{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE RecordWildCards #-}\n\nmodule Duckling.Api\n  ( analyze\n  , formatToken\n  , parse\n  , supportedDimensions\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.HashSet (HashSet)\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.HashSet as HashSet\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Dimensions\nimport Duckling.Engine\nimport Duckling.Locale\nimport Duckling.Ranking.Classifiers\nimport Duckling.Ranking.Rank\nimport Duckling.Resolve\nimport Duckling.Rules\nimport Duckling.Types\n\n-- | Parses `input` and returns a curated list of entities found.\nparse\n  :: Text\n  -> Context\n  -> Options\n  -> [Seal Dimension]\n  -> [Entity]\nparse input ctx options =\n  map (formatToken input)\n  . analyze input ctx options\n  . HashSet.fromList\n\nsupportedDimensions :: HashMap Lang [Seal Dimension]\nsupportedDimensions =\n  HashMap.fromList [ (l, allDimensions l) | l <- [minBound..maxBound] ]\n\n-- | Returns a curated list of resolved tokens found\n-- When `targets` is non-empty, returns only tokens of such dimensions.\nanalyze\n  :: Text\n  -> Context\n  -> Options\n  -> HashSet (Seal Dimension)\n  -> [ResolvedToken]\nanalyze input context@Context{..} options targets =\n  rank (classifiers locale) targets\n  $ filter isRelevantDimension\n  $ parseAndResolve (rulesFor locale targets) input context options\n  where\n    isRelevantDimension Resolved{node = Node{token = (Token d _)}} =\n      HashSet.null targets || HashSet.member (Seal d) targets\n\n-- | Converts the resolved token to the API format\nformatToken :: Text -> ResolvedToken -> Entity\nformatToken sentence\n  (Resolved (Range start end) node@Node{token = Token dim _} value latent)\n  = Entity (toName dim) body value start end latent node\n  where\n    body = Text.drop start $ Text.take end sentence\n", "num_lines": 75}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NoRebindableSyntax #-}\n\n-- | Everything needed to run Duckling.\n\nmodule Duckling.Core\n  ( Context(..)\n  , Dimension(..)\n  , Entity(..)\n  , Lang(..)\n  , Locale\n  , Node(..)\n  , Options(..)\n  , Range(..)\n  , Region(..)\n  , ResolvedVal(..)\n  , Seal(..)\n  , withSeal\n  , fromName\n  , makeLocale\n  , toJText\n  , toName\n\n  -- Duckling API\n  , parse\n  , supportedDimensions\n  , allLocales\n\n  -- Reference time builders\n  , currentReftime\n  , fromZonedTime\n  , makeReftime\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Text (Text)\nimport Data.Time\nimport Data.Time.LocalTime.TimeZone.Series\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\n\nimport Duckling.Api\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Types\n\n-- | Builds a `DucklingTime` for timezone `tz` at `utcTime`.\n-- If no `series` found for `tz`, uses UTC.\nmakeReftime :: HashMap Text TimeZoneSeries -> Text -> UTCTime -> DucklingTime\nmakeReftime series tz utcTime = DucklingTime $ ZoneSeriesTime ducklingTime tzs\n  where\n    tzs = HashMap.lookupDefault (TimeZoneSeries utc []) tz series\n    ducklingTime = toUTC $ utcToLocalTime' tzs utcTime\n\n-- | Builds a `DucklingTime` for timezone `tz` at current time.\n-- If no `series` found for `tz`, uses UTC.\ncurrentReftime :: HashMap Text TimeZoneSeries -> Text -> IO DucklingTime\ncurrentReftime series tz = makeReftime series tz <$> getCurrentTime\n\n-- | Builds a `DucklingTime` from a `ZonedTime`.\nfromZonedTime :: ZonedTime -> DucklingTime\nfromZonedTime (ZonedTime localTime timeZone) = DucklingTime $\n  ZoneSeriesTime (toUTC localTime) (TimeZoneSeries timeZone [])\n", "num_lines": 71}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Debug\n  ( allParses\n  , debug\n  , debugCustom\n  , fullParses\n  , ptree\n  ) where\n\nimport Data.Maybe\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashSet as HashSet\nimport qualified Data.Text as Text\nimport qualified Data.Text.IO as Text\n\nimport Duckling.Api\nimport Duckling.Dimensions.Types\nimport Duckling.Engine\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Rules\nimport Duckling.Testing.Types\nimport Duckling.Types\n\n-- -----------------------------------------------------------------\n-- API\n\ndebug :: Locale -> Text -> [Seal Dimension] -> IO [Entity]\ndebug locale = debugCustom testContext {locale = locale} testOptions\n\nallParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]\nallParses l input targets = debugTokens input $ parses l input targets\n\nfullParses :: Locale -> Text -> [Seal Dimension] -> IO [Entity]\nfullParses l input targets =\n  debugTokens\n    input\n    $ filter\n      (\\Resolved{range = Range start end} -> start == 0 && end == n)\n      $ parses l input targets\n  where\n    n = Text.length input\n\ndebugCustom :: Context -> Options -> Text -> [Seal Dimension] -> IO [Entity]\ndebugCustom context options input targets =\n  debugTokens\n    input\n    $ analyze input context options $ HashSet.fromList targets\n\nptree :: Text -> Entity -> IO ()\nptree input Entity {enode} = pnode input 0 enode\n\n-- -----------------------------------------------------------------\n-- Internals\n\nparses :: Locale -> Text -> [Seal Dimension] -> [ResolvedToken]\nparses l input targets =\n  filter isRelevantDimension tokens\n  where\n    tokens = parseAndResolve rules input testContext {locale = l} testOptions\n    rules = rulesFor l $ HashSet.fromList targets\n    isRelevantDimension Resolved{node = Node{token = (Token d _)}} =\n      case targets of\n        [] -> True\n        _ -> elem (Seal d) targets\n\ndebugTokens :: Text -> [ResolvedToken] -> IO [Entity]\ndebugTokens input tokens = do\n  mapM_ (ptree input) entities\n  return entities\n  where entities = map (formatToken input) tokens\n\npnode :: Text -> Int -> Node -> IO ()\npnode input depth Node {children, rule, nodeRange = Range start end} = do\n  Text.putStrLn out\n  mapM_ (pnode input (depth + 1)) children\n  where\n    out = Text.concat [ Text.replicate depth \"-- \", name, \" (\", body, \")\" ]\n    name = fromMaybe \"regex\" rule\n    body = Text.drop start $ Text.take end input\n", "num_lines": 92}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Dimensions\n  ( allDimensions\n  , explicitDimensions\n  ) where\n\nimport Data.HashSet (HashSet)\nimport Prelude\nimport qualified Data.HashSet as HashSet\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Dimensions.Common as CommonDimensions\nimport qualified Duckling.Dimensions.AF as AFDimensions\nimport qualified Duckling.Dimensions.AR as ARDimensions\nimport qualified Duckling.Dimensions.BG as BGDimensions\nimport qualified Duckling.Dimensions.BN as BNDimensions\nimport qualified Duckling.Dimensions.CA as CADimensions\nimport qualified Duckling.Dimensions.CS as CSDimensions\nimport qualified Duckling.Dimensions.DA as DADimensions\nimport qualified Duckling.Dimensions.DE as DEDimensions\nimport qualified Duckling.Dimensions.EL as ELDimensions\nimport qualified Duckling.Dimensions.EN as ENDimensions\nimport qualified Duckling.Dimensions.ES as ESDimensions\nimport qualified Duckling.Dimensions.ET as ETDimensions\nimport qualified Duckling.Dimensions.FA as FADimensions\nimport qualified Duckling.Dimensions.FI as FIDimensions\nimport qualified Duckling.Dimensions.FR as FRDimensions\nimport qualified Duckling.Dimensions.GA as GADimensions\nimport qualified Duckling.Dimensions.HE as HEDimensions\nimport qualified Duckling.Dimensions.HI as HIDimensions\nimport qualified Duckling.Dimensions.HR as HRDimensions\nimport qualified Duckling.Dimensions.HU as HUDimensions\nimport qualified Duckling.Dimensions.ID as IDDimensions\nimport qualified Duckling.Dimensions.IS as ISDimensions\nimport qualified Duckling.Dimensions.IT as ITDimensions\nimport qualified Duckling.Dimensions.JA as JADimensions\nimport qualified Duckling.Dimensions.KA as KADimensions\nimport qualified Duckling.Dimensions.KM as KMDimensions\nimport qualified Duckling.Dimensions.KN as KNDimensions\nimport qualified Duckling.Dimensions.KO as KODimensions\nimport qualified Duckling.Dimensions.LO as LODimensions\nimport qualified Duckling.Dimensions.ML as MLDimensions\nimport qualified Duckling.Dimensions.MN as MNDimensions\nimport qualified Duckling.Dimensions.MY as MYDimensions\nimport qualified Duckling.Dimensions.NB as NBDimensions\nimport qualified Duckling.Dimensions.NE as NEDimensions\nimport qualified Duckling.Dimensions.NL as NLDimensions\nimport qualified Duckling.Dimensions.PL as PLDimensions\nimport qualified Duckling.Dimensions.PT as PTDimensions\nimport qualified Duckling.Dimensions.RO as RODimensions\nimport qualified Duckling.Dimensions.RU as RUDimensions\nimport qualified Duckling.Dimensions.SK as SKDimensions\nimport qualified Duckling.Dimensions.SV as SVDimensions\nimport qualified Duckling.Dimensions.SW as SWDimensions\nimport qualified Duckling.Dimensions.TA as TADimensions\nimport qualified Duckling.Dimensions.TE as TEDimensions\nimport qualified Duckling.Dimensions.TH as THDimensions\nimport qualified Duckling.Dimensions.TR as TRDimensions\nimport qualified Duckling.Dimensions.UK as UKDimensions\nimport qualified Duckling.Dimensions.VI as VIDimensions\nimport qualified Duckling.Dimensions.ZH as ZHDimensions\n\n\nallDimensions :: Lang -> [Seal Dimension]\nallDimensions lang = CommonDimensions.allDimensions ++ langDimensions lang\n\n-- | Augments `targets` with all dependent dimensions.\nexplicitDimensions :: HashSet (Seal Dimension) -> HashSet (Seal Dimension)\nexplicitDimensions targets = HashSet.union targets deps\n  where\n    deps = HashSet.unions . map dependents $ HashSet.toList targets\n\n-- | Ordinal depends on Numeral for JA, KO, and ZH.\ndependents :: Seal Dimension -> HashSet (Seal Dimension)\ndependents (Seal CreditCardNumber) = HashSet.empty\ndependents (Seal Distance) = HashSet.singleton (Seal Numeral)\ndependents (Seal Duration) = HashSet.fromList [Seal Numeral, Seal TimeGrain]\ndependents (Seal Numeral) = HashSet.empty\ndependents (Seal Email) = HashSet.empty\ndependents (Seal AmountOfMoney) = HashSet.singleton (Seal Numeral)\ndependents (Seal Ordinal) = HashSet.singleton (Seal Numeral)\ndependents (Seal PhoneNumber) = HashSet.empty\ndependents (Seal Quantity) = HashSet.singleton (Seal Numeral)\ndependents (Seal RegexMatch) = HashSet.empty\ndependents (Seal Temperature) = HashSet.singleton (Seal Numeral)\ndependents (Seal Time) =\n  HashSet.fromList [Seal Numeral, Seal Duration, Seal Ordinal, Seal TimeGrain]\ndependents (Seal TimeGrain) = HashSet.empty\ndependents (Seal Url) = HashSet.empty\ndependents (Seal Volume) = HashSet.singleton (Seal Numeral)\ndependents (Seal (CustomDimension dim)) = dimDependents dim\n\nlangDimensions :: Lang -> [Seal Dimension]\nlangDimensions AF = AFDimensions.allDimensions\nlangDimensions AR = ARDimensions.allDimensions\nlangDimensions BG = BGDimensions.allDimensions\nlangDimensions BN = BNDimensions.allDimensions\nlangDimensions CA = CADimensions.allDimensions\nlangDimensions CS = CSDimensions.allDimensions\nlangDimensions DA = DADimensions.allDimensions\nlangDimensions DE = DEDimensions.allDimensions\nlangDimensions EL = ELDimensions.allDimensions\nlangDimensions EN = ENDimensions.allDimensions\nlangDimensions ES = ESDimensions.allDimensions\nlangDimensions ET = ETDimensions.allDimensions\nlangDimensions FA = FADimensions.allDimensions\nlangDimensions FI = FIDimensions.allDimensions\nlangDimensions FR = FRDimensions.allDimensions\nlangDimensions GA = GADimensions.allDimensions\nlangDimensions HE = HEDimensions.allDimensions\nlangDimensions HI = HIDimensions.allDimensions\nlangDimensions HR = HRDimensions.allDimensions\nlangDimensions HU = HUDimensions.allDimensions\nlangDimensions ID = IDDimensions.allDimensions\nlangDimensions IS = ISDimensions.allDimensions\nlangDimensions IT = ITDimensions.allDimensions\nlangDimensions JA = JADimensions.allDimensions\nlangDimensions KA = KADimensions.allDimensions\nlangDimensions KM = KMDimensions.allDimensions\nlangDimensions KN = KNDimensions.allDimensions\nlangDimensions KO = KODimensions.allDimensions\nlangDimensions LO = LODimensions.allDimensions\nlangDimensions ML = MLDimensions.allDimensions\nlangDimensions MN = MNDimensions.allDimensions\nlangDimensions MY = MYDimensions.allDimensions\nlangDimensions NB = NBDimensions.allDimensions\nlangDimensions NE = NEDimensions.allDimensions\nlangDimensions NL = NLDimensions.allDimensions\nlangDimensions PL = PLDimensions.allDimensions\nlangDimensions PT = PTDimensions.allDimensions\nlangDimensions RO = RODimensions.allDimensions\nlangDimensions RU = RUDimensions.allDimensions\nlangDimensions SK = SKDimensions.allDimensions\nlangDimensions SV = SVDimensions.allDimensions\nlangDimensions SW = SWDimensions.allDimensions\nlangDimensions TA = TADimensions.allDimensions\nlangDimensions TE = TEDimensions.allDimensions\nlangDimensions TH = THDimensions.allDimensions\nlangDimensions TR = TRDimensions.allDimensions\nlangDimensions UK = UKDimensions.allDimensions\nlangDimensions VI = VIDimensions.allDimensions\nlangDimensions ZH = ZHDimensions.allDimensions\n", "num_lines": 154}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Engine\n  ( parseAndResolve\n  , lookupRegexAnywhere\n  , runDuckling\n  ) where\n\nimport Control.DeepSeq\nimport Control.Monad.Extra\nimport Data.ByteString (ByteString)\nimport Data.Functor.Identity\nimport Data.Maybe\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Array as Array\nimport qualified Data.Foldable as Foldable\nimport qualified Data.List as L\nimport qualified Text.Regex.PCRE as PCRE\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Regex.Types\nimport Duckling.Resolve\nimport Duckling.Types hiding (regex)\nimport Duckling.Types.Document (Document)\nimport Duckling.Types.Stash (Stash)\nimport qualified Duckling.Engine.Regex as Regex\nimport qualified Duckling.Types.Document as Document\nimport qualified Duckling.Types.Stash as Stash\n\n-- -----------------------------------------------------------------\n-- Engine\n\nparseAndResolve :: [Rule] -> Text -> Context -> Options -> [ResolvedToken]\nparseAndResolve rules input context@Context{locale = Locale lang _} options =\n  mapMaybe\n    (resolveNode context options)\n    $ force $ Stash.toPosOrderedList\n      $ runDuckling $ parseString lang rules (Document.fromText input)\n\ntype Duckling a = Identity a\n\nrunDuckling :: Duckling a -> a\nrunDuckling ma = runIdentity ma\n\n-- | A match is full if its rule pattern is empty.\n-- (rule, endPosition, reversedRoute)\ntype Match = (Rule, Int, [Node])\n\nresolveNode :: Context -> Options -> Node -> Maybe ResolvedToken\nresolveNode context options n@Node{token = (Token dim dd), nodeRange = r}\n  = do\n  (val, latent) <- resolve context options dd\n  Just Resolved\n    { range = r\n    , node = n\n    , rval = RVal dim val\n    , isLatent = latent\n    }\n\nparseString :: Lang -> [Rule] -> Document -> Duckling Stash\nparseString lang rules sentence = do\n  (new, partialMatches) <-\n    -- One the first pass we try all the rules\n    parseString1 lang rules sentence Stash.empty Stash.empty []\n  if Stash.null new\n    then return Stash.empty\n    else\n    -- For subsequent passes, we only try rules starting with a predicate.\n    saturateParseString lang headPredicateRules sentence new new partialMatches\n  where\n  headPredicateRules =\n    [ rule | rule@Rule{pattern = (Predicate _ : _)} <- rules ]\n\n-- | Produces all tokens recursively.\nsaturateParseString\n  :: Lang -> [Rule] -> Document -> Stash -> Stash -> [Match] -> Duckling Stash\nsaturateParseString lang rules sentence stash new matches = do\n  (new', matches') <- parseString1 lang rules sentence stash new matches\n  let stash' = Stash.union stash new'\n  if Stash.null new'\n    then return stash\n    else saturateParseString lang rules sentence stash' new' matches'\n\n-- | Finds new matches resulting from newly added tokens.\n-- Produces new tokens from full matches.\nparseString1\n  :: Lang -> [Rule] -> Document -> Stash -> Stash -> [Match]\n  -> Duckling (Stash, [Match])\nparseString1 lang rules sentence stash new matches = do\n  -- Recursively match patterns.\n  -- Find which `matches` can advance because of `new`.\n  newPartial <- concatMapM (matchFirst sentence lang new) matches\n\n  -- Find new matches resulting from newly added tokens (`new`)\n  newMatches <- concatMapM (matchFirstAnywhere sentence lang new) rules\n\n  (full, partial) <- L.partition (\\(Rule {pattern}, _, _) -> null pattern)\n    <$> matchAll sentence lang stash (newPartial ++ newMatches)\n\n  -- Produce full matches as new tokens\n  return ( Stash.fromList $ mapMaybe produce full\n         , partial ++ matches\n         )\n\n-- | Recursively augments `matches`.\n-- Discards partial matches stuck by a regex.\nmatchAll :: Document -> Lang -> Stash -> [Match] -> Duckling [Match]\nmatchAll sentence lang stash matches = concatMapM mkNextMatches matches\n  where\n    mkNextMatches :: Match -> Duckling [Match]\n    mkNextMatches match@(Rule {pattern = []}, _, _) = return [ match ]\n    mkNextMatches match@(Rule {pattern = p:_}, _, _) = do\n      nextMatches <- matchAll sentence lang stash =<< matchFirst sentence lang stash match\n      return $ case p of\n        Regex _ -> nextMatches\n        Predicate _ -> match:nextMatches\n\nproduce :: Match -> Maybe Node\nproduce (_, _, []) = Nothing\nproduce (Rule name _ production, _, etuor@(Node {nodeRange = Range _ e}:_)) = do\n  let route = reverse etuor\n  token <- force $ production $ map token route\n  case route of\n    (Node {nodeRange = Range p _}:_) -> Just Node\n      { nodeRange = Range p e\n      , token = token\n      , children = route\n      , rule = Just name\n      }\n    [] -> Nothing\n\n-- | Returns all matches matching the first pattern item of `match`,\n-- resuming from a Match position\nmatchFirst :: Document -> Lang -> Stash -> Match -> Duckling [Match]\nmatchFirst _ _ _ (Rule {pattern = []}, _, _) = return []\nmatchFirst sentence lang stash (rule@Rule{pattern = p : ps}, position, route) =\n  map (mkMatch route newRule) <$> lookupItem sentence lang p stash position\n  where\n  newRule = rule { pattern = ps }\n\n-- | Returns all matches matching the first pattern item of `match`,\n-- starting anywhere\nmatchFirstAnywhere :: Document -> Lang -> Stash -> Rule -> Duckling [Match]\nmatchFirstAnywhere _sentence _lang _stash Rule {pattern = []} = return []\nmatchFirstAnywhere sentence lang stash rule@Rule{pattern = p : ps} =\n  map (mkMatch [] newRule) <$> lookupItemAnywhere sentence lang p stash\n  where\n  newRule = rule { pattern = ps }\n\n-- | Handle one PatternItem at a given position\nlookupItem :: Document -> Lang -> PatternItem -> Stash -> Int -> Duckling [Node]\nlookupItem doc lang (Regex re) _ position =\n  filter (isPositionValid position doc) <$>\n  lookupRegex doc lang re position\nlookupItem doc _lang (Predicate p) stash position =\n  return $\n  filter (p . token) $\n  takeWhile (isPositionValid position doc) $\n  Stash.toPosOrderedListFrom stash position\n\n-- | Handle one PatternItem anywhere in the text\nlookupItemAnywhere :: Document -> Lang -> PatternItem -> Stash -> Duckling [Node]\nlookupItemAnywhere doc lang (Regex re) _ = lookupRegexAnywhere doc lang re\nlookupItemAnywhere _doc _lang (Predicate p) stash =\n  return $ filter (p . token) $ Stash.toPosOrderedList stash\n\nisPositionValid :: Int -> Document -> Node -> Bool\nisPositionValid position sentence Node{nodeRange = Range start _} =\n  Document.isAdjacent sentence position start\n\n{-# INLINE mkMatch #-}\nmkMatch :: [Node] -> Rule -> Node -> Match\nmkMatch route newRule node@Node{nodeRange = Range _ pos'} =\n  newRoute `seq` (newRule, pos', newRoute)\n  where newRoute = node:route\n\n-- | Handle a regex match at a given position\nlookupRegex :: Document -> Lang -> PCRE.Regex -> Int -> Duckling [Node]\nlookupRegex doc _lang _regex position | position >= Document.length doc = return []\nlookupRegex doc lang regex position =\n  lookupRegexCommon doc lang regex position Regex.matchOnce\n\n-- | Handle a regex match anywhere in the text\nlookupRegexAnywhere :: Document -> Lang -> PCRE.Regex -> Duckling [Node]\nlookupRegexAnywhere doc lang regex = lookupRegexCommon doc lang regex 0 Regex.matchAll\n\n{-# INLINE lookupRegexCommon #-}\n-- INLINE bloats the code a bit, but the code is better\nlookupRegexCommon\n  :: Foldable t\n  => Document\n  -> Lang\n  -> PCRE.Regex\n  -> Int\n  -> (PCRE.Regex -> ByteString -> t PCRE.MatchArray)\n  -> Duckling [Node]\nlookupRegexCommon doc lang regex position matchFun = return nodes\n  where\n  -- See Note [Regular expressions and Text] from Document.hs to understand\n  -- what's going on here\n  (substring, rangeToText, translateRange) =\n    Document.byteStringFromPos doc position\n  nodes = mapMaybe (f . Array.elems)\n    $ Foldable.toList\n    $ matchFun regex substring\n  f :: [(Int, Int)] -> Maybe Node\n  f [] = Nothing\n  f ((0,0):_) = Nothing\n  f ((bsStart, bsLen):groups) =\n    if Document.isRangeValid lang doc start end\n      then Just node\n      else Nothing\n    where\n    textGroups = map rangeToText groups\n    (start, end) = translateRange bsStart bsLen\n    node = Node\n      { nodeRange = Range start end\n      , token = Token RegexMatch (GroupMatch textGroups)\n      , children = []\n      , rule = Nothing\n      }\n", "num_lines": 232}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\nmodule Duckling.Locale\n  ( Lang(..)\n  , Locale(..)\n  , Region\n      ( AU\n      , BE\n      , BZ\n      , CL\n      , CN\n      , CO\n      , EG\n      , GB\n      , HK\n      , IE\n      , IN\n      , JM\n      , MO\n      , MX\n      , NZ\n      , PE\n      , PH\n      , TT\n      , TW\n      , US\n      , VE\n      , ZA\n      )\n  , allLocales\n  , makeLocale\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.HashSet (HashSet)\nimport qualified Data.HashSet as HashSet\nimport Data.Hashable\nimport GHC.Generics\nimport Prelude\nimport TextShow (TextShow)\nimport qualified TextShow as TS\n\nimport Duckling.Region hiding\n  ( AR\n  , CA\n  , ES\n  , NL\n  )\nimport qualified Duckling.Region as R\n  ( Region\n      ( AR\n      , CA\n      , ES\n      , NL\n      )\n  )\n\n-- | ISO 639-1 Language.\n-- See https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes\ndata Lang\n  = AF\n  | AR\n  | BG\n  | BN\n  | CA\n  | CS\n  | DA\n  | DE\n  | EL\n  | EN\n  | ES\n  | ET\n  | FA\n  | FI\n  | FR\n  | GA\n  | HE\n  | HI\n  | HR\n  | HU\n  | ID\n  | IS\n  | IT\n  | JA\n  | KA\n  | KN\n  | KM\n  | KO\n  | LO\n  | ML\n  | MN\n  | MY\n  | NB\n  | NE\n  | NL\n  | PL\n  | PT\n  | RO\n  | RU\n  | SK\n  | SV\n  | SW\n  | TA\n  | TE\n  | TH\n  | TR\n  | UK\n  | VI\n  | ZH\n  deriving (Bounded, Enum, Eq, Generic, Hashable, Ord, Read, Show)\n\ninstance TextShow Lang where\n  showb = TS.fromString . show\n\ndata Locale = Locale Lang (Maybe Region)\n  deriving (Eq, Generic, Hashable, Ord)\n\ninstance Show Locale where\n  show (Locale lang Nothing) = show lang ++ \"_XX\"\n  show (Locale lang (Just region)) = show lang ++ \"_\" ++ show region\n\ninstance TextShow Locale where\n  showb = TS.fromString . show\n\nmakeLocale :: Lang -> Maybe Region -> Locale\nmakeLocale lang Nothing = Locale lang Nothing\nmakeLocale lang (Just region)\n  | HashSet.member region locales = Locale lang $ Just region\n  | otherwise = Locale lang Nothing\n  where\n    locales = HashMap.lookupDefault HashSet.empty lang allLocales\n\nallLocales :: HashMap Lang (HashSet Region)\nallLocales =\n  HashMap.fromList\n    [ (AR, HashSet.fromList [EG])\n    , (EN, HashSet.fromList [AU, BZ, R.CA, GB, IN, IE, JM, NZ, PH, ZA, TT, US])\n    , (ES, HashSet.fromList [R.AR, CL, CO, R.ES, MX, PE, VE])\n    , (NL, HashSet.fromList [BE, R.NL])\n    , (ZH, HashSet.fromList [CN, HK, MO, TW])\n    ]\n", "num_lines": 151}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Region\n  ( Region(..)\n  ) where\n\nimport Data.Hashable\nimport GHC.Generics\nimport Prelude\nimport TextShow (TextShow)\nimport qualified TextShow as TS\n\n-- | ISO 3166-1 alpha-2 Country code (includes regions and territories).\n-- See https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2\ndata Region\n  = AR\n  | AU\n  | BE\n  | BZ\n  | CA\n  | CL\n  | CN\n  | CO\n  | EG\n  | ES\n  | GB\n  | HK\n  | IE\n  | IN\n  | JM\n  | MN\n  | MX\n  | MO\n  | NL\n  | NZ\n  | PE\n  | PH\n  | TT\n  | TW\n  | US\n  | VE\n  | ZA\n  deriving (Bounded, Enum, Eq, Generic, Hashable, Ord, Read, Show)\n\ninstance TextShow Region where\n  showb = TS.fromString . show\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Resolve\n  ( Context(..)\n  , DucklingTime(..)\n  , Options(..)\n  , Resolve(..)\n  , fromUTC\n  , toUTC\n  ) where\n\nimport Data.Aeson (ToJSON)\nimport Prelude\nimport qualified Data.Time as Time\nimport qualified Data.Time.LocalTime.TimeZone.Series as Series\n\nimport Duckling.Locale\n\n-- | Internal time reference.\n-- We work as if we were in UTC time and use `ZoneSeriesTime` to house the info.\n-- We convert to local time at resolution, using `fromUTC`.\nnewtype DucklingTime = DucklingTime Series.ZoneSeriesTime\n  deriving (Eq, Show)\n\ndata Context = Context\n  { referenceTime :: DucklingTime\n  , locale :: Locale\n  }\n  deriving (Eq, Show)\n\nnewtype Options = Options\n  { withLatent :: Bool  -- When set, includes less certain parses, e.g. \"7\" as an hour of the day\n  }\n  deriving (Eq, Show)\n\nclass ( Eq (ResolvedValue a)\n      , Show (ResolvedValue a)\n      , ToJSON (ResolvedValue a)\n      ) => Resolve a where\n  type ResolvedValue a\n  resolve :: Context -> Options -> a -> Maybe (ResolvedValue a, Bool)\n\n-- | Given a UTCTime and an TimeZone, build a ZonedTime (no conversion)\nfromUTC :: Time.UTCTime -> Time.TimeZone -> Time.ZonedTime\nfromUTC (Time.UTCTime day diffTime) timeZone = Time.ZonedTime localTime timeZone\n  where\n    localTime = Time.LocalTime day timeOfDay\n    timeOfDay = Time.timeToTimeOfDay diffTime\n\n-- | Given a LocalTime, build a UTCTime (no conversion)\ntoUTC :: Time.LocalTime -> Time.UTCTime\ntoUTC (Time.LocalTime day timeOfDay) = Time.UTCTime day diffTime\n  where\n    diffTime = Time.timeOfDayToTime timeOfDay\n", "num_lines": 63}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Rules\n  ( allRules\n  , rulesFor\n  ) where\n\nimport Data.HashSet (HashSet)\nimport Prelude\nimport qualified Data.HashSet as HashSet\n\nimport Duckling.Dimensions\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Rules.AF as AFRules\nimport qualified Duckling.Rules.AR as ARRules\nimport qualified Duckling.Rules.Common as CommonRules\nimport qualified Duckling.Rules.BG as BGRules\nimport qualified Duckling.Rules.BN as BNRules\nimport qualified Duckling.Rules.CA as CARules\nimport qualified Duckling.Rules.CS as CSRules\nimport qualified Duckling.Rules.DA as DARules\nimport qualified Duckling.Rules.DE as DERules\nimport qualified Duckling.Rules.EL as ELRules\nimport qualified Duckling.Rules.EN as ENRules\nimport qualified Duckling.Rules.ES as ESRules\nimport qualified Duckling.Rules.ET as ETRules\nimport qualified Duckling.Rules.FI as FIRules\nimport qualified Duckling.Rules.FA as FARules\nimport qualified Duckling.Rules.FR as FRRules\nimport qualified Duckling.Rules.GA as GARules\nimport qualified Duckling.Rules.HE as HERules\nimport qualified Duckling.Rules.HI as HIRules\nimport qualified Duckling.Rules.HR as HRRules\nimport qualified Duckling.Rules.HU as HURules\nimport qualified Duckling.Rules.ID as IDRules\nimport qualified Duckling.Rules.IS as ISRules\nimport qualified Duckling.Rules.IT as ITRules\nimport qualified Duckling.Rules.JA as JARules\nimport qualified Duckling.Rules.KA as KARules\nimport qualified Duckling.Rules.KM as KMRules\nimport qualified Duckling.Rules.KN as KNRules\nimport qualified Duckling.Rules.KO as KORules\nimport qualified Duckling.Rules.LO as LORules\nimport qualified Duckling.Rules.ML as MLRules\nimport qualified Duckling.Rules.MN as MNRules\nimport qualified Duckling.Rules.MY as MYRules\nimport qualified Duckling.Rules.NB as NBRules\nimport qualified Duckling.Rules.NE as NERules\nimport qualified Duckling.Rules.NL as NLRules\nimport qualified Duckling.Rules.PL as PLRules\nimport qualified Duckling.Rules.PT as PTRules\nimport qualified Duckling.Rules.RO as RORules\nimport qualified Duckling.Rules.RU as RURules\nimport qualified Duckling.Rules.SK as SKRules\nimport qualified Duckling.Rules.SV as SVRules\nimport qualified Duckling.Rules.SW as SWRules\nimport qualified Duckling.Rules.TA as TARules\nimport qualified Duckling.Rules.TE as TERules\nimport qualified Duckling.Rules.TH as THRules\nimport qualified Duckling.Rules.TR as TRRules\nimport qualified Duckling.Rules.UK as UKRules\nimport qualified Duckling.Rules.VI as VIRules\nimport qualified Duckling.Rules.ZH as ZHRules\n\n-- | Returns the minimal set of rules required for `targets`.\nrulesFor :: Locale -> HashSet (Seal Dimension) -> [Rule]\nrulesFor locale targets\n  | HashSet.null targets = allRules locale\n  | otherwise = [ rules | dims <- HashSet.toList $ explicitDimensions targets\n                        , rules <- rulesFor' locale dims ]\n\n-- | Returns all the rules for the provided locale.\n-- We can't really use `allDimensions` as-is, since `TimeGrain` is not present.\nallRules :: Locale -> [Rule]\nallRules locale@(Locale lang _) = concatMap (rulesFor' locale) . HashSet.toList\n  . explicitDimensions . HashSet.fromList $ allDimensions lang\n\nrulesFor' :: Locale -> Seal Dimension -> [Rule]\nrulesFor' (Locale lang (Just region)) dim =\n  CommonRules.rules dim ++ langRules lang dim ++ localeRules lang region dim\nrulesFor' (Locale lang Nothing) dim =\n  CommonRules.rules dim ++ defaultRules lang dim\n\n-- | Default rules when no locale, for backward compatibility.\ndefaultRules :: Lang -> Seal Dimension -> [Rule]\ndefaultRules AF = AFRules.defaultRules\ndefaultRules AR = ARRules.defaultRules\ndefaultRules BG = BGRules.defaultRules\ndefaultRules BN = BNRules.defaultRules\ndefaultRules CA = CARules.defaultRules\ndefaultRules CS = CSRules.defaultRules\ndefaultRules DA = DARules.defaultRules\ndefaultRules DE = DERules.defaultRules\ndefaultRules EL = ELRules.defaultRules\ndefaultRules EN = ENRules.defaultRules\ndefaultRules ES = ESRules.defaultRules\ndefaultRules ET = ETRules.defaultRules\ndefaultRules FI = FIRules.defaultRules\ndefaultRules FA = FARules.defaultRules\ndefaultRules FR = FRRules.defaultRules\ndefaultRules GA = GARules.defaultRules\ndefaultRules HE = HERules.defaultRules\ndefaultRules HI = HIRules.defaultRules\ndefaultRules HR = HRRules.defaultRules\ndefaultRules HU = HURules.defaultRules\ndefaultRules ID = IDRules.defaultRules\ndefaultRules IS = ISRules.defaultRules\ndefaultRules IT = ITRules.defaultRules\ndefaultRules JA = JARules.defaultRules\ndefaultRules KA = KARules.defaultRules\ndefaultRules KM = KMRules.defaultRules\ndefaultRules KN = KNRules.defaultRules\ndefaultRules KO = KORules.defaultRules\ndefaultRules LO = LORules.defaultRules\ndefaultRules ML = MLRules.defaultRules\ndefaultRules MN = MNRules.defaultRules\ndefaultRules MY = MYRules.defaultRules\ndefaultRules NB = NBRules.defaultRules\ndefaultRules NE = NERules.defaultRules\ndefaultRules NL = NLRules.defaultRules\ndefaultRules PL = PLRules.defaultRules\ndefaultRules PT = PTRules.defaultRules\ndefaultRules RO = RORules.defaultRules\ndefaultRules RU = RURules.defaultRules\ndefaultRules SK = SKRules.defaultRules\ndefaultRules SV = SVRules.defaultRules\ndefaultRules SW = SWRules.defaultRules\ndefaultRules TA = TARules.defaultRules\ndefaultRules TE = TERules.defaultRules\ndefaultRules TH = THRules.defaultRules\ndefaultRules TR = TRRules.defaultRules\ndefaultRules UK = UKRules.defaultRules\ndefaultRules VI = VIRules.defaultRules\ndefaultRules ZH = ZHRules.defaultRules\n\nlocaleRules :: Lang -> Region -> Seal Dimension -> [Rule]\nlocaleRules AF = AFRules.localeRules\nlocaleRules AR = ARRules.localeRules\nlocaleRules BG = BGRules.localeRules\nlocaleRules BN = BNRules.localeRules\nlocaleRules CA = CARules.localeRules\nlocaleRules CS = CSRules.localeRules\nlocaleRules DA = DARules.localeRules\nlocaleRules DE = DERules.localeRules\nlocaleRules EL = ELRules.localeRules\nlocaleRules EN = ENRules.localeRules\nlocaleRules ES = ESRules.localeRules\nlocaleRules ET = ETRules.localeRules\nlocaleRules FI = FIRules.localeRules\nlocaleRules FA = FARules.localeRules\nlocaleRules FR = FRRules.localeRules\nlocaleRules GA = GARules.localeRules\nlocaleRules HE = HERules.localeRules\nlocaleRules HI = HIRules.localeRules\nlocaleRules HR = HRRules.localeRules\nlocaleRules HU = HURules.localeRules\nlocaleRules ID = IDRules.localeRules\nlocaleRules IS = ISRules.localeRules\nlocaleRules IT = ITRules.localeRules\nlocaleRules JA = JARules.localeRules\nlocaleRules KA = KARules.localeRules\nlocaleRules KM = KMRules.localeRules\nlocaleRules KN = KNRules.localeRules\nlocaleRules KO = KORules.localeRules\nlocaleRules LO = LORules.localeRules\nlocaleRules ML = MLRules.localeRules\nlocaleRules MN = MNRules.localeRules\nlocaleRules MY = MYRules.localeRules\nlocaleRules NB = NBRules.localeRules\nlocaleRules NE = NERules.localeRules\nlocaleRules NL = NLRules.localeRules\nlocaleRules PL = PLRules.localeRules\nlocaleRules PT = PTRules.localeRules\nlocaleRules RO = RORules.localeRules\nlocaleRules RU = RURules.localeRules\nlocaleRules SK = SKRules.localeRules\nlocaleRules SV = SVRules.localeRules\nlocaleRules SW = SWRules.localeRules\nlocaleRules TA = TARules.localeRules\nlocaleRules TE = TERules.localeRules\nlocaleRules TH = THRules.localeRules\nlocaleRules TR = TRRules.localeRules\nlocaleRules UK = UKRules.localeRules\nlocaleRules VI = VIRules.localeRules\nlocaleRules ZH = ZHRules.localeRules\n\nlangRules :: Lang -> Seal Dimension -> [Rule]\nlangRules AF = AFRules.langRules\nlangRules AR = ARRules.langRules\nlangRules BG = BGRules.langRules\nlangRules BN = BNRules.langRules\nlangRules CA = CARules.langRules\nlangRules CS = CSRules.langRules\nlangRules DA = DARules.langRules\nlangRules DE = DERules.langRules\nlangRules EL = ELRules.langRules\nlangRules EN = ENRules.langRules\nlangRules ES = ESRules.langRules\nlangRules ET = ETRules.langRules\nlangRules FI = FIRules.langRules\nlangRules FA = FARules.langRules\nlangRules FR = FRRules.langRules\nlangRules GA = GARules.langRules\nlangRules HE = HERules.langRules\nlangRules HI = HIRules.langRules\nlangRules KN = KNRules.langRules\nlangRules HR = HRRules.langRules\nlangRules HU = HURules.langRules\nlangRules ID = IDRules.langRules\nlangRules IS = ISRules.langRules\nlangRules IT = ITRules.langRules\nlangRules JA = JARules.langRules\nlangRules KA = KARules.langRules\nlangRules KM = KMRules.langRules\nlangRules KO = KORules.langRules\nlangRules LO = LORules.langRules\nlangRules ML = MLRules.langRules\nlangRules MN = MNRules.langRules\nlangRules MY = MYRules.langRules\nlangRules NB = NBRules.langRules\nlangRules NE = NERules.langRules\nlangRules NL = NLRules.langRules\nlangRules PL = PLRules.langRules\nlangRules PT = PTRules.langRules\nlangRules RO = RORules.langRules\nlangRules RU = RURules.langRules\nlangRules SK = SKRules.langRules\nlangRules SV = SVRules.langRules\nlangRules SW = SWRules.langRules\nlangRules TA = TARules.langRules\nlangRules TE = TERules.langRules\nlangRules TH = THRules.langRules\nlangRules TR = TRRules.langRules\nlangRules UK = UKRules.langRules\nlangRules VI = VIRules.langRules\nlangRules ZH = ZHRules.langRules\n", "num_lines": 247}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE NamedFieldPuns #-}\n\nmodule Duckling.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.GADT.Compare\nimport Data.GADT.Show\nimport Data.Hashable\nimport Data.HashMap.Strict (HashMap)\nimport Data.HashSet (HashSet)\nimport Data.List (intersperse, sortOn)\nimport Data.Maybe\nimport Data.Text (Text, toLower, unpack)\nimport Data.Typeable ((:~:)(Refl), eqT, Typeable)\nimport GHC.Generics\nimport Prelude\nimport TextShow (TextShow(..))\nimport qualified Data.ByteString.Lazy as LB\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as TT\nimport qualified Data.Text.Encoding as Text\nimport qualified Text.Regex.Base as R\nimport qualified Text.Regex.PCRE as PCRE\nimport qualified TextShow as TS\n\nimport Duckling.AmountOfMoney.Types (AmountOfMoneyData)\nimport Duckling.CreditCardNumber.Types (CreditCardNumberData)\nimport Duckling.Distance.Types (DistanceData)\nimport Duckling.Duration.Types (DurationData)\nimport Duckling.Email.Types (EmailData)\nimport Duckling.Locale\nimport Duckling.Numeral.Types (NumeralData)\nimport Duckling.Ordinal.Types (OrdinalData)\nimport Duckling.PhoneNumber.Types (PhoneNumberData)\nimport Duckling.Quantity.Types (QuantityData)\nimport Duckling.Regex.Types\nimport Duckling.Resolve\nimport Duckling.Temperature.Types (TemperatureData)\nimport Duckling.Time.Types (TimeData)\nimport Duckling.TimeGrain.Types (Grain)\nimport Duckling.Url.Types (UrlData)\nimport Duckling.Volume.Types (VolumeData)\n\n-- -----------------------------------------------------------------\n-- Token\n\ndata Token = forall a . (Resolve a, Eq a, Hashable a, Show a, NFData a) =>\n  Token (Dimension a) a\n\nderiving instance Show Token\ninstance Eq Token where\n  Token d1 v1 == Token d2 v2 = case geq d1 d2 of\n    Just Refl -> v1 == v2\n    Nothing   -> False\n\ninstance Hashable Token where\n  hashWithSalt s (Token d v) = hashWithSalt s (d, v)\n\ninstance NFData Token where\n  rnf (Token _ v) = rnf v\n\n-- -----------------------------------------------------------------\n-- Seal\n\ndata Seal s where\n  Seal :: s a -> Seal s\n\ninstance GEq s => Eq (Seal s) where\n  Seal x == Seal y =\n    defaultEq x y\n\ninstance GShow s => Show (Seal s) where\n  showsPrec p (Seal s)\n    = showParen (p > 10) (showString \"Seal \" . gshowsPrec 11 s)\n\nwithSeal :: Seal s -> (forall t. s t -> r) -> r\nwithSeal (Seal x) f = f x\n\n-- -----------------------------------------------------------------\n-- Dimension\n\nclass (Show a, Typeable a, Typeable (DimensionData  a)) =>\n    CustomDimension a where\n  type DimensionData a\n  dimRules :: a -> [Rule]\n  dimLangRules :: Lang -> a -> [Rule]\n  dimLocaleRules :: Region -> a -> [Rule]\n  dimDependents :: a -> HashSet (Seal Dimension)\n\n-- | GADT for differentiating between dimensions\n-- Each dimension should have its own constructor and provide the data structure\n-- for its parsed data\ndata Dimension a where\n  RegexMatch :: Dimension GroupMatch\n  AmountOfMoney :: Dimension AmountOfMoneyData\n  CreditCardNumber :: Dimension CreditCardNumberData\n  Distance :: Dimension DistanceData\n  Duration :: Dimension DurationData\n  Email :: Dimension EmailData\n  Numeral :: Dimension NumeralData\n  Ordinal :: Dimension OrdinalData\n  PhoneNumber :: Dimension PhoneNumberData\n  Quantity :: Dimension QuantityData\n  Temperature :: Dimension TemperatureData\n  Time :: Dimension TimeData\n  TimeGrain :: Dimension Grain\n  Url :: Dimension UrlData\n  Volume :: Dimension VolumeData\n  CustomDimension :: CustomDimension a => a -> Dimension (DimensionData a)\n\n-- Show\ninstance Show (Dimension a) where\n  show RegexMatch = \"RegexMatch\"\n  show CreditCardNumber = \"CreditCardNumber\"\n  show Distance = \"Distance\"\n  show Duration = \"Duration\"\n  show Email = \"Email\"\n  show AmountOfMoney = \"AmountOfMoney\"\n  show Numeral = \"Numeral\"\n  show Ordinal = \"Ordinal\"\n  show PhoneNumber = \"PhoneNumber\"\n  show Quantity = \"Quantity\"\n  show Temperature = \"Temperature\"\n  show Time = \"Time\"\n  show TimeGrain = \"TimeGrain\"\n  show Url = \"Url\"\n  show Volume = \"Volume\"\n  show (CustomDimension d) = show d\ninstance GShow Dimension where gshowsPrec = showsPrec\n\n-- TextShow\ninstance TextShow (Dimension a) where\n  showb d = TS.fromString $ show d\ninstance TextShow (Seal Dimension) where\n  showb (Seal d) = showb d\n\n-- Hashable\ninstance Hashable (Seal Dimension) where\n  hashWithSalt s (Seal a) = hashWithSalt s a\ninstance Hashable (Dimension a) where\n  hashWithSalt s RegexMatch          = hashWithSalt s (0::Int)\n  hashWithSalt s Distance            = hashWithSalt s (1::Int)\n  hashWithSalt s Duration            = hashWithSalt s (2::Int)\n  hashWithSalt s Email               = hashWithSalt s (3::Int)\n  hashWithSalt s AmountOfMoney       = hashWithSalt s (4::Int)\n  hashWithSalt s Numeral             = hashWithSalt s (5::Int)\n  hashWithSalt s Ordinal             = hashWithSalt s (6::Int)\n  hashWithSalt s PhoneNumber         = hashWithSalt s (7::Int)\n  hashWithSalt s Quantity            = hashWithSalt s (8::Int)\n  hashWithSalt s Temperature         = hashWithSalt s (9::Int)\n  hashWithSalt s Time                = hashWithSalt s (10::Int)\n  hashWithSalt s TimeGrain           = hashWithSalt s (11::Int)\n  hashWithSalt s Url                 = hashWithSalt s (12::Int)\n  hashWithSalt s Volume              = hashWithSalt s (13::Int)\n  hashWithSalt s (CustomDimension _) = hashWithSalt s (14::Int)\n  hashWithSalt s CreditCardNumber    = hashWithSalt s (15::Int)\n\ninstance GEq Dimension where\n  geq RegexMatch RegexMatch = Just Refl\n  geq RegexMatch _ = Nothing\n  geq CreditCardNumber CreditCardNumber = Just Refl\n  geq CreditCardNumber _ = Nothing\n  geq Distance Distance = Just Refl\n  geq Distance _ = Nothing\n  geq Duration Duration = Just Refl\n  geq Duration _ = Nothing\n  geq Email Email = Just Refl\n  geq Email _ = Nothing\n  geq AmountOfMoney AmountOfMoney = Just Refl\n  geq AmountOfMoney _ = Nothing\n  geq Numeral Numeral = Just Refl\n  geq Numeral _ = Nothing\n  geq Ordinal Ordinal = Just Refl\n  geq Ordinal _ = Nothing\n  geq PhoneNumber PhoneNumber = Just Refl\n  geq PhoneNumber _ = Nothing\n  geq Quantity Quantity = Just Refl\n  geq Quantity _ = Nothing\n  geq Temperature Temperature = Just Refl\n  geq Temperature _ = Nothing\n  geq Time Time = Just Refl\n  geq Time _ = Nothing\n  geq TimeGrain TimeGrain = Just Refl\n  geq TimeGrain _ = Nothing\n  geq Url Url = Just Refl\n  geq Url _ = Nothing\n  geq Volume Volume = Just Refl\n  geq Volume _ = Nothing\n  geq (CustomDimension (_ :: a)) (CustomDimension (_ :: b))\n    | Just Refl <- eqT :: Maybe (a :~: b) = Just Refl\n  geq (CustomDimension _) _ = Nothing\n\nisDimension :: Dimension a -> Token -> Bool\nisDimension dim (Token dim' _) = isJust $ geq dim dim'\n\ndata ResolvedVal\n  = forall a . ( Resolve a, Eq (ResolvedValue a)\n               , Show (ResolvedValue a)\n               , ToJSON (ResolvedValue a)) =>\n    RVal (Dimension a) (ResolvedValue a)\n\nderiving instance Show ResolvedVal\n\ninstance Eq ResolvedVal where\n  RVal d1 v1 == RVal d2 v2\n    | Just Refl <- geq d1 d2 = v1 == v2\n    | otherwise = False\n\ndata Node = Node\n  { nodeRange :: Range\n  , token     :: Token\n  , children  :: [Node]\n  , rule      :: Maybe Text\n  } deriving (Eq, Generic, Hashable, Show, NFData)\n\ndata ResolvedToken = Resolved\n  { range :: Range\n  , node :: Node\n  , rval :: ResolvedVal\n  , isLatent :: Bool\n  } deriving (Eq, Show)\n\ninstance Ord ResolvedToken where\n  compare (Resolved range1 _ (RVal _ v1) latent1)\n          (Resolved range2 _ (RVal _ v2) latent2) =\n    case compare range1 range2 of\n      EQ -> case compare (toJText v1) (toJText v2) of\n        EQ -> compare latent1 latent2\n        z -> z\n      z  -> z\n\n\ndata Range = Range Int Int\n  deriving (Eq, Ord, Generic, Hashable, Show, NFData)\n\ntype Production = [Token] -> Maybe Token\ntype Predicate = Token -> Bool\ndata PatternItem = Regex PCRE.Regex | Predicate Predicate\n\ntype Pattern = [PatternItem]\n\ndata Rule = Rule\n  { name :: Text\n  , pattern :: Pattern\n  , prod :: Production\n  }\n\ninstance Show Rule where\n  show Rule{ name } = show name\n\ndata Entity = Entity\n  { dim    :: Text\n  , body   :: Text\n  , value  :: ResolvedVal\n  , start  :: Int\n  , end    :: Int\n  , latent :: Bool\n  , enode  :: Node\n  } deriving (Eq, Generic, Show)\n\ninstance ToJSON Entity where\n  toJSON ent@Entity{value = RVal _ val} = object\n    [ \"dim\"    .= dim ent\n    , \"body\"   .= body ent\n    , \"value\"  .= val\n    , \"start\"  .= start ent\n    , \"end\"    .= end ent\n    , \"latent\" .= latent ent\n    ]\n\ntoJText :: ToJSON x => x -> Text\ntoJText = Text.decodeUtf8 . LB.toStrict . encode\n\n-- -----------------------------------------------------------------\n-- Predicates helpers\n\nregex :: String -> PatternItem\nregex = Regex . R.makeRegexOpts compOpts execOpts\n  where\n    compOpts = PCRE.defaultCompOpt + PCRE.compCaseless + PCRE.compUTF8\n    execOpts = PCRE.defaultExecOpt\n\ndimension :: Typeable a => Dimension a -> PatternItem\ndimension d = Predicate $ isDimension d\n\n-- -----------------------------------------------------------------\n-- Rule Construction helpers\n\nsingleStringLookupRule :: HashMap Text a -> Text -> (a -> Maybe Token) -> Rule\nsingleStringLookupRule hashMap name production = Rule\n  { name\n  , pattern = [ regex $ unpack regexString ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (toLower match) hashMap >>= production\n      _ -> Nothing\n  }\n  where\n    regexString =\n      \"(\" <> mconcat\n      (intersperse \"|\" $ sortOn (negate . TT.length) $ HashMap.keys hashMap)\n      <> \")\"\n", "num_lines": 326}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NamedFieldPuns #-}\n\nmodule Duckling.AmountOfMoney.Helpers\n  ( currencyOnly\n  , valueOnly\n  , isSimpleAmountOfMoney\n  , isCent\n  , isCents\n  , isDollarCoin\n  , isCurrencyOnly\n  , isDime\n  , isMoneyWithValue\n  , isWithoutCents\n  , withCents\n  , withInterval\n  , withMax\n  , withMin\n  , withValue\n  , mkLatent\n  , dollarCoins\n  )\n  where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe (isJust)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\n  ( Currency (..)\n  , AmountOfMoneyData (..)\n  , amountOfMoneyData'\n  )\nimport Duckling.Numeral.Types (getIntValue, isInteger)\nimport Duckling.Dimensions.Types\nimport Duckling.Types hiding (Entity(..))\n\nimport qualified Data.HashMap.Strict as HashMap\n\n-- -----------------------------------------------------------------\n-- Dollar coin Types\n\ndollarCoins :: HashMap Text Double\ndollarCoins = HashMap.fromList\n  [ (\"nickel\", 0.05)\n  , (\"nickels\", 0.05)\n  , (\"dime\", 0.1)\n  , (\"dimes\", 0.1)\n  , (\"quarter\", 0.25)\n  , (\"quarters\", 0.25)\n  ]\n\n-- -----------------------------------------------------------------\n-- Patterns\n\nisCents :: Predicate\nisCents (Token AmountOfMoney AmountOfMoneyData{value = Just _, currency = Cent}) = True\nisCents _ = False\n\nisWithoutCents :: Predicate\nisWithoutCents (Token AmountOfMoney AmountOfMoneyData{currency = Cent}) = False\nisWithoutCents (Token AmountOfMoney AmountOfMoneyData{value = Just v}) = isInteger v\nisWithoutCents _ = False\n\nisMoneyWithValue :: Predicate\nisMoneyWithValue (Token AmountOfMoney AmountOfMoneyData{value = v1, minValue = v2, maxValue = v3}) =\n any isJust [v1, v2, v3]\nisMoneyWithValue _ = False\n\nisCurrencyOnly :: Predicate\nisCurrencyOnly (Token AmountOfMoney AmountOfMoneyData\n  {value = Nothing, minValue = Nothing, maxValue = Nothing}) = True\nisCurrencyOnly _ = False\n\nisDollarCoin :: Predicate\nisDollarCoin (Token AmountOfMoney AmountOfMoneyData{value = Just d, currency}) =\n  elem d [0.05, 0.1, 0.25] && elem currency [Dollar, AUD, CAD, JMD,\n                                             NZD,    SGD, TTD, USD]\nisDollarCoin _ = False\n\nisSimpleAmountOfMoney :: Predicate\nisSimpleAmountOfMoney (Token AmountOfMoney AmountOfMoneyData\n  {value = Just _, minValue = Nothing, maxValue = Nothing}) = True\nisSimpleAmountOfMoney _ = False\n\nisDime :: Predicate\nisDime (Token AmountOfMoney AmountOfMoneyData\n  {value = Just d, currency = Cent}) =\n  maybe False (\\i -> (i `mod` 10) == 0) $ getIntValue d\nisDime _ = False\n\nisCent :: Predicate\nisCent (Token AmountOfMoney AmountOfMoneyData\n  {value = Just c, currency = Cent}) =\n  maybe False (\\i -> i >= 0 && i <= 9) $ getIntValue c\nisCent _ = False\n\n-- -----------------------------------------------------------------\n-- Production\n\ncurrencyOnly :: Currency -> AmountOfMoneyData\ncurrencyOnly c = amountOfMoneyData'{currency = c}\n\nvalueOnly :: Double -> AmountOfMoneyData\nvalueOnly x = amountOfMoneyData'{value = Just x}\n\nwithValue :: Double -> AmountOfMoneyData -> AmountOfMoneyData\nwithValue x fd = fd {value = Just x}\n\nwithCents :: Double -> AmountOfMoneyData -> AmountOfMoneyData\nwithCents x fd@AmountOfMoneyData {value = Just value} = fd\n  {value = Just $ value + x / 100}\nwithCents x AmountOfMoneyData {value = Nothing} =\n  amountOfMoneyData'{value = Just x, currency = Cent}\n\nwithInterval :: (Double, Double) -> AmountOfMoneyData -> AmountOfMoneyData\nwithInterval (from, to) fd = fd\n  {minValue = Just from, maxValue = Just to, value = Nothing}\n\nwithMin :: Double -> AmountOfMoneyData -> AmountOfMoneyData\nwithMin x fd = fd {minValue = Just x}\n\nwithMax :: Double -> AmountOfMoneyData -> AmountOfMoneyData\nwithMax x fd = fd {maxValue = Just x}\n\nmkLatent :: AmountOfMoneyData -> AmountOfMoneyData\nmkLatent fd = fd {latent = True}\n", "num_lines": 137}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\ncurrencies :: HashMap Text Currency\ncurrencies = HashMap.fromList\n  [ (\"aed\", AED)\n  , (\"aud\", AUD)\n  , (\"bgn\", BGN)\n  , (\"brl\", BRL)\n  , (\"byn\", BYN)\n  , (\"cad\", CAD)\n  , (\"\u00c2\u00a2\", Cent)\n  , (\"c\", Cent)\n  , (\"chf\", CHF)\n  , (\"cny\", CNY)\n  , (\"czk\", CZK)\n  , (\"rmb\", CNY)\n  , (\"yuan\", CNY)\n  , (\"$\", Dollar)\n  , (\"dinar\", Dinar)\n  , (\"dinars\", Dinar)\n  , (\"dkk\", DKK)\n  , (\"dollar\", Dollar)\n  , (\"dollars\", Dollar)\n  , (\"egp\", EGP)\n  , (\"\u00e2\u201a\u00ac\", EUR)\n  , (\"eur\", EUR)\n  , (\"euro\", EUR)\n  , (\"euros\", EUR)\n  , (\"eurs\", EUR)\n  , (\"\u00e2\u201a\u00acur\", EUR)\n  , (\"\u00e2\u201a\u00acuro\", EUR)\n  , (\"\u00e2\u201a\u00acuros\", EUR)\n  , (\"\u00e2\u201a\u00acurs\", EUR)\n  , (\"gbp\", GBP)\n  , (\"gel\", GEL)\n  , (\"hkd\", HKD)\n  , (\"hrk\", HRK)\n  , (\"idr\", IDR)\n  , (\"ils\", ILS)\n  , (\"\u00e2\u201a\u00aa\", ILS)\n  , (\"nis\", ILS)\n  , (\"inr\", INR)\n  , (\"iqd\", IQD)\n  , (\"rs\", INR)\n  , (\"rs.\", INR)\n  , (\"rupee\", INR)\n  , (\"rupees\", INR)\n  , (\"jmd\", JMD)\n  , (\"jod\", JOD)\n  , (\"\u00c2\u00a5\", JPY)\n  , (\"jpy\", JPY)\n  , (\"lari\", GEL)\n  , (\"\\x20BE\", GEL)\n  , (\"yen\", JPY)\n  , (\"krw\", KRW)\n  , (\"kwd\", KWD)\n  , (\"lbp\", LBP)\n  , (\"mad\", MAD)\n  , (\"mnt\", MNT)\n  , (\"myr\", MYR)\n  , (\"rm\", MYR)\n  , (\"\u00e2\u201a\u00ae\", MNT)\n  , (\"tugrik\", MNT)\n  , (\"tugriks\", MNT)\n  , (\"nok\", NOK)\n  , (\"nzd\", NZD)\n  , (\"pkr\", PKR)\n  , (\"pln\", PLN)\n  , (\"\u00c2\u00a3\", Pound)\n  , (\"pt\", PTS)\n  , (\"pta\", PTS)\n  , (\"ptas\", PTS)\n  , (\"pts\", PTS)\n  , (\"qar\", QAR)\n  , (\"\u00e2\u201a\u00bd\", RUB)\n  , (\"rial\", Rial)\n  , (\"rials\", Rial)\n  , (\"riyal\", Riyal)\n  , (\"riyals\", Riyal)\n  , (\"ron\", RON)\n  , (\"rub\", RUB)\n  , (\"sar\", SAR)\n  , (\"sek\", SEK)\n  , (\"sgd\", SGD)\n  , (\"shekel\", ILS)\n  , (\"shekels\", ILS)\n  , (\"thb\", THB)\n  , (\"ttd\", TTD)\n  , (\"\u00e2\u201a\u00b4\", UAH)\n  , (\"uah\", UAH)\n  , (\"usd\", USD)\n  , (\"us$\", USD)\n  , (\"vnd\", VND)\n  , (\"zar\", ZAR)\n  , (\"tl\", TRY)\n  , (\"lira\", TRY)\n  , (\"\u00e2\u201a\u00ba\", TRY)\n  ]\n\nruleCurrencies :: Rule\nruleCurrencies = Rule\n  { name = \"currencies\"\n  , pattern =\n    [ regex \"(aed|aud|bgn|brl|byn|\u00c2\u00a2|cad|chf|cny|c|\\\\$|dinars?|dkk|dollars?|egp|(e|\u00e2\u201a\u00ac)uro?s?|\u00e2\u201a\u00ac|gbp|gel|\\x20BE|hkd|hrk|idr|ils|\u00e2\u201a\u00aa|inr|iqd|jmd|jod|\u00c2\u00a5|jpy|lari|krw|kwd|lbp|mad|\u00e2\u201a\u00ae|mnt|tugriks?|myr|rm|nis|nok|nzd|\u00c2\u00a3|pkr|pln|pta?s?|qar|\u00e2\u201a\u00bd|rs\\\\.?|riy?als?|ron|rub|rupees?|sar|sek|sgb|shekels?|thb|ttd|\u00e2\u201a\u00b4|uah|us(d|\\\\$)|vnd|yen|yuan|zar|tl|lira|\u00e2\u201a\u00ba)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) currencies\n        Just . Token AmountOfMoney $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleAmountUnit :: Rule\nruleAmountUnit = Rule\n  { name = \"<amount> <unit>\"\n  , pattern =\n    [ Predicate isPositive\n    , Predicate isCurrencyOnly\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleAmountLatent :: Rule\nruleAmountLatent = Rule\n  { name = \"<amount> (latent)\"\n  , pattern =\n    [ Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token AmountOfMoney . mkLatent $ valueOnly v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAmountUnit\n  , ruleAmountLatent\n  , ruleCurrencies\n  ]\n", "num_lines": 175}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.AmountOfMoney.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\nimport qualified Data.HashMap.Strict as H\n\nimport Duckling.Resolve (Resolve(..), Options(..))\n\ndata Currency\n  -- ambiguous\n  = Cent\n  | Dinar\n  | Dirham\n  | Dollar\n  | Pound\n  | Rial\n  | Riyal\n  | Unnamed -- e.g. bucks\n  -- unambiguous\n  | AED\n  | AUD\n  | BGN\n  | BRL\n  | BYN\n  | CAD\n  | CHF\n  | CNY\n  | CZK\n  | DKK\n  | EGP\n  | EUR\n  | GBP\n  | HKD\n  | HRK\n  | IDR\n  | ILS\n  | INR\n  | IQD\n  | JMD\n  | JOD\n  | JPY\n  | GEL\n  | KRW\n  | KWD\n  | LBP\n  | MAD\n  | MNT\n  | MYR\n  | NOK\n  | NZD\n  | PKR\n  | PLN\n  | PTS\n  | QAR\n  | RON\n  | RUB\n  | SAR\n  | SEK\n  | SGD\n  | THB\n  | TTD\n  | USD\n  | VND\n  | ZAR\n  | UAH\n  | TRY\n  deriving (Eq, Generic, Hashable, Show, Ord, NFData)\n\ninstance ToJSON Currency where\n  toJSON Cent    = \"cent\"\n  toJSON Dollar  = \"$\"\n  toJSON Pound   = \"\\x00a3\"\n  toJSON Dinar   = \"dinar\"\n  toJSON Dirham  = \"dirham\"\n  toJSON Rial    = \"rial\"\n  toJSON Riyal   = \"riyal\"\n  toJSON Unnamed = \"unknown\"\n  toJSON AED     = \"AED\"\n  toJSON AUD     = \"AUD\"\n  toJSON BGN     = \"BGN\"\n  toJSON BRL     = \"BRL\"\n  toJSON BYN     = \"BYN\"\n  toJSON CAD     = \"CAD\"\n  toJSON CHF     = \"CHF\"\n  toJSON CNY     = \"CNY\"\n  toJSON CZK     = \"CZK\"\n  toJSON DKK     = \"DKK\"\n  toJSON EGP     = \"EGP\"\n  toJSON EUR     = \"EUR\"\n  toJSON GBP     = \"GBP\"\n  toJSON HKD     = \"HKD\"\n  toJSON HRK     = \"HRK\"\n  toJSON IDR     = \"IDR\"\n  toJSON ILS     = \"ILS\"\n  toJSON IQD     = \"IQD\"\n  toJSON INR     = \"INR\"\n  toJSON JMD     = \"JMD\"\n  toJSON JOD     = \"JOD\"\n  toJSON JPY     = \"JPY\"\n  toJSON GEL     = \"GEL\"\n  toJSON KRW     = \"KRW\"\n  toJSON KWD     = \"KWD\"\n  toJSON LBP     = \"LBP\"\n  toJSON MAD     = \"MAD\"\n  toJSON MNT     = \"MNT\"\n  toJSON MYR     = \"MYR\"\n  toJSON NOK     = \"NOK\"\n  toJSON NZD     = \"NZD\"\n  toJSON PTS     = \"PTS\"\n  toJSON PKR     = \"PKR\"\n  toJSON PLN     = \"PLN\"\n  toJSON QAR     = \"QAR\"\n  toJSON RON     = \"RON\"\n  toJSON RUB     = \"RUB\"\n  toJSON SAR     = \"SAR\"\n  toJSON SEK     = \"SEK\"\n  toJSON SGD     = \"SGD\"\n  toJSON THB     = \"THB\"\n  toJSON TTD     = \"TTD\"\n  toJSON USD     = \"USD\"\n  toJSON VND     = \"VND\"\n  toJSON ZAR     = \"ZAR\"\n  toJSON UAH     = \"UAH\"\n  toJSON TRY     = \"TRY\"\n\ndata AmountOfMoneyData = AmountOfMoneyData\n  { value    :: Maybe Double\n  , currency :: Currency\n  , minValue :: Maybe Double\n  , maxValue :: Maybe Double\n  , latent   :: Bool\n  }\n  deriving (Eq, Generic, Hashable, Show, Ord, NFData)\n\ninstance Resolve AmountOfMoneyData where\n  type ResolvedValue AmountOfMoneyData = AmountOfMoneyValue\n  resolve _ Options {withLatent = False} AmountOfMoneyData {latent = True} =\n    Nothing\n  resolve _ _ AmountOfMoneyData {value = Nothing, minValue = Nothing\n                              , maxValue = Nothing} =\n    Nothing\n  resolve _ _ AmountOfMoneyData {value = Just value, currency, latent} =\n    Just (simple currency value, latent)\n  resolve _ _ AmountOfMoneyData {value = Nothing, currency = c\n                              , minValue = Just from, maxValue = Just to\n                              , latent} =\n    Just (between c (from, to), latent)\n  resolve _ _ AmountOfMoneyData {value = Nothing, currency = c\n                              , minValue = Just v, maxValue = Nothing\n                              , latent} =\n    Just (above c v, latent)\n  resolve _ _ AmountOfMoneyData {value = Nothing, currency = c\n                              , minValue = Nothing, maxValue = Just v\n                              , latent} =\n    Just (under c v, latent)\n\namountOfMoneyData' :: AmountOfMoneyData\namountOfMoneyData' = AmountOfMoneyData\n  { value = Nothing\n  , currency = Unnamed\n  , minValue = Nothing\n  , maxValue = Nothing\n  , latent = False\n  }\n\ndata IntervalDirection = Above | Under\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ndata SingleValue = SingleValue\n  { vCurrency :: Currency\n  , vValue    :: Double\n  }\n  deriving (Eq, Show)\n\ninstance ToJSON SingleValue where\n  toJSON SingleValue {vCurrency, vValue} = object\n    [ \"value\" .= vValue\n    , \"unit\"  .= vCurrency\n    ]\n\ndata AmountOfMoneyValue\n  = SimpleValue SingleValue\n  | IntervalValue (SingleValue, SingleValue)\n  | OpenIntervalValue (SingleValue, IntervalDirection)\n  deriving (Show, Eq)\n\ninstance ToJSON AmountOfMoneyValue where\n  toJSON (SimpleValue value) = case toJSON value of\n    Object o -> Object $ H.insert \"type\" (toJSON (\"value\" :: Text)) o\n    _ -> Object H.empty\n  toJSON (IntervalValue (from, to)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    , \"to\" .= toJSON to\n    ]\n  toJSON (OpenIntervalValue (from, Above)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    ]\n  toJSON (OpenIntervalValue (to, Under)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"to\" .= toJSON to\n    ]\n\n-- -----------------------------------------------------------------\n-- Value helpers\n\nsimple :: Currency -> Double -> AmountOfMoneyValue\nsimple c v = SimpleValue $ single c v\n\nbetween :: Currency -> (Double, Double) -> AmountOfMoneyValue\nbetween c (from, to) = IntervalValue (single c from, single c to)\n\nabove :: Currency -> Double -> AmountOfMoneyValue\nabove = openInterval Above\n\nunder :: Currency -> Double -> AmountOfMoneyValue\nunder = openInterval Under\n\nopenInterval :: IntervalDirection -> Currency -> Double -> AmountOfMoneyValue\nopenInterval direction c v = OpenIntervalValue (single c v, direction)\n\nsingle :: Currency -> Double -> SingleValue\nsingle c v = SingleValue {vCurrency = c, vValue = v}\n", "num_lines": 243}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.AR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale AR Nothing},\n  testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1)\n             [ \"$1\"\n             , \"1 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             ]\n  , examples (simple Dollar 10)\n             [ \"$10\"\n             , \"$ 10\"\n             , \"10 $\"\n             , \"10$\"\n             , \"10$\"\n             , \"10 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             , \"\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d8\u00a9 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\u00d8\u00a7\u00d8\u00aa\"\n             ]\n  , examples (simple Cent 10)\n             [ \"10 \u00d8\u00b3\u00d9\u2020\u00d8\u00aa\u00d8\u00a7\u00d8\u00aa\"\n             , \"10 \u00d8\u00b3\u00d9\u2020\u00d8\u00aa\"\n             , \"10 \u00d8\u00b3\u00d9\u0160\u00d9\u2020\u00d8\u00aa\"\n             , \"10 \u00d8\u00b3\u00d9\u0160\u00d9\u2020\u00d8\u00aa\u00d8\u00a7\u00d8\u00aa\"\n             , \"10 c\"\n             , \"10\u00c2\u00a2\"\n             ]\n  , examples (simple Dollar 1e4)\n             [ \"10000 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             , \"$10,000\"\n             , \"10000$\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20 \u00d9\u0160\u00d9\u02c6\u00d8\u00b1\u00d9\u02c6\"\n             , \"20 \u00d8\u00a7\u00d9\u02c6\u00d8\u00b1\u00d9\u02c6\"\n             , \"20 \u00d8\u00a3\u00d9\u02c6\u00d8\u00b1\u00d9\u02c6\"\n             , \"20\u00e2\u201a\u00ac\"\n             , \"20 \u00e2\u201a\u00ac\"\n             ]\n  , examples (simple Pound 10)\n             [ \"10 \u00d8\u00ac\u00d9\u2020\u00d9\u0160\u00d9\u2021\"\n             , \"10 \u00d8\u00ac\u00d9\u2020\u00d9\u0160\u00d9\u2021\u00d8\u00a7\u00d8\u00aa\"\n             ]\n  , examples (simple Dollar 20.43)\n             [ \"20$ \u00d9\u02c6 43c\"\n             , \"$20 43\"\n             , \"20$ 43c\"\n             , \"20 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1 \u00d9\u02c643 \u00d8\u00b3\u00d9\u2020\u00d8\u00aa\"\n             , \"20.43 $\"\n             ]\n  , examples (simple GBP 3)\n             [ \"3 \u00d8\u00ac\u00d9\u2020\u00d9\u0160\u00d9\u2021\u00d8\u00a7\u00d8\u00aa \u00d8\u00a7\u00d8\u00b3\u00d8\u00aa\u00d8\u00b1\u00d9\u201e\u00d9\u0160\u00d9\u2020\u00d9\u0160\u00d8\u00a9\"\n             , \"3 \u00d8\u00ac\u00d9\u2020\u00d9\u0160\u00d9\u2021 \u00d8\u00a7\u00d8\u00b3\u00d8\u00aa\u00d8\u00b1\u00d9\u201e\u00d9\u0160\u00d9\u2020\u00d9\u0160\"\n             ]\n  , examples (simple KWD 42)\n             [ \"42 KWD\"\n             , \"42 \u00d8\u00af\u00d9\u0160\u00d9\u2020\u00d8\u00a7\u00d8\u00b1 \u00d9\u0192\u00d9\u02c6\u00d9\u0160\u00d8\u00aa\u00d9\u0160\"\n             ]\n  , examples (simple LBP 42)\n             [ \"42 LBP\"\n             , \"42 \u00d9\u201e\u00d9\u0160\u00d8\u00b1\u00d8\u00a9 \u00d9\u201e\u00d8\u00a8\u00d9\u2020\u00d8\u00a7\u00d9\u2020\u00d9\u0160\u00d8\u00a9\"\n             , \"42 \u00d9\u201e\u00d9\u0160\u00d8\u00b1\u00d8\u00a7\u00d8\u00aa \u00d9\u201e\u00d8\u00a8\u00d9\u2020\u00d8\u00a7\u00d9\u2020\u00d9\u0160\u00d8\u00a9\"\n             ]\n  , examples (simple EGP 42)\n             [ \"42 EGP\"\n             , \"42 \u00d8\u00ac\u00d9\u2020\u00d9\u0160\u00d9\u2021 \u00d9\u2026\u00d8\u00b5\u00d8\u00b1\u00d9\u0160\"\n             , \"42 \u00d8\u00ac\u00d9\u2020\u00d9\u0160\u00d9\u2021\u00d8\u00a7\u00d8\u00aa \u00d9\u2026\u00d8\u00b5\u00d8\u00b1\u00d9\u0160\u00d9\u2021\"\n             , \"42 \u00d8\u00ac.\u00d9\u2026\"\n             , \"42 \u00d8\u00ac.\u00d9\u2026.\"\n             ]\n  , examples (simple QAR 42)\n             [ \"42 QAR\"\n             , \"42 \u00d8\u00b1\u00d9\u0160\u00d8\u00a7\u00d9\u201e \u00d9\u201a\u00d8\u00b7\u00d8\u00b1\u00d9\u0160\"\n             , \"42 \u00d8\u00b1\u00d9\u0160\u00d8\u00a7\u00d9\u201e\u00d8\u00a7\u00d8\u00aa \u00d9\u201a\u00d8\u00b7\u00d8\u00b1\u00d9\u0160\u00d8\u00a9\"\n             ]\n  , examples (simple SAR 42)\n             [ \"42 SAR\"\n             , \"42 \u00d8\u00b1\u00d9\u0160\u00d8\u00a7\u00d9\u201e \u00d8\u00b3\u00d8\u00b9\u00d9\u02c6\u00d8\u00af\u00d9\u0160\"\n             ]\n  , examples (between Dollar (10, 20))\n             [ \"\u00d9\u2026\u00d9\u2020 10 \u00d8\u00a7\u00d9\u201e\u00d9\u2030 20 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             , \"\u00d8\u00a8\u00d8\u00ad\u00d8\u00af\u00d9\u02c6\u00d8\u00af 10-20 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             , \"\u00d9\u2026\u00d8\u00a7 \u00d8\u00a8\u00d9\u0160\u00d9\u2020 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d8\u00a9 \u00d9\u02c6\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d9\u02c6\u00d9\u2020 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             , \"\u00d9\u2026\u00d9\u2020 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d8\u00a9 \u00d9\u201e\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d9\u0160\u00d9\u2020 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             , \"\u00d8\u00ad\u00d9\u02c6\u00d8\u00a7\u00d9\u201e\u00d9\u0160 10$-20$\"\n             , \"10-20 $\"\n             , \"10-20 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1\"\n             ]\n  , examples (under EUR 7)\n             [ \"\u00d8\u00aa\u00d8\u00ad\u00d8\u00aa \u00d8\u00b3\u00d8\u00a8\u00d8\u00b9\u00d8\u00a9 \u00d8\u00a7\u00d9\u02c6\u00d8\u00b1\u00d9\u02c6\"\n             , \"\u00d8\u00a7\u00d9\u201a\u00d9\u201e \u00d9\u2026\u00d9\u2020 \u00d8\u00b3\u00d8\u00a8\u00d8\u00b9\u00d8\u00a9 \u00d9\u0160\u00d9\u02c6\u00d8\u00b1\u00d9\u02c6\"\n             , \"\u00d8\u00a7\u00d9\u201a\u00d9\u201e \u00d9\u2026\u00d9\u2020 7 \u00d9\u0160\u00d9\u02c6\u00d8\u00b1\u00d9\u02c6\"\n             ]\n  , examples (above Dollar 3.42)\n             [ \"\u00d8\u00a7\u00d9\u0192\u00d8\u00ab\u00d8\u00b1 \u00d9\u2026\u00d9\u2020 \u00d8\u00ab\u00d9\u201e\u00d8\u00a7\u00d8\u00ab\u00d8\u00a9 \u00d8\u00af\u00d9\u02c6\u00d9\u201e\u00d8\u00a7\u00d8\u00b1 \u00d9\u02c642 \u00d8\u00b3\u00d9\u0160\u00d9\u2020\u00d8\u00aa\"\n             , \"3.42$ \u00d8\u00b9\u00d9\u201e\u00d9\u2030 \u00d8\u00a7\u00d9\u201e\u00d8\u00a7\u00d9\u201a\u00d9\u201e\"\n             ]\n  , examples (simple JOD 5)\n             [ \"5 \u00d8\u00af\u00d9\u0160\u00d9\u2020\u00d8\u00a7\u00d8\u00b1 \u00d8\u00a7\u00d8\u00b1\u00d8\u00af\u00d9\u2020\u00d9\u0160\"\n             , \"5 \u00d8\u00af\u00d9\u2020\u00d8\u00a7\u00d9\u2020\u00d9\u0160\u00d8\u00b1 \u00d8\u00a3\u00d8\u00b1\u00d8\u00af\u00d9\u2020\u00d9\u0160\u00d8\u00a9\"\n             ]\n  , examples (simple ILS 5)\n             [ \"5 \u00d8\u00b4\u00d9\u0160\u00d9\u201a\u00d9\u201e\"\n             , \"5 \u00d8\u00b4\u00d9\u02c6\u00d8\u00a7\u00d9\u201a\u00d9\u201e\"\n             , \"\u00d8\u00ae\u00d9\u2026\u00d8\u00b3\u00d8\u00a9 \u00d8\u00b4\u00d9\u0160\u00d9\u0192\u00d9\u201e\"\n             ]\n  ]\n", "num_lines": 129}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.CA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale CA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"deu dolars\"\n             , \"deu d\u00c3\u00b2lars\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             , \"vint euros\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             , \"29,99 euros\"\n             , \"29,99 \u00e2\u201a\u00ac\"\n             , \"29,99\u00e2\u201a\u00ac\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"nou lliures\"\n             , \"9 lliures\"\n             ]\n  ,examples (simple Pound 1)\n             [ \"\u00c2\u00a31\"\n             , \"una lliura\"\n             , \"1 lliura\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             , \"3 gbp 1 c\u00c3\u00a8ntims\"\n             , \"3 gbp i 1 c\u00c3\u00a8ntims\"\n             ]\n  , examples (simple PTS 15)\n             [ \"15 Pt\"\n             , \"15pta\"\n             , \"15Ptas\"\n             ]\n  , examples (between Dollar (10, 20))\n             [ \"entre 10 i 20 d\u00c3\u00b2lars\"\n             , \"des de $10 fins a $20\"\n             , \"10$ - 20 dolars\"\n             , \"10 - 20 $\"\n             ]\n  , examples (under Dollar 10)\n             [ \"menys de 10 dolars\"\n             , \"no m\u00c3\u00a9s de 10$\"\n             ]\n  , examples (above Dollar 10)\n             [ \"no menys de 10 d\u00c3\u00b2lars\"\n             , \"m\u00c3\u00a9s de 10$\"\n             ]\n  ]\n", "num_lines": 91}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.CA.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just $ Token AmountOfMoney $ withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleDollar :: Rule\nruleDollar = Rule\n  { name = \"dollar\"\n  , pattern =\n    [ regex \"d(\u00c3\u00b2|o|\u00c3\u00b3)lar(s)?\"\n    ]\n  , prod = \\_ -> Just $ Token AmountOfMoney $ currencyOnly Dollar\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"c(e|\u00c3\u00a8)ntims?\"\n    ]\n  , prod = \\_ -> Just $ Token AmountOfMoney $ currencyOnly Cent\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"(lliure|lliura)s?\"\n    ]\n  , prod = \\_ -> Just $ Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"i\"\n    , Predicate isNatural\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"i\"\n    , Predicate isCents\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"des de|des d'|entre\"\n    , Predicate isPositive\n    , regex \"fins a|i\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"des de|des d'|entre\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"fins a|i\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                                             TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) | from < to->\n         Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                                             TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"less/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"menys de|no m(e|\u00c3\u00a9)s de|no m(e|\u00c3\u00a9)s d'|menys d'\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) -> Just $ Token AmountOfMoney $ withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"no less/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"m(e|\u00c3\u00a9)s de|no menys de|m(e|\u00c3\u00a9)s d'|no menys d'\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) -> Just $ Token AmountOfMoney $ withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleCent\n  , ruleDollar\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , rulePounds\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , ruleIntervalMax\n  , ruleIntervalMin\n  ]\n", "num_lines": 255}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.Corpus\n  ( corpus\n  , negativeCorpus\n  , latentCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Resolve (Options(..))\nimport Duckling.Testing.Types\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"exactly dollars\"\n      ]\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nlatentCorpus :: Corpus\nlatentCorpus = (testContext, testOptions {withLatent = True}, xs)\n  where\n    xs = concat\n      [ examples (simple Unnamed 5)\n                 [ \"five\"\n                 , \"5\"\n                 , \"about 5\"\n                 ]\n      , examples (simple Unnamed 7.2)\n                 [ \"7.2\"\n                 , \"7.20000\"\n                 ]\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1)\n             [ \"$1\"\n             , \"one dollar\"\n             , \"a dollar\"\n             ]\n  , examples (simple Dollar 10)\n             [ \"$10\"\n             , \"$ 10\"\n             , \"10$\"\n             , \"10 dollars\"\n             , \"ten dollars\"\n             ]\n  , examples (simple Cent 10)\n             [ \"10 cent\"\n             , \"ten pennies\"\n             , \"ten cents\"\n             , \"10 c\"\n             , \"10\u00c2\u00a2\"\n             ]\n  , examples (simple Dollar 1e4)\n             [ \"$10K\"\n             , \"10k$\"\n             , \"$10,000\"\n             ]\n  , examples (simple USD 3.14)\n             [ \"USD3.14\"\n             , \"3.14US$\"\n             , \"US$ 3.14\"\n             , \"US$3 and fourteen\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\\x20ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             , \"EUR 20.0\"\n             , \"20\u00e2\u201a\u00ac\"\n             , \"20 \u00e2\u201a\u00acur\"\n             ]\n  , examples (simple Pound 10)\n             [ \"\\x00a3\\&10\"\n             , \"ten pounds\"\n             ]\n  , examples (simple INR 20)\n             [ \"Rs. 20\"\n             , \"Rs 20\"\n             , \"20 Rupees\"\n             , \"20Rs\"\n             , \"Rs20\"\n             ]\n  , examples (simple INR 20.43)\n             [ \"20 Rupees 43\"\n             , \"twenty rupees 43\"\n             ]\n  , examples (simple Dollar 20.43)\n             [ \"$20 and 43c\"\n             , \"$20 43\"\n             , \"20 dollar 43c\"\n             , \"20 dollars 43 cents\"\n             , \"twenty dollar 43 cents\"\n             , \"20 dollar 43\"\n             , \"twenty dollar and 43\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3.01\"\n             , \"GBP 3.01\"\n             , \"3 GBP 1 pence\"\n             , \"3 GBP and one\"\n             ]\n  , examples (simple CAD 3.03)\n             [ \"CAD3.03\"\n             , \"CAD 3.03\"\n             , \"3 CAD 3 cents\"\n             ]\n  , examples (simple CHF 3.04)\n             [ \"CHF3.04\"\n             , \"CHF 3.04\"\n             , \"3 CHF 4 cents\"\n             ]\n  , examples (simple CNY 3)\n             [ \"CNY3\"\n             , \"CNY 3\"\n             , \"3 CNY\"\n             , \"3 yuan\"\n             ]\n  , examples (simple Unnamed 42)\n             [ \"42 bucks\"\n             , \"around 42 bucks\"\n             , \"exactly 42 bucks\"\n             ]\n  , examples (simple KWD 42)\n             [ \"42 KWD\"\n             , \"42 kuwaiti Dinar\"\n             ]\n  , examples (simple LBP 42)\n             [ \"42 LBP\"\n             , \"42 Lebanese Pounds\"\n             ]\n  , examples (simple EGP 42)\n             [ \"42 EGP\"\n             , \"42 egyptianpound\"\n             , \"42 LE\"\n             , \"42 L.E\"\n             , \"42 l.e.\"\n             , \"42 le\"\n             , \"42 geneh\"\n             , \"42 genihat masriya\"\n             ]\n  , examples (simple QAR 42)\n             [ \"42 QAR\"\n             , \"42 qatari riyals\"\n             ]\n  , examples (simple SAR 42)\n             [ \"42 SAR\"\n             , \"42 Saudiriyal\"\n             ]\n  , examples (simple BGN 42)\n             [ \"42 BGN\"\n             ]\n  , examples (simple MYR 42)\n             [ \"42 MYR\"\n             , \"42 RM\"\n             , \"RM 42\"\n             , \"MYR 42\"\n             , \"42MYR\"\n             , \"42RM\"\n             , \"RM42\"\n             , \"MYR42\"\n             , \"ringgit 42\"\n             , \"42 ringgit\"\n             , \"42 malaysia ringgit\"\n             , \"malaysia ringgit 42\"\n             , \"42 malaysian ringgit\"\n             , \"malaysian ringgit 42\"\n             , \"42 malaysia ringgits\"\n             , \"malaysia ringgits 42\"\n             , \"42 malaysian ringgits\"\n             , \"malaysian ringgits 42\"\n             ]\n  , examples (simple MYR 20.43)\n             [ \"20 ringgit and 43c\"\n             , \"20 ringgit and 43 sen\"\n             , \"twenty ringgit 43 sens\"\n             , \"20 ringgit 43\"\n             , \"twenty ringgit and 43\"\n             ]\n  , examples (simple Dinar 10)\n             [ \"10 dinars\"\n             ]\n  , examples (simple ILS 10)\n             [ \"ten shekels\"\n             , \"10 ILS\"\n             ]\n  , examples (simple Riyal 10)\n             [ \"ten riyals\"\n             , \"10 riyals\"\n             ]\n  , examples (simple Rial 10)\n             [ \"ten rials\"\n             , \"10 rials\"\n             ]\n  , examples (between Dollar (10, 20))\n             [ \"between 10 and 20 dollars\"\n             , \"from 10 dollars to 20 dollars\"\n             , \"around 10-20 dollars\"\n             , \"between 10 dollars and 20 dollars\"\n             , \"from 10 to 20 dollars\"\n             , \"about $10-$20\"\n             , \"10-20 dollars\"\n             ]\n  , examples (between Dollar (1.1, 1.3))\n             [ \"between 1.1 and 1.3 dollars\"\n             , \"from 1 point 1 and one point three dollars\"\n             ]\n  , examples (under EUR 7)\n             [ \"under seven euros\"\n             , \"less than 7 EUR\"\n             , \"lower than 7\u00e2\u201a\u00ac\"\n             , \"no more than 7 euros\"\n             , \"at most 7\u00e2\u201a\u00ac\"\n             ]\n  , examples (above Dollar 1.42)\n             [ \"more than 1 dollar and forty-two cents\"\n             , \"at least $1.42\"\n             , \"over 1.42 dollars\"\n             , \"above a dollar and 42 cents\"\n             , \"no less than $1.42\"\n             ]\n   , examples (simple INR 5e5)\n             [ \"5 lakh rupees\"\n             , \"five lakhs rupees\"\n             ]\n   , examples (between INR (7, 9e5))\n             [ \"7-9 lakh rupees\"\n             ]\n   , examples (simple INR 4e7)\n             [ \"four crore rupees\"\n             , \"4 crores rupees\"\n             ]\n   , examples (simple MNT 10)\n             [ \"ten tugriks\"\n             , \"10 Tugrik\"\n             , \"10MNT\"\n             ]\n   , examples (simple USD 4.7e9)\n             [ \"US$4.7 billion\"\n             , \"a US$4.7 billion\"\n             , \"a US$ 4.7 billion\"\n             ]\n  , examples (simple UAH 3.04)\n             [ \"UAH3.04\"\n             , \"UAH 3.04\"\n             , \"3 UAH 4 kopiykas\"\n             ]\n  ]\n", "num_lines": 266}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"pounds?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleOtherPounds :: Rule\nruleOtherPounds = Rule\n  { name = \"other pounds\"\n  , pattern =\n    [ regex \"(egyptian|lebanese) ?pounds?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"egyptian\" -> Just . Token AmountOfMoney $ currencyOnly EGP\n        \"lebanese\" -> Just . Token AmountOfMoney $ currencyOnly LBP\n        _          -> Nothing\n      _ -> Nothing\n  }\n\nruleEgpAbrreviation :: Rule\nruleEgpAbrreviation = Rule\n  { name = \"livre \u00c3\u00a9gyptienne\"\n  , pattern =\n    [ regex \"[lL].?[eE].?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly EGP\n  }\n\nruleEgpArabizi :: Rule\nruleEgpArabizi = Rule\n  { name = \"geneh\"\n  , pattern =\n    [ regex \"[Gg][eiy]*n[eiy]*h(at)?( m[aiey]?sr[eiy]+a?)?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly EGP\n  }\n\nruleRiyals :: Rule\nruleRiyals = Rule\n  { name = \"riyals\"\n  , pattern =\n    [ regex \"(qatari|saudi) ?riyals?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"qatari\" -> Just . Token AmountOfMoney $ currencyOnly QAR\n        \"saudi\"  -> Just . Token AmountOfMoney $ currencyOnly SAR\n        _        -> Nothing\n      _ -> Nothing\n  }\n\nruleDinars :: Rule\nruleDinars = Rule\n  { name = \"dinars\"\n  , pattern =\n    [ regex \"(kuwaiti) ?dinars?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"kuwaiti\" -> Just . Token AmountOfMoney $ currencyOnly KWD\n        _         -> Nothing\n      _ -> Nothing\n  }\n\nruleDirham :: Rule\nruleDirham = Rule\n  { name = \"dirham\"\n  , pattern =\n    [ regex \"dirhams?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly AED\n  }\n\nruleRinggit :: Rule\nruleRinggit = Rule\n  { name = \"ringgit\"\n  , pattern =\n    [ regex \"(malaysian? )?ringgits?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly MYR\n  }\n\nruleHryvnia :: Rule\nruleHryvnia = Rule\n  { name = \"hryvnia\"\n  , pattern =\n      [ regex \"hryvnia\" -- TODO: complete\n      ]\n  , prod = \\_ -> Just $ Token AmountOfMoney $ currencyOnly UAH\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cents?|penn(y|ies)|pence|sens?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleKopiyka :: Rule\nruleKopiyka = Rule\n  { name = \"kopiyka\"\n  , pattern =\n    [ regex \"kopiy(ok|kas?)\"\n    ]\n  , prod = \\_ -> Just $ Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleBucks :: Rule\nruleBucks = Rule\n  { name = \"bucks\"\n  , pattern =\n    [ regex \"bucks?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Unnamed\n  }\n\nruleACurrency :: Rule\nruleACurrency = Rule\n  { name = \"a <currency>\"\n  , pattern =\n    [ regex \"an?\"\n    , Predicate isCurrencyOnly\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney fd:\n       _) -> Just . Token AmountOfMoney $ fd {TAmountOfMoney.value = Just 1}\n      _ -> Nothing\n  }\n\nruleAbsorbA :: Rule\nruleAbsorbA = Rule\n  { name = \"a <amount-of-money>\"\n  , pattern =\n    [ regex \"an?\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:Token AmountOfMoney fd:_) -> Just $ Token AmountOfMoney fd\n      _ -> Nothing\n  }\n\nruleADollarCoin :: Rule\nruleADollarCoin = Rule\n  { name = \"a <dollar coin>\"\n  , pattern =\n    [ regex \"an?\"\n    , Predicate isDollarCoin\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney fd:\n       _) -> Just . Token AmountOfMoney $ fd\n      _ -> Nothing\n  }\n\nruleNumDollarCoins :: Rule\nruleNumDollarCoins = Rule\n  { name = \"X <dollar coins>\"\n  , pattern =\n    [ Predicate isNatural\n    , Predicate isDollarCoin\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = c}:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just d,\n                                             TAmountOfMoney.currency = cur}:\n       _) -> Just . Token AmountOfMoney $ withValue (c * d) $ currencyOnly cur\n      _ -> Nothing\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"and\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"and\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about|exactly <amount-of-money>\"\n  , pattern =\n    [ regex \"exactly|precisely|about|approx(\\\\.|imately)?|close to|near( to)?|around|almost\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"between|from\"\n    , Predicate isPositive\n    , regex \"to|and\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"between|from\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"to|and\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to->\n         Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"under|at most|(less|lower|not? more) than\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"over|above|at least|(more|not? less) than\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleACurrency\n  , ruleAbsorbA\n  , ruleBucks\n  , ruleCent\n  , ruleADollarCoin\n  , ruleNumDollarCoins\n  , ruleDinars\n  , ruleDirham\n  , ruleHryvnia\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , ruleKopiyka\n  , ruleOtherPounds\n  , ruleEgpAbrreviation\n  , ruleEgpArabizi\n  , rulePounds\n  , rulePrecision\n  , ruleRinggit\n  , ruleRiyals\n  ]\n", "num_lines": 433}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.AU.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple AUD 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple AUD 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple AUD 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple AUD 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple AUD 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple AUD 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.AU.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000 $ currencyOnly AUD\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v) $ currencyOnly AUD\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly AUD\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 72}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.BZ.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple Dollar 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple Dollar 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple Dollar 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple Dollar 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.BZ.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000\n                 $ currencyOnly Dollar\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v)\n           $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.CA.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple CAD 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple CAD 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple CAD 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple CAD 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple CAD 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple CAD 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.CA.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000 $ currencyOnly CAD\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v) $ currencyOnly CAD\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly CAD\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 72}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.GB.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple GBP 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple GBP 10000)\n             [ \"10 grand\"\n             ]\n  , examples (simple Dollar 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple Dollar 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple Dollar 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple Dollar 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.GB.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000 $ currencyOnly GBP\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v) $ currencyOnly GBP\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 72}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.IE.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple Dollar 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple Dollar 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple Dollar 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple Dollar 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.IE.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000\n                 $ currencyOnly Dollar\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v)\n           $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 75}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.IN.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple Dollar 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple Dollar 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple Dollar 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple Dollar 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.IN.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000 $ currencyOnly Dollar\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v) $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 72}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.JM.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple JMD 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple JMD 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple JMD 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple JMD 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple JMD 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple JMD 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.JM.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000\n                 $ currencyOnly JMD\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v)\n           $ currencyOnly JMD\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly JMD\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.NZ.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple NZD 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple NZD 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple NZD 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple NZD 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple NZD 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple NZD 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.NZ.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000\n                 $ currencyOnly NZD\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v)\n           $ currencyOnly NZD\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly NZD\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.PH.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple Dollar 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple Dollar 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple Dollar 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple Dollar 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.PH.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000\n                 $ currencyOnly Dollar\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v)\n           $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) dollarCoins\n        Just . Token AmountOfMoney . withValue c $ Helpers.currencyOnly Dollar\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.TT.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple TTD 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple TTD 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple TTD 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple TTD 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple TTD 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple TTD 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.TT.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000\n                 $ currencyOnly TTD\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v)\n           $ currencyOnly TTD\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly TTD\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.US.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple USD 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple USD 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple USD 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple USD 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple USD 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple USD 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.US.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000 $ currencyOnly USD\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v) $ currencyOnly USD\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly USD\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 72}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.ZA.Corpus\n  ( allExamples\n  , negativeExamples\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1000)\n             [ \"a grand\"\n             , \"1 grand\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"10 grand\"\n             , \"two hundred thousand nickels\"\n             ]\n  , examples (simple Dollar 1)\n             [ \"four quarters\"\n             , \"ten dimes\"\n             , \"twenty nickels\"\n             ]\n  , examples (simple Dollar 0.1)\n             [ \"dime\"\n             , \"a dime\"\n             , \"two nickels\"\n             ]\n  , examples (simple Dollar 0.25)\n             [ \"quarter\"\n             , \"a quarter\"\n             , \"five nickels\"\n             ]\n  , examples (simple Dollar 0.05)\n             [ \"nickel\"\n             , \"a nickel\"\n             ]\n  ]\n\nnegativeExamples :: [Text]\nnegativeExamples =\n  [ \"grand\"\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.EN.ZA.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..))\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Duckling.AmountOfMoney.Helpers as Helpers\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleAGrand :: Rule\nruleAGrand = Rule\n  { name = \"a grand\"\n  , pattern =\n    [ regex \"a grand\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney . withValue 1000\n                 $ currencyOnly Dollar\n  }\n\nruleGrand :: Rule\nruleGrand = Rule\n  { name = \"<amount> grand\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"grand\"\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:_)\n        -> Just . Token AmountOfMoney . withValue (1000 * v)\n           $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nruleDollarCoin :: Rule\nruleDollarCoin = Rule\n  { name = \"dollar coin\"\n  , pattern =\n    [ regex \"(nickel|dime|quarter)s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        c <- HashMap.lookup (Text.toLower match) Helpers.dollarCoins\n        Just . Token AmountOfMoney . withValue c $ currencyOnly Dollar\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAGrand\n  , ruleGrand\n  , ruleDollarCoin\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.ES.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ES Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"diez dollars\"\n             , \"diez d\u00c3\u00b3lares\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"nueve pounds\"\n             , \"9 libras\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             , \"3 gbp 1 centavo\"\n             , \"3 gbp y 1 centavo\"\n             ]\n  , examples (simple PTS 15)\n             [ \"15 Pt\"\n             , \"15pta\"\n             , \"15Ptas\"\n             ]\n  , examples (between Dollar (10, 20))\n             [ \"entre 10 y 20 d\u00c3\u00b3lares\"\n             , \"de $10 y $20\"\n             , \"$10 - 20 d\u00c3\u00b3lares\"\n             , \"10 - 20 $\"\n             ]\n  , examples (under Dollar 10)\n             [ \"menos de 10 d\u00c3\u00b3lares\"\n             , \"no m\u00c3\u00a1s de $10\"\n             ]\n  , examples (above Dollar 10)\n             [ \"no menos de 10 d\u00c3\u00b3lares\"\n             , \"m\u00c3\u00a1s de $10\"\n             ]\n  ]\n", "num_lines": 82}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.ES.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleDollar :: Rule\nruleDollar = Rule\n  { name = \"dollar\"\n  , pattern =\n    [ regex \"d(\u00c3\u00b3|o)lar(es)?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Dollar\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"centavos?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"(pound|libra)s?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"y\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"y\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"de|entre\"\n    , Predicate isPositive\n    , regex \"a|y\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"de|entre\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"a|y\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                                             TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) | from < to->\n         Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                                             TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just $ Token AmountOfMoney $ withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"less/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"menos de|no m\u00c3\u00a1s de\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) -> Just $ Token AmountOfMoney $ withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"no less/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"m\u00c3\u00a1s de|no menos de\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                                             TAmountOfMoney.currency = c}:\n       _) -> Just $ Token AmountOfMoney $ withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleCent\n  , ruleDollar\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , rulePounds\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , ruleIntervalMax\n  , ruleIntervalMin\n  ]\n", "num_lines": 255}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.FR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"dix dollars\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             , \"10 000 dollars\"\n             , \"10 000,00 $\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             , \"1 USD et 23 centimes\"\n             , \"1 USD 23 cents\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple Unnamed 3)\n             [ \"3 balles\"\n             , \"\u00c3\u00a0 peu pr\u00c3\u00a8s 3 pouloutes\"\n             ]\n  , examples (simple Pound 9)\n             [ \"exactement \u00c2\u00a39\"\n             , \"neuf pounds\"\n             , \"quasi neuf livres\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             ]\n  , examples (simple ILS 10)\n             [ \"dix shekels\"\n             ]\n  , examples (simple Rial 10)\n             [ \"dix rials\"\n             ]\n  , examples (simple Riyal 10)\n             [ \"dix riyals\"\n             ]\n  , examples (between EUR (10, 20))\n             [ \"entre 10 et 20 euro\"\n             , \"entre 10 euro et 20 euro\"\n             , \"10 - 20 euro\"\n             , \"10 euro - 20 euro\"\n             ]\n  , examples (above EUR 10)\n             [ \"au moins 10 euro\"\n             , \"plus que 10 euros\"\n             , \"plus de 10 euros\"\n             ]\n  , examples (under Dollar 10)\n             [ \"en-dessous de 10 dollars\"\n             , \"moins de 10 dollars\"\n             , \"pas plus de 10 dollars\"\n             ]\n  ]\n", "num_lines": 93}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.FR.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency (..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"et\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"precision\"\n  , pattern =\n    [ regex \"exactement|quasi|plus ou moins|environ|autour de|(a|\u00c3\u00a0) peu pr(e|\u00c3\u00a8)s\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cent(ime)?s?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"entre\"\n    , Predicate isPositive\n    , regex \"et\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"entre\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"et\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData {\n         TAmountOfMoney.value = Just from,\n         TAmountOfMoney.currency = c1\n       }:\n       _:\n       Token AmountOfMoney AmountOfMoneyData {\n         TAmountOfMoney.value = Just to,\n         TAmountOfMoney.currency = c2\n       }:\n       _) | c1 == c2, from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n         Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"(moins|pas plus|en-dessous) de\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"plus (que|de)|au moins\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"(livre|pound)s?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"et\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleUnnamedCurrency :: Rule\nruleUnnamedCurrency = Rule\n  { name = \"unnamed currencyOnly\"\n  , pattern =\n    [ regex \"(balle|pouloute)s?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Unnamed\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleCent\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , ruleIntervalBetween\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalDash\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  , rulePounds\n  , rulePrecision\n  , ruleUnnamedCurrency\n  ]\n", "num_lines": 274}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.GA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"deich dollair\"\n             ]\n  , examples (simple Cent 10)\n             [ \"deich ceinteanna\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10,000\"\n             , \"10K$\"\n             , \"$10k\"\n             ]\n  , examples (simple EUR 10000)\n             [ \"\u00e2\u201a\u00ac10,000\"\n             , \"10K\u00e2\u201a\u00ac\"\n             , \"\u00e2\u201a\u00ac10k\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1.23\"\n             ]\n  , examples (simple Dollar 2.23)\n             [ \"2 dhollair agus 23 ceinteanna\"\n             , \"dh\u00c3\u00a1 dhollair 23 ceinteanna\"\n             , \"2 dhollair 23\"\n             , \"dh\u00c3\u00a1 dhollair agus 23\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29.99\"\n             ]\n  , examples (simple INR 20)\n             [ \"Rs. 20\"\n             , \"Rs 20\"\n             , \"20 R\u00c3\u00bapa\u00c3\u00ad\"\n             , \"20Rs\"\n             , \"Rs20\"\n             ]\n  , examples (simple INR 20.43)\n             [ \"20 Rupees 43\"\n             , \"fiche r\u00c3\u00bapa\u00c3\u00ad 43\"\n             ]\n  , examples (simple INR 33)\n             [ \"INR33\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"naoi bpunt\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3.01\"\n             , \"GBP 3.01\"\n             ]\n  ]\n", "num_lines": 87}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.GA.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency (..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleDollar :: Rule\nruleDollar = Rule\n  { name = \"$\"\n  , pattern =\n    [ regex \"n?dh?oll?ai?rs?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Dollar\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cents?|g?ch?eint(eanna)?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleThartArAmountofmoney :: Rule\nruleThartArAmountofmoney = Rule\n  { name = \"thart ar <amount-of-money>\"\n  , pattern =\n    [ regex \"thart( ar)?|beagnach|breis (is|agus)\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"pounds?|b?ph?unt\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"agus|is\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleInr :: Rule\nruleInr = Rule\n  { name = \"INR\"\n  , pattern =\n    [ regex \"r(\u00c3\u00ba|u)pa(\u00c3\u00ad|i)\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly INR\n  }\n\nruleIntersectAgusNumeral :: Rule\nruleIntersectAgusNumeral = Rule\n  { name = \"intersect (agus number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"agus|is\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleAmountofmoneyGlan :: Rule\nruleAmountofmoneyGlan = Rule\n  { name = \"<amount-of-money> glan\"\n  , pattern =\n    [ Predicate isMoneyWithValue\n    , regex \"glan|baileach|(go )?d(\u00c3\u00ad|i)reach\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> Just token\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleAmountofmoneyGlan\n  , ruleCent\n  , ruleDollar\n  , ruleInr\n  , ruleIntersect\n  , ruleIntersectAgusNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , rulePounds\n  , ruleThartArAmountofmoney\n  ]\n", "num_lines": 177}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.HR.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleACurrency :: Rule\nruleACurrency = Rule\n  { name = \"a <currency>\"\n  , pattern =\n    [ regex \"jed(an|na|no)\"\n    , Predicate isCurrencyOnly\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney $ withValue 1 $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntersectAndNumber :: Rule\nruleIntersectAndNumber = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"i\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleSar :: Rule\nruleSar = Rule\n  { name = \"SAR\"\n  , pattern =\n    [ regex \"saudijskirijal|saudi rijal?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly SAR\n  }\n\nruleDollar :: Rule\nruleDollar = Rule\n  { name = \"$\"\n  , pattern =\n    [ regex \"dolar(a|i|e)?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Dollar\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cent(i|a)?|penij(i|a)?|c|\u00c2\u00a2|lp|lip(a|e)\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleIntersectIXLipa :: Rule\nruleIntersectIXLipa = Rule\n  { name = \"intersect (i X lipa)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"i\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePound :: Rule\nrulePound = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"funt(a|e|i)?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleHrk :: Rule\nruleHrk = Rule\n  { name = \"HRK\"\n  , pattern =\n    [ regex \"kn|(hrvatsk(a|ih|e) )?kun(a|e)\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly HRK\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleOtherPounds :: Rule\nruleOtherPounds = Rule\n  { name = \"other pounds\"\n  , pattern =\n    [ regex \"(egipatska|libanonska) ?funta\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"egipatska\"  -> Just . Token AmountOfMoney $ currencyOnly EGP\n        \"libanonska\" -> Just . Token AmountOfMoney $ currencyOnly LBP\n        _            -> Nothing\n      _ -> Nothing\n  }\n\nruleInr :: Rule\nruleInr = Rule\n  { name = \"INR\"\n  , pattern =\n    [ regex \"rupija?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly INR\n  }\n\nruleKwd :: Rule\nruleKwd = Rule\n  { name = \"KWD\"\n  , pattern =\n    [ regex \"kuvajtski ?dinar\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly KWD\n  }\n\nruleQar :: Rule\nruleQar = Rule\n  { name = \"QAR\"\n  , pattern =\n    [ regex \"katarski(i| )rijal\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly QAR\n  }\n\nruleAed :: Rule\nruleAed = Rule\n  { name = \"AED\"\n  , pattern =\n    [ regex \"drahma?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly AED\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about|exactly <amount-of-money>\"\n  , pattern =\n    [ regex \"oko|otprilike|u blizini|skoro|pribli\u00c5\u00beno\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to->\n         Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral1 :: Rule\nruleIntervalBetweenNumeral1 = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"od|otprilike|pribli\u00c5\u00beno\"\n    , Predicate isPositive\n    , regex \"do\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral2 :: Rule\nruleIntervalBetweenNumeral2 = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"izmedju\"\n    , Predicate isPositive\n    , regex \"i\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetween1 :: Rule\nruleIntervalBetween1 = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"od|otprilike\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"do\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalBetween2 :: Rule\nruleIntervalBetween2 = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"izmedju\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"i\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"vi\u00c5\u00a1e od|najmanje|preko|iznad\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"ispod|manje od\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\n\nrules :: [Rule]\nrules =\n  [ ruleACurrency\n  , ruleUnitAmount\n  , ruleDollar\n  , rulePound\n  , ruleOtherPounds\n  , ruleAed\n  , ruleCent\n  , ruleHrk\n  , ruleInr\n  , ruleIntersect\n  , ruleIntersectAndNumber\n  , ruleIntersectIXLipa\n  , ruleIntersectXCents\n  , ruleKwd\n  , ruleQar\n  , ruleSar\n  , rulePrecision\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , ruleIntervalBetweenNumeral1\n  , ruleIntervalBetweenNumeral2\n  , ruleIntervalBetween1\n  , ruleIntervalBetween2\n  , ruleIntervalMin\n  , ruleIntervalMax\n  ]\n", "num_lines": 404}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.ID.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ID Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"sepuluh dolar\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             ]\n  , examples (simple Dollar 2)\n             [ \"2 dolar\"\n             , \"dua dolar\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             , \"dua puluh Euro\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple IDR 315)\n             [ \"Rp. 315,00\"\n             ]\n  , examples (simple IDR 20)\n             [ \"Rp 20\"\n             , \"20 Rupiah\"\n             , \"20Rp\"\n             , \"Rp20\"\n             ]\n  , examples (simple IDR 33000)\n             [ \"IDR33000\"\n             , \"IDR 33.000\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"sembilan pound\"\n             , \"sembilan pound sterling\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             ]\n  , examples (simple JPY 10)\n             [ \"10 yen\"\n             , \"10\u00c2\u00a5\"\n             , \"10 \u00c2\u00a5.\"\n             ]\n  , examples (between Dollar(10, 20))\n             [ \"antara 10 sampai 20 dolar\"\n             , \"dari 10 dolar sampai 20 dolar\"\n             , \"sekitar 10 sampai 20 dolar\"\n             , \"antara 10 hingga 20 dolar\"\n             , \"sekitar 10 dolar hingga 20 dolar\"\n             , \"kira-kira 10-20 dolar\"\n             , \"10-20 dolar\"\n             ]\n  , examples (between IDR(1000, 10000))\n             [ \"antara Rp1000 sampai Rp10000\"\n             , \"dari 1000 Rupiah hingga 10000 Rupiah\"\n             , \"sekitar 1000 sampai 10000 Rupiah\"\n             , \"1000-10000 Rupiah\"\n             , \"kira-kira Rp1000 sampai Rp10000\"\n             , \"dari Rp1.000 sampai Rp10.000\"\n             , \"antara 1.000 hingga 10.000 Rupiah\"\n             , \"kira-kira 1.000-10.000 Rupiah\"\n             , \"sekitar 1.000 hingga 10.000 Rupiah\"\n             ]\n  , examples (under EUR 7)\n             [ \"kurang dari 7 euro\"\n             , \"di bawah EUR 7\"\n             , \"tidak sampai 7 euro\"\n             , \"lebih murah dari EUR 7\"\n             ]\n  , examples (under IDR 500)\n             [ \"kurang dari 500 Rupiah\"\n             , \"tidak sampai Rp500\"\n             , \"di bawah Rp 500\"\n             , \"lebih murah dari 500 rupiah\"\n             ]\n  , examples (above USD 1.42)\n             [ \"di atas USD1,42\"\n             , \"lebih dari USD1,42\"\n             , \"melebihi USD1,42\"\n             , \"melewati USD1,42\"\n             ]\n  , examples (above IDR 33000)\n             [ \"di atas 33.000 Rupiah\"\n             , \"lebih dari Rp33000\"\n             , \"melebihi Rp33.000\"\n             , \"melewati 33000 rupiah\"\n             ]\n  ]\n", "num_lines": 127}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.ID.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData(..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleDollar :: Rule\nruleDollar = Rule\n  { name = \"$\"\n  , pattern =\n    [ regex \"dolar?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Dollar\n  }\n\nruleIdr :: Rule\nruleIdr = Rule\n  { name = \"IDR\"\n  , pattern =\n    [ regex \"rp\\\\.?|rupiah\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly IDR\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"pound( sterling)?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleJpy :: Rule\nruleJpy = Rule\n  { name = \"JPY\"\n  , pattern =\n    [ regex \"\u00c2\u00a5\\\\.\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly JPY\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about|exactly <amount-of-money>\"\n  , pattern =\n    [ regex \"tepatnya|kira-kira|sekitar|hampir\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"sekitar|dari|antara\"\n    , Predicate isPositive\n    , regex \"sampai|hingga\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"sekitar|dari|antara|kira-kira\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"sampai|hingga\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"\\\\-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n         Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"\\\\-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"(kurang|lebih murah) dari|tidak sampai|di bawah\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"di atas|lebih dari|melebihi|melewati\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\case\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleDollar\n  , ruleIdr\n  , ruleIntersect\n  , ruleJpy\n  , rulePounds\n  , rulePrecision\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  ]\n", "num_lines": 229}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.IT.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"dieci dollari\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             , \"10 000 dollari\"\n             , \"10 000,00 $\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             , \"1 USD e 23 centesimi\"\n             , \"1 USD 23 centesimi\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euro\"\n             , \"20 Euro\"\n             , \"20 Euro\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple Pound 9)\n             [ \"nove sterline\"\n             , \"quasi nove sterline\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             ]\n  , examples (between EUR (10, 20))\n             [ \"tra 10 e 20 euro\"\n             , \"tra 10 euro e 20 euro\"\n             , \"10 - 20 euro\"\n             , \"10 euro - 20 euro\"\n             ]\n  , examples (above EUR 10)\n             [ \"almeno 10 euro\"\n             , \"pi\u00c3\u00b9 di 10 euro\"\n             , \"pi\u00c3\u00b9 di 10 euro\"\n             ]\n  , examples (under Dollar 10)\n             [ \"meno di 10 dollari\"\n             , \"non pi\u00c3\u00b9 di 10 dollari\"\n             ]\n  ]\n", "num_lines": 78}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.IT.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency (..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types (GroupMatch (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"e\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"precision\"\n  , pattern =\n    [ regex \"esattamente|quasi|pi\u00c3\u00b9 o meno|circa\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cent(esim)i?o?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"tra\"\n    , Predicate isPositive\n    , regex \"e\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"tra\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"e\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData {\n         TAmountOfMoney.value = Just from,\n         TAmountOfMoney.currency = c1\n       }:\n       _:\n       Token AmountOfMoney AmountOfMoneyData {\n         TAmountOfMoney.value = Just to,\n         TAmountOfMoney.currency = c2\n       }:\n       _) | c1 == c2, from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n         Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"(meno|non pi\u00c3\u00b9) di\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"pi\u00c3\u00b9 di|almeno\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleCurrencies :: Rule\nruleCurrencies = Rule\n  { name = \"\u00c2\u00a3, $\"\n  , pattern =\n    [ regex \"(dollari|sterline)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"dollari\"  -> Just . Token AmountOfMoney $ currencyOnly Dollar\n        \"sterline\" -> Just . Token AmountOfMoney $ currencyOnly Pound\n        _          -> Nothing\n      _ -> Nothing\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"e\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleCent\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , ruleIntervalBetween\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalDash\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  , ruleCurrencies\n  , rulePrecision\n  ]\n", "num_lines": 271}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.NB.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NB Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"ti dollar\"\n             ]\n  , examples (simple Cent 10)\n             [ \"ti \u00c3\u00b8re\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             ]\n  , examples (simple NOK 10)\n             [ \"10kroner\"\n             , \"10kr\"\n             , \"ti kroner\"\n             , \"10 NOK\"\n             , \"ti norske kroner\"\n             ]\n  , examples (simple SEK 10)\n             [ \"10kronor\"\n             , \"10 svenske kroner\"\n             , \"10 svenske kr\"\n             , \"10 svenske kronor\"\n             , \"ti kronor\"\n             ]\n  , examples (simple DKK 10)\n             [ \"10 danske kroner\"\n             , \"ti danske kroner\"\n             , \"ti danske kr\"\n             ]\n  , examples (simple AUD 10)\n             [ \"10 australske dollar\"\n             , \"10 australske dollars\"\n             ]\n  , examples (simple CAD 10)\n             [ \"10 kanadiske dollar\"\n             , \"10 kanadiske dollars\"\n             , \"10 canadiske dollar\"\n             , \"10 canadiske dollars\"\n             ]\n  , examples (simple CHF 10)\n             [ \"10 sveitsiske franc\"\n             , \"10 sveitsiske francs\"\n             ]\n  , examples (simple CNY 10)\n             [ \"10 yuan\"\n             , \"10 kinesiske yuan\"\n             , \"10 kinesisk yuan\"\n             , \"10 renminbi\"\n             , \"10 kinesiske renminbi\"\n             , \"10 kinesisk renminbi\"\n             ]\n  , examples (simple CZK 10)\n             [ \"10 koruna\"\n             , \"10 tsjekkiske koruna\"\n             ]\n  , examples (simple INR 10)\n             [ \"10 rupi\"\n             , \"10 rupier\"\n             , \"10 rupee\"\n             , \"10 rupees\"\n             , \"10 indisk rupi\"\n             , \"10 indiske rupi\"\n             , \"10 indiske rupee\"\n             , \"10 indiske rupees\"\n             , \"10 indiske rupier\"\n             , \"10 indisk rupier\"\n             , \"ti rupi\"\n             , \"ti rupier\"\n             , \"ti indisk rupi\"\n             , \"ti indiske rupi\"\n             , \"ti indiske rupee\"\n             , \"ti indiske rupees\"\n             , \"ti indiske rupier\"\n             , \"ti indisk rupier\"\n             ]\n  , examples (simple JPY 10)\n             [ \"10 japanske yen\"\n             , \"10 yen\"\n             , \"ti japanske yen\"\n             , \"ti yen\"\n             ]\n  , examples (simple PKR 10)\n             [ \"10 pakistansk rupi\"\n             , \"10 pakistanske rupi\"\n             , \"10 pakistanske rupee\"\n             , \"10 pakistanske rupees\"\n             , \"10 pakistanske rupier\"\n             , \"10 pakistansk rupier\"\n             , \"ti pakistansk rupi\"\n             , \"ti pakistanske rupi\"\n             , \"ti pakistanske rupee\"\n             , \"ti pakistanske rupees\"\n             , \"ti pakistanske rupier\"\n             , \"ti pakistansk rupier\"\n             ]\n  , examples (simple PLN 10)\n             [ \"10 zloty\"\n             , \"10 sloty\"\n             , \"10 polske zloty\"\n             , \"10 polske sloty\"\n             , \"ti zloty\"\n             , \"ti sloty\"\n             , \"ti polske zloty\"\n             , \"ti polske sloty\"\n             ]\n  , examples (simple SGD 10)\n             [ \"10 singapore dollar\"\n             , \"10 singapore dollars\"\n             , \"10 singaporske dollar\"\n             , \"10 singaporske dollars\"\n             , \"ti singapore dollar\"\n             , \"ti singapore dollars\"\n             , \"ti singaporske dollar\"\n             , \"ti singaporske dollars\"\n             ]\n  , examples (simple THB 10)\n             [ \"10 bhat\"\n             , \"10 thai baht\"\n             , \"10 thai bhat\"\n             , \"10 thailand baht\"\n             , \"10 thailand bhat\"\n             , \"10 thailandske baht\"\n             , \"10 thailandske bhat\"\n             , \"ti baht\"\n             , \"ti bhat\"\n             , \"ti thai baht\"\n             , \"ti thai bhat\"\n             , \"ti thailand baht\"\n             , \"ti thailand bhat\"\n             , \"ti thailandske baht\"\n             , \"ti thailandske bhat\"\n             ]\n  , examples (simple ZAR 10)\n             [ \"10 rand\"\n             , \"10 s\u00c3\u00b8rafrikanske rand\"\n             , \"10 s\u00c3\u00b8r-afrikanske rand\"\n             , \"10 rand\"\n             , \"10 s\u00c3\u00b8rafrikanske rand\"\n             , \"10 s\u00c3\u00b8r-afrikanske rand\"\n             , \"ti rand\"\n             , \"ti s\u00c3\u00b8rafrikanske rand\"\n             , \"ti s\u00c3\u00b8r-afrikanske rand\"\n             ]\n  , examples (simple NOK 2.23)\n             [ \"2 kroner og 23 \u00c3\u00b8re\"\n             , \"to kroner 23 \u00c3\u00b8re\"\n             , \"to kroner og 23 \u00c3\u00b8re\"\n             , \"to kr 23\"\n             ]\n  , examples (simple SEK 2.23)\n             [ \"2 kronor og 23 \u00c3\u00b6re\"\n             , \"to kronor 23 \u00c3\u00b6re\"\n             , \"to svenske kronor 23 \u00c3\u00b6re\"\n             , \"to svenske kroner 23 \u00c3\u00b6re\"\n             , \"to svenske kroner 23 \u00c3\u00b8re\"\n             , \"to kronor og 23 \u00c3\u00b6re\"\n             , \"to svenske kronor og 23 \u00c3\u00b6re\"\n             , \"to svenske kroner og 23 \u00c3\u00b6re\"\n             , \"to svenske kroner og 23 \u00c3\u00b8re\"\n             , \"to svensk kroner og 23 \u00c3\u00b8re\"\n             ]\n  , examples (simple DKK 2.23)\n             [ \"2 danske kroner og 23 \u00c3\u00b8re\"\n             , \"to danske kroner 23 \u00c3\u00b8re\"\n             , \"to danske kroner og 23 \u00c3\u00b8re\"\n             , \"to danske kr 23\"\n             , \"to dansk kr 23\"\n             ]\n  , examples (simple USD 2.23)\n             [ \"2 amerikanske dollar og 23 cent\"\n             , \"2 amerikanske dollars og 23 cent\"\n             , \"2 amerikanske dollar og 23 cents\"\n             , \"2 amerikanske dollars og 23 cents\"\n             , \"to amerikanske dollar 23 cent\"\n             , \"to amerikanske dollars 23 cent\"\n             , \"to amerikanske dollar 23 cents\"\n             , \"to amerikanske dollars 23 cents\"\n             , \"to amerikanske dollar og 23 cent\"\n             , \"to amerikanske dollars og 23 cent\"\n             , \"to amerikanske dollar og 23 cents\"\n             , \"to amerikanske dollars og 23 cents\"\n             , \"to amerikanske dollar 23\"\n             , \"to amerikanske dollars 23\"\n             ]\n  , examples (simple AUD 2.23)\n             [ \"2 australske dollar og 23 cent\"\n             , \"2 australske dollars og 23 cent\"\n             , \"2 australske dollar og 23 cents\"\n             , \"2 australske dollars og 23 cents\"\n             , \"to australske dollar 23 cent\"\n             , \"to australske dollars 23 cent\"\n             , \"to australske dollar 23 cents\"\n             , \"to australske dollars 23 cents\"\n             , \"to australske dollar og 23 cent\"\n             , \"to australske dollars og 23 cent\"\n             , \"to australske dollar og 23 cents\"\n             , \"to australske dollars og 23 cents\"\n             , \"to australske dollar 23\"\n             , \"to australske dollars 23\"\n             ]\n  , examples (simple CAD 2.23)\n             [ \"2 kanadiske dollar og 23 cent\"\n             , \"2 kanadiske dollars og 23 cent\"\n             , \"2 canadiske dollar og 23 cent\"\n             , \"2 canadiske dollars og 23 cent\"\n             , \"2 kanadiske dollar og 23 cents\"\n             , \"2 kanadiske dollars og 23 cents\"\n             , \"2 canadiske dollar og 23 cents\"\n             , \"2 canadiske dollars og 23 cents\"\n             , \"to kanadiske dollar 23 cent\"\n             , \"to kanadiske dollars 23 cent\"\n             , \"to canadiske dollar 23 cent\"\n             , \"to canadiske dollars 23 cent\"\n             , \"to kanadiske dollar 23 cents\"\n             , \"to kanadiske dollars 23 cents\"\n             , \"to canadiske dollar 23 cents\"\n             , \"to canadiske dollars 23 cents\"\n             , \"to kanadiske dollar og 23 cent\"\n             , \"to kanadiske dollars og 23 cent\"\n             , \"to canadiske dollar og 23 cent\"\n             , \"to canadiske dollars og 23 cent\"\n             , \"to kanadiske dollar og 23 cents\"\n             , \"to kanadiske dollars og 23 cents\"\n             , \"to canadiske dollar og 23 cents\"\n             , \"to canadiske dollars og 23 cents\"\n             , \"to kanadiske dollar 23\"\n             , \"to kanadiske dollars 23\"\n             , \"to canadiske dollar 23\"\n             , \"to canadiske dollars 23\"\n             ]\n  , examples (simple CHF 2.23)\n             [ \"2 sveitsiske franc og 23 rappen\"\n             , \"2 sveitsiske francs og 23 rappen\"\n             , \"2 sveitsiske franc og 23 rp\"\n             , \"2 sveitsiske francs og 23 rp\"\n             , \"2 sveitsiske franc og 23 centime\"\n             , \"2 sveitsiske francs og 23 centime\"\n             , \"2 sveitsiske franc og 23 c\"\n             , \"2 sveitsiske francs og 23 c\"\n             , \"2 sveitsiske franc og 23 centesimo\"\n             , \"2 sveitsiske francs og 23 centesimo\"\n             , \"2 sveitsiske franc og 23 ct\"\n             , \"2 sveitsiske francs og 23 ct\"\n             , \"2 sveitsiske franc og 23 rap\"\n             , \"2 sveitsiske francs og 23 rap\"\n             , \"to sveitsiske franc 23 rappen\"\n             , \"to sveitsiske francs 23 rappen\"\n             , \"to sveitsiske franc 23 rp\"\n             , \"to sveitsiske francs 23 rp\"\n             , \"to sveitsiske franc 23 centime\"\n             , \"to sveitsiske francs 23 centime\"\n             , \"to sveitsiske franc 23 c\"\n             , \"to sveitsiske francs 23 c\"\n             , \"to sveitsiske franc 23 centesimo\"\n             , \"to sveitsiske francs 23 centesimo\"\n             , \"to sveitsiske franc 23 ct\"\n             , \"to sveitsiske francs 23 ct\"\n             , \"to sveitsiske franc 23 rap\"\n             , \"to sveitsiske francs 23 rap\"\n             , \"to sveitsiske franc og 23 rappen\"\n             , \"to sveitsiske francs og 23 rappen\"\n             , \"to sveitsiske franc og 23 rp\"\n             , \"to sveitsiske francs og 23 rp\"\n             , \"to sveitsiske franc og 23 centime\"\n             , \"to sveitsiske francs og 23 centime\"\n             , \"to sveitsiske franc og 23 c\"\n             , \"to sveitsiske francs og 23 c\"\n             , \"to sveitsiske franc og 23 centesimo\"\n             , \"to sveitsiske francs og 23 centesimo\"\n             , \"to sveitsiske franc og 23 ct\"\n             , \"to sveitsiske francs og 23 ct\"\n             , \"to sveitsiske franc og 23 rap\"\n             , \"to sveitsiske francs og 23 rap\"\n             , \"to sveitsiske franc 23\"\n             , \"to sveitsiske francs 23\"\n             ]\n  , examples (simple CNY 2.23)\n             [ \"2 yuan og 23 fen\"\n             , \"2 kinesiske yuan og 23 fen\"\n             , \"2 renminbi og 23 fen\"\n             , \"2 kinesiske renminbi og 23 fen\"\n             , \"to yuan 23 fen\"\n             , \"to kinesiske yuan 23 fen\"\n             , \"to renminbi 23 fen\"\n             , \"to kinesiske renminbi 23 fen\"\n             , \"to yuan og 23 fen\"\n             , \"to kinesiske yuan og 23 fen\"\n             , \"to renminbi og 23 fen\"\n             , \"to kinesiske renminbi og 23 fen\"\n             , \"to yuan 23\"\n             , \"to kinesiske yuan 23\"\n             , \"to renminbi 23\"\n             , \"to kinesiske renminbi 23\"\n             ]\n  , examples (simple CZK 2.23)\n             [ \"2 koruna og 23 haleru\"\n             , \"2 tsjekkiske koruna og 23 haleru\"\n             , \"to koruna 23 haleru\"\n             , \"to tsjekkiske koruna 23 haleru\"\n             , \"to koruna og 23 haleru\"\n             , \"to tsjekkiske koruna og 23 haleru\"\n             , \"to koruna 23\"\n             , \"to tsjekkiske koruna 23\"\n             ]\n  , examples (simple HKD 2.23)\n             [ \"2 hong kong dollar og 23 cent\"\n             , \"2 hong kong dollar og 23 cents\"\n             , \"2 hong kong dollars og 23 cent\"\n             , \"2 hong kong dollars og 23 cents\"\n             , \"2 hong kong dollar og 23 cents\"\n             , \"2 hong kong dollars og 23 cents\"\n             , \"to hong kong dollar 23 cent\"\n             , \"to hong kong dollars 23 cent\"\n             , \"to hong kong dollar 23 cents\"\n             , \"to hong kong dollars 23 cents\"\n             , \"to hong kong dollar og 23 cent\"\n             , \"to hong kong dollars og 23 cent\"\n             , \"to hong kong dollar og 23 cents\"\n             , \"to hong kong dollars og 23 cents\"\n             , \"to hong kong dollar 23\"\n             , \"to hong kong dollars 23\"\n             ]\n  , examples (simple INR 2.23)\n             [ \"2 indiske rupi og 23 paise\"\n             , \"2 indiske rupier og 23 paise\"\n             , \"to indiske rupi 23 paise\"\n             , \"to indiske rupier 23 paise\"\n             , \"to indiske rupier 23 paise\"\n             , \"to indiske rupi og 23 paise\"\n             , \"to indiske rupier og 23 paise\"\n             , \"to indiske rupi 23\"\n             , \"to indiske rupier 23\"\n             ]\n  , examples (simple NZD 2.23)\n             [ \"2 new zealand dollar og 23 cent\"\n             , \"2 new zealand dollars og 23 cent\"\n             , \"2 new zealand dollars og 23 cents\"\n             , \"2 new zealandske dollar og 23 cent\"\n             , \"2 new zealandske dollars og 23 cent\"\n             , \"2 new zealandske dollars og 23 cents\"\n             , \"2 new zealand dollar og 23 cents\"\n             , \"2 new zealand dollars og 23 cents\"\n             , \"2 nz dollar og 23 cents\"\n             , \"2 nz dollars og 23 cents\"\n             , \"to new zealand dollar 23 cent\"\n             , \"to new zealand dollars 23 cent\"\n             , \"to new zealand dollars 23 cents\"\n             , \"to new zealandske dollar 23 cent\"\n             , \"to new zealandske dollars 23 cent\"\n             , \"to new zealandske dollars 23 cents\"\n             , \"to new zealand dollar 23 cents\"\n             , \"to new zealand dollars 23 cents\"\n             , \"to new zealand dollars 23 cent\"\n             , \"to new zealand dollar og 23 cent\"\n             , \"to new zealand dollars og 23 cent\"\n             , \"to new zealandske dollar og 23 cent\"\n             , \"to new zealandske dollars og 23 cent\"\n             , \"to new zealandske dollars og 23 cents\"\n             , \"to new zealand dollar og 23 cents\"\n             , \"to new zealand dollars og 23 cent\"\n             , \"to new zealand dollars og 23 cents\"\n             , \"to new zealand dollar 23\"\n             , \"to new zealand dollars 23\"\n             , \"to new zealandske dollar 23\"\n             , \"to new zealandske dollars 23\"\n             , \"to nz dollar 23\"\n             , \"to nz dollars 23\"\n             ]\n  , examples (simple PLN 2.23)\n             [ \"2 zloty og 23 groszy\"\n             , \"2 sloty og 23 groszy\"\n             , \"2 polske zloty og 23 groszy\"\n             , \"2 polske sloty og 23 groszy\"\n             , \"to zloty 23 groszy\"\n             , \"to sloty 23 groszy\"\n             , \"to polske zloty 23 groszy\"\n             , \"to polske sloty 23 groszy\"\n             , \"to zloty og 23 groszy\"\n             , \"to sloty og 23 groszy\"\n             , \"to polske zloty og 23 groszy\"\n             , \"to polske sloty og 23 groszy\"\n             , \"to zloty 23\"\n             , \"to sloty 23\"\n             , \"to polske zloty 23\"\n             , \"to polske sloty 23\"\n             ]\n  , examples (simple SGD 2.23)\n             [ \"2 singapore dollar og 23 cent\"\n             , \"2 singapore dollars og 23 cent\"\n             , \"2 singaporske dollar og 23 cent\"\n             , \"2 singaporske dollars og 23 cent\"\n             , \"2 singapore dollar og 23 cents\"\n             , \"2 singapore dollars og 23 cents\"\n             , \"to singapore dollar 23 cent\"\n             , \"to singapore dollars 23 cent\"\n             , \"to singaporske dollar 23 cent\"\n             , \"to singaporske dollars 23 cent\"\n             , \"to singapore dollar 23 cents\"\n             , \"to singapore dollars 23 cents\"\n             , \"to singapore dollar og 23 cent\"\n             , \"to singapore dollars og 23 cent\"\n             , \"to singaporske dollar og 23 cent\"\n             , \"to singaporske dollars og 23 cent\"\n             , \"to singapore dollar og 23 cents\"\n             , \"to singapore dollars og 23 cents\"\n             , \"to singapore dollar 23\"\n             , \"to singapore dollars 23\"\n             , \"to singaporske dollar 23\"\n             , \"to singaporske dollars 23\"\n             ]\n  , examples (simple ZAR 2.23)\n             [ \"2 rand og 23 cent\"\n             , \"2 s\u00c3\u00b8rafrikanske rand og 23 cent\"\n             , \"2 s\u00c3\u00b8rafrikanske rand og 23 cents\"\n             , \"2 s\u00c3\u00b8r-afrikanske rand og 23 cent\"\n             , \"2 s\u00c3\u00b8r-afrikanske rand og 23 cents\"\n             , \"to rand 23 cent\"\n             , \"to s\u00c3\u00b8rafrikanske rand 23 cent\"\n             , \"to s\u00c3\u00b8rafrikanske rand 23 cents\"\n             , \"to s\u00c3\u00b8r-afrikanske rand 23 cent\"\n             , \"to s\u00c3\u00b8r-afrikanske rand 23 cents\"\n             , \"to rand og 23 cent\"\n             , \"to s\u00c3\u00b8rafrikanske rand og 23 cent\"\n             , \"to s\u00c3\u00b8rafrikanske rand og 23 cents\"\n             , \"to s\u00c3\u00b8r-afrikanske rand og 23 cent\"\n             , \"to s\u00c3\u00b8r-afrikanske rand og 23 cents\"\n             , \"to rand 23\"\n             , \"to s\u00c3\u00b8rafrikanske rand 23\"\n             , \"to s\u00c3\u00b8r-afrikanske rand 23\"\n             ]\n  , examples (simple THB 2.23)\n             [ \"2 baht og 23 satang\"\n             , \"2 bhat og 23 satang\"\n             , \"2 thai baht og 23 satang\"\n             , \"2 thai bhat og 23 satang\"\n             , \"2 thailandske baht og 23 satang\"\n             , \"2 thailandske bhat og 23 satang\"\n             , \"to baht 23 satang\"\n             , \"to bhat 23 satang\"\n             , \"to thai baht 23 satang\"\n             , \"to thai bhat 23 satang\"\n             , \"to thailandske baht 23 satang\"\n             , \"to thailandske bhat 23 satang\"\n             , \"to baht og 23 satang\"\n             , \"to bhat og 23 satang\"\n             , \"to thai baht og 23 satang\"\n             , \"to thai bhat og 23 satang\"\n             , \"to thailandske baht og 23 satang\"\n             , \"to thailandske bhat og 23 satang\"\n             , \"to baht 23\"\n             , \"to bhat 23\"\n             , \"to thai baht 23\"\n             , \"to thai bhat 23\"\n             , \"to thailandske baht 23\"\n             , \"to thailandske bhat 23\"\n             ]\n  , examples (simple Cent 10)\n             [ \"ti cent\"\n             , \"ti cents\"\n             , \"ti pence\"\n             , \"ti penny\"\n             , \"ti pennies\"\n             , \"10 cent\"\n             , \"10 cents\"\n             , \"10 cents\"\n             , \"10 pence\"\n             , \"10 penny\"\n             , \"10 \u00c3\u00b8re\"\n             , \"10 \u00c3\u00b8rer\"\n             , \"10 \u00c3\u00b6re\"\n             , \"10 \u00c3\u00b6rer\"\n             , \"10 p\"\n             , \"10 c\"\n             , \"10 fen\"\n             , \"10 haleru\"\n             , \"10 groszy\"\n             , \"10 paise\"\n             , \"10 paisa\"\n             , \"10 centesimo\"\n             , \"10 centesimi\"\n             , \"10 centime\"\n             , \"10 centimes\"\n             , \"10 ct\"\n             , \"10 rap\"\n             , \"10 rappen\"\n             , \"10 rappens\"\n             , \"10 rp\"\n             , \"10 satang\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euro\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple INR 20)\n             [ \"Rs. 20\"\n             , \"Rs 20\"\n             , \"20 Rupees\"\n             , \"20Rs\"\n             , \"Rs20\"\n             , \"INR20\"\n             ]\n  , examples (simple INR 20.43)\n             [ \"20 Rupees 43\"\n             , \"tjue rupees 43\"\n             , \"tjue rupees 43\u00c2\u00a2\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"ni pund\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             ]\n  ]\n", "num_lines": 554}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.NB.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency (..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just $ Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"og\"\n    , Predicate isNatural\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleAboutAmountofmoney :: Rule\nruleAboutAmountofmoney = Rule\n  { name = \"about <amount-of-money>\"\n  , pattern =\n    [ regex \"omtrent|cirka|rundt|ca\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cent(?:\\\\b|s)|\\\\bc\\\\b|pen(?:ce|ny|nies)|\\\\bp\\\\b|(?:\u00c3\u00b8|\u00c3\u00b6)rer?|fen|haleru|groszy|pais(?:e|a)\\\n           \\|centesim(?:o|i)|centimes?|\\\\bct?\\\\b|\\\\brp?\\\\b|rap(?:pen)?s?|satang\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleNok :: Rule\nruleNok = Rule\n  { name = \"NOK\"\n  , pattern =\n    [ regex \"(?:norske? ?)?kr(?:oner?)?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly NOK\n  }\n\nrulePound :: Rule\nrulePound = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"po?und?s?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"og\"\n    , Predicate isCents\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\case\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleDirham :: Rule\nruleDirham = Rule\n  { name = \"AED\"\n  , pattern =\n    [ regex \"dirhams?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly AED\n  }\n\nruleSEK :: Rule\nruleSEK = Rule\n  { name = \"SEK\"\n  , pattern =\n    [ regex \"(?:svenske? )?kron(?:a|or)|svenske? kr(?:oner?)?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly SEK\n  }\n\nruleGBP :: Rule\nruleGBP = Rule\n  { name = \"GBP\"\n  , pattern =\n    [ regex \"(?:britiske?|engelske?) po?unds?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly GBP\n  }\n\nruleDKK :: Rule\nruleDKK = Rule\n  { name = \"DKK\"\n  , pattern =\n    [ regex \"danske? kr(?:oner?)?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly DKK\n  }\n\nruleUSD :: Rule\nruleUSD = Rule\n  { name = \"USD\"\n  , pattern =\n    [ regex \"amerikanske? dollars?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly USD\n  }\n\nruleAUD :: Rule\nruleAUD = Rule\n  { name = \"AUD\"\n  , pattern =\n    [ regex \"australske? dollars?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly AUD\n  }\n\nruleCAD :: Rule\nruleCAD = Rule\n  { name = \"CAD\"\n  , pattern =\n    [ regex \"(?:k|c)anadiske? dollars?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly CAD\n  }\n\nruleCHF :: Rule\nruleCHF = Rule\n  { name = \"CHF\"\n  , pattern =\n    [ regex \"sveitsiske? francs?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly CHF\n  }\n\nruleCNY :: Rule\nruleCNY = Rule\n  { name = \"CNY\"\n  , pattern =\n    [ regex \"(?:kinesiske? )?(?:yuan|renminbi)\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly CNY\n  }\n\nruleCZK :: Rule\nruleCZK = Rule\n  { name = \"CZK\"\n  , pattern =\n    [ regex \"(?:tsjekkiske? )?koruna\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly CZK\n  }\n\nruleHKD :: Rule\nruleHKD = Rule\n  { name = \"HKD\"\n  , pattern =\n    [ regex \"hong kong dollars?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly HKD\n  }\n\nruleINR :: Rule\nruleINR = Rule\n  { name = \"INR\"\n  , pattern =\n    [ regex \"(?:indiske? )?rup(?:i(?:er)?|ees?)\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly INR\n  }\n\nruleJPY :: Rule\nruleJPY = Rule\n  { name = \"JPY\"\n  , pattern =\n    [ regex \"japanske? yen\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly JPY\n  }\n\nruleNZD :: Rule\nruleNZD = Rule\n  { name = \"NZD\"\n  , pattern =\n    [ regex \"(?:nz|new zealand(?:ske)?) dollars?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly NZD\n  }\n\nrulePKR :: Rule\nrulePKR = Rule\n  { name = \"PKR\"\n  , pattern =\n    [ regex \"pakistanske? rup(?:i(?:er)?|ees?)\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly PKR\n  }\n\nrulePLN :: Rule\nrulePLN = Rule\n  { name = \"PLN\"\n  , pattern =\n    [ regex \"(?:polske? )?(?:z|s)?lotys?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly PLN\n  }\n\nruleSGD :: Rule\nruleSGD = Rule\n  { name = \"SGD\"\n  , pattern =\n    [ regex \"singapor(?:e|ske?) dollars?\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly SGD\n  }\n\nruleTHB :: Rule\nruleTHB = Rule\n  { name = \"THB\"\n  , pattern =\n    [ regex \"(?:thai(?:land(?:ske?)?)? )?b(?:ah|ha)t\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly THB\n  }\n\nruleZAR :: Rule\nruleZAR = Rule\n  { name = \"ZAR\"\n  , pattern =\n    [ regex \"(?:s\u00c3\u00b8r(?: |-)?afrika(?:nske?)? )?rand\"\n    ]\n  , prod = const $ Just $ Token AmountOfMoney $ currencyOnly ZAR\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleAboutAmountofmoney\n  , ruleCent\n  , ruleDirham\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , ruleNok\n  , rulePound\n  , ruleSEK\n  , ruleDKK\n  , ruleUSD\n  , ruleAUD\n  , ruleCAD\n  , ruleGBP\n  , ruleCHF\n  , ruleCNY\n  , ruleCZK\n  , ruleHKD\n  , ruleINR\n  , ruleJPY\n  , ruleNZD\n  , rulePKR\n  , rulePLN\n  , ruleSGD\n  , ruleTHB\n  , ruleZAR\n  ]\n", "num_lines": 345}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.NL.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 1)\n             [ \"$1\"\n             , \"1 dollar\"\n             ]\n  , examples (simple Dollar 10)\n             [ \"$10\"\n             , \"$ 10\"\n             , \"10$\"\n             , \"10 dollars\"\n             , \"tien dollar\"\n             ]\n  , examples (simple Cent 10)\n             [ \"10 cent\"\n             , \"tien pennies\"\n             , \"tien cents\"\n             , \"10 c\"\n             , \"10\u00c2\u00a2\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10K\"\n             , \"10k$\"\n             , \"$10000\"\n             , \"$10.000\"\n             , \"$10.000,00\"\n             , \"10000,00 $\"\n             ]\n  , examples (simple USD 3.14)\n             [ \"USD3,14\"\n             , \"3,14US$\"\n             , \"US$ 3,14\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\\x20ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             , \"EUR 20,0\"\n             , \"20\u00e2\u201a\u00ac\"\n             , \"20 \u00e2\u201a\u00acur\"\n             ]\n  , examples (simple Dollar 20.43)\n             [ \"$20 en 43c\"\n             , \"$20,43\"\n             , \"20 dollar 43c\"\n             , \"20 dollars 43 cents\"\n             , \"20 dollar 43\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             , \"3 GBP een penny\"\n             ]\n  , examples (simple Unnamed 42)\n             [ \"42 bucks\"\n             , \"ongeveer twee-en-veertig bucks\"\n             , \"precies 42 bucks\"\n             ]\n  , examples (between Dollar (10, 20))\n             [ \"vanaf 10 dollars tot 20 dollars\"\n             , \"rond de 10-20 dollars\"\n             , \"tussen 10 dollars en 20 dollars\"\n             , \"ongeveer $10-$20\"\n             , \"10-20 dollars\"\n             ]\n  , examples (between Dollar (1.1, 1.3))\n             [ \"tussen 1,1 dollar en 1,3 dollars\"\n             , \"van 1,1$ en 1,3 dollars\"\n             ]\n  , examples (under EUR 7)\n             [ \"minder dan 7 euros\"\n             , \"minder dan zeven EUR\"\n             , \"lager dan 7\u00e2\u201a\u00ac\"\n             ]\n  , examples (above Dollar 1.42)\n             [ \"meer dan 1 dollar en 42 cents\"\n             , \"minstens $1,42\"\n             , \"boven de 1,42 dollars\"\n             , \"boven de 1 dollar en 42 cents\"\n             ]\n  ]\n", "num_lines": 108}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.NL.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"pou?nds?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cents?|penn(y|ies)|pence|sens?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleBucks :: Rule\nruleBucks = Rule\n  { name = \"bucks\"\n  , pattern =\n    [ regex \"bucks?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Unnamed\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"en\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"en\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about|exactly <amount-of-money>\"\n  , pattern =\n    [ regex \"precies|ongeveer|over|dicht|bijna|in de buurt|rond de\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"tussen|vanaf|van\"\n    , Predicate isPositive\n    , regex \"tot|en\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"tussen|vanaf|van\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"tot|en\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"\\\\-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n         Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"\\\\-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"(minder|lager|niet? meer) dan\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"boven de|minstens|meer dan\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleBucks\n  , ruleCent\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , rulePounds\n  , rulePrecision\n  ]\n", "num_lines": 270}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.PT.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"dez dolares\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euros\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"nove libras\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             ]\n  , examples (simple PTS 15)\n             [ \"15 Pt\"\n             , \"15pta\"\n             , \"15Ptas\"\n             ]\n  , examples (simple BRL 15)\n             [ \"15 reais\"\n             , \"15reais\"\n             , \"15 Reais\"\n             , \"BRL 15\"\n             ]\n  , examples (simple BRL 2.0)\n             [ \"R$2,00\"\n             , \"R$ 2,00\"\n             , \"2,00 reais\"\n             ]\n  ]\n", "num_lines": 75}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.PT.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"e\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleDollar :: Rule\nruleDollar = Rule\n  { name = \"$\"\n  , pattern =\n    [ regex \"dolares?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Dollar\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"centavos?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"libras?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"e\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleBrl :: Rule\nruleBrl = Rule\n  { name = \"BRL\"\n  , pattern =\n    [ regex \"reais|r\\\\$\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly BRL\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleBrl\n  , ruleCent\n  , ruleDollar\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , rulePounds\n  ]\n", "num_lines": 151}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.RO.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext {locale = makeLocale RO Nothing}\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (context, testOptions, examples)\n  where\n    examples =\n      [ \"10 de dolari\"\n      ]\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple RON 10)\n             [ \"10 lei\"\n             , \"10 roni\"\n             , \"10 RON\"\n             ]\n  , examples (simple Cent 50)\n             [ \"50 de bani\"\n             , \"50 DE BANI\"\n             ]\n  , examples (simple RON 10.5)\n             [ \"10,5 lei\"\n             , \"10,5 ron\"\n             , \"10 lei si 50 bani\"\n             ]\n  , examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"zece dolari\"\n             , \"10 dolari\"\n             ]\n  , examples (simple Cent 10)\n             [ \"zece centi\"\n             , \"zece cen\u00c8\u203ai\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"$10000\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             ]\n  , examples (simple Dollar 1)\n             [ \"1 dolar\"\n             , \"un dolar\"\n             , \"$1\"\n             ]\n  , examples (simple Cent 2)\n             [ \"2 centi\"\n             ]\n  , examples (simple Cent 23)\n             [ \"23 de centi\"\n             ]\n  , examples (simple Dollar 2.23)\n             [ \"2 dolari si 23 de centi\"\n             , \"2 dolari \u00c8\u2122i 23 de cen\u00c8\u203ai\"\n             , \"doi dolari si dou\u00c4\u0192zeci si trei de centi\"\n             , \"doi dolari \u00c8\u2122i dou\u00c4\u0192zeci \u00c8\u2122i trei de cen\u00c8\u203ai\"\n             , \"2 dolari 23 de centi\"\n             , \"doi dolari si 23\"\n             , \"doi dolari \u00c8\u2122i 23\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 de euro\"\n             , \"20 de Euro\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"noua lir\"\n             , \"nou\u00c4\u0192 lire\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             ]\n  , examples (simple QAR 1)\n             [ \"un rial qatarian\"\n             , \"1 rial qataria\"\n             ]\n  , examples (simple EGP 10)\n             [ \"zece lira egiptiana\"\n             ]\n  , examples (simple LBP 1)\n             [ \"una lir\u00c4\u0192 libanez\u00c4\u0192\"\n             ]\n  , examples (simple INR 42)\n             [ \"42 de rupii\"\n             , \"Rs. 42\"\n             ]\n  , examples (simple KWD 1)\n             [ \"un dinar kuweitian\"\n             ]\n  , examples (simple AED 2)\n             [ \"2 dirhami\"\n             ]\n  , examples (simple SAR 1)\n             [ \"1 rial saudit\"\n             , \"un rial saudi\"\n             ]\n  , examples (between RON (5, 15))\n             [ \"intre 5 si 15 lei\"\n             , \"intre 5 \u00c8\u2122i 15 lei\"\n             , \"de la 5 RON la 15 RON\"\n             , \"intre 5 lei si 15 lei\"\n             , \"de la 5 la 15 lei\"\n             , \"5 - 15 roni\"\n             , \"aproximativ 5-15 lei\"\n             , \"aproape de 5-15 lei\"\n             , \"cam 5-15 RON\"\n             ]\n  , examples (under EUR 7)\n             [ \"sub \u00c8\u2122apte euro\"\n             , \"mai putin de 7 EUR\"\n             , \"mai pu\u00c8\u203ain de 7 EUR\"\n             , \"nu chiar 7\u00e2\u201a\u00ac\"\n             , \"nici macar 7 euro\"\n             , \"mai ieftin de 7\u00e2\u201a\u00ac\"\n             , \"cel mult 7 euro\"\n             ]\n  , examples (above Dollar 3)\n            [ \"mai mult de 3 dolari\"\n            , \"peste 3 dolari\"\n            , \"mai scump de trei dolari\"\n            ]\n  ]\n", "num_lines": 157}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.RO.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive, numberWith)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleAmountDeUnit :: Rule\nruleAmountDeUnit = Rule\n  { name = \"<amount >= 20> de <unit>\"\n  , pattern =\n    [ numberWith TNumeral.value (>= 20)\n    , regex \"de\"\n    , Predicate isCurrencyOnly\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"(s|\u00c8\u2122)i\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleRiyals :: Rule\nruleRiyals = Rule\n  { name = \"riyals\"\n  , pattern =\n    [ regex \"rial (saudit?|qatarian?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"saudi\"     -> Just . Token AmountOfMoney $ currencyOnly SAR\n        \"saudit\"    -> Just . Token AmountOfMoney $ currencyOnly SAR\n        \"qataria\"   -> Just . Token AmountOfMoney $ currencyOnly QAR\n        \"qatarian\"  -> Just . Token AmountOfMoney $ currencyOnly QAR\n        _           -> Nothing\n      _ -> Nothing\n  }\n\nruleDollar :: Rule\nruleDollar = Rule\n  { name = \"$\"\n  , pattern =\n    [ regex \"dolari?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Dollar\n  }\n\nrulePrecisionAmountOfMoney :: Rule\nrulePrecisionAmountOfMoney = Rule\n  { name = \"about/exactly <amount-of-money>\"\n  , pattern =\n    [ regex \"exact|cam|aprox(\\\\.|imativ)?|(aproape|(i|\u00c3\u00ae)n jur)( de)?\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent|bani\"\n  , pattern =\n    [ regex \"bani?|cen(t|\u00c8\u203a)i?|c|\u00c2\u00a2\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleRon :: Rule\nruleRon = Rule\n  { name = \"RON\"\n  , pattern =\n    [ regex \"roni|lei\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly RON\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"(s|\u00c8\u2122)i\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"lire?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleOtherPounds :: Rule\nruleOtherPounds = Rule\n  { name = \"other pounds\"\n  , pattern =\n    [ regex \"lir(a|\u00c4\u0192) (egiptian|libanez)(a|\u00c4\u0192)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (_:match:_)):_) -> case Text.toLower match of\n        \"egiptian\" -> Just . Token AmountOfMoney $ currencyOnly EGP\n        \"libanez\"  -> Just . Token AmountOfMoney $ currencyOnly LBP\n        _          -> Nothing\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleInr :: Rule\nruleInr = Rule\n  { name = \"INR\"\n  , pattern =\n    [ regex \"rupii?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly INR\n  }\n\nruleKwd :: Rule\nruleKwd = Rule\n  { name = \"KWD\"\n  , pattern =\n    [ regex \"dinar kuweitian\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly KWD\n  }\n\nruleAed :: Rule\nruleAed = Rule\n  { name = \"AED\"\n  , pattern =\n    [ regex \"dirhami?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly AED\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"intre|de la\"\n    , Predicate isPositive\n    , regex \"[s\u00c8\u2122]i|la\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <amount-of-money> to|and <amount-of-money>\"\n  , pattern =\n    [ regex \"intre|de la\"\n    , Predicate isSimpleAmountOfMoney\n    , regex \"[s\u00c8\u2122]i|la\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                TAmountOfMoney.currency = c1}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n       _) | from < to && c1 == c2 ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) | from < to ->\n        Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<amount-of-money> - <amount-of-money>\"\n  , pattern =\n    [ Predicate isSimpleAmountOfMoney\n    , regex \"-\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just from,\n                  TAmountOfMoney.currency = c1}:\n        _:\n        Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c2}:\n        _) | from < to && c1 == c2 ->\n          Just . Token AmountOfMoney . withInterval (from, to) $ currencyOnly c1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <amount-of-money>\"\n  , pattern =\n    [ regex \"sub|mai (pu[t\u00c8\u203a]|ieft)in de|nu chiar|nici macar|cel mult\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMax to $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <amount-of-money>\"\n  , pattern =\n    [ regex \"peste|mai (mult|scump) de|cel pu[t\u00c8\u203a]in\"\n    , Predicate isSimpleAmountOfMoney\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just to,\n                  TAmountOfMoney.currency = c}:\n       _) -> Just . Token AmountOfMoney . withMin to $ currencyOnly c\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleAmountDeUnit\n  , ruleAed\n  , ruleCent\n  , ruleDollar\n  , ruleInr\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , ruleKwd\n  , ruleOtherPounds\n  , rulePounds\n  , rulePrecisionAmountOfMoney\n  , ruleRiyals\n  , ruleRon\n  , ruleIntervalBetween\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalDash\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  ]\n", "num_lines": 359}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.SV.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale SV Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Dollar 10)\n             [ \"$10\"\n             , \"10$\"\n             , \"tio dollar\"\n             ]\n  , examples (simple Cent 10)\n             [ \"tio \u00c3\u00b6re\"\n             ]\n  , examples (simple Dollar 10000)\n             [ \"$10.000\"\n             , \"10K$\"\n             , \"$10k\"\n             ]\n  , examples (simple USD 1.23)\n             [ \"USD1,23\"\n             ]\n  , examples (simple SEK 10)\n             [ \"10kronor\"\n             , \"10kr\"\n             , \"10 kr\"\n             , \"tio kronor\"\n             , \"10 SEK\"\n             ]\n  , examples (simple SEK 2.23)\n             [ \"2 kronor och 23 \u00c3\u00b6re\"\n             , \"tv\u00c3\u00a5 kronor 23 \u00c3\u00b6re\"\n             , \"tv\u00c3\u00a5 kronor och 23 \u00c3\u00b6re\"\n             ]\n  , examples (simple EUR 20)\n             [ \"20\u00e2\u201a\u00ac\"\n             , \"20 euro\"\n             , \"20 Euro\"\n             , \"20 Euros\"\n             , \"EUR 20\"\n             ]\n  , examples (simple EUR 29.99)\n             [ \"EUR29,99\"\n             ]\n  , examples (simple INR 20)\n             [ \"Rs. 20\"\n             , \"Rs 20\"\n             , \"20 Rupees\"\n             , \"20Rs\"\n             , \"Rs20\"\n             ]\n  , examples (simple INR 20.43)\n             [ \"20 Rupees 43\"\n             , \"tjugo rupees 43\"\n             ]\n  , examples (simple INR 33)\n             [ \"INR33\"\n             ]\n  , examples (simple Pound 9)\n             [ \"\u00c2\u00a39\"\n             , \"nio pund\"\n             ]\n  , examples (simple GBP 3.01)\n             [ \"GBP3,01\"\n             , \"GBP 3,01\"\n             ]\n  , examples (simple NOK 10)\n             [ \"10 norska kronor\"\n             , \"10 nkr\"\n             ]\n  ]\n", "num_lines": 92}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.SV.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just . Token AmountOfMoney . withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"och\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleAboutAmountofmoney :: Rule\nruleAboutAmountofmoney = Rule\n  { name = \"about <amount-of-money>\"\n  , pattern =\n    [ regex \"omkring|cirka|runt|ca\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"cents?|penn(y|ies)|\u00c3\u00b6re\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleExactlyAmountofmoney :: Rule\nruleExactlyAmountofmoney = Rule\n  { name = \"exactly <amount-of-money>\"\n  , pattern =\n    [ regex \"exakt|precis\"\n    , Predicate isMoneyWithValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleNok :: Rule\nruleNok = Rule\n  { name = \"NOK\"\n  , pattern =\n    [ regex \"norska kronor|nkr\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly NOK\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00c2\u00a3\"\n  , pattern =\n    [ regex \"pund?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly Pound\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"och\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just . Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleSek :: Rule\nruleSek = Rule\n  { name = \"SEK\"\n  , pattern =\n    [ regex \"kr(onor)?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly SEK\n  }\n\nruleDirham :: Rule\nruleDirham = Rule\n  { name = \"AED\"\n  , pattern =\n    [ regex \"dirhams?\"\n    ]\n  , prod = \\_ -> Just . Token AmountOfMoney $ currencyOnly AED\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleAboutAmountofmoney\n  , ruleCent\n  , ruleDirham\n  , ruleExactlyAmountofmoney\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , ruleNok\n  , rulePounds\n  , ruleSek\n  ]\n", "num_lines": 187}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.TR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String (fromString)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Types\nimport Duckling.Testing.Types\nimport Duckling.Locale\nimport Duckling.Resolve\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale TR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple TRY 10000)\n             [ \"10 bin lira\"\n             , \"on bin lira\"\n             , \"10000 lira\"\n             ]\n  , examples (simple TRY 1)\n             [ \"bir lira\"\n             , \"1 lira\"\n             ]\n  , examples (simple Cent 10)\n             [ \"on kuru\u00c5\u0178\"\n             , \"10 kuru\u00c5\u0178\"\n             ]\n  , examples (simple Cent 25)\n             [ \"25 kuru\u00c5\u0178\"\n             , \"yirmi be\u00c5\u0178 kuru\u00c5\u0178\"\n             ]\n  , examples (simple Cent 5)\n             [ \"be\u00c5\u0178 kuru\u00c5\u0178\"\n             , \"5 kuru\u00c5\u0178\"\n             ]\n  , examples (simple Cent 66)\n             [ \"altm\u00c4\u00b1\u00c5\u0178 alt\u00c4\u00b1 kuru\u00c5\u0178\"\n             , \"66 kuru\u00c5\u0178\"\n             ]\n  , examples (simple TRY 100.75)\n             [ \"y\u00c3\u00bcz lira yetmi\u00c5\u0178 be\u00c5\u0178 kuru\u00c5\u0178\"\n             , \"100 lira 75 kuru\u00c5\u0178\"\n             ]\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.AmountOfMoney.TR.Rules\n  ( rules\n  ) where\n\nimport Data.String (fromString)\nimport Prelude\n\nimport Duckling.AmountOfMoney.Helpers\nimport Duckling.AmountOfMoney.Types (Currency(..), AmountOfMoneyData (..))\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isNatural, isPositive)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Types as TAmountOfMoney\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleUnitAmount :: Rule\nruleUnitAmount = Rule\n  { name = \"<unit> <amount>\"\n  , pattern =\n    [ Predicate isCurrencyOnly\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.currency = c}:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> Just $ Token AmountOfMoney $ withValue v $ currencyOnly c\n      _ -> Nothing\n  }\n\nrulePounds :: Rule\nrulePounds = Rule\n  { name = \"\u00e2\u201a\u00ba\"\n  , pattern =\n    [ regex \"\u00e2\u201a\u00ba\"\n    ]\n  , prod = \\_ -> Just $ Token AmountOfMoney $ currencyOnly TRY\n  }\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"cent\"\n  , pattern =\n    [ regex \"kuru\u00c5\u0178?\"\n    ]\n  , prod = \\_ -> Just $ Token AmountOfMoney $ currencyOnly Cent\n  }\n\nruleADollarCoin :: Rule\nruleADollarCoin = Rule\n  { name = \"a <dollar coin>\"\n  , pattern =\n    [ regex \"kuru\u00c5\u0178\"\n    , Predicate isDollarCoin\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token AmountOfMoney fd:\n       _) -> Just $ Token AmountOfMoney fd\n      _ -> Nothing\n  }\n\nruleNumDollarCoins :: Rule\nruleNumDollarCoins = Rule\n  { name = \"X <dollar coins>\"\n  , pattern =\n    [ Predicate isNatural\n    , Predicate isDollarCoin\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = c}:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just d,\n                                             TAmountOfMoney.currency = cur}:\n       _) -> Just $ Token AmountOfMoney $ withValue (c * d) $ currencyOnly cur\n      _ -> Nothing\n  }\n\nruleIntersectAndXCents :: Rule\nruleIntersectAndXCents = Rule\n  { name = \"intersect (and X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"(lira|tl)\"\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectAndNumeral :: Rule\nruleIntersectAndNumeral = Rule\n  { name = \"intersect (and number)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , regex \"(lira|tl)\"\n    , Predicate isNatural\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       _:\n       Token Numeral NumeralData{TNumeral.value = c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nruleIntersectXCents :: Rule\nruleIntersectXCents = Rule\n  { name = \"intersect (X cents)\"\n  , pattern =\n    [ Predicate isWithoutCents\n    , Predicate isCents\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token AmountOfMoney fd:\n       Token AmountOfMoney AmountOfMoneyData{TAmountOfMoney.value = Just c}:\n       _) -> Just $ Token AmountOfMoney $ withCents c fd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUnitAmount\n  , ruleCent\n  , ruleADollarCoin\n  , ruleNumDollarCoins\n  , ruleIntersect\n  , ruleIntersectAndNumeral\n  , ruleIntersectAndXCents\n  , ruleIntersectXCents\n  , rulePounds\n  ]\n", "num_lines": 161}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.CreditCardNumber.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Prelude\nimport Data.String\nimport qualified Data.Text as T\n\nimport Duckling.CreditCardNumber.Types\nimport Duckling.CreditCardNumber.Helpers\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ T.replicate (minNumberDigits - 1) \"0\"\n      , T.replicate (maxNumberDigits + 1) \"0\"\n      , \"invalid\"\n      , \"4111111111111110\"\n      , \"41111111-1111-1111\"\n      , \"371449635398430\"\n      , \"3714496353-98431\"\n      , \"6011111111111110\"\n      , \"60111111-1111-1117\"\n      , \"5555555555554440\"\n      , \"55555555-5555-4444\"\n      , \"30569309025900\"\n      , \"3056930902-5904\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples\n      (CreditCardNumberValue \"4111111111111111\" Visa)\n      [ \"4111111111111111\"\n      , \"4111-1111-1111-1111\"\n      ]\n  , examples\n      (CreditCardNumberValue \"371449635398431\" Amex)\n      [ \"371449635398431\"\n      , \"3714-496353-98431\"\n      ]\n  , examples\n      (CreditCardNumberValue \"6011111111111117\" Discover)\n      [ \"6011111111111117\"\n      , \"6011-1111-1111-1117\"\n      ]\n  , examples\n      (CreditCardNumberValue \"5555555555554444\" Mastercard)\n      [ \"5555555555554444\"\n      , \"5555-5555-5555-4444\"\n      ]\n  , examples\n      (CreditCardNumberValue \"30569309025904\" DinerClub)\n      [ \"30569309025904\"\n      , \"3056-930902-5904\"\n      ]\n  , examples\n      (CreditCardNumberValue \"3530111333300000\" Other)\n      [ \"3530111333300000\" ]\n  ]\n", "num_lines": 76}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.CreditCardNumber.Helpers\n  ( otherCreditCardNumberRegex\n  , visaCreditCardNumberRegex\n  , amexCreditCardNumberRegex\n  , discoverCreditCardNumberRegex\n  , mastercardCreditCardNumberRegex\n  , dinerClubCreditCardNumberRegex\n  , isValidCreditCardNumber\n  , minNumberDigits\n  , maxNumberDigits\n  , creditCard\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.CreditCardNumber.Types (CreditCardNumberData(..))\nimport qualified Duckling.CreditCardNumber.Types as TCreditCardNumber\nimport qualified Data.Text as T\nimport qualified Data.Char as C\nimport qualified Data.Bits as B\n\n-- -----------------------------------------------------------------\n-- Patterns\n\notherCreditCardNumberRegex :: String\notherCreditCardNumberRegex =\n  concat [ \"(\"\n         , \"(?!\" , visaCreditCardNumberRegex, \")\"\n         , \"(?!\" , amexCreditCardNumberRegex, \")\"\n         , \"(?!\" , discoverCreditCardNumberRegex, \")\"\n         , \"(?!\" , mastercardCreditCardNumberRegex, \")\"\n         , \"(?!\" , dinerClubCreditCardNumberRegex, \")\"\n         , \"\\\\d{\" , show minNumberDigits , \",\" , show maxNumberDigits , \"}\"\n         , \")\"\n         ]\n\n-- | Visa credit card regex informed by latest BIN info\nvisaCreditCardNumberRegex :: String\nvisaCreditCardNumberRegex = \"(\" ++ withoutDashes ++ \"|\" ++ withDashes ++\")\"\n  where\n    withoutDashes = \"4[0-9]{15}\"\n    withDashes = \"4[0-9]{3}-[0-9]{4}-[0-9]{4}-[0-9]{4}\"\n\n-- | American Express credit card regex informed by latest BIN info\namexCreditCardNumberRegex :: String\namexCreditCardNumberRegex = \"(\" ++ withoutDashes ++ \"|\" ++ withDashes ++\")\"\n  where\n    withoutDashes = \"3[47][0-9]{13}\"\n    withDashes = \"3[47][0-9]{2}-[0-9]{6}-[0-9]{5}\"\n\n-- | Discover credit card regex informed by latest BIN info\ndiscoverCreditCardNumberRegex :: String\ndiscoverCreditCardNumberRegex = \"(\" ++ withoutDashes ++ \"|\" ++ withDashes ++\")\"\n  where\n    withoutDashes = \"6(?:011|[45][0-9]{2})[0-9]{12}\"\n    withDashes = \"6(?:011|[45][0-9]{2})-[0-9]{4}-[0-9]{4}-[0-9]{4}\"\n\n-- | Mastercard credit card regex informed by latest BIN info\nmastercardCreditCardNumberRegex :: String\nmastercardCreditCardNumberRegex =\n  \"(\" ++ withoutDashes ++ \"|\" ++ withDashes ++\")\"\n  where\n    withoutDashes = \"5[1-5][0-9]{14}\"\n    withDashes = \"5[1-5][0-9]{2}-[0-9]{4}-[0-9]{4}-[0-9]{4}\"\n\n-- | Diner Club credit card regex informed by latest BIN info\ndinerClubCreditCardNumberRegex :: String\ndinerClubCreditCardNumberRegex = \"(\" ++ withoutDashes ++ \"|\" ++ withDashes ++\")\"\n  where\n    withoutDashes = \"3(?:0[0-5]|[68][0-9])[0-9]{11}\"\n    withDashes = \"3(?:0[0-5]|[68][0-9])[0-9]-[0-9]{6}-[0-9]{4}\"\n\n-- -----------------------------------------------------------------\n-- Validation\n\n-- | An implementation of the Luhn algorithm (see\n-- https://en.wikipedia.org/wiki/Luhn_algorithm) to check if a given credit card\n-- number is valid\nisValidCreditCardNumber :: Text -> Bool\nisValidCreditCardNumber ccNum =\n  T.length ccNum >= minNumberDigits &&\n  T.length ccNum <= maxNumberDigits &&\n  validCheckSum\n  where\n  validCheckSum :: Bool\n  validCheckSum =\n    T.all C.isDigit ccNum &&\n    fst (T.foldr f (0, 0) ccNum) `rem` 10 == 0\n    where\n    f char (checksum, e) =\n      let\n        val = C.digitToInt char\n        -- every even digit should be doubled\n        d = sumDigits (B.shift val e)\n      in (checksum + d, 1 - e)\n    -- we only need sum of digits for numbers from 0 to 18\n    sumDigits a\n      | a > 9 = a - 9\n      | otherwise = a\n\nminNumberDigits :: Int\nminNumberDigits = 8\n\nmaxNumberDigits :: Int\nmaxNumberDigits = 19\n\n-- -----------------------------------------------------------------\n-- Production\n\ncreditCard :: Text -> TCreditCardNumber.Issuer -> CreditCardNumberData\ncreditCard ccNum i =\n  CreditCardNumberData { TCreditCardNumber.number = ccNum\n                       , TCreditCardNumber.issuer = i\n                       }\n", "num_lines": 124}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.CreditCardNumber.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\nimport Data.Text (Text)\nimport Data.Bool\nimport qualified Data.Text as T\nimport qualified Data.Char as C\n\nimport Duckling.Dimensions.Types\nimport Duckling.CreditCardNumber.Helpers\nimport qualified Duckling.CreditCardNumber.Types as TCreditCardNumber\nimport Duckling.Regex.Types\nimport Duckling.Types\n\ncreditCards :: [(Text, PatternItem, TCreditCardNumber.Issuer)]\ncreditCards =\n  [ ( \"visa credit card number\"\n    , regex visaCreditCardNumberRegex\n    , TCreditCardNumber.Visa\n    )\n  , ( \"amex card number\"\n    , regex amexCreditCardNumberRegex\n    , TCreditCardNumber.Amex\n    )\n  , ( \"discover card number\"\n    , regex discoverCreditCardNumberRegex\n    , TCreditCardNumber.Discover\n    )\n  , ( \"mastercard card number\"\n    , regex mastercardCreditCardNumberRegex\n    , TCreditCardNumber.Mastercard\n    )\n  , ( \"diner club card number\"\n    , regex dinerClubCreditCardNumberRegex\n    , TCreditCardNumber.DinerClub\n    )\n  , ( \"credit card number\"\n    , regex otherCreditCardNumberRegex\n    , TCreditCardNumber.Other\n    )\n  ]\n\nrules :: [Rule]\nrules = map go creditCards\n  where\n    go :: (Text, PatternItem, TCreditCardNumber.Issuer) -> Rule\n    go (name, regexPattern, i) = Rule\n      { name = name\n      , pattern = [ regexPattern ]\n      , prod = \\case\n          (Token RegexMatch (GroupMatch (ccNumGroup:_)):_) ->\n            bool\n              Nothing\n              (Just $ Token CreditCardNumber $ creditCard ccNum i)\n              (isValidCreditCardNumber ccNum)\n            where\n              ccNum = T.filter C.isDigit ccNumGroup\n          _ -> Nothing\n      }\n", "num_lines": 73}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.CreditCardNumber.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Text (Text)\nimport qualified Data.Text as Text\nimport GHC.Generics\n\nimport Prelude\n\nimport Duckling.Resolve (Resolve(..))\n\ndata Issuer\n  = Visa\n  | Amex\n  | Discover\n  | Mastercard\n  | DinerClub\n  | Other\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance ToJSON Issuer where\n  toJSON = String . Text.toLower . Text.pack . show\n\ndata CreditCardNumberData = CreditCardNumberData\n  { number :: Text\n  , issuer :: Issuer\n  }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve CreditCardNumberData where\n  type ResolvedValue CreditCardNumberData = CreditCardNumberValue\n  resolve _ _ CreditCardNumberData {number, issuer} =\n    Just (CreditCardNumberValue number issuer, False)\n\ndata CreditCardNumberValue = CreditCardNumberValue\n  { vNumber :: Text\n  , vIssuer :: Issuer\n  }\n  deriving (Eq, Ord, Show)\n\ninstance ToJSON CreditCardNumberValue where\n  toJSON (CreditCardNumberValue number issuer) =\n    object [ \"value\" .= number\n           , \"issuer\" .= issuer\n           ]\n", "num_lines": 62}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.AF\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.AR\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.BG\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.BN\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.CA\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal AmountOfMoney\n  , Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.Common\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal AmountOfMoney\n  , Seal CreditCardNumber\n  , Seal Email\n  , Seal Numeral\n  , Seal PhoneNumber\n  , Seal Url\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.CS\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Numeral\n  ]\n", "num_lines": 19}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.DA\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.DE\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.EL\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.EN\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.ES\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.ET\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  , Seal Ordinal\n  ]\n", "num_lines": 19}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Dimensions.FA\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions  =\n  [ Seal Numeral\n  ]\n", "num_lines": 17}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Dimensions.FI\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions  =\n  [ Seal Numeral\n  ]\n", "num_lines": 17}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.FR\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.GA\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.HE\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.HI\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Temperature\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.HR\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.HU\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.ID\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  , Seal Ordinal\n  ]\n", "num_lines": 19}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.IS\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.IT\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.JA\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Temperature\n  , Seal Time\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.KA\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  , Seal Ordinal\n  , Seal Duration\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.KM\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Volume\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.KN\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.KO\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.LO\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.ML\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral,\n    Seal Ordinal\n  ]\n", "num_lines": 19}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.MN\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Volume\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.MY\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.NB\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.NE\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.NL\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.PL\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.PT\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.RO\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.RU\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Volume\n  , Seal Time\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n\nmodule Duckling.Dimensions.SK\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 19}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.SV\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.SW\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.TA\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  , Seal Ordinal\n  ]\n", "num_lines": 19}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.TE\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.TH\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Numeral\n  ]\n", "num_lines": 18}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.TR\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Temperature\n  , Seal Time\n  , Seal Volume\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\n\nmodule Duckling.Dimensions.Types\n  ( Seal(..)\n  , Dimension(..)\n\n  , fromName\n  , toName\n  ) where\n\nimport Data.Maybe\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Types\n\ntoName :: Dimension a -> Text\ntoName RegexMatch = \"regex\"\ntoName CreditCardNumber = \"credit-card-number\"\ntoName Distance = \"distance\"\ntoName Duration = \"duration\"\ntoName Email = \"email\"\ntoName AmountOfMoney = \"amount-of-money\"\ntoName Numeral = \"number\"\ntoName Ordinal = \"ordinal\"\ntoName PhoneNumber = \"phone-number\"\ntoName Quantity = \"quantity\"\ntoName Temperature = \"temperature\"\ntoName Time = \"time\"\ntoName TimeGrain = \"time-grain\"\ntoName Url = \"url\"\ntoName Volume = \"volume\"\ntoName (CustomDimension dim) = Text.pack (show dim)\n\nfromName :: Text -> Maybe (Seal Dimension)\nfromName name = HashMap.lookup name m\n  where\n    m = HashMap.fromList\n      [ (\"amount-of-money\", Seal AmountOfMoney)\n      , (\"credit-card-number\", Seal CreditCardNumber)\n      , (\"distance\", Seal Distance)\n      , (\"duration\", Seal Duration)\n      , (\"email\", Seal Email)\n      , (\"number\", Seal Numeral)\n      , (\"ordinal\", Seal Ordinal)\n      , (\"phone-number\", Seal PhoneNumber)\n      , (\"quantity\", Seal Quantity)\n      , (\"temperature\", Seal Temperature)\n      , (\"time\", Seal Time)\n      , (\"time-grain\", Seal TimeGrain)\n      , (\"url\", Seal Url)\n      , (\"volume\", Seal Volume)\n      ]\n", "num_lines": 65}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.UK\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.VI\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Time\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.ZH\n  ( allDimensions\n  ) where\n\nimport Duckling.Dimensions.Types\n\nallDimensions :: [Seal Dimension]\nallDimensions =\n  [ Seal Distance\n  , Seal Duration\n  , Seal Numeral\n  , Seal Ordinal\n  , Seal Quantity\n  , Seal Temperature\n  , Seal Time\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Distance.Helpers\n  ( distance\n  , distanceSum\n  , isDistanceOfUnit\n  , isSimpleDistance\n  , unitOnly\n  , withInterval\n  , withMax\n  , withMin\n  , withUnit\n  , withValue\n  ) where\n\nimport Prelude\nimport Data.Semigroup ((<>))\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Types (DistanceData(..))\nimport Duckling.Types\nimport qualified Duckling.Distance.Types as TDistance\nimport qualified Duckling.DistanceUnits.Types as DGTypes\n\n-- -----------------------------------------------------------------\n-- Patterns\n\nisSimpleDistance :: Predicate\nisSimpleDistance (Token Distance DistanceData {TDistance.value = Just _\n                                              , TDistance.unit = Just _}) = True\nisSimpleDistance _ = False\n\nisDistanceOfUnit :: TDistance.Unit -> Predicate\nisDistanceOfUnit unit (Token Distance DistanceData {TDistance.unit = Just u}) =\n    unit == u\nisDistanceOfUnit _ _ = False\n\n-- -----------------------------------------------------------------\n-- Production\n\ndistance :: Double -> DistanceData\ndistance x = DistanceData {TDistance.value = Just x\n                          , TDistance.unit = Nothing\n                          , TDistance.minValue = Nothing\n                          , TDistance.maxValue = Nothing}\n\ndistanceSum ::\n     Double\n  -> TDistance.Unit\n  -> Double\n  -> TDistance.Unit\n  -> Maybe DistanceData\ndistanceSum v1 u1 v2 u2 = unwrapContext $ cd1 <> cd2\n  where\n    wrapContext v u = DGTypes.ContextualDistance v $ DGTypes.toSystemUnit u\n    cd1 = wrapContext v1 u1\n    cd2 = wrapContext v2 u2\n\n    unwrapContext DGTypes.Nonrelatable = Nothing\n    unwrapContext (DGTypes.ContextualDistance v u) =\n        Just $ withUnit (DGTypes.toRawUnit u) $ distance v\n\nunitOnly :: TDistance.Unit -> DistanceData\nunitOnly u = DistanceData {TDistance.unit = Just u\n                          , TDistance.value = Nothing\n                          , TDistance.minValue = Nothing\n                          , TDistance.maxValue = Nothing}\n\nwithUnit :: TDistance.Unit -> DistanceData -> DistanceData\nwithUnit u dd = dd {TDistance.unit = Just u}\n\nwithValue :: Double -> DistanceData -> DistanceData\nwithValue value dd = dd {TDistance.value = Just value}\n\nwithInterval :: (Double, Double) -> DistanceData -> DistanceData\nwithInterval (from, to) dd = dd {TDistance.minValue = Just from\n                                , TDistance.maxValue = Just to}\n\nwithMin :: Double -> DistanceData -> DistanceData\nwithMin from dd = dd {TDistance.minValue = Just from}\n\nwithMax :: Double -> DistanceData -> DistanceData\nwithMax to dd = dd {TDistance.maxValue = Just to}\n", "num_lines": 91}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.Rules\n  ( rules\n  ) where\n\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralAsDistance :: Rule\nruleNumeralAsDistance = Rule\n  { name = \"number as distance\"\n  , pattern =\n    [ dimension Numeral\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData {TNumeral.value = v}:_) ->\n        Just . Token Distance $ distance v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNumeralAsDistance\n  ]\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Distance.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\nimport qualified Data.HashMap.Strict as H\nimport qualified Data.Text as Text\n\nimport Duckling.Resolve (Resolve(..))\n\ndata Unit\n  = Centimetre\n  | Foot\n  | Inch\n  | Kilometre\n  | M -- ambiguous between Mile and Metre\n  | Metre\n  | Mile\n  | Millimetre\n  | Yard\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance ToJSON Unit where\n  toJSON = String . Text.toLower . Text.pack . show\n\ndata DistanceData = DistanceData\n  { unit     :: Maybe Unit\n  , value    :: Maybe Double\n  , minValue :: Maybe Double\n  , maxValue :: Maybe Double\n  }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve DistanceData where\n  type ResolvedValue DistanceData = DistanceValue\n  resolve _ _ DistanceData {unit = Just unit, value = Just val} =\n    Just (simple unit val, False)\n  resolve _ _ DistanceData {unit = Just unit, value = Nothing\n                         , minValue = Just from, maxValue = Just to} =\n    Just (between unit (from, to), False)\n  resolve _ _ DistanceData {unit = Just unit, value = Nothing\n                         , minValue = Just from, maxValue = Nothing} =\n    Just (above unit from, False)\n  resolve _ _ DistanceData {unit = Just unit, value = Nothing\n                         , minValue = Nothing, maxValue = Just to} =\n    Just (under unit to, False)\n  resolve _ _ _ = Nothing\n\ndata IntervalDirection = Above | Under\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ndata SingleValue = SingleValue\n  { vUnit :: Unit\n  , vValue :: Double\n  }\n  deriving (Eq, Ord, Show)\n\ninstance ToJSON SingleValue where\n  toJSON (SingleValue unit value) = object\n    [ \"value\" .= value\n    , \"unit\"  .= unit\n    ]\n\ndata DistanceValue\n  = SimpleValue SingleValue\n  | IntervalValue (SingleValue, SingleValue)\n  | OpenIntervalValue (SingleValue, IntervalDirection)\n  deriving (Eq, Ord, Show)\n\ninstance ToJSON DistanceValue where\n  toJSON (SimpleValue value) = case toJSON value of\n    Object o -> Object $ H.insert \"type\" (toJSON (\"value\" :: Text)) o\n    _ -> Object H.empty\n  toJSON (IntervalValue (from, to)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    , \"to\" .= toJSON to\n    ]\n  toJSON (OpenIntervalValue (from, Above)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    ]\n  toJSON (OpenIntervalValue (to, Under)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"to\" .= toJSON to\n    ]\n\n-- -----------------------------------------------------------------\n-- Value helpers\n\nsimple :: Unit -> Double -> DistanceValue\nsimple u v = SimpleValue $ single u v\n\nbetween :: Unit -> (Double, Double) -> DistanceValue\nbetween u (from, to) = IntervalValue (single u from, single u to)\n\nabove :: Unit -> Double -> DistanceValue\nabove = openInterval Above\n\nunder :: Unit -> Double -> DistanceValue\nunder = openInterval Under\n\nopenInterval :: IntervalDirection -> Unit -> Double -> DistanceValue\nopenInterval direction u v = OpenIntervalValue (single u v, direction)\n\nsingle :: Unit -> Double -> SingleValue\nsingle u v = SingleValue {vUnit = u, vValue = v}\n", "num_lines": 125}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.CA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale CA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kil\u00c3\u00b2metres\"\n             , \"3 kilometres\"\n             , \"3 kil\u00c3\u00b3metres\"\n             , \"3 quil\u00c3\u00b2metres\"\n             , \"3 km\"\n             , \"3km\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 milles\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9m\"\n             , \"9 metres\"\n             , \"9 m\"\n             ]\n  , examples (simple Metre 1)\n             [ \"1m\"\n             , \"1 metre\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 cent\u00c3\u00admetres\"\n             , \"2 cm\"\n             ]\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.CA.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Types\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(k|qu)(il(o|\u00c3\u00b2|\u00c3\u00b3))?m?(etre)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just $ Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m(etres?)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just $ Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(cm|cent(\u00c3\u00ad|i)m(etres?))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just $ Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"milles?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just $ Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.CS.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale CS Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometry\"\n             , \"3 km\"\n             , \"3km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 mil\"\n             , \"osm mil\"\n             ]\n  , examples (simple Metre 1)\n             [ \"1m\"\n             , \"1 metr\"\n             ]\n  , examples (simple Metre 2)\n             [ \"2m\"\n             , \"2 metry\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9m\"\n             , \"9 metr\u00c5\u00af\"\n             ]\n  , examples (simple Centimetre 1)\n             [ \"1cm\"\n             , \"1 centimetr\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 centimetry\"\n             ]\n  , examples (simple Centimetre 9)\n             [ \"9cm\"\n             , \"9 centimetr\u00c5\u00af\"\n             ]\n  ]\n", "num_lines": 61}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.CS.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Types\nimport qualified Duckling.Distance.Types as TDistance\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"km|kilometr(y|\\x016f)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"metr(y|\\x016f)?|m\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"cm|centimetr(y|\\x016f)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"mil\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.DE.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DE Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometer\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"acht meilen\"\n             , \"8 meilen\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 zentimeter\"\n             ]\n  , examples (simple Inch 5)\n             [ \"5''\"\n             , \"f\u00c3\u00bcnf zoll\"\n             , \"5\\\"\"\n             ]\n  , examples (simple Metre 1.87)\n             [ \"1,87 meter\"\n             ]\n  , examples (between Kilometre (3, 5))\n             [ \"zwischen 3 und 5 kilometern\"\n             , \"von 3km bis 5km\"\n             , \"um die 3-5 kilometer\"\n             , \"etwa 3km-5km\"\n             , \"3-5 kilometer\"\n             ]\n  , examples (under Mile 3.5)\n             [ \"unter 3,5 meilen\"\n             , \"weniger als 3,5meilen\"\n             --, \"niedriger als dreikommaf\u00c3\u00bcnf meilen\"\n             ]\n  , examples (above Inch 5)\n             [ \"mehr als f\u00c3\u00bcnf zoll\"\n             , \"mindestens 5''\"\n             , \"\u00c3\u00bcber 5\\\"\"\n             ]\n  , examples (between Millimetre (5, 6))\n             [ \"zwischen 5 und sechs Millimetern\"\n             , \"zwischen 5 und sechs millimeter\"\n             , \"5-6 mm\"\n             ]\n  ]\n", "num_lines": 75}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Distance.DE.Rules (rules) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Distance.Types (DistanceData(..))\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Types\n\ndistances :: [(Text, String, TDistance.Unit)]\ndistances =\n  [ -- Imperial\n    (\"miles\", \"meilen?\", TDistance.Mile)\n  , (\"inch\", \"(\\\"|''|zoll)\", TDistance.Inch)\n              -- Metric\n  , (\"km\", \"k(ilo)?m(etern?)?\", TDistance.Kilometre)\n  , (\"meters\", \"m(etern?)?\", TDistance.Metre)\n  , (\"centimeters\", \"(cm|[zc]entimetern?)\", TDistance.Centimetre)\n  , (\"millimeters\", \"(mm|millimetern?)\", TDistance.Millimetre)\n  ]\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about|exactly <dist>\"\n  , pattern =\n    [ regex \"genau|exakt|pr\u00c3\u00a4zise|ungef\u00c3\u00a4hr|(in )?etwa|nahe?( an)?|um( die)?|fast|rund|gut\"\n    , dimension Distance\n    ]\n  , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleDistances :: [Rule]\nruleDistances = map go distances\n  where\n    go :: (Text, String, TDistance.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [ dimension Distance, regex regexPattern ]\n      , prod = \\case\n          (Token Distance dd:_) -> Just . Token Distance $ withUnit u dd\n          _ -> Nothing\n      }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <dist>\"\n  , pattern =\n    [ regex \"zwischen|von\"\n    , Predicate isPositive\n    , regex \"bis|und\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token Distance DistanceData{TDistance.value = Just to, TDistance.unit = Just u}:\n       _) | from < to ->\n        Just . Token Distance . withInterval (from, to) $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <dist> to|and <dist>\"\n  , pattern =\n    [ regex \"zwischen|von\"\n    , Predicate isSimpleDistance\n    , regex \"und|bis\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Distance DistanceData{TDistance.value = Just from, TDistance.unit = Just u1}:\n       _:\n       Token Distance DistanceData{TDistance.value = Just to, TDistance.unit = Just u2}:\n       _) | from < to && u1 == u2 ->\n        Just . Token Distance . withInterval (from, to) $ unitOnly u1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <dist>\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"-\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token Distance DistanceData{TDistance.value = Just to, TDistance.unit = Just u}:\n       _) | from < to ->\n         Just . Token Distance . withInterval (from, to) $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<dist> - <dist>\"\n  , pattern =\n    [ Predicate isSimpleDistance\n    , regex \"-\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (Token Distance DistanceData{TDistance.value = Just from, TDistance.unit = Just u1}:\n       _:\n       Token Distance DistanceData{TDistance.value = Just to, TDistance.unit = Just u2}:\n       _) | from < to && u1 == u2 ->\n        Just . Token Distance . withInterval (from, to) $ unitOnly u1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <dist>\"\n  , pattern =\n    [ regex \"unter|h\u00c3\u00b6chstens|maximal|(weniger|nicht mehr) als\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Distance DistanceData{TDistance.value = Just to, TDistance.unit = Just u}:\n       _) -> Just . Token Distance . withMax to $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <dist>\"\n  , pattern =\n    [ regex \"\u00c3\u00bcber|(mehr|nicht weniger) als|mindestens|wenigstens|minimal\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Distance DistanceData{TDistance.value = Just to, TDistance.unit = Just u}:\n       _) -> Just . Token Distance . withMin to $ unitOnly u\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , rulePrecision\n  ]\n    ++ ruleDistances\n", "num_lines": 173}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.EN.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometers\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             , \"3.0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 miles\"\n             , \"eight mile\"\n             , \"8 mi\"\n             ]\n  , examples (simple M 9)\n             [ \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 centimeters\"\n             ]\n  , examples (simple Inch 5)\n             [ \"5 in\"\n             , \"5''\"\n             , \"five inches\"\n             , \"5\\\"\"\n             ]\n  , examples (simple Metre 1.87)\n             [ \"1.87 meters\"\n             ]\n  -- Composite values:\n  , examples (simple Inch 94)\n             [ \"7 feet and 10 inches\"\n             , \"7 feet, 10 inches\"\n             , \"7 feet 10 inches\"\n             ]\n  , examples (simple Metre 2001)\n             [ \"2 km and 1 meter\"\n             , \"2 kilometer, 1 metre\"\n             , \"2 kilometer 1 metre\"\n             ]\n  , examples (simple Inch 166)\n             [ \"2 yards 7 ft 10 inches\"\n             , \"2 yds, 7 feet and 10 inches\"\n             , \"2 yards, 7 feet, 10 in\"\n             ]\n  , examples (simple Foot 13)\n             [ \"2 yards and 7 feet\"\n             , \"2 yards, 7 feet\"\n             , \"2 yd 7'\"\n             ]\n  , examples (simple Centimetre 1000806)\n             [ \"10 kms 8 metres 6 cm\"\n             , \"10 kms, 8 meters, 6 cm\"\n             , \"10 kms, 8 meters and 6 centimeters\"\n--             , \"10 kms, 8 meters, and 6 cm\" -- Oxford comma not supported\n             ]\n  , examples (simple Metre 1.3048)\n             [ \"1 meter and 1 foot\"\n             ]\n  , examples (simple Kilometre 2.609344)\n             [ \"1 kilometer and 1 mile\"\n             ]\n  , examples (simple M 3)\n             -- The original, ambiguous \"m\" unit is preserved\n             [ \"3m\"\n             ]\n  , examples (simple Centimetre 305)\n             -- The ambiguous \"m\" unit is inferred as \"meteres\"\n             [ \"3m and 5cm\"\n             ]\n  , examples (simple Foot 5281)\n             -- The ambiguous \"m\" unit is inferred as \"miles\"\n             [ \"1m and 1ft\"\n             ]\n  -- Ranges:\n  , examples (between Kilometre (3, 5))\n             [ \"between 3 and 5 kilometers\"\n             , \"from 3km to 5km\"\n             , \"around 3-5 kilometers\"\n             , \"about 3km-5km\"\n             , \"3-5 kilometers\"\n             ]\n  , examples (under Mile 3.5)\n             [ \"under 3.5 miles\"\n             , \"less than 3.5mi\"\n             , \"lower than three point five miles\"\n             ]\n  , examples (above Inch 5)\n             [ \"more than five inches\"\n             , \"at least 5''\"\n             , \"over 5\\\"\"\n             , \"above 5 in\"\n             ]\n  , examples (between Millimetre (5, 6))\n             [ \"between 5 and six millimeters\"\n             , \"between 5 and six millimetres\"\n             , \"5-6 mm\"\n             ]\n  ]\n", "num_lines": 123}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.EN.Rules\n  ( rules ) where\n\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Distance.Types (DistanceData(..))\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Types\nimport qualified Duckling.Distance.Types as TDist\nimport qualified Duckling.Numeral.Types as TNumeral\n\n\ndistances :: [(Text, String, TDist.Unit)]\ndistances = [ -- Imperial\n              (\"miles\", \"mi(le(s)?)?\", TDist.Mile)\n            , (\"yard\", \"y(ar)?ds?\", TDist.Yard)\n            , (\"feet\", \"('|f(oo|ee)?ts?)\", TDist.Foot)\n            , (\"inch\", \"(\\\"|''|in(ch(es)?)?)\", TDist.Inch)\n              -- Metric\n            , (\"km\", \"k(ilo)?m?(et(er|re))?s?\", TDist.Kilometre)\n            , (\"meters\", \"met(er|re)s?\", TDist.Metre)\n            , (\"centimeters\", \"cm|centimet(er|re)s?\", TDist.Centimetre)\n            , (\"millimeters\", \"mm|millimet(er|re)s?\", TDist.Millimetre)\n              -- Ambiguous\n            , (\"m (miles or meters)\", \"m\", TDist.M)\n            ]\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about|exactly <dist>\"\n  , pattern =\n    [ regex \"exactly|precisely|about|approx(\\\\.|imately)?|close to| near( to)?|around|almost\"\n    , dimension Distance\n    ]\n  , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleDistances :: [Rule]\nruleDistances = map go distances\n  where\n    go :: (Text, String, TDist.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [ dimension Distance, regex regexPattern ]\n      , prod = \\case\n          (Token Distance dd:_) -> Just . Token Distance $ withUnit u dd\n          _ -> Nothing\n      }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> to|and <dist>\"\n  , pattern =\n    [ regex \"between|from\"\n    , Predicate isPositive\n    , regex \"to|and\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:\n       _) | from < to ->\n        Just . Token Distance . withInterval (from, to) $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <dist> to|and <dist>\"\n  , pattern =\n    [ regex \"between|from\"\n    , Predicate isSimpleDistance\n    , regex \"to|and\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Distance DistanceData{TDist.value=Just from, TDist.unit=Just u1}:\n       _:\n       Token Distance DistanceData{TDist.value=Just to, TDist.unit=Just u2}:\n       _) | from < to && u1 == u2 ->\n        Just . Token Distance . withInterval (from, to) $ unitOnly u1\n      _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <dist>\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"-\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = from}:\n       _:\n       Token Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:\n       _) | from < to ->\n         Just . Token Distance . withInterval (from, to) $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<dist> - <dist>\"\n  , pattern =\n    [ Predicate isSimpleDistance\n    , regex \"-\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (Token Distance DistanceData{TDist.value=Just from, TDist.unit=Just u1}:\n       _:\n       Token Distance DistanceData{TDist.value=Just to, TDist.unit=Just u2}:\n       _) | from < to && u1 == u2 ->\n        Just . Token Distance . withInterval (from, to) $ unitOnly u1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <dist>\"\n  , pattern =\n    [ regex \"under|(less|lower|not? more) than\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:\n       _) -> Just . Token Distance . withMax to $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <dist>\"\n  , pattern =\n    [ regex \"over|above|at least|more than\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (_:\n       Token Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:\n       _) -> Just . Token Distance . withMin to $ unitOnly u\n      _ -> Nothing\n  }\n\n-- | NOTE: Oxford comma is not supported.\nruleCompositeDistanceCommasAnd :: Rule\nruleCompositeDistanceCommasAnd = Rule\n  { name = \"composite <distance> (with ,/and)\"\n  , pattern =\n    [ Predicate isSimpleDistance\n    , regex \",|and\"\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (Token Distance DistanceData{TDist.value=Just v1, TDist.unit=Just u1}:\n       _:\n       Token Distance DistanceData{TDist.value=Just v2, TDist.unit=Just u2}:\n       _) | u1 /= u2 && v1 > 0 && v2 > 0 -> Token Distance <$>\n                                              distanceSum v1 u1 v2 u2\n      _ -> Nothing\n  }\n\nruleCompositeDistance :: Rule\nruleCompositeDistance = Rule\n  { name = \"composite <distance>\"\n  , pattern =\n    [ Predicate isSimpleDistance\n    , Predicate isSimpleDistance\n    ]\n  , prod = \\case\n      (Token Distance DistanceData{TDist.value=Just v1, TDist.unit=Just u1}:\n       Token Distance DistanceData{TDist.value=Just v2, TDist.unit=Just u2}:\n       _) | u1 /= u2 && v1 > 0 && v2 > 0 -> Token Distance <$>\n                                              distanceSum v1 u1 v2 u2\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalMax\n  , ruleIntervalMin\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , rulePrecision\n  , ruleCompositeDistanceCommasAnd\n  , ruleCompositeDistance\n  ] ++ ruleDistances\n", "num_lines": 214}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.ES.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ES Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kil\u00c3\u00b3metros\"\n             , \"3 kilometros\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 miles\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9m\"\n             , \"9 metros\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 cent\u00c3\u00admetros\"\n             ]\n  ]\n", "num_lines": 49}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.ES.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Types\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"k(il(\u00c3\u00b3|o))?m?(etro)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m(etros?)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(cm|cent(\u00c3\u00ad|i)m(etros?))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"miles?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.FR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilom\u00c3\u00a8tres\"\n             , \"3 kilometres\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 miles\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9 metres\"\n             , \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 centimetres\"\n             ]\n  ]\n", "num_lines": 48}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.FR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Types\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"k(ilo)?m?((e|\u00c3\u00a9|\u00c3\u00a8)tre)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m((e|\u00c3\u00a9|\u00c3\u00a8)tres?)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"cm|centim(e|\u00c3\u00a9|\u00c3\u00a8)tres?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"miles?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.GA.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 cilim\u00c3\u00a9adair\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3.0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 mh\u00c3\u00adle\"\n             , \"8 m\u00c3\u00adle\"\n             ]\n  , examples (simple M 9)\n             [ \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 cheintim\u00c3\u00a9adar\"\n             ]\n  ]\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.GA.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Types\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"mh?(e|\u00c3\u00a9)adai?r\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(c\\\\.?m\\\\.?|g?ch?eintimh?(e|\u00c3\u00a9)adai?r)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"mh?(\u00c3\u00ad|i)lt?e\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(k\\\\.?(m\\\\.?)?|g?ch?ilim(e|\u00c3\u00a9)adai?r)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleLatentDistTroigh :: Rule\nruleLatentDistTroigh = Rule\n  { name = \"<latent dist> troigh\"\n  , pattern =\n    [ dimension Distance\n    , regex \"('|d?th?roi[tg]he?|tr\\\\.?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Foot dd\n      _ -> Nothing\n  }\n\nruleLatentDistOrlach :: Rule\nruleLatentDistOrlach = Rule\n  { name = \"<latent dist> orlach\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(''|([nth]-?)?orl(ach|aigh|a(\u00c3\u00ad|i)|\\\\.))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Inch dd\n      _ -> Nothing\n  }\n\nruleDistMAmbiguousMilesOrMeters :: Rule\nruleDistMAmbiguousMilesOrMeters = Rule\n  { name = \"<dist> m (ambiguous miles or meters)\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.M dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMAmbiguousMilesOrMeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  , ruleLatentDistOrlach\n  , ruleLatentDistTroigh\n  ]\n", "num_lines": 123}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.HR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometra\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 milja\"\n             ]\n  , examples (simple M 9)\n             [ \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 centimetra\"\n             ]\n  ]\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.HR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Types\nimport qualified Duckling.Distance.Types as TDistance\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"k(ilo)?m?(eta?r)?a?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMetar :: Rule\nruleDistMetar = Rule\n  { name = \"<dist> metar\"\n  , pattern =\n    [ dimension Distance\n    , regex \"metara?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimetar :: Rule\nruleDistCentimetar = Rule\n  { name = \"<dist> centimetar\"\n  , pattern =\n    [ dimension Distance\n    , regex \"cm|centimeta?ra?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMilja :: Rule\nruleDistMilja = Rule\n  { name = \"<dist> milja\"\n  , pattern =\n    [ dimension Distance\n    , regex \"milja\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) -> Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nruleDistMAmbiguousMilesOrMeters :: Rule\nruleDistMAmbiguousMilesOrMeters = Rule\n  { name = \"<dist> m (ambiguous miles or meters)\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) -> Just . Token Distance $ withUnit TDistance.M dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimetar\n  , ruleDistMAmbiguousMilesOrMeters\n  , ruleDistMetar\n  , ruleDistMilja\n  , ruleLatentDistKm\n  ]\n", "num_lines": 92}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.IT.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext {locale = makeLocale IT Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometri\"\n             , \"3 chilometri\"\n             , \"3 km\"\n             , \"3km\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 miglia\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9 metri\"\n             , \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 centimetri\"\n             ]\n  ]\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.IT.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Types\nimport qualified Duckling.Distance.Types as TDistance\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"km|(k|ch)(ilo)?m?(etr)o?i?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"metro?i?|m\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"cm|centimetro?i?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"miglio?a?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 82}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.NL.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometer\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             , \"3,0km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 mijl\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9m\"\n             , \"9 m\"\n             , \"9 meter\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 cm\"\n             , \"2 centimeter\"\n             ]\n  ]\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.NL.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Types\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"k(ilo)?m?(eter)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m(eter)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(c(enti)?m(eter)?s?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"mijl?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.PT.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kil\u00c3\u00b3metros\"\n             , \"3 kilometros\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 milhas\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9m\"\n             , \"9 metros\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 cent\u00c3\u00admetros\"\n             ]\n  ]\n", "num_lines": 48}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.PT.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Types\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"k(il(\u00c3\u00b3|o))?m?(etro)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m(etros?)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(cm|cent(\u00c3\u00ad|i)m(etros?))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"milhas?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.RO.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometri\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 mile\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9m\"\n             , \"9 m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 centimetri\"\n             ]\n  , examples (simple Foot 10)\n             [ \"zece picioare\"\n             ]\n  , examples (simple Foot 20)\n             [ \"20 de picioare\"\n             ]\n  ]\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.RO.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Distance.Types as TDistance\n\nunitMap :: HashMap Text TDistance.Unit\nunitMap = HashMap.fromList\n  [ ( \"cm\", TDistance.Centimetre )\n  , ( \"centimetri\", TDistance.Centimetre )\n  , ( \"centimetru\", TDistance.Centimetre )\n  , ( \"picior\", TDistance.Foot )\n  , ( \"picioare\", TDistance.Foot )\n  , ( \"inch\", TDistance.Inch )\n  , ( \"inchi\", TDistance.Inch )\n  , ( \"inci\", TDistance.Inch )\n  , ( \"km\", TDistance.Kilometre )\n  , ( \"kilometri\", TDistance.Kilometre )\n  , ( \"kilometru\", TDistance.Kilometre )\n  , ( \"m\", TDistance.Metre )\n  , ( \"metri\", TDistance.Metre )\n  , ( \"metru\", TDistance.Metre )\n  , ( \"mila\", TDistance.Mile )\n  , ( \"mil\u00c4\u0192\", TDistance.Mile )\n  , ( \"mile\", TDistance.Mile )\n  , ( \"y\", TDistance.Yard )\n  , ( \"yar\", TDistance.Yard )\n  , ( \"yard\", TDistance.Yard )\n  , ( \"yarzi\", TDistance.Yard )\n  , ( \"yd\", TDistance.Yard )\n  , ( \"yzi\", TDistance.Yard )\n  ]\n\nruleLatentDistUnit :: Rule\nruleLatentDistUnit = Rule\n  { name = \"<latent dist> foot/inch/yard/meter/kilometer/centimeter\"\n  , pattern =\n    [ dimension Distance\n    , regex \"(inc(hi?|i)|(centi|kilo)?metr[iu]|mil[ea\u00c4\u0192]|[ck]?m|picio(are|r)|y(ar)?(zi|d)?)\"\n    ]\n  , prod = \\case\n      (Token Distance dd:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         x <- HashMap.lookup (Text.toLower match) unitMap\n         Just . Token Distance $ withUnit x dd\n      _ -> Nothing\n  }\n\nruleLatentDistDeUnit :: Rule\nruleLatentDistDeUnit = Rule\n  { name = \"<latent dist> foot/inch/yard/meter/kilometer/centimeter\"\n  , pattern =\n    [ dimension Distance\n    , regex \"de (inc(hi?|i)|(centi|kilo)?metr[iu]|mil[ea\u00c4\u0192]|[ck]?m|picio(are|r)|y(ar)?(zi|d)?)\"\n    ]\n  , prod = \\case\n      (Token Distance dd:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         x <- HashMap.lookup (Text.toLower match) unitMap\n         Just . Token Distance $ withUnit x dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentDistUnit\n  , ruleLatentDistDeUnit\n  ]\n", "num_lines": 93}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.SV.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale SV Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 kilometer\"\n             , \"3 km\"\n             , \"3km\"\n             , \"3k\"\n             ]\n  , examples (simple Kilometre 30)\n             [ \"3 mil\"\n             , \"tre mil\"\n             , \"n\u00c3\u00a5gra f\u00c3\u00a5 mil\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9 meter\"\n             , \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2cm\"\n             , \"2 centimeter\"\n             ]\n  ]\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.SV.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport Duckling.Distance.Types (DistanceData(..))\nimport Duckling.Types\nimport qualified Duckling.Distance.Types as TDistance\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"k(ilo)?m?(eter)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meter\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m(eter)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"cm|centimeter\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMils :: Rule\nruleDistMils = Rule\n  { name = \"<dist> mils\"\n  , pattern =\n    [ dimension Distance\n    , regex \"mils?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd@DistanceData {TDistance.value = Just x}:_) ->\n        Just . Token Distance . withValue (10 * x)\n          $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMils\n  , ruleLatentDistKm\n  ]\n", "num_lines": 84}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.TR.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Distance.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale TR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Kilometre 3)\n             [ \"3 Kilometre\"\n             , \"3 kilometre\"\n             , \"3 km\"\n             , \"3km\"\n             ]\n  , examples (simple Kilometre 3.0)\n             [ \"3,0 km\"\n             ]\n  , examples (simple Mile 8)\n             [ \"8 Mil\"\n             , \"8 mil\"\n             ]\n  , examples (simple Metre 9)\n             [ \"9 Metre\"\n             , \"9 metre\"\n             , \"9 m\"\n             , \"9m\"\n             ]\n  , examples (simple Centimetre 2)\n             [ \"2 Santimetre\"\n             , \"2 santim\"\n             , \"2 cm\"\n             , \"2cm\"\n             ]\n  ]\n", "num_lines": 52}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Distance.TR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.Helpers\nimport qualified Duckling.Distance.Types as TDistance\nimport Duckling.Types\n\nruleLatentDistKm :: Rule\nruleLatentDistKm = Rule\n  { name = \"<latent dist> km\"\n  , pattern =\n    [ dimension Distance\n    , regex \"k(ilo)?m?(etre)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Kilometre dd\n      _ -> Nothing\n  }\n\nruleDistMeters :: Rule\nruleDistMeters = Rule\n  { name = \"<dist> meters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"m(etre)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Metre dd\n      _ -> Nothing\n  }\n\nruleDistCentimeters :: Rule\nruleDistCentimeters = Rule\n  { name = \"<dist> centimeters\"\n  , pattern =\n    [ dimension Distance\n    , regex \"cm|santim(etre)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Centimetre dd\n      _ -> Nothing\n  }\n\nruleDistMiles :: Rule\nruleDistMiles = Rule\n  { name = \"<dist> miles\"\n  , pattern =\n    [ dimension Distance\n    , regex \"mil\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Distance dd:_) ->\n        Just . Token Distance $ withUnit TDistance.Mile dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDistCentimeters\n  , ruleDistMeters\n  , ruleDistMiles\n  , ruleLatentDistKm\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n-- | This module shadows names of some units previously defined in\n-- 'Duckling.Distance.Types'.\n-- Therefore, the units from that module must be used qualified by module.\nmodule Duckling.DistanceUnits.Types\n  ( ContextualDistance (..)\n  , toSystemUnit\n  , toRawUnit\n  ) where\n\nimport Data.Semigroup\nimport Data.Tuple.Extra (both)\nimport Prelude\n\nimport qualified Duckling.Distance.Types as TDist\n\n\n-- | Supports deferred resolution of ambiguous units.\n-- Note that this sum type cannot be simply replaced by\n-- \"Maybe (ContextualDistance Double DeferrableUnit)\"\n-- (with \"Nothing\" representing \"Nonrelatable\").\n-- See \"NOTE A\" below.\ndata ContextualDistance\n  = Nonrelatable\n    -- ^ If two different ambiguous units were to be composed, then\n    -- it would not be possible to decide which to resolve to. As of today,\n    -- this won't happen since for now \"M\" is the lone ambiguous unit.\n  | ContextualDistance Double DeferrableUnit\n\n-- | This represents Units that have not yet been established as unrelatable.\n-- The \"Definite\" constructor is purposely listed in front of \"Ambiguous\",\n-- so that it will be preferred when taking choosing the \"min\" between\n-- an \"Ambiguous\" and \"Definite\" unit.\ndata DeferrableUnit\n  = Definite SystemUnit\n  | Ambiguous AmbiguousUnit\n  deriving (Eq, Ord)\n\n-- | These measurement-system-specific units exist to disambiguate\n-- the \\\"M\\\" of the 'Unit' type and to maintain the measurement-system context\n-- for resolving to the appropriate precision.\n--\n-- It's also just handy to have separate programmatically accessible lists\n-- of units for each type of measurement system.\ndata SystemUnit\n  = Metric MetricUnit\n  | Imperial ImperialUnit\n  deriving (Eq, Ord)\n\ndata ImperialUnit\n  = Inch\n  | Foot\n  | Yard\n  | Mile\n  deriving (Eq, Ord)\n\ndata MetricUnit\n  = Millimetre\n  | Centimetre\n  | Metre\n  | Kilometre\n  deriving (Eq, Ord)\n\n-- | Currently there is only one actually ambiguous unit, but this design allows\n-- for expansion.\ndata AmbiguousUnit\n  = M -- ^ \"Miles\" or \"Metres\"\n  deriving (Eq, Ord)\n\n-- | Represents a value with an unambiguous unit\ndata UnitValuePair = UnitValuePair SystemUnit Double\n\nsumScaledUnits :: SystemUnit -> (UnitValuePair, UnitValuePair) -> Double\nsumScaledUnits preferredUnit = uncurry (+) . both (scaleUnits preferredUnit)\n\n-- | Determine the definite meaning of an \"Ambiguous\" unit using the context of\n-- another \"Definite\" unit\nreconcileAmbiguousWithDefinite ::\n     Double\n  -> AmbiguousUnit\n  -> Double\n  -> SystemUnit\n  -> ContextualDistance\nreconcileAmbiguousWithDefinite av au dv du =\n  ContextualDistance combinedValue $ Definite preferredUnit\n  where\n    resolvedAmbiguousUnit = resolveUnit au du\n    preferredUnit = du `min` resolvedAmbiguousUnit\n    combinedValue = sumScaledUnits preferredUnit\n      (UnitValuePair resolvedAmbiguousUnit av, UnitValuePair du dv)\n\n-- | When both Metric and Imperial units are given, resolve to Metric.\n-- Otherwise, preserve the original measurement system and use the smaller unit.\n-- For the purpose of this resolution, all Metric units are considered \"smaller\"\n-- than Imperial units.\ninstance Semigroup ContextualDistance where\n\n  _ <> Nonrelatable = Nonrelatable\n  Nonrelatable <> _ = Nonrelatable\n\n  (ContextualDistance v1 u@(Ambiguous u1))\n    <> (ContextualDistance v2 (Ambiguous u2))\n      | u1 == u2  = ContextualDistance (v1 + v2) u\n      | otherwise = Nonrelatable\n      -- NOTE A: Needing to return \"Nonrelatable\" in this edge case is why\n      -- the two-member \"ContextualDistance\" sum type cannot be simply\n      -- represented as (Maybe (ContextualDistance Double DeferrableUnit)).\n\n  (ContextualDistance av (Ambiguous au))\n    <> (ContextualDistance dv (Definite du)) =\n      reconcileAmbiguousWithDefinite av au dv du\n\n  (ContextualDistance dv (Definite du))\n    <> (ContextualDistance av (Ambiguous au)) =\n      reconcileAmbiguousWithDefinite av au dv du\n\n  (ContextualDistance v1 (Definite u1))\n    <> (ContextualDistance v2 (Definite u2)) =\n      ContextualDistance v $ Definite u\n      where\n        v = sumScaledUnits u (UnitValuePair u1 v1, UnitValuePair u2 v2)\n        u = u1 `min` u2\n\nresolveUnit :: AmbiguousUnit -> SystemUnit -> SystemUnit\nresolveUnit M (Metric _) = Metric Metre\nresolveUnit M (Imperial _) = Imperial Mile\n\n\n-- | Disambiguation of original Unit type\ntoSystemUnit :: TDist.Unit -> DeferrableUnit\ntoSystemUnit TDist.M          = Ambiguous M\ntoSystemUnit TDist.Millimetre = Definite $ Metric Millimetre\ntoSystemUnit TDist.Centimetre = Definite $ Metric Centimetre\ntoSystemUnit TDist.Metre      = Definite $ Metric Metre\ntoSystemUnit TDist.Kilometre  = Definite $ Metric Kilometre\ntoSystemUnit TDist.Inch       = Definite $ Imperial Inch\ntoSystemUnit TDist.Foot       = Definite $ Imperial Foot\ntoSystemUnit TDist.Yard       = Definite $ Imperial Yard\ntoSystemUnit TDist.Mile       = Definite $ Imperial Mile\n\n-- | Reconversion to original Unit type\ntoRawUnit :: DeferrableUnit -> TDist.Unit\ntoRawUnit (Ambiguous M) = TDist.M\ntoRawUnit (Definite (Metric Millimetre)) = TDist.Millimetre\ntoRawUnit (Definite (Metric Centimetre)) = TDist.Centimetre\ntoRawUnit (Definite (Metric Metre)) = TDist.Metre\ntoRawUnit (Definite (Metric Kilometre)) = TDist.Kilometre\ntoRawUnit (Definite (Imperial Inch)) = TDist.Inch\ntoRawUnit (Definite (Imperial Foot)) = TDist.Foot\ntoRawUnit (Definite (Imperial Yard)) = TDist.Yard\ntoRawUnit (Definite (Imperial Mile)) = TDist.Mile\n\n-- | Convert a distance to the given units.\n-- This only works if the unit is unambiguous.\nscaleUnits ::\n     SystemUnit -- ^ target unit\n  -> UnitValuePair -- ^ Original unit and value\n  -> Double\nscaleUnits targetUnit (UnitValuePair startingUnit v)\n  | startingUnit == targetUnit = v\n  | otherwise = inSIUnits v startingUnit / inSIUnits 1 targetUnit\n\n-- | This is used when distances\n-- must be normalized across measurement systems.\n-- The Metric metre is the Standard International unit of distance.\ninSIUnits :: Double -> SystemUnit -> Double\ninSIUnits val (Metric u) = inMetres u val\ninSIUnits val (Imperial u) = inInches u val * metersPerInch\n\n-- | This conversion factor is exact.\nmetersPerInch :: Double\nmetersPerInch = 0.0254\n\ninMetres :: Fractional a => MetricUnit -> a -> a\ninMetres Millimetre n = n / 1000\ninMetres Centimetre n = n / 100\ninMetres Metre      n = n\ninMetres Kilometre  n = n * 1000\n\ninInches :: Num a => ImperialUnit -> a -> a\ninInches Inch n = n\ninInches Foot n = 12   * n\ninInches Yard n = 3    * inInches Foot n\ninInches Mile n = 5280 * inInches Foot n\n", "num_lines": 191}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Duration.Helpers\n  ( duration\n  , isGrain\n  , isNatural\n  , minutesFromHourMixedFraction\n  , nPlusOneHalf\n  , secondsFromHourMixedFraction\n  , timesOneQuarter\n  , timesThreeQuarter\n  , inCoarsestGrain\n  ) where\n\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Types (DurationData (DurationData))\nimport Duckling.Numeral.Helpers (isNatural)\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\n-- -----------------------------------------------------------------\n-- Patterns\n\nisGrain :: TG.Grain -> Predicate\nisGrain value (Token TimeGrain grain) = grain == value\nisGrain _ _ = False\n\n-- -----------------------------------------------------------------\n-- Production\n\nduration :: TG.Grain -> Int -> DurationData\nduration grain n = DurationData {TDuration.grain = grain, TDuration.value = n}\n\nminutesFromHourMixedFraction :: Integer -> Integer -> Integer -> DurationData\nminutesFromHourMixedFraction h n d =\n  duration TG.Minute $ fromIntegral $ 60 * h + quot (n * 60) d\n\nnPlusOneHalf :: TG.Grain -> Int -> Maybe DurationData\nnPlusOneHalf grain = case grain of\n  TG.Minute -> Just . duration TG.Second . (30+) . (60*)\n  TG.Hour   -> Just . duration TG.Minute . (30+) . (60*)\n  TG.Day    -> Just . duration TG.Hour   . (12+) . (24*)\n  TG.Month  -> Just . duration TG.Day    . (15+) . (30*)\n  TG.Year   -> Just . duration TG.Month  . (6+)  . (12*)\n  _         -> const Nothing\n\nsecondsFromHourMixedFraction :: Integer -> Integer -> Integer -> DurationData\nsecondsFromHourMixedFraction m s d =\n  duration TG.Second $ fromIntegral $ 60 * m + quot (s * 60) d\n\ntimesOneQuarter :: TG.Grain -> Int -> Maybe DurationData\ntimesOneQuarter grain = case grain of\n  TG.Minute -> Just . duration TG.Second . (15+) . (60*)\n  TG.Hour   -> Just . duration TG.Minute . (15+) . (60*)\n  TG.Day    -> Just . duration TG.Hour   . (6+) . (24*)\n  TG.Month  -> Just . duration TG.Day    . (7+) . (30*)\n  TG.Year   -> Just . duration TG.Month  . (3+)  . (12*)\n  _         -> const Nothing\n\ntimesThreeQuarter :: TG.Grain -> Int -> Maybe DurationData\ntimesThreeQuarter grain = case grain of\n  TG.Minute -> Just . duration TG.Second . (45+) . (60*)\n  TG.Hour   -> Just . duration TG.Minute . (45+) . (60*)\n  TG.Day    -> Just . duration TG.Hour   . (18+) . (24*)\n  TG.Month  -> Just . duration TG.Day    . (21+) . (30*)\n  TG.Year   -> Just . duration TG.Month  . (9+)  . (12*)\n  _         -> const Nothing\n\ninCoarsestGrain :: TG.Grain -> Double -> DurationData\ninCoarsestGrain g v =\n  go g\n  where\n    seconds = fromIntegral (floor $ TG.inSeconds g v :: Int)\n    go grain =\n      -- recursion terminates because `seconds` is an Integer\n      let inGrain = seconds / TG.inSeconds grain 1\n      in case TNumeral.getIntValue inGrain of\n        Just n -> duration grain n\n        Nothing -> go $ TG.lower grain\n", "num_lines": 91}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleIntegerUnitofduration :: Rule\nruleIntegerUnitofduration = Rule\n  { name = \"<integer> <unit-of-duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain grain:\n       _) -> Just . Token Duration . duration grain $ floor v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleIntegerUnitofduration\n  ]\n", "num_lines": 43}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Duration.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Semigroup\nimport Data.Text (Text)\nimport Data.Tuple.Extra (both)\nimport GHC.Generics\nimport TextShow (showt)\nimport Prelude\n\nimport Duckling.Resolve (Resolve(..))\nimport Duckling.TimeGrain.Types (Grain(..), inSeconds)\n\ndata DurationData = DurationData\n  { value :: Int\n  , grain :: Grain\n  }\n  deriving (Eq, Generic, Hashable, Show, Ord, NFData)\n\ninstance Resolve DurationData where\n  type ResolvedValue DurationData = DurationData\n  resolve _ _ x = Just (x, False)\n\ninstance Semigroup DurationData where\n  d1@(DurationData _ g1) <> d2@(DurationData _ g2) = DurationData (v1+v2) g\n    where\n    g = g1 `min` g2\n    (DurationData v1 _, DurationData v2 _) = both (withGrain g) (d1,d2)\n\ninstance ToJSON DurationData where\n  toJSON DurationData {value, grain} = object\n    [ \"type\"       .= (\"value\" :: Text)\n    , \"value\"      .= value\n    , \"unit\"       .= grain\n    , showt grain  .= value\n    , \"normalized\" .= object\n      [ \"unit\"  .= (\"second\" :: Text)\n      , \"value\" .= inSeconds grain value\n      ]\n    ]\n\n-- | Convert a duration to the given grain, rounded to the\n-- nearest integer. For example, 1 month is converted to 4 weeks.\nwithGrain :: Grain -> DurationData -> DurationData\nwithGrain g d@(DurationData v1 g1)\n  | g == g1 = d\n  | otherwise = DurationData v g\n      where\n      v = round $ inSeconds g1 (fromIntegral v1 :: Double) / inSeconds g 1\n", "num_lines": 66}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.AR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale AR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"\u00d8\u00ab\u00d8\u00a7\u00d9\u2020\u00d9\u0160\u00d8\u00a9\"\n             , \"\u00d9\u201e\u00d8\u00ad\u00d8\u00b8\u00d8\u00a9\"\n             ]\n  , examples (DurationData 2 Minute)\n             [ \"\u00d8\u00af\u00d9\u201a\u00d9\u0160\u00d9\u201a\u00d8\u00aa\u00d8\u00a7\u00d9\u2020\"\n             , \"\u00d8\u00af\u00d9\u201a\u00d9\u0160\u00d9\u201a\u00d8\u00aa\u00d9\u0160\u00d9\u2020\"\n             ]\n  , examples (DurationData 5 Hour)\n             [ \"\u00d8\u00ae\u00d9\u2026\u00d8\u00b3\u00d8\u00a9 \u00d8\u00b3\u00d8\u00a7\u00d8\u00b9\u00d8\u00a7\u00d8\u00aa\"\n             ]\n  , examples (DurationData 30 Day)\n             [ \"30 \u00d9\u0160\u00d9\u02c6\u00d9\u2026\"\n             ]\n  , examples (DurationData 1 Week)\n             [ \"\u00d8\u00a7\u00d8\u00b3\u00d8\u00a8\u00d9\u02c6\u00d8\u00b9\"\n             ]\n  , examples (DurationData 7 Week)\n             [ \"\u00d8\u00b3\u00d8\u00a8\u00d8\u00b9 \u00d8\u00a7\u00d8\u00b3\u00d8\u00a7\u00d8\u00a8\u00d9\u0160\u00d8\u00b9\"\n             ]\n  , examples (DurationData 1 Month)\n             [ \"\u00d8\u00b4\u00d9\u2021\u00d8\u00b1\"\n             ]\n  , examples (DurationData 2 Month)\n             [ \"\u00d8\u00b4\u00d9\u2021\u00d8\u00b1\u00d9\u0160\u00d9\u2020\"\n             ]\n  , examples (DurationData 2 Year)\n             [ \"\u00d8\u00b3\u00d9\u2020\u00d8\u00aa\u00d9\u0160\u00d9\u2020\"\n             , \"\u00d8\u00b3\u00d9\u2020\u00d8\u00aa\u00d8\u00a7\u00d9\u2020\"\n             , \"\u00d8\u00b9\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\"\n             , \"\u00d8\u00b9\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\"\n             ]\n  ]\n", "num_lines": 61}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.CA.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale CA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 30 Minute)\n             [ \"mitja hora\"\n             , \"dos quarts\"\n             , \"30 minuts\"\n             , \"trenta minuts\"\n             ]\n  , examples (DurationData 15 Minute)\n             [  \"quart d'hora\"\n             ,  \"un quart d'hora\"\n             ,  \"1 quart d'hora\"\n             ,  \"1/4 d'hora\"\n             ,  \"quinze minuts\"\n             ,  \"15 minuts\"\n             ]\n  , examples (DurationData 45 Minute)\n             [  \"tres quarts d'hora\"\n             ,  \"3/4 d'hora\"\n             ,  \"3 quarts d'hora\"\n             ,  \"tres quarts\"\n             ,  \"quaranta-cinc minuts\"\n             ,  \"45 minuts\"\n             ]\n  , examples (DurationData 92 Minute)\n             [ \"una hora i trenta-dos minuts\"\n             , \"una hora trenta-dos minuts\"\n             ]\n  , examples (DurationData 155 Minute)\n             [ \"dues hores i trenta-cinc minuts\"\n             , \"dues hores trenta-cinc minuts\"\n             ]\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.CA.Rules\n  ( rules\n  ) where\n\nimport Prelude\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Duration.Types (DurationData(..))\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDurationQuarterOfAnHour :: Rule\nruleDurationQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern =\n    [ regex \"((1 |un )?quarts?|1/4) d'hora\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 15\n  }\n\nruleDurationHalfOfAnHour :: Rule\nruleDurationHalfOfAnHour = Rule\n  { name = \"half of an hour\"\n  , pattern =\n    [ regex \"(mitja hora|dos quarts)\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 30\n  }\n\nruleDurationThreeQuartersOfAnHour :: Rule\nruleDurationThreeQuartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern =\n    [ regex \"((tres|3) quarts|3/4)( d'hor([a]|(es)))?\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 45\n  }\n\nruleCompositeDurationCommasAnd :: Rule\nruleCompositeDurationCommasAnd = Rule\n  { name = \"composite <duration> (with and)\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \"i\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleCompositeDuration :: Rule\nruleCompositeDuration = Rule\n  {\n    name = \"composite <duration>\"\n  , pattern =\n    [\n      Predicate isNatural\n    , dimension TimeGrain\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDurationHalfOfAnHour\n  , ruleDurationQuarterOfAnHour\n  , ruleDurationThreeQuartersOfAnHour\n  , ruleCompositeDuration\n  , ruleCompositeDurationCommasAnd\n  ]\n", "num_lines": 98}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.DA.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (parseInteger)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\nruleExactlyDuration :: Rule\nruleExactlyDuration = Rule\n  { name = \"exactly <duration>\"\n  , pattern =\n    [ regex \"pr(\u00c3\u00a6)cis\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      -- TODO(jodent) +precision exact\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntegerAndAnHalfHours :: Rule\nruleIntegerAndAnHalfHours = Rule\n  { name = \"<integer> and an half hours\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"og (en )?halv timer?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleAUnitofduration :: Rule\nruleAUnitofduration = Rule\n  { name = \"a <unit-of-duration>\"\n  , pattern =\n    [ regex \"en|et?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleIntegerMoreUnitofduration :: Rule\nruleIntegerMoreUnitofduration = Rule\n  { name = \"<integer> more <unit-of-duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \"mere|mindre\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain grain:\n       _) -> Just . Token Duration . duration grain $ floor v\n      _ -> Nothing\n  }\n\nruleFortnight :: Rule\nruleFortnight = Rule\n  { name = \"fortnight\"\n  , pattern =\n    [ regex \"(a|one)? fortnight\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Day 14\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"(omkring|cirka|ca.)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      -- TODO(jodent) +precision approximate\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleNumeralnumberHours :: Rule\nruleNumeralnumberHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\,(\\\\d+)\"\n    , regex \"timer?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"(1/2|en halv) time\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAUnitofduration\n  , ruleAboutDuration\n  , ruleExactlyDuration\n  , ruleFortnight\n  , ruleHalfAnHour\n  , ruleIntegerAndAnHalfHours\n  , ruleIntegerMoreUnitofduration\n  , ruleNumeralnumberHours\n  ]\n", "num_lines": 139}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.DE.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DE Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"ein sekunde\"\n             , \"zirka eine sekunde\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"1/2 stunde\"\n             , \"1/2stunde\"\n             , \"eine halbe stunde\"\n             , \"einer halben stunde\"\n             , \"halbe stunde\"\n             , \"halben stunde\"\n             , \"ungefahr einer halben stunde\"\n             ]\n  , examples (DurationData 15 Minute)\n             [ \"einer Viertelstunde\"\n             , \"eine viertelstunde\"\n             , \"ViErTelStUnDe\"\n             , \"genau viertelstunde\"\n             ]\n  , examples (DurationData 45 Minute)\n             [ \"3/4 stunde\"\n             , \"3/4stunde\"\n             , \"eine dreiviertel stunde\"\n             , \"einer dreiviertel stunde\"\n             , \"dreiviertel stunde\"\n             , \"drei viertelstunden\"\n             ]\n  , examples (DurationData 92 Minute)\n             [ \"92 minuten\"\n             , \"zweiundneunzig minuten\"\n             , \"eine Stunde und zweiunddrei\u00c3\u0178ig Minuten\"\n             , \"ein stunde und zweiunddreissig minuten\"\n             ]\n  , examples (DurationData 30 Day)\n             [ \"30 tage\"\n             , \"drei\u00c3\u0178ig tage\"\n             , \"dreissig tage\"\n             ]\n  , examples (DurationData 7 Week)\n             [ \"7 Wochen\"\n             , \"sieben wochen\"\n             ]\n  , examples (DurationData 90 Minute)\n             [ \"1,5 stunden\"\n             , \"1,5 stunde\"\n             , \"90 min\"\n             , \"90min\"\n             ]\n  , examples (DurationData 75 Minute)\n             [ \"1,25 stunden\"\n             ]\n  , examples (DurationData 31719604 Second)\n             [ \"1 Jahr, 2 Tage, 3 Stunden und 4 Sekunden\"\n             , \"1 Jahr 2 Tage 3 Stunden und 4 Sekunden\"\n             ]\n  , examples (DurationData 330 Second)\n             [ \"5 und eine halbe Minuten\"\n             , \"5,5 min\"\n             ]\n  , examples (DurationData 330 Minute)\n             [ \"5 und eine halbe stunden\"\n             , \"5,5 stunde\"\n             , \"exakt 5,5 stunden\"\n             ]\n  , examples (DurationData 930 Second)\n              [ \"15,5 minuten\"\n              , \"15,5 minute\"\n              , \"15,5 min\"\n              ]\n  ]\n", "num_lines": 98}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.DE.Rules\n  ( rules ) where\n\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Regex.Types\nimport Control.Monad (join)\nimport qualified Data.Text as Text\nimport Prelude\nimport Duckling.Numeral.Helpers (numberBetween, parseInteger)\nimport Duckling.Duration.Types (DurationData(..))\nimport qualified Duckling.Duration.Types as TDuration\nimport Data.String\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.TimeGrain.Types as TG\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Types\n\nruleQuarterOfAnHour :: Rule\nruleQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern =\n    [ regex \"(einer? )?Viertelstunde\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 15\n  }\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"(1/2\\\\s?|(eine )?halbe |(einer )?halben )stunde\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 30\n  }\n\nruleThreeQuartersOfAnHour :: Rule\nruleThreeQuartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern =\n    [ regex \"3/4\\\\s?stunde|(einer? )?dreiviertel stunde|drei viertelstunden\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 45\n  }\n\nruleFortnight :: Rule\nruleFortnight = Rule\n  { name = \"fortnight\"\n  , pattern =\n    [ regex \"zwei Wochen\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Day 14\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about|exactly <duration>\"\n  , pattern =\n    [ regex \"ungef(\u00c3\u00a4|a)hr|zirka|genau|exakt\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleCommaNumeralHours :: Rule\nruleCommaNumeralHours = Rule\n  { name = \"number,number hours\"\n  , pattern =\n    [ regex \"(\\\\d+),(\\\\d+)\"\n    , Predicate $ isGrain TG.Hour\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just $ Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleCommaNumeralMinutes :: Rule\nruleCommaNumeralMinutes = Rule\n  { name = \"number,number minutes\"\n  , pattern =\n    [ regex \"(\\\\d+),(\\\\d+)\"\n    , Predicate $ isGrain TG.Minute\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (m:s:_)):_) -> do\n        mm <- parseInteger m\n        ss <- parseInteger s\n        let sden = 10 ^ Text.length s\n        Just $ Token Duration $ secondsFromHourMixedFraction mm ss sden\n      _ -> Nothing\n  }\n\nruleAndHalfHour :: Rule\nruleAndHalfHour = Rule\n  { name = \"<integer> and a half hour\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"(und )?(ein(en?)? )?halb(en?)?\"\n    , Predicate $ isGrain TG.Hour\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just $ Token Duration $ duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleAndHalfMinute :: Rule\nruleAndHalfMinute = Rule\n  { name = \"<integer> and a half minutes\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"(und )?(ein(en?)? ?)?halb(en?)?\"\n    , Predicate $ isGrain TG.Minute\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just $ Token Duration $ duration TG.Second $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleArticle :: Rule\nruleArticle = Rule\n  { name = \"a <unit-of-duration>\"\n  , pattern =\n    [ regex \"ein(en?)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (_:Token TimeGrain grain:_) -> Just $ Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleHalfTimeGrain :: Rule\nruleHalfTimeGrain = Rule\n  { name = \"half a <time-grain>\"\n  , pattern =\n    [ regex \"(ein(en)?)?(1/2|halbe?)\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (_:Token TimeGrain grain:_) -> Token Duration <$> nPlusOneHalf grain 0\n      _ -> Nothing\n  }\n\nruleCompositeDurationCommasAnd :: Rule\nruleCompositeDurationCommasAnd = Rule\n  { name = \"composite <duration> (with ,/and)\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \",|und\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleCompositeDuration :: Rule\nruleCompositeDuration = Rule\n  { name = \"composite <duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleCompositeDurationAnd :: Rule\nruleCompositeDurationAnd = Rule\n  { name = \"composite <duration> and <duration>\"\n  , pattern =\n    [ dimension Duration\n    , regex \",|und\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Duration DurationData{TDuration.value = v, TDuration.grain = g}:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g v <> dd\n      _ -> Nothing\n  }\n\nruleHoursAndMinutes :: Rule\nruleHoursAndMinutes = Rule\n  { name = \"<integer> hour and <integer>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"(ein(en?) )?stunden?( und)?\"\n    , Predicate $ and . sequence [isNatural, numberBetween 1 60]\n    , Predicate $ isGrain TG.Minute\n    ]\n  , prod = \\case\n      (Token Numeral h:\n       _:\n       Token Numeral m:\n       _) -> Just $ Token Duration $ duration TG.Minute $\n                floor (TNumeral.value m) + 60 * floor (TNumeral.value h)\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleQuarterOfAnHour\n  , ruleHalfAnHour\n  , ruleThreeQuartersOfAnHour\n  , rulePrecision\n  , ruleCommaNumeralHours\n  , ruleCommaNumeralMinutes\n  , ruleFortnight\n  , ruleAndHalfHour\n  , ruleAndHalfMinute\n  , ruleArticle\n  , ruleHalfTimeGrain\n  , ruleCompositeDurationCommasAnd\n  , ruleCompositeDuration\n  , ruleCompositeDurationAnd\n  , ruleHoursAndMinutes\n  , ruleAndHalfMinute\n  ]\n", "num_lines": 250}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.EN.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"for months\"\n      , \"in days\"\n      , \"secretary\"\n      , \"minutes\"\n      , \"I second that\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"one sec\"\n             , \"1 second\"\n             , \"1\\\"\"\n             ]\n  , examples (DurationData 2 Minute)\n             [ \"2 mins\"\n             , \"two minutes\"\n             , \"2'\"\n             , \"2 more minutes\"\n             , \"two additional minutes\"\n             , \"2 extra minutes\"\n             , \"2 less minutes\"\n             , \"2 fewer minutes\"\n             , \"2m\"\n             , \"2 m\"\n             ]\n  , examples (DurationData 30 Day)\n             [ \"30 days\"\n             ]\n  , examples (DurationData 7 Week)\n             [ \"seven weeks\"\n             ]\n  , examples (DurationData 1 Month)\n             [ \"1 month\"\n             , \"a month\"\n             ]\n  , examples (DurationData 3 Quarter)\n             [ \"3 quarters\"\n             ]\n  , examples (DurationData 2 Year)\n             [ \"2 years\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"half an hour\"\n             , \"half hour\"\n             , \"1/2 hour\"\n             , \"1/2h\"\n             , \"1/2 h\"\n             ]\n  , examples (DurationData 12 Hour)\n             [ \"half a day\"\n             , \"half day\"\n             , \"1/2 day\"\n             ]\n  , examples (DurationData 90 Minute)\n             [ \"an hour and a half\"\n             , \"one hour and half\"\n             , \"1 hour thirty\"\n             , \"1 hour and thirty\"\n             , \"1.5 hours\"\n             , \"1.5 hrs\"\n             , \"one and two quarter hour\"\n             , \"one and two quarters hour\"\n             , \"one and two quarter of hour\"\n             , \"one and two quarters of hour\"\n             ]\n  , examples (DurationData 75 Minute)\n             [ \"1 hour fifteen\"\n             , \"1 hour and fifteen\"\n             , \"one and quarter hour\"\n             , \"one and a quarter hour\"\n             , \"one and one quarter hour\"\n             , \"one and quarter of hour\"\n             , \"one and a quarter of hour\"\n             , \"one and one quarter of hour\"\n             ]\n  , examples (DurationData 130 Minute)\n             [ \"2 hours ten\"\n             , \"2 hour and 10\"\n             ]\n  , examples (DurationData 3615 Second)\n             [ \"1 hour fifteen seconds\"\n             , \"1 hour and fifteen seconds\"\n             ]\n  , examples (DurationData 45 Day)\n             [ \"a month and a half\"\n             , \"one month and half\"\n             ]\n  , examples (DurationData 27 Month)\n             [ \"2 years and 3 months\"\n             , \"2 years, 3 months\"\n             , \"2 years 3 months\"\n             ]\n  , examples (DurationData 31719604 Second)\n             [ \"1 year, 2 days, 3 hours and 4 seconds\"\n             , \"1 year 2 days 3 hours and 4 seconds\"\n               -- Oxford comma not supported:\n--           , \"1 year, 2 days, 3 hours, and 4 seconds\"\n             ]\n  , examples (DurationData 330 Second)\n             [ \"5 and a half minutes\"\n             , \"five and half min\"\n             , \"5 and an half minute\"\n             ]\n  , examples (DurationData 105 Minute)\n              [ \"one and three quarter hour\"\n              , \"one and three quarters hour\"\n              , \"one and three quarter of hour\"\n              , \"one and three quarters of hour\"\n              , \"one and three quarter of hours\"\n              , \"one and three quarters of hours\"\n              ]\n  , examples (DurationData 135 Minute)\n             [ \"two and quarter hour\"\n             , \"two and a quarter of hour\"\n             , \"two and quarter of hours\"\n             , \"two and a quarter of hours\"\n             ]\n  , examples (DurationData 105 Minute)\n              [ \"an hour and 45 minutes\"\n              , \"one hour and 45 minutes\"\n              ]\n  , examples (DurationData 90 Second)\n              [ \"a minute and 30 seconds\"\n              , \"one minute and 30 seconds\"\n              ]\n  , examples (DurationData 3630 Second)\n              [ \"an hour and 30 seconds\"]\n  , examples (DurationData 930 Second)\n              [ \"15.5 minutes\"\n              , \"15.5 minute\"\n              , \"15.5 mins\"\n              , \"15.5 min\"\n              ]\n  ]\n", "num_lines": 164}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.EN.Rules\n  ( rules\n  ) where\n\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Duration.Types (DurationData(..))\nimport Duckling.Numeral.Helpers (numberBetween, parseInteger)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDurationQuarterOfAnHour :: Rule\nruleDurationQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern =\n    [ regex \"(1/4\\\\s?h(our)?|(a\\\\s)?quarter of an hour)\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 15\n  }\n\nruleDurationHalfAnHourAbbrev :: Rule\nruleDurationHalfAnHourAbbrev = Rule\n  { name = \"half an hour (abbrev).\"\n  , pattern =\n    [ regex \"1/2\\\\s?h\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 30\n  }\n\nruleDurationThreeQuartersOfAnHour :: Rule\nruleDurationThreeQuartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern =\n    [ regex \"(3/4\\\\s?h(our)?|three(\\\\s|-)quarters of an hour)\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 45\n  }\n\nruleDurationFortnight :: Rule\nruleDurationFortnight = Rule\n  { name = \"fortnight\"\n  , pattern =\n    [ regex \"(a|one)? fortnight\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Day 14\n  }\n\nruleNumeralQuotes :: Rule\nruleNumeralQuotes = Rule\n  { name = \"<integer> + '\\\"\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"(['\\\"])\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (x:_)):\n       _) -> case x of\n         \"'\"  -> Just $ Token Duration $ duration TG.Minute $ floor v\n         \"\\\"\" -> Just $ Token Duration $ duration TG.Second $ floor v\n         _    -> Nothing\n      _ -> Nothing\n  }\n\nruleDurationNumeralMore :: Rule\nruleDurationNumeralMore = Rule\n  { name = \"<integer> more <unit-of-duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"more|additional|extra|less|fewer\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (Token Numeral nd:_:Token TimeGrain grain:_) ->\n        Just $ Token Duration $ duration grain $ floor $ TNumeral.value nd\n      _ -> Nothing\n  }\n\nruleDurationDotNumeralHours :: Rule\nruleDurationDotNumeralHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\.(\\\\d+)\"\n    , Predicate $ isGrain TG.Hour\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just $ Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleDurationAndHalfHour :: Rule\nruleDurationAndHalfHour = Rule\n  { name = \"<integer> and an half hour\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"and (an? )?half hours?\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just $ Token Duration $ duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleDurationAndHalfMinute :: Rule\nruleDurationAndHalfMinute = Rule\n  { name = \"<integer> and a half minutes\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"and (an? )?half min(ute)?s?\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just $ Token Duration $ duration TG.Second $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleDurationA :: Rule\nruleDurationA = Rule\n  { name = \"a <unit-of-duration>\"\n  , pattern =\n    [ regex \"an?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (_:Token TimeGrain grain:_) -> Just $ Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleDurationHalfATimeGrain :: Rule\nruleDurationHalfATimeGrain = Rule\n  { name = \"half a <time-grain>\"\n  , pattern =\n    [ regex \"(1/2|half)( an?)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (_:Token TimeGrain grain:_) -> Token Duration <$> nPlusOneHalf grain 0\n      _ -> Nothing\n  }\n\nruleDurationOneGrainAndHalf :: Rule\nruleDurationOneGrainAndHalf = Rule\n  { name = \"a <unit-of-duration> and a half\"\n  , pattern =\n    [ regex \"an?|one\"\n    , dimension TimeGrain\n    , regex \"and (a )?half\"\n    ]\n  , prod = \\case\n      (_:Token TimeGrain grain:_) -> Token Duration <$> nPlusOneHalf grain 1\n      _ -> Nothing\n  }\n\nruleDurationHoursAndMinutes :: Rule\nruleDurationHoursAndMinutes = Rule\n  { name = \"<integer> hour and <integer>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"hours?( and)?\"\n    , Predicate $ and . sequence [isNatural, numberBetween 1 60]\n    ]\n  , prod = \\case\n      (Token Numeral h:\n       _:\n       Token Numeral m:\n       _) -> Just $ Token Duration $ duration TG.Minute $\n         floor (TNumeral.value m) + 60 * floor (TNumeral.value h)\n      _ -> Nothing\n  }\n\nruleDurationPrecision :: Rule\nruleDurationPrecision = Rule\n  { name = \"about|exactly <duration>\"\n  , pattern =\n    [ regex \"(about|around|approximately|exactly)\"\n    , dimension Duration\n    ]\n    , prod = \\case\n        (_:token:_) -> Just token\n        _ -> Nothing\n  }\n\n-- | NOTE: Oxford comma is not supported.\nruleCompositeDurationCommasAnd :: Rule\nruleCompositeDurationCommasAnd = Rule\n  { name = \"composite <duration> (with ,/and)\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \",|and\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleCompositeDuration :: Rule\nruleCompositeDuration = Rule\n  { name = \"composite <duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleCompositeDurationAnd :: Rule\nruleCompositeDurationAnd = Rule\n  { name = \"composite <duration> and <duration>\"\n  , pattern =\n    [ dimension Duration\n    , regex \",|and\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Duration DurationData{TDuration.value = v, TDuration.grain = g}:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g v <> dd\n      _ -> Nothing\n  }\n\nruleDurationDotNumeralMinutes :: Rule\nruleDurationDotNumeralMinutes = Rule\n  { name = \"number.number minutes\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\.(\\\\d+)\"\n    , Predicate $ isGrain TG.Minute\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (m:s:_)):_) -> do\n        mm <- parseInteger m\n        ss <- parseInteger s\n        let sden = 10 ^ Text.length s\n        Just $ Token Duration $ secondsFromHourMixedFraction mm ss sden\n      _ -> Nothing\n  }\n\nruleDurationNumeralAndQuarterHour :: Rule\nruleDurationNumeralAndQuarterHour = Rule\n  { name = \"<Integer> and <Integer> quarter of hour\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"and (a |an |one |two |three )?quarters?( of)?( an)?\"\n    , Predicate $ isGrain TG.Hour\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = h}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         q <- case Text.strip $ Text.toLower match of \"a\"     -> Just 1\n                                                      \"an\"    -> Just 1\n                                                      \"one\"   -> Just 1\n                                                      \"two\"   -> Just 2\n                                                      \"three\" -> Just 3\n                                                      _       -> Just 1\n         Just $ Token Duration $ duration TG.Minute $ 15 * q + 60 * floor h\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleCompositeDurationCommasAnd\n  , ruleDurationQuarterOfAnHour\n  , ruleDurationHalfAnHourAbbrev\n  , ruleDurationThreeQuartersOfAnHour\n  , ruleDurationFortnight\n  , ruleDurationNumeralMore\n  , ruleDurationDotNumeralHours\n  , ruleDurationAndHalfHour\n  , ruleDurationAndHalfMinute\n  , ruleDurationA\n  , ruleDurationHalfATimeGrain\n  , ruleDurationOneGrainAndHalf\n  , ruleDurationHoursAndMinutes\n  , ruleDurationPrecision\n  , ruleNumeralQuotes\n  , ruleCompositeDuration\n  , ruleCompositeDurationAnd\n  , ruleCompositeDurationCommasAnd\n  , ruleDurationDotNumeralMinutes\n  , ruleDurationNumeralAndQuarterHour\n  ]\n", "num_lines": 318}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.ES.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ES Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 30 Minute)\n             [ \"media hora\"\n             , \"media horas\"\n             , \"30 minutos\"\n             , \"treinta minutos\"\n             ]\n  , examples (DurationData 15 Minute)\n             [  \"cuarto de hora\"\n             ,  \"cuartos de hora\"\n             ,  \"quince minutos\"\n             ,  \"15 minutos\"\n             ]\n  , examples (DurationData 45 Minute)\n             [  \"tres cuartos de hora\"\n             ,  \"tres cuartos de horas\"\n             ,  \"tres cuarto de hora\"\n             ,  \"tres cuarto de horas\"\n             ,  \"cuarenta y cinco minutos\"\n             ,  \"45 minutos\"\n             ]\n  , examples (DurationData 92 Minute)\n             [\n               \"una hora y treinta y dos minutos\"\n             , \"una hora treinta y dos minutos\"\n             ]\n  , examples (DurationData 155 Minute)\n             [\n               \"dos hora y treinta y cinco minutos\"\n             , \"dos hora  treinta y cinco minutos\"\n             ]\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.ES.Rules\n  ( rules\n  ) where\n\nimport Prelude\nimport Data.Semigroup ((<>))\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Duration.Types (DurationData(..))\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDurationQuarterOfAnHour :: Rule\nruleDurationQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern =\n    [ regex \"cuartos? de hora\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 15\n  }\n\nruleDurationHalfOfAnHour :: Rule\nruleDurationHalfOfAnHour = Rule\n  { name = \"half of an hour\"\n  , pattern =\n    [ regex \"media horas?\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 30\n  }\n\nruleDurationThreeQuartersOfAnHour :: Rule\nruleDurationThreeQuartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern =\n    [ regex \"tres cuartos? de horas?\"\n    ]\n  , prod = \\_ -> Just $ Token Duration $ duration TG.Minute 45\n  }\n\nruleCompositeDurationCommasAnd :: Rule\nruleCompositeDurationCommasAnd = Rule\n  { name = \"composite <duration> (with and)\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \"y\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleCompositeDuration :: Rule\nruleCompositeDuration = Rule\n  {\n    name = \"composite <duration>\"\n  , pattern =\n    [\n      Predicate isNatural\n    , dimension TimeGrain\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just $ Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDurationHalfOfAnHour\n  , ruleDurationQuarterOfAnHour\n  , ruleDurationThreeQuartersOfAnHour\n  , ruleCompositeDuration\n  , ruleCompositeDurationCommasAnd\n  ]\n", "num_lines": 99}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.FR.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, examples)\n  where\n    examples =\n      [ \"les jours\"\n      , \"en secondaire\"\n      , \"minutes\"\n      , \"pendant des mois\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"une sec\"\n             , \"1 seconde\"\n             , \"1\\\"\"\n             ]\n  , examples (DurationData 2 Minute)\n             [ \"2 mins\"\n             , \"deux minutes\"\n             , \"2'\"\n             ]\n  , examples (DurationData 30 Day)\n             [ \"30 jours\"\n             ]\n  , examples (DurationData 7 Week)\n             [ \"sept semaines\"\n             ]\n  , examples (DurationData 1 Month)\n             [ \"1 mois\"\n             , \"un mois\"\n             ]\n  , examples (DurationData 3 Quarter)\n             [ \"3 trimestres\"\n             ]\n  , examples (DurationData 2 Year)\n             [ \"2 ans\"\n             ]\n  ]\n", "num_lines": 66}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.FR.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\nruleNumeralQuotes :: Rule\nruleNumeralQuotes = Rule\n  { name = \"<integer> + '\\\"\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"(['\\\"])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (x:_)):\n       _) -> case x of\n         \"'\"  -> Just . Token Duration . duration TG.Minute $ floor v\n         \"\\\"\" -> Just . Token Duration . duration TG.Second $ floor v\n         _    -> Nothing\n      _ -> Nothing\n  }\n\nruleUneUnitofduration :: Rule\nruleUneUnitofduration = Rule\n  { name = \"une <unit-of-duration>\"\n  , pattern =\n    [ regex \"une|la|le?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token TimeGrain grain:\n       _) -> Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleUnQuartDHeure :: Rule\nruleUnQuartDHeure = Rule\n  { name = \"un quart d'heure\"\n  , pattern =\n    [ regex \"(1/4\\\\s?h(eure)?|(un|1) quart d'heure)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 15\n  }\n\nruleUneDemiHeure :: Rule\nruleUneDemiHeure = Rule\n  { name = \"une demi heure\"\n  , pattern =\n    [ regex \"(1/2\\\\s?h(eure)?|(1|une) demi(e)?(\\\\s|-)heure)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleTroisQuartsDHeure :: Rule\nruleTroisQuartsDHeure = Rule\n  { name = \"trois quarts d'heure\"\n  , pattern =\n    [ regex \"(3/4\\\\s?h(eure)?|(3|trois) quart(s)? d'heure)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 45\n  }\n\nruleDurationEnviron :: Rule\nruleDurationEnviron = Rule\n  { name = \"environ <duration>\"\n  , pattern =\n    [ regex \"environ\"\n    ]\n    , prod = \\tokens -> case tokens of\n      -- TODO(jodent) +precision approximate\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUneUnitofduration\n  , ruleUnQuartDHeure\n  , ruleUneDemiHeure\n  , ruleTroisQuartsDHeure\n  , ruleDurationEnviron\n  , ruleNumeralQuotes\n  ]\n", "num_lines": 104}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.GA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"aon soicind amhain\"\n             , \"aon soicind\"\n             , \"1 tshoicindi\"\n             , \"1 tsoicind\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"leathuair\"\n             , \"30 noimead\"\n             ]\n  , examples (DurationData 27 Minute)\n             [ \"7 noimead 20\"\n             ]\n  , examples (DurationData 14 Day)\n             [ \"coic\u00c3\u00ads\"\n             ]\n  ]\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.GA.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (numberWith)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\nruleCoics :: Rule\nruleCoics = Rule\n  { name = \"coic\u00c3\u00ads\"\n  , pattern =\n    [ regex \"coic(\u00c3\u00ad|i)s(\u00c3\u00ad|i|e)?\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Day 14\n  }\n\nruleLeathuair :: Rule\nruleLeathuair = Rule\n  { name = \"leathuair\"\n  , pattern =\n    [ regex \"leathuair(e|eanta)?\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleAonDurationAmhain :: Rule\nruleAonDurationAmhain = Rule\n  { name = \"aon X amhain\"\n  , pattern =\n    [ numberWith TNumeral.value (== 1)\n    , dimension TimeGrain\n    , numberWith TNumeral.value (== 1)\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleIntegerUnitofdurationInteger :: Rule\nruleIntegerUnitofdurationInteger = Rule\n  { name = \"<unit-integer> <unit-of-duration> <tens-integer>\"\n  , pattern =\n    [ numberWith TNumeral.value (< 10)\n    , dimension TimeGrain\n    , numberWith TNumeral.value (`elem` [10, 20 .. 50])\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token TimeGrain grain:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> Just . Token Duration . duration grain . floor $ v1 + v2\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleCoics\n  , ruleIntegerUnitofdurationInteger\n  , ruleLeathuair\n  , ruleAonDurationAmhain\n  ]\n", "num_lines": 79}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.HE.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Duration.Types (DurationData (..))\nimport Duckling.Numeral.Helpers (parseInteger)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleQuarterOfAnHour :: Rule\nruleQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern =\n    [ regex \"(1/4/s \u00d7\u00a9\u00d7\u00a2\u00d7\u201d|\u00d7\u00a8\u00d7\u2018\u00d7\u00a2 \u00d7\u00a9\u00d7\u00a2\u00d7\u201d)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 15\n  }\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"(1/2/s \u00d7\u00a9\u00d7\u00a2\u00d7\u201d|\u00d7\u2014\u00d7\u00a6\u00d7\u2122 \u00d7\u00a9\u00d7\u00a2\u00d7\u201d)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleThreequartersOfAnHour :: Rule\nruleThreequartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern =\n    [ regex \"(3/4/s \u00d7\u00a9\u00d7\u00a2\u00d7\u201d|\u00d7\u00a9\u00d7\u0153\u00d7\u2022\u00d7\u00a9\u00d7\u00aa \u00d7\u00a8\u00d7\u2018\u00d7\u00a2\u00d7\u2122 \u00d7\u00a9\u00d7\u00a2\u00d7\u201d)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 45\n  }\n\nruleNumbernumberHours :: Rule\nruleNumbernumberHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\.(\\\\d+)\"\n    , regex \"\u00d7\u00a9\u00d7\u00a2\u00d7\u201d|\u00d7\u00a9\u00d7\u00a2\u00d7\u2022\u00d7\u00aa\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleIntegerAndAnHalfHours :: Rule\nruleIntegerAndAnHalfHours = Rule\n  { name = \"<integer> and an half hours\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"\u00d7\u2022\u00d7\u2014\u00d7\u00a6\u00d7\u2122 (\u00d7\u00a9\u00d7\u00a2\u00d7\u2022\u00d7\u00aa|\u00d7\u00a9\u00d7\u00a2\u00d7\u201d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"(\u00d7\u2018\u00d7\u00a2\u00d7\u00a8\u00d7\u0161|\u00d7\u00a1\u00d7\u2018\u00d7\u2122\u00d7\u2018\u00d7\u2022\u00d7\u00aa|\u00d7\u2018\u00d7\u00a7\u00d7\u2122\u00d7\u00a8\u00d7\u2022\u00d7\u2018)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleExactlyDuration :: Rule\nruleExactlyDuration = Rule\n  { name = \"exactly <duration>\"\n  , pattern =\n    [ regex \"\u00d7\u2018\u00d7\u201c\u00d7\u2122\u00d7\u2022\u00d7\u00a7\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAboutDuration\n  , ruleExactlyDuration\n  , ruleHalfAnHour\n  , ruleIntegerAndAnHalfHours\n  , ruleNumbernumberHours\n  , ruleQuarterOfAnHour\n  , ruleThreequartersOfAnHour\n  ]\n", "num_lines": 121}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.HU.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HU Nothing}, testOptions, allExamples)\n\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"egy m\u00c3\u00a1sodperc\"\n             , \"1 m\u00c3\u00a1sodperc\"\n             ]\n  , examples (DurationData 2 Minute)\n             [ \"2 perc\"\n             , \"kett\u00c5\u2018 perc\"\n             ]\n  , examples (DurationData 15 Minute)\n             [ \"negyed \u00c3\u00b3ra\"\n             , \"negyed\u00c3\u00b3ra\"\n             , \"negyed-\u00c3\u00b3ra\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"f\u00c3\u00a9l \u00c3\u00b3ra\"\n             , \"f\u00c3\u00a9l\u00c3\u00b3ra\"\n             , \"f\u00c3\u00a9l-\u00c3\u00b3ra\"\n             ]\n  , examples (DurationData 45 Minute)\n             [ \"h\u00c3\u00a1romnegyed \u00c3\u00b3ra\"\n             , \"h\u00c3\u00a1romnegyed-\u00c3\u00b3ra\"\n             , \"h\u00c3\u00a1romnegyed\u00c3\u00b3ra\"\n             , \"3/4 \u00c3\u00b3ra\"\n             , \"3/4\u00c3\u00b3ra\"\n             ]\n  , examples (DurationData 150 Minute)\n             [ \"2.5 \u00c3\u00b3ra\"\n             , \"kett\u00c5\u2018 \u00c3\u00a9s f\u00c3\u00a9l \u00c3\u00b3ra\"\n             , \"kett\u00c5\u2018 \u00c3\u00a9s f\u00c3\u00a9l-\u00c3\u00b3ra\"\n             , \"kett\u00c5\u2018 \u00c3\u00a9s f\u00c3\u00a9l\u00c3\u00b3ra\"\n             ]\n  , examples (DurationData 30 Day)\n             [ \"30 nap\"\n             ]\n  , examples (DurationData 7 Week)\n             [ \"h\u00c3\u00a9t h\u00c3\u00a9t\"\n             ]\n  , examples (DurationData 1 Month)\n             [ \"egy h\u00c3\u00b3nap\"\n             ]\n  , examples (DurationData 3 Quarter)\n             [ \"3 negyed\u00c3\u00a9v\"\n             ]\n  , examples (DurationData 2 Year)\n             [ \"2 \u00c3\u00a9v\"\n             ]\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.HU.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (parseInt, parseInteger)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDurationQuarterOfAnHour :: Rule\nruleDurationQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern =\n    [ regex \"(negyed[\\\\s-]?\\x00F3ra)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 15\n  }\n\nruleDurationHalfAnHour :: Rule\nruleDurationHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"(f\\x00E9l[\\\\s-]?\\x00F3ra)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleDurationThreeQuartersOfAnHour :: Rule\nruleDurationThreeQuartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern =\n    [ regex \"(3/4[\\\\s-]?\u00c3\u00b3ra|h\\x00E1romnegyed[\\\\s-]?\\x00F3ra)\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 45\n  }\n\nruleDurationDotNumeralHours :: Rule\nruleDurationDotNumeralHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\.(\\\\d+) \u00c3\u00b3ra\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleDurationAndHalfHour :: Rule\nruleDurationAndHalfHour = Rule\n  { name = \"<integer> and an half hour\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"\\x00E9s f\\x00E9l[\\\\s-]?\\x00F3ra\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDurationQuarterOfAnHour\n  , ruleDurationHalfAnHour\n  , ruleDurationThreeQuartersOfAnHour\n  , ruleDurationDotNumeralHours\n  , ruleDurationAndHalfHour\n  ]\n", "num_lines": 91}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.IT.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\nruleUneUnitofduration :: Rule\nruleUneUnitofduration = Rule\n  { name = \"une <unit-of-duration>\"\n  , pattern =\n    [ regex \"un[a']?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleUnQuartoDora :: Rule\nruleUnQuartoDora = Rule\n  { name = \"un quarto d'ora\"\n  , pattern =\n    [ regex \"un quarto d['i] ?ora\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 15\n  }\n\nruleMezzOra :: Rule\nruleMezzOra = Rule\n  { name = \"mezz'ora\"\n  , pattern =\n    [ regex \"mezz[a'] ?ora\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleTreQuartiDora :: Rule\nruleTreQuartiDora = Rule\n  { name = \"tre quarti d'ora\"\n  , pattern =\n    [ regex \"(3|tre) quarti d['i] ?ora\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 45\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleUneUnitofduration\n  , ruleUnQuartoDora\n  , ruleMezzOra\n  , ruleTreQuartiDora\n  ]\n", "num_lines": 68}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.KO.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale KO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"1 \u00ec\u00b4\u02c6\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"\u00ec\u2039\u0153\u00ea\u00b0\u201e\u00eb\u00b0\u02dc\"\n             , \"\u00ec\u2039\u0153\u00eb\u00b0\u02dc\"\n             , \"\u00ec\u201e\u0153\u00eb\u00a5\u00b8\u00eb\u00b6\u201e\"\n             ]\n  , examples (DurationData 66 Minute)\n             [ \"1.1 \u00ec\u2039\u0153\u00ea\u00b0\u201e\"\n             ]\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.KO.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (parseInteger)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ Predicate $ isGrain TG.Hour\n    , regex \"\u00eb\u00b0\u02dc\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleADay :: Rule\nruleADay = Rule\n  { name = \"a day - \u00ed\u2022\u02dc\u00eb\u00a3\u00a8\"\n  , pattern =\n    [ regex \"\u00ed\u2022\u02dc\u00eb\u00a3\u00a8\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Day 1\n  }\n\nruleNumeralnumberHours :: Rule\nruleNumeralnumberHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\.(\\\\d+)\"\n    , regex \"\u00ec\u2039\u0153\u00ea\u00b0\u201e\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleIntegerAndAnHalfHours :: Rule\nruleIntegerAndAnHalfHours = Rule\n  { name = \"<integer> and an half hours\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"\u00ec\u2039\u0153\u00ea\u00b0\u201e\u00eb\u00b0\u02dc\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"\u00eb\u0152\u20ac\u00ec\u00b6\u00a9|\u00ec\u2022\u00bd\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleExactlyDuration :: Rule\nruleExactlyDuration = Rule\n  { name = \"exactly <duration>\"\n  , pattern =\n    [ regex \"\u00ec\u00a0\u2022\u00ed\u2122\u2022\u00ed\u017e\u02c6\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleADay\n  , ruleAboutDuration\n  , ruleExactlyDuration\n  , ruleHalfAnHour\n  , ruleIntegerAndAnHalfHours\n  , ruleNumeralnumberHours\n  ]\n", "num_lines": 109}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.NB.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NB Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"1 sek\"\n             , \"en sek\"\n             , \"ett sekund\"\n             , \"e sekunder\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"tredve min\"\n             , \"30 minutt\"\n             , \"30 minutter\"\n             , \"1/2 time\"\n             , \"en halv time\"\n             ]\n  , examples (DurationData 2 Day)\n             [ \"et par dager\"\n             , \"2 dag\"\n             , \"to dag\"\n             ]\n  ]\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.NB.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (parseInteger)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"(1/2|en halv) time\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleIntegerMoreUnitofduration :: Rule\nruleIntegerMoreUnitofduration = Rule\n  { name = \"<integer> more <unit-of-duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \"mere?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain grain:\n       _) -> Just . Token Duration . duration grain $ floor v\n      _ -> Nothing\n  }\n\nruleNumeralnumberHours :: Rule\nruleNumeralnumberHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\,(\\\\d+) *timer?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleIntegerAndAnHalfHours :: Rule\nruleIntegerAndAnHalfHours = Rule\n  { name = \"<integer> and an half hours\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"og (en )?halv time?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleAUnitofduration :: Rule\nruleAUnitofduration = Rule\n  { name = \"a <unit-of-duration>\"\n  , pattern =\n    [ regex \"en|ett|et?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"(omkring|cirka|ca.|ca)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleExactlyDuration :: Rule\nruleExactlyDuration = Rule\n  { name = \"exactly <duration>\"\n  , pattern =\n    [ regex \"(precis|akkurat)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAUnitofduration\n  , ruleAboutDuration\n  , ruleExactlyDuration\n  , ruleHalfAnHour\n  , ruleIntegerAndAnHalfHours\n  , ruleIntegerMoreUnitofduration\n  , ruleNumeralnumberHours\n  ]\n", "num_lines": 126}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.NL.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NL Nothing}, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext {locale = makeLocale NL Nothing}, testOptions, examples)\n  where\n    examples =\n      [ \"voor maanden\"\n      , \"in enkele dagen\"\n      , \"secretaris\"\n      , \"last minute\"\n      , \"12 uurtje\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"een seconde\"\n             , \"\u00c3\u00a9\u00c3\u00a9n seconde\"\n             , \"1 secondes\"\n             , \"1 s\"\n             , \"1\\\"\"\n             ]\n  , examples (DurationData 14 Second)\n             [ \"veertien seconden\"\n             , \"14 s\"\n             ]\n  , examples (DurationData 2 Minute)\n             [ \"2 min\"\n             , \"twee minuten\"\n             , \"2 m\"\n             , \"2'\"\n             ]\n  , examples (DurationData 45 Minute)\n             [ \"3 kwartier\"\n             ]\n  , examples (DurationData 90 Minute)\n             [ \"anderhalf uur\"\n             ]\n  , examples (DurationData 75 Minute)\n             [ \"een uur en een kwartier\"\n             , \"een uur en 15 minuten\"\n             , \"een uur, 15 minuten\"\n             , \"een uur 15 minuten\"\n             ]\n  , examples (DurationData 165 Minute)\n             [ \"twee uur en drie kwartier\"\n             , \"twee uur, 3 kwartier\"\n             , \"twee uur, 45 minuten\"\n             , \"twee uur 45 minuten\"\n             ]\n  , examples (DurationData 1 Hour)\n             [ \"een uur\"\n             , \"\u00c3\u00a9\u00c3\u00a9n uur\"\n             , \"1 u\"\n             , \"1 h\"\n             ]\n  , examples (DurationData 30 Day)\n             [ \"30 dagen\"\n             , \"4 weken en 2 dagen\"\n             ]\n  , examples (DurationData 7 Day)\n             [ \"7 dagen\"\n             ]\n  , examples (DurationData 7 Week)\n             [ \"zeven weken\"\n             , \"7 w\"\n             ]\n  , examples (DurationData 1 Month)\n             [ \"1 mnd\"\n             , \"een maand\"\n             , \"\u00c3\u00a9\u00c3\u00a9n maand\"\n             ]\n  , examples (DurationData 3 Quarter)\n             [ \"drie kwartalen\"\n             ]\n  , examples (DurationData 2 Year)\n             [ \"2 jaar\"\n             , \"2 jaren\"\n             , \"twee jaren\"\n             , \"2 j\"\n             ]\n  , examples (DurationData 150 Minute)\n            [ \"twee en een half uur\"\n            , \"2,5 uur\"\n            ]\n  ]\n", "num_lines": 111}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Duckling.Duration.NL.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport Prelude\nimport Data.String\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Duration.Types (DurationData(..))\nimport Duckling.Numeral.Helpers (parseInt, parseInteger)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDurationQuarterOfAnHour :: Rule\nruleDurationQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern = [ regex \"1/4\\\\s?(h|u(ur)?)|kwartier\"]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 15\n  }\n\nruleDurationKwartier :: Rule\nruleDurationKwartier = Rule\n  { name = \"<integer> kwartier\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"kwartier\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 15 * floor v\n      _ -> Nothing\n  }\n\nruleDurationHalfAnHour :: Rule\nruleDurationHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern = [regex \"(1/2\\\\s?uur|half uur)\"]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleDurationThreeQuartersOfAnHour :: Rule\nruleDurationThreeQuartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern = [regex \"3/4\\\\s?uur\"]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 45\n  }\n\nruleNumeralQuotes :: Rule\nruleNumeralQuotes = Rule\n  { name = \"<integer> + '\\\"\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"(['\\\"])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (x:_)):\n       _) -> case x of\n         \"'\"  -> Just . Token Duration . duration TG.Minute $ floor v\n         \"\\\"\" -> Just . Token Duration . duration TG.Second $ floor v\n         _    -> Nothing\n      _ -> Nothing\n  }\n\nruleDurationDotNumeralHours :: Rule\nruleDurationDotNumeralHours = Rule\n  { name = \"number,number uur\"\n  , pattern = [regex \"(\\\\d+)\\\\,(\\\\d+) *(uur|uren)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleDurationAndHalfHour :: Rule\nruleDurationAndHalfHour = Rule\n  { name = \"<integer> and an half hour\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"en een half (uur|uren)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleDurationOneAndHalfHour :: Rule\nruleDurationOneAndHalfHour = Rule\n  { name = \"1 and an half hour\"\n  , pattern = [ regex \"anderhalf uur\"]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 90\n  }\n\n-- | NOTE: Oxford comma is not supported.\nruleCompositeDurationCommasAnd :: Rule\nruleCompositeDurationCommasAnd = Rule\n  { name = \"composite <duration> (with ,/and)\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \",|en|plus\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just . Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleCompositeDuration :: Rule\nruleCompositeDuration = Rule\n  { name = \"composite <duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just . Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nruleDurationPrecision :: Rule\nruleDurationPrecision = Rule\n  { name = \"about|exactly <duration>\"\n  , pattern =\n    [ regex \"(ongeveer|precies|plusminus|exact)\"\n    , dimension Duration\n    ]\n    , prod = \\tokens -> case tokens of\n        (_:token:_) -> Just token\n        _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDurationQuarterOfAnHour\n  , ruleDurationKwartier\n  , ruleCompositeDurationCommasAnd\n  , ruleCompositeDuration\n  , ruleDurationHalfAnHour\n  , ruleDurationThreeQuartersOfAnHour\n  , ruleDurationDotNumeralHours\n  , ruleDurationAndHalfHour\n  , ruleDurationOneAndHalfHour\n  , ruleDurationPrecision\n  , ruleNumeralQuotes\n  ]\n", "num_lines": 176}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.PL.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"1s\"\n             , \"1 sekund\"\n             , \"jeden sekundzie\"\n             , \"pojedynczy sekundach\"\n             , \"mniej wi\u00c4\u2122cej jedn\u00c4\u2026 sekund\u00c4\u2122\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"pol godziny\"\n             , \"p\u00c3\u00b3\u00c5\u201a godziny\"\n             , \"30m\"\n             , \"30 minut\"\n             , \"trzydzie\u00c5\u203aci minutami\"\n             ]\n  , examples (DurationData 5 Day)\n             [ \"pi\u00c4\u2122ciu dniach\"\n             ]\n  , examples (DurationData 100 Day)\n             [ \"sto dzie\u00c5\u201e\"\n             , \"setki dni\u00c4\u2026\"\n             ]\n  ]\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.PL.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (parseInteger)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"p(o|\u00c3\u00b3)(l|\u00c5\u201a) godziny\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleIntegerMoreUnitofduration :: Rule\nruleIntegerMoreUnitofduration = Rule\n  { name = \"<integer> more <unit-of-duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"more|less\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       _:\n       Token TimeGrain grain:\n       _) -> Just . Token Duration . duration grain $ floor v\n      _ -> Nothing\n  }\n\nruleNumeralnumberHours :: Rule\nruleNumeralnumberHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\.(\\\\d+)\"\n    , regex \"godzin(y)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleIntegerAndAnHalfHours :: Rule\nruleIntegerAndAnHalfHours = Rule\n  { name = \"<integer> and an half hours\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"i (p(o|\u00c3\u00b3)(l|\u00c5\u201a)) godziny\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleUnitofdurationAsADuration :: Rule\nruleUnitofdurationAsADuration = Rule\n  { name = \"<unit-of-duration> as a duration\"\n  , pattern =\n    [ dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) ->\n        Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"(oko(l|\u00c5\u201a)o|mniej wi(\u00c4\u2122|e)cej|jakie(s|\u00c5\u203a))\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleExactlyDuration :: Rule\nruleExactlyDuration = Rule\n  { name = \"exactly <duration>\"\n  , pattern =\n    [ regex \"r(o|\u00c3\u00b3)wno|dok(l|\u00c5\u201a)adnie\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAboutDuration\n  , ruleExactlyDuration\n  , ruleHalfAnHour\n  , ruleIntegerAndAnHalfHours\n  , ruleIntegerMoreUnitofduration\n  , ruleNumeralnumberHours\n  , ruleUnitofdurationAsADuration\n  ]\n", "num_lines": 128}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.PT.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"um segundo\"\n             , \"uma seg\"\n             ]\n  , examples (DurationData 2 Minute)\n             [ \"duas mins\"\n             , \"dois minutos\"\n             ]\n  , examples (DurationData 20 Day)\n             [ \"20 dias\"\n             , \"vinte d\u00c3\u00adas\"\n             ]\n  ]\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.RO.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"o sec\"\n             , \"1 secunda\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"jumatate ora\"\n             , \"1/2h\"\n             , \"treizeci minute\"\n             ]\n  , examples (DurationData 45 Minute)\n             [ \"trei sferturi de or\u00c4\u0192\"\n             , \"45min\"\n             , \"45 de minute\"\n             ]\n  , examples (DurationData 12 Week)\n             [ \"doi\u00c8\u2122pe saptamanile\"\n             , \"doisprezece sapt\u00c4\u0192m\u00c3\u00a2ni\"\n             ]\n  , examples (DurationData 2 Month)\n             [ \"2 luni\"\n             ]\n  , examples (DurationData 1 Quarter)\n             [ \"un trimestru\"\n             ]\n  ]\n", "num_lines": 53}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.RO.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (numberWith)\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleQuarterOfAnHour :: Rule\nruleQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern =\n    [ regex \"(1/4\\\\s?(h|or(a|\u00c4\u0192))|sfert de or(a|\u00c4\u0192))\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 15\n  }\n\nruleJumatateDeOra :: Rule\nruleJumatateDeOra = Rule\n  { name = \"jumatate de ora\"\n  , pattern =\n    [ regex \"(1/2\\\\s?(h|or(a|\u00c4\u0192))|jum(a|\u00c4\u0192)tate (de )?or(a|\u00c4\u0192))\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleTreiSferturiDeOra :: Rule\nruleTreiSferturiDeOra = Rule\n  { name = \"trei sferturi de ora\"\n  , pattern =\n    [ regex \"(3/4\\\\s?(h|or(a|\u00c4\u0192))|trei sferturi de or(a|\u00c4\u0192))\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 45\n  }\n\nruleOUnitofduration :: Rule\nruleOUnitofduration = Rule\n  { name = \"o <unit-of-duration>\"\n  , pattern =\n    [ regex \"o|un\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (_:Token TimeGrain grain:_) -> Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleExactInJurDeDuration :: Rule\nruleExactInJurDeDuration = Rule\n  { name = \"exact|in jur de <duration>\"\n  , pattern =\n    [ regex \"(exact|aproximativ|(i|\u00c3\u00ae)n jur de)\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntegerDeUnitofduration :: Rule\nruleIntegerDeUnitofduration = Rule\n  { name = \"<integer> <unit-of-duration>\"\n  , pattern =\n    [ numberWith TNumeral.value (>= 20)\n    , regex \"de\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:\n       _:\n       Token TimeGrain grain:\n       _) -> Just . Token Duration . duration grain $ floor v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleExactInJurDeDuration\n  , ruleJumatateDeOra\n  , ruleOUnitofduration\n  , ruleQuarterOfAnHour\n  , ruleTreiSferturiDeOra\n  , ruleIntegerDeUnitofduration\n  ]\n", "num_lines": 102}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.SV.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain(..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale SV Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"enkel sek\"\n             , \"1 sekund fler\"\n             , \"1 sekunder mer\"\n             , \"en sekunderna\"\n             , \"et sek\"\n             , \"ett sek\"\n             ]\n  , examples (DurationData 30 Minute)\n             [ \"1/2 timme\"\n             , \"en halv timme\"\n             , \"0,5 timmar\"\n             , \"30 minuterna\"\n             , \"trettio min\"\n             ]\n  , examples (DurationData 5 Year)\n             [ \"5 \u00c3\u00a5r\"\n             , \"fem \u00c3\u00a5r\"\n             , \"omkring fem \u00c3\u00a5r\"\n             , \"ungef\u00c3\u00a4r fem \u00c3\u00a5r\"\n             , \"runt fem \u00c3\u00a5r\"\n             , \"cirka fem \u00c3\u00a5r\"\n             , \"ca fem \u00c3\u00a5r\"\n             , \"ca. fem \u00c3\u00a5r\"\n             , \"c:a fem \u00c3\u00a5r\"\n             ]\n  ]\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.SV.Rules\n  ( rules\n  ) where\n\nimport Control.Monad (join)\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (parseInteger)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"(1/2|en halv) timme\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleIntegerMoreUnitofduration :: Rule\nruleIntegerMoreUnitofduration = Rule\n  { name = \"<integer> more <unit-of-duration>\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \"fler|mer\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain grain:\n       _) -> Just . Token Duration . duration grain $ floor v\n      _ -> Nothing\n  }\n\nruleNumeralnumberHours :: Rule\nruleNumeralnumberHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\,(\\\\d+)\"\n    , regex \"timm(e|ar)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleIntegerAndAnHalfHours :: Rule\nruleIntegerAndAnHalfHours = Rule\n  { name = \"<integer> and an half hours\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"och (en )?halv timme?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleAUnitofduration :: Rule\nruleAUnitofduration = Rule\n  { name = \"a <unit-of-duration>\"\n  , pattern =\n    [ regex \"en|ett?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        Just . Token Duration $ duration grain 1\n      _ -> Nothing\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"(omkring|cirka|ca\\\\.?|c:a|runt|ungef\u00c3\u00a4r)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleExactlyDuration :: Rule\nruleExactlyDuration = Rule\n  { name = \"exactly <duration>\"\n  , pattern =\n    [ regex \"(precis|exakt)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAUnitofduration\n  , ruleAboutDuration\n  , ruleExactlyDuration\n  , ruleHalfAnHour\n  , ruleIntegerAndAnHalfHours\n  , ruleIntegerMoreUnitofduration\n  , ruleNumeralnumberHours\n  ]\n", "num_lines": 129}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.TR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Duration.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.TimeGrain.Types (Grain (..))\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale TR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (DurationData 1 Second)\n             [ \"bir sn\"\n             , \"1 saniye\"\n             , \"1\\\"\"\n             ]\n  , examples (DurationData 2 Minute)\n             [ \"2 dk\"\n             , \"iki dakika\"\n             , \"2'\"\n             ]\n  , examples (DurationData 30 Day)\n             [ \"30 g\u00c3\u00bcn\"\n             ]\n  , examples (DurationData 7 Week)\n             [ \"yedi hafta\"\n             ]\n  , examples (DurationData 1 Month)\n             [ \"1 ay\"\n             , \"bir ay\"\n             ]\n  , examples (DurationData 3 Quarter)\n             [ \"3 \u00c3\u00a7eyrek y\u00c4\u00b1l\"\n             ]\n  , examples (DurationData 2 Year)\n             [ \"2 y\u00c4\u00b1l\"\n             ]\n  ]\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.TR.Rules\n  ( rules\n  ) where\n\nimport Control.Monad (join)\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Numeral.Helpers (parseInteger)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDurationQuarterOfAnHour :: Rule\nruleDurationQuarterOfAnHour = Rule\n  { name = \"quarter of an hour\"\n  , pattern = [ regex \"(1/4\\\\s?sa(at)?|\u00c3\u00a7eyrek saat)\" ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 15\n  }\n\nruleDurationHalfAnHour :: Rule\nruleDurationHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern = [regex \"(1/2\\\\s?sa(at)?|yar\\305m saat)\"]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleDurationThreeQuartersOfAnHour :: Rule\nruleDurationThreeQuartersOfAnHour = Rule\n  { name = \"three-quarters of an hour\"\n  , pattern = [regex \"(3/4\\\\s?sa(at)?|\u00c3\u00bc\u00c3\u00a7 \\231eyrek sa(at)?)\"]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 45\n  }\n\nruleDurationFortnight :: Rule\nruleDurationFortnight = Rule\n  { name = \"fortnight\"\n  , pattern = [regex \"iki hafta\"]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Day 14\n  }\n\nruleNumeralQuotes :: Rule\nruleNumeralQuotes = Rule\n  { name = \"<integer> + '\\\"\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"(['\\\"])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (x:_)):\n       _) -> case x of\n         \"'\"  -> Just . Token Duration . duration TG.Minute $ floor v\n         \"\\\"\" -> Just . Token Duration . duration TG.Second $ floor v\n         _    -> Nothing\n      _ -> Nothing\n  }\n\nruleDurationDotNumeralHours :: Rule\nruleDurationDotNumeralHours = Rule\n  { name = \"number.number hours\"\n  , pattern = [regex \"(\\\\d+)(\\\\.|,)(\\\\d+) *sa(at)?\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleDurationAndHalfHour :: Rule\nruleDurationAndHalfHour = Rule\n  { name = \"<integer> and an half hour\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"bu\u00c3\u00a7uk sa(at)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\n\nruleDurationPrecision :: Rule\nruleDurationPrecision = Rule\n  { name = \"<duration> about|exactly\"\n  , pattern =\n    [ regex \"(yakla\u00c5\u0178\u00c4\u00b1k|tam(\\\\solarak)?)\"\n    , dimension Duration\n    ]\n    , prod = \\tokens -> case tokens of\n        (_:token:_) -> Just token\n        _           -> Nothing\n  }\n\nruleDurationPrecision2 :: Rule\nruleDurationPrecision2 = Rule\n  { name = \"<duration> about|exactly\"\n  , pattern =\n    [ dimension Duration\n    , regex \"gibi|civar\u00c4\u00b1nda\"\n    ]\n  , prod = \\case\n      (token:_:_) -> Just token\n      _           -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDurationQuarterOfAnHour\n  , ruleDurationHalfAnHour\n  , ruleDurationThreeQuartersOfAnHour\n  , ruleDurationFortnight\n  , ruleDurationDotNumeralHours\n  , ruleDurationAndHalfHour\n  , ruleDurationPrecision\n  , ruleDurationPrecision2\n  , ruleNumeralQuotes\n  ]\n", "num_lines": 137}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Duration.UK.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport Data.Semigroup ((<>))\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers\nimport Duckling.Duration.Types (DurationData(..))\nimport Duckling.Numeral.Helpers (parseInt, parseInteger)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleHalfAnHour :: Rule\nruleHalfAnHour = Rule\n  { name = \"half an hour\"\n  , pattern =\n    [ regex \"(1/2\\\\s?|\u00d0\u00bf\u00d1\u2013\u00d0\u00b2\\\\s?)\u00d0\u00b3\u00d0\u00be\u00d0\u00b4\u00d0\u00b8\u00d0\u00bd\u00d0\u00b8?\"\n    ]\n  , prod = \\_ -> Just . Token Duration $ duration TG.Minute 30\n  }\n\nruleNumeralnumberHours :: Rule\nruleNumeralnumberHours = Rule\n  { name = \"number.number hours\"\n  , pattern =\n    [ regex \"(\\\\d+)\\\\.(\\\\d+) \u00d0\u00b3\u00d0\u00be\u00d0\u00b4\u00d0\u00b8\u00d0\u00bd\u00d0\u00b8?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInteger h\n        mnum <- parseInteger m\n        let mden = 10 ^ Text.length m\n        Just . Token Duration $ minutesFromHourMixedFraction hh mnum mden\n      _ -> Nothing\n  }\n\nruleIntegerAndAnHalfHours :: Rule\nruleIntegerAndAnHalfHours = Rule\n  { name = \"<integer> and an half hours\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"\u00d0\u00b7 \u00d0\u00bf\u00d0\u00be\u00d0\u00bb\u00d0\u00be\u00d0\u00b2\u00d0\u00b8\u00d0\u00bd\u00d0\u00be\u00d1\u017d \u00d0\u00b3\u00d0\u00be\u00d0\u00b4\u00d0\u00b8\u00d0\u00bd\u00d0\u00b8\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . Token Duration . duration TG.Minute $ 30 + 60 * floor v\n      _ -> Nothing\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"\u00d0\u00b1\u00d0\u00bb\u00d0\u00b8\u00d0\u00b7\u00d1\u0152\u00d0\u00ba\u00d0\u00be\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleExactlyDuration :: Rule\nruleExactlyDuration = Rule\n  { name = \"exactly <duration>\"\n  , pattern =\n    [ regex \"\u00d1\u20ac\u00d1\u2013\u00d0\u00b2\u00d0\u00bd\u00d0\u00be\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleDurationHalfATimeGrain :: Rule\nruleDurationHalfATimeGrain = Rule\n  { name = \"half a <time-grain>\"\n  , pattern =\n    [ regex \"(1/2|\u00d0\u00bf\u00d1\u2013\u00d0\u00b2)\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> Token Duration <$> nPlusOneHalf grain 0\n      _ -> Nothing\n  }\n\nruleDurationOneGrainAndHalf :: Rule\nruleDurationOneGrainAndHalf = Rule\n  { name = \"one and a hald <unit-of-duration>\"\n  , pattern =\n    [ regex \"\u00d0\u00bf\u00d1\u2013\u00d0\u00b2\u00d1\u201a\u00d0\u00be\u00d1\u20ac\u00d0\u00b8\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> Token Duration <$> nPlusOneHalf grain 1\n      _ -> Nothing\n  }\n\nruleCompositeDurationCommasAnd :: Rule\nruleCompositeDurationCommasAnd = Rule\n  { name = \"composite <duration> (with ,/and)\"\n  , pattern =\n    [ Predicate isNatural\n    , dimension TimeGrain\n    , regex \",|\u00d1\u2013\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token TimeGrain g:\n       _:\n       Token Duration dd@DurationData{TDuration.grain = dg}:\n       _) | g > dg -> Just . Token Duration $ duration g (floor v) <> dd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAboutDuration\n  , ruleExactlyDuration\n  , ruleHalfAnHour\n  , ruleIntegerAndAnHalfHours\n  , ruleNumeralnumberHours\n  , ruleDurationHalfATimeGrain\n  , ruleDurationOneGrainAndHalf\n  , ruleCompositeDurationCommasAnd\n  ]\n", "num_lines": 145}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Email.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"hey@6\"\n      , \"hey@you\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (EmailData \"alice@exAmple.io\")\n             [ \"alice@exAmple.io\"\n             ]\n  , examples (EmailData \"yo+yo@blah.org\")\n             [ \"yo+yo@blah.org\"\n             ]\n  , examples (EmailData \"1234+abc@x.net\")\n             [ \"1234+abc@x.net\"\n             ]\n  , examples (EmailData \"jean-jacques@stuff.co.uk\")\n             [ \"jean-jacques@stuff.co.uk\"\n             ]\n  ]\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.Types (EmailData (..))\nimport qualified Duckling.Email.Types as TEmail\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleEmail :: Rule\nruleEmail = Rule\n  { name = \"email\"\n  , pattern =\n    [ regex \"([\\\\w\\\\._+-]+@[\\\\w_-]+(\\\\.[\\\\w_-]+)+)\"\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (x:_)):_) ->\n        Just $ Token Email EmailData {TEmail.value = x}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleEmail\n  ]\n", "num_lines": 39}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Email.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\n\nimport Duckling.Resolve (Resolve(..))\n\nnewtype EmailData = EmailData { value :: Text }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve EmailData where\n  type ResolvedValue EmailData = EmailData\n  resolve _ _ x = Just (x, False)\n\ninstance ToJSON EmailData where\n  toJSON EmailData {value} = object\n    [ \"value\" .= value\n    , \"type\"  .= (\"value\" :: Text)\n    ]\n", "num_lines": 38}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.DE.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Email.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext {locale = makeLocale DE Nothing}\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (context, testOptions, examples)\n  where\n    examples =\n      [ \"fitness at 6.40\"\n      , \"class at 12.00\"\n      , \"tonight at 9.15\"\n      , \" dot 2@abci\"\n      , \"x@ dot x\"\n      , \"x@ x dot \"\n      , \"abc@x dot \"\n      , Text.replicate 10000 \"a at a\"\n      ]\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (EmailData \"alice@exAmple.io\")\n             [ \"alice at exAmple.io\"\n             ]\n  , examples (EmailData \"yo+yo@blah.org\")\n             [ \"yo+yo at blah.org\"\n             ]\n  , examples (EmailData \"1234+abc@x.net\")\n             [ \"1234+abc at x.net\"\n             ]\n  , examples (EmailData \"jean-jacques@stuff.co.uk\")\n             [ \"jean-jacques at stuff.co.uk\"\n             ]\n  , examples (EmailData \"asdf+ab.c@gmail.com\")\n             [ \"asdf+ab punkt c at gmail punkt com\"\n             ]\n  , examples (EmailData \"asdf.k@fb.com\")\n             [ \"asdf punkt k@fb punkt com\"\n             ]\n  ]\n", "num_lines": 65}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.DE.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.Types (EmailData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Email.Types as TEmail\n\nruleEmailSpelledOut :: Rule\nruleEmailSpelledOut = Rule\n  { name = \"email spelled out\"\n  , pattern =\n    [ regex \"([\\\\w_+-]+(?:(?: punkt |\\\\.)[\\\\w_+-]+){0,10})(?: at |@)([a-zA-Z]+(?:(?:\\\\.| punkt )[\\\\w_-]+){1,10})\"\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) ->\n        Just $ Token Email EmailData\n          { TEmail.value = Text.concat [replaceDots m1, \"@\", replaceDots m2] }\n        where replaceDots = Text.replace \" punkt \" \".\"\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleEmailSpelledOut\n  ]\n", "num_lines": 42}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.EN.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Email.Types\nimport Duckling.Testing.Types\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"fitness at 6.40\"\n      , \"class at 12.00\"\n      , \"tonight at 9.15\"\n      , \" dot 2@abci\"\n      , \"x@ dot x\"\n      , \"x@ x dot \"\n      , \"abc@x dot \"\n      , Text.replicate 10000 \"a at a\"\n      ]\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (EmailData \"alice@exAmple.io\")\n             [ \"alice at exAmple.io\"\n             ]\n  , examples (EmailData \"yo+yo@blah.org\")\n             [ \"yo+yo at blah.org\"\n             ]\n  , examples (EmailData \"1234+abc@x.net\")\n             [ \"1234+abc at x.net\"\n             ]\n  , examples (EmailData \"jean-jacques@stuff.co.uk\")\n             [ \"jean-jacques at stuff.co.uk\"\n             ]\n  , examples (EmailData \"asdf+ab.c@gmail.com\")\n             [ \"asdf+ab dot c at gmail dot com\"\n             ]\n  , examples (EmailData \"asdf.k@fb.com\")\n             [ \"asdf dot k@fb dot com\"\n             ]\n  ]\n", "num_lines": 60}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.EN.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.Types (EmailData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Email.Types as TEmail\n\nruleEmailSpelledOut :: Rule\nruleEmailSpelledOut = Rule\n  { name = \"email spelled out\"\n  , pattern =\n    [ regex \"([\\\\w_+-]+(?:(?: dot |\\\\.)[\\\\w_+-]+){0,10})(?: at |@)([a-zA-Z]+(?:(?:\\\\.| dot )[\\\\w_-]+){1,10})\"\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) ->\n        Just $ Token Email EmailData\n          { TEmail.value = Text.concat [replaceDots m1, \"@\", replaceDots m2] }\n        where replaceDots = Text.replace \" dot \" \".\"\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleEmailSpelledOut\n  ]\n", "num_lines": 42}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.FR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Email.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (EmailData \"alice@exAmple.io\")\n             [ \"alice arobase exAmple.io\"\n             ]\n  , examples (EmailData \"yo+yo@blah.org\")\n             [ \"yo+yo arobase blah.org\"\n             ]\n  , examples (EmailData \"1234+abc@x.net\")\n             [ \"1234+abc arobase x.net\"\n             ]\n  , examples (EmailData \"jean-jacques@stuff.co.uk\")\n             [ \"jean-jacques arobase stuff.co.uk\"\n             ]\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.FR.Rules\n  ( rules ) where\n\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.Types (EmailData (..))\nimport qualified Duckling.Email.Types as TEmail\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleEmailSpelledOut :: Rule\nruleEmailSpelledOut = Rule\n  { name = \"email spelled out\"\n  , pattern =\n    [ regex \"([\\\\w\\\\._+-]+) arobase ([\\\\w_-]+(\\\\.[\\\\w_-]+)+)\"\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) ->\n        Just $ Token Email EmailData {TEmail.value = Text.concat [m1, \"@\", m2]}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleEmailSpelledOut\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.IS.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Email.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IS Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (EmailData \"alice@exAmple.io\")\n             [ \"alice ingi exAmple.io\"\n             ]\n  , examples (EmailData \"yo+yo@blah.org\")\n             [ \"yo+yo ingi blah.org\"\n             ]\n  , examples (EmailData \"1234+abc@x.net\")\n             [ \"1234+abc ingi x.net\"\n             ]\n  , examples (EmailData \"jean-jacques@stuff.co.uk\")\n             [ \"jean-jacques ingi stuff.co.uk\"\n             ]\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.IS.Rules\n  ( rules ) where\n\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.Types (EmailData (..))\nimport qualified Duckling.Email.Types as TEmail\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleEmailSpelledOut :: Rule\nruleEmailSpelledOut = Rule\n  { name = \"email spelled out\"\n  , pattern =\n    [ regex \"([\\\\w\\\\._+-]+) ingi ([\\\\w_-]+(\\\\.[\\\\w_-]+)+)\"\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) ->\n        Just $ Token Email EmailData {TEmail.value = Text.concat [m1, \"@\", m2]}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleEmailSpelledOut\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.IT.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Email.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (EmailData \"alice@exAmple.io\")\n             [ \"alice chiocciola exAmple.io\"\n             ]\n  , examples (EmailData \"yo+yo@blah.org\")\n             [ \"yo+yo chiocciola blah.org\"\n             ]\n  , examples (EmailData \"1234+abc@x.net\")\n             [ \"1234+abc chiocciola x.net\"\n             ]\n  , examples (EmailData \"jean-jacques@stuff.co.uk\")\n             [ \"jean-jacques chiocciola stuff.co.uk\"\n             ]\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Email.IT.Rules\n  ( rules ) where\n\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.Types (EmailData (..))\nimport qualified Duckling.Email.Types as TEmail\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleEmailSpelledOut :: Rule\nruleEmailSpelledOut = Rule\n  { name = \"email spelled out\"\n  , pattern =\n    [ regex \"([\\\\w\\\\._+-]+) chiocciola ([\\\\w_-]+(\\\\.[\\\\w_-]+)+)\"\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) ->\n        Just $ Token Email EmailData {TEmail.value = Text.concat [m1, \"@\", m2]}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleEmailSpelledOut\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Engine.Regex\n  ( matchAll\n  , matchOnce\n  ) where\n\nimport Text.Regex.Base (matchAll, matchOnce)\n", "num_lines": 14}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Numeral.Rules\n  ( rules\n  ) where\n\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleIntegerNumeric :: Rule\nruleIntegerNumeric = Rule\n  { name = \"integer (numeric)\"\n  , pattern =\n    [ regex \"(\\\\d{1,18})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        toInteger <$> parseInt match >>= integer\n      _ -> Nothing\n  }\n\nruleFractions :: Rule\nruleFractions = Rule\n  { name = \"fractional number\"\n  , pattern =\n    [ regex \"(\\\\d+)/(\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (numerator:denominator:_)):_) -> do\n        n <- parseDecimal False numerator\n        d <- parseDecimal False denominator\n        divide n d >>= notOkForAnyTime\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleIntegerNumeric\n  , ruleFractions\n  ]\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Numeral.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Maybe\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\n\nimport Duckling.Resolve\n\ndata NumeralData = NumeralData\n  { value        :: Double\n  , grain        :: Maybe Int\n  , multipliable :: Bool\n  -- Hack until other use cases pop up,\n  -- at which point we'll craft a generic solution.\n  -- This allows to explicitly flag Numerals that don't work well with Time.\n  -- See `ruleTODLatent`. Prevents things like \"at single\", \"dozens o'clock\".\n  , okForAnyTime :: Bool\n  }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve NumeralData where\n  type ResolvedValue NumeralData = NumeralValue\n  resolve _ _ NumeralData {value} = Just (NumeralValue {vValue = value}, False)\n\nnewtype NumeralValue = NumeralValue { vValue :: Double }\n  deriving (Eq, Show)\n\ninstance ToJSON NumeralValue where\n  toJSON (NumeralValue value) = object\n    [ \"type\" .= (\"value\" :: Text)\n    , \"value\" .= value\n    ]\n\ngetIntValue :: Double -> Maybe Int\ngetIntValue x = if rest == 0 then Just int else Nothing\n  where\n    (int, rest) = properFraction x :: (Int, Double)\n\nisInteger :: Double -> Bool\nisInteger = isJust . getIntValue\n\nisMultiple :: Int -> Double -> Bool\nisMultiple base = isJust . getIntValue . (/ fromIntegral base)\n\nisIntegerBetween :: Double -> Int -> Int -> Bool\nisIntegerBetween x low high = case getIntValue x of\n  Just int -> low <= int && int <= high\n  Nothing -> False\n", "num_lines": 67}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.AF.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus =\n  ( testContext {locale = makeLocale AF Nothing}\n  , testOptions\n  , allExamples\n  )\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"nul\"\n             , \"geen\"\n             , \"niks\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"een\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"twee\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"drie\"\n             ]\n  , examples (NumeralValue 4)\n             [ \"vier\"\n             ]\n  , examples (NumeralValue 5)\n             [ \"vyf\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"ses\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"sewe\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"agt\"\n             , \"ag\"\n             ]\n  , examples (NumeralValue 9)\n             [ \"nege\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"tien\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"elf\"\n             ]\n  , examples (NumeralValue 12)\n             [ \"twaalf\"\n             , \"dosyn\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"veertien\"\n             ]\n  , examples (NumeralValue 15)\n             [ \"vyftien\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"sestien\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"sewentien\"\n             ]\n  , examples (NumeralValue 19)\n             [ \"negentien\"\n             , \"neentien\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"twintig\"\n             ]\n  , examples (NumeralValue 22)\n             [ \"twee en twintig\"\n             ]\n  , examples (NumeralValue 24)\n             [ \"vier en twintig\"\n             ]\n  , examples (NumeralValue 26)\n             [ \"ses en twintig\"\n             ]\n  , examples (NumeralValue 28)\n             [ \"agt en twintig\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"drie en dertig\"\n             ]\n  , examples (NumeralValue 34)\n             [ \"vier en dertig\"\n             ]\n  , examples (NumeralValue 50)\n             [ \"vyftig\"\n             ]\n  , examples (NumeralValue 55)\n             [ \"vyf en vyftig\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 300)\n             [ \"3 honderd\"\n             , \"drie honderd\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 duisend\"\n             , \"vyf duisend\"\n             ]\n  , examples (NumeralValue 144)\n             [ \"een honderd vier en veertig\"\n             , \"honderd vier en veertig\"\n             ]\n  , examples (NumeralValue 122)\n             [ \"een honderd twee en twintig\"\n             , \"honderd twee en twintig\"\n             ]\n  , examples (NumeralValue 20000)\n             [ \"twintig duisend\"\n             ]\n  , examples (NumeralValue 0.2)\n             [ \"0,2\"\n             , \"1/5\"\n             , \"2/10\"\n             , \"3/15\"\n             , \"20/100\"\n             ]\n  ]\n", "num_lines": 153}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Numeral.AF.Rules\n  ( rules\n  ) where\n\nimport Control.Applicative ((<|>))\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nzeroAndTenMap :: HashMap Text Integer\nzeroAndTenMap = HashMap.fromList\n  [ ( \"nul\" , 0  )\n  , ( \"geen\", 0  )\n  , ( \"niks\", 0  )\n  , ( \"zero\", 0  )\n  , ( \"tien\", 10 )\n  ]\n\noneToNineMap :: HashMap Text Integer\noneToNineMap = HashMap.fromList\n  [ ( \"een\" , 1 )\n  , ( \"twee\", 2 )\n  , ( \"drie\", 3 )\n  , ( \"vier\", 4 )\n  , ( \"vyf\" , 5 )\n  , ( \"ses\" , 6 )\n  , ( \"sewe\", 7 )\n  , ( \"agt\" , 8 )\n  , ( \"ag\"  , 8 )\n  , ( \"nege\", 9 )\n  ]\n\nruleNumeral :: Rule\nruleNumeral = Rule\n  { name = \"number (0..10)\"\n  , pattern =\n    [ regex . Text.unpack $\n        Text.concat [ \"(\", Text.intercalate \"|\"\n          ((HashMap.keys zeroAndTenMap) ++ (HashMap.keys oneToNineMap)), \")\" ]\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        let x = Text.toLower match in\n        (HashMap.lookup x oneToNineMap >>= integer) <|>\n        (HashMap.lookup x zeroAndTenMap >>= integer)\n      _ -> Nothing\n  }\n\nelevenToNineteenMap :: HashMap Text Integer\nelevenToNineteenMap = HashMap.fromList\n  [ ( \"elf\"      , 11 )\n  , ( \"twaalf\"   , 12 )\n  , ( \"dertien\"  , 13 )\n  , ( \"veertien\" , 14 )\n  , ( \"vyftien\"  , 15 )\n  , ( \"sestien\"  , 16 )\n  , ( \"sewentien\", 17 )\n  , ( \"agtien\"   , 18 )\n  , ( \"negentien\", 19 )\n  , ( \"neentien\" , 19 )\n  ]\n\nruleElevenToNineteen :: Rule\nruleElevenToNineteen = Rule\n  { name = \"number (11..19)\"\n  , pattern =\n    [ regex \"(elf|twaalf|dertien|veertien|vyftien|sestien|sewentien|agtien|neg?entien)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) elevenToNineteenMap >>= integer\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"twin\" , 20 )\n  , ( \"der\"  , 30 )\n  , ( \"veer\" , 40 )\n  , ( \"vyf\"  , 50 )\n  , ( \"ses\"  , 60 )\n  , ( \"sewen\", 70 )\n  , ( \"tag\"  , 80 )\n  , ( \"negen\", 90 )\n  , ( \"neen\" , 90 )\n  ]\n\nruleTens :: Rule\nruleTens = Rule\n  { name = \"integer (20,30..90)\"\n  , pattern =\n    [ regex \"(twin|der|veer|vyf|ses|sewen|tag|neg?en)tig\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\nruleCompositeTens :: Rule\nruleCompositeTens = Rule\n  { name = \"integer ([3-9][1-9])\"\n  , pattern =\n    [ Predicate $ numberBetween 1 10\n    , regex \"en\"\n    , oneOf [20, 30..90]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = units}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = tens}:\n       _) -> double $ tens + units\n      _ -> Nothing\n  }\n\nruleDecimals :: Rule\nruleDecimals = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*\\\\,\\\\d+)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(honderd|duisend)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"honderd\" -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"duisend\" -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        _ -> Nothing\n      _ -> Nothing\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"a dozen of\"\n  , pattern =\n    [ regex \"dosyn\"\n    ]\n  , prod = \\_ -> integer 12 >>= withMultipliable >>= notOkForAnyTime\n  }\n\nruleSum :: Rule\nruleSum = Rule\n  { name = \"intersect 2 numbers\"\n  , pattern =\n    [ Predicate $ and . sequence [hasGrain, isPositive]\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\case\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNumeral\n  , ruleDozen\n  , ruleDecimals\n  , rulePowersOfTen\n  , ruleElevenToNineteen\n  , ruleTens\n  , ruleCompositeTens\n  , ruleSum\n  , ruleMultiply\n  ]\n", "num_lines": 211}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.AR.Helpers\n  ( digitsMap\n  , numeralToStringMap\n  , parseArabicDoubleAsText\n  , parseArabicDoubleFromText\n  , parseArabicIntAsText\n  , parseArabicIntegerFromText\n  ) where\n\nimport Control.Monad (join)\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe (mapMaybe)\nimport Data.String\nimport Data.Text (Text)\nimport Duckling.Numeral.Helpers\n  ( parseDouble\n  , parseInteger\n  )\nimport Prelude\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nnumeralToStringMap :: HashMap Char String\nnumeralToStringMap =\n  HashMap.fromList\n    [ ('\u00d9\u00a0', \"0\")\n    , ('\u00d9\u00a1', \"1\")\n    , ('\u00d9\u00a2', \"2\")\n    , ('\u00d9\u00a3', \"3\")\n    , ('\u00d9\u00a4', \"4\")\n    , ('\u00d9\u00a5', \"5\")\n    , ('\u00d9\u00a6', \"6\")\n    , ('\u00d9\u00a7', \"7\")\n    , ('\u00d9\u00a8', \"8\")\n    , ('\u00d9\u00a9', \"9\")\n    ]\n\ndigitsMap :: HashMap Text Integer\ndigitsMap =\n  HashMap.fromList\n    [ (\"\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\", 2)\n    , (\"\u00d8\u00ab\u00d9\u201e\u00d8\u00a7\u00d8\u00ab\", 3)\n    , (\"\u00d8\u00a7\u00d8\u00b1\u00d8\u00a8\u00d8\u00b9\", 4)\n    , (\"\u00d8\u00a3\u00d8\u00b1\u00d8\u00a8\u00d8\u00b9\", 4)\n    , (\"\u00d8\u00ae\u00d9\u2026\u00d8\u00b3\", 5)\n    , (\"\u00d8\u00b3\u00d8\u00aa\", 6)\n    , (\"\u00d8\u00b3\u00d8\u00a8\u00d8\u00b9\", 7)\n    , (\"\u00d8\u00ab\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", 8)\n    , (\"\u00d8\u00aa\u00d8\u00b3\u00d8\u00b9\", 9)\n    ]\n\nparseArabicIntAsText :: Text -> Text\nparseArabicIntAsText =\n  Text.pack\n    . join\n    . mapMaybe (`HashMap.lookup` numeralToStringMap)\n    . Text.unpack\n\nparseArabicIntegerFromText :: Text -> Maybe Integer\nparseArabicIntegerFromText = parseInteger . parseArabicIntAsText\n\nparseArabicDoubleAsText :: Text -> Text\nparseArabicDoubleAsText =\n  Text.pack\n    . join\n    . mapMaybe (`HashMap.lookup` HashMap.insert '\u00d9\u00ab' \".\" numeralToStringMap)\n    . Text.unpack\n\nparseArabicDoubleFromText :: Text -> Maybe Double\nparseArabicDoubleFromText = parseDouble . parseArabicDoubleAsText\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.AR.EG.Helpers\n  ( digitsMap\n  , numeralToStringMap\n  , parseArabicDoubleAsText\n  , parseArabicDoubleFromText\n  , parseArabicIntAsText\n  , parseArabicIntegerFromText\n  ) where\n\nimport Control.Monad (join)\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe (mapMaybe)\nimport Data.String\nimport Data.Text (Text)\nimport Duckling.Numeral.Helpers\n  ( parseDouble\n  , parseInteger\n  )\nimport Prelude\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nnumeralToStringMap :: HashMap Char String\nnumeralToStringMap =\n  HashMap.fromList\n    [ ('\u00d9\u00a0', \"0\")\n    , ('\u00d9\u00a1', \"1\")\n    , ('\u00d9\u00a2', \"2\")\n    , ('\u00d9\u00a3', \"3\")\n    , ('\u00d9\u00a4', \"4\")\n    , ('\u00d9\u00a5', \"5\")\n    , ('\u00d9\u00a6', \"6\")\n    , ('\u00d9\u00a7', \"7\")\n    , ('\u00d9\u00a8', \"8\")\n    , ('\u00d9\u00a9', \"9\")\n    ]\n\ndigitsMap :: HashMap Text Integer\ndigitsMap =\n  HashMap.fromList\n    [ (\"\u00d8\u00a7\u00d8\u00aa\u00d9\u2020\u00d9\u0160\u00d9\u2020\", 2)\n    , (\"\u00d8\u00aa\u00d9\u201e\u00d8\u00a7\u00d8\u00aa\", 3)\n    , (\"\u00d8\u00a7\u00d8\u00b1\u00d8\u00a8\u00d8\u00b9\", 4)\n    , (\"\u00d8\u00a3\u00d8\u00b1\u00d8\u00a8\u00d8\u00b9\", 4)\n    , (\"\u00d8\u00ae\u00d9\u2026\u00d8\u00b3\", 5)\n    , (\"\u00d8\u00b3\u00d8\u00aa\", 6)\n    , (\"\u00d8\u00b3\u00d8\u00a8\u00d8\u00b9\", 7)\n    , (\"\u00d8\u00aa\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", 8)\n    , (\"\u00d8\u00aa\u00d8\u00b3\u00d8\u00b9\", 9)\n    ]\n\nparseArabicIntAsText :: Text -> Text\nparseArabicIntAsText =\n  Text.pack\n    . join\n    . mapMaybe (`HashMap.lookup` numeralToStringMap)\n    . Text.unpack\n\nparseArabicIntegerFromText :: Text -> Maybe Integer\nparseArabicIntegerFromText = parseInteger . parseArabicIntAsText\n\nparseArabicDoubleAsText :: Text -> Text\nparseArabicDoubleAsText =\n  Text.pack\n    . join\n    . mapMaybe (`HashMap.lookup` HashMap.insert '\u00d9\u00ab' \".\" numeralToStringMap)\n    . Text.unpack\n\nparseArabicDoubleFromText :: Text -> Maybe Double\nparseArabicDoubleFromText = parseDouble . parseArabicDoubleAsText\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.CA.Corpus (corpus) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus =\n  (testContext { locale = makeLocale CA Nothing }, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1)\n        [ \"1\"\n        , \"u\"\n        , \"un\"\n        , \"una\"\n        ]\n    , examples (NumeralValue 11)\n        [ \"onze\"\n        ]\n    , examples (NumeralValue 12)\n        [ \"dotze\"\n        ]\n    , examples (NumeralValue 13)\n        [ \"tretze\"\n        ]\n    , examples (NumeralValue 14)\n        [ \"catorze\"\n        ]\n    , examples (NumeralValue 15)\n        [ \"quinze\"\n        ]\n    , examples (NumeralValue 16)\n        [ \"setze\"\n        ]\n    , examples (NumeralValue 17)\n        [ \"disset\"\n        , \"d\u00c3\u00a8sset\"\n        ]\n    , examples (NumeralValue 18)\n        [ \"divuit\"\n        , \"dihuit\"\n        , \"devuit\"\n        ]\n    , examples (NumeralValue 19)\n        [ \"dinou\"\n        , \"d\u00c3\u00a8nou\"\n        , \"denou\"\n        ]\n    , examples (NumeralValue 20)\n        [ \"vint\"\n        ]\n    , examples (NumeralValue 21)\n        [ \"vint-i-un\"\n        , \"vint i un\"\n        ]\n    , examples (NumeralValue 22)\n        [ \"vint-i-dos\"\n        , \"vint i dos\"\n        ]\n    , examples (NumeralValue 23)\n        [ \"vint-i-tres\"\n        , \"vint i tres\"\n        ]\n    , examples (NumeralValue 37)\n        [ \"trenta-set\"\n        ]\n    , examples (NumeralValue 40)\n        [ \"quaranta\"\n        ]\n    , examples (NumeralValue 70)\n        [ \"setanta\"\n        ]\n    , examples (NumeralValue 78)\n        [ \"Setanta-vuit\"\n        ]\n    , examples (NumeralValue 80)\n        [ \"vuitanta\"\n        ]\n    , examples (NumeralValue 33)\n        [ \"33\"\n        , \"trenta-tres\"\n        , \"trenta-3\"\n        ]\n    , examples (NumeralValue 100000)\n        [ \"100000\"\n        , \"100K\"\n        , \"100k\"\n        ]\n    , examples (NumeralValue 300)\n        [ \"tres-cents\"\n        ]\n    , examples (NumeralValue 243)\n        [ \"243\"\n        ]\n    , examples (NumeralValue 85)\n        [ \"vuitanta-cinc\"\n        ]\n    , examples (NumeralValue 3000000)\n        [ \"3M\"\n        , \"3000K\"\n        , \"3000000\"\n        ]\n    , examples (NumeralValue 1200000)\n        [ \"1200000\"\n        , \"1200K\"\n        ]\n    , examples (NumeralValue (-1200000))\n        [ \"-1200000\"\n        , \"-1200K\"\n        ]\n    , examples (NumeralValue 1.5)\n        [ \"1 coma cinc\"\n        , \"una coma cinc\"\n        , \"u coma cinc\"\n        ]\n    , examples (NumeralValue 1)\n        [ \"zero u\"\n        , \"zero un\"\n        ]\n    , examples (NumeralValue 2)\n        [ \"zero dos\"\n        ]\n    , examples (NumeralValue 3)\n        [ \"zero tres\"\n        ]\n    , examples (NumeralValue 4)\n        [ \"zero quatre\"\n        ]\n    , examples (NumeralValue 5)\n        [ \"zero cinc\"\n        ]\n    , examples (NumeralValue 6)\n        [ \"zero sis\"\n        ]\n    , examples (NumeralValue 7)\n        [ \"zero set\"\n        ]\n    , examples (NumeralValue 8)\n        [ \"zero vuit\"\n        ]\n    , examples (NumeralValue 9)\n        [ \"zero nou\"\n        ]\n    ]\n\n-- Ull, revisar la xifra amb decimals\n", "num_lines": 163}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.CA.Rules (rules) where\n\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nzeroToFifteenMap :: HashMap Text Integer\nzeroToFifteenMap =\n  HashMap.fromList\n    [ (\"zero\", 0)\n    , (\"u\", 1)\n    , (\"un\", 1)\n    , (\"una\", 1)\n    , (\"dos\", 2)\n    , (\"dues\", 2)\n    , (\"tres\", 3)\n    , (\"quatre\", 4)\n    , (\"cinc\", 5)\n    , (\"sis\", 6)\n    , (\"set\", 7)\n    , (\"vuit\", 8)\n    , (\"nou\", 9)\n    , (\"deu\", 10)\n    , (\"onze\", 11)\n    , (\"dotze\", 12)\n    , (\"tretze\", 13)\n    , (\"catorze\", 14)\n    , (\"quinze\", 15)\n    ]\n\nruleZeroToFifteen :: Rule\nruleZeroToFifteen = Rule\n  { name = \"number (0..15)\"\n  , pattern =\n      [ regex\n          \"(zero|u(na|n)?|d(o|ue)s|tres|quatre|cinc|sis|set|vuit|nou|deu|onze|dotze|tretze|catorze|quinze)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroToFifteenMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern = [regex \"-|menys\", Predicate isPositive]\n  , prod = \\case\n      (_ : Token Numeral NumeralData { TNumeral.value = v } : _) ->\n        double $ negate v\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap =\n  HashMap.fromList\n    [ (\"vint\", 20)\n    , (\"trenta\", 30)\n    , (\"quaranta\", 40)\n    , (\"cinquanta\", 50)\n    , (\"seixanta\", 60)\n    , (\"setanta\", 70)\n    , (\"vuitanta\", 80)\n    , (\"noranta\", 90)\n    ]\n\nruleTens :: Rule\nruleTens = Rule\n  { name = \"number (20..90)\"\n  , pattern =\n      [ regex\n          \"(vint|(tre|quara|cinqua|seixa|seta|vuita|nora)nta)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)) : _) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\nsixteenToTwentyNineMap :: HashMap Text Integer\nsixteenToTwentyNineMap =\n  HashMap.fromList\n    [ (\"setze\", 16)\n    , (\"disset\", 17)\n    , (\"d\u00c3\u00a8sset\", 17)\n    , (\"devuit\", 18)\n    , (\"divuit\", 18)\n    , (\"dihuit\", 18)\n    , (\"dinou\", 19)\n    , (\"d\u00c3\u00a8nou\", 19)\n    , (\"denou\", 19)\n    , (\"vint-i-u\", 21)\n    , (\"vint-i-una\", 21)\n    , (\"vint-i-dos\", 22)\n    , (\"vint-i-tres\", 23)\n    , (\"vint-i-quatre\", 24)\n    , (\"vint-i-cinc\", 25)\n    , (\"vint-i-sis\", 26)\n    , (\"vint-i-set\", 27)\n    , (\"vint-i-vuit\", 28)\n    , (\"vint-i-nou\", 29)\n    ]\n\nruleLowerTensWithOnes :: Rule\nruleLowerTensWithOnes = Rule\n  { name = \"number (16..19 21..29)\"\n  , pattern =\n      [ regex\n          \"(setze|d(i|e|\u00c3\u00a8)sset|d(e|i)(v|h)uit|d(i|e|\u00c3\u00a8)nou|vint-i-u(na)?|vint-i-dos|vint-i-tres|vint-i-quatre|vint-i-cinc|vint-i-sis|vint-i-set|vint-i-vuit|vint-i-nou)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) sixteenToTwentyNineMap >>= integer\n      _ -> Nothing\n  }\n\nruleHigherTensWithOnes :: Rule\nruleHigherTensWithOnes = Rule\n  { name = \"number (31..39 41..49 51..59 61..69 71..79 81..89 91..99)\"\n  , pattern =\n      [ oneOf [30, 40, 50, 60, 70, 80, 90]\n      , regex \"-\"\n      , Predicate $ numberBetween 1 9\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern = [dimension Numeral, regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) ->\n        case Text.toLower match of\n          \"k\" -> double $ v * 1e3\n          \"m\" -> double $ v * 1e6\n          \"g\" -> double $ v * 1e9\n          _ -> Nothing\n      _ -> Nothing\n  }\n\noneHundredToThousandMap :: HashMap Text Integer\noneHundredToThousandMap =\n  HashMap.fromList\n    [ (\"cent\", 100)\n    , (\"cents\", 100)\n    , (\"dos-cents\", 200)\n    , (\"tres-cents\", 300)\n    , (\"quatre-cents\", 400)\n    , (\"cinc-cents\", 500)\n    , (\"sis-cents\", 600)\n    , (\"set-cents\", 700)\n    , (\"vuit-cents\", 800)\n    , (\"nou-cents\", 900)\n    , (\"mil\", 1000)\n    ]\n\nruleTwenties :: Rule\nruleTwenties = Rule\n  { name = \"number (21..29)\"\n  , pattern =\n      [ oneOf [20]\n      , regex \"(-i-| i )\"\n      , Predicate $ numberBetween 1 10\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleHundreds :: Rule\nruleHundreds = Rule\n  { name = \"number 100..1000 \"\n  , pattern =\n      [ regex\n          \"(cent(s)?|dos-cents|tres-cents|quatre-cents|cinc-cents|sis-cents|set-cents|vuit-cents|nou-cents|mil)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) oneHundredToThousandMap >>= integer\n      _ -> Nothing\n  }\n\n-- Afegeixo regex \"-\" perque les centenes s'escriuen dos-cent, tres-cent\nruleNumerals :: Rule\nruleNumerals = Rule\n  { name = \"numbers 200..999\"\n  , pattern =\n      [ Predicate $ numberBetween 2 10\n      , regex \"-\"\n      , numberWith TNumeral.value (== 100)\n      , Predicate $ numberBetween 0 100\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ 100 * v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern = [dimension Numeral, regex \"coma\", Predicate $ not . hasGrain]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + decimalsToDouble v2\n      _ -> Nothing\n  }\n\nruleBelowTenWithTwoDigits :: Rule\nruleBelowTenWithTwoDigits = Rule\n  { name = \"integer (0-9) with two digits\"\n  , pattern =\n      [ regex \"zero|0\"\n      , Predicate $ numberBetween 1 10\n      ]\n  , prod = \\case\n      (_:Token Numeral NumeralData{TNumeral.value = v}:_) -> double v\n      _ -> Nothing\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator .\"\n  , pattern = [regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        let fmt = Text.replace \",\" \".\" . Text.replace \".\" Text.empty $ match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number ,\"\n  , pattern = [regex \"(\\\\d*,\\\\d+)\"]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleBelowTenWithTwoDigits\n  , ruleZeroToFifteen\n  , ruleTens\n  , ruleTwenties\n  , ruleLowerTensWithOnes\n  , ruleHigherTensWithOnes\n  , ruleHundreds\n\n  , ruleNumeralDotNumeral\n  , ruleNumerals\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n", "num_lines": 307}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.DA.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nul\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"\u00c3\u00a9n\"\n             , \"en\"\n             , \"\u00c3\u00a9t\"\n             , \"et\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"to\"\n             , \"et par\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"fjorten\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"seksten\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"sytten\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"Atten\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"minus 1.200.000\"\n             , \"negativ 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 tusind\"\n             , \"fem tusinde\"\n             , \"fem Tusind\"\n             ]\n  ]\n", "num_lines": 101}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.DA.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|minus|negativ\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        double $ v * (-1)\n      _ -> Nothing\n  }\n\nruleFew :: Rule\nruleFew = Rule\n  { name = \"few\"\n  , pattern =\n    [ regex \"(nogle )?f\u00c3\u00a5\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleTen :: Rule\nruleTen = Rule\n  { name = \"ten\"\n  , pattern =\n    [ regex \"ti\"\n    ]\n  , prod = \\_ -> integer 10 >>= withGrain 1\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+\\\\,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [20, 30 .. 90]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleSingle :: Rule\nruleSingle = Rule\n  { name = \"single\"\n  , pattern =\n    [ regex \"enkelt\"\n    ]\n  , prod = \\_ -> integer 1 >>= withGrain 1\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n          \"k\" -> double $ v * 1e3\n          \"m\" -> double $ v * 1e6\n          \"g\" -> double $ v * 1e9\n          _   -> Nothing\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(hundrede?|tohundrede|tusinde?|totusinde|million(er)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"hundred\"   -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"hundrede\"  -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"tohundrede\"  -> double (2 * 1e2) >>= withGrain 2 >>= withMultipliable\n        \"tusind\"    -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"tusinde\"   -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"totusinde\"   -> double (2 * 1e3) >>= withGrain 3 >>= withMultipliable\n        \"million\"   -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"millioner\" -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        _           -> Nothing\n      _ -> Nothing\n  }\n\nruleAPair :: Rule\nruleAPair = Rule\n  { name = \"a pair\"\n  , pattern =\n    [ regex \"et par\"\n    ]\n  , prod = \\_ -> integer 2 >>= withGrain 1\n  }\n\nruleNumeralsOg :: Rule\nruleNumeralsOg = Rule\n  { name = \"numbers og\"\n  , pattern =\n    [ Predicate $ numberBetween 1 10\n    , regex \"og\"\n    , oneOf [70, 20, 60, 50, 40, 90, 30, 80]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"dusin\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1 >>= withMultipliable\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nzeroNineteenMap :: HashMap Text Integer\nzeroNineteenMap = HashMap.fromList\n  [ (\"ingen\", 0)\n  , (\"nul\", 0)\n  , (\"intet\", 0)\n  , (\"en\", 1)\n  , (\"et\", 1)\n  , (\"\u00c3\u00a9n\", 1)\n  , (\"\u00c3\u00a9t\", 1)\n  , (\"to\", 2)\n  , (\"tre\", 3)\n  , (\"fire\", 4)\n  , (\"fem\", 5)\n  , (\"seks\", 6)\n  , (\"syv\", 7)\n  , (\"otte\", 8)\n  , (\"ni\", 9)\n  , (\"ti\", 10)\n  , (\"elleve\", 11)\n  , (\"tolv\", 12)\n  , (\"tretten\", 13)\n  , (\"fjorten\", 14)\n  , (\"femten\", 15)\n  , (\"seksten\", 16)\n  , (\"sytten\", 17)\n  , (\"atten\", 18)\n  , (\"nitten\", 19)\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..19)\"\n  , pattern =\n    [ regex \"(intet|ingen|nul|en|et|\u00c3\u00a9n|\u00c3\u00a9t|to|tretten|tre|fire|femten|fem|seksten|seks|syv|otte|nitten|ni|ti|elleve|tolv|fjorten|sytten|atten)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroNineteenMap >>= integer\n      _ -> Nothing\n  }\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"(tyve|tredive|fyrre|halvtreds|tres|halvfjerds|firs|halvfems)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"tyve\" -> integer 20\n        \"tredive\" -> integer 30\n        \"fyrre\" -> integer 40\n        \"halvtreds\" -> integer 50\n        \"tres\" -> integer 60\n        \"halvfjerds\" -> integer 70\n        \"firs\" -> integer 80\n        \"halvfems\" -> integer 90\n        _ -> Nothing\n      _ -> Nothing\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"komma\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + decimalsToDouble v2\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAPair\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleFew\n  , ruleInteger\n  , ruleInteger2\n  , ruleInteger3\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleMultiply\n  , ruleNumeralDotNumeral\n  , ruleNumeralsOg\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleSingle\n  , ruleTen\n  ]\n", "num_lines": 316}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.DE.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DE Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"null\"\n             , \"keiner\"\n             , \"keinen\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"eins\"\n             , \"Eine\"\n             , \"einen\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"3\"\n             , \"Drei\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"acht\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"achtzehn\"\n             ]\n  , examples (NumeralValue 30)\n             [ \"30\"\n             , \"drei\u00c3\u0178ig\"\n             , \"dreissig\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"dreiunddrei\u00c3\u0178ig\"\n             , \"dreiunddreissig\"\n             , \"0033\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"vierzehn\"\n             ]\n  , examples (NumeralValue 15)\n             [ \"15\"\n             , \"f\u00c3\u00bcnfzehn\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"sechzehn\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"Siebzehn\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"achtzehn\"\n             ]\n  , examples (NumeralValue 200)\n             [ \"200\"\n             , \"zweihundert\"\n             ]\n  , examples (NumeralValue 102)\n             [ \"102\"\n             , \"Hundertzwei\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1 komma 1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"einhunderttausend\"\n             , \"hunderttausend\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             , \"drei Millionen\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"minus 1.200.000\"\n             , \"negativ 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             ]\n  , examples (NumeralValue 1852)\n             [ \"eintausendachthundertzweiundf\u00c3\u00bcnfzig\"\n             , \"tausendachthundertzweiundf\u00c3\u00bcnfzig\"\n             , \"achtzehnhundertzweiundf\u00c3\u00bcnfzig\"]\n  , examples (NumeralValue 5000)\n             [ \"5 tausend\"\n             , \"f\u00c3\u00bcnftausend\"\n             ]\n  , examples (NumeralValue 200000)\n             [ \"zweihunderttausend\"\n             ]\n  , examples (NumeralValue 721012)\n             [ \"siebenhunderteinundzwanzigtausendzw\u00c3\u00b6lf\"\n             , \"siebenhunderteinundzwanzigtausendundzw\u00c3\u00b6lf\"\n             ]\n  , examples (NumeralValue 31256721)\n             [ \"einunddreissig millionen zweihundertsechsundf\u00c3\u00bcnfzigtausendsiebenhunderteinundzwanzig\"\n             , \"einunddrei\u00c3\u0178ig Millionen zweihundertsechsundf\u00c3\u00bcnfzigtausendundsiebenhunderteinundzwanzig\"\n             ]\n  , examples (NumeralValue 1416.15)\n             [ \"1416,15\"\n             ,  \"tausendvierhundertsechzehn Komma f\u00c3\u00bcnfzehn\"\n             ]\n  , examples (NumeralValue 1000000.0)\n             [ \"1.000.000,00\",\n               \"eine million\"\n             ]\n  , examples (NumeralValue 2771090092000000.0)\n             [ \"zwei billiarden siebenhunderteinundsiebzig billionen neunzig milliarden zweiundneunzig millionen\"\n             ]\n  ]\n", "num_lines": 160}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n{-# LANGUAGE DeriveFunctor #-}\n\nmodule Duckling.Numeral.DE.NumParser (parseNumeral) where\n\nimport Control.Applicative\nimport Data.Char\nimport Data.Foldable\nimport Data.List\nimport Data.String\nimport Prelude\n\nnewtype Parser a = Parser {runParser :: String -> Maybe (a, String)}\n  deriving (Functor)\n\nchar :: Char -> Parser Char\nchar c = Parser p\n  where\n    p [] = Nothing\n    p (x : xs)\n      | x == c = Just (x, xs)\n      | otherwise = Nothing\n\ninstance Applicative Parser where\n  pure a = Parser (\\s -> Just (a, s))\n  (Parser fp) <*> xp = Parser $ \\s ->\n    case fp s of\n      Nothing -> Nothing\n      Just (f, s') -> runParser (f <$> xp) s'\n\ninstance Alternative Parser where\n  empty = Parser (const Nothing)\n  Parser p1 <|> Parser p2 = Parser $ liftA2 (<|>) p1 p2\n\ntype NumParser = Parser Integer\n\n(.+.) :: NumParser -> NumParser -> NumParser\np .+. p' = (+) <$> p <*> p'\n\n(.*.) :: NumParser -> NumParser -> NumParser\np .*. p' = (*) <$> p <*> p'\n\ninfixl 6 .+.\n\ninfixl 7 .*.\n\nopt :: NumParser -> NumParser\nopt p = p <|> Parser p'\n  where\n    p' s = Just (0, s)\n\ndata NumItem = NumItem\n  { base :: NumParser\n  , plus10 :: NumParser\n  , times10 :: [NumParser]\n  }\n\ndefaultNumItem :: Integer -> String -> NumItem\ndefaultNumItem value form =\n  NumItem\n    { base = p\n    , plus10 = p .+. ten\n    , times10 = [p .*. ty]\n    }\n  where\n    p = assign value form\n\ntype Assignment = Integer -> String -> NumParser\n\nassign :: Assignment\nassign value = foldr (\\c p -> (1 <$ char c) .*. p) (pure value)\n\nten :: NumParser\nten = assign 10 \"zehn\"\n\nty :: NumParser\nty = assign 10 \"zig\"\n\nhundred :: NumParser\nhundred = assign 100 \"hundert\"\n\nthousand :: NumParser\nthousand = assign 1000 \"tausend\"\n\nund :: NumParser\nund = assign 0 \"und\"\n\none :: NumItem\none =\n  (defaultNumItem 1 \"ein\")\n    { plus10 = assign 11 \"elf\"\n    , times10 = [ten]\n    }\n\ntwo :: NumItem\ntwo =\n  (defaultNumItem 2 \"zwei\")\n    { plus10 = assign 12 \"zw\u00c3\u00b6lf\"\n    , times10 = [assign 20 \"zwanzig\"]\n    }\n\nthree :: NumItem\nthree =\n  (defaultNumItem 3 \"drei\")\n    { times10 =\n        [ assign 30 \"drei\u00c3\u0178ig\"\n        , assign 30 \"dreissig\"\n        ]\n    }\n\nfour :: NumItem\nfour = defaultNumItem 4 \"vier\"\n\nfive :: NumItem\nfive = defaultNumItem 5 \"f\u00c3\u00bcnf\"\n\nsix :: NumItem\nsix =\n  (defaultNumItem 6 \"sechs\")\n    { plus10 = assign 16 \"sechzehn\"\n    , times10 = [assign 60 \"sechzig\"]\n    }\n\nseven :: NumItem\nseven =\n  (defaultNumItem 7 \"sieben\")\n    { plus10 = assign 17 \"siebzehn\"\n    , times10 = [assign 70 \"siebzig\"]\n    }\n\neight :: NumItem\neight = defaultNumItem 8 \"acht\"\n\nnine :: NumItem\nnine = defaultNumItem 9 \"neun\"\n\ndigitLexicon :: [NumItem]\ndigitLexicon = [one, two, three, four, five, six, seven, eight, nine]\n\nfrom1to9 :: NumParser\nfrom1to9 = foldr ((<|>) . base) empty digitLexicon\n\ntensFrom20 :: NumParser\ntensFrom20 = asum (concatMap times10 (tail digitLexicon))\n\nfrom1to99 :: NumParser\nfrom1to99 =\n  opt (from1to9 .+. und) .+. tensFrom20\n    <|> foldr ((<|>) . plus10) empty digitLexicon\n    <|> ten\n    <|> from1to9\n\nfrom1to999 :: NumParser\nfrom1to999 = opt (from1to9 .*. hundred .+. opt und) .+. opt from1to99\n\nfrom1to999999 :: NumParser\nfrom1to999999 = opt (from1to999 .*. thousand .+. opt und) .+. opt from1to999\n\nfrom1to999999' :: NumParser\nfrom1to999999' = Parser p\n  where\n    p s\n      | isPrefixOf \"hundert\" s || isPrefixOf \"tausend\" s =\n        runParser from1to999999 (\"ein\" ++ s)\n      | otherwise =\n        runParser from1to999999 s\n\nfromYear1100to1999 :: NumParser\nfromYear1100to1999 =\n  asum ((\\n -> plus10 n .*. hundred) <$> digitLexicon)\n    .+. opt (opt und .+. from1to99)\n\nallNumerals :: NumParser\nallNumerals =\n  fromYear1100to1999\n    <|> from1to999999'\n\nremoveInflection :: (Integer, String) -> Maybe Integer\nremoveInflection (n, suffix)\n  | n `mod` 10 == 1 && suffix `elem` inflection = Just n\n  where\n    inflection = [\"s\", \"e\", \"em\", \"en\", \"er\", \"es\"]\nremoveInflection (n, \"\") = Just n\nremoveInflection _ = Nothing\n\nparseNumeral :: String -> Maybe Integer\nparseNumeral s = removeInflection =<< runParser allNumerals s\n", "num_lines": 192}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.DE.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Numeral.DE.NumParser\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|minus|negativ\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        double $ v * (- 1)\n      _ -> Nothing\n  }\n\nruleFew :: Rule\nruleFew = Rule\n  { name = \"few\"\n  , pattern =\n    [ regex \"mehrere\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+\\\\,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleNumeralsUnd :: Rule\nruleNumeralsUnd = Rule\n  { name = \"numbers und\"\n  , pattern =\n    [ Predicate $ numberBetween 1 10\n    , regex \"und\"\n    , oneOf [20, 30 .. 90]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _ -> Nothing\n      _ -> Nothing\n  }\n\nruleCouple :: Rule\nruleCouple = Rule\n  { name = \"couple\"\n  , pattern =\n    [ regex \"(ein )?paar\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"dutzend\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1 >>= withMultipliable\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(hunderte?|tausende?|million(en)?|milliarde(n)?|billion(en)?|billiarde(n)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"hundert\"    -> double 1e2  >>= withGrain 2  >>= withMultipliable\n        \"hunderte\"   -> double 1e2  >>= withGrain 2  >>= withMultipliable\n        \"tausend\"    -> double 1e3  >>= withGrain 3  >>= withMultipliable\n        \"tausende\"   -> double 1e3  >>= withGrain 3  >>= withMultipliable\n        \"million\"    -> double 1e6  >>= withGrain 6  >>= withMultipliable\n        \"millionen\"  -> double 1e6  >>= withGrain 6  >>= withMultipliable\n        \"milliarde\"  -> double 1e9  >>= withGrain 9  >>= withMultipliable\n        \"milliarden\" -> double 1e9  >>= withGrain 9  >>= withMultipliable\n        \"billion\"    -> double 1e12 >>= withGrain 12 >>= withMultipliable\n        \"billionen\"  -> double 1e12 >>= withGrain 12 >>= withMultipliable\n        \"billiarde\"  -> double 1e15 >>= withGrain 15 >>= withMultipliable\n        \"billiarden\" -> double 1e15 >>= withGrain 15 >>= withMultipliable\n        _            -> Nothing\n      _ -> Nothing\n  }\n\nruleZero :: Rule\nruleZero = Rule\n  { name = \"integer 0\"\n  , pattern =\n    [ regex \"(keine(m|n|r|s)?|keins?|null|nichts)\"\n    ]\n  , prod = \\_ -> integer 0\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"komma\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + decimalsToDouble v2\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleAllNumeralWords :: Rule\nruleAllNumeralWords = Rule\n  { name = \"simple and complex numerals written as one word\"\n  , pattern = [regex \"(ein|zwei|drei|vier|f\u00c3\u00bcnf|sech|sieb|acht|neun|zehn|elf|zw\u00c3\u00b6lf|hundert|tausend)?([^\\\\s]+)?(eine[m|n|r|s]?|eins?|zwei|drei|vier|f\u00c3\u00bcnf|sechs|sieben|acht|neun|zehn|elf|zw\u00c3\u00b6lf|[s|\u00c3\u0178|z]ig|hundert|tausend)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch matches) : _) ->\n        (parseNumeral $ concat $ Text.unpack . Text.toLower <$> matches)\n        >>= integer\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleCouple\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleFew\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleMultiply\n  , ruleNumeralDotNumeral\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , ruleNumeralsUnd\n  , rulePowersOfTen\n  , ruleZero\n  , ruleAllNumeralWords\n  ]\n", "num_lines": 247}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.EN.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"naught\"\n             , \"nought\"\n             , \"zero\"\n             , \"nil\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"one\"\n             , \"single\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"two\"\n             , \"a pair\"\n             , \"a couple\"\n             , \"a couple of\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"3\"\n             , \"three\"\n             , \"a few\"\n             , \"few\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"10\"\n             , \"ten\"\n             ]\n  , examples (NumeralValue 12)\n             [ \"12\"\n             , \"twelve\"\n             , \"a dozen\"\n             , \"a dozen of\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"fourteen\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"sixteen\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"seventeen\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"eighteen\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"thirty three\"\n             , \"0033\"\n             ]\n  , examples (NumeralValue 24)\n             [ \"24\"\n             , \"2 dozens\"\n             , \"two dozen\"\n             , \"Two dozen\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1.1\"\n             , \"1.10\"\n             , \"01.10\"\n             , \"1 point 1\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \".77\"\n             , \"0.77\"\n             , \"point 77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100,000\"\n             , \"100,000.0\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"one hundred thousand\"\n             ]\n  , examples (NumeralValue 0.2)\n             [ \"1/5\"\n             , \"2/10\"\n             , \"3/15\"\n             , \"20/100\"\n             ]\n  , examples (NumeralValue 3e6)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3,000,000\"\n             , \"3 million\"\n             , \"30 lakh\"\n             , \"30 lkh\"\n             , \"30 l\"\n             ]\n  , examples (NumeralValue 1.2e6)\n             [ \"1,200,000\"\n             , \"1200000\"\n             , \"1.2M\"\n             , \"1200k\"\n             , \".0012G\"\n             , \"12 lakhs\"\n             , \"12 lkhs\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 thousand\"\n             , \"five thousand\"\n             ]\n  , examples (NumeralValue (-504))\n             [ \"-504\"\n             , \"negative five hundred and four\"\n             ]\n  , examples (NumeralValue (-1.2e6))\n             [ \"- 1,200,000\"\n             , \"-1200000\"\n             , \"minus 1,200,000\"\n             , \"negative 1200000\"\n             , \"-1.2M\"\n             , \"-1200K\"\n             , \"-.0012G\"\n             ]\n  , examples (NumeralValue (-3200000))\n             [ \"-3,200,000\"\n             , \"-3200000\"\n             , \"minus three million two hundred thousand\"\n             ]\n  , examples (NumeralValue 122)\n             [ \"one twenty two\"\n             , \"ONE TwentY tWO\"\n             ]\n  , examples (NumeralValue 2e5)\n             [ \"two Hundred thousand\"\n             ]\n  , examples (NumeralValue 21011)\n             [ \"twenty-one thousand Eleven\"\n             ]\n  , examples (NumeralValue 721012)\n             [ \"seven hundred twenty-one thousand twelve\"\n             , \"seven hundred twenty-one thousand and twelve\"\n             ]\n  , examples (NumeralValue 31256721)\n             [ \"thirty-one million two hundred fifty-six thousand seven hundred twenty-one\"\n             , \"three crore twelve lakh fifty-six thousand seven hundred twenty-one\"\n             , \"three cr twelve lac fifty-six thousand seven hundred twenty-one\"\n             ]\n  , examples (NumeralValue 2400)\n             [ \"two hundred dozens\"\n             , \"200 dozens\"\n             ]\n  , examples (NumeralValue 2200000)\n             [ \"two point two million\"\n             ]\n  , examples (NumeralValue 3000000000)\n             [ \"three billions\"\n             , \"three thousand millions\"\n             , \"three hundred crores\"\n             , \"three hundred Cr\"\n             , \"three hundred koti\"\n             , \"three hundred krores\"\n             , \"three hundred Kr\"\n             ]\n  , examples (NumeralValue 45)\n             [ \"forty-five (45)\"\n             , \"45 (forty five)\"\n             ]\n  ]\n", "num_lines": 192}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.EN.Rules\n  ( rules\n  ) where\n\nimport Control.Applicative ((<|>))\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..), isInteger)\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"a dozen of\"\n  , pattern =\n    [ regex \"(a )?dozens?( of)?\"\n    ]\n  , prod = \\_ -> integer 12 >>= withMultipliable >>= notOkForAnyTime\n  }\n\nzeroNineteenMap :: HashMap Text Integer\nzeroNineteenMap = HashMap.fromList\n  [ ( \"naught\"   , 0 )\n  , ( \"nil\"      , 0 )\n  , ( \"nought\"   , 0 )\n  , ( \"none\"     , 0 )\n  , ( \"zero\"     , 0 )\n  , ( \"zilch\"    , 0 )\n  , ( \"one\"      , 1 )\n  , ( \"two\"      , 2 )\n  , ( \"three\"    , 3 )\n  , ( \"four\"     , 4 )\n  , ( \"five\"     , 5 )\n  , ( \"six\"      , 6 )\n  , ( \"seven\"    , 7 )\n  , ( \"eight\"    , 8 )\n  , ( \"nine\"     , 9 )\n  , ( \"ten\"      , 10 )\n  , ( \"eleven\"   , 11 )\n  , ( \"twelve\"   , 12 )\n  , ( \"thirteen\" , 13 )\n  , ( \"fourteen\" , 14 )\n  , ( \"fifteen\"  , 15 )\n  , ( \"sixteen\"  , 16 )\n  , ( \"seventeen\", 17 )\n  , ( \"eighteen\" , 18 )\n  , ( \"nineteen\" , 19 )\n  ]\n\ninformalMap :: HashMap Text Integer\ninformalMap = HashMap.fromList\n  [ ( \"single\"     , 1 )\n  , ( \"a couple\"   , 2 )\n  , ( \"a couple of\", 2 )\n  , ( \"couple\"     , 2 )\n  , ( \"couples\"    , 2 )\n  , ( \"couple of\"  , 2 )\n  , ( \"couples of\" , 2 )\n  , ( \"a pair\"     , 2 )\n  , ( \"a pair of\"  , 2 )\n  , ( \"pair\"       , 2 )\n  , ( \"pairs\"      , 2 )\n  , ( \"pair of\"    , 2 )\n  , ( \"pairs of\"   , 2 )\n  , ( \"a few\"      , 3 )\n  , ( \"few\"        , 3 )\n  ]\n\nruleToNineteen :: Rule\nruleToNineteen = Rule\n  { name = \"integer (0..19)\"\n  -- e.g. fourteen must be before four, otherwise four will always shadow fourteen\n  , pattern =\n    [ regex \"(none|zilch|naught|nought|nil|zero|one|single|two|(a )?(pair|couple)s?( of)?|three|(a )?few|fourteen|four|fifteen|five|sixteen|six|seventeen|seven|eighteen|eight|nineteen|nine|ten|eleven|twelve|thirteen)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        let x = Text.toLower match in\n        (HashMap.lookup x zeroNineteenMap >>= integer) <|>\n        (HashMap.lookup x informalMap >>= integer >>= notOkForAnyTime)\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"twenty\"  , 20 )\n  , ( \"thirty\"  , 30 )\n  , ( \"forty\"   , 40 )\n  , ( \"fourty\"  , 40 )\n  , ( \"fifty\"   , 50 )\n  , ( \"sixty\"   , 60 )\n  , ( \"seventy\" , 70 )\n  , ( \"eighty\"  , 80 )\n  , ( \"ninety\"  , 90 )\n  ]\n\nruleTens :: Rule\nruleTens = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"(twenty|thirty|fou?rty|fifty|sixty|seventy|eighty|ninety)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\npowersOfTensMap :: HashMap Text Int\npowersOfTensMap = HashMap.fromList\n  [ (\"hundred\", 2)\n  , (\"thousand\", 3)\n  , (\"lakh\", 5)\n  , (\"lkh\", 5)\n  , (\"l\", 5)\n  , (\"lac\", 5)\n  , (\"million\", 6)\n  , (\"cr\", 7)\n  , (\"crore\", 7)\n  , (\"krore\", 7)\n  , (\"kr\", 7)\n  , (\"koti\", 7)\n  , (\"billion\", 9)\n  , (\"trillion\", 12)\n  ]\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern = [regex \"(hundred|thousand|l(ac|(a?kh)?)|million|((k|c)r(ore)?|koti)|billion)s?\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) -> do\n        grain <- HashMap.lookup (Text.toLower match) powersOfTensMap\n        double (10 ^ grain) >>= withGrain grain >>= withMultipliable\n      _ -> Nothing\n  }\n\nruleCompositeTens :: Rule\nruleCompositeTens = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [20,30..90]\n    , regex \"[\\\\s\\\\-]+\"\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = tens}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = units}:\n       _) -> double $ tens + units\n      _ -> Nothing\n  }\n\nruleSkipHundreds1 :: Rule\nruleSkipHundreds1 = Rule\n  { name = \"one eleven\"\n  , pattern =\n    [ regex \"(one|two|three|four|five|six|seven|eight|nine)\"\n    , regex \"(ten|eleven|twelve|thirteen|fourteen|fifteen|sixteen|seventeen|eighteen|nineteen|twenty|thirty|fou?rty|fifty|sixty|seventy|eighty|ninety)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       Token RegexMatch (GroupMatch (m2:_)):\n       _) -> do\n       let x1 = Text.toLower m1\n       let x2 = Text.toLower m2\n       hundreds <- HashMap.lookup x1 zeroNineteenMap\n       rest <- HashMap.lookup x2 zeroNineteenMap <|> HashMap.lookup x2 tensMap\n       integer (hundreds * 100 + rest)\n      _ -> Nothing\n  }\n\nruleSkipHundreds2 :: Rule\nruleSkipHundreds2 = Rule\n  { name = \"one twenty two\"\n  , pattern =\n    [ regex \"(one|two|three|four|five|six|seven|eight|nine)\"\n    , regex \"(twenty|thirty|fou?rty|fifty|sixty|seventy|eighty|ninety)\"\n    , regex \"(one|two|three|four|five|six|seven|eight|nine)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       Token RegexMatch (GroupMatch (m2:_)):\n       Token RegexMatch (GroupMatch (m3:_)):\n       _) -> do\n       let x1 = Text.toLower m1\n       let x2 = Text.toLower m2\n       let x3 = Text.toLower m3\n       hundreds <- HashMap.lookup x1 zeroNineteenMap\n       tens <- HashMap.lookup x2 tensMap\n       rest <- HashMap.lookup x3 zeroNineteenMap\n       integer (hundreds * 100 + tens + rest)\n      _ -> Nothing\n  }\n\nruleDotSpelledOut :: Rule\nruleDotSpelledOut = Rule\n  { name = \"one point 2\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"point|dot\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral nd1:_:Token Numeral nd2:_) ->\n        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)\n      _ -> Nothing\n  }\n\nruleLeadingDotSpelledOut :: Rule\nruleLeadingDotSpelledOut = Rule\n  { name = \"point 77\"\n  , pattern =\n    [ regex \"point|dot\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double . decimalsToDouble $ TNumeral.value nd\n      _ -> Nothing\n  }\n\nruleDecimals :: Rule\nruleDecimals = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*\\\\.\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal True match\n      _ -> Nothing\n  }\n\nruleCommas :: Rule\nruleCommas = Rule\n  { name = \"comma-separated numbers\"\n  , pattern =\n    [ regex \"(\\\\d+(,\\\\d\\\\d\\\\d)+(\\\\.\\\\d+)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \",\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleSuffixes :: Rule\nruleSuffixes = Rule\n  { name = \"suffixes (K,M,G))\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"(k|m|g)(?=[\\\\W$\u00e2\u201a\u00ac\u00c2\u00a2\u00c2\u00a3]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral nd : Token RegexMatch (GroupMatch (match : _)):_) -> do\n        x <- case Text.toLower match of\n          \"k\" -> Just 1e3\n          \"m\" -> Just 1e6\n          \"g\" -> Just 1e9\n          _ -> Nothing\n        double $ TNumeral.value nd * x\n      _ -> Nothing\n  }\n\nruleNegative :: Rule\nruleNegative = Rule\n  { name = \"negative numbers\"\n  , pattern =\n    [ regex \"(-|minus|negative)(?!\\\\s*-)\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))\n      _ -> Nothing\n  }\n\nruleSum :: Rule\nruleSum = Rule\n  { name = \"intersect 2 numbers\"\n  , pattern =\n    [ Predicate $ and . sequence [hasGrain, isPositive]\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleSumAnd :: Rule\nruleSumAnd = Rule\n  { name = \"intersect 2 numbers (with and)\"\n  , pattern =\n    [ Predicate $ and . sequence [hasGrain, isPositive]\n    , regex \"and\"\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ Predicate isPositive\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleLegalParentheses :: Rule\nruleLegalParentheses = Rule\n  { name = \"<integer> '('<integer>')'\"\n  , pattern =\n    [ numberWith TNumeral.value $ and . sequence [isInteger, (>0)]\n    , regex \"\\\\(\"\n    , numberWith TNumeral.value $ and . sequence [isInteger, (>0)]\n    , regex \"\\\\)\"\n    ]\n  , prod = \\case\n    (Token Numeral NumeralData{TNumeral.value = n1}:\n     _:\n     Token Numeral NumeralData{TNumeral.value = n2}:\n     _:\n     _) | n1 == n2 -> double n1\n    _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleToNineteen\n  , ruleTens\n  , rulePowersOfTen\n  , ruleCompositeTens\n  , ruleSkipHundreds1\n  , ruleSkipHundreds2\n  , ruleDotSpelledOut\n  , ruleLeadingDotSpelledOut\n  , ruleDecimals\n  , ruleCommas\n  , ruleSuffixes\n  , ruleNegative\n  , ruleSum\n  , ruleSumAnd\n  , ruleMultiply\n  , ruleDozen\n  , ruleLegalParentheses\n  ]\n", "num_lines": 375}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NumericUnderscores #-}\nmodule Duckling.Numeral.ES.Corpus (corpus) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus =\n  (testContext { locale = makeLocale ES Nothing }, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\", \"uno\", \"una\"]\n    , examples (NumeralValue (-1)) [\"negativo 1\", \"menos 1\", \"negativo uno\"]\n    , examples (NumeralValue 11) [\"once\"]\n    , examples\n        (NumeralValue 16)\n        [\"diecis\u00c3\u00a9is\", \"dieciseis\", \"Diesiseis\", \"diez y seis\"]\n    , examples (NumeralValue 21) [\"veintiuno\", \"veinte y uno\"]\n    , examples (NumeralValue 22) [\"veintid\u00c3\u00b3s\"]\n    , examples (NumeralValue 23) [\"veintitr\u00c3\u00a9s\", \"veinte y tres\"]\n    , examples (NumeralValue 70) [\"setenta\"]\n    , examples (NumeralValue 78) [\"Setenta y ocho\"]\n    , examples (NumeralValue 80) [\"ochenta\"]\n    , examples (NumeralValue 33) [\"33\", \"treinta y tres\", \"treinta y 3\"]\n    , examples (NumeralValue 100_000) [\"100000\", \"100K\", \"100k\"]\n    , examples (NumeralValue 300) [\"trescientos\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3_000_000) [\"3M\", \"3000K\", \"3000000\"]\n    , examples (NumeralValue 1_200_000) [\"1200000\", \"1200K\"]\n    , examples (NumeralValue (-1_200_000)) [\"-1200000\", \"-1200K\"]\n    , examples (NumeralValue 1.5) [\"1 punto cinco\", \"una punto cinco\", \"1 con cinco\", \"1 con 5\", \"uno coma 5\"]\n    , examples (NumeralValue 0.5) [\"punto cinco\", \"coma 5\"]\n    , examples (NumeralValue 1) [\"cero uno\", \"zero uno\"]\n    , examples (NumeralValue 2) [\"cero dos\", \"zero dos\"]\n    , examples (NumeralValue 3)\n               [\n                 \"cero tres\",\n                 \"cero tr\u00c3\u00a9s\",\n                 \"zero tres\",\n                 \"zero tr\u00c3\u00a9s\"\n               ]\n    , examples (NumeralValue 4) [\"cero cuatro\", \"zero cuatro\"]\n    , examples (NumeralValue 5) [\"cero cinco\", \"zero cinco\"]\n    , examples (NumeralValue 6)\n               [\n                 \"cero seis\",\n                 \"cero s\u00c3\u00a9is\",\n                 \"zero seis\",\n                 \"zero s\u00c3\u00a9is\"\n               ]\n    , examples (NumeralValue 7) [\"cero siete\", \"zero siete\"]\n    , examples (NumeralValue 8) [\"cero ocho\", \"zero ocho\"]\n    , examples (NumeralValue 9) [\"cero nueve\", \"zero nueve\"]\n    , examples (NumeralValue 203) [\"dos cientos tres\", \"doscientos tres\"]\n    , examples (NumeralValue 203_000) [\"doscientos tres mil\", \"203 mil\"]\n    , examples (NumeralValue 4_000_000) [\"cuatro millones\", \"4 millones\"]\n    , examples (NumeralValue 4_002_003) [\"cuatro millones dos mil tres\", \"4 millones 2 mil 3\"]\n    ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Duckling.Numeral.ES.Rules (rules) where\n\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nzeroToFifteenMap :: HashMap.HashMap Text.Text Integer\nzeroToFifteenMap =\n  HashMap.fromList\n    [ (\"zero\", 0)\n    , (\"cero\", 0)\n    , (\"un\", 1)\n    , (\"una\", 1)\n    , (\"uno\", 1)\n    , (\"dos\", 2)\n    , (\"tr\u00c3\u00a9s\", 3)\n    , (\"tres\", 3)\n    , (\"cuatro\", 4)\n    , (\"cinco\", 5)\n    , (\"seis\", 6)\n    , (\"s\u00c3\u00a9is\", 6)\n    , (\"siete\", 7)\n    , (\"ocho\", 8)\n    , (\"nueve\", 9)\n    , (\"diez\", 10)\n    , (\"dies\", 10)\n    , (\"once\", 11)\n    , (\"doce\", 12)\n    , (\"trece\", 13)\n    , (\"catorce\", 14)\n    , (\"quince\", 15)\n    ]\n\nruleNumeralZeroToFifteen :: Rule\nruleNumeralZeroToFifteen = Rule\n  { name = \"number (0..15)\"\n  , pattern =\n      [ regex\n          \"((c|z)ero|un(o|a)?|dos|tr(\u00c3\u00a9|e)s|cuatro|cinco|s(e|\u00c3\u00a9)is|siete|ocho|nueve|die(z|s)|once|doce|trece|catorce|quince)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        HashMap.lookup (Text.toLower match) zeroToFifteenMap >>= integer\n      _ -> Nothing\n  }\n\nruleBelowTenWithTwoDigits :: Rule\nruleBelowTenWithTwoDigits = Rule\n  {\n    name = \"integer (0-9) with two digits\"\n  , pattern =\n      [ regex \"((c|z)ero)|0\"\n      , Predicate $ numberBetween 1 10\n      ]\n  , prod = \\case\n      (\n        _:\n        Token Numeral NumeralData { TNumeral.value = v }:\n        _\n        ) -> double v\n      _ -> Nothing\n  }\n\nsixteenToTwentyNineMap :: HashMap.HashMap Text.Text Integer\nsixteenToTwentyNineMap =\n  HashMap.fromList\n    [ (\"dieciseis\", 16)\n    , (\"diesis\u00c3\u00a9is\", 16)\n    , (\"diesiseis\", 16)\n    , (\"diecis\u00c3\u00a9is\", 16)\n    , (\"diecisiete\", 17)\n    , (\"dieciocho\", 18)\n    , (\"diecinueve\", 19)\n    , (\"veintiuno\", 21)\n    , (\"veintiuna\", 21)\n    , (\"veintidos\", 22)\n    , (\"veintid\u00c3\u00b3s\", 22)\n    , (\"veintitr\u00c3\u00a9s\", 23)\n    , (\"veintitres\", 23)\n    , (\"veinticuatro\", 24)\n    , (\"veinticinco\", 25)\n    , (\"veintis\u00c3\u00a9is\", 26)\n    , (\"veintiseis\", 26)\n    , (\"veintisiete\", 27)\n    , (\"veintiocho\", 28)\n    , (\"veintinueve\", 29)\n    ]\n\n\nruleNumeralSixteenToTwentyNine :: Rule\nruleNumeralSixteenToTwentyNine = Rule\n  { name = \"number (16..19 21..29)\"\n  , pattern =\n      [ regex\n          \"(die(c|s)is(\u00c3\u00a9|e)is|diecisiete|dieciocho|diecinueve|veintiun(o|a)|veintid(o|\u00c3\u00b3)s|veintitr(\u00c3\u00a9|e)s|veinticuatro|veinticinco|veintis(\u00c3\u00a9|e)is|veintisiete|veintiocho|veintinueve|treinta)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        HashMap.lookup (Text.toLower match) sixteenToTwentyNineMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeralSixteenToNineteenWithDiez :: Rule\nruleNumeralSixteenToNineteenWithDiez = Rule\n  { name = \"number (16..19, two words)\"\n  , pattern =\n      [ numberWith TNumeral.value (== 10)\n      , regex \"y\"\n      , Predicate $ numberBetween 6 10\n      ]\n  , prod = \\case\n      (_ : _ : Token Numeral NumeralData { TNumeral.value = v } : _) ->\n        double $ 10 + v\n      _ -> Nothing\n  }\n\nbyTensMap :: HashMap.HashMap Text.Text Integer\nbyTensMap =\n  HashMap.fromList\n    [ (\"veinte\", 20)\n    , (\"treinta\", 30)\n    , (\"cuarenta\", 40)\n    , (\"cincuenta\", 50)\n    , (\"sesenta\", 60)\n    , (\"setenta\", 70)\n    , (\"ochenta\", 80)\n    , (\"noventa\", 90)\n    ]\n\n\nruleNumeralTwentyToNinetyTens :: Rule\nruleNumeralTwentyToNinetyTens = Rule\n  { name = \"number (20..90)\"\n  , pattern =\n      [ regex\n          \"(veinte|treinta|cuarenta|cincuenta|sesenta|setenta|ochenta|noventa)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        HashMap.lookup (Text.toLower match) byTensMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeralTwentyOneToNinetyNine :: Rule\nruleNumeralTwentyOneToNinetyNine = Rule\n  { name = \"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\"\n  , pattern =\n      [ oneOf [20, 30 .. 90]\n      , regex \"y\"\n      , Predicate $ numberBetween 1 10\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v1 } : _ : Token Numeral NumeralData { TNumeral.value = v2 } : _) ->\n        double $ v1 + v2\n      _ -> Nothing\n  }\n\nbigNumbersMap :: HashMap.HashMap Text.Text Integer\nbigNumbersMap =\n  HashMap.fromList\n    [ (\"cien\", 100)\n    , (\"cientos\", 100)\n    , (\"ciento\", 100)\n    , (\"doscientos\", 200)\n    , (\"trescientos\", 300)\n    , (\"cuatrocientos\", 400)\n    , (\"quinientos\", 500)\n    , (\"seiscientos\", 600)\n    , (\"setecientos\", 700)\n    , (\"ochocientos\", 800)\n    , (\"novecientos\", 900)\n    , (\"mil\", 1000)\n    , (\"millon\", 1000000)\n    , (\"mill\u00c3\u00b3n\", 1000000)\n    , (\"un millon\", 1000000)\n    , (\"un mill\u00c3\u00b3n\", 1000000)\n    , (\"millones\", 1000000)\n    -- Note: billion and larger is ambiguous becaouse of long vs short scale\n    ]\n\nruleBigNumeral :: Rule\nruleBigNumeral = Rule\n  { name = \"big number 100 to 1K\"\n  , pattern =\n      [ regex\n          \"(cien(to|tos)?|doscientos|trescientos|cuatrocientos|quinientos|seiscientos|setecientos|ochocientos|novecientos|(un )?mill(o|\u00c3\u00b3)n)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        HashMap.lookup (Text.toLower match) bigNumbersMap >>= integer\n      _ -> Nothing\n  }\n\nruleBigNumeralMultipliable :: Rule\nruleBigNumeralMultipliable = Rule\n  { name = \"1K or 1M in multipliable form\"\n  , pattern =\n      [ regex\n          \"(mil(lones)?)\"\n      ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        HashMap.lookup (Text.toLower match) bigNumbersMap >>= integer >>= withMultipliable\n      _ -> Nothing\n  }\n\nruleTwoPartHundreds :: Rule\nruleTwoPartHundreds = Rule\n { name = \"2..9 cientos\"\n , pattern =\n     [ Predicate $ numberBetween 2 10\n     , regex \"cientos\"\n     ]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v1 } : _ : _) ->\n        double $ 100 * v1\n      _ -> Nothing\n  }\n\nruleNumeralHundredsAndSmaller :: Rule\nruleNumeralHundredsAndSmaller = Rule\n  { name = \"<hundreds> 0..99\"\n  , pattern =\n      [ numberWith TNumeral.value (TNumeral.isMultiple 100)\n      , Predicate $ numberBetween 0 100\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v1 } : Token Numeral NumeralData { TNumeral.value = v2 } : _)\n        | v1 > 0 && v1 < 1000 -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralMultiply :: Rule\nruleNumeralMultiply = Rule\n  { name = \"2..999 <multipliable>\"\n  , pattern =\n      [ Predicate $ numberBetween 2 1000\n      , Predicate isMultipliable\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v1 } : Token Numeral NumeralData { TNumeral.value = v2 } : _) ->\n        double $ v1 * v2\n      _ -> Nothing\n  }\n\nruleNumeralThousandsAnd :: Rule\nruleNumeralThousandsAnd = Rule\n  { name = \"<thousands> 0..999\"\n  , pattern =\n      [ numberWith TNumeral.value (TNumeral.isMultiple 1000)\n      , Predicate $ numberBetween 0 999\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v1 } : Token Numeral NumeralData { TNumeral.value = v2 } : _)\n       | 0 < v1 && v1 < 1000000 -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralMillionsAnd :: Rule\nruleNumeralMillionsAnd = Rule\n  { name = \"<millions> 0..999999\"\n  , pattern =\n      [ numberWith TNumeral.value (TNumeral.isMultiple 1000000)\n      , Predicate $ numberBetween 0 999999\n      ]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v1 } : Token Numeral NumeralData { TNumeral.value = v2 } : _)\n       | 0 < v1 -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern = [dimension Numeral, regex \"(co(n|ma)|punto)\", Predicate $ not . hasGrain]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v1 } : _ : Token Numeral NumeralData { TNumeral.value = v2 } : _) ->\n        double $ v1 + decimalsToDouble v2\n      _ -> Nothing\n  }\n\nruleLeadingDotNumeral :: Rule\nruleLeadingDotNumeral = Rule\n  { name = \"dot number\"\n  , pattern = [regex \"coma|punto\", Predicate $ not . hasGrain]\n  , prod = \\case\n      (_:Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        double $ decimalsToDouble v\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern = [dimension Numeral, regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"]\n  , prod = \\case\n      (Token Numeral NumeralData { TNumeral.value = v } : Token RegexMatch (GroupMatch (match : _)) : _) ->\n        case Text.toLower match of\n          \"k\" -> double $ v * 1e3\n          \"m\" -> double $ v * 1e6\n          \"g\" -> double $ v * 1e9\n          _ -> Nothing\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern = [regex \"-|menos|negativ(o|a)\", Predicate isPositive]\n  , prod = \\case\n      (_ : Token Numeral NumeralData { TNumeral.value = v } : _) ->\n        double $ v * (-1)\n      _ -> Nothing\n  }\n\n\nrules :: [Rule]\nrules =\n  [ ruleNumeralZeroToFifteen\n  , ruleBelowTenWithTwoDigits\n  , ruleNumeralSixteenToTwentyNine\n  , ruleNumeralSixteenToNineteenWithDiez\n  , ruleNumeralTwentyToNinetyTens\n  , ruleNumeralTwentyOneToNinetyNine\n  , ruleBigNumeral\n  , ruleBigNumeralMultipliable\n  , ruleNumeralMultiply\n  , ruleNumeralThousandsAnd\n  , ruleNumeralMillionsAnd\n  , ruleTwoPartHundreds\n  , ruleNumeralHundredsAndSmaller\n  , ruleNumeralDotNumeral\n  , ruleLeadingDotNumeral\n  , ruleNumeralsSuffixesKMG\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  ]\n", "num_lines": 357}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.AR.Corpus (allExamples) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\"]\n    , examples (NumeralValue 33) [\"33\"]\n    , examples (NumeralValue 1.1) [\"1,1\", \"1,10\", \"01,10\"]\n    , examples (NumeralValue 0.77) [\"0,77\", \",77\"]\n    , examples (NumeralValue 100000) [\"100.000\", \"100000\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3000000) [\"3000000\", \"3.000.000\"]\n    , examples (NumeralValue 1200000) [\"1.200.000\", \"1200000\"]\n    , examples\n        (NumeralValue (-1200000))\n        [\"- 1.200.000\", \"menos 1.200.000\", \"-1,2M\", \"-,0012G\"]\n    , examples (NumeralValue 1.5) [\"1,5\"]\n    ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.AR.Rules (rules) where\n\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator .\"\n  , pattern = [regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number ,\"\n  , pattern = [regex \"(\\\\d*,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.CL.Corpus (allExamples) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\"]\n    , examples (NumeralValue 33) [\"33\"]\n    , examples (NumeralValue 1.1) [\"1,1\", \"1,10\", \"01,10\"]\n    , examples (NumeralValue 0.77) [\"0,77\", \",77\"]\n    , examples (NumeralValue 100000) [\"100.000\", \"100000\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3000000) [\"3000000\", \"3.000.000\"]\n    , examples (NumeralValue 1200000) [\"1.200.000\", \"1200000\"]\n    , examples\n        (NumeralValue (-1200000))\n        [\"- 1.200.000\", \"menos 1.200.000\", \"-1,2M\", \"-,0012G\"]\n    , examples (NumeralValue 1.5) [\"1,5\"]\n    ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.CL.Rules (rules) where\n\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator .\"\n  , pattern = [regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number ,\"\n  , pattern = [regex \"(\\\\d*,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.CO.Corpus (allExamples) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\"]\n    , examples (NumeralValue 33) [\"33\"]\n    , examples (NumeralValue 1.1) [\"1,1\", \"1,10\", \"01,10\"]\n    , examples (NumeralValue 0.77) [\"0,77\", \",77\"]\n    , examples (NumeralValue 100000) [\"100.000\", \"100000\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3000000) [\"3000000\", \"3.000.000\"]\n    , examples (NumeralValue 1200000) [\"1.200.000\", \"1200000\"]\n    , examples\n        (NumeralValue (-1200000))\n        [\"- 1.200.000\", \"menos 1.200.000\", \"-1,2M\", \"-,0012G\"]\n    , examples (NumeralValue 1.5) [\"1,5\"]\n    ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.CO.Rules (rules) where\n\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator .\"\n  , pattern = [regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number ,\"\n  , pattern = [regex \"(\\\\d*,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.ES.Corpus (allExamples) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\"]\n    , examples (NumeralValue 33) [\"33\"]\n    , examples (NumeralValue 1.1) [\"1,1\", \"1,10\", \"01,10\"]\n    , examples (NumeralValue 0.77) [\"0,77\", \",77\"]\n    , examples (NumeralValue 100000) [\"100.000\", \"100000\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3000000) [\"3000000\", \"3.000.000\"]\n    , examples (NumeralValue 1200000) [\"1.200.000\", \"1200000\"]\n    , examples\n        (NumeralValue (-1200000))\n        [\"- 1.200.000\", \"menos 1.200.000\", \"-1,2M\", \"-,0012G\"]\n    , examples (NumeralValue 1.5) [\"1,5\"]\n    ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.ES.Rules\n  ( rules\n  , rulesBackwardCompatible\n  ) where\n\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator .\"\n  , pattern = [regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number ,\"\n  , pattern = [regex \"(\\\\d*,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrulesBackwardCompatible :: [Rule]\nrulesBackwardCompatible =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n\nrules :: [Rule]\nrules = rulesBackwardCompatible\n", "num_lines": 68}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.MX.Corpus (allExamples) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\"]\n    , examples (NumeralValue 33) [\"33\"]\n    , examples (NumeralValue 1.1) [\"1.1\", \"1.10\", \"01.10\"]\n    , examples (NumeralValue 0.77) [\"0.77\", \".77\"]\n    , examples (NumeralValue 100000) [\"100,000\", \"100000\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3000000) [\"3000000\", \"3,000,000\"]\n    , examples (NumeralValue 1200000) [\"1,200,000\", \"1200000\"]\n    , examples\n        (NumeralValue (-1200000))\n        [\"- 1,200,000\", \"menos 1,200,000\", \"-1.2M\", \"-.0012G\"]\n    , examples (NumeralValue 1.5) [\"1.5\"]\n    ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.MX.Rules (rules) where\n\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern = [regex \"(\\\\d+(\\\\,\\\\d\\\\d\\\\d)+\\\\.\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \",\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number .\"\n  , pattern = [regex \"(\\\\d*\\\\.\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator ,\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\,\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \",\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.PE.Corpus (allExamples) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\"]\n    , examples (NumeralValue 33) [\"33\"]\n    , examples (NumeralValue 1.1) [\"1,1\", \"1,10\", \"01,10\"]\n    , examples (NumeralValue 0.77) [\"0,77\", \",77\"]\n    , examples (NumeralValue 100000) [\"100.000\", \"100000\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3000000) [\"3000000\", \"3.000.000\"]\n    , examples (NumeralValue 1200000) [\"1.200.000\", \"1200000\"]\n    , examples\n        (NumeralValue (-1200000))\n        [\"- 1.200.000\", \"menos 1.200.000\", \"-1,2M\", \"-,0012G\"]\n    , examples (NumeralValue 1.5) [\"1,5\"]\n    ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.PE.Rules (rules) where\n\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator .\"\n  , pattern = [regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number ,\"\n  , pattern = [regex \"(\\\\d*,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.VE.Corpus (allExamples) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Types\n\nallExamples :: [Example]\nallExamples =\n  concat\n    [ examples (NumeralValue 1) [\"1\"]\n    , examples (NumeralValue 33) [\"33\"]\n    , examples (NumeralValue 1.1) [\"1,1\", \"1,10\", \"01,10\"]\n    , examples (NumeralValue 0.77) [\"0,77\", \",77\"]\n    , examples (NumeralValue 100000) [\"100.000\", \"100000\"]\n    , examples (NumeralValue 243) [\"243\"]\n    , examples (NumeralValue 3000000) [\"3000000\", \"3.000.000\"]\n    , examples (NumeralValue 1200000) [\"1.200.000\", \"1200000\"]\n    , examples\n        (NumeralValue (-1200000))\n        [\"- 1.200.000\", \"menos 1.200.000\", \"-1,2M\", \"-,0012G\"]\n    , examples (NumeralValue 1.5) [\"1,5\"]\n    ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Numeral.ES.VE.Rules (rules) where\n\nimport Data.Maybe\nimport Data.String\nimport qualified Data.Text as Text\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator .\"\n  , pattern = [regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number ,\"\n  , pattern = [regex \"(\\\\d*,\\\\d+)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern = [regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match : _)) : _) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.ET.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ET Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"null\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"\u00c3\u00bcks\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"Kolmk\u00c3\u00bcmmend kolm\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"neliteist\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"kuusteist\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"Seitseteist\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"kaheksateist\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1.1\"\n             , \"1.10\"\n             , \"01.10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0.77\"\n             , \".77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100,000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"100 000\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3,000,000\"\n             , \"3 000 000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1,200,000\"\n             , \"1200000\"\n             , \"1.2M\"\n             , \"1200K\"\n             , \".0012G\"\n             , \"1 200 000\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1,200,000\"\n             , \"-1200000\"\n             , \"miinus 1,200,000\"\n             , \"-1.2M\"\n             , \"-1200K\"\n             , \"-.0012G\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"viis tuhat\"\n             ]\n  , examples (NumeralValue 200000)\n             [ \"kakssada tuhat\"\n             ]\n  , examples (NumeralValue 21011)\n             [ \"kaksk\u00c3\u00bcmmend \u00c3\u00bcks Tuhat \u00c3\u00bcksteist\"\n             ]\n  , examples (NumeralValue 721012)\n             [ \"seitsesada kaksk\u00c3\u00bcmmend \u00c3\u00bcks tuhat kaksteist\"\n             ]\n  , examples (NumeralValue 31256721)\n             [ \"kolmk\u00c3\u00bcmmend \u00c3\u00bcks miljonit kakssada viisk\u00c3\u00bcmmend kuus tuhat seitsesada kaksk\u00c3\u00bcmmend \u00c3\u00bcks\"\n             ]\n  ]\n", "num_lines": 109}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.ET.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|miinus|negatiivne\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> double $ v * (-1)\n      _ -> Nothing\n  }\n\nruleACoupleOf :: Rule\nruleACoupleOf = Rule\n  { name = \"a couple of\"\n  , pattern =\n    [ regex \"paar\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleTen :: Rule\nruleTen = Rule\n  { name = \"ten\"\n  , pattern =\n    [ regex \"k\u00c3\u00bcmme\"\n    ]\n  , prod = \\_ -> integer 10 >>= withGrain 1\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(,\\\\d\\\\d\\\\d)+\\\\.\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace (Text.singleton ',') Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*\\\\.\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal True match\n      _ -> Nothing\n  }\n\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [70, 20, 60, 50, 40, 90, 30, 80]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:_) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleAFew :: Rule\nruleAFew = Rule\n  { name = \"(a )?few\"\n  , pattern =\n    [ regex \"m\u00c3\u00b5ni\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern = [regex \"(sada|tuhat|miljoni?t?)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"sada\"  -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"tuhat\" -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        _       -> double 1e6 >>= withGrain 6 >>= withMultipliable\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n          \"k\" -> double $ v * 1e3\n          \"m\" -> double $ v * 1e6\n          \"g\" -> double $ v * 1e9\n          _   -> Nothing\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nzeroNineteenMap :: HashMap Text Integer\nzeroNineteenMap = HashMap.fromList\n  [ (\"null\", 0)\n  , (\"\u00c3\u00bcks\", 1)\n  , (\"kaks\", 2)\n  , (\"kolm\", 3)\n  , (\"neli\", 4)\n  , (\"viis\", 5)\n  , (\"kuus\", 6)\n  , (\"seitse\", 7)\n  , (\"kaheksa\", 8)\n  , (\"\u00c3\u00bcheksa\", 9)\n  , (\"k\u00c3\u00bcmme\", 10)\n  , (\"\u00c3\u00bcksteist\", 11)\n  , (\"kaksteist\", 12)\n  , (\"kolmteist\", 13)\n  , (\"neliteist\", 14)\n  , (\"viisteist\", 15)\n  , (\"kuusteist\", 16)\n  , (\"seitseteist\", 17)\n  , (\"kaheksateist\", 18)\n  , (\"\u00c3\u00bcheksateist\", 19)\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..19)\"\n  , pattern =\n    [ regex \"(null|\u00c3\u00bcksteist|\u00c3\u00bcks|kaksteist|kaks|kolmteist|kolm|neliteist|neli|viisteist|viis|kuusteist|kuus|seitseteist|seitse|kaheksateist|kaheksa|\u00c3\u00bcheksateist|\u00c3\u00bcheksa|k\u00c3\u00bcmme)\"\n    ]\n  , prod = \\tokens -> case tokens of\n    (Token RegexMatch (GroupMatch (match:_)):_) ->\n      HashMap.lookup (Text.toLower match) zeroNineteenMap >>= integer\n    _ -> Nothing\n  }\n\nruleInteger4 :: Rule\nruleInteger4 = Rule\n  { name = \"integer (200..900)\"\n  , pattern =\n    [ regex \"(kakssada|kolmsada|nelisada|viissada|kuussada|seitsesada|kaheksasada|\u00c3\u00bcheksasada)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"kakssada\"        -> integer 200 >>= withGrain 2 >>= withMultipliable\n        \"kolmsada\"        -> integer 300 >>= withGrain 2 >>= withMultipliable\n        \"nelisada\"        -> integer 400 >>= withGrain 2 >>= withMultipliable\n        \"viissada\"        -> integer 500 >>= withGrain 2 >>= withMultipliable\n        \"kuussada\"        -> integer 600 >>= withGrain 2 >>= withMultipliable\n        \"seitsesada\"      -> integer 700 >>= withGrain 2 >>= withMultipliable\n        \"kaheksasada\"     -> integer 800 >>= withGrain 2 >>= withMultipliable\n        \"\u00c3\u00bcheksasada\" -> integer 900 >>= withGrain 2 >>= withMultipliable\n        _ -> Nothing\n      _ -> Nothing\n  }\n\ntwentyNinetyMap :: HashMap Text Integer\ntwentyNinetyMap = HashMap.fromList\n  [ (\"kaksk\u00c3\u00bcmmend\", 20)\n  , (\"kolmk\u00c3\u00bcmmend\", 30)\n  , (\"nelik\u00c3\u00bcmmend\", 40)\n  , (\"viisk\u00c3\u00bcmmend\", 50)\n  , (\"kuusk\u00c3\u00bcmmend\", 60)\n  , (\"seitsek\u00c3\u00bcmmend\", 70)\n  , (\"kaheksak\u00c3\u00bcmmend\", 80)\n  , (\"\u00c3\u00bcheksak\u00c3\u00bcmmend\", 90)\n  ]\n\nruletwentyNinety :: Rule\nruletwentyNinety = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"((kaks|kolm|neli|viis|kuus|seitse|kaheksa|(\u00c3\u00bc)heksa)k(\u00c3\u00bc)mmend)\"\n    ]\n    , prod = \\tokens -> case tokens of\n        (Token RegexMatch (GroupMatch (match:_)):_) ->\n          HashMap.lookup (Text.toLower match) twentyNinetyMap >>= integer\n        _ -> Nothing\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"dot|point\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + decimalsToDouble v2\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator ,\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(([, ])\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_:sep:_)):_) ->\n        parseDouble (Text.replace sep Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleACoupleOf\n  , ruleAFew\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleInteger\n  , ruletwentyNinety\n  , ruleInteger3\n  , ruleInteger4\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleMultiply\n  , ruleNumeralDotNumeral\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleTen\n  ]\n", "num_lines": 290}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.FI.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext {locale = makeLocale FI Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nolla\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"yksi\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"kaksi\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"kolme\"\n             ]\n  , examples (NumeralValue 4)\n             [ \"nelj\u00c3\u00a4\"\n             ]\n  , examples (NumeralValue 5)\n             [ \"viisi\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"kuusi\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"seitsem\u00c3\u00a4n\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"kahdeksan\"\n             ]\n  , examples (NumeralValue 9)\n             [ \"yhdeks\u00c3\u00a4n\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"10\"\n             , \"kymmenen\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"yksitoista\"\n             ]\n  , examples (NumeralValue 12)\n             [ \"kaksitoista\"\n             ]\n  , examples (NumeralValue 13)\n             [ \"kolmetoista\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"nelj\u00c3\u00a4toista\"\n             ]\n  , examples (NumeralValue 15)\n             [ \"viisitoista\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"kuusitoista\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"seitsem\u00c3\u00a4ntoista\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"kahdeksantoista\"\n             ]\n  , examples (NumeralValue 19)\n             [ \"yhdeks\u00c3\u00a4ntoista\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"kaksikymment\u00c3\u00a4\"\n             ]\n  , examples (NumeralValue 24)\n             [ \"24\"\n             , \"kaksikymment\u00c3\u00a4nelj\u00c3\u00a4\"\n             ]\n  , examples (NumeralValue 35)\n             [ \"kolmekymment\u00c3\u00a4viisi\"\n             ]\n  , examples (NumeralValue 42)\n             [ \"nelj\u00c3\u00a4kymment\u00c3\u00a4kaksi\"\n             ]\n  , examples (NumeralValue 52)\n             [ \"viisikymment\u00c3\u00a4kaksi\"\n             ]\n  , examples (NumeralValue 62)\n             [ \"kuusikymment\u00c3\u00a4kaksi\"\n             ]\n  , examples (NumeralValue 72)\n             [ \"seitsem\u00c3\u00a4nkymment\u00c3\u00a4kaksi\"\n             ]\n  , examples (NumeralValue 82)\n             [ \"kahdeksankymment\u00c3\u00a4kaksi\"\n             ]\n  , examples (NumeralValue 99)\n             [ \"99\"\n             , \"yhdeks\u00c3\u00a4nkymment\u00c3\u00a4yhdeks\u00c3\u00a4n\"\n             ]\n  ]\n", "num_lines": 123}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Numeral.FI.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleIntegerNumeric :: Rule\nruleIntegerNumeric = Rule\n  { name = \"integer (numeric)\"\n  , pattern =\n    [ regex \"(\\\\d{1,18})\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        v <- parseInt match\n        integer $ toInteger v\n      _ -> Nothing\n  }\n\nnumeralMap :: HashMap Text Integer\nnumeralMap = HashMap.fromList\n  [ ( \"nolla\", 0 )\n  , ( \"yksi\", 1 )\n  , ( \"kaksi\", 2 )\n  , ( \"kolme\", 3 )\n  , ( \"nelj\u00c3\u00a4\", 4 )\n  , ( \"viisi\", 5 )\n  , ( \"kuusi\", 6 )\n  , ( \"seitsem\u00c3\u00a4n\", 7 )\n  , ( \"kahdeksan\", 8 )\n  , ( \"yhdeks\u00c3\u00a4n\", 9 )\n  , ( \"kymmenen\", 10 )\n  ]\n\nruleNumeral :: Rule\nruleNumeral = Rule\n  { name = \"number (0..10)\"\n  , pattern =\n    [ regex \"(nolla|yksi|kaksi|kolme|nelj\u00c3\u00a4|viisi|kuusi|seitsem\u00c3\u00a4n|kahdeksan|yhdeks\u00c3\u00a4n|kymmenen)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) numeralMap >>= integer\n      _ -> Nothing\n  }\n\nelevenToNineteenMap :: HashMap Text Integer\nelevenToNineteenMap = HashMap.fromList\n  [ ( \"yksitoista\", 11 )\n  , ( \"kaksitoista\", 12 )\n  , ( \"kolmetoista\", 13 )\n  , ( \"nelj\u00c3\u00a4toista\", 14 )\n  , ( \"viisitoista\", 15 )\n  , ( \"kuusitoista\", 16 )\n  , ( \"seitsem\u00c3\u00a4ntoista\", 17 )\n  , ( \"kahdeksantoista\", 18 )\n  , ( \"yhdeks\u00c3\u00a4ntoista\", 19 )\n  ]\n\nruleElevenToNineteen :: Rule\nruleElevenToNineteen = Rule\n  { name = \"number (11..19)\"\n  , pattern =\n    [ regex \"(yksitoista|kaksitoista|kolmetoista|nelj\u00c3\u00a4toista|viisitoista|kuusitoista|seitsem\u00c3\u00a4ntoista|kahdeksantoista|yhdeks\u00c3\u00a4ntoista)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) elevenToNineteenMap >>= integer\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"kaksikymment\u00c3\u00a4\", 20 )\n  , ( \"kolmekymment\u00c3\u00a4\", 30 )\n  , ( \"nelj\u00c3\u00a4kymment\u00c3\u00a4\", 40 )\n  , ( \"viisikymment\u00c3\u00a4\", 50 )\n  , ( \"kuusikymment\u00c3\u00a4\", 60 )\n  , ( \"seitsem\u00c3\u00a4nkymment\u00c3\u00a4\", 70 )\n  , ( \"kahdeksankymment\u00c3\u00a4\", 80 )\n  , ( \"yhdeks\u00c3\u00a4nkymment\u00c3\u00a4\", 90 )\n  ]\n\nruleTens :: Rule\nruleTens = Rule\n  { name = \"integer (20,30..90)\"\n  , pattern =\n    [ regex \"(kaksikymment\u00c3\u00a4|kolmekymment\u00c3\u00a4|nelj\u00c3\u00a4kymment\u00c3\u00a4|viisikymment\u00c3\u00a4|kuusikymment\u00c3\u00a4|seitsem\u00c3\u00a4nkymment\u00c3\u00a4|kahdeksankymment\u00c3\u00a4|yhdeks\u00c3\u00a4nkymment\u00c3\u00a4)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\nruleCompositeTens :: Rule\nruleCompositeTens = Rule\n  { name = \"integer ([2-9][1-9])\"\n  , pattern =\n    [ regex \"(kaksikymment\u00c3\u00a4|kolmekymment\u00c3\u00a4|nelj\u00c3\u00a4kymment\u00c3\u00a4|viisikymment\u00c3\u00a4|kuusikymment\u00c3\u00a4|seitsem\u00c3\u00a4nkymment\u00c3\u00a4|kahdeksankymment\u00c3\u00a4|yhdeks\u00c3\u00a4nkymment\u00c3\u00a4)(yksi|kaksi|kolme|nelj\u00c3\u00a4|viisi|kuusi|seitsem\u00c3\u00a4n|kahdeksan|yhdeks\u00c3\u00a4n)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        v1 <- HashMap.lookup (Text.toLower m1) tensMap\n        v2 <- HashMap.lookup (Text.toLower m2) numeralMap\n        integer $ v1 + v2\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleIntegerNumeric\n  , ruleNumeral\n  , ruleElevenToNineteen\n  , ruleTens\n  , ruleCompositeTens\n  ]\n", "num_lines": 142}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.FR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"zero\"\n             , \"z\u00c3\u00a9ro\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"un\"\n             , \"une\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"onze\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"dix sept\"\n             , \"dix-sept\"\n             ]\n  , examples (NumeralValue 21)\n             [ \"vingt et un\"\n             , \"vingt-et-un\"\n             ]\n  , examples (NumeralValue 23)\n             [ \"vingt trois\"\n             , \"vingt-trois\"\n             ]\n  , examples (NumeralValue 70)\n             [ \"soixante dix\"\n             ]\n  , examples (NumeralValue 71)\n             [ \"soixante onze\"\n             ]\n  , examples (NumeralValue 78)\n             [ \"soixante dix huit\"\n             ]\n  , examples (NumeralValue 73)\n             [ \"soixante treize\"\n             ]\n  , examples (NumeralValue 80)\n             [ \"quatre vingt\"\n             ]\n  , examples (NumeralValue 81)\n             [ \"quatre vingt un\"\n             ]\n  , examples (NumeralValue 82)\n             [ \"quatre vingt deux\"\n             ]\n  , examples (NumeralValue 90)\n             [ \"quatre vingt dix\"\n             ]\n  , examples (NumeralValue 91)\n             [ \"quatre vingt onze\"\n             ]\n  , examples (NumeralValue 92)\n             [ \"quatre vingt douze\"\n             ]\n  , examples (NumeralValue 99)\n             [ \"quatre vingt dix neuf\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"trente trois\"\n             , \"trente-trois\"\n             , \"trente 3\"\n             ]\n  , examples (NumeralValue 118)\n             [ \"cent dix-huit\"\n             ]\n  , examples (NumeralValue 4020)\n             [ \"quatre mille vingt\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"cent mille\"\n             , \"100 000\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             , \"trois millions\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             , \"un million deux cent mille\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"moins 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             ]\n  , examples (NumeralValue 6.7)\n             [ \"6,7\"\n             ]\n  , examples (NumeralValue 6700.54)\n             [ \"6.700,54\"\n             , \"6 700,54\"\n             ]\n  ]\n", "num_lines": 136}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.FR.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumerals4 :: Rule\nruleNumerals4 = Rule\n  { name = \"numbers 81\"\n  , pattern =\n    [ numberWith TNumeral.value (== 80)\n    , numberWith TNumeral.value (== 1)\n    ]\n  , prod = \\_ -> integer 81\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|moins\"\n    , dimension Numeral\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> double $ v * (-1)\n      _ -> Nothing\n  }\n\nruleNumerals2 :: Rule\nruleNumerals2 = Rule\n  { name = \"numbers 22..29 32..39 .. 52..59\"\n  , pattern =\n    [ oneOf [20, 50, 40, 30]\n    , regex \"[\\\\s\\\\-]+\"\n    , Predicate $ numberBetween 2 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(([\\\\. ])\\\\d\\\\d\\\\d)+,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_:sep:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace sep Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nruleNumeral2Map :: HashMap Text Integer\nruleNumeral2Map = HashMap.fromList\n  [ ( \"vingt\"    , 20 )\n  , ( \"trente\"   , 30 )\n  , ( \"quarante\" , 40 )\n  , ( \"cinquante\", 50 )\n  , ( \"soixante\" , 60 )\n  ]\n\nruleNumeral2 :: Rule\nruleNumeral2 = Rule\n  { name = \"number (20..60)\"\n  , pattern =\n    [ regex \"(vingt|trente|quarante|cinquante|soixante)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) ruleNumeral2Map >>= integer\n      _ -> Nothing\n  }\n\nruleNumerals5 :: Rule\nruleNumerals5 = Rule\n  { name = \"numbers 62..69 .. 92..99\"\n  , pattern =\n    [ oneOf [60, 80]\n    , regex \"[\\\\s\\\\-]+\"\n    , Predicate $ numberBetween 2 20\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralMap :: HashMap Text Integer\nruleNumeralMap = HashMap.fromList\n  [ ( \"zero\"     , 0 )\n  , ( \"z\u00c3\u00a9ro\"     , 0 )\n  , ( \"un\"       , 1 )\n  , ( \"une\"      , 1 )\n  , ( \"deux\"     , 2 )\n  , ( \"trois\"    , 3 )\n  , ( \"quatre\"   , 4 )\n  , ( \"cinq\"     , 5 )\n  , ( \"six\"      , 6 )\n  , ( \"sept\"     , 7 )\n  , ( \"huit\"     , 8 )\n  , ( \"neuf\"     , 9 )\n  , ( \"dix\"      , 10 )\n  , ( \"onze\"     , 11 )\n  , ( \"douze\"    , 12 )\n  , ( \"treize\"   , 13 )\n  , ( \"quatorze\" , 14 )\n  , ( \"quinze\"   , 15 )\n  , ( \"seize\"    , 16 )\n  ]\n\nruleNumeral :: Rule\nruleNumeral = Rule\n  { name = \"number (0..16)\"\n  , pattern =\n    [ regex \"(z(e|\u00c3\u00a9)ro|une?|deux|trois|quatre|cinq|six|sept|huit|neuf|dix|onze|douze|treize|quatorze|quinze|seize)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) ruleNumeralMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeral3 :: Rule\nruleNumeral3 = Rule\n  { name = \"number (17..19)\"\n  , pattern =\n    [ numberWith TNumeral.value (== 10)\n    , regex \"[\\\\s\\\\-]+\"\n    , Predicate $ numberBetween 7 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> double $ 10 + v\n      _ -> Nothing\n  }\n\nruleNumerals3 :: Rule\nruleNumerals3 = Rule\n  { name = \"numbers 61 71\"\n  , pattern =\n    [ numberWith TNumeral.value (== 60)\n    , regex \"-?et-?\"\n    , oneOf [1, 11]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W$\u00e2\u201a\u00ac\u00c2\u00a2\u00c2\u00a3]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\nruleNumeral4 :: Rule\nruleNumeral4 = Rule\n  { name = \"number 80\"\n  , pattern =\n    [ regex \"quatre\"\n    , regex \"vingts?\"\n    ]\n  , prod = \\_ -> integer 80\n  }\n\nruleNumerals :: Rule\nruleNumerals = Rule\n  { name = \"numbers 21 31 41 51\"\n  , pattern =\n    [ oneOf [20, 50, 40, 30]\n    , regex \"-?et-?\"\n    , numberWith TNumeral.value (== 1)\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(([\\\\. ])\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_:sep:_)):\n       _) -> let fmt = Text.replace sep Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(cent|mille|millions?|milliards?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"cent\"      -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"mille\"     -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"million\"   -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"millions\"  -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"milliard\"  -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"milliards\" -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        _           -> Nothing\n      _ -> Nothing\n  }\n\nruleSum :: Rule\nruleSum = Rule\n  { name = \"intersect 2 numbers\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  , ruleNumeral\n  , ruleNumeral2\n  , ruleNumeral3\n  , ruleNumeral4\n  , ruleNumerals\n  , ruleNumerals2\n  , ruleNumerals3\n  , ruleNumerals4\n  , ruleNumerals5\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleSum\n  , ruleMultiply\n  ]\n", "num_lines": 320}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.GA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"a n\u00c3\u00a1id\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"aon\"\n             , \"a haon\"\n             , \"Amh\u00c3\u00a1in\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"Fiche\"\n             ]\n  , examples (NumeralValue 30)\n             [ \"d\u00c3\u00a9ag is fiche\"\n             ]\n  , examples (NumeralValue 40)\n             [ \"is dha fhichead\"\n             , \"is d\u00c3\u00a1 fhichead\"\n             ]\n  , examples (NumeralValue 50)\n             [ \"deag is dha fhichead\"\n             , \"deag is d\u00c3\u00a1 fhichead\"\n             ]\n  ]\n", "num_lines": 53}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.GA.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|m(\u00c3\u00ad|i)neas(\\\\sa)?\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> double $ v * (-1)\n      _ -> Nothing\n  }\n\noneToTenMap :: HashMap Text Integer\noneToTenMap = HashMap.fromList\n  [ (\"aon\", 1)\n  , (\"dha\", 2)\n  , (\"dh\u00c3\u00a1\", 2)\n  , (\"tr\u00c3\u00ad\", 3)\n  , (\"tri\", 3)\n  , (\"ceithre\", 4)\n  , (\"cuig\", 5)\n  , (\"c\u00c3\u00baig\", 5)\n  , (\"s\u00c3\u00a9\", 6)\n  , (\"se\", 6)\n  , (\"seacht\", 7)\n  , (\"ocht\", 8)\n  , (\"naoi\", 9)\n  , (\"deich\", 10)\n  ]\n\nruleNumerals2 :: Rule\nruleNumerals2 = Rule\n  { name = \"numbers, 1-10\"\n  , pattern =\n    [ regex \"(aon|dh(\u00c3\u00a1|a)|tr(\u00c3\u00ad|i)|ceithre|c(\u00c3\u00ba|u)ig|seacht|s(\u00c3\u00a9|e)|ocht|naoi|deich)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) oneToTenMap >>= integer\n      _ -> Nothing\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(,\\\\d\\\\d\\\\d)+\\\\.\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \",\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*\\\\.\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal True match\n      _ -> Nothing\n  }\n\nruleDag :: Rule\nruleDag = Rule\n  { name = \"d\u00c3\u00a9ag\"\n  , pattern =\n    [ regex \"d(\u00c3\u00a9|e)ag\"\n    ]\n  , prod = \\_ -> integer 10\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\noldVigNumeralsSMap :: HashMap Text Integer\noldVigNumeralsSMap = HashMap.fromList\n  [ (\"d\u00c3\u00a1 fhichead\", 40)\n  , (\"da fhichead\", 40)\n  , (\"dh\u00c3\u00a1 fhichead\", 40)\n  , (\"dha fhichead\", 40)\n  , (\"tr\u00c3\u00ad fichid\", 60)\n  , (\"tri fichid\", 60)\n  , (\"ceithre fichid\", 80)\n  ]\n\nruleOldVigesimalNumeralsS :: Rule\nruleOldVigesimalNumeralsS = Rule\n  { name = \"old vigesimal numbers, 20s\"\n  , pattern =\n    [ regex \"(d[\u00c3\u00a9e]ag )?is (dh?(\u00c3\u00a1|a) fhichead|tr(\u00c3\u00ad|i) fichid|ceithre fichid)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (ten:match:_)):_) -> do\n        x <- HashMap.lookup (Text.toLower match) oldVigNumeralsSMap\n        integer $ if Text.null ten then x else x + 10\n      _ -> Nothing\n  }\n\nruleOldVigesimalFiche :: Rule\nruleOldVigesimalFiche = Rule\n  { name = \"old vigesimal 20 + 10\"\n  , pattern =\n    [ regex \"d[\u00c3\u00a9e]ag is fiche\"\n    ]\n  , prod = const $ integer 30\n  }\n\nruleAmhin :: Rule\nruleAmhin = Rule\n  { name = \"amh\u00c3\u00a1in\"\n  , pattern =\n    [ regex \"amh(\u00c3\u00a1|a)in\"\n    ]\n  , prod = \\_ -> integer 1\n  }\n\ntwentyToNinetyMap :: HashMap Text Integer\ntwentyToNinetyMap = HashMap.fromList\n [ (\"fiche\", 20)\n , (\"triocha\", 30)\n , (\"tr\u00c3\u00adocha\", 30)\n , (\"daichead\", 40)\n , (\"caoga\", 50)\n , (\"seasca\", 60)\n , (\"seachto\", 70)\n , (\"seacht\u00c3\u00b3\", 70)\n , (\"ochto\", 80)\n , (\"ocht\u00c3\u00b3\", 80)\n , (\"n\u00c3\u00b3cha\", 90)\n , (\"nocha\", 90)\n ]\n\nruleNumerals :: Rule\nruleNumerals = Rule\n  { name = \"numbers, 20-90\"\n  , pattern =\n    [ regex \"(fiche|tr(\u00c3\u00ad|i)ocha|daichead|caoga|seasca|seacht(\u00c3\u00b3|o)|ocht(\u00c3\u00b3|o)|n(\u00c3\u00b3|o)cha)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) twentyToNinetyMap >>= integer\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator ,\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(,\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \",\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\ncountNumeralsMap :: HashMap Text Integer\ncountNumeralsMap = HashMap.fromList\n  [ (\"naid\", 0)\n  , (\"n\u00c3\u00a1id\", 0)\n  , (\"haon\", 1)\n  , (\"d\u00c3\u00b3\", 2)\n  , (\"do\", 2)\n  , (\"tr\u00c3\u00ad\", 3)\n  , (\"tri\", 3)\n  , (\"ceathair\", 4)\n  , (\"cuig\", 5)\n  , (\"c\u00c3\u00baig\", 5)\n  , (\"s\u00c3\u00a9\", 6)\n  , (\"se\", 6)\n  , (\"seacht\", 7)\n  , (\"hocht\", 8)\n  , (\"naoi\", 9)\n  , (\"deich\", 10)\n  ]\n\nruleCountNumerals :: Rule\nruleCountNumerals = Rule\n  { name = \"count numbers\"\n  , pattern =\n    [ regex \"a (n(\u00c3\u00a1|a)id|haon|d(\u00c3\u00b3|o)|tr(\u00c3\u00ad|i)|ceathair|c(\u00c3\u00ba|u)ig|s(\u00c3\u00a9|e)|seacht|hocht|naoi|deich)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) countNumeralsMap >>= integer\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAmhin\n  , ruleCountNumerals\n  , ruleDag\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  , ruleNumerals\n  , ruleNumerals2\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , ruleOldVigesimalNumeralsS\n  , ruleOldVigesimalFiche\n  ]\n", "num_lines": 253}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.HU.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HU Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nulla\"\n             , \"z\u00c3\u00a9r\u00c3\u00b3\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"egy\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"kett\u00c5\u2018\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"h\u00c3\u00a1rom\"\n             ]\n  , examples (NumeralValue 4)\n             [ \"n\u00c3\u00a9gy\"\n             ]\n  , examples (NumeralValue 5)\n             [ \"\u00c3\u00b6t\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"hat\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"h\u00c3\u00a9t\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"nyolc\"\n             ]\n  , examples (NumeralValue 9)\n             [ \"kilenc\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"tizenegy\"\n             ]\n  , examples (NumeralValue 15)\n             [ \"tizen\u00c3\u00b6t\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"tizenh\u00c3\u00a9t\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"h\u00c3\u00basz\"\n             ]\n  , examples (NumeralValue 22)\n             [ \"huszonkett\u00c5\u2018\"\n             ]\n  , examples (NumeralValue 24)\n             [ \"24\"\n             , \"huszonn\u00c3\u00a9gy\"\n             ]\n  , examples (NumeralValue 26)\n             [ \"huszonhat\"\n             ]\n  , examples (NumeralValue 28)\n             [ \"huszonnyolc\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"t\u00c3\u00adz\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"h\u00c3\u00basz\"\n             ]\n  , examples (NumeralValue 50)\n             [ \"\u00c3\u00b6tven\"\n             ]\n  , examples (NumeralValue 34)\n             [ \"harmincn\u00c3\u00a9gy\"\n             ]\n  ]\n", "num_lines": 98}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Numeral.HU.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralMap :: HashMap Text Integer\nruleNumeralMap = HashMap.fromList\n  [ ( \"nulla\", 0 )\n  , ( \"z\\x00E9r\\x00F3\", 0 )\n  , ( \"egy\", 1 )\n  , ( \"kett\\x0151\", 2 )\n  , ( \"h\\x00E1rom\", 3 )\n  , ( \"n\\x00E9gy\", 4 )\n  , ( \"\\x00F6t\", 5)\n  , ( \"hat\", 6)\n  , ( \"h\\x00E9t\", 7)\n  , ( \"nyolc\", 8)\n  , ( \"kilenc\", 9)\n  , ( \"t\\x00EDz\", 10)\n  ]\n\nruleNumeral :: Rule\nruleNumeral = Rule\n  { name = \"number (0..10)\"\n  , pattern =\n    [ regex \"(nulla|z\\x00E9r\\x00F3|egy|kett\\x0151|h\\x00E1rom|n\\x00E9gy|\\x00F6t|hat|h\\x00E9t|nyolc|kilenc|t\\x00EDz)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) ruleNumeralMap >>= integer\n      _ -> Nothing\n  }\n\nelevenToNineteenMap :: HashMap Text Integer\nelevenToNineteenMap = HashMap.fromList\n  [ ( \"tizenegy\", 11 )\n  , ( \"tizenkett\\x0151\", 12 )\n  , ( \"tizenh\\x00E1rom\", 13 )\n  , ( \"tizenn\\x00E9gy\", 14 )\n  , ( \"tizen\\x00F6t\", 15 )\n  , ( \"tizenhat\", 16 )\n  , ( \"tizenh\\x00E9t\", 17 )\n  , ( \"tizennyolc\", 18 )\n  , ( \"tizenkilenc\", 19 )\n  ]\n\nruleElevenToNineteen :: Rule\nruleElevenToNineteen = Rule\n  { name = \"number (11..19)\"\n  , pattern =\n    [ regex \"(tizenegy|tizenkett\\x0151|tizenh\\x00E1rom|tizenn\\x00E9gy|tizen\\x00F6t|tizenhat|tizenh\\x00E9t|tizennyolc|tizenkilenc)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) elevenToNineteenMap >>= integer\n      _ -> Nothing\n  }\n\ntwentyoneToTwentynineMap :: HashMap Text Integer\ntwentyoneToTwentynineMap = HashMap.fromList\n  [ ( \"huszonegy\", 21 )\n  , ( \"huszonkett\\x0151\", 22 )\n  , ( \"huszonh\\x00E1rom\", 23 )\n  , ( \"huszonn\\x00E9gy\", 24 )\n  , ( \"huszon\\x00F6t\", 25 )\n  , ( \"huszonhat\", 26 )\n  , ( \"huszonh\\x00E9t\", 27 )\n  , ( \"huszonnyolc\", 28 )\n  , ( \"huszonkilenc\", 29 )\n  ]\n\nruleTwentyoneToTwentynine :: Rule\nruleTwentyoneToTwentynine = Rule\n  { name = \"number (21..29)\"\n  , pattern =\n    [ regex \"(huszonegy|huszonkett\\x0151|huszonh\\x00E1rom|huszonn\\x00E9gy|huszon\\x00F6t|huszonhat|huszonh\\x00E9t|huszonnyolc|huszonkilenc)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) twentyoneToTwentynineMap >>= integer\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"h\\x00FAsz\", 20 )\n  , ( \"harminc\", 30 )\n  , ( \"negyven\", 40 )\n  , ( \"\\x00F6tven\", 50 )\n  , ( \"hatvan\", 60 )\n  , ( \"hetven\", 70 )\n  , ( \"nyolcvan\", 80 )\n  , ( \"kilencven\", 90 )\n  ]\n\nruleTens :: Rule\nruleTens = Rule\n  { name = \"integer (20,30..90)\"\n  , pattern =\n    [ regex \"(h\\x00FAsz|harminc|negyven|\u00c3\u00b6tven|hatvan|hetven|nyolcvan|kilencven)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\nruleCompositeTens :: Rule\nruleCompositeTens = Rule\n  { name = \"integer ([3-9][1-9])\"\n  , pattern =\n    [ regex \"(harminc|negyven|\\x00F6tven|hatvan|hetven|nyolcvan|kilencven)(egy|kett\\x0151|h\\x00E1rom|n\\x00E9gy|\\x00F6t|hat|h\\x00E9t|nyolc|kilenc)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        v1 <- HashMap.lookup (Text.toLower m1) tensMap\n        v2 <- HashMap.lookup (Text.toLower m2) ruleNumeralMap\n        integer $ v1 + v2\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNumeral\n  , ruleElevenToNineteen\n  , ruleTwentyoneToTwentynine\n  , ruleTens\n  , ruleCompositeTens\n  ]\n", "num_lines": 155}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.ID.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ID Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nol\"\n             , \"kosong\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"satu\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"Dua\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"10\"\n             , \"sepuluh\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"tiga puluh tiga\"\n             , \"0033\"\n             ]\n  , examples (NumeralValue 100)\n             [ \"100\"\n             , \"seratus\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"tujuh belas\"\n             ]\n  , examples (NumeralValue 28)\n             [ \"28\"\n             , \"dua puluh delapan\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"minus 1.200.000\"\n             , \"negatif 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             , \"-0,0012G\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 ribu\"\n             , \"lima ribu\"\n             ]\n  , examples (NumeralValue 122)\n             [ \"seratus dua puluh dua\"\n             ]\n  , examples (NumeralValue 200000)\n             [ \"dua ratus ribu\"\n             ]\n  , examples (NumeralValue 10011)\n             [ \"sepuluh ribu sebelas\"\n             ]\n  , examples (NumeralValue 721012)\n             [ \"tujuh ratus dua puluh satu ribu dua belas\"\n             ]\n  , examples (NumeralValue 31256721)\n             [ \"tiga puluh satu juta dua ratus lima puluh enam ribu tujuh ratus dua puluh satu\"\n             ]\n  ]\n", "num_lines": 118}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.ID.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleIntegerMap :: HashMap Text Integer\nruleIntegerMap = HashMap.fromList\n  [ ( \"kosong\"  , 0 )\n  , ( \"nol\"     , 0 )\n  , ( \"satu\"    , 1 )\n  , ( \"dua\"     , 2 )\n  , ( \"tiga\"    , 3 )\n  , ( \"empat\"   , 4 )\n  , ( \"lima\"    , 5 )\n  , ( \"enam\"    , 6 )\n  , ( \"tujuh\"   , 7 )\n  , ( \"delapan\" , 8 )\n  , ( \"sembilan\", 9 )\n  , ( \"sebelas\" , 11 )\n  ]\n\nruleTeen :: Rule\nruleTeen = Rule\n  { name = \"teen\"\n  , pattern =\n    [ Predicate $ numberBetween 2 10\n    , regex \"belas\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) -> double $ v + 10\n      _ -> Nothing\n  }\n\nruleNumeralCommaNumeral :: Rule\nruleNumeralCommaNumeral = Rule\n  { name = \"number comma number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"koma\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral nd1:_:Token Numeral nd2:_) ->\n        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|minus|negatif\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))\n      _ -> Nothing\n  }\n\nruleTen :: Rule\nruleTen = Rule\n  { name = \"ten\"\n  , pattern =\n    [ regex \"(se)?puluh\"\n    ]\n  , prod = \\_ -> integer 10 >>= withGrain 1\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [70, 20, 60, 50, 40, 90, 30, 80]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleSomefewcouple :: Rule\nruleSomefewcouple = Rule\n  { name = \"some/few/couple\"\n  , pattern =\n    [ regex \"beberapa\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(se)?(ratus|ribu|juta)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (_:match:_)):_) -> case Text.toLower match of\n        \"ratus\"-> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"ribu\" -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"juta\" -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        _      -> Nothing\n      _ -> Nothing\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"(se)?lusin\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1 >>= withMultipliable\n  }\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..9 11)\"\n  , pattern =\n    [ regex \"(kosong|nol|satu|dua|tiga|empat|lima|enam|tujuh|delapan|sembilan|sebelas)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) ruleIntegerMap >>= integer\n      _ -> Nothing\n  }\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer 20..90\"\n  , pattern =\n    [ Predicate $ numberBetween 2 10\n    , numberWith TNumeral.value (== 10)\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2, TNumeral.grain = Just g}:\n       _) -> double (v1 * v2) >>= withGrain g\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleInteger\n  , ruleInteger2\n  , ruleInteger3\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleMultiply\n  , ruleNumeralCommaNumeral\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleSomefewcouple\n  , ruleTeen\n  , ruleTen\n  ]\n", "num_lines": 266}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.IS.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext{locale = makeLocale IS Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"n\u00c3\u00ball\"\n             , \"null\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"einn\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"tveir\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"\u00c3\u00ber\u00c3\u00adr\"\n             ]\n  , examples (NumeralValue 4)\n             [ \"fj\u00c3\u00b3rir\"\n             ]\n  , examples (NumeralValue 5)\n             [ \"fimm\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"sex\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"sj\u00c3\u00b6\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"\u00c3\u00a1tta\"\n             ]\n  , examples (NumeralValue 9)\n             [ \"n\u00c3\u00adu\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"t\u00c3\u00adu\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"ellefu\"\n             ]\n  , examples (NumeralValue 15)\n             [ \"fimmt\u00c3\u00a1n\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"sautj\u00c3\u00a1n\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"tuttugu\"\n             ]\n  ]\n", "num_lines": 80}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Numeral.IS.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nzeroToTwentyMap:: HashMap Text Integer\nzeroToTwentyMap = HashMap.fromList\n  [ ( \"n\u00c3\u00ball\", 0 )\n  , ( \"null\", 0 )\n  , ( \"einn\", 1 )\n  , ( \"tveir\", 2 )\n  , ( \"\u00c3\u00ber\u00c3\u00adr\", 3 )\n  , ( \"fj\u00c3\u00b3rir\", 4 )\n  , ( \"fimm\", 5 )\n  , ( \"sex\", 6 )\n  , ( \"sj\u00c3\u00b6\", 7 )\n  , ( \"\u00c3\u00a1tta\", 8 )\n  , ( \"n\u00c3\u00adu\", 9 )\n  , ( \"t\u00c3\u00adu\", 10 )\n  , ( \"ellefu\", 11 )\n  , ( \"t\u00c3\u00b3lf\", 12 )\n  , ( \"\u00c3\u00berett\u00c3\u00a1n\", 13 )\n  , ( \"fj\u00c3\u00b3rt\u00c3\u00a1n\", 14 )\n  , ( \"fimmt\u00c3\u00a1n\", 15 )\n  , ( \"sext\u00c3\u00a1n\", 16 )\n  , ( \"sautj\u00c3\u00a1n\", 17 )\n  , ( \"\u00c3\u00a1tj\u00c3\u00a1n\", 18 )\n  , ( \"n\u00c3\u00adtj\u00c3\u00a1n\", 19 )\n  , ( \"tuttugu\", 20 )\n  ]\n\nruleZeroToTwenty :: Rule\nruleZeroToTwenty = Rule\n  { name = \"number (0..20)\"\n  , pattern =\n    [ regex \"(n[\u00c3\u00bau]ll|einn|tveir|\u00c3\u00ber\u00c3\u00adr|fj\u00c3\u00b3rir|fimm(t\u00c3\u00a1n)?|sex(t\u00c3\u00a1n)?|sj\u00c3\u00b6|\u00c3\u00a1tta|n\u00c3\u00adu|t\u00c3\u00adu|ellefu|t\u00c3\u00b3lf|\u00c3\u00berett\u00c3\u00a1n|fj\u00c3\u00b3rt\u00c3\u00a1n|sautj\u00c3\u00a1n|\u00c3\u00a1tj\u00c3\u00a1n|n\u00c3\u00adtj\u00c3\u00a1n|tuttugu)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroToTwentyMap >>= integer\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleZeroToTwenty\n  ]\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.IT.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nulla\"\n             , \"zero\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"uno\"\n             , \"Un\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"due\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"3\"\n             , \"tre\"\n             ]\n  , examples (NumeralValue 4)\n             [ \"4\"\n             , \"quattro\"\n             ]\n  , examples (NumeralValue 5)\n             [ \"5\"\n             , \"cinque\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"6\"\n             , \"sei\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"7\"\n             , \"sette\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"8\"\n             , \"otto\"\n             ]\n  , examples (NumeralValue 9)\n             [ \"9\"\n             , \"nove\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"10\"\n             , \"dieci\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"trentatr\u00c3\u00a9\"\n             , \"0033\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"11\"\n             , \"Undici\"\n             ]\n  , examples (NumeralValue 12)\n             [ \"12\"\n             , \"dodici\"\n             ]\n  , examples (NumeralValue 13)\n             [ \"13\"\n             , \"tredici\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"quattordici\"\n             ]\n  , examples (NumeralValue 15)\n             [ \"15\"\n             , \"quindici\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"sedici\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"diciassette\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"diciotto\"\n             ]\n  , examples (NumeralValue 19)\n             [ \"19\"\n             , \"diciannove\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"venti\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"100 000\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             , \"3 000 000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"meno 1.200.000\"\n             , \"negativo 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             ]\n  , examples (NumeralValue 6.7)\n             [ \"6,7\"\n             ]\n  , examples (NumeralValue 6700.54)\n             [ \"6.700,54\"\n             , \"6 700,54\"\n             ]\n  ]\n", "num_lines": 164}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.IT.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|meno|negativo\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))\n      _ -> Nothing\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(([\\\\. ])\\\\d\\\\d\\\\d)+,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_:sep:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace sep Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> parseDecimal False match\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ (\"venti\", 20)\n  , (\"trenta\", 30)\n  , (\"quaranta\", 40)\n  , (\"cinquanta\", 50)\n  , (\"sessanta\", 60)\n  , (\"settanta\", 70)\n  , (\"ottanta\", 80)\n  , (\"novanta\", 90)\n  ]\n\nruleNumeral2 :: Rule\nruleNumeral2 = Rule\n  { name = \"number (20..90)\"\n  , pattern =\n    [ regex \"(venti|trenta|quaranta|cinquanta|sessanta|settanta|ottanta|novanta)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\nzeroNineteenMap :: HashMap Text Integer\nzeroNineteenMap = HashMap.fromList\n  [ (\"zero\", 0)\n  , (\"niente\", 0)\n  , (\"nulla\", 0)\n  , (\"un\", 1)\n  , (\"uno\", 1)\n  , (\"due\", 2)\n  , (\"tre\", 3)\n  , (\"quattro\", 4)\n  , (\"cinque\", 5)\n  , (\"sei\", 6)\n  , (\"sette\", 7)\n  , (\"otto\", 8)\n  , (\"nove\", 9)\n  , (\"dieci\", 10)\n  , (\"undici\", 11)\n  , (\"dodici\", 12)\n  , (\"tredici\", 13)\n  , (\"quattordici\", 14)\n  , (\"quindici\", 15)\n  , (\"sedici\", 16)\n  , (\"diciassette\", 17)\n  , (\"diciotto\", 18)\n  , (\"diciannove\", 19)\n  ]\n\nruleNumeral :: Rule\nruleNumeral = Rule\n  { name = \"number (0..19)\"\n  , pattern =\n    [ regex \"(zero|nulla|niente|uno|due|tredici|tre|quattro|cinque|sei|sette|otto|nove|dieci|undici|dodici|quattordici|quindici|sedici|diciassette|diciotto|diciannove|un)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroNineteenMap >>= integer\n      _ -> Nothing\n  }\n\nhundredsMap :: HashMap Text Integer\nhundredsMap = HashMap.fromList\n  [ (\"cento\", 100)\n  , (\"duecento\", 200)\n  , (\"trecento\", 300)\n  , (\"quattrocento\", 400)\n  , (\"cinquecento\", 500)\n  , (\"seicento\", 600)\n  , (\"settecento\", 700)\n  , (\"ottocento\", 800)\n  , (\"novecento\", 900)\n  , (\"mila\", 1000)\n  , (\"mille\", 1000)\n  ]\n\nruleNumeral5 :: Rule\nruleNumeral5 = Rule\n  { name = \"number 100..1000 \"\n  , pattern =\n    [ regex \"(due|tre|quattro|cinque|sei|sette|otto|nove)?cento|mil(a|le)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) hundredsMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeral3 :: Rule\nruleNumeral3 = Rule\n  { name = \"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\"\n  , pattern =\n    [ oneOf [70, 20, 60, 50, 40, 90, 30, 80]\n    , regex \"e\"\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\ntwentyoneNinetynineMap :: HashMap Text Integer\ntwentyoneNinetynineMap = HashMap.fromList\n  [ (\"ventuno\", 21)\n  , (\"ventidue\", 22)\n  , (\"ventitre\", 23)\n  , (\"ventitr\u00c3\u00a9\", 23)\n  , (\"ventiquattro\", 24)\n  , (\"venticinque\", 25)\n  , (\"ventisei\", 26)\n  , (\"ventisette\", 27)\n  , (\"ventotto\", 28)\n  , (\"ventinove\", 29)\n  , (\"trentuno\", 31)\n  , (\"trentadue\", 32)\n  , (\"trentatre\", 33)\n  , (\"trentatr\u00c3\u00a9\", 33)\n  , (\"trentaquattro\", 34)\n  , (\"trentacinque\", 35)\n  , (\"trentasei\", 36)\n  , (\"trentasette\", 37)\n  , (\"trentotto\", 38)\n  , (\"trentanove\", 39)\n  , (\"quarantuno\", 41)\n  , (\"quarantadue\", 42)\n  , (\"quarantatre\", 43)\n  , (\"quarantatr\u00c3\u00a9\", 43)\n  , (\"quarantaquattro\", 44)\n  , (\"quarantacinque\", 45)\n  , (\"quarantasei\", 46)\n  , (\"quarantasette\", 47)\n  , (\"quarantotto\", 48)\n  , (\"quarantanove\", 49)\n  , (\"cinquantuno\", 51)\n  , (\"cinquantadue\", 52)\n  , (\"cinquantatre\", 53)\n  , (\"cinquantatr\u00c3\u00a9\", 53)\n  , (\"cinquantaquattro\", 54)\n  , (\"cinquantacinque\", 55)\n  , (\"cinquantasei\", 56)\n  , (\"cinquantasette\", 57)\n  , (\"cinquantotto\", 58)\n  , (\"cinquantanove\", 59)\n  , (\"sessantuno\", 61)\n  , (\"sessantadue\", 62)\n  , (\"sessantatr\u00c3\u00a9\", 63)\n  , (\"sessantatre\", 63)\n  , (\"sessantaquattro\", 64)\n  , (\"sessantacinque\", 65)\n  , (\"sessantasei\", 66)\n  , (\"sessantasette\", 67)\n  , (\"sessantotto\", 68)\n  , (\"sessantanove\", 69)\n  , (\"settantuno\", 71)\n  , (\"settantadue\", 72)\n  , (\"settantatr\u00c3\u00a9\", 73)\n  , (\"settantatre\", 73)\n  , (\"settantaquattro\", 74)\n  , (\"settantacinque\", 75)\n  , (\"settantasei\", 76)\n  , (\"settantasette\", 77)\n  , (\"settantotto\", 78)\n  , (\"settantanove\", 79)\n  , (\"ottantuno\", 81)\n  , (\"ottantadue\", 82)\n  , (\"ottantatr\u00c3\u00a9\", 83)\n  , (\"ottantatre\", 83)\n  , (\"ottantaquattro\", 84)\n  , (\"ottantacinque\", 85)\n  , (\"ottantasei\", 86)\n  , (\"ottantasette\", 87)\n  , (\"ottantotto\", 88)\n  , (\"ottantanove\", 89)\n  , (\"novantuno\", 91)\n  , (\"novantadue\", 92)\n  , (\"novantatre\", 93)\n  , (\"novantatr\u00c3\u00a9\", 93)\n  , (\"novantaquattro\", 94)\n  , (\"novantacinque\", 95)\n  , (\"novantasei\", 96)\n  , (\"novantasette\", 97)\n  , (\"novantotto\", 98)\n  , (\"novantanove\", 99)\n  ]\n\nruleNumeral4 :: Rule\nruleNumeral4 = Rule\n  { name = \"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\"\n  , pattern =\n    [ regex \"((venti|trenta|quaranta|cinquanta|sessanta|settanta|ottanta|novanta)(due|tre|tr\u00c3\u00a9|quattro|cinque|sei|sette|nove))|((vent|trent|quarant|cinquant|sessant|settant|ottant|novant)(uno|otto))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) twentyoneNinetynineMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumerals :: Rule\nruleNumerals = Rule\n  { name = \"numbers 200..999\"\n  , pattern =\n    [ Predicate $ numberBetween 2 10\n    , numberWith TNumeral.value (== 100)\n    , Predicate $ numberBetween 0 100\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       Token Numeral NumeralData{TNumeral.value = v3}:\n       _) -> double $ v1 * v2 + v3\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(([\\\\. ])\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_:sep:_)):\n       _) -> let fmt = Text.replace sep Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleIntegerWithThousandsSeparator\n  , ruleNumeral\n  , ruleNumeral2\n  , ruleNumeral3\n  , ruleNumeral4\n  , ruleNumeral5\n  , ruleNumerals\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  ]\n", "num_lines": 329}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.NB.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NB Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"null\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"\u00c3\u00a9n\"\n             , \"en\"\n             , \"Ett\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"to\"\n             , \"et par\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"7\"\n             , \"syv\"\n             , \"sju\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"fjorten\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"seksten\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"sytten\"\n             , \"s\u00c3\u00b8tten\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"atten\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"tyve\"\n             , \"Tjue\"\n             ]\n  , examples (NumeralValue 30)\n             [ \"30\"\n             , \"tretti\"\n             , \"tredve\"\n             ]\n  , examples (NumeralValue 70)\n             [ \"70\"\n             , \"s\u00c3\u00b8tti\"\n             , \"sytti\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"100 000\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             , \"3 000 000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             , \"1 200 000\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"minus 1.200.000\"\n             , \"negativ 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             , \"-1 200 000\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 tusen\"\n             , \"fem tusen\"\n             , \"5 000\"\n             ]\n  , examples (NumeralValue 100)\n             [ \"hundre\"\n             ]\n  , examples (NumeralValue 5020)\n             [ \"fem tusen og tjue\"\n             ]\n  , examples (NumeralValue 1e9)\n             [ \"en milliard\"\n             ]\n  , examples (NumeralValue 1e12)\n             [ \"en billion\"\n             ]\n  , examples (NumeralValue 1e15)\n             [ \"en billiard\"\n             ]\n  , examples (NumeralValue 1e18)\n             [ \"en trillion\"\n             ]\n  , examples (NumeralValue 1e21)\n             [ \"en trilliard\"\n             ]\n  , examples (NumeralValue 1e24)\n             [ \"en kvadrillion\"\n             ]\n  , examples (NumeralValue 1e27)\n             [ \"en kvadrilliard\"\n             ]\n  , examples (NumeralValue 6e10)\n             [ \"seksti milliarder\"\n             , \"60 milliarder\"\n             ]\n  , examples (NumeralValue 3e12)\n             [ \"tre billioner\"\n             , \"3 billioner\"\n             ]\n  , examples (NumeralValue 4e17)\n             [ \"fire hundre billiarder\"\n             , \"400 billiarder\"\n             ]\n  , examples (NumeralValue 2e18)\n             [ \"to trillioner\"\n             , \"2 trillioner\"\n             ]\n  , examples (NumeralValue 1.8e22)\n             [ \"atten trilliarder\"\n             , \"18 trilliarder\"\n             ]\n  , examples (NumeralValue 1.8e22)\n             [ \"atten trilliarder\"\n             , \"18 trilliarder\"\n             ]\n  , examples (NumeralValue 4.11e26)\n             [ \"fire hundre og elleve kvadrillioner\"\n             , \"411 kvadrillioner\"\n             ]\n  , examples (NumeralValue 9e27)\n             [ \"ni kvadrilliarder\"\n             , \"9 kvadrilliarder\"\n             ]\n  , examples (NumeralValue 21)\n             [ \"tjueen\"\n             , \"tjue\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 22)\n             [ \"tjueto\"\n             ]\n  , examples (NumeralValue 23)\n             [ \"tjuetre\"\n             ]\n  , examples (NumeralValue 24)\n             [ \"tjuefire\"\n             ]\n  , examples (NumeralValue 25)\n             [ \"tjuefem\"\n             ]\n  , examples (NumeralValue 26)\n             [ \"tjueseks\"\n             ]\n  , examples (NumeralValue 27)\n             [ \"tjuesju\"\n             , \"tjuesyv\"\n             ]\n  , examples (NumeralValue 28)\n             [ \"tjue\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 29)\n             [ \"tjueni\"\n             ]\n  , examples (NumeralValue 31)\n             [ \"trettien\"\n             , \"tretti\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 32)\n             [ \"trettito\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"trettitre\"\n             ]\n  , examples (NumeralValue 34)\n             [ \"trettifire\"\n             ]\n  , examples (NumeralValue 35)\n             [ \"trettifem\"\n             ]\n  , examples (NumeralValue 36)\n             [ \"trettiseks\"\n             ]\n  , examples (NumeralValue 37)\n             [ \"trettisju\"\n             , \"trettisyv\"\n             ]\n  , examples (NumeralValue 38)\n             [ \"tretti\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 39)\n             [ \"trettini\"\n             ]\n  , examples (NumeralValue 41)\n             [ \"f\u00c3\u00b8rtien\"\n             , \"f\u00c3\u00b8rti\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 42)\n             [ \"f\u00c3\u00b8rtito\"\n             ]\n  , examples (NumeralValue 43)\n             [ \"f\u00c3\u00b8rtitre\"\n             ]\n  , examples (NumeralValue 44)\n             [ \"f\u00c3\u00b8rtifire\"\n             ]\n  , examples (NumeralValue 45)\n             [ \"f\u00c3\u00b8rtifem\"\n             ]\n  , examples (NumeralValue 46)\n             [ \"f\u00c3\u00b8rtiseks\"\n             ]\n  , examples (NumeralValue 47)\n             [ \"f\u00c3\u00b8rtisju\"\n             , \"f\u00c3\u00b8rtisyv\"\n             ]\n  , examples (NumeralValue 48)\n             [ \"f\u00c3\u00b8rti\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 49)\n             [ \"f\u00c3\u00b8rtini\"\n             ]\n  , examples (NumeralValue 51)\n             [ \"femtien\"\n             , \"femti\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 52)\n             [ \"femtito\"\n             ]\n  , examples (NumeralValue 53)\n             [ \"femtitre\"\n             ]\n  , examples (NumeralValue 54)\n             [ \"femtifire\"\n             ]\n  , examples (NumeralValue 55)\n             [ \"femtifem\"\n             ]\n  , examples (NumeralValue 56)\n             [ \"femtiseks\"\n             ]\n  , examples (NumeralValue 57)\n             [ \"femtisju\"\n             , \"femtisyv\"\n             ]\n  , examples (NumeralValue 58)\n             [ \"femti\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 59)\n             [ \"femtini\"\n             ]\n  , examples (NumeralValue 61)\n             [ \"sekstien\"\n             , \"seksti\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 62)\n             [ \"sekstito\"\n             ]\n  , examples (NumeralValue 63)\n             [ \"sekstitre\"\n             ]\n  , examples (NumeralValue 64)\n             [ \"sekstifire\"\n             ]\n  , examples (NumeralValue 65)\n             [ \"sekstifem\"\n             ]\n  , examples (NumeralValue 66)\n             [ \"sekstiseks\"\n             ]\n  , examples (NumeralValue 67)\n             [ \"sekstisju\"\n             , \"sekstisyv\"\n             ]\n  , examples (NumeralValue 68)\n             [ \"seksti\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 69)\n             [ \"sekstini\"\n             ]\n  , examples (NumeralValue 71)\n             [ \"syttien\"\n             , \"s\u00c3\u00b8ttien\"\n             , \"s\u00c3\u00b8tti\u00c3\u00a9n\"\n             , \"s\u00c3\u00b8tti\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 72)\n             [ \"syttito\"\n             , \"s\u00c3\u00b8ttito\"\n             ]\n  , examples (NumeralValue 73)\n             [ \"syttitre\"\n             , \"s\u00c3\u00b8ttitre\"\n             ]\n  , examples (NumeralValue 74)\n             [ \"syttifire\"\n             , \"s\u00c3\u00b8ttifire\"\n             ]\n  , examples (NumeralValue 75)\n             [ \"syttifem\"\n             , \"s\u00c3\u00b8ttifem\"\n             ]\n  , examples (NumeralValue 76)\n             [ \"syttiseks\"\n             , \"s\u00c3\u00b8ttiseks\"\n             ]\n  , examples (NumeralValue 77)\n             [ \"syttisju\"\n             , \"syttisju\"\n             , \"s\u00c3\u00b8ttisyv\"\n             , \"s\u00c3\u00b8ttisyv\"\n             ]\n  , examples (NumeralValue 78)\n             [ \"s\u00c3\u00b8tti\u00c3\u00a5tte\"\n             , \"s\u00c3\u00b8tti\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 79)\n             [ \"s\u00c3\u00b8ttini\"\n             , \"s\u00c3\u00b8ttini\"\n             ]\n  , examples (NumeralValue 81)\n             [ \"\u00c3\u00a5ttien\"\n             , \"\u00c3\u00a5tti\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 82)\n             [ \"\u00c3\u00a5ttito\"\n             ]\n  , examples (NumeralValue 83)\n             [ \"\u00c3\u00a5ttitre\"\n             ]\n  , examples (NumeralValue 84)\n             [ \"\u00c3\u00a5ttifire\"\n             ]\n  , examples (NumeralValue 85)\n             [ \"\u00c3\u00a5ttifem\"\n             ]\n  , examples (NumeralValue 86)\n             [ \"\u00c3\u00a5ttiseks\"\n             ]\n  , examples (NumeralValue 87)\n             [ \"\u00c3\u00a5ttisju\"\n             , \"\u00c3\u00a5ttisyv\"\n             ]\n  , examples (NumeralValue 88)\n             [ \"\u00c3\u00a5tti\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 89)\n             [ \"\u00c3\u00a5ttini\"\n             ]\n  , examples (NumeralValue 91)\n             [ \"nittien\"\n             , \"nitti\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 92)\n             [ \"nittito\"\n             ]\n  , examples (NumeralValue 93)\n             [ \"nittitre\"\n             ]\n  , examples (NumeralValue 94)\n             [ \"nittifire\"\n             ]\n  , examples (NumeralValue 95)\n             [ \"nittifem\"\n             ]\n  , examples (NumeralValue 96)\n             [ \"nittiseks\"\n             ]\n  , examples (NumeralValue 97)\n             [ \"nittisju\"\n             , \"nittisyv\"\n             ]\n  , examples (NumeralValue 98)\n             [ \"nitti\u00c3\u00a5tte\"\n             ]\n  , examples (NumeralValue 99)\n             [ \"nittini\"\n             ]\n  ]\n", "num_lines": 427}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.NB.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleIntersectWithAnd :: Rule\nruleIntersectWithAnd = Rule\n  { name = \"intersect (with and)\"\n  , pattern =\n    [ Predicate hasGrain\n    , regex \"og\"\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|minus|negativ\"\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))\n      _ -> Nothing\n  }\n\nruleFew :: Rule\nruleFew = Rule\n  { name = \"few\"\n  , pattern =\n    [ regex \"(noen )?f\u00c3\u00a5\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+\\\\,\\\\d+)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\case\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [70, 20, 60, 50, 40, 90, 30, 80]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleSingle :: Rule\nruleSingle = Rule\n  { name = \"single\"\n  , pattern =\n    [ regex \"enkelt\"\n    ]\n  , prod = \\_ -> integer 1 >>= withGrain 1\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(hundre(de)?|tusen?|million(er)?|milliard(?:er)?|billion(?:er)?|billiard(?:er)?|trillion(?:er)?|trilliard(?:er)?|kvadrillion(?:er)?|kvadrilliard(?:er)?)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"hundre\"    -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"hundrede\"  -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"tuse\"      -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"tusen\"     -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"million\"   -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"millioner\" -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"milliard\" -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"milliarder\" -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"billion\" -> double 1e12 >>= withGrain 12 >>= withMultipliable\n        \"billioner\" -> double 1e12 >>= withGrain 12 >>= withMultipliable\n        \"billiard\" -> double 1e15 >>= withGrain 15 >>= withMultipliable\n        \"billiarder\" -> double 1e15 >>= withGrain 15 >>= withMultipliable\n        \"trillion\" -> double 1e18 >>= withGrain 18 >>= withMultipliable\n        \"trillioner\" -> double 1e18 >>= withGrain 18 >>= withMultipliable\n        \"trilliard\" -> double 1e21 >>= withGrain 21 >>= withMultipliable\n        \"trilliarder\" -> double 1e21 >>= withGrain 21 >>= withMultipliable\n        \"kvadrillion\" -> double 1e24 >>= withGrain 24 >>= withMultipliable\n        \"kvadrillioner\" -> double 1e24 >>= withGrain 24 >>= withMultipliable\n        \"kvadrilliard\" -> double 1e27 >>= withGrain 27 >>= withMultipliable\n        \"kvadrilliarder\" -> double 1e27 >>= withGrain 27 >>= withMultipliable\n        _           -> Nothing\n      _ -> Nothing\n  }\n\nruleAPair :: Rule\nruleAPair = Rule\n  { name = \"a pair\"\n  , pattern =\n    [ regex \"et par\"\n    ]\n  , prod = \\_ -> integer 2 >>= withGrain 1\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"dusin\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1 >>= withMultipliable\n  }\n\nzeroToNineteenMap :: HashMap Text Integer\nzeroToNineteenMap = HashMap.fromList\n  [ ( \"null\" , 0 )\n  , ( \"ingen\" , 0 )\n  , ( \"intet\" , 0 )\n  , ( \"en\" , 1 )\n  , ( \"ett\" , 1 )\n  , ( \"\u00c3\u00a9n\" , 1 )\n  , ( \"to\" , 2 )\n  , ( \"tre\" , 3 )\n  , ( \"fire\" , 4 )\n  , ( \"fem\" , 5 )\n  , ( \"seks\" , 6 )\n  , ( \"sju\" , 7 )\n  , ( \"syv\" , 7 )\n  , ( \"\u00c3\u00a5tte\" , 8 )\n  , ( \"ni\" , 9 )\n  , ( \"ti\" , 10 )\n  , ( \"elleve\" , 11 )\n  , ( \"tolv\" , 12 )\n  , ( \"tretten\" , 13 )\n  , ( \"fjorten\" , 14 )\n  , ( \"femten\" , 15 )\n  , ( \"seksten\" , 16 )\n  , ( \"s\u00c3\u00b8tten\" , 17 )\n  , ( \"sytten\" , 17 )\n  , ( \"atten\" , 18 )\n  , ( \"nitten\" , 19 )\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..19)\"\n  , pattern =\n    [ regex \"(intet|ingen|null|en|ett|\u00c3\u00a9n|to|tretten|tre|fire|femten|fem|seksten|seks|syv|sju|\u00c3\u00a5tte|nitten|ni|ti|elleve|tolv|fjorten|sytten|s\u00c3\u00b8tten|atten)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroToNineteenMap >>= integer\n      _ -> Nothing\n  }\n\ntwentyToHundredMap :: HashMap Text Integer\ntwentyToHundredMap = HashMap.fromList\n  [ (\"tjueen\", 21)\n  , (\"tjue\u00c3\u00a9n\", 21)\n  , (\"tjueto\", 22)\n  , (\"tjuetre\", 23)\n  , (\"tjuefire\", 24)\n  , (\"tjuefem\", 25)\n  , (\"tjueseks\", 26)\n  , (\"tjuesju\", 27)\n  , (\"tjuesyv\", 27)\n  , (\"tjue\u00c3\u00a5tte\", 28)\n  , (\"tjueni\", 29)\n  , (\"trettien\", 31)\n  , (\"tretti\u00c3\u00a9n\", 31)\n  , (\"trettito\", 32)\n  , (\"trettitre\", 33)\n  , (\"trettifire\", 34)\n  , (\"trettifem\", 35)\n  , (\"trettiseks\", 36)\n  , (\"trettisju\", 37)\n  , (\"trettisyv\", 37)\n  , (\"tretti\u00c3\u00a5tte\", 38)\n  , (\"trettini\", 39)\n  , (\"f\u00c3\u00b8rtien\", 41)\n  , (\"f\u00c3\u00b8rti\u00c3\u00a9n\", 41)\n  , (\"f\u00c3\u00b8rtito\", 42)\n  , (\"f\u00c3\u00b8rtitre\", 43)\n  , (\"f\u00c3\u00b8rtifire\", 44)\n  , (\"f\u00c3\u00b8rtifem\", 45)\n  , (\"f\u00c3\u00b8rtiseks\", 46)\n  , (\"f\u00c3\u00b8rtisju\", 47)\n  , (\"f\u00c3\u00b8rtisyv\", 47)\n  , (\"f\u00c3\u00b8rti\u00c3\u00a5tte\", 48)\n  , (\"f\u00c3\u00b8rtini\", 49)\n  , (\"femtien\", 51)\n  , (\"femti\u00c3\u00a9n\", 51)\n  , (\"femtito\", 52)\n  , (\"femtitre\", 53)\n  , (\"femtifire\", 54)\n  , (\"femtifem\", 55)\n  , (\"femtiseks\", 56)\n  , (\"femtisju\", 57)\n  , (\"femtisyv\", 57)\n  , (\"femti\u00c3\u00a5tte\", 58)\n  , (\"femtini\", 59)\n  , (\"sekstien\", 61)\n  , (\"seksti\u00c3\u00a9n\", 61)\n  , (\"sekstito\", 62)\n  , (\"sekstitre\", 63)\n  , (\"sekstifire\", 64)\n  , (\"sekstifem\", 65)\n  , (\"sekstiseks\", 66)\n  , (\"sekstisju\", 67)\n  , (\"sekstisyv\", 67)\n  , (\"seksti\u00c3\u00a5tte\", 68)\n  , (\"sekstini\", 69)\n  , (\"syttien\", 71)\n  , (\"sytti\u00c3\u00a9n\", 71)\n  , (\"syttito\", 72)\n  , (\"syttitre\", 73)\n  , (\"syttifire\", 74)\n  , (\"syttifem\", 75)\n  , (\"syttiseks\", 76)\n  , (\"syttisju\", 77)\n  , (\"syttisyv\", 77)\n  , (\"sytti\u00c3\u00a5tte\", 78)\n  , (\"syttini\", 79)\n  , (\"s\u00c3\u00b8ttien\", 71)\n  , (\"s\u00c3\u00b8tti\u00c3\u00a9n\", 71)\n  , (\"s\u00c3\u00b8ttito\", 72)\n  , (\"s\u00c3\u00b8ttitre\", 73)\n  , (\"s\u00c3\u00b8ttifire\", 74)\n  , (\"s\u00c3\u00b8ttifem\", 75)\n  , (\"s\u00c3\u00b8ttiseks\", 76)\n  , (\"s\u00c3\u00b8ttisju\", 77)\n  , (\"s\u00c3\u00b8ttisyv\", 77)\n  , (\"s\u00c3\u00b8tti\u00c3\u00a5tte\", 78)\n  , (\"s\u00c3\u00b8ttini\", 79)\n  , (\"\u00c3\u00a5ttien\", 81)\n  , (\"\u00c3\u00a5tti\u00c3\u00a9n\", 81)\n  , (\"\u00c3\u00a5ttito\", 82)\n  , (\"\u00c3\u00a5ttitre\", 83)\n  , (\"\u00c3\u00a5ttifire\", 84)\n  , (\"\u00c3\u00a5ttifem\", 85)\n  , (\"\u00c3\u00a5ttiseks\", 86)\n  , (\"\u00c3\u00a5ttisju\", 87)\n  , (\"\u00c3\u00a5ttisyv\", 87)\n  , (\"\u00c3\u00a5tti\u00c3\u00a5tte\", 88)\n  , (\"\u00c3\u00a5ttini\", 89)\n  , (\"nittien\", 91)\n  , (\"nitti\u00c3\u00a9n\", 91)\n  , (\"nittito\", 92)\n  , (\"nittitre\", 93)\n  , (\"nittifire\", 94)\n  , (\"nittifem\", 95)\n  , (\"nittiseks\", 96)\n  , (\"nittisju\", 97)\n  , (\"nittisyv\", 97)\n  , (\"nitti\u00c3\u00a5tte\", 98)\n  , (\"nittini\", 99)\n  ]\n\nruleInteger4 :: Rule\nruleInteger4 = Rule\n  { name = \"integer (21..99)\"\n  , pattern =\n    [ regex \"(tjueen|tjue\u00c3\u00a9n|tjueto|tjuetre|tjuefire|tjuefem|tjueseks|tjuesju|tjuesyv|tjue\u00c3\u00a5tte|tjueni\\\n            \\|trettien|tretti\u00c3\u00a9n|trettito|trettitre|trettifire|trettifem|trettiseks|trettisju|trettisyv|tretti\u00c3\u00a5tte|trettini\\\n            \\|f\u00c3\u00b8rtien|f\u00c3\u00b8rti\u00c3\u00a9n|f\u00c3\u00b8rtito|f\u00c3\u00b8rtitre|f\u00c3\u00b8rtifire|f\u00c3\u00b8rtifem|f\u00c3\u00b8rtiseks|f\u00c3\u00b8rtisju|f\u00c3\u00b8rtisyv|f\u00c3\u00b8rti\u00c3\u00a5tte|f\u00c3\u00b8rtini\\\n            \\|femtien|femti\u00c3\u00a9n|femtito|femtitre|femtifire|femtifem|femtiseks|femtisju|femtisyv|femti\u00c3\u00a5tte|femtini\\\n            \\|sekstien|seksti\u00c3\u00a9n|sekstito|sekstitre|sekstifire|sekstifem|sekstiseks|sekstisju|sekstisyv|seksti\u00c3\u00a5tte|sekstini\\\n            \\|syttien|sytti\u00c3\u00a9n|syttito|syttitre|syttifire|syttifem|syttiseks|syttisju|syttisyv|sytti\u00c3\u00a5tte|syttini\\\n            \\|s\u00c3\u00b8ttien|s\u00c3\u00b8tti\u00c3\u00a9n|s\u00c3\u00b8ttito|s\u00c3\u00b8ttitre|s\u00c3\u00b8ttifire|s\u00c3\u00b8ttifem|s\u00c3\u00b8ttiseks|s\u00c3\u00b8ttisju|s\u00c3\u00b8ttisyv|s\u00c3\u00b8tti\u00c3\u00a5tte|s\u00c3\u00b8ttini\\\n            \\|\u00c3\u00a5ttien|\u00c3\u00a5tti\u00c3\u00a9n|\u00c3\u00a5ttito|\u00c3\u00a5ttitre|\u00c3\u00a5ttifire|\u00c3\u00a5ttifem|\u00c3\u00a5ttiseks|\u00c3\u00a5ttisju|\u00c3\u00a5ttisyv|\u00c3\u00a5tti\u00c3\u00a5tte|\u00c3\u00a5ttini\\\n            \\|nittien|nitti\u00c3\u00a9n|nittito|nittitre|nittifire|nittifem|nittiseks|nittisju|nittisyv|nitti\u00c3\u00a5tte|nittini\\\n            \\)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) twentyToHundredMap >>= integer\n      _ -> Nothing\n  }\n\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"tyve\" , 20 )\n  , ( \"tjue\" , 20 )\n  , ( \"tredve\" , 30 )\n  , ( \"tretti\" , 30 )\n  , ( \"f\u00c3\u00b8rti\" , 40 )\n  , ( \"femti\" , 50 )\n  , ( \"seksti\" , 60 )\n  , ( \"sytti\" , 70 )\n  , ( \"s\u00c3\u00b8tti\" , 70 )\n  , ( \"\u00c3\u00a5tti\" , 80 )\n  , ( \"nitti\" , 90 )\n  ]\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"(tyve|tjue|tredve|tretti|f\u00c3\u00b8rti|femti|seksti|sytti|s\u00c3\u00b8tti|\u00c3\u00a5tti|nitti)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"komma\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\case\n      (Token Numeral nd1:_:Token Numeral nd2:_) ->\n        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}((?:\\\\.| )\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDouble\n        (Text.replace \" \" Text.empty $ Text.replace \".\" Text.empty $ match)\n        >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAPair\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleFew\n  , ruleInteger\n  , ruleInteger2\n  , ruleInteger3\n  , ruleInteger4\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleIntersectWithAnd\n  , ruleMultiply\n  , ruleNumeralDotNumeral\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleSingle\n  ]\n", "num_lines": 452}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.NL.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nul\"\n             , \"geen\"\n             , \"niks\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"een\"\n             , \"\u00c3\u00a9\u00c3\u00a9n\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"twee\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"3 en 30\"\n             , \"drieendertig\"\n             , \"drie\u00c3\u00abndertig\"\n             , \"drie en dertig\"\n             , \"0033\"\n             ]\n  , examples (NumeralValue 12)\n             [ \"twaalf\"\n             , \"dozijn\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"veertien\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"zestien\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"zeventien\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"achttien\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100.000,0\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"honderd duizend\"\n             ]\n  , examples (NumeralValue 300)\n             [ \"3 honderd\"\n             , \"drie honderd\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 duizend\"\n             , \"vijf duizend\"\n             , \"5.000\"\n             , \"5.000,00\"\n             ]\n  , examples (NumeralValue 144)\n             [ \"gros\"\n             ]\n  , examples (NumeralValue 122)\n             [ \"honderd twee\u00c3\u00abntwintig\"\n             , \"honderd tweeentwintig\"\n             , \"honderd twee en twintig\"\n             ]\n  , examples (NumeralValue 20000)\n             [ \"twintig duizend\"\n             , \"20.000\"\n             , \"20000\"\n             , \"20.000,00\"\n             ]\n  , examples (NumeralValue 0.2)\n             [ \"1/5\"\n             , \"2/10\"\n             , \"3/15\"\n             , \"20/100\"\n             ]\n  ]\n", "num_lines": 118}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.NL.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|min|minus|negatief\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))\n      _ -> Nothing\n  }\n\nruleFew :: Rule\nruleFew = Rule\n  { name = \"few\"\n  , pattern =\n    [ regex \"meerdere\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleTen :: Rule\nruleTen = Rule\n  { name = \"ten\"\n  , pattern =\n    [ regex \"tien\"\n    ]\n  , prod = \\_ -> integer 10 >>= withGrain 1\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+(,\\\\d+)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> parseDecimal False match\n      _ -> Nothing\n  }\n\n-- TODO: Single-word composition (#110)\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer ([2-9][1-9])\"\n  , pattern =\n    [ regex \"(een|twee|drie|vier|vijf|zes|zeven|acht|negen)(?:e|\u00c3\u00ab)n(twintig|dertig|veertig|vijftig|zestig|zeventig|tachtig|negentig)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        v1 <- HashMap.lookup (Text.toLower m1) zeroNineteenMap\n        v2 <- HashMap.lookup (Text.toLower m2) dozenMap\n        integer $ v1 + v2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _ -> Nothing\n      _ -> Nothing\n  }\n\nruleNumeralsEn :: Rule\nruleNumeralsEn = Rule\n  { name = \"numbers en\"\n  , pattern =\n    [ Predicate $ numberBetween 1 10\n    , regex \"-?en-?\"\n    , oneOf [20, 30 .. 90]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(honderd|duizend|miljoen)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"honderd\" -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"duizend\" -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"miljoen\" -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        _         -> Nothing\n      _ -> Nothing\n  }\n\nruleCouple :: Rule\nruleCouple = Rule\n  { name = \"couple\"\n  , pattern =\n    [ regex \"(een )?paar\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"dozijn\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1\n  }\n\nruleGross :: Rule\nruleGross = Rule\n  { name = \"gros\"\n  , pattern =\n    [ regex \"gros\"\n    ]\n  , prod = \\_ -> integer 144 >>= withGrain 1\n  }\n\nzeroNineteenMap :: HashMap Text Integer\nzeroNineteenMap = HashMap.fromList\n  [ (\"niks\", 0)\n  , (\"nul\", 0)\n  , (\"geen\", 0)\n  , (\"\u00c3\u00a9\u00c3\u00a9n\", 1)\n  , (\"een\", 1)\n  , (\"twee\", 2)\n  , (\"drie\", 3)\n  , (\"vier\", 4)\n  , (\"vijf\", 5)\n  , (\"zes\", 6)\n  , (\"zeven\", 7)\n  , (\"acht\", 8)\n  , (\"negen\", 9)\n  , (\"tien\", 10)\n  , (\"elf\", 11)\n  , (\"twaalf\", 12)\n  , (\"dertien\", 13)\n  , (\"veertien\", 14)\n  , (\"vijftien\", 15)\n  , (\"zestien\", 16)\n  , (\"zeventien\", 17)\n  , (\"achttien\", 18)\n  , (\"negentien\", 19)\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..19)\"\n  , pattern =\n    [ regex \"(geen|nul|niks|een|\u00c3\u00a9\u00c3\u00a9n|twee|drie|vier|vijftien|vijf|zestien|zes|zeventien|zeven|achttien|acht|negentien|negen|tien|elf|twaalf|dertien|veertien)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroNineteenMap >>= integer\n      _ -> Nothing\n  }\n\ndozenMap :: HashMap Text Integer\ndozenMap = HashMap.fromList\n  [ (\"twintig\", 20)\n  , (\"dertig\", 30)\n  , (\"veertig\", 40)\n  , (\"vijftig\", 50)\n  , (\"zestig\", 60)\n  , (\"zeventig\", 70)\n  , (\"tachtig\", 80)\n  , (\"negentig\", 90)\n  ]\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"(twintig|dertig|veertig|vijftig|zestig|zeventig|tachtig|negentig)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) dozenMap >>= integer\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleCouple\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleGross\n  , ruleFew\n  , ruleInteger\n  , ruleInteger2\n  , ruleInteger3\n  , ruleIntersect\n  , ruleMultiply\n  , ruleNumeralsEn\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleTen\n  ]\n", "num_lines": 285}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.PL.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nic\"\n             , \"zero\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"jeden\"\n             , \"pojedynczy\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"dwa\"\n             , \"para\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"trzydzie\u00c5\u203aci trzy\"\n             , \"0033\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"czterna\u00c5\u203acie\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"szesna\u00c5\u203acie\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"siedemna\u00c5\u203acie\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"osiemna\u00c5\u203acie\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1.1\"\n             , \"1.10\"\n             , \"01.10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0.77\"\n             , \".77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100,000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3,000,000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1,200,000\"\n             , \"1200000\"\n             , \"1.2M\"\n             , \"1200K\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1,200,000\"\n             , \"-1200000\"\n             , \"minus 1,200,000\"\n             , \"-1.2M\"\n             , \"-1200K\"\n             , \"-.0012G\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 tysi\u00c4\u2122cy\"\n             , \"pi\u00c4\u2122\u00c4\u2021 tysi\u00c4\u2122cy\"\n             ]\n  , examples (NumeralValue 79)\n             [ \"siedemdziesi\u00c4\u2026t dziewi\u00c4\u2122\u00c4\u2021\"\n             , \"siedemdziesi\u00c4\u2122ciu dziewi\u00c4\u2122ciu\"\n             ]\n  , examples (NumeralValue 84)\n             [ \"osiemdziesi\u00c4\u2026t cztery\"\n             , \"osiemdziesiat cztery\"\n             , \"osiemdziesi\u00c4\u2122ciu czterem\"\n             , \"osiemdziesieciu czterem\"\n             ]\n  , examples (NumeralValue 92)\n             [ \"dziewi\u00c4\u2122\u00c4\u2021dziesi\u00c4\u2026t dwa\"\n             , \"dziewiecdziesiat dwa\"\n             , \"dziewi\u00c4\u2122\u00c4\u2021dziesi\u00c4\u2122ciu dw\u00c3\u00b3m\"\n             , \"dziewiecdziesieciu dwom\"\n             ]\n  , examples (NumeralValue 122)\n             [ \"sto dwadzie\u00c5\u203acia dwa\"\n             ]\n  , examples (NumeralValue 200000)\n             [ \"dwie\u00c5\u203acie tysi\u00c4\u2122cy\"\n             ]\n  , examples (NumeralValue 21011)\n             [ \"dwadzie\u00c5\u203acia jeden tysi\u00c4\u2122cy i jedena\u00c5\u203acie\"\n             , \"dwadzie\u00c5\u203acia jeden tysi\u00c4\u2122cy jedena\u00c5\u203acie\"\n             ]\n  , examples (NumeralValue 721012)\n             [ \"siedemset dwadzie\u00c5\u203acia jeden tysi\u00c4\u2122cy dwana\u00c5\u203acie\"\n             , \"siedemset dwadzie\u00c5\u203acia jeden tysi\u00c4\u2122cy i dwana\u00c5\u203acie\"\n             ]\n  , examples (NumeralValue 65000000)\n             [ \"sze\u00c5\u203a\u00c4\u2021dziesi\u00c4\u2026t pi\u00c4\u2122\u00c4\u2021 milion\u00c3\u00b3w\"\n             ]\n  , examples (NumeralValue 31256721)\n             [ \"trzydzie\u00c5\u203aci jeden milion\u00c3\u00b3w dwie\u00c5\u203acie pi\u00c4\u2122\u00c4\u2021dziesi\u00c4\u2026t sze\u00c5\u203a\u00c4\u2021 tysi\u00c4\u2122cy siedemset dwadzie\u00c5\u203acia jeden\"\n             ]\n  , examples (NumeralValue 15)\n             [ \"pi\u00c4\u2122tnasta\"\n             ]\n  ]\n", "num_lines": 141}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.PL.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleSixteen :: Rule\nruleSixteen = Rule\n  { name = \"sixteen\"\n  , pattern =\n    [ regex \"szesna(s|\u00c5\u203a)(tu|cie|toma)\"\n    ]\n  , prod = \\_ -> integer 16\n  }\n\nruleFourteen :: Rule\nruleFourteen = Rule\n  { name = \"fourteen\"\n  , pattern =\n    [ regex \"czterna(s|\u00c5\u203a)(tu|cie|toma)\"\n    ]\n  , prod = \\_ -> integer 14\n  }\n\nruleTwo :: Rule\nruleTwo = Rule\n  { name = \"two\"\n  , pattern =\n    [ regex \"dw(a|(o|\u00c3\u00b3)(ch|m)|oma|iema|ie)\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleSixty :: Rule\nruleSixty = Rule\n  { name = \"sixty\"\n  , pattern =\n    [ regex \"sze(\u00c5\u203a\u00c4\u2021)dziesi(\u00c4\u2026)t|sze(\u00c5\u203a\u00c4\u2021)dziesi(\u00c4\u2122)ci(u|oma)\"\n    ]\n  , prod = \\_ -> integer 60\n  }\n\nruleSeventy :: Rule\nruleSeventy = Rule\n  { name = \"seventy\"\n  , pattern =\n    [ regex \"siedemdziesi((a|\u00c4\u2026)t|(e|\u00c4\u2122)ci(u|oma))\"\n    ]\n  , prod = \\_ -> integer 70\n  }\n\nruleEighty :: Rule\nruleEighty = Rule\n  { name = \"eighty\"\n  , pattern =\n    [ regex \"osiemdziesi((a|\u00c4\u2026)t|(e|\u00c4\u2122)ci(u|oma))\"\n    ]\n  , prod = \\_ -> integer 80\n  }\n\nruleNinety :: Rule\nruleNinety = Rule\n  { name = \"ninety\"\n  , pattern =\n    [ regex \"dziewi(e|\u00c4\u2122)(c|\u00c4\u2021)dziesi((a|\u00c4\u2026)|(e|\u00c4\u2122))(t|ci(u|oma))\"\n    ]\n  , prod = \\_ -> integer 90\n  }\n\nruleIntersectWithAnd :: Rule\nruleIntersectWithAnd = Rule\n  { name = \"intersect (with and)\"\n  , pattern =\n    [ Predicate hasGrain\n    , regex \"i|a\"\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|minus|negative\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))\n      _ -> Nothing\n  }\n\nruleOne :: Rule\nruleOne = Rule\n  { name = \"one\"\n  , pattern =\n    [ regex \"jed(en|nego|nemu|nym|nej|n(a|\u00c4\u2026))\"\n    ]\n  , prod = \\_ -> integer 1\n  }\n\nruleTen :: Rule\nruleTen = Rule\n  { name = \"ten\"\n  , pattern =\n    [ regex \"dzisi(e|\u00c4\u2122)(\u00c4\u2021|c)(iu|ioma)?\"\n    ]\n  , prod = \\_ -> integer 10\n  }\n\nruleSpecialCompositionForMissingHundredsLikeInOneTwentyTwo :: Rule\nruleSpecialCompositionForMissingHundredsLikeInOneTwentyTwo = Rule\n  { name = \"special composition for missing hundreds like in one twenty two\"\n  , pattern =\n    [ Predicate $ numberBetween 1 10\n    , Predicate $ numberBetween 10 100\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double (v1 * 100 + v2)\n      _ -> Nothing\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(,\\\\d\\\\d\\\\d)+\\\\.\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \",\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleNine :: Rule\nruleNine = Rule\n  { name = \"nine\"\n  , pattern =\n    [ regex \"dziewi(e|\u00c4\u2122)(\u00c4\u2021|c)(iu|ioma)?\"\n    ]\n  , prod = \\_ -> integer 9\n  }\n\nruleNumeral8 :: Rule\nruleNumeral8 = Rule\n  { name = \"number 800\"\n  , pattern =\n    [ regex \"(osiem(set| setek))\"\n    ]\n  , prod = \\_ -> integer 800 >>= withGrain 2\n  }\n\nruleTwelve :: Rule\nruleTwelve = Rule\n  { name = \"twelve\"\n  , pattern =\n    [ regex \"dwunast(u|oma)|dwana(\u00c5\u203a|s)cie\"\n    ]\n  , prod = \\_ -> integer 12\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*\\\\.\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal True match\n      _ -> Nothing\n  }\n\nruleFifteen :: Rule\nruleFifteen = Rule\n  { name = \"fifteen\"\n  , pattern =\n    [ regex \"pi(\u00c4\u2122)tna(s|\u00c5\u203a)(ta|tu|cie|toma)\"\n    ]\n  , prod = \\_ -> integer 15\n  }\n\nruleEleven :: Rule\nruleEleven = Rule\n  { name = \"eleven\"\n  , pattern =\n    [ regex \"jedena(stu|(s|\u00c5\u203a)cie|stoma)\"\n    ]\n  , prod = \\_ -> integer 11\n  }\n\nruleThirteen :: Rule\nruleThirteen = Rule\n  { name = \"thirteen\"\n  , pattern =\n    [ regex \"trzyna(\u00c5\u203a|s)(tu|cie|toma)\"\n    ]\n  , prod = \\_ -> integer 13\n  }\n\nruleThirty :: Rule\nruleThirty = Rule\n  { name = \"thirty\"\n  , pattern =\n    [ regex \"trzydzie(\u00c5\u203a)ci|trzydziest(u|oma)\"\n    ]\n  , prod = \\_ -> integer 30\n  }\n\nruleNumeral2 :: Rule\nruleNumeral2 = Rule\n  { name = \"number 200\"\n  , pattern =\n    [ regex \"dwie((\u00c5\u203a)cie| setki)\"\n    ]\n  , prod = \\_ -> integer 200 >>= withGrain 2\n  }\n\nruleSeventeen :: Rule\nruleSeventeen = Rule\n  { name = \"seventeen\"\n  , pattern =\n    [ regex \"siedemna(s|\u00c5\u203a)(tu|cie|toma)\"\n    ]\n  , prod = \\_ -> integer 17\n  }\n\nruleNumeral :: Rule\nruleNumeral = Rule\n  { name = \"number 100\"\n  , pattern =\n    [ regex \"(sto|setki)\"\n    ]\n  , prod = \\_ -> integer 100 >>= withGrain 2\n  }\n\nruleNumeral9 :: Rule\nruleNumeral9 = Rule\n  { name = \"number 900\"\n  , pattern =\n    [ regex \"dziewi(\u00c4\u2122\u00c4\u2021)(set| setek)\"\n    ]\n  , prod = \\_ -> integer 900 >>= withGrain 2\n  }\n\nruleSingle :: Rule\nruleSingle = Rule\n  { name = \"single\"\n  , pattern =\n    [ regex \"pojedynczy\"\n    ]\n  , prod = \\_ -> integer 1\n  }\n\nruleTwenty :: Rule\nruleTwenty = Rule\n  { name = \"twenty\"\n  , pattern =\n    [ regex \"dwadzie(\u00c5\u203a|s)cia|dwudziest(u|oma)\"\n    ]\n  , prod = \\_ -> integer 20\n  }\n\nruleAFew :: Rule\nruleAFew = Rule\n  { name = \"a few\"\n  , pattern =\n    [ regex \"kilk(a|u)\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleEight :: Rule\nruleEight = Rule\n  { name = \"eight\"\n  , pattern =\n    [ regex \"o(s|\u00c5\u203a)(iem|miu|mioma)\"\n    ]\n  , prod = \\_ -> integer 8\n  }\n\nruleNumeral5 :: Rule\nruleNumeral5 = Rule\n  { name = \"number 500\"\n  , pattern =\n    [ regex \"pi(\u00c4\u2122\u00c4\u2021)(set| setek)\"\n    ]\n  , prod = \\_ -> integer 500 >>= withGrain 2\n  }\n\nruleNumeral3 :: Rule\nruleNumeral3 = Rule\n  { name = \"number 300\"\n  , pattern =\n    [ regex \"(trzy(sta| setki))\"\n    ]\n  , prod = \\_ -> integer 300 >>= withGrain 2\n  }\n\nruleZero :: Rule\nruleZero = Rule\n  { name = \"zero\"\n  , pattern =\n    [ regex \"(zero|nic)\"\n    ]\n  , prod = \\_ -> integer 0\n  }\n\nruleThousand :: Rule\nruleThousand = Rule\n  { name = \"thousand\"\n  , pattern =\n    [ regex \"ty(s|\u00c5\u203a)i(a|\u00c4\u2026|\u00c4\u2122)c(e|y)?\"\n    ]\n  , prod = \\_ -> integer 1000 >>= withGrain 3 >>= withMultipliable\n  }\n\nruleMillion :: Rule\nruleMillion = Rule\n  { name = \"million\"\n  , pattern =\n    [ regex \"milion(y|(\u00c3\u00b3)w)?\"\n    ]\n  , prod = \\_ -> integer 1000000 >>= withGrain 6 >>= withMultipliable\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleThree :: Rule\nruleThree = Rule\n  { name = \"three\"\n  , pattern =\n    [ regex \"trz(y|ema|ech)\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleFour :: Rule\nruleFour = Rule\n  { name = \"four\"\n  , pattern =\n    [ regex \"czter(ej|y|ech|em|ema)\"\n    ]\n  , prod = \\_ -> integer 4\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\nruleNumeral7 :: Rule\nruleNumeral7 = Rule\n  { name = \"number 700\"\n  , pattern =\n    [ regex \"(siedem(set| setek))\"\n    ]\n  , prod = \\_ -> integer 700 >>= withGrain 2\n  }\n\nruleAPair :: Rule\nruleAPair = Rule\n  { name = \"a pair\"\n  , pattern =\n    [ regex \"para?\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleCouple :: Rule\nruleCouple = Rule\n  { name = \"couple\"\n  , pattern =\n    [ regex \"pare\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleSix :: Rule\nruleSix = Rule\n  { name = \"six\"\n  , pattern =\n    [ regex \"sze(s|\u00c5\u203a)(c|\u00c4\u2021)(iu|oma|u)?\"\n    ]\n  , prod = \\_ -> integer 6\n  }\n\nruleNumeral6 :: Rule\nruleNumeral6 = Rule\n  { name = \"number 600\"\n  , pattern =\n    [ regex \"(sze\u00c5\u203a\u00c4\u2021(set| setek))\"\n    ]\n  , prod = \\_ -> integer 600 >>= withGrain 2\n  }\n\nruleNumeral4 :: Rule\nruleNumeral4 = Rule\n  { name = \"number 400\"\n  , pattern =\n    [ regex \"(cztery(sta| setki))\"\n    ]\n  , prod = \\_ -> integer 400 >>= withGrain 2\n  }\n\nruleFive :: Rule\nruleFive = Rule\n  { name = \"five\"\n  , pattern =\n    [ regex \"pi(e|\u00c4\u2122)(c|\u00c4\u2021)(iu|oma|u)?\"\n    ]\n  , prod = \\_ -> integer 5\n  }\n\nruleFourty :: Rule\nruleFourty = Rule\n  { name = \"fou?rty\"\n  , pattern =\n    [ regex \"czterdzie(\u00c5\u203a)ci|czterdziest(u|oma)\"\n    ]\n  , prod = \\_ -> integer 40\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"tuzin\"\n    ]\n  , prod = \\_ -> integer 12 >>= withMultipliable\n  }\n\nruleSeven :: Rule\nruleSeven = Rule\n  { name = \"seven\"\n  , pattern =\n    [ regex \"sied(miu|em|mioma)\"\n    ]\n  , prod = \\_ -> integer 7\n  }\n\nruleNineteen :: Rule\nruleNineteen = Rule\n  { name = \"nineteen\"\n  , pattern =\n    [ regex \"dziewietna(s|\u00c5\u203a)(tu|cie|toma)\"\n    ]\n  , prod = \\_ -> integer 19\n  }\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [20, 30 .. 90]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleEighteen :: Rule\nruleEighteen = Rule\n  { name = \"eighteen\"\n  , pattern =\n    [ regex \"osiemna(s|\u00c5\u203a)(tu|cie|toma)\"\n    ]\n  , prod = \\_ -> integer 18\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"dot|point\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral nd1:_:Token Numeral nd2:_) ->\n        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator ,\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(,\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \",\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nruleFifty :: Rule\nruleFifty = Rule\n  { name = \"fifty\"\n  , pattern =\n    [ regex \"pi(\u00c4\u2122\u00c4\u2021)dziesi(\u00c4\u2026)t|pi(\u00c4\u2122\u00c4\u2021)dziesi(\u00c4\u2122)ci(u|oma)\"\n    ]\n  , prod = \\_ -> integer 50\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAFew\n  , ruleAPair\n  , ruleCouple\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleEight\n  , ruleEighteen\n  , ruleEighty\n  , ruleEleven\n  , ruleFifteen\n  , ruleFifty\n  , ruleFive\n  , ruleFour\n  , ruleFourteen\n  , ruleFourty\n  , ruleInteger2\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleIntersectWithAnd\n  , ruleMillion\n  , ruleMultiply\n  , ruleNine\n  , ruleNineteen\n  , ruleNinety\n  , ruleNumeral\n  , ruleNumeral2\n  , ruleNumeral3\n  , ruleNumeral4\n  , ruleNumeral5\n  , ruleNumeral6\n  , ruleNumeral7\n  , ruleNumeral8\n  , ruleNumeral9\n  , ruleNumeralDotNumeral\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , ruleOne\n  , ruleSeven\n  , ruleSeventeen\n  , ruleSeventy\n  , ruleSingle\n  , ruleSix\n  , ruleSixteen\n  , ruleSixty\n  , ruleSpecialCompositionForMissingHundredsLikeInOneTwentyTwo\n  , ruleTen\n  , ruleThirteen\n  , ruleThirty\n  , ruleThousand\n  , ruleThree\n  , ruleTwelve\n  , ruleTwenty\n  , ruleTwo\n  , ruleZero\n  ]\n", "num_lines": 630}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.PT.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 1)\n             [ \"1\"\n             , \"um\"\n             , \"Uma\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"dois\"\n             , \"duas\"\n             , \"pares de\"\n             , \"um par de\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"3\"\n             , \"tr\u00c3\u00aas\"\n             , \"tres\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"6\"\n             , \"seis\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"11\"\n             , \"onze\"\n             ]\n  , examples (NumeralValue 12)\n             [ \"12\"\n             , \"doze\"\n             , \"uma d\u00c3\u00bazia\"\n             , \"uma duzia\"\n             , \"uma duzias de\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"Catorze\"\n             , \"quatorze\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"dezesseis\"\n             , \"dezasseis\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"dezessete\"\n             , \"dezassete\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"dezoito\"\n             ]\n  , examples (NumeralValue 19)\n             [ \"19\"\n             , \"dezenove\"\n             , \"dezanove\"\n             ]\n  , examples (NumeralValue 21)\n             [ \"21\"\n             , \"vinte e um\"\n             ]\n  , examples (NumeralValue 23)\n             [ \"23\"\n             , \"vinte e tres\"\n             , \"vinte e tr\u00c3\u00aas\"\n             ]\n  , examples (NumeralValue 24)\n             [ \"24\"\n             , \"vinte e quatro\"\n             , \"duas d\u00c3\u00bazias\"\n             , \"duas duzias\"\n             ]\n  , examples (NumeralValue 50)\n             [ \"50\"\n             , \"cinquenta\"\n             , \"cinq\u00c3\u00bcenta\"\n             , \"cincoenta\"\n             ]\n  , examples (NumeralValue 70)\n             [ \"setenta\"\n             ]\n  , examples (NumeralValue 78)\n             [ \"setenta e oito\"\n             ]\n  , examples (NumeralValue 80)\n             [ \"oitenta\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"trinta e tr\u00c3\u00aas\"\n             , \"trinta e tres\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             , \"ponto setenta e sete\"\n             ]\n  , examples (NumeralValue 1000)\n             [ \"mil\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"100.000,00\"\n             ]\n  , examples (NumeralValue 100)\n             [ \"100\"\n             , \"Cem\"\n             ]\n  , examples (NumeralValue 104)\n             [ \"104\"\n             , \"cento e quatro\"\n             ]\n  , examples (NumeralValue 243)\n             [ \"243\"\n             ,\"duzentos e quarenta e tres\"\n             ]\n  , examples (NumeralValue 300)\n             [ \"trezentos\"\n             ]\n  , examples (NumeralValue 343)\n             [ \"trezentos e quarenta e tres\"\n             , \"343\"\n             ]\n  , examples (NumeralValue 891)\n             [ \"oitocentos e noventa e um\"\n             , \"891\"\n             ]\n  , examples (NumeralValue 2200)\n             [ \"dois mil e duzentos\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"menos 1.200.000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             , \"negativo 1,2M\"\n             ]\n  , examples (NumeralValue 1.5)\n             [ \"1 ponto cinco\"\n             , \"um ponto cinco\"\n             , \"1,5\"\n             ]\n  , examples (NumeralValue 1200000.42)\n             [ \"1.200.000,42\"\n             ]\n  , examples (NumeralValue 0.2)\n             [ \"1/5\"\n             , \"2/10\"\n             , \"3/15\"\n             , \"20/100\"\n             ]\n  ]\n", "num_lines": 201}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Numeral.PT.Rules\n  ( rules\n  ) where\n\nimport Control.Applicative ((<|>))\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"a dozen of\"\n  , pattern =\n    [ regex \"(uma )?d(u|\u00c3\u00ba)zias?( de)?\"\n    ]\n  , prod = \\_ -> integer 12 >>= withMultipliable >>= notOkForAnyTime\n  }\n\nzeroNineteenMap :: HashMap Text Integer\nzeroNineteenMap = HashMap.fromList\n  [ ( \"zero\"        , 0 )\n  , ( \"um\"          , 1 )\n  , ( \"uma\"         , 1 )\n  , ( \"dois\"        , 2 )\n  , ( \"duas\"        , 2 )\n  , ( \"tres\"        , 3 )\n  , ( \"tr\u00c3\u00aas\"        , 3 )\n  , ( \"quatro\"      , 4 )\n  , ( \"cinco\"       , 5 )\n  , ( \"seis\"        , 6 )\n  , ( \"sete\"        , 7 )\n  , ( \"oito\"        , 8 )\n  , ( \"nove\"        , 9 )\n  , ( \"dez\"         , 10 )\n  , ( \"onze\"        , 11 )\n  , ( \"doze\"        , 12 )\n  , ( \"treze\"       , 13 )\n  , ( \"catorze\"     , 14 )\n  , ( \"quatorze\"    , 14 )\n  , ( \"quinze\"      , 15 )\n  , ( \"dezesseis\"   , 16 )\n  , ( \"dezasseis\"   , 16 )\n  , ( \"dezessete\"   , 17 )\n  , ( \"dezassete\"   , 17 )\n  , ( \"dezoito\"     , 18 )\n  , ( \"dezenove\"    , 19 )\n  , ( \"dezanove\"    , 19 )\n  ]\n\ninformalMap :: HashMap Text Integer\ninformalMap = HashMap.fromList\n  [ ( \"um par\"      , 2 )\n  , ( \"um par de\"   , 2 )\n  , ( \"par\"         , 2 )\n  , ( \"pares\"       , 2 )\n  , ( \"par de\"      , 2 )\n  , ( \"pares de\"    , 2 )\n  , ( \"um pouco\"    , 3 )\n  , ( \"pouco\"       , 3 )\n  ]\n\nruleToNineteen :: Rule\nruleToNineteen = Rule\n  { name = \"integer (0..19)\"\n  , pattern =\n    [ regex \"(zero|d(oi|ua)s|(uma? )?par(es)?( de)?|tr(e|\u00c3\u00aa)s|(um )?pouco|uma?|(c|qu)atorze|quatro|quinze|cinco|dez[ea]sseis|seis|dez[ea]ssete|sete|dezoito|oito|dez[ea]nove|nove|dez|onze|doze|treze)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        let x = Text.toLower match in\n        (HashMap.lookup x zeroNineteenMap >>= integer) <|>\n        (HashMap.lookup x informalMap >>= integer >>= notOkForAnyTime)\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"vinte\"     , 20 )\n  , ( \"trinta\"    , 30 )\n  , ( \"quarenta\"  , 40 )\n  , ( \"cincoenta\" , 50 )\n  , ( \"cinquenta\" , 50 )\n  , ( \"cinq\u00c3\u00bcenta\" , 50 )\n  , ( \"sessenta\"  , 60 )\n  , ( \"setenta\"   , 70 )\n  , ( \"oitenta\"   , 80 )\n  , ( \"noventa\"   , 90 )\n  ]\n\nruleTens :: Rule\nruleTens = Rule\n  { name = \"tens (20..90)\"\n  , pattern =\n    [ regex \"(vinte|trinta|quarenta|cin(co|q[u\u00c3\u00bc])enta|sessenta|setenta|oitenta|noventa)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\ncentsMap :: HashMap Text Integer\ncentsMap = HashMap.fromList\n  [ ( \"cem\"           , 100 )\n  , ( \"cento\"         , 100 )\n  , ( \"duzentos\"      , 200 )\n  , ( \"trezentos\"     , 300 )\n  , ( \"quatrocentos\"  , 400 )\n  , ( \"quinhetos\"     , 500 )\n  , ( \"seiscentos\"    , 600 )\n  , ( \"setecentos\"    , 700 )\n  , ( \"oitocentos\"    , 800 )\n  , ( \"novecentos\"    , 900 )\n  ]\n\nruleCent :: Rule\nruleCent = Rule\n  { name = \"hundreds (100..900)\"\n  , pattern =\n    [ regex \"(cem|cento|duzentos|trezentos|quatrocentos|quinhetos|seiscentos|setecentos|oitocentos|novecentos)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) centsMap >>= integer\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(milhao|milh\u00c3\u00a3o|milh\u00c3\u00b5es|milhoes|bilhao|bilh\u00c3\u00a3o|bilh\u00c3\u00b5es|bilhoes|mil)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"mil\"      -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"milhao\"   -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"milh\u00c3\u00a3o\"   -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"milh\u00c3\u00b5es\"  -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"milhoes\"  -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"bilhao\"   -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"bilh\u00c3\u00a3o\"   -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"bilh\u00c3\u00b5es\"  -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"bilhoes\"  -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        _          -> Nothing\n      _ -> Nothing\n  }\n\nruleCompositeTens :: Rule\nruleCompositeTens = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [20,30..90]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = tens}:\n       Token Numeral NumeralData{TNumeral.value = units}:\n       _) -> double $ tens + units\n      _ -> Nothing\n  }\n\nruleDecsAnd :: Rule\nruleDecsAnd = Rule\n  { name = \"number (21..29 31..39 .. 91..99)\"\n  , pattern =\n    [ oneOf [20, 30..90]\n    , regex \"e\"\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleCompositeCents :: Rule\nruleCompositeCents = Rule\n  { name = \"integer 101..999\"\n  , pattern =\n    [ oneOf [100, 200..900]\n    , Predicate $ numberBetween 1 100\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = hundreds}:\n       Token Numeral NumeralData{TNumeral.value = units}:\n       _) -> double $ hundreds + units\n      _ -> Nothing\n  }\n\nruleCentsAnd :: Rule\nruleCentsAnd = Rule\n  { name = \"number (101..199 201..299 .. 901..999)\"\n  , pattern =\n    [ oneOf [100, 200..900]\n    , regex \"e\"\n    , Predicate $ numberBetween 1 100\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleSkipHundreds :: Rule\nruleSkipHundreds = Rule\n  { name = \"one twenty two\"\n  , pattern =\n    [ Predicate $ numberBetween 1 10\n    , Predicate $ numberBetween 10 100\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = hundreds}:\n       Token Numeral NumeralData{TNumeral.value = rest}:\n       _) -> double $ hundreds*100 + rest\n      _ -> Nothing\n  }\n\nruleDotSpelledOut :: Rule\nruleDotSpelledOut = Rule\n  { name = \"one point 2\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"ponto\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral nd1:_:Token Numeral nd2:_) ->\n        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)\n      _ -> Nothing\n  }\n\nruleLeadingDotSpelledOut :: Rule\nruleLeadingDotSpelledOut = Rule\n  { name = \"point 77\"\n  , pattern =\n    [ regex \"ponto\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double . decimalsToDouble $ TNumeral.value nd\n      _ -> Nothing\n  }\n\nruleDecimals :: Rule\nruleDecimals = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*\\\\,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nruleCommas :: Rule\nruleCommas = Rule\n  { name = \"dot-separated numbers\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+(\\\\,\\\\d+)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDecimal False $ Text.replace \".\" Text.empty match\n      _ -> Nothing\n  }\n\nruleSuffixes :: Rule\nruleSuffixes = Rule\n  { name = \"suffixes (K,M,G))\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"(k|m|g)(?=[\\\\W$\u00e2\u201a\u00ac\u00c2\u00a2\u00c2\u00a3]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n        \"k\" -> double $ v * 1e3\n        \"m\" -> double $ v * 1e6\n        \"g\" -> double $ v * 1e9\n        _   -> Nothing\n      _ -> Nothing\n  }\n\nruleNegative :: Rule\nruleNegative = Rule\n  { name = \"negative numbers\"\n  , pattern =\n    [ regex \"(-|menos|negativo)(?!\\\\s*\\\\-)\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral nd:_) -> double $ TNumeral.value nd * (-1)\n      _ -> Nothing\n  }\n\nruleSum :: Rule\nruleSum = Rule\n  { name = \"intersect 2 numbers\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleSumAnd :: Rule\nruleSumAnd = Rule\n  { name = \"intersect 2 numbers (with and)\"\n  , pattern =\n    [ Predicate hasGrain\n    , regex \"e\"\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleToNineteen\n  , ruleTens\n  , ruleCent\n  , rulePowersOfTen\n  , ruleCompositeTens\n  , ruleCompositeCents\n  , ruleSkipHundreds\n  , ruleDotSpelledOut\n  , ruleLeadingDotSpelledOut\n  , ruleDecimals\n  , ruleCommas\n  , ruleSuffixes\n  , ruleNegative\n  , ruleSum\n  , ruleDecsAnd\n  , ruleCentsAnd\n  , ruleSumAnd\n  , ruleMultiply\n  , ruleDozen\n  ]\n", "num_lines": 388}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.RO.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext {locale = makeLocale RO Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"zero\"\n             , \"nici unul\"\n             , \"nici unu\"\n             , \"nici una\"\n             , \"nici o\"\n             , \"nicio\"\n             , \"nimic\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"unu\"\n             , \"unul\"\n             , \"un\"\n             , \"o\"\n             , \"intai\"\n             , \"\u00c3\u00aent\u00c3\u00a2i\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"doi\"\n             , \"doua\"\n             , \"dou\u00c4\u0192\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"3\"\n             , \"trei\"\n             ]\n  , examples (NumeralValue 4)\n             [ \"4\"\n             , \"patru\"\n             ]\n  , examples (NumeralValue 5)\n             [ \"5\"\n             , \"cinci\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"6\"\n             , \"sase\"\n             , \"\u00c8\u2122ase\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"7\"\n             , \"sapte\"\n             , \"\u00c8\u2122apte\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"8\"\n             , \"opt\"\n             ]\n  , examples (NumeralValue 9)\n             [ \"9\"\n             , \"noua\"\n             , \"nou\u00c4\u0192\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"10\"\n             , \"zece\"\n             , \"zeci\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"10\"\n             , \"zece\"\n             ]\n  , examples (NumeralValue 11)\n             [ \"11\"\n             , \"unsprezece\"\n             , \"unspe\"\n             , \"un\u00c8\u2122pe\"\n             ]\n  , examples (NumeralValue 19)\n             [ \"19\"\n             , \"nouasprezece\"\n             , \"nouaspe\"\n             , \"nou\u00c4\u0192sprezece\"\n             , \"nou\u00c4\u0192\u00c8\u2122pe\"\n             ]\n  , examples (NumeralValue 70)\n             [ \"70\"\n             , \"sapte zeci\"\n             , \"\u00c8\u2122apte zeci\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3000000\"\n             , \"3.000.000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"-1.200.000\"\n             , \"-1200000\"\n             , \"minus 1.200.000\"\n             ]\n  , examples (NumeralValue (-3))\n             [ \"-3\"\n             , \"3 negativ\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 mii\"\n             , \"cinci mii\"\n             ]\n  , examples (NumeralValue 1000)\n             [ \"o mie\"\n             , \"1 mie\"\n             ]\n  , examples (NumeralValue 100)\n             [ \"o suta\"\n             , \"o sut\u00c4\u0192\"\n             , \"1 suta\"\n             , \"1 sut\u00c4\u0192\"\n             ]\n  , examples (NumeralValue 300)\n             [ \"3 sute\"\n             , \"trei sute\"\n             ]\n  , examples (NumeralValue 1000000)\n             [ \"un milion\"\n             , \"1 milion\"\n             ]\n  , examples (NumeralValue 7000000)\n             [ \"7 milioane\"\n             , \"sapte milioane\"\n             , \"\u00c8\u2122apte milioane\"\n             ]\n  , examples (NumeralValue 21000000)\n             [ \"21 de milioane\"\n             , \"douazeci si unu de milioane\"\n             ]\n  , examples (NumeralValue 1000000000)\n             [ \"un miliard\"\n             , \"1 miliard\"\n             ]\n  , examples (NumeralValue 9000000000)\n             [ \"9 miliarde\"\n             , \"noua miliarde\"\n             , \"nou\u00c4\u0192 miliarde\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"douazeci\"\n             , \"doua zeci\"\n             , \"dou\u00c4\u0192zeci\"\n             , \"dou\u00c4\u0192 zeci\"\n             ]\n  , examples (NumeralValue 23)\n             [ \"23\"\n             , \"20 3\"\n             , \"douazeci 3\"\n             , \"dou\u00c4\u0192zeci 3\"\n             , \"dou\u00c4\u0192zeci trei\"\n             , \"douazeci si trei\"\n             , \"dou\u00c4\u0192zeci \u00c8\u2122i trei\"\n             ]\n  ]\n", "num_lines": 200}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.RO.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralsPrefixWithOrMinus :: Rule\nruleNumeralsPrefixWithOrMinus = Rule\n  { name = \"numbers prefix with - or minus\"\n  , pattern =\n    [ regex \"-|minus\"\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (_:Token Numeral nd:_) -> double (TNumeral.value nd * (-1))\n      _ -> Nothing\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [20, 30 .. 90]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\case\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleMultiplyDe :: Rule\nruleMultiplyDe = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ numberWith TNumeral.value (>= 20)\n    , regex \"de\"\n    , Predicate isMultipliable\n    ]\n  , prod = \\case\n      (token1:_:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleIntersectCuI :: Rule\nruleIntersectCuI = Rule\n  { name = \"intersect (cu \u00c8\u2122i)\"\n  , pattern =\n    [ Predicate hasGrain\n    , regex \"[s\u00c8\u2122]i\"\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesWithNegativ :: Rule\nruleNumeralsSuffixesWithNegativ = Rule\n  { name = \"numbers suffixes with (negativ)\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"neg(ativ)?\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> double $ v * (-1)\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(sut(a|e|\u00c4\u0192)?|milio(n|ane)?|miliar(de?)?|mi[ei]?)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"suta\"      -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"sute\"      -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"sut\u00c4\u0192\" -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"mi\"        -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"mie\"       -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"mii\"       -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"milio\"     -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"milion\"    -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"milioane\"  -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"miliar\"    -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"miliard\"   -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        \"miliarde\"  -> double 1e9 >>= withGrain 9 >>= withMultipliable\n        _           -> Nothing\n      _ -> Nothing\n  }\n\nzeroTenMap :: HashMap Text Integer\nzeroTenMap = HashMap.fromList\n  [ (\"zero\", 0)\n  , (\"nimic\", 0)\n  , (\"nicio\", 0)\n  , (\"nici o\", 0)\n  , (\"nici una\", 0)\n  , (\"nici unu\", 0)\n  , (\"nici unul\", 0)\n  , (\"un\", 1)\n  , (\"una\", 1)\n  , (\"unu\", 1)\n  , (\"unul\", 1)\n  , (\"intai\", 1)\n  , (\"\u00c3\u00aentai\", 1)\n  , (\"int\u00c3\u00a2i\", 1)\n  , (\"\u00c3\u00aent\u00c3\u00a2i\", 1)\n  , (\"o\", 1)\n  , (\"doi\", 2)\n  , (\"doua\", 2)\n  , (\"dou\u00c4\u0192\", 2)\n  , (\"trei\", 3)\n  , (\"patru\", 4)\n  , (\"cinci\", 5)\n  , (\"sase\", 6)\n  , (\"\\537ase\", 6)\n  , (\"sapte\", 7)\n  , (\"\\537apte\", 7)\n  , (\"opt\", 8)\n  , (\"noua\", 9)\n  , (\"nou\u00c4\u0192\", 9)\n  , (\"zece\", 10)\n  , (\"zeci\", 10)\n  ]\n\nruleIntegerZeroTen :: Rule\nruleIntegerZeroTen = Rule\n  { name = \"integer (0..10)\"\n  , pattern =\n    [ regex \"(zero|nimic|nici(\\\\s?o|\\\\sun(a|ul?))|una|unul?|doi|dou(a|\u00c4\u0192)|trei|patru|cinci|(s|\u00c8\u2122)ase|(s|\u00c8\u2122)apte|opt|nou(a|\u00c4\u0192)|zec[ei]|(i|\u00c3\u00ae)nt(a|\u00c3\u00a2)i|un|o)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroTenMap >>= integer\n      _ -> Nothing\n  }\n\nelevenNineteenMap :: HashMap Text Integer\nelevenNineteenMap = HashMap.fromList\n  [ (\"un\", 11)\n  , (\"doi\", 12)\n  , (\"trei\", 13)\n  , (\"pai\", 14)\n  , (\"cin\", 15)\n  , (\"cinci\", 15)\n  , (\"sai\", 16)\n  , (\"\\537ai\", 16)\n  , (\"sapti\", 17)\n  , (\"\\537apti\", 17)\n  , (\"sapte\", 17)\n  , (\"\\537apte\", 17)\n  , (\"opti\", 18)\n  , (\"opt\", 18)\n  , (\"noua\", 19)\n  , (\"nou\u00c4\u0192\", 19)\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (11..19)\"\n  , pattern =\n    [ regex \"(cin|sapti|opti)(s|\u00c8\u2122)pe|(cinci|(s|\u00c8\u2122)apte|opt)sprezece|(un|doi|trei|pai|(s|\u00c8\u2122)ai|nou(a|\u00c4\u0192))((s|\u00c8\u2122)pe|sprezece)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (e1:_:e2:_:r:_)):_) -> do\n        match <- case () of\n          _ | not $ Text.null e1 -> Just e1\n            | not $ Text.null e2 -> Just e2\n            | not $ Text.null r  -> Just r\n            | otherwise          -> Nothing\n        HashMap.lookup (Text.toLower match) elevenNineteenMap >>= integer\n      _ -> Nothing\n  }\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"(dou[a\u00c4\u0192]|trei|patru|cinci|[s\u00c8\u2122]ai|[s\u00c8\u2122]apte|opt|nou[a\u00c4\u0192])\\\\s?zeci\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        unit <- HashMap.lookup (Text.toLower match) zeroTenMap\n        integer (unit * 10) >>= withGrain 2 >>= withMultipliable\n      _ -> Nothing\n  }\n\nruleIntegerCuSeparatorDeMiiDot :: Rule\nruleIntegerCuSeparatorDeMiiDot = Rule\n  { name = \"integer cu separator de mii dot\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleInteger\n  , ruleIntegerZeroTen\n  , ruleInteger2\n  , ruleInteger3\n  , ruleIntegerCuSeparatorDeMiiDot\n  , ruleIntersect\n  , ruleIntersectCuI\n  , ruleMultiply\n  , ruleMultiplyDe\n  , ruleNumeralsPrefixWithOrMinus\n  , ruleNumeralsSuffixesWithNegativ\n  , rulePowersOfTen\n  ]\n", "num_lines": 300}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.SK.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus =\n  ( testContext {locale = makeLocale SK Nothing}\n  , testOptions\n  , allExamples\n  )\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"nula\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"jeden\"\n             , \"jedna\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"dva\"\n             , \"dve\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"7\"\n             , \"sedem\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"\u00c5\u00a1trn\u00c3\u00a1s\u00c5\u00a5\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"\u00c5\u00a1estn\u00c3\u00a1s\u00c5\u00a5\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"sedemn\u00c3\u00a1s\u00c5\u00a5\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"osemn\u00c3\u00a1s\u00c5\u00a5\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"dvadsa\u00c5\u00a5\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"m\u00c3\u00adnus 1.200.000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 tis\u00c3\u00adc\"\n             , \"p\u00c3\u00a4\u00c5\u00a5 tis\u00c3\u00adc\"\n             ]\n  ]\n", "num_lines": 111}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.SK.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleIntersectWithAnd :: Rule\nruleIntersectWithAnd = Rule\n  { name = \"intersect (with and)\"\n  , pattern =\n    [ Predicate hasGrain\n    , regex \"a\"\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|m\u00c3\u00adnus|z\u00c3\u00a1porn\u00c3\u00a9\"\n    , Predicate isPositive\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> double $ v * (-1)\n      _ -> Nothing\n  }\n\nruleFew :: Rule\nruleFew = Rule\n  { name = \"few\"\n  , pattern =\n    [ regex \"(zo)?p\u00c3\u00a1r\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+\\\\,\\\\d+)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nruleIntegerCompositeTens :: Rule\nruleIntegerCompositeTens = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [20, 30..90]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = tens}:\n       Token Numeral NumeralData{TNumeral.value = units}:\n       _) -> double $ tens + units\n      _ -> Nothing\n  }\n\nruleSingle :: Rule\nruleSingle = Rule\n  { name = \"single\"\n  , pattern =\n    [ regex \"jed(en|no|na)\"\n    ]\n  , prod = \\_ -> integer 1 >>= withGrain 1\n  }\n\nruleSum :: Rule\nruleSum = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\case\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(sto(vky)?|tis\u00c3\u00adce?|mili\u00c3\u00b3ny?)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"sto\"     -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"stovky\"  -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"tis\u00c3\u00adc\"   -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"tis\u00c3\u00adce\"  -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"mili\u00c3\u00b3n\"  -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"mili\u00c3\u00b3ny\" -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        _         -> Nothing\n      _ -> Nothing\n  }\n\nruleCouple :: Rule\nruleCouple = Rule\n  { name = \"couple, a pair\"\n  , pattern =\n    [ regex \"p\u00c3\u00a1ry?\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"tucet\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1 >>= withMultipliable\n  }\n\nzeroToNineteenMap :: HashMap Text Integer\nzeroToNineteenMap = HashMap.fromList\n  [ ( \"nula\"    , 0 )\n  , ( \"jeden\"   , 1 )\n  , ( \"jedna\"   , 1 )\n  , ( \"jedno\"   , 1 )\n  , ( \"dva\"     , 2 )\n  , ( \"dve\"     , 2 )\n  , ( \"tri\"     , 3 )\n  , ( \"\u00c5\u00a1tyri\"   , 4 )\n  , ( \"p\u00c3\u00a4\u00c5\u00a5\"     , 5 )\n  , ( \"\u00c5\u00a1es\u00c5\u00a5\"    , 6 )\n  , ( \"sedem\"   , 7 )\n  , ( \"osem\"    , 8 )\n  , ( \"dev\u00c3\u00a4\u00c5\u00a5\"   , 9 )\n  , ( \"desa\u00c5\u00a5\"   , 10 )\n  , ( \"jeden\u00c3\u00a1s\u00c5\u00a5\", 11 )\n  , ( \"dvan\u00c3\u00a1s\u00c5\u00a5\" , 12 )\n  , ( \"trin\u00c3\u00a1s\u00c5\u00a5\" , 13 )\n  , ( \"\u00c5\u00a1trn\u00c3\u00a1s\u00c5\u00a5\" , 14 )\n  , ( \"p\u00c3\u00a4tn\u00c3\u00a1s\u00c5\u00a5\" , 15 )\n  , ( \"\u00c5\u00a1estn\u00c3\u00a1s\u00c5\u00a5\", 16 )\n  , ( \"sedemn\u00c3\u00a1s\u00c5\u00a5\", 17 )\n  , ( \"osemn\u00c3\u00a1s\u00c5\u00a5\" , 18 )\n  , ( \"dev\u00c3\u00a4tn\u00c3\u00a1s\u00c5\u00a5\", 19 )\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..19)\"\n  -- e.g. jeden\u00c3\u00a1s\u00c5\u00a5 must be before jeden, otherwise jeden will always shadow jeden\u00c3\u00a1s\u00c5\u00a5\n  , pattern =\n    [ regex \"(nula|jed(en\u00c3\u00a1s\u00c5\u00a5|en|na|no)|dv(an\u00c3\u00a1s\u00c5\u00a5|a|e)|trin\u00c3\u00a1s\u00c5\u00a5|tri|\u00c5\u00a1trn\u00c3\u00a1s\u00c5\u00a5|\u00c5\u00a1tyri|p\u00c3\u00a4tn\u00c3\u00a1s\u00c5\u00a5|p\u00c3\u00a4\u00c5\u00a5|\u00c5\u00a1estn\u00c3\u00a1s\u00c5\u00a5|\u00c5\u00a1es\u00c5\u00a5|sedemn\u00c3\u00a1s\u00c5\u00a5|sedem|osemn\u00c3\u00a1s\u00c5\u00a5|osem|dev\u00c3\u00a4tn\u00c3\u00a1s\u00c5\u00a5|dev\u00c3\u00a4\u00c5\u00a5|desa\u00c5\u00a5)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroToNineteenMap >>= integer\n      _ -> Nothing\n  }\n\ndozenMap :: HashMap Text Integer\ndozenMap = HashMap.fromList\n  [ ( \"dvadsa\u00c5\u00a5\"        , 20)\n  , ( \"tridsa\u00c5\u00a5\"        , 30)\n  , ( \"\u00c5\u00a1tyridsa\u00c5\u00a5\"      , 40)\n  , ( \"p\u00c3\u00a4\u00c5\u00a5desiat\"      , 50)\n  , ( \"\u00c5\u00a1es\u00c5\u00a5desiat\"     , 60)\n  , ( \"sedemdesiat\"    , 70)\n  , ( \"osemdesiat\"     , 80)\n  , ( \"dev\u00c3\u00a4tdesiat\"    , 90)\n  ]\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"((dva|tri|\u00c5\u00a1tyri)dsa\u00c5\u00a5|(p\u00c3\u00a4\u00c5\u00a5|\u00c5\u00a1es\u00c5\u00a5|sedem|osem|dev\u00c3\u00a4t)desiat)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) dozenMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"cel\u00c3\u00a1|cel\u00c3\u00bdch|cel\u00c3\u00a9\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\case\n      (Token Numeral nd1:_:Token Numeral nd2:_) ->\n        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleCouple\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleFew\n  , ruleInteger\n  , ruleInteger2\n  , ruleIntegerCompositeTens\n  , ruleIntegerWithThousandsSeparator\n  , ruleSum\n  , ruleIntersectWithAnd\n  , ruleMultiply\n  , ruleNumeralDotNumeral\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleSingle\n  ]\n", "num_lines": 310}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.SV.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale SV Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"noll\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"en\"\n             , \"ett\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"tv\u00c3\u00a5\"\n             , \"ett par\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"7\"\n             , \"sju\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"Fjorton\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"sexton\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"sjutton\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"arton\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"20\"\n             , \"tjugo\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"minus 1.200.000\"\n             , \"negativ 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 tusen\"\n             , \"fem tusen\"\n             ]\n  ]\n", "num_lines": 106}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.SV.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleIntersectWithAnd :: Rule\nruleIntersectWithAnd = Rule\n  { name = \"intersect (with and)\"\n  , pattern =\n    [ Predicate hasGrain\n    , regex \"och\"\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|minus|negativ\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Numeral NumeralData{TNumeral.value = v}:\n       _) -> double $ v * (-1)\n      _ -> Nothing\n  }\n\nruleFew :: Rule\nruleFew = Rule\n  { name = \"few\"\n  , pattern =\n    [ regex \"(n\u00c3\u00a5gra )?f\u00c3\u00a5\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+\\\\,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> parseDecimal False match\n      _ -> Nothing\n  }\n\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer 21..99\"\n  , pattern =\n    [ oneOf [70, 20, 60, 50, 40, 90, 30, 80]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleSingle :: Rule\nruleSingle = Rule\n  { name = \"single\"\n  , pattern =\n    [ regex \"enkel\"\n    ]\n  , prod = \\_ -> integer 1 >>= withGrain 1\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:token2:_) -> multiply token1 token2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmg])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"k\" -> double $ v * 1e3\n         \"m\" -> double $ v * 1e6\n         \"g\" -> double $ v * 1e9\n         _   -> Nothing\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(hundra?|tusen?|miljon(er)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"hundr\"    -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"hundra\"   -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"tuse\"     -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"tusen\"    -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"miljon\"   -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        \"miljoner\" -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        _          -> Nothing\n      _ -> Nothing\n  }\n\nruleCouple :: Rule\nruleCouple = Rule\n  { name = \"couple, a pair\"\n  , pattern =\n    [ regex \"ett par\"\n    ]\n  , prod = \\_ -> integer 2\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"dussin\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1 >>= withMultipliable\n  }\n\nzeroToNineteenMap :: HashMap Text Integer\nzeroToNineteenMap = HashMap.fromList\n  [ ( \"inget\"    , 0 )\n  , ( \"ingen\"    , 0 )\n  , ( \"noll\"     , 0 )\n  , ( \"en\"       , 1 )\n  , ( \"ett\"      , 1 )\n  , ( \"tv\u00c3\u00a5\" , 2 )\n  , ( \"tre\"      , 3 )\n  , ( \"fyra\"     , 4 )\n  , ( \"fem\"      , 5 )\n  , ( \"sex\"      , 6 )\n  , ( \"sju\"      , 7 )\n  , ( \"\u00c3\u00a5tta\", 8 )\n  , ( \"nio\"      , 9 )\n  , ( \"tio\"      , 10 )\n  , ( \"elva\"     , 11 )\n  , ( \"tolv\"     , 12 )\n  , ( \"tretton\"  , 13 )\n  , ( \"fjorton\"  , 14 )\n  , ( \"femton\"   , 15 )\n  , ( \"sexton\"   , 16 )\n  , ( \"sjutton\"  , 17 )\n  , ( \"arton\"    , 18 )\n  , ( \"nitton\"   , 19 )\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..19)\"\n  , pattern =\n    [ regex \"(inget|ingen|noll|en|ett|tv\u00c3\u00a5|tretton|tre|fyra|femton|fem|sexton|sex|sjutton|sju|\u00c3\u00a5tta|nio|tio|elva|tolv|fjorton|arton|nitton)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) zeroToNineteenMap >>= integer\n      _ -> Nothing\n  }\n\ndozenMap :: HashMap Text Integer\ndozenMap = HashMap.fromList\n  [ ( \"tjugo\"      , 20)\n  , ( \"trettio\"    , 30)\n  , ( \"fyrtio\"     , 40)\n  , ( \"femtio\"     , 50)\n  , ( \"sextio\"     , 60)\n  , ( \"sjuttio\"    , 70)\n  , ( \"\u00c3\u00a5ttio\" , 80)\n  , ( \"nittio\"     , 90)\n  ]\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer (20..90)\"\n  , pattern =\n    [ regex \"(tjugo|trettio|fyrtio|femtio|sextio|sjuttio|\u00c3\u00a5ttio|nittio)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) dozenMap >>= integer\n      _ -> Nothing\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"komma\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral nd1:_:Token Numeral nd2:_) ->\n        double $ TNumeral.value nd1 + decimalsToDouble (TNumeral.value nd2)\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleCouple\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleFew\n  , ruleInteger\n  , ruleInteger2\n  , ruleInteger3\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleIntersectWithAnd\n  , ruleMultiply\n  , ruleNumeralDotNumeral\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleSingle\n  ]\n", "num_lines": 307}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.SW.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale SW Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"sufuri\"\n             , \"zero\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"moja\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"mbili\"\n             ]\n  , examples (NumeralValue 3)\n             [ \"tatu\"\n             ]\n  , examples (NumeralValue 4)\n             [ \"nne\"\n             ]\n  , examples (NumeralValue 5)\n             [ \"tano\"\n             ]\n  , examples (NumeralValue 6)\n             [ \"sita\"\n             ]\n  , examples (NumeralValue 7)\n             [ \"saba\"\n             ]\n  , examples (NumeralValue 8)\n             [ \"nane\"\n             ]\n  , examples (NumeralValue 9)\n             [ \"tisa\"\n             ]\n  , examples (NumeralValue 10)\n             [ \"kumi\"\n             ]\n  , examples (NumeralValue 20)\n             [ \"ishirini\"\n             ]\n  , examples (NumeralValue 30)\n             [ \"thelathini\"\n             ]\n  , examples (NumeralValue 40)\n             [ \"arubaini\"\n             , \"arobaini\"\n             ]\n  , examples (NumeralValue 50)\n             [ \"hamsini\"\n             ]\n  , examples (NumeralValue 60)\n             [ \"sitini\"\n             ]\n  , examples (NumeralValue 70)\n             [ \"sabini\"\n             ]\n  , examples (NumeralValue 80)\n             [ \"themanini\"\n             ]\n  , examples (NumeralValue 90)\n             [ \"tisini\"\n             ]\n  ]\n", "num_lines": 87}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Numeral.SW.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralMap :: HashMap Text Integer\nruleNumeralMap = HashMap.fromList\n  [ ( \"sufuri\", 0 )\n  , ( \"zero\", 0 )\n  , ( \"moja\", 1 )\n  , ( \"mbili\", 2 )\n  , ( \"tatu\", 3 )\n  , ( \"nne\", 4 )\n  , ( \"tano\", 5)\n  , ( \"sita\", 6)\n  , ( \"saba\", 7)\n  , ( \"nane\", 8)\n  , ( \"tisa\", 9)\n  , ( \"kumi\", 10)\n  ]\n\nruleNumeral :: Rule\nruleNumeral = Rule\n  { name = \"number (0..10)\"\n  , pattern =\n    [ regex \"(sufuri|zero|moja|mbili|tatu|nne|tano|sita|saba|nane|tisa|kumi)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) ruleNumeralMap >>= integer\n      _ -> Nothing\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"ishirini\", 20 )\n  , ( \"thelathini\", 30 )\n  , ( \"arubaini\", 40 )\n  , ( \"arobaini\", 40 )\n  , ( \"hamsini\", 50 )\n  , ( \"sitini\", 60 )\n  , ( \"sabini\", 70 )\n  , ( \"themanini\", 80 )\n  , ( \"tisini\", 90 )\n  ]\n\nruleTens :: Rule\nruleTens = Rule\n  { name = \"integer (20,30..90)\"\n  , pattern =\n    [ regex \"(ishirini|thelathini|arubaini|arobaini|hamsini|sitini|sabini|themanini|tisini)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\n\nruleCompositeTens :: Rule\nruleCompositeTens = Rule\n  { name = \"integer 11..19 21..29 .. 91..99\"\n  , pattern = [oneOf [20,30..90]\n  , regex \"-?na-?\"\n  , Predicate $ numberBetween 1 10]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\n\nrules :: [Rule]\nrules =\n  [ ruleNumeral\n  , ruleTens\n  , ruleCompositeTens\n  ]\n", "num_lines": 105}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.TR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Numeral.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale TR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (NumeralValue 0)\n             [ \"0\"\n             , \"yok\"\n             , \"hi\u00c3\u00a7\"\n             , \"s\u00c4\u00b1f\u00c4\u00b1r\"\n             ]\n  , examples (NumeralValue 1)\n             [ \"1\"\n             , \"bir\"\n             , \"tek\"\n             , \"yek\"\n             ]\n  , examples (NumeralValue 2)\n             [ \"2\"\n             , \"iki\"\n             , \"\u00c3\u00a7ift\"\n             ]\n  , examples (NumeralValue 33)\n             [ \"33\"\n             , \"otuz\u00c3\u00bc\u00c3\u00a7\"\n             , \"otuz \u00c3\u00bc\u00c3\u00a7\"\n             , \"0033\"\n             ]\n  , examples (NumeralValue 14)\n             [ \"14\"\n             , \"ond\u00c3\u00b6rt\"\n             , \"on d\u00c3\u00b6rt\"\n             ]\n  , examples (NumeralValue 16)\n             [ \"16\"\n             , \"onalt\u00c4\u00b1\"\n             , \"on alt\u00c4\u00b1\"\n             ]\n  , examples (NumeralValue 17)\n             [ \"17\"\n             , \"onyedi\"\n             , \"on yedi\"\n             ]\n  , examples (NumeralValue 18)\n             [ \"18\"\n             , \"onsekiz\"\n             , \"on sekiz\"\n             ]\n  , examples (NumeralValue 1.1)\n             [ \"1,1\"\n             , \"1,10\"\n             , \"01,10\"\n             , \"bir virg\u00c3\u00bcl bir\"\n             , \"bir nokta bir\"\n             ]\n  , examples (NumeralValue 0.77)\n             [ \"0,77\"\n             , \",77\"\n             , \"s\u00c4\u00b1f\u00c4\u00b1r virg\u00c3\u00bcl yetmi\u00c5\u0178yedi\"\n             , \"s\u00c4\u00b1f\u00c4\u00b1r virg\u00c3\u00bcl yetmi\u00c5\u0178 yedi\"\n             ]\n  , examples (NumeralValue 100000)\n             [ \"100.000\"\n             , \"100000\"\n             , \"100K\"\n             , \"100k\"\n             , \"100b\"\n             ]\n  , examples (NumeralValue 3000000)\n             [ \"3M\"\n             , \"3000K\"\n             , \"3000000\"\n             , \"3.000.000\"\n             ]\n  , examples (NumeralValue 1200000)\n             [ \"1.200.000\"\n             , \"1200000\"\n             , \"1,2M\"\n             , \"1200K\"\n             , \",0012G\"\n             , \"1200B\"\n             ]\n  , examples (NumeralValue (-1200000))\n             [ \"- 1.200.000\"\n             , \"-1200000\"\n             , \"eksi 1.200.000\"\n             , \"negatif 1200000\"\n             , \"-1,2M\"\n             , \"-1200K\"\n             , \"-,0012G\"\n             , \"-1200B\"\n             ]\n  , examples (NumeralValue 5000)\n             [ \"5 bin\"\n             , \"be\u00c5\u0178 bin\"\n             ]\n  , examples (NumeralValue 50)\n             [ \"5 deste\"\n             , \"be\u00c5\u0178 deste\"\n             ]\n  , examples (NumeralValue 200000)\n             [ \"iki y\u00c3\u00bcz bin\"\n             , \"ikiy\u00c3\u00bczbin\"\n             ]\n  , examples (NumeralValue 21011)\n             [ \"yirmi bir bin on bir\"\n             , \"yirmibir bin onbir\"\n             ]\n  , examples (NumeralValue 721012)\n             [ \"yedi y\u00c3\u00bcz yirmibir bin on iki\"\n             , \"yedi y\u00c3\u00bcz yirmi bir bin on iki\"\n             , \"yediy\u00c3\u00bcz yirmibir bin oniki\"\n             ]\n  , examples (NumeralValue 300341)\n             [ \"\u00c3\u00bc\u00c3\u00a7y\u00c3\u00bczbin \u00c3\u00bc\u00c3\u00a7y\u00c3\u00bcz k\u00c4\u00b1rkbir\"\n             , \"\u00c3\u00bc\u00c3\u00a7 y\u00c3\u00bcz bin \u00c3\u00bc\u00c3\u00a7 y\u00c3\u00bcz k\u00c4\u00b1rk bir\"\n             ]\n  , examples (NumeralValue 40348)\n             [ \"k\u00c4\u00b1rkbin \u00c3\u00bc\u00c3\u00a7y\u00c3\u00bcz k\u00c4\u00b1rksekiz\"\n             , \"k\u00c4\u00b1rk bin \u00c3\u00bc\u00c3\u00a7 y\u00c3\u00bcz k\u00c4\u00b1rk sekiz\"\n             ]\n  , examples (NumeralValue 31256721)\n             [ \"otuz bir milyon iki y\u00c3\u00bcz elli alt\u00c4\u00b1 bin yedi y\u00c3\u00bcz yirmi bir\"\n             ]\n  , examples (NumeralValue 107)\n             [ \"107\"\n             , \"y\u00c3\u00bcz yedi\"\n             ]\n  , examples (NumeralValue 5.5)\n             [ \"be\u00c5\u0178 bu\u00c3\u00a7uk\"\n             , \"be\u00c5\u0178bu\u00c3\u00a7uk\"\n             , \"5 bu\u00c3\u00a7uk\"\n             , \"5,5\"\n             ]\n  , examples (NumeralValue 3500000)\n             [ \"3,5 milyon\"\n             , \"3500000\"\n             , \"\u00c3\u00bc\u00c3\u00a7 bu\u00c3\u00a7uk milyon\"\n             , \"\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk milyon\"\n             , \"3,5M\"\n             ]\n  , examples (NumeralValue 0.5)\n             [ \"yar\u00c4\u00b1m\"\n             , \"0,5\"\n             ]\n  , examples (NumeralValue 2500)\n             [ \"2,5 bin\"\n             , \"2500\"\n             , \"iki bin be\u00c5\u0178 y\u00c3\u00bcz\"\n             , \"ikibin be\u00c5\u0178y\u00c3\u00bcz\"\n             ]\n  , examples (NumeralValue 2200000)\n             [ \"2,2 milyon\"\n             , \"iki nokta iki milyon\"\n             , \"iki virg\u00c3\u00bcl iki milyon\"\n             ]\n  , examples (NumeralValue 72.5)\n             [ \"yetmi\u00c5\u0178ikibu\u00c3\u00a7uk\"\n             , \"yetmi\u00c5\u0178iki bu\u00c3\u00a7uk\"\n             , \"yetmi\u00c5\u0178 iki bu\u00c3\u00a7uk\"\n             , \"72,5\"\n             ]\n  ]\n", "num_lines": 184}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.TR.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nhundredsMap :: HashMap Text Integer\nhundredsMap = HashMap.fromList\n  [ ( \"y\u00c3\u00bcz\", 100)\n  , ( \"ikiy\u00c3\u00bcz\", 200)\n  , ( \"\u00c3\u00bc\u00c3\u00a7y\u00c3\u00bcz\", 300)\n  , ( \"d\u00c3\u00b6rty\u00c3\u00bcz\", 400)\n  , ( \"be\u00c5\u0178y\u00c3\u00bcz\", 500)\n  , ( \"alt\u00c4\u00b1y\u00c3\u00bcz\", 600)\n  , ( \"yediy\u00c3\u00bcz\", 700)\n  , ( \"sekizy\u00c3\u00bcz\", 800)\n  , ( \"dokuzy\u00c3\u00bcz\", 900)\n  ]\n\n\nruleInteger5 :: Rule\nruleInteger5 = Rule\n  { name = \"integer 100..900\"\n  , pattern =\n    [ regex \"(y\u00c3\u00bcz|ikiy\u00c3\u00bcz|\u00c3\u00bc\u00c3\u00a7y\u00c3\u00bcz|d\u00c3\u00b6rty\u00c3\u00bcz|be\u00c5\u0178y\u00c3\u00bcz|alt\u00c4\u00b1y\u00c3\u00bcz|yediy\u00c3\u00bcz|sekizy\u00c3\u00bcz|dokuzy\u00c3\u00bcz)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) hundredsMap >>= integer >>= withGrain 2\n      _ -> Nothing\n  }\n\nruleNumeralsPrefixWithNegativeOrMinus :: Rule\nruleNumeralsPrefixWithNegativeOrMinus = Rule\n  { name = \"numbers prefix with -, negative or minus\"\n  , pattern =\n    [ regex \"-|eksi|negatif\"\n    , Predicate isPositive\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        double (v * (- 1))\n      _ -> Nothing\n  }\n\nruleACoupleOf :: Rule\nruleACoupleOf = Rule\n  { name = \"a couple (of)\"\n  , pattern =\n    [ regex \"(bir )?\u00c3\u00a7ift\"\n    ]\n  , prod = \\_ -> integer 2 >>= withGrain 1\n  }\n\nruleFew :: Rule\nruleFew = Rule\n  { name = \"few\"\n  , pattern =\n    [ regex \"(bir)?az\"\n    ]\n  , prod = \\_ -> integer 3\n  }\n\nruleTen :: Rule\nruleTen = Rule\n  { name = \"ten\"\n  , pattern =\n    [ regex \"on\"\n    ]\n  , prod = \\_ -> integer 10 >>= withGrain 1 >>= withMultipliable\n  }\n\nruleDecimalWithThousandsSeparator :: Rule\nruleDecimalWithThousandsSeparator = Rule\n  { name = \"decimal with thousands separator\"\n  , pattern =\n    [ regex \"(\\\\d+(\\\\.\\\\d\\\\d\\\\d)+,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       _) -> let fmt = Text.replace \",\" \".\" $ Text.replace \".\" Text.empty match\n        in parseDouble fmt >>= double\n      _ -> Nothing\n  }\n\nruleMultiply :: Rule\nruleMultiply = Rule\n  { name = \"compose by multiplication\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isMultipliable\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1}:\n       Token Numeral NumeralData{TNumeral.value = val2, TNumeral.grain = g2}:\n       _) | isNothing g2 || (isJust g2 && val2 > val1) -> case g2 of\n         Nothing -> double $ val1 * val2\n         Just g  -> double (val1 * val2) >>= withGrain g\n      _ -> Nothing\n  }\n\nruleDecimalNumeral :: Rule\nruleDecimalNumeral = Rule\n  { name = \"decimal number\"\n  , pattern =\n    [ regex \"(\\\\d*,\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDecimal False match\n      _ -> Nothing\n  }\n\nnumeralSuffixesHalfsuffixTextMap :: HashMap Text Double\nnumeralSuffixesHalfsuffixTextMap = HashMap.fromList\n  [ ( \"birbu\u00c3\u00a7uk\", 1.5)\n  , ( \"bibu\u00c3\u00a7uk\", 1.5)\n  , ( \"ikibu\u00c3\u00a7uk\", 2.5)\n  , ( \"\u00c3\u00bc\\231bu\u00c3\u00a7uk\", 3.5)\n  , ( \"d\u00c3\u00b6rtbu\u00c3\u00a7uk\", 4.5)\n  , ( \"be\\351bu\u00c3\u00a7uk\", 5.5)\n  , ( \"alt\u00c4\u00b1bu\u00c3\u00a7uk\", 6.5)\n  , ( \"yedibu\u00c3\u00a7uk\", 7.5)\n  , ( \"sekizbu\u00c3\u00a7uk\", 8.5)\n  , ( \"dokuzbu\u00c3\u00a7uk\", 9.5)\n  ]\n\nruleNumeralSuffixesHalfsuffixText :: Rule\nruleNumeralSuffixesHalfsuffixText = Rule\n  { name = \"number suffixes (half-suffix text) (1..9)\"\n  , pattern =\n    [ regex \"((bir?|iki|\u00c3\u00bc\u00c3\u00a7\u00c3\u00bc?|d\u00c3\u00b6rt|be\u00c5\u0178|alt\u00c4\u00b1|yedi|sekiz|dokuz)(bu\u00c3\u00a7uk))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) numeralSuffixesHalfsuffixTextMap >>= double\n      _ -> Nothing\n  }\n\ntenToNintynineMap :: HashMap Text Integer\ntenToNintynineMap = HashMap.fromList\n  [ ( \"onbi\", 11)\n  , ( \"onbir\", 11)\n  , ( \"oniki\", 12)\n  , ( \"on\u00c3\u00bc\u00c3\u00a7\", 13)\n  , ( \"ond\u00c3\u00b6rt\", 14)\n  , ( \"onbe\u00c5\u0178\", 15)\n  , ( \"onalt\u00c4\u00b1\", 16)\n  , ( \"onyedi\", 17)\n  , ( \"onsekiz\", 18)\n  , ( \"ondokuz\", 19)\n  , ( \"yirmibi\", 21)\n  , ( \"yirmibir\", 21)\n  , ( \"yirmiiki\", 22)\n  , ( \"yirmi\u00c3\u00bc\u00c3\u00a7\", 23)\n  , ( \"yirmid\u00c3\u00b6rt\", 24)\n  , ( \"yirmibe\u00c5\u0178\", 25)\n  , ( \"yirmialt\u00c4\u00b1\", 26)\n  , ( \"yirmiyedi\", 27)\n  , ( \"yirmisekiz\", 28)\n  , ( \"yirmidokuz\", 29)\n  , ( \"otuzbi\", 31)\n  , ( \"otuzbir\", 31)\n  , ( \"otuziki\", 32)\n  , ( \"otuz\u00c3\u00bc\u00c3\u00a7\", 33)\n  , ( \"otuzd\u00c3\u00b6rt\", 34)\n  , ( \"otuzbe\u00c5\u0178\", 35)\n  , ( \"otuzalt\u00c4\u00b1\", 36)\n  , ( \"otuzyedi\", 37)\n  , ( \"otuzsekiz\", 38)\n  , ( \"otuzdokuz\", 39)\n  , ( \"k\u00c4\u00b1rkbir\", 41)\n  , ( \"k\u00c4\u00b1rkbi\", 41)\n  , ( \"k\u00c4\u00b1rkiki\", 42)\n  , ( \"k\u00c4\u00b1rk\u00c3\u00bc\u00c3\u00a7\", 43)\n  , ( \"k\u00c4\u00b1rkd\u00c3\u00b6rt\", 44)\n  , ( \"k\u00c4\u00b1rkbe\u00c5\u0178\", 45)\n  , ( \"k\u00c4\u00b1rkalt\u00c4\u00b1\", 46)\n  , ( \"k\u00c4\u00b1rkyedi\", 47)\n  , ( \"k\u00c4\u00b1rksekiz\", 48)\n  , ( \"k\u00c4\u00b1rkdokuz\", 49)\n  , ( \"ellibi\", 51)\n  , ( \"ellibir\", 51)\n  , ( \"elliiki\", 52)\n  , ( \"elli\u00c3\u00bc\u00c3\u00a7\", 53)\n  , ( \"ellid\u00c3\u00b6rt\", 54)\n  , ( \"ellibe\u00c5\u0178\", 55)\n  , ( \"ellialt\u00c4\u00b1\", 56)\n  , ( \"elliyedi\", 57)\n  , ( \"ellisekiz\", 58)\n  , ( \"ellidokuz\", 59)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178bir\", 61)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178bir\", 61)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178iki\", 62)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178iki\", 62)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178\u00c3\u00bc\u00c3\u00a7\", 63)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178\u00c3\u00bc\u00c3\u00a7\", 63)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178d\u00c3\u00b6rt\", 64)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178d\u00c3\u00b6rt\", 64)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178be\u00c5\u0178\", 65)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178be\u00c5\u0178\", 65)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178alt\u00c4\u00b1\", 66)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178alt\u00c4\u00b1\", 66)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178yedi\", 67)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178yedi\", 67)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178sekiz\", 68)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178sekiz\", 68)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178dokuz\", 69)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178dokuz\", 69)\n  , ( \"yetmi\u00c5\u0178bir\", 71)\n  , ( \"yetmi\u00c5\u0178bi\", 71)\n  , ( \"yetmi\u00c5\u0178iki\", 72)\n  , ( \"yetmi\u00c5\u0178\u00c3\u00bc\u00c3\u00a7\", 73)\n  , ( \"yetmi\u00c5\u0178d\u00c3\u00b6rt\", 74)\n  , ( \"yetmi\u00c5\u0178be\u00c5\u0178\", 75)\n  , ( \"yetmi\u00c5\u0178alt\u00c4\u00b1\", 76)\n  , ( \"yetmi\u00c5\u0178yedi\", 77)\n  , ( \"yetmi\u00c5\u0178sekiz\", 78)\n  , ( \"yetmi\u00c5\u0178dokuz\", 79)\n  , ( \"seksenbir\", 81)\n  , ( \"seksenbi\", 81)\n  , ( \"sekseniki\", 82)\n  , ( \"seksen\u00c3\u00bc\u00c3\u00a7\", 83)\n  , ( \"seksend\u00c3\u00b6rt\", 84)\n  , ( \"seksenbe\u00c5\u0178\", 85)\n  , ( \"seksenalt\u00c4\u00b1\", 86)\n  , ( \"seksenyedi\", 87)\n  , ( \"seksensekiz\", 88)\n  , ( \"seksendokuz\", 89)\n  , ( \"doksanbi\", 91)\n  , ( \"doksanbir\", 91)\n  , ( \"doksaniki\", 92)\n  , ( \"doksan\u00c3\u00bc\u00c3\u00a7\", 93)\n  , ( \"doksand\u00c3\u00b6rt\", 94)\n  , ( \"doksanbe\u00c5\u0178\", 95)\n  , ( \"doksanalt\u00c4\u00b1\", 96)\n  , ( \"doksanyedi\", 97)\n  , ( \"doksansekiz\", 98)\n  , ( \"doksandokuz\", 99)\n  ]\n\nruleInteger3 :: Rule\nruleInteger3 = Rule\n  { name = \"integer 11..19 21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99\"\n  , pattern =\n    [ regex \"((on|yirmi|otuz|k\u00c4\u00b1rk|elli|atm\u00c4\u00b1\u00c5\u0178|altm\u00c4\u00b1\u00c5\u0178|yetmi\u00c5\u0178|seksen|doksan)(bir|bi|iki|\u00c3\u00bc\u00c3\u00a7|d\u00c3\u00b6rt|be\u00c5\u0178|alt\u00c4\u00b1|yedi|sekiz|dokuz))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tenToNintynineMap >>= integer\n      _ -> Nothing\n  }\n\n\nthousandsMap :: HashMap Text Integer\nthousandsMap = HashMap.fromList\n  [ ( \"bin\", 1000)\n  , ( \"ikibin\", 2000)\n  , ( \"\u00c3\u00bc\u00c3\u00a7bin\", 3000)\n  , ( \"d\u00c3\u00b6rtbin\", 4000)\n  , ( \"be\u00c5\u0178bin\", 5000)\n  , ( \"alt\u00c4\u00b1bin\", 6000)\n  , ( \"yedibin\", 7000)\n  , ( \"sekizbin\", 8000)\n  , ( \"dokuzbin\", 9000)\n  ]\n\nruleInteger6 :: Rule\nruleInteger6 = Rule\n  { name = \"integer 1000..9000\"\n  , pattern =\n    [ regex \"(bin|ikibin|\u00c3\u00bc\u00c3\u00a7bin|d\u00c3\u00b6rtbin|be\u00c5\u0178bin|alt\u00c4\u00b1bin|yedibin|sekizbin|dokuzbin)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) thousandsMap >>= integer >>= withGrain 3\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate hasGrain\n    , Predicate $ and . sequence [not . isMultipliable, isPositive]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:\n       Token Numeral NumeralData{TNumeral.value = val2}:\n       _) | (10 ** fromIntegral g) > val2 -> double $ val1 + val2\n      _ -> Nothing\n  }\n\nruleNumeralsSuffixesKMG :: Rule\nruleNumeralsSuffixesKMG = Rule\n  { name = \"numbers suffixes (K, M, G)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"([kmgb])(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n          \"k\" -> double $ v * 1e3\n          \"b\" -> double $ v * 1e3\n          \"m\" -> double $ v * 1e6\n          \"g\" -> double $ v * 1e9\n          _ -> Nothing\n      _ -> Nothing\n  }\n\nrulePowersOfTen :: Rule\nrulePowersOfTen = Rule\n  { name = \"powers of tens\"\n  , pattern =\n    [ regex \"(y(\u00c3\u00bc)z|bin|milyon)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"y\u00c3\u00bcz\" -> double 1e2 >>= withGrain 2 >>= withMultipliable\n        \"bin\"      -> double 1e3 >>= withGrain 3 >>= withMultipliable\n        \"milyon\"   -> double 1e6 >>= withGrain 6 >>= withMultipliable\n        _          -> Nothing\n      _ -> Nothing\n  }\n\ntenThousandsMap :: HashMap Text Integer\ntenThousandsMap = HashMap.fromList\n  [  ( \"onbin\", 10000)\n   , ( \"yirmibin\", 20000)\n   , ( \"otuzbin\", 30000)\n   , ( \"k\u00c4\u00b1rkbin\", 40000)\n   , ( \"ellibin\", 50000)\n   , ( \"altm\u00c4\u00b1\u00c5\u0178bin\", 60000)\n   , ( \"atm\u00c4\u00b1\u00c5\u0178bin\", 60000)\n   , ( \"yetmi\u00c5\u0178bin\", 70000)\n   , ( \"seksenbin\", 80000)\n   , ( \"doksanbin\", 90000)\n  ]\n\nruleInteger7 :: Rule\nruleInteger7 = Rule\n  { name = \"integer 10000..90000\"\n  , pattern =\n    [ regex \"(onbin|yirmibin|otuzbin|k\u00c4\u00b1rkbin|ellibin|atm\u00c4\u00b1\u00c5\u0178bin|altm\u00c4\u00b1\u00c5\u0178bin|yetmi\u00c5\u0178bin|seksenbin|doksanbin)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tenThousandsMap >>= integer >>= withGrain 4\n      _ -> Nothing\n  }\n\nhundredThousandsMap :: HashMap Text Integer\nhundredThousandsMap = HashMap.fromList\n  [ ( \"y\u00c3\u00bczbin\", 100000)\n  , ( \"ikiy\u00c3\u00bczbin\", 200000)\n  , ( \"\u00c3\u00bc\u00c3\u00a7y\u00c3\u00bczbin\", 300000)\n  , ( \"d\u00c3\u00b6rty\u00c3\u00bczbin\", 400000)\n  , ( \"be\u00c5\u0178y\u00c3\u00bczbin\", 500000)\n  , ( \"alt\u00c4\u00b1y\u00c3\u00bczbin\", 600000)\n  , ( \"yediy\u00c3\u00bczbin\", 700000)\n  , ( \"sekizy\u00c3\u00bczbin\", 800000)\n  , ( \"dokuzy\u00c3\u00bczbin\", 900000)\n  ]\n\nruleInteger8 :: Rule\nruleInteger8 = Rule\n  { name = \"integer 100000..900000\"\n  , pattern =\n    [ regex \"(y\u00c3\u00bczbin|ikiy\u00c3\u00bczbin|\u00c3\u00bc\u00c3\u00a7y\u00c3\u00bczbin|d\u00c3\u00b6rty\u00c3\u00bczbin|be\u00c5\u0178y\u00c3\u00bczbin|alt\u00c4\u00b1y\u00c3\u00bczbin|yediy\u00c3\u00bczbin|sekizy\u00c3\u00bczbin|dokuzy\u00c3\u00bczbin)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) hundredThousandsMap >>= integer >>= withGrain 5\n      _ -> Nothing\n  }\n\nruleHalf :: Rule\nruleHalf = Rule\n  { name = \"half\"\n  , pattern =\n    [ regex \"(yar\u00c4\u00b1m)\"\n    ]\n  , prod = \\_ -> double 0.5\n  }\n\ninteger9Map :: HashMap Text Double\ninteger9Map = HashMap.fromList\n  [ ( \"onbirbu\u00c3\u00a7uk\", 11.5)\n  , ( \"onbibu\u00c3\u00a7uk\", 11.5)\n  , ( \"onikibu\u00c3\u00a7uk\", 12.5)\n  , ( \"on\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 13.5)\n  , ( \"ond\u00c3\u00b6rtbu\u00c3\u00a7uk\", 14.5)\n  , ( \"onbe\u00c5\u0178bu\u00c3\u00a7uk\", 15.5)\n  , ( \"onalt\u00c4\u00b1bu\u00c3\u00a7uk\", 16.5)\n  , ( \"onyedibu\u00c3\u00a7uk\", 17.5)\n  , ( \"onsekizbu\u00c3\u00a7uk\", 18.5)\n  , ( \"ondokuzbu\u00c3\u00a7uk\", 19.5)\n  , ( \"yirmibibu\u00c3\u00a7uk\", 21.5)\n  , ( \"yirmibirbu\u00c3\u00a7uk\", 21.5)\n  , ( \"yirmiikibu\u00c3\u00a7uk\", 22.5)\n  , ( \"yirmi\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 23.5)\n  , ( \"yirmid\u00c3\u00b6rtbu\u00c3\u00a7uk\", 24.5)\n  , ( \"yirmibe\u00c5\u0178bu\u00c3\u00a7uk\", 25.5)\n  , ( \"yirmialt\u00c4\u00b1bu\u00c3\u00a7uk\", 26.5)\n  , ( \"yirmiyedibu\u00c3\u00a7uk\", 27.5)\n  , ( \"yirmisekizbu\u00c3\u00a7uk\", 28.5)\n  , ( \"yirmidokuzbu\u00c3\u00a7uk\", 29.5)\n  , ( \"otuzbibu\u00c3\u00a7uk\", 31.5)\n  , ( \"otuzbirbu\u00c3\u00a7uk\", 31.5)\n  , ( \"otuzikibu\u00c3\u00a7uk\", 32.5)\n  , ( \"otuz\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 33.5)\n  , ( \"otuzd\u00c3\u00b6rtbu\u00c3\u00a7uk\", 34.5)\n  , ( \"otuzbe\u00c5\u0178bu\u00c3\u00a7uk\", 35.5)\n  , ( \"otuzalt\u00c4\u00b1bu\u00c3\u00a7uk\", 36.5)\n  , ( \"otuzyedibu\u00c3\u00a7uk\", 37.5)\n  , ( \"otuzsekizbu\u00c3\u00a7uk\", 38.5)\n  , ( \"otuzdokuzbu\u00c3\u00a7uk\", 39.5)\n  , ( \"k\u00c4\u00b1rkbirbu\u00c3\u00a7uk\", 41.5)\n  , ( \"k\u00c4\u00b1rkbibu\u00c3\u00a7uk\", 41.5)\n  , ( \"k\u00c4\u00b1rkikibu\u00c3\u00a7uk\", 42.5)\n  , ( \"k\u00c4\u00b1rk\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 43.5)\n  , ( \"k\u00c4\u00b1rkd\u00c3\u00b6rtbu\u00c3\u00a7uk\", 44.5)\n  , ( \"k\u00c4\u00b1rkbe\u00c5\u0178bu\u00c3\u00a7uk\", 45.5)\n  , ( \"k\u00c4\u00b1rkalt\u00c4\u00b1bu\u00c3\u00a7uk\", 46.5)\n  , ( \"k\u00c4\u00b1rkyedibu\u00c3\u00a7uk\", 47.5)\n  , ( \"k\u00c4\u00b1rksekizbu\u00c3\u00a7uk\", 48.5)\n  , ( \"k\u00c4\u00b1rkdokuzbu\u00c3\u00a7uk\", 49.5)\n  , ( \"ellibibu\u00c3\u00a7uk\", 51.5)\n  , ( \"ellibirbu\u00c3\u00a7uk\", 51.5)\n  , ( \"elliikibu\u00c3\u00a7uk\", 52.5)\n  , ( \"elli\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 53.5)\n  , ( \"ellid\u00c3\u00b6rtbu\u00c3\u00a7uk\", 54.5)\n  , ( \"ellibe\u00c5\u0178bu\u00c3\u00a7uk\", 55.5)\n  , ( \"ellialt\u00c4\u00b1bu\u00c3\u00a7uk\", 56.5)\n  , ( \"elliyedibu\u00c3\u00a7uk\", 57.5)\n  , ( \"ellisekizbu\u00c3\u00a7uk\", 58.5)\n  , ( \"ellidokuzbu\u00c3\u00a7uk\", 59.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178birbu\u00c3\u00a7uk\", 61.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178birbu\u00c3\u00a7uk\", 61.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178ikibu\u00c3\u00a7uk\", 62.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178ikibu\u00c3\u00a7uk\", 62.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 63.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 63.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178d\u00c3\u00b6rtbu\u00c3\u00a7uk\", 64.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178d\u00c3\u00b6rtbu\u00c3\u00a7uk\", 64.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178be\u00c5\u0178bu\u00c3\u00a7uk\", 65.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178be\u00c5\u0178bu\u00c3\u00a7uk\", 65.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178alt\u00c4\u00b1bu\u00c3\u00a7uk\", 66.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178alt\u00c4\u00b1bu\u00c3\u00a7uk\", 66.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178yedibu\u00c3\u00a7uk\", 67.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178yedibu\u00c3\u00a7uk\", 67.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178sekizbu\u00c3\u00a7uk\", 68.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178sekizbu\u00c3\u00a7uk\", 68.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178dokuzbu\u00c3\u00a7uk\", 69.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178dokuzbu\u00c3\u00a7uk\", 69.5)\n  , ( \"yetmi\u00c5\u0178bibu\u00c3\u00a7uk\", 71.5)\n  , ( \"yetmi\u00c5\u0178birbu\u00c3\u00a7uk\", 71.5)\n  , ( \"yetmi\u00c5\u0178ikibu\u00c3\u00a7uk\", 72.5)\n  , ( \"yetmi\u00c5\u0178\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 73.5)\n  , ( \"yetmi\u00c5\u0178d\u00c3\u00b6rtbu\u00c3\u00a7uk\", 74.5)\n  , ( \"yetmi\u00c5\u0178be\u00c5\u0178bu\u00c3\u00a7uk\", 75.5)\n  , ( \"yetmi\u00c5\u0178alt\u00c4\u00b1bu\u00c3\u00a7uk\", 76.5)\n  , ( \"yetmi\u00c5\u0178yedibu\u00c3\u00a7uk\", 77.5)\n  , ( \"yetmi\u00c5\u0178sekizbu\u00c3\u00a7uk\", 78.5)\n  , ( \"yetmi\u00c5\u0178dokuzbu\u00c3\u00a7uk\", 79.5)\n  , ( \"seksenbibu\u00c3\u00a7uk\", 81.5)\n  , ( \"seksenbirbu\u00c3\u00a7uk\", 81.5)\n  , ( \"seksenikibu\u00c3\u00a7uk\", 82.5)\n  , ( \"seksen\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 83.5)\n  , ( \"seksend\u00c3\u00b6rtbu\u00c3\u00a7uk\", 84.5)\n  , ( \"seksenbe\u00c5\u0178bu\u00c3\u00a7uk\", 85.5)\n  , ( \"seksenalt\u00c4\u00b1bu\u00c3\u00a7uk\", 86.5)\n  , ( \"seksenyedibu\u00c3\u00a7uk\", 87.5)\n  , ( \"seksensekizbu\u00c3\u00a7uk\", 88.5)\n  , ( \"seksendokuzbu\u00c3\u00a7uk\", 89.5)\n  , ( \"doksanbirbu\u00c3\u00a7uk\", 91.5)\n  , ( \"doksanbibu\u00c3\u00a7uk\", 91.5)\n  , ( \"doksanikibu\u00c3\u00a7uk\", 92.5)\n  , ( \"doksan\u00c3\u00bc\u00c3\u00a7bu\u00c3\u00a7uk\", 93.5)\n  , ( \"doksand\u00c3\u00b6rtbu\u00c3\u00a7uk\", 94.5)\n  , ( \"doksanbe\u00c5\u0178bu\u00c3\u00a7uk\", 95.5)\n  , ( \"doksanalt\u00c4\u00b1bu\u00c3\u00a7uk\", 96.5)\n  , ( \"doksanyedibu\u00c3\u00a7uk\", 97.5)\n  , ( \"doksansekizbu\u00c3\u00a7uk\", 98.5)\n  , ( \"doksandokuzbu\u00c3\u00a7uk\", 99.5)\n  ]\n\nruleInteger9 :: Rule\nruleInteger9 = Rule\n  { name = \"integer 11..19 21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99\"\n  , pattern =\n    [ regex \"((on|yirmi|otuz|k\u00c4\u00b1rk|elli|atm\u00c4\u00b1\u00c5\u0178|altm\u00c4\u00b1\u00c5\u0178|yetmi\u00c5\u0178|seksen|doksan)(bir|bi|iki|\u00c3\u00bc\u00c3\u00a7\u00c3\u00bc?|d\u00c3\u00b6rt|be\u00c5\u0178|alt\u00c4\u00b1|yedi|sekiz|dokuz)(bu\u00c3\u00a7uk))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) integer9Map >>= double\n      _ -> Nothing\n  }\n\nruleDozen :: Rule\nruleDozen = Rule\n  { name = \"dozen\"\n  , pattern =\n    [ regex \"d\u00c3\u00bczine\"\n    ]\n  , prod = \\_ -> integer 12 >>= withGrain 1 >>= withMultipliable\n  }\n\noneToNineMap :: HashMap Text Integer\noneToNineMap = HashMap.fromList\n  [ ( \"s\\305f\\305r\", 0)\n  , ( \"yok\", 0)\n  , ( \"hi\u00c3\u00a7\", 0)\n  , ( \"bir\", 1)\n  , ( \"bi\", 1)\n  , ( \"yek\", 1)\n  , ( \"tek\", 1)\n  , ( \"iki\", 2)\n  , ( \"\u00c3\u00bc\u00c3\u00a7\", 3)\n  , ( \"\u00c3\u00bc\u00c3\u00a7\u00c3\u00bc\", 3)\n  , ( \"d\u00c3\u00b6rt\", 4)\n  , ( \"be\u00c5\u0178\", 5)\n  , ( \"alt\u00c4\u00b1\", 6)\n  , ( \"yedi\", 7)\n  , ( \"sekiz\", 8)\n  , ( \"dokuz\", 9)\n  ]\n\nruleInteger :: Rule\nruleInteger = Rule\n  { name = \"integer (0..9)\"\n  , pattern =\n    [ regex \"(yok|hi(\u00c3\u00a7)|s(\u00c4\u00b1)f(\u00c4\u00b1)r|bir?|[ty]ek|iki|(\u00c3\u00bc)(\u00c3\u00a7)(\u00c3\u00bc)?|d(\u00c3\u00b6)rt|be(\u00c5\u0178)|alt(\u00c4\u00b1)|yedi|sekiz|dokuz)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) oneToNineMap >>= integer\n      _ -> Nothing\n  }\n\nnumeralSuffixesHalfsuffixText2Map :: HashMap Text Double\nnumeralSuffixesHalfsuffixText2Map = HashMap.fromList\n  [ ( \"onbu\u00c3\u00a7uk\", 10.5)\n  , ( \"yirmibu\u00c3\u00a7uk\", 20.5)\n  , ( \"otuzbu\u00c3\u00a7uk\", 30.5)\n  , ( \"k\u00c4\u00b1rkbu\u00c3\u00a7uk\", 40.5)\n  , ( \"ellibu\u00c3\u00a7uk\", 50.5)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178bu\u00c3\u00a7uk\", 60.5)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178bu\u00c3\u00a7uk\", 60.5)\n  , ( \"yetmi\u00c5\u0178bu\u00c3\u00a7uk\", 70.5)\n  , ( \"seksenbu\u00c3\u00a7uk\", 80.5)\n  , ( \"doksanbu\u00c3\u00a7uk\", 90.5)\n  ]\n\nruleNumeralSuffixesHalfsuffixText2 :: Rule\nruleNumeralSuffixesHalfsuffixText2 = Rule\n  { name = \"number suffixes (half-suffix text) (10..90)\"\n  , pattern =\n    [ regex \"((on|yirmi|otuz|k\u00c4\u00b1rk|elli|atm\u00c4\u00b1\u00c5\u0178|altm\u00c4\u00b1\u00c5\u0178|yetmi\u00c5\u0178|seksen|doksan)(bu\u00c3\u00a7uk))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) numeralSuffixesHalfsuffixText2Map\n        >>= double\n      _ -> Nothing\n  }\n\nruleNumeralSuffixesHalfSuffix :: Rule\nruleNumeralSuffixesHalfSuffix = Rule\n  { name = \"number suffixes (half-suffix)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"(bu\u00c3\u00a7uk)(?=[\\\\W\\\\$\u00e2\u201a\u00ac]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) -> double $ v + 0.5\n      _ -> Nothing\n  }\n\nruleInteger4 :: Rule\nruleInteger4 = Rule\n  { name = \"integer 11..99\"\n  , pattern =\n    [ oneOf [70, 20, 60, 50, 40, 90, 30, 10, 80]\n    , Predicate $ numberBetween 1 10\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + v2\n      _ -> Nothing\n  }\n\nruleGroupOfTens :: Rule\nruleGroupOfTens = Rule\n  { name = \"group of ten(s)\"\n  , pattern =\n    [ regex \"deste\"\n    ]\n  , prod = \\_ -> integer 10 >>= withGrain 1 >>= withMultipliable\n  }\n\ntensMap :: HashMap Text Integer\ntensMap = HashMap.fromList\n  [ ( \"on\", 10)\n  , ( \"yirmi\", 20)\n  , ( \"otuz\", 30)\n  , ( \"k\u00c4\u00b1rk\", 40)\n  , ( \"elli\", 50)\n  , ( \"altm\u00c4\u00b1\u00c5\u0178\", 60)\n  , ( \"atm\u00c4\u00b1\u00c5\u0178\", 60)\n  , ( \"yetmi\u00c5\u0178\", 70)\n  , ( \"seksen\", 80)\n  , ( \"doksan\", 90)\n  ]\n\nruleInteger2 :: Rule\nruleInteger2 = Rule\n  { name = \"integer (10..90)\"\n  , pattern =\n    [ regex \"(on|yirmi|otuz|k\u00c4\u00b1rk|elli|atm\u00c4\u00b1\u00c5\u0178|altm\u00c4\u00b1\u00c5\u0178|yetmi\u00c5\u0178|seksen|doksan)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        HashMap.lookup (Text.toLower match) tensMap >>= integer\n      _ -> Nothing\n  }\n\nruleQuarter :: Rule\nruleQuarter = Rule\n  { name = \"quarter\"\n  , pattern =\n    [ regex \"(\u00c3\u00a7eyrek)\"\n    ]\n  , prod = \\_ -> double 0.25\n  }\n\nruleNumeralDotNumeral :: Rule\nruleNumeralDotNumeral = Rule\n  { name = \"number dot number\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"nokta|virg\u00c3\u00bcl\"\n    , Predicate $ not . hasGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v1}:\n       _:\n       Token Numeral NumeralData{TNumeral.value = v2}:\n       _) -> double $ v1 + decimalsToDouble v2\n      _ -> Nothing\n  }\n\nruleIntegerWithThousandsSeparator :: Rule\nruleIntegerWithThousandsSeparator = Rule\n  { name = \"integer with thousands separator .\"\n  , pattern =\n    [ regex \"(\\\\d{1,3}(\\\\.\\\\d\\\\d\\\\d){1,5})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        parseDouble (Text.replace \".\" Text.empty match) >>= double\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleACoupleOf\n  , ruleDecimalNumeral\n  , ruleDecimalWithThousandsSeparator\n  , ruleDozen\n  , ruleFew\n  , ruleGroupOfTens\n  , ruleHalf\n  , ruleInteger\n  , ruleInteger2\n  , ruleInteger3\n  , ruleInteger4\n  , ruleInteger5\n  , ruleInteger6\n  , ruleInteger7\n  , ruleInteger8\n  , ruleInteger9\n  , ruleIntegerWithThousandsSeparator\n  , ruleIntersect\n  , ruleNumeralDotNumeral\n  , ruleNumeralSuffixesHalfSuffix\n  , ruleNumeralSuffixesHalfsuffixText\n  , ruleNumeralSuffixesHalfsuffixText2\n  , ruleNumeralsPrefixWithNegativeOrMinus\n  , ruleNumeralsSuffixesKMG\n  , rulePowersOfTen\n  , ruleQuarter\n  , ruleTen\n  , ruleMultiply\n  ]\n", "num_lines": 722}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Ordinal.Helpers\n  ( ordinal\n  , oneOf\n  ) where\n\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.Types (OrdinalData (..))\nimport Duckling.Types\nimport qualified Duckling.Ordinal.Types as TOrdinal\n\n-- -----------------------------------------------------------------\n-- Patterns\n\noneOf :: [Int] -> PatternItem\noneOf vs = Predicate $ \\x ->\n  case x of\n    (Token Ordinal OrdinalData {TOrdinal.value = v}) -> elem v vs\n    _ -> False\n\n-- -----------------------------------------------------------------\n-- Production\n\nordinal :: Int -> Token\nordinal x = Token Ordinal OrdinalData {TOrdinal.value = x}\n", "num_lines": 36}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Ordinal.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\n\nimport Duckling.Resolve (Resolve(..))\n\nnewtype OrdinalData = OrdinalData { value :: Int }\n  deriving (Eq, Generic, Hashable, Show, Ord, NFData)\n\ninstance Resolve OrdinalData where\n  type ResolvedValue OrdinalData = OrdinalData\n  resolve _ _ x = Just (x, False)\n\ninstance ToJSON OrdinalData where\n  toJSON (OrdinalData value) = object\n    [ \"type\" .= (\"value\" :: Text)\n    , \"value\" .= value\n    ]\n\nisBetween :: Ord a => a -> a -> a -> Bool\nisBetween x low high = low <= x && x <= high\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.AR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale AR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00a7\u00d9\u02c6\u00d9\u201e\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00a3\u00d9\u02c6\u00d9\u201e\"\n             , \"\u00d8\u00a7\u00d9\u02c6\u00d9\u201e\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u2020\u00d9\u0160\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u2020\"\n             , \"\u00d8\u00ab\u00d8\u00a7\u00d9\u2020\u00d9\u0160\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\"\n             , \"\u00d8\u00ab\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\"\n             ]\n  , examples (OrdinalData 4)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00b1\u00d8\u00a7\u00d8\u00a8\u00d8\u00b9\"\n             , \"\u00d8\u00b1\u00d8\u00a7\u00d8\u00a8\u00d8\u00b9\"\n             ]\n  , examples (OrdinalData 8)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u2026\u00d9\u2020\"\n             , \"\u00d8\u00ab\u00d8\u00a7\u00d9\u2026\u00d9\u2020\"\n             ]\n  , examples (OrdinalData 11)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00a3\u00d8\u00ad\u00d8\u00af \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00a5\u00d8\u00ad\u00d8\u00af\u00d9\u2030 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d8\u00a9\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ad\u00d8\u00a7\u00d8\u00af\u00d9\u0160 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d8\u00a9\"\n             ]\n  , examples (OrdinalData 12)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u2020\u00d9\u0160 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d8\u00a9\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u2020 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00a7\u00d8\u00ab\u00d9\u2020\u00d9\u2030 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\"\n             ]\n  , examples (OrdinalData 13)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u201e\u00d8\u00ab \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a9 \u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d8\u00a9\"\n             ]\n  , examples (OrdinalData 21)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ad\u00d8\u00a7\u00d8\u00af\u00d9\u0160 \u00d9\u02c6\u00d8\u00a7\u00d9\u201e\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d9\u0160\u00d9\u2020\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d9\u02c6\u00d8\u00a7\u00d8\u00ad\u00d8\u00af \u00d9\u02c6 \u00d8\u00a7\u00d9\u201e\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d9\u02c6\u00d9\u2020\"\n             ]\n  , examples (OrdinalData 25)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ae\u00d8\u00a7\u00d9\u2026\u00d8\u00b3 \u00d9\u02c6\u00d8\u00a7\u00d9\u201e\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d9\u0160\u00d9\u2020\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ae\u00d8\u00a7\u00d9\u2026\u00d8\u00b3 \u00d9\u02c6 \u00d8\u00a7\u00d9\u201e\u00d8\u00b9\u00d8\u00b4\u00d8\u00b1\u00d9\u02c6\u00d9\u2020\"\n             ]\n  , examples (OrdinalData 31)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d9\u02c6\u00d8\u00a7\u00d8\u00ad\u00d8\u00af \u00d9\u02c6\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d9\u201e\u00d8\u00a7\u00d8\u00ab\u00d9\u02c6\u00d9\u2020\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d9\u02c6\u00d8\u00a7\u00d8\u00ad\u00d8\u00af \u00d9\u02c6\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d9\u201e\u00d8\u00a7\u00d8\u00ab\u00d9\u0160\u00d9\u2020\"\n             ]\n  , examples (OrdinalData 72)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u2020 \u00d9\u02c6\u00d8\u00a7\u00d9\u201e\u00d8\u00b3\u00d8\u00a8\u00d8\u00b9\u00d9\u02c6\u00d9\u2020\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00ab\u00d8\u00a7\u00d9\u2020\u00d9\u0160 \u00d9\u02c6\u00d8\u00a7\u00d9\u201e\u00d8\u00b3\u00d8\u00a8\u00d8\u00b9\u00d9\u0160\u00d9\u2020\"\n             ]\n  , examples (OrdinalData 90)\n             [ \"\u00d8\u00a7\u00d9\u201e\u00d8\u00aa\u00d8\u00b3\u00d8\u00b9\u00d9\u02c6\u00d9\u2020\"\n             , \"\u00d8\u00a7\u00d9\u201e\u00d8\u00aa\u00d8\u00b3\u00d8\u00b9\u00d9\u0160\u00d9\u2020\"\n             ]\n  ]\n", "num_lines": 84}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.CA.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale CA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"primer\"\n             , \"primera\"\n             , \"primers\"\n             , \"primeres\"\n             ]\n   , examples (OrdinalData 2)\n              [ \"segon\"\n              , \"segona\"\n              , \"segons\"\n              , \"segones\"\n              ]\n   , examples (OrdinalData 3)\n              [ \"tercer\"\n              , \"tercera\"\n              , \"tercers\"\n              , \"terceres\"\n              ]\n   , examples (OrdinalData 4)\n              [ \"quart\"\n              , \"quarta\"\n              , \"quarts\"\n              , \"quartes\"\n              ]\n   , examples (OrdinalData 5)\n              [ \"cinqu\u00c3\u00a8\"\n              , \"cinquena\"\n              , \"cinquens\"\n              , \"cinquenes\"\n              ]\n   , examples (OrdinalData 6)\n              [ \"sis\u00c3\u00a8\"\n              , \"sisena\"\n              , \"sisens\"\n              , \"sisenes\"\n              ]\n   , examples (OrdinalData 7)\n              [ \"set\u00c3\u00a8\"\n              , \"setena\"\n              , \"setens\"\n              , \"setenes\"\n              ]\n   , examples (OrdinalData 8)\n              [ \"vuit\u00c3\u00a8\"\n              , \"vuitena\"\n              , \"vuitens\"\n              , \"vuitenes\"\n              ]\n   , examples (OrdinalData 9)\n              [ \"nov\u00c3\u00a8\"\n              , \"novena\"\n              , \"novens\"\n              , \"novenes\"\n              ]\n   , examples (OrdinalData 10)\n              [ \"des\u00c3\u00a8\"\n              , \"desena\"\n              , \"desens\"\n              , \"desenes\"\n              ]\n    , examples (OrdinalData 11)\n              [ \"onz\u00c3\u00a8\"\n              , \"onzena\"\n              ]\n    , examples (OrdinalData 12)\n              [ \"dotz\u00c3\u00a8\"\n              , \"dotzena\"\n              ]\n    , examples (OrdinalData 13)\n              [ \"tretz\u00c3\u00a8\"\n              , \"tretzena\"\n              ]\n    , examples (OrdinalData 14)\n              [ \"catorz\u00c3\u00a8\"\n              , \"catorzena\"\n              ]\n    , examples (OrdinalData 15)\n              [ \"quinz\u00c3\u00a8\"\n              , \"quinzena\"\n              ]\n    , examples (OrdinalData 16)\n              [ \"setz\u00c3\u00a8\"\n              , \"setzena\"\n              ]\n    , examples (OrdinalData 17)\n              [ \"disset\u00c3\u00a8\"\n              , \"dissetena\"\n              ]\n    , examples (OrdinalData 18)\n              [ \"divuit\u00c3\u00a8\"\n              , \"divuitena\"\n              ]\n    , examples (OrdinalData 19)\n              [ \"dinov\u00c3\u00a8\"\n              , \"dinovena\"\n              ]\n    , examples (OrdinalData 20)\n              [ \"vint\u00c3\u00a8\"\n              , \"vintena\"\n              ]\n  ]\n", "num_lines": 127}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Duckling.Ordinal.CA.Rules\n  ( rules ) where\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinalsMap :: HashMap.HashMap Text.Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"primer\" , 1 )\n  , ( \"primers\" , 1 )\n  , ( \"primera\" , 1 )\n  , ( \"primeres\" , 1 )\n  , ( \"segon\" , 2 )\n  , ( \"segona\" , 2 )\n  , ( \"segones\" , 2 )\n  , ( \"segons\" , 2 )\n  , ( \"tercer\" , 3 )\n  , ( \"tercera\" , 3 )\n  , ( \"tercers\" , 3 )\n  , ( \"terceres\" , 3 )\n  , ( \"quart\" , 4 )\n  , ( \"quarta\" , 4 )\n  , ( \"quarts\" , 4 )\n  , ( \"quartes\" , 4 )\n  , ( \"cinqu\u00c3\u00a8\" , 5 )\n  , ( \"cinquena\" , 5 )\n  , ( \"cinquens\" , 5 )\n  , ( \"cinquenes\" , 5 )\n  , ( \"sis\u00c3\u00a8\" , 6 )\n  , ( \"sisena\" , 6 )\n  , ( \"sisens\" , 6 )\n  , ( \"sisenes\" , 6 )\n  , ( \"set\u00c3\u00a8\" , 7 )\n  , ( \"setena\" , 7 )\n  , ( \"setens\" , 7 )\n  , ( \"setenes\" , 7 )\n  , ( \"vuit\u00c3\u00a8\" , 8 )\n  , ( \"vuitena\" , 8 )\n  , ( \"vuitens\" , 8 )\n  , ( \"vuitenes\" , 8 )\n  , ( \"nov\u00c3\u00a8\" , 9 )\n  , ( \"novena\" , 9 )\n  , ( \"novens\" , 9 )\n  , ( \"novenes\" , 9 )\n  , ( \"des\u00c3\u00a8\" , 10 )\n  , ( \"desena\" , 10 )\n  , ( \"desens\" , 10 )\n  , ( \"desenes\" , 10 )\n  , ( \"onz\u00c3\u00a8\" , 11 )\n  , ( \"onzena\" , 11 )\n  , ( \"dotz\u00c3\u00a8\" , 12 )\n  , ( \"dotzena\" , 12 )\n  , ( \"tretz\u00c3\u00a8\" , 13 )\n  , ( \"tretzena\" , 13 )\n  , ( \"catorz\u00c3\u00a8\" , 14 )\n  , ( \"catorzena\" , 14 )\n  , ( \"quinz\u00c3\u00a8\" , 15 )\n  , ( \"quinzena\" , 15 )\n  , ( \"setz\u00c3\u00a8\" , 16 )\n  , ( \"setzena\" , 16 )\n  , ( \"disset\u00c3\u00a8\" , 17 )\n  , ( \"dissetena\" , 17 )\n  , ( \"divuit\u00c3\u00a8\" , 18 )\n  , ( \"divuitena\" , 18 )\n  , ( \"dinov\u00c3\u00a8\" , 19 )\n  , ( \"dinovena\" , 19 )\n  , ( \"vint\u00c3\u00a8\" , 20 )\n  , ( \"vintena\" , 20 )\n  ]\n\nruleOrdinalsPrimero :: Rule\nruleOrdinalsPrimero = Rule\n  { name = \"ordinals (primero..10)\"\n  , pattern =\n    [ regex \"(primer(a|s|es)?|segon(a|s|es)?|tercer(a|s|es)?|quart(a|s|es)?|cinqu(\u00c3\u00a8|(en(a|s|es)))|sis(\u00c3\u00a8|en(a|s|es))|set(\u00c3\u00a8|en(a|s|es))|vuit(\u00c3\u00a8|en(a|s|es))|nov(\u00c3\u00a8|en(a|s|es))|des(\u00c3\u00a8|en(a|s|es))|onz(\u00c3\u00a8|ena)|dotz(\u00c3\u00a8|ena)|tretz(\u00c3\u00a8|ena)|catorz(\u00c3\u00a8|ena)|quinz(\u00c3\u00a8|ena)|setz(\u00c3\u00a8|ena)|disset(\u00c3\u00a8|ena)|divuit(\u00c3\u00a8|ena)|dinov(\u00c3\u00a8|ena)|vint(\u00c3\u00a8|ena))\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalsPrimero\n  ]\n", "num_lines": 105}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.DA.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 4)\n             [ \"4.\"\n             , \"fjerde\"\n             , \"Fjerde\"\n             ]\n  , examples (OrdinalData 41)\n             [ \"enogfyrrende\"\n             ]\n  , examples (OrdinalData 78)\n             [ \"otteoghalvfjerdsindstyvende\"\n             ]\n  , examples (OrdinalData 263)\n             [ \"to hundrede og treogtresindstyvende\"\n             , \"tohundrede og treogtresindstyvende\"\n             ]\n  , examples (OrdinalData 70)\n             [ \"halvfjerdsende\"\n             , \"halvfjerdsindstyvende\"\n             ]\n  ]\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Ordinal.DA.Rules\n  ( rules ) where\n\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt, numberWith)\nimport Duckling.Numeral.Types (NumeralData (..), getIntValue)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Ordinal.Types (OrdinalData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nordinalsMap :: HashMap Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"f\u00c3\u00b8rste\", 1 )\n  , ( \"anden\", 2 )\n  , ( \"tredje\", 3 )\n  , ( \"fjerde\", 4 )\n  , ( \"femte\", 5 )\n  , ( \"sjette\", 6 )\n  , ( \"syvende\", 7 )\n  , ( \"ottende\", 8 )\n  , ( \"niende\", 9 )\n  , ( \"tiende\", 10 )\n  , ( \"elfte\", 11 )\n  , ( \"tolvte\", 12 )\n  , ( \"trettende\", 13 )\n  , ( \"fjortende\", 14 )\n  , ( \"femtende\", 15 )\n  , ( \"sekstende\", 16 )\n  , ( \"syttende\", 17 )\n  , ( \"attende\", 18 )\n  , ( \"nittende\", 19 )\n  , ( \"tyvende\", 20 )\n  , ( \"tenogtyvende\", 21 )\n  , ( \"toogtyvende\", 22 )\n  , ( \"treogtyvende\", 23 )\n  , ( \"fireogtyvende\", 24 )\n  , ( \"femogtyvende\", 25 )\n  , ( \"seksogtyvende\", 26 )\n  , ( \"syvogtyvende\", 27 )\n  , ( \"otteogtyvende\", 28 )\n  , ( \"niogtyvende\", 29 )\n  , ( \"tredivte\", 30 )\n  , ( \"enogtredivte\", 31 )\n  ]\n\ncardinalsMap :: HashMap Text Int\ncardinalsMap = HashMap.fromList\n  [ ( \"tyvende\", 20 )\n  , ( \"tredivte\", 30 )\n  , ( \"fyrrende\", 40 )\n  , ( \"fyrretyvende\", 40 )\n  , ( \"halvtredsende\", 50 )\n  , ( \"halvtredsindstyvende\", 50 )\n  , ( \"tressende\", 60 )\n  , ( \"tresindstyvende\", 60 )\n  , ( \"halvfjerdsende\", 70 )\n  , ( \"halvfjerdsindstyvende\", 70 )\n  , ( \"firsende\", 80 )\n  , ( \"firsindsstyvende\", 80 )\n  , ( \"halvfemsende\", 90 )\n  , ( \"halvfemsindstyvende\", 90 )\n  ]\n\noneValMap :: HashMap Text Int\noneValMap = HashMap.fromList\n  [ ( \"\", 0 )\n  , ( \"enog\", 1 )\n  , ( \"toog\", 2 )\n  , ( \"treog\", 3 )\n  , ( \"fireog\", 4 )\n  , ( \"femog\", 5 )\n  , ( \"seksog\", 6 )\n  , ( \"syvog\", 7 )\n  , ( \"otteog\", 8 )\n  , ( \"niog\", 9 )\n  ]\n\nruleOrdinalsFirstst :: Rule\nruleOrdinalsFirstst = Rule\n  { name = \"ordinals (first..19st)\"\n  , pattern =\n    [ regex \"(f\u00c3\u00b8rste|anden|tredje|fjerde|femte|sjette|syvende|ottende|niende|tiende|elfte|tolvte|trettende|fjortende|femtende|sekstende|syttende|attende|nittende)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n  }\n\nruleSpelledOutOrdinals :: Rule\nruleSpelledOutOrdinals = Rule\n  { name = \"ordinals, 20 to 99, spelled-out\"\n  , pattern =\n    [ regex (concat [\"((?:en|to|tre|fire|fem|seks|syv|otte|ni)og)?\",\n                     \"(tyvende\",\n                     \"|tredivte\",\n                     \"|fyrr(?:etyv)?ende\",\n                     \"|halvtreds(?:indstyv)?ende\",\n                     \"|tres(?:indstyv|s)?ende\",\n                     \"|halvfjerds(?:indstyv)?ende\",\n                     \"|firs(?:indstyv)?ende\",\n                     \"|halvfems(?:indstyv)?ende)\"])\n    ]\n  , prod = \\case\n    (Token RegexMatch (GroupMatch (ones:tens:_)):_) -> do\n      oneVal <- HashMap.lookup (Text.toLower ones) oneValMap\n      tenVal <- HashMap.lookup (Text.toLower tens) cardinalsMap\n      Just $ ordinal (oneVal + tenVal)\n    _ -> Nothing\n\n  }\n\nruleSpelledOutBigOrdinals :: Rule\nruleSpelledOutBigOrdinals = Rule\n  { name = \"ordinals, above 99, spelled out\"\n  , pattern =\n    [ numberWith TNumeral.value (> 99)\n    , regex \"og\"\n    , dimension Ordinal\n    ]\n  , prod = \\case\n      Token Numeral NumeralData {TNumeral.value=maybenumnum}:_:Token Ordinal (OrdinalData ordnum):_ ->\n            case getIntValue maybenumnum of\n              Just numnum -> Just $ ordinal (numnum + ordnum)\n              Nothing -> Nothing\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+)(\\\\.|ste?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        v <- parseInt match\n        Just $ ordinal v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsFirstst\n  , ruleSpelledOutOrdinals\n  , ruleSpelledOutBigOrdinals\n  ]\n", "num_lines": 170}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.DE.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DE Nothing}, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext {locale = makeLocale DE Nothing}, testOptions, examples)\n  where\n    examples =\n      [ \"1.1\"\n      , \"1.1.\"\n      ]\n\nallExamples :: [Example]\nallExamples =\n  examples (OrdinalData 4)\n           [ \"vierter\"\n           , \"4ter\"\n           , \"Vierter\"\n           , \"4.\"\n           ]\n", "num_lines": 42}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.DE.Rules\n  ( rules\n  ) where\n\nimport Data.Semigroup ((<>))\nimport Prelude\nimport Data.String\nimport Data.Text (Text)\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.List as List\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinalList :: [(Text, Int)]\nordinalList =\n  [ (\"erste\", 1)\n  , (\"zweite\", 2)\n  , (\"dritte\", 3)\n  , (\"vierte\", 4)\n  , (\"f\u00c3\u00bcnfte\", 5)\n  , (\"sechste\", 6)\n  , (\"siebte\", 7)\n  , (\"achte\", 8)\n  , (\"neunte\", 9)\n  , (\"zehnte\", 10)\n  , (\"elfte\", 11)\n  , (\"zw\u00c3\u00b6lfte\", 12)\n  , (\"dreizente\", 13)\n  , (\"vierzehnte\", 14)\n  , (\"f\u00c3\u00bcnfzehnte\", 15)\n  , (\"sechzente\", 16)\n  , (\"siebzehnte\", 17)\n  , (\"achtzehnte\", 18)\n  , (\"neunzehnte\", 19)\n  , (\"zwanzigste\", 20)\n  , (\"einundzwanzigste\", 21)\n  , (\"zweiundzwanzigste\", 22)\n  , (\"dreiundzwanzigste\", 23)\n  , (\"vierundzwanzigste\", 24)\n  , (\"f\u00c3\u00bcnfundzwanzigste\", 25)\n  , (\"sechsundzwanzigste\", 26)\n  , (\"siebenundzwanzigste\", 27)\n  , (\"achtundzwanzigste\", 28)\n  , (\"neunundzwanzigste\", 29)\n  , (\"dreissigste\", 30)\n  , (\"drei\u00c3\u0178igste\", 30)\n  , (\"einunddreissigste\", 31)\n  , (\"einunddrei\u00c3\u0178igste\", 31)\n  ]\n\nruleOrdinalsFirstth :: Rule\nruleOrdinalsFirstth = Rule\n  { name = \"ordinal (1..31)\"\n  , pattern =\n    [ regex $ Text.unpack construction\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalMap\n      _ -> Nothing\n  }\n  where\n    ordinalMap :: HashMap.HashMap Text Int\n    ordinalMap = HashMap.fromList ordinalList\n\n    construction :: Text\n    construction =\n      \"(\"\n      <> mconcat (List.intersperse \"|\" (fst <$> ordinalList))\n      <> \")[rsn]?\"\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"(?<!\\\\d|\\\\.)0*(\\\\d+)(\\\\.(?!\\\\d)| ?(te(n|r|s)?)|(ste(n|r|s)?))\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        v <- parseInt match\n        Just $ ordinal v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalsFirstth\n  , ruleOrdinalDigits\n  ]\n", "num_lines": 106}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.EN.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Ordinal.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"first\"\n             , \"1st\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"second\"\n             , \"2nd\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"third\"\n             , \"3rd\"\n             ]\n  , examples (OrdinalData 4)\n             [ \"fourth\"\n             , \"4th\"\n             ]\n  , examples (OrdinalData 8)\n             [ \"eighth\"\n             , \"8th\"\n             ]\n  , examples (OrdinalData 25)\n             [ \"twenty-fifth\"\n             , \"twenty\u00e2\u20ac\u201dfifth\"\n             , \"twenty fifth\"\n             , \"twentyfifth\"\n             , \"25th\"\n             ]\n  , examples (OrdinalData 31)\n             [ \"thirty-first\"\n             , \"thirty\u00e2\u20ac\u201dfirst\"\n             , \"thirty first\"\n             , \"thirtyfirst\"\n             , \"31st\"\n             ]\n  , examples (OrdinalData 42)\n             [ \"forty-second\"\n             , \"forty\u00e2\u20ac\u201dsecond\"\n             , \"forty second\"\n             , \"fortysecond\"\n             , \"42nd\"\n             ]\n  , examples (OrdinalData 73)\n            [ \"seventy-third\"\n            , \"seventy\u00e2\u20ac\u201dthird\"\n            , \"seventy third\"\n            , \"seventythird\"\n            , \"73rd\"\n            ]\n  , examples (OrdinalData 90)\n            [ \"ninetieth\"\n            , \"90th\"\n            ]\n  ]\n", "num_lines": 78}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Ordinal.EN.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinalsMap :: HashMap Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"first\", 1 )\n  , ( \"second\", 2 )\n  , ( \"third\", 3 )\n  , ( \"fourth\", 4 )\n  , ( \"fifth\", 5 )\n  , ( \"sixth\", 6 )\n  , ( \"seventh\", 7 )\n  , ( \"eighth\", 8 )\n  , ( \"ninth\", 9 )\n  , ( \"tenth\", 10 )\n  , ( \"eleventh\", 11 )\n  , ( \"twelfth\", 12 )\n  , ( \"thirteenth\", 13 )\n  , ( \"fourteenth\", 14 )\n  , ( \"fifteenth\", 15 )\n  , ( \"sixteenth\", 16 )\n  , ( \"seventeenth\", 17 )\n  , ( \"eighteenth\", 18 )\n  , ( \"nineteenth\", 19 )\n  , ( \"twentieth\", 20 )\n  , ( \"thirtieth\", 30 )\n  , ( \"fortieth\", 40 )\n  , ( \"fiftieth\", 50 )\n  , ( \"sixtieth\", 60 )\n  , ( \"seventieth\", 70 )\n  , ( \"eightieth\", 80 )\n  , ( \"ninetieth\", 90 )\n  ]\n\ncardinalsMap :: HashMap Text Int\ncardinalsMap = HashMap.fromList\n  [ ( \"twenty\", 20 )\n  , ( \"thirty\", 30 )\n  , ( \"forty\", 40 )\n  , ( \"fifty\", 50 )\n  , ( \"sixty\", 60 )\n  , ( \"seventy\", 70 )\n  , ( \"eighty\", 80 )\n  , ( \"ninety\", 90 )\n  ]\n\nruleOrdinals :: Rule\nruleOrdinals = Rule\n  { name = \"ordinals (first..twentieth,thirtieth,...)\"\n  , pattern = [regex \"(first|second|third|fourth|fifth|sixth|seventh|eighth|ninth|tenth|eleventh|twelfth|thirteenth|fourteenth|fifteenth|sixteenth|seventeenth|eighteenth|nineteenth|twentieth|thirtieth|fortieth|fiftieth|sixtieth|seventieth|eightieth|ninetieth)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n    }\n\nruleCompositeOrdinals :: Rule\nruleCompositeOrdinals = Rule\n  { name = \"ordinals (composite, e.g. eighty-seven, forty\u00e2\u20ac\u201dseventh, twenty ninth, thirtythird)\"\n  , pattern = [regex \"(twenty|thirty|forty|fifty|sixty|seventy|eighty|ninety)[\\\\s\\\\-\\\\\u00e2\u20ac\u201d]?(first|second|third|fourth|fifth|sixth|seventh|eighth|ninth)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (tens:units:_)):_) -> do\n        tt <- HashMap.lookup (Text.toLower tens) cardinalsMap\n        uu <- HashMap.lookup (Text.toLower units) ordinalsMap\n        Just (ordinal (tt + uu))\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern = [regex \"0*(\\\\d+) ?(st|nd|rd|th)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinals\n  , ruleCompositeOrdinals\n  , ruleOrdinalDigits\n  ]\n", "num_lines": 109}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.ES.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ES Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"primer\"\n             , \"primero\"\n             , \"primeras\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"segundo\"\n             , \"segunda\"\n             , \"segundos\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"tercero\"\n             , \"tercera\"\n             , \"terceros\"\n             ]\n  , examples (OrdinalData 10)\n             [ \"decimo\"\n             , \"decimas\"\n             , \"d\u00c3\u00a9cimos\"\n             ]\n  ]\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.ES.Rules\n  ( rules ) where\n\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinalsMap :: HashMap.HashMap Text.Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"primer\" , 1 )\n  , ( \"primero\" , 1 )\n  , ( \"primeros\" , 1 )\n  , ( \"primera\" , 1 )\n  , ( \"primeras\" , 1 )\n  , ( \"segundo\" , 2 )\n  , ( \"segunda\" , 2 )\n  , ( \"segundas\" , 2 )\n  , ( \"segundos\" , 2 )\n  , ( \"terceros\" , 3 )\n  , ( \"tercera\" , 3 )\n  , ( \"terceras\" , 3 )\n  , ( \"tercero\" , 3 )\n  , ( \"tercer\" , 3 )\n  , ( \"cuarta\" , 4 )\n  , ( \"cuartas\" , 4 )\n  , ( \"cuartos\" , 4 )\n  , ( \"cuarto\" , 4 )\n  , ( \"quinto\" , 5 )\n  , ( \"quinta\" , 5 )\n  , ( \"quintas\" , 5 )\n  , ( \"quintos\" , 5 )\n  , ( \"sextos\" , 6 )\n  , ( \"sexto\" , 6 )\n  , ( \"sexta\" , 6 )\n  , ( \"sextas\" , 6 )\n  , ( \"s\u00c3\u00a9ptimas\" , 7 )\n  , ( \"septimas\" , 7 )\n  , ( \"s\u00c3\u00a9ptima\" , 7 )\n  , ( \"septimos\" , 7 )\n  , ( \"septima\" , 7 )\n  , ( \"s\u00c3\u00a9ptimo\" , 7 )\n  , ( \"s\u00c3\u00a9ptimos\" , 7 )\n  , ( \"septimo\" , 7 )\n  , ( \"octavas\" , 8 )\n  , ( \"octavo\" , 8 )\n  , ( \"octavos\" , 8 )\n  , ( \"octava\" , 8 )\n  , ( \"novenos\" , 9 )\n  , ( \"novena\" , 9 )\n  , ( \"noveno\" , 9 )\n  , ( \"novenas\" , 9 )\n  , ( \"d\u00c3\u00a9cimos\" , 10 )\n  , ( \"decimo\" , 10 )\n  , ( \"decimos\" , 10 )\n  , ( \"d\u00c3\u00a9cimo\" , 10 )\n  , ( \"decimas\" , 10 )\n  , ( \"d\u00c3\u00a9cima\" , 10 )\n  , ( \"decima\" , 10 )\n  , ( \"d\u00c3\u00a9cimas\" , 10 )\n  ]\n\nruleOrdinalsPrimero :: Rule\nruleOrdinalsPrimero = Rule\n  { name = \"ordinals (primero..10)\"\n  , pattern =\n    [ regex \"((primer|segund|tercer|cuart|quint|sext|s[e\u00c3\u00a9]ptim|octav|noven|d[e\u00c3\u00a9]cim)(os?|as?)|(prim|terc)er)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalsPrimero\n  ]\n", "num_lines": 94}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.ET.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ET Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples =\n  examples (OrdinalData 4)\n           [ \"4.\"\n           , \"neljas\"\n           , \"Neljas\"\n           ]\n", "num_lines": 31}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.ET.Rules\n  ( rules ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinalsMap :: HashMap Text Int\nordinalsMap = HashMap.fromList\n [ (\"esimene\", 1)\n , (\"teine\", 2)\n , (\"kolmas\", 3)\n , (\"neljas\", 4)\n , (\"viies\", 5)\n , (\"kuues\", 6)\n , (\"seitsmes\", 7)\n , (\"kaheksas\", 8)\n , (\"\u00c3\u00bcheksas\", 9)\n , (\"k\u00c3\u00bcmnes\", 10)\n , (\"\u00c3\u00bcheteistk\u00c3\u00bcmnes\", 11)\n , (\"kaheteistk\u00c3\u00bcmnes\", 12)\n , (\"kolmeteistk\u00c3\u00bcmnes\", 13)\n , (\"neljateistk\u00c3\u00bcmnes\", 14)\n , (\"viieteistk\u00c3\u00bcmnes\", 15)\n , (\"kuueteistk\u00c3\u00bcmnes\", 16)\n , (\"seitsmeteistk\u00c3\u00bcmnes\", 17)\n , (\"kaheksateistk\u00c3\u00bcmnes\", 18)\n , (\"\u00c3\u00bcheksateistk\u00c3\u00bcmnes\", 19)\n ]\n\nruleOrdinalsFirstth :: Rule\nruleOrdinalsFirstth = Rule\n  { name = \"ordinals (first..19th)\"\n  , pattern =\n    [ regex \"(esimene|teine|kolmas|neljas|viies|kuues|seitsmes|kaheksas|\u00c3\u00bcheksas|k\u00c3\u00bcmnes|\u00c3\u00bcheteistk\u00c3\u00bcmnes|kaheteistk\u00c3\u00bcmnes|kolmeteistk\u00c3\u00bcmnes|neljateistk\u00c3\u00bcmnes|viieteistk\u00c3\u00bcmnes|kuueteistk\u00c3\u00bcmnes|seitsmeteistk\u00c3\u00bcmnes|kaheksateistk\u00c3\u00bcmnes|\u00c3\u00bcheksateistk\u00c3\u00bcmnes)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+)\\\\.\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsFirstth\n  ]\n", "num_lines": 78}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.FR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"1er\"\n             , \"1ere\"\n             , \"1\u00c3\u00a8re\"\n             , \"Premier\"\n             , \"premi\u00c3\u00a8re\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"deuxieme\"\n             , \"deuxi\u00c3\u00a8me\"\n             , \"2e\"\n             , \"second\"\n             , \"2eme\"\n             , \"2\u00c3\u00a8me\"\n             ]\n  , examples (OrdinalData 11)\n             [ \"onzieme\"\n             , \"onzi\u00c3\u00a8me\"\n             , \"11eme\"\n             , \"11\u00c3\u00a8me\"\n             , \"11e\"\n             ]\n  ]\n", "num_lines": 49}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.FR.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict ( HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types (GroupMatch (..))\nimport Duckling.Types\n\nordinalsMap :: HashMap Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"premi\u00c3\u00a8re\", 1 )\n  , ( \"premiere\", 1 )\n  , ( \"premier\", 1 )\n  , ( \"deuxi\u00c3\u00a8me\", 2 )\n  , ( \"deuxieme\", 2 )\n  , ( \"second\", 2 )\n  , ( \"seconde\", 2 )\n  , ( \"troisi\u00c3\u00a8me\", 3 )\n  , ( \"troisieme\", 3 )\n  , ( \"quatrieme\", 4 )\n  , ( \"quatri\u00c3\u00a8me\", 4 )\n  , ( \"cinquieme\", 5 )\n  , ( \"cinqui\u00c3\u00a8me\", 5 )\n  , ( \"sixi\u00c3\u00a8me\", 6 )\n  , ( \"sixieme\", 6 )\n  , ( \"septieme\", 7 )\n  , ( \"septi\u00c3\u00a8me\", 7 )\n  , ( \"huiti\u00c3\u00a8me\", 8 )\n  , ( \"huitieme\", 8 )\n  , ( \"neuvieme\", 9 )\n  , ( \"neuvi\u00c3\u00a8me\", 9 )\n  , ( \"dixi\u00c3\u00a8me\", 10 )\n  , ( \"dixieme\", 10 )\n  , ( \"onzi\u00c3\u00a8me\", 11 )\n  , ( \"onzieme\", 11 )\n  , ( \"douzieme\", 12 )\n  , ( \"douzi\u00c3\u00a8me\", 12 )\n  , ( \"treizieme\", 13 )\n  , ( \"treizi\u00c3\u00a8me\", 13 )\n  , ( \"quatorzi\u00c3\u00a8me\", 14 )\n  , ( \"quatorzieme\", 14 )\n  , ( \"quinzi\u00c3\u00a8me\", 15 )\n  , ( \"quinzieme\", 15 )\n  , ( \"seizieme\", 16 )\n  , ( \"seizi\u00c3\u00a8me\", 16 )\n  ]\n\nruleOrdinalsPremierseizieme :: Rule\nruleOrdinalsPremierseizieme = Rule\n  { name = \"ordinals (premier..seizieme)\"\n  , pattern =\n    [ regex \"(premi(ere?|\u00c3\u00a8re)|(deux|trois|quatr|cinqu|six|sept|huit|neuv|dix|onz|douz|treiz|quatorz|quinz|seiz)i(e|\u00c3\u00a8)me|seconde?)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+) ?(ere?|\u00c3\u00a8re|\u00c3\u00a8me|eme|e)\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsPremierseizieme\n  ]\n", "num_lines": 96}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.GA.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 6)\n             [ \"s\u00c3\u00a9u\"\n             , \"6a\"\n             , \"6d\"\n             , \"06u\"\n             , \"6 \u00c3\u00ba\"\n             , \"0006 adh\"\n             ]\n  , examples (OrdinalData 1)\n             [ \"chead\"\n             , \"t-aonu\"\n             , \"t-aon\u00c3\u00ba\"\n             , \"Aonu\"\n             , \"aon\u00c3\u00ba\"\n             ]\n  , examples (OrdinalData 30)\n             [ \"tr\u00c3\u00adochad\u00c3\u00ba\"\n             , \"triochad\u00c3\u00ba\"\n             , \"tr\u00c3\u00adochadu\"\n             ]\n  , examples (OrdinalData 50)\n             [ \"caogadu\"\n             , \"caogad\u00c3\u00ba\"\n             ]\n  ]\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.GA.Rules\n  ( rules ) where\n\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleOrdinalsChadDaraEtc :: Rule\nruleOrdinalsChadDaraEtc = Rule\n  { name = \"ordinals (ch\u00c3\u00a9ad, dara, etc.)\"\n  , pattern =\n    [ regex \"(ch(\u00c3\u00a9|e)ad|aon(\u00c3\u00ba|u)|t-aon(\u00c3\u00ba|u)|dara|tr(\u00c3\u00ad|i)(\u00c3\u00ba|u)|ceathr(\u00c3\u00ba|u)|c(\u00c3\u00ba|u)igi(\u00c3\u00ba|u)|s(\u00c3\u00a9|e)(\u00c3\u00ba|u)|seacht(\u00c3\u00ba|u)|ocht(\u00c3\u00ba|u)|t-ocht(\u00c3\u00ba|u)|nao(\u00c3\u00ba|u)|deichi(\u00c3\u00ba|u)|fichi(\u00c3\u00ba|u)|tr(\u00c3\u00ad|i)ochad(\u00c3\u00ba|u)|daichead(\u00c3\u00ba|u)|caogad(\u00c3\u00ba|u)|seascad(\u00c3\u00ba|u)|seacht(\u00c3\u00b3|o)d(\u00c3\u00ba|u)|ocht(\u00c3\u00b3|o)d(\u00c3\u00ba|u)|t-ocht(\u00c3\u00b3|o)d(\u00c3\u00ba|u)|n(\u00c3\u00b3|o)chad(\u00c3\u00ba|u)|c(\u00c3\u00a9|e)ad(\u00c3\u00ba|u)|mili(\u00c3\u00ba|u)|milli(\u00c3\u00ba|u)n(\u00c3\u00ba|u))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"t-aonu\" -> Just $ ordinal 1\n        \"aonu\" -> Just $ ordinal 1\n        \"aon\u00c3\u00ba\" -> Just $ ordinal 1\n        \"ch\u00c3\u00a9ad\" -> Just $ ordinal 1\n        \"chead\" -> Just $ ordinal 1\n        \"t-aon\u00c3\u00ba\" -> Just $ ordinal 1\n        \"dara\" -> Just $ ordinal 2\n        \"tri\u00c3\u00ba\" -> Just $ ordinal 3\n        \"tr\u00c3\u00adu\" -> Just $ ordinal 3\n        \"tr\u00c3\u00ad\u00c3\u00ba\" -> Just $ ordinal 3\n        \"triu\" -> Just $ ordinal 3\n        \"ceathr\u00c3\u00ba\" -> Just $ ordinal 4\n        \"ceathru\" -> Just $ ordinal 4\n        \"c\u00c3\u00baigiu\" -> Just $ ordinal 5\n        \"c\u00c3\u00baigi\u00c3\u00ba\" -> Just $ ordinal 5\n        \"cuigiu\" -> Just $ ordinal 5\n        \"cuigi\u00c3\u00ba\" -> Just $ ordinal 5\n        \"s\u00c3\u00a9u\" -> Just $ ordinal 6\n        \"s\u00c3\u00a9\u00c3\u00ba\" -> Just $ ordinal 6\n        \"seu\" -> Just $ ordinal 6\n        \"se\u00c3\u00ba\" -> Just $ ordinal 6\n        \"seachtu\" -> Just $ ordinal 7\n        \"seacht\u00c3\u00ba\" -> Just $ ordinal 7\n        \"t-ocht\u00c3\u00ba\" -> Just $ ordinal 8\n        \"ochtu\" -> Just $ ordinal 8\n        \"t-ochtu\" -> Just $ ordinal 8\n        \"ocht\u00c3\u00ba\" -> Just $ ordinal 8\n        \"naou\" -> Just $ ordinal 9\n        \"nao\u00c3\u00ba\" -> Just $ ordinal 9\n        \"deichiu\" -> Just $ ordinal 10\n        \"deichi\u00c3\u00ba\" -> Just $ ordinal 10\n        \"fichiu\" -> Just $ ordinal 20\n        \"fichi\u00c3\u00ba\" -> Just $ ordinal 20\n        \"tr\u00c3\u00adochadu\" -> Just $ ordinal 30\n        \"triochadu\" -> Just $ ordinal 30\n        \"tr\u00c3\u00adochad\u00c3\u00ba\" -> Just $ ordinal 30\n        \"triochad\u00c3\u00ba\" -> Just $ ordinal 30\n        \"daichead\u00c3\u00ba\" -> Just $ ordinal 40\n        \"daicheadu\" -> Just $ ordinal 40\n        \"caogadu\" -> Just $ ordinal 50\n        \"caogad\u00c3\u00ba\" -> Just $ ordinal 50\n        \"seascadu\" -> Just $ ordinal 60\n        \"seascad\u00c3\u00ba\" -> Just $ ordinal 60\n        \"seachtodu\" -> Just $ ordinal 70\n        \"seachtod\u00c3\u00ba\" -> Just $ ordinal 70\n        \"seacht\u00c3\u00b3d\u00c3\u00ba\" -> Just $ ordinal 70\n        \"seacht\u00c3\u00b3du\" -> Just $ ordinal 70\n        \"ocht\u00c3\u00b3du\" -> Just $ ordinal 80\n        \"ochtodu\" -> Just $ ordinal 80\n        \"t-ochtodu\" -> Just $ ordinal 80\n        \"t-ocht\u00c3\u00b3d\u00c3\u00ba\" -> Just $ ordinal 80\n        \"t-ochtod\u00c3\u00ba\" -> Just $ ordinal 80\n        \"ocht\u00c3\u00b3d\u00c3\u00ba\" -> Just $ ordinal 80\n        \"t-ocht\u00c3\u00b3du\" -> Just $ ordinal 80\n        \"ochtod\u00c3\u00ba\" -> Just $ ordinal 80\n        \"n\u00c3\u00b3chad\u00c3\u00ba\" -> Just $ ordinal 90\n        \"n\u00c3\u00b3chadu\" -> Just $ ordinal 90\n        \"nochad\u00c3\u00ba\" -> Just $ ordinal 90\n        \"nochadu\" -> Just $ ordinal 90\n        \"c\u00c3\u00a9ad\u00c3\u00ba\" -> Just $ ordinal 100\n        \"cead\u00c3\u00ba\" -> Just $ ordinal 100\n        \"ceadu\" -> Just $ ordinal 100\n        \"c\u00c3\u00a9adu\" -> Just $ ordinal 100\n        \"miliu\" -> Just $ ordinal 1000\n        \"mili\u00c3\u00ba\" -> Just $ ordinal 1000\n        \"milliun\u00c3\u00ba\" -> Just $ ordinal 1000000\n        \"milliunu\" -> Just $ ordinal 1000000\n        \"milli\u00c3\u00banu\" -> Just $ ordinal 1000000\n        \"milli\u00c3\u00ban\u00c3\u00ba\" -> Just $ ordinal 1000000\n        _ -> Nothing\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+) ?(adh|a|d|\u00c3\u00ba|u)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsChadDaraEtc\n  ]\n", "num_lines": 121}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.HU.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HU Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"els\u00c5\u2018\"\n             , \"1.\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"m\u00c3\u00a1sodik\"\n             , \"2.\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"harmadik\"\n             , \"3.\"\n             ]\n  , examples (OrdinalData 4)\n             [ \"negyedik\"\n             , \"4.\"\n             ]\n  , examples (OrdinalData 8)\n             [ \"nyolcadik\"\n             , \"8.\"\n             ]\n  , examples (OrdinalData 25)\n             [ \"huszon\u00c3\u00b6t\u00c3\u00b6dik\"\n             , \"25.\"\n             ]\n  , examples (OrdinalData 31)\n             [ \"harmincegyedik\"\n             , \"31.\"\n             ]\n  , examples (OrdinalData 42)\n             [ \"negyvenkettedik\"\n             , \"42.\"\n             ]\n  , examples (OrdinalData 77)\n            [ \"hetvenhetedik\"\n            , \"77.\"\n            ]\n  , examples (OrdinalData 90)\n            [ \"kilencvenedik\"\n            , \"90.\"\n            ]\n  ]\n", "num_lines": 67}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.HU.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport Data.HashMap.Strict ( HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinalsMap :: HashMap Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"els\u00c5\u2018\", 1 )\n  , ( \"m\u00c3\u00a1sodik\", 2 )\n  , ( \"harmadik\", 3 )\n  , ( \"negyedik\", 4 )\n  , ( \"\u00c3\u00b6t\u00c3\u00b6dik\", 5 )\n  , ( \"hatodik\", 6 )\n  , ( \"hetedik\", 7 )\n  , ( \"nyolcadik\", 8 )\n  , ( \"kilencedik\", 9 )\n  , ( \"tizedik\", 10 )\n  , ( \"huszadik\", 20 )\n  , ( \"harmincadik\", 30 )\n  , ( \"negyvenedik\", 40 )\n  , ( \"\u00c3\u00b6tvenedik\", 50 )\n  , ( \"hatvanadik\", 60 )\n  , ( \"hetvenedik\", 70 )\n  , ( \"nyolcvanadik\", 80 )\n  , ( \"kilencvenedik\", 90 )\n  ]\n\nordinalsMap2 :: HashMap Text Int\nordinalsMap2 = HashMap.fromList\n    [ ( \"egyedik\", 1 )\n    , ( \"kettedik\", 2 )\n    , ( \"harmadik\", 3 )\n    , ( \"negyedik\", 4 )\n    , ( \"\u00c3\u00b6t\u00c3\u00b6dik\", 5 )\n    , ( \"hatodik\", 6 )\n    , ( \"hetedik\", 7 )\n    , ( \"nyolcadik\", 8 )\n    , ( \"kilencedik\", 9 )\n    ]\n\ncardinalsMap :: HashMap Text Int\ncardinalsMap = HashMap.fromList\n  [ ( \"tizen\", 10 )\n  , ( \"huszon\", 20 )\n  , ( \"harminc\", 30 )\n  , ( \"negyven\", 40 )\n  , ( \"\u00c3\u00b6tven\", 50 )\n  , ( \"hatvan\", 60 )\n  , ( \"hetven\", 70 )\n  , ( \"nyolcvan\", 80 )\n  , ( \"kilencven\", 90 )\n  ]\n\nruleOrdinals :: Rule\nruleOrdinals = Rule\n  { name = \"ordinals (first..twentieth,thirtieth,...)\"\n  , pattern =\n    [ regex \"(els\u00c5\u2018|m\u00c3\u00a1sodik|harmadik|negyedik|\u00c3\u00b6t\u00c3\u00b6dik|hatodik|hetedik|nyolcadik|kilencedik|tizedik|huszadik|harmincadik|negyvenedik|\u00c3\u00b6tvenedik|hatvanadik|hetvenedik|nyolcvanadik|kilencvenedik)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n    }\n\nruleCompositeOrdinals :: Rule\nruleCompositeOrdinals = Rule\n  { name = \"ordinals (composite, e.g., eighty-seven)\"\n  , pattern =\n    [ regex \"(tizen|huszon|harminc|negyven|\u00c3\u00b6tven|hatvan|hetven|nyolcvan|kilencven)\\\\-?(egyedik|kettedik|harmadik|negyedik|\u00c3\u00b6t\u00c3\u00b6dik|hatodik|hetedik|nyolcadik|kilencedik)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (tens:units:_)):_) -> do\n        tt <- HashMap.lookup (Text.toLower tens) cardinalsMap\n        uu <- HashMap.lookup (Text.toLower units) ordinalsMap2\n        Just . ordinal $ tt + uu\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+)\\\\.\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinals\n  , ruleCompositeOrdinals\n  , ruleOrdinalDigits\n  ]\n", "num_lines": 119}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.ID.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ID Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 4)\n             [ \"ke-4\"\n             , \"keempat\"\n             ]\n  , examples (OrdinalData 10)\n             [ \"Kesepuluh\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"ketiga\"\n             , \"ke-00003\"\n             ]\n  ]\n", "num_lines": 38}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.ID.Rules\n  ( rules ) where\n\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleOrdinals :: Rule\nruleOrdinals = Rule\n  { name = \"ordinals\"\n  , pattern =\n    [ regex \"(pertama|kedua|ketiga|keempat|kelima|keenam|ketujuh|kedelapan|kesembilan|kesepuluh)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"pertama\" -> Just $ ordinal 1\n        \"kedua\" -> Just $ ordinal 2\n        \"ketiga\" -> Just $ ordinal 3\n        \"keempat\" -> Just $ ordinal 4\n        \"kelima\" -> Just $ ordinal 5\n        \"keenam\" -> Just $ ordinal 6\n        \"ketujuh\" -> Just $ ordinal 7\n        \"kedelapan\" -> Just $ ordinal 8\n        \"kesembilan\" -> Just $ ordinal 9\n        \"kesepuluh\" -> Just $ ordinal 10\n        _ -> Nothing\n      _ -> Nothing\n  }\n\nruleOrdinalsDigits :: Rule\nruleOrdinalsDigits = Rule\n  { name = \"ordinals (digits)\"\n  , pattern =\n    [ regex \"ke-0*(\\\\d+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinals\n  , ruleOrdinalsDigits\n  ]\n", "num_lines": 62}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.IT.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"primo\"\n             , \"prima\"\n             , \"1\u00c2\u00b0\"\n             , \"1\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"secondo\"\n             , \"seconda\"\n             , \"2\u00c2\u00b0\"\n             , \"2\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"terzo\"\n             , \"Terza\"\n             , \"3\u00c2\u00b0\"\n             , \"3\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 4)\n             [ \"quarto\"\n             , \"quarta\"\n             , \"4\u00c2\u00b0\"\n             , \"4\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 5)\n             [ \"quinto\"\n             , \"quinta\"\n             , \"5\u00c2\u00b0\"\n             , \"5\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 6)\n             [ \"sesto\"\n             , \"sesta\"\n             , \"6\u00c2\u00b0\"\n             , \"6\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 7)\n             [ \"settimo\"\n             , \"settima\"\n             , \"7\u00c2\u00b0\"\n             , \"7\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 8)\n             [ \"ottavo\"\n             , \"ottava\"\n             , \"8\u00c2\u00b0\"\n             , \"8\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 9)\n             [ \"nono\"\n             , \"nona\"\n             , \"9\u00c2\u00b0\"\n             , \"9\u00c2\u00aa\"\n             ]\n  , examples (OrdinalData 10)\n             [ \"decimo\"\n             , \"decima\"\n             , \"10\u00c2\u00b0\"\n             , \"10\u00c2\u00aa\"\n             ]\n  ]\n", "num_lines": 87}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.IT.Rules\n  ( rules ) where\n\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleOrdinalsPrimo :: Rule\nruleOrdinalsPrimo = Rule\n  { name = \"ordinals (primo..10)\"\n  , pattern =\n    [ regex \"((prim|second|terz|quart|quint|sest|settim|ottav|non|decim)(o|a|i|e))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"primi\" -> Just $ ordinal 1\n        \"prima\" -> Just $ ordinal 1\n        \"primo\" -> Just $ ordinal 1\n        \"prime\" -> Just $ ordinal 1\n        \"seconda\" -> Just $ ordinal 2\n        \"secondi\" -> Just $ ordinal 2\n        \"seconde\" -> Just $ ordinal 2\n        \"secondo\" -> Just $ ordinal 2\n        \"terze\" -> Just $ ordinal 3\n        \"terzi\" -> Just $ ordinal 3\n        \"terzo\" -> Just $ ordinal 3\n        \"terza\" -> Just $ ordinal 3\n        \"quarte\" -> Just $ ordinal 4\n        \"quarto\" -> Just $ ordinal 4\n        \"quarta\" -> Just $ ordinal 4\n        \"quarti\" -> Just $ ordinal 4\n        \"quinto\" -> Just $ ordinal 5\n        \"quinta\" -> Just $ ordinal 5\n        \"quinti\" -> Just $ ordinal 5\n        \"quinte\" -> Just $ ordinal 5\n        \"sesti\" -> Just $ ordinal 6\n        \"seste\" -> Just $ ordinal 6\n        \"sesta\" -> Just $ ordinal 6\n        \"sesto\" -> Just $ ordinal 6\n        \"settimi\" -> Just $ ordinal 7\n        \"settima\" -> Just $ ordinal 7\n        \"settimo\" -> Just $ ordinal 7\n        \"settime\" -> Just $ ordinal 7\n        \"ottavo\" -> Just $ ordinal 8\n        \"ottava\" -> Just $ ordinal 8\n        \"ottavi\" -> Just $ ordinal 8\n        \"ottave\" -> Just $ ordinal 8\n        \"none\" -> Just $ ordinal 9\n        \"noni\" -> Just $ ordinal 9\n        \"nona\" -> Just $ ordinal 9\n        \"nono\" -> Just $ ordinal 9\n        \"decimo\" -> Just $ ordinal 10\n        \"decima\" -> Just $ ordinal 10\n        \"decime\" -> Just $ ordinal 10\n        \"decimi\" -> Just $ ordinal 10\n        _ -> Nothing\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+) ?(\u00c2\u00aa|\u00c2\u00b0|\u00c2\u00b0)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsPrimo\n  ]\n", "num_lines": 92}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.JA.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale JA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples =\n  examples (OrdinalData 7)\n           [ \"\u00e7\u00ac\u00ac\u00e4\u00b8\u0192\"\n           ]\n", "num_lines": 29}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.JA.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Types (NumeralData (..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Ordinal.Helpers\nimport Duckling.Types\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"\u00e7\u00ac\u00ac\"\n    , dimension Numeral\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . ordinal $ floor v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.KM.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext{locale = makeLocale KM Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"\u00e1\u017e\u2018\u00e1\u017e\u00b8\u00e1\u017e\u02dc\u00e1\u017e\u00bd\u00e1\u017e\u2122\"\n             , \"\u00e1\u017e\u2018\u00e1\u017e\u00b8\u00e1\u0178\u00a1\"\n             ]\n  , examples (OrdinalData 400)\n             [ \"\u00e1\u017e\u2018\u00e1\u017e\u00b8\u00e1\u017e\u201d\u00e1\u017e\u00bd\u00e1\u017e\u201c\u00e1\u017e\u0161\u00e1\u017e\u2122\"\n             ]\n  ]\n", "num_lines": 38}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.KM.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Ordinal.Helpers\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"\u00e1\u017e\u2018\u00e1\u017e\u00b8\"\n    , dimension Numeral\n    ]\n  , prod = \\case\n      (_:Token Numeral NumeralData{TNumeral.value = x}:_) ->\n        Just . ordinal $ floor x\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  ]\n", "num_lines": 42}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.KO.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Types\n\nruleOrdinals :: Rule\nruleOrdinals = Rule\n  { name = \"ordinals (\u00ec\u00b2\u00ab\u00eb\u00b2\u02c6\u00ec\u00a7\u00b8)\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"\u00eb\u00b2\u02c6\u00ec\u00a7\u00b8|\u00ec\u00a7\u00b8(\u00eb\u00b2\u02c6)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        Just . ordinal $ floor v\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinals\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.NB.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NB Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 4)\n             [ \"4.\"\n             , \"fjerde\"\n             , \"fJerde\"\n             ]\n  , examples (OrdinalData 15)\n             [ \"15.\"\n             , \"femtende\"\n             ]\n  , examples (OrdinalData 5)\n             [ \"5.\"\n             , \"femte\"\n             ]\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.NB.Rules\n  ( rules ) where\n\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleOrdinalsFirstst :: Rule\nruleOrdinalsFirstst = Rule\n  { name = \"ordinals (first..31st)\"\n  , pattern =\n    [ regex \"(f\u00c3\u00b8rste|andre|tredje|fjerde|femtende|femte|sjette|syvende|\u00c3\u00a5ttende|niende|tiende|ellevte|tolvte|trettende|fjortende|sekstende|syttende|attende|nittende|tyvende|tjuende|enogtyvende|toogtyvende|treogtyvende|fireogtyvende|femogtyvende|seksogtyvende|syvogtyvende|\u00c3\u00a5tteogtyvende|niogtyvende|enogtjuende|toogtjuende|treogtjuende|fireogtjuende|femogtjuende|seksogtjuende|syvogtjuende|\u00c3\u00a5tteogtyvend|niogtjuende|tredefte|enogtredefte)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"f\u00c3\u00b8rste\" -> Just $ ordinal 1\n        \"andre\" -> Just $ ordinal 2\n        \"tredje\" -> Just $ ordinal 3\n        \"fjerde\" -> Just $ ordinal 4\n        \"femte\" -> Just $ ordinal 5\n        \"sjette\" -> Just $ ordinal 6\n        \"syvende\" -> Just $ ordinal 7\n        \"\u00c3\u00a5ttende\" -> Just $ ordinal 8\n        \"niende\" -> Just $ ordinal 9\n        \"tiende\" -> Just $ ordinal 10\n        \"ellevte\" -> Just $ ordinal 11\n        \"tolvte\" -> Just $ ordinal 12\n        \"trettende\" -> Just $ ordinal 13\n        \"fjortende\" -> Just $ ordinal 14\n        \"femtende\" -> Just $ ordinal 15\n        \"sekstende\" -> Just $ ordinal 16\n        \"syttende\" -> Just $ ordinal 17\n        \"attende\" -> Just $ ordinal 18\n        \"nittende\" -> Just $ ordinal 19\n        \"tyvende\" -> Just $ ordinal 20\n        \"tjuende\" -> Just $ ordinal 20\n        \"enogtjuende\" -> Just $ ordinal 21\n        \"enogtyvende\" -> Just $ ordinal 21\n        \"toogtyvende\" -> Just $ ordinal 22\n        \"toogtjuende\" -> Just $ ordinal 22\n        \"treogtyvende\" -> Just $ ordinal 23\n        \"treogtjuende\" -> Just $ ordinal 23\n        \"fireogtjuende\" -> Just $ ordinal 24\n        \"fireogtyvende\" -> Just $ ordinal 24\n        \"femogtyvende\" -> Just $ ordinal 25\n        \"femogtjuende\" -> Just $ ordinal 25\n        \"seksogtjuende\" -> Just $ ordinal 26\n        \"seksogtyvende\" -> Just $ ordinal 26\n        \"syvogtyvende\" -> Just $ ordinal 27\n        \"syvogtjuende\" -> Just $ ordinal 27\n        \"\u00c3\u00a5tteogtyvende\" -> Just $ ordinal 28\n        \"\u00c3\u00a5tteogtjuende\" -> Just $ ordinal 28\n        \"niogtyvende\" -> Just $ ordinal 29\n        \"niogtjuende\" -> Just $ ordinal 29\n        \"tredefte\" -> Just $ ordinal 30\n        \"enogtredefte\" -> Just $ ordinal 31\n        _ -> Nothing\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+)(\\\\.|ste?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsFirstst\n  ]\n", "num_lines": 93}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.NL.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"1ste\"\n             , \"eerste\"\n             ]\n  , examples (OrdinalData 4)\n             [ \"4de\"\n             , \"vierde\"\n             ]\n  , examples (OrdinalData 17)\n             [ \"Zeventiende\"\n             , \"17de\"\n             ]\n  ]\n", "num_lines": 39}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.NL.Rules\n  ( rules ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Text (Text)\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nzeroNineteenMap :: HashMap Text Int\nzeroNineteenMap = HashMap.fromList\n  [ (\"eerste\", 1)\n  , (\"tweede\", 2)\n  , (\"derde\", 3)\n  , (\"vierde\", 4)\n  , (\"vijfde\", 5)\n  , (\"zesde\", 6)\n  , (\"zevende\", 7)\n  , (\"achste\", 8)\n  , (\"negende\", 9)\n  , (\"tiende\", 10)\n  , (\"elfde\", 11)\n  , (\"twaalfde\", 12)\n  , (\"dertiende\", 13)\n  , (\"veertiende\", 14)\n  , (\"vijftiende\", 15)\n  , (\"zestiende\", 16)\n  , (\"zeventiende\", 17)\n  , (\"achttiende\", 18)\n  , (\"negentiende\", 19)\n  ]\n\nruleOrdinalsFirstth :: Rule\nruleOrdinalsFirstth = Rule\n  { name = \"ordinals (first..19th)\"\n  , pattern =\n    [ regex \"(eerste|tweede|derde|vierde|vijfde|zeste|zevende|achtste|negende|tiende|elfde|twaalfde|veertiende|vijftiende|zestiende|zeventiende|achttiende|negentiende)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) zeroNineteenMap\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+)(\\\\.| ?(ste|de))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsFirstth\n  ]\n", "num_lines": 79}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.PL.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples =\n  examples (OrdinalData 4)\n           [ \"4ty\"\n           , \"czwarty\"\n           ]\n", "num_lines": 30}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.PL.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Ordinal.Types (OrdinalData (..))\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nruleThOrdinalNoSpace :: Rule\nruleThOrdinalNoSpace = Rule\n  { name = \"24th ordinal no space\"\n  , pattern =\n    [ regex \"dwudziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)czwart(y|ego|emu|ym|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 24\n  }\n\nruleThOrdinal16 :: Rule\nruleThOrdinal16 = Rule\n  { name = \"31-39th ordinal\"\n  , pattern =\n    [ regex \"trzydziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)( |-)?\"\n    , dimension Ordinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        Just . ordinal $ 30 + v\n      _ -> Nothing\n  }\n\nruleThOrdinal3 :: Rule\nruleThOrdinal3 = Rule\n  { name = \"10th ordinal\"\n  , pattern =\n    [ regex \"dziesi(a|\u00c4\u2026)t(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 10\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+)( |-)?(szy|sza|szym|ego|go|szego|gi(ego|ej)?|st(a|y|ej)|t(ej|y|ego)|ci(ego)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nruleThOrdinal8 :: Rule\nruleThOrdinal8 = Rule\n  { name = \"15th ordinal\"\n  , pattern =\n    [ regex \"pi(e|\u00c4\u2122)tnast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 15\n  }\n\nruleThOrdinal13 :: Rule\nruleThOrdinal13 = Rule\n  { name = \"20th ordinal\"\n  , pattern =\n    [ regex \"dwudziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 20\n  }\n\nruleThOrdinal4 :: Rule\nruleThOrdinal4 = Rule\n  { name = \"11th ordinal\"\n  , pattern =\n    [ regex \"jedenast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 11\n  }\n\nruleFifthOrdinal :: Rule\nruleFifthOrdinal = Rule\n  { name = \"fifth ordinal\"\n  , pattern =\n    [ regex \"pi(a|\u00c4\u2026)t(y|ego|emu|m|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 5\n  }\n\nruleThOrdinal11 :: Rule\nruleThOrdinal11 = Rule\n  { name = \"18th ordinal\"\n  , pattern =\n    [ regex \"osiemnast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 18\n  }\n\nruleSecondOrdinal :: Rule\nruleSecondOrdinal = Rule\n  { name = \"second ordinal\"\n  , pattern =\n    [ regex \"drugi?(ego|emu|m|(a|\u00c4\u2026)|ej)?\"\n    ]\n  , prod = \\_ -> Just $ ordinal 2\n  }\n\nruleNdOrdinalNoSpace :: Rule\nruleNdOrdinalNoSpace = Rule\n  { name = \"22nd ordinal no space\"\n  , pattern =\n    [ regex \"dwudziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)drugi?(ego|emu|m|(a|\u00c4\u2026)|ej)?\"\n    ]\n  , prod = \\_ -> Just $ ordinal 22\n  }\n\nruleSeventhOrdinal :: Rule\nruleSeventhOrdinal = Rule\n  { name = \"seventh ordinal\"\n  , pattern =\n    [ regex \"si(o|\u00c3\u00b3)dm(y|ego|emu|m|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 7\n  }\n\nruleStOrdinalNoSpace :: Rule\nruleStOrdinalNoSpace = Rule\n  { name = \"21st ordinal no space\"\n  , pattern =\n    [ regex \"dwudziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)pierw?sz(y|ego|emu|m|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 21\n  }\n\nruleThOrdinal7 :: Rule\nruleThOrdinal7 = Rule\n  { name = \"14th ordinal\"\n  , pattern =\n    [ regex \"czternast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 14\n  }\n\nruleThOrdinal2 :: Rule\nruleThOrdinal2 = Rule\n  { name = \"9th ordinal\"\n  , pattern =\n    [ regex \"dziewi(a|\u00c4\u2026)t(ym|y|ego|em|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 9\n  }\n\nruleThOrdinal9 :: Rule\nruleThOrdinal9 = Rule\n  { name = \"16th ordinal\"\n  , pattern =\n    [ regex \"szesnast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 16\n  }\n\nruleThOrdinal :: Rule\nruleThOrdinal = Rule\n  { name = \"8th ordinal\"\n  , pattern =\n    [ regex \"(o|\u00c3\u00b3|\u00c3\u201c)sm(y|ego|emu|m|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 8\n  }\n\nruleThOrdinal14 :: Rule\nruleThOrdinal14 = Rule\n  { name = \"21-29th ordinal\"\n  , pattern =\n    [ regex \"dwudziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)( |-)?\"\n    , dimension Ordinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        Just . ordinal $ 20 + v\n      _ -> Nothing\n  }\n\nruleThOrdinal10 :: Rule\nruleThOrdinal10 = Rule\n  { name = \"17th ordinal\"\n  , pattern =\n    [ regex \"siedemnast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 17\n  }\n\nruleRdOrdinalNoSpace :: Rule\nruleRdOrdinalNoSpace = Rule\n  { name = \"23rd ordinal no space\"\n  , pattern =\n    [ regex \"dwudziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)trzeci(ego|ch|emu|m|mi|ej|(a|\u00c4\u2026))?\"\n    ]\n  , prod = \\_ -> Just $ ordinal 23\n  }\n\nruleThOrdinal5 :: Rule\nruleThOrdinal5 = Rule\n  { name = \"12th ordinal\"\n  , pattern =\n    [ regex \"dwunast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 12\n  }\n\nruleThOrdinal6 :: Rule\nruleThOrdinal6 = Rule\n  { name = \"13th ordinal\"\n  , pattern =\n    [ regex \"trzynast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 13\n  }\n\nruleFirstOrdinal :: Rule\nruleFirstOrdinal = Rule\n  { name = \"first ordinal\"\n  , pattern =\n    [ regex \"pierw?sz(y|ego|emu|m|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 1\n  }\n\nruleSixthOrdinal :: Rule\nruleSixthOrdinal = Rule\n  { name = \"sixth ordinal\"\n  , pattern =\n    [ regex \"sz(o|\u00c3\u00b3)st(y|ego|emu|m|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 6\n  }\n\nruleFourthOrdinal :: Rule\nruleFourthOrdinal = Rule\n  { name = \"fourth ordinal\"\n  , pattern =\n    [ regex \"czwart(y|ego|emu|ym|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 4\n  }\n\nruleThOrdinal15 :: Rule\nruleThOrdinal15 = Rule\n  { name = \"30th ordinal\"\n  , pattern =\n    [ regex \"trzydziest(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 30\n  }\n\nruleThOrdinal12 :: Rule\nruleThOrdinal12 = Rule\n  { name = \"19th ordinal\"\n  , pattern =\n    [ regex \"dziewi(\u00c4\u2122|e)tnast(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 19\n  }\n\nruleThirdOrdinal :: Rule\nruleThirdOrdinal = Rule\n  { name = \"third ordinal\"\n  , pattern =\n    [ regex \"trzeci(ego|ch|emu|m|mi|ej|(a|\u00c4\u2026))?\"\n    ]\n  , prod = \\_ -> Just $ ordinal 3\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleFifthOrdinal\n  , ruleFirstOrdinal\n  , ruleFourthOrdinal\n  , ruleNdOrdinalNoSpace\n  , ruleOrdinalDigits\n  , ruleRdOrdinalNoSpace\n  , ruleSecondOrdinal\n  , ruleSeventhOrdinal\n  , ruleSixthOrdinal\n  , ruleStOrdinalNoSpace\n  , ruleThOrdinal\n  , ruleThOrdinal10\n  , ruleThOrdinal11\n  , ruleThOrdinal12\n  , ruleThOrdinal13\n  , ruleThOrdinal14\n  , ruleThOrdinal15\n  , ruleThOrdinal16\n  , ruleThOrdinal2\n  , ruleThOrdinal3\n  , ruleThOrdinal4\n  , ruleThOrdinal5\n  , ruleThOrdinal6\n  , ruleThOrdinal7\n  , ruleThOrdinal8\n  , ruleThOrdinal9\n  , ruleThOrdinalNoSpace\n  , ruleThirdOrdinal\n  ]\n", "num_lines": 318}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.PT.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"primeira\"\n             , \"primeiros\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"Segundo\"\n             , \"segundas\"\n             ]\n  , examples (OrdinalData 7)\n             [ \"setimo\"\n             , \"s\u00c3\u00a9timo\"\n             , \"s\u00c3\u00a9timas\"\n             ]\n  , examples (OrdinalData 10)\n             [ \"decimos\"\n             , \"d\u00c3\u00a9cimos\"\n             , \"decima\"\n             , \"d\u00c3\u00a9cima\"\n             , \"decimas\"\n             , \"d\u00c3\u00a9cimas\"\n             ]\n  , examples (OrdinalData 11)\n             [ \"decimos primeiros\"\n             , \"d\u00c3\u00a9cimos primeiros\"\n             , \"decimo primeiro\"\n             , \"d\u00c3\u00a9cimo primeiro\"\n             , \"decimas primeiras\"\n             , \"d\u00c3\u00a9cimas primeiras\"\n             , \"decima primeira\"\n             , \"d\u00c3\u00a9cima primeira\"\n             ]\n  , examples (OrdinalData 12)\n             [ \"decimos segundos\"\n             , \"d\u00c3\u00a9cimos segundos\"\n             , \"decimo segundo\"\n             , \"d\u00c3\u00a9cimo segundo\"\n             , \"decimas segundas\"\n             , \"d\u00c3\u00a9cimas segundas\"\n             , \"decima segunda\"\n             , \"d\u00c3\u00a9cima segunda\"\n             ]\n  , examples (OrdinalData 17)\n             [ \"decimos setimos\"\n             , \"d\u00c3\u00a9cimos setimos\"\n             , \"decimo setimo\"\n             , \"d\u00c3\u00a9cimo s\u00c3\u00a9timo\"\n             , \"decimas setimas\"\n             , \"d\u00c3\u00a9cimas s\u00c3\u00a9timas\"\n             , \"decima setima\"\n             , \"d\u00c3\u00a9cima setima\"\n             ]\n  , examples (OrdinalData 58)\n             [ \"quinquag\u00c3\u00a9simas oitavas\"\n             , \"q\u00c3\u00bcinquagesimo oitavo\"\n             , \"quinquag\u00c3\u00a9simo oitavo\"\n             ]\n  ]\n", "num_lines": 84}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.PT.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.Helpers\nimport Duckling.Ordinal.Types (OrdinalData (..))\nimport Duckling.Regex.Types (GroupMatch (..))\nimport Duckling.Types\nimport qualified Duckling.Ordinal.Types as TOrdinal\n\nordinalsMap :: HashMap Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"primeir\", 1 )\n  , ( \"segund\", 2 )\n  , ( \"terceir\", 3 )\n  , ( \"quart\", 4 )\n  , ( \"quint\", 5 )\n  , ( \"sext\", 6 )\n  , ( \"setim\", 7 )\n  , ( \"s\u00c3\u00a9tim\", 7 )\n  , ( \"oitav\", 8 )\n  , ( \"non\", 9 )\n  , ( \"decim\", 10 )\n  , ( \"d\u00c3\u00a9cim\", 10 )\n  ]\n\nruleOrdinals :: Rule\nruleOrdinals = Rule\n  { name = \"ordinals (1..10)\"\n  , pattern =\n    [ regex \"(primeir|segund|terceir|quart|quint|sext|s[\u00c3\u00a9e]tim|oitav|non|d[\u00c3\u00a9e]cim)[ao]s?\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n  }\n\ncardinalsMap :: HashMap Text Int\ncardinalsMap = HashMap.fromList\n  [ ( \"vi\", 20 )\n  , ( \"tri\", 30 )\n  , ( \"quadra\", 40 )\n  , ( \"q\u00c3\u00bcinqua\", 50 )\n  , ( \"quinqua\", 50 )\n  , ( \"sexa\", 60 )\n  , ( \"septua\", 70 )\n  , ( \"octo\", 80 )\n  , ( \"nona\", 90 )\n  ]\n\nruleCardinals :: Rule\nruleCardinals = Rule\n  { name = \"cardinals (20 .. 90)\"\n  , pattern =\n    [ regex \"(vi|tri|quadra|q[\u00c3\u00bcu]inqua|sexa|septua|octo|nona)g[\u00c3\u00a9e]sim[ao]s?\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) cardinalsMap\n      _ -> Nothing\n  }\n\nruleCompositeOrdinals :: Rule\nruleCompositeOrdinals = Rule\n  { name = \"ordinals (11..19)\"\n  , pattern =\n    [ oneOf [10, 20 .. 90]\n    , oneOf [1..9]\n    ]\n  , prod = \\case\n      (Token Ordinal OrdinalData{TOrdinal.value = t}:\n       Token Ordinal OrdinalData{TOrdinal.value = u}:\n       _) -> Just $ ordinal $ t + u\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinals\n  , ruleCardinals\n  , ruleCompositeOrdinals\n  ]\n", "num_lines": 103}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.RO.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"primul\"\n             , \"prima\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"al doilea\"\n             , \"al doi-lea\"\n             , \"al doi lea\"\n             , \"al 2-lea\"\n             , \"al 2 lea\"\n             , \"a 2 a\"\n             , \"a 2-a\"\n             , \"a doua\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"al treilea\"\n             , \"al trei-lea\"\n             , \"a treia\"\n             , \"a 3-lea\"\n             , \"a 3a\"\n             ]\n  , examples (OrdinalData 4)\n             [ \"a patra\"\n             , \"a patru-lea\"\n             ]\n  , examples (OrdinalData 6)\n             [ \"al saselea\"\n             , \"al \u00c8\u2122aselea\"\n             , \"al sase-lea\"\n             , \"al \u00c8\u2122ase-lea\"\n             , \"a sasea\"\n             , \"a \u00c8\u2122ase a\"\n             ]\n  , examples (OrdinalData 9)\n             [ \"al noualea\"\n             , \"al noua-lea\"\n             , \"al noua lea\"\n             , \"al nou\u00c4\u0192lea\"\n             , \"al nou\u00c4\u0192 lea\"\n             , \"a noua\"\n             ]\n  ]\n", "num_lines": 68}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.RO.Rules\n  ( rules ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Maybe\nimport Data.Text (Text)\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nrulePrimulDouaPatraNoua :: Rule\nrulePrimulDouaPatraNoua = Rule\n { name = \"special ordinals\"\n , pattern =\n   [ regex \"(prim(a|ul)|a (patra|[dn]oua))\"\n   ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> case Text.toLower match of\n        \"prima\"   -> Just $ ordinal 1\n        \"primul\"  -> Just $ ordinal 1\n        \"a doua\"  -> Just $ ordinal 2\n        \"a patra\" -> Just $ ordinal 4\n        \"a noua\"  -> Just $ ordinal 9\n        _         -> Nothing\n      _ -> Nothing\n }\n\n-- We can't have a generic rule of the form \"al?\" + Numeral + \"(le)?a\"\n-- It wouldn't match \"al optlea\"\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinals (digits)\"\n  , pattern =\n    [ regex \"al?\\\\s0*(\\\\d+)[ -]?(le)?a\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nordinalMap :: HashMap Text Int\nordinalMap = HashMap.fromList\n  [ (\"doi\", 2)\n  , (\"trei\", 3)\n  , (\"patru\", 4)\n  , (\"cinci\", 5)\n  , (\"sase\", 6)\n  , (\"\\537ase\", 6)\n  , (\"sapte\", 7)\n  , (\"\\537apte\", 7)\n  , (\"opt\", 8)\n  , (\"noua\", 9)\n  , (\"nou\u00c4\u0192\", 9)\n  ]\n\nruleSpelledOutOrdinals :: Rule\nruleSpelledOutOrdinals = Rule\n  { name = \"spelled out ordinals\"\n  , pattern =\n    [ regex \"al?\\\\s(doi|trei|patru|cinci|(s|\u00c8\u2122)a(s|pt)e|opt|nou(a|\u00c4\u0192))[ -]?(le)?a\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalMap\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , rulePrimulDouaPatraNoua\n  , ruleSpelledOutOrdinals\n  ]\n", "num_lines": 93}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.SV.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale SV Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"f\u00c3\u00b6rsta\"\n             , \"f\u00c3\u00b6rste\"\n             , \"1a\"\n             , \"1:a\"\n             ]\n  , examples (OrdinalData 2)\n             [ \"andra\"\n             , \"andre\"\n             , \"2a\"\n             , \"2:a\"\n             ]\n  , examples (OrdinalData 3)\n             [ \"tredje\"\n             , \"3e\"\n             , \"3:e\"\n             ]\n  , examples (OrdinalData 4)\n             [ \"fj\u00c3\u00a4rde\"\n             , \"4e\"\n             , \"4:e\"\n             ]\n  , examples (OrdinalData 8)\n             [ \"\u00c3\u00a5ttonde\"\n             , \"8e\"\n             , \"8:e\"\n             ]\n  , examples (OrdinalData 25)\n             [ \"tjugofemte\"\n             , \"25e\"\n             , \"25:e\"\n             ]\n  , examples (OrdinalData 31)\n             [ \"trettiof\u00c3\u00b6rsta\"\n             , \"trettiof\u00c3\u00b6rste\"\n             , \"31a\"\n             , \"31:a\"\n             ]\n  , examples (OrdinalData 42)\n             [ \"fyrtioandra\"\n             , \"fyrtioandre\"\n             , \"42a\"\n             , \"42:a\"\n             ]\n  , examples (OrdinalData 77)\n            [ \"sjuttiosjunde\"\n            , \"77e\"\n            , \"77:e\"\n            ]\n  , examples (OrdinalData 90)\n            [ \"nittionde\"\n            , \"90e\"\n            , \"90:e\"\n            ]\n  ]\n", "num_lines": 81}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.SV.Rules\n  ( rules ) where\n\nimport Control.Monad (join)\nimport Data.HashMap.Strict ( HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinalsMap :: HashMap Text Int\nordinalsMap = HashMap.fromList\n  [ ( \"f\u00c3\u00b6rsta\", 1 )\n  , ( \"f\u00c3\u00b6rste\", 1 )\n  , ( \"andra\", 2 )\n  , ( \"andre\", 2)\n  , ( \"tredje\", 3 )\n  , ( \"fj\u00c3\u00a4rde\", 4 )\n  , ( \"femte\", 5 )\n  , ( \"sj\u00c3\u00a4tte\", 6 )\n  , ( \"sjunde\", 7 )\n  , ( \"\u00c3\u00a5ttonde\", 8 )\n  , ( \"nionde\", 9 )\n  , ( \"tionde\", 10 )\n  , ( \"elfte\", 11 )\n  , ( \"tolfte\", 12 )\n  , ( \"trettonde\", 13 )\n  , ( \"fjortonde\", 14 )\n  , ( \"femtonde\", 15 )\n  , ( \"sextonde\", 16 )\n  , ( \"sjuttonde\", 17 )\n  , ( \"artonde\", 18 )\n  , ( \"nittonde\", 19 )\n  , ( \"tjugonde\", 20 )\n  , ( \"trettionde\", 30 )\n  , ( \"fyrtionde\", 40 )\n  , ( \"femtionde\", 50 )\n  , ( \"sextionde\", 60 )\n  , ( \"sjuttionde\", 70 )\n  , ( \"\u00c3\u00a5ttionde\", 80 )\n  , ( \"nittionde\", 90 )\n  ]\n\ncardinalsMap :: HashMap Text Int\ncardinalsMap = HashMap.fromList\n  [ ( \"tjugo\", 20 )\n  , ( \"trettio\", 30 )\n  , ( \"fyrtio\", 40 )\n  , ( \"femtio\", 50 )\n  , ( \"sextio\", 60 )\n  , ( \"sjuttio\", 70 )\n  , ( \"\u00c3\u00a5ttio\", 80 )\n  , ( \"nittio\", 90 )\n  ]\n\nruleOrdinals :: Rule\nruleOrdinals = Rule\n  { name = \"ordinals (first..twentieth,thirtieth,...)\"\n  , pattern =\n    [ regex \"(f\u00c3\u00b6rsta|f\u00c3\u00b6rste|andra|andre|tredje|fj\u00c3\u00a4rde|femte|sj\u00c3\u00a4tte|sjunde|\u00c3\u00a5ttonde|nionde|tionde|elfte|tolfte|trettionde|fjortonde|femtonde|sextonde|sjuttonde|artonde|nittonde|tjugonde|trettionde|fyrtionde|femtonde|sextionde|sjuttionde|\u00c3\u00a5ttionde|nittionde)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsMap\n      _ -> Nothing\n    }\n\nruleCompositeOrdinals :: Rule\nruleCompositeOrdinals = Rule\n  { name = \"ordinals (composite, e.g., eighty-seven)\"\n  , pattern =\n    [ regex \"(tjugo|trettio|fyrtio|femtio|sextio|sjuttio|\u00c3\u00a5ttio|nittio)(f\u00c3\u00b6rsta|f\u00c3\u00b6rste|andra|andre|tredje|fj\u00c3\u00a4rde|femte|sj\u00c3\u00a4tte|sjunde|\u00c3\u00a5ttonde|nionde)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (tens:units:_)):_) -> do\n        tt <- HashMap.lookup (Text.toLower tens) cardinalsMap\n        uu <- HashMap.lookup (Text.toLower units) ordinalsMap\n        Just . ordinal $ tt + uu\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+):?(a|e)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinals\n  , ruleCompositeOrdinals\n  , ruleOrdinalDigits\n  ]\n", "num_lines": 116}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.TR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale TR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 4)\n             [ \"4\u00c3\u00bcnc\u00c3\u00bc\"\n             , \"d\u00c3\u00b6rd\u00c3\u00bcnc\u00c3\u00bc\"\n             , \"4.\"\n             , \"4'\u00c3\u00bcnc\u00c3\u00bc\"\n             ]\n  , examples (OrdinalData 8)\n             [ \"sekizinci\"\n             ]\n  , examples (OrdinalData 23)\n             [ \"yirmi \u00c3\u00bc\u00c3\u00a7\u00c3\u00bcnc\u00c3\u00bc\"\n             ]\n  ]\n", "num_lines": 39}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.TR.Rules\n  ( rules ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Text (Text)\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nordinals :: [Text]\nordinals =\n  [ \"birinci\"\n  , \"ikinci\"\n  , \"\u00c3\u00bc\u00c3\u00a7\u00c3\u00bcnc\u00c3\u00bc\"\n  , \"d\u00c3\u00b6rd\u00c3\u00bcnc\u00c3\u00bc\"\n  , \"be\u00c5\u0178inci\"\n  , \"alt\u00c4\u00b1nc\u00c4\u00b1\"\n  , \"yedinci\"\n  , \"sekizinci\"\n  , \"dokuzuncu\"\n  , \"onuncu\"\n  , \"on birinci\"\n  , \"on ikinci\"\n  , \"on \u00c3\u00bc\u00c3\u00a7\u00c3\u00bcnc\u00c3\u00bc\"\n  , \"on d\u00c3\u00b6rd\u00c3\u00bcnc\u00c3\u00bc\"\n  , \"on be\u00c5\u0178inci\"\n  , \"on alt\u00c4\u00b1nc\u00c4\u00b1\"\n  , \"on yedinci\"\n  , \"on sekizinci\"\n  , \"on dokuzuncu\"\n  , \"yirminci\"\n  , \"yirmi birinci\"\n  , \"yirmi ikinci\"\n  , \"yirmi \u00c3\u00bc\u00c3\u00a7\u00c3\u00bcnc\u00c3\u00bc\"\n  , \"yirmi d\u00c3\u00b6rd\u00c3\u00bcnc\u00c3\u00bc\"\n  , \"yirmi be\u00c5\u0178inci\"\n  , \"yirmi alt\u00c4\u00b1nc\u00c4\u00b1\"\n  , \"yirmi yedinci\"\n  , \"yirmi sekizinci\"\n  , \"yirmi dokuzuncu\"\n  , \"otuzuncu\"\n  , \"otuz birinci\"\n  ]\n\nordinalsHashMap :: HashMap Text Int\nordinalsHashMap = HashMap.fromList $ zip ordinals [1..]\n\nruleOrdinalsFirstst :: Rule\nruleOrdinalsFirstst = Rule\n  { name = \"ordinals (first..31st)\"\n  , pattern =\n    [ regex . Text.unpack $\n        Text.concat [ \"(\", Text.intercalate \"|\" ordinals, \")\" ]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> HashMap.lookup (Text.toLower match) ordinalsHashMap\n      _ -> Nothing\n  }\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"0*(\\\\d+) ?('?)(inci|nci|\u00c4\u00b1nc\u00c4\u00b1|nc\u00c4\u00b1|uncu|ncu|\u00c3\u00bcnc\u00c3\u00bc|nc\u00c3\u00bc|.)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        ordinal <$> parseInt match\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  , ruleOrdinalsFirstst\n  ]\n", "num_lines": 95}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.VI.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Ordinal.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale VI Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (OrdinalData 1)\n             [ \"\u00c4\u2018\u00e1\u00ba\u00a7u ti\u00c3\u00aan\"\n             , \"th\u00e1\u00bb\u00a9 nh\u00e1\u00ba\u00a5t\"\n             , \"th\u00e1\u00bb\u00a9 1\"\n             ]\n  ]\n", "num_lines": 31}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.VI.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.Helpers\nimport Duckling.Types\n\nruleOrdinals :: Rule\nruleOrdinals = Rule\n  { name = \"ordinals\"\n  , pattern =\n    [ regex \"(\u00c4\u2018\u00e1\u00ba\u00a7u ti\u00c3\u00aan|th\u00e1\u00bb\u00a9 nh\u00e1\u00ba\u00a5t|th\u00e1\u00bb\u00a9 1)\"\n    ]\n  , prod = \\_ -> Just $ ordinal 1\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinals\n  ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Ordinal.ZH.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Types (NumeralData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Ordinal.Helpers\nimport Duckling.Types\n\nruleOrdinalDigits :: Rule\nruleOrdinalDigits = Rule\n  { name = \"ordinal (digits)\"\n  , pattern =\n    [ regex \"\u00e7\u00ac\u00ac\"\n    , dimension Numeral\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral NumeralData{TNumeral.value = x}:_) ->\n        Just . ordinal $ floor x\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleOrdinalDigits\n  ]\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.PhoneNumber.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.PhoneNumber.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"12345\"\n      , \"1234567890123456777777\"\n      , \"12345678901234567\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (PhoneNumberValue \"6507018887\")\n             [ \"650-701-8887\"\n             ]\n  , examples (PhoneNumberValue \"(+1) 6507018887\")\n             [ \"(+1)650-701-8887\"\n             , \"(+1)   650 - 701  8887\"\n             , \"(+1) 650-701-8887\"\n             , \"+1 6507018887\"\n             ]\n  , examples (PhoneNumberValue \"(+33) 146647998\")\n             [ \"+33 1 46647998\"\n             ]\n  , examples (PhoneNumberValue \"0620702220\")\n             [ \"06 2070 2220\"\n             ]\n  , examples (PhoneNumberValue \"6507018887 ext 897\")\n             [ \"(650)-701-8887 ext 897\"\n             ]\n  , examples (PhoneNumberValue \"(+1) 2025550121\")\n             [ \"+1-202-555-0121\"\n             , \"+1 202.555.0121\"\n             ]\n  , examples (PhoneNumberValue \"4866827\")\n             [ \"4.8.6.6.8.2.7\"\n             ]\n  , examples (PhoneNumberValue \"06354640807\")\n             [ \"06354640807\"\n             ]\n  , examples (PhoneNumberValue \"18998078030\")\n             [ \"18998078030\"\n             ]\n  , examples (PhoneNumberValue \"61992852776\")\n             [ \"61 - 9 9285-2776\"\n             ]\n  , examples (PhoneNumberValue \"19997424919\")\n             [ \"(19) 997424919\"\n             ]\n  , examples (PhoneNumberValue \"(+55) 19992842606\")\n             [ \"+55 19992842606\"\n             ]\n  ]\n", "num_lines": 76}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.PhoneNumber.Rules\n  ( rules ) where\n\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.PhoneNumber.Types (PhoneNumberData(..))\nimport qualified Duckling.PhoneNumber.Types as TPhoneNumber\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nrulePhoneNumber :: Rule\nrulePhoneNumber = Rule\n  { name = \"phone number\"\n  , pattern =\n    -- We somewhat arbitrarly use 20 here to limit the length of matches,\n    -- otherwise due to backtracking the regexp will take very long time\n    -- or run out of stack for some inputs.\n    [ regex $\n        \"(?:\\\\(?\\\\+(\\\\d{1,2})\\\\)?[\\\\s-\\\\.]*)?\" ++ -- area code\n        \"((?=[-\\\\d()\\\\s\\\\.]{6,16}(?:\\\\s*e?xt?\\\\.?\\\\s*(?:\\\\d{1,20}))?(?:[^\\\\d]+|$))(?:[\\\\d(]{1,20}(?:[-)\\\\s\\\\.]*\\\\d{1,20}){0,20}){1,20})\" ++ -- nums\n        \"(?:\\\\s*e?xt?\\\\.?\\\\s*(\\\\d{1,20}))?\" -- extension\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (code:nums:ext:_)):_) ->\n        let parseNum x = toInteger <$> parseInt x\n            mcode = parseNum code\n            mext = parseNum ext\n            cleanup = Text.filter (not . isWhitespace)\n            isWhitespace x = elem x ['.', ' ', '-', '\\t', '(', ')']\n        in Just . Token PhoneNumber $ PhoneNumberData\n          { TPhoneNumber.prefix = mcode\n          , TPhoneNumber.number = cleanup nums\n          , TPhoneNumber.extension = mext\n          }\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules = [ rulePhoneNumber ]\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.PhoneNumber.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Monoid\nimport Data.Text (Text)\nimport qualified Data.Text as Text\nimport GHC.Generics\nimport qualified TextShow as TS\n\nimport Prelude\n\nimport Duckling.Resolve (Resolve(..))\n\ndata PhoneNumberData = PhoneNumberData\n  { prefix :: Maybe Integer\n  , number :: Text\n  , extension :: Maybe Integer\n  }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve PhoneNumberData where\n  type ResolvedValue PhoneNumberData = PhoneNumberValue\n  resolve _ _ PhoneNumberData {prefix, number, extension} = Just\n    (PhoneNumberValue {value = Text.concat [p, number, e]}, False)\n    where\n      p = case prefix of\n        Just p -> \"(+\" <> TS.showt p <> \") \"\n        Nothing -> \"\"\n      e = case extension of\n        Just e -> \" ext \" <> TS.showt e\n        Nothing -> \"\"\n\ndata PhoneNumberValue = PhoneNumberValue { value :: Text }\n  deriving (Eq, Ord, Show)\n\ninstance ToJSON PhoneNumberValue where\n  toJSON (PhoneNumberValue value) = object\n    [ \"value\" .= value\n    , \"type\"  .= (\"value\" :: Text)\n    ]\n", "num_lines": 57}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.PhoneNumber.PT.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.PhoneNumber.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (PhoneNumberValue \"6502834757 ext 897\")\n             [ \"(650)-283-4757 ramal 897\"\n             ]\n  ]\n", "num_lines": 31}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.PhoneNumber.PT.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.PhoneNumber.Types (PhoneNumberData(..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.PhoneNumber.Types as TPhoneNumber\n\nrulePhoneNumber :: Rule\nrulePhoneNumber = Rule\n  { name = \"phone number\"\n  , pattern =\n    -- We somewhat arbitrarly use 20 here to limit the length of matches,\n    -- otherwise due to backtracking the regexp will take very long time\n    -- or run out of stack for some inputs.\n    [ regex $\n        \"(?:\\\\(?\\\\+(\\\\d{1,2})\\\\)?[\\\\s-\\\\.]*)?\" ++ -- area code\n        \"((?=[-\\\\d()\\\\s\\\\.]{6,16}(?:\\\\s*ramal\\\\.?\\\\s*(?:\\\\d{1,20}))?(?:[^\\\\d]+|$))(?:[\\\\d(]{1,20}(?:[-)\\\\s\\\\.]*\\\\d{1,20}){0,20}){1,20})\" ++ -- nums\n        \"(?:\\\\s*ramal\\\\.?\\\\s*(\\\\d{1,20}))?\" -- extension\n    ]\n  , prod = \\xs -> case xs of\n      (Token RegexMatch (GroupMatch (code:nums:ext:_)):_) ->\n        let parseNum x = toInteger <$> parseInt x\n            mcode = parseNum code\n            mext = parseNum ext\n            cleanup = Text.filter (not . isWhitespace)\n            isWhitespace x = elem x ['.', ' ', '-', '\\t', '(', ')']\n        in Just . Token PhoneNumber $ PhoneNumberData\n          { TPhoneNumber.prefix = mcode\n          , TPhoneNumber.number = cleanup nums\n          , TPhoneNumber.extension = mext\n          }\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ rulePhoneNumber\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Quantity.Helpers\n  ( getValue\n  , isSimpleQuantity\n  , quantity\n  , unitOnly\n  , valueOnly\n  , withProduct\n  , withUnit\n  , withValue\n  , withInterval\n  , withMin\n  , withMax\n  , mkLatent\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.Types (QuantityData(..))\nimport Duckling.Types\nimport qualified Duckling.Quantity.Types as TQuantity\n\ngetValue :: HashMap Text (Double -> Double) -> Text -> Double -> Double\ngetValue opsMap match = HashMap.lookupDefault id (Text.toLower match) opsMap\n\n-- -----------------------------------------------------------------\n-- Patterns\n\nisSimpleQuantity :: Predicate\nisSimpleQuantity (Token Quantity QuantityData {TQuantity.unit = Just _\n                                              , TQuantity.value = Just _})\n = True\nisSimpleQuantity _ = False\n\n-- -----------------------------------------------------------------\n-- Production\n\nquantity :: TQuantity.Unit -> Double -> QuantityData\nquantity u v = QuantityData {TQuantity.unit = Just u\n                            , TQuantity.value = Just v\n                            , TQuantity.aproduct = Nothing\n                            , TQuantity.minValue = Nothing\n                            , TQuantity.maxValue = Nothing\n                            , TQuantity.latent = False}\n\nunitOnly :: TQuantity.Unit -> QuantityData\nunitOnly u = QuantityData {TQuantity.unit = Just u\n                          , TQuantity.value = Nothing\n                          , TQuantity.aproduct = Nothing\n                          , TQuantity.minValue = Nothing\n                          , TQuantity.maxValue = Nothing\n                          , TQuantity.latent = False}\n\nvalueOnly :: Double -> QuantityData\nvalueOnly v = QuantityData {TQuantity.unit = Nothing\n                          , TQuantity.value = Just v\n                          , TQuantity.aproduct = Nothing\n                          , TQuantity.minValue = Nothing\n                          , TQuantity.maxValue = Nothing\n                          , TQuantity.latent = False}\n\nwithProduct :: Text -> QuantityData -> QuantityData\nwithProduct p qd = qd {TQuantity.aproduct = Just p}\n\nwithUnit :: TQuantity.Unit -> QuantityData -> QuantityData\nwithUnit u qd = qd {TQuantity.unit = Just u}\n\nwithValue :: Double -> QuantityData -> QuantityData\nwithValue value qd = qd {TQuantity.value = Just value}\n\nwithInterval :: (Double, Double) -> QuantityData -> QuantityData\nwithInterval (from, to) qd = qd {minValue = Just from, maxValue = Just to}\n\nwithMin :: Double -> QuantityData -> QuantityData\nwithMin from qd = qd {minValue = Just from}\n\nwithMax :: Double -> QuantityData -> QuantityData\nwithMax to qd = qd {maxValue = Just to}\n\nmkLatent :: QuantityData -> QuantityData\nmkLatent qd = qd {TQuantity.latent = True}\n", "num_lines": 95}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Duckling.Quantity.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport qualified Data.HashMap.Strict as H\nimport Data.Hashable\nimport Data.Text (Text)\nimport qualified Data.Text as Text\nimport Duckling.Resolve\n  ( Resolve(..)\n  , Options(..)\n  )\nimport GHC.Generics\nimport Prelude\n\ndata Unit\n  = Bowl\n  | Cup\n  | Custom Text\n  | Dish\n  | Gram\n  | Ounce\n  | Pint\n  | Pound\n  | Quart\n  | Tablespoon\n  | Teaspoon\n  | Unnamed\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance ToJSON Unit where\n  toJSON (Custom x) = String $ Text.toLower x\n  toJSON x = String . Text.toLower . Text.pack $ show x\n\ndata QuantityData = QuantityData\n  { unit :: Maybe Unit\n  , value :: Maybe Double\n  , aproduct :: Maybe Text\n  , minValue :: Maybe Double\n  , maxValue :: Maybe Double\n  , latent :: Bool\n  } deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve QuantityData where\n  type ResolvedValue QuantityData = QuantityValue\n  resolve _ Options {withLatent = False} QuantityData {latent = True}\n   = Nothing\n\n  resolve _ _ QuantityData {value = Just value\n                         , unit = Nothing\n                         , aproduct = aproduct\n                         , latent = latent}\n   = Just (simple Unnamed value aproduct, latent)\n\n  resolve _ _ QuantityData {value = Just value\n                         , unit = Just unit\n                         , aproduct = aproduct\n                         , latent = latent}\n   = Just (simple unit value aproduct, latent)\n\n  resolve _ _ QuantityData {value = Nothing\n                         , unit = Just unit\n                         , aproduct = aproduct\n                         , minValue = Just from\n                         , maxValue = Just to\n                         , latent = latent}\n   = Just (between unit (from, to) aproduct, latent)\n\n  resolve _ _ QuantityData {value = Nothing\n                         , unit = Just unit\n                         , aproduct = aproduct\n                         , minValue = Just from\n                         , maxValue = Nothing\n                         , latent = latent}\n   = Just (above unit from aproduct, latent)\n\n  resolve _ _ QuantityData {value = Nothing\n                         , unit = Just unit\n                         , aproduct = aproduct\n                         , minValue = Nothing\n                         , maxValue = Just to\n                         , latent = latent}\n   = Just (under unit to aproduct, latent)\n\n  resolve _ _ _ = Nothing\n\ndata IntervalDirection = Above | Under\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ndata SingleValue =\n  SingleValue { vUnit :: Unit, vValue :: Double, vProduct :: Maybe Text }\n    deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance ToJSON SingleValue where\n    toJSON (SingleValue unit value aproduct) = object $\n      [ \"value\" .= value\n      , \"unit\" .= unit\n      ]\n      ++ [ \"product\" .= p | Just p <- [aproduct] ]\n\ndata QuantityValue\n  = SimpleValue SingleValue\n  | IntervalValue (SingleValue, SingleValue)\n  | OpenIntervalValue (SingleValue, IntervalDirection)\n  deriving (Eq, Ord, Show)\n\ninstance ToJSON QuantityValue where\n  toJSON (SimpleValue value) = case toJSON value of\n    Object o -> Object $ H.insert \"type\" (toJSON (\"value\" :: Text)) o\n    _ -> Object H.empty\n  toJSON (IntervalValue (from, to)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    , \"to\" .= toJSON to\n    ]\n  toJSON (OpenIntervalValue (from, Above)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    ]\n  toJSON (OpenIntervalValue (to, Under)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"to\" .= toJSON to\n    ]\n\n-- -----------------------------------------------------------------\n-- Value helpers\n\nsimple :: Unit -> Double -> Maybe Text -> QuantityValue\nsimple u v p = SimpleValue $ single u v p\n\nbetween :: Unit -> (Double, Double) -> Maybe Text -> QuantityValue\nbetween u (from, to) p = IntervalValue (single u from p, single u to p)\n\nabove :: Unit -> Double -> Maybe Text -> QuantityValue\nabove = openInterval Above\n\nunder :: Unit -> Double -> Maybe Text -> QuantityValue\nunder = openInterval Under\n\nopenInterval\n  :: IntervalDirection -> Unit -> Double -> Maybe Text -> QuantityValue\nopenInterval direction u v p = OpenIntervalValue (single u v p, direction)\n\nsingle :: Unit -> Double -> Maybe Text -> SingleValue\nsingle u v p = SingleValue {vUnit = u, vValue = v, vProduct = p}\n", "num_lines": 158}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.AR.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Quantity.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\nquantities :: [(Text, String, TQuantity.Unit)]\nquantities =\n  [ (\"<quantity> cups\", \"(\u00d9\u0192\u00d9\u02c6\u00d8\u00a8(\u00d8\u00a7\u00d9\u2020|\u00d9\u0160\u00d9\u2020)?|[\u00d8\u00a3\u00d8\u00a7]\u00d9\u0192\u00d9\u02c6\u00d8\u00a7\u00d8\u00a8)\", TQuantity.Cup)\n  , (\"<quantity> grams\", \"(((\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6|\u00d9\u2026\u00d9\u0160?\u00d9\u201e\u00d9\u0160?) ?)?((\u00d8\u00ba|\u00d8\u00ac)\u00d8\u00b1\u00d8\u00a7\u00d9\u2026(\u00d8\u00a7\u00d8\u00aa|\u00d9\u0160\u00d9\u2020|\u00d8\u00a7\u00d9\u2020)?)|\u00d9\u0192(\u00d8\u00ba|\u00d8\u00ac)\u00d9\u2026?|\u00d9\u2026\u00d9\u201e(\u00d8\u00ba|\u00d8\u00ac)|(\u00d8\u00ba|\u00d8\u00ac)\u00d9\u2026)\", TQuantity.Gram)\n  , (\"<quantity> lb\", \"(\u00d8\u00a8\u00d8\u00a7\u00d9\u02c6\u00d9\u2020\u00d8\u00af(\u00d8\u00a7\u00d9\u2020|\u00d9\u0160\u00d9\u2020)?)\", TQuantity.Pound)\n  , (\"<quantity> oz\", \"([\u00d8\u00a3\u00d8\u00a7]\u00d9\u02c6\u00d9\u2020\u00d8\u00b5([\u00d8\u00a9\u00d9\u2021]|\u00d8\u00aa\u00d8\u00a7\u00d9\u2020|\u00d8\u00aa\u00d9\u0160\u00d9\u2020|\u00d8\u00a7\u00d8\u00aa))\", TQuantity.Ounce)\n  ]\n\nopsMap :: HashMap Text (Double -> Double)\nopsMap = HashMap.fromList\n  [ ( \"\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (* 2))\n  , ( \"\u00d9\u0192\u00d9\u02c6\u00d8\u00a8\u00d8\u00a7\u00d9\u2020\", (* 2))\n  , ( \"\u00d9\u0192\u00d9\u02c6\u00d8\u00a8\u00d9\u0160\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00a8\u00d8\u00a7\u00d9\u02c6\u00d9\u2020\u00d8\u00af\u00d8\u00a7\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00a8\u00d8\u00a7\u00d9\u02c6\u00d9\u2020\u00d8\u00af\u00d9\u0160\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00a7\u00d9\u02c6\u00d9\u2020\u00d8\u00b5\u00d8\u00aa\u00d8\u00a7\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00a7\u00d9\u02c6\u00d9\u2020\u00d8\u00b5\u00d8\u00aa\u00d9\u0160\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00a3\u00d9\u02c6\u00d9\u2020\u00d8\u00b5\u00d8\u00aa\u00d8\u00a7\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00a3\u00d9\u02c6\u00d9\u2020\u00d8\u00b5\u00d8\u00aa\u00d9\u0160\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (* 2))\n  , ( \"\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (* 2))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (/ 500))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (/ 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (* 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (* 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u201e\u00d8\u00ba\", (/ 1000))\n  , ( \"\u00d9\u0192\u00d8\u00ba\", (* 1000))\n  , ( \"\u00d9\u0192\u00d8\u00ba\u00d9\u2026\", (* 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d9\u0160\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (/ 1000))\n  , ( \"\u00d9\u2026\u00d9\u0160\u00d9\u201e\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (/ 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (* 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (* 1000))\n  , ( \"\u00d9\u2026\u00d9\u201e\u00d8\u00ac\", (/ 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (* 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\", (* 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (* 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d8\u00aa\", (* 1000))\n  , ( \"\u00d9\u0192\u00d8\u00ac\", (* 1000))\n  , ( \"\u00d9\u0192\u00d8\u00ac\u00d9\u2026\", (* 1000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (* 2000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (* 2000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (* 2000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ba\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (* 2000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (* 2000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6\u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (* 2000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d8\u00a7\u00d9\u2020\", (* 2000))\n  , ( \"\u00d9\u0192\u00d9\u0160\u00d9\u201e\u00d9\u02c6 \u00d8\u00ac\u00d8\u00b1\u00d8\u00a7\u00d9\u2026\u00d9\u0160\u00d9\u2020\", (* 2000))\n  ]\n\nruleNumeralQuantities :: [Rule]\nruleNumeralQuantities = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [ numberWith TNumeral.value (> 0), regex regexPattern ]\n      , prod = \\tokens -> case tokens of\n        (Token Numeral nd:\n         Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just . Token Quantity $ quantity u value\n          where value = getValue opsMap match $ TNumeral.value nd\n        _ -> Nothing\n      }\n\nruleAQuantity :: [Rule]\nruleAQuantity = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [ regex regexPattern ]\n      , prod = \\tokens -> case tokens of\n        (Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just . Token Quantity $ quantity u $ getValue opsMap match 1\n        _ -> Nothing\n      }\n\nruleQuantityOfProduct :: Rule\nruleQuantityOfProduct = Rule\n  { name = \"<quantity> of product\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"\u00d9\u2026\u00d9\u2020 ([\u00d8\u00a1-\u00d9\u0160]+)\"\n    ]\n  , prod = \\tokens -> case tokens of\n    (Token Quantity qd:Token RegexMatch (GroupMatch (product:_)):_) ->\n      Just . Token Quantity $ withProduct product qd\n    _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleQuantityOfProduct\n  ]\n  ++ ruleNumeralQuantities\n  ++ ruleAQuantity\n", "num_lines": 147}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.EN.Corpus\n  ( corpus\n  , latentCorpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Quantity.Types\nimport Duckling.Resolve (Options(..))\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\n\nlatentCorpus :: Corpus\nlatentCorpus = (testContext, testOptions {withLatent = True}, latentExamples)\n  where\n    latentExamples = concat\n      [\n      examples (simple Unnamed 4 Nothing)\n                [ \"around 4\"\n                , \"four\"\n                , \"~ four\"\n                ]\n      ,\n      examples (simple Unnamed 38.5 Nothing)\n                [ \"about 38.5\"\n                ]\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Pound 2 (Just \"meat\"))\n             [ \"two pounds of meat\"\n             ]\n  , examples (simple Gram 2 Nothing)\n             [ \"2 grams\"\n             , \"0.002 kg\"\n             , \"2 g.\"\n             , \"2 gs\"\n             , \"2/1000 kilograms\"\n             , \"2000 milligrams\"\n             , \"2,000 milligrams\"\n             ]\n  , examples (simple Gram 1000 Nothing)\n             [ \"a kilogram\"\n             , \"a kg\"\n             , \"1 k.g.\"\n             , \"1 k.gs\"\n             , \"1000 gs\"\n             ]\n  , examples (simple Pound 1 Nothing)\n             [ \"a Pound\"\n             , \"1 lb\"\n             , \"a lb\"\n             ]\n  , examples (simple Ounce 2 Nothing)\n             [ \"2 ounces\"\n             , \"2oz\"\n             ]\n  , examples (simple Cup 3 (Just \"sugar\"))\n             [ \"3 Cups of sugar\"\n             , \"3 Cups of SugAr\"\n             ]\n  , examples (simple Cup 0.75 Nothing)\n             [ \"3/4 cup\"\n             , \"0.75 cup\"\n             , \".75 cups\"\n             ]\n  , examples (simple Gram 500 (Just \"strawberries\"))\n             [ \"500 grams of strawberries\"\n             , \"500g of strawberries\"\n             , \"0.5 kilograms of strawberries\"\n             , \"0.5 kg of strawberries\"\n             , \"500000mg of strawberries\"\n             ]\n  , examples (between Gram (100,1000) (Just \"strawberries\"))\n              [ \"100-1000 gram of strawberries\"\n              , \"between 100 and 1000 grams of strawberries\"\n              , \"from 100 to 1000 g of strawberries\"\n              , \"100 - 1000 g of strawberries\"\n              ]\n  , examples (between Gram (2,7) Nothing)\n              [ \"around 2 -7 g\"\n              , \"~2-7 grams\"\n              , \"from 2 to 7 g\"\n              , \"between 2.0 g and about 7.0 g\"\n              , \"between 0.002 kg and about 0.007 kg\"\n              , \"2 - ~7 grams\"\n              ]\n  , examples (under Pound 6 (Just \"meat\"))\n              [ \"less than six pounds of meat\"\n              , \"no more than 6 lbs of meat\"\n              , \"below 6.0 pounds of meat\"\n              , \"at most six pounds of meat\"\n              ]\n  , examples (above Cup 2 Nothing)\n              [ \"exceeding 2 Cups\"\n              , \"at least two Cups\"\n              , \"over 2 Cups\"\n              , \"more than 2 Cups\"\n              ]\n  , examples (above Ounce 4 (Just \"chocolate\"))\n              [ \"exceeding 4 oz of chocolate\"\n              , \"at least 4.0 oz of chocolate\"\n              , \"over four ounces of chocolate\"\n              , \"more than four ounces of chocolate\"\n              ]\n  ]\n", "num_lines": 121}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Duckling.Quantity.EN.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Quantity.Helpers\nimport Duckling.Regex.Types (GroupMatch(..))\nimport Duckling.Types\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Quantity.Types (QuantityData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\nquantities :: [(Text, String, TQuantity.Unit)]\nquantities =\n  [ (\"<quantity> cups\", \"(cups?)\", TQuantity.Cup)\n  , (\"<quantity> grams\", \"(((m(illi)?[.]?)|(k(ilo)?)[.]?)?g(ram)?s?[.]?)[.]?\", TQuantity.Gram)\n  , (\"<quantity> lb\", \"((lb|pound)s?)\", TQuantity.Pound)\n  , (\"<quantity> oz\", \"((ounces?)|oz)\", TQuantity.Ounce)\n  ]\n\nopsMap :: HashMap Text (Double -> Double)\nopsMap = HashMap.fromList\n  [ ( \"milligram\" , (/ 1000))\n  , ( \"milligrams\", (/ 1000))\n  , ( \"mg\"        , (/ 1000))\n  , ( \"mgs\"       , (/ 1000))\n  , ( \"m.g\"       , (/ 1000))\n  , ( \"m.gs\"      , (/ 1000))\n  , ( \"m.g.\"      , (/ 1000))\n  , ( \"m.g.s\"     , (/ 1000))\n  , ( \"kilogram\"  , (* 1000))\n  , ( \"kilograms\" , (* 1000))\n  , ( \"kg\"        , (* 1000))\n  , ( \"kgs\"       , (* 1000))\n  , ( \"k.g\"       , (* 1000))\n  , ( \"k.gs\"      , (* 1000))\n  , ( \"k.g.\"      , (* 1000))\n  , ( \"k.g.s\"     , (* 1000))\n  ]\n\nruleNumeralQuantities :: [Rule]\nruleNumeralQuantities = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [Predicate isPositive, regex regexPattern]\n      , prod = \\case\n        (Token Numeral nd:\n         Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just . Token Quantity $ quantity u value\n          where value = getValue opsMap match $ TNumeral.value nd\n        _ -> Nothing\n      }\n\nruleAQuantity :: [Rule]\nruleAQuantity = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [ regex (\"an? \" ++ regexPattern) ]\n      , prod = \\case\n        (Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just . Token Quantity $ quantity u $ getValue opsMap match 1\n        _ -> Nothing\n      }\n\nruleQuantityOfProduct :: Rule\nruleQuantityOfProduct = Rule\n  { name = \"<quantity> of product\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"of (\\\\w+)\"\n    ]\n  , prod = \\case\n    (Token Quantity qd:Token RegexMatch (GroupMatch (product:_)):_) ->\n      Just . Token Quantity $ withProduct (Text.toLower product) qd\n    _ -> Nothing\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n    { name = \"about|exactly <quantity>\"\n    , pattern =\n      [ regex \"\\\\~|exactly|precisely|about|approx(\\\\.|imately)?|close to|near( to)?|around|almost\"\n      , dimension Quantity\n      ]\n      , prod = \\case\n        (_:token:_) -> Just token\n        _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n    { name = \"between|from <numeral> and|to <quantity>\"\n    , pattern =\n      [ regex \"between|from\"\n      , Predicate isPositive\n      , regex \"to|and\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Numeral NumeralData{TNumeral.value = from}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to ->\n          Just . Token Quantity . withInterval (from, to) $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n    { name = \"between|from <quantity> to|and <quantity>\"\n    , pattern =\n      [ regex \"between|from\"\n      , Predicate isSimpleQuantity\n      , regex \"and|to\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u1\n                                    , TQuantity.aproduct = Nothing}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u2\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to && u1 == u2 ->\n          Just . Token Quantity . withInterval (from, to) $ unitOnly u1\n        _ -> Nothing\n    }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n    { name = \"<numeral> - <quantity>\"\n    , pattern =\n      [ Predicate isPositive\n      , regex \"\\\\-\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (Token Numeral NumeralData{TNumeral.value = from}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to ->\n           Just . Token Quantity . withInterval (from, to) $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n    { name = \"<quantity> - <quantity>\"\n    , pattern =\n      [ Predicate isSimpleQuantity\n      , regex \"\\\\-\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u1\n                                    , TQuantity.aproduct = Nothing}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u2\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to && u1 == u2 ->\n          Just . Token Quantity . withInterval (from, to) $ unitOnly u1\n        _ -> Nothing\n    }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n    { name = \"under/below/less/lower/at most/no more than <dist>\"\n    , pattern =\n      [ regex \"under|below|at most|(less|lower|not? more) than\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) -> Just . Token Quantity . withMax to $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/exceeding/beyond/at least/more than <quantity>\"\n  , pattern =\n      [ regex \"over|above|exceeding|beyond|at least|(more|larger|bigger|heavier) than\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) -> Just . Token Quantity . withMin from $ unitOnly u\n        _ -> Nothing\n    }\n\nruleQuantityLatent :: Rule\nruleQuantityLatent = Rule\n  { name = \"<quantity> (latent)\"\n  , pattern =\n    [ Predicate isPositive\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}: _) ->\n        Just $ (Token Quantity . mkLatent) $ valueOnly v\n      _ -> Nothing\n  }\n\n\nrules :: [Rule]\nrules =\n  [ ruleQuantityOfProduct\n  , ruleIntervalMin\n  , ruleIntervalMax\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , rulePrecision\n  , ruleQuantityLatent\n  ]\n  ++ ruleNumeralQuantities\n  ++ ruleAQuantity\n", "num_lines": 257}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.ES.Corpus\n  ( corpus\n  ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Quantity.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext { locale = makeLocale ES Nothing }\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Pound 2 (Just \"carne\"))\n             [ \"dos libras de carne\"\n             ]\n  , examples (simple Gram 2 Nothing)\n             [ \"dos gramos\"\n             , \"0,002 kg\"\n             , \"2/1000 kilogramos\"\n             , \"2000 miligramos\"\n             ]\n  , examples (simple Gram 1000 Nothing)\n             [ \"un kilogramo\"\n             , \"un kg\"\n             ]\n  , examples (simple Pound 1 Nothing)\n             [ \"una libra\"\n             , \"1 lb\"\n             , \"una lb\"\n             ]\n  , examples (simple Ounce 2 Nothing)\n             [ \"2 onzas\"\n             , \"2oz\"\n             ]\n  , examples (simple Cup 3 (Just \"azucar\"))\n             [ \"tres tazas de azucar\"\n             , \"3 tazas de AzUcAr\"\n             ]\n  , examples (simple Cup 0.75 Nothing)\n             [ \"3/4 taza\"\n             , \"0,75 taza\"\n             , \",75 tazas\"\n             ]\n  , examples (simple Gram 500 (Just \"fresas\"))\n             [ \"500 gramos de fresas\"\n             , \"500g de fresas\"\n             , \"0,5 kilogramos de fresas\"\n             , \"0,5 kg de fresas\"\n             , \"500000mg de fresas\"\n             ]\n  , examples (under Pound 6 (Just \"carne\"))\n              [ \"menos que seis libras de carne\"\n              , \"no m\u00c3\u00a1s que 6 lbs de carne\"\n              , \"por debajo de 6,0 libras de carne\"\n              , \"a lo sumo seis libras de carne\"\n              ]\n  , examples (above Cup 2 Nothing)\n              [ \"excesivo 2 tazas\"\n              , \"como m\u00c3\u00adnimo dos tazas\"\n              , \"mayor de 2 tazas\"\n              , \"m\u00c3\u00a1s de 2 tazas\"\n              ]\n  , examples (above Ounce 4 (Just \"chocolate\"))\n              [ \"excesivo 4 oz de chocolate\"\n              , \"al menos 4,0 oz de chocolate\"\n              , \"mayor de cuatro onzas de chocolate\"\n              , \"m\u00c3\u00a1s de cuatro onzas de chocolate\"\n              ]\n  ]\n", "num_lines": 87}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Duckling.Quantity.ES.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Quantity.Helpers\nimport Duckling.Regex.Types (GroupMatch(..))\nimport Duckling.Types\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Quantity.Types (QuantityData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\n-- Our quantities: (name, regex, quantityType). Please make sure to wrap\n-- each regex in parentheses, because we extend these regexes later with\n-- articles (un/una).\nquantities :: [(Text, String, TQuantity.Unit)]\nquantities =\n  [ (\"<quantity> bowls\", \"(bol(es)?|taz\u00c3\u00b3n(es)?|cuencos?|platos? (soperos?)|(hondos?))\", TQuantity.Bowl)\n  , (\"<quantity> cups\", \"(tazas?)\", TQuantity.Cup)\n  , (\"<quantity> dishes\", \"(platos?|fuentes?)\", TQuantity.Dish)\n  , (\"<quantity> grams\", \"(((m(ili)?)|(k(ilo)?))?g(ramo)?s?)\", TQuantity.Gram)\n  , (\"<quantity> ounces\", \"((onzas?)|oz)\", TQuantity.Ounce)\n  , (\"<quantity> pints\", \"(pintas?)\", TQuantity.Pint)\n  , (\"<quantity> pounds\", \"((lb|libra)s?)\", TQuantity.Pound)\n  , (\"<quantity> quarts\", \"(cuartos? de gal\u00c3\u00b3n)\", TQuantity.Quart)\n  , (\"<quantity> tablespoons\", \"(cucharadas? (grande)?)\", TQuantity.Tablespoon)\n  , (\"<quantity> teaspoons\", \"(cucharaditas?)\", TQuantity.Teaspoon)\n  ]\n\nopsMap :: HashMap Text (Double -> Double)\nopsMap = HashMap.fromList\n  [ ( \"miligram\"   , (/ 1000))\n  , ( \"miligramos\" , (/ 1000))\n  , ( \"mg\"         , (/ 1000))\n  , ( \"mgs\"        , (/ 1000))\n  , ( \"kilogramo\"  , (* 1000))\n  , ( \"kilogramos\" , (* 1000))\n  , ( \"kg\"         , (* 1000))\n  , ( \"kgs\"        , (* 1000))\n  ]\n\nruleNumeralQuantities :: [Rule]\nruleNumeralQuantities = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (nm, regexPattern, u) = Rule\n      { name = nm\n      , pattern = [Predicate isPositive, regex regexPattern]\n      , prod = \\case\n        (Token Numeral nd:\n         Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just $ Token Quantity $ quantity u val\n          where val = getValue opsMap match $ TNumeral.value nd\n        _ -> Nothing\n      }\n\n-- Quantities prefixed by \"un\" or \"una\"\nruleAQuantity :: [Rule]\nruleAQuantity = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (nm, regexPattern, u) = Rule\n      { name = nm\n      , pattern = [ regex (\"una? \" ++ regexPattern) ]\n      , prod = \\case\n        (Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just $ Token Quantity $ quantity u $ getValue opsMap match 1\n        _ -> Nothing\n      }\n\nruleQuantityOfProduct :: Rule\nruleQuantityOfProduct = Rule\n  { name = \"<quantity> de producto\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"de (\\\\w+)\"\n    ]\n  , prod = \\case\n    (Token Quantity qd:Token RegexMatch (GroupMatch (prdct:_)):_) ->\n      Just $ Token Quantity $ withProduct (Text.toLower prdct) qd\n    _ -> Nothing\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n    { name = \"about|exactly <quantity>\"\n    , pattern =\n      [ regex \"exactamente|precisamente|a?cerca( de)?|aproximadamente|casi\"\n      , dimension Quantity\n      ]\n      , prod = \\case\n        (_:tkn:_) -> Just tkn\n        _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n    { name = \"between|from <numeral> and|to <quantity>\"\n    , pattern =\n      [ regex \"entre|de\"\n      , Predicate isPositive\n      , regex \"a|y\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Numeral NumeralData{TNumeral.value = from}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to ->\n          Just $ Token Quantity $ withInterval (from, to) $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n    { name = \"between|from <quantity> to|and <quantity>\"\n    , pattern =\n      [ regex \"entre/de\"\n      , Predicate isSimpleQuantity\n      , regex \"a/y\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u1\n                                    , TQuantity.aproduct = Nothing}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u2\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to && u1 == u2 ->\n          Just $ Token Quantity $ withInterval (from, to) $ unitOnly u1\n        _ -> Nothing\n    }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n    { name = \"<numeral> - <quantity>\"\n    , pattern =\n      [ Predicate isPositive\n      , regex \"\\\\-\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (Token Numeral NumeralData{TNumeral.value = from}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to ->\n           Just $ Token Quantity $ withInterval (from, to) $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n    { name = \"<quantity> - <quantity>\"\n    , pattern =\n      [ Predicate isSimpleQuantity\n      , regex \"\\\\-\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u1\n                                    , TQuantity.aproduct = Nothing}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u2\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to && u1 == u2 ->\n          Just $ Token Quantity $ withInterval (from, to) $ unitOnly u1\n        _ -> Nothing\n    }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n    { name = \"under/below/less/lower/at most/no more than <dist>\"\n    , pattern =\n      [ regex \"no m(\u00c3\u00a1|a)s que|menos de|por debajo de|como mucho|como m(\u00c3\u00a1|a)xim(o|a)|a lo sumo|menos (que|de)\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) -> Just $ Token Quantity $ withMax to $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/exceeding/beyond/at least/more than <quantity>\"\n  , pattern =\n      [ regex \"(?<!no )m(\u00c3\u00a1|a)s( grande| pesado)? (de|que)|mayor de|por encima de|excesivo|fuera de|por lo menos|como m(\u00c3\u00ad|i)nim(o|a)|al menos\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) -> Just $ Token Quantity $ withMin from $ unitOnly u\n        _ -> Nothing\n    }\n\nruleQuantityLatent :: Rule\nruleQuantityLatent = Rule\n  { name = \"<quantity> (latent)\"\n  , pattern =\n    [ Predicate isPositive\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData{TNumeral.value = v}: _) ->\n        Just $ Token Quantity $ mkLatent $ valueOnly v\n      _ -> Nothing\n  }\n\n\nrules :: [Rule]\nrules =\n  [ ruleQuantityOfProduct\n  , ruleIntervalMin\n  , ruleIntervalMax\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , rulePrecision\n  , ruleQuantityLatent\n  ]\n  ++ ruleNumeralQuantities\n  ++ ruleAQuantity\n", "num_lines": 259}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.FR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Quantity.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Cup 2 (Just \"caf\u00c3\u00a9\"))\n             [ \"2 tasses de caf\u00c3\u00a9\"\n             ]\n  , examples (simple Cup 1 Nothing)\n             [ \"une Tasse\"\n             ]\n  , examples (simple Tablespoon 3 (Just \"sucre\"))\n             [ \"3 Cuill\u00c3\u00a8res \u00c3\u00a0 soupe de sucre\"\n             ]\n  ]\n", "num_lines": 36}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.FR.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.Helpers\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\nruleNumeralUnits :: Rule\nruleNumeralUnits = Rule\n  { name = \"<number> <units>\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"(tasses?|cuill?(e|\u00c3\u00a8)res? (a|\u00c3\u00a0) soupe?)\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData {TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"tasse\"  -> Just . Token Quantity $ quantity TQuantity.Cup v\n         \"tasses\" -> Just . Token Quantity $ quantity TQuantity.Cup v\n         _        -> Just . Token Quantity $ quantity TQuantity.Tablespoon v\n      _ -> Nothing\n  }\n\nruleQuantityOfProduct :: Rule\nruleQuantityOfProduct = Rule\n  { name = \"<quantity> of product\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"de (caf(e|\u00c3\u00a9)|sucre)\"\n    ]\n  , prod = \\case\n      (Token Quantity qd:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> Just . Token Quantity $ withProduct match qd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNumeralUnits\n  , ruleQuantityOfProduct\n  ]\n", "num_lines": 64}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.HR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Quantity.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Gram 2000 (Just \"meso\"))\n             [ \"dvije kile mesa\"\n             , \"dva kilograma mesa\"\n             ]\n  , examples (simple Gram 1000 Nothing)\n             [ \"1 kilograma\"\n             ]\n  ]\n", "num_lines": 33}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.HR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Quantity.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\nruleNumberUnits :: Rule\nruleNumberUnits = Rule\n  { name = \"<number> <units>\"\n  , pattern =\n    [ dimension Numeral\n    , regex \"k(il(o|e|a))?(g(rama?)?)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData {TNumeral.value = v}:_) ->\n        Just . Token Quantity $ quantity TQuantity.Gram (1000 * v)\n      _ -> Nothing\n  }\n\nruleQuantityProduct :: Rule\nruleQuantityProduct = Rule\n  { name = \"<quantity> product\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"(mes(o|a)|soli?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Quantity qd:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"meso\" -> Just . Token Quantity $ withProduct \"meso\" qd\n         \"mesa\" -> Just . Token Quantity $ withProduct \"meso\" qd\n         \"sol\" -> Just . Token Quantity $ withProduct \"sol\" qd\n         \"soli\" -> Just . Token Quantity $ withProduct \"sol\" qd\n         _      -> Nothing\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNumberUnits\n  , ruleQuantityProduct\n  ]\n", "num_lines": 62}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.MN.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Quantity.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale MN Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Pound 2 Nothing)\n             [ \"2 \u00d1\u201e\u00d1\u0192\u00d0\u00bd\u00d1\u201a\"\n             ]\n  , examples (simple Gram 2 Nothing)\n             [ \"2 \u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc\"\n             , \"\u00d1\u2026\u00d0\u00be\u00d1\u2018\u00d1\u20ac \u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc\"\n             , \"2000 \u00d0\u00bc\u00d0\u00b8\u00d0\u00bb\u00d0\u00bb\u00d0\u00b8\u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc\"\n             , \"2000 \u00d0\u00bc\u00d0\u00b3\"\n             ]\n  , examples (simple Gram 1000 Nothing)\n             [ \"\u00d0\u00ba\u00d0\u00b8\u00d0\u00bb\u00d0\u00be\u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc\"\n             , \"\u00d0\u00ba\u00d0\u00b3\"\n             ]\n  , examples (simple Gram 2000 Nothing)\n             [ \"2 \u00d0\u00ba\u00d0\u00b8\u00d0\u00bb\u00d0\u00be\u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc\"\n             , \"2 \u00d0\u00ba\u00d0\u00b3\"\n             , \"2000 \u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc\"\n             ]\n  , examples (simple Pound 1 Nothing)\n             [ \"\u00d1\u201e\u00d1\u0192\u00d0\u00bd\u00d1\u201a\"\n             , \"1 \u00d1\u201e\u00d1\u0192\u00d0\u00bd\u00d1\u201a\"\n             ]\n  , examples (simple Ounce 2 Nothing)\n             [ \"2 \u00d1\u0192\u00d0\u00bd\u00d1\u2020\"\n             ]\n  , examples (simple Gram 500 Nothing)\n             [ \"500 \u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc\"\n             , \"500\u00d0\u00b3\"\n             , \"500 \u00d0\u00b3\"\n             , \"0.5 \u00d0\u00ba\u00d0\u00b3\"\n             ]\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.MN.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Quantity.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\nquantities :: [(Text, String, TQuantity.Unit, Double -> Double)]\nquantities =\n  [ (\"<quantity> milligrams\", \"(\u00d0\u00bc\u00d0\u00b3|\u00d0\u00bc\u00d0\u00b8\u00d0\u00bb\u00d0\u00bb\u00d0\u00b8\u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc)\", TQuantity.Gram, (/ 1000))\n  , (\"<quantity> grams\", \"\u00d0\u00b3(\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc?)?\", TQuantity.Gram, id)\n  , (\"<quantity> kilograms\", \"(\u00d0\u00ba\u00d0\u00b3|\u00d0\u00ba\u00d0\u00b8\u00d0\u00bb\u00d0\u00be\u00d0\u00b3\u00d1\u20ac\u00d0\u00b0\u00d0\u00bc\u00d0\u00bc?)\", TQuantity.Gram, (* 1000))\n  , (\"<quantity> lb\", \"\u00d1\u201e\u00d1\u0192\u00d0\u00bd\u00d1\u201a\", TQuantity.Pound, id)\n  , (\"<quantity> oz\", \"\u00d1\u0192\u00d0\u00bd\u00d1\u2020\", TQuantity.Ounce, id)\n  ]\n\nruleNumeralQuantities :: [Rule]\nruleNumeralQuantities = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit, Double -> Double) -> Rule\n    go (name, regexPattern, u, convert) = Rule\n      { name = name\n      , pattern =\n        [ numberWith TNumeral.value (> 0), regex regexPattern ]\n      , prod = \\tokens -> case tokens of\n        (Token Numeral nd:_) ->\n          Just . Token Quantity . quantity u . convert $ TNumeral.value nd\n        _ -> Nothing\n      }\n\nruleAQuantity :: [Rule]\nruleAQuantity = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit, Double -> Double) -> Rule\n    go (name, regexPattern, u, convert) = Rule\n      { name = name\n      , pattern = [ regex regexPattern ]\n      , prod = \\_ -> Just . Token Quantity . quantity u $ convert 1\n      }\n\nrules :: [Rule]\nrules = ruleNumeralQuantities ++ ruleAQuantity\n", "num_lines": 63}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.NL.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Quantity.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncontext :: Context\ncontext = testContext {locale = makeLocale NL Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Gram 2 Nothing)\n             [ \"2 gram\"\n             , \"0,002 kg\"\n             , \"0,002 kilo\"\n             , \"2/1000 kilogram\"\n             , \"2000 milligram\"\n             ]\n  , examples (simple Gram 1000 Nothing)\n             [ \"1 kg\"\n             , \"1,0 kg\"\n             , \"1 kilogram\"\n             , \"1 kilo\"\n             , \"1000 gram\"\n             , \"1000 g\"\n             , \"1000 gr\"\n             , \"duizend gram\"\n             , \"duizend gr\"\n             , \"2,0 pond\"\n             , \"10 ons\"\n             , \"1000000 mg\"\n             , \"1000000 milligram\"\n             ]\n  , examples (simple Cup 1 (Just \"suiker\"))\n             [ \"1 kopje suiker\"\n             ]\n  , examples (simple Cup 3 (Just \"suiker\"))\n             [ \"3 kopjes suiker\"\n             ]\n  , examples (simple Cup 0.75 Nothing)\n             [ \"3/4 kopje\"\n             , \"0,75 kopje\"\n             , \",75 kopje\"\n             ]\n  , examples (simple Gram 500 (Just \"aardbeien\"))\n             [ \"500 gram aardbeien\"\n             , \"500g aardbeien\"\n             , \"0,5 kilogram aardbeien\"\n             , \"0,5 kg aardbeien\"\n             , \"5 ons aardbeien\"\n             , \"1 pond aardbeien\"\n             , \"500000mg aardbeien\"\n             ]\n  , examples (between Gram (100,1000) (Just \"aardbeien\"))\n              [ \"100-1000 gram aardbeien\"\n              , \"tussen 100 en 1000 gram aardbeien\"\n              , \"van 100 tot 1000 g aardbeien\"\n              , \"tussen 1 ons en 10 ons aardbeien\"\n              , \"100 - 1000 g aardbeien\"\n              ]\n  , examples (between Gram (2,7) Nothing)\n              [ \"~2-7 gram\"\n              , \"van 2 tot 7 g\"\n              , \"tussen 2,0 g en ongeveer 7,0 g\"\n              , \"tussen 0,002 kg en ongeveer 0,007 kg\"\n              , \"2 - ~7 gram\"\n              ]\n  ]\n", "num_lines": 87}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Duckling.Quantity.NL.Rules\n  ( rules\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers\nimport Duckling.Quantity.Helpers\nimport Duckling.Regex.Types (GroupMatch (..))\nimport Duckling.Types\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Quantity.Types (QuantityData(..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\nquantities :: [(Text, String, TQuantity.Unit)]\nquantities =\n  [ (\"<quantity> kopje\",        \"(kopjes?)\", TQuantity.Cup)\n  , (\"<quantity> grams\",        \"(g((r)?(am)?)?)\", TQuantity.Gram)\n  , (\"<quantity> milligrams\",   \"((m(illi)?)(g(ram)?))\", TQuantity.Gram)\n  , (\"<quantity> kilograms\",    \"((k(ilo)?)(g(ram)?)?)\", TQuantity.Gram)\n  , (\"<quantity> pond\",         \"(pond(je(s)?)?)\", TQuantity.Gram)\n  , (\"<quantity> ons\",          \"(ons(je(s)?)?)\", TQuantity.Gram)\n  ]\n\nopsMap :: HashMap Text (Double -> Double)\nopsMap = HashMap.fromList\n  [ ( \"milligram\"   , (/ 1000))\n  , ( \"mg\"          , (/ 1000))\n  , ( \"kilo\"        , (* 1000))\n  , ( \"kilogram\"    , (* 1000))\n  , ( \"kg\"          , (* 1000))\n  , ( \"pond\"        , (* 500))\n  , ( \"ons\"         , (* 100))\n  ]\n\nruleNumeralQuantities :: [Rule]\nruleNumeralQuantities = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [Predicate isPositive, regex regexPattern]\n      , prod = \\case\n        (Token Numeral nd:\n         Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just . Token Quantity $ quantity u value\n          where value = getValue opsMap match $ TNumeral.value nd\n        _ -> Nothing\n      }\n\nruleAQuantity :: [Rule]\nruleAQuantity = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [ regex (\"een? \" ++ regexPattern) ]\n      , prod = \\case\n        (Token RegexMatch (GroupMatch (match:_)):\n         _) -> Just . Token Quantity $ quantity u $ getValue opsMap match 1\n        _ -> Nothing\n      }\n\nruleQuantityOfProduct :: Rule\nruleQuantityOfProduct = Rule\n  { name = \"<quantity> product\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"(\\\\w+)\"\n    ]\n  , prod = \\case\n    (Token Quantity qd:Token RegexMatch (GroupMatch (product:_)):_) ->\n      Just . Token Quantity $ withProduct (Text.toLower product) qd\n    _ -> Nothing\n  }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n    { name = \"ongeveer|plm|plusminus <quantity>\"\n    , pattern =\n      [ regex \"\\\\~|precies|exact|ongeveer|bijna|ongeveer\"\n      , dimension Quantity\n      ]\n      , prod = \\case\n        (_:token:_) -> Just token\n        _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n    { name = \"tussen|van <numeral> en|tot <quantity>\"\n    , pattern =\n      [ regex \"tussen|van\"\n      , Predicate isPositive\n      , regex \"tot|en\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Numeral NumeralData{TNumeral.value = from}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to ->\n          Just . Token Quantity . withInterval (from, to) $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n    { name = \"rond|tussen|van <quantity> tot|en <quantity>\"\n    , pattern =\n      [ regex \"tussen|van\"\n      , Predicate isSimpleQuantity\n      , regex \"en|tot\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u1\n                                    , TQuantity.aproduct = Nothing}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u2\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to && u1 == u2 ->\n          Just . Token Quantity . withInterval (from, to) $ unitOnly u1\n        _ -> Nothing\n    }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n    { name = \"<numeral> - <quantity>\"\n    , pattern =\n      [ Predicate isPositive\n      , regex \"\\\\-\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (Token Numeral NumeralData{TNumeral.value = from}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to ->\n           Just . Token Quantity . withInterval (from, to) $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n    { name = \"<quantity> - <quantity>\"\n    , pattern =\n      [ Predicate isSimpleQuantity\n      , regex \"\\\\-\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u1\n                                    , TQuantity.aproduct = Nothing}:\n         _:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u2\n                                    , TQuantity.aproduct = Nothing}:\n         _) | from < to && u1 == u2 ->\n          Just . Token Quantity . withInterval (from, to) $ unitOnly u1\n        _ -> Nothing\n    }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n    { name = \"minder dan/hoogstens/op zijn hoogst/maximaal/hooguit <quantity>\"\n    , pattern =\n      [ regex \"minder dan|hoogstens|hooguit|maximaal|op zijn hoogst\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just to\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) -> Just . Token Quantity . withMax to $ unitOnly u\n        _ -> Nothing\n    }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"meer dan/minstens/op zijn minst <quantity>\"\n  , pattern =\n      [ regex \"meer dan|minstens|minimaal|op zijn minst|minder dan\"\n      , Predicate isSimpleQuantity\n      ]\n    , prod = \\case\n        (_:\n         Token Quantity QuantityData{TQuantity.value = Just from\n                                    , TQuantity.unit = Just u\n                                    , TQuantity.aproduct = Nothing}:\n         _) -> Just . Token Quantity . withMin from $ unitOnly u\n        _ -> Nothing\n    }\n\nrules :: [Rule]\nrules =\n  [ ruleQuantityOfProduct\n  , ruleIntervalMin\n  , ruleIntervalMax\n  , ruleIntervalBetweenNumeral\n  , ruleIntervalBetween\n  , ruleIntervalNumeralDash\n  , ruleIntervalDash\n  , rulePrecision\n  ]\n  ++ ruleNumeralQuantities\n  ++ ruleAQuantity\n", "num_lines": 236}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.PT.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Quantity.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [  examples (simple Pound 2 (Just \"carne\"))\n             [ \"duas libras de carne\"\n             ]\n  , examples (simple Gram 2 Nothing)\n             [ \"2 gramas\"\n             , \"0,002 kg\"\n             , \"2 g\"\n             , \"2/1000 quilogramas\"\n             , \"2/1000 quilos\"\n             , \"2000 miligramas\"\n             , \"2000 miligramas\"\n             ]\n  , examples (simple Gram 1000 Nothing)\n             [ \"um quilograma\"\n             , \"um quilo\"\n             , \"um kg\"\n             , \"1 kg\"\n             , \"1000 g\"\n             ]\n  , examples (simple Pound 1 Nothing)\n             [ \"uma Libra\"\n             , \"1 lb\"\n             , \"uma lb\"\n             ]\n  , examples (simple Cup 3 (Just \"acucar\"))\n             [ \"3 copos de acucar\"\n             , \"3 copos de AcucAr\"\n             ]\n  , examples (simple Cup 0.75 Nothing)\n             [ \"3/4 copo\"\n             , \"0,75 copo\"\n             ]\n  , examples (simple Gram 500 (Just \"morangos\"))\n             [ \"500 gramas de morangos\"\n             , \"500g de morangos\"\n             , \"0,5 quilos de morangos\"\n             , \"0,5 kg de morangos\"\n             , \"500000mg de morangos\"\n             ]\n  ]\n", "num_lines": 66}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Duckling.Quantity.PT.Rules\n  ( rules ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport Prelude\nimport Data.String\nimport Data.Text (Text)\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Types (NumeralData (..))\nimport qualified Duckling.Numeral.Types as TNumeral\nimport Duckling.Numeral.Helpers\nimport Duckling.Quantity.Helpers\nimport qualified Duckling.Quantity.Types as TQuantity\nimport Duckling.Regex.Types\nimport Duckling.Types\n\nquantities :: [(Text, String, TQuantity.Unit)]\nquantities =\n  [ (\"<quantity> copos\", \"(copos?)\", TQuantity.Cup)\n  , (\"<quantity> gramas\", \"((((mili)|(quilo))?(grama)s?)|(quilos?)|((m|k)?g))\", TQuantity.Gram)\n  , (\"<quantity> libras\", \"((lb|libra)s?)\", TQuantity.Pound)\n  ]\n\nopsMap :: HashMap Text (Double -> Double)\nopsMap = HashMap.fromList\n  [ ( \"miligrama\"  , (/ 1000))\n  , ( \"miligramas\" , (/ 1000))\n  , ( \"mg\"         , (/ 1000))\n  , ( \"mgs\"        , (/ 1000))\n  , ( \"quilograma\" , (* 1000))\n  , ( \"quilogramas\", (* 1000))\n  , ( \"quilo\"      , (* 1000))\n  , ( \"quilos\"     , (* 1000))\n  , ( \"kg\"         , (* 1000))\n  , ( \"kgs\"        , (* 1000))\n  ]\n\nruleNumeralQuantities :: [Rule]\nruleNumeralQuantities = map go quantities\n  where\n    go :: (Text, String, TQuantity.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern = [Predicate isPositive, regex regexPattern]\n      , prod = \\case\n          (Token Numeral nd:\n           Token RegexMatch (GroupMatch (match:_)):\n           _) -> do\n            let value = getValue opsMap match $ TNumeral.value nd\n            Just $ Token Quantity $ quantity u value\n          _ -> Nothing\n      }\n\nruleQuantityOfProduct :: Rule\nruleQuantityOfProduct = Rule\n  { name = \"<quantity> of product\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"de (\\\\w+)\"\n    ]\n  , prod = \\case\n      (Token Quantity qd:Token RegexMatch (GroupMatch (product:_)):_) ->\n        Just $ Token Quantity $ withProduct (Text.toLower product) qd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleQuantityOfProduct ]\n  ++ ruleNumeralQuantities\n", "num_lines": 85}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.RO.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Quantity.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Pound 2 (Just \"carne\"))\n             [ \"doua livre de carne\"\n             ]\n  , examples (simple Pound 1 Nothing)\n             [ \"o livr\u00c4\u0192\"\n             ]\n  , examples (simple Pound 500 (Just \"zah\u00c4\u0192r\"))\n             [ \"cinci sute livre de zah\u00c4\u0192r\"\n             , \"cinci sute de livre de zah\u00c4\u0192r\"\n             ]\n  , examples (simple Pound 21 (Just \"mamaliga\"))\n             [ \"dou\u00c4\u0192zeci \u00c8\u2122i unu de livre de mamaliga\"\n             ]\n  ]\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Quantity.RO.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (isPositive)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Quantity.Helpers\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Quantity.Types as TQuantity\n\nruleNumeralUnits :: Rule\nruleNumeralUnits = Rule\n  { name = \"<number> <units>\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"(de )?livr(a|e|\u00c4\u0192)\"\n    ]\n  , prod = \\case\n      (Token Numeral NumeralData {TNumeral.value = v}:_) ->\n        Just . Token Quantity $ quantity TQuantity.Pound v\n      _ -> Nothing\n  }\n\nruleQuantityOfProduct :: Rule\nruleQuantityOfProduct = Rule\n  { name = \"<quantity> of product\"\n  , pattern =\n    [ dimension Quantity\n    , regex \"de (carne|can[a\u00c4\u0192]|zah[a\u00c4\u0192]r|mamaliga)\"\n    ]\n  , prod = \\case\n      (Token Quantity qd:\n       Token RegexMatch (GroupMatch (product:_)):\n       _) -> Just . Token Quantity $ withProduct product qd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNumeralUnits\n  , ruleQuantityOfProduct\n  ]\n", "num_lines": 60}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ranking.Classifiers\n  ( classifiers\n  ) where\n\nimport Data.Maybe\n\nimport Duckling.Locale\nimport Duckling.Ranking.Types\nimport qualified Duckling.Ranking.Classifiers.AF_XX as AF_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.AR_XX as AR_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.BG_XX as BG_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.BN_XX as BN_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.CA_XX as CA_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.CS_XX as CS_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.DA_XX as DA_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.DE_XX as DE_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.EL_XX as EL_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.EN_GB as EN_GBClassifiers\nimport qualified Duckling.Ranking.Classifiers.EN_US as EN_USClassifiers\nimport qualified Duckling.Ranking.Classifiers.EN_XX as EN_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.ES_XX as ES_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.ET_XX as ET_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.FI_XX as FI_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.FA_XX as FA_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.FR_XX as FR_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.GA_XX as GA_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.HE_XX as HE_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.HI_XX as HI_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.HR_XX as HR_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.HU_XX as HU_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.ID_XX as ID_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.IS_XX as IS_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.IT_XX as IT_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.JA_XX as JA_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.KA_XX as KA_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.KM_XX as KM_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.KN_XX as KN_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.KO_XX as KO_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.LO_XX as LO_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.ML_XX as ML_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.MN_XX as MN_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.MY_XX as MY_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.NB_XX as NB_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.NE_XX as NE_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.NL_XX as NL_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.PL_XX as PL_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.PT_XX as PT_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.RO_XX as RO_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.RU_XX as RU_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.SK_XX as SK_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.SV_XX as SV_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.SW_XX as SW_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.TA_XX as TA_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.TE_XX as TE_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.TH_XX as TH_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.TR_XX as TR_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.UK_XX as UK_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.VI_XX as VI_XXClassifiers\nimport qualified Duckling.Ranking.Classifiers.ZH_XX as ZH_XXClassifiers\n\nclassifiers :: Locale -> Classifiers\nclassifiers (Locale AF _) = AF_XXClassifiers.classifiers\nclassifiers (Locale AR _) = AR_XXClassifiers.classifiers\nclassifiers (Locale BG _) = BG_XXClassifiers.classifiers\nclassifiers (Locale BN _) = BN_XXClassifiers.classifiers\nclassifiers (Locale CA _) = CA_XXClassifiers.classifiers\nclassifiers (Locale CS _) = CS_XXClassifiers.classifiers\nclassifiers (Locale DA _) = DA_XXClassifiers.classifiers\nclassifiers (Locale DE _) = DE_XXClassifiers.classifiers\nclassifiers (Locale EL _) = EL_XXClassifiers.classifiers\nclassifiers (Locale EN (Just GB)) = EN_GBClassifiers.classifiers\nclassifiers (Locale EN (Just US)) = EN_USClassifiers.classifiers\nclassifiers (Locale EN _) = EN_XXClassifiers.classifiers\nclassifiers (Locale ES _) = ES_XXClassifiers.classifiers\nclassifiers (Locale ET _) = ET_XXClassifiers.classifiers\nclassifiers (Locale FI _) = FI_XXClassifiers.classifiers\nclassifiers (Locale FA _) = FA_XXClassifiers.classifiers\nclassifiers (Locale FR _) = FR_XXClassifiers.classifiers\nclassifiers (Locale GA _) = GA_XXClassifiers.classifiers\nclassifiers (Locale HE _) = HE_XXClassifiers.classifiers\nclassifiers (Locale HI _) = HI_XXClassifiers.classifiers\nclassifiers (Locale HR _) = HR_XXClassifiers.classifiers\nclassifiers (Locale HU _) = HU_XXClassifiers.classifiers\nclassifiers (Locale ID _) = ID_XXClassifiers.classifiers\nclassifiers (Locale IS _) = IS_XXClassifiers.classifiers\nclassifiers (Locale IT _) = IT_XXClassifiers.classifiers\nclassifiers (Locale JA _) = JA_XXClassifiers.classifiers\nclassifiers (Locale KA _) = KA_XXClassifiers.classifiers\nclassifiers (Locale KM _) = KM_XXClassifiers.classifiers\nclassifiers (Locale KN _) = KN_XXClassifiers.classifiers\nclassifiers (Locale KO _) = KO_XXClassifiers.classifiers\nclassifiers (Locale LO _) = LO_XXClassifiers.classifiers\nclassifiers (Locale ML _) = ML_XXClassifiers.classifiers\nclassifiers (Locale MN _) = MN_XXClassifiers.classifiers\nclassifiers (Locale MY _) = MY_XXClassifiers.classifiers\nclassifiers (Locale NB _) = NB_XXClassifiers.classifiers\nclassifiers (Locale NE _) = NE_XXClassifiers.classifiers\nclassifiers (Locale NL _) = NL_XXClassifiers.classifiers\nclassifiers (Locale PL _) = PL_XXClassifiers.classifiers\nclassifiers (Locale PT _) = PT_XXClassifiers.classifiers\nclassifiers (Locale RO _) = RO_XXClassifiers.classifiers\nclassifiers (Locale RU _) = RU_XXClassifiers.classifiers\nclassifiers (Locale SK _) = SK_XXClassifiers.classifiers\nclassifiers (Locale SV _) = SV_XXClassifiers.classifiers\nclassifiers (Locale SW _) = SW_XXClassifiers.classifiers\nclassifiers (Locale TA _) = TA_XXClassifiers.classifiers\nclassifiers (Locale TE _) = TE_XXClassifiers.classifiers\nclassifiers (Locale TH _) = TH_XXClassifiers.classifiers\nclassifiers (Locale TR _) = TR_XXClassifiers.classifiers\nclassifiers (Locale UK _) = UK_XXClassifiers.classifiers\nclassifiers (Locale VI _) = VI_XXClassifiers.classifiers\nclassifiers (Locale ZH _) = ZH_XXClassifiers.classifiers\n", "num_lines": 120}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\nmodule Duckling.Ranking.Extraction\n  ( extractFeatures\n  ) where\n\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Maybe\nimport qualified Data.Text as Text\nimport Prelude\nimport TextShow (showt)\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Types (DurationData (DurationData))\nimport qualified Duckling.Duration.Types as TDuration\nimport Duckling.Ranking.Types (BagOfFeatures)\nimport Duckling.Time.Types (TimeData (TimeData))\nimport qualified Duckling.Time.Types as TTime\nimport Duckling.Types (Node, Token(..), rule, children, token)\n\n\n-- | Feature extraction\n-- | Features:\n-- | 1) Concatenation of the names of the rules involved in parsing `Node`\n-- | 2) Concatenation of the grains for time-like dimensions\nextractFeatures :: Node -> BagOfFeatures\nextractFeatures node =\n  HashMap.fromList $ (featRules, 1) : [ (featGrain, 1) | not (null grains) ]\n  where\n    featRules = Text.concat $ mapMaybe rule (children node)\n    grains = mapMaybe (\\x ->\n      case token x of\n        Token Duration DurationData{TDuration.grain = g} -> Just $ showt g\n        Token Time TimeData{TTime.timeGrain = g} -> Just $ showt g\n        Token TimeGrain g -> Just $ showt g\n        _ -> Nothing\n      ) $ children node\n    featGrain = Text.concat grains\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Ranking.Rank\n  ( rank\n  ) where\n\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.HashSet (HashSet)\nimport qualified Data.HashSet as HashSet\nimport Data.Maybe\nimport qualified Data.Set as Set\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ranking.Extraction\nimport Duckling.Ranking.Types\nimport Duckling.Types\n\n-- | computes log likelihood of a class\nll :: BagOfFeatures -> ClassData -> Double\nll feats ClassData{..} =\n  prior +\n    HashMap.foldrWithKey\n      (\\feat x res ->\n       res + fromIntegral x * HashMap.lookupDefault unseen feat likelihoods)\n      0.0\n      feats\n\n-- | computes positive class log likelihood\nposLL :: Classifier -> BagOfFeatures -> Double\nposLL Classifier {..} feats = ll feats okData\n\nscore :: Classifiers -> Node -> Double\nscore classifiers node@Node {rule = Just rule, ..} =\n  case HashMap.lookup rule classifiers of\n    Just c -> let feats = extractFeatures node\n      in posLL c feats + sum (map (score classifiers) children)\n    Nothing -> 0.0\nscore _ Node {rule = Nothing} = 0.0\n\n-- | Return all superior candidates, as defined by the partial ordering\nwinners :: Ord a => [a] -> [a]\nwinners xs = filter (\\x -> all ((/=) LT . compare x) xs) xs\n\n-- | Return a curated list of tokens\nrank\n  :: Classifiers\n  -> HashSet (Seal Dimension)\n  -> [ResolvedToken]\n  -> [ResolvedToken]\nrank classifiers targets tokens =\n  Set.toList\n  $ Set.fromList\n  $ map (\\(Candidate token _ _) -> token)\n  $ winners\n  $ map makeCandidate tokens\n  where\n    makeCandidate :: ResolvedToken -> Candidate\n    makeCandidate token@Resolved {node = n@Node {token = Token d _}} =\n      Candidate token (score classifiers n) $ HashSet.member (Seal d) targets\n", "num_lines": 69}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NoRebindableSyntax #-}\n\n\nmodule Duckling.Ranking.Types\n  ( Feature\n  , BagOfFeatures\n  , Class\n  , Datum\n  , Dataset\n\n  , Classifier(..)\n  , Classifiers\n  , ClassData(..)\n  , Candidate(..)\n\n  , infinity\n  ) where\nimport Data.HashMap.Strict (HashMap)\nimport Data.Text (Text)\nimport Prelude\nimport Duckling.Types\n  ( Node(..)\n  , Range(..)\n  , ResolvedToken(..)\n  , Token(..)\n  , isDimension\n  )\n\n-- -----------------------------------------------------------------\n-- Aliases\n\ntype Feature = Text\ntype BagOfFeatures = HashMap Feature Int\ntype Class = Bool\ntype Datum = (BagOfFeatures, Class)\ntype Dataset = HashMap Text [Datum]\n\n-- -----------------------------------------------------------------\n-- Classification\n\ndata Classifier = Classifier\n  { okData :: ClassData\n  , koData :: ClassData\n  }\n  deriving (Eq, Show)\n\ntype Classifiers = HashMap Text Classifier\n\ndata ClassData = ClassData\n  { prior :: Double\n  , unseen :: Double\n  , likelihoods :: HashMap Feature Double\n  , n :: Int\n  }\n  deriving (Eq, Show)\n\ninfinity :: Double\ninfinity = 1 / 0\n\n-- -----------------------------------------------------------------\n-- Candidate\n\n-- |A Candidate represents a potential match going into the ranker\ndata Candidate = Candidate\n    ResolvedToken -- ^ The actual resolved token we are considering\n    Double -- ^ naive Bayes log-likelihood - sum of LL of all rules used\n    Bool -- ^ Does the ResolvedToken's dimension match the caller's request?\n  deriving (Eq, Show)\n\ninstance Ord Candidate where\n  compare (Candidate Resolved{range = Range s1 e1, node = Node{token = Token d1 _}} score1 t1)\n          (Candidate Resolved{range = Range s2 e2, node = Node{token = tok2}} score2 t2)\n    | isDimension d1 tok2 = case starts of\n        EQ -> case ends of\n          EQ -> compare score1 score2\n          z -> z\n        LT -> case ends of\n          LT -> EQ\n          _ -> GT\n        GT -> case ends of\n          GT -> EQ\n          _ -> LT\n    | t1 == t2 = compRange\n    | t1 && compRange == GT = GT\n    | t2 && compRange == LT = LT\n    | otherwise = EQ\n      where\n        starts = compare s1 s2\n        ends = compare e1 e2\n        -- a > b if a recovers b\n        compRange = case starts of\n          EQ -> ends\n          LT -> case ends of\n            LT -> EQ\n            _  -> GT\n          GT -> case ends of\n            GT -> EQ\n            _  -> LT\n", "num_lines": 106}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.AF_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.AR_EG (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -4.189654742026425,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 64},\n                   koData =\n                     ClassData{prior = -1.2992829841302609, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24}}),\n       (\"ordinals (twelveth)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8109302162163288),\n                                    (\"about|exactly <time-of-day>\", -1.5040773967762742),\n                                    (\"Tuesday\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> third\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"time-of-day integer (latent)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.5040773967762742),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"day (grain)yesterday\", -1.5040773967762742)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minute (grain)part of days\", -1.252762968495368),\n                                    (\"minutehour\", -1.252762968495368)],\n                               n = 1}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2411620568168881,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)February\", -2.70805020110221),\n                                    (\"integer (numeric)in <named-month>\", -2.70805020110221),\n                                    (\"integer (numeric)April\", -2.70805020110221),\n                                    (\"integer (numeric)August\", -2.70805020110221),\n                                    (\"integer (numeric)February\", -1.791759469228055),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -2.3025850929940455),\n                                    (\"integer (numeric)March\", -2.70805020110221)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.540445040947149, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)in <named-month>\", -1.9459101490553135),\n                                    (\"month\", -1.252762968495368),\n                                    (\"integer (numeric)July\", -1.540445040947149)],\n                               n = 3}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.41616039722491244,\n                               unseen = -5.488937726156687,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"part of days\",\n                                     -4.386184644822546),\n                                    (\"<hour-of-day> till thirdafter part of days\",\n                                     -4.386184644822546),\n                                    (\"time-of-day integer (latent)after part of days\",\n                                     -4.386184644822546),\n                                    (\"at <time-of-day>before part of days\", -4.098502572370764),\n                                    (\"hh:mmbefore part of days\", -4.791649752930709),\n                                    (\"<datetime> - <datetime> (interval)part of days\",\n                                     -4.098502572370764),\n                                    (\"<time-of-day> - <time-of-day> (interval)part of days\",\n                                     -4.386184644822546),\n                                    (\"time-of-day ordinal (latent)part of days\",\n                                     -4.098502572370764),\n                                    (\"<hour-of-day> halfpart of days\", -4.386184644822546),\n                                    (\"time-of-day integer (latent)part of days\",\n                                     -3.5388867844353418),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.386184644822546),\n                                    (\"hourhour\", -1.8738790208464304),\n                                    (\"hh:mmpart of days\", -3.8753590210565547),\n                                    (\"<hour-of-day> and integer minutespart of days\",\n                                     -2.651583589434439),\n                                    (\"<hour-of-day> quarterafter part of days\", -4.791649752930709),\n                                    (\"minutehour\", -1.4243539229442357),\n                                    (\"at <time-of-day>part of days\", -2.393754480132339),\n                                    (\"intersectpart of days\", -4.791649752930709),\n                                    (\"from <datetime> - <datetime> (interval)part of days\",\n                                     -4.386184644822546),\n                                    (\"<hour-of-day> and integer minutesafter part of days\",\n                                     -4.386184644822546),\n                                    (\"at <time-of-day>after part of days\", -3.6930374642626003),\n                                    (\"<hour-of-day> quarterpart of days\", -4.386184644822546),\n                                    (\"<hour-of-day> thirdpart of days\", -4.386184644822546),\n                                    (\"from <datetime> - <datetime> (interval)after part of days\",\n                                     -4.791649752930709),\n                                    (\"time-of-day ordinal (latent)tonight\", -4.791649752930709),\n                                    (\"<datetime> - <datetime> (interval)after part of days\",\n                                     -4.791649752930709),\n                                    (\"<hour-of-day> till quarterbefore part of days\",\n                                     -4.386184644822546),\n                                    (\"<time-of-day> - <time-of-day> (interval)after part of days\",\n                                     -4.791649752930709),\n                                    (\"at <time-of-day>this <part-of-day>\", -4.791649752930709),\n                                    (\"<hour-of-day> till thirdbefore part of days\",\n                                     -4.386184644822546)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.0775588794702773,\n                               unseen = -5.0238805208462765,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)part of days\", -3.2255203675868693),\n                                    (\"time-of-day integer (latent)after part of days\",\n                                     -4.324132656254979),\n                                    (\"dayhour\", -3.2255203675868693),\n                                    (\"<hour-of-day> till thirdafter <time-of-day>\",\n                                     -3.9186675481468147),\n                                    (\"time-of-day integer (latent)after <time-of-day>\",\n                                     -3.9186675481468147),\n                                    (\"yearhour\", -3.2255203675868693),\n                                    (\"at <time-of-day>until <time-of-day>\", -3.9186675481468147),\n                                    (\"hh:mmafter part of days\", -4.324132656254979),\n                                    (\"past year (latent)part of days\", -4.324132656254979),\n                                    (\"nograinhour\", -4.324132656254979),\n                                    (\"hh:mmuntil <time-of-day>\", -4.324132656254979),\n                                    (\"<time-of-day> - <time-of-day> (interval)part of days\",\n                                     -4.324132656254979),\n                                    (\"until <time-of-day>after part of days\", -4.324132656254979),\n                                    (\"time-of-day ordinal (latent)part of days\",\n                                     -3.9186675481468147),\n                                    (\"<time-of-day> - <time-of-day> (interval)after <time-of-day>\",\n                                     -4.324132656254979),\n                                    (\"by <time>part of days\", -4.324132656254979),\n                                    (\"<datetime> - <datetime> (interval)after <time-of-day>\",\n                                     -4.324132656254979),\n                                    (\"time-of-day integer (latent)part of days\",\n                                     -4.324132656254979),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.324132656254979),\n                                    (\"hourhour\", -2.0215475632609334),\n                                    (\"past year (latent)after part of days\", -4.324132656254979),\n                                    (\"<hour-of-day> and integer minutespart of days\",\n                                     -3.6309854756950335),\n                                    (\"until <time-of-day>after <time-of-day>\", -4.324132656254979),\n                                    (\"minutehour\", -2.072840857648484),\n                                    (\"at <time-of-day>part of days\", -3.9186675481468147),\n                                    (\"until <time-of-day>part of days\", -3.9186675481468147),\n                                    (\"hh:mmafter <time-of-day>\", -4.324132656254979),\n                                    (\"at <time-of-day>after part of days\", -4.324132656254979),\n                                    (\"past year (latent)after <time-of-day>\", -4.324132656254979),\n                                    (\"from <datetime> - <datetime> (interval)after <time-of-day>\",\n                                     -4.324132656254979),\n                                    (\"<hour-of-day> till quarteruntil <time-of-day>\",\n                                     -3.9186675481468147),\n                                    (\"past year (latent)until <time-of-day>\", -4.324132656254979),\n                                    (\"past year (latent)before part of days\", -4.324132656254979),\n                                    (\"at <time-of-day>after <time-of-day>\", -3.2255203675868693),\n                                    (\"<hour-of-day> and integer minutesafter <time-of-day>\",\n                                     -3.9186675481468147)],\n                               n = 48}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"numbers prefix with -, minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 3}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.269171584511341e-2,\n                               unseen = -4.852030263919617,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> third\", -4.151039905898646),\n                                    (\"<hour-of-day> and integer minutes\", -2.5416019934645457),\n                                    (\"<hour-of-day> quarter\", -4.151039905898646),\n                                    (\"<hour-of-day> till quarter\", -3.7455747977904816),\n                                    (\"time-of-day ordinal (latent)\", -1.8997481072921507),\n                                    (\"<hour-of-day> half\", -4.151039905898646),\n                                    (\"hh:mm\", -3.2347491740244907), (\"hour\", -1.180625440328945),\n                                    (\"minute\", -1.7996646487351682),\n                                    (\"<hour-of-day> till third\", -3.7455747977904816),\n                                    (\"time-of-day integer (latent)\", -1.7996646487351682)],\n                               n = 58},\n                   koData =\n                     ClassData{prior = -2.5336968139574325,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day ordinal (latent)\", -1.9459101490553135),\n                                    (\"hour\", -1.252762968495368),\n                                    (\"time-of-day integer (latent)\", -1.6582280766035324)],\n                               n = 5}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6131044728864089,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -2.639057329615259),\n                                    (\"September\", -3.044522437723423),\n                                    (\"second\", -3.044522437723423),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.044522437723423),\n                                    (\"day\", -1.4350845252893227), (\"year\", -2.639057329615259),\n                                    (\"part of <named-month>\", -2.128231705849268),\n                                    (\"month\", -3.044522437723423),\n                                    (\"year (integer)\", -2.639057329615259),\n                                    (\"this|last the <cycle>\", -2.639057329615259),\n                                    (\"day of <named-month>\", -3.044522437723423)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.7801585575495751,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -2.9444389791664407),\n                                    (\"October\", -2.9444389791664407),\n                                    (\"intersect\", -2.0281482472922856),\n                                    (\"<time> for <duration>\", -2.538973871058276),\n                                    (\"month (ordinal)\", -2.9444389791664407),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.538973871058276),\n                                    (\"month\", -1.1526795099383855)],\n                               n = 11}}),\n       (\"<hour-of-day> and integer minutes\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (13..19)\", -2.505525936990736),\n                                    (\"at <time-of-day>integer 21..99\", -2.793208009442517),\n                                    (\"time-of-day integer (latent)integer (numeric)\",\n                                     -2.793208009442517),\n                                    (\"at <time-of-day>integer (20..90)\", -3.1986731175506815),\n                                    (\"time-of-day integer (latent)integer (13..19)\",\n                                     -3.1986731175506815),\n                                    (\"hour\", -0.9473813189441862),\n                                    (\"time-of-day ordinal (latent)integer (20..90)\",\n                                     -3.1986731175506815),\n                                    (\"time-of-day ordinal (latent)integer (numeric)\",\n                                     -3.1986731175506815),\n                                    (\"at <time-of-day>integer (numeric)\", -2.505525936990736),\n                                    (\"time-of-day ordinal (latent)integer 21..99\",\n                                     -2.793208009442517),\n                                    (\"time-of-day ordinal (latent)integer (13..19)\",\n                                     -2.793208009442517)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day integer (latent)integer 21..99\",\n                                     -2.2512917986064953),\n                                    (\"time-of-day integer (latent)integer (20..90)\",\n                                     -1.845826690498331),\n                                    (\"hour\", -1.55814461804655)],\n                               n = 3}}),\n       (\"this|last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"week (grain)\", -1.791759469228055),\n                                    (\"day\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"day (grain)\", -1.791759469228055)],\n                               n = 3}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -2.0149030205422647, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.1431008436406733, unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0986122886681098),\n                                    (\"dual <unit-of-duration>\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003), (\"year\", -1.2039728043259361),\n                                    (\"single <unit-of-duration>\", -0.916290731874155)],\n                               n = 3}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 39}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.5458224658030868,\n                               unseen = -5.5134287461649825,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesdayon <date>\", -4.816241156068032),\n                                    (\"in <named-month>year\", -4.816241156068032),\n                                    (\"<hour-of-day> till thirdafter part of days\",\n                                     -4.410776047959867),\n                                    (\"dayhour\", -3.899950424193877),\n                                    (\"daymonth\", -4.816241156068032),\n                                    (\"in <named-month>on <date>\", -4.816241156068032),\n                                    (\"monthyear\", -3.312163759291758),\n                                    (\"Mondayon <date>\", -4.816241156068032),\n                                    (\"Christmasyear\", -4.816241156068032),\n                                    (\"Monday<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"month (integer)year (integer)\", -4.410776047959867),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1605\\1610\\1604\\1575\\1583year\",\n                                     -4.816241156068032),\n                                    (\"<day-of-week> the last of <time><cycle> this|last|next\",\n                                     -4.816241156068032),\n                                    (\"at <time-of-day>before part of days\", -4.123093975508087),\n                                    (\"hh:mmbefore part of days\", -4.816241156068032),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -4.816241156068032),\n                                    (\"intersect<time> <part-of-day>\", -4.410776047959867),\n                                    (\"month (ordinal)year (integer)\", -4.816241156068032),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1589\\1581year\",\n                                     -4.816241156068032),\n                                    (\"dd/mm<time> <part-of-day>\", -4.816241156068032),\n                                    (\"Thursday<time> timezone\", -4.410776047959867),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.410776047959867),\n                                    (\"dayday\", -3.024481686839977),\n                                    (\"absorption of , after named day<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"hourhour\", -3.717628867399922),\n                                    (\"month (integer)year\", -4.816241156068032),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1591\\1585year\",\n                                     -4.816241156068032),\n                                    (\"Thursday<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"dayyear\", -2.9444389791664407),\n                                    (\"Thursday<time> <part-of-day>\", -4.816241156068032),\n                                    (\"<cycle> last of <time>year (integer)\", -4.410776047959867),\n                                    (\"last <cycle> of <time>year (integer)\", -4.816241156068032),\n                                    (\"<hour-of-day> quarterafter part of days\", -4.816241156068032),\n                                    (\"minutehour\", -2.513656063073986),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -4.816241156068032),\n                                    (\"\\1585\\1571\\1587 \\1575\\1604\\1587\\1606\\1577 \\1575\\1604\\1607\\1580\\1585\\1610\\1577year\",\n                                     -4.816241156068032),\n                                    (\"Monday<cycle> this|last|next\", -4.816241156068032),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>year\",\n                                     -4.816241156068032),\n                                    (\"<cycle> <ordinal> day? of <time>year\", -4.816241156068032),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1571\\1590\\1581\\1609year\",\n                                     -4.816241156068032),\n                                    (\"on a <named-day>dd/mm\", -4.816241156068032),\n                                    (\"on a <named-day>on <date>\", -4.816241156068032),\n                                    (\"on a <named-day><day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"Tuesday<cycle> this|last|next\", -4.816241156068032),\n                                    (\"dayminute\", -3.563478187572664),\n                                    (\"dd/mmintersect\", -4.816241156068032),\n                                    (\"in <named-month><cycle> this|last|next\", -4.816241156068032),\n                                    (\"<hour-of-day> and integer minutesafter part of days\",\n                                     -4.410776047959867),\n                                    (\"Saturdaydd/mm\", -4.816241156068032),\n                                    (\"\\1585\\1605\\1590\\1575\\1606year\", -4.816241156068032),\n                                    (\"the <cycle> the <ordinal> of <time>year\", -4.816241156068032),\n                                    (\"at <time-of-day>after part of days\", -3.717628867399922),\n                                    (\"<ordinal> <cycle> of <time>year\", -4.816241156068032),\n                                    (\"Sunday<cycle> this|last|next\", -4.816241156068032),\n                                    (\"Tuesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.410776047959867),\n                                    (\"Septemberon <date>\", -4.816241156068032),\n                                    (\"from <datetime> - <datetime> (interval)after part of days\",\n                                     -4.816241156068032),\n                                    (\"intersectintersect\", -4.410776047959867),\n                                    (\"dayweek\", -4.123093975508087),\n                                    (\"weekyear\", -3.899950424193877),\n                                    (\"<datetime> - <datetime> (interval)after part of days\",\n                                     -4.816241156068032),\n                                    (\"Friday<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"<hour-of-day> till quarterbefore part of days\",\n                                     -4.410776047959867),\n                                    (\"<time-of-day> - <time-of-day> (interval)after part of days\",\n                                     -4.816241156068032),\n                                    (\"at <time-of-day>this <part-of-day>\", -4.816241156068032),\n                                    (\"<hour-of-day> till thirdbefore part of days\",\n                                     -4.410776047959867)],\n                               n = 73},\n                   koData =\n                     ClassData{prior = -0.8659899933993561, unseen = -5.337538079701318,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesdayon <date>\", -4.639571612705423),\n                                    (\"dayhour\", -3.1354942159291497),\n                                    (\"daymonth\", -3.5409593240373143),\n                                    (\"monthday\", -4.639571612705423),\n                                    (\"monthyear\", -2.7677694358038325),\n                                    (\"hh:mmafter part of days\", -4.639571612705423),\n                                    (\"houryear\", -4.639571612705423),\n                                    (\"intersectat <time-of-day>\", -3.7232808808312687),\n                                    (\"intersect<time> <part-of-day>\", -4.23410650459726),\n                                    (\"Octoberon <date>\", -4.639571612705423),\n                                    (\"until <time-of-day>after part of days\", -4.639571612705423),\n                                    (\"Tuesdayafter <time-of-day>\", -4.639571612705423),\n                                    (\"Wednesdayon <date>\", -4.23410650459726),\n                                    (\"dd/mm<time> <part-of-day>\", -4.639571612705423),\n                                    (\"yearyear\", -4.23410650459726),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.639571612705423),\n                                    (\"dayday\", -3.9464244321454784),\n                                    (\"dd/mmat <time-of-day>\", -4.23410650459726),\n                                    (\"hourhour\", -4.23410650459726),\n                                    (\"dayyear\", -3.386808644210056),\n                                    (\"Thursdayat <time-of-day>\", -4.23410650459726),\n                                    (\"Februaryyear\", -4.639571612705423),\n                                    (\"minutemonth\", -4.639571612705423),\n                                    (\"minutehour\", -4.23410650459726),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>year\",\n                                     -4.23410650459726),\n                                    (\"March<cycle> this|last|next\", -4.639571612705423),\n                                    (\"nth <time> of <time>year\", -4.639571612705423),\n                                    (\"Wednesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.639571612705423),\n                                    (\"secondyear\", -4.639571612705423),\n                                    (\"Wednesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.639571612705423),\n                                    (\"on <date>year (integer)\", -4.639571612705423),\n                                    (\"<time> for <duration>year\", -3.5409593240373143),\n                                    (\"<duration> after|before|from <time>on <date>\",\n                                     -4.639571612705423),\n                                    (\"dayminute\", -3.1354942159291497),\n                                    (\"Julyuntil <time-of-day>\", -4.639571612705423),\n                                    (\"intersecton <date>\", -4.639571612705423),\n                                    (\"at <time-of-day>after part of days\", -4.639571612705423),\n                                    (\"Octoberyear\", -4.639571612705423),\n                                    (\"in|within|after <duration>year\", -4.23410650459726),\n                                    (\"Tuesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.639571612705423),\n                                    (\"on a <named-day>intersect\", -4.23410650459726),\n                                    (\"Saturdayintersect\", -4.23410650459726),\n                                    (\"on <date>year\", -4.23410650459726),\n                                    (\"on <date>on <date>\", -4.639571612705423),\n                                    (\"Tuesdaynth <time> of <time>\", -4.639571612705423),\n                                    (\"weekyear\", -4.639571612705423),\n                                    (\"Tuesdayintersect\", -4.639571612705423),\n                                    (\"after <time-of-day>year\", -4.639571612705423),\n                                    (\"in <number> (implicit minutes)February\", -4.639571612705423),\n                                    (\"last <cycle> of <time>year\", -4.639571612705423),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>on <date>\",\n                                     -4.639571612705423)],\n                               n = 53}}),\n       (\"\\1585\\1605\\1590\\1575\\1606\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> the <ordinal> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)ordinals (first..tenth)October\",\n                                     -2.0794415416798357),\n                                    (\"daymonth\", -1.3862943611198906),\n                                    (\"week (grain)ordinals (first..tenth)month (integer)\",\n                                     -2.0794415416798357),\n                                    (\"weekmonth\", -1.6739764335716716),\n                                    (\"week (grain)ordinals (first..tenth)intersect\",\n                                     -2.0794415416798357),\n                                    (\"day (grain)ordinals (first..tenth)month (integer)\",\n                                     -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinals (first..tenth)week (grain)in <named-month>\",\n                                     -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (first..tenth)week (grain)intersect\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..tenth)day (grain)month (integer)\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2237754316221157,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.3483066942682157, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.791759469228055),\n                                    (\"at <time-of-day>at <time-of-day>\", -1.0986122886681098),\n                                    (\"hourhour\", -1.0986122886681098),\n                                    (\"<day-of-month> (ordinal or number) <named-month><day-of-month> (ordinal or number) <named-month>\",\n                                     -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8754687373538999), (\"Sunday\", -1.791759469228055),\n                                    (\"on a <named-day>\", -1.791759469228055),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 5integer (20..90)\", -0.6931471805599453),\n                                    (\"integer 3integer (20..90)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (13..19)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 5integer 10\", -0.916290731874155),\n                                    (\"integer 8integer 10\", -0.5108256237659907)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectsingle <unit-of-duration>\", -2.4423470353692043),\n                                    (\"monthyear\", -1.5260563034950494),\n                                    (\"nth <time> of <time>single <unit-of-duration>\",\n                                     -2.4423470353692043),\n                                    (\"dayyear\", -2.03688192726104),\n                                    (\"last <cycle> of <time>single <unit-of-duration>\",\n                                     -2.4423470353692043),\n                                    (\"weekyear\", -2.4423470353692043),\n                                    (\"Octobersingle <unit-of-duration>\", -2.4423470353692043),\n                                    (\"Septembersingle <unit-of-duration>\", -2.4423470353692043),\n                                    (\"on <date>single <unit-of-duration>\", -2.03688192726104)],\n                               n = 7}}),\n       (\"from <day-of-month> (ordinal or number) to <day-of-month> (ordinal or number) in <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)month (ordinal)\",\n                                     -1.252762968495368),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"ordinals (composite, e.g., eighty-seven)ordinals (composite, e.g., eighty-seven)in <named-month>\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (first..tenth)\",\n        Classifier{okData =\n                     ClassData{prior = -0.21825356602001794,\n                               unseen = -3.7612001156935624,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 41},\n                   koData =\n                     ClassData{prior = -1.62924053973028, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1571\\1590\\1581\\1609\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (twenty, thirty..ninety)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer 10\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"<time> nth of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0296194171811581),\n                                    (\"Wednesdayordinals (first..tenth)intersect\",\n                                     -1.9459101490553135),\n                                    (\"Tuesdayordinals (first..tenth)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.9459101490553135),\n                                    (\"Tuesdayordinals (first..tenth)in <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"Tuesdayordinals (first..tenth)October\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.2039728043259361),\n                                    (\"Tuesdayordinals (first..tenth)in <named-month>\",\n                                     -1.6094379124341003),\n                                    (\"Wednesdayordinals (first..tenth)in <named-month>\",\n                                     -1.6094379124341003)],\n                               n = 2}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.6739764335716716),\n                                    (\"ordinals (first..tenth)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (integer)\",\n                                     -2.367123614131617),\n                                    (\"ordinals (first..tenth)on a <named-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.772588722239781),\n                                    (\"dayyear\", -2.0794415416798357),\n                                    (\"ordinals (first..tenth)Tuesdaymonth (integer)\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)Wednesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.367123614131617),\n                                    (\"ordinals (first..tenth)intersectyear (integer)\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)Tuesdayintersect\",\n                                     -2.772588722239781)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)TuesdaySeptember\", -2.772588722239781),\n                                    (\"ordinals (first..tenth)time-of-day integer (latent)intersect\",\n                                     -2.772588722239781),\n                                    (\"daymonth\", -1.8562979903656263),\n                                    (\"ordinals (first..tenth)time-of-day integer (latent)February\",\n                                     -2.367123614131617),\n                                    (\"hourmonth\", -1.8562979903656263),\n                                    (\"ordinals (first..tenth)WednesdayOctober\", -2.772588722239781),\n                                    (\"ordinals (first..tenth)on a <named-day>September\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)time-of-day integer (latent)this|last the <cycle>\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)Wednesdayin <named-month>\",\n                                     -2.772588722239781)],\n                               n = 8}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.5040773967762742),\n                                    (\"time-of-day ordinal (latent)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1585\\1571\\1587 \\1575\\1604\\1587\\1606\\1577 \\1575\\1604\\1607\\1580\\1585\\1610\\1577\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> till quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3862943611198906),\n                                    (\"time-of-day ordinal (latent)\", -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"time-of-day integer (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.0986122886681098),\n                                    (\"time-of-day integer (latent)\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"past year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 3}}),\n       (\"integer 8\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.570544858467613, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (thirtieth..nineteenth)February\",\n                                     -2.5902671654458267),\n                                    (\"ordinals (first..tenth)October\", -2.5902671654458267),\n                                    (\"ordinals (first..tenth)April\", -2.5902671654458267),\n                                    (\"ordinals (first..tenth)February\", -2.995732273553991),\n                                    (\"ordinals (first..tenth)month (integer)\", -2.5902671654458267),\n                                    (\"ordinals (first..tenth)March\", -2.5902671654458267),\n                                    (\"month\", -1.0498221244986778),\n                                    (\"ordinals (first..tenth)in <named-month>\",\n                                     -2.5902671654458267)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.832909122935104, unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 2in <named-month>\", -2.833213344056216),\n                                    (\"integer 10February\", -2.4277482359480516),\n                                    (\"integer (numeric)month (ordinal)\", -2.833213344056216),\n                                    (\"ordinals (first..tenth)month (integer)\", -2.833213344056216),\n                                    (\"integer (20..90)in <named-month>\", -2.833213344056216),\n                                    (\"ordinals (composite, e.g., eighty-seven)in <named-month>\",\n                                     -2.833213344056216),\n                                    (\"ordinals (twenty, thirty..ninety)in <named-month>\",\n                                     -2.833213344056216),\n                                    (\"month\", -1.128465251817791),\n                                    (\"ordinals (first..tenth)in <named-month>\",\n                                     -2.4277482359480516)],\n                               n = 10}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"<cycle> <ordinal> day? of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)ordinals (first..tenth)October\",\n                                     -2.0794415416798357),\n                                    (\"daymonth\", -1.3862943611198906),\n                                    (\"week (grain)ordinals (first..tenth)month (integer)\",\n                                     -2.0794415416798357),\n                                    (\"weekmonth\", -1.6739764335716716),\n                                    (\"week (grain)ordinals (first..tenth)intersect\",\n                                     -2.0794415416798357),\n                                    (\"day (grain)ordinals (first..tenth)month (integer)\",\n                                     -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> this|last|next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -2.5649493574615367),\n                                    (\"year (grain)\", -2.341805806147327),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"day\", -2.5649493574615367), (\"year\", -2.341805806147327),\n                                    (\"month\", -2.5649493574615367),\n                                    (\"day (grain)\", -2.5649493574615367)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day ordinal (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13976194237515874,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (twelveth)\", -2.03688192726104),\n                                    (\"ordinals (first..tenth)\", -0.3022808718729337),\n                                    (\"ordinals (eleventh)\", -2.03688192726104)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -2.03688192726104, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)\", -0.40546510810816444)],\n                               n = 3}}),\n       (\"ordinals (eleventh)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.2992829841302609),\n                                    (\"hour\", -1.7047480922384253), (\"minute\", -1.7047480922384253)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.1400661634962708),\n                                    (\"time-of-day ordinal (latent)\", -2.1400661634962708),\n                                    (\"day\", -1.4469189829363254),\n                                    (\"<day-of-month> (ordinal)\", -1.7346010553881064),\n                                    (\"hour\", -1.7346010553881064)],\n                               n = 5}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1591\\1585\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<hour-of-day> half\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3862943611198906),\n                                    (\"time-of-day ordinal (latent)\", -1.3862943611198906),\n                                    (\"hour\", -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.0986122886681098),\n                                    (\"time-of-day integer (latent)\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"month (integer)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.8718021769015913),\n                                    (\"integer 10\", -0.6190392084062235),\n                                    (\"integer 3\", -1.1786549963416462)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.7419373447293773,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.6466271649250525,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8472978603872037),\n                                    (\"Monday<cycle> this|last|next\", -1.252762968495368),\n                                    (\"Mondayin <named-month>\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 10minute (grain)\", -2.4423470353692043),\n                                    (\"year\", -2.7300291078209855),\n                                    (\"integer 10year (grain)\", -2.7300291078209855),\n                                    (\"integer (20..90)minute (grain)\", -2.4423470353692043),\n                                    (\"month\", -2.7300291078209855),\n                                    (\"integer (numeric)minute (grain)\", -2.4423470353692043),\n                                    (\"integer (numeric)month (grain)\", -2.7300291078209855),\n                                    (\"minute\", -1.120591195386885),\n                                    (\"integer 21..99minute (grain)\", -2.7300291078209855),\n                                    (\"integer (13..19)minute (grain)\", -2.4423470353692043)],\n                               n = 18}}),\n       (\"dual <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"week (grain)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 10\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"from <day-of-month> (ordinal or number) to <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)July\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"integer (numeric)integer (numeric)in <named-month>\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -1.2992829841302609), (\"month\", -0.7884573603642702),\n                                    (\"in <named-month>\", -1.2992829841302609)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<hour-of-day> and integer\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (13..19)\", -2.0794415416798357),\n                                    (\"at <time-of-day>integer 21..99\", -1.6739764335716716),\n                                    (\"hour\", -1.1631508098056809),\n                                    (\"at <time-of-day>integer (numeric)\", -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer 5\", -2.2335922215070942),\n                                    (\"at <time-of-day>integer (13..19)\", -2.2335922215070942),\n                                    (\"at <time-of-day>integer 3\", -2.639057329615259),\n                                    (\"at <time-of-day>integer (20..90)\", -2.639057329615259),\n                                    (\"at <time-of-day>integer 8\", -2.2335922215070942),\n                                    (\"hour\", -0.9343092373768334),\n                                    (\"at <time-of-day>integer (numeric)\", -2.2335922215070942)],\n                               n = 10}}),\n       (\"month (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"ordinals (first..tenth)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1589\\1581\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.2992829841302609),\n                                    (\"dayday\", -0.7884573603642702),\n                                    (\"day (grain)yesterday\", -1.2992829841302609)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-week> next\", -1.8718021769015913),\n                                    (\"at <time-of-day>\", -1.466337068793427),\n                                    (\"day\", -1.466337068793427), (\"hour\", -1.466337068793427),\n                                    (\"Tuesday\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -2.2512917986064953,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.9808292530117262),\n                                    (\"single <unit-of-duration>\", -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.11122563511022437,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -2.538973871058276), (\"month\", -0.8649974374866046),\n                                    (\"single <unit-of-duration>\", -0.7472144018302211)],\n                               n = 17}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5533852381847867, unseen = -4.430816798843313,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.627081138568543),\n                                    (\"daymonth\", -2.472930458741285),\n                                    (\"monthyear\", -2.627081138568543),\n                                    (\"Wednesdayintersect\", -3.7256934272366524),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)October\",\n                                     -3.7256934272366524),\n                                    (\"Wednesday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"dayday\", -2.8094026953624978),\n                                    (\"Thursday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"in <named-month>year (integer)\", -3.3202283191284883),\n                                    (\"Thursdayat <time-of-day>\", -3.7256934272366524),\n                                    (\"Thursday<time> <part-of-day>\", -3.3202283191284883),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)this|last the <cycle>\",\n                                     -3.7256934272366524),\n                                    (\"last <cycle> of <time>year (integer)\", -3.7256934272366524),\n                                    (\"Tuesdaymonth (integer)\", -3.7256934272366524),\n                                    (\"Wednesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -3.7256934272366524),\n                                    (\"Septemberyear (integer)\", -3.3202283191284883),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7256934272366524),\n                                    (\"on a <named-day>September\", -3.7256934272366524),\n                                    (\"Octoberyear (integer)\", -3.7256934272366524),\n                                    (\"Sunday<cycle> this|last|next\", -3.7256934272366524),\n                                    (\"dayweek\", -3.3202283191284883),\n                                    (\"weekyear\", -3.7256934272366524),\n                                    (\"Mondaythis|last the <cycle>\", -3.7256934272366524),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)in <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"Wednesdayin <named-month>\", -3.7256934272366524)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -0.8556661100577202, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.065455299705096),\n                                    (\"TuesdaySeptember\", -3.56953269648137),\n                                    (\"monthyear\", -2.653241964607215),\n                                    (\"on a <named-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.56953269648137),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (integer)\",\n                                     -2.8763855159214247),\n                                    (\"dayyear\", -2.4709204078132605),\n                                    (\"Monday<cycle> this|last|next\", -3.56953269648137),\n                                    (\"Wednesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.56953269648137),\n                                    (\"Septemberyear (integer)\", -3.56953269648137),\n                                    (\"on <date>year (integer)\", -3.164067588373206),\n                                    (\"Octoberyear (integer)\", -3.56953269648137),\n                                    (\"intersectyear (integer)\", -3.56953269648137),\n                                    (\"Mondayin <named-month>\", -3.56953269648137),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>year (integer)\",\n                                     -3.56953269648137),\n                                    (\"Tuesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.56953269648137),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)in <named-month>\",\n                                     -3.164067588373206)],\n                               n = 17}}),\n       (\"integer 3\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.466337068793427), (\"day\", -1.466337068793427),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.466337068793427),\n                                    (\"in <named-month>\", -1.8718021769015913)],\n                               n = 4}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sundayordinals (thirtieth..nineteenth)\", -2.1972245773362196),\n                                    (\"Tuesdayordinals (first..tenth)\", -1.791759469228055),\n                                    (\"Tuesdayordinals (thirtieth..nineteenth)\",\n                                     -2.1972245773362196),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"Saturdayordinals (thirtieth..nineteenth)\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesdayordinals (first..tenth)\", -2.1972245773362196),\n                                    (\"Tuesdayordinals (first..tenth)\", -1.791759469228055),\n                                    (\"Sundayordinals (first..tenth)\", -2.1972245773362196),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"Saturdayordinals (first..tenth)\", -2.1972245773362196)],\n                               n = 5}}),\n       (\"after part of days\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)\", -0.5108256237659907),\n                                    (\"ordinals (eleventh)\", -1.6094379124341003),\n                                    (\"ordinals (composite, e.g., eighty-seven)\",\n                                     -1.6094379124341003)],\n                               n = 7}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -2.5455312716044354),\n                                    (\"<time> <part-of-day>\", -2.322387720290225),\n                                    (\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"intersect\", -3.2386784521643803),\n                                    (\"yesterday\", -2.5455312716044354),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.2386784521643803),\n                                    (\"day\", -1.8523840910444898), (\"hour\", -1.3668762752627892),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -3.2386784521643803),\n                                    (\"minute\", -3.2386784521643803),\n                                    (\"part of days\", -2.833213344056216)],\n                               n = 20}}),\n       (\"on a <named-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Saturday\", -2.0149030205422647),\n                                    (\"Monday\", -2.0149030205422647),\n                                    (\"Friday\", -2.0149030205422647), (\"day\", -0.916290731874155),\n                                    (\"Tuesday\", -1.6094379124341003)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.6094379124341003),\n                                    (\"single <unit-of-duration>yesterday\", -2.0149030205422647),\n                                    (\"single <unit-of-duration>tomorrow\", -2.0149030205422647)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"single <unit-of-duration>intersect\", -2.3513752571634776),\n                                    (\"daymonth\", -2.3513752571634776),\n                                    (\"single <unit-of-duration>in <named-month>\",\n                                     -2.3513752571634776),\n                                    (\"single <unit-of-duration>part of days\", -2.3513752571634776),\n                                    (\"minutehour\", -1.9459101490553135),\n                                    (\"single <unit-of-duration>month (integer)\",\n                                     -2.3513752571634776),\n                                    (\"secondmonth\", -1.9459101490553135),\n                                    (\"<integer> <unit-of-duration>part of days\",\n                                     -2.3513752571634776)],\n                               n = 5}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1605\\1610\\1604\\1575\\1583\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before part of days\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (thirtieth..nineteenth)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (integer)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> n next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"week (grain)integer 3\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 5\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -2.1400661634962708),\n                                    (\"at <time-of-day>at <time-of-day>\", -1.4469189829363254),\n                                    (\"hourhour\", -1.2237754316221157),\n                                    (\"<day-of-month> (ordinal or number) <named-month><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.1400661634962708),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"at <time-of-day>\",\n                                     -2.1400661634962708)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.5040773967762742),\n                                    (\"July<day-of-month> (ordinal or number) <named-month>\",\n                                     -1.5040773967762742)],\n                               n = 1}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"this|last the <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9924301646902063),\n                                    (\"month (grain)\", -2.3978952727983707),\n                                    (\"year (grain)\", -2.3978952727983707),\n                                    (\"second\", -2.3978952727983707),\n                                    (\"week (grain)\", -1.9924301646902063),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.3978952727983707),\n                                    (\"second (grain) \", -2.3978952727983707),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"day (grain)\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -2.3978952727983707),\n                                    (\"October\", -1.7047480922384253),\n                                    (\"February\", -2.3978952727983707),\n                                    (\"March\", -1.7047480922384253), (\"month\", -0.7884573603642702)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>at <time-of-day>\", -0.916290731874155),\n                                    (\"hourhour\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -0.916290731874155),\n                                    (\"at <time-of-day>time-of-day integer (latent)\",\n                                     -1.2039728043259361),\n                                    (\"until <time-of-day>time-of-day integer (latent)\",\n                                     -1.6094379124341003)],\n                               n = 3}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..tenth)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..tenth)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.5040773967762742),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"Julyinteger (numeric)\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.6739764335716716),\n                                    (\"week (grain)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.0794415416798357),\n                                    (\"day (grain)intersect\", -2.0794415416798357),\n                                    (\"weekmonth\", -1.6739764335716716),\n                                    (\"week (grain)September\", -2.0794415416798357),\n                                    (\"day (grain)month (integer)\", -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<time> for <duration>\", -1.791759469228055),\n                                    (\"weekmonth\", -1.3862943611198906),\n                                    (\"week (grain)intersect\", -1.791759469228055)],\n                               n = 2}}),\n       (\"ordinals (composite, e.g., eighty-seven)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> last of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)month (ordinal)\", -1.9459101490553135),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"day (grain)month (integer)\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.5649493574615367),\n                                    (\"tomorrow\", -1.8718021769015913), (\"day\", -1.466337068793427),\n                                    (\"Christmas\", -2.5649493574615367),\n                                    (\"hour\", -1.466337068793427),\n                                    (\"part of days\", -1.466337068793427)],\n                               n = 10}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3629054936893685, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.1895840668738362,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> the last of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"Tuesdayin <named-month>\", -1.6094379124341003),\n                                    (\"Mondaymonth (integer)\", -1.6094379124341003),\n                                    (\"Tuesdayintersect\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (integer)\", -1.3862943611198906),\n                                    (\"March\", -1.791759469228055), (\"month\", -0.8754687373538999),\n                                    (\"in <named-month>\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -1.3862943611198906), (\"month\", -0.9808292530117262),\n                                    (\"in <named-month>\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<day-of-week> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8754687373538999), (\"Sunday\", -1.791759469228055),\n                                    (\"on a <named-day>\", -1.791759469228055),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.0986122886681098),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"Augustinteger (numeric)integer (numeric)\",\n                                     -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.367295829986474,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 27},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<hour-of-day> till third\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3862943611198906),\n                                    (\"time-of-day ordinal (latent)\", -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"time-of-day integer (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day integer (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5306282510621704,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3448404862917295),\n                                    (\"integer 3\", -1.791759469228055),\n                                    (\"integer 5\", -2.4849066497880004)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8873031950009028,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.0986122886681098),\n                                    (\"integer 10\", -0.8109302162163288),\n                                    (\"integer 3\", -2.1972245773362196),\n                                    (\"integer 5\", -2.1972245773362196)],\n                               n = 14}}),\n       (\"single <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.590439381300684, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9924301646902063),\n                                    (\"week (grain)\", -1.9924301646902063),\n                                    (\"day\", -1.9924301646902063),\n                                    (\"day (grain)\", -1.9924301646902063)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -2.797385204240618e-2, unseen = -5.6937321388027,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6458370166006375),\n                                    (\"month (grain)\", -2.2563722498389143),\n                                    (\"hour (grain)\", -2.001480000210124),\n                                    (\"year (grain)\", -2.7999876964278956),\n                                    (\"second\", -3.898599985096005),\n                                    (\"week (grain)\", -2.6458370166006375),\n                                    (\"day\", -2.5993170009657445),\n                                    (\"minute (grain)\", -3.3877743613300146),\n                                    (\"year\", -2.7999876964278956),\n                                    (\"second (grain) \", -3.898599985096005),\n                                    (\"hour\", -2.001480000210124), (\"month\", -2.2563722498389143),\n                                    (\"minute\", -3.3877743613300146),\n                                    (\"day (grain)\", -2.5993170009657445)],\n                               n = 141}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)July\", -1.0986122886681098),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"integer (numeric)integer (numeric)in <named-month>\",\n                                     -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1956}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.AR_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -4.189654742026425,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 64},\n                   koData =\n                     ClassData{prior = -1.2992829841302609, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24}}),\n       (\"ordinals (twelveth)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8109302162163288),\n                                    (\"about|exactly <time-of-day>\", -1.5040773967762742),\n                                    (\"Tuesday\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> third\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"time-of-day integer (latent)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.5040773967762742),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"day (grain)yesterday\", -1.5040773967762742)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minute (grain)part of days\", -1.252762968495368),\n                                    (\"minutehour\", -1.252762968495368)],\n                               n = 1}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2411620568168881,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)February\", -2.70805020110221),\n                                    (\"integer (numeric)in <named-month>\", -2.70805020110221),\n                                    (\"integer (numeric)April\", -2.70805020110221),\n                                    (\"integer (numeric)August\", -2.70805020110221),\n                                    (\"integer (numeric)February\", -1.791759469228055),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -2.3025850929940455),\n                                    (\"integer (numeric)March\", -2.70805020110221)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.540445040947149, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)in <named-month>\", -1.9459101490553135),\n                                    (\"month\", -1.252762968495368),\n                                    (\"integer (numeric)July\", -1.540445040947149)],\n                               n = 3}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.41616039722491244,\n                               unseen = -5.488937726156687,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"part of days\",\n                                     -4.386184644822546),\n                                    (\"<hour-of-day> till thirdafter part of days\",\n                                     -4.386184644822546),\n                                    (\"time-of-day integer (latent)after part of days\",\n                                     -4.386184644822546),\n                                    (\"at <time-of-day>before part of days\", -4.098502572370764),\n                                    (\"hh:mmbefore part of days\", -4.791649752930709),\n                                    (\"<datetime> - <datetime> (interval)part of days\",\n                                     -4.098502572370764),\n                                    (\"<time-of-day> - <time-of-day> (interval)part of days\",\n                                     -4.386184644822546),\n                                    (\"time-of-day ordinal (latent)part of days\",\n                                     -4.098502572370764),\n                                    (\"<hour-of-day> halfpart of days\", -4.386184644822546),\n                                    (\"time-of-day integer (latent)part of days\",\n                                     -3.5388867844353418),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.386184644822546),\n                                    (\"hourhour\", -1.8738790208464304),\n                                    (\"hh:mmpart of days\", -3.8753590210565547),\n                                    (\"<hour-of-day> and integer minutespart of days\",\n                                     -2.651583589434439),\n                                    (\"<hour-of-day> quarterafter part of days\", -4.791649752930709),\n                                    (\"minutehour\", -1.4243539229442357),\n                                    (\"at <time-of-day>part of days\", -2.393754480132339),\n                                    (\"intersectpart of days\", -4.791649752930709),\n                                    (\"from <datetime> - <datetime> (interval)part of days\",\n                                     -4.386184644822546),\n                                    (\"<hour-of-day> and integer minutesafter part of days\",\n                                     -4.386184644822546),\n                                    (\"at <time-of-day>after part of days\", -3.6930374642626003),\n                                    (\"<hour-of-day> quarterpart of days\", -4.386184644822546),\n                                    (\"<hour-of-day> thirdpart of days\", -4.386184644822546),\n                                    (\"from <datetime> - <datetime> (interval)after part of days\",\n                                     -4.791649752930709),\n                                    (\"time-of-day ordinal (latent)tonight\", -4.791649752930709),\n                                    (\"<datetime> - <datetime> (interval)after part of days\",\n                                     -4.791649752930709),\n                                    (\"<hour-of-day> till quarterbefore part of days\",\n                                     -4.386184644822546),\n                                    (\"<time-of-day> - <time-of-day> (interval)after part of days\",\n                                     -4.791649752930709),\n                                    (\"at <time-of-day>this <part-of-day>\", -4.791649752930709),\n                                    (\"<hour-of-day> till thirdbefore part of days\",\n                                     -4.386184644822546)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.0775588794702773,\n                               unseen = -5.0238805208462765,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)part of days\", -3.2255203675868693),\n                                    (\"time-of-day integer (latent)after part of days\",\n                                     -4.324132656254979),\n                                    (\"dayhour\", -3.2255203675868693),\n                                    (\"<hour-of-day> till thirdafter <time-of-day>\",\n                                     -3.9186675481468147),\n                                    (\"time-of-day integer (latent)after <time-of-day>\",\n                                     -3.9186675481468147),\n                                    (\"yearhour\", -3.2255203675868693),\n                                    (\"at <time-of-day>until <time-of-day>\", -3.9186675481468147),\n                                    (\"hh:mmafter part of days\", -4.324132656254979),\n                                    (\"past year (latent)part of days\", -4.324132656254979),\n                                    (\"nograinhour\", -4.324132656254979),\n                                    (\"hh:mmuntil <time-of-day>\", -4.324132656254979),\n                                    (\"<time-of-day> - <time-of-day> (interval)part of days\",\n                                     -4.324132656254979),\n                                    (\"until <time-of-day>after part of days\", -4.324132656254979),\n                                    (\"time-of-day ordinal (latent)part of days\",\n                                     -3.9186675481468147),\n                                    (\"<time-of-day> - <time-of-day> (interval)after <time-of-day>\",\n                                     -4.324132656254979),\n                                    (\"by <time>part of days\", -4.324132656254979),\n                                    (\"<datetime> - <datetime> (interval)after <time-of-day>\",\n                                     -4.324132656254979),\n                                    (\"time-of-day integer (latent)part of days\",\n                                     -4.324132656254979),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.324132656254979),\n                                    (\"hourhour\", -2.0215475632609334),\n                                    (\"past year (latent)after part of days\", -4.324132656254979),\n                                    (\"<hour-of-day> and integer minutespart of days\",\n                                     -3.6309854756950335),\n                                    (\"until <time-of-day>after <time-of-day>\", -4.324132656254979),\n                                    (\"minutehour\", -2.072840857648484),\n                                    (\"at <time-of-day>part of days\", -3.9186675481468147),\n                                    (\"until <time-of-day>part of days\", -3.9186675481468147),\n                                    (\"hh:mmafter <time-of-day>\", -4.324132656254979),\n                                    (\"at <time-of-day>after part of days\", -4.324132656254979),\n                                    (\"past year (latent)after <time-of-day>\", -4.324132656254979),\n                                    (\"from <datetime> - <datetime> (interval)after <time-of-day>\",\n                                     -4.324132656254979),\n                                    (\"<hour-of-day> till quarteruntil <time-of-day>\",\n                                     -3.9186675481468147),\n                                    (\"past year (latent)until <time-of-day>\", -4.324132656254979),\n                                    (\"past year (latent)before part of days\", -4.324132656254979),\n                                    (\"at <time-of-day>after <time-of-day>\", -3.2255203675868693),\n                                    (\"<hour-of-day> and integer minutesafter <time-of-day>\",\n                                     -3.9186675481468147)],\n                               n = 48}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"numbers prefix with -, minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 3}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.269171584511341e-2,\n                               unseen = -4.852030263919617,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> third\", -4.151039905898646),\n                                    (\"<hour-of-day> and integer minutes\", -2.5416019934645457),\n                                    (\"<hour-of-day> quarter\", -4.151039905898646),\n                                    (\"<hour-of-day> till quarter\", -3.7455747977904816),\n                                    (\"time-of-day ordinal (latent)\", -1.8997481072921507),\n                                    (\"<hour-of-day> half\", -4.151039905898646),\n                                    (\"hh:mm\", -3.2347491740244907), (\"hour\", -1.180625440328945),\n                                    (\"minute\", -1.7996646487351682),\n                                    (\"<hour-of-day> till third\", -3.7455747977904816),\n                                    (\"time-of-day integer (latent)\", -1.7996646487351682)],\n                               n = 58},\n                   koData =\n                     ClassData{prior = -2.5336968139574325,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day ordinal (latent)\", -1.9459101490553135),\n                                    (\"hour\", -1.252762968495368),\n                                    (\"time-of-day integer (latent)\", -1.6582280766035324)],\n                               n = 5}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6131044728864089,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -2.639057329615259),\n                                    (\"September\", -3.044522437723423),\n                                    (\"second\", -3.044522437723423),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.044522437723423),\n                                    (\"day\", -1.4350845252893227), (\"year\", -2.639057329615259),\n                                    (\"part of <named-month>\", -2.128231705849268),\n                                    (\"month\", -3.044522437723423),\n                                    (\"year (integer)\", -2.639057329615259),\n                                    (\"this|last the <cycle>\", -2.639057329615259),\n                                    (\"day of <named-month>\", -3.044522437723423)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.7801585575495751,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -2.9444389791664407),\n                                    (\"October\", -2.9444389791664407),\n                                    (\"intersect\", -2.0281482472922856),\n                                    (\"<time> for <duration>\", -2.538973871058276),\n                                    (\"month (ordinal)\", -2.9444389791664407),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.538973871058276),\n                                    (\"month\", -1.1526795099383855)],\n                               n = 11}}),\n       (\"<hour-of-day> and integer minutes\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (13..19)\", -2.505525936990736),\n                                    (\"at <time-of-day>integer 21..99\", -2.793208009442517),\n                                    (\"time-of-day integer (latent)integer (numeric)\",\n                                     -2.793208009442517),\n                                    (\"at <time-of-day>integer (20..90)\", -3.1986731175506815),\n                                    (\"time-of-day integer (latent)integer (13..19)\",\n                                     -3.1986731175506815),\n                                    (\"hour\", -0.9473813189441862),\n                                    (\"time-of-day ordinal (latent)integer (20..90)\",\n                                     -3.1986731175506815),\n                                    (\"time-of-day ordinal (latent)integer (numeric)\",\n                                     -3.1986731175506815),\n                                    (\"at <time-of-day>integer (numeric)\", -2.505525936990736),\n                                    (\"time-of-day ordinal (latent)integer 21..99\",\n                                     -2.793208009442517),\n                                    (\"time-of-day ordinal (latent)integer (13..19)\",\n                                     -2.793208009442517)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day integer (latent)integer 21..99\",\n                                     -2.2512917986064953),\n                                    (\"time-of-day integer (latent)integer (20..90)\",\n                                     -1.845826690498331),\n                                    (\"hour\", -1.55814461804655)],\n                               n = 3}}),\n       (\"this|last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"week (grain)\", -1.791759469228055),\n                                    (\"day\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"day (grain)\", -1.791759469228055)],\n                               n = 3}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -2.0149030205422647, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.1431008436406733, unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0986122886681098),\n                                    (\"dual <unit-of-duration>\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003), (\"year\", -1.2039728043259361),\n                                    (\"single <unit-of-duration>\", -0.916290731874155)],\n                               n = 3}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 39}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.5458224658030868,\n                               unseen = -5.5134287461649825,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesdayon <date>\", -4.816241156068032),\n                                    (\"in <named-month>year\", -4.816241156068032),\n                                    (\"<hour-of-day> till thirdafter part of days\",\n                                     -4.410776047959867),\n                                    (\"dayhour\", -3.899950424193877),\n                                    (\"daymonth\", -4.816241156068032),\n                                    (\"in <named-month>on <date>\", -4.816241156068032),\n                                    (\"monthyear\", -3.312163759291758),\n                                    (\"Mondayon <date>\", -4.816241156068032),\n                                    (\"Christmasyear\", -4.816241156068032),\n                                    (\"Monday<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"month (integer)year (integer)\", -4.410776047959867),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1605\\1610\\1604\\1575\\1583year\",\n                                     -4.816241156068032),\n                                    (\"<day-of-week> the last of <time><cycle> this|last|next\",\n                                     -4.816241156068032),\n                                    (\"at <time-of-day>before part of days\", -4.123093975508087),\n                                    (\"hh:mmbefore part of days\", -4.816241156068032),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -4.816241156068032),\n                                    (\"intersect<time> <part-of-day>\", -4.410776047959867),\n                                    (\"month (ordinal)year (integer)\", -4.816241156068032),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1589\\1581year\",\n                                     -4.816241156068032),\n                                    (\"dd/mm<time> <part-of-day>\", -4.816241156068032),\n                                    (\"Thursday<time> timezone\", -4.410776047959867),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.410776047959867),\n                                    (\"dayday\", -3.024481686839977),\n                                    (\"absorption of , after named day<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"hourhour\", -3.717628867399922),\n                                    (\"month (integer)year\", -4.816241156068032),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1591\\1585year\",\n                                     -4.816241156068032),\n                                    (\"Thursday<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"dayyear\", -2.9444389791664407),\n                                    (\"Thursday<time> <part-of-day>\", -4.816241156068032),\n                                    (\"<cycle> last of <time>year (integer)\", -4.410776047959867),\n                                    (\"last <cycle> of <time>year (integer)\", -4.816241156068032),\n                                    (\"<hour-of-day> quarterafter part of days\", -4.816241156068032),\n                                    (\"minutehour\", -2.513656063073986),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -4.816241156068032),\n                                    (\"\\1585\\1571\\1587 \\1575\\1604\\1587\\1606\\1577 \\1575\\1604\\1607\\1580\\1585\\1610\\1577year\",\n                                     -4.816241156068032),\n                                    (\"Monday<cycle> this|last|next\", -4.816241156068032),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>year\",\n                                     -4.816241156068032),\n                                    (\"<cycle> <ordinal> day? of <time>year\", -4.816241156068032),\n                                    (\"\\1593\\1610\\1583 \\1575\\1604\\1571\\1590\\1581\\1609year\",\n                                     -4.816241156068032),\n                                    (\"on a <named-day>dd/mm\", -4.816241156068032),\n                                    (\"on a <named-day>on <date>\", -4.816241156068032),\n                                    (\"on a <named-day><day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"Tuesday<cycle> this|last|next\", -4.816241156068032),\n                                    (\"dayminute\", -3.563478187572664),\n                                    (\"dd/mmintersect\", -4.816241156068032),\n                                    (\"in <named-month><cycle> this|last|next\", -4.816241156068032),\n                                    (\"<hour-of-day> and integer minutesafter part of days\",\n                                     -4.410776047959867),\n                                    (\"Saturdaydd/mm\", -4.816241156068032),\n                                    (\"\\1585\\1605\\1590\\1575\\1606year\", -4.816241156068032),\n                                    (\"the <cycle> the <ordinal> of <time>year\", -4.816241156068032),\n                                    (\"at <time-of-day>after part of days\", -3.717628867399922),\n                                    (\"<ordinal> <cycle> of <time>year\", -4.816241156068032),\n                                    (\"Sunday<cycle> this|last|next\", -4.816241156068032),\n                                    (\"Tuesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.410776047959867),\n                                    (\"Septemberon <date>\", -4.816241156068032),\n                                    (\"from <datetime> - <datetime> (interval)after part of days\",\n                                     -4.816241156068032),\n                                    (\"intersectintersect\", -4.410776047959867),\n                                    (\"dayweek\", -4.123093975508087),\n                                    (\"weekyear\", -3.899950424193877),\n                                    (\"<datetime> - <datetime> (interval)after part of days\",\n                                     -4.816241156068032),\n                                    (\"Friday<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.816241156068032),\n                                    (\"<hour-of-day> till quarterbefore part of days\",\n                                     -4.410776047959867),\n                                    (\"<time-of-day> - <time-of-day> (interval)after part of days\",\n                                     -4.816241156068032),\n                                    (\"at <time-of-day>this <part-of-day>\", -4.816241156068032),\n                                    (\"<hour-of-day> till thirdbefore part of days\",\n                                     -4.410776047959867)],\n                               n = 73},\n                   koData =\n                     ClassData{prior = -0.8659899933993561, unseen = -5.337538079701318,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesdayon <date>\", -4.639571612705423),\n                                    (\"dayhour\", -3.1354942159291497),\n                                    (\"daymonth\", -3.5409593240373143),\n                                    (\"monthday\", -4.639571612705423),\n                                    (\"monthyear\", -2.7677694358038325),\n                                    (\"hh:mmafter part of days\", -4.639571612705423),\n                                    (\"houryear\", -4.639571612705423),\n                                    (\"intersectat <time-of-day>\", -3.7232808808312687),\n                                    (\"intersect<time> <part-of-day>\", -4.23410650459726),\n                                    (\"Octoberon <date>\", -4.639571612705423),\n                                    (\"until <time-of-day>after part of days\", -4.639571612705423),\n                                    (\"Tuesdayafter <time-of-day>\", -4.639571612705423),\n                                    (\"Wednesdayon <date>\", -4.23410650459726),\n                                    (\"dd/mm<time> <part-of-day>\", -4.639571612705423),\n                                    (\"yearyear\", -4.23410650459726),\n                                    (\"<hour-of-day> till quarterthis <part-of-day>\",\n                                     -4.639571612705423),\n                                    (\"dayday\", -3.9464244321454784),\n                                    (\"dd/mmat <time-of-day>\", -4.23410650459726),\n                                    (\"hourhour\", -4.23410650459726),\n                                    (\"dayyear\", -3.386808644210056),\n                                    (\"Thursdayat <time-of-day>\", -4.23410650459726),\n                                    (\"Februaryyear\", -4.639571612705423),\n                                    (\"minutemonth\", -4.639571612705423),\n                                    (\"minutehour\", -4.23410650459726),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>year\",\n                                     -4.23410650459726),\n                                    (\"March<cycle> this|last|next\", -4.639571612705423),\n                                    (\"nth <time> of <time>year\", -4.639571612705423),\n                                    (\"Wednesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.639571612705423),\n                                    (\"secondyear\", -4.639571612705423),\n                                    (\"Wednesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.639571612705423),\n                                    (\"on <date>year (integer)\", -4.639571612705423),\n                                    (\"<time> for <duration>year\", -3.5409593240373143),\n                                    (\"<duration> after|before|from <time>on <date>\",\n                                     -4.639571612705423),\n                                    (\"dayminute\", -3.1354942159291497),\n                                    (\"Julyuntil <time-of-day>\", -4.639571612705423),\n                                    (\"intersecton <date>\", -4.639571612705423),\n                                    (\"at <time-of-day>after part of days\", -4.639571612705423),\n                                    (\"Octoberyear\", -4.639571612705423),\n                                    (\"in|within|after <duration>year\", -4.23410650459726),\n                                    (\"Tuesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.639571612705423),\n                                    (\"on a <named-day>intersect\", -4.23410650459726),\n                                    (\"Saturdayintersect\", -4.23410650459726),\n                                    (\"on <date>year\", -4.23410650459726),\n                                    (\"on <date>on <date>\", -4.639571612705423),\n                                    (\"Tuesdaynth <time> of <time>\", -4.639571612705423),\n                                    (\"weekyear\", -4.639571612705423),\n                                    (\"Tuesdayintersect\", -4.639571612705423),\n                                    (\"after <time-of-day>year\", -4.639571612705423),\n                                    (\"in <number> (implicit minutes)February\", -4.639571612705423),\n                                    (\"last <cycle> of <time>year\", -4.639571612705423),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>on <date>\",\n                                     -4.639571612705423)],\n                               n = 53}}),\n       (\"\\1585\\1605\\1590\\1575\\1606\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> the <ordinal> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)ordinals (first..tenth)October\",\n                                     -2.0794415416798357),\n                                    (\"daymonth\", -1.3862943611198906),\n                                    (\"week (grain)ordinals (first..tenth)month (integer)\",\n                                     -2.0794415416798357),\n                                    (\"weekmonth\", -1.6739764335716716),\n                                    (\"week (grain)ordinals (first..tenth)intersect\",\n                                     -2.0794415416798357),\n                                    (\"day (grain)ordinals (first..tenth)month (integer)\",\n                                     -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinals (first..tenth)week (grain)in <named-month>\",\n                                     -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (first..tenth)week (grain)intersect\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..tenth)day (grain)month (integer)\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2237754316221157,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.3483066942682157, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.791759469228055),\n                                    (\"at <time-of-day>at <time-of-day>\", -1.0986122886681098),\n                                    (\"hourhour\", -1.0986122886681098),\n                                    (\"<day-of-month> (ordinal or number) <named-month><day-of-month> (ordinal or number) <named-month>\",\n                                     -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8754687373538999), (\"Sunday\", -1.791759469228055),\n                                    (\"on a <named-day>\", -1.791759469228055),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 5integer (20..90)\", -0.6931471805599453),\n                                    (\"integer 3integer (20..90)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (13..19)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 5integer 10\", -0.916290731874155),\n                                    (\"integer 8integer 10\", -0.5108256237659907)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectsingle <unit-of-duration>\", -2.4423470353692043),\n                                    (\"monthyear\", -1.5260563034950494),\n                                    (\"nth <time> of <time>single <unit-of-duration>\",\n                                     -2.4423470353692043),\n                                    (\"dayyear\", -2.03688192726104),\n                                    (\"last <cycle> of <time>single <unit-of-duration>\",\n                                     -2.4423470353692043),\n                                    (\"weekyear\", -2.4423470353692043),\n                                    (\"Octobersingle <unit-of-duration>\", -2.4423470353692043),\n                                    (\"Septembersingle <unit-of-duration>\", -2.4423470353692043),\n                                    (\"on <date>single <unit-of-duration>\", -2.03688192726104)],\n                               n = 7}}),\n       (\"from <day-of-month> (ordinal or number) to <day-of-month> (ordinal or number) in <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)month (ordinal)\",\n                                     -1.252762968495368),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"ordinals (composite, e.g., eighty-seven)ordinals (composite, e.g., eighty-seven)in <named-month>\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (first..tenth)\",\n        Classifier{okData =\n                     ClassData{prior = -0.21825356602001794,\n                               unseen = -3.7612001156935624,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 41},\n                   koData =\n                     ClassData{prior = -1.62924053973028, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1571\\1590\\1581\\1609\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (twenty, thirty..ninety)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer 10\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"<time> nth of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0296194171811581),\n                                    (\"Wednesdayordinals (first..tenth)intersect\",\n                                     -1.9459101490553135),\n                                    (\"Tuesdayordinals (first..tenth)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.9459101490553135),\n                                    (\"Tuesdayordinals (first..tenth)in <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"Tuesdayordinals (first..tenth)October\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.2039728043259361),\n                                    (\"Tuesdayordinals (first..tenth)in <named-month>\",\n                                     -1.6094379124341003),\n                                    (\"Wednesdayordinals (first..tenth)in <named-month>\",\n                                     -1.6094379124341003)],\n                               n = 2}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.6739764335716716),\n                                    (\"ordinals (first..tenth)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (integer)\",\n                                     -2.367123614131617),\n                                    (\"ordinals (first..tenth)on a <named-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.772588722239781),\n                                    (\"dayyear\", -2.0794415416798357),\n                                    (\"ordinals (first..tenth)Tuesdaymonth (integer)\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)Wednesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.367123614131617),\n                                    (\"ordinals (first..tenth)intersectyear (integer)\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)Tuesdayintersect\",\n                                     -2.772588722239781)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)TuesdaySeptember\", -2.772588722239781),\n                                    (\"ordinals (first..tenth)time-of-day integer (latent)intersect\",\n                                     -2.772588722239781),\n                                    (\"daymonth\", -1.8562979903656263),\n                                    (\"ordinals (first..tenth)time-of-day integer (latent)February\",\n                                     -2.367123614131617),\n                                    (\"hourmonth\", -1.8562979903656263),\n                                    (\"ordinals (first..tenth)WednesdayOctober\", -2.772588722239781),\n                                    (\"ordinals (first..tenth)on a <named-day>September\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)time-of-day integer (latent)this|last the <cycle>\",\n                                     -2.772588722239781),\n                                    (\"ordinals (first..tenth)Wednesdayin <named-month>\",\n                                     -2.772588722239781)],\n                               n = 8}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.5040773967762742),\n                                    (\"time-of-day ordinal (latent)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1585\\1571\\1587 \\1575\\1604\\1587\\1606\\1577 \\1575\\1604\\1607\\1580\\1585\\1610\\1577\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> till quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3862943611198906),\n                                    (\"time-of-day ordinal (latent)\", -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"time-of-day integer (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.0986122886681098),\n                                    (\"time-of-day integer (latent)\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"past year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 3}}),\n       (\"integer 8\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.570544858467613, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (thirtieth..nineteenth)February\",\n                                     -2.5902671654458267),\n                                    (\"ordinals (first..tenth)October\", -2.5902671654458267),\n                                    (\"ordinals (first..tenth)April\", -2.5902671654458267),\n                                    (\"ordinals (first..tenth)February\", -2.995732273553991),\n                                    (\"ordinals (first..tenth)month (integer)\", -2.5902671654458267),\n                                    (\"ordinals (first..tenth)March\", -2.5902671654458267),\n                                    (\"month\", -1.0498221244986778),\n                                    (\"ordinals (first..tenth)in <named-month>\",\n                                     -2.5902671654458267)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.832909122935104, unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 2in <named-month>\", -2.833213344056216),\n                                    (\"integer 10February\", -2.4277482359480516),\n                                    (\"integer (numeric)month (ordinal)\", -2.833213344056216),\n                                    (\"ordinals (first..tenth)month (integer)\", -2.833213344056216),\n                                    (\"integer (20..90)in <named-month>\", -2.833213344056216),\n                                    (\"ordinals (composite, e.g., eighty-seven)in <named-month>\",\n                                     -2.833213344056216),\n                                    (\"ordinals (twenty, thirty..ninety)in <named-month>\",\n                                     -2.833213344056216),\n                                    (\"month\", -1.128465251817791),\n                                    (\"ordinals (first..tenth)in <named-month>\",\n                                     -2.4277482359480516)],\n                               n = 10}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"<cycle> <ordinal> day? of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)ordinals (first..tenth)October\",\n                                     -2.0794415416798357),\n                                    (\"daymonth\", -1.3862943611198906),\n                                    (\"week (grain)ordinals (first..tenth)month (integer)\",\n                                     -2.0794415416798357),\n                                    (\"weekmonth\", -1.6739764335716716),\n                                    (\"week (grain)ordinals (first..tenth)intersect\",\n                                     -2.0794415416798357),\n                                    (\"day (grain)ordinals (first..tenth)month (integer)\",\n                                     -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> this|last|next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -2.5649493574615367),\n                                    (\"year (grain)\", -2.341805806147327),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"day\", -2.5649493574615367), (\"year\", -2.341805806147327),\n                                    (\"month\", -2.5649493574615367),\n                                    (\"day (grain)\", -2.5649493574615367)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day ordinal (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13976194237515874,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (twelveth)\", -2.03688192726104),\n                                    (\"ordinals (first..tenth)\", -0.3022808718729337),\n                                    (\"ordinals (eleventh)\", -2.03688192726104)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -2.03688192726104, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)\", -0.40546510810816444)],\n                               n = 3}}),\n       (\"ordinals (eleventh)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.2992829841302609),\n                                    (\"hour\", -1.7047480922384253), (\"minute\", -1.7047480922384253)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.1400661634962708),\n                                    (\"time-of-day ordinal (latent)\", -2.1400661634962708),\n                                    (\"day\", -1.4469189829363254),\n                                    (\"<day-of-month> (ordinal)\", -1.7346010553881064),\n                                    (\"hour\", -1.7346010553881064)],\n                               n = 5}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1591\\1585\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<hour-of-day> half\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3862943611198906),\n                                    (\"time-of-day ordinal (latent)\", -1.3862943611198906),\n                                    (\"hour\", -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.0986122886681098),\n                                    (\"time-of-day integer (latent)\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"month (integer)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.8718021769015913),\n                                    (\"integer 10\", -0.6190392084062235),\n                                    (\"integer 3\", -1.1786549963416462)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.7419373447293773,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.6466271649250525,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8472978603872037),\n                                    (\"Monday<cycle> this|last|next\", -1.252762968495368),\n                                    (\"Mondayin <named-month>\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 10minute (grain)\", -2.4423470353692043),\n                                    (\"year\", -2.7300291078209855),\n                                    (\"integer 10year (grain)\", -2.7300291078209855),\n                                    (\"integer (20..90)minute (grain)\", -2.4423470353692043),\n                                    (\"month\", -2.7300291078209855),\n                                    (\"integer (numeric)minute (grain)\", -2.4423470353692043),\n                                    (\"integer (numeric)month (grain)\", -2.7300291078209855),\n                                    (\"minute\", -1.120591195386885),\n                                    (\"integer 21..99minute (grain)\", -2.7300291078209855),\n                                    (\"integer (13..19)minute (grain)\", -2.4423470353692043)],\n                               n = 18}}),\n       (\"dual <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"week (grain)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 10\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"from <day-of-month> (ordinal or number) to <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)July\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"integer (numeric)integer (numeric)in <named-month>\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -1.2992829841302609), (\"month\", -0.7884573603642702),\n                                    (\"in <named-month>\", -1.2992829841302609)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<hour-of-day> and integer\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (13..19)\", -2.0794415416798357),\n                                    (\"at <time-of-day>integer 21..99\", -1.6739764335716716),\n                                    (\"hour\", -1.1631508098056809),\n                                    (\"at <time-of-day>integer (numeric)\", -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer 5\", -2.2335922215070942),\n                                    (\"at <time-of-day>integer (13..19)\", -2.2335922215070942),\n                                    (\"at <time-of-day>integer 3\", -2.639057329615259),\n                                    (\"at <time-of-day>integer (20..90)\", -2.639057329615259),\n                                    (\"at <time-of-day>integer 8\", -2.2335922215070942),\n                                    (\"hour\", -0.9343092373768334),\n                                    (\"at <time-of-day>integer (numeric)\", -2.2335922215070942)],\n                               n = 10}}),\n       (\"month (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"ordinals (first..tenth)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1601\\1589\\1581\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.2992829841302609),\n                                    (\"dayday\", -0.7884573603642702),\n                                    (\"day (grain)yesterday\", -1.2992829841302609)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-week> next\", -1.8718021769015913),\n                                    (\"at <time-of-day>\", -1.466337068793427),\n                                    (\"day\", -1.466337068793427), (\"hour\", -1.466337068793427),\n                                    (\"Tuesday\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -2.2512917986064953,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.9808292530117262),\n                                    (\"single <unit-of-duration>\", -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.11122563511022437,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -2.538973871058276), (\"month\", -0.8649974374866046),\n                                    (\"single <unit-of-duration>\", -0.7472144018302211)],\n                               n = 17}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5533852381847867, unseen = -4.430816798843313,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.627081138568543),\n                                    (\"daymonth\", -2.472930458741285),\n                                    (\"monthyear\", -2.627081138568543),\n                                    (\"Wednesdayintersect\", -3.7256934272366524),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)October\",\n                                     -3.7256934272366524),\n                                    (\"Wednesday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"dayday\", -2.8094026953624978),\n                                    (\"Thursday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"in <named-month>year (integer)\", -3.3202283191284883),\n                                    (\"Thursdayat <time-of-day>\", -3.7256934272366524),\n                                    (\"Thursday<time> <part-of-day>\", -3.3202283191284883),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)this|last the <cycle>\",\n                                     -3.7256934272366524),\n                                    (\"last <cycle> of <time>year (integer)\", -3.7256934272366524),\n                                    (\"Tuesdaymonth (integer)\", -3.7256934272366524),\n                                    (\"Wednesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -3.7256934272366524),\n                                    (\"Septemberyear (integer)\", -3.3202283191284883),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7256934272366524),\n                                    (\"on a <named-day>September\", -3.7256934272366524),\n                                    (\"Octoberyear (integer)\", -3.7256934272366524),\n                                    (\"Sunday<cycle> this|last|next\", -3.7256934272366524),\n                                    (\"dayweek\", -3.3202283191284883),\n                                    (\"weekyear\", -3.7256934272366524),\n                                    (\"Mondaythis|last the <cycle>\", -3.7256934272366524),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)in <named-month>\",\n                                     -3.7256934272366524),\n                                    (\"Wednesdayin <named-month>\", -3.7256934272366524)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -0.8556661100577202, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.065455299705096),\n                                    (\"TuesdaySeptember\", -3.56953269648137),\n                                    (\"monthyear\", -2.653241964607215),\n                                    (\"on a <named-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.56953269648137),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (integer)\",\n                                     -2.8763855159214247),\n                                    (\"dayyear\", -2.4709204078132605),\n                                    (\"Monday<cycle> this|last|next\", -3.56953269648137),\n                                    (\"Wednesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.56953269648137),\n                                    (\"Septemberyear (integer)\", -3.56953269648137),\n                                    (\"on <date>year (integer)\", -3.164067588373206),\n                                    (\"Octoberyear (integer)\", -3.56953269648137),\n                                    (\"intersectyear (integer)\", -3.56953269648137),\n                                    (\"Mondayin <named-month>\", -3.56953269648137),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>year (integer)\",\n                                     -3.56953269648137),\n                                    (\"Tuesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.56953269648137),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)in <named-month>\",\n                                     -3.164067588373206)],\n                               n = 17}}),\n       (\"integer 3\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.466337068793427), (\"day\", -1.466337068793427),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.466337068793427),\n                                    (\"in <named-month>\", -1.8718021769015913)],\n                               n = 4}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sundayordinals (thirtieth..nineteenth)\", -2.1972245773362196),\n                                    (\"Tuesdayordinals (first..tenth)\", -1.791759469228055),\n                                    (\"Tuesdayordinals (thirtieth..nineteenth)\",\n                                     -2.1972245773362196),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"Saturdayordinals (thirtieth..nineteenth)\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesdayordinals (first..tenth)\", -2.1972245773362196),\n                                    (\"Tuesdayordinals (first..tenth)\", -1.791759469228055),\n                                    (\"Sundayordinals (first..tenth)\", -2.1972245773362196),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"Saturdayordinals (first..tenth)\", -2.1972245773362196)],\n                               n = 5}}),\n       (\"after part of days\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..tenth)\", -0.5108256237659907),\n                                    (\"ordinals (eleventh)\", -1.6094379124341003),\n                                    (\"ordinals (composite, e.g., eighty-seven)\",\n                                     -1.6094379124341003)],\n                               n = 7}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -2.5455312716044354),\n                                    (\"<time> <part-of-day>\", -2.322387720290225),\n                                    (\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"intersect\", -3.2386784521643803),\n                                    (\"yesterday\", -2.5455312716044354),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.2386784521643803),\n                                    (\"day\", -1.8523840910444898), (\"hour\", -1.3668762752627892),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -3.2386784521643803),\n                                    (\"minute\", -3.2386784521643803),\n                                    (\"part of days\", -2.833213344056216)],\n                               n = 20}}),\n       (\"on a <named-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Saturday\", -2.0149030205422647),\n                                    (\"Monday\", -2.0149030205422647),\n                                    (\"Friday\", -2.0149030205422647), (\"day\", -0.916290731874155),\n                                    (\"Tuesday\", -1.6094379124341003)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.6094379124341003),\n                                    (\"single <unit-of-duration>yesterday\", -2.0149030205422647),\n                                    (\"single <unit-of-duration>tomorrow\", -2.0149030205422647)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"single <unit-of-duration>intersect\", -2.3513752571634776),\n                                    (\"daymonth\", -2.3513752571634776),\n                                    (\"single <unit-of-duration>in <named-month>\",\n                                     -2.3513752571634776),\n                                    (\"single <unit-of-duration>part of days\", -2.3513752571634776),\n                                    (\"minutehour\", -1.9459101490553135),\n                                    (\"single <unit-of-duration>month (integer)\",\n                                     -2.3513752571634776),\n                                    (\"secondmonth\", -1.9459101490553135),\n                                    (\"<integer> <unit-of-duration>part of days\",\n                                     -2.3513752571634776)],\n                               n = 5}}),\n       (\"\\1593\\1610\\1583 \\1575\\1604\\1605\\1610\\1604\\1575\\1583\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before part of days\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (thirtieth..nineteenth)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (integer)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> n next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"week (grain)integer 3\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 5\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -2.1400661634962708),\n                                    (\"at <time-of-day>at <time-of-day>\", -1.4469189829363254),\n                                    (\"hourhour\", -1.2237754316221157),\n                                    (\"<day-of-month> (ordinal or number) <named-month><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.1400661634962708),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"at <time-of-day>\",\n                                     -2.1400661634962708)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.5040773967762742),\n                                    (\"July<day-of-month> (ordinal or number) <named-month>\",\n                                     -1.5040773967762742)],\n                               n = 1}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"this|last the <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9924301646902063),\n                                    (\"month (grain)\", -2.3978952727983707),\n                                    (\"year (grain)\", -2.3978952727983707),\n                                    (\"second\", -2.3978952727983707),\n                                    (\"week (grain)\", -1.9924301646902063),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.3978952727983707),\n                                    (\"second (grain) \", -2.3978952727983707),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"day (grain)\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -2.3978952727983707),\n                                    (\"October\", -1.7047480922384253),\n                                    (\"February\", -2.3978952727983707),\n                                    (\"March\", -1.7047480922384253), (\"month\", -0.7884573603642702)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>at <time-of-day>\", -0.916290731874155),\n                                    (\"hourhour\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -0.916290731874155),\n                                    (\"at <time-of-day>time-of-day integer (latent)\",\n                                     -1.2039728043259361),\n                                    (\"until <time-of-day>time-of-day integer (latent)\",\n                                     -1.6094379124341003)],\n                               n = 3}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..tenth)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..tenth)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.5040773967762742),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"Julyinteger (numeric)\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.6739764335716716),\n                                    (\"week (grain)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.0794415416798357),\n                                    (\"day (grain)intersect\", -2.0794415416798357),\n                                    (\"weekmonth\", -1.6739764335716716),\n                                    (\"week (grain)September\", -2.0794415416798357),\n                                    (\"day (grain)month (integer)\", -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<time> for <duration>\", -1.791759469228055),\n                                    (\"weekmonth\", -1.3862943611198906),\n                                    (\"week (grain)intersect\", -1.791759469228055)],\n                               n = 2}}),\n       (\"ordinals (composite, e.g., eighty-seven)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> last of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)month (ordinal)\", -1.9459101490553135),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"day (grain)month (integer)\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.5649493574615367),\n                                    (\"tomorrow\", -1.8718021769015913), (\"day\", -1.466337068793427),\n                                    (\"Christmas\", -2.5649493574615367),\n                                    (\"hour\", -1.466337068793427),\n                                    (\"part of days\", -1.466337068793427)],\n                               n = 10}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3629054936893685, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.1895840668738362,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> the last of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"Tuesdayin <named-month>\", -1.6094379124341003),\n                                    (\"Mondaymonth (integer)\", -1.6094379124341003),\n                                    (\"Tuesdayintersect\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (integer)\", -1.3862943611198906),\n                                    (\"March\", -1.791759469228055), (\"month\", -0.8754687373538999),\n                                    (\"in <named-month>\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -1.3862943611198906), (\"month\", -0.9808292530117262),\n                                    (\"in <named-month>\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<day-of-week> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8754687373538999), (\"Sunday\", -1.791759469228055),\n                                    (\"on a <named-day>\", -1.791759469228055),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.0986122886681098),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"Augustinteger (numeric)integer (numeric)\",\n                                     -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.367295829986474,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 27},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<hour-of-day> till third\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3862943611198906),\n                                    (\"time-of-day ordinal (latent)\", -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"time-of-day integer (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day integer (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5306282510621704,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3448404862917295),\n                                    (\"integer 3\", -1.791759469228055),\n                                    (\"integer 5\", -2.4849066497880004)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8873031950009028,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.0986122886681098),\n                                    (\"integer 10\", -0.8109302162163288),\n                                    (\"integer 3\", -2.1972245773362196),\n                                    (\"integer 5\", -2.1972245773362196)],\n                               n = 14}}),\n       (\"single <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.590439381300684, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9924301646902063),\n                                    (\"week (grain)\", -1.9924301646902063),\n                                    (\"day\", -1.9924301646902063),\n                                    (\"day (grain)\", -1.9924301646902063)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -2.797385204240618e-2, unseen = -5.6937321388027,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6458370166006375),\n                                    (\"month (grain)\", -2.2563722498389143),\n                                    (\"hour (grain)\", -2.001480000210124),\n                                    (\"year (grain)\", -2.7999876964278956),\n                                    (\"second\", -3.898599985096005),\n                                    (\"week (grain)\", -2.6458370166006375),\n                                    (\"day\", -2.5993170009657445),\n                                    (\"minute (grain)\", -3.3877743613300146),\n                                    (\"year\", -2.7999876964278956),\n                                    (\"second (grain) \", -3.898599985096005),\n                                    (\"hour\", -2.001480000210124), (\"month\", -2.2563722498389143),\n                                    (\"minute\", -3.3877743613300146),\n                                    (\"day (grain)\", -2.5993170009657445)],\n                               n = 141}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)July\", -1.0986122886681098),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"integer (numeric)integer (numeric)in <named-month>\",\n                                     -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1956}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.BG_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.0149030205422647),\n                                    (\"day\", -1.6094379124341003),\n                                    (\"the <day-of-month> (number)\", -1.6094379124341003),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"hour\", -1.3217558399823195)],\n                               n = 5}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)March\", -2.0794415416798357),\n                                    (\"integer (numeric)April\", -2.0794415416798357),\n                                    (\"integer (numeric)August\", -2.0794415416798357),\n                                    (\"integer (numeric)February\", -2.0794415416798357),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)March\", -2.0794415416798357)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.0986122886681098),\n                                    (\"at <time-of-day>part of days\", -1.5040773967762742),\n                                    (\"time-of-day (latent)part of days\", -1.5040773967762742)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1786549963416462),\n                                    (\"the <day-of-month> (number)part of days\",\n                                     -1.1786549963416462),\n                                    (\"hourhour\", -1.8718021769015913),\n                                    (\"time-of-day (latent)part of days\", -1.8718021769015913)],\n                               n = 4}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am\", -2.0149030205422647),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hh:mm\", -2.0149030205422647), (\"hour\", -1.0986122886681098),\n                                    (\"minute\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -1.252762968495368)],\n                               n = 1}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm\", -1.0986122886681098),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.252762968495368), (\"year\", -1.252762968495368),\n                                    (\"<integer> <unit-of-duration>\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.3978952727983707),\n                                    (\"monthyear\", -2.3978952727983707),\n                                    (\"Octoberyear (latent)\", -2.3978952727983707),\n                                    (\"todayat <time-of-day>\", -2.3978952727983707),\n                                    (\"dayday\", -2.3978952727983707),\n                                    (\"absorption of , after named day<day-of-month> (ordinal or number) <named-month>\",\n                                     -2.3978952727983707),\n                                    (\"dayyear\", -2.3978952727983707),\n                                    (\"the <day-of-month> (ordinal)March\", -2.3978952727983707),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -2.3978952727983707),\n                                    (\"dayminute\", -2.3978952727983707)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0794415416798357),\n                                    (\"monthyear\", -2.0794415416798357),\n                                    (\"todayat <time-of-day>\", -2.0794415416798357),\n                                    (\"Aprilyear (latent)\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.7047480922384253),\n                                    (\"time-of-day (latent)\", -1.7047480922384253),\n                                    (\"hh:mm\", -1.7047480922384253), (\"hour\", -1.2992829841302609),\n                                    (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -1.252762968495368)],\n                               n = 1}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tonight\", -1.252762968495368), (\"hour\", -0.8472978603872037),\n                                    (\"part of days\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"month (grain)\", -2.3025850929940455),\n                                    (\"year (grain)\", -1.6094379124341003),\n                                    (\"week (grain)\", -1.6094379124341003),\n                                    (\"year\", -1.6094379124341003), (\"month\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Friday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"ordinals (first..19th)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8109302162163288,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.40546510810816444),\n                                    (\"number (0..19)\", -1.0986122886681098)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.587786664902119, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.15415067982725836)],\n                               n = 5}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)day (grain)\", -1.6094379124341003),\n                                    (\"integer (numeric)year (grain)\", -1.6094379124341003),\n                                    (\"day\", -1.6094379124341003), (\"year\", -1.6094379124341003)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"integer (numeric)hour (grain)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"ordinals (first..19th)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"the <day-of-month> (ordinal)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.0149030205422647),\n                                    (\"month (grain)\", -2.70805020110221),\n                                    (\"hour (grain)\", -2.70805020110221),\n                                    (\"year (grain)\", -1.791759469228055),\n                                    (\"week (grain)\", -2.0149030205422647),\n                                    (\"day\", -2.70805020110221), (\"year\", -1.791759469228055),\n                                    (\"hour\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"day (grain)\", -2.70805020110221)],\n                               n = 10}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday<day-of-month> (ordinal or number) <named-month>\",\n                                     -0.6931471805599453),\n                                    (\"dayday\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd.mm.yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.5040773967762742), (\"March\", -1.5040773967762742),\n                                    (\"month\", -1.5040773967762742),\n                                    (\"Tuesday\", -1.5040773967762742)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Friday\", -1.252762968495368), (\"day\", -1.252762968495368)],\n                               n = 1}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.916290731874155), (\"month\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"April\", -0.8472978603872037), (\"month\", -0.8472978603872037)],\n                               n = 2}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.3862943611198906), (\"day\", -0.9808292530117262),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Friday\", -1.0986122886681098), (\"day\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.6094379124341003), (\"day\", -0.916290731874155),\n                                    (\"winter\", -1.6094379124341003),\n                                    (\"summer\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 658}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.BN_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.CA_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6644370746775139, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53},\n                   koData =\n                     ClassData{prior = -0.7227059828014897, unseen = -3.951243718581427,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 50}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"el <time>\", -1.3862943611198906),\n                                    (\"day\", -0.8754687373538999), (\"Diumenge\", -1.791759469228055),\n                                    (\"Dimarts\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.17768117723745236,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Dillunseste|en un <cycle>\", -3.960813169597578),\n                                    (\"<day-of-month> de <named-month>year (value by adding three composing numbers together)\",\n                                     -3.960813169597578),\n                                    (\"el <day-of-month> (non ordinal)Setembre\",\n                                     -3.5553480614894135),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.960813169597578),\n                                    (\"daymonth\", -1.6094379124341003),\n                                    (\"monthyear\", -3.960813169597578),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -3.960813169597578),\n                                    (\"Dimecresel <cycle> (proximo|que viene)\", -3.960813169597578),\n                                    (\"Maigyear\", -3.960813169597578),\n                                    (\"Dimecreseste|en un <cycle>\", -3.960813169597578),\n                                    (\"dayyear\", -2.5745188084776873),\n                                    (\"quarteryear\", -3.960813169597578),\n                                    (\"dd-dd <month>(interval)year\", -3.5553480614894135),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -3.960813169597578),\n                                    (\"el <day-of-month> (non ordinal)Maig\", -3.2676659890376327),\n                                    (\"el <time>year\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>year\", -3.960813169597578),\n                                    (\"el <time>Mar\\231\", -3.960813169597578),\n                                    (\"el <day-of-month> (non ordinal)Febrer\", -3.960813169597578),\n                                    (\"el <time>este|en un <cycle>\", -3.5553480614894135),\n                                    (\"el <day-of-month> (non ordinal)Juliol\", -3.960813169597578),\n                                    (\"<ordinal> quarteryear\", -3.960813169597578),\n                                    (\"el <day-of-month> (non ordinal)Mar\\231\", -3.044522437723423),\n                                    (\"<day-of-month> de <named-month>year\", -3.960813169597578),\n                                    (\"el <day-of-month> (non ordinal)Agost\", -3.960813169597578),\n                                    (\"Dimartseste|en un <cycle>\", -3.960813169597578),\n                                    (\"dayweek\", -2.5745188084776873),\n                                    (\"intersect by `de`year\", -3.960813169597578),\n                                    (\"el <day-of-month> (non ordinal)Octubre\", -3.960813169597578),\n                                    (\"day of month (1st)Mar\\231\", -3.2676659890376327),\n                                    (\"el <day-of-month> (non ordinal)intersect\",\n                                     -3.960813169597578)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -1.8152899666382492, unseen = -3.871201010907891,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -2.2407096892759584),\n                                    (\"Maigyear\", -3.1570004211501135),\n                                    (\"dayyear\", -2.463853240590168),\n                                    (\"Juliolyear\", -2.751535313041949),\n                                    (\"Maigyear (value by adding three composing numbers together)\",\n                                     -3.1570004211501135),\n                                    (\"<day-of-month> de <named-month>year\", -2.463853240590168)],\n                               n = 7}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)setmana (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minuts (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)segon (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004), (\"year\", -2.4849066497880004),\n                                    (\"month\", -2.4849066497880004),\n                                    (\"integer (numeric)any (grain)\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Dilluns<named-month> <day-of-month>\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0986122886681098),\n                                    (\"DillunsFebrer\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"Dimecres\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dia Internacional de les Cooperatives\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Maig\", -2.7245795030534206),\n                                    (\"integer (numeric)Gener\", -3.417726683613366),\n                                    (\"integer (numeric)Mar\\231\", -2.3191143949452564),\n                                    (\"integer (numeric)Juliol\", -3.417726683613366),\n                                    (\"integer (numeric)Febrer\", -2.501435951739211),\n                                    (\"integer (numeric)Abril\", -3.012261575505202),\n                                    (\"integer (numeric)Maig\", -3.417726683613366),\n                                    (\"integer (numeric)Octubre\", -3.417726683613366),\n                                    (\"number (0..15)Mar\\231\", -3.012261575505202),\n                                    (\"integer (numeric)Agost\", -3.417726683613366),\n                                    (\"month\", -0.8919980393051105),\n                                    (\"integer (numeric)Setembre\", -3.012261575505202),\n                                    (\"integer (numeric)Desembre\", -3.417726683613366)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -2.5649493574615367, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Juliol\", -1.7346010553881064),\n                                    (\"month\", -1.7346010553881064)],\n                               n = 2}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -0.6931471805599453),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.3862943611198906),\n                                    (\"Desembre<day-of-month> de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906),\n                                    (\"Desembretime-of-day (latent)\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)trimestre (grain)\",\n                                     -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.25593337413720063,\n                               unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.56953269648137),\n                                    (\"dayhour\", -1.5546296759391054),\n                                    (\"monthyear\", -3.56953269648137),\n                                    (\"tomorrowin the <part-of-day>\", -2.316769727986002),\n                                    (\"Maigdel <year>\", -3.56953269648137),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.56953269648137),\n                                    (\"Dillunsin the <part-of-day>\", -3.56953269648137),\n                                    (\"dayyear\", -2.065455299705096),\n                                    (\"quarteryear\", -3.56953269648137),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.56953269648137),\n                                    (\"Dia Internacional de les Cooperativesel <time>\",\n                                     -3.56953269648137),\n                                    (\"intersect by `de`del <year>\", -3.56953269648137),\n                                    (\"<day-of-month> de <named-month>del <year>\",\n                                     -3.56953269648137),\n                                    (\"Dia Internacional de les Cooperativesdel <year>\",\n                                     -3.56953269648137),\n                                    (\"<ordinal> quarterdel <year>\", -3.56953269648137),\n                                    (\"el <time>in the <part-of-day>\", -3.56953269648137),\n                                    (\"el <day-of-month> de <named-month>del <year>\",\n                                     -3.56953269648137),\n                                    (\"el <time>del <year>\", -3.56953269648137),\n                                    (\"yesterdayin the <part-of-day>\", -2.8763855159214247),\n                                    (\"dd-dd <month>(interval)del <year>\", -3.164067588373206)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.488077055429833, unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -2.2246235515243336),\n                                    (\"Maigdel <year>\", -2.917770732084279),\n                                    (\"Febrerin the <part-of-day>\", -2.917770732084279),\n                                    (\"monthhour\", -2.917770732084279),\n                                    (\"dayyear\", -2.2246235515243336),\n                                    (\"<day-of-month> de <named-month>del <year>\",\n                                     -2.2246235515243336),\n                                    (\"Julioldel <year>\", -2.512305623976115)],\n                               n = 7}}),\n       (\"Dilluns\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Dilluns\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"any (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135), (\"month\", -1.9459101490553135),\n                                    (\"setmana (grain)\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nit\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Gener\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fa <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Maig\", -2.5649493574615367),\n                                    (\"integer (numeric)Mar\\231\", -2.277267285009756),\n                                    (\"integer (numeric)Juliol\", -2.9704144655697013),\n                                    (\"integer (numeric)Febrer\", -2.9704144655697013),\n                                    (\"integer (numeric)Abril\", -2.9704144655697013),\n                                    (\"integer (numeric)Maig\", -2.9704144655697013),\n                                    (\"integer (numeric)Octubre\", -2.9704144655697013),\n                                    (\"number (0..15)Mar\\231\", -2.9704144655697013),\n                                    (\"integer (numeric)Agost\", -2.9704144655697013),\n                                    (\"month\", -0.9555114450274363),\n                                    (\"integer (numeric)Setembre\", -2.5649493574615367)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dia de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.5217885770490405,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month|named-day> past\", -3.41224721784874),\n                                    (\"dd[/-]mm\", -2.5649493574615367),\n                                    (\"intersect by `de`\", -2.7191000372887952),\n                                    (\"Dimecres\", -3.41224721784874),\n                                    (\"<day-of-month> de <named-month>\", -1.9459101490553135),\n                                    (\"intersect\", -3.41224721784874),\n                                    (\"Dilluns\", -3.817712325956905), (\"day\", -0.9555114450274363),\n                                    (\"Diumenge\", -3.817712325956905),\n                                    (\"Dimarts\", -3.41224721784874), (\"year\", -3.41224721784874),\n                                    (\"day of month (1st)\", -3.817712325956905),\n                                    (\"<named-month|named-day> next\", -3.817712325956905),\n                                    (\"el proximo <cycle> \", -3.41224721784874),\n                                    (\"hour\", -3.817712325956905), (\"month\", -3.817712325956905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Agost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"estiu\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"hivern\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"nit\", -1.6094379124341003),\n                                    (\"afternoon\", -1.6094379124341003),\n                                    (\"hour\", -0.916290731874155), (\"evening\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.18924199963852842,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -1.7578579175523736,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"any (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"setmana (grain)\", -1.0296194171811581)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.1823215567939546),\n                                    (\"number (0..15)\", -1.791759469228055)],\n                               n = 10}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Juliol\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Mar\\231\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Juliol\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"any (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Dijousinteger (numeric)\", -1.4469189829363254),\n                                    (\"day\", -0.8873031950009028),\n                                    (\"Divendresinteger (numeric)\", -2.1400661634962708),\n                                    (\"Dimartsinteger (numeric)\", -2.1400661634962708),\n                                    (\"Dimecresinteger (numeric)\", -2.1400661634962708)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"Diumenge\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dimarts\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dia dels Innocents d'Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Desembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (0..15)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"Setembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.15415067982725836)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.40546510810816444),\n                                    (\"number 100..1000 \", -1.0986122886681098)],\n                               n = 7}}),\n       (\"Dissabte\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -4.060443010546419,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)minuts (grain)\", -3.349904087274605),\n                                    (\"week\", -2.9444389791664407),\n                                    (\"integer (numeric)hora (grain)\", -3.349904087274605),\n                                    (\"integer (numeric)dia (grain)\", -3.349904087274605),\n                                    (\"number (0..15)any (grain)\", -2.9444389791664407),\n                                    (\"number (0..15)setmana (grain)\", -2.9444389791664407),\n                                    (\"integer (numeric)minuts (grain)\", -2.9444389791664407),\n                                    (\"number (21..29)hora (grain)\", -3.349904087274605),\n                                    (\"day\", -2.9444389791664407), (\"year\", -2.6567569067146595),\n                                    (\"number (0..15)mes (grain)\", -2.9444389791664407),\n                                    (\"number (0..15)hora (grain)\", -2.6567569067146595),\n                                    (\"hour\", -2.097141118779237), (\"month\", -2.9444389791664407),\n                                    (\"integer (numeric)any (grain)\", -3.349904087274605),\n                                    (\"number (0..15)dia (grain)\", -3.349904087274605),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.349904087274605),\n                                    (\"minute\", -2.6567569067146595)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.1135153092103742),\n                                    (\"integer (numeric)hora (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)dia (grain)\", -2.70805020110221),\n                                    (\"number (0..15)setmana (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)mes (grain)\", -3.1135153092103742),\n                                    (\"second\", -2.70805020110221),\n                                    (\"integer (numeric)minuts (grain)\", -2.70805020110221),\n                                    (\"integer (numeric)segon (grain)\", -2.70805020110221),\n                                    (\"day\", -2.70805020110221), (\"year\", -3.1135153092103742),\n                                    (\"number (0..15)mes (grain)\", -3.1135153092103742),\n                                    (\"number (0..15)hora (grain)\", -3.1135153092103742),\n                                    (\"hour\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"integer (numeric)any (grain)\", -3.1135153092103742),\n                                    (\"minute\", -2.70805020110221)],\n                               n = 12}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.3025850929940455),\n                                    (\"integer (numeric)dia (grain)\", -2.3025850929940455),\n                                    (\"second\", -2.3025850929940455),\n                                    (\"integer (numeric)minuts (grain)\", -2.3025850929940455),\n                                    (\"integer (numeric)segon (grain)\", -2.3025850929940455),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"number (0..15)mes (grain)\", -2.3025850929940455),\n                                    (\"hour\", -2.3025850929940455), (\"month\", -2.3025850929940455),\n                                    (\"minute\", -2.3025850929940455)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"integer (numeric)setmana (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)any (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"any (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"setmana (grain)\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"segon (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maig\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minuts (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"trimestre (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Dimecres\", -1.791759469228055),\n                                    (\"el <time>\", -1.791759469228055), (\"day\", -0.8754687373538999),\n                                    (\"Dimarts\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"mes (grain)\", -1.791759469228055),\n                                    (\"any (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"setmana (grain)\", -1.791759469228055)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Octubre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.15415067982725836)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number 100..1000 \", -0.40546510810816444)],\n                               n = 1}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Divendres\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"setmana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"setmana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"setmana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.803360380906535), (\"day\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"<integer> <unit-of-duration>\", -0.8574502318512216),\n                                    (\"hour\", -1.8870696490323797), (\"month\", -2.803360380906535),\n                                    (\"minute\", -2.1102132003465894)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6094379124341003),\n                                    (\"dayday\", -1.6094379124341003),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.6094379124341003),\n                                    (\"<day-of-month> de <named-month><day-of-month> de <named-month>\",\n                                     -1.6094379124341003)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.3862943611198906),\n                                    (\"Desembre<day-of-month> de <named-month>\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Dia Mundial de la Lengua \\192rab\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2113090936672069),\n                                    (\"number (0..15)\", -1.6582280766035324)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.1823215567939546)],\n                               n = 4}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"setmana (grain)\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"setmana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Febrerinteger (numeric)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number 100..1000 \",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dijous\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"nit\", -1.9810014688665833),\n                                    (\"afternoon\", -1.9810014688665833),\n                                    (\"hour\", -0.8023464725249373), (\"evening\", -1.7578579175523736),\n                                    (\"morning\", -2.268683541318364)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number 100..1000 number (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dia de la Zero Discriminaci\\243\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Dilluns\", -2.1400661634962708),\n                                    (\"estiu\", -2.1400661634962708), (\"hivern\", -2.1400661634962708),\n                                    (\"day\", -1.4469189829363254), (\"hour\", -1.7346010553881064),\n                                    (\"evening\", -2.1400661634962708),\n                                    (\"week-end\", -2.1400661634962708)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1146}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.CS_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.DA_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.2809338454620642),\n                                    (\"hh:mm\", -1.5040773967762742), (\"hour\", -1.9740810260220096),\n                                    (\"minute\", -1.0185695809945732)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7872986116830517,\n                               unseen = -5.0689042022202315,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 157},\n                   koData =\n                     ClassData{prior = -0.6071024542014105, unseen = -5.247024072160486,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 188}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.9555114450274363),\n                                    (\"tomorrowevening\", -1.8718021769015913),\n                                    (\"tomorrowlunch\", -1.8718021769015913),\n                                    (\"yesterdayevening\", -1.8718021769015913),\n                                    (\"Mondaymorning\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2674793651342615, unseen = -5.062595033026967,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.264486336120253),\n                                    (\"time-of-day (latent)\", -1.2495833155779883),\n                                    (\"relative minutes after|past <integer> (hour-of-day)\",\n                                     -3.9576335166801986),\n                                    (\"hh:mm\", -1.9652033519899923),\n                                    (\"<time-of-day> sharp\", -3.6699514442284173),\n                                    (\"hour\", -1.1850447944404172), (\"minute\", -1.688949975361834)],\n                               n = 75},\n                   koData =\n                     ClassData{prior = -1.4494732627414222,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.7922380832041762),\n                                    (\"hour\", -0.7922380832041762)],\n                               n = 23}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -1.9924301646902063),\n                                    (\"Monday\", -1.9924301646902063),\n                                    (\"Friday\", -1.9924301646902063), (\"day\", -0.8938178760220964),\n                                    (\"Sunday\", -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.6817585740137264),\n                                    (\"Saturday\", -3.068052935133617),\n                                    (\"Monday\", -3.068052935133617),\n                                    (\"the <day-of-month> (non ordinal)\", -2.662587827025453),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -1.8152899666382492),\n                                    (\"day\", -0.8167611365271219),\n                                    (\"the <day-of-month> (ordinal)\", -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13976194237515874,\n                               unseen = -3.7376696182833684,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 40},\n                   koData =\n                     ClassData{prior = -2.03688192726104, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.2039728043259361),\n                                    (\"hh:mmhh:mm\", -1.2039728043259361),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0986122886681098),\n                                    (\"minutehour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7047480922384253),\n                                    (\"minuteminute\", -1.2992829841302609),\n                                    (\"hh:mmhh:mm\", -1.2992829841302609),\n                                    (\"minutehour\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.5040773967762742),\n                                    (\"minuteminute\", -1.5040773967762742),\n                                    (\"minutehour\", -1.5040773967762742),\n                                    (\"hh:mmintersect\", -1.5040773967762742)],\n                               n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -1.252762968495368),\n                                    (\"integer (0..19)minute (grain)\", -1.252762968495368),\n                                    (\"minute\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.252762968495368),\n                                    (\"quarter\", -0.8472978603872037),\n                                    (\"ordinals (first..19st)quarter (grain)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.252762968495368),\n                                    (\"quarter\", -0.8472978603872037),\n                                    (\"ordinals (first..19st)quarter (grain)\", -1.252762968495368)],\n                               n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.3657247794586503, unseen = -5.955837369464831,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<datetime> - <datetime> (interval)on <date>\",\n                                     -4.161483865059729),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -5.260096153727839),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -4.161483865059729),\n                                    (\"hourday\", -5.260096153727839),\n                                    (\"dayhour\", -2.5520459526256287),\n                                    (\"daymonth\", -3.468336684499784),\n                                    (\"monthyear\", -3.180654612048003),\n                                    (\"Mondayon <date>\", -5.260096153727839),\n                                    (\"intersecthh:mm\", -5.260096153727839),\n                                    (\"Wednesdaynext <cycle>\", -5.260096153727839),\n                                    (\"Marchyear\", -4.854631045619675),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -4.854631045619675),\n                                    (\"Mondayintersect\", -5.260096153727839),\n                                    (\"last <day-of-week> of <time>year\", -4.854631045619675),\n                                    (\"todayat <time-of-day>\", -4.343805421853684),\n                                    (\"Thursday<time> timezone\", -3.8738017926079484),\n                                    (\"dayday\", -3.180654612048003),\n                                    (\"dd/mmat <time-of-day>\", -4.007333185232471),\n                                    (\"the <day-of-month> (ordinal)February\", -4.854631045619675),\n                                    (\"intersect by \\\",\\\"hh:mm\", -4.343805421853684),\n                                    (\"Mondaythe <day-of-month> (non ordinal)\", -5.260096153727839),\n                                    (\"Thursdaybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -4.854631045619675),\n                                    (\"dayyear\", -3.5553480614894135),\n                                    (\"Thursdaybetween <datetime> and <datetime> (interval)\",\n                                     -4.854631045619675),\n                                    (\"Thursdayat <time-of-day>\", -4.161483865059729),\n                                    (\"tomorrow<time-of-day> sharp\", -4.566948973167894),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -4.854631045619675),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.343805421853684),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -4.566948973167894),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.566948973167894),\n                                    (\"tomorrowuntil <time-of-day>\", -4.566948973167894),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -4.343805421853684),\n                                    (\"the <day-of-month> (ordinal)March\", -4.343805421853684),\n                                    (\"after <time-of-day>at <time-of-day>\", -4.566948973167894),\n                                    (\"intersect by \\\",\\\"<day-of-month> (non ordinal) <named-month>\",\n                                     -4.343805421853684),\n                                    (\"Mondaythe <day-of-month> (ordinal)\", -5.260096153727839),\n                                    (\"tomorrowafter <time-of-day>\", -4.566948973167894),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -4.343805421853684),\n                                    (\"Sunday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.260096153727839),\n                                    (\"dayminute\", -2.4268828096716226),\n                                    (\"Tuesdaythis <time>\", -4.566948973167894),\n                                    (\"from <datetime> - <datetime> (interval)on <date>\",\n                                     -4.566948973167894),\n                                    (\"<ordinal> <cycle> of <time>year\", -4.854631045619675),\n                                    (\"minuteday\", -2.519256129802638),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.260096153727839),\n                                    (\"Octoberyear\", -3.6506582412937383),\n                                    (\"yearhh:mm\", -5.260096153727839),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -4.854631045619675),\n                                    (\"Septemberyear\", -4.343805421853684),\n                                    (\"at <time-of-day>on <date>\", -5.260096153727839),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <date>\",\n                                     -5.260096153727839),\n                                    (\"between <datetime> and <datetime> (interval)on <date>\",\n                                     -5.260096153727839),\n                                    (\"dayweek\", -4.161483865059729),\n                                    (\"weekyear\", -4.343805421853684),\n                                    (\"hh:mmtomorrow\", -4.343805421853684),\n                                    (\"this <cycle>at <time-of-day>\", -4.854631045619675),\n                                    (\"Wednesdaythis <time>\", -4.343805421853684),\n                                    (\"tomorrowat <time-of-day>\", -3.6506582412937383),\n                                    (\"at <time-of-day>tomorrow\", -4.566948973167894),\n                                    (\"intersectFebruary\", -5.260096153727839),\n                                    (\"last <cycle> of <time>year\", -4.343805421853684),\n                                    (\"Mondaythis <time>\", -5.260096153727839),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.854631045619675),\n                                    (\"yearminute\", -5.260096153727839)],\n                               n = 154},\n                   koData =\n                     ClassData{prior = -1.1831696766961728, unseen = -5.365976015021851,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.7963428082478883),\n                                    (\"daymonth\", -2.2702497123511094),\n                                    (\"monthyear\", -3.751854253275325),\n                                    (\"Marchyear\", -3.9749978045895347),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -3.4153820166541116),\n                                    (\"Sundaythis <time>\", -3.751854253275325),\n                                    (\"absorption of , after named dayJuly\", -4.2626798770413155),\n                                    (\"dd/mmat <time-of-day>\", -3.4153820166541116),\n                                    (\"hourhour\", -3.0587070727153796),\n                                    (\"dayyear\", -3.2818506240295893),\n                                    (\"Thursdayat <time-of-day>\", -2.9633968929110543),\n                                    (\"Thursdayhh:mm\", -4.2626798770413155),\n                                    (\"WednesdayFebruary\", -4.66814498514948),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -4.66814498514948),\n                                    (\"in|during the <part-of-day>until <time-of-day>\",\n                                     -3.9749978045895347),\n                                    (\"Aprilyear\", -4.66814498514948),\n                                    (\"until <time-of-day>on <date>\", -4.66814498514948),\n                                    (\"dayminute\", -3.2818506240295893),\n                                    (\"Tuesdaythis <time>\", -3.751854253275325),\n                                    (\"minuteday\", -3.164067588373206),\n                                    (\"hh:mmon <date>\", -3.2818506240295893),\n                                    (\"Wednesdaythis <time>\", -3.4153820166541116),\n                                    (\"absorption of , after named dayFebruary\",\n                                     -4.2626798770413155),\n                                    (\"this <part-of-day>until <time-of-day>\", -3.9749978045895347),\n                                    (\"tomorrownoon\", -4.66814498514948),\n                                    (\"this <time>until <time-of-day>\", -3.9749978045895347),\n                                    (\"Mondaythis <time>\", -4.2626798770413155)],\n                               n = 68}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7346010553881064),\n                                    (\"ordinals (first..19st)week (grain)intersect\",\n                                     -1.7346010553881064),\n                                    (\"ordinals (first..19st)week (grain)October\",\n                                     -1.7346010553881064),\n                                    (\"weekmonth\", -1.2237754316221157),\n                                    (\"ordinals (first..19st)day (grain)October\",\n                                     -1.7346010553881064)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"season\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.4423470353692043),\n                                    (\"minuteminute\", -1.5260563034950494),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.4423470353692043),\n                                    (\"hh:mmhh:mm\", -1.5260563034950494),\n                                    (\"hourhour\", -2.4423470353692043),\n                                    (\"minutehour\", -2.4423470353692043)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5596157879354228, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.6026896854443837),\n                                    (\"hh:mmtime-of-day (latent)\", -1.9095425048844386),\n                                    (\"minuteminute\", -1.9095425048844386),\n                                    (\"yearyear\", -2.6026896854443837),\n                                    (\"year (latent)year (latent)\", -2.6026896854443837),\n                                    (\"minutehour\", -1.9095425048844386),\n                                    (\"hh:mmintersect\", -1.9095425048844386),\n                                    (\"year (latent)time-of-day (latent)\", -2.6026896854443837)],\n                               n = 8}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"month (grain)\", -2.3025850929940455),\n                                    (\"year (grain)\", -2.3025850929940455),\n                                    (\"week (grain)\", -1.6094379124341003),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -2.3025850929940455),\n                                    (\"month\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.3025850929940455),\n                                    (\"minuteminute\", -1.2039728043259361),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -1.2039728043259361),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"minutehour\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0296194171811581),\n                                    (\"minutehour\", -1.0296194171811581)],\n                               n = 4}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5260930958967791),\n                                    (\"integer (0..19)\", -0.8938178760220964)],\n                               n = 20}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19st)quarter (grain)year\",\n                                     -1.252762968495368),\n                                    (\"quarteryear\", -0.8472978603872037),\n                                    (\"ordinal (digits)quarter (grain)year\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (grain)christmas eve\", -0.6931471805599453),\n                                    (\"yearday\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a pair\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8938178760220964),\n                                    (\"ordinals (first..19st)Tuesdayintersect\", -1.9924301646902063),\n                                    (\"ordinals (first..19st)TuesdayOctober\", -1.9924301646902063),\n                                    (\"ordinals (first..19st)Wednesdayintersect\",\n                                     -1.4816045409242156)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9444616088408514),\n                                    (\"ordinals (first..19st)WednesdayOctober\", -1.2809338454620642),\n                                    (\"ordinals (first..19st)TuesdaySeptember\", -1.791759469228055)],\n                               n = 6}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.8472978603872037), (\"evening\", -1.252762968495368),\n                                    (\"morning\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.11778303565638351, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7221347174331976),\n                                    (\"morning\", -0.7221347174331976)],\n                               n = 16}}),\n       (\"christmas eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19st)March\", -1.8325814637483102),\n                                    (\"ordinal (digits)February\", -1.8325814637483102),\n                                    (\"month\", -0.8209805520698302),\n                                    (\"ordinal (digits)March\", -1.6094379124341003)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19st)April\", -1.252762968495368),\n                                    (\"month\", -1.252762968495368)],\n                               n = 1}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 29}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.9808292530117262),\n                                    (\"evening\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.750305594399894), (\"morning\", -0.750305594399894)],\n                               n = 16}}),\n       (\"new year's eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (grain)christmas eve\", -0.6931471805599453),\n                                    (\"yearday\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19st)\", -1.2039728043259361),\n                                    (\"ordinal (digits)\", -0.35667494393873245)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second\", -1.4469189829363254), (\"year\", -2.1400661634962708),\n                                    (\"<integer> <unit-of-duration>\", -1.041453874828161),\n                                    (\"a <unit-of-duration>\", -2.1400661634962708),\n                                    (\"minute\", -1.7346010553881064)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.7227665977411035),\n                                    (\"year (grain)\", -2.2335922215070942),\n                                    (\"week (grain)\", -1.7227665977411035),\n                                    (\"day\", -1.9459101490553135), (\"quarter\", -2.639057329615259),\n                                    (\"year\", -2.2335922215070942),\n                                    (\"quarter (grain)\", -2.639057329615259),\n                                    (\"day (grain)\", -1.9459101490553135)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.6094379124341003),\n                                    (\"day (grain)\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (first..19st)\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8754687373538999),\n                                    (\"hour\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.3862943611198906),\n                                    (\"hour\", -1.3862943611198906),\n                                    (\"<hour-of-day> half (as relative minutes)\",\n                                     -1.3862943611198906),\n                                    (\"minute\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7105389232718146, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -1.7094433359300068e-2)],\n                               n = 57},\n                   koData =\n                     ClassData{prior = -0.6760527472006452, unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2607262624632527),\n                                    (\"integer (0..19)\", -1.4718165345580525)],\n                               n = 59}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 6}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8266785731844679),\n                                    (\"SundayMarch\", -1.6739764335716716),\n                                    (\"MondayMarch\", -1.6739764335716716),\n                                    (\"Sundayintersect\", -1.6739764335716716)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5408064559779265, unseen = -4.74493212836325,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.538973871058276),\n                                    (\"integer (0..19)year (grain)\", -3.349904087274605),\n                                    (\"integer (numeric)day (grain)\", -2.9444389791664407),\n                                    (\"integer (0..19)hour (grain)\", -4.04305126783455),\n                                    (\"second\", -2.9444389791664407),\n                                    (\"integer (numeric)second (grain)\", -4.04305126783455),\n                                    (\"a pairhour (grain)\", -4.04305126783455),\n                                    (\"integer (numeric)year (grain)\", -3.6375861597263857),\n                                    (\"day\", -2.338303175596125), (\"year\", -2.9444389791664407),\n                                    (\"integer (numeric)week (grain)\", -3.349904087274605),\n                                    (\"integer (0..19)month (grain)\", -4.04305126783455),\n                                    (\"integer (0..19)second (grain)\", -3.126760535960395),\n                                    (\"hour\", -2.9444389791664407), (\"month\", -3.6375861597263857),\n                                    (\"integer (numeric)minute (grain)\", -2.790288299339182),\n                                    (\"integer (0..19)minute (grain)\", -2.9444389791664407),\n                                    (\"integer (numeric)month (grain)\", -4.04305126783455),\n                                    (\"minute\", -2.2512917986064953),\n                                    (\"integer (numeric)hour (grain)\", -3.349904087274605),\n                                    (\"integer (0..19)day (grain)\", -2.9444389791664407),\n                                    (\"integer (0..19)week (grain)\", -2.9444389791664407)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -0.8729402910005413, unseen = -4.48863636973214,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6855773452501515),\n                                    (\"integer (0..19)year (grain)\", -3.378724525810097),\n                                    (\"integer (numeric)day (grain)\", -3.0910424533583156),\n                                    (\"integer (0..19)hour (grain)\", -3.784189633918261),\n                                    (\"second\", -2.867898902044106),\n                                    (\"integer (numeric)second (grain)\", -3.378724525810097),\n                                    (\"integer (numeric)year (grain)\", -3.0910424533583156),\n                                    (\"day\", -2.6855773452501515), (\"year\", -2.6855773452501515),\n                                    (\"integer (numeric)week (grain)\", -3.378724525810097),\n                                    (\"integer (0..19)month (grain)\", -3.0910424533583156),\n                                    (\"integer (0..19)second (grain)\", -3.378724525810097),\n                                    (\"hour\", -2.6855773452501515), (\"month\", -2.6855773452501515),\n                                    (\"integer (numeric)minute (grain)\", -3.378724525810097),\n                                    (\"integer (0..19)minute (grain)\", -3.378724525810097),\n                                    (\"integer (numeric)month (grain)\", -3.378724525810097),\n                                    (\"minute\", -2.867898902044106),\n                                    (\"integer (numeric)hour (grain)\", -2.867898902044106),\n                                    (\"integer (0..19)day (grain)\", -3.378724525810097),\n                                    (\"integer (0..19)week (grain)\", -3.0910424533583156)],\n                               n = 33}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>christmas eve\", -1.5040773967762742),\n                                    (\"yearday\", -0.8109302162163288),\n                                    (\"<integer> <unit-of-duration>christmas eve\",\n                                     -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.0794415416798357),\n                                    (\"year (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.0794415416798357),\n                                    (\"week (grain)\", -2.0794415416798357),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"minute (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"second (grain)\", -2.0794415416798357),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"day (grain)\", -2.4849066497880004)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -9.763846956391606e-2,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.007333185232471),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.007333185232471),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6018680771243066),\n                                    (\"at <time-of-day>Saturday\", -3.6018680771243066),\n                                    (\"intersect by \\\",\\\"year\", -4.007333185232471),\n                                    (\"hh:mmintersect by \\\",\\\"\", -3.6018680771243066),\n                                    (\"dayday\", -2.3025850929940455),\n                                    (\"dayyear\", -3.0910424533583156),\n                                    (\"Saturday<day-of-month> (non ordinal) <named-month>\",\n                                     -3.6018680771243066),\n                                    (\"<named-month> <day-of-month> (non ordinal)intersect\",\n                                     -4.007333185232471),\n                                    (\"intersect by \\\",\\\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.0910424533583156),\n                                    (\"Fridayintersect\", -4.007333185232471),\n                                    (\"hh:mmintersect\", -3.6018680771243066),\n                                    (\"intersect by \\\",\\\"intersect\", -4.007333185232471),\n                                    (\"hh:mmSaturday\", -3.6018680771243066),\n                                    (\"at <time-of-day>intersect\", -3.6018680771243066),\n                                    (\"Sunday<day-of-month> (non ordinal) <named-month>\",\n                                     -4.007333185232471),\n                                    (\"dayminute\", -2.908720896564361),\n                                    (\"intersectyear\", -4.007333185232471),\n                                    (\"minuteday\", -1.6559579280689931),\n                                    (\"hh:mmabsorption of , after named day\", -3.6018680771243066),\n                                    (\"at <time-of-day>intersect by \\\",\\\"\", -3.6018680771243066),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -3.6018680771243066),\n                                    (\"intersectintersect\", -4.007333185232471),\n                                    (\"Fridayintersect by \\\",\\\"\", -3.6018680771243066),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.007333185232471),\n                                    (\"Monday<day-of-month> (non ordinal) <named-month>\",\n                                     -4.007333185232471),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -3.6018680771243066)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -2.374905754573672, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.0794415416798357),\n                                    (\"FridayJuly\", -2.5902671654458267),\n                                    (\"WednesdayFebruary\", -2.995732273553991),\n                                    (\"MondayFebruary\", -2.995732273553991)],\n                               n = 4}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.526747213078842e-2,\n                               unseen = -4.204692619390966,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 65},\n                   koData =\n                     ClassData{prior = -4.189654742026425, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> sharp\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.8209805520698302,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sundaylast <cycle>\", -2.917770732084279),\n                                    (\"daymonth\", -1.6650077635889111),\n                                    (\"Wednesdayintersect\", -2.512305623976115),\n                                    (\"Wednesdaynext <cycle>\", -2.917770732084279),\n                                    (\"Tuesdaythis <cycle>\", -2.917770732084279),\n                                    (\"WednesdayOctober\", -2.512305623976115),\n                                    (\"Wednesdaythis <cycle>\", -2.917770732084279),\n                                    (\"TuesdayOctober\", -2.512305623976115),\n                                    (\"Mondaythis <cycle>\", -2.917770732084279),\n                                    (\"dayweek\", -1.8191584434161694)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.579818495252942, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0531499145913523),\n                                    (\"TuesdaySeptember\", -2.662587827025453),\n                                    (\"Wednesdayintersect\", -2.662587827025453),\n                                    (\"WednesdayOctober\", -2.662587827025453),\n                                    (\"SundayMarch\", -2.662587827025453),\n                                    (\"MondayMarch\", -2.662587827025453),\n                                    (\"Tuesdayintersect\", -2.662587827025453),\n                                    (\"Sundayintersect\", -2.662587827025453)],\n                               n = 14}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.580450375560848), (\"day\", -1.916922612182061),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"<integer> <unit-of-duration>\", -0.8873031950009028),\n                                    (\"a <unit-of-duration>\", -2.833213344056216),\n                                    (\"month\", -2.4277482359480516)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.751535313041949, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.6739764335716716), (\"Sunday\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357), (\"Tuesday\", -2.0794415416798357),\n                                    (\"week-end\", -2.0794415416798357)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -6.59579677917974e-2, unseen = -4.59511985013459,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.6405284995041316),\n                                    (\"Monday\", -3.4863551900024623), (\"day\", -2.3877429013343523),\n                                    (\"Sunday\", -3.4863551900024623),\n                                    (\"time-of-day (latent)\", -1.6405284995041316),\n                                    (\"year\", -1.6405284995041316),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\", -2.9755295662364714),\n                                    (\"hour\", -1.6405284995041316)],\n                               n = 44}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -0.8209805520698302),\n                                    (\"hour\", -0.8209805520698302)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.5040773967762742),\n                                    (\"hh:mm\", -1.5040773967762742),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 2}}),\n       (\"<integer> and an half hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"integer (0..19)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.1400661634962708),\n                                    (\"Monday\", -2.1400661634962708), (\"day\", -1.2237754316221157),\n                                    (\"March\", -2.1400661634962708), (\"month\", -2.1400661634962708),\n                                    (\"Tuesday\", -1.7346010553881064)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.0149030205422647),\n                                    (\"Friday\", -1.6094379124341003), (\"day\", -1.3217558399823195),\n                                    (\"March\", -2.0149030205422647), (\"month\", -2.0149030205422647)],\n                               n = 4}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"month (grain)\", -2.0794415416798357),\n                                    (\"year (grain)\", -2.0794415416798357),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"year\", -2.0794415416798357), (\"month\", -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"day\", -1.6739764335716716),\n                                    (\"day (grain)\", -1.6739764335716716)],\n                               n = 4}}),\n       (\"christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"new year's day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.793208009442517),\n                                    (\"integer (0..19)year (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)day (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)hour (grain)\", -3.1986731175506815),\n                                    (\"second\", -2.793208009442517),\n                                    (\"integer (numeric)second (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)year (grain)\", -3.1986731175506815),\n                                    (\"day\", -2.793208009442517), (\"year\", -2.793208009442517),\n                                    (\"integer (numeric)week (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)month (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)second (grain)\", -3.1986731175506815),\n                                    (\"hour\", -2.793208009442517), (\"month\", -2.793208009442517),\n                                    (\"integer (numeric)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)month (grain)\", -3.1986731175506815),\n                                    (\"minute\", -2.793208009442517),\n                                    (\"integer (numeric)hour (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)day (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)week (grain)\", -3.1986731175506815)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.418840607796598,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.0204248861443626),\n                                    (\"<integer> more <unit-of-duration>\", -3.3081069585961433),\n                                    (\"number.number hours\", -3.713572066704308),\n                                    (\"second\", -2.797281334830153), (\"day\", -2.6149597780361984),\n                                    (\"half an hour\", -3.713572066704308),\n                                    (\"<integer> <unit-of-duration>\", -1.2286654169163076),\n                                    (\"a <unit-of-duration>\", -2.797281334830153),\n                                    (\"<integer> and an half hours\", -3.3081069585961433),\n                                    (\"hour\", -2.6149597780361984), (\"minute\", -1.4622802680978126),\n                                    (\"about <duration>\", -3.3081069585961433)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5436154465889815,\n                               unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.1895840668738362),\n                                    (\"hh:mmhh:mm\", -1.1895840668738362),\n                                    (\"dayday\", -2.03688192726104),\n                                    (\"<day-of-month> (non ordinal) <named-month><day-of-month> (non ordinal) <named-month>\",\n                                     -2.03688192726104)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -0.8690378470236094,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"July<day-of-month> (non ordinal) <named-month>\",\n                                     -2.890371757896165),\n                                    (\"monthday\", -1.791759469228055),\n                                    (\"minuteminute\", -1.6376087894007967),\n                                    (\"hh:mmhh:mm\", -2.890371757896165),\n                                    (\"dayyear\", -2.4849066497880004),\n                                    (\"hh:mmintersect\", -1.791759469228055),\n                                    (\"August<day-of-month> (non ordinal) <named-month>\",\n                                     -1.9740810260220096),\n                                    (\"dd/mmyear\", -2.4849066497880004)],\n                               n = 13}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6241543090729939,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.4277482359480516),\n                                    (\"minuteminute\", -0.8873031950009028),\n                                    (\"hh:mmhh:mm\", -0.8873031950009028),\n                                    (\"minutehour\", -2.4277482359480516)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -0.7672551527136672,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -0.8362480242006186),\n                                    (\"minuteminute\", -2.70805020110221),\n                                    (\"hh:mmhh:mm\", -2.70805020110221),\n                                    (\"minutehour\", -0.8362480242006186)],\n                               n = 13}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.639057329615259),\n                                    (\"integer (0..19)year (grain)\", -3.332204510175204),\n                                    (\"integer (numeric)day (grain)\", -2.9267394020670396),\n                                    (\"second\", -2.9267394020670396),\n                                    (\"integer (numeric)second (grain)\", -3.332204510175204),\n                                    (\"integer (numeric)year (grain)\", -2.9267394020670396),\n                                    (\"day\", -2.639057329615259), (\"year\", -2.639057329615259),\n                                    (\"integer (numeric)week (grain)\", -3.332204510175204),\n                                    (\"integer (0..19)month (grain)\", -2.9267394020670396),\n                                    (\"integer (0..19)second (grain)\", -3.332204510175204),\n                                    (\"hour\", -2.9267394020670396), (\"month\", -2.639057329615259),\n                                    (\"integer (numeric)minute (grain)\", -3.332204510175204),\n                                    (\"integer (0..19)minute (grain)\", -3.332204510175204),\n                                    (\"integer (numeric)month (grain)\", -3.332204510175204),\n                                    (\"minute\", -2.9267394020670396),\n                                    (\"integer (numeric)hour (grain)\", -2.9267394020670396),\n                                    (\"integer (0..19)day (grain)\", -3.332204510175204),\n                                    (\"integer (0..19)week (grain)\", -2.9267394020670396)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -2.3025850929940455),\n                                    (\"month\", -0.7985076962177716),\n                                    (\"Februaryinteger (numeric)\", -1.3862943611198906),\n                                    (\"Julyinteger (numeric)\", -1.6094379124341003)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1466034741918754, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)September\", -2.70805020110221),\n                                    (\"integer (numeric)April\", -3.1135153092103742),\n                                    (\"integer (numeric)August\", -1.5040773967762742),\n                                    (\"integer (numeric)February\", -2.4203681286504293),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"integer (numeric)July\", -2.70805020110221),\n                                    (\"integer (numeric)March\", -2.70805020110221)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.9924301646902063, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.1786549963416462),\n                                    (\"integer (numeric)July\", -1.1786549963416462)],\n                               n = 3}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Monday\", -1.8718021769015913), (\"day\", -0.9555114450274363),\n                                    (\"Tuesday\", -1.466337068793427)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.7047480922384253),\n                                    (\"Friday\", -1.2992829841302609), (\"day\", -1.0116009116784799)],\n                               n = 3}}),\n       (\"<hour-of-day> half (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"about <time-of-day>\", -1.7346010553881064),\n                                    (\"time-of-day (latent)\", -1.041453874828161),\n                                    (\"hour\", -0.7537718023763802)],\n                               n = 7}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.4816045409242156),\n                                    (\"week (grain)intersect\", -1.9924301646902063),\n                                    (\"week (grain)September\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19st)April\", -1.6094379124341003),\n                                    (\"ordinals (first..19st)March\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.6094379124341003),\n                                    (\"intersect\", -2.169053700369523),\n                                    (\"tomorrow\", -2.169053700369523), (\"day\", -2.169053700369523),\n                                    (\"hour\", -1.252762968495368)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>\", -2.169053700369523),\n                                    (\"christmas eve\", -2.456735772821304),\n                                    (\"in|during the <part-of-day>\", -2.169053700369523),\n                                    (\"day\", -2.456735772821304), (\"hh:mm\", -2.8622008809294686),\n                                    (\"hour\", -1.252762968495368), (\"minute\", -2.8622008809294686),\n                                    (\"this <time>\", -2.169053700369523)],\n                               n = 12}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.445176257083381e-2,\n                               unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -3.1354942159291497,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"July\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half an hour\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906, unseen = -3.871201010907891,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2407096892759584), (\"October\", -2.751535313041949),\n                                    (\"intersect\", -2.751535313041949),\n                                    (\"season\", -2.2407096892759584),\n                                    (\"next <cycle>\", -3.1570004211501135),\n                                    (\"day\", -2.2407096892759584),\n                                    (\"this <cycle>\", -2.463853240590168),\n                                    (\"hour\", -2.2407096892759584), (\"evening\", -3.1570004211501135),\n                                    (\"month\", -2.2407096892759584),\n                                    (\"morning\", -3.1570004211501135),\n                                    (\"week-end\", -2.751535313041949)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -0.2876820724517809, unseen = -4.718498871295094,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -3.100092288878234),\n                                    (\"October\", -2.3116349285139637),\n                                    (\"intersect\", -2.1445808438507976),\n                                    (\"time-of-day (latent)\", -3.6109179126442243),\n                                    (\"March\", -3.100092288878234), (\"hour\", -1.7650912221458936),\n                                    (\"month\", -1.2755429968271879),\n                                    (\"morning\", -1.8763168572561182)],\n                               n = 48}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1663}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.DE_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.6094379124341003),\n                                    (\"hh:mm\", -1.2039728043259361), (\"hour\", -1.6094379124341003),\n                                    (\"minute\", -1.2039728043259361)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.41689380393178715,\n                               unseen = -5.857933154483459,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 348},\n                   koData =\n                     ClassData{prior = -1.0761394328160512, unseen = -5.204006687076795,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 180}}),\n       (\"exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.0986122886681098),\n                                    (\"<time-of-day>  o'clock\", -1.5040773967762742),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodoxer Karsamstag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <half> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Marz\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> approximately\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12044615307586722,\n                               unseen = -5.700443573390687,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -4.598481197837295),\n                                    (\"until <time-of-day>afternoon\", -5.003946305945459),\n                                    (\"dayhour\", -3.299198213707034),\n                                    (\"todayevening\", -4.598481197837295),\n                                    (\"half <integer> (german style hour-of-day)afternoon\",\n                                     -5.003946305945459),\n                                    (\"<time-of-day>  o'clockafter lunch\", -4.310799125385514),\n                                    (\"intersect by ','evening\", -3.499868909169185),\n                                    (\"<time-of-day>  o'clockon <date>\", -3.9053340172773496),\n                                    (\"intersectevening\", -1.935893370811842),\n                                    (\"time-of-day (latent)on <date>\", -4.310799125385514),\n                                    (\"about <time-of-day>on <date>\", -4.598481197837295),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in|during the <part-of-day>\",\n                                     -4.598481197837295),\n                                    (\"hourhour\", -1.2084571167732645),\n                                    (\"<time-of-day>  o'clockin|during the <part-of-day>\",\n                                     -3.9053340172773496),\n                                    (\"Donnerstagmorning\", -5.003946305945459),\n                                    (\"<time-of-day>  o'clockafternoon\", -4.310799125385514),\n                                    (\"half <integer> (german style hour-of-day)after lunch\",\n                                     -5.003946305945459),\n                                    (\"until <time-of-day>morning\", -5.003946305945459),\n                                    (\"minutehour\", -2.3648889763302003),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -4.087655574071304),\n                                    (\"<hour-of-day> <integer> (as relative minutes)after lunch\",\n                                     -5.003946305945459),\n                                    (\"tomorrowevening\", -5.003946305945459),\n                                    (\"time-of-day (latent)morning\", -5.003946305945459),\n                                    (\"hh:mmmorning\", -5.003946305945459),\n                                    (\"half <integer> (german style hour-of-day)in|during the <part-of-day>\",\n                                     -4.598481197837295),\n                                    (\"until <time-of-day>on <date>\", -5.003946305945459),\n                                    (\"<day-of-month>(ordinal) <named-month>morning\",\n                                     -5.003946305945459),\n                                    (\"<time-of-day>  o'clockevening\", -5.003946305945459),\n                                    (\"hh:mmon <date>\", -4.087655574071304),\n                                    (\"<hour-of-day> <integer> (as relative minutes)afternoon\",\n                                     -5.003946305945459),\n                                    (\"tomorrowlunch\", -4.598481197837295),\n                                    (\"until <time-of-day>after lunch\", -5.003946305945459),\n                                    (\"Montagmorning\", -5.003946305945459),\n                                    (\"at <time-of-day>on <date>\", -4.087655574071304),\n                                    (\"yesterdayevening\", -5.003946305945459),\n                                    (\"intersectmorning\", -5.003946305945459),\n                                    (\"hh:mmin|during the <part-of-day>\", -4.087655574071304),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -4.310799125385514),\n                                    (\"<hour-of-day> <integer> (as relative minutes)on <date>\",\n                                     -4.598481197837295),\n                                    (\"about <time-of-day>in|during the <part-of-day>\",\n                                     -4.598481197837295),\n                                    (\"half <integer> (german style hour-of-day)on <date>\",\n                                     -4.598481197837295),\n                                    (\"at <time-of-day>morning\", -5.003946305945459),\n                                    (\"until <time-of-day>in|during the <part-of-day>\",\n                                     -5.003946305945459)],\n                               n = 125},\n                   koData =\n                     ClassData{prior = -2.176171168138387, unseen = -4.394449154672439,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -3.283414346005772),\n                                    (\"year (latent)on <date>\", -3.6888794541139363),\n                                    (\"<time-of-day>  o'clockafter lunch\", -3.6888794541139363),\n                                    (\"intersectevening\", -2.995732273553991),\n                                    (\"monthhour\", -3.6888794541139363),\n                                    (\"time-of-day (latent)on <date>\", -2.772588722239781),\n                                    (\"hourhour\", -1.742969305058623),\n                                    (\"Februarmorning\", -3.6888794541139363),\n                                    (\"<time-of-day>  o'clockafternoon\", -3.6888794541139363),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.6888794541139363),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.772588722239781)],\n                               n = 16}}),\n       (\"Pfingstmontag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -0.37729423114146804,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -1.157452788691043, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1416505170630268, unseen = -4.634728988229636,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.8523840910444898),\n                                    (\"half <integer> (german style hour-of-day)\",\n                                     -3.9318256327243257),\n                                    (\"about <time-of-day>\", -3.0155349008501706),\n                                    (\"time-of-day (latent)\", -1.62924053973028),\n                                    (\"relative minutes after|past <integer> (hour-of-day)\",\n                                     -3.9318256327243257),\n                                    (\"hh:mm\", -3.0155349008501706),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -3.9318256327243257),\n                                    (\"hour\", -0.9614111671546247), (\"minute\", -2.4277482359480516),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.9318256327243257)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.0243817644968085,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -1.2321436812926323),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 7}}),\n       (\"Neujahr\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"on <date>\", -2.3978952727983707),\n                                    (\"Freitag\", -1.7047480922384253),\n                                    (\"Sonntag\", -2.803360380906535),\n                                    (\"Montag\", -2.1102132003465894), (\"day\", -0.8574502318512216),\n                                    (\"Mittwoch\", -2.803360380906535),\n                                    (\"Samstag\", -2.803360380906535)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Freitag\", -1.5040773967762742), (\"day\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pessach\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -4.941642422609305,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of , after named day\", -3.835861644462582),\n                                    (\"Freitag\", -4.241326752570746),\n                                    (\"intersect\", -1.7155981082624912),\n                                    (\"after lunch\", -2.9885637840753785),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -4.241326752570746),\n                                    (\"day\", -1.5671781031442178),\n                                    (\"afternoon\", -2.9885637840753785),\n                                    (\"intersect by ','\", -2.9885637840753785),\n                                    (\"intersect by 'of', 'from', 's\", -3.3250360206965914),\n                                    (\"Donnerstag\", -3.548179572010801),\n                                    (\"<day-of-month> (ordinal)\", -3.835861644462582),\n                                    (\"hour\", -2.044102175234527), (\"evening\", -4.241326752570746),\n                                    (\"<datetime> - <datetime> (interval)\", -4.241326752570746),\n                                    (\"minute\", -2.1618852108909103),\n                                    (\"Samstag\", -3.835861644462582),\n                                    (\"morning\", -4.241326752570746)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.456735772821304),\n                                    (\"after lunch\", -2.8622008809294686),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -2.8622008809294686),\n                                    (\"tomorrow\", -2.8622008809294686), (\"day\", -1.9459101490553135),\n                                    (\"hh:mm\", -2.456735772821304),\n                                    (\"<day-of-month> (ordinal)\", -2.8622008809294686),\n                                    (\"hour\", -2.8622008809294686), (\"minute\", -2.169053700369523)],\n                               n = 8}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Aschura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pfingsten\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time-of-day>  o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -3.846628082779605e-2,\n                               unseen = -5.3706380281276624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"exactly <time-of-day>\", -4.672828834461907),\n                                    (\"at <time-of-day>\", -2.5933872927820705),\n                                    (\"half <integer> (german style hour-of-day)\",\n                                     -4.672828834461907),\n                                    (\"about <time-of-day>\", -2.1078794770003695),\n                                    (\"time-of-day (latent)\", -1.4539530095937054),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -4.672828834461907),\n                                    (\"until <time-of-day>\", -3.5742165457937967),\n                                    (\"hour\", -0.750855498180592), (\"minute\", -4.267363726353742),\n                                    (\"after <time-of-day>\", -3.5742165457937967)],\n                               n = 102},\n                   koData =\n                     ClassData{prior = -3.2771447329921766,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1972245773362196),\n                                    (\"time-of-day (latent)\", -1.791759469228055),\n                                    (\"hour\", -1.2809338454620642),\n                                    (\"after <time-of-day>\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"Rosch haSchana\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Freitag\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Juli\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Valentinstag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Gr\\252ndonnerstag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karfreitag\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Chinesisches Neujahr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter\", -0.916290731874155),\n                                    (\"ordinal (1..31)quarter (grain)\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1}}),\n       (\"a <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Mai\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"3 days ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and a half hour\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"simple and complex numerals written as one wordhour (grain)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"simple and complex numerals written as one wordhour (grain)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 3}}),\n       (\"simple and complex numerals written as one word\",\n        Classifier{okData =\n                     ClassData{prior = -9.763846956391606e-2,\n                               unseen = -3.713572066704308,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 39},\n                   koData =\n                     ClassData{prior = -2.374905754573672, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.12020308869575518,\n                               unseen = -7.333676395657684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Boghiyear\", -6.639875833826536),\n                                    (\"Lailat al-Qadryear\", -5.135798437050262),\n                                    (\"Samstag<time-of-day>  o'clock\", -6.639875833826536),\n                                    (\"hourday\", -5.387112865331168),\n                                    (\"<datetime> - <datetime> (interval)year\", -5.387112865331168),\n                                    (\"dayhour\", -2.9385738597140425),\n                                    (\"daymonth\", -3.4011973816621555),\n                                    (\"Orthodoxer Ostersonntagyear\", -6.639875833826536),\n                                    (\"<day-of-month>(ordinal) <named-month> year<time-of-day>  o'clock\",\n                                     -6.639875833826536),\n                                    (\"monthyear\", -4.848116364598481),\n                                    (\"yearhour\", -6.639875833826536),\n                                    (\"Naraka Chaturdashiyear\", -6.234410725718371),\n                                    (\"Govardhan Pujayear\", -6.234410725718371),\n                                    (\"Juliintersect\", -6.639875833826536),\n                                    (\"intersect<time-of-day>  o'clock\", -4.499809670330265),\n                                    (\"after lunchat <time-of-day>\", -6.639875833826536),\n                                    (\"absorption of , after named daymm/dd/yyyy\",\n                                     -6.639875833826536),\n                                    (\"intersectJuli\", -5.94672865326659),\n                                    (\"Isra and Mi'rajyear\", -5.723585101952381),\n                                    (\"Schawuotyear\", -6.234410725718371),\n                                    (\"Aschermontagyear\", -5.94672865326659),\n                                    (\"<day-of-month> (ordinal)Dienstag\", -6.639875833826536),\n                                    (\"Sukkotyear\", -6.234410725718371),\n                                    (\"intersect by 'of', 'from', 'syear\", -6.234410725718371),\n                                    (\"<day-of-month> (ordinal)September\", -6.234410725718371),\n                                    (\"intersect<time> <part-of-day>\", -4.5604342921467),\n                                    (\"Jom Kippuryear\", -6.234410725718371),\n                                    (\"<time-of-day>  o'clockafter lunch\", -5.94672865326659),\n                                    (\"<day-of-month> (ordinal)Mittwoch\", -6.639875833826536),\n                                    (\"Montagthis <cycle>\", -6.639875833826536),\n                                    (\"Holiyear\", -5.94672865326659),\n                                    (\"<time> <part-of-day><time-of-day>  o'clock\",\n                                     -6.639875833826536),\n                                    (\"Oktoberyear\", -5.541263545158426),\n                                    (\"today<time-of-day>  o'clock\", -6.639875833826536),\n                                    (\"Dhanterasyear\", -6.234410725718371),\n                                    (\"<time-of-day>  o'clockon <date>\", -6.234410725718371),\n                                    (\"Islamisches Neujahryear\", -6.234410725718371),\n                                    (\"intersect by ','year\", -5.541263545158426),\n                                    (\"Holika Dahanyear\", -5.94672865326659),\n                                    (\"on <date><time-of-day>  o'clock\", -6.639875833826536),\n                                    (\"exactly <time-of-day>tomorrow\", -6.234410725718371),\n                                    (\"Jumu'atul-Widayear\", -5.723585101952381),\n                                    (\"mm/dd<time-of-day>  o'clock\", -6.639875833826536),\n                                    (\"monthhour\", -6.234410725718371),\n                                    (\"on <date>between <datetime> and <datetime> (interval)\",\n                                     -6.234410725718371),\n                                    (\"last <day-of-week> of <time>year\", -6.639875833826536),\n                                    (\"hourmonth\", -6.234410725718371),\n                                    (\"Krishna Janmashtamiyear\", -6.234410725718371),\n                                    (\"todayat <time-of-day>\", -5.94672865326659),\n                                    (\"Guru Gobind Singh Jayantiyear\", -6.639875833826536),\n                                    (\"mm/ddabout <time-of-day>\", -6.234410725718371),\n                                    (\"Donnerstagfrom <datetime> - <datetime> (interval)\",\n                                     -5.723585101952381),\n                                    (\"<day-of-month> (ordinal)Mai\", -6.639875833826536),\n                                    (\"on <date>between <time-of-day> and <time-of-day> (interval)\",\n                                     -6.234410725718371),\n                                    (\"Christi Himmelfahrtyear\", -5.94672865326659),\n                                    (\"on <date>at <time-of-day>\", -6.234410725718371),\n                                    (\"dayday\", -3.46182200347859),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.234410725718371),\n                                    (\"Thai Pongalyear\", -5.723585101952381),\n                                    (\"Thiru Onamyear\", -5.94672865326659),\n                                    (\"Maulid an-Nab\\299year\", -6.234410725718371),\n                                    (\"Vijayadashamiyear\", -6.234410725718371),\n                                    (\"about <time-of-day>on <date>\", -6.639875833826536),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in|during the <part-of-day>\",\n                                     -6.234410725718371),\n                                    (\"<day-of-month> (ordinal)intersect\", -5.387112865331168),\n                                    (\"hourhour\", -4.11414718951828),\n                                    (\"hh:mmintersect by ','\", -5.387112865331168),\n                                    (\"Donnerstagfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.387112865331168),\n                                    (\"Dienstagthis <cycle>\", -6.639875833826536),\n                                    (\"<part-of-day> of <time>Februar\", -6.234410725718371),\n                                    (\"Raksha Bandhanyear\", -6.639875833826536),\n                                    (\"Tu biSchevatyear\", -6.234410725718371),\n                                    (\"dayyear\", -1.844085288229795),\n                                    (\"Eid al-Adhayear\", -4.499809670330265),\n                                    (\"Orthodoxer Palmsonntagyear\", -6.639875833826536),\n                                    (\"K\\246nigstagyear\", -5.94672865326659),\n                                    (\"Mittwochthis <cycle>\", -6.639875833826536),\n                                    (\"Jom HaShoahyear\", -5.723585101952381),\n                                    (\"Lag BaOmeryear\", -6.234410725718371),\n                                    (\"<time-of-day>  o'clockin|during the <part-of-day>\",\n                                     -5.541263545158426),\n                                    (\"Guru Ravidass Jayantiyear\", -5.541263545158426),\n                                    (\"tomorrow<time-of-day>  o'clock\", -6.234410725718371),\n                                    (\"<time-of-day>  o'clocktomorrow\", -5.94672865326659),\n                                    (\"Jom Ha'atzmautyear\", -5.94672865326659),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -5.94672865326659),\n                                    (\"half <integer> (german style hour-of-day)after lunch\",\n                                     -6.639875833826536),\n                                    (\"Pargat Diwasyear\", -5.723585101952381),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month>\",\n                                     -5.387112865331168),\n                                    (\"Rabindra Jayantiyear\", -5.723585101952381),\n                                    (\"hourminute\", -5.94672865326659),\n                                    (\"the <day-of-month> (ordinal)Juli\", -6.639875833826536),\n                                    (\"Ostermontagyear\", -6.639875833826536),\n                                    (\"Fastenzeityear\", -6.639875833826536),\n                                    (\"on <date><day-of-month>(ordinal) <named-month>\",\n                                     -6.234410725718371),\n                                    (\"minutemonth\", -4.11414718951828),\n                                    (\"minutehour\", -4.388584035220041),\n                                    (\"Maha Navamiyear\", -6.639875833826536),\n                                    (\"Simchat Torahyear\", -6.639875833826536),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.723585101952381),\n                                    (\"Palmsonntagyear\", -6.639875833826536),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month> year\",\n                                     -6.234410725718371),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -5.541263545158426),\n                                    (\"Kaanum Pongalyear\", -6.234410725718371),\n                                    (\"Maha Saptamiyear\", -6.639875833826536),\n                                    (\"<day-of-month>(ordinal) <named-month> year<time> <part-of-day>\",\n                                     -6.639875833826536),\n                                    (\"<hour-of-day> <integer> (as relative minutes)after lunch\",\n                                     -6.639875833826536),\n                                    (\"Donnerstag<time> timezone\", -6.234410725718371),\n                                    (\"on <date>Dezember\", -6.639875833826536),\n                                    (\"Parsi Neujahryear\", -5.723585101952381),\n                                    (\"Corpus Christiyear\", -6.234410725718371),\n                                    (\"Samstagat <time-of-day>\", -6.234410725718371),\n                                    (\"intersect<day-of-month>(ordinal) <named-month>\",\n                                     -5.387112865331168),\n                                    (\"Orthodoxer Ostermontagyear\", -6.639875833826536),\n                                    (\"this <part-of-day><time-of-day>  o'clock\",\n                                     -6.639875833826536),\n                                    (\"<day-of-month>(ordinal) <named-month>intersect\",\n                                     -6.639875833826536),\n                                    (\"hh:mmintersect\", -4.1975287984573315),\n                                    (\"Fastnachtyear\", -5.94672865326659),\n                                    (\"Donnerstaghh:mm\", -6.639875833826536),\n                                    (\"Weihnachtenyear\", -6.639875833826536),\n                                    (\"<day-of-month> (ordinal)Juli\", -5.94672865326659),\n                                    (\"Dayananda Saraswati Jayantiyear\", -6.639875833826536),\n                                    (\"Orthodoxer Karfreitagyear\", -6.639875833826536),\n                                    (\"Chanukkayear\", -6.234410725718371),\n                                    (\"intersect by ','intersect\", -5.387112865331168),\n                                    (\"intersect by 'of', 'from', 'sJuli\", -6.639875833826536),\n                                    (\"half <integer> (german style hour-of-day)in|during the <part-of-day>\",\n                                     -6.234410725718371),\n                                    (\"Mahavir Jayantiyear\", -6.234410725718371),\n                                    (\"from <datetime> - <datetime> (interval)year\",\n                                     -5.94672865326659),\n                                    (\"at <time-of-day>intersect\", -4.848116364598481),\n                                    (\"on <date>from <time-of-day> - <time-of-day> (interval)\",\n                                     -5.723585101952381),\n                                    (\"<time> <part-of-day>from <time-of-day> - <time-of-day> (interval)\",\n                                     -6.639875833826536),\n                                    (\"absorption of , after named day<day-of-month> (ordinal)\",\n                                     -5.387112865331168),\n                                    (\"Donnerstagbetween <time-of-day> and <time-of-day> (interval)\",\n                                     -6.234410725718371),\n                                    (\"Dreifaltigkeitssonntagyear\", -5.723585101952381),\n                                    (\"Tisha B'Avyear\", -6.639875833826536),\n                                    (\"the <day-of-month> (ordinal)Dezember\", -6.639875833826536),\n                                    (\"dayminute\", -3.8672871115867546),\n                                    (\"on <date>from <datetime> - <datetime> (interval)\",\n                                     -6.234410725718371),\n                                    (\"Maiyear\", -6.639875833826536),\n                                    (\"Mittwochnext <cycle>\", -6.639875833826536),\n                                    (\"Donnerstagbetween <datetime> and <datetime> (interval)\",\n                                     -6.234410725718371),\n                                    (\"<time> <part-of-day>from <datetime> - <datetime> (interval)\",\n                                     -6.639875833826536),\n                                    (\"intersectyear\", -4.768073656924945),\n                                    (\"on <date>intersect\", -6.234410725718371),\n                                    (\"on <date><day-of-month> (ordinal)\", -6.234410725718371),\n                                    (\"intersectSeptember\", -4.000818504211277),\n                                    (\"<ordinal> <cycle> of <time>year\", -6.639875833826536),\n                                    (\"minuteday\", -2.7897282321164774),\n                                    (\"absorption of , after named dayintersect\",\n                                     -4.241980561028165),\n                                    (\"intersect by ','September\", -5.253581472706645),\n                                    (\"year<time-of-day>  o'clock\", -6.639875833826536),\n                                    (\"Juliyear\", -6.234410725718371),\n                                    (\"at <time-of-day>intersect by ','\", -5.94672865326659),\n                                    (\"hh:mmabsorption of , after named day\", -6.234410725718371),\n                                    (\"Earth Houryear\", -6.234410725718371),\n                                    (\"intersect by ','<time> <part-of-day>\", -5.723585101952381),\n                                    (\"Karfreitagyear\", -5.94672865326659),\n                                    (\"Chinesisches Neujahryear\", -6.639875833826536),\n                                    (\"Gr\\252ndonnerstagyear\", -5.541263545158426),\n                                    (\"hh:mmon <date>\", -4.1975287984573315),\n                                    (\"Pfingstenyear\", -6.234410725718371),\n                                    (\"Mattu Pongalyear\", -6.639875833826536),\n                                    (\"Rosch haSchanayear\", -5.94672865326659),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.639875833826536),\n                                    (\"until <time-of-day>after lunch\", -6.639875833826536),\n                                    (\"Pfingstmontagyear\", -6.234410725718371),\n                                    (\"mm/ddyear\", -6.234410725718371),\n                                    (\"intersect by ','<time-of-day>  o'clock\", -5.723585101952381),\n                                    (\"intersect<day-of-month> (ordinal)\", -5.387112865331168),\n                                    (\"absorption of , after named daymm/dd\", -6.639875833826536),\n                                    (\"on <date>September\", -5.723585101952381),\n                                    (\"Septemberyear\", -6.234410725718371),\n                                    (\"<day-of-month> (ordinal)intersect by 'of', 'from', 's\",\n                                     -5.94672865326659),\n                                    (\"at <time-of-day>on <date>\", -4.768073656924945),\n                                    (\"Pessachyear\", -5.541263545158426),\n                                    (\"intersectintersect\", -4.5604342921467),\n                                    (\"<day-of-month> (ordinal)Februar\", -5.541263545158426),\n                                    (\"Aschurayear\", -5.94672865326659),\n                                    (\"dayweek\", -5.541263545158426),\n                                    (\"intersect by ','Juli\", -5.94672865326659),\n                                    (\"absorption of , after named daythe <day-of-month> (ordinal)\",\n                                     -6.639875833826536),\n                                    (\"weekyear\", -6.234410725718371),\n                                    (\"<day-of-month> (ordinal)Dezember\", -5.541263545158426),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.723585101952381),\n                                    (\"Karva Chauthyear\", -6.234410725718371),\n                                    (\"Orthodoxer Karsamstagyear\", -6.639875833826536),\n                                    (\"Navaratriyear\", -6.234410725718371),\n                                    (\"Maha Shivaratriyear\", -6.639875833826536),\n                                    (\"Ramadanyear\", -5.387112865331168),\n                                    (\"Marzyear\", -6.639875833826536),\n                                    (\"Bhai Doojyear\", -6.639875833826536),\n                                    (\"tomorrowat <time-of-day>\", -6.234410725718371),\n                                    (\"<hour-of-day> <integer> (as relative minutes)on <date>\",\n                                     -6.639875833826536),\n                                    (\"Eid al-Fitryear\", -5.253581472706645),\n                                    (\"Donnerstag<time-of-day> - <time-of-day> (interval)\",\n                                     -6.234410725718371),\n                                    (\"Donnerstag<datetime> - <datetime> (interval)\",\n                                     -6.639875833826536),\n                                    (\"Aschermittwochyear\", -5.94672865326659),\n                                    (\"Lazarus-Samstagyear\", -6.234410725718371),\n                                    (\"Sonntaglast <cycle>\", -6.639875833826536),\n                                    (\"at <time-of-day>tomorrow\", -6.639875833826536),\n                                    (\"Ostersonntagyear\", -6.639875833826536),\n                                    (\"tomorrowabout <time-of-day>\", -6.234410725718371),\n                                    (\"Gro\\223e Fastenzeityear\", -6.639875833826536),\n                                    (\"about <time-of-day>in|during the <part-of-day>\",\n                                     -6.234410725718371),\n                                    (\"Schmini Azeretyear\", -5.94672865326659),\n                                    (\"half <integer> (german style hour-of-day)on <date>\",\n                                     -6.639875833826536),\n                                    (\"this <part-of-day>at <time-of-day>\", -6.234410725718371),\n                                    (\"<datetime> - <datetime> (interval)Juli\", -6.234410725718371),\n                                    (\"Vaisakhiyear\", -5.723585101952381),\n                                    (\"Diwaliyear\", -5.94672865326659),\n                                    (\"after lunch<hour-of-day> <integer> (as relative minutes)\",\n                                     -6.234410725718371),\n                                    (\"<day-of-month> (ordinal)Marz\", -6.639875833826536),\n                                    (\"last <cycle> of <time>year\", -6.234410725718371),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -6.639875833826536),\n                                    (\"minuteyear\", -6.234410725718371),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -6.639875833826536),\n                                    (\"Chhathyear\", -5.94672865326659),\n                                    (\"Vasant Panchamiyear\", -6.234410725718371),\n                                    (\"Global Youth Service-Tagyear\", -6.639875833826536),\n                                    (\"Karsamstagyear\", -5.94672865326659)],\n                               n = 642},\n                   koData =\n                     ClassData{prior = -2.178072145121463, unseen = -6.018593214496234,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of , after named daythe <day-of-month> (non ordinal)\",\n                                     -5.3230099791384085),\n                                    (\"<datetime> - <datetime> (interval)year\", -5.3230099791384085),\n                                    (\"Mittwochby the end of <time>\", -4.917544871030244),\n                                    (\"dayhour\", -4.629862798578463),\n                                    (\"daymonth\", -3.618261886899983),\n                                    (\"monthyear\", -5.3230099791384085),\n                                    (\"yearhour\", -5.3230099791384085),\n                                    (\"after lunchat <time-of-day>\", -4.917544871030244),\n                                    (\"mm/dduntil <time-of-day>\", -4.917544871030244),\n                                    (\"until <time-of-day>year\", -4.917544871030244),\n                                    (\"<day-of-month> (ordinal)Dienstag\", -4.917544871030244),\n                                    (\"absorption of , after named dayFebruar\", -4.2243976904702984),\n                                    (\"Donnerstagyear\", -4.629862798578463),\n                                    (\"on <date>Februar\", -5.3230099791384085),\n                                    (\"intersect by 'of', 'from', 'syear\", -4.629862798578463),\n                                    (\"intersect<time> <part-of-day>\", -5.3230099791384085),\n                                    (\"<time-of-day>  o'clockafter lunch\", -5.3230099791384085),\n                                    (\"<day-of-month> (ordinal)Mittwoch\", -5.3230099791384085),\n                                    (\"after lunch<time-of-day>  o'clock\", -5.3230099791384085),\n                                    (\"Holiyear\", -5.3230099791384085),\n                                    (\"absorption of , after named dayhh:mm\", -5.3230099791384085),\n                                    (\"<time-of-day>  o'clock<time> <part-of-day>\",\n                                     -4.406719247264253),\n                                    (\"monthhour\", -5.3230099791384085),\n                                    (\"todayat <time-of-day>\", -5.3230099791384085),\n                                    (\"dayday\", -3.9367156180185177),\n                                    (\"Thai Pongalyear\", -4.629862798578463),\n                                    (\"hourhour\", -3.8189325823621343),\n                                    (\"Donnerstagafter <time-of-day>\", -5.3230099791384085),\n                                    (\"dayyear\", -2.254957044004791),\n                                    (\"Ostermontagyear\", -5.3230099791384085),\n                                    (\"Fastenzeityear\", -5.3230099791384085),\n                                    (\"Palmsonntagyear\", -5.3230099791384085),\n                                    (\"Aprilyear\", -5.3230099791384085),\n                                    (\"Sonntagyear\", -5.3230099791384085),\n                                    (\"Montagyear\", -4.629862798578463),\n                                    (\"Dienstagafter <time-of-day>\", -5.3230099791384085),\n                                    (\"Donnerstaghh:mm\", -4.917544871030244),\n                                    (\"<day-of-month> (ordinal)Juli\", -4.917544871030244),\n                                    (\"dayminute\", -3.9367156180185177),\n                                    (\"until <time-of-day>Juli\", -5.3230099791384085),\n                                    (\"Karfreitagyear\", -5.3230099791384085),\n                                    (\"Freitagyear\", -4.917544871030244),\n                                    (\"year<time> <part-of-day>\", -5.3230099791384085),\n                                    (\"mm/ddyear\", -3.8189325823621343),\n                                    (\"Neujahryear\", -4.406719247264253),\n                                    (\"<day-of-month> (ordinal)intersect by 'of', 'from', 's\",\n                                     -4.917544871030244),\n                                    (\"Donnerstag<part-of-day> of <time>\", -5.3230099791384085),\n                                    (\"<day-of-month> (ordinal)April\", -5.3230099791384085),\n                                    (\"daynograin\", -4.917544871030244),\n                                    (\"Ostersonntagyear\", -5.3230099791384085),\n                                    (\"after <time-of-day>year\", -5.3230099791384085),\n                                    (\"on <date>after <time-of-day>\", -5.3230099791384085),\n                                    (\"Diwaliyear\", -5.3230099791384085),\n                                    (\"tomorrownoon\", -5.3230099791384085),\n                                    (\"Samstagyear\", -4.629862798578463),\n                                    (\"Karsamstagyear\", -5.3230099791384085)],\n                               n = 82}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinal (1..31)week (grain)intersect\", -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinal (1..31)day (grain)Oktober\", -1.7047480922384253),\n                                    (\"ordinal (1..31)week (grain)Oktober\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.3025850929940455),\n                                    (\"minuteminute\", -2.3025850929940455),\n                                    (\"time-of-day (latent)time-of-day (latent)\", -2.70805020110221),\n                                    (\"hh:mmhh:mm\", -2.3025850929940455),\n                                    (\"dayday\", -2.0149030205422647),\n                                    (\"hourhour\", -2.70805020110221),\n                                    (\"minutehour\", -2.3025850929940455),\n                                    (\"mm/ddmm/dd\", -2.0149030205422647)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.2512917986064953),\n                                    (\"mm/ddmm/dd/yyyy\", -2.2512917986064953),\n                                    (\"mm/ddhh:mm\", -2.2512917986064953),\n                                    (\"dayday\", -1.6916760106710724),\n                                    (\"mm/ddintersect\", -2.2512917986064953),\n                                    (\"dayminute\", -2.2512917986064953),\n                                    (\"mm/ddtime-of-day (latent)\", -2.2512917986064953)],\n                               n = 12}}),\n       (\"after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Muttertag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"month (grain)\", -2.3025850929940455),\n                                    (\"year (grain)\", -2.3025850929940455),\n                                    (\"week (grain)\", -1.6094379124341003),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -2.3025850929940455),\n                                    (\"month\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"week (grain)\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"Dreifaltigkeitssonntag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.6094379124341003),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -1.6094379124341003),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Silvester\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Chanukka\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"couple\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinal (digits)quarter (grain)year\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Fastnacht\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Weihnachten\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodoxer Karfreitag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mittwoch<integer> <unit-of-duration>\", -0.8754687373538999),\n                                    (\"dayweek\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Mittwochfortnight\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"Orthodoxer Ostermontag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Allerheiligen\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (1..31)DienstagOktober\", -1.9459101490553135),\n                                    (\"daymonth\", -1.0296194171811581),\n                                    (\"ordinal (1..31)Dienstagintersect\", -1.9459101490553135),\n                                    (\"ordinal (1..31)Mittwochintersect\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (1..31)MittwochOktober\", -1.3862943611198906),\n                                    (\"daymonth\", -1.0986122886681098),\n                                    (\"ordinal (1..31)DienstagSeptember\", -1.791759469228055)],\n                               n = 3}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"Palmsonntag\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Parsi Neujahr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vatertag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -0.9444616088408514),\n                                    (\"morning<day-of-month>(ordinal) <named-month>\",\n                                     -1.791759469228055),\n                                    (\"morningintersect\", -1.791759469228055),\n                                    (\"morning<day-of-month> (ordinal)\", -1.791759469228055)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.3862943611198906),\n                                    (\"morningtime-of-day (latent)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Corpus Christi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sonntag\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (german style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.7047480922384253),\n                                    (\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Montag\",\n        Classifier{okData =\n                     ClassData{prior = -0.2411620568168881,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -1.540445040947149, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.16251892949777494,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)Juli\", -2.3513752571634776),\n                                    (\"ordinal (1..31)Dezember\", -1.9459101490553135),\n                                    (\"ordinal (1..31)Marz\", -3.044522437723423),\n                                    (\"ordinal (digits)Mai\", -3.044522437723423),\n                                    (\"ordinal (digits)September\", -2.639057329615259),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"ordinal (digits)Februar\", -1.9459101490553135)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -1.8971199848858813, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)Juli\", -1.540445040947149),\n                                    (\"ordinal (digits)April\", -1.9459101490553135),\n                                    (\"month\", -1.252762968495368)],\n                               n = 3}}),\n       (\"ordinal (1..31)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 22}}),\n       (\"Fastenzeit\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.0624621816434854e-2,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"after lunch\", -1.6650077635889111),\n                                    (\"afternoon\", -1.5314763709643884),\n                                    (\"hour\", -0.7777045685880083), (\"evening\", -2.512305623976115),\n                                    (\"morning\", -2.917770732084279)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -2.833213344056216, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"after lunch\", -1.252762968495368),\n                                    (\"hour\", -1.252762968495368)],\n                               n = 1}}),\n       (\"Ostermontag\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"after next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.0794415416798357),\n                                    (\"month (grain)\", -2.0794415416798357),\n                                    (\"year (grain)\", -2.0794415416798357),\n                                    (\"week (grain)\", -2.0794415416798357),\n                                    (\"quarter\", -2.0794415416798357), (\"year\", -2.0794415416798357),\n                                    (\"month\", -2.0794415416798357),\n                                    (\"quarter (grain)\", -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Freitag\", -1.252762968495368), (\"day\", -0.8472978603872037),\n                                    (\"Mittwoch\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marz\", -1.3862943611198906), (\"Freitag\", -1.3862943611198906),\n                                    (\"day\", -1.3862943611198906), (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu biSchevat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodoxer Palmsonntag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"K\\246nigstag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (1..31)\", -0.6931471805599453),\n                                    (\"ordinal (digits)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"year (grain)\", -2.3025850929940455),\n                                    (\"week (grain)\", -1.2039728043259361),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.626052087178029e-2,\n                               unseen = -4.852030263919617,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.646962509122372),\n                                    (\"<time-of-day>  o'clock\", -1.5860905484371093),\n                                    (\"about <time-of-day>\", -2.2792377289970545),\n                                    (\"time-of-day (latent)\", -2.010973742402375),\n                                    (\"hour\", -0.7170527014134996)],\n                               n = 61},\n                   koData =\n                     ClassData{prior = -4.127134385045092, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -1.252762968495368)],\n                               n = 1}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.23419338750079477, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -6.995858860691034e-2),\n                                    (\"simple and complex numerals written as one word\",\n                                     -2.6946271807700692)],\n                               n = 72},\n                   koData =\n                     ClassData{prior = -1.5664205273504095,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2113090936672069),\n                                    (\"simple and complex numerals written as one word\",\n                                     -1.6582280766035324)],\n                               n = 19}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -1.731645001146093e-2,\n                               unseen = -5.442417710521793,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 229},\n                   koData =\n                     ClassData{prior = -4.06474409244581, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"MontagMarz\", -1.6094379124341003),\n                                    (\"SonntagMarz\", -1.6094379124341003),\n                                    (\"Sonntagintersect\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8034952377288106, unseen = -4.430816798843313,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9339339580085977),\n                                    (\"simple and complex numerals written as one wordhour (grain)\",\n                                     -3.3202283191284883),\n                                    (\"integer (numeric)day (grain)\", -2.8094026953624978),\n                                    (\"couplehour (grain)\", -3.7256934272366524),\n                                    (\"simple and complex numerals written as one wordyear (grain)\",\n                                     -3.3202283191284883),\n                                    (\"second\", -3.7256934272366524),\n                                    (\"integer (numeric)year (grain)\", -3.7256934272366524),\n                                    (\"day\", -2.8094026953624978),\n                                    (\"simple and complex numerals written as one wordmonth (grain)\",\n                                     -3.7256934272366524),\n                                    (\"year\", -3.0325462466767075),\n                                    (\"simple and complex numerals written as one wordsecond (grain)\",\n                                     -3.7256934272366524),\n                                    (\"integer (numeric)week (grain)\", -2.627081138568543),\n                                    (\"hour\", -2.8094026953624978), (\"month\", -3.7256934272366524),\n                                    (\"integer (numeric)minute (grain)\", -2.627081138568543),\n                                    (\"simple and complex numerals written as one wordweek (grain)\",\n                                     -2.472930458741285),\n                                    (\"minute\", -2.472930458741285),\n                                    (\"integer (numeric)hour (grain)\", -3.7256934272366524),\n                                    (\"simple and complex numerals written as one wordminute (grain)\",\n                                     -3.7256934272366524)],\n                               n = 30},\n                   koData =\n                     ClassData{prior = -0.5937747067467416, unseen = -4.584967478670572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.62880082944807),\n                                    (\"simple and complex numerals written as one wordhour (grain)\",\n                                     -3.8815637979434374),\n                                    (\"integer (numeric)day (grain)\", -3.4760986898352733),\n                                    (\"simple and complex numerals written as one wordyear (grain)\",\n                                     -2.9652730660692823),\n                                    (\"second\", -2.9652730660692823),\n                                    (\"integer (numeric)second (grain)\", -3.4760986898352733),\n                                    (\"integer (numeric)year (grain)\", -3.4760986898352733),\n                                    (\"day\", -2.3774864011671633),\n                                    (\"simple and complex numerals written as one wordmonth (grain)\",\n                                     -2.9652730660692823),\n                                    (\"year\", -2.62880082944807),\n                                    (\"simple and complex numerals written as one wordsecond (grain)\",\n                                     -3.4760986898352733),\n                                    (\"integer (numeric)week (grain)\", -3.188416617383492),\n                                    (\"hour\", -3.188416617383492), (\"month\", -2.62880082944807),\n                                    (\"integer (numeric)minute (grain)\", -3.4760986898352733),\n                                    (\"simple and complex numerals written as one wordday (grain)\",\n                                     -2.9652730660692823),\n                                    (\"simple and complex numerals written as one wordweek (grain)\",\n                                     -3.188416617383492),\n                                    (\"integer (numeric)month (grain)\", -3.4760986898352733),\n                                    (\"minute\", -2.9652730660692823),\n                                    (\"coupleday (grain)\", -3.4760986898352733),\n                                    (\"integer (numeric)hour (grain)\", -3.4760986898352733),\n                                    (\"simple and complex numerals written as one wordminute (grain)\",\n                                     -3.4760986898352733)],\n                               n = 37}}),\n       (\"Dienstag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number,number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Christi Himmelfahrt\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>Weihnachten\", -1.252762968495368),\n                                    (\"a <unit-of-duration>Weihnachten\", -1.252762968495368),\n                                    (\"yearday\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"simple and complex numerals written as one wordtime-of-day (latent)\",\n                                     -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Mittwoch\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -2.5649493574615367,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Maulid an-Nab\\299\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Oktober\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (grain)\", -0.6931471805599453),\n                                    (\"year\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd.(mm.)? - dd.mm.(yy[yy]?)? (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6061358035703156,\n                               unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -0.7884573603642702,\n                               unseen = -3.4657359027997265,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 30}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.5040773967762742),\n                                    (\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Islamisches Neujahr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by ','\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.969813299576001,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Freitag<day-of-month>(ordinal) <named-month> year\",\n                                     -3.8642323415917974),\n                                    (\"dayhour\", -2.765620052923688),\n                                    (\"Freitagintersect\", -1.967112356705916),\n                                    (\"Samstag<day-of-month>(ordinal) <named-month>\",\n                                     -4.269697449699962),\n                                    (\"Freitagmm/dd/yyyy\", -3.8642323415917974),\n                                    (\"Freitagmm/dd\", -3.8642323415917974),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"Samstagintersect\", -4.269697449699962),\n                                    (\"dayyear\", -4.269697449699962),\n                                    (\"Freitag<day-of-month>(ordinal) <named-month>\",\n                                     -3.5765502691400166),\n                                    (\"Freitagthe <day-of-month> (ordinal)\", -4.269697449699962),\n                                    (\"on <date><day-of-month>(ordinal) <named-month>\",\n                                     -3.8642323415917974),\n                                    (\"intersect<day-of-month>(ordinal) <named-month>\",\n                                     -3.5765502691400166),\n                                    (\"Freitag<day-of-month> (ordinal)\", -3.5765502691400166),\n                                    (\"on <date>intersect\", -3.8642323415917974),\n                                    (\"on <date><day-of-month> (ordinal)\", -3.8642323415917974),\n                                    (\"minuteday\", -2.6602595372658615),\n                                    (\"Montag<named-month> <day-of-month> (non ordinal)\",\n                                     -3.5765502691400166),\n                                    (\"Sonntag<named-month> <day-of-month> (non ordinal)\",\n                                     -4.269697449699962),\n                                    (\"intersect<day-of-month> (ordinal)\", -3.5765502691400166),\n                                    (\"intersectintersect\", -3.5765502691400166),\n                                    (\"Samstag<day-of-month> (ordinal)\", -4.269697449699962),\n                                    (\"Mittwoch<named-month> <day-of-month> (non ordinal)\",\n                                     -4.269697449699962),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -4.269697449699962)],\n                               n = 56},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -3.871201010907891,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.0583881324820035),\n                                    (\"dayday\", -3.1570004211501135),\n                                    (\"SonntagFebruar\", -3.1570004211501135),\n                                    (\"MontagFebruar\", -2.463853240590168),\n                                    (\"Freitagthe <day-of-month> (non ordinal)\",\n                                     -3.1570004211501135),\n                                    (\"dayminute\", -2.751535313041949),\n                                    (\"MittwochFebruar\", -3.1570004211501135),\n                                    (\"Freitaghh:mm\", -2.751535313041949)],\n                               n = 8}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Februar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by 'of', 'from', 's\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.371577964480997),\n                                    (\"intersectOktober\", -3.2188758248682006),\n                                    (\"Mittwochintersect\", -3.624340932976365),\n                                    (\"on <date>hh:mm\", -3.624340932976365),\n                                    (\"dayday\", -2.70805020110221),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month>\",\n                                     -3.624340932976365),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month> year\",\n                                     -3.624340932976365),\n                                    (\"on <date><time-of-day> - <time-of-day> (interval)\",\n                                     -3.2188758248682006),\n                                    (\"on <date><datetime> - <datetime> (interval)\",\n                                     -3.624340932976365),\n                                    (\"Donnerstaghh:mm\", -3.2188758248682006),\n                                    (\"absorption of , after named day<day-of-month> (ordinal)\",\n                                     -3.624340932976365),\n                                    (\"dayminute\", -1.7525387560747736),\n                                    (\"Mittwochnext <cycle>\", -3.624340932976365),\n                                    (\"absorption of , after named dayintersect\",\n                                     -3.624340932976365),\n                                    (\"DienstagOktober\", -3.624340932976365),\n                                    (\"MittwochOktober\", -3.624340932976365),\n                                    (\"intersectintersect\", -3.624340932976365),\n                                    (\"dayweek\", -3.2188758248682006),\n                                    (\"Donnerstag<time-of-day> - <time-of-day> (interval)\",\n                                     -2.70805020110221),\n                                    (\"Donnerstag<datetime> - <datetime> (interval)\",\n                                     -3.2188758248682006),\n                                    (\"Sonntaglast <cycle>\", -3.624340932976365)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.2992829841302609, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.5040773967762742),\n                                    (\"intersectOktober\", -3.1135153092103742),\n                                    (\"Mittwochintersect\", -3.1135153092103742),\n                                    (\"Dienstagintersect\", -3.1135153092103742),\n                                    (\"DienstagSeptember\", -3.1135153092103742),\n                                    (\"MontagMarz\", -3.1135153092103742),\n                                    (\"SonntagMarz\", -3.1135153092103742),\n                                    (\"intersectSeptember\", -3.1135153092103742),\n                                    (\"MittwochOktober\", -3.1135153092103742),\n                                    (\"Sonntagintersect\", -3.1135153092103742)],\n                               n = 9}}),\n       (\"Donnerstag\",\n        Classifier{okData =\n                     ClassData{prior = -0.2411620568168881,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -1.540445040947149, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003), (\"day\", -1.8971199848858813),\n                                    (\"year\", -2.3025850929940455),\n                                    (\"<integer> <unit-of-duration>\", -0.916290731874155),\n                                    (\"month\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149), (\"day\", -1.540445040947149),\n                                    (\"<integer> <unit-of-duration>\", -1.540445040947149),\n                                    (\"fortnight\", -1.540445040947149)],\n                               n = 4}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sonntag\", -1.252762968495368), (\"day\", -0.8472978603872037),\n                                    (\"Dienstag\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"EOM|End of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4595323293784402, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (1..31)\", -1.0608719606852628),\n                                    (\"ordinal (digits)\", -0.42488319396526597)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -0.9985288301111273, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (1..31)\", -0.8266785731844679),\n                                    (\"ordinal (digits)\", -0.5753641449035618)],\n                               n = 14}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5520685823000397, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.1972245773362196),\n                                    (\"<time-of-day>  o'clock\", -2.1972245773362196),\n                                    (\"intersect\", -3.295836866004329),\n                                    (\"time-of-day (latent)\", -2.043073897508961),\n                                    (\"EOM|End of month\", -3.295836866004329),\n                                    (\"hour\", -1.0445450673978338), (\"month\", -3.295836866004329),\n                                    (\"midnight|EOD|end of day\", -3.295836866004329)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.8574502318512216,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mm/dd\", -2.6855773452501515),\n                                    (\"intersect\", -2.3978952727983707),\n                                    (\"mm/dd/yyyy\", -2.6855773452501515),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -3.0910424533583156),\n                                    (\"day\", -1.3862943611198906), (\"hh:mm\", -2.174751721484161),\n                                    (\"<day-of-month> (ordinal)\", -3.0910424533583156),\n                                    (\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.0910424533583156),\n                                    (\"minute\", -2.174751721484161)],\n                               n = 14}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Schawuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nikolaus\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Aschermontag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Govardhan Puja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> until\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marz\", -2.1972245773362196), (\"Montag\", -1.791759469228055),\n                                    (\"day\", -1.0986122886681098), (\"Dienstag\", -1.791759469228055),\n                                    (\"Mittwoch\", -2.1972245773362196),\n                                    (\"month\", -2.1972245773362196)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.5040773967762742),\n                                    (\"month (grain)\", -2.1972245773362196),\n                                    (\"year (grain)\", -2.1972245773362196),\n                                    (\"week (grain)\", -1.5040773967762742),\n                                    (\"year\", -2.1972245773362196), (\"month\", -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"week (grain)\", -1.791759469228055),\n                                    (\"day\", -1.791759469228055),\n                                    (\"day (grain)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Tag der Deutschen Einheit\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.740840023925201),\n                                    (\"simple and complex numerals written as one wordhour (grain)\",\n                                     -3.4339872044851463),\n                                    (\"integer (numeric)day (grain)\", -3.4339872044851463),\n                                    (\"simple and complex numerals written as one wordyear (grain)\",\n                                     -3.028522096376982),\n                                    (\"second\", -3.028522096376982),\n                                    (\"integer (numeric)second (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)year (grain)\", -3.4339872044851463),\n                                    (\"day\", -2.3353749158170367),\n                                    (\"simple and complex numerals written as one wordmonth (grain)\",\n                                     -3.028522096376982),\n                                    (\"year\", -2.740840023925201),\n                                    (\"simple and complex numerals written as one wordsecond (grain)\",\n                                     -3.4339872044851463),\n                                    (\"integer (numeric)week (grain)\", -3.4339872044851463),\n                                    (\"hour\", -3.028522096376982), (\"month\", -2.740840023925201),\n                                    (\"integer (numeric)minute (grain)\", -3.4339872044851463),\n                                    (\"simple and complex numerals written as one wordday (grain)\",\n                                     -3.028522096376982),\n                                    (\"simple and complex numerals written as one wordweek (grain)\",\n                                     -3.028522096376982),\n                                    (\"integer (numeric)month (grain)\", -3.4339872044851463),\n                                    (\"minute\", -3.028522096376982),\n                                    (\"coupleday (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)hour (grain)\", -3.4339872044851463),\n                                    (\"simple and complex numerals written as one wordminute (grain)\",\n                                     -3.4339872044851463)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half an hour\", -0.916290731874155),\n                                    (\"minute\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> and a half hour\", -0.916290731874155),\n                                    (\"minute\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9808292530117262),\n                                    (\"hh:mm\", -2.0794415416798357), (\"hour\", -0.9808292530117262),\n                                    (\"minute\", -2.0794415416798357)],\n                               n = 6}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2336148511815052,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.8134107167600364),\n                                    (\"<integer> and a half hour\", -3.2188758248682006),\n                                    (\"second\", -3.2188758248682006), (\"day\", -2.8134107167600364),\n                                    (\"half an hour\", -3.2188758248682006),\n                                    (\"year\", -3.2188758248682006),\n                                    (\"<integer> <unit-of-duration>\", -1.1394342831883648),\n                                    (\"number,number hours\", -3.2188758248682006),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"about|exactly <duration>\", -3.2188758248682006),\n                                    (\"minute\", -1.6094379124341003)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.5686159179138452,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9924301646902063),\n                                    (\"<integer> and a half hour\", -2.3978952727983707),\n                                    (\"day\", -2.3978952727983707),\n                                    (\"<integer> <unit-of-duration>\", -1.9924301646902063),\n                                    (\"about|exactly <duration>\", -2.3978952727983707),\n                                    (\"fortnight\", -2.3978952727983707),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 5}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.9694005571881036, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.481240089335692),\n                                    (\"on <date>hh:mm\", -3.481240089335692),\n                                    (\"minuteminute\", -1.6894806201076367),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.0757749812275272),\n                                    (\"hh:mmhh:mm\", -2.228477120840324),\n                                    (\"dayday\", -1.6894806201076367),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.0757749812275272),\n                                    (\"intersect by 'of', 'from', 'shh:mm\", -2.7880929087757464),\n                                    (\"mm/ddmm/dd\", -2.094945728215801)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -0.4769240720903093, unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)<day-of-month>(ordinal) <named-month>\",\n                                     -3.4339872044851463),\n                                    (\"<named-month> <day-of-month> (non ordinal)Juli\",\n                                     -3.8394523125933104),\n                                    (\"daymonth\", -3.4339872044851463),\n                                    (\"mm/ddmm/dd/yyyy\", -2.5866893440979424),\n                                    (\"<day-of-month> (ordinal)mm/dd\", -2.9231615807191553),\n                                    (\"mm/ddhh:mm\", -2.45315795147342),\n                                    (\"dayday\", -1.3545456628053103),\n                                    (\"<day-of-month> (ordinal)intersect\", -3.146305132033365),\n                                    (\"<day-of-month> (ordinal)hh:mm\", -2.9231615807191553),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -3.8394523125933104),\n                                    (\"mm/ddintersect\", -2.5866893440979424),\n                                    (\"dayminute\", -2.0476928433652555),\n                                    (\"<day-of-month> (ordinal)mm/dd/yyyy\", -3.4339872044851463)],\n                               n = 36}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"Orthodoxer Ostersonntag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.3217558399823195),\n                                    (\"hh:mmhh:mm\", -1.3217558399823195),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9459101490553135),\n                                    (\"hourminute\", -1.252762968495368),\n                                    (\"minutehour\", -1.9459101490553135),\n                                    (\"time-of-day (latent)hh:mm\", -1.252762968495368)],\n                               n = 4}}),\n       (\"Lailat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"sommer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5257286443082556),\n                                    (\"integer (numeric)day (grain)\", -3.2188758248682006),\n                                    (\"simple and complex numerals written as one wordyear (grain)\",\n                                     -2.8134107167600364),\n                                    (\"second\", -2.8134107167600364),\n                                    (\"integer (numeric)second (grain)\", -3.2188758248682006),\n                                    (\"integer (numeric)year (grain)\", -3.2188758248682006),\n                                    (\"day\", -2.5257286443082556),\n                                    (\"simple and complex numerals written as one wordmonth (grain)\",\n                                     -2.8134107167600364),\n                                    (\"year\", -2.5257286443082556),\n                                    (\"simple and complex numerals written as one wordsecond (grain)\",\n                                     -3.2188758248682006),\n                                    (\"integer (numeric)week (grain)\", -2.8134107167600364),\n                                    (\"month\", -2.5257286443082556),\n                                    (\"integer (numeric)minute (grain)\", -3.2188758248682006),\n                                    (\"simple and complex numerals written as one wordday (grain)\",\n                                     -2.8134107167600364),\n                                    (\"simple and complex numerals written as one wordweek (grain)\",\n                                     -3.2188758248682006),\n                                    (\"integer (numeric)month (grain)\", -3.2188758248682006),\n                                    (\"minute\", -2.8134107167600364),\n                                    (\"simple and complex numerals written as one wordminute (grain)\",\n                                     -3.2188758248682006)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinal (1..31)Dienstagintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinal (1..31)DienstagWeihnachten\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.1972245773362196),\n                                    (\"Marzinteger (numeric)\", -2.4849066497880004),\n                                    (\"Februarinteger (numeric)\", -1.5040773967762742),\n                                    (\"Aprilinteger (numeric)\", -2.890371757896165),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"Juliinteger (numeric)\", -2.4849066497880004)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Juliinteger (numeric)\", -1.6094379124341003)],\n                               n = 2}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Marz\", -1.3862943611198906),\n                                    (\"integer (numeric)April\", -1.3862943611198906),\n                                    (\"month\", -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)Juli\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Montag\", -1.3862943611198906), (\"day\", -0.8266785731844679),\n                                    (\"Dienstag\", -1.6739764335716716),\n                                    (\"Mittwoch\", -2.0794415416798357)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> after\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"day (grain)Oktober\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"week (grain)September\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Global Youth Service-Tag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karsamstag\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)Juli\", -1.252762968495368),\n                                    (\"ordinal (digits)Mai\", -1.9459101490553135),\n                                    (\"ordinal (digits)April\", -1.9459101490553135),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Samstag\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Schmini Azeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.540445040947149),\n                                    (\"time-of-day (latent)\", -1.540445040947149),\n                                    (\"hour\", -0.9343092373768334)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -2.3025850929940455),\n                                    (\"intersect\", -2.3025850929940455),\n                                    (\"Weihnachten\", -1.8971199848858813),\n                                    (\"day\", -1.6094379124341003),\n                                    (\"time-of-day (latent)\", -2.3025850929940455),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.8971199848858813),\n                                    (\"minute\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dezember\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ostersonntag\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Gro\\223e Fastenzeit\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Juli\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7731898882334817),\n                                    (\"at <time-of-day>integer (numeric)\", -1.8718021769015913),\n                                    (\"<time-of-day>  o'clockinteger (numeric)\",\n                                     -0.9555114450274363)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Aschermittwoch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus-Samstag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Montag\", -1.9459101490553135), (\"day\", -1.252762968495368),\n                                    (\"hour\", -1.9459101490553135), (\"sommer\", -1.9459101490553135),\n                                    (\"winter\", -1.9459101490553135),\n                                    (\"week-end\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 2823}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EL_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> <time>'s'\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.128465251817791),\n                                    (\"week (grain)intersect by 'of', 'from', 's\",\n                                     -2.833213344056216),\n                                    (\"day (grain)intersect\", -2.4277482359480516),\n                                    (\"weekmonth\", -2.1400661634962708),\n                                    (\"day (grain)intersect by 'of', 'from', 's\",\n                                     -2.4277482359480516),\n                                    (\"week (grain)intersect\", -2.833213344056216),\n                                    (\"day (grain)absorption of article before time\",\n                                     -1.580450375560848),\n                                    (\"week (grain)September\", -2.833213344056216)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.8971199848858813),\n                                    (\"absorption of article before time\", -1.8971199848858813),\n                                    (\"<time-of-day> am|pm\", -2.3025850929940455),\n                                    (\"hh:mm\", -1.8971199848858813), (\"hour\", -1.2039728043259361),\n                                    (\"minute\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (1st..12th, 20th, 30th..90th)\",\n        Classifier{okData =\n                     ClassData{prior = -0.9480394301887354,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -0.4902063365632549,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5945320530416505, unseen = -5.293304824724492,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 197},\n                   koData =\n                     ClassData{prior = -0.8025619665458121,\n                               unseen = -5.0875963352323845,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 160}}),\n       (\"<integer> and a half <grain>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"integer (numeric)hour (grain)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.252762968495368),\n                                    (\"<integer> <unit-of-duration>\", -1.252762968495368)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.3513752571634776), (\"year\", -2.3513752571634776),\n                                    (\"<integer> <unit-of-duration>\", -1.0986122886681098),\n                                    (\"quarter of an hour\", -1.9459101490553135),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 8}}),\n       (\"Father's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"thursday\",\n        Classifier{okData =\n                     ClassData{prior = -0.12783337150988489,\n                               unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -2.120263536200091, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"few\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fall\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (ordinal or number)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.0986122886681098),\n                                    (\"Julyinteger (numeric)\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of article before timeinteger (numeric)\",\n                                     -1.3862943611198906),\n                                    (\"Aprilinteger (numeric)\", -1.3862943611198906),\n                                    (\"month\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"<time-of-day> approximately\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"<time-of-day> am|pm\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24214005200486485,\n                               unseen = -5.147494476813453,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)absorption of article before time\",\n                                     -2.8390784635086144),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)absorption of article before time\",\n                                     -4.04305126783455),\n                                    (\"ordinal (digits)October\", -4.04305126783455),\n                                    (\"integer (numeric)September\", -2.9444389791664407),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)September\",\n                                     -3.5322256440685593),\n                                    (\"integer (numeric)December\", -4.448516375942715),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)May\",\n                                     -4.448516375942715),\n                                    (\"number (0..19, 20, 30..90)April\", -4.448516375942715),\n                                    (\"ordinal (digits)August\", -4.448516375942715),\n                                    (\"number (0..19, 20, 30..90)March\", -4.448516375942715),\n                                    (\"ordinal (digits)February\", -3.5322256440685593),\n                                    (\"integer (numeric)April\", -3.5322256440685593),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)April\",\n                                     -3.7553691953827695),\n                                    (\"integer (numeric)August\", -3.7553691953827695),\n                                    (\"integer (numeric)February\", -2.743768283704289),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)February\",\n                                     -4.448516375942715),\n                                    (\"month\", -0.8375984632984902),\n                                    (\"ordinal (digits)March\", -4.04305126783455),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)October\",\n                                     -3.5322256440685593),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)January\",\n                                     -4.448516375942715),\n                                    (\"integer (numeric)July\", -3.5322256440685593),\n                                    (\"integer (numeric)March\", -4.04305126783455),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)March\",\n                                     -3.349904087274605)],\n                               n = 73},\n                   koData =\n                     ClassData{prior = -1.536867219599265, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)absorption of article before time\",\n                                     -2.382627800667582),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)absorption of article before time\",\n                                     -2.5649493574615367),\n                                    (\"ordinal (digits)October\", -3.481240089335692),\n                                    (\"ordinal (digits)July\", -3.481240089335692),\n                                    (\"integer (numeric)September\", -3.0757749812275272),\n                                    (\"ordinal (digits)August\", -3.0757749812275272),\n                                    (\"ordinal (digits)April\", -3.481240089335692),\n                                    (\"month\", -1.129864832172214),\n                                    (\"integer (numeric)July\", -2.5649493574615367)],\n                               n = 20}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -9.038406146826906e-2,\n                               unseen = -5.231108616854587,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.134704220354885),\n                                    (\"time-of-day (latent)absorption of article before time\",\n                                     -3.4339872044851463),\n                                    (\"<time-of-day>  o'clockabsorption of article before time\",\n                                     -4.532599493153256),\n                                    (\"mondayearly morning\", -4.532599493153256),\n                                    (\"tomorrowafternoon\", -4.532599493153256),\n                                    (\"absorption of article before timeabsorption of article before time\",\n                                     -3.6163087612791007),\n                                    (\"yesterdayabsorption of article before time\",\n                                     -4.532599493153256),\n                                    (\"hourhour\", -1.44155703979494),\n                                    (\"<time-of-day>  o'clockin|during the <part-of-day>\",\n                                     -4.532599493153256),\n                                    (\"todayin|during the <part-of-day>\", -4.532599493153256),\n                                    (\"until <time-of-day>morning\", -4.532599493153256),\n                                    (\"minutehour\", -2.8278514009148306),\n                                    (\"tonightin|during the <part-of-day>\", -4.532599493153256),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.6163087612791007),\n                                    (\"intersectafternoon\", -4.127134385045092),\n                                    (\"tomorrowevening\", -4.532599493153256),\n                                    (\"absorption of article before timein|during the <part-of-day>\",\n                                     -3.6163087612791007),\n                                    (\"time-of-day (latent)morning\", -4.532599493153256),\n                                    (\"yesterdayin|during the <part-of-day>\", -4.532599493153256),\n                                    (\"intersectin|during the <part-of-day>\", -3.2798365246578878),\n                                    (\"tonightabsorption of article before time\",\n                                     -4.532599493153256),\n                                    (\"todayabsorption of article before time\", -4.532599493153256),\n                                    (\"at <time-of-day>absorption of article before time\",\n                                     -3.6163087612791007),\n                                    (\"hh:mmabsorption of article before time\", -3.8394523125933104),\n                                    (\"intersectabsorption of article before time\",\n                                     -3.2798365246578878),\n                                    (\"tomorrowin|during the <part-of-day>\", -3.4339872044851463),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.8394523125933104),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.4339872044851463),\n                                    (\"mondaymorning\", -4.127134385045092),\n                                    (\"absorption of article before timemorning\",\n                                     -4.532599493153256),\n                                    (\"todaymorning\", -4.532599493153256),\n                                    (\"<day-of-month> (ordinal or number) <named-month>morning\",\n                                     -4.532599493153256),\n                                    (\"tomorrowabsorption of article before time\",\n                                     -3.4339872044851463)],\n                               n = 74},\n                   koData =\n                     ClassData{prior = -2.4485390056171257, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.8526314299133175),\n                                    (\"time-of-day (latent)absorption of article before time\",\n                                     -2.8526314299133175),\n                                    (\"monthhour\", -3.258096538021482),\n                                    (\"year (latent)absorption of article before time\",\n                                     -3.258096538021482),\n                                    (\"hourhour\", -2.341805806147327),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"Februarymorning\", -3.258096538021482),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.8526314299133175)],\n                               n = 7}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -3.1354942159291497,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -4.445176257083381e-2,\n                               unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -9.716374845364774e-2,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half after|past <integer> (hour-of-day)\", -3.960813169597578),\n                                    (\"<time-of-day> am|pm (verbose)\", -3.5553480614894135),\n                                    (\"time-of-day (latent)\", -1.3581234841531944),\n                                    (\"<time-of-day> am|pm\", -1.8207470061013074),\n                                    (\"hh:mm\", -3.044522437723423), (\"hour\", -0.916290731874155),\n                                    (\"minute\", -2.456735772821304)],\n                               n = 49},\n                   koData =\n                     ClassData{prior = -2.379546134130174, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.041453874828161),\n                                    (\"hour\", -1.041453874828161)],\n                               n = 5}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -2.772588722239781),\n                                    (\"saturday\", -2.772588722239781),\n                                    (\"absorption of article before time\", -2.367123614131617),\n                                    (\"monday\", -2.367123614131617), (\"friday\", -2.0794415416798357),\n                                    (\"day\", -0.9007865453381898), (\"sunday\", -2.772588722239781),\n                                    (\"tuesday\", -2.367123614131617)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"revolution day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9459101490553135),\n                                    (\"minuteminute\", -1.9459101490553135),\n                                    (\"hh:mmhh:mm\", -1.9459101490553135),\n                                    (\"hourminute\", -1.9459101490553135),\n                                    (\"minutehour\", -1.9459101490553135),\n                                    (\"time-of-day (latent)hh:mm\", -1.9459101490553135)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.6094379124341003),\n                                    (\"hourhour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.6931471805599453),\n                                    (\"hh:mmhh:mm\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..19, 20, 30..90)\",\n        Classifier{okData =\n                     ClassData{prior = -0.11441035117774422,\n                               unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -2.2246235515243336, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"hh(:mm) - <time-of-day> am|pm (verbose)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day>  o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"November\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5260930958967791, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.8938178760220964,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"in <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -1.5040773967762742),\n                                    (\"daysecond\", -1.0986122886681098),\n                                    (\"<integer> <unit-of-duration>now\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1st..12th, 20th, 30th..90th)quarter (grain)\",\n                                     -1.0986122886681098),\n                                    (\"ordinal (digits)quarter (grain)\", -1.5040773967762742),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.4019501660007199, unseen = -6.859614903654202,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tuesdaySeptember\", -5.249127122357264),\n                                    (\"Father's Dayabsorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"last <cycle> <time>'s'absorption of article before time\",\n                                     -5.472270673671475),\n                                    (\"hourday\", -4.293615677329829),\n                                    (\"dayhour\", -2.3587553644611003),\n                                    (\"daymonth\", -3.8140425970679424),\n                                    (\"monthyear\", -3.7675225814330493),\n                                    (\"<time-of-day> am|pmabsorption of article before time\",\n                                     -4.02535169073515),\n                                    (\"tuesdaythis <cycle>\", -6.16541785423142),\n                                    (\"last <day-of-week> of <time>absorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"wednesdayintersect\", -5.06680556556331),\n                                    (\"absorption of article before timeabsorption of , after named day\",\n                                     -6.16541785423142),\n                                    (\"houryear\", -6.16541785423142),\n                                    (\"absorption of article before timeat <time-of-day>\",\n                                     -5.472270673671475),\n                                    (\"absorption of article before time<day-of-month> (ordinal or number) <named-month>\",\n                                     -5.249127122357264),\n                                    (\"absorption of article before time<time> <part-of-day>\",\n                                     -5.472270673671475),\n                                    (\"Octoberabsorption of article before time\",\n                                     -5.472270673671475),\n                                    (\"intersect<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.293615677329829),\n                                    (\"intersect by 'of', 'from', 'syear\", -6.16541785423142),\n                                    (\"<time-of-day> am|pmintersect\", -4.661340457455146),\n                                    (\"intersectat <time-of-day>\", -5.759952746123256),\n                                    (\"thursday<day-of-month> ( ordinal) <named-month> year\",\n                                     -6.16541785423142),\n                                    (\"saturday<time-of-day> am|pm\", -5.759952746123256),\n                                    (\"saturdayat <time-of-day>\", -5.759952746123256),\n                                    (\"after tomorrowat <time-of-day>\", -6.16541785423142),\n                                    (\"intersect<time-of-day> am|pm\", -6.16541785423142),\n                                    (\"<part-of-day> of <time>February\", -6.16541785423142),\n                                    (\"absorption of article before timeOctober\",\n                                     -5.759952746123256),\n                                    (\"<time-of-day>  o'clockabsorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"after tomorrow<time-of-day> am|pm\", -5.759952746123256),\n                                    (\"wednesdayabsorption of article before time\",\n                                     -4.661340457455146),\n                                    (\"Marchabsorption of article before time\", -6.16541785423142),\n                                    (\"wednesdayat <time-of-day>\", -5.759952746123256),\n                                    (\"intersect by ','<time-of-day> am|pm\", -5.249127122357264),\n                                    (\"thursdayhh(:mm) - <time-of-day> am|pm\", -6.16541785423142),\n                                    (\"<time-of-day> am|pmintersect by ','\", -5.249127122357264),\n                                    (\"absorption of article before timeLast year\",\n                                     -5.759952746123256),\n                                    (\"absorption of article before timeintersect\",\n                                     -5.249127122357264),\n                                    (\"wednesday<time> <part-of-day>\", -5.249127122357264),\n                                    (\"hourmonth\", -6.16541785423142),\n                                    (\"todayat <time-of-day>\", -6.16541785423142),\n                                    (\"absorption of article before timeabsorption of article before time\",\n                                     -3.5627281687870362),\n                                    (\"thursday<time> timezone\", -4.912654885736052),\n                                    (\"yesterdayabsorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"dayday\", -3.6004684967698832),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -5.759952746123256),\n                                    (\"tonightat <time-of-day>\", -5.759952746123256),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.249127122357264),\n                                    (\"today<time-of-day> am|pm\", -5.759952746123256),\n                                    (\"at <time-of-day><time> <part-of-day>\", -5.472270673671475),\n                                    (\"absorption of , after named day<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.219507705176107),\n                                    (\"hourhour\", -2.851231849558894),\n                                    (\"<time-of-day> - <time-of-day> (interval)absorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"halloween dayabsorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"<datetime> - <datetime> (interval)absorption of article before time\",\n                                     -5.759952746123256),\n                                    (\"dayyear\", -2.9465420293632194),\n                                    (\"thursday<day-of-month> (ordinal or number) <named-month>\",\n                                     -6.16541785423142),\n                                    (\"last weekend of <named-month>year\", -6.16541785423142),\n                                    (\"<time-of-day>  o'clockin|during the <part-of-day>\",\n                                     -6.16541785423142),\n                                    (\"thursdaybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.759952746123256),\n                                    (\"tuesdayabsorption of article before time\",\n                                     -4.661340457455146),\n                                    (\"thursdaybetween <datetime> and <datetime> (interval)\",\n                                     -6.16541785423142),\n                                    (\"wednesday<time-of-day> am|pm (verbose)\", -5.759952746123256),\n                                    (\"before yesterday<time-of-day> am|pm\", -5.759952746123256),\n                                    (\"wednesdaythis <cycle>\", -6.16541785423142),\n                                    (\"todayin|during the <part-of-day>\", -6.16541785423142),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.249127122357264),\n                                    (\"thursdayhh:mm\", -6.16541785423142),\n                                    (\"minutehour\", -4.460669761992995),\n                                    (\"before yesterdayat <time-of-day>\", -5.759952746123256),\n                                    (\"tonightin|during the <part-of-day>\", -6.16541785423142),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.249127122357264),\n                                    (\"thursdayintersect\", -6.16541785423142),\n                                    (\"thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.249127122357264),\n                                    (\"Aprilyear\", -5.759952746123256),\n                                    (\"absorption of article before timetomorrow\",\n                                     -5.472270673671475),\n                                    (\"absorption of article before timehh(:mm) - <time-of-day> am|pm\",\n                                     -6.16541785423142),\n                                    (\"absorption of article before timein|during the <part-of-day>\",\n                                     -5.249127122357264),\n                                    (\"yesterdayin|during the <part-of-day>\", -6.16541785423142),\n                                    (\"before yesterdayabsorption of article before time\",\n                                     -5.759952746123256),\n                                    (\"this <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.16541785423142),\n                                    (\"tuesday<time> <part-of-day>\", -5.249127122357264),\n                                    (\"absorption of article before timeFebruary\",\n                                     -5.759952746123256),\n                                    (\"weekmonth\", -5.249127122357264),\n                                    (\"tuesdayat <time-of-day>\", -5.759952746123256),\n                                    (\"mondaythis <cycle>\", -6.16541785423142),\n                                    (\"tomorrowintersect\", -5.249127122357264),\n                                    (\"intersectin|during the <part-of-day>\", -4.912654885736052),\n                                    (\"<time> <part-of-day>absorption of article before time\",\n                                     -5.759952746123256),\n                                    (\"the <cycle> of <time>October\", -5.759952746123256),\n                                    (\"revolution dayabsorption of article before time\",\n                                     -5.759952746123256),\n                                    (\"thursday<datetime> - <datetime> (interval)\",\n                                     -6.16541785423142),\n                                    (\"Septemberabsorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"absorption of article before time<time-of-day> am|pm\",\n                                     -5.759952746123256),\n                                    (\"tonightabsorption of article before time\",\n                                     -5.472270673671475),\n                                    (\"todayabsorption of article before time\", -5.759952746123256),\n                                    (\"at <time-of-day>absorption of article before time\",\n                                     -4.661340457455146),\n                                    (\"thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -5.759952746123256),\n                                    (\"absorption of article before timeyear\", -6.16541785423142),\n                                    (\"tuesday<time-of-day> am|pm (verbose)\", -5.759952746123256),\n                                    (\"revolution dayLast year\", -5.759952746123256),\n                                    (\"at <time-of-day>intersect\", -5.249127122357264),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.16541785423142),\n                                    (\"absorption of article before timeintersect by ','\",\n                                     -6.16541785423142),\n                                    (\"dayminute\", -3.8140425970679424),\n                                    (\"intersectyear\", -5.06680556556331),\n                                    (\"hh:mmabsorption of article before time\", -5.472270673671475),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.16541785423142),\n                                    (\"minuteday\", -2.684177764895728),\n                                    (\"absorption of , after named dayintersect\", -6.16541785423142),\n                                    (\"the <cycle> of <time>absorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"<ordinal> <cycle> of <time>absorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"at <time-of-day>intersect by ','\", -6.16541785423142),\n                                    (\"Octoberyear\", -4.912654885736052),\n                                    (\"absorption of , after named dayintersect by ','\",\n                                     -5.759952746123256),\n                                    (\"this <cycle>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.16541785423142),\n                                    (\"intersectabsorption of article before time\",\n                                     -4.55597994179732),\n                                    (\"after tomorrowabsorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"saturdayabsorption of article before time\",\n                                     -5.759952746123256),\n                                    (\"tuesdaythe <day-of-month> (non ordinal)\", -6.16541785423142),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.16541785423142),\n                                    (\"tomorrowin|during the <part-of-day>\", -5.06680556556331),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year\",\n                                     -3.914126055624925),\n                                    (\"year<time-of-day> am|pm\", -6.16541785423142),\n                                    (\"Septemberyear\", -5.249127122357264),\n                                    (\"christmasabsorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"dayweek\", -5.06680556556331),\n                                    (\"weekyear\", -5.249127122357264),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.472270673671475),\n                                    (\"the <day-of-month> (non ordinal)absorption of article before time\",\n                                     -5.759952746123256),\n                                    (\"tomorrowat <time-of-day>\", -6.16541785423142),\n                                    (\"tuesdayintersect\", -4.55597994179732),\n                                    (\"tomorrowbetween <time-of-day> and <time-of-day> (interval)\",\n                                     -6.16541785423142),\n                                    (\"at <time-of-day>tomorrow\", -5.472270673671475),\n                                    (\"tomorrow<time-of-day> am|pm\", -5.759952746123256),\n                                    (\"last <cycle> of <time>absorption of article before time\",\n                                     -5.759952746123256),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.16541785423142),\n                                    (\"in|during the <part-of-day>absorption of article before time\",\n                                     -6.16541785423142),\n                                    (\"intersectFebruary\", -6.16541785423142),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.16541785423142),\n                                    (\"tomorrowabsorption of article before time\",\n                                     -4.912654885736052),\n                                    (\"yearminute\", -6.16541785423142),\n                                    (\"Mother's Dayabsorption of article before time\",\n                                     -6.16541785423142)],\n                               n = 380},\n                   koData =\n                     ClassData{prior = -1.1056794558912022, unseen = -6.343880434126331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -5.648974238161206),\n                                    (\"thursdayabsorption of article before time\",\n                                     -5.243509130053042),\n                                    (\"dayhour\", -3.56953269648137), (\"daymonth\", -2.55793178480289),\n                                    (\"hourquarter\", -5.648974238161206),\n                                    (\"absorption of article before timedd/mm\", -5.648974238161206),\n                                    (\"monthyear\", -3.297598980997728),\n                                    (\"absorption of article before timeDecember\",\n                                     -5.648974238161206),\n                                    (\"tuesdayFebruary\", -5.648974238161206),\n                                    (\"wednesdayintersect\", -5.648974238161206),\n                                    (\"intersecthh:mm\", -5.648974238161206),\n                                    (\"hh:mmuntil <time>\", -4.955827057601261),\n                                    (\"houryear\", -5.243509130053042),\n                                    (\"hournograin\", -4.396211269665838),\n                                    (\"intersect by 'of', 'from', 'syear\", -4.732683506287051),\n                                    (\"absorption of article before timeJuly\", -5.243509130053042),\n                                    (\"thursdayafter <time-of-day>\", -4.550361949493096),\n                                    (\"Marchyear\", -4.144896841384932),\n                                    (\"after tomorrowat <time-of-day>\", -5.648974238161206),\n                                    (\"absorption of article before timeOctober\",\n                                     -5.243509130053042),\n                                    (\"<time-of-day> am|pmuntil <time>\", -5.243509130053042),\n                                    (\"wednesdayabsorption of article before time\",\n                                     -5.243509130053042),\n                                    (\"intersect by ','<time-of-day> am|pm\", -5.648974238161206),\n                                    (\"absorption of article before timethe <cycle> of <time>\",\n                                     -5.648974238161206),\n                                    (\"intersect by 'of', 'from', 'sabsorption of article before time\",\n                                     -5.648974238161206),\n                                    (\"intersect by ','hh:mm\", -4.550361949493096),\n                                    (\"mondayabsorption of article before time\", -5.648974238161206),\n                                    (\"hourmonth\", -3.2510789653628356),\n                                    (\"todayat <time-of-day>\", -5.648974238161206),\n                                    (\"absorption of article before timeabsorption of article before time\",\n                                     -3.703064089105893),\n                                    (\"dayday\", -3.3463891451671604),\n                                    (\"dayquarter\", -5.648974238161206),\n                                    (\"<time-of-day> - <time-of-day> (interval)absorption of article before time\",\n                                     -5.648974238161206),\n                                    (\"thursdayat <time-of-day>\", -5.243509130053042),\n                                    (\"week-endintersect\", -5.648974238161206),\n                                    (\"<datetime> - <datetime> (interval)absorption of article before time\",\n                                     -5.243509130053042),\n                                    (\"dayyear\", -3.1232455938529506),\n                                    (\"thursdaydd/mm\", -5.648974238161206),\n                                    (\"tuesdayabsorption of article before time\",\n                                     -4.955827057601261),\n                                    (\"tuesdayintersect by 'of', 'from', 's\", -5.243509130053042),\n                                    (\"monthminute\", -5.243509130053042),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.648974238161206),\n                                    (\"tuesdayMarch\", -4.732683506287051),\n                                    (\"thursdayhh:mm\", -5.243509130053042),\n                                    (\"after <time-of-day>December\", -5.648974238161206),\n                                    (\"for <duration> from <time>December\", -5.648974238161206),\n                                    (\"thursdayintersect\", -5.243509130053042),\n                                    (\"Aprilyear\", -4.550361949493096),\n                                    (\"sundayintersect by 'of', 'from', 's\", -5.648974238161206),\n                                    (\"tuesdayJanuary\", -5.648974238161206),\n                                    (\"absorption of article before timehh(:mm) - <time-of-day> am|pm\",\n                                     -5.648974238161206),\n                                    (\"tuesdayOctober\", -5.243509130053042),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>year\",\n                                     -4.955827057601261),\n                                    (\"absorption of article before timeFebruary\",\n                                     -5.243509130053042),\n                                    (\"tuesday<day-of-month> (ordinal or number) <named-month>\",\n                                     -5.648974238161206),\n                                    (\"weekmonth\", -4.732683506287051),\n                                    (\"minutenograin\", -4.955827057601261),\n                                    (\"sundayabsorption of article before time\", -4.955827057601261),\n                                    (\"todayabsorption of article before time\", -5.648974238161206),\n                                    (\"absorption of article before timeyear\", -4.550361949493096),\n                                    (\"dayminute\", -4.039536325727106),\n                                    (\"intersectyear\", -3.857214768933151),\n                                    (\"hh:mmabsorption of article before time\", -5.243509130053042),\n                                    (\"thursdayApril\", -5.648974238161206),\n                                    (\"minuteday\", -4.732683506287051),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.648974238161206),\n                                    (\"the <cycle> of <time>absorption of article before time\",\n                                     -4.955827057601261),\n                                    (\"tuesdayApril\", -5.243509130053042),\n                                    (\"Octoberyear\", -5.648974238161206),\n                                    (\"absorption of , after named dayintersect by ','\",\n                                     -5.648974238161206),\n                                    (\"yearhh:mm\", -5.648974238161206),\n                                    (\"this <cycle>hh(:mm) - <time-of-day> am|pm\",\n                                     -5.648974238161206),\n                                    (\"intersectabsorption of article before time\",\n                                     -4.550361949493096),\n                                    (\"tuesday<day-of-month> (ordinal or number) of <named-month>\",\n                                     -5.648974238161206),\n                                    (\"after tomorrowabsorption of article before time\",\n                                     -5.648974238161206),\n                                    (\"absorption of article before timeuntil <time>\",\n                                     -4.2626798770413155),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year\",\n                                     -4.955827057601261),\n                                    (\"<duration> after <time>December\", -5.648974238161206),\n                                    (\"intersectintersect\", -5.648974238161206),\n                                    (\"tuesdaytuesday\", -5.648974238161206),\n                                    (\"the <day-of-month> (non ordinal)absorption of article before time\",\n                                     -3.944226145922781),\n                                    (\"at <time-of-day>February\", -5.648974238161206),\n                                    (\"week-endabsorption of article before time\",\n                                     -4.732683506287051),\n                                    (\"thursdayOctober\", -5.243509130053042),\n                                    (\"tomorrowat <time-of-day>\", -5.648974238161206),\n                                    (\"tuesdayintersect\", -3.857214768933151),\n                                    (\"daynograin\", -3.7771720612596145),\n                                    (\"tomorrowbetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.648974238161206),\n                                    (\"tuesdayMay\", -5.648974238161206),\n                                    (\"after <time-of-day>absorption of article before time\",\n                                     -5.648974238161206),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -5.243509130053042),\n                                    (\"sundayintersect\", -5.648974238161206),\n                                    (\"thursdayintersect by 'of', 'from', 's\", -5.648974238161206),\n                                    (\"tomorrowabsorption of article before time\",\n                                     -5.648974238161206),\n                                    (\"yearminute\", -5.648974238161206)],\n                               n = 188}}),\n       (\"quarter to|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrownight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.791759469228055),\n                                    (\"absorption of article before time\", -1.791759469228055),\n                                    (\"time-of-day (latent)\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.740840023925201),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)week (grain)intersect by 'of', 'from', 's\",\n                                     -2.740840023925201),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)day (grain)absorption of article before time\",\n                                     -2.740840023925201),\n                                    (\"ordinal (digits)quarter (grain)absorption of article before time\",\n                                     -2.3353749158170367),\n                                    (\"quarteryear\", -2.0476928433652555),\n                                    (\"weekmonth\", -1.6422277352570913),\n                                    (\"ordinal (digits)quarter (grain)year\", -2.740840023925201),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)week (grain)intersect\",\n                                     -2.740840023925201),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)week (grain)absorption of article before time\",\n                                     -2.0476928433652555)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)hour (grain)absorption of article before time\",\n                                     -2.2512917986064953),\n                                    (\"ordinal (digits)hour (grain)morning\", -2.2512917986064953),\n                                    (\"ordinal (digits)hour (grain)in|during the <part-of-day>\",\n                                     -2.2512917986064953),\n                                    (\"hourhour\", -1.55814461804655)],\n                               n = 3}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.0986122886681098),\n                                    (\"hh:mmhh:mm\", -1.0986122886681098),\n                                    (\"hourhour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"month (grain)\", -2.0794415416798357),\n                                    (\"year (grain)\", -2.0794415416798357),\n                                    (\"week (grain)\", -1.791759469228055),\n                                    (\"quarter\", -2.4849066497880004), (\"year\", -2.0794415416798357),\n                                    (\"month\", -2.0794415416798357),\n                                    (\"quarter (grain)\", -2.4849066497880004)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -2.917770732084279),\n                                    (\"week (grain)intersect by 'of', 'from', 's\",\n                                     -2.917770732084279),\n                                    (\"week (grain)<day-of-month> (ordinal)\", -2.512305623976115),\n                                    (\"weekmonth\", -2.2246235515243336),\n                                    (\"week (grain)October\", -2.917770732084279),\n                                    (\"day (grain)valentine's day\", -2.917770732084279),\n                                    (\"weekday\", -1.6650077635889111),\n                                    (\"week (grain)intersect\", -2.917770732084279),\n                                    (\"week (grain)<day-of-month> (ordinal or number) <named-month>\",\n                                     -2.001480000210124)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.8109302162163288,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -2.3978952727983707),\n                                    (\"daymonth\", -1.8870696490323797),\n                                    (\"day (grain)intersect\", -2.803360380906535),\n                                    (\"quarteryear\", -2.3978952727983707),\n                                    (\"week (grain)time-of-day (latent)\", -2.3978952727983707),\n                                    (\"weekhour\", -2.3978952727983707),\n                                    (\"day (grain)intersect by 'of', 'from', 's\",\n                                     -2.803360380906535),\n                                    (\"quarter (grain)year\", -2.3978952727983707)],\n                               n = 8}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -1.252762968495368),\n                                    (\"monday\", -1.252762968495368), (\"day\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"absorption of article before time\",\n        Classifier{okData =\n                     ClassData{prior = -0.23005964301258283, unseen = -6.54965074223381,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -5.855071922202427),\n                                    (\"last <cycle> <time>'s'\", -3.909161773147114),\n                                    (\"week\", -3.657847344866208),\n                                    (\"Father's Day\", -5.449606814094262),\n                                    (\"thursday\", -5.449606814094262), (\"fall\", -5.449606814094262),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.468777561082536),\n                                    (\"<time> <part-of-day>\", -4.2456340097683265),\n                                    (\"absorption of , after named day\", -5.449606814094262),\n                                    (\"revolution day\", -4.756459633534318),\n                                    (\"October\", -4.150323829964002),\n                                    (\"wednesday\", -5.855071922202427), (\"July\", -5.449606814094262),\n                                    (\"<ordinal> quarter\", -5.855071922202427),\n                                    (\"saturday\", -5.161924741642482),\n                                    (\"Last year\", -5.161924741642482),\n                                    (\"intersect\", -2.810549484479004),\n                                    (\"half after|past <integer> (hour-of-day)\", -5.855071922202427),\n                                    (\"<ordinal> <cycle> of <time>\", -5.855071922202427),\n                                    (\"next <cycle>\", -4.468777561082536),\n                                    (\"the <cycle> of <time>\", -4.602308953707059),\n                                    (\"<ordinal> quarter <year>\", -5.855071922202427),\n                                    (\"second\", -4.938781190328272), (\"monday\", -5.449606814094262),\n                                    (\"valentine's day\", -5.449606814094262),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>\",\n                                     -5.855071922202427),\n                                    (\"this|last|next <cycle>\", -4.2456340097683265),\n                                    (\"Mother's Day\", -5.449606814094262),\n                                    (\"friday\", -5.449606814094262),\n                                    (\"<time-of-day> am|pm (verbose)\", -5.161924741642482),\n                                    (\"<time> after next\", -5.855071922202427),\n                                    (\"day\", -1.8847800086503053),\n                                    (\"next <day-of-week>\", -4.938781190328272),\n                                    (\"afternoon\", -4.150323829964002),\n                                    (\"February\", -4.938781190328272),\n                                    (\"quarter\", -4.756459633534318),\n                                    (\"this <cycle>\", -5.855071922202427),\n                                    (\"sunday\", -5.855071922202427),\n                                    (\"time-of-day (latent)\", -2.9647001643062625),\n                                    (\"year\", -3.5524868292083815),\n                                    (\"<time-of-day> am|pm\", -3.457176649404057),\n                                    (\"<duration> after <time>\", -5.161924741642482),\n                                    (\"hh:mm\", -4.756459633534318),\n                                    (\"intersect by ','\", -5.161924741642482),\n                                    (\"intersect by 'of', 'from', 's\", -3.909161773147114),\n                                    (\"last <time>\", -4.468777561082536),\n                                    (\"EOM|End of month\", -5.855071922202427),\n                                    (\"March\", -4.602308953707059),\n                                    (\"<day-of-month> (ordinal)\", -4.468777561082536),\n                                    (\"noon\", -5.449606814094262), (\"hour\", -1.9430489167742813),\n                                    (\"evening\", -4.468777561082536), (\"month\", -2.937301190118148),\n                                    (\"EOD|End of day\", -5.855071922202427),\n                                    (\"next <time>\", -4.756459633534318),\n                                    (\"christmas\", -5.449606814094262),\n                                    (\"next n <cycle>\", -4.602308953707059),\n                                    (\"tuesday\", -5.161924741642482),\n                                    (\"halloween day\", -5.855071922202427),\n                                    (\"winter\", -5.855071922202427),\n                                    (\"last n <cycle>\", -4.756459633534318),\n                                    (\"last <cycle> of <time>\", -4.602308953707059),\n                                    (\"minute\", -3.051711541295892),\n                                    (\"week-end\", -5.449606814094262),\n                                    (\"summer\", -5.855071922202427), (\"August\", -5.855071922202427)],\n                               n = 317},\n                   koData =\n                     ClassData{prior = -1.5822421696256104, unseen = -5.480638923341991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.6847040827034556),\n                                    (\"<duration> hence|ago\", -4.783316371371566),\n                                    (\"<named-month> <day-of-month> (ordinal or number)\",\n                                     -4.783316371371566),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.173878458937465),\n                                    (\"September\", -4.783316371371566),\n                                    (\"October\", -4.377851263263401),\n                                    (\"<ordinal> quarter\", -4.783316371371566),\n                                    (\"intersect\", -3.173878458937465),\n                                    (\"the <cycle> of <time>\", -3.8670256394974105),\n                                    (\"April\", -4.783316371371566),\n                                    (\"this|last|next <cycle>\", -4.783316371371566),\n                                    (\"day\", -2.2183670139100284), (\"afternoon\", -4.783316371371566),\n                                    (\"quarter\", -4.09016919081162),\n                                    (\"time-of-day (latent)\", -2.4319411142080876),\n                                    (\"hh:mm\", -4.783316371371566), (\"nograin\", -3.2792389745952915),\n                                    (\"until <time>\", -3.2792389745952915),\n                                    (\"intersect by 'of', 'from', 's\", -4.783316371371566),\n                                    (\"March\", -4.377851263263401),\n                                    (\"<day-of-month> (ordinal)\", -2.99155690214351),\n                                    (\"hour\", -2.385421098573195), (\"month\", -2.7038748296917294),\n                                    (\"last <cycle>\", -4.09016919081162),\n                                    (\"<datetime> - <datetime> (interval)\", -4.783316371371566),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -4.377851263263401),\n                                    (\"minute\", -3.6847040827034556),\n                                    (\"August\", -4.377851263263401)],\n                               n = 82}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)absorption of article before time\",\n                                     -1.0986122886681098),\n                                    (\"quarteryear\", -0.8109302162163288),\n                                    (\"ordinal (digits)quarter (grain)year\", -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.2809338454620642),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)tuesdayintersect\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)tuesdayOctober\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)wednesdayintersect\",\n                                     -1.791759469228055),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)the <cycle> of <time>year\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.252762968495368),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)wednesdayOctober\",\n                                     -1.540445040947149),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)tuesdaySeptember\",\n                                     -1.9459101490553135)],\n                               n = 3}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -0.8109302162163288),\n                                    (\"morning<day-of-month> (ordinal or number) <named-month>\",\n                                     -1.0986122886681098),\n                                    (\"morning<day-of-month> (ordinal)\", -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"valentine's day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -0.9808292530117262),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)March\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1st..12th, 20th, 30th..90th)September\",\n                                     -1.791759469228055),\n                                    (\"month\", -0.8754687373538999),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)October\",\n                                     -1.0986122886681098)],\n                               n = 4}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.213022639845854),\n                                    (\"hour\", -0.7205461547480597),\n                                    (\"evening\", -1.5314763709643884)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"new year's eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2076393647782445,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6376087894007967),\n                                    (\"month (grain)\", -2.1972245773362196),\n                                    (\"year (grain)\", -2.1972245773362196),\n                                    (\"week (grain)\", -1.6376087894007967),\n                                    (\"quarter\", -2.890371757896165), (\"year\", -2.1972245773362196),\n                                    (\"month\", -2.1972245773362196),\n                                    (\"quarter (grain)\", -2.890371757896165)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.6739764335716716, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.3862943611198906),\n                                    (\"day (grain)\", -1.3862943611198906)],\n                               n = 3}}),\n       (\"Mother's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"annunciation day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm (verbose)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.538973871058276),\n                                    (\"<time-of-day>  o'clock\", -2.538973871058276),\n                                    (\"absorption of article before time\", -2.2512917986064953),\n                                    (\"time-of-day (latent)\", -1.845826690498331),\n                                    (\"hh:mm\", -2.538973871058276),\n                                    (\"until <time-of-day>\", -2.9444389791664407),\n                                    (\"hour\", -0.9985288301111273), (\"minute\", -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -1.252762968495368)],\n                               n = 3}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"friday\", -1.2039728043259361), (\"day\", -1.2039728043259361),\n                                    (\"March\", -1.6094379124341003), (\"month\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative integer (minutes) to|till|before|after <integer> (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..19, 20, 30..90)absorption of article before time\",\n                                     -1.0986122886681098),\n                                    (\"number (0..19, 20, 30..90)<time-of-day> am|pm\",\n                                     -1.5040773967762742),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -1.6582280766035324),\n                                    (\"wednesday\", -2.3513752571634776),\n                                    (\"monday\", -2.3513752571634776), (\"day\", -0.8472978603872037),\n                                    (\"tuesday\", -1.6582280766035324)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of article before time\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"June\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>\", -0.9808292530117262),\n                                    (\"minute\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.9808292530117262),\n                                    (\"<integer> <unit-of-duration>\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511, unseen = -3.871201010907891,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2407096892759584),\n                                    (\"intersect\", -3.1570004211501135),\n                                    (\"year (grain)\", -2.751535313041949),\n                                    (\"absorption of article before time\", -1.547562508716013),\n                                    (\"week (grain)\", -2.2407096892759584),\n                                    (\"day\", -1.7707060600302227), (\"quarter\", -3.1570004211501135),\n                                    (\"year\", -2.751535313041949), (\"hour\", -2.2407096892759584),\n                                    (\"quarter (grain)\", -3.1570004211501135),\n                                    (\"summer\", -3.1570004211501135)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -1.7047480922384253, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.845826690498331),\n                                    (\"absorption of article before time\", -1.845826690498331),\n                                    (\"day\", -1.55814461804655), (\"hour\", -2.2512917986064953)],\n                               n = 4}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3025850929940455),\n                                    (\"absorption of article before time\", -1.455287232606842),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.70805020110221),\n                                    (\"day\", -1.791759469228055),\n                                    (\"time-of-day (latent)\", -2.70805020110221),\n                                    (\"<time-of-day> am|pm\", -2.70805020110221),\n                                    (\"hour\", -2.0149030205422647),\n                                    (\"hhmm (military)\", -2.70805020110221),\n                                    (\"minute\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -1.9459101490553135), (\"day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"hour\", -1.9459101490553135)],\n                               n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.43286408229627876, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -6.995858860691034e-2),\n                                    (\"number (0..19, 20, 30..90)\", -2.6946271807700692)],\n                               n = 72},\n                   koData =\n                     ClassData{prior = -1.0459685551826876,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -2.469261259037152e-2)],\n                               n = 39}}),\n       (\"three quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.11506932978478723,\n                               unseen = -3.7612001156935624,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -2.2192034840549946,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9555114450274363),\n                                    (\"sundayMarch\", -1.8718021769015913),\n                                    (\"sundayintersect by 'of', 'from', 's\", -1.8718021769015913),\n                                    (\"mondayMarch\", -1.8718021769015913),\n                                    (\"sundayintersect\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -4.74493212836325,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.538973871058276),\n                                    (\"number (0..19, 20, 30..90)day (grain)\", -3.349904087274605),\n                                    (\"number (0..19, 20, 30..90)year (grain)\", -3.349904087274605),\n                                    (\"integer (numeric)day (grain)\", -2.538973871058276),\n                                    (\"number (0..19, 20, 30..90)month (grain)\",\n                                     -3.6375861597263857),\n                                    (\"second\", -3.6375861597263857),\n                                    (\"number (0..19, 20, 30..90)hour (grain)\", -3.349904087274605),\n                                    (\"number (0..19, 20, 30..90)minute (grain)\",\n                                     -3.6375861597263857),\n                                    (\"integer (numeric)year (grain)\", -4.04305126783455),\n                                    (\"day\", -2.2512917986064953),\n                                    (\"number (0..19, 20, 30..90)week (grain)\", -2.9444389791664407),\n                                    (\"year\", -3.126760535960395),\n                                    (\"integer (numeric)week (grain)\", -3.349904087274605),\n                                    (\"hour\", -2.790288299339182),\n                                    (\"fewminute (grain)\", -4.04305126783455),\n                                    (\"month\", -3.6375861597263857),\n                                    (\"integer (numeric)minute (grain)\", -2.4336133554004498),\n                                    (\"number (0..19, 20, 30..90)second (grain) \",\n                                     -3.6375861597263857),\n                                    (\"fewhour (grain)\", -4.04305126783455),\n                                    (\"minute\", -2.171249090932959),\n                                    (\"integer (numeric)hour (grain)\", -3.6375861597263857)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -4.442651256490317,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.332204510175204),\n                                    (\"number (0..19, 20, 30..90)day (grain)\", -3.7376696182833684),\n                                    (\"integer (numeric)day (grain)\", -3.332204510175204),\n                                    (\"fewday (grain)\", -3.7376696182833684),\n                                    (\"second\", -2.8213788864092133),\n                                    (\"number (0..19, 20, 30..90)hour (grain)\", -3.7376696182833684),\n                                    (\"integer (numeric)second (grain) \", -3.044522437723423),\n                                    (\"number (0..19, 20, 30..90)minute (grain)\",\n                                     -3.332204510175204),\n                                    (\"integer (numeric)year (grain)\", -3.332204510175204),\n                                    (\"day\", -2.8213788864092133), (\"year\", -3.332204510175204),\n                                    (\"integer (numeric)week (grain)\", -3.332204510175204),\n                                    (\"hour\", -1.9459101490553135), (\"month\", -3.044522437723423),\n                                    (\"integer (numeric)minute (grain)\", -3.332204510175204),\n                                    (\"number (0..19, 20, 30..90)second (grain) \",\n                                     -3.7376696182833684),\n                                    (\"integer (numeric)month (grain)\", -3.044522437723423),\n                                    (\"minute\", -2.8213788864092133),\n                                    (\"integer (numeric)hour (grain)\", -2.032921526044943)],\n                               n = 30}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.1670540846631662, unseen = -5.365976015021851,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> approximately\", -4.66814498514948),\n                                    (\"at <time-of-day>\", -2.528078821653209),\n                                    (\"<time-of-day>  o'clock\", -4.66814498514948),\n                                    (\"quarter to|past <integer> (hour-of-day)\", -4.66814498514948),\n                                    (\"half after|past <integer> (hour-of-day)\",\n                                     -3.9749978045895347),\n                                    (\"absorption of article before time\", -2.2702497123511094),\n                                    (\"about <time-of-day>\", -4.66814498514948),\n                                    (\"time-of-day (latent)\", -1.864784604242945),\n                                    (\"<time-of-day> am|pm\", -4.66814498514948),\n                                    (\"hh:mm\", -2.4168531865429848), (\"hour\", -1.156599546318459),\n                                    (\"<integer>-and-half (hour-of-day)\", -4.2626798770413155),\n                                    (\"hhmm (military)\", -4.66814498514948),\n                                    (\"minute\", -1.8349316410932637),\n                                    (\"after <time-of-day>\", -4.66814498514948)],\n                               n = 99},\n                   koData =\n                     ClassData{prior = -1.8718021769015913, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.2237754316221157),\n                                    (\"hour\", -0.9873866535578852),\n                                    (\"after <time-of-day>\", -2.322387720290225)],\n                               n = 18}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.17185025692665928,\n                               unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>absorption of article before time\",\n                                     -1.8827312474337816),\n                                    (\"quarter of an hour<time-of-day> am|pm\", -3.1354942159291497),\n                                    (\"<integer> <unit-of-duration>today\", -3.1354942159291497),\n                                    (\"secondsecond\", -3.1354942159291497),\n                                    (\"minutehour\", -1.4307461236907244),\n                                    (\"daysecond\", -2.7300291078209855),\n                                    (\"quarter of an hourabsorption of article before time\",\n                                     -2.7300291078209855),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.7300291078209855),\n                                    (\"yearday\", -2.7300291078209855),\n                                    (\"minutesecond\", -3.1354942159291497),\n                                    (\"<integer> <unit-of-duration>now\", -2.2192034840549946)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -1.845826690498331, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8971199848858813),\n                                    (\"<integer> <unit-of-duration>absorption of article before time\",\n                                     -1.8971199848858813),\n                                    (\"<integer> <unit-of-duration>intersect\", -2.3025850929940455),\n                                    (\"dayday\", -2.3025850929940455)],\n                               n = 3}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -6.317890162153156e-2,\n                               unseen = -3.871201010907891,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 46},\n                   koData =\n                     ClassData{prior = -2.793208009442517, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<duration> before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>absorption of article before time\",\n                                     -1.252762968495368),\n                                    (\"minutehour\", -0.8472978603872037),\n                                    (\"quarter of an hourabsorption of article before time\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by ','\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -4.584967478670572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>tuesday\",\n                                     -3.8815637979434374),\n                                    (\"monday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.4760986898352733),\n                                    (\"<day-of-month> (ordinal or number) <named-month>monday\",\n                                     -3.8815637979434374),\n                                    (\"absorption of article before time<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.188416617383492),\n                                    (\"intersect<day-of-month> (ordinal or number) <named-month>\",\n                                     -2.62880082944807),\n                                    (\"saturday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8815637979434374),\n                                    (\"intersect by ','year\", -3.8815637979434374),\n                                    (\"wednesday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8815637979434374),\n                                    (\"dayday\", -1.684339220607218),\n                                    (\"dayyear\", -2.9652730660692823),\n                                    (\"tuesday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.188416617383492),\n                                    (\"fridayintersect\", -3.8815637979434374),\n                                    (\"intersect by ','intersect\", -3.8815637979434374),\n                                    (\"dayminute\", -2.782951509275328),\n                                    (\"<day-of-month> (ordinal or number) <named-month>intersect\",\n                                     -3.8815637979434374),\n                                    (\"intersectyear\", -3.8815637979434374),\n                                    (\"minuteday\", -2.495269436823547),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year\",\n                                     -3.4760986898352733),\n                                    (\"intersectintersect\", -3.8815637979434374),\n                                    (\"fridayintersect by ','\", -3.4760986898352733),\n                                    (\"sunday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8815637979434374),\n                                    (\"<named-month> <day-of-month> (ordinal or number)friday\",\n                                     -3.8815637979434374),\n                                    (\"friday<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.188416617383492)],\n                               n = 33},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -2.871679624884012),\n                                    (\"Februarytuesday\", -3.2771447329921766),\n                                    (\"monthyear\", -2.871679624884012),\n                                    (\"Julyintersect\", -2.871679624884012),\n                                    (\"monthminute\", -2.871679624884012),\n                                    (\"Aprilyear\", -3.2771447329921766),\n                                    (\"Februarymonday\", -3.2771447329921766),\n                                    (\"fridayintersect\", -3.2771447329921766),\n                                    (\"intersect by ','intersect\", -3.2771447329921766),\n                                    (\"dayminute\", -2.178532444324067),\n                                    (\"<day-of-month> (ordinal or number) <named-month>intersect\",\n                                     -3.2771447329921766),\n                                    (\"Julyyear\", -3.2771447329921766),\n                                    (\"intersectintersect\", -3.2771447329921766),\n                                    (\"fridayintersect by ','\", -3.2771447329921766)],\n                               n = 11}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.540445040947149, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of article before time\", -1.3437347467010947),\n                                    (\"day\", -2.4423470353692043),\n                                    (\"<time-of-day> am|pm\", -2.4423470353692043),\n                                    (\"hour\", -2.4423470353692043), (\"month\", -2.4423470353692043),\n                                    (\"minute\", -1.749199854809259)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.2411620568168881, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3978952727983707),\n                                    (\"absorption of article before time\", -1.927891643552635),\n                                    (\"the <day-of-month> (non ordinal)\", -3.3141860046725258),\n                                    (\"<time-of-day> am|pm (verbose)\", -3.3141860046725258),\n                                    (\"day\", -1.927891643552635),\n                                    (\"time-of-day (latent)\", -2.2155737160044158),\n                                    (\"<time-of-day> am|pm\", -2.908720896564361),\n                                    (\"hh:mm\", -2.908720896564361), (\"hour\", -1.3682758556172123),\n                                    (\"minute\", -2.908720896564361)],\n                               n = 22}}),\n       (\"before <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.550597412411167), (\"day\", -1.8870696490323797),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"<integer> <unit-of-duration>\", -0.7884573603642702),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by 'of', 'from', 's\",\n        Classifier{okData =\n                     ClassData{prior = -0.4321333551903257, unseen = -4.74493212836325,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"halloween dayyear\", -4.04305126783455),\n                                    (\"daymonth\", -3.126760535960395),\n                                    (\"monthyear\", -2.538973871058276),\n                                    (\"wednesdaynext <cycle>\", -4.04305126783455),\n                                    (\"christmasyear\", -4.04305126783455),\n                                    (\"wednesdayintersect\", -4.04305126783455),\n                                    (\"Marchyear\", -4.04305126783455),\n                                    (\"absorption of article before timeLast year\",\n                                     -3.6375861597263857),\n                                    (\"last <day-of-week> of <time>year\", -4.04305126783455),\n                                    (\"wednesdayOctober\", -4.04305126783455),\n                                    (\"dayyear\", -1.7404661748405046),\n                                    (\"wednesdaythis|last|next <cycle>\", -4.04305126783455),\n                                    (\"Mother's Dayyear\", -4.04305126783455),\n                                    (\"tuesdayOctober\", -4.04305126783455),\n                                    (\"absorption of article before timeyear\", -2.2512917986064953),\n                                    (\"revolution dayLast year\", -3.6375861597263857),\n                                    (\"the <cycle> of <time>year\", -4.04305126783455),\n                                    (\"<ordinal> <cycle> of <time>year\", -4.04305126783455),\n                                    (\"absorption of article before timeMarch\", -4.04305126783455),\n                                    (\"Octoberyear\", -3.349904087274605),\n                                    (\"Septemberyear\", -4.04305126783455),\n                                    (\"dayweek\", -3.6375861597263857),\n                                    (\"last <cycle> <time>'s'year\", -3.349904087274605),\n                                    (\"weekyear\", -3.126760535960395),\n                                    (\"last <cycle> of <time>year\", -3.6375861597263857)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -1.0473189942805592, unseen = -4.394449154672439,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tuesdaySeptember\", -3.6888794541139363),\n                                    (\"week-endJuly\", -3.6888794541139363),\n                                    (\"week-endOctober\", -3.283414346005772),\n                                    (\"daymonth\", -1.984131361875511),\n                                    (\"monthyear\", -3.6888794541139363),\n                                    (\"wednesdayintersect\", -3.6888794541139363),\n                                    (\"intersect by 'of', 'from', 'syear\", -3.6888794541139363),\n                                    (\"hourmonth\", -2.772588722239781),\n                                    (\"wednesdayOctober\", -3.6888794541139363),\n                                    (\"week-endintersect\", -3.6888794541139363),\n                                    (\"dayyear\", -2.5902671654458267),\n                                    (\"sundayMarch\", -3.6888794541139363),\n                                    (\"sundayintersect by 'of', 'from', 's\", -3.6888794541139363),\n                                    (\"absorption of article before timeyear\", -3.6888794541139363),\n                                    (\"the <cycle> of <time>year\", -3.6888794541139363),\n                                    (\"intersectyear\", -3.283414346005772),\n                                    (\"intersectSeptember\", -3.6888794541139363),\n                                    (\"mondayMarch\", -3.6888794541139363),\n                                    (\"intersectintersect\", -3.6888794541139363),\n                                    (\"tuesdayintersect\", -3.6888794541139363),\n                                    (\"sundayintersect\", -3.6888794541139363),\n                                    (\"after <time-of-day>year\", -3.6888794541139363)],\n                               n = 20}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Father's Day\", -2.772588722239781),\n                                    (\"thursday\", -2.772588722239781),\n                                    (\"revolution day\", -2.772588722239781),\n                                    (\"Mother's Day\", -2.772588722239781),\n                                    (\"day\", -1.3862943611198906), (\"sunday\", -2.367123614131617),\n                                    (\"hour\", -1.8562979903656263), (\"tuesday\", -2.772588722239781),\n                                    (\"week-end\", -1.8562979903656263)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monday\", -2.3025850929940455), (\"day\", -1.8971199848858813),\n                                    (\"sunday\", -2.3025850929940455), (\"hour\", -1.6094379124341003),\n                                    (\"week-end\", -1.6094379124341003)],\n                               n = 5}}),\n       (\"EOM|End of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1st..12th, 20th, 30th..90th)\", -1.3862943611198906),\n                                    (\"ordinal (digits)\", -0.2876820724517809)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.8109302162163288,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1st..12th, 20th, 30th..90th)\", -0.2231435513142097),\n                                    (\"ordinal (digits)\", -1.6094379124341003)],\n                               n = 8}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -1.9459101490553135),\n                                    (\"absorption of article before time\", -1.252762968495368),\n                                    (\"<time-of-day> am|pm (verbose)\", -1.9459101490553135),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of article before time\", -0.9808292530117262),\n                                    (\"hour\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"EOD|End of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -1.9459101490553135),\n                                    (\"wednesday\", -2.639057329615259),\n                                    (\"monday\", -2.639057329615259), (\"day\", -1.0296194171811581),\n                                    (\"March\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"tuesday\", -1.9459101490553135),\n                                    (\"halloween day\", -2.639057329615259)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"week (grain)\", -1.6094379124341003),\n                                    (\"day\", -1.2039728043259361),\n                                    (\"day (grain)\", -1.2039728043259361)],\n                               n = 3}}),\n       (\"<integer>-and-half (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"new year's day\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.995732273553991),\n                                    (\"number (0..19, 20, 30..90)day (grain)\", -2.995732273553991),\n                                    (\"fewday (grain)\", -2.995732273553991),\n                                    (\"second\", -2.5902671654458267),\n                                    (\"number (0..19, 20, 30..90)hour (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)second (grain) \", -2.995732273553991),\n                                    (\"number (0..19, 20, 30..90)minute (grain)\",\n                                     -2.995732273553991),\n                                    (\"integer (numeric)year (grain)\", -2.995732273553991),\n                                    (\"day\", -2.5902671654458267), (\"year\", -2.995732273553991),\n                                    (\"integer (numeric)week (grain)\", -2.995732273553991),\n                                    (\"hour\", -2.5902671654458267), (\"month\", -2.995732273553991),\n                                    (\"integer (numeric)minute (grain)\", -2.995732273553991),\n                                    (\"number (0..19, 20, 30..90)second (grain) \",\n                                     -2.995732273553991),\n                                    (\"integer (numeric)month (grain)\", -2.995732273553991),\n                                    (\"minute\", -2.5902671654458267),\n                                    (\"integer (numeric)hour (grain)\", -2.995732273553991)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tuesday\",\n        Classifier{okData =\n                     ClassData{prior = -0.5306282510621704,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.8873031950009028, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 22}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half a <grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"halloween day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of article before time\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -7.598590697792199e-2,\n                               unseen = -4.5217885770490405,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.817712325956905),\n                                    (\"<integer> and a half <grain>\", -3.817712325956905),\n                                    (\"<integer> more <unit-of-duration>\", -3.817712325956905),\n                                    (\"<integer> + '\\\"\", -3.1245651453969594),\n                                    (\"number.number hours\", -3.817712325956905),\n                                    (\"second\", -3.1245651453969594), (\"day\", -3.1245651453969594),\n                                    (\"half an hour\", -3.1245651453969594),\n                                    (\"three quarters of an hour\", -2.9014215940827497),\n                                    (\"<integer> <unit-of-duration>\", -1.5151272329628591),\n                                    (\"quarter of an hour\", -2.9014215940827497),\n                                    (\"hour\", -2.5649493574615367),\n                                    (\"about|exactly <duration>\", -3.817712325956905),\n                                    (\"half a <grain>\", -3.817712325956905),\n                                    (\"minute\", -1.252762968495368)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -2.6149597780361984,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3513752571634776), (\"day\", -1.9459101490553135),\n                                    (\"<integer> <unit-of-duration>\", -1.6582280766035324)],\n                               n = 3}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.067840630001356, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.0910424533583156),\n                                    (\"minuteminute\", -1.9924301646902063),\n                                    (\"absorption of article before timeabsorption of article before time\",\n                                     -3.0910424533583156),\n                                    (\"hh:mmhh:mm\", -2.174751721484161),\n                                    (\"dayday\", -2.174751721484161),\n                                    (\"hourhour\", -2.6855773452501515),\n                                    (\"<day-of-month> (ordinal or number) <named-month><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.6855773452501515),\n                                    (\"absorption of article before timethe <day-of-month> (non ordinal)\",\n                                     -3.0910424533583156),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.6855773452501515)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.42121346507630353,\n                               unseen = -4.174387269895637,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.0602707946915624),\n                                    (\"dayhour\", -3.0602707946915624),\n                                    (\"monthday\", -3.0602707946915624),\n                                    (\"absorption of article before time<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.0602707946915624),\n                                    (\"<time-of-day> am|pmintersect\", -3.4657359027997265),\n                                    (\"July<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.4657359027997265),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.0602707946915624),\n                                    (\"absorption of article before timeintersect\",\n                                     -2.772588722239781),\n                                    (\"minuteminute\", -2.2129729343043585),\n                                    (\"absorption of article before timeabsorption of article before time\",\n                                     -2.772588722239781),\n                                    (\"hh:mmhh:mm\", -2.772588722239781),\n                                    (\"dayday\", -2.5494451709255714),\n                                    (\"hourhour\", -2.772588722239781),\n                                    (\"August<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.4657359027997265),\n                                    (\"minutehour\", -3.0602707946915624),\n                                    (\"hh:mmintersect\", -3.0602707946915624),\n                                    (\"absorption of article before timehh:mm\", -3.4657359027997265),\n                                    (\"about <time-of-day><time-of-day> am|pm\", -3.4657359027997265),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -3.4657359027997265)],\n                               n = 21}}),\n       (\"on the day of <day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"new year's day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0360919316867756,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pmabsorption of article before time\",\n                                     -2.890371757896165),\n                                    (\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.9740810260220096),\n                                    (\"hh:mmhh:mm\", -1.9740810260220096),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -2.890371757896165),\n                                    (\"hourhour\", -1.9740810260220096),\n                                    (\"minutehour\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.4849066497880004)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.4382549309311553, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.043073897508961),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"minuteminute\", -2.379546134130174),\n                                    (\"absorption of article before timeabsorption of article before time\",\n                                     -3.295836866004329),\n                                    (\"hh:mmhh:mm\", -2.6026896854443837),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -2.890371757896165),\n                                    (\"hourhour\", -1.9095425048844386),\n                                    (\"about <time-of-day>time-of-day (latent)\", -3.295836866004329),\n                                    (\"minutehour\", -1.6863989535702288),\n                                    (\"absorption of article before timetime-of-day (latent)\",\n                                     -2.890371757896165),\n                                    (\"absorption of article before timehh:mm\", -3.295836866004329),\n                                    (\"about <time-of-day><time-of-day> am|pm\", -3.295836866004329),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.295836866004329)],\n                               n = 20}}),\n       (\"<number><grain> (one word)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.917770732084279),\n                                    (\"integer (numeric)day (grain)\", -2.512305623976115),\n                                    (\"second\", -2.512305623976115),\n                                    (\"integer (numeric)second (grain) \", -2.512305623976115),\n                                    (\"number (0..19, 20, 30..90)minute (grain)\",\n                                     -2.917770732084279),\n                                    (\"integer (numeric)year (grain)\", -2.917770732084279),\n                                    (\"day\", -2.512305623976115), (\"year\", -2.917770732084279),\n                                    (\"integer (numeric)week (grain)\", -2.917770732084279),\n                                    (\"hour\", -2.917770732084279), (\"month\", -2.512305623976115),\n                                    (\"integer (numeric)minute (grain)\", -2.917770732084279),\n                                    (\"integer (numeric)month (grain)\", -2.512305623976115),\n                                    (\"minute\", -2.512305623976115),\n                                    (\"integer (numeric)hour (grain)\", -2.917770732084279)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1st..12th, 20th, 30th..90th)thursdayintersect\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -0.8754687373538999),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)thursdayabsorption of article before time\",\n                                     -1.3862943611198906),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)thursdayintersect by 'of', 'from', 's\",\n                                     -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)thursdayabsorption of article before time\",\n                                     -1.0986122886681098)],\n                               n = 1}}),\n       (\"hhmm (military)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -0.42488319396526597,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -1.0608719606852628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.6739764335716716),\n                                    (\"daymonth\", -0.8266785731844679),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)intersect by 'of', 'from', 's\",\n                                     -1.6739764335716716)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> ( ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2411620568168881,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1st..12th, 20th, 30th..90th)September\",\n                                     -1.9810014688665833),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)April\",\n                                     -2.268683541318364),\n                                    (\"ordinal (digits)April\", -2.6741486494265287),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"ordinal (digits)March\", -2.268683541318364),\n                                    (\"ordinals (1st..12th, 20th, 30th..90th)March\",\n                                     -1.9810014688665833)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.540445040947149, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1st..12th, 20th, 30th..90th)absorption of article before time\",\n                                     -1.1786549963416462),\n                                    (\"month\", -1.1786549963416462)],\n                               n = 3}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"lastnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.120263536200091, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of article before time\", -1.3862943611198906),\n                                    (\"<time-of-day> am|pm\", -1.791759469228055),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.12783337150988489,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.8134107167600364),\n                                    (\"absorption of article before time\", -1.1394342831883648),\n                                    (\"day\", -1.8325814637483102),\n                                    (\"<time-of-day> am|pm\", -2.3025850929940455),\n                                    (\"intersect by 'of', 'from', 's\", -3.2188758248682006),\n                                    (\"hour\", -1.1394342831883648)],\n                               n = 22}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1466034741918754, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -1.9924301646902063,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>absorption of article before time\",\n                                     -1.0986122886681098),\n                                    (\"dayday\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.9808292530117262),\n                                    (\"<integer> <unit-of-duration>absorption of article before time\",\n                                     -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>intersect\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of article before timeinteger (numeric)\",\n                                     -1.8718021769015913),\n                                    (\"absorption of article before timenumber (0..19, 20, 30..90)\",\n                                     -1.8718021769015913),\n                                    (\"at <time-of-day>number (0..19, 20, 30..90)\",\n                                     -1.8718021769015913),\n                                    (\"hour\", -0.9555114450274363),\n                                    (\"at <time-of-day>integer (numeric)\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -2.120263536200091),\n                                    (\"October\", -2.5257286443082556), (\"July\", -1.4271163556401458),\n                                    (\"month\", -0.8209805520698302), (\"August\", -2.120263536200091)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 2598}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_AU (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"Thursdaydd/mm\", -6.07993319509559),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_BZ (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"Thursdaydd/mm\", -6.07993319509559),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_CA (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5519485630968232,\n                               unseen = -6.2285110035911835,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 505},\n                   koData =\n                     ClassData{prior = -0.8576131380990365, unseen = -5.924255797414532,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 372}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Father's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.2744368457017603, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2336148511815052, unseen = -5.327876168789581,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.9367156180185177),\n                                    (\"noon|midnight|EOD|end of day\", -4.2243976904702984),\n                                    (\"integer after|past <hour-of-day>\", -3.9367156180185177),\n                                    (\"<time-of-day> o'clock\", -4.629862798578463),\n                                    (\"half after|past <hour-of-day>\", -4.629862798578463),\n                                    (\"hhhmm\", -3.713572066704308),\n                                    (\"<hour-of-day> <integer>\", -3.9367156180185177),\n                                    (\"time-of-day (latent)\", -1.6594483330087617),\n                                    (\"hhmm (latent)\", -3.9367156180185177),\n                                    (\"<time-of-day> am|pm\", -1.9908054689632042),\n                                    (\"hh:mm\", -3.2435684374585723),\n                                    (\"about|exactly <time-of-day>\", -4.2243976904702984),\n                                    (\"hour\", -1.1333552371119826),\n                                    (\"<time-of-day> sharp|exactly\", -4.629862798578463),\n                                    (\"minute\", -1.889022774653262)],\n                               n = 95},\n                   koData =\n                     ClassData{prior = -1.5686159179138452, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9963334395476915),\n                                    (\"<time-of-day> am|pm\", -3.0757749812275272),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 25}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.212136053234485e-2,\n                               unseen = -4.430816798843313,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 82},\n                   koData =\n                     ClassData{prior = -4.418840607796598, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1416505170630268, unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.0243817644968085,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.772588722239781), (\"quarter\", -2.772588722239781),\n                                    (\"year\", -1.6739764335716716),\n                                    (\"<integer> <unit-of-duration>\", -1.6739764335716716),\n                                    (\"a <unit-of-duration>\", -2.367123614131617)],\n                               n = 7}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Family Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vimy Ridge Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.4434640740111233, unseen = -7.214504414151143,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.520621127558696),\n                                    (\"Father's Dayyear (latent)\", -6.520621127558696),\n                                    (\"Karva Chauthyear (latent)\", -6.520621127558696),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.520621127558696),\n                                    (\"Maha Shivaratriyear (latent)\", -6.520621127558696),\n                                    (\"Ramadanyear (latent)\", -5.267858159063328),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.1343267664388055),\n                                    (\"Bhai Doojyear (latent)\", -6.520621127558696),\n                                    (\"hourday\", -4.505718107016431),\n                                    (\"dayhour\", -3.4760986898352733),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.1343267664388055),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.115156019450532),\n                                    (\"Shemini Atzeretyear (latent)\", -6.520621127558696),\n                                    (\"daymonth\", -4.505718107016431),\n                                    (\"monthday\", -6.115156019450532),\n                                    (\"monthyear\", -4.728861658330641),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.520621127558696),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.115156019450532),\n                                    (\"Vijayadashamiyear (latent)\", -6.520621127558696),\n                                    (\"Administrative Professionals' Dayyear (latent)\",\n                                     -6.115156019450532),\n                                    (\"Thanksgiving Dayyear (latent)\", -5.422008838890586),\n                                    (\"Thai Pongalyear (latent)\", -5.827473946998751),\n                                    (\"Thiru Onamyear (latent)\", -5.827473946998751),\n                                    (\"hhhmmabsorption of , after named day\", -6.520621127558696),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.520621127558696),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.604330395684541),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.520621127558696),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.115156019450532),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.520621127558696),\n                                    (\"houryear\", -5.604330395684541),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.520621127558696),\n                                    (\"Christmas<time-of-day> am|pm\", -6.520621127558696),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.520621127558696),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.827473946998751),\n                                    (\"intersectin|during <named-month>|year\", -6.520621127558696),\n                                    (\"<time-of-day> am|pmintersect\", -5.267858159063328),\n                                    (\"Earth Houryear (latent)\", -6.520621127558696),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.520621127558696),\n                                    (\"Family Dayyear (latent)\", -5.604330395684541),\n                                    (\"Octoberyear (latent)\", -5.016543730782422),\n                                    (\"intersect<time-of-day> am|pm\", -6.520621127558696),\n                                    (\"Mattu Pongalyear (latent)\", -6.520621127558696),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.520621127558696),\n                                    (\"Shavuotyear (latent)\", -6.520621127558696),\n                                    (\"Parsi New Yearyear (latent)\", -5.604330395684541),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.520621127558696),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.520621127558696),\n                                    (\"todayin|within|after <duration>\", -6.520621127558696),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.115156019450532),\n                                    (\"Marchyear (latent)\", -6.520621127558696),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.115156019450532),\n                                    (\"Sukkotyear (latent)\", -6.115156019450532),\n                                    (\"hhhmmintersect\", -6.115156019450532),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.115156019450532),\n                                    (\"Clean Mondayyear (latent)\", -6.115156019450532),\n                                    (\"monthhour\", -6.115156019450532),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.604330395684541),\n                                    (\"todayat <time-of-day>\", -6.520621127558696),\n                                    (\"Thursday<time> timezone\", -4.122725854760326),\n                                    (\"tonight<time-of-day> am|pm\", -6.520621127558696),\n                                    (\"time-of-day (latent)tonight\", -6.115156019450532),\n                                    (\"from|since|after <time>December\", -6.520621127558696),\n                                    (\"<time-of-day> am|pmon <day>\", -4.505718107016431),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.520621127558696),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.115156019450532),\n                                    (\"dayday\", -3.748032405318915),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.115156019450532),\n                                    (\"mm/ddat <time-of-day>\", -6.520621127558696),\n                                    (\"tonightat <time-of-day>\", -5.422008838890586),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.827473946998751),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.520621127558696),\n                                    (\"today<time-of-day> am|pm\", -6.520621127558696),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.115156019450532),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.520621127558696),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.115156019450532),\n                                    (\"mm/dd<time-of-day> am|pm\", -6.520621127558696),\n                                    (\"hourhour\", -3.550206661988995),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.115156019450532),\n                                    (\"Navaratriin|during <named-month>|year\", -6.520621127558696),\n                                    (\"National Patriots' Dayyear (latent)\", -5.827473946998751),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.520621127558696),\n                                    (\"Lentyear (latent)\", -6.520621127558696),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.6488189506571045),\n                                    (\"Boghiyear (latent)\", -6.520621127558696),\n                                    (\"dayyear\", -1.857182033446629),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.520621127558696),\n                                    (\"Thursdayfrom|since|after <time>\", -6.115156019450532),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.520621127558696),\n                                    (\"Thursdayat <time-of-day>\", -5.827473946998751),\n                                    (\"Islamic New Yearyear (latent)\", -6.115156019450532),\n                                    (\"Laylat al-Qadryear (latent)\", -5.604330395684541),\n                                    (\"part of days<time-of-day> am|pm\", -6.520621127558696),\n                                    (\"Discovery Dayyear (latent)\", -6.115156019450532),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.520621127558696),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.827473946998751),\n                                    (\"hourminute\", -6.115156019450532),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.604330395684541),\n                                    (\"Yom Kippuryear (latent)\", -6.520621127558696),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.827473946998751),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.520621127558696),\n                                    (\"minutehour\", -5.267858159063328),\n                                    (\"Kaanum Pongalyear (latent)\", -6.115156019450532),\n                                    (\"Maha Saptamiyear (latent)\", -6.520621127558696),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.827473946998751),\n                                    (\"time-of-day (latent)tomorrow\", -5.604330395684541),\n                                    (\"part of daysat <time-of-day>\", -4.911183215124596),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.505718107016431),\n                                    (\"for <duration> from <time>December\", -6.520621127558696),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.520621127558696),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.267858159063328),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.267858159063328),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.520621127558696),\n                                    (\"Pentecostyear (latent)\", -6.520621127558696),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.267858159063328),\n                                    (\"<day-of-month> (ordinal)February\", -6.520621127558696),\n                                    (\"Eid al-Fitryear (latent)\", -5.1343267664388055),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.520621127558696),\n                                    (\"Mondayin|during the <part-of-day>\", -6.520621127558696),\n                                    (\"Chhathin|during <named-month>|year\", -6.520621127558696),\n                                    (\"Diwaliin|during <named-month>|year\", -6.520621127558696),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.520621127558696),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.520621127558696),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.267858159063328),\n                                    (\"Raksha Bandhanyear (latent)\", -6.520621127558696),\n                                    (\"daysecond\", -6.115156019450532),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.115156019450532),\n                                    (\"Ratha-Yatrayear (latent)\", -6.520621127558696),\n                                    (\"Ashurayear (latent)\", -6.520621127558696),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.520621127558696),\n                                    (\"Chinese New Yearyear (latent)\", -6.520621127558696),\n                                    (\"tomorrowintersect\", -6.520621127558696),\n                                    (\"Lag BaOmeryear (latent)\", -6.520621127558696),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.520621127558696),\n                                    (\"Eid al-Adhayear (latent)\", -4.3805549640624255),\n                                    (\"intersectin|during the <part-of-day>\", -6.520621127558696),\n                                    (\"Palm Sundayyear (latent)\", -6.520621127558696),\n                                    (\"Christmasat <time-of-day>\", -6.520621127558696),\n                                    (\"Passoveryear (latent)\", -6.520621127558696),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.520621127558696),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.520621127558696),\n                                    (\"hhhmmon <day>\", -5.604330395684541),\n                                    (\"Yom HaShoahyear (latent)\", -6.115156019450532),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.115156019450532),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.520621127558696),\n                                    (\"Septemberyear (latent)\", -6.115156019450532),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -5.016543730782422),\n                                    (\"Halloweenyear (latent)\", -6.520621127558696),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.115156019450532),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.827473946998751),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.520621127558696),\n                                    (\"at <time-of-day>intersect\", -5.604330395684541),\n                                    (\"Rosh Hashanahyear (latent)\", -5.827473946998751),\n                                    (\"Dhanterasyear (latent)\", -6.520621127558696),\n                                    (\"Tu BiShvatyear (latent)\", -6.520621127558696),\n                                    (\"<day-of-month> (ordinal)December\", -5.827473946998751),\n                                    (\"Holiyear (latent)\", -5.827473946998751),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.520621127558696),\n                                    (\"Holika Dahanyear (latent)\", -5.827473946998751),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.115156019450532),\n                                    (\"dayminute\", -3.1707170402840914),\n                                    (\"Mawlidyear (latent)\", -6.520621127558696),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.115156019450532),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.520621127558696),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.604330395684541),\n                                    (\"minuteday\", -2.771117051628325),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.827473946998751),\n                                    (\"intersectyear (latent)\", -6.520621127558696),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.520621127558696),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.520621127558696),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.520621127558696),\n                                    (\"intersecthhhmm\", -6.115156019450532),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.520621127558696),\n                                    (\"Boss's Dayyear (latent)\", -6.115156019450532),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.520621127558696),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.520621127558696),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.520621127558696),\n                                    (\"tonight<time-of-day> o'clock\", -6.520621127558696),\n                                    (\"Tisha B'Avyear (latent)\", -6.520621127558696),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.604330395684541),\n                                    (\"at <time-of-day>on <day>\", -4.911183215124596),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.115156019450532),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.827473946998751),\n                                    (\"Christmasyear (latent)\", -6.115156019450532),\n                                    (\"Saturdayintersect\", -6.520621127558696),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.115156019450532),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.520621127558696),\n                                    (\"dayweek\", -6.520621127558696),\n                                    (\"Easter Sundayyear (latent)\", -5.827473946998751),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.115156019450532),\n                                    (\"Labour Dayyear (latent)\", -6.520621127558696),\n                                    (\"weekyear\", -5.422008838890586),\n                                    (\"King's Dayyear (latent)\", -5.016543730782422),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.604330395684541),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.115156019450532),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.827473946998751),\n                                    (\"Hanukkahyear (latent)\", -5.827473946998751),\n                                    (\"Rama Navamiyear (latent)\", -6.520621127558696),\n                                    (\"February<time> <part-of-day>\", -6.520621127558696),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.827473946998751),\n                                    (\"Great Lentyear (latent)\", -6.520621127558696),\n                                    (\"tomorrowat <time-of-day>\", -5.827473946998751),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.520621127558696),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.115156019450532),\n                                    (\"Ugadiyear (latent)\", -5.1343267664388055),\n                                    (\"Vaisakhiyear (latent)\", -5.827473946998751),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.827473946998751),\n                                    (\"last <cycle> of <time>year (latent)\", -5.827473946998751),\n                                    (\"at <time-of-day>tomorrow\", -6.115156019450532),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.520621127558696),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.520621127558696),\n                                    (\"Diwaliyear (latent)\", -6.520621127558696),\n                                    (\"between <time> and <time>on <day>\", -6.115156019450532),\n                                    (\"Black Fridayyear (latent)\", -6.115156019450532),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.520621127558696),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.520621127558696),\n                                    (\"Chhathyear (latent)\", -6.115156019450532),\n                                    (\"Vasant Panchamiyear (latent)\", -6.520621127558696),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.267858159063328),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.267858159063328),\n                                    (\"St Patrick's Dayyear (latent)\", -6.520621127558696),\n                                    (\"Thursday<time> (timezone)\", -6.520621127558696),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.520621127558696),\n                                    (\"Pargat Diwasyear (latent)\", -5.267858159063328),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.115156019450532),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.827473946998751),\n                                    (\"Februaryintersect\", -6.520621127558696),\n                                    (\"Mother's Dayyear (latent)\", -6.520621127558696),\n                                    (\"Simchat Torahyear (latent)\", -6.520621127558696),\n                                    (\"Victoria Dayyear (latent)\", -6.115156019450532),\n                                    (\"minuteyear\", -6.520621127558696)],\n                               n = 525},\n                   koData =\n                     ClassData{prior = -1.0266897275856797, unseen = -6.796823718274855,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.598481197837295),\n                                    (\"hourday\", -3.499868909169185),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.102558594613569),\n                                    (\"<day-of-month> (ordinal)August\", -6.102558594613569),\n                                    (\"dayhour\", -3.42840994518704),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.186267862739414),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.409411414053624),\n                                    (\"daymonth\", -3.3945083935113587),\n                                    (\"hourquarter\", -5.186267862739414),\n                                    (\"monthyear\", -4.849795626118201),\n                                    (\"Thai Pongalyear (latent)\", -5.409411414053624),\n                                    (\"intersecthh:mm\", -6.102558594613569),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.697093486505405),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.102558594613569),\n                                    (\"houryear\", -4.716264233493678),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.102558594613569),\n                                    (\"<day-of-month> (ordinal)October\", -6.102558594613569),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.409411414053624),\n                                    (\"hournograin\", -4.849795626118201),\n                                    (\"<time-of-day> am|pmintersect\", -4.849795626118201),\n                                    (\"Octoberyear (latent)\", -6.102558594613569),\n                                    (\"Good Fridayyear (latent)\", -5.697093486505405),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.697093486505405),\n                                    (\"early morningat <time-of-day>\", -6.102558594613569),\n                                    (\"until <time>on <day>\", -5.409411414053624),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.102558594613569),\n                                    (\"time-of-day (latent)intersect\", -5.409411414053624),\n                                    (\"todayin <number> (implicit minutes)\", -6.102558594613569),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.102558594613569),\n                                    (\"hh:mmon <day>\", -4.849795626118201),\n                                    (\"hhhmmintersect\", -5.697093486505405),\n                                    (\"absorption of , after named dayJuly\", -5.186267862739414),\n                                    (\"from|since|after <time>July\", -5.697093486505405),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.186267862739414),\n                                    (\"Clean Mondayyear (latent)\", -6.102558594613569),\n                                    (\"monthhour\", -6.102558594613569),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.697093486505405),\n                                    (\"hourmonth\", -3.962492431117298),\n                                    (\"todayat <time-of-day>\", -6.102558594613569),\n                                    (\"from|since|after <time>December\", -6.102558594613569),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.102558594613569),\n                                    (\"<time-of-day> am|pmon <day>\", -4.849795626118201),\n                                    (\"Mondayyear (latent)\", -5.409411414053624),\n                                    (\"dayday\", -3.962492431117298),\n                                    (\"mm/ddat <time-of-day>\", -5.697093486505405),\n                                    (\"on <day>September\", -5.409411414053624),\n                                    (\"time-of-day (latent)September\", -5.697093486505405),\n                                    (\"hourhour\", -4.023117052933733),\n                                    (\"time-of-day (latent)on <day>\", -4.598481197837295),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.697093486505405),\n                                    (\"dayyear\", -3.299198213707034),\n                                    (\"Thursdaymm/dd\", -6.102558594613569),\n                                    (\"New Year's Dayyear (latent)\", -5.186267862739414),\n                                    (\"time-of-day (latent)Sunday\", -5.697093486505405),\n                                    (\"Thursdayfrom|since|after <time>\", -4.397810502375144),\n                                    (\"Thursdayat <time-of-day>\", -4.493120682179469),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.102558594613569),\n                                    (\"Aprilyear (latent)\", -6.102558594613569),\n                                    (\"the <day-of-month> (ordinal)July\", -6.102558594613569),\n                                    (\"the <day-of-month> (number)July\", -6.102558594613569),\n                                    (\"monthminute\", -6.102558594613569),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.697093486505405),\n                                    (\"Thursdayhh:mm\", -5.186267862739414),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.697093486505405),\n                                    (\"minutemonth\", -3.962492431117298),\n                                    (\"time-of-day (latent)Friday\", -5.697093486505405),\n                                    (\"minutehour\", -6.102558594613569),\n                                    (\"part of daysat <time-of-day>\", -5.003946305945459),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.751183337450091),\n                                    (\"Augustyear (latent)\", -5.697093486505405),\n                                    (\"week-endin|during <named-month>|year\", -6.102558594613569),\n                                    (\"time-of-day (latent)Tuesday\", -5.697093486505405),\n                                    (\"mm/dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.697093486505405),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.102558594613569),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.102558594613569),\n                                    (\"Sundayyear (latent)\", -5.186267862739414),\n                                    (\"hourweek\", -5.186267862739414),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.409411414053624),\n                                    (\"Christmasat <time-of-day>\", -6.102558594613569),\n                                    (\"from|since|after <time>year (latent)\", -5.697093486505405),\n                                    (\"hhhmmon <day>\", -5.186267862739414),\n                                    (\"yesterday<time-of-day> am|pm\", -6.102558594613569),\n                                    (\"<day-of-month> (ordinal)July\", -5.409411414053624),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.102558594613569),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.102558594613569),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.102558594613569),\n                                    (\"at <time-of-day>intersect\", -5.186267862739414),\n                                    (\"Holiyear (latent)\", -6.102558594613569),\n                                    (\"until <time><time-of-day> am|pm\", -6.102558594613569),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.697093486505405),\n                                    (\"dayminute\", -3.2403577136841006),\n                                    (\"yyyy-mm-ddhh:mm\", -5.697093486505405),\n                                    (\"intersectfrom|since|after <time>\", -5.697093486505405),\n                                    (\"intersectSeptember\", -4.230756417711977),\n                                    (\"minuteday\", -2.9455581734634557),\n                                    (\"absorption of , after named dayintersect\",\n                                     -6.102558594613569),\n                                    (\"intersectyear (latent)\", -6.102558594613569),\n                                    (\"Februaryin|during the <part-of-day>\", -6.102558594613569),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.102558594613569),\n                                    (\"time-of-day (latent)July\", -5.409411414053624),\n                                    (\"Saturdayyear (latent)\", -6.102558594613569),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.102558594613569),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.849795626118201),\n                                    (\"at <time-of-day>on <day>\", -5.186267862739414),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.849795626118201),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.102558594613569),\n                                    (\"from|since|after <time>on <day>\", -5.186267862739414),\n                                    (\"dayweek\", -6.102558594613569),\n                                    (\"Easter Sundayyear (latent)\", -5.697093486505405),\n                                    (\"Thursday<time-of-day> am|pm\", -4.849795626118201),\n                                    (\"weekyear\", -5.697093486505405),\n                                    (\"time-of-day (latent)Thursday\", -5.697093486505405),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.102558594613569),\n                                    (\"<day-of-month> (ordinal)April\", -6.102558594613569),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.697093486505405),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.409411414053624),\n                                    (\"Sundayfrom|since|after <time>\", -6.102558594613569),\n                                    (\"absorption of , after named dayFebruary\", -5.186267862739414),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.697093486505405),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.102558594613569),\n                                    (\"tomorrowat <time-of-day>\", -6.102558594613569),\n                                    (\"daynograin\", -5.697093486505405),\n                                    (\"Fridayin|during <named-month>|year\", -6.102558594613569),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.697093486505405),\n                                    (\"last <cycle> of <time>year (latent)\", -5.697093486505405),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.102558594613569),\n                                    (\"Diwaliyear (latent)\", -5.697093486505405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.102558594613569),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.186267862739414),\n                                    (\"Fridayyear (latent)\", -5.186267862739414),\n                                    (\"time-of-day (latent)April\", -6.102558594613569)],\n                               n = 293}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3581234841531944,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.2972515234679316, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2411620568168881),\n                                    (\"integer (0..19)\", -1.540445040947149)],\n                               n = 26}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.7376696182833684,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 40},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.1499730906752734e-2,\n                               unseen = -5.480638923341991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.1142436573809237e-2),\n                                    (\"intersect 2 numbers\", -4.09016919081162)],\n                               n = 236},\n                   koData =\n                     ClassData{prior = -3.202746442938317, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Civic Holiday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Memorial Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Labour Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Discovery Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"The Twelfth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Groundhog Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.41284521540578695,\n                               unseen = -5.262690188904886,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2685113254635072),\n                                    (\"month (grain)\", -2.367123614131617),\n                                    (\"year (grain)\", -2.4242820279715653),\n                                    (\"week (grain)\", -1.2685113254635072),\n                                    (\"quarter\", -3.648057459593681), (\"year\", -2.4242820279715653),\n                                    (\"month\", -2.367123614131617),\n                                    (\"quarter (grain)\", -3.648057459593681)],\n                               n = 90},\n                   koData =\n                     ClassData{prior = -1.0840134892469568, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Mother's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Victoria Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5753641449035618),\n                                    (\"ordinal (digits)\", -0.8266785731844679)],\n                               n = 14}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7087724984630261, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6777622617204658, unseen = -4.897839799950911,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15415067982725836),\n                                    (\"integer (0..19)\", -1.9459101490553135)],\n                               n = 131}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6112300580920585, unseen = -5.318119993844216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6741486494265287),\n                                    (\"integer (0..19)year (grain)\", -3.115981401705568),\n                                    (\"integer (numeric)day (grain)\", -2.6741486494265287),\n                                    (\"integer (0..19)second (grain) \", -3.926911617921897),\n                                    (\"integer (0..19)hour (grain)\", -3.115981401705568),\n                                    (\"second\", -3.521446509813732),\n                                    (\"integer (numeric)second (grain) \", -4.214593690373678),\n                                    (\"integer (numeric)year (grain)\", -3.367295829986474),\n                                    (\"day\", -2.4228342211456226), (\"year\", -2.605155777939577),\n                                    (\"integer (numeric)week (grain)\", -3.2337644373619514),\n                                    (\"integer (0..19)month (grain)\", -3.703768066607687),\n                                    (\"integer (20..90)minute (grain)\", -4.620058798481842),\n                                    (\"hour\", -2.7482566215802504), (\"month\", -3.367295829986474),\n                                    (\"integer (numeric)minute (grain)\", -2.605155777939577),\n                                    (\"integer (0..19)minute (grain)\", -3.2337644373619514),\n                                    (\"integer (numeric)month (grain)\", -4.214593690373678),\n                                    (\"minute\", -2.1777117631126375),\n                                    (\"integer (numeric)hour (grain)\", -3.703768066607687),\n                                    (\"integer (0..19)day (grain)\", -3.703768066607687),\n                                    (\"integer (0..19)week (grain)\", -3.367295829986474)],\n                               n = 89},\n                   koData =\n                     ClassData{prior = -0.782378314287888, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.26452876747706405,\n                               unseen = -5.717027701406222,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.767822656454056),\n                                    (\"integer after|past <hour-of-day>\", -4.327438444389479),\n                                    (\"at <time-of-day>\", -2.3815282953341654),\n                                    (\"<time-of-day> o'clock\", -4.61512051684126),\n                                    (\"half after|past <hour-of-day>\", -4.61512051684126),\n                                    (\"second\", -4.61512051684126), (\"hh:mm:ss\", -4.61512051684126),\n                                    (\"<hour-of-day> <integer>\", -4.104294893075269),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.020585624949423),\n                                    (\"time-of-day (latent)\", -1.7063996202768983),\n                                    (\"hhmm (latent)\", -5.020585624949423),\n                                    (\"hh:mm\", -2.3815282953341654),\n                                    (\"quarter after|past <hour-of-day>\", -3.5165082281731497),\n                                    (\"until <time>\", -4.327438444389479),\n                                    (\"about|exactly <time-of-day>\", -5.020585624949423),\n                                    (\"hour\", -1.2593855092558615),\n                                    (\"<time-of-day> sharp|exactly\", -5.020585624949423),\n                                    (\"minute\", -1.68838111477422)],\n                               n = 142},\n                   koData =\n                     ClassData{prior = -1.4591557093847622, unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.2676659890376327),\n                                    (\"from|since|after <time>\", -3.2676659890376327),\n                                    (\"at <time-of-day>\", -3.5553480614894135),\n                                    (\"time-of-day (latent)\", -1.157452788691043),\n                                    (\"hh:mm\", -3.5553480614894135),\n                                    (\"until <time>\", -3.960813169597578),\n                                    (\"hour\", -1.0163741904311376), (\"minute\", -2.70805020110221)],\n                               n = 43}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.21511137961694557, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8803128665695), (\"mm/dd\", -3.3843902633457743),\n                                    (\"absorption of , after named day\", -2.691243082785829),\n                                    (\"intersect\", -2.691243082785829),\n                                    (\"Saturday\", -2.691243082785829),\n                                    (\"Friday\", -2.9789251552376097), (\"day\", -0.8194409058842375),\n                                    (\"the <day-of-month> (ordinal)\", -2.9789251552376097),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.691243082785829)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.6422277352570913,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6582280766035324),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6582280766035324)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Administrative Professionals' Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thanksgiving Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.14595391262307983,\n                               unseen = -4.276666119016055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 70},\n                   koData =\n                     ClassData{prior = -1.9965538818740682,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -8.961215868968717e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -2.456735772821304, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mm/dd\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.540445040947149),\n                                    (\"Marcha <unit-of-duration>\", -1.9459101490553135),\n                                    (\"March<integer> <unit-of-duration>\", -1.9459101490553135),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.9459101490553135),\n                                    (\"Administrative Professionals' Day<integer> <unit-of-duration>\",\n                                     -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5485659517488378, unseen = -5.43372200355424,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.736198448394496),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.736198448394496),\n                                    (\"dayhour\", -4.330733340286331),\n                                    (\"daymonth\", -2.0281482472922856),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.736198448394496),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4834354798991276),\n                                    (\"Wednesdayintersect\", -4.736198448394496),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.349904087274605),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.736198448394496),\n                                    (\"Labour Daythis|last|next <cycle>\", -4.736198448394496),\n                                    (\"<part-of-day> of <time>February\", -4.736198448394496),\n                                    (\"Saturday<time-of-day> am|pm\", -4.736198448394496),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.330733340286331),\n                                    (\"hourmonth\", -4.736198448394496),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.04305126783455),\n                                    (\"dayday\", -2.4849066497880004),\n                                    (\"the <day-of-month> (ordinal)February\", -4.330733340286331),\n                                    (\"WednesdayOctober\", -4.736198448394496),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.330733340286331),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4834354798991276),\n                                    (\"dayyear\", -3.6375861597263857),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.736198448394496),\n                                    (\"Thursdayhh:mm\", -4.330733340286331),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -4.736198448394496),\n                                    (\"TuesdayOctober\", -4.736198448394496),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6375861597263857),\n                                    (\"Mondaythis|last|next <cycle>\", -3.8199077165203406),\n                                    (\"Fridayintersect\", -4.04305126783455),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.330733340286331),\n                                    (\"intersectOctober\", -4.330733340286331),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.8199077165203406),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.330733340286331),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.736198448394496),\n                                    (\"dayminute\", -2.9444389791664407),\n                                    (\"minuteday\", -3.4834354798991276),\n                                    (\"this|last|next <cycle>Sunday\", -4.736198448394496),\n                                    (\"Sundaythis|last|next <cycle>\", -4.736198448394496),\n                                    (\"on <day><time-of-day> am|pm\", -4.736198448394496),\n                                    (\"intersectintersect\", -4.736198448394496),\n                                    (\"weekday\", -4.736198448394496),\n                                    (\"dayweek\", -3.6375861597263857),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.330733340286331),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.8199077165203406),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.04305126783455)],\n                               n = 78},\n                   koData =\n                     ClassData{prior = -0.8622235106038793, unseen = -5.231108616854587,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.532599493153256),\n                                    (\"week-endOctober\", -3.8394523125933104),\n                                    (\"daymonth\", -1.791759469228055),\n                                    (\"TuesdaySeptember\", -4.532599493153256),\n                                    (\"Wednesdayintersect\", -4.532599493153256),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4339872044851463),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.532599493153256),\n                                    (\"hournograin\", -4.127134385045092),\n                                    (\"from|since|after <time>July\", -4.127134385045092),\n                                    (\"hourmonth\", -2.5866893440979424),\n                                    (\"Fridaythis|last|next <cycle>\", -4.532599493153256),\n                                    (\"SundayFebruary\", -4.532599493153256),\n                                    (\"on <day>September\", -3.8394523125933104),\n                                    (\"WednesdayOctober\", -4.532599493153256),\n                                    (\"intersectnow\", -4.127134385045092),\n                                    (\"week-endintersect\", -4.532599493153256),\n                                    (\"dayyear\", -4.532599493153256),\n                                    (\"FridayJuly\", -3.6163087612791007),\n                                    (\"FridaySeptember\", -4.127134385045092),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6163087612791007),\n                                    (\"WednesdayFebruary\", -4.532599493153256),\n                                    (\"minutemonth\", -3.028522096376982),\n                                    (\"Mondaythis|last|next <cycle>\", -4.532599493153256),\n                                    (\"SundayMarch\", -4.532599493153256),\n                                    (\"MondayFebruary\", -4.127134385045092),\n                                    (\"Fridayintersect\", -4.532599493153256),\n                                    (\"intersectOctober\", -4.532599493153256),\n                                    (\"dayminute\", -4.532599493153256),\n                                    (\"SaturdaySeptember\", -4.532599493153256),\n                                    (\"intersectSeptember\", -3.146305132033365),\n                                    (\"Tuesdaynow\", -4.127134385045092),\n                                    (\"MondayMarch\", -4.532599493153256),\n                                    (\"FridayOctober\", -4.532599493153256),\n                                    (\"daynograin\", -4.127134385045092),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.532599493153256),\n                                    (\"Tuesdayintersect\", -4.532599493153256),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.532599493153256),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.532599493153256),\n                                    (\"Sundayintersect\", -4.532599493153256)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5978370007556204, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Father's Day\", -2.8622008809294686),\n                                    (\"Martin Luther King's Day\", -2.8622008809294686),\n                                    (\"Mother's Day\", -2.8622008809294686),\n                                    (\"day\", -1.157452788691043), (\"Sunday\", -2.8622008809294686),\n                                    (\"Chinese New Year\", -2.169053700369523),\n                                    (\"Thanksgiving Day\", -2.8622008809294686),\n                                    (\"Easter Sunday\", -2.8622008809294686),\n                                    (\"hour\", -2.8622008809294686), (\"Tuesday\", -2.8622008809294686),\n                                    (\"week-end\", -2.8622008809294686)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.7985076962177716,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.740840023925201), (\"Friday\", -2.3353749158170367),\n                                    (\"day\", -1.824549292051046), (\"Sunday\", -2.740840023925201),\n                                    (\"hour\", -1.6422277352570913),\n                                    (\"week-end\", -1.6422277352570913)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm.dd.yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Labour Day weekend\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.3513752571634776),\n                                    (\"Halloween\", -3.044522437723423),\n                                    (\"Boss's Day\", -3.044522437723423),\n                                    (\"Memorial Day\", -3.044522437723423),\n                                    (\"Monday\", -2.639057329615259),\n                                    (\"Discovery Day\", -3.044522437723423),\n                                    (\"Mother's Day\", -3.044522437723423),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"Thanksgiving Day\", -3.044522437723423),\n                                    (\"March\", -3.044522437723423), (\"month\", -3.044522437723423),\n                                    (\"Tuesday\", -2.639057329615259)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.1972245773362196),\n                                    (\"Saturday\", -2.1972245773362196), (\"day\", -1.791759469228055)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -4.652001563489282e-2),\n                                    (\"integer (0..19)\", -3.0910424533583156)],\n                               n = 42}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"National Patriots' Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1512560221535317, unseen = -4.68213122712422,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.0633909220278057),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"minuteminute\", -1.6770965609079151),\n                                    (\"<time> timezone<time> timezone\", -3.2865344733420154),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.979681653901961),\n                                    (\"hh:mmhh:mm\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"hhhmmhhhmm\", -3.0633909220278057),\n                                    (\"hourhour\", -2.4756042571256867),\n                                    (\"minutehour\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.979681653901961),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"hoursecond\", -3.5742165457937967),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -3.0633909220278057)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.3801473001238745, unseen = -5.267858159063328,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.164077900236776),\n                                    (\"<time> timezonehhhmm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.56954300834494),\n                                    (\"until <time>time-of-day (latent)\", -3.316780039849572),\n                                    (\"from|since|after <time>hh:mm\", -4.56954300834494),\n                                    (\"hh:mmtime-of-day (latent)\", -2.4901014666651045),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1832486472250494),\n                                    (\"minuteminute\", -2.4901014666651045),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.653252276470785),\n                                    (\"hh:mmhh:mm\", -3.876395827784995),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.164077900236776),\n                                    (\"hhhmmhhhmm\", -4.164077900236776),\n                                    (\"at <time-of-day><time-of-day> am|pm\", -4.56954300834494),\n                                    (\"hourhour\", -2.0045936508834035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.876395827784995),\n                                    (\"hourminute\", -3.4709307196768306),\n                                    (\"minutehour\", -1.6791712504487755),\n                                    (\"<time> timezonehh:mm\", -4.56954300834494),\n                                    (\"hh:mm<time> timezone\", -4.56954300834494),\n                                    (\"hhhmmtime-of-day (latent)\", -3.876395827784995),\n                                    (\"until <time><time-of-day> am|pm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.56954300834494),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.876395827784995),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.065465611568666),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.653252276470785),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.876395827784995),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.876395827784995)],\n                               n = 80}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.9704144655697013),\n                                    (\"Labour Daythis|last|next <cycle>\", -2.9704144655697013),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.5649493574615367),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.277267285009756),\n                                    (\"dayyear\", -0.8909729238898653),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -2.9704144655697013),\n                                    (\"intersectyear (latent)\", -2.277267285009756),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -2.0541237336955462)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.639057329615259),\n                                    (\"Martin Luther King's Day\", -2.639057329615259),\n                                    (\"Monday\", -2.639057329615259), (\"day\", -1.1349799328389845),\n                                    (\"Thanksgiving Day\", -2.639057329615259),\n                                    (\"Christmas\", -2.639057329615259), (\"hour\", -2.639057329615259),\n                                    (\"winter\", -2.639057329615259),\n                                    (\"week-end\", -2.639057329615259),\n                                    (\"summer\", -2.2335922215070942)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4262}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_GB (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5662316613402895, unseen = -6.208590026096629,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 495},\n                   koData =\n                     ClassData{prior = -0.8385442364609689, unseen = -5.937536205082426,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 377}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Father's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2336148511815052, unseen = -5.327876168789581,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.9367156180185177),\n                                    (\"noon|midnight|EOD|end of day\", -4.2243976904702984),\n                                    (\"integer after|past <hour-of-day>\", -3.9367156180185177),\n                                    (\"<time-of-day> o'clock\", -4.629862798578463),\n                                    (\"half after|past <hour-of-day>\", -4.629862798578463),\n                                    (\"hhhmm\", -3.713572066704308),\n                                    (\"<hour-of-day> <integer>\", -3.9367156180185177),\n                                    (\"time-of-day (latent)\", -1.6594483330087617),\n                                    (\"hhmm (latent)\", -3.9367156180185177),\n                                    (\"<time-of-day> am|pm\", -1.9908054689632042),\n                                    (\"hh:mm\", -3.2435684374585723),\n                                    (\"about|exactly <time-of-day>\", -4.2243976904702984),\n                                    (\"hour\", -1.1333552371119826),\n                                    (\"<time-of-day> sharp|exactly\", -4.629862798578463),\n                                    (\"minute\", -1.889022774653262)],\n                               n = 95},\n                   koData =\n                     ClassData{prior = -1.5686159179138452, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9963334395476915),\n                                    (\"<time-of-day> am|pm\", -3.0757749812275272),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 25}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.4614721941962667, unseen = -7.198931240688173,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.505036396541998),\n                                    (\"Father's Dayyear (latent)\", -6.505036396541998),\n                                    (\"Karva Chauthyear (latent)\", -6.505036396541998),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.505036396541998),\n                                    (\"Maha Shivaratriyear (latent)\", -6.505036396541998),\n                                    (\"Ramadanyear (latent)\", -5.25227342804663),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.118742035422107),\n                                    (\"Bhai Doojyear (latent)\", -6.505036396541998),\n                                    (\"hourday\", -4.490133375999733),\n                                    (\"dayhour\", -3.460513958818575),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.118742035422107),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.099571288433833),\n                                    (\"Shemini Atzeretyear (latent)\", -6.505036396541998),\n                                    (\"daymonth\", -4.490133375999733),\n                                    (\"monthday\", -6.099571288433833),\n                                    (\"monthyear\", -4.7132769273139425),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.505036396541998),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.099571288433833),\n                                    (\"Vijayadashamiyear (latent)\", -6.505036396541998),\n                                    (\"Thanksgiving Dayyear (latent)\", -5.406424107873888),\n                                    (\"Thai Pongalyear (latent)\", -5.8118892159820525),\n                                    (\"Thiru Onamyear (latent)\", -5.8118892159820525),\n                                    (\"hhhmmabsorption of , after named day\", -6.505036396541998),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.505036396541998),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.588745664667843),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.505036396541998),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.099571288433833),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.505036396541998),\n                                    (\"houryear\", -5.588745664667843),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.505036396541998),\n                                    (\"Christmas<time-of-day> am|pm\", -6.505036396541998),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.505036396541998),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.8118892159820525),\n                                    (\"intersectin|during <named-month>|year\", -6.505036396541998),\n                                    (\"<time-of-day> am|pmintersect\", -5.25227342804663),\n                                    (\"Earth Houryear (latent)\", -6.505036396541998),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.505036396541998),\n                                    (\"Octoberyear (latent)\", -5.000958999765723),\n                                    (\"intersect<time-of-day> am|pm\", -6.505036396541998),\n                                    (\"Mattu Pongalyear (latent)\", -6.505036396541998),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.505036396541998),\n                                    (\"Shavuotyear (latent)\", -6.505036396541998),\n                                    (\"Parsi New Yearyear (latent)\", -5.588745664667843),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.505036396541998),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.505036396541998),\n                                    (\"todayin|within|after <duration>\", -6.505036396541998),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.099571288433833),\n                                    (\"Marchyear (latent)\", -6.505036396541998),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.099571288433833),\n                                    (\"Sukkotyear (latent)\", -6.099571288433833),\n                                    (\"hhhmmintersect\", -6.099571288433833),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.099571288433833),\n                                    (\"Clean Mondayyear (latent)\", -6.099571288433833),\n                                    (\"monthhour\", -6.099571288433833),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.588745664667843),\n                                    (\"todayat <time-of-day>\", -6.505036396541998),\n                                    (\"Thursday<time> timezone\", -4.107141123743627),\n                                    (\"tonight<time-of-day> am|pm\", -6.505036396541998),\n                                    (\"time-of-day (latent)tonight\", -6.099571288433833),\n                                    (\"from|since|after <time>December\", -6.505036396541998),\n                                    (\"dd/mm<time-of-day> am|pm\", -6.505036396541998),\n                                    (\"<time-of-day> am|pmon <day>\", -4.490133375999733),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.505036396541998),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.099571288433833),\n                                    (\"dayday\", -3.732447674302217),\n                                    (\"dd/mmat <time-of-day>\", -6.505036396541998),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.099571288433833),\n                                    (\"tonightat <time-of-day>\", -5.406424107873888),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.8118892159820525),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.505036396541998),\n                                    (\"today<time-of-day> am|pm\", -6.505036396541998),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.099571288433833),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.505036396541998),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.099571288433833),\n                                    (\"hourhour\", -3.5346219309722966),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.099571288433833),\n                                    (\"Navaratriin|during <named-month>|year\", -6.505036396541998),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.505036396541998),\n                                    (\"Lentyear (latent)\", -6.505036396541998),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.633234219640406),\n                                    (\"Boghiyear (latent)\", -6.505036396541998),\n                                    (\"dayyear\", -1.8899158797007385),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.505036396541998),\n                                    (\"Thursdayfrom|since|after <time>\", -6.099571288433833),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.505036396541998),\n                                    (\"Thursdayat <time-of-day>\", -5.8118892159820525),\n                                    (\"Islamic New Yearyear (latent)\", -6.099571288433833),\n                                    (\"Laylat al-Qadryear (latent)\", -5.588745664667843),\n                                    (\"part of days<time-of-day> am|pm\", -6.505036396541998),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.505036396541998),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.8118892159820525),\n                                    (\"hourminute\", -6.099571288433833),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.588745664667843),\n                                    (\"Yom Kippuryear (latent)\", -6.505036396541998),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.8118892159820525),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.505036396541998),\n                                    (\"minutehour\", -5.25227342804663),\n                                    (\"Kaanum Pongalyear (latent)\", -6.099571288433833),\n                                    (\"Maha Saptamiyear (latent)\", -6.505036396541998),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.8118892159820525),\n                                    (\"time-of-day (latent)tomorrow\", -5.588745664667843),\n                                    (\"part of daysat <time-of-day>\", -4.895598484107897),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.490133375999733),\n                                    (\"for <duration> from <time>December\", -6.505036396541998),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.505036396541998),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.25227342804663),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.25227342804663),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.505036396541998),\n                                    (\"Pentecostyear (latent)\", -6.505036396541998),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.25227342804663),\n                                    (\"<day-of-month> (ordinal)February\", -6.505036396541998),\n                                    (\"Eid al-Fitryear (latent)\", -5.118742035422107),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.505036396541998),\n                                    (\"Mondayin|during the <part-of-day>\", -6.505036396541998),\n                                    (\"Chhathin|during <named-month>|year\", -6.505036396541998),\n                                    (\"Diwaliin|during <named-month>|year\", -6.505036396541998),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.505036396541998),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.505036396541998),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.25227342804663),\n                                    (\"Raksha Bandhanyear (latent)\", -6.505036396541998),\n                                    (\"daysecond\", -6.099571288433833),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.099571288433833),\n                                    (\"Ratha-Yatrayear (latent)\", -6.505036396541998),\n                                    (\"Ashurayear (latent)\", -6.505036396541998),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.505036396541998),\n                                    (\"Chinese New Yearyear (latent)\", -6.505036396541998),\n                                    (\"tomorrowintersect\", -6.505036396541998),\n                                    (\"Lag BaOmeryear (latent)\", -6.505036396541998),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.505036396541998),\n                                    (\"Eid al-Adhayear (latent)\", -4.364970233045727),\n                                    (\"intersectin|during the <part-of-day>\", -6.505036396541998),\n                                    (\"Palm Sundayyear (latent)\", -6.505036396541998),\n                                    (\"Christmasat <time-of-day>\", -6.505036396541998),\n                                    (\"Passoveryear (latent)\", -6.505036396541998),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.505036396541998),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.505036396541998),\n                                    (\"hhhmmon <day>\", -5.588745664667843),\n                                    (\"Yom HaShoahyear (latent)\", -6.099571288433833),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.099571288433833),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.505036396541998),\n                                    (\"Septemberyear (latent)\", -6.099571288433833),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -5.000958999765723),\n                                    (\"Halloweenyear (latent)\", -6.505036396541998),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.099571288433833),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.8118892159820525),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.505036396541998),\n                                    (\"at <time-of-day>intersect\", -5.588745664667843),\n                                    (\"Rosh Hashanahyear (latent)\", -5.8118892159820525),\n                                    (\"Dhanterasyear (latent)\", -6.505036396541998),\n                                    (\"Tu BiShvatyear (latent)\", -6.505036396541998),\n                                    (\"<day-of-month> (ordinal)December\", -5.8118892159820525),\n                                    (\"Holiyear (latent)\", -5.8118892159820525),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.505036396541998),\n                                    (\"Holika Dahanyear (latent)\", -5.8118892159820525),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.099571288433833),\n                                    (\"dayminute\", -3.155132309267393),\n                                    (\"Mawlidyear (latent)\", -6.505036396541998),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.099571288433833),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.505036396541998),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.588745664667843),\n                                    (\"minuteday\", -2.7555323206116267),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.8118892159820525),\n                                    (\"intersectyear (latent)\", -6.505036396541998),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.505036396541998),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.505036396541998),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.505036396541998),\n                                    (\"intersecthhhmm\", -6.099571288433833),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.505036396541998),\n                                    (\"Mothering Sundayyear (latent)\", -6.099571288433833),\n                                    (\"Boss's Dayyear (latent)\", -6.099571288433833),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.505036396541998),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.505036396541998),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.505036396541998),\n                                    (\"tonight<time-of-day> o'clock\", -6.505036396541998),\n                                    (\"Tisha B'Avyear (latent)\", -6.505036396541998),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.588745664667843),\n                                    (\"at <time-of-day>on <day>\", -4.895598484107897),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.099571288433833),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.8118892159820525),\n                                    (\"Christmasyear (latent)\", -6.099571288433833),\n                                    (\"Saturdayintersect\", -6.505036396541998),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.099571288433833),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.505036396541998),\n                                    (\"dayweek\", -6.505036396541998),\n                                    (\"Easter Sundayyear (latent)\", -5.8118892159820525),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.099571288433833),\n                                    (\"weekyear\", -5.406424107873888),\n                                    (\"King's Dayyear (latent)\", -5.000958999765723),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.588745664667843),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.099571288433833),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.8118892159820525),\n                                    (\"Hanukkahyear (latent)\", -5.8118892159820525),\n                                    (\"Rama Navamiyear (latent)\", -6.505036396541998),\n                                    (\"February<time> <part-of-day>\", -6.505036396541998),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.8118892159820525),\n                                    (\"Great Lentyear (latent)\", -6.505036396541998),\n                                    (\"tomorrowat <time-of-day>\", -5.8118892159820525),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.505036396541998),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.099571288433833),\n                                    (\"Ugadiyear (latent)\", -5.118742035422107),\n                                    (\"Vaisakhiyear (latent)\", -5.8118892159820525),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.8118892159820525),\n                                    (\"last <cycle> of <time>year (latent)\", -5.8118892159820525),\n                                    (\"at <time-of-day>tomorrow\", -6.099571288433833),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.505036396541998),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.505036396541998),\n                                    (\"Diwaliyear (latent)\", -6.505036396541998),\n                                    (\"between <time> and <time>on <day>\", -6.099571288433833),\n                                    (\"Black Fridayyear (latent)\", -6.099571288433833),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.505036396541998),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.505036396541998),\n                                    (\"Chhathyear (latent)\", -6.099571288433833),\n                                    (\"Vasant Panchamiyear (latent)\", -6.505036396541998),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.25227342804663),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.25227342804663),\n                                    (\"St Patrick's Dayyear (latent)\", -6.505036396541998),\n                                    (\"Thursday<time> (timezone)\", -6.505036396541998),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.505036396541998),\n                                    (\"Pargat Diwasyear (latent)\", -5.25227342804663),\n                                    (\"August Bank Holidayyear (latent)\", -5.8118892159820525),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.099571288433833),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.8118892159820525),\n                                    (\"Februaryintersect\", -6.505036396541998),\n                                    (\"Simchat Torahyear (latent)\", -6.505036396541998),\n                                    (\"minuteyear\", -6.505036396541998)],\n                               n = 515},\n                   koData =\n                     ClassData{prior = -0.9952120774851333, unseen = -6.815639990074332,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.617318319923739),\n                                    (\"time-of-day (latent)<time-of-day> - <time-of-day> (interval)\",\n                                     -5.715930608591849),\n                                    (\"hourday\", -3.518706031255629),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.121395716700013),\n                                    (\"<day-of-month> (ordinal)August\", -6.121395716700013),\n                                    (\"dayhour\", -3.447247067273484),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.205104984825858),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.428248536140067),\n                                    (\"daymonth\", -3.413345515597803),\n                                    (\"hourquarter\", -5.205104984825858),\n                                    (\"monthyear\", -4.868632748204645),\n                                    (\"Thai Pongalyear (latent)\", -5.428248536140067),\n                                    (\"intersecthh:mm\", -6.121395716700013),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.715930608591849),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.121395716700013),\n                                    (\"houryear\", -4.735101355580122),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.121395716700013),\n                                    (\"<day-of-month> (ordinal)October\", -6.121395716700013),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.428248536140067),\n                                    (\"hournograin\", -4.868632748204645),\n                                    (\"<time-of-day> am|pmintersect\", -4.868632748204645),\n                                    (\"Octoberyear (latent)\", -6.121395716700013),\n                                    (\"Good Fridayyear (latent)\", -5.715930608591849),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.715930608591849),\n                                    (\"early morningat <time-of-day>\", -6.121395716700013),\n                                    (\"until <time>on <day>\", -5.428248536140067),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.121395716700013),\n                                    (\"time-of-day (latent)intersect\", -5.428248536140067),\n                                    (\"todayin <number> (implicit minutes)\", -6.121395716700013),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.121395716700013),\n                                    (\"hh:mmon <day>\", -4.868632748204645),\n                                    (\"hhhmmintersect\", -5.715930608591849),\n                                    (\"absorption of , after named dayJuly\", -5.205104984825858),\n                                    (\"from|since|after <time>July\", -5.715930608591849),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.205104984825858),\n                                    (\"Clean Mondayyear (latent)\", -6.121395716700013),\n                                    (\"monthhour\", -6.121395716700013),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.715930608591849),\n                                    (\"hourmonth\", -3.9813295532037425),\n                                    (\"todayat <time-of-day>\", -6.121395716700013),\n                                    (\"Bank Holidayyear (latent)\", -5.428248536140067),\n                                    (\"from|since|after <time>December\", -6.121395716700013),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.121395716700013),\n                                    (\"<time-of-day> am|pmon <day>\", -4.868632748204645),\n                                    (\"Mondayyear (latent)\", -5.428248536140067),\n                                    (\"dayday\", -3.9813295532037425),\n                                    (\"dd/mmat <time-of-day>\", -5.715930608591849),\n                                    (\"on <day>September\", -5.428248536140067),\n                                    (\"time-of-day (latent)September\", -5.715930608591849),\n                                    (\"hourhour\", -3.870103918093518),\n                                    (\"time-of-day (latent)on <day>\", -4.617318319923739),\n                                    (\"Thursdaydd/mm\", -6.121395716700013),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.715930608591849),\n                                    (\"dayyear\", -3.2310239588038483),\n                                    (\"New Year's Dayyear (latent)\", -5.205104984825858),\n                                    (\"time-of-day (latent)Sunday\", -5.715930608591849),\n                                    (\"Thursdayfrom|since|after <time>\", -4.4166476244615875),\n                                    (\"Thursdayat <time-of-day>\", -4.511957804265912),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.121395716700013),\n                                    (\"Aprilyear (latent)\", -6.121395716700013),\n                                    (\"the <day-of-month> (ordinal)July\", -6.121395716700013),\n                                    (\"the <day-of-month> (number)July\", -6.121395716700013),\n                                    (\"monthminute\", -6.121395716700013),\n                                    (\"hourminute\", -5.428248536140067),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.715930608591849),\n                                    (\"Thursdayhh:mm\", -5.205104984825858),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.715930608591849),\n                                    (\"minutemonth\", -3.9813295532037425),\n                                    (\"time-of-day (latent)Friday\", -5.715930608591849),\n                                    (\"minutehour\", -6.121395716700013),\n                                    (\"part of daysat <time-of-day>\", -5.022783428031904),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.770020459536535),\n                                    (\"Augustyear (latent)\", -5.715930608591849),\n                                    (\"week-endin|during <named-month>|year\", -6.121395716700013),\n                                    (\"time-of-day (latent)Tuesday\", -5.715930608591849),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.121395716700013),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.121395716700013),\n                                    (\"dd/mm<time-of-day> - <time-of-day> (interval)\",\n                                     -5.715930608591849),\n                                    (\"Sundayyear (latent)\", -5.205104984825858),\n                                    (\"hourweek\", -5.205104984825858),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.428248536140067),\n                                    (\"Christmasat <time-of-day>\", -6.121395716700013),\n                                    (\"from|since|after <time>year (latent)\", -5.715930608591849),\n                                    (\"hhhmmon <day>\", -5.205104984825858),\n                                    (\"yesterday<time-of-day> am|pm\", -6.121395716700013),\n                                    (\"<day-of-month> (ordinal)July\", -5.428248536140067),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.121395716700013),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.121395716700013),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.121395716700013),\n                                    (\"at <time-of-day>intersect\", -5.205104984825858),\n                                    (\"Holiyear (latent)\", -6.121395716700013),\n                                    (\"until <time><time-of-day> am|pm\", -6.121395716700013),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.715930608591849),\n                                    (\"dayminute\", -3.2591948357705447),\n                                    (\"yyyy-mm-ddhh:mm\", -5.715930608591849),\n                                    (\"intersectfrom|since|after <time>\", -5.715930608591849),\n                                    (\"intersectSeptember\", -4.249593539798422),\n                                    (\"minuteday\", -2.9643952955499),\n                                    (\"absorption of , after named dayintersect\",\n                                     -6.121395716700013),\n                                    (\"intersectyear (latent)\", -6.121395716700013),\n                                    (\"Februaryin|during the <part-of-day>\", -6.121395716700013),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.121395716700013),\n                                    (\"time-of-day (latent)July\", -5.428248536140067),\n                                    (\"Saturdayyear (latent)\", -6.121395716700013),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.121395716700013),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.868632748204645),\n                                    (\"at <time-of-day>on <day>\", -5.205104984825858),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -6.121395716700013),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.868632748204645),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.121395716700013),\n                                    (\"from|since|after <time>on <day>\", -5.205104984825858),\n                                    (\"dayweek\", -6.121395716700013),\n                                    (\"Easter Sundayyear (latent)\", -5.715930608591849),\n                                    (\"time-of-day (latent)at <time-of-day>\", -5.428248536140067),\n                                    (\"Thursday<time-of-day> am|pm\", -4.868632748204645),\n                                    (\"weekyear\", -5.715930608591849),\n                                    (\"time-of-day (latent)Thursday\", -5.715930608591849),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.121395716700013),\n                                    (\"<day-of-month> (ordinal)April\", -6.121395716700013),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.715930608591849),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.428248536140067),\n                                    (\"Sundayfrom|since|after <time>\", -6.121395716700013),\n                                    (\"absorption of , after named dayFebruary\", -5.205104984825858),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.715930608591849),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.121395716700013),\n                                    (\"tomorrowat <time-of-day>\", -6.121395716700013),\n                                    (\"daynograin\", -5.715930608591849),\n                                    (\"Fridayin|during <named-month>|year\", -6.121395716700013),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.715930608591849),\n                                    (\"last <cycle> of <time>year (latent)\", -5.715930608591849),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.121395716700013),\n                                    (\"Diwaliyear (latent)\", -5.715930608591849),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.121395716700013),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.205104984825858),\n                                    (\"Fridayyear (latent)\", -5.205104984825858),\n                                    (\"time-of-day (latent)April\", -6.121395716700013)],\n                               n = 302}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mothering Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.329680575332419e-2,\n                               unseen = -5.438079308923196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.2075951699199847e-2),\n                                    (\"intersect 2 numbers\", -4.047427642434349)],\n                               n = 226},\n                   koData =\n                     ClassData{prior = -3.1612467120315646, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"Bank Holiday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4166384087062897, unseen = -5.25227342804663,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2580400255962119),\n                                    (\"month (grain)\", -2.356652314264321),\n                                    (\"year (grain)\", -2.474435349920705),\n                                    (\"week (grain)\", -1.2580400255962119),\n                                    (\"quarter\", -3.6375861597263857), (\"year\", -2.474435349920705),\n                                    (\"month\", -2.356652314264321),\n                                    (\"quarter (grain)\", -3.6375861597263857)],\n                               n = 89},\n                   koData =\n                     ClassData{prior = -1.0766333819493346, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August Bank Holiday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7126409752409464, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6740261391131669, unseen = -4.90527477843843,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15290767158766128),\n                                    (\"integer (0..19)\", -1.9534008207844709)],\n                               n = 132}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.26452876747706405,\n                               unseen = -5.717027701406222,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.767822656454056),\n                                    (\"integer after|past <hour-of-day>\", -4.327438444389479),\n                                    (\"at <time-of-day>\", -2.3815282953341654),\n                                    (\"<time-of-day> o'clock\", -4.61512051684126),\n                                    (\"half after|past <hour-of-day>\", -4.61512051684126),\n                                    (\"second\", -4.61512051684126), (\"hh:mm:ss\", -4.61512051684126),\n                                    (\"<hour-of-day> <integer>\", -4.104294893075269),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.020585624949423),\n                                    (\"time-of-day (latent)\", -1.7063996202768983),\n                                    (\"hhmm (latent)\", -5.020585624949423),\n                                    (\"hh:mm\", -2.3815282953341654),\n                                    (\"quarter after|past <hour-of-day>\", -3.5165082281731497),\n                                    (\"until <time>\", -4.327438444389479),\n                                    (\"about|exactly <time-of-day>\", -5.020585624949423),\n                                    (\"hour\", -1.2593855092558615),\n                                    (\"<time-of-day> sharp|exactly\", -5.020585624949423),\n                                    (\"minute\", -1.68838111477422)],\n                               n = 142},\n                   koData =\n                     ClassData{prior = -1.4591557093847622, unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.2676659890376327),\n                                    (\"from|since|after <time>\", -3.2676659890376327),\n                                    (\"at <time-of-day>\", -3.5553480614894135),\n                                    (\"time-of-day (latent)\", -1.157452788691043),\n                                    (\"hh:mm\", -3.5553480614894135),\n                                    (\"until <time>\", -3.960813169597578),\n                                    (\"hour\", -1.0163741904311376), (\"minute\", -2.70805020110221)],\n                               n = 43}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.21511137961694557, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8803128665695), (\"dd/mm\", -3.3843902633457743),\n                                    (\"absorption of , after named day\", -2.691243082785829),\n                                    (\"intersect\", -2.691243082785829),\n                                    (\"Saturday\", -2.691243082785829),\n                                    (\"Friday\", -2.9789251552376097), (\"day\", -0.8194409058842375),\n                                    (\"the <day-of-month> (ordinal)\", -2.9789251552376097),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.691243082785829)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.6422277352570913,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6582280766035324),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6582280766035324)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thanksgiving Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guy Fawkes Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.276666119016055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 70},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5540343780972276, unseen = -5.420534999272286,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.722953221644475),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.722953221644475),\n                                    (\"dayhour\", -4.31748811353631),\n                                    (\"daymonth\", -2.0149030205422647),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.722953221644475),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4701902531491067),\n                                    (\"Wednesdayintersect\", -4.722953221644475),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3366588605245844),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.722953221644475),\n                                    (\"<part-of-day> of <time>February\", -4.722953221644475),\n                                    (\"Saturday<time-of-day> am|pm\", -4.722953221644475),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.31748811353631),\n                                    (\"hourmonth\", -4.722953221644475),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.029806041084529),\n                                    (\"dayday\", -2.4716614230379794),\n                                    (\"the <day-of-month> (ordinal)February\", -4.31748811353631),\n                                    (\"WednesdayOctober\", -4.722953221644475),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.31748811353631),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4701902531491067),\n                                    (\"dayyear\", -3.8066624897703196),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.722953221644475),\n                                    (\"Thursdayhh:mm\", -4.31748811353631),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -4.722953221644475),\n                                    (\"TuesdayOctober\", -4.722953221644475),\n                                    (\"the <day-of-month> (ordinal)March\", -3.624340932976365),\n                                    (\"Mondaythis|last|next <cycle>\", -3.8066624897703196),\n                                    (\"Fridayintersect\", -4.029806041084529),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.31748811353631),\n                                    (\"intersectOctober\", -4.31748811353631),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.8066624897703196),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.31748811353631),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.722953221644475),\n                                    (\"dayminute\", -2.9311937524164198),\n                                    (\"minuteday\", -3.4701902531491067),\n                                    (\"this|last|next <cycle>Sunday\", -4.722953221644475),\n                                    (\"Sundaythis|last|next <cycle>\", -4.722953221644475),\n                                    (\"on <day><time-of-day> am|pm\", -4.722953221644475),\n                                    (\"intersectintersect\", -4.722953221644475),\n                                    (\"weekday\", -4.722953221644475),\n                                    (\"dayweek\", -3.624340932976365),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.31748811353631),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.8066624897703196),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.029806041084529)],\n                               n = 77},\n                   koData =\n                     ClassData{prior = -0.8547885321163612, unseen = -5.225746673713201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.527208644518379),\n                                    (\"week-endOctober\", -3.834061463958434),\n                                    (\"daymonth\", -1.7863686205931786),\n                                    (\"TuesdaySeptember\", -4.527208644518379),\n                                    (\"Wednesdayintersect\", -4.527208644518379),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.42859635585027),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.527208644518379),\n                                    (\"hournograin\", -4.121743536410215),\n                                    (\"from|since|after <time>July\", -4.121743536410215),\n                                    (\"hourmonth\", -2.581298495463066),\n                                    (\"Fridaythis|last|next <cycle>\", -4.527208644518379),\n                                    (\"SundayFebruary\", -4.527208644518379),\n                                    (\"on <day>September\", -3.834061463958434),\n                                    (\"WednesdayOctober\", -4.527208644518379),\n                                    (\"intersectnow\", -4.121743536410215),\n                                    (\"week-endintersect\", -4.527208644518379),\n                                    (\"dayyear\", -4.527208644518379),\n                                    (\"FridayJuly\", -3.6109179126442243),\n                                    (\"FridaySeptember\", -4.121743536410215),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6109179126442243),\n                                    (\"WednesdayFebruary\", -4.527208644518379),\n                                    (\"minutemonth\", -3.0231312477421053),\n                                    (\"Mondaythis|last|next <cycle>\", -4.527208644518379),\n                                    (\"SundayMarch\", -4.527208644518379),\n                                    (\"MondayFebruary\", -4.121743536410215),\n                                    (\"Fridayintersect\", -4.527208644518379),\n                                    (\"intersectOctober\", -4.527208644518379),\n                                    (\"dayminute\", -4.527208644518379),\n                                    (\"SaturdaySeptember\", -4.527208644518379),\n                                    (\"intersectSeptember\", -3.1409142833984887),\n                                    (\"Tuesdaynow\", -4.121743536410215),\n                                    (\"MondayMarch\", -4.527208644518379),\n                                    (\"FridayOctober\", -4.527208644518379),\n                                    (\"daynograin\", -4.121743536410215),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.527208644518379),\n                                    (\"Tuesdayintersect\", -4.527208644518379),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.527208644518379),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.527208644518379),\n                                    (\"Sundayintersect\", -4.527208644518379)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5978370007556204, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Father's Day\", -2.8622008809294686),\n                                    (\"Martin Luther King's Day\", -2.8622008809294686),\n                                    (\"Mothering Sunday\", -2.8622008809294686),\n                                    (\"day\", -1.157452788691043), (\"Sunday\", -2.8622008809294686),\n                                    (\"Chinese New Year\", -2.169053700369523),\n                                    (\"Thanksgiving Day\", -2.8622008809294686),\n                                    (\"Easter Sunday\", -2.8622008809294686),\n                                    (\"hour\", -2.8622008809294686), (\"Tuesday\", -2.8622008809294686),\n                                    (\"week-end\", -2.8622008809294686)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.7985076962177716,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.740840023925201), (\"Friday\", -2.3353749158170367),\n                                    (\"day\", -1.824549292051046), (\"Sunday\", -2.740840023925201),\n                                    (\"hour\", -1.6422277352570913),\n                                    (\"week-end\", -1.6422277352570913)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd.mm.yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.1972245773362196),\n                                    (\"Halloween\", -2.890371757896165),\n                                    (\"Boss's Day\", -2.890371757896165),\n                                    (\"Mothering Sunday\", -2.890371757896165),\n                                    (\"Monday\", -2.4849066497880004), (\"day\", -1.0986122886681098),\n                                    (\"Thanksgiving Day\", -2.890371757896165),\n                                    (\"March\", -2.890371757896165), (\"month\", -2.890371757896165),\n                                    (\"Tuesday\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.0794415416798357),\n                                    (\"Saturday\", -2.0794415416798357),\n                                    (\"day\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -4.652001563489282e-2),\n                                    (\"integer (0..19)\", -3.0910424533583156)],\n                               n = 42}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1512560221535317, unseen = -4.68213122712422,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.0633909220278057),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"minuteminute\", -1.6770965609079151),\n                                    (\"<time> timezone<time> timezone\", -3.2865344733420154),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.979681653901961),\n                                    (\"hh:mmhh:mm\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"hhhmmhhhmm\", -3.0633909220278057),\n                                    (\"hourhour\", -2.4756042571256867),\n                                    (\"minutehour\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.979681653901961),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"hoursecond\", -3.5742165457937967),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -3.0633909220278057)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.3801473001238745, unseen = -5.267858159063328,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.164077900236776),\n                                    (\"<time> timezonehhhmm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.56954300834494),\n                                    (\"until <time>time-of-day (latent)\", -3.316780039849572),\n                                    (\"from|since|after <time>hh:mm\", -4.56954300834494),\n                                    (\"hh:mmtime-of-day (latent)\", -2.4901014666651045),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1832486472250494),\n                                    (\"minuteminute\", -2.4901014666651045),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.653252276470785),\n                                    (\"hh:mmhh:mm\", -3.876395827784995),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.164077900236776),\n                                    (\"hhhmmhhhmm\", -4.164077900236776),\n                                    (\"at <time-of-day><time-of-day> am|pm\", -4.56954300834494),\n                                    (\"hourhour\", -2.0045936508834035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.876395827784995),\n                                    (\"hourminute\", -3.4709307196768306),\n                                    (\"minutehour\", -1.6791712504487755),\n                                    (\"<time> timezonehh:mm\", -4.56954300834494),\n                                    (\"hh:mm<time> timezone\", -4.56954300834494),\n                                    (\"hhhmmtime-of-day (latent)\", -3.876395827784995),\n                                    (\"until <time><time-of-day> am|pm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.56954300834494),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.876395827784995),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.065465611568666),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.653252276470785),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.876395827784995),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.876395827784995)],\n                               n = 80}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.890371757896165),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.4849066497880004),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"dayyear\", -0.8754687373538999),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -2.890371757896165),\n                                    (\"intersectyear (latent)\", -2.1972245773362196),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.9740810260220096)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.6094379124341003),\n                                    (\"dayyear\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.639057329615259),\n                                    (\"Martin Luther King's Day\", -2.639057329615259),\n                                    (\"Monday\", -2.639057329615259), (\"day\", -1.1349799328389845),\n                                    (\"Thanksgiving Day\", -2.639057329615259),\n                                    (\"Christmas\", -2.639057329615259), (\"hour\", -2.639057329615259),\n                                    (\"winter\", -2.639057329615259),\n                                    (\"week-end\", -2.639057329615259),\n                                    (\"summer\", -2.2335922215070942)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}})]", "num_lines": 4193}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_IE (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"Thursdaydd/mm\", -6.07993319509559),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_IN (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"Thursdaydd/mm\", -6.07993319509559),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_JM (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"Thursdaydd/mm\", -6.07993319509559),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_NZ (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"Thursdaydd/mm\", -6.07993319509559),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_PH (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"Thursdaymm/dd\", -6.07993319509559),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mm/dd\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_TT (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"Thursdaydd/mm\", -6.07993319509559),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_US (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Military Spouse Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5300783472814723, unseen = -6.285998094508865,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 535},\n                   koData =\n                     ClassData{prior = -0.8880892967629469, unseen = -5.929589143389895,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 374}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0986122886681098),\n                                    (\"dayyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.0986122886681098),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Sundayyear (latent)\",\n                                     -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.10008345855698253,\n                               unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003), (\"day\", -1.8607523407150064),\n                                    (\"year\", -2.4203681286504293),\n                                    (\"<integer> <unit-of-duration>\", -1.0340737675305385),\n                                    (\"a <unit-of-duration>\", -2.70805020110221),\n                                    (\"month\", -2.70805020110221), (\"fortnight\", -2.70805020110221)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -2.3513752571634776,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.2992829841302609),\n                                    (\"<integer> <unit-of-duration>\", -1.2992829841302609)],\n                               n = 2}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Father's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6945957207744071, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.2029408439966903,\n                               unseen = -5.6240175061873385,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -4.01096295328305),\n                                    (\"week\", -4.927253685157205),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.927253685157205),\n                                    (\"today\", -4.927253685157205),\n                                    (\"intersect\", -3.2225055929187794),\n                                    (\"year (latent)\", -4.927253685157205),\n                                    (\"<time> for <duration>\", -4.23410650459726),\n                                    (\"second\", -4.927253685157205), (\"now\", -3.317815772723104),\n                                    (\"tomorrow\", -4.5217885770490405),\n                                    (\"this|last|next <cycle>\", -4.5217885770490405),\n                                    (\"day\", -1.8137383759468302),\n                                    (\"the <day-of-month> (ordinal)\", -4.5217885770490405),\n                                    (\"the <day-of-month> (number)\", -3.5409593240373143),\n                                    (\"time-of-day (latent)\", -2.4849066497880004),\n                                    (\"year\", -4.5217885770490405),\n                                    (\"<time-of-day> am|pm\", -4.23410650459726),\n                                    (\"hh:mm\", -4.5217885770490405), (\"nograin\", -3.317815772723104),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.5217885770490405),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.927253685157205),\n                                    (\"<day-of-month> (ordinal)\", -3.828641396489095),\n                                    (\"Easter Sunday\", -4.927253685157205),\n                                    (\"Christmas\", -4.23410650459726), (\"hour\", -2.324563999712821),\n                                    (\"month\", -4.927253685157205),\n                                    (\"<datetime> - <datetime> (interval)\", -2.7300291078209855),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.981343536101891),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.5217885770490405),\n                                    (\"minute\", -2.0094829530729257),\n                                    (\"right now\", -4.927253685157205),\n                                    (\"<month> dd-dd (interval)\", -4.23410650459726),\n                                    (\"part of days\", -4.927253685157205),\n                                    (\"dd-dd <month> (interval)\", -4.5217885770490405)],\n                               n = 120}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"Cyber Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.2744368457017603, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2336148511815052, unseen = -5.327876168789581,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.9367156180185177),\n                                    (\"noon|midnight|EOD|end of day\", -4.2243976904702984),\n                                    (\"integer after|past <hour-of-day>\", -3.9367156180185177),\n                                    (\"<time-of-day> o'clock\", -4.629862798578463),\n                                    (\"half after|past <hour-of-day>\", -4.629862798578463),\n                                    (\"hhhmm\", -3.713572066704308),\n                                    (\"<hour-of-day> <integer>\", -3.9367156180185177),\n                                    (\"time-of-day (latent)\", -1.6594483330087617),\n                                    (\"hhmm (latent)\", -3.9367156180185177),\n                                    (\"<time-of-day> am|pm\", -1.9908054689632042),\n                                    (\"hh:mm\", -3.2435684374585723),\n                                    (\"about|exactly <time-of-day>\", -4.2243976904702984),\n                                    (\"hour\", -1.1333552371119826),\n                                    (\"<time-of-day> sharp|exactly\", -4.629862798578463),\n                                    (\"minute\", -1.889022774653262)],\n                               n = 95},\n                   koData =\n                     ClassData{prior = -1.5686159179138452, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9963334395476915),\n                                    (\"<time-of-day> am|pm\", -3.0757749812275272),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 25}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1834457647002796e-2,\n                               unseen = -4.454347296253507,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 84},\n                   koData =\n                     ClassData{prior = -4.442651256490317, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -2.03688192726104),\n                                    (\"October\", -3.1354942159291497),\n                                    (\"year (latent)\", -1.2636920390275583),\n                                    (\"year\", -0.9382696385929302), (\"March\", -2.7300291078209855),\n                                    (\"month\", -2.4423470353692043)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.16034265007517937,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -1.9095425048844386,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.833213344056216), (\"quarter\", -2.833213344056216),\n                                    (\"year\", -1.580450375560848),\n                                    (\"<integer> <unit-of-duration>\", -1.580450375560848),\n                                    (\"a <unit-of-duration>\", -2.4277482359480516)],\n                               n = 8}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.3862943611198906),\n                                    (\"dayyear\", -2.4849066497880004),\n                                    (\"Super Tuesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -2.4849066497880004),\n                                    (\"Christmastoday\", -2.4849066497880004),\n                                    (\"Super TuesdayMini-Tuesday\", -2.4849066497880004),\n                                    (\"Super Tuesdayyear (latent)\", -2.4849066497880004),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"Super TuesdayMarch\", -2.1972245773362196),\n                                    (\"MondayOctober\", -2.1972245773362196),\n                                    (\"dayday\", -2.1972245773362196),\n                                    (\"Super Tuesday<named-month> <day-of-month> (non ordinal)\",\n                                     -2.1972245773362196)],\n                               n = 3}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -1.0116009116784799),\n                                    (\"Tax Day<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Mini-Tuesday<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"Diwali<integer> <unit-of-duration>\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesday<integer> <unit-of-duration>\", -1.252762968495368),\n                                    (\"dayyear\", -1.252762968495368)],\n                               n = 1}}),\n       (\"Daylight Saving Start Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.44737150540954457,\n                               unseen = -7.271008538280992,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.5771657055190795),\n                                    (\"Father's Dayyear (latent)\", -6.5771657055190795),\n                                    (\"Karva Chauthyear (latent)\", -6.5771657055190795),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.5771657055190795),\n                                    (\"Maha Shivaratriyear (latent)\", -6.5771657055190795),\n                                    (\"Ramadanyear (latent)\", -5.3244027370237115),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.190871344399189),\n                                    (\"Military Spouse Dayyear (latent)\", -6.5771657055190795),\n                                    (\"Bhai Doojyear (latent)\", -6.5771657055190795),\n                                    (\"hourday\", -4.562262684976815),\n                                    (\"dayhour\", -3.5326432677956565),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.190871344399189),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.171700597410915),\n                                    (\"Shemini Atzeretyear (latent)\", -6.5771657055190795),\n                                    (\"daymonth\", -4.562262684976815),\n                                    (\"monthday\", -6.171700597410915),\n                                    (\"monthyear\", -4.785406236291025),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.5771657055190795),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.171700597410915),\n                                    (\"Vijayadashamiyear (latent)\", -6.5771657055190795),\n                                    (\"Administrative Professionals' Dayyear (latent)\",\n                                     -5.190871344399189),\n                                    (\"Thanksgiving Dayyear (latent)\", -5.47855341685097),\n                                    (\"Thai Pongalyear (latent)\", -5.884018524959134),\n                                    (\"Thiru Onamyear (latent)\", -5.884018524959134),\n                                    (\"hhhmmabsorption of , after named day\", -6.5771657055190795),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.5771657055190795),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.660874973644924),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.5771657055190795),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.171700597410915),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.5771657055190795),\n                                    (\"houryear\", -5.660874973644924),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.5771657055190795),\n                                    (\"Christmas<time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.5771657055190795),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.884018524959134),\n                                    (\"intersectin|during <named-month>|year\", -6.5771657055190795),\n                                    (\"<time-of-day> am|pmintersect\", -5.3244027370237115),\n                                    (\"Earth Houryear (latent)\", -6.5771657055190795),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.5771657055190795),\n                                    (\"Octoberyear (latent)\", -5.073088308742806),\n                                    (\"intersect<time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"Mattu Pongalyear (latent)\", -6.5771657055190795),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.5771657055190795),\n                                    (\"Daylight Saving Start Dayyear (latent)\", -5.660874973644924),\n                                    (\"Shavuotyear (latent)\", -6.5771657055190795),\n                                    (\"Parsi New Yearyear (latent)\", -5.660874973644924),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.5771657055190795),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -6.5771657055190795),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"todayin|within|after <duration>\", -6.5771657055190795),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.171700597410915),\n                                    (\"Marchyear (latent)\", -6.5771657055190795),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.171700597410915),\n                                    (\"Sukkotyear (latent)\", -6.171700597410915),\n                                    (\"hhhmmintersect\", -6.171700597410915),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.171700597410915),\n                                    (\"Daylight Saving End Dayyear (latent)\", -5.660874973644924),\n                                    (\"Clean Mondayyear (latent)\", -6.171700597410915),\n                                    (\"the <day-of-month> (ordinal)Sunday\", -6.5771657055190795),\n                                    (\"monthhour\", -6.171700597410915),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.660874973644924),\n                                    (\"todayat <time-of-day>\", -6.5771657055190795),\n                                    (\"Thursday<time> timezone\", -4.179270432720709),\n                                    (\"tonight<time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"time-of-day (latent)tonight\", -6.171700597410915),\n                                    (\"from|since|after <time>December\", -6.5771657055190795),\n                                    (\"Emergency Medical Services for Children Dayyear (latent)\",\n                                     -6.5771657055190795),\n                                    (\"<time-of-day> am|pmon <day>\", -4.562262684976815),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.5771657055190795),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.171700597410915),\n                                    (\"Tax Daythis|last|next <cycle>\", -6.5771657055190795),\n                                    (\"dayday\", -3.7439523614628634),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.171700597410915),\n                                    (\"mm/ddat <time-of-day>\", -6.5771657055190795),\n                                    (\"tonightat <time-of-day>\", -5.47855341685097),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.884018524959134),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.5771657055190795),\n                                    (\"today<time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.171700597410915),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.5771657055190795),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.171700597410915),\n                                    (\"mm/dd<time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"hourhour\", -3.6067512399493786),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.171700597410915),\n                                    (\"Navaratriin|during <named-month>|year\", -6.5771657055190795),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.5771657055190795),\n                                    (\"Lentyear (latent)\", -6.5771657055190795),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.705363528617489),\n                                    (\"Boghiyear (latent)\", -6.5771657055190795),\n                                    (\"dayyear\", -1.7980422124075501),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.5771657055190795),\n                                    (\"Thursdayfrom|since|after <time>\", -6.171700597410915),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.5771657055190795),\n                                    (\"Thursdayat <time-of-day>\", -5.884018524959134),\n                                    (\"Islamic New Yearyear (latent)\", -6.171700597410915),\n                                    (\"Laylat al-Qadryear (latent)\", -5.660874973644924),\n                                    (\"part of days<time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.5771657055190795),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.884018524959134),\n                                    (\"hourminute\", -6.171700597410915),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.660874973644924),\n                                    (\"Yom Kippuryear (latent)\", -6.5771657055190795),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.884018524959134),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.5771657055190795),\n                                    (\"minutehour\", -5.3244027370237115),\n                                    (\"Kaanum Pongalyear (latent)\", -6.171700597410915),\n                                    (\"Maha Saptamiyear (latent)\", -6.5771657055190795),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.884018524959134),\n                                    (\"time-of-day (latent)tomorrow\", -5.660874973644924),\n                                    (\"part of daysat <time-of-day>\", -4.967727793084979),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.562262684976815),\n                                    (\"for <duration> from <time>December\", -6.5771657055190795),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.5771657055190795),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.3244027370237115),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.3244027370237115),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.5771657055190795),\n                                    (\"Pentecostyear (latent)\", -6.5771657055190795),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.3244027370237115),\n                                    (\"<day-of-month> (ordinal)February\", -6.5771657055190795),\n                                    (\"Eid al-Fitryear (latent)\", -5.190871344399189),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.5771657055190795),\n                                    (\"Mini-Tuesday<duration> hence|ago\", -6.5771657055190795),\n                                    (\"Mondayin|during the <part-of-day>\", -6.5771657055190795),\n                                    (\"Chhathin|during <named-month>|year\", -6.5771657055190795),\n                                    (\"Diwaliin|during <named-month>|year\", -6.5771657055190795),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.5771657055190795),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.3244027370237115),\n                                    (\"Raksha Bandhanyear (latent)\", -6.5771657055190795),\n                                    (\"daysecond\", -6.171700597410915),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.171700597410915),\n                                    (\"Emancipation Dayyear (latent)\", -5.884018524959134),\n                                    (\"Ratha-Yatrayear (latent)\", -6.5771657055190795),\n                                    (\"Ashurayear (latent)\", -6.5771657055190795),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.5771657055190795),\n                                    (\"Chinese New Yearyear (latent)\", -6.5771657055190795),\n                                    (\"tomorrowintersect\", -6.5771657055190795),\n                                    (\"Lag BaOmeryear (latent)\", -6.5771657055190795),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.5771657055190795),\n                                    (\"Eid al-Adhayear (latent)\", -4.437099542022809),\n                                    (\"intersectin|during the <part-of-day>\", -6.5771657055190795),\n                                    (\"Palm Sundayyear (latent)\", -6.5771657055190795),\n                                    (\"Christmasat <time-of-day>\", -6.5771657055190795),\n                                    (\"Passoveryear (latent)\", -6.5771657055190795),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.5771657055190795),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.5771657055190795),\n                                    (\"Cyber Mondayyear (latent)\", -6.171700597410915),\n                                    (\"hhhmmon <day>\", -5.660874973644924),\n                                    (\"Yom HaShoahyear (latent)\", -6.171700597410915),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.171700597410915),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.5771657055190795),\n                                    (\"Septemberyear (latent)\", -6.171700597410915),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -5.073088308742806),\n                                    (\"Halloweenyear (latent)\", -6.5771657055190795),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.171700597410915),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.884018524959134),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.5771657055190795),\n                                    (\"at <time-of-day>intersect\", -5.660874973644924),\n                                    (\"Rosh Hashanahyear (latent)\", -5.884018524959134),\n                                    (\"Super Tuesdayyear (latent)\", -5.660874973644924),\n                                    (\"Dhanterasyear (latent)\", -6.5771657055190795),\n                                    (\"Tu BiShvatyear (latent)\", -6.5771657055190795),\n                                    (\"<day-of-month> (ordinal)December\", -5.884018524959134),\n                                    (\"Holiyear (latent)\", -5.884018524959134),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.5771657055190795),\n                                    (\"Holika Dahanyear (latent)\", -5.884018524959134),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.171700597410915),\n                                    (\"dayminute\", -3.2272616182444747),\n                                    (\"Mawlidyear (latent)\", -6.5771657055190795),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.171700597410915),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.5771657055190795),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.660874973644924),\n                                    (\"minuteday\", -2.8276616295887087),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.884018524959134),\n                                    (\"intersectyear (latent)\", -6.5771657055190795),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.5771657055190795),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.5771657055190795),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.5771657055190795),\n                                    (\"Mini-Tuesdayyear (latent)\", -6.5771657055190795),\n                                    (\"intersecthhhmm\", -6.171700597410915),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.5771657055190795),\n                                    (\"Boss's Dayyear (latent)\", -6.171700597410915),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.5771657055190795),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.5771657055190795),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.5771657055190795),\n                                    (\"Super Tuesdayin|during <named-month>|year\",\n                                     -6.5771657055190795),\n                                    (\"tonight<time-of-day> o'clock\", -6.5771657055190795),\n                                    (\"Tisha B'Avyear (latent)\", -6.5771657055190795),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.660874973644924),\n                                    (\"at <time-of-day>on <day>\", -4.967727793084979),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.171700597410915),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.884018524959134),\n                                    (\"Christmasyear (latent)\", -6.171700597410915),\n                                    (\"Saturdayintersect\", -6.5771657055190795),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.171700597410915),\n                                    (\"Thai Pongalin|during <named-month>|year\",\n                                     -6.5771657055190795),\n                                    (\"Emergency Medical Services Weekyear (latent)\",\n                                     -6.5771657055190795),\n                                    (\"dayweek\", -6.5771657055190795),\n                                    (\"Easter Sundayyear (latent)\", -5.884018524959134),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.171700597410915),\n                                    (\"weekyear\", -5.47855341685097),\n                                    (\"Super Tuesdaythis|last|next <cycle>\", -6.5771657055190795),\n                                    (\"King's Dayyear (latent)\", -5.073088308742806),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.660874973644924),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.171700597410915),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.884018524959134),\n                                    (\"Hanukkahyear (latent)\", -5.884018524959134),\n                                    (\"Rama Navamiyear (latent)\", -6.5771657055190795),\n                                    (\"February<time> <part-of-day>\", -6.5771657055190795),\n                                    (\"National Grandparents Dayyear (latent)\", -6.5771657055190795),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.884018524959134),\n                                    (\"Great Lentyear (latent)\", -6.5771657055190795),\n                                    (\"tomorrowat <time-of-day>\", -5.884018524959134),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.5771657055190795),\n                                    (\"Labor Dayyear (latent)\", -6.5771657055190795),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.171700597410915),\n                                    (\"Ugadiyear (latent)\", -5.190871344399189),\n                                    (\"Vaisakhiyear (latent)\", -5.884018524959134),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.884018524959134),\n                                    (\"last <cycle> of <time>year (latent)\", -5.884018524959134),\n                                    (\"at <time-of-day>tomorrow\", -6.171700597410915),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.5771657055190795),\n                                    (\"President's Dayyear (latent)\", -6.5771657055190795),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.5771657055190795),\n                                    (\"Diwaliyear (latent)\", -6.5771657055190795),\n                                    (\"between <time> and <time>on <day>\", -6.171700597410915),\n                                    (\"Black Fridayyear (latent)\", -6.171700597410915),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.5771657055190795),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.5771657055190795),\n                                    (\"Chhathyear (latent)\", -6.171700597410915),\n                                    (\"Vasant Panchamiyear (latent)\", -6.5771657055190795),\n                                    (\"Tax Dayyear (latent)\", -5.47855341685097),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.3244027370237115),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.3244027370237115),\n                                    (\"St Patrick's Dayyear (latent)\", -6.5771657055190795),\n                                    (\"Thursday<time> (timezone)\", -6.5771657055190795),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.5771657055190795),\n                                    (\"Pargat Diwasyear (latent)\", -5.3244027370237115),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.171700597410915),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.884018524959134),\n                                    (\"Februaryintersect\", -6.5771657055190795),\n                                    (\"Mother's Dayyear (latent)\", -6.5771657055190795),\n                                    (\"Simchat Torahyear (latent)\", -6.5771657055190795),\n                                    (\"minuteyear\", -6.5771657055190795)],\n                               n = 553},\n                   koData =\n                     ClassData{prior = -1.019726319122397, unseen = -6.862757913051402,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.664486763144511),\n                                    (\"hourday\", -3.5658744744764013),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.168564159920785),\n                                    (\"<day-of-month> (ordinal)August\", -6.168564159920785),\n                                    (\"dayhour\", -3.4944155104942562),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.25227342804663),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.069951871252675),\n                                    (\"daymonth\", -3.460513958818575),\n                                    (\"hourquarter\", -5.25227342804663),\n                                    (\"monthyear\", -4.915801191425417),\n                                    (\"Thai Pongalyear (latent)\", -5.47541697936084),\n                                    (\"intersecthh:mm\", -6.168564159920785),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.76309905181262),\n                                    (\"<datetime> - <datetime> (interval)Sunday\", -5.76309905181262),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.168564159920785),\n                                    (\"houryear\", -4.782269798800894),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.168564159920785),\n                                    (\"<day-of-month> (ordinal)October\", -6.168564159920785),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.47541697936084),\n                                    (\"hournograin\", -4.915801191425417),\n                                    (\"<time-of-day> am|pmintersect\", -4.915801191425417),\n                                    (\"Octoberyear (latent)\", -6.168564159920785),\n                                    (\"Good Fridayyear (latent)\", -5.76309905181262),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.76309905181262),\n                                    (\"early morningat <time-of-day>\", -6.168564159920785),\n                                    (\"until <time>on <day>\", -5.47541697936084),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.168564159920785),\n                                    (\"time-of-day (latent)intersect\", -5.47541697936084),\n                                    (\"todayin <number> (implicit minutes)\", -6.168564159920785),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.168564159920785),\n                                    (\"hh:mmon <day>\", -4.915801191425417),\n                                    (\"hhhmmintersect\", -5.76309905181262),\n                                    (\"absorption of , after named dayJuly\", -5.25227342804663),\n                                    (\"from|since|after <time>July\", -5.76309905181262),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.25227342804663),\n                                    (\"Clean Mondayyear (latent)\", -6.168564159920785),\n                                    (\"monthhour\", -6.168564159920785),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.76309905181262),\n                                    (\"hourmonth\", -4.028497996424514),\n                                    (\"todayat <time-of-day>\", -6.168564159920785),\n                                    (\"from|since|after <time>December\", -6.168564159920785),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.168564159920785),\n                                    (\"<time-of-day> am|pmon <day>\", -4.915801191425417),\n                                    (\"Mondayyear (latent)\", -5.069951871252675),\n                                    (\"dayday\", -3.8171889027573074),\n                                    (\"mm/ddat <time-of-day>\", -5.76309905181262),\n                                    (\"on <day>September\", -5.47541697936084),\n                                    (\"time-of-day (latent)September\", -5.76309905181262),\n                                    (\"hourhour\", -4.089122618240949),\n                                    (\"time-of-day (latent)on <day>\", -4.664486763144511),\n                                    (\"<datetime> - <datetime> (interval)year (latent)\",\n                                     -6.168564159920785),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.76309905181262),\n                                    (\"dayyear\", -3.0115637387706715),\n                                    (\"Thursdaymm/dd\", -6.168564159920785),\n                                    (\"New Year's Dayyear (latent)\", -5.25227342804663),\n                                    (\"Tuesdayyear (latent)\", -5.069951871252675),\n                                    (\"time-of-day (latent)Sunday\", -5.76309905181262),\n                                    (\"Thursdayfrom|since|after <time>\", -4.46381606768236),\n                                    (\"Thursdayat <time-of-day>\", -4.5591262474866845),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.168564159920785),\n                                    (\"Aprilyear (latent)\", -6.168564159920785),\n                                    (\"the <day-of-month> (ordinal)July\", -6.168564159920785),\n                                    (\"the <day-of-month> (number)July\", -6.168564159920785),\n                                    (\"monthminute\", -6.168564159920785),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.76309905181262),\n                                    (\"Thursdayhh:mm\", -5.25227342804663),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.76309905181262),\n                                    (\"minutemonth\", -4.028497996424514),\n                                    (\"time-of-day (latent)Friday\", -5.76309905181262),\n                                    (\"minutehour\", -6.168564159920785),\n                                    (\"Tuesdayin <number> (implicit minutes)\", -6.168564159920785),\n                                    (\"part of daysat <time-of-day>\", -5.069951871252675),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.8171889027573074),\n                                    (\"<day-of-month> (ordinal)Sunday\", -6.168564159920785),\n                                    (\"Augustyear (latent)\", -5.76309905181262),\n                                    (\"week-endin|during <named-month>|year\", -6.168564159920785),\n                                    (\"time-of-day (latent)Tuesday\", -5.76309905181262),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -6.168564159920785),\n                                    (\"mm/dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.76309905181262),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.168564159920785),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.168564159920785),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.168564159920785),\n                                    (\"Sundayyear (latent)\", -5.25227342804663),\n                                    (\"hourweek\", -5.25227342804663),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.47541697936084),\n                                    (\"Christmasat <time-of-day>\", -6.168564159920785),\n                                    (\"from|since|after <time>year (latent)\", -5.76309905181262),\n                                    (\"hhhmmon <day>\", -5.25227342804663),\n                                    (\"yesterday<time-of-day> am|pm\", -6.168564159920785),\n                                    (\"<day-of-month> (ordinal)July\", -5.47541697936084),\n                                    (\"Tuesday<duration> hence|ago\", -6.168564159920785),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.168564159920785),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.168564159920785),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.168564159920785),\n                                    (\"Tuesdaythis|last|next <cycle>\", -6.168564159920785),\n                                    (\"at <time-of-day>intersect\", -5.25227342804663),\n                                    (\"Holiyear (latent)\", -6.168564159920785),\n                                    (\"until <time><time-of-day> am|pm\", -6.168564159920785),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.76309905181262),\n                                    (\"dayminute\", -3.2781924020246205),\n                                    (\"yyyy-mm-ddhh:mm\", -5.76309905181262),\n                                    (\"intersectfrom|since|after <time>\", -5.76309905181262),\n                                    (\"intersectSeptember\", -4.296761983019193),\n                                    (\"minuteday\", -3.0115637387706715),\n                                    (\"absorption of , after named dayintersect\",\n                                     -6.168564159920785),\n                                    (\"intersectyear (latent)\", -6.168564159920785),\n                                    (\"Februaryin|during the <part-of-day>\", -6.168564159920785),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.168564159920785),\n                                    (\"time-of-day (latent)July\", -5.47541697936084),\n                                    (\"Saturdayyear (latent)\", -6.168564159920785),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.168564159920785),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.915801191425417),\n                                    (\"at <time-of-day>on <day>\", -5.25227342804663),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.915801191425417),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.168564159920785),\n                                    (\"from|since|after <time>on <day>\", -5.25227342804663),\n                                    (\"dayweek\", -6.168564159920785),\n                                    (\"Easter Sundayyear (latent)\", -5.76309905181262),\n                                    (\"Thursday<time-of-day> am|pm\", -4.915801191425417),\n                                    (\"weekyear\", -5.76309905181262),\n                                    (\"time-of-day (latent)Thursday\", -5.76309905181262),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.168564159920785),\n                                    (\"<day-of-month> (ordinal)April\", -6.168564159920785),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.76309905181262),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.47541697936084),\n                                    (\"Sundayfrom|since|after <time>\", -6.168564159920785),\n                                    (\"absorption of , after named dayFebruary\", -5.25227342804663),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.76309905181262),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.168564159920785),\n                                    (\"tomorrowat <time-of-day>\", -6.168564159920785),\n                                    (\"daynograin\", -5.76309905181262),\n                                    (\"Fridayin|during <named-month>|year\", -6.168564159920785),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.76309905181262),\n                                    (\"last <cycle> of <time>year (latent)\", -5.76309905181262),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.168564159920785),\n                                    (\"Diwaliyear (latent)\", -5.76309905181262),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.168564159920785),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.25227342804663),\n                                    (\"Fridayyear (latent)\", -5.25227342804663),\n                                    (\"Tuesdayin|within|after <duration>\", -6.168564159920785),\n                                    (\"time-of-day (latent)April\", -6.168564159920785)],\n                               n = 312}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2318016140573243),\n                                    (\"integer (0..19)\", -1.575536360758419)],\n                               n = 27}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mini-Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -3.7179003241754015e-2,\n                               unseen = -5.5909869805108565,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.8904154639152723e-2),\n                                    (\"intersect 2 numbers\", -4.200954297280359)],\n                               n = 264},\n                   koData =\n                     ClassData{prior = -3.3105430133940246, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Memorial Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.322773392263051, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.2878542883066382,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lincoln's Birthday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Emergency Medical Services for Children Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.995732273553991),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.995732273553991),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.995732273553991),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.5902671654458267),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.5902671654458267),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.742969305058623),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.5902671654458267)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Sundayyear (latent)\",\n                                     -1.791759469228055)],\n                               n = 1}}),\n       (\"Siblings Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"National Grandparents Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Loyalty Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tax Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Groundhog Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4125322753312568, unseen = -5.303304908059076,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3093333199837622),\n                                    (\"month (grain)\", -2.4079456086518722),\n                                    (\"year (grain)\", -2.2537949288246137),\n                                    (\"week (grain)\", -1.3093333199837622),\n                                    (\"quarter\", -3.6888794541139363), (\"year\", -2.2537949288246137),\n                                    (\"month\", -2.4079456086518722),\n                                    (\"quarter (grain)\", -3.6888794541139363)],\n                               n = 94},\n                   koData =\n                     ClassData{prior = -1.08462604669337, unseen = -4.6913478822291435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8489178830680035),\n                                    (\"month (grain)\", -2.4849066497880004),\n                                    (\"year (grain)\", -3.0726933146901194),\n                                    (\"second\", -2.7362210780689065),\n                                    (\"week (grain)\", -1.8489178830680035),\n                                    (\"day\", -2.2842359543258492), (\"quarter\", -3.0726933146901194),\n                                    (\"year\", -3.0726933146901194),\n                                    (\"second (grain) \", -2.7362210780689065),\n                                    (\"month\", -2.4849066497880004),\n                                    (\"quarter (grain)\", -3.0726933146901194),\n                                    (\"day (grain)\", -2.2842359543258492)],\n                               n = 48}}),\n       (\"Mother's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6225296133459919,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3862943611198906),\n                                    (\"ordinal (digits)\", -0.2876820724517809)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -0.7691330875378672,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5596157879354228),\n                                    (\"ordinal (digits)\", -0.8472978603872037)],\n                               n = 19}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Emancipation Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"the nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Super Tuesdayyear (latent)\",\n                                     -1.252762968495368),\n                                    (\"dayyear\", -0.8472978603872037),\n                                    (\"ordinal (digits)Super Tuesdaythis|last|next <cycle>\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7087724984630261, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6777622617204658, unseen = -4.897839799950911,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15415067982725836),\n                                    (\"integer (0..19)\", -1.9459101490553135)],\n                               n = 131}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5962052353677147,\n                               unseen = -5.3471075307174685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.7032769223495525),\n                                    (\"integer (0..19)year (grain)\", -2.9444389791664407),\n                                    (\"integer (numeric)day (grain)\", -2.7032769223495525),\n                                    (\"integer (0..19)second (grain) \", -3.9560398908449206),\n                                    (\"integer (0..19)hour (grain)\", -3.1451096746285914),\n                                    (\"second\", -3.550574782736756),\n                                    (\"integer (numeric)second (grain) \", -4.243721963296701),\n                                    (\"integer (numeric)year (grain)\", -3.262892710284975),\n                                    (\"day\", -2.4519624940686464), (\"year\", -2.4519624940686464),\n                                    (\"integer (numeric)week (grain)\", -3.262892710284975),\n                                    (\"integer (0..19)month (grain)\", -3.7328963395307104),\n                                    (\"integer (20..90)minute (grain)\", -4.6491870714048655),\n                                    (\"hour\", -2.777384894503274), (\"month\", -3.3964241029094975),\n                                    (\"integer (numeric)minute (grain)\", -2.634284050862601),\n                                    (\"integer (0..19)minute (grain)\", -3.262892710284975),\n                                    (\"integer (numeric)month (grain)\", -4.243721963296701),\n                                    (\"minute\", -2.2068400360356613),\n                                    (\"integer (numeric)hour (grain)\", -3.7328963395307104),\n                                    (\"integer (0..19)day (grain)\", -3.7328963395307104),\n                                    (\"integer (0..19)week (grain)\", -3.3964241029094975)],\n                               n = 92},\n                   koData =\n                     ClassData{prior = -0.8005056988804446, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.26452876747706405,\n                               unseen = -5.717027701406222,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.767822656454056),\n                                    (\"integer after|past <hour-of-day>\", -4.327438444389479),\n                                    (\"at <time-of-day>\", -2.3815282953341654),\n                                    (\"<time-of-day> o'clock\", -4.61512051684126),\n                                    (\"half after|past <hour-of-day>\", -4.61512051684126),\n                                    (\"second\", -4.61512051684126), (\"hh:mm:ss\", -4.61512051684126),\n                                    (\"<hour-of-day> <integer>\", -4.104294893075269),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.020585624949423),\n                                    (\"time-of-day (latent)\", -1.7063996202768983),\n                                    (\"hhmm (latent)\", -5.020585624949423),\n                                    (\"hh:mm\", -2.3815282953341654),\n                                    (\"quarter after|past <hour-of-day>\", -3.5165082281731497),\n                                    (\"until <time>\", -4.327438444389479),\n                                    (\"about|exactly <time-of-day>\", -5.020585624949423),\n                                    (\"hour\", -1.2593855092558615),\n                                    (\"<time-of-day> sharp|exactly\", -5.020585624949423),\n                                    (\"minute\", -1.68838111477422)],\n                               n = 142},\n                   koData =\n                     ClassData{prior = -1.4591557093847622, unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.2676659890376327),\n                                    (\"from|since|after <time>\", -3.2676659890376327),\n                                    (\"at <time-of-day>\", -3.5553480614894135),\n                                    (\"time-of-day (latent)\", -1.157452788691043),\n                                    (\"hh:mm\", -3.5553480614894135),\n                                    (\"until <time>\", -3.960813169597578),\n                                    (\"hour\", -1.0163741904311376), (\"minute\", -2.70805020110221)],\n                               n = 43}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.21511137961694557, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8803128665695), (\"mm/dd\", -3.3843902633457743),\n                                    (\"absorption of , after named day\", -2.691243082785829),\n                                    (\"intersect\", -2.691243082785829),\n                                    (\"Saturday\", -2.691243082785829),\n                                    (\"Friday\", -2.9789251552376097), (\"day\", -0.8194409058842375),\n                                    (\"the <day-of-month> (ordinal)\", -2.9789251552376097),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.691243082785829)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.6422277352570913,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6582280766035324),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6582280766035324)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Administrative Professionals' Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thanksgiving Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Super Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.14595391262307983,\n                               unseen = -4.276666119016055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 70},\n                   koData =\n                     ClassData{prior = -1.9965538818740682,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -2.6668247082161294e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -3.6375861597263857,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3677247801253174, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9932517730102834),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.6026896854443837),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6863989535702288),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.1972245773362196)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.1786549963416462, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.4469189829363254),\n                                    (\"dayyear\", -2.1400661634962708),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.1400661634962708),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.7346010553881064),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Sundayyear (latent)\",\n                                     -2.1400661634962708)],\n                               n = 4}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mm/dd\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.791759469228055),\n                                    (\"Marcha <unit-of-duration>\", -2.1972245773362196),\n                                    (\"March<integer> <unit-of-duration>\", -2.1972245773362196),\n                                    (\"Super Tuesday<integer> <unit-of-duration>\",\n                                     -2.1972245773362196),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -2.1972245773362196),\n                                    (\"dayyear\", -1.5040773967762742),\n                                    (\"Tax Day<integer> <unit-of-duration>\", -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesday<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"dayyear\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Daylight Saving End Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5432070332690304, unseen = -5.44673737166631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.749270529961848),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.749270529961848),\n                                    (\"dayhour\", -4.343805421853684),\n                                    (\"daymonth\", -2.0412203288596382),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.749270529961848),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4965075614664802),\n                                    (\"Wednesdayintersect\", -4.749270529961848),\n                                    (\"Labor Daythis|last|next <cycle>\", -4.749270529961848),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3629761688419575),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.749270529961848),\n                                    (\"<part-of-day> of <time>February\", -4.749270529961848),\n                                    (\"Saturday<time-of-day> am|pm\", -4.749270529961848),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.343805421853684),\n                                    (\"hourmonth\", -4.749270529961848),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.056123349401903),\n                                    (\"dayday\", -2.497978731355353),\n                                    (\"the <day-of-month> (ordinal)February\", -4.343805421853684),\n                                    (\"WednesdayOctober\", -4.749270529961848),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.343805421853684),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4965075614664802),\n                                    (\"dayyear\", -3.4965075614664802),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.749270529961848),\n                                    (\"Thursdayhh:mm\", -4.343805421853684),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -4.749270529961848),\n                                    (\"Memorial Daythis|last|next <cycle>\", -4.749270529961848),\n                                    (\"TuesdayOctober\", -4.749270529961848),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6506582412937383),\n                                    (\"Mondaythis|last|next <cycle>\", -3.832979798087693),\n                                    (\"Fridayintersect\", -4.056123349401903),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.343805421853684),\n                                    (\"intersectOctober\", -4.343805421853684),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.832979798087693),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.343805421853684),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.749270529961848),\n                                    (\"dayminute\", -2.9575110607337933),\n                                    (\"minuteday\", -3.4965075614664802),\n                                    (\"this|last|next <cycle>Sunday\", -4.749270529961848),\n                                    (\"Sundaythis|last|next <cycle>\", -4.749270529961848),\n                                    (\"on <day><time-of-day> am|pm\", -4.749270529961848),\n                                    (\"intersectintersect\", -4.749270529961848),\n                                    (\"weekday\", -4.749270529961848),\n                                    (\"dayweek\", -3.6506582412937383),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.343805421853684),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.832979798087693),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.056123349401903)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -0.8696036179015019, unseen = -5.236441962829949,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.537961436294641),\n                                    (\"week-endOctober\", -3.844814255734696),\n                                    (\"daymonth\", -1.7971214123694403),\n                                    (\"TuesdaySeptember\", -4.537961436294641),\n                                    (\"Wednesdayintersect\", -4.537961436294641),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4393491476265314),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.537961436294641),\n                                    (\"hournograin\", -4.132496328186477),\n                                    (\"from|since|after <time>July\", -4.132496328186477),\n                                    (\"hourmonth\", -2.592051287239328),\n                                    (\"Fridaythis|last|next <cycle>\", -4.537961436294641),\n                                    (\"SundayFebruary\", -4.537961436294641),\n                                    (\"on <day>September\", -3.844814255734696),\n                                    (\"WednesdayOctober\", -4.537961436294641),\n                                    (\"intersectnow\", -4.132496328186477),\n                                    (\"week-endintersect\", -4.537961436294641),\n                                    (\"dayyear\", -4.537961436294641),\n                                    (\"FridayJuly\", -3.6216707044204863),\n                                    (\"FridaySeptember\", -4.132496328186477),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6216707044204863),\n                                    (\"WednesdayFebruary\", -4.537961436294641),\n                                    (\"minutemonth\", -3.0338840395183673),\n                                    (\"Mondaythis|last|next <cycle>\", -4.537961436294641),\n                                    (\"SundayMarch\", -4.537961436294641),\n                                    (\"MondayFebruary\", -4.132496328186477),\n                                    (\"Fridayintersect\", -4.537961436294641),\n                                    (\"intersectOctober\", -4.537961436294641),\n                                    (\"dayminute\", -4.537961436294641),\n                                    (\"SaturdaySeptember\", -4.537961436294641),\n                                    (\"intersectSeptember\", -3.1516670751747506),\n                                    (\"Tuesdaynow\", -4.132496328186477),\n                                    (\"MondayMarch\", -4.537961436294641),\n                                    (\"FridayOctober\", -4.537961436294641),\n                                    (\"daynograin\", -4.132496328186477),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.537961436294641),\n                                    (\"Tuesdayintersect\", -4.537961436294641),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.537961436294641),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.537961436294641),\n                                    (\"Sundayintersect\", -4.537961436294641)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.496436886313891, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Father's Day\", -3.0910424533583156),\n                                    (\"Martin Luther King's Day\", -3.0910424533583156),\n                                    (\"Cyber Monday\", -3.0910424533583156),\n                                    (\"Memorial Day\", -3.0910424533583156),\n                                    (\"Mother's Day\", -3.0910424533583156),\n                                    (\"day\", -1.1451323043030026), (\"Sunday\", -3.0910424533583156),\n                                    (\"Chinese New Year\", -2.3978952727983707),\n                                    (\"Thanksgiving Day\", -3.0910424533583156),\n                                    (\"Super Tuesday\", -3.0910424533583156),\n                                    (\"Easter Sunday\", -3.0910424533583156),\n                                    (\"hour\", -3.0910424533583156), (\"Tuesday\", -3.0910424533583156),\n                                    (\"week-end\", -3.0910424533583156)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -0.9382696385929302,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.833213344056216), (\"Friday\", -2.4277482359480516),\n                                    (\"day\", -1.916922612182061), (\"Sunday\", -2.833213344056216),\n                                    (\"hour\", -1.7346010553881064),\n                                    (\"week-end\", -1.7346010553881064)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Labor Day weekend\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6632942174102642, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.723918839226699, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.49247648509779407),\n                                    (\"ordinal (digits)\", -0.9444616088408514)],\n                               n = 16}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Emergency Medical Services Week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Veterans Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm.dd.yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"Independence Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.4203681286504293),\n                                    (\"Halloween\", -3.1135153092103742),\n                                    (\"Boss's Day\", -3.1135153092103742),\n                                    (\"Memorial Day\", -3.1135153092103742),\n                                    (\"Monday\", -2.70805020110221), (\"Tax Day\", -3.1135153092103742),\n                                    (\"Mother's Day\", -3.1135153092103742),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"Thanksgiving Day\", -3.1135153092103742),\n                                    (\"Super Tuesday\", -3.1135153092103742),\n                                    (\"March\", -3.1135153092103742), (\"month\", -3.1135153092103742),\n                                    (\"Tuesday\", -2.70805020110221)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.2512917986064953),\n                                    (\"Saturday\", -2.2512917986064953), (\"day\", -1.845826690498331)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3677247801253174,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Super Tuesdaythe nth <day-of-week> of <month-or-greater>\",\n                                     -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Super TuesdayMini-Tuesday\",\n                                     -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Super Tuesdayintersect\",\n                                     -2.3353749158170367),\n                                    (\"dayday\", -1.1314021114911006),\n                                    (\"ordinal (digits)Super TuesdayMini-Tuesday\",\n                                     -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Super Tuesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -2.740840023925201),\n                                    (\"ordinal (digits)Christmastoday\", -2.740840023925201)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.1786549963416462,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.3513752571634776),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Super Tuesdayintersect\",\n                                     -2.3513752571634776),\n                                    (\"dayday\", -1.6582280766035324),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Super TuesdayTax Day\",\n                                     -2.3513752571634776),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Super Tuesdaythe <day-of-month> (ordinal)\",\n                                     -2.3513752571634776),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -2.3513752571634776)],\n                               n = 4}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -4.652001563489282e-2),\n                                    (\"integer (0..19)\", -3.0910424533583156)],\n                               n = 42}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.1400661634962708),\n                                    (\"Friday\", -1.7346010553881064), (\"day\", -1.2237754316221157),\n                                    (\"Super Tuesday\", -2.1400661634962708),\n                                    (\"March\", -2.1400661634962708), (\"month\", -2.1400661634962708)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.5040773967762742), (\"Tuesday\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3424917384614978, unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.784189633918261),\n                                    (\"from|since|after <time>hh:mm\", -3.2733640101522705),\n                                    (\"minuteminute\", -1.7047480922384253),\n                                    (\"<time> timezone<time> timezone\", -3.4965075614664802),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.784189633918261),\n                                    (\"hh:mmhh:mm\", -2.6855773452501515),\n                                    (\"dayday\", -2.6855773452501515),\n                                    (\"hhhmmhhhmm\", -3.2733640101522705),\n                                    (\"hourhour\", -3.784189633918261),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.784189633918261),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.784189633918261),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.189654742026425),\n                                    (\"hoursecond\", -3.784189633918261),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.4965075614664802),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.2733640101522705)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3027199498163214, unseen = -5.564520407322694,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.462069342347418),\n                                    (\"<time> timezonehhhmm\", -4.462069342347418),\n                                    (\"hourday\", -3.258096538021482),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.867534450455582),\n                                    (\"dayhour\", -4.867534450455582),\n                                    (\"daymonth\", -3.6147714819602146),\n                                    (\"Super TuesdayMarch\", -4.867534450455582),\n                                    (\"Tuesdaythe nth <day-of-week> of <month-or-greater>\",\n                                     -4.867534450455582),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -4.867534450455582),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.951243718581427),\n                                    (\"TuesdayTax Day\", -4.867534450455582),\n                                    (\"<time-of-day> am|pmintersect\", -4.867534450455582),\n                                    (\"MondayOctober\", -4.462069342347418),\n                                    (\"from|since|after <time>hh:mm\", -4.867534450455582),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.7689221617874726),\n                                    (\"hhhmmintersect\", -4.867534450455582),\n                                    (\"minuteminute\", -2.425187415086378),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -4.174387269895637),\n                                    (\"hh:mmhh:mm\", -4.174387269895637),\n                                    (\"dayday\", -1.5903897174634058),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.951243718581427),\n                                    (\"hhhmmhhhmm\", -4.462069342347418),\n                                    (\"hourhour\", -3.951243718581427),\n                                    (\"Super Tuesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.462069342347418),\n                                    (\"hourminute\", -4.867534450455582),\n                                    (\"Super Tuesdaythe nth <day-of-week> of <month-or-greater>\",\n                                     -4.867534450455582),\n                                    (\"TuesdayMarch\", -4.867534450455582),\n                                    (\"minutehour\", -3.951243718581427),\n                                    (\"<time> timezonehh:mm\", -4.867534450455582),\n                                    (\"hh:mm<time> timezone\", -4.867534450455582),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.867534450455582),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.951243718581427),\n                                    (\"Super Tuesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.867534450455582),\n                                    (\"hh:mmintersect\", -3.951243718581427),\n                                    (\"Super Tuesdayintersect\", -4.174387269895637),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.867534450455582),\n                                    (\"Christmastoday\", -4.174387269895637),\n                                    (\"Super TuesdayMini-Tuesday\", -4.174387269895637),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.867534450455582),\n                                    (\"from|since|after <time>intersect\", -3.3634570536793085),\n                                    (\"Tuesdayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.462069342347418),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.951243718581427),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.462069342347418),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.867534450455582),\n                                    (\"Tuesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.867534450455582),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.3634570536793085),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.867534450455582),\n                                    (\"Super TuesdayTax Day\", -4.867534450455582),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.867534450455582),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.462069342347418),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.867534450455582),\n                                    (\"Super Tuesdaythe <day-of-month> (ordinal)\",\n                                     -4.867534450455582),\n                                    (\"Tuesdayintersect\", -4.462069342347418),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.462069342347418)],\n                               n = 99}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Memorial Day weekend\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1512560221535317, unseen = -4.68213122712422,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.0633909220278057),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"minuteminute\", -1.6770965609079151),\n                                    (\"<time> timezone<time> timezone\", -3.2865344733420154),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.979681653901961),\n                                    (\"hh:mmhh:mm\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"hhhmmhhhmm\", -3.0633909220278057),\n                                    (\"hourhour\", -2.4756042571256867),\n                                    (\"minutehour\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.979681653901961),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"hoursecond\", -3.5742165457937967),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -3.0633909220278057)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.3801473001238745, unseen = -5.267858159063328,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.164077900236776),\n                                    (\"<time> timezonehhhmm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.56954300834494),\n                                    (\"until <time>time-of-day (latent)\", -3.316780039849572),\n                                    (\"from|since|after <time>hh:mm\", -4.56954300834494),\n                                    (\"hh:mmtime-of-day (latent)\", -2.4901014666651045),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1832486472250494),\n                                    (\"minuteminute\", -2.4901014666651045),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.653252276470785),\n                                    (\"hh:mmhh:mm\", -3.876395827784995),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.164077900236776),\n                                    (\"hhhmmhhhmm\", -4.164077900236776),\n                                    (\"at <time-of-day><time-of-day> am|pm\", -4.56954300834494),\n                                    (\"hourhour\", -2.0045936508834035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.876395827784995),\n                                    (\"hourminute\", -3.4709307196768306),\n                                    (\"minutehour\", -1.6791712504487755),\n                                    (\"<time> timezonehh:mm\", -4.56954300834494),\n                                    (\"hh:mm<time> timezone\", -4.56954300834494),\n                                    (\"hhhmmtime-of-day (latent)\", -3.876395827784995),\n                                    (\"until <time><time-of-day> am|pm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.56954300834494),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.876395827784995),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.065465611568666),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.653252276470785),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.876395827784995),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.876395827784995)],\n                               n = 80}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Super Tuesdayyear (latent)\",\n                                     -1.791759469228055),\n                                    (\"dayyear\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -1.791759469228055),\n                                    (\"ordinal (digits)Super Tuesdaythis|last|next <cycle>\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3528213746227423, unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.7245795030534206),\n                                    (\"Marchinteger (numeric)\", -2.7245795030534206),\n                                    (\"Aprilinteger (numeric)\", -3.417726683613366),\n                                    (\"month\", -0.8150369981689822),\n                                    (\"Februaryinteger (numeric)\", -2.164963715117998),\n                                    (\"Septemberinteger (numeric)\", -2.7245795030534206),\n                                    (\"Octoberinteger (numeric)\", -2.7245795030534206),\n                                    (\"Julyinteger (numeric)\", -2.031432322493475)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -1.213022639845854, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"President's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.174387269895637,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 63},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Labor Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.5040773967762742,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.25131442828090605,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Labor Daythis|last|next <cycle>\", -3.2771447329921766),\n                                    (\"Administrative Professionals' Dayyear (latent)\",\n                                     -3.2771447329921766),\n                                    (\"Black Fridaythis|last|next <cycle>\", -3.2771447329921766),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.871679624884012),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.583997552432231),\n                                    (\"dayyear\", -0.9257694758286987),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -3.2771447329921766),\n                                    (\"Memorial Daythis|last|next <cycle>\", -3.2771447329921766),\n                                    (\"Sundayyear (latent)\", -3.2771447329921766),\n                                    (\"intersectyear (latent)\", -2.3608540011180215),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -2.178532444324067)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -2.4423470353692043),\n                                    (\"<datetime> - <datetime> (interval)year (latent)\",\n                                     -2.03688192726104),\n                                    (\"dayyear\", -1.3437347467010947),\n                                    (\"intersectyear (latent)\", -2.03688192726104)],\n                               n = 5}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.639057329615259),\n                                    (\"Martin Luther King's Day\", -2.639057329615259),\n                                    (\"Monday\", -2.639057329615259), (\"day\", -1.1349799328389845),\n                                    (\"Thanksgiving Day\", -2.639057329615259),\n                                    (\"Christmas\", -2.639057329615259), (\"hour\", -2.639057329615259),\n                                    (\"winter\", -2.639057329615259),\n                                    (\"week-end\", -2.639057329615259),\n                                    (\"summer\", -2.2335922215070942)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4486}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5667760648397627, unseen = -6.212606095751519,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 497},\n                   koData =\n                     ClassData{prior = -0.8378298858539651, unseen = -5.942799375126701,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 379}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.466337068793427),\n                                    (\"<integer> <unit-of-duration>\", -1.1786549963416462),\n                                    (\"month\", -1.8718021769015913)],\n                               n = 3}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6877697557040074, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.204483128596807, unseen = -5.616771097666572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -4.00369019395397),\n                                    (\"week\", -4.919980925828125),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.919980925828125),\n                                    (\"today\", -4.919980925828125), (\"intersect\", -3.2152328335897),\n                                    (\"<time> for <duration>\", -4.22683374526818),\n                                    (\"second\", -4.919980925828125), (\"now\", -3.2152328335897),\n                                    (\"tomorrow\", -4.5145158177199605),\n                                    (\"this|last|next <cycle>\", -4.919980925828125),\n                                    (\"day\", -1.8064656166177504),\n                                    (\"the <day-of-month> (ordinal)\", -4.5145158177199605),\n                                    (\"the <day-of-month> (number)\", -3.5336865647082343),\n                                    (\"time-of-day (latent)\", -2.477633890458921),\n                                    (\"<time-of-day> am|pm\", -4.22683374526818),\n                                    (\"hh:mm\", -4.5145158177199605), (\"nograin\", -3.2152328335897),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.5145158177199605),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.919980925828125),\n                                    (\"<day-of-month> (ordinal)\", -3.821368637160015),\n                                    (\"Easter Sunday\", -4.919980925828125),\n                                    (\"Christmas\", -4.22683374526818), (\"hour\", -2.317291240383741),\n                                    (\"month\", -4.919980925828125),\n                                    (\"<datetime> - <datetime> (interval)\", -2.7227563484919055),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.9740707767728116),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.5145158177199605),\n                                    (\"minute\", -2.0022101937438457),\n                                    (\"right now\", -4.919980925828125),\n                                    (\"<month> dd-dd (interval)\", -4.22683374526818),\n                                    (\"part of days\", -4.919980925828125),\n                                    (\"dd-dd <month> (interval)\", -4.5145158177199605)],\n                               n = 119}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.041453874828161, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.3978952727983707),\n                                    (\"ordinal (digits)December\", -1.7047480922384253),\n                                    (\"ordinal (digits)February\", -2.3978952727983707),\n                                    (\"integer (numeric)April\", -2.3978952727983707),\n                                    (\"month\", -1.1451323043030026)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.4353180712578455,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.2163953243244932,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -0.3513978868378886, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24557058710165408,\n                               unseen = -5.3471075307174685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.9560398908449206),\n                                    (\"noon|midnight|EOD|end of day\", -4.243721963296701),\n                                    (\"integer after|past <hour-of-day>\", -3.9560398908449206),\n                                    (\"<time-of-day> o'clock\", -4.6491870714048655),\n                                    (\"half after|past <hour-of-day>\", -4.6491870714048655),\n                                    (\"hhhmm\", -3.3964241029094975),\n                                    (\"<hour-of-day> <integer>\", -3.9560398908449206),\n                                    (\"time-of-day (latent)\", -1.6787726058351646),\n                                    (\"hhmm (latent)\", -3.9560398908449206),\n                                    (\"<time-of-day> am|pm\", -2.010129741789607),\n                                    (\"hh:mm\", -3.262892710284975),\n                                    (\"about|exactly <time-of-day>\", -4.243721963296701),\n                                    (\"hour\", -1.1526795099383855),\n                                    (\"<time-of-day> sharp|exactly\", -4.6491870714048655),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 97},\n                   koData =\n                     ClassData{prior = -1.5244446996007077, unseen = -4.248495242049359,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9760099665757773),\n                                    (\"<time-of-day> am|pm\", -3.1354942159291497),\n                                    (\"hour\", -0.9019019944220554)],\n                               n = 27}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.11122563511022437, unseen = -3.58351893845611,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 34},\n                   koData =\n                     ClassData{prior = -2.2512917986064953, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.178691788743376, unseen = -4.718498871295094,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3232358401924436),\n                                    (\"<integer> more <unit-of-duration>\", -4.0163830207523885),\n                                    (\"three-quarters of an hour\", -3.100092288878234),\n                                    (\"<integer> + '\\\"\", -3.3232358401924436),\n                                    (\"number.number hours\", -4.0163830207523885),\n                                    (\"second\", -3.6109179126442243),\n                                    (\"half a <time-grain>\", -3.100092288878234),\n                                    (\"day\", -3.3232358401924436), (\"year\", -4.0163830207523885),\n                                    (\"<integer> <unit-of-duration>\", -1.6184877479540183),\n                                    (\"a <unit-of-duration>\", -3.100092288878234),\n                                    (\"quarter of an hour\", -3.100092288878234),\n                                    (\"hour\", -2.512305623976115),\n                                    (\"about|exactly <duration>\", -4.0163830207523885),\n                                    (\"half an hour (abbrev).\", -3.6109179126442243),\n                                    (\"<integer> and an half hour\", -4.0163830207523885),\n                                    (\"minute\", -1.3083328196501787)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -1.8101086078962516,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.917770732084279), (\"quarter\", -2.917770732084279),\n                                    (\"year\", -1.6650077635889111),\n                                    (\"<integer> <unit-of-duration>\", -1.6650077635889111),\n                                    (\"a <unit-of-duration>\", -2.2246235515243336),\n                                    (\"month\", -2.917770732084279)],\n                               n = 9}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.4000876832522264, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.28312625591592017, unseen = -4.04305126783455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 55}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"Thanksgiving Day<integer> <unit-of-duration>\",\n                                     -1.0986122886681098),\n                                    (\"dayyear\", -1.3862943611198906),\n                                    (\"Diwali<integer> <unit-of-duration>\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45216128863385024,\n                               unseen = -7.195187320178708,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.501289670540389),\n                                    (\"Karva Chauthyear (latent)\", -6.501289670540389),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.501289670540389),\n                                    (\"Maha Shivaratriyear (latent)\", -6.501289670540389),\n                                    (\"Ramadanyear (latent)\", -5.248526702045021),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.1149953094204985),\n                                    (\"Bhai Doojyear (latent)\", -6.501289670540389),\n                                    (\"hourday\", -4.486386649998124),\n                                    (\"dayhour\", -3.4567672328169663),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.1149953094204985),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.095824562432225),\n                                    (\"Shemini Atzeretyear (latent)\", -6.501289670540389),\n                                    (\"daymonth\", -4.3612235070441185),\n                                    (\"monthday\", -6.095824562432225),\n                                    (\"monthyear\", -4.6294874936387975),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.501289670540389),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.095824562432225),\n                                    (\"Vijayadashamiyear (latent)\", -6.501289670540389),\n                                    (\"Thanksgiving Dayyear (latent)\", -5.402677381872279),\n                                    (\"Thai Pongalyear (latent)\", -5.808142489980444),\n                                    (\"Thiru Onamyear (latent)\", -5.808142489980444),\n                                    (\"hhhmmabsorption of , after named day\", -6.501289670540389),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.501289670540389),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.584998938666234),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.501289670540389),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.095824562432225),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.501289670540389),\n                                    (\"houryear\", -5.584998938666234),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.501289670540389),\n                                    (\"Christmas<time-of-day> am|pm\", -6.501289670540389),\n                                    (\"<day-of-month> (ordinal)October\", -6.501289670540389),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.501289670540389),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.808142489980444),\n                                    (\"intersectin|during <named-month>|year\", -6.501289670540389),\n                                    (\"<time-of-day> am|pmintersect\", -5.248526702045021),\n                                    (\"Earth Houryear (latent)\", -6.501289670540389),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.501289670540389),\n                                    (\"Octoberyear (latent)\", -4.891851758106289),\n                                    (\"intersect<time-of-day> am|pm\", -6.501289670540389),\n                                    (\"Mattu Pongalyear (latent)\", -6.501289670540389),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.501289670540389),\n                                    (\"Shavuotyear (latent)\", -6.501289670540389),\n                                    (\"Parsi New Yearyear (latent)\", -5.584998938666234),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.501289670540389),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.501289670540389),\n                                    (\"todayin|within|after <duration>\", -6.501289670540389),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.095824562432225),\n                                    (\"Marchyear (latent)\", -6.501289670540389),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.095824562432225),\n                                    (\"Sukkotyear (latent)\", -6.095824562432225),\n                                    (\"hhhmmintersect\", -6.095824562432225),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.095824562432225),\n                                    (\"Clean Mondayyear (latent)\", -6.095824562432225),\n                                    (\"monthhour\", -6.095824562432225),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.584998938666234),\n                                    (\"todayat <time-of-day>\", -6.501289670540389),\n                                    (\"Thursday<time> timezone\", -4.103394397742019),\n                                    (\"tonight<time-of-day> am|pm\", -6.501289670540389),\n                                    (\"time-of-day (latent)tonight\", -6.095824562432225),\n                                    (\"from|since|after <time>December\", -6.501289670540389),\n                                    (\"<time-of-day> am|pmon <day>\", -4.486386649998124),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.501289670540389),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.095824562432225),\n                                    (\"dayday\", -3.7287009483006077),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.095824562432225),\n                                    (\"mm/ddat <time-of-day>\", -5.808142489980444),\n                                    (\"tonightat <time-of-day>\", -5.402677381872279),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.808142489980444),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.501289670540389),\n                                    (\"today<time-of-day> am|pm\", -6.501289670540389),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.095824562432225),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.501289670540389),\n                                    (\"<day-of-month> (ordinal)intersect\", -5.808142489980444),\n                                    (\"mm/dd<time-of-day> am|pm\", -6.501289670540389),\n                                    (\"hourhour\", -3.530875204970688),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.095824562432225),\n                                    (\"Navaratriin|during <named-month>|year\", -6.501289670540389),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.501289670540389),\n                                    (\"Lentyear (latent)\", -6.501289670540389),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.6294874936387975),\n                                    (\"Boghiyear (latent)\", -6.501289670540389),\n                                    (\"dayyear\", -1.906169820405799),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.501289670540389),\n                                    (\"Thursdayfrom|since|after <time>\", -6.095824562432225),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.501289670540389),\n                                    (\"Thursdayat <time-of-day>\", -5.808142489980444),\n                                    (\"Islamic New Yearyear (latent)\", -6.095824562432225),\n                                    (\"Laylat al-Qadryear (latent)\", -5.584998938666234),\n                                    (\"part of days<time-of-day> am|pm\", -6.501289670540389),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.501289670540389),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.808142489980444),\n                                    (\"hourminute\", -6.095824562432225),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.584998938666234),\n                                    (\"Yom Kippuryear (latent)\", -6.501289670540389),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.808142489980444),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.501289670540389),\n                                    (\"minutehour\", -5.248526702045021),\n                                    (\"Kaanum Pongalyear (latent)\", -6.095824562432225),\n                                    (\"Maha Saptamiyear (latent)\", -6.501289670540389),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.808142489980444),\n                                    (\"time-of-day (latent)tomorrow\", -5.584998938666234),\n                                    (\"part of daysat <time-of-day>\", -4.891851758106289),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.486386649998124),\n                                    (\"for <duration> from <time>December\", -6.501289670540389),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.501289670540389),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.248526702045021),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.248526702045021),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.501289670540389),\n                                    (\"Pentecostyear (latent)\", -6.501289670540389),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.248526702045021),\n                                    (\"<day-of-month> (ordinal)February\", -6.501289670540389),\n                                    (\"Eid al-Fitryear (latent)\", -5.1149953094204985),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.501289670540389),\n                                    (\"Mondayin|during the <part-of-day>\", -6.501289670540389),\n                                    (\"Chhathin|during <named-month>|year\", -6.501289670540389),\n                                    (\"Diwaliin|during <named-month>|year\", -6.501289670540389),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.501289670540389),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.501289670540389),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.248526702045021),\n                                    (\"Raksha Bandhanyear (latent)\", -6.501289670540389),\n                                    (\"daysecond\", -6.095824562432225),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.095824562432225),\n                                    (\"Ratha-Yatrayear (latent)\", -6.501289670540389),\n                                    (\"Ashurayear (latent)\", -6.501289670540389),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.501289670540389),\n                                    (\"Chinese New Yearyear (latent)\", -6.501289670540389),\n                                    (\"tomorrowintersect\", -6.501289670540389),\n                                    (\"Lag BaOmeryear (latent)\", -6.501289670540389),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.501289670540389),\n                                    (\"Eid al-Adhayear (latent)\", -4.3612235070441185),\n                                    (\"intersectin|during the <part-of-day>\", -6.501289670540389),\n                                    (\"Palm Sundayyear (latent)\", -6.501289670540389),\n                                    (\"Christmasat <time-of-day>\", -6.501289670540389),\n                                    (\"Passoveryear (latent)\", -6.501289670540389),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.501289670540389),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.095824562432225),\n                                    (\"hhhmmon <day>\", -5.584998938666234),\n                                    (\"Yom HaShoahyear (latent)\", -6.095824562432225),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.095824562432225),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.501289670540389),\n                                    (\"Septemberyear (latent)\", -6.095824562432225),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.997212273764115),\n                                    (\"Halloweenyear (latent)\", -6.501289670540389),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.095824562432225),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.808142489980444),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.501289670540389),\n                                    (\"at <time-of-day>intersect\", -5.584998938666234),\n                                    (\"Rosh Hashanahyear (latent)\", -5.808142489980444),\n                                    (\"Dhanterasyear (latent)\", -6.501289670540389),\n                                    (\"Tu BiShvatyear (latent)\", -6.501289670540389),\n                                    (\"<day-of-month> (ordinal)December\", -5.808142489980444),\n                                    (\"Holiyear (latent)\", -5.808142489980444),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.501289670540389),\n                                    (\"Holika Dahanyear (latent)\", -5.808142489980444),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.095824562432225),\n                                    (\"dayminute\", -3.116899407194615),\n                                    (\"Mawlidyear (latent)\", -6.501289670540389),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.095824562432225),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.501289670540389),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.584998938666234),\n                                    (\"minuteday\", -2.751785594610018),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.808142489980444),\n                                    (\"intersectyear (latent)\", -6.095824562432225),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.501289670540389),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.501289670540389),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.501289670540389),\n                                    (\"intersecthhhmm\", -6.095824562432225),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.501289670540389),\n                                    (\"Boss's Dayyear (latent)\", -6.095824562432225),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.501289670540389),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.501289670540389),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.501289670540389),\n                                    (\"tonight<time-of-day> o'clock\", -6.501289670540389),\n                                    (\"Tisha B'Avyear (latent)\", -6.501289670540389),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.584998938666234),\n                                    (\"at <time-of-day>on <day>\", -4.891851758106289),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.095824562432225),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.808142489980444),\n                                    (\"Christmasyear (latent)\", -6.095824562432225),\n                                    (\"Saturdayintersect\", -6.501289670540389),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.095824562432225),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.501289670540389),\n                                    (\"dayweek\", -6.501289670540389),\n                                    (\"Easter Sundayyear (latent)\", -5.808142489980444),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.095824562432225),\n                                    (\"weekyear\", -5.402677381872279),\n                                    (\"King's Dayyear (latent)\", -4.997212273764115),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.584998938666234),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.095824562432225),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.808142489980444),\n                                    (\"Hanukkahyear (latent)\", -5.808142489980444),\n                                    (\"Rama Navamiyear (latent)\", -6.501289670540389),\n                                    (\"February<time> <part-of-day>\", -6.501289670540389),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.808142489980444),\n                                    (\"Great Lentyear (latent)\", -6.501289670540389),\n                                    (\"tomorrowat <time-of-day>\", -5.808142489980444),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.501289670540389),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.095824562432225),\n                                    (\"Ugadiyear (latent)\", -5.1149953094204985),\n                                    (\"Vaisakhiyear (latent)\", -5.808142489980444),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.808142489980444),\n                                    (\"last <cycle> of <time>year (latent)\", -5.808142489980444),\n                                    (\"at <time-of-day>tomorrow\", -6.095824562432225),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.501289670540389),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.501289670540389),\n                                    (\"Diwaliyear (latent)\", -6.501289670540389),\n                                    (\"between <time> and <time>on <day>\", -6.095824562432225),\n                                    (\"Black Fridayyear (latent)\", -6.095824562432225),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.501289670540389),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.501289670540389),\n                                    (\"Chhathyear (latent)\", -6.095824562432225),\n                                    (\"Vasant Panchamiyear (latent)\", -6.501289670540389),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.248526702045021),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.248526702045021),\n                                    (\"St Patrick's Dayyear (latent)\", -6.501289670540389),\n                                    (\"Thursday<time> (timezone)\", -6.501289670540389),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.501289670540389),\n                                    (\"Pargat Diwasyear (latent)\", -5.248526702045021),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.095824562432225),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.808142489980444),\n                                    (\"Februaryintersect\", -6.501289670540389),\n                                    (\"Simchat Torahyear (latent)\", -6.501289670540389),\n                                    (\"minuteyear\", -6.501289670540389)],\n                               n = 516},\n                   koData =\n                     ClassData{prior = -1.0112926977755932, unseen = -6.792344427470809,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.593996885389966),\n                                    (\"hourday\", -3.4953845967218564),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.09807428216624),\n                                    (\"<day-of-month> (ordinal)August\", -6.09807428216624),\n                                    (\"dayhour\", -3.3572342582410393),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.181783550292085),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.404927101606295),\n                                    (\"daymonth\", -3.39002408106403),\n                                    (\"hourquarter\", -5.181783550292085),\n                                    (\"monthyear\", -4.845311313670872),\n                                    (\"Thai Pongalyear (latent)\", -5.404927101606295),\n                                    (\"intersecthh:mm\", -6.09807428216624),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.6926091740580755),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.09807428216624),\n                                    (\"houryear\", -4.711779921046349),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.09807428216624),\n                                    (\"<day-of-month> (ordinal)October\", -6.09807428216624),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.404927101606295),\n                                    (\"hournograin\", -4.845311313670872),\n                                    (\"<time-of-day> am|pmintersect\", -4.845311313670872),\n                                    (\"Octoberyear (latent)\", -6.09807428216624),\n                                    (\"Good Fridayyear (latent)\", -5.6926091740580755),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.6926091740580755),\n                                    (\"early morningat <time-of-day>\", -6.09807428216624),\n                                    (\"until <time>on <day>\", -5.404927101606295),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.09807428216624),\n                                    (\"time-of-day (latent)intersect\", -5.404927101606295),\n                                    (\"todayin <number> (implicit minutes)\", -6.09807428216624),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.09807428216624),\n                                    (\"hh:mmon <day>\", -4.845311313670872),\n                                    (\"hhhmmintersect\", -5.6926091740580755),\n                                    (\"absorption of , after named dayJuly\", -5.181783550292085),\n                                    (\"from|since|after <time>July\", -5.6926091740580755),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.181783550292085),\n                                    (\"Clean Mondayyear (latent)\", -6.09807428216624),\n                                    (\"monthhour\", -6.09807428216624),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.6926091740580755),\n                                    (\"hourmonth\", -3.9580081186699694),\n                                    (\"todayat <time-of-day>\", -6.09807428216624),\n                                    (\"from|since|after <time>December\", -6.09807428216624),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.09807428216624),\n                                    (\"<time-of-day> am|pmon <day>\", -4.845311313670872),\n                                    (\"Mondayyear (latent)\", -5.404927101606295),\n                                    (\"dayday\", -3.9580081186699694),\n                                    (\"mm/ddat <time-of-day>\", -5.181783550292085),\n                                    (\"on <day>September\", -5.404927101606295),\n                                    (\"time-of-day (latent)September\", -5.6926091740580755),\n                                    (\"hourhour\", -4.018632740486404),\n                                    (\"time-of-day (latent)on <day>\", -4.593996885389966),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.6926091740580755),\n                                    (\"dayyear\", -3.2947139012597053),\n                                    (\"Thursdaymm/dd\", -6.09807428216624),\n                                    (\"New Year's Dayyear (latent)\", -5.181783550292085),\n                                    (\"time-of-day (latent)Sunday\", -5.6926091740580755),\n                                    (\"Thursdayfrom|since|after <time>\", -4.393326189927815),\n                                    (\"Thursdayat <time-of-day>\", -4.48863636973214),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.09807428216624),\n                                    (\"Aprilyear (latent)\", -6.09807428216624),\n                                    (\"the <day-of-month> (ordinal)July\", -6.09807428216624),\n                                    (\"the <day-of-month> (number)July\", -6.09807428216624),\n                                    (\"monthminute\", -6.09807428216624),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.6926091740580755),\n                                    (\"Thursdayhh:mm\", -5.181783550292085),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.6926091740580755),\n                                    (\"minutemonth\", -3.9580081186699694),\n                                    (\"time-of-day (latent)Friday\", -5.6926091740580755),\n                                    (\"minutehour\", -6.09807428216624),\n                                    (\"part of daysat <time-of-day>\", -4.99946199349813),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7466990250027625),\n                                    (\"Augustyear (latent)\", -5.6926091740580755),\n                                    (\"week-endin|during <named-month>|year\", -6.09807428216624),\n                                    (\"time-of-day (latent)Tuesday\", -5.6926091740580755),\n                                    (\"mm/dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.6926091740580755),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.09807428216624),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.09807428216624),\n                                    (\"Sundayyear (latent)\", -5.181783550292085),\n                                    (\"hourweek\", -5.181783550292085),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.404927101606295),\n                                    (\"Christmasat <time-of-day>\", -6.09807428216624),\n                                    (\"from|since|after <time>year (latent)\", -5.6926091740580755),\n                                    (\"hhhmmon <day>\", -5.181783550292085),\n                                    (\"yesterday<time-of-day> am|pm\", -6.09807428216624),\n                                    (\"<day-of-month> (ordinal)July\", -5.404927101606295),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.09807428216624),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.09807428216624),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.09807428216624),\n                                    (\"at <time-of-day>intersect\", -5.181783550292085),\n                                    (\"Holiyear (latent)\", -6.09807428216624),\n                                    (\"until <time><time-of-day> am|pm\", -6.09807428216624),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.6926091740580755),\n                                    (\"dayminute\", -3.235873401236772),\n                                    (\"yyyy-mm-ddhh:mm\", -5.6926091740580755),\n                                    (\"intersectfrom|since|after <time>\", -5.6926091740580755),\n                                    (\"intersectSeptember\", -4.226272105264648),\n                                    (\"minuteday\", -2.9410738610161267),\n                                    (\"absorption of , after named dayintersect\", -6.09807428216624),\n                                    (\"intersectyear (latent)\", -6.09807428216624),\n                                    (\"Februaryin|during the <part-of-day>\", -6.09807428216624),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.09807428216624),\n                                    (\"time-of-day (latent)July\", -5.404927101606295),\n                                    (\"Saturdayyear (latent)\", -6.09807428216624),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.09807428216624),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.845311313670872),\n                                    (\"at <time-of-day>on <day>\", -5.181783550292085),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.845311313670872),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.09807428216624),\n                                    (\"from|since|after <time>on <day>\", -5.181783550292085),\n                                    (\"dayweek\", -6.09807428216624),\n                                    (\"Easter Sundayyear (latent)\", -5.6926091740580755),\n                                    (\"Thursday<time-of-day> am|pm\", -4.845311313670872),\n                                    (\"weekyear\", -5.6926091740580755),\n                                    (\"time-of-day (latent)Thursday\", -5.6926091740580755),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.09807428216624),\n                                    (\"<day-of-month> (ordinal)April\", -6.09807428216624),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.6926091740580755),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.404927101606295),\n                                    (\"Sundayfrom|since|after <time>\", -6.09807428216624),\n                                    (\"absorption of , after named dayFebruary\", -5.181783550292085),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.6926091740580755),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.09807428216624),\n                                    (\"tomorrowat <time-of-day>\", -6.09807428216624),\n                                    (\"daynograin\", -5.6926091740580755),\n                                    (\"Fridayin|during <named-month>|year\", -6.09807428216624),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.6926091740580755),\n                                    (\"last <cycle> of <time>year (latent)\", -5.6926091740580755),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.09807428216624),\n                                    (\"Diwaliyear (latent)\", -5.6926091740580755),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.09807428216624),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.181783550292085),\n                                    (\"Fridayyear (latent)\", -5.181783550292085),\n                                    (\"time-of-day (latent)April\", -6.09807428216624)],\n                               n = 295}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.18924199963852842),\n                                    (\"integer (0..19)\", -1.7578579175523736)],\n                               n = 27}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 41},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.42550090040407e-2, unseen = -5.41610040220442,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.2574322038539065e-2),\n                                    (\"intersect 2 numbers\", -4.02535169073515)],\n                               n = 221},\n                   koData =\n                     ClassData{prior = -3.139832617527748, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.150620522096362e-2,\n                               unseen = -3.871201010907891,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 46},\n                   koData =\n                     ClassData{prior = -3.8501476017100584,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4166384087062897, unseen = -5.25227342804663,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2580400255962119),\n                                    (\"month (grain)\", -2.356652314264321),\n                                    (\"year (grain)\", -2.474435349920705),\n                                    (\"week (grain)\", -1.2580400255962119),\n                                    (\"quarter\", -3.6375861597263857), (\"year\", -2.474435349920705),\n                                    (\"month\", -2.356652314264321),\n                                    (\"quarter (grain)\", -3.6375861597263857)],\n                               n = 89},\n                   koData =\n                     ClassData{prior = -1.0766333819493346, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7164945445569365, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6703325027937741, unseen = -4.912654885736052,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15168458733206477),\n                                    (\"integer (0..19)\", -1.960835799271989)],\n                               n = 133}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6031989438970057, unseen = -5.356586274672012,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.712800803860808),\n                                    (\"integer (0..19)year (grain)\", -3.2724165917962305),\n                                    (\"integer (numeric)day (grain)\", -2.712800803860808),\n                                    (\"integer (0..19)second (grain) \", -3.965563772356176),\n                                    (\"integer (0..19)hour (grain)\", -3.154633556139847),\n                                    (\"second\", -3.5600986642480117),\n                                    (\"integer (numeric)second (grain) \", -4.253245844807957),\n                                    (\"integer (numeric)year (grain)\", -3.154633556139847),\n                                    (\"day\", -2.4614863755799017), (\"year\", -2.579269411236285),\n                                    (\"integer (numeric)week (grain)\", -3.2724165917962305),\n                                    (\"integer (0..19)month (grain)\", -3.742420221041966),\n                                    (\"integer (20..90)minute (grain)\", -4.658710952916121),\n                                    (\"hour\", -2.78690877601453), (\"month\", -3.0492730404820207),\n                                    (\"integer (numeric)minute (grain)\", -2.6438079323738566),\n                                    (\"integer (0..19)minute (grain)\", -3.2724165917962305),\n                                    (\"integer (numeric)month (grain)\", -3.5600986642480117),\n                                    (\"minute\", -2.216363917546917),\n                                    (\"integer (numeric)hour (grain)\", -3.742420221041966),\n                                    (\"integer (0..19)day (grain)\", -3.742420221041966),\n                                    (\"integer (0..19)week (grain)\", -3.405947984420753)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -0.7919930151965779, unseen = -5.19295685089021,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.577947893406655),\n                                    (\"integer (0..19)year (grain)\", -4.088773517172645),\n                                    (\"integer (numeric)day (grain)\", -4.088773517172645),\n                                    (\"integer (numeric)quarter (grain)\", -4.088773517172645),\n                                    (\"integer (numeric)year (grain)\", -4.088773517172645),\n                                    (\"day\", -3.577947893406655), (\"quarter\", -3.577947893406655),\n                                    (\"year\", -3.577947893406655),\n                                    (\"integer (numeric)week (grain)\", -4.088773517172645),\n                                    (\"integer (0..19)month (grain)\", -4.088773517172645),\n                                    (\"hour\", -1.1443345380062049), (\"month\", -3.577947893406655),\n                                    (\"integer (numeric)minute (grain)\", -4.4942386252808095),\n                                    (\"integer (numeric)month (grain)\", -4.088773517172645),\n                                    (\"minute\", -4.4942386252808095),\n                                    (\"integer (numeric)hour (grain)\", -1.1443345380062049),\n                                    (\"integer (0..19)day (grain)\", -4.088773517172645),\n                                    (\"integer (0..19)week (grain)\", -4.088773517172645),\n                                    (\"integer (0..19)quarter (grain)\", -4.088773517172645)],\n                               n = 77}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.26452876747706405,\n                               unseen = -5.717027701406222,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.767822656454056),\n                                    (\"integer after|past <hour-of-day>\", -4.327438444389479),\n                                    (\"at <time-of-day>\", -2.3815282953341654),\n                                    (\"<time-of-day> o'clock\", -4.61512051684126),\n                                    (\"half after|past <hour-of-day>\", -4.61512051684126),\n                                    (\"second\", -4.61512051684126), (\"hh:mm:ss\", -4.61512051684126),\n                                    (\"<hour-of-day> <integer>\", -4.104294893075269),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.020585624949423),\n                                    (\"time-of-day (latent)\", -1.7063996202768983),\n                                    (\"hhmm (latent)\", -5.020585624949423),\n                                    (\"hh:mm\", -2.3815282953341654),\n                                    (\"quarter after|past <hour-of-day>\", -3.5165082281731497),\n                                    (\"until <time>\", -4.327438444389479),\n                                    (\"about|exactly <time-of-day>\", -5.020585624949423),\n                                    (\"hour\", -1.2593855092558615),\n                                    (\"<time-of-day> sharp|exactly\", -5.020585624949423),\n                                    (\"minute\", -1.68838111477422)],\n                               n = 142},\n                   koData =\n                     ClassData{prior = -1.4591557093847622, unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.2676659890376327),\n                                    (\"from|since|after <time>\", -3.2676659890376327),\n                                    (\"at <time-of-day>\", -3.5553480614894135),\n                                    (\"time-of-day (latent)\", -1.157452788691043),\n                                    (\"hh:mm\", -3.5553480614894135),\n                                    (\"until <time>\", -3.960813169597578),\n                                    (\"hour\", -1.0163741904311376), (\"minute\", -2.70805020110221)],\n                               n = 43}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.21511137961694557, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8803128665695), (\"mm/dd\", -3.3843902633457743),\n                                    (\"absorption of , after named day\", -2.691243082785829),\n                                    (\"intersect\", -2.691243082785829),\n                                    (\"Saturday\", -2.691243082785829),\n                                    (\"Friday\", -2.9789251552376097), (\"day\", -0.8194409058842375),\n                                    (\"the <day-of-month> (ordinal)\", -2.9789251552376097),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.691243082785829)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.6422277352570913,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6582280766035324),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6582280766035324)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thanksgiving Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.9694005571881036,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1972245773362196),\n                                    (\"year (grain)\", -2.1972245773362196),\n                                    (\"second\", -2.890371757896165),\n                                    (\"week (grain)\", -2.1972245773362196),\n                                    (\"day\", -2.1972245773362196),\n                                    (\"minute (grain)\", -2.890371757896165),\n                                    (\"year\", -2.1972245773362196),\n                                    (\"second (grain) \", -2.890371757896165),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"day (grain)\", -2.1972245773362196)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.4769240720903093,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.14595391262307983,\n                               unseen = -4.276666119016055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 70},\n                   koData =\n                     ClassData{prior = -1.9965538818740682,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7932306391169278, unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.4965075614664802),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.4965075614664802),\n                                    (\"a <unit-of-duration>Christmas\", -3.4965075614664802),\n                                    (\"minuteminute\", -3.4965075614664802),\n                                    (\"dayday\", -3.4965075614664802),\n                                    (\"<integer> <unit-of-duration>today\", -3.4965075614664802),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.3978952727983707),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"daysecond\", -3.4965075614664802),\n                                    (\"a <unit-of-duration>right now\", -3.4965075614664802),\n                                    (\"minutenograin\", -3.4965075614664802),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.4965075614664802),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.4965075614664802),\n                                    (\"secondnograin\", -3.4965075614664802),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.580216829592325),\n                                    (\"yearday\", -2.803360380906535),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.4965075614664802),\n                                    (\"daynograin\", -3.4965075614664802),\n                                    (\"<integer> <unit-of-duration>now\", -3.0910424533583156)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6021754023542185, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.3596261140377293),\n                                    (\"dayhour\", -3.6109179126442243),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.6109179126442243),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.6109179126442243),\n                                    (\"monthnograin\", -3.6109179126442243),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.10684051586795),\n                                    (\"a <unit-of-duration>time-of-day (latent)\", -2.10684051586795),\n                                    (\"dayday\", -2.917770732084279),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.6109179126442243),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.20545280453606),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6109179126442243),\n                                    (\"<integer> <unit-of-duration>now\", -3.6109179126442243)],\n                               n = 23}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mm/dd\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.3025850929940455),\n                                    (\"monthyear\", -1.8971199848858813),\n                                    (\"Marcha <unit-of-duration>\", -2.3025850929940455),\n                                    (\"March<integer> <unit-of-duration>\", -2.3025850929940455),\n                                    (\"Thanksgiving Daya <unit-of-duration>\", -2.3025850929940455),\n                                    (\"Thanksgiving Day<integer> <unit-of-duration>\",\n                                     -1.8971199848858813),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -2.3025850929940455),\n                                    (\"dayyear\", -1.6094379124341003)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5540343780972276, unseen = -5.420534999272286,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.722953221644475),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.722953221644475),\n                                    (\"dayhour\", -4.31748811353631),\n                                    (\"daymonth\", -2.0149030205422647),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.722953221644475),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4701902531491067),\n                                    (\"Wednesdayintersect\", -4.722953221644475),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3366588605245844),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.722953221644475),\n                                    (\"<part-of-day> of <time>February\", -4.722953221644475),\n                                    (\"Saturday<time-of-day> am|pm\", -4.722953221644475),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.31748811353631),\n                                    (\"hourmonth\", -4.722953221644475),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.029806041084529),\n                                    (\"dayday\", -2.4716614230379794),\n                                    (\"the <day-of-month> (ordinal)February\", -4.31748811353631),\n                                    (\"WednesdayOctober\", -4.722953221644475),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.31748811353631),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4701902531491067),\n                                    (\"dayyear\", -3.8066624897703196),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.722953221644475),\n                                    (\"Thursdayhh:mm\", -4.31748811353631),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -4.722953221644475),\n                                    (\"TuesdayOctober\", -4.722953221644475),\n                                    (\"the <day-of-month> (ordinal)March\", -3.624340932976365),\n                                    (\"Mondaythis|last|next <cycle>\", -3.8066624897703196),\n                                    (\"Fridayintersect\", -4.029806041084529),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.31748811353631),\n                                    (\"intersectOctober\", -4.31748811353631),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.8066624897703196),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.31748811353631),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.722953221644475),\n                                    (\"dayminute\", -2.9311937524164198),\n                                    (\"minuteday\", -3.4701902531491067),\n                                    (\"this|last|next <cycle>Sunday\", -4.722953221644475),\n                                    (\"Sundaythis|last|next <cycle>\", -4.722953221644475),\n                                    (\"on <day><time-of-day> am|pm\", -4.722953221644475),\n                                    (\"intersectintersect\", -4.722953221644475),\n                                    (\"weekday\", -4.722953221644475),\n                                    (\"dayweek\", -3.624340932976365),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.31748811353631),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.8066624897703196),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.029806041084529)],\n                               n = 77},\n                   koData =\n                     ClassData{prior = -0.8547885321163612, unseen = -5.225746673713201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.527208644518379),\n                                    (\"week-endOctober\", -3.834061463958434),\n                                    (\"daymonth\", -1.7863686205931786),\n                                    (\"TuesdaySeptember\", -4.527208644518379),\n                                    (\"Wednesdayintersect\", -4.527208644518379),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.42859635585027),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.527208644518379),\n                                    (\"hournograin\", -4.121743536410215),\n                                    (\"from|since|after <time>July\", -4.121743536410215),\n                                    (\"hourmonth\", -2.581298495463066),\n                                    (\"Fridaythis|last|next <cycle>\", -4.527208644518379),\n                                    (\"SundayFebruary\", -4.527208644518379),\n                                    (\"on <day>September\", -3.834061463958434),\n                                    (\"WednesdayOctober\", -4.527208644518379),\n                                    (\"intersectnow\", -4.121743536410215),\n                                    (\"week-endintersect\", -4.527208644518379),\n                                    (\"dayyear\", -4.527208644518379),\n                                    (\"FridayJuly\", -3.6109179126442243),\n                                    (\"FridaySeptember\", -4.121743536410215),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6109179126442243),\n                                    (\"WednesdayFebruary\", -4.527208644518379),\n                                    (\"minutemonth\", -3.0231312477421053),\n                                    (\"Mondaythis|last|next <cycle>\", -4.527208644518379),\n                                    (\"SundayMarch\", -4.527208644518379),\n                                    (\"MondayFebruary\", -4.121743536410215),\n                                    (\"Fridayintersect\", -4.527208644518379),\n                                    (\"intersectOctober\", -4.527208644518379),\n                                    (\"dayminute\", -4.527208644518379),\n                                    (\"SaturdaySeptember\", -4.527208644518379),\n                                    (\"intersectSeptember\", -3.1409142833984887),\n                                    (\"Tuesdaynow\", -4.121743536410215),\n                                    (\"MondayMarch\", -4.527208644518379),\n                                    (\"FridayOctober\", -4.527208644518379),\n                                    (\"daynograin\", -4.121743536410215),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.527208644518379),\n                                    (\"Tuesdayintersect\", -4.527208644518379),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.527208644518379),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.527208644518379),\n                                    (\"Sundayintersect\", -4.527208644518379)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.6741486494265287),\n                                    (\"day\", -1.1700712526502546), (\"Sunday\", -2.6741486494265287),\n                                    (\"Chinese New Year\", -1.9810014688665833),\n                                    (\"Thanksgiving Day\", -2.6741486494265287),\n                                    (\"Easter Sunday\", -2.6741486494265287),\n                                    (\"hour\", -2.6741486494265287), (\"Tuesday\", -2.6741486494265287),\n                                    (\"week-end\", -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.6741486494265287), (\"Friday\", -2.268683541318364),\n                                    (\"day\", -1.7578579175523736), (\"Sunday\", -2.6741486494265287),\n                                    (\"hour\", -1.575536360758419), (\"week-end\", -1.575536360758419)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6061358035703156, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3862943611198906),\n                                    (\"ordinal (digits)\", -0.2876820724517809)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -0.7884573603642702, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm.dd.yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -1.791759469228055),\n                                    (\"ordinal (digits)April\", -1.791759469228055),\n                                    (\"month\", -0.8754687373538999),\n                                    (\"integer (numeric)October\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.1102132003465894),\n                                    (\"Halloween\", -2.803360380906535),\n                                    (\"Boss's Day\", -2.803360380906535),\n                                    (\"Monday\", -2.3978952727983707), (\"day\", -1.0986122886681098),\n                                    (\"Thanksgiving Day\", -2.803360380906535),\n                                    (\"March\", -2.803360380906535), (\"month\", -2.803360380906535),\n                                    (\"Tuesday\", -2.3978952727983707)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.8718021769015913, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.0149030205422647),\n                                    (\"Saturday\", -2.0149030205422647),\n                                    (\"day\", -1.6094379124341003)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -4.546237407675729e-2),\n                                    (\"integer (0..19)\", -3.1135153092103742)],\n                               n = 43}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1512560221535317, unseen = -4.68213122712422,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.0633909220278057),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"minuteminute\", -1.6770965609079151),\n                                    (\"<time> timezone<time> timezone\", -3.2865344733420154),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.979681653901961),\n                                    (\"hh:mmhh:mm\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"hhhmmhhhmm\", -3.0633909220278057),\n                                    (\"hourhour\", -2.4756042571256867),\n                                    (\"minutehour\", -2.4756042571256867),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.979681653901961),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2865344733420154),\n                                    (\"hoursecond\", -3.5742165457937967),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2865344733420154),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -3.0633909220278057)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.3801473001238745, unseen = -5.267858159063328,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.164077900236776),\n                                    (\"<time> timezonehhhmm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.56954300834494),\n                                    (\"until <time>time-of-day (latent)\", -3.316780039849572),\n                                    (\"from|since|after <time>hh:mm\", -4.56954300834494),\n                                    (\"hh:mmtime-of-day (latent)\", -2.4901014666651045),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1832486472250494),\n                                    (\"minuteminute\", -2.4901014666651045),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.653252276470785),\n                                    (\"hh:mmhh:mm\", -3.876395827784995),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.164077900236776),\n                                    (\"hhhmmhhhmm\", -4.164077900236776),\n                                    (\"at <time-of-day><time-of-day> am|pm\", -4.56954300834494),\n                                    (\"hourhour\", -2.0045936508834035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.876395827784995),\n                                    (\"hourminute\", -3.4709307196768306),\n                                    (\"minutehour\", -1.6791712504487755),\n                                    (\"<time> timezonehh:mm\", -4.56954300834494),\n                                    (\"hh:mm<time> timezone\", -4.56954300834494),\n                                    (\"hhhmmtime-of-day (latent)\", -3.876395827784995),\n                                    (\"until <time><time-of-day> am|pm\", -4.164077900236776),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.56954300834494),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.876395827784995),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.065465611568666),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.653252276470785),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.876395827784995),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.56954300834494),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.876395827784995)],\n                               n = 80}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.1588830833596715,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 62},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -1.252762968495368),\n                                    (\"ordinal (digits)April\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.890371757896165),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.4849066497880004),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"dayyear\", -0.8754687373538999),\n                                    (\"Thanksgiving Daythis|last|next <cycle>\", -2.890371757896165),\n                                    (\"intersectyear (latent)\", -2.1972245773362196),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.9740810260220096)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.6094379124341003),\n                                    (\"dayyear\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.639057329615259),\n                                    (\"Martin Luther King's Day\", -2.639057329615259),\n                                    (\"Monday\", -2.639057329615259), (\"day\", -1.1349799328389845),\n                                    (\"Thanksgiving Day\", -2.639057329615259),\n                                    (\"Christmas\", -2.639057329615259), (\"hour\", -2.639057329615259),\n                                    (\"winter\", -2.639057329615259),\n                                    (\"week-end\", -2.639057329615259),\n                                    (\"summer\", -2.2335922215070942)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4155}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.EN_ZA (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Bhai Dooj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7308875085427924),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7308875085427924)],\n                               n = 12}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -9.237332013101517e-2,\n                               unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4277482359480516),\n                                    (\"hhhmm\", -1.65455834771457),\n                                    (\"<time-of-day> am|pm\", -2.0222831278398874),\n                                    (\"hh:mm\", -2.2735975561207935), (\"hour\", -1.821612432377736),\n                                    (\"minute\", -1.128465251817791)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -2.4277482359480516,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm\", -1.3862943611198906), (\"hh:mm\", -1.791759469228055),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5357197883070597, unseen = -6.186208623900494,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 484},\n                   koData =\n                     ClassData{prior = -0.8800742478577515, unseen = -5.84354441703136,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 343}}),\n       (\"<year> (bc|ad)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.563975538357343), (\"day\", -1.8152899666382492),\n                                    (\"year\", -2.662587827025453),\n                                    (\"<integer> <unit-of-duration>\", -1.0531499145913523),\n                                    (\"a <unit-of-duration>\", -2.662587827025453),\n                                    (\"month\", -2.662587827025453),\n                                    (\"fortnight\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"noon|midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Karva Chauth\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.6739764335716716),\n                                    (\"dayday\", -1.1631508098056809),\n                                    (\"day (grain)yesterday\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.6739764335716716),\n                                    (\"year (grain)Christmas\", -2.0794415416798357),\n                                    (\"dayday\", -2.0794415416798357),\n                                    (\"day (grain)intersect\", -1.6739764335716716),\n                                    (\"day (grain)Easter Sunday\", -2.0794415416798357),\n                                    (\"yearday\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martin Luther King's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shemini Atzeret\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.3862943611198906),\n                                    (\"yearhour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -0.9808292530117262)],\n                               n = 2}}),\n       (\"Maha Shivaratri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramadan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lazarus Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (0..19)\",\n                                     -0.2231435513142097)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"powers of tensinteger (0..19)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from|since|after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6808968764162453, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"July\", -3.8066624897703196),\n                                    (\"intersect\", -3.8066624897703196),\n                                    (\"year (latent)\", -3.4011973816621555),\n                                    (\"day\", -2.4203681286504293),\n                                    (\"the <day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"the <day-of-month> (number)\", -3.8066624897703196),\n                                    (\"time-of-day (latent)\", -2.5538995212749516),\n                                    (\"year\", -3.4011973816621555),\n                                    (\"<time-of-day> am|pm\", -2.5538995212749516),\n                                    (\"hh:mm\", -2.890371757896165),\n                                    (\"<day-of-month> (ordinal)\", -3.4011973816621555),\n                                    (\"hour\", -1.9348603128687285), (\"month\", -3.4011973816621555),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"August\", -3.8066624897703196)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.20604911795490968, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.996364153861897),\n                                    (\"week\", -4.912654885736052),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.912654885736052),\n                                    (\"today\", -4.912654885736052),\n                                    (\"intersect\", -3.2079067934976266),\n                                    (\"<time> for <duration>\", -4.219507705176107),\n                                    (\"second\", -4.912654885736052), (\"now\", -3.3032169733019514),\n                                    (\"tomorrow\", -4.507189777627888),\n                                    (\"this|last|next <cycle>\", -4.912654885736052),\n                                    (\"day\", -1.7991395765256777),\n                                    (\"the <day-of-month> (ordinal)\", -4.507189777627888),\n                                    (\"the <day-of-month> (number)\", -3.5263605246161616),\n                                    (\"time-of-day (latent)\", -2.4703078503668476),\n                                    (\"<time-of-day> am|pm\", -4.219507705176107),\n                                    (\"hh:mm\", -4.507189777627888), (\"nograin\", -3.3032169733019514),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.507189777627888),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.912654885736052),\n                                    (\"<day-of-month> (ordinal)\", -3.8140425970679424),\n                                    (\"Easter Sunday\", -4.912654885736052),\n                                    (\"Christmas\", -4.219507705176107), (\"hour\", -2.309965200291668),\n                                    (\"month\", -4.912654885736052),\n                                    (\"<datetime> - <datetime> (interval)\", -2.715430308399833),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.966744736680739),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -4.507189777627888),\n                                    (\"minute\", -1.994884153651773),\n                                    (\"right now\", -4.912654885736052),\n                                    (\"<month> dd-dd (interval)\", -4.219507705176107),\n                                    (\"part of days\", -4.912654885736052),\n                                    (\"dd-dd <month> (interval)\", -4.507189777627888)],\n                               n = 118}}),\n       (\"integer after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon|midnight|EOD|end of day\",\n                                     -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.268683541318364),\n                                    (\"daymonth\", -2.268683541318364),\n                                    (\"ordinal (digits)day (grain)May\", -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.6741486494265287),\n                                    (\"weekmonth\", -1.7578579175523736),\n                                    (\"ordinal (digits)week (grain)October\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)intersect\", -2.6741486494265287),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.6741486494265287),\n                                    (\"weekyear\", -1.9810014688665833),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.6741486494265287),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)May\",\n                                     -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom HaShoah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)December\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.3025850929940455),\n                                    (\"integer (numeric)April\", -2.3025850929940455),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)October\", -2.772588722239781),\n                                    (\"ordinal (digits)July\", -2.0794415416798357),\n                                    (\"integer (numeric)September\", -2.367123614131617),\n                                    (\"ordinal (digits)August\", -2.772588722239781),\n                                    (\"ordinal (digits)April\", -2.772588722239781),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"integer (numeric)July\", -2.0794415416798357)],\n                               n = 11}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"dayhour\", -1.499234772300486),\n                                    (\"Mondayearly morning\", -3.536116699561526),\n                                    (\"time-of-day (latent)tonight\", -3.536116699561526),\n                                    (\"hourhour\", -2.236833715431265),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"todaypart of days\", -3.9415818076696905),\n                                    (\"minutehour\", -2.6888188391743224),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.536116699561526),\n                                    (\"time-of-day (latent)this <part-of-day>\", -3.9415818076696905),\n                                    (\"Mondayin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"intersectpart of days\", -3.0252910757955354),\n                                    (\"Saturdaypart of days\", -3.9415818076696905),\n                                    (\"intersectin|during the <part-of-day>\", -3.9415818076696905),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"tomorrowpart of days\", -2.33214389523559),\n                                    (\"hh:mmin|during the <part-of-day>\", -3.0252910757955354),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"yesterdaypart of days\", -3.536116699561526),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -3.9415818076696905),\n                                    (\"Mondaypart of days\", -3.9415818076696905)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.068052935133617),\n                                    (\"yearhour\", -3.068052935133617),\n                                    (\"monthhour\", -3.068052935133617),\n                                    (\"hourhour\", -1.9694406464655074),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"year (latent)in|during the <part-of-day>\",\n                                     -3.068052935133617),\n                                    (\"Februaryin|during the <part-of-day>\", -3.068052935133617),\n                                    (\"tomorrowpart of days\", -3.068052935133617),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.151762203259462)],\n                               n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.22957444164450025,\n                               unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.917010546939185),\n                                    (\"noon|midnight|EOD|end of day\", -4.204692619390966),\n                                    (\"integer after|past <hour-of-day>\", -3.917010546939185),\n                                    (\"<time-of-day> o'clock\", -4.61015772749913),\n                                    (\"half after|past <hour-of-day>\", -4.61015772749913),\n                                    (\"hhhmm\", -3.6938669956249752),\n                                    (\"<hour-of-day> <integer>\", -3.917010546939185),\n                                    (\"time-of-day (latent)\", -1.6397432619294292),\n                                    (\"hhmm (latent)\", -3.917010546939185),\n                                    (\"<time-of-day> am|pm\", -2.0074680420547466),\n                                    (\"hh:mm\", -3.3573947590037623),\n                                    (\"about|exactly <time-of-day>\", -4.204692619390966),\n                                    (\"hour\", -1.11365016603265),\n                                    (\"<time-of-day> sharp|exactly\", -4.61015772749913),\n                                    (\"minute\", -1.9360090780726016)],\n                               n = 93},\n                   koData =\n                     ClassData{prior = -1.5841201044498106,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0076405104623831),\n                                    (\"<time-of-day> am|pm\", -3.044522437723423),\n                                    (\"hour\", -0.924258901523332)],\n                               n = 24}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.8622008809294686),\n                                    (\"Saturday\", -2.8622008809294686),\n                                    (\"Monday\", -2.456735772821304), (\"Friday\", -1.6094379124341003),\n                                    (\"day\", -0.8472978603872037), (\"Sunday\", -2.8622008809294686),\n                                    (\"on <day>\", -2.169053700369523)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.17486983145803e-2,\n                               unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304), (\"second\", -2.639057329615259),\n                                    (\"day\", -2.3025850929940455), (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -0.7827593392496325),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -3.4657359027997265,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -1.8971199848858813),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.4816045409242156),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"integer (numeric)July\", -1.4816045409242156)],\n                               n = 8}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.227009259181436e-2,\n                               unseen = -4.418840607796598,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 81},\n                   koData =\n                     ClassData{prior = -4.406719247264253, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in|during <named-month>|year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> (bc|ad)\", -1.9924301646902063),\n                                    (\"October\", -3.0910424533583156),\n                                    (\"year (latent)\", -1.2992829841302609),\n                                    (\"year\", -0.9509762898620451), (\"March\", -2.6855773452501515),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.5040773967762742),\n                                    (\"year (latent)\", -1.5040773967762742),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.5040773967762742)],\n                               n = 6}}),\n       (\"<part-of-day> at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.223809823697212e-2,\n                               unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>hh:mm\", -3.7013019741124937),\n                                    (\"tonighthh:mm\", -3.7013019741124937),\n                                    (\"hourhour\", -0.8979415932059586),\n                                    (\"hourminute\", -3.0081547935525483),\n                                    (\"in|during the <part-of-day>time-of-day (latent)\",\n                                     -3.7013019741124937),\n                                    (\"this <part-of-day>time-of-day (latent)\", -1.9965538818740682),\n                                    (\"early morningtime-of-day (latent)\", -3.7013019741124937),\n                                    (\"tonight<time-of-day> o'clock\", -3.7013019741124937),\n                                    (\"tonighttime-of-day (latent)\", -2.7850112422383386),\n                                    (\"part of dayshh:mm\", -3.7013019741124937),\n                                    (\"part of daystime-of-day (latent)\", -1.6218604324326575)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.538973871058276, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.4469189829363254),\n                                    (\"this <part-of-day>time-of-day (latent)\", -2.1400661634962708),\n                                    (\"tonighttime-of-day (latent)\", -2.1400661634962708),\n                                    (\"part of daystime-of-day (latent)\", -2.1400661634962708)],\n                               n = 3}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -2.0794415416798357),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hhhmmhhhmm\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"hhhmmtime-of-day (latent)\", -1.791759469228055)],\n                               n = 2}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Passover\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyinteger (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.12136085700426748,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31},\n                   koData =\n                     ClassData{prior = -2.169053700369523, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0794415416798357),\n                                    (\"<part-of-day> at <time-of-day>\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -1.1631508098056809),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vesak\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Earth Hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|within|after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12260232209233239,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3141860046725258),\n                                    (\"<integer> more <unit-of-duration>\", -4.007333185232471),\n                                    (\"three-quarters of an hour\", -3.0910424533583156),\n                                    (\"<integer> + '\\\"\", -3.3141860046725258),\n                                    (\"number.number hours\", -4.007333185232471),\n                                    (\"second\", -3.6018680771243066),\n                                    (\"half a <time-grain>\", -3.0910424533583156),\n                                    (\"day\", -3.3141860046725258), (\"year\", -4.007333185232471),\n                                    (\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"a <unit-of-duration>\", -3.0910424533583156),\n                                    (\"quarter of an hour\", -3.0910424533583156),\n                                    (\"hour\", -2.503255788456197),\n                                    (\"about|exactly <duration>\", -4.007333185232471),\n                                    (\"half an hour (abbrev).\", -3.6018680771243066),\n                                    (\"<integer> and an half hour\", -4.007333185232471),\n                                    (\"minute\", -1.2992829841302609)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.159484249353372, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.70805020110221), (\"quarter\", -2.70805020110221),\n                                    (\"year\", -1.791759469228055),\n                                    (\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"the closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.0986122886681098),\n                                    (\"Christmastoday\", -1.791759469228055),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayOctober\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mattu Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (UK style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ganesh Chaturthi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)tonight\", -2.5649493574615367),\n                                    (\"hourhour\", -1.3609765531356008),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -2.9704144655697013),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"time-of-day (latent)this <part-of-day>\", -2.9704144655697013),\n                                    (\"hh:mmin|during the <part-of-day>\", -2.0541237336955462),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -2.277267285009756),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -2.9704144655697013)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.466337068793427),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -1.466337068793427)],\n                               n = 2}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3723081191451507, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -0.2923879634891936, unseen = -4.007333185232471,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 53}}),\n       (\"Parsi New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shavuot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> <duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -0.6931471805599453),\n                                    (\"Diwali<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.466337068793427),\n                                    (\"quarter\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.8109302162163288),\n                                    (\"quarter\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"Boss's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Orthodox Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one twenty two\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.45469784807592467,\n                               unseen = -7.170888478512505,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Navaratriyear (latent)\", -6.476972362889683),\n                                    (\"Karva Chauthyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Maha Shivaratriyear (latent)\", -6.476972362889683),\n                                    (\"Ramadanyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Bhai Doojyear (latent)\", -6.476972362889683),\n                                    (\"hourday\", -4.462069342347418),\n                                    (\"dayhour\", -3.4324499251662597),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.090678001769792),\n                                    (\"Martin Luther King's Dayyear (latent)\", -6.071507254781518),\n                                    (\"Shemini Atzeretyear (latent)\", -6.476972362889683),\n                                    (\"daymonth\", -4.462069342347418),\n                                    (\"monthday\", -6.071507254781518),\n                                    (\"monthyear\", -4.685212893661627),\n                                    (\"Yom Ha'atzmautyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Good Fridayyear (latent)\", -6.071507254781518),\n                                    (\"Vijayadashamiyear (latent)\", -6.476972362889683),\n                                    (\"Thai Pongalyear (latent)\", -5.783825182329737),\n                                    (\"Thiru Onamyear (latent)\", -5.783825182329737),\n                                    (\"hhhmmabsorption of , after named day\", -6.476972362889683),\n                                    (\"Tuesdaythe <day-of-month> (ordinal)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.560681631015528),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.476972362889683),\n                                    (\"Krishna Janmashtamiyear (latent)\", -6.071507254781518),\n                                    (\"Guru Gobind Singh Jayantiyear (latent)\", -6.476972362889683),\n                                    (\"houryear\", -5.560681631015528),\n                                    (\"this|next <day-of-week>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"Christmas<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"last <day-of-week> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.783825182329737),\n                                    (\"intersectin|during <named-month>|year\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmintersect\", -5.224209394394315),\n                                    (\"Earth Houryear (latent)\", -6.476972362889683),\n                                    (\"Ganesh Chaturthiyear (latent)\", -6.476972362889683),\n                                    (\"Octoberyear (latent)\", -4.972894966113409),\n                                    (\"intersect<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Mattu Pongalyear (latent)\", -6.476972362889683),\n                                    (\"Saturday<part-of-day> at <time-of-day>\", -6.476972362889683),\n                                    (\"Shavuotyear (latent)\", -6.476972362889683),\n                                    (\"Parsi New Yearyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayhh(:mm) - <time-of-day> am|pm\", -6.476972362889683),\n                                    (\"todayin|within|after <duration>\", -6.476972362889683),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Marchyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hhhmm\",\n                                     -6.071507254781518),\n                                    (\"Sukkotyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect\", -6.071507254781518),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -6.071507254781518),\n                                    (\"Clean Mondayyear (latent)\", -6.071507254781518),\n                                    (\"monthhour\", -6.071507254781518),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.560681631015528),\n                                    (\"todayat <time-of-day>\", -6.476972362889683),\n                                    (\"Thursday<time> timezone\", -4.079077090091312),\n                                    (\"tonight<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"time-of-day (latent)tonight\", -6.071507254781518),\n                                    (\"from|since|after <time>December\", -6.476972362889683),\n                                    (\"<time-of-day> am|pmon <day>\", -4.462069342347418),\n                                    (\"this <time>hh(:mm) - <time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"yyyy-mm-ddhh:mm:ss\", -6.071507254781518),\n                                    (\"dayday\", -3.7043836406499016),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -6.071507254781518),\n                                    (\"tonightat <time-of-day>\", -5.378360074221573),\n                                    (\"<time-of-day> am|pmabsorption of , after named day\",\n                                     -5.783825182329737),\n                                    (\"Dayananda Saraswati Jayantiyear (latent)\",\n                                     -6.476972362889683),\n                                    (\"today<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Februarythe <day-of-month> (ordinal)\", -6.071507254781518),\n                                    (\"at <time-of-day><time> <part-of-day>\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)intersect\", -6.071507254781518),\n                                    (\"hourhour\", -3.506557897319982),\n                                    (\"Mahavir Jayantiyear (latent)\", -6.071507254781518),\n                                    (\"Navaratriin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Wednesdaythis|last|next <cycle>\", -6.476972362889683),\n                                    (\"Lentyear (latent)\", -6.476972362889683),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.605170185988091),\n                                    (\"Boghiyear (latent)\", -6.476972362889683),\n                                    (\"dayyear\", -1.9178461154029982),\n                                    (\"Karva Chauthin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Thursdayfrom|since|after <time>\", -6.071507254781518),\n                                    (\"<time-of-day> o'clockin|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Thursdayat <time-of-day>\", -5.783825182329737),\n                                    (\"Islamic New Yearyear (latent)\", -6.071507254781518),\n                                    (\"Laylat al-Qadryear (latent)\", -5.560681631015528),\n                                    (\"part of days<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Shrove Tuesdayyear (latent)\", -6.476972362889683),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year<time-of-day> am|pm\",\n                                     -5.783825182329737),\n                                    (\"hourminute\", -6.071507254781518),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.560681631015528),\n                                    (\"Yom Kippuryear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.783825182329737),\n                                    (\"<part-of-day> of <time>year (latent)\", -6.476972362889683),\n                                    (\"minutehour\", -5.224209394394315),\n                                    (\"Kaanum Pongalyear (latent)\", -6.071507254781518),\n                                    (\"Maha Saptamiyear (latent)\", -6.476972362889683),\n                                    (\"at <time-of-day>in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"time-of-day (latent)tomorrow\", -5.560681631015528),\n                                    (\"part of daysat <time-of-day>\", -4.867534450455582),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.462069342347418),\n                                    (\"for <duration> from <time>December\", -6.476972362889683),\n                                    (\"tomorrow<time-of-day> sharp|exactly\", -6.476972362889683),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.224209394394315),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhhhmm\",\n                                     -5.224209394394315),\n                                    (\"time-of-day (latent)this <part-of-day>\", -6.476972362889683),\n                                    (\"Pentecostyear (latent)\", -6.476972362889683),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -5.224209394394315),\n                                    (\"<day-of-month> (ordinal)February\", -6.476972362889683),\n                                    (\"Eid al-Fitryear (latent)\", -5.090678001769792),\n                                    (\"Vasant Panchamiin|during <named-month>|year\",\n                                     -6.476972362889683),\n                                    (\"Mondayin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Chhathin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Diwaliin|during <named-month>|year\", -6.476972362889683),\n                                    (\"this <part-of-day><time-of-day> am|pm\", -6.476972362889683),\n                                    (\"Vaisakhiin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Guru Ravidass Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"Raksha Bandhanyear (latent)\", -6.476972362889683),\n                                    (\"daysecond\", -6.071507254781518),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.071507254781518),\n                                    (\"Ratha-Yatrayear (latent)\", -6.476972362889683),\n                                    (\"Ashurayear (latent)\", -6.476972362889683),\n                                    (\"Tuesdayin|during <named-month>|year\", -6.476972362889683),\n                                    (\"Chinese New Yearyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowintersect\", -6.476972362889683),\n                                    (\"Lag BaOmeryear (latent)\", -6.476972362889683),\n                                    (\"last weekend of <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Eid al-Adhayear (latent)\", -4.336906199393412),\n                                    (\"intersectin|during the <part-of-day>\", -6.476972362889683),\n                                    (\"Palm Sundayyear (latent)\", -6.476972362889683),\n                                    (\"Christmasat <time-of-day>\", -6.476972362889683),\n                                    (\"Passoveryear (latent)\", -6.476972362889683),\n                                    (\"Lazarus Saturdayyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"hhhmmon <day>\", -5.560681631015528),\n                                    (\"Yom HaShoahyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -6.071507254781518),\n                                    (\"<day-of-month> (ordinal or number) of <named-month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Septemberyear (latent)\", -6.071507254781518),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.972894966113409),\n                                    (\"Halloweenyear (latent)\", -6.476972362889683),\n                                    (\"<ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.071507254781518),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.783825182329737),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"<time-of-day> am|pm\",\n                                     -6.476972362889683),\n                                    (\"at <time-of-day>intersect\", -5.560681631015528),\n                                    (\"Rosh Hashanahyear (latent)\", -5.783825182329737),\n                                    (\"Dhanterasyear (latent)\", -6.476972362889683),\n                                    (\"Tu BiShvatyear (latent)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal)December\", -5.783825182329737),\n                                    (\"Holiyear (latent)\", -5.783825182329737),\n                                    (\"<time-of-day> - <time-of-day> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Holika Dahanyear (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.071507254781518),\n                                    (\"dayminute\", -3.162786358217157),\n                                    (\"Mawlidyear (latent)\", -6.476972362889683),\n                                    (\"from <datetime> - <datetime> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"<datetime> - <datetime> (interval)tomorrow\",\n                                     -6.476972362889683),\n                                    (\"Jumu'atul-Widayear (latent)\", -5.560681631015528),\n                                    (\"minuteday\", -2.7274682869593114),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.783825182329737),\n                                    (\"intersectyear (latent)\", -6.476972362889683),\n                                    (\"Orthodox Easter Sundayyear (latent)\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|within|after <duration>\",\n                                     -6.476972362889683),\n                                    (\"<ordinal> <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"intersecthhhmm\", -6.071507254781518),\n                                    (\"the <day-of-month> (ordinal)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Boss's Dayyear (latent)\", -6.071507254781518),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.476972362889683),\n                                    (\"Global Youth Service Dayyear (latent)\", -6.476972362889683),\n                                    (\"Dhanterasin|during <named-month>|year\", -6.476972362889683),\n                                    (\"tonight<time-of-day> o'clock\", -6.476972362889683),\n                                    (\"Tisha B'Avyear (latent)\", -6.476972362889683),\n                                    (\"Isra and Mi'rajyear (latent)\", -5.560681631015528),\n                                    (\"at <time-of-day>on <day>\", -4.867534450455582),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -6.071507254781518),\n                                    (\"time-of-day (latent)<time> <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Christmasyear (latent)\", -6.071507254781518),\n                                    (\"Saturdayintersect\", -6.476972362889683),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.071507254781518),\n                                    (\"Thai Pongalin|during <named-month>|year\", -6.476972362889683),\n                                    (\"dayweek\", -6.476972362889683),\n                                    (\"Easter Sundayyear (latent)\", -5.783825182329737),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <day>\",\n                                     -6.071507254781518),\n                                    (\"weekyear\", -5.378360074221573),\n                                    (\"King's Dayyear (latent)\", -4.972894966113409),\n                                    (\"hh:mmin|during the <part-of-day>\", -5.560681631015528),\n                                    (\"<cycle> after|before <time><time-of-day> am|pm\",\n                                     -6.071507254781518),\n                                    (\"first|second|third|fourth|fifth <day-of-week> of <time>year (latent)\",\n                                     -5.783825182329737),\n                                    (\"Hanukkahyear (latent)\", -5.783825182329737),\n                                    (\"Rama Navamiyear (latent)\", -6.476972362889683),\n                                    (\"February<time> <part-of-day>\", -6.476972362889683),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.783825182329737),\n                                    (\"Great Lentyear (latent)\", -6.476972362889683),\n                                    (\"tomorrowat <time-of-day>\", -5.783825182329737),\n                                    (\"hhmm (latent)in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"tomorrow<part-of-day> at <time-of-day>\", -6.071507254781518),\n                                    (\"Ugadiyear (latent)\", -5.090678001769792),\n                                    (\"Vaisakhiyear (latent)\", -5.783825182329737),\n                                    (\"absorption of , after named dayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -5.783825182329737),\n                                    (\"last <cycle> of <time>year (latent)\", -5.783825182329737),\n                                    (\"at <time-of-day>tomorrow\", -6.071507254781518),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.476972362889683),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -6.476972362889683),\n                                    (\"Diwaliyear (latent)\", -6.476972362889683),\n                                    (\"between <time> and <time>on <day>\", -6.071507254781518),\n                                    (\"Black Fridayyear (latent)\", -6.071507254781518),\n                                    (\"the <ordinal> last <cycle> of <time>year (latent)\",\n                                     -6.476972362889683),\n                                    (\"in|during the <part-of-day>at <time-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Chhathyear (latent)\", -6.071507254781518),\n                                    (\"Vasant Panchamiyear (latent)\", -6.476972362889683),\n                                    (\"Rabindra Jayantiyear (latent)\", -5.224209394394315),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.224209394394315),\n                                    (\"St Patrick's Dayyear (latent)\", -6.476972362889683),\n                                    (\"Thursday<time> (timezone)\", -6.476972362889683),\n                                    (\"<day-of-month> (ordinal or number) of <month>in|during the <part-of-day>\",\n                                     -6.476972362889683),\n                                    (\"Pargat Diwasyear (latent)\", -5.224209394394315),\n                                    (\"<datetime> - <datetime> (interval)July\", -6.071507254781518),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.783825182329737),\n                                    (\"Februaryintersect\", -6.476972362889683),\n                                    (\"Simchat Torahyear (latent)\", -6.476972362889683),\n                                    (\"minuteyear\", -6.476972362889683)],\n                               n = 502},\n                   koData =\n                     ClassData{prior = -1.0068712796552217, unseen = -6.774223886357614,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursdayhhhmm\", -4.575855798319316),\n                                    (\"hourday\", -3.477243509651206),\n                                    (\"<hour-of-day> <integer><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)August\", -6.07993319509559),\n                                    (\"dayhour\", -3.514983837634053),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <day>\",\n                                     -5.163642463221435),\n                                    (\"Tuesdayfrom|since|after <time>\", -5.3867860145356445),\n                                    (\"daymonth\", -3.37188299399338),\n                                    (\"hourquarter\", -5.163642463221435),\n                                    (\"monthyear\", -4.827170226600222),\n                                    (\"Thai Pongalyear (latent)\", -5.3867860145356445),\n                                    (\"intersecthh:mm\", -6.07993319509559),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -5.674468086987426),\n                                    (\"<day-of-month> (ordinal)Wednesday\", -6.07993319509559),\n                                    (\"houryear\", -4.693638833975699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)October\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.3867860145356445),\n                                    (\"hournograin\", -4.827170226600222),\n                                    (\"<time-of-day> am|pmintersect\", -4.827170226600222),\n                                    (\"Octoberyear (latent)\", -6.07993319509559),\n                                    (\"Good Fridayyear (latent)\", -5.674468086987426),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"early morningat <time-of-day>\", -6.07993319509559),\n                                    (\"until <time>on <day>\", -5.3867860145356445),\n                                    (\"part of days<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)intersect\", -5.3867860145356445),\n                                    (\"todayin <number> (implicit minutes)\", -6.07993319509559),\n                                    (\"this <part-of-day><time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"hh:mmon <day>\", -4.827170226600222),\n                                    (\"hhhmmintersect\", -5.674468086987426),\n                                    (\"absorption of , after named dayJuly\", -5.163642463221435),\n                                    (\"from|since|after <time>July\", -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -5.163642463221435),\n                                    (\"Clean Mondayyear (latent)\", -6.07993319509559),\n                                    (\"monthhour\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"hourmonth\", -3.939867031599319),\n                                    (\"todayat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>December\", -6.07993319509559),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -6.07993319509559),\n                                    (\"<time-of-day> am|pmon <day>\", -4.827170226600222),\n                                    (\"Mondayyear (latent)\", -5.3867860145356445),\n                                    (\"dayday\", -3.939867031599319),\n                                    (\"on <day>September\", -5.3867860145356445),\n                                    (\"time-of-day (latent)September\", -5.674468086987426),\n                                    (\"hourhour\", -4.000491653415755),\n                                    (\"time-of-day (latent)on <day>\", -4.575855798319316),\n                                    (\"time-of-day (latent)<cycle> after|before <time>\",\n                                     -5.674468086987426),\n                                    (\"dayyear\", -3.276572814189055),\n                                    (\"Thursdaymm/dd\", -6.07993319509559),\n                                    (\"New Year's Dayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)Sunday\", -5.674468086987426),\n                                    (\"Thursdayfrom|since|after <time>\", -4.375185102857165),\n                                    (\"Thursdayat <time-of-day>\", -4.470495282661489),\n                                    (\"<integer> to|till|before <hour-of-day>September\",\n                                     -6.07993319509559),\n                                    (\"Aprilyear (latent)\", -6.07993319509559),\n                                    (\"the <day-of-month> (ordinal)July\", -6.07993319509559),\n                                    (\"the <day-of-month> (number)July\", -6.07993319509559),\n                                    (\"monthminute\", -6.07993319509559),\n                                    (\"<time-of-day> am|pmtomorrow\", -5.674468086987426),\n                                    (\"Thursdayhh:mm\", -5.163642463221435),\n                                    (\"<day-of-month> (ordinal)Tuesday\", -5.674468086987426),\n                                    (\"minutemonth\", -3.939867031599319),\n                                    (\"time-of-day (latent)Friday\", -5.674468086987426),\n                                    (\"minutehour\", -6.07993319509559),\n                                    (\"part of daysat <time-of-day>\", -4.981320906427481),\n                                    (\"time-of-day (latent)this|last|next <cycle>\",\n                                     -3.7285579379321123),\n                                    (\"Augustyear (latent)\", -5.674468086987426),\n                                    (\"week-endin|during <named-month>|year\", -6.07993319509559),\n                                    (\"time-of-day (latent)Tuesday\", -5.674468086987426),\n                                    (\"tomorrowfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"tonight<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"Sundayyear (latent)\", -5.163642463221435),\n                                    (\"hourweek\", -5.163642463221435),\n                                    (\"the <day-of-month> (ordinal)Monday\", -5.3867860145356445),\n                                    (\"Christmasat <time-of-day>\", -6.07993319509559),\n                                    (\"from|since|after <time>year (latent)\", -5.674468086987426),\n                                    (\"hhhmmon <day>\", -5.163642463221435),\n                                    (\"yesterday<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)July\", -5.3867860145356445),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -6.07993319509559),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -6.07993319509559),\n                                    (\"in|during <named-month>|yearyear (latent)\",\n                                     -6.07993319509559),\n                                    (\"at <time-of-day>intersect\", -5.163642463221435),\n                                    (\"Holiyear (latent)\", -6.07993319509559),\n                                    (\"until <time><time-of-day> am|pm\", -6.07993319509559),\n                                    (\"at <time-of-day>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -5.674468086987426),\n                                    (\"dayminute\", -3.246719851039374),\n                                    (\"yyyy-mm-ddhh:mm\", -5.674468086987426),\n                                    (\"intersectfrom|since|after <time>\", -5.674468086987426),\n                                    (\"intersectSeptember\", -4.208131018193999),\n                                    (\"minuteday\", -2.922932773945477),\n                                    (\"absorption of , after named dayintersect\", -6.07993319509559),\n                                    (\"intersectyear (latent)\", -6.07993319509559),\n                                    (\"Februaryin|during the <part-of-day>\", -6.07993319509559),\n                                    (\"<duration> after|before|from|past <time>December\",\n                                     -6.07993319509559),\n                                    (\"time-of-day (latent)July\", -5.3867860145356445),\n                                    (\"Saturdayyear (latent)\", -6.07993319509559),\n                                    (\"hhhmmintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)Monday\", -4.827170226600222),\n                                    (\"at <time-of-day>on <day>\", -5.163642463221435),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.827170226600222),\n                                    (\"Naraka Chaturdashiyear (latent)\", -6.07993319509559),\n                                    (\"from|since|after <time>on <day>\", -5.163642463221435),\n                                    (\"dayweek\", -6.07993319509559),\n                                    (\"Easter Sundayyear (latent)\", -5.674468086987426),\n                                    (\"Thursday<time-of-day> am|pm\", -4.827170226600222),\n                                    (\"weekyear\", -5.674468086987426),\n                                    (\"time-of-day (latent)Thursday\", -5.674468086987426),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time>\",\n                                     -6.07993319509559),\n                                    (\"<day-of-month> (ordinal)April\", -6.07993319509559),\n                                    (\"yyyy-mm-dd<time-of-day> - <time-of-day> (interval)\",\n                                     -5.674468086987426),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for yearhh:mm\",\n                                     -5.3867860145356445),\n                                    (\"Sundayfrom|since|after <time>\", -6.07993319509559),\n                                    (\"absorption of , after named dayFebruary\", -5.163642463221435),\n                                    (\"time-of-day (latent)in|during the <part-of-day>\",\n                                     -5.674468086987426),\n                                    (\"July<integer> to|till|before <hour-of-day>\",\n                                     -6.07993319509559),\n                                    (\"tomorrowat <time-of-day>\", -6.07993319509559),\n                                    (\"daynograin\", -5.674468086987426),\n                                    (\"Fridayin|during <named-month>|year\", -6.07993319509559),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -5.674468086987426),\n                                    (\"last <cycle> of <time>year (latent)\", -5.674468086987426),\n                                    (\"tomorrow<time-of-day> am|pm\", -6.07993319509559),\n                                    (\"Diwaliyear (latent)\", -5.674468086987426),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -6.07993319509559),\n                                    (\"this <part-of-day>at <time-of-day>\", -5.163642463221435),\n                                    (\"Fridayyear (latent)\", -5.163642463221435),\n                                    (\"time-of-day (latent)April\", -6.07993319509559)],\n                               n = 289}}),\n       (\"one eleven\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"after lunch/work/school\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <number> (implicit minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -1.329135947279942, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3184537311185346),\n                                    (\"integer (0..19)\", -1.2992829841302609)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.30748469974796055,\n                               unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.20479441264601328),\n                                    (\"integer (0..19)\", -1.6863989535702288)],\n                               n = 25}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.791759469228055),\n                                    (\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"quarteryear\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)October\",\n                                     -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)this|last|next <cycle>\",\n                                     -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.3737155789130304, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -3.4231762883809305),\n                                    (\"minuteminute\", -2.91235066461494),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.4231762883809305),\n                                    (\"hh:mmhh:mm\", -2.91235066461494),\n                                    (\"dayday\", -1.9568392195875037),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -3.4231762883809305),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -3.828641396489095),\n                                    (\"hourhour\", -3.4231762883809305),\n                                    (\"minutehour\", -3.4231762883809305),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -3.828641396489095),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.828641396489095),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -3.828641396489095)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.29191040856130207, unseen = -5.14166355650266,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.570849079588725),\n                                    (\"dayhour\", -3.056356895370426),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)intersect\", -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)time-of-day (latent)\",\n                                     -3.7495040759303713),\n                                    (\"<named-month>|<named-day> <day-of-month> (ordinal)year (latent)\",\n                                     -4.442651256490317),\n                                    (\"hh:mmtime-of-day (latent)\", -3.5263605246161616),\n                                    (\"hh:mm<time-of-day> am|pm\", -4.037186148382152),\n                                    (\"minuteminute\", -3.5263605246161616),\n                                    (\"<day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.5263605246161616),\n                                    (\"hh:mmhh:mm\", -4.442651256490317),\n                                    (\"dayday\", -1.916922612182061),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (number)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.442651256490317),\n                                    (\"hourhour\", -3.1898882879949486),\n                                    (\"time-of-day (latent)the <day-of-month> (ordinal)\",\n                                     -4.442651256490317),\n                                    (\"dayyear\", -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"minutehour\", -3.3440389678222067),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.442651256490317),\n                                    (\"hh:mmintersect\", -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\", -4.442651256490317),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"time-of-day (latent)the <day-of-month> (number)\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.037186148382152),\n                                    (\"<day-of-month> (ordinal)the <day-of-month> (number)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.037186148382152),\n                                    (\"<named-month> <day-of-month> (non ordinal)time-of-day (latent)\",\n                                     -4.442651256490317),\n                                    (\"the <day-of-month> (number)intersect\", -4.037186148382152)],\n                               n = 59}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week (grain)<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekmonth\", -1.845826690498331),\n                                    (\"week (grain)October\", -1.845826690498331),\n                                    (\"week (grain)<named-month> <day-of-month> (non ordinal)\",\n                                     -1.845826690498331),\n                                    (\"weekday\", -1.3350010667323402)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second (grain) March\", -1.5040773967762742),\n                                    (\"secondmonth\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh:mmhh:mm\", -1.8718021769015913),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.5649493574615367),\n                                    (\"hourhour\", -2.5649493574615367),\n                                    (\"hourminute\", -2.5649493574615367),\n                                    (\"minutehour\", -2.0541237336955462),\n                                    (\"time-of-day (latent)<time-of-day> sharp|exactly\",\n                                     -2.9704144655697013),\n                                    (\"time-of-day (latent)hh:mm\", -2.9704144655697013),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.5649493574615367)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9218125974762528),\n                                    (\"hh:mm<time-of-day> am|pm\", -2.6149597780361984),\n                                    (\"minuteminute\", -2.6149597780361984),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.9218125974762528),\n                                    (\"hh:mmhh:mm\", -3.0204248861443626),\n                                    (\"hourhour\", -1.7676619176489945),\n                                    (\"minutehour\", -1.7676619176489945),\n                                    (\"time-of-day (latent)<time-of-day> am|pm\",\n                                     -3.0204248861443626)],\n                               n = 14}}),\n       (\"integer 21..99\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90)integer (0..19)\", -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2231435513142097)],\n                               n = 3}}),\n       (\"Global Youth Service Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tisha B'Av\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.320289707966387e-2),\n                                    (\"intersect 2 numbers\", -3.9982007016691985)],\n                               n = 215},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.48550781578170077),\n                                    (\"compose by multiplication\", -1.1786549963416462)],\n                               n = 10}}),\n       (\"<time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -2.833213344056216),\n                                    (\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -2.1400661634962708),\n                                    (\"dayday\", -1.4469189829363254),\n                                    (\"hourminute\", -1.916922612182061),\n                                    (\"hhhmm<integer> <unit-of-duration>\", -2.833213344056216),\n                                    (\"intersect<integer> <unit-of-duration>\", -2.1400661634962708),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -2.4277482359480516),\n                                    (\"from|since|after <time><integer> <unit-of-duration>\",\n                                     -2.1400661634962708)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"December<integer> <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"hhhmm\",\n        Classifier{okData =\n                     ClassData{prior = -2.247285585205863e-2,\n                               unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -3.8066624897703196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"as soon as possible\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mahavir Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.21357410029805904,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -1.6486586255873816,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dayananda Saraswati Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Hanukkah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first|second|third|fourth|fifth <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8649974374866046),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdaythis|last|next <cycle>\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.9444389791664407),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.538973871058276),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6916760106710724),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.538973871058276)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (20..90)\", -2.5649493574615367),\n                                    (\"time-of-day (latent)integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer 21..99\", -2.159484249353372),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"at <time-of-day>integer (numeric)\", -2.159484249353372),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"time-of-day (latent)integer (20..90)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"Rama Navami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"half a <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"King's Day\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9810014688665833),\n                                    (\"integer (numeric)ordinal (digits)July\", -1.9810014688665833),\n                                    (\"ordinal (digits)integer (numeric)July\", -1.9810014688665833),\n                                    (\"month\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maha Saptami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.546237407675729e-2,\n                               unseen = -4.477336814478207,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 86},\n                   koData =\n                     ClassData{prior = -3.1135153092103742, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"part of daysintersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.4849066497880004),\n                                    (\"part of daysintersect\", -2.4849066497880004),\n                                    (\"hourday\", -0.9808292530117262),\n                                    (\"part of daysthe <day-of-month> (ordinal)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (number)\",\n                                     -2.4849066497880004),\n                                    (\"part of daysthis <time>\", -2.4849066497880004),\n                                    (\"part of daysthe <day-of-month> (ordinal or number) of <named-month>\",\n                                     -2.4849066497880004),\n                                    (\"part of daysChristmas\", -2.0794415416798357)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"hourminute\", -1.7047480922384253),\n                                    (\"intersect<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"<day-of-month> (ordinal or number) <named-month><integer> <unit-of-duration>\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <day-of-week> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fridaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Tuesdaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (0..19)Fridaynow\", -2.2512917986064953),\n                                    (\"daynograin\", -0.9985288301111273),\n                                    (\"integer (numeric)Sundaynow\", -2.2512917986064953),\n                                    (\"integer (numeric)Tuesdaynow\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shrove Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (ordinal or number) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7339691750802004,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -2.740840023925201),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.6422277352570913),\n                                    (\"ordinal (digits)February\", -2.740840023925201),\n                                    (\"integer (numeric)February\", -2.3353749158170367),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"ordinal (digits)March\", -2.3353749158170367),\n                                    (\"integer (numeric)July\", -2.740840023925201)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.6539264674066639,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.550597412411167),\n                                    (\"ordinal (digits)February\", -2.803360380906535),\n                                    (\"month\", -0.8574502318512216),\n                                    (\"integer (numeric)July\", -1.550597412411167)],\n                               n = 13}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"part of days\", -0.6931471805599453)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kaanum Pongal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Yom Kippur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> minutes to|till|before <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"minutehour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rabindra Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"powers of tens\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pargat Diwas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"early morning\", -2.740840023925201),\n                                    (\"hour\", -0.7259370033829361),\n                                    (\"part of days\", -0.7949298748698876)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"part of days\", -0.916290731874155)],\n                               n = 1}}),\n       (\"St Patrick's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:mm) - <time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hh:mm\", -1.9924301646902063), (\"hour\", -1.0116009116784799),\n                                    (\"minute\", -1.9924301646902063)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.42050298547270487,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2474579162656747),\n                                    (\"month (grain)\", -2.3460702049337847),\n                                    (\"year (grain)\", -2.528391761727739),\n                                    (\"week (grain)\", -1.2474579162656747),\n                                    (\"quarter\", -3.6270040503958487), (\"year\", -2.528391761727739),\n                                    (\"month\", -2.3460702049337847),\n                                    (\"quarter (grain)\", -3.6270040503958487)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -1.0691984034618165, unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8111775550851565),\n                                    (\"month (grain)\", -2.4471663218051534),\n                                    (\"year (grain)\", -3.0349529867072724),\n                                    (\"second\", -3.0349529867072724),\n                                    (\"week (grain)\", -1.8111775550851565),\n                                    (\"day\", -2.2464956263430023), (\"quarter\", -3.0349529867072724),\n                                    (\"year\", -3.0349529867072724),\n                                    (\"second (grain) \", -3.0349529867072724),\n                                    (\"month\", -2.4471663218051534),\n                                    (\"quarter (grain)\", -3.0349529867072724),\n                                    (\"day (grain)\", -2.2464956263430023)],\n                               n = 46}}),\n       (\"Simchat Torah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)year (latent)\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Raksha Bandhan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ashura\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ratha-Yatra\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Adha\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -1.9459101490553135),\n                                    (\"time-of-day (latent)\", -1.9459101490553135),\n                                    (\"<time-of-day> am|pm\", -1.9459101490553135),\n                                    (\"hh:mm\", -1.9459101490553135), (\"hour\", -1.540445040947149),\n                                    (\"minute\", -1.540445040947149)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4818380868927383,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.5260563034950494),\n                                    (\"ordinal (digits)\", -0.24512245803298496)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.9614111671546247, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"last weekend of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -0.9555114450274363), (\"July\", -1.8718021769015913),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Lag BaOmer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"Guru Ravidass Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Chinese New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|this|next <season>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Orthodox Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7009903580209712, unseen = -4.867534450455582,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.763846956391606e-2),\n                                    (\"integer (0..19)\", -2.374905754573672)],\n                               n = 127},\n                   koData =\n                     ClassData{prior = -0.6853650401178903, unseen = -4.882801922586371,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15669845190605702),\n                                    (\"integer (0..19)\", -1.9307583440347111)],\n                               n = 129}}),\n       (\"beginning of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"SundayMarch\", -2.0149030205422647),\n                                    (\"MondayMarch\", -2.0149030205422647),\n                                    (\"FridayOctober\", -1.6094379124341003),\n                                    (\"Sundayintersect\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6164133863285559, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6642475784438173),\n                                    (\"integer (0..19)year (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)day (grain)\", -2.6642475784438173),\n                                    (\"integer (0..19)second (grain) \", -3.917010546939185),\n                                    (\"integer (0..19)hour (grain)\", -3.1060803307228566),\n                                    (\"second\", -3.5115454388310208),\n                                    (\"integer (numeric)second (grain) \", -4.204692619390966),\n                                    (\"integer (numeric)year (grain)\", -3.3573947590037623),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.6642475784438173),\n                                    (\"integer (numeric)week (grain)\", -3.22386336637924),\n                                    (\"integer (0..19)month (grain)\", -3.6938669956249752),\n                                    (\"integer (20..90)minute (grain)\", -4.61015772749913),\n                                    (\"hour\", -2.738355550597539), (\"month\", -3.3573947590037623),\n                                    (\"integer (numeric)minute (grain)\", -2.5952547069568657),\n                                    (\"integer (0..19)minute (grain)\", -3.22386336637924),\n                                    (\"integer (numeric)month (grain)\", -4.204692619390966),\n                                    (\"minute\", -2.167810692129926),\n                                    (\"integer (numeric)hour (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)day (grain)\", -3.6938669956249752),\n                                    (\"integer (0..19)week (grain)\", -3.3573947590037623)],\n                               n = 88},\n                   koData =\n                     ClassData{prior = -0.7762620872704519, unseen = -5.170483995038151,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.5553480614894135),\n                                    (\"integer (0..19)year (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)day (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)quarter (grain)\", -4.0661736852554045),\n                                    (\"integer (numeric)year (grain)\", -4.0661736852554045),\n                                    (\"day\", -3.5553480614894135), (\"quarter\", -3.5553480614894135),\n                                    (\"year\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)month (grain)\", -4.0661736852554045),\n                                    (\"hour\", -1.157452788691043), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -4.471638793363569),\n                                    (\"integer (numeric)month (grain)\", -4.0661736852554045),\n                                    (\"minute\", -4.471638793363569),\n                                    (\"integer (numeric)hour (grain)\", -1.157452788691043),\n                                    (\"integer (0..19)day (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)week (grain)\", -4.0661736852554045),\n                                    (\"integer (0..19)quarter (grain)\", -4.0661736852554045)],\n                               n = 75}}),\n       (\"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)ordinal (digits)July\", -1.3217558399823195),\n                                    (\"integer (numeric)integer (numeric)July\", -1.3217558399823195),\n                                    (\"month\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Guru Gobind Singh Jayanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Krishna Janmashtami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -5.703782474656201,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>\", -3.7545334243353734),\n                                    (\"integer after|past <hour-of-day>\", -4.314149212270796),\n                                    (\"at <time-of-day>\", -2.4046067073863573),\n                                    (\"<time-of-day> o'clock\", -4.601831284722577),\n                                    (\"half after|past <hour-of-day>\", -4.601831284722577),\n                                    (\"second\", -4.601831284722577),\n                                    (\"hh:mm:ss\", -4.601831284722577),\n                                    (\"<hour-of-day> <integer>\", -4.091005660956586),\n                                    (\"<integer> minutes to|till|before <hour-of-day>\",\n                                     -5.0072963928307415),\n                                    (\"time-of-day (latent)\", -1.6931103881582155),\n                                    (\"hhmm (latent)\", -5.0072963928307415),\n                                    (\"hh:mm\", -2.4046067073863573),\n                                    (\"quarter after|past <hour-of-day>\", -3.503218996054467),\n                                    (\"until <time>\", -4.314149212270796),\n                                    (\"about|exactly <time-of-day>\", -5.0072963928307415),\n                                    (\"hour\", -1.2460962771371789),\n                                    (\"<time-of-day> sharp|exactly\", -5.0072963928307415),\n                                    (\"minute\", -1.7114595268264121)],\n                               n = 140},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> to|till|before <hour-of-day>\", -3.248434627109745),\n                                    (\"from|since|after <time>\", -3.248434627109745),\n                                    (\"at <time-of-day>\", -3.536116699561526),\n                                    (\"time-of-day (latent)\", -1.1689930854299093),\n                                    (\"hh:mm\", -3.536116699561526),\n                                    (\"until <time>\", -3.9415818076696905),\n                                    (\"hour\", -1.0238110755854113), (\"minute\", -2.6888188391743224)],\n                               n = 42}}),\n       (\"Yom Ha'atzmaut\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8281271133989299),\n                                    (\"absorption of , after named day\", -2.639057329615259),\n                                    (\"intersect\", -2.639057329615259),\n                                    (\"Saturday\", -2.639057329615259),\n                                    (\"Friday\", -2.9267394020670396), (\"day\", -0.8064758658669484),\n                                    (\"the <day-of-month> (ordinal)\", -2.9267394020670396),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -2.639057329615259)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.6094379124341003),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -1.6094379124341003)],\n                               n = 6}}),\n       (\"Thiru Onam\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thai Pongal\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Vijayadashami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"March\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708),\n                                    (\"year (grain)\", -2.4277482359480516),\n                                    (\"second\", -2.833213344056216),\n                                    (\"week (grain)\", -2.1400661634962708),\n                                    (\"day\", -2.1400661634962708),\n                                    (\"minute (grain)\", -2.833213344056216),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"second (grain) \", -2.833213344056216),\n                                    (\"minute\", -2.833213344056216),\n                                    (\"day (grain)\", -2.1400661634962708)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -2.3025850929940455),\n                                    (\"quarter\", -1.3470736479666092),\n                                    (\"minute (grain)\", -2.8134107167600364),\n                                    (\"hour\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -1.3470736479666092),\n                                    (\"minute\", -2.8134107167600364)],\n                               n = 18}}),\n       (\"at the beginning|end of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.2237754316221157),\n                                    (\"this|last|next <cycle>\", -1.4469189829363254),\n                                    (\"year\", -0.7537718023763802)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.916290731874155),\n                                    (\"year\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Dhanteras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tu BiShvat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Whit Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13534134786976212,\n                               unseen = -4.2626798770413155,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 69},\n                   koData =\n                     ClassData{prior = -2.0668627594729756,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Holi\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"upcoming <integer> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Rosh Hashanah\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <named-day> ago|back\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Thursday\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> upcoming <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..19)year (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)day (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)quarter (grain)\", -2.908720896564361),\n                                    (\"integer (numeric)year (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"integer (numeric)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)month (grain)\", -2.908720896564361),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"integer (numeric)month (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)day (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)week (grain)\", -2.908720896564361),\n                                    (\"integer (0..19)quarter (grain)\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Holika Dahan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = -3.077165866675366e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32},\n                   koData =\n                     ClassData{prior = -3.4965075614664802,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mawlid\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jumu'atul-Wida\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after|before|from|past <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7691330875378672, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>now\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>hhhmm\", -3.481240089335692),\n                                    (\"a <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"minuteminute\", -3.481240089335692),\n                                    (\"dayday\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>today\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -2.382627800667582),\n                                    (\"minutehour\", -1.7764919970972666),\n                                    (\"daysecond\", -3.481240089335692),\n                                    (\"a <unit-of-duration>right now\", -3.481240089335692),\n                                    (\"minutenograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Christmas\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>Easter Sunday\",\n                                     -3.481240089335692),\n                                    (\"secondnograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration><time-of-day> am|pm\",\n                                     -2.5649493574615367),\n                                    (\"yearday\", -2.7880929087757464),\n                                    (\"<integer> <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.481240089335692),\n                                    (\"daynograin\", -3.481240089335692),\n                                    (\"<integer> <unit-of-duration>now\", -3.0757749812275272)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.6225296133459919, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.318240897874875),\n                                    (\"dayhour\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration>intersect\", -3.56953269648137),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration><time-of-day> am|pm\", -2.065455299705096),\n                                    (\"a <unit-of-duration>time-of-day (latent)\",\n                                     -2.065455299705096),\n                                    (\"dayday\", -2.8763855159214247),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -3.56953269648137),\n                                    (\"a <unit-of-duration>noon|midnight|EOD|end of day\",\n                                     -3.164067588373206),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.56953269648137)],\n                               n = 22}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Wednesdayintersect\",\n                                     -2.120263536200091),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mondaythis|last|next <cycle>\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayOctober\",\n                                     -2.120263536200091)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1786549963416462),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdaySeptember\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..twentieth,thirtieth,...)WednesdayOctober\",\n                                     -1.466337068793427)],\n                               n = 3}}),\n       (\"quarter after|past <hour-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon|midnight|EOD|end of day\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -0.9382696385929302),\n                                    (\"hour\", -0.7375989431307791)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.159484249353372),\n                                    (\"time-of-day (latent)\", -2.5649493574615367),\n                                    (\"year\", -2.159484249353372),\n                                    (\"<time-of-day> am|pm\", -1.8718021769015913),\n                                    (\"hh:mm\", -2.159484249353372), (\"hour\", -2.159484249353372),\n                                    (\"minute\", -1.6486586255873816)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.3025850929940455),\n                                    (\"yesterday\", -2.8134107167600364),\n                                    (\"day\", -2.8134107167600364),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"<time-of-day> am|pm\", -3.2188758248682006),\n                                    (\"hh:mm\", -2.3025850929940455), (\"hour\", -1.4271163556401458),\n                                    (\"minute\", -1.8325814637483102)],\n                               n = 20}}),\n       (\"the <cycle> after|before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -1.252762968495368),\n                                    (\"dayday\", -0.8472978603872037),\n                                    (\"day (grain)yesterday\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"hh(:mm) - <time-of-day> am|pm\", -2.890371757896165),\n                                    (\"this|last|next <cycle>\", -1.791759469228055),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"time-of-day (latent)\", -2.890371757896165),\n                                    (\"hhmm (latent)\", -2.4849066497880004),\n                                    (\"<time-of-day> am|pm\", -2.890371757896165),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"next <time>\", -2.890371757896165),\n                                    (\"this|next <day-of-week>\", -2.890371757896165),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mm/dd\", -2.0794415416798357), (\"day\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"Sukkot\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day> in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.2992829841302609),\n                                    (\"Marcha <unit-of-duration>\", -1.7047480922384253),\n                                    (\"March<integer> <unit-of-duration>\", -1.7047480922384253),\n                                    (\"Vijayadashami<integer> <unit-of-duration>\",\n                                     -1.7047480922384253),\n                                    (\"dayyear\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"World Vegan Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -5.407171771460119,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectthis|last|next <cycle>\", -4.709530201312334),\n                                    (\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayhour\", -4.304065093204169),\n                                    (\"daymonth\", -2.001480000210124),\n                                    (\"<named-month> <day-of-month> (non ordinal)Friday\",\n                                     -4.709530201312334),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"Wednesdayintersect\", -4.709530201312334),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.3232358401924436),\n                                    (\"Black Fridaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"<part-of-day> of <time>February\", -4.709530201312334),\n                                    (\"Saturday<time-of-day> am|pm\", -4.709530201312334),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -4.304065093204169),\n                                    (\"hourmonth\", -4.709530201312334),\n                                    (\"Fridayintersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n                                     -4.0163830207523885),\n                                    (\"dayday\", -2.458238402705839),\n                                    (\"the <day-of-month> (ordinal)February\", -4.304065093204169),\n                                    (\"WednesdayOctober\", -4.709530201312334),\n                                    (\"Wednesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4567672328169663),\n                                    (\"dayyear\", -4.0163830207523885),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"Thursdayhh:mm\", -4.304065093204169),\n                                    (\"TuesdayOctober\", -4.709530201312334),\n                                    (\"the <day-of-month> (ordinal)March\", -3.6109179126442243),\n                                    (\"Mondaythis|last|next <cycle>\", -3.7932394694381792),\n                                    (\"Fridayintersect\", -4.0163830207523885),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.304065093204169),\n                                    (\"intersectOctober\", -4.304065093204169),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -3.7932394694381792),\n                                    (\"Tuesdaythis|last|next <cycle>\", -4.304065093204169),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.709530201312334),\n                                    (\"dayminute\", -2.917770732084279),\n                                    (\"minuteday\", -3.4567672328169663),\n                                    (\"this|last|next <cycle>Sunday\", -4.709530201312334),\n                                    (\"Sundaythis|last|next <cycle>\", -4.709530201312334),\n                                    (\"on <day><time-of-day> am|pm\", -4.709530201312334),\n                                    (\"intersectintersect\", -4.709530201312334),\n                                    (\"weekday\", -4.709530201312334),\n                                    (\"dayweek\", -3.6109179126442243),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.304065093204169),\n                                    (\"<datetime> - <datetime> (interval)July\", -3.7932394694381792),\n                                    (\"on <day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.0163830207523885)],\n                               n = 76},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -5.220355825078324,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week-endJuly\", -4.5217885770490405),\n                                    (\"week-endOctober\", -3.828641396489095),\n                                    (\"daymonth\", -1.7809485531238394),\n                                    (\"TuesdaySeptember\", -4.5217885770490405),\n                                    (\"Wednesdayintersect\", -4.5217885770490405),\n                                    (\"from <datetime> - <datetime> (interval)July\",\n                                     -3.4231762883809305),\n                                    (\"from <time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"hournograin\", -4.116323468940876),\n                                    (\"from|since|after <time>July\", -4.116323468940876),\n                                    (\"hourmonth\", -2.575878427993727),\n                                    (\"Fridaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayFebruary\", -4.5217885770490405),\n                                    (\"on <day>September\", -3.828641396489095),\n                                    (\"WednesdayOctober\", -4.5217885770490405),\n                                    (\"intersectnow\", -4.116323468940876),\n                                    (\"week-endintersect\", -4.5217885770490405),\n                                    (\"dayyear\", -4.5217885770490405),\n                                    (\"FridayJuly\", -3.6054978451748854),\n                                    (\"FridaySeptember\", -4.116323468940876),\n                                    (\"the <day-of-month> (ordinal)July\", -3.6054978451748854),\n                                    (\"WednesdayFebruary\", -4.5217885770490405),\n                                    (\"minutemonth\", -3.0177111802727663),\n                                    (\"Mondaythis|last|next <cycle>\", -4.5217885770490405),\n                                    (\"SundayMarch\", -4.5217885770490405),\n                                    (\"MondayFebruary\", -4.116323468940876),\n                                    (\"Fridayintersect\", -4.5217885770490405),\n                                    (\"intersectOctober\", -4.5217885770490405),\n                                    (\"dayminute\", -4.5217885770490405),\n                                    (\"SaturdaySeptember\", -4.5217885770490405),\n                                    (\"intersectSeptember\", -3.1354942159291497),\n                                    (\"Tuesdaynow\", -4.116323468940876),\n                                    (\"MondayMarch\", -4.5217885770490405),\n                                    (\"FridayOctober\", -4.5217885770490405),\n                                    (\"daynograin\", -4.116323468940876),\n                                    (\"<integer> to|till|before <hour-of-day>July\",\n                                     -4.5217885770490405),\n                                    (\"Tuesdayintersect\", -4.5217885770490405),\n                                    (\"<time-of-day> - <time-of-day> (interval)July\",\n                                     -4.5217885770490405),\n                                    (\"<datetime> - <datetime> (interval)July\", -4.5217885770490405),\n                                    (\"Sundayintersect\", -4.5217885770490405)],\n                               n = 57}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7537718023763802, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Sunday\", -2.5649493574615367),\n                                    (\"Chinese New Year\", -1.8718021769015913),\n                                    (\"Easter Sunday\", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367), (\"Tuesday\", -2.5649493574615367),\n                                    (\"week-end\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6359887667199967, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -2.639057329615259), (\"Friday\", -2.2335922215070942),\n                                    (\"day\", -1.7227665977411035), (\"Sunday\", -2.639057329615259),\n                                    (\"hour\", -1.540445040947149), (\"week-end\", -1.540445040947149)],\n                               n = 9}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>|<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)\", -2.0149030205422647),\n                                    (\"Thursdayordinal (digits)\", -2.70805020110221),\n                                    (\"day\", -2.3025850929940455),\n                                    (\"Augustordinal (digits)\", -2.70805020110221),\n                                    (\"Marchordinals (first..twentieth,thirtieth,...)\",\n                                     -2.3025850929940455),\n                                    (\"Tuesdayordinal (digits)\", -2.70805020110221),\n                                    (\"Octoberordinals (first..twentieth,thirtieth,...)\",\n                                     -2.70805020110221),\n                                    (\"month\", -1.2039728043259361),\n                                    (\"Marchordinal (digits)\", -2.70805020110221)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>ordinal (digits)\",\n                                     -1.9459101490553135),\n                                    (\"Augustordinal (digits)\", -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"Clean Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6325225587435105, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -1.3350010667323402),\n                                    (\"ordinal (digits)\", -0.3053816495511819)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.7576857016975165, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.5306282510621704),\n                                    (\"ordinal (digits)\", -0.8873031950009028)],\n                               n = 15}}),\n       (\"<time> (timezone)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval) timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.8109302162163288),\n                                    (\"hh:mmhh:mm\", -1.5040773967762742),\n                                    (\"hhhmmhhhmm\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Isra and Mi'raj\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) of <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5679840376059393, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -3.068052935133617),\n                                    (\"ordinals (first..twentieth,thirtieth,...)March\",\n                                     -1.9694406464655074),\n                                    (\"ordinal (digits)this|last|next <cycle>\", -2.374905754573672),\n                                    (\"integer (numeric)this|last|next <cycle>\", -2.662587827025453),\n                                    (\"ordinal (digits)February\", -3.068052935133617),\n                                    (\"integer (numeric)February\", -2.662587827025453),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"ordinal (digits)March\", -2.662587827025453),\n                                    (\"integer (numeric)July\", -3.068052935133617)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.8362480242006186, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.6094379124341003),\n                                    (\"ordinal (digits)February\", -2.8622008809294686),\n                                    (\"month\", -0.916290731874155),\n                                    (\"integer (numeric)July\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month>(ordinal or number)/<named-month>/year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Naraka Chaturdashi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyyqq\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"beginning of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martin Luther King's Day\", -2.0149030205422647),\n                                    (\"Halloween\", -2.70805020110221),\n                                    (\"Boss's Day\", -2.70805020110221),\n                                    (\"Monday\", -2.3025850929940455), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9459101490553135),\n                                    (\"Saturday\", -1.9459101490553135), (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time-of-day> sharp|exactly\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hhmm (latent)\", -2.1400661634962708),\n                                    (\"<time-of-day> am|pm\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.1400661634962708), (\"hour\", -1.7346010553881064),\n                                    (\"minute\", -1.4469189829363254)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> closest <day> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Christmastoday\",\n                                     -1.791759469228055),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"ordinal (digits)Christmastoday\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"ordinals (first..twentieth,thirtieth,...)MondayOctober\",\n                                     -1.3862943611198906)],\n                               n = 1}}),\n       (\"Islamic New Year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.129329438755058e-2),\n                                    (\"integer (0..19)\", -2.995732273553991)],\n                               n = 38}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half a <time-grain>\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Purim\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> before last|after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Friday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"March\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this|last|next <cycle>\", -0.8109302162163288),\n                                    (\"year\", -1.5040773967762742), (\"month\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour (abbrev).\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1631508098056809, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -3.6635616461296463),\n                                    (\"from|since|after <time>hh:mm\", -3.152736022363656),\n                                    (\"minuteminute\", -1.5841201044498106),\n                                    (\"<time> timezone<time> timezone\", -3.3758795736778655),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"hh:mmhh:mm\", -2.5649493574615367),\n                                    (\"dayday\", -2.5649493574615367),\n                                    (\"hhhmmhhhmm\", -3.152736022363656),\n                                    (\"hourhour\", -3.6635616461296463),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -3.6635616461296463),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"hh:mm\",\n                                     -3.6635616461296463),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -4.069026754237811),\n                                    (\"hoursecond\", -3.6635616461296463),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.3758795736778655),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -3.152736022363656)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -0.3746934494414107, unseen = -5.308267697401205,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.204692619390966),\n                                    (\"<time> timezonehhhmm\", -4.204692619390966),\n                                    (\"hourday\", -3.00071981506503),\n                                    (\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -4.61015772749913),\n                                    (\"dayhour\", -4.61015772749913),\n                                    (\"daymonth\", -3.6938669956249752),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <month>\",\n                                     -3.6938669956249752),\n                                    (\"<time-of-day> am|pmintersect\", -4.61015772749913),\n                                    (\"MondayOctober\", -4.204692619390966),\n                                    (\"from|since|after <time>hh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.5115454388310208),\n                                    (\"hhhmmintersect\", -4.61015772749913),\n                                    (\"minuteminute\", -2.167810692129926),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.917010546939185),\n                                    (\"hh:mmhh:mm\", -3.917010546939185),\n                                    (\"dayday\", -1.8067973465925955),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hhhmmhhhmm\", -4.204692619390966),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"hourminute\", -4.61015772749913),\n                                    (\"minutehour\", -3.6938669956249752),\n                                    (\"<time> timezonehh:mm\", -4.61015772749913),\n                                    (\"hh:mm<time> timezone\", -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time><day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.6938669956249752),\n                                    (\"hh:mmintersect\", -3.6938669956249752),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -4.61015772749913),\n                                    (\"Christmastoday\", -3.917010546939185),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>intersect\", -3.1060803307228566),\n                                    (\"from|since|after <time>intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n                                     -3.6938669956249752),\n                                    (\"Monday<named-month>|<named-day> <day-of-month> (ordinal)\",\n                                     -4.204692619390966),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -3.1060803307228566),\n                                    (\"the <day-of-month> (ordinal)<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.61015772749913),\n                                    (\"from|since|after <time>the <day-of-month> (ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)the <day-of-month> (ordinal or number) of <named-month>\",\n                                     -4.204692619390966),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.61015772749913),\n                                    (\"the <day-of-month> (ordinal)intersect\", -4.204692619390966)],\n                               n = 77}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Laylat al-Qadr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Boghi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at the beginning|end of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"January\", -1.3862943611198906),\n                                    (\"April\", -1.3862943611198906), (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1340142157190256, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>hh:mm\", -3.054001181677967),\n                                    (\"hh:mmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"minuteminute\", -1.667706820558076),\n                                    (\"<time> timezone<time> timezone\", -3.2771447329921766),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.970291913552122),\n                                    (\"hh:mmhh:mm\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"hhhmmhhhmm\", -3.054001181677967),\n                                    (\"hourhour\", -2.466214516775848),\n                                    (\"minutehour\", -2.466214516775848),\n                                    (\"<time-of-day> am|pmhh:mm:ss\", -3.970291913552122),\n                                    (\"hhhmmtime-of-day (latent)\", -3.2771447329921766),\n                                    (\"hoursecond\", -3.5648268054439574),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.2771447329921766),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\", -3.054001181677967)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.38822330167365837,\n                               unseen = -5.241747015059643,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hhhmm<time> timezone\", -4.137829674161839),\n                                    (\"<time> timezonehhhmm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day>time-of-day (latent)\",\n                                     -4.543294782270004),\n                                    (\"until <time>time-of-day (latent)\", -3.2905318137746358),\n                                    (\"from|since|after <time>hh:mm\", -4.543294782270004),\n                                    (\"hh:mmtime-of-day (latent)\", -2.463853240590168),\n                                    (\"hh:mm<time-of-day> am|pm\", -3.1570004211501135),\n                                    (\"minuteminute\", -2.463853240590168),\n                                    (\"from|since|after <time><time-of-day> am|pm\",\n                                     -3.6270040503958487),\n                                    (\"hh:mmhh:mm\", -3.8501476017100584),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\", -4.137829674161839),\n                                    (\"hhhmmhhhmm\", -4.137829674161839),\n                                    (\"hourhour\", -2.0583881324820035),\n                                    (\"from|since|after <time><integer> to|till|before <hour-of-day>\",\n                                     -3.8501476017100584),\n                                    (\"hourminute\", -3.4446824936018943),\n                                    (\"minutehour\", -1.6529230243738393),\n                                    (\"<time> timezonehh:mm\", -4.543294782270004),\n                                    (\"hh:mm<time> timezone\", -4.543294782270004),\n                                    (\"hhhmmtime-of-day (latent)\", -3.8501476017100584),\n                                    (\"until <time><time-of-day> am|pm\", -4.137829674161839),\n                                    (\"about|exactly <time-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<time-of-day> am|pmhh:mm\", -4.543294782270004),\n                                    (\"<part-of-day> at <time-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584),\n                                    (\"from|since|after <time>time-of-day (latent)\",\n                                     -3.0392173854937297),\n                                    (\"at <time-of-day>time-of-day (latent)\", -3.8501476017100584),\n                                    (\"<time> timezonetime-of-day (latent)\", -3.8501476017100584),\n                                    (\"<integer> to|till|before <hour-of-day><time-of-day> am|pm\",\n                                     -4.543294782270004),\n                                    (\"<integer> to|till|before <hour-of-day>time-of-day (latent)\",\n                                     -3.8501476017100584)],\n                               n = 78}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tuesdayintersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TuesdayChristmas\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"Ugadi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3646431135879093, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.691243082785829),\n                                    (\"Marchinteger (numeric)\", -2.9789251552376097),\n                                    (\"Aprilinteger (numeric)\", -3.3843902633457743),\n                                    (\"month\", -0.8194409058842375),\n                                    (\"Februaryinteger (numeric)\", -2.1316272948504063),\n                                    (\"Septemberinteger (numeric)\", -2.691243082785829),\n                                    (\"Octoberinteger (numeric)\", -2.691243082785829),\n                                    (\"Julyinteger (numeric)\", -1.9980959022258835)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.1856236656577395,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -2.3353749158170367),\n                                    (\"Marchinteger (numeric)\", -2.740840023925201),\n                                    (\"Aprilinteger (numeric)\", -2.740840023925201),\n                                    (\"month\", -0.9490805546971459),\n                                    (\"from|since|after <time>integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"Julyinteger (numeric)\", -1.6422277352570913)],\n                               n = 11}}),\n       (\"Diwali\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.3978952727983707),\n                                    (\"Wednesday\", -2.3978952727983707),\n                                    (\"Saturday\", -2.3978952727983707),\n                                    (\"Monday\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Tuesday\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9924301646902063),\n                                    (\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -2.3978952727983707),\n                                    (\"week (grain)September\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2335922215070942),\n                                    (\"day (grain)May\", -2.2335922215070942),\n                                    (\"week (grain)year (latent)\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.7227665977411035),\n                                    (\"week (grain)October\", -2.2335922215070942),\n                                    (\"weekyear\", -1.9459101490553135),\n                                    (\"week (grain)intersect\", -2.2335922215070942)],\n                               n = 9}}),\n       (\"Chhath\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vasant Panchami\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"daymonth\", -2.1972245773362196),\n                                    (\"ordinal (digits)day (grain)May\", -2.1972245773362196),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"ordinal (digits)week (grain)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"weekyear\", -1.791759469228055),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)October\",\n                                     -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Black Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Great Lent\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maundy Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vaisakhi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>intersect\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -2.2512917986064953),\n                                    (\"dayday\", -1.55814461804655),\n                                    (\"minutehour\", -1.845826690498331),\n                                    (\"<integer> + '\\\"<time-of-day> am|pm\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration><day-of-month> (ordinal or number) <named-month>\",\n                                     -2.2512917986064953)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<integer> + '\\\"from|since|after <time>\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.8718021769015913),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 2}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..19)powers of tens\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time> and <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -2.1972245773362196),\n                                    (\"<time-of-day> am|pmtime-of-day (latent)\",\n                                     -2.1972245773362196),\n                                    (\"hhhmmhhhmm\", -2.1972245773362196),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"<time-of-day> am|pm<time-of-day> am|pm\",\n                                     -2.1972245773362196)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.1972245773362196),\n                                    (\"hhhmmintersect\", -2.1972245773362196),\n                                    (\"minuteminute\", -1.791759469228055),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"hh:mmintersect\", -2.1972245773362196),\n                                    (\"hhhmmtime-of-day (latent)\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"from|since|after <time>integer (numeric)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"from|since|after <time>ordinal (digits)ordinal (digits)\",\n                                     -2.740840023925201),\n                                    (\"Julyinteger (numeric)integer (numeric)\", -1.6422277352570913),\n                                    (\"Augustordinal (digits)integer (numeric)\",\n                                     -2.3353749158170367),\n                                    (\"from|since|after <time>ordinal (digits)integer (numeric)\",\n                                     -2.740840023925201),\n                                    (\"month\", -0.8690378470236094),\n                                    (\"Augustordinal (digits)ordinal (digits)\",\n                                     -2.3353749158170367)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Black Fridaythis|last|next <cycle>\", -2.803360380906535),\n                                    (\"Martin Luther King's Daythis|last|next <cycle>\",\n                                     -2.3978952727983707),\n                                    (\"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"year (latent)\",\n                                     -2.1102132003465894),\n                                    (\"dayyear\", -0.8574502318512216),\n                                    (\"intersectyear (latent)\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month> (non ordinal)year (latent)\",\n                                     -1.8870696490323797)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Fridaythis|last|next <cycle>\", -1.5040773967762742),\n                                    (\"dayyear\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -4.1672696400568074e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -3.1986731175506815,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"at the beginning|end of <week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.706570200892086),\n                                    (\"this|last|next <cycle>\", -0.8209805520698302),\n                                    (\"about|exactly <time-of-day>\", -2.70805020110221)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eid al-Fitr\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Trinity Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>/<datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"secondsecond\", -0.916290731874155),\n                                    (\"intersectintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm:ssintersect\", -0.916290731874155),\n                                    (\"secondsecond\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Mid-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)September\",\n                                     -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)July\", -1.9924301646902063),\n                                    (\"ordinal (digits)ordinal (digits)October\",\n                                     -2.3978952727983707),\n                                    (\"integer (numeric)integer (numeric)July\", -1.9924301646902063),\n                                    (\"month\", -0.8938178760220964),\n                                    (\"ordinal (digits)ordinal (digits)August\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -2.5257286443082556),\n                                    (\"Martin Luther King's Day\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.1394342831883648),\n                                    (\"Christmas\", -2.5257286443082556),\n                                    (\"hour\", -2.5257286443082556), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Shushan Purim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 4113}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_AR (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1470}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_CL (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1470}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_CO (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1470}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_ES (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1470}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_MX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number .\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1477}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_PE (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1470}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_VE (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1470}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ES_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Martes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5659920050746986, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.8388589917413389, unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.791759469228055),\n                                    (\"el <time>\", -1.3862943611198906),\n                                    (\"Domingo\", -1.791759469228055), (\"day\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `de`\",\n        Classifier{okData =\n                     ClassData{prior = -0.19290366612449156,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Miercoleseste|en un <cycle>\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)intersect by `de`\",\n                                     -3.784189633918261),\n                                    (\"daymonth\", -1.8382794848629478),\n                                    (\"monthyear\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Abril\", -4.189654742026425),\n                                    (\"Marteseste|en un <cycle>\", -4.189654742026425),\n                                    (\"Miercolesel <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <time>Marzo\", -3.784189633918261),\n                                    (\"el <day-of-month> (non ordinal)Septiembre\",\n                                     -4.189654742026425),\n                                    (\"Miercolesel proximo <cycle> \", -4.189654742026425),\n                                    (\"Luneseste|en un <cycle>\", -4.189654742026425),\n                                    (\"dayyear\", -2.1102132003465894),\n                                    (\"dd-dd <month>(interval)year\", -4.189654742026425),\n                                    (\"el <time>el <cycle> (proximo|que viene)\", -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Julio\", -4.189654742026425),\n                                    (\"el <time>year\", -3.784189633918261),\n                                    (\"Septiembreyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -3.4965075614664802),\n                                    (\"el <time>la <cycle> pasado\", -4.189654742026425),\n                                    (\"day of month (1st)Marzo\", -3.2733640101522705),\n                                    (\"el <day-of-month> de <named-month>year\", -3.784189633918261),\n                                    (\"el <time>este|en un <cycle>\", -3.784189633918261),\n                                    (\"Mayoyear\", -4.189654742026425),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year (value by adding three composing numbers together)\",\n                                     -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Febrero\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"intersect by `de`\",\n                                     -4.189654742026425),\n                                    (\"dayweek\", -2.4849066497880004),\n                                    (\"intersect by `de`year\", -3.4965075614664802),\n                                    (\"el <day-of-month> (non ordinal)Marzo\", -3.4965075614664802),\n                                    (\"Domingola <cycle> pasado\", -4.189654742026425),\n                                    (\"two time tokens separated by \\\",\\\"Septiembre\",\n                                     -4.189654742026425),\n                                    (\"el <day-of-month> (non ordinal)Mayo\", -3.4965075614664802)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -1.7404661748405046, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mayoyear (value by adding three composing numbers together)\",\n                                     -3.367295829986474),\n                                    (\"monthyear\", -2.268683541318364),\n                                    (\"Julioyear\", -3.367295829986474),\n                                    (\"hourmonth\", -2.9618307218783095),\n                                    (\"a las <time-of-day>Julio\", -3.367295829986474),\n                                    (\"dayyear\", -2.6741486494265287),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.6741486494265287),\n                                    (\"Mayoyear\", -2.6741486494265287),\n                                    (\"a las <time-of-day>Enero\", -3.367295829986474)],\n                               n = 10}}),\n       (\"n pasados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)a\\241o (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906),\n                                    (\"number (0..15)mes (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"pasados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)mes (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"number (0..15)semana (grain)\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Abril\", -1.252762968495368),\n                                    (\"integer (numeric)Marzo\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernesintersect by `de`\", -1.466337068793427),\n                                    (\"Lunes<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"dayday\", -0.8602012652231115),\n                                    (\"Viernesel <day-of-month> de <named-month>\",\n                                     -2.5649493574615367),\n                                    (\"Viernesel <time>\", -2.159484249353372),\n                                    (\"Viernesel <day-of-month> (non ordinal)\",\n                                     -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la manana\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"big number 100 to 1K\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del mediod\\237a\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Prematuridad Mundial\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mayo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Jueves\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.277267285009756),\n                                    (\"Lunesin the <part-of-day>\", -3.6635616461296463),\n                                    (\"tomorrowin the <part-of-day>\", -3.6635616461296463),\n                                    (\"a las <time-of-day>del mediod\\237a\", -3.6635616461296463),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"hourhour\", -2.159484249353372),\n                                    (\"a las <time-of-day>in the <part-of-day>\",\n                                     -2.4107986776342782),\n                                    (\"intersectin the <part-of-day>\", -3.6635616461296463),\n                                    (\"minutehour\", -1.717651497074333),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.258096538021482),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>del mediod\\237a\",\n                                     -3.258096538021482),\n                                    (\"el <time>in the <part-of-day>\", -3.6635616461296463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.6635616461296463),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -2.7472709142554916),\n                                    (\"yesterdayin the <part-of-day>\", -3.6635616461296463),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.7472709142554916)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.70805020110221),\n                                    (\"year (latent)del mediod\\237a\", -2.70805020110221),\n                                    (\"monthhour\", -2.70805020110221),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"Febreroin the <part-of-day>\", -2.70805020110221),\n                                    (\"time-of-day (latent)in the <part-of-day>\",\n                                     -2.3025850929940455)],\n                               n = 4}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.3862943611198906),\n                                    (\"monthday\", -1.3862943611198906),\n                                    (\"Diciembretime-of-day (latent)\", -1.3862943611198906),\n                                    (\"monthhour\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.20585205420414873,\n                               unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.0149030205422647),\n                                    (\"Lunesin the <part-of-day>\", -3.960813169597578),\n                                    (\"tomorrowin the <part-of-day>\", -3.960813169597578),\n                                    (\"el <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"D\\237a Internacional de las Cooperativasel <time>\",\n                                     -3.960813169597578),\n                                    (\"hourhour\", -3.044522437723423),\n                                    (\"now<hour-of-day> minus quarter (as relative minutes)\",\n                                     -3.960813169597578),\n                                    (\"dayyear\", -3.044522437723423),\n                                    (\"a las <time-of-day>in the <part-of-day>\", -2.70805020110221),\n                                    (\"intersectin the <part-of-day>\", -3.960813169597578),\n                                    (\"<named-month> <day-of-month>del <year>\", -3.960813169597578),\n                                    (\"minutehour\", -2.256065077359153),\n                                    (\"intersect by `de`in the <part-of-day>\", -3.960813169597578),\n                                    (\"now<hour-of-day> and <relative minutes>\", -3.960813169597578),\n                                    (\"<hour-of-day> and halfin the <part-of-day>\",\n                                     -3.5553480614894135),\n                                    (\"tomorrowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"Miercoles<time-of-day> <part-of-day>\", -3.960813169597578),\n                                    (\"<hour-of-day> <integer> (as relative minutes)in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"Miercoles<dim time> de la manana\", -3.960813169597578),\n                                    (\"dayminute\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month>el <time>\", -3.960813169597578),\n                                    (\"Miercolesa las <time-of-day>\", -3.960813169597578),\n                                    (\"el <time>in the <part-of-day>\", -3.960813169597578),\n                                    (\"Miercolesintersect\", -3.960813169597578),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -3.960813169597578),\n                                    (\"nowa las <time-of-day>\", -3.5553480614894135),\n                                    (\"D\\237a Internacional de las Cooperativasdel <year>\",\n                                     -3.960813169597578),\n                                    (\"<hour-of-day> and quarterin the <part-of-day>\",\n                                     -3.044522437723423),\n                                    (\"yesterdayin the <part-of-day>\", -3.960813169597578)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -1.6817585740137264, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.2386784521643803),\n                                    (\"dayhour\", -2.5455312716044354),\n                                    (\"monthhour\", -2.833213344056216),\n                                    (\"now<hour-of-day> and <relative minutes>\",\n                                     -3.2386784521643803),\n                                    (\"Diciembrea las <time-of-day>\", -3.2386784521643803),\n                                    (\"dayminute\", -2.833213344056216),\n                                    (\"Febreroin the <part-of-day>\", -3.2386784521643803),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>a las <time-of-day>\",\n                                     -3.2386784521643803),\n                                    (\"nowa las <time-of-day>\", -2.5455312716044354),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.2386784521643803)],\n                               n = 8}}),\n       (\"Miercoles\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a las <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.320340402329494e-2,\n                               unseen = -5.135798437050262,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -3.7436043538031827),\n                                    (\"<time-of-day> horas\", -4.436751534363128),\n                                    (\"<hour-of-day> and quarter\", -3.520460802488973),\n                                    (\"time-of-day (latent)\", -1.4163266482187657),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.3381392456950185),\n                                    (\"<time-of-day> am|pm\", -2.5649493574615367),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -4.436751534363128),\n                                    (\"<hour-of-day> minus quarter (as relative minutes)\",\n                                     -4.0312864262549635),\n                                    (\"hour\", -1.3686985992295109), (\"minute\", -1.4923125551966876),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.644992065135073)],\n                               n = 79},\n                   koData =\n                     ClassData{prior = -2.6508917872622613,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5260563034950494),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.03688192726104),\n                                    (\"hour\", -1.5260563034950494), (\"minute\", -2.03688192726104)],\n                               n = 6}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"number (20..90)\", 0.0)],\n                               n = 1}}),\n       (\"Viernes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.4350845252893227),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hace <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..15)Marzo\", -2.6741486494265287),\n                                    (\"integer (numeric)Abril\", -2.6741486494265287),\n                                    (\"number (0..15)Mayo\", -2.268683541318364),\n                                    (\"integer (numeric)Marzo\", -2.268683541318364),\n                                    (\"integer (numeric)Febrero\", -2.6741486494265287),\n                                    (\"integer (numeric)Septiembre\", -2.6741486494265287),\n                                    (\"month\", -0.9694005571881036),\n                                    (\"integer (numeric)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Julio\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a Mundial de la Lengua \\193rabe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de los Inocentes de Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"number (0..15)\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5317807984289897e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -3.4339872044851463),\n                                    (\"<named-month|named-day> past\", -3.4339872044851463),\n                                    (\"dd[/-]mm\", -3.146305132033365),\n                                    (\"intersect by `de`\", -2.3353749158170367),\n                                    (\"<time-of-day> <part-of-day>\", -3.8394523125933104),\n                                    (\"intersect\", -3.8394523125933104),\n                                    (\"Miercoles\", -3.4339872044851463),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.0476928433652555),\n                                    (\"Domingo\", -3.4339872044851463),\n                                    (\"Lunes\", -3.8394523125933104), (\"day\", -0.9490805546971459),\n                                    (\"year\", -3.4339872044851463),\n                                    (\"day of month (1st)\", -3.4339872044851463),\n                                    (\"<named-month|named-day> next\", -3.8394523125933104),\n                                    (\"hour\", -3.4339872044851463),\n                                    (\"this|next <day-of-week>\", -3.8394523125933104)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -3.6888794541139363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -2.2512917986064953), (\"hour\", -2.2512917986064953)],\n                               n = 1}}),\n       (\"Septiembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<thousands> 0..999\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable form<hundreds> 0..99\",\n                                     -0.2876820724517809)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"1K or 1M in multipliable formbig number 100 to 1K\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primero..10)Marzo\", -2.9618307218783095),\n                                    (\"number (0..15)Marzo\", -2.9618307218783095),\n                                    (\"integer (numeric)Abril\", -2.9618307218783095),\n                                    (\"integer (numeric)Diciembre\", -3.367295829986474),\n                                    (\"number (0..15)Mayo\", -2.6741486494265287),\n                                    (\"integer (numeric)Enero\", -3.367295829986474),\n                                    (\"integer (numeric)Marzo\", -2.451005098112319),\n                                    (\"integer (numeric)Febrero\", -2.268683541318364),\n                                    (\"integer (numeric)Septiembre\", -3.367295829986474),\n                                    (\"month\", -0.8823891801984737),\n                                    (\"integer (numeric)Mayo\", -3.367295829986474),\n                                    (\"integer (numeric)Julio\", -3.367295829986474)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.6739764335716716),\n                                    (\"integer (numeric)Julio\", -1.6739764335716716)],\n                               n = 2}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primero..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"invierno\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..15)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13858616328614667,\n                               unseen = -4.330733340286331,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 74},\n                   koData =\n                     ClassData{prior = -2.044755983691946, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"D\\237a Internacional de las Cooperativas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este|en un <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0296194171811581),\n                                    (\"semana (grain)\", -1.0296194171811581),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2006706954621511),\n                                    (\"number (0..15)\", -1.7047480922384253)],\n                               n = 9}}),\n       (\"Lunes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julio\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.12188981760903689, unseen = -4.02535169073515,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 54},\n                   koData =\n                     ClassData{prior = -2.164963715117998, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Juevesinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"1K or 1M in multipliable form\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6592456288842639, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3062516534463542),\n                                    (\"number (0..15)\", -0.3448404862917295)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -0.7282385003712154, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.5040773967762742),\n                                    (\"number (0..15)\", -0.7156200364120039),\n                                    (\"integer (0-9) with two digits\", -1.241713132308783)],\n                               n = 42}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"time-of-day (latent)number (0..15)\", -2.6026896854443837),\n                                    (\"a las <time-of-day>number (20..90)\", -2.1972245773362196),\n                                    (\"a las <time-of-day>number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -2.1972245773362196),\n                                    (\"hour\", -0.8979415932059586),\n                                    (\"a las <time-of-day>number (0..15)\", -2.6026896854443837),\n                                    (\"time-of-day (latent)number (20..90)\", -2.1972245773362196)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>number (20..90)\", -1.6094379124341003),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"time-of-day (latent)number (20..90)\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5108256237659907),\n                                    (\"<thousands> 0..999\", -1.2039728043259361)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"<thousands> 0..999\", -1.3862943611198906),\n                                    (\"1K or 1M in multipliable form\", -1.3862943611198906)],\n                               n = 9}}),\n       (\"en <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que viene)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"number (0..15)mes (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.028522096376982),\n                                    (\"integer (numeric)hora (grain)\", -3.4339872044851463),\n                                    (\"integer (numeric)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)segundo (grain)\", -3.4339872044851463),\n                                    (\"second\", -3.4339872044851463),\n                                    (\"number (0..15)a\\241o (grain)\", -3.028522096376982),\n                                    (\"integer (numeric)minutos (grain)\", -2.740840023925201),\n                                    (\"day\", -3.028522096376982), (\"year\", -2.740840023925201),\n                                    (\"number (0..15)mes (grain)\", -3.028522096376982),\n                                    (\"number (0..15)hora (grain)\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -3.028522096376982),\n                                    (\"number (0..15)dia (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)minutos (grain)\", -3.028522096376982),\n                                    (\"number (16..19 21..29)hora (grain)\", -3.4339872044851463),\n                                    (\"minute\", -2.3353749158170367),\n                                    (\"integer (numeric)a\\241o (grain)\", -3.4339872044851463),\n                                    (\"number (0..15)semana (grain)\", -3.028522096376982)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.890371757896165),\n                                    (\"integer (numeric)hora (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)dia (grain)\", -2.890371757896165),\n                                    (\"integer (numeric)mes (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"number (0..15)a\\241o (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)semana (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)minutos (grain)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"integer (numeric)segundo (grain)\", -2.890371757896165),\n                                    (\"year\", -2.6026896854443837),\n                                    (\"number (0..15)mes (grain)\", -2.890371757896165),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.6026896854443837),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)a\\241o (grain)\", -2.890371757896165),\n                                    (\"number (0..15)semana (grain)\", -3.295836866004329)],\n                               n = 16}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"number (0..15)a\\241o (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"number (0..15)mes (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7069405026922811, unseen = -4.356708826689592,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.7788560643921472),\n                                    (\"time-of-day (latent)\", -3.6506582412937383),\n                                    (\"hour\", -3.245193133185574), (\"minute\", -0.7884573603642702),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.1657515915057381)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -0.6795415285041666, unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1113513144455396),\n                                    (\"hour\", -1.1113513144455396), (\"minute\", -1.8044984950054848),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.8044984950054848)],\n                               n = 37}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055),\n                                    (\"integer (numeric)a\\241o (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano nuevo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la <cycle> pasado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semana (grain)\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"a\\241o (grain)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"la pasado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (20..90)number (0..15)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sabado\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Diciembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"D\\237a de la Cero Discriminaci\\243n\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a\\241o (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hundreds> 0..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)number (0..15)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"a las <time-of-day>number (0..15)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martes\", -1.6094379124341003),\n                                    (\"Miercoles\", -1.6094379124341003),\n                                    (\"el <time>\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (16..19 21..29)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> de la tarde\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.662587827025453),\n                                    (\"a las <time-of-day>\", -1.6817585740137264),\n                                    (\"<hour-of-day> and quarter\", -2.151762203259462),\n                                    (\"time-of-day (latent)\", -2.151762203259462),\n                                    (\"hour\", -1.563975538357343), (\"minute\", -1.363304842895192),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.068052935133617)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"el proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"a\\241o (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quarter (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"del <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febrero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -1.791759469228055),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Diciembre<day-of-month> (ordinal or number) de <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"dayyear\", -1.540445040947149),\n                                    (\"dd[/-]mmyear\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Enero\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"el <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2682639865946794),\n                                    (\"number (0..15)\", -1.4469189829363254)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next week (alt)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"semana (grain)\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marzointeger (numeric)\", -1.6094379124341003),\n                                    (\"Abrilinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"Mayointeger (numeric)\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.455287232606842),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -2.0149030205422647),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"morning\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Viernes\", -1.0986122886681098),\n                                    (\"Lunes\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nochevieja\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (value by adding three composing numbers together)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"big number 100 to 1Knumber (20..90)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Navidad\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a las <time-of-day>integer (0-9) with two digits\",\n                                     -1.4853852637641216),\n                                    (\"time-of-day (latent)integer (0-9) with two digits\",\n                                     -1.405342556090585),\n                                    (\"time-of-day (latent)number (0..15)\", -3.2771447329921766),\n                                    (\"hour\", -0.7514160886839211)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (numeric)\", -1.9810014688665833),\n                                    (\"time-of-day (latent)number (0..15)\", -1.0647107369924282),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12}}),\n       (\"integer (0-9) with two digits\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"number (0..15)\", -0.3364722366212129)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"invierno\", -2.0794415416798357),\n                                    (\"Lunes\", -2.0794415416798357), (\"verano\", -2.0794415416798357),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.6739764335716716),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1470}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ET_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.FA_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.FI_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.FR_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"n derniers <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.803360380906535),\n                                    (\"number (0..16)seconde (grain)\", -2.803360380906535),\n                                    (\"number (0..16)jour (grain)\", -2.803360380906535),\n                                    (\"second\", -2.3978952727983707),\n                                    (\"integer (numeric)ann\\233e (grain)\", -2.803360380906535),\n                                    (\"integer (numeric)seconde (grain)\", -2.803360380906535),\n                                    (\"number (0..16)minute (grain)\", -2.803360380906535),\n                                    (\"integer (numeric)jour (grain)\", -2.803360380906535),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.803360380906535),\n                                    (\"month\", -2.803360380906535),\n                                    (\"integer (numeric)minute (grain)\", -2.803360380906535),\n                                    (\"integer (numeric)mois (grain)\", -2.803360380906535),\n                                    (\"minute\", -2.3978952727983707),\n                                    (\"integer (numeric)semaine (grain)\", -2.803360380906535)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> prochain\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mardi\", -1.0986122886681098), (\"day\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mercredi\", -1.3862943611198906), (\"day\", -0.9808292530117262),\n                                    (\"Lundi\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"du|dans le <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"soir\", -1.3862943611198906),\n                                    (\"apr\\232s-midi\", -2.174751721484161),\n                                    (\"matin\", -1.8382794848629478), (\"hour\", -0.7396671961948381)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -0.8109302162163288,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"soir\", -2.1972245773362196),\n                                    (\"apr\\232s-midi\", -2.1972245773362196),\n                                    (\"matin\", -1.1856236656577395), (\"hour\", -0.750305594399894)],\n                               n = 16}}),\n       (\"du dd au dd (interval) (latent month)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)integer (numeric)\", -1.6094379124341003),\n                                    (\"integer (numeric)integer (numeric)\", -1.6094379124341003),\n                                    (\"number (0..16)integer (numeric)\", -1.6094379124341003),\n                                    (\"ordinal (digits)number (17..19)\", -1.6094379124341003),\n                                    (\"ordinal (digits)number (0..16)\", -1.6094379124341003)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)number (0..16)\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"dans <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.639057329615259),\n                                    (\"<integer> + '\\\"\", -2.9267394020670396),\n                                    (\"second\", -2.639057329615259), (\"day\", -2.9267394020670396),\n                                    (\"year\", -2.639057329615259),\n                                    (\"<integer> <unit-of-duration>\", -1.1921383466789333),\n                                    (\"une <unit-of-duration>\", -2.2335922215070942),\n                                    (\"hour\", -2.4159137783010487), (\"month\", -3.332204510175204),\n                                    (\"minute\", -1.9459101490553135)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9459101490553135), (\"day\", -1.9459101490553135),\n                                    (\"une <unit-of-duration>\", -1.540445040947149)],\n                               n = 2}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224|vers <time-of-day>\", -1.6094379124341003),\n                                    (\"hour\", -1.2039728043259361),\n                                    (\"<time-of-day> heures\", -1.6094379124341003)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224|vers <time-of-day>\", -1.7047480922384253),\n                                    (\"<hour-of-day> et quart\", -1.9924301646902063),\n                                    (\"hour\", -1.9924301646902063),\n                                    (\"<hour-of-day> et demi\", -1.9924301646902063),\n                                    (\"minute\", -1.1451323043030026),\n                                    (\"<time-of-day> heures\", -2.3978952727983707)],\n                               n = 8}}),\n       (\"n <cycle> apr\\232s\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..16)jour (grain)\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4620354595965587, unseen = -5.537334267018537,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 252},\n                   koData =\n                     ClassData{prior = -0.9942522733438669,\n                               unseen = -5.0106352940962555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 148}}),\n       (\"the nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (premier..seizieme)Mercredi<cycle> prochain|suivant|d'apr\\232s\",\n                                     -0.6931471805599453),\n                                    (\"daymonth\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Decembre\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"apr\\232s le travail\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n prochains <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.833213344056216),\n                                    (\"number (0..16)seconde (grain)\", -2.833213344056216),\n                                    (\"second\", -2.4277482359480516),\n                                    (\"integer (numeric)ann\\233e (grain)\", -2.833213344056216),\n                                    (\"integer (numeric)seconde (grain)\", -2.833213344056216),\n                                    (\"number (0..16)minute (grain)\", -2.833213344056216),\n                                    (\"integer (numeric)jour (grain)\", -2.833213344056216),\n                                    (\"day\", -2.833213344056216), (\"year\", -2.833213344056216),\n                                    (\"hour\", -2.833213344056216), (\"month\", -2.833213344056216),\n                                    (\"integer (numeric)minute (grain)\", -2.833213344056216),\n                                    (\"integer (numeric)mois (grain)\", -2.833213344056216),\n                                    (\"minute\", -2.4277482359480516),\n                                    (\"integer (numeric)semaine (grain)\", -2.833213344056216),\n                                    (\"integer (numeric)heure (grain)\", -2.833213344056216)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fin d'ann\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month> \\224 <time-of-day>)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.916290731874155),\n                                    (\"Samediinteger (numeric)\\224|vers <time-of-day>\",\n                                     -2.0149030205422647),\n                                    (\"Jeudiinteger (numeric)\\224|vers <time-of-day>\",\n                                     -2.0149030205422647),\n                                    (\"Vendredinumber (0..16)\\224|vers <time-of-day>\",\n                                     -1.6094379124341003),\n                                    (\"Vendrediinteger (numeric)\\224|vers <time-of-day>\",\n                                     -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"apr\\232s le d\\233jeuner\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-day> en quinze\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mercredi\", -1.6739764335716716),\n                                    (\"Mardi\", -1.6739764335716716), (\"day\", -0.8266785731844679),\n                                    (\"Lundi\", -1.6739764335716716)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Juillet\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 30},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"entre <datetime> et <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3483066942682157,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"le <time>le <day-of-month> (non ordinal)\",\n                                     -2.890371757896165),\n                                    (\"le <time>le <time>\", -2.4849066497880004),\n                                    (\"dayday\", -1.0986122886681098),\n                                    (\"hourhour\", -2.890371757896165),\n                                    (\"le <time>intersect\", -2.890371757896165),\n                                    (\"miditime-of-day (latent)\", -2.890371757896165),\n                                    (\"intersectle <day-of-month> (non ordinal)\",\n                                     -2.890371757896165),\n                                    (\"le <day-of-month> (non ordinal)le <day-of-month> (non ordinal)\",\n                                     -2.1972245773362196),\n                                    (\"intersectintersect\", -2.890371757896165),\n                                    (\"intersectle <time>\", -2.4849066497880004)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.2237754316221157,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -1.2992829841302609),\n                                    (\"le <day-of-month> (non ordinal)intersect\",\n                                     -1.9924301646902063),\n                                    (\"le <day-of-month> (non ordinal)le <time>\",\n                                     -1.9924301646902063),\n                                    (\"le <day-of-month> (non ordinal)le <day-of-month> (non ordinal)\",\n                                     -2.3978952727983707)],\n                               n = 5}}),\n       (\"soir\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"ann\\233e (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"d\\233but de semaine\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> moins <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midinumber (0..16)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> suivant|d'apr\\232s\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.5336968139574325),\n                                    (\"en semaine\", -1.9459101490553135),\n                                    (\"Mercredi\", -3.044522437723423), (\"Mardi\", -3.044522437723423),\n                                    (\"intersect by 'de' or ','\", -2.5336968139574325),\n                                    (\"day\", -0.7758388964050588),\n                                    (\"le <time>\", -1.9459101490553135)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"en semaine\", -1.7047480922384253),\n                                    (\"day\", -1.2992829841302609),\n                                    (\"le <time>\", -1.7047480922384253)],\n                               n = 2}}),\n       (\"Samedi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"seconde (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> et|pass\\233 de <number>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224|vers <time-of-day>number (20..60)\", -2.1400661634962708),\n                                    (\"<time-of-day> heuresinteger (numeric)\", -2.1400661634962708),\n                                    (\"\\224|vers <time-of-day>number (0..16)\", -2.1400661634962708),\n                                    (\"hour\", -1.041453874828161),\n                                    (\"<time-of-day> heuresnumber (20..60)\", -2.1400661634962708),\n                                    (\"<time-of-day> heuresnumber (0..16)\", -2.1400661634962708)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midiinteger (numeric)\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"<hour-of-day> moins quart\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midi\", -0.6931471805599453), (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"apr\\232s <time-of-day|day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3677247801253174, unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.7047480922384253),\n                                    (\"hh(:|h)mm (time-of-day)\", -2.803360380906535),\n                                    (\"midi\", -3.4965075614664802), (\"day\", -2.803360380906535),\n                                    (\"time-of-day (latent)\", -2.803360380906535),\n                                    (\"hour\", -1.4170660197866443), (\"minute\", -1.8870696490323797),\n                                    (\"<time-of-day> heures\", -2.803360380906535),\n                                    (\"le <time>\", -3.0910424533583156),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.580216829592325)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -1.1786549963416462,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.4849066497880004),\n                                    (\"le <day-of-month> (non ordinal)\", -2.890371757896165),\n                                    (\"day\", -2.890371757896165),\n                                    (\"time-of-day (latent)\", -1.9740810260220096),\n                                    (\"au d\\233jeuner\", -2.890371757896165),\n                                    (\"hour\", -1.0986122886681098),\n                                    (\"<time-of-day> heures\", -1.9740810260220096)],\n                               n = 12}}),\n       (\"de <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh(:|h)mm (time-of-day)<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.6855773452501515),\n                                    (\"minuteminute\", -1.5869650565820417),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.0910424533583156),\n                                    (\"<time-of-day> heures<time-of-day> heures\",\n                                     -3.0910424533583156),\n                                    (\"hh(:|h)mm (time-of-day)hh(:|h)mm (time-of-day)\",\n                                     -2.6855773452501515),\n                                    (\"hourhour\", -2.3978952727983707),\n                                    (\"minutehour\", -2.174751721484161),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<time-of-day> heures\",\n                                     -2.3978952727983707),\n                                    (\"<hour-of-day> <integer> (as relative minutes)hh(:|h)mm (time-of-day)\",\n                                     -2.6855773452501515),\n                                    (\"hh(:|h)mm (time-of-day)<time-of-day> heures\",\n                                     -3.0910424533583156),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.6855773452501515),\n                                    (\"<time-of-day> heurestime-of-day (latent)\",\n                                     -3.0910424533583156)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -0.8109302162163288,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minutehour\", -1.072636802264849),\n                                    (\"hh(:|h)mm (time-of-day)time-of-day (latent)\",\n                                     -2.2512917986064953),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<time-of-day> heures\",\n                                     -2.538973871058276),\n                                    (\"hh(:|h)mm (time-of-day)<time-of-day> heures\",\n                                     -2.538973871058276),\n                                    (\"<hour-of-day> <integer> (as relative minutes)time-of-day (latent)\",\n                                     -1.845826690498331)],\n                               n = 12}}),\n       (\"<datetime>-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8472978603872037),\n                                    (\"day of month (premier)number (0..16)Juillet\",\n                                     -1.540445040947149),\n                                    (\"<day-of-month> <named-month>integer (numeric)Juillet\",\n                                     -1.540445040947149),\n                                    (\"day of month (premier)integer (numeric)Juillet\",\n                                     -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semaine (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"demain\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"mois (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by 'mais/par exemple/plut\\244t'\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.3978952727983707),\n                                    (\"le <day-of-month> (non ordinal)\\224|vers <time-of-day>\",\n                                     -2.3978952727983707),\n                                    (\"dayminute\", -0.8938178760220964),\n                                    (\"Jeudientre <time-of-day> et <time-of-day> (interval)\",\n                                     -0.8938178760220964)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0560526742493137,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day of month (premier)<day-of-week> <day-of-month>\",\n                                     -2.9444389791664407),\n                                    (\"hh(:|h)mm (time-of-day)<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.9444389791664407),\n                                    (\"minuteminute\", -2.0281482472922856),\n                                    (\"hh(:|h)mm (time-of-day)hh(:|h)mm (time-of-day)\",\n                                     -2.9444389791664407),\n                                    (\"dayday\", -2.0281482472922856),\n                                    (\"<day-of-month> <named-month>day of month (premier)\",\n                                     -2.9444389791664407),\n                                    (\"<hour-of-day> <integer> (as relative minutes)hh(:|h)mm (time-of-day)\",\n                                     -2.9444389791664407),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.9444389791664407),\n                                    (\"<day-of-month> <named-month>intersect\", -2.9444389791664407),\n                                    (\"intersect<day-of-week> <day-of-month>\", -2.9444389791664407)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.4274440148269396, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-week> <day-of-month>Dimanche\", -3.258096538021482),\n                                    (\"yearyear\", -2.8526314299133175),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.8526314299133175),\n                                    (\"dayday\", -1.466337068793427),\n                                    (\"year (latent)year (latent)\", -2.8526314299133175),\n                                    (\"<day-of-week> <day-of-month><day-of-week> <day-of-month>\",\n                                     -3.258096538021482),\n                                    (\"hourhour\", -2.8526314299133175),\n                                    (\"day of month (premier)<day-of-month> <named-month>\",\n                                     -3.258096538021482),\n                                    (\"day of month (premier)intersect\", -2.8526314299133175),\n                                    (\"intersectintersect\", -2.8526314299133175),\n                                    (\"day of month (premier)Mercredi\", -3.258096538021482),\n                                    (\"intersectMercredi\", -3.258096538021482),\n                                    (\"<day-of-week> <day-of-month>intersect\", -2.8526314299133175)],\n                               n = 15}}),\n       (\"<ordinal> <cycle> de <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)jour (grain)Octobre\", -1.7346010553881064),\n                                    (\"ordinals (premier..seizieme)semaine (grain)Octobre\",\n                                     -1.7346010553881064),\n                                    (\"daymonth\", -1.7346010553881064),\n                                    (\"weekmonth\", -1.2237754316221157),\n                                    (\"ordinals (premier..seizieme)semaine (grain)intersect\",\n                                     -1.7346010553881064)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"premi\\232re quinzaine de <named-month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Avril\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> suivants\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.6094379124341003), (\"month\", -1.6094379124341003),\n                                    (\"integer (numeric)mois (grain)\", -1.6094379124341003),\n                                    (\"integer (numeric)heure (grain)\", -1.6094379124341003)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..16)jour (grain)\", -1.2039728043259361),\n                                    (\"day\", -1.2039728043259361)],\n                               n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.22416866672945499,\n                               unseen = -6.913737350659685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect<dim time> du matin\", -6.219595639933231),\n                                    (\"<hour-of-day> <integer> (as relative minutes)intersect\",\n                                     -5.814130531825066),\n                                    (\"<day-of-month> <named-month>d\\233but de journ\\233e\",\n                                     -6.219595639933231),\n                                    (\"hourday\", -3.9683038413267355),\n                                    (\"<day-of-month> <named-month>year\", -5.526448459373285),\n                                    (\"apr\\232s <time-of-day|day>le <time>\", -5.303304908059076),\n                                    (\"dayhour\", -1.9927618946650512),\n                                    (\"<datetime> - <datetime> (interval)Juillet\",\n                                     -5.120983351265121),\n                                    (\"daymonth\", -2.738355550597539),\n                                    (\"monthyear\", -4.715518243156957),\n                                    (\"<day-of-month> <named-month>d\\233but de matin\\233e\",\n                                     -6.219595639933231),\n                                    (\"dernier <cycle> de <time> (latent)year\", -5.303304908059076),\n                                    (\"apr\\232s <time-of-day|day>intersect\", -5.814130531825066),\n                                    (\"aujourd'huimilieu d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"<day-of-month> <named-month>\\224|vers <time-of-day>\",\n                                     -4.715518243156957),\n                                    (\"dd mmyear\", -4.966832671437863),\n                                    (\"Vendredi\\224|vers <time-of-day>\", -5.814130531825066),\n                                    (\"Mercredidu|dans le <part-of-day>\", -6.219595639933231),\n                                    (\"aujourd'huifin d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"day of month (premier)Novembre\", -5.526448459373285),\n                                    (\"le <day-of-month> (non ordinal)<dim time> du matin\",\n                                     -6.219595639933231),\n                                    (\"aujourd'huimilieu de matin\\233e\", -6.219595639933231),\n                                    (\"hh(:|h)mm (time-of-day)<day-of-week> <day-of-month>\",\n                                     -6.219595639933231),\n                                    (\"le <day-of-month> (non ordinal)Fevrier\", -4.140154098253395),\n                                    (\"Lundiday of month (premier)\", -5.814130531825066),\n                                    (\"<time-of-day> heuresdu|dans le <part-of-day>\",\n                                     -5.526448459373285),\n                                    (\"<hour-of-day> et quart<dim time> <part-of-day>\",\n                                     -5.814130531825066),\n                                    (\"le <time>du|dans le <part-of-day>\", -5.526448459373285),\n                                    (\"aujourd'huifin de matin\\233e\", -6.219595639933231),\n                                    (\"Marsyear\", -5.814130531825066),\n                                    (\"aujourd'huifin de soir\\233e\", -6.219595639933231),\n                                    (\"\\224|vers <time-of-day>ce <part-of-day>\", -5.526448459373285),\n                                    (\"<day-of-month> <named-month>d\\233but d'apr\\232s-midi\",\n                                     -6.219595639933231),\n                                    (\"le <day-of-month> (non ordinal)<dim time> du soir\",\n                                     -5.526448459373285),\n                                    (\"intersectSeptembre\", -5.814130531825066),\n                                    (\"aujourd'huid\\233but de soir\\233e\", -6.219595639933231),\n                                    (\"<day-of-week> <day-of-month>Fevrier\", -5.814130531825066),\n                                    (\"<hour-of-day> et demice <part-of-day>\", -5.814130531825066),\n                                    (\"<dim time> <part-of-day>apr\\232s <time-of-day|day>\",\n                                     -6.219595639933231),\n                                    (\"le <time>fin de matin\\233e\", -6.219595639933231),\n                                    (\"Jeudide <time-of-day> - <time-of-day> (interval)\",\n                                     -5.814130531825066),\n                                    (\"day of month (premier)Mars\", -5.303304908059076),\n                                    (\"intersectmilieu de journ\\233e\", -6.219595639933231),\n                                    (\"intersectfin de journ\\233e\", -6.219595639933231),\n                                    (\"le <day-of-month> (non ordinal)<time-of-day> heures\",\n                                     -6.219595639933231),\n                                    (\"Octobreyear\", -5.303304908059076),\n                                    (\"Jeudiapr\\232s <time-of-day|day>\", -5.303304908059076),\n                                    (\"Fevrierd\\233but de matin\\233e\", -6.219595639933231),\n                                    (\"de <datetime> - <datetime> (interval)Juillet\",\n                                     -5.814130531825066),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<day-of-week> <day-of-month>\",\n                                     -6.219595639933231),\n                                    (\"monthhour\", -4.07952947643696),\n                                    (\"Marsintersect\", -6.219595639933231),\n                                    (\"Lundile <cycle> prochain|suivant|d'apr\\232s\",\n                                     -6.219595639933231),\n                                    (\"le <time>fin d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"hourmonth\", -4.715518243156957),\n                                    (\"<time-of-day> heuresle <time>\", -4.715518243156957),\n                                    (\"dayday\", -3.868220382769753),\n                                    (\"Septembreyear\", -5.814130531825066),\n                                    (\"aujourd'hui<hour-of-day> <integer> (as relative minutes)\",\n                                     -5.814130531825066),\n                                    (\"hourhour\", -3.6938669956249752),\n                                    (\"Fevrierd\\233but d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"<day-of-week> <day-of-month>\\224|vers <time-of-day>\",\n                                     -5.120983351265121),\n                                    (\"<day-of-week> <day-of-month>Septembre\", -6.219595639933231),\n                                    (\"le <time>intersect\", -5.814130531825066),\n                                    (\"\\224|vers <time-of-day><dim time> <part-of-day>\",\n                                     -6.219595639933231),\n                                    (\"aujourd'huiau d\\233jeuner\", -6.219595639933231),\n                                    (\"du dd au dd (interval) (latent month)Juillet\",\n                                     -5.526448459373285),\n                                    (\"Vendrediday of month (premier)\", -6.219595639933231),\n                                    (\"le <day-of-month> (non ordinal)Avril\", -6.219595639933231),\n                                    (\"<time-of-day> heuresintersect\", -5.303304908059076),\n                                    (\"<hour-of-day> et quartce <part-of-day>\", -5.814130531825066),\n                                    (\"Jeudi\\224|vers <time-of-day>\", -6.219595639933231),\n                                    (\"dayyear\", -3.82170036713486),\n                                    (\"le <day-of-month> (non ordinal)Juin\", -6.219595639933231),\n                                    (\"Lundice|dans le <cycle>\", -6.219595639933231),\n                                    (\"apr\\232s-demain\\224|vers <time-of-day>\", -5.814130531825066),\n                                    (\"intersectfin d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"le <ordinal> <cycle> de <time>year\", -6.219595639933231),\n                                    (\"intersectmilieu d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"<hour-of-day> <integer> (as relative minutes)Jeudi\",\n                                     -6.219595639933231),\n                                    (\"le <time>milieu de journ\\233e\", -6.219595639933231),\n                                    (\"aujourd'huid\\233but de journ\\233e\", -6.219595639933231),\n                                    (\"demain\\224|vers <time-of-day>\", -5.814130531825066),\n                                    (\"le <day-of-month> (non ordinal)Mars\", -4.83330127881334),\n                                    (\"le <day-of-month> (non ordinal)intersect\",\n                                     -3.7772486045640266),\n                                    (\"hourminute\", -6.219595639933231),\n                                    (\"dd-dd <month>(interval)year\", -6.219595639933231),\n                                    (\"intersect<day-of-month> <named-month>\", -5.814130531825066),\n                                    (\"<hour-of-day> <integer> (as relative minutes)Samedi\",\n                                     -6.219595639933231),\n                                    (\"minutemonth\", -5.814130531825066),\n                                    (\"minutehour\", -4.61015772749913),\n                                    (\"Lundidu|dans le <part-of-day>\", -6.219595639933231),\n                                    (\"aujourd'huimilieu de journ\\233e\", -6.219595639933231),\n                                    (\"Vendrediapr\\232s <time-of-day|day>\", -6.219595639933231),\n                                    (\"Mars\\224|vers <time-of-day>\", -5.526448459373285),\n                                    (\"intersectd\\233but de soir\\233e\", -6.219595639933231),\n                                    (\"Mardile <cycle> prochain|suivant|d'apr\\232s\",\n                                     -5.526448459373285),\n                                    (\"aujourd'huifin de journ\\233e\", -6.219595639933231),\n                                    (\"le <day-of-month> (non ordinal)Octobre\", -6.219595639933231),\n                                    (\"intersectdu|dans le <part-of-day>\", -4.427836170705175),\n                                    (\"le <day-of-month> \\224 <datetime>du|dans le <part-of-day>\",\n                                     -5.814130531825066),\n                                    (\"hh(:|h)mm (time-of-day)Jeudi\", -6.219595639933231),\n                                    (\"le <time>Juillet\", -6.219595639933231),\n                                    (\"Lundi<day-of-month> <named-month>\", -6.219595639933231),\n                                    (\"Mercredile <cycle> prochain|suivant|d'apr\\232s\",\n                                     -5.526448459373285),\n                                    (\"Lundifin d'apr\\232s-midi\", -5.814130531825066),\n                                    (\"Lundile <time>\", -5.814130531825066),\n                                    (\"Mardi<named-month|named-day> suivant|d'apr\\232s\",\n                                     -5.814130531825066),\n                                    (\"le <day-of-month> (non ordinal)Juillet\", -6.219595639933231),\n                                    (\"Mars<dim time> du matin\", -6.219595639933231),\n                                    (\"le <time>Novembre\", -5.526448459373285),\n                                    (\"intersectd\\233but d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"<datetime> - <datetime> (interval)Jeudi\", -5.303304908059076),\n                                    (\"Mercredi<named-month|named-day> suivant|d'apr\\232s\",\n                                     -5.814130531825066),\n                                    (\"<time-of-day> - <time-of-day> (interval)Jeudi\",\n                                     -4.966832671437863),\n                                    (\"Samedi<day-of-month> <named-month>\", -6.219595639933231),\n                                    (\"<time-of-day> heuresce <time>\", -6.219595639933231),\n                                    (\"le <time>d\\233but d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"day of month (premier)Juillet\", -5.526448459373285),\n                                    (\"<day-of-month> <named-month>du|dans le <part-of-day>\",\n                                     -5.814130531825066),\n                                    (\"Fevriermilieu d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"Mercredi\\224|vers <time-of-day>\", -6.219595639933231),\n                                    (\"intersectNovembre\", -4.966832671437863),\n                                    (\"le <time><dim time> du matin\", -6.219595639933231),\n                                    (\"Fevrierfin d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"le <day-of-month> (non ordinal)\\224|vers <time-of-day>\",\n                                     -4.715518243156957),\n                                    (\"<day-of-month> <named-month>d\\233but de soir\\233e\",\n                                     -6.219595639933231),\n                                    (\"hierdu|dans le <part-of-day>\", -6.219595639933231),\n                                    (\"le <time>d\\233but de soir\\233e\", -6.219595639933231),\n                                    (\"Mercredice|dans le <cycle>\", -6.219595639933231),\n                                    (\"Fevrierfin de soir\\233e\", -6.219595639933231),\n                                    (\"Mardice|dans le <cycle>\", -6.219595639933231),\n                                    (\"dayminute\", -4.61015772749913),\n                                    (\"intersectd\\233but de journ\\233e\", -6.219595639933231),\n                                    (\"<ordinal> <cycle> de <time>year\", -5.814130531825066),\n                                    (\"Fevriermilieu de matin\\233e\", -6.219595639933231),\n                                    (\"le <time>\\224|vers <time-of-day>\", -5.120983351265121),\n                                    (\"<day-of-month> <named-month><dim time> du matin\",\n                                     -6.219595639933231),\n                                    (\"intersectyear\", -5.526448459373285),\n                                    (\"Fevrierfin de matin\\233e\", -6.219595639933231),\n                                    (\"minuteday\", -3.47875561600803),\n                                    (\"le <time>d\\233but de matin\\233e\", -6.219595639933231),\n                                    (\"Mardile <time>\", -4.83330127881334),\n                                    (\"aujourd'hui\\224|vers <time-of-day>\", -5.303304908059076),\n                                    (\"<day-of-month> <named-month>milieu d'apr\\232s-midi\",\n                                     -6.219595639933231),\n                                    (\"day of month (premier)intersect\", -6.219595639933231),\n                                    (\"<day-of-month> <named-month>fin d'apr\\232s-midi\",\n                                     -6.219595639933231),\n                                    (\"day of month (premier)Janvier\", -6.219595639933231),\n                                    (\"le <time>milieu de matin\\233e\", -6.219595639933231),\n                                    (\"aujourd'huid\\233but de matin\\233e\", -5.120983351265121),\n                                    (\"Fevrierd\\233but de soir\\233e\", -6.219595639933231),\n                                    (\"apr\\232s <time-of-day|day>Jeudi\", -5.814130531825066),\n                                    (\"Mercredile <time>\", -4.83330127881334),\n                                    (\"le <time>fin de soir\\233e\", -6.219595639933231),\n                                    (\"de <time-of-day> - <time-of-day> (interval)Jeudi\",\n                                     -5.303304908059076),\n                                    (\"<day-of-month> <named-month>milieu de matin\\233e\",\n                                     -6.219595639933231),\n                                    (\"<day-of-month> <named-month>fin de soir\\233e\",\n                                     -6.219595639933231),\n                                    (\"<day-of-month> <named-month>fin de matin\\233e\",\n                                     -6.219595639933231),\n                                    (\"<time-of-day> heuresce <part-of-day>\", -5.814130531825066),\n                                    (\"Mercredi<day-of-month> <named-month>\", -6.219595639933231),\n                                    (\"aujourd'huid\\233but d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"le <time>milieu d'apr\\232s-midi\", -6.219595639933231),\n                                    (\"apr\\232s <time-of-day|day>Novembre\", -5.526448459373285),\n                                    (\"\\224|vers <time-of-day>du|dans le <part-of-day>\",\n                                     -5.120983351265121),\n                                    (\"entre <time-of-day> et <time-of-day> (interval)Jeudi\",\n                                     -5.814130531825066),\n                                    (\"intersectintersect\", -6.219595639933231),\n                                    (\"dayweek\", -4.022371062597012),\n                                    (\"entre <datetime> et <datetime> (interval)Juillet\",\n                                     -5.814130531825066),\n                                    (\"intersectMars\", -6.219595639933231),\n                                    (\"weekyear\", -4.83330127881334),\n                                    (\"le <time>Mars\", -5.814130531825066),\n                                    (\"apr\\232s le <day-of-month>Mars\", -6.219595639933231),\n                                    (\"hh(:|h)mm (time-of-day)intersect\", -5.814130531825066),\n                                    (\"<day-of-month> <named-month>fin de journ\\233e\",\n                                     -6.219595639933231),\n                                    (\"<day-of-month> <named-month>milieu de journ\\233e\",\n                                     -6.219595639933231),\n                                    (\"le <time>fin de journ\\233e\", -6.219595639933231),\n                                    (\"dd/-mm\\224|vers <time-of-day>\", -5.814130531825066),\n                                    (\"intersectfin de matin\\233e\", -6.219595639933231),\n                                    (\"Fevrierd\\233but de journ\\233e\", -6.219595639933231),\n                                    (\"Vendrediintersect\", -6.219595639933231),\n                                    (\"<day-of-month> <named-month>intersect\", -6.219595639933231),\n                                    (\"intersectfin de soir\\233e\", -6.219595639933231),\n                                    (\"intersectmilieu de matin\\233e\", -6.219595639933231),\n                                    (\"intersect\\224|vers <time-of-day>\", -5.526448459373285),\n                                    (\"le <time>year\", -4.715518243156957),\n                                    (\"hh(:|h)mm (time-of-day)Samedi\", -6.219595639933231),\n                                    (\"le <day-of-month> (non ordinal)apr\\232s <time-of-day|day>\",\n                                     -6.219595639933231),\n                                    (\"Fevrierfin de journ\\233e\", -6.219595639933231),\n                                    (\"Fevriermilieu de journ\\233e\", -6.219595639933231),\n                                    (\"le <time>d\\233but de journ\\233e\", -6.219595639933231),\n                                    (\"intersectd\\233but de matin\\233e\", -6.219595639933231)],\n                               n = 390},\n                   koData =\n                     ClassData{prior = -1.6053479271825752, unseen = -6.045005314036012,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"demain<time-of-day> heures\", -5.349485653122436),\n                                    (\"hourday\", -3.2094194896261654),\n                                    (\"<day-of-month> <named-month>year\", -5.349485653122436),\n                                    (\"demainavant <time-of-day>\", -5.349485653122436),\n                                    (\"dayhour\", -2.8237570088141806),\n                                    (\"<time-of-day> - <time-of-day> (interval)Juillet\",\n                                     -4.433194921248281),\n                                    (\"Jeudi<time-of-day> - <time-of-day> (interval)\",\n                                     -4.944020545014272),\n                                    (\"daymonth\", -3.9631912920025454),\n                                    (\"monthyear\", -4.65633847256249),\n                                    (\"le <cycle> de <time>Octobre\", -4.944020545014272),\n                                    (\"houryear\", -5.349485653122436),\n                                    (\"<time-of-day> heuresdu|dans le <part-of-day>\",\n                                     -4.65633847256249),\n                                    (\"le <time>du|dans le <part-of-day>\", -4.944020545014272),\n                                    (\"Marsyear\", -5.349485653122436),\n                                    (\"Dimanche<day-of-month> <named-month>\", -4.944020545014272),\n                                    (\"le <time>Mercredi\", -5.349485653122436),\n                                    (\"<time-of-day> heuresle <day-of-month> (non ordinal)\",\n                                     -4.433194921248281),\n                                    (\"<dim time> <part-of-day>apr\\232s <time-of-day|day>\",\n                                     -5.349485653122436),\n                                    (\"le <day-of-month> (non ordinal)<time-of-day> heures\",\n                                     -5.349485653122436),\n                                    (\"Jeudiapr\\232s <time-of-day|day>\", -4.944020545014272),\n                                    (\"aujourd'huidu|dans le <part-of-day>\", -4.944020545014272),\n                                    (\"de <datetime> - <datetime> (interval)Juillet\",\n                                     -4.944020545014272),\n                                    (\"monthhour\", -3.9631912920025454),\n                                    (\"hourmonth\", -3.9631912920025454),\n                                    (\"Vendredi<time-of-day> - <time-of-day> (interval)\",\n                                     -4.096722684627068),\n                                    (\"dayday\", -3.477683476220845),\n                                    (\"Septembreyear\", -5.349485653122436),\n                                    (\"hourhour\", -3.7400477406883357),\n                                    (\"\\224|vers <time-of-day>Jeudi\", -4.65633847256249),\n                                    (\"dayyear\", -4.250873364454327),\n                                    (\"demain\\224|vers <time-of-day>\", -4.944020545014272),\n                                    (\"\\224|vers <time-of-day>demain\", -5.349485653122436),\n                                    (\"Mars\\224|vers <time-of-day>\", -4.250873364454327),\n                                    (\"Lundi<datetime> - <datetime> (interval)\", -4.944020545014272),\n                                    (\"intersect by 'de' or ','year\", -4.944020545014272),\n                                    (\"apr\\232s <time-of-day|day>le <day-of-month> (non ordinal)\",\n                                     -4.944020545014272),\n                                    (\"hh(:|h)mm (time-of-day)Jeudi\", -5.349485653122436),\n                                    (\"weekmonth\", -4.944020545014272),\n                                    (\"le <day-of-month> (non ordinal)Juillet\", -4.944020545014272),\n                                    (\"le <day-of-month> (non ordinal)year\", -4.944020545014272),\n                                    (\"<time-of-day> - <time-of-day> (interval)Septembre\",\n                                     -5.349485653122436),\n                                    (\"Samedi<time-of-day> - <time-of-day> (interval)\",\n                                     -4.944020545014272),\n                                    (\"<time-of-day> heuresdd/-mm\", -5.349485653122436),\n                                    (\"<hour-of-day> et quartdemain\", -4.944020545014272),\n                                    (\"<time-of-day> - <time-of-day> (interval)du|dans le <part-of-day>\",\n                                     -4.944020545014272),\n                                    (\"yearmonth\", -5.349485653122436),\n                                    (\"intersectyear\", -5.349485653122436),\n                                    (\"minuteday\", -4.433194921248281),\n                                    (\"Mardile <time>\", -5.349485653122436),\n                                    (\"Fevrierdu|dans le <part-of-day>\", -4.944020545014272),\n                                    (\"aujourd'hui\\224|vers <time-of-day>\", -4.944020545014272),\n                                    (\"Mercredile <time>\", -5.349485653122436),\n                                    (\"le <day-of-month> (non ordinal)avant <time-of-day>\",\n                                     -5.349485653122436),\n                                    (\"Mercredi<day-of-month> <named-month>\", -4.65633847256249),\n                                    (\"<day-of-week> <day-of-month>Juillet\", -4.250873364454327),\n                                    (\"day of month (premier)Mercredi\", -4.944020545014272),\n                                    (\"<time-of-day> - <time-of-day> (interval)intersect\",\n                                     -5.349485653122436),\n                                    (\"Fevrieryear\", -5.349485653122436),\n                                    (\"Jeudi<time-of-day> heures\", -4.944020545014272),\n                                    (\"avant <time-of-day>Jeudi\", -5.349485653122436),\n                                    (\"<dim time> <part-of-day><time-of-day> heures\",\n                                     -5.349485653122436),\n                                    (\"<time-of-day> heuresJeudi\", -4.250873364454327)],\n                               n = 98}}),\n       (\"Janvier\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"season\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453), (\"Lundi\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"le <cycle> de <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthmonth\", -1.9459101490553135),\n                                    (\"mois (grain)Mars\", -1.9459101490553135),\n                                    (\"weekday\", -1.540445040947149),\n                                    (\"semaine (grain)<day-of-month> <named-month>\",\n                                     -1.540445040947149)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"semaine (grain)year (latent)\", -1.6739764335716716),\n                                    (\"weekhour\", -1.6739764335716716),\n                                    (\"semaine (grain)time-of-day (latent)\", -1.6739764335716716),\n                                    (\"weekyear\", -1.6739764335716716)],\n                               n = 4}}),\n       (\"<hour-of-day> et trois quarts\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"<time-of-day> heures\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"le <day-of-month> \\224 <datetime>\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)<time-of-day> heures\", -1.7227665977411035),\n                                    (\"integer (numeric)<dim time> du soir\", -2.639057329615259),\n                                    (\"integer (numeric)intersect\", -2.2335922215070942),\n                                    (\"integer (numeric)<dim time> du matin\", -2.639057329615259),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.9459101490553135)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Juin\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"le <cycle> dernier\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"ann\\233e (grain)\", -1.9459101490553135),\n                                    (\"semaine (grain)\", -1.540445040947149),\n                                    (\"mois (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135), (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.1823215567939546),\n                                    (\"number (0..16)\", -1.791759469228055)],\n                               n = 10}}),\n       (\"soir de no\\235l\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fin de journ\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"du <datetime>-<day-of-week> dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectMercrediinteger (numeric)Juillet\",\n                                     -1.9459101490553135),\n                                    (\"day of month (premier)Mercrediinteger (numeric)Juillet\",\n                                     -1.9459101490553135),\n                                    (\"daydaymonth\", -1.252762968495368),\n                                    (\"<day-of-week> <day-of-month>Dimancheinteger (numeric)Juillet\",\n                                     -1.9459101490553135)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)Dimancheinteger (numeric)Juillet\",\n                                     -1.791759469228055),\n                                    (\"hourdaymonth\", -1.791759469228055),\n                                    (\"year (latent)Dimancheinteger (numeric)Juillet\",\n                                     -1.791759469228055),\n                                    (\"yeardaymonth\", -1.791759469228055)],\n                               n = 2}}),\n       (\"milieu de semaine\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"d\\233but d'ann\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"DD month YY\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Octobreinteger (numeric)\",\n                                     -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noel\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"fin de matin\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"le <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3528213746227423, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.352605801082348e-2),\n                                    (\"number (17..19)\", -3.332204510175204),\n                                    (\"number (0..16)\", -3.332204510175204)],\n                               n = 52},\n                   koData =\n                     ClassData{prior = -1.213022639845854, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3677247801253174),\n                                    (\"numbers 22..29 32..39 .. 52..59\", -1.6486586255873816),\n                                    (\"number (0..16)\", -2.5649493574615367)],\n                               n = 22}}),\n       (\"du dd-<day-of-week> dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.6931471805599453),\n                                    (\"DimancheJuillet\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"en semaine\",\n        Classifier{okData =\n                     ClassData{prior = -1.2656663733312759,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -0.3313571359544425,\n                               unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28}}),\n       (\"numbers 22..29 32..39 .. 52..59\",\n        Classifier{okData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (20..60)number (0..16)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)\", -0.2876820724517809),\n                                    (\"integer (numeric)number (0..16)\", -1.791759469228055)],\n                               n = 9}}),\n       (\"Mercredi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mardi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> prochain\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mercredi\", -1.6094379124341003),\n                                    (\"Mardi\", -1.6094379124341003), (\"day\", -0.916290731874155),\n                                    (\"Lundi\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by 'de' or ','\",\n        Classifier{okData =\n                     ClassData{prior = -0.2578291093020998, unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.4231762883809305),\n                                    (\"Jeudi<time-of-day> - <time-of-day> (interval)\",\n                                     -3.4231762883809305),\n                                    (\"daymonth\", -3.4231762883809305),\n                                    (\"Dimanchele <time>\", -3.828641396489095),\n                                    (\"fin du moisMars\", -3.828641396489095),\n                                    (\"Lundile <cycle> prochain|suivant|d'apr\\232s\",\n                                     -3.828641396489095),\n                                    (\"hourmonth\", -3.828641396489095),\n                                    (\"dayday\", -1.8827312474337816),\n                                    (\"Mardile <cycle> prochain|suivant|d'apr\\232s\",\n                                     -3.1354942159291497),\n                                    (\"Mercredile <cycle> prochain|suivant|d'apr\\232s\",\n                                     -3.1354942159291497),\n                                    (\"Lundile <time>\", -3.4231762883809305),\n                                    (\"Mardi<named-month|named-day> suivant|d'apr\\232s\",\n                                     -3.4231762883809305),\n                                    (\"Mercredi<named-month|named-day> suivant|d'apr\\232s\",\n                                     -3.4231762883809305),\n                                    (\"Mardile <time>\", -2.4423470353692043),\n                                    (\"Mercredile <time>\", -2.4423470353692043),\n                                    (\"Mercredi<cycle> prochain|suivant|d'apr\\232s\",\n                                     -3.828641396489095),\n                                    (\"dayweek\", -1.6885752329928243),\n                                    (\"week-endSeptembre\", -3.828641396489095),\n                                    (\"Dimanchele <cycle> dernier\", -3.828641396489095)],\n                               n = 34},\n                   koData =\n                     ClassData{prior = -1.4816045409242156,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"en semaineSeptembre\", -2.6855773452501515),\n                                    (\"hourday\", -3.0910424533583156),\n                                    (\"dayhour\", -3.0910424533583156),\n                                    (\"daymonth\", -2.174751721484161),\n                                    (\"du|dans le <part-of-day>noel\", -3.0910424533583156),\n                                    (\"hourmonth\", -2.6855773452501515),\n                                    (\"dayday\", -2.6855773452501515),\n                                    (\"en semaineintersect\", -2.6855773452501515),\n                                    (\"Mardile <time>\", -3.0910424533583156),\n                                    (\"Mercredile <time>\", -3.0910424533583156),\n                                    (\"Jeudi<time-of-day> heures\", -3.0910424533583156),\n                                    (\"week-endSeptembre\", -2.6855773452501515)],\n                               n = 10}}),\n       (\"milieu d'apr\\232s-midi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"soir\", -1.6094379124341003),\n                                    (\"apr\\232s-midi\", -1.0986122886681098),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..60)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hier\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"plus tard\",\n        Classifier{okData =\n                     ClassData{prior = -1.5040773967762742,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.25131442828090605,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.40546510810816444),\n                                    (\"numbers 22..29 32..39 .. 52..59\", -2.1972245773362196),\n                                    (\"number (0..16)\", -1.5040773967762742)],\n                               n = 15}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Juillet\", -1.0116009116784799),\n                                    (\"Septembre\", -1.7047480922384253),\n                                    (\"month\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"plus tard <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"du|dans le <part-of-day>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime>-<day-of-week> dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectMercrediinteger (numeric)Juillet\",\n                                     -1.9924301646902063),\n                                    (\"<day-of-week> <day-of-month>Dimancheordinal (digits)Juillet\",\n                                     -2.3978952727983707),\n                                    (\"day of month (premier)Mercrediinteger (numeric)Juillet\",\n                                     -1.7047480922384253),\n                                    (\"daydaymonth\", -0.8938178760220964),\n                                    (\"<day-of-week> <day-of-month>Mercrediordinal (digits)Juillet\",\n                                     -2.3978952727983707),\n                                    (\"<day-of-week> <day-of-month>Dimancheinteger (numeric)Juillet\",\n                                     -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> du soir\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224|vers <time-of-day>\", -1.1786549963416462),\n                                    (\"hour\", -0.7731898882334817),\n                                    (\"<time-of-day> heures\", -1.466337068793427)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.8472978603872037),\n                                    (\"<time-of-day> heures\", -0.8472978603872037)],\n                               n = 2}}),\n       (\"aujourd'hui\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 23},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"midi\",\n        Classifier{okData =\n                     ClassData{prior = -1.157452788691043, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -0.37729423114146804,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24}}),\n       (\"toussaint\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"d\\233but de soir\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (17..19)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"number (0..16)number (0..16)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3022808718729337,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Vendrediinteger (numeric)\", -2.639057329615259),\n                                    (\"Jeudiinteger (numeric)\", -2.639057329615259),\n                                    (\"Lundiinteger (numeric)\", -2.639057329615259),\n                                    (\"day\", -0.8472978603872037),\n                                    (\"Mercrediinteger (numeric)\", -1.9459101490553135),\n                                    (\"Samediinteger (numeric)\", -2.128231705849268),\n                                    (\"Vendredinumber (0..16)\", -2.639057329615259)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -1.3437347467010947, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Dimancheinteger (numeric)\", -1.6094379124341003),\n                                    (\"Lundiinteger (numeric)\", -1.8971199848858813),\n                                    (\"day\", -1.0498221244986778),\n                                    (\"Mercrediinteger (numeric)\", -2.3025850929940455)],\n                               n = 6}}),\n       (\"d'ici <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.252762968495368), (\"day\", -1.252762968495368),\n                                    (\"<integer> <unit-of-duration>\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\224|vers <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.23293155768037255, unseen = -4.90527477843843,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -4.204692619390966),\n                                    (\"<hour-of-day> et|pass\\233 de <number>\", -3.7992275112828016),\n                                    (\"hh(:|h)mm (time-of-day)\", -4.204692619390966),\n                                    (\"midi\", -3.7992275112828016),\n                                    (\"<hour-of-day> et|pass\\233 de <number> minutes\",\n                                     -3.7992275112828016),\n                                    (\"minuit\", -4.204692619390966),\n                                    (\"<hour-of-day> et quart\", -3.7992275112828016),\n                                    (\"hour\", -0.9858167945227653),\n                                    (\"<hour-of-day> et demi\", -4.204692619390966),\n                                    (\"minute\", -2.332890442489375),\n                                    (\"<time-of-day> heures\", -1.0691984034618165),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.288401887516811)],\n                               n = 61},\n                   koData =\n                     ClassData{prior = -1.5712166996139025,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -2.3978952727983707),\n                                    (\"hh(:|h)mm (time-of-day)\", -2.6855773452501515),\n                                    (\"hour\", -1.3862943611198906), (\"minute\", -1.8382794848629478),\n                                    (\"<time-of-day> heures\", -1.4816045409242156),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.6855773452501515)],\n                               n = 16}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22}}),\n       (\"d\\233but <named-month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Avril\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"d\\233but de matin\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"apr\\232s-midi\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"le <ordinal> <cycle> de <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)jour (grain)Octobre\", -1.7047480922384253),\n                                    (\"ordinals (premier..seizieme)semaine (grain)Octobre\",\n                                     -1.7047480922384253),\n                                    (\"daymonth\", -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (premier..seizieme)semaine (grain)intersect\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (premier..seizieme)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"deuxi\\232me quinzaine de <named-month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Avril\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.941388520629334e-2,\n                               unseen = -5.278114659230518,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mercredisoir\", -4.579852378003801),\n                                    (\"<day-of-month> <named-month>d\\233but de journ\\233e\",\n                                     -4.579852378003801),\n                                    (\"dayhour\", -1.05349185338764),\n                                    (\"<day-of-month> <named-month>d\\233but de matin\\233e\",\n                                     -4.579852378003801),\n                                    (\"aujourd'huimilieu d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"Mercredidu|dans le <part-of-day>\", -4.579852378003801),\n                                    (\"aujourd'huifin d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"aujourd'huimilieu de matin\\233e\", -4.579852378003801),\n                                    (\"le <time>du|dans le <part-of-day>\", -4.174387269895637),\n                                    (\"aujourd'huifin de matin\\233e\", -4.579852378003801),\n                                    (\"aujourd'huifin de soir\\233e\", -4.579852378003801),\n                                    (\"<day-of-month> <named-month>d\\233but d'apr\\232s-midi\",\n                                     -4.579852378003801),\n                                    (\"demainsoir\", -4.579852378003801),\n                                    (\"aujourd'huid\\233but de soir\\233e\", -4.579852378003801),\n                                    (\"Lundimatin\", -4.579852378003801),\n                                    (\"le <time>fin de matin\\233e\", -4.579852378003801),\n                                    (\"intersectmilieu de journ\\233e\", -4.579852378003801),\n                                    (\"intersectfin de journ\\233e\", -4.579852378003801),\n                                    (\"le <time>fin d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"aujourd'huiau d\\233jeuner\", -4.579852378003801),\n                                    (\"intersectfin d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"intersectmilieu d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"le <time>milieu de journ\\233e\", -4.579852378003801),\n                                    (\"aujourd'huid\\233but de journ\\233e\", -4.579852378003801),\n                                    (\"demainapr\\232s-midi\", -4.579852378003801),\n                                    (\"Lundidu|dans le <part-of-day>\", -4.579852378003801),\n                                    (\"aujourd'huimilieu de journ\\233e\", -4.579852378003801),\n                                    (\"intersectd\\233but de soir\\233e\", -4.579852378003801),\n                                    (\"aujourd'huifin de journ\\233e\", -4.579852378003801),\n                                    (\"intersectdu|dans le <part-of-day>\", -4.174387269895637),\n                                    (\"Lundifin d'apr\\232s-midi\", -4.174387269895637),\n                                    (\"intersectd\\233but d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"le <time>d\\233but d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"<day-of-month> <named-month>du|dans le <part-of-day>\",\n                                     -4.174387269895637),\n                                    (\"<day-of-month> <named-month>d\\233but de soir\\233e\",\n                                     -4.579852378003801),\n                                    (\"hierdu|dans le <part-of-day>\", -4.579852378003801),\n                                    (\"le <time>d\\233but de soir\\233e\", -4.579852378003801),\n                                    (\"intersectd\\233but de journ\\233e\", -4.579852378003801),\n                                    (\"le <time>d\\233but de matin\\233e\", -4.579852378003801),\n                                    (\"<day-of-month> <named-month>milieu d'apr\\232s-midi\",\n                                     -4.579852378003801),\n                                    (\"<day-of-month> <named-month>fin d'apr\\232s-midi\",\n                                     -4.579852378003801),\n                                    (\"le <time>milieu de matin\\233e\", -4.579852378003801),\n                                    (\"aujourd'huid\\233but de matin\\233e\", -3.481240089335692),\n                                    (\"le <time>fin de soir\\233e\", -4.579852378003801),\n                                    (\"<day-of-month> <named-month>milieu de matin\\233e\",\n                                     -4.579852378003801),\n                                    (\"<day-of-month> <named-month>fin de soir\\233e\",\n                                     -4.579852378003801),\n                                    (\"<day-of-month> <named-month>fin de matin\\233e\",\n                                     -4.579852378003801),\n                                    (\"aujourd'huid\\233but d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"le <time>milieu d'apr\\232s-midi\", -4.579852378003801),\n                                    (\"Jeudimatin\", -4.579852378003801),\n                                    (\"<day-of-month> <named-month>fin de journ\\233e\",\n                                     -4.579852378003801),\n                                    (\"<day-of-month> <named-month>milieu de journ\\233e\",\n                                     -4.579852378003801),\n                                    (\"le <time>fin de journ\\233e\", -4.579852378003801),\n                                    (\"Lundiapr\\232s-midi\", -4.579852378003801),\n                                    (\"intersectfin de matin\\233e\", -4.579852378003801),\n                                    (\"intersectfin de soir\\233e\", -4.579852378003801),\n                                    (\"intersectmilieu de matin\\233e\", -4.579852378003801),\n                                    (\"le <time>d\\233but de journ\\233e\", -4.579852378003801),\n                                    (\"intersectd\\233but de matin\\233e\", -4.579852378003801),\n                                    (\"hiersoir\", -4.579852378003801)],\n                               n = 67},\n                   koData =\n                     ClassData{prior = -3.5409593240373143, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.0757749812275272),\n                                    (\"aujourd'huidu|dans le <part-of-day>\", -3.0757749812275272)],\n                               n = 2}}),\n       (\"jour de l'an\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.38348620138938916,\n                               unseen = -4.553876891600541,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.13657553500575073),\n                                    (\"number (0..16)\", -2.0583881324820035)],\n                               n = 92},\n                   koData =\n                     ClassData{prior = -1.144074662744867, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2803019651541584),\n                                    (\"number (0..16)\", -1.4087672169719492)],\n                               n = 43}}),\n       (\"apr\\232s-demain\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.46262352194811296,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.9932517730102834,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 10}}),\n       (\"<hour-of-day> et|pass\\233 de <number> minutes\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224|vers <time-of-day>number (20..60)\", -2.0794415416798357),\n                                    (\"<time-of-day> heuresinteger (numeric)\", -2.0794415416798357),\n                                    (\"\\224|vers <time-of-day>number (0..16)\", -2.0794415416798357),\n                                    (\"hour\", -0.9808292530117262),\n                                    (\"<time-of-day> heuresnumber (20..60)\", -2.0794415416798357),\n                                    (\"<time-of-day> heuresnumber (0..16)\", -2.0794415416798357)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.580216829592325),\n                                    (\"number (0..16)semaine (grain)\", -3.0910424533583156),\n                                    (\"number (0..16)ann\\233e (grain)\", -3.0910424533583156),\n                                    (\"number (0..16)seconde (grain)\", -3.4965075614664802),\n                                    (\"number (0..16)jour (grain)\", -3.4965075614664802),\n                                    (\"second\", -3.4965075614664802),\n                                    (\"integer (numeric)ann\\233e (grain)\", -3.4965075614664802),\n                                    (\"number (0..16)minute (grain)\", -3.0910424533583156),\n                                    (\"integer (numeric)jour (grain)\", -3.0910424533583156),\n                                    (\"day\", -2.803360380906535), (\"year\", -2.803360380906535),\n                                    (\"number (0..16)mois (grain)\", -3.0910424533583156),\n                                    (\"hour\", -2.580216829592325),\n                                    (\"number (0..16)heure (grain)\", -3.0910424533583156),\n                                    (\"month\", -3.0910424533583156),\n                                    (\"integer (numeric)minute (grain)\", -2.803360380906535),\n                                    (\"minute\", -2.3978952727983707),\n                                    (\"integer (numeric)semaine (grain)\", -3.0910424533583156),\n                                    (\"numbers 22..29 32..39 .. 52..59heure (grain)\",\n                                     -3.4965075614664802),\n                                    (\"integer (numeric)heure (grain)\", -3.4965075614664802)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -4.48863636973214,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.784189633918261),\n                                    (\"number (20..60)minute (grain)\", -3.784189633918261),\n                                    (\"number (0..16)jour (grain)\", -3.0910424533583156),\n                                    (\"integer (numeric)ann\\233e (grain)\", -3.784189633918261),\n                                    (\"number (0..16)minute (grain)\", -3.784189633918261),\n                                    (\"day\", -3.0910424533583156), (\"year\", -3.784189633918261),\n                                    (\"hour\", -1.2584609896100056),\n                                    (\"number (0..16)heure (grain)\", -1.9123874570166697),\n                                    (\"month\", -3.784189633918261),\n                                    (\"integer (numeric)minute (grain)\", -3.784189633918261),\n                                    (\"integer (numeric)mois (grain)\", -3.784189633918261),\n                                    (\"minute\", -3.0910424533583156),\n                                    (\"integer (numeric)semaine (grain)\", -3.784189633918261),\n                                    (\"integer (numeric)heure (grain)\", -1.9123874570166697)],\n                               n = 33}}),\n       (\"avant-hier\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"d\\233but de journ\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"entre <time-of-day> et <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -2.6741486494265287),\n                                    (\"miditime-of-day (latent)\", -2.6741486494265287),\n                                    (\"minutehour\", -0.9694005571881036),\n                                    (\"hh(:|h)mm (time-of-day)time-of-day (latent)\",\n                                     -2.268683541318364),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<time-of-day> heures\",\n                                     -1.9810014688665833),\n                                    (\"hh(:|h)mm (time-of-day)<time-of-day> heures\",\n                                     -1.9810014688665833),\n                                    (\"<hour-of-day> <integer> (as relative minutes)time-of-day (latent)\",\n                                     -2.268683541318364)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minutehour\", -1.2992829841302609),\n                                    (\"hh(:|h)mm (time-of-day)time-of-day (latent)\",\n                                     -1.7047480922384253),\n                                    (\"<hour-of-day> <integer> (as relative minutes)time-of-day (latent)\",\n                                     -1.7047480922384253)],\n                               n = 2}}),\n       (\"d\\233but du mois\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Jeudi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"matin\",\n        Classifier{okData =\n                     ClassData{prior = -0.7472144018302211,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.6418538861723948,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"en <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mars\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"maintenant\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-week> 1er-<day-of-week> dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daydaymonth\", -0.6931471805599453),\n                                    (\"LundiMercrediJuillet\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Decembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Septembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Octobre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"au d\\233jeuner\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Novembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lundi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"le lendemain du <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.0986122886681098),\n                                    (\"<day-of-month> <named-month>\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.0986122886681098),\n                                    (\"year\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"le <cycle> prochain|suivant|d'apr\\232s\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0608719606852628),\n                                    (\"ann\\233e (grain)\", -3.258096538021482),\n                                    (\"semaine (grain)\", -1.0608719606852628),\n                                    (\"mois (grain)\", -2.8526314299133175),\n                                    (\"day\", -2.8526314299133175), (\"year\", -3.258096538021482),\n                                    (\"jour (grain)\", -2.8526314299133175),\n                                    (\"month\", -2.8526314299133175)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/-mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.7375989431307791,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -0.6505875661411494, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"minuit\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"entre dd et dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)Juillet\",\n                                     -1.252762968495368),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"integer (numeric)number (0..16)Juillet\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <day-of-week> of <month-or-greater>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (premier..seizieme)Mercredi<cycle> prochain|suivant|d'apr\\232s\",\n                                     -0.6931471805599453),\n                                    (\"daymonth\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mars\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"une <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -2.174751721484161, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"ann\\233e (grain)\", -2.4849066497880004),\n                                    (\"seconde (grain)\", -2.4849066497880004),\n                                    (\"semaine (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"minute (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"heure (grain)\", -2.4849066497880004),\n                                    (\"hour\", -2.4849066497880004), (\"minute\", -2.4849066497880004)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.12062798778861475,\n                               unseen = -4.532599493153256,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2636920390275583),\n                                    (\"semaine (grain)\", -1.2636920390275583),\n                                    (\"mois (grain)\", -2.91235066461494), (\"day\", -2.12389330425067),\n                                    (\"jour (grain)\", -2.12389330425067),\n                                    (\"month\", -2.91235066461494)],\n                               n = 39}}),\n       (\"<hour-of-day> et quart\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midi\", -1.9459101490553135),\n                                    (\"\\224|vers <time-of-day>\", -1.540445040947149),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"<time-of-day> heures\", -1.540445040947149)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..16)\",\n        Classifier{okData =\n                     ClassData{prior = -0.22738984219566089,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47},\n                   koData =\n                     ClassData{prior = -1.5926307941177191, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"heure (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.540445040947149, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.2411620568168881,\n                               unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22}}),\n       (\"<named-month|named-day> dernier|pass\\233\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.3862943611198906),\n                                    (\"Dimanche\", -1.3862943611198906)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.0794415416798357),\n                                    (\"en semaine\", -1.6739764335716716),\n                                    (\"day\", -1.1631508098056809), (\"year\", -2.0794415416798357),\n                                    (\"le <time>\", -1.6739764335716716)],\n                               n = 5}}),\n       (\"milieu de journ\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/-mm/-yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fin de semaine\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd mm yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fin du mois\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (premier)\",\n        Classifier{okData =\n                     ClassData{prior = -0.16251892949777494,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -1.8971199848858813,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"jour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -1.4271163556401458,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"dd mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"Avril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dernier <cycle> de <time> (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.4816045409242156),\n                                    (\"semaine (grain)intersect\", -1.9924301646902063),\n                                    (\"jour (grain)Octobre\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.4816045409242156),\n                                    (\"semaine (grain)Septembre\", -1.9924301646902063),\n                                    (\"jour (grain)intersect\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"milieu de matin\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"avant le d\\233jeuner\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"1er mai\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fin de soir\\233e\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.9858167945227653, unseen = -4.418840607796598,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"demain<time-of-day> heures\", -3.713572066704308),\n                                    (\"day of month (premier)<day-of-week> <day-of-month>\",\n                                     -3.0204248861443626),\n                                    (\"dayhour\", -3.3081069585961433),\n                                    (\"hh(:|h)mm (time-of-day)<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.3081069585961433),\n                                    (\"le <day-of-month> (non ordinal)<time-of-day> heures\",\n                                     -3.713572066704308),\n                                    (\"minuteminute\", -2.0088239744658827),\n                                    (\"<day-of-month> <named-month><day-of-month> <named-month>\",\n                                     -3.3081069585961433),\n                                    (\"hh(:|h)mm (time-of-day)hh(:|h)mm (time-of-day)\",\n                                     -3.0204248861443626),\n                                    (\"dayday\", -1.9218125974762528),\n                                    (\"<day-of-month> <named-month>day of month (premier)\",\n                                     -3.3081069585961433),\n                                    (\"minutehour\", -3.3081069585961433),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<time-of-day> heures\",\n                                     -3.713572066704308),\n                                    (\"<hour-of-day> <integer> (as relative minutes)hh(:|h)mm (time-of-day)\",\n                                     -3.0204248861443626),\n                                    (\"hh(:|h)mm (time-of-day)<time-of-day> heures\",\n                                     -3.713572066704308),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.3081069585961433),\n                                    (\"<day-of-month> <named-month>intersect\", -3.3081069585961433),\n                                    (\"intersect<day-of-week> <day-of-month>\", -3.3081069585961433)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -0.4670230011075977, unseen = -4.762173934797756,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> <integer> (as relative minutes)intersect\",\n                                     -3.654977902438255),\n                                    (\"monthday\", -2.8076800420510515),\n                                    (\"<day-of-week> <day-of-month>Dimanche\", -3.654977902438255),\n                                    (\"Juinintersect\", -3.654977902438255),\n                                    (\"minuteminute\", -3.654977902438255),\n                                    (\"dayday\", -1.4577533251020356),\n                                    (\"<day-of-week> <day-of-month><day-of-week> <day-of-month>\",\n                                     -3.367295829986474),\n                                    (\"day of month (premier)<day-of-month> <named-month>\",\n                                     -3.367295829986474),\n                                    (\"minutehour\", -2.5563656137701454),\n                                    (\"Juillet<day-of-month> <named-month>\", -3.654977902438255),\n                                    (\"<day-of-week> <day-of-month>Mercredi\", -4.060443010546419),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<time-of-day> heures\",\n                                     -3.367295829986474),\n                                    (\"day of month (premier)intersect\", -2.8076800420510515),\n                                    (\"hh(:|h)mm (time-of-day)<time-of-day> heures\",\n                                     -3.367295829986474),\n                                    (\"intersectintersect\", -3.144152278672264),\n                                    (\"Juinday of month (premier)\", -3.654977902438255),\n                                    (\"hh(:|h)mm (time-of-day)intersect\", -3.654977902438255),\n                                    (\"day of month (premier)Mercredi\", -3.367295829986474),\n                                    (\"intersectMercredi\", -3.654977902438255),\n                                    (\"<day-of-week> <day-of-month>intersect\", -3.654977902438255)],\n                               n = 42}}),\n       (\"<day-of-month> <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2744368457017603, unseen = -4.820281565605037,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Juin\", -3.4258899942525267),\n                                    (\"integer (numeric)Juillet\", -2.414289082574047),\n                                    (\"integer (numeric)Octobre\", -3.202746442938317),\n                                    (\"integer (numeric)Avril\", -3.713572066704308),\n                                    (\"integer (numeric)Fevrier\", -1.6766901394432678),\n                                    (\"month\", -0.7517413448259981),\n                                    (\"integer (numeric)Septembre\", -4.119037174812472),\n                                    (\"integer (numeric)Mars\", -2.0395956331326364)],\n                               n = 57},\n                   koData =\n                     ClassData{prior = -1.4271163556401458, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..16)Juillet\", -2.4203681286504293),\n                                    (\"integer (numeric)Juillet\", -1.241713132308783),\n                                    (\"integer (numeric)Octobre\", -3.1135153092103742),\n                                    (\"month\", -0.8622235106038793),\n                                    (\"integer (numeric)Septembre\", -3.1135153092103742),\n                                    (\"integer (numeric)Mars\", -3.1135153092103742)],\n                               n = 18}}),\n       (\"du dd/nth au dd/nth month (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)number (0..16)Juillet\", -1.6094379124341003),\n                                    (\"ordinal (digits)integer (numeric)Juillet\",\n                                     -1.6094379124341003),\n                                    (\"number (0..16)integer (numeric)Juillet\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Vendredi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> prochain|suivant|d'apr\\232s\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.1700712526502546),\n                                    (\"ann\\233e (grain)\", -3.367295829986474),\n                                    (\"semaine (grain)\", -1.1700712526502546),\n                                    (\"mois (grain)\", -2.451005098112319),\n                                    (\"day\", -2.6741486494265287), (\"year\", -3.367295829986474),\n                                    (\"jour (grain)\", -2.6741486494265287),\n                                    (\"month\", -2.451005098112319)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mois (grain)\", -1.791759469228055),\n                                    (\"day\", -1.791759469228055),\n                                    (\"jour (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055)],\n                               n = 2}}),\n       (\"fin <named-month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mars\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2595426554807467, unseen = -4.060443010546419,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh(:|h)mm (time-of-day)<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.6567569067146595),\n                                    (\"minuteminute\", -1.3350010667323402),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.349904087274605),\n                                    (\"<time-of-day> heures<time-of-day> heures\",\n                                     -3.349904087274605),\n                                    (\"hh(:|h)mm (time-of-day)hh(:|h)mm (time-of-day)\",\n                                     -2.4336133554004498),\n                                    (\"hourhour\", -2.6567569067146595),\n                                    (\"minutehour\", -2.4336133554004498),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<time-of-day> heures\",\n                                     -2.6567569067146595),\n                                    (\"<hour-of-day> <integer> (as relative minutes)hh(:|h)mm (time-of-day)\",\n                                     -2.4336133554004498),\n                                    (\"hh(:|h)mm (time-of-day)<time-of-day> heures\",\n                                     -3.349904087274605),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.6567569067146595),\n                                    (\"<time-of-day> heurestime-of-day (latent)\",\n                                     -3.349904087274605)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.3337731796520479, unseen = -4.804021044733257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)time-of-day (latent)\",\n                                     -1.6602963296675914),\n                                    (\"hourhour\", -1.2694300209805798),\n                                    (\"minutehour\", -1.751268107873318),\n                                    (\"hh(:|h)mm (time-of-day)time-of-day (latent)\",\n                                     -3.004031076368686),\n                                    (\"<hour-of-day> <integer> (as relative minutes)<time-of-day> heures\",\n                                     -3.186352633162641),\n                                    (\"hh(:|h)mm (time-of-day)<time-of-day> heures\",\n                                     -3.186352633162641),\n                                    (\"<hour-of-day> <integer> (as relative minutes)time-of-day (latent)\",\n                                     -2.716349003916905),\n                                    (\"time-of-day (latent)<time-of-day> heures\",\n                                     -2.3108838958087405)],\n                               n = 53}}),\n       (\"<named-day> en huit\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mercredi\", -1.6739764335716716),\n                                    (\"Mardi\", -1.6739764335716716), (\"day\", -0.8266785731844679),\n                                    (\"Lundi\", -1.6739764335716716)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> et demi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midi\", -1.6094379124341003),\n                                    (\"\\224|vers <time-of-day>\", -1.6094379124341003),\n                                    (\"hour\", -0.916290731874155),\n                                    (\"<time-of-day> heures\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dernier week-end de <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Septembre\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0498221244986778,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.4307829160924542, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13}}),\n       (\"avant <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.6739764335716716),\n                                    (\"hour\", -1.1631508098056809),\n                                    (\"<time-of-day> heures\", -1.6739764335716716)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.772588722239781),\n                                    (\"hh(:|h)mm (time-of-day)\", -2.772588722239781),\n                                    (\"time-of-day (latent)\", -1.8562979903656263),\n                                    (\"au d\\233jeuner\", -2.772588722239781),\n                                    (\"hour\", -1.067840630001356), (\"minute\", -2.367123614131617),\n                                    (\"<time-of-day> heures\", -1.8562979903656263),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -2.772588722239781)],\n                               n = 12}}),\n       (\"fin d'apr\\232s-midi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> du <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"matin<day-of-month> <named-month>\", -1.0986122886681098),\n                                    (\"hourday\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"matinyear (latent)\", -1.0986122886681098),\n                                    (\"houryear\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<time-of-day> heures\",\n        Classifier{okData =\n                     ClassData{prior = -0.14805309995913976,\n                               unseen = -5.262690188904886,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"apr\\232s <time-of-day|day>\", -3.871201010907891),\n                                    (\"time-of-day (latent)\", -0.7576857016975165),\n                                    (\"hour\", -0.7036184804272406),\n                                    (\"avant <time-of-day>\", -4.1588830833596715)],\n                               n = 94},\n                   koData =\n                     ClassData{prior = -1.9832976811269336,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"apr\\232s <time-of-day|day>\", -1.916922612182061),\n                                    (\"time-of-day (latent)\", -1.4469189829363254),\n                                    (\"hour\", -0.7537718023763802),\n                                    (\"avant <time-of-day>\", -1.916922612182061)],\n                               n = 15}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"le <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2318016140573243, unseen = -5.857933154483459,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.596975384180945),\n                                    (\"<named-month|named-day> suivant|d'apr\\232s\",\n                                     -3.657847344866208),\n                                    (\"<ordinal> <cycle> de <time>\", -4.468777561082536),\n                                    (\"premi\\232re quinzaine de <named-month>(interval)\",\n                                     -5.161924741642482),\n                                    (\"intersect\", -2.2441540095582027),\n                                    (\"soir de no\\235l\", -5.161924741642482),\n                                    (\"en semaine\", -3.457176649404057),\n                                    (\"toussaint\", -4.756459633534318), (\"day\", -1.290723730734591),\n                                    (\"deuxi\\232me quinzaine de <named-month>(interval)\",\n                                     -5.161924741642482),\n                                    (\"<dim time> <part-of-day>\", -3.2160145925871686),\n                                    (\"dd/-mm\", -3.909161773147114),\n                                    (\"nth <day-of-week> of <month-or-greater>\", -5.161924741642482),\n                                    (\"dd/-mm/-yyyy\", -4.468777561082536),\n                                    (\"dd mm yyyy\", -3.909161773147114),\n                                    (\"day of month (premier)\", -3.909161773147114),\n                                    (\"dd mm\", -3.909161773147114), (\"hour\", -2.1915102760727807),\n                                    (\"month\", -4.468777561082536),\n                                    (\"dernier <cycle> de <time> (latent)\", -4.2456340097683265),\n                                    (\"<day-of-month> <named-month>\", -2.5592350561980983),\n                                    (\"<cycle> prochain|suivant|d'apr\\232s\", -2.810549484479004),\n                                    (\"dernier week-end de <time>\", -5.161924741642482),\n                                    (\"<ordinal> week-end de <time>\", -4.756459633534318),\n                                    (\"<cycle> dernier\", -4.0633124529743725)],\n                               n = 161},\n                   koData =\n                     ClassData{prior = -1.575536360758419, unseen = -4.718498871295094,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month|named-day> suivant|d'apr\\232s\",\n                                     -4.0163830207523885),\n                                    (\"intersect\", -3.3232358401924436),\n                                    (\"en semaine\", -1.936941479072553),\n                                    (\"day\", -1.3083328196501787), (\"dd/-mm\", -3.3232358401924436),\n                                    (\"<named-month|named-day> dernier|pass\\233\",\n                                     -3.6109179126442243),\n                                    (\"day of month (premier)\", -3.6109179126442243),\n                                    (\"dd mm\", -3.3232358401924436), (\"hour\", -2.0704728716970755),\n                                    (\"<day-of-month> <named-month>\", -3.6109179126442243),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.2246235515243336)],\n                               n = 42}}),\n       (\"apr\\232s le <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"n <cycle> passes|precedents\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"integer (numeric)ann\\233e (grain)\", -1.6094379124341003),\n                                    (\"year\", -1.6094379124341003),\n                                    (\"integer (numeric)semaine (grain)\", -1.6094379124341003)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"number (0..16)heure (grain)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"il y a <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -0.9555114450274363),\n                                    (\"hour\", -1.8718021769015913), (\"month\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> week-end de <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (premier..seizieme)Septembre\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> du matin\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224|vers <time-of-day>\", -1.466337068793427),\n                                    (\"hour\", -0.7731898882334817),\n                                    (\"<time-of-day> heures\", -1.1786549963416462)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.916290731874155),\n                                    (\"<time-of-day> heures\", -0.916290731874155)],\n                               n = 1}}),\n       (\"d\\233but d'apr\\232s-midi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -8.961215868968717e-2,\n                               unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuitnumber (0..16)\", -3.20545280453606),\n                                    (\"midinumber (20..60)\", -3.6109179126442243),\n                                    (\"\\224|vers <time-of-day>number (20..60)\", -3.6109179126442243),\n                                    (\"<time-of-day> heuresinteger (numeric)\", -1.16857087727502),\n                                    (\"\\224|vers <time-of-day>number (0..16)\", -3.20545280453606),\n                                    (\"midinumber (0..16)\", -3.6109179126442243),\n                                    (\"hour\", -0.8075575317376895),\n                                    (\"<time-of-day> heuresnumber (20..60)\", -3.6109179126442243),\n                                    (\"\\224|vers <time-of-day>integer (numeric)\",\n                                     -3.6109179126442243),\n                                    (\"<time-of-day> heuresnumber (0..16)\", -3.6109179126442243)],\n                               n = 32},\n                   koData =\n                     ClassData{prior = -2.456735772821304, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.3862943611198906),\n                                    (\"\\224|vers <time-of-day>integer (numeric)\",\n                                     -1.6739764335716716),\n                                    (\"<time-of-day> heuresnumber (0..16)\", -2.0794415416798357)],\n                               n = 3}}),\n       (\"<cycle> dernier\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9924301646902063),\n                                    (\"ann\\233e (grain)\", -2.3978952727983707),\n                                    (\"semaine (grain)\", -1.9924301646902063),\n                                    (\"mois (grain)\", -2.3978952727983707),\n                                    (\"day\", -1.9924301646902063), (\"year\", -2.3978952727983707),\n                                    (\"jour (grain)\", -1.9924301646902063),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"heure (grain)\", -1.791759469228055),\n                                    (\"hour\", -1.791759469228055)],\n                               n = 1}}),\n       (\"ce|dans le <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2992829841302609),\n                                    (\"ann\\233e (grain)\", -2.3978952727983707),\n                                    (\"semaine (grain)\", -1.2992829841302609),\n                                    (\"day\", -1.9924301646902063), (\"year\", -2.3978952727983707),\n                                    (\"jour (grain)\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dimanche\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Fevrier\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ce <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"soir\", -1.466337068793427), (\"day\", -1.8718021769015913),\n                                    (\"Lundi\", -1.8718021769015913), (\"hour\", -1.1786549963416462),\n                                    (\"week-end\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 2679}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.GA_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"ar\\250 am\\225rach\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"inniu\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"<time> seo chugainn\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.3862943611198906), (\"day\", -0.8266785731844679),\n                                    (\"d\\233 named-day\", -2.0794415416798357),\n                                    (\"an named-day\", -1.6739764335716716)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"d\\233 named-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"anois\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"an named-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"am\\225rach\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"inn\\233\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> seo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.3862943611198906), (\"day\", -0.7985076962177716),\n                                    (\"d\\233 named-day\", -2.3025850929940455),\n                                    (\"an named-day\", -1.6094379124341003)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ar\\250 inn\\233\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 163}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.HE_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\1502\\1512\\1509\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -1.110882381259924, unseen = -3.367295829986474,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 27},\n                   koData =\n                     ClassData{prior = -0.3993860620317821, unseen = -4.04305126783455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 55}}),\n       (\"\\1489 <date>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12783337150988489,\n                               unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1502\\1512\\1509\", -3.0757749812275272),\n                                    (\"week\", -3.0757749812275272),\n                                    (\"<time> <part-of-day>\", -3.481240089335692),\n                                    (\"mm/dd\", -3.481240089335692),\n                                    (\"intersect\", -3.0757749812275272), (\"day\", -2.228477120840324),\n                                    (\"this <cycle>\", -3.481240089335692),\n                                    (\"time-of-day (latent)\", -3.0757749812275272),\n                                    (\"<time-of-day> am|pm\", -3.481240089335692),\n                                    (\"named-day\", -3.0757749812275272),\n                                    (\"current <day-of-week>\", -3.481240089335692),\n                                    (\"last <time>\", -3.481240089335692),\n                                    (\"\\1488\\1493\\1511\\1496\\1493\\1489\\1512\", -3.481240089335692),\n                                    (\"hour\", -1.7764919970972666), (\"month\", -2.5649493574615367),\n                                    (\"\\1508\\1489\\1512\\1493\\1488\\1512\", -3.481240089335692),\n                                    (\"last <cycle>\", -3.481240089335692),\n                                    (\"<named-month> <day-of-month> (non ordinal)\",\n                                     -3.481240089335692),\n                                    (\"week-end\", -3.0757749812275272),\n                                    (\"this <time>\", -3.0757749812275272)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -2.120263536200091, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.6026896854443837),\n                                    (\"day\", -2.1972245773362196),\n                                    (\"<day-of-month> (ordinal)\", -2.6026896854443837),\n                                    (\"month\", -2.6026896854443837),\n                                    (\"this <time>\", -2.6026896854443837)],\n                               n = 3}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.4213856809311607),\n                                    (\"\\1489 <date>morning\", -2.6741486494265287),\n                                    (\"yesterdayevening|night\", -2.6741486494265287),\n                                    (\"hourhour\", -1.9810014688665833),\n                                    (\"time-of-day (latent)morning\", -2.6741486494265287),\n                                    (\"named-daymorning\", -2.6741486494265287),\n                                    (\"todayevening|night\", -2.6741486494265287),\n                                    (\"tomorrowlunch\", -2.268683541318364),\n                                    (\"at <time-of-day>morning\", -2.6741486494265287),\n                                    (\"tomorrowevening|night\", -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"<day-of-month> (ordinal)morning\", -1.8718021769015913)],\n                               n = 1}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"<time-of-day> am|pm\", -1.5040773967762742),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<day-of-month> (non ordinal) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\\1502\\1512\\1509\", -1.9459101490553135),\n                                    (\"integer (numeric)\\1508\\1489\\1512\\1493\\1488\\1512\",\n                                     -1.4350845252893227),\n                                    (\"integer (numeric)\\1488\\1508\\1512\\1497\\1500\",\n                                     -2.3513752571634776),\n                                    (\"integer 3\\1502\\1512\\1509\", -2.3513752571634776),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"named-day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1502\\1512\\1509\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 4\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"\\1489 <named-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"named-day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 9\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"integer 21..99 (with and)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (20..90)integer 4\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.37320424588994294,\n                               unseen = -4.859812404361672,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.6548056865833978),\n                                    (\"daymonth\", -3.242592351485517),\n                                    (\"monthyear\", -3.7534179752515073),\n                                    (\"the <day-of-month> (ordinal)in <named-month>\",\n                                     -3.7534179752515073),\n                                    (\"\\1488\\1493\\1511\\1496\\1493\\1489\\1512year\",\n                                     -4.1588830833596715),\n                                    (\"intersect<time-of-day> am|pm\", -4.1588830833596715),\n                                    (\"<time> <part-of-day>\\1489 <named-day>\", -3.4657359027997265),\n                                    (\"intersect by \\\",\\\"<time-of-day> am|pm\", -3.242592351485517),\n                                    (\"last <day-of-week> of <time>year\", -4.1588830833596715),\n                                    (\"dayday\", -2.772588722239781),\n                                    (\"the <day-of-month> (ordinal)\\1489 <date>\",\n                                     -3.7534179752515073),\n                                    (\"dayyear\", -2.367123614131617),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -3.7534179752515073),\n                                    (\"\\1489 <date>\\1489 <named-day>\", -4.1588830833596715),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.1588830833596715),\n                                    (\"absorption of , after named day<day-of-month> (ordinal) of <named-month>\",\n                                     -4.1588830833596715),\n                                    (\"<day-of-month> (ordinal) of <named-month>year\",\n                                     -3.4657359027997265),\n                                    (\"named-daynext <cycle>\", -4.1588830833596715),\n                                    (\"dayminute\", -2.772588722239781),\n                                    (\"named-day<day-of-month> (ordinal) of <named-month>\",\n                                     -4.1588830833596715),\n                                    (\"named-day\\1489 <date>\", -4.1588830833596715),\n                                    (\"absorption of , after named dayintersect\",\n                                     -4.1588830833596715),\n                                    (\"named-day<day-of-month> (non ordinal) of <named-month>\",\n                                     -4.1588830833596715),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -3.7534179752515073),\n                                    (\"year<time-of-day> am|pm\", -4.1588830833596715),\n                                    (\"\\1489 <date>\\1489 <date>\", -4.1588830833596715),\n                                    (\"<day-of-month> (non ordinal) of <named-month>year\",\n                                     -3.4657359027997265),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) of <named-month>\",\n                                     -4.1588830833596715),\n                                    (\"dayweek\", -3.7534179752515073),\n                                    (\"\\1502\\1512\\1509year\", -4.1588830833596715),\n                                    (\"<time> <part-of-day>\\1489 <date>\", -3.4657359027997265),\n                                    (\"named-daythe <day-of-month> (ordinal)\", -4.1588830833596715),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -3.7534179752515073),\n                                    (\"yearminute\", -4.1588830833596715)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -1.1664348850068706, unseen = -4.418840607796598,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"in <named-month>year\", -3.713572066704308),\n                                    (\"dayhour\", -3.3081069585961433),\n                                    (\"daymonth\", -3.0204248861443626),\n                                    (\"monthyear\", -2.6149597780361984),\n                                    (\"intersecthh:mm\", -3.713572066704308),\n                                    (\"dayday\", -3.713572066704308),\n                                    (\"intersect by \\\",\\\"hh:mm\", -2.797281334830153),\n                                    (\"\\1488\\1508\\1512\\1497\\1500year\", -3.713572066704308),\n                                    (\"named-dayin <named-month>\", -3.713572066704308),\n                                    (\"dayminute\", -2.327277705584417),\n                                    (\"named-day\\1489 <date>\", -3.713572066704308),\n                                    (\"absorption of , after named dayintersect\",\n                                     -3.713572066704308),\n                                    (\"yearhh:mm\", -3.713572066704308),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -3.713572066704308),\n                                    (\"\\1502\\1512\\1509year\", -3.3081069585961433),\n                                    (\"\\1489 <date>year\", -3.713572066704308),\n                                    (\"named-daythe <day-of-month> (ordinal)\", -3.713572066704308),\n                                    (\"absorption of , after named day\\1497\\1493\\1500\\1497\",\n                                     -3.713572066704308),\n                                    (\"tomorrownoon\", -3.3081069585961433),\n                                    (\"yearminute\", -3.713572066704308)],\n                               n = 19}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"month (grain)\", -1.9459101490553135),\n                                    (\"year (grain)\", -1.9459101490553135),\n                                    (\"week (grain)\", -1.540445040947149),\n                                    (\"year\", -1.9459101490553135), (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 3\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal) of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal 3\\1502\\1512\\1509\", -2.4849066497880004),\n                                    (\"ordinal (digits)\\1502\\1512\\1509\", -2.0794415416798357),\n                                    (\"ordinal (digits)\\1488\\1508\\1512\\1497\\1500\",\n                                     -2.4849066497880004),\n                                    (\"ordinal 3\\1488\\1493\\1511\\1496\\1493\\1489\\1512\",\n                                     -2.4849066497880004),\n                                    (\"month\", -0.8754687373538999),\n                                    (\"ordinal (digits)\\1508\\1489\\1512\\1493\\1488\\1512\",\n                                     -1.5686159179138452)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer 4\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer 10\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"ordinal 19\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1488\\1493\\1490\\1493\\1505\\1496\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1488\\1508\\1512\\1497\\1500\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 11..19\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer 9integer 10\", 0.0)],\n                               n = 1}}),\n       (\"integer 7\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal 3\\1489 <date>\", -1.7346010553881064),\n                                    (\"ordinal (digits)in <named-month>\", -2.1400661634962708),\n                                    (\"month\", -0.8873031950009028),\n                                    (\"ordinal 3in <named-month>\", -1.7346010553881064),\n                                    (\"ordinal (digits)\\1489 <date>\", -2.1400661634962708)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1497\\1493\\1500\\1497\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 6}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"named-day\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal 3\", -1.252762968495368),\n                                    (\"ordinal 19\", -1.252762968495368),\n                                    (\"ordinal (digits)\", -1.252762968495368)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"ordinal 9\", -0.916290731874155)],\n                               n = 1}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"week (grain)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 7\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4700036292457356),\n                                    (\"integer 9\", -1.3862943611198906)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3677247801253174),\n                                    (\"integer (20..90)\", -1.8718021769015913),\n                                    (\"integer 9\", -1.8718021769015913)],\n                               n = 10}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"integer 9\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8109302162163288),\n                                    (\"named-dayintersect\", -1.5040773967762742),\n                                    (\"named-day\\1502\\1512\\1509\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer 21..99 (with and)hour (grain)\", -2.3025850929940455),\n                                    (\"day\", -1.8971199848858813),\n                                    (\"integer 7day (grain)\", -1.8971199848858813),\n                                    (\"hour\", -1.8971199848858813),\n                                    (\"integer (numeric)minute (grain)\", -1.8971199848858813),\n                                    (\"minute\", -1.8971199848858813),\n                                    (\"integer (numeric)hour (grain)\", -2.3025850929940455)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.6094379124341003),\n                                    (\"integer 4hour (grain)\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.3629054936893685,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1489 <date>\", -2.9444389791664407),\n                                    (\"at <time-of-day>\", -2.9444389791664407),\n                                    (\"time-of-day (latent)\", -2.2512917986064953),\n                                    (\"hh:mm\", -1.1526795099383855), (\"hour\", -1.845826690498331),\n                                    (\"minute\", -1.1526795099383855)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -1.1895840668738362, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 7}}),\n       (\"integer 10\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.3794896217049037,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect by \\\",\\\"year\", -3.044522437723423),\n                                    (\"dayday\", -2.128231705849268),\n                                    (\"named-dayintersect by \\\",\\\"\", -2.639057329615259),\n                                    (\"dayyear\", -2.128231705849268),\n                                    (\"<named-month> <day-of-month> (non ordinal)intersect\",\n                                     -3.044522437723423),\n                                    (\"named-day<named-month> <day-of-month> (non ordinal)\",\n                                     -3.044522437723423),\n                                    (\"intersect by \\\",\\\"intersect\", -3.044522437723423),\n                                    (\"named-dayintersect\", -3.044522437723423),\n                                    (\"dayminute\", -1.9459101490553135),\n                                    (\"named-day<day-of-month> (ordinal) of <named-month>\",\n                                     -3.044522437723423),\n                                    (\"intersectyear\", -3.044522437723423),\n                                    (\"named-day<day-of-month> (non ordinal) of <named-month>\",\n                                     -3.044522437723423),\n                                    (\"intersectintersect\", -3.044522437723423),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -2.639057329615259)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.1526795099383855, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.639057329615259),\n                                    (\"named-dayintersect by \\\",\\\"\", -2.639057329615259),\n                                    (\"named-day\\1497\\1493\\1500\\1497\", -2.639057329615259),\n                                    (\"<named-month> <day-of-month> (non ordinal)intersect\",\n                                     -2.639057329615259),\n                                    (\"intersect by \\\",\\\"intersect\", -2.639057329615259),\n                                    (\"named-dayintersect\", -2.639057329615259),\n                                    (\"dayminute\", -1.540445040947149),\n                                    (\"intersectintersect\", -2.639057329615259)],\n                               n = 6}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"named-day\",\n        Classifier{okData =\n                     ClassData{prior = -3.7740327982847086e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -3.295836866004329, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"ordinal 1\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"current <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1489 <date>\", -1.9459101490553135),\n                                    (\"\\1489 <named-day>\", -1.9459101490553135),\n                                    (\"day\", -0.8472978603872037),\n                                    (\"named-day\", -1.252762968495368)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 4\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"named-dayordinal (digits)\", -0.916290731874155),\n                                    (\"day\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of , after named dayordinal (digits)\",\n                                     -0.916290731874155),\n                                    (\"day\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 6\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"integer 3\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1489 <date>\", -1.791759469228055),\n                                    (\"day\", -1.791759469228055), (\"named-day\", -1.791759469228055),\n                                    (\"hour\", -1.3862943611198906),\n                                    (\"week-end\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.9808292530117262),\n                                    (\"named-day\", -1.6739764335716716),\n                                    (\"<day-of-month> (ordinal)\", -1.3862943611198906)],\n                               n = 5}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal 4\", -1.7047480922384253),\n                                    (\"ordinal 3\", -1.7047480922384253),\n                                    (\"ordinal 2\", -1.0116009116784799),\n                                    (\"ordinal 1\", -1.2992829841302609)],\n                               n = 7}}),\n       (\"\\1488\\1493\\1511\\1496\\1493\\1489\\1512\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\1508\\1489\\1512\\1493\\1488\\1512\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1502\\1512\\1509\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.916290731874155), (\"named-day\", -0.916290731874155)],\n                               n = 3}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.0986122886681098),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"week (grain)\", -1.0986122886681098),\n                                    (\"month\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 20..90\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"hhmm (military) am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.3025850929940455),\n                                    (\"half an hour\", -2.3025850929940455),\n                                    (\"<integer> <unit-of-duration>\", -1.2039728043259361),\n                                    (\"quarter of an hour\", -2.3025850929940455),\n                                    (\"hour\", -1.8971199848858813), (\"minute\", -1.3862943611198906)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1502\\1512\\1509\", -1.3862943611198906),\n                                    (\"\\1488\\1493\\1511\\1496\\1493\\1489\\1512\", -1.791759469228055),\n                                    (\"month\", -0.8754687373538999),\n                                    (\"\\1508\\1489\\1512\\1493\\1488\\1512\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"ordinal 5\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"in <named-month>integer (numeric)\", -2.3978952727983707),\n                                    (\"\\1502\\1512\\1509integer (numeric)\", -2.3978952727983707),\n                                    (\"\\1489 <date>integer (numeric)\", -2.3978952727983707),\n                                    (\"\\1508\\1489\\1512\\1493\\1488\\1512integer (numeric)\",\n                                     -2.3978952727983707),\n                                    (\"\\1488\\1493\\1490\\1493\\1505\\1496integer (numeric)\",\n                                     -2.3978952727983707),\n                                    (\"\\1488\\1508\\1512\\1497\\1500integer (numeric)\",\n                                     -2.3978952727983707),\n                                    (\"\\1497\\1493\\1500\\1497integer (numeric)\", -2.3978952727983707),\n                                    (\"month\", -1.0116009116784799)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)in <named-month>\", -1.8718021769015913),\n                                    (\"integer 3\\1489 <date>\", -1.8718021769015913),\n                                    (\"integer (numeric)\\1489 <date>\", -1.8718021769015913),\n                                    (\"month\", -0.9555114450274363),\n                                    (\"integer 3in <named-month>\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal 3\\1489 <date>\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"ordinal 3in <named-month>\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1489 <date>\", -1.9459101490553135),\n                                    (\"\\1489 <named-day>\", -2.3513752571634776),\n                                    (\"day\", -1.252762968495368), (\"named-day\", -1.6582280766035324),\n                                    (\"hour\", -1.9459101490553135),\n                                    (\"week-end\", -2.3513752571634776)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1489 <date>\", -2.0149030205422647),\n                                    (\"day\", -1.0986122886681098),\n                                    (\"<day-of-month> (ordinal)\", -1.3217558399823195)],\n                               n = 4}})]", "num_lines": 1053}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.HI_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.HR_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.0149030205422647),\n                                    (\"intersect\", -1.6094379124341003),\n                                    (\"hh:mm\", -1.6094379124341003), (\"hour\", -2.0149030205422647),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.9456429438866826, unseen = -4.564348191467836,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 94},\n                   koData =\n                     ClassData{prior = -0.49172545239257137,\n                               unseen = -5.0106352940962555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 148}}),\n       (\"Father's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"few\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -5.214935757608986,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> o'clockmorning\", -4.516338972281476),\n                                    (\"until <time-of-day>afternoon\", -4.516338972281476),\n                                    (\"dayhour\", -2.8115908800430502),\n                                    (\"time-of-day (latent)late night\", -3.82319179172153),\n                                    (\"time-of-day (latent)evening|night\", -4.110873864173311),\n                                    (\"<time-of-day> o'clockevening|night\", -4.516338972281476),\n                                    (\"Mondayearly morning\", -3.82319179172153),\n                                    (\"<time-of-day> o'clocktonight\", -4.516338972281476),\n                                    (\"<hour-of-day> halfafternoon\", -4.516338972281476),\n                                    (\"time-of-day (latent)tonight\", -4.110873864173311),\n                                    (\"yesterdayevening|night\", -4.516338972281476),\n                                    (\"hourhour\", -1.4482860371478585),\n                                    (\"at <time-of-day>afternoon\", -3.417726683613366),\n                                    (\"minutehour\", -2.501435951739211),\n                                    (\"<time-of-day> o'clockafternoon\", -4.516338972281476),\n                                    (\"intersectafternoon\", -4.516338972281476),\n                                    (\"time-of-day (latent)morning\", -4.516338972281476),\n                                    (\"todayevening|night\", -4.516338972281476),\n                                    (\"at <time-of-day>late night\", -3.82319179172153),\n                                    (\"hh:mmearly morning\", -4.516338972281476),\n                                    (\"<day-of-month>(ordinal) <named-month>morning\",\n                                     -4.516338972281476),\n                                    (\"half <integer> (HR style hour-of-day)afternoon\",\n                                     -4.110873864173311),\n                                    (\"numeral after|past (hour-of-day)afternoon\",\n                                     -4.516338972281476),\n                                    (\"quarter after|past (hour-of-day)afternoon\",\n                                     -4.516338972281476),\n                                    (\"<time-of-day> o'clocklate night\", -4.110873864173311),\n                                    (\"tomorrowlunch\", -4.516338972281476),\n                                    (\"todaytonight\", -4.516338972281476),\n                                    (\"time-of-day (latent)afternoon\", -3.130044611161585),\n                                    (\"intersectmorning\", -3.2635760037861075),\n                                    (\"about <time-of-day>afternoon\", -3.82319179172153),\n                                    (\"<duration> after <time>afternoon\", -4.516338972281476),\n                                    (\"Mondaymorning\", -4.516338972281476),\n                                    (\"hh:mmafternoon\", -3.2635760037861075),\n                                    (\"between <datetime> and <datetime> (interval)morning\",\n                                     -4.516338972281476),\n                                    (\"between <time-of-day> and <time-of-day> (interval)morning\",\n                                     -4.516338972281476),\n                                    (\"at <time-of-day>morning\", -4.516338972281476),\n                                    (\"tomorrowevening|night\", -4.516338972281476)],\n                               n = 66},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -4.564348191467836,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> o'clockmorning\", -3.8607297110405954),\n                                    (\"Februarylate night\", -3.8607297110405954),\n                                    (\"dayhour\", -3.455264602932431),\n                                    (\"yearhour\", -3.455264602932431),\n                                    (\"nograinhour\", -3.455264602932431),\n                                    (\"monthhour\", -3.455264602932431),\n                                    (\"by <time>afternoon\", -3.8607297110405954),\n                                    (\"after <time-of-day>morning\", -3.8607297110405954),\n                                    (\"hourhour\", -2.2512917986064953),\n                                    (\"until <time-of-day>morning\", -3.8607297110405954),\n                                    (\"since <time-of-day>morning\", -3.8607297110405954),\n                                    (\"minutehour\", -2.762117422372486),\n                                    (\"time-of-day (latent)morning\", -3.8607297110405954),\n                                    (\"year (latent)afternoon\", -3.455264602932431),\n                                    (\"Februarymorning\", -3.8607297110405954),\n                                    (\"by <time>morning\", -3.8607297110405954),\n                                    (\"numeral to|till|before <integer> (hour-of-day)morning\",\n                                     -3.8607297110405954),\n                                    (\"Mondaylate night\", -3.8607297110405954),\n                                    (\"time-of-day (latent)afternoon\", -2.6079667425452278),\n                                    (\"intersectmorning\", -3.455264602932431),\n                                    (\"<day-of-month>(ordinal) <named-month>late night\",\n                                     -3.8607297110405954)],\n                               n = 22}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = -1.3350010667323402,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.3053816495511819, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1670540846631662, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> o'clock\", -2.2823823856765264),\n                                    (\"time-of-day (latent)\", -1.1192315758708455),\n                                    (\"hh:mm\", -2.505525936990736), (\"hour\", -0.8960880245566356),\n                                    (\"minute\", -2.505525936990736)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -1.8718021769015913, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9555114450274363),\n                                    (\"hour\", -0.9555114450274363)],\n                               n = 4}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.803360380906535),\n                                    (\"Saturday\", -2.803360380906535),\n                                    (\"Monday\", -1.8870696490323797),\n                                    (\"Friday\", -2.1102132003465894), (\"day\", -0.8574502318512216),\n                                    (\"Sunday\", -2.3978952727983707),\n                                    (\"u <named-day>\", -2.3978952727983707)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15822400521489416,\n                               unseen = -3.6109179126442243,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 35},\n                   koData =\n                     ClassData{prior = -1.9218125974762528,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9924301646902063),\n                                    (\"minuteminute\", -1.2992829841302609),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3978952727983707),\n                                    (\"hh:mmhh:mm\", -1.2992829841302609),\n                                    (\"hourhour\", -2.3978952727983707),\n                                    (\"minutehour\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0986122886681098),\n                                    (\"minutehour\", -1.0986122886681098)],\n                               n = 3}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.03688192726104),\n                                    (\"minuteminute\", -1.3437347467010947),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.4423470353692043),\n                                    (\"hh:mmhh:mm\", -1.3437347467010947),\n                                    (\"hourhour\", -2.4423470353692043),\n                                    (\"minutehour\", -2.03688192726104)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.55814461804655),\n                                    (\"minuteminute\", -1.55814461804655),\n                                    (\"minutehour\", -1.55814461804655),\n                                    (\"hh:mmintersect\", -1.55814461804655)],\n                               n = 6}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.824549292051046),\n                                    (\"time-of-day (latent)\", -1.2367626271489267),\n                                    (\"until <time-of-day>\", -2.740840023925201),\n                                    (\"hour\", -0.7949298748698876)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8690378470236094),\n                                    (\"hour\", -0.7949298748698876),\n                                    (\"after <time-of-day>\", -2.740840023925201)],\n                               n = 13}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"three-quarters of an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8690378470236094, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.5436154465889815, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.2992829841302609),\n                                    (\"ordinals (first..19th)quarter (grain)\", -1.2992829841302609),\n                                    (\"quarter\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.252762968495368),\n                                    (\"ordinals (first..19th)quarter (grain)\", -1.252762968495368),\n                                    (\"quarter\", -0.8472978603872037)],\n                               n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.44531101665536404,\n                               unseen = -6.100318952020064,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"u <named-day><day-of-month>(ordinal) <named-month>\",\n                                     -5.404927101606295),\n                                    (\"hourday\", -4.99946199349813),\n                                    (\"dd.mm<time-of-day> o'clock\", -5.404927101606295),\n                                    (\"dayhour\", -2.730778452179766),\n                                    (\"daymonth\", -3.61316763237824),\n                                    (\"u <named-day><named-month> <day-of-month> (ordinal)\",\n                                     -5.404927101606295),\n                                    (\"monthyear\", -3.7001790093678695),\n                                    (\"Wednesdayintersect\", -5.404927101606295),\n                                    (\"christmasyear\", -5.404927101606295),\n                                    (\"Wednesdaynext <cycle>\", -5.404927101606295),\n                                    (\"u <named-day><time-of-day> o'clock\", -5.404927101606295),\n                                    (\"<time> <part-of-day>u <named-day>\", -4.018632740486404),\n                                    (\"intersectat <time-of-day>\", -5.404927101606295),\n                                    (\"Saturday<time> <part-of-day>\", -4.99946199349813),\n                                    (\"day before yesterdayat <time-of-day>\", -4.711779921046349),\n                                    (\"Marchyear\", -5.404927101606295),\n                                    (\"<named-day> <day-of-month> (ordinal)September\",\n                                     -4.99946199349813),\n                                    (\"Saturdayat <time-of-day>\", -4.99946199349813),\n                                    (\"between <time-of-day> and <time-of-day> (interval)u <named-day>\",\n                                     -4.711779921046349),\n                                    (\"between <datetime> and <datetime> (interval)u <named-day>\",\n                                     -4.711779921046349),\n                                    (\"last <cycle>u <named-day>\", -5.404927101606295),\n                                    (\"<time-of-day> o'clocktonight\", -5.404927101606295),\n                                    (\"from <datetime> - <datetime> (interval)u <named-day>\",\n                                     -5.404927101606295),\n                                    (\"today<time> <part-of-day>\", -4.99946199349813),\n                                    (\"todayat <time-of-day>\", -5.404927101606295),\n                                    (\"Thursday<time> timezone\", -4.99946199349813),\n                                    (\"from <time-of-day> - <time-of-day> (interval)u <named-day>\",\n                                     -5.404927101606295),\n                                    (\"next <cycle>u <named-day>\", -5.404927101606295),\n                                    (\"dayday\", -3.1536353029998), (\"hourhour\", -5.404927101606295),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.99946199349813),\n                                    (\"Thursdaybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -4.306314812938186),\n                                    (\"dayyear\", -3.900849704830021),\n                                    (\"Thursdaybetween <datetime> and <datetime> (interval)\",\n                                     -4.306314812938186),\n                                    (\"<time-of-day> o'clocktomorrow\", -5.404927101606295),\n                                    (\"Thursday<time> <part-of-day>\", -4.99946199349813),\n                                    (\"<time-of-day> - <time-of-day> (interval)u <named-day>\",\n                                     -4.48863636973214),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -4.99946199349813),\n                                    (\"<datetime> - <datetime> (interval)u <named-day>\",\n                                     -4.48863636973214),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month>\",\n                                     -4.018632740486404),\n                                    (\"day after tomorrow<time> <part-of-day>\", -5.404927101606295),\n                                    (\"Thursdayhh:mm\", -4.99946199349813),\n                                    (\"minutemonth\", -4.48863636973214),\n                                    (\"day after tomorrowat <time-of-day>\", -4.99946199349813),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (ordinal)\",\n                                     -4.48863636973214),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.99946199349813),\n                                    (\"<named-day> <day-of-month> (ordinal)February\",\n                                     -4.152164133110927),\n                                    (\"this <cycle>u <named-day>\", -4.99946199349813),\n                                    (\"last <day-of-week> <time>year\", -4.99946199349813),\n                                    (\"dd.mmat <time-of-day>\", -4.99946199349813),\n                                    (\"intersect<day-of-month>(ordinal) <named-month>\",\n                                     -4.48863636973214),\n                                    (\"intersect<named-month> <day-of-month> (ordinal)\",\n                                     -4.99946199349813),\n                                    (\"Saturday<time-of-day> o'clock\", -5.404927101606295),\n                                    (\"day before yesterday<time-of-day> o'clock\",\n                                     -5.404927101606295),\n                                    (\"<time> <part-of-day><named-day> <day-of-month> (ordinal)\",\n                                     -4.48863636973214),\n                                    (\"dayminute\", -3.0070318288079245),\n                                    (\"u <named-day>at <time-of-day>\", -4.99946199349813),\n                                    (\"<time> <part-of-day>intersect\", -3.5331249247047034),\n                                    (\"u <named-day><time> <part-of-day>\", -4.99946199349813),\n                                    (\"Tuesdayu <named-month>\", -5.404927101606295),\n                                    (\"intersectyear\", -5.404927101606295),\n                                    (\"intersectSeptember\", -4.48863636973214),\n                                    (\"<ordinal> <cycle> of <time>year\", -5.404927101606295),\n                                    (\"minuteday\", -2.1090902356019656),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.404927101606295),\n                                    (\"<time> <part-of-day>intersect by \\\",\\\"\", -4.48863636973214),\n                                    (\"Octoberyear\", -4.306314812938186),\n                                    (\"intersect by \\\",\\\"at <time-of-day>\", -4.48863636973214),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -4.306314812938186),\n                                    (\"yearat <time-of-day>\", -5.404927101606295),\n                                    (\"Septemberyear\", -4.99946199349813),\n                                    (\"<time> <part-of-day>absorption of , after named day\",\n                                     -4.711779921046349),\n                                    (\"todaytonight\", -5.404927101606295),\n                                    (\"weekday\", -4.48863636973214), (\"dayweek\", -5.404927101606295),\n                                    (\"weekyear\", -4.99946199349813),\n                                    (\"Wednesdayu <named-month>\", -5.404927101606295),\n                                    (\"u <named-day><named-month> <day-of-month> (non ordinal)\",\n                                     -5.404927101606295),\n                                    (\"u <named-month>year\", -4.99946199349813),\n                                    (\"last <cycle> of <time>year\", -4.99946199349813),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -5.404927101606295),\n                                    (\"yearminute\", -5.404927101606295)],\n                               n = 164},\n                   koData =\n                     ClassData{prior = -1.0233888674305223, unseen = -5.71042701737487,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"since <time-of-day>by <time>\", -4.3208159036289855),\n                                    (\"year<time-of-day> - <time-of-day> (interval)\",\n                                     -5.01396308418893),\n                                    (\"hourday\", -5.01396308418893), (\"dayhour\", -3.142160907287339),\n                                    (\"daymonth\", -2.9990600636466658),\n                                    (\"monthday\", -3.915350795520821),\n                                    (\"monthyear\", -3.40452517175483),\n                                    (\"yearhour\", -4.608497976080766),\n                                    (\"Wednesdayintersect\", -5.01396308418893),\n                                    (\"hh:mmu <named-day>\", -3.915350795520821),\n                                    (\"intersectat <time-of-day>\", -5.01396308418893),\n                                    (\"Marchyear\", -4.608497976080766),\n                                    (\"u <named-day>September\", -5.01396308418893),\n                                    (\"<named-day> <day-of-month> (ordinal)September\",\n                                     -5.01396308418893),\n                                    (\"Thursdayafter <time-of-day>\", -4.097672352314775),\n                                    (\"until <time-of-day>u <named-day>\", -5.01396308418893),\n                                    (\"since <time-of-day>u <named-day>\", -4.608497976080766),\n                                    (\"Sundayu <named-month>\", -5.01396308418893),\n                                    (\"absorption of , after named dayJuly\", -4.608497976080766),\n                                    (\"JanuaryWednesday\", -5.01396308418893),\n                                    (\"Marchintersect\", -5.01396308418893),\n                                    (\"dayday\", -3.915350795520821),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -5.01396308418893),\n                                    (\"monthmonth\", -4.097672352314775),\n                                    (\"hourhour\", -5.01396308418893),\n                                    (\"<time> <part-of-day>Thursday\", -5.01396308418893),\n                                    (\"dayyear\", -4.3208159036289855),\n                                    (\"Thursday<time> <part-of-day>\", -4.608497976080766),\n                                    (\"<time-of-day> - <time-of-day> (interval)u <named-day>\",\n                                     -5.01396308418893),\n                                    (\"FebruaryWednesday\", -5.01396308418893),\n                                    (\"monthminute\", -5.01396308418893),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month>\",\n                                     -5.01396308418893),\n                                    (\"minutemonth\", -4.608497976080766),\n                                    (\"MarchTuesday\", -4.608497976080766),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (ordinal)\",\n                                     -5.01396308418893),\n                                    (\"intersect<time-of-day> - <time-of-day> (interval)\",\n                                     -5.01396308418893),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.3208159036289855),\n                                    (\"intersect by \\\",\\\"<time-of-day> - <time-of-day> (interval)\",\n                                     -4.097672352314775),\n                                    (\"Aprilyear\", -5.01396308418893),\n                                    (\"Julynumeral to|till|before <integer> (hour-of-day)\",\n                                     -5.01396308418893),\n                                    (\"Thursdaysince <time-of-day>\", -4.097672352314775),\n                                    (\"minutenograin\", -3.40452517175483),\n                                    (\"dayminute\", -3.309214991950505),\n                                    (\"<time> <part-of-day>intersect\", -4.608497976080766),\n                                    (\"Tuesdayu <named-month>\", -5.01396308418893),\n                                    (\"intersectyear\", -4.097672352314775),\n                                    (\"after <time-of-day>by <time>\", -4.3208159036289855),\n                                    (\"intersectSeptember\", -4.608497976080766),\n                                    (\"minuteday\", -2.9990600636466658),\n                                    (\"absorption of , after named dayintersect\", -5.01396308418893),\n                                    (\"<time> <part-of-day>intersect by \\\",\\\"\", -5.01396308418893),\n                                    (\"intersect by \\\",\\\"at <time-of-day>\", -4.097672352314775),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -5.01396308418893),\n                                    (\"yearat <time-of-day>\", -5.01396308418893),\n                                    (\"absorption of , after named daySeptember\",\n                                     -4.608497976080766),\n                                    (\"MarchMarch\", -4.3208159036289855),\n                                    (\"after <time-of-day>u <named-day>\", -4.608497976080766),\n                                    (\"Wednesdayu <named-month>\", -5.01396308418893),\n                                    (\"absorption of , after named dayFebruary\", -5.01396308418893),\n                                    (\"hh:mmby <time>\", -4.3208159036289855),\n                                    (\"u <named-month>year\", -3.915350795520821),\n                                    (\"Tuesdayintersect\", -5.01396308418893),\n                                    (\"JanuaryTuesday\", -5.01396308418893),\n                                    (\"Sundayintersect\", -5.01396308418893),\n                                    (\"Mondayu <named-month>\", -5.01396308418893)],\n                               n = 92}}),\n       (\"early morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)intersect\",\n                                     -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (first..19th)day (grain)October\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)October\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.252762968495368),\n                                    (\"hh:mmhh:mm\", -1.252762968495368)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.5040773967762742),\n                                    (\"minuteminute\", -1.5040773967762742),\n                                    (\"minutehour\", -1.5040773967762742),\n                                    (\"hh:mmintersect\", -1.5040773967762742)],\n                               n = 2}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.7047480922384253),\n                                    (\"month (grain)\", -1.9924301646902063),\n                                    (\"year (grain)\", -2.3978952727983707),\n                                    (\"week (grain)\", -1.7047480922384253),\n                                    (\"quarter\", -2.3978952727983707), (\"year\", -2.3978952727983707),\n                                    (\"month\", -1.9924301646902063),\n                                    (\"quarter (grain)\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.0986122886681098),\n                                    (\"hh:mmhh:mm\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0986122886681098),\n                                    (\"minutehour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2}}),\n       (\"prije <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003), (\"day\", -1.8971199848858813),\n                                    (\"year\", -2.3025850929940455),\n                                    (\"<integer> <unit-of-duration>\", -0.916290731874155),\n                                    (\"month\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.3862943611198906),\n                                    (\"hour\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.8472978603872037),\n                                    (\"ordinals (first..19th)quarter (grain)year\",\n                                     -1.252762968495368),\n                                    (\"ordinal (digits)quarter (grain)year\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numeral to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..19)noon\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7731898882334817),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.7731898882334817)],\n                               n = 5}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -0.6931471805599453), (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a pair\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0296194171811581),\n                                    (\"ordinals (first..19th)TuesdayOctober\", -1.9459101490553135),\n                                    (\"ordinals (first..19th)Wednesdayintersect\",\n                                     -1.540445040947149),\n                                    (\"ordinals (first..19th)Tuesdayintersect\",\n                                     -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0986122886681098),\n                                    (\"ordinals (first..19th)WednesdayOctober\", -1.3862943611198906),\n                                    (\"ordinals (first..19th)TuesdaySeptember\", -1.791759469228055)],\n                               n = 3}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"valentine's day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9444616088408514),\n                                    (\"Sundayu <named-month>\", -2.1972245773362196),\n                                    (\"SundayMarch\", -2.1972245773362196),\n                                    (\"MondayMarch\", -2.1972245773362196),\n                                    (\"Sundayintersect\", -1.791759469228055),\n                                    (\"Mondayu <named-month>\", -2.1972245773362196)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"evening|night\", -1.8718021769015913),\n                                    (\"afternoon\", -1.466337068793427),\n                                    (\"hour\", -0.9555114450274363),\n                                    (\"morning\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.252762968495368),\n                                    (\"late night\", -1.252762968495368)],\n                               n = 1}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -4.652001563489282e-2,\n                               unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)September\", -3.1986731175506815),\n                                    (\"ordinal (digits)August\", -2.793208009442517),\n                                    (\"ordinals (first..19th)March\", -2.2823823856765264),\n                                    (\"ordinal (digits)February\", -1.493925025312256),\n                                    (\"ordinal (digits)April\", -3.1986731175506815),\n                                    (\"month\", -0.8007778447523107),\n                                    (\"ordinal (digits)March\", -2.505525936990736)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -3.0910424533583156,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)April\", -1.5040773967762742),\n                                    (\"month\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"numbers i\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (20..90)integer (0..19)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"new year's eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mother's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Friday\", -1.3862943611198906), (\"day\", -1.3862943611198906),\n                                    (\"March\", -1.3862943611198906), (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.5649493574615367,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.5040773967762742),\n                                    (\"midnight|EOD|end of day\", -1.5040773967762742)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -2.740840023925201),\n                                    (\"time-of-day (latent)\", -1.488077055429833),\n                                    (\"hh:mm\", -2.0476928433652555), (\"noon\", -2.3353749158170367),\n                                    (\"hour\", -1.2367626271489267), (\"minute\", -1.824549292051046)],\n                               n = 12}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year\", -1.252762968495368),\n                                    (\"<integer> <unit-of-duration>\", -0.8472978603872037),\n                                    (\"minute\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913),\n                                    (\"month (grain)\", -2.5649493574615367),\n                                    (\"year (grain)\", -2.5649493574615367),\n                                    (\"week (grain)\", -1.8718021769015913),\n                                    (\"day\", -2.5649493574615367), (\"quarter\", -2.159484249353372),\n                                    (\"year\", -2.5649493574615367), (\"month\", -2.5649493574615367),\n                                    (\"quarter (grain)\", -2.159484249353372),\n                                    (\"day (grain)\", -2.5649493574615367)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.7047480922384253),\n                                    (\"time-of-day (latent)\", -1.0116009116784799),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8109302162163288),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5965203448708736,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.1823215567939546),\n                                    (\"integer (0..19)\", -2.128231705849268)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -0.8001193001121132, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.37729423114146804),\n                                    (\"few\", -2.8622008809294686),\n                                    (\"integer (0..19)\", -1.6094379124341003),\n                                    (\"a pair\", -2.8622008809294686)],\n                               n = 31}}),\n       (\"for <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.11441035117774422,\n                               unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9704144655697013),\n                                    (\"three-quarters of an hour\", -2.7472709142554916),\n                                    (\"number.number hours\", -3.6635616461296463),\n                                    (\"second\", -3.6635616461296463), (\"day\", -2.5649493574615367),\n                                    (\"half an hour\", -2.5649493574615367),\n                                    (\"year\", -3.6635616461296463),\n                                    (\"<integer> <unit-of-duration>\", -1.221214610760442),\n                                    (\"hour\", -2.4107986776342782), (\"month\", -3.6635616461296463),\n                                    (\"minute\", -1.5234954826333758),\n                                    (\"about <duration>\", -3.6635616461296463)],\n                               n = 33},\n                   koData =\n                     ClassData{prior = -2.2246235515243336, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.3862943611198906),\n                                    (\"hour\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -1.7047480922384253, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -4.5217885770490405,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5649493574615367),\n                                    (\"integer (0..19)year (grain)\", -3.1245651453969594),\n                                    (\"integer (numeric)day (grain)\", -2.431417964837014),\n                                    (\"integer (0..19)hour (grain)\", -3.817712325956905),\n                                    (\"second\", -3.817712325956905),\n                                    (\"a pairhour (grain)\", -3.817712325956905),\n                                    (\"integer (numeric)year (grain)\", -3.817712325956905),\n                                    (\"day\", -2.3136349291806306), (\"year\", -2.9014215940827497),\n                                    (\"integer (numeric)week (grain)\", -3.817712325956905),\n                                    (\"integer (0..19)month (grain)\", -3.41224721784874),\n                                    (\"integer (0..19)second (grain)\", -3.817712325956905),\n                                    (\"hour\", -2.5649493574615367), (\"month\", -3.41224721784874),\n                                    (\"integer (numeric)minute (grain)\", -2.7191000372887952),\n                                    (\"integer (0..19)minute (grain)\", -3.817712325956905),\n                                    (\"fewhour (grain)\", -3.817712325956905),\n                                    (\"minute\", -2.5649493574615367),\n                                    (\"integer (numeric)hour (grain)\", -3.1245651453969594),\n                                    (\"integer (0..19)day (grain)\", -3.817712325956905),\n                                    (\"integer (0..19)week (grain)\", -2.7191000372887952)],\n                               n = 33},\n                   koData =\n                     ClassData{prior = -0.4700036292457356, unseen = -4.912654885736052,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.959364629383116),\n                                    (\"integer (0..19)year (grain)\", -3.8066624897703196),\n                                    (\"integer (numeric)day (grain)\", -3.518980417318539),\n                                    (\"fewday (grain)\", -4.212127597878484),\n                                    (\"integer (0..19)hour (grain)\", -2.959364629383116),\n                                    (\"second\", -3.295836866004329),\n                                    (\"numbers ihour (grain)\", -3.8066624897703196),\n                                    (\"integer (numeric)second (grain)\", -3.8066624897703196),\n                                    (\"integer (numeric)year (grain)\", -3.8066624897703196),\n                                    (\"day\", -2.959364629383116), (\"year\", -3.295836866004329),\n                                    (\"integer (numeric)week (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)month (grain)\", -3.8066624897703196),\n                                    (\"integer (0..19)second (grain)\", -3.8066624897703196),\n                                    (\"hour\", -1.5730702682632256), (\"month\", -3.295836866004329),\n                                    (\"integer (numeric)minute (grain)\", -3.8066624897703196),\n                                    (\"integer (0..19)minute (grain)\", -3.8066624897703196),\n                                    (\"integer (numeric)month (grain)\", -3.8066624897703196),\n                                    (\"minute\", -3.295836866004329),\n                                    (\"integer (numeric)hour (grain)\", -1.9095425048844386),\n                                    (\"integer (0..19)day (grain)\", -3.8066624897703196),\n                                    (\"integer (0..19)week (grain)\", -3.8066624897703196)],\n                               n = 55}}),\n       (\"ordinals (first..19th)\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter of an hourtime-of-day (latent)\", -2.0149030205422647),\n                                    (\"minutehour\", -1.6094379124341003),\n                                    (\"minutenograin\", -2.0149030205422647),\n                                    (\"<integer> <unit-of-duration>christmas\", -2.0149030205422647),\n                                    (\"quarter of an hour<time> <part-of-day>\", -2.0149030205422647),\n                                    (\"yearday\", -2.0149030205422647),\n                                    (\"<integer> <unit-of-duration>now\", -2.0149030205422647)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.35667494393873245,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"u <named-day><day-of-month>(ordinal) <named-month>\",\n                                     -4.189654742026425),\n                                    (\"<named-month> <day-of-month> (ordinal)intersect\",\n                                     -4.189654742026425),\n                                    (\"u <named-day><named-month> <day-of-month> (ordinal)\",\n                                     -4.189654742026425),\n                                    (\"intersecthh:mm\", -4.189654742026425),\n                                    (\"intersect by \\\",\\\"year\", -3.784189633918261),\n                                    (\"dayday\", -2.1102132003465894),\n                                    (\"intersect by \\\",\\\"hh:mm\", -3.2733640101522705),\n                                    (\"intersect by \\\",\\\"intersect by \\\",\\\"\", -4.189654742026425),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.189654742026425),\n                                    (\"dayyear\", -2.803360380906535),\n                                    (\"Wednesday<day-of-month>(ordinal) <named-month>\",\n                                     -4.189654742026425),\n                                    (\"<named-month> <day-of-month> (ordinal)intersect by \\\",\\\"\",\n                                     -4.189654742026425),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -4.189654742026425),\n                                    (\"Monday<day-of-month>(ordinal) <named-month>\",\n                                     -3.4965075614664802),\n                                    (\"intersect<day-of-month>(ordinal) <named-month>\",\n                                     -3.784189633918261),\n                                    (\"intersect<named-month> <day-of-month> (ordinal)\",\n                                     -4.189654742026425),\n                                    (\"Fridayintersect\", -4.189654742026425),\n                                    (\"intersect by \\\",\\\"intersect\", -4.189654742026425),\n                                    (\"intersectintersect by \\\",\\\"\", -4.189654742026425),\n                                    (\"dayminute\", -2.1102132003465894),\n                                    (\"intersectyear\", -3.784189633918261),\n                                    (\"minuteday\", -3.2733640101522705),\n                                    (\"Sunday<day-of-month>(ordinal) <named-month>\",\n                                     -3.784189633918261),\n                                    (\"yearhh:mm\", -4.189654742026425),\n                                    (\"Friday<named-month> <day-of-month> (ordinal)\",\n                                     -3.784189633918261),\n                                    (\"intersectintersect\", -4.189654742026425),\n                                    (\"Fridayintersect by \\\",\\\"\", -3.0910424533583156),\n                                    (\"u <named-day><named-month> <day-of-month> (non ordinal)\",\n                                     -4.189654742026425),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.189654742026425),\n                                    (\"<named-month> <day-of-month> (ordinal)year\",\n                                     -3.784189633918261),\n                                    (\"yearminute\", -4.189654742026425),\n                                    (\"Monday<named-month> <day-of-month> (ordinal)\",\n                                     -4.189654742026425)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -1.2039728043259361, unseen = -4.442651256490317,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.7376696182833684),\n                                    (\"<named-month> <day-of-month> (ordinal)intersect\",\n                                     -3.7376696182833684),\n                                    (\"dayhour\", -2.639057329615259),\n                                    (\"daymonth\", -2.639057329615259),\n                                    (\"monthyear\", -3.7376696182833684),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.332204510175204),\n                                    (\"u <named-day>September\", -3.7376696182833684),\n                                    (\"dayday\", -2.639057329615259),\n                                    (\"Saturday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.7376696182833684),\n                                    (\"FridayJuly\", -3.332204510175204),\n                                    (\"minutemonth\", -3.7376696182833684),\n                                    (\"at <time-of-day><day-of-month>(ordinal) <named-month>\",\n                                     -3.7376696182833684),\n                                    (\"Aprilyear\", -3.7376696182833684),\n                                    (\"MondayFebruary\", -3.7376696182833684),\n                                    (\"Saturday<named-month> <day-of-month> (ordinal)\",\n                                     -3.7376696182833684),\n                                    (\"Fridayintersect\", -3.7376696182833684),\n                                    (\"intersect by \\\",\\\"intersect\", -3.7376696182833684),\n                                    (\"SaturdaySeptember\", -3.7376696182833684),\n                                    (\"intersectSeptember\", -3.7376696182833684),\n                                    (\"intersectintersect\", -3.7376696182833684),\n                                    (\"Friday<day-of-month>(ordinal) <named-month>\",\n                                     -3.7376696182833684),\n                                    (\"Fridayintersect by \\\",\\\"\", -3.7376696182833684)],\n                               n = 18}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -2.6668247082161294e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -3.6375861597263857,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"u <named-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.845826690498331),\n                                    (\"absorption of , after named day\", -2.538973871058276),\n                                    (\"Wednesday\", -2.538973871058276),\n                                    (\"Saturday\", -2.2512917986064953),\n                                    (\"Monday\", -2.9444389791664407),\n                                    (\"Friday\", -2.9444389791664407), (\"day\", -0.8649974374866046),\n                                    (\"Sunday\", -2.9444389791664407)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-day> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of , after named dayordinal (digits)\",\n                                     -1.0116009116784799),\n                                    (\"day\", -0.7884573603642702),\n                                    (\"Tuesdayordinal (digits)\", -2.3978952727983707),\n                                    (\"u <named-day>ordinal (digits)\", -2.3978952727983707)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"absorption of , after named dayordinal (digits)\",\n                                     -1.0986122886681098),\n                                    (\"day\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"evening|night\", -1.9459101490553135),\n                                    (\"day\", -1.540445040947149), (\"Sunday\", -1.9459101490553135),\n                                    (\"hour\", -1.540445040947149), (\"Tuesday\", -1.9459101490553135),\n                                    (\"week-end\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = -0.4795730802618862, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.9650808960435872,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"since <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.772588722239781, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm\", -1.7047480922384253),\n                                    (\"minute\", -1.7047480922384253)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.9704144655697013),\n                                    (\"intersect\", -1.8718021769015913),\n                                    (\"numeral to|till|before <integer> (hour-of-day)\",\n                                     -2.9704144655697013),\n                                    (\"now\", -2.9704144655697013), (\"hh:mm\", -2.277267285009756),\n                                    (\"nograin\", -2.0541237336955462),\n                                    (\"<datetime> - <datetime> (interval)\", -2.5649493574615367),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.5649493574615367),\n                                    (\"minute\", -1.1786549963416462)],\n                               n = 15}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.2039728043259361, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> o'clock\", -1.8718021769015913),\n                                    (\"time-of-day (latent)\", -1.466337068793427),\n                                    (\"hour\", -1.1786549963416462)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.35667494393873245,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -2.3513752571634776),\n                                    (\"hh:mm\", -1.6582280766035324), (\"noon\", -1.9459101490553135),\n                                    (\"hour\", -1.4350845252893227),\n                                    (\"midnight|EOD|end of day\", -2.3513752571634776),\n                                    (\"minute\", -1.6582280766035324)],\n                               n = 7}}),\n       (\"<integer> and an half hours\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (0..19)\", 0.0)],\n                               n = 1}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"late night\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.3513752571634776),\n                                    (\"Monday\", -2.3513752571634776),\n                                    (\"Friday\", -2.3513752571634776), (\"day\", -1.0986122886681098),\n                                    (\"March\", -2.3513752571634776), (\"month\", -2.3513752571634776),\n                                    (\"Tuesday\", -1.6582280766035324)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -2.3025850929940455),\n                                    (\"year (grain)\", -1.8971199848858813),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.8971199848858813), (\"month\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"new year's day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6026896854443837),\n                                    (\"integer (0..19)year (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)day (grain)\", -3.295836866004329),\n                                    (\"fewday (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)hour (grain)\", -3.295836866004329),\n                                    (\"second\", -2.890371757896165),\n                                    (\"integer (numeric)second (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)year (grain)\", -3.295836866004329),\n                                    (\"day\", -2.6026896854443837), (\"year\", -2.890371757896165),\n                                    (\"integer (numeric)week (grain)\", -2.890371757896165),\n                                    (\"integer (0..19)month (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)second (grain)\", -3.295836866004329),\n                                    (\"hour\", -2.890371757896165), (\"month\", -2.890371757896165),\n                                    (\"integer (numeric)minute (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)minute (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)month (grain)\", -3.295836866004329),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)hour (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)day (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)week (grain)\", -3.295836866004329)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"halloween day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"today\", -1.8718021769015913),\n                                    (\"next <cycle>\", -1.8718021769015913),\n                                    (\"day\", -1.466337068793427),\n                                    (\"this <cycle>\", -1.466337068793427),\n                                    (\"month\", -1.466337068793427)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.343805421853684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407),\n                                    (\"three-quarters of an hour\", -2.7212954278522306),\n                                    (\"number.number hours\", -3.6375861597263857),\n                                    (\"second\", -3.6375861597263857), (\"day\", -2.538973871058276),\n                                    (\"half an hour\", -2.538973871058276),\n                                    (\"year\", -3.6375861597263857),\n                                    (\"<integer> <unit-of-duration>\", -1.2396908869280152),\n                                    (\"hour\", -2.384823191231018), (\"month\", -3.6375861597263857),\n                                    (\"minute\", -1.55814461804655),\n                                    (\"about <duration>\", -3.6375861597263857)],\n                               n = 32},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"since <time-of-day>hh:mm\", -2.639057329615259),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.7227665977411035),\n                                    (\"dayday\", -2.2335922215070942),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -2.2335922215070942),\n                                    (\"after <time-of-day>hh:mm\", -2.639057329615259)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -2.4849066497880004),\n                                    (\"daymonth\", -2.0794415416798357),\n                                    (\"minuteminute\", -1.5686159179138452),\n                                    (\"after <time-of-day>intersect\", -2.4849066497880004),\n                                    (\"hh:mmintersect\", -2.0794415416798357),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -2.4849066497880004),\n                                    (\"since <time-of-day>intersect\", -2.4849066497880004)],\n                               n = 6}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8266785731844679, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"since <time-of-day>hh:mm\", -2.5257286443082556),\n                                    (\"hh:mmtime-of-day (latent)\", -2.5257286443082556),\n                                    (\"minuteminute\", -1.2729656758128873),\n                                    (\"hh:mmhh:mm\", -1.6094379124341003),\n                                    (\"minutehour\", -2.5257286443082556),\n                                    (\"after <time-of-day>hh:mm\", -2.5257286443082556)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5753641449035618,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"since <time-of-day>time-of-day (latent)\",\n                                     -2.6741486494265287),\n                                    (\"hh:mmtime-of-day (latent)\", -1.9810014688665833),\n                                    (\"hourhour\", -2.6741486494265287),\n                                    (\"minutehour\", -1.1700712526502546),\n                                    (\"numeral to|till|before <integer> (hour-of-day)time-of-day (latent)\",\n                                     -1.9810014688665833),\n                                    (\"at <time-of-day>time-of-day (latent)\", -2.6741486494265287),\n                                    (\"after <time-of-day>time-of-day (latent)\",\n                                     -2.6741486494265287)],\n                               n = 9}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter after|past (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.110873864173311,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.70805020110221),\n                                    (\"integer (0..19)year (grain)\", -3.4011973816621555),\n                                    (\"integer (numeric)day (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)hour (grain)\", -3.4011973816621555),\n                                    (\"second\", -2.995732273553991),\n                                    (\"numbers ihour (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)second (grain)\", -3.4011973816621555),\n                                    (\"integer (numeric)year (grain)\", -3.4011973816621555),\n                                    (\"day\", -2.70805020110221), (\"year\", -2.995732273553991),\n                                    (\"integer (numeric)week (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)month (grain)\", -3.4011973816621555),\n                                    (\"integer (0..19)second (grain)\", -3.4011973816621555),\n                                    (\"hour\", -2.3025850929940455), (\"month\", -2.995732273553991),\n                                    (\"integer (numeric)minute (grain)\", -3.4011973816621555),\n                                    (\"integer (0..19)minute (grain)\", -3.4011973816621555),\n                                    (\"integer (numeric)month (grain)\", -3.4011973816621555),\n                                    (\"minute\", -2.995732273553991),\n                                    (\"integer (numeric)hour (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)day (grain)\", -3.4011973816621555),\n                                    (\"integer (0..19)week (grain)\", -3.4011973816621555)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)Tuesdayintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)Tuesdaychristmas\", -0.916290731874155),\n                                    (\"dayday\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6061358035703156,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.791759469228055),\n                                    (\"month\", -0.9444616088408514),\n                                    (\"Februaryinteger (numeric)\", -2.1972245773362196),\n                                    (\"Septemberinteger (numeric)\", -2.1972245773362196),\n                                    (\"Julyinteger (numeric)\", -1.791759469228055)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.7884573603642702, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -2.0794415416798357),\n                                    (\"month\", -0.9808292530117262),\n                                    (\"Julyinteger (numeric)\", -1.1631508098056809)],\n                               n = 5}}),\n       (\"numeral after|past (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"integer (20..90)time-of-day (latent)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)April\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.03688192726104), (\"Monday\", -2.03688192726104),\n                                    (\"Friday\", -2.4423470353692043), (\"day\", -0.832909122935104),\n                                    (\"Tuesday\", -1.5260563034950494)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -3.7740327982847086e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -3.295836866004329, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9459101490553135),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"week (grain)September\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)March\", -1.6094379124341003),\n                                    (\"ordinal (digits)April\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)March\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half <integer> (HR style hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.890371757896165, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm\", -1.9459101490553135),\n                                    (\"minute\", -1.9459101490553135)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -3.1354942159291497),\n                                    (\"<time-of-day> o'clock\", -3.1354942159291497),\n                                    (\"intersect\", -2.03688192726104),\n                                    (\"numeral to|till|before <integer> (hour-of-day)\",\n                                     -3.1354942159291497),\n                                    (\"now\", -3.1354942159291497),\n                                    (\"time-of-day (latent)\", -3.1354942159291497),\n                                    (\"hh:mm\", -2.4423470353692043),\n                                    (\"nograin\", -2.2192034840549946), (\"hour\", -2.7300291078209855),\n                                    (\"<datetime> - <datetime> (interval)\", -2.7300291078209855),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -2.7300291078209855),\n                                    (\"minute\", -1.3437347467010947)],\n                               n = 17}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd.mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"July\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half an hour\", -1.6094379124341003),\n                                    (\"quarter of an hour\", -1.0986122886681098),\n                                    (\"minute\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter of an hour\", -0.7884573603642702),\n                                    (\"minute\", -0.7884573603642702)],\n                               n = 4}}),\n       (\"u <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7884573603642702, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.540445040947149), (\"March\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6061358035703156, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -1.6739764335716716),\n                                    (\"October\", -1.1631508098056809),\n                                    (\"month\", -0.8266785731844679)],\n                               n = 6}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.5257286443082556),\n                                    (\"evening|night\", -2.5257286443082556),\n                                    (\"Monday\", -2.5257286443082556), (\"day\", -1.4271163556401458),\n                                    (\"hour\", -1.8325814637483102), (\"winter\", -2.5257286443082556),\n                                    (\"week-end\", -2.120263536200091),\n                                    (\"summer\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.7047480922384253), (\"Tuesday\", -1.7047480922384253)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julyordinal (digits)\", -1.3862943611198906),\n                                    (\"Septemberordinal (digits)\", -1.791759469228055),\n                                    (\"Februaryordinal (digits)\", -1.791759469228055),\n                                    (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1934}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.HU_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6817184847363225, unseen = -3.828641396489095,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 44},\n                   koData =\n                     ClassData{prior = -0.7047080029610213,\n                               unseen = -3.8066624897703196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 43}}),\n       (\"pm <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.9382696385929302),\n                                    (\"todaypart of days\", -1.1895840668738362),\n                                    (\"tomorrowpart of days\", -2.4423470353692043),\n                                    (\"yesterdaypart of days\", -2.4423470353692043)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.0986122886681098),\n                                    (\"next <day-of-week>part of days\", -2.0149030205422647),\n                                    (\"yyyy.mm.ddpart of days\", -2.0149030205422647),\n                                    (\"Wednesdaypart of days\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"November\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.3629054936893685,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.0116009116784799),\n                                    (\"yyyy.mm.ddhh:mm\", -3.0910424533583156),\n                                    (\"Wednesdaypm <time-of-day>\", -2.3978952727983707),\n                                    (\"todaypart of days\", -1.8382794848629478),\n                                    (\"yyyy.mm.ddpm <time-of-day>\", -3.0910424533583156),\n                                    (\"dayminute\", -3.0910424533583156),\n                                    (\"tomorrowpart of days\", -3.0910424533583156),\n                                    (\"next <day-of-week>pm <time-of-day>\", -2.3978952727983707),\n                                    (\"yesterdaypart of days\", -3.0910424533583156)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -1.1895840668738362, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1786549963416462),\n                                    (\"next <day-of-week>part of days\", -2.5649493574615367),\n                                    (\"Wednesdaypm <time-of-day>\", -1.8718021769015913),\n                                    (\"yyyy.mm.ddpart of days\", -2.5649493574615367),\n                                    (\"Wednesdaypart of days\", -2.159484249353372)],\n                               n = 7}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"am <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|last|next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (grain)\", -1.3862943611198906),\n                                    (\"year (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906), (\"month\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.7047480922384253),\n                                    (\"Wednesday\", -1.0116009116784799),\n                                    (\"day\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"June\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 39},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy.mm.dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.74493212836325,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (numeric)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 56},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"seasons\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm.dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"end of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = -0.17589066646366416,\n                               unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -1.824549292051046, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"<named-month> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -0.6931471805599453),\n                                    (\"Marchordinal (digits)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 415}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ID_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.IS_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.IT_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time-of-day> - <time-of-day> <day-of-month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)<integer> (latent time-of-day)Giovedi\",\n                                     -1.6094379124341003),\n                                    (\"hh(:|h)mm (time-of-day)hh(:|h)mm (time-of-day)Giovedi\",\n                                     -1.6094379124341003),\n                                    (\"hourhourday\", -1.6094379124341003),\n                                    (\"minuteminuteday\", -1.6094379124341003)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)<integer> (latent time-of-day)Luglio\",\n                                     -1.3862943611198906),\n                                    (\"hourhourmonth\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"semaine (grain)\", -1.3862943611198906),\n                                    (\"mois (grain)\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.1631508098056809),\n                                    (\"hh(:|h)mm (time-of-day)\", -1.6739764335716716),\n                                    (\"hour\", -1.6739764335716716), (\"minute\", -1.1631508098056809)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5084130773606067, unseen = -5.123963979403259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 166},\n                   koData =\n                     ClassData{prior = -0.9199204999247338, unseen = -4.718498871295094,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 110}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Giornata Internazionale delle cooperative\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Venerdi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5978370007556204, unseen = -4.820281565605037,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -4.119037174812472),\n                                    (\"<time> timezone\", -3.713572066704308),\n                                    (\"<integer 0 12> del <part of day>\", -2.7327428136925813),\n                                    (\"<integer> (latent time-of-day)\", -1.5540878173509354),\n                                    (\"hh(:|h)mm (time-of-day)\", -2.1041341542702074),\n                                    (\"<hour-of-day> and <relative minutes>\", -4.119037174812472),\n                                    (\"noon\", -3.713572066704308),\n                                    (\"hh <relative-minutes> del pomeriggio(time-of-day)\",\n                                     -3.713572066704308),\n                                    (\"<hour-of-day> minus quart\", -4.119037174812472),\n                                    (\"hour\", -1.2286654169163076), (\"minute\", -1.7676619176489945)],\n                               n = 55},\n                   koData =\n                     ClassData{prior = -0.7985076962177716,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"una\", -3.9415818076696905),\n                                    (\"<integer> (latent time-of-day)\", -1.0512100497735257),\n                                    (\"hh(:|h)mm (time-of-day)\", -2.842969519001581),\n                                    (\"<hour-of-day> and <relative minutes>\", -3.536116699561526),\n                                    (\"<hour-of-day> minus <integer> (as relative minutes)\",\n                                     -3.9415818076696905),\n                                    (\"noon\", -3.9415818076696905), (\"hour\", -0.99714282850325),\n                                    (\"minute\", -2.4375044108934163)],\n                               n = 45}}),\n       (\"ann\\233e (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dopo le <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -2.0149030205422647),\n                                    (\"<integer> (latent time-of-day)\", -1.0986122886681098),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.2876820724517809, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -2.8622008809294686),\n                                    (\"<integer> (latent time-of-day)\", -1.0704414117014134),\n                                    (\"hh(:|h)mm (time-of-day)\", -2.169053700369523),\n                                    (\"hour\", -0.9903987040278769), (\"minute\", -2.169053700369523)],\n                               n = 15}}),\n       (\"Giovedi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"seconde (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"stanotte\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"Martedi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dal <integer> al <integer> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (0..19)number (0..19)\", -0.6931471805599453),\n                                    (\"integer (numeric)integer (numeric)\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer 0 12> del <part of day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2876820724517809),\n                                    (\"number (0..19)\", -1.3862943611198906)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"una\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"semaine (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 34},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"il <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"mois (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primo..10)trimestre (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primo..10)trimestre (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 3}}),\n       (\"in|entro <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.252762968495368),\n                                    (\"<integer> <unit-of-duration>\", -0.8472978603872037),\n                                    (\"minute\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2039728043259361),\n                                    (\"semaine (grain)\", -1.2039728043259361),\n                                    (\"mois (grain)\", -1.6094379124341003),\n                                    (\"month\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"epifania\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time> \",\n        Classifier{okData =\n                     ClassData{prior = -2.8622008809294686,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.791759469228055), (\"hour\", -1.791759469228055),\n                                    (\"week-end\", -1.791759469228055),\n                                    (\"Domenica\", -1.791759469228055)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -5.8840500022933465e-2,\n                               unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.9718605830289657),\n                                    (\"intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"\", -3.20545280453606),\n                                    (\"day\", -2.3581549441488563), (\"Lunedi\", -3.6109179126442243),\n                                    (\"hour\", -0.9718605830289657),\n                                    (\"two time tokens separated by `di`\", -3.20545280453606),\n                                    (\"Domenica\", -3.6109179126442243)],\n                               n = 33}}),\n       (\"Ottobre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primo..10)jour (grain)Ottobre\",\n                                     -1.7047480922384253),\n                                    (\"daymonth\", -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (primo..10)semaine (grain)two time tokens in a row\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (primo..10)semaine (grain)Ottobre\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"season\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> last\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martedi\", -1.252762968495368), (\"day\", -1.252762968495368)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.6094379124341003),\n                                    (\"<integer> (latent time-of-day)\", -1.3217558399823195),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 5}}),\n       (\"the <ordinal> <cycle> <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinals (primo..10)trimestre (grain)year (1000-2100 not latent)\",\n                                     -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"verso <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"weekday\", -0.9808292530117262),\n                                    (\"semaine (grain)<day-of-month> <named-month>\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"semaine (grain)<integer> (latent time-of-day)\",\n                                     -0.9808292530117262),\n                                    (\"weekhour\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"Giornata Mondiale della Prematurit\\224\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in the <part-of-day> of <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -0.9808292530117262),\n                                    (\"eveningtomorrow\", -1.3862943611198906),\n                                    (\"morningLunedi\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -0.9808292530117262),\n                                    (\"nighttomorrow\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinals (primo..10)trimestre (grain)year (1000-2100 not latent)\",\n                                     -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"festa della repubblica\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in/after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4849066497880004),\n                                    (\"un quarto d'ora\", -2.4849066497880004),\n                                    (\"<integer> <unit-of-duration>\", -1.5686159179138452),\n                                    (\"une <unit-of-duration>\", -2.4849066497880004),\n                                    (\"hour\", -2.0794415416798357),\n                                    (\"mezz'ora\", -2.4849066497880004),\n                                    (\"minute\", -1.3862943611198906),\n                                    (\"tre quarti d'ora\", -2.4849066497880004)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"i|le n <cycle> passati|passate\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.219507705176107,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)heure (grain)\",\n                                     -3.5115454388310208),\n                                    (\"number (0..19)heure (grain)\", -3.5115454388310208),\n                                    (\"number (0..19)jour (grain)\", -2.8183982582710754),\n                                    (\"second\", -3.1060803307228566),\n                                    (\"integer (numeric)ann\\233e (grain)\", -3.1060803307228566),\n                                    (\"integer (numeric)seconde (grain)\", -3.5115454388310208),\n                                    (\"integer (numeric)jour (grain)\", -3.1060803307228566),\n                                    (\"day\", -2.412933150162911), (\"year\", -2.5952547069568657),\n                                    (\"number (0..19)seconde (grain)\", -3.5115454388310208),\n                                    (\"number (0..19)ann\\233e (grain)\", -3.1060803307228566),\n                                    (\"hour\", -2.2587824703356527),\n                                    (\"number (0..19)mois (grain)\", -3.1060803307228566),\n                                    (\"month\", -2.412933150162911),\n                                    (\"integer (numeric)minute (grain)\", -3.5115454388310208),\n                                    (\"integer (numeric)mois (grain)\", -2.8183982582710754),\n                                    (\"minute\", -3.1060803307228566),\n                                    (\"number (0..19)minute (grain)\", -3.5115454388310208),\n                                    (\"integer (numeric)heure (grain)\", -2.5952547069568657)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"un quarto d'ora\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Aprile\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"santo stefano\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"entro il <integer>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"stasera\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<integer> (latent time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0198314108149953, unseen = -3.871201010907891,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.294799540220645),\n                                    (\"number (0..19)\", -1.452252328911688)],\n                               n = 44},\n                   koData =\n                     ClassData{prior = -0.4473122180436648, unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3513978868378886),\n                                    (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n                                     -3.295836866004329),\n                                    (\"number (0..19)\", -1.349926716949016)],\n                               n = 78}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9808292530117262),\n                                    (\"ordinals (primo..10)Mercoleditwo time tokens in a row\",\n                                     -1.6739764335716716),\n                                    (\"ordinals (primo..10)Marteditwo time tokens in a row\",\n                                     -2.0794415416798357),\n                                    (\"ordinals (primo..10)MartediOttobre\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0986122886681098),\n                                    (\"ordinals (primo..10)MartediSettembre\", -1.791759469228055),\n                                    (\"ordinals (primo..10)MercolediOttobre\", -1.3862943611198906)],\n                               n = 3}}),\n       (\"Settembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a quart to <integer> (as hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -0.6931471805599453), (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> notte\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"new year's eve\", -1.8718021769015913),\n                                    (\"tomorrow\", -0.9555114450274363),\n                                    (\"day\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Febbraio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444, unseen = -4.61512051684126,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh(:|h)mm (time-of-day)Sabato\", -3.912023005428146),\n                                    (\"hourday\", -2.659260036932778),\n                                    (\"daymonth\", -2.5257286443082556),\n                                    (\"MartediOttobre\", -3.912023005428146),\n                                    (\"Mercoleditwo time tokens in a row\", -3.912023005428146),\n                                    (\"hh(:|h)mm (time-of-day)<day-of-month> <named-month>\",\n                                     -3.912023005428146),\n                                    (\"Giornata Internazionale delle cooperativeyear (1000-2100 not latent)\",\n                                     -3.912023005428146),\n                                    (\"two time tokens in a rowtwo time tokens in a row\",\n                                     -3.912023005428146),\n                                    (\"two time tokens in a rowOttobre\", -3.506557897319982),\n                                    (\"<integer 0 12> del <part of day>tomorrow\",\n                                     -3.912023005428146),\n                                    (\"dayyear\", -3.912023005428146),\n                                    (\"hh(:|h)mm (time-of-day)two time tokens in a row\",\n                                     -2.995732273553991),\n                                    (\"Lunedithis <cycle>\", -3.912023005428146),\n                                    (\"Martedithis <cycle>\", -3.912023005428146),\n                                    (\"hh(:|h)mm (time-of-day)<named-day> <day-of-month>\",\n                                     -3.506557897319982),\n                                    (\"day of month (1st)Marzo\", -3.912023005428146),\n                                    (\"MercolediOttobre\", -3.912023005428146),\n                                    (\"at <time-of-day>two time tokens in a row\",\n                                     -3.506557897319982),\n                                    (\"minuteday\", -1.8325814637483102),\n                                    (\"dalle <time-of-day> alle <time-of-day> (interval)Giovedi\",\n                                     -3.2188758248682006),\n                                    (\"at <time-of-day>Sabato\", -3.912023005428146),\n                                    (\"at <time-of-day><named-day> <day-of-month>\",\n                                     -3.912023005428146),\n                                    (\"dayweek\", -3.2188758248682006),\n                                    (\"at <time-of-day>Venerdi\", -3.912023005428146),\n                                    (\"tra il <datetime> e il <datetime> (interval)Giovedi\",\n                                     -3.506557897319982),\n                                    (\"<dim time> al <part-of-day>tomorrow\", -3.912023005428146),\n                                    (\"Mercoledithis <cycle>\", -3.912023005428146),\n                                    (\"hh(:|h)mm (time-of-day)Venerdi\", -3.912023005428146)],\n                               n = 32},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -4.23410650459726,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.4277482359480516),\n                                    (\"daymonth\", -2.1400661634962708),\n                                    (\"Mercoleditwo time tokens in a row\", -3.5263605246161616),\n                                    (\"stanottetomorrow\", -3.120895416507997),\n                                    (\"MartediSettembre\", -3.5263605246161616),\n                                    (\"LunediMarzo\", -3.5263605246161616),\n                                    (\"MercolediOttobre\", -3.5263605246161616),\n                                    (\"Marteditwo time tokens in a row\", -3.5263605246161616),\n                                    (\"minuteday\", -2.6100697927420065),\n                                    (\"DomenicaMarzo\", -3.5263605246161616),\n                                    (\"at <time-of-day>Giovedi\", -2.4277482359480516),\n                                    (\"Domenicatwo time tokens in a row\", -3.5263605246161616),\n                                    (\"hh(:|h)mm (time-of-day)Giovedi\", -3.120895416507997)],\n                               n = 16}}),\n       (\"<hour-of-day> and a quart\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"commemorazione dei defunti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"valentine's day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13062018241706422,\n                               unseen = -3.8066624897703196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 43},\n                   koData =\n                     ClassData{prior = -2.1000608288825715,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"EOY|End of year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4595323293784402, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -2.639057329615259),\n                                    (\"hour\", -0.7672551527136672), (\"evening\", -1.1349799328389845),\n                                    (\"morning\", -1.9459101490553135)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.9985288301111273,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.8109302162163288), (\"evening\", -1.791759469228055),\n                                    (\"morning\", -1.0986122886681098)],\n                               n = 7}}),\n       (\"circa per le <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer 0 12> del <part of day>\", -1.5040773967762742),\n                                    (\"<integer> (latent time-of-day)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"christmas eve\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"festa del lavoro\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Agosto\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"il week-end del <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"<day-of-month> <named-month>\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2231435513142097),\n                                    (\"number (0..19)\", -1.6094379124341003)],\n                               n = 13}}),\n       (\"entro le <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"il <day-of-month>\", -2.639057329615259),\n                                    (\"<integer> (latent time-of-day)\", -2.2335922215070942),\n                                    (\"hh(:|h)mm (time-of-day)\", -2.639057329615259),\n                                    (\"EOY|End of year\", -2.639057329615259),\n                                    (\"day\", -2.639057329615259), (\"year\", -2.639057329615259),\n                                    (\"EOM|End of month\", -2.639057329615259),\n                                    (\"noon\", -2.639057329615259), (\"hour\", -1.9459101490553135),\n                                    (\"month\", -2.2335922215070942), (\"Marzo\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -1.9459101490553135),\n                                    (\"hour\", -1.9459101490553135)],\n                               n = 1}}),\n       (\"new year's eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Mother's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"domattina\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (primo..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0185695809945732, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.4480247225269604,\n                               unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 23}}),\n       (\"the <ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primo..10)jour (grain)Ottobre\",\n                                     -0.6931471805599453),\n                                    (\"daymonth\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"gli <n> ultimi <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8109302162163288),\n                                    (\"number (0..19)semaine (grain)\", -1.5040773967762742),\n                                    (\"integer (numeric)semaine (grain)\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"Giornata Mondiale contro la discriminazione\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"tra il <integer> e il <integer> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)integer (numeric)\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Luglio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2809338454620642),\n                                    (\"ann\\233e (grain)\", -2.1972245773362196),\n                                    (\"semaine (grain)\", -1.2809338454620642),\n                                    (\"quarter\", -2.1972245773362196), (\"year\", -2.1972245773362196),\n                                    (\"trimestre (grain)\", -2.1972245773362196)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"semaine (grain)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"il <cycle> dopo <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.5040773967762742),\n                                    (\"dayday\", -1.5040773967762742),\n                                    (\"mois (grain)two time tokens in a row\", -1.5040773967762742),\n                                    (\"jour (grain)tomorrow\", -1.5040773967762742)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.252762968495368),\n                                    (\"mois (grain)christmas\", -1.252762968495368)],\n                               n = 1}}),\n       (\"night\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"tra il <datetime> e il <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6094379124341003),\n                                    (\"at <time-of-day>at <time-of-day>\", -0.916290731874155),\n                                    (\"hourhour\", -1.6094379124341003),\n                                    (\"minutehour\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)<integer> (latent time-of-day)\",\n                                     -1.1786549963416462),\n                                    (\"at <time-of-day>at <time-of-day>\", -1.8718021769015913),\n                                    (\"hourhour\", -1.1786549963416462),\n                                    (\"minutehour\", -1.8718021769015913)],\n                               n = 4}}),\n       (\"gli ultimi <n> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.343805421853684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.2321210516182215),\n                                    (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)heure (grain)\",\n                                     -3.6375861597263857),\n                                    (\"number (0..19)heure (grain)\", -2.9444389791664407),\n                                    (\"number (0..19)jour (grain)\", -3.2321210516182215),\n                                    (\"second\", -3.2321210516182215),\n                                    (\"integer (numeric)ann\\233e (grain)\", -2.9444389791664407),\n                                    (\"integer (numeric)seconde (grain)\", -3.6375861597263857),\n                                    (\"integer (numeric)jour (grain)\", -3.2321210516182215),\n                                    (\"day\", -2.7212954278522306), (\"year\", -2.538973871058276),\n                                    (\"number (0..19)seconde (grain)\", -3.6375861597263857),\n                                    (\"number (0..19)ann\\233e (grain)\", -3.2321210516182215),\n                                    (\"number (0..19)semaine (grain)\", -3.6375861597263857),\n                                    (\"hour\", -2.2512917986064953),\n                                    (\"number (0..19)mois (grain)\", -2.9444389791664407),\n                                    (\"month\", -2.538973871058276),\n                                    (\"integer (numeric)minute (grain)\", -3.6375861597263857),\n                                    (\"integer (numeric)mois (grain)\", -3.2321210516182215),\n                                    (\"minute\", -3.2321210516182215),\n                                    (\"number (0..19)minute (grain)\", -3.6375861597263857),\n                                    (\"integer (numeric)semaine (grain)\", -3.6375861597263857),\n                                    (\"integer (numeric)heure (grain)\", -2.9444389791664407)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"le idi di <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -0.6931471805599453), (\"Marzo\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primo..10)trimestre (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (primo..10)trimestre (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"<dim time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5389965007326869, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1786549963416462),\n                                    (\"<day-of-month> <named-month>morning\", -2.5649493574615367),\n                                    (\"tomorrowevening\", -2.5649493574615367),\n                                    (\"Lunedimorning\", -2.159484249353372),\n                                    (\"tomorrowmorning\", -2.5649493574615367),\n                                    (\"tomorrowlunch\", -2.5649493574615367),\n                                    (\"yesterdayevening\", -2.5649493574615367)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.9924301646902063),\n                                    (\"tomorrownight\", -2.3978952727983707),\n                                    (\"monthhour\", -1.7047480922384253),\n                                    (\"Febbraiothis <part-of-day>\", -1.9924301646902063),\n                                    (\"tomorrowstanotte\", -2.3978952727983707),\n                                    (\"Febbraiomorning\", -2.3978952727983707)],\n                               n = 5}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>number (20..90)\", -1.8718021769015913),\n                                    (\"<integer> (latent time-of-day)integer (numeric)\",\n                                     -1.466337068793427),\n                                    (\"<integer> (latent time-of-day)number (20..90)\",\n                                     -1.8718021769015913),\n                                    (\"hour\", -0.9555114450274363)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>number (20..90)\", -1.845826690498331),\n                                    (\"<integer> (latent time-of-day)integer (numeric)\",\n                                     -2.2512917986064953),\n                                    (\"<integer> (latent time-of-day)number (20..90)\",\n                                     -1.845826690498331),\n                                    (\"hour\", -0.8649974374866046),\n                                    (\"<integer> (latent time-of-day)number (0..19)\",\n                                     -1.845826690498331)],\n                               n = 7}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"LunediMarzo\", -1.6094379124341003),\n                                    (\"DomenicaMarzo\", -1.6094379124341003),\n                                    (\"Domenicatwo time tokens in a row\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-day> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Domenicainteger (numeric)\", -2.772588722239781),\n                                    (\"Lunediinteger (numeric)\", -2.367123614131617),\n                                    (\"Mercolediinteger (numeric)\", -2.772588722239781),\n                                    (\"Sabatointeger (numeric)\", -2.772588722239781),\n                                    (\"day\", -0.9007865453381898),\n                                    (\"Venerdiinteger (numeric)\", -1.8562979903656263),\n                                    (\"Giovediinteger (numeric)\", -2.772588722239781),\n                                    (\"Martediinteger (numeric)\", -2.367123614131617)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2192034840549946),\n                                    (\"integer (numeric)ann\\233e (grain)\", -3.1354942159291497),\n                                    (\"integer (numeric)jour (grain)\", -3.1354942159291497),\n                                    (\"day\", -3.1354942159291497), (\"year\", -2.7300291078209855),\n                                    (\"number (0..19)ann\\233e (grain)\", -3.1354942159291497),\n                                    (\"number (0..19)semaine (grain)\", -2.7300291078209855),\n                                    (\"hour\", -3.1354942159291497),\n                                    (\"number (0..19)mois (grain)\", -3.1354942159291497),\n                                    (\"month\", -2.7300291078209855),\n                                    (\"integer (numeric)minute (grain)\", -2.7300291078209855),\n                                    (\"integer (numeric)mois (grain)\", -3.1354942159291497),\n                                    (\"minute\", -2.7300291078209855),\n                                    (\"integer (numeric)semaine (grain)\", -2.7300291078209855),\n                                    (\"integer (numeric)heure (grain)\", -3.1354942159291497)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -5.117993812416755,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.3202283191284883),\n                                    (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)heure (grain)\",\n                                     -4.013375499688434),\n                                    (\"number (0..19)heure (grain)\", -3.3202283191284883),\n                                    (\"number (0..19)jour (grain)\", -3.16607763930123),\n                                    (\"second\", -3.0325462466767075),\n                                    (\"integer (numeric)ann\\233e (grain)\", -3.16607763930123),\n                                    (\"integer (numeric)seconde (grain)\", -3.7256934272366524),\n                                    (\"integer (numeric)jour (grain)\", -3.16607763930123),\n                                    (\"day\", -2.5470384308950065), (\"year\", -2.627081138568543),\n                                    (\"number (0..19)seconde (grain)\", -3.5025498759224427),\n                                    (\"number (0..19)ann\\233e (grain)\", -3.3202283191284883),\n                                    (\"number (0..19)semaine (grain)\", -4.013375499688434),\n                                    (\"hour\", -2.278774444300327),\n                                    (\"number (0..19)mois (grain)\", -3.0325462466767075),\n                                    (\"month\", -2.403937587254333),\n                                    (\"integer (numeric)minute (grain)\", -3.5025498759224427),\n                                    (\"integer (numeric)mois (grain)\", -3.0325462466767075),\n                                    (\"minute\", -3.0325462466767075),\n                                    (\"number (0..19)minute (grain)\", -3.7256934272366524),\n                                    (\"integer (numeric)semaine (grain)\", -3.7256934272366524),\n                                    (\"integer (numeric)heure (grain)\", -2.8094026953624978)],\n                               n = 72}}),\n       (\"immacolata concezione\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lunedi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> al <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.413693335308005),\n                                    (\"<integer> (latent time-of-day)afternoon\", -2.917770732084279),\n                                    (\"hh(:|h)mm (time-of-day)afternoon\", -2.917770732084279),\n                                    (\"<day-of-month> <named-month>morning\", -2.512305623976115),\n                                    (\"il <day-of-month> <named-month>morning\", -2.917770732084279),\n                                    (\"hourhour\", -2.917770732084279),\n                                    (\"two time tokens in a rowmorning\", -2.917770732084279),\n                                    (\"minutehour\", -2.512305623976115),\n                                    (\"tomorrowevening\", -2.917770732084279),\n                                    (\"Lunedimorning\", -2.512305623976115),\n                                    (\"il <time>morning\", -2.917770732084279),\n                                    (\"hh(:|h)mm (time-of-day)morning\", -2.917770732084279)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.5257286443082556),\n                                    (\"<integer> (latent time-of-day)afternoon\", -2.120263536200091),\n                                    (\"tomorrownight\", -2.5257286443082556),\n                                    (\"monthhour\", -2.120263536200091),\n                                    (\"hourhour\", -2.120263536200091),\n                                    (\"Febbraiomorning\", -2.120263536200091)],\n                               n = 5}}),\n       (\"Mercoledi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dal <datetime> al <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.6931471805599453),\n                                    (\"tomorrowGiovedi\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dalle <time-of-day> alle <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight<integer> (latent time-of-day)\", -2.5649493574615367),\n                                    (\"minuteminute\", -1.8718021769015913),\n                                    (\"hh(:|h)mm (time-of-day)hh(:|h)mm (time-of-day)\",\n                                     -1.8718021769015913),\n                                    (\"<integer> (latent time-of-day)<integer> (latent time-of-day)\",\n                                     -2.159484249353372),\n                                    (\"hourhour\", -1.6486586255873816),\n                                    (\"minutehour\", -2.159484249353372),\n                                    (\"hh(:|h)mm (time-of-day)<integer> (latent time-of-day)\",\n                                     -2.159484249353372),\n                                    (\"<integer> (latent time-of-day)una\", -2.5649493574615367)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minutehour\", -1.6094379124341003),\n                                    (\"hh(:|h)mm (time-of-day)<integer> (latent time-of-day)\",\n                                     -1.6094379124341003)],\n                               n = 1}}),\n       (\"ferragosto\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 41..49 51..59 61..69 71..79 81..89 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Sabato\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Maggio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -4.060443010546419,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 56},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"year (1000-2100 not latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.16034265007517937,\n                               unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -1.9095425048844386, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"il <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -4.060443010546419,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd[/-]mm\", -3.349904087274605),\n                                    (\"Martedi\", -3.349904087274605),\n                                    (\"<ordinal> quarter\", -3.349904087274605),\n                                    (\"<cycle> next\", -3.349904087274605),\n                                    (\"<ordinal> <cycle> of <time>\", -3.349904087274605),\n                                    (\"<ordinal> quarter <year>\", -3.349904087274605),\n                                    (\"day\", -1.3350010667323402), (\"quarter\", -2.9444389791664407),\n                                    (\"<dim time> al <part-of-day>\", -3.349904087274605),\n                                    (\"day of month (1st)\", -3.349904087274605),\n                                    (\"two time tokens in a row\", -2.6567569067146595),\n                                    (\"hour\", -2.9444389791664407), (\"month\", -3.349904087274605),\n                                    (\"next <time>\", -2.9444389791664407),\n                                    (\"<day-of-month> <named-month>\", -2.097141118779237),\n                                    (\"minute\", -3.349904087274605),\n                                    (\"week-end\", -3.349904087274605)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> quarter\", -2.5257286443082556),\n                                    (\"day\", -2.5257286443082556), (\"quarter\", -2.5257286443082556),\n                                    (\"two time tokens in a row\", -2.5257286443082556),\n                                    (\"hour\", -2.120263536200091),\n                                    (\"<day-of-month> <named-month>\", -2.5257286443082556),\n                                    (\"week-end\", -2.5257286443082556)],\n                               n = 4}}),\n       (\"entro <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4423470353692043),\n                                    (\"il <day-of-month>\", -2.4423470353692043),\n                                    (\"EOY|End of year\", -2.4423470353692043),\n                                    (\"day\", -2.4423470353692043), (\"year\", -2.4423470353692043),\n                                    (\"EOM|End of month\", -2.4423470353692043),\n                                    (\"noon\", -2.4423470353692043), (\"hour\", -2.4423470353692043),\n                                    (\"month\", -2.03688192726104), (\"Marzo\", -2.4423470353692043),\n                                    (\"minute\", -2.4423470353692043)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.8718021769015913),\n                                    (\"hour\", -1.8718021769015913)],\n                               n = 1}}),\n       (\"trimestre (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Gennaio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ognissanti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noonnumber (0..19)\", -1.0986122886681098),\n                                    (\"at <time-of-day>number (0..19)\", -1.5040773967762742),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"une <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"semaine (grain)\", -1.3862943611198906),\n                                    (\"heure (grain)\", -1.3862943611198906),\n                                    (\"hour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.5686159179138452), (\"day\", -2.4849066497880004),\n                                    (\"year\", -2.0794415416798357),\n                                    (\"<integer> <unit-of-duration>\", -0.9808292530117262),\n                                    (\"une <unit-of-duration>\", -2.4849066497880004),\n                                    (\"month\", -2.0794415416798357)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.7047480922384253),\n                                    (\"ann\\233e (grain)\", -2.3978952727983707),\n                                    (\"semaine (grain)\", -1.7047480922384253),\n                                    (\"mois (grain)\", -2.3978952727983707),\n                                    (\"quarter\", -1.9924301646902063), (\"year\", -2.3978952727983707),\n                                    (\"trimestre (grain)\", -1.9924301646902063),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"EOM|End of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh quart del pomeriggio(time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens in a row\",\n        Classifier{okData =\n                     ClassData{prior = -0.31730232051349283,\n                               unseen = -6.037870919922137,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Lunedi<day-of-month> <named-month>\", -4.936869143856646),\n                                    (\"<datetime> - <datetime> (interval)Giovedi\",\n                                     -5.342334251964811),\n                                    (\"intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"year (1000-2100 not latent)\",\n                                     -4.936869143856646),\n                                    (\"dayhour\", -3.3274312314225463),\n                                    (\"Febbraioyear (1000-2100 not latent)\", -5.342334251964811),\n                                    (\"Settembreat <time-of-day>\", -4.6491870714048655),\n                                    (\"daymonth\", -2.56974552972503),\n                                    (\"<named-day> <day-of-month>Settembre\", -4.243721963296701),\n                                    (\"day of month (1st)intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"\",\n                                     -4.6491870714048655),\n                                    (\"Ottobreyear (1000-2100 not latent)\", -4.089571283469443),\n                                    (\"monthyear\", -3.20226808846854),\n                                    (\"day of month (1st)two time tokens in a row\",\n                                     -4.243721963296701),\n                                    (\"<ordinal> <cycle> of <time>year (1000-2100 not latent)\",\n                                     -5.342334251964811),\n                                    (\"christmasyear (1000-2100 not latent)\", -4.936869143856646),\n                                    (\"<named-day> <day-of-month>two time tokens in a row\",\n                                     -4.936869143856646),\n                                    (\"tomorrowdopo <time>\", -5.342334251964811),\n                                    (\"Giovedidalle <time-of-day> alle <time-of-day> (interval)\",\n                                     -4.6491870714048655),\n                                    (\"intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"<day-of-month> <named-month>\",\n                                     -4.6491870714048655),\n                                    (\"two time tokens separated by `di`Settembre\",\n                                     -4.6491870714048655),\n                                    (\"day of month (1st)Maggio\", -5.342334251964811),\n                                    (\"tra il <integer> e il <integer> (interval)Luglio\",\n                                     -4.936869143856646),\n                                    (\"day of month (1st)Mercoledi\", -5.342334251964811),\n                                    (\"dayday\", -2.777384894503274),\n                                    (\"il <time>year (1000-2100 not latent)\", -5.342334251964811),\n                                    (\"Giovediat <time-of-day>\", -4.936869143856646),\n                                    (\"entro il <integer>Aprile\", -5.342334251964811),\n                                    (\"dayyear\", -3.20226808846854),\n                                    (\"tomorrowdalle <time-of-day> alle <time-of-day> (interval)\",\n                                     -4.936869143856646),\n                                    (\"hh(:|h)mm (time-of-day)two time tokens in a row\",\n                                     -4.936869143856646),\n                                    (\"dd[/-]mmat <time-of-day>\", -5.342334251964811),\n                                    (\"dal <integer> al <integer> (interval)Luglio\",\n                                     -4.936869143856646),\n                                    (\"tomorrowdopo le <time-of-day>\", -4.936869143856646),\n                                    (\"monthminute\", -4.6491870714048655),\n                                    (\"minutemonth\", -3.8382568551885368),\n                                    (\"il <time>Marzo\", -5.342334251964811),\n                                    (\"<named-day> <day-of-month>Febbraio\", -4.426043520090656),\n                                    (\"hh(:|h)mm (time-of-day)<named-day> <day-of-month>\",\n                                     -5.342334251964811),\n                                    (\"Settembreyear (1000-2100 not latent)\", -4.936869143856646),\n                                    (\"Mercoledi<day-of-month> <named-month>\", -5.342334251964811),\n                                    (\"il <day-of-month> <named-month>at <time-of-day>\",\n                                     -5.342334251964811),\n                                    (\"day of month (1st)Marzo\", -4.936869143856646),\n                                    (\"Sabato<day-of-month> <named-month>\", -5.342334251964811),\n                                    (\"il <day-of-month>Settembre\", -5.342334251964811),\n                                    (\"Venerdi<day-of-month> <named-month>\", -4.426043520090656),\n                                    (\"<day-of-month> <named-month>at <time-of-day>\",\n                                     -4.6491870714048655),\n                                    (\"il <day-of-month> <named-month>year (1000-2100 not latent)\",\n                                     -5.342334251964811),\n                                    (\"two time tokens separated by `di`year (1000-2100 not latent)\",\n                                     -4.936869143856646),\n                                    (\"last <cycle> of <time>year (1000-2100 not latent)\",\n                                     -4.6491870714048655),\n                                    (\"day of month (1st)two time tokens separated by `di`\",\n                                     -4.6491870714048655),\n                                    (\"il <day-of-month>Febbraio\", -4.426043520090656),\n                                    (\"Gennaioyear (1000-2100 not latent)\", -4.6491870714048655),\n                                    (\"the day after tomorrowat <time-of-day>\", -4.936869143856646),\n                                    (\"two time tokens in a rowyear (1000-2100 not latent)\",\n                                     -4.6491870714048655),\n                                    (\"il <day-of-month>two time tokens in a row\",\n                                     -4.936869143856646),\n                                    (\"Giovedientro <time>\", -5.342334251964811),\n                                    (\"at <time-of-day>two time tokens in a row\",\n                                     -4.936869143856646),\n                                    (\"dayminute\", -2.739644566520427),\n                                    (\"Venerditwo time tokens in a row\", -4.936869143856646),\n                                    (\"two time tokens in a rowat <time-of-day>\",\n                                     -4.243721963296701),\n                                    (\"minuteday\", -3.1451096746285914),\n                                    (\"two time tokens separated by `di`<day-of-month> <named-month>\",\n                                     -4.6491870714048655),\n                                    (\"il <time>at <time-of-day>\", -5.342334251964811),\n                                    (\"Sabatoat <time-of-day>\", -5.342334251964811),\n                                    (\"intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"Settembre\",\n                                     -4.6491870714048655),\n                                    (\"Domenica<day-of-month> <named-month>\", -5.342334251964811),\n                                    (\"last <day-of-week> of <time>year (1000-2100 not latent)\",\n                                     -5.342334251964811),\n                                    (\"immacolata concezioneat <time-of-day>\", -5.342334251964811),\n                                    (\"at <time-of-day><named-day> <day-of-month>\",\n                                     -5.342334251964811),\n                                    (\"day of month (1st)Martedi\", -4.426043520090656),\n                                    (\"at <time-of-day>Venerdi\", -5.342334251964811),\n                                    (\"weekyear\", -4.936869143856646),\n                                    (\"Giovedi<time> timezone\", -4.936869143856646),\n                                    (\"Gioveditra il <datetime> e il <datetime> (interval)\",\n                                     -4.6491870714048655),\n                                    (\"two time tokens in a rowSettembre\", -4.936869143856646),\n                                    (\"tomorrowat <time-of-day>\", -5.342334251964811),\n                                    (\"two time tokens in a row<day-of-month> <named-month>\",\n                                     -4.936869143856646),\n                                    (\"Giovedientro le <time-of-day>\", -5.342334251964811),\n                                    (\"two time tokens in a rowin <named-month>\",\n                                     -4.6491870714048655),\n                                    (\"Dicembreyear (1000-2100 not latent)\", -4.6491870714048655),\n                                    (\"Marzoyear (1000-2100 not latent)\", -5.342334251964811),\n                                    (\"Martediin <named-month>\", -4.6491870714048655),\n                                    (\"the day after tomorrowentro le <time-of-day>\",\n                                     -5.342334251964811),\n                                    (\"<day-of-month> <named-month>year (1000-2100 not latent)\",\n                                     -4.936869143856646),\n                                    (\"commemorazione dei defuntiat <time-of-day>\",\n                                     -5.342334251964811),\n                                    (\"il <day-of-month>Marzo\", -5.342334251964811),\n                                    (\"hh(:|h)mm (time-of-day)Venerdi\", -5.342334251964811)],\n                               n = 158},\n                   koData =\n                     ClassData{prior = -1.3023599096347402,\n                               unseen = -5.3981627015177525,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>prossimi <unit-of-duration>\",\n                                     -4.295015257684252),\n                                    (\"intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"year (1000-2100 not latent)\",\n                                     -4.007333185232471),\n                                    (\"dayhour\", -2.1355310083308794),\n                                    (\"Settembreat <time-of-day>\", -3.784189633918261),\n                                    (\"daymonth\", -4.700480365792417),\n                                    (\"monthyear\", -4.700480365792417),\n                                    (\"<named-day> <day-of-month>two time tokens in a row\",\n                                     -4.007333185232471),\n                                    (\"monthhour\", -3.6018680771243066),\n                                    (\"hourmonth\", -4.295015257684252),\n                                    (\"dayday\", -4.700480365792417),\n                                    (\"Febbraiothis <part-of-day>\", -4.295015257684252),\n                                    (\"Giovediat <time-of-day>\", -3.784189633918261),\n                                    (\"tra il <datetime> e il <datetime> (interval)Luglio\",\n                                     -4.295015257684252),\n                                    (\"dayyear\", -3.196402969016142),\n                                    (\"<hour-of-day> and <relative minutes>Luglio\",\n                                     -4.700480365792417),\n                                    (\"tomorrowstanotte\", -4.700480365792417),\n                                    (\"dd[/-]mmat <time-of-day>\", -4.700480365792417),\n                                    (\"il <day-of-month>Luglio\", -4.700480365792417),\n                                    (\"tomorrowdopo le <time-of-day>\", -4.295015257684252),\n                                    (\"monthminute\", -4.700480365792417),\n                                    (\"minutemonth\", -4.700480365792417),\n                                    (\"il <day-of-month> <named-month>at <time-of-day>\",\n                                     -4.700480365792417),\n                                    (\"dopo <time>at <time-of-day>\", -4.700480365792417),\n                                    (\"<day-of-month> <named-month>at <time-of-day>\",\n                                     -3.784189633918261),\n                                    (\"weekmonth\", -4.295015257684252),\n                                    (\"two time tokens separated by `di`year (1000-2100 not latent)\",\n                                     -4.007333185232471),\n                                    (\"hourweek\", -4.295015257684252),\n                                    (\"the day after tomorrowat <time-of-day>\", -4.700480365792417),\n                                    (\"il <day-of-month>two time tokens in a row\",\n                                     -4.700480365792417),\n                                    (\"dayminute\", -3.0910424533583156),\n                                    (\"Venerditwo time tokens in a row\", -4.007333185232471),\n                                    (\"two time tokens in a rowat <time-of-day>\",\n                                     -3.3141860046725258),\n                                    (\"minuteday\", -4.700480365792417),\n                                    (\"il <time>at <time-of-day>\", -4.700480365792417),\n                                    (\"Giovedidopo le <time-of-day>\", -4.007333185232471),\n                                    (\"the <cycle> of <time>Ottobre\", -4.295015257684252),\n                                    (\"tomorrowat <time-of-day>\", -4.700480365792417),\n                                    (\"Martedidopo <time>\", -4.700480365792417),\n                                    (\"dopo <time>year (1000-2100 not latent)\", -4.295015257684252),\n                                    (\"hh(:|h)mm (time-of-day)Giovedi\", -4.700480365792417),\n                                    (\"Marzoyear (1000-2100 not latent)\", -4.700480365792417)],\n                               n = 59}}),\n       (\"heure (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Giornata della lingua araba\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"jour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh <relative-minutes> del pomeriggio(time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>number (20..90)\", -1.2992829841302609),\n                                    (\"<integer> (latent time-of-day)number (20..90)\",\n                                     -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> minus quart\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.5040773967762742),\n                                    (\"noon\", -1.0986122886681098), (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd[/-]mm[/-]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martedi\", -1.791759469228055),\n                                    (\"season\", -2.1972245773362196), (\"day\", -0.9444616088408514),\n                                    (\"Lunedi\", -2.1972245773362196),\n                                    (\"Mercoledi\", -2.1972245773362196),\n                                    (\"il <time>\", -2.1972245773362196)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Martedi\", -1.3862943611198906), (\"day\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"christmas\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"new year's day\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.304065093204169,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.498699971920336),\n                                    (\"number (0..19)heure (grain)\", -3.597312260588446),\n                                    (\"number (0..19)jour (grain)\", -3.597312260588446),\n                                    (\"second\", -2.9041650800285006),\n                                    (\"integer (numeric)ann\\233e (grain)\", -3.597312260588446),\n                                    (\"integer (numeric)seconde (grain)\", -3.597312260588446),\n                                    (\"integer (numeric)jour (grain)\", -3.1918471524802814),\n                                    (\"day\", -2.9041650800285006), (\"year\", -2.9041650800285006),\n                                    (\"number (0..19)seconde (grain)\", -3.1918471524802814),\n                                    (\"number (0..19)ann\\233e (grain)\", -3.1918471524802814),\n                                    (\"number (0..19)semaine (grain)\", -3.1918471524802814),\n                                    (\"hour\", -2.9041650800285006),\n                                    (\"number (0..19)mois (grain)\", -2.9041650800285006),\n                                    (\"month\", -2.344549292093078),\n                                    (\"integer (numeric)minute (grain)\", -3.1918471524802814),\n                                    (\"integer (numeric)mois (grain)\", -2.9041650800285006),\n                                    (\"minute\", -2.9041650800285006),\n                                    (\"number (0..19)minute (grain)\", -3.597312260588446),\n                                    (\"integer (numeric)semaine (grain)\", -2.9041650800285006),\n                                    (\"integer (numeric)heure (grain)\", -3.1918471524802814)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"entro il <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.9808292530117262),\n                                    (\"semaine (grain)\", -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mois (grain)\", -0.9808292530117262),\n                                    (\"month\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"prossimi <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9924301646902063),\n                                    (\"ann\\233e (grain)\", -2.3978952727983707),\n                                    (\"semaine (grain)\", -1.9924301646902063),\n                                    (\"mois (grain)\", -1.9924301646902063),\n                                    (\"day\", -1.9924301646902063), (\"year\", -2.3978952727983707),\n                                    (\"jour (grain)\", -1.9924301646902063),\n                                    (\"month\", -1.9924301646902063)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dopo <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.9555114450274363, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.845826690498331),\n                                    (\"Giovedi\", -2.2512917986064953), (\"day\", -1.55814461804655),\n                                    (\"day of month (1st)\", -2.2512917986064953),\n                                    (\"the day after tomorrow\", -2.2512917986064953),\n                                    (\"hour\", -1.845826690498331)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.48550781578170077,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tomorrow\", -1.8325814637483102), (\"day\", -1.1394342831883648),\n                                    (\"two time tokens in a row\", -1.8325814637483102),\n                                    (\"hour\", -2.5257286443082556),\n                                    (\"christmas\", -2.120263536200091)],\n                               n = 8}}),\n       (\"festa della liberazione\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dal <integer\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.40546510810816444)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"number (0..19)\", -0.6931471805599453)],\n                               n = 4}}),\n       (\"halloween day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.5040773967762742),\n                                    (\"<day-of-month> <named-month><day-of-month> <named-month>\",\n                                     -1.791759469228055),\n                                    (\"hh(:|h)mm (time-of-day)hh(:|h)mm (time-of-day)\",\n                                     -1.5040773967762742),\n                                    (\"dayday\", -1.791759469228055)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"Luglio<day-of-month> <named-month>\", -1.9459101490553135),\n                                    (\"minuteminute\", -1.9459101490553135),\n                                    (\"hh(:|h)mm (time-of-day)two time tokens in a row\",\n                                     -1.9459101490553135),\n                                    (\"Agosto<day-of-month> <named-month>\", -1.9459101490553135)],\n                               n = 3}}),\n       (\"<day-of-month> <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1880522315029396, unseen = -4.219507705176107,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Settembre\", -2.12525107771113),\n                                    (\"integer (numeric)Aprile\", -3.5115454388310208),\n                                    (\"integer (numeric)Agosto\", -3.1060803307228566),\n                                    (\"integer (numeric)Ottobre\", -3.1060803307228566),\n                                    (\"integer (numeric)Marzo\", -3.1060803307228566),\n                                    (\"integer (numeric)Febbraio\", -1.5656352897757075),\n                                    (\"integer (numeric)Luglio\", -3.1060803307228566),\n                                    (\"month\", -0.8034952377288106)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -1.7635885922613588,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Aprile\", -2.3513752571634776),\n                                    (\"integer (numeric)Luglio\", -1.4350845252893227),\n                                    (\"month\", -1.0986122886681098),\n                                    (\"number (0..19)Luglio\", -2.3513752571634776)],\n                               n = 6}}),\n       (\"Marzo\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"in <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Ottobre\", -1.0116009116784799),\n                                    (\"month\", -0.7884573603642702), (\"Marzo\", -1.7047480922384253)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mezz'ora\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dicembre\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> entro le <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.8472978603872037),\n                                    (\"Giovedinoon\", -1.252762968495368),\n                                    (\"the day after tomorrow<integer> (latent time-of-day)\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (primo..10)Marteditwo time tokens in a row\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (primo..10)Martedichristmas\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<part-of-day> of <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -1.0986122886681098),\n                                    (\"morning<day-of-month> <named-month>\", -1.6094379124341003),\n                                    (\"eveningtomorrow\", -2.0149030205422647),\n                                    (\"morningLunedi\", -2.0149030205422647)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -0.9985288301111273),\n                                    (\"stanottetomorrow\", -1.845826690498331),\n                                    (\"nighttomorrow\", -1.845826690498331),\n                                    (\"afternoontomorrow\", -1.845826690498331)],\n                               n = 6}}),\n       (\"<dim time> del mattino\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.7047480922384253),\n                                    (\"<integer> (latent time-of-day)\", -1.7047480922384253),\n                                    (\"hh(:|h)mm (time-of-day)\", -1.7047480922384253),\n                                    (\"hour\", -1.2992829841302609), (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.2809338454620642),\n                                    (\"jour (grain)two time tokens in a row\", -1.791759469228055),\n                                    (\"semaine (grain)Settembre\", -2.1972245773362196),\n                                    (\"weekmonth\", -1.791759469228055),\n                                    (\"semaine (grain)two time tokens in a row\",\n                                     -2.1972245773362196),\n                                    (\"jour (grain)Ottobre\", -1.791759469228055)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by `di`\",\n        Classifier{okData =\n                     ClassData{prior = -0.4274440148269396, unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh(:|h)mm (time-of-day)Sabato\", -3.8394523125933104),\n                                    (\"hourday\", -2.5866893440979424),\n                                    (\"daymonth\", -2.45315795147342),\n                                    (\"MartediOttobre\", -3.8394523125933104),\n                                    (\"Mercoleditwo time tokens in a row\", -3.8394523125933104),\n                                    (\"two time tokens in a rowtwo time tokens in a row\",\n                                     -3.8394523125933104),\n                                    (\"two time tokens in a rowOttobre\", -3.4339872044851463),\n                                    (\"<integer 0 12> del <part of day>tomorrow\",\n                                     -3.8394523125933104),\n                                    (\"hh(:|h)mm (time-of-day)two time tokens in a row\",\n                                     -2.9231615807191553),\n                                    (\"Lunedithis <cycle>\", -3.8394523125933104),\n                                    (\"Martedithis <cycle>\", -3.8394523125933104),\n                                    (\"hh(:|h)mm (time-of-day)<named-day> <day-of-month>\",\n                                     -3.4339872044851463),\n                                    (\"day of month (1st)Marzo\", -3.8394523125933104),\n                                    (\"MercolediOttobre\", -3.8394523125933104),\n                                    (\"at <time-of-day>two time tokens in a row\",\n                                     -3.4339872044851463),\n                                    (\"minuteday\", -1.824549292051046),\n                                    (\"dalle <time-of-day> alle <time-of-day> (interval)Giovedi\",\n                                     -3.146305132033365),\n                                    (\"at <time-of-day>Sabato\", -3.8394523125933104),\n                                    (\"at <time-of-day><named-day> <day-of-month>\",\n                                     -3.8394523125933104),\n                                    (\"dayweek\", -3.146305132033365),\n                                    (\"at <time-of-day>Venerdi\", -3.8394523125933104),\n                                    (\"tra il <datetime> e il <datetime> (interval)Giovedi\",\n                                     -3.4339872044851463),\n                                    (\"<dim time> al <part-of-day>tomorrow\", -3.8394523125933104),\n                                    (\"Mercoledithis <cycle>\", -3.8394523125933104),\n                                    (\"hh(:|h)mm (time-of-day)Venerdi\", -3.8394523125933104)],\n                               n = 30},\n                   koData =\n                     ClassData{prior = -1.0560526742493137, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.382627800667582),\n                                    (\"daymonth\", -2.094945728215801),\n                                    (\"Mercoleditwo time tokens in a row\", -3.481240089335692),\n                                    (\"stanottetomorrow\", -3.0757749812275272),\n                                    (\"MartediSettembre\", -3.481240089335692),\n                                    (\"LunediMarzo\", -3.481240089335692),\n                                    (\"MercolediOttobre\", -3.481240089335692),\n                                    (\"Marteditwo time tokens in a row\", -3.481240089335692),\n                                    (\"minuteday\", -2.5649493574615367),\n                                    (\"DomenicaMarzo\", -3.481240089335692),\n                                    (\"at <time-of-day>Giovedi\", -2.382627800667582),\n                                    (\"Domenicatwo time tokens in a row\", -3.481240089335692),\n                                    (\"hh(:|h)mm (time-of-day)Giovedi\", -3.0757749812275272)],\n                               n = 16}}),\n       (\"il <day-of-month> <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Settembre\", -2.1400661634962708),\n                                    (\"integer (numeric)Marzo\", -2.1400661634962708),\n                                    (\"integer (numeric)Febbraio\", -1.2237754316221157),\n                                    (\"month\", -0.8873031950009028)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Luglio\", -1.252762968495368),\n                                    (\"month\", -1.252762968495368)],\n                               n = 1}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"fino al <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh(:|h)mm (time-of-day)\", -1.791759469228055),\n                                    (\"EOY|End of year\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"EOM|End of month\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055), (\"minute\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"Domenica\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tre quarti d'ora\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"ann\\233e (grain)\", -2.1972245773362196),\n                                    (\"semaine (grain)\", -1.791759469228055),\n                                    (\"mois (grain)\", -1.5040773967762742),\n                                    (\"year\", -2.1972245773362196), (\"month\", -1.5040773967762742)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"festa del pap\\224\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"at <time-of-day>integer (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Giornata dell'Africa\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Luglio\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8971199848858813),\n                                    (\"semaine (grain)\", -1.8971199848858813),\n                                    (\"mois (grain)\", -1.8971199848858813),\n                                    (\"heure (grain)\", -1.8971199848858813),\n                                    (\"hour\", -1.8971199848858813), (\"month\", -1.8971199848858813)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9459101490553135),\n                                    (\"semaine (grain)\", -1.9459101490553135),\n                                    (\"day\", -1.540445040947149),\n                                    (\"jour (grain)\", -1.540445040947149)],\n                               n = 3}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"season\", -1.8562979903656263), (\"day\", -1.8562979903656263),\n                                    (\"hour\", -1.1631508098056809), (\"evening\", -2.772588722239781),\n                                    (\"morning\", -2.0794415416798357),\n                                    (\"week-end\", -1.6739764335716716)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 2292}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.JA_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\21320\\24460|\\21320\\21069 <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.35667494393873245,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> o'clock\", -2.1400661634962708),\n                                    (\"time-of-day (latent)\", -2.1400661634962708),\n                                    (\"hh:mm\", -2.4277482359480516), (\"hour\", -1.580450375560848),\n                                    (\"hh\\26178mm\\20998\", -1.580450375560848),\n                                    (\"minute\", -1.329135947279942)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -1.2039728043259361,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9444616088408514),\n                                    (\"hour\", -0.9444616088408514)],\n                               n = 6}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.9572987556015321, unseen = -4.875197323201151,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 129},\n                   koData =\n                     ClassData{prior = -0.4843923666978351, unseen = -5.342334251964811,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 207}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (0..10)\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy/mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh\\26178mm\\20998\", -0.8266785731844679),\n                                    (\"minute\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8754687373538999),\n                                    (\"hour\", -0.8754687373538999)],\n                               n = 4}}),\n       (\"Imperial year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"December\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"last|past|next <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.0986122886681098),\n                                    (\"<integer> <unit-of-duration>\", -0.8109302162163288),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -2.6790626642289577,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -7.109592168373022e-2,\n                               unseen = -4.574710978503383,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 95}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\21320\\24460|\\21320\\21069 <time-of-day>\",\n                                     -1.6582280766035324),\n                                    (\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"hour\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"January\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"this quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"November\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8209805520698302,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -0.579818495252942, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"<year> - <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)integer (numeric)\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time> to <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7801585575495751, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearyear\", -2.639057329615259),\n                                    (\"yyyy/mm/ddyyyy/mm/dd\", -2.4159137783010487),\n                                    (\"dayday\", -2.4159137783010487),\n                                    (\"year (latent)year (latent)\", -2.639057329615259),\n                                    (\"monthmonth\", -1.252762968495368),\n                                    (\"<year> <named-month><year> <named-month>\",\n                                     -2.0794415416798357),\n                                    (\"JuneJuly\", -2.4159137783010487),\n                                    (\"<year> <named-month>July\", -2.2335922215070942)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -0.6131044728864089, unseen = -4.174387269895637,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"MondayJuly\", -1.8562979903656263),\n                                    (\"June<year> <named-month>\", -2.2129729343043585),\n                                    (\"monthmonth\", -1.6739764335716716),\n                                    (\"JuneJuly\", -2.367123614131617),\n                                    (\"Monday<year> <named-month>\", -2.2129729343043585)],\n                               n = 26}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"First Imperial year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -2.120263536200091, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.12783337150988489,\n                               unseen = -4.219507705176107,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 66}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> - <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0055218656020977, unseen = -4.574710978503383,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<year> <named-month>in <month>\", -3.871201010907891),\n                                    (\"<year> <named-month>until <time>\", -3.4657359027997265),\n                                    (\"Junein <named-month>\", -3.871201010907891),\n                                    (\"yyyy/mm/ddmm/dd\", -3.871201010907891),\n                                    (\"yearyear\", -2.2617630984737906),\n                                    (\"yyyy/mm/ddyyyy/mm/dd\", -3.4657359027997265),\n                                    (\"dayday\", -2.9549102790337356),\n                                    (\"year (latent)year (latent)\", -2.4849066497880004),\n                                    (\"monthmonth\", -1.6739764335716716),\n                                    (\"<year> <named-month><year> <named-month>\",\n                                     -2.6184380424125226),\n                                    (\"JuneJuly\", -3.1780538303479458),\n                                    (\"Juneuntil <time>\", -3.871201010907891),\n                                    (\"Junein <month>\", -3.871201010907891),\n                                    (\"year (latent)in <year>\", -3.871201010907891),\n                                    (\"year (latent)until <time>\", -3.871201010907891),\n                                    (\"yyyy/mm/dduntil <time>\", -3.871201010907891),\n                                    (\"<year> <named-month>July\", -3.4657359027997265)],\n                               n = 30},\n                   koData =\n                     ClassData{prior = -0.45547552868282576,\n                               unseen = -4.948759890378168,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.995732273553991),\n                                    (\"daymonth\", -1.9459101490553135),\n                                    (\"monthyear\", -2.995732273553991),\n                                    (\"yyyy/mm/ddyyyy/mm\", -3.8430301339411947),\n                                    (\"MondayJuly\", -3.1498829533812494),\n                                    (\"June<year> <named-month>\", -2.995732273553991),\n                                    (\"monthhour\", -2.8622008809294686),\n                                    (\"Mondayyear (latent)\", -3.5553480614894135),\n                                    (\"monthmonth\", -2.456735772821304),\n                                    (\"Junetime-of-day (latent)\", -3.1498829533812494),\n                                    (\"dayyear\", -3.5553480614894135),\n                                    (\"JuneJuly\", -3.8430301339411947),\n                                    (\"Juneuntil <time>\", -3.8430301339411947),\n                                    (\"Junein <month>\", -4.248495242049359),\n                                    (\"<year> <named-month>year (latent)\", -3.5553480614894135),\n                                    (\"Juneyear (latent)\", -3.5553480614894135),\n                                    (\"Mondaytime-of-day (latent)\", -3.1498829533812494),\n                                    (\"yyyy/mm/ddtime-of-day (latent)\", -4.248495242049359),\n                                    (\"Mondayuntil <time>\", -3.5553480614894135),\n                                    (\"Mondayin <month>\", -3.8430301339411947),\n                                    (\"Mondayin <named-month>\", -4.248495242049359),\n                                    (\"<year> <named-month>time-of-day (latent)\",\n                                     -3.8430301339411947),\n                                    (\"Monday<year> <named-month>\", -2.995732273553991)],\n                               n = 52}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -1.739174271186922e-2,\n                               unseen = -4.07753744390572,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 57},\n                   koData =\n                     ClassData{prior = -4.060443010546419, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"yyyy/mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -2.583997552432231, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -7.847161544149521e-2,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> counter months\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.727387818712341,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9267394020670396),\n                                    (\"month (grain)\", -3.109060958860994),\n                                    (\"hour (grain)\", -2.772588722239781),\n                                    (\"year (grain)\", -2.9267394020670396),\n                                    (\"second\", -2.320603598496724),\n                                    (\"week (grain)\", -2.9267394020670396),\n                                    (\"day\", -3.619886582626985), (\"quarter\", -2.772588722239781),\n                                    (\"minute (grain)\", -2.320603598496724),\n                                    (\"year\", -2.9267394020670396),\n                                    (\"second (grain)\", -2.320603598496724),\n                                    (\"hour\", -2.772588722239781), (\"month\", -3.109060958860994),\n                                    (\"quarter (grain)\", -2.772588722239781),\n                                    (\"minute\", -2.320603598496724),\n                                    (\"day (grain)\", -3.619886582626985)],\n                               n = 48},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<year> <named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.9459101490553135),\n                                    (\"Marchinteger (numeric)\", -1.252762968495368),\n                                    (\"Juneinteger (numeric)\", -1.9459101490553135),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -1.4469189829363254, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.2682639865946794, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13}}),\n       (\"June\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.871201010907891,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 46},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in/for the last <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> counter months\", -1.6739764335716716),\n                                    (\"day\", -2.0794415416798357), (\"year\", -1.6739764335716716),\n                                    (\"<integer> <unit-of-duration>\", -1.3862943611198906),\n                                    (\"month\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003), (\"day\", -1.6094379124341003),\n                                    (\"<integer> <unit-of-duration>\", -1.2039728043259361)],\n                               n = 2}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -1.466337068793427, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -0.13353139262452263)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.262364264467491, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.1466034741918754),\n                                    (\"integer (0..10)\", -1.9924301646902063)],\n                               n = 20}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -2.6149597780361984, unseen = -4.060443010546419,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407),\n                                    (\"integer (numeric)day (grain)\", -2.6567569067146595),\n                                    (\"integer (0..10)year (grain)\", -3.349904087274605),\n                                    (\"integer (numeric)year (grain)\", -3.349904087274605),\n                                    (\"day\", -2.6567569067146595), (\"year\", -2.9444389791664407),\n                                    (\"integer (numeric)week (grain)\", -3.349904087274605),\n                                    (\"hour\", -3.349904087274605),\n                                    (\"integer (0..10)week (grain)\", -3.349904087274605),\n                                    (\"integer (numeric)minute (grain)\", -1.6451559950361796),\n                                    (\"minute\", -1.6451559950361796),\n                                    (\"integer (numeric)hour (grain)\", -3.349904087274605)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -7.598590697792199e-2,\n                               unseen = -6.169610732491456,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -5.474369310328396),\n                                    (\"integer (0..10)month (grain)\", -3.223077511721901),\n                                    (\"integer (0..10)hour (grain)\", -5.0689042022202315),\n                                    (\"integer (numeric)day (grain)\", -3.459466289786131),\n                                    (\"integer (11..19)month (grain)\", -5.0689042022202315),\n                                    (\"second\", -3.970291913552122),\n                                    (\"integer (numeric)second (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)year (grain)\", -1.9628238714973751),\n                                    (\"day\", -3.459466289786131), (\"year\", -1.9628238714973751),\n                                    (\"integer (0..10)minute (grain)\", -5.0689042022202315),\n                                    (\"integer (numeric)week (grain)\", -5.474369310328396),\n                                    (\"integer (20..90)minute (grain)\", -5.0689042022202315),\n                                    (\"hour\", -2.9486406660201405), (\"month\", -1.5825490122177692),\n                                    (\"integer (numeric)minute (grain)\", -3.459466289786131),\n                                    (\"integer (numeric)month (grain)\", -1.8108076641987496),\n                                    (\"minute\", -3.223077511721901),\n                                    (\"integer (numeric)hour (grain)\", -3.0320222749591914)],\n                               n = 228}}),\n       (\"integer (11..19)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (0..10)\", 0.0)],\n                               n = 2}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm\", -0.8754687373538999),\n                                    (\"minute\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8754687373538999),\n                                    (\"hour\", -0.8754687373538999)],\n                               n = 4}}),\n       (\"on the <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5}}),\n       (\"on <day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7646061445420903, unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mm/dd\", -3.4965075614664802),\n                                    (\"Wednesday\", -3.4965075614664802),\n                                    (\"Saturday\", -3.4965075614664802),\n                                    (\"yyyy/mm/dd\", -2.3978952727983707),\n                                    (\"Monday\", -3.4965075614664802),\n                                    (\"<year> <named-month> <day-of-month>\", -2.580216829592325),\n                                    (\"day\", -0.8574502318512216), (\"Sunday\", -3.4965075614664802),\n                                    (\"Tuesday\", -2.1102132003465894),\n                                    (\"<named-month> <day-of-month>\", -3.4965075614664802),\n                                    (\"imperial <year> <named-month> <day-of-month>\",\n                                     -2.3978952727983707)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.6264558060612732, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> - <time>\", -3.20545280453606),\n                                    (\"Monday\", -1.5960148921019597), (\"day\", -0.8383291904044432),\n                                    (\"Sunday\", -1.8191584434161694),\n                                    (\"<named-month> <day-of-month>\", -2.6946271807700692)],\n                               n = 31}}),\n       (\"this|current <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -3.922071315328127e-2,\n                               unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.181224235989778),\n                                    (\"month (grain)\", -2.740840023925201),\n                                    (\"hour (grain)\", -2.517696472610991),\n                                    (\"year (grain)\", -3.028522096376982),\n                                    (\"week (grain)\", -2.181224235989778),\n                                    (\"day\", -2.517696472610991), (\"quarter\", -2.181224235989778),\n                                    (\"year\", -3.028522096376982), (\"hour\", -2.517696472610991),\n                                    (\"month\", -2.740840023925201),\n                                    (\"quarter (grain)\", -2.181224235989778),\n                                    (\"day (grain)\", -2.517696472610991)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -3.258096538021482, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.9459101490553135),\n                                    (\"day (grain)\", -1.9459101490553135)],\n                               n = 1}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in <year>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Imperial year (latent)\", -1.6094379124341003),\n                                    (\"First Imperial year (latent)\", -2.5257286443082556),\n                                    (\"<time> - <time>\", -2.5257286443082556),\n                                    (\"year (latent)\", -1.6094379124341003),\n                                    (\"year\", -0.8209805520698302)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.252762968495368),\n                                    (\"year\", -1.252762968495368)],\n                               n = 1}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7375989431307791, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"July\", -2.6741486494265287),\n                                    (\"year (latent)\", -2.451005098112319),\n                                    (\"yyyy/mm/dd\", -2.451005098112319),\n                                    (\"<year> <named-month> <day-of-month>\", -3.367295829986474),\n                                    (\"day\", -1.9810014688665833), (\"June\", -2.268683541318364),\n                                    (\"year\", -2.451005098112319), (\"month\", -1.575536360758419),\n                                    (\"<named-month> <day-of-month>\", -3.367295829986474),\n                                    (\"<year> <named-month>\", -2.6741486494265287),\n                                    (\"imperial <year> <named-month> <day-of-month>\",\n                                     -3.367295829986474)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -0.6505875661411494, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> - <time>\", -1.729239112246721),\n                                    (\"yyyy/mm/dd\", -2.740840023925201),\n                                    (\"Monday\", -1.929909807708872), (\"day\", -1.1826954058786512),\n                                    (\"Sunday\", -3.028522096376982), (\"year\", -3.4339872044851463),\n                                    (\"month\", -2.3353749158170367),\n                                    (\"<named-month> <day-of-month>\", -3.4339872044851463)],\n                               n = 24}}),\n       (\"in <month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24512245803298496,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yyyy/mm\", -2.174751721484161), (\"July\", -2.6855773452501515),\n                                    (\"<time> - <time>\", -2.6855773452501515),\n                                    (\"June\", -2.174751721484161), (\"March\", -2.3978952727983707),\n                                    (\"month\", -0.8397506547518206),\n                                    (\"<year> <named-month>\", -2.3978952727983707)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -1.5260563034950494,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -2.1972245773362196),\n                                    (\"July\", -1.791759469228055),\n                                    (\"<time> - <time>\", -2.1972245773362196),\n                                    (\"month\", -1.0986122886681098),\n                                    (\"<year> <named-month>\", -2.1972245773362196)],\n                               n = 5}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh\\26178mm\\20998\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (20..90)\", -1.7346010553881064),\n                                    (\"\", -0.8873031950009028),\n                                    (\"integer (numeric)integer (numeric)\", -0.8873031950009028)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"next week\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.16034265007517937,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.871679624884012),\n                                    (\"<integer> counter months\", -1.4853852637641216),\n                                    (\"<integer> <unit-of-duration>\", -1.405342556090585),\n                                    (\"month\", -1.4853852637641216),\n                                    (\"minute\", -1.5723966407537513)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -1.9095425048844386, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.0149030205422647), (\"year\", -2.0149030205422647),\n                                    (\"<integer> <unit-of-duration>\", -1.0986122886681098),\n                                    (\"month\", -2.0149030205422647),\n                                    (\"minute\", -2.0149030205422647)],\n                               n = 4}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.17185025692665928,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"July\", -2.512305623976115), (\"June\", -1.413693335308005),\n                                    (\"March\", -1.6650077635889111), (\"month\", -0.7777045685880083)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -1.845826690498331, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -1.7047480922384253),\n                                    (\"July\", -1.2992829841302609), (\"month\", -1.0116009116784799)],\n                               n = 3}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (numeric)\", -1.2039728043259361),\n                                    (\"Juneinteger (numeric)\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.3862943611198906),\n                                    (\"Marchinteger (numeric)\", -1.6739764335716716),\n                                    (\"Juneinteger (numeric)\", -2.0794415416798357),\n                                    (\"month\", -0.8266785731844679)],\n                               n = 6}}),\n       (\"integer (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = -1.8971199848858813,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.16251892949777494, unseen = -3.58351893845611,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 34}}),\n       (\"next <time-grain>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"week (grain)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"week (grain)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a week after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.9382696385929302,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.496436886313891, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"<year> <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3468709438421116, unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)July\", -2.45315795147342),\n                                    (\"year (latent)June\", -1.536867219599265),\n                                    (\"yearmonth\", -0.7949298748698876),\n                                    (\"year (latent)in <month>\", -3.146305132033365),\n                                    (\"year (latent)until <time>\", -3.146305132033365),\n                                    (\"year (latent)March\", -3.4339872044851463),\n                                    (\"year (latent)in <named-month>\", -3.146305132033365),\n                                    (\"year (latent)from <time>\", -2.9231615807191553)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -1.2272296664902034, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Imperial year (latent)August\", -3.1135153092103742),\n                                    (\"last yearAugust\", -3.1135153092103742),\n                                    (\"year (latent)June\", -3.1135153092103742),\n                                    (\"yearmonth\", -0.916290731874155),\n                                    (\"year (latent)in <month>\", -3.1135153092103742),\n                                    (\"year (latent)March\", -2.4203681286504293),\n                                    (\"year (latent)in <named-month>\", -3.1135153092103742),\n                                    (\"year (latent)August\", -3.1135153092103742),\n                                    (\"year (latent)from <time>\", -1.6094379124341003)],\n                               n = 17}}),\n       (\"imperial <year> <named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)Augustinteger (numeric)\", -2.3025850929940455),\n                                    (\"year (latent)Marchinteger (numeric)\", -1.6094379124341003),\n                                    (\"yearmonth\", -0.916290731874155),\n                                    (\"Imperial year (latent)Augustinteger (numeric)\",\n                                     -2.3025850929940455),\n                                    (\"year (latent)Juneinteger (numeric)\", -2.3025850929940455),\n                                    (\"last yearAugustinteger (numeric)\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <named-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.8971199848858813),\n                                    (\"Friday\", -1.8971199848858813), (\"day\", -0.7985076962177716),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.1430640512389436, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.379546134130174),\n                                    (\"yyyy/mm/dd\", -2.1972245773362196),\n                                    (\"day\", -2.1972245773362196), (\"June\", -1.6863989535702288),\n                                    (\"year\", -2.379546134130174), (\"month\", -1.349926716949016),\n                                    (\"<year> <named-month>\", -2.379546134130174)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -0.38395890288720075,\n                               unseen = -4.653960350157523,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -2.8526314299133175),\n                                    (\"yyyy/mm/dd\", -3.0349529867072724),\n                                    (\"Monday\", -1.6486586255873816), (\"day\", -1.466337068793427),\n                                    (\"June\", -2.2464956263430023), (\"year\", -2.8526314299133175),\n                                    (\"hh:mm\", -3.951243718581427), (\"month\", -1.6999519199749322),\n                                    (\"minute\", -3.951243718581427),\n                                    (\"<year> <named-month>\", -2.4471663218051534)],\n                               n = 47}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 988}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.KA_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.KM_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.KN_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.KO_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -1.6094379124341003),\n                                    (\"hh:mm\", -1.2039728043259361), (\"hour\", -1.6094379124341003),\n                                    (\"minute\", -1.2039728043259361)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -4.867534450455582,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 128},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -4.189654742026425,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 64}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect 2 numbers\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"compose by multiplicationinteger (21..99) - TYPE 2\",\n                                     -0.40546510810816444)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer - TYPE 1: powers of teninteger (21..99) - TYPE 2\",\n                                     -0.40546510810816444)],\n                               n = 1}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1826954058786512),\n                                    (\"yesterdayevening|night\", -3.4339872044851463),\n                                    (\"mm/ddafternoon\", -3.4339872044851463),\n                                    (\"todayafternoon\", -3.4339872044851463),\n                                    (\"dayevening|night\", -3.4339872044851463),\n                                    (\"todayevening|night\", -2.740840023925201),\n                                    (\"daymorning\", -3.4339872044851463),\n                                    (\"intersectevening|night\", -3.4339872044851463),\n                                    (\"next <cycle>evening|night\", -3.028522096376982),\n                                    (\"tomorrowlunch\", -3.4339872044851463),\n                                    (\"intersectmorning\", -3.4339872044851463),\n                                    (\"Mondaymorning\", -3.4339872044851463),\n                                    (\"the day before yesterday - \\50634\\44536\\51228morning\",\n                                     -3.4339872044851463),\n                                    (\"tomorrowevening|night\", -3.028522096376982),\n                                    (\"next <cycle>lunch\", -3.4339872044851463)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -0.5596157879354228, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)lunch\", -3.6109179126442243),\n                                    (\"dayhour\", -1.8191584434161694),\n                                    (\"yearhour\", -1.906169820405799),\n                                    (\"time-of-day (latent)evening|night\", -3.6109179126442243),\n                                    (\"Fridayafternoon\", -3.6109179126442243),\n                                    (\"year (latent)evening|night\", -2.512305623976115),\n                                    (\"hourhour\", -2.917770732084279),\n                                    (\"time-of-day (latent)lunch\", -3.6109179126442243),\n                                    (\"intersectafternoon\", -2.10684051586795),\n                                    (\"year (latent)afternoon\", -3.20545280453606),\n                                    (\"next <cycle>evening|night\", -3.6109179126442243),\n                                    (\"time-of-day (latent)afternoon\", -3.6109179126442243),\n                                    (\"year (latent)morning\", -3.20545280453606),\n                                    (\"tomorrowevening|night\", -3.6109179126442243)],\n                               n = 24}}),\n       (\"<time> nth <time> - 3\\50900 \\52395\\51704 \\54868\\50836\\51068\",\n        Classifier{okData =\n                     ClassData{prior = -0.6190392084062235, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -0.8649974374866046),\n                                    (\"intersectordinals (\\52395\\48264\\51704)Tuesday\",\n                                     -1.845826690498331),\n                                    (\"monthordinals (\\52395\\48264\\51704)Tuesday\",\n                                     -2.2512917986064953),\n                                    (\"intersectordinals (\\52395\\48264\\51704)Wednesday\",\n                                     -1.3350010667323402)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.7731898882334817, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -0.8873031950009028),\n                                    (\"monthordinals (\\52395\\48264\\51704)Wednesday\",\n                                     -1.2237754316221157),\n                                    (\"monthordinals (\\52395\\48264\\51704)Tuesday\",\n                                     -1.7346010553881064)],\n                               n = 6}}),\n       (\"the day before yesterday - \\50634\\44536\\51228\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half - \\48152\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> \\47560\\51648\\47561 <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthSunday\", -1.6094379124341003),\n                                    (\"monthday\", -0.916290731874155),\n                                    (\"monthMonday\", -1.6094379124341003),\n                                    (\"intersectSunday\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer - TYPE 1\",\n        Classifier{okData =\n                     ClassData{prior = -1.8588987720656835, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -0.1694181519580468, unseen = -4.882801922586371,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 130}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.241713132308783, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.3409265869705932,\n                               unseen = -3.5263605246161616,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 32}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.4279379639602229, unseen = -5.991464547107982,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect<hour-of-day> <integer> (as relative minutes)\",\n                                     -5.295814236329918),\n                                    (\"intersectFriday\", -4.602667055769973),\n                                    (\"year<time> \\47560\\51648\\47561 <cycle>\", -4.890349128221754),\n                                    (\"next <cycle>Friday\", -5.295814236329918),\n                                    (\"dayhour\", -2.0571357841655376),\n                                    (\"last <cycle>Sunday\", -4.890349128221754),\n                                    (\"monthday\", -2.462600892273702),\n                                    (\"yearhour\", -3.591066144091493),\n                                    (\"<time> <part-of-day>time-of-day\", -4.379523504455763),\n                                    (\"this <cycle>Tuesday\", -5.295814236329918),\n                                    (\"dayTuesday\", -5.295814236329918),\n                                    (\"intersectam|pm <time-of-day>\", -3.0985896589936988),\n                                    (\"next <cycle><time-of-day> am|pm\", -5.295814236329918),\n                                    (\"next <cycle>am|pm <time-of-day>\", -4.890349128221754),\n                                    (\"yearintersect\", -2.9932291433358724),\n                                    (\"monthday with korean number - \\51068\\51068..\\44396\\51068\",\n                                     -5.295814236329918),\n                                    (\"Saturdaytime-of-day\", -5.295814236329918),\n                                    (\"intersectMonday\", -4.890349128221754),\n                                    (\"monthhour\", -3.591066144091493),\n                                    (\"Thursday<time> timezone\", -4.890349128221754),\n                                    (\"mm/ddam|pm <time-of-day>\", -4.602667055769973),\n                                    (\"todayam|pm <time-of-day>\", -4.602667055769973),\n                                    (\"the day before yesterday - \\50634\\44536\\51228am|pm <time-of-day>\",\n                                     -4.379523504455763),\n                                    (\"dayday\", -3.686376323895818),\n                                    (\"hourhour\", -3.791736839553644),\n                                    (\"year<time> <ordinal> <cycle>\", -5.295814236329918),\n                                    (\"month<datetime> - <datetime> (interval)\", -4.890349128221754),\n                                    (\"dayam|pm <time-of-day>\", -5.295814236329918),\n                                    (\"last <cycle>Tuesday\", -5.295814236329918),\n                                    (\"time-of-dayafter <time-of-day>\", -5.295814236329918),\n                                    (\"monthminute\", -4.890349128221754),\n                                    (\"hourminute\", -4.602667055769973),\n                                    (\"this <cycle>Wednesday\", -5.295814236329918),\n                                    (\"Thursdayhh:mm\", -4.890349128221754),\n                                    (\"intersectday\", -4.197201947661808),\n                                    (\"am|pm <time-of-day>after <time-of-day>\", -5.295814236329918),\n                                    (\"dayMonday\", -4.890349128221754),\n                                    (\"Thursday<datetime> - <datetime> (interval)\",\n                                     -4.379523504455763),\n                                    (\"next <cycle>Wednesday\", -5.295814236329918),\n                                    (\"month<time> <part-of-day>\", -4.890349128221754),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.04305126783455),\n                                    (\"yearmonth\", -3.1557480728336476),\n                                    (\"dayminute\", -3.424012059428327),\n                                    (\"today<date>\\50640\", -5.295814236329918),\n                                    (\"mm/dd<date>\\50640\", -5.295814236329918),\n                                    (\"<hour-of-day> <integer> (as relative minutes)seconds\",\n                                     -5.295814236329918),\n                                    (\"<time> <part-of-day><date>\\50640\", -4.890349128221754),\n                                    (\"dayFriday\", -5.295814236329918),\n                                    (\"monthintersect\", -3.686376323895818),\n                                    (\"year<time> \\47560\\51648\\47561 <day-of-week>\",\n                                     -5.295814236329918),\n                                    (\"intersectintersect\", -3.5040547671018634),\n                                    (\"weekday\", -3.686376323895818),\n                                    (\"intersectday with korean number - \\51068\\51068..\\44396\\51068\",\n                                     -4.890349128221754),\n                                    (\"yearday\", -3.5040547671018634),\n                                    (\"Thursdayam|pm <time-of-day>\", -5.295814236329918),\n                                    (\"yearweek\", -4.890349128221754),\n                                    (\"minutesecond\", -5.295814236329918),\n                                    (\"<time> <part-of-day><hour-of-day> <integer> (as relative minutes)\",\n                                     -4.890349128221754),\n                                    (\"Fridayam|pm <time-of-day>\", -4.890349128221754),\n                                    (\"next <cycle>Tuesday\", -4.890349128221754),\n                                    (\"tomorrow<time-of-day> am|pm\", -5.295814236329918),\n                                    (\"tomorrowam|pm <time-of-day>\", -4.890349128221754),\n                                    (\"dayintersect\", -4.890349128221754)],\n                               n = 176},\n                   koData =\n                     ClassData{prior = -1.0551271767283708, unseen = -5.594711379601839,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year<time> \\47560\\51648\\47561 <cycle>\", -4.897839799950911),\n                                    (\"dayhour\", -2.2587824703356527),\n                                    (\"monthday\", -3.1930917077124863),\n                                    (\"yearhour\", -3.1930917077124863),\n                                    (\"<time> <part-of-day>time-of-day\", -3.7992275112828016),\n                                    (\"houryear\", -4.204692619390966),\n                                    (\"after <time-of-day>by <time> - \\44620\\51648\",\n                                     -4.897839799950911),\n                                    (\"intersectam|pm <time-of-day>\", -4.492374691842747),\n                                    (\"hournograin\", -4.897839799950911),\n                                    (\"intersect<time> <part-of-day>\", -3.9815490680767565),\n                                    (\"yearintersect\", -3.02603762304932),\n                                    (\"time-of-day<duration> ago\", -4.897839799950911),\n                                    (\"intersecttime-of-day\", -4.492374691842747),\n                                    (\"monthhour\", -3.02603762304932),\n                                    (\"intersectlast <time>\", -4.897839799950911),\n                                    (\"dayday\", -3.9815490680767565),\n                                    (\"hourhour\", -2.951929650895598),\n                                    (\"month<datetime> - <datetime> (interval)\",\n                                     -3.9815490680767565),\n                                    (\"dayam|pm <time-of-day>\", -4.492374691842747),\n                                    (\"hourminute\", -4.204692619390966),\n                                    (\"Thursdayhh:mm\", -4.492374691842747),\n                                    (\"<time-of-day> - <time-of-day> (interval)last <time>\",\n                                     -3.9815490680767565),\n                                    (\"intersectday\", -4.492374691842747),\n                                    (\"Thursdayintersect\", -4.897839799950911),\n                                    (\"this <cycle>Monday\", -4.492374691842747),\n                                    (\"<datetime> - <datetime> (interval)day\", -3.9815490680767565),\n                                    (\"month<time> <part-of-day>\", -4.492374691842747),\n                                    (\"Thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.492374691842747),\n                                    (\"yearmonth\", -4.492374691842747),\n                                    (\"Fridayafter <time-of-day>\", -4.897839799950911),\n                                    (\"dayminute\", -4.492374691842747),\n                                    (\"<time> <part-of-day><date>\\50640\", -4.897839799950911),\n                                    (\"last <time>time-of-day\", -4.897839799950911),\n                                    (\"monthintersect\", -3.3937624031746374),\n                                    (\"year<time> <part-of-day>\", -4.492374691842747),\n                                    (\"intersectintersect\", -3.6450768314555435),\n                                    (\"weekday\", -4.492374691842747),\n                                    (\"intersectday with korean number - \\51068\\51068..\\44396\\51068\",\n                                     -4.492374691842747),\n                                    (\"day<time> <part-of-day>\", -4.897839799950911),\n                                    (\"yearday\", -3.7992275112828016),\n                                    (\"Thursdayam|pm <time-of-day>\", -4.897839799950911),\n                                    (\"<time-of-day> - <time-of-day> (interval)time-of-day\",\n                                     -4.492374691842747),\n                                    (\"intersectafter <time-of-day>\", -3.3937624031746374),\n                                    (\"<time> <part-of-day><hour-of-day> <integer> (as relative minutes)\",\n                                     -4.492374691842747),\n                                    (\"dayintersect\", -4.897839799950911),\n                                    (\"mm/ddafter <time-of-day>\", -4.897839799950911),\n                                    (\"todayafter <time-of-day>\", -4.897839799950911)],\n                               n = 94}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0608719606852628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.42488319396526597,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.12516314295400605,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"month (grain)\", -3.044522437723423),\n                                    (\"year (grain)\", -3.044522437723423),\n                                    (\"week (grain)\", -1.791759469228055),\n                                    (\"day\", -1.791759469228055), (\"quarter\", -3.044522437723423),\n                                    (\"year\", -3.044522437723423), (\"month\", -3.044522437723423),\n                                    (\"quarter (grain)\", -3.044522437723423),\n                                    (\"day (grain)\", -1.791759469228055)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -2.1400661634962708, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.0794415416798357),\n                                    (\"minute (grain)\", -2.0794415416798357),\n                                    (\"minute\", -2.0794415416798357),\n                                    (\"day (grain)\", -2.0794415416798357)],\n                               n = 2}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.791759469228055),\n                                    (\"Monday\", -1.3862943611198906), (\"day\", -0.8754687373538999),\n                                    (\"Tuesday\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.9315582040049435),\n                                    (\"integer - TYPE 1\", -0.8574502318512216),\n                                    (\"integer (21..99) - TYPE 2\", -2.803360380906535),\n                                    (\"integer (1..4) - for ordinals\", -2.1102132003465894)],\n                               n = 29}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Memorial Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90) - TYPE 2 and ordinals\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time> - \\44620\\51648\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"am|pm <time-of-day>\", -1.252762968495368),\n                                    (\"time-of-day\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month>\\50640\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"month\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (21..99) - TYPE 2\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (20..90) - TYPE 2 and ordinalsinteger (1..4) - for ordinals\",\n                                     -1.5040773967762742),\n                                    (\"integer - TYPE 1: powers of teninteger - TYPE 1\",\n                                     -1.0986122886681098),\n                                    (\"compose by multiplicationinteger - TYPE 1\",\n                                     -1.0986122886681098)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer - TYPE 1: powers of teninteger - TYPE 1\",\n                                     -0.8472978603872037),\n                                    (\"integer (numeric)integer - TYPE 1\", -1.252762968495368)],\n                               n = 3}}),\n       (\"Independence Movement Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.17589066646366416,\n                               unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -1.824549292051046, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"<year> <1..4>quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearinteger (numeric)quarter (grain)\", -0.6931471805599453),\n                                    (\"yearquarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"Christmas Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Liberation Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, \\47560\\51060\\45320\\49828, or \\47560\\51060\\45208\\49828\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 7}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"National Foundation Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (\\52395\\48264\\51704)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (1..4) - for ordinals\", -0.35667494393873245),\n                                    (\"integer (1..10) - TYPE 2\", -1.2039728043259361)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day\",\n        Classifier{okData =\n                     ClassData{prior = -0.2657031657330056, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -8.338160893905101e-2),\n                                    (\"integer - TYPE 1\", -2.5257286443082556)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -1.455287232606842, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.25131442828090605),\n                                    (\"integer - TYPE 1\", -1.5040773967762742)],\n                               n = 7}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour (grain)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 7}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"integer (1..4) - for ordinals\",\n        Classifier{okData =\n                     ClassData{prior = -3.7740327982847086e-2,\n                               unseen = -3.332204510175204,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 26},\n                   koData =\n                     ClassData{prior = -3.295836866004329, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time> <ordinal> <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthordinals (\\52395\\48264\\51704)week (grain)\",\n                                     -1.252762968495368),\n                                    (\"monthweek\", -0.8472978603872037),\n                                    (\"intersectordinals (\\52395\\48264\\51704)week (grain)\",\n                                     -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"year (grain)\", -2.3025850929940455),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"minute (grain)\", -2.0794415416798357),\n                                    (\"minute\", -2.0794415416798357)],\n                               n = 4}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6359887667199967,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.7537718023763802,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"time-of-day\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4769240720903093),\n                                    (\"integer - TYPE 1\", -2.6741486494265287),\n                                    (\"integer (1..4) - for ordinals\", -1.7578579175523736),\n                                    (\"integer (1..10) - TYPE 2\", -2.6741486494265287)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.0608719606852628),\n                                    (\"integer - TYPE 1\", -0.8157495026522777),\n                                    (\"integer (20..90) - TYPE 2 and ordinals\", -3.258096538021482),\n                                    (\"integer (21..99) - TYPE 2\", -3.258096538021482),\n                                    (\"integer (1..4) - for ordinals\", -2.159484249353372)],\n                               n = 46}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.9873866535578852, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3285040669720361),\n                                    (\"intersect 2 numbers\", -2.5257286443082556),\n                                    (\"integer (21..99) - TYPE 2\", -2.5257286443082556)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -0.46608972992459924,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5020919437972361),\n                                    (\"intersect 2 numbers\", -2.2512917986064953),\n                                    (\"integer - TYPE 1\", -2.0281482472922856),\n                                    (\"integer - TYPE 1: powers of ten\", -2.538973871058276),\n                                    (\"compose by multiplication\", -2.9444389791664407)],\n                               n = 32}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.5955488002734333,\n                               unseen = -4.5217885770490405,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.7191000372887952),\n                                    (\"integer - TYPE 1year (grain)\", -3.41224721784874),\n                                    (\"integer (numeric)day (grain)\", -2.5649493574615367),\n                                    (\"second\", -3.817712325956905),\n                                    (\"integer - TYPE 1minute (grain)\", -2.9014215940827497),\n                                    (\"integer (1..4) - for ordinalshour (grain)\",\n                                     -3.41224721784874),\n                                    (\"integer (numeric)second (grain)\", -3.817712325956905),\n                                    (\"integer (numeric)year (grain)\", -3.41224721784874),\n                                    (\"day\", -2.5649493574615367), (\"year\", -2.9014215940827497),\n                                    (\"integer (numeric)week (grain)\", -2.7191000372887952),\n                                    (\"hour\", -2.3136349291806306),\n                                    (\"integer (numeric)minute (grain)\", -3.817712325956905),\n                                    (\"few \\47751hour (grain)\", -2.9014215940827497),\n                                    (\"minute\", -2.7191000372887952),\n                                    (\"integer (numeric)hour (grain)\", -3.41224721784874)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -0.22664618186541183,\n                               unseen = -5.568344503761097,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.955082494888593),\n                                    (\"integer - TYPE 1quarter (grain)\", -4.871373226762748),\n                                    (\"integer - TYPE 1day (grain)\", -4.178226046202803),\n                                    (\"integer - TYPE 1year (grain)\", -4.465908118654584),\n                                    (\"integer (numeric)day (grain)\", -2.4290261913935436),\n                                    (\"intersect 2 numbersyear (grain)\", -4.465908118654584),\n                                    (\"integer (numeric)quarter (grain)\", -4.871373226762748),\n                                    (\"compose by multiplicationminute (grain)\", -4.871373226762748),\n                                    (\"second\", -3.7727609380946383),\n                                    (\"integer - TYPE 1minute (grain)\", -3.7727609380946383),\n                                    (\"integer (1..4) - for ordinalsmonth (grain)\",\n                                     -4.465908118654584),\n                                    (\"integer (1..4) - for ordinalshour (grain)\",\n                                     -2.7313070632664775),\n                                    (\"integer (numeric)second (grain)\", -4.871373226762748),\n                                    (\"integer (numeric)year (grain)\", -2.6741486494265287),\n                                    (\"integer (21..99) - TYPE 2hour (grain)\", -4.871373226762748),\n                                    (\"integer - TYPE 1week (grain)\", -4.465908118654584),\n                                    (\"day\", -2.3064238693012116), (\"quarter\", -4.465908118654584),\n                                    (\"year\", -2.4290261913935436),\n                                    (\"integer (21..99) - TYPE 2minute (grain)\", -4.178226046202803),\n                                    (\"integer (numeric)week (grain)\", -4.465908118654584),\n                                    (\"integer (1..10) - TYPE 2hour (grain)\", -4.871373226762748),\n                                    (\"hour\", -1.900958761193047), (\"month\", -3.955082494888593),\n                                    (\"integer - TYPE 1second (grain)\", -4.465908118654584),\n                                    (\"integer (numeric)minute (grain)\", -3.955082494888593),\n                                    (\"integer (numeric)month (grain)\", -4.465908118654584),\n                                    (\"integer (21..99) - TYPE 2year (grain)\", -4.871373226762748),\n                                    (\"minute\", -2.856470206220483),\n                                    (\"integer - TYPE 1: powers of tenminute (grain)\",\n                                     -4.871373226762748),\n                                    (\"integer (numeric)hour (grain)\", -2.5199979695992702),\n                                    (\"integer (21..99) - TYPE 2second (grain)\",\n                                     -4.465908118654584)],\n                               n = 114}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.6486586255873816),\n                                    (\"hh:mm\", -1.1786549963416462), (\"hour\", -1.6486586255873816),\n                                    (\"minute\", -1.1786549963416462)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8472978603872037),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 5}}),\n       (\"a day - \\54616\\47336\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"am|pm <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.23262229526875347,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.824549292051046),\n                                    (\"<date>\\50640\", -3.146305132033365),\n                                    (\"time-of-day\", -1.536867219599265),\n                                    (\"hour\", -0.8437200390393196),\n                                    (\"<time-of-day>\\51060\\51204\", -3.4339872044851463),\n                                    (\"<hour-of-day> half (as relative minutes)\",\n                                     -3.8394523125933104),\n                                    (\"minute\", -3.146305132033365),\n                                    (\"after <time-of-day>\", -3.8394523125933104),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.4339872044851463)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -1.5723966407537513,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.2367626271489267),\n                                    (\"time-of-day\", -2.0476928433652555),\n                                    (\"hour\", -0.9490805546971459)],\n                               n = 11}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -4.255961441879589e-2,\n                               unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 23},\n                   koData =\n                     ClassData{prior = -3.1780538303479458,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"integer - TYPE 1: powers of ten\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"day with korean number - \\51068\\51068..\\44396\\51068\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Hangul Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> (hour-of-day) relative minutes \\51204\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"time-of-dayinteger (21..99) - TYPE 2\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8971199848858813), (\"day\", -1.6094379124341003),\n                                    (\"year\", -1.8971199848858813),\n                                    (\"<integer> <unit-of-duration>\", -0.916290731874155)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.0296194171811581),\n                                    (\"hour\", -1.540445040947149), (\"minute\", -1.540445040947149)],\n                               n = 4}}),\n       (\"Constitution Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -2.833213344056216, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.03688192726104), (\"Sunday\", -2.03688192726104),\n                                    (\"hour\", -2.03688192726104), (\"week-end\", -2.03688192726104)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -6.0624621816434854e-2,\n                               unseen = -4.969813299576001,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -3.8642323415917974),\n                                    (\"year (latent)\", -1.967112356705916),\n                                    (\"second\", -3.8642323415917974),\n                                    (\"time-of-day (latent)\", -1.9183221925364844),\n                                    (\"year\", -1.967112356705916),\n                                    (\"<duration> ago\", -3.8642323415917974),\n                                    (\"time-of-day\", -2.477937980471907),\n                                    (\"hour\", -1.1786549963416462), (\"seconds\", -3.8642323415917974),\n                                    (\"<datetime> - <datetime> (interval)\", -3.8642323415917974),\n                                    (\"<time-of-day>\\51060\\51204\", -3.8642323415917974),\n                                    (\"<time-of-day> - <time-of-day> (interval)\",\n                                     -3.353406717825807)],\n                               n = 64}}),\n       (\"<date>\\50640\",\n        Classifier{okData =\n                     ClassData{prior = -7.410797215372185e-2,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.824549292051046), (\"day\", -2.3353749158170367),\n                                    (\"am|pm <time-of-day>\", -2.0476928433652555),\n                                    (\"<duration> ago\", -2.740840023925201),\n                                    (\"time-of-day\", -2.0476928433652555),\n                                    (\"hour\", -1.0360919316867756), (\"month\", -2.740840023925201)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.639057329615259, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"integer (1..10) - TYPE 2\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day\",\n        Classifier{okData =\n                     ClassData{prior = -0.5328045304847658,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.5753641449035618),\n                                    (\"integer (1..4) - for ordinals\", -1.1631508098056809),\n                                    (\"integer (1..10) - TYPE 2\", -2.772588722239781)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -0.8842024173226546,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3862943611198906),\n                                    (\"integer (21..99) - TYPE 2\", -2.4849066497880004),\n                                    (\"integer (1..4) - for ordinals\", -0.8754687373538999),\n                                    (\"few \\47751\", -1.5686159179138452)],\n                               n = 19}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<integer> and an half hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (1..4) - for ordinals\", 0.0)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.5040773967762742),\n                                    (\"<integer> <unit-of-duration>\", -0.8109302162163288),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 1}}),\n       (\"month\",\n        Classifier{okData =\n                     ClassData{prior = -5.5569851154810765e-2,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -5.5569851154810765e-2),\n                                    (\"integer - TYPE 1\", -2.917770732084279)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -2.917770732084279, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer - TYPE 1\", -0.2876820724517809)],\n                               n = 2}}),\n       (\"midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.3862943611198906), (\"month\", -1.3862943611198906),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day\", -1.252762968495368),\n                                    (\"hour\", -1.252762968495368)],\n                               n = 1}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2992829841302609),\n                                    (\"month (grain)\", -2.3978952727983707),\n                                    (\"year (grain)\", -2.3978952727983707),\n                                    (\"week (grain)\", -1.2992829841302609),\n                                    (\"year\", -2.3978952727983707), (\"month\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"day\", -1.6739764335716716),\n                                    (\"day (grain)\", -1.6739764335716716)],\n                               n = 4}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.367123614131617),\n                                    (\"integer - TYPE 1year (grain)\", -2.772588722239781),\n                                    (\"integer - TYPE 1minute (grain)\", -2.772588722239781),\n                                    (\"integer (1..4) - for ordinalsmonth (grain)\",\n                                     -2.772588722239781),\n                                    (\"integer (numeric)year (grain)\", -2.772588722239781),\n                                    (\"integer - TYPE 1week (grain)\", -2.772588722239781),\n                                    (\"year\", -2.367123614131617),\n                                    (\"integer (numeric)week (grain)\", -2.772588722239781),\n                                    (\"hour\", -2.772588722239781), (\"month\", -2.367123614131617),\n                                    (\"integer (numeric)minute (grain)\", -2.772588722239781),\n                                    (\"integer (numeric)month (grain)\", -2.772588722239781),\n                                    (\"minute\", -2.367123614131617),\n                                    (\"integer (numeric)hour (grain)\", -2.772588722239781)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"seconds\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.916290731874155),\n                                    (\"integer (21..99) - TYPE 2\", -0.916290731874155)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.252762968495368),\n                                    (\"integer - TYPE 1\", -0.8472978603872037),\n                                    (\"integer (21..99) - TYPE 2\", -1.252762968495368)],\n                               n = 4}}),\n       (\"<time> \\47560\\51648\\47561 <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.540445040947149),\n                                    (\"monthday (grain)\", -1.9459101490553135),\n                                    (\"monthweek\", -1.540445040947149),\n                                    (\"intersectweek (grain)\", -1.9459101490553135),\n                                    (\"intersectday (grain)\", -1.9459101490553135),\n                                    (\"monthweek (grain)\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.2039728043259361),\n                                    (\"monthday (grain)\", -1.6094379124341003),\n                                    (\"intersectday (grain)\", -1.6094379124341003)],\n                               n = 2}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.17589066646366416,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.044522437723423), (\"second\", -3.4499875458315876),\n                                    (\"day\", -2.5336968139574325), (\"year\", -3.044522437723423),\n                                    (\"<integer> <unit-of-duration>\", -1.1986957472250923),\n                                    (\"a day - \\54616\\47336\", -3.044522437723423),\n                                    (\"<integer> and an half hours\", -2.3513752571634776),\n                                    (\"hour\", -2.1972245773362196), (\"minute\", -1.6582280766035324),\n                                    (\"about <duration>\", -3.4499875458315876)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -1.824549292051046, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half an hour\", -1.252762968495368),\n                                    (\"minute\", -1.252762968495368)],\n                               n = 5}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.46262352194811296,\n                               unseen = -3.8501476017100584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -2.7300291078209855),\n                                    (\"intersectam|pm <time-of-day>\", -2.7300291078209855),\n                                    (\"minuteminute\", -1.749199854809259),\n                                    (\"hh:mmhh:mm\", -2.03688192726104),\n                                    (\"dayday\", -1.8827312474337816),\n                                    (\"hourhour\", -2.2192034840549946),\n                                    (\"intersectday\", -2.7300291078209855),\n                                    (\"am|pm <time-of-day>am|pm <time-of-day>\", -2.7300291078209855),\n                                    (\"intersectintersect\", -2.7300291078209855)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.9932517730102834,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.8562979903656263),\n                                    (\"time-of-dayam|pm <time-of-day>\", -2.367123614131617),\n                                    (\"intersectmonth\", -2.367123614131617),\n                                    (\"dayday\", -2.367123614131617),\n                                    (\"hourhour\", -1.8562979903656263),\n                                    (\"last <time>am|pm <time-of-day>\", -2.367123614131617),\n                                    (\"dayintersect\", -2.367123614131617)],\n                               n = 10}}),\n       (\"<time-of-day>\\51060\\51204\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"am|pm <time-of-day>\", -1.540445040947149),\n                                    (\"time-of-day\", -1.540445040947149),\n                                    (\"hour\", -1.0296194171811581)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003), (\"minute\", -1.6094379124341003),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -1.6094379124341003)],\n                               n = 2}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<1..4> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer - TYPE 1quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1}}),\n       (\"Children's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.49247648509779407,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.8870696490323797),\n                                    (\"minuteminute\", -1.7047480922384253),\n                                    (\"hh:mmhh:mm\", -1.7047480922384253),\n                                    (\"hourhour\", -2.3978952727983707),\n                                    (\"minutehour\", -1.8870696490323797),\n                                    (\"am|pm <time-of-day>am|pm <time-of-day>\",\n                                     -2.3978952727983707)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.9444616088408514, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-dayam|pm <time-of-day>\", -2.120263536200091),\n                                    (\"time-of-daytime-of-day (latent)\", -2.5257286443082556),\n                                    (\"hh:mmtime-of-day (latent)\", -2.5257286443082556),\n                                    (\"am|pm <time-of-day>time-of-day (latent)\",\n                                     -2.5257286443082556),\n                                    (\"am|pm <time-of-day><time-of-day>\\51060\\51204\",\n                                     -2.5257286443082556),\n                                    (\"hourhour\", -1.2729656758128873),\n                                    (\"time-of-day<time-of-day>\\51060\\51204\", -2.5257286443082556),\n                                    (\"minutehour\", -2.5257286443082556)],\n                               n = 7}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5902671654458267), (\"second\", -2.5902671654458267),\n                                    (\"integer - TYPE 1minute (grain)\", -2.995732273553991),\n                                    (\"integer (1..4) - for ordinalsmonth (grain)\",\n                                     -2.995732273553991),\n                                    (\"integer (1..4) - for ordinalshour (grain)\",\n                                     -2.995732273553991),\n                                    (\"integer (numeric)second (grain)\", -2.995732273553991),\n                                    (\"integer (21..99) - TYPE 2hour (grain)\", -2.995732273553991),\n                                    (\"integer - TYPE 1week (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)week (grain)\", -2.995732273553991),\n                                    (\"hour\", -2.0794415416798357), (\"month\", -2.5902671654458267),\n                                    (\"integer - TYPE 1second (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)minute (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)month (grain)\", -2.995732273553991),\n                                    (\"minute\", -2.5902671654458267),\n                                    (\"integer (numeric)hour (grain)\", -2.5902671654458267)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> half (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.5040773967762742, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"lunch\", -1.8718021769015913),\n                                    (\"time-of-day (latent)\", -1.8718021769015913),\n                                    (\"am|pm <time-of-day>\", -1.8718021769015913),\n                                    (\"time-of-day\", -1.8718021769015913),\n                                    (\"hour\", -0.9555114450274363)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.25131442828090605,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.7884573603642702),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 14}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.1727202608218315, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.37037378829689427,\n                               unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29}}),\n       (\"the day after tomorrow - \\45236\\51068\\47784\\47112\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer - TYPE 1integer - TYPE 1: powers of ten\", 0.0)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> and an half hours\", -1.0986122886681098),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.0986122886681098),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-daycompose by multiplication\", -1.6094379124341003),\n                                    (\"time-of-dayinteger (numeric)\", -1.6094379124341003),\n                                    (\"hour\", -0.916290731874155),\n                                    (\"time-of-dayinteger (21..99) - TYPE 2\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.0986122886681098),\n                                    (\"time-of-dayinteger (21..99) - TYPE 2\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"few \\47751\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.540445040947149), (\"hour\", -1.540445040947149),\n                                    (\"Winter\", -1.9459101490553135),\n                                    (\"morning\", -1.9459101490553135),\n                                    (\"week-end\", -1.9459101490553135),\n                                    (\"Summer\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1507}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.LO_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ML_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.MN_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.MY_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.NB_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"L\\248rdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.410986973710262),\n                                    (\"<time-of-day> o'clock\", -3.0204248861443626),\n                                    (\"hh:mm\", -1.5163474893680884), (\"hour\", -2.1041341542702074),\n                                    (\"minute\", -1.0055218656020977)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8446970786871463, unseen = -5.117993812416755,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 165},\n                   koData =\n                     ClassData{prior = -0.561570822771226, unseen = -5.3981627015177525,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 219}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Father's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"S\\248ndag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.8649974374866046),\n                                    (\"tomorrowevening\", -1.845826690498331),\n                                    (\"tomorrowlunch\", -1.845826690498331),\n                                    (\"yesterdayevening\", -2.2512917986064953),\n                                    (\"Mandagmorning\", -1.845826690498331)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2488960474166244,\n                               unseen = -5.2574953720277815,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.3063632789913164),\n                                    (\"time-of-day (latent)\", -1.244940242814159),\n                                    (\"relative minutes after|past <integer> (hour-of-day)\",\n                                     -3.865979066926739),\n                                    (\"hh:mm\", -2.074219597698684),\n                                    (\"<time-of-day> sharp\", -3.3063632789913164),\n                                    (\"hour\", -1.1413995638733185), (\"minute\", -1.7557658665801497)],\n                               n = 92},\n                   koData =\n                     ClassData{prior = -1.5125880864441827, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.7817005779013904),\n                                    (\"hour\", -0.7817005779013904)],\n                               n = 26}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"L\\248rdag\", -2.3978952727983707),\n                                    (\"S\\248ndag\", -2.3978952727983707),\n                                    (\"Mandag\", -1.7047480922384253), (\"day\", -0.8938178760220964),\n                                    (\"Onsdag\", -2.3978952727983707),\n                                    (\"Fredag\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3272129112084162, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"L\\248rdag\", -3.2188758248682006),\n                                    (\"on <date>\", -3.624340932976365),\n                                    (\"Mandag\", -3.624340932976365),\n                                    (\"Torsdag\", -2.2380465718564744),\n                                    (\"the <day-of-month> (non ordinal)\", -3.2188758248682006),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -2.2380465718564744),\n                                    (\"day\", -0.8517522107365838),\n                                    (\"the <day-of-month> (ordinal)\", -3.624340932976365),\n                                    (\"<day-of-month> (ordinal)\", -1.91959284073794)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -1.276293465905562, unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"on <date>\", -2.512305623976115),\n                                    (\"year (latent)\", -2.917770732084279),\n                                    (\"time-of-day (latent)\", -1.3083328196501787),\n                                    (\"year\", -2.917770732084279), (\"hour\", -1.126011262856224)],\n                               n = 12}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -0.13005312824819779,\n                               unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -2.1041341542702074,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.2039728043259361),\n                                    (\"hh:mmhh:mm\", -1.2039728043259361),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0986122886681098),\n                                    (\"minutehour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7047480922384253),\n                                    (\"minuteminute\", -1.2992829841302609),\n                                    (\"hh:mmhh:mm\", -1.2992829841302609),\n                                    (\"minutehour\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.5040773967762742),\n                                    (\"minuteminute\", -1.5040773967762742),\n                                    (\"minutehour\", -1.5040773967762742),\n                                    (\"hh:mmintersect\", -1.5040773967762742)],\n                               n = 2}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -1.252762968495368),\n                                    (\"integer (0..19)minute (grain)\", -1.252762968495368),\n                                    (\"minute\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Juli\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"November\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"dd/m\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.252762968495368),\n                                    (\"quarter\", -0.8472978603872037),\n                                    (\"ordinals (first..31st)quarter (grain)\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.252762968495368),\n                                    (\"quarter\", -0.8472978603872037),\n                                    (\"ordinals (first..31st)quarter (grain)\", -1.252762968495368)],\n                               n = 2}}),\n       (\"Last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.3305637999350466, unseen = -6.156978985585555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Onsdagthis <cycle>\", -5.461710913456472),\n                                    (\"Torsdag<time> timezone\", -3.9576335166801986),\n                                    (\"<datetime> - <datetime> (interval)on <date>\",\n                                     -4.363098624788362),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -4.363098624788362),\n                                    (\"hourday\", -5.056245805348308),\n                                    (\"dayhour\", -2.2836570831085266),\n                                    (\"daymonth\", -3.1103356562929947),\n                                    (\"monthyear\", -3.3822693717766366),\n                                    (\"Torsdagbetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.056245805348308),\n                                    (\"Mandagon <date>\", -5.056245805348308),\n                                    (\"intersecthh:mm\", -5.461710913456472),\n                                    (\"Torsdagbetween <datetime> and <datetime> (interval)\",\n                                     -5.056245805348308),\n                                    (\"Torsdagat <time-of-day>\", -4.208947944961104),\n                                    (\"on <date>Februar\", -5.056245805348308),\n                                    (\"Marsyear\", -5.056245805348308),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -5.056245805348308),\n                                    (\"Oktoberyear\", -3.8522730010223722),\n                                    (\"on <date>November\", -5.461710913456472),\n                                    (\"Torsdagfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.768563732896527),\n                                    (\"Torsdagfrom <datetime> - <datetime> (interval)\",\n                                     -4.768563732896527),\n                                    (\"Mandagintersect\", -5.056245805348308),\n                                    (\"dd/mat <time-of-day>\", -4.545420181582317),\n                                    (\"last <day-of-week> of <time>year\", -5.056245805348308),\n                                    (\"intersectFebruar\", -5.056245805348308),\n                                    (\"todayat <time-of-day>\", -4.768563732896527),\n                                    (\"dayday\", -3.3216447499602015),\n                                    (\"dd/mmat <time-of-day>\", -4.208947944961104),\n                                    (\"intersect by \\\",\\\"hh:mm\", -4.545420181582317),\n                                    (\"dayyear\", -3.7569628212180475),\n                                    (\"tomorrow<time-of-day> sharp\", -4.208947944961104),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -5.056245805348308),\n                                    (\"the <day-of-month> (ordinal)November\", -5.461710913456472),\n                                    (\"Onsdag<named-month> <day-of-month> (non ordinal)\",\n                                     -5.461710913456472),\n                                    (\"Onsdagthis <time>\", -4.768563732896527),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.363098624788362),\n                                    (\"tomorrowuntil <time-of-day>\", -4.208947944961104),\n                                    (\"S\\248ndag<day-of-month> (non ordinal) <named-month>\",\n                                     -5.461710913456472),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -4.768563732896527),\n                                    (\"the <day-of-month> (ordinal)Februar\", -5.056245805348308),\n                                    (\"after <time-of-day>at <time-of-day>\", -4.208947944961104),\n                                    (\"the <day-of-month> (ordinal)Mars\", -4.545420181582317),\n                                    (\"intersect by \\\",\\\"<day-of-month> (non ordinal) <named-month>\",\n                                     -5.056245805348308),\n                                    (\"Mandagthe <day-of-month> (ordinal)\", -5.461710913456472),\n                                    (\"Mandagthis <cycle>\", -5.461710913456472),\n                                    (\"Tirsdagthis <time>\", -5.056245805348308),\n                                    (\"tomorrowafter <time-of-day>\", -4.208947944961104),\n                                    (\"Tirsdagthis <cycle>\", -5.461710913456472),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -4.545420181582317),\n                                    (\"dayminute\", -2.4659786399024815),\n                                    (\"from <datetime> - <datetime> (interval)on <date>\",\n                                     -4.768563732896527),\n                                    (\"on <date>Mars\", -4.545420181582317),\n                                    (\"<ordinal> <cycle> of <time>year\", -5.056245805348308),\n                                    (\"minuteday\", -2.571339155560308),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.461710913456472),\n                                    (\"yearhh:mm\", -5.461710913456472),\n                                    (\"Onsdagnext <cycle>\", -5.461710913456472),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -5.056245805348308),\n                                    (\"Septemberyear\", -4.545420181582317),\n                                    (\"at <time-of-day>on <date>\", -5.056245805348308),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <date>\",\n                                     -5.461710913456472),\n                                    (\"between <datetime> and <datetime> (interval)on <date>\",\n                                     -5.461710913456472),\n                                    (\"dayweek\", -4.363098624788362),\n                                    (\"weekyear\", -4.545420181582317),\n                                    (\"hh:mmtomorrow\", -3.9576335166801986),\n                                    (\"tomorrowat <time-of-day>\", -3.2104191148499774),\n                                    (\"at <time-of-day>tomorrow\", -4.208947944961104),\n                                    (\"last <cycle> of <time>year\", -4.545420181582317),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -5.056245805348308),\n                                    (\"yearminute\", -5.461710913456472)],\n                               n = 194},\n                   koData =\n                     ClassData{prior = -1.2676886187120435,\n                               unseen = -5.4638318050256105,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -2.463853240590168),\n                                    (\"daymonth\", -2.3240912982150093),\n                                    (\"monthyear\", -3.8501476017100584),\n                                    (\"Mandagon <date>\", -4.7664383335842135),\n                                    (\"Torsdagat <time-of-day>\", -2.894636156682622),\n                                    (\"absorption of , after named dayFebruar\", -4.073291153024268),\n                                    (\"Marsyear\", -4.073291153024268),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -3.5136753650888455),\n                                    (\"OnsdagFebruar\", -4.7664383335842135),\n                                    (\"dd/mat <time-of-day>\", -3.8501476017100584),\n                                    (\"absorption of , after named dayJuli\", -4.360973225476049),\n                                    (\"dd/mmat <time-of-day>\", -3.5136753650888455),\n                                    (\"hourhour\", -3.1570004211501135),\n                                    (\"dayyear\", -3.5136753650888455),\n                                    (\"Onsdagthis <time>\", -3.5136753650888455),\n                                    (\"in|during the <part-of-day>until <time-of-day>\",\n                                     -4.073291153024268),\n                                    (\"Aprilyear\", -4.7664383335842135),\n                                    (\"Tirsdagthis <time>\", -3.8501476017100584),\n                                    (\"until <time-of-day>on <date>\", -4.7664383335842135),\n                                    (\"Torsdaghh:mm\", -4.360973225476049),\n                                    (\"dayminute\", -3.2623609368079394),\n                                    (\"minuteday\", -3.2623609368079394),\n                                    (\"hh:mmon <date>\", -3.380143972464323),\n                                    (\"this <part-of-day>until <time-of-day>\", -4.073291153024268),\n                                    (\"S\\248ndagthis <time>\", -3.8501476017100584),\n                                    (\"tomorrownoon\", -4.360973225476049),\n                                    (\"this <time>until <time-of-day>\", -4.073291153024268),\n                                    (\"Mandagthis <time>\", -4.360973225476049)],\n                               n = 76}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7346010553881064),\n                                    (\"ordinals (first..31st)day (grain)Oktober\",\n                                     -1.7346010553881064),\n                                    (\"ordinals (first..31st)week (grain)intersect\",\n                                     -1.7346010553881064),\n                                    (\"weekmonth\", -1.2237754316221157),\n                                    (\"ordinals (first..31st)week (grain)Oktober\",\n                                     -1.7346010553881064)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"season\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.2512917986064953),\n                                    (\"minuteminute\", -1.3350010667323402),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.2512917986064953),\n                                    (\"hh:mmhh:mm\", -1.3350010667323402),\n                                    (\"hourhour\", -2.2512917986064953),\n                                    (\"minutehour\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.55814461804655),\n                                    (\"minuteminute\", -1.55814461804655),\n                                    (\"minutehour\", -1.55814461804655),\n                                    (\"hh:mmintersect\", -1.55814461804655)],\n                               n = 6}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"month (grain)\", -2.3025850929940455),\n                                    (\"year (grain)\", -2.3025850929940455),\n                                    (\"week (grain)\", -1.6094379124341003),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -2.3025850929940455),\n                                    (\"month\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.3025850929940455),\n                                    (\"minuteminute\", -1.2039728043259361),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -1.2039728043259361),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"minutehour\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0296194171811581),\n                                    (\"minutehour\", -1.0296194171811581)],\n                               n = 4}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"Mandag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..31st)quarter (grain)year\",\n                                     -1.252762968495368),\n                                    (\"quarteryear\", -0.8472978603872037),\n                                    (\"ordinal (digits)quarter (grain)year\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Torsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <cycle> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (grain)christmas eve\", -0.6931471805599453),\n                                    (\"yearday\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a pair\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8938178760220964),\n                                    (\"ordinals (first..31st)TirsdagOktober\", -1.9924301646902063),\n                                    (\"ordinals (first..31st)Onsdagintersect\", -1.4816045409242156),\n                                    (\"ordinals (first..31st)Tirsdagintersect\",\n                                     -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9444616088408514),\n                                    (\"ordinals (first..31st)OnsdagOktober\", -1.2809338454620642),\n                                    (\"ordinals (first..31st)TirsdagSeptember\", -1.791759469228055)],\n                               n = 6}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (first..31st)\",\n        Classifier{okData =\n                     ClassData{prior = -5.129329438755058e-2,\n                               unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -2.995732273553991, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 27},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.845826690498331, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.8109302162163288), (\"evening\", -1.5040773967762742),\n                                    (\"morning\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.17185025692665928, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7221347174331976),\n                                    (\"morning\", -0.7221347174331976)],\n                               n = 16}}),\n       (\"christmas eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)November\", -2.3025850929940455),\n                                    (\"ordinals (first..31st)Mars\", -2.0149030205422647),\n                                    (\"month\", -0.8362480242006186),\n                                    (\"ordinal (digits)Mars\", -1.791759469228055),\n                                    (\"ordinal (digits)Februar\", -2.0149030205422647)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -2.5649493574615367,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..31st)April\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 28}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.3862943611198906),\n                                    (\"hour\", -0.9808292530117262),\n                                    (\"evening\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.750305594399894), (\"morning\", -0.750305594399894)],\n                               n = 16}}),\n       (\"new year's eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (grain)christmas eve\", -0.6931471805599453),\n                                    (\"yearday\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Mother's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.1786549963416462), (\"Mars\", -1.8718021769015913),\n                                    (\"month\", -1.8718021769015913), (\"Onsdag\", -1.8718021769015913),\n                                    (\"Fredag\", -1.466337068793427)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..31st)\", -1.0986122886681098),\n                                    (\"ordinal (digits)\", -0.40546510810816444)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second\", -1.4469189829363254), (\"year\", -2.1400661634962708),\n                                    (\"<integer> <unit-of-duration>\", -1.2237754316221157),\n                                    (\"a <unit-of-duration>\", -1.7346010553881064),\n                                    (\"minute\", -1.7346010553881064)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.5686159179138452),\n                                    (\"year (grain)\", -2.0794415416798357),\n                                    (\"week (grain)\", -1.5686159179138452),\n                                    (\"day\", -2.4849066497880004), (\"quarter\", -2.4849066497880004),\n                                    (\"year\", -2.0794415416798357),\n                                    (\"quarter (grain)\", -2.4849066497880004),\n                                    (\"day (grain)\", -2.4849066497880004)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.6094379124341003),\n                                    (\"day (grain)\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8754687373538999),\n                                    (\"hour\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.3862943611198906),\n                                    (\"hour\", -1.3862943611198906),\n                                    (\"<hour-of-day> half (as relative minutes)\",\n                                     -1.3862943611198906),\n                                    (\"minute\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"christmas days\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6562426236244944, unseen = -4.276666119016055,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -1.4184634991956413e-2)],\n                               n = 69},\n                   koData =\n                     ClassData{prior = -0.731466044862082, unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.23841102344499823),\n                                    (\"integer (0..19)\", -1.550597412411167)],\n                               n = 64}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.43286408229627876,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -1.0459685551826876, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 13}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8266785731844679),\n                                    (\"S\\248ndagMars\", -1.6739764335716716),\n                                    (\"S\\248ndagintersect\", -1.6739764335716716),\n                                    (\"MandagMars\", -1.6739764335716716)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.579818495252942, unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.466214516775848),\n                                    (\"integer (0..19)year (grain)\", -3.5648268054439574),\n                                    (\"integer (numeric)day (grain)\", -2.871679624884012),\n                                    (\"integer (0..19)hour (grain)\", -3.970291913552122),\n                                    (\"second\", -3.2771447329921766),\n                                    (\"integer (numeric)second (grain)\", -3.970291913552122),\n                                    (\"a pairhour (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)year (grain)\", -3.5648268054439574),\n                                    (\"day\", -2.2655438213136967), (\"year\", -3.054001181677967),\n                                    (\"integer (numeric)week (grain)\", -3.2771447329921766),\n                                    (\"integer (0..19)month (grain)\", -3.970291913552122),\n                                    (\"integer (0..19)second (grain)\", -3.5648268054439574),\n                                    (\"hour\", -2.871679624884012), (\"month\", -3.5648268054439574),\n                                    (\"integer (numeric)minute (grain)\", -2.717528945056754),\n                                    (\"integer (0..19)minute (grain)\", -3.054001181677967),\n                                    (\"integer (numeric)month (grain)\", -3.970291913552122),\n                                    (\"minute\", -2.2655438213136967),\n                                    (\"integer (numeric)hour (grain)\", -3.2771447329921766),\n                                    (\"integer (0..19)day (grain)\", -2.871679624884012),\n                                    (\"integer (0..19)week (grain)\", -2.871679624884012)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -0.8209805520698302, unseen = -4.48863636973214,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6855773452501515),\n                                    (\"integer (0..19)year (grain)\", -3.378724525810097),\n                                    (\"integer (numeric)day (grain)\", -3.0910424533583156),\n                                    (\"integer (0..19)hour (grain)\", -3.784189633918261),\n                                    (\"second\", -2.867898902044106),\n                                    (\"integer (numeric)second (grain)\", -3.378724525810097),\n                                    (\"integer (numeric)year (grain)\", -3.0910424533583156),\n                                    (\"day\", -2.6855773452501515), (\"year\", -2.6855773452501515),\n                                    (\"integer (numeric)week (grain)\", -3.378724525810097),\n                                    (\"integer (0..19)month (grain)\", -3.0910424533583156),\n                                    (\"integer (0..19)second (grain)\", -3.378724525810097),\n                                    (\"hour\", -2.6855773452501515), (\"month\", -2.6855773452501515),\n                                    (\"integer (numeric)minute (grain)\", -3.378724525810097),\n                                    (\"integer (0..19)minute (grain)\", -3.378724525810097),\n                                    (\"integer (numeric)month (grain)\", -3.378724525810097),\n                                    (\"minute\", -2.867898902044106),\n                                    (\"integer (numeric)hour (grain)\", -2.867898902044106),\n                                    (\"integer (0..19)day (grain)\", -3.378724525810097),\n                                    (\"integer (0..19)week (grain)\", -3.0910424533583156)],\n                               n = 33}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"a <unit-of-duration>christmas eve\", -1.0986122886681098),\n                                    (\"yearday\", -0.8109302162163288),\n                                    (\"<integer> <unit-of-duration>christmas eve\",\n                                     -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"integer (numeric)time-of-day (latent)\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Oktober\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.367123614131617),\n                                    (\"year (grain)\", -2.367123614131617),\n                                    (\"second\", -1.8562979903656263),\n                                    (\"week (grain)\", -2.367123614131617),\n                                    (\"day\", -2.772588722239781),\n                                    (\"minute (grain)\", -2.367123614131617),\n                                    (\"year\", -2.367123614131617),\n                                    (\"second (grain)\", -1.8562979903656263),\n                                    (\"minute\", -2.367123614131617),\n                                    (\"day (grain)\", -2.772588722239781)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.1590646946296874, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"L\\248rdag<day-of-month> (non ordinal) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"intersect by \\\",\\\"year\", -3.8066624897703196),\n                                    (\"hh:mmintersect by \\\",\\\"\", -3.8066624897703196),\n                                    (\"dayday\", -2.1019143975318944),\n                                    (\"dayyear\", -2.890371757896165),\n                                    (\"at <time-of-day>L\\248rdag\", -3.8066624897703196),\n                                    (\"<named-month> <day-of-month> (non ordinal)intersect\",\n                                     -3.8066624897703196),\n                                    (\"hh:mmL\\248rdag\", -3.8066624897703196),\n                                    (\"Onsdag<named-month> <day-of-month> (non ordinal)\",\n                                     -3.8066624897703196),\n                                    (\"Fredagintersect by \\\",\\\"\", -3.4011973816621555),\n                                    (\"S\\248ndag<day-of-month> (non ordinal) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"intersect by \\\",\\\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.4011973816621555),\n                                    (\"hh:mmintersect\", -3.8066624897703196),\n                                    (\"intersect by \\\",\\\"intersect\", -3.8066624897703196),\n                                    (\"at <time-of-day>intersect\", -3.8066624897703196),\n                                    (\"dayminute\", -2.70805020110221),\n                                    (\"intersectyear\", -3.8066624897703196),\n                                    (\"minuteday\", -2.1019143975318944),\n                                    (\"<named-month> <day-of-month> (non ordinal)Fredag\",\n                                     -3.8066624897703196),\n                                    (\"Fredag<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4011973816621555),\n                                    (\"hh:mmabsorption of , after named day\", -3.8066624897703196),\n                                    (\"at <time-of-day>intersect by \\\",\\\"\", -3.8066624897703196),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -3.8066624897703196),\n                                    (\"intersectintersect\", -3.8066624897703196),\n                                    (\"Fredagintersect\", -3.8066624897703196),\n                                    (\"Mandag<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4011973816621555),\n                                    (\"Mandag<day-of-month> (non ordinal) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -3.4011973816621555)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -1.916922612182061, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.9459101490553135),\n                                    (\"OnsdagFebruar\", -3.044522437723423),\n                                    (\"MandagFebruar\", -2.639057329615259),\n                                    (\"FredagJuli\", -2.639057329615259)],\n                               n = 5}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -3.390155167568134e-2, unseen = -4.0943445622221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 58},\n                   koData =\n                     ClassData{prior = -3.4011973816621555,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> sharp\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.349926716949016),\n                                    (\"time-of-day (latent)\", -1.349926716949016),\n                                    (\"hour\", -0.7308875085427924)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mars\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Februar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -1.0116009116784799, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"OnsdagOktober\", -2.2335922215070942),\n                                    (\"TirsdagOktober\", -2.2335922215070942),\n                                    (\"S\\248ndaglast <cycle>\", -2.639057329615259),\n                                    (\"Onsdagintersect\", -2.2335922215070942),\n                                    (\"Onsdagnext <cycle>\", -2.639057329615259),\n                                    (\"dayweek\", -2.2335922215070942)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9808292530117262),\n                                    (\"OnsdagOktober\", -2.5902671654458267),\n                                    (\"Tirsdagintersect\", -2.5902671654458267),\n                                    (\"TirsdagSeptember\", -2.5902671654458267),\n                                    (\"S\\248ndagMars\", -2.5902671654458267),\n                                    (\"S\\248ndagintersect\", -2.5902671654458267),\n                                    (\"Onsdagintersect\", -2.5902671654458267),\n                                    (\"MandagMars\", -2.5902671654458267)],\n                               n = 14}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.580450375560848), (\"day\", -1.916922612182061),\n                                    (\"year\", -2.4277482359480516),\n                                    (\"<integer> <unit-of-duration>\", -0.8873031950009028),\n                                    (\"a <unit-of-duration>\", -2.833213344056216),\n                                    (\"month\", -2.4277482359480516)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.6739764335716716, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"S\\248ndag\", -1.8971199848858813),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.8971199848858813),\n                                    (\"Tirsdag\", -1.8971199848858813),\n                                    (\"week-end\", -1.8971199848858813)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.2076393647782445, unseen = -4.110873864173311,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"S\\248ndag\", -2.995732273553991),\n                                    (\"Mandag\", -2.995732273553991), (\"day\", -1.8971199848858813),\n                                    (\"time-of-day (latent)\", -1.1499055830556604),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\", -2.4849066497880004),\n                                    (\"hour\", -1.1499055830556604)],\n                               n = 26}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..31st)\", -1.0986122886681098),\n                                    (\"ordinal (digits)\", -0.40546510810816444)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -0.8023464725249373),\n                                    (\"hour\", -0.8023464725249373)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.5040773967762742),\n                                    (\"hh:mm\", -1.5040773967762742),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 2}}),\n       (\"<integer> and an half hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"integer (0..19)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mandag\", -2.0149030205422647), (\"day\", -1.3217558399823195),\n                                    (\"Mars\", -2.0149030205422647), (\"month\", -2.0149030205422647),\n                                    (\"Onsdag\", -2.0149030205422647),\n                                    (\"Tirsdag\", -2.0149030205422647)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.3217558399823195), (\"Mars\", -2.0149030205422647),\n                                    (\"month\", -2.0149030205422647), (\"Onsdag\", -2.0149030205422647),\n                                    (\"Fredag\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.7047480922384253),\n                                    (\"month (grain)\", -1.9924301646902063),\n                                    (\"year (grain)\", -1.9924301646902063),\n                                    (\"week (grain)\", -1.7047480922384253),\n                                    (\"year\", -1.9924301646902063), (\"month\", -1.9924301646902063)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"day\", -1.6739764335716716),\n                                    (\"day (grain)\", -1.6739764335716716)],\n                               n = 4}}),\n       (\"Onsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"new year's day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.793208009442517),\n                                    (\"integer (0..19)year (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)day (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)hour (grain)\", -3.1986731175506815),\n                                    (\"second\", -2.793208009442517),\n                                    (\"integer (numeric)second (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)year (grain)\", -3.1986731175506815),\n                                    (\"day\", -2.793208009442517), (\"year\", -2.793208009442517),\n                                    (\"integer (numeric)week (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)month (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)second (grain)\", -3.1986731175506815),\n                                    (\"hour\", -2.793208009442517), (\"month\", -2.793208009442517),\n                                    (\"integer (numeric)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)month (grain)\", -3.1986731175506815),\n                                    (\"minute\", -2.793208009442517),\n                                    (\"integer (numeric)hour (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)day (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)week (grain)\", -3.1986731175506815)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Fredag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.418840607796598,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.0204248861443626),\n                                    (\"<integer> more <unit-of-duration>\", -3.3081069585961433),\n                                    (\"number.number hours\", -3.713572066704308),\n                                    (\"second\", -2.797281334830153), (\"day\", -2.6149597780361984),\n                                    (\"half an hour\", -3.713572066704308),\n                                    (\"<integer> <unit-of-duration>\", -1.3156767939059373),\n                                    (\"a <unit-of-duration>\", -2.46080909820894),\n                                    (\"<integer> and an half hours\", -3.3081069585961433),\n                                    (\"hour\", -2.6149597780361984), (\"minute\", -1.4622802680978126),\n                                    (\"about <duration>\", -3.3081069585961433)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.413693335308005),\n                                    (\"hh:mmhh:mm\", -1.413693335308005),\n                                    (\"dayday\", -1.8191584434161694),\n                                    (\"<day-of-month> (non ordinal) <named-month><day-of-month> (non ordinal) <named-month>\",\n                                     -1.8191584434161694)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.6888794541139363,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Juli<day-of-month> (non ordinal) <named-month>\",\n                                     -2.9704144655697013),\n                                    (\"d/mmyear\", -2.9704144655697013),\n                                    (\"monthday\", -1.8718021769015913),\n                                    (\"minuteminute\", -1.717651497074333),\n                                    (\"hh:mmhh:mm\", -2.9704144655697013),\n                                    (\"dayyear\", -2.277267285009756),\n                                    (\"hh:mmintersect\", -1.8718021769015913),\n                                    (\"August<day-of-month> (non ordinal) <named-month>\",\n                                     -2.0541237336955462),\n                                    (\"dd/mmyear\", -2.5649493574615367)],\n                               n = 14}}),\n       (\"d/mm\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.0794415416798357),\n                                    (\"minuteminute\", -0.9808292530117262),\n                                    (\"hh:mmhh:mm\", -0.9808292530117262),\n                                    (\"minutehour\", -2.0794415416798357)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -0.916290731874155),\n                                    (\"minuteminute\", -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -2.3025850929940455),\n                                    (\"minutehour\", -0.916290731874155)],\n                               n = 8}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.04305126783455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.639057329615259),\n                                    (\"integer (0..19)year (grain)\", -3.332204510175204),\n                                    (\"integer (numeric)day (grain)\", -2.9267394020670396),\n                                    (\"second\", -2.9267394020670396),\n                                    (\"integer (numeric)second (grain)\", -3.332204510175204),\n                                    (\"integer (numeric)year (grain)\", -2.9267394020670396),\n                                    (\"day\", -2.639057329615259), (\"year\", -2.639057329615259),\n                                    (\"integer (numeric)week (grain)\", -3.332204510175204),\n                                    (\"integer (0..19)month (grain)\", -2.9267394020670396),\n                                    (\"integer (0..19)second (grain)\", -3.332204510175204),\n                                    (\"hour\", -2.9267394020670396), (\"month\", -2.639057329615259),\n                                    (\"integer (numeric)minute (grain)\", -3.332204510175204),\n                                    (\"integer (0..19)minute (grain)\", -3.332204510175204),\n                                    (\"integer (numeric)month (grain)\", -3.332204510175204),\n                                    (\"minute\", -2.9267394020670396),\n                                    (\"integer (numeric)hour (grain)\", -2.9267394020670396),\n                                    (\"integer (0..19)day (grain)\", -3.332204510175204),\n                                    (\"integer (0..19)week (grain)\", -2.9267394020670396)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Februarinteger (numeric)\", -1.4271163556401458),\n                                    (\"Aprilinteger (numeric)\", -2.5257286443082556),\n                                    (\"month\", -0.8209805520698302),\n                                    (\"Juliinteger (numeric)\", -1.8325814637483102),\n                                    (\"Novemberinteger (numeric)\", -2.5257286443082556)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -1.252762968495368),\n                                    (\"month\", -1.252762968495368)],\n                               n = 1}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)September\", -3.068052935133617),\n                                    (\"integer (numeric)April\", -3.068052935133617),\n                                    (\"integer (numeric)August\", -1.4586150226995167),\n                                    (\"month\", -0.8167611365271219),\n                                    (\"integer (numeric)Juli\", -2.662587827025453),\n                                    (\"integer (numeric)Februar\", -2.374905754573672),\n                                    (\"integer (numeric)Mars\", -2.662587827025453)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.1786549963416462),\n                                    (\"integer (numeric)Juli\", -1.1786549963416462)],\n                               n = 3}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mandag\", -1.7047480922384253), (\"day\", -1.0116009116784799),\n                                    (\"Onsdag\", -1.7047480922384253),\n                                    (\"Tirsdag\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.0116009116784799), (\"Onsdag\", -1.7047480922384253),\n                                    (\"Fredag\", -1.2992829841302609)],\n                               n = 3}}),\n       (\"<hour-of-day> half (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"about <time-of-day>\", -1.7346010553881064),\n                                    (\"time-of-day (latent)\", -1.041453874828161),\n                                    (\"hour\", -0.7537718023763802)],\n                               n = 7}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7308875085427924, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -0.6567795363890705, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.4816045409242156),\n                                    (\"day (grain)Oktober\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -1.9924301646902063),\n                                    (\"week (grain)September\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..31st)April\", -1.6094379124341003),\n                                    (\"ordinals (first..31st)Mars\", -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)Mars\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tirsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.667706820558076),\n                                    (\"intersect\", -2.0243817644968085),\n                                    (\"tomorrow\", -2.0243817644968085), (\"day\", -2.0243817644968085),\n                                    (\"hour\", -1.1977031913123406)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"this <part-of-day>\", -2.169053700369523),\n                                    (\"christmas eve\", -2.456735772821304),\n                                    (\"in|during the <part-of-day>\", -2.169053700369523),\n                                    (\"day\", -2.456735772821304), (\"hh:mm\", -2.8622008809294686),\n                                    (\"hour\", -1.252762968495368), (\"minute\", -2.8622008809294686),\n                                    (\"this <time>\", -2.169053700369523)],\n                               n = 12}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -4.8790164169432056e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -3.044522437723423, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"dd.mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Juli\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half an hour\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.2685113254635072,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.2188758248682006),\n                                    (\"intersect\", -2.8134107167600364),\n                                    (\"season\", -2.3025850929940455),\n                                    (\"next <cycle>\", -3.2188758248682006),\n                                    (\"day\", -1.9661128563728327),\n                                    (\"christmas days\", -2.8134107167600364),\n                                    (\"Oktober\", -2.8134107167600364), (\"hour\", -1.8325814637483102),\n                                    (\"evening\", -3.2188758248682006),\n                                    (\"month\", -2.3025850929940455),\n                                    (\"morning\", -2.8134107167600364),\n                                    (\"week-end\", -2.3025850929940455)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -0.33024168687057687,\n                               unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"September\", -3.054001181677967),\n                                    (\"intersect\", -2.0984897366505306),\n                                    (\"Oktober\", -2.2655438213136967), (\"Mars\", -3.054001181677967),\n                                    (\"hour\", -1.8302257500558512), (\"month\", -1.2294518896269209),\n                                    (\"morning\", -1.8302257500558512)],\n                               n = 46}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1733}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.NE_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.NL_BE (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Kerstmis\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.6094379124341003),\n                                    (\"hh:mm\", -1.2039728043259361), (\"hour\", -1.6094379124341003),\n                                    (\"minute\", -1.2039728043259361)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6300464741920015, unseen = -4.948759890378168,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 139},\n                   koData =\n                     ClassData{prior = -0.7604993625894368, unseen = -4.820281565605037,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 122}}),\n       (\"exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.252762968495368),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.55814461804655), (\"day\", -1.845826690498331),\n                                    (\"year\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"month\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -5.030437921392435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.077970371790963),\n                                    (\"until <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"dayhour\", -2.9444389791664407),\n                                    (\"todayevening\", -4.330733340286331),\n                                    (\"on <date>evening\", -3.925268232178167),\n                                    (\"thursdaymorning\", -4.330733340286331),\n                                    (\"intersectevening\", -2.384823191231018),\n                                    (\"tomorrowafternoon\", -3.925268232178167),\n                                    (\"half to|till|before <integer> (hour-of-day)afternoon\",\n                                     -4.330733340286331),\n                                    (\"hourhour\", -1.1737329191362178),\n                                    (\"<day-of-month> (non ordinal) <named-month>morning\",\n                                     -3.925268232178167),\n                                    (\"at <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"todayafternoon\", -4.330733340286331),\n                                    (\"<time-of-day>  o'clockafternoon\", -3.2321210516182215),\n                                    (\"<time-of-day>  o'clocknight\", -4.330733340286331),\n                                    (\"until <time-of-day>morning\", -3.925268232178167),\n                                    (\"minutehour\", -2.9444389791664407),\n                                    (\"<time-of-day> am|pmmorning\", -3.925268232178167),\n                                    (\"hh:mmmorning\", -3.925268232178167),\n                                    (\"about <time-of-day>evening\", -4.330733340286331),\n                                    (\"<time-of-day>  o'clockevening\", -3.6375861597263857),\n                                    (\"<hour-of-day> <integer> (as relative minutes)afternoon\",\n                                     -3.925268232178167),\n                                    (\"intersectmorning\", -3.077970371790963),\n                                    (\"about <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"hh:mmafternoon\", -4.330733340286331),\n                                    (\"on <date>morning\", -3.925268232178167),\n                                    (\"at <time-of-day>morning\", -4.330733340286331)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.258096538021482),\n                                    (\"yearhour\", -3.258096538021482),\n                                    (\"intersectevening\", -2.5649493574615367),\n                                    (\"monthhour\", -2.8526314299133175),\n                                    (\"hourhour\", -1.8718021769015913),\n                                    (\"year (latent)afternoon\", -3.258096538021482),\n                                    (\"Februarymorning\", -2.8526314299133175),\n                                    (\"<time-of-day>  o'clockevening\", -3.258096538021482),\n                                    (\"time-of-day (latent)afternoon\", -2.8526314299133175)],\n                               n = 10}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19237189264745613, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.739115735742633),\n                                    (\"half to|till|before <integer> (hour-of-day)\",\n                                     -3.6109179126442243),\n                                    (\"about <time-of-day>\", -2.6946271807700692),\n                                    (\"time-of-day (latent)\", -1.906169820405799),\n                                    (\"hh:mm\", -2.512305623976115), (\"hour\", -1.0082282271998406),\n                                    (\"minute\", -2.2246235515243336),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.6109179126442243)],\n                               n = 33},\n                   koData =\n                     ClassData{prior = -1.742969305058623, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -2.3978952727983707),\n                                    (\"time-of-day (latent)\", -1.1451323043030026),\n                                    (\"hour\", -1.0116009116784799)],\n                               n = 7}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -2.2512917986064953),\n                                    (\"monday\", -1.845826690498331), (\"friday\", -1.55814461804655),\n                                    (\"day\", -0.8649974374866046), (\"sunday\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -3.2771447329921766),\n                                    (\"<time> <part-of-day>\", -3.054001181677967),\n                                    (\"dd/mm\", -3.054001181677967), (\"saturday\", -3.970291913552122),\n                                    (\"intersect\", -1.367602228107738),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -3.970291913552122),\n                                    (\"friday\", -3.970291913552122), (\"day\", -1.8302257500558512),\n                                    (\"hh:mm\", -3.970291913552122),\n                                    (\"<day-of-month> (ordinal)\", -3.2771447329921766),\n                                    (\"hour\", -1.8302257500558512),\n                                    (\"<datetime> - <datetime> (interval)\", -3.970291913552122),\n                                    (\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.970291913552122),\n                                    (\"minute\", -1.955388893009857)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.5257286443082556,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.7047480922384253),\n                                    (\"day\", -2.3978952727983707),\n                                    (\"<day-of-month> (ordinal)\", -2.3978952727983707),\n                                    (\"hour\", -1.9924301646902063), (\"minute\", -2.3978952727983707)],\n                               n = 4}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -5.5569851154810765e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 35},\n                   koData =\n                     ClassData{prior = -2.917770732084279, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on a named-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -1.252762968495368),\n                                    (\"saturday\", -1.9459101490553135),\n                                    (\"friday\", -1.9459101490553135), (\"day\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday/tomorrow night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day>  o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -0.14107859825990549,\n                               unseen = -4.955827057601261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"exactly <time-of-day>\", -4.255612709818223),\n                                    (\"at <time-of-day>\", -2.3838105329166317),\n                                    (\"about <time-of-day>\", -2.8693183486983322),\n                                    (\"time-of-day (latent)\", -1.259880436264232),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -4.255612709818223),\n                                    (\"until <time-of-day>\", -3.339321977944068),\n                                    (\"hour\", -0.7591051483517427), (\"minute\", -4.255612709818223),\n                                    (\"after <time-of-day>\", -3.8501476017100584)],\n                               n = 66},\n                   koData =\n                     ClassData{prior = -2.0281482472922856,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.6741486494265287),\n                                    (\"time-of-day (latent)\", -1.0647107369924282),\n                                    (\"hour\", -0.9694005571881036)],\n                               n = 10}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.40546510810816444),\n                                    (\"integer (0..19)\", -1.0986122886681098)],\n                               n = 4}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.9661128563728327,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.15082288973458366,\n                               unseen = -3.8066624897703196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 43}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1}}),\n       (\"saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.17538912001830978,\n                               unseen = -6.263398262591624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"last <cycle>sunday\", -5.568344503761097),\n                                    (\"Koningsdagyear\", -4.064267106984823),\n                                    (\"hourday\", -4.4697322150929875),\n                                    (\"on a named-day<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month><time-of-day>  o'clock\",\n                                     -5.568344503761097),\n                                    (\"dayhour\", -2.4328502878319473),\n                                    (\"daymonth\", -4.6520537718869415),\n                                    (\"next <cycle>friday\", -5.568344503761097),\n                                    (\"monthyear\", -3.9589065913269965),\n                                    (\"friday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.162879395652933),\n                                    (\"yearhour\", -5.568344503761097),\n                                    (\"intersect<time-of-day>  o'clock\", -4.875197323201151),\n                                    (\"tuesdaythis <cycle>\", -5.568344503761097),\n                                    (\"on a named-dayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"saturday<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"absorption of , after named daydd/mm/yyyy\",\n                                     -5.162879395652933),\n                                    (\"<time-of-day> am|pmintersect\", -5.568344503761097),\n                                    (\"intersect<time> <part-of-day>\", -4.875197323201151),\n                                    (\"Marchyear\", -5.568344503761097),\n                                    (\"saturdayat <time-of-day>\", -5.162879395652933),\n                                    (\"saturday<time> <part-of-day>\", -5.162879395652933),\n                                    (\"dd/mm<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"on a named-dayat <time-of-day>\", -4.875197323201151),\n                                    (\"today<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"at <time-of-day>on a named-day\", -5.568344503761097),\n                                    (\"on a named-daybetween <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"intersect by ','year\", -5.568344503761097),\n                                    (\"on <date><time-of-day>  o'clock\", -4.875197323201151),\n                                    (\"next <cycle>monday\", -5.568344503761097),\n                                    (\"on a named-daybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"exactly <time-of-day>tomorrow\", -5.568344503761097),\n                                    (\"on a named-day<time> <part-of-day>\", -5.162879395652933),\n                                    (\"monthhour\", -4.6520537718869415),\n                                    (\"on <date>between <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"last <day-of-week> of <time>year\", -5.568344503761097),\n                                    (\"on a named-day<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"next <cycle>March\", -5.568344503761097),\n                                    (\"todayat <time-of-day>\", -4.875197323201151),\n                                    (\"on <date>between <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"on <date>at <time-of-day>\", -4.875197323201151),\n                                    (\"thursday<time> timezone\", -5.162879395652933),\n                                    (\"on <date>about <time-of-day>\", -4.875197323201151),\n                                    (\"dayday\", -3.265759410767051),\n                                    (\"on <date><time> <part-of-day>\", -4.6520537718869415),\n                                    (\"dd/mmabout <time-of-day>\", -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)intersect\", -5.568344503761097),\n                                    (\"hourhour\", -4.4697322150929875),\n                                    (\"saturday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"thursdayat <time-of-day>\", -5.568344503761097),\n                                    (\"today/tomorrow/yesterday afternoon<hour-of-day> <integer> (as relative minutes)\",\n                                     -5.162879395652933),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -4.4697322150929875),\n                                    (\"dayyear\", -3.1704492309627264),\n                                    (\"tuesdayafter <duration>\", -5.568344503761097),\n                                    (\"tomorrow<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"<time-of-day>  o'clocktomorrow\", -4.875197323201151),\n                                    (\"<day-of-month> (non ordinal) <named-month>intersect\",\n                                     -5.568344503761097),\n                                    (\"thursdaybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"thursdaybetween <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (ordinal)tuesday\", -5.568344503761097),\n                                    (\"hourminute\", -4.875197323201151),\n                                    (\"thursdayhh:mm\", -5.568344503761097),\n                                    (\"this <cycle>wednesday\", -5.568344503761097),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month><time> <part-of-day>\",\n                                     -5.162879395652933),\n                                    (\"on <date><day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"Aprilabout <time-of-day>\", -5.568344503761097),\n                                    (\"thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)February\", -5.568344503761097),\n                                    (\"thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.3155815352657285),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -4.6520537718869415),\n                                    (\"today/tomorrow/yesterday evening<time-of-day>  o'clock\",\n                                     -5.568344503761097),\n                                    (\"fridayintersect\", -4.875197323201151),\n                                    (\"on <date><time-of-day> - <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"on <date><datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"this <cycle>monday\", -5.568344503761097),\n                                    (\"April<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"next <cycle>wednesday\", -5.568344503761097),\n                                    (\"hh:mmintersect\", -5.162879395652933),\n                                    (\"thursday<datetime> - <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)July\", -5.568344503761097),\n                                    (\"thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"yearmonth\", -5.568344503761097),\n                                    (\"at <time-of-day>intersect\", -5.162879395652933),\n                                    (\"on <date>from <time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"<time> <part-of-day>from <time-of-day> - <time-of-day> (interval)\",\n                                     -5.568344503761097),\n                                    (\"dayminute\", -2.3902906734131513),\n                                    (\"<time> <part-of-day>from <datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"intersectyear\", -4.875197323201151),\n                                    (\"<time-of-day> am|pmsaturday\", -5.568344503761097),\n                                    (\"<ordinal> <cycle> of <time>year\", -5.568344503761097),\n                                    (\"minuteday\", -3.3711199264248775),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.568344503761097),\n                                    (\"Julyyear\", -5.568344503761097),\n                                    (\"year<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"Octoberyear\", -4.4697322150929875),\n                                    (\"hh:mmon <date>\", -5.162879395652933),\n                                    (\"today/tomorrow/yesterday afternoonat <time-of-day>\",\n                                     -5.568344503761097),\n                                    (\"tuesdayin <duration>\", -5.568344503761097),\n                                    (\"Septemberyear\", -5.162879395652933),\n                                    (\"at <time-of-day>on <date>\", -5.162879395652933),\n                                    (\"absorption of , after named daydd/mm\", -5.162879395652933),\n                                    (\"intersectintersect\", -5.568344503761097),\n                                    (\"hh:mmon a named-day\", -5.568344503761097),\n                                    (\"weekday\", -4.182050142641207),\n                                    (\"dayweek\", -4.875197323201151),\n                                    (\"weekyear\", -5.162879395652933),\n                                    (\"on <date>February\", -5.568344503761097),\n                                    (\"Kerstmisyear\", -5.568344503761097),\n                                    (\"<month> dd-dd (interval)year\", -5.568344503761097),\n                                    (\"tomorrowat <time-of-day>\", -5.162879395652933),\n                                    (\"next <cycle>tuesday\", -5.568344503761097),\n                                    (\"monday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"at <time-of-day>tomorrow\", -5.568344503761097),\n                                    (\"monday<named-month> <day-of-month> (non ordinal)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month>about <time-of-day>\",\n                                     -5.568344503761097),\n                                    (\"on a named-day<time-of-day> - <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"today/tomorrow/yesterday eveningat <time-of-day>\",\n                                     -5.162879395652933),\n                                    (\"last <cycle> of <time>year\", -5.162879395652933),\n                                    (\"on a named-day<datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.6520537718869415),\n                                    (\"April<time> <part-of-day>\", -5.162879395652933)],\n                               n = 193},\n                   koData =\n                     ClassData{prior = -1.827161396278971, unseen = -5.3612921657094255,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.2771447329921766),\n                                    (\"on a named-dayafter <time-of-day>\", -4.663439094112067),\n                                    (\"daymonth\", -4.257973986003902),\n                                    (\"monthyear\", -3.5648268054439574),\n                                    (\"yearhour\", -4.663439094112067),\n                                    (\"intersect<time-of-day>  o'clock\", -4.663439094112067),\n                                    (\"<day-of-month> (ordinal)wednesday\", -4.257973986003902),\n                                    (\"Julyintersect\", -4.663439094112067),\n                                    (\"thursdayafter <time-of-day>\", -4.663439094112067),\n                                    (\"intersect<time> <part-of-day>\", -4.663439094112067),\n                                    (\"Marchyear\", -4.663439094112067),\n                                    (\"<day-of-month> (ordinal)year\", -4.663439094112067),\n                                    (\"on a named-dayat <time-of-day>\", -4.663439094112067),\n                                    (\"tuesdayafter <time-of-day>\", -4.663439094112067),\n                                    (\"monthhour\", -3.747148362237912),\n                                    (\"todayat <time-of-day>\", -4.663439094112067),\n                                    (\"on <date>at <time-of-day>\", -4.663439094112067),\n                                    (\"on <date>about <time-of-day>\", -4.663439094112067),\n                                    (\"dayday\", -3.5648268054439574),\n                                    (\"hourhour\", -3.970291913552122),\n                                    (\"thursdayat <time-of-day>\", -4.663439094112067),\n                                    (\"dayyear\", -3.970291913552122),\n                                    (\"<day-of-month> (ordinal)tuesday\", -4.257973986003902),\n                                    (\"thursdayhh:mm\", -4.257973986003902),\n                                    (\"Aprilabout <time-of-day>\", -4.663439094112067),\n                                    (\"Aprilyear\", -4.663439094112067),\n                                    (\"mondayFebruary\", -4.663439094112067),\n                                    (\"yearuntil <time-of-day>\", -4.257973986003902),\n                                    (\"dayminute\", -3.5648268054439574),\n                                    (\"thursday<part-of-day> of <time>\", -4.663439094112067),\n                                    (\"Julyyear\", -4.257973986003902),\n                                    (\"Octoberyear\", -4.663439094112067),\n                                    (\"today/tomorrow/yesterday afternoonat <time-of-day>\",\n                                     -4.257973986003902),\n                                    (\"year<time> <part-of-day>\", -4.663439094112067),\n                                    (\"today/tomorrow/yesterday afternoon<time-of-day>  o'clock\",\n                                     -4.663439094112067),\n                                    (\"yearday\", -4.257973986003902),\n                                    (\"absorption of , after named dayFebruary\", -4.663439094112067),\n                                    (\"<day-of-month> (non ordinal) <named-month>about <time-of-day>\",\n                                     -4.663439094112067),\n                                    (\"after <time-of-day>year\", -4.663439094112067),\n                                    (\"on <date>after <time-of-day>\", -4.663439094112067),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.663439094112067)],\n                               n = 37}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)intersect\",\n                                     -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (first..19th)day (grain)October\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)October\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm/yyyydd/mm\", -2.3513752571634776),\n                                    (\"hh:mmtime-of-day (latent)\", -2.3513752571634776),\n                                    (\"minuteminute\", -2.3513752571634776),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3513752571634776),\n                                    (\"hh:mmhh:mm\", -2.3513752571634776),\n                                    (\"dayday\", -1.9459101490553135),\n                                    (\"dd/mm/yyyydd/mm/yyyy\", -2.3513752571634776),\n                                    (\"hourhour\", -2.3513752571634776),\n                                    (\"minutehour\", -2.3513752571634776)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"dd/mm/yyyytime-of-day (latent)\", -1.8718021769015913)],\n                               n = 1}}),\n       (\"after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.466337068793427),\n                                    (\"month (grain)\", -2.5649493574615367),\n                                    (\"year (grain)\", -2.159484249353372),\n                                    (\"week (grain)\", -1.466337068793427),\n                                    (\"quarter\", -2.5649493574615367), (\"year\", -2.159484249353372),\n                                    (\"month\", -2.5649493574615367),\n                                    (\"quarter (grain)\", -2.5649493574615367)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.6094379124341003),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -1.6094379124341003),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"couple\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinal (digits)quarter (grain)year\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Allerheiligen\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0296194171811581),\n                                    (\"ordinals (first..19th)tuesdayOctober\", -1.9459101490553135),\n                                    (\"ordinals (first..19th)wednesdayintersect\",\n                                     -1.540445040947149),\n                                    (\"ordinals (first..19th)tuesdayintersect\",\n                                     -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0986122886681098),\n                                    (\"ordinals (first..19th)wednesdayOctober\", -1.3862943611198906),\n                                    (\"ordinals (first..19th)tuesdaySeptember\", -1.791759469228055)],\n                               n = 3}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 23},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -0.6931471805599453),\n                                    (\"morningtime-of-day (latent)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Vaderdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number,number uur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037), (\"evening\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.252762968495368),\n                                    (\"ordinal (digits)February\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.53101798043249e-2),\n                                    (\"fractional number\", -2.3978952727983707)],\n                               n = 20}}),\n       (\"Nieuwjaarsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.4816045409242156),\n                                    (\"year (grain)\", -2.3978952727983707),\n                                    (\"week (grain)\", -1.4816045409242156),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"quarter (grain)\", -2.3978952727983707),\n                                    (\"day (grain)\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.4759065198095778),\n                                    (\"time-of-day (latent)\", -1.4759065198095778),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -2.8622008809294686),\n                                    (\"hour\", -0.8472978603872037), (\"minute\", -2.8622008809294686)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2113090936672069),\n                                    (\"integer (0..19)\", -1.7452394535931621)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.35667494393873245),\n                                    (\"integer (0..19)\", -1.6094379124341003),\n                                    (\"couple\", -2.3025850929940455)],\n                               n = 17}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"sundayMarch\", -1.6094379124341003),\n                                    (\"mondayMarch\", -1.6094379124341003),\n                                    (\"sundayintersect\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.207415148516909, unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.315007612992603),\n                                    (\"integer (0..19)year (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)day (grain)\", -2.7850112422383386),\n                                    (\"couplehour (grain)\", -3.7013019741124937),\n                                    (\"integer (0..19)second (grain) \", -3.7013019741124937),\n                                    (\"integer (0..19)hour (grain)\", -3.0081547935525483),\n                                    (\"second\", -3.7013019741124937),\n                                    (\"integer (numeric)year (grain)\", -3.7013019741124937),\n                                    (\"day\", -2.7850112422383386), (\"year\", -3.0081547935525483),\n                                    (\"integer (numeric)week (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)month (grain)\", -3.7013019741124937),\n                                    (\"hour\", -2.6026896854443837), (\"month\", -3.7013019741124937),\n                                    (\"integer (numeric)minute (grain)\", -2.4485390056171257),\n                                    (\"integer (0..19)minute (grain)\", -3.295836866004329),\n                                    (\"minute\", -2.1972245773362196),\n                                    (\"integer (numeric)hour (grain)\", -3.7013019741124937),\n                                    (\"integer (0..19)week (grain)\", -2.6026896854443837)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -0.3552032733272762, unseen = -5.075173815233827,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.6826098411003407),\n                                    (\"integer (0..19)year (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)day (grain)\", -3.6826098411003407),\n                                    (\"integer (0..19)second (grain) \", -4.375757021660286),\n                                    (\"integer (0..19)hour (grain)\", -2.871679624884012),\n                                    (\"second\", -3.6826098411003407),\n                                    (\"integer (numeric)second (grain) \", -3.970291913552122),\n                                    (\"integer (numeric)year (grain)\", -3.970291913552122),\n                                    (\"day\", -3.2771447329921766), (\"year\", -3.459466289786131),\n                                    (\"integer (numeric)week (grain)\", -3.970291913552122),\n                                    (\"integer (0..19)month (grain)\", -3.970291913552122),\n                                    (\"hour\", -1.2402628057311365), (\"month\", -3.459466289786131),\n                                    (\"integer (numeric)minute (grain)\", -3.970291913552122),\n                                    (\"integer (0..19)minute (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)month (grain)\", -3.970291913552122),\n                                    (\"minute\", -3.459466289786131),\n                                    (\"coupleday (grain)\", -4.375757021660286),\n                                    (\"integer (numeric)hour (grain)\", -1.4313180424938456),\n                                    (\"integer (0..19)day (grain)\", -4.375757021660286),\n                                    (\"integer (0..19)week (grain)\", -4.375757021660286)],\n                               n = 68}}),\n       (\"ordinals (first..19th)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.7047480922384253),\n                                    (\"hh:mm\", -1.7047480922384253),\n                                    (\"until <time-of-day>\", -1.7047480922384253),\n                                    (\"hour\", -1.2992829841302609), (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearday\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>Kerstmis\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.5040773967762742),\n                                    (\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>half to|till|before <integer> (hour-of-day)\",\n                                     -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"intersect by ','\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.833213344056216),\n                                    (\"friday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.833213344056216),\n                                    (\"dayday\", -1.128465251817791), (\"dayyear\", -2.833213344056216),\n                                    (\"fridaydd/mm\", -2.4277482359480516),\n                                    (\"fridaydd/mm/yyyy\", -2.4277482359480516),\n                                    (\"fridayintersect\", -2.833213344056216),\n                                    (\"sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -2.833213344056216),\n                                    (\"monday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.4277482359480516),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -2.833213344056216)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.9459101490553135),\n                                    (\"sundayFebruary\", -1.9459101490553135)],\n                               n = 1}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8109302162163288), (\"sunday\", -1.5040773967762742),\n                                    (\"tuesday\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"EOM|End of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2809338454620642,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)\", -0.8472978603872037),\n                                    (\"ordinal (digits)\", -0.5596157879354228)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.325422400434628, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)\", -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"Valentijnsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.327277705584417),\n                                    (\"<time-of-day>  o'clock\", -2.1041341542702074),\n                                    (\"time-of-day (latent)\", -1.9218125974762528),\n                                    (\"<time-of-day> am|pm\", -3.0204248861443626),\n                                    (\"EOM|End of month\", -3.0204248861443626),\n                                    (\"hour\", -1.074514737089049), (\"month\", -3.0204248861443626)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.6026896854443837),\n                                    (\"dd/mm/yyyy\", -2.6026896854443837),\n                                    (\"half to|till|before <integer> (hour-of-day)\",\n                                     -2.1972245773362196),\n                                    (\"day\", -2.1972245773362196), (\"hh:mm\", -1.9095425048844386),\n                                    (\"minute\", -1.5040773967762742)],\n                               n = 7}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.120263536200091), (\"second\", -2.5257286443082556),\n                                    (\"day\", -2.5257286443082556),\n                                    (\"<integer> <unit-of-duration>\", -1.0216512475319814),\n                                    (\"hour\", -1.8325814637483102), (\"minute\", -2.120263536200091),\n                                    (\"<integer> kwartier\", -2.5257286443082556)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time-of-day> until\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -1.8718021769015913),\n                                    (\"monday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"hour\", -1.8718021769015913),\n                                    (\"week-end\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"month (grain)\", -1.9459101490553135),\n                                    (\"year (grain)\", -1.9459101490553135),\n                                    (\"week (grain)\", -1.540445040947149),\n                                    (\"year\", -1.9459101490553135), (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sinterklaas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.1135153092103742),\n                                    (\"integer (0..19)year (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)day (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)second (grain) \", -3.1135153092103742),\n                                    (\"second\", -3.1135153092103742),\n                                    (\"integer (numeric)year (grain)\", -3.1135153092103742),\n                                    (\"day\", -2.4203681286504293), (\"year\", -2.70805020110221),\n                                    (\"integer (numeric)week (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)month (grain)\", -3.1135153092103742),\n                                    (\"hour\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"integer (numeric)minute (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)minute (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)month (grain)\", -3.1135153092103742),\n                                    (\"minute\", -2.70805020110221),\n                                    (\"coupleday (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)hour (grain)\", -2.70805020110221),\n                                    (\"integer (0..19)day (grain)\", -3.1135153092103742)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Koningsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -4.652001563489282e-2,\n                               unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5649493574615367), (\"second\", -3.258096538021482),\n                                    (\"number,number uur\", -3.258096538021482),\n                                    (\"day\", -2.8526314299133175), (\"year\", -3.258096538021482),\n                                    (\"<integer> <unit-of-duration>\", -1.006804739414987),\n                                    (\"hour\", -2.159484249353372),\n                                    (\"<integer> and an half hour\", -3.258096538021482),\n                                    (\"minute\", -1.6486586255873816),\n                                    (\"<integer> kwartier\", -3.258096538021482)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -3.0910424533583156,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"hour\", -1.791759469228055)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2076393647782445,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -2.001480000210124),\n                                    (\"on <date>hh:mm\", -2.917770732084279),\n                                    (\"at <time-of-day>hh:mm\", -2.917770732084279),\n                                    (\"minuteminute\", -1.213022639845854),\n                                    (\"hh:mmhh:mm\", -2.001480000210124),\n                                    (\"dayday\", -2.2246235515243336),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -2.512305623976115),\n                                    (\"dd/mmdd/mm\", -2.917770732084279)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.6739764335716716, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -2.1400661634962708),\n                                    (\"daymonth\", -1.7346010553881064),\n                                    (\"minuteminute\", -2.1400661634962708),\n                                    (\"hh:mmhh:mm\", -2.1400661634962708),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -2.1400661634962708)],\n                               n = 3}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (0..19)\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative minutes to|till|before|after <integer> (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.2992829841302609),\n                                    (\"integer (numeric)half to|till|before <integer> (hour-of-day)\",\n                                     -1.7047480922384253),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.7047480922384253),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.7047480922384253),\n                                    (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7227665977411035),\n                                    (\"at <time-of-day>hh:mm\", -2.639057329615259),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.540445040947149),\n                                    (\"minutehour\", -1.540445040947149),\n                                    (\"at <time-of-day>time-of-day (latent)\", -2.639057329615259)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -1.6739764335716716),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 5}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5902671654458267),\n                                    (\"integer (0..19)year (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)day (grain)\", -2.5902671654458267),\n                                    (\"second\", -2.5902671654458267),\n                                    (\"integer (numeric)second (grain) \", -2.5902671654458267),\n                                    (\"integer (numeric)year (grain)\", -2.995732273553991),\n                                    (\"day\", -2.5902671654458267), (\"year\", -2.5902671654458267),\n                                    (\"integer (numeric)week (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)month (grain)\", -2.995732273553991),\n                                    (\"month\", -2.5902671654458267),\n                                    (\"integer (numeric)minute (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)minute (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)month (grain)\", -2.995732273553991),\n                                    (\"minute\", -2.5902671654458267),\n                                    (\"integer (0..19)week (grain)\", -2.995732273553991)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)tuesdayintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)tuesdayKerstmis\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.749199854809259),\n                                    (\"Aprilinteger (numeric)\", -2.4423470353692043),\n                                    (\"month\", -0.832909122935104),\n                                    (\"Februaryinteger (numeric)\", -1.749199854809259),\n                                    (\"Julyinteger (numeric)\", -2.03688192726104)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2578291093020998,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)September\", -2.639057329615259),\n                                    (\"integer (numeric)April\", -2.639057329615259),\n                                    (\"integer (numeric)August\", -3.044522437723423),\n                                    (\"integer (numeric)February\", -1.6582280766035324),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"integer (numeric)July\", -2.639057329615259),\n                                    (\"integer (numeric)March\", -2.3513752571634776)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -1.4816045409242156,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.0986122886681098),\n                                    (\"integer (numeric)October\", -2.1972245773362196),\n                                    (\"integer (numeric)July\", -1.2809338454620642)],\n                               n = 5}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -1.8718021769015913),\n                                    (\"monday\", -0.9555114450274363), (\"day\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> after\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8109302162163288, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.587786664902119, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9459101490553135),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"week (grain)September\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Oudjaar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.845826690498331),\n                                    (\"<time-of-day>  o'clock\", -1.845826690498331),\n                                    (\"time-of-day (latent)\", -2.2512917986064953),\n                                    (\"hour\", -1.1526795099383855)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Kerstmis\", -1.7346010553881064),\n                                    (\"intersect\", -2.1400661634962708),\n                                    (\"day\", -1.4469189829363254), (\"hh:mm\", -2.1400661634962708),\n                                    (\"minute\", -2.1400661634962708)],\n                               n = 4}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Moederdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.8718021769015913), (\"July\", -0.9555114450274363),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"composite <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hour (grain)<integer> + '\\\"\",\n                                     -0.6931471805599453),\n                                    (\"hourminute\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7537718023763802),\n                                    (\"at <time-of-day>integer (numeric)\", -2.1400661634962708),\n                                    (\"<time-of-day>  o'clockinteger (numeric)\",\n                                     -0.8873031950009028)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> kwartier\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (0..19)\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.2992829841302609), (\"hour\", -1.7047480922384253),\n                                    (\"winter\", -1.7047480922384253),\n                                    (\"week-end\", -1.7047480922384253),\n                                    (\"summer\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1784}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.NL_NL (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Kerstmis\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.6094379124341003),\n                                    (\"hh:mm\", -1.2039728043259361), (\"hour\", -1.6094379124341003),\n                                    (\"minute\", -1.2039728043259361)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6300464741920015, unseen = -4.948759890378168,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 139},\n                   koData =\n                     ClassData{prior = -0.7604993625894368, unseen = -4.820281565605037,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 122}}),\n       (\"exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.252762968495368),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.55814461804655), (\"day\", -1.845826690498331),\n                                    (\"year\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"month\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -5.030437921392435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.077970371790963),\n                                    (\"until <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"dayhour\", -2.9444389791664407),\n                                    (\"todayevening\", -4.330733340286331),\n                                    (\"on <date>evening\", -3.925268232178167),\n                                    (\"thursdaymorning\", -4.330733340286331),\n                                    (\"intersectevening\", -2.384823191231018),\n                                    (\"tomorrowafternoon\", -3.925268232178167),\n                                    (\"half to|till|before <integer> (hour-of-day)afternoon\",\n                                     -4.330733340286331),\n                                    (\"hourhour\", -1.1737329191362178),\n                                    (\"<day-of-month> (non ordinal) <named-month>morning\",\n                                     -3.925268232178167),\n                                    (\"at <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"todayafternoon\", -4.330733340286331),\n                                    (\"<time-of-day>  o'clockafternoon\", -3.2321210516182215),\n                                    (\"<time-of-day>  o'clocknight\", -4.330733340286331),\n                                    (\"until <time-of-day>morning\", -3.925268232178167),\n                                    (\"minutehour\", -2.9444389791664407),\n                                    (\"<time-of-day> am|pmmorning\", -3.925268232178167),\n                                    (\"hh:mmmorning\", -3.925268232178167),\n                                    (\"about <time-of-day>evening\", -4.330733340286331),\n                                    (\"<time-of-day>  o'clockevening\", -3.6375861597263857),\n                                    (\"<hour-of-day> <integer> (as relative minutes)afternoon\",\n                                     -3.925268232178167),\n                                    (\"intersectmorning\", -3.077970371790963),\n                                    (\"about <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"hh:mmafternoon\", -4.330733340286331),\n                                    (\"on <date>morning\", -3.925268232178167),\n                                    (\"at <time-of-day>morning\", -4.330733340286331)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.258096538021482),\n                                    (\"yearhour\", -3.258096538021482),\n                                    (\"intersectevening\", -2.5649493574615367),\n                                    (\"monthhour\", -2.8526314299133175),\n                                    (\"hourhour\", -1.8718021769015913),\n                                    (\"year (latent)afternoon\", -3.258096538021482),\n                                    (\"Februarymorning\", -2.8526314299133175),\n                                    (\"<time-of-day>  o'clockevening\", -3.258096538021482),\n                                    (\"time-of-day (latent)afternoon\", -2.8526314299133175)],\n                               n = 10}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19237189264745613, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.739115735742633),\n                                    (\"half to|till|before <integer> (hour-of-day)\",\n                                     -3.6109179126442243),\n                                    (\"about <time-of-day>\", -2.6946271807700692),\n                                    (\"time-of-day (latent)\", -1.906169820405799),\n                                    (\"hh:mm\", -2.512305623976115), (\"hour\", -1.0082282271998406),\n                                    (\"minute\", -2.2246235515243336),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.6109179126442243)],\n                               n = 33},\n                   koData =\n                     ClassData{prior = -1.742969305058623, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -2.3978952727983707),\n                                    (\"time-of-day (latent)\", -1.1451323043030026),\n                                    (\"hour\", -1.0116009116784799)],\n                               n = 7}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -2.2512917986064953),\n                                    (\"monday\", -1.845826690498331), (\"friday\", -1.55814461804655),\n                                    (\"day\", -0.8649974374866046), (\"sunday\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -3.2771447329921766),\n                                    (\"<time> <part-of-day>\", -3.054001181677967),\n                                    (\"dd/mm\", -3.054001181677967), (\"saturday\", -3.970291913552122),\n                                    (\"intersect\", -1.367602228107738),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -3.970291913552122),\n                                    (\"friday\", -3.970291913552122), (\"day\", -1.8302257500558512),\n                                    (\"hh:mm\", -3.970291913552122),\n                                    (\"<day-of-month> (ordinal)\", -3.2771447329921766),\n                                    (\"hour\", -1.8302257500558512),\n                                    (\"<datetime> - <datetime> (interval)\", -3.970291913552122),\n                                    (\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.970291913552122),\n                                    (\"minute\", -1.955388893009857)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.5257286443082556,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.7047480922384253),\n                                    (\"day\", -2.3978952727983707),\n                                    (\"<day-of-month> (ordinal)\", -2.3978952727983707),\n                                    (\"hour\", -1.9924301646902063), (\"minute\", -2.3978952727983707)],\n                               n = 4}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -5.5569851154810765e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 35},\n                   koData =\n                     ClassData{prior = -2.917770732084279, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on a named-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -1.252762968495368),\n                                    (\"saturday\", -1.9459101490553135),\n                                    (\"friday\", -1.9459101490553135), (\"day\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday/tomorrow night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day>  o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -0.14107859825990549,\n                               unseen = -4.955827057601261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"exactly <time-of-day>\", -4.255612709818223),\n                                    (\"at <time-of-day>\", -2.3838105329166317),\n                                    (\"about <time-of-day>\", -2.8693183486983322),\n                                    (\"time-of-day (latent)\", -1.259880436264232),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -4.255612709818223),\n                                    (\"until <time-of-day>\", -3.339321977944068),\n                                    (\"hour\", -0.7591051483517427), (\"minute\", -4.255612709818223),\n                                    (\"after <time-of-day>\", -3.8501476017100584)],\n                               n = 66},\n                   koData =\n                     ClassData{prior = -2.0281482472922856,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.6741486494265287),\n                                    (\"time-of-day (latent)\", -1.0647107369924282),\n                                    (\"hour\", -0.9694005571881036)],\n                               n = 10}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.40546510810816444),\n                                    (\"integer (0..19)\", -1.0986122886681098)],\n                               n = 4}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.9661128563728327,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.15082288973458366,\n                               unseen = -3.8066624897703196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 43}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1}}),\n       (\"saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.17538912001830978,\n                               unseen = -6.263398262591624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"last <cycle>sunday\", -5.568344503761097),\n                                    (\"Koningsdagyear\", -4.064267106984823),\n                                    (\"hourday\", -4.4697322150929875),\n                                    (\"on a named-day<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month><time-of-day>  o'clock\",\n                                     -5.568344503761097),\n                                    (\"dayhour\", -2.4328502878319473),\n                                    (\"daymonth\", -4.6520537718869415),\n                                    (\"next <cycle>friday\", -5.568344503761097),\n                                    (\"monthyear\", -3.9589065913269965),\n                                    (\"friday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.162879395652933),\n                                    (\"yearhour\", -5.568344503761097),\n                                    (\"intersect<time-of-day>  o'clock\", -4.875197323201151),\n                                    (\"tuesdaythis <cycle>\", -5.568344503761097),\n                                    (\"on a named-dayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"saturday<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"absorption of , after named daydd/mm/yyyy\",\n                                     -5.162879395652933),\n                                    (\"<time-of-day> am|pmintersect\", -5.568344503761097),\n                                    (\"intersect<time> <part-of-day>\", -4.875197323201151),\n                                    (\"Marchyear\", -5.568344503761097),\n                                    (\"saturdayat <time-of-day>\", -5.162879395652933),\n                                    (\"saturday<time> <part-of-day>\", -5.162879395652933),\n                                    (\"dd/mm<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"on a named-dayat <time-of-day>\", -4.875197323201151),\n                                    (\"today<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"at <time-of-day>on a named-day\", -5.568344503761097),\n                                    (\"on a named-daybetween <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"intersect by ','year\", -5.568344503761097),\n                                    (\"on <date><time-of-day>  o'clock\", -4.875197323201151),\n                                    (\"next <cycle>monday\", -5.568344503761097),\n                                    (\"on a named-daybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"exactly <time-of-day>tomorrow\", -5.568344503761097),\n                                    (\"on a named-day<time> <part-of-day>\", -5.162879395652933),\n                                    (\"monthhour\", -4.6520537718869415),\n                                    (\"on <date>between <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"last <day-of-week> of <time>year\", -5.568344503761097),\n                                    (\"on a named-day<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"next <cycle>March\", -5.568344503761097),\n                                    (\"todayat <time-of-day>\", -4.875197323201151),\n                                    (\"on <date>between <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"on <date>at <time-of-day>\", -4.875197323201151),\n                                    (\"thursday<time> timezone\", -5.162879395652933),\n                                    (\"on <date>about <time-of-day>\", -4.875197323201151),\n                                    (\"dayday\", -3.265759410767051),\n                                    (\"on <date><time> <part-of-day>\", -4.6520537718869415),\n                                    (\"dd/mmabout <time-of-day>\", -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)intersect\", -5.568344503761097),\n                                    (\"hourhour\", -4.4697322150929875),\n                                    (\"saturday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"thursdayat <time-of-day>\", -5.568344503761097),\n                                    (\"today/tomorrow/yesterday afternoon<hour-of-day> <integer> (as relative minutes)\",\n                                     -5.162879395652933),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -4.4697322150929875),\n                                    (\"dayyear\", -3.1704492309627264),\n                                    (\"tuesdayafter <duration>\", -5.568344503761097),\n                                    (\"tomorrow<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"<time-of-day>  o'clocktomorrow\", -4.875197323201151),\n                                    (\"<day-of-month> (non ordinal) <named-month>intersect\",\n                                     -5.568344503761097),\n                                    (\"thursdaybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"thursdaybetween <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (ordinal)tuesday\", -5.568344503761097),\n                                    (\"hourminute\", -4.875197323201151),\n                                    (\"thursdayhh:mm\", -5.568344503761097),\n                                    (\"this <cycle>wednesday\", -5.568344503761097),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month><time> <part-of-day>\",\n                                     -5.162879395652933),\n                                    (\"on <date><day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"Aprilabout <time-of-day>\", -5.568344503761097),\n                                    (\"thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)February\", -5.568344503761097),\n                                    (\"thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.3155815352657285),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -4.6520537718869415),\n                                    (\"today/tomorrow/yesterday evening<time-of-day>  o'clock\",\n                                     -5.568344503761097),\n                                    (\"fridayintersect\", -4.875197323201151),\n                                    (\"on <date><time-of-day> - <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"on <date><datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"this <cycle>monday\", -5.568344503761097),\n                                    (\"April<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"next <cycle>wednesday\", -5.568344503761097),\n                                    (\"hh:mmintersect\", -5.162879395652933),\n                                    (\"thursday<datetime> - <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)July\", -5.568344503761097),\n                                    (\"thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"yearmonth\", -5.568344503761097),\n                                    (\"at <time-of-day>intersect\", -5.162879395652933),\n                                    (\"on <date>from <time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"<time> <part-of-day>from <time-of-day> - <time-of-day> (interval)\",\n                                     -5.568344503761097),\n                                    (\"dayminute\", -2.3902906734131513),\n                                    (\"<time> <part-of-day>from <datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"intersectyear\", -4.875197323201151),\n                                    (\"<time-of-day> am|pmsaturday\", -5.568344503761097),\n                                    (\"<ordinal> <cycle> of <time>year\", -5.568344503761097),\n                                    (\"minuteday\", -3.3711199264248775),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.568344503761097),\n                                    (\"Julyyear\", -5.568344503761097),\n                                    (\"year<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"Octoberyear\", -4.4697322150929875),\n                                    (\"hh:mmon <date>\", -5.162879395652933),\n                                    (\"today/tomorrow/yesterday afternoonat <time-of-day>\",\n                                     -5.568344503761097),\n                                    (\"tuesdayin <duration>\", -5.568344503761097),\n                                    (\"Septemberyear\", -5.162879395652933),\n                                    (\"at <time-of-day>on <date>\", -5.162879395652933),\n                                    (\"absorption of , after named daydd/mm\", -5.162879395652933),\n                                    (\"intersectintersect\", -5.568344503761097),\n                                    (\"hh:mmon a named-day\", -5.568344503761097),\n                                    (\"weekday\", -4.182050142641207),\n                                    (\"dayweek\", -4.875197323201151),\n                                    (\"weekyear\", -5.162879395652933),\n                                    (\"on <date>February\", -5.568344503761097),\n                                    (\"Kerstmisyear\", -5.568344503761097),\n                                    (\"<month> dd-dd (interval)year\", -5.568344503761097),\n                                    (\"tomorrowat <time-of-day>\", -5.162879395652933),\n                                    (\"next <cycle>tuesday\", -5.568344503761097),\n                                    (\"monday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"at <time-of-day>tomorrow\", -5.568344503761097),\n                                    (\"monday<named-month> <day-of-month> (non ordinal)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month>about <time-of-day>\",\n                                     -5.568344503761097),\n                                    (\"on a named-day<time-of-day> - <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"today/tomorrow/yesterday eveningat <time-of-day>\",\n                                     -5.162879395652933),\n                                    (\"last <cycle> of <time>year\", -5.162879395652933),\n                                    (\"on a named-day<datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.6520537718869415),\n                                    (\"April<time> <part-of-day>\", -5.162879395652933)],\n                               n = 193},\n                   koData =\n                     ClassData{prior = -1.827161396278971, unseen = -5.3612921657094255,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.2771447329921766),\n                                    (\"on a named-dayafter <time-of-day>\", -4.663439094112067),\n                                    (\"daymonth\", -4.257973986003902),\n                                    (\"monthyear\", -3.5648268054439574),\n                                    (\"yearhour\", -4.663439094112067),\n                                    (\"intersect<time-of-day>  o'clock\", -4.663439094112067),\n                                    (\"<day-of-month> (ordinal)wednesday\", -4.257973986003902),\n                                    (\"Julyintersect\", -4.663439094112067),\n                                    (\"thursdayafter <time-of-day>\", -4.663439094112067),\n                                    (\"intersect<time> <part-of-day>\", -4.663439094112067),\n                                    (\"Marchyear\", -4.663439094112067),\n                                    (\"<day-of-month> (ordinal)year\", -4.663439094112067),\n                                    (\"on a named-dayat <time-of-day>\", -4.663439094112067),\n                                    (\"tuesdayafter <time-of-day>\", -4.663439094112067),\n                                    (\"monthhour\", -3.747148362237912),\n                                    (\"todayat <time-of-day>\", -4.663439094112067),\n                                    (\"on <date>at <time-of-day>\", -4.663439094112067),\n                                    (\"on <date>about <time-of-day>\", -4.663439094112067),\n                                    (\"dayday\", -3.5648268054439574),\n                                    (\"hourhour\", -3.970291913552122),\n                                    (\"thursdayat <time-of-day>\", -4.663439094112067),\n                                    (\"dayyear\", -3.970291913552122),\n                                    (\"<day-of-month> (ordinal)tuesday\", -4.257973986003902),\n                                    (\"thursdayhh:mm\", -4.257973986003902),\n                                    (\"Aprilabout <time-of-day>\", -4.663439094112067),\n                                    (\"Aprilyear\", -4.663439094112067),\n                                    (\"mondayFebruary\", -4.663439094112067),\n                                    (\"yearuntil <time-of-day>\", -4.257973986003902),\n                                    (\"dayminute\", -3.5648268054439574),\n                                    (\"thursday<part-of-day> of <time>\", -4.663439094112067),\n                                    (\"Julyyear\", -4.257973986003902),\n                                    (\"Octoberyear\", -4.663439094112067),\n                                    (\"today/tomorrow/yesterday afternoonat <time-of-day>\",\n                                     -4.257973986003902),\n                                    (\"year<time> <part-of-day>\", -4.663439094112067),\n                                    (\"today/tomorrow/yesterday afternoon<time-of-day>  o'clock\",\n                                     -4.663439094112067),\n                                    (\"yearday\", -4.257973986003902),\n                                    (\"absorption of , after named dayFebruary\", -4.663439094112067),\n                                    (\"<day-of-month> (non ordinal) <named-month>about <time-of-day>\",\n                                     -4.663439094112067),\n                                    (\"after <time-of-day>year\", -4.663439094112067),\n                                    (\"on <date>after <time-of-day>\", -4.663439094112067),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.663439094112067)],\n                               n = 37}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)intersect\",\n                                     -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (first..19th)day (grain)October\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)October\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm/yyyydd/mm\", -2.3513752571634776),\n                                    (\"hh:mmtime-of-day (latent)\", -2.3513752571634776),\n                                    (\"minuteminute\", -2.3513752571634776),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3513752571634776),\n                                    (\"hh:mmhh:mm\", -2.3513752571634776),\n                                    (\"dayday\", -1.9459101490553135),\n                                    (\"dd/mm/yyyydd/mm/yyyy\", -2.3513752571634776),\n                                    (\"hourhour\", -2.3513752571634776),\n                                    (\"minutehour\", -2.3513752571634776)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"dd/mm/yyyytime-of-day (latent)\", -1.8718021769015913)],\n                               n = 1}}),\n       (\"after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.466337068793427),\n                                    (\"month (grain)\", -2.5649493574615367),\n                                    (\"year (grain)\", -2.159484249353372),\n                                    (\"week (grain)\", -1.466337068793427),\n                                    (\"quarter\", -2.5649493574615367), (\"year\", -2.159484249353372),\n                                    (\"month\", -2.5649493574615367),\n                                    (\"quarter (grain)\", -2.5649493574615367)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.6094379124341003),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -1.6094379124341003),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"couple\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinal (digits)quarter (grain)year\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Allerheiligen\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0296194171811581),\n                                    (\"ordinals (first..19th)tuesdayOctober\", -1.9459101490553135),\n                                    (\"ordinals (first..19th)wednesdayintersect\",\n                                     -1.540445040947149),\n                                    (\"ordinals (first..19th)tuesdayintersect\",\n                                     -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0986122886681098),\n                                    (\"ordinals (first..19th)wednesdayOctober\", -1.3862943611198906),\n                                    (\"ordinals (first..19th)tuesdaySeptember\", -1.791759469228055)],\n                               n = 3}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 23},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -0.6931471805599453),\n                                    (\"morningtime-of-day (latent)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Vaderdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number,number uur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037), (\"evening\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.252762968495368),\n                                    (\"ordinal (digits)February\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.53101798043249e-2),\n                                    (\"fractional number\", -2.3978952727983707)],\n                               n = 20}}),\n       (\"Nieuwjaarsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.4816045409242156),\n                                    (\"year (grain)\", -2.3978952727983707),\n                                    (\"week (grain)\", -1.4816045409242156),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"quarter (grain)\", -2.3978952727983707),\n                                    (\"day (grain)\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.4759065198095778),\n                                    (\"time-of-day (latent)\", -1.4759065198095778),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -2.8622008809294686),\n                                    (\"hour\", -0.8472978603872037), (\"minute\", -2.8622008809294686)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2113090936672069),\n                                    (\"integer (0..19)\", -1.7452394535931621)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.35667494393873245),\n                                    (\"integer (0..19)\", -1.6094379124341003),\n                                    (\"couple\", -2.3025850929940455)],\n                               n = 17}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"sundayMarch\", -1.6094379124341003),\n                                    (\"mondayMarch\", -1.6094379124341003),\n                                    (\"sundayintersect\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.207415148516909, unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.315007612992603),\n                                    (\"integer (0..19)year (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)day (grain)\", -2.7850112422383386),\n                                    (\"couplehour (grain)\", -3.7013019741124937),\n                                    (\"integer (0..19)second (grain) \", -3.7013019741124937),\n                                    (\"integer (0..19)hour (grain)\", -3.0081547935525483),\n                                    (\"second\", -3.7013019741124937),\n                                    (\"integer (numeric)year (grain)\", -3.7013019741124937),\n                                    (\"day\", -2.7850112422383386), (\"year\", -3.0081547935525483),\n                                    (\"integer (numeric)week (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)month (grain)\", -3.7013019741124937),\n                                    (\"hour\", -2.6026896854443837), (\"month\", -3.7013019741124937),\n                                    (\"integer (numeric)minute (grain)\", -2.4485390056171257),\n                                    (\"integer (0..19)minute (grain)\", -3.295836866004329),\n                                    (\"minute\", -2.1972245773362196),\n                                    (\"integer (numeric)hour (grain)\", -3.7013019741124937),\n                                    (\"integer (0..19)week (grain)\", -2.6026896854443837)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -0.3552032733272762, unseen = -5.075173815233827,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.6826098411003407),\n                                    (\"integer (0..19)year (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)day (grain)\", -3.6826098411003407),\n                                    (\"integer (0..19)second (grain) \", -4.375757021660286),\n                                    (\"integer (0..19)hour (grain)\", -2.871679624884012),\n                                    (\"second\", -3.6826098411003407),\n                                    (\"integer (numeric)second (grain) \", -3.970291913552122),\n                                    (\"integer (numeric)year (grain)\", -3.970291913552122),\n                                    (\"day\", -3.2771447329921766), (\"year\", -3.459466289786131),\n                                    (\"integer (numeric)week (grain)\", -3.970291913552122),\n                                    (\"integer (0..19)month (grain)\", -3.970291913552122),\n                                    (\"hour\", -1.2402628057311365), (\"month\", -3.459466289786131),\n                                    (\"integer (numeric)minute (grain)\", -3.970291913552122),\n                                    (\"integer (0..19)minute (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)month (grain)\", -3.970291913552122),\n                                    (\"minute\", -3.459466289786131),\n                                    (\"coupleday (grain)\", -4.375757021660286),\n                                    (\"integer (numeric)hour (grain)\", -1.4313180424938456),\n                                    (\"integer (0..19)day (grain)\", -4.375757021660286),\n                                    (\"integer (0..19)week (grain)\", -4.375757021660286)],\n                               n = 68}}),\n       (\"ordinals (first..19th)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.7047480922384253),\n                                    (\"hh:mm\", -1.7047480922384253),\n                                    (\"until <time-of-day>\", -1.7047480922384253),\n                                    (\"hour\", -1.2992829841302609), (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearday\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>Kerstmis\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.5040773967762742),\n                                    (\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>half to|till|before <integer> (hour-of-day)\",\n                                     -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"intersect by ','\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.833213344056216),\n                                    (\"friday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.833213344056216),\n                                    (\"dayday\", -1.128465251817791), (\"dayyear\", -2.833213344056216),\n                                    (\"fridaydd/mm\", -2.4277482359480516),\n                                    (\"fridaydd/mm/yyyy\", -2.4277482359480516),\n                                    (\"fridayintersect\", -2.833213344056216),\n                                    (\"sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -2.833213344056216),\n                                    (\"monday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.4277482359480516),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -2.833213344056216)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.9459101490553135),\n                                    (\"sundayFebruary\", -1.9459101490553135)],\n                               n = 1}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8109302162163288), (\"sunday\", -1.5040773967762742),\n                                    (\"tuesday\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"EOM|End of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2809338454620642,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)\", -0.8472978603872037),\n                                    (\"ordinal (digits)\", -0.5596157879354228)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.325422400434628, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)\", -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"Valentijnsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.327277705584417),\n                                    (\"<time-of-day>  o'clock\", -2.1041341542702074),\n                                    (\"time-of-day (latent)\", -1.9218125974762528),\n                                    (\"<time-of-day> am|pm\", -3.0204248861443626),\n                                    (\"EOM|End of month\", -3.0204248861443626),\n                                    (\"hour\", -1.074514737089049), (\"month\", -3.0204248861443626)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.6026896854443837),\n                                    (\"dd/mm/yyyy\", -2.6026896854443837),\n                                    (\"half to|till|before <integer> (hour-of-day)\",\n                                     -2.1972245773362196),\n                                    (\"day\", -2.1972245773362196), (\"hh:mm\", -1.9095425048844386),\n                                    (\"minute\", -1.5040773967762742)],\n                               n = 7}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.120263536200091), (\"second\", -2.5257286443082556),\n                                    (\"day\", -2.5257286443082556),\n                                    (\"<integer> <unit-of-duration>\", -1.0216512475319814),\n                                    (\"hour\", -1.8325814637483102), (\"minute\", -2.120263536200091),\n                                    (\"<integer> kwartier\", -2.5257286443082556)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time-of-day> until\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -1.8718021769015913),\n                                    (\"monday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"hour\", -1.8718021769015913),\n                                    (\"week-end\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"month (grain)\", -1.9459101490553135),\n                                    (\"year (grain)\", -1.9459101490553135),\n                                    (\"week (grain)\", -1.540445040947149),\n                                    (\"year\", -1.9459101490553135), (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.1135153092103742),\n                                    (\"integer (0..19)year (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)day (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)second (grain) \", -3.1135153092103742),\n                                    (\"second\", -3.1135153092103742),\n                                    (\"integer (numeric)year (grain)\", -3.1135153092103742),\n                                    (\"day\", -2.4203681286504293), (\"year\", -2.70805020110221),\n                                    (\"integer (numeric)week (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)month (grain)\", -3.1135153092103742),\n                                    (\"hour\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"integer (numeric)minute (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)minute (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)month (grain)\", -3.1135153092103742),\n                                    (\"minute\", -2.70805020110221),\n                                    (\"coupleday (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)hour (grain)\", -2.70805020110221),\n                                    (\"integer (0..19)day (grain)\", -3.1135153092103742)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Koningsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -4.652001563489282e-2,\n                               unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5649493574615367), (\"second\", -3.258096538021482),\n                                    (\"number,number uur\", -3.258096538021482),\n                                    (\"day\", -2.8526314299133175), (\"year\", -3.258096538021482),\n                                    (\"<integer> <unit-of-duration>\", -1.006804739414987),\n                                    (\"hour\", -2.159484249353372),\n                                    (\"<integer> and an half hour\", -3.258096538021482),\n                                    (\"minute\", -1.6486586255873816),\n                                    (\"<integer> kwartier\", -3.258096538021482)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -3.0910424533583156,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"hour\", -1.791759469228055)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2076393647782445,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -2.001480000210124),\n                                    (\"on <date>hh:mm\", -2.917770732084279),\n                                    (\"at <time-of-day>hh:mm\", -2.917770732084279),\n                                    (\"minuteminute\", -1.213022639845854),\n                                    (\"hh:mmhh:mm\", -2.001480000210124),\n                                    (\"dayday\", -2.2246235515243336),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -2.512305623976115),\n                                    (\"dd/mmdd/mm\", -2.917770732084279)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.6739764335716716, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -2.1400661634962708),\n                                    (\"daymonth\", -1.7346010553881064),\n                                    (\"minuteminute\", -2.1400661634962708),\n                                    (\"hh:mmhh:mm\", -2.1400661634962708),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -2.1400661634962708)],\n                               n = 3}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (0..19)\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative minutes to|till|before|after <integer> (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.2992829841302609),\n                                    (\"integer (numeric)half to|till|before <integer> (hour-of-day)\",\n                                     -1.7047480922384253),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.7047480922384253),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.7047480922384253),\n                                    (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7227665977411035),\n                                    (\"at <time-of-day>hh:mm\", -2.639057329615259),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.540445040947149),\n                                    (\"minutehour\", -1.540445040947149),\n                                    (\"at <time-of-day>time-of-day (latent)\", -2.639057329615259)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -1.6739764335716716),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 5}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5902671654458267),\n                                    (\"integer (0..19)year (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)day (grain)\", -2.5902671654458267),\n                                    (\"second\", -2.5902671654458267),\n                                    (\"integer (numeric)second (grain) \", -2.5902671654458267),\n                                    (\"integer (numeric)year (grain)\", -2.995732273553991),\n                                    (\"day\", -2.5902671654458267), (\"year\", -2.5902671654458267),\n                                    (\"integer (numeric)week (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)month (grain)\", -2.995732273553991),\n                                    (\"month\", -2.5902671654458267),\n                                    (\"integer (numeric)minute (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)minute (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)month (grain)\", -2.995732273553991),\n                                    (\"minute\", -2.5902671654458267),\n                                    (\"integer (0..19)week (grain)\", -2.995732273553991)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)tuesdayintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)tuesdayKerstmis\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.749199854809259),\n                                    (\"Aprilinteger (numeric)\", -2.4423470353692043),\n                                    (\"month\", -0.832909122935104),\n                                    (\"Februaryinteger (numeric)\", -1.749199854809259),\n                                    (\"Julyinteger (numeric)\", -2.03688192726104)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2578291093020998,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)September\", -2.639057329615259),\n                                    (\"integer (numeric)April\", -2.639057329615259),\n                                    (\"integer (numeric)August\", -3.044522437723423),\n                                    (\"integer (numeric)February\", -1.6582280766035324),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"integer (numeric)July\", -2.639057329615259),\n                                    (\"integer (numeric)March\", -2.3513752571634776)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -1.4816045409242156,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.0986122886681098),\n                                    (\"integer (numeric)October\", -2.1972245773362196),\n                                    (\"integer (numeric)July\", -1.2809338454620642)],\n                               n = 5}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -1.8718021769015913),\n                                    (\"monday\", -0.9555114450274363), (\"day\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> after\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8109302162163288, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.587786664902119, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9459101490553135),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"week (grain)September\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Oudjaar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.845826690498331),\n                                    (\"<time-of-day>  o'clock\", -1.845826690498331),\n                                    (\"time-of-day (latent)\", -2.2512917986064953),\n                                    (\"hour\", -1.1526795099383855)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Kerstmis\", -1.7346010553881064),\n                                    (\"intersect\", -2.1400661634962708),\n                                    (\"day\", -1.4469189829363254), (\"hh:mm\", -2.1400661634962708),\n                                    (\"minute\", -2.1400661634962708)],\n                               n = 4}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Moederdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.8718021769015913), (\"July\", -0.9555114450274363),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"composite <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hour (grain)<integer> + '\\\"\",\n                                     -0.6931471805599453),\n                                    (\"hourminute\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7537718023763802),\n                                    (\"at <time-of-day>integer (numeric)\", -2.1400661634962708),\n                                    (\"<time-of-day>  o'clockinteger (numeric)\",\n                                     -0.8873031950009028)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> kwartier\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (0..19)\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.2992829841302609), (\"hour\", -1.7047480922384253),\n                                    (\"winter\", -1.7047480922384253),\n                                    (\"week-end\", -1.7047480922384253),\n                                    (\"summer\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1777}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.NL_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"Kerstmis\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.6094379124341003),\n                                    (\"hh:mm\", -1.2039728043259361), (\"hour\", -1.6094379124341003),\n                                    (\"minute\", -1.2039728043259361)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6300464741920015, unseen = -4.948759890378168,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 139},\n                   koData =\n                     ClassData{prior = -0.7604993625894368, unseen = -4.820281565605037,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 122}}),\n       (\"exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.252762968495368),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence|ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.55814461804655), (\"day\", -1.845826690498331),\n                                    (\"year\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"month\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -5.030437921392435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.077970371790963),\n                                    (\"until <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"dayhour\", -2.9444389791664407),\n                                    (\"todayevening\", -4.330733340286331),\n                                    (\"on <date>evening\", -3.925268232178167),\n                                    (\"thursdaymorning\", -4.330733340286331),\n                                    (\"intersectevening\", -2.384823191231018),\n                                    (\"tomorrowafternoon\", -3.925268232178167),\n                                    (\"half to|till|before <integer> (hour-of-day)afternoon\",\n                                     -4.330733340286331),\n                                    (\"hourhour\", -1.1737329191362178),\n                                    (\"<day-of-month> (non ordinal) <named-month>morning\",\n                                     -3.925268232178167),\n                                    (\"at <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"todayafternoon\", -4.330733340286331),\n                                    (\"<time-of-day>  o'clockafternoon\", -3.2321210516182215),\n                                    (\"<time-of-day>  o'clocknight\", -4.330733340286331),\n                                    (\"until <time-of-day>morning\", -3.925268232178167),\n                                    (\"minutehour\", -2.9444389791664407),\n                                    (\"<time-of-day> am|pmmorning\", -3.925268232178167),\n                                    (\"hh:mmmorning\", -3.925268232178167),\n                                    (\"about <time-of-day>evening\", -4.330733340286331),\n                                    (\"<time-of-day>  o'clockevening\", -3.6375861597263857),\n                                    (\"<hour-of-day> <integer> (as relative minutes)afternoon\",\n                                     -3.925268232178167),\n                                    (\"intersectmorning\", -3.077970371790963),\n                                    (\"about <time-of-day>afternoon\", -4.330733340286331),\n                                    (\"hh:mmafternoon\", -4.330733340286331),\n                                    (\"on <date>morning\", -3.925268232178167),\n                                    (\"at <time-of-day>morning\", -4.330733340286331)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.258096538021482),\n                                    (\"yearhour\", -3.258096538021482),\n                                    (\"intersectevening\", -2.5649493574615367),\n                                    (\"monthhour\", -2.8526314299133175),\n                                    (\"hourhour\", -1.8718021769015913),\n                                    (\"year (latent)afternoon\", -3.258096538021482),\n                                    (\"Februarymorning\", -2.8526314299133175),\n                                    (\"<time-of-day>  o'clockevening\", -3.258096538021482),\n                                    (\"time-of-day (latent)afternoon\", -2.8526314299133175)],\n                               n = 10}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.19237189264745613, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.739115735742633),\n                                    (\"half to|till|before <integer> (hour-of-day)\",\n                                     -3.6109179126442243),\n                                    (\"about <time-of-day>\", -2.6946271807700692),\n                                    (\"time-of-day (latent)\", -1.906169820405799),\n                                    (\"hh:mm\", -2.512305623976115), (\"hour\", -1.0082282271998406),\n                                    (\"minute\", -2.2246235515243336),\n                                    (\"<hour-of-day> <integer> (as relative minutes)\",\n                                     -3.6109179126442243)],\n                               n = 33},\n                   koData =\n                     ClassData{prior = -1.742969305058623, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -2.3978952727983707),\n                                    (\"time-of-day (latent)\", -1.1451323043030026),\n                                    (\"hour\", -1.0116009116784799)],\n                               n = 7}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -2.2512917986064953),\n                                    (\"monday\", -1.845826690498331), (\"friday\", -1.55814461804655),\n                                    (\"day\", -0.8649974374866046), (\"sunday\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -4.672828834461907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -3.2771447329921766),\n                                    (\"<time> <part-of-day>\", -3.054001181677967),\n                                    (\"dd/mm\", -3.054001181677967), (\"saturday\", -3.970291913552122),\n                                    (\"intersect\", -1.367602228107738),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -3.970291913552122),\n                                    (\"friday\", -3.970291913552122), (\"day\", -1.8302257500558512),\n                                    (\"hh:mm\", -3.970291913552122),\n                                    (\"<day-of-month> (ordinal)\", -3.2771447329921766),\n                                    (\"hour\", -1.8302257500558512),\n                                    (\"<datetime> - <datetime> (interval)\", -3.970291913552122),\n                                    (\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.970291913552122),\n                                    (\"minute\", -1.955388893009857)],\n                               n = 46},\n                   koData =\n                     ClassData{prior = -2.5257286443082556,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.7047480922384253),\n                                    (\"day\", -2.3978952727983707),\n                                    (\"<day-of-month> (ordinal)\", -2.3978952727983707),\n                                    (\"hour\", -1.9924301646902063), (\"minute\", -2.3978952727983707)],\n                               n = 4}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -5.5569851154810765e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 35},\n                   koData =\n                     ClassData{prior = -2.917770732084279, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Halloween\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on a named-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"thursday\", -1.252762968495368),\n                                    (\"saturday\", -1.9459101490553135),\n                                    (\"friday\", -1.9459101490553135), (\"day\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday/tomorrow night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day>  o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -0.14107859825990549,\n                               unseen = -4.955827057601261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"exactly <time-of-day>\", -4.255612709818223),\n                                    (\"at <time-of-day>\", -2.3838105329166317),\n                                    (\"about <time-of-day>\", -2.8693183486983322),\n                                    (\"time-of-day (latent)\", -1.259880436264232),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -4.255612709818223),\n                                    (\"until <time-of-day>\", -3.339321977944068),\n                                    (\"hour\", -0.7591051483517427), (\"minute\", -4.255612709818223),\n                                    (\"after <time-of-day>\", -3.8501476017100584)],\n                               n = 66},\n                   koData =\n                     ClassData{prior = -2.0281482472922856,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.6741486494265287),\n                                    (\"time-of-day (latent)\", -1.0647107369924282),\n                                    (\"hour\", -0.9694005571881036)],\n                               n = 10}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.40546510810816444),\n                                    (\"integer (0..19)\", -1.0986122886681098)],\n                               n = 4}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.9661128563728327,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.15082288973458366,\n                               unseen = -3.8066624897703196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 43}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1}}),\n       (\"saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.17538912001830978,\n                               unseen = -6.263398262591624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"last <cycle>sunday\", -5.568344503761097),\n                                    (\"Koningsdagyear\", -4.064267106984823),\n                                    (\"hourday\", -4.4697322150929875),\n                                    (\"on a named-day<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month><time-of-day>  o'clock\",\n                                     -5.568344503761097),\n                                    (\"dayhour\", -2.4328502878319473),\n                                    (\"daymonth\", -4.6520537718869415),\n                                    (\"next <cycle>friday\", -5.568344503761097),\n                                    (\"monthyear\", -3.9589065913269965),\n                                    (\"friday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.162879395652933),\n                                    (\"yearhour\", -5.568344503761097),\n                                    (\"intersect<time-of-day>  o'clock\", -4.875197323201151),\n                                    (\"tuesdaythis <cycle>\", -5.568344503761097),\n                                    (\"on a named-dayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"saturday<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"absorption of , after named daydd/mm/yyyy\",\n                                     -5.162879395652933),\n                                    (\"<time-of-day> am|pmintersect\", -5.568344503761097),\n                                    (\"intersect<time> <part-of-day>\", -4.875197323201151),\n                                    (\"Marchyear\", -5.568344503761097),\n                                    (\"saturdayat <time-of-day>\", -5.162879395652933),\n                                    (\"saturday<time> <part-of-day>\", -5.162879395652933),\n                                    (\"dd/mm<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"on a named-dayat <time-of-day>\", -4.875197323201151),\n                                    (\"today<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"at <time-of-day>on a named-day\", -5.568344503761097),\n                                    (\"on a named-daybetween <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"intersect by ','year\", -5.568344503761097),\n                                    (\"on <date><time-of-day>  o'clock\", -4.875197323201151),\n                                    (\"next <cycle>monday\", -5.568344503761097),\n                                    (\"on a named-daybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"exactly <time-of-day>tomorrow\", -5.568344503761097),\n                                    (\"on a named-day<time> <part-of-day>\", -5.162879395652933),\n                                    (\"monthhour\", -4.6520537718869415),\n                                    (\"on <date>between <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"last <day-of-week> of <time>year\", -5.568344503761097),\n                                    (\"on a named-day<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"next <cycle>March\", -5.568344503761097),\n                                    (\"todayat <time-of-day>\", -4.875197323201151),\n                                    (\"on <date>between <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"on <date>at <time-of-day>\", -4.875197323201151),\n                                    (\"thursday<time> timezone\", -5.162879395652933),\n                                    (\"on <date>about <time-of-day>\", -4.875197323201151),\n                                    (\"dayday\", -3.265759410767051),\n                                    (\"on <date><time> <part-of-day>\", -4.6520537718869415),\n                                    (\"dd/mmabout <time-of-day>\", -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)intersect\", -5.568344503761097),\n                                    (\"hourhour\", -4.4697322150929875),\n                                    (\"saturday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"thursdayat <time-of-day>\", -5.568344503761097),\n                                    (\"today/tomorrow/yesterday afternoon<hour-of-day> <integer> (as relative minutes)\",\n                                     -5.162879395652933),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -4.4697322150929875),\n                                    (\"dayyear\", -3.1704492309627264),\n                                    (\"tuesdayafter <duration>\", -5.568344503761097),\n                                    (\"tomorrow<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"<time-of-day>  o'clocktomorrow\", -4.875197323201151),\n                                    (\"<day-of-month> (non ordinal) <named-month>intersect\",\n                                     -5.568344503761097),\n                                    (\"thursdaybetween <time-of-day> and <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"thursdaybetween <datetime> and <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (ordinal)tuesday\", -5.568344503761097),\n                                    (\"hourminute\", -4.875197323201151),\n                                    (\"thursdayhh:mm\", -5.568344503761097),\n                                    (\"this <cycle>wednesday\", -5.568344503761097),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month><time> <part-of-day>\",\n                                     -5.162879395652933),\n                                    (\"on <date><day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"Aprilabout <time-of-day>\", -5.568344503761097),\n                                    (\"thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)February\", -5.568344503761097),\n                                    (\"thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.3155815352657285),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -4.6520537718869415),\n                                    (\"today/tomorrow/yesterday evening<time-of-day>  o'clock\",\n                                     -5.568344503761097),\n                                    (\"fridayintersect\", -4.875197323201151),\n                                    (\"on <date><time-of-day> - <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"on <date><datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"this <cycle>monday\", -5.568344503761097),\n                                    (\"April<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"next <cycle>wednesday\", -5.568344503761097),\n                                    (\"hh:mmintersect\", -5.162879395652933),\n                                    (\"thursday<datetime> - <datetime> (interval)\",\n                                     -5.162879395652933),\n                                    (\"<day-of-month> (ordinal)July\", -5.568344503761097),\n                                    (\"thursday<time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"yearmonth\", -5.568344503761097),\n                                    (\"at <time-of-day>intersect\", -5.162879395652933),\n                                    (\"on <date>from <time-of-day> - <time-of-day> (interval)\",\n                                     -4.6520537718869415),\n                                    (\"<time> <part-of-day>from <time-of-day> - <time-of-day> (interval)\",\n                                     -5.568344503761097),\n                                    (\"dayminute\", -2.3902906734131513),\n                                    (\"<time> <part-of-day>from <datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"intersectyear\", -4.875197323201151),\n                                    (\"<time-of-day> am|pmsaturday\", -5.568344503761097),\n                                    (\"<ordinal> <cycle> of <time>year\", -5.568344503761097),\n                                    (\"minuteday\", -3.3711199264248775),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.568344503761097),\n                                    (\"Julyyear\", -5.568344503761097),\n                                    (\"year<time-of-day>  o'clock\", -5.568344503761097),\n                                    (\"Octoberyear\", -4.4697322150929875),\n                                    (\"hh:mmon <date>\", -5.162879395652933),\n                                    (\"today/tomorrow/yesterday afternoonat <time-of-day>\",\n                                     -5.568344503761097),\n                                    (\"tuesdayin <duration>\", -5.568344503761097),\n                                    (\"Septemberyear\", -5.162879395652933),\n                                    (\"at <time-of-day>on <date>\", -5.162879395652933),\n                                    (\"absorption of , after named daydd/mm\", -5.162879395652933),\n                                    (\"intersectintersect\", -5.568344503761097),\n                                    (\"hh:mmon a named-day\", -5.568344503761097),\n                                    (\"weekday\", -4.182050142641207),\n                                    (\"dayweek\", -4.875197323201151),\n                                    (\"weekyear\", -5.162879395652933),\n                                    (\"on <date>February\", -5.568344503761097),\n                                    (\"Kerstmisyear\", -5.568344503761097),\n                                    (\"<month> dd-dd (interval)year\", -5.568344503761097),\n                                    (\"tomorrowat <time-of-day>\", -5.162879395652933),\n                                    (\"next <cycle>tuesday\", -5.568344503761097),\n                                    (\"monday<day-of-month> (non ordinal) <named-month>\",\n                                     -5.568344503761097),\n                                    (\"at <time-of-day>tomorrow\", -5.568344503761097),\n                                    (\"monday<named-month> <day-of-month> (non ordinal)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month>about <time-of-day>\",\n                                     -5.568344503761097),\n                                    (\"on a named-day<time-of-day> - <time-of-day> (interval)\",\n                                     -5.162879395652933),\n                                    (\"today/tomorrow/yesterday eveningat <time-of-day>\",\n                                     -5.162879395652933),\n                                    (\"last <cycle> of <time>year\", -5.162879395652933),\n                                    (\"on a named-day<datetime> - <datetime> (interval)\",\n                                     -5.568344503761097),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.6520537718869415),\n                                    (\"April<time> <part-of-day>\", -5.162879395652933)],\n                               n = 193},\n                   koData =\n                     ClassData{prior = -1.827161396278971, unseen = -5.3612921657094255,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -3.2771447329921766),\n                                    (\"on a named-dayafter <time-of-day>\", -4.663439094112067),\n                                    (\"daymonth\", -4.257973986003902),\n                                    (\"monthyear\", -3.5648268054439574),\n                                    (\"yearhour\", -4.663439094112067),\n                                    (\"intersect<time-of-day>  o'clock\", -4.663439094112067),\n                                    (\"<day-of-month> (ordinal)wednesday\", -4.257973986003902),\n                                    (\"Julyintersect\", -4.663439094112067),\n                                    (\"thursdayafter <time-of-day>\", -4.663439094112067),\n                                    (\"intersect<time> <part-of-day>\", -4.663439094112067),\n                                    (\"Marchyear\", -4.663439094112067),\n                                    (\"<day-of-month> (ordinal)year\", -4.663439094112067),\n                                    (\"on a named-dayat <time-of-day>\", -4.663439094112067),\n                                    (\"tuesdayafter <time-of-day>\", -4.663439094112067),\n                                    (\"monthhour\", -3.747148362237912),\n                                    (\"todayat <time-of-day>\", -4.663439094112067),\n                                    (\"on <date>at <time-of-day>\", -4.663439094112067),\n                                    (\"on <date>about <time-of-day>\", -4.663439094112067),\n                                    (\"dayday\", -3.5648268054439574),\n                                    (\"hourhour\", -3.970291913552122),\n                                    (\"thursdayat <time-of-day>\", -4.663439094112067),\n                                    (\"dayyear\", -3.970291913552122),\n                                    (\"<day-of-month> (ordinal)tuesday\", -4.257973986003902),\n                                    (\"thursdayhh:mm\", -4.257973986003902),\n                                    (\"Aprilabout <time-of-day>\", -4.663439094112067),\n                                    (\"Aprilyear\", -4.663439094112067),\n                                    (\"mondayFebruary\", -4.663439094112067),\n                                    (\"yearuntil <time-of-day>\", -4.257973986003902),\n                                    (\"dayminute\", -3.5648268054439574),\n                                    (\"thursday<part-of-day> of <time>\", -4.663439094112067),\n                                    (\"Julyyear\", -4.257973986003902),\n                                    (\"Octoberyear\", -4.663439094112067),\n                                    (\"today/tomorrow/yesterday afternoonat <time-of-day>\",\n                                     -4.257973986003902),\n                                    (\"year<time> <part-of-day>\", -4.663439094112067),\n                                    (\"today/tomorrow/yesterday afternoon<time-of-day>  o'clock\",\n                                     -4.663439094112067),\n                                    (\"yearday\", -4.257973986003902),\n                                    (\"absorption of , after named dayFebruary\", -4.663439094112067),\n                                    (\"<day-of-month> (non ordinal) <named-month>about <time-of-day>\",\n                                     -4.663439094112067),\n                                    (\"after <time-of-day>year\", -4.663439094112067),\n                                    (\"on <date>after <time-of-day>\", -4.663439094112067),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.663439094112067)],\n                               n = 37}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)intersect\",\n                                     -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"ordinals (first..19th)day (grain)October\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)October\",\n                                     -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm/yyyydd/mm\", -2.3513752571634776),\n                                    (\"hh:mmtime-of-day (latent)\", -2.3513752571634776),\n                                    (\"minuteminute\", -2.3513752571634776),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3513752571634776),\n                                    (\"hh:mmhh:mm\", -2.3513752571634776),\n                                    (\"dayday\", -1.9459101490553135),\n                                    (\"dd/mm/yyyydd/mm/yyyy\", -2.3513752571634776),\n                                    (\"hourhour\", -2.3513752571634776),\n                                    (\"minutehour\", -2.3513752571634776)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.8718021769015913),\n                                    (\"dd/mm/yyyytime-of-day (latent)\", -1.8718021769015913)],\n                               n = 1}}),\n       (\"after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.466337068793427),\n                                    (\"month (grain)\", -2.5649493574615367),\n                                    (\"year (grain)\", -2.159484249353372),\n                                    (\"week (grain)\", -1.466337068793427),\n                                    (\"quarter\", -2.5649493574615367), (\"year\", -2.159484249353372),\n                                    (\"month\", -2.5649493574615367),\n                                    (\"quarter (grain)\", -2.5649493574615367)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.6094379124341003),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -1.6094379124341003),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"couple\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinal (digits)quarter (grain)year\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Allerheiligen\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0296194171811581),\n                                    (\"ordinals (first..19th)tuesdayOctober\", -1.9459101490553135),\n                                    (\"ordinals (first..19th)wednesdayintersect\",\n                                     -1.540445040947149),\n                                    (\"ordinals (first..19th)tuesdayintersect\",\n                                     -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.0986122886681098),\n                                    (\"ordinals (first..19th)wednesdayOctober\", -1.3862943611198906),\n                                    (\"ordinals (first..19th)tuesdaySeptember\", -1.791759469228055)],\n                               n = 3}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 23},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -0.6931471805599453),\n                                    (\"morningtime-of-day (latent)\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Vaderdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number,number uur\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037), (\"evening\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -1.252762968495368),\n                                    (\"ordinal (digits)February\", -1.252762968495368),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.53101798043249e-2),\n                                    (\"fractional number\", -2.3978952727983707)],\n                               n = 20}}),\n       (\"Nieuwjaarsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.4816045409242156),\n                                    (\"year (grain)\", -2.3978952727983707),\n                                    (\"week (grain)\", -1.4816045409242156),\n                                    (\"day\", -2.3978952727983707), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"quarter (grain)\", -2.3978952727983707),\n                                    (\"day (grain)\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.4759065198095778),\n                                    (\"time-of-day (latent)\", -1.4759065198095778),\n                                    (\"quarter after|past <integer> (hour-of-day)\",\n                                     -2.8622008809294686),\n                                    (\"hour\", -0.8472978603872037), (\"minute\", -2.8622008809294686)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.2113090936672069),\n                                    (\"integer (0..19)\", -1.7452394535931621)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.35667494393873245),\n                                    (\"integer (0..19)\", -1.6094379124341003),\n                                    (\"couple\", -2.3025850929940455)],\n                               n = 17}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 5}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"sundayMarch\", -1.6094379124341003),\n                                    (\"mondayMarch\", -1.6094379124341003),\n                                    (\"sundayintersect\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.207415148516909, unseen = -4.406719247264253,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.315007612992603),\n                                    (\"integer (0..19)year (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)day (grain)\", -2.7850112422383386),\n                                    (\"couplehour (grain)\", -3.7013019741124937),\n                                    (\"integer (0..19)second (grain) \", -3.7013019741124937),\n                                    (\"integer (0..19)hour (grain)\", -3.0081547935525483),\n                                    (\"second\", -3.7013019741124937),\n                                    (\"integer (numeric)year (grain)\", -3.7013019741124937),\n                                    (\"day\", -2.7850112422383386), (\"year\", -3.0081547935525483),\n                                    (\"integer (numeric)week (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)month (grain)\", -3.7013019741124937),\n                                    (\"hour\", -2.6026896854443837), (\"month\", -3.7013019741124937),\n                                    (\"integer (numeric)minute (grain)\", -2.4485390056171257),\n                                    (\"integer (0..19)minute (grain)\", -3.295836866004329),\n                                    (\"minute\", -2.1972245773362196),\n                                    (\"integer (numeric)hour (grain)\", -3.7013019741124937),\n                                    (\"integer (0..19)week (grain)\", -2.6026896854443837)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -0.3552032733272762, unseen = -5.075173815233827,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.6826098411003407),\n                                    (\"integer (0..19)year (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)day (grain)\", -3.6826098411003407),\n                                    (\"integer (0..19)second (grain) \", -4.375757021660286),\n                                    (\"integer (0..19)hour (grain)\", -2.871679624884012),\n                                    (\"second\", -3.6826098411003407),\n                                    (\"integer (numeric)second (grain) \", -3.970291913552122),\n                                    (\"integer (numeric)year (grain)\", -3.970291913552122),\n                                    (\"day\", -3.2771447329921766), (\"year\", -3.459466289786131),\n                                    (\"integer (numeric)week (grain)\", -3.970291913552122),\n                                    (\"integer (0..19)month (grain)\", -3.970291913552122),\n                                    (\"hour\", -1.2402628057311365), (\"month\", -3.459466289786131),\n                                    (\"integer (numeric)minute (grain)\", -3.970291913552122),\n                                    (\"integer (0..19)minute (grain)\", -3.970291913552122),\n                                    (\"integer (numeric)month (grain)\", -3.970291913552122),\n                                    (\"minute\", -3.459466289786131),\n                                    (\"coupleday (grain)\", -4.375757021660286),\n                                    (\"integer (numeric)hour (grain)\", -1.4313180424938456),\n                                    (\"integer (0..19)day (grain)\", -4.375757021660286),\n                                    (\"integer (0..19)week (grain)\", -4.375757021660286)],\n                               n = 68}}),\n       (\"ordinals (first..19th)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.7047480922384253),\n                                    (\"hh:mm\", -1.7047480922384253),\n                                    (\"until <time-of-day>\", -1.7047480922384253),\n                                    (\"hour\", -1.2992829841302609), (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearday\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>Kerstmis\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today/tomorrow/yesterday afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6888794541139363,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 38},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.5040773967762742),\n                                    (\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>time-of-day (latent)\",\n                                     -1.3862943611198906),\n                                    (\"minutehour\", -1.3862943611198906),\n                                    (\"<integer> <unit-of-duration>half to|till|before <integer> (hour-of-day)\",\n                                     -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter of an hour\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"intersect by ','\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.833213344056216),\n                                    (\"friday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.833213344056216),\n                                    (\"dayday\", -1.128465251817791), (\"dayyear\", -2.833213344056216),\n                                    (\"fridaydd/mm\", -2.4277482359480516),\n                                    (\"fridaydd/mm/yyyy\", -2.4277482359480516),\n                                    (\"fridayintersect\", -2.833213344056216),\n                                    (\"sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -2.833213344056216),\n                                    (\"monday<day-of-month> (non ordinal) <named-month>\",\n                                     -2.4277482359480516),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -2.833213344056216)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.9459101490553135),\n                                    (\"sundayFebruary\", -1.9459101490553135)],\n                               n = 1}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8109302162163288), (\"sunday\", -1.5040773967762742),\n                                    (\"tuesday\", -1.0986122886681098)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"EOM|End of month\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2809338454620642,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)\", -0.8472978603872037),\n                                    (\"ordinal (digits)\", -0.5596157879354228)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.325422400434628, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)\", -0.6286086594223742),\n                                    (\"ordinal (digits)\", -0.7621400520468967)],\n                               n = 13}}),\n       (\"Valentijnsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.327277705584417),\n                                    (\"<time-of-day>  o'clock\", -2.1041341542702074),\n                                    (\"time-of-day (latent)\", -1.9218125974762528),\n                                    (\"<time-of-day> am|pm\", -3.0204248861443626),\n                                    (\"EOM|End of month\", -3.0204248861443626),\n                                    (\"hour\", -1.074514737089049), (\"month\", -3.0204248861443626)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dd/mm\", -2.6026896854443837),\n                                    (\"dd/mm/yyyy\", -2.6026896854443837),\n                                    (\"half to|till|before <integer> (hour-of-day)\",\n                                     -2.1972245773362196),\n                                    (\"day\", -2.1972245773362196), (\"hh:mm\", -1.9095425048844386),\n                                    (\"minute\", -1.5040773967762742)],\n                               n = 7}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.120263536200091), (\"second\", -2.5257286443082556),\n                                    (\"day\", -2.5257286443082556),\n                                    (\"<integer> <unit-of-duration>\", -1.0216512475319814),\n                                    (\"hour\", -1.8325814637483102), (\"minute\", -2.120263536200091),\n                                    (\"<integer> kwartier\", -2.5257286443082556)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.5040773967762742),\n                                    (\"hour\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time-of-day> until\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -1.8718021769015913),\n                                    (\"monday\", -1.466337068793427), (\"day\", -1.1786549963416462),\n                                    (\"hour\", -1.8718021769015913),\n                                    (\"week-end\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"month (grain)\", -1.9459101490553135),\n                                    (\"year (grain)\", -1.9459101490553135),\n                                    (\"week (grain)\", -1.540445040947149),\n                                    (\"year\", -1.9459101490553135), (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Sinterklaas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.1135153092103742),\n                                    (\"integer (0..19)year (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)day (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)second (grain) \", -3.1135153092103742),\n                                    (\"second\", -3.1135153092103742),\n                                    (\"integer (numeric)year (grain)\", -3.1135153092103742),\n                                    (\"day\", -2.4203681286504293), (\"year\", -2.70805020110221),\n                                    (\"integer (numeric)week (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)month (grain)\", -3.1135153092103742),\n                                    (\"hour\", -2.70805020110221), (\"month\", -2.70805020110221),\n                                    (\"integer (numeric)minute (grain)\", -3.1135153092103742),\n                                    (\"integer (0..19)minute (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)month (grain)\", -3.1135153092103742),\n                                    (\"minute\", -2.70805020110221),\n                                    (\"coupleday (grain)\", -3.1135153092103742),\n                                    (\"integer (numeric)hour (grain)\", -2.70805020110221),\n                                    (\"integer (0..19)day (grain)\", -3.1135153092103742)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"Koningsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -4.652001563489282e-2,\n                               unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5649493574615367), (\"second\", -3.258096538021482),\n                                    (\"number,number uur\", -3.258096538021482),\n                                    (\"day\", -2.8526314299133175), (\"year\", -3.258096538021482),\n                                    (\"<integer> <unit-of-duration>\", -1.006804739414987),\n                                    (\"hour\", -2.159484249353372),\n                                    (\"<integer> and an half hour\", -3.258096538021482),\n                                    (\"minute\", -1.6486586255873816),\n                                    (\"<integer> kwartier\", -3.258096538021482)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -3.0910424533583156,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.791759469228055),\n                                    (\"hour\", -1.791759469228055)],\n                               n = 1}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2076393647782445,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -2.001480000210124),\n                                    (\"on <date>hh:mm\", -2.917770732084279),\n                                    (\"at <time-of-day>hh:mm\", -2.917770732084279),\n                                    (\"minuteminute\", -1.213022639845854),\n                                    (\"hh:mmhh:mm\", -2.001480000210124),\n                                    (\"dayday\", -2.2246235515243336),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -2.512305623976115),\n                                    (\"dd/mmdd/mm\", -2.917770732084279)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -1.6739764335716716, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -2.1400661634962708),\n                                    (\"daymonth\", -1.7346010553881064),\n                                    (\"minuteminute\", -2.1400661634962708),\n                                    (\"hh:mmhh:mm\", -2.1400661634962708),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -2.1400661634962708)],\n                               n = 3}}),\n       (\"<integer> and an half hour\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (0..19)\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative minutes to|till|before|after <integer> (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -1.2992829841302609),\n                                    (\"integer (numeric)half to|till|before <integer> (hour-of-day)\",\n                                     -1.7047480922384253),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.7047480922384253),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.7047480922384253),\n                                    (\"minute\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7227665977411035),\n                                    (\"at <time-of-day>hh:mm\", -2.639057329615259),\n                                    (\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.540445040947149),\n                                    (\"minutehour\", -1.540445040947149),\n                                    (\"at <time-of-day>time-of-day (latent)\", -2.639057329615259)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.3862943611198906),\n                                    (\"minuteminute\", -1.6739764335716716),\n                                    (\"hh:mmhh:mm\", -1.6739764335716716),\n                                    (\"minutehour\", -1.3862943611198906)],\n                               n = 5}}),\n       (\"winter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5902671654458267),\n                                    (\"integer (0..19)year (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)day (grain)\", -2.5902671654458267),\n                                    (\"second\", -2.5902671654458267),\n                                    (\"integer (numeric)second (grain) \", -2.5902671654458267),\n                                    (\"integer (numeric)year (grain)\", -2.995732273553991),\n                                    (\"day\", -2.5902671654458267), (\"year\", -2.5902671654458267),\n                                    (\"integer (numeric)week (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)month (grain)\", -2.995732273553991),\n                                    (\"month\", -2.5902671654458267),\n                                    (\"integer (numeric)minute (grain)\", -2.995732273553991),\n                                    (\"integer (0..19)minute (grain)\", -2.995732273553991),\n                                    (\"integer (numeric)month (grain)\", -2.995732273553991),\n                                    (\"minute\", -2.5902671654458267),\n                                    (\"integer (0..19)week (grain)\", -2.995732273553991)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)tuesdayintersect\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)tuesdayKerstmis\", -0.916290731874155)],\n                               n = 1}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.749199854809259),\n                                    (\"Aprilinteger (numeric)\", -2.4423470353692043),\n                                    (\"month\", -0.832909122935104),\n                                    (\"Februaryinteger (numeric)\", -1.749199854809259),\n                                    (\"Julyinteger (numeric)\", -2.03688192726104)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2578291093020998,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)September\", -2.639057329615259),\n                                    (\"integer (numeric)April\", -2.639057329615259),\n                                    (\"integer (numeric)August\", -3.044522437723423),\n                                    (\"integer (numeric)February\", -1.6582280766035324),\n                                    (\"month\", -0.8472978603872037),\n                                    (\"integer (numeric)July\", -2.639057329615259),\n                                    (\"integer (numeric)March\", -2.3513752571634776)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -1.4816045409242156,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.0986122886681098),\n                                    (\"integer (numeric)October\", -2.1972245773362196),\n                                    (\"integer (numeric)July\", -1.2809338454620642)],\n                               n = 5}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"wednesday\", -1.8718021769015913),\n                                    (\"monday\", -0.9555114450274363), (\"day\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> after\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8109302162163288, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.587786664902119, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9459101490553135),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"week (grain)September\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)July\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Oudjaar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.845826690498331),\n                                    (\"<time-of-day>  o'clock\", -1.845826690498331),\n                                    (\"time-of-day (latent)\", -2.2512917986064953),\n                                    (\"hour\", -1.1526795099383855)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Kerstmis\", -1.7346010553881064),\n                                    (\"intersect\", -2.1400661634962708),\n                                    (\"day\", -1.4469189829363254), (\"hh:mm\", -2.1400661634962708),\n                                    (\"minute\", -2.1400661634962708)],\n                               n = 4}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Moederdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"October\", -1.8718021769015913), (\"July\", -0.9555114450274363),\n                                    (\"month\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"composite <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hour (grain)<integer> + '\\\"\",\n                                     -0.6931471805599453),\n                                    (\"hourminute\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"summer\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7537718023763802),\n                                    (\"at <time-of-day>integer (numeric)\", -2.1400661634962708),\n                                    (\"<time-of-day>  o'clockinteger (numeric)\",\n                                     -0.8873031950009028)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> kwartier\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (0..19)\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.2992829841302609), (\"hour\", -1.7047480922384253),\n                                    (\"winter\", -1.7047480922384253),\n                                    (\"week-end\", -1.7047480922384253),\n                                    (\"summer\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1784}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.PL_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"five\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5658077581833438, unseen = -4.941642422609305,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 138},\n                   koData =\n                     ClassData{prior = -0.8391010931830252, unseen = -4.672828834461907,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 105}}),\n       (\"exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -1.3862943611198906),\n                                    (\"<integer> (latent time-of-day)\", -1.791759469228055),\n                                    (\"hour\", -0.8754687373538999),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.6931471805599453),\n                                    (\"day (grain)yesterday\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Father's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"third ordinalday (grain)October\", -2.5257286443082556),\n                                    (\"daymonth\", -2.120263536200091),\n                                    (\"quarteryear\", -2.5257286443082556),\n                                    (\"third ordinalday (grain)on <date>\", -2.5257286443082556),\n                                    (\"weekmonth\", -1.4271163556401458),\n                                    (\"ordinal (digits)quarter (grain)year\", -2.5257286443082556),\n                                    (\"first ordinalweek (grain)intersect\", -2.120263536200091),\n                                    (\"first ordinalweek (grain)October\", -2.5257286443082556),\n                                    (\"first ordinalweek (grain)on <date>\", -2.120263536200091)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Easter Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"zima\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7922380832041762,\n                               unseen = -4.9344739331306915,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)after <time-of-day>\", -3.828641396489095),\n                                    (\"dayhour\", -2.847812143477369),\n                                    (\"Wednesdayevening|night\", -4.23410650459726),\n                                    (\"<ordinal> (as hour)evening|night\", -2.5293584123588344),\n                                    (\"<ordinal> (as hour)on <date>\", -4.23410650459726),\n                                    (\"yesterdayevening|night\", -4.23410650459726),\n                                    (\"hourhour\", -1.213681618452897),\n                                    (\"after <time-of-day>after <time-of-day>\", -3.828641396489095),\n                                    (\"until <time-of-day>morning\", -3.828641396489095),\n                                    (\"until <time-of-day>after <time-of-day>\", -4.23410650459726),\n                                    (\"minutehour\", -4.23410650459726),\n                                    (\"todayevening|night\", -3.828641396489095),\n                                    (\"at <time-of-day>evening|night\", -4.23410650459726),\n                                    (\"intersecton <date>\", -4.23410650459726),\n                                    (\"<integer> (latent time-of-day)this <part-of-day>\",\n                                     -4.23410650459726),\n                                    (\"hh:mmon <date>\", -4.23410650459726),\n                                    (\"<integer> (latent time-of-day)morning\", -4.23410650459726),\n                                    (\"at <time-of-day>on <date>\", -4.23410650459726),\n                                    (\"intersectmorning\", -2.981343536101891),\n                                    (\"<integer> (latent time-of-day)evening|night\",\n                                     -2.981343536101891),\n                                    (\"from <datetime> - <datetime> (interval)morning\",\n                                     -4.23410650459726),\n                                    (\"from <time-of-day> - <time-of-day> (interval)morning\",\n                                     -4.23410650459726),\n                                    (\"Mondaymorning\", -4.23410650459726),\n                                    (\"on <date>morning\", -4.23410650459726),\n                                    (\"at <time-of-day>morning\", -3.828641396489095),\n                                    (\"tomorrowevening|night\", -3.828641396489095)],\n                               n = 48},\n                   koData =\n                     ClassData{prior = -0.6029960835656478,\n                               unseen = -5.0689042022202315,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)after <time-of-day>\", -4.3694478524670215),\n                                    (\"dayhour\", -2.018072595303544),\n                                    (\"yearhour\", -2.0668627594729756),\n                                    (\"year (latent)on <date>\", -4.3694478524670215),\n                                    (\"<day-of-month> (ordinal)on <date>\", -4.3694478524670215),\n                                    (\"nograinhour\", -3.1166848839716534),\n                                    (\"<time-of-day> - <time-of-day> (interval)morning\",\n                                     -4.3694478524670215),\n                                    (\"<day-of-month> (ordinal)evening|night\", -2.6646997602285962),\n                                    (\"by the end of <time>morning\", -4.3694478524670215),\n                                    (\"year (latent)evening|night\", -3.1166848839716534),\n                                    (\"hourhour\", -2.423537703411708),\n                                    (\"after <time-of-day>after <time-of-day>\", -3.963982744358857),\n                                    (\"<day-of-month> (ordinal)morning\", -3.963982744358857),\n                                    (\"<day-of-month> (ordinal)after <time-of-day>\",\n                                     -3.270835563798912),\n                                    (\"until <time-of-day>morning\", -4.3694478524670215),\n                                    (\"about <time-of-day>after <time-of-day>\", -4.3694478524670215),\n                                    (\"by <time>morning\", -4.3694478524670215),\n                                    (\"<integer> (latent time-of-day)after <time-of-day>\",\n                                     -3.963982744358857),\n                                    (\"<integer> (latent time-of-day)morning\", -3.270835563798912),\n                                    (\"intersectmorning\", -3.270835563798912),\n                                    (\"year (latent)morning\", -2.6646997602285962),\n                                    (\"year (latent)after <time-of-day>\", -3.963982744358857),\n                                    (\"at <time-of-day>after <time-of-day>\", -4.3694478524670215)],\n                               n = 58}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13580154115906176,\n                               unseen = -4.787491742782046,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -1.4832866271072003),\n                                    (\"<integer> (latent time-of-day)\", -2.381228220313159),\n                                    (\"about <time-of-day>\", -4.085976312551584),\n                                    (\"hh:mm\", -3.6805112044434196),\n                                    (\"<time-of-day> rano\", -2.987364023883474),\n                                    (\"hour\", -0.827879774530102),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -2.2942168433235293),\n                                    (\"minute\", -3.169685580677429)],\n                               n = 55},\n                   koData =\n                     ClassData{prior = -2.063693184711697, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -1.8325814637483102),\n                                    (\"<integer> (latent time-of-day)\", -1.8325814637483102),\n                                    (\"relative minutes after|past <integer> (hour-of-day)\",\n                                     -2.5257286443082556),\n                                    (\"hour\", -1.1394342831883648),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -2.5257286443082556),\n                                    (\"minute\", -2.5257286443082556)],\n                               n = 8}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.159484249353372),\n                                    (\"Saturday\", -3.258096538021482),\n                                    (\"Monday\", -1.754019141245208), (\"Friday\", -2.5649493574615367),\n                                    (\"day\", -0.7731898882334817), (\"Sunday\", -2.005333569526114)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"11th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -7.79615414697118e-2,\n                               unseen = -4.543294782270004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9231615807191553),\n                                    (\"Thursday\", -3.4339872044851463),\n                                    (\"<time> <part-of-day>\", -3.8394523125933104),\n                                    (\"September\", -3.4339872044851463),\n                                    (\"October\", -2.5866893440979424),\n                                    (\"intersect\", -2.0476928433652555),\n                                    (\"Saturday\", -3.4339872044851463),\n                                    (\"next <cycle>\", -3.146305132033365),\n                                    (\"half to|till|before <integer> (hour-of-day)\",\n                                     -3.8394523125933104),\n                                    (\"day\", -2.740840023925201), (\"afternoon\", -3.146305132033365),\n                                    (\"this <cycle>\", -2.9231615807191553),\n                                    (\"year\", -3.146305132033365), (\"March\", -3.8394523125933104),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -1.6993861490970399),\n                                    (\"minute\", -3.8394523125933104),\n                                    (\"this <time>\", -3.8394523125933104)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -2.5902671654458267, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -1.8325814637483102), (\"hour\", -1.8325814637483102)],\n                               n = 3}}),\n       (\"8th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Good Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -0.8649974374866046),\n                                    (\"<integer> (latent time-of-day)\", -2.2512917986064953),\n                                    (\"hour\", -0.7472144018302211)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -1.5040773967762742),\n                                    (\"<integer> (latent time-of-day)\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"on a named-day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -1.2992829841302609),\n                                    (\"Saturday\", -1.2992829841302609),\n                                    (\"day\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4989911661189879,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"third ordinalTuesdayon <date>\", -3.2771447329921766),\n                                    (\"daymonth\", -1.4853852637641216),\n                                    (\"dayyear\", -2.0243817644968085),\n                                    (\"second ordinalWednesdayon <date>\", -3.2771447329921766),\n                                    (\"first ordinalWednesdayintersect\", -2.871679624884012),\n                                    (\"first ordinalWednesdayon <date>\", -3.2771447329921766),\n                                    (\"second ordinalWednesdayintersect\", -2.871679624884012),\n                                    (\"third ordinalintersectyear\", -2.871679624884012),\n                                    (\"first ordinalTuesdayon <date>\", -3.2771447329921766),\n                                    (\"first ordinalTuesdayOctober\", -3.2771447329921766),\n                                    (\"first ordinalintersectyear\", -2.871679624884012),\n                                    (\"third ordinalTuesdayintersect\", -2.871679624884012),\n                                    (\"second ordinalintersectyear\", -2.871679624884012)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.9343092373768334,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"third ordinalTuesdaySeptember\", -3.0204248861443626),\n                                    (\"third ordinalTuesdayon <date>\", -3.0204248861443626),\n                                    (\"daymonth\", -1.7676619176489945),\n                                    (\"14th ordinalApril<integer> (latent time-of-day)\",\n                                     -2.6149597780361984),\n                                    (\"monthhour\", -1.9218125974762528),\n                                    (\"second ordinalWednesdayon <date>\", -3.0204248861443626),\n                                    (\"first ordinalWednesdayon <date>\", -3.0204248861443626),\n                                    (\"ordinal (digits)April<integer> (latent time-of-day)\",\n                                     -2.327277705584417),\n                                    (\"second ordinalWednesdayOctober\", -3.0204248861443626),\n                                    (\"first ordinalWednesdayOctober\", -3.0204248861443626)],\n                               n = 11}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> (as hour)\",\n        Classifier{okData =\n                     ClassData{prior = -2.985296314968116e-2,\n                               unseen = -4.454347296253507,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"11th ordinal\", -3.056356895370426),\n                                    (\"8th ordinal\", -3.3440389678222067),\n                                    (\"21st ordinal no space\", -3.7495040759303713),\n                                    (\"20th ordinal\", -3.7495040759303713),\n                                    (\"third ordinal\", -1.8035939268750578),\n                                    (\"16th ordinal\", -3.3440389678222067),\n                                    (\"18th ordinal\", -3.3440389678222067),\n                                    (\"fifth ordinal\", -3.7495040759303713),\n                                    (\"seventh ordinal\", -3.3440389678222067),\n                                    (\"19th ordinal\", -3.3440389678222067),\n                                    (\"21-29th ordinal\", -3.3440389678222067),\n                                    (\"sixth ordinal\", -3.3440389678222067),\n                                    (\"15th ordinal\", -3.3440389678222067),\n                                    (\"second ordinal\", -2.1400661634962708),\n                                    (\"ordinal (digits)\", -2.3632097148104805),\n                                    (\"10th ordinal\", -2.496741107435003),\n                                    (\"9th ordinal\", -2.3632097148104805),\n                                    (\"first ordinal\", -3.7495040759303713),\n                                    (\"23rd ordinal no space\", -3.7495040759303713)],\n                               n = 66},\n                   koData =\n                     ClassData{prior = -3.5263605246161616,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"20th ordinal\", -2.3513752571634776),\n                                    (\"first ordinal\", -2.3513752571634776)],\n                               n = 2}}),\n       (\"November\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"July\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12}}),\n       (\"21st ordinal no space\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter\", -0.916290731874155),\n                                    (\"third ordinalquarter (grain)\", -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -0.916290731874155),\n                                    (\"quarter\", -0.916290731874155)],\n                               n = 1}}),\n       (\"May\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.29394383367575705,\n                               unseen = -6.278521424165844,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesdayon <date>\", -4.667205576907544),\n                                    (\"Sundaylast <cycle>\", -5.1780312006735345),\n                                    (\"Fridaynext <cycle>\", -5.583496308781699),\n                                    (\"<datetime> - <datetime> (interval)on <date>\",\n                                     -5.1780312006735345),\n                                    (\"mm/dd<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -5.583496308781699),\n                                    (\"<hour-of-day> - <hour-of-day> (interval)on <date>\",\n                                     -5.1780312006735345),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -5.1780312006735345),\n                                    (\"hourday\", -3.791736839553644),\n                                    (\"dayhour\", -2.7212954278522306),\n                                    (\"daymonth\", -3.791736839553644),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocyabsorption of , after named day\",\n                                     -4.667205576907544),\n                                    (\"TuesdaySeptember\", -5.583496308781699),\n                                    (\"monthyear\", -3.0985896589936988),\n                                    (\"Wednesdayintersect\", -5.1780312006735345),\n                                    (\"from <hour-of-day> - <hour-of-day> (interval)on a named-day\",\n                                     -5.583496308781699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on a named-day\",\n                                     -5.583496308781699),\n                                    (\"intersecthh:mm\", -5.583496308781699),\n                                    (\"from <datetime> - <datetime> (interval)on a named-day\",\n                                     -5.583496308781699),\n                                    (\"Wednesdaynext <cycle>\", -5.1780312006735345),\n                                    (\"Tuesdaythis <cycle>\", -5.583496308781699),\n                                    (\"Saturday<time> <part-of-day>\", -5.583496308781699),\n                                    (\"Marchyear\", -5.1780312006735345),\n                                    (\"Saturdayat <time-of-day>\", -5.1780312006735345),\n                                    (\"on a named-dayat <time-of-day>\", -5.1780312006735345),\n                                    (\"at <time-of-day>on a named-day\", -5.583496308781699),\n                                    (\"<time> <part-of-day>on a named-day\", -5.1780312006735345),\n                                    (\"Wednesdayon <date>\", -4.484884020113589),\n                                    (\"on a named-day<time> <part-of-day>\", -5.583496308781699),\n                                    (\"last <day-of-week> of <time>year\", -5.583496308781699),\n                                    (\"today<time> <part-of-day>\", -5.583496308781699),\n                                    (\"todayat <time-of-day>\", -5.583496308781699),\n                                    (\"on <date>at <time-of-day>\", -5.1780312006735345),\n                                    (\"dayday\", -2.9444389791664407),\n                                    (\"on <date><time> <part-of-day>\", -5.583496308781699),\n                                    (\"intersect by \\\",\\\"hh:mm\", -4.667205576907544),\n                                    (\"mm/ddat <time-of-day>\", -4.890349128221754),\n                                    (\"WednesdayOctober\", -5.1780312006735345),\n                                    (\"last <cycle> <time>year\", -4.667205576907544),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -4.890349128221754),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -4.890349128221754),\n                                    (\"dayyear\", -3.5685932882394344),\n                                    (\"Wednesday<day-of-month>(ordinal) <named-month>\",\n                                     -5.583496308781699),\n                                    (\"Thursday<time> <part-of-day>\", -5.1780312006735345),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -5.1780312006735345),\n                                    (\"day-after-tomorrow (single-word)at <time-of-day>\",\n                                     -5.583496308781699),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month>\",\n                                     -4.079418912005425),\n                                    (\"Tuesdaynext <cycle>\", -5.583496308781699),\n                                    (\"tomorrow<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -5.583496308781699),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.197201947661808),\n                                    (\"Thursdayfrom <datetime> - <datetime> (interval)\",\n                                     -4.667205576907544),\n                                    (\"Thursdayfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.667205576907544),\n                                    (\"tomorrowuntil <time-of-day>\", -5.1780312006735345),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -4.079418912005425),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocyintersect by \\\",\\\"\",\n                                     -4.667205576907544),\n                                    (\"TuesdayOctober\", -5.583496308781699),\n                                    (\"last <day-of-week> <time>year\", -5.1780312006735345),\n                                    (\"Monday<day-of-month>(ordinal) <named-month>\",\n                                     -5.1780312006735345),\n                                    (\"Mondaythis <cycle>\", -5.583496308781699),\n                                    (\"<time-of-day> ranoon <date>\", -5.1780312006735345),\n                                    (\"on <date><time-of-day> rano\", -5.583496308781699),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocytomorrow\",\n                                     -5.583496308781699),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -5.583496308781699),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocyFriday\",\n                                     -4.667205576907544),\n                                    (\"at <time-of-day>intersect\", -5.1780312006735345),\n                                    (\"dayminute\", -3.791736839553644),\n                                    (\"<time-of-day> ranoon a named-day\", -5.1780312006735345),\n                                    (\"from <hour-of-day> - <hour-of-day> (interval)on <date>\",\n                                     -5.583496308781699),\n                                    (\"from <datetime> - <datetime> (interval)on <date>\",\n                                     -5.583496308781699),\n                                    (\"intersectyear\", -5.1780312006735345),\n                                    (\"on a named-day<time-of-day> rano\", -5.583496308781699),\n                                    (\"<ordinal> <cycle> of <time>year\", -5.583496308781699),\n                                    (\"minuteday\", -2.384823191231018),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.583496308781699),\n                                    (\"Saturday<time-of-day> rano\", -5.583496308781699),\n                                    (\"Octoberyear\", -3.878748216543274),\n                                    (\"yearhh:mm\", -5.583496308781699),\n                                    (\"at <time-of-day>intersect by \\\",\\\"\", -5.1780312006735345),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -5.1780312006735345),\n                                    (\"tomorrowexactly <time-of-day>\", -4.890349128221754),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -5.1780312006735345),\n                                    (\"Septemberyear\", -4.667205576907544),\n                                    (\"at <time-of-day>on <date>\", -5.583496308781699),\n                                    (\"on <date>year\", -4.197201947661808),\n                                    (\"dayweek\", -3.6375861597263857),\n                                    (\"Tuesdayin <duration>\", -5.583496308781699),\n                                    (\"<time> <part-of-day>on <date>\", -5.1780312006735345),\n                                    (\"weekyear\", -4.330733340286331),\n                                    (\"<ordinal> <cycle> <time>year\", -5.1780312006735345),\n                                    (\"tomorrowat <time-of-day>\", -5.583496308781699),\n                                    (\"tomorrow<time> <part-of-day>\", -5.583496308781699),\n                                    (\"at <time-of-day>Friday\", -5.1780312006735345),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocyintersect\",\n                                     -4.667205576907544),\n                                    (\"<named-month> <day-of-month> (ordinal)year\",\n                                     -5.583496308781699),\n                                    (\"tomorrow<time-of-day> rano\", -5.583496308781699),\n                                    (\"<datetime> - <datetime> (interval)on a named-day\",\n                                     -5.1780312006735345),\n                                    (\"last <cycle> of <time>year\", -5.1780312006735345),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -5.583496308781699),\n                                    (\"<time-of-day> - <time-of-day> (interval)on a named-day\",\n                                     -5.1780312006735345),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -5.1780312006735345),\n                                    (\"<hour-of-day> - <hour-of-day> (interval)on a named-day\",\n                                     -5.1780312006735345),\n                                    (\"yearminute\", -5.583496308781699)],\n                               n = 199},\n                   koData =\n                     ClassData{prior = -1.3677409532241427, unseen = -5.602118820879701,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tuesdayon <date>\", -4.90527477843843),\n                                    (\"<time-of-day> ranoby <time>\", -4.499809670330265),\n                                    (\"Julyrelative minutes to|till|before <integer> (hour-of-day)\",\n                                     -4.90527477843843),\n                                    (\"dayhour\", -3.8066624897703196),\n                                    (\"daymonth\", -2.6026896854443837),\n                                    (\"monthyear\", -3.9889840465642745),\n                                    (\"Wednesdayintersect\", -4.499809670330265),\n                                    (\"<time> <part-of-day>until <time-of-day>\", -4.499809670330265),\n                                    (\"hournograin\", -3.033472601536838),\n                                    (\"Marchyear\", -4.212127597878484),\n                                    (\"Wednesdayon <date>\", -4.90527477843843),\n                                    (\"absorption of , after named dayJuly\", -4.90527477843843),\n                                    (\"<time> <part-of-day><time> <part-of-day>\",\n                                     -4.212127597878484),\n                                    (\"mm/ddat <time-of-day>\", -4.90527477843843),\n                                    (\"hourhour\", -3.9889840465642745),\n                                    (\"<time> <part-of-day>by <time>\", -4.499809670330265),\n                                    (\"dayyear\", -3.6525118099430616),\n                                    (\"<time-of-day> ranoby the end of <time>\", -4.499809670330265),\n                                    (\"<named-month> <day-of-month> (non ordinal)until <time-of-day>\",\n                                     -4.90527477843843),\n                                    (\"monthminute\", -4.90527477843843),\n                                    (\"minutemonth\", -4.212127597878484),\n                                    (\"Aprilyear\", -4.90527477843843),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocyintersect by \\\",\\\"\",\n                                     -4.499809670330265),\n                                    (\"after <time-of-day>at <time-of-day>\", -4.90527477843843),\n                                    (\"SundayMarch\", -4.90527477843843),\n                                    (\"hh:mmby the end of <time>\", -4.90527477843843),\n                                    (\"minutenograin\", -4.499809670330265),\n                                    (\"<time> <part-of-day>by the end of <time>\",\n                                     -4.499809670330265),\n                                    (\"<time> <part-of-day><time-of-day> rano\", -4.90527477843843),\n                                    (\"<time-of-day> rano<time> <part-of-day>\", -4.499809670330265),\n                                    (\"at <time-of-day>intersect\", -4.90527477843843),\n                                    (\"<named-month> <day-of-month> (non ordinal)by <time>\",\n                                     -4.90527477843843),\n                                    (\"intersectyear\", -3.6525118099430616),\n                                    (\"intersectSeptember\", -4.212127597878484),\n                                    (\"minuteday\", -3.200526686200004),\n                                    (\"hh:mmon <date>\", -4.499809670330265),\n                                    (\"at <time-of-day>intersect by \\\",\\\"\", -4.90527477843843),\n                                    (\"MondayMarch\", -4.90527477843843),\n                                    (\"<named-month> <day-of-month> (non ordinal)by the end of <time>\",\n                                     -4.90527477843843),\n                                    (\"tomorrowexactly <time-of-day>\", -4.90527477843843),\n                                    (\"absorption of , after named daySeptember\", -4.90527477843843),\n                                    (\"hh:mmon a named-day\", -4.499809670330265),\n                                    (\"Sundayon <date>\", -4.499809670330265),\n                                    (\"absorption of , after named dayFebruary\",\n                                     -3.8066624897703196),\n                                    (\"hh:mmby <time>\", -4.90527477843843),\n                                    (\"tomorrowat <time-of-day>\", -4.90527477843843),\n                                    (\"daynograin\", -4.499809670330265),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocyintersect\",\n                                     -4.499809670330265),\n                                    (\"Tuesdayintersect\", -4.499809670330265),\n                                    (\"Sundayintersect\", -4.499809670330265)],\n                               n = 68}}),\n       (\"half after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"twenty\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"20th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"a few\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"third ordinalday (grain)October\", -1.7047480922384253),\n                                    (\"daymonth\", -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609),\n                                    (\"first ordinalweek (grain)intersect\", -1.7047480922384253),\n                                    (\"first ordinalweek (grain)October\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -6.0624621816434854e-2,\n                               unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -2.833213344056216, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"<time-of-day> rano<time-of-day> rano\", -2.1972245773362196),\n                                    (\"hh:mmhh:mm\", -1.791759469228055),\n                                    (\"hourhour\", -1.791759469228055),\n                                    (\"minutehour\", -2.1972245773362196),\n                                    (\"<time-of-day> rano<integer> (latent time-of-day)\",\n                                     -2.1972245773362196),\n                                    (\"hh:mm<integer> (latent time-of-day)\", -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.540445040947149),\n                                    (\"minutehour\", -1.9459101490553135),\n                                    (\"hh:mmintersect\", -1.540445040947149),\n                                    (\"hh:mm<integer> (latent time-of-day)\", -1.9459101490553135)],\n                               n = 3}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.13353139262452263,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -2.0794415416798357,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"from <hour-of-day> - <hour-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -0.6931471805599453),\n                                    (\"hh:mmhh:mm\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.491654876777717),\n                                    (\"month (grain)\", -2.995732273553991),\n                                    (\"year (grain)\", -2.5902671654458267),\n                                    (\"second\", -2.995732273553991),\n                                    (\"week (grain)\", -1.491654876777717),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -2.5902671654458267),\n                                    (\"second (grain)\", -2.995732273553991),\n                                    (\"month\", -2.995732273553991),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.7346010553881064),\n                                    (\"<time-of-day> rano<time-of-day> rano\", -2.1400661634962708),\n                                    (\"hh:mmhh:mm\", -1.7346010553881064),\n                                    (\"hourhour\", -1.7346010553881064),\n                                    (\"minutehour\", -2.1400661634962708),\n                                    (\"<time-of-day> rano<integer> (latent time-of-day)\",\n                                     -2.1400661634962708),\n                                    (\"hh:mm<integer> (latent time-of-day)\", -2.1400661634962708)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minutehour\", -1.5040773967762742),\n                                    (\"hh:mm<integer> (latent time-of-day)\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"Three Kings' Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 20}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 23},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"third ordinal\",\n        Classifier{okData =\n                     ClassData{prior = -5.129329438755058e-2,\n                               unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -2.995732273553991, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"All Saints' Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -5.406722127027582e-2,\n                               unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -2.9444389791664407,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinal (digits)quarter (grain)year\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Saint Nicholas Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"16th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -1.791759469228055),\n                                    (\"<integer> (latent time-of-day)\", -1.791759469228055),\n                                    (\"noon\", -1.3862943611198906), (\"hour\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> (latent time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -7.232066157962613e-2),\n                                    (\"fifteen\", -3.068052935133617)],\n                               n = 40},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.1823215567939546),\n                                    (\"one\", -2.1972245773362196)],\n                               n = 15}}),\n       (\"Labour Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.1631508098056809),\n                                    (\"first ordinalWednesdayintersect\", -2.0794415416798357),\n                                    (\"second ordinalWednesdayintersect\", -2.0794415416798357),\n                                    (\"first ordinalTuesdayOctober\", -2.0794415416798357),\n                                    (\"third ordinalTuesdayintersect\", -2.0794415416798357)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"third ordinalTuesdaySeptember\", -1.9459101490553135),\n                                    (\"daymonth\", -1.252762968495368),\n                                    (\"second ordinalWednesdayOctober\", -1.9459101490553135),\n                                    (\"first ordinalWednesdayOctober\", -1.9459101490553135)],\n                               n = 3}}),\n       (\"Valentine's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"St Stephen's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"18th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.784189633918261,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fifth ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Corpus Christi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week> <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8873031950009028),\n                                    (\"SundayMarch\", -2.1400661634962708),\n                                    (\"MondayMarch\", -2.1400661634962708),\n                                    (\"Sundayon <date>\", -1.7346010553881064),\n                                    (\"Sundayintersect\", -1.7346010553881064)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Christmas Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<unit-of-duration> as a duration\",\n        Classifier{okData =\n                     ClassData{prior = -2.1435203983643585,\n                               unseen = -3.9318256327243257,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.7147984280919266),\n                                    (\"hour (grain)\", -2.8134107167600364),\n                                    (\"second\", -2.5257286443082556),\n                                    (\"week (grain)\", -1.7147984280919266),\n                                    (\"day\", -2.5257286443082556),\n                                    (\"minute (grain)\", -3.2188758248682006),\n                                    (\"second (grain)\", -2.5257286443082556),\n                                    (\"hour\", -2.8134107167600364), (\"minute\", -3.2188758248682006),\n                                    (\"day (grain)\", -2.5257286443082556)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -0.12470347850095725, unseen = -5.60947179518496,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.050454004806584),\n                                    (\"month (grain)\", -3.120895416507997),\n                                    (\"hour (grain)\", -2.6100697927420065),\n                                    (\"year (grain)\", -2.715430308399833),\n                                    (\"second\", -3.996364153861897),\n                                    (\"week (grain)\", -2.050454004806584),\n                                    (\"day\", -2.3869262414277963), (\"quarter\", -3.4085774889597777),\n                                    (\"minute (grain)\", -3.120895416507997),\n                                    (\"year\", -2.715430308399833),\n                                    (\"second (grain)\", -3.996364153861897),\n                                    (\"hour\", -2.6100697927420065), (\"month\", -3.120895416507997),\n                                    (\"quarter (grain)\", -3.4085774889597777),\n                                    (\"minute\", -3.120895416507997),\n                                    (\"day (grain)\", -2.3869262414277963)],\n                               n = 128}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"on <date>\", -1.5040773967762742),\n                                    (\"evening|night\", -1.0986122886681098),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2318016140573243, unseen = -4.060443010546419,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"15th ordinalFebruary\", -2.9444389791664407),\n                                    (\"8th ordinalAugust\", -2.9444389791664407),\n                                    (\"13th ordinalFebruary\", -3.349904087274605),\n                                    (\"first ordinalMarch\", -2.9444389791664407),\n                                    (\"ordinal (digits)February\", -1.55814461804655),\n                                    (\"third ordinalMarch\", -3.349904087274605),\n                                    (\"month\", -0.8649974374866046),\n                                    (\"ordinal (digits)March\", -2.4336133554004498)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -1.575536360758419, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"14th ordinalApril\", -2.03688192726104),\n                                    (\"third ordinalMay\", -2.4423470353692043),\n                                    (\"ordinal (digits)April\", -1.749199854809259),\n                                    (\"month\", -1.1895840668738362)],\n                               n = 6}}),\n       (\"<duration> hence\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3121863889661687),\n                                    (\"<unit-of-duration> as a duration\", -1.8718021769015913),\n                                    (\"day\", -2.159484249353372), (\"year\", -2.5649493574615367),\n                                    (\"<integer> <unit-of-duration>\", -1.1786549963416462),\n                                    (\"month\", -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.0794415416798357),\n                                    (\"<unit-of-duration> as a duration\", -0.9808292530117262),\n                                    (\"day\", -1.6739764335716716), (\"year\", -2.0794415416798357),\n                                    (\"month\", -2.0794415416798357)],\n                               n = 5}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"<cycle> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)tomorrow\", -0.6931471805599453),\n                                    (\"dayday\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mother's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Assumption Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Friday\", -1.3862943611198906), (\"day\", -1.3862943611198906),\n                                    (\"March\", -1.3862943611198906), (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Palm Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -2.456735772821304),\n                                    (\"year (latent)\", -2.8622008809294686),\n                                    (\"<integer> (latent time-of-day)\", -1.9459101490553135),\n                                    (\"day\", -2.456735772821304), (\"year\", -2.8622008809294686),\n                                    (\"hh:mm\", -2.8622008809294686),\n                                    (\"<day-of-month> (ordinal)\", -2.456735772821304),\n                                    (\"noon\", -2.8622008809294686),\n                                    (\"<time-of-day> rano\", -2.8622008809294686),\n                                    (\"hour\", -1.3581234841531944), (\"minute\", -2.8622008809294686)],\n                               n = 12}}),\n       (\"seventh ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"one\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -0.10008345855698253,\n                               unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -2.3513752571634776,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second\", -1.9459101490553135),\n                                    (\"<unit-of-duration> as a duration\", -1.540445040947149),\n                                    (\"day\", -1.9459101490553135), (\"year\", -1.9459101490553135),\n                                    (\"<integer> <unit-of-duration>\", -1.540445040947149),\n                                    (\"minute\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<unit-of-duration> as a duration\", -1.2039728043259361),\n                                    (\"year\", -1.6094379124341003), (\"minute\", -1.6094379124341003)],\n                               n = 2}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 30},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.5869650565820417),\n                                    (\"year (grain)\", -1.9924301646902063),\n                                    (\"week (grain)\", -1.5869650565820417),\n                                    (\"day\", -2.6855773452501515), (\"quarter\", -2.3978952727983707),\n                                    (\"year\", -1.9924301646902063),\n                                    (\"quarter (grain)\", -2.3978952727983707),\n                                    (\"day (grain)\", -2.6855773452501515)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -2.639057329615259),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -2.2335922215070942),\n                                    (\"day (grain)on <date>\", -2.2335922215070942),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -2.2335922215070942),\n                                    (\"week (grain)on <date>\", -2.2335922215070942),\n                                    (\"week (grain)September\", -2.639057329615259)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.4423470353692043),\n                                    (\"<ordinal> (as hour)\", -1.5260563034950494),\n                                    (\"<integer> (latent time-of-day)\", -2.03688192726104),\n                                    (\"hour\", -0.9382696385929302),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -2.4423470353692043)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"relative minutes after|past <integer> (hour-of-day)\",\n                                     -1.5040773967762742),\n                                    (\"minute\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.14842000511827333,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.9810014688665833, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.8472978603872037),\n                                    (\"SundayMarch\", -1.252762968495368),\n                                    (\"Sundayintersect\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7091475219063865, unseen = -4.59511985013459,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2823823856765264),\n                                    (\"threemonth (grain)\", -3.4863551900024623),\n                                    (\"fifteenminute (grain)\", -3.891820298110627),\n                                    (\"a fewhour (grain)\", -3.891820298110627),\n                                    (\"integer (numeric)day (grain)\", -2.793208009442517),\n                                    (\"twoweek (grain)\", -3.891820298110627),\n                                    (\"fiveday (grain)\", -3.891820298110627),\n                                    (\"oneweek (grain)\", -3.1986731175506815),\n                                    (\"oneminute (grain)\", -3.891820298110627),\n                                    (\"integer (numeric)year (grain)\", -3.891820298110627),\n                                    (\"day\", -2.505525936990736), (\"year\", -3.1986731175506815),\n                                    (\"integer (numeric)week (grain)\", -3.1986731175506815),\n                                    (\"oneday (grain)\", -3.891820298110627),\n                                    (\"hour\", -3.1986731175506815), (\"month\", -3.4863551900024623),\n                                    (\"threeweek (grain)\", -3.4863551900024623),\n                                    (\"integer (numeric)minute (grain)\", -2.793208009442517),\n                                    (\"minute\", -2.505525936990736),\n                                    (\"integer (numeric)hour (grain)\", -3.4863551900024623),\n                                    (\"twoyear (grain)\", -3.4863551900024623)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -0.6773988235918061, unseen = -4.61512051684126,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.8134107167600364),\n                                    (\"threemonth (grain)\", -3.912023005428146),\n                                    (\"threehour (grain)\", -3.912023005428146),\n                                    (\"integer (numeric)day (grain)\", -3.2188758248682006),\n                                    (\"twoweek (grain)\", -3.912023005428146),\n                                    (\"twominute (grain)\", -3.912023005428146),\n                                    (\"second\", -2.995732273553991),\n                                    (\"threeday (grain)\", -3.912023005428146),\n                                    (\"threeyear (grain)\", -3.912023005428146),\n                                    (\"integer (numeric)second (grain)\", -3.506557897319982),\n                                    (\"twomonth (grain)\", -3.912023005428146),\n                                    (\"onehour (grain)\", -3.912023005428146),\n                                    (\"integer (numeric)year (grain)\", -3.506557897319982),\n                                    (\"threesecond (grain)\", -3.912023005428146),\n                                    (\"day\", -2.659260036932778), (\"year\", -2.995732273553991),\n                                    (\"threeminute (grain)\", -3.912023005428146),\n                                    (\"integer (numeric)week (grain)\", -3.2188758248682006),\n                                    (\"twoday (grain)\", -3.912023005428146),\n                                    (\"hour\", -2.659260036932778), (\"month\", -3.2188758248682006),\n                                    (\"threeweek (grain)\", -3.912023005428146),\n                                    (\"integer (numeric)minute (grain)\", -3.506557897319982),\n                                    (\"a fewday (grain)\", -3.912023005428146),\n                                    (\"integer (numeric)month (grain)\", -3.912023005428146),\n                                    (\"minute\", -2.995732273553991),\n                                    (\"twosecond (grain)\", -3.912023005428146),\n                                    (\"integer (numeric)hour (grain)\", -3.2188758248682006),\n                                    (\"fifteenhour (grain)\", -3.912023005428146),\n                                    (\"twoyear (grain)\", -3.912023005428146)],\n                               n = 32}}),\n       (\"19th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.6931471805599453),\n                                    (\"<unit-of-duration> as a durationtomorrow\",\n                                     -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)<integer> (latent time-of-day)\",\n                                     -1.7047480922384253),\n                                    (\"fifteen<ordinal> (as hour)\", -1.7047480922384253),\n                                    (\"hour\", -1.0116009116784799),\n                                    (\"integer (numeric)<ordinal> (as hour)\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon\", -1.0986122886681098),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 2}}),\n       (\"Holy Saturday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thanksgiving Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.2282586519809802, unseen = -4.727387818712341,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.02535169073515),\n                                    (\"Wednesday<day-of-month> (non ordinal) <named-month>\",\n                                     -3.332204510175204),\n                                    (\"Friday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.619886582626985),\n                                    (\"Friday<day-of-month> (non ordinal) <named-month>\",\n                                     -4.02535169073515),\n                                    (\"intersect by \\\",\\\"year\", -4.02535169073515),\n                                    (\"dayday\", -1.4996230464268938),\n                                    (\"intersect<named-month> <day-of-month> (non ordinal)\",\n                                     -3.332204510175204),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -3.332204510175204),\n                                    (\"dayyear\", -3.109060958860994),\n                                    (\"Wednesday<day-of-month>(ordinal) <named-month>\",\n                                     -4.02535169073515),\n                                    (\"<named-month> <day-of-month> (non ordinal)intersect\",\n                                     -4.02535169073515),\n                                    (\"Monday<day-of-month>(ordinal) <named-month>\",\n                                     -3.619886582626985),\n                                    (\"Saturday<day-of-month>(ordinal) <named-month>\",\n                                     -4.02535169073515),\n                                    (\"Fridayintersect\", -4.02535169073515),\n                                    (\"intersect by \\\",\\\"intersect\", -4.02535169073515),\n                                    (\"Sunday<named-month> <day-of-month> (non ordinal)\",\n                                     -4.02535169073515),\n                                    (\"Sunday<day-of-month> (non ordinal) <named-month>\",\n                                     -4.02535169073515),\n                                    (\"dayminute\", -2.9267394020670396),\n                                    (\"intersectyear\", -4.02535169073515),\n                                    (\"minuteday\", -2.772588722239781),\n                                    (\"Sunday<day-of-month>(ordinal) <named-month>\",\n                                     -3.109060958860994),\n                                    (\"intersectintersect\", -4.02535169073515),\n                                    (\"Fridayintersect by \\\",\\\"\", -3.619886582626985),\n                                    (\"Monday<named-month> <day-of-month> (non ordinal)\",\n                                     -3.332204510175204),\n                                    (\"Monday<day-of-month> (non ordinal) <named-month>\",\n                                     -3.332204510175204),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -3.619886582626985)],\n                               n = 39},\n                   koData =\n                     ClassData{prior = -1.589235205116581, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.9095425048844386),\n                                    (\"SundayFebruary\", -3.295836866004329),\n                                    (\"FridayJuly\", -3.295836866004329),\n                                    (\"FridaySeptember\", -3.295836866004329),\n                                    (\"WednesdayFebruary\", -3.295836866004329),\n                                    (\"minutemonth\", -2.6026896854443837),\n                                    (\"MondayFebruary\", -2.6026896854443837),\n                                    (\"intersectSeptember\", -2.6026896854443837)],\n                               n = 10}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -4.652001563489282e-2,\n                               unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -3.0910424533583156,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"14th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"21-29th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second ordinal\", -0.6931471805599453),\n                                    (\"first ordinal\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> before <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.6931471805599453),\n                                    (\"<unit-of-duration> as a durationyesterday\",\n                                     -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"13th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sundaylast <cycle>\", -0.6931471805599453),\n                                    (\"dayweek\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3121863889661687),\n                                    (\"<unit-of-duration> as a duration\", -1.8718021769015913),\n                                    (\"day\", -2.159484249353372), (\"year\", -2.5649493574615367),\n                                    (\"<integer> <unit-of-duration>\", -1.1786549963416462),\n                                    (\"month\", -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.0794415416798357),\n                                    (\"<unit-of-duration> as a duration\", -0.9808292530117262),\n                                    (\"day\", -1.6739764335716716), (\"year\", -2.0794415416798357),\n                                    (\"month\", -2.0794415416798357)],\n                               n = 5}}),\n       (\"day-before-yesterday (single-word)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Constitution Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.8754687373538999), (\"Sunday\", -1.3862943611198906),\n                                    (\"Tuesday\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.6094379124341003), (\"day\", -0.916290731874155),\n                                    (\"Sunday\", -1.2039728043259361)],\n                               n = 3}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"sixth ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"11th ordinal\", -2.2335922215070942),\n                                    (\"8th ordinal\", -2.639057329615259),\n                                    (\"third ordinal\", -2.2335922215070942),\n                                    (\"16th ordinal\", -2.639057329615259),\n                                    (\"second ordinal\", -1.7227665977411035),\n                                    (\"ordinal (digits)\", -2.2335922215070942),\n                                    (\"10th ordinal\", -1.7227665977411035),\n                                    (\"9th ordinal\", -1.7227665977411035)],\n                               n = 20}}),\n       (\"Easter Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"Christmas\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8873031950009028,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -1.9924301646902063),\n                                    (\"<integer> (latent time-of-day)\", -1.9924301646902063),\n                                    (\"<time-of-day> rano\", -1.9924301646902063),\n                                    (\"hour\", -1.0116009116784799),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.5306282510621704, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -2.2335922215070942),\n                                    (\"<integer> (latent time-of-day)\", -1.7227665977411035),\n                                    (\"hh:mm\", -2.639057329615259), (\"noon\", -2.2335922215070942),\n                                    (\"<time-of-day> rano\", -2.639057329615259),\n                                    (\"hour\", -1.0296194171811581), (\"minute\", -2.639057329615259)],\n                               n = 10}}),\n       (\"<integer> and an half hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ash Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> rano\",\n        Classifier{okData =\n                     ClassData{prior = -0.10008345855698253,\n                               unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.0149030205422647),\n                                    (\"<ordinal> (as hour)\", -2.70805020110221),\n                                    (\"<integer> (latent time-of-day)\", -1.5040773967762742),\n                                    (\"hh:mm\", -3.1135153092103742),\n                                    (\"until <time-of-day>\", -2.70805020110221),\n                                    (\"hour\", -0.8622235106038793), (\"minute\", -3.1135153092103742)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -2.3513752571634776,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -1.7047480922384253),\n                                    (\"until <time-of-day>\", -1.7047480922384253),\n                                    (\"hour\", -1.2992829841302609)],\n                               n = 2}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.5649493574615367),\n                                    (\"Monday\", -2.159484249353372), (\"day\", -0.9555114450274363),\n                                    (\"March\", -2.5649493574615367), (\"month\", -2.5649493574615367),\n                                    (\"Tuesday\", -1.3121863889661687)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"month (grain)\", -1.6739764335716716),\n                                    (\"year (grain)\", -2.367123614131617),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"year\", -2.367123614131617), (\"month\", -1.6739764335716716)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.3862943611198906, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"day\", -1.6739764335716716),\n                                    (\"day (grain)\", -1.6739764335716716)],\n                               n = 4}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.793208009442517),\n                                    (\"threemonth (grain)\", -3.1986731175506815),\n                                    (\"threehour (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)day (grain)\", -3.1986731175506815),\n                                    (\"second\", -2.793208009442517),\n                                    (\"threeday (grain)\", -3.1986731175506815),\n                                    (\"threeyear (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)second (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)year (grain)\", -3.1986731175506815),\n                                    (\"threesecond (grain)\", -3.1986731175506815),\n                                    (\"day\", -2.505525936990736), (\"year\", -2.793208009442517),\n                                    (\"threeminute (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)week (grain)\", -3.1986731175506815),\n                                    (\"hour\", -2.793208009442517), (\"month\", -3.1986731175506815),\n                                    (\"threeweek (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)minute (grain)\", -3.1986731175506815),\n                                    (\"a fewday (grain)\", -3.1986731175506815),\n                                    (\"minute\", -2.793208009442517),\n                                    (\"integer (numeric)hour (grain)\", -3.1986731175506815)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"15th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Halloween Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by the end of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> (as hour)\", -2.456735772821304),\n                                    (\"year (latent)\", -2.8622008809294686),\n                                    (\"<integer> (latent time-of-day)\", -1.9459101490553135),\n                                    (\"day\", -2.456735772821304), (\"year\", -2.8622008809294686),\n                                    (\"hh:mm\", -2.8622008809294686),\n                                    (\"<day-of-month> (ordinal)\", -2.456735772821304),\n                                    (\"noon\", -2.8622008809294686),\n                                    (\"<time-of-day> rano\", -2.8622008809294686),\n                                    (\"hour\", -1.3581234841531944), (\"minute\", -2.8622008809294686)],\n                               n = 12}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.691243082785829),\n                                    (\"number.number hours\", -3.3843902633457743),\n                                    (\"second\", -2.9789251552376097),\n                                    (\"<unit-of-duration> as a duration\", -1.9980959022258835),\n                                    (\"day\", -2.9789251552376097),\n                                    (\"half an hour\", -3.3843902633457743),\n                                    (\"<integer> <unit-of-duration>\", -1.5125880864441827),\n                                    (\"<integer> and an half hours\", -3.3843902633457743),\n                                    (\"hour\", -2.2857779746776643), (\"minute\", -1.5125880864441827),\n                                    (\"about <duration>\", -2.9789251552376097)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -2.1972245773362196, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.4469189829363254),\n                                    (\"<unit-of-duration> as a duration\", -2.1400661634962708),\n                                    (\"<integer> <unit-of-duration>\", -1.7346010553881064)],\n                               n = 3}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.041453874828161, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.6094379124341003),\n                                    (\"hh:mmhh:mm\", -1.6094379124341003),\n                                    (\"dayday\", -2.120263536200091),\n                                    (\"<named-month> <day-of-month> (non ordinal)<named-month> <day-of-month> (non ordinal)\",\n                                     -2.120263536200091)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.4353180712578455, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month> <day-of-month> (non ordinal)July\",\n                                     -2.8622008809294686),\n                                    (\"daymonth\", -2.456735772821304),\n                                    (\"about <time-of-day>noon\", -2.8622008809294686),\n                                    (\"minuteminute\", -1.7635885922613588),\n                                    (\"<time-of-day> rano<time-of-day> rano\", -2.8622008809294686),\n                                    (\"until <time-of-day>noon\", -2.8622008809294686),\n                                    (\"hh:mmhh:mm\", -2.8622008809294686),\n                                    (\"hourhour\", -1.9459101490553135),\n                                    (\"hh:mmintersect\", -1.9459101490553135),\n                                    (\"at <time-of-day>noon\", -2.8622008809294686),\n                                    (\"<named-month> <day-of-month> (non ordinal)August\",\n                                     -2.8622008809294686)],\n                               n = 11}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"New Year's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second ordinal\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -2.5649493574615367,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n        Classifier{okData =\n                     ClassData{prior = -1.5037877364540559e-2,\n                               unseen = -4.962844630259907,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"exactly <time-of-day>\", -4.2626798770413155),\n                                    (\"at <time-of-day>\", -2.4709204078132605),\n                                    (\"<ordinal> (as hour)\", -1.5218398531161146),\n                                    (\"<integer> (latent time-of-day)\", -2.01138807843482),\n                                    (\"about <time-of-day>\", -4.2626798770413155),\n                                    (\"hh:mm\", -3.857214768933151),\n                                    (\"until <time-of-day>\", -4.2626798770413155),\n                                    (\"hour\", -0.812692331209728), (\"minute\", -3.3463891451671604),\n                                    (\"after <time-of-day>\", -3.857214768933151)],\n                               n = 66},\n                   koData =\n                     ClassData{prior = -4.204692619390966, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.791759469228055),\n                                    (\"hour\", -1.791759469228055)],\n                               n = 1}}),\n       (\"fifteen\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2237754316221157,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.4816045409242156),\n                                    (\"hh:mmhh:mm\", -1.4816045409242156),\n                                    (\"minutehour\", -2.3978952727983707),\n                                    (\"hh:mm<integer> (latent time-of-day)\", -2.3978952727983707)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.3483066942682157,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"about <time-of-day>noon\", -2.890371757896165),\n                                    (\"relative minutes to|till|before <integer> (hour-of-day)<integer> (latent time-of-day)\",\n                                     -2.890371757896165),\n                                    (\"minuteminute\", -2.890371757896165),\n                                    (\"<time-of-day> rano<time-of-day> rano\", -2.890371757896165),\n                                    (\"until <time-of-day>noon\", -2.890371757896165),\n                                    (\"hh:mmhh:mm\", -2.890371757896165),\n                                    (\"hourhour\", -1.6376087894007967),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"at <time-of-day>noon\", -2.890371757896165),\n                                    (\"<time-of-day> rano<integer> (latent time-of-day)\",\n                                     -2.890371757896165),\n                                    (\"until <time-of-day><integer> (latent time-of-day)\",\n                                     -2.890371757896165),\n                                    (\"hh:mm<integer> (latent time-of-day)\", -1.9740810260220096)],\n                               n = 12}}),\n       (\"<hour-of-day> - <hour-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.5040773967762742,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.2809338454620642),\n                                    (\"hh:mmhh:mm\", -1.2809338454620642)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.25131442828090605,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"about <time-of-day>noon\", -2.9444389791664407),\n                                    (\"minuteminute\", -2.9444389791664407),\n                                    (\"<time-of-day> rano<time-of-day> rano\", -2.9444389791664407),\n                                    (\"until <time-of-day>noon\", -2.9444389791664407),\n                                    (\"hh:mmhh:mm\", -2.9444389791664407),\n                                    (\"hourhour\", -0.9985288301111273),\n                                    (\"after <time-of-day>noon\", -2.538973871058276),\n                                    (\"at <time-of-day>noon\", -2.9444389791664407),\n                                    (\"<ordinal> (as hour)noon\", -1.845826690498331),\n                                    (\"<integer> (latent time-of-day)noon\", -2.538973871058276)],\n                               n = 14}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.583997552432231),\n                                    (\"integer (numeric)day (grain)\", -2.871679624884012),\n                                    (\"twoweek (grain)\", -3.2771447329921766),\n                                    (\"twominute (grain)\", -3.2771447329921766),\n                                    (\"second\", -2.871679624884012),\n                                    (\"integer (numeric)second (grain)\", -3.2771447329921766),\n                                    (\"twomonth (grain)\", -3.2771447329921766),\n                                    (\"onehour (grain)\", -3.2771447329921766),\n                                    (\"integer (numeric)year (grain)\", -3.2771447329921766),\n                                    (\"day\", -2.583997552432231), (\"year\", -2.871679624884012),\n                                    (\"integer (numeric)week (grain)\", -2.871679624884012),\n                                    (\"twoday (grain)\", -3.2771447329921766),\n                                    (\"hour\", -2.871679624884012), (\"month\", -2.871679624884012),\n                                    (\"integer (numeric)minute (grain)\", -3.2771447329921766),\n                                    (\"integer (numeric)month (grain)\", -3.2771447329921766),\n                                    (\"minute\", -2.871679624884012),\n                                    (\"twosecond (grain)\", -3.2771447329921766),\n                                    (\"integer (numeric)hour (grain)\", -3.2771447329921766),\n                                    (\"twoyear (grain)\", -3.2771447329921766)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.871201010907891,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Augustinteger (numeric)\", -1.9042374526547454),\n                                    (\"Marchinteger (numeric)\", -2.463853240590168),\n                                    (\"Aprilinteger (numeric)\", -3.1570004211501135),\n                                    (\"month\", -0.8056251639866356),\n                                    (\"Februaryinteger (numeric)\", -1.9042374526547454),\n                                    (\"Septemberinteger (numeric)\", -3.1570004211501135),\n                                    (\"Julyinteger (numeric)\", -2.463853240590168)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (numeric)\", -2.4423470353692043),\n                                    (\"Aprilinteger (numeric)\", -1.3437347467010947),\n                                    (\"month\", -0.9382696385929302),\n                                    (\"Julyinteger (numeric)\", -2.03688192726104)],\n                               n = 8}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -4.8790164169432056e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)September\", -3.1780538303479458),\n                                    (\"integer (numeric)May\", -2.4849066497880004),\n                                    (\"integer (numeric)April\", -3.1780538303479458),\n                                    (\"integer (numeric)August\", -3.1780538303479458),\n                                    (\"integer (numeric)February\", -1.5686159179138452),\n                                    (\"month\", -0.8266785731844679),\n                                    (\"integer (numeric)November\", -2.2617630984737906),\n                                    (\"integer (numeric)March\", -3.1780538303479458)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -3.044522437723423, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)May\", -1.6094379124341003),\n                                    (\"month\", -1.6094379124341003)],\n                               n = 1}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -2.3978952727983707),\n                                    (\"Monday\", -1.9924301646902063), (\"day\", -0.7884573603642702),\n                                    (\"Tuesday\", -1.1451323043030026)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"three\",\n        Classifier{okData =\n                     ClassData{prior = -0.1670540846631662,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -1.8718021769015913,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day (grain)October\", -1.9459101490553135),\n                                    (\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"week (grain)September\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"14th ordinalApril\", -1.845826690498331),\n                                    (\"third ordinalMarch\", -2.2512917986064953),\n                                    (\"ordinal (digits)April\", -1.55814461804655),\n                                    (\"month\", -0.8649974374866046),\n                                    (\"ordinal (digits)March\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lato\",\n        Classifier{okData =\n                     ClassData{prior = -1.5040773967762742,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.25131442828090605,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.7731898882334817,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6190392084062235,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"relative minutes to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)<integer> (latent time-of-day)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Women's Day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"10th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -1.2367626271489267,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.268683541318364),\n                                    (\"<ordinal> (as hour)\", -2.268683541318364),\n                                    (\"afternoon\", -1.9810014688665833),\n                                    (\"hour\", -1.0647107369924282),\n                                    (\"<time-of-day> popo\\322udniu/wieczorem/w nocy\",\n                                     -2.268683541318364)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.3429447511268303, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.908720896564361),\n                                    (\"intersect\", -3.3141860046725258),\n                                    (\"tomorrow\", -2.3978952727983707), (\"day\", -2.0614230361771577),\n                                    (\"afternoon\", -2.3978952727983707),\n                                    (\"<day-of-month> (ordinal)\", -2.908720896564361),\n                                    (\"noon\", -1.927891643552635), (\"hour\", -1.1741198411762548),\n                                    (\"<hour-of-day> - <hour-of-day> (interval)\",\n                                     -2.908720896564361)],\n                               n = 22}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.20479441264601328,\n                               unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -1.6863989535702288,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"9th ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"first ordinal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"July\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half an hour\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day-after-tomorrow (single-word)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>fifteen\", -1.252762968495368),\n                                    (\"at <time-of-day>twenty\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"23rd ordinal no space\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Pentecost\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5389965007326869, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Thursday\", -3.068052935133617), (\"zima\", -2.662587827025453),\n                                    (\"Wednesday\", -3.068052935133617),\n                                    (\"Saturday\", -3.068052935133617),\n                                    (\"Monday\", -3.068052935133617), (\"Friday\", -3.068052935133617),\n                                    (\"day\", -1.276293465905562), (\"Sunday\", -3.068052935133617),\n                                    (\"hour\", -2.374905754573672), (\"Tuesday\", -3.068052935133617),\n                                    (\"lato\", -2.662587827025453), (\"week-end\", -2.374905754573672)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -0.8754687373538999, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"April\", -2.456735772821304),\n                                    (\"February\", -1.3581234841531944),\n                                    (\"month\", -1.157452788691043)],\n                               n = 10}}),\n       (\"<named-month> <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"February15th ordinal\", -1.791759469228055),\n                                    (\"Marchfirst ordinal\", -1.791759469228055),\n                                    (\"month\", -0.8754687373538999),\n                                    (\"Marchordinal (digits)\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"August\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 2443}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.PT_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<cycle> (que vem)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.540445040947149),\n                                    (\"semana (grain)\", -1.540445040947149),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"ano (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"semana (grain)\", -1.791759469228055),\n                                    (\"mes (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055),\n                                    (\"ano (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055)],\n                               n = 3}}),\n       (\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"S\\225bada\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> da tarde\",\n        Classifier{okData =\n                     ClassData{prior = -0.24686007793152578, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and half\", -2.468099531471619),\n                                    (\"time-of-day (latent)\", -2.9789251552376097),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.1316272948504063),\n                                    (\"hour\", -2.468099531471619),\n                                    (\"<hour-of-day> and quinze\", -2.468099531471619),\n                                    (\"minute\", -0.9864949905474035),\n                                    (\"\\224s <time-of-day>\", -1.7749523509116738)],\n                               n = 25},\n                   koData =\n                     ClassData{prior = -1.5198257537444133,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.3437347467010947),\n                                    (\"time-of-day (latent)\", -2.03688192726104),\n                                    (\"year\", -1.3437347467010947), (\"hour\", -2.03688192726104)],\n                               n = 7}}),\n       (\"de <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.442651256490317,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 83},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"\\224s <time-of-day>\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.23894721648733527,\n                               unseen = -5.429345628954441,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 226},\n                   koData =\n                     ClassData{prior = -1.5486083515863098, unseen = -4.143134726391533,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 61}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh(:|.|h)mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month|named-day> past\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Ter\\231a-feira\", -1.5040773967762742),\n                                    (\"Domingo\", -1.0986122886681098), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.121230377255882, unseen = -5.393627546352362,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.4378280112350734),\n                                    (\"ordinals (1..10)mes (grain)year\", -2.61648300757672),\n                                    (\"ordinals (1..10)trimestre (grain)de <year>\",\n                                     -1.7781538171722764),\n                                    (\"quarteryear\", -1.4378280112350734),\n                                    (\"ordinals (1..10)mes (grain)de <year>\", -1.8055527913603908),\n                                    (\"ordinals (11..19)mes (grain)de <year>\", -4.695924549256556),\n                                    (\"ordinals (1..10)trimestre (grain)year\", -2.61648300757672)],\n                               n = 102},\n                   koData =\n                     ClassData{prior = -0.39434505706408673,\n                               unseen = -6.082218910376446,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -5.3867860145356445),\n                                    (\"quarterquarter\", -1.227902931175973),\n                                    (\"monthmonth\", -1.6491163962522766),\n                                    (\"ordinals (1..10)mes (grain)<datetime> - <datetime> (interval)\",\n                                     -2.49641425663948),\n                                    (\"ordinals (1..10)mes (grain)entre <datetime> e <datetime> (interval)\",\n                                     -2.5245851336061764),\n                                    (\"ordinals (1..10)trimestre (grain)intersect\",\n                                     -2.9888907417372743),\n                                    (\"ordinals (1..10)mes (grain)de <year>\", -5.3867860145356445),\n                                    (\"ordinals (1..10)trimestre (grain)<datetime> - <datetime> (interval)\",\n                                     -2.0545815043604407),\n                                    (\"ordinals (1..10)trimestre (grain)entre <datetime> e <datetime> (interval)\",\n                                     -2.128689476514163),\n                                    (\"ordinals (1..10)mes (grain)intersect\", -3.37188299399338)],\n                               n = 211}}),\n       (\"Abril\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"proximo <cycle> \",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"semana (grain)\", -1.791759469228055),\n                                    (\"mes (grain)\", -2.1972245773362196),\n                                    (\"quarter\", -2.1972245773362196), (\"year\", -2.1972245773362196),\n                                    (\"ano (grain)\", -2.1972245773362196),\n                                    (\"trimestre (grain)\", -2.1972245773362196),\n                                    (\"month\", -2.1972245773362196)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9459101490553135),\n                                    (\"semana (grain)\", -1.9459101490553135),\n                                    (\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"ano (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 3}}),\n       (\"dd[/-]mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Julho\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by `da` or `de`\",\n        Classifier{okData =\n                     ClassData{prior = -1.9108188292440431, unseen = -4.912654885736052,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.959364629383116),\n                                    (\"dd-dd <month> de (interval)year\", -4.212127597878484),\n                                    (\"dayday\", -3.518980417318539),\n                                    (\"Quart-feira<cycle> (que vem)\", -4.212127597878484),\n                                    (\"dayyear\", -2.132686056198648),\n                                    (\"quarteryear\", -4.212127597878484),\n                                    (\"dd-dd <month>(interval)year\", -4.212127597878484),\n                                    (\"<ordinal> trimestreyear\", -4.212127597878484),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -2.8258332367585934),\n                                    (\"day of month (1st)Mar\\231o\", -3.518980417318539),\n                                    (\"dayminute\", -4.212127597878484),\n                                    (\"two time tokens separated by \\\",\\\"2year\",\n                                     -3.8066624897703196),\n                                    (\"intersectyear\", -4.212127597878484),\n                                    (\"dia <day-of-month> (non ordinal)Fevereiro\",\n                                     -3.518980417318539),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year\",\n                                     -4.212127597878484),\n                                    (\"two time tokens separated by \\\",\\\"year\", -3.8066624897703196),\n                                    (\"Domingo<cycle> passado\", -4.212127597878484),\n                                    (\"dayweek\", -3.518980417318539),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>two time tokens separated by \\\",\\\"2\",\n                                     -4.212127597878484),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>intersect\",\n                                     -4.212127597878484),\n                                    (\"Quart-feiraproximo <cycle> \", -4.212127597878484),\n                                    (\"dia <day-of-month> (non ordinal)intersect\",\n                                     -4.212127597878484),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>two time tokens separated by \\\",\\\"\",\n                                     -4.212127597878484)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -0.16012084681376212,\n                               unseen = -6.021023349349527,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)<datetime> - <datetime> (interval)\",\n                                     -4.919980925828125),\n                                    (\"hourday\", -3.1853798704400185),\n                                    (\"year (latent)Abril\", -4.919980925828125),\n                                    (\"year (latent)Julho\", -3.5336865647082343),\n                                    (\"dayhour\", -5.32544603393629),\n                                    (\"time-of-day (latent)Fevereiro\", -3.9391516728163984),\n                                    (\"monthday\", -4.632298853376344),\n                                    (\"monthyear\", -3.620697941697864),\n                                    (\"yearhour\", -3.821368637160015),\n                                    (\"entre <datetime> e <datetime> (interval)Julho\",\n                                     -3.7160081215021887),\n                                    (\"houryear\", -3.379535884880976),\n                                    (\"year (latent)Maio\", -4.22683374526818),\n                                    (\"time-of-day (latent)two time tokens separated by \\\",\\\"2\",\n                                     -4.919980925828125),\n                                    (\"Setembroyear\", -4.22683374526818),\n                                    (\"time-of-day (latent)Setembro\", -4.22683374526818),\n                                    (\"time-of-day (latent)intersect\", -3.3105430133940246),\n                                    (\"year (latent)<time-of-day> <part-of-day>\", -5.32544603393629),\n                                    (\"\\224s <time-of-day>Julho\", -4.632298853376344),\n                                    (\"year (latent)intersect\", -4.22683374526818),\n                                    (\"Setembrointersect\", -5.32544603393629),\n                                    (\"intersect by `da` or `de`two time tokens separated by \\\",\\\"\",\n                                     -5.32544603393629),\n                                    (\"year (latent)amanh\\227 pela <part-of-day>\",\n                                     -5.32544603393629),\n                                    (\"hourmonth\", -1.7700979724468757),\n                                    (\"time-of-day (latent)intersect by `da` or `de`\",\n                                     -3.5336865647082343),\n                                    (\"monthmonth\", -5.32544603393629),\n                                    (\"Setembrotwo time tokens separated by \\\",\\\"2\",\n                                     -5.32544603393629),\n                                    (\"year (latent)Fevereiro\", -3.9391516728163984),\n                                    (\"time-of-day (latent)Dezembro\", -5.32544603393629),\n                                    (\"dayyear\", -5.32544603393629),\n                                    (\"time-of-day (latent)Julho\", -3.5336865647082343),\n                                    (\"time-of-day (latent)Abril\", -4.919980925828125),\n                                    (\"passado <cycle>year\", -5.32544603393629),\n                                    (\"year (latent)<dim time> da manha\", -5.32544603393629),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -5.32544603393629),\n                                    (\"time-of-day (latent)Mar\\231o\", -4.22683374526818),\n                                    (\"year (latent)Janeiro\", -5.32544603393629),\n                                    (\"year (latent)Dezembro\", -5.32544603393629),\n                                    (\"entre <datetime> e <datetime> (interval)Janeiro\",\n                                     -5.32544603393629),\n                                    (\"yearmonth\", -2.2344035805779736),\n                                    (\"two time tokens separated by \\\",\\\"2year\", -4.919980925828125),\n                                    (\"Setembrotwo time tokens separated by \\\",\\\"\",\n                                     -5.32544603393629),\n                                    (\"intersect by `da` or `de`intersect\", -5.32544603393629),\n                                    (\"intersectyear\", -5.32544603393629),\n                                    (\"intersect by `da` or `de`two time tokens separated by \\\",\\\"2\",\n                                     -5.32544603393629),\n                                    (\"time-of-day (latent)Maio\", -4.22683374526818),\n                                    (\"antes das <time-of-day>Julho\", -4.072683065440922),\n                                    (\"Maioyear\", -4.632298853376344),\n                                    (\"year (latent)Setembro\", -4.22683374526818),\n                                    (\"\\224s <time-of-day>Janeiro\", -5.32544603393629),\n                                    (\"two time tokens separated by \\\",\\\"year\", -4.919980925828125),\n                                    (\"time-of-day (latent)two time tokens separated by \\\",\\\"\",\n                                     -4.919980925828125),\n                                    (\"intersect by `da` or `de`year\", -3.821368637160015),\n                                    (\"year (latent)<datetime> - <datetime> (interval)\",\n                                     -4.919980925828125),\n                                    (\"yearday\", -5.32544603393629),\n                                    (\"time-of-day (latent)Janeiro\", -5.32544603393629),\n                                    (\"dia <day-of-month> (non ordinal)intersect\",\n                                     -5.32544603393629),\n                                    (\"Julhoyear\", -5.32544603393629),\n                                    (\"de <datetime> - <datetime> (interval)Julho\",\n                                     -5.32544603393629),\n                                    (\"year (latent)Mar\\231o\", -4.22683374526818),\n                                    (\"yearminute\", -5.32544603393629)],\n                               n = 167}}),\n       (\"<hour-of-day> and half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.4816045409242156),\n                                    (\"noon\", -2.3978952727983707), (\"hour\", -0.7884573603642702),\n                                    (\"\\224s <time-of-day>\", -1.4816045409242156)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal or number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6190392084062235, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..19)Maio\", -2.2512917986064953),\n                                    (\"integer (numeric)Julho\", -2.2512917986064953),\n                                    (\"month\", -0.8649974374866046),\n                                    (\"integer (0..19)Julho\", -2.2512917986064953),\n                                    (\"integer (numeric)Maio\", -1.3350010667323402)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.7731898882334817, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Julho\", -0.8873031950009028),\n                                    (\"month\", -0.8873031950009028)],\n                               n = 6}}),\n       (\"semana (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 18},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -1.0360919316867756,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Segunda-feira<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.917770732084279),\n                                    (\"yearSexta-feira\", -2.917770732084279),\n                                    (\"dayday\", -1.3083328196501787),\n                                    (\"de <year>Sexta-feira\", -2.917770732084279),\n                                    (\"Sexta-feira<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.512305623976115),\n                                    (\"Sexta-feiraintersect\", -2.512305623976115),\n                                    (\"intersectSexta-feira\", -2.917770732084279),\n                                    (\"Sexta-feiraintersect by `da` or `de`\", -2.512305623976115),\n                                    (\"intersect by `da` or `de`Sexta-feira\", -2.917770732084279),\n                                    (\"yearday\", -2.512305623976115)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.4382549309311553, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.3978952727983707),\n                                    (\"dayhour\", -1.5224265354444706),\n                                    (\"daymonth\", -2.6210388241125804),\n                                    (\"monthday\", -2.908720896564361),\n                                    (\"Segunda-feiraintersect by `da` or `de`\", -2.908720896564361),\n                                    (\"Sexta-feiraintersect\", -2.908720896564361),\n                                    (\"intersectSexta-feira\", -2.908720896564361),\n                                    (\"Sexta-feiraintersect by `da` or `de`\", -1.6094379124341003),\n                                    (\"intersect by `da` or `de`Sexta-feira\", -2.3978952727983707)],\n                               n = 20}}),\n       (\"Sexta-feira\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.6529301951210582e-2,\n                               unseen = -4.127134385045092,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 60},\n                   koData =\n                     ClassData{prior = -4.110873864173311, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"desde <month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)Julho\",\n                                     -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3639653772014116, unseen = -4.663439094112067,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and quinzeafternoon\", -3.044522437723423),\n                                    (\"dayhour\", -3.2676659890376327),\n                                    (\"\\224s <time-of-day>morning\", -3.2676659890376327),\n                                    (\"intersectevening\", -3.960813169597578),\n                                    (\"hourhour\", -1.7635885922613588),\n                                    (\"<hour-of-day> and halfafternoon\", -3.044522437723423),\n                                    (\"minutehour\", -1.5629178967992075),\n                                    (\"time-of-day (latent)morning\", -3.2676659890376327),\n                                    (\"time-of-day (latent)evening\", -3.5553480614894135),\n                                    (\"\\224s <time-of-day>afternoon\", -2.3513752571634776),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>morning\",\n                                     -3.960813169597578),\n                                    (\"dia <day-of-month> de <named-month>morning\",\n                                     -3.960813169597578),\n                                    (\"time-of-day (latent)afternoon\", -3.5553480614894135),\n                                    (\"<hour-of-day> and <relative minutes>afternoon\",\n                                     -2.70805020110221),\n                                    (\"intersectmorning\", -3.960813169597578),\n                                    (\"\\224s <time-of-day>evening\", -3.2676659890376327),\n                                    (\"intersect by `da` or `de`morning\", -3.960813169597578)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -1.1871656860095547, unseen = -4.0943445622221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -1.5125880864441827),\n                                    (\"monthhour\", -2.9789251552376097),\n                                    (\"hourhour\", -2.468099531471619),\n                                    (\"time-of-day (latent)morning\", -3.3843902633457743),\n                                    (\"year (latent)afternoon\", -2.2857779746776643),\n                                    (\"time-of-day (latent)evening\", -3.3843902633457743),\n                                    (\"Fevereiromorning\", -3.3843902633457743),\n                                    (\"year (latent)evening\", -2.691243082785829),\n                                    (\"time-of-day (latent)afternoon\", -2.9789251552376097),\n                                    (\"year (latent)morning\", -2.468099531471619),\n                                    (\"intersect by `da` or `de`morning\", -3.3843902633457743)],\n                               n = 18}}),\n       (\"de <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"hourhour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"Maio\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number (21..29 31..39 .. 91..99)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList [(\"tens (20..90)integer (0..19)\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> de <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -5.049856007249537,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.4325072042750222),\n                                    (\"ordinals (1..10)mes (grain)year\", -1.4599061784631366),\n                                    (\"ordinals (11..19)mes (grain)year\", -4.350277936359301),\n                                    (\"quarteryear\", -1.4325072042750222),\n                                    (\"ordinals (1..10)trimestre (grain)year\", -1.4325072042750222)],\n                               n = 72},\n                   koData =\n                     ClassData{prior = -0.5108256237659907, unseen = -5.429345628954441,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -4.7318028369214575),\n                                    (\"ordinals (1..10)mes (grain)year\", -4.7318028369214575),\n                                    (\"quarterquarter\", -1.2505627475857655),\n                                    (\"monthmonth\", -1.6407603835631415),\n                                    (\"ordinals (1..10)mes (grain)<datetime> - <datetime> (interval)\",\n                                     -1.9909628129962564),\n                                    (\"ordinals (1..10)trimestre (grain)intersect\",\n                                     -2.4292177439274116),\n                                    (\"ordinals (1..10)trimestre (grain)<datetime> - <datetime> (interval)\",\n                                     -1.5963086209923076),\n                                    (\"ordinals (1..10)mes (grain)intersect\", -2.785892687866144)],\n                               n = 108}}),\n       (\"<time-of-day> horas\",\n        Classifier{okData =\n                     ClassData{prior = -0.5306282510621704, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.466337068793427),\n                                    (\"hour\", -0.8602012652231115),\n                                    (\"depois das <time-of-day>\", -2.159484249353372),\n                                    (\"\\224s <time-of-day>\", -1.8718021769015913)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.8873031950009028, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.2039728043259361),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.3025850929940455),\n                                    (\"hour\", -1.0498221244986778), (\"minute\", -2.3025850929940455),\n                                    (\"\\224s <time-of-day>\", -2.3025850929940455)],\n                               n = 7}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -1.0287687153008453, unseen = -5.58724865840025,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.9199346626520526),\n                                    (\"dia <day-of-month> (non ordinal)\\224s <time-of-day>\",\n                                     -3.5040547671018634),\n                                    (\"dia <day-of-month> de <named-month>\\224s <time-of-day>\",\n                                     -4.890349128221754),\n                                    (\"tomorrowin the <part-of-day>\", -3.9740583963475986),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\\224s <time-of-day>\",\n                                     -4.890349128221754),\n                                    (\"nowquinze para as <hour-of-day> (as relative minutes)\",\n                                     -4.890349128221754),\n                                    (\"Quart-feiraamanh\\227 pela <part-of-day>\", -4.890349128221754),\n                                    (\"now\\224s <time-of-day>\", -4.484884020113589),\n                                    (\"now<hour-of-day> and 3/4\", -4.890349128221754),\n                                    (\"Segunda-feirain the <part-of-day>\", -4.890349128221754),\n                                    (\"Quart-feira<time-of-day> <part-of-day>\", -4.890349128221754),\n                                    (\"yearSexta-feira\", -4.890349128221754),\n                                    (\"dayday\", -3.3862717314454795),\n                                    (\"hourhour\", -4.890349128221754),\n                                    (\"dayyear\", -2.6931245508855346),\n                                    (\"Quinta-feira\\224s <time-of-day>\", -4.197201947661808),\n                                    (\"de <year>Sexta-feira\", -4.890349128221754),\n                                    (\"quarteryear\", -4.890349128221754),\n                                    (\"intersect by `da` or `de`\\224s <time-of-day>\",\n                                     -4.890349128221754),\n                                    (\"monthminute\", -4.890349128221754),\n                                    (\"minutehour\", -3.6375861597263857),\n                                    (\"<hour-of-day> and quinzein the <part-of-day>\",\n                                     -4.484884020113589),\n                                    (\"Sexta-feira<day-of-month> (ordinal or number) de <named-month>\",\n                                     -4.890349128221754),\n                                    (\"intersect by `da` or `de`in the <part-of-day>\",\n                                     -4.484884020113589),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>year\",\n                                     -4.890349128221754),\n                                    (\"now<hour-of-day> and <relative minutes>\", -4.890349128221754),\n                                    (\"tomorrow<time-of-day> horas\", -4.484884020113589),\n                                    (\"dd-dd <month> de (interval)de <year>\", -4.890349128221754),\n                                    (\"now<integer> para as <hour-of-day> (as relative minutes)\",\n                                     -4.890349128221754),\n                                    (\"Quinta-feira<time-of-day> horas\", -4.890349128221754),\n                                    (\"\\224s <time-of-day>in the <part-of-day>\", -4.197201947661808),\n                                    (\"Sexta-feiraintersect\", -4.890349128221754),\n                                    (\"Fevereiro\\224s <time-of-day>\", -4.890349128221754),\n                                    (\"dayminute\", -3.1856010359833284),\n                                    (\"<ordinal> trimestrede <year>\", -4.890349128221754),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>de <year>\",\n                                     -3.5040547671018634),\n                                    (\"intersectSexta-feira\", -4.890349128221754),\n                                    (\"dd-dd <month>(interval)de <year>\", -4.890349128221754),\n                                    (\"Sexta-feiraintersect by `da` or `de`\", -4.890349128221754),\n                                    (\"<day-of-month> (ordinal or number) <named-month>year\",\n                                     -4.890349128221754),\n                                    (\"intersect by `da` or `de`Sexta-feira\", -4.890349128221754),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>in the <part-of-day>\",\n                                     -4.484884020113589),\n                                    (\"tomorrow\\224s <time-of-day>\", -4.890349128221754),\n                                    (\"dia <day-of-month> de <named-month>in the <part-of-day>\",\n                                     -4.484884020113589),\n                                    (\"<day-of-month> (ordinal or number) <named-month>de <year>\",\n                                     -4.890349128221754),\n                                    (\"tomorrow<time-of-day> <part-of-day>\", -4.890349128221754),\n                                    (\"yearday\", -4.484884020113589),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>two time tokens separated by \\\",\\\"2\",\n                                     -4.890349128221754),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>intersect\",\n                                     -4.890349128221754),\n                                    (\"two time tokens separated by \\\",\\\"de <year>\",\n                                     -4.484884020113589),\n                                    (\"dia <day-of-month> (non ordinal)<time-of-day> horas\",\n                                     -4.890349128221754),\n                                    (\"Quart-feira\\224s <time-of-day>\", -4.890349128221754),\n                                    (\"Quart-feira<dim time> da manha\", -4.890349128221754),\n                                    (\"yesterdayin the <part-of-day>\", -3.9740583963475986),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>two time tokens separated by \\\",\\\"\",\n                                     -4.890349128221754),\n                                    (\"tomorrowdepois das <time-of-day>\", -4.484884020113589),\n                                    (\"<hour-of-day> and <relative minutes>in the <part-of-day>\",\n                                     -4.484884020113589),\n                                    (\"tomorrowamanh\\227 pela <part-of-day>\", -4.890349128221754),\n                                    (\"two time tokens separated by \\\",\\\"2de <year>\",\n                                     -4.484884020113589),\n                                    (\"intersectde <year>\", -4.890349128221754),\n                                    (\"n[ao] <date>\\224s <time-of-day>\", -4.890349128221754)],\n                               n = 84},\n                   koData =\n                     ClassData{prior = -0.4423056773292346, unseen = -5.993961427306569,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.4265151896464454),\n                                    (\"dayhour\", -3.506557897319982),\n                                    (\"daymonth\", -5.298317366548036),\n                                    (\"monthday\", -4.199705077879927),\n                                    (\"monthyear\", -3.3524072174927233),\n                                    (\"dia <day-of-month> (non ordinal)\\224s <time-of-day>\",\n                                     -5.298317366548036),\n                                    (\"dia <day-of-month> de <named-month>\\224s <time-of-day>\",\n                                     -5.298317366548036),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\\224s <time-of-day>\",\n                                     -4.892852258439873),\n                                    (\"now\\224s <time-of-day>\", -4.892852258439873),\n                                    (\"entre <datetime> e <datetime> (interval)Julho\",\n                                     -3.6888794541139363),\n                                    (\"houryear\", -3.283414346005772),\n                                    (\"Dezembro\\224s <time-of-day>\", -5.298317366548036),\n                                    (\"\\224s <time-of-day>Julho\", -4.892852258439873),\n                                    (\"Fevereiroin the <part-of-day>\", -4.892852258439873),\n                                    (\"de <year>antes das <time-of-day>\", -2.557477342622836),\n                                    (\"monthhour\", -3.7942399697717626),\n                                    (\"Setembrointersect\", -5.298317366548036),\n                                    (\"intersect by `da` or `de`two time tokens separated by \\\",\\\"\",\n                                     -5.298317366548036),\n                                    (\"hourmonth\", -3.4265151896464454),\n                                    (\"Julhode <year>\", -5.298317366548036),\n                                    (\"<time-of-day> am|pmintersect by `da` or `de`\",\n                                     -4.605170185988091),\n                                    (\"Setembrotwo time tokens separated by \\\",\\\"2\",\n                                     -5.298317366548036),\n                                    (\"dayyear\", -5.298317366548036),\n                                    (\"intersect by `da` or `de`\\224s <time-of-day>\",\n                                     -4.382026634673881),\n                                    (\"monthminute\", -5.298317366548036),\n                                    (\"passado <cycle>year\", -5.298317366548036),\n                                    (\"de <year>o <ordinal> <cycle> de <time>\", -4.892852258439873),\n                                    (\"intersect by `da` or `de`in the <part-of-day>\",\n                                     -4.892852258439873),\n                                    (\"Setembrode <year>\", -4.199705077879927),\n                                    (\"now<hour-of-day> and <relative minutes>\", -5.298317366548036),\n                                    (\"yearmonth\", -2.557477342622836),\n                                    (\"Ter\\231a-feiraright now\", -5.298317366548036),\n                                    (\"Sexta-feiraintersect\", -5.298317366548036),\n                                    (\"Fevereiro\\224s <time-of-day>\", -5.298317366548036),\n                                    (\"dayminute\", -4.892852258439873),\n                                    (\"Setembrotwo time tokens separated by \\\",\\\"\",\n                                     -5.298317366548036),\n                                    (\"intersect by `da` or `de`intersect\", -5.298317366548036),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>de <year>\",\n                                     -5.298317366548036),\n                                    (\"intersectSexta-feira\", -4.892852258439873),\n                                    (\"intersect by `da` or `de`two time tokens separated by \\\",\\\"2\",\n                                     -5.298317366548036),\n                                    (\"yearo <ordinal> <cycle> de <time>\", -4.892852258439873),\n                                    (\"Maioyear\", -4.892852258439873),\n                                    (\"passado <cycle>de <year>\", -5.298317366548036),\n                                    (\"Sexta-feiraintersect by `da` or `de`\", -4.199705077879927),\n                                    (\"intersect by `da` or `de`Sexta-feira\", -4.382026634673881),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) <named-month>\",\n                                     -4.892852258439873),\n                                    (\"intersect by `da` or `de`year\", -5.298317366548036),\n                                    (\"two time tokens separated by \\\",\\\"de <year>\",\n                                     -4.892852258439873),\n                                    (\"intersect by `da` or `de`de <year>\", -3.7942399697717626),\n                                    (\"yearquarter\", -2.277892480403674),\n                                    (\"de <datetime> - <datetime> (interval)Julho\",\n                                     -5.298317366548036),\n                                    (\"daynograin\", -5.298317366548036),\n                                    (\"yearantes das <time-of-day>\", -2.4651040224918206),\n                                    (\"Maiode <year>\", -4.605170185988091),\n                                    (\"two time tokens separated by \\\",\\\"2de <year>\",\n                                     -4.892852258439873),\n                                    (\"intersectde <year>\", -5.298317366548036),\n                                    (\"<time-of-day> am|pm<day-of-month> (ordinal or number) de <named-month>\",\n                                     -4.605170185988091)],\n                               n = 151}}),\n       (\"<ordinal> <cycle> de <year> - <ordinal> <cycle> de <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.174387269895637,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyearmonthyear\", -1.3862943611198906),\n                                    (\"ordinals (1..10)mes (grain)yearordinals (1..10)mes (grain)year\",\n                                     -1.3862943611198906),\n                                    (\"ordinals (1..10)trimestre (grain)yearordinals (1..10)trimestre (grain)year\",\n                                     -1.3862943611198906),\n                                    (\"quarteryearquarteryear\", -1.3862943611198906)],\n                               n = 30},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"season\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minutos (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"two time tokens separated by \\\",\\\"2\",\n        Classifier{okData =\n                     ClassData{prior = -1.0360919316867756,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Segunda-feira<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.917770732084279),\n                                    (\"yearSexta-feira\", -2.917770732084279),\n                                    (\"dayday\", -1.3083328196501787),\n                                    (\"de <year>Sexta-feira\", -2.917770732084279),\n                                    (\"Sexta-feira<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.512305623976115),\n                                    (\"Sexta-feiraintersect\", -2.512305623976115),\n                                    (\"intersectSexta-feira\", -2.917770732084279),\n                                    (\"Sexta-feiraintersect by `da` or `de`\", -2.512305623976115),\n                                    (\"intersect by `da` or `de`Sexta-feira\", -2.917770732084279),\n                                    (\"yearday\", -2.512305623976115)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -0.4382549309311553, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.3978952727983707),\n                                    (\"dayhour\", -1.5224265354444706),\n                                    (\"daymonth\", -2.6210388241125804),\n                                    (\"monthday\", -2.908720896564361),\n                                    (\"Segunda-feiraintersect by `da` or `de`\", -2.908720896564361),\n                                    (\"Sexta-feiraintersect\", -2.908720896564361),\n                                    (\"intersectSexta-feira\", -2.908720896564361),\n                                    (\"Sexta-feiraintersect by `da` or `de`\", -1.6094379124341003),\n                                    (\"intersect by `da` or `de`Sexta-feira\", -2.3978952727983707)],\n                               n = 20}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.35894509247327155),\n                                    (\"integer (0..19)\", -1.3099213823353166),\n                                    (\"tens (20..90)\", -3.4499875458315876)],\n                               n = 60}}),\n       (\"n[ao] <date>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dia <day-of-month> (non ordinal)\", -1.0986122886681098),\n                                    (\"Domingo\", -1.5040773967762742), (\"day\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"amanh\\227 pela <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -4.770684624465665,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<hour-of-day> and quinzeafternoon\", -3.152736022363656),\n                                    (\"dayhour\", -2.68273239311792),\n                                    (\"\\224s <time-of-day>morning\", -3.3758795736778655),\n                                    (\"intersectevening\", -4.069026754237811),\n                                    (\"tomorrowafternoon\", -4.069026754237811),\n                                    (\"hourhour\", -1.8718021769015913),\n                                    (\"<hour-of-day> and halfafternoon\", -3.152736022363656),\n                                    (\"minutehour\", -1.6711314814394402),\n                                    (\"tomorrowevening\", -4.069026754237811),\n                                    (\"time-of-day (latent)morning\", -3.3758795736778655),\n                                    (\"yesterdayafternoon\", -4.069026754237811),\n                                    (\"time-of-day (latent)evening\", -3.6635616461296463),\n                                    (\"\\224s <time-of-day>afternoon\", -2.4595888418037104),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>morning\",\n                                     -4.069026754237811),\n                                    (\"dia <day-of-month> de <named-month>morning\",\n                                     -4.069026754237811),\n                                    (\"yesterdayevening\", -4.069026754237811),\n                                    (\"time-of-day (latent)afternoon\", -3.6635616461296463),\n                                    (\"<hour-of-day> and <relative minutes>afternoon\",\n                                     -2.816263785742443),\n                                    (\"intersectmorning\", -4.069026754237811),\n                                    (\"\\224s <time-of-day>evening\", -3.3758795736778655),\n                                    (\"intersect by `da` or `de`morning\", -4.069026754237811)],\n                               n = 45},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -4.1588830833596715,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -1.578185368929996),\n                                    (\"monthhour\", -3.044522437723423),\n                                    (\"hourhour\", -2.5336968139574325),\n                                    (\"time-of-day (latent)morning\", -3.4499875458315876),\n                                    (\"year (latent)afternoon\", -2.3513752571634776),\n                                    (\"time-of-day (latent)evening\", -3.4499875458315876),\n                                    (\"Fevereiromorning\", -3.4499875458315876),\n                                    (\"year (latent)evening\", -2.7568403652716422),\n                                    (\"time-of-day (latent)afternoon\", -3.044522437723423),\n                                    (\"year (latent)morning\", -2.5336968139574325),\n                                    (\"intersect by `da` or `de`morning\", -3.4499875458315876)],\n                               n = 18}}),\n       (\"dentro de <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -2.772588722239781, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> <unit-of-duration>\", -1.6094379124341003),\n                                    (\"hour\", -1.6094379124341003)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15}}),\n       (\"Segunda-feira\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Fevereiro\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> trimestre <year>\",\n        Classifier{okData =\n                     ClassData{prior = -1.2499579175677595, unseen = -4.700480365792417,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1..10)trimestre (grain)de <year>\",\n                                     -1.080429969584919),\n                                    (\"quarteryear\", -0.7401041636477163),\n                                    (\"ordinals (1..10)trimestre (grain)year\", -1.9187591599893623)],\n                               n = 51},\n                   koData =\n                     ClassData{prior = -0.3375964638334939, unseen = -5.568344503761097,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterquarter\", -0.7124901434030763),\n                                    (\"ordinals (1..10)trimestre (grain)intersect\",\n                                     -2.4734779539643776),\n                                    (\"ordinals (1..10)trimestre (grain)<datetime> - <datetime> (interval)\",\n                                     -1.539168716587544),\n                                    (\"ordinals (1..10)trimestre (grain)entre <datetime> e <datetime> (interval)\",\n                                     -1.6132766887412662)],\n                               n = 127}}),\n       (\"dia <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.13353139262452263),\n                                    (\"integer (0..19)\", -2.0794415416798357)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> trimestre\",\n        Classifier{okData =\n                     ClassData{prior = -2.871679624884012, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1..10)trimestre (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -5.826890812397576e-2,\n                               unseen = -4.634728988229636,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1..10)trimestre (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 50}}),\n       (\"<day-of-month> (ordinal or number) de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2363887780642304, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fevereiro\", -2.2246235515243336),\n                                    (\"integer (numeric)Mar\\231o\", -3.20545280453606),\n                                    (\"integer (0..19)Maio\", -3.20545280453606),\n                                    (\"integer (numeric)Abril\", -3.6109179126442243),\n                                    (\"integer (numeric)Julho\", -3.20545280453606),\n                                    (\"ordinals (1..10)Mar\\231o\", -3.6109179126442243),\n                                    (\"integer (numeric)Dezembro\", -3.6109179126442243),\n                                    (\"integer (numeric)Janeiro\", -3.6109179126442243),\n                                    (\"month\", -0.8700778887190235),\n                                    (\"integer (0..19)Julho\", -3.6109179126442243),\n                                    (\"integer (0..19)Abril\", -3.6109179126442243),\n                                    (\"integer (numeric)Maio\", -2.917770732084279),\n                                    (\"integer (0..19)Mar\\231o\", -2.917770732084279),\n                                    (\"integer (numeric)Setembro\", -2.512305623976115)],\n                               n = 30},\n                   koData =\n                     ClassData{prior = -1.55814461804655, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Julho\", -1.2039728043259361),\n                                    (\"month\", -1.2039728043259361)],\n                               n = 8}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia <day-of-month> de <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)Fevereiro\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"evening\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"passado <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.5686159179138452),\n                                    (\"semana (grain)\", -1.5686159179138452),\n                                    (\"quarter\", -2.0794415416798357),\n                                    (\"trimestre (grain)\", -2.0794415416798357),\n                                    (\"hour\", -2.4849066497880004),\n                                    (\"hora (grain)\", -2.4849066497880004)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -1.6486586255873816),\n                                    (\"quarter\", -2.159484249353372), (\"year\", -2.159484249353372),\n                                    (\"ano (grain)\", -2.159484249353372),\n                                    (\"trimestre (grain)\", -2.159484249353372),\n                                    (\"month\", -1.6486586255873816)],\n                               n = 8}}),\n       (\"Ter\\231a-feira\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Domingo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"antes das <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -2.740840023925201, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -2.0794415416798357),\n                                    (\"noon\", -2.0794415416798357), (\"hour\", -1.5686159179138452)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -6.669137449867228e-2,\n                               unseen = -4.890349128221754,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> <cycle> <time>\", -2.174751721484161),\n                                    (\"intersect by `da` or `de`\", -2.9368917735310576),\n                                    (\"<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.4965075614664802),\n                                    (\"<ordinal> <cycle> de <time>\", -2.3178525651248343),\n                                    (\"year (latent)\", -3.4965075614664802),\n                                    (\"<ordinal> trimestre <year>\", -2.803360380906535),\n                                    (\"<ordinal> trimestre\", -2.803360380906535),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.4965075614664802),\n                                    (\"day\", -2.9368917735310576), (\"quarter\", -1.550597412411167),\n                                    (\"time-of-day (latent)\", -3.4965075614664802),\n                                    (\"year\", -3.4965075614664802), (\"hour\", -2.9368917735310576),\n                                    (\"month\", -2.049588578530155)],\n                               n = 58}}),\n       (\"dd-dd <month>(interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Julho\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (11..19)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods =\n                                 HashMap.fromList [(\"ordinals (1..10)ordinals (1..10)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> passado\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9459101490553135),\n                                    (\"semana (grain)\", -1.9459101490553135),\n                                    (\"mes (grain)\", -2.639057329615259),\n                                    (\"quarter\", -2.2335922215070942), (\"year\", -2.639057329615259),\n                                    (\"ano (grain)\", -2.639057329615259),\n                                    (\"trimestre (grain)\", -2.2335922215070942),\n                                    (\"hour\", -2.2335922215070942), (\"month\", -2.639057329615259),\n                                    (\"hora (grain)\", -2.2335922215070942)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.7047480922384253, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"mes (grain)\", -1.9459101490553135),\n                                    (\"year\", -1.9459101490553135),\n                                    (\"ano (grain)\", -1.9459101490553135),\n                                    (\"month\", -1.9459101490553135)],\n                               n = 2}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"mes (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.219507705176107,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 66},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (1..10)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2565418317160577, unseen = -4.68213122712422,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 106},\n                   koData =\n                     ClassData{prior = -1.4859937213429786,\n                               unseen = -3.4965075614664802,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 31}}),\n       (\"<integer> para as <hour-of-day> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)noon\", -1.7047480922384253),\n                                    (\"integer (0..19)noon\", -1.0116009116784799),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"o <ordinal> trimestre\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1..10)trimestre (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 4}}),\n       (\"<dim time> da manha\",\n        Classifier{okData =\n                     ClassData{prior = -0.262364264467491, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect by `da` or `de`\", -2.70805020110221),\n                                    (\"intersect\", -2.70805020110221),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>\",\n                                     -2.70805020110221),\n                                    (\"dia <day-of-month> de <named-month>\", -2.70805020110221),\n                                    (\"day\", -2.0149030205422647),\n                                    (\"time-of-day (latent)\", -2.0149030205422647),\n                                    (\"hour\", -1.3217558399823195),\n                                    (\"\\224s <time-of-day>\", -2.0149030205422647)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.466337068793427, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect by `da` or `de`\", -2.0794415416798357),\n                                    (\"Fevereiro\", -2.0794415416798357),\n                                    (\"time-of-day (latent)\", -2.0794415416798357),\n                                    (\"hour\", -2.0794415416798357), (\"month\", -1.6739764335716716)],\n                               n = 3}}),\n       (\"em <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9444389791664407), (\"second\", -2.9444389791664407),\n                                    (\"day\", -2.538973871058276), (\"year\", -2.538973871058276),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"hour\", -2.2512917986064953), (\"month\", -2.9444389791664407),\n                                    (\"minute\", -1.845826690498331)],\n                               n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n passados <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)mes (grain)\", -1.3862943611198906),\n                                    (\"integer (numeric)ano (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906), (\"month\", -1.3862943611198906)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<cycle> actual\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter\", -0.6931471805599453),\n                                    (\"trimestre (grain)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"passados n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)dia (grain)\", -2.0794415416798357),\n                                    (\"integer (numeric)mes (grain)\", -1.6739764335716716),\n                                    (\"integer (numeric)ano (grain)\", -1.6739764335716716),\n                                    (\"day\", -2.0794415416798357), (\"year\", -1.6739764335716716),\n                                    (\"month\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> passados\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)mes (grain)\", -1.3862943611198906),\n                                    (\"integer (numeric)ano (grain)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906), (\"month\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Janeiro\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and 3/4\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702),\n                                    (\"\\224s <time-of-day>\", -1.2992829841302609)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\250ltimo <cycle> <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.540445040947149),\n                                    (\"trimestre (grain)year\", -1.9459101490553135),\n                                    (\"quarteryear\", -1.540445040947149),\n                                    (\"mes (grain)year\", -1.9459101490553135),\n                                    (\"trimestre (grain)de <year>\", -1.9459101490553135),\n                                    (\"mes (grain)de <year>\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Dezembro\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.916290731874155),\n                                    (\"integer (0..19)\", -0.5596157879354228)],\n                               n = 32},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -4.219507705176107,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.27286698666664033),\n                                    (\"integer (0..19)\", -1.5656352897757075),\n                                    (\"tens (20..90)\", -3.5115454388310208)],\n                               n = 64}}),\n       (\"<hour-of-day> and <relative minutes>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2719337154836418, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224s <time-of-day>tens (20..90)\", -2.5902671654458267),\n                                    (\"time-of-day (latent)integer (0..19)\", -2.0794415416798357),\n                                    (\"time-of-day (latent)tens (20..90)\", -2.5902671654458267),\n                                    (\"nooninteger (0..19)\", -2.995732273553991),\n                                    (\"time-of-day (latent)number (21..29 31..39 .. 91..99)\",\n                                     -2.5902671654458267),\n                                    (\"hour\", -0.8556661100577202),\n                                    (\"\\224s <time-of-day>number (21..29 31..39 .. 91..99)\",\n                                     -2.5902671654458267),\n                                    (\"\\224s <time-of-day>integer (0..19)\", -2.3025850929940455)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -1.4350845252893227,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\224s <time-of-day>tens (20..90)\", -1.791759469228055),\n                                    (\"time-of-day (latent)integer (0..19)\", -2.1972245773362196),\n                                    (\"time-of-day (latent)tens (20..90)\", -1.791759469228055),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 5}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -5.8107630807280694e-2,\n                               unseen = -4.77912349311153,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 117},\n                   koData =\n                     ClassData{prior = -2.8743714165497236,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 7}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7841189587656721, unseen = -4.174387269895637,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number (21..29 31..39 .. 91..99)hora (grain)\",\n                                     -3.4657359027997265),\n                                    (\"week\", -2.772588722239781),\n                                    (\"integer (0..19)segundo (grain)\", -3.4657359027997265),\n                                    (\"integer (numeric)hora (grain)\", -3.4657359027997265),\n                                    (\"integer (numeric)dia (grain)\", -3.4657359027997265),\n                                    (\"integer (0..19)ano (grain)\", -3.0602707946915624),\n                                    (\"second\", -3.4657359027997265),\n                                    (\"integer (0..19)semana (grain)\", -2.772588722239781),\n                                    (\"integer (numeric)ano (grain)\", -3.4657359027997265),\n                                    (\"integer (0..19)mes (grain)\", -3.0602707946915624),\n                                    (\"integer (0..19)hora (grain)\", -2.772588722239781),\n                                    (\"integer (numeric)minutos (grain)\", -2.772588722239781),\n                                    (\"day\", -3.0602707946915624), (\"year\", -2.772588722239781),\n                                    (\"integer (0..19)minutos (grain)\", -3.0602707946915624),\n                                    (\"hour\", -2.367123614131617), (\"month\", -3.0602707946915624),\n                                    (\"minute\", -2.367123614131617),\n                                    (\"integer (0..19)dia (grain)\", -3.4657359027997265)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.6097655716208943, unseen = -4.290459441148391,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.1780538303479458),\n                                    (\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -3.1780538303479458),\n                                    (\"integer (0..19)ano (grain)\", -3.58351893845611),\n                                    (\"integer (numeric)mes (grain)\", -2.890371757896165),\n                                    (\"second\", -3.1780538303479458),\n                                    (\"integer (0..19)semana (grain)\", -3.58351893845611),\n                                    (\"integer (numeric)semana (grain)\", -3.58351893845611),\n                                    (\"integer (numeric)ano (grain)\", -2.667228206581955),\n                                    (\"integer (0..19)mes (grain)\", -3.1780538303479458),\n                                    (\"integer (0..19)hora (grain)\", -3.1780538303479458),\n                                    (\"integer (numeric)minutos (grain)\", -3.1780538303479458),\n                                    (\"day\", -3.1780538303479458),\n                                    (\"integer (numeric)segundo (grain)\", -3.1780538303479458),\n                                    (\"year\", -2.4849066497880004), (\"hour\", -2.1972245773362196),\n                                    (\"month\", -2.4849066497880004),\n                                    (\"minute\", -3.1780538303479458)],\n                               n = 25}}),\n       (\"proximas n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)hora (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)dia (grain)\", -2.4849066497880004),\n                                    (\"integer (0..19)ano (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.4849066497880004),\n                                    (\"integer (0..19)mes (grain)\", -2.4849066497880004),\n                                    (\"integer (numeric)minutos (grain)\", -2.4849066497880004),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"integer (numeric)segundo (grain)\", -2.4849066497880004),\n                                    (\"year\", -2.4849066497880004), (\"hour\", -2.4849066497880004),\n                                    (\"month\", -2.4849066497880004),\n                                    (\"minute\", -2.4849066497880004)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"hour\", -0.8472978603872037),\n                                    (\"\\224s <time-of-day>\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.3364722366212129, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.7731898882334817),\n                                    (\"hour\", -0.7731898882334817)],\n                               n = 5}}),\n       (\"n proximas <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)mes (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)ano (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"vespera de ano novo\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Quart-feira\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"o <ordinal> <cycle> de <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.3862943611198906),\n                                    (\"ordinals (1..10)mes (grain)year\", -1.3862943611198906),\n                                    (\"quarteryear\", -1.3862943611198906),\n                                    (\"ordinals (1..10)trimestre (grain)year\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"Quinta-feira\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day of month (1st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> <cycle> <year> - <ordinal> <cycle> <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.465908118654584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (1..10)trimestre (grain)de <year>ordinals (1..10)trimestre (grain)de <year>\",\n                                     -1.6817585740137264),\n                                    (\"ordinals (1..10)mes (grain)de <year>ordinals (1..10)mes (grain)de <year>\",\n                                     -1.6817585740137264),\n                                    (\"monthyearmonthyear\", -1.4098248585300848),\n                                    (\"ordinals (1..10)mes (grain)yearordinals (1..10)mes (grain)year\",\n                                     -2.662587827025453),\n                                    (\"ordinals (1..10)trimestre (grain)yearordinals (1..10)trimestre (grain)year\",\n                                     -2.662587827025453),\n                                    (\"quarteryearquarteryear\", -1.4098248585300848)],\n                               n = 40},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"trimestre (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.174387269895637,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 63},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"este <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9459101490553135),\n                                    (\"semana (grain)\", -1.9459101490553135),\n                                    (\"quarter\", -1.9459101490553135), (\"year\", -1.9459101490553135),\n                                    (\"ano (grain)\", -1.9459101490553135),\n                                    (\"trimestre (grain)\", -1.9459101490553135)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.252762968495368),\n                                    (\"dia (grain)\", -1.252762968495368)],\n                               n = 3}}),\n       (\"<named-month|named-day> next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"Quart-feira\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Setembro\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"year (latent)\", -1.3862943611198906),\n                                    (\"time-of-day (latent)\", -1.3862943611198906),\n                                    (\"year\", -1.3862943611198906), (\"hour\", -1.3862943611198906)],\n                               n = 4}}),\n       (\"\\250ltimo <cycle> de <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -1.3862943611198906),\n                                    (\"trimestre (grain)year\", -1.3862943611198906),\n                                    (\"quarteryear\", -1.3862943611198906),\n                                    (\"mes (grain)year\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> dessa semana\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Ter\\231a-feira\", -0.6931471805599453),\n                                    (\"day\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ano novo\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"dd[/-.]mm[/-.]yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> de (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)Julho\",\n                                     -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> (proximo|que vem)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"integer (numeric)semana (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)ano (grain)\", -1.791759469228055),\n                                    (\"integer (0..19)mes (grain)\", -1.791759469228055),\n                                    (\"year\", -1.791759469228055), (\"month\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> and quinze\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.3862943611198906),\n                                    (\"noon\", -2.3025850929940455), (\"hour\", -0.7985076962177716),\n                                    (\"\\224s <time-of-day>\", -1.6094379124341003)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"depois das <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> horas\", -1.6739764335716716),\n                                    (\"time-of-day (latent)\", -1.6739764335716716),\n                                    (\"noon\", -1.6739764335716716), (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"negative numbers\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 6}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.20938473514278214,\n                               unseen = -6.523562306149512,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> <cycle> <time><ordinal> trimestre <year>\",\n                                     -3.4775703604467294),\n                                    (\"de <year><ordinal> trimestre <year>\", -3.7495040759303713),\n                                    (\"<ordinal> trimestre <year><ordinal> <cycle> <time>\",\n                                     -3.4775703604467294),\n                                    (\"year<ordinal> <cycle> de <time>\", -3.7495040759303713),\n                                    (\"quarterquarter\", -1.4722367909206153),\n                                    (\"minuteminute\", -5.8289456176102075),\n                                    (\"<ordinal> <cycle> <time><ordinal> <cycle> <time>\",\n                                     -2.8085207314658445),\n                                    (\"dayday\", -5.8289456176102075),\n                                    (\"de <year><ordinal> <cycle> <time>\", -3.7495040759303713),\n                                    (\"hh(:|.|h)mm (time-of-day)hh(:|.|h)mm (time-of-day)\",\n                                     -5.8289456176102075),\n                                    (\"monthmonth\", -2.332438056143727),\n                                    (\"<day-of-month> (ordinal or number) de <named-month><day-of-month> (ordinal or number) de <named-month>\",\n                                     -5.8289456176102075),\n                                    (\"<ordinal> trimestre <year><ordinal> trimestre <year>\",\n                                     -3.4775703604467294),\n                                    (\"<ordinal> trimestre <year><ordinal> <cycle> de <time>\",\n                                     -3.7495040759303713),\n                                    (\"<ordinal> <cycle> <time><ordinal> <cycle> de <time>\",\n                                     -3.088105593685006),\n                                    (\"de <year><ordinal> <cycle> de <time>\", -3.7495040759303713),\n                                    (\"<ordinal> <cycle> de <time><ordinal> <cycle> <time>\",\n                                     -3.088105593685006),\n                                    (\"year<ordinal> trimestre <year>\", -3.4775703604467294),\n                                    (\"<ordinal> <cycle> de <time><ordinal> <cycle> de <time>\",\n                                     -3.088105593685006),\n                                    (\"year<ordinal> <cycle> <time>\", -3.4775703604467294),\n                                    (\"yearquarter\", -1.906972281328893),\n                                    (\"<ordinal> <cycle> de <time><ordinal> trimestre <year>\",\n                                     -3.7495040759303713)],\n                               n = 322},\n                   koData =\n                     ClassData{prior = -1.66644816715088, unseen = -5.231108616854587,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -4.532599493153256),\n                                    (\"dayhour\", -4.532599493153256),\n                                    (\"daymonth\", -4.532599493153256),\n                                    (\"monthday\", -4.127134385045092),\n                                    (\"year<ordinal> <cycle> de <time>\", -2.45315795147342),\n                                    (\"Dezembro<day-of-month> (ordinal or number) de <named-month>\",\n                                     -4.532599493153256),\n                                    (\"monthhour\", -4.127134385045092),\n                                    (\"de <year><ordinal> <cycle> <time>\", -2.45315795147342),\n                                    (\"monthmonth\", -4.532599493153256),\n                                    (\"hourhour\", -4.532599493153256),\n                                    (\"dayyear\", -4.532599493153256),\n                                    (\"intersect by `da` or `de`<day-of-month> (ordinal or number) de <named-month>\",\n                                     -4.127134385045092),\n                                    (\"de <year><ordinal> <cycle> de <time>\", -2.45315795147342),\n                                    (\"yearmonth\", -1.0360919316867756),\n                                    (\"intersect by `da` or `de`intersect by `da` or `de`\",\n                                     -4.127134385045092),\n                                    (\"year<ordinal> <cycle> <time>\", -2.181224235989778),\n                                    (\"Dezembrointersect by `da` or `de`\", -4.127134385045092),\n                                    (\"dd[/-]mmyear\", -4.532599493153256),\n                                    (\"<day-of-month> (ordinal or number) de <named-month>intersect by `da` or `de`\",\n                                     -4.127134385045092)],\n                               n = 75}}),\n       (\"entre <datetime> e <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3371303478657622, unseen = -6.163314804034641,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<ordinal> <cycle> <time><ordinal> trimestre <year>\",\n                                     -3.4531571205928664),\n                                    (\"<ordinal> trimestre <year><ordinal> <cycle> <time>\",\n                                     -3.4531571205928664),\n                                    (\"year<ordinal> <cycle> de <time>\", -3.270835563798912),\n                                    (\"quarterquarter\", -1.3990333868973204),\n                                    (\"<ordinal> <cycle> <time><ordinal> <cycle> <time>\",\n                                     -2.7939114917086023),\n                                    (\"monthmonth\", -2.2293816889707507),\n                                    (\"<ordinal> trimestre <year><ordinal> trimestre <year>\",\n                                     -3.4531571205928664),\n                                    (\"<ordinal> trimestre <year><ordinal> <cycle> de <time>\",\n                                     -3.5962579642335397),\n                                    (\"<ordinal> <cycle> <time><ordinal> <cycle> de <time>\",\n                                     -2.942331496826876),\n                                    (\"<ordinal> <cycle> de <time><ordinal> <cycle> <time>\",\n                                     -2.942331496826876),\n                                    (\"year<ordinal> trimestre <year>\", -3.270835563798912),\n                                    (\"<ordinal> <cycle> de <time><ordinal> <cycle> de <time>\",\n                                     -2.942331496826876),\n                                    (\"year<ordinal> <cycle> <time>\", -3.270835563798912),\n                                    (\"yearquarter\", -2.209963603113649),\n                                    (\"<ordinal> <cycle> de <time><ordinal> trimestre <year>\",\n                                     -3.5962579642335397)],\n                               n = 217},\n                   koData =\n                     ClassData{prior = -1.2511195827516381,\n                               unseen = -5.3706380281276624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.420065865966538),\n                                    (\"monthday\", -4.672828834461907),\n                                    (\"monthyear\", -4.672828834461907),\n                                    (\"yearhour\", -3.0633909220278057),\n                                    (\"year (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.979681653901961),\n                                    (\"year (latent)intersect by `da` or `de`\", -3.420065865966538),\n                                    (\"time-of-day (latent)year (latent)\", -3.420065865966538),\n                                    (\"houryear\", -3.420065865966538),\n                                    (\"year<ordinal> <cycle> de <time>\", -2.4756042571256867),\n                                    (\"Dezembro<day-of-month> (ordinal or number) de <named-month>\",\n                                     -4.672828834461907),\n                                    (\"monthhour\", -4.267363726353742),\n                                    (\"yearyear\", -3.420065865966538),\n                                    (\"hourmonth\", -3.979681653901961),\n                                    (\"time-of-day (latent)intersect by `da` or `de`\",\n                                     -3.420065865966538),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -3.420065865966538),\n                                    (\"year (latent)year (latent)\", -3.420065865966538),\n                                    (\"monthmonth\", -4.672828834461907),\n                                    (\"hourhour\", -3.0633909220278057),\n                                    (\"Dezembrotime-of-day (latent)\", -4.672828834461907),\n                                    (\"year (latent)<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.979681653901961),\n                                    (\"Dezembroyear (latent)\", -4.672828834461907),\n                                    (\"year (latent)time-of-day (latent)\", -3.420065865966538),\n                                    (\"yearmonth\", -1.7283898552954657),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) <named-month>\",\n                                     -3.979681653901961),\n                                    (\"year<ordinal> <cycle> <time>\", -2.4756042571256867),\n                                    (\"yearday\", -3.420065865966538),\n                                    (\"Dezembrointersect by `da` or `de`\", -4.267363726353742),\n                                    (\"time-of-day (latent)<day-of-month> (ordinal or number) de <named-month>\",\n                                     -3.979681653901961)],\n                               n = 87}}),\n       (\"segundo (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"desde <month> dd-dd de (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)Julho\",\n                                     -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Maiointeger (0..19)\", -1.8718021769015913),\n                                    (\"Julhointeger (numeric)\", -1.8718021769015913),\n                                    (\"Julhointeger (0..19)\", -1.8718021769015913),\n                                    (\"month\", -0.9555114450274363),\n                                    (\"Maiointeger (numeric)\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mar\\231o\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tens (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dia (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"in the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoon\", -1.6094379124341003),\n                                    (\"hour\", -0.7621400520468967), (\"evening\", -1.791759469228055),\n                                    (\"morning\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Segunda-feira\", -1.6582280766035324),\n                                    (\"Ter\\231a-feira\", -1.0986122886681098),\n                                    (\"day\", -0.7419373447293773)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"natal\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hora (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"right now\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quinze para as <hour-of-day> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -0.6931471805599453), (\"hour\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\224s <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24921579162398486, unseen = -4.77912349311153,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -4.07753744390572),\n                                    (\"hh(:|.|h)mm (time-of-day)\", -3.1612467120315646),\n                                    (\"<hour-of-day> and half\", -3.1612467120315646),\n                                    (\"<time-of-day> horas\", -3.3843902633457743),\n                                    (\"<hour-of-day> and 3/4\", -3.672072335797555),\n                                    (\"time-of-day (latent)\", -1.4033887944791907),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.691243082785829),\n                                    (\"<time-of-day> am|pm\", -4.07753744390572),\n                                    (\"hour\", -1.2443240998495033),\n                                    (\"<hour-of-day> and quinze\", -3.3843902633457743),\n                                    (\"minute\", -1.7261621867422419)],\n                               n = 53},\n                   koData =\n                     ClassData{prior = -1.5114575040738967,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -3.044522437723423),\n                                    (\"<time-of-day> horas\", -3.044522437723423),\n                                    (\"time-of-day (latent)\", -1.252762968495368),\n                                    (\"<hour-of-day> and <relative minutes>\", -2.639057329615259),\n                                    (\"hour\", -1.0986122886681098), (\"minute\", -2.639057329615259)],\n                               n = 15}}),\n       (\"fazem <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003), (\"year\", -2.0149030205422647),\n                                    (\"<integer> <unit-of-duration>\", -0.916290731874155),\n                                    (\"hour\", -2.0149030205422647), (\"month\", -2.0149030205422647)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd-dd <month> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)integer (numeric)Julho\",\n                                     -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"n <cycle> atras\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055), (\"second\", -1.791759469228055),\n                                    (\"integer (0..19)semana (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)minutos (grain)\", -1.791759469228055),\n                                    (\"integer (numeric)segundo (grain)\", -1.791759469228055),\n                                    (\"minute\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"season\", -2.1102132003465894),\n                                    (\"Segunda-feira\", -2.1102132003465894),\n                                    (\"dia <day-of-month> (non ordinal)\", -2.1102132003465894),\n                                    (\"day\", -1.1939224684724346), (\"hour\", -1.8870696490323797),\n                                    (\"evening\", -2.3978952727983707),\n                                    (\"week-end\", -2.3978952727983707)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 2027}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.RO_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"luni\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"acum\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.8971199848858813),\n                                    (\"martithe <day-of-month> (number)\", -2.3025850929940455),\n                                    (\"dayday\", -1.2039728043259361),\n                                    (\"absorption of , after named day<day-of-month>(number) <named-month>\",\n                                     -1.8971199848858813),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -1.8971199848858813),\n                                    (\"<named-day> <day-of-month> (number)februarie\",\n                                     -1.8971199848858813)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-day> <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7884573603642702),\n                                    (\"martiinteger (numeric)\", -1.2992829841302609),\n                                    (\"absorption of , after named dayinteger (numeric)\",\n                                     -1.2992829841302609)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"duminica\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"marti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"iunie\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with - or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"luni\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"februarie\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"craciun\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"sambata\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"joi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"vineri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ieri\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"luni<day-of-month>(number) <named-month>\",\n                                     -1.2992829841302609),\n                                    (\"dayday\", -0.7884573603642702),\n                                    (\"luni<day-of-month> (non ordinal) <named-month>\",\n                                     -1.2992829841302609)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"azi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-day> pe <day-of-month> (number)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"martiinteger (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> (aceasta|acesta|[a\\259]sta)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"luni\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"iunieinteger (numeric)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)martie\", -1.791759469228055),\n                                    (\"integer (numeric)februarie\", -1.3862943611198906),\n                                    (\"integer (0..10)martie\", -1.791759469228055),\n                                    (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"luni\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"martie\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"maine\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"iunie\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(number) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)martie\", -1.791759469228055),\n                                    (\"integer (numeric)februarie\", -1.3862943611198906),\n                                    (\"integer (0..10)martie\", -1.791759469228055),\n                                    (\"month\", -0.8754687373538999)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 293}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.RU_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"midnight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1055\\1086\\1085\\1077\\1076\\1077\\1083\\1100\\1085\\1080\\1082\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7865811872060422, unseen = -4.59511985013459,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 97},\n                   koData =\n                     ClassData{prior = -0.6077019746030605, unseen = -4.770684624465665,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 116}}),\n       (\"\\1057\\1088\\1077\\1076\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (3..19)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1087\\1086\\1079\\1072\\1087\\1086\\1079\\1072\\1074\\1095\\1077\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"\\1074\\1095\\1077\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1568424714929697, unseen = -4.919980925828125,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.8140425970679424),\n                                    (\"until <time-of-day>afternoon\", -4.219507705176107),\n                                    (\"dayhour\", -2.966744736680739),\n                                    (\"on <date>evening\", -4.219507705176107),\n                                    (\"at <time-of-day>evening\", -4.219507705176107),\n                                    (\"intersect by ','evening\", -3.8140425970679424),\n                                    (\"intersectevening\", -2.4277482359480516),\n                                    (\"hourhour\", -1.1514547700424895),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072lunch\", -4.219507705176107),\n                                    (\"on <date>afternoon\", -3.3032169733019514),\n                                    (\"at <time-of-day>afternoon\", -3.3032169733019514),\n                                    (\"<time-of-day>  o'clockafternoon\", -2.4277482359480516),\n                                    (\"until <time-of-day>morning\", -4.219507705176107),\n                                    (\"minutehour\", -3.120895416507997),\n                                    (\"time-of-day (latent)morning\", -4.219507705176107),\n                                    (\"hh:mmmorning\", -4.219507705176107),\n                                    (\"\\1074\\1095\\1077\\1088\\1072evening\", -4.219507705176107),\n                                    (\"time-of-day (latent)evening\", -4.219507705176107),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072evening\", -4.219507705176107),\n                                    (\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103afternoon\",\n                                     -3.8140425970679424),\n                                    (\"<time-of-day>  o'clockevening\", -3.8140425970679424),\n                                    (\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103evening\",\n                                     -4.219507705176107),\n                                    (\"hh:mmnight\", -4.219507705176107),\n                                    (\"hh:mmafternoon\", -4.219507705176107),\n                                    (\"on <date>morning\", -4.219507705176107),\n                                    (\"at <time-of-day>morning\", -4.219507705176107)],\n                               n = 53},\n                   koData =\n                     ClassData{prior = -1.929909807708872, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.772588722239781),\n                                    (\"intersectevening\", -2.4849066497880004),\n                                    (\"hourhour\", -1.791759469228055),\n                                    (\"year (latent)afternoon\", -3.1780538303479458),\n                                    (\"year (latent)night\", -3.1780538303479458),\n                                    (\"time-of-day (latent)afternoon\", -2.2617630984737906)],\n                               n = 9}}),\n       (\"numbers prefix with -, minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4700036292457356),\n                                    (\"decimal number\", -0.9808292530117262)],\n                               n = 22}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -0.7801585575495751,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -0.6131044728864089, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -4.382026634673881,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -3.676300671907076),\n                                    (\"<time-of-day>  o'clock\", -1.8044984950054848),\n                                    (\"time-of-day (latent)\", -1.3737155789130304),\n                                    (\"hh:mm\", -2.9831534913471307), (\"noon\", -3.676300671907076),\n                                    (\"hour\", -0.84308732785086), (\"minute\", -2.9831534913471307)],\n                               n = 36},\n                   koData =\n                     ClassData{prior = -2.5649493574615367, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.1786549963416462),\n                                    (\"hour\", -1.1786549963416462)],\n                               n = 3}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1055\\1086\\1085\\1077\\1076\\1077\\1083\\1100\\1085\\1080\\1082\",\n                                     -2.0794415416798357),\n                                    (\"\\1057\\1088\\1077\\1076\\1072\", -2.0794415416798357),\n                                    (\"\\1042\\1086\\1089\\1082\\1088\\1077\\1089\\1077\\1085\\1100\\1077\",\n                                     -2.4849066497880004),\n                                    (\"day\", -0.8754687373538999),\n                                    (\"\\1057\\1091\\1073\\1073\\1086\\1090\\1072\", -2.4849066497880004),\n                                    (\"\\1055\\1103\\1090\\1085\\1080\\1094\\1072\", -1.791759469228055)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -1.5748356968139168e-2,\n                               unseen = -4.990432586778736,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"midnight\", -4.290459441148391),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1077\\1083\\1100\\1085\\1080\\1082\",\n                                     -4.290459441148391),\n                                    (\"<time> <part-of-day>\", -3.0376964726530233),\n                                    (\"<time-of-day>  o'clock\", -2.4186572642467996),\n                                    (\"<ordinal> quarter\", -4.290459441148391),\n                                    (\"intersect\", -2.4186572642467996),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -3.884994333040227),\n                                    (\"day\", -2.039167642541896), (\"quarter\", -4.290459441148391),\n                                    (\"time-of-day (latent)\", -2.2755564206061263),\n                                    (\"\\1057\\1091\\1073\\1073\\1086\\1090\\1072\", -3.884994333040227),\n                                    (\"hh:mm\", -3.597312260588446),\n                                    (\"\\1042\\1090\\1086\\1088\\1085\\1080\\1082\", -4.290459441148391),\n                                    (\"\\1055\\1103\\1090\\1085\\1080\\1094\\1072\", -4.290459441148391),\n                                    (\"<day-of-month> (ordinal)\", -3.884994333040227),\n                                    (\"noon\", -4.290459441148391), (\"hour\", -1.2700345550040286),\n                                    (\"this|next <day-of-week>\", -3.597312260588446),\n                                    (\"<day-of-month>(ordinal) <named-month> year\",\n                                     -4.290459441148391),\n                                    (\"minute\", -3.3741687092742363)],\n                               n = 63},\n                   koData =\n                     ClassData{prior = -4.1588830833596715,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -2.3978952727983707),\n                                    (\"<day-of-month> (ordinal)\", -2.3978952727983707)],\n                               n = 1}}),\n       (\"\\1050\\1086\\1085\\1077\\1094 \\1084\\1077\\1089\\1103\\1094\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1074\\1077\\1089\\1085\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 1\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)time-of-day (latent)\",\n                                     -0.6931471805599453),\n                                    (\"hourhour\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -2.5649493574615367,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<time-of-day>  o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -0.12629372532429212,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.1355310083308794),\n                                    (\"on <date>\", -2.1355310083308794),\n                                    (\"time-of-day (latent)\", -1.5649861498632667),\n                                    (\"until <time-of-day>\", -3.3141860046725258),\n                                    (\"hour\", -0.7301884522402944),\n                                    (\"after <time-of-day>\", -3.3141860046725258)],\n                               n = 52},\n                   koData =\n                     ClassData{prior = -2.1316272948504063, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 7}}),\n       (\"\\1053\\1086\\1074\\1099\\1081 \\1075\\1086\\1076\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1087\\1086\\1079\\1072\\1074\\1095\\1077\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1083\\1077\\1090\\1086\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.580450375560848, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.23052365861183238,\n                               unseen = -3.367295829986474,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 27}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter\", -0.6931471805599453),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)quarter (grain)\",\n                                     -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter\", -0.6931471805599453),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)quarter (grain)\",\n                                     -0.6931471805599453)],\n                               n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.16799173123912972,\n                               unseen = -6.028278520230698,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103on <date>\",\n                                     -4.639571612705423),\n                                    (\"<day-of-month> (ordinal)\\1040\\1074\\1075\\1091\\1089\\1090\",\n                                     -5.332718793265369),\n                                    (\"hourday\", -4.079955824770001),\n                                    (\"<datetime> - <datetime> (interval)year\", -5.332718793265369),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088\\1075<time> timezone\",\n                                     -4.927253685157205),\n                                    (\"hh:mm<part-of-day> of <time>\", -4.416428061391214),\n                                    (\"dayhour\", -2.1757183721152558),\n                                    (\"daymonth\", -2.336986519711378),\n                                    (\"monthyear\", -3.627970701026944),\n                                    (\"yearhour\", -5.332718793265369),\n                                    (\"intersect<time-of-day>  o'clock\", -4.416428061391214),\n                                    (\"absorption of , after named daymm/dd/yyyy\",\n                                     -5.332718793265369),\n                                    (\"intersect<time> <part-of-day>\", -4.416428061391214),\n                                    (\"intersect by ','year\", -4.927253685157205),\n                                    (\"<day-of-month> (ordinal)\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -3.253277251585533),\n                                    (\"on <date><time-of-day>  o'clock\", -4.927253685157205),\n                                    (\"<day-of-month> (ordinal)\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -4.927253685157205),\n                                    (\"mm/dd<time-of-day>  o'clock\", -4.927253685157205),\n                                    (\"on <date>at <time-of-day>\", -4.639571612705423),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072on <date>\", -5.332718793265369),\n                                    (\"dayday\", -3.317815772723104),\n                                    (\"at <time-of-day>\\1079\\1072\\1074\\1090\\1088\\1072\",\n                                     -5.332718793265369),\n                                    (\"mm/ddat <time-of-day>\", -4.927253685157205),\n                                    (\"<day-of-month> (ordinal)intersect\", -3.828641396489095),\n                                    (\"on <date>\\1079\\1072\\1074\\1090\\1088\\1072\", -5.332718793265369),\n                                    (\"hh:mmintersect by ','\", -5.332718793265369),\n                                    (\"<day-of-month> (ordinal)\\1040\\1087\\1088\\1077\\1083\\1100\",\n                                     -5.332718793265369),\n                                    (\"<day-of-month> (ordinal)\\1052\\1072\\1088\\1090\",\n                                     -4.079955824770001),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -4.927253685157205),\n                                    (\"dayyear\", -2.560130071025588),\n                                    (\"<day-of-month> (non ordinal) <named-month>intersect\",\n                                     -5.332718793265369),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -3.828641396489095),\n                                    (\"\\1053\\1086\\1103\\1073\\1088\\1100year\", -5.332718793265369),\n                                    (\"absorption of , after named day<day-of-month>(ordinal) <named-month>\",\n                                     -5.332718793265369),\n                                    (\"minutehour\", -4.079955824770001),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -3.9464244321454784),\n                                    (\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103<time> <part-of-day>\",\n                                     -4.927253685157205),\n                                    (\"<day-of-month> (ordinal)\\1052\\1072\\1081\", -5.332718793265369),\n                                    (\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103at <time-of-day>\",\n                                     -4.416428061391214),\n                                    (\"hh:mmintersect\", -5.332718793265369),\n                                    (\"\\1054\\1082\\1090\\1103\\1073\\1088\\1100year\", -4.639571612705423),\n                                    (\"on <date>\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -5.332718793265369),\n                                    (\"intersect by ','intersect\", -5.332718793265369),\n                                    (\"absorption of , after named day<day-of-month> (ordinal)\",\n                                     -5.332718793265369),\n                                    (\"dayminute\", -4.416428061391214),\n                                    (\"<time> <part-of-day>intersect\", -5.332718793265369),\n                                    (\"intersect by ','\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -5.332718793265369),\n                                    (\"intersectyear\", -3.5409593240373143),\n                                    (\"\\1040\\1087\\1088\\1077\\1083\\1100year\", -5.332718793265369),\n                                    (\"on <date>intersect\", -5.332718793265369),\n                                    (\"minuteday\", -4.079955824770001),\n                                    (\"absorption of , after named dayintersect\", -4.23410650459726),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072<time-of-day>  o'clock\",\n                                     -4.927253685157205),\n                                    (\"intersect\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -5.332718793265369),\n                                    (\"year<time-of-day>  o'clock\", -5.332718793265369),\n                                    (\"<time-of-day>  o'clock\\1079\\1072\\1074\\1090\\1088\\1072\",\n                                     -4.639571612705423),\n                                    (\"\\1057\\1091\\1073\\1073\\1086\\1090\\1072on <date>\",\n                                     -5.332718793265369),\n                                    (\"intersect by ','<time> <part-of-day>\", -5.332718793265369),\n                                    (\"\\1057\\1091\\1073\\1073\\1086\\1090\\1072at <time-of-day>\",\n                                     -4.639571612705423),\n                                    (\"<time> <part-of-day>intersect by ','\", -5.332718793265369),\n                                    (\"<time> <part-of-day>\\1057\\1091\\1073\\1073\\1086\\1090\\1072\",\n                                     -5.332718793265369),\n                                    (\"\\1042\\1090\\1086\\1088\\1085\\1080\\1082next <cycle>\",\n                                     -5.332718793265369),\n                                    (\"mm/ddyear\", -4.927253685157205),\n                                    (\"intersect by ','<time-of-day>  o'clock\", -5.332718793265369),\n                                    (\"absorption of , after named daymm/dd\", -5.332718793265369),\n                                    (\"mm/ddon <date>\", -5.332718793265369),\n                                    (\"<time> <part-of-day>absorption of , after named day\",\n                                     -5.332718793265369),\n                                    (\"on <date>year\", -4.927253685157205),\n                                    (\"intersectintersect\", -5.332718793265369),\n                                    (\"<part-of-day> of <time><day-of-month> (non ordinal) <named-month>\",\n                                     -5.332718793265369),\n                                    (\"\\1057\\1091\\1073\\1073\\1086\\1090\\1072<time-of-day>  o'clock\",\n                                     -4.927253685157205),\n                                    (\"on <date>on <date>\", -5.332718793265369),\n                                    (\"dayweek\", -5.332718793265369),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072at <time-of-day>\",\n                                     -4.927253685157205),\n                                    (\"\\1052\\1072\\1081year\", -5.332718793265369),\n                                    (\"on <date>\\1052\\1072\\1088\\1090\", -5.332718793265369),\n                                    (\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103<time-of-day>  o'clock\",\n                                     -4.927253685157205),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.23410650459726),\n                                    (\"\\1052\\1072\\1088\\1090year\", -4.416428061391214)],\n                               n = 164},\n                   koData =\n                     ClassData{prior = -1.8666607774011728, unseen = -4.990432586778736,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -4.290459441148391),\n                                    (\"daymonth\", -2.7863820443721172),\n                                    (\"monthyear\", -3.1918471524802814),\n                                    (\"yearhour\", -4.290459441148391),\n                                    (\"intersect<time-of-day>  o'clock\", -4.290459441148391),\n                                    (\"intersect<time> <part-of-day>\", -4.290459441148391),\n                                    (\"<day-of-month> (ordinal)\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -3.3741687092742363),\n                                    (\"<day-of-month> (ordinal)\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -4.290459441148391),\n                                    (\"monthhour\", -3.597312260588446),\n                                    (\"hourmonth\", -4.290459441148391),\n                                    (\"<day-of-month> (ordinal)intersect\", -3.884994333040227),\n                                    (\"dayyear\", -2.681021528714291),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -3.884994333040227),\n                                    (\"\\1048\\1102\\1083\\1100year\", -3.884994333040227),\n                                    (\"between <time-of-day> and <time-of-day> (interval)\\1048\\1102\\1083\\1100\",\n                                     -4.290459441148391),\n                                    (\"\\1048\\1102\\1083\\1100intersect\", -4.290459441148391),\n                                    (\"<day-of-month> (ordinal)\\1052\\1072\\1081\", -4.290459441148391),\n                                    (\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103at <time-of-day>\",\n                                     -4.290459441148391),\n                                    (\"dayminute\", -3.884994333040227),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088\\1075hh:mm\",\n                                     -3.884994333040227),\n                                    (\"intersectyear\", -3.884994333040227),\n                                    (\"\\1040\\1087\\1088\\1077\\1083\\1100year\", -4.290459441148391),\n                                    (\"year<time> <part-of-day>\", -4.290459441148391),\n                                    (\"mm/ddyear\", -3.1918471524802814),\n                                    (\"\\1052\\1072\\1088\\1090year\", -3.884994333040227)],\n                               n = 30}}),\n       (\"\\1040\\1087\\1088\\1077\\1083\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1087\\1086\\1089\\1083\\1077\\1079\\1072\\1074\\1090\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913),\n                                    (\"month (grain)\", -2.159484249353372),\n                                    (\"year (grain)\", -2.159484249353372),\n                                    (\"week (grain)\", -1.8718021769015913),\n                                    (\"quarter\", -2.159484249353372), (\"year\", -2.159484249353372),\n                                    (\"month\", -2.159484249353372),\n                                    (\"quarter (grain)\", -2.159484249353372)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"one <cycle> before last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -1.0116009116784799, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..20th, then 30th, 40th, ..., 100th)quarter (grain)year\",\n                                     -0.6931471805599453),\n                                    (\"quarteryear\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal 21..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1063\\1077\\1090\\1074\\1077\\1088\\1075\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1079\\1080\\1084\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthyear\", -0.6931471805599453),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1052\\1072\\1081year\",\n                                     -0.6931471805599453)],\n                               n = 1}}),\n       (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\",\n        Classifier{okData =\n                     ClassData{prior = -0.35667494393873245,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -1.2039728043259361,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"\\1042\\1086\\1089\\1082\\1088\\1077\\1089\\1077\\1085\\1100\\1077\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -6.899287148695143e-2,\n                               unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -2.70805020110221, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -0.9555114450274363),\n                                    (\"nightabsorption of , after named day\", -1.8718021769015913),\n                                    (\"night\\1057\\1091\\1073\\1073\\1086\\1090\\1072\",\n                                     -1.8718021769015913),\n                                    (\"nightintersect by ','\", -1.8718021769015913),\n                                    (\"nightintersect\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2076393647782445, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1040\\1074\\1075\\1091\\1089\\1090\",\n                                     -3.481240089335692),\n                                    (\"ordinal 21..99\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -3.481240089335692),\n                                    (\"ordinal (digits)\\1052\\1072\\1088\\1090\", -3.0757749812275272),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -2.5649493574615367),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1052\\1072\\1088\\1090\",\n                                     -2.5649493574615367),\n                                    (\"ordinal 21..99\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -2.5649493574615367),\n                                    (\"month\", -0.878550403891308),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1040\\1087\\1088\\1077\\1083\\1100\",\n                                     -3.481240089335692),\n                                    (\"ordinal (digits)\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -3.481240089335692),\n                                    (\"ordinal (digits)\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -2.094945728215801),\n                                    (\"ordinal 21..99\\1052\\1072\\1081\", -3.481240089335692)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -1.6739764335716716, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1052\\1072\\1081\",\n                                     -2.5257286443082556),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -2.5257286443082556),\n                                    (\"month\", -1.2729656758128873)],\n                               n = 6}}),\n       (\"\\1048\\1102\\1083\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1053\\1086\\1103\\1073\\1088\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1040\\1074\\1075\\1091\\1089\\1090\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1057\\1077\\1085\\1090\\1103\\1073\\1088\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 2\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (grain)\", -1.791759469228055),\n                                    (\"year (grain)\", -1.791759469228055),\n                                    (\"quarter\", -1.791759469228055), (\"year\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055),\n                                    (\"quarter (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1079\\1072\\1074\\1090\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4372138064227446, unseen = -3.58351893845611,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.1880522315029396),\n                                    (\"integer (3..19)\", -2.169053700369523)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -1.0379876668516748,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4795730802618862),\n                                    (\"integer (3..19)\", -1.9459101490553135),\n                                    (\"integer 1\", -2.3513752571634776),\n                                    (\"integer 2\", -1.9459101490553135)],\n                               n = 17}}),\n       (\"\\1087\\1086\\1089\\1083\\1077\\1087\\1086\\1089\\1083\\1077\\1079\\1072\\1074\\1090\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.213022639845854, unseen = -4.304065093204169,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.498699971920336),\n                                    (\"integer 2week (grain)\", -3.597312260588446),\n                                    (\"integer (numeric)day (grain)\", -2.681021528714291),\n                                    (\"integer 1hour (grain)\", -3.597312260588446),\n                                    (\"second\", -3.597312260588446),\n                                    (\"integer 2hour (grain)\", -3.597312260588446),\n                                    (\"integer (numeric)second (grain) \", -3.597312260588446),\n                                    (\"integer (numeric)year (grain)\", -3.597312260588446),\n                                    (\"day\", -2.681021528714291), (\"year\", -3.1918471524802814),\n                                    (\"integer (3..19)week (grain)\", -3.597312260588446),\n                                    (\"integer (numeric)week (grain)\", -2.9041650800285006),\n                                    (\"hour\", -2.681021528714291), (\"month\", -3.597312260588446),\n                                    (\"integer (numeric)minute (grain)\", -2.498699971920336),\n                                    (\"integer (3..19)month (grain)\", -3.597312260588446),\n                                    (\"minute\", -2.498699971920336),\n                                    (\"integer (numeric)hour (grain)\", -3.1918471524802814),\n                                    (\"integer 2year (grain)\", -3.597312260588446)],\n                               n = 22},\n                   koData =\n                     ClassData{prior = -0.3528213746227423, unseen = -4.897839799950911,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.2809112157876537),\n                                    (\"integer 2week (grain)\", -4.197201947661808),\n                                    (\"integer (numeric)day (grain)\", -3.5040547671018634),\n                                    (\"integer (3..19)day (grain)\", -4.197201947661808),\n                                    (\"integer 2minute (grain)\", -4.197201947661808),\n                                    (\"second\", -3.2809112157876537),\n                                    (\"integer 2month (grain)\", -4.197201947661808),\n                                    (\"integer (3..19)second (grain) \", -4.197201947661808),\n                                    (\"integer (numeric)second (grain) \", -3.791736839553644),\n                                    (\"integer (numeric)year (grain)\", -3.791736839553644),\n                                    (\"integer (3..19)year (grain)\", -4.197201947661808),\n                                    (\"day\", -3.0985896589936988), (\"year\", -3.2809112157876537),\n                                    (\"integer (3..19)week (grain)\", -4.197201947661808),\n                                    (\"integer 2day (grain)\", -4.197201947661808),\n                                    (\"integer (numeric)week (grain)\", -3.791736839553644),\n                                    (\"integer (3..19)minute (grain)\", -4.197201947661808),\n                                    (\"hour\", -1.55814461804655), (\"month\", -3.2809112157876537),\n                                    (\"integer (numeric)minute (grain)\", -3.791736839553644),\n                                    (\"integer 2second (grain) \", -4.197201947661808),\n                                    (\"integer (3..19)month (grain)\", -4.197201947661808),\n                                    (\"integer (numeric)month (grain)\", -3.791736839553644),\n                                    (\"integer (3..19)hour (grain)\", -3.791736839553644),\n                                    (\"minute\", -3.2809112157876537),\n                                    (\"integer (numeric)hour (grain)\", -1.6322525902002718),\n                                    (\"integer 2year (grain)\", -4.197201947661808)],\n                               n = 52}}),\n       (\"\\1057\\1091\\1073\\1073\\1086\\1090\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -3.054001181677967, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8718021769015913),\n                                    (\"hour (grain)\", -2.5649493574615367),\n                                    (\"second\", -2.5649493574615367),\n                                    (\"week (grain)\", -1.8718021769015913),\n                                    (\"second (grain) \", -2.5649493574615367),\n                                    (\"hour\", -2.5649493574615367)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -4.831857727080768e-2,\n                               unseen = -5.389071729816501,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.819545705327552),\n                                    (\"month (grain)\", -2.7454377331738304),\n                                    (\"hour (grain)\", -1.8581345381729275),\n                                    (\"year (grain)\", -2.9865997899907186),\n                                    (\"second\", -3.592735593561034),\n                                    (\"week (grain)\", -2.819545705327552),\n                                    (\"day\", -2.819545705327552), (\"quarter\", -3.305053521109253),\n                                    (\"minute (grain)\", -3.0819099697950434),\n                                    (\"year\", -2.9865997899907186),\n                                    (\"second (grain) \", -3.592735593561034),\n                                    (\"hour\", -1.8581345381729275), (\"month\", -2.7454377331738304),\n                                    (\"quarter (grain)\", -3.305053521109253),\n                                    (\"minute\", -3.0819099697950434),\n                                    (\"day (grain)\", -2.819545705327552)],\n                               n = 101}}),\n       (\"dd.(mm.)? - dd.mm.(yy[yy]?)? (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by ','\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.3141860046725258),\n                                    (\"dayhour\", -2.908720896564361),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1077\\1083\\1100\\1085\\1080\\1082<day-of-month> (non ordinal) <named-month>\",\n                                     -2.908720896564361),\n                                    (\"\\1055\\1103\\1090\\1085\\1080\\1094\\1072mm/dd\",\n                                     -3.3141860046725258),\n                                    (\"\\1057\\1088\\1077\\1076\\1072<day-of-month> (non ordinal) <named-month>\",\n                                     -3.3141860046725258),\n                                    (\"\\1057\\1088\\1077\\1076\\1072<day-of-month>(ordinal) <named-month>\",\n                                     -3.3141860046725258),\n                                    (\"\\1055\\1103\\1090\\1085\\1080\\1094\\1072intersect\",\n                                     -2.3978952727983707),\n                                    (\"dayday\", -1.2992829841302609),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -2.908720896564361),\n                                    (\"\\1057\\1088\\1077\\1076\\1072intersect\", -3.3141860046725258),\n                                    (\"\\1057\\1091\\1073\\1073\\1086\\1090\\1072<day-of-month> (non ordinal) <named-month>\",\n                                     -3.3141860046725258),\n                                    (\"minuteday\", -2.908720896564361),\n                                    (\"\\1055\\1103\\1090\\1085\\1080\\1094\\1072mm/dd/yyyy\",\n                                     -3.3141860046725258),\n                                    (\"\\1042\\1086\\1089\\1082\\1088\\1077\\1089\\1077\\1085\\1100\\1077<day-of-month> (non ordinal) <named-month>\",\n                                     -3.3141860046725258),\n                                    (\"<part-of-day> of <time><day-of-month> (non ordinal) <named-month>\",\n                                     -3.3141860046725258),\n                                    (\"\\1055\\1103\\1090\\1085\\1080\\1094\\1072<day-of-month> (non ordinal) <named-month>\",\n                                     -2.908720896564361),\n                                    (\"\\1057\\1088\\1077\\1076\\1072<day-of-month> (ordinal)\",\n                                     -3.3141860046725258)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain) \",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1042\\1090\\1086\\1088\\1085\\1080\\1082\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1055\\1103\\1090\\1085\\1080\\1094\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.5306282510621704, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.466337068793427), (\"day\", -1.8718021769015913),\n                                    (\"year\", -2.5649493574615367),\n                                    (\"<integer> <unit-of-duration>\", -1.0608719606852628),\n                                    (\"a <unit-of-duration>\", -2.159484249353372),\n                                    (\"month\", -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.8873031950009028, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8971199848858813), (\"day\", -1.6094379124341003),\n                                    (\"year\", -2.3025850929940455),\n                                    (\"a <unit-of-duration>\", -0.916290731874155),\n                                    (\"month\", -2.3025850929940455)],\n                               n = 7}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"\\1042\\1090\\1086\\1088\\1085\\1080\\1082\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.325422400434628, unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal 21..99\", -1.4213856809311607),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\",\n                                     -0.9694005571881036),\n                                    (\"ordinal (digits)\", -0.9694005571881036)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -1.2809338454620642, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..20th, then 30th, 40th, ..., 100th)\",\n                                     -0.1670540846631662)],\n                               n = 10}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.1972245773362196),\n                                    (\"\\1050\\1086\\1085\\1077\\1094 \\1084\\1077\\1089\\1103\\1094\\1072\",\n                                     -2.6026896854443837),\n                                    (\"<time-of-day>  o'clock\", -1.9095425048844386),\n                                    (\"time-of-day (latent)\", -1.9095425048844386),\n                                    (\"hour\", -0.9932517730102834), (\"month\", -2.6026896854443837),\n                                    (\"midnight|EOD|end of day\", -2.6026896854443837)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.6109179126442243,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 35}}),\n       (\"midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (grain)\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.793208009442517),\n                                    (\"integer (numeric)day (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)day (grain)\", -3.1986731175506815),\n                                    (\"second\", -2.793208009442517),\n                                    (\"integer (3..19)second (grain) \", -3.1986731175506815),\n                                    (\"integer (numeric)second (grain) \", -3.1986731175506815),\n                                    (\"integer (numeric)year (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)year (grain)\", -3.1986731175506815),\n                                    (\"day\", -2.793208009442517), (\"year\", -2.793208009442517),\n                                    (\"integer (3..19)week (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)week (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)minute (grain)\", -3.1986731175506815),\n                                    (\"hour\", -2.793208009442517), (\"month\", -2.793208009442517),\n                                    (\"integer (numeric)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)month (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)month (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)hour (grain)\", -3.1986731175506815),\n                                    (\"minute\", -2.793208009442517),\n                                    (\"integer (numeric)hour (grain)\", -3.1986731175506815)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.713572066704308,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5902671654458267), (\"second\", -2.5902671654458267),\n                                    (\"day\", -2.995732273553991), (\"year\", -2.995732273553991),\n                                    (\"<integer> <unit-of-duration>\", -1.0498221244986778),\n                                    (\"a <unit-of-duration>\", -2.3025850929940455),\n                                    (\"hour\", -1.8971199848858813), (\"minute\", -1.8971199848858813)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.791759469228055),\n                                    (\"hh:mmhh:mm\", -1.791759469228055),\n                                    (\"dayday\", -1.5686159179138452),\n                                    (\"<day-of-month> (non ordinal) <named-month><day-of-month> (non ordinal) <named-month>\",\n                                     -2.0794415416798357),\n                                    (\"mm/ddmm/dd\", -2.0794415416798357)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -1.791759469228055),\n                                    (\"mm/ddmm/dd/yyyy\", -2.1972245773362196),\n                                    (\"\\1048\\1102\\1083\\1100<day-of-month> (non ordinal) <named-month>\",\n                                     -2.1972245773362196),\n                                    (\"\\1040\\1074\\1075\\1091\\1089\\1090<day-of-month> (non ordinal) <named-month>\",\n                                     -2.1972245773362196),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"mm/ddintersect\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"\\1089\\1077\\1075\\1086\\1076\\1085\\1103\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6739764335716716),\n                                    (\"minuteminute\", -1.1631508098056809),\n                                    (\"hh:mmhh:mm\", -1.1631508098056809),\n                                    (\"minutehour\", -1.6739764335716716)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0986122886681098),\n                                    (\"minutehour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.639057329615259),\n                                    (\"integer 2week (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)day (grain)\", -3.044522437723423),\n                                    (\"integer 2minute (grain)\", -3.044522437723423),\n                                    (\"second\", -2.639057329615259),\n                                    (\"integer 2month (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)second (grain) \", -3.044522437723423),\n                                    (\"integer (numeric)year (grain)\", -3.044522437723423),\n                                    (\"day\", -2.639057329615259), (\"year\", -2.639057329615259),\n                                    (\"integer 2day (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)week (grain)\", -3.044522437723423),\n                                    (\"month\", -2.639057329615259),\n                                    (\"integer (numeric)minute (grain)\", -3.044522437723423),\n                                    (\"integer 2second (grain) \", -3.044522437723423),\n                                    (\"integer (numeric)month (grain)\", -3.044522437723423),\n                                    (\"minute\", -2.639057329615259),\n                                    (\"integer 2year (grain)\", -3.044522437723423)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.871201010907891,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\\1052\\1072\\1088\\1090\", -2.463853240590168),\n                                    (\"integer (numeric)\\1048\\1102\\1083\\1100\", -2.2407096892759584),\n                                    (\"integer (numeric)\\1057\\1077\\1085\\1090\\1103\\1073\\1088\\1100\",\n                                     -3.1570004211501135),\n                                    (\"integer (numeric)\\1040\\1074\\1075\\1091\\1089\\1090\",\n                                     -2.2407096892759584),\n                                    (\"integer (numeric)\\1040\\1087\\1088\\1077\\1083\\1100\",\n                                     -3.1570004211501135),\n                                    (\"integer (numeric)\\1060\\1077\\1074\\1088\\1072\\1083\\1100\",\n                                     -1.7707060600302227),\n                                    (\"month\", -0.8056251639866356)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\\1048\\1102\\1083\\1100\", -1.2992829841302609),\n                                    (\"month\", -1.2992829841302609)],\n                               n = 2}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1055\\1086\\1085\\1077\\1076\\1077\\1083\\1100\\1085\\1080\\1082\",\n                                     -1.9459101490553135),\n                                    (\"\\1057\\1088\\1077\\1076\\1072\", -1.252762968495368),\n                                    (\"day\", -0.8472978603872037),\n                                    (\"\\1042\\1090\\1086\\1088\\1085\\1080\\1082\", -1.9459101490553135)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1052\\1072\\1088\\1090\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal 21..99\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -2.5257286443082556),\n                                    (\"ordinal (digits)\\1052\\1072\\1088\\1090\", -2.5257286443082556),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1052\\1072\\1088\\1090\",\n                                     -1.8325814637483102),\n                                    (\"month\", -1.0216512475319814),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1040\\1087\\1088\\1077\\1083\\1100\",\n                                     -2.5257286443082556),\n                                    (\"ordinal (digits)\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -2.5257286443082556),\n                                    (\"ordinal 21..99\\1052\\1072\\1081\", -2.5257286443082556)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -1.6094379124341003, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1052\\1072\\1081\",\n                                     -1.8718021769015913),\n                                    (\"ordinals (first..20th, then 30th, 40th, ..., 100th)\\1054\\1082\\1090\\1103\\1073\\1088\\1100\",\n                                     -1.8718021769015913),\n                                    (\"month\", -1.466337068793427)],\n                               n = 2}}),\n       (\"\\1056\\1086\\1078\\1076\\1077\\1089\\1090\\1074\\1086 \\1061\\1088\\1080\\1089\\1090\\1086\\1074\\1086\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.3217558399823195),\n                                    (\"time-of-day (latent)\", -1.3217558399823195),\n                                    (\"hour\", -0.7621400520468967)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\1052\\1072\\1081\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1048\\1102\\1083\\1100\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"week-end\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1375}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.SK_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.SV_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.3217558399823195),\n                                    (\"hh:mm\", -1.455287232606842), (\"hour\", -2.0149030205422647),\n                                    (\"minute\", -1.0033021088637848)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8176416508043156, unseen = -4.897839799950911,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 132},\n                   koData =\n                     ClassData{prior = -0.5824497609739314,\n                               unseen = -5.1298987149230735,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 167}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"Tisdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (20..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.9555114450274363),\n                                    (\"tomorrowevening\", -1.8718021769015913),\n                                    (\"tomorrowlunch\", -1.8718021769015913),\n                                    (\"yesterdayevening\", -1.8718021769015913),\n                                    (\"Mandagmorning\", -1.8718021769015913)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"couple, a pair\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"sommar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3014753945841168,\n                               unseen = -4.7535901911063645,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> timezone\", -3.1354942159291497),\n                                    (\"time-of-day (latent)\", -1.3437347467010947),\n                                    (\"relative minutes after|past <integer> (hour-of-day)\",\n                                     -3.6463198396951406),\n                                    (\"hh:mm\", -1.8545603704670852),\n                                    (\"<time-of-day> sharp\", -3.6463198396951406),\n                                    (\"hour\", -1.2791962255635234), (\"minute\", -1.5668782980153044)],\n                               n = 54},\n                   koData =\n                     ClassData{prior = -1.3460204619819507, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8109302162163288),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 19}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sondag\", -2.3978952727983707),\n                                    (\"Mandag\", -1.7047480922384253),\n                                    (\"Lordag\", -2.3978952727983707), (\"day\", -0.8938178760220964),\n                                    (\"Onsdag\", -2.3978952727983707),\n                                    (\"Fredag\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -0.48285177172358457,\n                               unseen = -4.304065093204169,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"on <date>\", -3.597312260588446),\n                                    (\"Mandag\", -3.597312260588446), (\"Torsdag\", -2.211017899468555),\n                                    (\"Lordag\", -3.597312260588446),\n                                    (\"the <day-of-month> (non ordinal)\", -3.1918471524802814),\n                                    (\"<day-of-month>(ordinal) <named-month>\", -2.344549292093078),\n                                    (\"day\", -0.9231636111619171),\n                                    (\"the <day-of-month> (ordinal)\", -3.597312260588446),\n                                    (\"afternoon\", -3.597312260588446),\n                                    (\"<day-of-month> (ordinal)\", -2.093234863812172),\n                                    (\"hour\", -3.597312260588446),\n                                    (\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.597312260588446)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -0.9597758438138939, unseen = -3.951243718581427,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"on <date>\", -2.322387720290225),\n                                    (\"year (latent)\", -1.8523840910444898),\n                                    (\"time-of-day (latent)\", -1.8523840910444898),\n                                    (\"year\", -1.62924053973028), (\"hour\", -1.62924053973028)],\n                               n = 18}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -0.16251892949777494, unseen = -3.58351893845611,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 34},\n                   koData =\n                     ClassData{prior = -1.8971199848858813,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6094379124341003),\n                                    (\"minuteminute\", -1.2039728043259361),\n                                    (\"hh:mmhh:mm\", -1.2039728043259361),\n                                    (\"minutehour\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0986122886681098),\n                                    (\"minutehour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"between <datetime> and <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7047480922384253),\n                                    (\"minuteminute\", -1.2992829841302609),\n                                    (\"hh:mmhh:mm\", -1.2992829841302609),\n                                    (\"minutehour\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.5040773967762742),\n                                    (\"minuteminute\", -1.5040773967762742),\n                                    (\"minutehour\", -1.5040773967762742),\n                                    (\"hh:mmintersect\", -1.5040773967762742)],\n                               n = 2}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> more <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)minute (grain)\", -1.252762968495368),\n                                    (\"integer (0..19)minute (grain)\", -1.252762968495368),\n                                    (\"minute\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"vinter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Juli\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.252762968495368),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.252762968495368),\n                                    (\"quarter\", -0.8472978603872037)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinal (digits)quarter (grain)\", -1.252762968495368),\n                                    (\"ordinals (first..twentieth,thirtieth,...)quarter (grain)\",\n                                     -1.252762968495368),\n                                    (\"quarter\", -0.8472978603872037)],\n                               n = 2}}),\n       (\"Last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.35003530316883363,\n                               unseen = -5.860786223465865,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Onsdagthis <cycle>\", -5.1647859739235145),\n                                    (\"Torsdag<time> timezone\", -3.912023005428146),\n                                    (\"<datetime> - <datetime> (interval)on <date>\",\n                                     -4.0661736852554045),\n                                    (\"<time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -4.0661736852554045),\n                                    (\"hourday\", -5.1647859739235145),\n                                    (\"dayhour\", -2.9134941753170187),\n                                    (\"daymonth\", -3.1498829533812494),\n                                    (\"monthyear\", -3.1498829533812494),\n                                    (\"Torsdagbetween <time-of-day> and <time-of-day> (interval)\",\n                                     -4.75932086581535),\n                                    (\"Mandagon <date>\", -5.1647859739235145),\n                                    (\"yyyy-mm-ddat <time-of-day>\", -4.471638793363569),\n                                    (\"intersecthh:mm\", -5.1647859739235145),\n                                    (\"Torsdagbetween <datetime> and <datetime> (interval)\",\n                                     -4.75932086581535),\n                                    (\"Torsdagat <time-of-day>\", -4.248495242049359),\n                                    (\"Marsyear\", -5.1647859739235145),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -4.75932086581535),\n                                    (\"Oktoberyear\", -3.5553480614894135),\n                                    (\"Torsdagfrom <time-of-day> - <time-of-day> (interval)\",\n                                     -4.471638793363569),\n                                    (\"Torsdagfrom <datetime> - <datetime> (interval)\",\n                                     -4.471638793363569),\n                                    (\"last <day-of-week> of <time>year\", -5.1647859739235145),\n                                    (\"todayat <time-of-day>\", -4.75932086581535),\n                                    (\"the <day-of-month> (ordinal)Februari\", -5.1647859739235145),\n                                    (\"dayday\", -3.2929837970219227),\n                                    (\"dd/mmat <time-of-day>\", -4.248495242049359),\n                                    (\"intersect by \\\",\\\"hh:mm\", -4.248495242049359),\n                                    (\"dayyear\", -3.5553480614894135),\n                                    (\"tomorrow<time-of-day> sharp\", -4.75932086581535),\n                                    (\"<day-of-month>(ordinal) <named-month>year\",\n                                     -4.75932086581535),\n                                    (\"Onsdag<named-month> <day-of-month> (non ordinal)\",\n                                     -5.1647859739235145),\n                                    (\"absorption of , after named day<named-month> <day-of-month> (non ordinal)\",\n                                     -4.0661736852554045),\n                                    (\"tomorrowuntil <time-of-day>\", -4.75932086581535),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -4.471638793363569),\n                                    (\"after <time-of-day>at <time-of-day>\", -4.75932086581535),\n                                    (\"the <day-of-month> (ordinal)Mars\", -4.0661736852554045),\n                                    (\"intersect by \\\",\\\"<day-of-month> (non ordinal) <named-month>\",\n                                     -4.75932086581535),\n                                    (\"Mandagthis <cycle>\", -5.1647859739235145),\n                                    (\"tomorrowafter <time-of-day>\", -4.75932086581535),\n                                    (\"from <time-of-day> - <time-of-day> (interval)on <date>\",\n                                     -4.248495242049359),\n                                    (\"dayminute\", -2.361425593016979),\n                                    (\"from <datetime> - <datetime> (interval)on <date>\",\n                                     -4.471638793363569),\n                                    (\"on <date>Mars\", -4.0661736852554045),\n                                    (\"<ordinal> <cycle> of <time>year\", -4.75932086581535),\n                                    (\"minuteday\", -2.5620962884791303),\n                                    (\"absorption of , after named dayintersect\",\n                                     -5.1647859739235145),\n                                    (\"yearhh:mm\", -5.1647859739235145),\n                                    (\"Tisdagthis <time>\", -4.75932086581535),\n                                    (\"Onsdagnext <cycle>\", -5.1647859739235145),\n                                    (\"absorption of , after named dayintersect by \\\",\\\"\",\n                                     -4.75932086581535),\n                                    (\"Sondaglast <cycle>\", -5.1647859739235145),\n                                    (\"Septemberyear\", -4.248495242049359),\n                                    (\"at <time-of-day>on <date>\", -5.1647859739235145),\n                                    (\"between <time-of-day> and <time-of-day> (interval)on <date>\",\n                                     -5.1647859739235145),\n                                    (\"between <datetime> and <datetime> (interval)on <date>\",\n                                     -5.1647859739235145),\n                                    (\"dayweek\", -4.0661736852554045),\n                                    (\"Tisdagthis <cycle>\", -5.1647859739235145),\n                                    (\"on <date>Februari\", -5.1647859739235145),\n                                    (\"weekyear\", -4.248495242049359),\n                                    (\"hh:mmtomorrow\", -4.471638793363569),\n                                    (\"tomorrowat <time-of-day>\", -3.912023005428146),\n                                    (\"at <time-of-day>tomorrow\", -4.75932086581535),\n                                    (\"Sondag<day-of-month> (non ordinal) <named-month>\",\n                                     -5.1647859739235145),\n                                    (\"last <cycle> of <time>year\", -4.248495242049359),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.75932086581535),\n                                    (\"yearminute\", -5.1647859739235145)],\n                               n = 136},\n                   koData =\n                     ClassData{prior = -1.2196389210703353, unseen = -5.262690188904886,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"OnsdagFebruari\", -4.564348191467836),\n                                    (\"dayhour\", -2.6184380424125226),\n                                    (\"daymonth\", -2.4242820279715653),\n                                    (\"monthyear\", -3.648057459593681),\n                                    (\"Mandagon <date>\", -4.1588830833596715),\n                                    (\"yyyy-mm-ddat <time-of-day>\", -3.871201010907891),\n                                    (\"Torsdagat <time-of-day>\", -3.0602707946915624),\n                                    (\"Marsyear\", -3.871201010907891),\n                                    (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"year\",\n                                     -3.4657359027997265),\n                                    (\"Torsdagfrom <datetime> - <datetime> (interval)\",\n                                     -4.564348191467836),\n                                    (\"Mandagintersect\", -4.1588830833596715),\n                                    (\"absorption of , after named dayJuli\", -4.1588830833596715),\n                                    (\"hourmonth\", -4.1588830833596715),\n                                    (\"dd/mmat <time-of-day>\", -3.648057459593681),\n                                    (\"dayyear\", -3.1780538303479458),\n                                    (\"Onsdagthis <time>\", -3.648057459593681),\n                                    (\"Aprilyear\", -4.564348191467836),\n                                    (\"yearmonth\", -4.564348191467836),\n                                    (\"until <time-of-day>on <date>\", -4.564348191467836),\n                                    (\"Torsdaghh:mm\", -4.1588830833596715),\n                                    (\"dayminute\", -3.311585222972468),\n                                    (\"minuteday\", -3.0602707946915624),\n                                    (\"Tisdagthis <time>\", -4.1588830833596715),\n                                    (\"hh:mmon <date>\", -3.1780538303479458),\n                                    (\"on <date>Februari\", -4.1588830833596715),\n                                    (\"absorption of , after named dayFebruari\", -3.871201010907891),\n                                    (\"intersectFebruari\", -4.1588830833596715),\n                                    (\"Mandagthis <time>\", -4.564348191467836),\n                                    (\"Sondagthis <time>\", -4.564348191467836)],\n                               n = 57}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7346010553881064),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)Oktober\",\n                                     -1.7346010553881064),\n                                    (\"ordinals (first..twentieth,thirtieth,...)week (grain)intersect\",\n                                     -1.7346010553881064),\n                                    (\"weekmonth\", -1.2237754316221157),\n                                    (\"ordinals (first..twentieth,thirtieth,...)day (grain)Oktober\",\n                                     -1.7346010553881064)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.4423470353692043),\n                                    (\"minuteminute\", -1.5260563034950494),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.4423470353692043),\n                                    (\"hh:mmhh:mm\", -1.5260563034950494),\n                                    (\"hourhour\", -2.4423470353692043),\n                                    (\"minutehour\", -2.4423470353692043)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.5596157879354228, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.6026896854443837),\n                                    (\"hh:mmtime-of-day (latent)\", -1.9095425048844386),\n                                    (\"minuteminute\", -1.9095425048844386),\n                                    (\"yearyear\", -2.6026896854443837),\n                                    (\"year (latent)year (latent)\", -2.6026896854443837),\n                                    (\"minutehour\", -1.9095425048844386),\n                                    (\"hh:mmintersect\", -1.9095425048844386),\n                                    (\"year (latent)time-of-day (latent)\", -2.6026896854443837)],\n                               n = 8}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6094379124341003),\n                                    (\"month (grain)\", -2.3025850929940455),\n                                    (\"year (grain)\", -2.3025850929940455),\n                                    (\"week (grain)\", -1.6094379124341003),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -2.3025850929940455),\n                                    (\"month\", -2.3025850929940455),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"from <time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.3025850929940455),\n                                    (\"minuteminute\", -1.2039728043259361),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -1.2039728043259361),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"minutehour\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.0296194171811581),\n                                    (\"minutehour\", -1.0296194171811581)],\n                               n = 4}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.15415067982725836),\n                                    (\"integer (0..19)\", -1.9459101490553135)],\n                               n = 12}}),\n       (\"Sondag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mandag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)quarter (grain)year\",\n                                     -1.252762968495368),\n                                    (\"quarteryear\", -0.8472978603872037),\n                                    (\"ordinal (digits)quarter (grain)year\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Torsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter to|till|before <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.0986122886681098),\n                                    (\"noon\", -1.5040773967762742), (\"hour\", -0.8109302162163288)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Lordag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)TisdagOktober\",\n                                     -1.9924301646902063),\n                                    (\"daymonth\", -0.8938178760220964),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Onsdagintersect\",\n                                     -1.4816045409242156),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Tisdagintersect\",\n                                     -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.9444616088408514),\n                                    (\"ordinals (first..twentieth,thirtieth,...)OnsdagOktober\",\n                                     -1.2809338454620642),\n                                    (\"ordinals (first..twentieth,thirtieth,...)TisdagSeptember\",\n                                     -1.791759469228055)],\n                               n = 6}}),\n       (\"the <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"morning\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)Mars\",\n                                     -1.6094379124341003),\n                                    (\"ordinal (digits)Februari\", -2.120263536200091),\n                                    (\"month\", -0.8209805520698302),\n                                    (\"ordinal (digits)Mars\", -1.6094379124341003)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)April\",\n                                     -1.252762968495368),\n                                    (\"month\", -1.252762968495368)],\n                               n = 1}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 29}}),\n       (\"in|during the <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"morning\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"new year's eve\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tisdag\", -0.6931471805599453), (\"day\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.1786549963416462), (\"Mars\", -1.8718021769015913),\n                                    (\"month\", -1.8718021769015913), (\"Onsdag\", -1.8718021769015913),\n                                    (\"Fredag\", -1.466337068793427)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half an hour\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"the <day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.916290731874155),\n                                    (\"ordinal (digits)\", -0.5108256237659907)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"second\", -1.2039728043259361),\n                                    (\"<integer> <unit-of-duration>\", -1.2039728043259361),\n                                    (\"a <unit-of-duration>\", -1.6094379124341003),\n                                    (\"minute\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"year (grain)\", -1.8971199848858813),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"quarter\", -2.3025850929940455), (\"year\", -1.8971199848858813),\n                                    (\"quarter (grain)\", -2.3025850929940455)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Februari\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 2}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6567795363890705,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -4.652001563489282e-2),\n                                    (\"integer (0..19)\", -3.0910424533583156)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -0.7308875085427924,\n                               unseen = -3.7376696182833684,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.10265415406008334),\n                                    (\"integer (0..19)\", -2.327277705584417)],\n                               n = 39}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.33024168687057687,\n                               unseen = -3.2188758248682006,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -1.2685113254635072,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 9}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"Sondagintersect\", -1.6094379124341003),\n                                    (\"SondagMars\", -1.6094379124341003),\n                                    (\"MandagMars\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6231885919530349, unseen = -4.574710978503383,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6184380424125226),\n                                    (\"integer (0..19)year (grain)\", -3.871201010907891),\n                                    (\"integer (numeric)day (grain)\", -2.772588722239781),\n                                    (\"couple, a pairhour (grain)\", -3.871201010907891),\n                                    (\"integer (0..19)hour (grain)\", -3.871201010907891),\n                                    (\"second\", -3.1780538303479458),\n                                    (\"integer (numeric)second (grain)\", -3.871201010907891),\n                                    (\"integer (numeric)year (grain)\", -3.871201010907891),\n                                    (\"day\", -2.166452918669466), (\"year\", -3.4657359027997265),\n                                    (\"integer (numeric)week (grain)\", -3.1780538303479458),\n                                    (\"integer (0..19)month (grain)\", -3.871201010907891),\n                                    (\"integer (0..19)second (grain)\", -3.4657359027997265),\n                                    (\"hour\", -2.772588722239781), (\"month\", -3.4657359027997265),\n                                    (\"integer (numeric)minute (grain)\", -2.772588722239781),\n                                    (\"integer (0..19)minute (grain)\", -2.9549102790337356),\n                                    (\"integer (numeric)month (grain)\", -3.871201010907891),\n                                    (\"minute\", -2.2617630984737906),\n                                    (\"integer (numeric)hour (grain)\", -3.1780538303479458),\n                                    (\"integer (0..19)day (grain)\", -2.772588722239781),\n                                    (\"integer (0..19)week (grain)\", -3.1780538303479458)],\n                               n = 37},\n                   koData =\n                     ClassData{prior = -0.7683706017975328, unseen = -4.465908118654584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.662587827025453),\n                                    (\"integer (0..19)year (grain)\", -3.355735007585398),\n                                    (\"integer (numeric)day (grain)\", -3.068052935133617),\n                                    (\"integer (0..19)hour (grain)\", -3.7612001156935624),\n                                    (\"second\", -2.8449093838194073),\n                                    (\"integer (numeric)second (grain)\", -3.355735007585398),\n                                    (\"integer (numeric)year (grain)\", -3.068052935133617),\n                                    (\"day\", -2.662587827025453), (\"year\", -2.662587827025453),\n                                    (\"integer (numeric)week (grain)\", -3.355735007585398),\n                                    (\"integer (0..19)month (grain)\", -3.068052935133617),\n                                    (\"integer (0..19)second (grain)\", -3.355735007585398),\n                                    (\"hour\", -2.8449093838194073), (\"month\", -2.662587827025453),\n                                    (\"integer (numeric)minute (grain)\", -3.355735007585398),\n                                    (\"integer (0..19)minute (grain)\", -3.355735007585398),\n                                    (\"integer (numeric)month (grain)\", -3.355735007585398),\n                                    (\"minute\", -2.8449093838194073),\n                                    (\"integer (numeric)hour (grain)\", -3.068052935133617),\n                                    (\"integer (0..19)day (grain)\", -3.355735007585398),\n                                    (\"integer (0..19)week (grain)\", -3.068052935133617)],\n                               n = 32}}),\n       (\"relative minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.8109302162163288),\n                                    (\"integer (numeric)time-of-day (latent)\", -1.0986122886681098),\n                                    (\"integer (20..90)time-of-day (latent)\", -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Oktober\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"a <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.0794415416798357),\n                                    (\"hour (grain)\", -2.4849066497880004),\n                                    (\"second\", -2.0794415416798357),\n                                    (\"week (grain)\", -2.0794415416798357),\n                                    (\"day\", -2.4849066497880004),\n                                    (\"minute (grain)\", -2.4849066497880004),\n                                    (\"second (grain)\", -2.0794415416798357),\n                                    (\"hour\", -2.4849066497880004), (\"minute\", -2.4849066497880004),\n                                    (\"day (grain)\", -2.4849066497880004)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.1590646946296874, unseen = -4.51085950651685,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>Lordag\", -3.8066624897703196),\n                                    (\"Lordag<day-of-month> (non ordinal) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"intersect by \\\",\\\"year\", -3.8066624897703196),\n                                    (\"hh:mmintersect by \\\",\\\"\", -3.8066624897703196),\n                                    (\"dayday\", -2.1019143975318944),\n                                    (\"dayyear\", -2.890371757896165),\n                                    (\"<named-month> <day-of-month> (non ordinal)intersect\",\n                                     -3.8066624897703196),\n                                    (\"Onsdag<named-month> <day-of-month> (non ordinal)\",\n                                     -3.8066624897703196),\n                                    (\"Fredagintersect by \\\",\\\"\", -3.4011973816621555),\n                                    (\"intersect by \\\",\\\"<day-of-month> (non ordinal) <named-month>\",\n                                     -3.4011973816621555),\n                                    (\"hh:mmintersect\", -3.8066624897703196),\n                                    (\"intersect by \\\",\\\"intersect\", -3.8066624897703196),\n                                    (\"at <time-of-day>intersect\", -3.8066624897703196),\n                                    (\"dayminute\", -2.70805020110221),\n                                    (\"intersectyear\", -3.8066624897703196),\n                                    (\"minuteday\", -2.1019143975318944),\n                                    (\"<named-month> <day-of-month> (non ordinal)Fredag\",\n                                     -3.8066624897703196),\n                                    (\"Fredag<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4011973816621555),\n                                    (\"hh:mmabsorption of , after named day\", -3.8066624897703196),\n                                    (\"at <time-of-day>intersect by \\\",\\\"\", -3.8066624897703196),\n                                    (\"at <time-of-day>absorption of , after named day\",\n                                     -3.8066624897703196),\n                                    (\"intersectintersect\", -3.8066624897703196),\n                                    (\"Fredagintersect\", -3.8066624897703196),\n                                    (\"Mandag<named-month> <day-of-month> (non ordinal)\",\n                                     -3.4011973816621555),\n                                    (\"Mandag<day-of-month> (non ordinal) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"Sondag<day-of-month> (non ordinal) <named-month>\",\n                                     -3.8066624897703196),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -3.4011973816621555),\n                                    (\"hh:mmLordag\", -3.8066624897703196)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -1.916922612182061, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"OnsdagFebruari\", -3.044522437723423),\n                                    (\"daymonth\", -1.9459101490553135),\n                                    (\"MandagFebruari\", -2.639057329615259),\n                                    (\"FredagJuli\", -2.639057329615259)],\n                               n = 5}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -1.9418085857101627e-2,\n                               unseen = -3.970291913552122,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 51},\n                   koData =\n                     ClassData{prior = -3.951243718581427, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"quarter after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (first..twentieth,thirtieth,...)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> sharp\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.2992829841302609),\n                                    (\"time-of-day (latent)\", -1.2992829841302609),\n                                    (\"hour\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mars\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -0.8649974374866046, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"OnsdagOktober\", -2.2335922215070942),\n                                    (\"TisdagOktober\", -2.2335922215070942),\n                                    (\"Onsdagintersect\", -2.2335922215070942),\n                                    (\"Onsdagnext <cycle>\", -2.639057329615259),\n                                    (\"Sondaglast <cycle>\", -2.639057329615259),\n                                    (\"dayweek\", -2.2335922215070942)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.5465437063680699,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.041453874828161),\n                                    (\"OnsdagOktober\", -2.4277482359480516),\n                                    (\"Sondagintersect\", -2.833213344056216),\n                                    (\"TisdagSeptember\", -2.4277482359480516),\n                                    (\"Tisdagintersect\", -2.4277482359480516),\n                                    (\"Onsdagintersect\", -2.4277482359480516),\n                                    (\"SondagMars\", -2.833213344056216),\n                                    (\"MandagMars\", -2.833213344056216)],\n                               n = 11}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716), (\"day\", -1.8562979903656263),\n                                    (\"year\", -2.367123614131617),\n                                    (\"<integer> <unit-of-duration>\", -0.9007865453381898),\n                                    (\"a <unit-of-duration>\", -2.772588722239781),\n                                    (\"month\", -2.367123614131617)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tisdag\", -1.791759469228055), (\"Sondag\", -1.791759469228055),\n                                    (\"day\", -1.3862943611198906), (\"hour\", -1.791759469228055),\n                                    (\"week-end\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sondag\", -1.6094379124341003),\n                                    (\"Mandag\", -1.6094379124341003), (\"day\", -1.2039728043259361)],\n                               n = 2}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)\",\n                                     -0.916290731874155),\n                                    (\"ordinal (digits)\", -0.5108256237659907)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -0.8873031950009028),\n                                    (\"hour\", -0.8873031950009028)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.5040773967762742),\n                                    (\"hh:mm\", -1.5040773967762742),\n                                    (\"minute\", -1.0986122886681098)],\n                               n = 2}}),\n       (\"Augusti\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> and an half hours\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.6931471805599453),\n                                    (\"integer (0..19)\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tisdag\", -2.0149030205422647),\n                                    (\"Mandag\", -2.0149030205422647), (\"day\", -1.3217558399823195),\n                                    (\"Mars\", -2.0149030205422647), (\"month\", -2.0149030205422647),\n                                    (\"Onsdag\", -2.0149030205422647)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.3217558399823195), (\"Mars\", -2.0149030205422647),\n                                    (\"month\", -2.0149030205422647), (\"Onsdag\", -2.0149030205422647),\n                                    (\"Fredag\", -1.6094379124341003)],\n                               n = 4}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.7047480922384253),\n                                    (\"month (grain)\", -2.3978952727983707),\n                                    (\"year (grain)\", -1.7047480922384253),\n                                    (\"week (grain)\", -1.7047480922384253),\n                                    (\"year\", -1.7047480922384253), (\"month\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -1.0116009116784799, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"day\", -1.6739764335716716),\n                                    (\"day (grain)\", -1.6739764335716716)],\n                               n = 4}}),\n       (\"Onsdag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"christmas\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"new year's day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.793208009442517),\n                                    (\"integer (0..19)year (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)day (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)hour (grain)\", -3.1986731175506815),\n                                    (\"second\", -2.793208009442517),\n                                    (\"integer (numeric)second (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)year (grain)\", -3.1986731175506815),\n                                    (\"day\", -2.793208009442517), (\"year\", -2.793208009442517),\n                                    (\"integer (numeric)week (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)month (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)second (grain)\", -3.1986731175506815),\n                                    (\"hour\", -2.793208009442517), (\"month\", -2.793208009442517),\n                                    (\"integer (numeric)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)month (grain)\", -3.1986731175506815),\n                                    (\"minute\", -2.793208009442517),\n                                    (\"integer (numeric)hour (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)day (grain)\", -3.1986731175506815),\n                                    (\"integer (0..19)week (grain)\", -3.1986731175506815)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Fredag\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.258096538021482),\n                                    (\"<integer> more <unit-of-duration>\", -3.258096538021482),\n                                    (\"number.number hours\", -3.6635616461296463),\n                                    (\"second\", -2.9704144655697013), (\"day\", -2.5649493574615367),\n                                    (\"half an hour\", -3.6635616461296463),\n                                    (\"<integer> <unit-of-duration>\", -1.3121863889661687),\n                                    (\"a <unit-of-duration>\", -2.5649493574615367),\n                                    (\"<integer> and an half hours\", -3.258096538021482),\n                                    (\"hour\", -2.4107986776342782), (\"minute\", -1.466337068793427),\n                                    (\"about <duration>\", -3.258096538021482)],\n                               n = 33},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"minuteminute\", -1.3862943611198906),\n                                    (\"hh:mmhh:mm\", -1.3862943611198906),\n                                    (\"dayday\", -1.791759469228055),\n                                    (\"<day-of-month> (non ordinal) <named-month><day-of-month> (non ordinal) <named-month>\",\n                                     -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Juli<day-of-month> (non ordinal) <named-month>\",\n                                     -2.890371757896165),\n                                    (\"monthday\", -1.791759469228055),\n                                    (\"minuteminute\", -1.6376087894007967),\n                                    (\"hh:mmhh:mm\", -2.890371757896165),\n                                    (\"dayyear\", -2.4849066497880004),\n                                    (\"Augusti<day-of-month> (non ordinal) <named-month>\",\n                                     -1.9740810260220096),\n                                    (\"hh:mmintersect\", -1.791759469228055),\n                                    (\"dd/mmyear\", -2.4849066497880004)],\n                               n = 13}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.587786664902119, unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -2.0794415416798357),\n                                    (\"minuteminute\", -0.9808292530117262),\n                                    (\"hh:mmhh:mm\", -0.9808292530117262),\n                                    (\"minutehour\", -2.0794415416798357)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -0.8109302162163288, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -0.916290731874155),\n                                    (\"minuteminute\", -2.3025850929940455),\n                                    (\"hh:mmhh:mm\", -2.3025850929940455),\n                                    (\"minutehour\", -0.916290731874155)],\n                               n = 8}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.007333185232471,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.6026896854443837),\n                                    (\"integer (0..19)year (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)day (grain)\", -2.890371757896165),\n                                    (\"second\", -2.890371757896165),\n                                    (\"integer (numeric)second (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)year (grain)\", -2.890371757896165),\n                                    (\"day\", -2.6026896854443837), (\"year\", -2.6026896854443837),\n                                    (\"integer (numeric)week (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)month (grain)\", -2.890371757896165),\n                                    (\"integer (0..19)second (grain)\", -3.295836866004329),\n                                    (\"hour\", -3.295836866004329), (\"month\", -2.6026896854443837),\n                                    (\"integer (numeric)minute (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)minute (grain)\", -3.295836866004329),\n                                    (\"integer (numeric)month (grain)\", -3.295836866004329),\n                                    (\"minute\", -2.890371757896165),\n                                    (\"integer (numeric)hour (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)day (grain)\", -3.295836866004329),\n                                    (\"integer (0..19)week (grain)\", -2.890371757896165)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -2.3978952727983707),\n                                    (\"Februariinteger (numeric)\", -1.2992829841302609),\n                                    (\"month\", -0.7884573603642702),\n                                    (\"Juliinteger (numeric)\", -1.7047480922384253)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Aprilinteger (numeric)\", -1.0986122886681098),\n                                    (\"month\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1466034741918754, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)September\", -3.1135153092103742),\n                                    (\"integer (numeric)Augusti\", -1.5040773967762742),\n                                    (\"integer (numeric)April\", -3.1135153092103742),\n                                    (\"month\", -0.8109302162163288),\n                                    (\"integer (numeric)Februari\", -2.1972245773362196),\n                                    (\"integer (numeric)Juli\", -2.70805020110221),\n                                    (\"integer (numeric)Mars\", -2.70805020110221)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.9924301646902063, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month\", -1.1786549963416462),\n                                    (\"integer (numeric)Juli\", -1.1786549963416462)],\n                               n = 3}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tisdag\", -1.7047480922384253),\n                                    (\"Mandag\", -1.7047480922384253), (\"day\", -1.0116009116784799),\n                                    (\"Onsdag\", -1.7047480922384253)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.0116009116784799), (\"Onsdag\", -1.7047480922384253),\n                                    (\"Fredag\", -1.2992829841302609)],\n                               n = 3}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.4816045409242156),\n                                    (\"day (grain)intersect\", -1.9924301646902063),\n                                    (\"weekmonth\", -1.4816045409242156),\n                                    (\"day (grain)Oktober\", -1.9924301646902063),\n                                    (\"week (grain)intersect\", -1.9924301646902063),\n                                    (\"week (grain)September\", -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month> year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..twentieth,thirtieth,...)April\",\n                                     -1.6094379124341003),\n                                    (\"ordinals (first..twentieth,thirtieth,...)Mars\",\n                                     -1.6094379124341003),\n                                    (\"month\", -0.916290731874155),\n                                    (\"ordinal (digits)Mars\", -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.6863989535702288),\n                                    (\"intersect\", -2.1972245773362196),\n                                    (\"tomorrow\", -2.1972245773362196), (\"day\", -2.1972245773362196),\n                                    (\"hour\", -1.349926716949016)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"lunch\", -2.6026896854443837),\n                                    (\"year (latent)\", -1.9095425048844386),\n                                    (\"time-of-day (latent)\", -1.9095425048844386),\n                                    (\"year\", -1.9095425048844386), (\"hh:mm\", -2.6026896854443837),\n                                    (\"hour\", -1.6863989535702288), (\"minute\", -2.6026896854443837)],\n                               n = 8}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 19},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Juli\", -0.6931471805599453), (\"month\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"half an hour\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = -1.0608719606852628, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"sommar\", -2.2335922215070942),\n                                    (\"vinter\", -2.2335922215070942), (\"day\", -1.7227665977411035),\n                                    (\"Oktober\", -2.2335922215070942), (\"hour\", -1.9459101490553135),\n                                    (\"month\", -2.2335922215070942),\n                                    (\"week-end\", -1.9459101490553135)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.42488319396526597,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Tisdag\", -3.0910424533583156),\n                                    (\"September\", -2.174751721484161), (\"day\", -3.0910424533583156),\n                                    (\"Oktober\", -1.3862943611198906), (\"Mars\", -2.6855773452501515),\n                                    (\"month\", -0.9509762898620451)],\n                               n = 17}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1638}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.SW_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.TA_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.TE_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.TH_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers = HashMap.fromList []", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.TR_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"week\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4302451371066514, unseen = -4.553876891600541,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 93},\n                   koData =\n                     ClassData{prior = -1.0508216248317612, unseen = -3.951243718581427,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 50}}),\n       (\"Sal\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ramazan Bayram\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.0647107369924282),\n                                    (\"tomorrowevening\", -2.6741486494265287),\n                                    (\"<day-of-month> (non ordinal) <named-month>part of days\",\n                                     -2.6741486494265287),\n                                    (\"Pazartesipart of days\", -2.6741486494265287),\n                                    (\"Cumartesipart of days\", -2.6741486494265287),\n                                    (\"tomorrowlunch\", -2.6741486494265287),\n                                    (\"tomorrowpart of days\", -2.268683541318364),\n                                    (\"yesterdayevening\", -2.6741486494265287),\n                                    (\"yesterdaypart of days\", -2.6741486494265287)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\350ubatpart of days\", -1.8718021769015913),\n                                    (\"monthhour\", -1.8718021769015913)],\n                               n = 1}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -4.060443010546419,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.4039939382192916),\n                                    (\"hh:mm\", -1.55814461804655),\n                                    (\"about|exactly <time-of-day>\", -2.9444389791664407),\n                                    (\"hour\", -1.4039939382192916), (\"minute\", -1.4039939382192916)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.8690378470236094),\n                                    (\"about|exactly <time-of-day>\", -2.740840023925201),\n                                    (\"hour\", -0.7949298748698876)],\n                               n = 13}}),\n       (\"the ides of <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Mart\", -1.252762968495368), (\"month\", -0.8472978603872037),\n                                    (\"\\350ubat\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"g\\252n (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3101549283038396,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -1.3217558399823195, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"Ekim\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yaz\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> + '\\\"\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"Cuma\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter\", -0.6931471805599453),\n                                    (\"ordinals (first..31st)\\231eyrek y\\305l (grain)\",\n                                     -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Emek ve Dayan\\305\\351ma G\\252n\\252\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.5049259016388025, unseen = -5.673323267171493,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<named-month> <day-of-month> (non ordinal)Cuma\",\n                                     -4.976733742420574),\n                                    (\"Cuma<named-month> <day-of-month> (non ordinal)\",\n                                     -4.976733742420574),\n                                    (\"Cumartesiat <time-of-day>\", -4.57126863431241),\n                                    (\"dayhour\", -3.590439381300684),\n                                    (\"<day-of-month> (non ordinal) <named-month>Cuma\",\n                                     -4.57126863431241),\n                                    (\"monthday\", -3.367295829986474),\n                                    (\"monthyear\", -4.57126863431241),\n                                    (\"yearhour\", -4.976733742420574),\n                                    (\"intersectCuma\", -3.7239707739252066),\n                                    (\"Ekimintersect\", -3.8781214537524646),\n                                    (\"Per\\351embe<datetime> - <datetime> (interval)\",\n                                     -4.976733742420574),\n                                    (\"Per\\351embe<time-of-day> - <time-of-day> (interval)\",\n                                     -4.283586561860629),\n                                    (\"year<day-of-month> (ordinal)\", -4.976733742420574),\n                                    (\"intersectat <time-of-day>\", -3.8781214537524646),\n                                    (\"yearintersect\", -4.57126863431241),\n                                    (\"next <cycle>at <time-of-day>\", -4.976733742420574),\n                                    (\"intersectSal\\305\", -4.57126863431241),\n                                    (\"Cumaat <time-of-day>\", -4.57126863431241),\n                                    (\"<day-of-month> (non ordinal) <named-month>Cumartesi\",\n                                     -4.976733742420574),\n                                    (\"<named-month> <day-of-month> (non ordinal)Pazartesi\",\n                                     -4.976733742420574),\n                                    (\"Cumartesi<part-of-day> of <time>\", -4.976733742420574),\n                                    (\"<day-of-month> (non ordinal) <named-month>Pazartesi\",\n                                     -4.976733742420574),\n                                    (\"yearKurban Bayram\\305\", -4.060443010546419),\n                                    (\"dayday\", -2.578838469622204),\n                                    (\"<time> <part-of-day>at <time-of-day>\", -4.976733742420574),\n                                    (\"last <cycle>Pazar\", -4.976733742420574),\n                                    (\"hourhour\", -4.976733742420574),\n                                    (\"yearRamazan Bayram\\305\", -3.590439381300684),\n                                    (\"dayyear\", -3.367295829986474),\n                                    (\"<day-of-month> (non ordinal) <named-month>intersect\",\n                                     -3.7239707739252066),\n                                    (\"EOM|End of dayat <time-of-day>\", -4.976733742420574),\n                                    (\"<day-of-month> (non ordinal) <named-month>Sal\\305\",\n                                     -4.976733742420574),\n                                    (\"<day-of-month> (ordinal)\\199ar\\351amba\", -4.976733742420574),\n                                    (\"before yesterdayat <time-of-day>\", -4.976733742420574),\n                                    (\"Pazar<day-of-month> (non ordinal) <named-month>\",\n                                     -4.976733742420574),\n                                    (\"Y\\305lba\\351\\305at <time-of-day>\", -4.976733742420574),\n                                    (\"at <time-of-day><day-of-month> (non ordinal) <named-month>\",\n                                     -4.976733742420574),\n                                    (\"hh:mm<day-of-month> (non ordinal) <named-month>\",\n                                     -4.976733742420574),\n                                    (\"hh:mmintersect\", -4.283586561860629),\n                                    (\"Ekim<day-of-month> (ordinal)\", -4.57126863431241),\n                                    (\"at <time-of-day>intersect\", -4.283586561860629),\n                                    (\"dayminute\", -2.7254419438140793),\n                                    (\"intersectyear\", -4.57126863431241),\n                                    (\"minuteday\", -2.9618307218783095),\n                                    (\"yearCuma\", -4.57126863431241),\n                                    (\"Ekimyear\", -4.57126863431241),\n                                    (\"<day-of-month> (ordinal)Sal\\305\", -4.57126863431241),\n                                    (\"intersect<day-of-month> (ordinal)\", -4.976733742420574),\n                                    (\"intersectintersect\", -4.060443010546419),\n                                    (\"weekday\", -4.57126863431241),\n                                    (\"yearday\", -2.8972922007407385),\n                                    (\"Ramazan Bayram\\305year\", -4.976733742420574),\n                                    (\"next <cycle>\\199ar\\351amba\", -4.976733742420574),\n                                    (\"tomorrowat <time-of-day>\", -4.976733742420574),\n                                    (\"<duration> henceat <time-of-day>\", -4.976733742420574),\n                                    (\"Per\\351embehh:mm\", -4.976733742420574),\n                                    (\"intersect\\199ar\\351amba\", -4.283586561860629),\n                                    (\"<named-month> <day-of-month> (non ordinal)year\",\n                                     -4.283586561860629),\n                                    (\"minuteyear\", -4.57126863431241),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -3.8781214537524646),\n                                    (\"yearminute\", -4.976733742420574)],\n                               n = 102},\n                   koData =\n                     ClassData{prior = -0.9252060955321073,\n                               unseen = -5.3981627015177525,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Cumartesiat <time-of-day>\", -4.700480365792417),\n                                    (\"dayhour\", -2.2155737160044158),\n                                    (\"daymonth\", -4.700480365792417),\n                                    (\"monthday\", -2.995732273553991),\n                                    (\"monthyear\", -3.6018680771243066),\n                                    (\"yearhour\", -4.700480365792417),\n                                    (\"intersectCuma\", -4.295015257684252),\n                                    (\"Per\\351embe<datetime> - <datetime> (interval)\",\n                                     -4.295015257684252),\n                                    (\"Cumaintersect\", -4.700480365792417),\n                                    (\"intersectat <time-of-day>\", -2.754570216737103),\n                                    (\"yearintersect\", -4.700480365792417),\n                                    (\"<day-of-month> (ordinal)year\", -4.700480365792417),\n                                    (\"Cumaat <time-of-day>\", -4.295015257684252),\n                                    (\"Martyear\", -4.295015257684252),\n                                    (\"monthhour\", -3.6018680771243066),\n                                    (\"<day-of-month> (ordinal)<day-of-month> (ordinal)\",\n                                     -4.700480365792417),\n                                    (\"dayday\", -3.6018680771243066),\n                                    (\"\\350ubatPazartesi\", -4.700480365792417),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.700480365792417),\n                                    (\"Temmuz<day-of-month> (ordinal)\", -4.700480365792417),\n                                    (\"dayyear\", -4.295015257684252),\n                                    (\"<day-of-month> (non ordinal) <named-month>intersect\",\n                                     -3.784189633918261),\n                                    (\"EOM|End of dayat <time-of-day>\", -4.700480365792417),\n                                    (\"monthminute\", -3.6018680771243066),\n                                    (\"Per\\351embe<day-of-month> (ordinal)\", -4.700480365792417),\n                                    (\"Temmuzyear\", -4.295015257684252),\n                                    (\"Nisanyear\", -4.700480365792417),\n                                    (\"CumaTemmuz\", -4.700480365792417),\n                                    (\"TemmuzCuma\", -4.700480365792417),\n                                    (\"last <cycle>at <time-of-day>\", -4.700480365792417),\n                                    (\"\\350ubatSal\\305\", -4.700480365792417),\n                                    (\"<day-of-month> (ordinal)hh:mm\", -4.007333185232471),\n                                    (\"dayminute\", -3.196402969016142),\n                                    (\"intersectyear\", -4.700480365792417),\n                                    (\"Eyl\\252lCuma\", -4.700480365792417),\n                                    (\"minuteday\", -4.295015257684252),\n                                    (\"Eyl\\252lintersect\", -3.784189633918261),\n                                    (\"intersect<day-of-month> (ordinal)\", -4.700480365792417),\n                                    (\"intersectintersect\", -4.007333185232471),\n                                    (\"Temmuzintersect\", -3.4477173972970485),\n                                    (\"Eyl\\252lCumartesi\", -4.700480365792417),\n                                    (\"Per\\351embeat <time-of-day>\", -4.700480365792417),\n                                    (\"tomorrowat <time-of-day>\", -4.700480365792417),\n                                    (\"<datetime> - <datetime> (interval)<day-of-month> (ordinal)\",\n                                     -4.295015257684252),\n                                    (\"tomorrownoon\", -4.700480365792417)],\n                               n = 67}}),\n       (\"y\\305l (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1431008436406733,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"g\\252n (grain)\", -2.890371757896165),\n                                    (\"y\\305l (grain)\", -2.890371757896165),\n                                    (\"hafta (grain)\", -1.791759469228055),\n                                    (\"day\", -2.890371757896165), (\"quarter\", -2.890371757896165),\n                                    (\"year\", -2.890371757896165),\n                                    (\"\\231eyrek y\\305l (grain)\", -2.890371757896165),\n                                    (\"ay (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.0149030205422647, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"g\\252n (grain)\", -1.540445040947149),\n                                    (\"day\", -1.540445040947149)],\n                               n = 2}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 1}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"hafta (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"Pazartesi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Nisan\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersectordinals (first..31st)\\199ar\\351amba\",\n                                     -2.1972245773362196),\n                                    (\"<day-of-month> (ordinal)ordinal (digits)year\",\n                                     -2.1972245773362196),\n                                    (\"monthday\", -1.5040773967762742),\n                                    (\"dayyear\", -2.1972245773362196),\n                                    (\"Ekimordinals (first..31st)Sal\\305\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<day-of-month> (ordinal)ordinal (digits)time-of-day (latent)\",\n                                     -1.791759469228055),\n                                    (\"dayhour\", -1.791759469228055),\n                                    (\"dayyear\", -2.1972245773362196),\n                                    (\"yearordinals (first..31st)\\199ar\\351amba\",\n                                     -2.1972245773362196),\n                                    (\"Per\\351embeordinal (digits)year (latent)\",\n                                     -2.1972245773362196),\n                                    (\"yearday\", -2.1972245773362196)],\n                               n = 4}}),\n       (\"saniye (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Cumartesi\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinals (first..31st)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Temmuz\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -1.3862943611198906),\n                                    (\"hourminute\", -1.3862943611198906),\n                                    (\"part of daysat <time-of-day>\", -1.0986122886681098),\n                                    (\"eveningat <time-of-day>\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourhour\", -0.9808292530117262),\n                                    (\"part of daysat <time-of-day>\", -1.3862943611198906),\n                                    (\"eveningat <time-of-day>\", -1.3862943611198906)],\n                               n = 2}}),\n       (\"EOY|End of year\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.8472978603872037), (\"evening\", -1.252762968495368),\n                                    (\"part of days\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> hence\",\n        Classifier{okData =\n                     ClassData{prior = -0.2411620568168881,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.575536360758419), (\"day\", -1.9810014688665833),\n                                    (\"year\", -2.268683541318364),\n                                    (\"<integer> <unit-of-duration>\", -0.8823891801984737),\n                                    (\"month\", -2.6741486494265287)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.540445040947149, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.8718021769015913), (\"year\", -1.8718021769015913),\n                                    (\"<integer> <unit-of-duration>\", -1.466337068793427),\n                                    (\"fortnight\", -1.8718021769015913),\n                                    (\"minute\", -1.8718021769015913)],\n                               n = 3}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Zafer Bayram\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Per\\351embe\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"by <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.3862943611198906),\n                                    (\"EOM|End of month\", -1.3862943611198906),\n                                    (\"month\", -1.3862943611198906),\n                                    (\"EOM|End of day\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1400661634962708), (\"second\", -1.7346010553881064),\n                                    (\"year\", -2.1400661634962708),\n                                    (\"<integer> <unit-of-duration>\", -0.8873031950009028),\n                                    (\"hour\", -1.7346010553881064)],\n                               n = 6}}),\n       (\"quarter\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.791759469228055),\n                                    (\"y\\305l (grain)\", -1.791759469228055),\n                                    (\"hafta (grain)\", -1.791759469228055),\n                                    (\"quarter\", -1.791759469228055), (\"year\", -1.791759469228055),\n                                    (\"\\231eyrek y\\305l (grain)\", -1.791759469228055)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"hafta (grain)\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"dakika (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6061358035703156, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.10536051565782628),\n                                    (\"integer (0..9)\", -2.3025850929940455)],\n                               n = 18},\n                   koData =\n                     ClassData{prior = -0.7884573603642702, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (numeric)\", -6.0624621816434854e-2)],\n                               n = 15}}),\n       (\"A\\287ustos\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -2.5649493574615367,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -0.456758402495715, unseen = -4.584967478670572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.0898043287153825),\n                                    (\"integer (numeric)hafta (grain)\", -2.782951509275328),\n                                    (\"integer (numeric)saniye (grain)\", -3.4760986898352733),\n                                    (\"integer (0..9)saniye (grain)\", -3.4760986898352733),\n                                    (\"second\", -2.9652730660692823),\n                                    (\"integer (numeric)g\\252n (grain)\", -2.495269436823547),\n                                    (\"integer (0..9)g\\252n (grain)\", -3.8815637979434374),\n                                    (\"integer (numeric)y\\305l (grain)\", -3.8815637979434374),\n                                    (\"day\", -2.3774864011671633),\n                                    (\"integer (0..9)ay (grain)\", -3.4760986898352733),\n                                    (\"year\", -2.782951509275328),\n                                    (\"integer (0..9)y\\305l (grain)\", -2.9652730660692823),\n                                    (\"hour\", -3.8815637979434374), (\"month\", -3.4760986898352733),\n                                    (\"integer (numeric)dakika (grain)\", -2.782951509275328),\n                                    (\"integer (0..9)saat (grain)\", -3.8815637979434374),\n                                    (\"integer (0..9)hafta (grain)\", -2.62880082944807),\n                                    (\"minute\", -2.495269436823547),\n                                    (\"integer (0..9)dakika (grain)\", -3.4760986898352733)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -1.0033021088637848, unseen = -4.189654742026425,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5649493574615367),\n                                    (\"integer (numeric)saniye (grain)\", -3.0757749812275272),\n                                    (\"integer (0..9)saniye (grain)\", -3.0757749812275272),\n                                    (\"second\", -2.5649493574615367),\n                                    (\"integer (numeric)g\\252n (grain)\", -3.481240089335692),\n                                    (\"integer (numeric)ay (grain)\", -3.481240089335692),\n                                    (\"integer (0..9)g\\252n (grain)\", -3.481240089335692),\n                                    (\"integer (numeric)y\\305l (grain)\", -3.0757749812275272),\n                                    (\"day\", -3.0757749812275272),\n                                    (\"integer (0..9)ay (grain)\", -3.481240089335692),\n                                    (\"year\", -2.5649493574615367),\n                                    (\"integer (0..9)y\\305l (grain)\", -3.0757749812275272),\n                                    (\"hour\", -2.5649493574615367), (\"month\", -3.0757749812275272),\n                                    (\"integer (numeric)dakika (grain)\", -3.481240089335692),\n                                    (\"integer (0..9)saat (grain)\", -3.0757749812275272),\n                                    (\"integer (0..9)hafta (grain)\", -2.5649493574615367),\n                                    (\"minute\", -3.0757749812275272),\n                                    (\"integer (numeric)saat (grain)\", -3.0757749812275272),\n                                    (\"integer (0..9)dakika (grain)\", -3.481240089335692)],\n                               n = 22}}),\n       (\"Aral\\305k\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\199ar\\351amba\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayyear\", -1.2039728043259361),\n                                    (\"hourminute\", -1.6094379124341003),\n                                    (\"at <time-of-day><integer> <unit-of-duration>\",\n                                     -1.6094379124341003),\n                                    (\"Y\\305lba\\351\\305<integer> <unit-of-duration>\",\n                                     -1.2039728043259361)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (10..90)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Kurban Bayram\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\231eyrek y\\305l (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 22},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ay (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Mart\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"about|exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.7346010553881064),\n                                    (\"hh:mm\", -1.4469189829363254), (\"minute\", -1.041453874828161)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -1.8718021769015913),\n                                    (\"day\", -1.8718021769015913),\n                                    (\"time-of-day (latent)\", -1.8718021769015913),\n                                    (\"<day-of-month> (ordinal)\", -1.8718021769015913),\n                                    (\"hour\", -1.466337068793427)],\n                               n = 3}}),\n       (\"k\\305\\351\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -0.11778303565638351,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.4816045409242156), (\"day\", -1.9924301646902063),\n                                    (\"year\", -2.3978952727983707),\n                                    (\"<integer> <unit-of-duration>\", -0.8938178760220964),\n                                    (\"month\", -2.3978952727983707)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -2.1972245773362196,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -1.3862943611198906),\n                                    (\"fortnight\", -1.3862943611198906)],\n                               n = 1}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sal\\305\", -2.0794415416798357), (\"day\", -1.1631508098056809),\n                                    (\"k\\305\\351\", -1.6739764335716716),\n                                    (\"hour\", -2.0794415416798357), (\"Pazar\", -2.0794415416798357),\n                                    (\"week-end\", -2.0794415416798357)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"EOM|End of month\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"saat (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -2.6026896854443837,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..31st)\", -0.40546510810816444),\n                                    (\"ordinal (digits)\", -1.0986122886681098)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..31st)\", -2.8526314299133175),\n                                    (\"ordinal (digits)\", -5.9423420470800764e-2)],\n                               n = 50}}),\n       (\"Atat\\252rk\\8217\\252 Anma, Gen\\231lik ve Spor Bayram\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sal\\305\", -1.466337068793427), (\"Cuma\", -2.5649493574615367),\n                                    (\"day\", -1.1786549963416462), (\"Mart\", -1.8718021769015913),\n                                    (\"month\", -1.8718021769015913),\n                                    (\"ilkbahar\", -2.5649493574615367)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Eyl\\252l\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.5686159179138452),\n                                    (\"y\\305l (grain)\", -2.4849066497880004),\n                                    (\"hafta (grain)\", -1.5686159179138452),\n                                    (\"year\", -2.4849066497880004),\n                                    (\"ay (grain)\", -1.791759469228055),\n                                    (\"month\", -1.791759469228055)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -1.2992829841302609, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9459101490553135),\n                                    (\"g\\252n (grain)\", -1.540445040947149),\n                                    (\"hafta (grain)\", -1.9459101490553135),\n                                    (\"day\", -1.540445040947149)],\n                               n = 3}}),\n       (\"Pazar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Cumhuriyet Bayram\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.1972245773362196),\n                                    (\"integer (numeric)saniye (grain)\", -2.6026896854443837),\n                                    (\"integer (0..9)saniye (grain)\", -2.6026896854443837),\n                                    (\"second\", -2.1972245773362196),\n                                    (\"integer (numeric)y\\305l (grain)\", -2.6026896854443837),\n                                    (\"year\", -2.1972245773362196),\n                                    (\"integer (0..9)y\\305l (grain)\", -2.6026896854443837),\n                                    (\"hour\", -2.1972245773362196),\n                                    (\"integer (0..9)saat (grain)\", -2.6026896854443837),\n                                    (\"integer (0..9)hafta (grain)\", -2.1972245773362196),\n                                    (\"integer (numeric)saat (grain)\", -2.6026896854443837)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.4277482359480516), (\"second\", -1.916922612182061),\n                                    (\"day\", -2.833213344056216),\n                                    (\"<integer> <unit-of-duration>\", -0.8183103235139514),\n                                    (\"hour\", -2.833213344056216), (\"minute\", -1.580450375560848)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -2.70805020110221),\n                                    (\"at <time-of-day>hh:mm\", -2.70805020110221),\n                                    (\"minuteminute\", -1.6094379124341003),\n                                    (\"hh:mmhh:mm\", -2.0149030205422647),\n                                    (\"dayday\", -2.70805020110221),\n                                    (\"<day-of-month> (non ordinal) <named-month><day-of-month> (non ordinal) <named-month>\",\n                                     -2.70805020110221)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -2.4849066497880004),\n                                    (\"monthday\", -3.1780538303479458),\n                                    (\"hh:mm<day-of-month> (ordinal)\", -2.2617630984737906),\n                                    (\"year<day-of-month> (ordinal)\", -2.772588722239781),\n                                    (\"dayday\", -3.1780538303479458),\n                                    (\"nth <time> of <time><day-of-month> (ordinal)\",\n                                     -3.1780538303479458),\n                                    (\"nth <time> of <time>hh:mm\", -3.1780538303479458),\n                                    (\"at <time-of-day><day-of-month> (ordinal)\",\n                                     -2.2617630984737906),\n                                    (\"dayminute\", -3.1780538303479458),\n                                    (\"minuteday\", -1.791759469228055),\n                                    (\"intersect<day-of-month> (ordinal)\", -2.772588722239781),\n                                    (\"yearday\", -2.772588722239781),\n                                    (\"A\\287ustos<day-of-month> (non ordinal) <named-month>\",\n                                     -3.1780538303479458)],\n                               n = 15}}),\n       (\"fortnight\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\350ubat\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.9095425048844386),\n                                    (\"at <time-of-day>hh:mm\", -2.6026896854443837),\n                                    (\"minuteminute\", -1.6863989535702288),\n                                    (\"hh:mmhh:mm\", -1.9095425048844386),\n                                    (\"hourhour\", -2.1972245773362196),\n                                    (\"minutehour\", -1.6863989535702288),\n                                    (\"at <time-of-day>time-of-day (latent)\", -1.9095425048844386)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7047480922384253),\n                                    (\"minutehour\", -1.2992829841302609),\n                                    (\"at <time-of-day>time-of-day (latent)\", -1.7047480922384253)],\n                               n = 2}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.772588722239781),\n                                    (\"integer (numeric)saniye (grain)\", -3.1780538303479458),\n                                    (\"integer (0..9)saniye (grain)\", -3.1780538303479458),\n                                    (\"second\", -2.772588722239781),\n                                    (\"integer (numeric)g\\252n (grain)\", -3.1780538303479458),\n                                    (\"integer (numeric)ay (grain)\", -3.1780538303479458),\n                                    (\"integer (0..9)g\\252n (grain)\", -3.1780538303479458),\n                                    (\"integer (numeric)y\\305l (grain)\", -3.1780538303479458),\n                                    (\"day\", -2.772588722239781),\n                                    (\"integer (0..9)ay (grain)\", -3.1780538303479458),\n                                    (\"year\", -2.772588722239781),\n                                    (\"integer (0..9)y\\305l (grain)\", -3.1780538303479458),\n                                    (\"hour\", -2.772588722239781), (\"month\", -2.772588722239781),\n                                    (\"integer (numeric)dakika (grain)\", -3.1780538303479458),\n                                    (\"integer (0..9)saat (grain)\", -3.1780538303479458),\n                                    (\"integer (0..9)hafta (grain)\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781),\n                                    (\"integer (numeric)saat (grain)\", -3.1780538303479458),\n                                    (\"integer (0..9)dakika (grain)\", -3.1780538303479458)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<named-month> <day-of-month> (non ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\350ubatinteger (numeric)\", -2.5257286443082556),\n                                    (\"A\\287ustosinteger (numeric)\", -2.120263536200091),\n                                    (\"Martinteger (numeric)\", -2.5257286443082556),\n                                    (\"Martinteger (0..9)\", -2.120263536200091),\n                                    (\"Nisaninteger (numeric)\", -2.5257286443082556),\n                                    (\"Temmuzinteger (numeric)\", -2.120263536200091),\n                                    (\"month\", -0.916290731874155)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ilkbahar\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\\350ubat\", -2.151762203259462),\n                                    (\"integer (numeric)Nisan\", -3.068052935133617),\n                                    (\"integer (numeric)A\\287ustos\", -2.662587827025453),\n                                    (\"integer (numeric)Mart\", -2.662587827025453),\n                                    (\"integer (numeric)Eyl\\252l\", -2.662587827025453),\n                                    (\"integer (0..9)Mart\", -3.068052935133617),\n                                    (\"integer (numeric)Temmuz\", -2.374905754573672),\n                                    (\"month\", -0.8708283577973976),\n                                    (\"integer (numeric)Aral\\305k\", -2.662587827025453)],\n                               n = 17},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sal\\305\", -1.252762968495368), (\"Cuma\", -1.9459101490553135),\n                                    (\"Pazartesi\", -1.9459101490553135),\n                                    (\"day\", -0.8472978603872037)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -3.5115454388310208,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -3.0305349495328922e-2,\n                               unseen = -4.204692619390966,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 65}}),\n       (\"integer (0..9)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Y\\305lba\\351\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 11..99\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (10..90)integer (0..9)\", 0.0)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"for <duration> from <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.9808292530117262),\n                                    (\"<day-of-month> (non ordinal) <named-month><integer> <unit-of-duration>\",\n                                     -0.9808292530117262)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -0.9808292530117262),\n                                    (\"Aral\\305k<integer> <unit-of-duration>\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"part of days\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Ulusal Egemenlik ve \\199ocuk Bayram\\305\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> (as relative minutes)\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer 11..99\", -1.3862943611198906),\n                                    (\"hour\", -0.9808292530117262),\n                                    (\"at <time-of-day>integer (numeric)\", -1.3862943611198906)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>integer (10..90)\", -1.0986122886681098),\n                                    (\"hour\", -1.0986122886681098)],\n                               n = 1}}),\n       (\"EOM|End of day\",\n        Classifier{okData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yaz\", -2.0149030205422647),\n                                    (\"Pazartesi\", -2.0149030205422647),\n                                    (\"day\", -1.3217558399823195),\n                                    (\"k\\305\\351\", -2.0149030205422647),\n                                    (\"hour\", -2.0149030205422647),\n                                    (\"week-end\", -2.0149030205422647)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Sal\\305\", -1.5040773967762742), (\"day\", -1.5040773967762742)],\n                               n = 1}}),\n       (\"before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1247}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.UK_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\1050\\1074\\1110\\1090\\1077\\1085\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm\", -0.6931471805599453),\n                                    (\"minute\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.7693745459478296, unseen = -4.634728988229636,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 101},\n                   koData =\n                     ClassData{prior = -0.6223211279913329, unseen = -4.77912349311153,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 117}}),\n       (\"integer (3..19)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.13976194237515874,\n                               unseen = -4.709530201312334,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clockmorning\", -3.6018680771243066),\n                                    (\"until <time-of-day>afternoon\", -4.007333185232471),\n                                    (\"dayhour\", -2.503255788456197),\n                                    (\"at <time-of-day>evening\", -4.007333185232471),\n                                    (\"\\1074\\1095\\1086\\1088\\1072evening\", -4.007333185232471),\n                                    (\"intersect by ','evening\", -3.6018680771243066),\n                                    (\"\\1089\\1100\\1086\\1075\\1086\\1076\\1085\\1110afternoon\",\n                                     -4.007333185232471),\n                                    (\"intersectevening\", -2.2155737160044158),\n                                    (\"hourhour\", -1.3331845358059422),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072lunch\", -4.007333185232471),\n                                    (\"at <time-of-day>afternoon\", -3.6018680771243066),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082morning\",\n                                     -4.007333185232471),\n                                    (\"<time-of-day>  o'clockafternoon\", -3.0910424533583156),\n                                    (\"until <time-of-day>morning\", -4.007333185232471),\n                                    (\"minutehour\", -3.0910424533583156),\n                                    (\"\\1089\\1100\\1086\\1075\\1086\\1076\\1085\\1110evening\",\n                                     -4.007333185232471),\n                                    (\"time-of-day (latent)morning\", -4.007333185232471),\n                                    (\"hh:mmmorning\", -4.007333185232471),\n                                    (\"time-of-day (latent)evening\", -4.007333185232471),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072evening\", -4.007333185232471),\n                                    (\"<time-of-day>  o'clockevening\", -3.6018680771243066),\n                                    (\"hh:mmnight\", -4.007333185232471),\n                                    (\"hh:mmafternoon\", -4.007333185232471),\n                                    (\"on <date>morning\", -4.007333185232471),\n                                    (\"at <time-of-day>morning\", -4.007333185232471),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088morning\", -4.007333185232471)],\n                               n = 40},\n                   koData =\n                     ClassData{prior = -2.03688192726104, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearhour\", -2.639057329615259),\n                                    (\"intersectevening\", -2.3513752571634776),\n                                    (\"hourhour\", -2.128231705849268),\n                                    (\"year (latent)afternoon\", -3.044522437723423),\n                                    (\"year (latent)night\", -3.044522437723423),\n                                    (\"time-of-day (latent)afternoon\", -3.044522437723423)],\n                               n = 6}}),\n       (\"numbers prefix with -, minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4462871026284195),\n                                    (\"decimal number\", -1.0216512475319814)],\n                               n = 23}}),\n       (\"\\1087\\1110\\1089\\1083\\1103\\1079\\1072\\1074\\1090\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1074\\1095\\1086\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -0.5389965007326869, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14}}),\n       (\"\\1057\\1091\\1073\\1086\\1090\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"at <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1431008436406733, unseen = -4.060443010546419,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.845826690498331),\n                                    (\"time-of-day (latent)\", -1.3350010667323402),\n                                    (\"hh:mm\", -2.4336133554004498), (\"hour\", -0.9075570519054005),\n                                    (\"minute\", -2.4336133554004498)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -2.0149030205422647, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9555114450274363),\n                                    (\"hour\", -0.9555114450274363)],\n                               n = 4}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1057\\1091\\1073\\1086\\1090\\1072\", -2.3978952727983707),\n                                    (\"\\1057\\1077\\1088\\1077\\1076\\1072\", -2.3978952727983707),\n                                    (\"\\1053\\1077\\1076\\1110\\1083\\1103\", -2.3978952727983707),\n                                    (\"day\", -0.8938178760220964),\n                                    (\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103\", -1.7047480922384253),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082\",\n                                     -1.9924301646902063)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"on <date>\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.639057329615259),\n                                    (\"\\1057\\1091\\1073\\1086\\1090\\1072\", -2.639057329615259),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088\", -2.639057329615259),\n                                    (\"intersect\", -1.540445040947149), (\"day\", -1.9459101490553135),\n                                    (\"hour\", -1.7227665977411035),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082\",\n                                     -2.639057329615259),\n                                    (\"minute\", -2.2335922215070942)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -1.7047480922384253, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.9459101490553135),\n                                    (\"\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100\",\n                                     -1.9459101490553135),\n                                    (\"month\", -1.540445040947149)],\n                               n = 2}}),\n       (\"\\1074\\1077\\1089\\1085\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"between <time-of-day> and <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.6739764335716716),\n                                    (\"minuteminute\", -1.6739764335716716),\n                                    (\"time-of-day (latent)time-of-day (latent)\",\n                                     -2.0794415416798357),\n                                    (\"hh:mmhh:mm\", -1.6739764335716716),\n                                    (\"hourhour\", -2.0794415416798357),\n                                    (\"minutehour\", -1.6739764335716716)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1063\\1077\\1090\\1074\\1077\\1088\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day>  o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -0.14518200984449783,\n                               unseen = -4.248495242049359,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"at <time-of-day>\", -2.03688192726104),\n                                    (\"time-of-day (latent)\", -1.289667525430819),\n                                    (\"until <time-of-day>\", -2.847812143477369),\n                                    (\"hour\", -0.7375989431307791),\n                                    (\"after <time-of-day>\", -2.847812143477369)],\n                               n = 32},\n                   koData =\n                     ClassData{prior = -2.001480000210124, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.916290731874155),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 5}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.4350845252893227,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.2719337154836418, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16}}),\n       (\"<ordinal> quarter\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)quarter (grain)\", -0.6931471805599453),\n                                    (\"quarter\", -0.6931471805599453)],\n                               n = 1}}),\n       (\"\\1057\\1077\\1088\\1077\\1076\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.2411620568168881, unseen = -5.817111159963204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082this <cycle>\",\n                                     -5.120983351265121),\n                                    (\"hourday\", -4.204692619390966),\n                                    (\"<datetime> - <datetime> (interval)year\", -5.120983351265121),\n                                    (\"hh:mm<part-of-day> of <time>\", -4.204692619390966),\n                                    (\"dayhour\", -2.287770007208905),\n                                    (\"daymonth\", -3.868220382769753),\n                                    (\"monthyear\", -3.5115454388310208),\n                                    (\"yearhour\", -5.120983351265121),\n                                    (\"intersect<time-of-day>  o'clock\", -4.204692619390966),\n                                    (\"absorption of , after named daymm/dd/yyyy\",\n                                     -5.120983351265121),\n                                    (\"<day-of-month> (ordinal)\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100\",\n                                     -5.120983351265121),\n                                    (\"\\1046\\1086\\1074\\1090\\1077\\1085\\1100year\", -4.022371062597012),\n                                    (\"intersect<time> <part-of-day>\", -4.204692619390966),\n                                    (\"\\1051\\1080\\1089\\1090\\1086\\1087\\1072\\1076year\",\n                                     -5.120983351265121),\n                                    (\"\\1057\\1077\\1088\\1077\\1076\\1072\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -4.715518243156957),\n                                    (\"intersect\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -5.120983351265121),\n                                    (\"intersect by ','year\", -4.715518243156957),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088hh:mm\", -5.120983351265121),\n                                    (\"on <date><time-of-day>  o'clock\", -5.120983351265121),\n                                    (\"\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100year\",\n                                     -5.120983351265121),\n                                    (\"\\1057\\1091\\1073\\1086\\1090\\1072<time-of-day>  o'clock\",\n                                     -5.120983351265121),\n                                    (\"mm/dd<time-of-day>  o'clock\", -5.120983351265121),\n                                    (\"\\1057\\1077\\1088\\1077\\1076\\1072next <cycle>\",\n                                     -5.120983351265121),\n                                    (\"last <day-of-week> of <time>year\", -5.120983351265121),\n                                    (\"\\1042\\1077\\1088\\1077\\1089\\1077\\1085\\1100year\",\n                                     -4.715518243156957),\n                                    (\"on <date>between <time-of-day> and <time-of-day> (interval)\",\n                                     -4.715518243156957),\n                                    (\"on <date>at <time-of-day>\", -4.715518243156957),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088between <time-of-day> and <time-of-day> (interval)\",\n                                     -4.204692619390966),\n                                    (\"dayday\", -2.9809171877688505),\n                                    (\"at <time-of-day>\\1079\\1072\\1074\\1090\\1088\\1072\",\n                                     -5.120983351265121),\n                                    (\"\\1057\\1091\\1073\\1086\\1090\\1072at <time-of-day>\",\n                                     -4.715518243156957),\n                                    (\"mm/ddat <time-of-day>\", -4.715518243156957),\n                                    (\"<time> <part-of-day>between <time-of-day> and <time-of-day> (interval)\",\n                                     -5.120983351265121),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.427836170705175),\n                                    (\"hourhour\", -5.120983351265121),\n                                    (\"hh:mmintersect by ','\", -5.120983351265121),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -4.715518243156957),\n                                    (\"dayyear\", -2.869691552658626),\n                                    (\"<day-of-month> (ordinal)\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\",\n                                     -5.120983351265121),\n                                    (\"<day-of-month> (non ordinal) <named-month>intersect\",\n                                     -5.120983351265121),\n                                    (\"\\1089\\1100\\1086\\1075\\1086\\1076\\1085\\1110<time-of-day>  o'clock\",\n                                     -5.120983351265121),\n                                    (\"minutehour\", -3.868220382769753),\n                                    (\"absorption of , after named day<day-of-month> (non ordinal) <named-month>\",\n                                     -3.7346889901452305),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088<part-of-day> of <time>\",\n                                     -5.120983351265121),\n                                    (\"at <time-of-day><day-of-month> (non ordinal) <named-month>\",\n                                     -5.120983351265121),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088<datetime> - <datetime> (interval)\",\n                                     -5.120983351265121),\n                                    (\"hh:mm<day-of-month> (non ordinal) <named-month>\",\n                                     -5.120983351265121),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088<time-of-day> - <time-of-day> (interval)\",\n                                     -4.715518243156957),\n                                    (\"hh:mmintersect\", -5.120983351265121),\n                                    (\"intersect by ','intersect\", -5.120983351265121),\n                                    (\"\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082this <cycle>\",\n                                     -5.120983351265121),\n                                    (\"dayminute\", -3.175073202209808),\n                                    (\"<time> <part-of-day>intersect\", -5.120983351265121),\n                                    (\"intersectyear\", -4.022371062597012),\n                                    (\"<ordinal> <cycle> of <time>year\", -5.120983351265121),\n                                    (\"minuteday\", -3.616905954488847),\n                                    (\"absorption of , after named dayintersect\",\n                                     -4.204692619390966),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072<time-of-day>  o'clock\",\n                                     -5.120983351265121),\n                                    (\"year<time-of-day>  o'clock\", -5.120983351265121),\n                                    (\"<time-of-day>  o'clock\\1079\\1072\\1074\\1090\\1088\\1072\",\n                                     -4.715518243156957),\n                                    (\"intersect by ','<time> <part-of-day>\", -5.120983351265121),\n                                    (\"<time> <part-of-day>intersect by ','\", -5.120983351265121),\n                                    (\"<day-of-month> (ordinal)\\1057\\1077\\1088\\1077\\1076\\1072\",\n                                     -5.120983351265121),\n                                    (\"mm/ddyear\", -4.715518243156957),\n                                    (\"intersect by ','<time-of-day>  o'clock\", -5.120983351265121),\n                                    (\"<time> <part-of-day>\\1057\\1091\\1073\\1086\\1090\\1072\",\n                                     -5.120983351265121),\n                                    (\"absorption of , after named daymm/dd\", -5.120983351265121),\n                                    (\"<time> <part-of-day>absorption of , after named day\",\n                                     -5.120983351265121),\n                                    (\"intersectintersect\", -4.715518243156957),\n                                    (\"<part-of-day> of <time><day-of-month> (non ordinal) <named-month>\",\n                                     -5.120983351265121),\n                                    (\"dayweek\", -4.204692619390966),\n                                    (\"\\1079\\1072\\1074\\1090\\1088\\1072at <time-of-day>\",\n                                     -4.715518243156957),\n                                    (\"\\1057\\1077\\1088\\1077\\1076\\1072intersect\", -5.120983351265121),\n                                    (\"weekyear\", -4.715518243156957),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088<time> timezone\",\n                                     -4.715518243156957),\n                                    (\"\\1089\\1100\\1086\\1075\\1086\\1076\\1085\\1110at <time-of-day>\",\n                                     -4.204692619390966),\n                                    (\"\\1089\\1100\\1086\\1075\\1086\\1076\\1085\\1110<time> <part-of-day>\",\n                                     -5.120983351265121),\n                                    (\"\\1050\\1072\\1090\\1086\\1083\\1080\\1094\\1100\\1082\\1077 \\1056\\1110\\1079\\1076\\1074\\1086year\",\n                                     -5.120983351265121),\n                                    (\"\\1057\\1077\\1088\\1077\\1076\\1072this <cycle>\",\n                                     -5.120983351265121),\n                                    (\"last <cycle> of <time>year\", -4.715518243156957),\n                                    (\"<day-of-month> (non ordinal) <named-month>year\",\n                                     -4.022371062597012)],\n                               n = 121},\n                   koData =\n                     ClassData{prior = -1.540445040947149, unseen = -5.075173815233827,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -4.375757021660286),\n                                    (\"daymonth\", -3.2771447329921766),\n                                    (\"monthyear\", -3.122994053164918),\n                                    (\"yearhour\", -4.375757021660286),\n                                    (\"intersect<time-of-day>  o'clock\", -4.375757021660286),\n                                    (\"intersect<time> <part-of-day>\", -4.375757021660286),\n                                    (\"absorption of , after named dayhh:mm\", -4.375757021660286),\n                                    (\"intersect\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -4.375757021660286),\n                                    (\"\\1063\\1077\\1090\\1074\\1077\\1088hh:mm\", -3.970291913552122),\n                                    (\"\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100year\",\n                                     -3.970291913552122),\n                                    (\"\\1051\\1080\\1087\\1077\\1085\\1100intersect\", -4.375757021660286),\n                                    (\"monthhour\", -3.6826098411003407),\n                                    (\"dayday\", -3.2771447329921766),\n                                    (\"\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082after <time-of-day>\",\n                                     -4.375757021660286),\n                                    (\"<day-of-month> (ordinal)intersect\", -4.375757021660286),\n                                    (\"dayyear\", -2.7663191092261856),\n                                    (\"<day-of-month> (ordinal)\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\",\n                                     -3.970291913552122),\n                                    (\"\\1051\\1080\\1087\\1077\\1085\\1100year\", -3.970291913552122),\n                                    (\"dayminute\", -3.6826098411003407),\n                                    (\"intersectyear\", -3.970291913552122),\n                                    (\"<day-of-month> (ordinal)\\1057\\1077\\1088\\1077\\1076\\1072\",\n                                     -4.375757021660286),\n                                    (\"year<time> <part-of-day>\", -4.375757021660286),\n                                    (\"mm/ddyear\", -3.2771447329921766),\n                                    (\"on <date>year\", -4.375757021660286),\n                                    (\"\\1057\\1077\\1088\\1077\\1076\\1072intersect\", -4.375757021660286),\n                                    (\"\\1053\\1077\\1076\\1110\\1083\\1103intersect\", -4.375757021660286),\n                                    (\"\\1050\\1074\\1110\\1090\\1077\\1085\\1100year\", -4.375757021660286),\n                                    (\"\\1089\\1100\\1086\\1075\\1086\\1076\\1085\\1110at <time-of-day>\",\n                                     -4.375757021660286),\n                                    (\"after <time-of-day>year\", -4.375757021660286),\n                                    (\"\\1056\\1110\\1079\\1076\\1074\\1086 \\1061\\1088\\1080\\1089\\1090\\1086\\1074\\1077year\",\n                                     -4.375757021660286),\n                                    (\"\\1053\\1077\\1076\\1110\\1083\\1103on <date>\",\n                                     -3.970291913552122)],\n                               n = 33}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.7047480922384253),\n                                    (\"ordinals (first..19th)day (grain)\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -1.7047480922384253),\n                                    (\"ordinals (first..19th)week (grain)intersect\",\n                                     -1.7047480922384253),\n                                    (\"weekmonth\", -1.2992829841302609)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.7047480922384253),\n                                    (\"month (grain)\", -2.3978952727983707),\n                                    (\"year (grain)\", -1.9924301646902063),\n                                    (\"week (grain)\", -1.7047480922384253),\n                                    (\"quarter\", -2.3978952727983707), (\"year\", -1.9924301646902063),\n                                    (\"month\", -2.3978952727983707),\n                                    (\"quarter (grain)\", -2.3978952727983707)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 2}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -1.0116009116784799, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"<ordinal> quarter <year>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -0.6931471805599453),\n                                    (\"ordinals (first..19th)quarter (grain)year\",\n                                     -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1051\\1080\\1087\\1077\\1085\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1050\\1110\\1085\\1077\\1094\\1100 \\1084\\1110\\1089\\1103\\1094\\1103\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1079\\1080\\1084\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"dayyear\", -1.8971199848858813),\n                                    (\"ordinals (first..19th)\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -2.3025850929940455),\n                                    (\"ordinals (first..19th)\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082intersect\",\n                                     -2.3025850929940455),\n                                    (\"ordinals (first..19th)\\1057\\1077\\1088\\1077\\1076\\1072intersect\",\n                                     -1.8971199848858813),\n                                    (\"ordinals (first..19th)intersectyear\", -1.8971199848858813)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.252762968495368),\n                                    (\"ordinals (first..19th)\\1057\\1077\\1088\\1077\\1076\\1072\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -1.540445040947149),\n                                    (\"ordinals (first..19th)\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\\1042\\1077\\1088\\1077\\1089\\1077\\1085\\1100\",\n                                     -1.9459101490553135)],\n                               n = 3}}),\n       (\"\\1053\\1077\\1076\\1110\\1083\\1103\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 21},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<part-of-day> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -1.2039728043259361),\n                                    (\"morning<day-of-month> (non ordinal) <named-month>\",\n                                     -2.3025850929940455),\n                                    (\"hourhour\", -2.3025850929940455),\n                                    (\"morningbetween <time-of-day> and <time-of-day> (interval)\",\n                                     -2.3025850929940455),\n                                    (\"night\\1057\\1091\\1073\\1086\\1090\\1072\", -2.3025850929940455),\n                                    (\"nightabsorption of , after named day\", -2.3025850929940455),\n                                    (\"nightintersect by ','\", -2.3025850929940455),\n                                    (\"nightintersect\", -2.3025850929940455)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month>(ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"ordinals (first..19th)\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100\",\n                                     -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1089\\1100\\1086\\1075\\1086\\1076\\1085\\1110\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> after next\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1057\\1077\\1088\\1077\\1076\\1072\", -1.252762968495368),\n                                    (\"day\", -0.8472978603872037),\n                                    (\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103\", -1.252762968495368)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer 2\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.2809338454620642),\n                                    (\"year (grain)\", -2.1972245773362196),\n                                    (\"week (grain)\", -1.2809338454620642),\n                                    (\"quarter\", -2.1972245773362196), (\"year\", -2.1972245773362196),\n                                    (\"quarter (grain)\", -2.1972245773362196)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1053\\1086\\1074\\1080\\1081 \\1088\\1110\\1082\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1079\\1072\\1074\\1090\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.35020242943311486,\n                               unseen = -3.5553480614894135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -9.237332013101517e-2),\n                                    (\"integer (3..19)\", -2.833213344056216)],\n                               n = 31},\n                   koData =\n                     ClassData{prior = -1.2192402764567243, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3746934494414107),\n                                    (\"integer (3..19)\", -1.6739764335716716),\n                                    (\"integer 2\", -2.0794415416798357)],\n                               n = 13}}),\n       (\"year\",\n        Classifier{okData =\n                     ClassData{prior = -0.19105523676270922,\n                               unseen = -3.044522437723423,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 19},\n                   koData =\n                     ClassData{prior = -1.749199854809259, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"last <day-of-week> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -0.916290731874155),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100\",\n                                     -1.6094379124341003),\n                                    (\"\\1053\\1077\\1076\\1110\\1083\\1103\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100\",\n                                     -1.6094379124341003),\n                                    (\"\\1053\\1077\\1076\\1110\\1083\\1103intersect\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -1.114360645636249, unseen = -4.2626798770413155,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.456735772821304),\n                                    (\"integer 2week (grain)\", -3.5553480614894135),\n                                    (\"integer (numeric)day (grain)\", -2.8622008809294686),\n                                    (\"second\", -3.5553480614894135),\n                                    (\"integer 2hour (grain)\", -3.5553480614894135),\n                                    (\"integer (numeric)second (grain)\", -3.5553480614894135),\n                                    (\"integer (numeric)year (grain)\", -3.1498829533812494),\n                                    (\"day\", -2.8622008809294686), (\"year\", -2.8622008809294686),\n                                    (\"integer (3..19)week (grain)\", -3.5553480614894135),\n                                    (\"integer (numeric)week (grain)\", -2.8622008809294686),\n                                    (\"hour\", -2.8622008809294686), (\"month\", -3.5553480614894135),\n                                    (\"integer (numeric)minute (grain)\", -2.456735772821304),\n                                    (\"integer (3..19)month (grain)\", -3.5553480614894135),\n                                    (\"minute\", -2.456735772821304),\n                                    (\"integer (numeric)hour (grain)\", -3.1498829533812494),\n                                    (\"integer 2year (grain)\", -3.5553480614894135)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -0.39768296766610944, unseen = -4.74493212836325,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.126760535960395),\n                                    (\"integer 2week (grain)\", -4.04305126783455),\n                                    (\"integer (numeric)day (grain)\", -3.349904087274605),\n                                    (\"integer (3..19)day (grain)\", -4.04305126783455),\n                                    (\"integer 2minute (grain)\", -4.04305126783455),\n                                    (\"second\", -3.126760535960395),\n                                    (\"integer 2month (grain)\", -4.04305126783455),\n                                    (\"integer (3..19)second (grain)\", -4.04305126783455),\n                                    (\"integer (numeric)second (grain)\", -3.6375861597263857),\n                                    (\"integer (numeric)year (grain)\", -3.6375861597263857),\n                                    (\"integer (3..19)year (grain)\", -4.04305126783455),\n                                    (\"day\", -2.9444389791664407), (\"year\", -3.126760535960395),\n                                    (\"integer (3..19)week (grain)\", -4.04305126783455),\n                                    (\"integer 2day (grain)\", -4.04305126783455),\n                                    (\"integer (numeric)week (grain)\", -3.6375861597263857),\n                                    (\"integer (3..19)minute (grain)\", -4.04305126783455),\n                                    (\"hour\", -1.791759469228055), (\"month\", -3.126760535960395),\n                                    (\"integer (numeric)minute (grain)\", -3.6375861597263857),\n                                    (\"integer (3..19)month (grain)\", -4.04305126783455),\n                                    (\"integer (numeric)month (grain)\", -3.6375861597263857),\n                                    (\"integer (3..19)hour (grain)\", -4.04305126783455),\n                                    (\"integer 2second (grain)\", -4.04305126783455),\n                                    (\"minute\", -3.126760535960395),\n                                    (\"integer (numeric)hour (grain)\", -1.845826690498331),\n                                    (\"integer 2year (grain)\", -4.04305126783455)],\n                               n = 43}}),\n       (\"ordinals (first..19th)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1042\\1077\\1088\\1077\\1089\\1077\\1085\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"yearday\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\\1056\\1110\\1079\\1076\\1074\\1086 \\1061\\1088\\1080\\1089\\1090\\1086\\1074\\1077\",\n                                     -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1051\\1102\\1090\\1080\\1081\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd.(mm.)? - dd.mm.(yy[yy]?)? (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -3.4011973816621555,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 28},\n                   koData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20}}),\n       (\"intersect by ','\",\n        Classifier{okData =\n                     ClassData{prior = -6.0624621816434854e-2,\n                               unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -3.1780538303479458),\n                                    (\"dayhour\", -2.772588722239781),\n                                    (\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103mm/dd\",\n                                     -3.1780538303479458),\n                                    (\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103intersect\",\n                                     -2.2617630984737906),\n                                    (\"dayday\", -1.3862943611198906),\n                                    (\"\\1057\\1077\\1088\\1077\\1076\\1072<day-of-month> (non ordinal) <named-month>\",\n                                     -3.1780538303479458),\n                                    (\"intersect<day-of-month> (non ordinal) <named-month>\",\n                                     -2.772588722239781),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082<day-of-month> (non ordinal) <named-month>\",\n                                     -2.772588722239781),\n                                    (\"\\1057\\1091\\1073\\1086\\1090\\1072<day-of-month> (non ordinal) <named-month>\",\n                                     -3.1780538303479458),\n                                    (\"minuteday\", -2.772588722239781),\n                                    (\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103mm/dd/yyyy\",\n                                     -3.1780538303479458),\n                                    (\"<part-of-day> of <time><day-of-month> (non ordinal) <named-month>\",\n                                     -3.1780538303479458),\n                                    (\"\\1053\\1077\\1076\\1110\\1083\\1103<day-of-month> (non ordinal) <named-month>\",\n                                     -3.1780538303479458),\n                                    (\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103<day-of-month> (non ordinal) <named-month>\",\n                                     -2.772588722239781)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -2.833213344056216, unseen = -2.9444389791664407,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103hh:mm\",\n                                     -2.1972245773362196),\n                                    (\"dayminute\", -2.1972245773362196)],\n                               n = 1}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by 'of', 'from', 's\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayweek\", -0.6931471805599453),\n                                    (\"\\1053\\1077\\1076\\1110\\1083\\1103last <cycle>\",\n                                     -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.55814461804655), (\"day\", -1.845826690498331),\n                                    (\"year\", -2.2512917986064953),\n                                    (\"<integer> <unit-of-duration>\", -0.8649974374866046),\n                                    (\"month\", -2.2512917986064953)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1051\\1080\\1089\\1090\\1086\\1087\\1072\\1076\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1053\\1077\\1076\\1110\\1083\\1103\", -1.0986122886681098),\n                                    (\"day\", -0.8109302162163288),\n                                    (\"\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\",\n                                     -1.5040773967762742)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (ordinal)\",\n        Classifier{okData =\n                     ClassData{prior = -1.2039728043259361,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"ordinals (first..19th)\", 0.0)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -0.35667494393873245,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"ordinals (first..19th)\", 0.0)],\n                               n = 7}}),\n       (\"\\1055'\\1103\\1090\\1085\\1080\\1094\\1103\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"until <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time> <part-of-day>\", -2.268683541318364),\n                                    (\"<time-of-day>  o'clock\", -1.9810014688665833),\n                                    (\"\\1050\\1110\\1085\\1077\\1094\\1100 \\1084\\1110\\1089\\1103\\1094\\1103\",\n                                     -2.6741486494265287),\n                                    (\"time-of-day (latent)\", -1.9810014688665833),\n                                    (\"hour\", -1.0647107369924282), (\"month\", -2.6741486494265287),\n                                    (\"midnight|EOD|end of day\", -2.6741486494265287)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -1.791759469228055, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm\", -1.466337068793427), (\"minute\", -1.466337068793427)],\n                               n = 2}}),\n       (\"\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"decimal number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.6109179126442243,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 35}}),\n       (\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"midnight|EOD|end of day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -2.0794415416798357),\n                                    (\"year (grain)\", -2.0794415416798357),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"year\", -2.0794415416798357), (\"month\", -2.0794415416798357)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.793208009442517),\n                                    (\"integer (numeric)day (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)day (grain)\", -3.1986731175506815),\n                                    (\"second\", -2.793208009442517),\n                                    (\"integer (3..19)second (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)second (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)year (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)year (grain)\", -3.1986731175506815),\n                                    (\"day\", -2.793208009442517), (\"year\", -2.793208009442517),\n                                    (\"integer (3..19)week (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)week (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)minute (grain)\", -3.1986731175506815),\n                                    (\"hour\", -2.793208009442517), (\"month\", -2.793208009442517),\n                                    (\"integer (numeric)minute (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)month (grain)\", -3.1986731175506815),\n                                    (\"integer (numeric)month (grain)\", -3.1986731175506815),\n                                    (\"integer (3..19)hour (grain)\", -3.1986731175506815),\n                                    (\"minute\", -2.793208009442517),\n                                    (\"integer (numeric)hour (grain)\", -3.1986731175506815)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"in <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.740840023925201), (\"second\", -2.740840023925201),\n                                    (\"day\", -2.740840023925201), (\"year\", -2.740840023925201),\n                                    (\"<integer> <unit-of-duration>\", -0.8690378470236094),\n                                    (\"hour\", -2.0476928433652555), (\"minute\", -1.6422277352570913)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<datetime> - <datetime> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersecthh:mm\", -2.740840023925201),\n                                    (\"minuteminute\", -1.6422277352570913),\n                                    (\"hh:mmhh:mm\", -1.824549292051046),\n                                    (\"dayday\", -1.824549292051046),\n                                    (\"<day-of-month> (non ordinal) <named-month><day-of-month> (non ordinal) <named-month>\",\n                                     -2.3353749158170367),\n                                    (\"mm/ddmm/dd\", -2.3353749158170367)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -3.258096538021482,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"monthday\", -2.120263536200091),\n                                    (\"mm/ddmm/dd/yyyy\", -2.5257286443082556),\n                                    (\"mm/ddhh:mm\", -2.120263536200091),\n                                    (\"dayday\", -2.120263536200091),\n                                    (\"mm/ddintersect\", -2.5257286443082556),\n                                    (\"dayminute\", -2.120263536200091),\n                                    (\"\\1057\\1077\\1088\\1087\\1077\\1085\\1100<day-of-month> (non ordinal) <named-month>\",\n                                     -2.5257286443082556),\n                                    (\"\\1051\\1080\\1087\\1077\\1085\\1100<day-of-month> (non ordinal) <named-month>\",\n                                     -2.5257286443082556)],\n                               n = 6}}),\n       (\"<time-of-day> - <time-of-day> (interval)\",\n        Classifier{okData =\n                     ClassData{prior = -0.3184537311185346,\n                               unseen = -3.1354942159291497,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.7047480922384253),\n                                    (\"minuteminute\", -1.2992829841302609),\n                                    (\"hh:mmhh:mm\", -1.2992829841302609),\n                                    (\"minutehour\", -1.7047480922384253)],\n                               n = 8},\n                   koData =\n                     ClassData{prior = -1.2992829841302609,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mmtime-of-day (latent)\", -1.791759469228055),\n                                    (\"hourminute\", -1.3862943611198906),\n                                    (\"minutehour\", -1.791759469228055),\n                                    (\"time-of-day (latent)hh:mm\", -1.3862943611198906)],\n                               n = 3}}),\n       (\"\\1057\\1077\\1088\\1087\\1077\\1085\\1100\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.639057329615259),\n                                    (\"integer 2week (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)day (grain)\", -3.044522437723423),\n                                    (\"integer 2minute (grain)\", -3.044522437723423),\n                                    (\"second\", -2.639057329615259),\n                                    (\"integer 2month (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)second (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)year (grain)\", -3.044522437723423),\n                                    (\"day\", -2.639057329615259), (\"year\", -2.639057329615259),\n                                    (\"integer 2day (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)week (grain)\", -3.044522437723423),\n                                    (\"month\", -2.639057329615259),\n                                    (\"integer (numeric)minute (grain)\", -3.044522437723423),\n                                    (\"integer (numeric)month (grain)\", -3.044522437723423),\n                                    (\"integer 2second (grain)\", -3.044522437723423),\n                                    (\"minute\", -2.639057329615259),\n                                    (\"integer 2year (grain)\", -3.044522437723423)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> after <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082intersect\",\n                                     -0.916290731874155)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayday\", -0.916290731874155),\n                                    (\"ordinals (first..19th)\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\\1050\\1072\\1090\\1086\\1083\\1080\\1094\\1100\\1082\\1077 \\1056\\1110\\1079\\1076\\1074\\1086\",\n                                     -0.916290731874155)],\n                               n = 1}}),\n       (\"\\1056\\1110\\1079\\1076\\1074\\1086 \\1061\\1088\\1080\\1089\\1090\\1086\\1074\\1077\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<day-of-month> (non ordinal) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -8.338160893905101e-2,\n                               unseen = -3.9889840465642745,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\\1051\\1080\\1087\\1077\\1085\\1100\",\n                                     -2.3608540011180215),\n                                    (\"integer (numeric)\\1050\\1074\\1110\\1090\\1077\\1085\\1100\",\n                                     -3.2771447329921766),\n                                    (\"integer (numeric)\\1041\\1077\\1088\\1077\\1079\\1077\\1085\\1100\",\n                                     -2.3608540011180215),\n                                    (\"integer (numeric)\\1051\\1102\\1090\\1080\\1081\",\n                                     -1.7730673362159024),\n                                    (\"integer (numeric)\\1057\\1077\\1088\\1087\\1077\\1085\\1100\",\n                                     -2.3608540011180215),\n                                    (\"month\", -0.7922380832041762),\n                                    (\"integer (numeric)\\1042\\1077\\1088\\1077\\1089\\1077\\1085\\1100\",\n                                     -2.871679624884012)],\n                               n = 23},\n                   koData =\n                     ClassData{prior = -2.5257286443082556,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\\1051\\1080\\1087\\1077\\1085\\1100\",\n                                     -1.2992829841302609),\n                                    (\"month\", -1.2992829841302609)],\n                               n = 2}}),\n       (\"this|next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1057\\1077\\1088\\1077\\1076\\1072\", -1.6094379124341003),\n                                    (\"day\", -0.916290731874155),\n                                    (\"\\1055\\1086\\1085\\1077\\1076\\1110\\1083\\1086\\1082\",\n                                     -1.6094379124341003),\n                                    (\"\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\",\n                                     -1.6094379124341003)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.540445040947149),\n                                    (\"day (grain)intersect\", -1.9459101490553135),\n                                    (\"day (grain)\\1046\\1086\\1074\\1090\\1077\\1085\\1100\",\n                                     -1.9459101490553135),\n                                    (\"weekmonth\", -1.540445040947149),\n                                    (\"week (grain)intersect\", -1.9459101490553135),\n                                    (\"week (grain)\\1042\\1077\\1088\\1077\\1089\\1077\\1085\\1100\",\n                                     -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1042\\1110\\1074\\1090\\1086\\1088\\1086\\1082\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"after <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day>  o'clock\", -1.55814461804655),\n                                    (\"time-of-day (latent)\", -1.55814461804655),\n                                    (\"hour\", -0.9985288301111273)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -1.0986122886681098, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"intersect\", -1.8718021769015913),\n                                    (\"day\", -1.1786549963416462),\n                                    (\"\\1056\\1110\\1079\\1076\\1074\\1086 \\1061\\1088\\1080\\1089\\1090\\1086\\1074\\1077\",\n                                     -1.8718021769015913),\n                                    (\"\\1050\\1072\\1090\\1086\\1083\\1080\\1094\\1100\\1082\\1077 \\1056\\1110\\1079\\1076\\1074\\1086\",\n                                     -1.8718021769015913)],\n                               n = 3}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.10536051565782628,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -2.3025850929940455,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"<month> dd-dd (interval)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1051\\1080\\1087\\1077\\1085\\1100\", -0.6931471805599453),\n                                    (\"month\", -0.6931471805599453)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1083\\1110\\1090\\1086\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1087\\1086\\1079\\1072\\1074\\1095\\1086\\1088\\1072\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\1050\\1072\\1090\\1086\\1083\\1080\\1094\\1100\\1082\\1077 \\1056\\1110\\1079\\1076\\1074\\1086\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\1074\\1077\\1089\\1085\\1072\", -1.9459101490553135),\n                                    (\"\\1079\\1080\\1084\\1072\", -1.9459101490553135),\n                                    (\"day\", -1.252762968495368), (\"hour\", -1.9459101490553135),\n                                    (\"week-end\", -1.9459101490553135),\n                                    (\"\\1083\\1110\\1090\\1086\", -1.9459101490553135)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"within <duration>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.6931471805599453),\n                                    (\"<integer> <unit-of-duration>\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1355}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.VI_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5028732955754956, unseen = -4.634728988229636,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 101},\n                   koData =\n                     ClassData{prior = -0.9283390703903296, unseen = -4.219507705176107,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 66}}),\n       (\"exactly <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day gi\\7901\", -1.6094379124341003),\n                                    (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889i\",\n                                     -1.6094379124341003),\n                                    (\"time-of-day (latent)\", -1.6094379124341003),\n                                    (\"hour\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ng\\224y h\\244m qua\",\n        Classifier{okData =\n                     ClassData{prior = -0.5596157879354228, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ng\\224y dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"<part-of-day> <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.3746934494414107,\n                               unseen = -3.5263605246161616,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -1.0116009116784799),\n                                    (\"noonh\\244m nay\", -2.803360380906535),\n                                    (\"lunchng\\224y mai\", -2.3978952727983707),\n                                    (\"noonng\\224y h\\244m qua\", -2.3978952727983707),\n                                    (\"morningSunday\", -2.3978952727983707),\n                                    (\"noonng\\224y mai\", -2.3978952727983707),\n                                    (\"afternoonng\\224y dd/mm\", -2.803360380906535),\n                                    (\"afternoonng\\224y mai\", -2.803360380906535)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.1631508098056809,\n                               unseen = -3.0910424533583156,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hourday\", -1.252762968495368),\n                                    (\"afternoon<day-of-month> (numeric with day symbol) <named-month>\",\n                                     -1.9459101490553135),\n                                    (\"afternoonng\\224y dd/mm/yyyy\", -2.3513752571634776),\n                                    (\"afternoonng\\224y dd/mm\", -2.3513752571634776),\n                                    (\"afternoonintersect\", -2.3513752571634776)],\n                               n = 5}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..19)\",\n        Classifier{okData =\n                     ClassData{prior = -1.452252328911688, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -0.2666286632539486,\n                               unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36}}),\n       (\"<day-of-week> t\\7899i\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.3862943611198906), (\"Friday\", -1.791759469228055),\n                                    (\"day\", -0.8754687373538999), (\"Tuesday\", -1.791759469228055)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.466337068793427, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.262364264467491, unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ng\\224y h\\244m kia\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"gi\\225ng sinh\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.791759469228055, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.1823215567939546,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -0.24512245803298496,\n                               unseen = -5.030437921392435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> s\\225ng|chi\\7873u|t\\7889ing\\224y dd/mm\",\n                                     -3.6375861597263857),\n                                    (\"hourday\", -3.6375861597263857),\n                                    (\"dayhour\", -4.330733340286331),\n                                    (\"h\\244m nay<time-of-day> s\\225ng|chi\\7873u|t\\7889i\",\n                                     -4.330733340286331),\n                                    (\"monthyear\", -3.414442608412176),\n                                    (\"Wednesdaynext <cycle>\", -4.330733340286331),\n                                    (\"Tuesday<day-of-month> (numeric with day symbol) <named-month>\",\n                                     -4.330733340286331),\n                                    (\"time-of-day gi\\7901<part-of-day> <time>\", -4.330733340286331),\n                                    (\"Sunday<day-of-month> (numeric with day symbol) <named-month>\",\n                                     -3.6375861597263857),\n                                    (\"time-of-day gi\\7901<time> n\\224y\", -4.330733340286331),\n                                    (\"month (numeric with month symbol)year (numeric with year symbol)\",\n                                     -3.6375861597263857),\n                                    (\"dayday\", -2.538973871058276),\n                                    (\"hourhour\", -3.414442608412176),\n                                    (\"intersectyear (numeric with year symbol)\",\n                                     -3.6375861597263857),\n                                    (\"dayyear\", -2.4589311633847397),\n                                    (\"<ordinal> <cycle> of <time>year (numeric with year symbol)\",\n                                     -4.330733340286331),\n                                    (\"minutehour\", -3.925268232178167),\n                                    (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889iintersect\",\n                                     -3.925268232178167),\n                                    (\"Thursdaynext <cycle>\", -3.925268232178167),\n                                    (\"Octoberyear (numeric with year symbol)\", -4.330733340286331),\n                                    (\"time-of-day gi\\7901<part-of-day> (h\\244m )?nay\",\n                                     -4.330733340286331),\n                                    (\"<day-of-month> (numeric with day symbol) <named-month>year (numeric with year symbol)\",\n                                     -3.2321210516182215),\n                                    (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889i<day-of-month> (numeric with day symbol) <named-month>\",\n                                     -3.414442608412176),\n                                    (\"time-of-day gi\\7901tonight\", -4.330733340286331),\n                                    (\"minuteday\", -2.826655943510057),\n                                    (\"hh:mm<part-of-day> <time>\", -4.330733340286331),\n                                    (\"<day-of-month> <named-month>year (numeric with year symbol)\",\n                                     -3.2321210516182215),\n                                    (\"Fridaythis <cycle>\", -3.925268232178167),\n                                    (\"Thursdaythis <cycle>\", -4.330733340286331),\n                                    (\"at hh:mm<part-of-day> <time>\", -4.330733340286331),\n                                    (\"dayweek\", -3.077970371790963),\n                                    (\"weekyear\", -4.330733340286331),\n                                    (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889ing\\224y dd/mm/yyyy\",\n                                     -4.330733340286331),\n                                    (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889ing\\224y mai\",\n                                     -4.330733340286331),\n                                    (\"Tuesdayintersect\", -4.330733340286331),\n                                    (\"Monday<day-of-month> (numeric with day symbol) <named-month>\",\n                                     -3.077970371790963),\n                                    (\"seasonthis <cycle>\", -4.330733340286331),\n                                    (\"minuteyear\", -3.925268232178167)],\n                               n = 54},\n                   koData =\n                     ClassData{prior = -1.5260563034950494, unseen = -4.31748811353631,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> s\\225ng|chi\\7873u|t\\7889ing\\224y dd/mm\",\n                                     -3.6109179126442243),\n                                    (\"hourday\", -2.3581549441488563),\n                                    (\"dayhour\", -3.6109179126442243),\n                                    (\"monthyear\", -2.3581549441488563),\n                                    (\"noonh\\244m nay\", -3.6109179126442243),\n                                    (\"houryear\", -3.6109179126442243),\n                                    (\"month (numeric with month symbol)year (numeric with year symbol)\",\n                                     -2.3581549441488563),\n                                    (\"dayyear\", -3.6109179126442243),\n                                    (\"h\\244m naytime-of-day gi\\7901\", -3.6109179126442243),\n                                    (\"<part-of-day> <time>year (numeric with year symbol)\",\n                                     -3.6109179126442243),\n                                    (\"noonng\\224y h\\244m qua\", -3.20545280453606),\n                                    (\"noonng\\224y mai\", -3.20545280453606),\n                                    (\"<day-of-month> <named-month>year (numeric with year symbol)\",\n                                     -3.6109179126442243)],\n                               n = 15}}),\n       (\"time-of-day gi\\7901\",\n        Classifier{okData =\n                     ClassData{prior = -6.453852113757118e-2,\n                               unseen = -4.174387269895637,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"exactly <time-of-day>\", -3.4657359027997265),\n                                    (\"about <time-of-day>\", -3.0602707946915624),\n                                    (\"time-of-day (latent)\", -0.8266785731844679),\n                                    (\"hour\", -0.7248958788745256)],\n                               n = 30},\n                   koData =\n                     ClassData{prior = -2.772588722239781, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.9808292530117262),\n                                    (\"hour\", -0.9808292530117262)],\n                               n = 2}}),\n       (\"<ordinal> <cycle> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -1.3862943611198906),\n                                    (\"day (grain)ordinalsmonth (numeric with month symbol)\",\n                                     -1.6739764335716716),\n                                    (\"week (grain)ordinalsintersect\", -2.0794415416798357),\n                                    (\"day (grain)ordinalsMarch\", -2.0794415416798357),\n                                    (\"weekmonth\", -1.6739764335716716),\n                                    (\"week (grain)ordinalsmonth (numeric with month symbol)\",\n                                     -2.0794415416798357)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"season\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5389965007326869, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 14},\n                   koData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10}}),\n       (\"quarter <number>\",\n        Classifier{okData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter (grain)integer (numeric)\", -1.2992829841302609),\n                                    (\"quarter (grain)integer (0..19)\", -1.2992829841302609),\n                                    (\"quarter\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarter (grain)integer (numeric)\", -0.8472978603872037),\n                                    (\"quarter\", -0.8472978603872037)],\n                               n = 2}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.9459101490553135),\n                                    (\"month (grain)\", -3.044522437723423),\n                                    (\"year (grain)\", -2.128231705849268),\n                                    (\"week (grain)\", -1.9459101490553135),\n                                    (\"quarter\", -2.3513752571634776), (\"year\", -2.128231705849268),\n                                    (\"month\", -3.044522437723423),\n                                    (\"quarter (grain)\", -2.3513752571634776)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (grain)\", -2.639057329615259),\n                                    (\"hour (grain)\", -2.639057329615259),\n                                    (\"year (grain)\", -2.639057329615259),\n                                    (\"second\", -2.3513752571634776), (\"day\", -2.639057329615259),\n                                    (\"minute (grain)\", -2.639057329615259),\n                                    (\"year\", -2.639057329615259),\n                                    (\"second (grain)\", -2.3513752571634776),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"minute\", -2.639057329615259),\n                                    (\"day (grain)\", -2.639057329615259)],\n                               n = 13}}),\n       (\"ng\\224y mai\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter <number> <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -1.0986122886681098),\n                                    (\"quarter (grain)integer (numeric)year (numeric with year symbol)\",\n                                     -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.0986122886681098),\n                                    (\"quarter (grain)integer (numeric)time-of-day (latent)\",\n                                     -1.0986122886681098)],\n                               n = 1}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -1.9459101490553135,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"after lunch\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm:ss\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> tr\\432\\7899c\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453), (\"Tuesday\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"ng\\224y dd/mm/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> n\\224y\",\n        Classifier{okData =\n                     ClassData{prior = -0.6061358035703156, unseen = -2.995732273553991,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"season\", -1.845826690498331),\n                                    (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889i\",\n                                     -2.2512917986064953),\n                                    (\"day\", -1.845826690498331), (\"noon\", -1.845826690498331),\n                                    (\"hour\", -1.3350010667323402),\n                                    (\"morning\", -2.2512917986064953)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.7884573603642702, unseen = -2.890371757896165,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.4469189829363254),\n                                    (\"noon\", -1.7346010553881064), (\"hour\", -1.041453874828161)],\n                               n = 5}}),\n       (\"b\\226y gi\\7901\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer>\",\n        Classifier{okData =\n                     ClassData{prior = -1.4469189829363254,\n                               unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.7884573603642702),\n                                    (\"time-of-day gi\\7901integer (numeric)\", -0.7884573603642702)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.2682639865946794,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)integer (0..19)\", -0.7282385003712154),\n                                    (\"hour\", -0.7282385003712154)],\n                               n = 13}}),\n       (\"<time> t\\7899i\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Monday\", -1.8971199848858813),\n                                    (\"month (numeric with month symbol)\", -2.3025850929940455),\n                                    (\"Friday\", -2.3025850929940455), (\"day\", -1.3862943611198906),\n                                    (\"month\", -2.3025850929940455),\n                                    (\"Tuesday\", -2.3025850929940455)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day gi\\7901\", -1.9459101490553135),\n                                    (\"<hour-of-day> <integer>\", -1.9459101490553135),\n                                    (\"hour\", -1.9459101490553135), (\"minute\", -1.9459101490553135)],\n                               n = 2}}),\n       (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889i\",\n        Classifier{okData =\n                     ClassData{prior = -5.129329438755058e-2,\n                               unseen = -4.465908118654584,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"exactly <time-of-day>\", -3.7612001156935624),\n                                    (\"time-of-day gi\\7901\", -1.318853080324358),\n                                    (\"<hour-of-day> <integer>\", -3.355735007585398),\n                                    (\"about <time-of-day>\", -3.355735007585398),\n                                    (\"at hh:mm\", -3.068052935133617),\n                                    (\"(hour-of-day) half\", -3.355735007585398),\n                                    (\"hh:mm\", -2.5084371471981943), (\"hour\", -1.1962507582320256),\n                                    (\"minute\", -1.8152899666382492)],\n                               n = 38},\n                   koData =\n                     ClassData{prior = -2.995732273553991, unseen = -2.70805020110221,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -1.540445040947149),\n                                    (\"hour\", -1.540445040947149)],\n                               n = 2}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (numeric with month symbol)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.21511137961694557),\n                                    (\"integer (0..19)\", -1.6422277352570913)],\n                               n = 29},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (numeric with year symbol)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter <number> of <year>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarteryear\", -1.0986122886681098),\n                                    (\"quarter (grain)integer (numeric)year (numeric with year symbol)\",\n                                     -1.0986122886681098)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"quarterhour\", -1.0986122886681098),\n                                    (\"quarter (grain)integer (numeric)time-of-day (latent)\",\n                                     -1.0986122886681098)],\n                               n = 1}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"June\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6376087894007967),\n                                    (\"year (grain)\", -2.1972245773362196),\n                                    (\"week (grain)\", -1.6376087894007967),\n                                    (\"day\", -2.890371757896165), (\"quarter\", -1.9740810260220096),\n                                    (\"year\", -2.1972245773362196),\n                                    (\"quarter (grain)\", -1.9740810260220096),\n                                    (\"day (grain)\", -2.890371757896165)],\n                               n = 14},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2876820724517809,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -1.3862943611198906,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"about <time-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day gi\\7901\", -1.6739764335716716),\n                                    (\"<time-of-day> s\\225ng|chi\\7873u|t\\7889i\",\n                                     -1.6739764335716716),\n                                    (\"time-of-day (latent)\", -1.6739764335716716),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"time-of-day (latent)\",\n        Classifier{okData =\n                     ClassData{prior = -0.579818495252942, unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.10536051565782628),\n                                    (\"integer (0..19)\", -2.3025850929940455)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -0.8209805520698302,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.3448404862917295),\n                                    (\"integer (0..19)\", -1.2321436812926323)],\n                               n = 22}}),\n       (\"at hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"(hour-of-day) half\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day gi\\7901\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.995732273553991,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -5.236441962829949,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -3.4393491476265314),\n                                    (\"integer (0..19)year (grain)\", -4.537961436294641),\n                                    (\"integer (numeric)day (grain)\", -3.0338840395183673),\n                                    (\"integer (0..19)hour (grain)\", -3.844814255734696),\n                                    (\"second\", -3.6216707044204863),\n                                    (\"integer (numeric)second (grain)\", -3.6216707044204863),\n                                    (\"integer (numeric)year (grain)\", -2.66615925939305),\n                                    (\"day\", -2.833213344056216), (\"year\", -2.592051287239328),\n                                    (\"integer (numeric)week (grain)\", -4.132496328186477),\n                                    (\"integer (0..19)month (grain)\", -4.537961436294641),\n                                    (\"hour\", -2.012232791986386), (\"month\", -2.012232791986386),\n                                    (\"integer (numeric)minute (grain)\", -3.6216707044204863),\n                                    (\"integer (numeric)month (grain)\", -2.053054786506641),\n                                    (\"minute\", -3.6216707044204863),\n                                    (\"integer (numeric)hour (grain)\", -2.1400661634962708),\n                                    (\"integer (0..19)day (grain)\", -4.132496328186477),\n                                    (\"integer (0..19)week (grain)\", -3.844814255734696)],\n                               n = 84}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"time-of-day (latent)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"h\\244m nay\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hh:mm\",\n        Classifier{okData =\n                     ClassData{prior = -8.701137698962981e-2,\n                               unseen = -2.5649493574615367,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 11},\n                   koData =\n                     ClassData{prior = -2.4849066497880004,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesdaynext <cycle>\", -1.6094379124341003),\n                                    (\"Fridaythis <cycle>\", -1.6094379124341003),\n                                    (\"Thursdaythis <cycle>\", -1.6094379124341003),\n                                    (\"dayweek\", -0.916290731874155)],\n                               n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<hour-of-day> <integer> ph\\250t\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"time-of-day gi\\7901integer (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"noon\",\n        Classifier{okData =\n                     ClassData{prior = -0.7621400520468967,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.6286086594223742,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"ordinals\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"(hour-of-day) quarter\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hour\", -0.6931471805599453),\n                                    (\"time-of-day gi\\7901integer (numeric)\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7731898882334817, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.5649493574615367),\n                                    (\"month (grain)\", -2.5649493574615367),\n                                    (\"year (grain)\", -1.6486586255873816),\n                                    (\"week (grain)\", -2.5649493574615367),\n                                    (\"year\", -1.6486586255873816), (\"month\", -2.5649493574615367)],\n                               n = 6},\n                   koData =\n                     ClassData{prior = -0.6190392084062235, unseen = -3.367295829986474,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"month (grain)\", -2.2335922215070942),\n                                    (\"hour (grain)\", -2.639057329615259),\n                                    (\"year (grain)\", -2.639057329615259),\n                                    (\"second\", -2.639057329615259), (\"day\", -2.639057329615259),\n                                    (\"minute (grain)\", -2.639057329615259),\n                                    (\"year\", -2.639057329615259),\n                                    (\"second (grain)\", -2.639057329615259),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.2335922215070942),\n                                    (\"minute\", -2.639057329615259),\n                                    (\"day (grain)\", -2.639057329615259)],\n                               n = 7}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.1431008436406733,\n                               unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)day (grain)\", -2.639057329615259),\n                                    (\"second\", -2.3513752571634776),\n                                    (\"integer (numeric)second (grain)\", -2.3513752571634776),\n                                    (\"integer (numeric)year (grain)\", -2.639057329615259),\n                                    (\"day\", -2.639057329615259), (\"year\", -2.639057329615259),\n                                    (\"integer (0..19)month (grain)\", -3.044522437723423),\n                                    (\"hour\", -2.639057329615259), (\"month\", -2.639057329615259),\n                                    (\"integer (numeric)minute (grain)\", -2.639057329615259),\n                                    (\"integer (numeric)month (grain)\", -3.044522437723423),\n                                    (\"minute\", -2.639057329615259),\n                                    (\"integer (numeric)hour (grain)\", -2.639057329615259)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -2.0149030205422647, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.8971199848858813),\n                                    (\"integer (numeric)week (grain)\", -2.3025850929940455),\n                                    (\"integer (0..19)week (grain)\", -2.3025850929940455)],\n                               n = 2}}),\n       (\"<day-of-month> <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.784189633918261,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)month (numeric with month symbol)\",\n                                     -0.8167611365271219),\n                                    (\"month\", -0.7166776779701395),\n                                    (\"integer (numeric)March\", -2.662587827025453)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)month (numeric with month symbol)\",\n                                     -0.8472978603872037),\n                                    (\"month\", -0.8472978603872037)],\n                               n = 2}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.4657359027997265,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)day (grain)\", -2.3353749158170367),\n                                    (\"integer (0..19)hour (grain)\", -2.740840023925201),\n                                    (\"second\", -2.740840023925201),\n                                    (\"integer (numeric)second (grain)\", -2.740840023925201),\n                                    (\"integer (numeric)year (grain)\", -2.740840023925201),\n                                    (\"day\", -2.3353749158170367), (\"year\", -2.740840023925201),\n                                    (\"hour\", -2.3353749158170367), (\"month\", -2.3353749158170367),\n                                    (\"integer (numeric)minute (grain)\", -2.740840023925201),\n                                    (\"integer (numeric)month (grain)\", -2.3353749158170367),\n                                    (\"minute\", -2.740840023925201),\n                                    (\"integer (numeric)hour (grain)\", -2.740840023925201)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"quarter (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6190392084062235,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -0.7731898882334817,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"<part-of-day> (h\\244m )?nay\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"noon\", -1.0116009116784799), (\"hour\", -0.7884573603642702),\n                                    (\"morning\", -1.7047480922384253)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<day-of-month> (numeric with day symbol) <named-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.828641396489095,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)month (numeric with month symbol)\",\n                                     -0.8109302162163288),\n                                    (\"month\", -0.7156200364120039),\n                                    (\"integer (numeric)March\", -2.70805020110221)],\n                               n = 21},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 951}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ZH_CN (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\25490\\28783\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of 5 minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8979415932059586),\n                                    (\"hour\", -0.7308875085427924),\n                                    (\"<integer> (latent time-of-day)<number>\\20010/\\20491\",\n                                     -2.1972245773362196)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8109302162163288),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\22235\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67}}),\n       (\"\\21355\\22622\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22269\\38469\\28040\\36153\\32773\\26435\\30410\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24314\\20891\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453), (\"Sunday\", -0.6931471805599453)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.963437510299857, unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -0.48058573857627246,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -1.466337068793427, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.262364264467491, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 30}}),\n       (\"national day\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"integer (20,30,40)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\19977\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\20250\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20803\\26086\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"\\32654\\22269\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -5.694137640013845e-2,\n                               unseen = -6.329720905522696,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -4.718498871295094),\n                                    (\"year (numeric with year symbol)\\20809\\26126\\33410\",\n                                     -4.248495242049359),\n                                    (\"xxxx year<named-month> <day-of-month>\", -4.941642422609305),\n                                    (\"daymonth\", -4.248495242049359),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"next yearSeptember\", -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\25995\\26376\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\20061\\22812\\33410\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)February\", -4.718498871295094),\n                                    (\"xxxx yearintersect\", -4.941642422609305),\n                                    (\"March<time> <day-of-month>\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)<named-month> <day-of-month>\",\n                                     -3.494723439672979),\n                                    (\"monthhour\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)\\22320\\29699\\19968\\23567\\26102\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)April\", -5.2293244950610855),\n                                    (\"dayday\", -2.284885515894645),\n                                    (\"hourhour\", -4.718498871295094),\n                                    (\"xxxx yearFebruary\", -5.634789603169249),\n                                    (\"year (numeric with year symbol)March\", -4.1307122063929755),\n                                    (\"February<dim time> <part-of-day>\", -3.7629874262676584),\n                                    (\"hourminute\", -4.718498871295094),\n                                    (\"April<time> <day-of-month>\", -5.2293244950610855),\n                                    (\"February<time> <day-of-month>\", -2.614364717024887),\n                                    (\"absorption of , after named day<named-month> <day-of-month>\",\n                                     -3.619886582626985),\n                                    (\"year (numeric with year symbol)\\22823\\25995\\26399\",\n                                     -4.941642422609305),\n                                    (\"this <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\22235\\26092\\33410\",\n                                     -5.2293244950610855),\n                                    (\"yearmonth\", -3.332204510175204),\n                                    (\"year (numeric with year symbol)\\20303\\26842\\33410\",\n                                     -5.2293244950610855),\n                                    (\"dayminute\", -4.718498871295094),\n                                    (\"next <cycle>September\", -5.634789603169249),\n                                    (\"intersect by \\\",\\\"<time> <day-of-month>\", -3.619886582626985),\n                                    (\"xxxx yearMarch\", -5.634789603169249),\n                                    (\"absorption of , after named dayintersect\",\n                                     -3.619886582626985),\n                                    (\"intersect<time> <day-of-month>\", -2.8015762591130335),\n                                    (\"next <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"tonight<time-of-day> o'clock\", -4.718498871295094),\n                                    (\"year (numeric with year symbol)intersect\",\n                                     -3.494723439672979),\n                                    (\"yearday\", -2.0794415416798357),\n                                    (\"absorption of , after named dayFebruary\", -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\19971\\19971\\33410\",\n                                     -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\36926\\36234\\33410\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\29369\\22826\\26032\\24180\",\n                                     -5.2293244950610855),\n                                    (\"yearminute\", -5.2293244950610855),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -4.718498871295094)],\n                               n = 256},\n                   koData =\n                     ClassData{prior = -2.894068619777491, unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -2.159484249353372),\n                                    (\"dayhour\", -2.7472709142554916),\n                                    (\"year (numeric with year symbol)Sunday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day><time-of-day> o'clock\",\n                                     -3.258096538021482),\n                                    (\"hourhour\", -3.258096538021482),\n                                    (\"hourminute\", -2.7472709142554916),\n                                    (\"dayminute\", -2.7472709142554916),\n                                    (\"yearday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.7472709142554916)],\n                               n = 15}}),\n       (\"half after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20399\\20029\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.625967214385311, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.21905356606268464,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.570544858467613, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"month (grain)\", -1.5198257537444133),\n                                    (\"year (grain)\", -2.367123614131617),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"year\", -2.367123614131617), (\"month\", -1.5198257537444133)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.832909122935104, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8602012652231115),\n                                    (\"week (grain)\", -0.8602012652231115)],\n                               n = 10}}),\n       (\"last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\27583\\34987\\27585\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Monday\", -1.8718021769015913), (\"day\", -0.7323678937132265),\n                                    (\"Tuesday\", -1.5533484457830569)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\35199\\36203\\25176\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20811\\21704\\29305\\26222\\36838\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21313\\32988\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20303\\26842\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\19977\\19968\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\30331\\38660\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\19971\\19971\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3564413979702095),\n                                    (\"integer (20,30,40)\", -3.0910424533583156),\n                                    (\"integer with consecutive unit modifiers\", -1.245215762859985),\n                                    (\"integer (0..10)\", -1.4170660197866443),\n                                    (\"number suffix: \\21313|\\25342\", -2.1102132003465894),\n                                    (\"compose by multiplication\", -3.0910424533583156)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)\", -0.3629054936893685),\n                                    (\"number suffix: \\21313|\\25342\", -2.03688192726104)],\n                               n = 17}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"hh:mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative (1-9) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> (latent time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2754119798599665,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.174751721484161),\n                                    (\"integer (0..10)\", -0.1466034741918754)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -1.4240346891027378, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4700036292457356),\n                                    (\"one point 2\", -1.1631508098056809)],\n                               n = 13}}),\n       (\"\\36926\\36234\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)Monday\", -0.6931471805599453),\n                                    (\"monthday\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22235\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\20809\\26126\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8434293836092833,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -0.5625269981428811,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"relative (10-59) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)compose by multiplication\",\n                                     -2.164963715117998),\n                                    (\"<integer> (latent time-of-day)integer with consecutive unit modifiers\",\n                                     -0.9753796482441617),\n                                    (\"hour\", -0.7435780341868373)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -1.0116009116784799,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)number suffix: \\21313|\\25342\",\n                                     -1.413693335308005),\n                                    (\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -1.413693335308005),\n                                    (\"hour\", -0.7777045685880083)],\n                               n = 16}}),\n       (\"year (numeric with year symbol)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22823\\25995\\26399\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24858\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26893\\26641\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\28789\\33410\\24198\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22522\\30563\\22307\\20307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\28595\\38376\\22238\\24402\\32426\\24565\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20804\\22969\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.3437347467010947),\n                                    (\"day\", -0.7375989431307791), (\"Tuesday\", -1.3437347467010947)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -4.8790164169432056e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -3.044522437723423, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\36174\\32618\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8909729238898653,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.1526795099383855),\n                                    (\"month (grain)\", -2.2512917986064953),\n                                    (\"year (grain)\", -2.538973871058276),\n                                    (\"week (grain)\", -1.1526795099383855),\n                                    (\"year\", -2.538973871058276), (\"month\", -2.2512917986064953)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -0.5280674302004967, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.7731898882334817),\n                                    (\"week (grain)\", -0.7731898882334817)],\n                               n = 23}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4462871026284195, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.0216512475319814,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"xxxx year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)integer (0..10)integer (0..10)\",\n                                     0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -4.6913478822291435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.750305594399894),\n                                    (\"national dayevening|night\", -3.58351893845611),\n                                    (\"<named-month> <day-of-month>morning\", -2.117181869662683),\n                                    (\"\\24773\\20154\\33410evening|night\", -3.58351893845611),\n                                    (\"\\20799\\31461\\33410afternoon\", -3.58351893845611),\n                                    (\"intersectmorning\", -2.117181869662683),\n                                    (\"<time> <day-of-month>morning\", -2.117181869662683),\n                                    (\"Mondaymorning\", -2.4849066497880004)],\n                               n = 50},\n                   koData =\n                     ClassData{prior = -2.6026896854443837, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1631508098056809),\n                                    (\"<time> <day-of-month>morning\", -1.1631508098056809)],\n                               n = 4}}),\n       (\"<part-of-day> <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7935659283069926,\n                               unseen = -5.0369526024136295,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tonight<integer> (latent time-of-day)\", -3.4210000089583352),\n                                    (\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -1.6631420914059614),\n                                    (\"hourhour\", -2.322387720290225),\n                                    (\"afternoon<time-of-day> o'clock\", -3.644143560272545),\n                                    (\"hourminute\", -0.9699949108460162),\n                                    (\"afternoon<integer> (latent time-of-day)\", -3.644143560272545),\n                                    (\"afternoonrelative (1-9) minutes after|past <integer> (hour-of-day)\",\n                                     -2.72785282839839),\n                                    (\"afternoonhh:mm (time-of-day)\", -3.644143560272545),\n                                    (\"tonight<time-of-day> o'clock\", -3.4210000089583352),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -2.4654885639308985),\n                                    (\"afternoonhalf after|past <integer> (hour-of-day)\",\n                                     -3.2386784521643803)],\n                               n = 71},\n                   koData =\n                     ClassData{prior = -0.6018985090948004, unseen = -5.214935757608986,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.3762728087852047),\n                                    (\"hourhour\", -0.9899784476653142),\n                                    (\"afternoon<time-of-day> o'clock\", -1.7754989483562746),\n                                    (\"hourminute\", -2.21375387928743),\n                                    (\"afternoon<integer> (latent time-of-day)\", -1.571899993115035),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -3.82319179172153)],\n                               n = 86}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -6.244166900663736,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342month (grain)\",\n                                     -4.632785353021065),\n                                    (\"week\", -3.0233474405869645),\n                                    (\"integer (0..10)month (grain)\", -2.745715703988685),\n                                    (\"integer (0..10)hour (grain)\", -3.1067290495260154),\n                                    (\"<number>\\20010/\\20491week (grain)\", -3.8443279926567944),\n                                    (\"compose by multiplicationminute (grain)\", -4.45046379622711),\n                                    (\"second\", -3.6031659358399066),\n                                    (\"integer (0..10)day (grain)\", -3.1067290495260154),\n                                    (\"integer (0..10)year (grain)\", -3.7573166156671647),\n                                    (\"<number>\\20010/\\20491month (grain)\", -3.469634543215384),\n                                    (\"integer (numeric)year (grain)\", -2.3710222545472743),\n                                    (\"integer (0..10)second (grain)\", -3.6031659358399066),\n                                    (\"day\", -3.1067290495260154), (\"year\", -2.1646858215494458),\n                                    (\"integer (0..10)minute (grain)\", -2.984126727433683),\n                                    (\"number suffix: \\21313|\\25342minute (grain)\",\n                                     -4.855928904335275),\n                                    (\"hour\", -3.1067290495260154),\n                                    (\"integer (0..10)week (grain)\", -3.534173064352955),\n                                    (\"month\", -2.008116760857906),\n                                    (\"integer (numeric)month (grain)\", -3.3518515075590005),\n                                    (\"integer with consecutive unit modifiersminute (grain)\",\n                                     -4.296313116399852),\n                                    (\"minute\", -2.553343811341229)],\n                               n = 246}}),\n       (\"\\32769\\26495\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31709\\28779\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.4353180712578455, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm (time-of-day)\", -0.9555114450274363),\n                                    (\"<integer> (latent time-of-day)\", -2.159484249353372),\n                                    (\"hour\", -2.159484249353372), (\"minute\", -0.9555114450274363)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.041453874828161, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.8266785731844679),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6}}),\n       (\"one point 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.9650808960435872),\n                                    (\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -1.9459101490553135),\n                                    (\"integer (0..10)integer with consecutive unit modifiers\",\n                                     -1.3397743454849977),\n                                    (\"integer (0..10)<number>\\20010/\\20491\", -2.639057329615259),\n                                    (\"integer (0..10)compose by multiplication\",\n                                     -2.639057329615259),\n                                    (\"integer (0..10)half\", -2.639057329615259)],\n                               n = 36}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2380465718564744),\n                                    (\"Sunday<named-month> <day-of-month>\", -1.6094379124341003),\n                                    (\"SundayFebruary\", -2.2380465718564744),\n                                    (\"dayday\", -0.9501922835498364),\n                                    (\"Sundayintersect\", -1.6094379124341003)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\38463\\33298\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer with consecutive unit modifiers\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"integer (0..10)integer (0..10)\", -0.6931471805599453)],\n                               n = 34},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.2876820724517809)],\n                               n = 2}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\25289\\25746\\36335\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\22307\\35806\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7308875085427924), (\"Sunday\", -1.2163953243244932),\n                                    (\"Tuesday\", -1.5040773967762742)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20234\\26031\\20848\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24320\\25995\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"\\22919\\22899\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20840\\29699\\38738\\24180\\26381\\21153\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27431\\21335\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20061\\22812\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7731898882334817), (\"Tuesday\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -0.7731898882334817),\n                                    (\"day\", -0.7731898882334817)],\n                               n = 5}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"year (grain)\", -2.4849066497880004),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"year\", -2.4849066497880004), (\"month\", -1.791759469228055)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8362480242006186),\n                                    (\"week (grain)\", -0.8362480242006186)],\n                               n = 12}}),\n       (\"\\20197\\33394\\21015\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.9856819377004897),\n                                    (\"second\", -2.803360380906535),\n                                    (\"integer (0..10)day (grain)\", -2.515678308454754),\n                                    (\"integer (0..10)year (grain)\", -3.2088254890146994),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.803360380906535),\n                                    (\"integer (0..10)second (grain)\", -2.803360380906535),\n                                    (\"day\", -2.515678308454754), (\"year\", -3.2088254890146994),\n                                    (\"integer (0..10)minute (grain)\", -2.649209701079277),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.803360380906535), (\"minute\", -2.649209701079277)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19975\\22307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21476\\23572\\37030\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of five minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (0..10)\", 0.0)],\n                               n = 2}}),\n       (\"\\20799\\31461\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = -3.922071315328127e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -3.258096538021482, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\26149\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer with consecutive unit modifiersminute (grain)\",\n                                     -1.0986122886681098),\n                                    (\"integer (0..10)compose by multiplicationminute (grain)\",\n                                     -1.6094379124341003),\n                                    (\"minute\", -0.7621400520468967)],\n                               n = 6}}),\n       (\"\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.762173934797756,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (0..10)\", -2.5563656137701454),\n                                    (\"Marchinteger (numeric)\", -3.144152278672264),\n                                    (\"Aprilinteger (numeric)\", -3.654977902438255),\n                                    (\"Februaryinteger (0..10)\", -2.6741486494265287),\n                                    (\"Februarynumber suffix: \\21313|\\25342\", -2.6741486494265287),\n                                    (\"month\", -0.7462570058738938),\n                                    (\"Februaryinteger (numeric)\", -2.5563656137701454),\n                                    (\"Februaryinteger with consecutive unit modifiers\",\n                                     -1.8091512119399242)],\n                               n = 54},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21171\\21160\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"number suffix: \\19975|\\33836\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"\\22823\\25995\\39318\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"two days after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5957987257888164, unseen = -5.407171771460119,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 221},\n                   koData =\n                     ClassData{prior = -0.8010045764163588, unseen = -5.204006687076795,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 180}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9856819377004897),\n                                    (\"integer (0..10)month (grain)\", -3.4965075614664802),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"second\", -2.649209701079277),\n                                    (\"integer (0..10)day (grain)\", -2.9856819377004897),\n                                    (\"integer (0..10)year (grain)\", -3.4965075614664802),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)second (grain)\", -2.649209701079277),\n                                    (\"day\", -2.9856819377004897), (\"year\", -3.4965075614664802),\n                                    (\"integer (0..10)minute (grain)\", -2.3978952727983707),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.1972245773362196),\n                                    (\"minute\", -2.3978952727983707)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2823823856765264), (\"second\", -2.505525936990736),\n                                    (\"day\", -2.793208009442517),\n                                    (\"<integer> <unit-of-duration>\", -0.8007778447523107),\n                                    (\"hour\", -2.2823823856765264), (\"month\", -2.2823823856765264),\n                                    (\"minute\", -2.2823823856765264)],\n                               n = 21}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList [(\"<number>\\20010/\\20491\", -0.1823215567939546)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -8.701137698962981e-2)],\n                               n = 10}}),\n       (\"n <cycle> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.908720896564361),\n                                    (\"second\", -2.908720896564361),\n                                    (\"integer (0..10)day (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)year (grain)\", -2.908720896564361),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.908720896564361),\n                                    (\"integer (0..10)second (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.908720896564361),\n                                    (\"integer (0..10)minute (grain)\", -2.908720896564361),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.908720896564361),\n                                    (\"month\", -2.908720896564361), (\"minute\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24527\\24724\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number suffix: \\21313|\\25342\",\n        Classifier{okData =\n                     ClassData{prior = -0.1590646946296874,\n                               unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -1.916922612182061, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"\\22320\\29699\\19968\\23567\\26102\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.38299225225610584,\n                               unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -1.1451323043030026,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"\\22307\\32426\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"<number>\\20010/\\20491\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -3.509131981127006e-2)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2\", -0.9808292530117262),\n                                    (\"integer (0..10)\", -0.4700036292457356)],\n                               n = 6}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -0.15415067982725836)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2number suffix: \\21313|\\25342\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"\\24773\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20116\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31070\\22307\\26143\\26399\\22235\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\25995\\26376\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27861\\20196\\20043\\22812\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9810014688665833),\n                                    (\"Monday\", -1.9810014688665833), (\"day\", -0.8415671856782186),\n                                    (\"hour\", -2.9618307218783095), (\"Tuesday\", -1.6625477377480489),\n                                    (\"week-end\", -2.9618307218783095)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1575}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ZH_HK (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\25490\\28783\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of 5 minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8979415932059586),\n                                    (\"hour\", -0.7308875085427924),\n                                    (\"<integer> (latent time-of-day)<number>\\20010/\\20491\",\n                                     -2.1972245773362196)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8109302162163288),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\22235\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67}}),\n       (\"\\21355\\22622\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22269\\38469\\28040\\36153\\32773\\26435\\30410\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24314\\20891\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453), (\"Sunday\", -0.6931471805599453)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.963437510299857, unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -0.48058573857627246,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -1.466337068793427, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.262364264467491, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 30}}),\n       (\"national day\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"integer (20,30,40)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\19977\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\20250\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20803\\26086\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"\\32654\\22269\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -5.694137640013845e-2,\n                               unseen = -6.329720905522696,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -4.718498871295094),\n                                    (\"year (numeric with year symbol)\\20809\\26126\\33410\",\n                                     -4.248495242049359),\n                                    (\"xxxx year<named-month> <day-of-month>\", -4.941642422609305),\n                                    (\"daymonth\", -4.248495242049359),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"next yearSeptember\", -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\25995\\26376\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\20061\\22812\\33410\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)February\", -4.718498871295094),\n                                    (\"xxxx yearintersect\", -4.941642422609305),\n                                    (\"March<time> <day-of-month>\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)<named-month> <day-of-month>\",\n                                     -3.494723439672979),\n                                    (\"monthhour\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)\\22320\\29699\\19968\\23567\\26102\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)April\", -5.2293244950610855),\n                                    (\"dayday\", -2.284885515894645),\n                                    (\"hourhour\", -4.718498871295094),\n                                    (\"xxxx yearFebruary\", -5.634789603169249),\n                                    (\"year (numeric with year symbol)March\", -4.1307122063929755),\n                                    (\"February<dim time> <part-of-day>\", -3.7629874262676584),\n                                    (\"hourminute\", -4.718498871295094),\n                                    (\"April<time> <day-of-month>\", -5.2293244950610855),\n                                    (\"February<time> <day-of-month>\", -2.614364717024887),\n                                    (\"absorption of , after named day<named-month> <day-of-month>\",\n                                     -3.619886582626985),\n                                    (\"year (numeric with year symbol)\\22823\\25995\\26399\",\n                                     -4.941642422609305),\n                                    (\"this <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\22235\\26092\\33410\",\n                                     -5.2293244950610855),\n                                    (\"yearmonth\", -3.332204510175204),\n                                    (\"year (numeric with year symbol)\\20303\\26842\\33410\",\n                                     -5.2293244950610855),\n                                    (\"dayminute\", -4.718498871295094),\n                                    (\"next <cycle>September\", -5.634789603169249),\n                                    (\"intersect by \\\",\\\"<time> <day-of-month>\", -3.619886582626985),\n                                    (\"xxxx yearMarch\", -5.634789603169249),\n                                    (\"absorption of , after named dayintersect\",\n                                     -3.619886582626985),\n                                    (\"intersect<time> <day-of-month>\", -2.8015762591130335),\n                                    (\"next <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"tonight<time-of-day> o'clock\", -4.718498871295094),\n                                    (\"year (numeric with year symbol)intersect\",\n                                     -3.494723439672979),\n                                    (\"yearday\", -2.0794415416798357),\n                                    (\"absorption of , after named dayFebruary\", -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\19971\\19971\\33410\",\n                                     -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\36926\\36234\\33410\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\29369\\22826\\26032\\24180\",\n                                     -5.2293244950610855),\n                                    (\"yearminute\", -5.2293244950610855),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -4.718498871295094)],\n                               n = 256},\n                   koData =\n                     ClassData{prior = -2.894068619777491, unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -2.159484249353372),\n                                    (\"dayhour\", -2.7472709142554916),\n                                    (\"year (numeric with year symbol)Sunday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day><time-of-day> o'clock\",\n                                     -3.258096538021482),\n                                    (\"hourhour\", -3.258096538021482),\n                                    (\"hourminute\", -2.7472709142554916),\n                                    (\"dayminute\", -2.7472709142554916),\n                                    (\"yearday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.7472709142554916)],\n                               n = 15}}),\n       (\"half after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20399\\20029\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.625967214385311, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.21905356606268464,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.570544858467613, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"month (grain)\", -1.5198257537444133),\n                                    (\"year (grain)\", -2.367123614131617),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"year\", -2.367123614131617), (\"month\", -1.5198257537444133)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.832909122935104, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8602012652231115),\n                                    (\"week (grain)\", -0.8602012652231115)],\n                               n = 10}}),\n       (\"last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\27583\\34987\\27585\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Monday\", -1.8718021769015913), (\"day\", -0.7323678937132265),\n                                    (\"Tuesday\", -1.5533484457830569)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\35199\\36203\\25176\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20811\\21704\\29305\\26222\\36838\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21313\\32988\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20303\\26842\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\19977\\19968\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\30331\\38660\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\19971\\19971\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3564413979702095),\n                                    (\"integer (20,30,40)\", -3.0910424533583156),\n                                    (\"integer with consecutive unit modifiers\", -1.245215762859985),\n                                    (\"integer (0..10)\", -1.4170660197866443),\n                                    (\"number suffix: \\21313|\\25342\", -2.1102132003465894),\n                                    (\"compose by multiplication\", -3.0910424533583156)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)\", -0.3629054936893685),\n                                    (\"number suffix: \\21313|\\25342\", -2.03688192726104)],\n                               n = 17}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"hh:mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative (1-9) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> (latent time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2754119798599665,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.174751721484161),\n                                    (\"integer (0..10)\", -0.1466034741918754)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -1.4240346891027378, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4700036292457356),\n                                    (\"one point 2\", -1.1631508098056809)],\n                               n = 13}}),\n       (\"\\36926\\36234\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)Monday\", -0.6931471805599453),\n                                    (\"monthday\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22235\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\20809\\26126\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8434293836092833,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -0.5625269981428811,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"relative (10-59) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)compose by multiplication\",\n                                     -2.164963715117998),\n                                    (\"<integer> (latent time-of-day)integer with consecutive unit modifiers\",\n                                     -0.9753796482441617),\n                                    (\"hour\", -0.7435780341868373)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -1.0116009116784799,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)number suffix: \\21313|\\25342\",\n                                     -1.413693335308005),\n                                    (\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -1.413693335308005),\n                                    (\"hour\", -0.7777045685880083)],\n                               n = 16}}),\n       (\"year (numeric with year symbol)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22823\\25995\\26399\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24858\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26893\\26641\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\28789\\33410\\24198\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22522\\30563\\22307\\20307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\28595\\38376\\22238\\24402\\32426\\24565\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20804\\22969\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.3437347467010947),\n                                    (\"day\", -0.7375989431307791), (\"Tuesday\", -1.3437347467010947)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -4.8790164169432056e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -3.044522437723423, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\36174\\32618\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8909729238898653,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.1526795099383855),\n                                    (\"month (grain)\", -2.2512917986064953),\n                                    (\"year (grain)\", -2.538973871058276),\n                                    (\"week (grain)\", -1.1526795099383855),\n                                    (\"year\", -2.538973871058276), (\"month\", -2.2512917986064953)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -0.5280674302004967, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.7731898882334817),\n                                    (\"week (grain)\", -0.7731898882334817)],\n                               n = 23}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4462871026284195, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.0216512475319814,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"xxxx year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)integer (0..10)integer (0..10)\",\n                                     0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -4.6913478822291435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.750305594399894),\n                                    (\"national dayevening|night\", -3.58351893845611),\n                                    (\"<named-month> <day-of-month>morning\", -2.117181869662683),\n                                    (\"\\24773\\20154\\33410evening|night\", -3.58351893845611),\n                                    (\"\\20799\\31461\\33410afternoon\", -3.58351893845611),\n                                    (\"intersectmorning\", -2.117181869662683),\n                                    (\"<time> <day-of-month>morning\", -2.117181869662683),\n                                    (\"Mondaymorning\", -2.4849066497880004)],\n                               n = 50},\n                   koData =\n                     ClassData{prior = -2.6026896854443837, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1631508098056809),\n                                    (\"<time> <day-of-month>morning\", -1.1631508098056809)],\n                               n = 4}}),\n       (\"<part-of-day> <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7935659283069926,\n                               unseen = -5.0369526024136295,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tonight<integer> (latent time-of-day)\", -3.4210000089583352),\n                                    (\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -1.6631420914059614),\n                                    (\"hourhour\", -2.322387720290225),\n                                    (\"afternoon<time-of-day> o'clock\", -3.644143560272545),\n                                    (\"hourminute\", -0.9699949108460162),\n                                    (\"afternoon<integer> (latent time-of-day)\", -3.644143560272545),\n                                    (\"afternoonrelative (1-9) minutes after|past <integer> (hour-of-day)\",\n                                     -2.72785282839839),\n                                    (\"afternoonhh:mm (time-of-day)\", -3.644143560272545),\n                                    (\"tonight<time-of-day> o'clock\", -3.4210000089583352),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -2.4654885639308985),\n                                    (\"afternoonhalf after|past <integer> (hour-of-day)\",\n                                     -3.2386784521643803)],\n                               n = 71},\n                   koData =\n                     ClassData{prior = -0.6018985090948004, unseen = -5.214935757608986,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.3762728087852047),\n                                    (\"hourhour\", -0.9899784476653142),\n                                    (\"afternoon<time-of-day> o'clock\", -1.7754989483562746),\n                                    (\"hourminute\", -2.21375387928743),\n                                    (\"afternoon<integer> (latent time-of-day)\", -1.571899993115035),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -3.82319179172153)],\n                               n = 86}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -6.244166900663736,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342month (grain)\",\n                                     -4.632785353021065),\n                                    (\"week\", -3.0233474405869645),\n                                    (\"integer (0..10)month (grain)\", -2.745715703988685),\n                                    (\"integer (0..10)hour (grain)\", -3.1067290495260154),\n                                    (\"<number>\\20010/\\20491week (grain)\", -3.8443279926567944),\n                                    (\"compose by multiplicationminute (grain)\", -4.45046379622711),\n                                    (\"second\", -3.6031659358399066),\n                                    (\"integer (0..10)day (grain)\", -3.1067290495260154),\n                                    (\"integer (0..10)year (grain)\", -3.7573166156671647),\n                                    (\"<number>\\20010/\\20491month (grain)\", -3.469634543215384),\n                                    (\"integer (numeric)year (grain)\", -2.3710222545472743),\n                                    (\"integer (0..10)second (grain)\", -3.6031659358399066),\n                                    (\"day\", -3.1067290495260154), (\"year\", -2.1646858215494458),\n                                    (\"integer (0..10)minute (grain)\", -2.984126727433683),\n                                    (\"number suffix: \\21313|\\25342minute (grain)\",\n                                     -4.855928904335275),\n                                    (\"hour\", -3.1067290495260154),\n                                    (\"integer (0..10)week (grain)\", -3.534173064352955),\n                                    (\"month\", -2.008116760857906),\n                                    (\"integer (numeric)month (grain)\", -3.3518515075590005),\n                                    (\"integer with consecutive unit modifiersminute (grain)\",\n                                     -4.296313116399852),\n                                    (\"minute\", -2.553343811341229)],\n                               n = 246}}),\n       (\"\\32769\\26495\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31709\\28779\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.4353180712578455, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm (time-of-day)\", -0.9555114450274363),\n                                    (\"<integer> (latent time-of-day)\", -2.159484249353372),\n                                    (\"hour\", -2.159484249353372), (\"minute\", -0.9555114450274363)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.041453874828161, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.8266785731844679),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6}}),\n       (\"one point 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.9650808960435872),\n                                    (\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -1.9459101490553135),\n                                    (\"integer (0..10)integer with consecutive unit modifiers\",\n                                     -1.3397743454849977),\n                                    (\"integer (0..10)<number>\\20010/\\20491\", -2.639057329615259),\n                                    (\"integer (0..10)compose by multiplication\",\n                                     -2.639057329615259),\n                                    (\"integer (0..10)half\", -2.639057329615259)],\n                               n = 36}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2380465718564744),\n                                    (\"Sunday<named-month> <day-of-month>\", -1.6094379124341003),\n                                    (\"SundayFebruary\", -2.2380465718564744),\n                                    (\"dayday\", -0.9501922835498364),\n                                    (\"Sundayintersect\", -1.6094379124341003)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\38463\\33298\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer with consecutive unit modifiers\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"integer (0..10)integer (0..10)\", -0.6931471805599453)],\n                               n = 34},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.2876820724517809)],\n                               n = 2}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\25289\\25746\\36335\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\22307\\35806\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7308875085427924), (\"Sunday\", -1.2163953243244932),\n                                    (\"Tuesday\", -1.5040773967762742)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20234\\26031\\20848\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24320\\25995\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"\\22919\\22899\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20840\\29699\\38738\\24180\\26381\\21153\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27431\\21335\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20061\\22812\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7731898882334817), (\"Tuesday\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -0.7731898882334817),\n                                    (\"day\", -0.7731898882334817)],\n                               n = 5}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"year (grain)\", -2.4849066497880004),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"year\", -2.4849066497880004), (\"month\", -1.791759469228055)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8362480242006186),\n                                    (\"week (grain)\", -0.8362480242006186)],\n                               n = 12}}),\n       (\"\\20197\\33394\\21015\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.9856819377004897),\n                                    (\"second\", -2.803360380906535),\n                                    (\"integer (0..10)day (grain)\", -2.515678308454754),\n                                    (\"integer (0..10)year (grain)\", -3.2088254890146994),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.803360380906535),\n                                    (\"integer (0..10)second (grain)\", -2.803360380906535),\n                                    (\"day\", -2.515678308454754), (\"year\", -3.2088254890146994),\n                                    (\"integer (0..10)minute (grain)\", -2.649209701079277),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.803360380906535), (\"minute\", -2.649209701079277)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19975\\22307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21476\\23572\\37030\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of five minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (0..10)\", 0.0)],\n                               n = 2}}),\n       (\"\\20799\\31461\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = -3.922071315328127e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -3.258096538021482, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\26149\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer with consecutive unit modifiersminute (grain)\",\n                                     -1.0986122886681098),\n                                    (\"integer (0..10)compose by multiplicationminute (grain)\",\n                                     -1.6094379124341003),\n                                    (\"minute\", -0.7621400520468967)],\n                               n = 6}}),\n       (\"\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.762173934797756,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (0..10)\", -2.5563656137701454),\n                                    (\"Marchinteger (numeric)\", -3.144152278672264),\n                                    (\"Aprilinteger (numeric)\", -3.654977902438255),\n                                    (\"Februaryinteger (0..10)\", -2.6741486494265287),\n                                    (\"Februarynumber suffix: \\21313|\\25342\", -2.6741486494265287),\n                                    (\"month\", -0.7462570058738938),\n                                    (\"Februaryinteger (numeric)\", -2.5563656137701454),\n                                    (\"Februaryinteger with consecutive unit modifiers\",\n                                     -1.8091512119399242)],\n                               n = 54},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21171\\21160\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"number suffix: \\19975|\\33836\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"\\22823\\25995\\39318\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"two days after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5957987257888164, unseen = -5.407171771460119,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 221},\n                   koData =\n                     ClassData{prior = -0.8010045764163588, unseen = -5.204006687076795,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 180}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9856819377004897),\n                                    (\"integer (0..10)month (grain)\", -3.4965075614664802),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"second\", -2.649209701079277),\n                                    (\"integer (0..10)day (grain)\", -2.9856819377004897),\n                                    (\"integer (0..10)year (grain)\", -3.4965075614664802),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)second (grain)\", -2.649209701079277),\n                                    (\"day\", -2.9856819377004897), (\"year\", -3.4965075614664802),\n                                    (\"integer (0..10)minute (grain)\", -2.3978952727983707),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.1972245773362196),\n                                    (\"minute\", -2.3978952727983707)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2823823856765264), (\"second\", -2.505525936990736),\n                                    (\"day\", -2.793208009442517),\n                                    (\"<integer> <unit-of-duration>\", -0.8007778447523107),\n                                    (\"hour\", -2.2823823856765264), (\"month\", -2.2823823856765264),\n                                    (\"minute\", -2.2823823856765264)],\n                               n = 21}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList [(\"<number>\\20010/\\20491\", -0.1823215567939546)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -8.701137698962981e-2)],\n                               n = 10}}),\n       (\"n <cycle> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.908720896564361),\n                                    (\"second\", -2.908720896564361),\n                                    (\"integer (0..10)day (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)year (grain)\", -2.908720896564361),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.908720896564361),\n                                    (\"integer (0..10)second (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.908720896564361),\n                                    (\"integer (0..10)minute (grain)\", -2.908720896564361),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.908720896564361),\n                                    (\"month\", -2.908720896564361), (\"minute\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24527\\24724\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number suffix: \\21313|\\25342\",\n        Classifier{okData =\n                     ClassData{prior = -0.1590646946296874,\n                               unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -1.916922612182061, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"\\22320\\29699\\19968\\23567\\26102\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.38299225225610584,\n                               unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -1.1451323043030026,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"\\22307\\32426\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"<number>\\20010/\\20491\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -3.509131981127006e-2)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2\", -0.9808292530117262),\n                                    (\"integer (0..10)\", -0.4700036292457356)],\n                               n = 6}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -0.15415067982725836)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2number suffix: \\21313|\\25342\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"\\24773\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20116\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31070\\22307\\26143\\26399\\22235\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\25995\\26376\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27861\\20196\\20043\\22812\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9810014688665833),\n                                    (\"Monday\", -1.9810014688665833), (\"day\", -0.8415671856782186),\n                                    (\"hour\", -2.9618307218783095), (\"Tuesday\", -1.6625477377480489),\n                                    (\"week-end\", -2.9618307218783095)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1575}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ZH_MO (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\25490\\28783\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of 5 minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8979415932059586),\n                                    (\"hour\", -0.7308875085427924),\n                                    (\"<integer> (latent time-of-day)<number>\\20010/\\20491\",\n                                     -2.1972245773362196)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8109302162163288),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\22235\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67}}),\n       (\"\\21355\\22622\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22269\\38469\\28040\\36153\\32773\\26435\\30410\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24314\\20891\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453), (\"Sunday\", -0.6931471805599453)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.963437510299857, unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -0.48058573857627246,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -1.466337068793427, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.262364264467491, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 30}}),\n       (\"national day\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"integer (20,30,40)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\19977\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\20250\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20803\\26086\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"\\32654\\22269\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -5.694137640013845e-2,\n                               unseen = -6.329720905522696,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -4.718498871295094),\n                                    (\"year (numeric with year symbol)\\20809\\26126\\33410\",\n                                     -4.248495242049359),\n                                    (\"xxxx year<named-month> <day-of-month>\", -4.941642422609305),\n                                    (\"daymonth\", -4.248495242049359),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"next yearSeptember\", -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\25995\\26376\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\20061\\22812\\33410\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)February\", -4.718498871295094),\n                                    (\"xxxx yearintersect\", -4.941642422609305),\n                                    (\"March<time> <day-of-month>\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)<named-month> <day-of-month>\",\n                                     -3.494723439672979),\n                                    (\"monthhour\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)\\22320\\29699\\19968\\23567\\26102\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)April\", -5.2293244950610855),\n                                    (\"dayday\", -2.284885515894645),\n                                    (\"hourhour\", -4.718498871295094),\n                                    (\"xxxx yearFebruary\", -5.634789603169249),\n                                    (\"year (numeric with year symbol)March\", -4.1307122063929755),\n                                    (\"February<dim time> <part-of-day>\", -3.7629874262676584),\n                                    (\"hourminute\", -4.718498871295094),\n                                    (\"April<time> <day-of-month>\", -5.2293244950610855),\n                                    (\"February<time> <day-of-month>\", -2.614364717024887),\n                                    (\"absorption of , after named day<named-month> <day-of-month>\",\n                                     -3.619886582626985),\n                                    (\"year (numeric with year symbol)\\22823\\25995\\26399\",\n                                     -4.941642422609305),\n                                    (\"this <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\22235\\26092\\33410\",\n                                     -5.2293244950610855),\n                                    (\"yearmonth\", -3.332204510175204),\n                                    (\"year (numeric with year symbol)\\20303\\26842\\33410\",\n                                     -5.2293244950610855),\n                                    (\"dayminute\", -4.718498871295094),\n                                    (\"next <cycle>September\", -5.634789603169249),\n                                    (\"intersect by \\\",\\\"<time> <day-of-month>\", -3.619886582626985),\n                                    (\"xxxx yearMarch\", -5.634789603169249),\n                                    (\"absorption of , after named dayintersect\",\n                                     -3.619886582626985),\n                                    (\"intersect<time> <day-of-month>\", -2.8015762591130335),\n                                    (\"next <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"tonight<time-of-day> o'clock\", -4.718498871295094),\n                                    (\"year (numeric with year symbol)intersect\",\n                                     -3.494723439672979),\n                                    (\"yearday\", -2.0794415416798357),\n                                    (\"absorption of , after named dayFebruary\", -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\19971\\19971\\33410\",\n                                     -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\36926\\36234\\33410\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\29369\\22826\\26032\\24180\",\n                                     -5.2293244950610855),\n                                    (\"yearminute\", -5.2293244950610855),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -4.718498871295094)],\n                               n = 256},\n                   koData =\n                     ClassData{prior = -2.894068619777491, unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -2.159484249353372),\n                                    (\"dayhour\", -2.7472709142554916),\n                                    (\"year (numeric with year symbol)Sunday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day><time-of-day> o'clock\",\n                                     -3.258096538021482),\n                                    (\"hourhour\", -3.258096538021482),\n                                    (\"hourminute\", -2.7472709142554916),\n                                    (\"dayminute\", -2.7472709142554916),\n                                    (\"yearday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.7472709142554916)],\n                               n = 15}}),\n       (\"half after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20399\\20029\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.625967214385311, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.21905356606268464,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.570544858467613, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"month (grain)\", -1.5198257537444133),\n                                    (\"year (grain)\", -2.367123614131617),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"year\", -2.367123614131617), (\"month\", -1.5198257537444133)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.832909122935104, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8602012652231115),\n                                    (\"week (grain)\", -0.8602012652231115)],\n                               n = 10}}),\n       (\"last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\27583\\34987\\27585\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Monday\", -1.8718021769015913), (\"day\", -0.7323678937132265),\n                                    (\"Tuesday\", -1.5533484457830569)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\35199\\36203\\25176\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20811\\21704\\29305\\26222\\36838\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21313\\32988\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20303\\26842\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\19977\\19968\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\30331\\38660\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\19971\\19971\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3564413979702095),\n                                    (\"integer (20,30,40)\", -3.0910424533583156),\n                                    (\"integer with consecutive unit modifiers\", -1.245215762859985),\n                                    (\"integer (0..10)\", -1.4170660197866443),\n                                    (\"number suffix: \\21313|\\25342\", -2.1102132003465894),\n                                    (\"compose by multiplication\", -3.0910424533583156)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)\", -0.3629054936893685),\n                                    (\"number suffix: \\21313|\\25342\", -2.03688192726104)],\n                               n = 17}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"hh:mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative (1-9) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> (latent time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2754119798599665,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.174751721484161),\n                                    (\"integer (0..10)\", -0.1466034741918754)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -1.4240346891027378, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4700036292457356),\n                                    (\"one point 2\", -1.1631508098056809)],\n                               n = 13}}),\n       (\"\\36926\\36234\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)Monday\", -0.6931471805599453),\n                                    (\"monthday\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22235\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\20809\\26126\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8434293836092833,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -0.5625269981428811,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"relative (10-59) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)compose by multiplication\",\n                                     -2.164963715117998),\n                                    (\"<integer> (latent time-of-day)integer with consecutive unit modifiers\",\n                                     -0.9753796482441617),\n                                    (\"hour\", -0.7435780341868373)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -1.0116009116784799,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)number suffix: \\21313|\\25342\",\n                                     -1.413693335308005),\n                                    (\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -1.413693335308005),\n                                    (\"hour\", -0.7777045685880083)],\n                               n = 16}}),\n       (\"year (numeric with year symbol)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22823\\25995\\26399\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24858\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26893\\26641\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\28789\\33410\\24198\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22522\\30563\\22307\\20307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\28595\\38376\\22238\\24402\\32426\\24565\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20804\\22969\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.3437347467010947),\n                                    (\"day\", -0.7375989431307791), (\"Tuesday\", -1.3437347467010947)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -4.8790164169432056e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -3.044522437723423, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\36174\\32618\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8909729238898653,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.1526795099383855),\n                                    (\"month (grain)\", -2.2512917986064953),\n                                    (\"year (grain)\", -2.538973871058276),\n                                    (\"week (grain)\", -1.1526795099383855),\n                                    (\"year\", -2.538973871058276), (\"month\", -2.2512917986064953)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -0.5280674302004967, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.7731898882334817),\n                                    (\"week (grain)\", -0.7731898882334817)],\n                               n = 23}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4462871026284195, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.0216512475319814,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"xxxx year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)integer (0..10)integer (0..10)\",\n                                     0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -4.6913478822291435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.750305594399894),\n                                    (\"national dayevening|night\", -3.58351893845611),\n                                    (\"<named-month> <day-of-month>morning\", -2.117181869662683),\n                                    (\"\\24773\\20154\\33410evening|night\", -3.58351893845611),\n                                    (\"\\20799\\31461\\33410afternoon\", -3.58351893845611),\n                                    (\"intersectmorning\", -2.117181869662683),\n                                    (\"<time> <day-of-month>morning\", -2.117181869662683),\n                                    (\"Mondaymorning\", -2.4849066497880004)],\n                               n = 50},\n                   koData =\n                     ClassData{prior = -2.6026896854443837, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1631508098056809),\n                                    (\"<time> <day-of-month>morning\", -1.1631508098056809)],\n                               n = 4}}),\n       (\"<part-of-day> <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7935659283069926,\n                               unseen = -5.0369526024136295,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tonight<integer> (latent time-of-day)\", -3.4210000089583352),\n                                    (\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -1.6631420914059614),\n                                    (\"hourhour\", -2.322387720290225),\n                                    (\"afternoon<time-of-day> o'clock\", -3.644143560272545),\n                                    (\"hourminute\", -0.9699949108460162),\n                                    (\"afternoon<integer> (latent time-of-day)\", -3.644143560272545),\n                                    (\"afternoonrelative (1-9) minutes after|past <integer> (hour-of-day)\",\n                                     -2.72785282839839),\n                                    (\"afternoonhh:mm (time-of-day)\", -3.644143560272545),\n                                    (\"tonight<time-of-day> o'clock\", -3.4210000089583352),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -2.4654885639308985),\n                                    (\"afternoonhalf after|past <integer> (hour-of-day)\",\n                                     -3.2386784521643803)],\n                               n = 71},\n                   koData =\n                     ClassData{prior = -0.6018985090948004, unseen = -5.214935757608986,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.3762728087852047),\n                                    (\"hourhour\", -0.9899784476653142),\n                                    (\"afternoon<time-of-day> o'clock\", -1.7754989483562746),\n                                    (\"hourminute\", -2.21375387928743),\n                                    (\"afternoon<integer> (latent time-of-day)\", -1.571899993115035),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -3.82319179172153)],\n                               n = 86}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -6.244166900663736,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342month (grain)\",\n                                     -4.632785353021065),\n                                    (\"week\", -3.0233474405869645),\n                                    (\"integer (0..10)month (grain)\", -2.745715703988685),\n                                    (\"integer (0..10)hour (grain)\", -3.1067290495260154),\n                                    (\"<number>\\20010/\\20491week (grain)\", -3.8443279926567944),\n                                    (\"compose by multiplicationminute (grain)\", -4.45046379622711),\n                                    (\"second\", -3.6031659358399066),\n                                    (\"integer (0..10)day (grain)\", -3.1067290495260154),\n                                    (\"integer (0..10)year (grain)\", -3.7573166156671647),\n                                    (\"<number>\\20010/\\20491month (grain)\", -3.469634543215384),\n                                    (\"integer (numeric)year (grain)\", -2.3710222545472743),\n                                    (\"integer (0..10)second (grain)\", -3.6031659358399066),\n                                    (\"day\", -3.1067290495260154), (\"year\", -2.1646858215494458),\n                                    (\"integer (0..10)minute (grain)\", -2.984126727433683),\n                                    (\"number suffix: \\21313|\\25342minute (grain)\",\n                                     -4.855928904335275),\n                                    (\"hour\", -3.1067290495260154),\n                                    (\"integer (0..10)week (grain)\", -3.534173064352955),\n                                    (\"month\", -2.008116760857906),\n                                    (\"integer (numeric)month (grain)\", -3.3518515075590005),\n                                    (\"integer with consecutive unit modifiersminute (grain)\",\n                                     -4.296313116399852),\n                                    (\"minute\", -2.553343811341229)],\n                               n = 246}}),\n       (\"\\32769\\26495\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31709\\28779\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.4353180712578455, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm (time-of-day)\", -0.9555114450274363),\n                                    (\"<integer> (latent time-of-day)\", -2.159484249353372),\n                                    (\"hour\", -2.159484249353372), (\"minute\", -0.9555114450274363)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.041453874828161, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.8266785731844679),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6}}),\n       (\"one point 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.9650808960435872),\n                                    (\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -1.9459101490553135),\n                                    (\"integer (0..10)integer with consecutive unit modifiers\",\n                                     -1.3397743454849977),\n                                    (\"integer (0..10)<number>\\20010/\\20491\", -2.639057329615259),\n                                    (\"integer (0..10)compose by multiplication\",\n                                     -2.639057329615259),\n                                    (\"integer (0..10)half\", -2.639057329615259)],\n                               n = 36}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2380465718564744),\n                                    (\"Sunday<named-month> <day-of-month>\", -1.6094379124341003),\n                                    (\"SundayFebruary\", -2.2380465718564744),\n                                    (\"dayday\", -0.9501922835498364),\n                                    (\"Sundayintersect\", -1.6094379124341003)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\38463\\33298\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer with consecutive unit modifiers\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"integer (0..10)integer (0..10)\", -0.6931471805599453)],\n                               n = 34},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.2876820724517809)],\n                               n = 2}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\25289\\25746\\36335\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\22307\\35806\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7308875085427924), (\"Sunday\", -1.2163953243244932),\n                                    (\"Tuesday\", -1.5040773967762742)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20234\\26031\\20848\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24320\\25995\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"\\22919\\22899\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20840\\29699\\38738\\24180\\26381\\21153\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27431\\21335\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20061\\22812\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7731898882334817), (\"Tuesday\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -0.7731898882334817),\n                                    (\"day\", -0.7731898882334817)],\n                               n = 5}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"year (grain)\", -2.4849066497880004),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"year\", -2.4849066497880004), (\"month\", -1.791759469228055)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8362480242006186),\n                                    (\"week (grain)\", -0.8362480242006186)],\n                               n = 12}}),\n       (\"\\20197\\33394\\21015\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.9856819377004897),\n                                    (\"second\", -2.803360380906535),\n                                    (\"integer (0..10)day (grain)\", -2.515678308454754),\n                                    (\"integer (0..10)year (grain)\", -3.2088254890146994),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.803360380906535),\n                                    (\"integer (0..10)second (grain)\", -2.803360380906535),\n                                    (\"day\", -2.515678308454754), (\"year\", -3.2088254890146994),\n                                    (\"integer (0..10)minute (grain)\", -2.649209701079277),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.803360380906535), (\"minute\", -2.649209701079277)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19975\\22307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21476\\23572\\37030\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of five minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (0..10)\", 0.0)],\n                               n = 2}}),\n       (\"\\20799\\31461\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = -3.922071315328127e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -3.258096538021482, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\26149\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer with consecutive unit modifiersminute (grain)\",\n                                     -1.0986122886681098),\n                                    (\"integer (0..10)compose by multiplicationminute (grain)\",\n                                     -1.6094379124341003),\n                                    (\"minute\", -0.7621400520468967)],\n                               n = 6}}),\n       (\"\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.762173934797756,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (0..10)\", -2.5563656137701454),\n                                    (\"Marchinteger (numeric)\", -3.144152278672264),\n                                    (\"Aprilinteger (numeric)\", -3.654977902438255),\n                                    (\"Februaryinteger (0..10)\", -2.6741486494265287),\n                                    (\"Februarynumber suffix: \\21313|\\25342\", -2.6741486494265287),\n                                    (\"month\", -0.7462570058738938),\n                                    (\"Februaryinteger (numeric)\", -2.5563656137701454),\n                                    (\"Februaryinteger with consecutive unit modifiers\",\n                                     -1.8091512119399242)],\n                               n = 54},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21171\\21160\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"number suffix: \\19975|\\33836\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"\\22823\\25995\\39318\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"two days after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5957987257888164, unseen = -5.407171771460119,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 221},\n                   koData =\n                     ClassData{prior = -0.8010045764163588, unseen = -5.204006687076795,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 180}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9856819377004897),\n                                    (\"integer (0..10)month (grain)\", -3.4965075614664802),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"second\", -2.649209701079277),\n                                    (\"integer (0..10)day (grain)\", -2.9856819377004897),\n                                    (\"integer (0..10)year (grain)\", -3.4965075614664802),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)second (grain)\", -2.649209701079277),\n                                    (\"day\", -2.9856819377004897), (\"year\", -3.4965075614664802),\n                                    (\"integer (0..10)minute (grain)\", -2.3978952727983707),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.1972245773362196),\n                                    (\"minute\", -2.3978952727983707)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2823823856765264), (\"second\", -2.505525936990736),\n                                    (\"day\", -2.793208009442517),\n                                    (\"<integer> <unit-of-duration>\", -0.8007778447523107),\n                                    (\"hour\", -2.2823823856765264), (\"month\", -2.2823823856765264),\n                                    (\"minute\", -2.2823823856765264)],\n                               n = 21}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList [(\"<number>\\20010/\\20491\", -0.1823215567939546)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -8.701137698962981e-2)],\n                               n = 10}}),\n       (\"n <cycle> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.908720896564361),\n                                    (\"second\", -2.908720896564361),\n                                    (\"integer (0..10)day (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)year (grain)\", -2.908720896564361),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.908720896564361),\n                                    (\"integer (0..10)second (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.908720896564361),\n                                    (\"integer (0..10)minute (grain)\", -2.908720896564361),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.908720896564361),\n                                    (\"month\", -2.908720896564361), (\"minute\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24527\\24724\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number suffix: \\21313|\\25342\",\n        Classifier{okData =\n                     ClassData{prior = -0.1590646946296874,\n                               unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -1.916922612182061, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"\\22320\\29699\\19968\\23567\\26102\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.38299225225610584,\n                               unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -1.1451323043030026,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"\\22307\\32426\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"<number>\\20010/\\20491\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -3.509131981127006e-2)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2\", -0.9808292530117262),\n                                    (\"integer (0..10)\", -0.4700036292457356)],\n                               n = 6}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -0.15415067982725836)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2number suffix: \\21313|\\25342\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"\\24773\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20116\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31070\\22307\\26143\\26399\\22235\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\25995\\26376\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27861\\20196\\20043\\22812\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9810014688665833),\n                                    (\"Monday\", -1.9810014688665833), (\"day\", -0.8415671856782186),\n                                    (\"hour\", -2.9618307218783095), (\"Tuesday\", -1.6625477377480489),\n                                    (\"week-end\", -2.9618307218783095)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1575}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ZH_TW (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\25490\\28783\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of 5 minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8979415932059586),\n                                    (\"hour\", -0.7308875085427924),\n                                    (\"<integer> (latent time-of-day)<number>\\20010/\\20491\",\n                                     -2.1972245773362196)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8109302162163288),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\22235\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67}}),\n       (\"\\21355\\22622\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22269\\38469\\28040\\36153\\32773\\26435\\30410\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24314\\20891\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453), (\"Sunday\", -0.6931471805599453)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.963437510299857, unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -0.48058573857627246,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -1.466337068793427, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.262364264467491, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 30}}),\n       (\"national day\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"integer (20,30,40)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\19977\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\20250\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20803\\26086\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"\\32654\\22269\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -5.694137640013845e-2,\n                               unseen = -6.329720905522696,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -4.718498871295094),\n                                    (\"year (numeric with year symbol)\\20809\\26126\\33410\",\n                                     -4.248495242049359),\n                                    (\"xxxx year<named-month> <day-of-month>\", -4.941642422609305),\n                                    (\"daymonth\", -4.248495242049359),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"next yearSeptember\", -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\25995\\26376\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\20061\\22812\\33410\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)February\", -4.718498871295094),\n                                    (\"xxxx yearintersect\", -4.941642422609305),\n                                    (\"March<time> <day-of-month>\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)<named-month> <day-of-month>\",\n                                     -3.494723439672979),\n                                    (\"monthhour\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)\\22320\\29699\\19968\\23567\\26102\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)April\", -5.2293244950610855),\n                                    (\"dayday\", -2.284885515894645),\n                                    (\"hourhour\", -4.718498871295094),\n                                    (\"xxxx yearFebruary\", -5.634789603169249),\n                                    (\"year (numeric with year symbol)March\", -4.1307122063929755),\n                                    (\"February<dim time> <part-of-day>\", -3.7629874262676584),\n                                    (\"hourminute\", -4.718498871295094),\n                                    (\"April<time> <day-of-month>\", -5.2293244950610855),\n                                    (\"February<time> <day-of-month>\", -2.614364717024887),\n                                    (\"absorption of , after named day<named-month> <day-of-month>\",\n                                     -3.619886582626985),\n                                    (\"year (numeric with year symbol)\\22823\\25995\\26399\",\n                                     -4.941642422609305),\n                                    (\"this <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\22235\\26092\\33410\",\n                                     -5.2293244950610855),\n                                    (\"yearmonth\", -3.332204510175204),\n                                    (\"year (numeric with year symbol)\\20303\\26842\\33410\",\n                                     -5.2293244950610855),\n                                    (\"dayminute\", -4.718498871295094),\n                                    (\"next <cycle>September\", -5.634789603169249),\n                                    (\"intersect by \\\",\\\"<time> <day-of-month>\", -3.619886582626985),\n                                    (\"xxxx yearMarch\", -5.634789603169249),\n                                    (\"absorption of , after named dayintersect\",\n                                     -3.619886582626985),\n                                    (\"intersect<time> <day-of-month>\", -2.8015762591130335),\n                                    (\"next <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"tonight<time-of-day> o'clock\", -4.718498871295094),\n                                    (\"year (numeric with year symbol)intersect\",\n                                     -3.494723439672979),\n                                    (\"yearday\", -2.0794415416798357),\n                                    (\"absorption of , after named dayFebruary\", -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\19971\\19971\\33410\",\n                                     -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\36926\\36234\\33410\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\29369\\22826\\26032\\24180\",\n                                     -5.2293244950610855),\n                                    (\"yearminute\", -5.2293244950610855),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -4.718498871295094)],\n                               n = 256},\n                   koData =\n                     ClassData{prior = -2.894068619777491, unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -2.159484249353372),\n                                    (\"dayhour\", -2.7472709142554916),\n                                    (\"year (numeric with year symbol)Sunday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day><time-of-day> o'clock\",\n                                     -3.258096538021482),\n                                    (\"hourhour\", -3.258096538021482),\n                                    (\"hourminute\", -2.7472709142554916),\n                                    (\"dayminute\", -2.7472709142554916),\n                                    (\"yearday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.7472709142554916)],\n                               n = 15}}),\n       (\"half after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20399\\20029\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.625967214385311, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.21905356606268464,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.570544858467613, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"month (grain)\", -1.5198257537444133),\n                                    (\"year (grain)\", -2.367123614131617),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"year\", -2.367123614131617), (\"month\", -1.5198257537444133)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.832909122935104, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8602012652231115),\n                                    (\"week (grain)\", -0.8602012652231115)],\n                               n = 10}}),\n       (\"last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\27583\\34987\\27585\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Monday\", -1.8718021769015913), (\"day\", -0.7323678937132265),\n                                    (\"Tuesday\", -1.5533484457830569)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\35199\\36203\\25176\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20811\\21704\\29305\\26222\\36838\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21313\\32988\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20303\\26842\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\19977\\19968\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\30331\\38660\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\19971\\19971\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3564413979702095),\n                                    (\"integer (20,30,40)\", -3.0910424533583156),\n                                    (\"integer with consecutive unit modifiers\", -1.245215762859985),\n                                    (\"integer (0..10)\", -1.4170660197866443),\n                                    (\"number suffix: \\21313|\\25342\", -2.1102132003465894),\n                                    (\"compose by multiplication\", -3.0910424533583156)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)\", -0.3629054936893685),\n                                    (\"number suffix: \\21313|\\25342\", -2.03688192726104)],\n                               n = 17}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"hh:mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative (1-9) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> (latent time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2754119798599665,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.174751721484161),\n                                    (\"integer (0..10)\", -0.1466034741918754)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -1.4240346891027378, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4700036292457356),\n                                    (\"one point 2\", -1.1631508098056809)],\n                               n = 13}}),\n       (\"\\36926\\36234\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)Monday\", -0.6931471805599453),\n                                    (\"monthday\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22235\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\20809\\26126\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8434293836092833,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -0.5625269981428811,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"relative (10-59) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)compose by multiplication\",\n                                     -2.164963715117998),\n                                    (\"<integer> (latent time-of-day)integer with consecutive unit modifiers\",\n                                     -0.9753796482441617),\n                                    (\"hour\", -0.7435780341868373)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -1.0116009116784799,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)number suffix: \\21313|\\25342\",\n                                     -1.413693335308005),\n                                    (\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -1.413693335308005),\n                                    (\"hour\", -0.7777045685880083)],\n                               n = 16}}),\n       (\"year (numeric with year symbol)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22823\\25995\\26399\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24858\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26893\\26641\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\28789\\33410\\24198\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22522\\30563\\22307\\20307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\28595\\38376\\22238\\24402\\32426\\24565\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20804\\22969\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.3437347467010947),\n                                    (\"day\", -0.7375989431307791), (\"Tuesday\", -1.3437347467010947)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -4.8790164169432056e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -3.044522437723423, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\36174\\32618\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8909729238898653,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.1526795099383855),\n                                    (\"month (grain)\", -2.2512917986064953),\n                                    (\"year (grain)\", -2.538973871058276),\n                                    (\"week (grain)\", -1.1526795099383855),\n                                    (\"year\", -2.538973871058276), (\"month\", -2.2512917986064953)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -0.5280674302004967, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.7731898882334817),\n                                    (\"week (grain)\", -0.7731898882334817)],\n                               n = 23}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4462871026284195, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.0216512475319814,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"xxxx year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)integer (0..10)integer (0..10)\",\n                                     0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -7.696104113612832e-2,\n                               unseen = -4.6913478822291435,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.750305594399894),\n                                    (\"national dayevening|night\", -3.58351893845611),\n                                    (\"<named-month> <day-of-month>morning\", -2.117181869662683),\n                                    (\"\\24773\\20154\\33410evening|night\", -3.58351893845611),\n                                    (\"\\20799\\31461\\33410afternoon\", -3.58351893845611),\n                                    (\"intersectmorning\", -2.117181869662683),\n                                    (\"<time> <day-of-month>morning\", -2.117181869662683),\n                                    (\"Mondaymorning\", -2.4849066497880004)],\n                               n = 50},\n                   koData =\n                     ClassData{prior = -2.6026896854443837, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.1631508098056809),\n                                    (\"<time> <day-of-month>morning\", -1.1631508098056809)],\n                               n = 4}}),\n       (\"<part-of-day> <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7935659283069926,\n                               unseen = -5.0369526024136295,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tonight<integer> (latent time-of-day)\", -3.4210000089583352),\n                                    (\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -1.6631420914059614),\n                                    (\"hourhour\", -2.322387720290225),\n                                    (\"afternoon<time-of-day> o'clock\", -3.644143560272545),\n                                    (\"hourminute\", -0.9699949108460162),\n                                    (\"afternoon<integer> (latent time-of-day)\", -3.644143560272545),\n                                    (\"afternoonrelative (1-9) minutes after|past <integer> (hour-of-day)\",\n                                     -2.72785282839839),\n                                    (\"afternoonhh:mm (time-of-day)\", -3.644143560272545),\n                                    (\"tonight<time-of-day> o'clock\", -3.4210000089583352),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -2.4654885639308985),\n                                    (\"afternoonhalf after|past <integer> (hour-of-day)\",\n                                     -3.2386784521643803)],\n                               n = 71},\n                   koData =\n                     ClassData{prior = -0.6018985090948004, unseen = -5.214935757608986,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.3762728087852047),\n                                    (\"hourhour\", -0.9899784476653142),\n                                    (\"afternoon<time-of-day> o'clock\", -1.7754989483562746),\n                                    (\"hourminute\", -2.21375387928743),\n                                    (\"afternoon<integer> (latent time-of-day)\", -1.571899993115035),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -3.82319179172153)],\n                               n = 86}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -6.244166900663736,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342month (grain)\",\n                                     -4.632785353021065),\n                                    (\"week\", -3.0233474405869645),\n                                    (\"integer (0..10)month (grain)\", -2.745715703988685),\n                                    (\"integer (0..10)hour (grain)\", -3.1067290495260154),\n                                    (\"<number>\\20010/\\20491week (grain)\", -3.8443279926567944),\n                                    (\"compose by multiplicationminute (grain)\", -4.45046379622711),\n                                    (\"second\", -3.6031659358399066),\n                                    (\"integer (0..10)day (grain)\", -3.1067290495260154),\n                                    (\"integer (0..10)year (grain)\", -3.7573166156671647),\n                                    (\"<number>\\20010/\\20491month (grain)\", -3.469634543215384),\n                                    (\"integer (numeric)year (grain)\", -2.3710222545472743),\n                                    (\"integer (0..10)second (grain)\", -3.6031659358399066),\n                                    (\"day\", -3.1067290495260154), (\"year\", -2.1646858215494458),\n                                    (\"integer (0..10)minute (grain)\", -2.984126727433683),\n                                    (\"number suffix: \\21313|\\25342minute (grain)\",\n                                     -4.855928904335275),\n                                    (\"hour\", -3.1067290495260154),\n                                    (\"integer (0..10)week (grain)\", -3.534173064352955),\n                                    (\"month\", -2.008116760857906),\n                                    (\"integer (numeric)month (grain)\", -3.3518515075590005),\n                                    (\"integer with consecutive unit modifiersminute (grain)\",\n                                     -4.296313116399852),\n                                    (\"minute\", -2.553343811341229)],\n                               n = 246}}),\n       (\"\\32769\\26495\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31709\\28779\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.4353180712578455, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm (time-of-day)\", -0.9555114450274363),\n                                    (\"<integer> (latent time-of-day)\", -2.159484249353372),\n                                    (\"hour\", -2.159484249353372), (\"minute\", -0.9555114450274363)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.041453874828161, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.8266785731844679),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6}}),\n       (\"one point 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.9650808960435872),\n                                    (\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -1.9459101490553135),\n                                    (\"integer (0..10)integer with consecutive unit modifiers\",\n                                     -1.3397743454849977),\n                                    (\"integer (0..10)<number>\\20010/\\20491\", -2.639057329615259),\n                                    (\"integer (0..10)compose by multiplication\",\n                                     -2.639057329615259),\n                                    (\"integer (0..10)half\", -2.639057329615259)],\n                               n = 36}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2380465718564744),\n                                    (\"Sunday<named-month> <day-of-month>\", -1.6094379124341003),\n                                    (\"SundayFebruary\", -2.2380465718564744),\n                                    (\"dayday\", -0.9501922835498364),\n                                    (\"Sundayintersect\", -1.6094379124341003)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\38463\\33298\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer with consecutive unit modifiers\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"integer (0..10)integer (0..10)\", -0.6931471805599453)],\n                               n = 34},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.2876820724517809)],\n                               n = 2}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\25289\\25746\\36335\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\22307\\35806\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7308875085427924), (\"Sunday\", -1.2163953243244932),\n                                    (\"Tuesday\", -1.5040773967762742)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20234\\26031\\20848\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24320\\25995\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"\\22919\\22899\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20840\\29699\\38738\\24180\\26381\\21153\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27431\\21335\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20061\\22812\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7731898882334817), (\"Tuesday\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -0.7731898882334817),\n                                    (\"day\", -0.7731898882334817)],\n                               n = 5}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"year (grain)\", -2.4849066497880004),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"year\", -2.4849066497880004), (\"month\", -1.791759469228055)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8362480242006186),\n                                    (\"week (grain)\", -0.8362480242006186)],\n                               n = 12}}),\n       (\"\\20197\\33394\\21015\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.9856819377004897),\n                                    (\"second\", -2.803360380906535),\n                                    (\"integer (0..10)day (grain)\", -2.515678308454754),\n                                    (\"integer (0..10)year (grain)\", -3.2088254890146994),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.803360380906535),\n                                    (\"integer (0..10)second (grain)\", -2.803360380906535),\n                                    (\"day\", -2.515678308454754), (\"year\", -3.2088254890146994),\n                                    (\"integer (0..10)minute (grain)\", -2.649209701079277),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.803360380906535), (\"minute\", -2.649209701079277)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19975\\22307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21476\\23572\\37030\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of five minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (0..10)\", 0.0)],\n                               n = 2}}),\n       (\"\\20799\\31461\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = -3.922071315328127e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -3.258096538021482, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\26149\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer with consecutive unit modifiersminute (grain)\",\n                                     -1.0986122886681098),\n                                    (\"integer (0..10)compose by multiplicationminute (grain)\",\n                                     -1.6094379124341003),\n                                    (\"minute\", -0.7621400520468967)],\n                               n = 6}}),\n       (\"\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.762173934797756,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (0..10)\", -2.5563656137701454),\n                                    (\"Marchinteger (numeric)\", -3.144152278672264),\n                                    (\"Aprilinteger (numeric)\", -3.654977902438255),\n                                    (\"Februaryinteger (0..10)\", -2.6741486494265287),\n                                    (\"Februarynumber suffix: \\21313|\\25342\", -2.6741486494265287),\n                                    (\"month\", -0.7462570058738938),\n                                    (\"Februaryinteger (numeric)\", -2.5563656137701454),\n                                    (\"Februaryinteger with consecutive unit modifiers\",\n                                     -1.8091512119399242)],\n                               n = 54},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21171\\21160\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"number suffix: \\19975|\\33836\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"\\22823\\25995\\39318\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"two days after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5957987257888164, unseen = -5.407171771460119,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 221},\n                   koData =\n                     ClassData{prior = -0.8010045764163588, unseen = -5.204006687076795,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 180}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9856819377004897),\n                                    (\"integer (0..10)month (grain)\", -3.4965075614664802),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"second\", -2.649209701079277),\n                                    (\"integer (0..10)day (grain)\", -2.9856819377004897),\n                                    (\"integer (0..10)year (grain)\", -3.4965075614664802),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)second (grain)\", -2.649209701079277),\n                                    (\"day\", -2.9856819377004897), (\"year\", -3.4965075614664802),\n                                    (\"integer (0..10)minute (grain)\", -2.3978952727983707),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.1972245773362196),\n                                    (\"minute\", -2.3978952727983707)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2823823856765264), (\"second\", -2.505525936990736),\n                                    (\"day\", -2.793208009442517),\n                                    (\"<integer> <unit-of-duration>\", -0.8007778447523107),\n                                    (\"hour\", -2.2823823856765264), (\"month\", -2.2823823856765264),\n                                    (\"minute\", -2.2823823856765264)],\n                               n = 21}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList [(\"<number>\\20010/\\20491\", -0.1823215567939546)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -8.701137698962981e-2)],\n                               n = 10}}),\n       (\"n <cycle> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.908720896564361),\n                                    (\"second\", -2.908720896564361),\n                                    (\"integer (0..10)day (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)year (grain)\", -2.908720896564361),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.908720896564361),\n                                    (\"integer (0..10)second (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.908720896564361),\n                                    (\"integer (0..10)minute (grain)\", -2.908720896564361),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.908720896564361),\n                                    (\"month\", -2.908720896564361), (\"minute\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24527\\24724\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number suffix: \\21313|\\25342\",\n        Classifier{okData =\n                     ClassData{prior = -0.1590646946296874,\n                               unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -1.916922612182061, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"\\22320\\29699\\19968\\23567\\26102\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.38299225225610584,\n                               unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -1.1451323043030026,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"\\22307\\32426\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"<number>\\20010/\\20491\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -3.509131981127006e-2)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2\", -0.9808292530117262),\n                                    (\"integer (0..10)\", -0.4700036292457356)],\n                               n = 6}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -0.15415067982725836)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2number suffix: \\21313|\\25342\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"\\24773\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20116\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31070\\22307\\26143\\26399\\22235\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\25995\\26376\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27861\\20196\\20043\\22812\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9810014688665833),\n                                    (\"Monday\", -1.9810014688665833), (\"day\", -0.8415671856782186),\n                                    (\"hour\", -2.9618307218783095), (\"Tuesday\", -1.6625477377480489),\n                                    (\"week-end\", -2.9618307218783095)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1575}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n-----------------------------------------------------------------\n-- Auto-generated by regenClassifiers\n--\n-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n--  @generated\n-----------------------------------------------------------------\n{-# LANGUAGE OverloadedStrings #-}\nmodule Duckling.Ranking.Classifiers.ZH_XX (classifiers) where\nimport Data.String\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport Duckling.Ranking.Types\n\nclassifiers :: Classifiers\nclassifiers\n  = HashMap.fromList\n      [(\"\\25490\\28783\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of 5 minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2231435513142097, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8979415932059586),\n                                    (\"hour\", -0.7308875085427924),\n                                    (\"<integer> (latent time-of-day)<number>\\20010/\\20491\",\n                                     -2.1972245773362196)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -2.3025850929940455,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.8109302162163288),\n                                    (\"hour\", -0.8109302162163288)],\n                               n = 3}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\22235\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> timezone\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<time-of-day> am|pm\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Thursday\",\n        Classifier{okData =\n                     ClassData{prior = -0.4700036292457356,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.9808292530117262,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"integer (numeric)\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -4.23410650459726,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 67}}),\n       (\"\\21355\\22622\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day before yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22269\\38469\\28040\\36153\\32773\\26435\\30410\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24314\\20891\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"today\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd\",\n        Classifier{okData =\n                     ClassData{prior = -1.6094379124341003,\n                               unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -0.2231435513142097, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"absorption of , after named day\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.6931471805599453), (\"Sunday\", -0.6931471805599453)],\n                               n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"September\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"tonight\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"October\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"month (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.963437510299857, unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -0.48058573857627246,\n                               unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 47}}),\n       (\"<time-of-day> o'clock\",\n        Classifier{okData =\n                     ClassData{prior = -1.466337068793427, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.262364264467491, unseen = -4.143134726391533,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 30}}),\n       (\"integer (20,30,40)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Wednesday\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -2.9444389791664407,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 17},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\\31532\\19977\\22825\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"hour (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -9.53101798043249e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -2.3978952727983707,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\20250\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20803\\26086\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8}}),\n       (\"\\32654\\22269\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"intersect\",\n        Classifier{okData =\n                     ClassData{prior = -5.694137640013845e-2,\n                               unseen = -6.329720905522696,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -4.718498871295094),\n                                    (\"year (numeric with year symbol)\\20809\\26126\\33410\",\n                                     -4.248495242049359),\n                                    (\"xxxx year<named-month> <day-of-month>\", -4.941642422609305),\n                                    (\"daymonth\", -4.248495242049359),\n                                    (\"monthday\", -1.9459101490553135),\n                                    (\"next yearSeptember\", -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\25995\\26376\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\20061\\22812\\33410\",\n                                     -4.941642422609305),\n                                    (\"year (numeric with year symbol)February\", -4.718498871295094),\n                                    (\"xxxx yearintersect\", -4.941642422609305),\n                                    (\"March<time> <day-of-month>\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)<named-month> <day-of-month>\",\n                                     -3.494723439672979),\n                                    (\"monthhour\", -3.7629874262676584),\n                                    (\"year (numeric with year symbol)\\22320\\29699\\19968\\23567\\26102\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)April\", -5.2293244950610855),\n                                    (\"dayday\", -2.284885515894645),\n                                    (\"hourhour\", -4.718498871295094),\n                                    (\"xxxx yearFebruary\", -5.634789603169249),\n                                    (\"year (numeric with year symbol)March\", -4.1307122063929755),\n                                    (\"February<dim time> <part-of-day>\", -3.7629874262676584),\n                                    (\"hourminute\", -4.718498871295094),\n                                    (\"April<time> <day-of-month>\", -5.2293244950610855),\n                                    (\"February<time> <day-of-month>\", -2.614364717024887),\n                                    (\"absorption of , after named day<named-month> <day-of-month>\",\n                                     -3.619886582626985),\n                                    (\"year (numeric with year symbol)\\22823\\25995\\26399\",\n                                     -4.941642422609305),\n                                    (\"this <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"year (numeric with year symbol)\\22235\\26092\\33410\",\n                                     -5.2293244950610855),\n                                    (\"yearmonth\", -3.332204510175204),\n                                    (\"year (numeric with year symbol)\\20303\\26842\\33410\",\n                                     -5.2293244950610855),\n                                    (\"dayminute\", -4.718498871295094),\n                                    (\"next <cycle>September\", -5.634789603169249),\n                                    (\"intersect by \\\",\\\"<time> <day-of-month>\", -3.619886582626985),\n                                    (\"xxxx yearMarch\", -5.634789603169249),\n                                    (\"absorption of , after named dayintersect\",\n                                     -3.619886582626985),\n                                    (\"intersect<time> <day-of-month>\", -2.8015762591130335),\n                                    (\"next <cycle><time> <day-of-month>\", -4.941642422609305),\n                                    (\"tonight<time-of-day> o'clock\", -4.718498871295094),\n                                    (\"year (numeric with year symbol)intersect\",\n                                     -3.494723439672979),\n                                    (\"yearday\", -2.0794415416798357),\n                                    (\"absorption of , after named dayFebruary\", -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\19971\\19971\\33410\",\n                                     -4.248495242049359),\n                                    (\"year (numeric with year symbol)\\36926\\36234\\33410\",\n                                     -5.2293244950610855),\n                                    (\"year (numeric with year symbol)\\29369\\22826\\26032\\24180\",\n                                     -5.2293244950610855),\n                                    (\"yearminute\", -5.2293244950610855),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -4.718498871295094)],\n                               n = 256},\n                   koData =\n                     ClassData{prior = -2.894068619777491, unseen = -4.3694478524670215,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"\\20799\\31461\\33410<part-of-day> <dim time>\",\n                                     -2.159484249353372),\n                                    (\"dayhour\", -2.7472709142554916),\n                                    (\"year (numeric with year symbol)Sunday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day><time-of-day> o'clock\",\n                                     -3.258096538021482),\n                                    (\"hourhour\", -3.258096538021482),\n                                    (\"hourminute\", -2.7472709142554916),\n                                    (\"dayminute\", -2.7472709142554916),\n                                    (\"yearday\", -3.6635616461296463),\n                                    (\"<dim time> <part-of-day>relative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.7472709142554916)],\n                               n = 15}}),\n       (\"half after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20399\\20029\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"year (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -1.625967214385311, unseen = -2.639057329615259,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 12},\n                   koData =\n                     ClassData{prior = -0.21905356606268464,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"Saturday\",\n        Classifier{okData =\n                     ClassData{prior = -0.8754687373538999,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.5389965007326869,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"next <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.570544858467613, unseen = -3.4965075614664802,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.6739764335716716),\n                                    (\"month (grain)\", -1.5198257537444133),\n                                    (\"year (grain)\", -2.367123614131617),\n                                    (\"week (grain)\", -1.6739764335716716),\n                                    (\"year\", -2.367123614131617), (\"month\", -1.5198257537444133)],\n                               n = 13},\n                   koData =\n                     ClassData{prior = -0.832909122935104, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8602012652231115),\n                                    (\"week (grain)\", -0.8602012652231115)],\n                               n = 10}}),\n       (\"last year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\27583\\34987\\27585\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.8718021769015913),\n                                    (\"Monday\", -1.8718021769015913), (\"day\", -0.7323678937132265),\n                                    (\"Tuesday\", -1.5533484457830569)],\n                               n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\35199\\36203\\25176\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3025850929940455,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 8},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yyyy-mm-dd\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"mm/dd/yyyy\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20811\\21704\\29305\\26222\\36838\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21313\\32988\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"evening|night\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20303\\26842\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\19977\\19968\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\30331\\38660\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Monday\",\n        Classifier{okData =\n                     ClassData{prior = -0.15415067982725836,\n                               unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -1.9459101490553135, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\19971\\19971\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"yesterday\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = -0.24946085963158313,\n                               unseen = -4.204692619390966,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -1.3564413979702095),\n                                    (\"integer (20,30,40)\", -3.0910424533583156),\n                                    (\"integer with consecutive unit modifiers\", -1.245215762859985),\n                                    (\"integer (0..10)\", -1.4170660197866443),\n                                    (\"number suffix: \\21313|\\25342\", -2.1102132003465894),\n                                    (\"compose by multiplication\", -3.0910424533583156)],\n                               n = 60},\n                   koData =\n                     ClassData{prior = -1.5105920777974677,\n                               unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)\", -0.3629054936893685),\n                                    (\"number suffix: \\21313|\\25342\", -2.03688192726104)],\n                               n = 17}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"hh:mm (time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"relative (1-9) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.044522437723423,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"hour\", -0.6931471805599453)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<integer> (latent time-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.2754119798599665,\n                               unseen = -3.8066624897703196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -2.174751721484161),\n                                    (\"integer (0..10)\", -0.1466034741918754)],\n                               n = 41},\n                   koData =\n                     ClassData{prior = -1.4240346891027378, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (numeric)\", -0.4700036292457356),\n                                    (\"one point 2\", -1.1631508098056809)],\n                               n = 13}}),\n       (\"\\36926\\36234\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"nth <time> of <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.3978952727983707,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Octoberordinal (digits)Monday\", -0.6931471805599453),\n                                    (\"monthday\", -0.6931471805599453)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22235\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"April\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20016\\25910\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\20809\\26126\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.8434293836092833,\n                               unseen = -3.6635616461296463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 37},\n                   koData =\n                     ClassData{prior = -0.5625269981428811,\n                               unseen = -3.9318256327243257,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 49}}),\n       (\"relative (10-59) minutes after|past <integer> (hour-of-day)\",\n        Classifier{okData =\n                     ClassData{prior = -0.45198512374305727,\n                               unseen = -4.127134385045092,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)compose by multiplication\",\n                                     -2.164963715117998),\n                                    (\"<integer> (latent time-of-day)integer with consecutive unit modifiers\",\n                                     -0.9753796482441617),\n                                    (\"hour\", -0.7435780341868373)],\n                               n = 28},\n                   koData =\n                     ClassData{prior = -1.0116009116784799,\n                               unseen = -3.6375861597263857,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)number suffix: \\21313|\\25342\",\n                                     -1.413693335308005),\n                                    (\"<integer> (latent time-of-day)integer (0..10)\",\n                                     -1.413693335308005),\n                                    (\"hour\", -0.7777045685880083)],\n                               n = 16}}),\n       (\"year (numeric with year symbol)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 47},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"now\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.4849066497880004,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22823\\25995\\26399\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24858\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\29369\\22826\\26893\\26641\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22307\\28789\\33410\\24198\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"numbers prefix with -, negative or minus\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"integer (numeric)\", 0.0)],\n                               n = 4}}),\n       (\"Friday\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22522\\30563\\22307\\20307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\28595\\38376\\22238\\24402\\32426\\24565\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21360\\24230\\20804\\22969\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <day-of-week>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.1780538303479458,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.3437347467010947),\n                                    (\"day\", -0.7375989431307791), (\"Tuesday\", -1.3437347467010947)],\n                               n = 10},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"fractional number\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"Sunday\",\n        Classifier{okData =\n                     ClassData{prior = -4.8790164169432056e-2,\n                               unseen = -3.0910424533583156,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 20},\n                   koData =\n                     ClassData{prior = -3.044522437723423, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"afternoon\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.6375861597263857,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 36},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> from now\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\36174\\32618\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"February\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.258096538021482,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 24},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8909729238898653,\n                               unseen = -3.6635616461296463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.1526795099383855),\n                                    (\"month (grain)\", -2.2512917986064953),\n                                    (\"year (grain)\", -2.538973871058276),\n                                    (\"week (grain)\", -1.1526795099383855),\n                                    (\"year\", -2.538973871058276), (\"month\", -2.2512917986064953)],\n                               n = 16},\n                   koData =\n                     ClassData{prior = -0.5280674302004967, unseen = -3.970291913552122,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.7731898882334817),\n                                    (\"week (grain)\", -0.7731898882334817)],\n                               n = 23}}),\n       (\"minute (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.4462871026284195, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -1.0216512475319814,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"xxxx year\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)integer (0..10)integer (0..10)\",\n                                     0.0)],\n                               n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<dim time> <part-of-day>\",\n        Classifier{okData =\n                     ClassData{prior = -8.004270767353637e-2,\n                               unseen = -4.6443908991413725,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -0.7429086901190092),\n                                    (\"<named-month> <day-of-month>morning\", -2.069779630768099),\n                                    (\"\\24773\\20154\\33410evening|night\", -3.536116699561526),\n                                    (\"\\20799\\31461\\33410afternoon\", -3.536116699561526),\n                                    (\"intersectmorning\", -2.069779630768099),\n                                    (\"<time> <day-of-month>morning\", -2.069779630768099),\n                                    (\"Mondaymorning\", -2.4375044108934163)],\n                               n = 48},\n                   koData =\n                     ClassData{prior = -2.5649493574615367, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"dayhour\", -1.0986122886681098),\n                                    (\"<time> <day-of-month>morning\", -1.0986122886681098)],\n                               n = 4}}),\n       (\"<part-of-day> <dim time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.7935659283069926,\n                               unseen = -5.0369526024136295,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"tonight<integer> (latent time-of-day)\", -3.4210000089583352),\n                                    (\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -1.6631420914059614),\n                                    (\"hourhour\", -2.322387720290225),\n                                    (\"afternoon<time-of-day> o'clock\", -3.644143560272545),\n                                    (\"hourminute\", -0.9699949108460162),\n                                    (\"afternoon<integer> (latent time-of-day)\", -3.644143560272545),\n                                    (\"afternoonrelative (1-9) minutes after|past <integer> (hour-of-day)\",\n                                     -2.72785282839839),\n                                    (\"afternoonhh:mm (time-of-day)\", -3.644143560272545),\n                                    (\"tonight<time-of-day> o'clock\", -3.4210000089583352),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -2.4654885639308985),\n                                    (\"afternoonhalf after|past <integer> (hour-of-day)\",\n                                     -3.2386784521643803)],\n                               n = 71},\n                   koData =\n                     ClassData{prior = -0.6018985090948004, unseen = -5.214935757608986,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"afternoonrelative (10-59) minutes after|past <integer> (hour-of-day)\",\n                                     -2.3762728087852047),\n                                    (\"hourhour\", -0.9899784476653142),\n                                    (\"afternoon<time-of-day> o'clock\", -1.7754989483562746),\n                                    (\"hourminute\", -2.21375387928743),\n                                    (\"afternoon<integer> (latent time-of-day)\", -1.571899993115035),\n                                    (\"afternoonnumber of 5 minutes after|past <integer> (hour-of-day)\",\n                                     -3.82319179172153)],\n                               n = 86}}),\n       (\"<integer> <unit-of-duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -3.1354942159291497,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -6.244166900663736,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342month (grain)\",\n                                     -4.632785353021065),\n                                    (\"week\", -3.0233474405869645),\n                                    (\"integer (0..10)month (grain)\", -2.745715703988685),\n                                    (\"integer (0..10)hour (grain)\", -3.1067290495260154),\n                                    (\"<number>\\20010/\\20491week (grain)\", -3.8443279926567944),\n                                    (\"compose by multiplicationminute (grain)\", -4.45046379622711),\n                                    (\"second\", -3.6031659358399066),\n                                    (\"integer (0..10)day (grain)\", -3.1067290495260154),\n                                    (\"integer (0..10)year (grain)\", -3.7573166156671647),\n                                    (\"<number>\\20010/\\20491month (grain)\", -3.469634543215384),\n                                    (\"integer (numeric)year (grain)\", -2.3710222545472743),\n                                    (\"integer (0..10)second (grain)\", -3.6031659358399066),\n                                    (\"day\", -3.1067290495260154), (\"year\", -2.1646858215494458),\n                                    (\"integer (0..10)minute (grain)\", -2.984126727433683),\n                                    (\"number suffix: \\21313|\\25342minute (grain)\",\n                                     -4.855928904335275),\n                                    (\"hour\", -3.1067290495260154),\n                                    (\"integer (0..10)week (grain)\", -3.534173064352955),\n                                    (\"month\", -2.008116760857906),\n                                    (\"integer (numeric)month (grain)\", -3.3518515075590005),\n                                    (\"integer with consecutive unit modifiersminute (grain)\",\n                                     -4.296313116399852),\n                                    (\"minute\", -2.553343811341229)],\n                               n = 246}}),\n       (\"\\32769\\26495\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31709\\28779\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<time-of-day> am|pm\",\n        Classifier{okData =\n                     ClassData{prior = -0.4353180712578455, unseen = -3.295836866004329,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"hh:mm (time-of-day)\", -0.9555114450274363),\n                                    (\"<integer> (latent time-of-day)\", -2.159484249353372),\n                                    (\"hour\", -2.159484249353372), (\"minute\", -0.9555114450274363)],\n                               n = 11},\n                   koData =\n                     ClassData{prior = -1.041453874828161, unseen = -2.833213344056216,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"<integer> (latent time-of-day)\", -0.8266785731844679),\n                                    (\"hour\", -0.8266785731844679)],\n                               n = 6}}),\n       (\"one point 2\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.7612001156935624,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.9650808960435872),\n                                    (\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -1.9459101490553135),\n                                    (\"integer (0..10)integer with consecutive unit modifiers\",\n                                     -1.3397743454849977),\n                                    (\"integer (0..10)<number>\\20010/\\20491\", -2.639057329615259),\n                                    (\"integer (0..10)compose by multiplication\",\n                                     -2.639057329615259),\n                                    (\"integer (0..10)half\", -2.639057329615259)],\n                               n = 36}}),\n       (\"intersect by \\\",\\\"\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.330733340286331,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"daymonth\", -2.2380465718564744),\n                                    (\"Sunday<named-month> <day-of-month>\", -1.6094379124341003),\n                                    (\"SundayFebruary\", -2.2380465718564744),\n                                    (\"dayday\", -0.9501922835498364),\n                                    (\"Sundayintersect\", -1.6094379124341003)],\n                               n = 35},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\26837\\26525\\20027\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4}}),\n       (\"\\38463\\33298\\25289\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer with consecutive unit modifiers\",\n        Classifier{okData =\n                     ClassData{prior = -5.715841383994864e-2,\n                               unseen = -3.6109179126442243,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"number suffix: \\21313|\\25342integer (0..10)\",\n                                     -0.6931471805599453),\n                                    (\"integer (0..10)integer (0..10)\", -0.6931471805599453)],\n                               n = 34},\n                   koData =\n                     ClassData{prior = -2.890371757896165, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer (0..10)\", -0.2876820724517809)],\n                               n = 2}}),\n       (\"second (grain)\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.70805020110221,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 13},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19996\\27491\\25945\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\25289\\25746\\36335\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"<duration> ago\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.891820298110627,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2617630984737906), (\"second\", -2.772588722239781),\n                                    (\"day\", -2.2617630984737906), (\"year\", -2.772588722239781),\n                                    (\"<integer> <unit-of-duration>\", -0.8266785731844679),\n                                    (\"hour\", -2.2617630984737906), (\"month\", -2.772588722239781),\n                                    (\"minute\", -2.772588722239781)],\n                               n = 20}}),\n       (\"\\22307\\35806\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -3.332204510175204,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7308875085427924), (\"Sunday\", -1.2163953243244932),\n                                    (\"Tuesday\", -1.5040773967762742)],\n                               n = 12},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20234\\26031\\20848\\26032\\24180\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"March\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24320\\25995\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"the day after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = -0.5108256237659907,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.916290731874155, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"\\22307\\21608\\20845\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"\\22919\\22899\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20840\\29699\\38738\\24180\\26381\\21153\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27431\\21335\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20061\\22812\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next <time>\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"day\", -0.7731898882334817), (\"Tuesday\", -0.7731898882334817)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -0.6931471805599453, unseen = -2.639057329615259,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -0.7731898882334817),\n                                    (\"day\", -0.7731898882334817)],\n                               n = 5}}),\n       (\"last <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = -0.8472978603872037,\n                               unseen = -3.2188758248682006,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -1.3862943611198906),\n                                    (\"month (grain)\", -1.791759469228055),\n                                    (\"year (grain)\", -2.4849066497880004),\n                                    (\"week (grain)\", -1.3862943611198906),\n                                    (\"year\", -2.4849066497880004), (\"month\", -1.791759469228055)],\n                               n = 9},\n                   koData =\n                     ClassData{prior = -0.5596157879354228,\n                               unseen = -3.4339872044851463,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -0.8362480242006186),\n                                    (\"week (grain)\", -0.8362480242006186)],\n                               n = 12}}),\n       (\"\\20197\\33394\\21015\\29420\\31435\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.791759469228055,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 4},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"next n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.9856819377004897),\n                                    (\"second\", -2.803360380906535),\n                                    (\"integer (0..10)day (grain)\", -2.515678308454754),\n                                    (\"integer (0..10)year (grain)\", -3.2088254890146994),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.803360380906535),\n                                    (\"integer (0..10)second (grain)\", -2.803360380906535),\n                                    (\"day\", -2.515678308454754), (\"year\", -3.2088254890146994),\n                                    (\"integer (0..10)minute (grain)\", -2.649209701079277),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.803360380906535), (\"minute\", -2.649209701079277)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\19975\\22307\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21476\\23572\\37030\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number of five minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"integer (0..10)\", 0.0)],\n                               n = 2}}),\n       (\"\\20799\\31461\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"Tuesday\",\n        Classifier{okData =\n                     ClassData{prior = -3.922071315328127e-2,\n                               unseen = -3.295836866004329,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 25},\n                   koData =\n                     ClassData{prior = -3.258096538021482, unseen = -1.0986122886681098,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 1}}),\n       (\"\\26149\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number.number minutes\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -2.772588722239781,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)integer with consecutive unit modifiersminute (grain)\",\n                                     -1.0986122886681098),\n                                    (\"integer (0..10)compose by multiplicationminute (grain)\",\n                                     -1.6094379124341003),\n                                    (\"minute\", -0.7621400520468967)],\n                               n = 6}}),\n       (\"\\32822\\31267\\21463\\38590\\26085\",\n        Classifier{okData =\n                     ClassData{prior = -1.0296194171811581,\n                               unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -0.4418327522790392,\n                               unseen = -2.3978952727983707,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 9}}),\n       (\"<named-month> <day-of-month>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.762173934797756,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Marchinteger (0..10)\", -2.5563656137701454),\n                                    (\"Marchinteger (numeric)\", -3.144152278672264),\n                                    (\"Aprilinteger (numeric)\", -3.654977902438255),\n                                    (\"Februaryinteger (0..10)\", -2.6741486494265287),\n                                    (\"Februarynumber suffix: \\21313|\\25342\", -2.6741486494265287),\n                                    (\"month\", -0.7462570058738938),\n                                    (\"Februaryinteger (numeric)\", -2.5563656137701454),\n                                    (\"Februaryinteger with consecutive unit modifiers\",\n                                     -1.8091512119399242)],\n                               n = 54},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\21171\\21160\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\\26143\\26399\\19968\",\n        Classifier{okData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -0.6931471805599453,\n                               unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2}}),\n       (\"number suffix: \\19975|\\33836\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3}}),\n       (\"\\22823\\25995\\39318\\26085\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"half\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"two days after tomorrow\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"integer (0..10)\",\n        Classifier{okData =\n                     ClassData{prior = -0.5957987257888164, unseen = -5.407171771460119,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 221},\n                   koData =\n                     ClassData{prior = -0.8010045764163588, unseen = -5.204006687076795,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 180}}),\n       (\"last n <cycle>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.605170185988091,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.9856819377004897),\n                                    (\"integer (0..10)month (grain)\", -3.4965075614664802),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"second\", -2.649209701079277),\n                                    (\"integer (0..10)day (grain)\", -2.9856819377004897),\n                                    (\"integer (0..10)year (grain)\", -3.4965075614664802),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)second (grain)\", -2.649209701079277),\n                                    (\"day\", -2.9856819377004897), (\"year\", -3.4965075614664802),\n                                    (\"integer (0..10)minute (grain)\", -2.3978952727983707),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.9856819377004897),\n                                    (\"month\", -2.1972245773362196),\n                                    (\"minute\", -2.3978952727983707)],\n                               n = 42},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"last <duration>\",\n        Classifier{okData =\n                     ClassData{prior = -infinity, unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [], n = 0},\n                   koData =\n                     ClassData{prior = 0.0, unseen = -3.912023005428146,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.2823823856765264), (\"second\", -2.505525936990736),\n                                    (\"day\", -2.793208009442517),\n                                    (\"<integer> <unit-of-duration>\", -0.8007778447523107),\n                                    (\"hour\", -2.2823823856765264), (\"month\", -2.2823823856765264),\n                                    (\"minute\", -2.2823823856765264)],\n                               n = 21}}),\n       (\"ordinal (digits)\",\n        Classifier{okData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.9459101490553135,\n                               likelihoods =\n                                 HashMap.fromList [(\"<number>\\20010/\\20491\", -0.1823215567939546)],\n                               n = 4},\n                   koData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.5649493574615367,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -8.701137698962981e-2)],\n                               n = 10}}),\n       (\"n <cycle> last\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.02535169073515,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"week\", -2.3978952727983707),\n                                    (\"integer (0..10)hour (grain)\", -2.3978952727983707),\n                                    (\"<number>\\20010/\\20491week (grain)\", -2.908720896564361),\n                                    (\"second\", -2.908720896564361),\n                                    (\"integer (0..10)day (grain)\", -2.3978952727983707),\n                                    (\"integer (0..10)year (grain)\", -2.908720896564361),\n                                    (\"<number>\\20010/\\20491month (grain)\", -2.908720896564361),\n                                    (\"integer (0..10)second (grain)\", -2.908720896564361),\n                                    (\"day\", -2.3978952727983707), (\"year\", -2.908720896564361),\n                                    (\"integer (0..10)minute (grain)\", -2.908720896564361),\n                                    (\"hour\", -2.3978952727983707),\n                                    (\"integer (0..10)week (grain)\", -2.908720896564361),\n                                    (\"month\", -2.908720896564361), (\"minute\", -2.908720896564361)],\n                               n = 20},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -2.772588722239781,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\24527\\24724\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"morning\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -2.890371757896165,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 16},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"week-end\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"number suffix: \\21313|\\25342\",\n        Classifier{okData =\n                     ClassData{prior = -0.1590646946296874,\n                               unseen = -3.4339872044851463,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 29},\n                   koData =\n                     ClassData{prior = -1.916922612182061, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5}}),\n       (\"\\22320\\29699\\19968\\23567\\26102\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"day (grain)\",\n        Classifier{okData =\n                     ClassData{prior = -0.38299225225610584,\n                               unseen = -2.833213344056216,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 15},\n                   koData =\n                     ClassData{prior = -1.1451323043030026,\n                               unseen = -2.1972245773362196,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 7}}),\n       (\"\\22307\\32426\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\22797\\27963\\33410\",\n        Classifier{okData =\n                     ClassData{prior = -1.0986122886681098,\n                               unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -0.40546510810816444,\n                               unseen = -2.0794415416798357,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 6}}),\n       (\"<number>\\20010/\\20491\",\n        Classifier{okData =\n                     ClassData{prior = -0.2006706954621511,\n                               unseen = -3.4011973816621555,\n                               likelihoods =\n                                 HashMap.fromList [(\"integer (0..10)\", -3.509131981127006e-2)],\n                               n = 27},\n                   koData =\n                     ClassData{prior = -1.7047480922384253,\n                               unseen = -2.1972245773362196,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2\", -0.9808292530117262),\n                                    (\"integer (0..10)\", -0.4700036292457356)],\n                               n = 6}}),\n       (\"compose by multiplication\",\n        Classifier{okData =\n                     ClassData{prior = -0.3364722366212129,\n                               unseen = -2.0794415416798357,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"integer (0..10)number suffix: \\21313|\\25342\",\n                                     -0.15415067982725836)],\n                               n = 5},\n                   koData =\n                     ClassData{prior = -1.252762968495368, unseen = -1.6094379124341003,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"one point 2number suffix: \\21313|\\25342\",\n                                     -0.2876820724517809)],\n                               n = 2}}),\n       (\"\\24773\\20154\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\20116\\26092\\33410\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\31070\\22307\\26143\\26399\\22235\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 5},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\25995\\26376\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.6094379124341003,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 3},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"\\27861\\20196\\20043\\22812\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -1.3862943611198906,\n                               likelihoods = HashMap.fromList [(\"\", 0.0)], n = 2},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -0.6931471805599453,\n                               likelihoods = HashMap.fromList [], n = 0}}),\n       (\"this <time>\",\n        Classifier{okData =\n                     ClassData{prior = 0.0, unseen = -4.07753744390572,\n                               likelihoods =\n                                 HashMap.fromList\n                                   [(\"Wednesday\", -1.9810014688665833),\n                                    (\"Monday\", -1.9810014688665833), (\"day\", -0.8415671856782186),\n                                    (\"hour\", -2.9618307218783095), (\"Tuesday\", -1.6625477377480489),\n                                    (\"week-end\", -2.9618307218783095)],\n                               n = 26},\n                   koData =\n                     ClassData{prior = -infinity, unseen = -1.9459101490553135,\n                               likelihoods = HashMap.fromList [], n = 0}})]", "num_lines": 1565}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Regex.Types\n  ( GroupMatch(..)\n  ) where\n\nimport Control.DeepSeq\nimport Data.Hashable\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\nimport Duckling.Resolve (Resolve(..))\n\nnewtype GroupMatch = GroupMatch [Text]\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve GroupMatch where\n  type ResolvedValue GroupMatch = ()\n  resolve _ _ _ = Nothing\n", "num_lines": 30}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.AF\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.AF.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules AF dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.AR\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.AR.Rules as AmountOfMoney\nimport qualified Duckling.Duration.AR.Rules as Duration\nimport qualified Duckling.Numeral.AR.Rules as Numeral\nimport qualified Duckling.Numeral.AR.EG.Rules as NumeralEG\nimport qualified Duckling.Ordinal.AR.Rules as Ordinal\nimport qualified Duckling.PhoneNumber.AR.Rules as PhoneNumber\nimport qualified Duckling.Quantity.AR.Rules as Quantity\nimport qualified Duckling.Temperature.AR.Rules as Temperature\nimport qualified Duckling.Time.AR.Rules as Time\nimport qualified Duckling.TimeGrain.AR.Rules as TimeGrain\nimport qualified Duckling.Volume.AR.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules EG (Seal Numeral) = NumeralEG.rules\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = PhoneNumber.rules\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules AR dim\n", "num_lines": 57}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.BG\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.BG.Rules as Numeral\nimport qualified Duckling.AmountOfMoney.BG.Rules as AmountOfMoney\nimport qualified Duckling.Distance.BG.Rules as Distance\nimport qualified Duckling.Duration.BG.Rules as Duration\nimport qualified Duckling.Time.BG.Rules as Time\nimport qualified Duckling.TimeGrain.BG.Rules as TimeGrain\nimport qualified Duckling.Ordinal.BG.Rules as Ordinal\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules BG dim\n", "num_lines": 52}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.BN\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.BN.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Email) = []\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules BN dim\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.CA\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport qualified Duckling.AmountOfMoney.CA.Rules as AmountOfMoney\nimport qualified Duckling.Distance.CA.Rules as Distance\nimport qualified Duckling.Duration.CA.Rules as Duration\nimport qualified Duckling.Numeral.CA.Rules as Numeral\nimport qualified Duckling.Ordinal.CA.Rules as Ordinal\nimport qualified Duckling.Temperature.CA.Rules as Temperature\nimport qualified Duckling.Time.CA.Rules as Time\nimport qualified Duckling.TimeGrain.CA.Rules as TimeGrain\nimport qualified Duckling.Volume.CA.Rules as Volume\nimport Duckling.Types\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension _)) = []\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.Common\n  ( rules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.Rules as AmountOfMoney\nimport qualified Duckling.CreditCardNumber.Rules as CreditCardNumber\nimport qualified Duckling.Distance.Rules as Distance\nimport qualified Duckling.Duration.Rules as Duration\nimport qualified Duckling.Email.Rules as Email\nimport qualified Duckling.Numeral.Rules as Numeral\nimport qualified Duckling.PhoneNumber.Rules as PhoneNumber\nimport qualified Duckling.Temperature.Rules as Temperature\nimport qualified Duckling.Url.Rules as Url\nimport qualified Duckling.Volume.Rules as Volume\n\nrules :: Seal Dimension -> [Rule]\nrules (Seal AmountOfMoney) = AmountOfMoney.rules\nrules (Seal CreditCardNumber) = CreditCardNumber.rules\nrules (Seal Distance) = Distance.rules\nrules (Seal Duration) = Duration.rules\nrules (Seal Email) = Email.rules\nrules (Seal Numeral) = Numeral.rules\nrules (Seal Ordinal) = []\nrules (Seal PhoneNumber) = PhoneNumber.rules\nrules (Seal Quantity) = []\nrules (Seal RegexMatch) = []\nrules (Seal Temperature) = Temperature.rules\nrules (Seal Time) = []\nrules (Seal TimeGrain) = []\nrules (Seal Url) = Url.rules\nrules (Seal Volume) = Volume.rules\nrules (Seal (CustomDimension dim)) = dimRules dim\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.CS\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Distance.CS.Rules as Distance\nimport qualified Duckling.Numeral.CS.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules CS dim\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.DA\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Duration.DA.Rules as Duration\nimport qualified Duckling.Numeral.DA.Rules as Numeral\nimport qualified Duckling.Ordinal.DA.Rules as Ordinal\nimport qualified Duckling.Time.DA.Rules as Time\nimport qualified Duckling.TimeGrain.DA.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules DA dim\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\nmodule Duckling.Rules.DE\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.Distance.DE.Rules as Distance\nimport qualified Duckling.Duration.DE.Rules as Duration\nimport qualified Duckling.Email.DE.Rules as Email\nimport Duckling.Locale\nimport qualified Duckling.Numeral.DE.Rules as Numeral\nimport qualified Duckling.Ordinal.DE.Rules as Ordinal\nimport qualified Duckling.Time.DE.Rules as Time\nimport qualified Duckling.TimeGrain.DE.Rules as TimeGrain\nimport Duckling.Types\nimport qualified Duckling.Volume.DE.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = Email.rules\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules DE dim\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.EL\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Duration.EL.Rules as Duration\nimport qualified Duckling.Numeral.EL.Rules as Numeral\nimport qualified Duckling.Ordinal.EL.Rules as Ordinal\nimport qualified Duckling.Time.EL.Rules as Time\nimport qualified Duckling.TimeGrain.EL.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules EL dim\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.EN\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.EN.Rules as AmountOfMoney\nimport qualified Duckling.AmountOfMoney.EN.AU.Rules as AmountOfMoneyAU\nimport qualified Duckling.AmountOfMoney.EN.BZ.Rules as AmountOfMoneyBZ\nimport qualified Duckling.AmountOfMoney.EN.CA.Rules as AmountOfMoneyCA\nimport qualified Duckling.AmountOfMoney.EN.GB.Rules as AmountOfMoneyGB\nimport qualified Duckling.AmountOfMoney.EN.IE.Rules as AmountOfMoneyIE\nimport qualified Duckling.AmountOfMoney.EN.IN.Rules as AmountOfMoneyIN\nimport qualified Duckling.AmountOfMoney.EN.JM.Rules as AmountOfMoneyJM\nimport qualified Duckling.AmountOfMoney.EN.NZ.Rules as AmountOfMoneyNZ\nimport qualified Duckling.AmountOfMoney.EN.PH.Rules as AmountOfMoneyPH\nimport qualified Duckling.AmountOfMoney.EN.TT.Rules as AmountOfMoneyTT\nimport qualified Duckling.AmountOfMoney.EN.US.Rules as AmountOfMoneyUS\nimport qualified Duckling.AmountOfMoney.EN.ZA.Rules as AmountOfMoneyZA\nimport qualified Duckling.Distance.EN.Rules as Distance\nimport qualified Duckling.Duration.EN.Rules as Duration\nimport qualified Duckling.Email.EN.Rules as Email\nimport qualified Duckling.Numeral.EN.Rules as Numeral\nimport qualified Duckling.Ordinal.EN.Rules as Ordinal\nimport qualified Duckling.Quantity.EN.Rules as Quantity\nimport qualified Duckling.Region as R\nimport qualified Duckling.Temperature.EN.Rules as Temperature\nimport qualified Duckling.Time.EN.Rules as Time\nimport qualified Duckling.Time.EN.AU.Rules as TimeAU\nimport qualified Duckling.Time.EN.BZ.Rules as TimeBZ\nimport qualified Duckling.Time.EN.CA.Rules as TimeCA\nimport qualified Duckling.Time.EN.GB.Rules as TimeGB\nimport qualified Duckling.Time.EN.IE.Rules as TimeIE\nimport qualified Duckling.Time.EN.IN.Rules as TimeIN\nimport qualified Duckling.Time.EN.JM.Rules as TimeJM\nimport qualified Duckling.Time.EN.NZ.Rules as TimeNZ\nimport qualified Duckling.Time.EN.PH.Rules as TimePH\nimport qualified Duckling.Time.EN.TT.Rules as TimeTT\nimport qualified Duckling.Time.EN.US.Rules as TimeUS\nimport qualified Duckling.Time.EN.ZA.Rules as TimeZA\nimport qualified Duckling.TimeGrain.EN.Rules as TimeGrain\nimport qualified Duckling.Volume.EN.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules dim@(Seal Time) = TimeUS.rulesBackwardCompatible ++ langRules dim\ndefaultRules dim             = langRules dim\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules AU (Seal AmountOfMoney) = AmountOfMoneyAU.rules\nlocaleRules BZ (Seal AmountOfMoney) = AmountOfMoneyBZ.rules\nlocaleRules R.CA (Seal AmountOfMoney) = AmountOfMoneyCA.rules\nlocaleRules GB (Seal AmountOfMoney) = AmountOfMoneyGB.rules\nlocaleRules IE (Seal AmountOfMoney) = AmountOfMoneyIE.rules\nlocaleRules IN (Seal AmountOfMoney) = AmountOfMoneyIN.rules\nlocaleRules JM (Seal AmountOfMoney) = AmountOfMoneyJM.rules\nlocaleRules NZ (Seal AmountOfMoney) = AmountOfMoneyNZ.rules\nlocaleRules PH (Seal AmountOfMoney) = AmountOfMoneyPH.rules\nlocaleRules TT (Seal AmountOfMoney) = AmountOfMoneyTT.rules\nlocaleRules US (Seal AmountOfMoney) = AmountOfMoneyUS.rules\nlocaleRules ZA (Seal AmountOfMoney) = AmountOfMoneyZA.rules\nlocaleRules AU (Seal Time) = TimeAU.rules\nlocaleRules BZ (Seal Time) = TimeBZ.rules\nlocaleRules R.CA (Seal Time) = TimeCA.rules\nlocaleRules GB (Seal Time) = TimeGB.rules\nlocaleRules IE (Seal Time) = TimeIE.rules\nlocaleRules IN (Seal Time) = TimeIN.rules\nlocaleRules JM (Seal Time) = TimeJM.rules\nlocaleRules NZ (Seal Time) = TimeNZ.rules\nlocaleRules PH (Seal Time) = TimePH.rules\nlocaleRules TT (Seal Time) = TimeTT.rules\nlocaleRules US (Seal Time) = TimeUS.rules\nlocaleRules ZA (Seal Time) = TimeZA.rules\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = Email.rules\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules EN dim\n", "num_lines": 108}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\nmodule Duckling.Rules.ES\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Prelude\n\nimport qualified Duckling.AmountOfMoney.ES.Rules as AmountOfMoney\nimport Duckling.Dimensions.Types\nimport qualified Duckling.Distance.ES.Rules as Distance\nimport Duckling.Locale\nimport qualified Duckling.Numeral.ES.AR.Rules as NumeralAR\nimport qualified Duckling.Numeral.ES.CL.Rules as NumeralCL\nimport qualified Duckling.Numeral.ES.CO.Rules as NumeralCO\nimport qualified Duckling.Numeral.ES.ES.Rules as NumeralES\nimport qualified Duckling.Numeral.ES.MX.Rules as NumeralMX\nimport qualified Duckling.Numeral.ES.PE.Rules as NumeralPE\nimport qualified Duckling.Numeral.ES.Rules as Numeral\nimport qualified Duckling.Numeral.ES.VE.Rules as NumeralVE\nimport qualified Duckling.Ordinal.ES.Rules as Ordinal\nimport qualified Duckling.Region as R\n  ( Region\n      ( AR\n      , ES\n      )\n  )\nimport qualified Duckling.Temperature.ES.Rules as Temperature\nimport qualified Duckling.Time.ES.Rules as Time\nimport qualified Duckling.TimeGrain.ES.Rules as TimeGrain\nimport Duckling.Types\nimport qualified Duckling.Volume.ES.Rules as Volume\nimport qualified Duckling.Duration.ES.Rules as Duration\nimport qualified Duckling.Quantity.ES.Rules as Quantity\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules dim@(Seal Numeral) =\n  NumeralES.rulesBackwardCompatible ++ langRules dim\ndefaultRules dim = langRules dim\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules R.AR (Seal Numeral) = NumeralAR.rules\nlocaleRules CL (Seal Numeral) = NumeralCL.rules\nlocaleRules CO (Seal Numeral) = NumeralCO.rules\nlocaleRules R.ES (Seal Numeral) = NumeralES.rules\nlocaleRules MX (Seal Numeral) = NumeralMX.rules\nlocaleRules PE (Seal Numeral) = NumeralPE.rules\nlocaleRules VE (Seal Numeral) = NumeralVE.rules\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules ES dim\n", "num_lines": 77}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.ET\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.ET.Rules as Numeral\nimport qualified Duckling.Ordinal.ET.Rules as Ordinal\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules ET dim\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.FA\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.FA.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules FA dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.FI\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.FI.Rules as Numeral\nimport qualified Duckling.TimeGrain.FI.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules FI dim\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.FR\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.FR.Rules as AmountOfMoney\nimport qualified Duckling.Distance.FR.Rules as Distance\nimport qualified Duckling.Duration.FR.Rules as Duration\nimport qualified Duckling.Email.FR.Rules as Email\nimport qualified Duckling.Numeral.FR.Rules as Numeral\nimport qualified Duckling.Ordinal.FR.Rules as Ordinal\nimport qualified Duckling.Quantity.FR.Rules as Quantity\nimport qualified Duckling.Temperature.FR.Rules as Temperature\nimport qualified Duckling.Time.FR.Rules as Time\nimport qualified Duckling.TimeGrain.FR.Rules as TimeGrain\nimport qualified Duckling.Volume.FR.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = Email.rules\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules FR dim\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.GA\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.GA.Rules as AmountOfMoney\nimport qualified Duckling.Distance.GA.Rules as Distance\nimport qualified Duckling.Duration.GA.Rules as Duration\nimport qualified Duckling.Numeral.GA.Rules as Numeral\nimport qualified Duckling.Ordinal.GA.Rules as Ordinal\nimport qualified Duckling.Temperature.GA.Rules as Temperature\nimport qualified Duckling.Time.GA.Rules as Time\nimport qualified Duckling.TimeGrain.GA.Rules as TimeGrain\nimport qualified Duckling.Volume.GA.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules GA dim\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.HE\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.HE.Rules as AmountOfMoney\nimport qualified Duckling.Duration.HE.Rules as Duration\nimport qualified Duckling.Numeral.HE.Rules as Numeral\nimport qualified Duckling.Ordinal.HE.Rules as Ordinal\nimport qualified Duckling.TimeGrain.HE.Rules as TimeGrain\nimport qualified Duckling.Time.HE.Rules as Time\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules HE dim\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.HI\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.HI.Rules as Numeral\nimport qualified Duckling.Ordinal.HI.Rules as Ordinal\nimport qualified Duckling.Duration.HI.Rules as Duration\nimport qualified Duckling.TimeGrain.HI.Rules as TimeGrain\nimport qualified Duckling.Temperature.HI.Rules as Temperature\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Email) = []\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules HI dim\n", "num_lines": 49}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.HR\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.HR.Rules as AmountOfMoney\nimport qualified Duckling.Distance.HR.Rules as Distance\nimport qualified Duckling.Duration.HR.Rules as Duration\nimport qualified Duckling.Numeral.HR.Rules as Numeral\nimport qualified Duckling.Ordinal.HR.Rules as Ordinal\nimport qualified Duckling.Quantity.HR.Rules as Quantity\nimport qualified Duckling.Temperature.HR.Rules as Temperature\nimport qualified Duckling.Time.HR.Rules as Time\nimport qualified Duckling.TimeGrain.HR.Rules as TimeGrain\nimport qualified Duckling.Volume.HR.Rules as Volume\n\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules HR dim\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.HU\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Duration.HU.Rules as Duration\nimport qualified Duckling.Numeral.HU.Rules as Numeral\nimport qualified Duckling.Ordinal.HU.Rules as Ordinal\nimport qualified Duckling.Time.HU.Rules as Time\nimport qualified Duckling.TimeGrain.HU.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules HU dim\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.ID\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.ID.Rules as AmountOfMoney\nimport qualified Duckling.Numeral.ID.Rules as Numeral\nimport qualified Duckling.Ordinal.ID.Rules as Ordinal\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules ID dim\n", "num_lines": 48}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.IS\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Email.IS.Rules as Email\nimport qualified Duckling.Numeral.IS.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Email) = Email.rules\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules IS dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.IT\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.IT.Rules as AmountOfMoney\nimport qualified Duckling.Distance.IT.Rules as Distance\nimport qualified Duckling.Duration.IT.Rules as Duration\nimport qualified Duckling.Email.IT.Rules as Email\nimport qualified Duckling.Numeral.IT.Rules as Numeral\nimport qualified Duckling.Ordinal.IT.Rules as Ordinal\nimport qualified Duckling.Temperature.IT.Rules as Temperature\nimport qualified Duckling.Time.IT.Rules as Time\nimport qualified Duckling.TimeGrain.IT.Rules as TimeGrain\nimport qualified Duckling.Volume.IT.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = Email.rules\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules IT dim\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.JA\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Duration.JA.Rules as Duration\nimport qualified Duckling.Numeral.JA.Rules as Numeral\nimport qualified Duckling.Ordinal.JA.Rules as Ordinal\nimport qualified Duckling.Temperature.JA.Rules as Temperature\nimport qualified Duckling.Time.JA.Rules as Time\nimport qualified Duckling.TimeGrain.JA.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules JA dim\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.KA\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.KA.Rules as AmountOfMoney\nimport qualified Duckling.Numeral.KA.Rules as Numeral\nimport qualified Duckling.Time.KA.Rules as Time\nimport qualified Duckling.TimeGrain.KA.Rules as TimeGrain\nimport qualified Duckling.Ordinal.KA.Rules as Ordinal\nimport qualified Duckling.Duration.KA.Rules as Duration\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules KA dim\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.KM\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Distance.KM.Rules as Distance\nimport qualified Duckling.Numeral.KM.Rules as Numeral\nimport qualified Duckling.Ordinal.KM.Rules as Ordinal\nimport qualified Duckling.Quantity.KM.Rules as Quantity\nimport qualified Duckling.Temperature.KM.Rules as Temperature\nimport qualified Duckling.Volume.KM.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules KM dim\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "---Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.KN\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.KN.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Email) = []\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules KN dim\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.KO\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.KO.Rules as AmountOfMoney\nimport qualified Duckling.Distance.KO.Rules as Distance\nimport qualified Duckling.Duration.KO.Rules as Duration\nimport qualified Duckling.Numeral.KO.Rules as Numeral\nimport qualified Duckling.Ordinal.KO.Rules as Ordinal\nimport qualified Duckling.Quantity.KO.Rules as Quantity\nimport qualified Duckling.Temperature.KO.Rules as Temperature\nimport qualified Duckling.Time.KO.Rules as Time\nimport qualified Duckling.TimeGrain.KO.Rules as TimeGrain\nimport qualified Duckling.Volume.KO.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules KO dim\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.LO\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.LO.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules LO dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.ML\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.ML.Rules as Numeral\nimport qualified Duckling.Ordinal.ML.Rules as Ordinal\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules ML dim\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.MN\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.MN.Rules as AmountOfMoney\nimport qualified Duckling.Distance.MN.Rules as Distance\nimport qualified Duckling.Duration.MN.Rules as Duration\nimport qualified Duckling.Numeral.MN.Rules as Numeral\nimport qualified Duckling.Ordinal.MN.Rules as Ordinal\nimport qualified Duckling.Quantity.MN.Rules as Quantity\nimport qualified Duckling.TimeGrain.MN.Rules as TimeGrain\nimport qualified Duckling.Volume.MN.Rules as Volume\nimport qualified Duckling.Temperature.MN.Rules as Temperature\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules MN dim\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.MY\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.MY.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules MY dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.NB\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.NB.Rules as AmountOfMoney\nimport qualified Duckling.Duration.NB.Rules as Duration\nimport qualified Duckling.Numeral.NB.Rules as Numeral\nimport qualified Duckling.Ordinal.NB.Rules as Ordinal\nimport qualified Duckling.Time.NB.Rules as Time\nimport qualified Duckling.TimeGrain.NB.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules NB dim\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.NE\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.NE.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Email) = []\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules NE dim\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.NL\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.NL.Rules as AmountOfMoney\nimport qualified Duckling.Distance.NL.Rules as Distance\nimport qualified Duckling.Duration.NL.Rules as Duration\nimport qualified Duckling.Numeral.NL.Rules as Numeral\nimport qualified Duckling.Ordinal.NL.Rules as Ordinal\nimport qualified Duckling.Quantity.NL.Rules as Quantity\nimport qualified Duckling.Time.NL.Rules as Time\nimport qualified Duckling.Time.NL.BE.Rules as TimeBE\nimport qualified Duckling.Time.NL.NL.Rules as TimeNL\nimport qualified Duckling.TimeGrain.NL.Rules as TimeGrain\nimport qualified Duckling.Volume.NL.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules dim@(Seal Time) = TimeNL.rulesBackwardCompatible ++ langRules dim\ndefaultRules dim = langRules dim\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules BE (Seal Time) = TimeBE.rules\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules NL dim\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.PL\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Duration.PL.Rules as Duration\nimport qualified Duckling.Numeral.PL.Rules as Numeral\nimport qualified Duckling.Ordinal.PL.Rules as Ordinal\nimport qualified Duckling.Time.PL.Rules as Time\nimport qualified Duckling.TimeGrain.PL.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules PL dim\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.PT\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.PT.Rules as AmountOfMoney\nimport qualified Duckling.Distance.PT.Rules as Distance\nimport qualified Duckling.Numeral.PT.Rules as Numeral\nimport qualified Duckling.Ordinal.PT.Rules as Ordinal\nimport qualified Duckling.PhoneNumber.PT.Rules as PhoneNumber\nimport qualified Duckling.Quantity.PT.Rules as Quantity\nimport qualified Duckling.Temperature.PT.Rules as Temperature\nimport qualified Duckling.Time.PT.Rules as Time\nimport qualified Duckling.TimeGrain.PT.Rules as TimeGrain\nimport qualified Duckling.Volume.PT.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = PhoneNumber.rules\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules PT dim\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.RO\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.RO.Rules as AmountOfMoney\nimport qualified Duckling.Distance.RO.Rules as Distance\nimport qualified Duckling.Duration.RO.Rules as Duration\nimport qualified Duckling.Numeral.RO.Rules as Numeral\nimport qualified Duckling.Ordinal.RO.Rules as Ordinal\nimport qualified Duckling.Quantity.RO.Rules as Quantity\nimport qualified Duckling.Temperature.RO.Rules as Temperature\nimport qualified Duckling.Time.RO.Rules as Time\nimport qualified Duckling.TimeGrain.RO.Rules as TimeGrain\nimport qualified Duckling.Volume.RO.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules RO dim\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.RU\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.RU.Rules as AmountOfMoney\nimport qualified Duckling.Distance.RU.Rules as Distance\nimport qualified Duckling.Duration.RU.Rules as Duration\nimport qualified Duckling.Numeral.RU.Rules as Numeral\nimport qualified Duckling.Ordinal.RU.Rules as Ordinal\nimport qualified Duckling.Quantity.RU.Rules as Quantity\nimport qualified Duckling.Time.RU.Rules as Time\nimport qualified Duckling.TimeGrain.RU.Rules as TimeGrain\nimport qualified Duckling.Volume.RU.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules RU dim\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.SK\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.SK.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules SK dim\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.SV\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.SV.Rules as AmountOfMoney\nimport qualified Duckling.Duration.SV.Rules as Duration\nimport qualified Duckling.Distance.SV.Rules as Distance\nimport qualified Duckling.Ordinal.SV.Rules as Ordinal\nimport qualified Duckling.Numeral.SV.Rules as Numeral\nimport qualified Duckling.Time.SV.Rules as Time\nimport qualified Duckling.TimeGrain.SV.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules SV dim\n", "num_lines": 52}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.SW\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.SW.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules SW dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.TA\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.TA.Rules as Numeral\nimport qualified Duckling.Ordinal.TA.Rules as Ordinal\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Email) = []\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules TA dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Rules.TE\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.TE.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules TE dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.TH\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Numeral.TH.Rules as Numeral\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = []\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = []\nlangRules (Seal TimeGrain) = []\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules TH dim\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.TR\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Distance.TR.Rules as Distance\nimport qualified Duckling.Duration.TR.Rules as Duration\nimport qualified Duckling.Numeral.TR.Rules as Numeral\nimport qualified Duckling.Ordinal.TR.Rules as Ordinal\nimport qualified Duckling.Temperature.TR.Rules as Temperature\nimport qualified Duckling.Time.TR.Rules as Time\nimport qualified Duckling.TimeGrain.TR.Rules as TimeGrain\nimport qualified Duckling.Volume.TR.Rules as Volume\nimport qualified Duckling.AmountOfMoney.TR.Rules as AmountOfMoney\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules TR dim\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.UK\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.Duration.UK.Rules as Duration\nimport qualified Duckling.Numeral.UK.Rules as Numeral\nimport qualified Duckling.Ordinal.UK.Rules as Ordinal\nimport qualified Duckling.Time.UK.Rules as Time\nimport qualified Duckling.TimeGrain.UK.Rules as TimeGrain\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = []\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules UK dim\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.VI\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.VI.Rules as AmountOfMoney\nimport qualified Duckling.Numeral.VI.Rules as Numeral\nimport qualified Duckling.Ordinal.VI.Rules as Ordinal\nimport qualified Duckling.TimeGrain.VI.Rules as TimeGrain\nimport qualified Duckling.Time.VI.Rules as Time\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = []\nlangRules (Seal Duration) = []\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = []\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = []\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = []\nlangRules (Seal (CustomDimension dim)) = dimLangRules VI dim\n", "num_lines": 50}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Rules.ZH\n  ( defaultRules\n  , langRules\n  , localeRules\n  ) where\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Types\nimport qualified Duckling.AmountOfMoney.ZH.Rules as AmountOfMoney\nimport qualified Duckling.Distance.ZH.Rules as Distance\nimport qualified Duckling.Duration.ZH.Rules as Duration\nimport qualified Duckling.Numeral.ZH.Rules as Numeral\nimport qualified Duckling.Ordinal.ZH.Rules as Ordinal\nimport qualified Duckling.Quantity.ZH.Rules as Quantity\nimport qualified Duckling.Temperature.ZH.Rules as Temperature\nimport qualified Duckling.Time.ZH.Rules as Time\nimport qualified Duckling.Time.ZH.CN.Rules as TimeCN\nimport qualified Duckling.Time.ZH.HK.Rules as TimeHK\nimport qualified Duckling.Time.ZH.MO.Rules as TimeMO\nimport qualified Duckling.Time.ZH.TW.Rules as TimeTW\nimport qualified Duckling.TimeGrain.ZH.Rules as TimeGrain\nimport qualified Duckling.Volume.ZH.Rules as Volume\n\ndefaultRules :: Seal Dimension -> [Rule]\ndefaultRules = langRules\n\nlocaleRules :: Region -> Seal Dimension -> [Rule]\nlocaleRules CN (Seal Time) = TimeCN.rules\nlocaleRules HK (Seal Time) = TimeHK.rules\nlocaleRules MO (Seal Time) = TimeMO.rules\nlocaleRules TW (Seal Time) = TimeTW.rules\nlocaleRules region (Seal (CustomDimension dim)) = dimLocaleRules region dim\nlocaleRules _ _ = []\n\nlangRules :: Seal Dimension -> [Rule]\nlangRules (Seal AmountOfMoney) = AmountOfMoney.rules\nlangRules (Seal CreditCardNumber) = []\nlangRules (Seal Distance) = Distance.rules\nlangRules (Seal Duration) = Duration.rules\nlangRules (Seal Email) = []\nlangRules (Seal Numeral) = Numeral.rules\nlangRules (Seal Ordinal) = Ordinal.rules\nlangRules (Seal PhoneNumber) = []\nlangRules (Seal Quantity) = Quantity.rules\nlangRules (Seal RegexMatch) = []\nlangRules (Seal Temperature) = Temperature.rules\nlangRules (Seal Time) = Time.rules\nlangRules (Seal TimeGrain) = TimeGrain.rules\nlangRules (Seal Url) = []\nlangRules (Seal Volume) = Volume.rules\nlangRules (Seal (CustomDimension dim)) = dimLangRules ZH dim\n", "num_lines": 63}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\nmodule Duckling.Temperature.Helpers\n  ( isLatent\n  , isValueOnly\n  , isSimpleTemperature\n  , withUnit\n  , withInterval\n  , withValue\n  , valueOnly\n  , unitOnly\n  , withMin\n  , withMax\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.Temperature.Types as TTemperature\nimport Duckling.Temperature.Types (TemperatureData(..))\nimport Duckling.Types hiding (isLatent)\n\n-- -----------------------------------------------------------------\n-- Patterns\n\nisLatent :: Predicate\nisLatent (Token Temperature TemperatureData{TTemperature.unit = Nothing}) =\n  True\nisLatent _ = False\n\nisValueOnly :: Bool -> Predicate\nisValueOnly allowDegree (Token Temperature TemperatureData\n                         { TTemperature.unit = u, TTemperature.value = Just _\n                         , TTemperature.minValue = Nothing\n                         , TTemperature.maxValue = Nothing})\n      = isNothing u || (allowDegree && u == Just TTemperature.Degree)\nisValueOnly _ _ = False\n\nisSimpleTemperature :: Predicate\nisSimpleTemperature (Token Temperature TemperatureData\n                      {TTemperature.value = Just _}) = True\nisSimpleTemperature _ = False\n\n-- -----------------------------------------------------------------\n-- Production\n\nwithUnit :: TTemperature.TemperatureUnit -> TemperatureData -> TemperatureData\nwithUnit u td = td {TTemperature.unit = Just u}\n\nwithInterval :: (Double, Double) -> TemperatureData -> TemperatureData\nwithInterval (from, to) td = td\n  { TTemperature.value = Nothing\n  , TTemperature.minValue = Just from\n  , TTemperature.maxValue = Just to\n  }\n\nwithValue :: Double -> TemperatureData -> TemperatureData\nwithValue v td = td\n  { TTemperature.value = Just v\n  , TTemperature.minValue = Nothing\n  , TTemperature.maxValue = Nothing\n  }\n\nvalueOnly :: Double -> TemperatureData\nvalueOnly v = TemperatureData\n  { TTemperature.unit = Nothing\n  , TTemperature.value = Just v\n  , TTemperature.minValue = Nothing\n  , TTemperature.maxValue = Nothing\n  }\n\nunitOnly :: TTemperature.TemperatureUnit -> TemperatureData\nunitOnly u = TemperatureData\n  { TTemperature.unit = Just u\n  , TTemperature.value = Nothing\n  , TTemperature.minValue = Nothing\n  , TTemperature.maxValue = Nothing\n  }\n\nwithMax :: Double -> TemperatureData -> TemperatureData\nwithMax v td = td\n  { TTemperature.value = Nothing\n  , TTemperature.minValue = Nothing\n  , TTemperature.maxValue = Just v\n  }\n\nwithMin :: Double -> TemperatureData -> TemperatureData\nwithMin v td = td\n  { TTemperature.value = Nothing\n  , TTemperature.minValue = Just v\n  , TTemperature.maxValue = Nothing\n  }\n", "num_lines": 101}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Temperature.Types as TTemperature\n\nruleNumeralAsTemp :: Rule\nruleNumeralAsTemp = Rule\n  { name = \"number as temp\"\n  , pattern =\n    [ dimension Numeral\n    ]\n  , prod = \\case\n      (Token Numeral nd:_) ->\n        Just . Token Temperature $ valueOnly $ TNumeral.value nd\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNumeralAsTemp\n  ]\n", "num_lines": 42}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Temperature.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\nimport qualified Data.HashMap.Strict as H\nimport qualified Data.Text as Text\n\nimport Duckling.Resolve (Resolve(..))\n\ndata TemperatureUnit =\n  Degree | Celsius | Fahrenheit\n  deriving (Eq, Generic, Hashable, Show, Ord, NFData)\n\ninstance ToJSON TemperatureUnit where\n  toJSON = String . Text.toLower . Text.pack . show\n\ndata TemperatureData = TemperatureData\n  { unit     :: Maybe TemperatureUnit\n  , value    :: Maybe Double\n  , minValue :: Maybe Double\n  , maxValue :: Maybe Double\n  } deriving (Eq, Generic, Hashable, Show, Ord, NFData)\n\ninstance Resolve TemperatureData where\n  type ResolvedValue TemperatureData = TemperatureValue\n  resolve _ _ TemperatureData {unit = Nothing} = Nothing\n  resolve _ _ TemperatureData {unit = Just unit, value = Just value} =\n    Just (simple unit value, False)\n  resolve _ _ TemperatureData {unit = Just unit, minValue = Just from\n                              , maxValue = Just to} =\n    Just (between unit (from, to), False)\n  resolve _ _ TemperatureData {unit = Just unit, minValue = Just from} =\n    Just (above unit from, False)\n  resolve _ _ TemperatureData {unit = Just unit, maxValue = Just to} =\n    Just (under unit to, False)\n  resolve _ _ _ = Nothing\n\ndata IntervalDirection = Above | Under\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ndata SingleValue = SingleValue\n  { vUnit :: TemperatureUnit\n  , vValue :: Double\n  }\n  deriving (Eq, Show)\n\ninstance ToJSON SingleValue where\n  toJSON (SingleValue unit value) = object\n    [ \"value\" .= value\n    , \"unit\"  .= unit\n    ]\n\ndata TemperatureValue\n  = SimpleValue SingleValue\n  | IntervalValue (SingleValue, SingleValue)\n  | OpenIntervalValue (SingleValue, IntervalDirection)\n  deriving (Show, Eq)\n\ninstance ToJSON TemperatureValue where\n  toJSON (SimpleValue value) = case toJSON value of\n    Object o -> Object $ H.insert \"type\" (toJSON (\"value\" :: Text)) o\n    _        -> Object H.empty\n  toJSON (IntervalValue (from, to)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    , \"to\"   .= toJSON to\n    ]\n  toJSON (OpenIntervalValue (from, Above)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    ]\n  toJSON (OpenIntervalValue (to, Under)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"to\"   .= toJSON to\n    ]\n\n-- -----------------------------------------------------------------\n-- Value helpers\n\nsimple :: TemperatureUnit -> Double -> TemperatureValue\nsimple u v = SimpleValue $ single u v\n\nbetween :: TemperatureUnit -> (Double, Double) -> TemperatureValue\nbetween u (from, to) = IntervalValue (single u from, single u to)\n\nabove :: TemperatureUnit -> Double -> TemperatureValue\nabove = openInterval Above\n\nunder :: TemperatureUnit -> Double -> TemperatureValue\nunder = openInterval Under\n\nopenInterval :: IntervalDirection -> TemperatureUnit -> Double -> TemperatureValue\nopenInterval direction u v = OpenIntervalValue (single u v, direction)\n\nsingle :: TemperatureUnit -> Double -> SingleValue\nsingle u v = SingleValue {vUnit = u, vValue = v}\n\nunitsAreCompatible :: Maybe TemperatureUnit -> TemperatureUnit -> Bool\nunitsAreCompatible (Just u1) u2 = u1 == u2\nunitsAreCompatible Nothing _ = True\n", "num_lines": 119}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.CA.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale CA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 graus Celsius\"\n             , \"37 graus C\"\n             , \"37 cent\u00c3\u00adgrads\"\n             , \"37 graus cent\u00c3\u00adgrads\"\n             , \"37 Celsius\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 graus F\"\n             , \"setanta Fahrenheit\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 graus\"\n             ]\n  , examples (simple Degree 37)\n             [ \"trenta-set graus\"\n             , \"37 grads\"\n             ]\n  , examples (simple Degree (-10))\n             [ \"-10\u00c2\u00b0\"\n             , \"- deu graus\"\n             , \"10 sota zero\"\n             ]\n  ]\n", "num_lines": 55}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.CA.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport qualified Duckling.Temperature.Types as TTemperature\nimport Duckling.Types\n\nruleLatentTempTemp :: Rule\nruleLatentTempTemp = Rule\n  { name = \"<latent temp> temp\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"(gra(d|u)s?|\u00c2\u00b0)\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) ->\n        Just $ Token Temperature $ withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelsius :: Rule\nruleTempCelsius = Rule\n  { name = \"<temp> Celsius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"(cent(i|\u00c3\u00ad)gra(d|u)s?|(C|c)(el[cs]?(ius)?)?\\\\.?)\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) ->\n        Just $ Token Temperature $ withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?reh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just $ Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nruleLatentTempTempBajoCero :: Rule\nruleLatentTempTempBajoCero = Rule\n  { name = \"<latent temp> temp bajo zero\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"sota zero\"\n    ]\n  , prod = \\case\n      (Token Temperature td@TemperatureData{TTemperature.value = Just v}:_) ->\n        case TTemperature.unit td of\n          Nothing -> Just $ Token Temperature $ withUnit TTemperature.Degree $\n            td {TTemperature.value = Just (- v)}\n          _ -> Just $ Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempTemp\n  , ruleLatentTempTempBajoCero\n  , ruleTempCelsius\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 86}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.EN.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 degrees Celsius\"\n             , \"thirty seven celsius\"\n             , \"37 degrees Celsius\"\n             , \"thirty seven celsius\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 degrees F\"\n             , \"seventy Fahrenheit\"\n             ]\n  , examples (simple Fahrenheit 98.6)\n             [ \"98.6\u00c2\u00b0F\"\n             , \"98.6 \u00c2\u00b0 Fahrenheit\"\n             , \"98.6 degrees F\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 degrees\"\n             , \"45 deg.\"\n             ]\n  , examples (simple Degree (-2))\n             [ \"-2\u00c2\u00b0\"\n             , \"- 2 degrees\"\n             , \"2 degrees below zero\"\n             , \"2 below zero\"\n             ]\n  , examples (between Degree (30, 40))\n             [ \"between 30 and 40 degrees\"\n             , \"from 30 degrees to 40 degrees\"\n             ]\n  , examples (between Celsius (30, 40))\n             [ \"between 30 and 40 celsius\"\n             , \"from 30 celsius and 40 celsius\"\n             , \"between 30 and 40 degrees celsius\"\n             , \"from 30 degrees celsius to 40 degrees celsius\"\n             , \"30-40 degrees celsius\"\n             ]\n    , examples (above Degree 40)\n             [ \"over 40 degrees\"\n             , \"at least 40 degrees\"\n             , \"more than 40 degrees\"\n             ]\n    , examples (under Degree 40)\n             [ \"under 40 degrees\"\n             , \"less than 40 degrees\"\n             , \"lower than 40 degrees\"\n             ]\n  ]\n", "num_lines": 77}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.EN.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData(..), unitsAreCompatible)\nimport Duckling.Types\nimport qualified Duckling.Temperature.Types as TTemperature\n\nruleTemperatureDegrees :: Rule\nruleTemperatureDegrees = Rule\n  { name = \"<latent temp> degrees\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"(deg(ree?)?s?\\\\.?)|\u00c2\u00b0\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTemperatureCelsius :: Rule\nruleTemperatureCelsius = Rule\n  { name = \"<temp> Celsius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"c(el[cs]?(ius)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTemperatureFahrenheit :: Rule\nruleTemperatureFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?rh?eh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nruleTemperatureBelowZero :: Rule\nruleTemperatureBelowZero = Rule\n  { name = \"<temp> below zero\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"below zero\"\n    ]\n  , prod = \\case\n      (Token Temperature td@TemperatureData {TTemperature.value = Just v}:\n       _) -> case TTemperature.unit td of\n        Nothing -> Just . Token Temperature . withUnit TTemperature.Degree $\n          td {TTemperature.value = Just (- v)}\n        _ -> Just . Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <temp> and|to <temp>\"\n  , pattern =\n    [ regex \"between|from\"\n    , Predicate isSimpleTemperature\n    , regex \"to|and\"\n    , Predicate isSimpleTemperature\n    ]\n  , prod = \\case\n      (_:\n       Token Temperature TemperatureData\n        {TTemperature.unit = u1 , TTemperature.value = Just from}:\n       _:\n       Token Temperature TemperatureData\n        {TTemperature.unit = Just u2, TTemperature.value = Just to}:\n       _) | from < to && unitsAreCompatible u1 u2 ->\n        Just . Token Temperature . withInterval (from, to) $ unitOnly u2\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<temp> - <temp>\"\n  , pattern =\n    [ Predicate isSimpleTemperature\n    , regex \"-\"\n    , Predicate isSimpleTemperature\n    ]\n  , prod = \\case\n      (Token Temperature TemperatureData\n        {TTemperature.unit = u1, TTemperature.value = Just from}:\n       _:\n       Token Temperature TemperatureData\n        {TTemperature.unit = Just u2, TTemperature.value = Just to}:\n       _) | from < to && unitsAreCompatible u1 u2 ->\n        Just . Token Temperature . withInterval (from, to) $ unitOnly u2\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"under/less/lower/no more than <temp>\"\n  , pattern =\n    [ regex \"under|(less|lower|not? more) than\"\n    , Predicate isSimpleTemperature\n    ]\n  , prod = \\case\n      (_:\n       Token Temperature TemperatureData{TTemperature.value = Just to,\n                                         TTemperature.unit = Just u}:\n       _) -> Just . Token Temperature . withMax to $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"over/above/at least/more than <temp>\"\n  , pattern =\n    [ regex \"over|above|at least|more than\"\n    , Predicate isSimpleTemperature\n    ]\n  , prod = \\case\n      (_:\n       Token Temperature TemperatureData{TTemperature.value = Just from,\n                                         TTemperature.unit = Just u}:\n       _) -> Just . Token Temperature . withMin from $ unitOnly u\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleTemperatureDegrees\n  , ruleTemperatureCelsius\n  , ruleTemperatureFahrenheit\n  , ruleTemperatureBelowZero\n  , ruleIntervalBetween\n  , ruleIntervalDash\n  , ruleIntervalMin\n  , ruleIntervalMax\n  ]\n", "num_lines": 162}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.ES.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ES Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 grados Celsius\"\n             , \"37 grados C\"\n             , \"treinta y siete celsius\"\n             , \"37 cent\u00c3\u00adgrados\"\n             , \"37 grados cent\u00c3\u00adgrados\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 grados F\"\n             , \"setenta Fahrenheit\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 grados\"\n             ]\n  , examples (simple Degree (-10))\n             [ \"-10\u00c2\u00b0\"\n             , \"- diez grados\"\n             , \"10 bajo cero\"\n             ]\n  ]\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.ES.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport qualified Duckling.Temperature.Types as TTemperature\nimport Duckling.Types\n\nruleLatentTempTemp :: Rule\nruleLatentTempTemp = Rule\n  { name = \"<latent temp> temp\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"(grados?)|\u00c2\u00b0\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelsius :: Rule\nruleTempCelsius = Rule\n  { name = \"<temp> Celsius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"(cent(i|\u00c3\u00ad)grados?|c(el[cs]?(ius)?)?\\\\.?)\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?reh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nruleLatentTempTempBajoCero :: Rule\nruleLatentTempTempBajoCero = Rule\n  { name = \"<latent temp> temp bajo cero\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"bajo cero\"\n    ]\n  , prod = \\case\n      (Token Temperature td@TemperatureData{TTemperature.value = Just v}:_) ->\n        case TTemperature.unit td of\n          Nothing -> Just . Token Temperature . withUnit TTemperature.Degree $\n            td {TTemperature.value = Just (- v)}\n          _ -> Just . Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempTemp\n  , ruleLatentTempTempBajoCero\n  , ruleTempCelsius\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 86}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.FR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 degres Celsius\"\n             , \"37 degr\u00c3\u00a9 C\"\n             , \"trente sept celsius\"\n             , \"37 degr\u00c3\u00a9 C\"\n             , \"trente sept celsius\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 degr\u00c3\u00a8s F\"\n             , \"soixante-dix Fahrenheit\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 degr\u00c3\u00a9s\"\n             , \"45 deg.\"\n             ]\n  , examples (simple Degree (-10))\n             [ \"-10\u00c2\u00b0\"\n             , \"- 10 degres\"\n             , \"10 degres en dessous de zero\"\n             , \"10 en dessous de zero\"\n             ]\n  ]\n", "num_lines": 53}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.FR.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport qualified Duckling.Temperature.Types as TTemperature\nimport Duckling.Types\n\nruleLatentTempDegrees :: Rule\nruleLatentTempDegrees = Rule\n  { name = \"<latent temp> degrees\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"(deg(r(\u00c3\u00a9|e|\u00c3\u00a8))?s?\\\\.?)|\u00c2\u00b0\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelsius :: Rule\nruleTempCelsius = Rule\n  { name = \"<temp> Celsius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"c(el[cs]?(ius)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?reh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nruleLatentTempEnDessousDeZero :: Rule\nruleLatentTempEnDessousDeZero = Rule\n  { name = \"<latent temp> en dessous de zero\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"en dessous de (0|z(\u00c3\u00a9|e)ro)\"\n    ]\n  , prod = \\case\n      (Token Temperature td@TemperatureData{TTemperature.value = Just v}:_) ->\n        case TTemperature.unit td of\n          Nothing -> Just . Token Temperature . withUnit TTemperature.Degree $\n            td {TTemperature.value = Just (- v)}\n          _ -> Just . Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempDegrees\n  , ruleLatentTempEnDessousDeZero\n  , ruleTempCelsius\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 86}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.GA.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 c\u00c3\u00a9imeanna Celsius\"\n             , \"37 c\u00c3\u00a9imeanna C\"\n             , \"37 c\u00c3\u00a9imeanna ceinteagr\u00c3\u00a1d\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 c\u00c3\u00a9imeanna F\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 c\u00c3\u00a9imeanna\"\n             ]\n  , examples (simple Degree (-10))\n             [ \"-10\u00c2\u00b0\"\n             , \"- 10 c\u00c3\u00a9imeanna\"\n             , \"10 c\u00c3\u00a9imeanna faoi bhun n\u00c3\u00a1id\"\n             , \"10 faoi bhun n\u00c3\u00a1id\"\n             ]\n  ]\n", "num_lines": 49}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.GA.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport qualified Duckling.Temperature.Types as TTemperature\nimport Duckling.Types\n\nruleLatentTempCim :: Rule\nruleLatentTempCim = Rule\n  { name = \"<latent temp> c\u00c3\u00a9im\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"g?ch?(\u00c3\u00a9|e)im(e(anna)?)?|\u00c2\u00b0\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelsius :: Rule\nruleTempCelsius = Rule\n  { name = \"<temp> Celsius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"ceinteagr(\u00c3\u00a1|a)d|c(el[cs]?(ius)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?reh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nruleLatentTempFaoiBhunNid :: Rule\nruleLatentTempFaoiBhunNid = Rule\n  { name = \"<latent temp> faoi bhun n\u00c3\u00a1id\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"faoi bhun (0|n(a|\u00c3\u00a1)id)\"\n    ]\n  , prod = \\case\n      (Token Temperature td@TemperatureData{TTemperature.value = Just v}:_) ->\n        case TTemperature.unit td of\n          Nothing -> Just . Token Temperature . withUnit TTemperature.Degree $\n            td {TTemperature.value = Just (- v)}\n          _ -> Just . Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempCim\n  , ruleLatentTempFaoiBhunNid\n  , ruleTempCelsius\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 86}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.HR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celzija\"\n             , \"37 stupnjeva Celzija\"\n             , \"trideset i sedam celzija\"\n             , \"37 stupnjeva Celzija\"\n             , \"trideset sedam celzija\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 stupnjeva F\"\n             , \"sedamdeset Fahrenheit\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 stupnjeva\"\n             , \"45 deg.\"\n             ]\n  ]\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.HR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport Duckling.Types\nimport qualified Duckling.Temperature.Types as TTemperature\n\nruleLatentTempStupnjevi :: Rule\nruleLatentTempStupnjevi = Rule\n  { name = \"<latent temp> stupnjevi\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"deg\\\\.?|stupa?nj((ev)?a)?|\u00c2\u00b0\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelzij :: Rule\nruleTempCelzij = Rule\n  { name = \"<temp> Celzij\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"c(elz?(ija?)?)?\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?rh?eh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempStupnjevi\n  , ruleTempCelzij\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 67}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.IT.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 \u00c2\u00b0 centigradi\"\n             , \"37 gradi Celsius\"\n             , \"37 gradi Centigradi\"\n             , \"trentasette celsius\"\n             , \"trentasette gradi centigradi\"\n             ]\n  , examples (simple Celsius 1)\n             [ \"1 grado centigrado\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 gradi F\"\n             , \"70 gradi Fahreneit\"\n             , \"settanta Fahrenheit\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 gradi\"\n             ]\n  , examples (simple Degree 1)\n             [ \"1 grado\"\n             ]\n  ]\n", "num_lines": 52}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.IT.Rules\n  ( rules ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport Duckling.Types\nimport qualified Duckling.Temperature.Types as TTemperature\n\nruleLatentTempDegrees :: Rule\nruleLatentTempDegrees = Rule\n  { name = \"<latent temp> degrees\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"(grad[io]?\\\\.?)|\u00c2\u00b0\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelcius :: Rule\nruleTempCelcius = Rule\n  { name = \"<temp> Celcius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"(c((el[cs]?(ius)?)|(entigrad[io]))?\\\\.?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?rh?eh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempDegrees\n  , ruleTempCelcius\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 67}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.PT.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 graus Celsius\"\n             , \"37 graus C\"\n             , \"trinta e sete celsius\"\n             , \"37 cent\u00c3\u00adgrados\"\n             , \"37 graus centigrados\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 graus F\"\n             , \"setenta Fahrenheit\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 graus\"\n             ]\n  , examples (simple Degree (-10))\n             [ \"-10\u00c2\u00b0\"\n             , \"- dez graus\"\n             , \"10 abaixo de zero\"\n             ]\n  ]\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.PT.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Temperature.Types (TemperatureData (..))\nimport qualified Duckling.Temperature.Types as TTemperature\nimport Duckling.Types\n\nruleLatentTempTemp :: Rule\nruleLatentTempTemp = Rule\n  { name = \"<latent temp> temp\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"(graus?)|\u00c2\u00b0\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelsius :: Rule\nruleTempCelsius = Rule\n  { name = \"<temp> Celsius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"(cent(i|\u00c3\u00ad)grados?|c(el[cs]?(ius)?)?\\\\.?)\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ah?reh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nruleLatentTempTempAbaixoDeZero :: Rule\nruleLatentTempTempAbaixoDeZero = Rule\n  { name = \"<latent temp> temp abaixo de zero\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"((graus?)|\u00c2\u00b0)?( abaixo (de)? zero)\"\n    ]\n  , prod = \\case\n      (Token Temperature td@TemperatureData{TTemperature.value = Just v}:_) ->\n        case TTemperature.unit td of\n          Nothing -> Just . Token Temperature . withUnit TTemperature.Degree $\n            td {TTemperature.value = Just (- v)}\n          _ -> Just . Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempTemp\n  , ruleLatentTempTempAbaixoDeZero\n  , ruleTempCelsius\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 86}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.RO.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 celsius\"\n             , \"37 grade Celsius\"\n             , \"treizeci si sapte celsius\"\n             , \"37 grade Celsius\"\n             , \"37 de grade de Celsius\"\n             , \"treizeci si sapte celsius\"\n             , \"treizeci si sapte de celsius\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenheit\"\n             , \"70 grade F\"\n             , \"saptezeci Fahrenheit\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 grade\"\n             , \"45 de grade\"\n             ]\n  ]\n", "num_lines": 49}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.RO.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport Duckling.Types\nimport qualified Duckling.Temperature.Types as TTemperature\n\nruleLatentTempGrade :: Rule\nruleLatentTempGrade = Rule\n  { name = \"<latent temp> grade\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"(de )?(grade)|\u00c2\u00b0\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Degree td\n      _ -> Nothing\n  }\n\nruleTempCelcius :: Rule\nruleTempCelcius = Rule\n  { name = \"<temp> Celcius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"(de )?c(el[cs]?(ius)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Celsius td\n      _ -> Nothing\n  }\n\nruleTempFahrenheit :: Rule\nruleTempFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"(de )?f(ah?rh?eh?n(h?eit)?)?\\\\.?\"\n    ]\n  , prod = \\case\n      (Token Temperature td:_) -> Just . Token Temperature $\n        withUnit TTemperature.Fahrenheit td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleLatentTempGrade\n  , ruleTempCelcius\n  , ruleTempFahrenheit\n  ]\n", "num_lines": 69}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.TR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Temperature.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale TR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Celsius 37)\n             [ \"37\u00c2\u00b0C\"\n             , \"37 \u00c2\u00b0 santigrat\"\n             , \"37 derece C\"\n             , \"37 C\"\n             , \"37 derece santigrat\"\n             , \"otuz yedi santigrat\"\n             ]\n  , examples (simple Fahrenheit 70)\n             [ \"70\u00c2\u00b0F\"\n             , \"70 \u00c2\u00b0 Fahrenhayt\"\n             , \"70 \u00c2\u00b0 Fahrenayt\"\n             , \"70 derece fahrenhayt\"\n             , \"70 derece F\"\n             , \"70 F\"\n             , \"yetmi\u00c5\u0178 fahrenayt\"\n             ]\n  , examples (simple Degree 45)\n             [ \"45\u00c2\u00b0\"\n             , \"45 derece\"\n             , \"k\u00c4\u00b1rk be\u00c5\u0178 derece\"\n             ]\n  , examples (simple Degree (-2))\n             [ \"-2\u00c2\u00b0\"\n             , \"- 2 derece\"\n             , \"s\u00c4\u00b1f\u00c4\u00b1r\u00c4\u00b1n alt\u00c4\u00b1nda 2\u00c2\u00b0\"\n             , \"s\u00c4\u00b1f\u00c4\u00b1r\u00c4\u00b1n alt\u00c4\u00b1nda 2 derece\"\n             , \"2\u00c2\u00b0 s\u00c4\u00b1f\u00c4\u00b1r\u00c4\u00b1n alt\u00c4\u00b1nda\"\n             , \"2 derece s\u00c4\u00b1f\u00c4\u00b1r\u00c4\u00b1n alt\u00c4\u00b1nda\"\n             ]\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Temperature.TR.Rules\n  ( rules ) where\n\nimport Data.Maybe\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.Helpers\nimport qualified Duckling.Temperature.Types as TTemperature\nimport Duckling.Temperature.Types (TemperatureData(..))\nimport Duckling.Types\n\nruleTemperatureDegrees :: Rule\nruleTemperatureDegrees = Rule\n  { name = \"<latent temp> degrees\"\n  , pattern =\n    [ Predicate $ isValueOnly False\n    , regex \"derece|\u00c2\u00b0\"\n    ]\n  , prod = \\case\n    (Token Temperature td:_) -> Just . Token Temperature $\n      withUnit TTemperature.Degree td\n    _ -> Nothing\n  }\n\nruleTemperatureCelsius :: Rule\nruleTemperatureCelsius = Rule\n  { name = \"<temp> Celsius\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"c|santigrat\"\n    ]\n  , prod = \\case\n    (Token Temperature td:_) -> Just . Token Temperature $\n      withUnit TTemperature.Celsius td\n    _ -> Nothing\n  }\n\nruleTemperatureFahrenheit :: Rule\nruleTemperatureFahrenheit = Rule\n  { name = \"<temp> Fahrenheit\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"f(ahrenh?ayt)?\"\n    ]\n  , prod = \\case\n    (Token Temperature td:_) -> Just . Token Temperature $\n      withUnit TTemperature.Fahrenheit td\n    _ -> Nothing\n  }\n\nruleTemperatureBelowZero :: Rule\nruleTemperatureBelowZero = Rule\n  { name = \"below zero <temp>\"\n  , pattern =\n    [ regex \"s\\305f\\305r\\305n alt\\305nda\"\n    , Predicate $ isValueOnly True\n    ]\n  , prod = \\case\n      (_:Token Temperature td@TemperatureData{TTemperature.value = Just v}:_) ->\n        case TTemperature.unit td of\n          Nothing -> Just . Token Temperature . withUnit TTemperature.Degree $\n            td {TTemperature.value = Just (- v)}\n          _ -> Just . Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nruleTemperatureBelowZeroReverse :: Rule\nruleTemperatureBelowZeroReverse = Rule\n  { name = \"<temp> below zero\"\n  , pattern =\n    [ Predicate $ isValueOnly True\n    , regex \"s\\305f\\305r\\305n alt\\305nda\"\n    ]\n  , prod = \\case\n      (Token Temperature td@TemperatureData{TTemperature.value = Just v}:_) ->\n        case TTemperature.unit td of\n          Nothing -> Just . Token Temperature . withUnit TTemperature.Degree $\n            td {TTemperature.value = Just (- v)}\n          _ -> Just . Token Temperature $ td {TTemperature.value = Just (- v)}\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleTemperatureDegrees\n  , ruleTemperatureCelsius\n  , ruleTemperatureFahrenheit\n  , ruleTemperatureBelowZero\n  , ruleTemperatureBelowZeroReverse\n  ]\n", "num_lines": 104}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE TupleSections #-}\n\nmodule Duckling.Testing.Types\n  ( Corpus\n  , Datetime\n  , Example\n  , NegativeCorpus\n  , TestPredicate\n  , dt\n  , examples\n  , examplesCustom\n  , parserCheck\n  , refTime\n  , simpleCheck\n  , testContext\n  , testOptions\n  , withLocale\n  , zTime\n  ) where\n\nimport Data.Aeson (toJSON, ToJSON, Value)\nimport Data.Fixed (Pico)\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Time as Time\n\nimport Duckling.Core\nimport Duckling.Resolve\nimport Duckling.Types\n\ntype TestPredicate = Context -> ResolvedToken -> Bool\ntype Example = (Text, TestPredicate)\ntype Corpus = (Context, Options, [Example])\ntype NegativeCorpus = (Context, Options, [Text])\n\nexamplesCustom :: TestPredicate -> [Text] -> [Example]\nexamplesCustom check = map (, check)\n\nsimpleCheck :: ToJSON a => a -> TestPredicate\nsimpleCheck json _ Resolved{rval = RVal _ v} = toJSON json == toJSON v\n\nparserCheck :: Eq a => a -> (Value -> Maybe a) -> TestPredicate\nparserCheck expected parseValue _ Resolved{rval = RVal _ v} =\n  Just expected == parseValue (toJSON v)\n\nexamples :: ToJSON a => a -> [Text] -> [Example]\nexamples output = examplesCustom (simpleCheck output)\n\ntype Datetime = (Integer, Int, Int, Int, Int, Pico)\n\ndt :: Datetime -> Time.UTCTime\ndt (year, month, days, hours, minutes, seconds) = Time.UTCTime day diffTime\n  where\n    day = Time.fromGregorian year month days\n    diffTime = Time.timeOfDayToTime $ Time.TimeOfDay hours minutes seconds\n\nzTime :: Datetime -> Int -> Time.ZonedTime\nzTime datetime offset = fromUTC (dt datetime) $ Time.hoursToTimeZone offset\n\nrefTime :: Datetime -> Int -> DucklingTime\nrefTime datetime offset = fromZonedTime $ zTime datetime offset\n\n-- Tuesday Feb 12, 2013 at 4:30am is the \"now\" for the tests\ntestContext :: Context\ntestContext = Context\n  { locale = makeLocale EN Nothing\n  , referenceTime = refTime (2013, 2, 12, 4, 30, 0) (-2)\n  }\n\ntestOptions :: Options\ntestOptions = Options\n  { withLatent = False\n  }\n\nwithLocale :: (Context, Options, [a]) -> Locale -> [a]\n  -> (Context, Options, [a])\nwithLocale (langContext, options, langXs) locale localeXs\n  = (langContext {locale = locale}, options, langXs ++ localeXs)\n", "num_lines": 87}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.Computed\n  ( chanukah, chineseNewYear, dhanteras, easterSunday, eidalAdha, eidalFitr\n  , globalYouthServiceDay, guruGobindSinghJayanti, karvaChauth\n  , krishnaJanmashtami, lagBaOmer, mawlid, muharram, navaratri, orthodoxEaster\n  , passover, rajab, rakshaBandhan, mahavirJayanti, mahaShivaRatri\n  , ramadan, rathaYatra, roshHashana, thaiPongal, thiruOnam, superTuesday\n  , tishaBAv, tuBishvat, vasantPanchami, vesak\n  , yomHaatzmaut, vaisakhi, purim, saraswatiJayanti, rabindraJayanti\n  , ravidassJayanti, pargatDiwas, ugadi, ganeshChaturthi, ramaNavami\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Time.Helpers (timeComputed, toTimeObjectM)\nimport Duckling.Time.Types (TimeData(..), TimeObject(..), timedata')\nimport qualified Duckling.TimeGrain.Types as TG\n\ncomputedDays :: [TimeObject] -> TimeData\ncomputedDays xs = timedata'\n  { timePred = timeComputed xs\n  , timeGrain = TG.Day\n  }\n\nchanukah :: TimeData\nchanukah = computedDays chanukah'\n\nchanukah' :: [TimeObject]\nchanukah' = mapMaybe toTimeObjectM\n  [ (1950, 12, 3)\n  , (1951, 12, 23)\n  , (1952, 12, 12)\n  , (1953, 12, 1)\n  , (1954, 12, 19)\n  , (1955, 12, 9)\n  , (1956, 11, 28)\n  , (1957, 12, 17)\n  , (1958, 12, 6)\n  , (1959, 12, 25)\n  , (1960, 12, 13)\n  , (1961, 12, 2)\n  , (1962, 12, 21)\n  , (1963, 12, 10)\n  , (1964, 11, 29)\n  , (1965, 12, 18)\n  , (1966, 12, 7)\n  , (1967, 12, 26)\n  , (1968, 12, 15)\n  , (1969, 12, 4)\n  , (1970, 12, 22)\n  , (1971, 12, 12)\n  , (1972, 11, 30)\n  , (1973, 12, 19)\n  , (1974, 12, 8)\n  , (1975, 11, 28)\n  , (1976, 12, 16)\n  , (1977, 12, 4)\n  , (1978, 12, 24)\n  , (1979, 12, 14)\n  , (1980, 12, 2)\n  , (1981, 12, 20)\n  , (1982, 12, 10)\n  , (1983, 11, 30)\n  , (1984, 12, 18)\n  , (1985, 12, 7)\n  , (1986, 12, 26)\n  , (1987, 12, 15)\n  , (1988, 12, 3)\n  , (1989, 12, 22)\n  , (1990, 12, 11)\n  , (1991, 12, 1)\n  , (1992, 12, 19)\n  , (1993, 12, 8)\n  , (1994, 11, 27)\n  , (1995, 12, 17)\n  , (1996, 12, 5)\n  , (1997, 12, 23)\n  , (1998, 12, 13)\n  , (1999, 12, 3)\n  , (2000, 12, 21)\n  , (2001, 12, 9)\n  , (2002, 11, 29)\n  , (2003, 12, 19)\n  , (2004, 12, 7)\n  , (2005, 12, 25)\n  , (2006, 12, 15)\n  , (2007, 12, 4)\n  , (2008, 12, 21)\n  , (2009, 12, 11)\n  , (2010, 12, 1)\n  , (2011, 12, 20)\n  , (2012, 12, 8)\n  , (2013, 11, 27)\n  , (2014, 12, 16)\n  , (2015, 12, 6)\n  , (2016, 12, 24)\n  , (2017, 12, 12)\n  , (2018, 12, 2)\n  , (2019, 12, 22)\n  , (2020, 12, 10)\n  , (2021, 11, 28)\n  , (2022, 12, 18)\n  , (2023, 12, 7)\n  , (2024, 12, 25)\n  , (2025, 12, 14)\n  , (2026, 12, 4)\n  , (2027, 12, 24)\n  , (2028, 12, 12)\n  , (2029, 12, 1)\n  , (2030, 12, 20)\n  , (2031, 12, 9)\n  , (2032, 11, 27)\n  , (2033, 12, 16)\n  , (2034, 12, 6)\n  , (2035, 12, 25)\n  , (2036, 12, 13)\n  , (2037, 12, 2)\n  , (2038, 12, 21)\n  , (2039, 12, 11)\n  , (2040, 11, 29)\n  , (2041, 12, 17)\n  , (2042, 12, 7)\n  , (2043, 12, 26)\n  , (2044, 12, 14)\n  , (2045, 12, 3)\n  , (2046, 12, 23)\n  , (2047, 12, 12)\n  , (2048, 11, 29)\n  , (2049, 12, 19)\n  , (2050, 12, 9)\n  ]\n\nchineseNewYear :: TimeData\nchineseNewYear = computedDays chineseNewYear'\n\nchineseNewYear' :: [TimeObject]\nchineseNewYear' = mapMaybe toTimeObjectM\n  [ (1950, 2, 17)\n  , (1951, 2, 6)\n  , (1952, 1, 27)\n  , (1953, 2, 14)\n  , (1954, 2, 3)\n  , (1955, 1, 24)\n  , (1956, 2, 12)\n  , (1957, 1, 31)\n  , (1958, 2, 18)\n  , (1959, 2, 8)\n  , (1960, 1, 28)\n  , (1961, 2, 15)\n  , (1962, 2, 5)\n  , (1963, 1, 25)\n  , (1964, 2, 13)\n  , (1965, 2, 2)\n  , (1966, 1, 21)\n  , (1967, 2, 9)\n  , (1968, 1, 30)\n  , (1969, 2, 17)\n  , (1970, 2, 6)\n  , (1971, 1, 27)\n  , (1972, 2, 15)\n  , (1973, 2, 3)\n  , (1974, 1, 23)\n  , (1975, 2, 11)\n  , (1976, 1, 31)\n  , (1977, 2, 18)\n  , (1978, 2, 7)\n  , (1979, 1, 28)\n  , (1980, 2, 16)\n  , (1981, 2, 5)\n  , (1982, 1, 25)\n  , (1983, 2, 13)\n  , (1984, 2, 2)\n  , (1985, 2, 20)\n  , (1986, 2, 9)\n  , (1987, 1, 29)\n  , (1988, 2, 17)\n  , (1989, 2, 6)\n  , (1990, 1, 27)\n  , (1991, 2, 15)\n  , (1992, 2, 4)\n  , (1993, 1, 23)\n  , (1994, 2, 10)\n  , (1995, 1, 31)\n  , (1996, 2, 19)\n  , (1997, 2, 7)\n  , (1998, 1, 28)\n  , (1999, 2, 16)\n  , (2000, 2, 5)\n  , (2001, 1, 24)\n  , (2002, 2, 12)\n  , (2003, 2, 1)\n  , (2004, 1, 22)\n  , (2005, 2, 9)\n  , (2006, 1, 29)\n  , (2007, 2, 18)\n  , (2008, 2, 7)\n  , (2009, 1, 26)\n  , (2010, 2, 14)\n  , (2011, 2, 3)\n  , (2012, 1, 23)\n  , (2013, 2, 10)\n  , (2014, 1, 31)\n  , (2015, 2, 19)\n  , (2016, 2, 8)\n  , (2017, 1, 28)\n  , (2018, 2, 16)\n  , (2019, 2, 5)\n  , (2020, 1, 25)\n  , (2021, 2, 12)\n  , (2022, 2, 1)\n  , (2023, 1, 22)\n  , (2024, 2, 10)\n  , (2025, 1, 29)\n  , (2026, 2, 17)\n  , (2027, 2, 6)\n  , (2028, 1, 26)\n  , (2029, 2, 13)\n  , (2030, 2, 3)\n  , (2031, 1, 23)\n  , (2032, 2, 11)\n  , (2033, 1, 31)\n  , (2034, 2, 19)\n  , (2035, 2, 8)\n  , (2036, 1, 28)\n  , (2037, 2, 15)\n  , (2038, 2, 4)\n  , (2039, 1, 24)\n  , (2040, 2, 12)\n  , (2041, 2, 1)\n  , (2042, 1, 22)\n  , (2043, 2, 10)\n  , (2044, 1, 30)\n  , (2045, 2, 17)\n  , (2046, 2, 6)\n  , (2047, 1, 26)\n  , (2048, 2, 14)\n  , (2049, 2, 2)\n  , (2050, 1, 23)\n  ]\n\neasterSunday :: TimeData\neasterSunday = computedDays easterSunday'\n\neasterSunday' :: [TimeObject]\neasterSunday' = mapMaybe toTimeObjectM\n  [ (1950, 4, 9)\n  , (1951, 3, 25)\n  , (1952, 4, 13)\n  , (1953, 4, 5)\n  , (1954, 4, 18)\n  , (1955, 4, 10)\n  , (1956, 4, 1)\n  , (1957, 4, 21)\n  , (1958, 4, 6)\n  , (1959, 3, 29)\n  , (1960, 4, 17)\n  , (1961, 4, 2)\n  , (1962, 4, 22)\n  , (1963, 4, 14)\n  , (1964, 3, 29)\n  , (1965, 4, 18)\n  , (1966, 4, 10)\n  , (1967, 3, 26)\n  , (1968, 4, 14)\n  , (1969, 4, 6)\n  , (1970, 3, 29)\n  , (1971, 4, 11)\n  , (1972, 4, 2)\n  , (1973, 4, 22)\n  , (1974, 4, 14)\n  , (1975, 3, 30)\n  , (1976, 4, 18)\n  , (1977, 4, 10)\n  , (1978, 3, 26)\n  , (1979, 4, 15)\n  , (1980, 4, 6)\n  , (1981, 4, 19)\n  , (1982, 4, 11)\n  , (1983, 4, 3)\n  , (1984, 4, 22)\n  , (1985, 4, 7)\n  , (1986, 3, 30)\n  , (1987, 4, 19)\n  , (1988, 4, 3)\n  , (1989, 3, 26)\n  , (1990, 4, 15)\n  , (1991, 3, 31)\n  , (1992, 4, 19)\n  , (1993, 4, 11)\n  , (1994, 4, 3)\n  , (1995, 4, 16)\n  , (1996, 4, 7)\n  , (1997, 3, 30)\n  , (1998, 4, 12)\n  , (1999, 4, 4)\n  , (2000, 4, 23)\n  , (2001, 4, 15)\n  , (2002, 3, 31)\n  , (2003, 4, 20)\n  , (2004, 4, 11)\n  , (2005, 3, 27)\n  , (2006, 4, 16)\n  , (2007, 4, 8)\n  , (2008, 3, 23)\n  , (2009, 4, 12)\n  , (2010, 4, 4)\n  , (2011, 4, 24)\n  , (2012, 4, 8)\n  , (2013, 3, 31)\n  , (2014, 4, 20)\n  , (2015, 4, 5)\n  , (2016, 3, 27)\n  , (2017, 4, 16)\n  , (2018, 4, 1)\n  , (2019, 4, 21)\n  , (2020, 4, 12)\n  , (2021, 4, 4)\n  , (2022, 4, 17)\n  , (2023, 4, 9)\n  , (2024, 3, 31)\n  , (2025, 4, 20)\n  , (2026, 4, 5)\n  , (2027, 3, 28)\n  , (2028, 4, 16)\n  , (2029, 4, 1)\n  , (2030, 4, 21)\n  , (2031, 4, 13)\n  , (2032, 3, 28)\n  , (2033, 4, 17)\n  , (2034, 4, 9)\n  , (2035, 3, 25)\n  , (2036, 4, 13)\n  , (2037, 4, 5)\n  , (2038, 4, 25)\n  , (2039, 4, 10)\n  , (2040, 4, 1)\n  , (2041, 4, 21)\n  , (2042, 4, 6)\n  , (2043, 3, 29)\n  , (2044, 4, 17)\n  , (2045, 4, 9)\n  , (2046, 3, 25)\n  , (2047, 4, 14)\n  , (2048, 4, 5)\n  , (2049, 4, 18)\n  , (2050, 4, 10)\n  ]\n\nlagBaOmer :: TimeData\nlagBaOmer = computedDays lagBaOmer'\n\nlagBaOmer' :: [TimeObject]\nlagBaOmer' = mapMaybe toTimeObjectM\n  [ (1950, 5, 4)\n  , (1951, 5, 23)\n  , (1952, 5, 12)\n  , (1953, 5, 2)\n  , (1954, 5, 20)\n  , (1955, 5, 9)\n  , (1956, 4, 28)\n  , (1957, 5, 18)\n  , (1958, 5, 7)\n  , (1959, 5, 25)\n  , (1960, 5, 14)\n  , (1961, 5, 3)\n  , (1962, 5, 21)\n  , (1963, 5, 11)\n  , (1964, 4, 29)\n  , (1965, 5, 19)\n  , (1966, 5, 7)\n  , (1967, 5, 27)\n  , (1968, 5, 15)\n  , (1969, 5, 5)\n  , (1970, 5, 23)\n  , (1971, 5, 12)\n  , (1972, 5, 1)\n  , (1973, 5, 19)\n  , (1974, 5, 9)\n  , (1975, 4, 28)\n  , (1976, 5, 17)\n  , (1977, 5, 5)\n  , (1978, 5, 24)\n  , (1979, 5, 14)\n  , (1980, 5, 3)\n  , (1981, 5, 21)\n  , (1982, 5, 10)\n  , (1983, 4, 30)\n  , (1984, 5, 19)\n  , (1985, 5, 8)\n  , (1986, 5, 26)\n  , (1987, 5, 16)\n  , (1988, 5, 4)\n  , (1989, 5, 22)\n  , (1990, 5, 12)\n  , (1991, 5, 1)\n  , (1992, 5, 20)\n  , (1993, 5, 8)\n  , (1994, 4, 28)\n  , (1995, 5, 17)\n  , (1996, 5, 6)\n  , (1997, 5, 24)\n  , (1998, 5, 13)\n  , (1999, 5, 3)\n  , (2000, 5, 22)\n  , (2001, 5, 10)\n  , (2002, 4, 29)\n  , (2003, 5, 19)\n  , (2004, 5, 8)\n  , (2005, 5, 26)\n  , (2006, 5, 15)\n  , (2007, 5, 5)\n  , (2008, 5, 22)\n  , (2009, 5, 11)\n  , (2010, 5, 1)\n  , (2011, 5, 21)\n  , (2012, 5, 9)\n  , (2013, 4, 27)\n  , (2014, 5, 17)\n  , (2015, 5, 6)\n  , (2016, 5, 25)\n  , (2017, 5, 13)\n  , (2018, 5, 2)\n  , (2019, 5, 22)\n  , (2020, 5, 11)\n  , (2021, 4, 29)\n  , (2022, 5, 18)\n  , (2023, 5, 8)\n  , (2024, 5, 25)\n  , (2025, 5, 15)\n  , (2026, 5, 4)\n  , (2027, 5, 24)\n  , (2028, 5, 13)\n  , (2029, 5, 2)\n  , (2030, 5, 20)\n  , (2031, 5, 10)\n  , (2032, 4, 28)\n  , (2033, 5, 16)\n  , (2034, 5, 6)\n  , (2035, 5, 26)\n  , (2036, 5, 14)\n  , (2037, 5, 2)\n  , (2038, 5, 22)\n  , (2039, 5, 11)\n  , (2040, 4, 30)\n  , (2041, 5, 18)\n  , (2042, 5, 7)\n  , (2043, 5, 27)\n  , (2044, 5, 14)\n  , (2045, 5, 4)\n  , (2046, 5, 23)\n  , (2047, 5, 13)\n  , (2048, 4, 30)\n  , (2049, 5, 19)\n  , (2050, 5, 9)\n  ]\n\northodoxEaster :: TimeData\northodoxEaster = computedDays orthodoxEaster'\n\northodoxEaster' :: [TimeObject]\northodoxEaster' = mapMaybe toTimeObjectM\n  [ (1950, 4, 9)\n  , (1951, 4, 29)\n  , (1952, 4, 20)\n  , (1953, 4, 5)\n  , (1954, 4, 25)\n  , (1955, 4, 17)\n  , (1956, 5, 6)\n  , (1957, 4, 21)\n  , (1958, 4, 13)\n  , (1959, 5, 3)\n  , (1960, 4, 17)\n  , (1961, 4, 9)\n  , (1962, 4, 29)\n  , (1963, 4, 14)\n  , (1964, 5, 3)\n  , (1965, 4, 25)\n  , (1966, 4, 10)\n  , (1967, 4, 30)\n  , (1968, 4, 21)\n  , (1969, 4, 13)\n  , (1970, 4, 26)\n  , (1971, 4, 18)\n  , (1972, 4, 9)\n  , (1973, 4, 29)\n  , (1974, 4, 14)\n  , (1975, 5, 4)\n  , (1976, 4, 25)\n  , (1977, 4, 10)\n  , (1978, 4, 30)\n  , (1979, 4, 22)\n  , (1980, 4, 6)\n  , (1981, 4, 26)\n  , (1982, 4, 18)\n  , (1983, 5, 8)\n  , (1984, 4, 22)\n  , (1985, 4, 14)\n  , (1986, 5, 4)\n  , (1987, 4, 19)\n  , (1988, 4, 10)\n  , (1989, 4, 30)\n  , (1990, 4, 15)\n  , (1991, 4, 7)\n  , (1992, 4, 26)\n  , (1993, 4, 18)\n  , (1994, 5, 1)\n  , (1995, 4, 23)\n  , (1996, 4, 14)\n  , (1997, 4, 27)\n  , (1998, 4, 19)\n  , (1999, 4, 11)\n  , (2000, 4, 30)\n  , (2001, 4, 15)\n  , (2002, 5, 5)\n  , (2003, 4, 27)\n  , (2004, 4, 11)\n  , (2005, 5, 1)\n  , (2006, 4, 23)\n  , (2007, 4, 8)\n  , (2008, 4, 27)\n  , (2009, 4, 19)\n  , (2010, 4, 4)\n  , (2011, 4, 24)\n  , (2012, 4, 15)\n  , (2013, 5, 5)\n  , (2014, 4, 20)\n  , (2015, 4, 12)\n  , (2016, 5, 1)\n  , (2017, 4, 16)\n  , (2018, 4, 8)\n  , (2019, 4, 28)\n  , (2020, 4, 19)\n  , (2021, 5, 2)\n  , (2022, 4, 24)\n  , (2023, 4, 16)\n  , (2024, 5, 5)\n  , (2025, 4, 20)\n  , (2026, 4, 12)\n  , (2027, 5, 2)\n  , (2028, 4, 16)\n  , (2029, 4, 8)\n  , (2030, 4, 28)\n  , (2031, 4, 13)\n  , (2032, 5, 2)\n  , (2033, 4, 24)\n  , (2034, 4, 9)\n  , (2035, 4, 29)\n  , (2036, 4, 20)\n  , (2037, 4, 5)\n  , (2038, 4, 25)\n  , (2039, 4, 17)\n  , (2040, 5, 6)\n  , (2041, 4, 21)\n  , (2042, 4, 13)\n  , (2043, 5, 3)\n  , (2044, 4, 24)\n  , (2045, 4, 9)\n  , (2046, 4, 29)\n  , (2047, 4, 21)\n  , (2048, 4, 5)\n  , (2049, 4, 25)\n  , (2050, 4, 17)\n  ]\n\npassover :: TimeData\npassover = computedDays passover'\n\npassover' :: [TimeObject]\npassover' = mapMaybe toTimeObjectM\n  [ (1950, 4, 1)\n  , (1951, 4, 20)\n  , (1952, 4, 9)\n  , (1953, 3, 30)\n  , (1954, 4, 17)\n  , (1955, 4, 6)\n  , (1956, 3, 26)\n  , (1957, 4, 15)\n  , (1958, 4, 4)\n  , (1959, 4, 22)\n  , (1960, 4, 11)\n  , (1961, 3, 31)\n  , (1962, 4, 18)\n  , (1963, 4, 8)\n  , (1964, 3, 27)\n  , (1965, 4, 16)\n  , (1966, 4, 4)\n  , (1967, 4, 24)\n  , (1968, 4, 12)\n  , (1969, 4, 2)\n  , (1970, 4, 20)\n  , (1971, 4, 9)\n  , (1972, 3, 29)\n  , (1973, 4, 16)\n  , (1974, 4, 6)\n  , (1975, 3, 26)\n  , (1976, 4, 14)\n  , (1977, 4, 2)\n  , (1978, 4, 21)\n  , (1979, 4, 11)\n  , (1980, 3, 31)\n  , (1981, 4, 18)\n  , (1982, 4, 7)\n  , (1983, 3, 28)\n  , (1984, 4, 16)\n  , (1985, 4, 5)\n  , (1986, 4, 23)\n  , (1987, 4, 13)\n  , (1988, 4, 1)\n  , (1989, 4, 19)\n  , (1990, 4, 9)\n  , (1991, 3, 29)\n  , (1992, 4, 17)\n  , (1993, 4, 5)\n  , (1994, 3, 26)\n  , (1995, 4, 14)\n  , (1996, 4, 3)\n  , (1997, 4, 21)\n  , (1998, 4, 10)\n  , (1999, 3, 31)\n  , (2000, 4, 19)\n  , (2001, 4, 7)\n  , (2002, 3, 27)\n  , (2003, 4, 16)\n  , (2004, 4, 5)\n  , (2005, 4, 23)\n  , (2006, 4, 12)\n  , (2007, 4, 2)\n  , (2008, 4, 19)\n  , (2009, 4, 8)\n  , (2010, 3, 29)\n  , (2011, 4, 18)\n  , (2012, 4, 6)\n  , (2013, 3, 25)\n  , (2014, 4, 14)\n  , (2015, 4, 3)\n  , (2016, 4, 22)\n  , (2017, 4, 10)\n  , (2018, 3, 30)\n  , (2019, 4, 19)\n  , (2020, 4, 8)\n  , (2021, 3, 27)\n  , (2022, 4, 15)\n  , (2023, 4, 5)\n  , (2024, 4, 22)\n  , (2025, 4, 12)\n  , (2026, 4, 1)\n  , (2027, 4, 21)\n  , (2028, 4, 10)\n  , (2029, 3, 30)\n  , (2030, 4, 17)\n  , (2031, 4, 7)\n  , (2032, 3, 26)\n  , (2033, 4, 13)\n  , (2034, 4, 3)\n  , (2035, 4, 23)\n  , (2036, 4, 11)\n  , (2037, 3, 30)\n  , (2038, 4, 19)\n  , (2039, 4, 8)\n  , (2040, 3, 28)\n  , (2041, 4, 15)\n  , (2042, 4, 4)\n  , (2043, 4, 24)\n  , (2044, 4, 11)\n  , (2045, 4, 1)\n  , (2046, 4, 20)\n  , (2047, 4, 10)\n  , (2048, 3, 28)\n  , (2049, 4, 16)\n  , (2050, 4, 6)\n  ]\n\nroshHashana :: TimeData\nroshHashana = computedDays roshHashana'\n\nroshHashana' :: [TimeObject]\nroshHashana' = mapMaybe toTimeObjectM\n  [ (1950, 9, 11)\n  , (1951, 9, 30)\n  , (1952, 9, 19)\n  , (1953, 9, 9)\n  , (1954, 9, 27)\n  , (1955, 9, 16)\n  , (1956, 9, 5)\n  , (1957, 9, 25)\n  , (1958, 9, 14)\n  , (1959, 10, 2)\n  , (1960, 9, 21)\n  , (1961, 9, 10)\n  , (1962, 9, 28)\n  , (1963, 9, 18)\n  , (1964, 9, 6)\n  , (1965, 9, 26)\n  , (1966, 9, 14)\n  , (1967, 10, 4)\n  , (1968, 9, 22)\n  , (1969, 9, 12)\n  , (1970, 9, 30)\n  , (1971, 9, 19)\n  , (1972, 9, 8)\n  , (1973, 9, 26)\n  , (1974, 9, 16)\n  , (1975, 9, 5)\n  , (1976, 9, 24)\n  , (1977, 9, 12)\n  , (1978, 10, 1)\n  , (1979, 9, 21)\n  , (1980, 9, 10)\n  , (1981, 9, 28)\n  , (1982, 9, 17)\n  , (1983, 9, 7)\n  , (1984, 9, 26)\n  , (1985, 9, 15)\n  , (1986, 10, 3)\n  , (1987, 9, 23)\n  , (1988, 9, 11)\n  , (1989, 9, 29)\n  , (1990, 9, 19)\n  , (1991, 9, 8)\n  , (1992, 9, 27)\n  , (1993, 9, 15)\n  , (1994, 9, 5)\n  , (1995, 9, 24)\n  , (1996, 9, 13)\n  , (1997, 10, 1)\n  , (1998, 9, 20)\n  , (1999, 9, 10)\n  , (2000, 9, 29)\n  , (2001, 9, 17)\n  , (2002, 9, 6)\n  , (2003, 9, 26)\n  , (2004, 9, 15)\n  , (2005, 10, 3)\n  , (2006, 9, 22)\n  , (2007, 9, 12)\n  , (2008, 9, 29)\n  , (2009, 9, 18)\n  , (2010, 9, 8)\n  , (2011, 9, 28)\n  , (2012, 9, 18)\n  , (2013, 9, 4)\n  , (2014, 9, 24)\n  , (2015, 9, 13)\n  , (2016, 10, 2)\n  , (2017, 9, 20)\n  , (2018, 9, 9)\n  , (2019, 9, 29)\n  , (2020, 9, 18)\n  , (2021, 9, 6)\n  , (2022, 9, 25)\n  , (2023, 9, 15)\n  , (2024, 10, 2)\n  , (2025, 9, 22)\n  , (2026, 9, 11)\n  , (2027, 10, 1)\n  , (2028, 9, 20)\n  , (2029, 9, 9)\n  , (2030, 9, 27)\n  , (2031, 9, 17)\n  , (2032, 9, 5)\n  , (2033, 9, 23)\n  , (2034, 9, 13)\n  , (2035, 10, 3)\n  , (2036, 9, 21)\n  , (2037, 9, 9)\n  , (2038, 9, 29)\n  , (2039, 9, 18)\n  , (2040, 9, 7)\n  , (2041, 9, 25)\n  , (2042, 9, 14)\n  , (2043, 10, 4)\n  , (2044, 9, 21)\n  , (2045, 9, 11)\n  , (2046, 9, 30)\n  , (2047, 9, 20)\n  , (2048, 9, 7)\n  , (2049, 9, 26)\n  , (2050, 9, 16)\n  ]\n\ntishaBAv :: TimeData\ntishaBAv = computedDays tishaBAv'\n\ntishaBAv' :: [TimeObject]\ntishaBAv' = mapMaybe toTimeObjectM\n  [ (1950, 7, 22)\n  , (1951, 8, 11)\n  , (1952, 7, 30)\n  , (1953, 7, 20)\n  , (1954, 8, 7)\n  , (1955, 7, 27)\n  , (1956, 7, 16)\n  , (1957, 8, 5)\n  , (1958, 7, 26)\n  , (1959, 8, 12)\n  , (1960, 8, 1)\n  , (1961, 7, 22)\n  , (1962, 8, 8)\n  , (1963, 7, 29)\n  , (1964, 7, 18)\n  , (1965, 8, 7)\n  , (1966, 7, 25)\n  , (1967, 8, 14)\n  , (1968, 8, 3)\n  , (1969, 7, 23)\n  , (1970, 8, 10)\n  , (1971, 7, 31)\n  , (1972, 7, 19)\n  , (1973, 8, 6)\n  , (1974, 7, 27)\n  , (1975, 7, 16)\n  , (1976, 8, 4)\n  , (1977, 7, 23)\n  , (1978, 8, 12)\n  , (1979, 8, 1)\n  , (1980, 7, 21)\n  , (1981, 8, 8)\n  , (1982, 7, 28)\n  , (1983, 7, 18)\n  , (1984, 8, 6)\n  , (1985, 7, 27)\n  , (1986, 8, 13)\n  , (1987, 8, 3)\n  , (1988, 7, 23)\n  , (1989, 8, 9)\n  , (1990, 7, 30)\n  , (1991, 7, 20)\n  , (1992, 8, 8)\n  , (1993, 7, 26)\n  , (1994, 7, 16)\n  , (1995, 8, 5)\n  , (1996, 7, 24)\n  , (1997, 8, 11)\n  , (1998, 8, 1)\n  , (1999, 7, 21)\n  , (2000, 8, 9)\n  , (2001, 7, 28)\n  , (2002, 7, 17)\n  , (2003, 8, 6)\n  , (2004, 7, 26)\n  , (2005, 8, 13)\n  , (2006, 8, 2)\n  , (2007, 7, 23)\n  , (2008, 8, 9)\n  , (2009, 7, 29)\n  , (2010, 7, 19)\n  , (2011, 8, 8)\n  , (2012, 7, 28)\n  , (2013, 7, 15)\n  , (2014, 8, 4)\n  , (2015, 7, 25)\n  , (2016, 8, 13)\n  , (2017, 7, 31)\n  , (2018, 7, 21)\n  , (2019, 8, 10)\n  , (2020, 7, 29)\n  , (2021, 7, 17)\n  , (2022, 8, 6)\n  , (2023, 7, 26)\n  , (2024, 8, 12)\n  , (2025, 8, 2)\n  , (2026, 7, 22)\n  , (2027, 8, 11)\n  , (2028, 7, 31)\n  , (2029, 7, 21)\n  , (2030, 8, 7)\n  , (2031, 7, 28)\n  , (2032, 7, 17)\n  , (2033, 8, 3)\n  , (2034, 7, 24)\n  , (2035, 8, 13)\n  , (2036, 8, 2)\n  , (2037, 7, 20)\n  , (2038, 8, 9)\n  , (2039, 7, 30)\n  , (2040, 7, 18)\n  , (2041, 8, 5)\n  , (2042, 7, 26)\n  , (2043, 8, 15)\n  , (2044, 8, 1)\n  , (2045, 7, 22)\n  , (2046, 8, 11)\n  , (2047, 7, 31)\n  , (2048, 7, 18)\n  , (2049, 8, 7)\n  , (2050, 7, 27)\n  ]\n\nyomHaatzmaut :: TimeData\nyomHaatzmaut = computedDays yomHaatzmaut'\n\nyomHaatzmaut' :: [TimeObject]\nyomHaatzmaut' = mapMaybe toTimeObjectM\n  [ (1950, 4, 19)\n  , (1951, 5, 9)\n  , (1952, 4, 29)\n  , (1953, 4, 19)\n  , (1954, 5, 5)\n  , (1955, 4, 26)\n  , (1956, 4, 15)\n  , (1957, 5, 5)\n  , (1958, 4, 23)\n  , (1959, 5, 12)\n  , (1960, 5, 1)\n  , (1961, 4, 19)\n  , (1962, 5, 8)\n  , (1963, 4, 28)\n  , (1964, 4, 15)\n  , (1965, 5, 5)\n  , (1966, 4, 24)\n  , (1967, 5, 14)\n  , (1968, 5, 1)\n  , (1969, 4, 22)\n  , (1970, 5, 10)\n  , (1971, 4, 28)\n  , (1972, 4, 18)\n  , (1973, 5, 6)\n  , (1974, 4, 24)\n  , (1975, 4, 15)\n  , (1976, 5, 4)\n  , (1977, 4, 20)\n  , (1978, 5, 10)\n  , (1979, 5, 1)\n  , (1980, 4, 20)\n  , (1981, 5, 6)\n  , (1982, 4, 27)\n  , (1983, 4, 17)\n  , (1984, 5, 6)\n  , (1985, 4, 24)\n  , (1986, 5, 13)\n  , (1987, 5, 3)\n  , (1988, 4, 20)\n  , (1989, 5, 9)\n  , (1990, 4, 29)\n  , (1991, 4, 17)\n  , (1992, 5, 6)\n  , (1993, 4, 25)\n  , (1994, 4, 13)\n  , (1995, 5, 3)\n  , (1996, 4, 23)\n  , (1997, 5, 11)\n  , (1998, 4, 29)\n  , (1999, 4, 20)\n  , (2000, 5, 9)\n  , (2001, 4, 25)\n  , (2002, 4, 16)\n  , (2003, 5, 6)\n  , (2004, 4, 26)\n  , (2005, 5, 11)\n  , (2006, 5, 2)\n  , (2007, 4, 23)\n  , (2008, 5, 7)\n  , (2009, 4, 28)\n  , (2010, 4, 19)\n  , (2011, 5, 9)\n  , (2012, 4, 25)\n  , (2013, 4, 15)\n  , (2014, 5, 5)\n  , (2015, 4, 22)\n  , (2016, 5, 11)\n  , (2017, 5, 1)\n  , (2018, 4, 18)\n  , (2019, 5, 8)\n  , (2020, 4, 28)\n  , (2021, 4, 14)\n  , (2022, 5, 4)\n  , (2023, 4, 25)\n  , (2024, 5, 13)\n  , (2025, 4, 30)\n  , (2026, 4, 21)\n  , (2027, 5, 11)\n  , (2028, 5, 1)\n  , (2029, 4, 18)\n  , (2030, 5, 7)\n  , (2031, 4, 28)\n  , (2032, 4, 14)\n  , (2033, 5, 3)\n  , (2034, 4, 24)\n  , (2035, 5, 14)\n  , (2036, 4, 30)\n  , (2037, 4, 20)\n  , (2038, 5, 10)\n  , (2039, 4, 27)\n  , (2040, 4, 17)\n  , (2041, 5, 6)\n  , (2042, 4, 23)\n  , (2043, 5, 13)\n  , (2044, 5, 2)\n  , (2045, 4, 19)\n  , (2046, 5, 9)\n  , (2047, 4, 30)\n  , (2048, 4, 15)\n  , (2049, 5, 5)\n  , (2050, 4, 26)\n  ]\n\neidalAdha :: TimeData\neidalAdha = computedDays eidalAdha'\n\neidalAdha' :: [TimeObject]\neidalAdha' = mapMaybe toTimeObjectM\n  [ (1950, 9, 23)\n  , (1951, 9, 12)\n  , (1952, 8, 31)\n  , (1953, 8, 20)\n  , (1954, 8, 9)\n  , (1955, 7, 30)\n  , (1956, 7, 19)\n  , (1957, 7, 8)\n  , (1958, 6, 27)\n  , (1959, 6, 17)\n  , (1960, 6, 4)\n  , (1961, 5, 25)\n  , (1962, 5, 14)\n  , (1963, 5, 3)\n  , (1964, 4, 22)\n  , (1965, 4, 11)\n  , (1966, 4, 1)\n  , (1967, 3, 21)\n  , (1968, 3, 9)\n  , (1969, 2, 27)\n  , (1970, 2, 16)\n  , (1971, 2, 6)\n  , (1972, 1, 26)\n  , (1973, 1, 14)\n  , (1974, 1, 3)\n  , (1974, 12, 24)\n  , (1975, 12, 13)\n  , (1976, 12, 1)\n  , (1977, 11, 21)\n  , (1978, 11, 10)\n  , (1979, 10, 31)\n  , (1980, 10, 19)\n  , (1981, 10, 8)\n  , (1982, 9, 27)\n  , (1983, 9, 17)\n  , (1984, 9, 5)\n  , (1985, 8, 26)\n  , (1986, 8, 15)\n  , (1987, 8, 4)\n  , (1988, 7, 23)\n  , (1989, 7, 13)\n  , (1990, 7, 2)\n  , (1991, 6, 22)\n  , (1992, 6, 11)\n  , (1993, 5, 31)\n  , (1994, 5, 20)\n  , (1995, 5, 9)\n  , (1996, 4, 27)\n  , (1997, 4, 17)\n  , (1998, 4, 7)\n  , (1999, 3, 27)\n  , (2000, 3, 16)\n  , (2001, 3, 5)\n  , (2002, 2, 22)\n  , (2003, 2, 11)\n  , (2004, 2, 1)\n  , (2005, 1, 21)\n  , (2006, 1, 10)\n  , (2006, 12, 31)\n  , (2007, 12, 20)\n  , (2008, 12, 8)\n  , (2009, 11, 27)\n  , (2011, 11, 6)\n  , (2012, 10, 26)\n  , (2013, 10, 15)\n  , (2014, 10, 4)\n  , (2015, 8, 23)\n  , (2016, 9, 11)\n  , (2017, 9, 1)\n  , (2018, 8, 21)\n  , (2019, 8, 11)\n  , (2020, 7, 31)\n  , (2021, 7, 20)\n  , (2022, 7, 9)\n  , (2023, 6, 28)\n  , (2024, 6, 16)\n  , (2025, 6, 6)\n  , (2026, 5, 27)\n  , (2027, 5, 16)\n  , (2028, 5, 5)\n  , (2029, 4, 24)\n  ]\n\neidalFitr :: TimeData\neidalFitr = computedDays eidalFitr'\n\neidalFitr' :: [TimeObject]\neidalFitr' = mapMaybe toTimeObjectM\n  [ (1950, 7, 16)\n  , (1951, 7, 6)\n  , (1952, 6, 23)\n  , (1953, 6, 13)\n  , (1954, 6, 2)\n  , (1955, 5, 23)\n  , (1956, 5, 11)\n  , (1957, 5, 1)\n  , (1958, 4, 20)\n  , (1959, 4, 10)\n  , (1960, 3, 28)\n  , (1961, 3, 18)\n  , (1962, 3, 7)\n  , (1963, 2, 24)\n  , (1964, 2, 14)\n  , (1965, 2, 2)\n  , (1966, 1, 22)\n  , (1967, 1, 12)\n  , (1968, 1, 1)\n  , (1968, 12, 21)\n  , (1969, 12, 10)\n  , (1970, 11, 30)\n  , (1971, 11, 19)\n  , (1972, 11, 7)\n  , (1973, 10, 27)\n  , (1974, 10, 16)\n  , (1975, 10, 6)\n  , (1976, 9, 24)\n  , (1977, 9, 14)\n  , (1978, 9, 3)\n  , (1979, 8, 23)\n  , (1980, 8, 12)\n  , (1981, 8, 1)\n  , (1982, 7, 21)\n  , (1983, 7, 11)\n  , (1984, 6, 30)\n  , (1985, 6, 19)\n  , (1986, 6, 8)\n  , (1987, 5, 28)\n  , (1988, 5, 16)\n  , (1989, 5, 6)\n  , (1990, 4, 26)\n  , (1991, 4, 15)\n  , (1992, 4, 4)\n  , (1993, 3, 24)\n  , (1994, 3, 13)\n  , (1995, 3, 2)\n  , (1996, 2, 19)\n  , (1997, 2, 8)\n  , (1998, 1, 29)\n  , (1999, 1, 18)\n  , (2000, 1, 8)\n  , (2000, 12, 27)\n  , (2001, 12, 16)\n  , (2002, 12, 5)\n  , (2003, 11, 25)\n  , (2004, 11, 14)\n  , (2005, 11, 3)\n  , (2006, 10, 23)\n  , (2007, 10, 13)\n  , (2008, 10, 1)\n  , (2009, 9, 20)\n  , (2010, 9, 10)\n  , (2011, 8, 30)\n  , (2012, 8, 19)\n  , (2013, 8, 8)\n  , (2014, 7, 28)\n  , (2015, 7, 17)\n  , (2016, 7, 6)\n  , (2017, 6, 25)\n  , (2018, 6, 15)\n  , (2019, 6, 4)\n  , (2020, 5, 24)\n  , (2021, 5, 13)\n  , (2022, 5, 2)\n  , (2023, 4, 21)\n  , (2024, 4, 10)\n  , (2025, 3, 30)\n  , (2026, 3, 20)\n  , (2027, 3, 9)\n  , (2028, 2, 26)\n  , (2029, 2, 14)\n  , (2030, 2, 05)\n  , (2031, 1, 25)\n  , (2032, 1, 14)\n  , (2033, 1, 3)\n  , (2033, 12, 23)\n  , (2034, 12, 12)\n  , (2035, 12, 2)\n  , (2036, 11, 20)\n  , (2037, 11, 10)\n  , (2038, 10, 30)\n  , (2039, 10, 19)\n  , (2040, 10, 8)\n  , (2041, 9, 27)\n  , (2042, 9, 16)\n  , (2043, 9, 6)\n  , (2044, 8, 25)\n  , (2045, 8, 15)\n  , (2046, 8, 4)\n  , (2047, 7, 24)\n  , (2048, 7, 13)\n  , (2049, 7, 2)\n  , (2050, 6, 21)\n  ]\n\nrajab :: TimeData\nrajab = computedDays rajab'\n\nrajab' :: [TimeObject]\nrajab' = mapMaybe toTimeObjectM\n  [ (1999, 10, 10)\n  , (2000, 9, 28)\n  , (2001, 9, 18)\n  , (2002, 9, 8)\n  , (2003, 8, 29)\n  , (2004, 8, 17)\n  , (2005, 8, 6)\n  , (2006, 7, 26)\n  , (2007, 7, 15)\n  , (2008, 7, 4)\n  , (2009, 6, 24)\n  , (2010, 6, 13)\n  , (2011, 6, 3)\n  , (2012, 5, 22)\n  , (2013, 5, 11)\n  , (2014, 4, 30)\n  , (2015, 4, 20)\n  , (2016, 4, 8)\n  , (2017, 3, 29)\n  , (2018, 3, 18)\n  , (2019, 3, 8)\n  , (2020, 2, 25)\n  , (2021, 2, 13)\n  , (2022, 2, 2)\n  , (2023, 1, 23)\n  , (2024, 1, 13)\n  , (2025, 1, 1)\n  , (2025, 12, 21)\n  , (2026, 12, 10)\n  , (2027, 11, 29)\n  , (2028, 11, 18)\n  ]\n\nmuharram :: TimeData\nmuharram = computedDays muharram'\n\nmuharram' :: [TimeObject]\nmuharram' = mapMaybe toTimeObjectM\n  [ (1998, 4, 27)\n  , (1999, 4, 17)\n  , (2000, 4, 6)\n  , (2001, 3, 26)\n  , (2002, 3, 15)\n  , (2003, 4, 4)\n  , (2004, 2, 21)\n  , (2005, 2, 10)\n  , (2006, 1, 31)\n  , (2007, 1, 20)\n  , (2008, 1, 10)\n  , (2009, 12, 18)\n  , (2010, 12, 7)\n  , (2011, 11, 26)\n  , (2012, 11, 15)\n  , (2013, 11, 4)\n  , (2014, 10, 25)\n  , (2015, 10, 14)\n  , (2016, 10, 2)\n  , (2017, 9, 21)\n  , (2018, 9, 11)\n  , (2019, 8, 31)\n  , (2020, 8, 20)\n  , (2021, 8, 9)\n  , (2022, 7, 30)\n  , (2023, 7, 19)\n  , (2024, 7, 7)\n  , (2025, 6, 26)\n  , (2026, 6, 16)\n  , (2027, 6, 6)\n  , (2028, 5, 25)\n  ]\n\nramadan :: TimeData\nramadan = computedDays ramadan'\n\nramadan' :: [TimeObject]\nramadan' = mapMaybe toTimeObjectM\n  [ (1950, 6, 17)\n  , (1951, 6, 6)\n  , (1952, 5, 25)\n  , (1953, 5, 14)\n  , (1954, 5, 4)\n  , (1955, 4, 24)\n  , (1956, 4, 12)\n  , (1957, 4, 1)\n  , (1958, 3, 21)\n  , (1959, 3, 11)\n  , (1960, 2, 28)\n  , (1961, 2, 16)\n  , (1962, 2, 5)\n  , (1963, 1, 26)\n  , (1964, 1, 15)\n  , (1965, 1, 3)\n  , (1965, 12, 23)\n  , (1966, 12, 13)\n  , (1967, 12, 2)\n  , (1968, 11, 21)\n  , (1969, 11, 10)\n  , (1970, 11, 1)\n  , (1971, 10, 20)\n  , (1972, 10, 8)\n  , (1973, 9, 27)\n  , (1974, 9, 17)\n  , (1975, 9, 6)\n  , (1976, 8, 26)\n  , (1977, 8, 15)\n  , (1978, 8, 5)\n  , (1979, 7, 25)\n  , (1980, 7, 13)\n  , (1981, 7, 2)\n  , (1982, 6, 22)\n  , (1983, 6, 12)\n  , (1984, 5, 31)\n  , (1985, 5, 20)\n  , (1986, 5, 9)\n  , (1987, 4, 29)\n  , (1988, 4, 17)\n  , (1989, 4, 7)\n  , (1990, 3, 27)\n  , (1991, 3, 17)\n  , (1992, 3, 5)\n  , (1993, 2, 22)\n  , (1994, 2, 11)\n  , (1995, 1, 31)\n  , (1996, 1, 21)\n  , (1997, 1, 10)\n  , (1997, 12, 30)\n  , (1998, 12, 19)\n  , (1999, 12, 9)\n  , (2000, 11, 27)\n  , (2001, 11, 16)\n  , (2002, 11, 6)\n  , (2003, 10, 26)\n  , (2004, 10, 15)\n  , (2005, 10, 4)\n  , (2006, 9, 24)\n  , (2007, 9, 13)\n  , (2008, 9, 1)\n  , (2009, 8, 22)\n  , (2010, 8, 11)\n  , (2011, 8, 1)\n  , (2012, 7, 20)\n  , (2013, 7, 9)\n  , (2014, 6, 28)\n  , (2015, 6, 18)\n  , (2016, 6, 6)\n  , (2017, 5, 27)\n  , (2018, 5, 16)\n  , (2019, 5, 6)\n  , (2020, 4, 24)\n  , (2021, 4, 13)\n  , (2022, 4, 2)\n  , (2023, 3, 23)\n  , (2024, 3, 11)\n  , (2025, 3, 1)\n  , (2026, 2, 18)\n  , (2027, 2, 8)\n  , (2028, 1, 28)\n  , (2029, 1, 16)\n  , (2030, 1, 6)\n  , (2030, 12, 26)\n  , (2031, 12, 15)\n  , (2032, 12, 4)\n  , (2033, 11, 23)\n  , (2034, 11, 12)\n  , (2035, 11, 2)\n  , (2036, 10, 21)\n  , (2037, 10, 11)\n  , (2038, 9, 30)\n  , (2039, 9, 19)\n  , (2040, 9, 8)\n  , (2041, 8, 28)\n  , (2042, 8, 17)\n  , (2043, 8, 7)\n  , (2044, 7, 26)\n  , (2045, 7, 16)\n  , (2046, 7, 5)\n  , (2047, 6, 24)\n  , (2048, 6, 13)\n  , (2049, 6, 2)\n  , (2050, 5, 22)\n  ]\n\nmawlid :: TimeData\nmawlid = computedDays mawlid'\n\nmawlid' :: [TimeObject]\nmawlid' = mapMaybe toTimeObjectM\n  [ (1950, 1, 1)\n  , (1950, 12, 22)\n  , (1951, 12, 11)\n  , (1952, 11, 30)\n  , (1953, 11, 19)\n  , (1954, 11, 8)\n  , (1955, 10, 29)\n  , (1956, 10, 17)\n  , (1957, 10, 6)\n  , (1958, 9, 26)\n  , (1959, 9, 15)\n  , (1960, 9, 3)\n  , (1961, 8, 23)\n  , (1962, 8, 12)\n  , (1963, 8, 2)\n  , (1964, 7, 21)\n  , (1965, 7, 10)\n  , (1966, 7, 1)\n  , (1967, 6, 19)\n  , (1968, 6, 8)\n  , (1969, 5, 28)\n  , (1970, 5, 18)\n  , (1971, 5, 7)\n  , (1972, 4, 25)\n  , (1973, 4, 15)\n  , (1974, 4, 4)\n  , (1975, 3, 24)\n  , (1976, 3, 12)\n  , (1977, 3, 2)\n  , (1978, 2, 19)\n  , (1979, 2, 9)\n  , (1980, 1, 30)\n  , (1981, 1, 18)\n  , (1982, 1, 7)\n  , (1982, 12, 27)\n  , (1983, 12, 16)\n  , (1984, 12, 4)\n  , (1985, 11, 24)\n  , (1986, 11, 14)\n  , (1987, 11, 3)\n  , (1988, 10, 22)\n  , (1989, 10, 11)\n  , (1990, 10, 1)\n  , (1991, 9, 20)\n  , (1992, 9, 9)\n  , (1993, 8, 29)\n  , (1994, 8, 19)\n  , (1995, 8, 8)\n  , (1996, 7, 27)\n  , (1997, 7, 16)\n  , (1998, 7, 6)\n  , (1999, 6, 26)\n  , (2000, 6, 14)\n  , (2001, 6, 4)\n  , (2002, 5, 24)\n  , (2003, 5, 13)\n  , (2004, 5, 1)\n  , (2005, 4, 21)\n  , (2006, 4, 10)\n  , (2007, 3, 31)\n  , (2008, 3, 20)\n  , (2009, 3, 9)\n  , (2010, 2, 26)\n  , (2011, 2, 15)\n  , (2012, 2, 4)\n  , (2013, 1, 24)\n  , (2014, 1, 13)\n  , (2015, 1, 3)\n  , (2015, 12, 23)\n  , (2016, 12, 11)\n  , (2017, 11, 30)\n  , (2018, 11, 20)\n  , (2019, 11, 9)\n  , (2020, 10, 29)\n  , (2021, 10, 18)\n  , (2022, 10, 8)\n  , (2023, 9, 27)\n  , (2024, 9, 15)\n  , (2025, 9, 4)\n  , (2026, 8, 25)\n  , (2027, 8, 14)\n  , (2028, 8, 3)\n  ]\n\ntuBishvat :: TimeData\ntuBishvat = computedDays tuBishvat'\n\ntuBishvat' :: [TimeObject]\ntuBishvat' = mapMaybe toTimeObjectM\n  [ (1950, 2, 1)\n  , (1951, 1, 21)\n  , (1952, 2, 10)\n  , (1953, 1, 30)\n  , (1954, 1, 18)\n  , (1955, 2, 6)\n  , (1956, 1, 27)\n  , (1957, 1, 16)\n  , (1958, 2, 4)\n  , (1959, 1, 23)\n  , (1960, 2, 12)\n  , (1961, 1, 31)\n  , (1962, 1, 19)\n  , (1963, 2, 8)\n  , (1964, 1, 28)\n  , (1965, 1, 17)\n  , (1966, 2, 4)\n  , (1967, 1, 25)\n  , (1968, 2, 13)\n  , (1969, 2, 2)\n  , (1970, 1, 21)\n  , (1971, 2, 9)\n  , (1972, 1, 30)\n  , (1973, 1, 17)\n  , (1974, 2, 6)\n  , (1975, 1, 26)\n  , (1976, 1, 16)\n  , (1977, 2, 2)\n  , (1978, 1, 22)\n  , (1979, 2, 11)\n  , (1980, 2, 1)\n  , (1981, 1, 19)\n  , (1982, 2, 7)\n  , (1983, 1, 28)\n  , (1984, 1, 18)\n  , (1985, 2, 5)\n  , (1986, 1, 24)\n  , (1987, 2, 13)\n  , (1988, 2, 2)\n  , (1989, 1, 20)\n  , (1990, 2, 9)\n  , (1991, 1, 29)\n  , (1992, 1, 19)\n  , (1993, 2, 5)\n  , (1994, 1, 26)\n  , (1995, 1, 15)\n  , (1996, 2, 4)\n  , (1997, 1, 22)\n  , (1998, 2, 10)\n  , (1999, 1, 31)\n  , (2000, 1, 21)\n  , (2001, 2, 7)\n  , (2002, 1, 27)\n  , (2003, 1, 17)\n  , (2004, 2, 6)\n  , (2005, 1, 24)\n  , (2006, 2, 12)\n  , (2007, 2, 2)\n  , (2008, 1, 21)\n  , (2009, 2, 8)\n  , (2010, 1, 29)\n  , (2011, 1, 19)\n  , (2012, 2, 7)\n  , (2013, 1, 25)\n  , (2014, 1, 15)\n  , (2015, 2, 3)\n  , (2016, 1, 24)\n  , (2017, 2, 10)\n  , (2018, 1, 30)\n  , (2019, 1, 20)\n  , (2020, 2, 9)\n  , (2021, 1, 27)\n  , (2022, 1, 16)\n  , (2023, 2, 5)\n  , (2024, 1, 24)\n  , (2025, 2, 12)\n  , (2026, 2, 1)\n  , (2027, 1, 22)\n  , (2028, 2, 11)\n  , (2029, 1, 30)\n  , (2030, 1, 18)\n  , (2031, 2, 7)\n  , (2032, 1, 27)\n  , (2033, 1, 14)\n  , (2034, 2, 3)\n  , (2035, 1, 24)\n  , (2036, 2, 12)\n  , (2037, 1, 30)\n  , (2038, 1, 20)\n  , (2039, 2, 8)\n  , (2040, 1, 29)\n  , (2041, 1, 16)\n  , (2042, 2, 4)\n  , (2043, 1, 25)\n  , (2044, 2, 12)\n  , (2045, 2, 1)\n  , (2046, 1, 21)\n  , (2047, 2, 10)\n  , (2048, 1, 29)\n  , (2049, 1, 17)\n  , (2050, 2, 6)\n  ]\n\ndhanteras :: TimeData\ndhanteras = computedDays dhanteras'\n\ndhanteras' :: [TimeObject]\ndhanteras' = mapMaybe toTimeObjectM\n  [ (2000, 10, 24)\n  , (2001, 11, 12)\n  , (2002, 11, 2)\n  , (2003, 10, 23)\n  , (2004, 11, 10)\n  , (2005, 10, 30)\n  , (2006, 10, 19)\n  , (2007, 11, 7)\n  , (2008, 10, 26)\n  , (2009, 10, 15)\n  , (2010, 11, 3)\n  , (2011, 10, 24)\n  , (2012, 11, 11)\n  , (2013, 11, 1)\n  , (2014, 10, 21)\n  , (2015, 11, 9)\n  , (2016, 10, 28)\n  , (2017, 10, 17)\n  , (2018, 11, 5)\n  , (2019, 10, 25)\n  , (2020, 11, 13)\n  , (2021, 11, 2)\n  , (2022, 10, 22)\n  , (2023, 11, 10)\n  , (2024, 10, 29)\n  , (2025, 10, 18)\n  , (2026, 11, 6)\n  , (2027, 10, 27)\n  , (2028, 10, 15)\n  , (2029, 11, 4)\n  , (2030, 10, 24)\n  ]\n\nnavaratri :: TimeData\nnavaratri = computedDays navaratri'\n\nnavaratri' :: [TimeObject]\nnavaratri' = mapMaybe toTimeObjectM\n  [ (2000, 9, 28)\n  , (2001, 10, 17)\n  , (2002, 10, 7)\n  , (2003, 9, 26)\n  , (2004, 10, 14)\n  , (2005, 10, 4)\n  , (2006, 9, 23)\n  , (2007, 10, 12)\n  , (2008, 9, 30)\n  , (2009, 9, 19)\n  , (2010, 10, 8)\n  , (2011, 9, 28)\n  , (2012, 10, 16)\n  , (2013, 10, 5)\n  , (2014, 9, 25)\n  , (2015, 10, 13)\n  , (2016, 10, 1)\n  , (2017, 9, 21)\n  , (2018, 10, 9)\n  , (2019, 9, 29)\n  , (2020, 10, 17)\n  , (2021, 10, 6)\n  , (2022, 9, 26)\n  , (2023, 10, 15)\n  , (2024, 10, 3)\n  , (2025, 9, 22)\n  , (2026, 10, 11)\n  , (2027, 9, 30)\n  , (2028, 9, 19)\n  , (2029, 10, 8)\n  , (2030, 9, 27)\n  ]\n\nrakshaBandhan :: TimeData\nrakshaBandhan = computedDays rakshaBandhan'\n\nrakshaBandhan' :: [TimeObject]\nrakshaBandhan' = mapMaybe toTimeObjectM\n  [ (2000, 8, 15)\n  , (2001, 8, 4)\n  , (2002, 8, 22)\n  , (2003, 8, 12)\n  , (2004, 8, 29)\n  , (2005, 8, 19)\n  , (2006, 8, 9)\n  , (2007, 8, 28)\n  , (2008, 8, 16)\n  , (2009, 8, 5)\n  , (2010, 8, 24)\n  , (2011, 8, 13)\n  , (2012, 8, 2)\n  , (2013, 8, 20)\n  , (2014, 8, 10)\n  , (2015, 8, 29)\n  , (2016, 8, 18)\n  , (2017, 8, 7)\n  , (2018, 8, 26)\n  , (2019, 8, 15)\n  , (2020, 8, 3)\n  , (2021, 8, 22)\n  , (2022, 8, 11)\n  , (2023, 8, 30)\n  , (2024, 8, 19)\n  , (2025, 8, 9)\n  , (2026, 8, 28)\n  , (2027, 8, 17)\n  , (2028, 8, 5)\n  , (2029, 8, 23)\n  , (2030, 8, 13)\n  ]\n\nganeshChaturthi :: TimeData\nganeshChaturthi = computedDays ganeshChaturthi'\n\nganeshChaturthi' :: [TimeObject]\nganeshChaturthi' = mapMaybe toTimeObjectM\n  [ (2000, 9, 1)\n  , (2001, 8, 22)\n  , (2002, 9, 10)\n  , (2003, 8, 31)\n  , (2004, 9, 18)\n  , (2005, 9, 7)\n  , (2006, 8, 27)\n  , (2007, 9, 15)\n  , (2008, 9, 3)\n  , (2009, 8, 23)\n  , (2010, 9, 11)\n  , (2011, 9, 1)\n  , (2012, 9, 19)\n  , (2013, 9, 9)\n  , (2014, 8, 29)\n  , (2015, 9, 17)\n  , (2016, 9, 5)\n  , (2017, 8, 25)\n  , (2018, 9, 13)\n  , (2019, 9, 2)\n  , (2020, 8, 22)\n  , (2021, 9, 9)\n  , (2022, 8, 30)\n  , (2023, 9, 18)\n  , (2024, 9, 6)\n  , (2025, 8, 26)\n  , (2026, 9, 14)\n  , (2027, 9, 3)\n  , (2028, 8, 23)\n  , (2029, 9, 11)\n  , (2030, 9, 1)\n  ]\n\nmahavirJayanti :: TimeData\nmahavirJayanti = computedDays mahavirJayanti'\n\nmahavirJayanti' :: [TimeObject]\nmahavirJayanti' = mapMaybe toTimeObjectM\n  [ (2000, 4, 16)\n  , (2001, 4, 6)\n  , (2002, 4, 25)\n  , (2003, 4, 15)\n  , (2004, 4, 3)\n  , (2005, 4, 22)\n  , (2006, 4, 11)\n  , (2007, 3, 31)\n  , (2008, 4, 18)\n  , (2009, 4, 7)\n  , (2010, 3, 28)\n  , (2011, 4, 16)\n  , (2012, 4, 5)\n  , (2013, 4, 24)\n  , (2014, 4, 13)\n  , (2015, 4, 2)\n  , (2016, 4, 19)\n  , (2017, 4, 9)\n  , (2018, 3, 29)\n  , (2019, 4, 17)\n  , (2020, 4, 6)\n  , (2021, 4, 25)\n  , (2022, 4, 14)\n  , (2023, 4, 4)\n  , (2024, 4, 21)\n  , (2025, 4, 10)\n  , (2026, 3, 31)\n  , (2027, 4, 19)\n  , (2028, 4, 7)\n  , (2029, 4, 26)\n  , (2030, 4, 16)\n  ]\n\nthaiPongal :: TimeData\nthaiPongal = computedDays thaiPongal'\n\nthaiPongal' :: [TimeObject]\nthaiPongal' = mapMaybe toTimeObjectM\n  [ (2000, 1, 15)\n  , (2001, 1, 14)\n  , (2002, 1, 14)\n  , (2003, 1, 14)\n  , (2004, 1, 15)\n  , (2005, 1, 14)\n  , (2006, 1, 14)\n  , (2007, 1, 15)\n  , (2008, 1, 15)\n  , (2009, 1, 14)\n  , (2010, 1, 14)\n  , (2011, 1, 15)\n  , (2012, 1, 15)\n  , (2013, 1, 14)\n  , (2014, 1, 14)\n  , (2015, 1, 15)\n  , (2016, 1, 15)\n  , (2017, 1, 14)\n  , (2018, 1, 14)\n  , (2019, 1, 15)\n  , (2020, 1, 15)\n  , (2021, 1, 14)\n  , (2022, 1, 14)\n  , (2023, 1, 15)\n  , (2024, 1, 15)\n  , (2025, 1, 14)\n  , (2026, 1, 14)\n  , (2027, 1, 15)\n  , (2028, 1, 15)\n  , (2029, 1, 14)\n  , (2030, 1, 14)\n  ]\n\nmahaShivaRatri :: TimeData\nmahaShivaRatri = computedDays mahaShivaRatri'\n\nmahaShivaRatri' :: [TimeObject]\nmahaShivaRatri' = mapMaybe toTimeObjectM\n   [  (2000, 3, 4)\n   ,  (2001, 2, 21)\n   ,  (2002, 3, 12)\n   ,  (2003, 3, 1)\n   ,  (2004, 2, 18)\n   ,  (2005, 3, 8)\n   ,  (2006, 2, 26)\n   ,  (2007, 2, 16)\n   ,  (2008, 3, 6)\n   ,  (2009, 2, 23)\n   ,  (2010, 2, 12)\n   ,  (2011, 3, 2)\n   ,  (2012, 2, 20)\n   ,  (2013, 3, 10)\n   ,  (2014, 2, 27)\n   ,  (2015, 2, 17)\n   ,  (2016, 3, 7)\n   ,  (2017, 2, 24)\n   ,  (2018, 2, 13)\n   ,  (2019, 3, 4)\n   ,  (2020, 2, 21)\n   ,  (2021, 3, 11)\n   ,  (2022, 3, 1)\n   ,  (2023, 2, 18)\n   ,  (2024, 3, 8)\n   ,  (2025, 2, 26)\n   ,  (2026, 2, 15)\n   ,  (2027, 3, 6)\n   ,  (2028, 2, 23)\n   ,  (2029, 2, 11)\n   ,  (2030, 3, 2)\n   ]\n\nthiruOnam :: TimeData\nthiruOnam = computedDays thiruOnam'\n\nthiruOnam' :: [TimeObject]\nthiruOnam' = mapMaybe toTimeObjectM\n  [ (2000, 9, 10)\n  , (2001, 8, 31)\n  , (2002, 8, 21)\n  , (2003, 9, 8)\n  , (2004, 8, 28)\n  , (2005, 9, 15)\n  , (2006, 9, 5)\n  , (2007, 8, 26)\n  , (2008, 9, 12)\n  , (2009, 9, 2)\n  , (2010, 8, 23)\n  , (2011, 9, 9)\n  , (2012, 8, 29)\n  , (2013, 8, 20)\n  , (2014, 9, 6)\n  , (2015, 8, 28)\n  , (2016, 9, 13)\n  , (2017, 9, 4)\n  , (2018, 8, 24)\n  , (2019, 9, 11)\n  , (2020, 8, 31)\n  , (2021, 8, 21)\n  , (2022, 9, 8)\n  , (2023, 8, 29)\n  , (2024, 9, 15)\n  , (2025, 9, 5)\n  , (2026, 8, 26)\n  , (2027, 9, 12)\n  , (2028, 9, 1)\n  , (2029, 8, 22)\n  , (2030, 9, 9)\n  ]\n\nrathaYatra :: TimeData\nrathaYatra = computedDays rathaYatra'\n\nrathaYatra' :: [TimeObject]\nrathaYatra' = mapMaybe toTimeObjectM\n  [ (2000, 7, 2)\n  , (2001, 6, 22)\n  , (2002, 7, 11)\n  , (2003, 7, 1)\n  , (2004, 6, 19)\n  , (2005, 7, 8)\n  , (2006, 6, 27)\n  , (2007, 7, 16)\n  , (2008, 7, 4)\n  , (2009, 6, 24)\n  , (2010, 7, 13)\n  , (2011, 7, 3)\n  , (2012, 6, 21)\n  , (2013, 7, 10)\n  , (2014, 6, 29)\n  , (2015, 7, 18)\n  , (2016, 7, 6)\n  , (2017, 6, 25)\n  , (2018, 7, 14)\n  , (2019, 7, 4)\n  , (2020, 6, 23)\n  , (2021, 7, 11)\n  , (2022, 6, 30)\n  , (2023, 6, 19)\n  , (2024, 7, 7)\n  , (2025, 6, 26)\n  , (2026, 7, 15)\n  , (2027, 7, 5)\n  , (2028, 6, 24)\n  , (2029, 7, 13)\n  , (2030, 7, 2)\n  ]\n\nvasantPanchami :: TimeData\nvasantPanchami = computedDays vasantPanchami'\n\nvasantPanchami' :: [TimeObject]\nvasantPanchami' = mapMaybe toTimeObjectM\n  [ (2000, 2, 10)\n  , (2001, 1, 29)\n  , (2002, 2, 17)\n  , (2003, 2, 6)\n  , (2004, 1, 26)\n  , (2005, 2, 13)\n  , (2006, 2, 2)\n  , (2007, 1, 23)\n  , (2008, 2, 11)\n  , (2009, 1, 31)\n  , (2010, 1, 20)\n  , (2011, 2, 8)\n  , (2012, 1, 28)\n  , (2013, 2, 15)\n  , (2014, 2, 4)\n  , (2015, 1, 24)\n  , (2016, 2, 12)\n  , (2017, 2, 1)\n  , (2018, 1, 22)\n  , (2019, 2, 10)\n  , (2020, 1, 29)\n  , (2021, 2, 16)\n  , (2022, 2, 5)\n  , (2023, 1, 26)\n  , (2024, 2, 14)\n  , (2025, 2, 2)\n  , (2026, 1, 23)\n  , (2027, 2, 11)\n  , (2028, 1, 31)\n  , (2029, 1, 19)\n  , (2030, 2, 7)\n  ]\n\nglobalYouthServiceDay :: TimeData\nglobalYouthServiceDay = computedDays globalYouthServiceDay'\n\nglobalYouthServiceDay' :: [TimeObject]\nglobalYouthServiceDay' = mapMaybe toTimeObjectM\n  [ (2012, 4, 20)\n  , (2013, 4, 26)\n  , (2014, 4, 11)\n  , (2015, 4, 17)\n  , (2016, 4, 15)\n  , (2017, 4, 21)\n  , (2018, 4, 20)\n  ]\n\nguruGobindSinghJayanti :: TimeData\nguruGobindSinghJayanti = computedDays guruGobindSinghJayanti'\n\nguruGobindSinghJayanti' :: [TimeObject]\nguruGobindSinghJayanti' = mapMaybe toTimeObjectM\n  [ (2000, 1, 14)\n  , (2001, 1, 2)\n  , (2002, 1, 21)\n  , (2003, 12, 29)\n  , (2004, 1, 5)\n  , (2005, 1, 16)\n  , (2006, 12, 27)\n  , (2007, 1, 5)\n  , (2008, 1, 14)\n  , (2009, 12, 23)\n  , (2010, 1, 5)\n  , (2011, 1, 5)\n  , (2012, 1, 5)\n  , (2013, 1, 18)\n  , (2014, 1, 7)\n  , (2015, 1, 5)\n  , (2016, 1, 16)\n  , (2017, 12, 25)\n  , (2018, 1, 5)\n  , (2019, 1, 13)\n  , (2020, 2, 1)\n  , (2021, 1, 19)\n  , (2022, 1, 8)\n  , (2023, 1, 5)\n  , (2024, 1, 17)\n  , (2025, 1, 5)\n  , (2026, 1, 5)\n  , (2027, 1, 14)\n  , (2028, 1, 3)\n  , (2029, 1, 5)\n  , (2030, 1, 10)\n  ]\n\nkarvaChauth :: TimeData\nkarvaChauth = computedDays karvaChauth'\n\nkarvaChauth' :: [TimeObject]\nkarvaChauth' = mapMaybe toTimeObjectM\n    [ (2000, 10, 16)\n    , (2001, 10, 4)\n    , (2002, 10, 24)\n    , (2003, 10, 13)\n    , (2004, 10, 31)\n    , (2005, 10, 20)\n    , (2006, 10, 9)\n    , (2007, 10, 28)\n    , (2008, 10, 17)\n    , (2009, 10, 7)\n    , (2010, 10, 26)\n    , (2011, 10, 15)\n    , (2012, 10, 2)\n    , (2013, 10, 22)\n    , (2014, 10, 11)\n    , (2015, 10, 30)\n    , (2016, 10, 18)\n    , (2017, 10, 8)\n    , (2018, 10, 27)\n    , (2019, 10, 17)\n    , (2020, 10, 3)\n    , (2021, 10, 23)\n    , (2022, 10, 12)\n    , (2023, 10, 31)\n    , (2024, 10, 20)\n    , (2025, 10, 9)\n    , (2026, 10, 28)\n    , (2027, 10, 18)\n    , (2028, 10, 6)\n    , (2029, 10, 25)\n    , (2030, 10, 14)\n    ]\n\nkrishnaJanmashtami :: TimeData\nkrishnaJanmashtami = computedDays krishnaJanmashtami'\n\nkrishnaJanmashtami' :: [TimeObject]\nkrishnaJanmashtami' = mapMaybe toTimeObjectM\n    [ (2000, 8, 22)\n    , (2001, 8, 12)\n    , (2002, 8, 31)\n    , (2003, 8, 20)\n    , (2004, 9, 6)\n    , (2005, 8, 26)\n    , (2006, 8, 15)\n    , (2007, 9, 3)\n    , (2008, 8, 23)\n    , (2009, 8, 13)\n    , (2010, 9, 1)\n    , (2011, 8, 21)\n    , (2012, 8, 9)\n    , (2013, 8, 28)\n    , (2014, 8, 17)\n    , (2015, 9, 5)\n    , (2016, 8, 25)\n    , (2017, 8, 14)\n    , (2018, 9, 3)\n    , (2019, 8, 23)\n    , (2020, 8, 11)\n    , (2021, 8, 30)\n    , (2022, 8, 19)\n    , (2023, 9, 6)\n    , (2024, 8, 26)\n    , (2025, 8, 16)\n    , (2026, 9, 4)\n    , (2027, 8, 25)\n    , (2028, 8, 13)\n    , (2029, 9, 1)\n    , (2030, 8, 21)\n    ]\n\nvesak :: TimeData\nvesak = computedDays vesak'\n\nvesak' :: [TimeObject]\nvesak' = mapMaybe toTimeObjectM\n  [ (2000, 5, 18)\n  , (2001, 5, 7)\n  , (2002, 5, 26)\n  , (2003, 5, 15)\n  , (2004, 5, 4)\n  , (2005, 5, 23)\n  , (2006, 5, 12)\n  , (2007, 5, 31)\n  , (2008, 5, 19)\n  , (2009, 5, 8)\n  , (2010, 5, 27)\n  , (2011, 5, 17)\n  , (2012, 5, 5)\n  , (2013, 5, 24)\n  , (2014, 5, 14)\n  , (2015, 5, 3)\n  , (2016, 5, 21)\n  , (2017, 5, 10)\n  , (2018, 5, 29)\n  , (2019, 5, 18)\n  , (2020, 5, 7)\n  , (2021, 5, 26)\n  , (2022, 5, 15)\n  , (2023, 5, 5)\n  , (2024, 5, 23)\n  , (2025, 5, 12)\n  , (2026, 5, 31)\n  , (2027, 5, 20)\n  , (2028, 5, 8)\n  , (2029, 5, 27)\n  , (2030, 5, 17)\n  ]\n\nvaisakhi :: TimeData\nvaisakhi = computedDays vaisakhi'\n\nvaisakhi' :: [TimeObject]\nvaisakhi' = mapMaybe toTimeObjectM\n  [ (2000, 4, 13)\n  , (2001, 4, 13)\n  , (2002, 4, 14)\n  , (2003, 4, 14)\n  , (2004, 4, 13)\n  , (2005, 4, 13)\n  , (2006, 4, 14)\n  , (2007, 4, 14)\n  , (2008, 4, 13)\n  , (2009, 4, 14)\n  , (2010, 4, 14)\n  , (2011, 4, 14)\n  , (2012, 4, 13)\n  , (2013, 4, 14)\n  , (2014, 4, 14)\n  , (2015, 4, 14)\n  , (2016, 4, 13)\n  , (2017, 4, 14)\n  , (2018, 4, 14)\n  , (2019, 4, 14)\n  , (2020, 4, 13)\n  , (2021, 4, 14)\n  , (2022, 4, 14)\n  , (2023, 4, 14)\n  , (2024, 4, 13)\n  , (2025, 4, 14)\n  , (2026, 4, 14)\n  , (2027, 4, 14)\n  , (2028, 4, 13)\n  , (2029, 4, 14)\n  , (2030, 4, 14)\n  ]\n\npurim :: TimeData\npurim = computedDays purim'\n\npurim' :: [TimeObject]\npurim' = mapMaybe toTimeObjectM\n  [ (1950, 3, 2)\n  , (1951, 3, 21)\n  , (1952, 3, 10)\n  , (1953, 2, 28)\n  , (1954, 3, 18)\n  , (1955, 3, 7)\n  , (1956, 2, 25)\n  , (1957, 3, 16)\n  , (1958, 3, 5)\n  , (1959, 3, 23)\n  , (1960, 3, 12)\n  , (1961, 3, 1)\n  , (1962, 3, 19)\n  , (1963, 3, 9)\n  , (1964, 2, 26)\n  , (1965, 3, 17)\n  , (1966, 3, 5)\n  , (1967, 3, 25)\n  , (1968, 3, 13)\n  , (1969, 3, 3)\n  , (1970, 3, 21)\n  , (1971, 3, 10)\n  , (1972, 2, 28)\n  , (1973, 3, 17)\n  , (1974, 3, 7)\n  , (1975, 2, 24)\n  , (1976, 3, 15)\n  , (1977, 3, 3)\n  , (1978, 3, 22)\n  , (1979, 3, 12)\n  , (1980, 3, 1)\n  , (1981, 3, 19)\n  , (1982, 3, 8)\n  , (1983, 2, 26)\n  , (1984, 3, 17)\n  , (1985, 3, 6)\n  , (1986, 3, 24)\n  , (1987, 3, 14)\n  , (1988, 3, 2)\n  , (1989, 3, 20)\n  , (1990, 3, 10)\n  , (1991, 2, 27)\n  , (1992, 3, 18)\n  , (1993, 3, 6)\n  , (1994, 2, 24)\n  , (1995, 3, 15)\n  , (1996, 3, 4)\n  , (1997, 3, 22)\n  , (1998, 3, 11)\n  , (1999, 3, 1)\n  , (2000, 3, 20)\n  , (2001, 3, 8)\n  , (2002, 2, 27)\n  , (2003, 3, 19)\n  , (2004, 3, 6)\n  , (2005, 3, 24)\n  , (2006, 3, 13)\n  , (2007, 3, 3)\n  , (2008, 3, 20)\n  , (2009, 3, 9)\n  , (2010, 2, 27)\n  , (2011, 3, 19)\n  , (2012, 3, 7)\n  , (2013, 2, 23)\n  , (2014, 3, 15)\n  , (2015, 3, 4)\n  , (2016, 3, 23)\n  , (2017, 3, 11)\n  , (2018, 2, 28)\n  , (2019, 3, 20)\n  , (2020, 3, 9)\n  , (2021, 2, 25)\n  , (2022, 3, 16)\n  , (2023, 3, 6)\n  , (2024, 3, 23)\n  , (2025, 3, 13)\n  , (2026, 3, 2)\n  , (2027, 3, 22)\n  , (2028, 3, 11)\n  , (2029, 2, 28)\n  , (2030, 3, 18)\n  , (2031, 3, 8)\n  , (2032, 2, 25)\n  , (2033, 3, 14)\n  , (2034, 3, 4)\n  , (2035, 3, 24)\n  , (2036, 3, 12)\n  , (2037, 2, 28)\n  , (2038, 3, 20)\n  , (2039, 3, 9)\n  , (2040, 2, 27)\n  , (2041, 3, 16)\n  , (2042, 3, 5)\n  , (2043, 3, 25)\n  , (2044, 3, 12)\n  , (2045, 3, 2)\n  , (2046, 3, 21)\n  , (2047, 3, 11)\n  , (2048, 2, 27)\n  , (2049, 3, 17)\n  , (2050, 3, 7)\n  ]\n\nsaraswatiJayanti :: TimeData\nsaraswatiJayanti = computedDays saraswatiJayanti'\n\nsaraswatiJayanti' :: [TimeObject]\nsaraswatiJayanti' = mapMaybe toTimeObjectM\n  [ (2000, 2, 29)\n  , (2001, 2, 17)\n  , (2002, 3, 8)\n  , (2003, 2, 26)\n  , (2004, 2, 15)\n  , (2005, 3, 5)\n  , (2006, 2, 23)\n  , (2007, 2, 12)\n  , (2008, 3, 2)\n  , (2009, 2, 19)\n  , (2010, 2, 8)\n  , (2011, 2, 27)\n  , (2012, 2, 16)\n  , (2013, 3, 7)\n  , (2014, 2, 24)\n  , (2015, 2, 14)\n  , (2016, 3, 4)\n  , (2017, 2, 21)\n  , (2018, 2, 10)\n  , (2019, 2, 28)\n  , (2020, 2, 18)\n  , (2021, 3, 8)\n  , (2022, 2, 26)\n  , (2023, 2, 15)\n  , (2024, 3, 5)\n  , (2025, 2, 23)\n  , (2026, 2, 12)\n  , (2027, 3 , 2)\n  , (2028, 2, 19)\n  , (2029, 2, 8)\n  , (2030, 2, 27)\n  ]\n\nrabindraJayanti :: TimeData\nrabindraJayanti = computedDays rabindraJayanti'\n\nrabindraJayanti' :: [TimeObject]\nrabindraJayanti' = mapMaybe toTimeObjectM\n  [ (2000, 5, 8)\n  , (2001, 5, 9)\n  , (2002, 5, 9)\n  , (2003, 5, 9)\n  , (2004, 5, 8)\n  , (2005, 5, 9)\n  , (2006, 5, 9)\n  , (2007, 5, 9)\n  , (2008, 5, 8)\n  , (2009, 5, 9)\n  , (2010, 5, 9)\n  , (2011, 5, 9)\n  , (2012, 5, 8)\n  , (2013, 5, 9)\n  , (2014, 5, 9)\n  , (2015, 5, 9)\n  , (2016, 5, 8)\n  , (2017, 5, 9)\n  , (2018, 5, 9)\n  , (2019, 5, 9)\n  , (2020, 5, 8)\n  , (2021, 5, 9)\n  , (2022, 5, 9)\n  , (2023, 5, 9)\n  , (2024, 5, 8)\n  , (2025, 5, 9)\n  , (2026, 5, 9)\n  , (2027, 5 ,9)\n  , (2028, 5, 9)\n  , (2029, 5, 9)\n  , (2030, 5, 9)\n  ]\n\nravidassJayanti :: TimeData\nravidassJayanti = computedDays ravidassJayanti'\n\nravidassJayanti' :: [TimeObject]\nravidassJayanti' = mapMaybe toTimeObjectM\n  [ (2000, 2, 19)\n  , (2001, 2, 8)\n  , (2002, 2, 27)\n  , (2003, 2, 16)\n  , (2004, 2, 6)\n  , (2005, 2, 24)\n  , (2006, 2, 13)\n  , (2007, 2, 2)\n  , (2008, 2, 21)\n  , (2009, 2, 9)\n  , (2010, 1, 30)\n  , (2011, 2, 18)\n  , (2012, 2, 7)\n  , (2013, 2, 25)\n  , (2014, 2, 14)\n  , (2015, 2, 3)\n  , (2016, 2, 22)\n  , (2017, 2, 10)\n  , (2018, 1, 31)\n  , (2019, 2, 19)\n  , (2020, 2, 9)\n  , (2021, 2, 27)\n  , (2022, 2, 16)\n  , (2023, 2, 5)\n  , (2024, 2, 24)\n  , (2025, 2, 12)\n  , (2026, 2, 1)\n  , (2027, 2 ,20)\n  , (2028, 2, 10)\n  , (2029, 1, 30)\n  , (2030, 2, 18)\n  ]\n\npargatDiwas :: TimeData\npargatDiwas = computedDays pargatDiwas'\n\npargatDiwas' :: [TimeObject]\npargatDiwas' = mapMaybe toTimeObjectM\n  [ (2000, 10, 12)\n  , (2001, 10, 31)\n  , (2002, 10, 20)\n  , (2003, 10, 9)\n  , (2004, 10, 27)\n  , (2005, 10, 16)\n  , (2006, 10, 6)\n  , (2007, 10, 25)\n  , (2008, 10, 14)\n  , (2009, 10, 3)\n  , (2010, 10, 22)\n  , (2011, 10, 11)\n  , (2012, 10, 29)\n  , (2013, 10, 18)\n  , (2014, 10, 7)\n  , (2015, 10, 26)\n  , (2016, 10, 15)\n  , (2017, 10, 5)\n  , (2018, 10, 24)\n  , (2019, 10, 13)\n  , (2020, 10, 30)\n  , (2021, 10, 19)\n  , (2022, 10, 9)\n  , (2023, 10, 28)\n  , (2024, 10, 16)\n  , (2025, 10, 6)\n  , (2026, 10, 25)\n  , (2027, 10, 14)\n  , (2028, 10, 2)\n  , (2029, 10, 21)\n  , (2030, 10, 10)\n  ]\n\nugadi :: TimeData\nugadi = computedDays ugadi'\n\nugadi' :: [TimeObject]\nugadi' = mapMaybe toTimeObjectM\n  [ (2000, 4, 5)\n  , (2001, 3, 26)\n  , (2002, 4, 13)\n  , (2003, 4, 2)\n  , (2004, 3, 21)\n  , (2005, 4, 9)\n  , (2006, 3, 30)\n  , (2007, 3, 19)\n  , (2008, 4, 6)\n  , (2009, 3, 27)\n  , (2010, 3, 16)\n  , (2011, 4, 4)\n  , (2012, 3, 23)\n  , (2013, 4, 11)\n  , (2014, 3, 31)\n  , (2015, 3, 21)\n  , (2016, 4, 8)\n  , (2017, 3, 28)\n  , (2018, 3, 18)\n  , (2019, 4, 6)\n  , (2020, 3, 25)\n  , (2021, 4, 13)\n  , (2022, 4, 2)\n  , (2023, 3, 22)\n  , (2024, 4, 9)\n  , (2025, 3, 30)\n  , (2026, 3, 19)\n  , (2027, 4, 7)\n  , (2028, 3, 27)\n  , (2029, 4, 14)\n  , (2030, 4, 3)\n  ]\n\nramaNavami :: TimeData\nramaNavami = computedDays ramaNavami'\n\nramaNavami' :: [TimeObject]\nramaNavami' = mapMaybe toTimeObjectM\n  [ (2000, 4, 12)\n  , (2001, 4, 2)\n  , (2002, 4, 21)\n  , (2003, 4, 11)\n  , (2004, 3, 30)\n  , (2005, 4, 18)\n  , (2006, 4, 6)\n  , (2007, 3, 27)\n  , (2008, 4, 14)\n  , (2009, 4, 3)\n  , (2010, 3, 24)\n  , (2011, 4, 12)\n  , (2012, 4, 1)\n  , (2013, 4, 19)\n  , (2014, 4, 8)\n  , (2015, 3, 28)\n  , (2016, 4, 15)\n  , (2017, 4, 5)\n  , (2018, 3, 25)\n  , (2019, 4, 14)\n  , (2020, 4, 2)\n  , (2021, 4, 21)\n  , (2022, 4, 10)\n  , (2023, 3, 30)\n  , (2024, 4, 17)\n  , (2025, 4, 6)\n  , (2026, 3, 27)\n  , (2027, 4, 15)\n  , (2028, 4, 4)\n  , (2029, 4, 23)\n  , (2030, 4, 12)\n  ]\n\nsuperTuesday :: TimeData\nsuperTuesday = computedDays superTuesday'\n\nsuperTuesday' :: [TimeObject]\nsuperTuesday' = mapMaybe toTimeObjectM\n  [ (1984, 3, 13)\n  , (1988, 3, 8)\n  , (1992, 3, 10)\n  , (1996, 3, 12)\n  , (2000, 3, 7)\n  , (2004, 3, 2)\n  , (2008, 2, 5)\n  , (2012, 3, 6)\n  , (2016, 3, 1)\n  , (2020, 3, 3)\n  ]\n", "num_lines": 2522}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.Corpus\n  ( datetime\n  , datetimeHoliday\n  , datetimeInterval\n  , datetimeIntervalHoliday\n  , datetimeOpenInterval\n  , examples\n  ) where\n\nimport Data.Aeson\nimport qualified Data.HashMap.Strict as H\nimport Data.Text (Text)\nimport qualified Data.Time.LocalTime.TimeZone.Series as Series\nimport Prelude\nimport Data.String\n\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Types hiding (Entity(..))\n\ndatetime :: Datetime -> Grain -> Context -> TimeValue\ndatetime d g ctx = datetimeIntervalHolidayHelper (d, Nothing) g Nothing ctx\n\ndatetimeHoliday :: Datetime -> Grain -> Text -> Context -> TimeValue\ndatetimeHoliday d g h ctx =\n  datetimeIntervalHolidayHelper (d, Nothing) g (Just h) ctx\n\ndatetimeInterval :: (Datetime, Datetime) -> Grain -> Context -> TimeValue\ndatetimeInterval (d1, d2) g ctx =\n  datetimeIntervalHolidayHelper (d1, Just d2) g Nothing ctx\n\ndatetimeIntervalHoliday ::\n  (Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue\ndatetimeIntervalHoliday (d1, d2) g h ctx =\n  datetimeIntervalHolidayHelper (d1, Just d2) g (Just h) ctx\n\ndatetimeIntervalHolidayHelper ::\n  (Datetime, Maybe Datetime) -> Grain -> Maybe Text -> Context -> TimeValue\ndatetimeIntervalHolidayHelper (d1, md2) g hol ctx = TimeValue tv [tv] hol\n  where\n    DucklingTime (Series.ZoneSeriesTime _ tzSeries) = referenceTime ctx\n    tv = timeValue tzSeries TimeObject {start = dt d1, end = d, grain = g}\n    d = case md2 of\n      Nothing -> Nothing\n      Just d2 -> Just $ dt d2\n\ndatetimeOpenInterval\n  :: IntervalDirection -> Datetime -> Grain -> Context -> TimeValue\ndatetimeOpenInterval dir d g ctx = TimeValue tv [tv] Nothing\n  where\n    DucklingTime (Series.ZoneSeriesTime _ tzSeries) = referenceTime ctx\n    tv = openInterval tzSeries dir TimeObject\n      {start = dt d, end = Nothing, grain = g}\n\n\ncheck :: ToJSON a => (Context -> a) -> TestPredicate\ncheck f context Resolved{rval = RVal _ v} = case toJSON v of\n  Object o -> deleteValues (toJSON (f context)) == deleteValues (Object o)\n  _ -> False\n  where\n    deleteValues :: Value -> Value\n    deleteValues (Object o) = Object $ H.delete \"values\" o\n    deleteValues _ = Object H.empty\n\nexamples :: ToJSON a => (Context -> a) -> [Text] -> [Example]\nexamples f = examplesCustom (check f)\n", "num_lines": 79}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE TupleSections #-}\n\nmodule Duckling.Time.Helpers\n  ( -- Patterns\n    hasNoDirection, isADayOfWeek, isAMonth, isAnHourOfDay, isAPartOfDay\n  , isATimeOfDay, isDurationGreaterThan, isDOMInteger, isDOMOrdinal, isDOMValue\n  , isGrainFinerThan, isGrainCoarserThan, isGrainOfTime\n  , isIntegerBetween, isNotLatent , isOrdinalBetween, isMidnightOrNoon\n  , isOkWithThisNext, sameGrain, hasTimezone, hasNoTimezone, today\n    -- Production\n  , cycleLastOf, cycleN, cycleNth, cycleNthAfter, dayOfMonth, dayOfWeek\n  , durationAfter, durationAgo, durationBefore, mkOkForThisNext, form, hour\n  , hourMinute, hourMinuteSecond, inDuration, intersect, intersectDOM, interval\n  , inTimezone, longWEBefore, minute, minutesAfter, minutesBefore, mkLatent\n  , month, monthDay, notLatent, now, nthDOWOfMonth, partOfDay, predLastOf\n  , predNth, predNthAfter, predNthClosest, season, second, timeOfDayAMPM\n  , weekday, weekend, workweek, withDirection, year, yearMonthDay, tt, durationIntervalAgo\n  , inDurationInterval, intersectWithReplacement, yearADBC, yearMonth\n  , predEveryNDaysFrom, timeCycle\n    -- Other\n  , getIntValue, timeComputed, toTimeObjectM\n  -- Rule constructors\n  , mkRuleInstants\n  , mkRuleDaysOfWeek, mkRuleDaysOfWeekLatent\n  , mkRuleMonths, mkRuleMonthsWithLatent\n  , mkRuleSeasons, mkRuleHolidays, mkRuleHolidays'\n  ) where\n\nimport Control.Applicative ((<|>))\nimport Data.Maybe\nimport Data.Ord (comparing)\nimport Data.Text (Text)\nimport Data.Tuple.Extra (both)\nimport Prelude hiding (pred)\nimport qualified Data.Time as Time\nimport qualified Data.Time.LocalTime.TimeZone.Series as Series\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Types (DurationData (DurationData))\nimport Duckling.Ordinal.Types (OrdinalData (OrdinalData))\nimport Duckling.Time.TimeZone.Parse (parseTimezone)\nimport Duckling.Time.Types\n  ( TimeData(TimeData)\n  , mkSeriesPredicate\n  , mkSecondPredicate\n  , mkMinutePredicate\n  , mkHourPredicate\n  , mkAMPMPredicate\n  , mkMonthPredicate\n  , mkDayOfTheWeekPredicate\n  , mkDayOfTheMonthPredicate\n  , mkYearPredicate\n  , mkIntersectPredicate\n  , mkTimeIntervalsPredicate\n  , mkReplaceIntersectPredicate\n  , runPredicate\n  , AMPM(..)\n  )\nimport Duckling.Types\n  ( Predicate\n  , Token(..)\n  , regex\n  , Rule\n  )\nimport qualified Duckling.Types as Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\ngetIntValue :: Token -> Maybe Int\ngetIntValue (Token Numeral nd) = TNumeral.getIntValue $ TNumeral.value nd\ngetIntValue (Token Ordinal OrdinalData {TOrdinal.value = x}) = Just x\ngetIntValue _ = Nothing\n\ntimeNegPeriod :: DurationData -> DurationData\ntimeNegPeriod (DurationData v g) = DurationData\n  {TDuration.grain = g, TDuration.value = negate v}\n\ntimeShiftPeriod :: Int -> DurationData -> DurationData\ntimeShiftPeriod n dd@DurationData{TDuration.value = v} =\n  dd{TDuration.value = v + n}\n\n-- -----------------------------------------------------------------\n-- Time predicates\n\ntimeComputed :: [TTime.TimeObject] -> TTime.Predicate\ntimeComputed xs = mkSeriesPredicate series\n  where\n    series t _ = (reverse start, end)\n      where\n        (start, end) = span (`TTime.timeBefore` t) xs\n\ntimeCycle :: TG.Grain -> TTime.Predicate\ntimeCycle grain = mkSeriesPredicate series\n  where\n  series t _ = TTime.timeSequence grain 1 $ TTime.timeRound t grain\n\ntimeSecond :: Int -> TTime.Predicate\ntimeSecond n = mkSecondPredicate n\n\ntimeMinute :: Int -> TTime.Predicate\ntimeMinute n = mkMinutePredicate n\n\ntimeHour :: Bool -> Int -> TTime.Predicate\ntimeHour is12H n = mkHourPredicate is12H n\n\ntimeDayOfWeek :: Int -> TTime.Predicate\ntimeDayOfWeek n = mkDayOfTheWeekPredicate n\n\ntimeDayOfMonth :: Int -> TTime.Predicate\ntimeDayOfMonth n = mkDayOfTheMonthPredicate n\n\ntimeMonth :: Int -> TTime.Predicate\ntimeMonth n = mkMonthPredicate n\n\ntimeYear :: Int -> TTime.Predicate\ntimeYear n = mkYearPredicate n\n\n-- | Takes `n` cycles of `f`\ntakeN :: Int -> Bool -> TTime.Predicate -> TTime.Predicate\ntakeN n notImmediate f = mkSeriesPredicate series\n  where\n  series t context =\n    case slot of\n      Just nth -> if TTime.timeStartsBeforeTheEndOf t nth\n        then ([], [nth])\n        else ([nth], [])\n      Nothing -> ([], [])\n    where\n      baseTime = TTime.refTime context\n      (past, future) = runPredicate f baseTime context\n      fut = case future of\n        (ahead:rest)\n          | notImmediate && isJust (TTime.timeIntersect ahead baseTime) -> rest\n        _ -> future\n      slot = if n >= 0\n        then case fut of\n          (start:_) -> case drop n fut of\n            (end:_) -> Just $ TTime.timeInterval TTime.Open start end\n            _ -> Nothing\n          _ -> Nothing\n        else case past of\n          (end:_) -> case drop ((- n) - 1) past of\n            (start:_) -> Just $ TTime.timeInterval TTime.Closed start end\n            _ -> Nothing\n          _ -> Nothing\n\n-- | -1 is the first element in the past\n-- | 0 is the first element in the future\ntakeNth :: Int -> Bool -> TTime.Predicate -> TTime.Predicate\ntakeNth n notImmediate f = mkSeriesPredicate series\n  where\n  series t context =\n    case rest of\n      [] -> ([], [])\n      (nth:_) -> if TTime.timeStartsBeforeTheEndOf t nth\n        then ([], [nth])\n        else ([nth], [])\n    where\n      baseTime = TTime.refTime context\n      (past, future) = runPredicate f baseTime context\n      rest = if n >= 0\n        then case future of\n          (ahead:_) | notImmediate && isJust (TTime.timeIntersect ahead baseTime)\n            -> drop (n + 1) future\n          _ -> drop n future\n        else drop (- (n + 1)) past\n\n-- | Like `takeNth`, but takes the nth cyclic predicate after `basePred`\ntakeNthAfter\n  :: Int\n  -> Bool\n  -> TTime.Predicate\n  -> TTime.Predicate\n  -> TTime.Predicate\ntakeNthAfter n notImmediate cyclicPred basePred =\n  mkSeriesPredicate $! TTime.timeSeqMap False f basePred\n  where\n    f t ctx =\n      let (past, future) = runPredicate cyclicPred t ctx\n          rest = if n >= 0\n                   then case future of\n                     (ahead:_) | notImmediate && TTime.timeBefore ahead t\n                       -> drop (n + 1) future\n                     _ -> drop n future\n                   else drop (- (n + 1)) past\n      in case rest of\n           [] -> Nothing\n           (nth:_) -> Just nth\n\n-- | Take the nth closest value to `basePred` among those yielded by\n-- `cyclicPred`.\n-- n = 0 is the closest value, n = 1 is the second closest value, etc.\n-- n < 0 is treated as n = 0.\ntakeNthClosest :: Int -> TTime.Predicate -> TTime.Predicate -> TTime.Predicate\ntakeNthClosest n cyclicPred basePred =\n  mkSeriesPredicate $! TTime.timeSeqMap False f basePred\n  where\n  f t ctx = mth (n `max` 0) past future Nothing\n    where\n    (past, future) = runPredicate cyclicPred t ctx\n    mth m pa fu res\n      | m < 0 = res\n      | otherwise = case comparing against x y of\n          GT -> mth (m-1) (tailSafe pa) fu x\n          _ -> mth (m-1) pa (tailSafe fu) y\n      where (x,y) = both listToMaybe (pa,fu)\n    against :: Maybe TTime.TimeObject -> Maybe Time.NominalDiffTime\n    against = fmap (negate . TTime.diffStartTime t)\n    tailSafe :: [a] -> [a]\n    tailSafe (_:xs) = xs\n    tailSafe [] = []\n\n-- | Takes the last occurrence of `cyclicPred` within `basePred`.\ntakeLastOf :: TTime.Predicate -> TTime.Predicate -> TTime.Predicate\ntakeLastOf cyclicPred basePred =\n  mkSeriesPredicate $! TTime.timeSeqMap False f basePred\n  where\n    f :: TTime.TimeObject -> TTime.TimeContext -> Maybe TTime.TimeObject\n    f t ctx =\n      case runPredicate cyclicPred (TTime.timeStartingAtTheEndOf t) ctx of\n        (nth:_, _) -> Just nth\n        _ -> Nothing\n\n-- | Assumes the grain of `pred1` is smaller than the one of `pred2`\ntimeCompose :: TTime.Predicate -> TTime.Predicate -> TTime.Predicate\ntimeCompose pred1 pred2 = mkIntersectPredicate pred1 pred2\n\ntimeComposeWithReplacement\n  :: TTime.Predicate -> TTime.Predicate -> TTime.Predicate -> TTime.Predicate\ntimeComposeWithReplacement pred1 pred2 pred3 =\n  mkReplaceIntersectPredicate pred1 pred2 pred3\n\naddDuration :: DurationData -> TTime.TimeObject -> TTime.TimeObject\naddDuration (DurationData n g) t = TTime.timePlus t g $ toInteger n\n\nmergeDuration :: TTime.Predicate -> DurationData -> TTime.Predicate\nmergeDuration pred1 dd@(DurationData _ g) =\n  mkSeriesPredicate $! TTime.timeSeqMap False f pred1\n  where\n    f x@TTime.TimeObject{TTime.grain = tg} _ = Just $ addDuration dd t'\n      where\n        g' = min tg g\n        t' = if g' == tg then x else TTime.timeRound x g'\n\nshiftDuration :: TTime.Predicate -> DurationData -> TTime.Predicate\nshiftDuration pred1 dd@(DurationData _ g) =\n  mkSeriesPredicate $! TTime.timeSeqMap False f pred1\n  where\n    f x _ = Just $ addDuration dd $ TTime.timeRound x $ TG.lower g\n\nshiftTimezone :: Series.TimeZoneSeries -> TTime.Predicate -> TTime.Predicate\nshiftTimezone providedSeries pred1 =\n  mkSeriesPredicate $! TTime.timeSeqMap False f pred1\n  where\n    f x@(TTime.TimeObject s _ _) ctx =\n      let Time.TimeZone ctxOffset _ _ =\n            Series.timeZoneFromSeries (TTime.tzSeries ctx) s\n          Time.TimeZone providedOffset _ _ =\n            Series.timeZoneFromSeries providedSeries s\n      -- This forgets about TTime.end, but it's OK since we act on time-of-days.\n      in Just $ TTime.timePlus x TG.Minute $ toInteger $\n           ctxOffset - providedOffset\n\n-- -----------------------------------------------------------------\n-- Patterns\n\nisGrainFinerThan :: TG.Grain -> Predicate\nisGrainFinerThan value (Token Time TimeData{TTime.timeGrain = g}) = g < value\nisGrainFinerThan _ _ = False\n\nisGrainCoarserThan :: TG.Grain -> Predicate\nisGrainCoarserThan value (Token Time TimeData{TTime.timeGrain = g}) = g > value\nisGrainCoarserThan _ _ = False\n\nisGrainOfTime :: TG.Grain -> Predicate\nisGrainOfTime value (Token Time TimeData{TTime.timeGrain = g}) = g == value\nisGrainOfTime _ _ = False\n\nsameGrain :: TimeData -> TimeData -> Bool\nsameGrain TimeData{TTime.timeGrain = g} TimeData{TTime.timeGrain = h} = g == h\n\nhasTimezone :: Predicate\nhasTimezone (Token Time TimeData{TTime.hasTimezone = tz}) = tz\nhasTimezone _ = False\n\nhasNoTimezone :: Predicate\nhasNoTimezone = not . hasTimezone\n\nisADayOfWeek :: Predicate\nisADayOfWeek (Token Time td) = case TTime.form td of\n  Just TTime.DayOfWeek -> True\n  _ -> False\nisADayOfWeek _ = False\n\nisATimeOfDay :: Predicate\nisATimeOfDay (Token Time td) = case TTime.form td of\n  Just (TTime.TimeOfDay _ _) -> True\n  _ -> False\nisATimeOfDay _ = False\n\nisAPartOfDay :: Predicate\nisAPartOfDay (Token Time td) = case TTime.form td of\n  Just TTime.PartOfDay -> True\n  _ -> False\nisAPartOfDay _ = False\n\nisAMonth :: Predicate\nisAMonth (Token Time td) = case TTime.form td of\n  Just (TTime.Month _) -> True\n  _ -> False\nisAMonth _ = False\n\nisAnHourOfDay :: Predicate\nisAnHourOfDay (Token Time td) = case TTime.form td of\n  Just (TTime.TimeOfDay (Just _) _) | TTime.timeGrain td > TG.Minute -> True\n  _ -> False\nisAnHourOfDay _ = False\n\nisMidnightOrNoon :: Predicate\nisMidnightOrNoon (Token Time td) = case TTime.form td of\n  Just (TTime.TimeOfDay (Just x) _) -> x == 0 || x == 12\n  _ -> False\nisMidnightOrNoon _ = False\n\nisNotLatent :: Predicate\nisNotLatent (Token Time td) = not $ TTime.latent td\nisNotLatent _ = False\n\nhasNoDirection :: Predicate\nhasNoDirection (Token Time td) = isNothing $ TTime.direction td\nhasNoDirection _ = False\n\nisIntegerBetween :: Int -> Int -> Predicate\nisIntegerBetween low high (Token Numeral nd) = TNumeral.okForAnyTime nd\n  && TNumeral.isIntegerBetween (TNumeral.value nd) low high\nisIntegerBetween _ _ _ = False\n\nisOrdinalBetween :: Int -> Int -> Predicate\nisOrdinalBetween low high (Token Ordinal od) =\n  TOrdinal.isBetween (TOrdinal.value od) low high\nisOrdinalBetween _ _ _ = False\n\nisDurationGreaterThan :: TG.Grain -> Predicate\nisDurationGreaterThan value (Token Duration DurationData{TDuration.grain = grain}) = grain > value\nisDurationGreaterThan _ _ = False\n\nisDOMOrdinal :: Predicate\nisDOMOrdinal = isOrdinalBetween 1 31\n\nisDOMInteger :: Predicate\nisDOMInteger = isIntegerBetween 1 31\n\nisDOMValue :: Predicate\nisDOMValue = or . sequence [isDOMOrdinal, isDOMInteger]\n\nisOkWithThisNext :: Predicate\nisOkWithThisNext (Token Time TimeData {TTime.okForThisNext = True}) = True\nisOkWithThisNext _ = False\n\n-- -----------------------------------------------------------------\n-- Production\n\n-- Pass the interval second\nintersect :: TimeData -> TimeData -> Maybe TimeData\nintersect td1 td2 =\n  case intersect' (td1, td2) of\n    TTime.TimeData { TTime.timePred = pred }\n      | TTime.isEmptyPredicate pred -> Nothing\n    res -> Just res\n\nintersectWithReplacement :: TimeData -> TimeData -> TimeData -> Maybe TimeData\nintersectWithReplacement\n  (TimeData pred1 _ g1 _ _ _ _ h1 _)\n  (TimeData pred2 _ g2 _ _ _ _ h2 _)\n  (TimeData pred3 _ g3 _ _ _ _ h3 _)\n  | g1 == g2 && g2 == g3 = Just $ TTime.timedata'\n    { TTime.timePred = timeComposeWithReplacement pred1 pred2 pred3\n    , TTime.timeGrain = g1\n    , TTime.direction = Nothing\n    , TTime.holiday = h1 <|> h2 <|> h3\n    }\n  | otherwise = Nothing\n\nintersect' :: (TimeData, TimeData) -> TimeData\nintersect' (TimeData pred1 _ g1 _ _ d1 _ h1 _, TimeData pred2 _ g2 _ _ d2 _ h2 _)\n  | g1 < g2 = TTime.timedata'\n    { TTime.timePred = timeCompose pred1 pred2\n    , TTime.timeGrain = g1\n    , TTime.direction = d1 <|> d2\n    , TTime.holiday = h1 <|> h2\n    }\n  | otherwise = TTime.timedata'\n    { TTime.timePred = timeCompose pred2 pred1\n    , TTime.timeGrain = g2\n    , TTime.direction = d1 <|> d2\n    , TTime.holiday = h1 <|> h2\n    }\n\nnow :: TimeData\nnow = td {TTime.timeGrain = TG.NoGrain}\n  where\n    td = cycleNth TG.Second 0\n\ntoday :: TimeData\ntoday = cycleNth TG.Day 0\n\nhour :: Bool -> Int -> TimeData\nhour is12H n = timeOfDay (Just n) is12H $ TTime.timedata'\n  {TTime.timePred = timeHour is12H n, TTime.timeGrain = TG.Hour}\n\nminute :: Int -> TimeData\nminute n = TTime.timedata'\n  {TTime.timePred = timeMinute n, TTime.timeGrain = TG.Minute}\n\nsecond :: Int -> TimeData\nsecond n = TTime.timedata'\n  {TTime.timePred = timeSecond n, TTime.timeGrain = TG.Second}\n\ndayOfWeek :: Int -> TimeData\ndayOfWeek n = form TTime.DayOfWeek $ TTime.timedata'\n  { TTime.timePred = timeDayOfWeek n\n  , TTime.timeGrain = TG.Day\n  , TTime.notImmediate = True\n  }\n\ndayOfMonth :: Int -> TimeData\ndayOfMonth n = TTime.timedata'\n  {TTime.timePred = timeDayOfMonth n, TTime.timeGrain = TG.Day}\n\nmonth :: Int -> TimeData\nmonth n = form TTime.Month {TTime.month = n} $ TTime.timedata'\n  {TTime.timePred = timeMonth n, TTime.timeGrain = TG.Month}\n\n-- | Converts 2-digits to a year between 1950 and 2050\nyear :: Int -> TimeData\nyear n = TTime.timedata'{TTime.timePred = timeYear y, TTime.timeGrain = TG.Year}\n  where\n    y = if n <= 99 then mod (n + 50) 100 + 2000 - 50 else n\n\nyearADBC :: Int -> TimeData\nyearADBC n =\n  TTime.timedata'{TTime.timePred = timeYear n, TTime.timeGrain = TG.Year}\n\nyearMonth :: Int -> Int -> TimeData\nyearMonth y m = intersect' (year y, month m)\n\nyearMonthDay :: Int -> Int -> Int -> TimeData\nyearMonthDay y m d = intersect' (yearMonth y m, dayOfMonth d)\n\nmonthDay :: Int -> Int -> TimeData\nmonthDay m d = intersect' (month m, dayOfMonth d)\n\nhourMinute :: Bool -> Int -> Int -> TimeData\nhourMinute is12H h m = timeOfDay (Just h) is12H $\n  intersect' (hour is12H h, minute m)\n\nhourMinuteSecond :: Bool -> Int -> Int -> Int -> TimeData\nhourMinuteSecond is12H h m s = timeOfDay (Just h) is12H $\n  intersect' (intersect' (hour is12H h, minute m), second s)\n\nseason :: TimeData\nseason = TTime.timedata'\n  { TTime.timePred = TTime.seasonPredicate\n  , TTime.timeGrain = TG.Day\n  }\n\n-- | Note that this function is not the counterpart of `weekend`.\n-- `weekend` returns an interval while `weekday` returns a single day.\nweekday :: TimeData\nweekday = TTime.timedata'\n  { TTime.timePred = TTime.weekdayPredicate\n  , TTime.timeGrain = TG.Day\n  }\n\ncycleN :: Bool -> TG.Grain -> Int -> TimeData\ncycleN notImmediate grain n = TTime.timedata'\n  { TTime.timePred = takeN n notImmediate $ timeCycle grain\n  , TTime.timeGrain = grain\n  }\n\ncycleNth :: TG.Grain -> Int -> TimeData\ncycleNth grain n = TTime.timedata'\n  {TTime.timePred = takeNth n False $ timeCycle grain, TTime.timeGrain = grain}\n\ncycleNthAfter :: Bool -> TG.Grain -> Int -> TimeData -> TimeData\ncycleNthAfter notImmediate grain n TimeData {TTime.timePred = p} =\n  TTime.timedata'\n    { TTime.timePred = takeNthAfter n notImmediate (timeCycle grain) p\n    , TTime.timeGrain = grain\n    }\n\ncycleLastOf :: TG.Grain -> TimeData -> TimeData\ncycleLastOf grain TimeData {TTime.timePred = p} = TTime.timedata'\n  { TTime.timePred = takeLastOf (timeCycle grain) p\n  , TTime.timeGrain = grain\n  }\n\n-- Generalized version of cycleLastOf with custom predicate\npredLastOf :: TimeData -> TimeData -> TimeData\npredLastOf TimeData {TTime.timePred = cyclicPred, TTime.timeGrain = g} base =\n  TTime.timedata'\n    { TTime.timePred = takeLastOf cyclicPred $ TTime.timePred base\n    , TTime.timeGrain = g\n    }\n\n-- Generalized version of cycleNth with custom predicate\npredNth :: Int -> Bool -> TimeData -> TimeData\npredNth n notImmediate TimeData\n  {TTime.timePred = p, TTime.timeGrain = g, TTime.holiday = h} =\n  TTime.timedata'\n    {TTime.timePred = takeNth n notImmediate p\n    , TTime.timeGrain = g\n    , TTime.holiday = h}\n\n-- Generalized version of `cycleNthAfter` with custom predicate\npredNthAfter :: Int -> TimeData -> TimeData -> TimeData\npredNthAfter n TimeData\n  {TTime.timePred = p, TTime.timeGrain = g, TTime.holiday = h} base =\n  TTime.timedata'\n    { TTime.timePred = takeNthAfter n True p $ TTime.timePred base\n    , TTime.timeGrain = g\n    , TTime.holiday = h\n    }\n\n-- This function can be used to express predicates invoving \"closest\",\n-- such as \"the second closest Monday to Oct 5th\"\npredNthClosest :: Int -> TimeData -> TimeData -> TimeData\npredNthClosest n TimeData\n  {TTime.timePred = p, TTime.timeGrain = g, TTime.holiday = h} base =\n  TTime.timedata'\n    { TTime.timePred = takeNthClosest n p $ TTime.timePred base\n    , TTime.timeGrain = g\n    , TTime.holiday = h\n    }\n\n-- This function is used for periodic events, for example,\n-- \"every 365 days\" or \"every 8 years\".\n-- `given` is a known example of the event.\n-- Do not export\npredEveryFrom :: TG.Grain -> Int -> TTime.TimeObject -> TimeData\npredEveryFrom periodGrain period given = TTime.timedata'\n    { TTime.timePred = TTime.periodicPredicate periodGrain period given\n    , TTime.timeGrain = TTime.grain given\n    }\n\npredEveryNDaysFrom :: Int -> (Integer, Int, Int) -> Maybe TimeData\npredEveryNDaysFrom period given = do\n  date <- toTimeObjectM given\n  return $ predEveryFrom TG.Day period date\n\ntoTimeObjectM :: (Integer, Int, Int) -> Maybe TTime.TimeObject\ntoTimeObjectM (y, m, d) = do\n  day <- Time.fromGregorianValid y m d\n  return TTime.TimeObject\n    { TTime.start = Time.UTCTime day 0\n    , TTime.grain = TG.Day\n    , TTime.end = Nothing\n    }\n\ninterval' :: TTime.TimeIntervalType -> (TimeData, TimeData) -> TimeData\ninterval' intervalType (TimeData p1 _ g1 _ _ _ _ _ _, TimeData p2 _ g2 _ _ _ _ _ _) =\n  TTime.timedata'\n    { TTime.timePred = mkTimeIntervalsPredicate intervalType' p1 p2\n    , TTime.timeGrain = min g1 g2\n    }\n    where\n      intervalType'\n        | g1 == g2 && g1 == TG.Day = TTime.Closed\n        | otherwise = intervalType\n\ninterval :: TTime.TimeIntervalType -> TimeData -> TimeData -> Maybe TimeData\ninterval intervalType td1 td2 =\n  case interval' intervalType (td1, td2) of\n    TTime.TimeData { TTime.timePred = pred }\n      | TTime.isEmptyPredicate pred -> Nothing\n    res -> Just res\n\nmkOkForThisNext :: TimeData -> TimeData\nmkOkForThisNext td = td {TTime.okForThisNext = True}\n\ndurationAgo :: DurationData -> TimeData\ndurationAgo dd = inDuration $ timeNegPeriod dd\n\ndurationIntervalAgo :: DurationData -> TimeData\ndurationIntervalAgo dd = inDurationInterval $ timeNegPeriod dd\n\ndurationAfter :: DurationData -> TimeData -> TimeData\ndurationAfter dd TimeData {TTime.timePred = pred1, TTime.timeGrain = g} =\n  TTime.timedata'\n    { TTime.timePred = if g == TG.NoGrain\n      then shiftDuration pred1 dd\n      else mergeDuration pred1 dd\n    , TTime.timeGrain = TDuration.grain dd\n    }\n\ndurationBefore :: DurationData -> TimeData -> TimeData\ndurationBefore dd pred1 = durationAfter (timeNegPeriod dd) pred1\n\ninDuration :: DurationData -> TimeData\ninDuration dd = TTime.timedata'\n  { TTime.timePred = shiftDuration t dd\n  , TTime.timeGrain = TDuration.grain dd\n  }\n  where\n    t = takeNth 0 False $ timeCycle TG.Second\n\ninDurationInterval :: DurationData -> TimeData\ninDurationInterval dd = interval' TTime.Open\n  (inDuration dd, inDuration $ timeShiftPeriod 1 dd)\n\ninTimezone :: Text -> TimeData -> Maybe TimeData\ninTimezone input td@TimeData {TTime.timePred = p} = do\n  tz <- parseTimezone input\n  Just $ td {TTime.timePred = shiftTimezone (Series.TimeZoneSeries tz []) p, TTime.hasTimezone = True}\n\nwithHoliday :: Text -> TimeData -> TimeData\nwithHoliday n td = td {TTime.holiday = Just n}\n\nmkLatent :: TimeData -> TimeData\nmkLatent td = td {TTime.latent = True}\n\nnotLatent :: TimeData -> TimeData\nnotLatent td = td {TTime.latent = False}\n\nform :: TTime.Form -> TimeData -> TimeData\nform f td = td {TTime.form = Just f}\n\npartOfDay :: TimeData -> TimeData\npartOfDay td = form TTime.PartOfDay td\n\ntimeOfDay :: Maybe Int -> Bool -> TimeData -> TimeData\ntimeOfDay h is12H = form TTime.TimeOfDay {TTime.hours = h, TTime.is12H = is12H}\n\ntimeOfDayAMPM :: Bool -> TimeData -> TimeData\ntimeOfDayAMPM isAM tod = timeOfDay Nothing False $ intersect' (tod, ampm)\n  where\n    ampm = TTime.timedata'\n           { TTime.timePred = ampmPred\n           , TTime.timeGrain = TG.Hour\n           }\n    ampmPred = if isAM then mkAMPMPredicate AM else mkAMPMPredicate PM\n\nwithDirection :: TTime.IntervalDirection -> TimeData -> TimeData\nwithDirection dir td = td {TTime.direction = Just dir}\n\nlongWEBefore :: TimeData -> TimeData\nlongWEBefore monday = interval' TTime.Open (start, end)\n  where\n    start = intersect' (fri, hour False 18)\n    end = intersect' (tue, hour False 0)\n    fri = cycleNthAfter False TG.Day (- 3) monday\n    tue = cycleNthAfter False TG.Day 1 monday\n\nweekend :: TimeData\nweekend = interval' TTime.Open (fri, mon)\n  where\n    fri = intersect' (dayOfWeek 5, hour False 18)\n    mon = intersect' (dayOfWeek 1, hour False 0)\n\nworkweek :: TimeData\nworkweek = interval' TTime.Open (mon, fri)\n  where\n    mon = intersect' (dayOfWeek 1, hour False 10)\n    fri = intersect' (dayOfWeek 5, hour False 18)\n\n-- Zero-indexed weeks, Monday is 1\n-- Use `predLastOf` for last day of week of month\nnthDOWOfMonth :: Int -> Int -> Int -> TimeData\nnthDOWOfMonth n dow m = predNthAfter (n - 1) dow_ month_\n  where\n    dow_ = dayOfWeek dow\n    month_ = month m\n\nintersectDOM :: TimeData -> Token -> Maybe TimeData\nintersectDOM td token = do\n  n <- getIntValue token\n  intersect (dayOfMonth n) td\n\nminutesBefore :: Int -> TimeData -> Maybe TimeData\nminutesBefore n TimeData {TTime.form = Just (TTime.TimeOfDay (Just 0) is12H)} =\n  Just $ hourMinute is12H 23 (60 - n)\nminutesBefore n TimeData {TTime.form = Just (TTime.TimeOfDay (Just 1) True)} =\n  Just $ hourMinute True 12 (60 - n)\nminutesBefore n TimeData {TTime.form = Just (TTime.TimeOfDay (Just h) is12H)} =\n  Just $ hourMinute is12H (h - 1) (60 - n)\nminutesBefore _ _ = Nothing\n\nminutesAfter :: Int -> TimeData -> Maybe TimeData\nminutesAfter n TimeData {TTime.form = Just (TTime.TimeOfDay (Just h) is12H)} =\n  Just $ hourMinute is12H h n\nminutesAfter _ _ = Nothing\n\n-- | Convenience helper to return a time token from a rule\ntt :: TimeData -> Maybe Token\ntt = Just . Token Time\n\n-- | Rule constructors\nmkSingleRegexRule :: Text -> String -> Maybe Token -> Rule\nmkSingleRegexRule name pattern token = Types.Rule\n  { Types.name = name\n  , Types.pattern = [regex pattern]\n  , Types.prod = const token\n  }\n\nmkRuleInstants :: [(Text, TG.Grain, Int, String)] -> [Rule]\nmkRuleInstants = map go\n  where\n    go (name, grain, n, pattern) = mkSingleRegexRule name pattern $ tt $\n      cycleNth grain n\n\nmkRuleDaysOfWeek :: [(Text, String)] -> [Rule]\nmkRuleDaysOfWeek daysOfWeek = zipWith go daysOfWeek [1..7]\n  where\n    go (name, pattern) i =\n      mkSingleRegexRule name pattern $ tt $ mkOkForThisNext $ dayOfWeek i\n\nmkRuleDaysOfWeekLatent :: [(Text, String)] -> [Rule]\nmkRuleDaysOfWeekLatent daysOfWeek = zipWith go daysOfWeek [1..7]\n  where\n    go (name, pattern) i =\n      mkSingleRegexRule name pattern $ tt $ mkLatent $ mkOkForThisNext $ dayOfWeek i\n\nmkRuleMonths :: [(Text, String)] -> [Rule]\nmkRuleMonths = mkRuleMonthsWithLatent . map (uncurry (,, False))\n\nmkRuleMonthsWithLatent :: [(Text, String, Bool)] -> [Rule]\nmkRuleMonthsWithLatent months  = zipWith go months [1..12]\n  where\n    go (name, pattern, latent) i =\n      mkSingleRegexRule name pattern $ tt $ (if latent then mkLatent else id)\n      $ mkOkForThisNext $ month i\n\nmkRuleSeasons :: [(Text, String, TimeData, TimeData)] -> [Rule]\nmkRuleSeasons = map go\n  where\n    go (name, pattern, start, end) = mkSingleRegexRule name pattern $\n      Token Time <$> mkOkForThisNext <$> interval TTime.Open start end\n\nmkRuleHolidays :: [(Text, String, TimeData)] -> [Rule]\nmkRuleHolidays = map go\n  where\n    go (name, pattern, td) = mkSingleRegexRule name pattern $ tt\n      $ withHoliday name $ mkOkForThisNext td\n\nmkRuleHolidays' :: [(Text, String, Maybe TimeData)] -> [Rule]\nmkRuleHolidays' = map go\n  where\n    go (name, pattern, maybeTimeData) = mkSingleRegexRule name pattern $ do\n      timeData <- maybeTimeData\n      tt $ withHoliday name $ mkOkForThisNext timeData\n", "num_lines": 763}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.HolidayHelpers\n  ( computeEarthHour, computeKingsDay\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Time.Helpers\nimport Duckling.Time.Computed\nimport Duckling.Time.Types (TimeData (..))\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\n-- Last Saturday of March unless it falls on Holy Saturday,\n-- in which case it's the Saturday before.\ncomputeEarthHour :: Maybe TimeData\ncomputeEarthHour =\n  let holySaturday = cycleNthAfter False TG.Day (-1) easterSunday\n      tentative = predLastOf (dayOfWeek 6) (month 3)\n      alternative = cycleNthAfter False TG.Day (-7) tentative\n    in do\n      day <- intersectWithReplacement holySaturday tentative alternative\n      start <- intersect day $ hourMinute True 20 30\n      interval TTime.Closed start $ cycleNthAfter False TG.Minute 60 start\n\n-- King's day is on April 27th unless it's on Sunday, in which case it's a day\n-- earlier. We intersect with the last Sunday of April. If 4/27 is a Sunday it\n-- will be the last Sunday in April.\ncomputeKingsDay :: Maybe TimeData\ncomputeKingsDay =\n  let tentative = monthDay 4 27\n      alternative = monthDay 4 26\n      lastSundayOfApril = predLastOf (dayOfWeek 7) (month 4)\n    in intersectWithReplacement lastSundayOfApril tentative alternative\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n{- HLINT ignore \"Use foldr1OrError\" -}\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Time.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Foldable (find)\nimport Data.Hashable\nimport Data.Maybe\nimport Data.Monoid\nimport Data.Text (Text)\nimport Data.Tuple.Extra (both)\nimport GHC.Generics hiding (from, to)\nimport Prelude\nimport TextShow (showt)\nimport qualified Data.HashMap.Strict as H\nimport qualified Data.List as List\nimport qualified Data.Text as Text\nimport qualified Data.Time as Time\nimport qualified Data.Time.Calendar.WeekDate as Time\nimport qualified Data.Time.LocalTime.TimeZone.Series as Series\n\nimport Duckling.Resolve\nimport Duckling.TimeGrain.Types (Grain)\nimport qualified Duckling.TimeGrain.Types as TG\n\ndata TimeObject = TimeObject\n  { start :: Time.UTCTime\n  , grain :: Grain\n  , end :: Maybe Time.UTCTime\n  } deriving (Eq, Show)\n\ndata Form = DayOfWeek\n  | TimeOfDay\n    { hours :: Maybe Int\n    , is12H :: Bool\n    }\n  | Month { month :: Int }\n  | PartOfDay\n  deriving (Eq, Generic, Hashable, Show, Ord, NFData)\n\ndata IntervalDirection = Before | After\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ndata TimeData = TimeData\n  { timePred :: Predicate\n  , latent :: Bool\n  , timeGrain :: Grain -- needed for intersect\n  , notImmediate :: Bool\n  , form :: Maybe Form\n  , direction :: Maybe IntervalDirection\n  , okForThisNext :: Bool -- allows specific this+Time\n  , holiday :: Maybe Text\n  , hasTimezone :: Bool -- hack to prevent double timezone parsing\n  }\n\ninstance Eq TimeData where\n  (==) (TimeData _ l1 g1 n1 f1 d1 _ _ t1) (TimeData _ l2 g2 n2 f2 d2 _ _ t2) =\n    l1 == l2 && g1 == g2 && n1 == n2 && f1 == f2 && d1 == d2 && t1 == t2\n\ninstance Hashable TimeData where\n  hashWithSalt s (TimeData _ latent grain imm form dir _ _ _) = hashWithSalt s\n    (0::Int, (latent, grain, imm, form, dir))\n\ninstance Ord TimeData where\n  compare (TimeData _ l1 g1 n1 f1 d1 _ _ _) (TimeData _ l2 g2 n2 f2 d2 _ _ _) =\n    case compare g1 g2 of\n      EQ -> case compare f1 f2 of\n        EQ -> case compare l1 l2 of\n          EQ -> case compare n1 n2 of\n            EQ -> compare d1 d2\n            z -> z\n          z -> z\n        z -> z\n      z -> z\n\ninstance Show TimeData where\n  show (TimeData _ latent grain _ form dir _ holiday tz) =\n    \"TimeData{\" ++\n    \"latent=\" ++ show latent ++\n    \", grain=\" ++ show grain ++\n    \", form=\" ++ show form ++\n    \", direction=\" ++ show dir ++\n    \", holiday=\" ++ show holiday ++\n    \", hasTimezone=\" ++ show tz ++\n    \"}\"\n\ninstance NFData TimeData where\n  rnf TimeData{..} = rnf (latent, timeGrain, notImmediate, form, direction)\n\ninstance Resolve TimeData where\n  type ResolvedValue TimeData = TimeValue\n  resolve _ Options {withLatent = False} TimeData {latent = True} = Nothing\n  resolve context _ TimeData {timePred, latent, notImmediate, direction, holiday} = do\n    value <- case future of\n      [] -> listToMaybe past\n      ahead:nextAhead:_\n        | notImmediate && isJust (timeIntersect ahead refTime) -> Just nextAhead\n      ahead:_ -> Just ahead\n    values <- Just $ take 3 $ if List.null future then past else future\n    Just $ case direction of\n      Nothing -> (TimeValue (timeValue tzSeries value)\n        (map (timeValue tzSeries) values) holiday, latent)\n      Just d -> (TimeValue (openInterval tzSeries d value)\n        (map (openInterval tzSeries d) values) holiday, latent)\n    where\n      DucklingTime (Series.ZoneSeriesTime utcTime tzSeries) = referenceTime context\n      refTime = TimeObject\n        { start = utcTime\n        , grain = TG.Second\n        , end = Nothing\n        }\n      tc = TimeContext\n        { refTime = refTime\n        , tzSeries = tzSeries\n        , maxTime = timePlus refTime TG.Year 2000\n        , minTime = timePlus refTime TG.Year $ - 2000\n        }\n      (past, future) = runPredicate timePred refTime tc\n\ntimedata' :: TimeData\ntimedata' = TimeData\n  { timePred = mkEmptyPredicate\n  , latent = False\n  , timeGrain = TG.Second\n  , notImmediate = False\n  , form = Nothing\n  , direction = Nothing\n  , okForThisNext = False\n  , holiday = Nothing\n  , hasTimezone = False\n  }\n\ndata TimeContext = TimeContext\n  { refTime  :: TimeObject\n  , tzSeries :: Series.TimeZoneSeries\n  , maxTime  :: TimeObject\n  , minTime  :: TimeObject\n  }\n\ndata InstantValue = InstantValue\n  { vValue :: Time.ZonedTime\n  , vGrain :: Grain\n  }\n  deriving (Show)\n\ninstance Eq InstantValue where\n  (==) (InstantValue (Time.ZonedTime lt1 tz1) g1)\n       (InstantValue (Time.ZonedTime lt2 tz2) g2) =\n    g1 == g2 && lt1 == lt2 && tz1 == tz2\n\ndata SingleTimeValue\n  = SimpleValue InstantValue\n  | IntervalValue (InstantValue, InstantValue)\n  | OpenIntervalValue (InstantValue, IntervalDirection)\n  deriving (Show, Eq)\n\ndata TimeValue = TimeValue SingleTimeValue [SingleTimeValue] (Maybe Text)\n  deriving (Show, Eq)\n\ninstance ToJSON InstantValue where\n  toJSON (InstantValue value grain) = object\n    [ \"value\" .= toRFC3339 value\n    , \"grain\" .= grain\n    ]\n\ninstance ToJSON SingleTimeValue where\n  toJSON (SimpleValue value) = case toJSON value of\n    Object o -> Object $ H.insert \"type\" (toJSON (\"value\" :: Text)) o\n    _ -> Object H.empty\n  toJSON (IntervalValue (from, to)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    , \"to\" .= toJSON to\n    ]\n  toJSON (OpenIntervalValue (instant, Before)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"to\" .= toJSON instant\n    ]\n  toJSON (OpenIntervalValue (instant, After)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON instant\n    ]\n\ninstance ToJSON TimeValue where\n  toJSON (TimeValue value values holiday) = case toJSON value of\n    Object o ->\n      Object $ insertHoliday holiday $ H.insert \"values\" (toJSON values) o\n    _ -> Object H.empty\n    where\n      insertHoliday :: Maybe Text -> Object -> Object\n      insertHoliday Nothing obj = obj\n      insertHoliday (Just h) obj = H.insert \"holidayBeta\" (toJSON h) obj\n\n-- | Return a tuple of (past, future) elements\ntype SeriesPredicate = TimeObject -> TimeContext -> ([TimeObject], [TimeObject])\n\ndata AMPM = AM | PM\n  deriving (Eq, Show)\n\ndata SeasonName = Spring | Summer | Fall | Winter deriving (Enum,Eq,Ord,Show)\n\n-- | Regular seasons of the Northern Hemisphere.\ndata Season = Season { startYear :: Integer, seasonName :: SeasonName }\n  deriving (Eq,Ord,Show)\n\nnewtype NoShow a = NoShow a\n\ninstance Show (NoShow a) where\n  show _ = \"??\"\n\ndata Predicate\n  = SeriesPredicate (NoShow SeriesPredicate)\n  | EmptyPredicate\n  | TimeDatePredicate -- invariant: at least one of them is Just\n    { tdSecond :: Maybe Int\n    , tdMinute :: Maybe Int\n    , tdHour :: Maybe (Bool, Int)\n    , tdAMPM :: Maybe AMPM -- only used if we have an hour\n    , tdDayOfTheWeek :: Maybe Int\n    , tdDayOfTheMonth :: Maybe Int\n    , tdMonth :: Maybe Int\n    , tdYear :: Maybe Int\n    }\n  | IntersectPredicate Predicate Predicate\n  | TimeIntervalsPredicate TimeIntervalType Predicate Predicate\n  | ReplaceIntersectPredicate Predicate Predicate Predicate\n  deriving Show\n\nrunPredicate :: Predicate -> SeriesPredicate\nrunPredicate EmptyPredicate{} = \\_ _ -> ([], [])\nrunPredicate (SeriesPredicate (NoShow p)) = p\nrunPredicate TimeDatePredicate{..}\n  -- This should not happen by construction, but if it does then\n  -- empty time series should be ok\n  | isNothing tdHour && isJust tdAMPM = \\_ _ -> ([], [])\nrunPredicate TimeDatePredicate{..} =\n  foldr1 runCompose toCompose\n  where\n  -- runComposePredicate performs best when the first predicate is of\n  -- smaller grain, that's why we order by grain here\n  toCompose = catMaybes\n    [ runSecondPredicate <$> tdSecond\n    , runMinutePredicate <$> tdMinute\n    , uncurry (runHourPredicate tdAMPM) <$> tdHour\n    , runDayOfTheWeekPredicate <$> tdDayOfTheWeek\n    , runDayOfTheMonthPredicate <$> tdDayOfTheMonth\n    , runMonthPredicate <$> tdMonth\n    , runYearPredicate <$> tdYear\n    ]\nrunPredicate (IntersectPredicate pred1 pred2) =\n  runIntersectPredicate pred1 pred2\nrunPredicate (TimeIntervalsPredicate ty pred1 pred2) =\n  runTimeIntervalsPredicate ty pred1 pred2\nrunPredicate (ReplaceIntersectPredicate pred1 pred2 pred3) =\n  runReplaceIntersectPredicate pred1 pred2 pred3\n\n-- Don't use outside this module, use a smart constructor\nemptyTimeDatePredicate :: Predicate\nemptyTimeDatePredicate =\n  TimeDatePredicate Nothing Nothing Nothing Nothing Nothing Nothing Nothing\n    Nothing\n\n-- Predicate smart constructors\n\n-- For debugging find it useful to make it:\n-- mkEmptyPredicate :: HasCallStack => Predicate\n-- mkEmptyPredicate = EmptyPredicate callStack\n-- This way I can track where EmptyPredicates get created\nmkEmptyPredicate :: Predicate\nmkEmptyPredicate = EmptyPredicate\n\nmkSeriesPredicate :: SeriesPredicate -> Predicate\nmkSeriesPredicate = SeriesPredicate . NoShow\n\nmkSecondPredicate :: Int -> Predicate\nmkSecondPredicate n = emptyTimeDatePredicate { tdSecond = Just n }\n\nmkMinutePredicate :: Int -> Predicate\nmkMinutePredicate n = emptyTimeDatePredicate { tdMinute = Just n }\n\nmkHourPredicate :: Bool -> Int -> Predicate\nmkHourPredicate is12H h = emptyTimeDatePredicate { tdHour = Just (is12H, h) }\n\nmkAMPMPredicate :: AMPM -> Predicate\nmkAMPMPredicate ampm = emptyTimeDatePredicate { tdAMPM = Just ampm }\n\nmkDayOfTheWeekPredicate :: Int -> Predicate\nmkDayOfTheWeekPredicate n = emptyTimeDatePredicate { tdDayOfTheWeek = Just n }\n\nmkDayOfTheMonthPredicate :: Int -> Predicate\nmkDayOfTheMonthPredicate n = emptyTimeDatePredicate { tdDayOfTheMonth = Just n }\n\nmkMonthPredicate :: Int -> Predicate\nmkMonthPredicate n = emptyTimeDatePredicate { tdMonth = Just n }\n\nmkYearPredicate :: Int -> Predicate\nmkYearPredicate n = emptyTimeDatePredicate { tdYear = Just n }\n\nmkIntersectPredicate :: Predicate -> Predicate -> Predicate\nmkIntersectPredicate a@EmptyPredicate{} _ = a\nmkIntersectPredicate _ a@EmptyPredicate{} = a\nmkIntersectPredicate\n  (TimeDatePredicate a1 b1 c1 d1 e1 f1 g1 h1)\n  (TimeDatePredicate a2 b2 c2 d2 e2 f2 g2 h2)\n  = fromMaybe mkEmptyPredicate\n      (TimeDatePredicate <$>\n        unify a1 a2 <*>\n        unify b1 b2 <*>\n        unify c1 c2 <*>\n        unify d1 d2 <*>\n        unify e1 e2 <*>\n        unify f1 f2 <*>\n        unify g1 g2 <*>\n        unify h1 h2)\n  where\n  unify Nothing a = Just a\n  unify a Nothing = Just a\n  unify ma@(Just a) (Just b)\n    | a == b = Just ma\n    | otherwise = Nothing\nmkIntersectPredicate pred1 pred2 = IntersectPredicate pred1 pred2\n\nmkReplaceIntersectPredicate :: Predicate -> Predicate -> Predicate -> Predicate\nmkReplaceIntersectPredicate pred1 pred2 pred3 =\n  ReplaceIntersectPredicate pred1 pred2 pred3\n\nmkTimeIntervalsPredicate\n  :: TimeIntervalType -> Predicate -> Predicate -> Predicate\nmkTimeIntervalsPredicate _ a@EmptyPredicate{} _ = a\nmkTimeIntervalsPredicate _ _ a@EmptyPredicate{} = a\n-- `from (... from a to b ...) to c` and `from c to (... from a to b ...)` don't\n-- really have a good interpretation, so abort early\nmkTimeIntervalsPredicate _ a b\n  | containsTimeIntervalsPredicate a ||\n    containsTimeIntervalsPredicate b = mkEmptyPredicate\n  -- this is potentially quadratic, but the sizes involved should be small\nmkTimeIntervalsPredicate t a b = TimeIntervalsPredicate t a b\n\ncontainsTimeIntervalsPredicate :: Predicate -> Bool\ncontainsTimeIntervalsPredicate TimeIntervalsPredicate{} = True\ncontainsTimeIntervalsPredicate (IntersectPredicate a b) =\n  containsTimeIntervalsPredicate a || containsTimeIntervalsPredicate b\ncontainsTimeIntervalsPredicate _ = False\n  -- SeriesPredicate might contain one, but we'll underapproximate for\n  -- now\n\n-- Computes the difference of the start time of two `TimeObject`s.\ndiffStartTime :: TimeObject -> TimeObject -> Time.NominalDiffTime\ndiffStartTime TimeObject{start = x} TimeObject{start = y} =\n  abs (Time.diffUTCTime x y)\n\nisEmptyPredicate :: Predicate -> Bool\nisEmptyPredicate EmptyPredicate{} = True\nisEmptyPredicate _ = False\n\nseasonStart :: Season -> Time.Day\nseasonStart (Season year Spring) = Time.fromGregorian year 3 20\nseasonStart (Season year Summer) = Time.fromGregorian year 6 21\nseasonStart (Season year Fall) = Time.fromGregorian year 9 23\nseasonStart (Season year Winter) = Time.fromGregorian year 12 21\n\nseasonEnd :: Season -> Time.Day\nseasonEnd = Time.addDays (-1) . seasonStart . nextSeason\n\nnextSeason :: Season -> Season\nnextSeason (Season year Winter) = Season (year+1) Spring\nnextSeason (Season year x) = Season year (succ x)\n\nprevSeason :: Season -> Season\nprevSeason (Season year Spring) = Season (year-1) Winter\nprevSeason (Season year x) = Season year (pred x)\n\nseasonOf :: Time.Day -> Season\nseasonOf day = fromMaybe (Season (year-1) Winter) mbSeason\n  where\n  (year,_,_) = Time.toGregorian day\n  mbSeason = find ((<= day) . seasonStart) $\n               Season year <$> [Winter,Fall,Summer,Spring]\n\nseasonPredicate :: Predicate\nseasonPredicate = mkSeriesPredicate series\n  where\n  series t = const (past,future)\n    where\n    day = Time.utctDay (start t)\n    (past,future) = both (map toTimeObj) (toZipper day)\n    toTimeObj season = TimeObject { start = s, grain = TG.Day, end = Just e }\n      where (s,e) = both toMidnight (seasonStart season, seasonEnd season)\n    toZipper d = (before, currentAndAfter)\n      where\n      current = seasonOf d\n      currentAndAfter = iterate nextSeason current\n      before = iterate prevSeason (prevSeason current)\n\n-- Predicate for weekdays, i.e., Mon to Fri.\nweekdayPredicate :: Predicate\nweekdayPredicate = mkSeriesPredicate series\n  where\n  series time = const (past,future)\n    where\n    day = Time.utctDay (start time)\n    (_,_,dayOfWeek) = Time.toWeekDate day\n    past = toTimeObj . toMidnight . fst <$>\n      iterate prevWeekday (prevWeekday (day,dayOfWeek))\n    future = toTimeObj . toMidnight <$>\n      if dayOfWeek <= 5 then day:days else days\n        where days = fst <$> iterate nextWeekday (nextWeekday (day,dayOfWeek))\n    toTimeObj t = TimeObject { start = t, grain = TG.Day, end = Nothing }\n    nextWeekday (d,dow)\n      | dow < 5 = (Time.addDays 1 d, dow+1)\n      | otherwise = (Time.addDays (toInteger $ 8-dow) d, 1)\n    prevWeekday (d,dow)\n      | dow == 1 = (Time.addDays (-3) d, 5)\n      | dow == 7 = (Time.addDays (-2) d, 5)\n      | otherwise = (Time.addDays (-1) d, dow-1)\n\n-- Predicate for periodic events with known `given`\nperiodicPredicate :: TG.Grain -> Int -> TimeObject -> Predicate\nperiodicPredicate grain delta given = mkSeriesPredicate series\n  where\n  series t _ = (past', future')\n    where\n    (past, future) = timeSequence grain delta given\n    (past', future') = if timeBefore t given\n      then\n        let (newer, older) = span (timeBefore t) past\n        in (older, reverse newer ++ future)\n      else\n        let (older, newer) = span (`timeBefore` t) future\n        in (reverse older ++ past, newer)\n\ntoMidnight :: Time.Day -> Time.UTCTime\ntoMidnight = flip Time.UTCTime (Time.timeOfDayToTime Time.midnight)\n\n-- Predicate runners\n\nrunSecondPredicate :: Int -> SeriesPredicate\nrunSecondPredicate n = series\n  where\n  series t _ = timeSequence TG.Minute 1 anchor\n    where\n      Time.UTCTime _ diffTime = start t\n      Time.TimeOfDay _ _ s = Time.timeToTimeOfDay diffTime\n      anchor = timePlus (timeRound t TG.Second) TG.Second\n        $ mod (toInteger n - floor s :: Integer) 60\n\nrunMinutePredicate :: Int -> SeriesPredicate\nrunMinutePredicate n = series\n  where\n  series t _ = timeSequence TG.Hour 1 anchor\n    where\n      Time.UTCTime _ diffTime = start t\n      Time.TimeOfDay _ m _ = Time.timeToTimeOfDay diffTime\n      rounded = timeRound t TG.Minute\n      anchor = timePlus rounded TG.Minute $ toInteger $ mod (n - m) 60\n\nrunHourPredicate :: Maybe AMPM -> Bool -> Int -> SeriesPredicate\nrunHourPredicate ampm is12H n = series\n  where\n  series time _ =\n    ( drop 1 $\n        iterate (\\t -> timePlus t TG.Hour $ toInteger $ - step) anchor\n    , iterate (\\t -> timePlus t TG.Hour $ toInteger step) anchor\n    )\n    where\n      Time.UTCTime _ diffTime = start time\n      Time.TimeOfDay h _ _ = Time.timeToTimeOfDay diffTime\n      step :: Int\n      step = if is12H && n <= 12 && isNothing ampm then 12 else 24\n      n' = case ampm of\n            Just AM -> n `mod` 12\n            Just PM -> (n `mod` 12) + 12\n            Nothing -> n\n      rounded = timeRound time TG.Hour\n      anchor = timePlus rounded TG.Hour $ toInteger $ mod (n' - h) step\n\nrunAMPMPredicate :: AMPM -> SeriesPredicate\nrunAMPMPredicate ampm = series\n  where\n  series time _ = (past, future)\n    where\n    past = maybeShrinkFirst $\n      iterate (\\t -> timePlusEnd t TG.Hour $ toInteger $ - step) anchor\n    future = maybeShrinkFirst $\n      iterate (\\t -> timePlusEnd t TG.Hour $ toInteger step) anchor\n    -- to produce time in the future/past we need to adjust\n    -- the start/end of the first interval\n    maybeShrinkFirst (a:as) =\n      case timeIntersect (time { grain = TG.Day }) a of\n        Nothing -> as\n        Just ii -> ii:as\n    maybeShrinkFirst a = a\n    step :: Int\n    step = 24\n    n = case ampm of\n          AM -> 0\n          PM -> 12\n    rounded = timeRound time TG.Day\n    anchorStart = timePlus rounded TG.Hour n\n    anchorEnd = timePlus anchorStart TG.Hour 12\n    -- an interval of length 12h starting either at 12am or 12pm,\n    -- the same day as input time\n    anchor = timeInterval Open anchorStart anchorEnd\n\nrunDayOfTheWeekPredicate :: Int -> SeriesPredicate\nrunDayOfTheWeekPredicate n = series\n  where\n  series t _ = timeSequence TG.Day 7 anchor\n    where\n      Time.UTCTime day _ = start t\n      (_, _, dayOfWeek) = Time.toWeekDate day\n      daysUntilNextWeek = toInteger $ mod (n - dayOfWeek) 7\n      anchor =\n        timePlus (timeRound t TG.Day) TG.Day daysUntilNextWeek\n\nrunDayOfTheMonthPredicate :: Int -> SeriesPredicate\nrunDayOfTheMonthPredicate n = series\n  where\n  series time _ =\n    ( map addDays $ filter enoughDays $ iterate (addMonth $ - 1) $\n        addMonth (- 1) anchor\n    , map addDays $ filter enoughDays $ iterate (addMonth 1) anchor\n    )\n    where\n      enoughDays :: TimeObject -> Bool\n      enoughDays t = let Time.UTCTime d _ = start t\n                         (year, month, _) = Time.toGregorian d\n                     in n <= Time.gregorianMonthLength year month\n      addDays :: TimeObject -> TimeObject\n      addDays t = timePlus t TG.Day $ toInteger $ n - 1\n      addMonth :: Int -> TimeObject -> TimeObject\n      addMonth i t = timePlus t TG.Month $ toInteger i\n      roundMonth :: TimeObject -> TimeObject\n      roundMonth t = timeRound t TG.Month\n      rounded = roundMonth time\n      Time.UTCTime day _ = start time\n      (_, _, dayOfMonth) = Time.toGregorian day\n      anchor = if dayOfMonth <= n then rounded else addMonth 1 rounded\n\nrunMonthPredicate :: Int -> SeriesPredicate\nrunMonthPredicate n = series\n  where\n  series t _ = timeSequence TG.Year 1 anchor\n    where\n      rounded =\n        timePlus (timeRound t TG.Year) TG.Month $ toInteger $ n - 1\n      anchor = if timeStartsBeforeTheEndOf t rounded\n        then rounded\n        else timePlus rounded TG.Year 1\n\nrunYearPredicate :: Int -> SeriesPredicate\nrunYearPredicate n = series\n  where\n  series t _ =\n    if tyear <= year\n      then ([], [y])\n      else ([y], [])\n    where\n      Time.UTCTime day _ = start t\n      (tyear, _, _) = Time.toGregorian day\n      year = toInteger n\n      y = timePlus (timeRound t TG.Year) TG.Year $ year - tyear\n\n-- Limits how deep into lists of segments to look\nsafeMax :: Int\nsafeMax = 10\n\nrunReplaceIntersectPredicate\n  :: Predicate -> Predicate -> Predicate -> SeriesPredicate\nrunReplaceIntersectPredicate pred1 pred2 pred3 = runComposeWithReplacement\n  (runPredicate pred1) (runPredicate pred2) (runPredicate pred3)\n\n-- If pred1 intersects with pred2, returns pred3 otherwise pred2\n-- Caveat: only works if all predicates are aligned (e.g. once a year)\nrunComposeWithReplacement\n  :: SeriesPredicate -> SeriesPredicate -> SeriesPredicate -> SeriesPredicate\nrunComposeWithReplacement pred1 pred2 pred3 = series\n  where\n  series nowTime context = (backward, forward)\n    where\n    (past1, future1) = pred1 nowTime context\n    (past2, future2) = pred2 nowTime context\n    (past3, future3) = pred3 nowTime context\n\n    computeSerie :: [[TimeObject]] -> [TimeObject]\n    computeSerie [tokens1,tokens2,tokens3] =\n      zipWith3 (\\token1 token2 token3 -> case timeIntersect token1 token2 of\n        Just _ -> token3\n        Nothing -> token2\n      ) tokens1 tokens2 tokens3\n    computeSerie _ = []\n\n    backwardBounded =\n      takeWhile (\\t -> timeStartsBeforeTheEndOf (minTime context) t)\n      . take safeMax\n    forwardBounded =\n      takeWhile (\\t -> timeStartsBeforeTheEndOf t (maxTime context))\n      . take safeMax\n\n    backward = computeSerie $ map backwardBounded [past1, past2, past3]\n    forward = computeSerie $ map forwardBounded [future1, future2, future3]\n\nrunIntersectPredicate :: Predicate -> Predicate -> SeriesPredicate\nrunIntersectPredicate pred1 pred2 =\n  runCompose (runPredicate pred1) (runPredicate pred2)\n\n-- Performs best when pred1 is smaller grain than pred2\nrunCompose :: SeriesPredicate -> SeriesPredicate -> SeriesPredicate\nrunCompose pred1 pred2 = series\n  where\n  series nowTime context = (backward, forward)\n    where\n    (past, future) = pred2 nowTime context\n    computeSerie tokens =\n      [t | time1 <- take safeMax tokens\n         , t <- mapMaybe (timeIntersect time1) $\n                takeWhile (startsBefore time1) $\n                snd $ pred1 time1 $ fixedRange time1\n      ]\n\n    startsBefore t1 this = timeStartsBeforeTheEndOf this t1\n    fixedRange t1 = context {minTime = t1, maxTime = t1}\n\n    backward = computeSerie $ takeWhile (\\t ->\n      timeStartsBeforeTheEndOf (minTime context) t) past\n    forward = computeSerie $ takeWhile (\\t ->\n      timeStartsBeforeTheEndOf t (maxTime context)) future\n\nrunTimeIntervalsPredicate\n  :: TimeIntervalType -> Predicate\n  -> Predicate -> SeriesPredicate\nrunTimeIntervalsPredicate intervalType pred1 pred2 = timeSeqMap True f pred1\n  where\n    -- Pick the first interval *after* the given time segment\n    f thisSegment ctx = case runPredicate pred2 thisSegment ctx of\n      (_, firstFuture:_) -> Just $\n        timeInterval intervalType thisSegment firstFuture\n      _ -> Nothing\n\n-- Limits how deep into lists of segments to look\nsafeMaxInterval :: Int\nsafeMaxInterval = 12\n\n-- | Applies `f` to each interval yielded by `g`.\n-- | Intervals including \"now\" are in the future.\ntimeSeqMap\n  :: Bool\n     -- Given an interval and range, compute a single new interval\n  -> (TimeObject -> TimeContext -> Maybe TimeObject)\n     -- First-layer series generator\n  -> Predicate\n     -- Series generator for values that come from `f`\n  -> SeriesPredicate\ntimeSeqMap dontReverse f g = series\n  where\n  series nowTime context = (past, future)\n    where\n    -- computes a single interval from `f` based on each interval in the series\n    applyF ts = mapMaybe (`f` context) $ take safeMaxInterval ts\n\n    (firstPast, firstFuture) = runPredicate g nowTime context\n    (past1, future1) = (applyF firstPast, applyF firstFuture)\n\n    -- Separate what's before and after now from the past's series\n    (newFuture, stillPast) =\n      span (timeStartsBeforeTheEndOf nowTime) past1\n    -- A series that ends at the earliest time\n    oldPast = takeWhile\n      (timeStartsBeforeTheEndOf $ minTime context)\n      stillPast\n\n    -- Separate what's before and after now from the future's series\n    (newPast, stillFuture) =\n      break (timeStartsBeforeTheEndOf nowTime) future1\n    -- A series that ends at the furthest future time\n    oldFuture = takeWhile\n      (\\x -> timeStartsBeforeTheEndOf x $ maxTime context)\n      stillFuture\n\n    -- Reverse the list if needed?\n    applyRev ts = if dontReverse then ts else reverse ts\n    (sortedPast, sortedFuture) = (applyRev newPast, applyRev newFuture)\n\n    -- Past is the past from the future's series with the\n    -- past from the past's series tacked on\n    past = sortedPast ++ oldPast\n\n    -- Future is the future from the past's series with the\n    -- future from the future's series tacked on\n    future = sortedFuture ++ oldFuture\n\n\ntimeSequence\n  :: TG.Grain\n  -> Int\n  -> TimeObject\n  -> ([TimeObject], [TimeObject])\ntimeSequence grain step anchor =\n  ( drop 1 $ iterate (f $ - step) anchor\n  , iterate (f step) anchor\n  )\n  where\n    f :: Int -> TimeObject -> TimeObject\n    f n t = timePlus t grain $ toInteger n\n\n-- | Zero-pad `x` to reach length `n`.\npad :: Int -> Int -> Text\npad n x\n  | x <= magnitude = Text.replicate (n - Text.length s) \"0\" <> s\n  | otherwise      = s\n  where\n    magnitude = round ((10 :: Float) ** fromIntegral (n - 1) :: Float)\n    s = showt x\n\n-- | Return the timezone offset portion of the RFC3339 format, e.g. \"-02:00\".\ntimezoneOffset :: Time.TimeZone -> Text\ntimezoneOffset (Time.TimeZone t _ _) = Text.concat [sign, hh, \":\", mm]\n  where\n    (sign, t') = if t < 0 then (\"-\", negate t) else (\"+\", t)\n    (hh, mm) = both (pad 2) $ divMod t' 60\n\n-- | Return a RFC3339 formatted time, e.g. \"2013-02-12T04:30:00.000-02:00\".\n-- | Backward-compatible with Duckling: fraction of second is milli and padded.\ntoRFC3339 :: Time.ZonedTime -> Text\ntoRFC3339 (Time.ZonedTime (Time.LocalTime day (Time.TimeOfDay h m s)) tz) =\n  Text.concat\n    [ Text.pack $ Time.showGregorian day\n    , \"T\"\n    , pad 2 h\n    , \":\"\n    , pad 2 m\n    , \":\"\n    , pad 2 $ floor s\n    , \".\"\n    , pad 3 $ round $ (s - realToFrac (floor s :: Integer)) * 1000\n    , timezoneOffset tz\n    ]\n\ninstantValue :: Series.TimeZoneSeries -> Time.UTCTime -> Grain -> InstantValue\ninstantValue tzSeries t g = InstantValue\n  { vValue = fromUTC t $ Series.timeZoneFromSeries tzSeries t\n  , vGrain = g\n  }\n\ntimeValue :: Series.TimeZoneSeries -> TimeObject -> SingleTimeValue\ntimeValue tzSeries (TimeObject s g Nothing) =\n  SimpleValue $ instantValue tzSeries s g\ntimeValue tzSeries (TimeObject s g (Just e)) = IntervalValue\n  ( instantValue tzSeries s g\n  , instantValue tzSeries e g\n  )\n\nopenInterval\n  :: Series.TimeZoneSeries -> IntervalDirection -> TimeObject -> SingleTimeValue\nopenInterval tzSeries direction (TimeObject s g _) = OpenIntervalValue\n  ( instantValue tzSeries s g\n  , direction\n  )\n\n-- -----------------------------------------------------------------\n-- Time object helpers\n\ntimeRound :: TimeObject -> TG.Grain -> TimeObject\ntimeRound t TG.Week = TimeObject {start = s, grain = TG.Week, end = Nothing}\n  where\n    Time.UTCTime day diffTime = start $ timeRound t TG.Day\n    (year, week, _) = Time.toWeekDate day\n    newDay = Time.fromWeekDate year week 1\n    s = Time.UTCTime newDay diffTime\ntimeRound t TG.Quarter = newTime {grain = TG.Quarter}\n  where\n    monthTime = timeRound t TG.Month\n    Time.UTCTime day _ = start monthTime\n    (_, month, _) = Time.toGregorian day\n    newTime = timePlus monthTime TG.Month $ toInteger $ - (mod (month - 1) 3)\ntimeRound t grain = TimeObject {start = s, grain = grain, end = Nothing}\n  where\n    Time.UTCTime day diffTime = start t\n    timeOfDay = Time.timeToTimeOfDay diffTime\n    (year, month, dayOfMonth) = Time.toGregorian day\n    Time.TimeOfDay hours mins secs = timeOfDay\n    newMonth = if grain > TG.Month then 1 else month\n    newDayOfMonth = if grain > TG.Day then 1 else dayOfMonth\n    newDay = Time.fromGregorian year newMonth newDayOfMonth\n    newHours = if grain > TG.Hour then 0 else hours\n    newMins = if grain > TG.Minute then 0 else mins\n    newSecs = if grain > TG.Second then 0 else secs\n    newDiffTime = Time.timeOfDayToTime $ Time.TimeOfDay newHours newMins newSecs\n    s = Time.UTCTime newDay newDiffTime\n\ntimePlus :: TimeObject -> TG.Grain -> Integer -> TimeObject\ntimePlus (TimeObject start grain _) theGrain n = TimeObject\n  { start = TG.add start theGrain n\n  , grain = min grain theGrain\n  , end = Nothing\n  }\n\n-- | Shifts the whole interval by n units of theGrain\n-- Returned interval has the same length as the input one\ntimePlusEnd :: TimeObject -> TG.Grain -> Integer -> TimeObject\ntimePlusEnd (TimeObject start grain end) theGrain n = TimeObject\n  { start = TG.add start theGrain n\n  , grain = min grain theGrain\n  , end = TG.add <$> end <*> return theGrain <*> return n\n  }\n\ntimeEnd :: TimeObject -> Time.UTCTime\ntimeEnd (TimeObject start grain end) = fromMaybe (TG.add start grain 1) end\n\ntimeStartingAtTheEndOf :: TimeObject -> TimeObject\ntimeStartingAtTheEndOf t = TimeObject\n  {start = timeEnd t, end = Nothing, grain = grain t}\n\n-- | Closed if the interval between A and B should include B\n-- Open if the interval should end right before B\ndata TimeIntervalType = Open | Closed\n  deriving (Eq, Show)\n\ntimeInterval :: TimeIntervalType -> TimeObject -> TimeObject -> TimeObject\ntimeInterval\n  intervalType\n  TimeObject{start = s1, grain = g1}\n  TimeObject{start = s2, end = e2, grain = g2} = TimeObject\n  { start = s1\n  , grain = g'\n  , end = Just $ case intervalType of\n      Open -> s2\n      Closed -> fromMaybe (TG.add s2 g2' 1) e2\n  }\n  where\n    g' = min g1 g2\n    g2'\n      | g1 < TG.Day && g2 < TG.Day = g'\n      | otherwise = g2\n\ntimeStartsBeforeTheEndOf :: TimeObject -> TimeObject -> Bool\ntimeStartsBeforeTheEndOf t1 t2 = start t1 < timeEnd t2\n\ntimeBefore :: TimeObject -> TimeObject -> Bool\ntimeBefore t1 t2 = start t1 < start t2\n\n-- | Intersection between two `TimeObject`.\n-- The resulting grain and end fields are the smallest.\n-- Prefers intervals when the range is equal.\ntimeIntersect :: TimeObject -> TimeObject -> Maybe TimeObject\ntimeIntersect t1 t2\n  | s1 > s2 = timeIntersect t2 t1\n  | e1 <= s2 = Nothing\n  | e1 < e2 || s1 == s2 && e1 == e2 && isJust end1 = Just TimeObject\n    {start = s2, end = end1, grain = g'}\n  | otherwise = Just t2 {grain = g'}\n  where\n    TimeObject s1 g1 end1 = t1\n    TimeObject s2 g2 _    = t2\n    e1 = timeEnd t1\n    e2 = timeEnd t2\n    g' = min g1 g2\n", "num_lines": 873}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.CA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Time.Corpus\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Testing.Types hiding (examples)\n\ncontext :: Context\ncontext = testContext {locale = makeLocale CA Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"ara\"\n             , \"ja\"\n             , \"en aquest moment\"\n             , \"en aquests moments\"\n             , \"ara mateix\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"avui\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"ahir\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"abans d'ahir\"\n             ]\n  {--\n    This is intentional\n    The purpose is to steer the classifier towards \"tomorrow\" rule\n    instead of \"morning\" rule.\n  --}\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"dem\u00c3\u00a0\"\n             , \"dema\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"dem\u00c3\u00a0 passat\"\n             , \"dema passat\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"dilluns\"\n             , \"dl\"\n             , \"dl.\"\n             , \"aquest dilluns\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"dilluns, Febrer 18\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"dimarts\"\n             , \"dm\"\n             , \"dm.\"\n             , \"dimarts 19\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"dimecres\"\n             , \"dc\"\n             , \"dc.\"\n             , \"dimecres 13\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"dijous\"\n             , \"dj\"\n             , \"dj.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"divendres\"\n             , \"dv\"\n             , \"dv.\"\n             , \"dv. 15\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"dissabte\"\n             , \"ds\"\n             , \"ds.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"diumenge\"\n             , \"dg\"\n             , \"dg.\"\n             ]\n  , examples (datetime (2013, 5, 5, 0, 0, 0) Day)\n             [ \"el 5 de maig\"\n             , \"el cinc de maig\"\n             ]\n  , examples (datetime (2013, 5, 5, 0, 0, 0) Day)\n             [ \"el cinc de maig de 2013\"\n             , \"5-5-2013\"\n             ]\n  , examples (datetime (2013, 7, 4, 0, 0, 0) Day)\n             [ \"el 4 de juliol\"\n             , \"el 4/7\"\n             ]\n   , examples (datetime (2013, 8, 4, 0, 0, 0) Day)\n             [ \"el 4 d'agost\"\n             , \"el 4/8\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"el 3 de mar\u00c3\u00a7\"\n             , \"3 de mar\u00c3\u00a7\"\n             , \"el 3-3\"\n             ]\n   , examples (datetime (2013, 10, 24, 0, 0, 0) Day)\n             [ \"el 24 d'octubre\"\n             , \"el 24/10\"\n             ]\n   , examples (datetime (2013, 09, 24, 0, 0, 0) Day)\n             [ \"el 24 de setembre\"\n             , \"el 24 de set\"\n             , \"el 24/09\"\n             ]\n   , examples (datetime (2013, 09, 0, 0, 0, 0) Month)\n             [ \"setembre\"\n             , \"set\"\n             ]\n  , examples (datetime (2013, 4, 5, 0, 0, 0) Day)\n             [ \"el 5 d'abril\"\n             , \"5 d'abril\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"el 1 de mar\u00c3\u00a7\"\n             , \"l'1 de mar\u00c3\u00a7\"\n             , \"1 de mar\u00c3\u00a7\"\n             , \"el primer de mar\u00c3\u00a7\"\n             , \"l'u de mar\u00c3\u00a7\"\n             , \"u de mar\u00c3\u00a7\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"1-3-2013\"\n             , \"1.3.2013\"\n             , \"1/3/2013\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"el 16\"\n             , \"16 de febrer\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"el 17\"\n             , \"17 de febrer\"\n             , \"17-2\"\n             , \"el 17/2\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"el 20\"\n             , \"20 de febrer\"\n             , \"20/2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"el dimarts vinent\"\n             , \"dimarts vinent\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"dimecres vinent\"\n             , \"el dimecres de la setmana vinent\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"el dilluns d'aquesta setmana\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"dimarts d'aquesta setmana\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"el dimecres d'aquesta setmana\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"aquesta setmana\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"la setmana passada\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"la setmana vinent\"\n             , \"la propera setmana\"\n             , \"setmana vinent\"\n             , \"propera setmana\"\n             , \"properes setmanes\"\n             , \"seg\u00c3\u00bcent setmana\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Month)\n             [ \"el passat mes\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"el mes vinent\"\n             , \"el proper mes\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"l'any passat\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"aquest any\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"l'any vinent\"\n             , \"el proper any\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"el diumenge passat\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"el dimarts passat\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Minute)\n             [ \"15:00\"\n             , \"15.00\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"mitjanit\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 0, 0) Hour)\n             [ \"migdia\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"tres i quart\"\n             , \"15:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"15:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"11:45\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"en 2 minuts\"\n             , \"en dos minuts\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"en 60 minuts\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"en una hora\"\n             ]\n  , examples (datetime (2013, 2, 12, 2, 30, 0) Minute)\n             [ \"fa dues hores\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"en 24 hores\"\n             , \"en vint-i-quatre hores\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"en un dia\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"en 7 dies\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"en una setmana\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"fa tres setmanes\"\n             ]\n  , examples (datetime (2013, 4, 12, 0, 0, 0) Day)\n             [ \"en dos mesos\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"fa tres mesos\"\n             ]\n  , examples (datetime (2014, 2, 0, 0, 0, 0) Month)\n             [ \"en un any\"\n             , \"en 1 any\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"fa dos anys\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"aquest estiu\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"aquest hivern\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 25, 0, 0, 0) Day \"Navidad\")\n             [ \"Nadal\"\n             , \"el Nadal\"\n             ]\n  , examples (datetime (2013, 12, 31, 0, 0, 0) Day)\n             [ \"nit de cap d'any\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"cap d'any\"\n             ]\n  , examples (datetime (2013, 2, 12, 21, 0, 0) Hour)\n             [ \"nou del vespre\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 14, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"aquesta tarda\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 14, 0, 0), (2013, 2, 13, 19, 0, 0)) Hour)\n             [ \"dem\u00c3\u00a0 a la tarda\"\n             , \"dema a la tarda\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 14, 0, 0), (2013, 2, 11, 19, 0, 0)) Hour)\n             [ \"ahir per la tarda\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 19, 0, 0), (2013, 2, 12, 22, 0, 0)) Hour)\n             [ \"aquest vespre\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 19, 0, 0), (2013, 2, 13, 22, 0, 0)) Hour)\n             [ \"dem\u00c3\u00a0 al vespre\"\n             , \"dema al vespre\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 19, 0, 0), (2013, 2, 11, 22, 0, 0)) Hour)\n             [ \"ahir al vespre\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 0, 0, 0), (2013, 2, 12, 1, 0, 0)) Hour)\n             [ \"aquesta nit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 13, 1, 0, 0)) Hour)\n             [ \"dem\u00c3\u00a0 a la nit\"\n             , \"dema a la nit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 0, 0, 0), (2013, 2, 11, 1, 0, 0)) Hour)\n             [ \"ahir per la nit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"aquest cap de setmana\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 6, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"dilluns pel mat\u00c3\u00ad\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 6, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"el 15 de febrer pel mat\u00c3\u00ad\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"darrers 2 segons\" -- texte original pasados 2 segundos\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"propers 3 segons\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"darrers 2 minuts\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"propers 3 minuts\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"properes 3 hores\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"darrers 2 dies\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"propers 3 dies\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"darreres dues setmanes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"3 properes setmanes\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"darrers 2 mesos\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"3 propers mesos\"\n             , \"propers tres mesos\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"darrers 2 anys\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"3 propers anys\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13 - 15 de juliol de 2013\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 1, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"1 - 15 de juliol de 2013\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 0, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 12, 21, 0, 0, 0), (2014, 1, 7, 0, 0, 0)) Day)\n             [ \"21 de des. al 6 de gen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 12, 7, 30, 0)) Second)\n             [ \"dintre de tres hores\"\n             ]\n  , examples (datetime (2013, 8, 15, 0, 0, 0) Day)\n             [ \"dj 15\"\n             , \"dj. 15\"\n             , \"dijous 15\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 18, 0, 0, 0) Day \"Dia Mundial de la Lengua \u00c3\u20acrab\")\n             [ \"dia mundial de la lengua \u00c3\u00a1rabe\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 1, 0, 0, 0) Day \"Dia de la Zero Discriminaci\u00c3\u00b3\")\n             [ \"dia de la zero discriminaci\u00c3\u00b3\"\n             ]\n  , examples (datetimeHoliday (2019, 7, 6, 0, 0, 0) Day \"Dia Internacional de les Cooperatives\")\n             [ \"dia internacional de les cooperatives del 2019\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 17, 0, 0, 0) Day \"Dia de la Prematuridad Mundial\")\n             [ \"dia de la prematuritat mundial\"\n             , \"dia mundial de l'infant prematur\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 1, 0, 0, 0) Day \"Dia dels Innocents d'Abril\")\n             [ \"dia dels innocents d'abril\"\n             ]\n  , examples (datetime (2013, 3, 9, 0, 0, 0) Day)\n             [ \"dia nou\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"dia quinze\"\n             ]\n  , examples (datetime (2013, 3, 11, 0, 0, 0) Day)\n             [ \"dia onze\"\n             ]\n  , examples (datetime (1990, 0, 0, 0, 0, 0) Year)\n             [ \"mil nou-cents noranta\"\n             ]\n  , examples (datetime (1990, 5, 4, 0, 0, 0) Day)\n             [ \"quatre de maig de mil nou-cents noranta\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"segon trimestre de 2013\"\n             ]\n  ]\n", "num_lines": 440}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.DA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Testing.Types hiding (examples)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"nu\"\n             , \"lige nu\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"i dag\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"i g\u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"i morgen\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"mandag\"\n             , \"p\u00c3\u00a5 mandag\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Mandag den 18. februar\"\n             , \"Mandag, 18 februar\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"tirsdag\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"torsdag\"\n             , \"tors\"\n             , \"tors.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"fredag\"\n             , \"fre\"\n             , \"fre.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"l\u00c3\u00b8rdag\"\n             , \"l\u00c3\u00b8r\"\n             , \"l\u00c3\u00b8r.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"s\u00c3\u00b8ndag\"\n             , \"s\u00c3\u00b8n\"\n             , \"s\u00c3\u00b8n.\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"Den f\u00c3\u00b8rste marts\"\n             , \"1. marts\"\n             , \"Den 1. marts\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"3 marts\"\n             , \"den tredje marts\"\n             , \"den 3. marts\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"3 marts 2015\"\n             , \"tredje marts 2015\"\n             , \"3. marts 2015\"\n             , \"3-3-2015\"\n             , \"03-03-2015\"\n             , \"3/3/2015\"\n             , \"3/3/15\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"P\u00c3\u00a5 den 15.\"\n             , \"P\u00c3\u00a5 den 15\"\n             , \"Den 15.\"\n             , \"Den 15\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"den 15. februar\"\n             , \"15. februar\"\n             , \"februar 15\"\n             , \"15-02\"\n             , \"15/02\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"8 Aug\"\n             ]\n  , examples (datetime (2014, 10, 0, 0, 0, 0) Month)\n             [ \"Oktober 2014\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14april 2015\"\n             , \"April 14, 2015\"\n             , \"fjortende April 15\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a6ste tirsdag\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a6ste fredag igen\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a6ste marts\"\n             ]\n  , examples (datetime (2014, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a6ste marts igen\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"S\u00c3\u00b8ndag, 10 feb\"\n             , \"S\u00c3\u00b8ndag 10 Feb\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"Ons, Feb13\"\n             , \"Ons feb13\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Mandag, Feb 18\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"denne uge\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"sidste uge\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"n\u00c3\u00a6ste uge\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"sidste m\u00c3\u00a5ned\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a6ste m\u00c3\u00a5ned\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"dette kvartal\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"n\u00c3\u00a6ste kvartal\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"tredje kvartal\"\n             , \"3. kvartal\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"4. kvartal 2018\"\n             , \"fjerde kvartal 2018\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"sidste \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"i \u00c3\u00a5r\"\n             , \"dette \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"n\u00c3\u00a6ste \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"sidste s\u00c3\u00b8ndag\"\n             , \"s\u00c3\u00b8ndag i sidste uge\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"sidste tirsdag\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a6ste tirsdag\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a6ste onsdag\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"onsdag i n\u00c3\u00a6ste uge\"\n             , \"onsdag n\u00c3\u00a6ste uge\"\n             , \"n\u00c3\u00a6ste onsdag igen\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a6ste fredag igen\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"mandag i denne uge\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"tirsdag i denne uge\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"onsdag i denne uge\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"i overmorgen\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"i forg\u00c3\u00a5rs\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"sidste mandag i marts\"\n             , \"sidste mandag i Marts\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"sidste s\u00c3\u00b8ndag i marts 2014\"\n             , \"sidste s\u00c3\u00b8ndag i Marts 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"tredje dag i oktober\"\n             , \"tredje dag i Oktober\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"f\u00c3\u00b8rste uge i oktober 2014\"\n             , \"f\u00c3\u00b8rste uge i Oktober 2014\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"sidste dag i oktober 2015\"\n             , \"sidste dag i Oktober 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"sidste uge i september 2014\"\n             , \"sidste uge i September 2014\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b8rste tirsdag i oktober\"\n             , \"f\u00c3\u00b8rste tirsdag i Oktober\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"tredje tirsdag i september 2014\"\n             , \"tredje tirsdag i September 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b8rste onsdag i oktober 2014\"\n             , \"f\u00c3\u00b8rste onsdag i Oktober 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"anden onsdag i oktober 2014\"\n             , \"anden onsdag i Oktober 2014\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Hour)\n             [ \"klokken 3\"\n             , \"kl. 3\"\n             , \"kl 3\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"klokken 15\"\n             , \"kl. 15\"\n             , \"kl 15\"\n             , \"15h\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"ca. kl. 15\"\n             , \"cirka kl. 15\"\n             , \"cirka kl 15\"\n             , \"omkring klokken 15\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"imorgen klokken 17 sharp\"\n             , \"imorgen kl. 17 pr\u00c3\u00a6cis\"\n             , \"imorgen kl 17 pr\u00c3\u00a6cis\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"kvarter over 15\"\n             , \"kvart over 15\"\n             , \"15:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"kl. 20 over 15\"\n             , \"klokken 20 over 15\"\n             , \"kl. 15:20\"\n             , \"kl 15:20\"\n             , \"15:20\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"15:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 23, 24) Second)\n             [ \"15:23:24\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"kvarter i 12\"\n             , \"kvart i 12\"\n             , \"11:45\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"klokken 9 p\u00c3\u00a5 l\u00c3\u00b8rdag\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Minute)\n             [ \"Fre, Jul 18, 2014 19:00\"\n             ]\n  , examples (datetime (2014, 7, 18, 0, 0, 0) Day)\n             [ \"Fre, Jul 18\"\n             , \"Jul 18, Fre\"\n             ]\n  , examples (datetime (2014, 9, 20, 19, 30, 0) Minute)\n             [ \"kl. 19:30, L\u00c3\u00b8r, 20 sep\"\n             , \"kl 19:30, L\u00c3\u00b8r, 20 sep\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"om 1 sekund\"\n             , \"om \u00c3\u00a9t sekund\"\n             , \"om et sekund\"\n             , \"\u00c3\u00a9t sekund fra nu\"\n             , \"et sekund fra nu\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"om 1 minut\"\n             , \"om \u00c3\u00a9t minut\"\n             , \"om et minut\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"om 2 minutter\"\n             , \"om to minutter\"\n             , \"om 2 minutter mere\"\n             , \"om to minutter mere\"\n             , \"2 minutter fra nu\"\n             , \"to minutter fra nu\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"om 60 minutter\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"om en halv time\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 0, 0) Second)\n             [ \"om 2,5 time\"\n             , \"om 2 og en halv time\"\n             , \"om to og en halv time\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"om \u00c3\u00a9n time\"\n             , \"om 1 time\"\n             , \"om 1t\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 30, 0) Minute)\n             [ \"om et par timer\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"om 24 timer\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"om en dag\"\n             ]\n  , examples (datetime (2016, 2, 0, 0, 0, 0) Month)\n             [ \"3 \u00c3\u00a5r fra i dag\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"om 7 dage\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"om en uge\"\n             , \"om \u00c3\u00a9n uge\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"om ca. en halv time\"\n             , \"om cirka en halv time\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 dage siden\"\n             , \"syv dage siden\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"14 dage siden\"\n             , \"fjorten dage siden\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"en uge siden\"\n             , \"\u00c3\u00a9n uge siden\"\n             , \"1 uge siden\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"3 uger siden\"\n             , \"tre uger siden\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"3 m\u00c3\u00a5neder siden\"\n             , \"tre m\u00c3\u00a5neder siden\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"to \u00c3\u00a5r siden\"\n             , \"2 \u00c3\u00a5r siden\"\n             ]\n  , examples (datetime (1954, 0, 0, 0, 0, 0) Year)\n             [ \"1954\"\n             ]\n  , examples (datetime (2013, 12, 24, 0, 0, 0) Day)\n             [ \"et \u00c3\u00a5r efter juleaften\"\n             , \"\u00c3\u00a9t \u00c3\u00a5r efter juleaften\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"denne sommer\"\n             , \"den her sommer\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"denne vinter\"\n             , \"den her vinter\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"1 juledag\"\n             , \"1. juledag\"\n             , \"f\u00c3\u00b8rste juledag\"\n             ]\n  , examples (datetime (2013, 12, 31, 0, 0, 0) Day)\n             [ \"nyt\u00c3\u00a5rsaftensdag\"\n             , \"nyt\u00c3\u00a5rsaften\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"nyt\u00c3\u00a5rsdag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"i aften\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 8, 18, 0, 0), (2013, 2, 11, 0, 0, 0)) Hour)\n             [ \"sidste weekend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"i morgen aften\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 14, 0, 0)) Hour)\n             [ \"i morgen middag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"i g\u00c3\u00a5r aftes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"denne weekend\"\n             , \"i weekenden\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"mandag morgen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"sidste 2 sekunder\"\n             , \"sidste to sekunder\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"n\u00c3\u00a6ste 3 sekunder\"\n             , \"n\u00c3\u00a6ste tre sekunder\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"sidste 2 minutter\"\n             , \"sidste to minutter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"n\u00c3\u00a6ste 3 minutter\"\n             , \"n\u00c3\u00a6ste tre minutter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 3, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"sidste 1 time\"\n             , \"seneste 1 time\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"n\u00c3\u00a6ste 3 timer\"\n             , \"n\u00c3\u00a6ste tre timer\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"sidste 2 dage\"\n             , \"sidste to dage\"\n             , \"seneste 2 dage\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"n\u00c3\u00a6ste 3 dage\"\n             , \"n\u00c3\u00a6ste tre dage\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"sidste 2 uger\"\n             , \"sidste to uger\"\n             , \"seneste to uger\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"n\u00c3\u00a6ste 3 uger\"\n             , \"n\u00c3\u00a6ste tre uger\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"sidste 2 m\u00c3\u00a5neder\"\n             , \"sidste to m\u00c3\u00a5neder\"\n             , \"seneste to m\u00c3\u00a5neder\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"n\u00c3\u00a6ste 3 m\u00c3\u00a5neder\"\n             , \"n\u00c3\u00a6ste tre m\u00c3\u00a5neder\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"sidste 2 \u00c3\u00a5r\"\n             , \"sidste to \u00c3\u00a5r\"\n             , \"seneste 2 \u00c3\u00a5r\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"n\u00c3\u00a6ste 3 \u00c3\u00a5r\"\n             , \"n\u00c3\u00a6ste tre \u00c3\u00a5r\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13-15 juli\"\n             , \"13-15 Juli\"\n             , \"13 til 15 Juli\"\n             , \"13 juli til 15 juli\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"8 Aug - 12 Aug\"\n             , \"8 Aug - 12 aug\"\n             , \"8 aug - 12 aug\"\n             , \"8 august - 12 august\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             , \"9:30 til 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"fra 9:30 - 11:00 p\u00c3\u00a5 torsdag\"\n             , \"fra 9:30 til 11:00 p\u00c3\u00a5 torsdag\"\n             , \"mellem 9:30 og 11:00 p\u00c3\u00a5 torsdag\"\n             , \"9:30 - 11:00 p\u00c3\u00a5 torsdag\"\n             , \"9:30 til 11:00 p\u00c3\u00a5 torsdag\"\n             , \"efter 9:30 men f\u00c3\u00b8r 11:00 p\u00c3\u00a5 torsdag\"\n             , \"torsdag fra 9:30 til 11:00\"\n             , \"torsdag mellem 9:30 og 11:00\"\n             , \"fra 9:30 til 11:00 p\u00c3\u00a5 torsdag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"torsdag fra 9 til 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-13:30\"\n             , \"11:30-13:30\"\n             , \"11:30-13:30\"\n             , \"11:30-13:30\"\n             , \"11:30-13:30\"\n             , \"11:30-13:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"indenfor 2 uger\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"inden kl. 14\"\n             , \"indtil kl. 14\"\n             , \"indtil kl 14\"\n             , \"inden klokken 14\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"@ 16 CET\"\n             , \"kl. 16 CET\"\n             , \"kl 16 CET\"\n             , \"klokken 16 CET\"\n             ]\n  , examples (datetime (2013, 2, 14, 6, 0, 0) Minute)\n             [ \"torsdag kl. 8:00 GMT\"\n             , \"torsdag kl. 8:00 gmt\"\n             , \"torsdag kl 8:00 gmt\"\n             , \"torsdag klokken 8:00 GMT\"\n             , \"torsdag klokken 8:00 gmt\"\n             , \"torsdag 08:00 GMT\"\n             , \"torsdag 08:00 gmt\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"idag kl. 14\"\n             , \"i dag kl. 14\"\n             , \"i dag kl. 14\"\n             , \"idag klokken 14\"\n             , \"kl. 14\"\n             , \"kl 14\"\n             , \"klokken 14\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 kl. 16:00\"\n             , \"25/4 kl 16:00\"\n             , \"25/4 klokken 16:00\"\n             , \"25-04 klokken 16:00\"\n             , \"25-4 kl. 16:00\"\n             , \"25-4 kl 16:00\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Minute)\n             [ \"15:00 i morgen\"\n             , \"kl. 15:00 i morgen\"\n             , \"kl 15:00 i morgen\"\n             , \"klokken 15:00 i morgen\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"efter kl. 14\"\n             , \"efter kl 14\"\n             , \"efter klokken 14\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"efter 5 dage\"\n             , \"efter fem dage\"\n             ]\n  , examples (datetime (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"om 5 dage\"\n             , \"om fem dage\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 13, 14, 0, 0) Hour)\n             [ \"efter i morgen kl. 14\"\n             , \"efter i morgen kl 14\"\n             , \"efter i morgen klokken 14\"\n             , \"i morgen efter kl. 14\"\n             , \"i morgen efter kl 14\"\n             , \"i morgen efter klokken 14\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"f\u00c3\u00b8r kl. 11\"\n             , \"f\u00c3\u00b8r kl 11\"\n             , \"f\u00c3\u00b8r klokken 11\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 13, 11, 0, 0) Hour)\n             [ \"i morgen f\u00c3\u00b8r kl. 11\"\n             , \"i morgen f\u00c3\u00b8r kl 11\"\n             , \"i morgen f\u00c3\u00b8r klokken 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"om eftermiddagen\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 30, 0) Minute)\n             [ \"kl. 13:30\"\n             , \"kl 13:30\"\n             , \"klokken 13:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"om 15 minutter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"efter frokost\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"denne morgen\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a6ste mandag\"\n             ]\n  ]\n", "num_lines": 656}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.DA.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Types (OrdinalData (..))\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport qualified Data.Text as Text\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  -- 'man' is a common Danish word ('you'), leading to false positives\n  [ ( \"Monday\"   , \"mandag\"            )\n  , ( \"Tuesday\"  , \"tirsdag|tirs?\\\\.?\" )\n  , ( \"Wednesday\", \"onsdag|ons\\\\.?\"    )\n  , ( \"Thursday\" , \"torsdag|tors?\\\\.?\" )\n  , ( \"Friday\"   , \"fredag|fre\\\\.?\"    )\n  , ( \"Saturday\" , \"l\u00c3\u00b8rdag|l\u00c3\u00b8r\\\\.?\"    )\n  , ( \"Sunday\"   , \"s\u00c3\u00b8ndag|s\u00c3\u00b8n\\\\.?\"    )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"January\"  , \"januar|jan\\\\.?\"      )\n  , ( \"February\" , \"februar|feb\\\\.?\"     )\n  , ( \"March\"    , \"marts|mar\\\\.?\"       )\n  , ( \"April\"    , \"april|apr\\\\.?\"       )\n  , ( \"May\"      , \"maj\"                 )\n  , ( \"June\"     , \"juni|jun\\\\.?\"        )\n  , ( \"July\"     , \"juli|jul\\\\.?\"        )\n  , ( \"August\"   , \"august|aug\\\\.?\"      )\n  , ( \"September\", \"september|sept?\\\\.?\" )\n  , ( \"October\"  , \"oktober|okt\\\\.?\"     )\n  , ( \"November\" , \"november|nov\\\\.?\"    )\n  , ( \"December\" , \"december|dec\\\\.?\"    )\n  ]\n\nruleTheDayAfterTomorrow :: Rule\nruleTheDayAfterTomorrow = Rule\n  { name = \"the day after tomorrow\"\n  , pattern =\n    [ regex \"i overmorgen\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleRelativeMinutesTotillbeforeIntegerHourofday :: Rule\nruleRelativeMinutesTotillbeforeIntegerHourofday = Rule\n  { name = \"relative minutes to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"i\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleQuarterTotillbeforeIntegerHourofday :: Rule\nruleQuarterTotillbeforeIntegerHourofday = Rule\n  { name = \"quarter to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"(et|\u00c3\u00a9t)? ?kvart(er)? i\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleHalfTotillbeforeIntegerHourofday :: Rule\nruleHalfTotillbeforeIntegerHourofday = Rule\n  { name = \"half to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halv time i\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleConstitutionDay :: Rule\nruleConstitutionDay = Rule\n  { name = \"constitution day\"\n  , pattern =\n    [ regex \"grundlov'?s?'? dag\"\n    ]\n  , prod = \\_ -> tt $ monthDay 6 5\n  }\n\nruleValentinesDay :: Rule\nruleValentinesDay = Rule\n  { name = \"valentine's day\"\n  , pattern =\n    [ regex \"valentine'?s?( dag)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 2 14\n  }\n\nruleTheOrdinalCycleOfTime :: Rule\nruleTheOrdinalCycleOfTime = Rule\n  { name = \"the <ordinal> <cycle> of <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"af|i|fra\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime2 :: Rule\nruleNthTimeOfTime2 = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"af|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleNewYearsDay :: Rule\nruleNewYearsDay = Rule\n  { name = \"new year's day\"\n  , pattern =\n    [ regex \"nyt\u00c3\u00a5rsdag\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 1\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"(sidste|seneste)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|til|indtil\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEvening :: Rule\nruleEvening = Rule\n  { name = \"evening\"\n  , pattern =\n    [ regex \"afte(s|n(en)?)\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTheDayofmonthNonOrdinal :: Rule\nruleTheDayofmonthNonOrdinal = Rule\n  { name = \"the <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"den\"\n    , Predicate $ isIntegerBetween 1 31\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt $ dayOfMonth n\n      _ -> Nothing\n  }\n\nruleCycleAfterTime :: Rule\nruleCycleAfterTime = Rule\n  { name = \"<cycle> after <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in <duration>\"\n  , pattern =\n    [ regex \"om\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleNow :: Rule\nruleNow = Rule\n  { name = \"now\"\n  , pattern =\n    [ regex \"lige nu|nu|(i )?dette \u00c3\u00b8jeblik\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"sidste\"\n    , dimension TimeGrain\n    , regex \"af|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleFromDatetimeDatetimeInterval :: Rule\nruleFromDatetimeDatetimeInterval = Rule\n  { name = \"from <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"fra\"\n    , dimension Time\n    , regex \"\\\\-|til|indtil\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleRelativeMinutesAfterpastIntegerHourofday :: Rule\nruleRelativeMinutesAfterpastIntegerHourofday = Rule\n  { name = \"relative minutes after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"over\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       _:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleQuarterAfterpastIntegerHourofday :: Rule\nruleQuarterAfterpastIntegerHourofday = Rule\n  { name = \"quarter after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"(et|\u00c3\u00a9t)? ?kvart(er)? over\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleHalfAfterpastIntegerHourofday :: Rule\nruleHalfAfterpastIntegerHourofday = Rule\n  { name = \"half after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halv time over\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleMonthDdddInterval :: Rule\nruleMonthDdddInterval = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ regex \"([012]?\\\\d|30|31)(ter|\\\\.)?\"\n    , regex \"\\\\-|til\"\n    , regex \"([012]?\\\\d|30|31)(ter|\\\\.)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (m2:_)):\n       Token Time td:\n       _) -> do\n        v1 <- parseInt m1\n        v2 <- parseInt m2\n        from <- intersect td (dayOfMonth v1)\n        to <- intersect td (dayOfMonth v2)\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleTheCycleAfterTime :: Rule\nruleTheCycleAfterTime = Rule\n  { name = \"the <cycle> after <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|tet|et)? efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleTheCycleBeforeTime :: Rule\nruleTheCycleBeforeTime = Rule\n  { name = \"the <cycle> before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|tet|et)? f\u00c3\u00b8r\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleSeason4 :: Rule\nruleSeason4 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"for\u00c3\u00a5r\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (monthDay 3 20) (monthDay 6 21)\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleTimeAfterNext :: Rule\nruleTimeAfterNext = Rule\n  { name = \"<time> after next\"\n  , pattern =\n    [ regex \"n(\u00c3\u00a6)ste\"\n    , dimension Time\n    , regex \"igen\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleTheIdesOfNamedmonth :: Rule\nruleTheIdesOfNamedmonth = Rule\n  { name = \"the ides of <named-month>\"\n  , pattern =\n    [ regex \"midten af\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td@TimeData {TTime.form = Just (TTime.Month m)}:_) ->\n        Token Time <$>\n          intersect td (dayOfMonth $ if elem m [3, 5, 7, 10] then 15 else 13)\n      _ -> Nothing\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"middag|(kl(\\\\.|okken)?)? tolv\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleToday :: Rule\nruleToday = Rule\n  { name = \"today\"\n  , pattern =\n    [ regex \"i dag|idag\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"(kommende|n(\u00c3\u00a6)ste)\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleTheDayBeforeYesterday :: Rule\nruleTheDayBeforeYesterday = Rule\n  { name = \"the day before yesterday\"\n  , pattern =\n    [ regex \"i forg\u00c3\u00a5rs\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 2\n  }\n\nruleBetweenTimeofdayAndTimeofdayInterval :: Rule\nruleBetweenTimeofdayAndTimeofdayInterval = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"mellem\"\n    , Predicate isATimeOfDay\n    , regex \"og\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNextCycle :: Rule\nruleNextCycle = Rule\n  { name = \"next <cycle>\"\n  , pattern =\n    [ regex \"n(\u00c3\u00a6)ste|kommende\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleTheCycleOfTime :: Rule\nruleTheCycleOfTime = Rule\n  { name = \"the <cycle> of <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|tet|et)? af\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleTimeofdayApproximately :: Rule\nruleTimeofdayApproximately = Rule\n  { name = \"<time-of-day> approximately\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(cirka|ca\\\\.|-?ish)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleOnDate :: Rule\nruleOnDate = Rule\n  { name = \"on <date>\"\n  , pattern =\n    [ regex \"den|p\u00c3\u00a5\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleDurationFromNow :: Rule\nruleDurationFromNow = Rule\n  { name = \"<duration> from now\"\n  , pattern =\n    [ dimension Duration\n    , regex \"fra (i dag|nu)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLunch :: Rule\nruleLunch = Rule\n  { name = \"lunch\"\n  , pattern =\n    [ regex \"(til )?middag\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 14\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleLastCycle :: Rule\nruleLastCycle = Rule\n  { name = \"last <cycle>\"\n  , pattern =\n    [ regex \"sidste|seneste\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\/-](0?[1-9]|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"eftermiddag(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 19\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTimeBeforeLast :: Rule\nruleTimeBeforeLast = Rule\n  { name = \"<time> before last\"\n  , pattern =\n    [ regex \"sidste\"\n    , dimension Time\n    , regex \"igen\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-2) False td\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthOrdinal :: Rule\nruleNamedmonthDayofmonthOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleChristmasEve :: Rule\nruleChristmasEve = Rule\n  { name = \"christmas eve\"\n  , pattern =\n    [ regex \"juleaften(sdag)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 24\n  }\n\nruleInduringThePartofday :: Rule\nruleInduringThePartofday = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"om|i\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdayQuart :: Rule\nruleHourofdayQuart = Rule\n  { name = \"<hour-of-day> quarter (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(et|\u00c3\u00a9t)? ?kvart(er)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayHalf :: Rule\nruleHourofdayHalf = Rule\n  { name = \"<hour-of-day> half (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"halv time\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonth :: Rule\nruleDayofmonthordinalNamedmonth = Rule\n  { name = \"<day-of-month>(ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by \\\",\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleAfterDuration :: Rule\nruleAfterDuration = Rule\n  { name = \"after <duration>\"\n  , pattern =\n    [ regex \"efter\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt . withDirection TTime.After $ inDuration dd\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ hour False v\n      _ -> Nothing\n  }\n\nruleDayofmonthOrdinalOfNamedmonth :: Rule\nruleDayofmonthOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , regex \"af|i\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleFromTimeofdayTimeofdayInterval :: Rule\nruleFromTimeofdayTimeofdayInterval = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(efter|fra)\"\n    , Predicate isATimeOfDay\n    , regex \"((men )?f\u00c3\u00b8r)|\\\\-|til|indtil\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\n\nruleExactlyTimeofday :: Rule\nruleExactlyTimeofday = Rule\n  { name = \"exactly <time-of-day>\"\n  , pattern =\n    [ regex \"pr(\u00c3\u00a6)cis( klokken| kl\\\\.?)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleInduringThePartofday2 :: Rule\nruleInduringThePartofday2 = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"om|i\"\n    , Predicate isAPartOfDay\n    , regex \"en|ten\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleSeason3 :: Rule\nruleSeason3 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"vinter\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 12 21\n          to = monthDay 3 20\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleSeason :: Rule\nruleSeason = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"sommer\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 6 21\n          to = monthDay 9 23\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleBetweenDatetimeAndDatetimeInterval :: Rule\nruleBetweenDatetimeAndDatetimeInterval = Rule\n  { name = \"between <datetime> and <datetime> (interval)\"\n  , pattern =\n    [ regex \"mellem\"\n    , dimension Time\n    , regex \"og\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNewYearsEve :: Rule\nruleNewYearsEve = Rule\n  { name = \"new year's eve\"\n  , pattern =\n    [ regex \"nyt\u00c3\u00a5rsaften(sdag)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 31\n  }\n\nruleDurationAgo :: Rule\nruleDurationAgo = Rule\n  { name = \"<duration> ago\"\n  , pattern =\n    [ dimension Duration\n    , regex \"siden\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleByTheEndOfTime :: Rule\nruleByTheEndOfTime = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"i slutningen af\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed now td\n      _ -> Nothing\n  }\n\nruleAfterWork :: Rule\nruleAfterWork = Rule\n  { name = \"after work\"\n  , pattern =\n    [ regex \"efter arbejde\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 17) (hour False 21)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleLastNCycle :: Rule\nruleLastNCycle = Rule\n  { name = \"last n <cycle>\"\n  , pattern =\n    [ regex \"sidste|seneste\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt $ cycleN True grain (- n)\n      _ -> Nothing\n  }\n\nruleTimeofdaySharp :: Rule\nruleTimeofdaySharp = Rule\n  { name = \"<time-of-day> sharp\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(sharp|pr(\u00c3\u00a6)cis)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleWithinDuration :: Rule\nruleWithinDuration = Rule\n  { name = \"within <duration>\"\n  , pattern =\n    [ regex \"indenfor\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> Token Time <$>\n        interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleMidnighteodendOfDay :: Rule\nruleMidnighteodendOfDay = Rule\n  { name = \"midnight|EOD|end of day\"\n  , pattern =\n    [ regex \"midnat|EOD\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleDayofmonthNonOrdinalNamedmonth :: Rule\nruleDayofmonthNonOrdinalNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAboutTimeofday :: Rule\nruleAboutTimeofday = Rule\n  { name = \"about <time-of-day>\"\n  , pattern =\n    [ regex \"(omkring|cirka|ca\\\\.)( klokken| kl\\\\.?)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleUntilTimeofday :: Rule\nruleUntilTimeofday = Rule\n  { name = \"until <time-of-day>\"\n  , pattern =\n    [ regex \"(engang )?inden|indtil|f\u00c3\u00b8r|op til\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleAtTimeofday :: Rule\nruleAtTimeofday = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"klokken|kl\\\\.?|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"af|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimePartofday :: Rule\nruleTimePartofday = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"(week(\\\\s|-)?end)(en)?\"\n    ]\n  , prod = \\_ -> tt weekend\n  }\n\nruleAboutDuration :: Rule\nruleAboutDuration = Rule\n  { name = \"about <duration>\"\n  , pattern =\n    [ regex \"(omkring|cirka|ca.)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> Just . Token Duration $ dd\n      _ -> Nothing\n  }\n\nruleEomendOfMonth :: Rule\nruleEomendOfMonth = Rule\n  { name = \"EOM|End of month\"\n  , pattern =\n    [ regex \"EOM\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Month 1\n  }\n\nruleNthTimeAfterTime2 :: Rule\nruleNthTimeAfterTime2 = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"n(\u00c3\u00a6)ste|kommende\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarterYear :: Rule\nruleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:_:Token Time td:_) ->\n        tt $ cycleNthAfter False TG.Quarter (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m1\n        m <- parseInt m2\n        d <- parseInt m3\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleAfterTime :: Rule\nruleTheOrdinalCycleAfterTime = Rule\n  { name = \"the <ordinal> <cycle> after <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleIntersectByOfFromS :: Rule\nruleIntersectByOfFromS = Rule\n  { name = \"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"i\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNextNCycle :: Rule\nruleNextNCycle = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"n(\u00c3\u00a6)ste\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt $ cycleN True grain n\n      _ -> Nothing\n  }\n\nruleADuration :: Rule\nruleADuration = Rule\n  { name = \"a <duration>\"\n  , pattern =\n    [ regex \"(om )?en|et|\u00c3\u00a9n|\u00c3\u00a9t\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"morgen(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 4\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"i|denne\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisCycle :: Rule\nruleThisCycle = Rule\n  { name = \"this <cycle>\"\n  , pattern =\n    [ regex \"denne|dette|i|nuv(\u00c3\u00a6)rende|indev(\u00c3\u00a6)rende\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"(denne|dette|i|den her)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleDurationHence :: Rule\nruleDurationHence = Rule\n  { name = \"<duration> hence\"\n  , pattern =\n    [ dimension Duration\n    , regex \"hence\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalOfNamedmonth :: Rule\nruleDayofmonthNonOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"af|i\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAfterLunch :: Rule\nruleAfterLunch = Rule\n  { name = \"after lunch\"\n  , pattern =\n    [ regex \"efter (frokost|middag)\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 13) (hour False 17)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleOnANamedday :: Rule\nruleOnANamedday = Rule\n  { name = \"on a named-day\"\n  , pattern =\n    [ regex \"p\u00c3\u00a5 en\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        y <- getIntValue token\n        tt . mkLatent $ year y\n      _ -> Nothing\n  }\n\nruleYesterday :: Rule\nruleYesterday = Rule\n  { name = \"yesterday\"\n  , pattern =\n    [ regex \"i g\u00c3\u00a5r|ig\u00c3\u00a5r\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleSeason2 :: Rule\nruleSeason2 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"efter\u00c3\u00a5r\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 9 23\n          to = monthDay 12 21\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleAfterTimeofday :: Rule\nruleAfterTimeofday = Rule\n  { name = \"after <time-of-day>\"\n  , pattern =\n    [ regex \"(engang )?efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleChristmas :: Rule\nruleChristmas = Rule\n  { name = \"christmas\"\n  , pattern =\n    [ regex \"((1\\\\.?)|f\u00c3\u00b8rste)? ?juledag\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleNight :: Rule\nruleNight = Rule\n  { name = \"night\"\n  , pattern =\n    [ regex \"nat(ten)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 0\n          to = hour False 4\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDayofmonthOrdinal :: Rule\nruleDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleOrdinalCycleAfterTime :: Rule\nruleOrdinalCycleAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleOfTime :: Rule\nruleOrdinalCycleOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"af|i|fra\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleHhmm :: Rule\nruleHhmm = Rule\n  { name = \"hh:mm\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleTonight :: Rule\nruleTonight = Rule\n  { name = \"tonight\"\n  , pattern =\n    [ regex \"i aften\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 18) (hour False 0)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        y <- getIntValue token\n        tt $ year y\n      _ -> Nothing\n  }\n\nruleHalloweenDay :: Rule\nruleHalloweenDay = Rule\n  { name = \"halloween day\"\n  , pattern =\n    [ regex \"hall?owe?en\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 31\n  }\n\nruleNamedmonthDayofmonthNonOrdinal :: Rule\nruleNamedmonthDayofmonthNonOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"sidste\"\n    , Predicate isADayOfWeek\n    , regex \"af|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleFathersDay :: Rule\nruleFathersDay = Rule\n  { name = \"Father's Day\"\n  , pattern =\n    [ regex \"far'?s?'? dag\"\n    ]\n  , prod = \\_ -> tt $ monthDay 6 5\n  }\n\nruleCycleBeforeTime :: Rule\nruleCycleBeforeTime = Rule\n  { name = \"<cycle> before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"f\u00c3\u00b8r\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\/-](0?[1-9]|1[0-2])[\\\\/-](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval :: Rule\nruleTimeofdayTimeofdayInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\-|til|indtil\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAfterTime :: Rule\nruleDurationAfterTime = Rule\n  { name = \"<duration> after <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarter :: Rule\nruleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter False TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleTheDayofmonthOrdinal :: Rule\nruleTheDayofmonthOrdinal = Rule\n  { name = \"the <day-of-month> (ordinal)\"\n  , pattern =\n    [ regex \"den\"\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleDurationBeforeTime :: Rule\nruleDurationBeforeTime = Rule\n  { name = \"<duration> before <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"f\u00c3\u00b8r\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nrulePartofdayOfTime :: Rule\nrulePartofdayOfTime = Rule\n  { name = \"<part-of-day> of <time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"(en |ten )?den\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleEoyendOfYear :: Rule\nruleEoyendOfYear = Rule\n  { name = \"EOY|End of year\"\n  , pattern =\n    [ regex \"EOY\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Year 1\n  }\n\nruleTomorrow :: Rule\nruleTomorrow = Rule\n  { name = \"tomorrow\"\n  , pattern =\n    [ regex \"i morgen|imorgen\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleMothersDay :: Rule\nruleMothersDay = Rule\n  { name = \"Mother's Day\"\n  , pattern =\n    [ regex \"mor'?s? dag\"\n    ]\n  , prod = \\_ -> tt $ nthDOWOfMonth 1 7 5\n  }\n\nruleTimeofdayOclock :: Rule\nruleTimeofdayOclock = Rule\n  { name = \"<time-of-day> o'clock\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"h\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonthYear :: Rule\nruleDayofmonthordinalNamedmonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       Token Time td:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         n <- parseInt match\n         td2 <- intersectDOM td token\n         Token Time <$> intersect td2 (year n)\n      _ -> Nothing\n  }\n\nruleHhmmss :: Rule\nruleHhmmss = Rule\n  { name = \"hh:mm:ss\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        s <- parseInt m3\n        tt $ hourMinuteSecond False h m s\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleADuration\n  , ruleAboutDuration\n  , ruleAboutTimeofday\n  , ruleAbsorptionOfAfterNamedDay\n  , ruleAfterDuration\n  , ruleAfterLunch\n  , ruleAfterTimeofday\n  , ruleAfterWork\n  , ruleAfternoon\n  , ruleAtTimeofday\n  , ruleBetweenDatetimeAndDatetimeInterval\n  , ruleBetweenTimeofdayAndTimeofdayInterval\n  , ruleByTheEndOfTime\n  , ruleChristmas\n  , ruleChristmasEve\n  , ruleConstitutionDay\n  , ruleCycleAfterTime\n  , ruleCycleBeforeTime\n  , ruleDatetimeDatetimeInterval\n  , ruleDayofmonthNonOrdinalNamedmonth\n  , ruleDayofmonthNonOrdinalOfNamedmonth\n  , ruleDayofmonthOrdinal\n  , ruleDayofmonthOrdinalOfNamedmonth\n  , ruleDayofmonthordinalNamedmonth\n  , ruleDayofmonthordinalNamedmonthYear\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleDurationAfterTime\n  , ruleDurationAgo\n  , ruleDurationBeforeTime\n  , ruleDurationFromNow\n  , ruleDurationHence\n  , ruleEomendOfMonth\n  , ruleEoyendOfYear\n  , ruleEvening\n  , ruleExactlyTimeofday\n  , ruleFathersDay\n  , ruleFromDatetimeDatetimeInterval\n  , ruleFromTimeofdayTimeofdayInterval\n  , ruleHalloweenDay\n  , ruleHhmm\n  , ruleHhmmss\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleInDuration\n  , ruleInduringThePartofday\n  , ruleInduringThePartofday2\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleIntersectByOfFromS\n  , ruleLastCycle\n  , ruleLastCycleOfTime\n  , ruleLastDayofweekOfTime\n  , ruleLastNCycle\n  , ruleLastTime\n  , ruleLunch\n  , ruleMidnighteodendOfDay\n  , ruleMonthDdddInterval\n  , ruleMorning\n  , ruleMothersDay\n  , ruleNamedmonthDayofmonthNonOrdinal\n  , ruleNamedmonthDayofmonthOrdinal\n  , ruleNewYearsDay\n  , ruleNewYearsEve\n  , ruleNextCycle\n  , ruleNextNCycle\n  , ruleNextTime\n  , ruleNight\n  , ruleNoon\n  , ruleNow\n  , ruleNthTimeAfterTime\n  , ruleNthTimeAfterTime2\n  , ruleNthTimeOfTime\n  , ruleNthTimeOfTime2\n  , ruleOnANamedday\n  , ruleOnDate\n  , ruleOrdinalCycleAfterTime\n  , ruleOrdinalCycleOfTime\n  , ruleOrdinalQuarter\n  , ruleOrdinalQuarterYear\n  , rulePartofdayOfTime\n  , ruleRelativeMinutesAfterpastIntegerHourofday\n  , ruleRelativeMinutesTotillbeforeIntegerHourofday\n  , ruleSeason\n  , ruleSeason2\n  , ruleSeason3\n  , ruleSeason4\n  , ruleTheCycleAfterTime\n  , ruleTheCycleBeforeTime\n  , ruleTheCycleOfTime\n  , ruleTheDayAfterTomorrow\n  , ruleTheDayBeforeYesterday\n  , ruleTheDayofmonthNonOrdinal\n  , ruleTheDayofmonthOrdinal\n  , ruleTheIdesOfNamedmonth\n  , ruleTheOrdinalCycleAfterTime\n  , ruleTheOrdinalCycleOfTime\n  , ruleThisCycle\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleThisnextDayofweek\n  , ruleTimeAfterNext\n  , ruleTimeBeforeLast\n  , ruleTimePartofday\n  , ruleTimeofdayApproximately\n  , ruleTimeofdayLatent\n  , ruleTimeofdayOclock\n  , ruleTimeofdaySharp\n  , ruleTimeofdayTimeofdayInterval\n  , ruleToday\n  , ruleTomorrow\n  , ruleTonight\n  , ruleUntilTimeofday\n  , ruleValentinesDay\n  , ruleWeekend\n  , ruleWithinDuration\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYesterday\n  , ruleYyyymmdd\n  , ruleQuarterTotillbeforeIntegerHourofday\n  , ruleHalfTotillbeforeIntegerHourofday\n  , ruleQuarterAfterpastIntegerHourofday\n  , ruleHalfAfterpastIntegerHourofday\n  , ruleHourofdayQuart\n  , ruleHourofdayHalf\n  , ruleTimezone\n  ]\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n", "num_lines": 1838}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.DE.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\ncontext :: Context\ncontext = testContext {locale = makeLocale DE Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (context, testOptions, examples)\n  where\n    examples =\n      [ \"ein Hotel\"\n      , \"ein Angebot\"\n      , \"n\u00c3\u00a4chsten 5\"\n      , \"so\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"jetzt\"\n             , \"genau jetzt\"\n             , \"gerade eben\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"heute\"\n             , \"zu dieser zeit\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"gestern\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"morgen\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"montag\"\n             , \"mo.\"\n             , \"diesen montag\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Montag, Feb 18\"\n             , \"Montag, Februar 18\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"dienstag\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"donnerstag\"\n             , \"do\"\n             , \"do.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"freitag\"\n             , \"fr.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"samstag\"\n             , \"sa.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"sonntag\"\n             , \"so.\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"1 m\u00c3\u00a4rz\"\n             , \"erster m\u00c3\u00a4rz\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"m\u00c3\u00a4rz 3\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"m\u00c3\u00a4rz 3 2015\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"am 15ten\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15. februar\"\n             , \"februar 15\"\n             , \"15te februar\"\n             , \"15.2.\"\n             , \"am 15.2.\"\n             , \"februar 15\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"Aug 8\"\n             ]\n  , examples (datetime (2014, 10, 0, 0, 0, 0) Month)\n             [ \"Oktober 2014\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31.10.1974\"\n             , \"31.10.74\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14 april 2015\"\n             , \"April 14, 2015\"\n             , \"14te April 15\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4chsten dienstag\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"\u00c3\u00bcbern\u00c3\u00a4chsten freitag\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a4chsten m\u00c3\u00a4rz\"\n             ]\n  , examples (datetime (2014, 3, 0, 0, 0, 0) Month)\n             [ \"\u00c3\u00bcbern\u00c3\u00a4chsten m\u00c3\u00a4rz\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"Sonntag, Feb 10\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"Mittwoch, Feb 13\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Montag, Feb 18\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"diese woche\"\n             , \"kommende woche\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"letzte woche\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"n\u00c3\u00a4chste woche\"\n             ]\n  , examples (datetime (2013, 2, 25, 0, 0, 0) Week)\n             [ \"\u00c3\u00bcbern\u00c3\u00a4chste woche\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"letzten monat\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a4chsten monat\"\n             ]\n  , examples (datetime (2013, 4, 0, 0, 0, 0) Month)\n             [ \"\u00c3\u00bcbern\u00c3\u00a4chsten monat\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"dieses quartal\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"n\u00c3\u00a4chstes quartal\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"\u00c3\u00bcbern\u00c3\u00a4chstes quartal\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"drittes quartal\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"4tes quartal 2018\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"letztes jahr\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"dieses jahr\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"n\u00c3\u00a4chstes jahr\"\n             ]\n  , examples (datetime (2015, 0, 0, 0, 0, 0) Year)\n             [ \"\u00c3\u00bcbern\u00c3\u00a4chstes jahr\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"letzten sonntag\"\n             , \"sonntag der letzten woche\"\n             , \"sonntag letzte woche\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"letzten dienstag\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4chsten dienstag\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4chsten mittwoch\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"mittwoch der n\u00c3\u00a4chsten woche\"\n             , \"mittwoch n\u00c3\u00a4chste woche\"\n             , \"mittwoch nach dem n\u00c3\u00a4chsten\"\n             ]\n  , examples (datetime (2013, 2, 27, 0, 0, 0) Day)\n             [ \"mittwoch in 2 wochen\"\n             , \"mittwoch in zwei wochen\"\n             ]\n  , examples (datetime (2013, 1, 30, 0, 0, 0) Day)\n             [ \"mittwoch vor 2 wochen\"\n             , \"mittwoch vor zwei wochen\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"freitag nach dem n\u00c3\u00a4chsten\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"montag dieser woche\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"dienstag dieser woche\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"mittwoch dieser woche\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"\u00c3\u00bcbermorgen\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"vorgestern\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"letzter montag im m\u00c3\u00a4rz\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"letzter sonntag im m\u00c3\u00a4rz 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"dritter tag im oktober\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"erste woche im oktober 2014\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"letzter tag im oktober 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"letzte woche im september 2014\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"erster dienstag im oktober\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"dritter dienstag im september 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"erster mittwoch im oktober 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"zweiter mittwoch im oktober 2014\"\n             ]\n  , examples (datetime (2015, 1, 13, 0, 0, 0) Day)\n             [ \"dritter dienstag nach weihnachten 2014\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 0, 0) Hour)\n             [ \"um 4 in der fr\u00c3\u00bch\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"um 3\"\n             , \"3 uhr\"\n             , \"um drei\"\n             ]\n  , examples (datetime (2013, 2, 12, 3, 18, 0) Minute)\n             [ \"3:18 fr\u00c3\u00bch\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"um 3 am nachmittag\"\n             , \"um 15\"\n             , \"um 15 uhr\"\n             , \"15 uhr\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"zirka 15 uhr\"\n             , \"circa 15 uhr\"\n             , \"um circa 15 uhr\"\n             , \"zirka 3 uhr am nachmittag\"\n             , \"um ungef\u00c3\u00a4hr 15 uhr\"\n             , \"gegen 15 uhr\"\n             , \"ca. 15h\"\n             , \"ca. um 15 uhr\"\n             , \"um ca 15h\"\n             , \"so gegen 15 uhr\"\n             , \"so um 15 uhr\"\n             , \"etwa um 15 uhr\"\n             , \"so ungef\u00c3\u00a4hr um 15 uhr\"\n             , \"etwa gegen 15 uhr\"\n             , \"gegen 15 uhr\"\n             , \"ungef\u00c3\u00a4hr um 15 uhr\"\n             , \"ungef\u00c3\u00a4hr gegen 15 uhr\"\n             , \"so circa um 15 uhr\"\n             , \"15 uhr in etwa\"\n             ]\n  , examples (datetime (2013, 4, 1, 18, 0, 0) Hour)\n             [ \"01.04. gegen 18Uhr\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"p\u00c3\u00bcnktlich um 17 uhr morgen\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"um viertel nach 3\"\n             , \"viertel nach drei Uhr\"\n             , \"3 uhr 15 am nachmittag\"\n             , \"15:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"um 20 nach 3\"\n             , \"15:20 am nachmittag\"\n             , \"15 uhr 20 nachmittags\"\n             , \"zwanzig nach 3\"\n             , \"15:20\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"um halb 4\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"halb vier uhr nachmittags\"\n             , \"halb vier am nachmittag\"\n             , \"15:30\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 30, 0) Minute)\n             [ \"3:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"viertel vor 12\"\n             , \"11:45\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"15 minuten vor 12\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"8 uhr am abend\"\n             , \"heute abend um 20 Uhr\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Minute)\n             [ \"heute um 20:00\"\n             ]\n  , examples (datetime (2013, 9, 20, 19, 30, 0) Minute)\n             [ \"um 19:30 am fr, 20. Sept.\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"am samstag um 9 Uhr\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Hour)\n             [ \"Fr, 18. Juli 2014 7 uhr abends\"\n             ]\n  , examples (datetime (2014, 7, 18, 0, 0, 0) Day)\n             [ \"Fr, 18. Juli 2014\"\n             , \"Freitag, 18.07.14\"\n             , \"Freitag, den 18.07.2014\"\n             , \"Freitag, der 18. Juli 14\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"in einer sekunde\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"in einer minute\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"in 2 minuten\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"in 60 minuten\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"in einer halben stunde\"\n             , \"in 30 minuten\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 0, 0) Second)\n             [ \"in 2,5 stunden\"\n             , \"in zwei ein halb stunden\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"in einer stunde\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 30, 0) Minute)\n             [ \"in zwei stunden\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 30, 0) Minute)\n             [ \"in ein paar stunden\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"in 24 stunden\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"morgen\"\n             ]\n  , examples (datetime (2016, 2, 0, 0, 0, 0) Month)\n             [ \"in 3 Jahren\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"in 7 tagen\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"in 1 woche\"\n             , \"in einer woche\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"in zirka einer halben stunde\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"vor 7 tagen\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"vor 14 tagen\"\n             ]\n  , examples (datetime (2013, 1, 29, 0, 0, 0) Day)\n             [ \"vor zwei wochen\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"vor einer woche\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"vor drei wochen\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"vor drei monaten\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"vor zwei jahren\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"in 7 tagen\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"ein jahr nach weihnachten\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"diesen sommer\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"diesen winter\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 25, 0, 0, 0) Day \"Weihnachten\")\n             [ \"Weihnachten\"\n             , \"Weihnachtstag\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 31, 0, 0, 0) Day \"Silvester\")\n             [ \"Silvester\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 1, 0, 0, 0) Day \"Neujahr\")\n             [ \"Neujahrstag\"\n             , \"Neujahr\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 14, 0, 0, 0) Day \"Valentinstag\")\n             [ \"Valentinstag\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Muttertag\" )\n             [ \"Muttertag\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Vatertag\" )\n             [ \"Vatertag\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 3, 0, 0, 0) Day \"Tag der Deutschen Einheit\")\n             [ \"Tag der Deutschen Einheit\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 31, 0, 0, 0) Day \"Halloween\")\n             [ \"Halloween\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 1, 0, 0, 0) Day \"Allerheiligen\" )\n             [ \"Allerheiligen\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 6, 0, 0, 0) Day \"Nikolaus\")\n             [ \"Nikolaus\"\n             , \"Nikolaustag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"heute abend\"\n             , \"am abend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"morgen abend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 14, 0, 0)) Hour)\n             [ \"morgen mittag\"\n             , \"morgen zu mittag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"gestern abend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"dieses wochenende\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 3, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"montag morgens\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 3, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"morgens am 15. februar\"\n             , \"15. februar morgens\"\n             , \"am morgen des 15. februar\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"letzte 2 sekunden\"\n             , \"letzten zwei sekunden\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"n\u00c3\u00a4chste 3 sekunden\"\n             , \"n\u00c3\u00a4chsten drei sekunden\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"letzte 2 minuten\"\n             , \"letzten zwei minuten\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"n\u00c3\u00a4chste 3 minuten\"\n             , \"n\u00c3\u00a4chsten drei minuten\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"n\u00c3\u00a4chste 3 stunden\"\n             , \"n\u00c3\u00a4chsten drei stunden\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"letzte 2 tage\"\n             , \"letzten zwei tage\"\n             , \"vergangenen zwei tage\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"n\u00c3\u00a4chsten 3 tagen\"\n             , \"n\u00c3\u00a4chsten drei tage\"\n             , \"kommenden drei tagen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 15, 0, 0, 0)) Day)\n             [ \"n\u00c3\u00a4chsten paar tagen\"\n             , \"kommenden paar tagen\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"letzten 2 wochen\"\n             , \"letzte zwei wochen\"\n             , \"vergangenen 2 wochen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"n\u00c3\u00a4chsten 3 wochen\"\n             , \"n\u00c3\u00a4chste drei wochen\"\n             , \"kommenden drei wochen\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"letzten 2 monaten\"\n             , \"letzte zwei monate\"\n             , \"vergangenen zwei monaten\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"n\u00c3\u00a4chsten 3 monaten\"\n             , \"n\u00c3\u00a4chste drei monate\"\n             , \"kommenden drei monaten\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"letzten 2 jahren\"\n             , \"letzten zwei jahre\"\n             , \"vergangenen zwei jahren\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"n\u00c3\u00a4chsten 3 jahren\"\n             , \"kommenden drei jahren\"\n             , \"n\u00c3\u00a4chste drei jahre\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13. - 15. Juli\"\n             , \"13ter bis 15ter Juli\"\n             , \"13 bis 15 Juli\"\n             , \"13 - 15 Juli\"\n             , \"Juli 13 - Juli 15\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"Aug 8 - Aug 12\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"am Donnerstag von 9:30 - 11:00\"\n             , \"am Donnerstag zwischen 9:30 und 11:00\"\n             , \"Donnerstag 9:30 - 11:00\"\n             , \"am Donnerstag nach 9:30 aber vor 11:00\"\n             , \"Donnerstag von 9:30 bis 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"Donnerstag Vormittag von 9 bis 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-13:30\"\n             ]\n  , examples (datetime (2013, 9, 21, 1, 30, 0) Minute)\n             [ \"1:30 am Sa, 21. Sept\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"binnen 2 wochen\"\n             , \"innerhalb von 2 wochen\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"bis 2 Uhr nachmittag\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"bis zum ende des tages\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 3, 1, 0, 0, 0) Month)\n             [ \"bis zum ende des monats\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"16 Uhr CET\"\n             ]\n  , examples (datetime (2013, 2, 14, 6, 0, 0) Minute)\n             [ \"donnerstag 8:00 GMT\"\n             , \"donnerstag 8:00 gmt\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"heute um 14 Uhr\"\n             , \"um 2\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Hour)\n             [ \"morgen um 15 Uhr\"\n             , \"morgen so um 15 Uhr\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"nach 14 Uhr\"\n             , \"nach 14h\"\n             , \"ab 14Uhr\"\n             , \"nach 2 Uhr\"\n             , \"fr\u00c3\u00bchestens 14 Uhr\"\n             , \"14 Uhr fr\u00c3\u00bchstens\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"bis 11 uhr\"\n             , \"vor 11 uhr\"\n             , \"bis 11h vormittags\"\n             , \"bis 11 am vormittag\"\n             , \"sp\u00c3\u00a4testens 11 uhr\"\n             , \"11Uhr sp\u00c3\u00a4testens\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"am nachmittag\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 30, 0) Minute)\n             [ \"um 13:30 am nachmittag\"\n             , \"nachmittags um 1 uhr 30\"\n             , \"13:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"in 15 minuten\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"nach dem mittagessen\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4chsten montag\"\n             , \"kommenden montag\"\n             ]\n  , examples (datetime (2013, 12, 10, 0, 0, 0) Day)\n             [ \"10.12.\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 30, 0), (2013, 2, 12, 19, 1, 0)) Minute)\n             [ \"18:30h - 19:00h\"\n             , \"18:30h/19:00h\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 14, 0, 0, 0), (2013, 10, 16, 0, 0, 0)) Day)\n             [ \"14. - 15.10.\"\n             , \"14 - 15.10.\"\n             , \"14. - 15.10\"\n             , \"14 - 15.10\"\n             , \"14.10. - 15.10.\"\n             , \"14. - 15.10.2013\"\n             , \"14.10. - 15.10.2013\"\n             , \"14./15.10.\"\n             ]\n  , examples (datetimeInterval ((2018, 10, 14, 0, 0, 0), (2018, 10, 16, 0, 0, 0)) Day)\n             [ \"14. - 15.10.18\"\n             , \"14 - 15.10.18\"\n             , \"14.10. - 15.10.2018\"\n             , \"14./15.10.2018\"\n             , \"vom 14.10. - 15.10.2018\"\n             , \"14.10. bis 15.10.2018\"\n             , \"vom 14.10. auf den 15.10.2018\"\n             , \"vom 14.10. bis zum 15.10.2018\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"am 10.10.\"\n             , \"am 10.10\"\n             , \"10.10\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 10, 0) Minute)\n             [ \"um 10.10\"\n             ]\n  , examples (datetime (2013, 2, 12, 17, 10, 0) Minute)\n             [ \"17h10\"\n             ]\n  , examples (datetime (2018, 8, 31, 0, 0, 0) Day)\n             [ \"2018-08-31\"\n             , \"2018-8-31\"\n             ]\n  , examples (datetime (1980, 5, 30, 0, 0, 0) Day)\n             [ \"30. Mai 1980\"\n             ]\n  , examples (datetime (2013, 2, 9, 0, 0, 0) Day)\n             [ \"vorvorgestern\"\n             ]\n  , examples (datetime (2013, 12, 5, 0, 0, 0) Day)\n             [ \"f\u00c3\u00bcnfter Dezember\"\n             ]\n  , examples (datetime (2013, 12, 30, 0, 0, 0) Day)\n             [ \"drei\u00c3\u0178igster Dezember\"\n             , \"dreissigster Dezember\"\n             ]\n  , examples (datetime (2013, 12, 4, 0, 0, 0) Day)\n             [ \"am vierten Dezember\"\n             , \"der vierte Dezember\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 31, 0, 0, 0) Day \"Chinesisches Neujahr\")\n             [ \"Chinesisches Neujahr\"\n             , \"Chinesisches Fr\u00c3\u00bchlingsfest\"\n             , \"Chinesisches Neujahrsfest\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 16, 0, 0, 0) Day \"Chinesisches Neujahr\")\n             [ \"Chinesisches Neujahr 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 9, 18, 0, 0, 0) Day \"Jom Kippur\")\n             [ \"Jom Kippur 2018\"\n             , \"Yom Kippur 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 9, 30, 0, 0, 0) Day \"Schmini Azeret\")\n             [ \"Schmini Azeret 2018\"\n             , \"Schemini Azeret 2018\"\n             , \"Shemini Atzeret 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 10, 1, 0, 0, 0) Day \"Simchat Torah\")\n             [ \"simchat torah 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 7, 21, 0, 0, 0) Day \"Tisha B'Av\")\n             [ \"tisha b'av 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 18, 0, 0, 0) Day \"Jom Ha'atzmaut\")\n             [ \"Jom Haatzmaut 2018\"\n             , \"Yom Haatzmaut 2018\"\n             , \"Yom Ha'atzmaut 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 5, 13, 0, 0, 0) Day \"Lag BaOmer\")\n             [ \"Lag BaOmer 2017\"\n             , \"Lag LaOmer 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 11, 0, 0, 0) Day \"Jom HaShoah\")\n             [ \"Jom HaShoah 2018\"\n             , \"Yom HaShoah 2018\"\n             , \"Holocaustgedenktag 2018\"\n             , \"Holocaust-Gedenktag 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 9, 9, 0, 0, 0), (2018, 9, 12, 0, 0, 0)) Day \"Rosch haSchana\")\n             [ \"Rosch haSchana 2018\"\n             , \"Rosch ha-Schana 2018\"\n             , \"Rosch ha-Schanah 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 12, 2, 0, 0, 0), (2018, 12, 10, 0, 0, 0)) Day \"Chanukka\")\n             [ \"Chanukka 2018\"\n             , \"Hanukkah 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 3, 30, 0, 0, 0), (2018, 4, 8, 0, 0, 0)) Day \"Pessach\")\n             [ \"Passover 2018\"\n             , \"Pessach 2018\"\n             , \"Passa 2018\"\n             , \"Passah 2018\"\n             , \"Pascha 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 9, 23, 0, 0, 0), (2018, 10, 2, 0, 0, 0)) Day \"Sukkot\")\n             [ \"Laubh\u00c3\u00bcttenfest 2018\"\n             , \"Sukkot 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 5, 19, 0, 0, 0), (2018, 5, 22, 0, 0, 0)) Day \"Schawuot\")\n             [ \"Shavuot 2018\"\n             , \"Schawuot 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 30, 0, 0, 0) Day \"Maulid an-Nab\u00c4\u00ab\")\n             [ \"Mawlid al-Nabawi 2017\"\n             , \"Maulid an-Nab\u00c4\u00ab 2017\"\n             ]\n  , examples (datetimeHoliday (1950, 7, 16, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 1950\"\n             ]\n  , examples (datetimeHoliday (1975, 10, 6, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 1975\"\n             ]\n  , examples (datetimeHoliday (1988, 5, 16, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 1988\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 15, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2018\"\n             ]\n  , examples (datetimeHoliday (2034, 12, 12, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2034\"\n             ]\n  , examples (datetimeHoliday (2046, 8, 4, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2046\"\n             ]\n  , examples (datetimeHoliday (2050, 6, 21, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2050\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 21, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 2018\"\n             , \"id ul-adha 2018\"\n             , \"Opferfest 2018\"\n             , \"Bakr Id 2018\"\n             ]\n  , examples (datetimeHoliday (1980, 10, 19, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 1980\"\n             , \"id ul-adha 1980\"\n             , \"Opferfest 1980\"\n             , \"Bakr Id 1980\"\n             ]\n  , examples (datetimeHoliday (1966, 4, 1, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 1966\"\n             , \"id ul-adha 1966\"\n             , \"Opferfest 1966\"\n             , \"Bakr Id 1966\"\n             ]\n  , examples (datetimeHoliday (1974, 1, 3, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 1974\"\n             , \"id ul-adha 1974\"\n             , \"Opferfest 1974\"\n             , \"Bakr Id 1974\"\n             ]\n  , examples (datetimeHoliday (2017, 6, 22, 0, 0, 0) Day \"Lailat al-Qadr\")\n             [ \"laylat al kadr 2017\"\n             , \"die Nacht der Bestimmung 2017\"\n             , \"Laylat al-Qadr 2017\"\n             , \"Lailat al-Qadr 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 11, 0, 0, 0) Day \"Lailat al-Qadr\")\n             [ \"laylat al-qadr 2018\"\n             , \"die Nacht der Allmacht 2018\"\n             , \"Laylat al-Qadr 2018\"\n             , \"Lailat al-Qadr 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 9, 11, 0, 0, 0) Day \"Islamisches Neujahr\")\n             [ \"Islamisches Neujahr 2018\"\n             , \"Amun Jadid 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 9, 30, 0, 0, 0) Day \"Aschura\")\n             [ \"Aschura-Tag 2017\"\n             , \"Aschura 2017\"\n             , \"Ashura 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 30, 0, 0, 0) Day \"Tu biSchevat\")\n             [ \"Tu BiShvat 2018\"\n             , \"Tu biSchevat 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 6, 23, 0, 0, 0) Day \"Jumu'atul-Wida\")\n             [ \"Jamat Ul-Vida 2017\"\n             , \"Jumu'atul-Wida 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 8, 0, 0, 0) Day \"Jumu'atul-Wida\")\n             [ \"Jamat Ul-Vida 2018\"\n             , \"Jumu'atul-Wida 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 13, 0, 0, 0) Day \"Isra and Mi'raj\")\n             [ \"isra and mi'raj 2018\"\n             , \"Aufstieg des Propheten 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 4, 3, 0, 0, 0) Day \"Isra and Mi'raj\")\n             [ \"Die Nachtreise 2019\"\n             , \"Aufstieg in den Himmel 2019\"\n             ]\n  , examples (datetimeIntervalHoliday ((1950, 6, 17, 0, 0, 0), (1950, 7, 16, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 1950\"\n             ]\n  , examples (datetimeIntervalHoliday ((1977, 8, 15, 0, 0, 0), (1977, 9, 14, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 1977\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 5, 16, 0, 0, 0), (2018, 6, 15, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2034, 11, 12, 0, 0, 0), (2034, 12, 12, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2034\"\n             ]\n  , examples (datetimeIntervalHoliday ((2046, 7, 5, 0, 0, 0), (2046, 8, 4, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2046\"\n             ]\n  , examples (datetimeIntervalHoliday ((2050, 5, 22, 0, 0, 0), (2050, 6, 21, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2050\"\n             ]\n  , examples (datetimeHoliday (2017, 10, 17, 0, 0, 0) Day \"Dhanteras\")\n             [ \"Dhanatrayodashi 2017\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 25, 0, 0, 0) Day \"Dhanteras\")\n             [ \"Dhanteras 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 26, 0, 0, 0) Day \"Naraka Chaturdashi\")\n             [ \"kali chaudas 2019\"\n             , \"choti diwali 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 27, 0, 0, 0) Day \"Diwali\")\n             [ \"diwali 2019\"\n             , \"Deepavali 2019\"\n             , \"Lakshmi Puja 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 29, 0, 0, 0) Day \"Bhai Dooj\")\n             [ \"bhai dooj 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 11, 2, 0, 0, 0) Day \"Chhath\")\n             [ \"chhath 2019\"\n             , \"dala puja 2019\"\n             , \"Surya Shashthi 2019\"\n             ]\n  , examples (datetimeHoliday (2021, 10, 14, 0, 0, 0) Day \"Maha Navami\")\n             [ \"Maha Navami 2021\"\n             ]\n  , examples (datetimeHoliday (2021, 10, 12, 0, 0, 0) Day \"Maha Saptami\")\n             [ \"Maha Saptami 2021\"\n             ]\n  , examples (datetimeHoliday (2018, 10, 18, 0, 0, 0) Day \"Vijayadashami\")\n             [ \"Dussehra 2018\"\n             , \"vijayadashami 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 10, 9, 0, 0, 0), (2018, 10, 19, 0, 0, 0)) Day \"Navaratri\")\n             [ \"navaratri 2018\"\n             , \"durga puja 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 10, 27, 0, 0, 0) Day \"Karva Chauth\")\n             [ \"karva chauth 2018\"\n             , \"karva chauth 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 26, 0, 0, 0) Day \"Raksha Bandhan\")\n             [ \"rakhi 2018\"\n             ]\n  , examples (datetimeHoliday (2020, 4, 6, 0, 0, 0) Day \"Mahavir Jayanti\")\n             [ \"mahavir jayanti 2020\"\n             , \"mahaveer janma kalyanak 2020\"\n             ]\n  , examples (datetimeHoliday (2020, 2, 21, 0, 0, 0) Day \"Maha Shivaratri\")\n             [ \"maha shivaratri 2020\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 10, 0, 0, 0) Day \"Dayananda Saraswati Jayanti\")\n             [ \"saraswati jayanti 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 14, 0, 0, 0) Day \"Thai Pongal\")\n             [ \"pongal 2018\"\n             , \"makara sankranthi 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 13, 0, 0, 0) Day \"Boghi\")\n             [ \"bogi pandigai 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 15, 0, 0, 0) Day \"Mattu Pongal\")\n             [ \"maattu pongal 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 16, 0, 0, 0) Day \"Kaanum Pongal\")\n             [ \"kaanum pongal 2018\"\n             , \"kanni pongal 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 1, 15, 0, 0, 0) Day \"Thai Pongal\")\n             [ \"makar sankranti 2019\"\n             , \"maghi 2019\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 14, 0, 0, 0) Day \"Vaisakhi\")\n             [ \"Vaisakhi 2018\"\n             , \"baisakhi 2018\"\n             , \"Vasakhi 2018\"\n             , \"vaishakhi 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 24, 0, 0, 0) Day \"Thiru Onam\")\n             [ \"onam 2018\"\n             , \"Thiru Onam 2018\"\n             , \"Thiruvonam 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 2, 10, 0, 0, 0) Day \"Vasant Panchami\")\n             [ \"vasant panchami 2019\"\n             , \"basant panchami 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 3, 20, 0, 0, 0) Day \"Holika Dahan\")\n             [ \"chhoti holi 2019\"\n             , \"holika dahan 2019\"\n             , \"kamudu pyre 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 8, 23, 0, 0, 0) Day \"Krishna Janmashtami\")\n             [ \"krishna janmashtami 2019\"\n             , \"gokulashtami 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 3, 21, 0, 0, 0) Day \"Holi\")\n             [ \"holi 2019\"\n             , \"dhulandi 2019\"\n             , \"phagwah 2019\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 17, 0, 0, 0) Day \"Parsi Neujahr\")\n             [ \"Parsi Neujahr 2018\"\n             , \"Jamshedi Navroz 2018\"\n             ]\n  , examples (datetimeHoliday (2022, 8, 16, 0, 0, 0) Day \"Parsi Neujahr\")\n             [ \"jamshedi Navroz 2022\"\n             , \"Parsi Neujahr 2022\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 4, 26, 0, 0, 0), (2013, 4, 29, 0, 0, 0)) Day \"Global Youth Service-Tag\")\n             [ \"GYSD 2013\"\n             , \"Global Youth Service-Tag\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 24, 0, 0, 0) Day \"Vesak\")\n             [ \"vesak\"\n             , \"vaisakha\"\n             , \"Buddha-Tag\"\n             , \"Buddha Purnima\"\n             , \"Wesakfest\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 3, 23, 20, 30, 0), (2013, 3, 23, 21, 31, 0)) Minute \"Earth Hour\")\n             [ \"Earth Hour\"\n             , \"Stunde der Erde\"\n             ]\n  , examples (datetimeIntervalHoliday ((2016, 3, 19, 20, 30, 0), (2016, 3, 19, 21, 31, 0)) Minute \"Earth Hour\")\n             [ \"Earth Hour 2016\"\n             , \"Stunde der Erde 2016\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 23, 0, 0, 0) Day \"Purim\")\n             [ \"purim\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 24, 0, 0, 0) Day \"Shushan Purim\")\n             [ \"Shushan Purim\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 7, 0, 0, 0) Day \"Guru Gobind Singh Jayanti\")\n             [ \"Guru Gobind Singh Geburtstag\"\n             , \"Guru Gobind Singh Jayanti 2014\"\n             , \"Guru Govind Singh Jayanti\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 27, 0, 0, 0) Day \"K\u00c3\u00b6nigstag\")\n             [ \"Koningsdag 2018\"\n             , \"k\u00c3\u00b6nigstag 2018\"\n             ]\n  , examples (datetimeHoliday (2014, 4, 26, 0, 0, 0) Day \"K\u00c3\u00b6nigstag\")\n             [ \"Koningsdag 2014\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 9, 0, 0, 0) Day \"Rabindra Jayanti\")\n             [ \"Rabindra Jayanti 2018\"\n             , \"Rabindranath Jayanti 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 5, 9, 0, 0, 0) Day \"Rabindra Jayanti\")\n             [ \"Rabindra Jayanti 2019\"\n             , \"Rabindranath Jayanti 2019\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 31, 0, 0, 0) Day \"Guru Ravidass Jayanti\")\n             [ \"Guru Ravidas Jayanti 2018\"\n             , \"Guru Ravidass Geburtstag 2018\"\n             , \"Guru Ravidass Jayanti 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 2, 19, 0, 0, 0) Day \"Guru Ravidass Jayanti\")\n             [ \"Guru Ravidass Jayanti 2019\"\n             , \"Guru Ravidas Geburtstag 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 13, 0, 0, 0) Day \"Pargat Diwas\")\n             [ \"Valmiki Jayanti 2019\"\n             , \"Pargat Diwas 2019\"\n             ]\n  , examples (datetimeHoliday (2018, 10, 24, 0, 0, 0) Day \"Pargat Diwas\")\n             [ \"Maharishi Valmiki Jayanti 2018\"\n             , \"Pargat Diwas 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 10, 0, 0, 0) Day \"Christi Himmelfahrt\")\n             [ \"Christi Himmelfahrt 2018\"\n             , \"Himmelfahrt 2018\"\n             , \"Himmelfahrtstag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 14, 0, 0, 0) Day \"Aschermittwoch\")\n             [ \"Aschermittwoch 2018\"\n             , \"Aschertag 2018\"\n             , \"Aschetag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 19, 0, 0, 0) Day \"Aschermontag\")\n             [ \"Aschermontag 2018\"\n             , \"Reiner Montag 2018\"\n             , \"Sauberer Montag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 31, 0, 0, 0) Day \"Corpus Christi\")\n             [ \"Corpus Christi 2018\"\n             , \"Fronleichnam 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 2, 0, 0, 0) Day \"Ostermontag\")\n             [ \"Ostermontag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 1, 0, 0, 0) Day \"Ostersonntag\")\n             [ \"Ostersonntag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 11, 8, 0, 0, 0) Day \"Govardhan Puja\")\n             [ \"Govardhan Puja 2018\"\n             , \"Annakut 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 3, 30, 0, 0, 0) Day \"Karfreitag\")\n             [ \"Karfreitag 2018\"\n             , \"Stiller Freitag 2018\"\n             , \"Hoher Freitag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 3, 31, 0, 0, 0) Day \"Karsamstag\")\n             [ \"Karsamstag 2018\"\n             , \"Stiller Samstag 2018\"\n             , \"Karsonnabend 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 3, 31, 0, 0, 0) Day \"Lazarus-Samstag\")\n             [ \"Lazarus-Samstag 2018\"\n             , \"Lazarus Samstag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 3, 29, 0, 0, 0) Day \"Gr\u00c3\u00bcndonnerstag\")\n             [ \"Gr\u00c3\u00bcndonnerstag 2018\"\n             , \"Hoher Donnerstag 2018\"\n             , \"Heiliger Donnerstag 2018\"\n             , \"Wei\u00c3\u0178er Donnerstag 2018\"\n             , \"Palmdonnerstag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 9, 0, 0, 0) Day \"Orthodoxer Ostermontag\")\n             [ \"Orthodoxer Ostermontag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 8, 0, 0, 0) Day \"Orthodoxer Ostersonntag\")\n             [ \"Orthodoxer Ostersonntag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 7, 0, 0, 0) Day \"Orthodoxer Karsamstag\")\n             [ \"Orthodoxer Karsamstag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 6, 0, 0, 0) Day \"Orthodoxer Karfreitag\")\n             [ \"Orthodoxer Karfreitag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 1, 0, 0, 0) Day \"Orthodoxer Palmsonntag\")\n             [ \"Orthodoxer Palmsonntag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 3, 25, 0, 0, 0) Day \"Palmsonntag\")\n             [ \"Palmsonntag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 20, 0, 0, 0) Day \"Pfingsten\")\n             [ \"Pfingsten 2018\"\n             , \"pentecost 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 13, 0, 0, 0) Day \"Fastnacht\")\n             [ \"Fastnacht 2018\"\n             , \"mardi gras 2018\"\n             , \"Fastnachtsdienstag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 27, 0, 0, 0) Day \"Dreifaltigkeitssonntag\")\n             [ \"Dreifaltigkeitssonntag 2018\"\n             , \"Dreifaltigkeitsfest 2018\"\n             , \"Trinitatis 2018\"\n             , \"Goldener Sonntag 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 21, 0, 0, 0) Day \"Pfingstmontag\")\n             [ \"Pfingstmontag 2018\"\n             , \"Pentecost Montag 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 2, 19, 0, 0, 0), (2018, 3, 31, 0, 0, 0)) Day \"Gro\u00c3\u0178e Fastenzeit\")\n             [ \"Gro\u00c3\u0178e Fastenzeit 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 2, 14, 0, 0, 0), (2018, 4, 1, 0, 0, 0)) Day \"Fastenzeit\")\n             [ \"Fastenzeit 2018\"\n             ]\n  ]\n", "num_lines": 1162}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.DE.Rules\n  ( rules\n  ) where\n\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Types (OrdinalData(..))\nimport Duckling.Regex.Types (GroupMatch(..))\nimport Duckling.Time.Computed\nimport Duckling.Time.Helpers\nimport Duckling.Time.HolidayHelpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Types\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleInstants :: [Rule]\nruleInstants = mkRuleInstants\n  [ ( \"now\"             , TG.Second,  0,\n       \"(genau)? ?jetzt|diesen moment|in diesem moment|gerade eben\" )\n  , ( \"today\"           , TG.Day   ,  0,\n       \"heute|(um diese zeit|zu dieser zeit|um diesen zeitpunkt|zu diesem zeitpunkt)\" )\n  , ( \"tomorrow\"        , TG.Day   ,  1, \"morgen\" )\n  , ( \"yesterday\"       , TG.Day   , -1, \"gestern\" )\n  , ( \"after tomorrow\"  , TG.Day   ,  2, \"(\u00c3\u00bc)bermorgen\" )\n  , ( \"before yesterday\", TG.Day   , -2, \"vorgestern\" )\n  , ( \"3 days ago\"      , TG.Day   , -3, \"vorvorgestern\" )\n  , ( \"EOM|End of month\", TG.Month ,  1, \"(das )?ende des monats?\" )\n  , ( \"EOY|End of year\" , TG.Year  ,  1,\n       \"(das )?(EOY|jahr(es)? ?ende|ende (des )?jahr(es)?)\" )\n  ]\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Montag\"    , \"montags?|mo\\\\.?\"              )\n  , ( \"Dienstag\"  , \"die?nstags?|di\\\\.?\"           )\n  , ( \"Mittwoch\"  , \"mittwochs?|mi\\\\.?\"            )\n  , ( \"Donnerstag\", \"donn?erstag|do\\\\.?\"           )\n  , ( \"Freitag\"   , \"freitags?|fr\\\\.?\"             )\n  , ( \"Samstag\"   , \"samstags?|sonnabends?|sa\\\\.?\" )\n  , ( \"Sonntag\"   , \"sonntags?|so\\\\.\"             )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"Januar\"   , \"januar|jan\\\\.?\"             )\n  , ( \"Februar\"  , \"februar|feb\\\\.?\"            )\n  , ( \"Marz\"     , \"m(\u00c3\u00a4)rz|m(\u00c3\u00a4)r\\\\.?\" )\n  , ( \"April\"    , \"april|apr\\\\.?\"              )\n  , ( \"Mai\"      , \"mai\\\\.?\"                    )\n  , ( \"Juni\"     , \"juni|jun\\\\.?\"               )\n  , ( \"Juli\"     , \"juli|jul\\\\.?\"               )\n  , ( \"August\"   , \"august|aug\\\\.?\"             )\n  , ( \"September\", \"september|sept?\\\\.?\"        )\n  , ( \"Oktober\"  , \"oktober|okt\\\\.?\"            )\n  , ( \"November\" , \"november|nov\\\\.?\"           )\n  , ( \"Dezember\" , \"dezember|dez\\\\.?\"           )\n  ]\n\nruleSeasons :: [Rule]\nruleSeasons = mkRuleSeasons\n  [ ( \"sommer\"  , \"sommer\"                , monthDay  6 21, monthDay  9 23 )\n  , ( \"herbst\"  , \"herbst\"                , monthDay  9 23, monthDay 12 21 )\n  , ( \"winter\"  , \"winter\"                , monthDay 12 21, monthDay  3 20 )\n  , ( \"fruhling\", \"fr(\u00c3\u00bc)h(ling|jahr)\", monthDay  3 20, monthDay  6 21 )\n  ]\n\nruleHolidays :: [Rule]\nruleHolidays = mkRuleHolidays\n  [ ( \"Neujahr\"                           , \"neujahr(s?tag)?\"\n    , monthDay  1  1 )\n  , ( \"Valentinstag\"                      , \"valentin'?stag\"\n    , monthDay  2 14 )\n  , ( \"Schweizer Bundesfeiertag\"\n    , \"schweiz(er)? (bundes)?feiertag|bundes feiertag\"\n    , monthDay  8  1 )\n  , ( \"Tag der Deutschen Einheit\"         , \"tag (der)? deutsc?hen? einheit\"\n    , monthDay 10  3 )\n  , ( \"Oesterreichischer Nationalfeiertag\"\n    , \"((\u00c3\u00b6)sterreichischer?)? nationalfeiertag|national feiertag\"\n    , monthDay 10 26 )\n  , ( \"Halloween\"                         , \"hall?owe?en?\"\n    , monthDay 10 31 )\n  , ( \"Allerheiligen\"                     , \"allerheiligen?|aller heiligen?\"\n    , monthDay 11  1 )\n  , ( \"Nikolaus\"                          , \"nikolaus(tag)?|nikolaus tag|nikolo\"\n    , monthDay 12  6 )\n  , ( \"Heiligabend\"                       , \"heilig(er)? abend\"\n    , monthDay 12 24 )\n  , ( \"Weihnachten\"                       , \"weih?nacht(en|stag)?\"\n    , monthDay 12 25 )\n  , ( \"Silvester\"                         , \"silvester\"\n    , monthDay 12 31 )\n  , ( \"Muttertag\"                      , \"mutt?ertag|mutt?er (tag)?\"\n    , nthDOWOfMonth 2 7 5 )\n  , ( \"Vatertag\"                      , \"vatt?er( ?tag)?\"\n    , nthDOWOfMonth 3 7 6 )\n  ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  [ ( \"Christi Himmelfahrt\", \"(christi\\\\s+)?himmelfahrt(stag)?\"\n    , cycleNthAfter False TG.Day 39 easterSunday )\n  , ( \"Aschermittwoch\", \"ascher?(tag|mittwoch)\"\n    , cycleNthAfter False TG.Day (-46) easterSunday )\n  , ( \"Aschura\", \"asc?hura(\\\\-?tag)?\"\n    , cycleNthAfter False TG.Day 9 muharram )\n  , ( \"Bhai Dooj\", \"bhai(ya)?\\\\s+d(u|oo)j|bhau\\\\-beej|bhai\\\\s+(tika|phonta)\"\n    , cycleNthAfter False TG.Day 4 dhanteras )\n  , ( \"Chhath\", \"chhathi?|chhath (parv|puja)|dala (chhath|puja)|surya shashthi\"\n    , cycleNthAfter False TG.Day 8 dhanteras )\n  , ( \"Boghi\", \"boghi|bogi\\\\s+pandigai\"\n    , cycleNthAfter False TG.Day (-1) thaiPongal )\n  , ( \"Chinesisches Neujahr\", \"chinesische(s|r)\\\\s+(neujahr(s(tag|fest))?|fr\u00c3\u00bchlingsfest)\"\n    , chineseNewYear )\n  , ( \"Aschermontag\"\n    , \"(orthodoxer?\\\\s+)?(ascher|reiner?\\\\s+|sauberer?\\\\s+)montag\"\n    , cycleNthAfter False TG.Day (-48) orthodoxEaster )\n  , ( \"Corpus Christi\", \"corpus\\\\s+christi|fronleichnam\"\n    , cycleNthAfter False TG.Day 60 easterSunday )\n  , ( \"Dhanteras\", \"dhanatrayodashi|dhanteras|dhanvantari\\\\s+trayodashi\"\n    , dhanteras )\n  , ( \"Diwali\", \"deepavali|diwali|lakshmi\\\\s+puja\"\n    , cycleNthAfter False TG.Day 2 dhanteras )\n  , ( \"Durga Ashtami\", \"(durga|maha)(\\\\s+a)?shtami\"\n    , cycleNthAfter False TG.Day 7 navaratri )\n  , ( \"Ostermontag\", \"ostermontag\"\n    , cycleNthAfter False TG.Day 1 easterSunday )\n  , ( \"Ostersonntag\", \"ostersonntag\", easterSunday )\n  , ( \"Eid al-Adha\", \"bakr[\\\\-\\\\s]e?id|e?id [au]l\\\\-adha|opferfest\"\n    , eidalAdha )\n  , ( \"Eid al-Fitr\", \"eid al\\\\-fitr\", eidalFitr )\n  , ( \"Govardhan Puja\", \"govardhan\\\\s+puja|annak(u|oo)t\"\n    , cycleNthAfter False TG.Day 3 dhanteras )\n  , ( \"Karfreitag\", \"(kar|stiller\\\\s+|hoher\\\\s+)freitag\"\n    , cycleNthAfter False TG.Day (-2) easterSunday )\n  , ( \"Guru Gobind Singh Jayanti\"\n    , \"guru\\\\s+(gobind|govind)\\\\s+singh\\\\s+(Geburtstag|jayanti)\"\n    , guruGobindSinghJayanti )\n  , ( \"Holi\", \"(rangwali )?holi|dhuleti|dhulandi|phagwah\"\n    , cycleNthAfter False TG.Day 39 vasantPanchami )\n  , ( \"Holika Dahan\", \"holika dahan|kamudu pyre|chhoti holi\"\n    , cycleNthAfter False TG.Day 38 vasantPanchami )\n  , ( \"Karsamstag\"\n    , \"(kar|stiller\\\\s+)samstag|karsonnabend\"\n    , cycleNthAfter False TG.Day (-1) easterSunday )\n  , ( \"Islamisches Neujahr\", \"(arabisches|hijri|islamisches) neujahr|amun jadid|muharram\"\n    , muharram )\n  , ( \"Isra and Mi'raj\"\n    , \"isra and mi'raj|aufstieg des propheten|(die\\\\s+)?nachtreise|aufstieg\\\\s+in\\\\s+den\\\\s+himmel\"\n    , cycleNthAfter False TG.Day 26 rajab\n    )\n  , ( \"Jumu'atul-Wida\", \"jumu'atul\\\\-widaa?'?|jamat[\\\\-\\\\s]ul[\\\\-\\\\s]vida\"\n    , predNthAfter (-1) (dayOfWeek 5) eidalFitr )\n  , ( \"Kaanum Pongal\", \"(kaanum|kanni)\\\\s+pongal\"\n    , cycleNthAfter False TG.Day 2 thaiPongal )\n  , ( \"Lag BaOmer\", \"lag (b|l)[a']omer\", lagBaOmer )\n  , ( \"Vaisakhi\", \"mesadi|[bv]aisakhi|vaisakhadi|vasakhi|vaishakhi\", vaisakhi)\n  , ( \"Lailat al-Qadr\"\n    , \"la[iy]lat al[\\\\-\\\\s][qk]adr|(die)? nacht der (bestimmung|allmacht)\"\n    , cycleNthAfter False TG.Day 26 ramadan )\n  , ( \"Lazarus-Samstag\", \"lazarus(\\\\-|\\\\s+)samstag\"\n    , cycleNthAfter False TG.Day (-8) orthodoxEaster )\n  , ( \"Maha Navami\", \"maha\\\\s+navami\", cycleNthAfter False TG.Day 8 navaratri )\n  , ( \"Maha Saptami\", \"maha\\\\s+saptami\", cycleNthAfter False TG.Day 6 navaratri )\n  , ( \"Mattu Pongal\", \"maa?ttu\\\\s+pongal\"\n    , cycleNthAfter False TG.Day 1 thaiPongal )\n  , ( \"Gr\u00c3\u00bcndonnerstag\"\n    , \"(gr\u00c3\u00bcn|hoher\\\\s+|heiliger\\\\s+|wei\u00c3\u0178er\\\\s+|palm)donnerstag\"\n    , cycleNthAfter False TG.Day (-3) easterSunday )\n  , ( \"Maulid an-Nab\u00c4\u00ab\"\n    , \"Maulid\\\\s+an\\\\-Nab\u00c4\u00ab|mawlid(\\\\s+al\\\\-nab(awi|i\\\\s+al\\\\-sharif))?|mevli[dt]|mulud|geburtstag des propheten( muhammad)?\"\n    , mawlid )\n  , ( \"Naraka Chaturdashi\"\n    , \"naraka? (nivaran )?chaturdashi|(kali|roop) chaudas|choti diwali\"\n    , cycleNthAfter False TG.Day 1 dhanteras )\n  , ( \"Orthodoxer Ostermontag\", \"orthodoxer\\\\s+ostermontag\"\n    , cycleNthAfter False TG.Day 1 orthodoxEaster )\n  , ( \"Orthodoxer Ostersonntag\", \"orthodoxer\\\\s+ostersonntag\"\n    , orthodoxEaster )\n  , ( \"Orthodoxer Karsamstag\", \"orthodoxer\\\\s+karsamstag\"\n    , cycleNthAfter False TG.Day (-1) orthodoxEaster )\n  , ( \"Orthodoxer Karfreitag\", \"orthodoxer\\\\s+karfreitag\"\n    , cycleNthAfter False TG.Day (-2) orthodoxEaster )\n  , ( \"Orthodoxer Palmsonntag\", \"orthodoxer\\\\s+palmsonntag\"\n    , cycleNthAfter False TG.Day (-7) orthodoxEaster )\n  , ( \"Palmsonntag\", \"palmsonntag\"\n    , cycleNthAfter False TG.Day (-7) easterSunday )\n  , ( \"Pfingsten\", \"pfingsten|pentecost\"\n    , cycleNthAfter False TG.Day 49 easterSunday )\n  , ( \"Purim\", \"purim\", purim )\n  , ( \"Raksha Bandhan\", \"raksha(\\\\s+)?bandhan|rakhi\", rakshaBandhan )\n  , ( \"Pargat Diwas\", \"pargat diwas|(maharishi )?valmiki jayanti\", pargatDiwas )\n  , ( \"Mahavir Jayanti\", \"(mahavir|mahaveer) (jayanti|janma kalyanak)\"\n    , mahavirJayanti )\n  , ( \"Maha Shivaratri\", \"maha(\\\\s+)?shivaratri\", mahaShivaRatri)\n  , ( \"Dayananda Saraswati Jayanti\",\"((maharishi|swami) )?(dayananda )?saraswati jayanti\", saraswatiJayanti )\n  , ( \"Karva Chauth\", \"karva\\\\s+chauth|karaka\\\\s+chaturthi\", karvaChauth)\n  , ( \"Krishna Janmashtami\", \"(krishna )?janmashtami|gokulashtami\", krishnaJanmashtami )\n  , ( \"Schmini Azeret\", \"sc?he?mini\\\\s+at?zeret\"\n    , cycleNthAfter False TG.Day 21 roshHashana )\n  , ( \"Fastnacht\", \"fastnacht(sdienstag)?|mardi gras\"\n    , cycleNthAfter False TG.Day (-47) easterSunday )\n  , ( \"Shushan Purim\", \"shushan\\\\s+purim\", cycleNthAfter False TG.Day 1 purim )\n  , ( \"Simchat Torah\", \"simc?hat\\\\s+torah\"\n    , cycleNthAfter False TG.Day 22 roshHashana )\n  , ( \"Thai Pongal\"\n    , \"(thai )?pongal|pongal pandigai|(makara? |magha )?sankranth?i|maghi\"\n    , thaiPongal )\n  , ( \"Thiru Onam\", \"(thiru(v|\\\\s+))?onam\", thiruOnam )\n  , ( \"Tisha B'Av\", \"tisha b'av\", tishaBAv )\n  , ( \"Dreifaltigkeitssonntag\",\n      \"trinitatis(fest)?|(dreifaltigkeits|goldener\\\\s+)sonntag|drei(faltigkeit|einigkeit)(sfest)?\"\n    , cycleNthAfter False TG.Day 56 easterSunday )\n  , ( \"Vasant Panchami\", \"[bv]asant\\\\s+panchami\", vasantPanchami )\n  , ( \"Vijayadashami\", \"dasara|duss(eh|he)ra|vijayadashami\"\n    , cycleNthAfter False TG.Day 9 navaratri )\n  , ( \"Tu biSchevat\", \"tu b[i']sc?he?vat\", tuBishvat )\n  , ( \"Vesak\", \"v(e|ai)sak(ha)?|buddha(\\\\-?tag|\\\\s+purnima)|wesakfest\", vesak )\n  , ( \"Jom Ha'atzmaut\", \"[yj]om ha'?atzmaut\", yomHaatzmaut )\n  , ( \"Jom HaShoah\"\n    , \"[yj]om hashoah|[yj]om hazikaron lashoah ve-lag'vurah|holocaust\\\\-?gedenktag\"\n    , cycleNthAfter False TG.Day 12 passover )\n  , ( \"Jom Kippur\", \"[yj]om\\\\s+kippur\", cycleNthAfter False TG.Day 9 roshHashana )\n  , ( \"Pfingstmontag\", \"pfingstmontag|(pentecost|whit)\\\\s+montag\"\n    , cycleNthAfter False TG.Day 50 easterSunday )\n  , ( \"Rabindra Jayanti\", \"rabindra(nath)?\\\\s+jayanti\", rabindraJayanti )\n  , (\"Guru Ravidass Jayanti\", \"guru\\\\s+ravidass?\\\\s+(geburtstag|jayanti)\"\n    , ravidassJayanti )\n  ]\n\nruleComputedHolidays' :: [Rule]\nruleComputedHolidays' = mkRuleHolidays'\n  [ ( \"Global Youth Service-Tag\", \"global youth service[\\\\-\\\\s]?tag|gysd\"\n    , let start = globalYouthServiceDay\n          end = cycleNthAfter False TG.Day 2 globalYouthServiceDay\n        in interval TTime.Open start end )\n  , ( \"Gro\u00c3\u0178e Fastenzeit\", \"gro\u00c3\u0178e\\\\s+fastenzeit\"\n    , let start = cycleNthAfter False TG.Day (-48) orthodoxEaster\n          end = cycleNthAfter False TG.Day (-9) orthodoxEaster\n        in interval TTime.Open start end )\n  , ( \"Chanukka\", \"c?hann?ukk?ah?\"\n    , let start = chanukah\n          end = cycleNthAfter False TG.Day 7 chanukah\n        in interval TTime.Open start end )\n  , ( \"Fastenzeit\", \"fastenzeit\"\n    , let start = cycleNthAfter False TG.Day (-46) easterSunday\n          end = cycleNthAfter False TG.Day (-1) easterSunday\n        in interval TTime.Open start end )\n  , ( \"Navaratri\", \"durga\\\\s+puja|durgotsava|nava?rath?ri\"\n    , let start = navaratri\n          end = cycleNthAfter False TG.Day 9 navaratri\n        in interval TTime.Open start end )\n  , ( \"Pessach\", \"passover|pess?a[ck]?h|pascha|Passah?\"\n    , let start = passover\n          end = cycleNthAfter False TG.Day 8 passover\n        in interval TTime.Open start end )\n  , ( \"Ramadan\", \"rama[dt]h?an|ramzaa?n\"\n    , let start = ramadan\n          end = cycleNthAfter False TG.Day (-1) eidalFitr\n        in interval TTime.Open start end )\n  , ( \"Rosch haSchana\", \"rosch ha\\\\-?schanah?\"\n    , let start = roshHashana\n          end = cycleNthAfter False TG.Day 2 roshHashana\n        in interval TTime.Open start end )\n  , ( \"Schawuot\", \"sc?ha[vw]u'?oth?|shovuos\"\n    , let start = cycleNthAfter False TG.Day 50 passover\n          end = cycleNthAfter False TG.Day 52 passover\n        in interval TTime.Open start end )\n  , ( \"Sukkot\", \"Laubh\u00c3\u00bcttenfest|su[ck]{2}o[st]\"\n    , let start = cycleNthAfter False TG.Day 14 roshHashana\n          end = cycleNthAfter False TG.Day 22 roshHashana\n        in interval TTime.Open start end )\n  -- Does not account for leap years, so every 365 days.\n  , ( \"Parsi Neujahr\", \"parsi neujahr|jamshedi navroz\"\n    , predEveryNDaysFrom 365 (2020, 8, 16)\n    )\n  , ( \"Earth Hour\", \"earth hour|stunde der erde\"\n    , computeEarthHour )\n  , ( \"K\u00c3\u00b6nigstag\", \"k\u00c3\u00b6nigstag|koningsdag\"\n    , computeKingsDay )\n  ]\n\nruleRelativeMinutesTotillbeforeIntegerHourofday :: Rule\nruleRelativeMinutesTotillbeforeIntegerHourofday = Rule\n  { name = \"relative minutes to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"vor\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleQuarterTotillbeforeIntegerHourofday :: Rule\nruleQuarterTotillbeforeIntegerHourofday = Rule\n  { name = \"quarter to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [regex \"vie?rtel vor\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleHalfTotillbeforeIntegerHourofday :: Rule\nruleHalfTotillbeforeIntegerHourofday = Rule\n  { name = \"half to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halbe? vor\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleOfTime :: Rule\nruleTheOrdinalCycleOfTime = Rule\n  { name = \"the <ordinal> <cycle> of <time>\"\n  , pattern =\n    [ regex \"der|die|das\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"im|in|von\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime2 :: Rule\nruleNthTimeOfTime2 = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ regex \"der|die|das\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"im\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"letzten?|letztes\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|bis( zum)?|auf( den)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDateDateInterval :: Rule\nruleDateDateInterval = Rule\n  { name = \"dd.(mm.)? - dd.mm.(yy[yy]?)? (interval)\"\n  , pattern =\n    [ regex \"(?:vo[nm]\\\\s+)?(10|20|30|31|[012]?[1-9])\\\\.?((?<=\\\\.)(?:10|11|12|0?[1-9])(?:\\\\.?))?\"\n    , regex \"\\\\-|/|bis( zum)?|auf( den)?\"\n    , regex \"(10|20|30|31|[012]?[1-9])\\\\.(10|11|12|0?[1-9])\\\\.?((?<=\\\\.)\\\\d{2,4})?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (d1:\"\":_)):\n       _:\n       Token RegexMatch (GroupMatch (d2:m2:\"\":_)):\n       _) -> do\n          d1 <- parseInt d1\n          d2 <- parseInt d2\n          m2 <- parseInt m2\n          Token Time <$> interval TTime.Closed (monthDay m2 d1) (monthDay m2 d2)\n      (Token RegexMatch (GroupMatch (d1:\"\":_)):\n       _:\n       Token RegexMatch (GroupMatch (d2:m2:y:_)):\n       _) -> do\n          d1 <- parseInt d1\n          d2 <- parseInt d2\n          m2 <- parseInt m2\n          y <- parseInt y\n          Token Time <$> interval TTime.Closed (yearMonthDay y m2 d1) (yearMonthDay y m2 d2)\n      (Token RegexMatch (GroupMatch (d1:m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (d2:m2:\"\":_)):\n       _) -> do\n          d1 <- parseInt d1\n          d2 <- parseInt d2\n          m1 <- parseInt m1\n          m2 <- parseInt m2\n          Token Time <$> interval TTime.Closed (monthDay m1 d1) (monthDay m2 d2)\n      (Token RegexMatch (GroupMatch (d1:m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (d2:m2:y:_)):\n       _) -> do\n          d1 <- parseInt d1\n          d2 <- parseInt d2\n          m1 <- parseInt m1\n          m2 <- parseInt m2\n          y <- parseInt y\n          Token Time <$> interval TTime.Closed (yearMonthDay y m1 d1) (yearMonthDay y m2 d2)\n      _ -> Nothing\n  }\n\nruleEvening :: Rule\nruleEvening = Rule\n  { name = \"evening\"\n  , pattern =\n    [ regex \"abends?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTheDayofmonthNonOrdinal :: Rule\nruleTheDayofmonthNonOrdinal = Rule\n  { name = \"the <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"der\"\n    , Predicate $ isIntegerBetween 1 31\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in <duration>\"\n  , pattern =\n    [ regex \"in\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"letzte(r|n|s)?\"\n    , dimension TimeGrain\n    , regex \"um|im\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleFromDatetimeDatetimeInterval :: Rule\nruleFromDatetimeDatetimeInterval = Rule\n  { name = \"from <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"vo[nm]\"\n    , dimension Time\n    , regex \"\\\\-|bis( zum)?|auf( den)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleRelativeMinutesAfterpastIntegerHourofday :: Rule\nruleRelativeMinutesAfterpastIntegerHourofday = Rule\n  { name = \"relative minutes after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"nach\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       _:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleQuarterAfterpastIntegerHourofday :: Rule\nruleQuarterAfterpastIntegerHourofday = Rule\n  { name = \"quarter after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"vie?rtel nach\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleHalfAfterpastIntegerHourofday :: Rule\nruleHalfAfterpastIntegerHourofday = Rule\n  { name = \"half after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halbe? nach\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleMonthDdddInterval :: Rule\nruleMonthDdddInterval = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ regex \"([012]?\\\\d|30|31)(ter|\\\\.)?\"\n    , regex \"\\\\-|bis( zum)?|auf( den)?\"\n    , regex \"([012]?\\\\d|30|31)(ter|\\\\.)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (m2:_)):\n       Token Time td:\n       _) -> do\n        v1 <- parseInt m1\n        v2 <- parseInt m2\n        from <- intersect (dayOfMonth v1) td\n        to <- intersect (dayOfMonth v2) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleTheCycleAfterTime :: Rule\nruleTheCycleAfterTime = Rule\n  { name = \"the <cycle> after <time>\"\n  , pattern =\n    [ regex \"der\"\n    , dimension TimeGrain\n    , regex \"nach\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleTheCycleBeforeTime :: Rule\nruleTheCycleBeforeTime = Rule\n  { name = \"the <cycle> before <time>\"\n  , pattern =\n    [ regex \"der\"\n    , dimension TimeGrain\n    , regex \"vor\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleTimeAfterNext :: Rule\nruleTimeAfterNext = Rule\n  { name = \"<time> after next\"\n  , pattern =\n    [ dimension Time\n    , regex \"nach dem n(\u00c3\u00a4)chsten\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleTheIdesOfNamedmonth :: Rule\nruleTheIdesOfNamedmonth = Rule\n  { name = \"the ides of <named-month>\"\n  , pattern =\n    [ regex \"die iden (des?)\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td@TimeData {TTime.form = Just (TTime.Month m)}:_) ->\n        Token Time <$>\n          intersect (dayOfMonth $ if elem m [3, 5, 7, 10] then 15 else 13) td\n      _ -> Nothing\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"mittags?|zw(\u00c3\u00b6)lf (uhr)?\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"diese(n|r)|kommenden|n(\u00c3\u00a4)chsten\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleBetweenTimeofdayAndTimeofdayInterval :: Rule\nruleBetweenTimeofdayAndTimeofdayInterval = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"zwischen\"\n    , Predicate isATimeOfDay\n    , regex \"und\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNextCycle :: Rule\nruleNextCycle = Rule\n  { name = \"next <cycle>\"\n  , pattern =\n    [ regex \"n(\u00c3\u00a4)chste(r|n|s)?|kommende(r|n|s)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleAfterNextCycle :: Rule\nruleAfterNextCycle = Rule\n  { name = \"after next <cycle>\"\n  , pattern =\n    [ regex \"(\u00c3\u00bc)ber ?n(\u00c3\u00a4)chste[ns]?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 2\n      _ -> Nothing\n  }\n\nruleTimeofdayApproximately :: Rule\nruleTimeofdayApproximately = Rule\n  { name = \"<time-of-day> approximately\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"ca\\\\.?|circa|zirka|ungef(\u00c3\u00a4)hr|(in )?etwa\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleOnDate :: Rule\nruleOnDate = Rule\n  { name = \"on <date>\"\n  , pattern =\n    [ regex \"am\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleDurationFromNow :: Rule\nruleDurationFromNow = Rule\n  { name = \"<duration> from now\"\n  , pattern =\n    [ dimension Duration\n    , regex \"ab (heute|jetzt)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLunch :: Rule\nruleLunch = Rule\n  { name = \"lunch\"\n  , pattern =\n    [ regex \"(am |zu )?mittags?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 14\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleLastCycle :: Rule\nruleLastCycle = Rule\n  { name = \"last <cycle>\"\n  , pattern =\n    [ regex \"letzte(r|n|s)?|vergangene(r|n|s)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"nach ?mittags?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 19\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTimeBeforeLast :: Rule\nruleTimeBeforeLast = Rule\n  { name = \"<time> before last\"\n  , pattern =\n    [ regex \"vorletzten?|vor ?letztes?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-2) False td\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthOrdinal :: Rule\nruleNamedmonthDayofmonthOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleInduringThePartofday :: Rule\nruleInduringThePartofday = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"(in|an|am|w(\u00c3\u00a4)h?rend)( der| dem| des)?\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdayQuarter :: Rule\nruleHourofdayQuarter = Rule\n  { name = \"<hour-of-day> <quarter> (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"vie?rtel\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:_) ->\n        tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayHalf :: Rule\nruleHourofdayHalf = Rule\n  { name = \"<hour-of-day> <half> (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"halbe?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:_) ->\n        tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonth :: Rule\nruleDayofmonthordinalNamedmonth = Rule\n  { name = \"<day-of-month>(ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by ','\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",( den|r)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"nach\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleMmdd :: Rule\nruleMmdd = Rule\n  { name = \"mm/dd\"\n  , pattern =\n    [ regex \"(?:am\\\\s+)?([012]?[1-9]|10|20|30|31)\\\\.(10|11|12|0?[1-9])\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        d <- parseInt m1\n        m <- parseInt m2\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleAfterDuration :: Rule\nruleAfterDuration = Rule\n  { name = \"after <duration>\"\n  , pattern =\n    [ regex \"nach\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ hour (n < 12) n\n      _ -> Nothing\n  }\n\nruleFromTimeofdayTimeofdayInterval :: Rule\nruleFromTimeofdayTimeofdayInterval = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(von|nach|ab|fr(\u00c3\u00bc)hestens (um)?)\"\n    , Predicate isATimeOfDay\n    , regex \"((noch|aber|jedoch)? vor)|\\\\-|bis\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleExactlyTimeofday :: Rule\nruleExactlyTimeofday = Rule\n  { name = \"exactly <time-of-day>\"\n  , pattern =\n    [ regex \"genau|exakt|p(\u00c3\u00bc)nktlich|punkt( um)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleBetweenDatetimeAndDatetimeInterval :: Rule\nruleBetweenDatetimeAndDatetimeInterval = Rule\n  { name = \"between <datetime> and <datetime> (interval)\"\n  , pattern =\n    [ regex \"zwischen\"\n    , dimension Time\n    , regex \"und\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAgo :: Rule\nruleDurationAgo = Rule\n  { name = \"<duration> ago\"\n  , pattern =\n    [ regex \"vor\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleByTheEndOfTime :: Rule\nruleByTheEndOfTime = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"bis (zum)? ende (von)?|(noch)? vor\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed td now\n      _ -> Nothing\n  }\n\nruleAfterWork :: Rule\nruleAfterWork = Rule\n  { name = \"after work\"\n  , pattern =\n    [ regex \"nach (der)? arbeit|(am)? feier ?abend\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 17) (hour False 21)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleLastNCycle :: Rule\nruleLastNCycle = Rule\n  { name = \"last n <cycle>\"\n  , pattern =\n    [ regex \"letzten?|vergangenen?\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt $ cycleN True grain (- n)\n      _ -> Nothing\n  }\n\nruleTimeofdaySharp :: Rule\nruleTimeofdaySharp = Rule\n  { name = \"<time-of-day> sharp\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"genau|exakt|p(\u00c3\u00bc)nktlich|punkt( um)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleWithinDuration :: Rule\nruleWithinDuration = Rule\n  { name = \"within <duration>\"\n  , pattern =\n    [ regex \"binnen|innerhalb( von)?\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> Token Time <$>\n        interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleMidnighteodendOfDay :: Rule\nruleMidnighteodendOfDay = Rule\n  { name = \"midnight|EOD|end of day\"\n  , pattern =\n    [ regex \"mitternacht|EOD|tagesende|ende (des)? tag(es)?\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleDayofmonthNonOrdinalNamedmonth :: Rule\nruleDayofmonthNonOrdinalNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\n\nruleDayOfWeekIntersectDuration :: Rule\nruleDayOfWeekIntersectDuration = Rule\n  { name = \"<day-of-week> in <duration>\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \"(in|vor)\"\n    , dimension Duration\n    ]\n  , prod = \\case\n      (Token Time td:Token RegexMatch (GroupMatch (match:_)):Token Duration dd:_) ->\n        case Text.toLower match of\n          \"vor\" -> Token Time <$> intersect td (durationIntervalAgo dd)\n          _     -> Token Time <$> intersect td (inDurationInterval dd)\n      _ -> Nothing\n  }\nruleAboutTimeofday :: Rule\nruleAboutTimeofday = Rule\n  { name = \"about <time-of-day>\"\n  , pattern =\n    [ regex \"so( um)?|(so |um |so um )?circa|zirka|ca\\\\.?|ungef(\u00c3\u00a4)hr|(etwa|gegen)( so| um| so um)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleUntilTimeofday :: Rule\nruleUntilTimeofday = Rule\n  { name = \"until <time-of-day>\"\n  , pattern =\n    [ regex \"vor|bis( zu[rm]?)?|sp(\u00c3\u00a4)testens?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleUntilTimeofdayPostfix :: Rule\nruleUntilTimeofdayPostfix = Rule\n  { name = \"<time-of-day> until\"\n  , pattern =\n    [ dimension Time\n    , regex \"sp(\u00c3\u00a4)testens\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:_) -> tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleAtTimeofday :: Rule\nruleAtTimeofday = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"um|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"im\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimePartofday :: Rule\nruleTimePartofday = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"wochen ?ende?\"\n    ]\n  , prod = \\_ -> tt $ mkOkForThisNext weekend\n  }\n\nruleNthTimeAfterTime2 :: Rule\nruleNthTimeAfterTime2 = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ regex \"der|das\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"nach\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"(n(\u00c3\u00a4)chste|kommende)[ns]?\"\n    , Predicate $ and . sequence [isNotLatent, isOkWithThisNext]\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarterYear :: Rule\nruleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:_:Token Time td:_) ->\n        tt $ cycleNthAfter False TG.Quarter (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(1[0-2]|0?[1-9])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m1\n        m <- parseInt m2\n        d <- parseInt m3\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleAfterTime :: Rule\nruleTheOrdinalCycleAfterTime = Rule\n  { name = \"the <ordinal> <cycle> after <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"nach\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleIntersectByOfFromS :: Rule\nruleIntersectByOfFromS = Rule\n  { name = \"intersect by 'of', 'from', 's\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"von|der|im\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNextNCycle :: Rule\nruleNextNCycle = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"n(\u00c3\u00a4)chsten?|kommenden?\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleADuration :: Rule\nruleADuration = Rule\n  { name = \"a <duration>\"\n  , pattern =\n    [ regex \"(in )?eine?(r|n)?\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"morgens|(in der )?fr(\u00c3\u00bc)h|vor ?mittags?|am morgen\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 3\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"diesen?|dieses|heute\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisCycle :: Rule\nruleThisCycle = Rule\n  { name = \"this <cycle>\"\n  , pattern =\n    [ regex \"diese(r|n|s)?|kommende(r|n|s)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"diese(n|r|s)?|(im )?laufenden\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleDurationHence :: Rule\nruleDurationHence = Rule\n  { name = \"<duration> hence\"\n  , pattern =\n    [ dimension Duration\n    , regex \"hence\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalOfNamedmonth :: Rule\nruleDayofmonthNonOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"vom|von\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAfterLunch :: Rule\nruleAfterLunch = Rule\n  { name = \"after lunch\"\n  , pattern =\n    [ regex \"nach dem mittagessen|nachmittags?\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 13) (hour False 17)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleOnANamedday :: Rule\nruleOnANamedday = Rule\n  { name = \"on a named-day\"\n  , pattern =\n    [ regex \"an einem\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 25 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        y <- getIntValue token\n        tt . mkLatent $ year y\n      _ -> Nothing\n  }\n\nruleAfterTimeofday :: Rule\nruleAfterTimeofday = Rule\n  { name = \"after <time-of-day>\"\n  , pattern =\n    [ regex \"nach|ab|fr(\u00c3\u00bc)he?stens\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleAfterTimeofdayPostfix :: Rule\nruleAfterTimeofdayPostfix = Rule\n  { name = \"<time-of-day> after\"\n  , pattern =\n    [ dimension Time\n    , regex \"fr(\u00c3\u00bc)he?stens\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:_) -> tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleNight :: Rule\nruleNight = Rule\n  { name = \"night\"\n  , pattern =\n    [ regex \"nachts?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 0\n          to = hour False 4\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDayofmonthOrdinal :: Rule\nruleDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleHalfIntegerGermanStyleHourofday :: Rule\nruleHalfIntegerGermanStyleHourofday = Rule\n  { name = \"half <integer> (german style hour-of-day)\"\n  , pattern =\n    [ regex \"halb\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleAfterTime :: Rule\nruleOrdinalCycleAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"nach\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleOfTime :: Rule\nruleOrdinalCycleOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"im|in|von\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleAfterNextTime :: Rule\nruleAfterNextTime = Rule\n  { name = \"after next <time>\"\n  , pattern =\n    [ regex \"(\u00c3\u00bc)ber ?n(\u00c3\u00a4)chste[ns]?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleHhmm :: Rule\nruleHhmm = Rule\n  { name = \"hh:mm\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.h]([0-5]\\\\d)(?:uhr|h)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleTonight :: Rule\nruleTonight = Rule\n  { name = \"tonight\"\n  , pattern =\n    [ regex \"heute? (am)? abends?\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 18) (hour False 0)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        y <- getIntValue token\n        tt $ year y\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthNonOrdinal :: Rule\nruleNamedmonthDayofmonthNonOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleHhmmMilitary :: Rule\nruleHhmmMilitary = Rule\n  { name = \"hhmm (military)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInt h\n        mm <- parseInt m\n        tt . mkLatent $ hourMinute False hh mm\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"letzte(r|n|s)?\"\n    , Predicate isADayOfWeek\n    , regex \"[ui]m\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleHhmmMilitaryAmpm :: Rule\nruleHhmmMilitaryAmpm = Rule\n  { name = \"hhmm (military) am|pm\"\n  , pattern =\n    [ regex \"((?:1[012]|0?\\\\d))([0-5]\\\\d)\"\n    , regex \"([ap])\\\\.?m\\\\.?(?:[\\\\s'\\\"-_{}\\\\[\\\\]()]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):Token RegexMatch (GroupMatch (ap:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt . timeOfDayAMPM (Text.toLower ap == \"a\") $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval :: Rule\nruleTimeofdayTimeofdayInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\-|bis\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval2 :: Rule\nruleTimeofdayTimeofdayInterval2 = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"\\\\-|/|bis\"\n    , Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAfterTime :: Rule\nruleDurationAfterTime = Rule\n  { name = \"<duration> after <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"nach\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarter :: Rule\nruleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) -> tt .\n        cycleNthAfter False TG.Quarter (v - 1) $ cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleTheDayofmonthOrdinal :: Rule\nruleTheDayofmonthOrdinal = Rule\n  { name = \"the <day-of-month> (ordinal)\"\n  , pattern =\n    [ regex \"der\"\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleDurationBeforeTime :: Rule\nruleDurationBeforeTime = Rule\n  { name = \"<duration> before <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"vor\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nrulePartofdayOfTime :: Rule\nrulePartofdayOfTime = Rule\n  { name = \"<part-of-day> of <time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"des|von|vom|am\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleMmddyyyy :: Rule\nruleMmddyyyy = Rule\n  { name = \"mm/dd/yyyy\"\n  , pattern =\n    [ regex \"([012]?[1-9]|10|20|30|31)\\\\.(0?[1-9]|10|11|12)\\\\.(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTimeofdayOclock :: Rule\nruleTimeofdayOclock = Rule\n  { name = \"<time-of-day>  o'clock\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"uhr|h(?:[\\\\s'\\\"-_{}\\\\[\\\\]()]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonthYear :: Rule\nruleDayofmonthordinalNamedmonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       Token Time td:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n        n <- parseInt match\n        dom <- intersectDOM td token\n        Token Time <$> intersect dom (year n)\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleADuration\n  , ruleAboutTimeofday\n  , ruleAbsorptionOfAfterNamedDay\n  , ruleAfterDuration\n  , ruleAfterLunch\n  , ruleAfterNextTime\n  , ruleAfterTimeofday\n  , ruleAfterTimeofdayPostfix\n  , ruleAfterWork\n  , ruleAfternoon\n  , ruleAtTimeofday\n  , ruleBetweenDatetimeAndDatetimeInterval\n  , ruleBetweenTimeofdayAndTimeofdayInterval\n  , ruleByTheEndOfTime\n  , ruleDatetimeDatetimeInterval\n  , ruleDateDateInterval\n  , ruleDayofmonthNonOrdinalNamedmonth\n  , ruleDayofmonthNonOrdinalOfNamedmonth\n  , ruleDayofmonthOrdinal\n  , ruleDayofmonthordinalNamedmonth\n  , ruleDayofmonthordinalNamedmonthYear\n  , ruleDurationAfterTime\n  , ruleDurationAgo\n  , ruleDurationBeforeTime\n  , ruleDurationFromNow\n  , ruleDurationHence\n  , ruleEvening\n  , ruleExactlyTimeofday\n  , ruleFromDatetimeDatetimeInterval\n  , ruleFromTimeofdayTimeofdayInterval\n  , ruleHalfIntegerGermanStyleHourofday\n  , ruleHhmm\n  , ruleHhmmMilitary\n  , ruleHhmmMilitaryAmpm\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleInDuration\n  , ruleInduringThePartofday\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleIntersectByOfFromS\n  , ruleDayOfWeekIntersectDuration\n  , ruleLastCycle\n  , ruleLastCycleOfTime\n  , ruleLastDayofweekOfTime\n  , ruleLastNCycle\n  , ruleLastTime\n  , ruleLunch\n  , ruleMidnighteodendOfDay\n  , ruleMmdd\n  , ruleMmddyyyy\n  , ruleMonthDdddInterval\n  , ruleMorning\n  , ruleNamedmonthDayofmonthNonOrdinal\n  , ruleNamedmonthDayofmonthOrdinal\n  , ruleNextCycle\n  , ruleAfterNextCycle\n  , ruleNextNCycle\n  , ruleNextTime\n  , ruleNight\n  , ruleNoon\n  , ruleNthTimeAfterTime\n  , ruleNthTimeAfterTime2\n  , ruleNthTimeOfTime\n  , ruleNthTimeOfTime2\n  , ruleOnANamedday\n  , ruleOnDate\n  , ruleOrdinalCycleAfterTime\n  , ruleOrdinalCycleOfTime\n  , ruleOrdinalQuarter\n  , ruleOrdinalQuarterYear\n  , rulePartofdayOfTime\n  , ruleRelativeMinutesAfterpastIntegerHourofday\n  , ruleRelativeMinutesTotillbeforeIntegerHourofday\n  , ruleTheCycleAfterTime\n  , ruleTheCycleBeforeTime\n  , ruleTheDayofmonthNonOrdinal\n  , ruleTheDayofmonthOrdinal\n  , ruleTheIdesOfNamedmonth\n  , ruleTheOrdinalCycleAfterTime\n  , ruleTheOrdinalCycleOfTime\n  , ruleThisCycle\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleThisnextDayofweek\n  , ruleTimeAfterNext\n  , ruleTimeBeforeLast\n  , ruleTimePartofday\n  , ruleTimeofdayApproximately\n  , ruleTimeofdayLatent\n  , ruleTimeofdayOclock\n  , ruleTimeofdaySharp\n  , ruleTimeofdayTimeofdayInterval\n  , ruleTimeofdayTimeofdayInterval2\n  , ruleTonight\n  , ruleUntilTimeofday\n  , ruleUntilTimeofdayPostfix\n  , ruleWeekend\n  , ruleWithinDuration\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYyyymmdd\n  , ruleQuarterTotillbeforeIntegerHourofday\n  , ruleHalfTotillbeforeIntegerHourofday\n  , ruleQuarterAfterpastIntegerHourofday\n  , ruleHalfAfterpastIntegerHourofday\n  , ruleHourofdayQuarter\n  , ruleHourofdayHalf\n  , ruleTimezone\n  ]\n  ++ ruleInstants\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n  ++ ruleSeasons\n  ++ ruleHolidays\n  ++ ruleComputedHolidays\n  ++ ruleComputedHolidays'\n", "num_lines": 1938}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.Corpus\n  ( corpus\n  , defaultCorpus\n  , negativeCorpus\n  , latentCorpus\n  , diffCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Core\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month, refTime)\nimport Duckling.TimeGrain.Types hiding (add)\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\ndefaultCorpus :: Corpus\ndefaultCorpus = (testContext, testOptions, allExamples ++ custom)\n  where\n    custom = concat\n      [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n                 [ \"2/15\"\n                 , \"on 2/15\"\n                 , \"2 / 15\"\n                 , \"2-15\"\n                 , \"2 - 15\"\n                 ]\n      , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n                 [ \"10/31/1974\"\n                 , \"10/31/74\"\n                 , \"10-31-74\"\n                 , \"10.31.1974\"\n                 , \"31/Oct/1974\"\n                 , \"31-Oct-74\"\n                 , \"31st Oct 1974\"\n                 ]\n      , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n                 [ \"4/25 at 4:00pm\"\n                 , \"4/25 at 16h00\"\n                 , \"4/25 at 16h\"\n                 ]\n      , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n                 [ \"thanksgiving day\"\n                 , \"thanksgiving\"\n                 , \"thanksgiving 2013\"\n                 , \"this thanksgiving\"\n                 , \"next thanksgiving day\"\n                 , \"thanksgiving in 9 months\"\n                 , \"thanksgiving 9 months from now\"\n                 ]\n      , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n                 [ \"thanksgiving of next year\"\n                 , \"thanksgiving in a year\"\n                 , \"thanksgiving 2014\"\n                 ]\n      , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n                 [ \"last thanksgiving\"\n                 , \"thanksgiving day 2012\"\n                 , \"thanksgiving 3 months ago\"\n                 , \"thanksgiving 1 year ago\"\n                 ]\n      , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n                 [ \"thanksgiving 2016\"\n                 , \"thanksgiving in 3 years\"\n                 ]\n      , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n                 [ \"thanksgiving 2017\"\n                 ]\n      ]\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"laughing out loud\"\n      , \"1 adult\"\n      , \"we are separated\"\n      , \"25\"\n      , \"this is the one\"\n      , \"this one\"\n      , \"this past one\"\n      , \"at single\"\n      , \"at a couple of\"\n      , \"at pairs\"\n      , \"at a few\"\n      , \"at dozens\"\n      , \"single o'clock\"\n      , \"dozens o'clock\"\n      , \"Rat 6\"\n      , \"rat 6\"\n      , \"3 30\"\n      , \"three twenty\"\n      , \"at 650.650.6500\"\n      , \"at 650-650-6500\"\n      , \"two sixty a m\"\n      , \"Pay ABC 2000\"\n      , \"4a\"\n      , \"4a.\"\n      , \"A4 A5\"\n      , \"palm\"\n      , \"Martin Luther King' day\"\n      , \"two three\"\n      ]\n\nlatentCorpus :: Corpus\nlatentCorpus = (testContext, testOptions {withLatent = True}, xs)\n  where\n    xs = concat\n      [ examples (datetime (2013, 2, 24, 0, 0, 0) Day)\n                 [ \"the 24\"\n                 , \"On 24th\"\n                 ]\n      , examples (datetime (2013, 2, 12, 7, 0, 0) Hour)\n                 [ \"7\"\n                 , \"7a\"\n                 ]\n      , examples (datetime (2013, 2, 12, 19, 0, 0) Hour)\n                 [ \"7p\"\n                 ]\n      , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n                 [ \"ten thirty\"\n                 , \"ten-thirty\"\n                 ]\n      , examples (datetime (1974, 1, 1, 0, 0, 0) Year)\n                 [ \"1974\"\n                 ]\n      , examples (datetime (2013, 5, 1, 0, 0, 0) Month)\n                 [ \"May\"\n                 ]\n      , examples (datetimeInterval\n          ((2013, 2, 12, 0, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n                 [ \"morning\"\n                 ]\n      , examples (datetimeInterval\n          ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n                 [ \"afternoon\"\n                 ]\n      , examples (datetimeInterval\n          ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n                 [ \"evening\"\n                 ]\n      , examples (datetimeInterval\n          ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n                 [ \"night\"\n                 ]\n      , examples (datetimeInterval ((2013, 2, 12, 0, 0, 0), (2013, 2, 17, 0, 0, 0)) Day)\n                 [ \"the week\"\n                 ]\n      , examples (datetime (2013, 2, 12, 12, 3, 0) Minute)\n             [  \"twelve zero three\"\n             ,  \"twelve o three\"\n             ,  \"twelve ou three\"\n             ,  \"twelve oh three\"\n             ,  \"twelve-zero-three\"\n             ,  \"twelve-oh-three\"\n             ]\n      , examples (datetimeInterval ((1960, 1, 1, 0, 0, 0), (1962, 1, 1, 0, 0, 0)) Year)\n             [ \"1960 - 1961\"\n             ]\n      , examples (datetime (2013, 2, 12, 20, 15, 0) Minute)\n             [  \"tonight 815\"\n             ]\n      ]\n\ndiffContext :: Context\ndiffContext = Context\n  { locale = makeLocale EN Nothing\n  , referenceTime = refTime (2013, 2, 15, 4, 30, 0) (-2)\n  }\n\ndiffCorpus :: Corpus\ndiffCorpus = (diffContext, testOptions, diffExamples)\n  where\n    diffExamples =\n      examples (datetime (2013, 3, 8, 0, 0, 0) Day)\n               [ \"3 fridays from now\"\n               , \"three fridays from now\"\n               ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"now\"\n             , \"right now\"\n             , \"just now\"\n             , \"at the moment\"\n             , \"ATM\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"today\"\n             , \"at this time\"\n             ]\n  , examples (datetime (2013, 2, 1, 0, 0, 0) Month)\n             [ \"2/2013\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"in 2014\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"yesterday\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"tomorrow\"\n             , \"tomorrows\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"monday\"\n             , \"mon.\"\n             , \"this monday\"\n             , \"Monday, Feb 18\"\n             , \"Mon, February 18\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"tuesday\"\n             , \"Tuesday the 19th\"\n             , \"Tuesday 19th\"\n             ]\n  , examples (datetime (2013, 8, 15, 0, 0, 0) Day)\n             [ \"Thu 15th\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"thursday\"\n             , \"thu\"\n             , \"thu.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"friday\"\n             , \"fri\"\n             , \"fri.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"saturday\"\n             , \"sat\"\n             , \"sat.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"sunday\"\n             , \"sun\"\n             , \"sun.\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"the 1st of march\"\n             , \"first of march\"\n             , \"the first of march\"\n             , \"march first\"\n             ]\n  , examples (datetime (2013, 3, 2, 0, 0, 0) Day)\n             [ \"the 2nd of march\"\n             , \"second of march\"\n             , \"the second of march\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"march 3\"\n             , \"the third of march\"\n             ]\n  , examples (datetime (2013, 3, 15, 0, 0, 0) Day)\n             [ \"the ides of march\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"march 3 2015\"\n             , \"march 3rd 2015\"\n             , \"march third 2015\"\n             , \"3/3/2015\"\n             , \"3/3/15\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"on the 15th\"\n             , \"the 15th of february\"\n             , \"15 of february\"\n             , \"february the 15th\"\n             , \"february 15\"\n             , \"15th february\"\n             , \"February 15\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"Aug 8\"\n             ]\n  , examples (datetime (2014, 3, 1, 0, 0, 0) Month)\n             [ \"March in 1 year\"\n             , \"March in a year\"\n             ]\n  , examples (datetime (2014, 7, 18, 0, 0, 0) Day)\n             [ \"Fri, Jul 18\"\n             , \"Jul 18, Fri\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Month)\n             [ \"October 2014\"\n             , \"2014-10\"\n             , \"2014/10\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14april 2015\"\n             , \"April 14, 2015\"\n             , \"14th April 15\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"next tuesday\"\n             , \"around next tuesday\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"friday after next\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"next March\"\n             ]\n  , examples (datetime (2014, 3, 1, 0, 0, 0) Month)\n             [ \"March after next\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"Sunday, Feb 10\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"Wed, Feb13\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"this week\"\n             , \"current week\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"last week\"\n             , \"past week\"\n             , \"previous week\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"next week\"\n             , \"the following week\"\n             , \"around next week\"\n             , \"upcoming week\"\n             , \"coming week\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Month)\n             [ \"last month\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"next month\"\n             ]\n  , examples (datetime (2013, 3, 20, 0, 0, 0) Day)\n             [ \"20 of next month\"\n             , \"20th of the next month\"\n             , \"20th day of next month\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"20th of the current month\"\n             , \"20 of this month\"\n             ]\n  , examples (datetime (2013, 1, 20, 0, 0, 0) Day)\n             [ \"20th of the previous month\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"this quarter\"\n             , \"this qtr\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"next quarter\"\n             , \"next qtr\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"third quarter\"\n             , \"3rd quarter\"\n             , \"third qtr\"\n             , \"3rd qtr\"\n             , \"the 3rd qtr\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"4th quarter 2018\"\n             , \"4th qtr 2018\"\n             , \"the 4th qtr of 2018\"\n             , \"18q4\"\n             , \"2018Q4\"\n             ]\n  , examples (datetime (2012, 1, 1, 0, 0, 0) Year)\n             [ \"last year\"\n             , \"last yr\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Year)\n             [ \"this year\"\n             , \"current year\"\n             , \"this yr\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"next year\"\n             , \"next yr\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"in 2014 A.D.\",\n               \"in 2014 AD\"\n             ]\n  , examples (datetime (-2014, 1, 1, 0, 0, 0) Year)\n             [ \"in 2014 B.C.\",\n               \"in 2014 BC\"\n             ]\n  , examples (datetime (14, 1, 1, 0, 0, 0) Year)\n             [ \"in 14 a.d.\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"last sunday\"\n             , \"sunday from last week\"\n             , \"last week's sunday\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"last tuesday\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"next wednesday\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"wednesday of next week\"\n             , \"wednesday next week\"\n             , \"wednesday after next\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"friday after next\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"monday of this week\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"tuesday of this week\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"wednesday of this week\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"the day after tomorrow\"\n             ]\n  , examples (datetime (2013, 2, 14, 17, 0, 0) Hour)\n             [ \"day after tomorrow 5pm\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"the day before yesterday\"\n             ]\n  , examples (datetime (2013, 2, 10, 8, 0, 0) Hour)\n             [ \"day before yesterday 8am\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"last Monday of March\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"last Sunday of March 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"third day of october\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"first week of october 2014\"\n             ]\n  , examples (datetime (2018, 12, 10, 0, 0, 0) Week)\n             [ \"third last week of 2018\"\n             , \"the third last week of 2018\"\n             , \"the 3rd last week of 2018\"\n             ]\n  , examples (datetime (2018, 10, 15, 0, 0, 0) Week)\n             [ \"2nd last week of October 2018\"\n             , \"the second last week of October 2018\"\n             ]\n  , examples (datetime (2013, 5, 27, 0, 0, 0) Day)\n             [ \"fifth last day of May\"\n             , \"the 5th last day of May\"\n             ]\n  , examples (datetime (2013, 10, 7, 0, 0, 0) Week)\n             [ \"the week of october 6th\"\n             ]\n  , examples (datetime (2013, 10, 7, 0, 0, 0) Week)\n             [ \"the week of october 7th\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"last day of october 2015\"\n             , \"last day in october 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"last week of september 2014\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"first tuesday of october\"\n             , \"first tuesday in october\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"third tuesday of september 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"first wednesday of october 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"second wednesday of october 2014\"\n             ]\n  , examples (datetime (2015, 1, 13, 0, 0, 0) Day)\n             [ \"third tuesday after christmas 2014\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Hour)\n             [ \"at 3am\"\n             , \"3 in the AM\"\n             , \"at 3 AM\"\n             , \"3 oclock am\"\n             , \"at three am\"\n             , \"this morning at 3\"\n             , \"3 in the morning\"\n             , \"at 3 in the morning\"\n             , \"early morning @ 3\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 0, 0) Hour)\n             [ \"this morning @ 10\"\n             , \"this morning at 10am\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18am\"\n             , \"3:18a\"\n             , \"3h18\"\n             ]\n  , examples (datetime (2016, 2, 1, 7, 0, 0) Hour)\n             [ \"at 7 in 3 years\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"at 3pm\"\n             , \"@ 3pm\"\n             , \"3PM\"\n             , \"3pm\"\n             , \"3 oclock pm\"\n             , \"3 o'clock in the afternoon\"\n             , \"3ish pm\"\n             , \"3pm approximately\"\n             , \"at about 3pm\"\n             , \"at 3p\"\n             , \"at 3p.\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Minute)\n             [ \"15h00\"\n             , \"at 15h00\"\n             , \"15h\"\n             , \"at 15h\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"at 15 past 3pm\"\n             , \"a quarter past 3pm\"\n             , \"for a quarter past 3pm\"\n             , \"3:15 in the afternoon\"\n             , \"15:15\"\n             , \"15h15\"\n             , \"3:15pm\"\n             , \"3:15PM\"\n             , \"3:15p\"\n             , \"at 3 15\"\n             , \"15 minutes past 3pm\"\n             , \"15 minutes past 15h\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"at 20 past 3pm\"\n             , \"3:20 in the afternoon\"\n             , \"3:20 in afternoon\"\n             , \"twenty after 3pm\"\n             , \"3:20p\"\n             , \"15h20\"\n             , \"at three twenty\"\n             , \"20 minutes past 3pm\"\n             , \"this afternoon at 3:20\"\n             , \"tonight @ 3:20\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"at half past three pm\"\n             , \"half past 3 pm\"\n             , \"15:30\"\n             , \"15h30\"\n             , \"3:30pm\"\n             , \"3:30PM\"\n             , \"330 p.m.\"\n             , \"3:30 p m\"\n             , \"3:30\"\n             , \"half three\"\n             , \"30 minutes past 3 pm\"\n             ]\n   , examples (datetime (2013, 2, 12, 12, 15, 0) Minute)\n              [ \"at 15 past noon\"\n              , \"a quarter past noon\"\n              , \"for a quarter past noon\"\n              , \"12:15 in the afternoon\"\n              , \"12:15\"\n              , \"12h15\"\n              , \"12:15pm\"\n              , \"12:15PM\"\n              , \"12:15p\"\n              , \"at 12 15\"\n              , \"15 minutes past noon\"\n  ]\n  , examples (datetime (2013, 2, 12, 9, 59, 0) Minute)\n             [ \"nine fifty nine a m\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 23, 24) Second)\n             [ \"15:23:24\"\n             ]\n  , examples (datetime (2013, 2, 12, 9, 1, 10) Second)\n             [ \"9:01:10 AM\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"a quarter to noon\"\n             , \"11:45am\"\n             , \"11h45\"\n             , \"15 to noon\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 15, 0) Minute)\n             [ \"a quarter past 1pm\"\n             , \"for a quarter past 1pm\"\n             , \"1:15pm\"\n             , \"13h15\"\n             , \"15 minutes from 1pm\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 15, 0) Minute)\n             [ \"a quarter past 2pm\"\n             , \"for a quarter past 2pm\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 15, 0) Minute)\n             [ \"a quarter past 8pm\"\n             , \"for a quarter past 8pm\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"8 tonight\"\n             , \"tonight at 8 o'clock\"\n             , \"eight tonight\"\n             , \"8 this evening\"\n             , \"at 8 in the evening\"\n             , \"in the evening at eight\"\n             ]\n  , examples (datetime (2013, 9, 20, 19, 30, 0) Minute)\n             [ \"at 7:30 PM on Fri, Sep 20\"\n             , \"at 19h30 on Fri, Sep 20\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"at 9am on Saturday\"\n             , \"Saturday morning at 9\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"on Saturday for 9am\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Minute)\n             [ \"Fri, Jul 18, 2014 07:00 PM\"\n             , \"Fri, Jul 18, 2014 19h00\"\n             , \"Fri, Jul 18, 2014 19h\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"in a sec\"\n             , \"one second from now\"\n             , \"in 1\\\"\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"in a minute\"\n             , \"in one minute\"\n             , \"in 1'\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"in 2 minutes\"\n             , \"in 2 more minutes\"\n             , \"2 minutes from now\"\n             , \"in a couple of minutes\"\n             , \"in a pair of minutes\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 33, 0) Second)\n             [ \"in three minutes\"\n             , \"in a few minutes\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"in 60 minutes\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"in a quarter of an hour\"\n             , \"in 1/4h\"\n             , \"in 1/4 h\"\n             , \"in 1/4 hour\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"in half an hour\"\n             , \"in 1/2h\"\n             , \"in 1/2 h\"\n             , \"in 1/2 hour\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 15, 0) Second)\n             [ \"in three-quarters of an hour\"\n             , \"in 3/4h\"\n             , \"in 3/4 h\"\n             , \"in 3/4 hour\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 0, 0) Second)\n             [ \"in 2.5 hours\"\n             , \"in 2 and an half hours\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"in one hour\"\n             , \"in 1h\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 30, 0) Minute)\n             [ \"in a couple hours\"\n             , \"in a couple of hours\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 30, 0) Minute)\n             [ \"in a few hours\"\n             , \"in few hours\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"in 24 hours\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"in a day\"\n             , \"a day from now\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Second)\n             [ \"a day from right now\"\n             ]\n  , examples (datetime (2016, 2, 12, 0, 0, 0) Day)\n             [ \"3 years from today\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"3 fridays from now\"\n             , \"three fridays from now\"\n             ]\n  , examples (datetime (2013, 2, 24, 0, 0, 0) Day)\n             [ \"2 sundays from now\"\n             , \"two sundays from now\"\n             ]\n  , examples (datetime (2013, 3, 12, 0, 0, 0) Day)\n             [ \"4 tuesdays from now\"\n             , \"four tuesdays from now\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"in 7 days\"\n             ]\n  , examples (datetime (2013, 2, 19, 17, 0, 0) Hour)\n             [ \"in 7 days at 5pm\"\n             ]\n  , examples (datetime (2017, 2, 1, 17, 0, 0) Hour)\n             [ \"in 4 years at 5pm\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"in 1 week\"\n             , \"in a week\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"in about half an hour\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 days ago\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"14 days Ago\"\n             , \"a fortnight ago\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"a week ago\"\n             , \"one week ago\"\n             , \"1 week ago\"\n             ]\n  , examples (datetime (2013, 1, 31, 0, 0, 0) Day)\n             [ \"2 thursdays back\"\n             , \"2 thursdays ago\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"three weeks ago\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"three months ago\"\n             ]\n  , examples (datetime (2013, 02, 04, 0, 0, 0) Day)\n             [ \"the first Monday of this month\"\n             , \"the first Monday of the month\"\n             , \"the first Monday in this month\"\n             , \"first Monday in the month\"\n             ]\n  , examples (datetime (2011, 2, 1, 0, 0, 0) Month)\n             [ \"two years ago\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"7 days hence\"\n             ]\n  , examples (datetime (2013, 2, 26, 4, 0, 0) Hour)\n             [ \"14 days hence\"\n             , \"a fortnight hence\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"a week hence\"\n             , \"one week hence\"\n             , \"1 week hence\"\n             ]\n  , examples (datetime (2013, 3, 5, 0, 0, 0) Day)\n             [ \"three weeks hence\"\n             ]\n  , examples (datetime (2013, 5, 12, 0, 0, 0) Day)\n             [ \"three months hence\"\n             ]\n  , examples (datetime (2015, 2, 1, 0, 0, 0) Month)\n             [ \"two years hence\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"one year After christmas\"\n             , \"a year from Christmas\"\n             ]\n  , examples (datetimeInterval ((2013, 12, 18, 0, 0, 0), (2013, 12, 29, 0, 0, 0)) Day)\n             [ \"for 10 days from 18th Dec\"\n             , \"from 18th Dec for 10 days\"\n             , \"18th Dec for 10 days\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 16, 0, 0), (2013, 2, 12, 16, 31, 0)) Minute)\n             [ \"for 30' starting from 4pm\"\n             , \"from 4pm for thirty minutes\"\n             , \"4pm for 30 mins\"\n             , \"16h for 30 mins\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"this Summer\"\n             , \"current summer\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"this winter\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 19, 0, 0, 0)) Day)\n             [ \"this season\"\n             , \"current seasons\"\n             ]\n  , examples (datetimeInterval ((2012, 9, 23, 0, 0, 0), (2012, 12, 20, 0, 0, 0)) Day)\n             [ \"last season\"\n             , \"past seasons\"\n             , \"previous seasons\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 20, 0, 0, 0), (2013, 6, 20, 0, 0, 0)) Day)\n             [ \"next season\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"last night\"\n             , \"yesterday evening\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 21, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"late last night\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 25, 0, 0, 0) Day \"Christmas\")\n             [ \"xmas\"\n             , \"christmas\"\n             , \"christmas day\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 25, 18, 0, 0) Hour \"Christmas\")\n             [ \"xmas at 6 pm\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 12, 25, 0, 0, 0), (2013, 12, 25, 12, 0, 0)) Hour \"Christmas\")\n             [ \"morning of xmas\"\n             , \"morning of christmas 2013\"\n             , \"morning of this christmas day\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 31, 0, 0, 0) Day \"New Year's Eve\")\n             [ \"new year's eve\"\n             , \"new years eve\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 1, 0, 0, 0) Day \"New Year's Day\")\n             [ \"new year's day\"\n             , \"new years day\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 14, 0, 0, 0) Day \"Valentine's Day\")\n             [ \"valentine's day\"\n             , \"valentine day\"\n             ]\n  , examples (datetime (2013, 7, 4, 0, 0, 0) Day)\n             [ \"4th of July\"\n             , \"4 of july\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 31, 0, 0, 0) Day \"Halloween\")\n             [ \"halloween\"\n             , \"next halloween\"\n             , \"Halloween 2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 29, 0, 0, 0) Day \"Black Friday\")\n             [ \"black friday\"\n             , \"black friday of this year\"\n             , \"black friday 2013\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 24, 0, 0, 0) Day \"Black Friday\")\n             [ \"black friday 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 16, 0, 0, 0) Day \"Boss's Day\")\n             [ \"boss's day\"\n             , \"boss's\"\n             , \"boss day\"\n             , \"next boss's day\"\n             ]\n  , examples (datetimeHoliday (2016, 10, 17, 0, 0, 0) Day \"Boss's Day\")\n             [ \"boss's day 2016\"\n             ]\n  , examples (datetimeHoliday (2021, 10, 15, 0, 0, 0) Day \"Boss's Day\")\n             [ \"boss's day 2021\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 20, 0, 0, 0) Day \"Martin Luther King's Day\")\n             [ \"MLK day\"\n             , \"next Martin Luther King day\"\n             , \"next Martin Luther King's day\"\n             , \"next Martin Luther Kings day\"\n             , \"this MLK day\"\n             ]\n  , examples (datetimeHoliday (2013, 1, 21, 0, 0, 0) Day \"Martin Luther King's Day\")\n             [ \"last MLK Jr. day\"\n             , \"MLK day 2013\"\n             ]\n  , examples (datetimeHoliday (2012, 1, 16, 0, 0, 0) Day \"Martin Luther King's Day\")\n             [ \"MLK day of last year\"\n             , \"MLK day 2012\"\n             , \"Civil Rights Day of last year\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 1, 0, 0, 0) Day \"World Vegan Day\")\n             [ \"world vegan day\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 31, 0, 0, 0) Day \"Easter Sunday\")\n             [ \"easter\"\n             , \"easter 2013\"\n             ]\n , examples (datetimeHoliday (2012, 4, 08, 0, 0, 0) Day \"Easter Sunday\")\n             [ \"last easter\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 1, 0, 0, 0) Day \"Easter Monday\")\n             [ \"easter mon\"\n             ]\n  , examples (datetimeHoliday (2010, 4, 4, 0, 0, 0) Day \"Easter Sunday\")\n             [ \"easter 2010\"\n             , \"Easter Sunday two thousand ten\"\n             ]\n  , examples (datetime (2013, 4, 3, 0, 0, 0) Day)\n             [ \"three days after Easter\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 28, 0, 0, 0) Day \"Maundy Thursday\")\n             [ \"Maundy Thursday\"\n             , \"Covenant thu\"\n             , \"Thu of Mysteries\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 19, 0, 0, 0) Day \"Pentecost\")\n             [ \"Pentecost\"\n             , \"white sunday 2013\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 20, 0, 0, 0) Day \"Whit Monday\")\n             [ \"whit monday\"\n             , \"Monday of the Holy Spirit\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 24, 0, 0, 0) Day \"Palm Sunday\")\n             [ \"palm sunday\"\n             , \"branch sunday 2013\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 26, 0, 0, 0) Day \"Trinity Sunday\")\n             [ \"trinity sunday\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 12, 0, 0, 0) Day \"Shrove Tuesday\")\n             [ \"pancake day 2013\"\n             , \"mardi gras\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 17, 0, 0, 0) Day \"St Patrick's Day\")\n             [ \"st patrick's day 2013\"\n             , \"st paddy's day\"\n             , \"saint paddy's day\"\n             , \"saint patricks day\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 2, 14, 0, 0, 0), (2018, 4, 1, 0, 0, 0)) Day \"Lent\")\n             [ \"lent 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 8, 0, 0, 0) Day \"Orthodox Easter Sunday\")\n             [ \"orthodox easter 2018\"\n             ]\n  , examples (datetimeHoliday (2020, 4, 17, 0, 0, 0) Day \"Orthodox Good Friday\")\n             [ \"orthodox good friday 2020\"\n             , \"orthodox great friday 2020\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 19, 0, 0, 0) Day \"Clean Monday\")\n             [ \"clean monday 2018\"\n             , \"orthodox shrove monday two thousand eighteen\"\n             ]\n  , examples (datetimeHoliday (2018, 3, 31, 0, 0, 0) Day \"Lazarus Saturday\")\n             [ \"lazarus saturday 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 2, 19, 0, 0, 0), (2018, 3, 31, 0, 0, 0)) Day \"Great Lent\")\n             [ \"great fast 2018\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"this evening\"\n             , \"today evening\"\n             , \"tonight\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 8, 18, 0, 0), (2013, 2, 11, 0, 0, 0)) Hour)\n             [ \"this past weekend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"tomorrow evening\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 14, 0, 0)) Hour)\n             [ \"tomorrow lunch\"\n             , \"tomorrow at lunch\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"yesterday evening\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"this week-end\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"monday mOrnIng\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 2, 18, 9, 0, 0)) Hour)\n             [ \"monday early in the morning\"\n             , \"monday early morning\"\n             , \"monday in the early hours of the morning\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 21, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"late tonight\"\n             , \"late tonite\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 0, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"february the 15th in the morning\"\n             , \"15 of february in the morning\"\n             , \"morning of the 15th of february\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"last 2 seconds\"\n             , \"last two seconds\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"next 3 seconds\"\n             , \"next three seconds\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"last 2 minutes\"\n             , \"last two minutes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"next 3 minutes\"\n             , \"next three minutes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 3, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"last 1 hour\"\n             , \"last one hour\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"next 3 hours\"\n             , \"next three hours\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"last 2 days\"\n             , \"last two days\"\n             , \"past 2 days\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"next 3 days\"\n             , \"next three days\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"next few days\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"last 2 weeks\"\n             , \"last two weeks\"\n             , \"past 2 weeks\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"next 3 weeks\"\n             , \"next three weeks\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 1, 0, 0, 0), (2013, 2, 1, 0, 0, 0)) Month)\n             [ \"last 2 months\"\n             , \"last two months\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 1, 0, 0, 0), (2013, 6, 1, 0, 0, 0)) Month)\n             [ \"next 3 months\"\n             , \"next three months\"\n             ]\n  , examples (datetimeInterval ((2011, 1, 1, 0, 0, 0), (2013, 1, 1, 0, 0, 0)) Year)\n             [ \"last 2 years\"\n             , \"last two years\"\n             ]\n  , examples (datetimeInterval ((2014, 1, 1, 0, 0, 0), (2017, 1, 1, 0, 0, 0)) Year)\n             [ \"next 3 years\"\n             , \"next three years\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"July 13-15\"\n             , \"July 13 to 15\"\n             , \"July 13 thru 15\"\n             , \"July 13 through 15\"\n             , \"July 13 - July 15\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"from July 13-15\"\n             , \"from 13 to 15 July\"\n             , \"from 13th to 15th July\"\n             , \"from the 13 to 15 July\"\n             , \"from the 13th to 15th July\"\n             , \"from the 13th to the 15th July\"\n             , \"from the 13 to the 15 July\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"from 13 to 15 of July\"\n             , \"from 13th to 15 of July\"\n             , \"from 13 to 15th of July\"\n             , \"from 13th to 15th of July\"\n             , \"from 13 to the 15 of July\"\n             , \"from 13th to the 15 of July\"\n             , \"from 13 to the 15th of July\"\n             , \"from 13th to the 15th of July\"\n             , \"from the 13 to the 15 of July\"\n             , \"from the 13th to the 15 of July\"\n             , \"from the 13 to the 15th of July\"\n             , \"from the 13th to the 15th of July\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"Aug 8 - Aug 12\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             , \"9h30 - 11h00\"\n             , \"9h30 - 11h\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 30, 0), (2013, 2, 12, 15, 1, 0)) Minute)\n             [ \"9:30 - 11:00 CST\"\n             , \"9h30 - 11h00 CST\"\n             , \"9h30 - 11h CST\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 16, 1, 0)) Minute)\n             [ \"15:00 GMT - 18:00 GMT\"\n             , \"15h00 GMT - 18h00 GMT\"\n             , \"15h GMT - 18h GMT\"\n             ]\n  , examples (datetimeInterval\n      ((2015, 3, 28, 17, 00, 0), (2015, 3, 29, 21, 0, 1)) Second)\n             [ \"2015-03-28 17:00:00/2015-03-29 21:00:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"from 9:30 - 11:00 on Thursday\"\n             , \"between 9:30 and 11:00 on thursday\"\n             , \"between 9h30 and 11h00 on thursday\"\n             , \"9:30 - 11:00 on Thursday\"\n             , \"9h30 - 11h00 on Thursday\"\n             , \"later than 9:30 but before 11:00 on Thursday\"\n             , \"Thursday from 9:30 to 11:00\"\n             , \"from 9:30 untill 11:00 on thursday\"\n             , \"Thursday from 9:30 untill 11:00\"\n             , \"9:30 till 11:00 on Thursday\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 1, 0, 0), (2013, 2, 13, 2, 31, 0)) Minute)\n             [ \"tomorrow in between 1-2:30 ish\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 15, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"3-4pm\"\n             , \"from 3 to 4 in the PM\"\n             , \"around 3-4pm\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 15, 30, 0), (2013, 2, 12, 18, 1, 0)) Minute)\n             [ \"3:30 to 6 PM\"\n             , \"3:30-6 p.m.\"\n             , \"3:30-6:00pm\"\n             , \"15h30-18h\"\n             , \"from 3:30 to six p.m.\"\n             , \"from 3:30 to 6:00pm\"\n             , \"later than 3:30pm but before 6pm\"\n             , \"between 3:30pm and 6 pm\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 15, 0, 0), (2013, 2, 12, 18, 0, 1)) Second)\n             [ \"3pm - 6:00:00pm\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 8, 0, 0), (2013, 2, 12, 14, 0, 0)) Hour)\n             [ \"8am - 1pm\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"Thursday from 9a to 11a\"\n             , \"this Thu 9-11am\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-1:30\"\n             ]\n  , examples (datetime (2013, 9, 21, 13, 30, 0) Minute)\n             [ \"1:30 PM on Sat, Sep 21\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"Within 2 weeks\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 12, 14, 0, 0)) Second)\n             [ \"by 2:00pm\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 13, 0, 0, 0)) Second)\n             [ \"by EOD\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 3, 1, 0, 0, 0)) Second)\n             [ \"by EOM\"\n             , \"by the EOM\"\n             , \"by end of the month\"\n             , \"by the end of month\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 21, 0, 0, 0), (2013, 3, 1, 0, 0, 0)) Day)\n             [ \"EOM\"\n             , \"the EOM\"\n             , \"at the EOM\"\n             , \"the end of the month\"\n             , \"end of the month\"\n             , \"at the end of month\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 1, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Day)\n             [ \"BOM\"\n             , \"the BOM\"\n             , \"at the BOM\"\n             , \"beginning of the month\"\n             , \"the beginning of the month\"\n             , \"at the beginning of month\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 4, 1, 0, 0, 0)) Second)\n             [ \"by the end of next month\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"4pm CET\"\n             ]\n  , examples (datetime (2013, 2, 14, 6, 0, 0) Minute)\n             [ \"Thursday 8:00 GMT\"\n             , \"Thursday 8:00 gmt\"\n             , \"Thursday 8h00 GMT\"\n             , \"Thursday 8h00 gmt\"\n             , \"Thursday 8h GMT\"\n             , \"Thursday 8h gmt\"\n             , \"Thu at 8 GMT\"\n             , \"Thu at 8 gmt\"\n             , \"Thursday 9 am BST\"\n             , \"Thursday 9 am (BST)\"\n             ]\n  , examples (datetime (2013, 2, 14, 14, 0, 0) Minute)\n             [ \"Thursday 8:00 PST\"\n             , \"Thursday 8:00 pst\"\n             , \"Thursday 8h00 PST\"\n             , \"Thursday 8h00 pst\"\n             , \"Thursday 8h PST\"\n             , \"Thursday 8h pst\"\n             , \"Thu at 8 am PST\"\n             , \"Thu at 8 am pst\"\n             , \"Thursday at 9:30pm ist\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"today at 2pm\"\n             , \"at 2pm\"\n             , \"this afternoon at 2\"\n             , \"this evening at 2\"\n             , \"tonight at 2\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Hour)\n             [ \"3pm tomorrow\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"today in one hour\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 4, 30, 0) Second)\n             [ \"ASAP\"\n             , \"as soon as possible\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Minute)\n             [ \"until 2:00pm\"\n             , \"through 2:00pm\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"after 2 pm\"\n             , \"from 2 pm\"\n             , \"since 2pm\"\n             ]\n  , examples (datetimeOpenInterval After (2014, 1, 1, 0, 0, 0) Year)\n             [ \"anytime after 2014\"\n             , \"since 2014\"\n             ]\n  , examples (datetimeOpenInterval Before (2014, 1, 1, 0, 0, 0) Year)\n             [ \"sometimes before 2014\"\n             , \"through 2014\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"after 5 days\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"before 11 am\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"in the afternoon\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 8, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"8am until 6\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 30, 0) Minute)\n             [ \"at 1:30pm\"\n             , \"1:30pm\"\n             , \"at 13h30\"\n             , \"13h30\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"in 15 minutes\"\n             , \"in 15'\"\n             , \"in 15\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"after lunch\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 15, 0, 0), (2013, 2, 12, 21, 0, 0)) Hour)\n             [ \"after school\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             , \"approximately 1030\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 0, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"this morning\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"next monday\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 0, 0) Hour)\n             [ \"at 12pm\"\n             , \"at noon\"\n             , \"midday\"\n             , \"the midday\"\n             , \"mid day\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"at 12am\"\n             , \"at midnight\"\n             , \"this morning at 12\"\n             , \"this evening at 12\"\n             , \"this afternoon at 12\"\n             ]\n  , examples (datetime (2013, 2, 13, 9, 0, 0) Hour)\n             [ \"9 tomorrow morning\"\n             , \"9 tomorrow\"\n             ]\n  , examples (datetime (2013, 2, 13, 21, 0, 0) Hour)\n             [ \"9 tomorrow evening\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"March\"\n             , \"in March\"\n             , \"during March\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"tomorrow afternoon at 5\"\n             , \"at 5 tomorrow afternoon\"\n             , \"at 5pm tomorrow\"\n             , \"tomorrow at 5pm\"\n             , \"tomorrow evening at 5\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 19, 0, 0)) Hour)\n             [ \"tomorrow afternoon\"\n             , \"tomorrow afternoonish\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 13, 0, 0), (2013, 2, 13, 15, 0, 0)) Hour)\n             [ \"1pm-2pm tomorrow\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"on the first\"\n             , \"the 1st\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"at 1030\"\n             , \"around 1030\"\n             , \"ten thirty am\"\n             ]\n  , examples (datetime (2013, 2, 12, 19, 30, 0) Minute)\n             [ \"at 730 in the evening\"\n             , \"seven thirty p.m.\"\n             ]\n  , examples (datetime (2013, 2, 13, 1, 50, 0) Minute)\n             [ \"tomorrow at 150ish\"\n             ]\n  , examples (datetime (2013, 2, 12, 23, 0, 0) Hour)\n             [ \"tonight at 11\"\n             , \"this evening at 11\"\n             , \"this afternoon at 11\"\n             , \"tonight at 11pm\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 23, 0) Minute)\n    -- yes, the result is in the past, we may need to revisit\n             [ \"at 4:23\"\n             , \"4:23am\"\n             , \"four twenty-three a m\"\n             ]\n  , examples (datetime (2013, 10, 7, 0, 0, 0) Day)\n             [ \"the closest Monday to Oct 5th\"\n             ]\n  , examples (datetime (2013, 9, 30, 0, 0, 0) Day)\n             [ \"the second closest Mon to October fifth\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 1, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Day)\n             [ \"early March\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 11, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"mid March\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 21, 0, 0, 0), (2013, 4, 1, 0, 0, 0)) Day)\n             [ \"late March\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 25, 18, 0, 0), (2013, 10, 28, 0, 0, 0)) Hour)\n             [ \"last weekend of October\"\n             , \"last week-end in October\"\n             , \"last week end of October\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 0, 0, 0), (2013, 2, 17, 0, 0, 0)) Day)\n             [ \"all week\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 0, 0, 0), (2013, 2, 17, 0, 0, 0)) Day)\n             [ \"rest of the week\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 26, 18, 0, 0), (2013, 7, 29, 0, 0, 0)) Hour)\n             [ \"last wkend of July\"\n             ]\n  , examples (datetimeInterval ((2017, 10, 27, 18, 0, 0), (2017, 10, 30, 0, 0, 0)) Hour)\n             [ \"last weekend of October 2017\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 27, 0, 0, 0), (2013, 8, 30, 0, 0, 0)) Day)\n             [ \"August 27th - 29th\"\n             , \"from August 27th - 29th\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 23, 0, 0, 0), (2013, 10, 27, 0, 0, 0)) Day)\n             [ \"23rd to 26th Oct\"\n             ]\n  , examples (datetimeInterval ((2013, 9, 1, 0, 0, 0), (2013, 9, 9, 0, 0, 0)) Day)\n             [ \"1-8 september\"\n             ]\n  , examples (datetimeInterval ((2013, 9, 12, 0, 0, 0), (2013, 9, 17, 0, 0, 0)) Day)\n             [ \"12 to 16 september\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 19, 0, 0, 0), (2013, 8, 22, 0, 0, 0)) Day)\n             [ \"19th To 21st aug\"\n             ]\n  , examples (datetimeInterval ((2013, 4, 21, 0, 0, 0), (2013, 5, 1, 0, 0, 0)) Day)\n             [ \"end of April\"\n             , \"at the end of April\"\n             ]\n  , examples (datetimeInterval ((2014, 1, 1, 0, 0, 0), (2014, 1, 11, 0, 0, 0)) Day)\n             [ \"beginning of January\"\n             , \"at the beginning of January\"\n             ]\n  , examples (datetimeInterval ((2012, 9, 1, 0, 0, 0), (2013, 1, 1, 0, 0, 0)) Month)\n             [ \"end of 2012\"\n             , \"at the end of 2012\"\n             ]\n  , examples (datetimeInterval ((2017, 1, 1, 0, 0, 0), (2017, 4, 1, 0, 0, 0)) Month)\n             [ \"beginning of 2017\"\n             , \"at the beginning of 2017\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 1, 0, 0, 0), (2013, 4, 1, 0, 0, 0)) Month)\n             [ \"beginning of year\"\n             , \"the beginning of the year\"\n             , \"the BOY\"\n             , \"BOY\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2014, 1, 1, 0, 0, 0)) Second)\n             [ \"by EOY\"\n             , \"by the EOY\"\n             , \"by end of the year\"\n             , \"by the end of year\"\n             ]\n  , examples (datetimeInterval ((2013, 9, 1, 0, 0, 0), (2014, 1, 1, 0, 0, 0)) Month)\n             [ \"EOY\"\n             , \"the EOY\"\n             , \"at the EOY\"\n             , \"the end of the year\"\n             , \"end of the year\"\n             , \"at the end of year\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 0, 0, 0), (2013, 2, 14, 0, 0, 0)) Day)\n             [ \"beginning of this week\"\n             , \"beginning of current week\"\n             , \"at the beginning of this week\"\n             , \"at the beginning of current week\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 2, 21, 0, 0, 0)) Day)\n             [ \"beginning of coming week\"\n             , \"at the beginning of coming week\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 4, 0, 0, 0), (2013, 2, 7, 0, 0, 0)) Day)\n             [ \"beginning of last week\"\n             , \"beginning of past week\"\n             , \"beginning of previous week\"\n             , \"at the beginning of last week\"\n             , \"at the beginning of past week\"\n             , \"at the beginning of previous week\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 2, 21, 0, 0, 0)) Day)\n             [ \"beginning of next week\"\n             , \"beginning of the following week\"\n             , \"beginning of around next week\"\n             , \"at the beginning of next week\"\n             , \"at the beginning of the following week\"\n             , \"at the beginning of around next week\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 0, 0, 0), (2013, 2, 18, 0, 0, 0)) Day)\n             [ \"end of this week\"\n             , \"end of current week\"\n             , \"at the end of this week\"\n             , \"at the end of current week\"\n             ]\n   , examples (datetimeInterval ((2013, 2, 22, 0, 0, 0), (2013, 2, 25, 0, 0, 0)) Day)\n             [ \"end of coming week\"\n             , \"at the end of coming week\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 8, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Day)\n             [ \"end of last week\"\n             , \"end of past week\"\n             , \"end of previous week\"\n             , \"at the end of last week\"\n             , \"at the end of past week\"\n             , \"at the end of previous week\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 22, 0, 0, 0), (2013, 2, 25, 0, 0, 0)) Day)\n             [ \"end of next week\"\n             , \"end of the following week\"\n             , \"end of around next week\"\n             , \"at the end of next week\"\n             , \"at the end of the following week\"\n             , \"at the end of around next week\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 31, 0, 0, 0) Day \"Chinese New Year\")\n             [ \"chinese new year\"\n             , \"chinese lunar new year's day\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 10, 0, 0, 0) Day \"Chinese New Year\")\n             [ \"last chinese new year\"\n             , \"last chinese lunar new year's day\"\n             , \"last chinese new years\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 16, 0, 0, 0) Day \"Chinese New Year\")\n             [ \"chinese new year's day 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 9, 18, 0, 0, 0) Day \"Yom Kippur\")\n             [ \"yom kippur 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 9, 30, 0, 0, 0) Day \"Shemini Atzeret\")\n             [ \"shemini atzeret 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 10, 1, 0, 0, 0) Day \"Simchat Torah\")\n             [ \"simchat torah 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 7, 21, 0, 0, 0) Day \"Tisha B'Av\")\n             [ \"tisha b'av 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 18, 0, 0, 0) Day \"Yom Ha'atzmaut\")\n             [ \"yom haatzmaut 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 5, 13, 0, 0, 0) Day \"Lag BaOmer\")\n             [ \"lag b'omer 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 11, 0, 0, 0) Day \"Yom HaShoah\")\n             [ \"Yom Hashoah 2018\"\n             , \"Holocaust Day 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 9, 9, 0, 0, 0), (2018, 9, 12, 0, 0, 0)) Day \"Rosh Hashanah\")\n             [ \"rosh hashanah 2018\"\n             , \"rosh hashana 2018\"\n             , \"rosh hashanna 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 12, 2, 0, 0, 0), (2018, 12, 10, 0, 0, 0)) Day \"Hanukkah\")\n             [ \"Chanukah 2018\"\n             , \"hanukah 2018\"\n             , \"hannukkah 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 3, 30, 0, 0, 0), (2018, 4, 8, 0, 0, 0)) Day \"Passover\")\n             [ \"passover 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 9, 23, 0, 0, 0), (2018, 10, 2, 0, 0, 0)) Day \"Sukkot\")\n             [ \"feast of the ingathering 2018\"\n             , \"succos 2018\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 5, 19, 0, 0, 0), (2018, 5, 22, 0, 0, 0)) Day \"Shavuot\")\n             [ \"shavuot 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 30, 0, 0, 0) Day \"Mawlid\")\n             [ \"mawlid al-nabawi 2017\"\n             ]\n  , examples (datetimeHoliday (1950, 7, 16, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 1950\"\n             ]\n  , examples (datetimeHoliday (1975, 10, 6, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 1975\"\n             ]\n  , examples (datetimeHoliday (1988, 5, 16, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 1988\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 15, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2018\"\n             ]\n  , examples (datetimeHoliday (2034, 12, 12, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2034\"\n             ]\n  , examples (datetimeHoliday (2046, 8, 4, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2046\"\n             ]\n  , examples (datetimeHoliday (2050, 6, 21, 0, 0, 0) Day \"Eid al-Fitr\")\n             [ \"Eid al-Fitr 2050\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 21, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 2018\"\n             , \"id ul-adha 2018\"\n             , \"sacrifice feast 2018\"\n             , \"Bakr Id 2018\"\n             ]\n  , examples (datetimeHoliday (1980, 10, 19, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 1980\"\n             , \"id ul-adha 1980\"\n             , \"sacrifice feast 1980\"\n             , \"Bakr Id 1980\"\n             ]\n  , examples (datetimeHoliday (1966, 4, 1, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 1966\"\n             , \"id ul-adha 1966\"\n             , \"sacrifice feast 1966\"\n             , \"Bakr Id 1966\"\n             ]\n  , examples (datetimeHoliday (1974, 1, 3, 0, 0, 0) Day \"Eid al-Adha\")\n             [ \"Eid al-Adha 1974\"\n             , \"id ul-adha 1974\"\n             , \"sacrifice feast 1974\"\n             , \"Bakr Id 1974\"\n             ]\n  , examples (datetimeHoliday (2017, 6, 22, 0, 0, 0) Day \"Laylat al-Qadr\")\n             [ \"laylat al kadr 2017\"\n             , \"night of measures 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 11, 0, 0, 0) Day \"Laylat al-Qadr\")\n             [ \"laylat al-qadr 2018\"\n             , \"night of power 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 9, 11, 0, 0, 0) Day \"Islamic New Year\")\n             [ \"Islamic New Year 2018\"\n             , \"Amun Jadid 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 9, 30, 0, 0, 0) Day \"Ashura\")\n             [ \"day of Ashura 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 30, 0, 0, 0) Day \"Tu BiShvat\")\n             [ \"tu bishvat 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 6, 23, 0, 0, 0) Day \"Jumu'atul-Wida\")\n             [ \"Jamat Ul-Vida 2017\"\n             , \"Jumu'atul-Wida 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 8, 0, 0, 0) Day \"Jumu'atul-Wida\")\n             [ \"Jamat Ul-Vida 2018\"\n             , \"Jumu'atul-Wida 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 13, 0, 0, 0) Day \"Isra and Mi'raj\")\n             [ \"isra and mi'raj 2018\"\n             , \"the prophet's ascension 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 4, 3, 0, 0, 0) Day \"Isra and Mi'raj\")\n             [ \"the night journey 2019\"\n             , \"ascension to heaven 2019\"\n             ]\n  , examples (datetimeIntervalHoliday ((1950, 6, 17, 0, 0, 0), (1950, 7, 16, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 1950\"\n             ]\n  , examples (datetimeIntervalHoliday ((1977, 8, 15, 0, 0, 0), (1977, 9, 14, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 1977\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 5, 16, 0, 0, 0), (2018, 6, 15, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2018\"\n             ]\n , examples (datetimeIntervalHoliday ((2034, 11, 12, 0, 0, 0), (2034, 12, 12, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2034\"\n             ]\n , examples (datetimeIntervalHoliday ((2046, 7, 5, 0, 0, 0), (2046, 8, 4, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2046\"\n             ]\n , examples (datetimeIntervalHoliday ((2050, 5, 22, 0, 0, 0), (2050, 6, 21, 0, 0, 0)) Day \"Ramadan\")\n             [ \"Ramadan 2050\"\n             ]\n  , examples (datetimeHoliday (2017, 10, 17, 0, 0, 0) Day \"Dhanteras\")\n             [ \"dhanatrayodashi in 2017\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 25, 0, 0, 0) Day \"Dhanteras\")\n             [ \"dhanteras 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 26, 0, 0, 0) Day \"Naraka Chaturdashi\")\n             [ \"kali chaudas 2019\"\n             , \"choti diwali two thousand nineteen\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 27, 0, 0, 0) Day \"Diwali\")\n             [ \"diwali 2019\"\n             , \"Deepavali in 2019\"\n             , \"Lakshmi Puja six years hence\"\n             ]\n  , examples (datetimeHoliday (2019, 10, 29, 0, 0, 0) Day \"Bhai Dooj\")\n             [ \"bhai dooj 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 11, 2, 0, 0, 0) Day \"Chhath\")\n             [ \"chhath 2019\"\n             , \"dala puja 2019\"\n             , \"Surya Shashthi in 2019\"\n             ]\n  , examples (datetimeHoliday (2021, 10, 12, 0, 0, 0) Day \"Maha Saptami\")\n             [ \"Maha Saptami 2021\"\n             ]\n  , examples (datetimeHoliday (2018, 10, 18, 0, 0, 0) Day \"Vijayadashami\")\n             [ \"Dussehra 2018\"\n             , \"vijayadashami in five years\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 10, 9, 0, 0, 0), (2018, 10, 19, 0, 0, 0)) Day \"Navaratri\")\n             [ \"navaratri 2018\"\n             , \"durga puja in 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 10, 27, 0, 0, 0) Day \"Karva Chauth\")\n             [ \"karva chauth 2018\"\n             , \"karva chauth in 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 7, 14, 0, 0, 0) Day \"Ratha-Yatra\")\n             [ \"ratha-yatra 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 26, 0, 0, 0) Day \"Raksha Bandhan\")\n             [ \"rakhi 2018\"\n             ]\n  , examples (datetimeHoliday (2020, 4, 6, 0, 0, 0) Day \"Mahavir Jayanti\")\n             [ \"mahavir jayanti 2020\"\n             , \"mahaveer janma kalyanak 2020\"\n             ]\n  , examples (datetimeHoliday (2020, 2, 21, 0, 0, 0) Day \"Maha Shivaratri\")\n              [ \"maha shivaratri 2020\"\n              ]\n  , examples (datetimeHoliday (2018, 2, 10, 0, 0, 0) Day \"Dayananda Saraswati Jayanti\")\n             [ \"saraswati jayanti 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 14, 0, 0, 0) Day \"Thai Pongal\")\n             [ \"pongal 2018\"\n             , \"makara sankranthi 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 13, 0, 0, 0) Day \"Boghi\")\n             [ \"bogi pandigai 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 15, 0, 0, 0) Day \"Mattu Pongal\")\n             [ \"maattu pongal 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 1, 16, 0, 0, 0) Day \"Kaanum Pongal\")\n             [ \"kaanum pongal 2018\"\n             , \"kanni pongal 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 1, 15, 0, 0, 0) Day \"Thai Pongal\")\n             [ \"makar sankranti 2019\"\n             , \"maghi in 2019\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 14, 0, 0, 0) Day \"Vaisakhi\")\n             [ \"Vaisakhi 2018\"\n             , \"baisakhi in 2018\"\n             , \"Vasakhi 2018\"\n             , \"vaishakhi 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 24, 0, 0, 0) Day \"Thiru Onam\")\n             [ \"onam 2018\"\n             , \"Thiru Onam 2018\"\n             , \"Thiruvonam 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 2, 10, 0, 0, 0) Day \"Vasant Panchami\")\n             [ \"vasant panchami in 2019\"\n             , \"basant panchami 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 3, 20, 0, 0, 0) Day \"Holika Dahan\")\n             [ \"chhoti holi 2019\"\n             , \"holika dahan 2019\"\n             , \"kamudu pyre 2019\"\n             ]\n  , examples (datetimeHoliday (2019, 8, 23, 0, 0, 0) Day \"Krishna Janmashtami\")\n            [ \"krishna janmashtami 2019\"\n            , \"gokulashtami 2019\"\n            ]\n  , examples (datetimeHoliday (2019, 3, 21, 0, 0, 0) Day \"Holi\")\n             [ \"holi 2019\"\n             , \"dhulandi 2019\"\n             , \"phagwah 2019\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 17, 0, 0, 0) Day \"Parsi New Year\")\n             [ \"Parsi New Year 2018\"\n             , \"Jamshedi Navroz 2018\"\n             ]\n  , examples (datetimeHoliday (2022, 8, 16, 0, 0, 0) Day \"Parsi New Year\")\n             [ \"jamshedi Navroz 2022\"\n             , \"parsi new year 2022\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 4, 26, 0, 0, 0), (2013, 4, 29, 0, 0, 0)) Day \"Global Youth Service Day\")\n             [ \"GYSD 2013\"\n             , \"global youth service day\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 24, 0, 0, 0) Day \"Vesak\")\n             [ \"vesak\"\n             , \"vaisakha\"\n             , \"Buddha day\"\n             , \"Buddha Purnima\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 3, 23, 20, 30, 0), (2013, 3, 23, 21, 31, 0)) Minute \"Earth Hour\")\n             [ \"earth hour\"\n             ]\n  , examples (datetimeIntervalHoliday ((2016, 3, 19, 20, 30, 0), (2016, 3, 19, 21, 31, 0)) Minute \"Earth Hour\")\n             [ \"earth hour 2016\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 23, 0, 0, 0) Day \"Purim\")\n             [ \"purim\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 24, 0, 0, 0) Day \"Shushan Purim\")\n             [ \"Shushan Purim\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 7, 0, 0, 0) Day \"Guru Gobind Singh Jayanti\")\n             [ \"guru gobind singh birthday\"\n             , \"guru gobind singh jayanti 2014\"\n             , \"guru gobind singh jayanti\"\n             , \"Guru Govind Singh Jayanti\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 27, 0, 0, 0) Day \"King's Day\")\n            [ \"Koningsdag 2018\"\n            , \"koningsdag 2018\"\n            , \"king's day 2018\"\n            , \"King's Day 2018\"\n            ]\n  , examples (datetimeHoliday (2014, 4, 26, 0, 0, 0) Day \"King's Day\")\n            [ \"Koningsdag 2014\"\n            , \"koningsdag 2014\"\n            , \"King's Day 2014\"\n            , \"king's day 2014\"\n            ]\n  , examples (datetimeHoliday (2018, 5, 9, 0, 0, 0) Day \"Rabindra Jayanti\")\n            [ \"rabindra jayanti 2018\"\n            , \"Rabindranath Jayanti 2018\"\n            , \"Rabindra Jayanti 2018\"\n            ]\n  , examples (datetimeHoliday (2019, 5, 9, 0, 0, 0) Day \"Rabindra Jayanti\")\n            [ \"rabindra jayanti 2019\"\n            , \"Rabindranath Jayanti 2019\"\n            , \"Rabindra Jayanti 2019\"\n            ]\n  , examples (datetimeHoliday (2018, 1, 31, 0, 0, 0) Day \"Guru Ravidass Jayanti\")\n            [ \"guru Ravidas jayanti 2018\"\n            , \"Guru Ravidass birthday 2018\"\n            , \"guru ravidass Jayanti 2018\"\n            ]\n  , examples (datetimeHoliday (2019, 2, 19, 0, 0, 0) Day \"Guru Ravidass Jayanti\")\n            [ \"Guru Ravidass Jayanti 2019\"\n            , \"Guru Ravidas Birthday 2019\"\n            , \"guru ravidas jayanti 2019\"\n            ]\n  , examples (datetimeHoliday (2019, 10, 13, 0, 0, 0) Day \"Pargat Diwas\")\n            [ \"valmiki jayanti 2019\"\n            , \"Valmiki Jayanti 2019\"\n            , \"pargat diwas 2019\"\n            ]\n  , examples (datetimeHoliday (2018, 10, 24, 0, 0, 0) Day \"Pargat Diwas\")\n            [ \"maharishi valmiki jayanti 2018\"\n            , \"pargat diwas 2018\"\n            , \"Pargat Diwas 2018\"\n            ]\n  , examples (datetimeHoliday (2019, 9, 2, 0, 0, 0) Day \"Ganesh Chaturthi\")\n            [ \"ganesh chaturthi 2019\"\n            ]\n  , examples (datetimeHoliday (2020, 4, 2, 0, 0, 0) Day \"Rama Navami\")\n            [ \"rama navami 2020\"\n            ]\n  , examples (datetimeHoliday (2018, 3, 18, 0, 0, 0) Day \"Ugadi\")\n            [ \"Ugadi 2018\"\n            , \"ugadi 2018\"\n            , \"yugadi 2018\"\n            , \"Yugadi 2018\"\n            , \"samvatsaradi 2018\"\n            , \"chaitra sukladi 2018\"\n            , \"chaitra sukhladi 2018\"\n            ]\n  , examples (datetimeHoliday (2012, 12, 25, 0, 0, 0) Day \"Christmas\")\n            [ \"the closest xmas to today\"\n            ]\n  , examples (datetimeHoliday (2013, 12, 25, 0, 0, 0) Day \"Christmas\")\n            [ \"the second closest xmas to today\"\n            ]\n  , examples (datetimeHoliday (2011, 12, 25, 0, 0, 0) Day \"Christmas\")\n            [ \"the 3rd closest xmas to today\"\n            ]\n  , examples (datetime (2013, 10, 25, 0, 0, 0) Day)\n            [ \"last friday of october\"\n            , \"last friday in october\"\n            ]\n  , examples (datetime (2013, 2, 25, 0, 0, 0) Week)\n            [ \"upcoming two weeks\"\n            , \"upcoming two week\"\n            , \"upcoming 2 weeks\"\n            , \"upcoming 2 week\"\n            , \"two upcoming weeks\"\n            , \"two upcoming week\"\n            , \"2 upcoming weeks\"\n            , \"2 upcoming week\"\n            ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n            [ \"upcoming two days\"\n            , \"upcoming two day\"\n            , \"upcoming 2 days\"\n            , \"upcoming 2 day\"\n            , \"two upcoming days\"\n            , \"two upcoming day\"\n            , \"2 upcoming days\"\n            , \"2 upcoming day\"\n            ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Month)\n            [ \"upcoming two months\"\n            , \"upcoming two month\"\n            , \"upcoming 2 months\"\n            , \"upcoming 2 month\"\n            , \"two upcoming months\"\n            , \"two upcoming month\"\n            , \"2 upcoming months\"\n            , \"2 upcoming month\"\n            ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n            [ \"upcoming two quarters\"\n            , \"upcoming two quarter\"\n            , \"upcoming 2 quarters\"\n            , \"upcoming 2 quarter\"\n            , \"two upcoming quarters\"\n            , \"two upcoming quarter\"\n            , \"2 upcoming quarters\"\n            , \"2 upcoming quarter\"\n            ]\n  , examples (datetime (2015, 1, 1, 0, 0, 0) Year)\n            [ \"upcoming two years\"\n            , \"upcoming two year\"\n            , \"upcoming 2 years\"\n            , \"upcoming 2 year\"\n            , \"two upcoming years\"\n            , \"two upcoming year\"\n            , \"2 upcoming years\"\n            , \"2 upcoming year\"\n            ]\n  , examples (datetime (2013, 2, 13, 13, 40, 0) Minute)\n             [ \"20 minutes to 2pm tomorrow\"\n             ]\n  , examples (datetime (2013, 1, 7, 0, 0, 0) Day)\n             [\n               \"first monday of last month\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Day)\n             [\n               \"first tuesday of last month\"\n             ]\n  , examples (datetime (2013, 1, 14, 0, 0, 0) Day)\n             [\n               \"second monday of last month\"\n             ]\n  , examples (datetime (2013, 2, 23, 0, 0, 0) Day)\n             [ \"next saturday\" ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"next monday\" ]\n  ]\n", "num_lines": 1949}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.Rules where\n\nimport Control.Applicative ((<|>))\nimport Control.Monad (guard)\nimport Data.Maybe\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (duration, isGrain)\nimport Duckling.Duration.Types (DurationData (..))\nimport Duckling.Numeral.Helpers (isNatural, parseInt)\nimport Duckling.Numeral.Types (NumeralData (..))\nimport Duckling.Ordinal.Types (OrdinalData (..))\nimport Duckling.Regex.Types\nimport Duckling.Time.Computed\nimport Duckling.Time.Helpers\nimport Duckling.Time.HolidayHelpers\nimport Duckling.Time.Types (TimeData (..), TimeIntervalType (..))\nimport Duckling.Types\nimport qualified Duckling.Duration.Types as TDuration\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate $ isGrainFinerThan TG.Year\n    , Predicate $ or . sequence [isNotLatent, isGrainOfTime TG.Year]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_)\n        | not (TTime.latent td1) || not (TTime.latent td2) ->\n        Token Time . notLatent <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleIntersectOf :: Rule\nruleIntersectOf = Rule\n  { name = \"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\", \\\"'s\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"of|from|for|'s|,\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time . notLatent <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleIntersectYear :: Rule\nruleIntersectYear = Rule\n  { name = \"intersect by \\\",\\\", \\\"of\\\", \\\"from\\\" for year\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"of|from|,\"\n    , Predicate $ isGrainOfTime TG.Year\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time . notLatent <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAbsorbOnDay :: Rule\nruleAbsorbOnDay = Rule\n  { name = \"on <day>\"\n  , pattern =\n    [ regex \"on\"\n    , Predicate $ isGrainOfTime TG.Day\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleAbsorbOnADOW :: Rule\nruleAbsorbOnADOW = Rule\n  { name = \"on a <named-day>\"\n  , pattern =\n    [ regex \"on a\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleAbsorbInMonthYear :: Rule\nruleAbsorbInMonthYear = Rule\n  { name = \"in|during <named-month>|year\"\n  , pattern =\n    [ regex \"in|during\"\n    , Predicate $ or . sequence [isAMonth, isGrainOfTime TG.Year]\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleAbsorbCommaTOD :: Rule\nruleAbsorbCommaTOD = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleInstants :: [Rule]\nruleInstants = mkRuleInstants\n  [ (\"right now\"    , TG.Second, 0  , \"((just|right)\\\\s*)now|immediately\")\n  , (\"today\"        , TG.Day   , 0  , \"todays?|(at this time)\"           )\n  , (\"tomorrow\"     , TG.Day   , 1  , \"(tmrw?|tomm?or?rows?)\"            )\n  , (\"yesterday\"    , TG.Day   , - 1, \"yesterdays?\"                      )\n  ]\n\nruleNow :: Rule\nruleNow = Rule\n  { name = \"now\"\n  , pattern =\n    [ regex \"now|at\\\\sthe\\\\smoment|atm\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleASAP :: Rule\nruleASAP = Rule\n  { name = \"as soon as possible\"\n  , pattern =\n    [ regex \"asap|as\\\\ssoon\\\\sas\\\\spossible\"\n    ]\n  , prod = \\_ -> tt $ withDirection TTime.After now\n  }\n\nruleNextDOW :: Rule\nruleNextDOW = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"(this|next)\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\case\n      (\n        Token RegexMatch (GroupMatch (match:_)):\n        Token Time dow:\n        _) -> do\n          td <- case Text.toLower match of\n                  \"this\" -> Just $ predNth 0 True dow\n                  \"next\" -> intersect dow $ cycleNth TG.Week 1\n                  _ -> Nothing\n          tt td\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"this|current|coming\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"next\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"(this past|last|previous)\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth (- 1) False td\n      _ -> Nothing\n  }\n\nruleLastWeekendOfMonth :: Rule\nruleLastWeekendOfMonth = Rule\n  { name = \"last weekend of <named-month>\"\n  , pattern =\n    [ regex \"last\\\\s(week(\\\\s|-)?end|wkend)\\\\s(of|in)\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td2:_) -> tt $ predLastOf weekend td2\n      _ -> Nothing\n  }\n\nruleTimeBeforeLastAfterNext :: Rule\nruleTimeBeforeLastAfterNext = Rule\n  { name = \"<time> before last|after next\"\n  , pattern =\n    [ dimension Time\n    , regex \"(before last|after next)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:Token RegexMatch (GroupMatch (match:_)):_) ->\n        tt $ predNth 1 (Text.toLower match == \"after next\") td\n      _ -> Nothing\n  }\n\nruleOrdinalDOWOfTime :: Rule\nruleOrdinalDOWOfTime = Rule\n  { name = \"first|second|third|fourth|fifth <day-of-week> of <time>\"\n  , pattern =\n    [ Predicate $ isOrdinalBetween 1 5\n    , Predicate isADayOfWeek\n    , regex \"(of|in)\"\n    , dimension Time\n    ]\n  , prod = \\case\n      (\n        token:\n        Token Time td1:\n        _:\n        Token Time td2:\n        _) -> do\n          ord <- getIntValue token\n          td <- Just $ predNthAfter (ord-1) td1 td2\n          tt td\n      _ -> Nothing\n  }\n\nruleLastDOWOfTime :: Rule\nruleLastDOWOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"last\"\n    , Predicate isADayOfWeek\n    , regex \"(of|in)\"\n    , dimension Time\n    ]\n  , prod = \\case\n      (\n        _:\n        Token Time td1:\n        _:\n        Token Time td2:\n        _) -> tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"last\"\n    , dimension TimeGrain\n    , regex \"of|in\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleLastNight :: Rule\nruleLastNight = Rule\n  { name = \"last night\"\n  , pattern =\n    [ regex \"(late )?last night\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) ->\n        let hours = if Text.toLower match == \"late \" then 3 else 6\n            start = durationBefore (DurationData hours TG.Hour) today\n        in Token Time . partOfDay . notLatent <$> interval TTime.Open start today\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <day-of-week> of <month-or-greater>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate isADayOfWeek\n    , regex \"of|in\"\n    , Predicate $ not . isGrainFinerThan TG.Month\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n        predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTheNthTimeOfTime :: Rule\nruleTheNthTimeOfTime = Rule\n  { name = \"the nth <day-of-week> of <month-or-greater>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , Predicate isADayOfWeek\n    , regex \"of|in\"\n    , Predicate $ not . isGrainFinerThan TG.Month\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n         predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"after\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) ->\n        tt $ predNthAfter (TOrdinal.value od - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleTheNthTimeAfterTime :: Rule\nruleTheNthTimeAfterTime = Rule\n  { name = \"the nth <time> after <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"after\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token Time td1:_:Token Time td2:_) ->\n        tt $ predNthAfter (TOrdinal.value od - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleNDOWFromTime :: Rule\nruleNDOWFromTime = Rule\n  { name = \"<integer> <day-of-week> from <time>\"\n  , pattern =\n    [ dimension Numeral\n    , Predicate isADayOfWeek\n    , regex \"from\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td1:_:Token Time td2:_) -> do\n        n <- getIntValue token\n        tt $ predNthAfter (n - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n      [ Predicate $ isIntegerBetween 25 10000\n      ]\n  , prod = \\case\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleYearADBC :: Rule\nruleYearADBC = Rule\n  { name = \"<year> (bc|ad)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 10000\n    , regex \"(a\\\\.?d\\\\.?|b\\\\.?c\\\\.?)\"\n    ]\n  , prod = \\case\n    (token:Token RegexMatch (GroupMatch (ab:_)):_) -> do\n      y <- getIntValue token\n      tt $ yearADBC $ if Text.head (Text.toLower ab) == 'b' then -y else y\n    _ -> Nothing\n  }\n\nruleDOMLatent :: Rule\nruleDOMLatent = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern = [Predicate isDOMOrdinal]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ mkLatent $ dayOfMonth n\n      _ -> Nothing\n  }\n\nruleTheDOMNumeral :: Rule\nruleTheDOMNumeral = Rule\n  { name = \"the <day-of-month> (number)\"\n  , pattern =\n    [ regex \"the\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt $ mkLatent $ dayOfMonth n\n      _ -> Nothing\n  }\n\nruleTheDOMOrdinal :: Rule\nruleTheDOMOrdinal = Rule\n  { name = \"the <day-of-month> (ordinal)\"\n  , pattern =\n    [ regex \"the\"\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       _) -> tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleNamedDOMOrdinal :: Rule\nruleNamedDOMOrdinal = Rule\n  { name = \"<named-month>|<named-day> <day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate $ or . sequence [isAMonth, isADayOfWeek]\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleMonthDOMNumeral :: Rule\nruleMonthDOMNumeral = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleTheDOMOfMonth :: Rule\nruleTheDOMOfMonth = Rule\n  { name = \"the <day-of-month> (ordinal or number) of <named-month>\"\n  , pattern =\n    [ regex \"the\"\n    , Predicate isDOMValue\n    , regex \"of|in\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDOMOfMonth :: Rule\nruleDOMOfMonth = Rule\n  { name = \"<day-of-month> (ordinal or number) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMValue\n    , regex \"of|in\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDOMMonth :: Rule\nruleDOMMonth = Rule\n  { name = \"<day-of-month> (ordinal or number) <named-month>\"\n  , pattern =\n    [ Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDOMMonthYear :: Rule\nruleDOMMonthYear = Rule\n  { name = \"<day-of-month>(ordinal or number)/<named-month>/year\"\n  , pattern =\n    [ Predicate isDOMValue\n    , regex \"[-/\\\\s]\"\n    , Predicate isAMonth\n    , regex \"[-/\\\\s]\"\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       _:\n       Token Time td:\n       _:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         intVal <- parseInt match\n         dom <- intersectDOM td token\n         Token Time <$> intersect dom (year intVal)\n      _ -> Nothing\n  }\n\nruleDOMOrdinalMonthYear :: Rule\nruleDOMOrdinalMonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:Token RegexMatch (GroupMatch (match:_)):_) -> do\n        intVal <- parseInt match\n        dom <- intersectDOM td token\n        Token Time <$> intersect dom (year intVal)\n      _ -> Nothing\n  }\n\nruleIdesOfMonth :: Rule\nruleIdesOfMonth = Rule\n  { name = \"the ides of <named-month>\"\n  , pattern =\n    [ regex \"the ides? of\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td@TimeData {TTime.form = Just (TTime.Month m)}:_) ->\n        Token Time <$>\n          intersect td (dayOfMonth $ if elem m [3, 5, 7, 10] then 15 else 13)\n      _ -> Nothing\n  }\n\nruleTODLatent :: Rule\nruleTODLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ mkLatent $ hour (n < 13) n\n      _ -> Nothing\n  }\n\nruleAtTOD :: Rule\nruleAtTOD = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"at|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleTODOClock :: Rule\nruleTODOClock = Rule\n  { name = \"<time-of-day> o'clock\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"o.?clock\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nrulePODatTOD :: Rule\nrulePODatTOD = Rule\n  { name = \"<part-of-day> at <time-of-day>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"at|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData{TTime.timePred = TTime.IntersectPredicate\n        (TTime.TimeIntervalsPredicate\n          _ TTime.TimeDatePredicate{TTime.tdHour = Just (False, start)} _) _}:_:\n        Token Time tod@TimeData{TTime.form = Just (TTime.TimeOfDay (Just hours) True)}:_) ->\n        tt $ timeOfDayAMPM (start < 12 || hours == 12) tod\n      (Token Time TimeData{TTime.timePred = TTime.TimeIntervalsPredicate\n        _ TTime.TimeDatePredicate{TTime.tdHour = Just (False, start)} _}:_:\n        Token Time tod@TimeData{TTime.form = Just (TTime.TimeOfDay (Just hours) True)}:_) ->\n        tt $ timeOfDayAMPM (start < 12 || hours == 12) tod\n      _ -> Nothing\n  }\n\nrulePODintersectTODlatent :: Rule\nrulePODintersectTODlatent = Rule\n  { name = \"<part-of-day> <latent-time-of-day> (latent)\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_)\n        | not (TTime.latent td1) || TTime.latent td2 ->\n        Token Time . mkLatent <$> intersect td1 td2\n      _ -> Nothing\n  }\n\n\nruleHHMM :: Rule\nruleHHMM = Rule\n  { name = \"hh:mm\"\n  , pattern = [regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ hourMinute (h /= 0 && h < 12) h m\n      _ -> Nothing\n  }\n\nruleHHhMM :: Rule\nruleHHhMM = Rule\n  { name = \"hhhmm\"\n  , pattern =\n    [ regex \"(?<!/)((?:[01]?\\\\d)|(?:2[0-3]))h(([0-5]\\\\d)|(?!\\\\d))\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm <|> Just 0\n        tt $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleHHMMLatent :: Rule\nruleHHMMLatent = Rule\n  { name = \"hhmm (latent)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))([0-5]\\\\d)(?!.\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ mkLatent $ hourMinute (h < 12) h m\n      _ -> Nothing\n  }\n\nruleHHMMSS :: Rule\nruleHHMMSS = Rule\n  { name = \"hh:mm:ss\"\n  , pattern = [regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)[:.]([0-5]\\\\d)\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:ss:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        s <- parseInt ss\n        tt $ hourMinuteSecond (h < 12) h m s\n      _ -> Nothing\n  }\n\nruleMilitaryAMPM :: Rule\nruleMilitaryAMPM = Rule\n  { name = \"hhmm (military) am|pm\"\n  , pattern =\n    [ regex \"((?:1[012]|0?\\\\d))([0-5]\\\\d)\"\n    , regex \"([ap])\\\\.?m?\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):\n       Token RegexMatch (GroupMatch (ap:_)):\n       _) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ timeOfDayAMPM (Text.toLower ap == \"a\") $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleTODAMPM :: Rule\nruleTODAMPM = Rule\n  { name = \"<time-of-day> am|pm\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(in the )?([ap])(\\\\s|\\\\.)?(m?)\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td@TimeData{TTime.latent = True}:\n       Token RegexMatch (GroupMatch (_:ap:_:\"\":_)):\n       _) ->\n        tt $ mkLatent $ timeOfDayAMPM (Text.toLower ap == \"a\") td\n      (Token Time td@TimeData{TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       Token RegexMatch (GroupMatch (_:ap:_)):\n       _) | hours < 13 ->\n        tt $ timeOfDayAMPM (Text.toLower ap == \"a\") td\n      _ -> Nothing\n  }\n\nruleHONumeral :: Rule\nruleHONumeral = Rule\n  { name = \"<hour-of-day> <integer>\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , Predicate $ isIntegerBetween 10 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData{TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)\n                          ,TTime.latent = isLatent}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        if isLatent\n          then tt $ mkLatent $ hourMinute is12H hours n\n          else tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHONumeralDash :: Rule\nruleHONumeralDash = Rule\n  { name = \"<hour-of-day> - <integer-as-word>\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"-(?!\\\\d)\"\n    , Predicate $ isIntegerBetween 10 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData{TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)\n                          ,TTime.latent = isLatent}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        let lt = if isLatent then mkLatent else id\n        tt $ lt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHONumeralAlt :: Rule\nruleHONumeralAlt = Rule\n  { name = \"<hour-of-day> zero <integer>\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(zero|o(h|u)?)\"\n    , Predicate $ isIntegerBetween 1 9\n    ]\n  , prod = \\case\n      (\n        Token Time TimeData{TTime.form = Just (TTime.TimeOfDay\n                                              (Just hours) is12H)\n                          , TTime.latent = isLatent}:\n        _:\n        token:\n        _) -> do\n          n <- getIntValue token\n          if isLatent\n            then tt $ mkLatent $ hourMinute is12H hours n\n            else tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHONumeralAltDash :: Rule\nruleHONumeralAltDash = Rule\n  { name = \"<hour-of-day> - zero - <integer>\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"-\"\n    , regex \"(zero|o(h|u)?)\"\n    , regex \"-(?!\\\\d)\"\n    , Predicate $ isIntegerBetween 1 9\n    ]\n  , prod = \\case\n      (\n        Token Time TimeData{TTime.form = Just (TTime.TimeOfDay\n                                              (Just hours) is12H)\n                          , TTime.latent = isLatent}:\n        _:_:_:\n        token:\n        _) -> do\n          n <- getIntValue token\n          let lt = if isLatent then mkLatent else id\n          tt $ lt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHODHalf :: Rule\nruleHODHalf = Rule\n  { name = \"<hour-of-day> half\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"half\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData{TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleHODQuarter :: Rule\nruleHODQuarter = Rule\n  { name = \"<hour-of-day> quarter\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(a|one)? ?quarter\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData{TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleNumeralToHOD :: Rule\nruleNumeralToHOD = Rule\n  { name = \"<integer> to|till|before <hour-of-day>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"to|till|before|of\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleHalfToHOD :: Rule\nruleHalfToHOD = Rule\n  { name = \"half to|till|before <hour-of-day>\"\n  , pattern =\n    [ regex \"half (to|till|before|of)\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleQuarterToHOD :: Rule\nruleQuarterToHOD = Rule\n  { name = \"quarter to|till|before <hour-of-day>\"\n  , pattern =\n    [ regex \"(a|one)? ?quarter (to|till|before|of)\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleNumeralAfterHOD :: Rule\nruleNumeralAfterHOD = Rule\n  { name = \"integer after|past <hour-of-day>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"after|past\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesAfter n td\n      _ -> Nothing\n  }\n\nruleHalfAfterHOD :: Rule\nruleHalfAfterHOD = Rule\n  { name = \"half after|past <hour-of-day>\"\n  , pattern =\n    [ regex \"half (after|past)\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesAfter 30 td\n      _ -> Nothing\n  }\n\nruleQuarterAfterHOD :: Rule\nruleQuarterAfterHOD = Rule\n  { name = \"quarter after|past <hour-of-day>\"\n  , pattern =\n    [ regex \"(for )?((a|one) )?quarter (after|past)\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesAfter 15 td\n      _ -> Nothing\n  }\n\nruleHalfHOD :: Rule\nruleHalfHOD = Rule\n  { name = \"half <integer> (UK style hour-of-day)\"\n  , pattern =\n    [ regex \"half\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesAfter 30 td\n      _ -> Nothing\n  }\n\nruleMMYYYY :: Rule\nruleMMYYYY = Rule\n  { name = \"mm/yyyy\"\n  , pattern =\n    [ regex \"(0?[1-9]|1[0-2])[/-](\\\\d{4})\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (mm:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        tt $ yearMonth y m\n      _ -> Nothing\n  }\n\nruleYYYYMM :: Rule\nruleYYYYMM = Rule\n  { name = \"yyyy-mm\"\n  , pattern =\n    [ regex \"(\\\\d{4})\\\\s*[/-]\\\\s*(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (yy:mm:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        tt $ yearMonth y m\n      _ -> Nothing\n  }\n\nruleYYYYMMDD :: Rule\nruleYYYYMMDD = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (yy:mm:dd:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleYYYYQQ :: Rule\nruleYYYYQQ = Rule\n  { name = \"yyyyqq\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})q([1-4])\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (yy:qq:_)):_) -> do\n        y <- parseInt yy\n        q <- parseInt qq\n        tt $ cycleNthAfter True TG.Quarter (q - 1) $ year y\n      _ -> Nothing\n  }\n\nruleNoonMidnightEOD :: Rule\nruleNoonMidnightEOD = Rule\n  { name = \"noon|midnight|EOD|end of day\"\n  , pattern =\n    [ regex \"(noon|midni(ght|te)|(the )?(EOD|end of (the )?day))\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> tt $ hour False $\n        if Text.toLower match == \"noon\" then 12 else 0\n      _ -> Nothing\n  }\n\nrulePartOfDays :: Rule\nrulePartOfDays = Rule\n  { name = \"part of days\"\n  , pattern =\n    [ regex \"(morning|after ?noo?n(ish)?|evening|night|(at )?lunch)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        let (start, end) = case Text.toLower match of\n              \"morning\"  -> (hour False 0, hour False 12)\n              \"evening\"  -> (hour False 18, hour False 0)\n              \"night\"    -> (hour False 18, hour False 0)\n              \"lunch\"    -> (hour False 12, hour False 14)\n              \"at lunch\" -> (hour False 12, hour False 14)\n              _          -> (hour False 12, hour False 19)\n        td <- interval TTime.Open start end\n        tt $ partOfDay $ mkLatent td\n      _ -> Nothing\n  }\n\nruleEarlyMorning :: Rule\nruleEarlyMorning = Rule\n  { name = \"early morning\"\n  , pattern =\n    [ regex \"early ((in|hours of) the )?morning\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay . mkLatent <$>\n      interval TTime.Open (hour False 0) (hour False 9)\n  }\n\nrulePODIn :: Rule\nrulePODIn = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"(in|during)( the)?\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nrulePODThis :: Rule\nrulePODThis = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"this\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay . notLatent <$>\n        intersect today td\n      _ -> Nothing\n  }\n\nruleTonight :: Rule\nruleTonight = Rule\n  { name = \"tonight\"\n  , pattern = [regex \"(late )?toni(ght|gth|te)s?\"]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        let h = if Text.toLower match == \"late \" then 21 else 18\n        evening <- interval TTime.Open (hour False h) (hour False 0)\n        Token Time . partOfDay . notLatent <$> intersect today evening\n      _ -> Nothing\n  }\n\nruleAfterPartofday :: Rule\nruleAfterPartofday = Rule\n  { name = \"after lunch/work/school\"\n  , pattern =\n    [ regex \"after[\\\\s-]?(lunch|work|school)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        (start, end) <- case Text.toLower match of\n          \"lunch\"  -> Just (hour False 13, hour False 17)\n          \"work\"   -> Just (hour False 17, hour False 21)\n          \"school\" -> Just (hour False 15, hour False 21)\n          _        -> Nothing\n        td <- interval TTime.Open start end\n        Token Time . partOfDay . notLatent <$> intersect today td\n      _ -> Nothing\n  }\n\n-- Since part of days are latent, general time intersection is blocked\nruleTimePOD :: Rule\nruleTimePOD = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:Token Time pod:_) -> Token Time <$> intersect pod td\n      _ -> Nothing\n  }\n\nrulePODofTime :: Rule\nrulePODofTime = Rule\n  { name = \"<part-of-day> of <time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"of\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time pod:_:Token Time td:_) -> Token Time <$> intersect pod td\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"(week(\\\\s|-)?end|wkend)s?\"\n    ]\n  , prod = \\_ -> tt $ mkOkForThisNext weekend\n  }\n\nruleWeek :: Rule\nruleWeek = Rule\n { name = \"week\"\n , pattern =\n   [ regex \"(all|rest of the|the) week\"\n   ]\n , prod = \\case\n     (Token RegexMatch (GroupMatch (match:_)):_) ->\n       let end = cycleNthAfter True TG.Day (-2) $ cycleNth TG.Week 1\n           period = case Text.toLower match of\n                      \"all\" -> interval Closed (cycleNth TG.Week 0) end\n                      \"rest of the\" -> interval Open today end\n                      \"the\" -> interval Open today end\n                      _ -> Nothing\n       in case Text.toLower match of\n         \"the\" -> Token Time . mkLatent <$> period\n         _ -> Token Time <$> period\n     _ -> Nothing\n }\n\nruleSeason :: Rule\nruleSeason = Rule\n  { name = \"last|this|next <season>\"\n  , pattern =\n    [ regex \"(this|current|next|last|past|previous) seasons?\"\n    ]\n  , prod = \\case\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        n <- case Text.toLower match of\n               \"this\" -> Just 0\n               \"current\" -> Just 0\n               \"last\" -> Just (-1)\n               \"past\" -> Just (-1)\n               \"previous\" -> Just (-1)\n               \"next\" -> Just 1\n               _ -> Nothing\n        tt $ predNth n False season\n      _ -> Nothing\n  }\n\nruleSeasons :: [Rule]\nruleSeasons = mkRuleSeasons\n  [ ( \"summer\", \"summer\"     , monthDay  6 21, monthDay  9 23 )\n  , ( \"fall\"  , \"fall|autumn\", monthDay  9 23, monthDay 12 21 )\n  , ( \"winter\", \"winter\"     , monthDay 12 21, monthDay  3 20 )\n  , ( \"spring\", \"spring\"     , monthDay  3 20, monthDay  6 21 )\n  ]\n\nruleTODPrecision :: Rule\nruleTODPrecision = Rule\n  { name = \"<time-of-day> sharp|exactly\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(sharp|exactly|-?ish|approximately)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleTODPOD :: Rule\nruleTODPOD = Rule\n  { name = \"<time-of-day> <part-of-day>\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:Token Time pod:_) -> Token Time . notLatent <$> intersect td pod\n      _ -> Nothing\n  }\n\nrulePrecisionTOD :: Rule\nrulePrecisionTOD = Rule\n  { name = \"about|exactly <time-of-day>\"\n  , pattern =\n    [ regex \"(about|around|approximately|exactly)\"\n    , Predicate $ isGrainFinerThan TG.Year\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleIntervalMonthDDDD :: Rule\nruleIntervalMonthDDDD = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMValue\n    , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , Predicate isDOMValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       token1:\n       _:\n       token2:\n       _) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleIntervalDDDDMonth :: Rule\nruleIntervalDDDDMonth = Rule\n  { name = \"dd-dd <month> (interval)\"\n  , pattern =\n    [ Predicate isDOMValue\n    , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token1:\n       _:\n       token2:\n       Token Time td:\n       _) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleIntervalFromMonthDDDD :: Rule\nruleIntervalFromMonthDDDD = Rule\n  { name = \"from <month> dd-dd (interval)\"\n  , pattern =\n    [ regex \"from\"\n    , Predicate isAMonth\n    , Predicate isDOMValue\n    , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , Predicate isDOMValue\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time td:\n       token1:\n       _:\n       token2:\n       _) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleIntervalFromDDDDMonth :: Rule\nruleIntervalFromDDDDMonth = Rule\n  { name = \"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) <named-month> (interval)\"\n  , pattern =\n    [ regex \"from( the)?\"\n    , Predicate isDOMValue\n    , regex \"\\\\-|to( the)?|th?ru|through|(un)?til(l)?\"\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       token1:\n       _:\n       token2:\n       Token Time td:\n       _) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleIntervalFromDDDDOfMonth :: Rule\nruleIntervalFromDDDDOfMonth = Rule\n  { name = \"from the <day-of-month> (ordinal or number) to the <day-of-month> (ordinal or number) of <named-month> (interval)\"\n  , pattern =\n    [ regex \"from( the)?\"\n    , Predicate isDOMValue\n    , regex \"\\\\-|to( the)?|th?ru|through|(un)?til(l)?\"\n    , Predicate isDOMValue\n    , regex \"of\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       token1:\n       _:\n       token2:\n       _:\n       Token Time td:\n       _) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\n-- In order to support latent year ranges, e.g. \"1960 - 1961\", we impose\n-- the following constraints:\n--   1. Neither year can be negative.\n--   2. The first year must be less than the second year.\n--   3. The years must be within the interval [1000,10000].\n-- (1): We could try to allow negative years, but years in natural language are\n--      almost never written as negative, so it's unnecessary complication.\n-- (2): Year ranges in natural language are written\n--      <earlier year> - <later year>. No need to derive the ordering from\n--      something which is not likely a year range.\n-- (3): Four+ digits prevents phone numbers (e.g. \"333-444-5555\") from\n--      registering false positives.\n--      In everyday language, people are more likely to mention years closer\n--      to the present than very far in the past or future (closer times are\n--      more relevant).\n--      Of course, this means we do not have the ability to parse something like\n--      \"300 - 600\" as a year interval. But, prior to implementing this\n--      rule, we already did not have that ability.\n--\n-- These guidelines are not perfect, but they work. They can be iterated on and\n-- improved going forward.\nruleIntervalYearLatent :: Rule\nruleIntervalYearLatent = Rule\n  { name = \"<year> (latent) - <year> (latent) (interval)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 10000\n    , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , Predicate $ isIntegerBetween 1000 10000\n    ]\n  , prod = \\case\n      (t1:_:t2:_) -> do\n        y1 <- getIntValue t1\n        y2 <- getIntValue t2\n        guard (y1 < y2)\n        Token Time <$> interval TTime.Closed (year y1) (year y2)\n      _ -> Nothing\n  }\n\n-- Blocked for :latent time.\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\case\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleIntervalSlash :: Rule\nruleIntervalSlash = Rule\n  { name = \"<datetime>/<datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"/\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) | sameGrain td1 td2 ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleIntervalFrom :: Rule\nruleIntervalFrom = Rule\n  { name = \"from <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"from\"\n    , dimension Time\n    , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between <time> and <time>\"\n  , pattern =\n    [ regex \"between\"\n    , dimension Time\n    , regex \"and\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\n-- Specific for time-of-day, to help resolve ambiguities\nruleIntervalTODDash :: Rule\nruleIntervalTODDash = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\-|:|to|th?ru|through|(un)?til(l)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\case\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleIntervalTODFrom :: Rule\nruleIntervalTODFrom = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(later than|from|(in[\\\\s-])?between)\"\n    , Predicate isATimeOfDay\n    , regex \"((but )?before)|\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\n-- We can't take generic TOD (e.g. \"6:30am - 9pm\").\n-- Those are handled by other rules.\nruleIntervalTODAMPM :: Rule\nruleIntervalTODAMPM = Rule\n { name = \"hh(:mm) - <time-of-day> am|pm\"\n , pattern =\n   [ regex \"(?:from )?((?:[01]?\\\\d)|(?:2[0-3]))([:.]([0-5]\\\\d))?\"\n   , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n   , Predicate isATimeOfDay\n   , regex \"(in the )?([ap])(\\\\s|\\\\.)?m?\\\\.?\"\n   ]\n , prod = \\tokens -> case tokens of\n     (Token RegexMatch (GroupMatch (hh:_:mm:_)):\n      _:\n      Token Time td2:\n      Token RegexMatch (GroupMatch (_:ap:_)):\n      _) -> do\n       h <- parseInt hh\n       let ampm = Text.toLower ap == \"a\"\n           td1 = case parseInt mm of\n             Just m -> hourMinute True h m\n             Nothing -> hour True h\n       Token Time <$>\n         interval TTime.Closed (timeOfDayAMPM ampm td1) (timeOfDayAMPM ampm td2)\n     _ -> Nothing\n }\n\nruleIntervalTODBetween :: Rule\nruleIntervalTODBetween = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"between\"\n    , Predicate isATimeOfDay\n    , regex \"and\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\case\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleIntervalBy :: Rule\nruleIntervalBy = Rule\n  { name = \"by <time>\"\n  , pattern =\n    [ regex \"by\"\n    , dimension Time\n    ]\n  , prod = \\case\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Open now td\n      _ -> Nothing\n  }\n\nruleIntervalByTheEndOf :: Rule\nruleIntervalByTheEndOf = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"by (the )?end of\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed now td\n      _ -> Nothing\n  }\n\nruleIntervalUntilTime :: Rule\nruleIntervalUntilTime = Rule\n  { name = \"until <time>\"\n  , pattern =\n    [ regex \"(anytime |sometimes? )?(before|(un)?til(l)?|through|up to)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.Before $ notLatent td\n      _ -> Nothing\n  }\n\nruleIntervalAfterFromSinceTime :: Rule\nruleIntervalAfterFromSinceTime = Rule\n  { name = \"from|since|after <time>\"\n  , pattern =\n    [ regex \"from|since|(anytime |sometimes? )?after\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.After $ notLatent td\n      _ -> Nothing\n  }\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Monday\"   , \"mondays?|mon\\\\.?\"         )\n  , ( \"Tuesday\"  , \"tuesdays?|tues?\\\\.?\"      )\n  , ( \"Wednesday\", \"wed?nesdays?|wed\\\\.?\"     )\n  , ( \"Thursday\" , \"thursdays?|thu(rs?)?\\\\.?\" )\n  , ( \"Friday\"   , \"fridays?|fri\\\\.?\"         )\n  , ( \"Saturday\" , \"saturdays?|sat\\\\.?\"       )\n  , ( \"Sunday\"   , \"sundays?|sun\\\\.?\"         )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonthsWithLatent\n  [ ( \"January\"  , \"january|jan\\\\.?\"    , False )\n  , ( \"February\" , \"february|feb\\\\.?\"   , False )\n  , ( \"March\"    , \"march|mar\\\\.?\"      , False )\n  , ( \"April\"    , \"april|apr\\\\.?\"      , False )\n  , ( \"May\"      , \"may\"                , True  )\n  , ( \"June\"     , \"june|jun\\\\.?\"       , False )\n  , ( \"July\"     , \"july|jul\\\\.?\"       , False )\n  , ( \"August\"   , \"august|aug\\\\.?\"     , False )\n  , ( \"September\", \"september|sept?\\\\.?\", False )\n  , ( \"October\"  , \"october|oct\\\\.?\"    , False )\n  , ( \"November\" , \"november|nov\\\\.?\"   , False )\n  , ( \"December\" , \"december|dec\\\\.?\"   , False )\n  ]\n\nrulePartOfMonth :: Rule\nrulePartOfMonth = Rule\n  { name = \"part of <named-month>\"\n  , pattern =\n    [ regex \"(early|mid|late)-?( of)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):Token Time td:_) -> do\n        (sd, ed) <- case Text.toLower match of\n          \"early\" -> Just (1, 10)\n          \"mid\"   -> Just (11, 20)\n          \"late\"  -> Just (21, -1)\n          _       -> Nothing\n        start <- intersect td $ dayOfMonth sd\n        end <- if ed /= -1\n          then intersect td $ dayOfMonth ed\n          else Just $ cycleLastOf TG.Day td\n        Token Time <$> interval TTime.Open start end\n      _ -> Nothing\n  }\n\nruleEndOrBeginningOfMonth :: Rule\nruleEndOrBeginningOfMonth = Rule\n  { name = \"at the beginning|end of <named-month>\"\n  , pattern =\n    [ regex \"(at the )?(beginning|end) of\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (_:match:_)):Token Time td:_) -> do\n        (sd, ed) <- case Text.toLower match of\n          \"beginning\" -> Just (1, 10)\n          \"end\"       -> Just (21, -1)\n          _           -> Nothing\n        start <- intersect td $ dayOfMonth sd\n        end <- if ed /= -1\n          then intersect td $ dayOfMonth ed\n          else Just $ cycleLastOf TG.Day td\n        Token Time <$> interval TTime.Open start end\n      _ -> Nothing\n  }\n\nruleEndOfMonth :: Rule\nruleEndOfMonth = Rule\n  { name = \"end of month\"\n  , pattern = [ regex \"(by (the )?|(at )?the )?(EOM|end of (the )?month)\" ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_)\n        | (Just start, Just end) <- parsed ->\n          Token Time <$> interval TTime.Open start end\n        where\n          cycleMonth = cycleNth TG.Month\n          parsed = if \"by\" `Text.isPrefixOf` Text.toLower match\n            then\n              ( Just now\n              , intersect (dayOfMonth 1) $ cycleMonth 1)\n            else\n              ( intersect (dayOfMonth 21) $ cycleMonth 0\n              , Just $ cycleLastOf TG.Day $ cycleMonth 0)\n      _ -> Nothing\n  }\n\nruleBeginningOfMonth :: Rule\nruleBeginningOfMonth = Rule\n  { name = \"beginning of month\"\n  , pattern = [ regex \"((at )?the )?(BOM|beginning of (the )?month)\" ]\n  , prod = \\_ -> do\n      start <- intersect (dayOfMonth 1) $ cycleNth TG.Month 0\n      end <- intersect (dayOfMonth 10) $ cycleNth TG.Month 0\n      Token Time <$> interval TTime.Open start end\n  }\n\nruleEndOrBeginningOfYear :: Rule\nruleEndOrBeginningOfYear = Rule\n  { name = \"at the beginning|end of <year>\"\n  , pattern =\n    [ regex \"(at the )?(beginning|end) of\"\n    , Predicate $ isGrainOfTime TG.Year\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (_:match:_)):Token Time td:_) -> do\n        (sd, ed) <- case Text.toLower match of\n          \"beginning\" -> Just (1, 4)\n          \"end\"       -> Just (9, -1)\n          _           -> Nothing\n        start <- intersect td $ month sd\n        end <- if ed /= -1\n          then intersect td $ cycleLastOf TG.Month $ month ed\n          else cycleNthAfter False TG.Year 1 <$> intersect td (month 1)\n        Token Time <$> interval TTime.Open start end\n      _ -> Nothing\n  }\n\nruleEndOfYear :: Rule\nruleEndOfYear = Rule\n  { name = \"end of year\"\n  , pattern =\n    [ regex \"(by (the )?|(at )?the )?(EOY|end of (the )?year)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        start <- std\n        end <- intersect (month 1) $ cycleYear 1\n        Token Time <$> interval TTime.Open start end\n          where\n            std = if \"by\" `Text.isPrefixOf` Text.toLower match\n              then Just now\n              else intersect (month 9) $ cycleYear 0\n            cycleYear = cycleNth TG.Year\n      _ -> Nothing\n  }\n\nruleBeginningOfYear :: Rule\nruleBeginningOfYear = Rule\n  { name = \"beginning of year\"\n  , pattern =\n    [ regex \"((at )?the )?(BOY|beginning of (the )?year)\"\n    ]\n  , prod = \\_ -> do\n      start <- intersect (month 1) $ cycleNth TG.Year 0\n      end <- intersect (month 4) $ cycleNth TG.Year 0\n      Token Time <$> interval TTime.Open start end\n  }\n\nruleEndOrBeginningOfWeek :: Rule\nruleEndOrBeginningOfWeek = Rule\n  { name = \"at the beginning|end of <week>\"\n  , pattern =\n    [ regex \"(at the )?(beginning|end) of\"\n    , Predicate $ isGrainOfTime TG.Week\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (_:match1:_)):Token Time td:_) -> do\n        (sd, ed) <- case Text.toLower match1 of\n          \"beginning\" -> Just (1, 3)\n          \"end\"       -> Just (5, 7)\n          _           -> Nothing\n        start <- intersect td $ dayOfWeek sd\n        end <- intersect td $ dayOfWeek ed\n        Token Time <$> interval TTime.Open start end\n      _ -> Nothing\n  }\n\nruleClosest :: Rule\nruleClosest = Rule\n  { name = \"the closest <day> to <time>\"\n  , pattern =\n    [ regex \"the\\\\s+closest\"\n    , Predicate $ isGrainOfTime TG.Day\n    , regex \"to\"\n    , dimension Time\n    ]\n  , prod = \\case\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predNthClosest 0 td1 td2\n      _ -> Nothing\n  }\n\nruleNthClosest :: Rule\nruleNthClosest = Rule\n  { name = \"the <ordinal> closest <day> to <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , regex \"closest\"\n    , Predicate $ isGrainOfTime TG.Day\n    , regex \"to\"\n    , dimension Time\n    ]\n  , prod = \\case\n      (_:token:_:Token Time td1:_:Token Time td2:_) -> do\n        n <- getIntValue token\n        tt $ predNthClosest (n - 1) td1 td2\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Africa Day\", \"africa(n (freedom|liberation))? day\", monthDay 5 25 )\n  , ( \"Africa Industrialization Day\", \"africa industrialization day\", monthDay 11 20 )\n  , ( \"All Saints' Day\", \"all saints' day\", monthDay 11 1 )\n  , ( \"All Souls' Day\", \"all souls' day\", monthDay 11 2 )\n  , ( \"April Fools\", \"(april|all) fool'?s('? day)?\", monthDay 4 1 )\n  , ( \"Arabic Language Day\", \"arabic language day\", monthDay 12 18 )\n  , ( \"Assumption of Mary\", \"assumption of mary\", monthDay 8 15 )\n  , ( \"Boxing Day\", \"boxing day\", monthDay 12 26 )\n  , ( \"Chinese Language Day\", \"chinese language day\", monthDay 4 20 )\n  , ( \"Christmas\", \"(xmas|christmas)( day)?\", monthDay 12 25 )\n  , ( \"Christmas Eve\", \"(xmas|christmas)( day)?('s)? eve\", monthDay 12 24 )\n  , ( \"Day of Remembrance for all Victims of Chemical Warfare\", \"day of remembrance for all victims of chemical warfare\", monthDay 4 29 )\n  , ( \"Day of Remembrance of the Victims of the Rwanda Genocide\", \"day of remembrance of the victims of the rwanda genocide\", monthDay 4 7 )\n  , ( \"Day of the Seafarer\", \"day of the seafarer\", monthDay 6 25 )\n  , ( \"Earth Day\", \"earth day\", monthDay 4 22 )\n  , ( \"English Language Day\", \"english language day\", monthDay 4 23 )\n  , ( \"Epiphany\", \"Epiphany\", monthDay 1 6 )\n  , ( \"Feast of St Francis of Assisi\", \"feast of st\\\\.? francis of assisi\", monthDay 10 4 )\n  , ( \"Feast of the Immaculate Conception\", \"feast of the immaculate conception\", monthDay 12 8 )\n  , ( \"Global Day of Parents\", \"global day of parents\", monthDay 6 1 )\n  , ( \"Halloween\", \"hall?owe?en( day)?\", monthDay 10 31 )\n  , ( \"Human Rights Day\", \"human rights? day\", monthDay 12 10 )\n  , ( \"International Albinism Awareness Day\", \"international albinism awareness day\", monthDay 6 13 )\n  , ( \"International Anti-Corruption Day\", \"international anti(\\\\-|\\\\s)corruption day\", monthDay 12 9 )\n  , ( \"International Asteroid Day\", \"international asteroid day\", monthDay 6 30 )\n  , ( \"International Celebrate Bisexuality Day\", \"international celebrate bisexuality day\", monthDay 9 23 )\n  , ( \"International Chernobyl Disaster Remembrance Day\", \"international chernobyl disaster remembrance day\", monthDay 4 26 )\n  , ( \"International Civil Aviation Day\", \"international civil aviation day\", monthDay 12 7 )\n  , ( \"International Customs Day\", \"international customs day\", monthDay 1 26 )\n  , ( \"International Day Against Drug Abuse and Illicit Trafficking\", \"international day against drug abuse and illicit trafficking\", monthDay 6 26 )\n  , ( \"International Day against Nuclear Tests\", \"international day against nuclear tests\", monthDay 8 29 )\n  , ( \"International Day for Biological Diversity\", \"international day for biological diversity|world biodiversity day\", monthDay 5 22 )\n  , ( \"International Day for Monuments and Sites\", \"international day for monuments and sites\", monthDay 4 18 )\n  , ( \"International Day for Preventing the Exploitation of the Environment in War and Armed Conflict\", \"international day for preventing the exploitation of the environment in war and armed conflict\", monthDay 11 6 )\n  , ( \"International Day for South-South Cooperation\", \"international day for south(\\\\-|\\\\s)south cooperation\", monthDay 9 12 )\n  , ( \"International Day for Tolerance\", \"international day for tolerance\", monthDay 11 16 )\n  , ( \"International Day for the Abolition of Slavery\", \"international day for the abolition of slavery\", monthDay 12 2 )\n  , ( \"International Day for the Elimination of Racial Discrimination\", \"international day for the elimination of racial discrimination\", monthDay 3 21 )\n  , ( \"International Day for the Elimination of Sexual Violence in Conflict\", \"international day for the elimination of sexual violence in conflict\", monthDay 6 19 )\n  , ( \"International Day for the Elimination of Violence against Women\", \"international day for the elimination of violence against women\", monthDay 11 25 )\n  , ( \"International Day for the Eradication of Poverty\", \"international day for the eradication of poverty\", monthDay 10 17 )\n  , ( \"International Day for the Preservation of the Ozone Layer\", \"international day for the preservation of the ozone Layer\", monthDay 9 16 )\n  , ( \"International Day for the Remembrance of the Slave Trade and its Abolition\", \"international day for the remembrance of the slave trade and its abolition\", monthDay 8 23 )\n  , ( \"International Day for the Right to the Truth concerning Gross Human Rights Violations and for the Dignity of Victims\", \"international day for the right to the truth concerning gross human rights violations and for the dignity of victims\", monthDay 3 24 )\n  , ( \"International Day for the Total Elimination of Nuclear Weapons\", \"international day for the total elimination of nuclear weapons\", monthDay 9 26 )\n  , ( \"International Day in Support of Victims of Torture\", \"international day in support of victims of torture\", monthDay 6 26 )\n  , ( \"International Day of Charity\", \"international day of charity\", monthDay 9 5 )\n  , ( \"International Day of Commemoration in Memory of the Victims of the Holocaust\", \"international day of commemoration in memory of the victims of the holocaust\", monthDay 1 27 )\n  , ( \"International Day of Democracy\", \"international day of democracy\", monthDay 9 15 )\n  , ( \"International Day of Disabled Persons\", \"international day of disabled persons\", monthDay 12 3 )\n  , ( \"International Day of Families\", \"international day of families\", monthDay 5 15 )\n  , ( \"International Day of Family Remittances\", \"international day of family remittances\", monthDay 6 16 )\n  , ( \"International Day of Forests\", \"international day of forests\", monthDay 3 21 )\n  , ( \"International Day of Friendship\", \"international day of friendship\", monthDay 7 30 )\n  , ( \"International Day of Happiness\", \"international day of happiness\", monthDay 3 20 )\n  , ( \"International Day of Human Space Flight\", \"international day of human space flight\", monthDay 4 12 )\n  , ( \"International Day of Innocent Children Victims of Aggression\", \"international day of innocent children victims of aggression\", monthDay 6 4 )\n  , ( \"International Day of Non-Violence\", \"international day of non(\\\\-|\\\\s)violence\", monthDay 10 2 )\n  , ( \"International Day of Nowruz\", \"international day of nowruz\", monthDay 3 21 )\n  , ( \"International Day of Older Persons\", \"international day of older persons\", monthDay 10 1 )\n  , ( \"International Day of Peace\", \"international day of peace\", monthDay 9 21 )\n  , ( \"International Day of Persons with Disabilities\", \"international day of persons with disabilities\", monthDay 12 3 )\n  , ( \"International Day of Remembrance of Slavery Victims and the Transatlantic Slave Trade\", \"international day of remembrance of slavery victims and the transatlantic slave trade\", monthDay 3 25 )\n  , ( \"International Day of Rural Women\", \"international day of rural women\", monthDay 10 15 )\n  , ( \"International Day of Solidarity with Detained and Missing Staff Members\", \"international day of solidarity with detained and missing staff members\", monthDay 3 25 )\n  , ( \"International Day of Solidarity with the Palestinian People\", \"international day of solidarity with the palestinian people\", monthDay 11 29 )\n  , ( \"International Day of Sport for Development and Peace\", \"international day of sport for development and peace\", monthDay 4 6 )\n  , ( \"International Day of United Nations Peacekeepers\", \"international day of united nations peacekeepers\", monthDay 5 29 )\n  , ( \"International Day of Women and Girls in Science\", \"international day of women and girls in science\", monthDay 2 11 )\n  , ( \"International Day of Yoga\", \"international day of yoga\", monthDay 6 21 )\n  , ( \"International Day of Zero Tolerance for Female Genital Mutilation\", \"international day of zero tolerance for female genital mutilation\", monthDay 2 6 )\n  , ( \"International Day of the Girl Child\", \"international day of the girl child\", monthDay 10 11 )\n  , ( \"International Day of the Victims of Enforced Disappearances\", \"international day of the victims of enforced disappearances\", monthDay 8 30 )\n  , ( \"International Day of the World's Indigenous People\", \"international day of the world'?s indigenous people\", monthDay 8 9 )\n  , ( \"International Day to End Impunity for Crimes against Journalists\", \"international day to end impunity for crimes against journalists\", monthDay 11 2 )\n  , ( \"International Day to End Obstetric Fistula\", \"international day to end obstetric fistula\", monthDay 5 23 )\n  , ( \"International Day for Disaster Reduction\", \"iddr|international day for (natural )?disaster reduction\", monthDay 10 13 )\n  , ( \"International Human Solidarity Day\", \"international human solidarity day\", monthDay 12 20 )\n  , ( \"International Jazz Day\", \"international jazz day\", monthDay 4 30 )\n  , ( \"International Literacy Day\", \"international literacy day\", monthDay 9 8 )\n  , ( \"International Men's Day\", \"international men'?s day\", monthDay 11 19 )\n  , ( \"International Migrants Day\", \"international migrants day\", monthDay 12 18 )\n  , ( \"International Mother Language Day\", \"international mother language day\", monthDay 2 21 )\n  , ( \"International Mountain Day\", \"international mountain day\", monthDay 12 11 )\n  , ( \"International Nurses Day\", \"international nurses day\", monthDay 5 12 )\n  , ( \"International Overdose Awareness Day\", \"international overdose awareness day\", monthDay 8 31 )\n  , ( \"International Volunteer Day for Economic and Social Development\", \"international volunteer day for economic and social development\", monthDay 12 5 )\n  , ( \"International Widows' Day\", \"international widows'? day\", monthDay 6 23 )\n  , ( \"International Women's Day\", \"international women'?s day\", monthDay 3 8 )\n  , ( \"International Youth Day\", \"international youth day\", monthDay 8 12 )\n  , ( \"May Day\", \"may day\", monthDay 5 1 )\n  , ( \"Nelson Mandela Day\", \"nelson mandela day\", monthDay 7 18 )\n  , ( \"New Year's Day\", \"new year'?s?( day)?\", monthDay  1  1 )\n  , ( \"New Year's Eve\", \"new year'?s? eve\", monthDay 12 31 )\n  , ( \"Orthodox Christmas Day\", \"orthodox christmas day\", monthDay 1 7 )\n  , ( \"Orthodox New Year\", \"orthodox new year\", monthDay 1 14 )\n  , ( \"Public Service Day\", \"public service day\", monthDay 6 23 )\n  , ( \"St. George's Day\", \"(saint|st\\\\.?) george'?s day|feast of saint george\", monthDay 4 23 )\n  , ( \"St Patrick's Day\", \"(saint|st\\\\.?) (patrick|paddy)'?s day\", monthDay 3 17 )\n  , ( \"St. Stephen's Day\", \"(saint|st\\\\.?) stephen'?s day\", monthDay 12 26 )\n  , ( \"Time of Remembrance and Reconciliation for Those Who Lost Their Lives during the Second World War\", \"time of remembrance and reconciliation for those who lost their lives during the second world war\", monthDay 5 8 )\n  , ( \"Ugadi\", \"y?ugadi|samvatsaradi|chaitra sukh?ladi\", ugadi)\n  , ( \"United Nations Day\", \"united nations day\", monthDay 10 24 )\n  , ( \"United Nations' Mine Awareness Day\", \"united nations'? mine awareness day\", monthDay 4 4 )\n  , ( \"United Nations' World Health Day\", \"united nations'? world health day\", monthDay 4 7 )\n  , ( \"Universal Children's Day\", \"universal children'?s day\", monthDay 11 20 )\n  , ( \"Valentine's Day\", \"valentine'?s?( day)?\", monthDay 2 14 )\n  , ( \"World AIDS Day\", \"world aids day\", monthDay 12 1 )\n  , ( \"World Autism Awareness Day\", \"world autism awareness day\", monthDay 4 2 )\n  , ( \"World Autoimmune Arthritis Day\", \"world autoimmune arthritis day\", monthDay 5 20 )\n  , ( \"World Blood Donor Day\", \"world blood donor day\", monthDay 6 14 )\n  , ( \"World Book and Copyright Day\", \"world book and copyright day\", monthDay 4 23 )\n  , ( \"World Braille Day\", \"world braille day\", monthDay 1 4 )\n  , ( \"World Cancer Day\", \"world cancer day\", monthDay 2 4 )\n  , ( \"World Cities Day\", \"world cities day\", monthDay 10 31 )\n  , ( \"World CP Day\", \"world (cerebral palsy| cp) day\", monthDay 10 6 )\n  , ( \"World Day Against Child Labour\", \"world day against child labour\", monthDay 6 12 )\n  , ( \"World Day against Trafficking in Persons\", \"world day against trafficking in persons\", monthDay 7 30 )\n  , ( \"World Day for Audiovisual Heritage\", \"world day for audiovisual heritage\", monthDay 10 27 )\n  , ( \"World Day for Cultural Diversity for Dialogue and Development\", \"world day for cultural diversity for dialogue and development\", monthDay 5 21 )\n  , ( \"World Day for Safety and Health at Work\", \"world day for safety and health at work\", monthDay 4 28 )\n  , ( \"World Day for the Abolition of Slavery\", \"world day for the abolition of slavery\", monthDay 12 2 )\n  , ( \"World Day of Social Justice\", \"world day of social justice\", monthDay 2 20 )\n  , ( \"World Day of the Sick\", \"world day of the sick\", monthDay 2 11 )\n  , ( \"World Day to Combat Desertification and Drought\", \"world day to combat desertification and drought\", monthDay 6 17 )\n  , ( \"World Development Information Day\", \"world development information day\", monthDay 10 24 )\n  , ( \"World Diabetes Day\", \"world diabetes day\", monthDay 11 14 )\n  , ( \"World Down Syndrome Day\", \"world down syndrome day\", monthDay 3 21 )\n  , ( \"World Elder Abuse Awareness Day\", \"world elder abuse awareness day\", monthDay 6 15 )\n  , ( \"World Environment Day\", \"world environment day\", monthDay 6 5 )\n  , ( \"World Food Day\", \"world food day\", monthDay 10 16 )\n  , ( \"World Genocide Commemoration Day\", \"world genocide commemoration day\", monthDay 12 9 )\n  , ( \"World Heart Day\", \"world heart day\", monthDay 9 29 )\n  , ( \"World Hepatitis Day\", \"world hepatitis day\", monthDay 7 28 )\n  , ( \"World Humanitarian Day\", \"world humanitarian day\", monthDay 8 19 )\n  , ( \"World Information Society Day\", \"world information society day\", monthDay 5 17 )\n  , ( \"World Intellectual Property Day\", \"world intellectual property day\", monthDay 4 26 )\n  , ( \"World Malaria Day\", \"world malaria day\", monthDay 4 25 )\n  , ( \"World Mental Health Day\", \"world mental health day\", monthDay 10 10 )\n  , ( \"World Meteorological Day\", \"world meteorological day\", monthDay 3 23 )\n  , ( \"World No Tobacco Day\", \"world no tobacco day\", monthDay 5 31 )\n  , ( \"World Oceans Day\", \"world oceans day\", monthDay 6 8 )\n  , ( \"World Ovarian Cancer Day\", \"world ovarian cancer day\", monthDay 5 8 )\n  , ( \"World Pneumonia Day\", \"world pneumonia day\", monthDay 11 12 )\n  , ( \"World Poetry Day\", \"world poetry day\", monthDay 3 21 )\n  , ( \"World Population Day\", \"world population day\", monthDay 7 11 )\n  , ( \"World Post Day\", \"world post day\", monthDay 10 9 )\n  , ( \"World Prematurity Day\", \"world prematurity day\", monthDay 11 17 )\n  , ( \"World Press Freedom Day\", \"world press freedom day\", monthDay 5 3 )\n  , ( \"World Rabies Day\", \"world rabies day\", monthDay 9 28 )\n  , ( \"World Radio Day\", \"world radio day\", monthDay 2 13 )\n  , ( \"World Refugee Day\", \"world refugee day\", monthDay 6 20 )\n  , ( \"World Science Day for Peace and Development\", \"world science day for peace and development\", monthDay 11 10 )\n  , ( \"World Sexual Health Day\", \"world sexual health day\", monthDay 9 4 )\n  , ( \"World Soil Day\", \"world soil day\", monthDay 12 5 )\n  , ( \"World Stroke Day\", \"world stroke day\", monthDay 10 29 )\n  , ( \"World Suicide Prevention Day\", \"world suicide prevention day\", monthDay 9 10 )\n  , ( \"World Teachers' Day\", \"world teachers'? day\", monthDay 10 5 )\n  , ( \"World Television Day\", \"world television day\", monthDay 11 21 )\n  , ( \"World Toilet Day\", \"world toilet day\", monthDay 11 19 )\n  , ( \"World Tourism Day\", \"world tourism day\", monthDay 9 27 )\n  , ( \"World Tuberculosis Day\", \"world tuberculosis day\", monthDay 3 24 )\n  , ( \"World Tuna Day\", \"world tuna day\", monthDay 5 2 )\n  , ( \"World Vegan Day\", \"world vegan day\", monthDay 11 1 )\n  , ( \"World Vegetarian Day\", \"world vegetarian day\", monthDay 10 1 )\n  , ( \"World Water Day\", \"world water day\", monthDay 3 22 )\n  , ( \"World Wetlands Day\", \"world wetlands day\", monthDay 2 2 )\n  , ( \"World Wildlife Day\", \"world wildlife day\", monthDay 3 3 )\n  , ( \"World Youth Skills Day\", \"world youth skills day\", monthDay 7 15 )\n  , ( \"Zero Discrimination Day\", \"zero discrimination day\", monthDay 3 1 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Commonwealth Day\", \"commonwealth day\", nthDOWOfMonth 2 1 3 )\n  , ( \"Day of Remembrance for Road Traffic Victims\"\n    , \"(world )?day of remembrance for road traffic victims\"\n    , nthDOWOfMonth 3 7 11 )\n  , ( \"International Day of Cooperatives\"\n    , \"international day of co\\\\-?operatives\", nthDOWOfMonth 1 6 7 )\n  , ( \"Martin Luther King's Day\"\n    , \"(MLK|Martin Luther King('?s)?,?)( Jr\\\\.?| Junior)? day|(civil|idaho human) rights day\"\n    , nthDOWOfMonth 3 1 1\n    )\n\n  -- The day after Thanksgiving (not always the fourth Friday of November)\n  , ( \"Black Friday\", \"black frid?day\"\n    , cycleNthAfter False TG.Day 1 $ nthDOWOfMonth 4 4 11\n    )\n  , ( \"World Habitat Day\", \"world habitat day\", nthDOWOfMonth 1 1 10 )\n  , ( \"World Kidney Day\", \"world kidney day\", nthDOWOfMonth 2 4 3 )\n  , ( \"World Leprosy Day\", \"world leprosy day\"\n    , predLastOf (dayOfWeek 7) (month 1) )\n  , ( \"World Maritime Day\", \"world maritime day\"\n    , predLastOf (dayOfWeek 4) (month 9) )\n  , ( \"World Migratory Bird Day\", \"world migratory bird day\"\n    , nthDOWOfMonth 2 6 5 )\n  , ( \"World Philosophy Day\", \"world philosophy day\", nthDOWOfMonth 3 4 11 )\n  , ( \"World Religion Day\", \"world religion day\", nthDOWOfMonth 3 7 1 )\n  , ( \"World Sight Day\", \"world sight day\", nthDOWOfMonth 2 4 10 )\n\n  -- Other\n  , ( \"Boss's Day\", \"boss'?s?( day)?\"\n    , predNthClosest 0 weekday (monthDay 10 16) )\n  ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  [ ( \"Ascension Day\", \"ascension\\\\s+(thurs)?day\"\n    , cycleNthAfter False TG.Day 39 easterSunday )\n  , ( \"Ash Wednesday\", \"ash\\\\s+wednesday|carnival\"\n    , cycleNthAfter False TG.Day (-46) easterSunday )\n  , ( \"Ashura\", \"(day of )?ashura\"\n    , cycleNthAfter False TG.Day 9 muharram )\n  , ( \"Bhai Dooj\", \"bhai(ya)?\\\\s+d(u|oo)j|bhau\\\\-beej|bhai\\\\s+(tika|phonta)\"\n    , cycleNthAfter False TG.Day 4 dhanteras )\n  -- 6th day after Diwali\n  , ( \"Chhath\", \"chhathi?|chhath (parv|puja)|dala (chhath|puja)|surya shashthi\"\n    , cycleNthAfter False TG.Day 8 dhanteras )\n  , ( \"Boghi\", \"boghi|bogi\\\\s+pandigai\"\n    , cycleNthAfter False TG.Day (-1) thaiPongal )\n  , ( \"Chinese New Year\", \"chinese\\\\s+(lunar\\\\s+)?new\\\\s+year('?s(\\\\s+day)?)?\"\n    , chineseNewYear )\n  , ( \"Clean Monday\"\n    , \"(orthodox\\\\s+)?(ash|clean|green|pure|shrove)\\\\s+monday|monday of lent\"\n    , cycleNthAfter False TG.Day (-48) orthodoxEaster )\n  , ( \"Corpus Christi\", \"(the feast of )?corpus\\\\s+christi\"\n    , cycleNthAfter False TG.Day 60 easterSunday )\n  , ( \"Dhanteras\", \"dhanatrayodashi|dhanteras|dhanvantari\\\\s+trayodashi\"\n    , dhanteras )\n  , ( \"Diwali\", \"deepavali|diwali|lakshmi\\\\s+puja\"\n    , cycleNthAfter False TG.Day 2 dhanteras )\n  , ( \"Durga Ashtami\", \"(durga|maha)(\\\\s+a)?shtami\"\n    , cycleNthAfter False TG.Day 7 navaratri )\n  , ( \"Easter Monday\", \"easter\\\\s+mon(day)?\"\n    , cycleNthAfter False TG.Day 1 easterSunday )\n  , ( \"Easter Sunday\", \"easter(\\\\s+sun(day)?)?\", easterSunday )\n  , ( \"Eid al-Adha\", \"bakr[\\\\-\\\\s]e?id|e?id [au]l\\\\-adha|sacrifice feast\"\n    , eidalAdha )\n  , ( \"Eid al-Fitr\", \"eid al\\\\-fitr\", eidalFitr )\n  , ( \"Govardhan Puja\", \"govardhan\\\\s+puja|annak(u|oo)t\"\n    , cycleNthAfter False TG.Day 3 dhanteras )\n  , ( \"Good Friday\", \"(good|great|holy)\\\\s+fri(day)?\"\n    , cycleNthAfter False TG.Day (-2) easterSunday )\n  , ( \"Guru Gobind Singh Jayanti\"\n    , \"guru\\\\s+(gobind|govind)\\\\s+singh\\\\s+(birthday|jayanti)\"\n    , guruGobindSinghJayanti )\n  , ( \"Holi\", \"(rangwali )?holi|dhuleti|dhulandi|phagwah\"\n    , cycleNthAfter False TG.Day 39 vasantPanchami )\n  , ( \"Holika Dahan\", \"holika dahan|kamudu pyre|chhoti holi\"\n    , cycleNthAfter False TG.Day 38 vasantPanchami )\n  , ( \"Holy Saturday\"\n    , \"(black|holy (and great )?|joyous)sat(urday)?|the great sabbath|easter eve\"\n    , cycleNthAfter False TG.Day (-1) easterSunday )\n  , ( \"Islamic New Year\", \"(arabic|hijri|islamic) new year|amun jadid|muharram\"\n    , muharram )\n  , ( \"Isra and Mi'raj\"\n    , \"isra and mi'raj|(the )?prophet'?s'? ascension|(the )?ascension to heaven|the night journey\"\n    , cycleNthAfter False TG.Day 26 rajab\n    )\n  , ( \"Jumu'atul-Wida\", \"jumu'atul\\\\-widaa?'?|jamat[\\\\-\\\\s]ul[\\\\-\\\\s]vida\"\n    , predNthAfter (-1) (dayOfWeek 5) eidalFitr )\n  , ( \"Kaanum Pongal\", \"(kaanum|kanni)\\\\s+pongal\"\n    , cycleNthAfter False TG.Day 2 thaiPongal )\n  , ( \"Lag BaOmer\", \"lag b[a']omer\", lagBaOmer )\n  , ( \"Vaisakhi\", \"mesadi|[bv]aisakhi|vaisakhadi|vasakhi|vaishakhi\", vaisakhi)\n  , ( \"Laylat al-Qadr\"\n    , \"laylat al[\\\\-\\\\s][qk]adr|night of (destiny|measures|power|value)\"\n    , cycleNthAfter False TG.Day 26 ramadan )\n  , ( \"Lazarus Saturday\", \"lazarus\\\\s+saturday\"\n    , cycleNthAfter False TG.Day (-8) orthodoxEaster )\n  , ( \"Maha Navami\", \"maha\\\\s+navami\", cycleNthAfter False TG.Day 8 navaratri )\n  , ( \"Maha Saptami\", \"maha\\\\s+saptami\", cycleNthAfter False TG.Day 6 navaratri )\n  , ( \"Mattu Pongal\", \"maa?ttu\\\\s+pongal\"\n    , cycleNthAfter False TG.Day 1 thaiPongal )\n  , ( \"Maundy Thursday\"\n    , \"(covenant|(great and )?holy|maundy|sheer)\\\\s+thu(rsday)?|thu(rsday)? of mysteries\"\n    , cycleNthAfter False TG.Day (-3) easterSunday )\n  , ( \"Mawlid\"\n    , \"mawlid(\\\\s+al\\\\-nab(awi|i\\\\s+al\\\\-sharif))?|mevli[dt]|mulud|birth(day)? of (the )?prophet( muhammad)?|(the )?prophet's birthday\"\n    , mawlid )\n  , ( \"Naraka Chaturdashi\"\n    , \"naraka? (nivaran )?chaturdashi|(kali|roop) chaudas|choti diwali\"\n    , cycleNthAfter False TG.Day 1 dhanteras )\n  , ( \"Orthodox Easter Monday\", \"orthodox\\\\s+easter\\\\s+mon(day)?\"\n    , cycleNthAfter False TG.Day 1 orthodoxEaster )\n  , ( \"Orthodox Easter Sunday\", \"orthodox\\\\s+easter(\\\\s+sun(day)?)?|pascha?\"\n    , orthodoxEaster )\n  , ( \"Orthodox Holy Saturday\", \"orthodox\\\\s+holy\\\\s+sat(urday)?|the great sabbath\"\n    , cycleNthAfter False TG.Day (-1) orthodoxEaster )\n  , ( \"Orthodox Good Friday\", \"orthodox\\\\s+(great|good)(\\\\s+and\\\\s+holy)?\\\\s+friday\"\n    , cycleNthAfter False TG.Day (-2) orthodoxEaster )\n  , ( \"Orthodox Palm Sunday\", \"orthodox\\\\s+(branch|palm|yew)\\\\s+sunday\"\n    , cycleNthAfter False TG.Day (-7) orthodoxEaster )\n  , ( \"Palm Sunday\", \"(branch|palm|yew)\\\\s+sunday\"\n    , cycleNthAfter False TG.Day (-7) easterSunday )\n  , ( \"Pentecost\", \"pentecost|white sunday|whitsunday\"\n    , cycleNthAfter False TG.Day 49 easterSunday )\n  , ( \"Purim\", \"purim\", purim )\n  , ( \"Raksha Bandhan\", \"raksha(\\\\s+)?bandhan|rakhi\", rakshaBandhan )\n  , ( \"Rama Navami\", \"rama\\\\s+navami\", ramaNavami)\n  , ( \"Ganesh Chaturthi\", \"(ganesh|vinayaka)\\\\s+chaturthi\", ganeshChaturthi )\n  , ( \"Ratha-Yatra\", \"ratha(\\\\-|\\\\s+)?yatra|rathjatra|chariot\\\\s+festival\"\n    , rathaYatra )\n  , ( \"Pargat Diwas\", \"pargat diwas|(maharishi )?valmiki jayanti\", pargatDiwas )\n  , ( \"Mahavir Jayanti\", \"(mahavir|mahaveer) (jayanti|janma kalyanak)\"\n    , mahavirJayanti )\n  , ( \"Maha Shivaratri\", \"maha(\\\\s+)?shivaratri\", mahaShivaRatri)\n  , ( \"Dayananda Saraswati Jayanti\",\"((maharishi|swami) )?(dayananda )?saraswati jayanti\"\n    , saraswatiJayanti )\n  , ( \"Karva Chauth\", \"karva\\\\s+chauth|karaka\\\\s+chaturthi\"\n    , karvaChauth)\n  , ( \"Krishna Janmashtami\", \"(krishna )?janmashtami|gokulashtami\", krishnaJanmashtami )\n  , ( \"Shemini Atzeret\", \"shemini\\\\s+atzeret\"\n    , cycleNthAfter False TG.Day 21 roshHashana )\n  , ( \"Shrove Tuesday\", \"pancake (tues)?day|shrove tuesday|mardi gras\"\n    , cycleNthAfter False TG.Day (-47) easterSunday )\n  , ( \"Shushan Purim\", \"shushan\\\\s+purim\", cycleNthAfter False TG.Day 1 purim )\n  , ( \"Simchat Torah\", \"simc?hat\\\\s+torah\"\n    , cycleNthAfter False TG.Day 22 roshHashana )\n  , ( \"Thai Pongal\"\n    , \"(thai )?pongal|pongal pandigai|(makara? |magha )?sankranth?i|maghi\"\n    , thaiPongal )\n  , ( \"Thiru Onam\", \"(thiru(v|\\\\s+))?onam\", thiruOnam )\n  , ( \"Tisha B'Av\", \"tisha b'av\", tishaBAv )\n  , ( \"Trinity Sunday\", \"trinity\\\\s+sunday\"\n    , cycleNthAfter False TG.Day 56 easterSunday )\n  , ( \"Vasant Panchami\", \"[bv]asant\\\\s+panchami\", vasantPanchami )\n  , ( \"Vijayadashami\", \"dasara|duss(eh|he)ra|vijayadashami\"\n    , cycleNthAfter False TG.Day 9 navaratri )\n  -- 15th day of Shevat\n  , ( \"Tu BiShvat\", \"tu b[i']shvat\", tuBishvat )\n  -- day of the full moon in May in the Gregorian calendar\n  , ( \"Vesak\", \"v(e|ai)sak(ha)?|buddha (day|purnima)\", vesak )\n  , ( \"Yom Ha'atzmaut\", \"yom ha'?atzmaut\", yomHaatzmaut )\n  , ( \"Yom HaShoah\"\n    , \"yom hashoah|yom hazikaron lashoah ve-lag'vurah|holocaust (remembrance )?day\"\n    , cycleNthAfter False TG.Day 12 passover )\n  , ( \"Yom Kippur\", \"yom\\\\s+kippur\", cycleNthAfter False TG.Day 9 roshHashana )\n  , ( \"Whit Monday\", \"(pentecost|whit)\\\\s+monday|monday of the holy spirit\"\n    , cycleNthAfter False TG.Day 50 easterSunday )\n  -- Rabindra Jayanti 25th day of the Bengali month of Boishakh\n  , ( \"Rabindra Jayanti\", \"rabindra(nath)?\\\\s+jayanti\", rabindraJayanti )\n  , (\"Guru Ravidass Jayanti\", \"guru\\\\s+ravidass?\\\\s+(birthday|jayanti)\"\n    , ravidassJayanti )\n  ]\n\nruleComputedHolidays' :: [Rule]\nruleComputedHolidays' = mkRuleHolidays'\n  [ ( \"Global Youth Service Day\", \"global youth service day|gysd\"\n    , let start = globalYouthServiceDay\n          end = cycleNthAfter False TG.Day 2 globalYouthServiceDay\n        in interval TTime.Open start end )\n  , ( \"Great Lent\", \"great\\\\s+(fast|lent)\"\n    , let start = cycleNthAfter False TG.Day (-48) orthodoxEaster\n          end = cycleNthAfter False TG.Day (-9) orthodoxEaster\n        in interval TTime.Open start end )\n  , ( \"Hanukkah\", \"c?hann?ukk?ah\"\n    , let start = chanukah\n          end = cycleNthAfter False TG.Day 7 chanukah\n        in interval TTime.Open start end )\n  , ( \"Lent\", \"lent\"\n    , let start = cycleNthAfter False TG.Day (-46) easterSunday\n          end = cycleNthAfter False TG.Day (-1) easterSunday\n        in interval TTime.Open start end )\n  , ( \"Navaratri\", \"durga\\\\s+puja|durgotsava|nava?rath?ri\"\n    , let start = navaratri\n          end = cycleNthAfter False TG.Day 9 navaratri\n        in interval TTime.Open start end )\n  , ( \"Passover\", \"passover|pesa[ck]?h\"\n    , let start = passover\n          end = cycleNthAfter False TG.Day 8 passover\n        in interval TTime.Open start end )\n  , ( \"Ramadan\", \"rama[dt]h?an|ramzaa?n\"\n    , let start = ramadan\n          end = cycleNthAfter False TG.Day (-1) eidalFitr\n        in interval TTime.Open start end )\n  , ( \"Rosh Hashanah\", \"rosh hashann?ah?|yom teruah\"\n    , let start = roshHashana\n          end = cycleNthAfter False TG.Day 2 roshHashana\n        in interval TTime.Open start end )\n  , ( \"Shavuot\", \"feast of weeks|shavu'?oth?|shovuos\"\n    , let start = cycleNthAfter False TG.Day 50 passover\n          end = cycleNthAfter False TG.Day 52 passover\n        in interval TTime.Open start end )\n  , ( \"Sukkot\", \"feast of (booths|tabernacles|the ingathering)|su[ck]{2}o[st]\"\n    , let start = cycleNthAfter False TG.Day 14 roshHashana\n          end = cycleNthAfter False TG.Day 22 roshHashana\n        in interval TTime.Open start end )\n  -- Does not account for leap years, so every 365 days.\n  , ( \"Parsi New Year\", \"parsi new year|jamshedi navroz\"\n    , predEveryNDaysFrom 365 (2020, 8, 16)\n    )\n  , ( \"Earth Hour\", \"earth hour\"\n    , computeEarthHour )\n  , ( \"King's Day\", \"king's day|koningsdag\"\n    , computeKingsDay )\n  ]\n\nruleCycleThisLastNext :: Rule\nruleCycleThisLastNext = Rule\n  { name = \"this|last|next <cycle>\"\n  , pattern =\n    [ regex \"(this|current|coming|next|(the( following)?)|last|past|previous|upcoming)\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      (\n        Token RegexMatch (GroupMatch (match:_)):\n        Token TimeGrain grain:\n        _) ->\n          case Text.toLower match of\n            \"this\"          -> tt $ cycleNth grain 0\n            \"coming\"        -> tt $ cycleNth grain 1\n            \"current\"       -> tt $ cycleNth grain 0\n            \"last\"          -> tt $ cycleNth grain $ - 1\n            \"past\"          -> tt $ cycleNth grain $ - 1\n            \"previous\"      -> tt $ cycleNth grain $ - 1\n            \"next\"          -> tt $ cycleNth grain 1\n            \"upcoming\"      -> tt $ cycleNth grain 1\n            \"the following\" -> tt $ cycleNth grain 1\n            \"the\"           -> tt $ cycleNth grain 0\n            _ -> Nothing\n      _ -> Nothing\n  }\n\nruleDOMOfTimeMonth :: Rule\nruleDOMOfTimeMonth = Rule\n  { name = \"<day-of-month> (ordinal or number) of <month>\"\n  , pattern =\n    [ Predicate isDOMValue\n    , regex \"of( the)?\"\n    , Predicate $ isGrainOfTime TG.Month\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleCycleTheAfterBeforeTime :: Rule\nruleCycleTheAfterBeforeTime = Rule\n  { name = \"the <cycle> after|before <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension TimeGrain\n    , regex \"(after|before)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (  _\n       : Token TimeGrain grain\n       : Token RegexMatch (GroupMatch (match:_))\n       : Token Time td\n       : _) ->\n        let n = if Text.toLower match == \"after\" then 1 else - 1 in\n          tt $ cycleNthAfter False grain n td\n      _ -> Nothing\n  }\n\nruleCycleAfterBeforeTime :: Rule\nruleCycleAfterBeforeTime = Rule\n  { name = \"<cycle> after|before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(after|before)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:\n       Token RegexMatch (GroupMatch (match:_)):\n       Token Time td:\n       _) ->\n        let n = if Text.toLower match == \"after\" then 1 else - 1 in\n          tt $ cycleNthAfter False grain n td\n      _ -> Nothing\n  }\n\nruleCycleOrdinalOfTime :: Rule\nruleCycleOrdinalOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"of|in|from\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (n - 1) td\n      _ -> Nothing\n  }\n\nruleCycleLastOrdinalOfTime :: Rule\nruleCycleLastOrdinalOfTime = Rule\n  { name = \"<ordinal> last <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , regex \"last\"\n    , dimension TimeGrain\n    , regex \"of|in|from\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (-n) $ cycleNthAfter True (timeGrain td) 1 td\n      _ -> Nothing\n  }\n\nruleCycleTheOrdinalOfTime :: Rule\nruleCycleTheOrdinalOfTime = Rule\n  { name = \"the <ordinal> <cycle> of <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"of|in|from\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (n - 1) td\n      _ -> Nothing\n  }\n\nruleCycleTheLastOrdinalOfTime :: Rule\nruleCycleTheLastOrdinalOfTime = Rule\n  { name = \"the <ordinal> last <cycle> of <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , regex \"last\"\n    , dimension TimeGrain\n    , regex \"of|in|from\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (-n) $ cycleNthAfter True (timeGrain td) 1 td\n      _ -> Nothing\n  }\n\nruleCycleTheOfTimeGrain :: Rule\nruleCycleTheOfTimeGrain = Rule\n  { name = \"the <cycle> of the <time grain>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension TimeGrain\n    , regex \"of( the)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token TimeGrain time:_) ->\n        tt $ cycleNthAfter True grain 0 $ cycleNth time 0\n      _ -> Nothing\n  }\n\nruleCycleTheOfTime :: Rule\nruleCycleTheOfTime = Rule\n  { name = \"the <cycle> of <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension TimeGrain\n    , regex \"of\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleCycleOrdinalAfterTime :: Rule\nruleCycleOrdinalAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"after\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (n - 1) td\n      _ -> Nothing\n  }\n\nruleCycleTheOrdinalAfterTime :: Rule\nruleCycleTheOrdinalAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"after\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (n - 1) td\n      _ -> Nothing\n  }\n\nruleCycleOrdinalQuarter :: Rule\nruleCycleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleCycleTheOrdinalQuarter :: Rule\nruleCycleTheOrdinalQuarter = Rule\n  { name = \"the <ordinal> quarter\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleCycleOrdinalQuarterYear :: Rule\nruleCycleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter False TG.Quarter (n - 1) td\n      _ -> Nothing\n  }\n\nruleDurationInWithinAfter :: Rule\nruleDurationInWithinAfter = Rule\n  { name = \"in|within|after <duration>\"\n  , pattern =\n    [ regex \"(in|within|after)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       Token Duration dd:\n       _) -> case Text.toLower match of\n         \"within\" -> Token Time <$> interval TTime.Open now (inDuration dd)\n         \"after\"  -> tt $ withDirection TTime.After $ inDuration dd\n         \"in\"     -> tt $ inDuration dd\n         _        -> Nothing\n      _ -> Nothing\n  }\n\nruleDurationLastNext :: Rule\nruleDurationLastNext = Rule\n  { name = \"last|past|next <duration>\"\n  , pattern =\n    [ regex \"([lp]ast|next)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       Token Duration DurationData{TDuration.grain, TDuration.value}:\n       _) -> case Text.toLower match of\n         \"next\" -> tt $ cycleN True grain value\n         \"last\" -> tt $ cycleN True grain (- value)\n         \"past\" -> tt $ cycleN True grain (- value)\n         _      -> Nothing\n      _ -> Nothing\n  }\n\nruleNDOWago :: Rule\nruleNDOWago = Rule\n  { name = \"<integer> <named-day> ago|back\"\n  , pattern =\n    [ Predicate isNatural\n    , Predicate isADayOfWeek\n    , regex \"ago|back\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:Token Time td:_) ->\n        tt $ predNth (- (floor v)) False td\n      _ -> Nothing\n  }\n\nruleDurationHenceAgo :: Rule\nruleDurationHenceAgo = Rule\n  { name = \"<duration> hence|ago\"\n  , pattern =\n    [ dimension Duration\n    , regex \"(hence|ago)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n        \"ago\" -> tt $ durationAgo dd\n        _     -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleDayDurationHenceAgo :: Rule\nruleDayDurationHenceAgo = Rule\n  { name = \"<day> <duration> hence|ago\"\n  , pattern =\n    [ Predicate $ or . sequence [isGrainOfTime TG.Day, isGrainOfTime TG.Month]\n    , dimension Duration\n    , regex \"(from now|hence|ago)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token Duration dd:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n         \"ago\" -> Token Time <$> intersect td (durationIntervalAgo dd)\n         _     -> Token Time <$> intersect td (inDurationInterval dd)\n      _ -> Nothing\n  }\n\nruleDayInDuration :: Rule\nruleDayInDuration = Rule\n  { name = \"<day> in <duration>\"\n  , pattern =\n    [ Predicate $ or . sequence [isGrainOfTime TG.Day, isGrainOfTime TG.Month]\n    , regex \"in\"\n    , Predicate $ isDurationGreaterThan TG.Hour\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:Token Duration dd:_) ->\n        Token Time <$> intersect td (inDurationInterval dd)\n      _ -> Nothing\n  }\n\nruleInDurationAtTime :: Rule\nruleInDurationAtTime = Rule\n  { name = \"in <duration> at <time-of-day>\"\n  , pattern =\n    [ regex \"in\"\n    , Predicate $ isDurationGreaterThan TG.Hour\n    , regex \"at\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_:Token Time td:_) ->\n        Token Time <$> intersect td (inDurationInterval dd)\n      _ -> Nothing\n  }\n\nruleInNumeral :: Rule\nruleInNumeral = Rule\n  { name = \"in <number> (implicit minutes)\"\n  , pattern =\n    [ regex \"in\"\n    , Predicate $ isIntegerBetween 0 60\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        tt $ inDuration $ duration TG.Minute $ floor v\n      _ -> Nothing\n  }\n\nruleDurationAfterBeforeTime :: Rule\nruleDurationAfterBeforeTime = Rule\n  { name = \"<duration> after|before|from|past <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"(after|before|from|past)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:\n       Token RegexMatch (GroupMatch (match:_)):\n       Token Time td:\n       _) -> case Text.toLower match of\n         \"before\" -> tt $ durationBefore dd td\n         _        -> tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleIntervalForDurationFrom :: Rule\nruleIntervalForDurationFrom = Rule\n  { name = \"for <duration> from <time>\"\n  , pattern =\n    [ regex \"for\"\n    , dimension Duration\n    , regex \"(from|starting|beginning|after|starting from)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_:Token Time td1:_) ->\n        Token Time <$> interval TTime.Closed td1 (durationAfter dd td1)\n      _ -> Nothing\n}\n\nruleIntervalTimeForDuration :: Rule\nruleIntervalTimeForDuration = Rule\n  { name = \"<time> for <duration>\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"for\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Duration dd:_) ->\n        Token Time <$> interval TTime.Closed td1 (durationAfter dd td1)\n      _ -> Nothing\n}\n\nruleIntervalFromTimeForDuration :: Rule\nruleIntervalFromTimeForDuration = Rule\n  { name = \"from <time> for <duration>\"\n  , pattern =\n    [ regex \"(from|starting|beginning|after|starting from)\"\n    , Predicate isNotLatent\n    , regex \"for\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Duration dd:_) ->\n        Token Time <$> interval TTime.Closed td1 (durationAfter dd td1)\n      _ -> Nothing\n}\n\ntimezoneName :: String\ntimezoneName = \"YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT\"\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay, hasNoTimezone]\n    , regex $ \"\\\\b(\" ++ timezoneName ++ \")\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nruleTimezoneBracket :: Rule\nruleTimezoneBracket = Rule\n  { name = \"<time> (timezone)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay, hasNoTimezone]\n    , regex $ \"\\\\((\" ++ timezoneName ++ \")\\\\)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nruleIntervalDashTimezone :: Rule\nruleIntervalDashTimezone = Rule\n  { name = \"<datetime> - <datetime> (interval) timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isATimeOfDay, hasNoTimezone]\n    , regex \"\\\\-|to|th?ru|through|(un)?til(l)?\"\n    , Predicate $ and . sequence [isATimeOfDay, hasNoTimezone]\n    , regex $ \"\\\\b(\" ++ timezoneName ++ \")\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:\n       _:\n       Token Time td2:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> do\n        tdz1 <- inTimezone (Text.toUpper tz) td1\n        tdz2 <- inTimezone (Text.toUpper tz) td2\n        Token Time <$> interval TTime.Closed tdz1 tdz2\n      _ -> Nothing\n  }\n\nruleMidDay :: Rule\nruleMidDay = Rule\n  { name = \"Mid-day\"\n  , pattern =\n    [ regex \"(the )?mid(\\\\s)?day\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleUpcomingGrain :: Rule\nruleUpcomingGrain = Rule\n  { name = \"upcoming <integer> <cycle>\"\n  , pattern =\n    [ regex \"upcoming\"\n    , Predicate isNatural\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      ( _:\n        Token Numeral NumeralData{ TNumeral.value = numOfTimeGrain }:\n        Token TimeGrain grain:\n        _) -> tt $ cycleNth grain $ floor numOfTimeGrain\n      _ -> Nothing\n  }\n\nruleUpcomingGrainAlt :: Rule\nruleUpcomingGrainAlt = Rule\n  { name = \"<integer> upcoming <cycle>\"\n  , pattern =\n    [ Predicate isNatural\n    , regex \"upcoming\"\n    , dimension TimeGrain\n    ]\n  , prod = \\case\n      ( Token Numeral NumeralData{ TNumeral.value = numOfTimeGrain }:\n        _:\n        Token TimeGrain grain:\n        _) -> tt $ cycleNth grain $ floor numOfTimeGrain\n      _ -> Nothing\n  }\n\nruleMinutesToHOD :: Rule\nruleMinutesToHOD = Rule\n  { name = \"<integer> minutes to|till|before <hour-of-day>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , Predicate $ isGrain TG.Minute\n    , regex \"to|till|before|of\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleIntersect\n  , ruleIntersectOf\n  , ruleIntersectYear\n  , ruleAbsorbOnDay\n  , ruleAbsorbOnADOW\n  , ruleAbsorbInMonthYear\n  , ruleAbsorbCommaTOD\n  , ruleNextDOW\n  , ruleNextTime\n  , ruleThisTime\n  , ruleLastTime\n  , ruleTimeBeforeLastAfterNext\n  , ruleOrdinalDOWOfTime\n  , ruleLastDOWOfTime\n  , ruleLastCycleOfTime\n  , ruleLastNight\n  , ruleLastWeekendOfMonth\n  , ruleNthTimeOfTime\n  , ruleTheNthTimeOfTime\n  , ruleNthTimeAfterTime\n  , ruleTheNthTimeAfterTime\n  , ruleNDOWFromTime\n  , ruleYearLatent\n  , ruleYearADBC\n  , ruleTheDOMNumeral\n  , ruleTheDOMOrdinal\n  , ruleDOMLatent\n  , ruleNamedDOMOrdinal\n  , ruleMonthDOMNumeral\n  , ruleDOMMonth\n  , ruleDOMOfMonth\n  , ruleTheDOMOfMonth\n  , ruleDOMOrdinalMonthYear\n  , ruleDOMMonthYear\n  , ruleIdesOfMonth\n  , ruleTODLatent\n  , ruleAtTOD\n  , ruleTODOClock\n  , rulePODatTOD\n  , rulePODintersectTODlatent\n  , ruleHHMM\n  , ruleHHhMM\n  , ruleHHMMLatent\n  , ruleHHMMSS\n  , ruleMilitaryAMPM\n  , ruleTODAMPM\n  , ruleHONumeral\n  , ruleHONumeralDash\n  , ruleHONumeralAlt\n  , ruleHONumeralAltDash\n  , ruleHODHalf\n  , ruleHODQuarter\n  , ruleNumeralToHOD\n  , ruleHalfToHOD\n  , ruleQuarterToHOD\n  , ruleNumeralAfterHOD\n  , ruleHalfAfterHOD\n  , ruleQuarterAfterHOD\n  , ruleHalfHOD\n  , ruleYYYYQQ\n  , ruleYYYYMM\n  , ruleYYYYMMDD\n  , ruleMMYYYY\n  , ruleNoonMidnightEOD\n  , rulePartOfDays\n  , ruleEarlyMorning\n  , rulePODIn\n  , rulePODThis\n  , ruleTonight\n  , ruleAfterPartofday\n  , ruleTimePOD\n  , rulePODofTime\n  , ruleWeekend\n  , ruleWeek\n  , ruleTODPrecision\n  , ruleTODPOD\n  , rulePrecisionTOD\n  , ruleIntervalFromMonthDDDD\n  , ruleIntervalFromDDDDMonth\n  , ruleIntervalFromDDDDOfMonth\n  , ruleIntervalMonthDDDD\n  , ruleIntervalDDDDMonth\n  , ruleIntervalYearLatent\n  , ruleIntervalDash\n  , ruleIntervalSlash\n  , ruleIntervalFrom\n  , ruleIntervalBetween\n  , ruleIntervalTODDash\n  , ruleIntervalTODFrom\n  , ruleIntervalTODAMPM\n  , ruleIntervalTODBetween\n  , ruleIntervalBy\n  , ruleIntervalByTheEndOf\n  , ruleIntervalUntilTime\n  , ruleIntervalAfterFromSinceTime\n  , ruleCycleTheAfterBeforeTime\n  , ruleCycleThisLastNext\n  , ruleDOMOfTimeMonth\n  , ruleCycleAfterBeforeTime\n  , ruleCycleOrdinalOfTime\n  , ruleCycleLastOrdinalOfTime\n  , ruleCycleTheOrdinalOfTime\n  , ruleCycleTheLastOrdinalOfTime\n  , ruleCycleTheOfTimeGrain\n  , ruleCycleTheOfTime\n  , ruleCycleOrdinalAfterTime\n  , ruleCycleTheOrdinalAfterTime\n  , ruleCycleOrdinalQuarter\n  , ruleCycleTheOrdinalQuarter\n  , ruleCycleOrdinalQuarterYear\n  , ruleDurationInWithinAfter\n  , ruleDurationLastNext\n  , ruleNDOWago\n  , ruleDurationHenceAgo\n  , ruleDayDurationHenceAgo\n  , ruleDayInDuration\n  , ruleInDurationAtTime\n  , ruleDurationAfterBeforeTime\n  , ruleIntervalForDurationFrom\n  , ruleIntervalFromTimeForDuration\n  , ruleIntervalTimeForDuration\n  , ruleInNumeral\n  , ruleTimezone\n  , ruleTimezoneBracket\n  , ruleIntervalDashTimezone\n  , rulePartOfMonth\n  , ruleEndOrBeginningOfMonth\n  , ruleEndOrBeginningOfYear\n  , ruleEndOrBeginningOfWeek\n  , ruleNow\n  , ruleASAP\n  , ruleSeason\n  , ruleEndOfMonth\n  , ruleBeginningOfMonth\n  , ruleEndOfYear\n  , ruleBeginningOfYear\n  , ruleClosest\n  , ruleNthClosest\n  , ruleMidDay\n  , ruleUpcomingGrain\n  , ruleUpcomingGrainAlt\n  , ruleMinutesToHOD\n  ]\n  ++ ruleInstants\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n  ++ ruleSeasons\n  ++ ruleComputedHolidays\n  ++ ruleComputedHolidays'\n  ++ rulePeriodicHolidays\n", "num_lines": 2842}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.AU.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 25, 0, 0, 0) Day \"ANZAC Day\")\n             [ \"anzac day\"\n             ]\n  , examples (datetimeHoliday (2013, 9, 1, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 9, 2, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 9, 1, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeIntervalHoliday ((2020, 2, 8, 0, 0, 0), (2020, 2, 11, 0, 0, 0)) Day \"Royal Hobart Regatta\")\n             [ \"Royal Hobart Regatta 2020\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 7, 8, 0, 0, 0), (2018, 7, 16, 0, 0, 0)) Day \"NAIDOC Week\")\n             [ \"NAIDOC week 2018\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 7, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 10, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 28, 0, 0, 0) Day \"Reconciliation Day\")\n             [ \"reconciliation day 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 5, 27, 0, 0, 0) Day \"Reconciliation Day\")\n             [ \"reconciliation day 2019\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 8, 9, 0, 0, 0), (2013, 8, 19, 0, 0, 0)) Day \"Royal Queensland Show\")\n             [ \"ekka\"\n             , \"royal national agricultural show\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 15, 0, 0, 0) Day \"Royal Queensland Show Day\")\n             [ \"ekka day 2018\"\n             , \"RNA Show Day 2018\"\n             , \"Royal Queensland Show Day in five years\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 3, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"admin day\"\n             ]\n  ]\n", "num_lines": 119}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.AU.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Computed (easterSunday)\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"ANZAC Day\", \"anzac day\", monthDay 4 25 )\n  , ( \"Australia Day\", \"(ana|anniversary|australia|foundation) day\"\n    , monthDay 1 26 )\n  , ( \"Harmony Day\", \"harmony day\", monthDay 3 21 )\n  , ( \"National Sorry Day\", \"national sorry day\", monthDay 5 26 )\n  , ( \"Queensland Day\", \"queensland day\", monthDay 6 6 )\n  , ( \"Remembrance Day\", \"remembrance day\", monthDay 11 11 )\n  , ( \"Take our Daughters and Sons to Work Day\"\n    , \"take our daughters and sons to work day\", monthDay 1 5 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Adelaide Cup\", \"adelaide cup\", nthDOWOfMonth 2 1 3 )\n  , ( \"Administrative Professionals' Day\"\n    , \"(administrative professional|secretarie|admin)('?s'?)? day\"\n    , nthDOWOfMonth 1 5 5 )\n  , ( \"Canberra Day\", \"canberra day\", nthDOWOfMonth 2 1 3 )\n  , ( \"Eight Hours Day\", \"eight hours day\", nthDOWOfMonth 2 1 3 )\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 1 7 9 )\n  , ( \"Labour Day\", \"labour day\", nthDOWOfMonth 1 1 10 )\n  , ( \"Melbourne Cup Day\", \"melbourne cup day\", nthDOWOfMonth 1 2 11 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"National Close the Gap Day\", \"national close the gap day\"\n    , nthDOWOfMonth 3 4 3 )\n  , ( \"National Tree Day\", \"(arbor|national tree) day\"\n    , predLastOf (dayOfWeek 7) (month 6) )\n  , ( \"National Schools Tree Day\", \"national schools tree day\"\n    , predLastOf (dayOfWeek 5) (month 6) )\n  , ( \"New South Wales Bank Holiday\", \"new south wales bank holiday\"\n    , nthDOWOfMonth 1 1 8 )\n  , ( \"Picnic Day\", \"(northern territory )?picnic day\", nthDOWOfMonth 1 1 8 )\n  , ( \"Recreation Day\", \"recreation day\", nthDOWOfMonth 1 1 10 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  , ( \"Western Australia Day\", \"western australia day\", nthDOWOfMonth 1 1 6 )\n\n  -- Other\n  , ( \"Reconciliation Day\", \"reconciliation\\\\s+day\"\n    , predNthAfter 0 (dayOfWeek 1) (monthDay 5 26) )\n  ]\n\nrulePeriodicHolidays' :: [Rule]\nrulePeriodicHolidays' = mkRuleHolidays'\n  -- Fixed day/week/month, year over year\n  -- Week from Sunday of July until following Sunday that has the second Friday\n  [ ( \"NAIDOC Week\"\n    , \"(naidoc|national aboriginal and islander day observance committee) week\"\n    , let fri = nthDOWOfMonth 2 5 7\n          start = cycleNthAfter False TG.Day (- 5) fri\n          end = cycleNthAfter False TG.Day 2 fri\n      in interval TTime.Open start end )\n  -- 3 days ending on the second Monday of February\n  , ( \"Royal Hobart Regatta\", \"royal hobart regatta\"\n    , let end = nthDOWOfMonth 2 1 2\n      in interval TTime.Open (cycleNthAfter False TG.Day (- 2) end) end )\n\n  -- Other\n  -- Wednesday of the Royal Queensland Show\n  -- Starts on the first Friday of August if it's not before August 5th\n  -- Otherwise on the second Friday of August\n  , ( \"Royal Queensland Show Day\"\n    , \"(royal (national agricultural|queensland)|rna) show day|ekka day\"\n    , let tentative = nthDOWOfMonth 1 5 8\n          alternative = nthDOWOfMonth 2 5 8\n      in do\n        forbidden <- interval TTime.Open (monthDay 8 1) (monthDay 8 4)\n        start <- intersectWithReplacement forbidden tentative alternative\n        return $ cycleNthAfter False TG.Day 5 start )\n  -- Starts on the first Friday of August if it's not before August 5th\n  -- Otherwise on the second Friday of August\n  , ( \"Royal Queensland Show\"\n    , \"ekka|(royal (national agricultural|queensland)|rna) show\"\n    , let tentative = nthDOWOfMonth 1 5 8\n          alternative = nthDOWOfMonth 2 5 8\n      in do\n        forbidden <- interval TTime.Open (monthDay 8 1) (monthDay 8 4)\n        start <- intersectWithReplacement forbidden tentative alternative\n        interval TTime.Open start $ cycleNthAfter False TG.Day 9 start )\n  ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  [ ( \"Easter Tuesday\", \"easter\\\\s+tue(sday)?\"\n    , cycleNthAfter False TG.Day 2 easterSunday )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ ruleComputedHolidays\n  ++ rulePeriodicHolidays\n  ++ rulePeriodicHolidays'\n", "num_lines": 170}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.BZ.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 19, 0, 0, 0) Day \"Garifuna Settlement Day\")\n             [ \"garifuna settlement day\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  ]\n", "num_lines": 95}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.BZ.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Garifuna Settlement Day\", \"garifuna settlement day\", monthDay 11 19 )\n  , ( \"Labour Day\", \"labour day\", monthDay 5 1 )\n  , ( \"National Heroes and Benefactors Day\"\n    , \"national heroes and benefactors day\", monthDay 3 9 )\n  , ( \"Pan American Day\", \"pan american day\", monthDay 10 12 )\n  , ( \"St. George's Caye Day\", \"st\\\\.? george'?s caye day\", monthDay 9 10 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ rulePeriodicHolidays\n", "num_lines": 94}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.CA.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"2/15\"\n             , \"on 2/15\"\n             , \"2 / 15\"\n             , \"2-15\"\n             , \"2 - 15\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"10/31/1974\"\n             , \"10/31/74\"\n             , \"10-31-74\"\n             , \"10.31.1974\"\n             , \"10 31 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"4/25 at 4:00pm\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 14, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 10, 13, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 10, 8, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 10, 10, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 10, 9, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 7, 1, 0, 0, 0) Day \"Memorial Day\")\n             [ \"canada day\"\n             , \"memorial day\"\n             , \"dominion day\"\n             , \"Next Memorial Day\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 9, 0, 0, 0) Day \"Vimy Ridge Day\")\n             [ \"vimy ridge day\"\n             ]\n  , examples (datetimeHoliday (2013, 7, 12, 0, 0, 0) Day \"The Twelfth\")\n             [ \"the Glorious Twelfth\"\n             , \"Orangemen's Day\"\n             , \"the twelfth\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 24, 0, 0, 0) Day \"Discovery Day\")\n             [ \"discovery day\"\n             , \"next discovery  day\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 25, 0, 0, 0) Day \"Discovery Day\")\n             [ \"discovery day 2018\"\n             ]\n  , examples (datetimeHoliday (2020, 6, 22, 0, 0, 0) Day \"Discovery Day\")\n             [ \"discovery   day 2020\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 21, 0, 0, 0) Day \"Victoria Day\")\n             [ \"Victoria day 2018\"\n             , \"Sovereign's birthday 2018\"\n             ]\n  , examples (datetimeHoliday (2013, 8, 5, 0, 0, 0) Day \"Civic Holiday\")\n             [ \"Civic Holiday\"\n             , \"British Columbia Day\"\n             , \"Natal Day\"\n             , \"New Brunswick Day\"\n             , \"Saskatchewan Day\"\n             , \"Terry Fox Day\"\n             ]\n  , examples (datetimeHoliday (2018, 2, 19, 0, 0, 0) Day \"Family Day\")\n             [ \"family day 2018\"\n             , \"islander day 2018\"\n             , \"louis riel day 2018\"\n             , \"nova scotia heritage day 2018\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2017, 5, 22, 0, 0, 0) Day \"National Patriots' Day\")\n             [ \"national patriots' day 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 21, 0, 0, 0) Day \"National Patriots' Day\")\n             [ \"national patriots' day 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 5, 20, 0, 0, 0) Day \"National Patriots' Day\")\n             [ \"national patriots' day 2019\"\n             ]\n  , examples (datetimeHoliday (2013, 9, 2, 0, 0, 0) Day \"Labour Day\")\n             [ \"labor day\"\n             ]\n  , examples (datetimeHoliday (2012, 9, 3, 0, 0, 0) Day \"Labour Day\")\n             [ \"labor day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 8, 30, 18, 0, 0), (2013, 9, 3, 0, 0, 0)) Hour \"Labour Day weekend\")\n             [ \"labor day weekend\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 2, 0, 0, 0) Day \"Groundhog Day\")\n             [ \"Groundhog day\"\n             , \"groundhogs day\"\n             ]\n  , examples (datetimeHoliday (2010, 4, 21, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"administrative professionals' day 2010\"\n             ]\n  , examples (datetimeHoliday (2019, 4, 24, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"admin day 2019\"\n             , \"secretaries day in six years\"\n             ]\n  ]\n", "num_lines": 153}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.CA.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\n-- Although one can see both MMDD and DDMM in Canada,\n-- there is no direct way to implement this today. Let's fallback to MMDD (US).\nruleMMDD :: Rule\nruleMMDD = Rule\n  { name = \"mm/dd\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])\\\\s?[/-]\\\\s?(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleMMDDYYYY :: Rule\nruleMMDDYYYY = Rule\n  { name = \"mm/dd/yyyy\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])[-/\\\\s](3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleMMDDYYYYDot :: Rule\nruleMMDDYYYYDot = Rule\n  { name = \"mm.dd.yyyy\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])\\\\.(3[01]|[12]\\\\d|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Anniversary of the Statute of Westminster\", \"anniversary of the statute of westminster\", monthDay 12 11 )\n  , ( \"Memorial Day\", \"(canada|dominion|memorial) day\", monthDay 7 1 )\n  , ( \"Groundhog Day\", \"groundhogs? day\", monthDay 2 2 )\n  , ( \"Healthcare Aide Day\", \"healthcare aide day\", monthDay 10 18 )\n  , ( \"National Aboriginal Day\", \"national aboriginal day\", monthDay 6 21 )\n  , ( \"National Flag of Canada Day\", \"national flag of canada day\", monthDay 2 15 )\n  , ( \"National Tartan Day\", \"national tartan day\", monthDay 4 6 )\n  , ( \"Nunavut Day\", \"nunavut day\", monthDay 7 9 )\n  , ( \"Remembrance Day\", \"remembrance day\", monthDay 11 11 )\n  , ( \"St David's Day\", \"st\\\\.? david'?s day\", monthDay 3 1 )\n  , ( \"St. Jean Baptiste Day\", \"st\\\\.? jean baptiste day\", monthDay 6 24 )\n  , ( \"The Twelfth\", \"orangemen's day|the (glorious )?twelfth\", monthDay 7 12 )\n  , ( \"Victoria Day\", \"sovereign's birthday|victoria day\"\n    , predLastOf (dayOfWeek 1) (monthDay 5 25) )\n  , ( \"Vimy Ridge Day\", \"vimy ridge day\", monthDay 4 9 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Civic Holiday\"\n    , \"british columbia day|civic holiday|natal day|new brunswick day|Saskatchewan Day|terry fox day\"\n    , nthDOWOfMonth 1 1 8\n    )\n  , ( \"Family Day\"\n    , \"(family|islander|louis riel|nova scotia heritage) day\"\n    , nthDOWOfMonth 3 1 2 )\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Gold Cup Parade\", \"gold cup parade\", nthDOWOfMonth 3 5 8 )\n  , ( \"Heritage Day in Alberta\", \"heritage day in alberta\", nthDOWOfMonth 1 1 8 )\n  , ( \"Labour Day\", \"labou?r day\", nthDOWOfMonth 1 1 9 )\n  -- Long weekend before the first Monday of September\n  , ( \"Labour Day weekend\", \"labou?r day week(\\\\s|-)?ends?\"\n    , longWEBefore $ nthDOWOfMonth 1 1 9\n    )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"Royal St. John's Regatta\", \"regatta day|royal st\\\\.? john's regatta\"\n    , nthDOWOfMonth 1 3 8 )\n  , ( \"Take our Daughters and Sons to Work Day\"\n    , \"take our daughters and sons to work day\", nthDOWOfMonth 1 3 11 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 2 1 10 )\n  , ( \"Yukon's Discovery Day\", \"(klondike gold|yukon's) discovery day\"\n    , nthDOWOfMonth 3 1 8 )\n\n  -- Monday before May 25th\n  , ( \"National Patriots' Day\", \"national patriot'?s'? day\"\n    , predNthAfter (-1) (dayOfWeek 1) (monthDay 5 25) )\n\n  -- Closest Monday to June 24th\n  , ( \"Discovery Day\", \"discovery\\\\s+day\"\n    , predNthClosest 0 (dayOfWeek 1) (monthDay 6 24) )\n\n  -- Wednesday of the last full week of April, where a full week starts on\n  -- Sunday and ends on Saturday.\n  , ( \"Administrative Professionals' Day\"\n    , \"(administrative professional|secretarie|admin)('?s'?)? day\"\n    , cycleNthAfter False TG.Day (-3) $\n        predNthAfter (-1) (dayOfWeek 6) (monthDay 5 1)\n    )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleMMDD\n  , ruleMMDDYYYY\n  , ruleMMDDYYYYDot\n  ]\n  ++ rulePeriodicHolidays\n", "num_lines": 142}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.GB.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 5, 0, 0, 0) Day \"Guy Fawkes Day\")\n             [ \"guy fawkes day\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 27, 0, 0, 0) Day \"August Bank Holiday\")\n             [ \"august bank holiday 2018\"\n             , \"summer bank holiday 2018\"\n             , \"late summer bank holiday 2018\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 10, 0, 0, 0) Day \"Mothering Sunday\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             , \"mothering sunday\"\n             ]\n  , examples (datetimeHoliday (2012, 3, 18, 0, 0, 0) Day \"Mothering Sunday\")\n             [ \"mothers day 2012\"\n             , \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 3, 30, 0, 0, 0) Day \"Mothering Sunday\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 19, 0, 0, 0) Day \"Pentecost\")\n             [ \"whitsunday\"\n             ]\n  ]\n", "num_lines": 98}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.GB.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Computed (easterSunday)\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Bank Holiday\", \"bank holiday\", monthDay 12 28 )\n  , ( \"Battle of the Boyne\", \"battle of the boyne\", monthDay 7 12 )\n  , ( \"Burns Night\", \"burns night\", monthDay 1 25 )\n  , ( \"Guy Fawkes Day\", \"guy fawkes day\", monthDay 11 5 )\n  , ( \"Shakespeare Day\", \"shakespeare day\", monthDay 4 23 )\n  , ( \"St Andrew's Day\", \"st\\\\.? andrew'?s day\", monthDay 11 30 )\n  , ( \"St. David's Day\", \"st\\\\.? david'?s day\", monthDay 3 1 )\n  , ( \"Victory in Europe Day\", \"victory in europe day\", monthDay 5 8 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"August Bank Holiday\", \"(august|(late )?summer) bank holiday\"\n    , predLastOf (dayOfWeek 1) (month 8) )\n  , ( \"Early May Bank Holiday\", \"early may bank holiday\", nthDOWOfMonth 1 1 5 )\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Remembrance Sunday\", \"remembrance sunday\", nthDOWOfMonth 2 7 11 )\n  , ( \"Spring Bank Holiday\", \"(sprint|late may) bank holiday\"\n    , predLastOf (dayOfWeek 1) (month 5) )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  -- 3 weeks before Easter\n  [ ( \"Mothering Sunday\", \"mothering sunday|mother'?s?'? day\"\n    , cycleNthAfter False TG.Day (-21) easterSunday )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ ruleComputedHolidays\n  ++ rulePeriodicHolidays\n", "num_lines": 111}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.IE.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 6, 0, 0, 0) Day \"August Bank Holiday\")\n             [ \"august bank holiday 2018\"\n             , \"summer bank holiday 2018\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 6, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 7, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  ]\n", "num_lines": 96}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.IE.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed day/week/month, year over year\n  [ ( \"August Bank Holiday\", \"(august|summer) bank holiday\"\n    , nthDOWOfMonth 1 1 8 )\n  , ( \"Early May Bank Holiday\", \"early may bank holiday\", nthDOWOfMonth 1 1 5 )\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"June Bank Holiday\", \"june bank holiday\", nthDOWOfMonth 1 1 6 )\n  , ( \"Labour Day\", \"labour day\", nthDOWOfMonth 1 1 5 )\n  , ( \"October Bank Holiday\", \"october (bank )?holiday\"\n    , predLastOf (dayOfWeek 1) (month 10) )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ rulePeriodicHolidays\n", "num_lines": 93}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.IN.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 19, 0, 0, 0) Day \"Shivaji Jayanti\")\n             [ \"shivaji jayanti 2013\"\n             ]\n  , examples (datetimeHoliday (2013, 8, 15, 0, 0, 0) Day \"Independence Day\")\n             [ \"independence day\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeHoliday (2018, 3, 30, 0, 0, 0) Day \"Hazarat Ali's Birthday\")\n             [ \"Hazarat Ali's Birthday 2018\"\n             ]\n  , examples (datetimeHoliday (2019, 3, 20, 0, 0, 0) Day \"Hazarat Ali's Birthday\")\n             [ \"Hazarat Ali's Birthday 2019\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 5, 16, 0, 0, 0), (2018, 6, 15, 0, 0, 0)) Day \"Ramadan\")\n             [ \"ramzaan 2018\"\n             ]\n  ]\n", "num_lines": 107}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.IN.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Computed\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Guru Tegh Bahadur's Martyrdom Day\", \"guru tegh bahadur'?s martyrdom day\"\n    , monthDay 11 24 )\n  , ( \"Independence Day\", \"independence day\", monthDay 8 15 )\n  , ( \"Labour Day\", \"labour day\", monthDay 5 1 )\n  , ( \"Mahatma Gandhi Jayanti\", \"mahatma gandhi jayanti\", monthDay 10 2 )\n  , ( \"Republic Day\", \"republic day\", monthDay 1 26 )\n  , ( \"Shivaji Jayanti\", \"shivaji jayanti\", monthDay 2 19 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Friendship Day\", \"friendship day\", nthDOWOfMonth 1 7 8 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  [ ( \"Hazarat Ali's Birthday\", \"hazarat ali's birthday\"\n    , cycleNthAfter False TG.Day 12 rajab )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ ruleComputedHolidays\n  ++ rulePeriodicHolidays\n", "num_lines": 105}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.JM.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 23, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 23, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 21, 0, 0, 0) Day \"Heroes' Day\")\n             [ \"heroes' day\"\n             ]\n  ]\n", "num_lines": 95}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.JM.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Labour Day\", \"labour day\", monthDay 5 23 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Heroes' Day\", \"heroes' day\", nthDOWOfMonth 3 1 10 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ rulePeriodicHolidays\n", "num_lines": 90}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.NZ.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 25, 0, 0, 0) Day \"ANZAC Day\")\n             [ \"ANZAC day\"\n             ]\n  , examples (datetimeHoliday (2013, 9, 1, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 9, 2, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 9, 1, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday  (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 28, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 10, 22, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 17, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"admin day\"\n             ]\n  ]\n", "num_lines": 98}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.NZ.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Computed (easterSunday)\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"ANZAC Day\", \"anzac day\", monthDay 4 25 )\n  , ( \"Guy Fawkes Night\", \"guy fawkes night\", monthDay 11 5 )\n  , ( \"Waitangi Day\", \"waitangi day\", monthDay 2 6 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Administrative Professionals' Day\"\n    , \"(administrative professional|secretarie|admin)('?s'?)? day\"\n    , nthDOWOfMonth 3 3 4 )\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 1 7 9 )\n  , ( \"Labour Day\", \"labour day\", nthDOWOfMonth 4 1 10 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"Queen's birthday\", \"queen's birthday\", nthDOWOfMonth 1 1 6 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  [ ( \"Easter Tuesday\", \"easter\\\\s+tue(sday)?\"\n    , cycleNthAfter False TG.Day 2 easterSunday )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ ruleComputedHolidays\n  ++ rulePeriodicHolidays\n", "num_lines": 105}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.PH.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"2/15\"\n             , \"on 2/15\"\n             , \"2 / 15\"\n             , \"2-15\"\n             , \"2 - 15\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"10/31/1974\"\n             , \"10/31/74\"\n             , \"10-31-74\"\n             , \"10.31.1974\"\n             , \"10 31 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"4/25 at 4:00pm\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 30, 0, 0, 0) Day \"Rizal Day\")\n             [ \"Rizal day\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 12, 0, 0, 0) Day \"Independence Day\")\n             [ \"Independence day\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeHoliday (2013, 8, 26, 0, 0, 0) Day \"National Heroes' Day\")\n             [ \"national heroes' day\"\n             ]\n  ]\n", "num_lines": 97}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.PH.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\n\nruleMMDD :: Rule\nruleMMDD = Rule\n  { name = \"mm/dd\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])\\\\s?[/-]\\\\s?(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleMMDDYYYY :: Rule\nruleMMDDYYYY = Rule\n  { name = \"mm/dd/yyyy\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])[-/\\\\s](3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleMMDDYYYYDot :: Rule\nruleMMDDYYYYDot = Rule\n  { name = \"mm.dd.yyyy\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])\\\\.(3[01]|[12]\\\\d|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Arbor Day\", \"arbor day\", monthDay 6 25 )\n  , ( \"Bonifacio Day\", \"bonifacio day\", monthDay 11 30 )\n  , ( \"Independence Day\", \"independence day\", monthDay 6 12 )\n  , ( \"Labour Day\", \"labour day\", monthDay 5 1 )\n  , ( \"Ninoy Aquino Day\", \"ninoy aquino day\", monthDay 8 21 )\n  , ( \"People Power Anniversary\", \"(edsa revolution|people power) anniversary\"\n    , monthDay 2 25 )\n  , ( \"Rizal Day\", \"rizal day\", monthDay 12 30 )\n  , ( \"The Day of Valor\", \"the day of valor\", monthDay 4 9 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"National Elections Day\", \"national elections day\", nthDOWOfMonth 2 1 5 )\n  , ( \"National Heroes' Day\", \"(national )?heroes' day\"\n    , predLastOf (dayOfWeek 1) (month 8) )\n  , ( \"Parents' Day\", \"parents' day\", nthDOWOfMonth 1 1 12 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleMMDD\n  , ruleMMDDYYYY\n  , ruleMMDDYYYYDot\n  ]\n  ++ rulePeriodicHolidays\n", "num_lines": 101}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.TT.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/2\"\n             , \"on 15/2\"\n             , \"15 / 2\"\n             , \"15-2\"\n             , \"15 - 2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 at 4:00pm\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"10/10\"\n             , \"10/10/2013\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 30, 0, 0, 0) Day \"Indian Arrival Day\")\n             [ \"Indian arrival day\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 19, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 19, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeHoliday (2017, 9, 30, 0, 0, 0) Day \"Hosay\")\n             [ \"hosay 2017\"\n             ]\n  ]\n", "num_lines": 97}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.TT.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Computed\nimport Duckling.Time.Helpers\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDDMM :: Rule\nruleDDMM = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Indian Arrival Day\", \"indian arrival day\", monthDay 5 30 )\n  , ( \"Labour Day\", \"labour day\", monthDay 6 19 )\n  , ( \"Spiritual Baptist Liberation Day\", \"spiritual baptist liberation day\", monthDay 3 30 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  [ ( \"Hosay\", \"hosay\", cycleNthAfter False TG.Day 9 muharram )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleDDMM\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ ruleComputedHolidays\n  ++ rulePeriodicHolidays\n", "num_lines": 98}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.US.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"2/15\"\n             , \"on 2/15\"\n             , \"2 / 15\"\n             , \"2-15\"\n             , \"2 - 15\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"10/31/1974\"\n             , \"10/31/74\"\n             , \"10-31-74\"\n             , \"10.31.1974\"\n             , \"10 31 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"4/25 at 4:00pm\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 26, 0, 0, 0) Day \"Cyber Monday\")\n             [ \"last cyber monday\"\n             , \"cyber monday 2012\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 27, 0, 0, 0) Day \"Cyber Monday\")\n             [ \"cyber monday 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 27, 0, 0, 0) Day \"Memorial Day\")\n             [ \"memorial day\"\n             , \"Next Memorial Day\"\n             , \"decoration day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 28, 0, 0, 0) Day \"Memorial Day\")\n             [ \"last memorial day\"\n             , \"memorial day of last year\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 5, 24, 18, 0, 0), (2013, 5, 28, 0, 0, 0)) Hour \"Memorial Day weekend\")\n             [ \"memorial day week-end\"\n             ]\n  , examples (datetimeHoliday (2013, 7, 4, 0, 0, 0) Day \"Independence Day\")\n             [ \"independence day\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 11, 0, 0, 0) Day \"Veterans Day\")\n             [ \"veterans day\"\n             , \"veteran day\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 1, 0, 0, 0) Day \"Loyalty Day\")\n             [ \"law day\"\n             , \"Lei Day\"\n             , \"loyalty day\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 18, 0, 0, 0) Day \"President's Day\")\n             [ \"George Washington Day\"\n             , \"washington's birthday\"\n             , \"presidents' day\"\n             , \"president day 2013\"\n             , \"Daisy Gatson Bates Day\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 12, 0, 0, 0) Day \"Lincoln's Birthday\")\n             [ \"Lincolns birthday\"\n             , \"Abraham Lincoln's birthday\"\n             , \"Lincoln birthday\"\n             , \"Lincolns' birthday\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2019, 9, 8, 0, 0, 0) Day \"National Grandparents Day\")\n             [ \"national grandparents day 2019\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 11, 0, 0, 0) Day \"Military Spouse Day\")\n             [ \"Military Spouse day 2018\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 9, 2, 0, 0, 0) Day \"Labor Day\")\n             [ \"labor day\"\n             ]\n  , examples (datetimeHoliday (2012, 9, 3, 0, 0, 0) Day \"Labor Day\")\n             [ \"labor day of last year\"\n             , \"Labor Day 2012\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 8, 30, 18, 0, 0), (2013, 9, 3, 0, 0, 0)) Hour \"Labor Day weekend\")\n             [ \"labor day weekend\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 2, 0, 0, 0) Day \"Groundhog Day\")\n             [ \"Groundhog day\"\n             , \"groundhogs day\"\n             ]\n  , examples (datetimeHoliday (2011, 4, 15, 0, 0, 0) Day \"Emancipation Day\")\n             [ \"emancipation day 2011\"\n             ]\n  , examples (datetimeHoliday (2012, 4, 16, 0, 0, 0) Day \"Emancipation Day\")\n             [ \"emancipation day 2012\"\n             ]\n  , examples (datetimeHoliday (2017, 4, 17, 0, 0, 0) Day \"Emancipation Day\")\n             [ \"emancipation day 2017\"\n             ]\n  , examples (datetimeHoliday (2011, 4, 18, 0, 0, 0) Day \"Tax Day\")\n             [ \"tax day 2011\"\n             , \"tax day two years ago\"\n             ]\n  , examples (datetimeHoliday (2012, 4, 17, 0, 0, 0) Day \"Tax Day\")\n             [ \"tax day 2012\"\n             , \"tax day last year\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 15, 0, 0, 0) Day \"Tax Day\")\n             [ \"next tax day\"\n             , \"tax day 2013\"\n             ]\n  , examples (datetimeHoliday (2017, 4, 18, 0, 0, 0) Day \"Tax Day\")\n             [ \"tax day 2017\"\n             , \"tax day in 4 years\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 10, 0, 0, 0) Day \"Siblings Day\")\n             [ \"siblings day\"\n             , \"national sibling day\"\n             ]\n  , examples (datetimeHoliday (2016, 4, 27, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"administrative professionals' day 2016\"\n             , \"administrative professionals day 2016\"\n             , \"administrative professional day 2016\"\n             , \"administrative professional's day of 2016\"\n             , \"secretaries' day 2016\"\n             , \"admins day 2016\"\n             ]\n  , examples (datetimeHoliday (2010, 4, 21, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"administrative professionals' day 2010\"\n             ]\n  , examples (datetimeHoliday (2019, 4, 24, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"administrative professionals' day 2019\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 4, 26, 0, 0, 0), (2013, 4, 29, 0, 0, 0)) Day \"Global Youth Service Day\")\n             [ \"national youth service day\"\n             ]\n  , examples (datetimeIntervalHoliday ((2018, 5, 20, 0, 0, 0), (2018, 5, 27, 0, 0, 0)) Day \"Emergency Medical Services Week\")\n             [ \"ems week 2018\"\n             ]\n  , examples (datetimeHoliday (2018, 5, 23, 0, 0, 0) Day \"Emergency Medical Services for Children Day\")\n             [ \"emsc day 2018\"\n             ]\n  , examples (datetimeHoliday (2017, 3, 12, 0, 0, 0) Day \"Daylight Saving Start Day\")\n             [ \"daylight saving start day 2017\"\n             , \"daylight saving start 2017\"\n             , \"daylight savings start day 2017\"\n             , \"daylight savings start 2017\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 5, 0, 0, 0) Day \"Daylight Saving End Day\")\n             [ \"daylight saving end day 2017\"\n             , \"daylight saving end 2017\"\n             , \"daylight savings end day 2017\"\n             , \"daylight savings end 2017\"\n             ]\n  , examples (datetimeHoliday (2008, 2, 5, 0, 0, 0) Day \"Super Tuesday\")\n             [ \"super tuesday 2008\"\n             , \"giga Tuesday\"\n             , \"mega giga Tuesday\"\n             , \"Tsunami Tuesday in 2008\"\n             , \"Super Duper Tuesday\"\n             ]\n  , examples (datetimeHoliday (2012, 3, 6, 0, 0, 0) Day \"Super Tuesday\")\n             [ \"super tuesday 2012\"\n             , \"last super tuesday\"\n             , \"super tuesday last year\"\n             , \"the second closest super tuesday to the third Sunday of 2015\"\n             ]\n  , examples (datetimeHoliday (2016, 3, 1, 0, 0, 0) Day \"Super Tuesday\")\n             [ \"super tuesday 2016\"\n             , \"next super tuesday\"\n             , \"super tuesday\"\n             ]\n  , examples (datetimeHoliday (2020, 3, 3, 0, 0, 0) Day \"Super Tuesday\")\n             [ \"super tuesday 2020\"\n             , \"super tuesday in seven years\"\n             , \"the first super tue. after 2019\"\n             , \"the 2nd Super Tuesday after next year\"\n             , \"the closest super tuesday to 2019\"\n             , \"the closest super tuesday to March 6, 2019\"\n             ]\n  , examples (datetimeHoliday (2004, 2, 3, 0, 0, 0) Day \"Mini-Tuesday\")\n             [ \"mini-tuesday\"\n             , \"Mini - Tuesday 2004\"\n             , \"mini tuesday nine yrs ago\"\n             ]\n  , examples (datetimeHoliday (2004, 3, 2, 0, 0, 0) Day \"Super Tuesday\")\n             [ \"the closest super tuesday to mini-tuesday\"\n             ]\n  , examples (datetimeHoliday (2000, 3, 7, 0, 0, 0) Day \"Super Tuesday\")\n             [ \"the second closest super tuesday to mini-tuesday\"\n             ]\n  , examples (datetimeHoliday (2008, 2, 5, 0, 0, 0) Day \"Super Tuesday\")\n             [ \"the 3rd closest super tuesday to mini-tuesday\"\n             , \"the first closest Super Tuesday to tax day 2006\"\n             ]\n  ]\n", "num_lines": 249}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.US.Rules where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Computed\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleMMDD :: Rule\nruleMMDD = Rule\n  { name = \"mm/dd\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])\\\\s?[/-]\\\\s?(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleMMDDYYYY :: Rule\nruleMMDDYYYY = Rule\n  { name = \"mm/dd/yyyy\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])[-/\\\\s](3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleMMDDYYYYDot :: Rule\nruleMMDDYYYYDot = Rule\n  { name = \"mm.dd.yyyy\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])\\\\.(3[01]|[12]\\\\d|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleBackwardCompatibleHolidays :: [Rule]\nruleBackwardCompatibleHolidays = mkRuleHolidays\n  [ (\"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11)\n  , (\"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6)\n  ]\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"African Liberation Day\", \"african liberation day\", monthDay 5 25 )\n  , ( \"Air Force Birthday\", \"air force birthday\", monthDay 9 18 )\n  , ( \"Alaska Day\", \"alaska day\", monthDay 10 18 )\n  , ( \"American Eagle Day\", \"american eagle day\", monthDay 6 20 )\n  , ( \"Army Birthday\", \"army birthday\", monthDay 6 14 )\n  , ( \"Bennington Battle Day\", \"bennington battle day\", monthDay 8 16 )\n  , ( \"Bunker Hill Day\", \"bunker hill day\", monthDay 6 17 )\n  , ( \"California Admission Day\", \"california admission day\", monthDay 9 9 )\n  , ( \"Cinco de Mayo\", \"cinco de mayo\", monthDay 5 5 )\n  , ( \"Citizenship Day\", \"citizenship day|i am an american day\", monthDay 9 17 )\n  , ( \"Coast Guard Birthday\", \"coast guard (birth)?day\", monthDay 8 4 )\n  , ( \"Colorado Day\", \"colorado day\", monthDay 8 1 )\n  , ( \"Constitution Day and Citizenship Day\", \"constitution day and citizenship day\", monthDay 9 17 )\n  , ( \"C\u00c3\u00a9sar Ch\u00c3\u00a1vez Day\", \"c[\u00c3\u00a9e]sar ch[\u00c3\u00a1a]vez day\", monthDay 3 31 )\n  , ( \"D-Day\", \"d\\\\-day\", monthDay 6 6 )\n  , ( \"Day After Christmas Day\", \"day after christmas day\", monthDay 12 26 )\n  , ( \"Elizabeth Peratrovich Day\", \"elizabeth peratrovich day\", monthDay 2 16 )\n  , ( \"Evacuation Day\", \"evacuation day\", monthDay 3 17 )\n  , ( \"Father Damien Day\", \"father damien day\", monthDay 4 15 )\n  , ( \"Feast of Our Lady of Guadalupe\", \"feast of our lady of guadalupe\", monthDay 12 12 )\n  , ( \"Flag Day\", \"flag day\", monthDay 6 14 )\n  , ( \"Groundhog Day\", \"groundhogs? day\", monthDay 2 2 )\n  , ( \"Harvey Milk Day\", \"harvey milk day\", monthDay 5 22 )\n  , ( \"Inauguration Day\", \"inauguration day\", monthDay 1 20 )\n  , ( \"Independence Day\", \"independence day\", monthDay 7 4 )\n  , ( \"Juneteenth\", \"juneteenth\", monthDay 6 19 )\n  , ( \"Kamehameha Day\", \"kamehameha day\", monthDay 6 11 )\n  , ( \"Kansas Day\", \"kansas day\", monthDay 1 29 )\n  , ( \"Kent State Shootings Remembrance\", \"kent state shootings remembrance\", monthDay 5 4 )\n  , ( \"Loyalty Day\", \"l(aw|ei|oyalty) day\", monthDay 5 1 )\n  , ( \"Leif Erikson Day\", \"leif erikson day\", monthDay 10 9 )\n  , ( \"Lincoln's Birthday\", \"(abraham )?lincoln'?s?'? birthday\", monthDay 2 12 )\n  , ( \"Linus Pauling Day\", \"linus pauling day\", monthDay 2 28 )\n  , ( \"Lyndon Baines Johnson Day\", \"lyndon baines johnson day\", monthDay 8 27 )\n  , ( \"Marine Corps Birthday\", \"marine corps (birth)?day\", monthDay 11 10 )\n  , ( \"Maryland Day\", \"maryland day\", monthDay 3 25 )\n  , ( \"National Aviation Day\", \"national aviation day\", monthDay 8 19 )\n  , ( \"National Freedom Day\", \"national freedom day\", monthDay 2 1 )\n  , ( \"National Guard Birthday\", \"national guard (birth)?day\", monthDay 12 13 )\n  , ( \"National Korean War Veterans Armistice Day\", \"national korean war veterans armistice day\", monthDay 7 27 )\n  , ( \"National Maritime Day\", \"national maritime day\", monthDay 5 22 )\n  , ( \"National Missing Children's Day\", \"national missing children'?s day\", monthDay 5 25 )\n  , ( \"National Nurses Day\", \"national nurses day\", monthDay 5 6 )\n  , ( \"National Tartan Day\", \"national tartan day\", monthDay 4 6 )\n  , ( \"Navy Birthday\", \"(u\\\\.?s\\\\.? )?navy (birth)?day\", monthDay 10 13 )\n  , ( \"Oklahoma Day\", \"oklahoma day\", monthDay 4 22 )\n  , ( \"Pan American Aviation Day\", \"pan american aviation day\", monthDay 12 17 )\n  , ( \"Pascua Florida Day\", \"pascua florida day\", monthDay 4 2 )\n  , ( \"Patriot Day\", \"patriot day\", monthDay 9 11 )\n  , ( \"Peace Officers Memorial Day\", \"peace officers memorial day\", monthDay 5 15 )\n  , ( \"Pearl Harbor Remembrance Day\", \"pearl harbor remembrance day\", monthDay 12 7 )\n  , ( \"Pioneer Day\", \"pioneer day\", monthDay 7 24 )\n  , ( \"Prince Jonah Kuhio Kalanianaole Day\", \"prince jonah kuhio kalanianaole day\", monthDay 3 26 )\n  , ( \"Purple Heart Day\", \"purple heart day\", monthDay 8 7 )\n  , ( \"Read Across America Day\", \"read across america day\", monthDay 3 2 )\n  , ( \"Rhode Island Independence Day\", \"rhode island independence day\", monthDay 5 4 )\n  , ( \"Rosa Parks Day\", \"rosa parks day\", monthDay 2 4 )\n  , ( \"San Jacinto Day\", \"san jacinto day\", monthDay 4 21 )\n  , ( \"Self-Injury Awareness Day\", \"self\\\\-injury awareness day\", monthDay 3 1 )\n  , ( \"Senior Citizens Day\", \"senior citizens day\", monthDay 8 21 )\n  , ( \"Siblings Day\", \"(national )?sibling'?s?'? day\", monthDay 4 10 )\n  , ( \"St Nicholas' Day\", \"st\\\\.? nicholas'? day\", monthDay 12 6 )\n  , ( \"St. David's Day\", \"st\\\\.? david'?s day\", monthDay 3 1 )\n  , ( \"Statehood Day\", \"statehood day\", monthDay 6 1 )\n  , ( \"Statehood Day in Arizona\", \"statehood day in arizona\", monthDay 2 14 )\n  , ( \"Stephen Foster Memorial Day\", \"stephen foster memorial day\", monthDay 1 13 )\n  , ( \"Susan B Anthony's Birthday\", \"susan b\\\\.? anthony'?s birthday\", monthDay 2 15 )\n  , ( \"Texas Independence Day\", \"texas independence day\", monthDay 3 2 )\n  , ( \"Thomas Jefferson's Birthday\", \"thomas jefferson'?s birthday\", monthDay 4 13 )\n  , ( \"Truman Day\", \"truman day\", monthDay 5 8 )\n  , ( \"Veterans Day\", \"veterans? day\", monthDay 11 11 )\n  , ( \"West Virginia Day\", \"west virginia day\", monthDay 6 20 )\n  , ( \"White Cane Safety Day\", \"white cane safety day\", monthDay 10 15 )\n  , ( \"Women's Equality Day\", \"women'?s equality day\", monthDay 8 26 )\n  , ( \"Wright Brothers Day\", \"wright brothers day\", monthDay 12 17 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Arbor Day\", \"arbor day\", predLastOf (dayOfWeek 5) (month 4) )\n  , ( \"Armed Forces Day\", \"armed forces day\", nthDOWOfMonth 3 6 5 )\n  , ( \"Casimir Pulaski Day\", \"casimir pulaski day\", nthDOWOfMonth 1 1 3 )\n  , ( \"Child Health Day\", \"child health day\", nthDOWOfMonth 1 1 10 )\n  , ( \"Columbus Day\", \"columbus day\", nthDOWOfMonth 2 1 10 )\n  , ( \"Daylight Saving Start Day\", \"daylight savings? start( day)?\", nthDOWOfMonth 2 7 3 )\n  , ( \"Daylight Saving End Day\", \"daylight savings? end( day)?\", nthDOWOfMonth 1 7 11 )\n\n  -- Saturday after Labor Day\n  , ( \"Carl Garner Federal Lands Cleanup Day\"\n    , \"carl garner federal lands cleanup day\"\n    , cycleNthAfter False TG.Day 5 $ nthDOWOfMonth 1 1 9 )\n  -- Monday after Thanksgiving\n  , ( \"Cyber Monday\", \"cyber monday\"\n    , cycleNthAfter False TG.Day 4 $ nthDOWOfMonth 4 4 11 )\n  , ( \"Election Day\", \"election day\"\n    , cycleNthAfter False TG.Day 1 $ nthDOWOfMonth 1 1 11 )\n  , ( \"Employee Appreciation Day\", \"employee appreciation day\"\n    , nthDOWOfMonth 1 5 3 )\n  , ( \"Friendship Day\", \"friendship day\", nthDOWOfMonth 1 7 8 )\n  , ( \"Gold Star Mother's Day\", \"gold star mother's day\"\n    , predLastOf (dayOfWeek 7) (month 9) )\n  , ( \"Indigenous People's Day\", \"indigenous people's day\"\n    , nthDOWOfMonth 2 1 10 )\n  , ( \"Labor Day\", \"labor day\", nthDOWOfMonth 1 1 9 )\n  -- Long weekend before the first Monday of September\n  , ( \"Labor Day weekend\", \"labor day week(\\\\s|-)?ends?\"\n    , longWEBefore $ nthDOWOfMonth 1 1 9\n    )\n  , ( \"Lee Jackson Day\", \"lee jackson day\", nthDOWOfMonth 2 5 1 )\n  -- Last Monday of May\n  , ( \"Memorial Day\", \"(decoration|memorial) day\"\n    , predLastOf (dayOfWeek 1) (month 5) )\n  -- Long weekend before the last Monday of May\n  , ( \"Memorial Day weekend\", \"(decoration|memorial) day week(\\\\s|-)?ends?\"\n    , longWEBefore $ predLastOf (dayOfWeek 1) (month 5) )\n  -- 2 days before Mother's Day\n  , ( \"Military Spouse Day\", \"military spouse (appreciation )?day\"\n    , cycleNthAfter False TG.Day (- 2) $ nthDOWOfMonth 2 7 5 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"National CleanUp Day\", \"national clean\\\\-?up day\", nthDOWOfMonth 3 6 9 )\n  , ( \"National Day of Prayer\", \"national day of prayer\", nthDOWOfMonth 1 4 5 )\n  , ( \"National Defense Transportation Day\"\n    , \"national defense transportation day\"\n    , nthDOWOfMonth 3 5 5 )\n  , ( \"National Explosive Ordnance Disposal Day\"\n    , \"national (eod|explosive ordnance disosal) day\"\n    , nthDOWOfMonth 1 6 5 )\n  -- First Sunday after Labor Day\n  , ( \"National Grandparents Day\", \"national grandparents day\"\n    , cycleNthAfter False TG.Day 6 $ nthDOWOfMonth 1 1 9 )\n  , ( \"National POW/MIA Recognition Day\", \"national pow/mia recognition day\"\n    , nthDOWOfMonth 3 5 9 )\n  , ( \"National Wear Red Day\", \"national wear red day\", nthDOWOfMonth 1 5 2 )\n  -- Day after Thanksgiving\n  , ( \"Native American Heritage Day\"\n    , \"(american indian|native american) heritage day\"\n    , cycleNthAfter False TG.Day 1 $ nthDOWOfMonth 4 4 11 )\n  , ( \"Native Americans' Day\", \"native americans' day\", nthDOWOfMonth 4 1 9 )\n  , ( \"Nevada Day\", \"nevada day\", predLastOf (dayOfWeek 5) (month 10) )\n  , ( \"Parents' Day\", \"parents' day\", nthDOWOfMonth 4 7 7 )\n  , ( \"Patriots' Day\", \"patriot'?s'? day\", nthDOWOfMonth 3 1 4 )\n  , ( \"Robert E. Lee Day\", \"robert e\\\\. lee day|lee's (birth)?day\"\n    , nthDOWOfMonth 3 1 1 )\n  , ( \"Seward's Day\", \"seward's day\", predLastOf (dayOfWeek 1) (month 3) )\n  , ( \"Statehood Day\", \"(admission|statehood) day\", nthDOWOfMonth 3 5 8 )\n  , ( \"Sweetest Day\", \"sweetest day\", nthDOWOfMonth 3 6 10 )\n  , ( \"Take our Daughters and Sons to Work Day\"\n    , \"take our daughters and sons to work day\", nthDOWOfMonth 4 4 4 )\n  , ( \"Town Meeting Day\", \"town meeting day\", nthDOWOfMonth 1 2 3 )\n  , ( \"Victory Day\", \"victory day\", nthDOWOfMonth 2 1 8 )\n  , ( \"President's Day\"\n    , \"(george )?washington'?s? (birth)?day|president'?s?'? day|daisy gatson bates'? day\"\n    , nthDOWOfMonth 3 1 2\n    )\n\n  -- Wednesday of the last full week of April, where a full week starts on\n  -- Sunday and ends on Saturday.\n  , ( \"Administrative Professionals' Day\"\n    , \"(administrative professional|secretarie|admin)('?s'?)? day\"\n    , cycleNthAfter False TG.Day (-3) $\n        predNthAfter (-1) (dayOfWeek 6) (monthDay 5 1) )\n  -- Wednesday of the 3rd full week in May, starting on a Sunday\n  , ( \"Emergency Medical Services for Children Day\"\n    , \"(national )?(emsc|emergency medical services for children) day\"\n    , cycleNthAfter False TG.Day 3 $ predNthAfter 2 (dayOfWeek 7) (monthDay 5 1)\n    )\n\n  -- Other\n  , ( \"Emancipation Day\", \"emancipation day\"\n    , predNthClosest 0 weekday $ monthDay 4 16 )\n  ]\n\nrulePeriodicHolidays' :: [Rule]\nrulePeriodicHolidays' = mkRuleHolidays'\n  -- Fixed dates, year over year\n  [ ( \"Kwanzaa\", \"kwanzaa\", interval TTime.Open (monthDay 12 26) (monthDay 1 1) )\n\n  -- 3rd full week in May, starting on a Sunday\n  , ( \"Emergency Medical Services Week\"\n    , \"(national )?(ems|emergency medical services) week\"\n    , let start = predNthAfter 2 (dayOfWeek 7) (monthDay 5 1)\n          end = cycleNthAfter False TG.Day 6 start\n      in interval TTime.Open start end )\n\n  -- Other\n  -- First weekday on or after April 15 if different than Emancipation Day\n  -- Otherwise, first weekday following Emancipation Day\n  , ( \"Tax Day\", \"tax day\"\n    , let emancipationDay = predNthClosest 0 weekday $ monthDay 4 16\n          tentative = predNthAfter 0 weekday $ monthDay 4 15\n          alternative = predNthAfter 1 weekday emancipationDay\n      in intersectWithReplacement emancipationDay tentative alternative )\n  ]\n\n-- duplicating \"Tuesday\" regex as we lost the internal info\ntuesday :: String\ntuesday = \"(tuesdays?|tue?\\\\.?)\"\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays = mkRuleHolidays\n  [ ( \"Super Tuesday\", \"super\\\\s+\" ++ tuesday, superTuesday )\n  , ( \"Mini-Tuesday\"\n    , \"mini(\\\\s*\\\\-\\\\s*|\\\\s+)\" ++ tuesday\n    , yearMonthDay 2004 2 3\n    )\n  , ( \"Super Tuesday\"\n    , \"((mega\\\\s+)?giga|tsunami|super\\\\s+duper)\\\\s+\" ++ tuesday\n    , yearMonthDay 2008 2 5\n    )\n  ]\n\nruleComputedHolidays' :: [Rule]\nruleComputedHolidays' = mkRuleHolidays'\n  [ ( \"Global Youth Service Day\", \"national youth service day\"\n    , let start = globalYouthServiceDay\n          end = cycleNthAfter False TG.Day 2 globalYouthServiceDay\n        in interval TTime.Open start end )\n  ]\n\nrulesBackwardCompatible :: [Rule]\nrulesBackwardCompatible =\n  [ ruleMMDD\n  , ruleMMDDYYYY\n  , ruleMMDDYYYYDot\n  ]\n  ++ ruleBackwardCompatibleHolidays\n\nrules :: [Rule]\nrules = rulesBackwardCompatible\n  ++ ruleComputedHolidays\n  ++ ruleComputedHolidays'\n  ++ rulePeriodicHolidays\n  ++ rulePeriodicHolidays'\n", "num_lines": 312}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.ZA.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"2/15\"\n             , \"on 2/15\"\n             , \"2 / 15\"\n             , \"2-15\"\n             , \"2 - 15\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.1974\"\n             , \"31 10 1974\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"4/25 at 4:00pm\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving day\"\n             , \"thanksgiving\"\n             , \"thanksgiving 2013\"\n             , \"this thanksgiving\"\n             , \"next thanksgiving day\"\n             ]\n  , examples (datetimeHoliday (2014, 11, 27, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving of next year\"\n             , \"thanksgiving 2014\"\n             ]\n  , examples (datetimeHoliday (2012, 11, 22, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"last thanksgiving\"\n             , \"thanksgiving day 2012\"\n             ]\n  , examples (datetimeHoliday (2016, 11, 24, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2016\"\n             ]\n  , examples (datetimeHoliday (2017, 11, 23, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"thanksgiving 2017\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 16, 0, 0, 0) Day \"Day of Reconciliation\")\n             [ \"day of the vow\"\n             , \"day of reconciliation\"\n             , \"day of the covenant\"\n             ]\n  , examples (datetimeIntervalHoliday ((2013, 9, 1, 0, 0, 0), (2013, 9, 8, 0, 0, 0)) Day \"National Arbor Week\")\n             [ \"national arbor week\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"Father's Day\"\n             ]\n  , examples (datetimeHoliday (2012, 6, 17, 0, 0, 0) Day \"Father's Day\")\n             [ \"last fathers day\"\n             ]\n  , examples (datetimeHoliday (1996, 6, 16, 0, 0, 0) Day \"Father's Day\")\n             [ \"fathers day 1996\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Mother's Day\"\n             , \"next mothers day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 13, 0, 0, 0) Day \"Mother's Day\")\n             [ \"last mothers day\"\n             ]\n  , examples (datetimeHoliday (2014, 5, 11, 0, 0, 0) Day \"Mother's Day\")\n             [ \"mothers day 2014\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day\"\n             ]\n  , examples (datetimeHoliday (2012, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"labour day of last year\"\n             , \"Labour Day 2012\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 10, 0, 0, 0) Day \"Heroes' Day\")\n             [ \"heroes' day\"\n             , \"kruger day\"\n             ]\n  , examples (datetimeHoliday (2013, 9, 4, 0, 0, 0) Day \"Administrative Professionals' Day\")\n             [ \"admin day\"\n             ]\n  ]\n", "num_lines": 103}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.EN.ZA.Rules\n  ( rules\n  ) where\n\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.Time.Types as TTime\n\nruleMMDD :: Rule\nruleMMDD = Rule\n  { name = \"mm/dd\"\n  , pattern =\n    [ regex \"(1[0-2]|0?[1-9])\\\\s?[/-]\\\\s?(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDMMYYYY :: Rule\nruleDDMMYYYY = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/\\\\s](1[0-2]|0?[1-9])[-/\\\\s](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\n-- Clashes with HHMMSS, hence only 4-digit years\nruleDDMMYYYYDot :: Rule\nruleDDMMYYYYDot = Rule\n  { name = \"dd.mm.yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\.(1[0-2]|0?[1-9])\\\\.(\\\\d{4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Day of Goodwill\", \"day of goodwill\", monthDay 12 26 )\n  , ( \"Day of Reconciliation\", \"day of( the)? (covenant|reconciliation|vow)\", monthDay 12 16 )\n  , ( \"Heritage Day\", \"heritage day\", monthDay 9 24 )\n  , ( \"Heroes' Day\", \"(heroes'|kruger) day\", monthDay 10 10 )\n  , ( \"Labour Day\", \"labour day\", monthDay 5 1 )\n  , ( \"National Women's Day\", \"national women'?s day\", monthDay 8 9 )\n  , ( \"Workers' Day\", \"workers'? day\", monthDay 5 1 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Administrative Professionals' Day\"\n    , \"(administrative professional|secretarie|admin)('?s'?)? day\"\n    , nthDOWOfMonth 1 3 9 )\n  , ( \"Father's Day\", \"father'?s?'? day\", nthDOWOfMonth 3 7 6 )\n  , ( \"Mother's Day\", \"mother'?s?'? day\", nthDOWOfMonth 2 7 5 )\n  , ( \"Thanksgiving Day\", \"thanks?giving( day)?\", nthDOWOfMonth 4 4 11 )\n  ]\n\nrulePeriodicHolidays' :: [Rule]\nrulePeriodicHolidays' = mkRuleHolidays'\n  -- Fixed dates, year over year\n  [ ( \"National Arbor Week\", \"national arbor week\"\n    , interval TTime.Open (monthDay 9 1) (monthDay 9 7) )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleMMDD\n  , ruleDDMMYYYY\n  , ruleDDMMYYYYDot\n  ]\n  ++ rulePeriodicHolidays\n  ++ rulePeriodicHolidays'\n", "num_lines": 107}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.FR.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, examples)\n  where\n    examples =\n      [ \"Ana a un court de tennis\"\n      , \"deux trois\"\n      , \"deux trois minutes\"\n      , \"74\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"maintenant\"\n             , \"tout de suite\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"aujourd'hui\"\n             , \"ce jour\"\n             , \"dans la journ\u00c3\u00a9e\"\n             , \"en ce moment\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"hier\"\n             , \"le jour d'avant\"\n             , \"le jour pr\u00c3\u00a9c\u00c3\u00a9dent\"\n             , \"la veille\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"avant-hier\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"demain\"\n             , \"jour suivant\"\n             , \"le jour d'apr\u00c3\u00a8s\"\n             , \"le lendemain\"\n             , \"un jour apr\u00c3\u00a8s\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"apr\u00c3\u00a8s-demain\"\n             , \"le lendemain du 13 f\u00c3\u00a9vrier\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"lundi\"\n             , \"lun.\"\n             , \"ce lundi\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"lundi 18 f\u00c3\u00a9vrier\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"mardi\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"mercredi 13 f\u00c3\u00a9vrier\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"jeudi\"\n             , \"deux jours plus tard\"\n             , \"deux jours apr\u00c3\u00a8s\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"vendredi\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"samedi\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"dimanche\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"le 1er mars\"\n             , \"premier mars\"\n             , \"le 1 mars\"\n             , \"vendredi 1er mars\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"le premier mars 2013\"\n             , \"1/3/2013\"\n             , \"2013-03-01\"\n             ]\n  , examples (datetime (2013, 3, 2, 0, 0, 0) Day)\n             [ \"le 2 mars\"\n             , \"2 mars\"\n             , \"le 2/3\"\n             ]\n  , examples (datetime (2013, 7, 5, 0, 0, 0) Day)\n             [ \"le 5 juillet\"\n             , \"5 juillet\"\n             , \"5 juil\"\n             , \"5 jui\"\n             , \"5 juil.\"\n             , \"5 jui.\"\n             ]\n  , examples (datetime (2013, 3, 2, 5, 0, 0) Hour)\n             [ \"le 2 mars \u00c3\u00a0 5h\"\n             , \"2 mars \u00c3\u00a0 5h\"\n             , \"le 2/3 \u00c3\u00a0 5h\"\n             , \"le 2 mars \u00c3\u00a0 5h du matin\"\n             , \"le 2 mars vers 5h\"\n             , \"2 mars vers 5h\"\n             , \"2 mars \u00c3\u00a0 environ 5h\"\n             , \"2 mars aux alentours de 5h\"\n             , \"2 mars autour de 5h\"\n             , \"le 2/3 vers 5h\"\n             ]\n  , examples (datetime (2013, 3, 2, 0, 0, 0) Day)\n             [ \"le 2\"\n             ]\n  , examples (datetime (2013, 3, 2, 5, 0, 0) Hour)\n             [ \"le 2 \u00c3\u00a0 5h\"\n             , \"le 2 vers 5h\"\n             , \"le 2 \u00c3\u00a0 5h du mat\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"le 3 mars\"\n             , \"3 mars\"\n             , \"le 3/3\"\n             ]\n  , examples (datetime (2013, 4, 5, 0, 0, 0) Day)\n             [ \"le 5 avril\"\n             , \"5 avril\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"le 3 mars 2015\"\n             , \"3 mars 2015\"\n             , \"3/3/2015\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"le 15 f\u00c3\u00a9vrier\"\n             , \"15 f\u00c3\u00a9vrier\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15/02/2013\"\n             , \"15 fev 2013\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"le 16\"\n             ]\n  , examples (datetime (2013, 2, 16, 18, 0, 0) Hour)\n             [ \"le 16 \u00c3\u00a0 18h\"\n             , \"le 16 vers 18h\"\n             , \"le 16 plut\u00c3\u00b4t vers 18h\"\n             , \"le 16 \u00c3\u00a0 6h du soir\"\n             , \"le 16 vers 6h du soir\"\n             , \"le 16 vers 6h dans la soir\u00c3\u00a9e\"\n             , \"samedi 16 \u00c3\u00a0 18h\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"17 f\u00c3\u00a9vrier\"\n             , \"le 17 f\u00c3\u00a9vrier\"\n             , \"17/2\"\n             , \"17/02\"\n             , \"le 17/02\"\n             , \"17 02\"\n             , \"17 2\"\n             , \"le 17 02\"\n             , \"le 17 2\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"mercredi 13\"\n             ]\n  , examples (datetime (2014, 2, 20, 0, 0, 0) Day)\n             [ \"20/02/2014\"\n             , \"20/2/2014\"\n             , \"20/02/14\"\n             , \"le 20/02/14\"\n             , \"le 20/2/14\"\n             , \"20 02 2014\"\n             , \"20 02 14\"\n             , \"20 2 2014\"\n             , \"20 2 14\"\n             , \"le 20 02 2014\"\n             , \"le 20 02 14\"\n             , \"le 20 2 2014\"\n             , \"le 20 2 14\"\n             ]\n  , examples (datetime (2013, 10, 31, 0, 0, 0) Day)\n             [ \"31 octobre\"\n             , \"le 31 octobre\"\n             , \"31/10\"\n             , \"le 31/10\"\n             , \"31 10\"\n             , \"le 31 10\"\n             ]\n  , examples (datetime (2014, 12, 24, 0, 0, 0) Day)\n             [ \"24/12/2014\"\n             , \"24/12/14\"\n             , \"le 24/12/14\"\n             , \"24 12 2014\"\n             , \"24 12 14\"\n             , \"le 24 12 2014\"\n             , \"le 24 12 14\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31 octobre 74\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"lundi prochain\"\n             , \"lundi la semaine prochaine\"\n             , \"lundi de la semaine prochaine\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"mardi prochain\"\n             , \"mardi suivant\"\n             , \"mardi d'apr\u00c3\u00a8s\"\n             , \"mardi la semaine prochaine\"\n             , \"mardi de la semaine prochaine\"\n             , \"mardi la semaine suivante\"\n             , \"mardi de la semaine suivante\"\n             , \"mardi la semaine d'apr\u00c3\u00a8s\"\n             , \"mardi de la semaine d'apr\u00c3\u00a8s\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"mercredi prochain\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"mercredi suivant\"\n             , \"mercredi d'apr\u00c3\u00a8s\"\n             , \"mercredi la semaine prochaine\"\n             , \"mercredi de la semaine prochaine\"\n             , \"mercredi la semaine suivante\"\n             , \"mercredi de la semaine suivante\"\n             , \"mercredi la semaine d'apr\u00c3\u00a8s\"\n             , \"mercredi de la semaine d'apr\u00c3\u00a8s\"\n             ]\n  , examples (datetime (2013, 2, 25, 0, 0, 0) Day)\n             [ \"lundi en huit\"\n             , \"lundi en 8\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"mardi en huit\"\n             , \"mardi en 8\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"mercredi en huit\"\n             , \"mercredi en 8\"\n             ]\n  , examples (datetime (2013, 3, 4, 0, 0, 0) Day)\n             [ \"lundi en quinze\"\n             , \"lundi en 15\"\n             ]\n  , examples (datetime (2013, 2, 26, 0, 0, 0) Day)\n             [ \"mardi en quinze\"\n             , \"mardi en 15\"\n             ]\n  , examples (datetime (2013, 2, 27, 0, 0, 0) Day)\n             [ \"mercredi en quinze\"\n             , \"mercredi en 15\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"lundi cette semaine\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"mardi cette semaine\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"mercredi cette semaine\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"cette semaine\"\n             , \"dans la semaine\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"la semaine derni\u00c3\u00a8re\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"la semaine prochaine\"\n             , \"la semaine suivante\"\n             , \"la semaine qui suit\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"le mois dernier\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"le mois prochain\"\n             , \"le mois suivant\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"l'ann\u00c3\u00a9e derni\u00c3\u00a8re\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"cette ann\u00c3\u00a9e\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"l'ann\u00c3\u00a9e prochaine\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"dimanche dernier\"\n             , \"dimanche de la semaine derni\u00c3\u00a8re\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"3eme jour d'octobre\"\n             , \"le 3eme jour d'octobre\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"premiere semaine d'octobre 2014\"\n             , \"la premiere semaine d'octobre 2014\"\n             ]\n  , examples (datetime (2013, 10, 7, 0, 0, 0) Week)\n             [ \"la semaine du 6 octobre\"\n             , \"la semaine du 7 octobre\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"dernier jour d'octobre 2015\"\n             , \"le dernier jour d'octobre 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"derni\u00c3\u00a8re semaine de septembre 2014\"\n             , \"la derni\u00c3\u00a8re semaine de septembre 2014\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"\u00c3\u00a0 quinze heures\"\n             , \"\u00c3\u00a0 15 heures\"\n             , \"\u00c3\u00a0 3 heures cet apr\u00c3\u00a8s-midi\"\n             , \"15h\"\n             , \"15H\"\n             , \"vers 15 heures\"\n             , \"\u00c3\u00a0 environ 15 heures\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Minute)\n             [ \"15:00\"\n             , \"15h00\"\n             , \"15H00\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"minuit\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 0, 0) Hour)\n             [ \"midi\"\n             , \"aujourd'hui \u00c3\u00a0 midi\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 15, 0) Minute)\n             [ \"midi et quart\"\n             , \"midi quinze\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 55, 0) Minute)\n             [ \"midi moins cinq\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 30, 0) Minute)\n             [ \"midi et demi\"\n             , \"midi trente\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 3, 0) Minute)\n             [ \"minuit trois\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 3, 0) Minute)\n             [ \"aujourd'hui \u00c3\u00a0 minuit trois\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"\u00c3\u00a0 quinze heures quinze\"\n             , \"\u00c3\u00a0 quinze heures et quinze minutes\"\n             , \"15h pass\u00c3\u00a9 de 15 minutes\"\n             , \"\u00c3\u00a0 trois heures et quart cet apr\u00c3\u00a8s-midi\"\n             , \"15:15\"\n             , \"15h15\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 15, 0) Minute)\n             [ \"\u00c3\u00a0 trois heures et quart demain apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"\u00c3\u00a0 quinze heures trente\"\n             , \"\u00c3\u00a0 quinze heures pass\u00c3\u00a9 de trente minutes\"\n             , \"\u00c3\u00a0 trois heures et demi cet apr\u00c3\u00a8s-midi\"\n             , \"15:30\"\n             , \"15h30\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"midi moins le quart\"\n             , \"11h45\"\n             , \"onze heures trois quarts\"\n             , \"aujourd'hui \u00c3\u00a0 11h45\"\n             ]\n  , examples (datetime (2013, 2, 13, 11, 0, 0) Hour)\n             [ \"mercredi \u00c3\u00a0 11h\"\n             ]\n  , examples (datetime (2013, 2, 13, 11, 0, 0) Hour)\n             [ \"demain \u00c3\u00a0 11 heures\"\n             , \"demain \u00c3\u00a0 11H\"\n             ]\n  , examples (datetime (2013, 2, 14, 11, 0, 0) Hour)\n             [ \"jeudi \u00c3\u00a0 11h\"\n             , \"apr\u00c3\u00a8s-demain \u00c3\u00a0 11 heures\"\n             , \"apr\u00c3\u00a8s-demain \u00c3\u00a0 11H\"\n             ]\n  , examples (datetime (2013, 2, 15, 12, 0, 0) Hour)\n             [ \"vendredi \u00c3\u00a0 midi\"\n             , \"vendredi \u00c3\u00a0 12h\"\n             ]\n  , examples (datetime (2013, 2, 15, 16, 0, 0) Hour)\n             [ \"vendredi quinze \u00c3\u00a0 seize heures\"\n             , \"vendredi 15 \u00c3\u00a0 16h\"\n             , \"vendredi quinze \u00c3\u00a0 16h\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"dans une seconde\"\n             , \"dans 1\\\"\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"dans une minute\"\n             , \"dans 1 min\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"dans 2 minutes\"\n             , \"dans deux min\"\n             , \"dans 2'\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"dans 60 minutes\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"dans une heure\"\n             ]\n  , examples (datetime (2013, 2, 12, 2, 30, 0) Minute)\n             [ \"il y a deux heures\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"dans 24 heures\"\n             , \"dans vingt quatre heures\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"dans un jour\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"dans 7 jours\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"dans 1 semaine\"\n             , \"dans une semaine\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"il y a trois semaines\"\n             ]\n  , examples (datetime (2013, 4, 12, 0, 0, 0) Day)\n             [ \"dans deux mois\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"il y a trois mois\"\n             ]\n  , examples (datetime (2014, 2, 0, 0, 0, 0) Month)\n             [ \"dans une ann\u00c3\u00a9e\"\n             , \"dans 1 an\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"il y a deux ans\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"cet \u00c3\u00a9t\u00c3\u00a9\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"cet hiver\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"Noel\"\n             , \"no\u00c3\u00abl\"\n             , \"jour de noel\"\n             ]\n  , examples (datetimeInterval ((2013, 12, 24, 18, 0, 0), (2013, 12, 25, 0, 0, 0)) Hour)\n             [ \"le soir de no\u00c3\u00abl\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"jour de l'an\"\n             , \"nouvel an\"\n             , \"premier janvier\"\n             ]\n  , examples (datetime (2013, 11, 1, 0, 0, 0) Day)\n             [ \"la toussaint\"\n             , \"le jour de la toussaint\"\n             , \"la journ\u00c3\u00a9e de la toussaint\"\n             , \"toussaint\"\n             , \"le jour des morts\"\n             ]\n  , examples (datetime (2013, 5, 1, 0, 0, 0) Day)\n             [ \"f\u00c3\u00aate du travail\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"cet apr\u00c3\u00a8s-midi\"\n             , \"l'apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 7, 0, 0), (2013, 2, 12, 9, 0, 0)) Hour)\n             [ \"aujourd'hui en d\u00c3\u00a9but de matin\u00c3\u00a9e\"\n             , \"en d\u00c3\u00a9but de matin\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en d\u00c3\u00a9but de matin\u00c3\u00a9e\"\n             , \"aujourd'hui tr\u00c3\u00a8s t\u00c3\u00b4t le matin\"\n             , \"aujourd'hui t\u00c3\u00b4t le matin\"\n             , \"aujourd'hui le matin t\u00c3\u00b4t\"\n             , \"aujourd'hui le matin tr\u00c3\u00a8s t\u00c3\u00b4t\"\n             , \"le matin tr\u00c3\u00a8s t\u00c3\u00b4t\"\n             , \"le matin t\u00c3\u00b4t\"\n             , \"t\u00c3\u00b4t le matin\"\n             , \"tr\u00c3\u00a8s t\u00c3\u00b4t le matin\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 0, 0), (2013, 2, 12, 11, 0, 0)) Hour)\n             [ \"aujourd'hui en milieu de matin\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en milieu de matin\u00c3\u00a9e\"\n             , \"en milieu de matin\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 10, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"aujourd'hui en fin de matin\u00c3\u00a9e\"\n             , \"en fin de matin\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en fin de matin\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"apr\u00c3\u00a8s d\u00c3\u00a9jeuner\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 10, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"avant d\u00c3\u00a9jeuner\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 14, 0, 0)) Hour)\n             [ \"aujourd'hui pendant le d\u00c3\u00a9jeuner\"\n             , \"\u00c3\u00a0 l'heure du d\u00c3\u00a9jeuner\"\n             , \"au moment de d\u00c3\u00a9jeuner\"\n             , \"pendant le d\u00c3\u00a9jeuner\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 17, 0, 0), (2013, 2, 12, 21, 0, 0)) Hour)\n             [ \"apr\u00c3\u00a8s le travail\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"d\u00c3\u00a8s le matin\"\n             , \"d\u00c3\u00a8s la matin\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 14, 0, 0)) Hour)\n             [ \"aujourd'hui en d\u00c3\u00a9but d'apr\u00c3\u00a8s-midi\"\n             , \"en d\u00c3\u00a9but d'apr\u00c3\u00a8s-midi\"\n             , \"le 12 f\u00c3\u00a9vrier en d\u00c3\u00a9but d'apr\u00c3\u00a8s-midi\"\n             , \"au d\u00c3\u00a9but de l'apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 14, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"aujourd'hui en milieu d'apr\u00c3\u00a8s-midi\"\n             , \"en milieu d'apr\u00c3\u00a8s-midi\"\n             , \"le 12 f\u00c3\u00a9vrier en milieu d'apr\u00c3\u00a8s-midi\"\n             , \"au milieu de l'apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 17, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"aujourd'hui en fin d'apr\u00c3\u00a8s-midi\"\n             , \"en fin d'apr\u00c3\u00a8s-midi\"\n             , \"le 12 f\u00c3\u00a9vrier en fin d'apr\u00c3\u00a8s-midi\"\n             , \"\u00c3\u00a0 la fin de l'apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 6, 0, 0), (2013, 2, 12, 10, 0, 0)) Hour)\n             [ \"aujourd'hui en d\u00c3\u00a9but de journ\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en d\u00c3\u00a9but de journ\u00c3\u00a9e\"\n             , \"en d\u00c3\u00a9but de journ\u00c3\u00a9e\"\n             , \"au d\u00c3\u00a9but de la journ\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 0, 0), (2013, 2, 12, 16, 0, 0)) Hour)\n             [ \"aujourd'hui en milieu de journ\u00c3\u00a9e\"\n             , \"en milieu de journ\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en milieu de journ\u00c3\u00a9e\"\n             , \"au milieu de la journ\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 17, 0, 0), (2013, 2, 12, 21, 0, 0)) Hour)\n             [ \"aujourd'hui en fin de journ\u00c3\u00a9e\"\n             , \"en fin de journ\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en fin de journ\u00c3\u00a9e\"\n             , \"\u00c3\u00a0 la fin de la journ\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"ce soir\"\n             , \"le soir\"\n             , \"dans la soir\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 12, 21, 0, 0)) Hour)\n             [ \"aujourd'hui en d\u00c3\u00a9but de soir\u00c3\u00a9e\"\n             , \"en d\u00c3\u00a9but de soir\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en d\u00c3\u00a9but de soir\u00c3\u00a9e\"\n             , \"au d\u00c3\u00a9but de la soir\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 21, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"aujourd'hui en fin de soir\u00c3\u00a9e\"\n             , \"en fin de soir\u00c3\u00a9e\"\n             , \"le 12 f\u00c3\u00a9vrier en fin de soir\u00c3\u00a9e\"\n             , \"\u00c3\u00a0 la fin de la soir\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"demain soir\"\n             , \"mercredi soir\"\n             , \"mercredi en soir\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"hier soir\"\n             , \"la veille au soir\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"ce week-end\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 0, 0, 0), (2013, 2, 13, 0, 0, 0)) Day)\n             [ \"en d\u00c3\u00a9but de semaine\"\n             , \"au d\u00c3\u00a9but de la semaine\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 15, 0, 0, 0)) Day)\n             [ \"en milieu de semaine\"\n             , \"au milieu de la semaine\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 0, 0, 0), (2013, 2, 18, 0, 0, 0)) Day)\n             [ \"en fin de semaine\"\n             , \"\u00c3\u00a0 la fin de la semaine\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"en semaine\"\n             ]\n  , examples (datetimeInterval ((2013, 9, 6, 18, 0, 0), (2013, 9, 9, 0, 0, 0)) Hour)\n             [ \"le premier week-end de septembre\"\n             ]\n  , examples (datetimeInterval ((2013, 9, 13, 18, 0, 0), (2013, 9, 16, 0, 0, 0)) Hour)\n             [ \"le deuxi\u00c3\u00a8me week-end de septembre\"\n             ]\n  , examples (datetimeInterval ((2013, 9, 27, 18, 0, 0), (2013, 9, 30, 0, 0, 0)) Hour)\n             [ \"le dernier week-end de septembre\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"lundi matin\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 12, 0, 0), (2013, 2, 18, 19, 0, 0)) Hour)\n             [ \"lundi apr\u00c3\u00a8s-midi\"\n             , \"lundi dans l'apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 17, 0, 0), (2013, 2, 18, 19, 0, 0)) Hour)\n             [ \"lundi fin d'apr\u00c3\u00a8s-midi\"\n             , \"lundi en fin d'apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 4, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"le 15 f\u00c3\u00a9vrier dans la matin\u00c3\u00a9e\"\n             , \"matin\u00c3\u00a9e du 15 f\u00c3\u00a9vrier\"\n             , \"le 15 f\u00c3\u00a9vrier le matin\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"8 heures ce soir\"\n             , \"8h du soir\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Hour)\n             [ \"3 heures du matin\"\n             , \"3h du mat\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"2 derni\u00c3\u00a8res secondes\"\n             , \"deux dernieres secondes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"3 prochaines secondes\"\n             , \"trois prochaines secondes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"2 dernieres minutes\"\n             , \"deux derni\u00c3\u00a8res minutes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"3 prochaines minutes\"\n             , \"trois prochaines minutes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"3 prochaines heures\"\n             , \"3 heures suivantes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"2 dernier jours\"\n             , \"deux derniers jour\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"3 prochains jours\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"2 dernieres semaines\"\n             , \"2 semaines pass\u00c3\u00a9es\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"3 prochaines semaines\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"2 derniers mois\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"3 prochains mois\"\n             , \"3 mois suivant\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"2 dernieres annees\"\n             , \"2 ann\u00c3\u00a9es pass\u00c3\u00a9es\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"3 prochaines ann\u00c3\u00a9es\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13-15 juillet\"\n             , \"13 au 15 juillet\"\n             , \"13 jusqu'au 15 juillet\"\n             , \"13 juillet au 15 juillet\"\n             , \"13 juillet - 15 juillet\"\n             , \"entre le 13 et le 15 juillet\"\n             , \"samedi 13 au dimanche 15e juillet\"\n             , \"du samedi 13 au dimanche 15 juillet\"\n             , \"du 13 au dimanche 15 juillet\"\n             , \"entre le 13 et le quinze juillet\"\n             , \"du treize au 15 juillet\"\n             , \"du 13e au 15 juillet\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 1, 0, 0, 0), (2013, 7, 11, 0, 0, 0)) Day)\n             [ \"1er au 10 juillet\"\n             , \"lundi 1er au mercredi 10 juillet\"\n             , \"lundi 1 au mercredi 10e juillet\"\n             , \"du lundi 1er au mercredi 10 juillet\"\n             , \"du 1er au mercredi 10 juillet\"\n             , \"du 1er au dix juillet\"\n             , \"1er au dix juillet\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 19, 0, 0, 0)) Day)\n             [ \"du 13 au 18\"\n             , \"entre le 13 et le dix-huit\"\n             , \"du 13e au dix-huit\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 10, 0, 0, 0), (2013, 7, 2, 0, 0, 0)) Day)\n             [ \"10 juin au 1er juillet\"\n             , \"entre le 10 juin et le 1er juillet\"\n             , \"du 10 juin au 1er juillet\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"de 9h30 jusqu'\u00c3\u00a0 11h jeudi\"\n             , \"de 9 heures 30 \u00c3\u00a0 11h jeudi\"\n             , \"de 9 heures 30 a 11h jeudi\"\n             , \"entre 9h30 et 11h jeudi\"\n             , \"jeudi mais entre 9h30 et 11h\"\n             , \"jeudi par exemple entre 9h30 et 11h\"\n             , \"9h30 - 11h00 Jeudi\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 3, 8, 0, 0, 0) Day)\n             [ \"\u00c3\u00a0 partir du 8\"\n             , \"\u00c3\u00a0 partir du 8 mars\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 14, 9, 30, 0) Minute)\n             [ \"\u00c3\u00a0 partir de 9h30 jeudi\"\n             , \"jeudi apr\u00c3\u00a8s 9h30\"\n             , \"jeudi plus tard que 9h30\"\n             , \"jeudi matin \u00c3\u00a0 partir de 9 heures 30\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 11, 1, 16, 0, 0) Hour)\n             [ \"apr\u00c3\u00a8s 16h le 1er novembre\"\n             , \"plus tard que 16h le 1er novembre\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 11, 1, 0, 0, 0) Day)\n             [ \"apr\u00c3\u00a8s le 1er novembre\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 16, 0, 0) Hour)\n             [ \"avant 16h\"\n             , \"n'importe quand avant 16h\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 13, 17, 0, 0)) Hour)\n             [ \"demain jusqu'\u00c3\u00a0 16h\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 20, 10, 0, 0) Hour)\n             [ \"le 20 \u00c3\u00a0 partir de 10h\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 15, 12, 0, 0) Hour)\n             [ \"vendredi \u00c3\u00a0 partir de midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 20, 0, 0, 0), (2013, 2, 20, 19, 0, 0)) Hour)\n             [ \"le 20 jusqu'\u00c3\u00a0 18h\"\n             ]\n  , examples (datetimeInterval ((2014, 9, 14, 0, 0, 0), (2014, 9, 21, 0, 0, 0)) Day)\n             [ \"14 - 20 sept. 2014\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"d'ici 2 semaines\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 27, 4, 0, 0)) Second)\n             [ \"dans les 15 jours\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"de 5 \u00c3\u00a0 7\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"jeudi de 9h \u00c3\u00a0 11h\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 15, 0, 0)) Hour)\n             [ \"entre midi et 2\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11h30-1h30\"\n             , \"de 11h30 \u00c3\u00a0 1h30\"\n             , \"de 11h30 jusqu'\u00c3\u00a0 1h30\"\n             ]\n  , examples (datetime (2013, 9, 21, 13, 30, 0) Minute)\n             [ \"13h30 samedi 21 septembre\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"\u00c3\u00a0 seize heures CET\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 21, 0, 0, 0), (2013, 4, 1, 0, 0, 0)) Day)\n             [ \"fin mars\"\n             , \"fin du mois de mars\"\n             ]\n  , examples (datetimeInterval ((2013, 4, 1, 0, 0, 0), (2013, 4, 6, 0, 0, 0)) Day)\n             [ \"d\u00c3\u00a9but avril\"\n             , \"d\u00c3\u00a9but du mois d'avril\"\n             ]\n  , examples (datetimeInterval ((2013, 4, 1, 0, 0, 0), (2013, 4, 15, 0, 0, 0)) Day)\n             [ \"la premi\u00c3\u00a8re quinzaine d'avril\"\n             ]\n  , examples (datetimeInterval ((2013, 4, 15, 0, 0, 0), (2013, 5, 1, 0, 0, 0)) Day)\n             [ \"la deuxi\u00c3\u00a8me quinzaine d'avril\"\n             ]\n  , examples (datetimeInterval ((2013, 4, 1, 0, 0, 0), (2013, 4, 6, 0, 0, 0)) Day)\n             [ \"d\u00c3\u00a9but avril\"\n             , \"d\u00c3\u00a9but du mois d'avril\"\n             ]\n  , examples (datetimeInterval ((2013, 12, 10, 0, 0, 0), (2013, 12, 20, 0, 0, 0)) Day)\n             [ \"mi-d\u00c3\u00a9cembre\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 21, 0, 0, 0), (2013, 3, 1, 0, 0, 0)) Day)\n             [ \"en fin de mois\"\n             , \"\u00c3\u00a0 la fin du mois\"\n             ]\n  , examples (datetimeInterval ((2013, 11, 1, 0, 0, 0), (2014, 1, 1, 0, 0, 0)) Month)\n             [ \"en fin d'ann\u00c3\u00a9e\"\n             , \"\u00c3\u00a0 la fin de l'ann\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 1, 0, 0, 0), (2013, 3, 1, 0, 0, 0)) Month)\n             [ \"en d\u00c3\u00a9but d'ann\u00c3\u00a9e\"\n             , \"au d\u00c3\u00a9but de l'ann\u00c3\u00a9e\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 1, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Day)\n             [ \"au d\u00c3\u00a9but du mois\"\n             , \"en d\u00c3\u00a9but de mois\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"mars\"\n             , \"en mars\"\n             , \"au mois de mars\"\n             , \"le mois de mars\"\n             ]\n  , examples (datetime (2013, 8, 15, 0, 0, 0) Day)\n             [ \"jeudi 15\"\n             ]\n  , examples (datetime (2013, 8, 15, 8, 0, 0) Hour)\n             [ \"jeudi 15 \u00c3\u00a0 8h\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 4, 40, 0) Minute)\n             [ \"plus tard\"\n             , \"un peu plus tard\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"plus tard dans l'apr\u00c3\u00a8s-midi\"\n             , \"un peu plus tard dans l'apr\u00c3\u00a8s-midi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 00, 0, 0)) Hour)\n             [ \"plus tard dans la soir\u00c3\u00a9e\"\n             , \"un peu plus tard dans la soir\u00c3\u00a9e\"\n             ]\n  , examples (datetime (2013, 3, 6, 0, 0, 0) Day)\n             [ \"le premier mercredi de mois prochain\"\n             , \"premier mercredi du mois prochain\"\n             ]\n  ]\n", "num_lines": 884}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.FR.Rules\n  ( rules\n  ) where\n\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData (..))\nimport Duckling.Types\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleAujourdhui :: Rule\nruleAujourdhui = Rule\n  { name = \"aujourd'hui\"\n  , pattern =\n    [ regex \"(aujourd'? ?hui)|(ce jour)|(dans la journ(\u00c3\u00a9|e)e?)|(en ce moment)\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleDayofmonthNamedmonth :: Rule\nruleDayofmonthNamedmonth = Rule\n  { name = \"<day-of-month> <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleHier :: Rule\nruleHier = Rule\n  { name = \"hier\"\n  , pattern =\n    [ regex \"hier|la veille\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleDbutDeSoire :: Rule\nruleDbutDeSoire = Rule\n  { name = \"d\u00c3\u00a9but de soir\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |au )?d(\u00c3\u00a9|e)but de (la )?soir(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 18) (hour False 21)\n  }\n\nruleFinDeSoire :: Rule\nruleFinDeSoire = Rule\n  { name = \"fin de soir\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |(\u00c3\u00a0|a) la )?fin de (la )?soir(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 21) (hour False 0)\n  }\n\nruleDbutDeMatine :: Rule\nruleDbutDeMatine = Rule\n  { name = \"d\u00c3\u00a9but de matin\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"le matin (tr(e|\u00c3\u00a8)s )?t(\u00c3\u00b4|o)t|(tr(e|\u00c3\u00a8)s )?t(\u00c3\u00b4|o)t le matin|(en |au )?d(\u00c3\u00a9|e)but de (la )?matin(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 7) (hour False 9)\n  }\n\nruleMilieuDeMatine :: Rule\nruleMilieuDeMatine = Rule\n  { name = \"milieu de matin\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |au )?milieu de (la )?matin(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 9) (hour False 11)\n  }\n\nruleFinDeMatine :: Rule\nruleFinDeMatine = Rule\n  { name = \"fin de matin\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |(\u00c3\u00a0|a) la )?fin de (la )?matin(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 10) (hour False 12)\n  }\n\nruleDbutDaprsmidi :: Rule\nruleDbutDaprsmidi = Rule\n  { name = \"d\u00c3\u00a9but d'apr\u00c3\u00a8s-midi\"\n  , pattern =\n    [ regex \"(au |en )?d(\u00c3\u00a9|e)but (d'|de l')apr(e|\u00c3\u00a9|\u00c3\u00a8)s( |\\\\-)midi\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 12) (hour False 14)\n  }\n\nruleMilieuDaprsmidi :: Rule\nruleMilieuDaprsmidi = Rule\n  { name = \"milieu d'apr\u00c3\u00a8s-midi\"\n  , pattern =\n    [ regex \"(au |en )?milieu (d'|de l')apr(e|\u00c3\u00a9|\u00c3\u00a8)s( |\\\\-)midi\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 14) (hour False 17)\n  }\n\nruleFinDaprsmidi :: Rule\nruleFinDaprsmidi = Rule\n  { name = \"fin d'apr\u00c3\u00a8s-midi\"\n  , pattern =\n    [ regex \"((\u00c3\u00a0|a) la |en )?fin (d'|de l')apr(e|\u00c3\u00a9|\u00c3\u00a8)s( |\\\\-)midi\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 17) (hour False 19)\n  }\n\nruleDbutDeJourne :: Rule\nruleDbutDeJourne = Rule\n  { name = \"d\u00c3\u00a9but de journ\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |au )?d(\u00c3\u00a9|e)but de (la )?journ(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n        interval TTime.Open (hour False 6) (hour False 10)\n  }\n\nruleMilieuDeJourne :: Rule\nruleMilieuDeJourne = Rule\n  { name = \"milieu de journ\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |au )?milieu de (la )?journ(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 11) (hour False 16)\n  }\n\nruleFinDeJourne :: Rule\nruleFinDeJourne = Rule\n  { name = \"fin de journ\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |(\u00c3\u00a0|a) la )?fin de (la )?journ(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 17) (hour False 21)\n  }\n\nruleDbutDeSemaine :: Rule\nruleDbutDeSemaine = Rule\n  { name = \"d\u00c3\u00a9but de semaine\"\n  , pattern =\n    [ regex \"(en |au )?d(\u00c3\u00a9|e)but de (cette |la )?semaine\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (dayOfWeek 1) (dayOfWeek 2)\n  }\n\nruleMilieuDeSemaine :: Rule\nruleMilieuDeSemaine = Rule\n  { name = \"milieu de semaine\"\n  , pattern =\n    [ regex \"(en |au )?milieu de (cette |la )?semaine\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (dayOfWeek 3) (dayOfWeek 4)\n  }\n\nruleFinDeSemaine :: Rule\nruleFinDeSemaine = Rule\n  { name = \"fin de semaine\"\n  , pattern =\n    [ regex \"(en |(\u00c3\u00a0|a) la )?fin de (cette |la )?semaine\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (dayOfWeek 4) (dayOfWeek 7)\n  }\n\nruleLeLendemainDuTime :: Rule\nruleLeLendemainDuTime = Rule\n  { name = \"le lendemain du <time>\"\n  , pattern =\n    [ regex \"(le|au)? ?lendemain du\"\n    , Predicate $ isGrainCoarserThan TG.Hour\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ cycleNthAfter True TG.Day 1 td\n      _ -> Nothing\n  }\n\nruleCePartofday :: Rule\nruleCePartofday = Rule\n  { name = \"ce <part-of-day>\"\n  , pattern =\n    [ regex \"cet?t?e?\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay . notLatent <$>\n        intersect today td\n      _ -> Nothing\n  }\n\nruleCeTime :: Rule\nruleCeTime = Rule\n  { name = \"ce <time>\"\n  , pattern =\n    [ regex \"ce\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleDurationAvantTime :: Rule\nruleDurationAvantTime = Rule\n  { name = \"<duration> avant <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"avant\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nruleMidi :: Rule\nruleMidi = Rule\n  { name = \"midi\"\n  , pattern =\n    [ regex \"midi\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|au|jusqu'(au?|\u00c3\u00a0)\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDeTimeofdayTimeofdayInterval :: Rule\nruleDeTimeofdayTimeofdayInterval = Rule\n  { name = \"de <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(midi )?de\"\n    , Predicate isATimeOfDay\n    , regex \"\\\\-|(jusqu')?(\u00c3\u00a0|au?)\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNProchainsCycle :: Rule\nruleNProchainsCycle = Rule\n  { name = \"n prochains <cycle>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , regex \"prochaine?s?|suivante?s?|apr(e|\u00c3\u00a8|\u00c3\u00a9)s\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt $ cycleN True grain n\n      _ -> Nothing\n  }\n\nruleNDerniersCycle :: Rule\nruleNDerniersCycle = Rule\n  { name = \"n derniers <cycle>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , regex \"derni(e|\u00c3\u00a8|\u00c3\u00a9)re?s?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt . cycleN True grain $ - n\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <day-of-week> of <month-or-greater>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate isADayOfWeek\n    , regex \"d[eu]\"\n    , Predicate $ not . isGrainFinerThan TG.Month\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n        predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTheNthTimeOfTime :: Rule\nruleTheNthTimeOfTime = Rule\n  { name = \"the nth <day-of-week> of <month-or-greater>\"\n  , pattern =\n    [ regex \"le\"\n    , dimension Ordinal\n    , Predicate isADayOfWeek\n    , regex \"d[eu]\"\n    , Predicate $ not . isGrainFinerThan TG.Month\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n         predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleAvantTimeofday :: Rule\nruleAvantTimeofday = Rule\n  { name = \"avant <time-of-day>\"\n  , pattern =\n    [ regex \"(n[ ']importe quand )?(avant|jusqu'(a|\u00c3\u00a0))\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleEntreDatetimeEtDatetimeInterval :: Rule\nruleEntreDatetimeEtDatetimeInterval = Rule\n  { name = \"entre <datetime> et <datetime> (interval)\"\n  , pattern =\n    [ regex \"entre\"\n    , dimension Time\n    , regex \"et\"\n    , dimension Time\n    ]\n  , prod = \\case\n      (_:Token Time td1:_:Token Time td2:_)\n        | sameGrain td1 td2 ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDuDatetimedayofweekDdMonthinterval :: Rule\nruleDuDatetimedayofweekDdMonthinterval = Rule\n  { name = \"du <datetime>-<day-of-week> dd <month>(interval)\"\n  , pattern =\n    [ regex \"du\"\n    , dimension Time\n    , regex \"\\\\-|(jusqu')?au\"\n    , Predicate isADayOfWeek\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\case\n      (_:Token Time td1:_:_:token:Token Time td2:_) -> do\n        from <- intersect td2 td1\n        to <- intersectDOM td2 token\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleDuDdAuDdLatentMonthInterval :: Rule\nruleDuDdAuDdLatentMonthInterval = Rule\n  { name = \"du dd au dd (interval) (latent month)\"\n  , pattern =\n    [ regex \"du\"\n    , Predicate isDOMValue\n    , regex \"(jusqu')?au\"\n    , Predicate isDOMValue\n    ]\n  , prod = \\case\n      (_:token1:_:token2:_) -> do\n        n1 <- getIntValue token1\n        n2 <- getIntValue token2\n        Token Time <$> interval TTime.Closed (dayOfMonth n1) (dayOfMonth n2)\n      _ -> Nothing\n  }\n\nruleDatetimedayofweekDdMonthinterval :: Rule\nruleDatetimedayofweekDdMonthinterval = Rule\n  { name = \"<datetime>-<day-of-week> dd <month>(interval)\"\n  , pattern =\n    [ Predicate $ isGrainOfTime TG.Day\n    , regex \"\\\\-|(jusqu')?au\"\n    , Predicate isADayOfWeek\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\case\n      (Token Time td1:_:_:token:Token Time td2:_) -> do\n        from <- intersect td2 td1\n        to <- intersectDOM td2 token\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleEntreDdEtDdMonthinterval :: Rule\nruleEntreDdEtDdMonthinterval = Rule\n  { name = \"entre dd et dd <month>(interval)\"\n  , pattern =\n    [ regex \"entre( le)?\"\n    , Predicate isDOMValue\n    , regex \"et( le)?\"\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\case\n      (_:token1:_:token2:Token Time td:_) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleDatetimeddMonthinterval :: Rule\nruleDatetimeddMonthinterval = Rule\n  { name = \"<datetime>-dd <month>(interval)\"\n  , pattern =\n    [ Predicate $ isGrainOfTime TG.Day\n    , regex \"\\\\-|(jusqu')?au\"\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\case\n      (Token Time td1:_:token:Token Time td2:_) -> do\n        from <- intersect td2 td1\n        to <- intersectDOM td2 token\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleDuDdAuDdMonthInterval :: Rule\nruleDuDdAuDdMonthInterval = Rule\n  { name = \"du dd/nth au dd/nth month (interval)\"\n  , pattern =\n    [ regex \"du\"\n    , Predicate isDOMValue\n    , regex \"\\\\-|au|jusqu'(au?|\u00c3\u00a0)\"\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\case\n      (_:token1:_:token2:Token Time td:_) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleHhhmmTimeofday :: Rule\nruleHhhmmTimeofday = Rule\n  { name = \"hh(:|h)mm (time-of-day)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:h]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt $ hourMinute (h < 12) h m\n      _ -> Nothing\n  }\n\nruleDdMm :: Rule\nruleDdMm = Rule\n  { name = \"dd mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9]) (1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDdMmYyyy :: Rule\nruleDdMmYyyy = Rule\n  { name = \"dd mm yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9]) (1[0-2]|0?[1-9]) (\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleNamedmonthProchain :: Rule\nruleNamedmonthProchain = Rule\n  { name = \"<named-month> prochain\"\n  , pattern =\n    [ dimension Time\n    , regex \"prochain\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 False td\n      _ -> Nothing\n  }\n\nruleDiciDuration :: Rule\nruleDiciDuration = Rule\n  { name = \"d'ici <duration>\"\n  , pattern =\n    [ regex \"d'ici|dans l('|es?)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        Token Time <$> interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleToussaint :: Rule\nruleToussaint = Rule\n  { name = \"toussaint\"\n  , pattern =\n    [ regex \"((la |la journ(\u00c3\u00a9|e)e de la |jour de la )?toussaint|jour des morts)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 11 1\n  }\n\nruleDernierCycleDeTimeLatent :: Rule\nruleDernierCycleDeTimeLatent = Rule\n  { name = \"dernier <cycle> de <time> (latent)\"\n  , pattern =\n    [ regex \"derni(e|\u00c3\u00a9|\u00c3\u00a8)re?\"\n    , dimension TimeGrain\n    , regex \"d['e]\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleDurationApresTime :: Rule\nruleDurationApresTime = Rule\n  { name = \"<duration> apres <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"apr(e|\u00c3\u00a8)s\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleNCycleAprs :: Rule\nruleNCycleAprs = Rule\n  { name = \"n <cycle> apr\u00c3\u00a8s\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"(d')? ?apr(e|\u00c3\u00a8|\u00c3\u00a9)s|qui sui(t|ves?)|plus tard\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt $ cycleNth grain n\n      _ -> Nothing\n  }\n\nruleSeason4 :: Rule\nruleSeason4 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(ce )?printemps\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (monthDay 3 20) (monthDay 6 21)\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleNCycleAvant :: Rule\nruleNCycleAvant = Rule\n  { name = \"n <cycle> avant\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"(d')? ?avant|plus t(o|\u00c3\u00b4)t\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt . cycleNth grain $ - n\n      _ -> Nothing\n  }\n\nruleDimTimeDuMatin :: Rule\nruleDimTimeDuMatin = Rule\n  { name = \"<dim time> du matin\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"((du|dans|de) )?((au|le|la) )?mat(in(\u00c3\u00a9|e)?e?)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> do\n        morning <- partOfDay . mkLatent <$>\n          interval TTime.Open (hour False 0) (hour False 12)\n        Token Time <$> intersect td morning\n      _ -> Nothing\n  }\n\nruleOrdinalWeekendDeTime :: Rule\nruleOrdinalWeekendDeTime = Rule\n  { name = \"<ordinal> week-end de <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , regex \"week(\\\\s|-)?end (d['eu]|en|du mois de)\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        td2 <- intersect td weekend\n        tt $ predNth (n - 1) False td2\n      _ -> Nothing\n  }\n\nruleHourofdayEtQuart :: Rule\nruleHourofdayEtQuart = Rule\n  { name = \"<hour-of-day> et quart\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(et )?quart\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayEtDemi :: Rule\nruleHourofdayEtDemi = Rule\n  { name = \"<hour-of-day> et demi\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"et demie?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleHourofdayEtTroisQuart :: Rule\nruleHourofdayEtTroisQuart = Rule\n  { name = \"<hour-of-day> et trois quarts\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(et )?(3|trois) quarts?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 45\n      _ -> Nothing\n  }\n\nruleHourofdayEtpassDeNumeral :: Rule\nruleHourofdayEtpassDeNumeral = Rule\n  { name = \"<hour-of-day> et|pass\u00c3\u00a9 de <number>\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"et|(pass(\u00c3\u00a9|e)e? de)\"\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdayEtpassDeNumeralMinutes :: Rule\nruleHourofdayEtpassDeNumeralMinutes = Rule\n  { name = \"<hour-of-day> et|pass\u00c3\u00a9 de <number> minutes\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"et|(pass(\u00c3\u00a9|e)e? de)\"\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min\\\\.?(ute)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdayInteger :: Rule\nruleHourofdayInteger = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay, hasNoDirection]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerMinutes :: Rule\nruleHourofdayIntegerMinutes = Rule\n  { name = \"<hour-of-day> <integer> minutes\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min\\\\.?(ute)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdayMoinsIntegerAsRelativeMinutes :: Rule\nruleHourofdayMoinsIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> moins <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"moins( le)?\"\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:token:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleHourofdayMoinsQuart :: Rule\nruleHourofdayMoinsQuart = Rule\n  { name = \"<hour-of-day> moins quart\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"moins( le)? quart\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleAprsLeDayofmonth :: Rule\nruleAprsLeDayofmonth = Rule\n  { name = \"apr\u00c3\u00a8s le <day-of-month>\"\n  , pattern =\n    [ regex \"(apr(e|\u00c3\u00a8)s le|(a|\u00c3\u00a0) partir du)\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt . withDirection TTime.After $ dayOfMonth n\n      _ -> Nothing\n  }\n\nruleCycleDernier :: Rule\nruleCycleDernier = Rule\n  { name = \"<cycle> dernier\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"derni(\u00c3\u00a8|e)re?|pass(\u00c3\u00a9|e)e?|pr(e|\u00c3\u00a9)c(e|\u00c3\u00a9)dente?|(d')? ?avant\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleLeOrdinalCycleDeTime :: Rule\nruleLeOrdinalCycleDeTime = Rule\n  { name = \"le <ordinal> <cycle> de <time>\"\n  , pattern =\n    [ regex \"l[ea]\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"d['eu]|en\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (n - 1) td\n      _ -> Nothing\n  }\n\nruleEnSemaine :: Rule\nruleEnSemaine = Rule\n  { name = \"en semaine\"\n  , pattern =\n    [ regex \"(pendant la |en )?semaine\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (dayOfWeek 1) (dayOfWeek 5)\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd/-mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[/-](1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleNamedmonthnameddayDernierpass :: Rule\nruleNamedmonthnameddayDernierpass = Rule\n  { name = \"<named-month|named-day> dernier|pass\u00c3\u00a9\"\n  , pattern =\n    [ Predicate $ isGrainCoarserThan TG.Hour\n    , regex \"derni(e|\u00c3\u00a9|\u00c3\u00a8)re?|pass(\u00c3\u00a9|e)e?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleLeCycleDernier :: Rule\nruleLeCycleDernier = Rule\n  { name = \"le <cycle> dernier\"\n  , pattern =\n    [ regex \"l[ae']? ?\"\n    , dimension TimeGrain\n    , regex \"derni(\u00c3\u00a8|e)re?|pass(\u00c3\u00a9|e)e?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleNCyclePassesprecedents :: Rule\nruleNCyclePassesprecedents = Rule\n  { name = \"n <cycle> passes|precedents\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"pass(e|\u00c3\u00a8|\u00c3\u00a9)(e|\u00c3\u00a8|\u00c3\u00a9)?s?|pr(e|\u00c3\u00a9)c(e|\u00c3\u00a9)dente?s?|(d')? ?avant|plus t(o|\u00c3\u00b4)t\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt . cycleN True grain $ - n\n      _ -> Nothing\n  }\n\nruleSoir :: Rule\nruleSoir = Rule\n  { name = \"soir\"\n  , pattern =\n    [ regex \"soir(\u00c3\u00a9|e)?e?\"\n    ]\n  , prod = \\_ -> Token Time . mkLatent . partOfDay <$>\n      interval TTime.Open (hour False 18) (hour False 0)\n  }\n\nruleDdddMonthinterval :: Rule\nruleDdddMonthinterval = Rule\n  { name = \"dd-dd <month>(interval)\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , regex \"\\\\-|(jusqu')?au\"\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):_:Token RegexMatch (GroupMatch (m2:_)):Token Time td:_) -> do\n        d1 <- parseInt m1\n        d2 <- parseInt m2\n        from <- intersect td (dayOfMonth d1)\n        to <- intersect td (dayOfMonth d2)\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ hour (n < 12) n\n      _ -> Nothing\n  }\n\nruleDuDddayofweekDdMonthinterval :: Rule\nruleDuDddayofweekDdMonthinterval = Rule\n  { name = \"du dd-<day-of-week> dd <month>(interval)\"\n  , pattern =\n    [ regex \"du\"\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , regex \"\\\\-|(jusqu')?au\"\n    , Predicate isADayOfWeek\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token RegexMatch (GroupMatch (m1:_)):_:_:Token RegexMatch (GroupMatch (m2:_)):Token Time td:_) -> do\n        d1 <- parseInt m1\n        d2 <- parseInt m2\n        from <- intersect (dayOfMonth d1) td\n        to <- intersect (dayOfMonth d2) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleDbutNamedmonthinterval :: Rule\nruleDbutNamedmonthinterval = Rule\n  { name = \"d\u00c3\u00a9but <named-month>(interval)\"\n  , pattern =\n    [ regex \"d(\u00c3\u00a9|e)but( du mois d[e'] ?)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        from <- intersect (dayOfMonth 1) td\n        to <- intersect (dayOfMonth 5) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleLeCycleDeTime :: Rule\nruleLeCycleDeTime = Rule\n  { name = \"le <cycle> de <time>\"\n  , pattern =\n    [ regex \"l[ea]\"\n    , dimension TimeGrain\n    , regex \"d['eu]|en\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleSeason3 :: Rule\nruleSeason3 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(cet )?hiver\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (monthDay 12 21) (monthDay 3 20)\n  }\n\nruleSeason :: Rule\nruleSeason = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(cet )?(\u00c3\u00a9|e)t(\u00c3\u00a9|e)\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (monthDay 6 21) (monthDay 9 23)\n  }\n\nruleAprsmidi :: Rule\nruleAprsmidi = Rule\n  { name = \"apr\u00c3\u00a8s-midi\"\n  , pattern =\n    [ regex \"apr(e|\u00c3\u00a9|\u00c3\u00a8)s( |\\\\-)midi\"\n    ]\n  , prod = \\_ -> Token Time . mkLatent . partOfDay <$>\n      interval TTime.Open (hour False 12) (hour False 19)\n  }\n\nruleNoel :: Rule\nruleNoel = Rule\n  { name = \"noel\"\n  , pattern =\n    [ regex \"(jour de )?no(e|\u00c3\u00ab)l\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleDayofweekProchain :: Rule\nruleDayofweekProchain = Rule\n  { name = \"<day-of-week> prochain\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \"prochain\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleDemain :: Rule\nruleDemain = Rule\n  { name = \"demain\"\n  , pattern =\n    [ regex \"(le len)?demain\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleNamedmonthnameddaySuivantdaprs :: Rule\nruleNamedmonthnameddaySuivantdaprs = Rule\n  { name = \"<named-month|named-day> suivant|d'apr\u00c3\u00a8s\"\n  , pattern =\n    [ Predicate $ isGrainCoarserThan TG.Hour\n    , regex \"suivante?s?|d'apr(e|\u00c3\u00a9|\u00c3\u00a8)s\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 False td\n      _ -> Nothing\n  }\n\nruleNameddayEnHuit :: Rule\nruleNameddayEnHuit = Rule\n  { name = \"<named-day> en huit\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \"en (huit|8)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 False td\n      _ -> Nothing\n  }\n\nruleHhmmMilitaryTimeofday :: Rule\nruleHhmmMilitaryTimeofday = Rule\n  { name = \"hhmm (military time-of-day)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt . mkLatent $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleDimTimeDuSoir :: Rule\nruleDimTimeDuSoir = Rule\n  { name = \"<dim time> du soir\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"((du|dans|de) )?((au|le|la) )?soir(\u00c3\u00a9|e)?e?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> do\n        td2 <- mkLatent . partOfDay <$>\n          interval TTime.Open (hour False 16) (hour False 0)\n        Token Time <$> intersect td td2\n      _ -> Nothing\n  }\n\nruleAprsTimeofday :: Rule\nruleAprsTimeofday = Rule\n  { name = \"apr\u00c3\u00a8s <time-of-day|day>\"\n  , pattern =\n    [ regex \"(apr(e|\u00c3\u00a8)s|(a|\u00c3\u00a0) partir de|(un peu )?plus tard que)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleAprsLeDjeuner :: Rule\nruleAprsLeDjeuner = Rule\n  { name = \"apr\u00c3\u00a8s le d\u00c3\u00a9jeuner\"\n  , pattern =\n    [ regex \"apr(e|\u00c3\u00a8)s (le )?d(e|\u00c3\u00a9|\u00c3\u00a8)jeuner\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 13) (hour False 17)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleErMai :: Rule\nruleErMai = Rule\n  { name = \"1er mai\"\n  , pattern =\n    [ regex \"f(e|\u00c3\u00aa)te du travail\"\n    ]\n  , prod = \\_ -> tt $ monthDay 5 1\n  }\n\nrulePremireQuinzaineDeNamedmonthinterval :: Rule\nrulePremireQuinzaineDeNamedmonthinterval = Rule\n  { name = \"premi\u00c3\u00a8re quinzaine de <named-month>(interval)\"\n  , pattern =\n    [ regex \"(premi(\u00c3\u00a8|e)re|1 ?(\u00c3\u00a8|e)re) (quinzaine|15 ?aine) d[e']\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        from <- intersect (dayOfMonth 1) td\n        to <- intersect (dayOfMonth 14) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleDeDatetimeDatetimeInterval :: Rule\nruleDeDatetimeDatetimeInterval = Rule\n  { name = \"de <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"de|depuis|du\"\n    , dimension Time\n    , regex \"\\\\-|au|jusqu'(au?|\u00c3\u00a0)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_)\n        | sameGrain td1 td2 ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleAvanthier :: Rule\nruleAvanthier = Rule\n  { name = \"avant-hier\"\n  , pattern =\n    [ regex \"avant[- ]?hier\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 2\n  }\n\nruleCycleProchainsuivantdaprs :: Rule\nruleCycleProchainsuivantdaprs = Rule\n  { name = \"<cycle> prochain|suivant|d'apr\u00c3\u00a8s\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"prochaine?|suivante?|qui suit|(d')? ?apr(e|\u00c3\u00a8|\u00c3\u00a9)s\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleAprsLeTravail :: Rule\nruleAprsLeTravail = Rule\n  { name = \"apr\u00c3\u00a8s le travail\"\n  , pattern =\n    [ regex \"apr(e|\u00c3\u00a8)s (le )?travail\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 17) (hour False 21)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleLeDayofmonthDatetime :: Rule\nruleLeDayofmonthDatetime = Rule\n  { name = \"le <day-of-month> \u00c3\u00a0 <datetime>\"\n  , pattern =\n    [ regex \"le\"\n    , Predicate isDOMInteger\n    , regex \"(a|\u00c3\u00a0)\"\n    , Predicate $ isGrainFinerThan TG.Day\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> intersect (dayOfMonth n) td\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"week(\\\\s|-)?end\"\n    ]\n  , prod = \\_ -> tt weekend\n  }\n\nruleCedansLeCycle :: Rule\nruleCedansLeCycle = Rule\n  { name = \"ce|dans le <cycle>\"\n  , pattern =\n    [ regex \"(cet?t?e?s?)|(dans l[ae']? ?)\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleDansDuration :: Rule\nruleDansDuration = Rule\n  { name = \"dans <duration>\"\n  , pattern =\n    [ regex \"dans\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleOrdinalCycleDeTime :: Rule\nruleOrdinalCycleDeTime = Rule\n  { name = \"<ordinal> <cycle> de <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"d['eu]|en\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (n - 1) td\n      _ -> Nothing\n  }\n\nruleAvantLeDjeuner :: Rule\nruleAvantLeDjeuner = Rule\n  { name = \"avant le d\u00c3\u00a9jeuner\"\n  , pattern =\n    [ regex \"avant (le )?d(e|\u00c3\u00a9|\u00c3\u00a8)jeuner\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 10) (hour False 12)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleDernierWeekendDeTime :: Rule\nruleDernierWeekendDeTime = Rule\n  { name = \"dernier week-end de <time>\"\n  , pattern =\n    [ regex \"dernier week(\\\\s|-)?end (d['eu]|en|du mois de)\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        tt $ predLastOf weekend td\n      _ -> Nothing\n  }\n\nruleLeCycleProchainsuivantdaprs :: Rule\nruleLeCycleProchainsuivantdaprs = Rule\n  { name = \"le <cycle> prochain|suivant|d'apr\u00c3\u00a8s\"\n  , pattern =\n    [ regex \"l[ae']? ?|une? ?\"\n    , dimension TimeGrain\n    , regex \"prochaine?|suivante?|qui suit|(d'? ?)?apr(e|\u00c3\u00a8|\u00c3\u00a9)s\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleDimTimePartofday :: Rule\nruleDimTimePartofday = Rule\n  { name = \"<dim time> <part-of-day>\"\n  , pattern =\n    [ Predicate $ isGrainOfTime TG.Day\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleEnNamedmonth :: Rule\nruleEnNamedmonth = Rule\n  { name = \"en <named-month>\"\n  , pattern =\n    [ regex \"en|au mois de?'?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleEntreTimeofdayEtTimeofdayInterval :: Rule\nruleEntreTimeofdayEtTimeofdayInterval = Rule\n  { name = \"entre <time-of-day> et <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"entre\"\n    , Predicate isATimeOfDay\n    , regex \"et\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleIntersectByDeOr :: Rule\nruleIntersectByDeOr = Rule\n  { name = \"intersect by 'de' or ','\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"de|,\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleDeuximeQuinzaineDeNamedmonthinterval :: Rule\nruleDeuximeQuinzaineDeNamedmonthinterval = Rule\n  { name = \"deuxi\u00c3\u00a8me quinzaine de <named-month>(interval)\"\n  , pattern =\n    [ regex \"(deuxi(\u00c3\u00a8|e)me|2 ?(\u00c3\u00a8|e)me) (quinzaine|15 ?aine) d[e']\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        from <- intersect (dayOfMonth 15) td\n        let to = cycleLastOf TG.Day td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nrulePartofdayDuDimTime :: Rule\nrulePartofdayDuDimTime = Rule\n  { name = \"<part-of-day> du <dim time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"du\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(1[0-2]|0?[1-9])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m1\n        m <- parseInt m2\n        d <- parseInt m3\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTimeofdayHeures :: Rule\nruleTimeofdayHeures = Rule\n  { name = \"<time-of-day> heures\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"h\\\\.?(eure)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDernierDayofweekDeTimeLatent :: Rule\nruleDernierDayofweekDeTimeLatent = Rule\n  { name = \"dernier <day-of-week> de <time> (latent)\"\n  , pattern =\n    [ regex \"derni(e|\u00c3\u00a9|\u00c3\u00a8)re?\"\n    , Predicate isADayOfWeek\n    , regex \"d['e]\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleCeDayofweek :: Rule\nruleCeDayofweek = Rule\n  { name = \"ce <day-of-week>\"\n  , pattern =\n    [ regex \"ce\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleMatin :: Rule\nruleMatin = Rule\n  { name = \"matin\"\n  , pattern =\n    [ regex \"mat(in(\u00c3\u00a9|e)?e?)?\"\n    ]\n  , prod = \\_ -> Token Time . mkLatent . partOfDay <$>\n      interval TTime.Open (hour False 4) (hour False 12)\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleSeason2 :: Rule\nruleSeason2 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(cet )?automne\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (monthDay 9 23) (monthDay 12 21)\n  }\n\nruleVersTimeofday :: Rule\nruleVersTimeofday = Rule\n  { name = \"\u00c3\u00a0|vers <time-of-day>\"\n  , pattern =\n    [ regex \"(vers|autour de|(a|\u00c3\u00a0) environ|aux alentours de|(a|\u00c3\u00a0))\"\n    , Predicate $ and . sequence [isATimeOfDay, isNotLatent]\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleFinNamedmonthinterval :: Rule\nruleFinNamedmonthinterval = Rule\n  { name = \"fin <named-month>(interval)\"\n  , pattern =\n    [ regex \"fin( du mois d[e']? ?)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        from <- intersect (dayOfMonth 21) td\n        let to = cycleLastOf TG.Day td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleDayofweekDayofmonth :: Rule\nruleDayofweekDayofmonth = Rule\n  { name = \"<day-of-week> <day-of-month>\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleNameddayEnQuinze :: Rule\nruleNameddayEnQuinze = Rule\n  { name = \"<named-day> en quinze\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \"en (quinze|15)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 2 False td\n      _ -> Nothing\n  }\n\nruleLeDayofmonthNonOrdinal :: Rule\nruleLeDayofmonthNonOrdinal = Rule\n  { name = \"le <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"le\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt $ dayOfMonth n\n      _ -> Nothing\n  }\n\nruleIntersectByMaisparExempleplutt :: Rule\nruleIntersectByMaisparExempleplutt = Rule\n  { name = \"intersect by 'mais/par exemple/plut\u00c3\u00b4t'\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"mais|par exemple|plut(\u00c3\u00b4|o)t\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleLeCycleAprssuivantTime :: Rule\nruleLeCycleAprssuivantTime = Rule\n  { name = \"le <cycle> apr\u00c3\u00a8s|suivant <time>\"\n  , pattern =\n    [ regex \"l[ea']?\"\n    , dimension TimeGrain\n    , regex \"suivante?|apr(e|\u00c3\u00a8|\u00c3\u00a9)s\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleAprsdemain :: Rule\nruleAprsdemain = Rule\n  { name = \"apr\u00c3\u00a8s-demain\"\n  , pattern =\n    [ regex \"apr(e|\u00c3\u00a8)s[- ]?demain\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleIlYADuration :: Rule\nruleIlYADuration = Rule\n  { name = \"il y a <duration>\"\n  , pattern =\n    [ regex \"il y a\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleDudansLePartofday :: Rule\nruleDudansLePartofday = Rule\n  { name = \"du|dans le <part-of-day>\"\n  , pattern =\n    [ regex \"du|dans l[ae']? ?|au|en|l[ae' ]|d(\u00c3\u00a8|e)s l?[ae']?\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleAuDjeuner :: Rule\nruleAuDjeuner = Rule\n  { name = \"au d\u00c3\u00a9jeuner\"\n  , pattern =\n    [ regex \"((\u00c3\u00a0|a) l'heure du|au moment de|pendant( le)?|au)? d(e|\u00c3\u00a9|\u00c3\u00a8)jeuner\"\n    ]\n  , prod = \\_ -> Token Time . partOfDay <$>\n      interval TTime.Open (hour False 12) (hour False 14)\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ year n\n      _ -> Nothing\n  }\n\nruleMaintenant :: Rule\nruleMaintenant = Rule\n  { name = \"maintenant\"\n  , pattern =\n    [ regex \"maintenant|tout de suite\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd/-mm/-yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[/-](1[0-2]|0?[1-9])[-/](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleLeCycleAvantprcdentTime :: Rule\nruleLeCycleAvantprcdentTime = Rule\n  { name = \"le <cycle> avant|pr\u00c3\u00a9c\u00c3\u00a9dent <time>\"\n  , pattern =\n    [ regex \"l[ea']?\"\n    , dimension TimeGrain\n    , regex \"avant|pr(\u00c3\u00a9|e)c(\u00c3\u00a9|e)dent\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleDayOfMonthPremier :: Rule\nruleDayOfMonthPremier = Rule\n  { name = \"day of month (premier)\"\n  , pattern =\n    [ regex \"premier|prem\\\\.?|1 ?er\"\n    ]\n  , prod = \\_ -> tt $ dayOfMonth 1\n  }\n\nruleTimeofdayTimeofdayInterval :: Rule\nruleTimeofdayTimeofdayInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"\\\\-|(jusqu')?(au?|\u00c3\u00a0)\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleLeVeilleDuTime :: Rule\nruleLeVeilleDuTime = Rule\n  { name = \"le veille du <time>\"\n  , pattern =\n    [ regex \"(la )?veille du\"\n    , Predicate $ isGrainCoarserThan TG.Hour\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ cycleNthAfter True TG.Day (-1) td\n      _ -> Nothing\n  }\n\nruleLeTime :: Rule\nruleLeTime = Rule\n  { name = \"le <time>\"\n  , pattern =\n    [ regex \"l[ea]\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleSoirDeNol :: Rule\nruleSoirDeNol = Rule\n  { name = \"soir de no\u00c3\u00abl\"\n  , pattern =\n    [ regex \"soir(\u00c3\u00a9e)? de no(e|\u00c3\u00ab)l\"\n    ]\n  , prod = \\_ -> do\n      from <- intersect (monthDay 12 24) (hour False 18)\n      to <- intersect (monthDay 12 25) (hour False 0)\n      Token Time <$> interval TTime.Open from to\n  }\n\nruleDayofweekDayofmonthTimeofday :: Rule\nruleDayofweekDayofmonthTimeofday = Rule\n  { name = \"<day-of-week> <day-of-month> \u00c3\u00a0 <time-of-day>)\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , Predicate isDOMInteger\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:token:Token Time td2:_) -> do\n        dom <- intersectDOM td1 token\n        Token Time <$> intersect dom td2\n      _ -> Nothing\n  }\n\nruleJourDeLan :: Rule\nruleJourDeLan = Rule\n  { name = \"jour de l'an\"\n  , pattern =\n    [ regex \"(jour de l'|nouvel )an\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 1\n  }\n\nruleMinuit :: Rule\nruleMinuit = Rule\n  { name = \"minuit\"\n  , pattern =\n    [ regex \"minuit\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleNCycleSuivants :: Rule\nruleNCycleSuivants = Rule\n  { name = \"n <cycle> suivants\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"prochaine?s?|suivante?s?|apr(e|\u00c3\u00a8|\u00c3\u00a9)s|qui sui(t|ves?)|plus tard\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt $ cycleN True grain n\n      _ -> Nothing\n  }\n\nruleMidMonth :: Rule\nruleMidMonth = Rule\n  { name = \"<named-month>\"\n  , pattern =\n    [ regex \"mi[- ]\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        from <- intersect (dayOfMonth 10) td\n        to <- intersect (dayOfMonth 19) td\n        Token Time <$> interval TTime.Open from to\n      _ -> Nothing\n  }\n\nruleDayofweekErdayofweekDdMonthinterval :: Rule\nruleDayofweekErdayofweekDdMonthinterval = Rule\n  { name = \"<day-of-week> 1er-<day-of-week> dd <month>(interval)\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \"premier|prem\\\\.?|1er|1 er\"\n    , regex \"\\\\-|(jusqu')?au\"\n    , Predicate isADayOfWeek\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:_:_:_:Token RegexMatch (GroupMatch (m:_)):Token Time td:_) -> do\n        n <- parseInt m\n        from <- intersect (dayOfMonth 1) td\n        to <- intersect (dayOfMonth n) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleFinDuMois :: Rule\nruleFinDuMois = Rule\n  { name = \"fin du mois\"\n  , pattern =\n    [ regex \"(en |((\u00c3\u00a0|a) la ))?fin (du|de) (ce )?mois\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (dayOfMonth 21) (dayOfMonth 0)\n  }\n\nruleDbutDuMois :: Rule\nruleDbutDuMois = Rule\n  { name = \"d\u00c3\u00a9but du mois\"\n  , pattern =\n    [ regex \"(en |au )?d(\u00c3\u00a9|e)but (du|de) (ce )?mois\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (dayOfMonth 1) (dayOfMonth 10)\n  }\n\nruleFinDAnnee :: Rule\nruleFinDAnnee = Rule\n  { name = \"fin d'ann\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |(\u00c3\u00a0|a) la )?fin (d'|de l'|de cette )ann(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (month 11) (month 1)\n  }\n\nruleDbutDAnnee :: Rule\nruleDbutDAnnee = Rule\n  { name = \"d\u00c3\u00a9but d'ann\u00c3\u00a9e\"\n  , pattern =\n    [ regex \"(en |au )?d(\u00c3\u00a9|e)but (d'|de l'|de cette )ann(\u00c3\u00a9|e)e\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (month 1) (month 3)\n  }\n\nrulePlusTard :: Rule\nrulePlusTard = Rule\n  { name = \"plus tard\"\n  , pattern =\n    [ regex \"(un peu )?plus tard\"\n    ]\n  , prod = \\_ -> tt $ withDirection TTime.After $ cycleNth TG.Minute 10\n\n  }\n\nrulePlusTardPartofday :: Rule\nrulePlusTardPartofday = Rule\n  { name = \"plus tard <part-of-day>\"\n  , pattern =\n    [ regex \"(un peu )?plus tard\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDDMonthYY :: Rule\nruleDDMonthYY = Rule\n  { name = \"DD month YY\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 31\n    , Predicate isAMonth\n    , Predicate $ isIntegerBetween 32 99\n    ]\n  , prod = \\case\n      (dayd:Token Time monthd:yeard:_) -> do\n        d <- getIntValue dayd\n        y <- getIntValue yeard\n        dayMonth <- intersect monthd (dayOfMonth d)\n        ymd <- intersect dayMonth (year y)\n        tt ymd\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"Janvier\"   , \"janvier|janv\\\\.?\"          )\n  , ( \"Fevrier\"   , \"f(\u00c3\u00a9|e)vrier|f(\u00c3\u00a9|e)v\\\\.?\"   )\n  , ( \"Mars\"      , \"mars|mar\\\\.?\"              )\n  , ( \"Avril\"     , \"avril|avr\\\\.?\"             )\n  , ( \"Mai\"       , \"mai\"                       )\n  , ( \"Juin\"      , \"juin|jun\\\\.?\"              )\n  , ( \"Juillet\"   , \"juillet|juil?\\\\.?\"         )\n  , ( \"Aout\"      , \"ao(\u00c3\u00bb|u)t|aou\\\\.?\"          )\n  , ( \"Septembre\" , \"septembre|sept?\\\\.?\"       )\n  , ( \"Octobre\"   , \"octobre|oct\\\\.?\"           )\n  , ( \"Novembre\"  , \"novembre|nov\\\\.?\"          )\n  , ( \"Decembre\"  ,  \"d(\u00c3\u00a9|e)cembre|d(\u00c3\u00a9|e)c\\\\.?\" )\n  ]\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Lundi\"    , \"lun\\\\.?(di)?\"    )\n  , ( \"Mardi\"    , \"mar\\\\.?(di)?\"    )\n  , ( \"Mercredi\" , \"mer\\\\.?(credi)?\" )\n  , ( \"Jeudi\"    , \"jeu\\\\.?(di)?\"    )\n  , ( \"Vendredi\" , \"ven\\\\.?(dredi)?\" )\n  , ( \"Samedi\"   , \"sam\\\\.?(edi)?\"   )\n  , ( \"Dimanche\" , \"dim\\\\.?(anche)?\" )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleAprsLeDayofmonth\n  , ruleAprsLeDjeuner\n  , ruleAprsLeTravail\n  , ruleAprsTimeofday\n  , ruleAprsdemain\n  , ruleAprsmidi\n  , ruleAuDjeuner\n  , ruleAujourdhui\n  , ruleAvantLeDjeuner\n  , ruleAvantTimeofday\n  , ruleAvanthier\n  , ruleCeDayofweek\n  , ruleCePartofday\n  , ruleCeTime\n  , ruleCedansLeCycle\n  , ruleCycleDernier\n  , ruleCycleProchainsuivantdaprs\n  , ruleDansDuration\n  , ruleDatetimeDatetimeInterval\n  , ruleDatetimedayofweekDdMonthinterval\n  , ruleDatetimeddMonthinterval\n  , ruleDayOfMonthPremier\n  , ruleDayofmonthNamedmonth\n  , ruleDayofweekDayofmonth\n  , ruleDayofweekDayofmonthTimeofday\n  , ruleMidMonth\n  , ruleDayofweekErdayofweekDdMonthinterval\n  , ruleDayofweekProchain\n  , ruleDbutDaprsmidi\n  , ruleDbutDeJourne\n  , ruleDbutDeMatine\n  , ruleDbutDeSemaine\n  , ruleDbutNamedmonthinterval\n  , ruleDdMm\n  , ruleDdMmYyyy\n  , ruleDdddMonthinterval\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleDeDatetimeDatetimeInterval\n  , ruleDeTimeofdayTimeofdayInterval\n  , ruleDemain\n  , ruleDernierCycleDeTimeLatent\n  , ruleDernierDayofweekDeTimeLatent\n  , ruleDernierWeekendDeTime\n  , ruleDeuximeQuinzaineDeNamedmonthinterval\n  , ruleDiciDuration\n  , ruleDimTimeDuMatin\n  , ruleDimTimeDuSoir\n  , ruleDimTimePartofday\n  , ruleDuDatetimedayofweekDdMonthinterval\n  , ruleDuDdAuDdLatentMonthInterval\n  , ruleDuDdAuDdMonthInterval\n  , ruleDuDddayofweekDdMonthinterval\n  , ruleDudansLePartofday\n  , ruleDurationApresTime\n  , ruleDurationAvantTime\n  , ruleEnNamedmonth\n  , ruleEnSemaine\n  , ruleEntreDatetimeEtDatetimeInterval\n  , ruleEntreDdEtDdMonthinterval\n  , ruleEntreTimeofdayEtTimeofdayInterval\n  , ruleErMai\n  , ruleMilieuDaprsmidi\n  , ruleFinDaprsmidi\n  , ruleMilieuDeJourne\n  , ruleFinDeJourne\n  , ruleMilieuDeMatine\n  , ruleFinDeMatine\n  , ruleFinDeSemaine\n  , ruleFinNamedmonthinterval\n  , ruleHhhmmTimeofday\n  , ruleHhmmMilitaryTimeofday\n  , ruleHier\n  , ruleIlYADuration\n  , ruleIntersect\n  , ruleIntersectByDeOr\n  , ruleIntersectByMaisparExempleplutt\n  , ruleJourDeLan\n  , ruleLeCycleAprssuivantTime\n  , ruleLeCycleAvantprcdentTime\n  , ruleLeCycleDeTime\n  , ruleLeCycleDernier\n  , ruleLeCycleProchainsuivantdaprs\n  , ruleLeDayofmonthDatetime\n  , ruleLeDayofmonthNonOrdinal\n  , ruleLeLendemainDuTime\n  , ruleLeOrdinalCycleDeTime\n  , ruleLeTime\n  , ruleLeVeilleDuTime\n  , ruleMaintenant\n  , ruleMatin\n  , ruleMidi\n  , ruleMilieuDeSemaine\n  , ruleMinuit\n  , ruleNCycleAprs\n  , ruleNCycleAvant\n  , ruleNCyclePassesprecedents\n  , ruleNCycleSuivants\n  , ruleNDerniersCycle\n  , ruleNProchainsCycle\n  , ruleNameddayEnHuit\n  , ruleNameddayEnQuinze\n  , ruleNamedmonthProchain\n  , ruleNamedmonthnameddayDernierpass\n  , ruleNamedmonthnameddaySuivantdaprs\n  , ruleNoel\n  , ruleOrdinalCycleDeTime\n  , ruleOrdinalWeekendDeTime\n  , rulePartofdayDuDimTime\n  , rulePremireQuinzaineDeNamedmonthinterval\n  , ruleSeason\n  , ruleSeason2\n  , ruleSeason3\n  , ruleSeason4\n  , ruleSoir\n  , ruleDbutDeSoire\n  , ruleFinDeSoire\n  , ruleSoirDeNol\n  , ruleTimeofdayHeures\n  , ruleTimeofdayLatent\n  , ruleTimeofdayTimeofdayInterval\n  , ruleToussaint\n  , ruleVersTimeofday\n  , ruleWeekend\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYyyymmdd\n  , ruleHourofdayMoinsQuart\n  , ruleHourofdayMoinsIntegerAsRelativeMinutes\n  , ruleHourofdayIntegerMinutes\n  , ruleHourofdayInteger\n  , ruleHourofdayEtpassDeNumeral\n  , ruleHourofdayEtpassDeNumeralMinutes\n  , ruleHourofdayEtTroisQuart\n  , ruleHourofdayEtQuart\n  , ruleHourofdayEtDemi\n  , ruleFinDuMois\n  , ruleTimezone\n  , ruleDbutDuMois\n  , ruleFinDAnnee\n  , ruleDbutDAnnee\n  , rulePlusTard\n  , rulePlusTardPartofday\n  , ruleNthTimeOfTime\n  , ruleTheNthTimeOfTime\n  , ruleDDMonthYY\n  ]\n  ++ ruleMonths\n  ++ ruleDaysOfWeek\n", "num_lines": 2128}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.GA.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Time.Corpus\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Testing.Types hiding (examples)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"anois\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"inniu\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"inn\u00c3\u00a9\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"ar\u00c3\u00ba inn\u00c3\u00a9\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"am\u00c3\u00a1rach\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"ar\u00c3\u00ba am\u00c3\u00a1rach\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"d\u00c3\u00a9 luain\"\n             , \"an luan\"\n             , \"an luan seo\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"an luan seo chugainn\"\n             , \"an luan seo at\u00c3\u00a1 ag teacht\"\n             , \"d\u00c3\u00a9 luain seo chugainn\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"18/2/2013\"\n             ]\n  ]\n", "num_lines": 60}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.GA.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Types\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleArInn :: Rule\nruleArInn = Rule\n  { name = \"ar\u00c3\u00ba inn\u00c3\u00a9\"\n  , pattern =\n    [ regex \"ar(\u00c3\u00ba|u) inn(\u00c3\u00a9|e)\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 2\n  }\n\nruleNollaigNaMban :: Rule\nruleNollaigNaMban = Rule\n  { name = \"Nollaig na mBan\"\n  , pattern =\n    [ regex \"(l(\u00c3\u00a1|a) |an )?nollaig (bheag|na mban)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 6\n  }\n\nruleInniu :: Rule\nruleInniu = Rule\n  { name = \"inniu\"\n  , pattern =\n    [ regex \"inniu\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleAnOrdinalCycleINdiaidhTime :: Rule\nruleAnOrdinalCycleINdiaidhTime = Rule\n  { name = \"an <ordinal> <cycle> i ndiaidh <time>\"\n  , pattern =\n    [ regex \"an\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"(i ndiaidh|tar (\u00c3\u00a9|e)is)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleInn :: Rule\nruleInn = Rule\n  { name = \"inn\u00c3\u00a9\"\n  , pattern =\n    [ regex \"inn(\u00c3\u00a9|e)\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleLFhileBrde :: Rule\nruleLFhileBrde = Rule\n  { name = \"L\u00c3\u00a1 Fh\u00c3\u00a9ile Br\u00c3\u00adde\"\n  , pattern =\n    [ regex \"(l(\u00c3\u00a1|a) )?(fh(e|\u00c3\u00a9)ile|'?le) bh?r(\u00c3\u00ad|i)de\"\n    ]\n  , prod = \\_ -> tt $ monthDay 2 1\n  }\n\nruleLFhileVailintn :: Rule\nruleLFhileVailintn = Rule\n  { name = \"L\u00c3\u00a1 Fh\u00c3\u00a9ile Vailint\u00c3\u00adn\"\n  , pattern =\n    [ regex \"(l(\u00c3\u00a1|a) )?(fh(e|\u00c3\u00a9)ile|'?le) vailint(\u00c3\u00ad|i)n\"\n    ]\n  , prod = \\_ -> tt $ monthDay 2 14\n  }\n\nruleTimeSeo :: Rule\nruleTimeSeo = Rule\n  { name = \"<time> seo\"\n  , pattern =\n    [ dimension Time\n    , regex \"seo\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleTimeSeoChaite :: Rule\nruleTimeSeoChaite = Rule\n  { name = \"<time> seo chaite\"\n  , pattern =\n    [ dimension Time\n    , regex \"seo ch?aite\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleTimeSeoChugainn :: Rule\nruleTimeSeoChugainn = Rule\n  { name = \"<time> seo chugainn\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"seo (chugainn|at(a|\u00c3\u00a1) ag teacht)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleAmrach :: Rule\nruleAmrach = Rule\n  { name = \"am\u00c3\u00a1rach\"\n  , pattern =\n    [ regex \"am(\u00c3\u00a1|a)rach\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleOrdinalRithe :: Rule\nruleOrdinalRithe = Rule\n  { name = \"<ordinal> r\u00c3\u00a1ithe\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleAnnaCycleRoimhTime :: Rule\nruleAnnaCycleRoimhTime = Rule\n  { name = \"(an|na) <cycle> roimh <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension TimeGrain\n    , regex \"roimh\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleCycleShin :: Rule\nruleCycleShin = Rule\n  { name = \"<cycle> \u00c3\u00b3 shin\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(\u00c3\u00b3|o) shin\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ 1\n      _ -> Nothing\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])/(0?[1-9]|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleIGceannCycle :: Rule\nruleIGceannCycle = Rule\n  { name = \"i gceann <cycle>\"\n  , pattern =\n    [ regex \"(i|faoi) g?ch?eann\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_) ->\n        tt $ cycleN True grain (TOrdinal.value od)\n      _ -> Nothing\n  }\n\nruleAnCycleDeTime :: Rule\nruleAnCycleDeTime = Rule\n  { name = \"an <cycle> de <time>\"\n  , pattern =\n    [ regex \"an\"\n    , dimension TimeGrain\n    , regex \"d[e']\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonth :: Rule\nruleDayofmonthordinalNamedmonth = Rule\n  { name = \"<day-of-month>(ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by \\\",\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleOrdinalRitheYear :: Rule\nruleOrdinalRitheYear = Rule\n  { name = \"<ordinal> r\u00c3\u00a1ithe <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:_:Token Time td:_) ->\n        tt $ cycleNthAfter False TG.Quarter (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleCycleInniu :: Rule\nruleCycleInniu = Rule\n  { name = \"<cycle> \u00c3\u00b3 inniu\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    , regex \"(\u00c3\u00b3|o)(n l(\u00c3\u00a1|a) (at(\u00c3\u00a1|a) )?)?inniu\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleOrdinalCycleINdiaidhTime :: Rule\nruleOrdinalCycleINdiaidhTime = Rule\n  { name = \"<ordinal> <cycle> i ndiaidh <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"(i ndiaidh|tar (\u00c3\u00a9|e)is)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleAnDayofmonthOrdinal :: Rule\nruleAnDayofmonthOrdinal = Rule\n  { name = \"an <day-of-month> (ordinal)\"\n  , pattern =\n    [ regex \"an|na\"\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt $ dayOfMonth n\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAnOrdinalCycleDeTime :: Rule\nruleAnOrdinalCycleDeTime = Rule\n  { name = \"an <ordinal> <cycle> de <time>\"\n  , pattern =\n    [ regex \"an\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"d[e']\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleLNaNaithreacha :: Rule\nruleLNaNaithreacha = Rule\n  { name = \"L\u00c3\u00a1 na nAithreacha\"\n  , pattern =\n    [ regex \"l(\u00c3\u00a1|a) na naithreacha\"\n    ]\n  , prod = \\_ -> tt $ nthDOWOfMonth 2 7 6\n  }\n\nruleArAmrach :: Rule\nruleArAmrach = Rule\n  { name = \"ar\u00c3\u00ba am\u00c3\u00a1rach\"\n  , pattern =\n    [ regex \"ar(\u00c3\u00ba|u) am(\u00c3\u00a1|a)rach\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleOrdinalCycleDeTime :: Rule\nruleOrdinalCycleDeTime = Rule\n  { name = \"<ordinal> <cycle> de <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"d[e']\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m1\n        m <- parseInt m2\n        d <- parseInt m3\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleArDate :: Rule\nruleArDate = Rule\n  { name = \"ar <date>\"\n  , pattern =\n    [ regex \"ar\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleAnNollaig :: Rule\nruleAnNollaig = Rule\n  { name = \"An Nollaig\"\n  , pattern =\n    [ regex \"(l(\u00c3\u00a1|a) |an )?(nollai?g)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleOnANamedday :: Rule\nruleOnANamedday = Rule\n  { name = \"on a named-day\"\n  , pattern =\n    [ regex \"ar an\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleAnois :: Rule\nruleAnois = Rule\n  { name = \"anois\"\n  , pattern =\n    [ regex \"anois|(ag an (t-?)?am seo)\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleLFhilePdraig :: Rule\nruleLFhilePdraig = Rule\n  { name = \"L\u00c3\u00a1 Fh\u00c3\u00a9ile P\u00c3\u00a1draig\"\n  , pattern =\n    [ regex \"(l(\u00c3\u00a1|a) )?(fh(e|\u00c3\u00a9)ile|'?le) ph?(\u00c3\u00a1|a)draig\"\n    ]\n  , prod = \\_ -> tt $ monthDay 3 17\n  }\n\nruleAnCycleINdiaidhTime :: Rule\nruleAnCycleINdiaidhTime = Rule\n  { name = \"an <cycle> i ndiaidh <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension TimeGrain\n    , regex \"(i ndiaidh|tar (\u00c3\u00a9|e)is)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleDayofmonthOrdinal :: Rule\nruleDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ dayOfMonth n\n      _ -> Nothing\n  }\n\nruleAnCycleSeo :: Rule\nruleAnCycleSeo = Rule\n  { name = \"an <cycle> seo\"\n  , pattern =\n    [ regex \"an\"\n    , dimension TimeGrain\n    , regex \"seo\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleAnDayofmonthNonOrdinal :: Rule\nruleAnDayofmonthNonOrdinal = Rule\n  { name = \"an <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"an|na\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleDNamedday :: Rule\nruleDNamedday = Rule\n  { name = \"d\u00c3\u00a9 named-day\"\n  , pattern =\n    [ regex \"d(\u00c3\u00a9|e)\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt $ year v\n      _ -> Nothing\n  }\n\nruleCycleRoimhTime :: Rule\nruleCycleRoimhTime = Rule\n  { name = \"<cycle> roimh <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"roimhe?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/](0?[1-9]|1[0-2])[/-](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleAnNamedday :: Rule\nruleAnNamedday = Rule\n  { name = \"an named-day\"\n  , pattern =\n    [ regex \"an\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Monday\"   , \"luai?n|lu\\\\.?\"             )\n  , ( \"Tuesday\"  , \"mh?(\u00c3\u00a1|a)irt|m(\u00c3\u00a1|a)?\\\\.?\"   )\n  , ( \"Wednesday\", \"ch?(\u00c3\u00a9|e)adaoin|c(\u00c3\u00a9|e)\\\\.?\" )\n  , ( \"Thursday\" , \"d(\u00c3\u00a9|e)ardaoin|d(\u00c3\u00a9|e)?\\\\.?\" )\n  , ( \"Friday\"   , \"h?aoine|ao\\\\.?\"            )\n  , ( \"Saturday\" , \"sathai?rn|sa\\\\.?\"          )\n  , ( \"Sunday\"   , \"domhnai?[cg]h|do\\\\.?\"      )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"January\"  , \"(mh?(\u00c3\u00ad|i) )?(an )?t?ean(\u00c3\u00a1|a)ir|ean\\\\.?\"     )\n  , ( \"February\" , \"(mh?(\u00c3\u00ad|i) )?(na )?feabhra|fea\\\\.?\"          )\n  , ( \"March\"    , \"(mh?(\u00c3\u00ad|i) )?(an )?mh?(\u00c3\u00a1|a)rta|m(\u00c3\u00a1|a)r\\\\.?\"  )\n  , ( \"April\"    , \"(mh?(\u00c3\u00ad|i) )?(an )?t?aibre(\u00c3\u00a1|a)i?n|abr\\\\.?\"  )\n  , ( \"May\"      , \"(mh?(\u00c3\u00ad|i) )?(na )?bh?ealtaine|bea\\\\.?\"      )\n  , ( \"June\"     , \"(mh?(\u00c3\u00ad|i) )?(an )?mh?eith(ea|i)mh|mei\\\\.?\"  )\n  , ( \"July\"     , \"(mh?(\u00c3\u00ad|i) )?i(\u00c3\u00ba|u)il|i(\u00c3\u00ba|u)i\\\\.?\"           )\n  , ( \"August\"   , \"(mh?(\u00c3\u00ad|i) )?(na )?l(\u00c3\u00ba|u)nasa|l(\u00c3\u00ba|u)n\\\\.?\"   )\n  , ( \"September\", \"(mh?(\u00c3\u00ad|i) )?mh?e(\u00c3\u00a1|a)n f(\u00c3\u00b3|o)mhair|mef?\\\\.?\")\n  , ( \"October\"  , \"(mh?(\u00c3\u00ad|i) )?(na )?nollai?g|nol\\\\.?\"         )\n  , ( \"November\" , \"(mh?(\u00c3\u00ad|i) )?(na )?samh(ain|na)|sam\\\\.?\"     )\n  , ( \"December\" , \"(mh?(\u00c3\u00ad|i) )?(na )?nollai?g|nol\\\\.?\"         )\n  ]\n\nruleCycleINdiaidhTime :: Rule\nruleCycleINdiaidhTime = Rule\n  { name = \"<cycle> i ndiaidh <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(i ndiaidh|tar (\u00c3\u00a9|e)is)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonthYear :: Rule\nruleDayofmonthordinalNamedmonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:Token RegexMatch (GroupMatch (match:_)):_) -> do\n        intVal <- parseInt match\n        dom <- intersectDOM td token\n        Token Time <$> intersect dom (year intVal)\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAbsorptionOfAfterNamedDay\n  , ruleAmrach\n  , ruleAnCycleDeTime\n  , ruleAnCycleINdiaidhTime\n  , ruleAnCycleSeo\n  , ruleAnDayofmonthNonOrdinal\n  , ruleAnDayofmonthOrdinal\n  , ruleAnNamedday\n  , ruleAnNollaig\n  , ruleAnOrdinalCycleDeTime\n  , ruleAnOrdinalCycleINdiaidhTime\n  , ruleAnnaCycleRoimhTime\n  , ruleAnois\n  , ruleArAmrach\n  , ruleArDate\n  , ruleArInn\n  , ruleCycleINdiaidhTime\n  , ruleCycleInniu\n  , ruleCycleRoimhTime\n  , ruleCycleShin\n  , ruleDNamedday\n  , ruleDayofmonthOrdinal\n  , ruleDayofmonthordinalNamedmonth\n  , ruleDayofmonthordinalNamedmonthYear\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleIGceannCycle\n  , ruleInn\n  , ruleInniu\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleLFhileBrde\n  , ruleLFhilePdraig\n  , ruleLFhileVailintn\n  , ruleLNaNaithreacha\n  , ruleNollaigNaMban\n  , ruleOnANamedday\n  , ruleOrdinalCycleDeTime\n  , ruleOrdinalCycleINdiaidhTime\n  , ruleOrdinalRithe\n  , ruleOrdinalRitheYear\n  , ruleTimeSeo\n  , ruleTimeSeoChaite\n  , ruleTimeSeoChugainn\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYyyymmdd\n  ]\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n", "num_lines": 714}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.HU.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Time.Corpus\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Testing.Types hiding (examples)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HU Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"most\"\n             , \"\u00c3\u00a9pp most\"\n             , \"azonnal\"\n             , \"mostani\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"ma\"\n             , \"m\u00c3\u00a1ma\"\n             , \"Mai nap\"\n             , \"Mai napot\"\n             , \"mai napon\"\n             , \"mai\"\n             , \"mait\"\n             , \"mai napi\"\n             , \"mai napit\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"holnap\"\n             , \"holnapi\"\n             , \"holnapit\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"holnaput\u00c3\u00a1n\"\n             , \"holnaput\u00c3\u00a1ni\"\n             , \"holnaput\u00c3\u00a1nit\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"tegnap\"\n             , \"tegnapi\"\n             , \"tegnapit\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"tegnapel\u00c5\u2018tt\"\n             , \"tegnapel\u00c5\u2018tti\"\n             , \"tegnapel\u00c5\u2018ttit\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"h\u00c3\u00b3nap v\u00c3\u00a9ge\"\n             , \"a h\u00c3\u00b3nap v\u00c3\u00a9ge\"\n             , \"h\u00c3\u00b3 v\u00c3\u00a9ge\"\n             , \"h\u00c3\u00b3 v\u00c3\u00a9gi\"\n             , \"h\u00c3\u00b3 v\u00c3\u00a9git\"\n             , \"h\u00c3\u00b3 v\u00c3\u00a9g\u00c3\u00a9n\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"\u00c3\u00a9v v\u00c3\u00a9ge\"\n             , \"az \u00c3\u00a9v v\u00c3\u00a9ge\"\n             , \"\u00c3\u00a9v v\u00c3\u00a9gi\"\n             , \"\u00c3\u00a9v v\u00c3\u00a9git\"\n             , \"\u00c3\u00a9v v\u00c3\u00a9g\u00c3\u00a9n\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"h\u00c3\u00a9tf\u00c5\u2018\"\n             , \"h\u00c3\u00a9tf\u00c5\u2018n\"\n             , \"h\u00c3\u00a9tf\u00c5\u2018t\"\n             , \"h\u00c3\u00a9tf\u00c5\u2018i\"\n             , \"h\u00c3\u00a9tf\u00c5\u2018it\"\n             , \"h\u00c3\u00a9t.\"\n             , \"h\u00c3\u00a9t\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"kedd\"\n             , \"kedden\"\n             , \"keddet\"\n             , \"keddi\"\n             , \"keddit\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"szerda\"\n             , \"szerd\u00c3\u00a1n\"\n             , \"szerd\u00c3\u00a1t\"\n             , \"szerdai\"\n             , \"szerdait\"\n             , \"szer\"\n             , \"szer.\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"cs\u00c3\u00bct\u00c3\u00b6rt\u00c3\u00b6k\"\n             , \"cs\u00c3\u00bct\u00c3\u00b6rt\u00c3\u00b6k\u00c3\u00b6n\"\n             , \"cs\u00c3\u00bct\u00c3\u00b6rt\u00c3\u00b6k\u00c3\u00b6t\"\n             , \"cs\u00c3\u00bct\u00c3\u00b6rt\u00c3\u00b6ki\"\n             , \"cs\u00c3\u00bct\u00c3\u00b6rt\u00c3\u00b6kit\"\n             , \"cs\u00c3\u00bct\"\n             , \"cs\u00c3\u00bct.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"p\u00c3\u00a9ntek\"\n             , \"p\u00c3\u00a9nteken\"\n             , \"p\u00c3\u00a9nteket\"\n             , \"p\u00c3\u00a9nteki\"\n             , \"p\u00c3\u00a9ntekit\"\n             , \"p\u00c3\u00a9n\"\n             , \"p\u00c3\u00a9n.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"szombat\"\n             , \"szombaton\"\n             , \"szombatot\"\n             , \"szombati\"\n             , \"szombatit\"\n             , \"szom\"\n             , \"szom.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"vas\u00c3\u00a1rnap\"\n             , \"vas\u00c3\u00a1rnapot\"\n             , \"vas\u00c3\u00a1rnapi\"\n             , \"vas\u00c3\u00a1rnapit\"\n             , \"vas\"\n             , \"vas.\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Month)\n             [ \"janu\u00c3\u00a1r\"\n             , \"janu\u00c3\u00a1rban\"\n             , \"janu\u00c3\u00a1ri\"\n             , \"janu\u00c3\u00a1rit\"\n             , \"jan\"\n             , \"jan.\"\n             ]\n  , examples (datetime (2013, 2, 1, 0, 0, 0) Month)\n             [ \"febru\u00c3\u00a1r\"\n             , \"febru\u00c3\u00a1rban\"\n             , \"febru\u00c3\u00a1ri\"\n             , \"febru\u00c3\u00a1rit\"\n             , \"feb\"\n             , \"feb.\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"m\u00c3\u00a1rcius\"\n             , \"m\u00c3\u00a1rciusban\"\n             , \"m\u00c3\u00a1rciusi\"\n             , \"m\u00c3\u00a1rciusit\"\n             , \"m\u00c3\u00a1r\"\n             , \"m\u00c3\u00a1r.\"\n             , \"m\u00c3\u00a1rc\"\n             , \"m\u00c3\u00a1rc.\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Month)\n             [ \"\u00c3\u00a1prilis\"\n             , \"\u00c3\u00a1prilisban\"\n             , \"\u00c3\u00a1prilisi\"\n             , \"\u00c3\u00a1prilisit\"\n             , \"\u00c3\u00a1pr\"\n             , \"\u00c3\u00a1pr.\"\n             ]\n  , examples (datetime (2013, 5, 1, 0, 0, 0) Month)\n             [ \"m\u00c3\u00a1jus\"\n             , \"m\u00c3\u00a1jusban\"\n             , \"m\u00c3\u00a1jusi\"\n             , \"m\u00c3\u00a1jusit\"\n             , \"m\u00c3\u00a1j\"\n             , \"m\u00c3\u00a1j.\"\n             ]\n  , examples (datetime (2013, 6, 1, 0, 0, 0) Month)\n             [ \"j\u00c3\u00banius\"\n             , \"j\u00c3\u00baniusban\"\n             , \"j\u00c3\u00baniusi\"\n             , \"j\u00c3\u00baniusit\"\n             , \"j\u00c3\u00ban\"\n             , \"j\u00c3\u00ban.\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Month)\n             [ \"j\u00c3\u00balius\"\n             , \"j\u00c3\u00baliusban\"\n             , \"j\u00c3\u00baliusi\"\n             , \"j\u00c3\u00baliusit\"\n             , \"j\u00c3\u00bal\"\n             , \"j\u00c3\u00bal.\"\n             ]\n  , examples (datetime (2013, 8, 1, 0, 0, 0) Month)\n             [ \"augusztus\"\n             , \"augusztusban\"\n             , \"augusztusi\"\n             , \"augusztusit\"\n             , \"aug\"\n             , \"aug.\"\n             ]\n  , examples (datetime (2013, 9, 1, 0, 0, 0) Month)\n             [ \"szeptember\"\n             , \"szeptemberben\"\n             , \"szeptemberi\"\n             , \"szeptemberit\"\n             , \"szep\"\n             , \"szep.\"\n             , \"szept\"\n             , \"szept.\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Month)\n             [ \"okt\u00c3\u00b3ber\"\n             , \"okt\u00c3\u00b3berben\"\n             , \"okt\u00c3\u00b3beri\"\n             , \"okt\u00c3\u00b3berit\"\n             , \"okt\"\n             , \"okt.\"\n             ]\n  , examples (datetime (2013, 11, 1, 0, 0, 0) Month)\n             [ \"november\"\n             , \"novemberben\"\n             , \"novemberi\"\n             , \"novemberit\"\n             , \"nov\"\n             , \"nov.\"\n             ]\n  , examples (datetime (2013, 12, 1, 0, 0, 0) Month)\n             [ \"december\"\n             , \"decemberben\"\n             , \"decemberi\"\n             , \"decemberit\"\n             , \"dec\"\n             , \"dec.\"\n             ]\n  , examples (datetime (2013, 3, 15, 0, 0, 0) Day)\n             [ \"m\u00c3\u00a1rcius 15\"\n             , \"m\u00c3\u00a1rcius 15.\"\n             , \"m\u00c3\u00a1r 15\"\n             , \"m\u00c3\u00a1r. 15\"\n             , \"m\u00c3\u00a1rc 15\"\n             , \"m\u00c3\u00a1rc. 15\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n            [ \"m\u00c3\u00a1rcius 1-\u00c3\u00a9n\"\n            , \"m\u00c3\u00a1rcius 1-j\u00c3\u00a9n\"\n            , \"m\u00c3\u00a1rcius 1-je\"\n            , \"m\u00c3\u00a1rcius 1-jei\"\n            , \"m\u00c3\u00a1rcius 1-i\"\n            , \"m\u00c3\u00a1rcius 1\u00c3\u00a9n\"\n            , \"m\u00c3\u00a1rcius 1je\"\n            , \"m\u00c3\u00a1rcius 1jei\"\n            , \"m\u00c3\u00a1rcius 1i\"\n            ]\n  , examples (datetime (2013, 3, 2, 0, 0, 0) Day)\n            [ \"m\u00c3\u00a1rcius 2-\u00c3\u00a1n\"\n            , \"m\u00c3\u00a1rcius 2-ai\"\n            , \"m\u00c3\u00a1rcius 2-a\"\n            , \"m\u00c3\u00a1rcius 2\u00c3\u00a1n\"\n            , \"m\u00c3\u00a1rcius 2ai\"\n            , \"m\u00c3\u00a1rcius 2a\"\n            ]\n  , examples (datetime (2013, 3, 4, 0, 0, 0) Day)\n            [ \"m\u00c3\u00a1rcius 4-e\"\n            , \"m\u00c3\u00a1rcius 4e\"\n            ]\n  , examples (datetime (2013, 3, 7, 0, 0, 0) Day)\n            [ \"m\u00c3\u00a1rcius 7-ei\"\n            , \"m\u00c3\u00a1rcius 7ei\"\n            ]\n  , examples (datetime (2013, 3, 15, 0, 0, 0) Day)\n            [ \"m\u00c3\u00a1rcius 15-\u00c3\u00a9n\"\n            , \"m\u00c3\u00a1rcius 15-ei\"\n            , \"m\u00c3\u00a1rcius 15-i\"\n            , \"m\u00c3\u00a1rcius 15\u00c3\u00a9n\"\n            , \"m\u00c3\u00a1rcius 15e\"\n            , \"m\u00c3\u00a1rcius 15ei\"\n            ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"k\u00c3\u00b6vetkez\u00c5\u2018 h\u00c3\u00b3nap\"\n             , \"j\u00c3\u00b6v\u00c5\u2018 h\u00c3\u00b3nap\"\n             ]\n  , examples (datetime (2012, 1, 1, 0, 0, 0) Year)\n             [ \"el\u00c5\u2018z\u00c5\u2018 \u00c3\u00a9v\"\n             , \"m\u00c3\u00balt \u00c3\u00a9v\"\n             ]\n  , examples (datetime (2013, 2, 21, 0, 0, 0) Day)\n             [ \"j\u00c3\u00b6v\u00c5\u2018 cs\u00c3\u00bct\u00c3\u00b6rt\u00c3\u00b6k\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"15:20\"\n             ]\n  , examples (datetime (2013, 2, 12, 8, 20, 0) Minute)\n             [ \"08:20\"\n             , \"8:20\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 44) Second)\n             [ \"15:20:44\"\n             ]\n  , examples (datetime (2013, 2, 12, 8, 20, 44) Second)\n             [ \"08:20:44\"\n             , \"8:20:44\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"de 11\"\n             , \"de. 11\"\n             , \"d\u00c3\u00a9lel\u00c5\u2018tt 11\"\n             ]\n  , examples (datetime (2013, 2, 12, 23, 0, 0) Hour)\n             [ \"du 11\"\n             , \"du. 11\"\n             , \"d\u00c3\u00a9lut\u00c3\u00a1n 11\"\n             ]\n  , examples (datetime (2013, 2, 13, 23, 0, 0) Hour)\n             [ \"szerda du 11\"\n             , \"szerda du. 11\"\n             , \"szerda d\u00c3\u00a9lut\u00c3\u00a1n 11\"\n             ]\n  , examples (datetime (2013, 2, 20, 23, 0, 0) Hour)\n             [ \"j\u00c3\u00b6v\u00c5\u2018 szerda du 11\"\n             , \"j\u00c3\u00b6v\u00c5\u2018 szerda du. 11\"\n             , \"j\u00c3\u00b6v\u00c5\u2018 szerda d\u00c3\u00a9lut\u00c3\u00a1n 11\"\n             ]\n  , examples (datetime (2013, 8, 20, 0, 0, 0) Day)\n             [ \"2013.08.20\"\n             , \"2013 . 08 . 20\"\n             , \"2013-08-20\"\n             , \"2013 - 08 - 20\"\n             ]\n  , examples (datetime (2013, 8, 20, 11, 45, 0) Minute)\n             [ \"2013.08.20 11:45\"\n             ]\n  , examples (datetime (2013, 8, 20, 17, 0, 0) Hour)\n             [ \"2013.08.20 d\u00c3\u00a9lut\u00c3\u00a1n 5\"\n             ]\n  , examples (datetime (2013, 8, 20, 0, 0, 0) Day)\n             [ \"08.20\"\n             , \"08 . 20\"\n             , \"08-20\"\n             , \"08 - 20\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 6, 0, 0), (2013, 2, 12, 10, 0, 0)) Hour)\n             [ \"ma reggel\"\n             , \"reggel\"\n             , \"ma reggeli\"\n             , \"reggeli\"\n             , \"ma reggelit\"\n             , \"reggelit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 8, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"d\u00c3\u00a9lel\u00c5\u2018tt\"\n             , \"d\u00c3\u00a9lel\u00c5\u2018tti\"\n             , \"d\u00c3\u00a9lel\u00c5\u2018ttit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 13, 0, 0)) Hour)\n             [ \"d\u00c3\u00a9lben\"\n             , \"d\u00c3\u00a9li\"\n             , \"d\u00c3\u00a9lit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 8, 0, 0), (2013, 2, 13, 12, 0, 0)) Hour)\n             [ \"holnap d\u00c3\u00a9lel\u00c5\u2018tt\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 12, 0, 0), (2013, 2, 11, 13, 0, 0)) Hour)\n             [ \"tegnap d\u00c3\u00a9lben\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 18, 0, 0)) Hour)\n             [ \"ma d\u00c3\u00a9lut\u00c3\u00a1n\"\n             , \"d\u00c3\u00a9lut\u00c3\u00a1n\"\n             , \"d\u00c3\u00a9lut\u00c3\u00a1ni\"\n             , \"d\u00c3\u00a9lut\u00c3\u00a1nit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 16, 0, 0), (2013, 2, 12, 20, 0, 0)) Hour)\n             [ \"ma este\"\n             , \"este\"\n             , \"esti\"\n             , \"estit\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 20, 0, 0), (2013, 2, 12, 23, 0, 0)) Hour)\n             [ \"ma \u00c3\u00a9jszaka\"\n             , \"\u00c3\u00a9jszaka\"\n             , \"\u00c3\u00a9jszakai\"\n             , \"\u00c3\u00a9jszakait\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"ny\u00c3\u00a1r\"\n             , \"ny\u00c3\u00a1ri\"\n             , \"ny\u00c3\u00a1rit\"\n             , \"ny\u00c3\u00a1ron\"\n             ]\n   , examples (datetimeInterval ((2013, 9, 23, 0, 0, 0), (2013, 12, 22, 0, 0, 0)) Day)\n             [ \"\u00c5\u2018sz\"\n             , \"\u00c5\u2018szi\"\n             , \"\u00c5\u2018szit\"\n             , \"\u00c5\u2018sszel\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"t\u00c3\u00a9l\"\n             , \"t\u00c3\u00a9li\"\n             , \"t\u00c3\u00a9lit\"\n             , \"t\u00c3\u00a9len\"\n             ]\n    , examples (datetimeInterval ((2013, 3, 20, 0, 0, 0), (2013, 6, 22, 0, 0, 0)) Day)\n             [ \"tavasz\"\n             , \"tavaszi\"\n             , \"tavaszit\"\n             , \"tavasszal\"\n             ]\n  ]\n", "num_lines": 412}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.HU.Rules\n  ( rules ) where\n\nimport Data.Maybe\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport Duckling.Time.Helpers\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) -> Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleInstants :: [Rule]\nruleInstants = mkRuleInstants\n  [ (\"right now\",            TG.Second, 0 , \"mostani(t)?|((\\x00E9pp )?most)|azonnal\"                      )\n  , (\"today\",                TG.Day,    0 , \"m(\u00c3\u00a1|a)(i( nap(o(t|n)|it?)?|t)?|ma)?\"                         )\n  , (\"tomorrow\",             TG.Day,    1 , \"holnap(i(t)?)?\"                                              )\n  , (\"day after tomorrow\",   TG.Day,    2 , \"holnaput\\x00E1n(i(t)?)?\"                                     )\n  , (\"yesterday\",            TG.Day,    -1, \"tegnap(i(t)?)?\"                                              )\n  , (\"day before yesterday\", TG.Day,    -2, \"tegnapel\\x0151tt(i(t)?)?\"                                    )\n  , (\"end of month\",         TG.Month,  1 , \"(a )?h\\x00F3nap v\\x00E9ge|h\\x00F3 v\\x00E9g(e|i(t)?|\\x00E9n)\" )\n  , (\"end of year\",          TG.Year,   1 , \"(az )?\\x00E9v v\\x00E9g(e|i(t)?|\\x00E9n)\"                     )\n  ]\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Monday\"   , \"h\\x00E9tf\\x0151(n|t|i(t)?)?|h\\x00E9t\\\\.?\"                   )\n  , ( \"Tuesday\"  , \"kedd(en|et|i(t)?)?\"                                         )\n  , ( \"Wednesday\", \"szerda(i(t)?)?|szerd\u00c3\u00a1(n|t)|szer\\\\.?\"                        )\n  , ( \"Thursday\" , \"cs\\x00FCt\\x00F6rt\\x00F6k(\\x00F6(n|t)|i(t)?)?|cs\\x00FCt\\\\.?\" )\n  , ( \"Friday\"   , \"p\\x00E9ntek(e(n|t)|i(t)?)?|p\\x00E9n\\\\.?\"                    )\n  , ( \"Saturday\" , \"szombat(o(n|t)|i(t)?)?|szom\\\\.?\"                            )\n  , ( \"Sunday\"   , \"vas\\x00E1rnap(ot|i(t)?)?|vas\\\\.?\"                           )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"January\"  , \"janu\\x00E1r(ban|i(t)?)?|jan\\\\.?\"         )\n  , ( \"February\" , \"febru\\x00E1r(ban|i(t)?)?|febr?\\\\.?\"      )\n  , ( \"March\"    , \"m\\x00E1rcius(ban|i(t)?)?|m\\x00E1rc?\\\\.?\" )\n  , ( \"April\"    , \"\\x00E1prilis(ban|i(t)?)?|\\x00E1pr\\\\.?\"   )\n  , ( \"May\"      , \"m\\x00E1jus(ban|i(t)?)?|m\\x00E1j\\\\.?\"     )\n  , ( \"June\"     , \"j\\x00FAnius(ban|i(t)?)?|j\\x00FAn\\\\.?\"    )\n  , ( \"July\"     , \"j\\x00FAlius(ban|i(t)?)?|j\\x00FAl\\\\.?\"    )\n  , ( \"August\"   , \"augusztus(ban|i(t)?)?|aug\\\\.?\"           )\n  , ( \"September\", \"szeptember(ben|i(t)?)?|szept?\\\\.?\"       )\n  , ( \"October\"  , \"okt\u00c3\u00b3ber(ben|i(t)?)?|okt\\\\.?\"             )\n  , ( \"November\" , \"november(ben|i(t)?)?|nov\\\\.?\"            )\n  , ( \"December\" , \"december(ben|i(t)?)?|dec\\\\.?\"            )\n  ]\n\nruleMonthDOMNumeral :: Rule\nruleMonthDOMNumeral = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleMonthDOMNumeralSuffix :: Rule\nruleMonthDOMNumeralSuffix = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    , regex \"(-?(jei|j\u00c3\u00a9n|\u00c3\u00a1n|\u00c3\u00a9n|ai|ei|je|ji|a|e|i))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleMonthDOMOrdinal :: Rule\nruleMonthDOMOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleCycleThisLastNext :: Rule\nruleCycleThisLastNext = Rule\n  { name = \"this|last|next <cycle>\"\n  , pattern =\n    [ regex \"(most|el\\x0151z\\x0151|m\\x00FAlt|k\\x00F6vetkez\\x0151|j\\x00F6v\\x0151)\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):Token TimeGrain grain:_) ->\n        case Text.toLower match of\n          \"most\"                -> tt $ cycleNth grain 0\n          \"el\\x0151z\\x0151\"     -> tt . cycleNth grain $ - 1\n          \"m\\x00FAlt\"           -> tt . cycleNth grain $ - 1\n          \"k\\x00F6vetkez\\x0151\" -> tt $ cycleNth grain 1\n          \"j\\x00F6v\\x0151\"      -> tt $ cycleNth grain 1\n          _ -> Nothing\n      _ -> Nothing\n  }\n\nruleNextDOW :: Rule\nruleNextDOW = Rule\n  { name = \"next <day-of-week>\"\n  , pattern =\n    [ regex \"j\\x00F6v\\x0151\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleHHMM :: Rule\nruleHHMM = Rule\n  { name = \"hh:mm\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleHHMMSS :: Rule\nruleHHMMSS = Rule\n  { name = \"hh:mm:ss\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:ss:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        s <- parseInt ss\n        tt $ hourMinuteSecond True h m s\n      _ -> Nothing\n  }\n\nruleTODLatent :: Rule\nruleTODLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ hour True n\n      _ -> Nothing\n  }\n\nruleTODAM :: Rule\nruleTODAM = Rule\n  { name = \"am <time-of-day>\"\n  , pattern =\n    [ regex \"(de\\\\.?|d\\x00E9lel\\x0151tt)\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ timeOfDayAMPM True td\n      _ -> Nothing\n  }\n\nruleTODPM :: Rule\nruleTODPM = Rule\n  { name = \"pm <time-of-day>\"\n  , pattern =\n    [ regex \"(du\\\\.?|d\\x00E9lut\\x00E1n)\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ timeOfDayAMPM False td\n      _ -> Nothing\n  }\n\nruleYYYYMMDD :: Rule\nruleYYYYMMDD = Rule\n  { name = \"yyyy.mm.dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})\\\\s?[-\\\\.]\\\\s?(0?[1-9]|1[0-2])\\\\s?[-\\\\.]\\\\s?(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (yy:mm:dd:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleMMDD :: Rule\nruleMMDD = Rule\n  { name = \"mm.dd\"\n  , pattern =\n    [ regex \"(0?[1-9]|1[0-2])\\\\s?[-\\\\.]\\\\s?(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nrulePartOfDays :: Rule\nrulePartOfDays = Rule\n  { name = \"part of days\"\n  , pattern =\n    [ regex \"(reggel(i(t)?)?|d\\x00E9lel\\x0151tt(i(t)?)?|d\\x00E9lben|d\\x00E9li(t)?|d\\x00E9lut\\x00E1n(i(t)?)?|est(e|i(t)?)|\\x00E9jszaka(i(t)?)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        let (start, end) = case Text.toLower match of\n              \"reggel\"               -> (hour False 6, hour False 10)\n              \"reggeli\"              -> (hour False 6, hour False 10)\n              \"reggelit\"             -> (hour False 6, hour False 10)\n              \"d\\x00E9lel\\x0151tt\"   -> (hour False 08, hour False 12)\n              \"d\\x00E9lel\\x0151tti\"  -> (hour False 08, hour False 12)\n              \"d\\x00E9lel\\x0151ttit\" -> (hour False 08, hour False 12)\n              \"d\\x00E9lben\"          -> (hour False 12, hour False 13)\n              \"d\\x00E9li\"            -> (hour False 12, hour False 13)\n              \"d\\x00E9lit\"           -> (hour False 12, hour False 13)\n              \"d\\x00E9lut\\x00E1n\"    -> (hour False 12, hour False 18)\n              \"d\\x00E9lut\\x00E1ni\"   -> (hour False 12, hour False 18)\n              \"d\\x00E9lut\\x00E1nit\"  -> (hour False 12, hour False 18)\n              \"este\"                 -> (hour False 16, hour False 20)\n              \"esti\"                 -> (hour False 16, hour False 20)\n              \"estit\"                -> (hour False 16, hour False 20)\n              _                      -> (hour False 20, hour False 23)\n        td <- interval TTime.Open start end\n        tt . partOfDay $ td\n      _ -> Nothing\n  }\n\n-- Since part of days are latent, general time intersection is blocked\nruleTimePOD :: Rule\nruleTimePOD = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:Token Time pod:_) -> Token Time <$> intersect pod td\n      _ -> Nothing\n  }\n\nruleSeasons :: Rule\nruleSeasons = Rule\n  { name = \"seasons\"\n  , pattern =\n    [ regex \"(ny\\x00E1r(i(t)?|on)?|\\x0151sz(i(t)?)?|\\x0151sszel|t\\x00E9l(i(t)?|en)?|tavasz(i(t)?)?|tavasszal)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        start <- case Text.toLower match of\n          \"ny\\x00E1r\"      -> Just $ monthDay 6 21\n          \"ny\\x00E1ri\"     -> Just $ monthDay 6 21\n          \"ny\\x00E1rit\"    -> Just $ monthDay 6 21\n          \"ny\\x00E1ron\"    -> Just $ monthDay 6 21\n          \"\\x0151sz\"       -> Just $ monthDay 9 23\n          \"\\x0151szi\"      -> Just $ monthDay 9 23\n          \"\\x0151szit\"     -> Just $ monthDay 9 23\n          \"\\x0151sszel\"    -> Just $ monthDay 9 23\n          \"t\\x00E9l\"       -> Just $ monthDay 12 21\n          \"t\\x00E9li\"      -> Just $ monthDay 12 21\n          \"t\\x00E9lit\"     -> Just $ monthDay 12 21\n          \"t\\x00E9len\"     -> Just $ monthDay 12 21\n          \"tavasz\"         -> Just $ monthDay 3 20\n          \"tavaszi\"        -> Just $ monthDay 3 20\n          \"tavaszit\"       -> Just $ monthDay 3 20\n          \"tavasszal\"      -> Just $ monthDay 3 20\n          _ -> Nothing\n        end <- case Text.toLower match of\n          \"ny\\x00E1r\"      -> Just $ monthDay 9 23\n          \"ny\\x00E1ri\"     -> Just $ monthDay 9 23\n          \"ny\\x00E1rit\"    -> Just $ monthDay 9 23\n          \"ny\\x00E1ron\"    -> Just $ monthDay 9 23\n          \"\\x0151sz\"       -> Just $ monthDay 12 21\n          \"\\x0151szi\"      -> Just $ monthDay 12 21\n          \"\\x0151szit\"     -> Just $ monthDay 12 21\n          \"\\x0151sszel\"    -> Just $ monthDay 12 21\n          \"t\\x00E9l\"       -> Just $ monthDay 3 20\n          \"t\\x00E9li\"      -> Just $ monthDay 3 20\n          \"t\\x00E9lit\"     -> Just $ monthDay 3 20\n          \"t\\x00E9len\"     -> Just $ monthDay 3 20\n          \"tavasz\"         -> Just $ monthDay 6 21\n          \"tavaszi\"        -> Just $ monthDay 6 21\n          \"tavaszit\"       -> Just $ monthDay 6 21\n          \"tavasszal\"      -> Just $ monthDay 6 21\n          _ -> Nothing\n        Token Time <$> interval TTime.Open start end\n      _ -> Nothing\n\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleIntersect\n  , ruleMonthDOMNumeral\n  , ruleMonthDOMNumeralSuffix\n  , ruleMonthDOMOrdinal\n  , ruleCycleThisLastNext\n  , ruleNextDOW\n  , ruleHHMM\n  , ruleHHMMSS\n  , ruleTODLatent\n  , ruleTODAM\n  , ruleTODPM\n  , ruleYYYYMMDD\n  , ruleMMDD\n  , rulePartOfDays\n  , ruleTimePOD\n  , ruleSeasons\n  ]\n  ++ ruleInstants\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n", "num_lines": 356}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.IT.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Testing.Types hiding (examples)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, examples)\n  where\n    examples =\n      [ \"ma\"\n      , \"3 20\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"subito\"\n             , \"immediatamente\"\n             , \"in questo momento\"\n             , \"ora\"\n             , \"adesso\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"di oggi\"\n             , \"oggi\"\n             , \"in giornata\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"ieri\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"domani\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"Il giorno dopo domani\"\n             , \"dopodomani\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Luned\u00c3\u00ac 18 febbraio\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"marted\u00c3\u00ac\"\n             , \"Marted\u00c3\u00ac 19\"\n             , \"mar 19\"\n             , \"il 19\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"l'altro ieri\"\n             , \"altroieri\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"lunedi\"\n             , \"lun\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"lunedi 18 febbraio\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"Marted\u00c3\u00ac\"\n             , \"Martedi\"\n             , \"mar\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"Mercoled\u00c3\u00ac\"\n             , \"mer\"\n             , \"mer.\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"mercoledi 13 feb\"\n             , \"il 13 febbraio\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"il 13 febbraio 2013\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"giovedi\"\n             , \"gioved\u00c3\u00ac\"\n             , \"gio\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"venerdi\"\n             , \"venerd\u00c3\u00ac\"\n             , \"ven\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"sabato\"\n             , \"sab\"\n             , \"sab.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"domenica\"\n             , \"dom\"\n             , \"dom.\"\n             ]\n   , examples (datetime (2013, 1, 1, 0, 0, 0) Month)\n              [ \"gennaio 2013\"\n              , \"genn 2013\"\n              , \"genn. 2013\"\n              ]\n  , examples (datetime (2013, 12, 1, 0, 0, 0) Month)\n              [ \"dicembre 2013\"\n              , \"dic 2013\"\n              , \"dic. 2013\"\n              ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"domenica 10 febbraio\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"il 1 marzo\"\n             , \"primo marzo\"\n             , \"primo di marzo\"\n             , \"il 1\u00c2\u00ba marzo\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 3, 1, 0, 0, 0) Month)\n             [ \"prima di marzo\"\n             ]\n  , examples (datetime (2013, 3, 15, 0, 0, 0) Day)\n             [ \"le idi di marzo\"\n             , \"idi di marzo\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"3 marzo 2015\"\n             , \"3/3/2015\"\n             , \"3/3/15\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"il 15 febbraio\"\n             , \"15/2\"\n             , \"il 15/02\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"marted\u00c3\u00ac scorso\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"marted\u00c3\u00ac prossimo\"\n             , \"il marted\u00c3\u00ac dopo\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"mercoled\u00c3\u00ac prossimo\"\n             ]\n  , examples (datetime (2014, 10, 0, 0, 0, 0) Month)\n             [ \"ottobre 2014\"\n             ]\n  , examples (datetime (2013, 2, 12, 3, 0, 0) Hour)\n             [ \"l'ultima ora\"\n             , \"nell'ultima ora\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"questa settimana\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"la settimana scorsa\"\n             , \"la scorsa settimana\"\n             , \"nella scorsa settimana\"\n             , \"della settimana scorsa\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"la settimana prossima\"\n             , \"la prossima settimana\"\n             , \"nella prossima settimana\"\n             , \"settimana prossima\"\n             , \"prossima settimana\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"il mese scorso\"\n             , \"nel mese scorso\"\n             , \"nel mese passato\"\n             , \"lo scorso mese\"\n             , \"dello scorso mese\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"il mese prossimo\"\n             , \"il prossimo mese\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"questo trimestre\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"il prossimo trimestre\"\n             , \"nel prossimo trimestre\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"terzo trimestre\"\n             , \"il terzo trimestre\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"quarto trimestre 2018\"\n             , \"il quarto trimestre 2018\"\n             , \"del quarto trimestre 2018\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"l'anno scorso\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"quest'anno\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"il prossimo anno\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"ultima domenica\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"luned\u00c3\u00ac di questa settimana\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"marted\u00c3\u00ac di questa settimana\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"mercoled\u00c3\u00ac di questa settimana\"\n             ]\n  , examples (datetime (2013, 2, 14, 17, 0, 0) Hour)\n             [ \"dopo domani alle 17\"\n             , \"dopodomani alle 5 del pomeriggio\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"ultimo luned\u00c3\u00ac di marzo\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"ultima domenica di marzo 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"il terzo giorno di ottobre\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"prima settimana di ottobre 2014\"\n             ]\n  , examples (datetime (2013, 10, 7, 0, 0, 0) Week)\n             [ \"la settimana del 6 ottobre\"\n             , \"la settimana del 7 ott\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"il we del 15 febbraio\"\n             ]\n  , examples (datetimeInterval ((2013, 4, 12, 18, 0, 0), (2013, 4, 15, 0, 0, 0)) Hour)\n             [ \"il week-end del 10 aprile\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"l'ultimo giorno di ottobre 2015\"\n             , \"l'ultimo giorno dell'ottobre 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"l'ultima settimana di settembre 2014\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"tra un'ora\"\n             , \"tra 1 ora\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"tra un quarto d'ora\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"tra mezz'ora\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 15, 0) Second)\n             [ \"tra tre quarti d'ora\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"primo marted\u00c3\u00ac di ottobre\"\n             , \"primo marted\u00c3\u00ac in ottobre\"\n             , \"1\u00c2\u00b0 marted\u00c3\u00ac del mese di ottobre\"\n             , \"1\u00c2\u00ba marted\u00c3\u00ac del mese di ottobre\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"terzo marted\u00c3\u00ac di settembre 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"primo mercoled\u00c3\u00ac di ottobre 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"secondo mercoled\u00c3\u00ac di ottobre 2014\"\n             ]\n  , examples (datetime (2015, 1, 13, 0, 0, 0) Day)\n             [ \"terzo marted\u00c3\u00ac dopo natale 2014\"\n             ]\n  , examples (datetime (2016, 1, 0, 0, 0, 0) Month)\n             [ \"il mese dopo natale 2015\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"alle 3 di pomeriggio\"\n             , \"le tre di pomeriggio\"\n             , \"alle 3 del pomeriggio\"\n             , \"le tre del pomeriggio\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"circa alle 3 del pomeriggio\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"per le 15\"\n             , \"verso le 15\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Minute)\n             [ \"3:00\"\n             , \"03:00\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"15:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"3:15 di pomeriggio\"\n             , \"3:15 del pomeriggio\"\n             , \"3 e un quarto di pomeriggio\"\n             , \"tre e un quarto di pomeriggio\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"alle tre e venti di pomeriggio\"\n             , \"alle tre e venti del pomeriggio\"\n             , \"3:20 di pomeriggio\"\n             , \"3:20 del pomeriggio\"\n             , \"15:20 del pomeriggio\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 20, 0) Minute)\n             [ \"alle tre e venti\"\n             , \"tre e 20\"\n             , \"3 e 20\"\n             , \"3:20\"\n             , \"alle 3 20\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"15:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"a mezzogiorno meno un quarto\"\n             , \"mezzogiorno meno un quarto\"\n             , \"un quarto a mezzogiorno\"\n             , \"11:45 del mattino\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Hour)\n             [ \"alle 3 del mattino\"\n             ]\n  , examples (datetime (2013, 9, 20, 19, 30, 0) Minute)\n             [ \"alle 19:30 di venerd\u00c3\u00ac 20 settembre\"\n             , \"alle 19:30 venerd\u00c3\u00ac 20 settembre\"\n             , \"venerd\u00c3\u00ac 20 settembre alle 19:30\"\n             , \"il 20 settembre alle 19:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"questo week-end\"\n             , \"questo fine settimana\"\n             , \"questo finesettimana\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"lunedi mattina\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 4, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"15 febbraio al mattino\"\n             , \"mattino di 15 febbraio\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"8 di stasera\"\n             , \"8 della sera\"\n             ]\n  , examples (datetime (2013, 9, 20, 19, 30, 0) Minute)\n             [ \"venerd\u00c3\u00ac 20 settembre alle 7:30 del pomeriggio\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"alle 9 di sabato\"\n             , \"sabato alle 9\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"quest'estate\"\n             , \"questa estate\"\n             , \"in estate\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"quest'inverno\"\n             , \"questo inverno\"\n             , \"in inverno\"\n             ]\n  , examples (datetimeInterval ((2014, 9, 23, 0, 0, 0), (2014, 12, 22, 0, 0, 0)) Day)\n             [ \"il prossimo autunno\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"natale\"\n             , \"il giorno di natale\"\n             ]\n  , examples (datetime (2013, 12, 24, 0, 0, 0) Day)\n             [ \"vigilia di natale\"\n             , \"alla vigilia\"\n             , \"la vigilia\"\n             ]\n  , examples (datetime (2013, 12, 31, 0, 0, 0) Day)\n             [ \"vigilia di capodanno\"\n             , \"san silvestro\"\n             ]\n  , examples (datetimeInterval ((2014, 1, 1, 0, 0, 0), (2014, 1, 1, 4, 0, 0)) Hour)\n             [ \"notte di san silvestro\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"capodanno\"\n             , \"primo dell'anno\"\n             ]\n  , examples (datetime (2014, 1, 6, 0, 0, 0) Day)\n             [ \"epifania\"\n             , \"befana\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"san valentino\"\n             , \"festa degli innamorati\"\n             ]\n  , examples (datetime (2013, 3, 19, 0, 0, 0) Day)\n             [ \"festa del pap\u00c3\u00a0\"\n             , \"festa del papa\"\n             , \"festa di san giuseppe\"\n             , \"san giuseppe\"\n             ]\n  , examples (datetime (2013, 4, 25, 0, 0, 0) Day)\n             [ \"anniversario della liberazione\"\n             , \"la liberazione\"\n             , \"alla liberazione\"\n             ]\n  , examples (datetime (2013, 5, 1, 0, 0, 0) Day)\n             [ \"festa del lavoro\"\n             , \"festa dei lavoratori\"\n             , \"giorno dei lavoratori\"\n             , \"primo maggio\"\n             ]\n  , examples (datetime (2013, 5, 12, 0, 0, 0) Day)\n             [ \"festa della mamma\"\n             ]\n  , examples (datetime (2013, 6, 2, 0, 0, 0) Day)\n             [ \"festa della repubblica\"\n             , \"la repubblica\"\n             , \"repubblica\"\n             ]\n  , examples (datetime (2013, 8, 15, 0, 0, 0) Day)\n             [ \"ferragosto\"\n             , \"assunzione\"\n             ]\n  , examples (datetime (2013, 10, 31, 0, 0, 0) Day)\n             [ \"halloween\"\n             ]\n  , examples (datetime (2013, 11, 1, 0, 0, 0) Day)\n             [ \"tutti i santi\"\n             , \"ognissanti\"\n             , \"festa dei santi\"\n             , \"il giorno dei santi\"\n             ]\n  , examples (datetime (2013, 11, 2, 0, 0, 0) Day)\n             [ \"giorno dei morti\"\n             , \"commemorazione dei defunti\"\n             ]\n  , examples (datetime (2013, 11, 2, 2, 0, 0) Hour)\n             [ \"ai morti alle 2\"\n             ]\n  , examples (datetime (2013, 12, 8, 0, 0, 0) Day)\n             [ \"immacolata\"\n             , \"immacolata concezione\"\n             , \"all'immacolata\"\n             ]\n  , examples (datetime (2013, 12, 8, 18, 0, 0) Hour)\n             [ \"all'immacolata alle 18\"\n             ]\n  , examples (datetime (2013, 12, 26, 0, 0, 0) Day)\n             [ \"santo stefano\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"questa sera\"\n             , \"sta sera\"\n             , \"stasera\"\n             , \"in serata\"\n             , \"nella sera\"\n             , \"verso sera\"\n             , \"la sera\"\n             , \"alla sera\"\n             , \"la serata\"\n             , \"nella serata\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 4, 0, 0), (2013, 2, 13, 12, 0, 0)) Hour)\n             [ \"domani mattina\"\n             , \"domattina\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 18, 0, 0, 0)) Second)\n             [ \"in settimana\"\n             , \"per la settimana\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 13, 4, 0, 0)) Hour)\n             [ \"stanotte\"\n             , \"nella notte\"\n             , \"in nottata\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 8, 18, 0, 0), (2013, 2, 11, 0, 0, 0)) Hour)\n             [ \"ultimo weekend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"domani in serata\"\n             , \"domani sera\"\n             , \"nella serata di domani\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 0, 0, 0), (2013, 2, 14, 4, 0, 0)) Hour)\n             [ \"domani notte\"\n             , \"domani in nottata\"\n             , \"nella nottata di domani\"\n             , \"nella notte di domani\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 14, 0, 0)) Hour)\n             [ \"domani a pranzo\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"ieri sera\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"questo weekend\"\n             , \"questo week-end\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"luned\u00c3\u00ac mattina\"\n             , \"nella mattinata di luned\u00c3\u00ac\"\n             , \"luned\u00c3\u00ac in mattinata\"\n             , \"luned\u00c3\u00ac nella mattina\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 4, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"il 15 febbraio in mattinata\"\n             , \"mattina del 15 febbraio\"\n             , \"15 febbraio mattina\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"gli ultimi 2 secondi\"\n             , \"gli ultimi due secondi\"\n             , \"i 2 secondi passati\"\n             , \"i due secondi passati\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"i prossimi 3 secondi\"\n             , \"i prossimi tre secondi\"\n             , \"nei prossimi tre secondi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"gli ultimi 2 minuti\"\n             , \"gli ultimi due minuti\"\n             , \"i 2 minuti passati\"\n             , \"i due minuti passati\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"i prossimi 3 minuti\"\n             , \"nei prossimi 3 minuti\"\n             , \"i prossimi tre minuti\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 2, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"le ultime 2 ore\"\n             , \"le ultime due ore\"\n             , \"nelle ultime due ore\"\n             , \"le scorse due ore\"\n             , \"le due ore scorse\"\n             , \"le scorse 2 ore\"\n             , \"le 2 ore scorse\"\n             , \"nelle 2 ore scorse\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 4, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"le ultime 24 ore\"\n             , \"le ultime ventiquattro ore\"\n             , \"le 24 ore passate\"\n             , \"nelle 24 ore scorse\"\n             , \"le ventiquattro ore passate\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"le prossime 3 ore\"\n             , \"prossime tre ore\"\n             , \"nelle prossime 3 ore\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"gli ultimi 2 giorni\"\n             , \"gli ultimi due giorni\"\n             , \"negli ultimi 2 giorni\"\n             , \"i 2 giorni passati\"\n             , \"i due giorni passati\"\n             , \"nei due giorni passati\"\n             , \"gli scorsi due giorni\"\n             , \"i 2 giorni scorsi\"\n             , \"i due giorni scorsi\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"prossimi 3 giorni\"\n             , \"i prossimi tre giorni\"\n             , \"nei prossimi 3 giorni\"\n             , \"prossimi giorni\"\n             , \"nei prossimi giorni\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"le ultime 2 settimane\"\n             , \"le ultime due settimane\"\n             , \"le 2 ultime settimane\"\n             , \"le due ultime settimane\"\n             , \"nelle 2 ultime settimane\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"prossime 3 settimane\"\n             , \"le prossime tre settimane\"\n             , \"le 3 prossime settimane\"\n             , \"nelle prossime 3 settimane\"\n             , \"le tre prossime settimane\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"gli ultimi 2 mesi\"\n             , \"gli ultimi due mesi\"\n             , \"i 2 mesi passati\"\n             , \"nei 2 mesi passati\"\n             , \"i due mesi passati\"\n             , \"i due mesi scorsi\"\n             , \"i 2 mesi scorsi\"\n             , \"negli scorsi due mesi\"\n             , \"gli scorsi due mesi\"\n             , \"gli scorsi 2 mesi\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"i prossimi 3 mesi\"\n             , \"i prossimi tre mesi\"\n             , \"prossimi 3 mesi\"\n             , \"i 3 prossimi mesi\"\n             , \"i tre prossimi mesi\"\n             , \"nei prossimi tre mesi\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"gli ultimi 2 anni\"\n             , \"gli ultimi due anni\"\n             , \"negli ultimi 2 anni\"\n             , \"i 2 anni passati\"\n             , \"i due anni passati\"\n             , \"i 2 anni scorsi\"\n             , \"i due anni scorsi\"\n             , \"gli scorsi due anni\"\n             , \"gli scorsi 2 anni\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"i prossimi 3 anni\"\n             , \"i prossimi tre anni\"\n             , \"nei tre prossimi anni\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13-15 luglio\"\n             , \"dal 13 al 15 luglio\"\n             , \"tra il 13 e il 15 luglio\"\n             , \"tra 13 e 15 luglio\"\n             , \"dal tredici al quindici luglio\"\n             , \"13 luglio - 15 luglio\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 3, 0, 0, 0), (2013, 3, 6, 0, 0, 0)) Day)\n             [ \"dal 3 al 5\"\n             , \"tra il 3 e il 5\"\n             , \"dal tre al cinque\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"8 ago - 12 ago\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 15, 0, 0, 0)) Day)\n             [ \"da domani a gioved\u00c3\u00ac\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"dalle 9:30 alle 11:00 di gioved\u00c3\u00ac\"\n             , \"tra le 9:30 e le 11:00 di gioved\u00c3\u00ac\"\n             , \"9:30 - 11:00 gioved\u00c3\u00ac\"\n             , \"gioved\u00c3\u00ac dalle 9:30 alle 11:00\"\n             , \"gioved\u00c3\u00ac tra le 9:30 e le 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"dalle 9 alle 11 di gioved\u00c3\u00ac\"\n             , \"tra le 9 e le 11 di gioved\u00c3\u00ac\"\n             , \"9 - 11 gioved\u00c3\u00ac\"\n             , \"gioved\u00c3\u00ac dalle nove alle undici\"\n             , \"gioved\u00c3\u00ac tra le nove e le undici\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 3, 0, 0), (2013, 2, 14, 14, 0, 0)) Hour)\n             [ \"dalle tre all'una di gioved\u00c3\u00ac\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 13, 3, 0, 0)) Hour)\n             [ \"dalla mezzanotte alle 2\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 15, 0, 0), (2013, 2, 13, 17, 1, 0)) Minute)\n             [ \"domani dalle 15:00 alle 17:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-13:30\"\n             ]\n  , examples (datetime (2013, 9, 21, 13, 30, 0) Minute)\n             [ \"13:30 di sabato 21 settembre\"\n             , \"13:30 del 21 settembre\"\n             ]\n  , examples (datetime (2013, 2, 26, 0, 0, 0) Day)\n             [ \"in due settimane\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 12, 14, 0, 0)) Second)\n             [ \"fino alle 14:00\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Minute)\n             [ \"entro le 14:00\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 3, 1, 0, 0, 0) Month)\n             [ \"entro la fine del mese\"\n             ]\n  , examples (datetimeOpenInterval Before (2014, 1, 1, 0, 0, 0) Year)\n             [ \"entro la fine dell'anno\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 3, 1, 0, 0, 0)) Second)\n             [ \"fino alla fine del mese\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2014, 1, 1, 0, 0, 0)) Second)\n             [ \"fino alla fine dell'anno\"\n             ]\n  , examples (datetime (2013, 2, 13, 1, 0, 0) Minute)\n             [ \"alle 4 CET\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"alle 16 CET\"\n             ]\n  , examples (datetime (2013, 2, 14, 6, 0, 0) Minute)\n             [ \"gioved\u00c3\u00ac alle 8:00 GMT\"\n             , \"gioved\u00c3\u00ac alle 8:00 gmt\"\n             ]\n  , examples (datetime (2013, 2, 13, 14, 0, 0) Hour)\n             [ \"domani alle 14\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"alle 14\"\n             , \"alle 2 del pomeriggio\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 alle 16:00\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Hour)\n             [ \"3 del pomeriggio di domani\"\n             , \"15 del pomeriggio di domani\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"dopo le 14\"\n             , \"dalle 14\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"dalla mezzanotte\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 13, 14, 0, 0) Hour)\n             [ \"domani dopo le 14\"\n             , \"domani dalle 14\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"prima delle 11\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 14, 11, 0, 0) Hour)\n             [ \"dopodomani prima delle 11\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 14, 12, 0, 0) Hour)\n             [ \"gioved\u00c3\u00ac entro mezzogiorno\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 14, 0, 0, 0) Day)\n             [ \"da dopodomani\"\n             , \"da gioved\u00c3\u00ac\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 3, 1, 0, 0, 0) Day)\n             [ \"dal primo\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 20, 0, 0, 0) Day)\n             [ \"dal 20\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 15, 0, 0, 0) Day)\n             [ \"entro il 15\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 4, 20, 0, 0, 0) Day)\n             [ \"prima del 20 aprile\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"nel pomeriggio\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 30, 0) Minute)\n             [ \"alle 13:30\"\n             , \"13:30\"\n             , \"1:30 del pomeriggio\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"in 15 minuti\"\n             , \"tra 15 minuti\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"questa mattina\"\n             , \"questa mattinata\"\n             , \"questo mattino\"\n             ]\n  , examples (datetime (2013, 2, 25, 0, 0, 0) Day)\n             [ \"prossimo luned\u00c3\u00ac\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 0, 0) Hour)\n             [ \"alle 12\"\n             , \"a mezzogiorno\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"alle 24\"\n             , \"a mezzanotte\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"marzo\"\n             , \"in marzo\"\n             ]\n  , examples (datetime (2013, 8, 15, 0, 0, 0) Day)\n             [ \"gio 15\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 giorni fa\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"una settimana fa\"\n             , \"1 settimana fa\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"tre settimane fa\"\n             , \"3 settimane fa\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"tre mesi fa\"\n             , \"3 mesi fa\"\n             ]\n  , examples (datetime (2011, 2, 1, 0, 0, 0) Month)\n             [ \"due anni fa\"\n             , \"2 anni fa\"\n             ]\n   , examples (datetimeHoliday (2013, 12, 18, 0, 0, 0) Day \"Giornata della lingua araba\")\n             [ \"giornata della lingua araba\"\n             ]\n   , examples (datetimeHoliday (2013, 3, 1, 0, 0, 0) Day \"Giornata Mondiale contro la discriminazione\")\n             [ \"giornata mondiale contro la discriminazione\"\n             ]\n   , examples (datetimeHoliday (2019, 7, 6, 0, 0, 0) Day \"Giornata Internazionale delle cooperative\")\n             [ \"giornata internazionale delle cooperative del 2019\"\n             ]\n   , examples (datetimeHoliday (2013, 11, 17, 0, 0, 0) Day \"Giornata Mondiale della Prematurit\u00c3\u00a0\")\n             [ \"giornata mondiale dei prematuri\"\n             , \"giornata mondiale della prematurita\"\n             , \"giornata mondiale della prematurit\u00c3\u00a0\"\n             ]\n   , examples (datetimeHoliday (2013, 5, 25, 0, 0, 0) Day \"Giornata dell'Africa\")\n             [ \"giornata della liberazione africana\"\n             , \"giornata dell'unit\u00c3\u00a0 africana\"\n             , \"giornata dell'africa\"\n             ]\n  ]\n", "num_lines": 867}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.IT.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Ordinal.Types (OrdinalData(..))\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleFestaDellaRepubblica :: Rule\nruleFestaDellaRepubblica = Rule\n  { name = \"festa della repubblica\"\n  , pattern =\n    [ regex \"((festa del)?la )?repubblica\"\n    ]\n  , prod = \\_ -> tt $ monthDay 6 2\n  }\n\nruleEpifania :: Rule\nruleEpifania = Rule\n  { name = \"epifania\"\n  , pattern =\n    [ regex \"(epifania|befana)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 6\n  }\n\nruleDayofmonthNamedmonth :: Rule\nruleDayofmonthNamedmonth = Rule\n  { name = \"<day-of-month> <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleTheDayAfterTomorrow :: Rule\nruleTheDayAfterTomorrow = Rule\n  { name = \"the day after tomorrow\"\n  , pattern =\n    [ regex \"(il giorno )?dopo\\\\s?domani\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleInafterDuration :: Rule\nruleInafterDuration = Rule\n  { name = \"in/after <duration>\"\n  , pattern =\n    [ regex \"[tf]ra|in|dopo\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleTheLastCycle :: Rule\nruleTheLastCycle = Rule\n  { name = \"the last <cycle>\"\n  , pattern =\n    [ regex \"(([nd]el)?l' ?ultim|(il|la) passat|([nd]el)?l[ao] scors)[oa]\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleStanotte :: Rule\nruleStanotte = Rule\n  { name = \"stanotte\"\n  , pattern =\n    [ regex \"(sta|nella )notte|(in|nella) nottata\"\n    ]\n  , prod = \\_ -> do\n      let td1 = cycleNth TG.Day 1\n      td2 <- interval TTime.Open (hour False 0) (hour False 4)\n      Token Time . partOfDay <$> intersect td1 td2\n  }\n\nruleDomattina :: Rule\nruleDomattina = Rule\n  { name = \"domattina\"\n  , pattern =\n    [ regex \"domattina\"\n    ]\n  , prod = \\_ -> do\n      let td1 = cycleNth TG.Day 1\n      td2 <- interval TTime.Open (hour False 4) (hour False 12)\n      Token Time . partOfDay <$> intersect td1 td2\n  }\n\nruleTheCycleNext :: Rule\nruleTheCycleNext = Rule\n  { name = \"the <cycle> next\"\n  , pattern =\n    [ regex \"l'|il|la|[nd]el(la)?\"\n    , dimension TimeGrain\n    , regex \"prossim[oa]\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleCycleNext :: Rule\nruleCycleNext = Rule\n  { name = \"<cycle> next\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"prossim[oa]\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) -> tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleFestaDellaLiberazione :: Rule\nruleFestaDellaLiberazione = Rule\n  { name = \"festa della liberazione\"\n  , pattern =\n    [ regex \"((festa|anniversario) della|(al)?la) liberazione\"\n    ]\n  , prod = \\_ -> tt $ monthDay 4 25\n  }\n\nruleStamattina :: Rule\nruleStamattina = Rule\n  { name = \"stamattina\"\n  , pattern =\n    [ regex \"stamattina\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 4) (hour False 12)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleYearNotLatent :: Rule\nruleYearNotLatent = Rule\n  { name = \"year (1000-2100 not latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt $ year v\n      _ -> Nothing\n  }\n\nruleValentinesDay :: Rule\nruleValentinesDay = Rule\n  { name = \"valentine's day\"\n  , pattern =\n    [ regex \"san valentino|festa degli innamorati\"\n    ]\n  , prod = \\_ -> tt $ monthDay 2 14\n  }\n\nruleTheOrdinalCycleOfTime :: Rule\nruleTheOrdinalCycleOfTime = Rule\n  { name = \"the <ordinal> <cycle> of <time>\"\n  , pattern =\n    [ regex \"il|l[a']|[nd]el(l[a'])?\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"di|del(l[a'])?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarter :: Rule\nruleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleTheOrdinalQuarter :: Rule\nruleTheOrdinalQuarter = Rule\n  { name = \"the <ordinal> quarter\"\n  , pattern =\n    [ regex \"il|[nd]el(l')?|l'\"\n    , dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleCycleOrdinalQuarterYear :: Rule\nruleCycleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter False TG.Quarter (n - 1) td\n      _ -> Nothing\n  }\n\nruleCycleTheOrdinalTime :: Rule\nruleCycleTheOrdinalTime = Rule\n  { name = \"the <ordinal> <cycle> <time>\"\n  , pattern =\n    [ regex \"il|[nd]el(l')?|l'\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter True grain (n - 1) td\n      _ -> Nothing\n  }\n\nruleDdddMonthInterval :: Rule\nruleDdddMonthInterval = Rule\n  { name = \"dd-dd <month> (interval)\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , regex \"\\\\-\"\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (m2:_)):\n       Token Time td:\n       _) -> do\n         v1 <- parseInt m1\n         v2 <- parseInt m2\n         from <- intersect (dayOfMonth v1) td\n         to <- intersect (dayOfMonth v2) td\n         Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleTimeLast :: Rule\nruleTimeLast = Rule\n  { name = \"<time> last\"\n  , pattern =\n    [ dimension Time\n    , regex \"(ultim|scors|passat)[oaie]\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleThisDayofweek :: Rule\nruleThisDayofweek = Rule\n  { name = \"this <day-of-week>\"\n  , pattern =\n    [ regex \"quest[oaie]\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleUna :: Rule\nruleUna = Rule\n  { name = \"una\"\n  , pattern =\n    [ regex \"una\"\n    ]\n  , prod = \\_ -> tt . mkLatent $ hour True 1\n  }\n\nruleNthTimeOfTime2 :: Rule\nruleNthTimeOfTime2 = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"di|del(l[oa'])|in\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData {TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleNewYearsDay :: Rule\nruleNewYearsDay = Rule\n  { name = \"new year's day\"\n  , pattern =\n    [ regex \"(capodanno|primo dell' ?anno)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 1\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time> \"\n  , pattern =\n    [ regex \"(ultim|scors|passat)[oaie]\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleIlDayofmonthDeNamedmonth :: Rule\nruleIlDayofmonthDeNamedmonth = Rule\n  { name = \"il <day-of-month> <named-month>\"\n  , pattern =\n    [ regex \"il|l'\"\n    , Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|[fs]ino a(l(l[e'])?)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEvening :: Rule\nruleEvening = Rule\n  { name = \"evening\"\n  , pattern =\n    [ regex \"ser(ata|[ae])\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDayOfMonthSt :: Rule\nruleDayOfMonthSt = Rule\n  { name = \"day of month (1st)\"\n  , pattern =\n    [ regex \"(primo|1o|1\u00c2\u00ba|1\u00c2\u00b0)\"\n    ]\n  , prod = \\_ -> tt $ dayOfMonth 1\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in|entro <duration>\"\n  , pattern =\n    [ regex \"(in|entro)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):\n       Token Duration dd:\n       _) -> case Text.toLower match of\n        \"entro\" -> Token Time <$> interval TTime.Open now (inDuration dd)\n        \"in\"    -> tt $ inDuration dd\n        _       -> Nothing\n      _ -> Nothing\n  }\n\nruleInNamedmonth :: Rule\nruleInNamedmonth = Rule\n  { name = \"in <named-month>\"\n  , pattern =\n    [ regex \"in|del mese( di)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLeIdiDiNamedmonth :: Rule\nruleLeIdiDiNamedmonth = Rule\n  { name = \"le idi di <named-month>\"\n  , pattern =\n    [ regex \"(le )?idi di\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td@TimeData {TTime.form = Just (TTime.Month m)}:_) ->\n        Token Time <$>\n          intersect (dayOfMonth $ if elem m [3, 5, 7, 10] then 15 else 13) td\n      _ -> Nothing\n  }\n\nruleRightNow :: Rule\nruleRightNow = Rule\n  { name = \"right now\"\n  , pattern =\n    [ regex \"(subito|(immediata|attual)mente|(proprio )?adesso|(in questo|al) momento|ora)\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleToday :: Rule\nruleToday = Rule\n  { name = \"today\"\n  , pattern =\n    [ regex \"(di )?oggi|in giornata\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"(l')ultim[oa]\"\n    , dimension TimeGrain\n    , regex \"di|del(l[oa'])\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleHhRelativeminutesDelPomeriggiotimeofday2 :: Rule\nruleHhRelativeminutesDelPomeriggiotimeofday2 = Rule\n  { name = \"hh <relative-minutes> del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e\"\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        let h = if hours > 12 then hours else hours + 12\n        tt $ hourMinute False h n\n      _ -> Nothing\n  }\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\nruleHourofdayAndRelativeMinutes :: Rule\nruleHourofdayAndRelativeMinutes = Rule\n  { name = \"<hour-of-day> and <relative minutes>\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e\"\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\nruleRelativeMinutesToIntegerAsHourofday :: Rule\nruleRelativeMinutesToIntegerAsHourofday = Rule\n  { name = \"relative minutes to <integer> (as hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"a\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\nruleHourofdayMinusIntegerAsRelativeMinutes :: Rule\nruleHourofdayMinusIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> minus <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"meno\"\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:token:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\nruleHhRelativeminutesDelPomeriggiotimeofday :: Rule\nruleHhRelativeminutesDelPomeriggiotimeofday = Rule\n  { name = \"hh <relative-minutes> del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        let h = if hours > 12 then hours else hours + 12\n        tt $ hourMinute False h n\n      _ -> Nothing\n  }\n\nruleHhIntegerminutesDelPomeriggiotimeofday2 :: Rule\nruleHhIntegerminutesDelPomeriggiotimeofday2 = Rule\n  { name = \"hh <relative-minutes> minutes del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e\"\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min(ut[oi]|\\\\.)? d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        let h = if hours > 12 then hours else hours + 12\n        tt $ hourMinute False h n\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerMinutes :: Rule\nruleHourofdayIntegerMinutes = Rule\n  { name = \"<hour-of-day> <integer> minutes\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min(ut[oi]|\\\\.)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\nruleHourofdayAndIntegerMinutes :: Rule\nruleHourofdayAndIntegerMinutes = Rule\n  { name = \"<hour-of-day> and <integer> minutes\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e\"\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min(ut[oi]|\\\\.)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\nruleMinutesToIntegerAsHourofday :: Rule\nruleMinutesToIntegerAsHourofday = Rule\n  { name = \"minutes to <integer> (as hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"min(ut[oi]|\\\\.)? a\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\nruleHourofdayMinusIntegerMinutes :: Rule\nruleHourofdayMinusIntegerMinutes = Rule\n  { name = \"<hour-of-day> minus <integer> minutes\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"meno\"\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min(ut[oi]|\\\\.)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       _:\n       token:\n       _) -> do\n         v <- getIntValue token\n         Token Time <$> minutesBefore v td\n      _ -> Nothing\n  }\nruleHhIntegerminutesDelPomeriggiotimeofday :: Rule\nruleHhIntegerminutesDelPomeriggiotimeofday = Rule\n  { name = \"hh <integer> minutes del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min(ut[oi]|\\\\.)? d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       token:\n       _) -> do\n         v <- getIntValue token\n         let h = if hours > 12 then hours else hours + 12\n         tt $ hourMinute False h v\n      _ -> Nothing\n  }\n\nruleHhQuartDelPomeriggiotimeofday2 :: Rule\nruleHhQuartDelPomeriggiotimeofday2 = Rule\n  { name = \"hh quart del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e un quarto d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) ->\n         let h = if hours > 12 then hours else hours + 12\n         in tt $ hourMinute False h 15\n      _ -> Nothing\n  }\nruleHourofdayQuart :: Rule\nruleHourofdayQuart = Rule\n  { name = \"<hour-of-day> quart\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"un quarto\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\nruleHourofdayAndAQuart :: Rule\nruleHourofdayAndAQuart = Rule\n  { name = \"<hour-of-day> and a quart\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e un quarto\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\nruleQuartAsHourofday :: Rule\nruleQuartAsHourofday = Rule\n  { name = \"a quart to <integer> (as hour-of-day)\"\n  , pattern =\n    [ regex \"un quarto a\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\nruleHourofdayMinusQuart :: Rule\nruleHourofdayMinusQuart = Rule\n  { name = \"<hour-of-day> minus quart\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"meno un quarto\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\nruleHhQuartDelPomeriggiotimeofday :: Rule\nruleHhQuartDelPomeriggiotimeofday = Rule\n  { name = \"hh quart del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"un quarto d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) ->\n         let h = if hours > 12 then hours else hours + 12\n         in tt $ hourMinute False h 15\n      _ -> Nothing\n  }\n\nruleHhHalfDelPomeriggiotimeofday2 :: Rule\nruleHhHalfDelPomeriggiotimeofday2 = Rule\n  { name = \"hh half del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e mezzo d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) ->\n         let h = if hours > 12 then hours else hours + 12\n         in tt $ hourMinute False h 30\n      _ -> Nothing\n  }\nruleHourofdayHalf :: Rule\nruleHourofdayHalf = Rule\n  { name = \"<hour-of-day> half\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"mezzo\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\nruleHourofdayAndHalf :: Rule\nruleHourofdayAndHalf = Rule\n  { name = \"<hour-of-day> and half\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e mezzo\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\nruleHalfToIntegerAsHourofday :: Rule\nruleHalfToIntegerAsHourofday = Rule\n  { name = \"half to <integer> (as hour-of-day)\"\n  , pattern =\n    [ regex \"mezzo a\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\nruleHourofdayMinusHalf :: Rule\nruleHourofdayMinusHalf = Rule\n  { name = \"<hour-of-day> minus half\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"meno mezzo\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\nruleHhHalfDelPomeriggiotimeofday :: Rule\nruleHhHalfDelPomeriggiotimeofday = Rule\n  { name = \"hh half del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"mezzo d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) ->\n         let h = if hours > 12 then hours else hours + 12\n         in tt $ hourMinute False h 30\n      _ -> Nothing\n  }\n\nruleHhThreeQuarterDelPomeriggiotimeofday2 :: Rule\nruleHhThreeQuarterDelPomeriggiotimeofday2 = Rule\n  { name = \"hh three quarters del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e (3|tre) quarti? d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) ->\n         let h = if hours > 12 then hours else hours + 12\n         in tt $ hourMinute False h 45\n      _ -> Nothing\n  }\nruleHourofdayThreeQuarters :: Rule\nruleHourofdayThreeQuarters = Rule\n  { name = \"<hour-of-day> three quarters\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(3|tre) quarti?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 45\n      _ -> Nothing\n  }\nruleHourofdayAndThreeQuarter :: Rule\nruleHourofdayAndThreeQuarter = Rule\n  { name = \"<hour-of-day> and three quarters\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e (3|tre) quarti?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 45\n      _ -> Nothing\n  }\nruleThreeQuarterToIntegerAsHourofday :: Rule\nruleThreeQuarterToIntegerAsHourofday = Rule\n  { name = \"three quarter to <integer> (as hour-of-day)\"\n  , pattern =\n    [ regex \"(3|tre) quarti? a\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 45 td\n      _ -> Nothing\n  }\nruleHourofdayMinusThreeQuarter :: Rule\nruleHourofdayMinusThreeQuarter = Rule\n  { name = \"<hour-of-day> minus three quarter\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"meno (3|tre) quarti?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> Token Time <$> minutesBefore 45 td\n      _ -> Nothing\n  }\nruleHhThreeQuarterDelPomeriggiotimeofday :: Rule\nruleHhThreeQuarterDelPomeriggiotimeofday = Rule\n  { name = \"hh three quarter del pomeriggio(time-of-day)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(3|tre) quarti? d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) ->\n         let h = if hours > 12 then hours else hours + 12\n         in tt $ hourMinute False h 45\n      _ -> Nothing\n  }\n\nruleHhhmmTimeofday :: Rule\nruleHhhmmTimeofday = Rule\n  { name = \"hh(:|h)mm (time-of-day)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:h]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleDalIntAlInt :: Rule\nruleDalIntAlInt = Rule\n  { name = \"dal <integer> al <integer> (interval)\"\n  , pattern =\n    [ regex \"dal(?:l')?\"\n    , Predicate isDOMInteger\n    , regex \"([fs]ino )?al(l')?\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token1:_:token2:_) -> do\n         v1 <- getIntValue token1\n         v2 <- getIntValue token2\n         Token Time <$>\n           interval TTime.Closed (dayOfMonth v1) (dayOfMonth v2)\n      _ -> Nothing\n  }\n\nruleTraIlIntEIlInt :: Rule\nruleTraIlIntEIlInt = Rule\n  { name = \"tra il <integer> e il <integer> (interval)\"\n  , pattern =\n    [ regex \"tra( (il|l'))?\"\n    , Predicate isDOMInteger\n    , regex \"e( (il|l'))?\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token1:_:token2:_) -> do\n         v1 <- getIntValue token1\n         v2 <- getIntValue token2\n         Token Time <$>\n           interval TTime.Closed (dayOfMonth v1) (dayOfMonth v2)\n      _ -> Nothing\n  }\n\nruleTimeofdayOra :: Rule\nruleTimeofdayOra = Rule\n  { name = \"<time-of-day> ora\"\n  , pattern =\n    [ regex \"or[ea]\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleNextTime2 :: Rule\nruleNextTime2 = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ dimension Time\n    , regex \"dopo|prossim[ao]\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 False td\n      _ -> Nothing\n  }\n\nruleSantoStefano :: Rule\nruleSantoStefano = Rule\n  { name = \"santo stefano\"\n  , pattern =\n    [ regex \"s(anto|\\\\.) stefano\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 26\n  }\n\nruleIlTime :: Rule\nruleIlTime = Rule\n  { name = \"il <time>\"\n  , pattern =\n    [ regex \"il|l'\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleFestaDelPap :: Rule\nruleFestaDelPap = Rule\n  { name = \"festa del pap\u00c3\u00a0\"\n  , pattern =\n    [ regex \"festa del pap(a|\u00c3\u00a0)|(festa di )?s(an|\\\\.) giuseppe\"\n    ]\n  , prod = \\_ -> tt $ monthDay 3 19\n  }\n\nruleEntroIlDuration :: Rule\nruleEntroIlDuration = Rule\n  { name = \"entro il <duration>\"\n  , pattern =\n    [ regex \"(entro|durante|per( tutt[ao])?) (il|l[a'])|in|nel(l[a'])?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        Token Time <$> interval TTime.Open now (cycleNth grain 1)\n      _ -> Nothing\n  }\n\nruleDimTimeAlPartofday :: Rule\nruleDimTimeAlPartofday = Rule\n  { name = \"<dim time> al <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , regex \"al|nel(la)?|in|d(i|el(la)?)\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleSeason4 :: Rule\nruleSeason4 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(in )?primavera\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 3 20\n          to = monthDay 6 21\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"mezz?ogiorno\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleTheDayBeforeYesterday :: Rule\nruleTheDayBeforeYesterday = Rule\n  { name = \"the day before yesterday\"\n  , pattern =\n    [ regex \"(l')?altro\\\\s?ieri\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 2\n  }\n\nruleNextCycle :: Rule\nruleNextCycle = Rule\n  { name = \"next <cycle> \"\n  , pattern =\n    [ regex \"((il|la|[nd]el(la)?) )?prossim[oa]\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Lunedi\"   , \"luned(i|\u00c3\u00ac)|lun?\\\\.?\"   )\n  , ( \"Martedi\"  , \"marted(i|\u00c3\u00ac)|mar\\\\.?\"   )\n  , ( \"Mercoledi\", \"mercoled(i|\u00c3\u00ac)|mer\\\\.?\" )\n  , ( \"Giovedi\"  , \"gioved(i|\u00c3\u00ac)|gio\\\\.?\"   )\n  , ( \"Venerdi\"  , \"venerd(i|\u00c3\u00ac)|ven\\\\.?\"   )\n  , ( \"Sabato\"   , \"sabato|sab\\\\.?\"        )\n  , ( \"Domenica\" , \"domenica|dom\\\\.?\"      )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"Gennaio\"  , \"gennaio|genn?\\\\.?\"   )\n  , ( \"Febbraio\" , \"febbraio|febb?\\\\.?\"  )\n  , ( \"Marzo\"    , \"marzo|mar\\\\.?\"       )\n  , ( \"Aprile\"   , \"aprile|apr\\\\.?\"      )\n  , ( \"Maggio\"   , \"maggio|magg?\\\\.?\"    )\n  , ( \"Giugno\"   , \"giugno|giu\\\\.?\"      )\n  , ( \"Luglio\"   , \"luglio|lug\\\\.?\"      )\n  , ( \"Agosto\"   , \"agosto|ago\\\\.?\"      )\n  , ( \"Settembre\", \"settembre|sett?\\\\.?\" )\n  , ( \"Ottobre\"  , \"ottobre|ott\\\\.?\"     )\n  , ( \"Novembre\" , \"novembre|nov\\\\.?\"    )\n  , ( \"Dicembre\" , \"dicembre|dic\\\\.?\"    )\n  ]\n\nrulePeriodicHolidays :: [Rule]\nrulePeriodicHolidays = mkRuleHolidays\n  -- Fixed dates, year over year\n  [ ( \"Giornata dell'Africa\", \"giornata (dell('((unit(\u00c3\u00a0|a)|unione) )?|a (liberazione|libert(\u00c3\u00a0|a)) ))?africa(na)?\", monthDay 5 25 )\n  , ( \"Giornata dell'Industrializzazione dell'Africa\", \"giornata (dell')?industrializzazione (dell')?africa(na)\", monthDay 11 20 )\n  , ( \"Pesce d'aprile\", \"pesce d'aprile\", monthDay 4 1 )\n  , ( \"Giornata della lingua araba\", \"giornata della lingua araba\", monthDay 12 18 )\n  , ( \"Assunzione di Maria\", \"assunzione di maria\", monthDay 8 15 )\n  , ( \"Boxing Day\", \"boxing day\", monthDay 12 26 )\n  , ( \"Giornata della lingua cinese\", \"giornata della lingua cinese\", monthDay 4 20 )\n  , ( \"Giornata della memoria per tutte le vittime della guerra chimica\", \"Giornata della memoria per tutte le vittime della guerra chimica\", monthDay 4 29 )\n  , ( \"Giornata Internazionale della memoria delle vittime del genocidio del Rwanda\", \"giornata internazionale della (memoria|riflessione) (delle vittime )?del genocidio del rwanda\", monthDay 4 7 )\n  , ( \"Giorno della gente di mare\", \"giornata (mondiale )? del( marittimo|la gente di mare)\", monthDay 6 25 )\n  , ( \"Giornata della Terra\", \"giornata della terra\", monthDay 4 22 )\n  , ( \"Giornata della lingua inglese\", \"giornata della lingua inglese\", monthDay 4 23 )\n  , ( \"San Francesco d'Assisi\", \"san francesco d'assisi\", monthDay 10 4 )\n  , ( \"Giorno dei genitori\", \"giorno dei genitori\", monthDay 6 1 )\n  , ( \"Giornata Mondiale dei diritti umani\", \"giornata (mondiale )?dei diritti umani\", monthDay 12 10 )\n  , ( \"Giornata Internazionale di sensibilizzazione sull'albinismo\", \"giornata internazionale di sensibilizzazione sull'albinismo\", monthDay 6 13 )\n  , ( \"Giornata Internazionale Anticorruzione\", \"giornata internazionale anticorruzione\", monthDay 12 9 )\n  , ( \"Giornata Internazionale Asteroid Day\", \"international asteroid day\", monthDay 6 30 )\n  , ( \"Giornata Mondiale dell'orgoglio bisessuale\", \"giornata mondiale dell('orgoglio|a visibilit(a|\u00c3\u00a0)) bisessuale\", monthDay 9 23 )\n  , ( \"Giornata Internazionale della memoria sul disastro di Chernobyl\", \"giornata internazionale della memoria del disastro di chernobyl\", monthDay 4 26 )\n  , ( \"Giornata Internazionale dell'aviazione civile\", \"giornata internazionale dell'aviazione civile\", monthDay 12 7 )\n  , ( \"Giornata Internazionale delle dogane\", \"giornata internazionale delle dogane\", monthDay 1 26 )\n  , ( \"Giornata Internazionale contro l'abuso di droghe e il traffico illecito\", \"giornata internazionale contro l'abuso di droghe e il traffico illecito\", monthDay 6 26 )\n  , ( \"Giornata Internazionale contro i test nucleari\", \"giornata internazionale contro i test nucleari\", monthDay 8 29 )\n  , ( \"Giornata Mondiale della biodiversit\u00c3\u00a0\", \"giornata mondiale della biodiversit(a|\u00c3\u00a0)\", monthDay 5 22 )\n  , ( \"Giornata Internazionale dei Monumenti e dei Siti\", \"giornata internazionale dei monumenti e dei siti\", monthDay 4 18 )\n  , ( \"Giornata Internazionale per prevenire lo sfruttamento dell'ambiente in guerra e conflitti armati\", \"giornata internazionale per prevenire lo sfruttamento dell'ambiente in guerra e conflitti armati\", monthDay 11 6 )\n  , ( \"Giornata Internazionale per la Cooperazione Sud-Sud\", \"giornata internazionale per la Cooperazione sud(\\\\-|\\\\s)sud\", monthDay 9 12 )\n  , ( \"Giornata Internazionale della tolleranza\", \"giornata internazionale della tolleranza\", monthDay 11 16 )\n  , ( \"Giornata Internazionale per l'abolizione della schiavit\u00c3\u00b9\", \"giornata internazionale per l'abolizione della schiavit(u|\u00c3\u00b9)\", monthDay 12 2 )\n  , ( \"Giornata Internazionale per l'eliminazione della discriminazione razziale\", \"giornata internazionale per l'eliminazione della discriminazione razziale\", monthDay 3 21 )\n  , ( \"Giornata Internazionale contro la violenza sessuale nei conflitti armati\", \"giornata internazionale contro la violenza sessuale nei conflitti( armati)?\", monthDay 6 19 )\n  , ( \"Giornata Internazionale per l'eliminazione della violenza contro le donne\", \"giornata internazionale per l'eliminazione della violenza contro le donne\", monthDay 11 25 )\n  , ( \"Giornata Internazionale contro la Povert\u00c3\u00a0\", \"giornata internazionale (contro |per l'e(radic|limin)azione del)la povert(a|\u00c3\u00a0)\", monthDay 10 17 )\n  , ( \"Giornata Internazionale per la preservazione dello strato di ozono\", \"giornata internazionale per la preservazione dello strato di ozono\", monthDay 9 16 )\n  , ( \"Giornata Internazionale per la Commemorazione della Tratta degli Schiavi e la sua abolizione\", \"giornata internazionale per la commemorazione della tratta degli schiavi e la sua abolizione\", monthDay 8 23 )\n  , ( \"Giornata Internazionale per il diritto alla verit\u00c3\u00a0 sulle gravi violazioni dei diritti umani e per la dignit\u00c3\u00a0 delle vittime\", \"giornata internazionale per il diritto alla verit(a|\u00c3\u00a0) sulle gravi violazioni dei diritti umani e per la dignit(a|\u00c3\u00a0) delle vittime\", monthDay 3 24 )\n  , ( \"Giornata Internazionale per l'eliminazione totale delle armi nucleari\", \"giornata internazionale per l'eliminazione totale delle armi nucleari\", monthDay 9 26 )\n  , ( \"Giornata Internazionale a sostegno delle vittime di tortura\", \"giornata Internazionale a sostegno delle vittime di tortura\", monthDay 6 26 )\n  , ( \"Giornata Internazionale della Carit\u00c3\u00a0\", \"giornata internazionale della carit(a|\u00c3\u00a0)\", monthDay 9 5 )\n  , ( \"Giornata Internazionale di commemorazione in memoria delle vittime dell'Olocausto\", \"giornata internazionale di commemorazione in memoria delle vittime dell'olocausto\", monthDay 1 27 )\n  , ( \"Giornata Internazionale della Democrazia\", \"giornata internazionale della democrazia\", monthDay 9 15 )\n  , ( \"Giornata Internazionale delle persone con disabilit\u00c3\u00a0\", \"giornata internazionale delle persone con disabilit(a|\u00c3\u00a0)\", monthDay 12 3 )\n  , ( \"Giornata Internazionale della Famiglia\", \"giornata internazionale dell(a|e) famigli(a|e)\", monthDay 5 15 )\n  , ( \"Giornata Internazionale delle Rimesse Familiari\", \"giornata Internazionale delle rimesse familiari\", monthDay 6 16 )\n  , ( \"Giornata Internazionale delle foreste\", \"giornata internazionale delle foreste\", monthDay 3 21 )\n  , ( \"Giornata Internazionale dell'amicizia\", \"giornata internazionale dell'amicizia\", monthDay 7 30 )\n  , ( \"Giornata Internazionale della Felicit\u00c3\u00a0\", \"giornata internazionale della felicit(a|\u00c3\u00a0)\", monthDay 3 20 )\n  , ( \"Giornata Mondiale del volo umano nello spazio\", \"giornata mondiale del volo umano nello spazio\", monthDay 4 12 )\n  , ( \"Giornata Internazionale dei bambini innocenti vittime di aggressioni\", \"giornata internazionale dei bambini innocenti vittime di aggressioni\", monthDay 6 4 )\n  , ( \"Giornata Internazionale della nonviolenza\", \"giornata internazionale della nonviolenza\", monthDay 10 2 )\n  , ( \"Giornata Internazionale di Nowruz\", \"giornata internazionale di nowruz\", monthDay 3 21 )\n  , ( \"Giornata Internazionale delle Persone Anziane\", \"giornata internazionale delle persone anziane\", monthDay 10 1 )\n  , ( \"Giornata Internazionale della pace\", \"giornata internazionale della pace\", monthDay 9 21 )\n  , ( \"Giornata Internazionale in ricordo delle vittime delle schiavit\u00c3\u00b9 e della tratta transatlantica degli schiavi\", \"giornata internazionale in ricordo delle vittime delle schiavit\u00c3\u00b9 e della tratta transatlantica degli schiavi\", monthDay 3 25 )\n  , ( \"Giornata Internazionale delle donne rurali\", \"giornata internazionale delle donne rurali\", monthDay 10 15 )\n  , ( \"Giornata di solidariet\u00c3\u00a0 con i funzionari detenuti o scomparsi\", \"giornata di solidariet(a|\u00c3\u00a0) con i funzionari detenuti o scomparsi\", monthDay 3 25 )\n  , ( \"Giornata Internazionale di solidariet\u00c3\u00a0 per il popolo palestinese\", \"giornata internazionale della solidariet(a|\u00c3\u00a0) con il popolo palestinese\", monthDay 11 29 )\n  , ( \"Giornata Internazionale dello sport per lo sviluppo e la pace\", \"giornata internazionale dello sport per lo sviluppo e la pace\", monthDay 4 6 )\n  , ( \"Giornata Internazionale dei Peacekeepers delle Nazioni Unite\", \"giornata internazionale dei peacekeepers delle nazioni unite\", monthDay 5 29 )\n  , ( \"Giornata Mondiale per le donne e le ragazze nella scienza\", \"giornata mondiale per le donne e le ragazze nella scienza\", monthDay 2 11 )\n  , ( \"Giornata Internazionale dello Yoga\", \"giornata internazionale dello yoga\", monthDay 6 21 )\n  , ( \"Giornata Internazionale sulla tolleranza zero nei confronti delle mutilazioni genitali femminili\", \"giornata internazionale sulla tolleranza zero nei confronti delle mutilazioni genitali femminili\", monthDay 2 6 )\n  , ( \"Giornata Mondiale delle bambine e delle ragazze\", \"giornata mondiale delle bambine e delle ragazze\", monthDay 10 11 )\n  , ( \"Giornata Internazionale vittime sparizione forzata\", \"giornata internazionale vittime sparizione forzata\", monthDay 8 30 )\n  , ( \"Giornata Internazionale dei popoli indigeni del mondo\", \"giornata internazionale dei popoli indigeni( del mondo)?\", monthDay 8 9 )\n  , ( \"Giornata Internazionale per mettere fine all'impunit\u00c3\u00a0 per i crimini contro i giornalisti\", \"giornata internazionale per mettere fine all'impunit(a|\u00c3\u00a0) per i crimini contro i giornalisti\", monthDay 11 2 )\n  , ( \"Giornata Internazionale per l'Eliminazione della Fistola Ostetrica\", \"giornata internazionale per l'eliminazione della fistola ostetrica\", monthDay 5 23 )\n  , ( \"Giornata Internazionale per la Riduzione dei Disastri Naturali\", \"giornata internazionale per la riduzione dei disastri naturali\", monthDay 10 13 )\n  , ( \"Giornata Internazionale della solidariet\u00c3\u00a0 umana\", \"giornata internazionale della solidariet\u00c3\u00a0 umana\", monthDay 12 20 )\n  , ( \"Giornata Internazionale Jazz Day\", \"international jazz day\", monthDay 4 30 )\n  , ( \"Giornata Internazionale dell'alfabetizzazione\", \"giornata internazionale dell'alfabetizzazione\", monthDay 9 8 )\n  , ( \"Giornata Internazionale dell'uomo\", \"giornata internazionale dell'uomo\", monthDay 11 19 )\n  , ( \"Giornata Internazionale del Migrante\", \"giornata internazionale del migrante\", monthDay 12 18 )\n  , ( \"Giornata Internazionale della lingua madre\", \"giornata internazionale della lingua madre\", monthDay 2 21 )\n  , ( \"Giornata Internazionale della Montagna\", \"giornata internazionale della montagna\", monthDay 12 11 )\n  , ( \"Giornata Internazionale dell'infermiere\", \"giornata internazionale dell'infermiere\", monthDay 5 12 )\n  , ( \"Giornata Internazionale contro l'Overdose\", \"giornata internazionale contro l'overdose\", monthDay 8 31 )\n  , ( \"Giornata Internazionale del Volontariato per lo Sviluppo Economico e Sociale\", \"giornata internazionale del volontariato per lo sviluppo economico e sociale\", monthDay 12 5 )\n  , ( \"Giornata Internazionale delle Vedove\", \"giornata internazionale delle vedove\", monthDay 6 23 )\n  , ( \"Giornata Internazionale della donna\", \"giornata internazionale della donna\", monthDay 3 8 )\n  , ( \"Giornata Mondiale della giovent\u00c3\u00b9\", \"giornata mondiale della giovent(u|\u00c3\u00b9)\", monthDay 8 12 )\n  , ( \"Giornata Internazionale Nelson Mandela\", \"giornata (internazionale )?nelson mandela\", monthDay 7 18 )\n  , ( \"Natale Ortodosso\", \"natale ortodosso\", monthDay 1 7 )\n  , ( \"Capodanno ortodosso\", \"capodanno ortodosso\", monthDay 1 14 )\n  , ( \"Giornata del servizio pubblico\", \"giornata del servizio pubblico\", monthDay 6 23 )\n  , ( \"Giorno di San Giorgio\", \"(giorno di )?san giorgio\", monthDay 4 23 )\n  , ( \"Festa di San Patrizio\", \"((festa|giorno) di )?san patrizio\", monthDay 3 17 )\n  , ( \"Ricordo e Riconciliazione per Coloro che Hanno Perso la Vita Durante la Seconda Guerra Mondiale\", \"ricordo e riconciliazione per coloro che hanno perso la vita durante la seconda guerra mondiale\", monthDay 5 8 )\n  , ( \"Giornata delle Nazioni Unite\", \"giornata delle nazioni unite\", monthDay 10 24 )\n  , ( \"United Nations' Mine Awareness Day\", \"united nations'? mine awareness day\", monthDay 4 4 )\n  , ( \"United Nations' World Health Day\", \"united nations'? world health day\", monthDay 4 7 )\n  , ( \"Universal Children's Day\", \"universal children'?s day\", monthDay 11 20 )\n  , ( \"Giornata Mondiale contro l'AIDS\", \"giornata mondiale contro l'aids\", monthDay 12 1 )\n  , ( \"Giornata Mondiale per la consapevolezza sull'autismo\", \"giornata mondiale per la consapevolezza sull'autismo\", monthDay 4 2 )\n  , ( \"Giornata Mondiale del Lupus\", \"giornata mondiale del lupus\", monthDay 5 10 )\n  , ( \"Giornata Mondiale del donatore di sangue\", \"giornata mondiale del donatore di sangue\", monthDay 6 14 )\n  , ( \"Giornata Mondiale del libro e del diritto d'autore\", \"giornata mondiale del libro e del( diritto d'autore|le rose)\", monthDay 4 23 )\n  , ( \"Giornata Mondiale dell'alfabeto braille\", \"giornata mondiale del(l'alfabeto)? braille\", monthDay 1 4 )\n  , ( \"Giornata Mondiale contro il cancro\", \"giornata mondiale contro il cancro\", monthDay 2 4 )\n  , ( \"Giornata Mondiale della citt\u00c3\u00a0\", \"giornata mondiale della citt(a|\u00c3\u00a0)\", monthDay 10 31 )\n  , ( \"Giornata Mondiale della paralisi cerebrale infantile\", \"giornata mondiale della paralisi cerebrale( infantile)?\", monthDay 10 6 )\n  , ( \"World Day Against Child Labour\", \"world day against child labour\", monthDay 6 12 )\n  , ( \"Giornata Mondiale contro la tratta di esseri umani\", \"giornata mondiale contro la tratta di esseri umani\", monthDay 7 30 )\n  , ( \"Giornata Mondiale del Patrimonio Audiovisivo\", \"giornata mondiale del patrimonio audiovisivo\", monthDay 10 27 )\n  , ( \"Giornata Mondiale della diversit\u00c3\u00a0 culturale per il dialogo e lo sviluppo\", \"giornata mondiale della diversit(a|\u00c3\u00a0) culturale per il dialogo e lo sviluppo\", monthDay 5 21 )\n  , ( \"Giornata Mondiale per la salute e sicurezza sul lavoro\", \"giornata mondiale per la salute e sicurezza sul lavoro\", monthDay 4 28 )\n  , ( \"Giornata Internazionale per l'abolizione della schiavit\u00c3\u00b9\", \"giornata internazionale per l'abolizione della schiavit(u|\u00c3\u00bb)\", monthDay 12 2 )\n  , ( \"Giornata Mondiale della giustizia sociale\", \"giornata mondiale della giustizia sociale\", monthDay 2 20 )\n  , ( \"Giornata Mondiale del malato\", \"giornata mondiale del malato\", monthDay 2 11 )\n  , ( \"Giornata Mondiale per la lotta alla desertificazione e alla siccit\u00c3\u00a0\", \"giornata mondiale per la lotta alla desertificazione e alla siccit(a|\u00c3\u00a0)\", monthDay 6 17 )\n  , ( \"Giornata Mondiale dell'informazione sullo Sviluppo\", \"giornata mondiale dell'informazione sullo sviluppo\", monthDay 10 24 )\n  , ( \"Giornata Mondiale del diabete\", \"giornata mondiale del diabete\", monthDay 11 14 )\n  , ( \"Giornata Mondiale sulla Sindrome di Down\", \"giornata mondiale (de|su)lla sindrome di down\", monthDay 3 21 )\n  , ( \"Giornata Mondiale contro gli abusi sugli anziani\", \"giornata mondiale contro gli abusi sugli anziani\", monthDay 6 15 )\n  , ( \"Giornata Mondiale dell'ambiente\", \"giornata mondiale dell'ambiente\", monthDay 6 5 )\n  , ( \"Giornata Mondiale dell'alimentazione\", \"giornata mondiale dell'alimentazione\", monthDay 10 16 )\n  , ( \"Giornata Internazionale per la Commemorazione e la Dignit\u00c3\u00a0 delle vittime di Genocidio e della prevenzione di questo crimine\", \"giornata internazionale per la commemorazione (e la dignit(a|\u00c3\u00a0) )?delle vittime di genocidio( e della prevenzione di questo crimine)?\", monthDay 12 9 )\n  , ( \"Giornata Mondiale del cuore\", \"giornata mondiale del cuore\", monthDay 9 29 )\n  , ( \"Giornata Mondiale dell'epatitey\", \"giornata mondiale dell'epatite\", monthDay 7 28 )\n  , ( \"Giornata Mondiale dell'aiuto umanitario\", \"giornata mondiale dell'aiuto umanitario\", monthDay 8 19 )\n  , ( \"Giornata Mondiale delle Telecomunicazioni e della societ\u00c3\u00a0 dell'informazione\", \"giornata mondiale (delle Telecomunicazioni e )?della societ(a|\u00c3\u00a0) dell'informazione\", monthDay 5 17 )\n  , ( \"Giornata Mondiale della propriet\u00c3\u00a0 intellettuale\", \"giornata mondiale della propriet(a|\u00c3\u00a0) intellettuale\", monthDay 4 26 )\n  , ( \"Giornata Mondiale contro la malaria\", \"giornata mondiale contro la malaria\", monthDay 4 25 )\n  , ( \"Giornata Mondiale della salute mentale\", \"giornata mondiale della salute mentale\", monthDay 10 10 )\n  , ( \"Giornata Mondiale della meteorologia\", \"giornata mondiale della meteorologia\", monthDay 3 23 )\n  , ( \"Giornata Mondiale senza tabacco\", \"giornata mondiale senza tabacco\", monthDay 5 31 )\n  , ( \"Giornata Mondiale degli oceani\", \"giornata mondiale degli oceani\", monthDay 6 8 )\n  , ( \"Giornata Mondiale sul Tumore Ovarico\", \"giornata mondiale sul tumore ovarico\", monthDay 5 8 )\n  , ( \"Giornata Mondiale contro la polmonite\", \"giornata mondiale contro la polmonite\", monthDay 11 12 )\n  , ( \"Giornata Mondiale della Poesia\", \"giornata mondiale della poesia\", monthDay 3 21 )\n  , ( \"Giornata Mondiale della popolazione\", \"giornata mondiale della popolazione\", monthDay 7 11 )\n  , ( \"Giornata Mondiale della Posta\", \"giornata mondiale della posta\", monthDay 10 9 )\n  , ( \"Giornata Mondiale della Prematurit\u00c3\u00a0\", \"giornata mondiale de(lla|i) (prematuri(t(a|\u00c3\u00a0))?)\", monthDay 11 17 )\n  , ( \"Giornata Mondiale della libert\u00c3\u00a0 di stampa\", \"giornata mondiale della libert(a|\u00c3\u00a0) di stampa\", monthDay 5 3 )\n  , ( \"Giornata Mondiale contro la rabbia\", \"giornata mondiale contro la rabbia\", monthDay 9 28 )\n  , ( \"Giornata Mondiale della radio\", \"giornata mondiale della radio\", monthDay 2 13 )\n  , ( \"Giornata Mondiale dei profughi\", \"giornata mondiale de(i profughi|l rifugiato)\", monthDay 6 20 )\n  , ( \"Giornata Mondiale della scienza per pace e sviluppo\", \"giornata mondiale della scienza per pace e sviluppo\", monthDay 11 10 )\n  , ( \"Giornata Mondiale del Benessere Sessuale\", \"giornata mondiale del benessere sessuale\", monthDay 9 4 )\n  , ( \"Giornata Mondiale del Suolo\", \"giornata mondiale del suolo\", monthDay 12 5 )\n  , ( \"Giornata Mondiale dell'Ictus\", \"giornata mondiale dell'icuts\", monthDay 10 29 )\n  , ( \"Giornata Mondiale per la Prevenzione del Suicidio\", \"giornata mondiale per la prevenzione del suicidio\", monthDay 9 10 )\n  , ( \"Giornata Mondiale dell'insegnante\", \"giornata mondiale de(gli |ll')insegnant(e|i)\", monthDay 10 5 )\n  , ( \"Giornata Mondiale Della Televisione\", \"giornata mondiale della televisione\", monthDay 11 21 )\n  , ( \"Giornata Mondiale del gabinetto\", \"giornata mondiale del gabinetto\", monthDay 11 19 )\n  , ( \"Giornata Mondiale del turismo\", \"giornata mondiale del turismo\", monthDay 9 27 )\n  , ( \"Giornata Mondiale della tubercolosi\", \"giornata mondiale della tubercolosi\", monthDay 3 24 )\n  , ( \"Giornata Mondiale del Tonno\", \"giornata mondiale del tonno\", monthDay 5 2 )\n  , ( \"Giornata Mondiale dei Vegani\", \"giornata mondiale (de(i|l) )?vegan(i|o|ismo)?\", monthDay 11 1 )\n  , ( \"Giornata Mondiale dei Vegetariani\", \"giornata mondiale de(i|l) vegetari(smo|ani)\", monthDay 10 1 )\n  , ( \"Giornata Mondiale dell'acqua\", \"giornata mondiale dell'acqua\", monthDay 3 22 )\n  , ( \"Giornata Mondiale delle zone umide\", \"giornata mondiale delle zone umide\", monthDay 2 2 )\n  , ( \"Giornata Mondiale della Vita Selvatica\", \"giornata mondiale della (fauna|vita) selvatica\", monthDay 3 3 )\n  , ( \"Giornata Internazionale delle competenze giovanili\", \"giornata internazionale delle competenze giovanili\", monthDay 7 15 )\n  , ( \"Giornata Mondiale contro la discriminazione\", \"giornata mondiale contro la discriminazione\", monthDay 3 1 )\n\n  -- Fixed day/week/month, year over year\n  , ( \"Giornata Mondiale in memoria delle vittime della strada\"\n    , \"Giornata (Mondiale )?in memoria delle vittime della strada\"\n    , nthDOWOfMonth 3 7 11 )\n  , ( \"Giornata Internazionale delle cooperative\"\n    , \"giornata internazionale delle cooperative\", nthDOWOfMonth 1 6 7 )\n  , ( \"Martin Luther King's Day\"\n    , \"((MLK|martin luther king,?)( jr\\\\.?| junior)? day|giornata dei diritti civili)\"\n    , nthDOWOfMonth 3 1 1\n    )\n\n  -- -- The day after Thanksgiving (not always the fourth Friday of November)\n  , ( \"Black Friday\", \"black friday\"\n    , cycleNthAfter False TG.Day 1 $ nthDOWOfMonth 4 4 11\n    )\n  , ( \"Giornata Mondiale dell'Habitat\", \"giornata mondiale dell'habitat\", nthDOWOfMonth 1 1 10 )\n  , ( \"Giornata Mondiale del Rene\", \"giornata mondiale del rene\", nthDOWOfMonth 2 4 3 )\n  , ( \"Giornata Mondiale per i malati di lebbra\", \"giornata mondiale per i malati di lebbra\"\n    , predLastOf (dayOfWeek 7) (month 1) )\n  , ( \"Giornata Mondiale del Mare\", \"giornata mondiale del mare\"\n    , predLastOf (dayOfWeek 4) (month 9) )\n  , ( \"Giornata Mondiale degli uccelli migratori\", \"giornata mondiale degli uccelli migratori\"\n    , nthDOWOfMonth 2 6 5 )\n  , ( \"Giornata Mondiale della filosofia\", \"giornata mondiale della filosofia\", nthDOWOfMonth 3 4 11 )\n  , ( \"Giornata Mondiale della religione\", \"giornata mondiale della religione\", nthDOWOfMonth 3 7 1 )\n  , ( \"Giornata Mondiale della vista\", \"giornata mondiale della vista\", nthDOWOfMonth 2 4 10 )\n  ]\n\nruleTheCycleOfTime :: Rule\nruleTheCycleOfTime = Rule\n  { name = \"the <cycle> of <time>\"\n  , pattern =\n    [ regex \"il|la\"\n    , dimension TimeGrain\n    , regex \"del\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleLunch :: Rule\nruleLunch = Rule\n  { name = \"lunch\"\n  , pattern =\n    [ regex \"(a )?pranzo\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 14\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd[/-]mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[/-](0?[1-9]|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        d <- parseInt m1\n        m <- parseInt m2\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleGliUltimiNCycle :: Rule\nruleGliUltimiNCycle = Rule\n  { name = \"gli ultimi <n> <cycle>\"\n  , pattern =\n    [ regex \"((([nd]el)?le|([nd]e)?gli) )?(scors|ultim)[ei]\"\n    , Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"pomeriggio?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 19\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nrulePartofdayOfDimTime :: Rule\nrulePartofdayOfDimTime = Rule\n  { name = \"<part-of-day> of <dim time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"d(i|el)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleDimTimeDelMattino :: Rule\nruleDimTimeDelMattino = Rule\n  { name = \"<dim time> del mattino\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"del mattino\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> do\n        let from = hour False 0\n            to = hour False 12\n        td2 <- mkLatent . partOfDay <$> interval TTime.Open from to\n        Token Time <$> intersect td td2\n      _ -> Nothing\n  }\n\nruleMidnight :: Rule\nruleMidnight = Rule\n  { name = \"midnight\"\n  , pattern =\n    [ regex \"mez?zanott?e\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleChristmasEve :: Rule\nruleChristmasEve = Rule\n  { name = \"christmas eve\"\n  , pattern =\n    [ regex \"((al)?la )?vigig?lia( di natale)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 24\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"dopo\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleHhhmmTimeofday2 :: Rule\nruleHhhmmTimeofday2 = Rule\n  { name = \"hh(:|h)mm (time-of-day)\"\n  , pattern =\n    [ regex \"((?:0?\\\\d)|(?:1[0-2]))[:h]([0-5]\\\\d) d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        v1 <- parseInt m1\n        v2 <- parseInt m2\n        tt $ hourMinute False (v1 + 12) v2\n      _ -> Nothing\n  }\n\nruleTimeNotte :: Rule\nruleTimeNotte = Rule\n  { name = \"<time> notte\"\n  , pattern =\n    [ dimension Time\n    , regex \"((in|nella|alla) )?nott(e|ata)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> do\n        let td1 = cycleNthAfter False TG.Day 1 td\n        td2 <- interval TTime.Open (hour False 0) (hour False 4)\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleStasera :: Rule\nruleStasera = Rule\n  { name = \"stasera\"\n  , pattern =\n    [ regex \"stasera\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 18) (hour False 0)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleSeason3 :: Rule\nruleSeason3 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(in )?inverno\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 12 21\n          to = monthDay 3 20\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleSeason :: Rule\nruleSeason = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(in )?estate\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 6 21\n          to = monthDay 9 23\n       in Token Time <$> interval TTime.Open from to\n  }\n\nruleIntegerLatentTimeofday :: Rule\nruleIntegerLatentTimeofday = Rule\n  { name = \"<integer> (latent time-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 24\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ hour False v\n      _ -> Nothing\n  }\n\nruleInThePartofdayOfDimTime :: Rule\nruleInThePartofdayOfDimTime = Rule\n  { name = \"in the <part-of-day> of <dim time>\"\n  , pattern =\n    [ regex \"nel(la)?\"\n    , Predicate isAPartOfDay\n    , regex \"d(i|el)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNewYearsEve :: Rule\nruleNewYearsEve = Rule\n  { name = \"new year's eve\"\n  , pattern =\n    [ regex \"((la )?vigig?lia di capodanno|san silvestro)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 31\n  }\n\nruleFerragosto :: Rule\nruleFerragosto = Rule\n  { name = \"ferragosto\"\n  , pattern =\n    [ regex \"ferragosto|assunzione\"\n    ]\n  , prod = \\_ -> tt $ monthDay 8 15\n  }\n\nruleDurationAgo :: Rule\nruleDurationAgo = Rule\n  { name = \"<duration> ago\"\n  , pattern =\n    [ dimension Duration\n    , regex \"fa\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleTimeNotte2 :: Rule\nruleTimeNotte2 = Rule\n  { name = \"<time> notte\"\n  , pattern =\n    [ regex \"((nella|alla) )?nott(e|ata)( d(i|el))\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        let td1 = cycleNthAfter False TG.Day 1 td\n        td2 <- interval TTime.Open (hour False 0) (hour False 4)\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleTimeofdayPrecise :: Rule\nruleTimeofdayPrecise = Rule\n  { name = \"<time-of-day> precise\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"precise\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleHhmmMilitaryTimeofday :: Rule\nruleHhmmMilitaryTimeofday = Rule\n  { name = \"hhmm (military time-of-day)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt . mkLatent $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleTheCycleLast :: Rule\nruleTheCycleLast = Rule\n  { name = \"the <cycle> last\"\n  , pattern =\n    [ regex \"l'|il|la|[nd]el(la)?\"\n    , dimension TimeGrain\n    , regex \"(scors|passat)[oa]\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleFinoAlDatetimeInterval :: Rule\nruleFinoAlDatetimeInterval = Rule\n  { name = \"fino al <datetime> (interval)\"\n  , pattern =\n    [ regex \"[fs]ino a(l(l[ae'])?)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Open now td\n      _ -> Nothing\n  }\n\nruleAtTimeofday :: Rule\nruleAtTimeofday = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"(al)?l[e']|a\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleTheNthTimeOfTime :: Rule\nruleTheNthTimeOfTime = Rule\n  { name = \"the nth <time> of <time>\"\n  , pattern =\n    [ regex \"il|l[a']|[nd]el(l[a'])?\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"di|del(l[a'])?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n         predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"di|del(l[a'])?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n         predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleDalDatetimeAlDatetimeInterval :: Rule\nruleDalDatetimeAlDatetimeInterval = Rule\n  { name = \"dal <datetime> al <datetime> (interval)\"\n  , pattern =\n    [ regex \"da(l(l')?)?\"\n    , Predicate isNotLatent\n    , regex \"([fs]ino )?a(l(l')?)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayDayofmonthInterval :: Rule\nruleTimeofdayTimeofdayDayofmonthInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> <day-of-month> (interval)\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"\\\\-\"\n    , Predicate isATimeOfDay\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:Token Time td3:_) -> do\n        from <- intersect td1 td3\n        to <- intersect td2 td3\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"week[ -]?end|fine ?settimana|we\"\n    ]\n  , prod = \\_ -> tt weekend\n  }\n\nruleIlWeekendDelTime :: Rule\nruleIlWeekendDelTime = Rule\n  { name = \"il week-end del <time>\"\n  , pattern =\n    [ regex \"il (week[ -]?end|fine ?settimana|we) del\"\n    , Predicate $ isGrainOfTime TG.Day\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> do\n        from1 <- intersect (cycleNthAfter False TG.Week 0 td) (dayOfWeek 5)\n        from <- intersect from1 (hour False 18)\n        to1 <- intersect (cycleNthAfter False TG.Week 1 td) (dayOfWeek 1)\n        to <- intersect to1 (hour False 0)\n        Token Time <$> interval TTime.Open from to\n      _ -> Nothing\n  }\n\nruleEomendOfMonth :: Rule\nruleEomendOfMonth = Rule\n  { name = \"EOM|End of month\"\n  , pattern =\n    [ regex \"fine del mese\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Month 1\n  }\n\nruleCommemorazioneDeiDefunti :: Rule\nruleCommemorazioneDeiDefunti = Rule\n  { name = \"commemorazione dei defunti\"\n  , pattern =\n    [ regex \"(((giorno|commemorazione) dei|ai) )?(morti|defunti)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 11 2\n  }\n\nruleImmacolataConcezione :: Rule\nruleImmacolataConcezione = Rule\n  { name = \"immacolata concezione\"\n  , pattern =\n    [ regex \"(all')?immacolata( concezione)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 8\n  }\n\nruleDimTimePartofday :: Rule\nruleDimTimePartofday = Rule\n  { name = \"<dim time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleTraIlDatetimeEIlDatetimeInterval :: Rule\nruleTraIlDatetimeEIlDatetimeInterval = Rule\n  { name = \"tra il <datetime> e il <datetime> (interval)\"\n  , pattern =\n    [ regex \"tra( il| l')?\"\n    , Predicate isATimeOfDay\n    , regex \"e( il| l')?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime2 :: Rule\nruleNthTimeAfterTime2 = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ regex \"il|l'\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"dopo\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token Time td1:_:Token Time td2:_) ->\n        tt $ predNthAfter (TOrdinal.value od - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleDopoLeTimeofday :: Rule\nruleDopoLeTimeofday = Rule\n  { name = \"dopo le <time-of-day>\"\n  , pattern =\n    [ regex \"dopo( l['ea'])?|dal(l['ea'])?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt . withDirection TTime.After $ notLatent td\n      _ -> Nothing\n  }\n\nruleDopoTime :: Rule\nruleDopoTime = Rule\n  { name = \"dopo <time>\"\n  , pattern =\n    [ regex \"dopo|dal?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleDalInt :: Rule\nruleDalInt = Rule\n  { name = \"dal <integer\"\n  , pattern =\n    [ regex \"dal\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt . withDirection TTime.After $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleTimeEntroLeTime :: Rule\nruleTimeEntroLeTime = Rule\n  { name = \"<time> entro le <time>\"\n  , pattern =\n    [ dimension Time\n    , regex \"entro( l[e'])?|prima d(i|ell['ea])\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time . withDirection TTime.Before <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleEntroTime :: Rule\nruleEntroTime = Rule\n  { name = \"entro <time>\"\n  , pattern =\n    [ regex \"entro( la)?|prima d(i|ella)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleEntroIlInt :: Rule\nruleEntroIlInt = Rule\n  { name = \"entro il <integer>\"\n  , pattern =\n    [ regex \"entro il|prima del\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt . withDirection TTime.Before $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"prossim[ao]\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 1 False td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime3 :: Rule\nruleNthTimeOfTime3 = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ regex \"il|l'\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"di|del(l[oa'])|in\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n         predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleIlCycleDopoTime :: Rule\nruleIlCycleDopoTime = Rule\n  { name = \"il <cycle> dopo <time>\"\n  , pattern =\n    [ regex \"l[a']|il|[nd]el\"\n    , dimension TimeGrain\n    , regex \"dopo\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (yy:mm:dd:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleNextNCycle :: Rule\nruleNextNCycle = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"((([nd]e)?i|([nd]el)?le) )?prossim[ei]\"\n    , Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"mattin(ata|[aoe])\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 4\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTheDayofmonth :: Rule\nruleTheDayofmonth = Rule\n  { name = \"il <day-of-month>\"\n  , pattern =\n    [ regex \"il|l'\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"(que)?st[oa]|i[nl]|(al|nel)(la)?|la\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisCycle :: Rule\nruleThisCycle = Rule\n  { name = \"this <cycle>\"\n  , pattern =\n    [ regex \"(in )?quest['oa]|per (il|l['a])\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"quest[oaie']\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleTwoTimeTokensSeparatedByDi :: Rule\nruleTwoTimeTokensSeparatedByDi = Rule\n  { name = \"two time tokens separated by `di`\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"di\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleTimeofdayCirca :: Rule\nruleTimeofdayCirca = Rule\n  { name = \"<time-of-day> circa\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"circa\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleYesterday :: Rule\nruleYesterday = Rule\n  { name = \"yesterday\"\n  , pattern =\n    [ regex \"ieri\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleSeason2 :: Rule\nruleSeason2 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"(in )?autunno\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 9 23\n          to = monthDay 12 21\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleCircaPerLeTimeofday :: Rule\nruleCircaPerLeTimeofday = Rule\n  { name = \"circa per le <time-of-day>\"\n  , pattern =\n    [ regex \"(circa )?per( le)?|circa( alle)?|verso( le)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleVersoPartOfDay :: Rule\nruleVersoPartOfDay = Rule\n  { name = \"verso <part-of-day>\"\n  , pattern =\n    [ regex \"verso( la| il)?\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleChristmas :: Rule\nruleChristmas = Rule\n  { name = \"christmas\"\n  , pattern =\n    [ regex \"((il )?giorno di )?natale\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleNight :: Rule\nruleNight = Rule\n  { name = \"night\"\n  , pattern =\n    [ regex \"nott(e|ata)\"\n    ]\n  , prod = \\_ -> do\n      let td1 = cycleNth TG.Day 1\n      td2 <- interval TTime.Open (hour False 0) (hour False 4)\n      Token Time . partOfDay . mkLatent <$> intersect td1 td2\n  }\n\nruleOgnissanti :: Rule\nruleOgnissanti = Rule\n  { name = \"ognissanti\"\n  , pattern =\n    [ regex \"(tutti i |ognis|festa dei |([ia]l )?giorno dei )santi\"\n    ]\n  , prod = \\_ -> tt $ monthDay 11 1\n  }\n\nruleIntegerDelPartOfDay :: Rule\nruleIntegerDelPartOfDay = Rule\n  { name = \"<integer 0 12> del <part of day>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 12\n    , regex \"d(i|el(la)?) (pomeriggio|(sta)?(sera|notte))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:_) ->\n        tt $ hour False (12 + floor v)\n      _ -> Nothing\n  }\n\nruleOrdinalCycleOfTime :: Rule\nruleOrdinalCycleOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"di|del(l[a'])?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleGliNUltimiCycle :: Rule\nruleGliNUltimiCycle = Rule\n  { name = \"gli <n> ultimi <cycle>\"\n  , pattern =\n    [ regex \"([nd]e)?i|([nd]el)?le\"\n    , Predicate $ isIntegerBetween 2 9999\n    , regex \"(scors|ultim)[ei]\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleDalleTimeofdayAlleTimeofdayInterval :: Rule\nruleDalleTimeofdayAlleTimeofdayInterval = Rule\n  { name = \"dalle <time-of-day> alle <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"da(ll[ae'])?\"\n    , Predicate isATimeOfDay\n    , regex \"\\\\-|([fs]ino )?a(ll[ae'])?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEntroLeTimeofday :: Rule\nruleEntroLeTimeofday = Rule\n  { name = \"entro le <time-of-day>\"\n  , pattern =\n    [ regex \"entro( l[ea'])?|prima d(i|ell['e])\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt . withDirection TTime.Before $ notLatent td\n      _ -> Nothing\n  }\n\nruleHalloweenDay :: Rule\nruleHalloweenDay = Rule\n  { name = \"halloween day\"\n  , pattern =\n    [ regex \"hall?owe?en\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 31\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"(([nd]el)?l')?ultim[oa]\"\n    , Predicate isADayOfWeek\n    , regex \"di|del(l[a'])?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleNameddayDayofmonth :: Rule\nruleNameddayDayofmonth = Rule\n  { name = \"<named-day> <day-of-month>\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime2 :: Rule\nruleLastDayofweekOfTime2 = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"(l')ultim[oa]\"\n    , Predicate isADayOfWeek\n    , regex \"di\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd[/-]mm[/-]yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[/-](0?[1-9]|1[0-2])[/-](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTwoTimeTokensInARow :: Rule\nruleTwoTimeTokensInARow = Rule\n  { name = \"two time tokens in a row\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleIleNCyclePassatipassate :: Rule\nruleIleNCyclePassatipassate = Rule\n  { name = \"i|le n <cycle> passati|passate\"\n  , pattern =\n    [ regex \"([nd]e)?i|([nd]el)?le\"\n    , Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"(scors|passat)[ie]\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleEoyendOfYear :: Rule\nruleEoyendOfYear = Rule\n  { name = \"EOY|End of year\"\n  , pattern =\n    [ regex \"fine dell' ?anno\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Year 1\n  }\n\nruleTomorrow :: Rule\nruleTomorrow = Rule\n  { name = \"tomorrow\"\n  , pattern =\n    [ regex \"domani\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleNextNCycle2 :: Rule\nruleNextNCycle2 = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"([nd]e)?i|([nd]el)?le\"\n    , Predicate $ isIntegerBetween 2 9999\n    , regex \"prossim[ei]\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleProssimiUnitofduration :: Rule\nruleProssimiUnitofduration = Rule\n  { name = \"prossimi <unit-of-duration>\"\n  , pattern =\n    [ regex \"((([nd]e)?i|([nd]el)?le) )?prossim[ie]\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        let from = cycleNth grain 1\n            to = cycleNth grain 3\n        in Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleMothersDay :: Rule\nruleMothersDay = Rule\n  { name = \"Mother's Day\"\n  , pattern =\n    [ regex \"festa della mamma\"\n    ]\n  , prod = \\_ -> tt $ nthDOWOfMonth 2 7 5\n  }\n\nruleFestaDelLavoro :: Rule\nruleFestaDelLavoro = Rule\n  { name = \"festa del lavoro\"\n  , pattern =\n    [ regex \"festa del lavoro|(festa|giorno) dei lavoratori\"\n    ]\n  , prod = \\_ -> tt $ monthDay 5 1\n  }\n\nruleIntersectByDiDellaDel :: Rule\nruleIntersectByDiDellaDel = Rule\n  { name = \"intersect by \\\"di\\\", \\\"della\\\", \\\"del\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"di|del(la)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleAfternoon\n  , ruleAtTimeofday\n  , ruleChristmas\n  , ruleChristmasEve\n  , ruleCircaPerLeTimeofday\n  , ruleCommemorazioneDeiDefunti\n  , ruleDalDatetimeAlDatetimeInterval\n  , ruleDalleTimeofdayAlleTimeofdayInterval\n  , ruleDatetimeDatetimeInterval\n  , ruleDayOfMonthSt\n  , ruleDayofmonthNamedmonth\n  , ruleDdddMonthInterval\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleDimTimeAlPartofday\n  , ruleDimTimeDelMattino\n  , ruleDimTimePartofday\n  , ruleDopoLeTimeofday\n  , ruleDurationAgo\n  , ruleEntroIlDuration\n  , ruleEntroLeTimeofday\n  , ruleEomendOfMonth\n  , ruleEoyendOfYear\n  , ruleEpifania\n  , ruleEvening\n  , ruleFerragosto\n  , ruleFestaDelLavoro\n  , ruleFestaDelPap\n  , ruleFestaDellaLiberazione\n  , ruleFestaDellaRepubblica\n  , ruleFinoAlDatetimeInterval\n  , ruleGliNUltimiCycle\n  , ruleGliUltimiNCycle\n  , ruleHalloweenDay\n  , ruleHhRelativeminutesDelPomeriggiotimeofday\n  , ruleHhRelativeminutesDelPomeriggiotimeofday2\n  , ruleHhhmmTimeofday\n  , ruleHhhmmTimeofday2\n  , ruleHhmmMilitaryTimeofday\n  , ruleHourofdayAndRelativeMinutes\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleHourofdayMinusIntegerAsRelativeMinutes\n  , ruleIlCycleDopoTime\n  , ruleIlDayofmonthDeNamedmonth\n  , ruleIlTime\n  , ruleIleNCyclePassatipassate\n  , ruleInDuration\n  , ruleInNamedmonth\n  , ruleInThePartofdayOfDimTime\n  , ruleInafterDuration\n  , ruleIntegerDelPartOfDay\n  , ruleIntegerLatentTimeofday\n  , ruleIntersectByDiDellaDel\n  , ruleLastCycleOfTime\n  , ruleLastDayofweekOfTime\n  , ruleLastDayofweekOfTime2\n  , ruleLastTime\n  , ruleLeIdiDiNamedmonth\n  , ruleLunch\n  , ruleMidnight\n  , ruleMorning\n  , ruleMothersDay\n  , ruleNameddayDayofmonth\n  , ruleNewYearsDay\n  , ruleNewYearsEve\n  , ruleNextCycle\n  , ruleNextNCycle\n  , ruleNextNCycle2\n  , ruleNextTime\n  , ruleNextTime2\n  , ruleNight\n  , ruleNoon\n  , ruleNthTimeAfterTime\n  , ruleNthTimeAfterTime2\n  , ruleNthTimeOfTime\n  , ruleNthTimeOfTime2\n  , ruleNthTimeOfTime3\n  , ruleOgnissanti\n  , ruleOrdinalCycleOfTime\n  , rulePartofdayOfDimTime\n  , ruleProssimiUnitofduration\n  , ruleRelativeMinutesToIntegerAsHourofday\n  , ruleRightNow\n  , ruleSantoStefano\n  , ruleSeason\n  , ruleSeason2\n  , ruleSeason3\n  , ruleSeason4\n  , ruleStamattina\n  , ruleStanotte\n  , ruleStasera\n  , ruleTheCycleLast\n  , ruleTheCycleNext\n  , ruleTheCycleOfTime\n  , ruleTheDayAfterTomorrow\n  , ruleTheDayBeforeYesterday\n  , ruleTheDayofmonth\n  , ruleTheLastCycle\n  , ruleTheNthTimeOfTime\n  , ruleTheOrdinalCycleOfTime\n  , ruleThisCycle\n  , ruleThisDayofweek\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleTimeLast\n  , ruleTimeNotte\n  , ruleTimeNotte2\n  , ruleTimeofdayCirca\n  , ruleTimeofdayOra\n  , ruleTimeofdayPrecise\n  , ruleTimeofdayTimeofdayDayofmonthInterval\n  , ruleTomorrow\n  , ruleTraIlDatetimeEIlDatetimeInterval\n  , ruleTwoTimeTokensInARow\n  , ruleTwoTimeTokensSeparatedByDi\n  , ruleUna\n  , ruleValentinesDay\n  , ruleWeekend\n  , ruleYearLatent\n  , ruleYearNotLatent\n  , ruleYesterday\n  , ruleYyyymmdd\n  , ruleHhThreeQuarterDelPomeriggiotimeofday\n  , ruleHhThreeQuarterDelPomeriggiotimeofday2\n  , ruleHourofdayMinusThreeQuarter\n  , ruleThreeQuarterToIntegerAsHourofday\n  , ruleHourofdayAndThreeQuarter\n  , ruleHourofdayThreeQuarters\n  , ruleHhQuartDelPomeriggiotimeofday\n  , ruleHhQuartDelPomeriggiotimeofday2\n  , ruleHourofdayMinusQuart\n  , ruleQuartAsHourofday\n  , ruleHourofdayAndAQuart\n  , ruleHourofdayQuart\n  , ruleHhHalfDelPomeriggiotimeofday\n  , ruleHhHalfDelPomeriggiotimeofday2\n  , ruleHourofdayMinusHalf\n  , ruleHalfToIntegerAsHourofday\n  , ruleHourofdayAndHalf\n  , ruleHourofdayHalf\n  , ruleHhIntegerminutesDelPomeriggiotimeofday\n  , ruleHhIntegerminutesDelPomeriggiotimeofday2\n  , ruleHourofdayMinusIntegerMinutes\n  , ruleMinutesToIntegerAsHourofday\n  , ruleHourofdayAndIntegerMinutes\n  , ruleHourofdayIntegerMinutes\n  , ruleTimezone\n  , ruleTimeEntroLeTime\n  , ruleImmacolataConcezione\n  , ruleOrdinalQuarter\n  , ruleTheOrdinalQuarter\n  , ruleCycleOrdinalQuarterYear\n  , ruleCycleTheOrdinalTime\n  , ruleCycleNext\n  , ruleDomattina\n  , ruleVersoPartOfDay\n  , ruleEntroIlInt\n  , ruleEntroTime\n  , ruleDalInt\n  , ruleDopoTime\n  , ruleToday\n  , ruleDalIntAlInt\n  , ruleTraIlIntEIlInt\n  , ruleIlWeekendDelTime\n  ]\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n  ++ rulePeriodicHolidays\n", "num_lines": 2572}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.NB.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Testing.Types hiding (examples)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NB Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"n\u00c3\u00a5\"\n             , \"akkurat n\u00c3\u00a5\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"i dag\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"i g\u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"i morgen\"\n             , \"i morra\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"mandag\"\n             , \"man.\"\n             , \"p\u00c3\u00a5 mandag\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Mandag den 18. februar\"\n             , \"Man, 18 februar\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"tirsdag\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"torsdag\"\n             , \"tors\"\n             , \"tors.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"fredag\"\n             , \"fre\"\n             , \"fre.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"l\u00c3\u00b8rdag\"\n             , \"l\u00c3\u00b8r\"\n             , \"l\u00c3\u00b8r.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"s\u00c3\u00b8ndag\"\n             , \"s\u00c3\u00b8n\"\n             , \"s\u00c3\u00b8n.\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"Den f\u00c3\u00b8rste mars\"\n             , \"1. mars\"\n             , \"Den 1. mars\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"3 mars\"\n             , \"den tredje mars\"\n             , \"den 3. mars\"\n             ]\n  , examples (datetime (2013, 10, 30, 0, 0, 0) Day)\n             [ \"30.10\"\n             , \"30/10\"\n             , \"30-10\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"3 mars 2015\"\n             , \"tredje mars 2015\"\n             , \"3. mars 2015\"\n             , \"3-3-2015\"\n             , \"03-03-2015\"\n             , \"3/3/2015\"\n             , \"3/3/15\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             , \"2015.03.03\"\n             , \"03/03/2015\"\n             , \"03.03.2015\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"P\u00c3\u00a5 den 15.\"\n             , \"P\u00c3\u00a5 den 15\"\n             , \"Den 15.\"\n             , \"Den femtende\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"den 15. februar\"\n             , \"15. februar\"\n             , \"februar 15\"\n             , \"15-02\"\n             , \"15/02\"\n             , \"15.2\"\n             ]\n  , examples (datetime (2013, 11, 27, 0, 0, 0) Day)\n             [ \"den 27. november\"\n             , \"27. november\"\n             , \"november 27\"\n             , \"27-11\"\n             , \"27/11\"\n             , \"27.11\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"8 Aug\"\n             ]\n  , examples (datetime (2014, 10, 0, 0, 0, 0) Month)\n             [ \"Oktober 2014\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31.10.1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             , \"31.10.74\"\n             , \"1974/10/31\"\n             , \"1974-10-31\"\n             , \"1974.10.31\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14april 2015\"\n             , \"April 14, 2015\"\n             , \"fjortende April 15\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"neste fredag igjen\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"neste mars\"\n             ]\n  , examples (datetime (2014, 3, 0, 0, 0, 0) Month)\n             [ \"neste mars igjen\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"S\u00c3\u00b8ndag, 10 feb\"\n             , \"S\u00c3\u00b8ndag 10 Feb\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"Ons, Feb13\"\n             , \"Ons feb13\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Mandag, Feb 18\"\n             , \"Man, februar 18\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"denne uken\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"forrige uke\"\n             , \"sist uke\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"neste uke\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"forrige m\u00c3\u00a5ned\"\n             , \"sist m\u00c3\u00a5ned\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"neste m\u00c3\u00a5ned\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"dette kvartalet\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"neste kvartal\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"tredje kvartal\"\n             , \"3. kvartal\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"4. kvartal 2018\"\n             , \"fjerde kvartal 2018\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"forrige \u00c3\u00a5r\"\n             , \"sist \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"i fjor\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"i \u00c3\u00a5r\"\n             , \"dette \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"neste \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"forrige s\u00c3\u00b8ndag\"\n             , \"sist s\u00c3\u00b8ndag\"\n             , \"s\u00c3\u00b8ndag i forrige uke\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"forrige tirsdag\"\n             , \"sist tirsdag\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"neste tirsdag\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"neste onsdag\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"onsdag i neste uke\"\n             , \"onsdag neste uke\"\n             , \"neste onsdag igjen\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"neste fredag igjen\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"mandag denne uken\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"tirsdag denne uken\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"onsdag denne uken\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"i overimorgen\"\n             , \"i overimorra\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"i forig\u00c3\u00a5rs\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"siste mandag i mars\"\n             , \"siste mandag i mars\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"siste s\u00c3\u00b8ndag i mars 2014\"\n             , \"siste s\u00c3\u00b8ndag i mars 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"tredje dag i oktober\"\n             , \"tredje dag i Oktober\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"f\u00c3\u00b8rste uke i oktober 2014\"\n             , \"f\u00c3\u00b8rste uke i Oktober 2014\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"siste dag i oktober 2015\"\n             , \"siste dag i Oktober 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"siste uke i september 2014\"\n             , \"siste uke i September 2014\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b8rste tirsdag i oktober\"\n             , \"f\u00c3\u00b8rste tirsdag i Oktober\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"tredje tirsdag i september 2014\"\n             , \"tredje tirsdag i September 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b8rste onsdag i oktober 2014\"\n             , \"f\u00c3\u00b8rste onsdag i Oktober 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"andre onsdag i oktober 2014\"\n             , \"andre onsdag i Oktober 2014\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Hour)\n             [ \"klokken 3\"\n             , \"klokka 3\"\n             , \"kl. 3\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"klokken 15\"\n             , \"klokka 15\"\n             , \"kl. 15\"\n             , \"15h\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"ca. kl. 15\"\n             , \"cirka kl. 15\"\n             , \"omkring klokken 15\"\n             , \"omkring klokka 15\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"imorgen klokken 17 sharp\"\n             , \"imorra klokken 17 sharp\"\n             , \"imorgen klokka 17 presis\"\n             , \"imorra klokka 17 presis\"\n             , \"imorgen kl. 17 presis\"\n             , \"imorra kl. 17 presis\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"kvarter over 15\"\n             , \"kvart over 15\"\n             , \"15:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"kl. 20 over 15\"\n             , \"klokken 20 over 15\"\n             , \"klokka 20 over 15\"\n             , \"kl. 15:20\"\n             , \"15:20\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"15:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 23, 24) Second)\n             [ \"15:23:24\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"kvarter p\u00c3\u00a5 12\"\n             , \"kvart p\u00c3\u00a5 12\"\n             , \"11:45\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"klokken 9 p\u00c3\u00a5 l\u00c3\u00b8rdag\"\n             , \"klokka 9 p\u00c3\u00a5 l\u00c3\u00b8rdag\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Minute)\n             [ \"Fre, Jul 18, 2014 19:00\"\n             ]\n  , examples (datetime (2014, 7, 18, 0, 0, 0) Day)\n             [ \"Fre, Jul 18\"\n             , \"Jul 18, Fre\"\n             ]\n  , examples (datetime (2014, 9, 20, 19, 30, 0) Minute)\n             [ \"kl. 19:30, L\u00c3\u00b8r, 20 sep\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"om 1 sekund\"\n             , \"om ett sekund\"\n             , \"om et sekund\"\n             , \"ett sekund fra n\u00c3\u00a5\"\n             , \"et sekund fra n\u00c3\u00a5\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"om 1 minutt\"\n             , \"om et minutt\"\n             , \"om ett minutt\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"om 2 minutter\"\n             , \"om to minutter\"\n             , \"om 2 minutter mer\"\n             , \"om to minutter mer\"\n             , \"2 minutter fra n\u00c3\u00a5\"\n             , \"to minutter fra n\u00c3\u00a5\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"om 60 minutter\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"om en halv time\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 0, 0) Second)\n             [ \"om 2,5 time\"\n             , \"om 2 og en halv time\"\n             , \"om to og en halv time\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"om \u00c3\u00a9n time\"\n             , \"om 1 time\"\n             , \"om 1t\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 30, 0) Minute)\n             [ \"om et par timer\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"om 24 timer\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"om en dag\"\n             ]\n  , examples (datetime (2016, 2, 0, 0, 0, 0) Month)\n             [ \"3 \u00c3\u00a5r fra i dag\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"om 7 dager\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"om en uke\"\n             , \"om \u00c3\u00a9n uke\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"om ca. en halv time\"\n             , \"om cirka en halv time\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 dager siden\"\n             , \"syv dager siden\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"14 dager siden\"\n             , \"fjorten dager siden\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"en uke siden\"\n             , \"\u00c3\u00a9n uke siden\"\n             , \"1 uke siden\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"3 uker siden\"\n             , \"tre uker siden\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"3 m\u00c3\u00a5neder siden\"\n             , \"tre m\u00c3\u00a5neder siden\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"to \u00c3\u00a5r siden\"\n             , \"2 \u00c3\u00a5r siden\"\n             ]\n  , examples (datetime (1954, 0, 0, 0, 0, 0) Year)\n             [ \"1954\"\n             ]\n  , examples (datetime (2013, 12, 24, 0, 0, 0) Day)\n             [ \"et \u00c3\u00a5r etter julaften\"\n             , \"ett \u00c3\u00a5r etter julaften\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"denne sommeren\"\n             , \"den her sommeren\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"denne vinteren\"\n             , \"den her vinteren\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"1 juledag\"\n             , \"1. juledag\"\n             , \"f\u00c3\u00b8rste juledag\"\n             ]\n  , examples (datetime (2013, 12, 31, 0, 0, 0) Day)\n             [ \"nytt\u00c3\u00a5rsaften\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"nytt\u00c3\u00a5rsdag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"i kveld\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 8, 18, 0, 0), (2013, 2, 11, 0, 0, 0)) Hour)\n             [ \"forrige helg\"\n             , \"sist helg\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"i morgen kveld\"\n             , \"i morra kveld\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 14, 0, 0)) Hour)\n             [ \"i morgen middag\"\n             , \"i morra middag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"i g\u00c3\u00a5r kveld\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"denne helgen\"\n             , \"denne helga\"\n             , \"i helga\"\n             , \"i helgen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"mandag morgen\"\n             , \"mandag morran\"\n             ]\n  , examples (datetimeInterval ((2013, 12, 24, 0, 0, 0), (2013, 12, 31, 0, 0, 0)) Day)\n             [ \"i romjulen\"\n             , \"i romjula\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"siste 2 sekunder\"\n             , \"siste to sekunder\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"neste 3 sekunder\"\n             , \"neste tre sekunder\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"siste 2 minutter\"\n             , \"siste to minutter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"neste 3 minutter\"\n             , \"neste tre minutter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 3, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"siste 1 time\"\n             , \"seneste 1 time\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"neste 3 timer\"\n             , \"neste tre timer\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"siste 2 dager\"\n             , \"siste to dager\"\n             , \"seneste 2 dager\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"neste 3 dager\"\n             , \"neste tre dager\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"siste 2 uker\"\n             , \"siste to uker\"\n             , \"seneste to uker\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"neste 3 uker\"\n             , \"neste tre uker\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"siste 2 m\u00c3\u00a5neder\"\n             , \"siste to m\u00c3\u00a5neder\"\n             , \"seneste to m\u00c3\u00a5neder\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"neste 3 m\u00c3\u00a5neder\"\n             , \"neste tre m\u00c3\u00a5neder\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"siste 2 \u00c3\u00a5r\"\n             , \"siste to \u00c3\u00a5r\"\n             , \"seneste 2 \u00c3\u00a5r\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"neste 3 \u00c3\u00a5r\"\n             , \"neste tre \u00c3\u00a5r\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13-15 juli\"\n             , \"13-15 Juli\"\n             , \"13 til 15 Juli\"\n             , \"13 juli til 15 juli\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"8 Aug - 12 Aug\"\n             , \"8 Aug - 12 aug\"\n             , \"8 aug - 12 aug\"\n             , \"8 august - 12 august\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             , \"9:30 til 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"fra 9:30 - 11:00 p\u00c3\u00a5 torsdag\"\n             , \"fra 9:30 til 11:00 p\u00c3\u00a5 torsdag\"\n             , \"mellom 9:30 og 11:00 p\u00c3\u00a5 torsdag\"\n             , \"9:30 - 11:00 p\u00c3\u00a5 torsdag\"\n             , \"9:30 til 11:00 p\u00c3\u00a5 torsdag\"\n             , \"etter 9:30 men f\u00c3\u00b8r 11:00 p\u00c3\u00a5 torsdag\"\n             , \"torsdag fra 9:30 til 11:00\"\n             , \"torsdag mellom 9:30 og 11:00\"\n             , \"fra 9:30 til 11:00 p\u00c3\u00a5 torsdag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"torsdag fra 9 til 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-13:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"innenfor 2 uker\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"innen kl. 14\"\n             , \"innen klokken 14\"\n             , \"innen klokka 14\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"16h CET\"\n             , \"kl. 16 CET\"\n             , \"klokken 16 CET\"\n             , \"klokka 16 CET\"\n             ]\n  , examples (datetime (2013, 2, 14, 6, 0, 0) Minute)\n             [ \"torsdag kl. 8:00 GMT\"\n             , \"torsdag kl. 8:00 gmt\"\n             , \"torsdag klokken 8:00 GMT\"\n             , \"torsdag klokka 8:00 GMT\"\n             , \"torsdag klokken 8:00 gmt\"\n             , \"torsdag klokka 8:00 gmt\"\n             , \"torsdag 08:00 GMT\"\n             , \"torsdag 08:00 gmt\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"idag kl. 14\"\n             , \"idag klokken 14\"\n             , \"idag klokka 14\"\n             , \"kl. 14\"\n             , \"klokken 14\"\n             , \"klokka 14\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 kl. 16:00\"\n             , \"25/4 klokken 16:00\"\n             , \"25/4 klokka 16:00\"\n             , \"25-04 klokken 16:00\"\n             , \"25-04 klokka 16:00\"\n             , \"25-4 kl. 16:00\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Minute)\n             [ \"15:00 i morgen\"\n             , \"15:00 i morra\"\n             , \"kl. 15:00 i morgen\"\n             , \"kl. 15:00 i morra\"\n             , \"klokken 15:00 i morgen\"\n             , \"klokken 15:00 i morra\"\n             , \"klokka 15:00 i morgen\"\n             , \"klokka 15:00 i morra\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"etter kl. 14\"\n             , \"etter klokken 14\"\n             , \"etter klokka 14\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"etter 5 dager\"\n             , \"etter fem dager\"\n             ]\n  , examples (datetime (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"om 5 dager\"\n             , \"om fem dager\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 13, 14, 0, 0) Hour)\n             [ \"etter i morgen kl. 14\"\n             , \"etter i morra kl. 14\"\n             , \"etter i morgen klokken 14\"\n             , \"etter i morra klokken 14\"\n             , \"etter i morgen klokka 14\"\n             , \"etter i morra klokka 14\"\n             , \"i morgen etter kl. 14\"\n             , \"i morra etter kl. 14\"\n             , \"i morgen etter klokken 14\"\n             , \"i morra etter klokken 14\"\n             , \"i morgen etter klokka 14\"\n             , \"i morra etter klokka 14\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"f\u00c3\u00b8r kl. 11\"\n             , \"f\u00c3\u00b8r klokken 11\"\n             , \"f\u00c3\u00b8r klokka 11\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 13, 11, 0, 0) Hour)\n             [ \"i morgen f\u00c3\u00b8r kl. 11\"\n             , \"i morra f\u00c3\u00b8r kl. 11\"\n             , \"i morgen f\u00c3\u00b8r klokken 11\"\n             , \"i morra f\u00c3\u00b8r klokken 11\"\n             , \"i morgen f\u00c3\u00b8r klokka 11\"\n             , \"i morra f\u00c3\u00b8r klokka 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"om ettermiddagen\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 30, 0) Minute)\n             [ \"kl. 13:30\"\n             , \"klokken 13:30\"\n             , \"klokka 13:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"om 15 minutter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"etter frokost\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"denne morgen\"\n             , \"denne morran\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"neste mandag\"\n             ]\n  , examples (datetime (2014, 2, 9, 0, 0, 0) Day)\n             [ \"morsdag\"\n             ]\n  , examples (datetime (2013, 11, 10, 0, 0, 0) Day)\n             [ \"farsdag\"\n             ]\n  ]\n", "num_lines": 712}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.NB.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Types (OrdinalData(..))\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Types\nimport qualified Data.Text as Text\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleTheDayAfterTomorrow :: Rule\nruleTheDayAfterTomorrow = Rule\n  { name = \"the day after tomorrow\"\n  , pattern =\n    [ regex \"i overimorgen|i overimorra\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleRelativeMinutesTotillbeforeIntegerHourofday :: Rule\nruleRelativeMinutesTotillbeforeIntegerHourofday = Rule\n  { name = \"relative minutes to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"p\u00c3\u00a5\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleRelativeMinutesAfterpastIntegerHourofday :: Rule\nruleRelativeMinutesAfterpastIntegerHourofday = Rule\n  { name = \"relative minutes after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"over\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       _:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute True hours n\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute True hours n\n      _ -> Nothing\n  }\n\nruleQuarterTotillbeforeIntegerHourofday :: Rule\nruleQuarterTotillbeforeIntegerHourofday = Rule\n  { name = \"quarter to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"(et)? ?(kvart)(er)? *p\u00c3\u00a5\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleQuarterAfterpastIntegerHourofday :: Rule\nruleQuarterAfterpastIntegerHourofday = Rule\n  { name = \"quarter after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"(et)? ?(kvart)(er)? *over\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayQuarter :: Rule\nruleHourofdayQuarter = Rule\n  { name = \"<hour-of-day> quarter (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"(et)? ?(kvart)(er)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:_) ->\n        tt $ hourMinute True hours 15\n      _ -> Nothing\n  }\n\nruleHalfTotillbeforeIntegerHourofday :: Rule\nruleHalfTotillbeforeIntegerHourofday = Rule\n  { name = \"half to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halv time *p\u00c3\u00a5|halvtime *p\u00c3\u00a5|halv\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleHalfAfterpastIntegerHourofday :: Rule\nruleHalfAfterpastIntegerHourofday = Rule\n  { name = \"half after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halv time *over\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 30\n      _ -> Nothing\n  }\n\nruleHourofdayHalf :: Rule\nruleHourofdayHalf = Rule\n  { name = \"<hour-of-day> half (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"halv time\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:_) ->\n        tt $ hourMinute True hours 30\n      _ -> Nothing\n  }\n\nruleConstitutionDay :: Rule\nruleConstitutionDay = Rule\n  { name = \"constitution day\"\n  , pattern =\n    [ regex \"grunnlovsdag(en)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 5 17\n  }\n\nruleValentinesDay :: Rule\nruleValentinesDay = Rule\n  { name = \"valentine's day\"\n  , pattern =\n    [ regex \"valentine'?s?( dag)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 2 14\n  }\n\nruleTheOrdinalCycleOfTime :: Rule\nruleTheOrdinalCycleOfTime = Rule\n  { name = \"the <ordinal> <cycle> of <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"av|i|fra\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime2 :: Rule\nruleNthTimeOfTime2 = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"af|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n        predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleNewYearsDay :: Rule\nruleNewYearsDay = Rule\n  { name = \"new year's day\"\n  , pattern =\n    [ regex \"nytt\u00c3\u00a5rsdag\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 1\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"(siste?|forrige|seneste)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|til|tilogmed\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEvening :: Rule\nruleEvening = Rule\n  { name = \"evening\"\n  , pattern =\n    [ regex \"kveld(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTheDayofmonthNonOrdinal :: Rule\nruleTheDayofmonthNonOrdinal = Rule\n  { name = \"the <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"den\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleCycleAfterTime :: Rule\nruleCycleAfterTime = Rule\n  { name = \"<cycle> after <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in <duration>\"\n  , pattern =\n    [ regex \"om\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleNow :: Rule\nruleNow = Rule\n  { name = \"now\"\n  , pattern =\n    [ regex \"akkurat n\u00c3\u00a5|n\u00c3\u00a5|(i )?dette \u00c3\u00b8yeblikk\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"siste\"\n    , dimension TimeGrain\n    , regex \"av|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleFromDatetimeDatetimeInterval :: Rule\nruleFromDatetimeDatetimeInterval = Rule\n  { name = \"from <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"fra\"\n    , dimension Time\n    , regex \"\\\\-|til|tilogmed\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleMonthDdddInterval :: Rule\nruleMonthDdddInterval = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ regex \"([012]?\\\\d|30|31)(ter|\\\\.)?\"\n    , regex \"\\\\-|til\"\n    , regex \"([012]?\\\\d|30|31)(ter|\\\\.)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (d1:_)):\n       _:\n       Token RegexMatch (GroupMatch (d2:_)):\n       Token Time td:\n       _) -> do\n        dd1 <- parseInt d1\n        dd2 <- parseInt d2\n        dom1 <- intersect (dayOfMonth dd1) td\n        dom2 <- intersect (dayOfMonth dd2) td\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleTheCycleAfterTime :: Rule\nruleTheCycleAfterTime = Rule\n  { name = \"the <cycle> after <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|tet|et)? etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleTheCycleBeforeTime :: Rule\nruleTheCycleBeforeTime = Rule\n  { name = \"the <cycle> before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|tet|et)? f\u00c3\u00b8r\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleTimeAfterNext :: Rule\nruleTimeAfterNext = Rule\n  { name = \"<time> after next\"\n  , pattern =\n    [ regex \"neste\"\n    , dimension Time\n    , regex \"igjen\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleTheIdesOfNamedmonth :: Rule\nruleTheIdesOfNamedmonth = Rule\n  { name = \"the ides of <named-month>\"\n  , pattern =\n    [ regex \"midten af\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td@TimeData {TTime.form = Just (TTime.Month m)}:_) ->\n        Token Time <$>\n          intersect (dayOfMonth $ if elem m [3, 5, 7, 10] then 15 else 13) td\n      _ -> Nothing\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"middag|(kl(\\\\.|okken)?)? tolv\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleToday :: Rule\nruleToday = Rule\n  { name = \"today\"\n  , pattern =\n    [ regex \"i dag|idag\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"(kommende|neste)\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleTheDayBeforeYesterday :: Rule\nruleTheDayBeforeYesterday = Rule\n  { name = \"the day before yesterday\"\n  , pattern =\n    [ regex \"i forig\u00c3\u00a5rs\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 2\n  }\n\nruleBetweenTimeofdayAndTimeofdayInterval :: Rule\nruleBetweenTimeofdayAndTimeofdayInterval = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"mellom\"\n    , Predicate isATimeOfDay\n    , regex \"og\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNextCycle :: Rule\nruleNextCycle = Rule\n  { name = \"next <cycle>\"\n  , pattern =\n    [ regex \"neste|kommende\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Mandag\"  , \"mandag|man\\\\.?\"    )\n  , ( \"Tirsdag\" , \"tirsdag|tirs?\\\\.?\" )\n  , ( \"Onsdag\"  , \"onsdag|ons\\\\.?\"    )\n  , ( \"Torsdag\" , \"torsdag|tors?\\\\.?\" )\n  , ( \"Fredag\"  , \"fredag|fre\\\\.?\"    )\n  , ( \"L\u00c3\u00b8rdag\"  , \"l\u00c3\u00b8rdag|l\u00c3\u00b8r\\\\.?\"    )\n  , ( \"S\u00c3\u00b8ndag\"  , \"s\u00c3\u00b8ndag|s\u00c3\u00b8n\\\\.?\"    )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"Januar\"   , \"januar|jan\\\\.?\"      )\n  , ( \"Februar\"  , \"februar|feb\\\\.?\"     )\n  , ( \"Mars\"     , \"mars|mar\\\\.?\"        )\n  , ( \"April\"    , \"april|apr\\\\.?\"       )\n  , ( \"Mai\"      , \"mai\"                 )\n  , ( \"Juni\"     , \"juni|jun\\\\.?\"        )\n  , ( \"Juli\"     , \"juli|jul\\\\.?\"        )\n  , ( \"August\"   , \"august|aug\\\\.?\"      )\n  , ( \"September\", \"september|sept?\\\\.?\" )\n  , ( \"Oktober\"  , \"oktober|okt\\\\.?\"     )\n  , ( \"November\" , \"november|nov\\\\.?\"    )\n  , ( \"Desember\" , \"desember|des\\\\.?\"    )\n  ]\n\nruleTheCycleOfTime :: Rule\nruleTheCycleOfTime = Rule\n  { name = \"the <cycle> of <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|tet|et)? av\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleTimeofdayApproximately :: Rule\nruleTimeofdayApproximately = Rule\n  { name = \"<time-of-day> approximately\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(cirka|ca\\\\.|-?ish)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleOnDate :: Rule\nruleOnDate = Rule\n  { name = \"on <date>\"\n  , pattern =\n    [ regex \"den|p\u00c3\u00a5\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDurationFromNow :: Rule\nruleDurationFromNow = Rule\n  { name = \"<duration> from now\"\n  , pattern =\n    [ dimension Duration\n    , regex \"fra (i dag|idag|n\u00c3\u00a5)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLunch :: Rule\nruleLunch = Rule\n  { name = \"lunch\"\n  , pattern =\n    [ regex \"(til )?middag\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 14\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleLastCycle :: Rule\nruleLastCycle = Rule\n  { name = \"last <cycle>\"\n  , pattern =\n    [ regex \"siste?|seneste|forrige\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\/-](0?[1-9]\\\\b|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"ettermiddag(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 19\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTimeBeforeLast :: Rule\nruleTimeBeforeLast = Rule\n  { name = \"<time> before last\"\n  , pattern =\n    [ regex \"siste\"\n    , dimension Time\n    , regex \"igjen\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-2) False td\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthOrdinal :: Rule\nruleNamedmonthDayofmonthOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleChristmasEve :: Rule\nruleChristmasEve = Rule\n  { name = \"christmas eve\"\n  , pattern =\n    [ regex \"julaften?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 24\n  }\n\nruleInduringThePartofday :: Rule\nruleInduringThePartofday = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"om|i\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonth :: Rule\nruleDayofmonthordinalNamedmonth = Rule\n  { name = \"<day-of-month>(ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by \\\",\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) ->\n        tt $ predNthAfter (TOrdinal.value od - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleAfterDuration :: Rule\nruleAfterDuration = Rule\n  { name = \"after <duration>\"\n  , pattern =\n    [ regex \"etter\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt . withDirection TTime.After $ inDuration dd\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ hour False v\n      _ -> Nothing\n  }\n\nruleDayofmonthOrdinalOfNamedmonth :: Rule\nruleDayofmonthOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , regex \"av|i\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleFromTimeofdayTimeofdayInterval :: Rule\nruleFromTimeofdayTimeofdayInterval = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(etter|fra)\"\n    , Predicate isATimeOfDay\n    , regex \"((men )?f\u00c3\u00b8r)|\\\\-|tilogmed|til\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleExactlyTimeofday :: Rule\nruleExactlyTimeofday = Rule\n  { name = \"exactly <time-of-day>\"\n  , pattern =\n    [ regex \"presis( kl.| klokken | klokka)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleInduringThePartofday2 :: Rule\nruleInduringThePartofday2 = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"om|i\"\n    , Predicate isAPartOfDay\n    , regex \"en|ten\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleSeason :: Rule\nruleSeason = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"sommer(en)\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 6 21\n          to = monthDay 9 23\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleBetweenDatetimeAndDatetimeInterval :: Rule\nruleBetweenDatetimeAndDatetimeInterval = Rule\n  { name = \"between <datetime> and <datetime> (interval)\"\n  , pattern =\n    [ regex \"mellom\"\n    , dimension Time\n    , regex \"og\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNewYearsEve :: Rule\nruleNewYearsEve = Rule\n  { name = \"new year's eve\"\n  , pattern =\n    [ regex \"nytt\u00c3\u00a5rsaften?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 31\n  }\n\nruleDurationAgo :: Rule\nruleDurationAgo = Rule\n  { name = \"<duration> ago\"\n  , pattern =\n    [ dimension Duration\n    , regex \"siden\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleByTheEndOfTime :: Rule\nruleByTheEndOfTime = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"i slutten av\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed now td\n      _ -> Nothing\n  }\n\nruleAfterWork :: Rule\nruleAfterWork = Rule\n  { name = \"after work\"\n  , pattern =\n    [ regex \"etter jobb\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 17) (hour False 21)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleLastNCycle :: Rule\nruleLastNCycle = Rule\n  { name = \"last n <cycle>\"\n  , pattern =\n    [ regex \"siste?|seneste|forrige\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleChristmasDays :: Rule\nruleChristmasDays = Rule\n  { name = \"christmas days\"\n  , pattern =\n    [ regex \"romjul(a|en)\"\n    ]\n  , prod = \\_ ->\n      Token Time <$> interval TTime.Open (monthDay 12 24) (monthDay 12 30)\n  }\n\nruleTimeofdaySharp :: Rule\nruleTimeofdaySharp = Rule\n  { name = \"<time-of-day> sharp\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(sharp|presis)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleWithinDuration :: Rule\nruleWithinDuration = Rule\n  { name = \"within <duration>\"\n  , pattern =\n    [ regex \"innenfor\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        Token Time <$> interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleMidnighteodendOfDay :: Rule\nruleMidnighteodendOfDay = Rule\n  { name = \"midnight|EOD|end of day\"\n  , pattern =\n    [ regex \"midnatt|EOD\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleDayofmonthNonOrdinalNamedmonth :: Rule\nruleDayofmonthNonOrdinalNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAboutTimeofday :: Rule\nruleAboutTimeofday = Rule\n  { name = \"about <time-of-day>\"\n  , pattern =\n    [ regex \"(omkring|cirka|ca\\\\.)( kl\\\\.| klokken | klokka)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleUntilTimeofday :: Rule\nruleUntilTimeofday = Rule\n  { name = \"until <time-of-day>\"\n  , pattern =\n    [ regex \"(engang )?innen|f\u00c3\u00b8r|opptil\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleAtTimeofday :: Rule\nruleAtTimeofday = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"klokken|klokka|kl.|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"av|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n        predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimePartofday :: Rule\nruleTimePartofday = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"((week(\\\\s|-)?end)|helg)(en|a)?\"\n    ]\n  , prod = \\_ -> tt weekend\n  }\n\nruleEomendOfMonth :: Rule\nruleEomendOfMonth = Rule\n  { name = \"EOM|End of month\"\n  , pattern =\n    [ regex \"EOM\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Month 1\n  }\n\nruleLastYear :: Rule\nruleLastYear = Rule\n  { name = \"Last year\"\n  , pattern =\n    [ regex \"i fjor\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Year $ - 1\n  }\n\nruleNthTimeAfterTime2 :: Rule\nruleNthTimeAfterTime2 = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token Time td1:_:Token Time td2:_) ->\n        tt $ predNthAfter (TOrdinal.value od - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"neste|kommende\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarterYear :: Rule\nruleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:_:Token Time td:_) ->\n        tt $ cycleNthAfter False TG.Quarter (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{4})[\\\\-\\\\.\\\\/](0?[1-9]|1[0-2])[\\\\-\\\\.\\\\/](3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (yy:mm:dd:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleAfterTime :: Rule\nruleTheOrdinalCycleAfterTime = Rule\n  { name = \"the <ordinal> <cycle> after <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleIntersectByOfFromS :: Rule\nruleIntersectByOfFromS = Rule\n  { name = \"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"i\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNextNCycle :: Rule\nruleNextNCycle = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"neste\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleADuration :: Rule\nruleADuration = Rule\n  { name = \"a <duration>\"\n  , pattern =\n    [ regex \"(om )?en|ett|\u00c3\u00a9n|et\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"morgen(en)?|morran\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 4\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"i|denne\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisCycle :: Rule\nruleThisCycle = Rule\n  { name = \"this <cycle>\"\n  , pattern =\n    [ regex \"denne|dette|i|n\u00c3\u00a5v\u00c3\u00a6rende\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"(denne|dette|i|den her)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalOfNamedmonth :: Rule\nruleDayofmonthNonOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"av|i\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAfterLunch :: Rule\nruleAfterLunch = Rule\n  { name = \"after lunch\"\n  , pattern =\n    [ regex \"etter (frokost|middag|lunsj|lunch)\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 13) (hour False 17)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleOnANamedday :: Rule\nruleOnANamedday = Rule\n  { name = \"on a named-day\"\n  , pattern =\n    [ regex \"p\u00c3\u00a5 en\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 25 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleYesterday :: Rule\nruleYesterday = Rule\n  { name = \"yesterday\"\n  , pattern =\n    [ regex \"i g\u00c3\u00a5r|ig\u00c3\u00a5r\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleSeason2 :: Rule\nruleSeason2 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"vinter(en)\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 12 21\n          to = monthDay 3 20\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleAfterTimeofday :: Rule\nruleAfterTimeofday = Rule\n  { name = \"after <time-of-day>\"\n  , pattern =\n    [ regex \"(engang )?etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleChristmas :: Rule\nruleChristmas = Rule\n  { name = \"christmas\"\n  , pattern =\n    [ regex \"((1\\\\.?)|f\u00c3\u00b8rste)? ?juledag\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleNight :: Rule\nruleNight = Rule\n  { name = \"night\"\n  , pattern =\n    [ regex \"natt(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 0\n          to = hour False 4\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDayofmonthOrdinal :: Rule\nruleDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleOrdinalCycleAfterTime :: Rule\nruleOrdinalCycleAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleOfTime :: Rule\nruleOrdinalCycleOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"av|i|fra\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleHhmm :: Rule\nruleHhmm = Rule\n  { name = \"hh:mm\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ hourMinute False h m\n      _ -> Nothing\n  }\n\nrule2400 :: Rule\nrule2400 = Rule\n  { name = \"24:00\"\n  , pattern =\n    [ regex \"24[.:]00\"\n    ]\n  , prod = \\_ -> tt $ hourMinute False 24 00\n  }\n\nruleDmm :: Rule\nruleDmm = Rule\n  { name = \"d/mm\"\n  , pattern =\n    [ regex \"([1-9])[\\\\/\\\\.\\\\-]([1-9]\\\\b|1[0-2]\\\\b)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDDm :: Rule\nruleDDm = Rule\n  { name = \"dd/m\"\n  , pattern =\n    [ regex \"([0-2]\\\\d|3[01])[\\\\/\\\\.\\\\-]([1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleDdDotMm :: Rule\nruleDdDotMm = Rule\n  { name = \"dd.mm\"\n  , pattern =\n    [ regex \"(2[5-9]|3[01])\\\\.(0[1-9]|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        d <- parseInt dd\n        m <- parseInt mm\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleTonight :: Rule\nruleTonight = Rule\n  { name = \"tonight\"\n  , pattern =\n    [ regex \"i kveld\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 18) (hour False 0)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ year n\n      _ -> Nothing\n  }\n\nruleHalloweenDay :: Rule\nruleHalloweenDay = Rule\n  { name = \"halloween day\"\n  , pattern =\n    [ regex \"hall?owe?en\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 31\n  }\n\nruleNamedmonthDayofmonthNonOrdinal :: Rule\nruleNamedmonthDayofmonthNonOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"siste\"\n    , Predicate isADayOfWeek\n    , regex \"av|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleFathersDay :: Rule\nruleFathersDay = Rule\n  { name = \"Father's Day\"\n  , pattern =\n    [ regex \"farsdag\"\n    ]\n  , prod = \\_ -> tt $ nthDOWOfMonth 2 7 11\n  }\n\nruleCycleBeforeTime :: Rule\nruleCycleBeforeTime = Rule\n  { name = \"<cycle> before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"f\u00c3\u00b8r\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\/\\\\-\\\\.](0?[1-9]|1[0-2])[\\\\/\\\\-\\\\.](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval :: Rule\nruleTimeofdayTimeofdayInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\-|tilogmed|til\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAfterTime :: Rule\nruleDurationAfterTime = Rule\n  { name = \"<duration> after <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"etter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarter :: Rule\nruleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleTheDayofmonthOrdinal :: Rule\nruleTheDayofmonthOrdinal = Rule\n  { name = \"the <day-of-month> (ordinal)\"\n  , pattern =\n    [ regex \"den\"\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleDurationBeforeTime :: Rule\nruleDurationBeforeTime = Rule\n  { name = \"<duration> before <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"f\u00c3\u00b8r\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nrulePartofdayOfTime :: Rule\nrulePartofdayOfTime = Rule\n  { name = \"<part-of-day> of <time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"(en |ten )?den\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleEoyendOfYear :: Rule\nruleEoyendOfYear = Rule\n  { name = \"EOY|End of year\"\n  , pattern =\n    [ regex \"EOY\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Year 1\n  }\n\nruleTomorrow :: Rule\nruleTomorrow = Rule\n  { name = \"tomorrow\"\n  , pattern =\n    [ regex \"i morgen|imorgen|i morra|imorra\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleMothersDay :: Rule\nruleMothersDay = Rule\n  { name = \"Mother's Day\"\n  , pattern =\n    [ regex \"morsdag\"\n    ]\n  , prod = \\_ -> tt $ nthDOWOfMonth 2 7 2\n  }\n\nruleTimeofdayOclock :: Rule\nruleTimeofdayOclock = Rule\n  { name = \"<time-of-day> o'clock\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"h\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonthYear :: Rule\nruleDayofmonthordinalNamedmonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       Token Time td:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         y <- parseInt match\n         dom <- intersectDOM td token\n         Token Time <$> intersect dom (year y)\n      _ -> Nothing\n  }\n\nruleHhmmss :: Rule\nruleHhmmss = Rule\n  { name = \"hh:mm:ss\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:ss:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        s <- parseInt ss\n        tt $ hourMinuteSecond False h m s\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleADuration\n  , ruleAboutTimeofday\n  , ruleAbsorptionOfAfterNamedDay\n  , ruleAfterDuration\n  , ruleAfterLunch\n  , ruleAfterTimeofday\n  , ruleAfterWork\n  , ruleAfternoon\n  , ruleAtTimeofday\n  , ruleBetweenDatetimeAndDatetimeInterval\n  , ruleBetweenTimeofdayAndTimeofdayInterval\n  , ruleByTheEndOfTime\n  , ruleChristmas\n  , ruleChristmasEve\n  , ruleChristmasDays\n  , ruleConstitutionDay\n  , ruleCycleAfterTime\n  , ruleCycleBeforeTime\n  , ruleDatetimeDatetimeInterval\n  , ruleDayofmonthNonOrdinalNamedmonth\n  , ruleDayofmonthNonOrdinalOfNamedmonth\n  , ruleDayofmonthOrdinal\n  , ruleDayofmonthOrdinalOfNamedmonth\n  , ruleDayofmonthordinalNamedmonth\n  , ruleDayofmonthordinalNamedmonthYear\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleDurationAfterTime\n  , ruleDurationAgo\n  , ruleDurationBeforeTime\n  , ruleDurationFromNow\n  , ruleEomendOfMonth\n  , ruleEoyendOfYear\n  , ruleEvening\n  , ruleExactlyTimeofday\n  , ruleFathersDay\n  , ruleFromDatetimeDatetimeInterval\n  , ruleFromTimeofdayTimeofdayInterval\n  , ruleHalloweenDay\n  , ruleHhmm\n  , ruleHhmmss\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleHourofdayQuarter\n  , ruleHourofdayHalf\n  , ruleInDuration\n  , ruleInduringThePartofday\n  , ruleInduringThePartofday2\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleIntersectByOfFromS\n  , ruleLastCycle\n  , ruleLastCycleOfTime\n  , ruleLastDayofweekOfTime\n  , ruleLastNCycle\n  , ruleLastTime\n  , ruleLastYear\n  , ruleLunch\n  , ruleMidnighteodendOfDay\n  , ruleMonthDdddInterval\n  , ruleMorning\n  , ruleMothersDay\n  , ruleNamedmonthDayofmonthNonOrdinal\n  , ruleNamedmonthDayofmonthOrdinal\n  , ruleNewYearsDay\n  , ruleNewYearsEve\n  , ruleNextCycle\n  , ruleNextNCycle\n  , ruleNextTime\n  , ruleNight\n  , ruleNoon\n  , ruleNow\n  , ruleNthTimeAfterTime\n  , ruleNthTimeAfterTime2\n  , ruleNthTimeOfTime\n  , ruleNthTimeOfTime2\n  , ruleOnANamedday\n  , ruleOnDate\n  , ruleOrdinalCycleAfterTime\n  , ruleOrdinalCycleOfTime\n  , ruleOrdinalQuarter\n  , ruleOrdinalQuarterYear\n  , rulePartofdayOfTime\n  , ruleRelativeMinutesAfterpastIntegerHourofday\n  , ruleRelativeMinutesTotillbeforeIntegerHourofday\n  , ruleHalfAfterpastIntegerHourofday\n  , ruleHalfTotillbeforeIntegerHourofday\n  , ruleQuarterAfterpastIntegerHourofday\n  , ruleQuarterTotillbeforeIntegerHourofday\n  , ruleSeason\n  , ruleSeason2\n  , ruleTheCycleAfterTime\n  , ruleTheCycleBeforeTime\n  , ruleTheCycleOfTime\n  , ruleTheDayAfterTomorrow\n  , ruleTheDayBeforeYesterday\n  , ruleTheDayofmonthNonOrdinal\n  , ruleTheDayofmonthOrdinal\n  , ruleTheIdesOfNamedmonth\n  , ruleTheOrdinalCycleAfterTime\n  , ruleTheOrdinalCycleOfTime\n  , ruleThisCycle\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleThisnextDayofweek\n  , ruleTimeAfterNext\n  , ruleTimeBeforeLast\n  , ruleTimePartofday\n  , ruleTimeofdayApproximately\n  , ruleTimeofdayLatent\n  , ruleTimeofdayOclock\n  , ruleTimeofdaySharp\n  , ruleTimeofdayTimeofdayInterval\n  , ruleToday\n  , ruleTomorrow\n  , ruleTonight\n  , ruleUntilTimeofday\n  , ruleValentinesDay\n  , ruleWeekend\n  , ruleWithinDuration\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYesterday\n  , ruleYyyymmdd\n  , ruleTimezone\n  , rule2400\n  , ruleDmm\n  , ruleDDm\n  , ruleDdDotMm\n  ]\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n", "num_lines": 1851}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.NL.Corpus\n  ( corpus\n  , defaultCorpus\n  , latentCorpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\ncontext :: Context\ncontext = testContext {locale = makeLocale NL Nothing}\n\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\ndefaultCorpus :: Corpus\ndefaultCorpus = (context, testOptions, allExamples ++ custom)\n  where\n    custom = concat\n      [ examples (datetimeHoliday (2013, 12, 5, 0, 0, 0) Day \"Sinterklaas\")\n                 [ \"Sinterklaas\"\n                 , \"Pakjesavond\"\n                 , \"Sinterklaasavond\"\n                 ]\n      ]\n\nlatentCorpus :: Corpus\nlatentCorpus = (context, testOptions {withLatent = True}, xs)\n  where\n    xs = concat\n      [ examples (datetimeOpenInterval Before (2013, 2, 12, 8, 0, 0) Hour)\n                 [ \"voor 8\"\n                 ]\n      ]\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (context, testOptions, examples)\n  where\n    examples =\n      [ \"een hotel\"\n      , \"twee aanbiedingen\"\n      , \"komende 5 agendapunten\"\n      , \"d\"\n      , \"do\"\n      , \"di\"\n      , \"woe\"\n      , \"vr\"\n      , \"zat\"\n      , \"zo\"\n      , \"zon\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"nu\"\n             , \"direct\"\n             , \"zojuist\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"vandaag\"\n             , \"op deze dag\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"gisteren\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"morgen\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"maandag\"\n             , \"ma.\"\n             , \"volgende week maandag\"\n             , \"komende maandag\"\n             , \"aanstaande maandag\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Maandag, 18 Feb\"\n             , \"maandag, 18 februari\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"dinsdag\"\n             , \"di.\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"donderdag\"\n             , \"do.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"vrijdag\"\n             , \"vr.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"zaterdag\"\n             , \"za.\"\n             , \"zat.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"zondag\"\n             , \"zo.\"\n             , \"zon.\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"1 maart\"\n             , \"op de eerste\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"3 maart\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"3 maart 2015\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"op de 15de\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15 februari\"\n             , \"februari 15\"\n             , \"op de 15de februari\"\n             , \"15-2\"\n             , \"op 15-2\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"Aug 8\"\n             , \"8 augustus\"\n             ]\n  , examples (datetime (2014, 10, 0, 0, 0, 0) Month)\n             [ \"Oktober 2014\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31.10.1974\"\n             , \"31.10.74\"\n             , \"31-10-1974\"\n             , \"31-10-74\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14 april 2015\"\n             , \"April 14, 2015\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"volgende week dinsdag\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"volgende week vrijdag\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"maart\"\n             ]\n  , examples (datetime (2014, 3, 0, 0, 0, 0) Month)\n             [ \"volgend jaar maart\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"zondag, feb 10\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"woensdag, 13 februari\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Maandag feb 18\"\n             , \"Maandag 18 februari\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"Deze week\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"vorige week\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"volgende week\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"vorige maand\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"volgende maand\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"dit kwartaal\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"volgende kwartaal\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"derde kwartaal\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"4de kwartaal 2018\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"vorig jaar\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"dit jaar\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"volgend jaar\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"afgelopen zondag\"\n             , \"vorige week zondag\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"vorige dinsdag\"\n             , \"afgelopen dinsdag\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"dinsdag over een week\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"komende woensdag\"\n             , \"woensdag\"\n             , \"woe.\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"volgende week woensdag\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"deze week maandag\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"dinsdag deze week\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"deze week woensdag\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"overmorgen\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"eergisteren\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"laatste maandag in maart\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"laatste zondag van maart 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"derde dag in oktober\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"eerste week in oktober 2014\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"laatste dag van oktober 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"laatste week van september 2014\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"eerste dinsdag in oktober\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"derde dinsdag in september 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"eerste woensdag in oktober 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"tweede woensdag in oktober 2014\"\n             ]\n  , examples (datetime (2015, 1, 13, 0, 0, 0) Day)\n             [ \"derde dinsdag na kerst 2014\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 0, 0) Hour)\n             [ \"4 uur in de morgen\"\n             , \"4 uur in de nacht\"\n             , \"4 uur in de ochtend\"\n             , \"4 uur 's ochtends\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"3 uur\"\n             , \"om drie uur\"\n             ]\n  , examples (datetime (2013, 2, 12, 3, 18, 0) Minute)\n             [ \"3:18 in de ochtend\"\n             , \"3:18 's morgens\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"drie uur 's middags\"\n             , \"15 uur\"\n             , \"om drie uur\"\n             , \"rond drie uur\"\n             , \"rond 3 uur 's middags\"\n             , \"om ongeveer drie uur\"\n             , \"ca. 15h\"\n             , \"om circa 15u\"\n             ]\n  , examples (datetime (2013, 4, 1, 18, 0, 0) Hour)\n             [ \"op 01-04 tegen 18 uur\"\n             , \"op 1 april tegen zes uur 's avonds\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"stipt om 17 uur morgen\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 15, 0) Minute)\n             [ \"rond kwart over 2\"\n             , \"kwart over twee uur\"\n             , \"14 uur 15\"\n             , \"15 over 14\"\n             , \"2 uur 15 's middags\"\n             , \"14:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"15:20\"\n             , \"10 voor half 4\"\n             , \"10 minuten voor half 4\"\n             , \"3 uur 20 's middags\"\n             , \"twintig over 3\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"om half vier\"\n             , \"15:30\"\n             , \"half vier 's middags\"\n             , \"half 4\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 30, 0) Minute)\n             [ \"3:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"kwart voor 12\"\n             , \"11:45\"\n             , \"15 minuten voor 12\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"8 uur 's avonds\"\n             , \"vanavond om 8 uur\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Minute)\n             [ \"vandaag om 20:00\"\n             ]\n  , examples (datetime (2013, 9, 20, 19, 30, 0) Minute)\n             [ \"om 19:30 op vr. 20 sept.\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"op zaterdag om 9 uur 's morgens\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Hour)\n             [ \"Vrij. 18 juli 2014 7 uur 's avonds\"\n             ]\n  , examples (datetime (2014, 7, 18, 0, 0, 0) Day)\n             [ \"Vr., 18 Juli 2014\"\n             , \"Vrijdag, 18-07-14\"\n             , \"Vrijdag, 18/07/2014\"\n             , \"18de juli 2014\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"over een seconde\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"in een minuut\"\n             , \"over een minuut\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"in 2 minuten\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"in 60 minuten\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"in 30 minuten\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 0, 0) Second)\n             [ \"in 2,5 uur\"\n             , \"in twee en een half uur\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"over een uur\"\n             , \"in een uur\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 30, 0) Minute)\n             [ \"over twee uur\"\n             , \"in een paar uur\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"over 24 uur\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"morgen\"\n             ]\n  , examples (datetime (2016, 2, 0, 0, 0, 0) Month)\n             [ \"in 3 jaar\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"in 7 dagen\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"in 1 week\"\n             , \"over een week\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 dagen geleden\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"14 dagen geleden\"\n             ]\n  , examples (datetime (2013, 1, 29, 0, 0, 0) Day)\n             [ \"twee weken geleden\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"een week geleden\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"drie weken geleden\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"drie maanden geleden\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"twee jaar geleden\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"over 7 dagen\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"een jaar na kerst\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"deze zomer\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"deze winter\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 25, 0, 0, 0) Day \"Kerstmis\")\n             [ \"kerst\"\n             , \"kerstmis\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 31, 0, 0, 0) Day \"Oudjaar\")\n             [ \"oudjaar\"\n             , \"oudejaarsavond\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 1, 0, 0, 0) Day \"Nieuwjaarsdag\")\n             [ \"nieuwjaarsdag\"\n             , \"nieuwjaar\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 14, 0, 0, 0) Day \"Valentijnsdag\")\n             [ \"Valentijnsdag\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 12, 0, 0, 0) Day \"Moederdag\")\n             [ \"moederdag\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 16, 0, 0, 0) Day \"Vaderdag\")\n             [ \"vaderdag\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 31, 0, 0, 0) Day \"Halloween\")\n             [ \"Halloween\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 1, 0, 0, 0) Day \"Allerheiligen\")\n             [ \"Allerheiligen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"vanavond\"\n             , \"deze avond\"\n             , \"vandaag avond\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"morgenavond\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"gisteravond\"\n             , \"gisterenavond\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 0, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n             [ \"vanmorgen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 13, 12, 0, 0)) Hour)\n             [ \"morgenochtend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 0, 0, 0), (2013, 2, 11, 12, 0, 0)) Hour)\n             [ \"gisterenochtend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"morgennacht\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"gisterennacht\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 18, 0, 0)) Hour)\n             [ \"vanmiddag\"\n             , \"deze namiddag\"\n             , \"vandaag namiddag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 18, 0, 0)) Hour)\n             [ \"morgenmiddag\"\n             , \"morgen 's middags\"\n             , \"morgen namiddag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 12, 0, 0), (2013, 2, 11, 18, 0, 0)) Hour)\n             [ \"gisterenmiddag\"\n             , \"gistermiddag\"\n             , \"gisterennamiddag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"dit weekend\"\n             , \"komend weekend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 0, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"15 februari 's morgens\"\n             , \"15 februari in de morgen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"afgelopen 2 seconden\"\n             , \"vorige 2 secondes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"komende drie secondes\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"afgelopen 2 minuten\"\n             , \"afgelopen twee minuten\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"komende 3 minuten\"\n             , \"volgende drie minuten\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"komende 3 uur\"\n             , \"volgende 3 uur\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"afgelopen 2 dagen\"\n             , \"vorige 2 dagen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"komende 3 dagen\"\n             , \"komende drie dagen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 15, 0, 0, 0)) Day)\n             [ \"komende paar dagen\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"vorige 2 weken\"\n             , \"afgelopen twee weken\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"komende 3 weken\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"vorige 2 maanden\"\n             , \"afgelopen twee maanden\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"komende 3 maanden\"\n             , \"volgende drie maanden\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"vorige 2 jaren\"\n             , \"afgelopen twee jaar\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"komende 3 jaren\"\n             , \"volgende drie jaar\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13 - 15 juli\"\n             , \"13 t/m 15 juli\"\n             , \"13 - 15 juli\"\n             , \"juli 13 - juli 15\"\n             , \"13 tot en met 15 juli\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"aug 8 - aug 12\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"op donderdag om 9:30 - 11:00\"\n             , \"op donderdag tussen 9:30 en 11:00\"\n             , \"donderdag 9:30 - 11:00\"\n             , \"op donderdag na 9:30 maar voor 11:00\"\n             , \"donderdag van 9:30 tot 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"donderdag ochtend van 9 tot 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-13:30\"\n             ]\n  , examples (datetime (2013, 9, 21, 1, 30, 0) Minute)\n             [ \"1:30 am Za. 21 sept\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"binnen 2 weken\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"tot 2 uur 's middags\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 3, 1, 0, 0, 0) Month)\n             [ \"tot het einde van de maand\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"16 uur CET\"\n             ]\n  , examples (datetime (2013, 2, 14, 6, 0, 0) Minute)\n             [ \"donderdag 8:00 GMT\"\n             , \"donderdag 8:00 gmt\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"vandaag om 14 uur\"\n             , \"om 2 uur\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Hour)\n             [ \"morgen om 15 uur\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"vanaf 14u\"\n             , \"op zijn vroegst om 14 uur\"\n             , \"twee uur op zijn vroegst\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"tot 11 uur\"\n             , \"tot 11h 's morgens\"\n             , \"tot 11 am in de ochtend\"\n             , \"op zijn laatst om 11 uur\"\n             , \"11 uur op zijn laatst\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 30, 0) Minute)\n             [ \"om 13:30 in de middag\"\n             , \"vanmiddag om 1 uur 30\"\n             , \"13:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"in 15 minuten\"\n             , \"over een kwartier\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"na de lunch\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"komende maandag\"\n             , \"aanstaande maandag\"\n             ]\n  , examples (datetime (2013, 12, 10, 0, 0, 0) Day)\n             [ \"10-12\"\n             ]\n\u00c2\u00a0 , examples (datetimeInterval ((2013, 2, 12, 18, 30, 0), (2013, 2, 12, 19, 1, 0)) Minute)\n             [ \"18:30u - 19:00u\"\n             , \"18:30h tot 19:00h\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 14, 0, 0, 0), (2013, 10, 16, 0, 0, 0)) Day)\n             [ \"14/10 - 15/10\"\n             , \"van 14/10/2013 tot 15/10/2013\"\n             ]\n  , examples (datetimeInterval ((2018, 10, 14, 0, 0, 0), (2018, 10, 16, 0, 0, 0)) Day)\n             [ \"14 t/m 15 oktober 2018\"\n             ]\n  , examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"op 10-10\"\n             , \"op 10.10\"\n             , \"10/10\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 10, 0) Minute)\n             [ \"om 10:10\"\n             , \"op 10:10\"\n             ]\n  , examples (datetime (2013, 2, 12, 17, 10, 0) Minute)\n             [ \"17h10\"\n             , \"17u10\"\n             ]\n  , examples (datetimeHoliday (2018, 4, 27, 0, 0, 0) Day \"Koningsdag\")\n           [ \"Koningsdag 2018\"\n           , \"koningsdag 2018\"\n           , \"king's day 2018\"\n           , \"King's Day 2018\"\n           ]\n  , examples (datetimeHoliday (2014, 4, 26, 0, 0, 0) Day \"Koningsdag\")\n           [ \"Koningsdag 2014\"\n           , \"koningsdag 2014\"\n           , \"King's Day 2014\"\n           , \"king's day 2014\"\n           ]\n  ]\n", "num_lines": 697}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.NL.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (duration, isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Numeral.Types (NumeralData(..))\nimport Duckling.Ordinal.Types (OrdinalData(..))\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.HolidayHelpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleInstants :: [Rule]\nruleInstants = mkRuleInstants\n [ ( \"now\"             , TG.Second,  0, \"meteen|nu|direct|zojuist\" )\n , ( \"today\"           , TG.Day   ,  0, \"vandaag|op deze dag\" )\n , ( \"tomorrow\"        , TG.Day   ,  1, \"morgen\" )\n , ( \"yesterday\"       , TG.Day   , -1, \"gisteren\" )\n , ( \"after tomorrow\"  , TG.Day   ,  2, \"overmorgen\" )\n , ( \"before yesterday\", TG.Day   , -2, \"eergisteren\" )\n , ( \"EOM|End of month\", TG.Month ,  1, \"(het )?einde? van de maand\" )\n , ( \"EOY|End of year\" , TG.Year  ,  1, \"(het )? einde? van het jaar\" )\n ]\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"monday\"    , \"maandags?|ma\\\\.\"      )\n  , ( \"tuesday\"   , \"dinsdags?|di\\\\.\"      )\n  , ( \"wednesday\" , \"woensdags?|woe\\\\.\"    )\n  , ( \"thursday\"  , \"donderdags?|do\\\\.\"    )\n  , ( \"friday\"    , \"vrijdags?|vr(ij)?\\\\.\" )\n  , ( \"saturday\"  , \"zaterdags?|zat?\\\\.\"   )\n  , ( \"sunday\"    , \"zondags?|zon?\\\\.\"     )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"January\"   , \"januari|jan\\\\.?\"    )\n  , ( \"February\"  , \"februari|feb\\\\.?\"   )\n  , ( \"March\"     , \"maart|mar\\\\.?\"      )\n  , ( \"April\"    , \"april|apr\\\\.?\"       )\n  , ( \"May\"      , \"mei\\\\.?\"             )\n  , ( \"June\"     , \"juni?\\\\.?\"           )\n  , ( \"July\"     , \"juli?\\\\.?\"           )\n  , ( \"August\"   , \"augustus|aug\\\\.?\"    )\n  , ( \"September\", \"september|sept?\\\\.?\" )\n  , ( \"October\"  , \"oktober|okt\\\\.?\"     )\n  , ( \"November\" , \"november|nov\\\\.?\"    )\n  , ( \"December\" , \"december|dec\\\\.?\"    )\n  ]\n\nruleSeasons :: [Rule]\nruleSeasons = mkRuleSeasons\n  [ ( \"summer\" , \"zomer\"          , monthDay  6 21, monthDay  9 23 )\n  , ( \"fall\"   , \"herfst|najaar\"  , monthDay  9 23, monthDay 12 21 )\n  , ( \"winter\" , \"winter\"         , monthDay 12 21, monthDay  3 20 )\n  , ( \"spring\" , \"lente|voorjaar\" , monthDay  3 20, monthDay  6 21 )\n  ]\n\nruleHolidays :: [Rule]\nruleHolidays = mkRuleHolidays\n  [ ( \"Nieuwjaarsdag\", \"nieuwjaars?(dag)?\", monthDay  1  1 )\n  , ( \"Valentijnsdag\", \"valentijns?(dag)?\", monthDay  2 14 )\n  , ( \"Halloween\", \"hall?oween?\", monthDay 10 31 )\n  , ( \"Allerheiligen\", \"allerheiligen?|aller heiligen?\", monthDay 11  1 )\n  , ( \"Kerstavond\", \"kerstavond\", monthDay 12 24 )\n  , ( \"Tweede Kerstdag\", \"tweede kerstdag\", monthDay 12 26 )\n  , ( \"Kerstmis\", \"kerstmis|(eerste )?kerstdag|kerst\", monthDay 12 25 )\n  , ( \"Oudjaar\", \"oudjaar|oudejaars?avond\", monthDay 12 31 )\n  , ( \"Moederdag\", \"moederdag\", nthDOWOfMonth 2 7 5 )\n  , ( \"Vaderdag\", \"vaderdag\", nthDOWOfMonth 3 7 6 )\n  ]\n\nruleComputedHolidays' :: [Rule]\nruleComputedHolidays' = mkRuleHolidays'\n  [\n    ( \"Koningsdag\", \"king's day|koningsdag\"\n    , computeKingsDay )\n  ]\nruleRelativeMinutesToOrAfterIntegerPartOfDay :: Rule\nruleRelativeMinutesToOrAfterIntegerPartOfDay = Rule\n  { name = \"relative minutes to|till|before|after <integer> (time-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"(voor|over|na)\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Numeral NumeralData{TNumeral.value = v}:\n       Token RegexMatch (GroupMatch (match:_)):\n       Token Time td:\n       _) -> case Text.toLower match of\n        \"voor\" -> tt $ durationBefore (duration TG.Minute $ floor v) td\n        _        -> tt $ durationAfter (duration TG.Minute $ floor v) td\n      _ -> Nothing\n  }\n\nruleQuarterTotillbeforeIntegerHourofday :: Rule\nruleQuarterTotillbeforeIntegerHourofday = Rule\n  { name = \"quarter to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"kwart(ier)? voor\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleHalfTotillbeforeIntegerHourofday :: Rule\nruleHalfTotillbeforeIntegerHourofday = Rule\n  { name = \"half to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"half\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleOfTime :: Rule\nruleTheOrdinalCycleOfTime = Rule\n  { name = \"the <ordinal> <cycle> of <time>\"\n  , pattern =\n    [ regex \"de|het\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"van|in\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime2 :: Rule\nruleNthTimeOfTime2 = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ regex \"de|het\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"in\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"afgelopen|vorige?\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|t\\\\/m|tot en met\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEvening :: Rule\nruleEvening = Rule\n  { name = \"evening\"\n  , pattern =\n    [ regex \"\\\\'s avonds|avond\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\n-- TODO: Single-word composition (#110)\nruleEvenings :: Rule\nruleEvenings = Rule\n  { name = \"today/tomorrow/yesterday evening\"\n  , pattern =\n    [ regex \"(van|morgen|gister(en)?)avond\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        td1 <- case Text.toLower match of\n          \"van\"    -> Just today\n          \"morgen\" -> Just $ cycleNth TG.Day 1\n          _        -> Just $ cycleNth TG.Day $ - 1\n        td2 <- interval TTime.Open (hour False 18) (hour False 0)\n        Token Time . partOfDay <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleTheDayofmonthNonOrdinal :: Rule\nruleTheDayofmonthNonOrdinal = Rule\n  { name = \"the <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"de\"\n    , Predicate $ isIntegerBetween 1 31\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in <duration>\"\n  , pattern =\n    [ regex \"in|over\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"laatste|vorige|afgelopen\"\n    , dimension TimeGrain\n    , regex \"van|in\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleFromDatetimeDatetimeInterval :: Rule\nruleFromDatetimeDatetimeInterval = Rule\n  { name = \"from <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"van\"\n    , dimension Time\n    , regex \"\\\\-|tot\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleQuarterAfterpastIntegerHourofday :: Rule\nruleQuarterAfterpastIntegerHourofday = Rule\n  { name = \"quarter after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"kwart(ier)? over\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData\n       {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleMonthDdddInterval :: Rule\nruleMonthDdddInterval = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ regex \"([012]?\\\\d|30|31)(ste|de)?\"\n    , regex \"\\\\-|tot en met|t\\\\/m\"\n    , regex \"([012]?\\\\d|30|31)(ste|de)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (m2:_)):\n       Token Time td:\n       _) -> do\n        v1 <- parseInt m1\n        v2 <- parseInt m2\n        from <- intersect (dayOfMonth v1) td\n        to <- intersect (dayOfMonth v2) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleTheCycleAfterTime :: Rule\nruleTheCycleAfterTime = Rule\n  { name = \"the <cycle> after <time>\"\n  , pattern =\n    [ regex \"de|het\"\n    , dimension TimeGrain\n    , regex \"na\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleTheCycleBeforeTime :: Rule\nruleTheCycleBeforeTime = Rule\n  { name = \"the <cycle> before <time>\"\n  , pattern =\n    [ regex \"de\"\n    , dimension TimeGrain\n    , regex \"voor\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleTimeAfterNext :: Rule\nruleTimeAfterNext = Rule\n  { name = \"<time> after next\"\n  , pattern =\n    [ dimension Time\n    , regex \"navolgend\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"aanstaande|komende|volgende\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleBetweenTimeofdayAndTimeofdayInterval :: Rule\nruleBetweenTimeofdayAndTimeofdayInterval = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"tussen\"\n    , Predicate isATimeOfDay\n    , regex \"en\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNextCycle :: Rule\nruleNextCycle = Rule\n  { name = \"next <cycle>\"\n  , pattern =\n    [ regex \"aanstaande|komende?|volgende?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleTimeofdayApproximately :: Rule\nruleTimeofdayApproximately = Rule\n  { name = \"<time-of-day> approximately\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"ongeveer\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleOnDate :: Rule\nruleOnDate = Rule\n  { name = \"on <date>\"\n  , pattern =\n    [ regex \"op( de)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleDurationFromNow :: Rule\nruleDurationFromNow = Rule\n  { name = \"<duration> from now\"\n  , pattern =\n    [ dimension Duration\n    , regex \"vanaf (vandaag|nu)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLunch :: Rule\nruleLunch = Rule\n  { name = \"lunch\"\n  , pattern =\n    [ regex \"(am |zu )?mittags?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 14\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleLastCycle :: Rule\nruleLastCycle = Rule\n  { name = \"last <cycle>\"\n  , pattern =\n    [ regex \"vorige?|afgelopen\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"('s )?middags?|(in de )?middag|namiddag\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 18\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\n-- TODO: Single-word composition (#110)\nruleAfternoons :: Rule\nruleAfternoons = Rule\n  { name = \"today/tomorrow/yesterday afternoon\"\n  , pattern =\n    [ regex \"(vanmiddag|morgenmiddags?|gistermiddag|gisteren(na)?middag)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        td1 <- case Text.toLower match of\n          \"vanmiddag\"     -> Just today\n          \"morgenmiddag\"  -> Just $ cycleNth TG.Day 1\n          \"morgenmiddags\" -> Just $ cycleNth TG.Day 1\n          _               -> Just . cycleNth TG.Day $ - 1\n        td2 <- interval TTime.Open (hour False 12) (hour False 18)\n        Token Time . partOfDay <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthOrdinal :: Rule\nruleNamedmonthDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleInduringThePartofday :: Rule\nruleInduringThePartofday = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"(tijdens|gedurende?)( de)?\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData\n       {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonth :: Rule\nruleDayofmonthordinalNamedmonth = Rule\n  { name = \"<day-of-month>(ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by ','\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",( den|r)?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"na\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleMmdd :: Rule\nruleMmdd = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\\\\s?[/.-]\\\\s?(1[0-2]|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        d <- parseInt m1\n        m <- parseInt m2\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleAfterDuration :: Rule\nruleAfterDuration = Rule\n  { name = \"after <duration>\"\n  , pattern =\n    [ regex \"over|na\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ hour (n < 12) n\n      _ -> Nothing\n  }\n\nruleFromTimeofdayTimeofdayInterval :: Rule\nruleFromTimeofdayTimeofdayInterval = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(van|vanaf|na|vroegst om|om)\"\n    , Predicate isATimeOfDay\n    , regex \"((maar)? voor)|\\\\-|tot\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleExactlyTimeofday :: Rule\nruleExactlyTimeofday = Rule\n  { name = \"exactly <time-of-day>\"\n  , pattern =\n    [ regex \"(stipt|exact|precies)( om)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleBetweenDatetimeAndDatetimeInterval :: Rule\nruleBetweenDatetimeAndDatetimeInterval = Rule\n  { name = \"between <datetime> and <datetime> (interval)\"\n  , pattern =\n    [ regex \"tussen\"\n    , dimension Time\n    , regex \"en\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationHenceAgo :: Rule\nruleDurationHenceAgo = Rule\n  { name = \"<duration> hence|ago\"\n  , pattern =\n    [ dimension Duration\n    , regex \"(later|geleden)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> case Text.toLower match of\n        \"geleden\" -> tt $ durationAgo dd\n        _ -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleByTheEndOfTime :: Rule\nruleByTheEndOfTime = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"tot( het)? einde( van)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed now td\n      _ -> Nothing\n  }\n\nruleAfterWork :: Rule\nruleAfterWork = Rule\n  { name = \"after work\"\n  , pattern =\n    [ regex \"na het werk\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 17) (hour False 21)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleLastNCycle :: Rule\nruleLastNCycle = Rule\n  { name = \"last n <cycle>\"\n  , pattern =\n    [ regex \"laatste|afgelopen|vorige?\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        n <- getIntValue token\n        tt $ cycleN True grain (- n)\n      _ -> Nothing\n  }\n\nruleTimeofdaySharp :: Rule\nruleTimeofdaySharp = Rule\n  { name = \"<time-of-day> sharp\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"genau|exakt|p(\u00c3\u00bc)nktlich|punkt( um)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleWithinDuration :: Rule\nruleWithinDuration = Rule\n  { name = \"within <duration>\"\n  , pattern =\n    [ regex \"binnen|innerhalb( von)?\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> Token Time <$>\n        interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleMidnighteodendOfDay :: Rule\nruleMidnighteodendOfDay = Rule\n  { name = \"midnight|EOD|end of day\"\n  , pattern =\n    [ regex \"middernacht|EOD|einde? van de dag\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleDayofmonthNonOrdinalNamedmonth :: Rule\nruleDayofmonthNonOrdinalNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAboutTimeofday :: Rule\nruleAboutTimeofday = Rule\n  { name = \"about <time-of-day>\"\n  , pattern =\n    [ regex \"ongeveer|circa|ca\\\\.|tegen|rond\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleUntilTimeofday :: Rule\nruleUntilTimeofday = Rule\n  { name = \"until <time-of-day>\"\n  , pattern =\n    [ regex \"voor|tot|op zijn laatst om\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleUntilTimeofdayPostfix :: Rule\nruleUntilTimeofdayPostfix = Rule\n  { name = \"<time-of-day> until\"\n  , pattern =\n    [ dimension Time\n    , regex \"op zijn laatst\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:_) -> tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleAtTimeofday :: Rule\nruleAtTimeofday = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"om|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"in|van\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimePartofday :: Rule\nruleTimePartofday = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"week(\\\\s|-)?ei?nde?\"\n    ]\n  , prod = \\_ -> tt $ mkOkForThisNext weekend\n  }\n\nruleNthTimeAfterTime2 :: Rule\nruleNthTimeAfterTime2 = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ regex \"de|het\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"na\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"(volgende?|komende?)\"\n    , Predicate $ and . sequence [isOkWithThisNext, not . isATimeOfDay]\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarterYear :: Rule\nruleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:_:Token Time td:_) ->\n        tt $ cycleNthAfter False TG.Quarter (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})[.-](1[0-2]|0?[1-9])[.-](3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m1\n        m <- parseInt m2\n        d <- parseInt m3\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleAfterTime :: Rule\nruleTheOrdinalCycleAfterTime = Rule\n  { name = \"the <ordinal> <cycle> after <time>\"\n  , pattern =\n    [ regex \"de|het\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"na\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleIntersectByOfFromS :: Rule\nruleIntersectByOfFromS = Rule\n  { name = \"intersect by 'of', 'from', 's\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"von|der|im\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNextNCycle :: Rule\nruleNextNCycle = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"(volgende?|komende?)\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleADuration :: Rule\nruleADuration = Rule\n  { name = \"a <duration>\"\n  , pattern =\n    [ regex \"(in )?eine?(r|n)?\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"(in de )?morgen( van)?|(in de )?ochtend|\\\\'s ochtends|\\\\'s morgens\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 0\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\n-- TODO: Single-word composition (#110)\nruleMornings :: Rule\nruleMornings = Rule\n  { name = \"today/tomorrow/yesterday morning\"\n  , pattern =\n    [ regex \"(vanmorgen|morgenochtend|gisterenochtend)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        td1 <- case Text.toLower match of\n          \"vanmorgen\"     -> Just today\n          \"morgenochtend\" -> Just $ cycleNth TG.Day 1\n          _               -> Just . cycleNth TG.Day $ - 1\n        td2 <- interval TTime.Open (hour False 0) (hour False 12)\n        Token Time . partOfDay <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"deze|dit\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisCycle :: Rule\nruleThisCycle = Rule\n  { name = \"this <cycle>\"\n  , pattern =\n    [ regex \"dit|deze|komende?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"dit|deze|huidige?\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalOfNamedmonth :: Rule\nruleDayofmonthNonOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"van\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAfterLunch :: Rule\nruleAfterLunch = Rule\n  { name = \"after lunch\"\n  , pattern =\n    [ regex \"na de lunch|na het middageten\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 13) (hour False 17)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleOnANamedday :: Rule\nruleOnANamedday = Rule\n  { name = \"on a named-day\"\n  , pattern =\n    [ regex \"op( een)?\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 25 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        y <- getIntValue token\n        tt . mkLatent $ year y\n      _ -> Nothing\n  }\n\nruleAfterTimeofday :: Rule\nruleAfterTimeofday = Rule\n  { name = \"after <time-of-day>\"\n  , pattern =\n    [ regex \"na|vanaf|op zijn vroegst\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleAfterTimeofdayPostfix :: Rule\nruleAfterTimeofdayPostfix = Rule\n  { name = \"<time-of-day> after\"\n  , pattern =\n    [ dimension Time\n    , regex \"op zijn vroegst\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:_) -> tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleNight :: Rule\nruleNight = Rule\n  { name = \"night\"\n  , pattern =\n    [ regex \"(\\\\'s nachts|(in de )?nacht)\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 20\n          to = hour False 8\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\n-- TODO: Single-word composition (#110)\nruleNights :: Rule\nruleNights = Rule\n  { name = \"yesterday/tomorrow night\"\n  , pattern =\n    [ regex \"(morgen|gisteren)nacht\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (match:_)):_) -> do\n        td1 <- case Text.toLower match of\n          \"morgen\" -> Just $ cycleNth TG.Day 1\n          _        -> Just . cycleNth TG.Day $ - 1\n        td2 <- interval TTime.Open (hour False 18) (hour False 0)\n        Token Time . partOfDay <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleDayofmonthOrdinal :: Rule\nruleDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleTimeofdayAmpm :: Rule\nruleTimeofdayAmpm = Rule\n  { name = \"<time-of-day> am|pm\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"([ap])\\\\.?m\\\\.?(?:[\\\\s'\\\"-_{}\\\\[\\\\]()]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:Token RegexMatch (GroupMatch (ap:_)):_) ->\n        tt $ timeOfDayAMPM (Text.toLower ap == \"a\") td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleAfterTime :: Rule\nruleOrdinalCycleAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"na\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleOfTime :: Rule\nruleOrdinalCycleOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"in|van\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleAfterNextTime :: Rule\nruleAfterNextTime = Rule\n  { name = \"after next <time>\"\n  , pattern =\n    [ regex \"(\u00c3\u00bc)ber ?n(\u00c3\u00a4)chste[ns]?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleHhmm :: Rule\nruleHhmm = Rule\n  { name = \"hh:mm\"\n  , pattern = [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:hu]([0-5]\\\\d)(?:uur|u|h)?\" ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        y <- getIntValue token\n        tt $ year y\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthNonOrdinal :: Rule\nruleNamedmonthDayofmonthNonOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleHhmmMilitary :: Rule\nruleHhmmMilitary = Rule\n  { name = \"hhmm (military)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (h:m:_)):_) -> do\n        hh <- parseInt h\n        mm <- parseInt m\n        tt . mkLatent $ hourMinute False hh mm\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"laatste\"\n    , Predicate isADayOfWeek\n    , regex \"in|van\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) -> tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleHhmmMilitaryAmpm :: Rule\nruleHhmmMilitaryAmpm = Rule\n  { name = \"hhmm (military) am|pm\"\n  , pattern =\n    [ regex \"((?:1[012]|0?\\\\d))([0-5]\\\\d)\"\n    , regex \"([ap])\\\\.?m\\\\.?(?:[\\\\s'\\\"-_{}\\\\[\\\\]()]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):Token RegexMatch (GroupMatch (ap:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt . timeOfDayAMPM (Text.toLower ap == \"a\") $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval :: Rule\nruleTimeofdayTimeofdayInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\-|tot\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval2 :: Rule\nruleTimeofdayTimeofdayInterval2 = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"\\\\-|tot\"\n    , Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAfterTime :: Rule\nruleDurationAfterTime = Rule\n  { name = \"<duration> after <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"na\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) -> tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarter :: Rule\nruleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) -> tt .\n        cycleNthAfter False TG.Quarter (v - 1) $ cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleTheDayofmonthOrdinal :: Rule\nruleTheDayofmonthOrdinal = Rule\n  { name = \"the <day-of-month> (ordinal)\"\n  , pattern =\n    [ regex \"der\"\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleDurationBeforeTime :: Rule\nruleDurationBeforeTime = Rule\n  { name = \"<duration> before <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"voor\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nrulePartofdayOfTime :: Rule\nrulePartofdayOfTime = Rule\n  { name = \"<part-of-day> of <time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"(van|op|in)( de)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleMmddyyyy :: Rule\nruleMmddyyyy = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[/.-](1[0-2]|0?[1-9])[/.-](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTimeofdayOclock :: Rule\nruleTimeofdayOclock = Rule\n  { name = \"<time-of-day>  o'clock\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"uur|h|u(?:[\\\\s'\\\"-_{}\\\\[\\\\]()]|$)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonthYear :: Rule\nruleDayofmonthordinalNamedmonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       Token Time td:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n        n <- parseInt match\n        dom <- intersectDOM td token\n        Token Time <$> intersect dom (year n)\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleADuration\n  , ruleAboutTimeofday\n  , ruleAbsorptionOfAfterNamedDay\n  , ruleAfterDuration\n  , ruleAfterLunch\n  , ruleAfterNextTime\n  , ruleAfterTimeofday\n  , ruleAfterTimeofdayPostfix\n  , ruleAfterWork\n  , ruleAfternoon\n  , ruleAfternoons\n  , ruleAtTimeofday\n  , ruleBetweenDatetimeAndDatetimeInterval\n  , ruleBetweenTimeofdayAndTimeofdayInterval\n  , ruleByTheEndOfTime\n  , ruleDatetimeDatetimeInterval\n  , ruleDayofmonthNonOrdinalNamedmonth\n  , ruleDayofmonthNonOrdinalOfNamedmonth\n  , ruleDayofmonthOrdinal\n  , ruleDayofmonthordinalNamedmonth\n  , ruleDayofmonthordinalNamedmonthYear\n  , ruleDurationAfterTime\n  , ruleDurationHenceAgo\n  , ruleDurationBeforeTime\n  , ruleDurationFromNow\n  , ruleEvening\n  , ruleEvenings\n  , ruleExactlyTimeofday\n  , ruleFromDatetimeDatetimeInterval\n  , ruleFromTimeofdayTimeofdayInterval\n  , ruleHhmm\n  , ruleHhmmMilitary\n  , ruleHhmmMilitaryAmpm\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleInDuration\n  , ruleInduringThePartofday\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleIntersectByOfFromS\n  , ruleLastCycle\n  , ruleLastCycleOfTime\n  , ruleLastDayofweekOfTime\n  , ruleLastNCycle\n  , ruleLastTime\n  , ruleLunch\n  , ruleMidnighteodendOfDay\n  , ruleMmdd\n  , ruleMmddyyyy\n  , ruleMonthDdddInterval\n  , ruleMorning\n  , ruleMornings\n  , ruleNamedmonthDayofmonthNonOrdinal\n  , ruleNamedmonthDayofmonthOrdinal\n  , ruleNextCycle\n  , ruleNextNCycle\n  , ruleNextTime\n  , ruleNight\n  , ruleNights\n  , ruleNthTimeAfterTime\n  , ruleNthTimeAfterTime2\n  , ruleNthTimeOfTime\n  , ruleNthTimeOfTime2\n  , ruleOnANamedday\n  , ruleOnDate\n  , ruleOrdinalCycleAfterTime\n  , ruleOrdinalCycleOfTime\n  , ruleOrdinalQuarter\n  , ruleOrdinalQuarterYear\n  , rulePartofdayOfTime\n  , ruleRelativeMinutesToOrAfterIntegerPartOfDay\n  , ruleTheCycleAfterTime\n  , ruleTheCycleBeforeTime\n  , ruleTheDayofmonthNonOrdinal\n  , ruleTheDayofmonthOrdinal\n  , ruleTheOrdinalCycleAfterTime\n  , ruleTheOrdinalCycleOfTime\n  , ruleThisCycle\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleThisnextDayofweek\n  , ruleTimeAfterNext\n  , ruleTimePartofday\n  , ruleTimeofdayAmpm\n  , ruleTimeofdayApproximately\n  , ruleTimeofdayLatent\n  , ruleTimeofdayOclock\n  , ruleTimeofdaySharp\n  , ruleTimeofdayTimeofdayInterval\n  , ruleTimeofdayTimeofdayInterval2\n  , ruleUntilTimeofday\n  , ruleUntilTimeofdayPostfix\n  , ruleWeekend\n  , ruleWithinDuration\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYyyymmdd\n  , ruleQuarterTotillbeforeIntegerHourofday\n  , ruleHalfTotillbeforeIntegerHourofday\n  , ruleQuarterAfterpastIntegerHourofday\n  , ruleTimezone\n  ]\n  ++ ruleInstants\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n  ++ ruleSeasons\n  ++ ruleHolidays\n  ++ ruleComputedHolidays'\n", "num_lines": 1600}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.NL.BE.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetimeHoliday (2013, 12, 6, 0, 0, 0) Day \"Sinterklaas\")\n             [ \"Sinterklaas\"\n             ]\n  ]\n", "num_lines": 27}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.NL.BE.Rules\n  ( rules\n  ) where\n\nimport Duckling.Time.Helpers\nimport Duckling.Types\n\nruleHolidays :: [Rule]\nruleHolidays = mkRuleHolidays\n  [ ( \"Sinterklaas\", \"sinterklaas\", monthDay 12 6 )\n  ]\n\nrules :: [Rule]\nrules = ruleHolidays\n", "num_lines": 26}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.NL.NL.Rules\n  ( rulesBackwardCompatible\n  ) where\n\nimport Duckling.Time.Helpers\nimport Duckling.Types\n\nrulesBackwardCompatible :: [Rule]\nrulesBackwardCompatible = mkRuleHolidays\n  [ ( \"Sinterklaas\", \"sinterklaas(avond)?|pakjesavond\", monthDay 12 5 )\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.PL.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PL Nothing}, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext {locale = makeLocale PL Nothing}, testOptions, examples)\n  where\n    examples =\n      [ \"nie\"\n      , \"niez\"\n      , \"Za Herbatke\"\n      , \"za herbatke\"\n      , \"No nic\"\n      , \"no nic\"\n      , \"pierwszy\"\n      , \"drugiej\"\n      , \"trzecia pi\u00c4\u2122tna\u00c5\u203acie\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"teraz\"\n             , \"w tej chwili\"\n             , \"w tym momencie\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"dzi\u00c5\u203a\"\n             , \"dzis\"\n             , \"dzisiaj\"\n             , \"obecnego dnia\"\n             , \"tego dnia\"\n             , \"dzisiejsza\"\n             , \"dzisiejsz\u00c4\u2026\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"wczoraj\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"przedwczoraj\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"jutro\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"pojutrze\"\n             , \"po jutrze\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"poniedzia\u00c5\u201aek\"\n             , \"pon.\"\n             , \"ten poniedzia\u00c5\u201aek\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Poniedzia\u00c5\u201aek, 18 Luty\"\n             , \"Poniedzia\u00c5\u201aek, Luty 18\"\n             , \"Poniedzia\u00c5\u201aek 18tego Lutego\"\n             , \"Poniedzia\u00c5\u201aek 18-tego Lutego\"\n             , \"Poniedzia\u00c5\u201aek, 18-tego Lutego\"\n             , \"poniedzialek, 18go Lutego\"\n             , \"Pon, 18 Luty\"\n             ]\n  , examples (datetime (2013, 2, 2, 0, 0, 0) Day)\n             [ \"Sobota, 2ego Lutego\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"Wtorek\"\n             , \"nastepny wtorek\"\n             , \"wt.\"\n             , \"wtr.\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"czwartek\"\n             , \"ten czwartek\"\n             , \"czw\"\n             , \"czw.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"piatek\"\n             , \"ten piatek\"\n             , \"pia\"\n             , \"pia.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"sobota\"\n             , \"ta sobota\"\n             , \"sob\"\n             , \"sob.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"niedziela\"\n             , \"ta niedziela\"\n             , \"niedz\"\n             , \"niedz.\"\n             , \"nd\"\n             , \"ndz\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"pierwszy marca\"\n             , \"pierwszego marca\"\n             , \"marzec pierwszy\"\n             , \"1szy marca\"\n             , \"1szy marzec\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"marzec 3\"\n             , \"marzec 3ci\"\n             , \"3go marca\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"3ci marca 2015\"\n             , \"marzec 3ci 2015\"\n             , \"3 marzec 2015\"\n             , \"marzec 3 2015\"\n             , \"trzeci marca 2015\"\n             , \"3/3/2015\"\n             , \"3/3/15\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"15 Luty\"\n             , \"15 Lutego\"\n             , \"Luty 15\"\n             , \"15-tego Lutego\"\n             , \"2/15\"\n             , \"Pietnastego Lutego\"\n             , \"Pi\u00c4\u2122tnasty Luty\"\n             , \"Luty Pi\u00c4\u2122tnastego\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"Sierpie\u00c5\u201e 8\"\n             , \"Sie 8\"\n             , \"Sier 8\"\n             , \"Sierp. 8\"\n             , \"8 Sie.\"\n             , \"\u00c3\u201csmy Sie.\"\n             , \"Osmego Sie.\"\n             ]\n  , examples (datetime (2013, 11, 20, 0, 0, 0) Day)\n             [ \"20 listopada\"\n             , \"20 listopadowi\"\n             , \"20 listopadem\"\n             , \"20 listopad\"\n             ]\n  , examples (datetime (2013, 5, 20, 0, 0, 0) Day)\n             [ \"20 maja\"\n             , \"20 maj\"\n             , \"20 majem\"\n             ]\n  , examples (datetime (2014, 10, 0, 0, 0, 0) Month)\n             [ \"Pa\u00c5\u00badziernik 2014\"\n             , \"Pazdziernika 2014\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"10/31/1974\"\n             , \"10/31/74\"\n             , \"10-31-74\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14kwiecien 2015\"\n             , \"Kwiecie\u00c5\u201e 14, 2015\"\n             , \"14tego Kwietnia 15\"\n             , \"14-tego Kwietnia 15\"\n             , \"14-ty Kwietnia 15\"\n             , \"Czternasty Kwietnia 15\"\n             , \"Czternastego Kwietnia 15\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"nastepny wtorek\"\n             , \"kolejny wtorek\"\n             , \"kolejnego wtorku\"\n             , \"nastepnego wtorku\"\n             , \"wtorek w przysz\u00c5\u201aym tygodniu\"\n             , \"wtorek za tydzie\u00c5\u201e\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"piatek po nastepnym\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"nastepny Marzec\"\n             ]\n  , examples (datetime (2014, 3, 0, 0, 0, 0) Month)\n             [ \"Marzec po nastepnym\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"Niedziela, 10 Luty\"\n             , \"Niedziela, Luty 10\"\n             , \"Niedziela, 10tego Luty\"\n             , \"Niedziela, 10-tego Luty\"\n             , \"Niedziela, 10-ty Lutego\"\n             , \"Niedziela, 10tego Lutego\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"\u00c5\u0161r., Luty13\"\n             , \"\u00c5\u0161r., 13Luty\"\n             , \"sr, 13Luty\"\n             , \"sr, 13tego Lutego\"\n             , \"\u00c5\u0161ro., 13Lutego\"\n             , \"\u00c5\u0161roda trzynastego lutego\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Poniedzia\u00c5\u201aek, Luty 18\"\n             , \"Poniedzia\u00c5\u201aek, 18 Lutego\"\n             , \"Pon, Luty 18\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"ten tydzien\"\n             , \"ten tydzie\u00c5\u201e\"\n             , \"ten tyg\"\n             , \"tym tygodniu\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"ostatni tydzien\"\n             , \"poprzedniego tygodnia\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"nastepny tydzien\"\n             , \"nastepnego tygodnia\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"ostatni miesiac\"\n             , \"poprzedni miesiac\"\n             , \"poprzedniego miesi\u00c4\u2026ca\"\n             , \"po przedniego miesi\u00c4\u2026ca\"\n             , \"ostatniego miesiaca\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"nastepnego miesiaca\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"ten kwarta\u00c5\u201a\"\n             , \"tego kwarta\u00c5\u201au\"\n             , \"tym kwartale\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"nastepny kwarta\u00c5\u201a\"\n             , \"nast\u00c4\u2122pny kwartal\"\n             , \"kolejnym kwartale\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"trzeci kwarta\u00c5\u201a\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"4ty kwarta\u00c5\u201a 2018\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"poprzedni rok\"\n             , \"ostatni rok\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"ten rok\"\n             , \"tym roku\"\n             , \"obecny rok\"\n             , \"w obecny rok\"\n             , \"w obecnym roku\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"w kolejnym roku\"\n             , \"kolejny rok\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"poprzednia niedziela\"\n             , \"niedziela z ostatniego tygodnia\"\n             , \"niedziela ostatniego tygodnia\"\n             , \"niedziela poprzedniego tygodnia\"\n             , \"ostatnia niedziela\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"ostatni wtorek\"\n             , \"poprzedni wtorek\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"nastepny wtorek\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"nastepna \u00c5\u203aroda\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"sroda nastepnego tygodnia\"\n             , \"\u00c5\u203aroda w przysz\u00c5\u201aym tygodniu\"\n             , \"\u00c5\u203aroda za tydzie\u00c5\u201e\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"piatek nastepnego tygodnia\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"poniedzialek tego tygodnia\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"wtorek tego tygodnia\"\n             , \"wtorek w tym tygodniu\"\n             , \"ten wtorek\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"\u00c5\u203aroda w tym tygodniu\"\n             , \"ta \u00c5\u203aroda\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"pojutrze\"\n             , \"po jutrze\"\n             , \"dzie\u00c5\u201e po jutrze\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"dzie\u00c5\u201e przed wczoraj\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"ostatni Poniedzia\u00c5\u201aek Marca\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"ostatnia Niedziela w Marcu 2014\"\n             , \"ostatnia Niedziela marca 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"trzeci dzie\u00c5\u201e pa\u00c5\u00badziernika\"\n             , \"trzeci dzie\u00c5\u201e w pa\u00c5\u00badzierniku\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"pierwszy tydzie\u00c5\u201e pa\u00c5\u00badziernika 2014\"\n             , \"pierwszy tydzien w pa\u00c5\u00badzierniku 2014\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"ostatni dzie\u00c5\u201e w pa\u00c5\u00badzierniku 2015\"\n             , \"ostatni dzie\u00c5\u201e pa\u00c5\u00badziernika 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"ostatni tydzie\u00c5\u201e we wrze\u00c5\u203aniu 2014\"\n             , \"ostatni tydzie\u00c5\u201e wrze\u00c5\u203ania 2014\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"pierwszy wtorek w pa\u00c5\u00badzierniku\"\n             , \"pierwszy wtorek pa\u00c5\u00badziernika\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"trzeci wtorek we wrze\u00c5\u203aniu 2014\"\n             , \"trzeci wtorek wrze\u00c5\u203ania 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"pierwsza \u00c5\u203aroda w pa\u00c5\u00badzierniku 2014\"\n             , \"pierwsza \u00c5\u203aroda pa\u00c5\u00badziernika 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"druga \u00c5\u203aroda w pa\u00c5\u00badzierniku 2014\"\n             , \"druga \u00c5\u203aroda pa\u00c5\u00badziernika 2014\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Hour)\n             [ \"o 3 rano\"\n             , \"3 rano\"\n             , \"3 z rana\"\n             , \"o trzeciej rano\"\n             , \"o trzeciej z rana\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Hour)\n             [ \"o pierwszy\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"o drugiej\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18 rano\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"o trzeciej\"\n             , \"o 3 po po\u00c5\u201audniu\"\n             -- , \"3 po po\u00c5\u201audniu\" t14902576\n             , \"3 popo\u00c5\u201audniu\"\n             , \"trzecia popoludniu\"\n             , \"o trzeciej popoludniu\"\n             , \"pi\u00c4\u2122tnasta godzina\"\n             , \"15sta godzina\"\n             , \"o pi\u00c4\u2122tnastej\"\n             , \"o 15stej\"\n             ]\n  , examples (datetime (2013, 2, 12, 18, 0, 0) Hour)\n             [ -- \"6 po po\u00c5\u201audniu\" t14902576\n               \"6 popo\u00c5\u201audniu\"\n             , \"sz\u00c3\u00b3sta popoludniu\"\n             , \"o szostej popoludniu\"\n             , \"o 18stej\"\n             , \"osiemnasta godzina\"\n             , \"o osiemnastej\"\n             ]\n  , examples (datetime (2013, 2, 12, 19, 0, 0) Hour)\n             [ -- \"7 po po\u00c5\u201audniu\" t14902576\n               \"7 popo\u00c5\u201audniu\"\n             , \"si\u00c3\u00b3dma popoludniu\"\n             , \"o siodmej popoludniu\"\n             , \"o dziewi\u00c4\u2122tnastej\"\n             , \"dziewietnasta godzina\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"8 wieczorem\"\n             , \"8 popo\u00c5\u201audniu\"\n             , \"osma w nocy\"\n             , \"\u00c3\u00b3sma wieczorem\"\n             , \"dwudziesta godzina\"\n             ]\n  , examples (datetime (2013, 2, 12, 21, 0, 0) Hour)\n             [ \"dziewiata wieczorem\"\n             , \"dziewi\u00c4\u2026ta popo\u00c5\u201audniu\"\n             , \"dziewiata po po\u00c5\u201audniu\"\n             , \"dziewi\u00c4\u2026ta wieczorem\"\n             , \"dziewi\u00c4\u2026ta noc\u00c4\u2026\"\n             , \"dziewi\u00c4\u2026ta w nocy\"\n             , \"9 wieczorem\"\n             , \"9 popo\u00c5\u201audniu\"\n             -- , \"9 po po\u00c5\u201audniu\" t14902576\n             , \"9 wieczorem\"\n             , \"9 noc\u00c4\u2026\"\n             , \"9 w nocy\"\n             , \"o dziewiatej w nocy\"\n             , \"dwudziesta pierwsza godzina\"\n             , \"dwudziestapierwsza godzina\"\n             ]\n  , examples (datetime (2013, 2, 12, 22, 0, 0) Hour)\n             [ \"dziesi\u00c4\u2026ta wieczorem\"\n             , \"dziesiata popo\u00c5\u201audniu\"\n             , \"dziesiata po po\u00c5\u201audniu\"\n             , \"dziesiata wieczorem\"\n             , \"dziesiata noc\u00c4\u2026\"\n             , \"10 w nocy\"\n             , \"o dziesiatej w nocy\"\n             , \"o dwudziestej drugiej\"\n             ]\n  , examples (datetime (2013, 2, 12, 23, 0, 0) Hour)\n             [ \"jedenasta wieczorem\"\n             , \"jedenasta w nocy\"\n             , \"11 w nocy\"\n             , \"11 wieczorem\"\n             , \"o jedenastej wieczorem\"\n             , \"o dwudziestejtrzeciej\"\n             ]\n  , examples (datetime (2013, 2, 13, 2, 0, 0) Hour)\n             [ \"jutro o drugiej\"\n             ]\n  , examples (datetime (2013, 2, 14, 2, 0, 0) Hour)\n             [ \"po jutrze o drugiej\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"oko\u00c5\u201ao 3 po po\u00c5\u201audniu\"\n             , \"oko\u00c5\u201ao trzeciej\"\n             , \"ko\u00c5\u201ao trzeciej\"\n             , \"o ko\u00c5\u201ao trzeciej\"\n             , \"mniej wiecej o 3\"\n             , \"tak o 15stej\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"jutro r\u00c3\u00b3wno o pi\u00c4\u2026tej popo\u00c5\u201audniu\"\n             , \"jutro r\u00c3\u00b3wno o 17-stej\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"pi\u00c4\u2122tna\u00c5\u203acie po trzeciej\"\n             , \"15 po trzeciej\"\n             , \"kwadrans po 3\"\n             , \"o trzecia pi\u00c4\u2122tna\u00c5\u203acie\"\n             , \"15:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"20 po 3\"\n             , \"3:20\"\n             , \"3:20 w poludnie\"\n             , \"o trzecia dwadzie\u00c5\u203acia\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"w p\u00c3\u00b3\u00c5\u201a do szesnastej\"\n             , \"pol po trzeciej\"\n             , \"15:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"3:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 23, 24) Second)\n             [ \"15:23:24\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"kwadrans do po\u00c5\u201audnia\"\n             , \"kwadrans przed po\u00c5\u201audniem\"\n             , \"kwadrans do 12stej\"\n             , \"11:45\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"8 wieczorem\"\n             , \"8 tego wieczora\"\n             ]\n  , examples (datetime (2013, 9, 20, 19, 30, 0) Minute)\n             [ \"o 7:30 popo\u00c5\u201audniu Piatek, 20 Wrzesie\u00c5\u201e\"\n             , \"o 7:30 popo\u00c5\u201audniu Piatek, Wrzesie\u00c5\u201e 20\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"o 9 rano w Sobote\"\n             , \"w Sobote na 9 rano\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Minute)\n             [ \"Pia, Lip 18, 2014 19:00\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"w sekund\u00c4\u2122\"\n             , \"za sekund\u00c4\u2122\"\n             , \"sekunde od teraz\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ -- \"za minut\u00c4\u2122\" t14902624\n               \"za jedn\u00c4\u2026 minut\u00c4\u2122\"\n             , \"przez minut\u00c4\u2122\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"w 2 minuty\"\n             , \"za jeszcze 2 minuty\"\n             , \"2 minuty od teraz\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"w 60 minut\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"w p\u00c3\u00b3\u00c5\u201a godziny\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 0, 0) Second)\n             [ \"w 2.5 godziny\"\n             , \"w 2 i p\u00c3\u00b3\u00c5\u201a godziny\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"w godzin\u00c4\u2122\"\n             , \"w 1h\"\n             , \"w przeci\u00c4\u2026gu godziny\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 30, 0) Minute)\n             [ \"w kilka godzin\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"w 24 godziny\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"w jeden dzie\u00c5\u201e\"\n             , \"dzie\u00c5\u201e od dzi\u00c5\u203a\"\n             ]\n  , examples (datetime (2016, 2, 0, 0, 0, 0) Month)\n             [ \"3 lata od dzi\u00c5\u203a\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"w 7 dni\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"w jeden tydzie\u00c5\u201e\"\n             , \"w tydzie\u00c5\u201e\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"za oko\u00c5\u201ao p\u00c3\u00b3\u00c5\u201a godziny\"\n             , \"za jakie\u00c5\u203a p\u00c3\u00b3\u00c5\u201a godziny\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 dni temu\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"14 dni temu\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"tydzien temu\"\n             , \"jeden tydzie\u00c5\u201e temu\"\n             , \"1 tydzie\u00c5\u201e temu\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"trzy tygodnie temu\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"trzy miesi\u00c4\u2026ce temu\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"dwa lata temu\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"7 dni potem\"\n             ]\n  , examples (datetime (2013, 2, 26, 4, 0, 0) Hour)\n             [ \"14 dni p\u00c3\u00b3\u00c5\u00baniej\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"tydzie\u00c5\u201e p\u00c3\u00b3\u00c5\u00baniej\"\n             , \"jeden tydzie\u00c5\u201e p\u00c3\u00b3\u00c5\u00baniej\"\n             , \"1 tydzie\u00c5\u201e p\u00c3\u00b3\u00c5\u00baniej\"\n             ]\n  , examples (datetime (2013, 3, 5, 0, 0, 0) Day)\n             [ \"trzy tygodnie p\u00c3\u00b3\u00c5\u00baniej\"\n             ]\n  , examples (datetime (2013, 5, 12, 0, 0, 0) Day)\n             [ \"trzy miesi\u00c4\u2026ce p\u00c3\u00b3\u00c5\u00baniej\"\n             ]\n  , examples (datetime (2015, 2, 0, 0, 0, 0) Month)\n             [ \"dwa lata p\u00c3\u00b3\u00c5\u00baniej\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"to lato\"\n             , \"w to lato\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"ta zima\"\n             , \"tej zimy\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 24, 0, 0, 0) Day \"Christmas Eve\")\n             [ \"Wigilia Bo\u00c5\u00bcego Narodzenia\"\n             , \"Wigilia\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 25, 0, 0, 0) Day \"Christmas\")\n             [ \"\u00c5\u0161wi\u00c4\u2122ta Bo\u00c5\u00bcego Narodzenia\"\n             , \"Bo\u00c5\u00bce Narodzenie\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 31, 0, 0, 0) Day \"New Year's Eve\")\n             [ \"Sylwester\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 14, 0, 0, 0) Day \"Valentine's Day\")\n             [ \"Walentynki\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 26, 0, 0, 0) Day \"Mother's Day\")\n             [ \"Dzie\u00c5\u201e Mamy\"\n             ]\n  , examples (datetimeHoliday (2013, 6, 23, 0, 0, 0) Day \"Father's Day\")\n             [ \"Dzie\u00c5\u201e Taty\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 31, 0, 0, 0) Day \"Halloween Day\")\n             [ \"Halloween\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 28, 0, 0, 0) Day \"Thanksgiving Day\")\n             [ \"Dzie\u00c5\u201e Dzi\u00c4\u2122kczynienia\"\n             , \"Dzi\u00c4\u2122kczynienie\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 26, 0, 0, 0) Day \"St Stephen's Day\")\n             [ \"drugi dzie\u00c5\u201e \u00c5\u203awi\u00c4\u2026t Bo\u00c5\u00bcego Narodzenia\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 6, 0, 0, 0) Day \"Three Kings' Day\")\n             [ \"\u00c5\u0161wi\u00c4\u2122to Trzech Kr\u00c3\u00b3li\"\n             , \"Trzech Kr\u00c3\u00b3li\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 1, 0, 0, 0) Day \"Labour Day\")\n             [ \"\u00c5\u0161wi\u00c4\u2122to Pracy\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 3, 0, 0, 0) Day \"Constitution Day\")\n             [ \"\u00c5\u0161wi\u00c4\u2122to Konstytucji Trzeciego Maja\"\n             , \"\u00c5\u0161wi\u00c4\u2122to Konstytucji 3 Maja\"\n             , \"\u00c5\u0161wi\u00c4\u2122to Konstytucji\"\n             ]\n  , examples (datetimeHoliday (2013, 8, 15, 0, 0, 0) Day \"Assumption Day\")\n             [ \"\u00c5\u0161wi\u00c4\u2122to Wojska Polskiego\"\n             , \"Wniebowzi\u00c4\u2122cie Naj\u00c5\u203awi\u00c4\u2122tszej Maryi Panny\"\n             ]\n  , examples (datetimeHoliday (2013, 11, 1, 0, 0, 0) Day \"All Saints' Day\")\n             [ \"Wszystkich \u00c5\u0161wi\u00c4\u2122tych\"\n             , \"\u00c5\u0161wi\u00c4\u2122to Wszystkich \u00c5\u0161wi\u00c4\u2122tych\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 1, 0, 0, 0) Day \"New Year's Day\")\n             [ \"Nowy Rok\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 8, 0, 0, 0) Day \"Women's Day\")\n             [ \"Dzie\u00c5\u201e Kobiet\"\n             ]\n  , examples (datetimeHoliday (2013, 2, 13, 0, 0, 0) Day \"Ash Wednesday\")\n             [ \"Popielec\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 30, 0, 0, 0) Day \"Corpus Christi\")\n             [ \"Bo\u00c5\u00bce Cia\u00c5\u201ao\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 1, 0, 0, 0) Day \"Easter Monday\")\n             [ \"Poniedzia\u00c5\u201aek Wielkanocny\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 31, 0, 0, 0) Day \"Easter Sunday\")\n             [ \"Niedziela Wielkanocna\"\n             , \"Wielkanoc\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 29, 0, 0, 0) Day \"Good Friday\")\n             [ \"Wielki Pi\u00c4\u2026tek\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 30, 0, 0, 0) Day \"Holy Saturday\")\n             [ \"Wielka Sobota\"\n             ]\n  , examples (datetimeHoliday (2013, 3, 24, 0, 0, 0) Day \"Palm Sunday\")\n             [ \"Niedziela Palmowa\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 19, 0, 0, 0) Day \"Pentecost\")\n             [ \"Zes\u00c5\u201aanie Ducha \u00c5\u0161wi\u00c4\u2122tego\"\n             , \"Zielone \u00c5\u0161wi\u00c4\u2026tki\"\n             ]\n  , examples (datetimeHoliday (2013, 12, 6, 0, 0, 0) Day \"Saint Nicholas Day\")\n             [ \"Miko\u00c5\u201aajki\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"ten wiecz\u00c3\u00b3r\"\n             , \"dzisiejszy wiecz\u00c3\u00b3r\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"jutrzejszy wiecz\u00c3\u00b3r\"\n             , \"\u00c5\u0161rodowy wiecz\u00c3\u00b3r\"\n             , \"jutrzejsza noc\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"wczorajszy wiecz\u00c3\u00b3r\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"ten week-end\"\n             , \"ten weekend\"\n             , \"ten wekend\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"poniedzia\u00c5\u201akowy poranek\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"ostatnie 2 sekundy\"\n             , \"ostatnie dwie sekundy\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"kolejne 3 sekundy\"\n             , \"kolejne trzy sekundy\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"ostatnie 2 minuty\"\n             , \"ostatnie dwie minuty\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"kolejne 3 minuty\"\n             , \"nastepne trzy minuty\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 3, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"ostatnia 1 godzina\"\n             , \"poprzednia jedna godzina\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"kolejne 3 godziny\"\n             , \"kolejne trzy godziny\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"ostatnie 2 dni\"\n             , \"ostatnie dwa dni\"\n             , \"poprzednie 2 dni\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"nastepne 3 dni\"\n             , \"nastepne trzy dni\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"nastepne kilka dni\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"ostatnie 2 tygodnie\"\n             , \"ostatnie dwa tygodnie\"\n             , \"poprzednie 2 tygodnie\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"nastepne 3 tygodnie\"\n             , \"nastepne trzy tygodnie\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"ostatnie 2 miesiace\"\n             , \"ostatnie dwa miesi\u00c4\u2026ce\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"nastepne trzy miesi\u00c4\u2026ce\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"ostatnie 2 lata\"\n             , \"ostatnie dwa lata\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"nastepne 3 lata\"\n             , \"kolejne trzy lata\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"Lipiec 13-15\"\n             , \"Lipca 13 do 15\"\n             , \"Lipiec 13 - Lipiec 15\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"Sie 8 - Sie 12\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"od 9:30 - 11:00 w Czwartek\"\n             -- , \"miedzy 9:30 a 11:00 w czwartek\" t14902649\n             , \"9:30 - 11:00 w czwartek\"\n             -- , \"pozniej ni\u00c5\u00bc 9:30 ale przed 11:00 w Czwartek\" t14902649\n             , \"Czwartek od 9:30 do 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"Czwartek od 9 rano do 11 rano\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-1:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"dzi\u00c5\u203a wieczorem\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"w ci\u00c4\u2026gu 2 tygodni\"\n             , \"w ci\u00c4\u2026gu dw\u00c3\u00b3ch tygodni\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"przed drug\u00c4\u2026 po po\u00c5\u201audniu\"\n             , \"przed drug\u00c4\u2026\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"dzi\u00c5\u203a o drugiej w po\u00c5\u201audnie\"\n             , \"o drugiej popo\u00c5\u201audniu\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Hour)\n             [ \"4/25 o 4 popo\u00c5\u201audniu\"\n             , \"4/25 o 16\"\n             , \"4/25 o szesnastej\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Hour)\n             [ \"3 popoludniu jutro\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"po drugiej po poludniu\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"po pi\u00c4\u2122ciu dniach\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"po drugiej po po\u00c5\u201audniu\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"przed 11 rano\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 13, 11, 0, 0) Hour)\n             [ \"jutro przed 11 rano\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"to w po\u00c5\u201audnie\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"w 15 minut\"\n             , \"w pi\u00c4\u2122tna\u00c5\u203acie minut\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"nastepny pon\"\n             , \"kolejny poniedzia\u00c5\u201aek\"\n             ]\n  ]\n", "num_lines": 863}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.PL.Rules\n  ( rules\n  ) where\n\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Types (OrdinalData(..))\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Time.Computed\nimport Duckling.Types\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleOrdinalCycleTime :: Rule\nruleOrdinalCycleTime = Rule\n  { name = \"<ordinal> <cycle> <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Monday\" , \"poniedzia(l|\u00c5\u201a)(ek|ku|kowi|kiem|kowy)|pon\\\\.?\" )\n  , ( \"Tuesday\" , \"wtorek|wtorku|wtorkowi|wtorkiem|wtr?\\\\.?\" )\n  , ( \"Wednesday\" , \"(\u00c5\u0161|\u00c5\u203a|s)rod(a|\u00c4\u2026|y|e|\u00c4\u2122|zie|owy|o)|(s|\u00c5\u203a|\u00c5\u0161)ro?\\\\.?\" )\n  , ( \"Thursday\" , \"czwartek|czwartku|czwartkowi|czwartkiem|czwr?\\\\.?\" )\n  , ( \"Friday\" , \"pi\u00c4\u2026tek|piatek|pi\u00c4\u2026tku|piatku|pi\u00c4\u2026tkowi|piatkowi|pi\u00c4\u2026tkiem|piatkiem|pi(\u00c4\u2026|a)tkowy|pia\\\\.?\" )\n  , ( \"Saturday\" , \"sobota|soboty|sobocie|sobot\u00c4\u2122|sobote|sobot\u00c4\u2026|sobota|sobocie|soboto|sob\\\\.?\" )\n  , ( \"Sunday\" , \"niedziel(a|i|\u00c4\u2122|e|\u00c4\u2026|o)|n(ie)?dz?\\\\.?\" )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"January\" , \"stycz(e\u00c5\u201e|en|nia|niowi|niem|niu)|sty(cz)?\\\\.?\" )\n  , ( \"February\" , \"lu(ty|tego|temu|t?\\\\.?)\" )\n  , ( \"March\" , \"mar(zec|ca|cowi|cem|cu|z?\\\\.?)\" )\n  , ( \"April\" , \"kwie(cie\u00c5\u201e|cien|tnia|tniowi|tniem|tniu|t?\\\\.?)\" )\n  , ( \"May\" , \"maj(a|owi|em|u)?\" )\n  , ( \"June\" , \"czerw(iec|ca|cowi|cem|cu)|czer?\\\\.?\" )\n  , ( \"July\" , \"lip(iec|ca|cowi|cem|cu)|lip\\\\.?\" )\n  , ( \"August\" , \"sierp(ie(n|\u00c5\u201e)|ni(a|owi|em|u))|sierp\\\\.?|sier\\\\.?|sie\\\\.?\" )\n  , ( \"September\" , \"wrze(s|\u00c5\u203a)(ie(\u00c5\u201e|n)|ni(a|owi|em|u))|wrz\\\\.?|wrze\\\\.?\" )\n  , ( \"October\" , \"pa(z|\u00c5\u00ba)dziernik(a|owi|iem|u)?|pa\u00c5\u00ba\\\\.?|paz\\\\.?\" )\n  , ( \"November\" , \"listopad(a|owi|em|zie)?|lis\\\\.?|list\\\\.?\" )\n  , ( \"December\" , \"grudz(ie\u00c5\u201e|ien)|grudn(ia|iowi|iem|niu)|gru\\\\.?|grud\\\\.?\" )\n  ]\n\nruleRelativeMinutesTotillbeforeIntegerHourofday :: Rule\nruleRelativeMinutesTotillbeforeIntegerHourofday = Rule\n  { name = \"relative minutes to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"do|przed\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleRelativeMinutesAfterpastIntegerHourofday :: Rule\nruleRelativeMinutesAfterpastIntegerHourofday = Rule\n  { name = \"relative minutes after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"po\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       _:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute True hours n\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute True hours n\n      _ -> Nothing\n  }\n\nruleQuarterTotillbeforeIntegerHourofday :: Rule\nruleQuarterTotillbeforeIntegerHourofday = Rule\n  { name = \"quarter to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"kwadrans(ie|owi|em|a)? *(do|przed)\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleQuarterAfterpastIntegerHourofday :: Rule\nruleQuarterAfterpastIntegerHourofday = Rule\n  { name = \"quarter after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"kwadrans(ie|owi|em|a)? *po\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayQuarter :: Rule\nruleHourofdayQuarter = Rule\n  { name = \"<hour-of-day> quarter (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"kwadrans(ie|owi|em|a)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 15\n      _ -> Nothing\n  }\n\nruleHalfTotillbeforeIntegerHourofday :: Rule\nruleHalfTotillbeforeIntegerHourofday = Rule\n  { name = \"half to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"p(o|\u00c3\u00b3)(l|\u00c5\u201a) *(do|przed)\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleHalfAfterpastIntegerHourofday :: Rule\nruleHalfAfterpastIntegerHourofday = Rule\n  { name = \"half after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"p(o|\u00c3\u00b3)(l|\u00c5\u201a) *po\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 30\n      _ -> Nothing\n  }\n\nruleHourofdayHalf :: Rule\nruleHourofdayHalf = Rule\n  { name = \"<hour-of-day> half (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"p(o|\u00c3\u00b3)(l|\u00c5\u201a)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 30\n      _ -> Nothing\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej)?|(po ?)?przedni(ego|ch|emu|e|mi|m|a)?\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|(p|d)o|a(\u00c5\u00bc|z) (p|d)o\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleCycleAfterTime :: Rule\nruleCycleAfterTime = Rule\n  { name = \"<cycle> after <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"po\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in <duration>\"\n  , pattern =\n    [ regex \"(w( ?(prze)?ci\u00c4\u2026gu)?|za) ?(jeszcze)?|przez\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleNow :: Rule\nruleNow = Rule\n  { name = \"now\"\n  , pattern =\n    [ regex \"(w)? ?(tym|tej)? ?(teraz|momencie|chwili|mome\u00c5\u201ecie)\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej)?\"\n    , dimension TimeGrain\n    , regex \"w(e)?|z(e)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleFromDatetimeDatetimeInterval :: Rule\nruleFromDatetimeDatetimeInterval = Rule\n  { name = \"from <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"od|p(o|\u00c3\u00b3)(z|\u00c5\u00ba)niej ni(z|\u00c5\u00bc)\"\n    , dimension Time\n    , regex \"\\\\-|do|po|a\u00c5\u00bc do|az do|a\u00c5\u00bc po|az po|ale przed\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleOrdinalAsHour :: Rule\nruleOrdinalAsHour = Rule\n  { name = \"<ordinal> (as hour)\"\n  , pattern =\n    [ Predicate $ isOrdinalBetween 1 24\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt . mkLatent $ hour True v\n      _ -> Nothing\n  }\n\nruleMonthDdddInterval :: Rule\nruleMonthDdddInterval = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ Predicate isAMonth\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , regex \"\\\\-|do|po|a\u00c5\u00bc do|az do|a\u00c5\u00bc po|az po\"\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      ( Token Time td\n       :Token RegexMatch (GroupMatch (d1:_))\n       :_\n       :Token RegexMatch (GroupMatch (d2:_))\n       :_) -> do\n        dd1 <- parseInt d1\n        dd2 <- parseInt d2\n        dom1 <- intersect (dayOfMonth dd1) td\n        dom2 <- intersect (dayOfMonth dd2) td\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleTimeAfterNext :: Rule\nruleTimeAfterNext = Rule\n  { name = \"<time> after next\"\n  , pattern =\n    [ dimension Time\n    , regex \"po kolejnym|po nast(e|\u00c4\u2122)pn(ym|y|ego|emu|(a|\u00c4\u2026)|ej|e)|po przysz(l|\u00c5\u201a)(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleTheIdesOfNamedmonth :: Rule\nruleTheIdesOfNamedmonth = Rule\n  { name = \"the ides of <named-month>\"\n  , pattern =\n    [ regex \"the ides? of\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td@TimeData {TTime.form = Just (TTime.Month m)}:_) ->\n        Token Time <$>\n          intersect (dayOfMonth $ if elem m [3, 5, 7, 10] then 15 else 13) td\n      _ -> Nothing\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"po(l|\u00c5\u201a)udni(em|e|a|u)\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleToday :: Rule\nruleToday = Rule\n  { name = \"today\"\n  , pattern =\n    [ regex \"dzisiejsz[ya\u00c4\u2026]|dzisiaj|dzi[\u00c5\u203as]|w ten dzie\u00c5\u201e|w ten dzien|w obecny dzie\u00c5\u201e|w obecny dzien|obecnego dnia\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"kolejn(ym|y|ego|emu|e)|nast(e|\u00c4\u2122)pn(ym|y|ego|emu|e|(a|\u00c4\u2026)|ej|e)\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleBetweenTimeofdayAndTimeofdayInterval :: Rule\nruleBetweenTimeofdayAndTimeofdayInterval = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(po|po )?miedzy|mi\u00c4\u2122dzy\"\n    , Predicate isATimeOfDay\n    , regex \"a|i\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNextCycle :: Rule\nruleNextCycle = Rule\n  { name = \"next <cycle>\"\n  , pattern =\n    [ regex \"kolejn(ym|y|ego|emu|(a|\u00c4\u2026)|ej|e)|nast(e|\u00c4\u2122)pn(ym|y|ego|emu|(a|\u00c4\u2026)|ej|e)|przysz(l|\u00c5\u201a)(ego|emu|ym|(a|\u00c4\u2026)|ej|ych|i|ymi|y|e)|za\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleTheCycleOfTime :: Rule\nruleTheCycleOfTime = Rule\n  { name = \"the <cycle> of <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension TimeGrain\n    , regex \"of\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleTimeofdayApproximately :: Rule\nruleTimeofdayApproximately = Rule\n  { name = \"<time-of-day> approximately\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"o?ko(l|\u00c5\u201a)o|mniej wi(e|\u00c4\u2122)cej\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleOnDate :: Rule\nruleOnDate = Rule\n  { name = \"on <date>\"\n  , pattern =\n    [ regex \"we?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekTime :: Rule\nruleLastDayofweekTime = Rule\n  { name = \"last <day-of-week> <time>\"\n  , pattern =\n    [ regex \"ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej)?\"\n    , Predicate isADayOfWeek\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleDurationFromNow :: Rule\nruleDurationFromNow = Rule\n  { name = \"<duration> from now\"\n  , pattern =\n    [ dimension Duration\n    , regex \"od (dzi(s|\u00c5\u203a)|teraz)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLunch :: Rule\nruleLunch = Rule\n  { name = \"lunch\"\n  , pattern =\n    [ regex \"(na )?la?u?nc(z|h)|obiad\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 14\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"po(l|\u00c5\u201a)udni(em|e|a|u)\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 19\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleEveningnight :: Rule\nruleEveningnight = Rule\n  { name = \"evening|night\"\n  , pattern =\n    [ regex \"wiecz[o\u00c3\u00b3]r(em|owi|ze|a|u)?|noc\u00c4\u2026?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleLastCycle :: Rule\nruleLastCycle = Rule\n  { name = \"last <cycle>\"\n  , pattern =\n    [ regex \"ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej|e)?|(po ?)?przedni(ego|ch|emu|mi|m|e|(a|\u00c4\u2026)|ej)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleHourofdayHourofdayInterval :: Rule\nruleHourofdayHourofdayInterval = Rule\n  { name = \"<hour-of-day> - <hour-of-day> (interval)\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"-|do|a\u00c5\u00bc po|po\"\n    , Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleTimeBeforeLast :: Rule\nruleTimeBeforeLast = Rule\n  { name = \"<time> before last\"\n  , pattern =\n    [ dimension Time\n    , regex \"przed ?ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth (-2) False td\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthOrdinal :: Rule\nruleNamedmonthDayofmonthOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleInduringThePartofday :: Rule\nruleInduringThePartofday = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"(w|na) ?(czas(ie)?)\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonth :: Rule\nruleDayofmonthordinalNamedmonth = Rule\n  { name = \"<day-of-month>(ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by \\\",\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"po\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) ->\n        tt $ predNthAfter (TOrdinal.value od - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleMmdd :: Rule\nruleMmdd = Rule\n  { name = \"mm/dd\"\n  , pattern =\n    [ regex \"(0?[1-9]|1[0-2])/(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleAfterDuration :: Rule\nruleAfterDuration = Rule\n  { name = \"after <duration>\"\n  , pattern =\n    [ regex \"po\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt . notLatent . withDirection TTime.After $ inDuration dd\n      _ -> Nothing\n  }\n\nruleDayofmonthOrdinalOfNamedmonth :: Rule\nruleDayofmonthOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , regex \"of|in\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleFromTimeofdayTimeofdayInterval :: Rule\nruleFromTimeofdayTimeofdayInterval = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(ni\u00c5\u00bc|niz|od)\"\n    , Predicate isATimeOfDay\n    , regex \"((but )?before)|\\\\-|do|po|a\u00c5\u00bc do|az do|a\u00c5\u00bc po|az po\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleExactlyTimeofday :: Rule\nruleExactlyTimeofday = Rule\n  { name = \"exactly <time-of-day>\"\n  , pattern =\n    [ regex \"(r(o|\u00c3\u00b3)wno|dok(l|\u00c5\u201a)adnie)( o)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleIntegerLatentTimeofday :: Rule\nruleIntegerLatentTimeofday = Rule\n  { name = \"<integer> (latent time-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ hour True v\n      _ -> Nothing\n  }\n\nruleBetweenDatetimeAndDatetimeInterval :: Rule\nruleBetweenDatetimeAndDatetimeInterval = Rule\n  { name = \"between <datetime> and <datetime> (interval)\"\n  , pattern =\n    [ regex \"(po|po )?mi(e|\u00c4\u2122)dzy\"\n    , dimension Time\n    , regex \"a|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAgo :: Rule\nruleDurationAgo = Rule\n  { name = \"<duration> ago\"\n  , pattern =\n    [ dimension Duration\n    , regex \"temu\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleByTheEndOfTime :: Rule\nruleByTheEndOfTime = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"do (ko[\u00c5\u201en]ca )?(tego)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed now td\n      _ -> Nothing\n  }\n\nruleDayBeforeYesterdaySingleWord :: Rule\nruleDayBeforeYesterdaySingleWord = Rule\n  { name = \"day-before-yesterday (single-word)\"\n  , pattern =\n    [ regex \"przedwczoraj\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day (-2)\n  }\n\nruleLastNCycle :: Rule\nruleLastNCycle = Rule\n  { name = \"last n <cycle>\"\n  , pattern =\n    [ regex \"ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej|e)?|(po ?)?przedni(ego|ch|emu|mi|m|e|(a|\u00c4\u2026)|ej)?\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleTimeofdaySharp :: Rule\nruleTimeofdaySharp = Rule\n  { name = \"<time-of-day> sharp\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"r(o|\u00c3\u00b3)wno|dok(l|\u00c5\u201a)adnie\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleWithinDuration :: Rule\nruleWithinDuration = Rule\n  { name = \"within <duration>\"\n  , pattern =\n    [ regex \"(w )?ci(a|\u00c4\u2026)gu|zakresie|obr\u00c4\u2122bie|obrebie\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        Token Time <$> interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleTimeofdayRano :: Rule\nruleTimeofdayRano = Rule\n  { name = \"<time-of-day> rano\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(z )?ran(o|a|u|em)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ timeOfDayAMPM True td\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalNamedmonth :: Rule\nruleDayofmonthNonOrdinalNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) -> Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAboutTimeofday :: Rule\nruleAboutTimeofday = Rule\n  { name = \"about <time-of-day>\"\n  , pattern =\n    [ regex \"o?ko(l|\u00c5\u201a)o|mniej wi(e|\u00c4\u2122)cej|tak o\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleUntilTimeofday :: Rule\nruleUntilTimeofday = Rule\n  { name = \"until <time-of-day>\"\n  , pattern =\n    [ regex \"(a(\u00c5\u00bc|z) )?do|przed\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt . notLatent $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleAtTimeofday :: Rule\nruleAtTimeofday = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"o|na|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"w(e)?|z(e)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:_:Token Time td2:_) -> Token Time .\n        predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimePartofday :: Rule\nruleTimePartofday = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"((wek|week|wik)(\\\\s|-)?end|wkend)\"\n    ]\n  , prod = \\_ -> tt $ mkOkForThisNext weekend\n  }\n\nruleEomendOfMonth :: Rule\nruleEomendOfMonth = Rule\n  { name = \"EOM|End of month\"\n  , pattern =\n    [ regex \"(na |w )?(koniec|ko(n|\u00c5\u201e)ca|ko(n|\u00c5\u201e)cu|ko(n|\u00c5\u201e)cowi|ko(n|\u00c5\u201e)cem|ko(n|\u00c5\u201e)c(o|\u00c3\u00b3)wke) (miesi(a|\u00c4\u2026)ca|msc)\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Month 1\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"kolejn(ym|y|ego|emu|(a|\u00c4\u2026)|ej|e)|nast(e|\u00c4\u2122)pn(ym|y|ego|emu|e|(a|\u00c4\u2026)|ej|e)|przysz(l|\u00c5\u201a)(ego|emu|ym|(a|\u00c4\u2026)|ej|ych|i|ymi|y|e)\"\n    , Predicate $ and . sequence [isNotLatent, isOkWithThisNext]\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleDayaftertomorrowSingleword :: Rule\nruleDayaftertomorrowSingleword = Rule\n  { name = \"day-after-tomorrow (single-word)\"\n  , pattern =\n    [ regex \"(po ?jutr(o|ze))\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleOrdinalQuarterYear :: Rule\nruleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:_:Token Time td:_) ->\n        tt $ cycleNthAfter False TG.Quarter (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (yy:mm:dd:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleAfterTime :: Rule\nruleTheOrdinalCycleAfterTime = Rule\n  { name = \"the <ordinal> <cycle> after <time>\"\n  , pattern =\n    [ regex \"the\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"after\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleIntersectByOfFromS :: Rule\nruleIntersectByOfFromS = Rule\n  { name = \"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"z\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNextNCycle :: Rule\nruleNextNCycle = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"kolejn(ym|y|ego|emu|(a|\u00c4\u2026)|ej|e)|nast(e|\u00c4\u2122)pn(ym|y|ego|emu|(a|\u00c4\u2026)|ej|e)\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"rano|poran(ek|ku|ka)|z rana|(s|\u00c5\u203a)witem\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 4\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"ten|tego|ta|to\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisCycle :: Rule\nruleThisCycle = Rule\n  { name = \"this <cycle>\"\n  , pattern =\n    [ regex \"te(mu|n|go|j)|tym|t(a|\u00c4\u2026)|nadchodz(a|\u00c4\u2026)c(ym|y|ego|emu|(a|\u00c4\u2026)|ej)|obecn(ym|y|emu|ego|nym|(a|\u00c4\u2026)|ej)\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"te(mu|n|go|j)|ta|to|tym|nadchodz(a|\u00c4\u2026)c(ym|y|ego|emu|(a|\u00c4\u2026)|ej)\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleDurationHence :: Rule\nruleDurationHence = Rule\n  { name = \"<duration> hence\"\n  , pattern =\n    [ dimension Duration\n    , regex \"p(o|\u00c3\u00b3)(z|\u00c5\u00ba)niej|potem\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalOfNamedmonth :: Rule\nruleDayofmonthNonOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"of|in\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleNthTimeTime :: Rule\nruleNthTimeTime = Rule\n  { name = \"nth <time> <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token Time td1:Token Time td2:_) -> Token Time .\n        predNth (TOrdinal.value od - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimeofdayPopoudniuwieczoremwNocy :: Rule\nruleTimeofdayPopoudniuwieczoremwNocy = Rule\n  { name = \"<time-of-day> popo\u00c5\u201audniu/wieczorem/w nocy\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(w )?noc(y|(a|\u00c4\u2026))|(po ?)?po(l|\u00c5\u201a)udni(em|e|a|u)|wiecz(o|\u00c3\u00b3)r(i|u|a|owi|em|rze)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ timeOfDayAMPM False td\n      _ -> Nothing\n  }\n\nruleOnANamedday :: Rule\nruleOnANamedday = Rule\n  { name = \"on a named-day\"\n  , pattern =\n    [ regex \"we?\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n         n <- getIntValue token\n         tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleYesterday :: Rule\nruleYesterday = Rule\n  { name = \"yesterday\"\n  , pattern =\n    [ regex \"wczoraj(szym|szy)?|wczrj|wczor\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleAfterTimeofday :: Rule\nruleAfterTimeofday = Rule\n  { name = \"after <time-of-day>\"\n  , pattern =\n    [ regex \"po\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleDayofmonthOrdinal :: Rule\nruleDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleOrdinalCycleAfterTime :: Rule\nruleOrdinalCycleAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"after\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleOfTime :: Rule\nruleOrdinalCycleOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"w(e)?|z(e)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleHhmm :: Rule\nruleHhmm = Rule\n  { name = \"hh:mm\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleFromHourofdayHourofdayInterval :: Rule\nruleFromHourofdayHourofdayInterval = Rule\n  { name = \"from <hour-of-day> - <hour-of-day> (interval)\"\n  , pattern =\n    [ regex \"od\"\n    , Predicate isATimeOfDay\n    , regex \"-|to|th?ru|through|until\"\n    , Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ year n\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthNonOrdinal :: Rule\nruleNamedmonthDayofmonthNonOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleHhmmMilitary :: Rule\nruleHhmmMilitary = Rule\n  { name = \"hhmm (military)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt . mkLatent $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej)?\"\n    , Predicate isADayOfWeek\n    , regex \"w(e)?|z(e)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleLastCycleTime :: Rule\nruleLastCycleTime = Rule\n  { name = \"last <cycle> <time>\"\n  , pattern =\n    [ regex \"ostatni(ego|ch|emu|mi|m|(a|\u00c4\u2026)|ej)?\"\n    , dimension TimeGrain\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleByTime :: Rule\nruleByTime = Rule\n  { name = \"by <time>\"\n  , pattern =\n    [ regex \"(a(z|\u00c5\u00bc) )?do\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Open now td\n      _ -> Nothing\n  }\n\nruleHhmmMilitaryAmpm :: Rule\nruleHhmmMilitaryAmpm = Rule\n  { name = \"hhmm (military) am|pm\"\n  , pattern =\n    [ regex \"((?:1[012]|0?\\\\d))([0-5]\\\\d)\"\n    , regex \"([ap])\\\\.?m?\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):\n       Token RegexMatch (GroupMatch (ap:_)):\n       _) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt . timeOfDayAMPM (Text.toLower ap == \"a\") $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleCycleBeforeTime :: Rule\nruleCycleBeforeTime = Rule\n  { name = \"<cycle> before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"przed\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval :: Rule\nruleTimeofdayTimeofdayInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\-|:|do|po|a\u00c5\u00bc do|az do|a\u00c5\u00bc po|az po\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAfterTime :: Rule\nruleDurationAfterTime = Rule\n  { name = \"<duration> after <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"po\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarter :: Rule\nruleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleDurationBeforeTime :: Rule\nruleDurationBeforeTime = Rule\n  { name = \"<duration> before <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"do|przed\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nruleMmddyyyy :: Rule\nruleMmddyyyy = Rule\n  { name = \"mm/dd/yyyy\"\n  , pattern =\n    [ regex \"(0?[1-9]|1[0-2])[/-](3[01]|[12]\\\\d|0?[1-9])[-/](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleEoyendOfYear :: Rule\nruleEoyendOfYear = Rule\n  { name = \"EOY|End of year\"\n  , pattern =\n    [ regex \"(na |w )?(koniec|ko(n|\u00c5\u201e)ca|ko(n|\u00c5\u201e)cu|ko(n|\u00c5\u201e)cowi|ko(n|\u00c5\u201e)cem|ko(n|\u00c5\u201e)c(o|\u00c3\u00b3)wke) (rok(u|owi|iem))\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Year 1\n  }\n\nruleTomorrow :: Rule\nruleTomorrow = Rule\n  { name = \"tomorrow\"\n  , pattern =\n    [ regex \"jutr(o|a|u|em|ze(jszy|jsza)?)|jtr|jutr\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleTimeofdayOclock :: Rule\nruleTimeofdayOclock = Rule\n  { name = \"<time-of-day> o'clock\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"godzina\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonthYear :: Rule\nruleDayofmonthordinalNamedmonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       Token Time td:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         y <- parseInt match\n         dom <- intersectDOM td token\n         Token Time <$> intersect dom (year y)\n      _ -> Nothing\n  }\n\nruleHhmmss :: Rule\nruleHhmmss = Rule\n  { name = \"hh:mm:ss\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:ss:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        s <- parseInt ss\n        tt $ hourMinuteSecond True h m s\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\n\nruleHolidays :: [Rule]\nruleHolidays =\n  mkRuleHolidays\n    [ ( \"New Year's Day\", \"nowy rok\", monthDay 1 1)\n    , ( \"Three Kings' Day\", \"((\u00c5\u203a|s)wi(e|\u00c4\u2122)to)? ?trzech kr(o|\u00c3\u00b3)li\", monthDay 1 6)\n    , ( \"Valentine's Day\", \"walentynki\", monthDay 2 14)\n    , ( \"Women's Day\", \"dzie(n|\u00c5\u201e) kobiet\", monthDay 3 8)\n    , ( \"Labour Day\", \"(s|\u00c5\u203a)wi(e|\u00c4\u2122)to pracy\", monthDay 5 1)\n    , ( \"Constitution Day\"\n      , \"(\u00c5\u203a|s)wi(e|\u00c4\u2122)to konstytucj(i|a) ?((trzeciego|3) maja)?\"\n      , monthDay 5 3\n      )\n    , ( \"Mother's Day\", \"dzie(n|\u00c5\u201e) ma(my|tki|m)\", monthDay 5 26)\n    , ( \"Father's Day\", \"dzie(n|\u00c5\u201e) (taty|ojca)\", monthDay 6 23)\n    , ( \"Assumption Day\"\n      , \"(\u00c5\u203a|s)wi(e|\u00c4\u2122)to wojska polskiego|wniebowzi(e|\u00c4\u2122)cie naj(s|\u00c5\u203a)wi(e|\u00c4\u2122)tszej maryi panny\"\n      , monthDay 8 15\n      )\n    , ( \"Halloween Day\", \"hall?owe?en( day)?\", monthDay 10 31)\n    , ( \"All Saints' Day\"\n      , \"((\u00c5\u203a|s)wi(e|\u00c4\u2122)to)? ?wszystkich (s|\u00c5\u203a)wi(e|\u00c4\u2122)tych\"\n      , monthDay 11 1\n      )\n    , ( \"Polish Independence Day\"\n      , \"(s|\u00c5\u203a)wi(e|\u00c4\u2122)t(a|o) niepodleg(l|\u00c5\u201a)o(s|\u00c5\u203a)ci|(\u00c5\u203a|s)w\\\\.? niepodleg(l|\u00c5\u201a)o(s|\u00c5\u203a)ci\"\n      , monthDay 11 11\n      )\n    , ( \"Saint Nicholas Day\", \"miko\u00c5\u201aajki\", monthDay 12 6)\n    , ( \"Christmas Eve\"\n      , \"(wigilia|wigilii|wigili(e|\u00c4\u2122)|wigili(a|\u00c4\u2026)|wigilio) ?(bo(z|\u00c5\u00bc)ego narodzenia)?\"\n      , monthDay 12 24\n      )\n    , ( \"Christmas\"\n      , \"((\u00c5\u0161|\u00c5\u203a|s)wi(e|\u00c4\u2122)ta)? ?bo(z|\u00c5\u00bc)(ym|ego|e) narodzeni(e|a|u)\"\n      , monthDay 12 25\n      )\n    , ( \"St Stephen's Day\"\n      , \"drugi dzie(n|\u00c5\u201e) (s|\u00c5\u203a)wi(a|\u00c4\u2026)t bo(z|\u00c5\u00bc)ego narodzenia\"\n      , monthDay 12 26\n      )\n    , ( \"New Year's Eve\", \"sylwester\", monthDay 12 31)\n    , ( \"Thanksgiving Day\"\n      , \"((s|\u00c5\u203a)wiet(a|o)|(dzie(n|\u00c5\u201e)))? ?dzi(e|\u00c4\u2122)kczynieni(e|a)\"\n      , nthDOWOfMonth 4 4 11\n      )\n    ]\n\nruleComputedHolidays :: [Rule]\nruleComputedHolidays =\n  mkRuleHolidays\n    [ ( \"Ash Wednesday\"\n      , \"popielec\"\n      , cycleNthAfter False TG.Day (-46) easterSunday\n      )\n    , ( \"Palm Sunday\"\n      , \"niedziela palmowa\"\n      , cycleNthAfter False TG.Day (-7) easterSunday\n      )\n    , ( \"Good Friday\"\n      , \"wielki pi(a|\u00c4\u2026)tek\"\n      , cycleNthAfter False TG.Day (-2) easterSunday\n      )\n    , ( \"Holy Saturday\"\n      , \"wielka sobota\"\n      , cycleNthAfter False TG.Day (-1) easterSunday\n      )\n    , ( \"Easter Sunday\", \"wielkanoc|niedziela wielkanocna\", easterSunday)\n    , ( \"Easter Monday\"\n      , \"poniedzia(l|\u00c5\u201a)ek wielkanocny\"\n      , cycleNthAfter False TG.Day 1 easterSunday\n      )\n    , ( \"Pentecost\"\n      , \"zielone (s|\u00c5\u203a)wi(a|\u00c4\u2026)tki|zes(l|\u00c5\u201a)anie ducha (\u00c5\u203a|s)wi(e|\u00c4\u2122)tego\"\n      , cycleNthAfter False TG.Day 49 easterSunday\n      )\n    , ( \"Corpus Christi\"\n      , \"bo(z|\u00c5\u00bc)e cia(l|\u00c5\u201a)o\"\n      , cycleNthAfter False TG.Day 60 easterSunday\n      )\n    ]\n\nruleSeasons :: [Rule]\nruleSeasons =\n  mkRuleSeasons\n    [ (\"lato\", \"lato|lata|latu|latem|lecie\", monthDay 6 21, monthDay 9 23)\n    , ( \"jesie\u00c5\u201e\"\n      , \"jesie\u00c5\u201e|jesien|jesieni|jesieni\u00c4\u2026|jesienia\"\n      , monthDay 9 23\n      , monthDay 12 21\n      )\n    , ( \"zima\"\n      , \"zima|zimy|zimie|zim\u00c4\u2122|zime|zim\u00c4\u2026|zima|zimie|zimo\"\n      , monthDay 12 21\n      , monthDay 3 20\n      )\n    , ( \"wiosna\"\n      , \"wiosna|wiosny|wio\u00c5\u203anie|wiosnie|wiosn\u00c4\u2122|wiosne|wiosn\u00c4\u2026|wiosna|wio\u00c5\u203anie|wiosnie|wiosno\"\n      , monthDay 3 20\n      , monthDay 6 21\n      )\n    ]\n\nrules :: [Rule]\nrules =\n  [ ruleAboutTimeofday\n  , ruleAbsorptionOfAfterNamedDay\n  , ruleAfterDuration\n  , ruleAfterTimeofday\n  , ruleAfternoon\n  , ruleAtTimeofday\n  , ruleBetweenDatetimeAndDatetimeInterval\n  , ruleBetweenTimeofdayAndTimeofdayInterval\n  , ruleByTheEndOfTime\n  , ruleByTime\n  , ruleCycleAfterTime\n  , ruleCycleBeforeTime\n  , ruleDatetimeDatetimeInterval\n  , ruleDayaftertomorrowSingleword\n  , ruleDayBeforeYesterdaySingleWord\n  , ruleDayofmonthNonOrdinalNamedmonth\n  , ruleDayofmonthNonOrdinalOfNamedmonth\n  , ruleDayofmonthOrdinal\n  , ruleDayofmonthOrdinalOfNamedmonth\n  , ruleDayofmonthordinalNamedmonth\n  , ruleDayofmonthordinalNamedmonthYear\n  , ruleDurationAfterTime\n  , ruleDurationAgo\n  , ruleDurationBeforeTime\n  , ruleDurationFromNow\n  , ruleDurationHence\n  , ruleEomendOfMonth\n  , ruleEoyendOfYear\n  , ruleEveningnight\n  , ruleExactlyTimeofday\n  , ruleFromDatetimeDatetimeInterval\n  , ruleFromHourofdayHourofdayInterval\n  , ruleFromTimeofdayTimeofdayInterval\n  , ruleHhmm\n  , ruleHhmmMilitary\n  , ruleHhmmMilitaryAmpm\n  , ruleHhmmss\n  , ruleHourofdayHourofdayInterval\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleHourofdayQuarter\n  , ruleHourofdayHalf\n  , ruleInDuration\n  , ruleInduringThePartofday\n  , ruleIntegerLatentTimeofday\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleIntersectByOfFromS\n  , ruleLastCycle\n  , ruleLastCycleOfTime\n  , ruleLastCycleTime\n  , ruleLastDayofweekOfTime\n  , ruleLastDayofweekTime\n  , ruleLastNCycle\n  , ruleLastTime\n  , ruleLunch\n  , ruleMmdd\n  , ruleMmddyyyy\n  , ruleMonthDdddInterval\n  , ruleMorning\n  , ruleNamedmonthDayofmonthNonOrdinal\n  , ruleNamedmonthDayofmonthOrdinal\n  , ruleNextCycle\n  , ruleNextNCycle\n  , ruleNextTime\n  , ruleNoon\n  , ruleNow\n  , ruleNthTimeAfterTime\n  , ruleNthTimeOfTime\n  , ruleNthTimeTime\n  , ruleOnANamedday\n  , ruleOnDate\n  , ruleOrdinalAsHour\n  , ruleOrdinalCycleAfterTime\n  , ruleOrdinalCycleOfTime\n  , ruleOrdinalCycleTime\n  , ruleOrdinalQuarter\n  , ruleOrdinalQuarterYear\n  , ruleRelativeMinutesAfterpastIntegerHourofday\n  , ruleQuarterAfterpastIntegerHourofday\n  , ruleHalfAfterpastIntegerHourofday\n  , ruleRelativeMinutesTotillbeforeIntegerHourofday\n  , ruleQuarterTotillbeforeIntegerHourofday\n  , ruleHalfTotillbeforeIntegerHourofday\n  , ruleTheCycleOfTime\n  , ruleTheIdesOfNamedmonth\n  , ruleTheOrdinalCycleAfterTime\n  , ruleThisCycle\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleThisnextDayofweek\n  , ruleTimeAfterNext\n  , ruleTimeBeforeLast\n  , ruleTimePartofday\n  , ruleTimeofdayApproximately\n  , ruleTimeofdayOclock\n  , ruleTimeofdayPopoudniuwieczoremwNocy\n  , ruleTimeofdayRano\n  , ruleTimeofdaySharp\n  , ruleTimeofdayTimeofdayInterval\n  , ruleToday\n  , ruleTomorrow\n  , ruleUntilTimeofday\n  , ruleWeekend\n  , ruleWithinDuration\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYesterday\n  , ruleYyyymmdd\n  , ruleTimezone\n  ]\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n  ++ ruleHolidays\n  ++ ruleSeasons\n  ++ ruleComputedHolidays\n", "num_lines": 1738}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.PT.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, examples)\n  where\n    examples =\n      [ \"no 987\"\n      , \"um\"\n      , \"um dos\"\n      , \"um dos minutos\"\n      , \"ter\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"agora\"\n             , \"j\u00c3\u00a1\"\n             , \"ja\"\n             , \"nesse instante\"\n             , \"neste instante\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"hoje\"\n             , \"nesse momento\"\n             , \"neste momento\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"ontem\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"antes de ontem\"\n             , \"anteontem\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"amanh\u00c3\u00a3\"\n             , \"amanha\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"depois de amanh\u00c3\u00a3\"\n             , \"depois de amanha\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"segunda-feira\"\n             , \"segunda feira\"\n             , \"segunda\"\n             , \"seg.\"\n             , \"seg\"\n             , \"essa segunda-feira\"\n             , \"essa segunda feira\"\n             , \"essa segunda\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"segunda, 18 de fevereiro\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"ter\u00c3\u00a7a-feira\"\n             , \"ter\u00c3\u00a7a feira\"\n             , \"ter\u00c3\u00a7a\"\n             , \"terca-feira\"\n             , \"terca feira\"\n             , \"terca\"\n             , \"ter.\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"quarta-feira\"\n             , \"quarta feira\"\n             , \"quarta\"\n             , \"qua.\"\n             , \"qua\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"quinta-feira\"\n             , \"quinta feira\"\n             , \"quinta\"\n             , \"qui.\"\n             , \"qui\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"sexta-feira\"\n             , \"sexta feira\"\n             , \"sexta\"\n             , \"sex.\"\n             , \"sex\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"s\u00c3\u00a1bado\"\n             , \"sabado\"\n             , \"s\u00c3\u00a1b.\"\n             , \"s\u00c3\u00a1b\"\n             , \"sab.\"\n             , \"sab\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"domingo\"\n             , \"dom.\"\n             , \"dom\"\n             ]\n  , examples (datetime (2013, 5, 5, 0, 0, 0) Day)\n             [ \"5 de maio\"\n             , \"5 maio\"\n             , \"05 maio\"\n             , \"cinco de maio\"\n             , \"cinco maio\"\n             , \"maio 5\"\n             , \"maio cinco\"\n             ]\n  , examples (datetime (2013, 5, 5, 0, 0, 0) Day)\n             [ \"cinco de maio de 2013\"\n             , \"5 de maio de 2013\"\n             , \"5 maio de 2013\"\n             , \"5 de maio 2013\"\n             , \"5 maio 2013\"\n             , \"5/5\"\n             , \"5/5/2013\"\n             ]\n  , examples (datetime (2013, 7, 4, 0, 0, 0) Day)\n             [ \"4 de julho\"\n             , \"04 de julho\"\n             , \"04 julho\"\n             , \"quatro de julho\"\n             , \"quatro julho\"\n             , \"julho 4\"\n             , \"julho quatro\"\n             , \"4/7\"\n             , \"4/7/2013\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"3 de mar\u00c3\u00a7o\"\n             , \"tr\u00c3\u00aas de mar\u00c3\u00a7o\"\n             , \"tres de mar\u00c3\u00a7o\"\n             , \"3/3\"\n             , \"3/3/2013\"\n             ]\n  , examples (datetime (2013, 4, 5, 0, 0, 0) Day)\n             [ \"5 de abril\"\n             , \"cinco de abril\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"1 de mar\u00c3\u00a7o\"\n             , \"primeiro de mar\u00c3\u00a7o\"\n             , \"um de mar\u00c3\u00a7o\"\n             , \"1o de mar\u00c3\u00a7o\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"1-3-2013\"\n             , \"1.3.2013\"\n             , \"1/3/2013\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"essa dia 16\"\n             , \"16 de fevereiro\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"este dia 17\"\n             , \"17 de fevereiro\"\n             , \"17/2\"\n             , \"no domingo\"\n             , \"no dia 17\"\n             , \"dia 17\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"esse dia 20\"\n             , \"20 de fevereiro\"\n             , \"20/2\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"pr\u00c3\u00b3xima ter\u00c3\u00a7a-feira\"\n             , \"pr\u00c3\u00b3xima ter\u00c3\u00a7a feira\"\n             , \"pr\u00c3\u00b3xima ter\u00c3\u00a7a\"\n             , \"proxima ter\u00c3\u00a7a-feira\"\n             , \"proxima ter\u00c3\u00a7a feira\"\n             , \"proxima ter\u00c3\u00a7a\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"quarta que vem\"\n             , \"quarta da semana que vem\"\n             , \"quarta da pr\u00c3\u00b3xima semana\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"ter\u00c3\u00a7a desta semana\"\n             , \"ter\u00c3\u00a7a dessa semana\"\n             , \"ter\u00c3\u00a7a agora\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"esta semana\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"semana passada\"\n             , \"semana anterior\"\n             , \"passada semana\"\n             , \"anterior semana\"\n             , \"\u00c3\u00baltima semana\"\n             , \"ultima semana\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"semana que vem\"\n             , \"proxima semana\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"m\u00c3\u00aas passado\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"mes que vem\"\n             , \"pr\u00c3\u00b3ximo m\u00c3\u00aas\"\n             ]\n  , examples (datetime (2012, 0, 0, 0, 0, 0) Year)\n             [ \"ano passado\"\n             ]\n  , examples (datetime (2013, 0, 0, 0, 0, 0) Year)\n             [ \"este ano\"\n             ]\n  , examples (datetime (2014, 0, 0, 0, 0, 0) Year)\n             [ \"ano que vem\"\n             , \"proximo ano\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"domingo passado\"\n             , \"domingo da semana passada\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"ter\u00c3\u00a7a passada\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"\u00c3\u00a0s tres da tarde\"\n             , \"\u00c3\u00a0s tres\"\n             , \"\u00c3\u00a0s 3 pm\"\n             , \"\u00c3\u00a0s 15 horas\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"\u00c3\u00a0s oito da noite\"\n             ]\n  , examples (datetime (2013, 2, 13, 20, 0, 0) Hour)\n             [ \"amanh\u00c3\u00a3 \u00c3\u00a0s oito da noite\"\n             ]\n  , examples (datetime (2013, 2, 15, 18, 0, 0) Hour)\n             [ \"no dia 15 \u00c3\u00a0s 18\"\n             , \"dia 15 \u00c3\u00a0s 18\"\n             , \"dia 15 \u00c3\u00a0s 18 horas\"\n             , \"dia 15 \u00c3\u00a0s dezoito\"\n             , \"dia quinze \u00c3\u00a0s dezoito\"\n             ]\n  , examples (datetime (2013, 2, 14, 18, 0, 0) Hour)\n             [ \"quinta-feira \u00c3\u00a0s 18 horas\"\n             , \"quinta \u00c3\u00a0s 18\"\n             ]\n  , examples (datetime (2013, 2, 15, 18, 15, 0) Minute)\n             [ \"dia 15 de Fevereiro \u00c3\u00a0s 18:15\"\n             , \"dia 15 \u00c3\u00a0s 18:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Minute)\n             [ \"15:00\"\n             , \"15.00\"\n             , \"\u00c3\u00a0s 15:00\"\n             , \"\u00c3\u00a0s 15.00\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"meianoite\"\n             , \"meia noite\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 0, 0) Hour)\n             [ \"meio dia\"\n             , \"meiodia\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 15, 0) Minute)\n             [ \"meio dia e quinze\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 55, 0) Minute)\n             [ \"5 para meio dia\"\n             ]\n  , examples (datetime (2013, 2, 12, 12, 30, 0) Minute)\n             [ \"meio dia e meia\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 0, 0) Hour)\n             [ \"as seis da manha\"\n             , \"as seis pela manha\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"\u00c3\u00a0s tres e quinze\"\n             , \"\u00c3\u00a0s tres e quinze da tarde\"\n             , \"\u00c3\u00a0s tres e quinze pela tarde\"\n             , \"15:15\"\n             , \"15.15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"\u00c3\u00a0s tres e meia\"\n             , \"\u00c3\u00a0s 3 e trinta\"\n             , \"\u00c3\u00a0s tres e meia da tarde\"\n             , \"\u00c3\u00a0s 3 e trinta da tarde\"\n             , \"15:30\"\n             , \"15.30\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"quinze para meio dia\"\n             , \"quinze para o meio dia\"\n             , \"11:45\"\n             , \"as onze e quarenta e cinco\"\n             , \"hoje quinze para o meio dia\"\n             , \"hoje \u00c3\u00a0s onze e quarenta e cinco\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 15, 0) Minute)\n             [ \"5 e quinze\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 0, 0) Hour)\n             [ \"6 da manh\u00c3\u00a3\"\n             ]\n  , examples (datetime (2013, 2, 13, 11, 0, 0) Hour)\n             [ \"quarta \u00c3\u00a0s onze da manh\u00c3\u00a3\"\n             ]\n  , examples (datetime (2014, 9, 12, 0, 0, 0) Day)\n             [ \"sexta, 12 de setembro de 2014\"\n             , \"sexta feira, 12 de setembro de 2014\"\n             , \"12 de setembro de 2014, sexta\"\n             , \"12 de setembro de 2014 sexta feira\"\n             , \"sexta feira 12 de setembro de 2014\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"em um segundo\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"em um minuto\"\n             , \"em 1 min\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"em 2 minutos\"\n             , \"em dois minutos\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"em 60 minutos\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"em uma hora\"\n             ]\n  , examples (datetime (2013, 2, 12, 2, 30, 0) Minute)\n             [ \"fazem duas horas\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"em 24 horas\"\n             , \"em vinte e quatro horas\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"em um dia\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"em 7 dias\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"em uma semana\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"faz tres semanas\"\n             , \"faz tr\u00c3\u00aas semanas\"\n             ]\n  , examples (datetime (2013, 4, 12, 0, 0, 0) Day)\n             [ \"em dois meses\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"faz tres meses\"\n             ]\n  , examples (datetime (2014, 2, 0, 0, 0, 0) Month)\n             [ \"em um ano\"\n             , \"em 1 ano\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"faz dois anos\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"este ver\u00c3\u00a3o\"\n             , \"este verao\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"este inverno\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"Natal\"\n             ]\n  , examples (datetime (2013, 12, 31, 0, 0, 0) Day)\n             [ \"v\u00c3\u00a9spera de ano novo\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"ano novo\"\n             , \"reveillon\"\n             , \"Reveillon\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"esta noite\"\n             , \"essa noite\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"amanh\u00c3\u00a3 a noite\"\n             , \"amanh\u00c3\u00a3 \u00c3\u00a0 noite\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"ontem a noite\"\n             , \"ontem \u00c3\u00a0 noite\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 19, 0, 0)) Hour)\n             [ \"amanh\u00c3\u00a3 a tarde\"\n             , \"amanh\u00c3\u00a3 \u00c3\u00a0 tarde\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 12, 0, 0), (2013, 2, 11, 19, 0, 0)) Hour)\n             [ \"ontem a tarde\"\n             , \"ontem \u00c3\u00a0 tarde\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"este final de semana\"\n             , \"este fim de semana\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"segunda de manh\u00c3\u00a3\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 4, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"dia 15 de fevereiro pela manh\u00c3\u00a3\"\n             , \"dia 15 de fevereiro de manh\u00c3\u00a3\"\n             ]\n  , examples (datetime (2013, 2, 12, 20, 0, 0) Hour)\n             [ \"\u00c3\u00a0s 8 da noite\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"2 segundos atras\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"proximos 3 segundos\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"2 minutos atr\u00c3\u00a1s\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"proximos 3 minutos\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"proximas 3 horas\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"passados 2 dias\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"proximos 3 dias\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"duas semanas atras\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"3 proximas semanas\"\n             , \"3 semanas que vem\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"passados 2 meses\"\n             , \"\u00c3\u00baltimos 2 meses\"\n             , \"2 meses anteriores\"\n             , \"2 \u00c3\u00baltimos meses\"\n             , \"2 anteriores meses\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"3 pr\u00c3\u00b3ximos meses\"\n             , \"proximos tres meses\"\n             , \"tres meses que vem\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"passados 2 anos\"\n              , \"\u00c3\u00baltimos 2 anos\"\n              , \"2 anos anteriores\"\n              , \"2 \u00c3\u00baltimos anos\"\n              , \"2 anteriores anos\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"3 pr\u00c3\u00b3ximos anos\"\n             , \"proximo tres anos\"\n             , \"3 anos que vem\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13 a 15 de julho\"\n             , \"13 - 15 de julho de 2013\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 12, 21, 0, 0, 0), (2014, 1, 7, 0, 0, 0)) Day)\n             [ \"21 de Dez. a 6 de Jan\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 12, 7, 30, 0)) Second)\n             [ \"dentro de tres horas\"\n             ]\n  , examples (datetime (2013, 2, 12, 16, 0, 0) Hour)\n             [ \"as quatro da tarde\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"as quatro CET\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 12, 0, 0) Hour)\n             [ \"ap\u00c3\u00b3s ao meio dia\"\n             , \"depois do meio dia\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 12, 0, 0) Hour)\n             [ \"antes do meio dia\"\n             , \"n\u00c3\u00a3o mais que meio dia\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 13, 15, 0, 0) Hour)\n             [ \"amanh\u00c3\u00a3 depois das 15hs\"\n             , \"amanha ap\u00c3\u00b3s as quinze horas\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 13, 0, 0, 0) Hour)\n             [ \"antes da meia noite\"\n             , \"at\u00c3\u00a9 a meia noite\"\n             ]\n ,examples (datetime (2013, 2, 12, 3, 0, 0) Hour)\n             [ \"\u00c3\u00baltima hora\"\n             , \"hora anterior\"\n             , \"hora passada\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"este trimestre\"\n             , \"trimestre actual\"\n             , \"trimestre atual\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Month)\n             [ \"primeiro m\u00c3\u00aas de 2013\"\n             , \"primeiro m\u00c3\u00aas 2013\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"pr\u00c3\u00b3ximo trimestre\"\n             , \"segundo trimestre de 2013\"\n             , \"segundo trimestre\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"terceiro trimestre\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"quarto trimestre de 2018\"\n             , \"quarto trimestre 2018\"\n             ]\n  , examples (datetime (2012, 10, 1, 0, 0, 0) Quarter)\n             [ \"trimestre passado\"\n             , \"trimestre anterior\"\n             , \"\u00c3\u00baltimo trimestre\"\n             , \"ultimo trimestre\"\n             ]\n  , examples (datetime (2013, 12, 1, 0, 0, 0) Month)\n             [ \"d\u00c3\u00a9cimo segundo m\u00c3\u00aas de 2013\"\n             , \"\u00c3\u00baltimo m\u00c3\u00aas de 2013\"\n             , \"\u00c3\u00baltimo m\u00c3\u00aas 2013\"\n             ]\n  , examples (datetime (2015, 10, 1, 0, 0, 0) Quarter)\n             [ \"\u00c3\u00baltimo trimestre de 2015\"\n             , \"\u00c3\u00baltimo trimestre 2015\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"desde 13 a 15 de Julho\"\n             , \"a partir de 13 at\u00c3\u00a9 15 de Julho\"\n             , \"desde 13 at\u00c3\u00a9 15 de Julho\"\n             , \"13-15 de Julho\"\n             , \"13 at\u00c3\u00a9 15 de Julho\"\n             , \"13 a 15 de Julho\"\n             , \"desde 13 a 15 Julho\"\n             , \"a partir de 13 at\u00c3\u00a9 15 Julho\"\n             , \"desde 13 at\u00c3\u00a9 15 Julho\"\n             , \"13-15 Julho\"\n             , \"13 at\u00c3\u00a9 15 Julho\"\n             , \"13 a 15 Julho\"\n             ]\n  , examples (datetimeInterval ((2017, 1, 1, 0, 0, 0), (2017, 10, 1, 0, 0, 0)) Quarter)\n             [ \"de primeiro trimestre de 2017 at\u00c3\u00a9 terceiro trimestre de 2017\"\n             , \"de primeiro trimestre de 2017 at\u00c3\u00a9 ao terceiro trimestre de 2017\"\n             , \"do primeiro trimestre de 2017 at\u00c3\u00a9 terceiro trimestre de 2017\"\n             , \"do primeiro trimestre de 2017 at\u00c3\u00a9 ao terceiro trimestre de 2017\"\n             , \"desde primeiro trimestre de 2017 at\u00c3\u00a9 terceiro trimestre de 2017\"\n             , \"desde primeiro trimestre de 2017 at\u00c3\u00a9 ao terceiro trimestre de 2017\"\n             , \"a partir do primeiro trimestre de 2017 at\u00c3\u00a9 terceiro trimestre de 2017\"\n             , \"a partir do primeiro trimestre de 2017 at\u00c3\u00a9 ao terceiro trimestre de 2017\"\n             , \"a partir de primeiro trimestre de 2017 at\u00c3\u00a9 terceiro trimestre de 2017\"\n             , \"a partir de primeiro trimestre de 2017 at\u00c3\u00a9 ao terceiro trimestre de 2017\"\n             , \"primeiro trimestre de 2017 a terceiro trimestre de 2017\"\n             , \"primeiro trimestre de 2017 ao terceiro trimestre de 2017\"\n             , \"primeiro trimestre de 2017 - terceiro trimestre de 2017\"\n             , \"entre primeiro trimestre de 2017 e terceiro trimestre de 2017\"\n             , \"entre o primeiro trimestre de 2017 e terceiro trimestre de 2017\"\n             , \"primeiro trimestre de 2017 at\u00c3\u00a9 terceiro trimestre de 2017\"\n             , \"primeiro trimestre de 2017 at\u00c3\u00a9 ao terceiro trimestre de 2017\"\n             , \"primeiro trimestre 2017 a terceiro trimestre 2017\"\n             , \"primeiro trimestre 2017 ao terceiro trimestre 2017\"\n             , \"primeiro trimestre 2017 - terceiro trimestre 2017\"\n             , \"primeiro trimestre 2017 at\u00c3\u00a9 terceiro trimestre 2017\"\n             , \"primeiro trimestre 2017 at\u00c3\u00a9 ao terceiro trimestre 2017\"\n             , \"entre primeiro trimestre 2017 e terceiro trimestre 2017\"\n             , \"entre o primeiro trimestre 2017 e terceiro trimestre 2017\"\n             ]\n  , examples (datetimeInterval ((2017, 3, 1, 0, 0, 0), (2017, 10, 1, 0, 0, 0)) Month)\n              [ \"de terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 nono m\u00c3\u00aas de 2017\"\n              , \"de terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 ao nono m\u00c3\u00aas de 2017\"\n              , \"do terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 nono m\u00c3\u00aas de 2017\"\n              , \"do terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 ao nono m\u00c3\u00aas de 2017\"\n              , \"desde terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 nono m\u00c3\u00aas de 2017\"\n              , \"desde terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 ao nono m\u00c3\u00aas de 2017\"\n              , \"a partir do terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 nono m\u00c3\u00aas de 2017\"\n              , \"a partir do terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 ao nono m\u00c3\u00aas de 2017\"\n              , \"a partir de terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 nono m\u00c3\u00aas de 2017\"\n              , \"a partir de terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 ao nono m\u00c3\u00aas de 2017\"\n              , \"terceiro m\u00c3\u00aas de 2017 a nono m\u00c3\u00aas de 2017\"\n              , \"terceiro m\u00c3\u00aas de 2017 ao nono m\u00c3\u00aas de 2017\"\n              , \"terceiro m\u00c3\u00aas de 2017 - nono m\u00c3\u00aas de 2017\"\n              , \"entre terceiro m\u00c3\u00aas de 2017 e nono m\u00c3\u00aas de 2017\"\n              , \"entre o terceiro m\u00c3\u00aas de 2017 e nono m\u00c3\u00aas de 2017\"\n              , \"terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 nono m\u00c3\u00aas de 2017\"\n              , \"terceiro m\u00c3\u00aas de 2017 at\u00c3\u00a9 ao nono m\u00c3\u00aas de 2017\"\n              , \"terceiro m\u00c3\u00aas 2017 a nono m\u00c3\u00aas 2017\"\n              , \"terceiro m\u00c3\u00aas 2017 ao nono m\u00c3\u00aas 2017\"\n              , \"terceiro m\u00c3\u00aas 2017 - nono m\u00c3\u00aas 2017\"\n              , \"terceiro m\u00c3\u00aas 2017 at\u00c3\u00a9 nono m\u00c3\u00aas 2017\"\n              , \"terceiro m\u00c3\u00aas 2017 at\u00c3\u00a9 ao nono m\u00c3\u00aas 2017\"\n              , \"entre terceiro m\u00c3\u00aas 2017 e nono m\u00c3\u00aas 2017\"\n              , \"entre o terceiro m\u00c3\u00aas 2017 e nono m\u00c3\u00aas 2017\"\n              ]\n  ]\n", "num_lines": 643}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.PT.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Types\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleSHourmintimeofday :: Rule\nruleSHourmintimeofday = Rule\n  { name = \"\u00c3\u00a0s <hour-min>(time-of-day)\"\n  , pattern =\n    [ regex \"(\u00c3\u00a0|a)s?\"\n    , Predicate isATimeOfDay\n    , regex \"horas?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleTheDayAfterTomorrow :: Rule\nruleTheDayAfterTomorrow = Rule\n  { name = \"the day after tomorrow\"\n  , pattern =\n    [ regex \"depois de amanh(\u00c3\u00a3|a)\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleNatal :: Rule\nruleNatal = Rule\n  { name = \"natal\"\n  , pattern =\n    [ regex \"natal\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleNaoDate :: Rule\nruleNaoDate = Rule\n  { name = \"n[ao] <date>\"\n  , pattern =\n    [ regex \"n[ao]\"\n    , Predicate $ isGrainOfTime TG.Day\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleIntersectByDaOrDe :: Rule\nruleIntersectByDaOrDe = Rule\n  { name = \"intersect by `da` or `de`\"\n  , pattern =\n    [ dimension Time\n    , regex \"d[ae]\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) -> Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nrulePassadosNCycle :: Rule\nrulePassadosNCycle = Rule\n  { name = \"passados n <cycle>\"\n  , pattern =\n    [ regex \"(passad|[\u00c3\u00bau]ltim)[ao]s?\"\n    , Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (-v)\n      _ -> Nothing\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"[\u00c3\u00bau]ltim[ao]s?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|at\u00c3\u00a9( ao?)?|ao?\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDeDatetimeDatetimeInterval :: Rule\nruleDeDatetimeDatetimeInterval = Rule\n  { name = \"de <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"de?\"\n    , Predicate isATimeOfDay\n    , regex \"\\\\-|at\u00c3\u00a9( ao?)?|ao?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEvening :: Rule\nruleEvening = Rule\n  { name = \"evening\"\n  , pattern =\n    [ regex \"noite\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDayOfMonthSt :: Rule\nruleDayOfMonthSt = Rule\n  { name = \"day of month (1st)\"\n  , pattern =\n    [ regex \"primeiro|um|1o\"\n    ]\n  , prod = \\_ -> tt . mkLatent $ dayOfMonth 1\n  }\n\nruleNow :: Rule\nruleNow = Rule\n  { name = \"now\"\n  , pattern =\n    [ regex \"(hoje)|(neste|nesse) momento\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleDimTimeDaMadrugada :: Rule\nruleDimTimeDaMadrugada = Rule\n  { name = \"<dim time> da madrugada\"\n  , pattern =\n    [ dimension Time\n    , regex \"(da|na|pela) madruga(da)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> do\n        td2 <- mkLatent . partOfDay <$>\n          interval TTime.Open (hour False 1) (hour False 4)\n        Token Time <$> intersect td td2\n      _ -> Nothing\n  }\n\nruleHhhmmTimeofday :: Rule\nruleHhhmmTimeofday = Rule\n  { name = \"hh(:|.|h)mm (time-of-day)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:h\\\\.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleProximoCycle :: Rule\nruleProximoCycle = Rule\n  { name = \"proximo <cycle> \"\n  , pattern =\n    [ regex \"pr(\u00c3\u00b3|o)xim(o|a)s?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleCycleAntesDeTime :: Rule\nruleCycleAntesDeTime = Rule\n  { name = \"<cycle> antes de <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"antes d[eo]\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleEsteCycle :: Rule\nruleEsteCycle = Rule\n  { name = \"este <cycle>\"\n  , pattern =\n    [ regex \"(n?es[st](es?|as?))\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleCycleActual :: Rule\nruleCycleActual = Rule\n  { name = \"<cycle> actual\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"ac?tual\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) -> tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleSHourminTimeofday :: Rule\nruleSHourminTimeofday = Rule\n  { name = \"\u00c3\u00a0s <hour-min> <time-of-day>\"\n  , pattern =\n    [ regex \"[\u00c3\u00a0a]s\"\n    , Predicate isNotLatent\n    , regex \"da\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) -> Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleSeason4 :: Rule\nruleSeason4 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"primavera\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 3 20\n          to = monthDay 6 21\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleDiaDayofmonthDeNamedmonth :: Rule\nruleDiaDayofmonthDeNamedmonth = Rule\n  { name = \"dia <day-of-month> de <named-month>\"\n  , pattern =\n    [ regex \"dia\"\n    , Predicate isDOMInteger\n    , regex \"de|\\\\/\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"meio[\\\\s\\\\-]?dia\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleProximasNCycle :: Rule\nruleProximasNCycle = Rule\n  { name = \"proximas n <cycle>\"\n  , pattern =\n    [ regex \"pr(\u00c3\u00b3|o)xim(o|a)s?\"\n    , Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"es[ts][ae]|pr(\u00c3\u00b3|o)xim[ao]\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleTheDayBeforeYesterday :: Rule\nruleTheDayBeforeYesterday = Rule\n  { name = \"the day before yesterday\"\n  , pattern =\n    [ regex \"anteontem|antes de ontem\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 2\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\nruleHourofdayAndRelativeMinutes :: Rule\nruleHourofdayAndRelativeMinutes = Rule\n  { name = \"<hour-of-day> and <relative minutes>\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e\"\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleIntegerParaAsHourofdayAsRelativeMinutes :: Rule\nruleIntegerParaAsHourofdayAsRelativeMinutes = Rule\n  { name = \"<integer> para as <hour-of-day> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"para ((o|a|\u00c3\u00a0)s?)?\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes2 :: Rule\nruleHourofdayIntegerAsRelativeMinutes2 = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes) minutos\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min\\\\.?(uto)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdayAndRelativeMinutes2 :: Rule\nruleHourofdayAndRelativeMinutes2 = Rule\n  { name = \"<hour-of-day> and <relative minutes> minutos\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e\"\n    , Predicate $ isIntegerBetween 1 59\n    , regex \"min\\\\.?(uto)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleIntegerParaAsHourofdayAsRelativeMinutes2 :: Rule\nruleIntegerParaAsHourofdayAsRelativeMinutes2 = Rule\n  { name = \"<integer> minutos para as <hour-of-day> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"min\\\\.?(uto)?s?\"\n    , regex \"para ((o|a|\u00c3\u00a0)s?)?\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleHourofdayQuarter :: Rule\nruleHourofdayQuarter = Rule\n  { name = \"<hour-of-day> quarter (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"quinze\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayAndQuarter :: Rule\nruleHourofdayAndQuarter = Rule\n  { name = \"<hour-of-day> and quinze\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e quinze\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleQuarterParaAsHourofdayAsRelativeMinutes :: Rule\nruleQuarterParaAsHourofdayAsRelativeMinutes = Rule\n  { name = \"quinze para as <hour-of-day> (as relative minutes)\"\n  , pattern =\n    [ regex \"quinze para ((o|a|\u00c3\u00a0)s?)?\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleHourofdayHalf :: Rule\nruleHourofdayHalf = Rule\n  { name = \"<hour-of-day> half (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"meia|trinta\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleHourofdayAndHalf :: Rule\nruleHourofdayAndHalf = Rule\n  { name = \"<hour-of-day> and half\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e (meia|trinta)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleHalfParaAsHourofdayAsRelativeMinutes :: Rule\nruleHalfParaAsHourofdayAsRelativeMinutes = Rule\n  { name = \"half para as <hour-of-day> (as relative minutes)\"\n  , pattern =\n    [ regex \"(meia|trinta) para ((o|a|\u00c3\u00a0)s?)?\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleHourofdayThreeQuarter :: Rule\nruleHourofdayThreeQuarter = Rule\n  { name = \"<hour-of-day> 3/4 (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"quarenta e cinco\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 45\n      _ -> Nothing\n  }\n\nruleHourofdayAndThreeQuarter :: Rule\nruleHourofdayAndThreeQuarter = Rule\n  { name = \"<hour-of-day> and 3/4\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"e quarenta e cinco\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 45\n      _ -> Nothing\n  }\n\nruleThreeQuarterParaAsHourofdayAsRelativeMinutes :: Rule\nruleThreeQuarterParaAsHourofdayAsRelativeMinutes = Rule\n  { name = \"3/4 para as <hour-of-day> (as relative minutes)\"\n  , pattern =\n    [ regex \"quarenta e cinco para ((o|a|\u00c3\u00a0)s?)?\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> minutesBefore 45 td\n      _ -> Nothing\n  }\n\nruleTiradentes :: Rule\nruleTiradentes = Rule\n  { name = \"Tiradentes\"\n  , pattern =\n    [ regex \"tiradentes\"\n    ]\n  , prod = \\_ -> tt $ monthDay 4 21\n  }\n\nruleInThePartofday :: Rule\nruleInThePartofday = Rule\n  { name = \"in the <part-of-day>\"\n  , pattern =\n    [ regex \"(de|pela|a|\u00c3\u00a0)\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nrulePartofdayDessaSemana :: Rule\nrulePartofdayDessaSemana = Rule\n  { name = \"<part-of-day> dessa semana\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"(d?es[ts]a semana)|agora\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleDepoisDasTimeofday :: Rule\nruleDepoisDasTimeofday = Rule\n  { name = \"depois das <time-of-day>\"\n  , pattern =\n    [ regex \"(depois|ap(\u00c3\u00b3|o)s) d?((a|\u00c3\u00a1|\u00c3\u00a0)[so]?|os?)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd[/-]mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\/\\\\-](0?[1-9]|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleEmDuration :: Rule\nruleEmDuration = Rule\n  { name = \"em <duration>\"\n  , pattern =\n    [ regex \"em\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"tarde\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 19\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDimTimeDaManha :: Rule\nruleDimTimeDaManha = Rule\n  { name = \"<dim time> da manha\"\n  , pattern =\n    [ Predicate $ isGrainFinerThan TG.Year\n    , regex \"(da|na|pela) manh(\u00c3\u00a3|a)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> do\n        td2 <- mkLatent . partOfDay <$>\n          interval TTime.Open (hour False 4) (hour False 12)\n        Token Time <$> intersect td td2\n      _ -> Nothing\n  }\n\nruleNCycleProximoqueVem :: Rule\nruleNCycleProximoqueVem = Rule\n  { name = \"n <cycle> (proximo|que vem)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"(pr(\u00c3\u00b3|o)xim(o|a)s?|que vem?|seguintes?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleMidnight :: Rule\nruleMidnight = Rule\n  { name = \"midnight\"\n  , pattern =\n    [ regex \"meia[\\\\s\\\\-]?noite\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleDdddMonthinterval :: Rule\nruleDdddMonthinterval = Rule\n  { name = \"dd-dd <month>(interval)\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , regex \"\\\\-|a\"\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , regex \"de\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (m2:_)):\n       _:\n       Token Time td:\n       _) -> do\n        d1 <- parseInt m1\n        d2 <- parseInt m2\n        from <- intersect (dayOfMonth d1) td\n        to <- intersect (dayOfMonth d2) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ hour True v\n      _ -> Nothing\n  }\n\nruleUltimoTime :: Rule\nruleUltimoTime = Rule\n  { name = \"ultimo <time>\"\n  , pattern =\n    [ regex \"(u|\u00c3\u00ba)ltimo\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleNamedmonthnameddayPast :: Rule\nruleNamedmonthnameddayPast = Rule\n  { name = \"<named-month|named-day> past\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"(da semana)? passad(o|a)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleSeason3 :: Rule\nruleSeason3 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"inverno\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 12 21\n          to = monthDay 3 20\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleSeason :: Rule\nruleSeason = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"ver(\u00c3\u00a3|a)o\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 6 21\n          to = monthDay 9 23\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleRightNow :: Rule\nruleRightNow = Rule\n  { name = \"right now\"\n  , pattern =\n    [ regex \"agora|j(\u00c3\u00a1|a)|(nesse|neste) instante\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleFazemDuration :: Rule\nruleFazemDuration = Rule\n  { name = \"fazem <duration>\"\n  , pattern =\n    [ regex \"faz(em)?\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleAmanhPelaPartofday :: Rule\nruleAmanhPelaPartofday = Rule\n  { name = \"amanh\u00c3\u00a3 pela <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , regex \"(da|na|pela|a)\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleHhmmMilitaryTimeofday :: Rule\nruleHhmmMilitaryTimeofday = Rule\n  { name = \"hhmm (military time-of-day)\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt . mkLatent $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleNamedmonthnameddayNext :: Rule\nruleNamedmonthnameddayNext = Rule\n  { name = \"<named-month|named-day> next\"\n  , pattern =\n    [ dimension Time\n    , regex \"(da pr(o|\u00c3\u00b3)xima semana)|(da semana)? que vem\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 1 False td\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleTimeofdayPartofday :: Rule\nruleTimeofdayPartofday = Rule\n  { name = \"<time-of-day> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , regex \"(da|na|pela)\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleDentroDeDuration :: Rule\nruleDentroDeDuration = Rule\n  { name = \"dentro de <duration>\"\n  , pattern =\n    [ regex \"(dentro de)|em\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        Token Time <$> interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleSTimeofday :: Rule\nruleSTimeofday = Rule\n  { name = \"\u00c3\u00a0s <time-of-day>\"\n  , pattern =\n    [ regex \"(\u00c3\u00a0|a)s?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDimTimeDaTarde :: Rule\nruleDimTimeDaTarde = Rule\n  { name = \"<dim time> da tarde\"\n  , pattern =\n    [ dimension Time\n    , regex \"(da|na|pela) tarde\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> do\n        td2 <- mkLatent . partOfDay <$>\n          interval TTime.Open (hour False 12) (hour False 18)\n        Token Time <$> intersect td td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"final de semana|fim de semana|fds\"\n    ]\n  , prod = \\_ -> tt weekend\n  }\n\nruleDayofweekSHourmin :: Rule\nruleDayofweekSHourmin = Rule\n  { name = \"<day-of-week> \u00c3\u00a0s <hour-min>\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(\u00c3\u00a0|a)s\"\n    , Predicate isNotLatent\n    , regex \"da|pela\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_:Token Time td3:_) -> do\n        td <- intersect td1 td2\n        Token Time <$> intersect td td3\n      _ -> Nothing\n  }\n\nruleCycleQueVem :: Rule\nruleCycleQueVem = Rule\n  { name = \"<cycle> (que vem)\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"que vem|seguintes?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) -> tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleAnoNovo :: Rule\nruleAnoNovo = Rule\n  { name = \"ano novo\"\n  , pattern =\n    [ regex \"ano novo|reveillon\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 1\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"(d[ao]) pr(\u00c3\u00b3|o)xim[ao]s?|que vem\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleDeYear :: Rule\nruleDeYear = Rule\n  { name = \"de <year>\"\n  , pattern =\n    [ regex \"de|do ano\"\n    , Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt $ year n\n      _ -> Nothing\n  }\n\nruleVesperaDeAnoNovo :: Rule\nruleVesperaDeAnoNovo = Rule\n  { name = \"vespera de ano novo\"\n  , pattern =\n    [ regex \"v(\u00c3\u00a9|e)spera d[eo] ano[\\\\s\\\\-]novo\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 31\n  }\n\nruleNPassadosCycle :: Rule\nruleNPassadosCycle = Rule\n  { name = \"n passados <cycle>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , regex \"(passad|[\u00c3\u00bau]ltim)[ao]s?|anterior(es)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleNCyclePassados :: Rule\nruleNCyclePassados = Rule\n  { name = \"n <cycle> passados\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"(passad|[\u00c3\u00bau]ltim)[ao]s?|anterior(es)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token: Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleDiaDayofmonthNonOrdinal :: Rule\nruleDiaDayofmonthNonOrdinal = Rule\n  { name = \"dia <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"dia\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (yy:mm:dd:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTimeofdayHoras :: Rule\nruleTimeofdayHoras = Rule\n  { name = \"<time-of-day> horas\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"h\\\\.?(ora)?s?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleTwoTimeTokensSeparatedBy :: Rule\nruleTwoTimeTokensSeparatedBy = Rule\n  { name = \"two time tokens separated by \\\",\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleTwoTimeTokensSeparatedBy2 :: Rule\nruleTwoTimeTokensSeparatedBy2 = Rule\n  { name = \"two time tokens separated by \\\",\\\"2\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"manh(\u00c3\u00a3|a)\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 4\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"es[ts]a\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"es[ts][ae]\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleProclamaoDaRepblica :: Rule\nruleProclamaoDaRepblica = Rule\n  { name = \"Proclama\u00c3\u00a7\u00c3\u00a3o da Rep\u00c3\u00bablica\"\n  , pattern =\n    [ regex \"proclama(c|\u00c3\u00a7)(a|\u00c3\u00a3)o da rep(\u00c3\u00ba|u)blica\"\n    ]\n  , prod = \\_ -> tt $ monthDay 11 15\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ year n\n      _ -> Nothing\n  }\n\nruleYesterday :: Rule\nruleYesterday = Rule\n  { name = \"yesterday\"\n  , pattern =\n    [ regex \"ontem\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleSeason2 :: Rule\nruleSeason2 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"outono\"\n    ]\n  , prod = \\_ ->\n      let from = monthDay 9 23\n          to = monthDay 12 21\n      in Token Time <$> interval TTime.Open from to\n  }\n\nruleDiaDoTrabalhador :: Rule\nruleDiaDoTrabalhador = Rule\n  { name = \"Dia do trabalhador\"\n  , pattern =\n    [ regex \"dia do trabalh(o|ador)\"\n    ]\n  , prod = \\_ -> tt $ monthDay 5 1\n  }\n\nruleNCycleAtras :: Rule\nruleNCycleAtras = Rule\n  { name = \"n <cycle> atras\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , dimension TimeGrain\n    , regex \"atr(a|\u00c3\u00a1)s\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleTimeofdayAmpm :: Rule\nruleTimeofdayAmpm = Rule\n  { name = \"<time-of-day> am|pm\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"([ap])\\\\.?m?\\\\.?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:Token RegexMatch (GroupMatch (ap:_)):_) ->\n        tt $ timeOfDayAMPM (Text.toLower ap == \"a\") td\n      _ -> Nothing\n  }\n\nruleDOMOfMonth :: Rule\nruleDOMOfMonth = Rule\n  { name = \"<day-of-month> (ordinal or number) de <named-month>\"\n  , pattern =\n    [ Predicate isDOMValue\n    , regex \"de|\\\\/\"\n    , Predicate isAMonth\n    ]\n  , prod = \\case\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDOMMonth :: Rule\nruleDOMMonth = Rule\n  { name = \"<day-of-month> (ordinal or number) <named-month>\"\n  , pattern =\n    [ Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\case\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleMonthDOM :: Rule\nruleMonthDOM = Rule\n  { name = \"<named-month> <day-of-month>\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\case\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleEntreDatetimeEDatetimeInterval :: Rule\nruleEntreDatetimeEDatetimeInterval = Rule\n  { name = \"entre <datetime> e <datetime> (interval)\"\n  , pattern =\n    [ regex \"entre( [ao])?|desde|(a partir )?d[eo]\"\n    , dimension Time\n    , regex \"e|\\\\-|at\u00c3\u00a9( ao?)?|ao?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEntreDdEtDdMonthinterval :: Rule\nruleEntreDdEtDdMonthinterval = Rule\n  { name = \"entre dd et dd <month>(interval)\"\n  , pattern =\n    [ regex \"entre\"\n    , regex \"(0?[1-9]|[12]\\\\d|3[01])\"\n    , regex \"e?\"\n    , regex \"(0?[1-9]|[12]\\\\d|3[01])\"\n    , regex \"de\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token RegexMatch (GroupMatch (d1:_)):\n       _:\n       Token RegexMatch (GroupMatch (d2:_)):\n       _:\n       Token Time td:\n       _) -> do\n        dd1 <- parseInt d1\n        dd2 <- parseInt d2\n        dom1 <- intersect (dayOfMonth dd1) td\n        dom2 <- intersect (dayOfMonth dd2) td\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleCyclePassado :: Rule\nruleCyclePassado = Rule\n  { name = \"<cycle> passado\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"passad[ao]s?|anterior(es)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) -> tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nrulePassadoCycle :: Rule\nrulePassadoCycle = Rule\n  { name = \"passado <cycle>\"\n  , pattern =\n    [ regex \"(passad|[\u00c3\u00bau]ltim)[ao]s?|anterior(es)?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleNossaSenhoraAparecida :: Rule\nruleNossaSenhoraAparecida = Rule\n  { name = \"Nossa Senhora Aparecida\"\n  , pattern =\n    [ regex \"nossa senhora( aparecida)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 12\n  }\n\nruleFinados :: Rule\nruleFinados = Rule\n  { name = \"Finados\"\n  , pattern =\n    [ regex \"finados|dia dos mortos\"\n    ]\n  , prod = \\_ -> tt $ monthDay 11 2\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt $ year n\n      _ -> Nothing\n  }\n\nruleAntesDasTimeofday :: Rule\nruleAntesDasTimeofday = Rule\n  { name = \"antes das <time-of-day>\"\n  , pattern =\n    [ regex \"(antes|at(e|\u00c3\u00a9)|n(a|\u00c3\u00a3)o mais que) (d?(o|a|\u00c3\u00a0)s?)?\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleNProximasCycle :: Rule\nruleNProximasCycle = Rule\n  { name = \"n proximas <cycle>\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2 9999\n    , regex \"pr(\u00c3\u00b3|o)xim(o|a)s?\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd[/-.]mm[/-.]yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\.\\\\/\\\\-](0?[1-9]|1[0-2])[\\\\.\\\\/\\\\-](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleIndependecia :: Rule\nruleIndependecia = Rule\n  { name = \"Independecia\"\n  , pattern =\n    [ regex \"independ(\u00c3\u00aa|e)ncia\"\n    ]\n  , prod = \\_ -> tt $ monthDay 9 7\n  }\n\nruleTomorrow :: Rule\nruleTomorrow = Rule\n  { name = \"tomorrow\"\n  , pattern =\n    [ regex \"amanh(\u00c3\u00a3|a)\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nruleCycleOrdinalOfTime :: Rule\nruleCycleOrdinalOfTime = Rule\n    { name = \"<ordinal> <cycle> de <time>\"\n    , pattern =\n      [ dimension Ordinal\n      , dimension TimeGrain\n      , regex \"d[eo]|em\"\n      , dimension Time\n      ]\n    , prod = \\tokens -> case tokens of\n        (token:Token TimeGrain grain:_:Token Time td:_) -> do\n          n <- getIntValue token\n          tt $ cycleNthAfter True grain (n - 1) td\n        _ -> Nothing\n    }\n\nruleCycleOrdinalTime :: Rule\nruleCycleOrdinalTime = Rule\n    { name = \"<ordinal> <cycle> <time>\"\n    , pattern =\n      [ dimension Ordinal\n      , dimension TimeGrain\n      , dimension Time\n      ]\n    , prod = \\tokens -> case tokens of\n        (token:Token TimeGrain grain: Token Time td:_) -> do\n          n <- getIntValue token\n          tt $ cycleNthAfter True grain (n - 1) td\n        _ -> Nothing\n    }\n\nruleCycleTheOrdinalOfTime :: Rule\nruleCycleTheOrdinalOfTime = Rule\n    { name = \"o <ordinal> <cycle> de <time>\"\n    , pattern =\n      [ regex \"o|a\"\n      , dimension Ordinal\n      , dimension TimeGrain\n      , regex \"d[eo]|em\"\n      , dimension Time\n      ]\n    , prod = \\tokens -> case tokens of\n        (_:token:Token TimeGrain grain:_:Token Time td:_) -> do\n          n <- getIntValue token\n          tt $ cycleNthAfter True grain (n - 1) td\n        _ -> Nothing\n    }\n\nruleOrdinalTrimestre :: Rule\nruleOrdinalTrimestre = Rule\n  { name = \"<ordinal> trimestre\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleTheOrdinalTrimestre :: Rule\nruleTheOrdinalTrimestre = Rule\n  { name = \"o <ordinal> trimestre\"\n  , pattern =\n    [ regex \"o|a\"\n    , dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleOrdinalTrimestreYear :: Rule\nruleOrdinalTrimestreYear = Rule\n  { name = \"<ordinal> trimestre <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter False TG.Quarter (n - 1) td\n      _ -> Nothing\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n    { name = \"\u00c3\u00baltimo <cycle> de <time>\"\n    , pattern =\n      [ regex \"[\u00c3\u00bau]ltim[ao]s?\"\n      , dimension TimeGrain\n      , regex \"d[eo]|em\"\n      , dimension Time\n      ]\n    , prod = \\tokens -> case tokens of\n        (_:Token TimeGrain grain:_:Token Time td:_) ->\n          tt $ cycleLastOf grain td\n        _ -> Nothing\n    }\n\nruleLastCycleTime :: Rule\nruleLastCycleTime = Rule\n    { name = \"\u00c3\u00baltimo <cycle> <time>\"\n    , pattern =\n      [ regex \"[\u00c3\u00bau]ltim[ao]s?\"\n      , dimension TimeGrain\n      , dimension Time\n      ]\n    , prod = \\tokens -> case tokens of\n        (_:Token TimeGrain grain: Token Time td:_) ->\n          tt $ cycleLastOf grain td\n        _ -> Nothing\n    }\n\nruleIntervalFromMonthDDDDOf :: Rule\nruleIntervalFromMonthDDDDOf = Rule\n  { name = \"desde <month> dd-dd de (interval)\"\n  , pattern =\n    [ regex \"desde|a partir d[eo]\"\n    , Predicate isDOMValue\n    , regex \"at\u00c3\u00a9( ao?)?|ao?\"\n    , Predicate isDOMValue\n    , regex \"d[eo]|em\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       token1:\n       _:\n       token2:\n       _:\n       Token Time td:\n       _) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleIntervalDDDDMonthOf :: Rule\nruleIntervalDDDDMonthOf = Rule\n    { name = \"dd-dd <month> de (interval)\"\n    , pattern =\n      [ Predicate isDOMValue\n      , regex \"\\\\-|a(t\u00c3\u00a9)?\"\n      , Predicate isDOMValue\n      , regex \"d[eo]|em\"\n      , Predicate isAMonth\n      ]\n    , prod = \\tokens -> case tokens of\n        (token1:\n         _:\n         token2:\n         _:\n         Token Time td:\n         _) -> do\n          dom1 <- intersectDOM td token1\n          dom2 <- intersectDOM td token2\n          Token Time <$> interval TTime.Closed dom1 dom2\n        _ -> Nothing\n    }\n\nruleIntervalFromMonthDDDD :: Rule\nruleIntervalFromMonthDDDD = Rule\n  { name = \"desde <month> dd-dd (interval)\"\n  , pattern =\n    [ regex \"desde|a partir d[eo]\"\n    , Predicate isDOMValue\n    , regex \"at\u00c3\u00a9( ao?)?|ao?\"\n    , Predicate isDOMValue\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       token1:\n       _:\n       token2:\n       Token Time td:\n       _) -> do\n        dom1 <- intersectDOM td token1\n        dom2 <- intersectDOM td token2\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleIntervalDDDDMonth :: Rule\nruleIntervalDDDDMonth = Rule\n    { name = \"dd-dd <month> (interval)\"\n    , pattern =\n      [ Predicate isDOMValue\n      , regex \"\\\\-|a(t\u00c3\u00a9)?\"\n      , Predicate isDOMValue\n      , Predicate isAMonth\n      ]\n    , prod = \\tokens -> case tokens of\n        (token1:\n         _:\n         token2:\n         Token Time td:\n         _) -> do\n          dom1 <- intersectDOM td token1\n          dom2 <- intersectDOM td token2\n          Token Time <$> interval TTime.Closed dom1 dom2\n        _ -> Nothing\n    }\n\nruleOrdinalCycleOfYearOrdinalCycleOfYear :: Rule\nruleOrdinalCycleOfYearOrdinalCycleOfYear = Rule\n    { name = \"<ordinal> <cycle> de <year> - <ordinal> <cycle> de <year>\"\n    , pattern =\n      [ dimension Ordinal\n      , dimension TimeGrain\n      , regex \"d[eo]|em\"\n      , dimension Time\n      , regex \"\\\\-|at\u00c3\u00a9( ao?)?|ao?\"\n      , dimension Ordinal\n      , dimension TimeGrain\n      , regex \"d[eo]|em\"\n      , dimension Time\n      ]\n    , prod = \\tokens -> case tokens of\n        (token1:\n         Token TimeGrain grain1:\n         _:\n         Token Time td1:\n         _:\n         token2:\n         Token TimeGrain grain2:\n         _:\n         Token Time td2:\n         _) -> do\n          n1 <- getIntValue token1\n          n2 <- getIntValue token2\n          let from = cycleNthAfter False grain1 (n1 - 1) td1\n              to = cycleNthAfter False grain2 (n2 - 1) td2\n          Token Time <$> interval TTime.Closed from to\n        _ -> Nothing\n    }\n\nruleOrdinalCycleYearOrdinalCycleYear :: Rule\nruleOrdinalCycleYearOrdinalCycleYear = Rule\n    { name = \"<ordinal> <cycle> <year> - <ordinal> <cycle> <year>\"\n    , pattern =\n      [ dimension Ordinal\n      , dimension TimeGrain\n      , dimension Time\n      , regex \"\\\\-|at\u00c3\u00a9( ao?)?|ao?\"\n      , dimension Ordinal\n      , dimension TimeGrain\n      , dimension Time\n      ]\n    , prod = \\tokens -> case tokens of\n        (token1:\n         Token TimeGrain grain1:\n         Token Time td1:\n         _:\n         token2:\n         Token TimeGrain grain2:\n         Token Time td2:\n         _) -> do\n          n1 <- getIntValue token1\n          n2 <- getIntValue token2\n          let from = cycleNthAfter False grain1 (n1 - 1) td1\n              to = cycleNthAfter  False grain2 (n2 - 1) td2\n          Token Time <$> interval TTime.Closed from to\n        _ -> Nothing\n    }\n\ndaysOfWeek :: [(Text, String)]\ndaysOfWeek =\n  [ ( \"Segunda-feira\", \"segunda((\\\\s|\\\\-)feira)?|seg\\\\.?\" )\n  , ( \"Ter\u00c3\u00a7a-feira\", \"ter(\u00c3\u00a7|c)a((\\\\s|\\\\-)feira)?|ter\\\\.\"  )\n  , ( \"Quart-feira\", \"quarta((\\\\s|\\\\-)feira)?|qua\\\\.?\"    )\n  , ( \"Quinta-feira\", \"quinta((\\\\s|\\\\-)feira)?|qui\\\\.?\"   )\n  , ( \"Sexta-feira\", \"sexta((\\\\s|\\\\-)feira)?|sex\\\\.?\"     )\n  , ( \"S\u00c3\u00a1bada\", \"s(\u00c3\u00a1|a)bado|s(\u00c3\u00a1|a)b\\\\.?\"                  )\n  , ( \"Domingo\", \"domingo|dom\\\\.?\"                        )\n  ]\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek daysOfWeek\n\nmonths :: [(Text, String)]\nmonths =\n  [ ( \"Janeiro\"   , \"janeiro|jan\\\\.?\"   )\n  , ( \"Fevereiro\" , \"fevereiro|fev\\\\.?\" )\n  , ( \"Mar\u00c3\u00a7o\"     , \"mar(\u00c3\u00a7|c)o|mar\\\\.?\" )\n  , ( \"Abril\"     , \"abril|abr\\\\.?\"     )\n  , ( \"Maio\"      , \"maio|mai\\\\.?\"      )\n  , ( \"Junho\"     , \"junho|jun\\\\.?\"     )\n  , ( \"Julho\"     , \"julho|jul\\\\.?\"     )\n  , ( \"Agosto\"    , \"agosto|ago\\\\.?\"    )\n  , ( \"Setembro\"  , \"setembro|set\\\\.?\"  )\n  , ( \"Outubro\"   , \"outubro|out\\\\.?\"   )\n  , ( \"Novembro\"  , \"novembro|nov\\\\.?\"  )\n  , ( \"Dezembro\"  , \"dezembro|dez\\\\.?\"  )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths months\n\nrules :: [Rule]\nrules =\n  [ ruleAfternoon\n  , ruleAmanhPelaPartofday\n  , ruleAnoNovo\n  , ruleAntesDasTimeofday\n  , ruleDatetimeDatetimeInterval\n  , ruleDayOfMonthSt\n  , ruleDayofweekSHourmin\n  , ruleDdddMonthinterval\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleDeDatetimeDatetimeInterval\n  , ruleDeYear\n  , ruleDentroDeDuration\n  , ruleDepoisDasTimeofday\n  , ruleDiaDayofmonthDeNamedmonth\n  , ruleDiaDayofmonthNonOrdinal\n  , ruleDiaDoTrabalhador\n  , ruleDimTimeDaMadrugada\n  , ruleDimTimeDaManha\n  , ruleDimTimeDaTarde\n  , ruleDOMOfMonth\n  , ruleDOMMonth\n  , ruleEmDuration\n  , ruleEntreDatetimeEDatetimeInterval\n  , ruleEntreDdEtDdMonthinterval\n  , ruleEsteCycle\n  , ruleCycleActual\n  , ruleEvening\n  , ruleFazemDuration\n  , ruleFinados\n  , ruleHhhmmTimeofday\n  , ruleHhmmMilitaryTimeofday\n  , ruleHourofdayAndRelativeMinutes\n  , ruleHourofdayAndRelativeMinutes2\n  , ruleHourofdayAndQuarter\n  , ruleHourofdayAndThreeQuarter\n  , ruleHourofdayAndHalf\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleHourofdayIntegerAsRelativeMinutes2\n  , ruleHourofdayQuarter\n  , ruleHourofdayHalf\n  , ruleHourofdayThreeQuarter\n  , ruleInThePartofday\n  , ruleIndependecia\n  , ruleIntegerParaAsHourofdayAsRelativeMinutes\n  , ruleIntegerParaAsHourofdayAsRelativeMinutes2\n  , ruleHalfParaAsHourofdayAsRelativeMinutes\n  , ruleQuarterParaAsHourofdayAsRelativeMinutes\n  , ruleThreeQuarterParaAsHourofdayAsRelativeMinutes\n  , ruleIntersect\n  , ruleIntersectByDaOrDe\n  , ruleLastTime\n  , ruleMidnight\n  , ruleMonthDOM\n  , ruleMorning\n  , ruleNCycleAtras\n  , ruleNCycleProximoqueVem\n  , ruleNPassadosCycle\n  , ruleNProximasCycle\n  , ruleNamedmonthnameddayNext\n  , ruleNamedmonthnameddayPast\n  , ruleNaoDate\n  , ruleNatal\n  , ruleNextTime\n  , ruleCycleQueVem\n  , ruleProximoCycle\n  , ruleNoon\n  , ruleNossaSenhoraAparecida\n  , ruleNow\n  , ruleCycleAntesDeTime\n  , ruleCyclePassado\n  , rulePassadoCycle\n  , rulePartofdayDessaSemana\n  , rulePassadosNCycle\n  , ruleNCyclePassados\n  , ruleProclamaoDaRepblica\n  , ruleProximasNCycle\n  , ruleRightNow\n  , ruleSHourminTimeofday\n  , ruleSHourmintimeofday\n  , ruleSTimeofday\n  , ruleSeason\n  , ruleSeason2\n  , ruleSeason3\n  , ruleSeason4\n  , ruleTheDayAfterTomorrow\n  , ruleTheDayBeforeYesterday\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleThisnextDayofweek\n  , ruleTimeofdayAmpm\n  , ruleTimeofdayHoras\n  , ruleTimeofdayLatent\n  , ruleTimeofdayPartofday\n  , ruleTiradentes\n  , ruleTomorrow\n  , ruleTwoTimeTokensSeparatedBy\n  , ruleTwoTimeTokensSeparatedBy2\n  , ruleUltimoTime\n  , ruleVesperaDeAnoNovo\n  , ruleWeekend\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYesterday\n  , ruleYyyymmdd\n  , ruleTimezone\n  , ruleCycleOrdinalOfTime\n  , ruleCycleOrdinalTime\n  , ruleCycleTheOrdinalOfTime\n  , ruleOrdinalTrimestre\n  , ruleTheOrdinalTrimestre\n  , ruleOrdinalTrimestreYear\n  , ruleLastCycleOfTime\n  , ruleLastCycleTime\n  , ruleIntervalFromMonthDDDDOf\n  , ruleIntervalDDDDMonthOf\n  , ruleIntervalFromMonthDDDD\n  , ruleIntervalDDDDMonth\n  , ruleOrdinalCycleOfYearOrdinalCycleOfYear\n  , ruleOrdinalCycleYearOrdinalCycleYear\n  ]\n  ++ ruleMonths\n  ++ ruleDaysOfWeek\n", "num_lines": 1858}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.RO.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Time.Corpus\nimport Duckling.TimeGrain.Types hiding (add)\nimport Duckling.Testing.Types hiding (examples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"sa\"\n      ]\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"acum\"\n             , \"chiar acum\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"azi\"\n             , \"astazi\"\n             , \"ast\u00c4\u0192zi\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"ieri\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"maine\"\n             , \"m\u00c3\u00a2ine\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"luni\"\n             , \"lunea asta\"\n             , \"lunea aceasta\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"Luni, 18 Feb\"\n             , \"Luni, 18 Februarie\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"marti\"\n             , \"mar\u00c8\u203ai\"\n             , \"Marti 19\"\n             , \"Marti pe 19\"\n             , \"Mar\u00c8\u203ai 19\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"joi\"\n             , \"jo\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"vineri\"\n             , \"vi\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"sambata\"\n             , \"s\u00c3\u00a2mb\u00c4\u0192t\u00c4\u0192\"\n             , \"sam\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"duminica\"\n             , \"duminic\u00c4\u0192\"\n             , \"du\"\n             , \"dum\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"1 martie\"\n             , \"intai martie\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 19, 0, 0, 0), (2013, 6, 21, 0, 0, 0)) Day)\n             [ \"iunie 19-20\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"ziua de craciun\"\n             , \"cr\u00c4\u0192ciun\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"poimaine\"\n             , \"poim\u00c3\u00a2ine\"\n             ]\n  ]\n", "num_lines": 103}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.RO.Rules\n  ( rules ) where\n\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Types\nimport qualified Data.Text as Text\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleTheDayAfterTomorrow :: Rule\nruleTheDayAfterTomorrow = Rule\n  { name = \"the day after tomorrow\"\n  , pattern =\n    [ regex \"poim(a|\u00c3\u00a2)ine\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleAcum :: Rule\nruleAcum = Rule\n  { name = \"acum\"\n  , pattern =\n    [ regex \"(chiar)? ?acum|imediat\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleDupamiaza :: Rule\nruleDupamiaza = Rule\n  { name = \"dupamiaza\"\n  , pattern =\n    [ regex \"dupamiaz(a|\u00c4\u0192)|dup(a|\u00c4\u0192) amiaz(a|\u00c4\u0192)\"\n    ]\n  , prod = \\_ -> Token Time . mkLatent . partOfDay <$>\n      interval TTime.Open (hour False 12) (hour False 19)\n  }\n\nruleValentinesDay :: Rule\nruleValentinesDay = Rule\n  { name = \"valentine's day\"\n  , pattern =\n    [ regex \"sf\\\\.?((a|\u00c3\u00a2)ntul)? Valentin\"\n    ]\n  , prod = \\_ -> tt $ monthDay 2 14\n  }\n\nruleSinceTimeofday :: Rule\nruleSinceTimeofday = Rule\n  { name = \"since <time-of-day>\"\n  , pattern =\n    [ regex \"de|din\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleNewYearsDay :: Rule\nruleNewYearsDay = Rule\n  { name = \"new year's day\"\n  , pattern =\n    [ regex \"(siua de )? an(ul)? nou\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 1\n  }\n\nruleOrdinalTrimestruYear :: Rule\nruleOrdinalTrimestruYear = Rule\n  { name = \"<ordinal> trimestru <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        tt $ cycleNthAfter False TG.Quarter (n - 1) td\n      _ -> Nothing\n  }\n\nruleInNamedmonth :: Rule\nruleInNamedmonth = Rule\n  { name = \"in <named-month>\"\n  , pattern =\n    [ regex \"(i|\u00c3\u00ae)n\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"ultim(ul|a)\"\n    , dimension TimeGrain\n    , regex \"din\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleIntroNamedday :: Rule\nruleIntroNamedday = Rule\n  { name = \"intr-o <named-day>\"\n  , pattern =\n    [ regex \"((i|\u00c3\u00ae)n(tr)?(\\\\-?o)?)\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleMonthDdddInterval :: Rule\nruleMonthDdddInterval = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ Predicate isAMonth\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    , regex \"\\\\-\"\n    , regex \"(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (m2:_)):\n       _) -> do\n        d1 <- parseInt m1\n        d2 <- parseInt m2\n        dom1 <- intersect (dayOfMonth d1) td\n        dom2 <- intersect (dayOfMonth d2) td\n        Token Time <$> interval TTime.Closed dom1 dom2\n      _ -> Nothing\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in <duration>\"\n  , pattern =\n    [ regex \"(i|\u00c3\u00ae)n\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleIeri :: Rule\nruleIeri = Rule\n  { name = \"ieri\"\n  , pattern =\n    [ regex \"ieri\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleCycleAcesta :: Rule\nruleCycleAcesta = Rule\n  { name = \"<cycle> acesta\"\n  , pattern =\n    [ regex \"aceasta|acest|(a|\u00c4\u0192)sta\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleAzi :: Rule\nruleAzi = Rule\n  { name = \"azi\"\n  , pattern =\n    [ regex \"a(st(a|\u00c4\u0192))?zi\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"noon\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleTimeTrecuta :: Rule\nruleTimeTrecuta = Rule\n  { name = \"<time> trecut[a\u00c4\u0192]?\"\n  , pattern =\n    [ dimension Time\n    , regex \"(trecut(a|\u00c4\u0192)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \"aceasta|(a|\u00c4\u0192)sta|urm(a|\u00c4\u0192)toare\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleBetweenTimeofdayAndTimeofdayInterval :: Rule\nruleBetweenTimeofdayAndTimeofdayInterval = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(i|\u00c3\u00ae)ntre\"\n    , Predicate isATimeOfDay\n    , regex \"(s|\u00c8\u2122)i\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleUrmatoareaCycle :: Rule\nruleUrmatoareaCycle = Rule\n  { name = \"urmatoarea <cycle>\"\n  , pattern =\n    [ regex \"(urm(a|\u00c4\u0192)to(area|rul)|viito(are|r))\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleCycleAcesta2 :: Rule\nruleCycleAcesta2 = Rule\n  { name = \"<cycle> acesta\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"aceasta|acest|(a|\u00c4\u0192)sta|curent(a|\u00c4\u0192)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) -> tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleCraciun :: Rule\nruleCraciun = Rule\n  { name = \"craciun\"\n  , pattern =\n    [ regex \"(ziua de )?cr(a|\u00c4\u0192)ciun\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleTrimestruNumeralYear :: Rule\nruleTrimestruNumeralYear = Rule\n  { name = \"trimestru <number> <year>\"\n  , pattern =\n    [ Predicate $ isGrain TG.Quarter\n    , dimension Numeral\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token Time td:_) -> do\n        v <- getIntValue token\n        tt $ cycleNthAfter False TG.Quarter (v - 1) td\n      _ -> Nothing\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])/(0?[1-9]|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleLaTimeofday :: Rule\nruleLaTimeofday = Rule\n  { name = \"la <time-of-day>\"\n  , pattern =\n    [ regex \"la|@ (ora)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleBlackFriday :: Rule\nruleBlackFriday = Rule\n  { name = \"black friday\"\n  , pattern =\n    [ regex \"black frid?day\"\n    ]\n  , prod = \\_ -> tt $ nthDOWOfMonth 4 5 11\n  }\n\nruleChristmasEve :: Rule\nruleChristmasEve = Rule\n  { name = \"christmas eve\"\n  , pattern =\n    [ regex \"ajun(ul)? (de )?cr(a|\u00c4\u0192)ciun\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 24\n  }\n\nrulePentruDuration :: Rule\nrulePentruDuration = Rule\n  { name = \"pentru <duration>\"\n  , pattern =\n    [ regex \"pentru\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute is12H hours n\n      _ -> Nothing\n  }\n\nruleHourofdaySfert :: Rule\nruleHourofdaySfert = Rule\n  { name = \"<hour-of-day> sfert\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"((s|\u00c8\u2122)i )?(un )?sfert\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayJumatate :: Rule\nruleHourofdayJumatate = Rule\n  { name = \"<hour-of-day> sfert\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"((s|\u00c8\u2122)i )?jum(a|\u00c4\u0192)tate|jumate\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}:\n       _) -> tt $ hourMinute is12H hours 30\n      _ -> Nothing\n  }\n\nruleDiseara :: Rule\nruleDiseara = Rule\n  { name = \"diseara\"\n  , pattern =\n    [ regex \"disear(a|\u00c4\u0192)|((i|\u00c3\u00ae)n aceas(a|\u00c4\u0192) )?sear(a|\u00c4\u0192)\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 18) (hour False 0)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by \\\",\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleDayofmonthNumeral :: Rule\nruleDayofmonthNumeral = Rule\n  { name = \"<day-of-month> (number)\"\n  , pattern =\n    [ Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"dup(a|\u00c4\u0192)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td1:_:Token Time td2:_) -> do\n        v <- getIntValue token\n        tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleMmdd :: Rule\nruleMmdd = Rule\n  { name = \"mm/dd\"\n  , pattern =\n    [ regex \"(0?[1-9]|1[0-2])/(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:_)):_) -> do\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ hour True v\n      _ -> Nothing\n  }\n\nruleFromTimeofdayTimeofdayInterval :: Rule\nruleFromTimeofdayTimeofdayInterval = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(dup(a|\u00c4\u0192)|(i|\u00c3\u00ae)ncep(a|\u00c3\u00a2)nd cu)\"\n    , Predicate isATimeOfDay\n    , regex \"(dar |(s|\u00c8\u2122)i )?((i|\u00c3\u00ae)nainte|p(a|\u00c3\u00a2)n(a|\u00c4\u0192) la( de)?)\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleSeason3 :: Rule\nruleSeason3 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"primavar(a|\u00c4\u0192)\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (monthDay 3 20) (monthDay 6 21)\n  }\n\nruleUrmatoareleNCycle :: Rule\nruleUrmatoareleNCycle = Rule\n  { name = \"urmatoarele n <cycle>\"\n  , pattern =\n    [ regex \"urm(a|\u00c4\u0192)to(arele|rii|area)\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleSeason :: Rule\nruleSeason = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"toamn(a|\u00c4\u0192)\"\n    ]\n  , prod = \\_ -> Token Time <$>\n      interval TTime.Open (monthDay 9 23) (monthDay 12 21)\n  }\n\nruleDupaDuration :: Rule\nruleDupaDuration = Rule\n  { name = \"dupa <duration>\"\n  , pattern =\n    [ regex \"dup(a|\u00c4\u0192)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt . withDirection TTime.After $ inDuration dd\n      _ -> Nothing\n  }\n\nruleNewYearsEve :: Rule\nruleNewYearsEve = Rule\n  { name = \"new year's eve\"\n  , pattern =\n    [ regex \"(ajun(ul)? )?(de )?an(ul)? nou\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 31\n  }\n\nruleByTheEndOfTime :: Rule\nruleByTheEndOfTime = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"p(a|\u00c3\u00ae)n(a|\u00c4\u0192) ((i|\u00c3\u00ae)n|la)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed now td\n      _ -> Nothing\n  }\n\nruleNameddayPeDayofmonthNumeral :: Rule\nruleNameddayPeDayofmonthNumeral = Rule\n  { name = \"<named-day> pe <day-of-month> (number)\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \"pe\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalNamedmonth :: Rule\nruleDayofmonthNonOrdinalNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAboutTimeofday :: Rule\nruleAboutTimeofday = Rule\n  { name = \"about <time-of-day>\"\n  , pattern =\n    [ regex \"(cam|aproximativ|(i|\u00c3\u00ae)n jur de)\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleUntilTimeofday :: Rule\nruleUntilTimeofday = Rule\n  { name = \"until <time-of-day>\"\n  , pattern =\n    [ regex \"p(a|\u00c3\u00ae)n(a|\u00c4\u0192) ((i|\u00c3\u00ae)n|la)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleDayofmonthnumberNamedmonth :: Rule\nruleDayofmonthnumberNamedmonth = Rule\n  { name = \"<day-of-month>(number) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntreDatetimeSiDatetimeInterval :: Rule\nruleIntreDatetimeSiDatetimeInterval = Rule\n  { name = \"intre <datetime> si <datetime> (interval)\"\n  , pattern =\n    [ regex \"(i|\u00c3\u00ae)nre\"\n    , dimension Time\n    , regex \"(s|\u00c8\u2122)i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"din\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td1:_:Token Time td2:_) -> do\n        v <- getIntValue token\n        Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimePartofday :: Rule\nruleTimePartofday = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"(week(\\\\s|\\\\-)?end|wkend)\"\n    ]\n  , prod = \\_ -> tt weekend\n  }\n\nrulePeDayofmonthNonOrdinal :: Rule\nrulePeDayofmonthNonOrdinal = Rule\n  { name = \"pe <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"pe\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleTimeAceastaacestaasta :: Rule\nruleTimeAceastaacestaasta = Rule\n  { name = \"<time> (aceasta|acesta|[a\u00c4\u0192]sta)\"\n  , pattern =\n    [ dimension Time\n    , regex \"aceasta|(a|\u00c4\u0192)sta|urm(a|\u00c4\u0192)toare\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleEomendOfMonth :: Rule\nruleEomendOfMonth = Rule\n  { name = \"EOM|End of month\"\n  , pattern =\n    [ regex \"sf(a|\u00c3\u00a2)r(s|\u00c8\u2122)itul lunii\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Month 1\n  }\n\nrulePartofdayAsta :: Rule\nrulePartofdayAsta = Rule\n  { name = \"<part-of-day> asta\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"asta\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleUltimaCycle :: Rule\nruleUltimaCycle = Rule\n  { name = \"ultima <cycle>\"\n  , pattern =\n    [ regex \"ultim(a|ul)\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleCycleUrmatoare :: Rule\nruleCycleUrmatoare = Rule\n  { name = \"<cycle> urmatoare\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(urm(a|\u00c4\u0192)to(are|r)|viito(are|r))\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) -> tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleTheDayofmonthNumeral :: Rule\nruleTheDayofmonthNumeral = Rule\n  { name = \"the <day-of-month> (number)\"\n  , pattern =\n    [ regex \"pe\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (yy:mm:dd:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleCycleTrecut :: Rule\nruleCycleTrecut = Rule\n  { name = \"<cycle> trecut\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"trecut(a|\u00c4\u0192)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleDayofmonthNumeralOfNamedmonth :: Rule\nruleDayofmonthNumeralOfNamedmonth = Rule\n  { name = \"<day-of-month> (number) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"din\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDurationInainteDeTime :: Rule\nruleDurationInainteDeTime = Rule\n  { name = \"<duration> inainte de <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"(i|\u00c3\u00ae)nainte de\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalOfNamedmonth :: Rule\nruleDayofmonthNonOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"din\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleDurationInUrma :: Rule\nruleDurationInUrma = Rule\n  { name = \"<duration> in urma\"\n  , pattern =\n    [ dimension Duration\n    , regex \"(i|\u00c3\u00ae)n urm(a|\u00c4\u0192)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) -> tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleDurationDeAcum :: Rule\nruleDurationDeAcum = Rule\n  { name = \"<duration> de acum\"\n  , pattern =\n    [ dimension Duration\n    , regex \"de (acum|azi)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) -> tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleSezonAnotimp :: Rule\nruleSezonAnotimp = Rule\n  { name = \"sezon anotimp\"\n  , pattern =\n    [ regex \"var(a|\u00c4\u0192)\"\n    ]\n  , prod = \\_ ->\n      Token Time <$> interval TTime.Open (monthDay 6 21) (monthDay 9 23)\n  }\n\nruleSearaNoapte :: Rule\nruleSearaNoapte = Rule\n  { name = \"sear[a\u00c4\u0192] noapte\"\n  , pattern =\n    [ regex \"sear(a|\u00c4\u0192)|noapte\"\n    ]\n  , prod = \\_ -> Token Time . mkLatent . partOfDay <$>\n      interval TTime.Open (hour False 18) (hour False 0)\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleSeason2 :: Rule\nruleSeason2 = Rule\n  { name = \"season\"\n  , pattern =\n    [ regex \"iarn(a|\u00c4\u0192)\"\n    ]\n  , prod = \\_ ->\n      Token Time <$> interval TTime.Open (monthDay 12 21) (monthDay 3 20)\n  }\n\nruleUltimeleNCycle :: Rule\nruleUltimeleNCycle = Rule\n  { name = \"ultimele n <cycle>\"\n  , pattern =\n    [ regex \"ultim(ele|ii|a)\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleAfterTimeofday :: Rule\nruleAfterTimeofday = Rule\n  { name = \"after <time-of-day>\"\n  , pattern =\n    [ regex \"dup(a|\u00c4\u0192)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleDimineata :: Rule\nruleDimineata = Rule\n  { name = \"diminea[t\u00c8\u203a][a\u00c4\u0192]\"\n  , pattern =\n    [ regex \"diminea(t|\u00c8\u203a)(a|\u00c4\u0192)\"\n    ]\n  , prod = \\_ -> Token Time . mkLatent . partOfDay <$>\n      interval TTime.Open (hour False 4) (hour False 12)\n  }\n\nruleTimeUrmatoarer :: Rule\nruleTimeUrmatoarer = Rule\n  { name = \"<time> urm[a\u00c4\u0192]to(are|r)\"\n  , pattern =\n    [ regex \"urm(a|\u00c4\u0192)to(are|r)\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleTimeofdayFix :: Rule\nruleTimeofdayFix = Rule\n  { name = \"<time-of-day> fix\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(fix|exact)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleHhmm :: Rule\nruleHhmm = Rule\n  { name = \"hh:mm\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        tt $ hourMinute True h m\n      _ -> Nothing\n  }\n\nruleMaine :: Rule\nruleMaine = Rule\n  { name = \"maine\"\n  , pattern =\n    [ regex \"m(a|\u00c3\u00a2)ine\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt $ year v\n      _ -> Nothing\n  }\n\nruleHalloweenDay :: Rule\nruleHalloweenDay = Rule\n  { name = \"halloween day\"\n  , pattern =\n    [ regex \"hall?owe?en\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 31\n  }\n\nruleNamedmonthDayofmonthNonOrdinal :: Rule\nruleNamedmonthDayofmonthNonOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nrulePeDate :: Rule\nrulePeDate = Rule\n  { name = \"pe <date>\"\n  , pattern =\n    [ regex \"pe\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleDayofmonthnumberNamedmonthYear :: Rule\nruleDayofmonthnumberNamedmonthYear = Rule\n  { name = \"<day-of-month>(number) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       Token Time td:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n        v <- parseInt match\n        dom <- intersectDOM td token\n        Token Time <$> intersect dom (year v)\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"ultima\"\n    , Predicate isADayOfWeek\n    , regex \"din\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleOrdinalTrimestru :: Rule\nruleOrdinalTrimestru = Rule\n  { name = \"<ordinal> trimestru\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . cycleNthAfter True TG.Quarter (n - 1) $\n          cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleByTime :: Rule\nruleByTime = Rule\n  { name = \"by <time>\"\n  , pattern =\n    [ regex \"p(a|\u00c3\u00a2)n(a|\u00c4\u0192) (la|(i|\u00c3\u00ae)n)\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Open now td\n      _ -> Nothing\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[-/](0?[1-9]|1[0-2])[/-](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (dd:mm:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleMmddyyyy :: Rule\nruleMmddyyyy = Rule\n  { name = \"mm/dd/yyyy\"\n  , pattern =\n    [ regex \"(0?[1-9]|1[0-2])[/-](3[01]|[12]\\\\d|0?[1-9])[-/](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (mm:dd:yy:_)):_) -> do\n        y <- parseInt yy\n        m <- parseInt mm\n        d <- parseInt dd\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleEoyendOfYear :: Rule\nruleEoyendOfYear = Rule\n  { name = \"EOY|End of year\"\n  , pattern =\n    [ regex \"sf(a|\u00c3\u00a2)r(s|\u00c8\u2122)itul anului\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Year 1\n  }\n\nruleMothersDay :: Rule\nruleMothersDay = Rule\n  { name = \"Mother's Day\"\n  , pattern =\n    [ regex \"ziua (mamei|memeii)\"\n    ]\n  , prod = \\_ -> tt $ nthDOWOfMonth 1 7 5\n  }\n\nruleNameddayDayofmonthNumeral :: Rule\nruleNameddayDayofmonthNumeral = Rule\n  { name = \"<named-day> <day-of-month> (number)\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleHhmmss :: Rule\nruleHhmmss = Rule\n  { name = \"hh:mm:ss\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:ss:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        s <- parseInt ss\n        tt $ hourMinuteSecond True h m s\n      _ -> Nothing\n  }\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"luni\"  , \"lu(n(ea|i)?)?\"                        )\n  , ( \"marti\"  , \"ma(r((t|\u00c8\u203a)(ea|i))?)?\"                )\n  , ( \"miercuri\"  , \"mi(e(rcur(ea|i))?)?\"              )\n  , ( \"joi\"  , \"jo(ia?)?\"                              )\n  , ( \"vineri\"  , \"vi(n(er(ea|i))?)?\"                  )\n  , ( \"sambata\" , \"s(a|\u00c3\u00a2)mb(a|\u00c4\u0192)t(a|\u00c4\u0192)|s(a|\u00c3\u00a2)m\"        )\n  , ( \"duminica\"  , \"du(m(inic(a|\u00c4\u0192))?)?\"               )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ ( \"ianuarie\"  , \"ian(uarie)?\"     )\n  , ( \"februarie\"  , \"feb(ruarie)?\"   )\n  , ( \"martie\"  , \"martie|mar\"        )\n  , ( \"aprilie\"  , \"apr(ilie)?\"       )\n  , ( \"mai\"  , \"mai\"                  )\n  , ( \"iunie\"  , \"iun(ie)?\"           )\n  , ( \"iulie\"  , \"iul(ie)?\"           )\n  , ( \"august\"  , \"aug(ust)?\"         )\n  , ( \"septembrie\"  , \"sept(embrie)?\" )\n  , ( \"octombrie\"  , \"oct(ombrie)?\"   )\n  , ( \"noiembrie\"  , \"noi(embrie)?\"   )\n  , ( \"decembrie\"  , \"dec(embrie)?\"   )\n  ]\n\nrules :: [Rule]\nrules =\n  [ ruleAboutTimeofday\n  , ruleAbsorptionOfAfterNamedDay\n  , ruleAcum\n  , ruleAfterTimeofday\n  , ruleAzi\n  , ruleBetweenTimeofdayAndTimeofdayInterval\n  , ruleBlackFriday\n  , ruleByTheEndOfTime\n  , ruleByTime\n  , ruleChristmasEve\n  , ruleCraciun\n  , ruleCycleAcesta\n  , ruleCycleAcesta2\n  , ruleCycleTrecut\n  , ruleCycleUrmatoare\n  , ruleDayofmonthNonOrdinalNamedmonth\n  , ruleDayofmonthNonOrdinalOfNamedmonth\n  , ruleDayofmonthNumeral\n  , ruleDayofmonthNumeralOfNamedmonth\n  , ruleDayofmonthnumberNamedmonth\n  , ruleDayofmonthnumberNamedmonthYear\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleDimineata\n  , ruleDiseara\n  , ruleDupaDuration\n  , ruleDupamiaza\n  , ruleDurationDeAcum\n  , ruleDurationInUrma\n  , ruleDurationInainteDeTime\n  , ruleEomendOfMonth\n  , ruleEoyendOfYear\n  , ruleFromTimeofdayTimeofdayInterval\n  , ruleHalloweenDay\n  , ruleHhmm\n  , ruleHhmmss\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleHourofdayJumatate\n  , ruleHourofdaySfert\n  , ruleIeri\n  , ruleInDuration\n  , ruleInNamedmonth\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleIntreDatetimeSiDatetimeInterval\n  , ruleIntroNamedday\n  , ruleLaTimeofday\n  , ruleLastCycleOfTime\n  , ruleLastDayofweekOfTime\n  , ruleMaine\n  , ruleMmdd\n  , ruleMmddyyyy\n  , ruleMonthDdddInterval\n  , ruleMothersDay\n  , ruleNameddayDayofmonthNumeral\n  , ruleNameddayPeDayofmonthNumeral\n  , ruleNamedmonthDayofmonthNonOrdinal\n  , ruleNewYearsDay\n  , ruleNewYearsEve\n  , ruleNoon\n  , ruleNthTimeAfterTime\n  , ruleNthTimeOfTime\n  , ruleOrdinalTrimestru\n  , ruleOrdinalTrimestruYear\n  , rulePartofdayAsta\n  , rulePeDate\n  , rulePeDayofmonthNonOrdinal\n  , rulePentruDuration\n  , ruleSearaNoapte\n  , ruleSeason\n  , ruleSeason2\n  , ruleSeason3\n  , ruleSezonAnotimp\n  , ruleSinceTimeofday\n  , ruleTheDayofmonthNumeral\n  , ruleThisnextDayofweek\n  , ruleTimeAceastaacestaasta\n  , ruleTimePartofday\n  , ruleTimezone\n  , ruleTimeTrecuta\n  , ruleTimeUrmatoarer\n  , ruleTimeofdayFix\n  , ruleTimeofdayLatent\n  , ruleTrimestruNumeralYear\n  , ruleUltimaCycle\n  , ruleUltimeleNCycle\n  , ruleUntilTimeofday\n  , ruleUrmatoareaCycle\n  , ruleUrmatoareleNCycle\n  , ruleValentinesDay\n  , ruleWeekend\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYyyymmdd\n  , ruleTheDayAfterTomorrow\n  ]\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n", "num_lines": 1347}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.SV.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale SV Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"nu\"\n             , \"just nu\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"idag\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"ig\u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"imorgon\"\n             , \"i morgon\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"m\u00c3\u00a5ndag\"\n             , \"m\u00c3\u00a5n\"\n             , \"p\u00c3\u00a5 m\u00c3\u00a5ndag\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"M\u00c3\u00a5ndag den 18 februari\"\n             , \"M\u00c3\u00a5n, 18 februari\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"tisdag\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"torsdag\"\n             , \"tors\"\n             , \"tors.\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"fredag\"\n             , \"fre\"\n             , \"fre.\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"l\u00c3\u00b6rdag\"\n             , \"l\u00c3\u00b6r\"\n             , \"l\u00c3\u00b6r.\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"s\u00c3\u00b6ndag\"\n             , \"s\u00c3\u00b6n\"\n             , \"s\u00c3\u00b6n.\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Day)\n             [ \"Den f\u00c3\u00b6rste mars\"\n             , \"Den f\u00c3\u00b6rsta mars\"\n             , \"1:a mars\"\n             , \"Den 1:a mars\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"3 mars\"\n             , \"den tredje mars\"\n             , \"den 3:e mars\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"3 mars 2015\"\n             , \"tredje mars 2015\"\n             , \"3:e mars 2015\"\n             , \"3-3-2015\"\n             , \"03-03-2015\"\n             , \"3/3/2015\"\n             , \"3/3/15\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"P\u00c3\u00a5 den 15:e\"\n             , \"P\u00c3\u00a5 den 15\"\n             , \"Den 15:e\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"den 15:e februari\"\n             , \"15:e februari\"\n             , \"februari 15\"\n             , \"15-02\"\n             , \"15/02\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"8 Aug\"\n             ]\n  , examples (datetime (2014, 10, 0, 0, 0, 0) Month)\n             [ \"Oktober 2014\"\n             ]\n  , examples (datetime (1974, 10, 31, 0, 0, 0) Day)\n             [ \"31/10/1974\"\n             , \"31/10/74\"\n             , \"31-10-74\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14april 2015\"\n             , \"April 14, 2015\"\n             , \"fjortonde April 15\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4sta fredag igen\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a4sta mars\"\n             ]\n  , examples (datetime (2014, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a4sta mars igen\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"S\u00c3\u00b6ndag, 10 feb\"\n             , \"S\u00c3\u00b6ndag 10 Feb\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"Ons, Feb13\"\n             , \"Ons feb13\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"M\u00c3\u00a5ndag, Feb 18\"\n             , \"M\u00c3\u00a5n, februari 18\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"denna vecka\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"f\u00c3\u00b6rra vecka\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"n\u00c3\u00a4sta vecka\"\n             ]\n  , examples (datetime (2013, 1, 0, 0, 0, 0) Month)\n             [ \"f\u00c3\u00b6rra m\u00c3\u00a5nad\"\n             ]\n  , examples (datetime (2013, 3, 0, 0, 0, 0) Month)\n             [ \"n\u00c3\u00a4sta m\u00c3\u00a5nad\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"detta kvartal\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"n\u00c3\u00a4sta kvartal\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"tredje kvartalet\"\n             , \"3:e kvartal\"\n             ]\n  , examples (datetime (2018, 10, 1, 0, 0, 0) Quarter)\n             [ \"4:e kvartal 2018\"\n             , \"fj\u00c3\u00a4rde kvartalet 2018\"\n             ]\n  , examples (datetime (2012, 1, 1, 0, 0, 0) Year)\n             [ \"f\u00c3\u00b6rra \u00c3\u00a5r\"\n             , \"f\u00c3\u00b6rra \u00c3\u00a5ret\"\n             , \"f\u00c3\u00b6reg\u00c3\u00a5ende \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2012, 1, 1, 0, 0, 0) Year)\n             [ \"i fjol\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Year)\n             [ \"i \u00c3\u00a5r\"\n             , \"detta \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"n\u00c3\u00a4sta \u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b6rra s\u00c3\u00b6ndag\"\n             , \"s\u00c3\u00b6ndag i f\u00c3\u00b6rra veckan\"\n             , \"s\u00c3\u00b6ndag f\u00c3\u00b6rra veckan\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b6rra tisdag\"\n             , \"i tisdags\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4sta tisdag\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4sta onsdag\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"onsdag i n\u00c3\u00a4sta vecka\"\n             , \"onsdag n\u00c3\u00a4sta vecka\"\n             , \"n\u00c3\u00a4sta onsdag igen\"\n             ]\n  , examples (datetime (2013, 2, 22, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4sta fredag igen\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"m\u00c3\u00a5ndag denna veckan\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"tisdag denna vecka\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"onsdag denna vecka\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"i \u00c3\u00b6verimorgon\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"i f\u00c3\u00b6rrg\u00c3\u00a5r\"\n             ]\n  , examples (datetime (2013, 3, 25, 0, 0, 0) Day)\n             [ \"sista m\u00c3\u00a5ndag i mars\"\n             ]\n  , examples (datetime (2014, 3, 30, 0, 0, 0) Day)\n             [ \"sista s\u00c3\u00b6ndag i mars 2014\"\n             ]\n  , examples (datetime (2013, 10, 3, 0, 0, 0) Day)\n             [ \"tredje dagen i oktober\"\n             , \"tredje dagen i Oktober\"\n             ]\n  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)\n             [ \"f\u00c3\u00b6rsta veckan i oktober 2014\"\n             , \"f\u00c3\u00b6rsta veckan i Oktober 2014\"\n             ]\n  , examples (datetime (2015, 10, 31, 0, 0, 0) Day)\n             [ \"sista dagen i oktober 2015\"\n             , \"sista dagen i Oktober 2015\"\n             ]\n  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)\n             [ \"sista veckan i september 2014\"\n             , \"sista veckan i September 2014\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b6rsta tisdag i oktober\"\n             , \"f\u00c3\u00b6rsta tisdagen i Oktober\"\n             ]\n  , examples (datetime (2014, 9, 16, 0, 0, 0) Day)\n             [ \"tredje tisdagen i september 2014\"\n             , \"tredje tisdagen i September 2014\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"f\u00c3\u00b6rsta onsdagen i oktober 2014\"\n             , \"f\u00c3\u00b6rsta onsdagen i Oktober 2014\"\n             ]\n  , examples (datetime (2014, 10, 8, 0, 0, 0) Day)\n             [ \"andra onsdagen i oktober 2014\"\n             , \"andra onsdagen i Oktober 2014\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 0, 0) Hour)\n             [ \"klockan 3\"\n             , \"kl. 3\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"klockan 15\"\n             , \"kl. 15\"\n             , \"15h\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"ca. kl. 15\"\n             , \"cirka kl. 15\"\n             , \"omkring klockan 15\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"imorgon klockan 17 exakt\"\n             , \"imorgon kl. 17 precis\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 15, 0) Minute)\n             [ \"kvart \u00c3\u00b6ver 15\"\n             , \"15:15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 20, 0) Minute)\n             [ \"kl. 20 \u00c3\u00b6ver 15\"\n             , \"klockan 20 \u00c3\u00b6ver 15\"\n             , \"tjugo \u00c3\u00b6ver 15\"\n             , \"kl. 15:20\"\n             , \"15:20\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 30, 0) Minute)\n             [ \"15:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 23, 24) Second)\n             [ \"15:23:24\"\n             ]\n  , examples (datetime (2013, 2, 12, 11, 45, 0) Minute)\n             [ \"kvart i 12\"\n             , \"kvart i tolv\"\n             , \"11:45\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"klockan 9 p\u00c3\u00a5 l\u00c3\u00b6rdag\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Minute)\n             [ \"Fre, Jul 18, 2014 19:00\"\n             ]\n  , examples (datetime (2014, 7, 18, 0, 0, 0) Day)\n             [ \"Fre, Jul 18\"\n             , \"Jul 18, Fre\"\n             ]\n  , examples (datetime (2014, 9, 20, 19, 30, 0) Minute)\n             [ \"kl. 19:30, L\u00c3\u00b6r, 20 sep\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"om 1 sekund\"\n             , \"om en sekund\"\n             , \"en sekund fr\u00c3\u00a5n nu\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"om 1 minut\"\n             , \"om en minut\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"om 2 minuter\"\n             , \"om tv\u00c3\u00a5 minuter\"\n             , \"om 2 minuter mer\"\n             , \"om tv\u00c3\u00a5 minuter mer\"\n             --, \"2 minuter fr\u00c3\u00a5n nu\" t14892978\n             , \"tv\u00c3\u00a5 minuter fr\u00c3\u00a5n nu\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"om 60 minuter\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"om en halv timme\"\n             ]\n  , examples (datetime (2013, 2, 12, 7, 0, 0) Second)\n             [ \"om 2,5 timme\"\n             , \"om 2 och en halv timme\"\n             , \"om tv\u00c3\u00a5 och en halv timme\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"om en timme\"\n             , \"om 1 timme\"\n             , \"om 1t\"\n             ]\n  , examples (datetime (2013, 2, 12, 6, 30, 0) Minute)\n             [ \"om ett par timmar\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 30, 0) Minute)\n             [ \"om 24 timmar\"\n             , \"2013-02-13 kl. 4:30\"\n             , \"2013-02-13 kl 04:30\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"om en dag\"\n             ]\n  , examples (datetime (2016, 2, 0, 0, 0, 0) Month)\n             [ -- \"3 \u00c3\u00a5r fr\u00c3\u00a5n idag\" t14892978\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"om 7 dagar\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"om en vecka\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 0, 0) Second)\n             [ \"om ca. en halv timme\"\n             , \"om cirka en halv timme\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 dagar sedan\"\n             , \"sju dagar sedan\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"14 dagar sedan\"\n             , \"fjorton dagar sedan\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"en vecka sedan\"\n             , \"1 vecka sedan\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"3 veckor sedan\"\n             , \"tre veckor sedan\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"3 m\u00c3\u00a5nader sedan\"\n             , \"tre m\u00c3\u00a5nader sedan\"\n             ]\n  , examples (datetime (2011, 2, 0, 0, 0, 0) Month)\n             [ \"tv\u00c3\u00a5 \u00c3\u00a5r sedan\"\n             , \"2 \u00c3\u00a5r sedan\"\n             ]\n  , examples (datetime (1954, 0, 0, 0, 0, 0) Year)\n             [ \"1954\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"denna sommaren\"\n             , \"den h\u00c3\u00a4r sommaren\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"denna vintern\"\n             , \"den h\u00c3\u00a4r vintern\"\n             ]\n  , examples (datetime (2013, 12, 25, 0, 0, 0) Day)\n             [ \"juldagen\"\n             ]\n  , examples (datetime (2013, 12, 31, 0, 0, 0) Day)\n             [ \"ny\u00c3\u00a5rsafton\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"ny\u00c3\u00a5rsdagen\"\n             , \"ny\u00c3\u00a5rsdag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"ikv\u00c3\u00a4ll\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 8, 18, 0, 0), (2013, 2, 11, 0, 0, 0)) Hour)\n             [ \"f\u00c3\u00b6rra helg\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"imorgon kv\u00c3\u00a4ll\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 14, 0, 0)) Hour)\n             [ \"imorgon lunch\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"ig\u00c3\u00a5r kv\u00c3\u00a4ll\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"denna helgen\"\n             , \"denna helg\"\n             , \"i helgen\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 4, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"m\u00c3\u00a5ndag morgon\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"senaste 2 sekunder\"\n             , \"senaste tv\u00c3\u00a5 sekunderna\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"n\u00c3\u00a4sta 3 sekunder\"\n             , \"n\u00c3\u00a4sta tre sekunder\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"senaste 2 minuter\"\n             , \"senaste tv\u00c3\u00a5 minuter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 31, 0), (2013, 2, 12, 4, 34, 0)) Minute)\n             [ \"n\u00c3\u00a4sta 3 minuter\"\n             , \"n\u00c3\u00a4sta tre minuter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 3, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"senaste 1 timme\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"n\u00c3\u00a4sta 3 timmar\"\n             , \"n\u00c3\u00a4sta tre timmar\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"senaste 2 dagar\"\n             , \"senaste tv\u00c3\u00a5 dagar\"\n             , \"senaste 2 dagar\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 0, 0, 0), (2013, 2, 16, 0, 0, 0)) Day)\n             [ \"n\u00c3\u00a4sta 3 dagar\"\n             , \"n\u00c3\u00a4sta tre dagar\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"senaste 2 veckor\"\n             , \"senaste tv\u00c3\u00a5 veckorna\"\n             , \"senaste tv\u00c3\u00a5 veckor\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"n\u00c3\u00a4sta 3 veckor\"\n             , \"n\u00c3\u00a4sta tre veckorna\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 0, 0, 0, 0), (2013, 2, 0, 0, 0, 0)) Month)\n             [ \"senaste 2 m\u00c3\u00a5nader\"\n             , \"senaste tv\u00c3\u00a5 m\u00c3\u00a5nader\"\n             , \"senaste tv\u00c3\u00a5 m\u00c3\u00a5nader\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 0, 0, 0, 0), (2013, 6, 0, 0, 0, 0)) Month)\n             [ \"n\u00c3\u00a4sta 3 m\u00c3\u00a5nader\"\n             , \"n\u00c3\u00a4sta tre m\u00c3\u00a5nader\"\n             ]\n  , examples (datetimeInterval ((2011, 0, 0, 0, 0, 0), (2013, 0, 0, 0, 0, 0)) Year)\n             [ \"senaste 2 \u00c3\u00a5r\"\n             , \"senaste tv\u00c3\u00a5 \u00c3\u00a5r\"\n             , \"senaste 2 \u00c3\u00a5r\"\n             ]\n  , examples (datetimeInterval ((2014, 0, 0, 0, 0, 0), (2017, 0, 0, 0, 0, 0)) Year)\n             [ \"n\u00c3\u00a4sta 3 \u00c3\u00a5r\"\n             , \"n\u00c3\u00a4sta tre \u00c3\u00a5r\"\n             ]\n  , examples (datetimeInterval ((2013, 7, 13, 0, 0, 0), (2013, 7, 16, 0, 0, 0)) Day)\n             [ \"13-15 juli\"\n             , \"13-15 Juli\"\n             , \"13 till 15 Juli\"\n             , \"13 juli till 15 juli\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"8 Aug - 12 Aug\"\n             , \"8 Aug - 12 aug\"\n             , \"8 aug - 12 aug\"\n             , \"8 augusti - 12 augusti\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             , \"9:30 till 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"fr\u00c3\u00a5n 9:30 - 11:00 p\u00c3\u00a5 torsdag\"\n             , \"fr\u00c3\u00a5n 9:30 till 11:00 p\u00c3\u00a5 torsdag\"\n             , \"mellan 9:30 och 11:00 p\u00c3\u00a5 torsdag\"\n             , \"9:30 - 11:00 p\u00c3\u00a5 torsdag\"\n             , \"9:30 till 11:00 p\u00c3\u00a5 torsdag\"\n             , \"efter 9:30 men f\u00c3\u00b6re 11:00 p\u00c3\u00a5 torsdag\"\n             , \"torsdag fr\u00c3\u00a5n 9:30 till 11:00\"\n             , \"torsdag mellan 9:30 och 11:00\"\n             , \"fr\u00c3\u00a5n 9:30 till 11:00 p\u00c3\u00a5 torsdag\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"torsdag fr\u00c3\u00a5n 9 till 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"11:30-13:30\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 26, 0, 0, 0)) Second)\n             [ \"inom 2 veckor\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"innan kl. 14\"\n             , \"innan klockan 14\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 0, 0) Minute)\n             [ \"@ 16 CET\"\n             , \"kl. 16 CET\"\n             , \"klockan 16 CET\"\n             ]\n  , examples (datetime (2013, 2, 14, 6, 0, 0) Minute)\n             [ \"torsdag kl. 8:00 GMT\"\n             , \"torsdag kl. 8:00 gmt\"\n             , \"torsdag klockan 8:00 GMT\"\n             , \"torsdag klockan 8:00 gmt\"\n             , \"torsdag 08:00 GMT\"\n             , \"torsdag 08:00 gmt\"\n             ]\n  , examples (datetime (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"idag kl. 14\"\n             , \"idag klockan 14\"\n             , \"kl. 14\"\n             , \"klockan 14\"\n             ]\n  , examples (datetime (2013, 4, 25, 16, 0, 0) Minute)\n             [ \"25/4 kl. 16:00\"\n             , \"25/4 klockan 16:00\"\n             , \"25-04 klockan 16:00\"\n             , \"25-4 kl. 16:00\"\n             , \"2013-04-25 kl 16:00\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Minute)\n             [ \"15:00 imorgon\"\n             , \"kl. 15:00 imorgon\"\n             , \"klockan 15:00 imorgon\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 12, 14, 0, 0) Hour)\n             [ \"efter kl. 14\"\n             , \"efter klockan 14\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"efter 5 dagar\"\n             , \"efter fem dagar\"\n             ]\n  , examples (datetime (2013, 2, 17, 4, 0, 0) Hour)\n             [ \"om 5 dagar\"\n             , \"om fem dagar\"\n             ]\n  , examples (datetimeOpenInterval After (2013, 2, 13, 14, 0, 0) Hour)\n             [ \"efter imorgon kl. 14\"\n             , \"efter imorgon klockan 14\"\n             , \"imorgon efter kl. 14\"\n             , \"imorgon efter klockan 14\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 12, 11, 0, 0) Hour)\n             [ \"f\u00c3\u00b6re kl. 11\"\n             , \"f\u00c3\u00b6re klockan 11\"\n             ]\n  , examples (datetimeOpenInterval Before (2013, 2, 13, 11, 0, 0) Hour)\n             [ \"imorgon f\u00c3\u00b6re kl. 11\"\n             , \"imorgon f\u00c3\u00b6re klockan 11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 12, 0, 0), (2013, 2, 12, 19, 0, 0)) Hour)\n             [ \"under eftermiddagen\"\n             ]\n  , examples (datetime (2013, 2, 12, 13, 30, 0) Minute)\n             [ \"kl. 13:30\"\n             , \"klockan 13:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 45, 0) Second)\n             [ \"om 15 minuter\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 13, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"efter lunch\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"10:30\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"n\u00c3\u00a4sta m\u00c3\u00a5ndag\"\n             ]\n  ]\n", "num_lines": 623}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.SV.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.Helpers (isGrain)\nimport Duckling.Numeral.Helpers (parseInt)\nimport Duckling.Ordinal.Types (OrdinalData(..))\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Time.Types (TimeData(..))\nimport Duckling.Types\nimport qualified Data.Text as Text\nimport qualified Duckling.Ordinal.Types as TOrdinal\nimport qualified Duckling.Time.Types as TTime\nimport qualified Duckling.TimeGrain.Types as TG\n\nruleDaysOfWeek :: [Rule]\nruleDaysOfWeek = mkRuleDaysOfWeek\n  [ ( \"Mandag\"  , \"m\u00c3\u00a5ndag(en)?s?|m\u00c3\u00a5n\\\\.?\"    )\n  , ( \"Tisdag\"  , \"tisdag(en)?s?|tis?\\\\.?\"   )\n  , ( \"Onsdag\"  , \"onsdag(en)?s?|ons\\\\.?\"    )\n  , ( \"Torsdag\" , \"torsdag(en)?s?|tors?\\\\.?\" )\n  , ( \"Fredag\"  , \"fredag(en)?s?|fre\\\\.?\"    )\n  , ( \"Lordag\"  , \"l\u00c3\u00b6rdag(en)?s?|l\u00c3\u00b6r\\\\.?\"    )\n  , ( \"Sondag\"  , \"s\u00c3\u00b6ndag(en)?s?|s\u00c3\u00b6n\\\\.?\"    )\n  ]\n\nruleMonths :: [Rule]\nruleMonths = mkRuleMonths\n  [ (\"Januari\"   , \"januari|jan\\\\.?\"     )\n  , (\"Februari\"  , \"februari|feb\\\\.?\"    )\n  , (\"Mars\"      , \"mars|mar\\\\.?\"        )\n  , (\"April\"     , \"april|apr\\\\.?\"       )\n  , (\"Maj\"       , \"maj\"                 )\n  , (\"Juni\"      , \"juni|jun\\\\.?\"        )\n  , (\"Juli\"      , \"juli|jul\\\\.?\"        )\n  , (\"Augusti\"   , \"augusti|aug\\\\.?\"     )\n  , (\"September\" , \"september|sept?\\\\.?\" )\n  , (\"Oktober\"   , \"oktober|okt\\\\.?\"     )\n  , (\"November\"  , \"november|nov\\\\.?\"    )\n  , (\"December\"  , \"december|dec\\\\.?\"    )\n  ]\n\nruleTheDayAfterTomorrow :: Rule\nruleTheDayAfterTomorrow = Rule\n  { name = \"the day after tomorrow\"\n  , pattern =\n    [ regex \"i \u00c3\u00b6verimorgon\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 2\n  }\n\nruleRelativeMinutesTotillbeforeIntegerHourofday :: Rule\nruleRelativeMinutesTotillbeforeIntegerHourofday = Rule\n  { name = \"relative minutes to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"i\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> do\n        n <- getIntValue token\n        Token Time <$> minutesBefore n td\n      _ -> Nothing\n  }\n\nruleRelativeMinutesAfterpastIntegerHourofday :: Rule\nruleRelativeMinutesAfterpastIntegerHourofday = Rule\n  { name = \"relative minutes after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 59\n    , regex \"\u00c3\u00b6ver\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       _:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute True hours n\n      _ -> Nothing\n  }\n\nruleHourofdayIntegerAsRelativeMinutes :: Rule\nruleHourofdayIntegerAsRelativeMinutes = Rule\n  { name = \"<hour-of-day> <integer> (as relative minutes)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isAnHourOfDay]\n    , Predicate $ isIntegerBetween 1 59\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       token:\n       _) -> do\n        n <- getIntValue token\n        tt $ hourMinute True hours n\n      _ -> Nothing\n  }\n\nruleQuarterTotillbeforeIntegerHourofday :: Rule\nruleQuarterTotillbeforeIntegerHourofday = Rule\n  { name = \"quarter to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"(en)? ?(kvart)(er)?\"\n    , regex \"i\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:_:Token Time td:_) -> Token Time <$> minutesBefore 15 td\n      _ -> Nothing\n  }\n\nruleQuarterAfterpastIntegerHourofday :: Rule\nruleQuarterAfterpastIntegerHourofday = Rule\n  { name = \"quarter after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"(en)? ?(kvart)(er)?\"\n    , regex \"\u00c3\u00b6ver\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       _:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 15\n      _ -> Nothing\n  }\n\nruleHourofdayQuarter :: Rule\nruleHourofdayQuarter = Rule\n  { name = \"<hour-of-day> quarter (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex  \"(en)? ?(kvart)(er)?\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 15\n      _ -> Nothing\n  }\n\nruleHalfTotillbeforeIntegerHourofday :: Rule\nruleHalfTotillbeforeIntegerHourofday = Rule\n  { name = \"half to|till|before <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halvtimme\"\n    , regex \"i\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:_:Token Time td:_) -> Token Time <$> minutesBefore 30 td\n      _ -> Nothing\n  }\n\nruleHalfAfterpastIntegerHourofday :: Rule\nruleHalfAfterpastIntegerHourofday = Rule\n  { name = \"half after|past <integer> (hour-of-day)\"\n  , pattern =\n    [ regex \"halvtimme\"\n    , regex \"\u00c3\u00b6ver\"\n    , Predicate isAnHourOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       _:\n       Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 30\n      _ -> Nothing\n  }\n\nruleHourofdayHalf :: Rule\nruleHourofdayHalf = Rule\n  { name = \"<hour-of-day> half (as relative minutes)\"\n  , pattern =\n    [ Predicate isAnHourOfDay\n    , regex \"halvtimme\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) _)}:\n       _) -> tt $ hourMinute True hours 30\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleOfTime :: Rule\nruleTheOrdinalCycleOfTime = Rule\n  { name = \"the <ordinal> <cycle> of <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"av|i|fr\u00c3\u00a5n\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime2 :: Rule\nruleNthTimeOfTime2 = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"av|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleNewYearsDay :: Rule\nruleNewYearsDay = Rule\n  { name = \"new year's day\"\n  , pattern =\n    [ regex \"ny\u00c3\u00a5rsdag(en)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 1 1\n  }\n\nruleLastTime :: Rule\nruleLastTime = Rule\n  { name = \"last <time>\"\n  , pattern =\n    [ regex \"(sista|f\u00c3\u00b6rra|senaste)\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-1) False td\n      _ -> Nothing\n  }\n\nruleDatetimeDatetimeInterval :: Rule\nruleDatetimeDatetimeInterval = Rule\n  { name = \"<datetime> - <datetime> (interval)\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"\\\\-|till|till och med|tom\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleEvening :: Rule\nruleEvening = Rule\n  { name = \"evening\"\n  , pattern =\n    [ regex \"kv\u00c3\u00a4ll(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 18\n          to = hour False 0\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTheDayofmonthNonOrdinal :: Rule\nruleTheDayofmonthNonOrdinal = Rule\n  { name = \"the <day-of-month> (non ordinal)\"\n  , pattern =\n    [ regex \"den\"\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleCycleAfterTime :: Rule\nruleCycleAfterTime = Rule\n  { name = \"<cycle> after <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleInDuration :: Rule\nruleInDuration = Rule\n  { name = \"in <duration>\"\n  , pattern =\n    [ regex \"om\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleNow :: Rule\nruleNow = Rule\n  { name = \"now\"\n  , pattern =\n    [ regex \"just nu|nu|(i )?detta \u00c3\u00b6gonblick\"\n    ]\n  , prod = \\_ -> tt now\n  }\n\nruleLastCycleOfTime :: Rule\nruleLastCycleOfTime = Rule\n  { name = \"last <cycle> of <time>\"\n  , pattern =\n    [ regex \"sista\"\n    , dimension TimeGrain\n    , regex \"av|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleLastOf grain td\n      _ -> Nothing\n  }\n\nruleFromDatetimeDatetimeInterval :: Rule\nruleFromDatetimeDatetimeInterval = Rule\n  { name = \"from <datetime> - <datetime> (interval)\"\n  , pattern =\n    [ regex \"fr\u00c3\u00a5n\"\n    , dimension Time\n    , regex \"\\\\-|till|till och med|tom\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleMonthDdddInterval :: Rule\nruleMonthDdddInterval = Rule\n  { name = \"<month> dd-dd (interval)\"\n  , pattern =\n    [ regex \"([012]?\\\\d|30|31)(er|\\\\.)?\"\n    , regex \"\\\\-|till\"\n    , regex \"([012]?\\\\d|30|31)(er|\\\\.)?\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:_)):\n       _:\n       Token RegexMatch (GroupMatch (m2:_)):\n       Token Time td:\n       _) -> do\n        v1 <- parseInt m1\n        v2 <- parseInt m2\n        from <- intersect (dayOfMonth v1) td\n        to <- intersect (dayOfMonth v2) td\n        Token Time <$> interval TTime.Closed from to\n      _ -> Nothing\n  }\n\nruleTheCycleAfterTime :: Rule\nruleTheCycleAfterTime = Rule\n  { name = \"the <cycle> after <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|na|et)? efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain 1 td\n      _ -> Nothing\n  }\n\nruleTheCycleBeforeTime :: Rule\nruleTheCycleBeforeTime = Rule\n  { name = \"the <cycle> before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|na|et)? f\u00c3\u00b6re\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleYearLatent2 :: Rule\nruleYearLatent2 = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 2101 10000\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleTimeAfterNext :: Rule\nruleTimeAfterNext = Rule\n  { name = \"<time> after next\"\n  , pattern =\n    [ regex \"n\u00c3\u00a4sta\"\n    , dimension Time\n    , regex \"igen\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 1 True td\n      _ -> Nothing\n  }\n\nruleTheIdesOfNamedmonth :: Rule\nruleTheIdesOfNamedmonth = Rule\n  { name = \"the ides of <named-month>\"\n  , pattern =\n    [ regex \"mitten av\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td@TimeData {TTime.form = Just (TTime.Month m)}:_) ->\n        Token Time <$>\n          intersect (dayOfMonth $ if elem m [3, 5, 7, 10] then 15 else 13) td\n      _ -> Nothing\n  }\n\nruleNoon :: Rule\nruleNoon = Rule\n  { name = \"noon\"\n  , pattern =\n    [ regex \"middag|(kl(\\\\.|ockan)?)? tolv\"\n    ]\n  , prod = \\_ -> tt $ hour False 12\n  }\n\nruleToday :: Rule\nruleToday = Rule\n  { name = \"today\"\n  , pattern =\n    [ regex \"i dag|idag\"\n    ]\n  , prod = \\_ -> tt today\n  }\n\nruleThisnextDayofweek :: Rule\nruleThisnextDayofweek = Rule\n  { name = \"this|next <day-of-week>\"\n  , pattern =\n    [ regex \"(kommande|n\u00c3\u00a4sta)\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleLastDayofweek :: Rule\nruleLastDayofweek = Rule\n  { name = \"last <day-of-week>\"\n  , pattern =\n    [ regex \"i\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ predNth (-1) True td\n      _ -> Nothing\n  }\n\nruleTheDayBeforeYesterday :: Rule\nruleTheDayBeforeYesterday = Rule\n  { name = \"the day before yesterday\"\n  , pattern =\n    [ regex \"i f\u00c3\u00b6rrg\u00c3\u00a5r\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 2\n  }\n\nruleBetweenTimeofdayAndTimeofdayInterval :: Rule\nruleBetweenTimeofdayAndTimeofdayInterval = Rule\n  { name = \"between <time-of-day> and <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"mellan\"\n    , Predicate isATimeOfDay\n    , regex \"och\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNextCycle :: Rule\nruleNextCycle = Rule\n  { name = \"next <cycle>\"\n  , pattern =\n    [ regex \"n\u00c3\u00a4sta|kommande\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 1\n      _ -> Nothing\n  }\n\nruleTheCycleOfTime :: Rule\nruleTheCycleOfTime = Rule\n  { name = \"the <cycle> of <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"(en|na|et)? av\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain 0 td\n      _ -> Nothing\n  }\n\nruleTimeofdayApproximately :: Rule\nruleTimeofdayApproximately = Rule\n  { name = \"<time-of-day> approximately\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(cirka|ca\\\\.|-?ish)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleOnDate :: Rule\nruleOnDate = Rule\n  { name = \"on <date>\"\n  , pattern =\n    [ regex \"den|p\u00c3\u00a5|under\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDurationFromNow :: Rule\nruleDurationFromNow = Rule\n  { name = \"<duration> from now\"\n  , pattern =\n    [ dimension Duration\n    , regex \"fr\u00c3\u00a5n (idag|nu)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleLunch :: Rule\nruleLunch = Rule\n  { name = \"lunch\"\n  , pattern =\n    [ regex \"lunch(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 14\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleLastCycle :: Rule\nruleLastCycle = Rule\n  { name = \"last <cycle>\"\n  , pattern =\n    [ regex \"sista|senaste|f(\u00c3\u00b6)rra|f(\u00c3\u00b6)reg(\u00c3\u00a5)ende\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt . cycleNth grain $ - 1\n      _ -> Nothing\n  }\n\nruleDdmm :: Rule\nruleDdmm = Rule\n  { name = \"dd/mm\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\/-](0?[1-9]|1[0-2])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        d <- parseInt m1\n        m <- parseInt m2\n        tt $ monthDay m d\n      _ -> Nothing\n  }\n\nruleAfternoon :: Rule\nruleAfternoon = Rule\n  { name = \"afternoon\"\n  , pattern =\n    [ regex \"eftermiddag(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 12\n          to = hour False 19\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleTimeBeforeLast :: Rule\nruleTimeBeforeLast = Rule\n  { name = \"<time> before last\"\n  , pattern =\n    [ regex \"sista\"\n    , dimension Time\n    , regex \"igen\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth (-2) False td\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthOrdinal :: Rule\nruleNamedmonthDayofmonthOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleChristmasEve :: Rule\nruleChristmasEve = Rule\n  { name = \"christmas eve\"\n  , pattern =\n    [ regex \"julafton?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 24\n  }\n\nruleInduringThePartofday :: Rule\nruleInduringThePartofday = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"om|i\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonth :: Rule\nruleDayofmonthordinalNamedmonth = Rule\n  { name = \"<day-of-month>(ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersectBy :: Rule\nruleIntersectBy = Rule\n  { name = \"intersect by \\\",\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \",\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNthTimeAfterTime :: Rule\nruleNthTimeAfterTime = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleAfterDuration :: Rule\nruleAfterDuration = Rule\n  { name = \"after <duration>\"\n  , pattern =\n    [ regex \"efter\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt . withDirection TTime.After $ inDuration dd\n      _ -> Nothing\n  }\n\nruleTimeofdayLatent :: Rule\nruleTimeofdayLatent = Rule\n  { name = \"time-of-day (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 0 23\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        n <- getIntValue token\n        tt . mkLatent $ hour False n\n      _ -> Nothing\n  }\n\nruleDayofmonthOrdinalOfNamedmonth :: Rule\nruleDayofmonthOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , regex \"av|i\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleFromTimeofdayTimeofdayInterval :: Rule\nruleFromTimeofdayTimeofdayInterval = Rule\n  { name = \"from <time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ regex \"(efter|fr\u00c3\u00a5n)\"\n    , Predicate isATimeOfDay\n    , regex \"((men )?f\u00c3\u00b6re)|\\\\-|till|till och med|tom\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleExactlyTimeofday :: Rule\nruleExactlyTimeofday = Rule\n  { name = \"exactly <time-of-day>\"\n  , pattern =\n    [ regex \"(precis|exakt)( kl.| klockan)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleInduringThePartofday2 :: Rule\nruleInduringThePartofday2 = Rule\n  { name = \"in|during the <part-of-day>\"\n  , pattern =\n    [ regex \"om|i\"\n    , Predicate isAPartOfDay\n    , regex \"en|ten\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleSeasons :: [Rule]\nruleSeasons = mkRuleSeasons\n  [ ( \"sommar\"  , \"sommar(en)\"       , monthDay  6 21, monthDay  9 23 )\n  , ( \"vinter\"  , \"vinter(n)\"           , monthDay 12 21, monthDay  3 20 )\n  ]\n\nruleBetweenDatetimeAndDatetimeInterval :: Rule\nruleBetweenDatetimeAndDatetimeInterval = Rule\n  { name = \"between <datetime> and <datetime> (interval)\"\n  , pattern =\n    [ regex \"mellan\"\n    , dimension Time\n    , regex \"och\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleNewYearsEve :: Rule\nruleNewYearsEve = Rule\n  { name = \"new year's eve\"\n  , pattern =\n    [ regex \"ny\u00c3\u00a5rsafton?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 31\n  }\n\nruleDurationAgo :: Rule\nruleDurationAgo = Rule\n  { name = \"<duration> ago\"\n  , pattern =\n    [ dimension Duration\n    , regex \"sedan\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_) ->\n        tt $ durationAgo dd\n      _ -> Nothing\n  }\n\nruleByTheEndOfTime :: Rule\nruleByTheEndOfTime = Rule\n  { name = \"by the end of <time>\"\n  , pattern =\n    [ regex \"i slutet av\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time <$> interval TTime.Closed now td\n      _ -> Nothing\n  }\n\nruleAfterWork :: Rule\nruleAfterWork = Rule\n  { name = \"after work\"\n  , pattern =\n    [ regex \"efter jobbet\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 17) (hour False 21)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleLastNCycle :: Rule\nruleLastNCycle = Rule\n  { name = \"last n <cycle>\"\n  , pattern =\n    [ regex \"sista|senaste|f\u00c3\u00b6rra\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain (- v)\n      _ -> Nothing\n  }\n\nruleTimeofdaySharp :: Rule\nruleTimeofdaySharp = Rule\n  { name = \"<time-of-day> sharp\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"(sharp|precis|exakt)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleWithinDuration :: Rule\nruleWithinDuration = Rule\n  { name = \"within <duration>\"\n  , pattern =\n    [ regex \"(innanf\u00c3\u00b6r|inom)\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        Token Time <$> interval TTime.Open now (inDuration dd)\n      _ -> Nothing\n  }\n\nruleMidnighteodendOfDay :: Rule\nruleMidnighteodendOfDay = Rule\n  { name = \"midnight|EOD|end of day\"\n  , pattern =\n    [ regex \"midnatt|EOD\"\n    ]\n  , prod = \\_ -> tt $ hour False 0\n  }\n\nruleDayofmonthNonOrdinalNamedmonth :: Rule\nruleDayofmonthNonOrdinalNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleIntersect :: Rule\nruleIntersect = Rule\n  { name = \"intersect\"\n  , pattern =\n    [ Predicate isNotLatent\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleAboutTimeofday :: Rule\nruleAboutTimeofday = Rule\n  { name = \"about <time-of-day>\"\n  , pattern =\n    [ regex \"(omkring|cirka|vid|runt|ca\\\\.)( kl\\\\.| klockan)?\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleUntilTimeofday :: Rule\nruleUntilTimeofday = Rule\n  { name = \"until <time-of-day>\"\n  , pattern =\n    [ regex \"innan|f\u00c3\u00b6re|intill\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ withDirection TTime.Before td\n      _ -> Nothing\n  }\n\nruleAtTimeofday :: Rule\nruleAtTimeofday = Rule\n  { name = \"at <time-of-day>\"\n  , pattern =\n    [ regex \"klockan|kl.|kl|@\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleNthTimeOfTime :: Rule\nruleNthTimeOfTime = Rule\n  { name = \"nth <time> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension Time\n    , regex \"av|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> Token Time . predNth (v - 1) False <$> intersect td2 td1\n      _ -> Nothing\n  }\n\nruleTimePartofday :: Rule\nruleTimePartofday = Rule\n  { name = \"<time> <part-of-day>\"\n  , pattern =\n    [ dimension Time\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleWeekend :: Rule\nruleWeekend = Rule\n  { name = \"week-end\"\n  , pattern =\n    [ regex \"((week(\\\\s|-)?end)|helg)(en)?\"\n    ]\n  , prod = \\_ -> tt $ mkOkForThisNext weekend\n  }\n\nruleEomendOfMonth :: Rule\nruleEomendOfMonth = Rule\n  { name = \"EOM|End of month\"\n  , pattern =\n    [ regex \"EOM\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Month 1\n  }\n\nruleLastYear :: Rule\nruleLastYear = Rule\n  { name = \"Last year\"\n  , pattern =\n    [ regex \"i fjol|ifjol\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Year $ - 1\n  }\n\nruleNthTimeAfterTime2 :: Rule\nruleNthTimeAfterTime2 = Rule\n  { name = \"nth <time> after <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension Time\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       Token Time td1:\n       _:\n       Token Time td2:\n       _) -> tt $ predNthAfter (v - 1) td1 td2\n      _ -> Nothing\n  }\n\nruleNextTime :: Rule\nruleNextTime = Rule\n  { name = \"next <time>\"\n  , pattern =\n    [ regex \"n\u00c3\u00a4sta|kommande\"\n    , Predicate $ and . sequence [isNotLatent, isOkWithThisNext]\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 True td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarterYear :: Rule\nruleOrdinalQuarterYear = Rule\n  { name = \"<ordinal> quarter <year>\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:_:Token Time td:_) ->\n        tt $ cycleNthAfter False TG.Quarter (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleYyyymmdd :: Rule\nruleYyyymmdd = Rule\n  { name = \"yyyy-mm-dd\"\n  , pattern =\n    [ regex \"(\\\\d{2,4})-(0?[1-9]|1[0-2])-(3[01]|[12]\\\\d|0?[1-9])\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m1\n        m <- parseInt m2\n        d <- parseInt m3\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTheOrdinalCycleAfterTime :: Rule\nruleTheOrdinalCycleAfterTime = Rule\n  { name = \"the <ordinal> <cycle> after <time>\"\n  , pattern =\n    [ regex \"den\"\n    , dimension Ordinal\n    , dimension TimeGrain\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleIntersectByOfFromS :: Rule\nruleIntersectByOfFromS = Rule\n  { name = \"intersect by \\\"of\\\", \\\"from\\\", \\\"'s\\\"\"\n  , pattern =\n    [ Predicate isNotLatent\n    , regex \"i\"\n    , Predicate isNotLatent\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleNextNCycle :: Rule\nruleNextNCycle = Rule\n  { name = \"next n <cycle>\"\n  , pattern =\n    [ regex \"n\u00c3\u00a4sta\"\n    , Predicate $ isIntegerBetween 1 9999\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:token:Token TimeGrain grain:_) -> do\n        v <- getIntValue token\n        tt $ cycleN True grain v\n      _ -> Nothing\n  }\n\nruleADuration :: Rule\nruleADuration = Rule\n  { name = \"a <duration>\"\n  , pattern =\n    [ regex \"(om )?en|ett\"\n    , dimension Duration\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Duration dd:_) ->\n        tt $ inDuration dd\n      _ -> Nothing\n  }\n\nruleMorning :: Rule\nruleMorning = Rule\n  { name = \"morning\"\n  , pattern =\n    [ regex \"morgon(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 4\n          to = hour False 12\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleThisPartofday :: Rule\nruleThisPartofday = Rule\n  { name = \"this <part-of-day>\"\n  , pattern =\n    [ regex \"i|denna\"\n    , Predicate isAPartOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) -> Token Time . partOfDay <$> intersect today td\n      _ -> Nothing\n  }\n\nruleThisCycle :: Rule\nruleThisCycle = Rule\n  { name = \"this <cycle>\"\n  , pattern =\n    [ regex \"denna|detta|i|nuvarande\"\n    , dimension TimeGrain\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token TimeGrain grain:_) ->\n        tt $ cycleNth grain 0\n      _ -> Nothing\n  }\n\nruleThisTime :: Rule\nruleThisTime = Rule\n  { name = \"this <time>\"\n  , pattern =\n    [ regex \"(denna|detta|i|den h\u00c3\u00a4r)\"\n    , Predicate isOkWithThisNext\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt $ predNth 0 False td\n      _ -> Nothing\n  }\n\nruleDayofmonthNonOrdinalOfNamedmonth :: Rule\nruleDayofmonthNonOrdinalOfNamedmonth = Rule\n  { name = \"<day-of-month> (non ordinal) of <named-month>\"\n  , pattern =\n    [ Predicate isDOMInteger\n    , regex \"av|i\"\n    , Predicate isAMonth\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_:Token Time td:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAfterLunch :: Rule\nruleAfterLunch = Rule\n  { name = \"after lunch\"\n  , pattern =\n    [ regex \"efter (lunch)\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 13) (hour False 17)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleOnANamedday :: Rule\nruleOnANamedday = Rule\n  { name = \"on a named-day\"\n  , pattern =\n    [ regex \"p\u00c3\u00a5 en\"\n    , Predicate isADayOfWeek\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleYearLatent :: Rule\nruleYearLatent = Rule\n  { name = \"year (latent)\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1 999\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt . mkLatent $ year v\n      _ -> Nothing\n  }\n\nruleYesterday :: Rule\nruleYesterday = Rule\n  { name = \"yesterday\"\n  , pattern =\n    [ regex \"i g\u00c3\u00a5r|ig\u00c3\u00a5r\"\n    ]\n  , prod = \\_ -> tt . cycleNth TG.Day $ - 1\n  }\n\nruleAfterTimeofday :: Rule\nruleAfterTimeofday = Rule\n  { name = \"after <time-of-day>\"\n  , pattern =\n    [ regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td:_) ->\n        tt . notLatent $ withDirection TTime.After td\n      _ -> Nothing\n  }\n\nruleChristmas :: Rule\nruleChristmas = Rule\n  { name = \"christmas\"\n  , pattern =\n    [ regex \"juldag(en)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 12 25\n  }\n\nruleNight :: Rule\nruleNight = Rule\n  { name = \"night\"\n  , pattern =\n    [ regex \"natt(en)?\"\n    ]\n  , prod = \\_ ->\n      let from = hour False 0\n          to = hour False 4\n      in Token Time . mkLatent . partOfDay <$>\n           interval TTime.Open from to\n  }\n\nruleDayofmonthOrdinal :: Rule\nruleDayofmonthOrdinal = Rule\n  { name = \"<day-of-month> (ordinal)\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) ->\n        tt . mkLatent $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleOrdinalCycleAfterTime :: Rule\nruleOrdinalCycleAfterTime = Rule\n  { name = \"<ordinal> <cycle> after <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleOrdinalCycleOfTime :: Rule\nruleOrdinalCycleOfTime = Rule\n  { name = \"<ordinal> <cycle> of <time>\"\n  , pattern =\n    [ dimension Ordinal\n    , dimension TimeGrain\n    , regex \"av|i|fr\u00c3\u00a5n\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal od:Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter True grain (TOrdinal.value od - 1) td\n      _ -> Nothing\n  }\n\nruleHhmm :: Rule\nruleHhmm = Rule\n  { name = \"hh:mm\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:_)):_) -> do\n        h <- parseInt m1\n        m <- parseInt m2\n        tt $ hourMinute False h m\n      _ -> Nothing\n  }\n\nruleTonight :: Rule\nruleTonight = Rule\n  { name = \"tonight\"\n  , pattern =\n    [ regex \"ikv\u00c3\u00a4ll\"\n    ]\n  , prod = \\_ -> do\n      td2 <- interval TTime.Open (hour False 18) (hour False 0)\n      Token Time . partOfDay <$> intersect today td2\n  }\n\nruleYear :: Rule\nruleYear = Rule\n  { name = \"year\"\n  , pattern =\n    [ Predicate $ isIntegerBetween 1000 2100\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:_) -> do\n        v <- getIntValue token\n        tt $ year v\n      _ -> Nothing\n  }\n\nruleNamedmonthDayofmonthNonOrdinal :: Rule\nruleNamedmonthDayofmonthNonOrdinal = Rule\n  { name = \"<named-month> <day-of-month> (non ordinal)\"\n  , pattern =\n    [ Predicate isAMonth\n    , Predicate isDOMInteger\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:token:_) -> Token Time <$> intersectDOM td token\n      _ -> Nothing\n  }\n\nruleAbsorptionOfAfterNamedDay :: Rule\nruleAbsorptionOfAfterNamedDay = Rule\n  { name = \"absorption of , after named day\"\n  , pattern =\n    [ Predicate isADayOfWeek\n    , regex \",\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (x:_) -> Just x\n      _ -> Nothing\n  }\n\nruleLastDayofweekOfTime :: Rule\nruleLastDayofweekOfTime = Rule\n  { name = \"last <day-of-week> of <time>\"\n  , pattern =\n    [ regex \"sista\"\n    , Predicate isADayOfWeek\n    , regex \"av|i\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:Token Time td1:_:Token Time td2:_) ->\n        tt $ predLastOf td1 td2\n      _ -> Nothing\n  }\n\nruleCycleBeforeTime :: Rule\nruleCycleBeforeTime = Rule\n  { name = \"<cycle> before <time>\"\n  , pattern =\n    [ dimension TimeGrain\n    , regex \"f\u00c3\u00b6re\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token TimeGrain grain:_:Token Time td:_) ->\n        tt $ cycleNthAfter False grain (-1) td\n      _ -> Nothing\n  }\n\nruleDdmmyyyy :: Rule\nruleDdmmyyyy = Rule\n  { name = \"dd/mm/yyyy\"\n  , pattern =\n    [ regex \"(3[01]|[12]\\\\d|0?[1-9])[\\\\/-](0?[1-9]|1[0-2])[\\\\/-](\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m1:m2:m3:_)):_) -> do\n        y <- parseInt m3\n        m <- parseInt m2\n        d <- parseInt m1\n        tt $ yearMonthDay y m d\n      _ -> Nothing\n  }\n\nruleTimeofdayTimeofdayInterval :: Rule\nruleTimeofdayTimeofdayInterval = Rule\n  { name = \"<time-of-day> - <time-of-day> (interval)\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\-|till|till och med|tom\"\n    , Predicate isATimeOfDay\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> interval TTime.Closed td1 td2\n      _ -> Nothing\n  }\n\nruleDurationAfterTime :: Rule\nruleDurationAfterTime = Rule\n  { name = \"<duration> after <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"efter\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationAfter dd td\n      _ -> Nothing\n  }\n\nruleOrdinalQuarter :: Rule\nruleOrdinalQuarter = Rule\n  { name = \"<ordinal> quarter\"\n  , pattern =\n    [ dimension Ordinal\n    , Predicate $ isGrain TG.Quarter\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Ordinal OrdinalData{TOrdinal.value = v}:_) -> tt .\n        cycleNthAfter False TG.Quarter (v - 1) $ cycleNth TG.Year 0\n      _ -> Nothing\n  }\n\nruleTheDayofmonthOrdinal :: Rule\nruleTheDayofmonthOrdinal = Rule\n  { name = \"the <day-of-month> (ordinal)\"\n  , pattern =\n    [ regex \"den\"\n    , Predicate isDOMOrdinal\n    ]\n  , prod = \\tokens -> case tokens of\n      (_:\n       Token Ordinal OrdinalData{TOrdinal.value = v}:\n       _) -> tt $ dayOfMonth v\n      _ -> Nothing\n  }\n\nruleDurationBeforeTime :: Rule\nruleDurationBeforeTime = Rule\n  { name = \"<duration> before <time>\"\n  , pattern =\n    [ dimension Duration\n    , regex \"f\u00c3\u00b6re\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Duration dd:_:Token Time td:_) ->\n        tt $ durationBefore dd td\n      _ -> Nothing\n  }\n\nrulePartofdayOfTime :: Rule\nrulePartofdayOfTime = Rule\n  { name = \"<part-of-day> of <time>\"\n  , pattern =\n    [ Predicate isAPartOfDay\n    , regex \"(en |ten )?den\"\n    , dimension Time\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td1:_:Token Time td2:_) ->\n        Token Time <$> intersect td1 td2\n      _ -> Nothing\n  }\n\nruleEoyendOfYear :: Rule\nruleEoyendOfYear = Rule\n  { name = \"EOY|End of year\"\n  , pattern =\n    [ regex \"EOY\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Year 1\n  }\n\nruleTomorrow :: Rule\nruleTomorrow = Rule\n  { name = \"tomorrow\"\n  , pattern =\n    [ regex \"i morgon|imorgon\"\n    ]\n  , prod = \\_ -> tt $ cycleNth TG.Day 1\n  }\n\nruleTimeofdayOclock :: Rule\nruleTimeofdayOclock = Rule\n  { name = \"<time-of-day> o'clock\"\n  , pattern =\n    [ Predicate isATimeOfDay\n    , regex \"( )?h\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:_) ->\n        tt $ notLatent td\n      _ -> Nothing\n  }\n\nruleDayofmonthordinalNamedmonthYear :: Rule\nruleDayofmonthordinalNamedmonthYear = Rule\n  { name = \"<day-of-month>(ordinal) <named-month> year\"\n  , pattern =\n    [ Predicate isDOMOrdinal\n    , Predicate isAMonth\n    , regex \"(\\\\d{2,4})\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (token:\n       Token Time td:\n       Token RegexMatch (GroupMatch (match:_)):\n       _) -> do\n         y <- parseInt match\n         dom <- intersectDOM td token\n         Token Time <$> intersect dom (year y)\n      _ -> Nothing\n  }\n\nruleHhmmss :: Rule\nruleHhmmss = Rule\n  { name = \"hh:mm:ss\"\n  , pattern =\n    [ regex \"((?:[01]?\\\\d)|(?:2[0-3]))[:.]([0-5]\\\\d)[:.]([0-5]\\\\d)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (hh:mm:ss:_)):_) -> do\n        h <- parseInt hh\n        m <- parseInt mm\n        s <- parseInt ss\n        tt $ hourMinuteSecond False h m s\n      _ -> Nothing\n  }\n\nruleTimezone :: Rule\nruleTimezone = Rule\n  { name = \"<time> timezone\"\n  , pattern =\n    [ Predicate $ and . sequence [isNotLatent, isATimeOfDay]\n    , regex \"\\\\b(YEKT|YEKST|YAKT|YAKST|WITA|WIT|WIB|WGT|WGST|WFT|WET|WEST|WAT|WAST|VUT|VLAT|VLAST|VET|UZT|UYT|UYST|UTC|ULAT|TVT|TMT|TLT|TKT|TJT|TFT|TAHT|SST|SRT|SGT|SCT|SBT|SAST|SAMT|RET|PYT|PYST|PWT|PST|PONT|PMST|PMDT|PKT|PHT|PHOT|PGT|PETT|PETST|PET|PDT|OMST|OMSST|NZST|NZDT|NUT|NST|NPT|NOVT|NOVST|NFT|NDT|NCT|MYT|MVT|MUT|MST|MSK|MSD|MMT|MHT|MDT|MAWT|MART|MAGT|MAGST|LINT|LHST|LHDT|KUYT|KST|KRAT|KRAST|KGT|JST|IST|IRST|IRKT|IRKST|IRDT|IOT|IDT|ICT|HOVT|HKT|GYT|GST|GMT|GILT|GFT|GET|GAMT|GALT|FNT|FKT|FKST|FJT|FJST|EST|EGT|EGST|EET|EEST|EDT|ECT|EAT|EAST|EASST|DAVT|ChST|CXT|CVT|CST|COT|CLT|CLST|CKT|CHAST|CHADT|CET|CEST|CDT|CCT|CAT|CAST|BTT|BST|BRT|BRST|BOT|BNT|AZT|AZST|AZOT|AZOST|AWST|AWDT|AST|ART|AQTT|ANAT|ANAST|AMT|AMST|ALMT|AKST|AKDT|AFT|AEST|AEDT|ADT|ACST|ACDT)\\\\b\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token Time td:\n       Token RegexMatch (GroupMatch (tz:_)):\n       _) -> Token Time <$> inTimezone (Text.toUpper tz) td\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleADuration\n  , ruleAboutTimeofday\n  , ruleAbsorptionOfAfterNamedDay\n  , ruleAfterDuration\n  , ruleAfterLunch\n  , ruleAfterTimeofday\n  , ruleAfterWork\n  , ruleAfternoon\n  , ruleAtTimeofday\n  , ruleBetweenDatetimeAndDatetimeInterval\n  , ruleBetweenTimeofdayAndTimeofdayInterval\n  , ruleByTheEndOfTime\n  , ruleChristmas\n  , ruleChristmasEve\n  , ruleCycleAfterTime\n  , ruleCycleBeforeTime\n  , ruleDatetimeDatetimeInterval\n  , ruleDayofmonthNonOrdinalNamedmonth\n  , ruleDayofmonthNonOrdinalOfNamedmonth\n  , ruleDayofmonthOrdinal\n  , ruleDayofmonthOrdinalOfNamedmonth\n  , ruleDayofmonthordinalNamedmonth\n  , ruleDayofmonthordinalNamedmonthYear\n  , ruleDdmm\n  , ruleDdmmyyyy\n  , ruleDurationAfterTime\n  , ruleDurationAgo\n  , ruleDurationBeforeTime\n  , ruleDurationFromNow\n  , ruleEomendOfMonth\n  , ruleEoyendOfYear\n  , ruleEvening\n  , ruleExactlyTimeofday\n  , ruleFromDatetimeDatetimeInterval\n  , ruleFromTimeofdayTimeofdayInterval\n  , ruleHhmm\n  , ruleHhmmss\n  , ruleHourofdayIntegerAsRelativeMinutes\n  , ruleHourofdayQuarter\n  , ruleHourofdayHalf\n  , ruleInDuration\n  , ruleInduringThePartofday\n  , ruleInduringThePartofday2\n  , ruleIntersect\n  , ruleIntersectBy\n  , ruleIntersectByOfFromS\n  , ruleLastCycle\n  , ruleLastCycleOfTime\n  , ruleLastDayofweekOfTime\n  , ruleLastNCycle\n  , ruleLastTime\n  , ruleLastYear\n  , ruleLunch\n  , ruleMidnighteodendOfDay\n  , ruleMonthDdddInterval\n  , ruleMorning\n  , ruleNamedmonthDayofmonthNonOrdinal\n  , ruleNamedmonthDayofmonthOrdinal\n  , ruleNewYearsDay\n  , ruleNewYearsEve\n  , ruleNextCycle\n  , ruleNextNCycle\n  , ruleNextTime\n  , ruleNight\n  , ruleNoon\n  , ruleNow\n  , ruleNthTimeAfterTime\n  , ruleNthTimeAfterTime2\n  , ruleNthTimeOfTime\n  , ruleNthTimeOfTime2\n  , ruleOnANamedday\n  , ruleOnDate\n  , ruleOrdinalCycleAfterTime\n  , ruleOrdinalCycleOfTime\n  , ruleOrdinalQuarter\n  , ruleOrdinalQuarterYear\n  , rulePartofdayOfTime\n  , ruleRelativeMinutesAfterpastIntegerHourofday\n  , ruleQuarterAfterpastIntegerHourofday\n  , ruleHalfAfterpastIntegerHourofday\n  , ruleRelativeMinutesTotillbeforeIntegerHourofday\n  , ruleQuarterTotillbeforeIntegerHourofday\n  , ruleHalfTotillbeforeIntegerHourofday\n  , ruleTheCycleAfterTime\n  , ruleTheCycleBeforeTime\n  , ruleTheCycleOfTime\n  , ruleTheDayAfterTomorrow\n  , ruleTheDayBeforeYesterday\n  , ruleTheDayofmonthNonOrdinal\n  , ruleTheDayofmonthOrdinal\n  , ruleTheIdesOfNamedmonth\n  , ruleTheOrdinalCycleAfterTime\n  , ruleTheOrdinalCycleOfTime\n  , ruleThisCycle\n  , ruleThisPartofday\n  , ruleThisTime\n  , ruleThisnextDayofweek\n  , ruleLastDayofweek\n  , ruleTimeAfterNext\n  , ruleTimeBeforeLast\n  , ruleTimePartofday\n  , ruleTimeofdayApproximately\n  , ruleTimeofdayLatent\n  , ruleTimeofdayOclock\n  , ruleTimeofdaySharp\n  , ruleTimeofdayTimeofdayInterval\n  , ruleToday\n  , ruleTomorrow\n  , ruleTonight\n  , ruleUntilTimeofday\n  , ruleWeekend\n  , ruleWithinDuration\n  , ruleYear\n  , ruleYearLatent\n  , ruleYearLatent2\n  , ruleYesterday\n  , ruleYyyymmdd\n  , ruleTimezone\n  ]\n  ++ ruleDaysOfWeek\n  ++ ruleMonths\n  ++ ruleSeasons\n", "num_lines": 1748}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.TimeZone.Parse\n  ( parseTimezone\n  ) where\n\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.String\nimport Data.Text (Text)\nimport Data.Time (TimeZone(..))\nimport Prelude\n\n-- `TimeZone` reads anything but only accepts timezones known\n-- from the provided locale.\nparseTimezone :: Text -> Maybe TimeZone\nparseTimezone x = HashMap.lookup x tzs\n\ntzs :: HashMap Text TimeZone\ntzs = HashMap.fromList\n  [ ( \"YEKT\", TimeZone 300 False \"YEKT\" )\n  , ( \"YEKST\", TimeZone 360 True \"YEKST\" )\n  , ( \"YAKT\", TimeZone 540 False \"YAKT\" )\n  , ( \"YAKST\", TimeZone 600 True \"YAKST\" )\n  , ( \"WITA\", TimeZone 480 False \"WITA\" )\n  , ( \"WIT\", TimeZone 420 False \"WIT\" )\n  , ( \"WIB\", TimeZone 420 False \"WIB\" )\n  , ( \"WGT\", TimeZone (-180) False \"WGT\" )\n  , ( \"WGST\", TimeZone (-120) True \"WGST\" )\n  , ( \"WFT\", TimeZone 720 False \"WFT\" )\n  , ( \"WET\", TimeZone 0 False \"WET\" )\n  , ( \"WEST\", TimeZone 60 True \"WEST\" )\n  , ( \"WAT\", TimeZone 60 False \"WAT\" )\n  , ( \"WAST\", TimeZone 120 True \"WAST\" )\n  , ( \"VUT\", TimeZone 660 False \"VUT\" )\n  , ( \"VLAT\", TimeZone 660 False \"VLAT\" )\n  , ( \"VLAST\", TimeZone 660 True \"VLAST\" )\n  , ( \"VET\", TimeZone (-270) False \"VET\" )\n  , ( \"UZT\", TimeZone 300 False \"UZT\" )\n  , ( \"UYT\", TimeZone (-180) False \"UYT\" )\n  , ( \"UYST\", TimeZone (-120) True \"UYST\" )\n  , ( \"UTC\", TimeZone 0 False \"UTC\" )\n  , ( \"ULAT\", TimeZone 480 False \"ULAT\" )\n  , ( \"TVT\", TimeZone 720 False \"TVT\" )\n  , ( \"TMT\", TimeZone 300 False \"TMT\" )\n  , ( \"TLT\", TimeZone 540 False \"TLT\" )\n  , ( \"TKT\", TimeZone 780 False \"TKT\" )\n  , ( \"TJT\", TimeZone 300 False \"TJT\" )\n  , ( \"TFT\", TimeZone 300 False \"TFT\" )\n  , ( \"TAHT\", TimeZone (-600) False \"TAHT\" )\n  , ( \"SST\", TimeZone (-660) False \"SST\" )\n  , ( \"SRT\", TimeZone (-180) False \"SRT\" )\n  , ( \"SGT\", TimeZone 480 False \"SGT\" )\n  , ( \"SCT\", TimeZone 240 False \"SCT\" )\n  , ( \"SBT\", TimeZone 660 False \"SBT\" )\n  , ( \"SAST\", TimeZone 120 False \"SAST\" )\n  , ( \"SAMT\", TimeZone 300 False \"SAMT\" )\n  , ( \"RET\", TimeZone 240 False \"RET\" )\n  , ( \"PYT\", TimeZone (-240) False \"PYT\" )\n  , ( \"PYST\", TimeZone (-180) True \"PYST\" )\n  , ( \"PWT\", TimeZone (-420) True \"PWT\" )\n  , ( \"PST\", TimeZone (-480) False \"PST\" )\n  , ( \"PONT\", TimeZone 660 False \"PONT\" )\n  , ( \"PMST\", TimeZone (-180) False \"PMST\" )\n  , ( \"PMDT\", TimeZone (-120) True \"PMDT\" )\n  , ( \"PKT\", TimeZone 300 False \"PKT\" )\n  , ( \"PHT\", TimeZone 480 False \"PHT\" )\n  , ( \"PHOT\", TimeZone 780 False \"PHOT\" )\n  , ( \"PGT\", TimeZone 600 False \"PGT\" )\n  , ( \"PETT\", TimeZone 720 False \"PETT\" )\n  , ( \"PETST\", TimeZone 720 True \"PETST\" )\n  , ( \"PET\", TimeZone (-300) False \"PET\" )\n  , ( \"PDT\", TimeZone (-420) False \"PDT\" )\n  , ( \"OMST\", TimeZone 360 False \"OMST\" )\n  , ( \"OMSST\", TimeZone 420 True \"OMSST\" )\n  , ( \"NZST\", TimeZone 720 False \"NZST\" )\n  , ( \"NZDT\", TimeZone 780 False \"NZDT\" )\n  , ( \"NUT\", TimeZone (-660) False \"NUT\" )\n  , ( \"NST\", TimeZone (-660) False \"NST\" )\n  , ( \"NPT\", TimeZone (-600) True \"NPT\" )\n  , ( \"NOVT\", TimeZone 360 False \"NOVT\" )\n  , ( \"NOVST\", TimeZone 420 True \"NOVST\" )\n  , ( \"NFT\", TimeZone 690 False \"NFT\" )\n  , ( \"NDT\", TimeZone (-150) True \"NDT\" )\n  , ( \"NCT\", TimeZone 660 False \"NCT\" )\n  , ( \"MYT\", TimeZone 480 False \"MYT\" )\n  , ( \"MVT\", TimeZone 300 False \"MVT\" )\n  , ( \"MUT\", TimeZone 240 False \"MUT\" )\n  , ( \"MST\", TimeZone (-420) False \"MST\" )\n  , ( \"MSK\", TimeZone 180 False \"MSK\" )\n  , ( \"MSD\", TimeZone 240 True \"MSD\" )\n  , ( \"MMT\", TimeZone 390 False \"MMT\" )\n  , ( \"MHT\", TimeZone 720 False \"MHT\" )\n  , ( \"MDT\", TimeZone (-360) True \"MDT\" )\n  , ( \"MAWT\", TimeZone 300 False \"MAWT\" )\n  , ( \"MART\", TimeZone (-570) False \"MART\" )\n  , ( \"MAGT\", TimeZone 600 False \"MAGT\" )\n  , ( \"MAGST\", TimeZone 720 True \"MAGST\" )\n  , ( \"LINT\", TimeZone 840 False \"LINT\" )\n  , ( \"LHST\", TimeZone 630 False \"LHST\" )\n  , ( \"LHDT\", TimeZone 660 True \"LHDT\" )\n  , ( \"KUYT\", TimeZone 180 False \"KUYT\" )\n  , ( \"KST\", TimeZone 540 False \"KST\" )\n  , ( \"KRAT\", TimeZone 420 False \"KRAT\" )\n  , ( \"KRAST\", TimeZone 480 True \"KRAST\" )\n  , ( \"KGT\", TimeZone 360 False \"KGT\" )\n  , ( \"JST\", TimeZone 540 False \"JST\" )\n  , ( \"IST\", TimeZone 330 False \"IST\" )\n  , ( \"IRST\", TimeZone 210 False \"IRST\" )\n  , ( \"IRKT\", TimeZone 480 False \"IRKT\" )\n  , ( \"IRKST\", TimeZone 540 True \"IRKST\" )\n  , ( \"IRDT\", TimeZone 270 True \"IRDT\" )\n  , ( \"IOT\", TimeZone 360 False \"IOT\" )\n  , ( \"IDT\", TimeZone 180 True \"IDT\" )\n  , ( \"ICT\", TimeZone 420 False \"ICT\" )\n  , ( \"HOVT\", TimeZone 420 False \"HOVT\" )\n  , ( \"HKT\", TimeZone 480 False \"HKT\" )\n  , ( \"GYT\", TimeZone (-240) False \"GYT\" )\n  , ( \"GST\", TimeZone 240 False \"GST\" )\n  , ( \"GMT\", TimeZone 0 False \"GMT\" )\n  , ( \"GILT\", TimeZone 720 False \"GILT\" )\n  , ( \"GFT\", TimeZone (-180) False \"GFT\" )\n  , ( \"GET\", TimeZone 240 False \"GET\" )\n  , ( \"GAMT\", TimeZone (-540) False \"GAMT\" )\n  , ( \"GALT\", TimeZone (-360) False \"GALT\" )\n  , ( \"FNT\", TimeZone (-120) False \"FNT\" )\n  , ( \"FKT\", TimeZone (-240) False \"FKT\" )\n  , ( \"FKST\", TimeZone (-180) False \"FKST\" )\n  , ( \"FJT\", TimeZone 720 False \"FJT\" )\n  , ( \"FJST\", TimeZone 780 True \"FJST\" )\n  , ( \"EST\", TimeZone (-300) False \"EST\" )\n  , ( \"EGT\", TimeZone (-60) False \"EGT\" )\n  , ( \"EGST\", TimeZone 0 True \"EGST\" )\n  , ( \"EET\", TimeZone 120 False \"EET\" )\n  , ( \"EEST\", TimeZone 180 True \"EEST\" )\n  , ( \"EDT\", TimeZone (-240) True \"EDT\" )\n  , ( \"ECT\", TimeZone (-300) False \"ECT\" )\n  , ( \"EAT\", TimeZone 180 False \"EAT\" )\n  , ( \"EAST\", TimeZone (-300) False \"EAST\" )\n  , ( \"EASST\", TimeZone (-300) True \"EASST\" )\n  , ( \"DAVT\", TimeZone 420 False \"DAVT\" )\n  , ( \"ChST\", TimeZone 600 False \"ChST\" )\n  , ( \"CXT\", TimeZone 420 False \"CXT\" )\n  , ( \"CVT\", TimeZone (-60) False \"CVT\" )\n  , ( \"CST\", TimeZone (-360) False \"CST\" )\n  , ( \"COT\", TimeZone (-300) False \"COT\" )\n  , ( \"CLT\", TimeZone (-180) False \"CLT\" )\n  , ( \"CLST\", TimeZone (-180) True \"CLST\" )\n  , ( \"CKT\", TimeZone (-600) False \"CKT\" )\n  , ( \"CHAST\", TimeZone 765 False \"CHAST\" )\n  , ( \"CHADT\", TimeZone 825 True \"CHADT\" )\n  , ( \"CET\", TimeZone 60 False \"CET\" )\n  , ( \"CEST\", TimeZone 120 True \"CEST\" )\n  , ( \"CDT\", TimeZone (-300) True \"CDT\" )\n  , ( \"CCT\", TimeZone 390 False \"CCT\" )\n  , ( \"CAT\", TimeZone 120 False \"CAT\" )\n  , ( \"CAST\", TimeZone 180 True \"CAST\" )\n  , ( \"BTT\", TimeZone 360 False \"BTT\" )\n  , ( \"BST\", TimeZone 60 False \"BST\" )\n  , ( \"BRT\", TimeZone (-180) False \"BRT\" )\n  , ( \"BRST\", TimeZone (-120) True \"BRST\" )\n  , ( \"BOT\", TimeZone (-240) False \"BOT\" )\n  , ( \"BNT\", TimeZone 480 False \"BNT\" )\n  , ( \"AZT\", TimeZone 240 False \"AZT\" )\n  , ( \"AZST\", TimeZone 300 True \"AZST\" )\n  , ( \"AZOT\", TimeZone (-60) False \"AZOT\" )\n  , ( \"AZOST\", TimeZone 0 True \"AZOST\" )\n  , ( \"AWST\", TimeZone 480 False \"AWST\" )\n  , ( \"AWDT\", TimeZone 540 True \"AWDT\" )\n  , ( \"AST\", TimeZone (-240) False \"AST\" )\n  , ( \"ART\", TimeZone (-180) False \"ART\" )\n  , ( \"AQTT\", TimeZone 300 False \"AQTT\" )\n  , ( \"ANAT\", TimeZone 720 False \"ANAT\" )\n  , ( \"ANAST\", TimeZone 720 True \"ANAST\" )\n  , ( \"AMT\", TimeZone 240 False \"AMT\" )\n  , ( \"AMST\", TimeZone 300 True \"AMST\" )\n  , ( \"ALMT\", TimeZone 360 False \"ALMT\" )\n  , ( \"AKST\", TimeZone (-540) False \"AKST\" )\n  , ( \"AKDT\", TimeZone (-480) True \"AKDT\" )\n  , ( \"AFT\", TimeZone 270 False \"AFT\" )\n  , ( \"AEST\", TimeZone 600 False \"AEST\" )\n  , ( \"AEDT\", TimeZone 660 True \"AEDT\" )\n  , ( \"ADT\", TimeZone (-180) True \"ADT\" )\n  , ( \"ACST\", TimeZone 570 False \"ACST\" )\n  , ( \"ACDT\", TimeZone 630 True \"ACDT\" )\n  ]\n", "num_lines": 194}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.TR.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.TimeGrain.Types\n    ( Grain(Minute, Hour, Year, Quarter, Week, Month, Day, Second) )\n\ncontext :: Context\ncontext = testContext {locale = makeLocale TR Nothing}\n\n-- Tuesday Feb 12, 2013 at 4:30am is the \"now\" for the tests\ncorpus :: Corpus\ncorpus = (context, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 2, 12, 4, 30, 0) Second)\n             [ \"\u00c5\u0178imdi\"\n             , \"\u00c5\u0178u an\"\n             ]\n  , examples (datetime (2013, 2, 12, 0, 0, 0) Day)\n             [ \"bug\u00c3\u00bcn\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"2014\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Day)\n             [ \"d\u00c3\u00bcn\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"yar\u00c4\u00b1n\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"yar\u00c4\u00b1ndan sonraki\"\n             , \"yar\u00c4\u00b1ndan sonraki g\u00c3\u00bcn\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"ay sonu\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"y\u00c4\u00b1l sonu\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Day)\n             [ \"pazartesi\"\n             , \"bu pazartesi\"\n             , \"18 \u00c5\u0178ubat pazartesi\"\n             , \"\u00c5\u0178ubat 18 pazartesi\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"sal\u00c4\u00b1\"\n             , \"sal\"\n             , \"bu sal\u00c4\u00b1\"\n             , \"19 \u00c5\u0178ubat sal\u00c4\u00b1\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"per\u00c5\u0178embe\"\n             , \"per\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"cuma\"\n             , \"cum\"\n             ]\n  , examples (datetime (2013, 2, 16, 0, 0, 0) Day)\n             [ \"cumartesi\"\n             , \"cmt\"\n             ]\n  , examples (datetime (2013, 2, 17, 0, 0, 0) Day)\n             [ \"pazar\"\n             ]\n  , examples (datetime (2013, 3, 3, 0, 0, 0) Day)\n             [ \"mart\u00c4\u00b1n \u00c3\u00bc\u00c3\u00a7\u00c3\u00bc\"\n             , \"3 mart\"\n             ]\n  , examples (datetime (2013, 3, 15, 0, 0, 0) Day)\n             [ \"mart\u00c4\u00b1n ortas\u00c4\u00b1\"\n             ]\n  , examples (datetime (2013, 2, 13, 0, 0, 0) Day)\n             [ \"\u00c5\u0178ubat\u00c4\u00b1n ortas\u00c4\u00b1\"\n             ]\n  , examples (datetime (2015, 3, 3, 0, 0, 0) Day)\n             [ \"mart 3 2015\"\n             , \"mart \u00c3\u00bc\u00c3\u00a7 2015\"\n             , \"3 mart 2015\"\n             , \"\u00c3\u00bc\u00c3\u00a7 mart 2015\"\n             , \"3/3/2015\"\n             , \"2015-3-3\"\n             , \"2015-03-03\"\n             ]\n  , examples (datetime (2013, 8, 8, 0, 0, 0) Day)\n             [ \"A\u00c4\u0178u 8\"\n             , \"A\u00c4\u0178ustos 8\"\n             ]\n  , examples (datetime (2014, 7, 18, 0, 0, 0) Day)\n             [ \"cuma temmuz 18\"\n             , \"temmuz 18 cuma\"\n             , \"18 temmuz cuma\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Month)\n             [ \"Ekim 2014\"\n             ]\n  , examples (datetime (2015, 4, 14, 0, 0, 0) Day)\n             [ \"14 nisan 2015\"\n             , \"nisan 14 2015\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki sal\u00c4\u00b1\"\n             , \"sonraki sal\u00c4\u00b1\"\n             ]\n  , examples (datetime (2013, 2, 15, 0, 0, 0) Day)\n             [ \"sonraki cuma\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki mart\"\n             , \"sonraki mart\"\n             , \"sonraki ay\"\n             , \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki ay\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki mart\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"pazar 10 \u00c5\u0178ubat\"\n             ]\n  , examples (datetime (2013, 2, 11, 0, 0, 0) Week)\n             [ \"bu hafta\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki hafta\"\n             ]\n  , examples (datetime (2013, 2, 4, 0, 0, 0) Week)\n             [ \"ge\u00c3\u00a7en hafta\"\n             , \"ge\u00c3\u00a7ti\u00c4\u0178imiz hafta\"\n             , \"\u00c3\u00b6nceki hafta\"\n             ]\n  , examples (datetime (2013, 2, 18, 0, 0, 0) Week)\n             [ \"sonraki hafta\"\n             , \"gelecek hafta\"\n             , \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki hafta\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Month)\n             [ \"ge\u00c3\u00a7en ay\"\n             , \"ge\u00c3\u00a7ti\u00c4\u0178imiz ay\"\n             , \"\u00c3\u00b6nceki ay\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki ay\"\n             , \"sonraki ay\"\n             , \"gelecek ay\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Quarter)\n             [ \"bu \u00c3\u00a7eyrek y\u00c4\u00b1l\"\n             ]\n  , examples (datetime (2013, 4, 1, 0, 0, 0) Quarter)\n             [ \"sonraki \u00c3\u00a7eyrek y\u00c4\u00b1l\"\n             ]\n  , examples (datetime (2013, 7, 1, 0, 0, 0) Quarter)\n             [ \"\u00c3\u00bc\u00c3\u00a7\u00c3\u00bcnc\u00c3\u00bc \u00c3\u00a7eyrek y\u00c4\u00b1l\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Quarter)\n             [ \"d\u00c3\u00b6rd\u00c3\u00bcnc\u00c3\u00bc \u00c3\u00a7eyrek y\u00c4\u00b1l\"\n             ]\n  , examples (datetime (2012, 1, 1, 0, 0, 0) Year)\n             [ \"ge\u00c3\u00a7en y\u00c4\u00b1l\"\n             ]\n  , examples (datetime (2013, 1, 1, 0, 0, 0) Year)\n             [ \"bu y\u00c4\u00b1l\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Year)\n             [ \"sonraki y\u00c4\u00b1l\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"ge\u00c3\u00a7en pazar\"\n             , \"ge\u00c3\u00a7en hafta pazar\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"ge\u00c3\u00a7en sal\u00c4\u00b1\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki sal\u00c4\u00b1\"\n             , \"gelecek sal\u00c4\u00b1\"\n             , \"sonraki sal\u00c4\u00b1\"\n             ]\n  , examples (datetime (2013, 2, 20, 0, 0, 0) Day)\n             [ \"gelecek hafta \u00c3\u00a7ar\u00c5\u0178amba\"\n             ]\n  , examples (datetime (2013, 2, 14, 0, 0, 0) Day)\n             [ \"yar\u00c4\u00b1ndan sonraki g\u00c3\u00bcn\"\n             ]\n  , examples (datetime (2013, 2, 13, 17, 0, 0) Hour)\n             [ \"sonraki g\u00c3\u00bcn saat 17\"\n             ]\n  , examples (datetime (2013, 2, 10, 0, 0, 0) Day)\n             [ \"d\u00c3\u00bcn de\u00c4\u0178il evvelsi g\u00c3\u00bcn\"\n             , \"d\u00c3\u00bcnden \u00c3\u00b6nceki g\u00c3\u00bcn\"\n             , \"\u00c3\u00b6b\u00c3\u00bcrki g\u00c3\u00bcn\"\n             , \"\u00c3\u00b6b\u00c3\u00bcrs\u00c3\u00bc g\u00c3\u00bcn\"\n             ]\n  , examples (datetime (2013, 2, 10, 8, 0, 0) Hour)\n             [ \"d\u00c3\u00bcnden \u00c3\u00b6nceki g\u00c3\u00bcn saat 8\"\n             ]\n  , examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"ekimin birinci sal\u00c4\u00b1\"\n             , \"ekimin birinci sal\u00c4\u00b1s\u00c4\u00b1\"\n             ]\n  , examples (datetime (2014, 10, 1, 0, 0, 0) Day)\n             [ \"ekim 2014 birinci \u00c3\u00a7ar\u00c5\u0178ambas\u00c4\u00b1\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"saat 3\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 0, 0) Hour)\n             [ \"sabah saat 10\"\n             ]\n  , examples (datetime (2013, 2, 13, 3, 18, 0) Minute)\n             [ \"3:18\"\n             , \"03:18\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Hour)\n             [ \"saat 15\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 0, 0) Minute)\n             [ \"15:00\"\n             ]\n  , examples (datetime (2013, 2, 12, 15, 3, 0) Minute)\n             [ \"saat 15:03\"\n             , \"15:03\"\n             ]\n  , examples (datetime (2013, 2, 12, 9, 59, 0) Minute)\n             [ \"saat dokuz elli dokuz\"\n             ]\n  , examples (datetime (2013, 9, 20, 19, 30, 0) Minute)\n             [ \"20 eyl\u00c3\u00bcl cuma saat 19:30\"\n             ]\n  , examples (datetime (2013, 2, 16, 9, 0, 0) Hour)\n             [ \"cumartesi saat 9\"\n             , \"cumartesi sabah saat 9\"\n             ]\n  , examples (datetime (2014, 7, 18, 19, 0, 0) Minute)\n             [ \"18 temmuz 2014 cuma saat 19:00\"\n             , \"saat 19:00 18 temmuz 2014 cuma\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 30, 1) Second)\n             [ \"bir saniye i\u00c3\u00a7inde\"\n             , \"bir saniye i\u00c3\u00a7erisinde\"\n             , \"1 saniye i\u00c3\u00a7erisinde\"\n             , \"1 saniye i\u00c3\u00a7inde\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 31, 0) Second)\n             [ \"bir dakika i\u00c3\u00a7inde\"\n             , \"bir dakika i\u00c3\u00a7erisinde\"\n             , \"1 dakika i\u00c3\u00a7inde\"\n             , \"1 dakika i\u00c3\u00a7erisinde\"\n             ]\n  , examples (datetime (2013, 2, 12, 4, 32, 0) Second)\n             [ \"2 dakika i\u00c3\u00a7inde\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Second)\n             [ \"60 dakika i\u00c3\u00a7inde\"\n             ]\n  , examples (datetime (2013, 2, 12, 5, 30, 0) Minute)\n             [ \"bir saat i\u00c3\u00a7inde\"\n             ]\n  , examples (datetime (2013, 2, 13, 4, 0, 0) Hour)\n             [ \"bir g\u00c3\u00bcn sonra\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"7 g\u00c3\u00bcn i\u00c3\u00a7inde\"\n             ]\n  , examples (datetime (2017, 2, 1, 17, 0, 0) Hour)\n             [ \"4 y\u00c4\u00b1l sonra saat 17\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"1 hafta i\u00c3\u00a7inde\"\n             , \"1 hafta sonra\"\n             ]\n  , examples (datetime (2013, 2, 5, 4, 0, 0) Hour)\n             [ \"7 g\u00c3\u00bcn \u00c3\u00b6nce\"\n             ]\n  , examples (datetime (2013, 1, 29, 4, 0, 0) Hour)\n             [ \"14 g\u00c3\u00bcn \u00c3\u00b6nce\"\n             ]\n  , examples (datetime (2013, 1, 29, 0, 0, 0) Day)\n             [ \"iki hafta \u00c3\u00b6nce\"\n             ]\n  , examples (datetime (2013, 2, 5, 0, 0, 0) Day)\n             [ \"bir hafta \u00c3\u00b6nce\"\n             , \"1 hafta \u00c3\u00b6nce\"\n             ]\n  , examples (datetime (2013, 1, 22, 0, 0, 0) Day)\n             [ \"\u00c3\u00bc\u00c3\u00a7 hafta \u00c3\u00b6nce\"\n             ]\n  , examples (datetime (2012, 11, 12, 0, 0, 0) Day)\n             [ \"\u00c3\u00bc\u00c3\u00a7 ay \u00c3\u00b6nce\"\n             ]\n  , examples (datetime (2011, 2, 1, 0, 0, 0) Month)\n             [ \"iki y\u00c4\u00b1l \u00c3\u00b6nce\"\n             ]\n  , examples (datetime (2013, 2, 19, 4, 0, 0) Hour)\n             [ \"7 g\u00c3\u00bcn sonra\"\n             ]\n  , examples (datetime (2013, 2, 26, 4, 0, 0) Hour)\n             [ \"14 g\u00c3\u00bcn sonra\"\n             ]\n  , examples (datetime (2013, 2, 26, 0, 0, 0) Day)\n             [ \"iki hafta sonra\"\n             ]\n  , examples (datetime (2013, 2, 19, 0, 0, 0) Day)\n             [ \"bir hafta sonra\"\n             , \"1 hafta sonra\"\n             ]\n  , examples (datetime (2013, 3, 5, 0, 0, 0) Day)\n             [ \"\u00c3\u00bc\u00c3\u00a7 hafta sonra\"\n             ]\n  , examples (datetime (2013, 5, 12, 0, 0, 0) Day)\n             [ \"\u00c3\u00bc\u00c3\u00a7 ay sonra\"\n             ]\n  , examples (datetime (2015, 2, 1, 0, 0, 0) Month)\n             [ \"iki y\u00c4\u00b1l sonra\"\n             ]\n  , examples (datetime (2014, 1, 1, 0, 0, 0) Day)\n             [ \"y\u00c4\u00b1lba\u00c5\u0178\u00c4\u00b1ndan sonra bir y\u00c4\u00b1l\"\n             , \"y\u00c4\u00b1lba\u00c5\u0178\u00c4\u00b1ndan bir y\u00c4\u00b1l sonra\"\n             ]\n  , examples (datetimeInterval ((2013, 12, 18, 0, 0, 0), (2013, 12, 29, 0, 0, 0)) Day)\n             [ \"18 aral\u00c4\u00b1ktan itibaren 10 g\u00c3\u00bcn boyunca\"\n             , \"18 aral\u00c4\u00b1ktan itibaren 10 g\u00c3\u00bcn s\u00c3\u00bcresince\"\n             ]\n  , examples (datetime (2013, 2, 12, 16, 30, 0) Minute)\n             [ \"saat 16'dan 30 dakika sonra\"\n             ]\n  , examples (datetimeInterval ((2013, 6, 21, 0, 0, 0), (2013, 9, 24, 0, 0, 0)) Day)\n             [ \"bu yaz\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 21, 0, 0, 0), (2013, 3, 21, 0, 0, 0)) Day)\n             [ \"bu k\u00c4\u00b1\u00c5\u0178\"\n             ]\n  , examples (datetimeInterval ((2011, 12, 21, 0, 0, 0), (2012, 03, 21, 0, 0, 0)) Day)\n             [ \"ge\u00c3\u00a7en k\u00c4\u00b1\u00c5\u0178\"\n             , \"\u00c3\u00b6nceki k\u00c4\u00b1\u00c5\u0178\"\n             ]\n  , examples (datetimeInterval ((2013, 3, 20, 0, 0, 0), (2013, 6, 22, 0, 0, 0)) Day)\n             [ \"gelecek ilkbahar\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 1, 0, 0, 0) Day \"Y\u00c4\u00b1lba\u00c5\u0178\u00c4\u00b1\")\n             [ \"y\u00c4\u00b1lba\u00c5\u0178\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2014, 1, 1, 18, 0, 0) Hour \"Y\u00c4\u00b1lba\u00c5\u0178\u00c4\u00b1\")\n             [ \"y\u00c4\u00b1lba\u00c5\u0178\u00c4\u00b1 saat 18\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 18, 0, 0), (2013, 2, 13, 0, 0, 0)) Hour)\n             [ \"bu ak\u00c5\u0178am\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 8, 18, 0, 0), (2013, 2, 11, 0, 0, 0)) Hour)\n             [ \"ge\u00c3\u00a7en hafta sonu\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 18, 0, 0), (2013, 2, 14, 0, 0, 0)) Hour)\n             [ \"yar\u00c4\u00b1n ak\u00c5\u0178am\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 13, 12, 0, 0), (2013, 2, 13, 14, 0, 0)) Hour)\n             [ \"yar\u00c4\u00b1n \u00c3\u00b6\u00c4\u0178le yeme\u00c4\u0178i\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 18, 0, 0), (2013, 2, 12, 0, 0, 0)) Hour)\n             [ \"d\u00c3\u00bcn ak\u00c5\u0178am\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 18, 0, 0), (2013, 2, 18, 0, 0, 0)) Hour)\n             [ \"bu hafta sonu\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 2, 18, 12, 0, 0)) Hour)\n             [ \"pazartesi sabah\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 15, 0, 0, 0), (2013, 2, 15, 12, 0, 0)) Hour)\n             [ \"15 \u00c5\u0178ubat sabah\u00c4\u00b1\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 29, 58), (2013, 2, 12, 4, 30, 0)) Second)\n             [ \"son 2 saniye\"\n             , \"son iki saniye\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 1), (2013, 2, 12, 4, 30, 4)) Second)\n             [ \"sonraki 3 saniye\"\n             , \"sonraki \u00c3\u00bc\u00c3\u00a7 saniye\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 28, 0), (2013, 2, 12, 4, 30, 0)) Minute)\n             [ \"son 2 dakika\"\n             , \"son iki dakika\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 3, 0, 0), (2013, 2, 12, 4, 0, 0)) Hour)\n             [ \"son 1 saat\"\n             , \"son bir saat\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 5, 0, 0), (2013, 2, 12, 8, 0, 0)) Hour)\n             [ \"sonraki 3 saat\"\n             , \"sonraki \u00c3\u00bc\u00c3\u00a7 saat\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 10, 0, 0, 0), (2013, 2, 12, 0, 0, 0)) Day)\n             [ \"son iki g\u00c3\u00bcn\"\n             , \"son 2 g\u00c3\u00bcn\"\n             ]\n  , examples (datetimeInterval ((2013, 1, 28, 0, 0, 0), (2013, 2, 11, 0, 0, 0)) Week)\n             [ \"ge\u00c3\u00a7ti\u00c4\u0178imiz iki hafta\"\n             , \"\u00c3\u00b6nceki iki hafta\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 18, 0, 0, 0), (2013, 3, 11, 0, 0, 0)) Week)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki \u00c3\u00bc\u00c3\u00a7 hafta\"\n             , \"sonraki \u00c3\u00bc\u00c3\u00a7 hafta\"\n             ]\n  , examples (datetimeInterval ((2012, 12, 1, 0, 0, 0), (2013, 2, 1, 0, 0, 0)) Month)\n             [ \"son 2 ay\"\n             , \"son iki ay\"\n             ]\n  , examples (datetimeInterval ((2011, 1, 1, 0, 0, 0), (2013, 1, 1, 0, 0, 0)) Year)\n             [ \"son 2 y\u00c4\u00b1l\"\n             , \"son iki y\u00c4\u00b1l\"\n             ]\n  , examples (datetimeInterval ((2014, 1, 1, 0, 0, 0), (2017, 1, 1, 0, 0, 0)) Year)\n             [ \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki \u00c3\u00bc\u00c3\u00a7 y\u00c4\u00b1l\"\n             , \"\u00c3\u00b6n\u00c3\u00bcm\u00c3\u00bczdeki 3 y\u00c4\u00b1l\"\n             ]\n  , examples (datetimeInterval ((2013, 8, 8, 0, 0, 0), (2013, 8, 13, 0, 0, 0)) Day)\n             [ \"8 A\u00c4\u0178u - 12 A\u00c4\u0178u\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 9, 30, 0), (2013, 2, 12, 11, 1, 0)) Minute)\n             [ \"9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 30, 0), (2013, 2, 14, 11, 1, 0)) Minute)\n             [ \"per\u00c5\u0178embe 9:30 - 11:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 15, 0, 0), (2013, 2, 12, 17, 0, 0)) Hour)\n             [ \"saat 15-16\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 15, 30, 0), (2013, 2, 12, 18, 1, 0)) Minute)\n             [ \"saat 15:30 - 18\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 14, 9, 0, 0), (2013, 2, 14, 12, 0, 0)) Hour)\n             [ \"per\u00c5\u0178embe saat 9-11\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 11, 30, 0), (2013, 2, 12, 13, 31, 0)) Minute)\n             [ \"saat 11:30-13:30\"\n             ]\n  , examples (datetime (2013, 9, 21, 13, 30, 0) Minute)\n             [ \"21 eyl\u00c3\u00bcl cumartesi saat 13:30\"\n             ]\n  , examples (datetime (2013, 2, 26, 0, 0, 0) Day)\n             [ \"2 hafta i\u00c3\u00a7inde\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 2, 13, 0, 0, 0)) Second)\n             [ \"g\u00c3\u00bcn sonuna kadar\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 12, 4, 30, 0), (2013, 3, 1, 0, 0, 0)) Second)\n             [ \"ay sonuna kadar\"\n             ]\n  , examples (datetime (2013, 3, 1, 0, 0, 0) Month)\n             [ \"ay sonunda\"\n             , \"ay sonu\"\n             ]\n  , examples (datetime (2013, 2, 12, 10, 30, 0) Minute)\n             [ \"saat 10:30 civar\u00c4\u00b1\"\n             , \"10:30 civar\u00c4\u00b1\"\n             , \"yakla\u00c5\u0178\u00c4\u00b1k saat 10:30\"\n             , \"saat yakla\u00c5\u0178\u00c4\u00b1k 10:30\"\n             ]\n  , examples (datetime (2013, 2, 12, 19, 30, 0) Minute)\n             [ \"ak\u00c5\u0178am saat 19:30\"\n             ]\n  , examples (datetime (2013, 2, 13, 15, 0, 0) Minute)\n             [ \"yar\u00c4\u00b1n saat 15:00\"\n             ]\n  , examples (datetimeInterval ((2013, 2, 11, 0, 0, 0), (2013, 2, 17, 0, 0, 0)) Day)\n             [ \"hafta boyunca\"\n             ]\n  , examples (datetimeHoliday (1950, 7, 16, 0, 0, 0) Day \"Ramazan Bayram\u00c4\u00b1\")\n             [ \"ramazan bayram\u00c4\u00b1 1950\"\n             , \"1950 ramazan bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (1975, 10, 6, 0, 0, 0) Day \"Ramazan Bayram\u00c4\u00b1\")\n             [ \"1975 ramazan bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (1988, 5, 16, 0, 0, 0) Day \"Ramazan Bayram\u00c4\u00b1\")\n             [ \"1988 ramazan bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2018, 6, 15, 0, 0, 0) Day \"Ramazan Bayram\u00c4\u00b1\")\n             [ \"2018 ramazan bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2013, 8, 8, 0, 0, 0) Day \"Ramazan Bayram\u00c4\u00b1\")\n             [ \"2013 ramazan bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2046, 8, 4, 0, 0, 0) Day \"Ramazan Bayram\u00c4\u00b1\")\n             [ \"2046 ramazan bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2050, 6, 21, 0, 0, 0) Day \"Ramazan Bayram\u00c4\u00b1\")\n             [ \"2050 ramazan bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2018, 8, 21, 0, 0, 0) Day \"Kurban Bayram\u00c4\u00b1\")\n             [ \"2018 kurban bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (1980, 10, 19, 0, 0, 0) Day \"Kurban Bayram\u00c4\u00b1\")\n             [ \"1980 kurban bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (1966, 4, 1, 0, 0, 0) Day \"Kurban Bayram\u00c4\u00b1\")\n             [ \"1966 kurban bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (1974, 1, 3, 0, 0, 0) Day \"Kurban Bayram\u00c4\u00b1\")\n             [ \"1974 kurban bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2013, 4, 23, 0, 0, 0) Day \"Ulusal Egemenlik ve \u00c3\u2021ocuk Bayram\u00c4\u00b1\")\n             [ \"ulusal egemenlik ve \u00c3\u00a7ocuk bayram\u00c4\u00b1\"\n             , \"\u00c3\u00a7ocuk bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 1, 0, 0, 0) Day \"Emek ve Dayan\u00c4\u00b1\u00c5\u0178ma G\u00c3\u00bcn\u00c3\u00bc\")\n             [ \"emek ve dayan\u00c4\u00b1\u00c5\u0178ma g\u00c3\u00bcn\u00c3\u00bc\"\n             ]\n  , examples (datetimeHoliday (2013, 5, 19, 0, 0, 0) Day \"Atat\u00c3\u00bcrk\u00e2\u20ac\u2122\u00c3\u00bc Anma, Gen\u00c3\u00a7lik ve Spor Bayram\u00c4\u00b1\")\n             [ \"gen\u00c3\u00a7lik ve spor bayram\u00c4\u00b1\"\n             , \"gen\u00c3\u00a7lik bayram\u00c4\u00b1\"\n             , \"spor bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2013, 8, 30, 0, 0, 0) Day \"Zafer Bayram\u00c4\u00b1\")\n             [ \"zafer bayram\u00c4\u00b1\"\n             ]\n  , examples (datetimeHoliday (2013, 10, 29, 0, 0, 0) Day \"Cumhuriyet Bayram\u00c4\u00b1\")\n             [ \"cumhuriyet bayram\u00c4\u00b1\"\n             ]\n  ]\n", "num_lines": 539}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.CN.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e7\u00af\u20ac\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e8\u0160\u201a\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 1, 18, 0, 0), (2013, 10, 2, 0, 0, 0)) Hour)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             ]\n  ]\n", "num_lines": 37}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.CN.Rules\n  ( rules\n  ) where\n\nimport Prelude\n\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Types\n\nruleNationalDay :: Rule\nruleNationalDay = Rule\n  { name = \"national day\"\n  , pattern =\n    [ regex \"(\u00e5\u203a\u00bd\u00e5\u00ba\u2020|\u00e5\u0153\u2039\u00e6\u2026\u00b6)(\u00e8\u0160\u201a|\u00e7\u00af\u20ac)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 1\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNationalDay\n  ]\n", "num_lines": 35}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.HK.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e7\u00af\u20ac\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e8\u0160\u201a\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 1, 18, 0, 0), (2013, 10, 2, 0, 0, 0)) Hour)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             ]\n  ]\n", "num_lines": 37}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.HK.Rules\n  ( rules\n  ) where\n\nimport Prelude\n\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Types\n\nruleNationalDay :: Rule\nruleNationalDay = Rule\n  { name = \"national day\"\n  , pattern =\n    [ regex \"(\u00e5\u203a\u00bd\u00e5\u00ba\u2020|\u00e5\u0153\u2039\u00e6\u2026\u00b6)(\u00e8\u0160\u201a|\u00e7\u00af\u20ac)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 1\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNationalDay\n  ]\n", "num_lines": 35}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.MO.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 10, 1, 0, 0, 0) Day)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e7\u00af\u20ac\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e8\u0160\u201a\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 1, 18, 0, 0), (2013, 10, 2, 0, 0, 0)) Hour)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             ]\n  ]\n", "num_lines": 37}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.MO.Rules\n  ( rules\n  ) where\n\nimport Prelude\n\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Types\n\nruleNationalDay :: Rule\nruleNationalDay = Rule\n  { name = \"national day\"\n  , pattern =\n    [ regex \"(\u00e5\u203a\u00bd\u00e5\u00ba\u2020|\u00e5\u0153\u2039\u00e6\u2026\u00b6)(\u00e8\u0160\u201a|\u00e7\u00af\u20ac)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 1\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNationalDay\n  ]\n", "num_lines": 35}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.TW.Corpus\n  ( allExamples\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.Types hiding (Month)\nimport Duckling.TimeGrain.Types hiding (add)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (datetime (2013, 10, 10, 0, 0, 0) Day)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\"\n             , \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e7\u00af\u20ac\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e8\u0160\u201a\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\"\n             ]\n  , examples (datetimeInterval ((2013, 10, 10, 18, 0, 0), (2013, 10, 11, 0, 0, 0)) Hour)\n             [ \"\u00e5\u203a\u00bd\u00e5\u00ba\u2020\u00e8\u0160\u201a\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             , \"\u00e5\u0153\u2039\u00e6\u2026\u00b6\u00e7\u00af\u20ac\u00e6\u2122\u0161\u00e4\u00b8\u0160\"\n             ]\n  ]\n", "num_lines": 37}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.ZH.TW.Rules\n  ( rules\n  ) where\n\nimport Prelude\n\nimport Duckling.Regex.Types\nimport Duckling.Time.Helpers\nimport Duckling.Types\n\nruleNationalDay :: Rule\nruleNationalDay = Rule\n  { name = \"national day\"\n  , pattern =\n    [ regex \"(\u00e5\u203a\u00bd\u00e5\u00ba\u2020|\u00e5\u0153\u2039\u00e6\u2026\u00b6)(\u00e8\u0160\u201a|\u00e7\u00af\u20ac)?\"\n    ]\n  , prod = \\_ -> tt $ monthDay 10 10\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleNationalDay\n  ]\n", "num_lines": 35}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.TimeGrain.Types\n  ( Grain(..)\n  , add\n  , inSeconds\n  , lower\n  )\n  where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport GHC.Generics\nimport Prelude\nimport TextShow\nimport qualified Data.Text as Text\nimport qualified Data.Time as Time\n\nimport Duckling.Resolve (Resolve(..))\n\ndata Grain\n  -- NoGrain is helpful to define \"now\"\n  = NoGrain | Second | Minute | Hour | Day | Week | Month | Quarter | Year\n  deriving (Eq, Generic, Hashable, Ord, Bounded, Enum, Show, NFData)\n\ninstance Resolve Grain where\n  type ResolvedValue Grain = Grain\n  resolve _ _ _ = Nothing\n\ninstance TextShow Grain where\n  showb = fromText . Text.toLower . Text.pack . show\n\ninstance ToJSON Grain where\n  toJSON = String . showt\n\nupdateUTCDay :: Time.UTCTime -> (Time.Day -> Time.Day) -> Time.UTCTime\nupdateUTCDay (Time.UTCTime day diffTime) f = Time.UTCTime (f day) diffTime\n\nadd :: Time.UTCTime -> Grain -> Integer -> Time.UTCTime\nadd utcTime NoGrain n = Time.addUTCTime (realToFrac n) utcTime\nadd utcTime Second n = Time.addUTCTime (realToFrac n) utcTime\nadd utcTime Minute n = Time.addUTCTime (realToFrac $ 60 * n) utcTime\nadd utcTime Hour n = Time.addUTCTime (realToFrac $ 3600 * n) utcTime\nadd utcTime Day n = updateUTCDay utcTime $ Time.addDays n\nadd utcTime Week n = updateUTCDay utcTime . Time.addDays $ 7 * n\nadd utcTime Month n = updateUTCDay utcTime $ Time.addGregorianMonthsClip n\nadd utcTime Quarter n =\n  updateUTCDay utcTime $ Time.addGregorianMonthsClip $ 3 * n\nadd utcTime Year n = updateUTCDay utcTime $ Time.addGregorianYearsClip n\n\ninSeconds :: Num a => Grain -> a -> a\ninSeconds NoGrain n = n\ninSeconds Second  n = n\ninSeconds Minute  n = n * 60\ninSeconds Hour    n = n * inSeconds Minute 60\ninSeconds Day     n = n * inSeconds Hour 24\ninSeconds Week    n = n * inSeconds Day 7\ninSeconds Month   n = n * inSeconds Day 30\ninSeconds Quarter n = n * inSeconds Month 3\ninSeconds Year    n = n * inSeconds Day 365\n\nlower :: Grain -> Grain\nlower NoGrain = Second\nlower Second = Second\nlower Year = Month\nlower Month = Day\nlower x = pred x\n", "num_lines": 79}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.AR.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain) \", \"(\u00d8\u00ab\u00d8\u00a7\u00d9\u2020\u00d9\u0160(\u00d8\u00a9|\u00d9\u2021)?|\u00d8\u00ab\u00d9\u02c6\u00d8\u00a7\u00d9\u2020\u00d9\u0160|\u00d9\u201e\u00d8\u00ad\u00d8\u00b8(\u00d8\u00a9|\u00d9\u2021|\u00d8\u00a7\u00d8\u00aa))\"   , TG.Second)\n         , (\"minute (grain)\" , \"\u00d8\u00af\u00d9\u201a(\u00d9\u0160\u00d9\u201a(\u00d8\u00a9|\u00d9\u2021)|\u00d8\u00a7\u00d8\u00a6\u00d9\u201a)\"                  , TG.Minute)\n         , (\"hour (grain)\"   , \"\u00d8\u00b3\u00d8\u00a7\u00d8\u00b9(\u00d8\u00a9|\u00d9\u2021|\u00d8\u00a7\u00d8\u00aa)\"                      , TG.Hour)\n         , (\"day (grain)\"    , \"\u00d9\u0160\u00d9\u02c6\u00d9\u2026|(\u00d8\u00a7|\u00d8\u00a3)\u00d9\u0160\u00d8\u00a7\u00d9\u2026\"                     , TG.Day)\n         , (\"week (grain)\"   , \"(\u00d8\u00a7|\u00d8\u00a3|\u00d8\u00a5)\u00d8\u00b3(\u00d8\u00a8\u00d9\u02c6\u00d8\u00b9|\u00d8\u00a7\u00d8\u00a8\u00d9\u0160\u00d8\u00b9)\"               , TG.Week)\n         , (\"month (grain)\"  , \"\u00d8\u00b4\u00d9\u2021\u00d8\u00b1|(\u00d8\u00a7|\u00d8\u00a3|\u00d8\u00a5)\u00d8\u00b4\u00d9\u2021\u00d8\u00b1\"                   , TG.Month)\n         , (\"quarter (grain)\", \"(\u00d8\u00b1\u00d8\u00a8\u00d8\u00b9(\u00d9\u0160\u00d9\u2020|\u00d8\u00a7\u00d9\u2020)|[\u00d8\u00a3\u00d8\u00a7]\u00d8\u00b1\u00d8\u00a8\u00d8\u00a7\u00d8\u00b9)(\u00d8\u00b3\u00d9\u2020\u00d8\u00a9|\u00d8\u00b9\u00d8\u00a7\u00d9\u2026)?\"  , TG.Quarter)\n         , (\"year (grain)\"   , \"\u00d8\u00b3\u00d9\u2020(\u00d8\u00a9|\u00d9\u0160\u00d9\u2020)|\u00d8\u00b9\u00d8\u00a7\u00d9\u2026\"                     , TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.CA.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"segon (grain)\", \"seg(on)?s?\", TG.Second)\n         , (\"minuts (grain)\", \"min(ut)?s?\", TG.Minute)\n         , (\"hora (grain)\", \"h(or(a|es))?\", TG.Hour)\n         , (\"dia (grain)\", \"d(\u00c3\u00ad|i)(a|es)\", TG.Day)\n         , (\"setmana (grain)\", \"setman(a|es)\", TG.Week)\n         , (\"mes (grain)\", \"mes(os)?\", TG.Month)\n         , (\"trimestre (grain)\", \"trimestres?\", TG.Quarter)\n         , (\"any (grain)\", \"anys?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.DA.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain)\", \"sekund(er)?\", TG.Second)\n         , (\"minute (grain)\", \"minut(ter)?\", TG.Minute)\n         , (\"hour (grain)\", \"t(imer?)?\", TG.Hour)\n         , (\"day (grain)\", \"dag(e)?\", TG.Day)\n         , (\"week (grain)\", \"uger?\", TG.Week)\n         , (\"month (grain)\", \"m\u00c3\u00a5ned(er)?\", TG.Month)\n         , (\"quarter (grain)\", \"kvartal(er)?\", TG.Quarter)\n         , (\"year (grain)\", \"\u00c3\u00a5r\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.DE.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain)\", \"sekunden?\", TG.Second)\n         , (\"minute (grain)\", \"min(uten?)?\", TG.Minute)\n         , (\"hour (grain)\", \"stunden?\", TG.Hour)\n         , (\"day (grain)\", \"tage?n?\", TG.Day)\n         , (\"week (grain)\", \"wochen?\", TG.Week)\n         , (\"month (grain)\", \"monate?n?\", TG.Month)\n         , (\"quarter (grain)\", \"quartale?\", TG.Quarter)\n         , (\"year (grain)\", \"jahre?n?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.EN.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain) \", \"sec(ond)?s?\",      TG.Second)\n         , (\"minute (grain)\" , \"m(in(ute)?s?)?\",   TG.Minute)\n         , (\"hour (grain)\"   , \"h(((ou)?rs?)|r)?\", TG.Hour)\n         , (\"day (grain)\"    , \"days?\",            TG.Day)\n         , (\"week (grain)\"   , \"weeks?\",           TG.Week)\n         , (\"month (grain)\"  , \"months?\",          TG.Month)\n         , (\"quarter (grain)\", \"(quarter|qtr)s?\",  TG.Quarter)\n         , (\"year (grain)\"   , \"y(ea)?rs?\",        TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.ES.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"segundo (grain)\", \"seg(undo)?s?\", TG.Second)\n         , (\"minutos (grain)\", \"min(uto)?s?\", TG.Minute)\n         , (\"hora (grain)\", \"h(ora)?s?\", TG.Hour)\n         , (\"dia (grain)\", \"d(\u00c3\u00ad|i)as?\", TG.Day)\n         , (\"semana (grain)\", \"semanas?\", TG.Week)\n         , (\"mes (grain)\", \"mes(es)?\", TG.Month)\n         , (\"trimestre (grain)\", \"trimestres?\", TG.Quarter)\n         , (\"a\u00c3\u00b1o (grain)\", \"a(n|\u00c3\u00b1)os?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.FI.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain) \", \"sekuntia?|s\", TG.Second)\n         , (\"minute (grain)\" , \"minuuttia?|min\", TG.Minute)\n         , (\"hour (grain)\"   , \"tuntia?|h\", TG.Hour)\n         , (\"day (grain)\"    , \"p\u00c3\u00a4iv\u00c3\u00a4(\u00c3\u00a4)?|vuorokau(si|tta)|vrk|d\", TG.Day)\n         , (\"week (grain)\"   , \"viikkoa?|vko?\", TG.Week)\n         , (\"month (grain)\"  , \"kuukau(si|tta)|kk\", TG.Month)\n         , (\"quarter (grain)\", \"kvartaali(a)?|nelj\u00c3\u00a4nnesvuo(si|tta)\", TG.Quarter)\n         , (\"year (grain)\"   , \"vuo(si|tta)|v\\\\.?|a\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.FR.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"seconde (grain)\", \"sec(onde)?s?\", TG.Second)\n         , (\"minute (grain)\", \"min(ute)?s?\", TG.Minute)\n         , (\"heure (grain)\", \"heures?\", TG.Hour)\n         , (\"jour (grain)\", \"jour(n(e|\u00c3\u00a9)e?)?s?\", TG.Day)\n         , (\"semaine (grain)\", \"semaines?\", TG.Week)\n         , (\"mois (grain)\", \"mois\", TG.Month)\n         , (\"trimestre (grain)\", \"trimestres?\", TG.Quarter)\n         , (\"ann\u00c3\u00a9e (grain)\", \"an(n(e|\u00c3\u00a9)e?)?s?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.GA.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"soicind (grain)\", \"t?sh?oicind(\u00c3\u00ad|i)?\", TG.Second)\n         , (\"n\u00c3\u00b3im\u00c3\u00a9ad (grain)\", \"n[\u00c3\u00b3o]im(\u00c3\u00a9|e)[ai]da?\", TG.Minute)\n         , (\"uair (grain)\", \"([thn]-?)?uair(e|eanta)?\", TG.Hour)\n         , (\"l\u00c3\u00a1 (grain)\", \"l(ae(thanta)?|(\u00c3\u00a1|a))\", TG.Day)\n         , (\"seachtain (grain)\", \"t?sh?eachtain(e|(\u00c3\u00ad|i))?\", TG.Week)\n         , (\"m\u00c3\u00ad (grain)\", \"mh?(\u00c3\u00ad|i)(sa|nna)\", TG.Month)\n         , (\"r\u00c3\u00a1ithe (grain)\", \"r(\u00c3\u00a1|a)ith(e|(\u00c3\u00ad|i))\", TG.Quarter)\n         , (\"bliain (grain)\", \"m?bh?lia(in|na|nta)\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.HU.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain) \", \"m\\x00E1sodperc(ek)?|mp\",    TG.Second)\n         , (\"minute (grain)\" , \"perc(ek)?\",                 TG.Minute)\n         , (\"hour (grain)\"   , \"\\x00F3ra|\\x00F3r\\x00E1k\",   TG.Hour)\n         , (\"day (grain)\"    , \"nap(ok)?\",                  TG.Day)\n         , (\"week (grain)\"   , \"h\\x00E9t|hetek\",            TG.Week)\n         , (\"month (grain)\"  , \"h\\x00F3nap|h\\x00F3napok\",   TG.Month)\n         , (\"quarter (grain)\", \"negyed\\\\s?\\x00E9v(ek)?\",    TG.Quarter)\n         , (\"year (grain)\"   , \"\\x00E9v(ek)?\",              TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.IT.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"seconde (grain)\", \"second[oi]\", TG.Second)\n         , (\"minute (grain)\", \"minut[oi]\", TG.Minute)\n         , (\"heure (grain)\", \"or[ae]\", TG.Hour)\n         , (\"jour (grain)\", \"giorn[oi]\", TG.Day)\n         , (\"semaine (grain)\", \"settiman[ae]\", TG.Week)\n         , (\"mois (grain)\", \"mes[ei]\", TG.Month)\n         , (\"trimestre (grain)\", \"trimestr[ei]\", TG.Quarter)\n         , (\"ann\u00c3\u00a9e (grain)\", \"ann?[oi]\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.NB.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain)\", \"sek(und(er)?)?\", TG.Second)\n         , (\"minute (grain)\", \"min(utt(er)?)?\", TG.Minute)\n         , (\"hour (grain)\", \"t(ime(r)?)?\", TG.Hour)\n         , (\"day (grain)\", \"dag(er)?\", TG.Day)\n         , (\"week (grain)\", \"uke(r|n)?\", TG.Week)\n         , (\"month (grain)\", \"m\u00c3\u00a5ned(er)?\", TG.Month)\n         , (\"quarter (grain)\", \"kvart(al|er)(et)?\", TG.Quarter)\n         , (\"year (grain)\", \"\u00c3\u00a5r\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.NL.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain) \" , \"(seconde(n|s)?|sec|s)\" , TG.Second)\n         , (\"minute (grain)\"  , \"(minuut|minuten|min|m)\", TG.Minute)\n         , (\"hour (grain)\"    , \"(uur|uren|u|h)\",         TG.Hour)\n         , (\"day (grain)\"     , \"dagen|dag|d\",            TG.Day)\n         , (\"week (grain)\"    , \"(weken|week|w)\",         TG.Week)\n         , (\"month (grain)\"   , \"(maanden|maand|mnd)\",    TG.Month)\n         , (\"quarter (grain)\" , \"(kwartaal|kwartalen)\",   TG.Quarter)\n         , (\"year (grain)\"    , \"(jaren|jaar|j)\",         TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.PL.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain)\", \"sekund(y|zie|(e|\u00c4\u2122)|om|ami|ach|o|a)?|s\", TG.Second)\n         , (\"minute (grain)\", \"minut(y|cie|(e|\u00c4\u2122)|om|o|ami|ach|(a|\u00c4\u2026))?|m\", TG.Minute)\n         , (\"hour (grain)\", \"h|godzin(y|(e|\u00c4\u2122)|ie|om|o|ami|ach|(a|\u00c4\u2026))?\", TG.Hour)\n         , (\"day (grain)\", \"dzie(n|\u00c5\u201e|ni(a|\u00c4\u2026))|dni(owi|ach|a|\u00c4\u2026)?\", TG.Day)\n         , (\"week (grain)\", \"tydzie(n|\u00c5\u201e|)|tygod(ni(owi|u|a|em))|tygodn(iach|iami|iom|ie|i)|tyg\\\\.?\", TG.Week)\n         , (\"month (grain)\", \"miesi(a|\u00c4\u2026)c(owi|em|u|e|om|ami|ach|a)?\", TG.Month)\n         , (\"quarter (grain)\", \"kwarta(l|\u00c5\u201a)(u|owi|em|e|(o|\u00c3\u00b3)w|om|ach|ami|y)?\", TG.Quarter)\n         , (\"year (grain)\", \"rok(u|owi|iem)?|lat(ami|ach|a|om)?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.PT.Rules\n  ( rules\n  ) where\n\nimport Data.Text (Text)\nimport Data.String\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"segundo (grain)\", \"seg(undo)?s?\", TG.Second)\n         , (\"minutos (grain)\", \"min(uto)?s?\", TG.Minute)\n         , (\"hora (grain)\", \"h(ora)?s?\", TG.Hour)\n         , (\"dia (grain)\", \"d(\u00c3\u00ad|i)as?\", TG.Day)\n         , (\"semana (grain)\", \"semanas?\", TG.Week)\n         , (\"mes (grain)\", \"m(e|\u00c3\u00aa)s(es)?\", TG.Month)\n         , (\"trimestre (grain)\", \"trimestres?\", TG.Quarter)\n         , (\"ano (grain)\", \"anos?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 42}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.RO.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"secunde (grain)\", \"sec(und(a|e|\u00c4\u0192))?\", TG.Second)\n         , (\"minute (grain)\", \"min(ut(e|ul)?)?\", TG.Minute)\n         , (\"ore (grain)\", \"h|or(a|e(le)?|\u00c4\u0192)\", TG.Hour)\n         , (\"zile (grain)\", \"zi(le(le)?|u(a|\u00c4\u0192))?\", TG.Day)\n         , (\"saptamani (grain)\", \"sapt(a|\u00c4\u0192)m(a|\u00c3\u00a2)n(ile|a|\u00c4\u0192|i)\", TG.Week)\n         , (\"luni (grain)\", \"lun(i(le)?|a|\u00c4\u0192)\", TG.Month)\n         , (\"trimestru (grain)\", \"trimestr(e(le)?|ul?)\", TG.Quarter)\n         , (\"ani (grain)\", \"an(ul|ii?)?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 42}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.SV.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport qualified Duckling.TimeGrain.Types as TG\nimport Duckling.Types\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"second (grain)\", \"sek(und(er(na)?)?)?\", TG.Second)\n         , (\"minute (grain)\", \"min(ut(er(na)?)?)?\", TG.Minute)\n         , (\"hour (grain)\", \"t(imm(e(n)?|ar(na)?)?)?\", TG.Hour)\n         , (\"day (grain)\", \"dag(en|ar(na)?)?\", TG.Day)\n         , (\"week (grain)\", \"veck(or(na)?|a(n)?)?\", TG.Week)\n         , (\"month (grain)\", \"m\u00c3\u00a5nad(er(na)?)?\", TG.Month)\n         , (\"quarter (grain)\", \"kvart(al)(et)?\", TG.Quarter)\n         , (\"year (grain)\", \"\u00c3\u00a5r(e[nt])?\", TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.TimeGrain.TR.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport qualified Duckling.TimeGrain.Types  as TG\n\ngrains :: [(Text, String, TG.Grain)]\ngrains = [ (\"saniye (grain)\",     \"sa?n(iye)?(nin)?\",           TG.Second)\n         , (\"dakika (grain)\",     \"da?k(ika)?(n\u00c4\u00b1n)?\",           TG.Minute)\n         , (\"saat (grain)\",       \"sa(at)?(in)?\",              TG.Hour)\n         , (\"g\u00c3\u00bcn (grain)\",        \"g\u00c3\u00bcn(\u00c3\u00bcn)?\",             TG.Day)\n         , (\"hafta (grain)\",      \"hafta(n\u00c4\u00b1n)?\",                TG.Week)\n         , (\"ay (grain)\",         \"ay(\u00c4\u00b1n)?\",                   TG.Month)\n         , (\"\u00c3\u00a7eyrek y\u00c4\u00b1l (grain)\", \"\\231eyrek y\\305l(\u00c4\u00b1n)?\",     TG.Quarter)\n         , (\"y\u00c4\u00b1l (grain)\",        \"y\\305l(\u00c4\u00b1n)?\",               TG.Year)\n         ]\n\nrules :: [Rule]\nrules = map go grains\n  where\n    go (name, regexPattern, grain) = Rule\n      { name = name\n      , pattern = [regex regexPattern]\n      , prod = \\_ -> Just $ Token TimeGrain grain\n      }\n", "num_lines": 41}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Types.Stash where\n\nimport qualified Data.IntMap.Strict as IntMap\nimport Data.IntMap.Strict (IntMap)\nimport qualified Data.HashSet as HashSet\nimport Data.HashSet (HashSet)\nimport Data.Maybe\nimport Prelude\n\nimport Duckling.Types\n\nnewtype Stash = Stash { getSet :: IntMap (HashSet Node) }\n\nfilter :: (Node -> Bool) -> Stash -> Stash\nfilter p Stash{..} = Stash (IntMap.map (HashSet.filter p) getSet)\n\ntoPosOrderedList:: Stash -> [Node]\ntoPosOrderedList Stash{..} = concatMap HashSet.toList $ IntMap.elems getSet\n\ntoPosOrderedListFrom :: Stash -> Int -> [Node]\ntoPosOrderedListFrom Stash{..} pos =\n  concatMap HashSet.toList $ maybeToList equal ++ IntMap.elems bigger\n  where\n  (_smaller, equal, bigger) = IntMap.splitLookup pos getSet\n  -- this is where we take advantage of the order\n\nempty :: Stash\nempty = Stash IntMap.empty\n\nfromList :: [Node] -> Stash\nfromList ns = Stash (IntMap.fromListWith HashSet.union $ map mkKV ns)\n  where\n  mkKV n@Node{nodeRange = Range start _} = (start, HashSet.singleton n)\n\nunion :: Stash -> Stash -> Stash\nunion (Stash set1) (Stash set2) =\n  Stash (IntMap.unionWith HashSet.union set1 set2)\n\n-- Checks if two stashes have equal amount of Nodes on each position.\n-- Used to detect a fixpoint, because the Stashes are only growing.\n--\n-- Not proud of this, but the algorithm shouldn't use it as the termination\n-- condition, it should know when it stopped adding tokens\nsizeEqual :: Stash -> Stash -> Bool\nsizeEqual (Stash set1) (Stash set2) =\n  go (IntMap.toAscList set1) (IntMap.toAscList set2)\n  where\n  go [] [] = True\n  go [] (_:_) = False\n  go (_:_) [] = False\n  go ((k1, h1):rest1) ((k2, h2):rest2) =\n    k1 == k2 && HashSet.size h1 == HashSet.size h2 && go rest1 rest2\n\nnull :: Stash -> Bool\nnull (Stash set) = IntMap.null set\n", "num_lines": 66}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Url.Corpus\n  ( corpus\n  , negativeCorpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types\nimport Duckling.Url.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nnegativeCorpus :: NegativeCorpus\nnegativeCorpus = (testContext, testOptions, examples)\n  where\n    examples =\n      [ \"foo\"\n      , \"MYHOST\"\n      , \"hey:42\"\n      , \"25\"\n      ]\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (UrlData \"http://www.bla.com\" \"bla.com\")\n             [ \"http://www.bla.com\"\n             ]\n  , examples (UrlData \"www.bla.com:8080/path\" \"bla.com\")\n             [ \"www.bla.com:8080/path\"\n             ]\n  , examples (UrlData \"https://myserver?foo=bar\" \"myserver\")\n             [ \"https://myserver?foo=bar\"\n             ]\n  , examples (UrlData \"cnn.com/info\" \"cnn.com\")\n             [ \"cnn.com/info\"\n             ]\n  , examples (UrlData \"bla.com/path/path?ext=%23&foo=bla\" \"bla.com\")\n             [ \"bla.com/path/path?ext=%23&foo=bla\"\n             ]\n  , examples (UrlData \"localhost\" \"localhost\")\n             [ \"localhost\"\n             ]\n  , examples (UrlData \"localhost:8000\" \"localhost\")\n             [ \"localhost:8000\"\n             ]\n  , examples (UrlData \"http://kimchi\" \"kimchi\")\n             [ \"http://kimchi\"\n             ]\n  , examples (UrlData \"https://500px.com:443/about\" \"500px.com\")\n             [ \"https://500px.com:443/about\"\n             ]\n  , examples (UrlData \"www2.foo-bar.net?foo=bar\" \"foo-bar.net\")\n             [ \"www2.foo-bar.net?foo=bar\"\n             ]\n  , examples (UrlData \"https://api.wit.ai/message?q=hi\" \"api.wit.ai\")\n             [ \"https://api.wit.ai/message?q=hi\"\n             ]\n  , examples (UrlData \"aMaZon.co.uk/?page=home\" \"amazon.co.uk\")\n             [ \"aMaZon.co.uk/?page=home\"\n             ]\n  , examples (UrlData \"https://en.wikipedia.org/wiki/Uniform_Resource_Identifier#Syntax\" \"en.wikipedia.org\")\n             [ \"https://en.wikipedia.org/wiki/Uniform_Resource_Identifier#Syntax\"\n             ]\n  , examples (UrlData \"http://example.com/data.csv#cell=4,1-6,2\" \"example.com\")\n             [ \"http://example.com/data.csv#cell=4,1-6,2\"\n             ]\n  , examples (UrlData \"http://example.com/bar.webm#t=40,80&xywh=160,120,320,240\" \"example.com\")\n             [ \"http://example.com/bar.webm#t=40,80&xywh=160,120,320,240\"\n             ]\n  ]\n", "num_lines": 82}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n\n\nmodule Duckling.Url.Helpers\n  ( url\n  ) where\n\nimport Data.Text (Text)\nimport qualified Data.Text as Text\n\nimport qualified Duckling.Url.Types as TUrl\nimport Duckling.Url.Types (UrlData(..))\n\n-- -----------------------------------------------------------------\n-- Patterns\n\n-- -----------------------------------------------------------------\n-- Production\n\nurl :: Text -> Text -> UrlData\nurl value domain = UrlData\n  {TUrl.value = value, TUrl.domain = Text.toLower domain}\n", "num_lines": 29}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Url.Rules\n  ( rules ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Regex.Types\nimport Duckling.Types\nimport Duckling.Url.Helpers\n\nruleURL :: Rule\nruleURL = Rule\n  { name = \"url\"\n  , pattern =\n    [ regex \"((([a-zA-Z]+)://)?(w{2,3}[0-9]*\\\\.)?(([\\\\w_-]+\\\\.)+[a-z]{2,4})(:(\\\\d+))?(/[^?\\\\s#]*)?(\\\\?[^\\\\s#]+)?(#[\\\\-,*=&a-z0-9]+)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m:_:_protocol:_:domain:_:_:_port:_path:_query:_)):\n       _) -> Just . Token Url $ url m domain\n      _ -> Nothing\n  }\n\nruleLocalhost :: Rule\nruleLocalhost = Rule\n  { name = \"localhost\"\n  , pattern =\n    [ regex \"((([a-zA-Z]+)://)?localhost(:(\\\\d+))?(/[^?\\\\s#]*)?(\\\\?[^\\\\s#]+)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m:_:_protocol:_:_port:_path:_query:_)):_) ->\n        Just . Token Url $ url m \"localhost\"\n      _ -> Nothing\n  }\n\nruleLocalURL :: Rule\nruleLocalURL = Rule\n  { name = \"local url\"\n  , pattern =\n    [ regex \"(([a-zA-Z]+)://([\\\\w_-]+)(:(\\\\d+))?(/[^?\\\\s#]*)?(\\\\?[^\\\\s#]+)?)\"\n    ]\n  , prod = \\tokens -> case tokens of\n      (Token RegexMatch (GroupMatch (m:_protocol:domain:_:_port:_path:_query:_)):\n       _) -> Just . Token Url $ url m domain\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules =\n  [ ruleURL\n  , ruleLocalhost\n  , ruleLocalURL\n  ]\n", "num_lines": 64}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Url.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Maybe\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\n\nimport Duckling.Resolve (Resolve(..))\n\ndata UrlData = UrlData\n  { value :: Text\n  , domain :: Text\n  }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve UrlData where\n  type ResolvedValue UrlData = UrlData\n  resolve _ _ x = Just (x, False)\n\ninstance ToJSON UrlData where\n  toJSON (UrlData value domain) = object\n    [ \"value\"  .= value\n    , \"domain\" .= domain\n    , \"type\"   .= (\"value\" :: Text)\n    ]\n", "num_lines": 43}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n\n\nmodule Duckling.Volume.Helpers\n  ( isSimpleVolume\n  , isUnitOnly\n  , volume\n  , unitOnly\n  , valueOnly\n  , withUnit\n  , withValue\n  , withInterval\n  , withMin\n  , withMax\n  ) where\n\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Volume.Types (Unit(..), VolumeData(..))\nimport Duckling.Types\nimport qualified Duckling.Volume.Types as TVolume\n\n-- -----------------------------------------------------------------\n-- Patterns\n\nisSimpleVolume :: Predicate\nisSimpleVolume (Token Volume VolumeData {TVolume.value = Just _\n                                        , TVolume.minValue = Nothing\n                                        , TVolume.maxValue = Nothing}) = True\nisSimpleVolume _ = False\n\nisUnitOnly :: Predicate\nisUnitOnly (Token Volume VolumeData {TVolume.value = Nothing\n                                    , TVolume.unit = Just _\n                                    , TVolume.minValue = Nothing\n                                    , TVolume.maxValue = Nothing}) = True\nisUnitOnly _ = False\n\n-- -----------------------------------------------------------------\n-- Production\n\nvolume :: Unit -> Double -> VolumeData\nvolume u v = VolumeData {TVolume.unit = Just u\n                        , TVolume.value = Just v\n                        , TVolume.minValue = Nothing\n                        , TVolume.maxValue = Nothing}\n\nunitOnly :: Unit -> VolumeData\nunitOnly u = VolumeData {TVolume.unit = Just u\n                        , TVolume.value = Nothing\n                        , TVolume.minValue = Nothing\n                        , TVolume.maxValue = Nothing}\n\nvalueOnly :: Double -> VolumeData\nvalueOnly v = VolumeData {TVolume.unit = Nothing\n                        , TVolume.value = Just v\n                        , TVolume.minValue = Nothing\n                        , TVolume.maxValue = Nothing}\n\nwithUnit :: Unit -> VolumeData -> VolumeData\nwithUnit u vd = vd {TVolume.unit = Just u}\n\nwithValue :: Double -> VolumeData -> VolumeData\nwithValue v vd = vd {TVolume.value = Just v}\n\nwithInterval :: (Double, Double) -> VolumeData -> VolumeData\nwithInterval (from, to) vd = vd {TVolume.value = Nothing\n                                , TVolume.minValue = Just from\n                                , TVolume.maxValue = Just to}\n\nwithMin :: Double -> VolumeData -> VolumeData\nwithMin from vd = vd {TVolume.minValue = Just from}\n\nwithMax :: Double -> VolumeData -> VolumeData\nwithMax to vd = vd {TVolume.maxValue = Just to}\n", "num_lines": 85}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nruleNumeralAsVolume :: Rule\nruleNumeralAsVolume = Rule\n  { name = \"number as volume\"\n  , pattern =\n    [ Predicate isPositive\n    ]\n  , prod = \\case\n    (Token Numeral TNumeral.NumeralData {TNumeral.value = v}:\n     _) ->\n      Just . Token Volume $ valueOnly v\n    _ -> Nothing\n  }\n\nruleNumeralVolumes :: Rule\nruleNumeralVolumes = Rule\n  { name = \"<number> <volume>\"\n  , pattern =\n    [ Predicate isPositive\n    , Predicate isUnitOnly\n    ]\n  , prod = \\case\n    (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:\n     Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n     _) ->\n      Just . Token Volume $ volume u v\n    _ -> Nothing\n  }\n\nruleIntervalNumeralDash :: Rule\nruleIntervalNumeralDash = Rule\n  { name = \"<numeral> - <volume>\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"\\\\-\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (Token Numeral TNumeral.NumeralData{TNumeral.value = from}:\n       _:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u}:\n       _) | from < to ->\n        Just . Token Volume . withInterval (from, to) $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalDash :: Rule\nruleIntervalDash = Rule\n  { name = \"<volume> - <volume>\"\n  , pattern =\n    [ Predicate isSimpleVolume\n    , regex \"\\\\-\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (Token Volume TVolume.VolumeData{TVolume.value = Just from\n                                  , TVolume.unit = Just u1}:\n       _:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u2}:\n       _) | from < to && u1 == u2 ->\n        Just . Token Volume . withInterval (from, to) $ unitOnly u1\n      _ -> Nothing\n  }\n\nrules :: [Rule]\nrules = [ ruleNumeralAsVolume\n        , ruleNumeralVolumes\n        , ruleIntervalNumeralDash\n        , ruleIntervalDash\n        ]\n", "num_lines": 99}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Duckling.Volume.Types where\n\nimport Control.DeepSeq\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Text (Text)\nimport GHC.Generics\nimport Prelude\nimport Duckling.Resolve (Resolve (..))\nimport qualified Data.Text as Text\nimport qualified Data.HashMap.Strict as H\n\ndata Unit\n  = Gallon\n  | Hectolitre\n  | Litre\n  | Centilitre\n  | Millilitre\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance ToJSON Unit where\n  toJSON = String . Text.toLower . Text.pack . show\n\ndata VolumeData = VolumeData\n  { value :: Maybe Double\n  , unit :: Maybe Unit\n  , minValue :: Maybe Double\n  , maxValue :: Maybe Double\n  }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve VolumeData where\n  type ResolvedValue VolumeData = VolumeValue\n  resolve _ _ VolumeData {value = Just v, unit = Just u} =\n    Just (simple u v, False)\n  resolve _ _ VolumeData {value = Nothing, unit = Just u\n                         , minValue = Just from, maxValue = Just to} =\n    Just (between u (from, to), False)\n  resolve _ _ VolumeData {value = Nothing, unit = Just u\n                         , minValue = Just v, maxValue = Nothing} =\n    Just (above u v, False)\n  resolve _ _ VolumeData {value = Nothing, unit = Just u\n                         , minValue = Nothing, maxValue = Just v} =\n    Just (under u v, False)\n  resolve _ _ _ = Nothing\n\ndata IntervalDirection = Above | Under\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ndata SingleValue = SingleValue\n  { vUnit :: Unit\n  , vValue :: Double\n  }\n  deriving (Eq, Show)\n\ninstance ToJSON SingleValue where\n  toJSON SingleValue {vUnit, vValue} = object\n    [ \"value\" .= vValue\n    , \"unit\"  .= vUnit\n    ]\n\ndata VolumeValue\n  = SimpleValue SingleValue\n  | IntervalValue (SingleValue, SingleValue)\n  | OpenIntervalValue (SingleValue, IntervalDirection)\n  deriving (Show, Eq)\n\ninstance ToJSON VolumeValue where\n  toJSON (SimpleValue value) = case toJSON value of\n    Object o -> Object $ H.insert \"type\" (toJSON (\"value\" :: Text)) o\n    _ -> Object H.empty\n  toJSON (IntervalValue (from, to)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    , \"to\" .= toJSON to\n    ]\n  toJSON (OpenIntervalValue (from, Above)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"from\" .= toJSON from\n    ]\n  toJSON (OpenIntervalValue (to, Under)) = object\n    [ \"type\" .= (\"interval\" :: Text)\n    , \"to\" .= toJSON to\n    ]\n\n-- -----------------------------------------------------------------\n-- Value helpers\n\nsimple :: Unit -> Double -> VolumeValue\nsimple u v = SimpleValue $ single u v\n\nbetween :: Unit -> (Double, Double) -> VolumeValue\nbetween u (from,to) = IntervalValue (single u from, single u to)\n\nabove :: Unit -> Double -> VolumeValue\nabove = openInterval Above\n\nunder :: Unit -> Double -> VolumeValue\nunder = openInterval Under\n\nopenInterval :: IntervalDirection -> Unit -> Double -> VolumeValue\nopenInterval direction u v = OpenIntervalValue (single u v, direction)\n\nsingle :: Unit -> Double -> SingleValue\nsingle u v = SingleValue {vUnit = u, vValue = v}\n", "num_lines": 120}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.CA.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale CA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 mililitres\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litres\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 gal\u00c3\u00b3\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hectolitres\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"mig litre\"\n             ]\n  ]\n", "num_lines": 44}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.CA.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Volume.Helpers\nimport qualified Duckling.Volume.Types as TVolume\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(l|ililitres?)\", TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"(hectolitres?)\" , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(itres?)?\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(ons|\u00c3\u00b3)\"     , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just $ Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"mig\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just $ Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n     rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 68}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.DE.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.Volume.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale DE Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Litre 1)\n             [ \"1 liter\"\n             --, \"ein liter\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 liter\"\n             , \"2l\"\n             ]\n  , examples (simple Litre 1000)\n             [ \"1000 liter\"\n             , \"tausend liter\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"halber liter\"\n            , \"ein halber liter\"\n             ]\n  , examples (simple Litre 0.25)\n             [ \"viertel liter\"\n            , \"ein viertel liter\"\n             ]\n  , examples (simple Millilitre 1)\n             [ \"ein milliliter\"\n             , \"ein ml\"\n             , \"1ml\"\n             ]\n  , examples (simple Millilitre 250)\n             [ \"250 milliliter\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hektoliter\"\n             ]\n  , examples (between Litre (100,1000))\n             [ \"zwischen 100 und 1000 litern\"\n             , \"100-1000 liter\"\n             , \"von 100 bis 1000 l\"\n             , \"100 - 1000 l\"\n             ]\n  , examples (between Litre (2,7))\n             [ \"etwa 2 -7 l\"\n             , \"~2-7 liter\"\n             , \"von 2 bis 7 l\"\n             , \"zwischen 2,0 l und ungef\u00c3\u00a4hr 7,0 l\"\n             , \"zwischen 2l und etwa 7l\"\n             , \"2 - ~7 liter\"\n             ]\n  , examples (under Hectolitre 2)\n             [ \"nicht mehr als 2 hektoliter\"\n             , \"h\u00c3\u00b6chstens zwei hektoliter\"\n             , \"unter 2 hektolitern\"\n             , \"weniger als 2 hektoliter\"\n             ]\n  , examples (above Millilitre 4)\n             [ \"mehr als 4 ml\"\n             , \"wenigstens 4,0 ml\"\n             , \"\u00c3\u00bcber vier milliliter\"\n             , \"mindestens vier ml\"\n             ]\n  ]\n", "num_lines": 86}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.DE.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\", \"m(l|illiliter[ns]?)\", TVolume.Millilitre)\n          , (\"<vol> hectoliters\", \"hektoliter[ns]?\", TVolume.Hectolitre)\n          , (\"<vol> liters\", \"l(iter[ns]?)?\", TVolume.Litre)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"one\",\"ein(e[ns])?\", 1)\n            , (\"half\", \"(ein(e[ns])? )?halb(e[rn])? \", 1/2)\n            , (\"third\", \"(ein(e[ns])? )?dritttel \", 1/3)\n            , (\"fourth\", \"(ein(e[ns])? )?viertel \", 1/4)\n            , (\"fifth\", \"(ein(e[ns])? )?f\u00c3\u00bcnftel \", 1/5)\n            , (\"tenth\", \"(ein(e[ns])? )?zehntel \", 1/10)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about <volume>\"\n  , pattern =\n    [ regex \"\\\\~|(ganz )?genau|pr\u00c3\u00a4zise|(in )?etwa|ungef\u00c3\u00a4hr|um( die)?|fast\"\n    , dimension Volume\n    ]\n    , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> and|to <volume>\"\n  , pattern =\n    [ regex \"zwischen|von\"\n    , Predicate isPositive\n    , regex \"und|bis( zu)?\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral TNumeral.NumeralData{TNumeral.value = from}:\n       _:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u}:\n       _) | from < to ->\n        Just . Token Volume . withInterval (from, to) $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <volume> to|and <volume>\"\n  , pattern =\n    [ regex \"zwischen|von\"\n    , Predicate isSimpleVolume\n    , regex \"bis( zu)?|und\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (_:\n       Token Volume TVolume.VolumeData{TVolume.value = Just from\n                                  , TVolume.unit = Just u1}:\n       _:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u2}:\n       _) | from < to && u1 == u2 ->\n        Just . Token Volume . withInterval (from, to) $ unitOnly u1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"at most <volume>\"\n  , pattern =\n    [ regex \"unter|weniger( als)?|h\u00c3\u00b6chstens|nicht mehr als\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (_:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u}:\n       _) ->\n        Just . Token Volume . withMax to $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"more than <volume>\"\n  , pattern =\n      [ regex \"\u00c3\u00bcber|mindestens|wenigstens|mehr als|gr\u00c3\u00b6\u00c3\u0178er( als)?\"\n      , Predicate isSimpleVolume\n      ]\n    , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.value = Just from\n                                    , TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume . withMin from $ unitOnly u\n        _ -> Nothing\n    }\n\nrules :: [Rule]\nrules = [ rulePrecision\n        , ruleIntervalBetweenNumeral\n        , ruleIntervalBetween\n        , ruleIntervalMax\n        , ruleIntervalMin\n        ]\n        ++ rulesVolumes\n        ++ rulesFractionalVolume\n", "num_lines": 166}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.EN.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Testing.Types\nimport Duckling.Volume.Types\n\ncorpus :: Corpus\ncorpus = (testContext, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Litre 1)\n             [ \"1 liter\"\n             , \"1 litre\"\n             , \"one liter\"\n             , \"a liter\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 liters\"\n             , \"2l\"\n             ]\n  , examples (simple Litre 1000)\n             [ \"1000 liters\"\n             , \"thousand liters\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"half liter\"\n             , \"half-litre\"\n             , \"half a liter\"\n             ]\n  , examples (simple Litre 0.25)\n             [ \"quarter-litre\"\n             , \"fourth of liter\"\n             ]\n  , examples (simple Millilitre 1)\n             [ \"one milliliter\"\n             , \"an ml\"\n             , \"a millilitre\"\n             ]\n  , examples (simple Millilitre 250)\n             [ \"250 milliliters\"\n             , \"250 millilitres\"\n             , \"250ml\"\n             , \"250mls\"\n             , \"250 ml\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 gallons\"\n             , \"3 gal\"\n             , \"3gal\"\n             , \"around three gallons\"\n             ]\n  , examples (simple Gallon 0.5)\n             [ \"0.5 gals\"\n             , \"1/2 gallon\"\n             , \"half a gallon\"\n             ]\n  , examples (simple Gallon 0.1)\n             [ \"0.1 gallons\"\n             , \"tenth of a gallon\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hectoliters\"\n             ]\n  , examples (between Litre (100,1000))\n             [ \"between 100 and 1000 liters\"\n             , \"100-1000 liters\"\n             , \"from 100 to 1000 l\"\n             , \"100 - 1000 l\"\n             ]\n  , examples (between Litre (2,7))\n             [ \"around 2 -7 l\"\n             , \"~2-7 liters\"\n             , \"from 2 to 7 l\"\n             , \"between 2.0 l and about 7.0 l\"\n             , \"between 2l and about 7l\"\n             , \"2 - ~7 litres\"\n             ]\n  , examples (under Gallon 6)\n             [ \"less than six gallons\"\n             , \"under six gallon\"\n             , \"no more than 6 gals\"\n             , \"below 6.0gal\"\n             , \"at most six gallons\"\n             ]\n  , examples (above Hectolitre 2)\n             [ \"exceeding 2 hectoliters\"\n             , \"at least two hectolitres\"\n             , \"over 2 hectolitre\"\n             , \"more than 2 hectoliter\"\n             ]\n  , examples (above Millilitre 4)\n             [ \"exceeding 4 ml\"\n             , \"at least 4.0 ml\"\n             , \"over four milliliters\"\n             , \"more than four mls\"\n             ]\n  ]\n", "num_lines": 111}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.EN.Rules\n  ( rules ) where\n\nimport Data.Text (Text)\nimport Prelude\nimport Data.String\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\", \"m(l(s?)|illilit(er|re)s?)\", TVolume.Millilitre)\n          , (\"<vol> hectoliters\", \"hectolit(er|re)s?\", TVolume.Hectolitre)\n          , (\"<vol> liters\", \"l(it(er|re)s?)?\", TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal((l?ons?)|s)?\", TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"one\", \"an? \", 1)\n            , (\"half\", \"half(-|(( of)?( a(n?))?))?\", 1/2)\n            , (\"third\", \"third(-|(( of)?( a(n?))?))?\", 1/3)\n            , (\"fourth\", \"(quarter|fourth)(-|(( of)?( a(n?))?))?\", 1/4)\n            , (\"fifth\", \"fifth(-|(( of)?( a(n?))?))?\", 1/5)\n            , (\"tenth\", \"tenth(-|(( of)?( a(n?))?))?\", 1/10)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrulePrecision :: Rule\nrulePrecision = Rule\n  { name = \"about <volume>\"\n  , pattern =\n    [ regex \"\\\\~|exactly|precisely|about|approx(\\\\.|imately)?|close to|near( to)?|around|almost\"\n    , dimension Volume\n    ]\n    , prod = \\case\n      (_:token:_) -> Just token\n      _ -> Nothing\n  }\n\nruleIntervalBetweenNumeral :: Rule\nruleIntervalBetweenNumeral = Rule\n  { name = \"between|from <numeral> and|to <volume>\"\n  , pattern =\n    [ regex \"between|from\"\n    , Predicate isPositive\n    , regex \"to|and\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (_:\n       Token Numeral TNumeral.NumeralData{TNumeral.value = from}:\n       _:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u}:\n       _) | from < to ->\n        Just . Token Volume . withInterval (from, to) $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalBetween :: Rule\nruleIntervalBetween = Rule\n  { name = \"between|from <volume> to|and <volume>\"\n  , pattern =\n    [ regex \"between|from\"\n    , Predicate isSimpleVolume\n    , regex \"to|and\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (_:\n       Token Volume TVolume.VolumeData{TVolume.value = Just from\n                                  , TVolume.unit = Just u1}:\n       _:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u2}:\n       _) | from < to && u1 == u2 ->\n        Just . Token Volume . withInterval (from, to) $ unitOnly u1\n      _ -> Nothing\n  }\n\nruleIntervalMax :: Rule\nruleIntervalMax = Rule\n  { name = \"at most <volume>\"\n  , pattern =\n    [ regex \"under|below|at most|(less|lower|not? more) than\"\n    , Predicate isSimpleVolume\n    ]\n  , prod = \\case\n      (_:\n       Token Volume TVolume.VolumeData{TVolume.value = Just to\n                                  , TVolume.unit = Just u}:\n       _) ->\n        Just . Token Volume . withMax to $ unitOnly u\n      _ -> Nothing\n  }\n\nruleIntervalMin :: Rule\nruleIntervalMin = Rule\n  { name = \"more than <volume>\"\n  , pattern =\n      [ regex \"over|above|exceeding|beyond|at least|(more|larger|bigger|heavier) than\"\n      , Predicate isSimpleVolume\n      ]\n    , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.value = Just from\n                                    , TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume . withMin from $ unitOnly u\n        _ -> Nothing\n    }\n\nrules :: [Rule]\nrules = [ rulePrecision\n        , ruleIntervalBetweenNumeral\n        , ruleIntervalBetween\n        , ruleIntervalMax\n        , ruleIntervalMin\n        ]\n        ++ rulesVolumes\n        ++ rulesFractionalVolume\n", "num_lines": 167}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.ES.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale ES Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 mililitros\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litros\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 gal\u00c3\u00b3n\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hectolitros\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"medio litro\"\n             ]\n  ]\n", "num_lines": 44}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.ES.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(l|ililitros?)\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"(hectolitros?)\"    , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(itros?)?\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(o|\u00c3\u00b3)ne?s?\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"medio\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.FR.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale FR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 millilitres\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Centilitre 25)\n             [ \"25 centilitres\"\n             , \"25cl\"\n             , \"25 cl\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litres\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 gallons\"\n             , \"3 gal\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hectolitres\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"demi-litre\"\n             , \"demi litre\"\n             ]\n  , examples (simple Litre 0.25)\n             [ \"quart de litre\"\n             ]\n  ]\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.FR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(l|illilitres?)\" , TVolume.Millilitre)\n          , (\"<latent vol> cl\"    , \"c(l|entilitres?)\" , TVolume.Centilitre)\n          , (\"<vol> hectoliters\"  , \"(hectolitres?)\"    , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(itres?)?\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(l?ons?)?\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"quart\", \"quart de\", 1/4)\n            , (\"half\", \"demi-?\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 76}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.GA.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale GA Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 millil\u00c3\u00adtir\"\n             , \"250 millilitir\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 l\u00c3\u00adtir\"\n             ]\n  , examples (simple Gallon 5)\n             [ \"5 gal\u00c3\u00bain\"\n             ]\n  , examples (simple Hectolitre 20)\n             [ \"20 heictilitear\"\n             , \"2 kl\"\n             ]\n  ]\n", "num_lines": 43}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.GA.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\", \"m(l\\\\.?|h?illil(\u00c3\u00ad|i)t(ea|i)r)\"\n            , TVolume.Millilitre)\n          , (\"<vol> hectoliters\" , \"heictil(\u00c3\u00ad|i)t(ea|i)r\"\n            , TVolume.Hectolitre)\n          , (\"<vol> liters\", \"(l(\u00c3\u00ad|i)t(ea|i)r|l\\\\.?)\"\n            , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"n?gh?al(\u00c3\u00ba|u)i?n\"\n            , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nruleKiloliter :: Rule\nruleKiloliter = Rule\n  { name = \"kiloliter\"\n  , pattern =\n    [ Predicate isPositive\n    , regex \"(kl\\\\.?|g?ch?illil(\u00c3\u00ad|i)t(ea|i)r)\"\n    ]\n  , prod = \\case\n    (Token Numeral TNumeral.NumeralData{TNumeral.value = v}:\n     _:_) ->\n      Just . Token Volume . withUnit TVolume.Hectolitre $ valueOnly (10.0 * v)\n    _ -> Nothing\n  }\n\nrules :: [Rule]\nrules = [ ruleKiloliter\n        ]\n        ++ rulesVolumes\n", "num_lines": 68}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.HR.Corpus\n  ( corpus ) where\n\nimport Prelude\nimport Data.String\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.Volume.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale HR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 mililitara\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litre\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 galona\"\n             , \"3 gal\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hektolitra\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"pola litre\"\n             ]\n  ]\n", "num_lines": 44}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.HR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(l|ililita?ra?)\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"(hektolita?ra?)\"    , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(it(a)?r(a|e)?)?\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(ona?)?\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"pola\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 73}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.IT.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale IT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 millilitri\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litri\"\n             , \"2l\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 galloni\"\n             , \"3 gal\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 ettolitri\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"mezzo litro\"\n             ]\n  ]\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.IT.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(l|illilitr(i|o))\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"ettolitr(i|o)\"    , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(itr(i|o))?\"    , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(lon(e|i))?\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"mezzo\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.KO.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"ml|(\u00eb\u00b0\u20ac|\u00eb\u00af\u00b8)\u00eb\u00a6\u00ac\u00eb\u00a6\u00ac\u00ed\u201e\u00b0\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"(\u00ed\u2022\u00b5|\u00ed\u2014\u00a5)\u00ed\u2020\u00a0\u00eb\u00a6\u00ac\u00ed\u201e\u00b0\"    , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"(l|\u00eb\u00a6\u00ac\u00ed\u201e\u00b0)\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(l?ons?)?|\u00ea\u00b0\u00a4(\u00eb\u0178\u00b0|\u00eb\u00a1\u00a0)\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.NL.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale NL Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 milliliter\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 liter\"\n             , \"2 liters\"\n             , \"2l\"\n             , \"2 l\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hectoliter\"\n             , \"3 hl\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"halve liter\"\n             ]\n  ]\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.NL.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types (GroupMatch(..))\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(illi)?l(iter)?\" , TVolume.Millilitre)\n          , (\"<vol> hl\"           , \"h(ecto)?l(iter)?\"   , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(iters?)?\"    , TVolume.Litre)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"halve\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.PT.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale PT Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 mililitros\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litros\"\n             ]\n  , examples (simple Gallon 1)\n             [ \"1 gal\u00c3\u00a3o\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 gal\u00c3\u00b5es\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hectolitros\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"meio litro\"\n             ]\n  ]\n", "num_lines": 47}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.PT.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(l|ililitros?)\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"(hectolitros?)\"    , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(itros?)?\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(a|\u00c3\u00a3|o|\u00c3\u00b5)o?e?s?\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"meio\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.RO.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Volume.Types\nimport Duckling.Testing.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RO Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 mililitri\"\n             , \"250 de mililitri\"\n             , \"250ml\"\n             , \"250 ml\"\n             , \"250 de ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litri\"\n             , \"2 l\"\n             , \"2l\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 galoane\"\n             , \"3 gal\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hectolitri\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"jumatate de litru\"\n             , \"jum\u00c4\u0192tate de litru\"\n             ]\n  , examples (simple Gallon 20)\n             [ \"douazeci de galoane\"\n             ]\n  ]\n", "num_lines": 54}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.RO.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"(de )?m(ililitr[ui]|l)\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"(de )?hectolitr[ui]\"    , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"(de )?l(itr[ui])?\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"(de )?gal(oane|on)?\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"jum(a|\u00c4\u0192)tate\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 75}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.RU.Corpus\n  ( corpus\n  ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.Volume.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale RU Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 \u00d0\u00bc\u00d0\u00b8\u00d0\u00bb\u00d0\u00bb\u00d0\u00b8\u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00be\u00d0\u00b2\"\n             , \"250\u00d0\u00bc\u00d0\u00bb\"\n             , \"250 \u00d0\u00bc\u00d0\u00bb\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 \u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n             , \"2 \u00d0\u00bb\"\n             , \"\u00d0\u00b4\u00d0\u00b2\u00d0\u00b0 \u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n             ]\n  , examples (simple Litre 1)\n             [ \"1 \u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\"\n             , \"\u00d0\u00be\u00d0\u00b4\u00d0\u00b8\u00d0\u00bd \u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\"\n             , \"1\u00d0\u00bb\"\n             ]\n  , examples (simple Gallon 3)\n             [ \"3 \u00d0\u00b3\u00d0\u00b0\u00d0\u00bb\u00d0\u00bb\u00d0\u00be\u00d0\u00bd\u00d0\u00b0\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 \u00d0\u00b3\u00d0\u00b5\u00d0\u00ba\u00d1\u201a\u00d0\u00be\u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n             , \"3 \u00d0\u00b3\u00d0\u00bb\"\n             , \"3\u00d0\u00b3\u00d0\u00bb\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"\u00d0\u00bf\u00d0\u00be\u00d0\u00bb-\u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n             , \"\u00d0\u00bf\u00d0\u00be\u00d0\u00bb\u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n             , \"\u00d0\u00bf\u00d0\u00be\u00d0\u00bb \u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n             ]\n  , examples (simple Litre 1.5)\n             [ \"\u00d0\u00bf\u00d0\u00be\u00d0\u00bb\u00d1\u201a\u00d0\u00be\u00d1\u20ac\u00d0\u00b0 \u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n             ]\n  ]\n", "num_lines": 59}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.RU.Rules\n  ( rules\n  ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"\u00d0\u00bc\u00d0\u00bb|\u00d0\u00bc\u00d0\u00b8\u00d0\u00bb\u00d0\u00bb\u00d0\u00b8\u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac(\u00d0\u00b0|\u00d0\u00be\u00d0\u00b2)?\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"\u00d0\u00b3\u00d0\u00bb|\u00d0\u00b3\u00d0\u00b5\u00d0\u00ba\u00d1\u201a\u00d0\u00be\u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac(\u00d0\u00b0|\u00d0\u00be\u00d0\u00b2)?\" , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"\u00d0\u00bb(\u00d0\u00b8\u00d1\u201a\u00d1\u20ac(\u00d0\u00b0|\u00d0\u00be\u00d0\u00b2)?)?\"      , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"\u00d0\u00b3\u00d0\u00b0\u00d0\u00bb\u00d0\u00bb\u00d0\u00be\u00d0\u00bd(\u00d0\u00b0|\u00d0\u00be\u00d0\u00b2)?\"       , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"\u00d0\u00bf\u00d0\u00be\u00d0\u00bb[-\\\\s]?\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nruleHalfLiter :: Rule\nruleHalfLiter = Rule\n  { name = \"half liter\"\n  , pattern =\n    [ regex \"\u00d0\u00bf\u00d0\u00be\u00d0\u00bb\u00d0\u00bb\u00d0\u00b8\u00d1\u201a\u00d1\u20ac\u00d0\u00b0\"\n    ]\n  , prod = \\_ -> Just . Token Volume . withUnit TVolume.Litre $ valueOnly 0.5\n  }\n\nrules :: [Rule]\nrules = [ ruleHalfLiter\n        ]\n        ++ rulesVolumes\n        ++ rulesFractionalVolume\n", "num_lines": 83}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.TR.Corpus\n  ( corpus ) where\n\nimport Data.String\nimport Prelude\n\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.Volume.Types\n\ncorpus :: Corpus\ncorpus = (testContext {locale = makeLocale TR Nothing}, testOptions, allExamples)\n\nallExamples :: [Example]\nallExamples = concat\n  [ examples (simple Millilitre 250)\n             [ \"250 mililitre\"\n             , \"250ml\"\n             , \"250 ml\"\n             ]\n  , examples (simple Litre 2)\n             [ \"2 litre\" ]\n  , examples (simple Gallon 3)\n             [ \"3 galon\"\n             , \"3 gal\"\n             ]\n  , examples (simple Hectolitre 3)\n             [ \"3 hektolitre\"\n             ]\n  , examples (simple Litre 0.5)\n             [ \"yar\u00c4\u00b1m litre\"\n             ]\n  ]\n", "num_lines": 44}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Volume.TR.Rules\n  ( rules ) where\n\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\n\nimport Duckling.Dimensions.Types\nimport Duckling.Types\nimport Duckling.Regex.Types\nimport Duckling.Volume.Helpers\nimport Duckling.Numeral.Helpers (isPositive)\nimport qualified Duckling.Volume.Types as TVolume\nimport qualified Duckling.Numeral.Types as TNumeral\n\nvolumes :: [(Text, String, TVolume.Unit)]\nvolumes = [ (\"<latent vol> ml\"    , \"m(l|ililitre)\" , TVolume.Millilitre)\n          , (\"<vol> hectoliters\"  , \"(hektolitre)\"  , TVolume.Hectolitre)\n          , (\"<vol> liters\"       , \"l(t|itre)\"     , TVolume.Litre)\n          , (\"<latent vol> gallon\", \"gal(l?on?)?\"   , TVolume.Gallon)\n          ]\n\nrulesVolumes :: [Rule]\nrulesVolumes = map go volumes\n  where\n    go :: (Text, String, TVolume.Unit) -> Rule\n    go (name, regexPattern, u) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        ]\n      , prod = \\_ -> Just . Token Volume $ unitOnly u\n      }\n\nfractions :: [(Text, String, Double)]\nfractions = [ (\"half\", \"yar\\305m\", 1/2)\n            ]\n\nrulesFractionalVolume :: [Rule]\nrulesFractionalVolume = map go fractions\n  where\n    go :: (Text, String, Double) -> Rule\n    go (name, regexPattern, f) = Rule\n      { name = name\n      , pattern =\n        [ regex regexPattern\n        , Predicate isUnitOnly\n        ]\n      , prod = \\case\n        (_:\n         Token Volume TVolume.VolumeData{TVolume.unit = Just u}:\n         _) ->\n          Just . Token Volume $ volume u f\n        _ -> Nothing\n      }\n\nrules :: [Rule]\nrules =\n  [\n  ]\n  ++ rulesVolumes\n  ++ rulesFractionalVolume\n", "num_lines": 74}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Main (main) where\n\nimport Control.DeepSeq\nimport Control.Monad\nimport Data.Aeson\nimport Data.Hashable\nimport Data.Semigroup ((<>))\nimport Data.Text (Text)\nimport Data.Typeable\nimport GHC.Generics\nimport Prelude\nimport qualified Data.HashSet as HashSet\nimport qualified TextShow as TS\n\nimport Duckling.Debug\nimport Duckling.Locale\nimport Duckling.Regex.Types (GroupMatch(..))\nimport Duckling.Resolve (Resolve(..))\nimport Duckling.Types\n\ndata MyDimension = MyDimension deriving (Eq, Show, Typeable)\n\ninstance CustomDimension MyDimension where\n  type DimensionData MyDimension = MyData\n  dimRules _ = [myDimensionRule, myDimensionRule']\n  dimLangRules _ _ = []\n  dimLocaleRules _ _ = []\n  dimDependents _ = HashSet.empty\n\ndata MyData = MyData\n  { iField :: Int\n  , bField :: Bool\n  , tField :: Text\n  }\n  deriving (Eq, Generic, Hashable, Ord, Show, NFData)\n\ninstance Resolve MyData where\n  type ResolvedValue MyData = MyValue\n  resolve _ _ MyData{..} = Just\n    ( MyValue $ TS.showt iField <> \",\" <> TS.showt bField <> \",\" <> tField\n    , False )\n\nnewtype MyValue = MyValue { value :: Text }\n  deriving (Eq, Ord, Show)\n\ninstance ToJSON MyValue where\n  toJSON (MyValue value) = object [ \"value\" .= value ]\n\nmyDimensionPredicate :: Predicate\nmyDimensionPredicate (Token (CustomDimension (dim :: a)) dimData)\n  | Just Refl <- eqT @a @MyDimension, MyData{..} <- dimData =\n      iField == 42 && bField\nmyDimensionPredicate _ = False\n\nmyDimensionRule :: Rule\nmyDimensionRule = Rule\n  { name = \"my dimension (simple)\"\n  , pattern =\n    [ regex \"my dimension\"\n    ]\n  , prod = \\case\n      (_:_) -> Just . Token (CustomDimension MyDimension) $ MyData\n                 { iField = 42\n                 , bField = True\n                 , tField = \"hello world\"\n                 }\n      _ -> Nothing\n  }\n\nmyDimensionRule' :: Rule\nmyDimensionRule' = Rule\n  { name = \"my dimension (pattern match)\"\n  , pattern =\n    [ Predicate myDimensionPredicate\n    , regex \"pattern match\"\n    ]\n  , prod = \\case\n      ((Token (CustomDimension (dim :: a)) dimData):\n       Token RegexMatch (GroupMatch _):\n       _)\n        | Just Refl <- eqT @a @MyDimension, MyData{..} <- dimData ->\n            Just . Token (CustomDimension MyDimension) $ MyData\n              { iField = iField * 10\n              , bField = not bField\n              , tField = \"goodnight moon\"\n              }\n      _ -> Nothing\n  }\n\nmain :: IO ()\nmain = do\n  let en = makeLocale EN Nothing\n  debug en \"testing my dimension\" [Seal (CustomDimension MyDimension)] >>= print\n  debug en \"testing my dimension pattern match\" [Seal (CustomDimension MyDimension)] >>= print\n", "num_lines": 111}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# OPTIONS -fno-full-laziness #-}\n\nmodule Main (main) where\n\nimport Control.Monad\nimport System.Environment\n\nimport Duckling.Debug\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\n\nmain :: IO ()\nmain = do\n  (repeatCount :: Int) <- read . head <$> getArgs\n  void $ replicateM repeatCount $ void $ do\n    debug en \"Monday 3rd at 9.30am or 2.30pm, Saturday 8th at 10.30am, Tuesday 11th at 2pm, Wednesday 12th at 2.30pm, Friday 14th at 12.30pm xx\" [Seal Time]\n    debug es \"Horario es de Lunes a Viernes de 2 pm a 10 pm. S\\195\\161bado de 9 am a 7 pm\" [Seal Time]\n    where\n      en = makeLocale EN Nothing\n      es = makeLocale ES Nothing\n", "num_lines": 29}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# OPTIONS -fno-full-laziness #-}\n\nmodule Main (main) where\n\nimport Control.Monad\nimport System.Environment\n\nimport Duckling.Debug\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\n\nmain :: IO ()\nmain = do\n  (repeatCount :: Int) <- read . head <$> getArgs\n  void $ replicateM repeatCount $ void $ do\n    debug en \"My number is 123\" [Seal PhoneNumber,Seal Distance,Seal Numeral,Seal Email]\n    debug en \"Wednesday 5:00PM 3/29/2017\" [Seal Numeral,Seal Time]\n    debug zh \"12:30pm\" [Seal Time]\n    debug en \"tomorrow at 4pm\" [Seal Time]\n    debug en \"Tomorrow at 12.30?\" [Seal Time]\n    debug en \"Wednesday 9am\" [Seal Time]\n    debug en \"Sure do! Will 11:30 work?\" [Seal Time,Seal AmountOfMoney]\n    debug en \"8:00am\" [Seal Time]\n    where\n      en = makeLocale EN Nothing\n      zh = makeLocale ZH Nothing\n", "num_lines": 35}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n\nimport Control.Applicative hiding (empty)\nimport Control.Arrow ((***))\nimport Control.Exception (SomeException, catch)\nimport Control.Monad (unless, when)\nimport Control.Monad.IO.Class\nimport Data.Aeson\nimport Data.ByteString (ByteString, empty)\nimport Data.HashMap.Strict (HashMap)\nimport Data.Maybe\nimport Data.String\nimport Data.Text (Text)\nimport Data.Time.LocalTime.TimeZone.Series\nimport Prelude\nimport System.Directory\nimport System.Environment (lookupEnv)\nimport TextShow\nimport Text.Read (readMaybe)\nimport qualified Data.ByteString.Lazy as LBS\nimport qualified Data.ByteString.Lazy.Char8 as LBS8\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\nimport qualified Data.Text.Encoding as Text\n\nimport Data.Time.Clock.POSIX (posixSecondsToUTCTime)\nimport Snap.Core\nimport Snap.Http.Server\n\nimport Duckling.Core\nimport Duckling.Data.TimeZone\nimport Duckling.Dimensions (allDimensions)\nimport Duckling.Resolve (DucklingTime)\n\ncreateIfMissing :: FilePath -> IO ()\ncreateIfMissing f = do\n  exists <- doesFileExist f\n  unless exists $ writeFile f \"\"\n\nshouldLog :: Maybe ConfigLog -> Bool\nshouldLog Nothing = False\nshouldLog (Just ConfigNoLog) = False\nshouldLog _ = True\n\nsetupLogs :: Config a b -> IO ()\nsetupLogs conf = do\n  let shouldLogErrors = shouldLog $ getErrorLog conf\n  let shouldLogAccesses = shouldLog $ getAccessLog conf\n\n  when (shouldLogErrors || shouldLogAccesses) $ createDirectoryIfMissing False \"log\"\n  when shouldLogErrors $ createIfMissing \"log/error.log\"\n  when shouldLogAccesses $ createIfMissing \"log/access.log\"\n\nloadTZs :: IO (HashMap Text TimeZoneSeries)\nloadTZs = do\n  let defaultPath = \"/usr/share/zoneinfo/\"\n  let fallbackPath = \"/etc/zoneinfo/\"\n  loadTimeZoneSeries defaultPath `catch` (\\(_ :: SomeException) -> loadTimeZoneSeries fallbackPath)\n\nmain :: IO ()\nmain = do\n  tzs <- loadTZs\n  p <- lookupEnv \"PORT\"\n  conf <- commandLineConfig $\n    maybe defaultConfig (`setPort` defaultConfig) (readMaybe =<< p)\n  setupLogs conf\n  httpServe conf $\n    ifTop (writeBS \"quack!\") <|>\n    route\n      [ (\"targets\", method GET targetsHandler)\n      , (\"parse\", method POST $ parseHandler tzs)\n      ]\n\n-- | Return which languages have which dimensions\ntargetsHandler :: Snap ()\ntargetsHandler = do\n  modifyResponse $ setHeader \"Content-Type\" \"application/json\"\n  writeLBS $ encode $\n    HashMap.fromList $ map dimText $ HashMap.toList supportedDimensions\n  where\n    dimText :: (Lang, [Seal Dimension]) -> (Text, [Text])\n    dimText = (Text.toLower . showt) *** map (\\(Seal d) -> toName d)\n\n\n-- | Parse some text into the given dimensions\nparseHandler :: HashMap Text TimeZoneSeries -> Snap ()\nparseHandler tzs = do\n  modifyResponse $ setHeader \"Content-Type\" \"application/json\"\n  t <- getPostParam \"text\"\n  l <- getPostParam \"lang\"\n  ds <- getPostParam \"dims\"\n  tz <- getPostParam \"tz\"\n  loc <- getPostParam \"locale\"\n  ref <- getPostParam \"reftime\"\n  latent <- getPostParam \"latent\"\n\n  case t of\n    Nothing -> do\n      modifyResponse $ setResponseStatus 422 \"Bad Input\"\n      writeBS \"Need a 'text' parameter to parse\"\n    Just tx -> do\n      let timezone = parseTimeZone tz\n      now <- liftIO $ currentReftime tzs timezone\n\n      let\n        lang = parseLang l\n\n        context = Context\n          { referenceTime = maybe now (parseRefTime timezone) ref\n          , locale = maybe (makeLocale lang Nothing) parseLocale loc\n          }\n        options = Options {withLatent = parseLatent latent}\n\n        cleanupDims =\n            LBS8.filter (/= '\\\\') -- strip out escape chars people throw in\n          . stripSuffix \"\\\"\" -- remove trailing double quote\n          . stripPrefix \"\\\"\" -- remote leading double quote\n\n          where\n            stripSuffix suffix str = fromMaybe str $ LBS.stripSuffix suffix str\n            stripPrefix prefix str = fromMaybe str $ LBS.stripPrefix prefix str\n\n        dims = fromMaybe (allDimensions lang) $ do\n          queryDims <- fmap (cleanupDims . LBS.fromStrict) ds\n          txtDims <- decode @[Text] queryDims\n          pure $ mapMaybe parseDimension txtDims\n\n        parsedResult = parse (Text.decodeUtf8 tx) context options dims\n\n      writeLBS $ encode parsedResult\n  where\n    defaultLang = EN\n    defaultLocale = makeLocale defaultLang Nothing\n    defaultTimeZone = \"America/Los_Angeles\"\n    defaultLatent = False\n\n    parseDimension :: Text -> Maybe (Seal Dimension)\n    parseDimension x = fromName x <|> fromCustomName x\n      where\n        fromCustomName :: Text -> Maybe (Seal Dimension)\n        fromCustomName name = HashMap.lookup name m\n        m = HashMap.fromList\n          [ -- (\"my-dimension\", Seal (CustomDimension MyDimension))\n          ]\n\n    parseTimeZone :: Maybe ByteString -> Text\n    parseTimeZone = maybe defaultTimeZone Text.decodeUtf8\n\n    parseLocale :: ByteString -> Locale\n    parseLocale x = maybe defaultLocale (`makeLocale` mregion) mlang\n      where\n        (mlang, mregion) = case chunks of\n          [a, b] -> (readMaybe a :: Maybe Lang, readMaybe b :: Maybe Region)\n          _      -> (Nothing, Nothing)\n        chunks = map Text.unpack\n          $ Text.split (== '_') $ Text.toUpper $ Text.decodeUtf8 x\n\n    parseLang :: Maybe ByteString -> Lang\n    parseLang l = fromMaybe defaultLang $ l >>=\n      readMaybe . Text.unpack . Text.toUpper . Text.decodeUtf8\n\n    parseRefTime :: Text -> ByteString -> DucklingTime\n    parseRefTime timezone refTime = makeReftime tzs timezone utcTime\n      where\n        milliseconds = readMaybe $ Text.unpack $ Text.decodeUtf8 refTime\n        utcTime = case milliseconds of\n          Just msec -> posixSecondsToUTCTime $ fromInteger msec / 1000\n          Nothing -> error \"Please use milliseconds since epoch for reftime\"\n\n    parseLatent :: Maybe ByteString -> Bool\n    parseLatent x = fromMaybe defaultLatent\n      (readMaybe (Text.unpack $ Text.toTitle $ Text.decodeUtf8 $ fromMaybe empty x)::Maybe Bool)\n", "num_lines": 182}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nimport Prelude\nimport Duckling.Ranking.Generate\n\nmain :: IO ()\nmain = regenAllClassifiers\n", "num_lines": 13}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Data.TimeZone\n  ( loadTimeZoneSeries\n  ) where\n\nimport qualified Control.Exception as E\nimport Control.Monad.Extra\nimport Data.Either\nimport Data.HashMap.Strict (HashMap)\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.HashSet as HashSet\nimport Data.String\nimport qualified Data.Text as Text\nimport Data.Time (TimeZone(..))\nimport Data.Text (Text)\nimport Data.Time.LocalTime.TimeZone.Olson\nimport Data.Time.LocalTime.TimeZone.Series\nimport System.Directory\nimport System.FilePath.Posix\n\nimport Prelude\n\n-- | Reference implementation for pulling TimeZoneSeries data from local\n-- Olson files.\n-- Many linux distros have Olson data in \"/usr/share/zoneinfo/\"\nloadTimeZoneSeries :: FilePath -> IO (HashMap Text TimeZoneSeries)\nloadTimeZoneSeries base = do\n  files <- getFiles base\n  tzSeries <- mapM parseOlsonFile files\n  -- This data is large, will live a long time, and essentially be constant,\n  -- so it's a perfect candidate for compact regions\n  return $ HashMap.fromList $ rights tzSeries\n  where\n    -- Multiple versions of the data can exist. We intentionally ignore the\n    -- posix and right formats\n    ignored_dirs = HashSet.fromList $ map (base </>)\n      [ \"posix\", \"right\" ]\n\n    -- Recursively crawls a directory to list every file underneath it,\n    -- ignoring certain directories as needed\n    getFiles :: FilePath -> IO [FilePath]\n    getFiles dir = do\n      fsAll <- getDirectoryContents dir\n      let\n        fs = filter notDotFile fsAll\n        full_fs = map (dir </>) fs\n      (dirs, files) <- partitionM doesDirectoryExist full_fs\n\n      subdirs <- concatMapM getFiles\n        [ d | d <- dirs, not $ HashSet.member d ignored_dirs ]\n\n      return $ files ++ subdirs\n\n    -- Attempts to read a file in Olson format and returns its\n    -- canonical name (file path relative to the base) and the data\n    parseOlsonFile :: FilePath\n                   -> IO (Either E.ErrorCall (Text, TimeZoneSeries))\n    parseOlsonFile f = E.try $ do\n      r <- getTimeZoneSeriesFromOlsonFile f\n      return (Text.pack $ makeRelative base f, r)\n\n    notDotFile s = not $ elem s [\".\", \"..\"]\n", "num_lines": 71}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE RecordWildCards #-}\n\nmodule Duckling.Ranking.Generate\n  ( regenAllClassifiers\n  , regenClassifiers\n  , regenLangClassifiers\n  ) where\n\nimport Data.HashSet (HashSet)\nimport Language.Haskell.Exts as F\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.HashSet as HashSet\nimport qualified Data.Text as Text\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Ranking.Train\nimport Duckling.Ranking.Types\nimport Duckling.Rules\nimport Duckling.Testing.Types\nimport qualified Duckling.Region as R\nimport qualified Duckling.Time.AR.Corpus as ARTime\nimport qualified Duckling.Time.BG.Corpus as BGTime\nimport qualified Duckling.Time.CA.Corpus as CATime\nimport qualified Duckling.Time.DA.Corpus as DATime\nimport qualified Duckling.Time.DE.Corpus as DETime\nimport qualified Duckling.Time.EL.Corpus as ELTime\nimport qualified Duckling.Time.EN.Corpus as ENTime\nimport qualified Duckling.Time.EN.CA.Corpus as EN_CATime\nimport qualified Duckling.Time.EN.GB.Corpus as EN_GBTime\nimport qualified Duckling.Time.EN.US.Corpus as EN_USTime\nimport qualified Duckling.Time.ES.Corpus as ESTime\nimport qualified Duckling.Time.FR.Corpus as FRTime\nimport qualified Duckling.Time.GA.Corpus as GATime\nimport qualified Duckling.Time.HR.Corpus as HRTime\nimport qualified Duckling.Time.HE.Corpus as HETime\nimport qualified Duckling.Time.HU.Corpus as HUTime\nimport qualified Duckling.Time.IT.Corpus as ITTime\nimport qualified Duckling.Time.JA.Corpus as JATime\nimport qualified Duckling.Time.KO.Corpus as KOTime\nimport qualified Duckling.Time.NB.Corpus as NBTime\nimport qualified Duckling.Time.NL.Corpus as NLTime\nimport qualified Duckling.Time.NL.BE.Corpus as NL_BETime\nimport qualified Duckling.Time.PL.Corpus as PLTime\nimport qualified Duckling.Time.PT.Corpus as PTTime\nimport qualified Duckling.Time.RO.Corpus as ROTime\nimport qualified Duckling.Time.RU.Corpus as RUTime\nimport qualified Duckling.Time.SV.Corpus as SVTime\nimport qualified Duckling.Time.TR.Corpus as TRTime\nimport qualified Duckling.Time.UK.Corpus as UKTime\nimport qualified Duckling.Time.VI.Corpus as VITime\nimport qualified Duckling.Time.ZH.Corpus as ZHTime\nimport qualified Duckling.Time.ZH.CN.Corpus as ZH_CNTime\nimport qualified Duckling.Time.ZH.HK.Corpus as ZH_HKTime\nimport qualified Duckling.Time.ZH.MO.Corpus as ZH_MOTime\nimport qualified Duckling.Time.ZH.TW.Corpus as ZH_TWTime\n\n-- -----------------------------------------------------------------\n-- Main\n\nregenAllClassifiers :: IO ()\nregenAllClassifiers = do\n  -- Regen default classifiers for langs\n  mapM_ (regenClassifiers . defaultLocale) [minBound .. maxBound]\n  -- Regen classifiers for locales\n  mapM_ regenClassifiers locales\n  where\n    defaultLocale :: Lang -> Locale\n    defaultLocale lang = makeLocale lang Nothing\n    f :: [Locale] -> Lang -> HashSet Region -> [Locale]\n    f res lang countries =\n      res ++ [makeLocale lang (Just c) | c <- HashSet.toList countries]\n    locales = HashMap.foldlWithKey' f [] allLocales\n\nregenLangClassifiers :: Lang -> IO ()\nregenLangClassifiers lang = do\n  regenClassifiers $ makeLocale lang Nothing\n  mapM_ (regenClassifiers . makeLocale lang . Just)\n    $ HashMap.lookupDefault HashSet.empty lang allLocales\n\n-- | Run this function to overwrite the file with Classifiers data\nregenClassifiers :: Locale -> IO ()\nregenClassifiers locale = do\n  putStrLn $ \"Regenerating \" ++ filepath ++ \"...\"\n  writeFile filepath $\n    (headerComment ++) $\n    prettyPrintWithMode baseMode $ (noLoc <$) m\n  putStrLn \"Done!\"\n  where\n    moduleName = show locale\n\n    filepath = \"Duckling/Ranking/Classifiers/\" ++ moduleName ++ \".hs\"\n\n    rules = rulesFor locale . HashSet.singleton $ Seal Time\n\n    -- | The trained classifier to write out\n    classifiers = makeClassifiers rules trainSet\n\n    -- | The training set (corpus)\n    trainSet = getCorpus locale\n\n    -- Data structure for the module\n    m = Module () (Just header) pragmas imports decls\n\n    -- Declares the top level options pragma\n    pragmas = [ LanguagePragma () [Ident () \"OverloadedStrings\"] ]\n\n    -- Declares the header for the module\n    -- \"module Duckling.Ranking.Classifiers (classifiers) where\"\n    header = ModuleHead ()\n      (ModuleName () $ \"Duckling.Ranking.Classifiers.\" ++ moduleName)\n      Nothing $\n      Just $ ExportSpecList ()\n       [ EVar () (unQual \"classifiers\")\n       ]\n\n    -- All imports the file will need\n    imports =\n      [ genImportModule \"Data.String\"\n      , genImportModule \"Prelude\"\n      , (genImportModule \"Data.HashMap.Strict\")\n        { importQualified = True\n        , importAs = Just (ModuleName () \"HashMap\")\n        }\n      , genImportModule \"Duckling.Ranking.Types\"\n      ]\n\n    -- The code body\n    decls =\n      [ -- Type Signature\n        TypeSig () [Ident () \"classifiers\"] (TyCon () (unQual \"Classifiers\"))\n        -- function body\n      , FunBind ()\n          [ Match () (Ident () \"classifiers\") []\n              (UnGuardedRhs () (genList classifiers)) Nothing\n          ]\n      ]\n\n    headerComment :: String\n    headerComment = \"\\\n\\-- Copyright (c) 2016-present, Facebook, Inc.\\n\\\n\\-- All rights reserved.\\n\\\n\\--\\n\\\n\\-- This source code is licensed under the BSD-style license found in the\\n\\\n\\-- LICENSE file in the root directory of this source tree. An additional grant\\n\\\n\\-- of patent rights can be found in the PATENTS file in the same directory.\\n\\n\\\n\\-----------------------------------------------------------------\\n\\\n\\-- Auto-generated by regenClassifiers\\n\\\n\\--\\n\\\n\\-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\\n\\\n\\--  @\" ++ \"generated\\n\\\n\\-----------------------------------------------------------------\\n\"\n\n-- | Retrieves the corpus for the locale.\n-- The corpus is all the language examples + all the locale examples, if any.\n-- Locales don't provide a corpus as contexts need to agree.\ngetCorpus :: Locale -> Corpus\ngetCorpus (Locale lang Nothing) = getDefaultCorpusForLang lang\ngetCorpus locale@(Locale lang (Just region)) =\n  withLocale (getCorpusForLang lang) locale $ getExamplesForLocale lang region\n\n-- | For backward compatibility.\ngetDefaultCorpusForLang :: Lang -> Corpus\ngetDefaultCorpusForLang = \\case\n  EN -> ENTime.defaultCorpus\n  NL -> NLTime.defaultCorpus\n  lang -> getCorpusForLang lang\n\ngetCorpusForLang :: Lang -> Corpus\ngetCorpusForLang = \\case\n  AF -> (testContext, testOptions, [])\n  AR -> ARTime.corpus\n  BG -> BGTime.corpus\n  BN -> (testContext, testOptions, [])\n  CA -> CATime.corpus\n  CS -> (testContext, testOptions, [])\n  DA -> DATime.corpus\n  DE -> DETime.corpus\n  EL -> ELTime.corpus\n  EN -> ENTime.corpus\n  ES -> ESTime.corpus\n  ET -> (testContext, testOptions, [])\n  FI -> (testContext, testOptions, [])\n  FA -> (testContext, testOptions, [])\n  FR -> FRTime.corpus\n  GA -> GATime.corpus\n  HR -> HRTime.corpus\n  HE -> HETime.corpus\n  HU -> HUTime.corpus\n  HI -> (testContext, testOptions, [])\n  ID -> (testContext, testOptions, [])\n  IS -> (testContext, testOptions, [])\n  IT -> ITTime.corpus\n  JA -> JATime.corpus\n  KA -> (testContext, testOptions, [])\n  KM -> (testContext, testOptions, [])\n  KN -> (testContext, testOptions, [])\n  KO -> KOTime.corpus\n  LO -> (testContext, testOptions, [])\n  ML -> (testContext, testOptions, [])\n  MN -> (testContext, testOptions, [])\n  MY -> (testContext, testOptions, [])\n  NB -> NBTime.corpus\n  NE -> (testContext, testOptions, [])\n  NL -> NLTime.corpus\n  PL -> PLTime.corpus\n  PT -> PTTime.corpus\n  RO -> ROTime.corpus\n  RU -> RUTime.corpus\n  SK -> (testContext, testOptions, [])\n  SV -> SVTime.corpus\n  SW -> (testContext, testOptions, [])\n  TA -> (testContext, testOptions, [])\n  TE -> (testContext, testOptions, [])\n  TH -> (testContext, testOptions, [])\n  TR -> TRTime.corpus\n  UK -> UKTime.corpus\n  VI -> VITime.corpus\n  ZH -> ZHTime.corpus\n\ngetExamplesForLocale :: Lang -> Region -> [Example]\ngetExamplesForLocale EN R.CA = EN_CATime.allExamples\ngetExamplesForLocale EN GB = EN_GBTime.allExamples\ngetExamplesForLocale EN US = EN_USTime.allExamples\ngetExamplesForLocale NL BE = NL_BETime.allExamples\ngetExamplesForLocale ZH CN = ZH_CNTime.allExamples\ngetExamplesForLocale ZH HK = ZH_HKTime.allExamples\ngetExamplesForLocale ZH MO = ZH_MOTime.allExamples\ngetExamplesForLocale ZH TW = ZH_TWTime.allExamples\ngetExamplesForLocale _ _   = []\n\n-- -----------------------------------------------------------------\n-- Source generators\n\n-- | Generates a line for an import\n--\n-- `genImportModule \"Foo.Bar\"` spits out:\n-- \"import Foo.Bar\" in the code\ngenImportModule :: String -> ImportDecl ()\ngenImportModule name = ImportDecl\n  { importAnn = ()\n  , importModule = ModuleName () name\n  , importQualified = False\n  , importSrc = False\n  , importSafe = False\n  , importPkg = Nothing\n  , importAs = Nothing\n  , importSpecs = Nothing\n  }\n\n-- | Creates the expression to build the HashMap object\ngenList :: Classifiers -> Exp ()\ngenList cs = appFromList $ map genClassifier $ HashMap.toList cs\n  where\n    -- \"fromList ...\"\n    appFromList exprs = App ()\n      (Var () (Qual () (ModuleName () \"HashMap\") (Ident () \"fromList\")))\n      (List () exprs)\n\n    -- (\"name\", Classifier { okData ....\n    genClassifier (name, Classifier{..}) =\n      let uname = Text.unpack name in\n      Tuple () Boxed\n        [ Lit () $ F.String () uname uname\n        , RecConstr () (unQual \"Classifier\")\n            [ genClassData okData \"okData\"\n            , genClassData koData \"koData\"\n            ]\n        ]\n\n    -- ClassData { prior = -0.123, unseen = ...\n    genClassData ClassData{..} name = FieldUpdate () (unQual name) $\n      RecConstr () (unQual \"ClassData\")\n        [ FieldUpdate () (unQual \"prior\") $ floatSym prior\n        , FieldUpdate () (unQual \"unseen\") $ floatSym unseen\n        , FieldUpdate () (unQual \"likelihoods\") $\n            appFromList $ map genLikelihood $ HashMap.toList likelihoods\n        , FieldUpdate () (unQual \"n\") $\n            Lit () (Int () (fromIntegral n) (show n))\n        ]\n\n    -- (\"feature\", 0.0)\n    genLikelihood (f, d) =\n      let uf = Text.unpack f in\n      Tuple () Boxed\n        [ Lit () $ F.String () uf uf\n        , floatSym d\n        ]\n\n-- Helper to print out doubles\nfloatSym :: Double -> Exp ()\nfloatSym val\n  | isInfinite val = if val < 0\n      then NegApp () inf\n      else inf\n  | otherwise = Lit () (Frac () (realToFrac val) $ show val)\n  where\n    inf = Var () $ unQual \"infinity\"\n\n-- Helper for unqualified things\nunQual :: String -> QName ()\nunQual name = UnQual () (Ident () name)\n\n\n-- -----------------------------------------------------------------\n-- Printing helpers\n\nbaseMode :: PPHsMode\nbaseMode = PPHsMode\n  { classIndent   = 2\n  , doIndent      = 3\n  , multiIfIndent = 3\n  , caseIndent    = 2\n  , letIndent     = 2\n  , whereIndent   = 2\n  , onsideIndent  = 2\n  , spacing       = True\n  , layout        = PPOffsideRule\n  , linePragmas   = False\n  }\n", "num_lines": 330}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE RecordWildCards #-}\n\nmodule Duckling.Ranking.Train\n  ( makeClassifiers\n  ) where\n\nimport Data.HashSet (HashSet)\nimport Prelude\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.HashSet as HashSet\nimport qualified Data.List as List\n\nimport Duckling.Engine\nimport Duckling.Ranking.Extraction\nimport Duckling.Ranking.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.Types\n\n-- -----------------------------------------------------------------\n-- Probabilistic layer\n-- Naive Bayes classifier with Laplace smoothing\n-- Train one classifier per rule, based on the test corpus.\n\nmakeClassifiers :: [Rule] -> Corpus -> Classifiers\nmakeClassifiers rules corpus = HashMap.map train $ makeDataset rules corpus\n\n-- | Train a classifier for a single rule\ntrain :: [Datum] -> Classifier\ntrain datums = Classifier {okData = okClass, koData = koClass}\n  where\n    total = List.length datums\n    (ok, ko) = List.partition snd datums\n    merge :: [BagOfFeatures] -> BagOfFeatures -> BagOfFeatures\n    merge xs m = List.foldl' (HashMap.unionWith (+)) m xs\n    okCounts = merge (map fst ok) HashMap.empty\n    koCounts = merge (map fst ko) HashMap.empty\n    vocSize = HashMap.size $ HashMap.union okCounts koCounts\n    okClass = makeClass okCounts total (List.length ok) vocSize\n    koClass = makeClass koCounts total (List.length ko) vocSize\n\n-- | Compute prior and likelihoods log-probabilities for one class.\nmakeClass :: BagOfFeatures -> Int -> Int -> Int -> ClassData\nmakeClass feats total classTotal vocSize = ClassData\n  { prior = prior\n  , unseen = unseen\n  , likelihoods = likelihoods\n  , n = classTotal\n  }\n  where\n    prior = log $ fromIntegral classTotal / fromIntegral total\n    denum = vocSize + sum (HashMap.elems feats)\n    unseen = log $ 1.0 / (fromIntegral denum + 1.0)\n    likelihoods = HashMap.map (\\x ->\n      log $ (fromIntegral x + 1.0) / fromIntegral denum\n      ) feats\n\n-- | Augment the dataset with one example.\n-- | Add all the nodes contributing to the resolutions of the input sentence.\n-- | Classes:\n-- | 1) True (node contributed to a token passing test predicate)\n-- | 2) False (node didn't contribute to any passing tokens)\nmakeDataset1 :: [Rule] -> Context -> Options -> Dataset -> Example -> Dataset\nmakeDataset1 rules context options dataset (sentence, predicate) = dataset'\n  where\n    tokens = parseAndResolve rules sentence context options\n    (ok, ko) = List.partition (predicate context) tokens\n    subnodes :: Node -> HashSet Node\n    subnodes node@(Node{..}) = case children of\n      [] -> HashSet.empty\n      cs -> HashSet.unions $ HashSet.singleton node:map subnodes cs\n    nodesOK = HashSet.unions $ map (subnodes . node) ok\n    nodesKO = HashSet.difference\n      (HashSet.unions $ map (subnodes . node) ko) nodesOK\n    updateDataset :: Class -> HashSet Node -> Dataset -> Dataset\n    updateDataset klass nodes dataset =\n      HashSet.foldl' (\\dataset node@Node {..} ->\n        case rule of\n          Just rule -> HashMap.insertWith (++) rule\n            [(extractFeatures node, klass)] dataset\n          Nothing -> dataset\n        ) dataset nodes\n    dataset' = updateDataset False nodesKO $ updateDataset True nodesOK dataset\n\n-- | Build a dataset (rule name -> datums)\nmakeDataset :: [Rule] -> Corpus -> Dataset\nmakeDataset rules (context, options, examples) =\n   List.foldl' (makeDataset1 rules context options) HashMap.empty examples\n", "num_lines": 96}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Main where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Tests\nimport Prelude\n\nmain :: IO ()\nmain = defaultMain tests\n", "num_lines": 17}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NoRebindableSyntax #-}\n\nmodule Duckling.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport qualified Duckling.Api.Tests as Api\nimport qualified Duckling.Dimensions.Tests as Dimensions\nimport qualified Duckling.Engine.Tests as Engine\n\ntests :: TestTree\ntests = testGroup \"Duckling Tests\"\n  [ Api.tests\n  , Dimensions.tests\n  , Engine.tests\n  ]\n", "num_lines": 28}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport qualified Duckling.AmountOfMoney.AR.Tests as AR\nimport qualified Duckling.AmountOfMoney.CA.Tests as CA\nimport qualified Duckling.AmountOfMoney.EN.Tests as EN\nimport qualified Duckling.AmountOfMoney.BG.Tests as BG\nimport qualified Duckling.AmountOfMoney.ES.Tests as ES\nimport qualified Duckling.AmountOfMoney.FR.Tests as FR\nimport qualified Duckling.AmountOfMoney.GA.Tests as GA\nimport qualified Duckling.AmountOfMoney.HE.Tests as HE\nimport qualified Duckling.AmountOfMoney.HR.Tests as HR\nimport qualified Duckling.AmountOfMoney.ID.Tests as ID\nimport qualified Duckling.AmountOfMoney.IT.Tests as IT\nimport qualified Duckling.AmountOfMoney.KA.Tests as KA\nimport qualified Duckling.AmountOfMoney.KO.Tests as KO\nimport qualified Duckling.AmountOfMoney.MN.Tests as MN\nimport qualified Duckling.AmountOfMoney.NB.Tests as NB\nimport qualified Duckling.AmountOfMoney.NL.Tests as NL\nimport qualified Duckling.AmountOfMoney.PT.Tests as PT\nimport qualified Duckling.AmountOfMoney.RO.Tests as RO\nimport qualified Duckling.AmountOfMoney.RU.Tests as RU\nimport qualified Duckling.AmountOfMoney.SV.Tests as SV\nimport qualified Duckling.AmountOfMoney.TR.Tests as TR\nimport qualified Duckling.AmountOfMoney.VI.Tests as VI\nimport qualified Duckling.AmountOfMoney.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"AmountOfMoney Tests\"\n  [ AR.tests\n  , BG.tests\n  , CA.tests\n  , EN.tests\n  , ES.tests\n  , FR.tests\n  , GA.tests\n  , HE.tests\n  , HR.tests\n  , ID.tests\n  , IT.tests\n  , KA.tests\n  , KO.tests\n  , MN.tests\n  , NB.tests\n  , NL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , SV.tests\n  , TR.tests\n  , VI.tests\n  , ZH.tests\n  ]\n", "num_lines": 66}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.AR.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.AR.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.BG.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.BG.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"BG Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.CA.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.EN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.AmountOfMoney.EN.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types (testContext, testOptions, withLocale)\nimport Duckling.Types (Range(..))\nimport qualified Duckling.AmountOfMoney.EN.AU.Corpus as AU\nimport qualified Duckling.AmountOfMoney.EN.BZ.Corpus as BZ\nimport qualified Duckling.AmountOfMoney.EN.CA.Corpus as CA\nimport qualified Duckling.AmountOfMoney.EN.GB.Corpus as GB\nimport qualified Duckling.AmountOfMoney.EN.IN.Corpus as IN\nimport qualified Duckling.AmountOfMoney.EN.IE.Corpus as IE\nimport qualified Duckling.AmountOfMoney.EN.JM.Corpus as JM\nimport qualified Duckling.AmountOfMoney.EN.NZ.Corpus as NZ\nimport qualified Duckling.AmountOfMoney.EN.PH.Corpus as PH\nimport qualified Duckling.AmountOfMoney.EN.TT.Corpus as TT\nimport qualified Duckling.AmountOfMoney.EN.US.Corpus as US\nimport qualified Duckling.AmountOfMoney.EN.ZA.Corpus as ZA\nimport qualified Duckling.Region as R\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  , makeNegativeCorpusTest [Seal AmountOfMoney] negativeCorpus\n  , localeTests\n  , intersectTests\n  , rangeTests\n  , latentTests\n  ]\n\nlocaleTests :: TestTree\nlocaleTests = testGroup \"Locale Tests\"\n  [ testGroup \"EN_AU Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeAU AU.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeAU AU.negativeExamples\n    ]\n   , testGroup \"EN_BZ Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeBZ BZ.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeBZ BZ.negativeExamples\n    ]\n   , testGroup \"EN_CA Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeCA CA.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeCA CA.negativeExamples\n    ]\n   , testGroup \"EN_GB Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeGB GB.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeGB GB.negativeExamples\n    ]\n   , testGroup \"EN_IE Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeIE IE.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeIE IE.negativeExamples\n    ]\n   , testGroup \"EN_IN Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeIN IN.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeIN IN.negativeExamples\n    ]\n   , testGroup \"EN_JM Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeJM JM.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeJM JM.negativeExamples\n    ]\n   , testGroup \"EN_NZ Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeNZ NZ.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeNZ NZ.negativeExamples\n    ]\n   , testGroup \"EN_PH Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localePH PH.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localePH PH.negativeExamples\n    ]\n    , testGroup \"EN_TT Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeTT TT.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeTT TT.negativeExamples\n    ]\n    , testGroup \"EN_US Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeUS US.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeUS US.negativeExamples\n    ]\n    , testGroup \"EN_ZA Tests\"\n    [ makeCorpusTest [Seal AmountOfMoney]\n      $ withLocale corpus localeZA ZA.allExamples\n    , makeNegativeCorpusTest [Seal AmountOfMoney]\n      $ withLocale negativeCorpus localeZA ZA.negativeExamples\n    ]\n  ]\n  where\n    localeAU = makeLocale EN $ Just AU\n    localeBZ = makeLocale EN $ Just BZ\n    localeCA = makeLocale EN $ Just R.CA\n    localeGB = makeLocale EN $ Just GB\n    localeIE = makeLocale EN $ Just IE\n    localeIN = makeLocale EN $ Just IN\n    localeJM = makeLocale EN $ Just JM\n    localeNZ = makeLocale EN $ Just NZ\n    localePH = makeLocale EN $ Just PH\n    localeTT = makeLocale EN $ Just TT\n    localeUS = makeLocale EN $ Just US\n    localeZA = makeLocale EN $ Just ZA\n\n\nintersectTests :: TestTree\nintersectTests = testCase \"Intersect Test\" $\n  mapM_ (analyzedNTest testContext testOptions . withTargets [Seal AmountOfMoney]) xs\n  where\n    xs = [ (\"7c7\", 2)\n         , (\"7c7c\", 3)\n         , (\"10 dollars 0.17\", 2)\n         , (\"1.1 dollars 6\", 2)\n         , (\"10 cents and 8 cents\", 2)\n         , (\"10 dollars and 2 dollars\", 2)\n         , (\"between 4.1 dollars and 4 dollars\", 3)\n         , (\"between 4 dollars and 7 euros\", 2)\n         ]\n\nrangeTests :: TestTree\nrangeTests = testCase \"Range Test\" $\n  mapM_ (analyzedRangeTest testContext testOptions . withTargets [Seal AmountOfMoney]) xs\n  where\n    xs = [ (\"between 3 and 1 dollars\", Range 14 23)\n         , (\"between 1 and between 2 and 3 dollars\", Range 14 37)\n         , (\"10 cents and 0.1\", Range 0 8)\n         , (\"Pay Kiran1 10eur\", Range 11 16)\n         ]\n\nlatentTests :: TestTree\nlatentTests = makeCorpusTest [Seal AmountOfMoney] latentCorpus\n", "num_lines": 163}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.ES.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.AmountOfMoney.ES.Corpus\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.FR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.FR.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.GA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.AmountOfMoney.GA.Corpus\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.HE.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.HE.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HE Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.AmountOfMoney.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.AmountOfMoney.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.ID.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.AmountOfMoney.ID.Corpus\n\ntests :: TestTree\ntests = testGroup \"ID Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.IT.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.IT.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.KA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.AmountOfMoney.KA.Corpus\n\ntests :: TestTree\ntests = testGroup \"KA Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.KO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.AmountOfMoney.KO.Corpus\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.MN.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.MN.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.NB.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.AmountOfMoney.NB.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NB Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.NL.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.NL.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.PT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.AmountOfMoney.PT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.RO.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.RO.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  , makeNegativeCorpusTest [Seal AmountOfMoney] negativeCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.RU.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.RU.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.SV.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.AmountOfMoney.SV.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"SV Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.TR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.TR.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.VI.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.AmountOfMoney.VI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"VI Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.AmountOfMoney.ZH.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.AmountOfMoney.ZH.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal AmountOfMoney] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE NoRebindableSyntax #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Api.Tests\n  ( tests\n  ) where\n\nimport Data.List (sortOn)\nimport Data.Text (Text)\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.HashSet as HashSet\n\nimport Duckling.Api\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\nimport Duckling.Types\nimport qualified Duckling.Numeral.Types as TNumeral\n\ntests :: TestTree\ntests = testGroup \"API Tests\"\n  [ parseTest\n  , rankTest\n  , rangeTest\n  , supportedDimensionsTest\n  ]\n\nparseTest :: TestTree\nparseTest = testCase \"Parse Test\" $\n  case parse sentence testContext testOptions [Seal Numeral] of\n    [] -> assertFailure \"empty result\"\n    (Entity dim body (RVal _ v) start end _ _:_) -> do\n      assertEqual \"dim\" \"number\" dim\n      assertEqual \"body\" \"42\" body\n      assertEqual \"value\" val (toJText v)\n      assertEqual \"start\" 4 start\n      assertEqual \"end\" 6 end\n  where\n    sentence = \"hey 42 there\"\n    val = toJText TNumeral.NumeralValue {TNumeral.vValue = 42.0}\n\nrankTest :: TestTree\nrankTest = testGroup \"Rank Tests\"\n  [ rankFilterTest\n  , rankOrderTest\n  ]\n\nrankFilterTest :: TestTree\nrankFilterTest = testCase \"Rank Filter Tests\" $ do\n  mapM_ check\n    [ ( \"in 2 minutes\"\n      , [Seal Numeral, Seal Duration, Seal Time]\n      , [Seal Time]\n      )\n    , ( \"in 2 minutes, about 42 degrees\"\n      , [Seal Numeral, Seal Temperature, Seal Time]\n      , [Seal Time, Seal Temperature]\n      )\n    , ( \"today works... and tomorrow at 9pm too\"\n      , [Seal Numeral, Seal Time]\n      , [Seal Time, Seal Time]\n      )\n    , ( \"between 9:30 and 11:00 on thursday or Saturday and Thanksgiving Day\"\n      , [Seal Numeral, Seal Time]\n      , [Seal Time, Seal Time, Seal Time]\n      )\n    , (\"the day after tomorrow 5pm\", [Seal Time], [Seal Time])\n    , (\"the day after tomorrow 5pm\", [Seal Time, Seal Numeral], [Seal Time])\n    , (\"the day after tomorrow 5pm\", [], [Seal Time])\n    ]\n  where\n    check :: (Text, [Seal Dimension], [Seal Dimension]) -> IO ()\n    check (sentence, targets, expected) =\n      let go = analyze sentence testContext testOptions $ HashSet.fromList targets\n          actual = flip map go $\n                     \\(Resolved{node=Node{token=Token d _}}) -> Seal d\n      in assertEqual (\"wrong winners for \" ++ show sentence) expected actual\n\nrankOrderTest :: TestTree\nrankOrderTest = testCase \"Rank Order Tests\" $ do\n  mapM_ check\n    [ (\"tomorrow at 5PM or 8PM\", [Seal Time])\n    , (\"321 12 3456 ... 7\", [Seal Numeral])\n    , (\"42 today 23 tomorrow\", [Seal Numeral, Seal Time])\n    ]\n  where\n    check (s, targets) =\n      let tokens = analyze s testContext testOptions $ HashSet.fromList targets\n        in assertEqual \"wrong ordering\" (sortOn range tokens) tokens\n\nrangeTest :: TestTree\nrangeTest = testCase \"Range Tests\" $ do\n  mapM_ (analyzedFirstTest testContext testOptions) xs\n  where\n    xs = map (\\(input, targets, range) -> (input, targets, f range))\n             [ ( \"order status 3233763377\", [Seal PhoneNumber], Range 13 23 )\n             , ( \"  3233763377  \"         , [Seal PhoneNumber], Range  2 12 )\n             , ( \" -3233763377\"           , [Seal PhoneNumber], Range  2 12 )\n             , ( \"  now\"                  , [Seal Time]       , Range  2  5 )\n             , ( \"   Monday  \"            , [Seal Time]       , Range  3  9 )\n             , ( \"  next   week \"         , [Seal Time]       , Range  2 13 )\n             , ( \"   42\\n\\n\"              , [Seal Numeral]    , Range  3  5 )\n             ]\n    f :: Range -> TestPredicate\n    f expected _ (Resolved {range = actual}) = expected == actual\n\nsupportedDimensionsTest :: TestTree\nsupportedDimensionsTest = testCase \"Supported Dimensions Test\" $ do\n  mapM_ check\n    [ ( AR\n      , [ Seal Email, Seal AmountOfMoney, Seal PhoneNumber, Seal Url\n        , Seal Duration, Seal Numeral, Seal Ordinal, Seal Time, Seal Volume\n        , Seal Temperature, Seal Quantity, Seal CreditCardNumber\n        ]\n      )\n    , ( PL\n      , [ Seal Email, Seal AmountOfMoney, Seal PhoneNumber, Seal Url\n        , Seal Duration, Seal Numeral, Seal Ordinal, Seal Time\n        , Seal CreditCardNumber\n        ]\n      )\n    ]\n  where\n    check :: (Lang, [Seal Dimension]) -> IO ()\n    check (l, expected) = case HashMap.lookup l supportedDimensions of\n      Nothing -> assertFailure $ \"no dimensions for \" ++ show l\n      Just actual ->\n        assertEqual (\"wrong dimensions for \" ++ show l)\n        (HashSet.fromList expected) (HashSet.fromList actual)\n", "num_lines": 141}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.CreditCardNumber.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.CreditCardNumber.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CreditCardNumber Tests\"\n  [ makeCorpusTest [Seal CreditCardNumber] corpus\n  , makeNegativeCorpusTest [Seal CreditCardNumber] negativeCorpus\n  ]\n", "num_lines": 26}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Dimensions.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport qualified Duckling.AmountOfMoney.Tests as AmountOfMoney\nimport qualified Duckling.CreditCardNumber.Tests as CreditCardNumber\nimport qualified Duckling.Distance.Tests as Distance\nimport qualified Duckling.Duration.Tests as Duration\nimport qualified Duckling.Email.Tests as Email\nimport qualified Duckling.Numeral.Tests as Numeral\nimport qualified Duckling.Ordinal.Tests as Ordinal\nimport qualified Duckling.PhoneNumber.Tests as PhoneNumber\nimport qualified Duckling.Quantity.Tests as Quantity\nimport qualified Duckling.Temperature.Tests as Temperature\nimport qualified Duckling.Time.Tests as Time\nimport qualified Duckling.Volume.Tests as Volume\nimport qualified Duckling.Url.Tests as Url\n\ntests :: TestTree\ntests = testGroup \"Dimensions Tests\"\n  [ AmountOfMoney.tests\n  , CreditCardNumber.tests\n  , Distance.tests\n  , Duration.tests\n  , Email.tests\n  , Numeral.tests\n  , Ordinal.tests\n  , PhoneNumber.tests\n  , Quantity.tests\n  , Temperature.tests\n  , Time.tests\n  , Volume.tests\n  , Url.tests\n  ]\n", "num_lines": 46}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport qualified Duckling.Distance.BG.Tests as BG\nimport qualified Duckling.Distance.CA.Tests as CA\nimport qualified Duckling.Distance.CS.Tests as CS\nimport qualified Duckling.Distance.DE.Tests as DE\nimport qualified Duckling.Distance.EN.Tests as EN\nimport qualified Duckling.Distance.ES.Tests as ES\nimport qualified Duckling.Distance.FR.Tests as FR\nimport qualified Duckling.Distance.GA.Tests as GA\nimport qualified Duckling.Distance.HR.Tests as HR\nimport qualified Duckling.Distance.IT.Tests as IT\nimport qualified Duckling.Distance.KM.Tests as KM\nimport qualified Duckling.Distance.KO.Tests as KO\nimport qualified Duckling.Distance.MN.Tests as MN\nimport qualified Duckling.Distance.NL.Tests as NL\nimport qualified Duckling.Distance.PT.Tests as PT\nimport qualified Duckling.Distance.RO.Tests as RO\nimport qualified Duckling.Distance.RU.Tests as RU\nimport qualified Duckling.Distance.TR.Tests as TR\nimport qualified Duckling.Distance.SV.Tests as SV\nimport qualified Duckling.Distance.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Distance Tests\"\n  [ BG.tests\n  , CA.tests\n  , CS.tests\n  , DE.tests\n  , EN.tests\n  , ES.tests\n  , FR.tests\n  , GA.tests\n  , HR.tests\n  , IT.tests\n  , KM.tests\n  , KO.tests\n  , MN.tests\n  , NL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , TR.tests\n  , SV.tests\n  , ZH.tests\n  ]\n", "num_lines": 60}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.BG.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.BG.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"BG Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Distance.CA.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.CS.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.CS.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CS Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.DE.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.DE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"DE Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.EN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.EN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.ES.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Distance.ES.Corpus\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.FR.Tests\n  ( tests ) where\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Distance.FR.Corpus\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.GA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.GA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Distance.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.IT.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.IT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.KM.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Distance.KM.Corpus\n\ntests :: TestTree\ntests = testGroup \"KM Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.KO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Distance.KO.Corpus\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.MN.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.MN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.NL.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Distance.NL.Corpus\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.PT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Distance.PT.Corpus\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.RO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Distance.RO.Corpus\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.RU.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.RU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.SV.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.SV.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"SV Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Distance.TR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Distance.TR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal Distance] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport qualified Duckling.Duration.AR.Tests as AR\nimport qualified Duckling.Duration.BG.Tests as BG\nimport qualified Duckling.Duration.CA.Tests as CA\nimport qualified Duckling.Duration.EL.Tests as EL\nimport qualified Duckling.Duration.EN.Tests as EN\nimport qualified Duckling.Duration.ES.Tests as ES\nimport qualified Duckling.Duration.FR.Tests as FR\nimport qualified Duckling.Duration.GA.Tests as GA\nimport qualified Duckling.Duration.HI.Tests as HI\nimport qualified Duckling.Duration.HU.Tests as HU\nimport qualified Duckling.Duration.JA.Tests as JA\nimport qualified Duckling.Duration.KA.Tests as KA\nimport qualified Duckling.Duration.KO.Tests as KO\nimport qualified Duckling.Duration.MN.Tests as MN\nimport qualified Duckling.Duration.NB.Tests as NB\nimport qualified Duckling.Duration.NL.Tests as NL\nimport qualified Duckling.Duration.PL.Tests as PL\nimport qualified Duckling.Duration.PT.Tests as PT\nimport qualified Duckling.Duration.RO.Tests as RO\nimport qualified Duckling.Duration.RU.Tests as RU\nimport qualified Duckling.Duration.SV.Tests as SV\nimport qualified Duckling.Duration.TR.Tests as TR\nimport qualified Duckling.Duration.UK.Tests as UK\nimport qualified Duckling.Duration.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Duration Tests\"\n  [ AR.tests\n  , BG.tests\n  , CA.tests\n  , EL.tests\n  , EN.tests\n  , ES.tests\n  , FR.tests\n  , GA.tests\n  , HI.tests\n  , HU.tests\n  , JA.tests\n  , KA.tests\n  , KO.tests\n  , MN.tests\n  , NB.tests\n  , NL.tests\n  , PL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , SV.tests\n  , TR.tests\n  , UK.tests\n  , ZH.tests\n  ]\n", "num_lines": 68}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.AR.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.AR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.BG.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.BG.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"BG Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Duration.CA.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.DE.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.DE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.EL.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.EL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"EL Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  , makeNegativeCorpusTest [Seal Duration] negativeCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.EN.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.EN.Corpus\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Types (Range(..))\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  , makeNegativeCorpusTest [Seal Duration] negativeCorpus\n  , rangeTests\n  ]\n\nrangeTests :: TestTree\nrangeTests = testCase \"Range Test\" $\n  mapM_ (analyzedRangeTest testContext testOptions . withTargets [Seal Duration]) xs\n  where\n    xs = [ (\"1 hour 111565513\", Range 0 6) -- ruleDurationHoursAndMinutes to accept valid minutes\n         ]\n", "num_lines": 36}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.ES.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.ES.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.FR.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.FR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  , makeNegativeCorpusTest [Seal Duration] negativeCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.GA.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.GA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.HI.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.HI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HI Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.HU.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.HU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HU Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.JA.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.JA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"JA Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  , makeNegativeCorpusTest [Seal Duration] negativeCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.KA.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.KA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KA Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.KO.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.KO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.MN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.MN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.NB.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.NB.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NB Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.NL.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.NL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  , makeNegativeCorpusTest [Seal Duration] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.PL.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.PL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PL Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.PT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.PT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.RO.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.RO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.RU.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.RU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.SV.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.SV.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"SV Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.TR.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.TR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.UK.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.UK.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"UK Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  , makeNegativeCorpusTest [Seal Duration] negativeCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Duration.ZH.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Duration.ZH.Corpus\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal Duration] corpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Email.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.Corpus\nimport Duckling.Testing.Asserts\nimport qualified Duckling.Email.DE.Tests as DE\nimport qualified Duckling.Email.EN.Tests as EN\nimport qualified Duckling.Email.FR.Tests as FR\nimport qualified Duckling.Email.IS.Tests as IS\nimport qualified Duckling.Email.IT.Tests as IT\n\ntests :: TestTree\ntests = testGroup \"Email Tests\"\n  [ makeCorpusTest [Seal Email] corpus\n  , makeNegativeCorpusTest [Seal Email] negativeCorpus\n  , DE.tests\n  , EN.tests\n  , FR.tests\n  , IS.tests\n  , IT.tests\n  ]\n", "num_lines": 35}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Email.DE.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.DE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"DE Tests\"\n  [ makeCorpusTest [Seal Email] corpus\n  , makeNegativeCorpusTest [Seal Email] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Email.EN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.EN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Email] corpus\n  , makeNegativeCorpusTest [Seal Email] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Email.FR.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.FR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Email] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Email.IS.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.IS.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IS Tests\"\n  [ makeCorpusTest [Seal Email] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Email.IT.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Email.IT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal Email] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Engine.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Engine\nimport Duckling.Locale (Lang(..))\nimport Duckling.Types\nimport Duckling.Regex.Types\n\ntests :: TestTree\ntests = testGroup \"Engine Tests\"\n  [ emptyRegexTest\n  , unicodeAndRegexTest\n  ]\n\nemptyRegexTest :: TestTree\nemptyRegexTest = testCase \"Empty Regex Test\" $\n  case regex \"()\" of\n    Regex regex -> assertEqual \"empty result\" [] $\n      runDuckling $ lookupRegexAnywhere \"hey\" EN regex\n    _ -> assertFailure \"expected a regex\"\n\nunicodeAndRegexTest :: TestTree\nunicodeAndRegexTest = testCase \"Unicode and Regex Test\" $\n  case regex \"\\\\$([0-9]*)\" of\n    Regex regex -> do --\n      assertEqual \"\" expected $\n        runDuckling $ lookupRegexAnywhere \"\\128526 $35\" EN regex\n    _ -> assertFailure \"expected a regex\"\n  where\n  expected =\n    [ Node\n      { nodeRange = Range 2 5\n      , token = Token RegexMatch (GroupMatch [\"35\"])\n      , children = []\n      , rule = Nothing\n      }\n    ]\n", "num_lines": 53}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.Tests (tests) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport qualified Duckling.Numeral.AF.Tests as AF\nimport qualified Duckling.Numeral.AR.Tests as AR\nimport qualified Duckling.Numeral.BG.Tests as BG\nimport qualified Duckling.Numeral.BN.Tests as BN\nimport qualified Duckling.Numeral.CA.Tests as CA\nimport qualified Duckling.Numeral.CS.Tests as CS\nimport qualified Duckling.Numeral.DA.Tests as DA\nimport qualified Duckling.Numeral.DE.Tests as DE\nimport qualified Duckling.Numeral.EL.Tests as EL\nimport qualified Duckling.Numeral.EN.Tests as EN\nimport qualified Duckling.Numeral.ES.Tests as ES\nimport qualified Duckling.Numeral.ET.Tests as ET\nimport qualified Duckling.Numeral.FI.Tests as FI\nimport qualified Duckling.Numeral.FA.Tests as FA\nimport qualified Duckling.Numeral.FR.Tests as FR\nimport qualified Duckling.Numeral.GA.Tests as GA\nimport qualified Duckling.Numeral.HE.Tests as HE\nimport qualified Duckling.Numeral.HI.Tests as HI\nimport qualified Duckling.Numeral.HR.Tests as HR\nimport qualified Duckling.Numeral.HU.Tests as HU\nimport qualified Duckling.Numeral.ID.Tests as ID\nimport qualified Duckling.Numeral.IS.Tests as IS\nimport qualified Duckling.Numeral.IT.Tests as IT\nimport qualified Duckling.Numeral.JA.Tests as JA\nimport qualified Duckling.Numeral.KA.Tests as KA\nimport qualified Duckling.Numeral.KM.Tests as KM\nimport qualified Duckling.Numeral.KN.Tests as KN\nimport qualified Duckling.Numeral.KO.Tests as KO\nimport qualified Duckling.Numeral.LO.Tests as LO\nimport qualified Duckling.Numeral.ML.Tests as ML\nimport qualified Duckling.Numeral.MN.Tests as MN\nimport qualified Duckling.Numeral.MY.Tests as MY\nimport qualified Duckling.Numeral.NB.Tests as NB\nimport qualified Duckling.Numeral.NE.Tests as NE\nimport qualified Duckling.Numeral.NL.Tests as NL\nimport qualified Duckling.Numeral.PL.Tests as PL\nimport qualified Duckling.Numeral.PT.Tests as PT\nimport qualified Duckling.Numeral.RO.Tests as RO\nimport qualified Duckling.Numeral.RU.Tests as RU\nimport qualified Duckling.Numeral.SK.Tests as SK\nimport qualified Duckling.Numeral.SV.Tests as SV\nimport qualified Duckling.Numeral.SW.Tests as SW\nimport qualified Duckling.Numeral.TA.Tests as TA\nimport qualified Duckling.Numeral.TE.Tests as TE\nimport qualified Duckling.Numeral.TH.Tests as TH\nimport qualified Duckling.Numeral.TR.Tests as TR\nimport qualified Duckling.Numeral.UK.Tests as UK\nimport qualified Duckling.Numeral.VI.Tests as VI\nimport qualified Duckling.Numeral.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Numeral Tests\"\n  [ AF.tests\n  , AR.tests\n  , BG.tests\n  , BN.tests\n  , CA.tests\n  , CS.tests\n  , DA.tests\n  , DE.tests\n  , EL.tests\n  , EN.tests\n  , ES.tests\n  , ET.tests\n  , FA.tests\n  , FR.tests\n  , FI.tests\n  , GA.tests\n  , HE.tests\n  , HI.tests\n  , HR.tests\n  , HU.tests\n  , ID.tests\n  , IS.tests\n  , IT.tests\n  , JA.tests\n  , KA.tests\n  , KM.tests\n  , KN.tests\n  , KO.tests\n  , LO.tests\n  , ML.tests\n  , MN.tests\n  , MY.tests\n  , NB.tests\n  , NE.tests\n  , NL.tests\n  , PL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , SK.tests\n  , SV.tests\n  , SW.tests\n  , TA.tests\n  , TE.tests\n  , TH.tests\n  , TR.tests\n  , UK.tests\n  , VI.tests\n  , ZH.tests\n  ]\n", "num_lines": 116}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.AF.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.AF.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"AF Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.AR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Numeral.AR.Corpus\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types hiding (examples)\nimport qualified Duckling.Numeral.AR.EG.Corpus as EG\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  , localeTests\n  ]\n\nlocaleTests :: TestTree\nlocaleTests = testGroup \"Locale Tests\"\n  [ testGroup \"AR_EG Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localeEG EG.allExamples\n    ]\n  ]\n  where\n    localeEG = makeLocale AR $ Just EG\n", "num_lines": 36}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.BG.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.BG.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"BG Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.BN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.BN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"BN Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.CA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.CS.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.CS.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CS Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.DA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.DA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"DA Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.DE.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.DE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"DE Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.EL.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.EL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"EL Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Numeral.EN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.EN.Corpus\nimport Duckling.Numeral.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\nimport Duckling.Types (Range(..))\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  , surroundTests\n  , intersectTests\n  , rangeTests\n  ]\n\nsurroundTests :: TestTree\nsurroundTests = testCase \"Surround Tests\" $\n  mapM_ (analyzedFirstTest testContext testOptions .\n    withTargets [Seal Numeral]) xs\n  where\n    xs = concat\n      [ examples (NumeralValue 3)\n                 [ \"3km\"\n                 ]\n      , examples (NumeralValue 100000)\n                 [ \"100k\u00e2\u201a\u00ac\"\n                 , \"100k\\x20ac\"\n                 ]\n      , examples (NumeralValue 10.99)\n                 [ \"10.99$\"\n                 ]\n      ]\n\nintersectTests :: TestTree\nintersectTests = testCase \"Intersect Test\" $\n  mapM_ (analyzedNTest testContext testOptions . withTargets [Seal Numeral]) xs\n  where\n    xs = [ (\"10 millions minus 10\", 2)\n         ]\n\nrangeTests :: TestTree\nrangeTests = testCase \"Range Test\" $\n  mapM_ (analyzedRangeTest testContext testOptions . withTargets [Seal Numeral]) xs\n  where\n    xs = [ (\"negative negative 5\", Range 9 19) -- prevent double negatives\n         , (\"negative-5\", Range 8 10) -- prevent double negatives\n         , (\"- -5\", Range 2 4) -- prevent clash with engine tokenizer\n         ]\n", "num_lines": 67}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.ES.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Numeral.ES.Corpus\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types hiding (examples)\nimport qualified Duckling.Numeral.ES.AR.Corpus as AR\nimport qualified Duckling.Numeral.ES.CL.Corpus as CL\nimport qualified Duckling.Numeral.ES.CO.Corpus as CO\nimport qualified Duckling.Numeral.ES.ES.Corpus as ES\nimport qualified Duckling.Numeral.ES.MX.Corpus as MX\nimport qualified Duckling.Numeral.ES.PE.Corpus as PE\nimport qualified Duckling.Numeral.ES.VE.Corpus as VE\nimport qualified Duckling.Region as R\n  ( Region\n      ( AR\n      , ES\n      )\n  )\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  , localeTests\n  ]\n\nlocaleTests :: TestTree\nlocaleTests = testGroup \"Locale Tests\"\n  [ testGroup \"ES_AR Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localeAR AR.allExamples\n    ]\n  , testGroup \"ES_CL Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localeCL CL.allExamples\n    ]\n  , testGroup \"ES_CO Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localeCO CO.allExamples\n    ]\n  , testGroup \"ES_ES Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localeES ES.allExamples\n    ]\n  , testGroup \"ES_MX Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localeMX MX.allExamples\n    ]\n  , testGroup \"ES_PE Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localePE PE.allExamples\n    ]\n  , testGroup \"ES_VE Tests\"\n    [ makeCorpusTest [Seal Numeral] $ withLocale corpus localeVE VE.allExamples\n    ]\n  ]\n  where\n    localeAR = makeLocale ES $ Just R.AR\n    localeCL = makeLocale ES $ Just CL\n    localeCO = makeLocale ES $ Just CO\n    localeES = makeLocale ES $ Just R.ES\n    localeMX = makeLocale ES $ Just MX\n    localePE = makeLocale ES $ Just PE\n    localeVE = makeLocale ES $ Just VE\n", "num_lines": 72}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.ET.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.ET.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ET Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.FA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.FA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FA Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.FI.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.FI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FI Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.FR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.FR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.GA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.GA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.HE.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.HE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HE Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.HI.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.HI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HI Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.HU.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.HU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HU Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.ID.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.ID.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ID Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.IS.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.IS.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IS Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.IT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.IT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.JA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.JA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"JA Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.KA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.KA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KA Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.KM.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.KM.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KM Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.KN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.KN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KN Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.KO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.KO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.LO.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.LO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"LO Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.ML.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.ML.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ML Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.MN.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.MN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.MY.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.MY.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MY Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.NB.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.NB.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NB Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.NE.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.NE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NE Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.NL.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.NL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.PL.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.PL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PL Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.PT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.PT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.RO.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Numeral.RO.Corpus\nimport Duckling.Resolve\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  , intersectTests\n  ]\n\nintersectTests :: TestTree\nintersectTests = testCase \"Intersect Test\" $\n  mapM_ (analyzedNTest context testOptions . withTargets [Seal Numeral])\n    [ (\"19 de milioane\", 2) -- make sure ruleMultiplyDe only takes >= 20\n    ]\n  where\n    context = testContext {locale = makeLocale RO Nothing}\n", "num_lines": 37}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.RU.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.RU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\n\nmodule Duckling.Numeral.SK.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.SK.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"SK Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.SV.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.SV.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"SV Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.SW.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.SW.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"SW Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.TA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.TA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TA Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.TE.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.TE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TE Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Numeral.TH.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.TH.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TH Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.TR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.TR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.UK.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.UK.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"UK Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.VI.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.VI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"VI Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Numeral.ZH.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Numeral.ZH.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal Numeral] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.Tests (tests) where\n\nimport Data.String\nimport Test.Tasty\n\nimport qualified Duckling.Ordinal.AR.Tests as AR\nimport qualified Duckling.Ordinal.BG.Tests as BG\nimport qualified Duckling.Ordinal.CA.Tests as CA\nimport qualified Duckling.Ordinal.DA.Tests as DA\nimport qualified Duckling.Ordinal.DE.Tests as DE\nimport qualified Duckling.Ordinal.EL.Tests as EL\nimport qualified Duckling.Ordinal.EN.Tests as EN\nimport qualified Duckling.Ordinal.ES.Tests as ES\nimport qualified Duckling.Ordinal.ET.Tests as ET\nimport qualified Duckling.Ordinal.FR.Tests as FR\nimport qualified Duckling.Ordinal.GA.Tests as GA\nimport qualified Duckling.Ordinal.HE.Tests as HE\nimport qualified Duckling.Ordinal.HI.Tests as HI\nimport qualified Duckling.Ordinal.HR.Tests as HR\nimport qualified Duckling.Ordinal.HU.Tests as HU\nimport qualified Duckling.Ordinal.ID.Tests as ID\nimport qualified Duckling.Ordinal.IT.Tests as IT\nimport qualified Duckling.Ordinal.JA.Tests as JA\nimport qualified Duckling.Ordinal.KA.Tests as KA\nimport qualified Duckling.Ordinal.KM.Tests as KM\nimport qualified Duckling.Ordinal.KO.Tests as KO\nimport qualified Duckling.Ordinal.MN.Tests as MN\nimport qualified Duckling.Ordinal.ML.Tests as ML\nimport qualified Duckling.Ordinal.NB.Tests as NB\nimport qualified Duckling.Ordinal.NL.Tests as NL\nimport qualified Duckling.Ordinal.PL.Tests as PL\nimport qualified Duckling.Ordinal.PT.Tests as PT\nimport qualified Duckling.Ordinal.RO.Tests as RO\nimport qualified Duckling.Ordinal.RU.Tests as RU\nimport qualified Duckling.Ordinal.SV.Tests as SV\nimport qualified Duckling.Ordinal.TA.Tests as TA\nimport qualified Duckling.Ordinal.TR.Tests as TR\nimport qualified Duckling.Ordinal.UK.Tests as UK\nimport qualified Duckling.Ordinal.VI.Tests as VI\nimport qualified Duckling.Ordinal.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Ordinal Tests\"\n  [ AR.tests\n  , BG.tests\n  , CA.tests\n  , DA.tests\n  , DE.tests\n  , EL.tests\n  , EN.tests\n  , ES.tests\n  , ET.tests\n  , FR.tests\n  , GA.tests\n  , HE.tests\n  , HI.tests\n  , HR.tests\n  , HU.tests\n  , ID.tests\n  , IT.tests\n  , JA.tests\n  , KA.tests\n  , KM.tests\n  , KO.tests\n  , MN.tests\n  , ML.tests\n  , NB.tests\n  , NL.tests\n  , PL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , SV.tests\n  , TA.tests\n  , TR.tests\n  , UK.tests\n  , VI.tests\n  , ZH.tests\n  ]\n", "num_lines": 87}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.AR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.AR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.BG.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.BG.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"BG Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.CA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.DA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.DA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"DA Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.DE.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.DE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"DE Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  , makeNegativeCorpusTest [Seal Ordinal] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.EL.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.EL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"EL Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.EN.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.EN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.ES.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.ES.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.ET.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.ET.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ET Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.FR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.FR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.GA.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.GA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Ordinal.HE.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.HE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HE Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.HI.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.HI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HI Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Ordinal.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.HU.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.HU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HU Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.ID.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.ID.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ID Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.IT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.IT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.JA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.JA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"JA Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.KA.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.KA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KA Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.KM.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.KM.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KM Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.KO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.KO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Ordinal.ML.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.ML.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ML Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.MN.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.MN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.NB.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.NB.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NB Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.NL.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.NL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.PL.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.PL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PL Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.PT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.PT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.RO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.RO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.RU.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.RU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.SV.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.SV.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"SV Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Ordinal.TA.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.TA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TA Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.TR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.TR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.UK.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.UK.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"UK Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Ordinal.VI.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.VI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"VI Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Ordinal.ZH.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Ordinal.ZH.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal Ordinal] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.PhoneNumber.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.PhoneNumber.Corpus\nimport Duckling.PhoneNumber.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\nimport qualified Duckling.PhoneNumber.AR.Tests as AR\nimport qualified Duckling.PhoneNumber.PT.Tests as PT\n\ntests :: TestTree\ntests = testGroup \"PhoneNumber Tests\"\n  [ makeCorpusTest [Seal PhoneNumber] corpus\n  , makeNegativeCorpusTest [Seal PhoneNumber] negativeCorpus\n  , surroundTests\n  , PT.tests\n  , AR.tests\n  ]\n\nsurroundTests :: TestTree\nsurroundTests = testCase \"Surround Tests\" $\n  mapM_ (analyzedFirstTest testContext testOptions .\n    withTargets [Seal PhoneNumber]) xs\n  where\n    xs = examples (PhoneNumberValue \"06354640807\")\n                  [ \"hey 06354640807\"\n                  , \"06354640807 hey\"\n                  , \"hey 06354640807 hey\"\n                  ]\n         ++ examples (PhoneNumberValue \"18998078030\")\n                     [ \"a 18998078030 b\"\n                     ]\n", "num_lines": 49}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.PhoneNumber.AR.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.PhoneNumber.AR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PhoneNumber Tests\"\n  [ makeCorpusTest [Seal PhoneNumber] corpus\n  , makeNegativeCorpusTest [Seal PhoneNumber] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.PhoneNumber.PT.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.PhoneNumber.PT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PhoneNumber Tests\"\n  [ makeCorpusTest [Seal PhoneNumber] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport qualified Duckling.Quantity.AR.Tests as AR\nimport qualified Duckling.Quantity.EN.Tests as EN\nimport qualified Duckling.Quantity.ES.Tests as ES\nimport qualified Duckling.Quantity.FR.Tests as FR\nimport qualified Duckling.Quantity.HR.Tests as HR\nimport qualified Duckling.Quantity.KM.Tests as KM\nimport qualified Duckling.Quantity.KO.Tests as KO\nimport qualified Duckling.Quantity.MN.Tests as MN\nimport qualified Duckling.Quantity.NL.Tests as NL\nimport qualified Duckling.Quantity.PT.Tests as PT\nimport qualified Duckling.Quantity.RO.Tests as RO\nimport qualified Duckling.Quantity.RU.Tests as RU\nimport qualified Duckling.Quantity.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Quantity Tests\"\n  [ AR.tests\n  , EN.tests\n  , ES.tests\n  , FR.tests\n  , HR.tests\n  , KM.tests\n  , KO.tests\n  , MN.tests\n  , NL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , ZH.tests\n  ]\n", "num_lines": 45}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.AR.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.AR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.EN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.EN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  , makeCorpusTest [Seal Quantity] latentCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.ES.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.ES.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.FR.Tests\n  ( tests ) where\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.FR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Quantity.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.KM.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.KM.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KM Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.KO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.KO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.MN.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.MN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.NL.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.NL.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.PT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.PT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.RO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.RO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.RU.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.RU.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Quantity.ZH.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Quantity.ZH.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal Quantity] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.Tests (tests) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport qualified Duckling.Temperature.AR.Tests as AR\nimport qualified Duckling.Temperature.CA.Tests as CA\nimport qualified Duckling.Temperature.EN.Tests as EN\nimport qualified Duckling.Temperature.ES.Tests as ES\nimport qualified Duckling.Temperature.FR.Tests as FR\nimport qualified Duckling.Temperature.GA.Tests as GA\nimport qualified Duckling.Temperature.HI.Tests as HI\nimport qualified Duckling.Temperature.HR.Tests as HR\nimport qualified Duckling.Temperature.IT.Tests as IT\nimport qualified Duckling.Temperature.JA.Tests as JA\nimport qualified Duckling.Temperature.KM.Tests as KM\nimport qualified Duckling.Temperature.KO.Tests as KO\nimport qualified Duckling.Temperature.MN.Tests as MN\nimport qualified Duckling.Temperature.PT.Tests as PT\nimport qualified Duckling.Temperature.RO.Tests as RO\nimport qualified Duckling.Temperature.TR.Tests as TR\nimport qualified Duckling.Temperature.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Temperature Tests\"\n  [ AR.tests\n  , CA.tests\n  , EN.tests\n  , ES.tests\n  , FR.tests\n  , GA.tests\n  , HI.tests\n  , HR.tests\n  , IT.tests\n  , JA.tests\n  , KM.tests\n  , KO.tests\n  , MN.tests\n  , PT.tests\n  , RO.tests\n  , TR.tests\n  , ZH.tests\n  ]\n", "num_lines": 52}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.AR.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.AR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Temperature.CA.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.EN.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.EN.Corpus\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types (testContext, testOptions)\nimport Duckling.Types (Range(..))\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  , rangeTests\n  ]\n\nrangeTests :: TestTree\nrangeTests = testCase \"Range Test\" $\n  mapM_ (analyzedRangeTest testContext testOptions\n          . withTargets [Seal Temperature]) xs\n  where\n    xs = [ (\"between 40 and 30 degrees\", Range 15 25 )\n         , (\"30 degrees degrees\", Range 0 10 )\n         ]\n", "num_lines": 37}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.ES.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.ES.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.FR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.FR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.GA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.GA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.HI.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.HI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HI Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Temperature.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Temperature.IT.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.IT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.JA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.JA.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"JA Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.KM.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.KM.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KM Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.KO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.KO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.MN.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.MN.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.PT.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.PT.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.RO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.RO.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.TR.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.TR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Temperature.ZH.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Temperature.ZH.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal Temperature] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE TupleSections #-}\n\nmodule Duckling.Testing.Asserts\n  ( analyzedTargetTest\n  , analyzedFirstTest\n  , analyzedAmbiguousTest\n  , analyzedNTest\n  , analyzedNothingTest\n  , analyzedRangeTest\n  , makeCorpusTest\n  , makeNegativeCorpusTest\n  , withTargets\n  ) where\n\nimport Data.List (partition)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\nimport qualified Data.HashSet as HashSet\nimport qualified Data.Text as Text\n\nimport Duckling.Api\nimport Duckling.Dimensions.Types\nimport Duckling.Resolve\nimport Duckling.Testing.Types\nimport Duckling.Types\n\nnewtype ExampleInput = ExampleInput Text\n\ninstance Show ExampleInput where\n  show (ExampleInput input) = \"\\\"\" ++ Text.unpack input ++ \"\\\"\"\n\nwithTargets :: [Seal Dimension] -> (Text, a) -> (Text, [Seal Dimension], a)\nwithTargets targets (input, expected) = (input, targets, expected)\n\nanalyzedTargetTest :: Context -> Options -> (Text, Seal Dimension) -> IO ()\nanalyzedTargetTest context options (input, target) =\n  assertBool msg $ all (== target) dimensions\n  where\n    msg = \"analyze \" ++ show (ExampleInput input, [target])\n          ++ \"dimensions = \" ++ show dimensions\n    dimensions = flip map (analyze input context options $ HashSet.singleton target) $\n      \\(Resolved{node=Node{token=Token dimension _}}) -> Seal dimension\n\nanalyzedFirstTest :: Context -> Options ->\n  (Text, [Seal Dimension], TestPredicate) -> IO ()\nanalyzedFirstTest context options (input, targets, predicate) =\n  case tokens of\n    [] -> assertFailure\n      (\"empty result on \" ++ show (ExampleInput input, targets))\n    (token:_) -> assertBool\n      (\"don't pass predicate on \" ++ show (ExampleInput input)) $\n      predicate context token\n    where\n      tokens = analyze input context options $ HashSet.fromList targets\n\nanalyzedAmbiguousTest :: Context -> Options ->\n  (Text, [Seal Dimension], [TestPredicate]) -> IO ()\nanalyzedAmbiguousTest context options (input, targets, predicates) =\n  case tokens of\n    [] -> assertFailure\n      (\"empty result on \" ++ show (ExampleInput input, targets))\n    _ -> assertBool (\"don't pass predicate on \" ++ show (ExampleInput input)) $\n      all (\\predicate -> any (predicate context) tokens) predicates\n    where\n      tokens = analyze input context options $ HashSet.fromList targets\n\nmakeCorpusTest :: [Seal Dimension] -> Corpus -> TestTree\nmakeCorpusTest targets (context, options, xs) = testCase \"Corpus Tests\" $\n  mapM_ check xs\n  where\n    dims = HashSet.fromList targets\n    check :: Example -> IO ()\n    check (input, predicate) =\n      let tokens = analyze input context options dims in\n      let inputRange = Range 0 $ Text.length input in\n      let (fullRangeTokens, restTokens) =\n            partition ((== inputRange) . range) tokens in\n      case fullRangeTokens of\n        [] -> case restTokens of\n          [] -> assertFailure $ \"empty result on \" ++ show (ExampleInput input)\n          (_:_:_) -> assertFailure $\n            show (length restTokens) ++\n            \" tokens found for \" ++\n            show (ExampleInput input)\n          _ -> assertFailure $ \"don't fully match \" ++ show (ExampleInput input)\n        [token] -> assertBool\n          (\"don't pass predicate on \" ++ show (ExampleInput input)) $\n          predicate context token\n        _ -> assertFailure $ show (length fullRangeTokens)\n          ++ \" different ambiguous parses on \" ++ show (ExampleInput input)\n\n\nmakeNegativeCorpusTest :: [Seal Dimension] -> NegativeCorpus -> TestTree\nmakeNegativeCorpusTest targets (context, options, xs) =\n  testCase \"Negative Corpus Tests\"\n  $ mapM_ (analyzedNothingTest context options . (, targets)) xs\n\nanalyzedRangeTest :: Context -> Options -> (Text, [Seal Dimension], Range)\n  -> IO ()\nanalyzedRangeTest context options  (input, targets, expRange) = case tokens of\n  [] -> assertFailure $ \"empty result on \" ++ show (ExampleInput input)\n  (_:_:_) -> assertFailure $\n    show (length tokens) ++ \" tokens found for \" ++ show (ExampleInput input)\n  (token:_) ->\n    assertEqual (\"wrong range for \" ++ show (ExampleInput input))\n    expRange (range token)\n  where\n    tokens = analyze input context options $ HashSet.fromList targets\n\nanalyzedNothingTest :: Context -> Options -> (Text, [Seal Dimension]) -> IO ()\nanalyzedNothingTest context options (input, targets) =\n  analyzedNTest context options (input, targets, 0)\n\nanalyzedNTest :: Context -> Options -> (Text, [Seal Dimension], Int) -> IO ()\nanalyzedNTest context options (input, targets, n) =\n  assertBool msg . (== n) $ length tokens\n  where\n    msg = \"analyze \" ++ show (ExampleInput input, targets)\n          ++ \"tokens= \" ++ show tokens\n    tokens = analyze input context options $ HashSet.fromList targets\n", "num_lines": 131}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.Tests (tests) where\n\nimport Data.Aeson\nimport Data.Aeson.Types ((.:), parseMaybe, withObject)\nimport Data.String\nimport Data.Text (Text)\nimport Data.Time\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\nimport Duckling.Time.Types\nimport Duckling.TimeGrain.Types\nimport qualified Duckling.Time.AR.Tests as AR\nimport qualified Duckling.Time.BG.Tests as BG\nimport qualified Duckling.Time.CA.Tests as CA\nimport qualified Duckling.Time.DA.Tests as DA\nimport qualified Duckling.Time.DE.Tests as DE\nimport qualified Duckling.Time.EN.Tests as EN\nimport qualified Duckling.Time.EL.Tests as EL\nimport qualified Duckling.Time.ES.Tests as ES\nimport qualified Duckling.Time.FR.Tests as FR\nimport qualified Duckling.Time.GA.Tests as GA\nimport qualified Duckling.Time.HR.Tests as HR\nimport qualified Duckling.Time.HE.Tests as HE\nimport qualified Duckling.Time.HU.Tests as HU\nimport qualified Duckling.Time.IT.Tests as IT\nimport qualified Duckling.Time.JA.Tests as JA\nimport qualified Duckling.Time.KA.Tests as KA\nimport qualified Duckling.Time.KO.Tests as KO\nimport qualified Duckling.Time.NB.Tests as NB\nimport qualified Duckling.Time.NL.Tests as NL\nimport qualified Duckling.Time.PL.Tests as PL\nimport qualified Duckling.Time.PT.Tests as PT\nimport qualified Duckling.Time.RO.Tests as RO\nimport qualified Duckling.Time.RU.Tests as RU\nimport qualified Duckling.Time.SV.Tests as SV\nimport qualified Duckling.Time.TR.Tests as TR\nimport qualified Duckling.Time.UK.Tests as UK\nimport qualified Duckling.Time.VI.Tests as VI\nimport qualified Duckling.Time.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Time Tests\"\n  [ AR.tests\n  , BG.tests\n  , CA.tests\n  , DA.tests\n  , DE.tests\n  , EL.tests\n  , EN.tests\n  , ES.tests\n  , FR.tests\n  , GA.tests\n  , HR.tests\n  , HE.tests\n  , HU.tests\n  , IT.tests\n  , JA.tests\n  , KA.tests\n  , KO.tests\n  , NB.tests\n  , NL.tests\n  , PL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , SV.tests\n  , TR.tests\n  , UK.tests\n  , VI.tests\n  , ZH.tests\n  , timeFormatTest\n  , timeIntersectTest\n  ]\n\ntimeFormatTest :: TestTree\ntimeFormatTest = testCase \"Format Test\" $\n  mapM_ (analyzedFirstTest testContext testOptions . withTargets [Seal Time]) xs\n  where\n    xs = examplesCustom (parserCheck expected parseValue) [\"now\"]\n    expected = \"2013-02-12T04:30:00.000-02:00\"\n\nparseValue :: Value -> Maybe Text\nparseValue = parseMaybe . withObject \"value object\" $ \\o -> o .: \"value\"\n\ntimeIntersectTest :: TestTree\ntimeIntersectTest = testCase \"Intersect Test\" $ mapM_ check\n  [ ((t01, t01), Just t01)\n  , ((t01, t12), Nothing)\n  , ((t12, t13), Just t12)\n  , ((t12, t34), Nothing)\n  , ((t13, t23), Just t23)\n  , ((t13, t24), Just t23)\n  , ((t0_, t0_), Just t0_)\n  , ((t0_, t1_), Nothing)\n  , ((t0_, t01), Just t01)\n  , ((t0_, t13), Nothing)\n  , ((t0_, t2_), Nothing)\n  , ((t0m, t13), Just t13)\n\n  , ((t12, t01), Nothing)\n  , ((t13, t12), Just t12)\n  , ((t34, t12), Nothing)\n  , ((t23, t13), Just t23)\n  , ((t24, t13), Just t23)\n  , ((t1_, t0_), Nothing)\n  , ((t01, t0_), Just t01)\n  , ((t13, t0_), Nothing)\n  , ((t2_, t0_), Nothing)\n  , ((t13, t0m), Just t13)\n\n  , ((t13, t2m), Just t23)\n  , ((t2m, t13), Just t23)\n  ]\n  where\n    check :: ((TimeObject, TimeObject), Maybe TimeObject) -> IO ()\n    check ((t1, t2), exp) =\n      assertEqual \"wrong intersect\" exp $ timeIntersect t1 t2\n    t0_ = TimeObject t0 Second Nothing\n    t0m = TimeObject t0 Minute Nothing\n    t01 = TimeObject t0 Second $ Just t1\n    t1_ = TimeObject t1 Second Nothing\n    t12 = TimeObject t1 Second $ Just t2\n    t13 = TimeObject t1 Second $ Just t3\n    t2_ = TimeObject t2 Second Nothing\n    t2m = TimeObject t2 Minute Nothing\n    t23 = TimeObject t2 Second $ Just t3\n    t24 = TimeObject t2 Second $ Just t4\n    t34 = TimeObject t3 Second $ Just t4\n    t0 = UTCTime day 0\n    t1 = UTCTime day 1\n    t2 = UTCTime day 2\n    t3 = UTCTime day 3\n    t4 = UTCTime day 4\n    day = fromGregorian 2017 2 8\n", "num_lines": 149}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.AR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.AR.Corpus\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Time.BG.Tests\n  ( tests\n  ) where\n\nimport Data.Aeson\nimport Data.Aeson.Types ((.:), parseMaybe, withObject)\nimport Data.String\nimport Data.Text (Text)\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.BG.Corpus\nimport Duckling.TimeGrain.Types (Grain(..))\nimport Duckling.Types (Range(..))\n\ntests :: TestTree\ntests = testGroup \"BG Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 36}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.CA.Corpus\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.DA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.DA.Corpus\n\ntests :: TestTree\ntests = testGroup \"DA Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.DE.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types (testContext, testOptions)\nimport Duckling.Time.DE.Corpus\nimport Duckling.Types (Range(..))\n\ntests :: TestTree\ntests = testGroup \"DE Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  , rangeTests\n  ]\n\nrangeTests :: TestTree\nrangeTests = testCase \"Range Test\" $\n  mapM_ (analyzedRangeTest (testContext{locale = makeLocale DE Nothing})\n         testOptions . withTargets [Seal Time]) xs\n  where\n    xs = [ (\"Wir treffen uns am 17 Uhr am KiLa.\", Range 16 25)\n         ]\n", "num_lines": 38}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.EL.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.EL.Corpus\n\ntests :: TestTree\ntests = testGroup \"EL Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TupleSections #-}\n\nmodule Duckling.Time.EN.Tests\n  ( tests\n  ) where\n\nimport Data.Aeson\nimport Data.Aeson.Types ((.:), parseMaybe, withObject)\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.EN.Corpus\nimport Duckling.TimeGrain.Types (Grain(..))\nimport Duckling.Types (Range(..))\nimport qualified Duckling.Region as R\nimport qualified Duckling.Time.EN.AU.Corpus as AU\nimport qualified Duckling.Time.EN.BZ.Corpus as BZ\nimport qualified Duckling.Time.EN.CA.Corpus as CA\nimport qualified Duckling.Time.EN.GB.Corpus as GB\nimport qualified Duckling.Time.EN.IE.Corpus as IE\nimport qualified Duckling.Time.EN.IN.Corpus as IN\nimport qualified Duckling.Time.EN.JM.Corpus as JM\nimport qualified Duckling.Time.EN.NZ.Corpus as NZ\nimport qualified Duckling.Time.EN.PH.Corpus as PH\nimport qualified Duckling.Time.EN.TT.Corpus as TT\nimport qualified Duckling.Time.EN.US.Corpus as US\nimport qualified Duckling.Time.EN.ZA.Corpus as ZA\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Time] defaultCorpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  , makeCorpusTest [Seal Time] diffCorpus\n  , exactSecondTests\n  , valuesTest\n  , intersectTests\n  , rangeTests\n  , localeTests\n  , makeCorpusTest [Seal Time] latentCorpus\n  ]\n\nlocaleTests :: TestTree\nlocaleTests = testGroup \"Locale Tests\"\n  [ testGroup \"EN_AU Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeAU AU.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeAU []\n    ]\n  , testGroup \"EN_BZ Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeBZ BZ.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeBZ []\n    ]\n  , testGroup \"EN_CA Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeCA CA.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeCA []\n    ]\n  , testGroup \"EN_GB Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeGB GB.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeGB []\n    ]\n  , testGroup \"EN_IE Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeIE IE.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeIE []\n    ]\n  , testGroup \"EN_IN Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeIN IN.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeIN []\n    ]\n  , testGroup \"EN_JM Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeJM JM.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeJM []\n    ]\n  , testGroup \"EN_NZ Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeNZ NZ.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeNZ []\n    ]\n  , testGroup \"EN_PH Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localePH PH.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localePH []\n    ]\n  , testGroup \"EN_TT Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeTT TT.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeTT []\n    ]\n  , testGroup \"EN_US Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeUS US.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeUS []\n    ]\n  , testGroup \"EN_ZA Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeZA ZA.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeZA []\n    ]\n  ]\n  where\n    localeAU = makeLocale EN $ Just AU\n    localeBZ = makeLocale EN $ Just BZ\n    localeCA = makeLocale EN $ Just R.CA\n    localeGB = makeLocale EN $ Just GB\n    localeIE = makeLocale EN $ Just IE\n    localeIN = makeLocale EN $ Just IN\n    localeJM = makeLocale EN $ Just JM\n    localeNZ = makeLocale EN $ Just NZ\n    localePH = makeLocale EN $ Just PH\n    localeTT = makeLocale EN $ Just TT\n    localeUS = makeLocale EN $ Just US\n    localeZA = makeLocale EN $ Just ZA\n\nexactSecondTests :: TestTree\nexactSecondTests = testCase \"Exact Second Tests\" $\n  mapM_ (analyzedFirstTest context testOptions . withTargets [Seal Time]) xs\n  where\n    context = testContext {referenceTime = refTime (2016, 12, 6, 13, 21, 42) 1}\n    xs = concat\n      [ examples (datetime (2016, 12, 6, 13, 21, 45) Second)\n                 [ \"in 3 seconds\"\n                 ]\n      , examples (datetime (2016, 12, 6, 13, 31, 42) Second)\n                 [ \"in ten minutes\"\n                 ]\n      , examples (datetimeInterval\n          ((2016, 12, 6, 13, 21, 42), (2016, 12, 12, 0, 0, 0)) Second)\n                 [ \"by next week\"\n                 , \"by Monday\"\n                 ]\n      ]\n\nvaluesTest :: TestTree\nvaluesTest = testCase \"Values Test\" $\n  mapM_ (analyzedFirstTest testContext testOptions . withTargets [Seal Time]) xs\n  where\n    xs = examplesCustom (parserCheck 1 parseValuesSize)\n                        [ \"now\"\n                        , \"8 o'clock tonight\"\n                        , \"yesterday\"\n                        ]\n    parseValuesSize :: Value -> Maybe Int\n    parseValuesSize x = length <$> parseValues x\n    parseValues :: Value -> Maybe [Object]\n    parseValues = parseMaybe $ withObject \"value object\" (.: \"values\")\n\nintersectTests :: TestTree\nintersectTests = testCase \"Intersect Test\" $\n  mapM_ (analyzedNTest testContext testOptions . withTargets [Seal Time]) xs\n  where\n    xs = [ (\"tomorrow July\", 2)\n         , (\"Mar tonight\", 2)\n         , (\"Feb tomorrow\", 1) -- we are in February\n         ]\n\nrangeTests :: TestTree\nrangeTests = testCase \"Range Test\" $\n  mapM_ (analyzedRangeTest testContext testOptions . withTargets [Seal Time]) xs\n  where\n    xs = [ (\"at 615.\", Range 0 6) -- make sure ruleHHMMLatent allows this\n         , (\"last in 2'\", Range 5 10) -- ruleLastTime too eager\n         , (\"this in 2'\", Range 5 10) -- ruleThisTime too eager\n         , (\"next in 2'\", Range 5 10) -- ruleNextTime too eager\n         , (\"this this week\", Range 5 14) -- ruleThisTime too eager\n         , (\"one ninety nine a m\", Range 11 19) -- ruleMilitarySpelledOutAMPM2\n         , (\"thirteen fifty nine a m\", Range 15 23) -- ruleMilitarySpelledOutAMPM\n         , (\"table Wednesday for 30 people\", Range 6 15)\n           -- do not parse \"for 30\" as year intersect\n         , (\"house 1 on december 2013\", Range 11 24) -- ruleAbsorbOnDay\n         , (\"at 6pm GMT PDT\", Range 0 10) -- ruleTimezone\n         , (\"at 6pm (PDT) GMT\", Range 0 12) -- ruleTimezoneBracket\n         , (\"6pm GMT - 8pm GMT PDT\", Range 0 17)\n           -- ruleTimezone will not match because TimeData hasTimezone.\n         , (\"Monday - 1\", Range 0 6) -- ruleYearLatent to not accept negative years.\n         ]\n", "num_lines": 185}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.ES.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.ES.Corpus\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n    , makeCorpusTest [Seal Time] latentCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.FR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.FR.Corpus\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.GA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.GA.Corpus\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.HE.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Time.HE.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HE Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Time.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.HU.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.HU.Corpus\n\ntests :: TestTree\ntests = testGroup \"HU Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.IT.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.IT.Corpus\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.JA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.JA.Corpus\n\ntests :: TestTree\ntests = testGroup \"JA Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Duration] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.KA.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.KA.Corpus\n\ntests :: TestTree\ntests = testGroup \"KA Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeCorpusTest [Seal Time] latentCorpus\n  ]\n", "num_lines": 25}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.KO.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.KO.Corpus\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.NB.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.NB.Corpus\n\ntests :: TestTree\ntests = testGroup \"NB Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.NL.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\nimport Duckling.Time.NL.Corpus\nimport qualified Duckling.Time.NL.BE.Corpus as BE\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeCorpusTest [Seal Time] latentCorpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  , localeTests\n  ]\n\nlocaleTests :: TestTree\nlocaleTests = testGroup \"Locale Tests\"\n  [ testGroup \"NL_BE Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeBE BE.allExamples\n    , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeBE []\n    ]\n  ]\n  where\n    localeBE = makeLocale NL $ Just BE\n", "num_lines": 40}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.PL.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.PL.Corpus\n\ntests :: TestTree\ntests = testGroup \"PL Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.PT.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.PT.Corpus\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.RO.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.RO.Corpus\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.RU.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.RU.Corpus\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TupleSections #-}\n\nmodule Duckling.Time.SV.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\nimport qualified Data.HashSet as HashSet\n\nimport Duckling.Api\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types hiding (examples)\nimport Duckling.Time.Corpus\nimport Duckling.Time.SV.Corpus\nimport Duckling.TimeGrain.Types (Grain(..))\n\ntests :: TestTree\ntests = testGroup \"SV Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , ambiguousTests\n  ]\n\n-- Ambiguous examples occur when multiple tokens have the same value,\n-- but one is more flexible (they differ in the `values` field).\n-- For example, \"i morgonen\" can both mean \"this morning\" and \"in the morning\".\nambiguousTests :: TestTree\nambiguousTests = testCase \"Ambiguous Tests\" $ mapM_ check xs\n  where\n    xs = examples (datetimeInterval ((2013, 2, 12, 4, 0, 0), (2013, 2, 12, 12, 0, 0)) Hour)\n                  [ \"i morgonen\"\n                  ]\n    ctx = testContext {locale = makeLocale SV Nothing}\n    dims = HashSet.singleton $ Seal Time\n    check :: Example -> IO ()\n    check (input, predicate) = case analyze input ctx testOptions dims of\n      [] -> assertFailure $ \"empty result on \" ++ show input\n      xs -> mapM_ (assertBool (\"predicate on \" ++ show input) . predicate ctx) xs\n", "num_lines": 51}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.TR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Time.TR.Corpus\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  ]\n", "num_lines": 21}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.UK.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Resolve\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types (testContext, testOptions)\nimport Duckling.Time.UK.Corpus\nimport Duckling.Types (Range(..))\n\ntests :: TestTree\ntests = testGroup \"UK Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 29}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Time.VI.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Time.VI.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"VI Tests\"\n  [ makeCorpusTest [Seal Time] corpus\n  , makeNegativeCorpusTest [Seal Time] negativeCorpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Time.ZH.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Locale\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\nimport Duckling.Time.ZH.Corpus\nimport qualified Duckling.Time.ZH.CN.Corpus as CN\nimport qualified Duckling.Time.ZH.HK.Corpus as HK\nimport qualified Duckling.Time.ZH.MO.Corpus as MO\nimport qualified Duckling.Time.ZH.TW.Corpus as TW\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal Time] defaultCorpus\n  , localeTests\n  ]\n\nlocaleTests :: TestTree\nlocaleTests = testGroup \"Locale Tests\"\n  [ testGroup \"ZH_CN Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeCN CN.allExamples\n    ]\n  , testGroup \"ZH_HK Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeHK HK.allExamples\n    ]\n  , testGroup \"ZH_MO Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeMO MO.allExamples\n    ]\n  , testGroup \"ZH_TW Tests\"\n    [ makeCorpusTest [Seal Time] $ withLocale corpus localeTW TW.allExamples\n    ]\n  ]\n  where\n    localeCN = makeLocale ZH $ Just CN\n    localeHK = makeLocale ZH $ Just HK\n    localeMO = makeLocale ZH $ Just MO\n    localeTW = makeLocale ZH $ Just TW\n", "num_lines": 52}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule Duckling.Url.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\nimport Test.Tasty.HUnit\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Testing.Types\nimport Duckling.Url.Corpus\nimport Duckling.Url.Types\n\ntests :: TestTree\ntests = testGroup \"Url Tests\"\n  [ makeCorpusTest [Seal Url] corpus\n  , makeNegativeCorpusTest [Seal Url] negativeCorpus\n  , surroundTests\n  ]\n\nsurroundTests :: TestTree\nsurroundTests = testCase \"Surround Tests\" $\n  mapM_ (analyzedFirstTest testContext testOptions . withTargets [Seal Url]) xs\n  where\n    xs = examples (UrlData \"www.lets-try-this-one.co.uk/episode-7\" \"lets-try-this-one.co.uk\")\n                  [ \"phishing link: www.lets-try-this-one.co.uk/episode-7  If you want my job\"\n                  ]\n", "num_lines": 39}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport qualified Duckling.Volume.AR.Tests as AR\nimport qualified Duckling.Volume.CA.Tests as CA\nimport qualified Duckling.Volume.DE.Tests as DE\nimport qualified Duckling.Volume.EN.Tests as EN\nimport qualified Duckling.Volume.ES.Tests as ES\nimport qualified Duckling.Volume.FR.Tests as FR\nimport qualified Duckling.Volume.GA.Tests as GA\nimport qualified Duckling.Volume.HR.Tests as HR\nimport qualified Duckling.Volume.IT.Tests as IT\nimport qualified Duckling.Volume.KM.Tests as KM\nimport qualified Duckling.Volume.KO.Tests as KO\nimport qualified Duckling.Volume.MN.Tests as MN\nimport qualified Duckling.Volume.NL.Tests as NL\nimport qualified Duckling.Volume.PT.Tests as PT\nimport qualified Duckling.Volume.RO.Tests as RO\nimport qualified Duckling.Volume.RU.Tests as RU\nimport qualified Duckling.Volume.TR.Tests as TR\nimport qualified Duckling.Volume.ZH.Tests as ZH\n\ntests :: TestTree\ntests = testGroup \"Volume Tests\"\n  [ AR.tests\n  , CA.tests\n  , DE.tests\n  , EN.tests\n  , ES.tests\n  , FR.tests\n  , GA.tests\n  , HR.tests\n  , IT.tests\n  , KM.tests\n  , KO.tests\n  , MN.tests\n  , NL.tests\n  , PT.tests\n  , RO.tests\n  , RU.tests\n  , TR.tests\n  , ZH.tests\n  ]\n", "num_lines": 56}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.AR.Tests\n  ( tests\n  ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.AR.Corpus\n\ntests :: TestTree\ntests = testGroup \"AR Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.CA.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Volume.CA.Corpus\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"CA Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.DE.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.DE.Corpus\n\ntests :: TestTree\ntests = testGroup \"DE Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.EN.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.EN.Corpus\n\ntests :: TestTree\ntests = testGroup \"EN Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.ES.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.ES.Corpus\n\ntests :: TestTree\ntests = testGroup \"ES Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.FR.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.FR.Corpus\n\ntests :: TestTree\ntests = testGroup \"FR Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.GA.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.GA.Corpus\n\ntests :: TestTree\ntests = testGroup \"GA Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Volume.HR.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Volume.HR.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"HR Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\nmodule Duckling.Volume.IT.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.IT.Corpus\n\ntests :: TestTree\ntests = testGroup \"IT Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 22}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.KM.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.KM.Corpus\n\ntests :: TestTree\ntests = testGroup \"KM Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.KO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.KO.Corpus\n\ntests :: TestTree\ntests = testGroup \"KO Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.MN.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.MN.Corpus\n\ntests :: TestTree\ntests = testGroup \"MN Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.NL.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.NL.Corpus\n\ntests :: TestTree\ntests = testGroup \"NL Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.PT.Tests\n  ( tests ) where\n\nimport Data.String\nimport Prelude\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.PT.Corpus\n\ntests :: TestTree\ntests = testGroup \"PT Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.RO.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.RO.Corpus\n\ntests :: TestTree\ntests = testGroup \"RO Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.RU.Tests\n  ( tests ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.RU.Corpus\n\ntests :: TestTree\ntests = testGroup \"RU Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree.\n\n\nmodule Duckling.Volume.TR.Tests\n  ( tests\n  ) where\n\nimport Prelude\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Testing.Asserts\nimport Duckling.Volume.TR.Corpus\n\ntests :: TestTree\ntests = testGroup \"TR Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 24}
{"repo_name": "duckling", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Copyright (c) 2016-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is licensed under the BSD-style license found in the\n-- LICENSE file in the root directory of this source tree. An additional grant\n-- of patent rights can be found in the PATENTS file in the same directory.\n\nmodule Duckling.Volume.ZH.Tests\n  ( tests ) where\n\nimport Data.String\nimport Test.Tasty\n\nimport Duckling.Dimensions.Types\nimport Duckling.Volume.ZH.Corpus\nimport Duckling.Testing.Asserts\n\ntests :: TestTree\ntests = testGroup \"ZH Tests\"\n  [ makeCorpusTest [Seal Volume] corpus\n  ]\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\\begin{code}\nmodule Main (main) where\n\nmain :: IO ()\nmain = putStr \"Hello world!\"\n\\end{code}\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | This is the syntax for bkp files which are parsed in 'ghc --backpack'\n-- mode.  This syntax is used purely for testing purposes.\n\nmodule BkpSyn (\n    -- * Backpack abstract syntax\n    HsUnitId(..),\n    LHsUnitId,\n    HsModuleSubst,\n    LHsModuleSubst,\n    HsModuleId(..),\n    LHsModuleId,\n    HsComponentId(..),\n    LHsUnit, HsUnit(..),\n    LHsUnitDecl, HsUnitDecl(..),\n    HsDeclType(..),\n    IncludeDecl(..),\n    LRenaming, Renaming(..),\n    ) where\n\nimport GhcPrelude\n\nimport HsSyn\nimport SrcLoc\nimport Outputable\nimport Module\nimport PackageConfig\n\n{-\n************************************************************************\n*                                                                      *\n                        User syntax\n*                                                                      *\n************************************************************************\n-}\n\ndata HsComponentId = HsComponentId {\n    hsPackageName :: PackageName,\n    hsComponentId :: ComponentId\n    }\n\ninstance Outputable HsComponentId where\n    ppr (HsComponentId _pn cid) = ppr cid -- todo debug with pn\n\ndata HsUnitId n = HsUnitId (Located n) [LHsModuleSubst n]\ntype LHsUnitId n = Located (HsUnitId n)\n\ntype HsModuleSubst n = (Located ModuleName, LHsModuleId n)\ntype LHsModuleSubst n = Located (HsModuleSubst n)\n\ndata HsModuleId n = HsModuleVar (Located ModuleName)\n                  | HsModuleId (LHsUnitId n) (Located ModuleName)\ntype LHsModuleId n = Located (HsModuleId n)\n\n-- | Top level @unit@ declaration in a Backpack file.\ndata HsUnit n = HsUnit {\n        hsunitName :: Located n,\n        hsunitBody :: [LHsUnitDecl n]\n    }\ntype LHsUnit n = Located (HsUnit n)\n\n-- | A declaration in a package, e.g. a module or signature definition,\n-- or an include.\ndata HsDeclType = ModuleD | SignatureD\ndata HsUnitDecl n\n    = DeclD   HsDeclType (Located ModuleName) (Maybe (Located (HsModule GhcPs)))\n    | IncludeD   (IncludeDecl n)\ntype LHsUnitDecl n = Located (HsUnitDecl n)\n\n-- | An include of another unit\ndata IncludeDecl n = IncludeDecl {\n        idUnitId :: LHsUnitId n,\n        idModRenaming :: Maybe [ LRenaming ],\n        -- | Is this a @dependency signature@ include?  If so,\n        -- we don't compile this include when we instantiate this\n        -- unit (as there should not be any modules brought into\n        -- scope.)\n        idSignatureInclude :: Bool\n    }\n\n-- | Rename a module from one name to another.  The identity renaming\n-- means that the module should be brought into scope.\ndata Renaming = Renaming { renameFrom :: Located ModuleName\n                         , renameTo :: Maybe (Located ModuleName) }\ntype LRenaming = Located Renaming\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NondecreasingIndentation #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE CPP #-}\n\n-- | This is the driver for the 'ghc --backpack' mode, which\n-- is a reimplementation of the \"package manager\" bits of\n-- Backpack directly in GHC.  The basic method of operation\n-- is to compile packages and then directly insert them into\n-- GHC's in memory database.\n--\n-- The compilation products of this mode aren't really suitable\n-- for Cabal, because GHC makes up component IDs for the things\n-- it builds and doesn't serialize out the database contents.\n-- But it's still handy for constructing tests.\n\nmodule DriverBkp (doBackpack) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\n-- In a separate module because it hooks into the parser.\nimport BkpSyn\n\nimport GHC hiding (Failed, Succeeded)\nimport Packages\nimport Parser\nimport Lexer\nimport GhcMonad\nimport DynFlags\nimport TcRnMonad\nimport TcRnDriver\nimport Module\nimport HscTypes\nimport StringBuffer\nimport FastString\nimport ErrUtils\nimport SrcLoc\nimport HscMain\nimport UniqFM\nimport UniqDFM\nimport Outputable\nimport Maybes\nimport HeaderInfo\nimport MkIface\nimport GhcMake\nimport UniqDSet\nimport PrelNames\nimport BasicTypes hiding (SuccessFlag(..))\nimport Finder\nimport Util\n\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Panic\nimport Data.List\nimport System.Exit\nimport Control.Monad\nimport System.FilePath\nimport Data.Version\n\n-- for the unification\nimport Data.IORef\nimport Data.Map (Map)\nimport qualified Data.Map as Map\n\n-- | Entry point to compile a Backpack file.\ndoBackpack :: [FilePath] -> Ghc ()\ndoBackpack [src_filename] = do\n    -- Apply options from file to dflags\n    dflags0 <- getDynFlags\n    let dflags1 = dflags0\n    src_opts <- liftIO $ getOptionsFromFile dflags1 src_filename\n    (dflags, unhandled_flags, warns) <- liftIO $ parseDynamicFilePragma dflags1 src_opts\n    modifySession (\\hsc_env -> hsc_env {hsc_dflags = dflags})\n    -- Cribbed from: preprocessFile / DriverPipeline\n    liftIO $ checkProcessArgsResult dflags unhandled_flags\n    liftIO $ handleFlagWarnings dflags warns\n    -- TODO: Preprocessing not implemented\n\n    buf <- liftIO $ hGetStringBuffer src_filename\n    let loc = mkRealSrcLoc (mkFastString src_filename) 1 1 -- TODO: not great\n    case unP parseBackpack (mkPState dflags buf loc) of\n        PFailed pst -> throwErrors (getErrorMessages pst dflags)\n        POk _ pkgname_bkp -> do\n            -- OK, so we have an LHsUnit PackageName, but we want an\n            -- LHsUnit HsComponentId.  So let's rename it.\n            let bkp = renameHsUnits dflags (packageNameMap pkgname_bkp) pkgname_bkp\n            initBkpM src_filename bkp $\n                forM_ (zip [1..] bkp) $ \\(i, lunit) -> do\n                    let comp_name = unLoc (hsunitName (unLoc lunit))\n                    msgTopPackage (i,length bkp) comp_name\n                    innerBkpM $ do\n                        let (cid, insts) = computeUnitId lunit\n                        if null insts\n                            then if cid == ComponentId (fsLit \"main\")\n                                    then compileExe lunit\n                                    else compileUnit cid []\n                            else typecheckUnit cid insts\ndoBackpack _ =\n    throwGhcException (CmdLineError \"--backpack can only process a single file\")\n\ncomputeUnitId :: LHsUnit HsComponentId -> (ComponentId, [(ModuleName, Module)])\ncomputeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])\n  where\n    cid = hsComponentId (unLoc (hsunitName unit))\n    reqs = uniqDSetToList (unionManyUniqDSets (map (get_reqs . unLoc) (hsunitBody unit)))\n    get_reqs (DeclD SignatureD (L _ modname) _) = unitUniqDSet modname\n    get_reqs (DeclD ModuleD _ _) = emptyUniqDSet\n    get_reqs (IncludeD (IncludeDecl (L _ hsuid) _ _)) =\n        unitIdFreeHoles (convertHsUnitId hsuid)\n\n-- | Tiny enum for all types of Backpack operations we may do.\ndata SessionType\n    -- | A compilation operation which will result in a\n    -- runnable executable being produced.\n    = ExeSession\n    -- | A type-checking operation which produces only\n    -- interface files, no object files.\n    | TcSession\n    -- | A compilation operation which produces both\n    -- interface files and object files.\n    | CompSession\n    deriving (Eq)\n\n-- | Create a temporary Session to do some sort of type checking or\n-- compilation.\nwithBkpSession :: ComponentId\n               -> [(ModuleName, Module)]\n               -> [(UnitId, ModRenaming)]\n               -> SessionType   -- what kind of session are we doing\n               -> BkpM a        -- actual action to run\n               -> BkpM a\nwithBkpSession cid insts deps session_type do_this = do\n    dflags <- getDynFlags\n    let (ComponentId cid_fs) = cid\n        is_primary = False\n        uid_str = unpackFS (hashUnitId cid insts)\n        cid_str = unpackFS cid_fs\n        -- There are multiple units in a single Backpack file, so we\n        -- need to separate out the results in those cases.  Right now,\n        -- we follow this hierarchy:\n        --      $outputdir/$compid          --> typecheck results\n        --      $outputdir/$compid/$unitid  --> compile results\n        key_base p | Just f <- p dflags = f\n                   | otherwise          = \".\"\n        sub_comp p | is_primary = p\n                   | otherwise = p </> cid_str\n        outdir p | CompSession <- session_type\n                 -- Special case when package is definite\n                 , not (null insts) = sub_comp (key_base p) </> uid_str\n                 | otherwise = sub_comp (key_base p)\n    withTempSession (overHscDynFlags (\\dflags ->\n      -- If we're type-checking an indefinite package, we want to\n      -- turn on interface writing.  However, if the user also\n      -- explicitly passed in `-fno-code`, we DON'T want to write\n      -- interfaces unless the user also asked for `-fwrite-interface`.\n      -- See Note [-fno-code mode]\n      (case session_type of\n        -- Make sure to write interfaces when we are type-checking\n        -- indefinite packages.\n        TcSession | hscTarget dflags /= HscNothing\n                  -> flip gopt_set Opt_WriteInterface\n                  | otherwise -> id\n        CompSession -> id\n        ExeSession -> id) $\n      dflags {\n        hscTarget   = case session_type of\n                        TcSession -> HscNothing\n                        _ -> hscTarget dflags,\n        thisUnitIdInsts_ = Just insts,\n        thisComponentId_ = Just cid,\n        thisInstalledUnitId =\n            case session_type of\n                TcSession -> newInstalledUnitId cid Nothing\n                -- No hash passed if no instances\n                _ | null insts -> newInstalledUnitId cid Nothing\n                  | otherwise  -> newInstalledUnitId cid (Just (hashUnitId cid insts)),\n        -- Setup all of the output directories according to our hierarchy\n        objectDir   = Just (outdir objectDir),\n        hiDir       = Just (outdir hiDir),\n        stubDir     = Just (outdir stubDir),\n        -- Unset output-file for non exe builds\n        outputFile  = if session_type == ExeSession\n                        then outputFile dflags\n                        else Nothing,\n        -- Clear the import path so we don't accidentally grab anything\n        importPaths = [],\n        -- Synthesized the flags\n        packageFlags = packageFlags dflags ++ map (\\(uid0, rn) ->\n          let uid = unwireUnitId dflags (improveUnitId (getPackageConfigMap dflags) $ renameHoleUnitId dflags (listToUFM insts) uid0)\n          in ExposePackage\n            (showSDoc dflags\n                (text \"-unit-id\" <+> ppr uid <+> ppr rn))\n            (UnitIdArg uid) rn) deps\n      } )) $ do\n        dflags <- getSessionDynFlags\n        -- pprTrace \"flags\" (ppr insts <> ppr deps) $ return ()\n        -- Calls initPackages\n        _ <- setSessionDynFlags dflags\n        do_this\n\nwithBkpExeSession :: [(UnitId, ModRenaming)] -> BkpM a -> BkpM a\nwithBkpExeSession deps do_this = do\n    withBkpSession (ComponentId (fsLit \"main\")) [] deps ExeSession do_this\n\ngetSource :: ComponentId -> BkpM (LHsUnit HsComponentId)\ngetSource cid = do\n    bkp_env <- getBkpEnv\n    case Map.lookup cid (bkp_table bkp_env) of\n        Nothing -> pprPanic \"missing needed dependency\" (ppr cid)\n        Just lunit -> return lunit\n\ntypecheckUnit :: ComponentId -> [(ModuleName, Module)] -> BkpM ()\ntypecheckUnit cid insts = do\n    lunit <- getSource cid\n    buildUnit TcSession cid insts lunit\n\ncompileUnit :: ComponentId -> [(ModuleName, Module)] -> BkpM ()\ncompileUnit cid insts = do\n    -- Let everyone know we're building this unit ID\n    msgUnitId (newUnitId cid insts)\n    lunit <- getSource cid\n    buildUnit CompSession cid insts lunit\n\n-- | Compute the dependencies with instantiations of a syntactic\n-- HsUnit; e.g., wherever you see @dependency p[A=<A>]@ in a\n-- unit file, return the 'UnitId' corresponding to @p[A=<A>]@.\n-- The @include_sigs@ parameter controls whether or not we also\n-- include @dependency signature@ declarations in this calculation.\n--\n-- Invariant: this NEVER returns InstalledUnitId.\nhsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(UnitId, ModRenaming)]\nhsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit)\n  where\n    get_dep (L _ (IncludeD (IncludeDecl (L _ hsuid) mb_lrn is_sig)))\n        | include_sigs || not is_sig = [(convertHsUnitId hsuid, go mb_lrn)]\n        | otherwise = []\n      where\n        go Nothing = ModRenaming True []\n        go (Just lrns) = ModRenaming False (map convRn lrns)\n          where\n            convRn (L _ (Renaming (L _ from) Nothing))         = (from, from)\n            convRn (L _ (Renaming (L _ from) (Just (L _ to)))) = (from, to)\n    get_dep _ = []\n\nbuildUnit :: SessionType -> ComponentId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()\nbuildUnit session cid insts lunit = do\n    -- NB: include signature dependencies ONLY when typechecking.\n    -- If we're compiling, it's not necessary to recursively\n    -- compile a signature since it isn't going to produce\n    -- any object files.\n    let deps_w_rns = hsunitDeps (session == TcSession) (unLoc lunit)\n        raw_deps = map fst deps_w_rns\n    dflags <- getDynFlags\n    -- The compilation dependencies are just the appropriately filled\n    -- in unit IDs which must be compiled before we can compile.\n    let hsubst = listToUFM insts\n        deps0 = map (renameHoleUnitId dflags hsubst) raw_deps\n\n    -- Build dependencies OR make sure they make sense. BUT NOTE,\n    -- we can only check the ones that are fully filled; the rest\n    -- we have to defer until we've typechecked our local signature.\n    -- TODO: work this into GhcMake!!\n    forM_ (zip [1..] deps0) $ \\(i, dep) ->\n        case session of\n            TcSession -> return ()\n            _ -> compileInclude (length deps0) (i, dep)\n\n    dflags <- getDynFlags\n    -- IMPROVE IT\n    let deps = map (improveUnitId (getPackageConfigMap dflags)) deps0\n\n    mb_old_eps <- case session of\n                    TcSession -> fmap Just getEpsGhc\n                    _ -> return Nothing\n\n    conf <- withBkpSession cid insts deps_w_rns session $ do\n\n        dflags <- getDynFlags\n        mod_graph <- hsunitModuleGraph dflags (unLoc lunit)\n        -- pprTrace \"mod_graph\" (ppr mod_graph) $ return ()\n\n        msg <- mkBackpackMsg\n        ok <- load' LoadAllTargets (Just msg) mod_graph\n        when (failed ok) (liftIO $ exitWith (ExitFailure 1))\n\n        let hi_dir = expectJust (panic \"hiDir Backpack\") $ hiDir dflags\n            export_mod ms = (ms_mod_name ms, ms_mod ms)\n            -- Export everything!\n            mods = [ export_mod ms | ms <- mgModSummaries mod_graph\n                                   , ms_hsc_src ms == HsSrcFile ]\n\n        -- Compile relevant only\n        hsc_env <- getSession\n        let home_mod_infos = eltsUDFM (hsc_HPT hsc_env)\n            linkables = map (expectJust \"bkp link\" . hm_linkable)\n                      . filter ((==HsSrcFile) . mi_hsc_src . hm_iface)\n                      $ home_mod_infos\n            getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)\n            obj_files = concatMap getOfiles linkables\n\n        let compat_fs = (case cid of ComponentId fs -> fs)\n            compat_pn = PackageName compat_fs\n\n        return InstalledPackageInfo {\n            -- Stub data\n            abiHash = \"\",\n            sourcePackageId = SourcePackageId compat_fs,\n            packageName = compat_pn,\n            packageVersion = makeVersion [0],\n            unitId = toInstalledUnitId (thisPackage dflags),\n            sourceLibName = Nothing,\n            componentId = cid,\n            instantiatedWith = insts,\n            -- Slight inefficiency here haha\n            exposedModules = map (\\(m,n) -> (m,Just n)) mods,\n            hiddenModules = [], -- TODO: doc only\n            depends = case session of\n                        -- Technically, we should state that we depend\n                        -- on all the indefinite libraries we used to\n                        -- typecheck this.  However, this field isn't\n                        -- really used for anything, so we leave it\n                        -- blank for now.\n                        TcSession -> []\n                        _ -> map (toInstalledUnitId . unwireUnitId dflags)\n                                $ deps ++ [ moduleUnitId mod\n                                          | (_, mod) <- insts\n                                          , not (isHoleModule mod) ],\n            abiDepends = [],\n            ldOptions = case session of\n                            TcSession -> []\n                            _ -> obj_files,\n            importDirs = [ hi_dir ],\n            exposed = False,\n            indefinite = case session of\n                            TcSession -> True\n                            _ -> False,\n            -- nope\n            hsLibraries = [],\n            extraLibraries = [],\n            extraGHCiLibraries = [],\n            libraryDynDirs = [],\n            libraryDirs = [],\n            frameworks = [],\n            frameworkDirs = [],\n            ccOptions = [],\n            includes = [],\n            includeDirs = [],\n            haddockInterfaces = [],\n            haddockHTMLs = [],\n            trusted = False\n            }\n\n\n    addPackage conf\n    case mb_old_eps of\n        Just old_eps -> updateEpsGhc_ (const old_eps)\n        _ -> return ()\n\ncompileExe :: LHsUnit HsComponentId -> BkpM ()\ncompileExe lunit = do\n    msgUnitId mainUnitId\n    let deps_w_rns = hsunitDeps False (unLoc lunit)\n        deps = map fst deps_w_rns\n        -- no renaming necessary\n    forM_ (zip [1..] deps) $ \\(i, dep) ->\n        compileInclude (length deps) (i, dep)\n    withBkpExeSession deps_w_rns $ do\n        dflags <- getDynFlags\n        mod_graph <- hsunitModuleGraph dflags (unLoc lunit)\n        msg <- mkBackpackMsg\n        ok <- load' LoadAllTargets (Just msg) mod_graph\n        when (failed ok) (liftIO $ exitWith (ExitFailure 1))\n\naddPackage :: GhcMonad m => PackageConfig -> m ()\naddPackage pkg = do\n    dflags0 <- GHC.getSessionDynFlags\n    case pkgDatabase dflags0 of\n        Nothing -> panic \"addPackage: called too early\"\n        Just pkgs -> do let dflags = dflags0 { pkgDatabase =\n                            Just (pkgs ++ [(\"(in memory \" ++ showSDoc dflags0 (ppr (unitId pkg)) ++ \")\", [pkg])]) }\n                        _ <- GHC.setSessionDynFlags dflags\n                        -- By this time, the global ref has probably already\n                        -- been forced, in which case doing this isn't actually\n                        -- going to do you any good.\n                        -- dflags <- GHC.getSessionDynFlags\n                        -- liftIO $ setUnsafeGlobalDynFlags dflags\n                        return ()\n\n-- Precondition: UnitId is NOT InstalledUnitId\ncompileInclude :: Int -> (Int, UnitId) -> BkpM ()\ncompileInclude n (i, uid) = do\n    hsc_env <- getSession\n    let dflags = hsc_dflags hsc_env\n    msgInclude (i, n) uid\n    -- Check if we've compiled it already\n    case lookupPackage dflags uid of\n        Nothing -> do\n            case splitUnitIdInsts uid of\n                (_, Just indef) ->\n                    innerBkpM $ compileUnit (indefUnitIdComponentId indef)\n                                            (indefUnitIdInsts indef)\n                _ -> return ()\n        Just _ -> return ()\n\n-- ----------------------------------------------------------------------------\n-- Backpack monad\n\n-- | Backpack monad is a 'GhcMonad' which also maintains a little extra state\n-- beyond the 'Session', c.f. 'BkpEnv'.\ntype BkpM = IOEnv BkpEnv\n\n-- | Backpack environment.  NB: this has a 'Session' and not an 'HscEnv',\n-- because we are going to update the 'HscEnv' as we go.\ndata BkpEnv\n    = BkpEnv {\n        -- | The session\n        bkp_session :: Session,\n        -- | The filename of the bkp file we're compiling\n        bkp_filename :: FilePath,\n        -- | Table of source units which we know how to compile\n        bkp_table :: Map ComponentId (LHsUnit HsComponentId),\n        -- | When a package we are compiling includes another package\n        -- which has not been compiled, we bump the level and compile\n        -- that.\n        bkp_level :: Int\n    }\n\n-- Blah, to get rid of the default instance for IOEnv\n-- TODO: just make a proper new monad for BkpM, rather than use IOEnv\ninstance {-# OVERLAPPING #-} HasDynFlags BkpM where\n    getDynFlags = fmap hsc_dflags getSession\n\ninstance GhcMonad BkpM where\n    getSession = do\n        Session s <- fmap bkp_session getEnv\n        readMutVar s\n    setSession hsc_env = do\n        Session s <- fmap bkp_session getEnv\n        writeMutVar s hsc_env\n\n-- | Get the current 'BkpEnv'.\ngetBkpEnv :: BkpM BkpEnv\ngetBkpEnv = getEnv\n\n-- | Get the nesting level, when recursively compiling modules.\ngetBkpLevel :: BkpM Int\ngetBkpLevel = bkp_level `fmap` getBkpEnv\n\n-- | Apply a function on 'DynFlags' on an 'HscEnv'\noverHscDynFlags :: (DynFlags -> DynFlags) -> HscEnv -> HscEnv\noverHscDynFlags f hsc_env = hsc_env { hsc_dflags = f (hsc_dflags hsc_env) }\n\n-- | Run a 'BkpM' computation, with the nesting level bumped one.\ninnerBkpM :: BkpM a -> BkpM a\ninnerBkpM do_this = do\n    -- NB: withTempSession mutates, so we don't have to worry\n    -- about bkp_session being stale.\n    updEnv (\\env -> env { bkp_level = bkp_level env + 1 }) do_this\n\n-- | Update the EPS from a 'GhcMonad'. TODO move to appropriate library spot.\nupdateEpsGhc_ :: GhcMonad m => (ExternalPackageState -> ExternalPackageState) -> m ()\nupdateEpsGhc_ f = do\n    hsc_env <- getSession\n    liftIO $ atomicModifyIORef' (hsc_EPS hsc_env) (\\x -> (f x, ()))\n\n-- | Get the EPS from a 'GhcMonad'.\ngetEpsGhc :: GhcMonad m => m ExternalPackageState\ngetEpsGhc = do\n    hsc_env <- getSession\n    liftIO $ readIORef (hsc_EPS hsc_env)\n\n-- | Run 'BkpM' in 'Ghc'.\ninitBkpM :: FilePath -> [LHsUnit HsComponentId] -> BkpM a -> Ghc a\ninitBkpM file bkp m = do\n    reifyGhc $ \\session -> do\n    let env = BkpEnv {\n                    bkp_session = session,\n                    bkp_table = Map.fromList [(hsComponentId (unLoc (hsunitName (unLoc u))), u) | u <- bkp],\n                    bkp_filename = file,\n                    bkp_level = 0\n                }\n    runIOEnv env m\n\n-- ----------------------------------------------------------------------------\n-- Messaging\n\n-- | Print a compilation progress message, but with indentation according\n-- to @level@ (for nested compilation).\nbackpackProgressMsg :: Int -> DynFlags -> String -> IO ()\nbackpackProgressMsg level dflags msg =\n    compilationProgressMsg dflags $ replicate (level * 2) ' ' ++ msg\n\n-- | Creates a 'Messager' for Backpack compilation; this is basically\n-- a carbon copy of 'batchMsg' but calling 'backpackProgressMsg', which\n-- handles indentation.\nmkBackpackMsg :: BkpM Messager\nmkBackpackMsg = do\n    level <- getBkpLevel\n    return $ \\hsc_env mod_index recomp mod_summary ->\n      let dflags = hsc_dflags hsc_env\n          showMsg msg reason =\n            backpackProgressMsg level dflags $\n                showModuleIndex mod_index ++\n                msg ++ showModMsg dflags (hscTarget dflags)\n                                  (recompileRequired recomp) mod_summary\n                    ++ reason\n      in case recomp of\n            MustCompile -> showMsg \"Compiling \" \"\"\n            UpToDate\n                | verbosity (hsc_dflags hsc_env) >= 2 -> showMsg \"Skipping  \" \"\"\n                | otherwise -> return ()\n            RecompBecause reason -> showMsg \"Compiling \" (\" [\" ++ reason ++ \"]\")\n\n-- | 'PprStyle' for Backpack messages; here we usually want the module to\n-- be qualified (so we can tell how it was instantiated.) But we try not\n-- to qualify packages so we can use simple names for them.\nbackpackStyle :: DynFlags -> PprStyle\nbackpackStyle dflags =\n    mkUserStyle dflags\n        (QueryQualify neverQualifyNames\n                      alwaysQualifyModules\n                      neverQualifyPackages) AllTheWay\n\n-- | Message when we initially process a Backpack unit.\nmsgTopPackage :: (Int,Int) -> HsComponentId -> BkpM ()\nmsgTopPackage (i,n) (HsComponentId (PackageName fs_pn) _) = do\n    dflags <- getDynFlags\n    level <- getBkpLevel\n    liftIO . backpackProgressMsg level dflags\n        $ showModuleIndex (i, n) ++ \"Processing \" ++ unpackFS fs_pn\n\n-- | Message when we instantiate a Backpack unit.\nmsgUnitId :: UnitId -> BkpM ()\nmsgUnitId pk = do\n    dflags <- getDynFlags\n    level <- getBkpLevel\n    liftIO . backpackProgressMsg level dflags\n        $ \"Instantiating \" ++ renderWithStyle dflags (ppr pk)\n                                (backpackStyle dflags)\n\n-- | Message when we include a Backpack unit.\nmsgInclude :: (Int,Int) -> UnitId -> BkpM ()\nmsgInclude (i,n) uid = do\n    dflags <- getDynFlags\n    level <- getBkpLevel\n    liftIO . backpackProgressMsg level dflags\n        $ showModuleIndex (i, n) ++ \"Including \" ++\n          renderWithStyle dflags (ppr uid) (backpackStyle dflags)\n\n-- ----------------------------------------------------------------------------\n-- Conversion from PackageName to HsComponentId\n\ntype PackageNameMap a = Map PackageName a\n\n-- For now, something really simple, since we're not actually going\n-- to use this for anything\nunitDefines :: LHsUnit PackageName -> (PackageName, HsComponentId)\nunitDefines (L _ HsUnit{ hsunitName = L _ pn@(PackageName fs) })\n    = (pn, HsComponentId pn (ComponentId fs))\n\npackageNameMap :: [LHsUnit PackageName] -> PackageNameMap HsComponentId\npackageNameMap units = Map.fromList (map unitDefines units)\n\nrenameHsUnits :: DynFlags -> PackageNameMap HsComponentId -> [LHsUnit PackageName] -> [LHsUnit HsComponentId]\nrenameHsUnits dflags m units = map (fmap renameHsUnit) units\n  where\n\n    renamePackageName :: PackageName -> HsComponentId\n    renamePackageName pn =\n        case Map.lookup pn m of\n            Nothing ->\n                case lookupPackageName dflags pn of\n                    Nothing -> error \"no package name\"\n                    Just cid -> HsComponentId pn cid\n            Just hscid -> hscid\n\n    renameHsUnit :: HsUnit PackageName -> HsUnit HsComponentId\n    renameHsUnit u =\n        HsUnit {\n            hsunitName = fmap renamePackageName (hsunitName u),\n            hsunitBody = map (fmap renameHsUnitDecl) (hsunitBody u)\n        }\n\n    renameHsUnitDecl :: HsUnitDecl PackageName -> HsUnitDecl HsComponentId\n    renameHsUnitDecl (DeclD a b c) = DeclD a b c\n    renameHsUnitDecl (IncludeD idecl) =\n        IncludeD IncludeDecl {\n            idUnitId = fmap renameHsUnitId (idUnitId idecl),\n            idModRenaming = idModRenaming idecl,\n            idSignatureInclude = idSignatureInclude idecl\n        }\n\n    renameHsUnitId :: HsUnitId PackageName -> HsUnitId HsComponentId\n    renameHsUnitId (HsUnitId ln subst)\n        = HsUnitId (fmap renamePackageName ln) (map (fmap renameHsModuleSubst) subst)\n\n    renameHsModuleSubst :: HsModuleSubst PackageName -> HsModuleSubst HsComponentId\n    renameHsModuleSubst (lk, lm)\n        = (lk, fmap renameHsModuleId lm)\n\n    renameHsModuleId :: HsModuleId PackageName -> HsModuleId HsComponentId\n    renameHsModuleId (HsModuleVar lm) = HsModuleVar lm\n    renameHsModuleId (HsModuleId luid lm) = HsModuleId (fmap renameHsUnitId luid) lm\n\nconvertHsUnitId :: HsUnitId HsComponentId -> UnitId\nconvertHsUnitId (HsUnitId (L _ hscid) subst)\n    = newUnitId (hsComponentId hscid) (map (convertHsModuleSubst . unLoc) subst)\n\nconvertHsModuleSubst :: HsModuleSubst HsComponentId -> (ModuleName, Module)\nconvertHsModuleSubst (L _ modname, L _ m) = (modname, convertHsModuleId m)\n\nconvertHsModuleId :: HsModuleId HsComponentId -> Module\nconvertHsModuleId (HsModuleVar (L _ modname)) = mkHoleModule modname\nconvertHsModuleId (HsModuleId (L _ hsuid) (L _ modname)) = mkModule (convertHsUnitId hsuid) modname\n\n\n\n{-\n************************************************************************\n*                                                                      *\n                        Module graph construction\n*                                                                      *\n************************************************************************\n-}\n\n-- | This is our version of GhcMake.downsweep, but with a few modifications:\n--\n--  1. Every module is required to be mentioned, so we don't do any funny\n--     business with targets or recursively grabbing dependencies.  (We\n--     could support this in principle).\n--  2. We support inline modules, whose summary we have to synthesize ourself.\n--\n-- We don't bother trying to support GhcMake for now, it's more trouble\n-- than it's worth for inline modules.\nhsunitModuleGraph :: DynFlags -> HsUnit HsComponentId -> BkpM ModuleGraph\nhsunitModuleGraph dflags unit = do\n    let decls = hsunitBody unit\n        pn = hsPackageName (unLoc (hsunitName unit))\n\n    --  1. Create a HsSrcFile/HsigFile summary for every\n    --  explicitly mentioned module/signature.\n    let get_decl (L _ (DeclD dt lmodname mb_hsmod)) = do\n          let hsc_src = case dt of\n                          ModuleD    -> HsSrcFile\n                          SignatureD -> HsigFile\n          Just `fmap` summariseDecl pn hsc_src lmodname mb_hsmod\n        get_decl _ = return Nothing\n    nodes <- catMaybes `fmap` mapM get_decl decls\n\n    --  2. For each hole which does not already have an hsig file,\n    --  create an \"empty\" hsig file to induce compilation for the\n    --  requirement.\n    let node_map = Map.fromList [ ((ms_mod_name n, ms_hsc_src n == HsigFile), n)\n                                | n <- nodes ]\n    req_nodes <- fmap catMaybes . forM (thisUnitIdInsts dflags) $ \\(mod_name, _) ->\n        let has_local = Map.member (mod_name, True) node_map\n        in if has_local\n            then return Nothing\n            else fmap Just $ summariseRequirement pn mod_name\n\n    -- 3. Return the kaboodle\n    return $ mkModuleGraph $ nodes ++ req_nodes\n\nsummariseRequirement :: PackageName -> ModuleName -> BkpM ModSummary\nsummariseRequirement pn mod_name = do\n    hsc_env <- getSession\n    let dflags = hsc_dflags hsc_env\n\n    let PackageName pn_fs = pn\n    location <- liftIO $ mkHomeModLocation2 dflags mod_name\n                 (unpackFS pn_fs </> moduleNameSlashes mod_name) \"hsig\"\n\n    env <- getBkpEnv\n    time <- liftIO $ getModificationUTCTime (bkp_filename env)\n    hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)\n    hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)\n    let loc = srcLocSpan (mkSrcLoc (mkFastString (bkp_filename env)) 1 1)\n\n    mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location\n\n    extra_sig_imports <- liftIO $ findExtraSigImports hsc_env HsigFile mod_name\n\n    return ModSummary {\n        ms_mod = mod,\n        ms_hsc_src = HsigFile,\n        ms_location = location,\n        ms_hs_date = time,\n        ms_obj_date = Nothing,\n        ms_iface_date = hi_timestamp,\n        ms_hie_date = hie_timestamp,\n        ms_srcimps = [],\n        ms_textual_imps = extra_sig_imports,\n        ms_parsed_mod = Just (HsParsedModule {\n                hpm_module = L loc (HsModule {\n                        hsmodName = Just (L loc mod_name),\n                        hsmodExports = Nothing,\n                        hsmodImports = [],\n                        hsmodDecls = [],\n                        hsmodDeprecMessage = Nothing,\n                        hsmodHaddockModHeader = Nothing\n                    }),\n                hpm_src_files = [],\n                hpm_annotations = (Map.empty, Map.empty)\n            }),\n        ms_hspp_file = \"\", -- none, it came inline\n        ms_hspp_opts = dflags,\n        ms_hspp_buf = Nothing\n        }\n\nsummariseDecl :: PackageName\n              -> HscSource\n              -> Located ModuleName\n              -> Maybe (Located (HsModule GhcPs))\n              -> BkpM ModSummary\nsummariseDecl pn hsc_src (L _ modname) (Just hsmod) = hsModuleToModSummary pn hsc_src modname hsmod\nsummariseDecl _pn hsc_src lmodname@(L loc modname) Nothing\n    = do hsc_env <- getSession\n         let dflags = hsc_dflags hsc_env\n         -- TODO: this looks for modules in the wrong place\n         r <- liftIO $ summariseModule hsc_env\n                         Map.empty -- GHC API recomp not supported\n                         (hscSourceToIsBoot hsc_src)\n                         lmodname\n                         True -- Target lets you disallow, but not here\n                         Nothing -- GHC API buffer support not supported\n                         [] -- No exclusions\n         case r of\n            Nothing -> throwOneError (mkPlainErrMsg dflags loc (text \"module\" <+> ppr modname <+> text \"was not found\"))\n            Just (Left err) -> throwOneError err\n            Just (Right summary) -> return summary\n\n-- | Up until now, GHC has assumed a single compilation target per source file.\n-- Backpack files with inline modules break this model, since a single file\n-- may generate multiple output files.  How do we decide to name these files?\n-- Should there only be one output file? This function our current heuristic,\n-- which is we make a \"fake\" module and use that.\nhsModuleToModSummary :: PackageName\n                     -> HscSource\n                     -> ModuleName\n                     -> Located (HsModule GhcPs)\n                     -> BkpM ModSummary\nhsModuleToModSummary pn hsc_src modname\n                     hsmod = do\n    let imps = hsmodImports (unLoc hsmod)\n        loc  = getLoc hsmod\n    hsc_env <- getSession\n    -- Sort of the same deal as in DriverPipeline's getLocation\n    -- Use the PACKAGE NAME to find the location\n    let PackageName unit_fs = pn\n        dflags = hsc_dflags hsc_env\n    -- Unfortunately, we have to define a \"fake\" location in\n    -- order to appease the various code which uses the file\n    -- name to figure out where to put, e.g. object files.\n    -- To add insult to injury, we don't even actually use\n    -- these filenames to figure out where the hi files go.\n    -- A travesty!\n    location0 <- liftIO $ mkHomeModLocation2 dflags modname\n                             (unpackFS unit_fs </>\n                              moduleNameSlashes modname)\n                              (case hsc_src of\n                                HsigFile -> \"hsig\"\n                                HsBootFile -> \"hs-boot\"\n                                HsSrcFile -> \"hs\")\n    -- DANGEROUS: bootifying can POISON the module finder cache\n    let location = case hsc_src of\n                        HsBootFile -> addBootSuffixLocnOut location0\n                        _ -> location0\n    -- This duplicates a pile of logic in GhcMake\n    env <- getBkpEnv\n    time <- liftIO $ getModificationUTCTime (bkp_filename env)\n    hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)\n    hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)\n\n    -- Also copied from 'getImports'\n    let (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps\n\n             -- GHC.Prim doesn't exist physically, so don't go looking for it.\n        ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc)\n                               ord_idecls\n\n        implicit_prelude = xopt LangExt.ImplicitPrelude dflags\n        implicit_imports = mkPrelImports modname loc\n                                         implicit_prelude imps\n        convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)\n\n    extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname\n\n    let normal_imports = map convImport (implicit_imports ++ ordinary_imps)\n    required_by_imports <- liftIO $ implicitRequirements hsc_env normal_imports\n\n    -- So that Finder can find it, even though it doesn't exist...\n    this_mod <- liftIO $ addHomeModuleToFinder hsc_env modname location\n    return ModSummary {\n            ms_mod = this_mod,\n            ms_hsc_src = hsc_src,\n            ms_location = location,\n            ms_hspp_file = (case hiDir dflags of\n                            Nothing -> \"\"\n                            Just d -> d) </> \"..\" </> moduleNameSlashes modname <.> \"hi\",\n            ms_hspp_opts = dflags,\n            ms_hspp_buf = Nothing,\n            ms_srcimps = map convImport src_idecls,\n            ms_textual_imps = normal_imports\n                           -- We have to do something special here:\n                           -- due to merging, requirements may end up with\n                           -- extra imports\n                           ++ extra_sig_imports\n                           ++ required_by_imports,\n            -- This is our hack to get the parse tree to the right spot\n            ms_parsed_mod = Just (HsParsedModule {\n                    hpm_module = hsmod,\n                    hpm_src_files = [], -- TODO if we preprocessed it\n                    hpm_annotations = (Map.empty, Map.empty) -- BOGUS\n                }),\n            ms_hs_date = time,\n            ms_obj_date = Nothing, -- TODO do this, but problem: hi_timestamp is BOGUS\n            ms_iface_date = hi_timestamp,\n            ms_hie_date = hie_timestamp\n        }\n\n-- | Create a new, externally provided hashed unit id from\n-- a hash.\nnewInstalledUnitId :: ComponentId -> Maybe FastString -> InstalledUnitId\nnewInstalledUnitId (ComponentId cid_fs) (Just fs)\n    = InstalledUnitId (cid_fs `appendFS` mkFastString \"+\" `appendFS` fs)\nnewInstalledUnitId (ComponentId cid_fs) Nothing\n    = InstalledUnitId cid_fs\n", "num_lines": 831}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule NameShape(\n    NameShape(..),\n    emptyNameShape,\n    mkNameShape,\n    extendNameShape,\n    nameShapeExports,\n    substNameShape,\n    maybeSubstNameShape,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Outputable\nimport HscTypes\nimport Module\nimport UniqFM\nimport Avail\nimport FieldLabel\n\nimport Name\nimport NameEnv\nimport TcRnMonad\nimport Util\nimport IfaceEnv\n\nimport Control.Monad\n\n-- Note [NameShape]\n-- ~~~~~~~~~~~~~~~~\n-- When we write a declaration in a signature, e.g., data T, we\n-- ascribe to it a *name variable*, e.g., {m.T}.  This\n-- name variable may be substituted with an actual original\n-- name when the signature is implemented (or even if we\n-- merge the signature with one which reexports this entity\n-- from another module).\n\n-- When we instantiate a signature m with a module M,\n-- we also need to substitute over names.  To do so, we must\n-- compute the *name substitution* induced by the *exports*\n-- of the module in question.  A NameShape represents\n-- such a name substitution for a single module instantiation.\n-- The \"shape\" in the name comes from the fact that the computation\n-- of a name substitution is essentially the *shaping pass* from\n-- Backpack'14, but in a far more restricted form.\n\n-- The name substitution for an export list is easy to explain.  If we are\n-- filling the module variable <m>, given an export N of the form\n-- M.n or {m'.n} (where n is an OccName), the induced name\n-- substitution is from {m.n} to N.  So, for example, if we have\n-- A=impl:B, and the exports of impl:B are impl:B.f and\n-- impl:C.g, then our name substitution is {A.f} to impl:B.f\n-- and {A.g} to impl:C.g\n\n\n\n\n-- The 'NameShape' type is defined in TcRnTypes, because TcRnTypes\n-- needs to refer to NameShape, and having TcRnTypes import\n-- NameShape (even by SOURCE) would cause a large number of\n-- modules to be pulled into the DynFlags cycle.\n{-\ndata NameShape = NameShape {\n        ns_mod_name :: ModuleName,\n        ns_exports :: [AvailInfo],\n        ns_map :: OccEnv Name\n    }\n-}\n\n-- NB: substitution functions need 'HscEnv' since they need the name cache\n-- to allocate new names if we change the 'Module' of a 'Name'\n\n-- | Create an empty 'NameShape' (i.e., the renaming that\n-- would occur with an implementing module with no exports)\n-- for a specific hole @mod_name@.\nemptyNameShape :: ModuleName -> NameShape\nemptyNameShape mod_name = NameShape mod_name [] emptyOccEnv\n\n-- | Create a 'NameShape' corresponding to an implementing\n-- module for the hole @mod_name@ that exports a list of 'AvailInfo's.\nmkNameShape :: ModuleName -> [AvailInfo] -> NameShape\nmkNameShape mod_name as =\n    NameShape mod_name as $ mkOccEnv $ do\n        a <- as\n        n <- availName a : availNamesWithSelectors a\n        return (occName n, n)\n\n-- | Given an existing 'NameShape', merge it with a list of 'AvailInfo's\n-- with Backpack style mix-in linking.  This is used solely when merging\n-- signatures together: we successively merge the exports of each\n-- signature until we have the final, full exports of the merged signature.\n--\n-- What makes this operation nontrivial is what we are supposed to do when\n-- we want to merge in an export for M.T when we already have an existing\n-- export {H.T}.  What should happen in this case is that {H.T} should be\n-- unified with @M.T@: we've determined a more *precise* identity for the\n-- export at 'OccName' @T@.\n--\n-- Note that we don't do unrestricted unification: only name holes from\n-- @ns_mod_name ns@ are flexible.  This is because we have a much more\n-- restricted notion of shaping than in Backpack'14: we do shaping\n-- *as* we do type-checking.  Thus, once we shape a signature, its\n-- exports are *final* and we're not allowed to refine them further,\nextendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either SDoc NameShape)\nextendNameShape hsc_env ns as =\n    case uAvailInfos (ns_mod_name ns) (ns_exports ns) as of\n        Left err -> return (Left err)\n        Right nsubst -> do\n            as1 <- mapM (liftIO . substNameAvailInfo hsc_env nsubst) (ns_exports ns)\n            as2 <- mapM (liftIO . substNameAvailInfo hsc_env nsubst) as\n            let new_avails = mergeAvails as1 as2\n            return . Right $ ns {\n                ns_exports = new_avails,\n                -- TODO: stop repeatedly rebuilding the OccEnv\n                ns_map = mkOccEnv $ do\n                            a <- new_avails\n                            n <- availName a : availNames a\n                            return (occName n, n)\n                }\n\n-- | The export list associated with this 'NameShape' (i.e., what\n-- the exports of an implementing module which induces this 'NameShape'\n-- would be.)\nnameShapeExports :: NameShape -> [AvailInfo]\nnameShapeExports = ns_exports\n\n-- | Given a 'Name', substitute it according to the 'NameShape' implied\n-- substitution, i.e. map @{A.T}@ to @M.T@, if the implementing module\n-- exports @M.T@.\nsubstNameShape :: NameShape -> Name -> Name\nsubstNameShape ns n | nameModule n == ns_module ns\n                    , Just n' <- lookupOccEnv (ns_map ns) (occName n)\n                    = n'\n                    | otherwise\n                    = n\n\n-- | Like 'substNameShape', but returns @Nothing@ if no substitution\n-- works.\nmaybeSubstNameShape :: NameShape -> Name -> Maybe Name\nmaybeSubstNameShape ns n\n    | nameModule n == ns_module ns\n    = lookupOccEnv (ns_map ns) (occName n)\n    | otherwise\n    = Nothing\n\n-- | The 'Module' of any 'Name's a 'NameShape' has action over.\nns_module :: NameShape -> Module\nns_module = mkHoleModule . ns_mod_name\n\n{-\n************************************************************************\n*                                                                      *\n                        Name substitutions\n*                                                                      *\n************************************************************************\n-}\n\n-- | Substitution on @{A.T}@.  We enforce the invariant that the\n-- 'nameModule' of keys of this map have 'moduleUnitId' @hole@\n-- (meaning that if we have a hole substitution, the keys of the map\n-- are never affected.)  Alternatively, this is isomorphic to\n-- @Map ('ModuleName', 'OccName') 'Name'@.\ntype ShNameSubst = NameEnv Name\n\n-- NB: In this module, we actually only ever construct 'ShNameSubst'\n-- at a single 'ModuleName'.  But 'ShNameSubst' is more convenient to\n-- work with.\n\n-- | Substitute names in a 'Name'.\nsubstName :: ShNameSubst -> Name -> Name\nsubstName env n | Just n' <- lookupNameEnv env n = n'\n                | otherwise                      = n\n\n-- | Substitute names in an 'AvailInfo'.  This has special behavior\n-- for type constructors, where it is sufficient to substitute the 'availName'\n-- to induce a substitution on 'availNames'.\nsubstNameAvailInfo :: HscEnv -> ShNameSubst -> AvailInfo -> IO AvailInfo\nsubstNameAvailInfo _ env (Avail n) = return (Avail (substName env n))\nsubstNameAvailInfo hsc_env env (AvailTC n ns fs) =\n    let mb_mod = fmap nameModule (lookupNameEnv env n)\n    in AvailTC (substName env n)\n        <$> mapM (initIfaceLoad hsc_env . setNameModule mb_mod) ns\n        <*> mapM (setNameFieldSelector hsc_env mb_mod) fs\n\n-- | Set the 'Module' of a 'FieldSelector'\nsetNameFieldSelector :: HscEnv -> Maybe Module -> FieldLabel -> IO FieldLabel\nsetNameFieldSelector _ Nothing f = return f\nsetNameFieldSelector hsc_env mb_mod (FieldLabel l b sel) = do\n    sel' <- initIfaceLoad hsc_env $ setNameModule mb_mod sel\n    return (FieldLabel l b sel')\n\n{-\n************************************************************************\n*                                                                      *\n                        AvailInfo merging\n*                                                                      *\n************************************************************************\n-}\n\n-- | Merges to 'AvailInfo' lists together, assuming the 'AvailInfo's have\n-- already been unified ('uAvailInfos').\nmergeAvails :: [AvailInfo] -> [AvailInfo] -> [AvailInfo]\nmergeAvails as1 as2 =\n    let mkNE as = mkNameEnv [(availName a, a) | a <- as]\n    in nameEnvElts (plusNameEnv_C plusAvail (mkNE as1) (mkNE as2))\n\n{-\n************************************************************************\n*                                                                      *\n                        AvailInfo unification\n*                                                                      *\n************************************************************************\n-}\n\n-- | Unify two lists of 'AvailInfo's, given an existing substitution @subst@,\n-- with only name holes from @flexi@ unifiable (all other name holes rigid.)\nuAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst\nuAvailInfos flexi as1 as2 = -- pprTrace \"uAvailInfos\" (ppr as1 $$ ppr as2) $\n    let mkOE as = listToUFM $ do a <- as\n                                 n <- availNames a\n                                 return (nameOccName n, a)\n    in foldM (\\subst (a1, a2) -> uAvailInfo flexi subst a1 a2) emptyNameEnv\n             (eltsUFM (intersectUFM_C (,) (mkOE as1) (mkOE as2)))\n             -- Edward: I have to say, this is pretty clever.\n\n-- | Unify two 'AvailInfo's, given an existing substitution @subst@,\n-- with only name holes from @flexi@ unifiable (all other name holes rigid.)\nuAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo\n           -> Either SDoc ShNameSubst\nuAvailInfo flexi subst (Avail n1) (Avail n2) = uName flexi subst n1 n2\nuAvailInfo flexi subst (AvailTC n1 _ _) (AvailTC n2 _ _) = uName flexi subst n1 n2\nuAvailInfo _ _ a1 a2 = Left $ text \"While merging export lists, could not combine\"\n                           <+> ppr a1 <+> text \"with\" <+> ppr a2\n                           <+> parens (text \"one is a type, the other is a plain identifier\")\n\n-- | Unify two 'Name's, given an existing substitution @subst@,\n-- with only name holes from @flexi@ unifiable (all other name holes rigid.)\nuName :: ModuleName -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst\nuName flexi subst n1 n2\n    | n1 == n2      = Right subst\n    | isFlexi n1    = uHoleName flexi subst n1 n2\n    | isFlexi n2    = uHoleName flexi subst n2 n1\n    | otherwise     = Left (text \"While merging export lists, could not unify\"\n                         <+> ppr n1 <+> text \"with\" <+> ppr n2 $$ extra)\n  where\n    isFlexi n = isHoleName n && moduleName (nameModule n) == flexi\n    extra | isHoleName n1 || isHoleName n2\n          = text \"Neither name variable originates from the current signature.\"\n          | otherwise\n          = empty\n\n-- | Unify a name @h@ which 'isHoleName' with another name, given an existing\n-- substitution @subst@, with only name holes from @flexi@ unifiable (all\n-- other name holes rigid.)\nuHoleName :: ModuleName -> ShNameSubst -> Name {- hole name -} -> Name\n          -> Either SDoc ShNameSubst\nuHoleName flexi subst h n =\n    ASSERT( isHoleName h )\n    case lookupNameEnv subst h of\n        Just n' -> uName flexi subst n' n\n                -- Do a quick check if the other name is substituted.\n        Nothing | Just n' <- lookupNameEnv subst n ->\n                    ASSERT( isHoleName n ) uName flexi subst h n'\n                | otherwise ->\n                    Right (extendNameEnv subst h n)\n", "num_lines": 269}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE LambdaCase #-}\n\n-- | This module implements interface renaming, which is\n-- used to rewrite interface files on the fly when we\n-- are doing indefinite typechecking and need instantiations\n-- of modules which do not necessarily exist yet.\n\nmodule RnModIface(\n    rnModIface,\n    rnModExports,\n    tcRnModIface,\n    tcRnModExports,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport SrcLoc\nimport Outputable\nimport HscTypes\nimport Module\nimport UniqFM\nimport Avail\nimport IfaceSyn\nimport FieldLabel\nimport Var\nimport ErrUtils\n\nimport Name\nimport TcRnMonad\nimport Util\nimport Fingerprint\nimport BasicTypes\n\n-- a bit vexing\nimport {-# SOURCE #-} LoadIface\nimport DynFlags\n\nimport qualified Data.Traversable as T\n\nimport Bag\nimport Data.IORef\nimport NameShape\nimport IfaceEnv\n\ntcRnMsgMaybe :: IO (Either ErrorMessages a) -> TcM a\ntcRnMsgMaybe do_this = do\n    r <- liftIO $ do_this\n    case r of\n        Left errs -> do\n            addMessages (emptyBag, errs)\n            failM\n        Right x -> return x\n\ntcRnModIface :: [(ModuleName, Module)] -> Maybe NameShape -> ModIface -> TcM ModIface\ntcRnModIface x y z = do\n    hsc_env <- getTopEnv\n    tcRnMsgMaybe $ rnModIface hsc_env x y z\n\ntcRnModExports :: [(ModuleName, Module)] -> ModIface -> TcM [AvailInfo]\ntcRnModExports x y = do\n    hsc_env <- getTopEnv\n    tcRnMsgMaybe $ rnModExports hsc_env x y\n\nfailWithRn :: SDoc -> ShIfM a\nfailWithRn doc = do\n    errs_var <- fmap sh_if_errs getGblEnv\n    dflags <- getDynFlags\n    errs <- readTcRef errs_var\n    -- TODO: maybe associate this with a source location?\n    writeTcRef errs_var (errs `snocBag` mkPlainErrMsg dflags noSrcSpan doc)\n    failM\n\n-- | What we have is a generalized ModIface, which corresponds to\n-- a module that looks like p[A=<A>]:B.  We need a *specific* ModIface, e.g.\n-- p[A=q():A]:B (or maybe even p[A=<B>]:B) which we load\n-- up (either to merge it, or to just use during typechecking).\n--\n-- Suppose we have:\n--\n--  p[A=<A>]:M  ==>  p[A=q():A]:M\n--\n-- Substitute all occurrences of <A> with q():A (renameHoleModule).\n-- Then, for any Name of form {A.T}, replace the Name with\n-- the Name according to the exports of the implementing module.\n-- This works even for p[A=<B>]:M, since we just read in the\n-- exports of B.hi, which is assumed to be ready now.\n--\n-- This function takes an optional 'NameShape', which can be used\n-- to further refine the identities in this interface: suppose\n-- we read a declaration for {H.T} but we actually know that this\n-- should be Foo.T; then we'll also rename this (this is used\n-- when loading an interface to merge it into a requirement.)\nrnModIface :: HscEnv -> [(ModuleName, Module)] -> Maybe NameShape\n           -> ModIface -> IO (Either ErrorMessages ModIface)\nrnModIface hsc_env insts nsubst iface = do\n    initRnIface hsc_env iface insts nsubst $ do\n        mod <- rnModule (mi_module iface)\n        sig_of <- case mi_sig_of iface of\n                    Nothing -> return Nothing\n                    Just x  -> fmap Just (rnModule x)\n        exports <- mapM rnAvailInfo (mi_exports iface)\n        decls <- mapM rnIfaceDecl' (mi_decls iface)\n        insts <- mapM rnIfaceClsInst (mi_insts iface)\n        fams <- mapM rnIfaceFamInst (mi_fam_insts iface)\n        deps <- rnDependencies (mi_deps iface)\n        -- TODO:\n        -- mi_rules\n        return iface { mi_module = mod\n                     , mi_sig_of = sig_of\n                     , mi_insts = insts\n                     , mi_fam_insts = fams\n                     , mi_exports = exports\n                     , mi_decls = decls\n                     , mi_deps = deps }\n\n-- | Rename just the exports of a 'ModIface'.  Useful when we're doing\n-- shaping prior to signature merging.\nrnModExports :: HscEnv -> [(ModuleName, Module)] -> ModIface -> IO (Either ErrorMessages [AvailInfo])\nrnModExports hsc_env insts iface\n    = initRnIface hsc_env iface insts Nothing\n    $ mapM rnAvailInfo (mi_exports iface)\n\nrnDependencies :: Rename Dependencies\nrnDependencies deps = do\n    orphs  <- rnDepModules dep_orphs deps\n    finsts <- rnDepModules dep_finsts deps\n    return deps { dep_orphs = orphs, dep_finsts = finsts }\n\nrnDepModules :: (Dependencies -> [Module]) -> Dependencies -> ShIfM [Module]\nrnDepModules sel deps = do\n    hsc_env <- getTopEnv\n    hmap <- getHoleSubst\n    -- NB: It's not necessary to test if we're doing signature renaming,\n    -- because ModIface will never contain module reference for itself\n    -- in these dependencies.\n    fmap (nubSort . concat) . T.forM (sel deps) $ \\mod -> do\n        dflags <- getDynFlags\n        -- For holes, its necessary to \"see through\" the instantiation\n        -- of the hole to get accurate family instance dependencies.\n        -- For example, if B imports <A>, and <A> is instantiated with\n        -- F, we must grab and include all of the dep_finsts from\n        -- F to have an accurate transitive dep_finsts list.\n        --\n        -- However, we MUST NOT do this for regular modules.\n        -- First, for efficiency reasons, doing this\n        -- bloats the the dep_finsts list, because we *already* had\n        -- those modules in the list (it wasn't a hole module, after\n        -- all). But there's a second, more important correctness\n        -- consideration: we perform module renaming when running\n        -- --abi-hash.  In this case, GHC's contract to the user is that\n        -- it will NOT go and read out interfaces of any dependencies\n        -- (https://github.com/haskell/cabal/issues/3633); the point of\n        -- --abi-hash is just to get a hash of the on-disk interfaces\n        -- for this *specific* package.  If we go off and tug on the\n        -- interface for /everything/ in dep_finsts, we're gonna have a\n        -- bad time.  (It's safe to do do this for hole modules, though,\n        -- because the hmap for --abi-hash is always trivial, so the\n        -- interface we request is local.  Though, maybe we ought\n        -- not to do it in this case either...)\n        --\n        -- This mistake was bug #15594.\n        let mod' = renameHoleModule dflags hmap mod\n        if isHoleModule mod\n          then do iface <- liftIO . initIfaceCheck (text \"rnDepModule\") hsc_env\n                                  $ loadSysInterface (text \"rnDepModule\") mod'\n                  return (mod' : sel (mi_deps iface))\n          else return [mod']\n\n{-\n************************************************************************\n*                                                                      *\n                        ModIface substitution\n*                                                                      *\n************************************************************************\n-}\n\n-- | Run a computation in the 'ShIfM' monad.\ninitRnIface :: HscEnv -> ModIface -> [(ModuleName, Module)] -> Maybe NameShape\n            -> ShIfM a -> IO (Either ErrorMessages a)\ninitRnIface hsc_env iface insts nsubst do_this = do\n    errs_var <- newIORef emptyBag\n    let dflags = hsc_dflags hsc_env\n        hsubst = listToUFM insts\n        rn_mod = renameHoleModule dflags hsubst\n        env = ShIfEnv {\n            sh_if_module = rn_mod (mi_module iface),\n            sh_if_semantic_module = rn_mod (mi_semantic_module iface),\n            sh_if_hole_subst = listToUFM insts,\n            sh_if_shape = nsubst,\n            sh_if_errs = errs_var\n        }\n    -- Modeled off of 'initTc'\n    res <- initTcRnIf 'c' hsc_env env () $ tryM do_this\n    msgs <- readIORef errs_var\n    case res of\n        Left _                          -> return (Left msgs)\n        Right r | not (isEmptyBag msgs) -> return (Left msgs)\n                | otherwise             -> return (Right r)\n\n-- | Environment for 'ShIfM' monads.\ndata ShIfEnv = ShIfEnv {\n        -- What we are renaming the ModIface to.  It assumed that\n        -- the original mi_module of the ModIface is\n        -- @generalizeModule (mi_module iface)@.\n        sh_if_module :: Module,\n        -- The semantic module that we are renaming to\n        sh_if_semantic_module :: Module,\n        -- Cached hole substitution, e.g.\n        -- @sh_if_hole_subst == listToUFM . unitIdInsts . moduleUnitId . sh_if_module@\n        sh_if_hole_subst :: ShHoleSubst,\n        -- An optional name substitution to be applied when renaming\n        -- the names in the interface.  If this is 'Nothing', then\n        -- we just load the target interface and look at the export\n        -- list to determine the renaming.\n        sh_if_shape :: Maybe NameShape,\n        -- Mutable reference to keep track of errors (similar to 'tcl_errs')\n        sh_if_errs :: IORef ErrorMessages\n    }\n\ngetHoleSubst :: ShIfM ShHoleSubst\ngetHoleSubst = fmap sh_if_hole_subst getGblEnv\n\ntype ShIfM = TcRnIf ShIfEnv ()\ntype Rename a = a -> ShIfM a\n\n\nrnModule :: Rename Module\nrnModule mod = do\n    hmap <- getHoleSubst\n    dflags <- getDynFlags\n    return (renameHoleModule dflags hmap mod)\n\nrnAvailInfo :: Rename AvailInfo\nrnAvailInfo (Avail n) = Avail <$> rnIfaceGlobal n\nrnAvailInfo (AvailTC n ns fs) = do\n    -- Why don't we rnIfaceGlobal the availName itself?  It may not\n    -- actually be exported by the module it putatively is from, in\n    -- which case we won't be able to tell what the name actually\n    -- is.  But for the availNames they MUST be exported, so they\n    -- will rename fine.\n    ns' <- mapM rnIfaceGlobal ns\n    fs' <- mapM rnFieldLabel fs\n    case ns' ++ map flSelector fs' of\n        [] -> panic \"rnAvailInfoEmpty AvailInfo\"\n        (rep:rest) -> ASSERT2( all ((== nameModule rep) . nameModule) rest, ppr rep $$ hcat (map ppr rest) ) do\n                         n' <- setNameModule (Just (nameModule rep)) n\n                         return (AvailTC n' ns' fs')\n\nrnFieldLabel :: Rename FieldLabel\nrnFieldLabel (FieldLabel l b sel) = do\n    sel' <- rnIfaceGlobal sel\n    return (FieldLabel l b sel')\n\n\n\n\n-- | The key function.  This gets called on every Name embedded\n-- inside a ModIface.  Our job is to take a Name from some\n-- generalized unit ID p[A=<A>, B=<B>], and change\n-- it to the correct name for a (partially) instantiated unit\n-- ID, e.g. p[A=q[]:A, B=<B>].\n--\n-- There are two important things to do:\n--\n-- If a hole is substituted with a real module implementation,\n-- we need to look at that actual implementation to determine what\n-- the true identity of this name should be.  We'll do this by\n-- loading that module's interface and looking at the mi_exports.\n--\n-- However, there is one special exception: when we are loading\n-- the interface of a requirement.  In this case, we may not have\n-- the \"implementing\" interface, because we are reading this\n-- interface precisely to \"merge it in\".\n--\n--     External case:\n--         p[A=<B>]:A (and thisUnitId is something else)\n--     We are loading this in order to determine B.hi!  So\n--     don't load B.hi to find the exports.\n--\n--     Local case:\n--         p[A=<A>]:A (and thisUnitId is p[A=<A>])\n--     This should not happen, because the rename is not necessary\n--     in this case, but if it does we shouldn't load A.hi!\n--\n-- Compare me with 'tcIfaceGlobal'!\n\n-- In effect, this function needs compute the name substitution on the\n-- fly.  What it has is the name that we would like to substitute.\n-- If the name is not a hole name {M.x} (e.g. isHoleModule) then\n-- no renaming can take place (although the inner hole structure must\n-- be updated to account for the hole module renaming.)\nrnIfaceGlobal :: Name -> ShIfM Name\nrnIfaceGlobal n = do\n    hsc_env <- getTopEnv\n    let dflags = hsc_dflags hsc_env\n    iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv\n    mb_nsubst <- fmap sh_if_shape getGblEnv\n    hmap <- getHoleSubst\n    let m = nameModule n\n        m' = renameHoleModule dflags hmap m\n    case () of\n       -- Did we encounter {A.T} while renaming p[A=<B>]:A? If so,\n       -- do NOT assume B.hi is available.\n       -- In this case, rename {A.T} to {B.T} but don't look up exports.\n     _ | m' == iface_semantic_mod\n       , isHoleModule m'\n      -- NB: this could be Nothing for computeExports, we have\n      -- nothing to say.\n      -> do n' <- setNameModule (Just m') n\n            case mb_nsubst of\n                Nothing -> return n'\n                Just nsubst ->\n                    case maybeSubstNameShape nsubst n' of\n                        -- TODO: would love to have context\n                        -- TODO: This will give an unpleasant message if n'\n                        -- is a constructor; then we'll suggest adding T\n                        -- but it won't work.\n                        Nothing -> failWithRn $ vcat [\n                            text \"The identifier\" <+> ppr (occName n') <+>\n                                text \"does not exist in the local signature.\",\n                            parens (text \"Try adding it to the export list of the hsig file.\")\n                            ]\n                        Just n'' -> return n''\n       -- Fastpath: we are renaming p[H=<H>]:A.T, in which case the\n       -- export list is irrelevant.\n       | not (isHoleModule m)\n      -> setNameModule (Just m') n\n       -- The substitution was from <A> to p[]:A.\n       -- But this does not mean {A.T} goes to p[]:A.T:\n       -- p[]:A may reexport T from somewhere else.  Do the name\n       -- substitution.  Furthermore, we need\n       -- to make sure we pick the accurate name NOW,\n       -- or we might accidentally reject a merge.\n       | otherwise\n      -> do -- Make sure we look up the local interface if substitution\n            -- went from <A> to <B>.\n            let m'' = if isHoleModule m'\n                        -- Pull out the local guy!!\n                        then mkModule (thisPackage dflags) (moduleName m')\n                        else m'\n            iface <- liftIO . initIfaceCheck (text \"rnIfaceGlobal\") hsc_env\n                            $ loadSysInterface (text \"rnIfaceGlobal\") m''\n            let nsubst = mkNameShape (moduleName m) (mi_exports iface)\n            case maybeSubstNameShape nsubst n of\n                Nothing -> failWithRn $ vcat [\n                    text \"The identifier\" <+> ppr (occName n) <+>\n                        -- NB: report m' because it's more user-friendly\n                        text \"does not exist in the signature for\" <+> ppr m',\n                    parens (text \"Try adding it to the export list in that hsig file.\")\n                    ]\n                Just n' -> return n'\n\n-- | Rename an implicit name, e.g., a DFun or coercion axiom.\n-- Here is where we ensure that DFuns have the correct module as described in\n-- Note [rnIfaceNeverExported].\nrnIfaceNeverExported :: Name -> ShIfM Name\nrnIfaceNeverExported name = do\n    hmap <- getHoleSubst\n    dflags <- getDynFlags\n    iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv\n    let m = renameHoleModule dflags hmap $ nameModule name\n    -- Doublecheck that this DFun/coercion axiom was, indeed, locally defined.\n    MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m )\n    setNameModule (Just m) name\n\n-- Note [rnIfaceNeverExported]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- For the high-level overview, see\n-- Note [Handling never-exported TyThings under Backpack]\n--\n-- When we see a reference to an entity that was defined in a signature,\n-- 'rnIfaceGlobal' relies on the identifier in question being part of the\n-- exports of the implementing 'ModIface', so that we can use the exports to\n-- decide how to rename the identifier.  Unfortunately, references to 'DFun's\n-- and 'CoAxiom's will run into trouble under this strategy, because they are\n-- never exported.\n--\n-- Let us consider first what should happen in the absence of promotion.  In\n-- this setting, a reference to a 'DFun' or a 'CoAxiom' can only occur inside\n-- the signature *that is defining it* (as there are no Core terms in\n-- typechecked-only interface files, there's no way for a reference to occur\n-- besides from the defining 'ClsInst' or closed type family).  Thus,\n-- it doesn't really matter what names we give the DFun/CoAxiom, as long\n-- as it's consistent between the declaration site and the use site.\n--\n-- We have to make sure that these bogus names don't get propagated,\n-- but it is fine: see Note [Signature merging DFuns] for the fixups\n-- to the names we do before writing out the merged interface.\n-- (It's even easier for instantiation, since the DFuns all get\n-- dropped entirely; the instances are reexported implicitly.)\n--\n-- Unfortunately, this strategy is not enough in the presence of promotion\n-- (see bug #13149), where modules which import the signature may make\n-- reference to their coercions.  It's not altogether clear how to\n-- fix this case, but it is definitely a bug!\n\n-- PILES AND PILES OF BOILERPLATE\n\n-- | Rename an 'IfaceClsInst', with special handling for an associated\n-- dictionary function.\nrnIfaceClsInst :: Rename IfaceClsInst\nrnIfaceClsInst cls_inst = do\n    n <- rnIfaceGlobal (ifInstCls cls_inst)\n    tys <- mapM rnMaybeIfaceTyCon (ifInstTys cls_inst)\n\n    dfun <- rnIfaceNeverExported (ifDFun cls_inst)\n    return cls_inst { ifInstCls = n\n                    , ifInstTys = tys\n                    , ifDFun = dfun\n                    }\n\nrnMaybeIfaceTyCon :: Rename (Maybe IfaceTyCon)\nrnMaybeIfaceTyCon Nothing = return Nothing\nrnMaybeIfaceTyCon (Just tc) = Just <$> rnIfaceTyCon tc\n\nrnIfaceFamInst :: Rename IfaceFamInst\nrnIfaceFamInst d = do\n    fam <- rnIfaceGlobal (ifFamInstFam d)\n    tys <- mapM rnMaybeIfaceTyCon (ifFamInstTys d)\n    axiom <- rnIfaceGlobal (ifFamInstAxiom d)\n    return d { ifFamInstFam = fam, ifFamInstTys = tys, ifFamInstAxiom = axiom }\n\nrnIfaceDecl' :: Rename (Fingerprint, IfaceDecl)\nrnIfaceDecl' (fp, decl) = (,) fp <$> rnIfaceDecl decl\n\nrnIfaceDecl :: Rename IfaceDecl\nrnIfaceDecl d@IfaceId{} = do\n            name <- case ifIdDetails d of\n                      IfDFunId -> rnIfaceNeverExported (ifName d)\n                      _ | isDefaultMethodOcc (occName (ifName d))\n                        -> rnIfaceNeverExported (ifName d)\n                      -- Typeable bindings. See Note [Grand plan for Typeable].\n                      _ | isTypeableBindOcc (occName (ifName d))\n                        -> rnIfaceNeverExported (ifName d)\n                        | otherwise -> rnIfaceGlobal (ifName d)\n            ty <- rnIfaceType (ifType d)\n            details <- rnIfaceIdDetails (ifIdDetails d)\n            info <- rnIfaceIdInfo (ifIdInfo d)\n            return d { ifName = name\n                     , ifType = ty\n                     , ifIdDetails = details\n                     , ifIdInfo = info\n                     }\nrnIfaceDecl d@IfaceData{} = do\n            name <- rnIfaceGlobal (ifName d)\n            binders <- mapM rnIfaceTyConBinder (ifBinders d)\n            ctxt <- mapM rnIfaceType (ifCtxt d)\n            cons <- rnIfaceConDecls (ifCons d)\n            res_kind <- rnIfaceType (ifResKind d)\n            parent <- rnIfaceTyConParent (ifParent d)\n            return d { ifName = name\n                     , ifBinders = binders\n                     , ifCtxt = ctxt\n                     , ifCons = cons\n                     , ifResKind = res_kind\n                     , ifParent = parent\n                     }\nrnIfaceDecl d@IfaceSynonym{} = do\n            name <- rnIfaceGlobal (ifName d)\n            binders <- mapM rnIfaceTyConBinder (ifBinders d)\n            syn_kind <- rnIfaceType (ifResKind d)\n            syn_rhs <- rnIfaceType (ifSynRhs d)\n            return d { ifName = name\n                     , ifBinders = binders\n                     , ifResKind = syn_kind\n                     , ifSynRhs = syn_rhs\n                     }\nrnIfaceDecl d@IfaceFamily{} = do\n            name <- rnIfaceGlobal (ifName d)\n            binders <- mapM rnIfaceTyConBinder (ifBinders d)\n            fam_kind <- rnIfaceType (ifResKind d)\n            fam_flav <- rnIfaceFamTyConFlav (ifFamFlav d)\n            return d { ifName = name\n                     , ifBinders = binders\n                     , ifResKind = fam_kind\n                     , ifFamFlav = fam_flav\n                     }\nrnIfaceDecl d@IfaceClass{} = do\n            name <- rnIfaceGlobal (ifName d)\n            binders <- mapM rnIfaceTyConBinder (ifBinders d)\n            body <- rnIfaceClassBody (ifBody d)\n            return d { ifName    = name\n                     , ifBinders = binders\n                     , ifBody    = body\n                     }\nrnIfaceDecl d@IfaceAxiom{} = do\n            name <- rnIfaceNeverExported (ifName d)\n            tycon <- rnIfaceTyCon (ifTyCon d)\n            ax_branches <- mapM rnIfaceAxBranch (ifAxBranches d)\n            return d { ifName = name\n                     , ifTyCon = tycon\n                     , ifAxBranches = ax_branches\n                     }\nrnIfaceDecl d@IfacePatSyn{} =  do\n            name <- rnIfaceGlobal (ifName d)\n            let rnPat (n, b) = (,) <$> rnIfaceGlobal n <*> pure b\n            pat_matcher <- rnPat (ifPatMatcher d)\n            pat_builder <- T.traverse rnPat (ifPatBuilder d)\n            pat_univ_bndrs <- mapM rnIfaceForAllBndr (ifPatUnivBndrs d)\n            pat_ex_bndrs <- mapM rnIfaceForAllBndr (ifPatExBndrs d)\n            pat_prov_ctxt <- mapM rnIfaceType (ifPatProvCtxt d)\n            pat_req_ctxt <- mapM rnIfaceType (ifPatReqCtxt d)\n            pat_args <- mapM rnIfaceType (ifPatArgs d)\n            pat_ty <- rnIfaceType (ifPatTy d)\n            return d { ifName = name\n                     , ifPatMatcher = pat_matcher\n                     , ifPatBuilder = pat_builder\n                     , ifPatUnivBndrs = pat_univ_bndrs\n                     , ifPatExBndrs = pat_ex_bndrs\n                     , ifPatProvCtxt = pat_prov_ctxt\n                     , ifPatReqCtxt = pat_req_ctxt\n                     , ifPatArgs = pat_args\n                     , ifPatTy = pat_ty\n                     }\n\nrnIfaceClassBody :: Rename IfaceClassBody\nrnIfaceClassBody IfAbstractClass = return IfAbstractClass\nrnIfaceClassBody d@IfConcreteClass{} = do\n    ctxt <- mapM rnIfaceType (ifClassCtxt d)\n    ats <- mapM rnIfaceAT (ifATs d)\n    sigs <- mapM rnIfaceClassOp (ifSigs d)\n    return d { ifClassCtxt = ctxt, ifATs = ats, ifSigs = sigs }\n\nrnIfaceFamTyConFlav :: Rename IfaceFamTyConFlav\nrnIfaceFamTyConFlav (IfaceClosedSynFamilyTyCon (Just (n, axs)))\n    = IfaceClosedSynFamilyTyCon . Just <$> ((,) <$> rnIfaceNeverExported n\n                                                <*> mapM rnIfaceAxBranch axs)\nrnIfaceFamTyConFlav flav = pure flav\n\nrnIfaceAT :: Rename IfaceAT\nrnIfaceAT (IfaceAT decl mb_ty)\n    = IfaceAT <$> rnIfaceDecl decl <*> T.traverse rnIfaceType mb_ty\n\nrnIfaceTyConParent :: Rename IfaceTyConParent\nrnIfaceTyConParent (IfDataInstance n tc args)\n    = IfDataInstance <$> rnIfaceGlobal n\n                     <*> rnIfaceTyCon tc\n                     <*> rnIfaceAppArgs args\nrnIfaceTyConParent IfNoParent = pure IfNoParent\n\nrnIfaceConDecls :: Rename IfaceConDecls\nrnIfaceConDecls (IfDataTyCon ds)\n    = IfDataTyCon <$> mapM rnIfaceConDecl ds\nrnIfaceConDecls (IfNewTyCon d) = IfNewTyCon <$> rnIfaceConDecl d\nrnIfaceConDecls IfAbstractTyCon = pure IfAbstractTyCon\n\nrnIfaceConDecl :: Rename IfaceConDecl\nrnIfaceConDecl d = do\n    con_name <- rnIfaceGlobal (ifConName d)\n    con_ex_tvs <- mapM rnIfaceBndr (ifConExTCvs d)\n    con_user_tvbs <- mapM rnIfaceForAllBndr (ifConUserTvBinders d)\n    let rnIfConEqSpec (n,t) = (,) n <$> rnIfaceType t\n    con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d)\n    con_ctxt <- mapM rnIfaceType (ifConCtxt d)\n    con_arg_tys <- mapM rnIfaceType (ifConArgTys d)\n    con_fields <- mapM rnFieldLabel (ifConFields d)\n    let rnIfaceBang (IfUnpackCo co) = IfUnpackCo <$> rnIfaceCo co\n        rnIfaceBang bang = pure bang\n    con_stricts <- mapM rnIfaceBang (ifConStricts d)\n    return d { ifConName = con_name\n             , ifConExTCvs = con_ex_tvs\n             , ifConUserTvBinders = con_user_tvbs\n             , ifConEqSpec = con_eq_spec\n             , ifConCtxt = con_ctxt\n             , ifConArgTys = con_arg_tys\n             , ifConFields = con_fields\n             , ifConStricts = con_stricts\n             }\n\nrnIfaceClassOp :: Rename IfaceClassOp\nrnIfaceClassOp (IfaceClassOp n ty dm) =\n    IfaceClassOp <$> rnIfaceGlobal n\n                 <*> rnIfaceType ty\n                 <*> rnMaybeDefMethSpec dm\n\nrnMaybeDefMethSpec :: Rename (Maybe (DefMethSpec IfaceType))\nrnMaybeDefMethSpec (Just (GenericDM ty)) = Just . GenericDM <$> rnIfaceType ty\nrnMaybeDefMethSpec mb = return mb\n\nrnIfaceAxBranch :: Rename IfaceAxBranch\nrnIfaceAxBranch d = do\n    ty_vars <- mapM rnIfaceTvBndr (ifaxbTyVars d)\n    lhs <- rnIfaceAppArgs (ifaxbLHS d)\n    rhs <- rnIfaceType (ifaxbRHS d)\n    return d { ifaxbTyVars = ty_vars\n             , ifaxbLHS = lhs\n             , ifaxbRHS = rhs }\n\nrnIfaceIdInfo :: Rename IfaceIdInfo\nrnIfaceIdInfo NoInfo = pure NoInfo\nrnIfaceIdInfo (HasInfo is) = HasInfo <$> mapM rnIfaceInfoItem is\n\nrnIfaceInfoItem :: Rename IfaceInfoItem\nrnIfaceInfoItem (HsUnfold lb if_unf)\n    = HsUnfold lb <$> rnIfaceUnfolding if_unf\nrnIfaceInfoItem i\n    = pure i\n\nrnIfaceUnfolding :: Rename IfaceUnfolding\nrnIfaceUnfolding (IfCoreUnfold stable if_expr)\n    = IfCoreUnfold stable <$> rnIfaceExpr if_expr\nrnIfaceUnfolding (IfCompulsory if_expr)\n    = IfCompulsory <$> rnIfaceExpr if_expr\nrnIfaceUnfolding (IfInlineRule arity unsat_ok boring_ok if_expr)\n    = IfInlineRule arity unsat_ok boring_ok <$> rnIfaceExpr if_expr\nrnIfaceUnfolding (IfDFunUnfold bs ops)\n    = IfDFunUnfold <$> rnIfaceBndrs bs <*> mapM rnIfaceExpr ops\n\nrnIfaceExpr :: Rename IfaceExpr\nrnIfaceExpr (IfaceLcl name) = pure (IfaceLcl name)\nrnIfaceExpr (IfaceExt gbl) = IfaceExt <$> rnIfaceGlobal gbl\nrnIfaceExpr (IfaceType ty) = IfaceType <$> rnIfaceType ty\nrnIfaceExpr (IfaceCo co) = IfaceCo <$> rnIfaceCo co\nrnIfaceExpr (IfaceTuple sort args) = IfaceTuple sort <$> rnIfaceExprs args\nrnIfaceExpr (IfaceLam lam_bndr expr)\n    = IfaceLam <$> rnIfaceLamBndr lam_bndr <*> rnIfaceExpr expr\nrnIfaceExpr (IfaceApp fun arg)\n    = IfaceApp <$> rnIfaceExpr fun <*> rnIfaceExpr arg\nrnIfaceExpr (IfaceCase scrut case_bndr alts)\n    = IfaceCase <$> rnIfaceExpr scrut\n                <*> pure case_bndr\n                <*> mapM rnIfaceAlt alts\nrnIfaceExpr (IfaceECase scrut ty)\n    = IfaceECase <$> rnIfaceExpr scrut <*> rnIfaceType ty\nrnIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)\n    = IfaceLet <$> (IfaceNonRec <$> rnIfaceLetBndr bndr <*> rnIfaceExpr rhs)\n               <*> rnIfaceExpr body\nrnIfaceExpr (IfaceLet (IfaceRec pairs) body)\n    = IfaceLet <$> (IfaceRec <$> mapM (\\(bndr, rhs) ->\n                                        (,) <$> rnIfaceLetBndr bndr\n                                            <*> rnIfaceExpr rhs) pairs)\n               <*> rnIfaceExpr body\nrnIfaceExpr (IfaceCast expr co)\n    = IfaceCast <$> rnIfaceExpr expr <*> rnIfaceCo co\nrnIfaceExpr (IfaceLit lit) = pure (IfaceLit lit)\nrnIfaceExpr (IfaceFCall cc ty) = IfaceFCall cc <$> rnIfaceType ty\nrnIfaceExpr (IfaceTick tickish expr) = IfaceTick tickish <$> rnIfaceExpr expr\n\nrnIfaceBndrs :: Rename [IfaceBndr]\nrnIfaceBndrs = mapM rnIfaceBndr\n\nrnIfaceBndr :: Rename IfaceBndr\nrnIfaceBndr (IfaceIdBndr (fs, ty)) = IfaceIdBndr <$> ((,) fs <$> rnIfaceType ty)\nrnIfaceBndr (IfaceTvBndr tv_bndr) = IfaceTvBndr <$> rnIfaceTvBndr tv_bndr\n\nrnIfaceTvBndr :: Rename IfaceTvBndr\nrnIfaceTvBndr (fs, kind) = (,) fs <$> rnIfaceType kind\n\nrnIfaceTyConBinder :: Rename IfaceTyConBinder\nrnIfaceTyConBinder (Bndr tv vis) = Bndr <$> rnIfaceBndr tv <*> pure vis\n\nrnIfaceAlt :: Rename IfaceAlt\nrnIfaceAlt (conalt, names, rhs)\n     = (,,) <$> rnIfaceConAlt conalt <*> pure names <*> rnIfaceExpr rhs\n\nrnIfaceConAlt :: Rename IfaceConAlt\nrnIfaceConAlt (IfaceDataAlt data_occ) = IfaceDataAlt <$> rnIfaceGlobal data_occ\nrnIfaceConAlt alt = pure alt\n\nrnIfaceLetBndr :: Rename IfaceLetBndr\nrnIfaceLetBndr (IfLetBndr fs ty info jpi)\n    = IfLetBndr fs <$> rnIfaceType ty <*> rnIfaceIdInfo info <*> pure jpi\n\nrnIfaceLamBndr :: Rename IfaceLamBndr\nrnIfaceLamBndr (bndr, oneshot) = (,) <$> rnIfaceBndr bndr <*> pure oneshot\n\nrnIfaceMCo :: Rename IfaceMCoercion\nrnIfaceMCo IfaceMRefl    = pure IfaceMRefl\nrnIfaceMCo (IfaceMCo co) = IfaceMCo <$> rnIfaceCo co\n\nrnIfaceCo :: Rename IfaceCoercion\nrnIfaceCo (IfaceReflCo ty) = IfaceReflCo <$> rnIfaceType ty\nrnIfaceCo (IfaceGReflCo role ty mco)\n  = IfaceGReflCo role <$> rnIfaceType ty <*> rnIfaceMCo mco\nrnIfaceCo (IfaceFunCo role co1 co2)\n    = IfaceFunCo role <$> rnIfaceCo co1 <*> rnIfaceCo co2\nrnIfaceCo (IfaceTyConAppCo role tc cos)\n    = IfaceTyConAppCo role <$> rnIfaceTyCon tc <*> mapM rnIfaceCo cos\nrnIfaceCo (IfaceAppCo co1 co2)\n    = IfaceAppCo <$> rnIfaceCo co1 <*> rnIfaceCo co2\nrnIfaceCo (IfaceForAllCo bndr co1 co2)\n    = IfaceForAllCo <$> rnIfaceBndr bndr <*> rnIfaceCo co1 <*> rnIfaceCo co2\nrnIfaceCo (IfaceFreeCoVar c) = pure (IfaceFreeCoVar c)\nrnIfaceCo (IfaceCoVarCo lcl) = IfaceCoVarCo <$> pure lcl\nrnIfaceCo (IfaceHoleCo lcl)  = IfaceHoleCo  <$> pure lcl\nrnIfaceCo (IfaceAxiomInstCo n i cs)\n    = IfaceAxiomInstCo <$> rnIfaceGlobal n <*> pure i <*> mapM rnIfaceCo cs\nrnIfaceCo (IfaceUnivCo s r t1 t2)\n    = IfaceUnivCo s r <$> rnIfaceType t1 <*> rnIfaceType t2\nrnIfaceCo (IfaceSymCo c)\n    = IfaceSymCo <$> rnIfaceCo c\nrnIfaceCo (IfaceTransCo c1 c2)\n    = IfaceTransCo <$> rnIfaceCo c1 <*> rnIfaceCo c2\nrnIfaceCo (IfaceInstCo c1 c2)\n    = IfaceInstCo <$> rnIfaceCo c1 <*> rnIfaceCo c2\nrnIfaceCo (IfaceNthCo d c) = IfaceNthCo d <$> rnIfaceCo c\nrnIfaceCo (IfaceLRCo lr c) = IfaceLRCo lr <$> rnIfaceCo c\nrnIfaceCo (IfaceSubCo c) = IfaceSubCo <$> rnIfaceCo c\nrnIfaceCo (IfaceAxiomRuleCo ax cos)\n    = IfaceAxiomRuleCo ax <$> mapM rnIfaceCo cos\nrnIfaceCo (IfaceKindCo c) = IfaceKindCo <$> rnIfaceCo c\n\nrnIfaceTyCon :: Rename IfaceTyCon\nrnIfaceTyCon (IfaceTyCon n info)\n    = IfaceTyCon <$> rnIfaceGlobal n <*> pure info\n\nrnIfaceExprs :: Rename [IfaceExpr]\nrnIfaceExprs = mapM rnIfaceExpr\n\nrnIfaceIdDetails :: Rename IfaceIdDetails\nrnIfaceIdDetails (IfRecSelId (Left tc) b) = IfRecSelId <$> fmap Left (rnIfaceTyCon tc) <*> pure b\nrnIfaceIdDetails (IfRecSelId (Right decl) b) = IfRecSelId <$> fmap Right (rnIfaceDecl decl) <*> pure b\nrnIfaceIdDetails details = pure details\n\nrnIfaceType :: Rename IfaceType\nrnIfaceType (IfaceFreeTyVar n) = pure (IfaceFreeTyVar n)\nrnIfaceType (IfaceTyVar   n)   = pure (IfaceTyVar n)\nrnIfaceType (IfaceAppTy t1 t2)\n    = IfaceAppTy <$> rnIfaceType t1 <*> rnIfaceAppArgs t2\nrnIfaceType (IfaceLitTy l)         = return (IfaceLitTy l)\nrnIfaceType (IfaceFunTy af t1 t2)\n    = IfaceFunTy af <$> rnIfaceType t1 <*> rnIfaceType t2\nrnIfaceType (IfaceTupleTy s i tks)\n    = IfaceTupleTy s i <$> rnIfaceAppArgs tks\nrnIfaceType (IfaceTyConApp tc tks)\n    = IfaceTyConApp <$> rnIfaceTyCon tc <*> rnIfaceAppArgs tks\nrnIfaceType (IfaceForAllTy tv t)\n    = IfaceForAllTy <$> rnIfaceForAllBndr tv <*> rnIfaceType t\nrnIfaceType (IfaceCoercionTy co)\n    = IfaceCoercionTy <$> rnIfaceCo co\nrnIfaceType (IfaceCastTy ty co)\n    = IfaceCastTy <$> rnIfaceType ty <*> rnIfaceCo co\n\nrnIfaceForAllBndr :: Rename IfaceForAllBndr\nrnIfaceForAllBndr (Bndr tv vis) = Bndr <$> rnIfaceBndr tv <*> pure vis\n\nrnIfaceAppArgs :: Rename IfaceAppArgs\nrnIfaceAppArgs (IA_Arg t a ts) = IA_Arg <$> rnIfaceType t <*> pure a\n                                        <*> rnIfaceAppArgs ts\nrnIfaceAppArgs IA_Nil = pure IA_Nil\n", "num_lines": 744}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n--\n-- (c) The University of Glasgow\n--\n\n#include \"HsVersions.h\"\n\nmodule Avail (\n    Avails,\n    AvailInfo(..),\n    avail,\n    availsToNameSet,\n    availsToNameSetWithSelectors,\n    availsToNameEnv,\n    availName, availNames, availNonFldNames,\n    availNamesWithSelectors,\n    availFlds,\n    availsNamesWithOccs,\n    availNamesWithOccs,\n    stableAvailCmp,\n    plusAvail,\n    trimAvail,\n    filterAvail,\n    filterAvails,\n    nubAvails\n\n\n  ) where\n\nimport GhcPrelude\n\nimport Name\nimport NameEnv\nimport NameSet\n\nimport FieldLabel\nimport Binary\nimport ListSetOps\nimport Outputable\nimport Util\n\nimport Data.Data ( Data )\nimport Data.List ( find )\nimport Data.Function\n\n-- -----------------------------------------------------------------------------\n-- The AvailInfo type\n\n-- | Records what things are \\\"available\\\", i.e. in scope\ndata AvailInfo\n\n  -- | An ordinary identifier in scope\n  = Avail Name\n\n  -- | A type or class in scope\n  --\n  -- The __AvailTC Invariant__: If the type or class is itself to be in scope,\n  -- it must be /first/ in this list.  Thus, typically:\n  --\n  -- > AvailTC Eq [Eq, ==, \\/=] []\n  | AvailTC\n       Name         -- ^ The name of the type or class\n       [Name]       -- ^ The available pieces of type or class,\n                    -- excluding field selectors.\n       [FieldLabel] -- ^ The record fields of the type\n                    -- (see Note [Representing fields in AvailInfo]).\n\n   deriving ( Eq    -- ^ Used when deciding if the interface has changed\n            , Data )\n\n-- | A collection of 'AvailInfo' - several things that are \\\"available\\\"\ntype Avails = [AvailInfo]\n\n{-\nNote [Representing fields in AvailInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen -XDuplicateRecordFields is disabled (the normal case), a\ndatatype like\n\n  data T = MkT { foo :: Int }\n\ngives rise to the AvailInfo\n\n  AvailTC T [T, MkT] [FieldLabel \"foo\" False foo]\n\nwhereas if -XDuplicateRecordFields is enabled it gives\n\n  AvailTC T [T, MkT] [FieldLabel \"foo\" True $sel:foo:MkT]\n\nsince the label does not match the selector name.\n\nThe labels in a field list are not necessarily unique:\ndata families allow the same parent (the family tycon) to have\nmultiple distinct fields with the same label. For example,\n\n  data family F a\n  data instance F Int  = MkFInt { foo :: Int }\n  data instance F Bool = MkFBool { foo :: Bool}\n\ngives rise to\n\n  AvailTC F [ F, MkFInt, MkFBool ]\n            [ FieldLabel \"foo\" True $sel:foo:MkFInt\n            , FieldLabel \"foo\" True $sel:foo:MkFBool ]\n\nMoreover, note that the flIsOverloaded flag need not be the same for\nall the elements of the list.  In the example above, this occurs if\nthe two data instances are defined in different modules, one with\n`-XDuplicateRecordFields` enabled and one with it disabled.  Thus it\nis possible to have\n\n  AvailTC F [ F, MkFInt, MkFBool ]\n            [ FieldLabel \"foo\" True $sel:foo:MkFInt\n            , FieldLabel \"foo\" False foo ]\n\nIf the two data instances are defined in different modules, both\nwithout `-XDuplicateRecordFields`, it will be impossible to export\nthem from the same module (even with `-XDuplicateRecordfields`\nenabled), because they would be represented identically.  The\nworkaround here is to enable `-XDuplicateRecordFields` on the defining\nmodules.\n-}\n\n-- | Compare lexicographically\nstableAvailCmp :: AvailInfo -> AvailInfo -> Ordering\nstableAvailCmp (Avail n1)       (Avail n2)   = n1 `stableNameCmp` n2\nstableAvailCmp (Avail {})         (AvailTC {})   = LT\nstableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) =\n    (n `stableNameCmp` m) `thenCmp`\n    (cmpList stableNameCmp ns ms) `thenCmp`\n    (cmpList (stableNameCmp `on` flSelector) nfs mfs)\nstableAvailCmp (AvailTC {})       (Avail {})     = GT\n\navail :: Name -> AvailInfo\navail n = Avail n\n\n-- -----------------------------------------------------------------------------\n-- Operations on AvailInfo\n\navailsToNameSet :: [AvailInfo] -> NameSet\navailsToNameSet avails = foldr add emptyNameSet avails\n      where add avail set = extendNameSetList set (availNames avail)\n\navailsToNameSetWithSelectors :: [AvailInfo] -> NameSet\navailsToNameSetWithSelectors avails = foldr add emptyNameSet avails\n      where add avail set = extendNameSetList set (availNamesWithSelectors avail)\n\navailsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo\navailsToNameEnv avails = foldr add emptyNameEnv avails\n     where add avail env = extendNameEnvList env\n                                (zip (availNames avail) (repeat avail))\n\n-- | Just the main name made available, i.e. not the available pieces\n-- of type or class brought into scope by the 'GenAvailInfo'\navailName :: AvailInfo -> Name\navailName (Avail n)     = n\navailName (AvailTC n _ _) = n\n\n-- | All names made available by the availability information (excluding overloaded selectors)\navailNames :: AvailInfo -> [Name]\navailNames (Avail n)         = [n]\navailNames (AvailTC _ ns fs) = ns ++ [ flSelector f | f <- fs, not (flIsOverloaded f) ]\n\n-- | All names made available by the availability information (including overloaded selectors)\navailNamesWithSelectors :: AvailInfo -> [Name]\navailNamesWithSelectors (Avail n)         = [n]\navailNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs\n\n-- | Names for non-fields made available by the availability information\navailNonFldNames :: AvailInfo -> [Name]\navailNonFldNames (Avail n)        = [n]\navailNonFldNames (AvailTC _ ns _) = ns\n\n-- | Fields made available by the availability information\navailFlds :: AvailInfo -> [FieldLabel]\navailFlds (AvailTC _ _ fs) = fs\navailFlds _                = []\n\navailsNamesWithOccs :: [AvailInfo] -> [(Name, OccName)]\navailsNamesWithOccs = concatMap availNamesWithOccs\n\n-- | 'Name's made available by the availability information, paired with\n-- the 'OccName' used to refer to each one.\n--\n-- When @DuplicateRecordFields@ is in use, the 'Name' may be the\n-- mangled name of a record selector (e.g. @$sel:foo:MkT@) while the\n-- 'OccName' will be the label of the field (e.g. @foo@).\n--\n-- See Note [Representing fields in AvailInfo].\navailNamesWithOccs :: AvailInfo -> [(Name, OccName)]\navailNamesWithOccs (Avail n) = [(n, nameOccName n)]\navailNamesWithOccs (AvailTC _ ns fs)\n  = [ (n, nameOccName n) | n <- ns ] ++\n    [ (flSelector fl, mkVarOccFS (flLabel fl)) | fl <- fs ]\n\n-- -----------------------------------------------------------------------------\n-- Utility\n\nplusAvail :: AvailInfo -> AvailInfo -> AvailInfo\nplusAvail a1 a2\n  | debugIsOn && availName a1 /= availName a2\n  = pprPanic \"RnEnv.plusAvail names differ\" (hsep [ppr a1,ppr a2])\nplusAvail a1@(Avail {})         (Avail {})        = a1\nplusAvail (AvailTC _ [] [])     a2@(AvailTC {})   = a2\nplusAvail a1@(AvailTC {})       (AvailTC _ [] []) = a1\nplusAvail (AvailTC n1 (s1:ss1) fs1) (AvailTC n2 (s2:ss2) fs2)\n  = case (n1==s1, n2==s2) of  -- Maintain invariant the parent is first\n       (True,True)   -> AvailTC n1 (s1 : (ss1 `unionLists` ss2))\n                                   (fs1 `unionLists` fs2)\n       (True,False)  -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))\n                                   (fs1 `unionLists` fs2)\n       (False,True)  -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))\n                                   (fs1 `unionLists` fs2)\n       (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))\n                                   (fs1 `unionLists` fs2)\nplusAvail (AvailTC n1 ss1 fs1) (AvailTC _ [] fs2)\n  = AvailTC n1 ss1 (fs1 `unionLists` fs2)\nplusAvail (AvailTC n1 [] fs1)  (AvailTC _ ss2 fs2)\n  = AvailTC n1 ss2 (fs1 `unionLists` fs2)\nplusAvail a1 a2 = pprPanic \"RnEnv.plusAvail\" (hsep [ppr a1,ppr a2])\n\n-- | trims an 'AvailInfo' to keep only a single name\ntrimAvail :: AvailInfo -> Name -> AvailInfo\ntrimAvail (Avail n)         _ = Avail n\ntrimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of\n    Just x  -> AvailTC n [] [x]\n    Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []\n\n-- | filters 'AvailInfo's by the given predicate\nfilterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]\nfilterAvails keep avails = foldr (filterAvail keep) [] avails\n\n-- | filters an 'AvailInfo' by the given predicate\nfilterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]\nfilterAvail keep ie rest =\n  case ie of\n    Avail n | keep n    -> ie : rest\n            | otherwise -> rest\n    AvailTC tc ns fs ->\n        let ns' = filter keep ns\n            fs' = filter (keep . flSelector) fs in\n        if null ns' && null fs' then rest else AvailTC tc ns' fs' : rest\n\n\n-- | Combines 'AvailInfo's from the same family\n-- 'avails' may have several items with the same availName\n-- E.g  import Ix( Ix(..), index )\n-- will give Ix(Ix,index,range) and Ix(index)\n-- We want to combine these; addAvail does that\nnubAvails :: [AvailInfo] -> [AvailInfo]\nnubAvails avails = nameEnvElts (foldl' add emptyNameEnv avails)\n  where\n    add env avail = extendNameEnv_C plusAvail env (availName avail) avail\n\n-- -----------------------------------------------------------------------------\n-- Printing\n\ninstance Outputable AvailInfo where\n   ppr = pprAvail\n\npprAvail :: AvailInfo -> SDoc\npprAvail (Avail n)\n  = ppr n\npprAvail (AvailTC n ns fs)\n  = ppr n <> braces (sep [ fsep (punctuate comma (map ppr ns)) <> semi\n                         , fsep (punctuate comma (map (ppr . flLabel) fs))])\n\ninstance Binary AvailInfo where\n    put_ bh (Avail aa) = do\n            putByte bh 0\n            put_ bh aa\n    put_ bh (AvailTC ab ac ad) = do\n            putByte bh 1\n            put_ bh ab\n            put_ bh ac\n            put_ bh ad\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do aa <- get bh\n                      return (Avail aa)\n              _ -> do ab <- get bh\n                      ac <- get bh\n                      ad <- get bh\n                      return (AvailTC ab ac ad)\n", "num_lines": 287}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1997-1998\n\n\\section[BasicTypes]{Miscellanous types}\n\nThis module defines a miscellaneously collection of very simple\ntypes that\n\n\\begin{itemize}\n\\item have no other obvious home\n\\item don't depend on any other complicated types\n\\item are used in more than one \"part\" of the compiler\n\\end{itemize}\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule BasicTypes(\n        Version, bumpVersion, initialVersion,\n\n        LeftOrRight(..),\n        pickLR,\n\n        ConTag, ConTagZ, fIRST_TAG,\n\n        Arity, RepArity, JoinArity,\n\n        Alignment,\n\n        PromotionFlag(..), isPromoted,\n        FunctionOrData(..),\n\n        WarningTxt(..), pprWarningTxtForMsg, StringLiteral(..),\n\n        Fixity(..), FixityDirection(..),\n        defaultFixity, maxPrecedence, minPrecedence,\n        negateFixity, funTyFixity,\n        compareFixity,\n        LexicalFixity(..),\n\n        RecFlag(..), isRec, isNonRec, boolToRecFlag,\n        Origin(..), isGenerated,\n\n        RuleName, pprRuleName,\n\n        TopLevelFlag(..), isTopLevel, isNotTopLevel,\n\n        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,\n        hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,\n\n        Boxity(..), isBoxed,\n\n        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,\n\n        TupleSort(..), tupleSortBoxity, boxityTupleSort,\n        tupleParens,\n\n        sumParens, pprAlternative,\n\n        -- ** The OneShotInfo type\n        OneShotInfo(..),\n        noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,\n        bestOneShot, worstOneShot,\n\n        OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,\n        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,\n        strongLoopBreaker, weakLoopBreaker,\n\n        InsideLam, insideLam, notInsideLam,\n        OneBranch, oneBranch, notOneBranch,\n        InterestingCxt,\n        TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,\n        isAlwaysTailCalled,\n\n        EP(..),\n\n        DefMethSpec(..),\n        SwapFlag(..), flipSwap, unSwap, isSwapped,\n\n        CompilerPhase(..), PhaseNum,\n\n        Activation(..), isActive, isActiveIn, competesWith,\n        isNeverActive, isAlwaysActive, isEarlyActive,\n        activeAfterInitial, activeDuringFinal,\n\n        RuleMatchInfo(..), isConLike, isFunLike,\n        InlineSpec(..), noUserInlineSpec,\n        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,\n        neverInlinePragma, dfunInlinePragma,\n        isDefaultInlinePragma,\n        isInlinePragma, isInlinablePragma, isAnyInlinePragma,\n        inlinePragmaSpec, inlinePragmaSat,\n        inlinePragmaActivation, inlinePragmaRuleMatchInfo,\n        setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,\n        pprInline, pprInlineDebug,\n\n        SuccessFlag(..), succeeded, failed, successIf,\n\n        IntegralLit(..), FractionalLit(..),\n        negateIntegralLit, negateFractionalLit,\n        mkIntegralLit, mkFractionalLit,\n        integralFractionalLit,\n\n        SourceText(..), pprWithSourceText,\n\n        IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,\n\n        SpliceExplicitFlag(..)\n   ) where\n\nimport GhcPrelude\n\nimport FastString\nimport Outputable\nimport SrcLoc ( Located,unLoc )\nimport Data.Data hiding (Fixity, Prefix, Infix)\nimport Data.Function (on)\n\n{-\n************************************************************************\n*                                                                      *\n          Binary choice\n*                                                                      *\n************************************************************************\n-}\n\ndata LeftOrRight = CLeft | CRight\n                 deriving( Eq, Data )\n\npickLR :: LeftOrRight -> (a,a) -> a\npickLR CLeft  (l,_) = l\npickLR CRight (_,r) = r\n\ninstance Outputable LeftOrRight where\n  ppr CLeft    = text \"Left\"\n  ppr CRight   = text \"Right\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Arity]{Arity}\n*                                                                      *\n************************************************************************\n-}\n\n-- | The number of value arguments that can be applied to a value before it does\n-- \"real work\". So:\n--  fib 100     has arity 0\n--  \\x -> fib x has arity 1\n-- See also Note [Definition of arity] in CoreArity\ntype Arity = Int\n\n-- | Representation Arity\n--\n-- The number of represented arguments that can be applied to a value before it does\n-- \"real work\". So:\n--  fib 100                    has representation arity 0\n--  \\x -> fib x                has representation arity 1\n--  \\(# x, y #) -> fib (x + y) has representation arity 2\ntype RepArity = Int\n\n-- | The number of arguments that a join point takes. Unlike the arity of a\n-- function, this is a purely syntactic property and is fixed when the join\n-- point is created (or converted from a value). Both type and value arguments\n-- are counted.\ntype JoinArity = Int\n\n{-\n************************************************************************\n*                                                                      *\n              Constructor tags\n*                                                                      *\n************************************************************************\n-}\n\n-- | Constructor Tag\n--\n-- Type of the tags associated with each constructor possibility or superclass\n-- selector\ntype ConTag = Int\n\n-- | A *zero-indexed* constructor tag\ntype ConTagZ = Int\n\nfIRST_TAG :: ConTag\n-- ^ Tags are allocated from here for real constructors\n--   or for superclass selectors\nfIRST_TAG =  1\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Alignment]{Alignment}\n*                                                                      *\n************************************************************************\n-}\n\ntype Alignment = Int -- align to next N-byte boundary (N must be a power of 2).\n\n{-\n************************************************************************\n*                                                                      *\n         One-shot information\n*                                                                      *\n************************************************************************\n-}\n\n-- | If the 'Id' is a lambda-bound variable then it may have lambda-bound\n-- variable info. Sometimes we know whether the lambda binding this variable\n-- is a \\\"one-shot\\\" lambda; that is, whether it is applied at most once.\n--\n-- This information may be useful in optimisation, as computations may\n-- safely be floated inside such a lambda without risk of duplicating\n-- work.\ndata OneShotInfo\n  = NoOneShotInfo -- ^ No information\n  | OneShotLam    -- ^ The lambda is applied at most once.\n  deriving (Eq)\n\n-- | It is always safe to assume that an 'Id' has no lambda-bound variable information\nnoOneShotInfo :: OneShotInfo\nnoOneShotInfo = NoOneShotInfo\n\nisOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool\nisOneShotInfo OneShotLam = True\nisOneShotInfo _          = False\n\nhasNoOneShotInfo NoOneShotInfo = True\nhasNoOneShotInfo _             = False\n\nworstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo\nworstOneShot NoOneShotInfo _             = NoOneShotInfo\nworstOneShot OneShotLam    os            = os\n\nbestOneShot NoOneShotInfo os         = os\nbestOneShot OneShotLam    _          = OneShotLam\n\npprOneShotInfo :: OneShotInfo -> SDoc\npprOneShotInfo NoOneShotInfo = empty\npprOneShotInfo OneShotLam    = text \"OneShot\"\n\ninstance Outputable OneShotInfo where\n    ppr = pprOneShotInfo\n\n{-\n************************************************************************\n*                                                                      *\n           Swap flag\n*                                                                      *\n************************************************************************\n-}\n\ndata SwapFlag\n  = NotSwapped  -- Args are: actual,   expected\n  | IsSwapped   -- Args are: expected, actual\n\ninstance Outputable SwapFlag where\n  ppr IsSwapped  = text \"Is-swapped\"\n  ppr NotSwapped = text \"Not-swapped\"\n\nflipSwap :: SwapFlag -> SwapFlag\nflipSwap IsSwapped  = NotSwapped\nflipSwap NotSwapped = IsSwapped\n\nisSwapped :: SwapFlag -> Bool\nisSwapped IsSwapped  = True\nisSwapped NotSwapped = False\n\nunSwap :: SwapFlag -> (a->a->b) -> a -> a -> b\nunSwap NotSwapped f a b = f a b\nunSwap IsSwapped  f a b = f b a\n\n\n{- *********************************************************************\n*                                                                      *\n           Promotion flag\n*                                                                      *\n********************************************************************* -}\n\n-- | Is a TyCon a promoted data constructor or just a normal type constructor?\ndata PromotionFlag\n  = NotPromoted\n  | IsPromoted\n  deriving ( Eq, Data )\n\nisPromoted :: PromotionFlag -> Bool\nisPromoted IsPromoted  = True\nisPromoted NotPromoted = False\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[FunctionOrData]{FunctionOrData}\n*                                                                      *\n************************************************************************\n-}\n\ndata FunctionOrData = IsFunction | IsData\n    deriving (Eq, Ord, Data)\n\ninstance Outputable FunctionOrData where\n    ppr IsFunction = text \"(function)\"\n    ppr IsData     = text \"(data)\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Version]{Module and identifier version numbers}\n*                                                                      *\n************************************************************************\n-}\n\ntype Version = Int\n\nbumpVersion :: Version -> Version\nbumpVersion v = v+1\n\ninitialVersion :: Version\ninitialVersion = 1\n\n{-\n************************************************************************\n*                                                                      *\n                Deprecations\n*                                                                      *\n************************************************************************\n-}\n\n-- | A String Literal in the source, including its original raw format for use by\n-- source to source manipulation tools.\ndata StringLiteral = StringLiteral\n                       { sl_st :: SourceText, -- literal raw source.\n                                              -- See not [Literal source text]\n                         sl_fs :: FastString  -- literal string value\n                       } deriving Data\n\ninstance Eq StringLiteral where\n  (StringLiteral _ a) == (StringLiteral _ b) = a == b\n\ninstance Outputable StringLiteral where\n  ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)\n\n-- | Warning Text\n--\n-- reason/explanation from a WARNING or DEPRECATED pragma\ndata WarningTxt = WarningTxt (Located SourceText)\n                             [Located StringLiteral]\n                | DeprecatedTxt (Located SourceText)\n                                [Located StringLiteral]\n    deriving (Eq, Data)\n\ninstance Outputable WarningTxt where\n    ppr (WarningTxt    lsrc ws)\n      = case unLoc lsrc of\n          NoSourceText   -> pp_ws ws\n          SourceText src -> text src <+> pp_ws ws <+> text \"#-}\"\n\n    ppr (DeprecatedTxt lsrc  ds)\n      = case unLoc lsrc of\n          NoSourceText   -> pp_ws ds\n          SourceText src -> text src <+> pp_ws ds <+> text \"#-}\"\n\npp_ws :: [Located StringLiteral] -> SDoc\npp_ws [l] = ppr $ unLoc l\npp_ws ws\n  = text \"[\"\n    <+> vcat (punctuate comma (map (ppr . unLoc) ws))\n    <+> text \"]\"\n\n\npprWarningTxtForMsg :: WarningTxt -> SDoc\npprWarningTxtForMsg (WarningTxt    _ ws)\n                     = doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))\npprWarningTxtForMsg (DeprecatedTxt _ ds)\n                     = text \"Deprecated:\" <+>\n                       doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))\n\n{-\n************************************************************************\n*                                                                      *\n                Rules\n*                                                                      *\n************************************************************************\n-}\n\ntype RuleName = FastString\n\npprRuleName :: RuleName -> SDoc\npprRuleName rn = doubleQuotes (ftext rn)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Fixity]{Fixity info}\n*                                                                      *\n************************************************************************\n-}\n\n------------------------\ndata Fixity = Fixity SourceText Int FixityDirection\n  -- Note [Pragma source text]\n  deriving Data\n\ninstance Outputable Fixity where\n    ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]\n\ninstance Eq Fixity where -- Used to determine if two fixities conflict\n  (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2\n\n------------------------\ndata FixityDirection = InfixL | InfixR | InfixN\n                     deriving (Eq, Data)\n\ninstance Outputable FixityDirection where\n    ppr InfixL = text \"infixl\"\n    ppr InfixR = text \"infixr\"\n    ppr InfixN = text \"infix\"\n\n------------------------\nmaxPrecedence, minPrecedence :: Int\nmaxPrecedence = 9\nminPrecedence = 0\n\ndefaultFixity :: Fixity\ndefaultFixity = Fixity NoSourceText maxPrecedence InfixL\n\nnegateFixity, funTyFixity :: Fixity\n-- Wired-in fixities\nnegateFixity = Fixity NoSourceText 6 InfixL  -- Fixity of unary negate\nfunTyFixity  = Fixity NoSourceText (-1) InfixR  -- Fixity of '->', see #15235\n\n{-\nConsider\n\n\\begin{verbatim}\n        a `op1` b `op2` c\n\\end{verbatim}\n@(compareFixity op1 op2)@ tells which way to arrange application, or\nwhether there's an error.\n-}\n\ncompareFixity :: Fixity -> Fixity\n              -> (Bool,         -- Error please\n                  Bool)         -- Associate to the right: a op1 (b op2 c)\ncompareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)\n  = case prec1 `compare` prec2 of\n        GT -> left\n        LT -> right\n        EQ -> case (dir1, dir2) of\n                        (InfixR, InfixR) -> right\n                        (InfixL, InfixL) -> left\n                        _                -> error_please\n  where\n    right        = (False, True)\n    left         = (False, False)\n    error_please = (True,  False)\n\n-- |Captures the fixity of declarations as they are parsed. This is not\n-- necessarily the same as the fixity declaration, as the normal fixity may be\n-- overridden using parens or backticks.\ndata LexicalFixity = Prefix | Infix deriving (Data,Eq)\n\ninstance Outputable LexicalFixity where\n  ppr Prefix = text \"Prefix\"\n  ppr Infix  = text \"Infix\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Top-level/local]{Top-level/not-top level flag}\n*                                                                      *\n************************************************************************\n-}\n\ndata TopLevelFlag\n  = TopLevel\n  | NotTopLevel\n\nisTopLevel, isNotTopLevel :: TopLevelFlag -> Bool\n\nisNotTopLevel NotTopLevel = True\nisNotTopLevel TopLevel    = False\n\nisTopLevel TopLevel     = True\nisTopLevel NotTopLevel  = False\n\ninstance Outputable TopLevelFlag where\n  ppr TopLevel    = text \"<TopLevel>\"\n  ppr NotTopLevel = text \"<NotTopLevel>\"\n\n{-\n************************************************************************\n*                                                                      *\n                Boxity flag\n*                                                                      *\n************************************************************************\n-}\n\ndata Boxity\n  = Boxed\n  | Unboxed\n  deriving( Eq, Data )\n\nisBoxed :: Boxity -> Bool\nisBoxed Boxed   = True\nisBoxed Unboxed = False\n\ninstance Outputable Boxity where\n  ppr Boxed   = text \"Boxed\"\n  ppr Unboxed = text \"Unboxed\"\n\n{-\n************************************************************************\n*                                                                      *\n                Recursive/Non-Recursive flag\n*                                                                      *\n************************************************************************\n-}\n\n-- | Recursivity Flag\ndata RecFlag = Recursive\n             | NonRecursive\n             deriving( Eq, Data )\n\nisRec :: RecFlag -> Bool\nisRec Recursive    = True\nisRec NonRecursive = False\n\nisNonRec :: RecFlag -> Bool\nisNonRec Recursive    = False\nisNonRec NonRecursive = True\n\nboolToRecFlag :: Bool -> RecFlag\nboolToRecFlag True  = Recursive\nboolToRecFlag False = NonRecursive\n\ninstance Outputable RecFlag where\n  ppr Recursive    = text \"Recursive\"\n  ppr NonRecursive = text \"NonRecursive\"\n\n{-\n************************************************************************\n*                                                                      *\n                Code origin\n*                                                                      *\n************************************************************************\n-}\n\ndata Origin = FromSource\n            | Generated\n            deriving( Eq, Data )\n\nisGenerated :: Origin -> Bool\nisGenerated Generated = True\nisGenerated FromSource = False\n\ninstance Outputable Origin where\n  ppr FromSource  = text \"FromSource\"\n  ppr Generated   = text \"Generated\"\n\n{-\n************************************************************************\n*                                                                      *\n                Instance overlap flag\n*                                                                      *\n************************************************************************\n-}\n\n-- | The semantics allowed for overlapping instances for a particular\n-- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.hs`) for a\n-- explanation of the `isSafeOverlap` field.\n--\n-- - 'ApiAnnotation.AnnKeywordId' :\n--      'ApiAnnotation.AnnOpen' @'\\{-\\# OVERLAPPABLE'@ or\n--                              @'\\{-\\# OVERLAPPING'@ or\n--                              @'\\{-\\# OVERLAPS'@ or\n--                              @'\\{-\\# INCOHERENT'@,\n--      'ApiAnnotation.AnnClose' @`\\#-\\}`@,\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata OverlapFlag = OverlapFlag\n  { overlapMode   :: OverlapMode\n  , isSafeOverlap :: Bool\n  } deriving (Eq, Data)\n\nsetOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag\nsetOverlapModeMaybe f Nothing  = f\nsetOverlapModeMaybe f (Just m) = f { overlapMode = m }\n\nhasIncoherentFlag :: OverlapMode -> Bool\nhasIncoherentFlag mode =\n  case mode of\n    Incoherent   _ -> True\n    _              -> False\n\nhasOverlappableFlag :: OverlapMode -> Bool\nhasOverlappableFlag mode =\n  case mode of\n    Overlappable _ -> True\n    Overlaps     _ -> True\n    Incoherent   _ -> True\n    _              -> False\n\nhasOverlappingFlag :: OverlapMode -> Bool\nhasOverlappingFlag mode =\n  case mode of\n    Overlapping  _ -> True\n    Overlaps     _ -> True\n    Incoherent   _ -> True\n    _              -> False\n\ndata OverlapMode  -- See Note [Rules for instance lookup] in InstEnv\n  = NoOverlap SourceText\n                  -- See Note [Pragma source text]\n    -- ^ This instance must not overlap another `NoOverlap` instance.\n    -- However, it may be overlapped by `Overlapping` instances,\n    -- and it may overlap `Overlappable` instances.\n\n\n  | Overlappable SourceText\n                  -- See Note [Pragma source text]\n    -- ^ Silently ignore this instance if you find a\n    -- more specific one that matches the constraint\n    -- you are trying to resolve\n    --\n    -- Example: constraint (Foo [Int])\n    --   instance                      Foo [Int]\n    --   instance {-# OVERLAPPABLE #-} Foo [a]\n    --\n    -- Since the second instance has the Overlappable flag,\n    -- the first instance will be chosen (otherwise\n    -- its ambiguous which to choose)\n\n\n  | Overlapping SourceText\n                  -- See Note [Pragma source text]\n    -- ^ Silently ignore any more general instances that may be\n    --   used to solve the constraint.\n    --\n    -- Example: constraint (Foo [Int])\n    --   instance {-# OVERLAPPING #-} Foo [Int]\n    --   instance                     Foo [a]\n    --\n    -- Since the first instance has the Overlapping flag,\n    -- the second---more general---instance will be ignored (otherwise\n    -- it is ambiguous which to choose)\n\n\n  | Overlaps SourceText\n                  -- See Note [Pragma source text]\n    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.\n\n  | Incoherent SourceText\n                  -- See Note [Pragma source text]\n    -- ^ Behave like Overlappable and Overlapping, and in addition pick\n    -- an an arbitrary one if there are multiple matching candidates, and\n    -- don't worry about later instantiation\n    --\n    -- Example: constraint (Foo [b])\n    -- instance {-# INCOHERENT -} Foo [Int]\n    -- instance                   Foo [a]\n    -- Without the Incoherent flag, we'd complain that\n    -- instantiating 'b' would change which instance\n    -- was chosen. See also note [Incoherent instances] in InstEnv\n\n  deriving (Eq, Data)\n\n\ninstance Outputable OverlapFlag where\n   ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)\n\ninstance Outputable OverlapMode where\n   ppr (NoOverlap    _) = empty\n   ppr (Overlappable _) = text \"[overlappable]\"\n   ppr (Overlapping  _) = text \"[overlapping]\"\n   ppr (Overlaps     _) = text \"[overlap ok]\"\n   ppr (Incoherent   _) = text \"[incoherent]\"\n\npprSafeOverlap :: Bool -> SDoc\npprSafeOverlap True  = text \"[safe]\"\npprSafeOverlap False = empty\n\n{-\n************************************************************************\n*                                                                      *\n                Precedence\n*                                                                      *\n************************************************************************\n-}\n\n-- | A general-purpose pretty-printing precedence type.\nnewtype PprPrec = PprPrec Int deriving (Eq, Ord, Show)\n-- See Note [Precedence in types]\n\ntopPrec, sigPrec, funPrec, opPrec, appPrec :: PprPrec\ntopPrec = PprPrec 0 -- No parens\nsigPrec = PprPrec 1 -- Explicit type signatures\nfunPrec = PprPrec 2 -- Function args; no parens for constructor apps\n                    -- See [Type operator precedence] for why both\n                    -- funPrec and opPrec exist.\nopPrec  = PprPrec 2 -- Infix operator\nappPrec = PprPrec 3 -- Constructor args; no parens for atomic\n\nmaybeParen :: PprPrec -> PprPrec -> SDoc -> SDoc\nmaybeParen ctxt_prec inner_prec pretty\n  | ctxt_prec < inner_prec = pretty\n  | otherwise              = parens pretty\n\n{- Note [Precedence in types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMany pretty-printing functions have type\n    ppr_ty :: PprPrec -> Type -> SDoc\n\nThe PprPrec gives the binding strength of the context.  For example, in\n   T ty1 ty2\nwe will pretty-print 'ty1' and 'ty2' with the call\n  (ppr_ty appPrec ty)\nto indicate that the context is that of an argument of a TyConApp.\n\nWe use this consistently for Type and HsType.\n\nNote [Type operator precedence]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't keep the fixity of type operators in the operator. So the\npretty printer follows the following precedence order:\n\n   TyConPrec         Type constructor application\n   TyOpPrec/FunPrec  Operator application and function arrow\n\nWe have funPrec and opPrec to represent the precedence of function\narrow and type operators respectively, but currently we implement\nfunPrec == opPrec, so that we don't distinguish the two. Reason:\nit's hard to parse a type like\n    a ~ b => c * d -> e - f\n\nBy treating opPrec = funPrec we end up with more parens\n    (a ~ b) => (c * d) -> (e - f)\n\nBut the two are different constructors of PprPrec so we could make\n(->) bind more or less tightly if we wanted.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                Tuples\n*                                                                      *\n************************************************************************\n-}\n\ndata TupleSort\n  = BoxedTuple\n  | UnboxedTuple\n  | ConstraintTuple\n  deriving( Eq, Data )\n\ntupleSortBoxity :: TupleSort -> Boxity\ntupleSortBoxity BoxedTuple      = Boxed\ntupleSortBoxity UnboxedTuple    = Unboxed\ntupleSortBoxity ConstraintTuple = Boxed\n\nboxityTupleSort :: Boxity -> TupleSort\nboxityTupleSort Boxed   = BoxedTuple\nboxityTupleSort Unboxed = UnboxedTuple\n\ntupleParens :: TupleSort -> SDoc -> SDoc\ntupleParens BoxedTuple      p = parens p\ntupleParens UnboxedTuple    p = text \"(#\" <+> p <+> ptext (sLit \"#)\")\ntupleParens ConstraintTuple p   -- In debug-style write (% Eq a, Ord b %)\n  = ifPprDebug (text \"(%\" <+> p <+> ptext (sLit \"%)\"))\n               (parens p)\n\n{-\n************************************************************************\n*                                                                      *\n                Sums\n*                                                                      *\n************************************************************************\n-}\n\nsumParens :: SDoc -> SDoc\nsumParens p = ptext (sLit \"(#\") <+> p <+> ptext (sLit \"#)\")\n\n-- | Pretty print an alternative in an unboxed sum e.g. \"| a | |\".\npprAlternative :: (a -> SDoc) -- ^ The pretty printing function to use\n               -> a           -- ^ The things to be pretty printed\n               -> ConTag      -- ^ Alternative (one-based)\n               -> Arity       -- ^ Arity\n               -> SDoc        -- ^ 'SDoc' where the alternative havs been pretty\n                              -- printed and finally packed into a paragraph.\npprAlternative pp x alt arity =\n    fsep (replicate (alt - 1) vbar ++ [pp x] ++ replicate (arity - alt) vbar)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Generic]{Generic flag}\n*                                                                      *\n************************************************************************\n\nThis is the \"Embedding-Projection pair\" datatype, it contains\ntwo pieces of code (normally either RenamedExpr's or Id's)\nIf we have a such a pair (EP from to), the idea is that 'from' and 'to'\nrepresents functions of type\n\n        from :: T -> Tring\n        to   :: Tring -> T\n\nAnd we should have\n\n        to (from x) = x\n\nT and Tring are arbitrary, but typically T is the 'main' type while\nTring is the 'representation' type.  (This just helps us remember\nwhether to use 'from' or 'to'.\n-}\n\n-- | Embedding Projection pair\ndata EP a = EP { fromEP :: a,   -- :: T -> Tring\n                 toEP   :: a }  -- :: Tring -> T\n\n{-\nEmbedding-projection pairs are used in several places:\n\nFirst of all, each type constructor has an EP associated with it, the\ncode in EP converts (datatype T) from T to Tring and back again.\n\nSecondly, when we are filling in Generic methods (in the typechecker,\ntcMethodBinds), we are constructing bimaps by induction on the structure\nof the type of the method signature.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Occurrence information}\n*                                                                      *\n************************************************************************\n\nThis data type is used exclusively by the simplifier, but it appears in a\nSubstResult, which is currently defined in VarEnv, which is pretty near\nthe base of the module hierarchy.  So it seemed simpler to put the\ndefn of OccInfo here, safely at the bottom\n-}\n\n-- | identifier Occurrence Information\ndata OccInfo\n  = ManyOccs        { occ_tail    :: !TailCallInfo }\n                        -- ^ There are many occurrences, or unknown occurrences\n\n  | IAmDead             -- ^ Marks unused variables.  Sometimes useful for\n                        -- lambda and case-bound variables.\n\n  | OneOcc          { occ_in_lam  :: !InsideLam\n                    , occ_one_br  :: !OneBranch\n                    , occ_int_cxt :: !InterestingCxt\n                    , occ_tail    :: !TailCallInfo }\n                        -- ^ Occurs exactly once (per branch), not inside a rule\n\n  -- | This identifier breaks a loop of mutually recursive functions. The field\n  -- marks whether it is only a loop breaker due to a reference in a rule\n  | IAmALoopBreaker { occ_rules_only :: !RulesOnly\n                    , occ_tail       :: !TailCallInfo }\n                        -- Note [LoopBreaker OccInfo]\n\n  deriving (Eq)\n\ntype RulesOnly = Bool\n\n{-\nNote [LoopBreaker OccInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n   IAmALoopBreaker True  <=> A \"weak\" or rules-only loop breaker\n                             Do not preInlineUnconditionally\n\n   IAmALoopBreaker False <=> A \"strong\" loop breaker\n                             Do not inline at all\n\nSee OccurAnal Note [Weak loop breakers]\n-}\n\nnoOccInfo :: OccInfo\nnoOccInfo = ManyOccs { occ_tail = NoTailCallInfo }\n\nisManyOccs :: OccInfo -> Bool\nisManyOccs ManyOccs{} = True\nisManyOccs _          = False\n\nseqOccInfo :: OccInfo -> ()\nseqOccInfo occ = occ `seq` ()\n\n-----------------\n-- | Interesting Context\ntype InterestingCxt = Bool      -- True <=> Function: is applied\n                                --          Data value: scrutinised by a case with\n                                --                      at least one non-DEFAULT branch\n\n-----------------\n-- | Inside Lambda\ntype InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda\n                        -- Substituting a redex for this occurrence is\n                        -- dangerous because it might duplicate work.\ninsideLam, notInsideLam :: InsideLam\ninsideLam    = True\nnotInsideLam = False\n\n-----------------\ntype OneBranch = Bool   -- True <=> Occurs in only one case branch\n                        --      so no code-duplication issue to worry about\noneBranch, notOneBranch :: OneBranch\noneBranch    = True\nnotOneBranch = False\n\n-----------------\ndata TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]\n                  | NoTailCallInfo\n  deriving (Eq)\n\ntailCallInfo :: OccInfo -> TailCallInfo\ntailCallInfo IAmDead   = NoTailCallInfo\ntailCallInfo other     = occ_tail other\n\nzapOccTailCallInfo :: OccInfo -> OccInfo\nzapOccTailCallInfo IAmDead   = IAmDead\nzapOccTailCallInfo occ       = occ { occ_tail = NoTailCallInfo }\n\nisAlwaysTailCalled :: OccInfo -> Bool\nisAlwaysTailCalled occ\n  = case tailCallInfo occ of AlwaysTailCalled{} -> True\n                             NoTailCallInfo     -> False\n\ninstance Outputable TailCallInfo where\n  ppr (AlwaysTailCalled ar) = sep [ text \"Tail\", int ar ]\n  ppr _                     = empty\n\n-----------------\nstrongLoopBreaker, weakLoopBreaker :: OccInfo\nstrongLoopBreaker = IAmALoopBreaker False NoTailCallInfo\nweakLoopBreaker   = IAmALoopBreaker True  NoTailCallInfo\n\nisWeakLoopBreaker :: OccInfo -> Bool\nisWeakLoopBreaker (IAmALoopBreaker{}) = True\nisWeakLoopBreaker _                   = False\n\nisStrongLoopBreaker :: OccInfo -> Bool\nisStrongLoopBreaker (IAmALoopBreaker { occ_rules_only = False }) = True\n  -- Loop-breaker that breaks a non-rule cycle\nisStrongLoopBreaker _                                            = False\n\nisDeadOcc :: OccInfo -> Bool\nisDeadOcc IAmDead = True\nisDeadOcc _       = False\n\nisOneOcc :: OccInfo -> Bool\nisOneOcc (OneOcc {}) = True\nisOneOcc _           = False\n\nzapFragileOcc :: OccInfo -> OccInfo\n-- Keep only the most robust data: deadness, loop-breaker-hood\nzapFragileOcc (OneOcc {}) = noOccInfo\nzapFragileOcc occ         = zapOccTailCallInfo occ\n\ninstance Outputable OccInfo where\n  -- only used for debugging; never parsed.  KSW 1999-07\n  ppr (ManyOccs tails)     = pprShortTailCallInfo tails\n  ppr IAmDead              = text \"Dead\"\n  ppr (IAmALoopBreaker rule_only tails)\n        = text \"LoopBreaker\" <> pp_ro <> pprShortTailCallInfo tails\n        where\n          pp_ro | rule_only = char '!'\n                | otherwise = empty\n  ppr (OneOcc inside_lam one_branch int_cxt tail_info)\n        = text \"Once\" <> pp_lam <> pp_br <> pp_args <> pp_tail\n        where\n          pp_lam | inside_lam = char 'L'\n                 | otherwise  = empty\n          pp_br  | one_branch = empty\n                 | otherwise  = char '*'\n          pp_args | int_cxt   = char '!'\n                  | otherwise = empty\n          pp_tail             = pprShortTailCallInfo tail_info\n\npprShortTailCallInfo :: TailCallInfo -> SDoc\npprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)\npprShortTailCallInfo NoTailCallInfo        = empty\n\n{-\nNote [TailCallInfo]\n~~~~~~~~~~~~~~~~~~~\nThe occurrence analyser determines what can be made into a join point, but it\ndoesn't change the binder into a JoinId because then it would be inconsistent\nwith the occurrences. Thus it's left to the simplifier (or to simpleOptExpr) to\nchange the IdDetails.\n\nThe AlwaysTailCalled marker actually means slightly more than simply that the\nfunction is always tail-called. See Note [Invariants on join points].\n\nThis info is quite fragile and should not be relied upon unless the occurrence\nanalyser has *just* run. Use 'Id.isJoinId_maybe' for the permanent state of\nthe join-point-hood of a binder; a join id itself will not be marked\nAlwaysTailCalled.\n\nNote that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that\nbeing tail-called would mean that the variable could only appear once per branch\n(thus getting a `OneOcc { occ_one_br = True }` occurrence info), but a join\npoint can also be invoked from other join points, not just from case branches:\n\n  let j1 x = ...\n      j2 y = ... j1 z {- tail call -} ...\n  in case w of\n       A -> j1 v\n       B -> j2 u\n       C -> j2 q\n\nHere both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get\nManyOccs and j2 will get `OneOcc { occ_one_br = True }`.\n\n************************************************************************\n*                                                                      *\n                Default method specification\n*                                                                      *\n************************************************************************\n\nThe DefMethSpec enumeration just indicates what sort of default method\nis used for a class. It is generated from source code, and present in\ninterface files; it is converted to Class.DefMethInfo before begin put in a\nClass object.\n-}\n\n-- | Default Method Specification\ndata DefMethSpec ty\n  = VanillaDM     -- Default method given with polymorphic code\n  | GenericDM ty  -- Default method given with code of this type\n\ninstance Outputable (DefMethSpec ty) where\n  ppr VanillaDM      = text \"{- Has default method -}\"\n  ppr (GenericDM {}) = text \"{- Has generic default method -}\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Success flag}\n*                                                                      *\n************************************************************************\n-}\n\ndata SuccessFlag = Succeeded | Failed\n\ninstance Outputable SuccessFlag where\n    ppr Succeeded = text \"Succeeded\"\n    ppr Failed    = text \"Failed\"\n\nsuccessIf :: Bool -> SuccessFlag\nsuccessIf True  = Succeeded\nsuccessIf False = Failed\n\nsucceeded, failed :: SuccessFlag -> Bool\nsucceeded Succeeded = True\nsucceeded Failed    = False\n\nfailed Succeeded = False\nfailed Failed    = True\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Source Text}\n*                                                                      *\n************************************************************************\nKeeping Source Text for source to source conversions\n\nNote [Pragma source text]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nThe lexer does a case-insensitive match for pragmas, as well as\naccepting both UK and US spelling variants.\n\nSo\n\n  {-# SPECIALISE #-}\n  {-# SPECIALIZE #-}\n  {-# Specialize #-}\n\nwill all generate ITspec_prag token for the start of the pragma.\n\nIn order to be able to do source to source conversions, the original\nsource text for the token needs to be preserved, hence the\n`SourceText` field.\n\nSo the lexer will then generate\n\n  ITspec_prag \"{ -# SPECIALISE\"\n  ITspec_prag \"{ -# SPECIALIZE\"\n  ITspec_prag \"{ -# Specialize\"\n\nfor the cases above.\n [without the space between '{' and '-', otherwise this comment won't parse]\n\n\nNote [Literal source text]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe lexer/parser converts literals from their original source text\nversions to an appropriate internal representation. This is a problem\nfor tools doing source to source conversions, so the original source\ntext is stored in literals where this can occur.\n\nMotivating examples for HsLit\n\n  HsChar          '\\n'       == '\\x20`\n  HsCharPrim      '\\x41`#    == `A`\n  HsString        \"\\x20\\x41\" == \" A\"\n  HsStringPrim    \"\\x20\"#    == \" \"#\n  HsInt           001        == 1\n  HsIntPrim       002#       == 2#\n  HsWordPrim      003##      == 3##\n  HsInt64Prim     004##      == 4##\n  HsWord64Prim    005##      == 5##\n  HsInteger       006        == 6\n\nFor OverLitVal\n\n  HsIntegral      003      == 0x003\n  HsIsString      \"\\x41nd\" == \"And\"\n-}\n\n -- Note [Literal source text],[Pragma source text]\ndata SourceText = SourceText String\n                | NoSourceText -- ^ For when code is generated, e.g. TH,\n                               -- deriving. The pretty printer will then make\n                               -- its own representation of the item.\n                deriving (Data, Show, Eq )\n\ninstance Outputable SourceText where\n  ppr (SourceText s) = text \"SourceText\" <+> text s\n  ppr NoSourceText   = text \"NoSourceText\"\n\n-- | Special combinator for showing string literals.\npprWithSourceText :: SourceText -> SDoc -> SDoc\npprWithSourceText NoSourceText     d = d\npprWithSourceText (SourceText src) _ = text src\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Activation}\n*                                                                      *\n************************************************************************\n\nWhen a rule or inlining is active\n-}\n\n-- | Phase Number\ntype PhaseNum = Int  -- Compilation phase\n                     -- Phases decrease towards zero\n                     -- Zero is the last phase\n\ndata CompilerPhase\n  = Phase PhaseNum\n  | InitialPhase    -- The first phase -- number = infinity!\n\ninstance Outputable CompilerPhase where\n   ppr (Phase n)    = int n\n   ppr InitialPhase = text \"InitialPhase\"\n\nactiveAfterInitial :: Activation\n-- Active in the first phase after the initial phase\n-- Currently we have just phases [2,1,0]\nactiveAfterInitial = ActiveAfter NoSourceText 2\n\nactiveDuringFinal :: Activation\n-- Active in the final simplification phase (which is repeated)\nactiveDuringFinal = ActiveAfter NoSourceText 0\n\n-- See note [Pragma source text]\ndata Activation = NeverActive\n                | AlwaysActive\n                | ActiveBefore SourceText PhaseNum\n                  -- Active only *strictly before* this phase\n                | ActiveAfter SourceText PhaseNum\n                  -- Active in this phase and later\n                deriving( Eq, Data )\n                  -- Eq used in comparing rules in HsDecls\n\n-- | Rule Match Information\ndata RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]\n                   | FunLike\n                   deriving( Eq, Data, Show )\n        -- Show needed for Lexer.x\n\ndata InlinePragma            -- Note [InlinePragma]\n  = InlinePragma\n      { inl_src    :: SourceText -- Note [Pragma source text]\n      , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]\n\n      , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n\n                                     --            explicit (non-type, non-dictionary) args\n                                     --   That is, inl_sat describes the number of *source-code*\n                                     --   arguments the thing must be applied to.  We add on the\n                                     --   number of implicit, dictionary arguments when making\n                                     --   the Unfolding, and don't look at inl_sat further\n\n      , inl_act    :: Activation     -- Says during which phases inlining is allowed\n                                     -- See Note [inl_inline and inl_act]\n\n      , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?\n    } deriving( Eq, Data )\n\n-- | Inline Specification\ndata InlineSpec   -- What the user's INLINE pragma looked like\n  = Inline       -- User wrote INLINE\n  | Inlinable    -- User wrote INLINABLE\n  | NoInline     -- User wrote NOINLINE\n  | NoUserInline -- User did not write any of INLINE/INLINABLE/NOINLINE\n                 -- e.g. in `defaultInlinePragma` or when created by CSE\n  deriving( Eq, Data, Show )\n        -- Show needed for Lexer.x\n\n{- Note [InlinePragma]\n~~~~~~~~~~~~~~~~~~~~~~\nThis data type mirrors what you can write in an INLINE or NOINLINE pragma in\nthe source program.\n\nIf you write nothing at all, you get defaultInlinePragma:\n   inl_inline = NoUserInline\n   inl_act    = AlwaysActive\n   inl_rule   = FunLike\n\nIt's not possible to get that combination by *writing* something, so\nif an Id has defaultInlinePragma it means the user didn't specify anything.\n\nIf inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding.\n\nIf you want to know where InlinePragmas take effect: Look in DsBinds.makeCorePair\n\nNote [inl_inline and inl_act]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* inl_inline says what the user wrote: did she say INLINE, NOINLINE,\n  INLINABLE, or nothing at all\n\n* inl_act says in what phases the unfolding is active or inactive\n  E.g  If you write INLINE[1]    then inl_act will be set to ActiveAfter 1\n       If you write NOINLINE[1]  then inl_act will be set to ActiveBefore 1\n       If you write NOINLINE[~1] then inl_act will be set to ActiveAfter 1\n  So note that inl_act does not say what pragma you wrote: it just\n  expresses its consequences\n\n* inl_act just says when the unfolding is active; it doesn't say what\n  to inline.  If you say INLINE f, then f's inl_act will be AlwaysActive,\n  but in addition f will get a \"stable unfolding\" with UnfoldingGuidance\n  that tells the inliner to be pretty eager about it.\n\nNote [CONLIKE pragma]\n~~~~~~~~~~~~~~~~~~~~~\nThe ConLike constructor of a RuleMatchInfo is aimed at the following.\nConsider first\n    {-# RULE \"r/cons\" forall a as. r (a:as) = f (a+1) #-}\n    g b bs = let x = b:bs in ..x...x...(r x)...\nNow, the rule applies to the (r x) term, because GHC \"looks through\"\nthe definition of 'x' to see that it is (b:bs).\n\nNow consider\n    {-# RULE \"r/f\" forall v. r (f v) = f (v+1) #-}\n    g v = let x = f v in ..x...x...(r x)...\nNormally the (r x) would *not* match the rule, because GHC would be\nscared about duplicating the redex (f v), so it does not \"look\nthrough\" the bindings.\n\nHowever the CONLIKE modifier says to treat 'f' like a constructor in\nthis situation, and \"look through\" the unfolding for x.  So (r x)\nfires, yielding (f (v+1)).\n\nThis is all controlled with a user-visible pragma:\n     {-# NOINLINE CONLIKE [1] f #-}\n\nThe main effects of CONLIKE are:\n\n    - The occurrence analyser (OccAnal) and simplifier (Simplify) treat\n      CONLIKE thing like constructors, by ANF-ing them\n\n    - New function CoreUtils.exprIsExpandable is like exprIsCheap, but\n      additionally spots applications of CONLIKE functions\n\n    - A CoreUnfolding has a field that caches exprIsExpandable\n\n    - The rule matcher consults this field.  See\n      Note [Expanding variables] in Rules.hs.\n-}\n\nisConLike :: RuleMatchInfo -> Bool\nisConLike ConLike = True\nisConLike _       = False\n\nisFunLike :: RuleMatchInfo -> Bool\nisFunLike FunLike = True\nisFunLike _       = False\n\nnoUserInlineSpec :: InlineSpec -> Bool\nnoUserInlineSpec NoUserInline = True\nnoUserInlineSpec _            = False\n\ndefaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma\n  :: InlinePragma\ndefaultInlinePragma = InlinePragma { inl_src = SourceText \"{-# INLINE\"\n                                   , inl_act = AlwaysActive\n                                   , inl_rule = FunLike\n                                   , inl_inline = NoUserInline\n                                   , inl_sat = Nothing }\n\nalwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }\nneverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }\n\ninlinePragmaSpec :: InlinePragma -> InlineSpec\ninlinePragmaSpec = inl_inline\n\n-- A DFun has an always-active inline activation so that\n-- exprIsConApp_maybe can \"see\" its unfolding\n-- (However, its actual Unfolding is a DFunUnfolding, which is\n--  never inlined other than via exprIsConApp_maybe.)\ndfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive\n                                         , inl_rule = ConLike }\n\nisDefaultInlinePragma :: InlinePragma -> Bool\nisDefaultInlinePragma (InlinePragma { inl_act = activation\n                                    , inl_rule = match_info\n                                    , inl_inline = inline })\n  = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info\n\nisInlinePragma :: InlinePragma -> Bool\nisInlinePragma prag = case inl_inline prag of\n                        Inline -> True\n                        _      -> False\n\nisInlinablePragma :: InlinePragma -> Bool\nisInlinablePragma prag = case inl_inline prag of\n                           Inlinable -> True\n                           _         -> False\n\nisAnyInlinePragma :: InlinePragma -> Bool\n-- INLINE or INLINABLE\nisAnyInlinePragma prag = case inl_inline prag of\n                        Inline    -> True\n                        Inlinable -> True\n                        _         -> False\n\ninlinePragmaSat :: InlinePragma -> Maybe Arity\ninlinePragmaSat = inl_sat\n\ninlinePragmaActivation :: InlinePragma -> Activation\ninlinePragmaActivation (InlinePragma { inl_act = activation }) = activation\n\ninlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo\ninlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info\n\nsetInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma\nsetInlinePragmaActivation prag activation = prag { inl_act = activation }\n\nsetInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma\nsetInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }\n\ninstance Outputable Activation where\n   ppr AlwaysActive       = empty\n   ppr NeverActive        = brackets (text \"~\")\n   ppr (ActiveBefore _ n) = brackets (char '~' <> int n)\n   ppr (ActiveAfter  _ n) = brackets (int n)\n\ninstance Outputable RuleMatchInfo where\n   ppr ConLike = text \"CONLIKE\"\n   ppr FunLike = text \"FUNLIKE\"\n\ninstance Outputable InlineSpec where\n   ppr Inline       = text \"INLINE\"\n   ppr NoInline     = text \"NOINLINE\"\n   ppr Inlinable    = text \"INLINABLE\"\n   ppr NoUserInline = text \"NOUSERINLINE\" -- what is better?\n\ninstance Outputable InlinePragma where\n  ppr = pprInline\n\npprInline :: InlinePragma -> SDoc\npprInline = pprInline' True\n\npprInlineDebug :: InlinePragma -> SDoc\npprInlineDebug = pprInline' False\n\npprInline' :: Bool           -- True <=> do not display the inl_inline field\n           -> InlinePragma\n           -> SDoc\npprInline' emptyInline (InlinePragma { inl_inline = inline, inl_act = activation\n                                    , inl_rule = info, inl_sat = mb_arity })\n    = pp_inl inline <> pp_act inline activation <+> pp_sat <+> pp_info\n    where\n      pp_inl x = if emptyInline then empty else ppr x\n\n      pp_act Inline   AlwaysActive = empty\n      pp_act NoInline NeverActive  = empty\n      pp_act _        act          = ppr act\n\n      pp_sat | Just ar <- mb_arity = parens (text \"sat-args=\" <> int ar)\n             | otherwise           = empty\n      pp_info | isFunLike info = empty\n              | otherwise      = ppr info\n\nisActive :: CompilerPhase -> Activation -> Bool\nisActive InitialPhase AlwaysActive      = True\nisActive InitialPhase (ActiveBefore {}) = True\nisActive InitialPhase _                 = False\nisActive (Phase p)    act               = isActiveIn p act\n\nisActiveIn :: PhaseNum -> Activation -> Bool\nisActiveIn _ NeverActive        = False\nisActiveIn _ AlwaysActive       = True\nisActiveIn p (ActiveAfter _ n)  = p <= n\nisActiveIn p (ActiveBefore _ n) = p >  n\n\ncompetesWith :: Activation -> Activation -> Bool\n-- See Note [Activation competition]\ncompetesWith NeverActive       _                = False\ncompetesWith _                 NeverActive      = False\ncompetesWith AlwaysActive      _                = True\n\ncompetesWith (ActiveBefore {})  AlwaysActive      = True\ncompetesWith (ActiveBefore {})  (ActiveBefore {}) = True\ncompetesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b\n\ncompetesWith (ActiveAfter {})  AlwaysActive      = False\ncompetesWith (ActiveAfter {})  (ActiveBefore {}) = False\ncompetesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b\n\n{- Note [Competing activations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSometimes a RULE and an inlining may compete, or two RULES.\nSee Note [Rules and inlining/other rules] in Desugar.\n\nWe say that act1 \"competes with\" act2 iff\n   act1 is active in the phase when act2 *becomes* active\nNB: remember that phases count *down*: 2, 1, 0!\n\nIt's too conservative to ensure that the two are never simultaneously\nactive.  For example, a rule might be always active, and an inlining\nmight switch on in phase 2.  We could switch off the rule, but it does\nno harm.\n-}\n\nisNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool\nisNeverActive NeverActive = True\nisNeverActive _           = False\n\nisAlwaysActive AlwaysActive = True\nisAlwaysActive _            = False\n\nisEarlyActive AlwaysActive      = True\nisEarlyActive (ActiveBefore {}) = True\nisEarlyActive _                 = False\n\n-- | Integral Literal\n--\n-- Used (instead of Integer) to represent negative zegative zero which is\n-- required for NegativeLiterals extension to correctly parse `-0::Double`\n-- as negative zero. See also #13211.\ndata IntegralLit\n  = IL { il_text :: SourceText\n       , il_neg :: Bool -- See Note [Negative zero]\n       , il_value :: Integer\n       }\n  deriving (Data, Show)\n\nmkIntegralLit :: Integral a => a -> IntegralLit\nmkIntegralLit i = IL { il_text = SourceText (show i_integer)\n                     , il_neg = i < 0\n                     , il_value = i_integer }\n  where\n    i_integer :: Integer\n    i_integer = toInteger i\n\nnegateIntegralLit :: IntegralLit -> IntegralLit\nnegateIntegralLit (IL text neg value)\n  = case text of\n      SourceText ('-':src) -> IL (SourceText src)       False    (negate value)\n      SourceText      src  -> IL (SourceText ('-':src)) True     (negate value)\n      NoSourceText         -> IL NoSourceText          (not neg) (negate value)\n\n-- | Fractional Literal\n--\n-- Used (instead of Rational) to represent exactly the floating point literal that we\n-- encountered in the user's source program. This allows us to pretty-print exactly what\n-- the user wrote, which is important e.g. for floating point numbers that can't represented\n-- as Doubles (we used to via Double for pretty-printing). See also #2245.\ndata FractionalLit\n  = FL { fl_text :: SourceText     -- How the value was written in the source\n       , fl_neg :: Bool            -- See Note [Negative zero]\n       , fl_value :: Rational      -- Numeric value of the literal\n       }\n  deriving (Data, Show)\n  -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on\n\nmkFractionalLit :: Real a => a -> FractionalLit\nmkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double))\n                           -- Converting to a Double here may technically lose\n                           -- precision (see #15502). We could alternatively\n                           -- convert to a Rational for the most accuracy, but\n                           -- it would cause Floats and Doubles to be displayed\n                           -- strangely, so we opt not to do this. (In contrast\n                           -- to mkIntegralLit, where we always convert to an\n                           -- Integer for the highest accuracy.)\n                       , fl_neg = r < 0\n                       , fl_value = toRational r }\n\nnegateFractionalLit :: FractionalLit -> FractionalLit\nnegateFractionalLit (FL text neg value)\n  = case text of\n      SourceText ('-':src) -> FL (SourceText src)     False value\n      SourceText      src  -> FL (SourceText ('-':src)) True  value\n      NoSourceText         -> FL NoSourceText (not neg) (negate value)\n\nintegralFractionalLit :: Bool -> Integer -> FractionalLit\nintegralFractionalLit neg i = FL { fl_text = SourceText (show i),\n                                   fl_neg = neg,\n                                   fl_value = fromInteger i }\n\n-- Comparison operations are needed when grouping literals\n-- for compiling pattern-matching (module MatchLit)\n\ninstance Eq IntegralLit where\n  (==) = (==) `on` il_value\n\ninstance Ord IntegralLit where\n  compare = compare `on` il_value\n\ninstance Outputable IntegralLit where\n  ppr (IL (SourceText src) _ _) = text src\n  ppr (IL NoSourceText _ value) = text (show value)\n\ninstance Eq FractionalLit where\n  (==) = (==) `on` fl_value\n\ninstance Ord FractionalLit where\n  compare = compare `on` fl_value\n\ninstance Outputable FractionalLit where\n  ppr f = pprWithSourceText (fl_text f) (rational (fl_value f))\n\n{-\n************************************************************************\n*                                                                      *\n    IntWithInf\n*                                                                      *\n************************************************************************\n\nRepresents an integer or positive infinity\n\n-}\n\n-- | An integer or infinity\ndata IntWithInf = Int {-# UNPACK #-} !Int\n                | Infinity\n  deriving Eq\n\n-- | A representation of infinity\ninfinity :: IntWithInf\ninfinity = Infinity\n\ninstance Ord IntWithInf where\n  compare Infinity Infinity = EQ\n  compare (Int _)  Infinity = LT\n  compare Infinity (Int _)  = GT\n  compare (Int a)  (Int b)  = a `compare` b\n\ninstance Outputable IntWithInf where\n  ppr Infinity = char '\u00e2\u02c6\u017e'\n  ppr (Int n)  = int n\n\ninstance Num IntWithInf where\n  (+) = plusWithInf\n  (*) = mulWithInf\n\n  abs Infinity = Infinity\n  abs (Int n)  = Int (abs n)\n\n  signum Infinity = Int 1\n  signum (Int n)  = Int (signum n)\n\n  fromInteger = Int . fromInteger\n\n  (-) = panic \"subtracting IntWithInfs\"\n\nintGtLimit :: Int -> IntWithInf -> Bool\nintGtLimit _ Infinity = False\nintGtLimit n (Int m)  = n > m\n\n-- | Add two 'IntWithInf's\nplusWithInf :: IntWithInf -> IntWithInf -> IntWithInf\nplusWithInf Infinity _        = Infinity\nplusWithInf _        Infinity = Infinity\nplusWithInf (Int a)  (Int b)  = Int (a + b)\n\n-- | Multiply two 'IntWithInf's\nmulWithInf :: IntWithInf -> IntWithInf -> IntWithInf\nmulWithInf Infinity _        = Infinity\nmulWithInf _        Infinity = Infinity\nmulWithInf (Int a)  (Int b)  = Int (a * b)\n\n-- | Turn a positive number into an 'IntWithInf', where 0 represents infinity\ntreatZeroAsInf :: Int -> IntWithInf\ntreatZeroAsInf 0 = Infinity\ntreatZeroAsInf n = Int n\n\n-- | Inject any integer into an 'IntWithInf'\nmkIntWithInf :: Int -> IntWithInf\nmkIntWithInf = Int\n\ndata SpliceExplicitFlag\n          = ExplicitSplice | -- ^ <=> $(f x y)\n            ImplicitSplice   -- ^ <=> f x y,  i.e. a naked top level expression\n    deriving Data\n", "num_lines": 1615}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1998\n\n\\section[ConLike]{@ConLike@: Constructor-like things}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule ConLike (\n          ConLike(..)\n        , conLikeArity\n        , conLikeFieldLabels\n        , conLikeInstOrigArgTys\n        , conLikeExTyCoVars\n        , conLikeName\n        , conLikeStupidTheta\n        , conLikeWrapId_maybe\n        , conLikeImplBangs\n        , conLikeFullSig\n        , conLikeResTy\n        , conLikeFieldType\n        , conLikesWithFields\n        , conLikeIsInfix\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DataCon\nimport PatSyn\nimport Outputable\nimport Unique\nimport Util\nimport Name\nimport BasicTypes\nimport TyCoRep (Type, ThetaType)\nimport Var\nimport Type (mkTyConApp)\n\nimport qualified Data.Data as Data\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Constructor-like things}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A constructor-like thing\ndata ConLike = RealDataCon DataCon\n             | PatSynCon PatSyn\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Instances}\n*                                                                      *\n************************************************************************\n-}\n\ninstance Eq ConLike where\n    (==) = eqConLike\n\neqConLike :: ConLike -> ConLike -> Bool\neqConLike x y = getUnique x == getUnique y\n\n-- There used to be an Ord ConLike instance here that used Unique for ordering.\n-- It was intentionally removed to prevent determinism problems.\n-- See Note [Unique Determinism] in Unique.\n\ninstance Uniquable ConLike where\n    getUnique (RealDataCon dc) = getUnique dc\n    getUnique (PatSynCon ps)   = getUnique ps\n\ninstance NamedThing ConLike where\n    getName (RealDataCon dc) = getName dc\n    getName (PatSynCon ps)   = getName ps\n\ninstance Outputable ConLike where\n    ppr (RealDataCon dc) = ppr dc\n    ppr (PatSynCon ps) = ppr ps\n\ninstance OutputableBndr ConLike where\n    pprInfixOcc (RealDataCon dc) = pprInfixOcc dc\n    pprInfixOcc (PatSynCon ps) = pprInfixOcc ps\n    pprPrefixOcc (RealDataCon dc) = pprPrefixOcc dc\n    pprPrefixOcc (PatSynCon ps) = pprPrefixOcc ps\n\ninstance Data.Data ConLike where\n    -- don't traverse?\n    toConstr _   = abstractConstr \"ConLike\"\n    gunfold _ _  = error \"gunfold\"\n    dataTypeOf _ = mkNoRepType \"ConLike\"\n\n-- | Number of arguments\nconLikeArity :: ConLike -> Arity\nconLikeArity (RealDataCon data_con) = dataConSourceArity data_con\nconLikeArity (PatSynCon pat_syn)    = patSynArity pat_syn\n\n-- | Names of fields used for selectors\nconLikeFieldLabels :: ConLike -> [FieldLabel]\nconLikeFieldLabels (RealDataCon data_con) = dataConFieldLabels data_con\nconLikeFieldLabels (PatSynCon pat_syn)    = patSynFieldLabels pat_syn\n\n-- | Returns just the instantiated /value/ argument types of a 'ConLike',\n-- (excluding dictionary args)\nconLikeInstOrigArgTys :: ConLike -> [Type] -> [Type]\nconLikeInstOrigArgTys (RealDataCon data_con) tys =\n    dataConInstOrigArgTys data_con tys\nconLikeInstOrigArgTys (PatSynCon pat_syn) tys =\n    patSynInstArgTys pat_syn tys\n\n-- | Existentially quantified type/coercion variables\nconLikeExTyCoVars :: ConLike -> [TyCoVar]\nconLikeExTyCoVars (RealDataCon dcon1) = dataConExTyCoVars dcon1\nconLikeExTyCoVars (PatSynCon psyn1)   = patSynExTyVars psyn1\n\nconLikeName :: ConLike -> Name\nconLikeName (RealDataCon data_con) = dataConName data_con\nconLikeName (PatSynCon pat_syn)    = patSynName pat_syn\n\n-- | The \\\"stupid theta\\\" of the 'ConLike', such as @data Eq a@ in:\n--\n-- > data Eq a => T a = ...\n-- It is empty for `PatSynCon` as they do not allow such contexts.\nconLikeStupidTheta :: ConLike -> ThetaType\nconLikeStupidTheta (RealDataCon data_con) = dataConStupidTheta data_con\nconLikeStupidTheta (PatSynCon {})         = []\n\n-- | Returns the `Id` of the wrapper. This is also known as the builder in\n-- some contexts. The value is Nothing only in the case of unidirectional\n-- pattern synonyms.\nconLikeWrapId_maybe :: ConLike -> Maybe Id\nconLikeWrapId_maybe (RealDataCon data_con) = Just $ dataConWrapId data_con\nconLikeWrapId_maybe (PatSynCon pat_syn)    = fst <$> patSynBuilder pat_syn\n\n-- | Returns the strictness information for each constructor\nconLikeImplBangs :: ConLike -> [HsImplBang]\nconLikeImplBangs (RealDataCon data_con) = dataConImplBangs data_con\nconLikeImplBangs (PatSynCon pat_syn)    =\n    replicate (patSynArity pat_syn) HsLazy\n\n-- | Returns the type of the whole pattern\nconLikeResTy :: ConLike -> [Type] -> Type\nconLikeResTy (RealDataCon con) tys = mkTyConApp (dataConTyCon con) tys\nconLikeResTy (PatSynCon ps)    tys = patSynInstResTy ps tys\n\n-- | The \\\"full signature\\\" of the 'ConLike' returns, in order:\n--\n-- 1) The universally quantified type variables\n--\n-- 2) The existentially quantified type/coercion variables\n--\n-- 3) The equality specification\n--\n-- 4) The provided theta (the constraints provided by a match)\n--\n-- 5) The required theta (the constraints required for a match)\n--\n-- 6) The original argument types (i.e. before\n--    any change of the representation of the type)\n--\n-- 7) The original result type\nconLikeFullSig :: ConLike\n               -> ([TyVar], [TyCoVar], [EqSpec]\n                   -- Why tyvars for universal but tycovars for existential?\n                   -- See Note [Existential coercion variables] in DataCon\n                  , ThetaType, ThetaType, [Type], Type)\nconLikeFullSig (RealDataCon con) =\n  let (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty) = dataConFullSig con\n  -- Required theta is empty as normal data cons require no additional\n  -- constraints for a match\n  in (univ_tvs, ex_tvs, eq_spec, theta, [], arg_tys, res_ty)\nconLikeFullSig (PatSynCon pat_syn) =\n let (univ_tvs, req, ex_tvs, prov, arg_tys, res_ty) = patSynSig pat_syn\n -- eqSpec is empty\n in (univ_tvs, ex_tvs, [], prov, req, arg_tys, res_ty)\n\n-- | Extract the type for any given labelled field of the 'ConLike'\nconLikeFieldType :: ConLike -> FieldLabelString -> Type\nconLikeFieldType (PatSynCon ps) label = patSynFieldType ps label\nconLikeFieldType (RealDataCon dc) label = dataConFieldType dc label\n\n\n-- | The ConLikes that have *all* the given fields\nconLikesWithFields :: [ConLike] -> [FieldLabelString] -> [ConLike]\nconLikesWithFields con_likes lbls = filter has_flds con_likes\n  where has_flds dc = all (has_fld dc) lbls\n        has_fld dc lbl = any (\\ fl -> flLabel fl == lbl) (conLikeFieldLabels dc)\n\nconLikeIsInfix :: ConLike -> Bool\nconLikeIsInfix (RealDataCon dc) = dataConIsInfix dc\nconLikeIsInfix (PatSynCon ps)   = patSynIsInfix  ps\n", "num_lines": 197}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1998\n\n\\section[DataCon]{@DataCon@: Data Constructors}\n-}\n\n{-# LANGUAGE CPP, DeriveDataTypeable #-}\n\nmodule DataCon (\n        -- * Main data types\n        DataCon, DataConRep(..),\n        SrcStrictness(..), SrcUnpackedness(..),\n        HsSrcBang(..), HsImplBang(..),\n        StrictnessMark(..),\n        ConTag,\n\n        -- ** Equality specs\n        EqSpec, mkEqSpec, eqSpecTyVar, eqSpecType,\n        eqSpecPair, eqSpecPreds,\n        substEqSpec, filterEqSpec,\n\n        -- ** Field labels\n        FieldLbl(..), FieldLabel, FieldLabelString,\n\n        -- ** Type construction\n        mkDataCon, buildAlgTyCon, buildSynTyCon, fIRST_TAG,\n\n        -- ** Type deconstruction\n        dataConRepType, dataConSig, dataConInstSig, dataConFullSig,\n        dataConName, dataConIdentity, dataConTag, dataConTagZ,\n        dataConTyCon, dataConOrigTyCon,\n        dataConUserType,\n        dataConUnivTyVars, dataConExTyCoVars, dataConUnivAndExTyCoVars,\n        dataConUserTyVars, dataConUserTyVarBinders,\n        dataConEqSpec, dataConTheta,\n        dataConStupidTheta,\n        dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,\n        dataConInstOrigArgTys, dataConRepArgTys,\n        dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,\n        dataConSrcBangs,\n        dataConSourceArity, dataConRepArity,\n        dataConIsInfix,\n        dataConWorkId, dataConWrapId, dataConWrapId_maybe,\n        dataConImplicitTyThings,\n        dataConRepStrictness, dataConImplBangs, dataConBoxer,\n\n        splitDataProductType_maybe,\n\n        -- ** Predicates on DataCons\n        isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon,\n        isUnboxedSumCon,\n        isVanillaDataCon, classDataCon, dataConCannotMatch,\n        dataConUserTyVarsArePermuted,\n        isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,\n        specialPromotedDc,\n\n        -- ** Promotion related functions\n        promoteDataCon\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} MkId( DataConBoxer )\nimport Type\nimport ForeignCall ( CType )\nimport Coercion\nimport Unify\nimport TyCon\nimport FieldLabel\nimport Class\nimport Name\nimport PrelNames\nimport Var\nimport VarSet( emptyVarSet )\nimport Outputable\nimport Util\nimport BasicTypes\nimport FastString\nimport Module\nimport Binary\nimport UniqSet\nimport Unique( mkAlphaTyVarUnique )\n\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString.Builder as BSB\nimport qualified Data.ByteString.Lazy    as LBS\nimport qualified Data.Data as Data\nimport Data.Char\nimport Data.List( find )\n\n{-\nData constructor representation\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following Haskell data type declaration\n\n        data T = T !Int ![Int]\n\nUsing the strictness annotations, GHC will represent this as\n\n        data T = T Int# [Int]\n\nThat is, the Int has been unboxed.  Furthermore, the Haskell source construction\n\n        T e1 e2\n\nis translated to\n\n        case e1 of { I# x ->\n        case e2 of { r ->\n        T x r }}\n\nThat is, the first argument is unboxed, and the second is evaluated.  Finally,\npattern matching is translated too:\n\n        case e of { T a b -> ... }\n\nbecomes\n\n        case e of { T a' b -> let a = I# a' in ... }\n\nTo keep ourselves sane, we name the different versions of the data constructor\ndifferently, as follows.\n\n\nNote [Data Constructor Naming]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEach data constructor C has two, and possibly up to four, Names associated with it:\n\n                   OccName   Name space   Name of   Notes\n ---------------------------------------------------------------------------\n The \"data con itself\"   C     DataName   DataCon   In dom( GlobalRdrEnv )\n The \"worker data con\"   C     VarName    Id        The worker\n The \"wrapper data con\"  $WC   VarName    Id        The wrapper\n The \"newtype coercion\"  :CoT  TcClsName  TyCon\n\nEVERY data constructor (incl for newtypes) has the former two (the\ndata con itself, and its worker.  But only some data constructors have a\nwrapper (see Note [The need for a wrapper]).\n\nEach of these three has a distinct Unique.  The \"data con itself\" name\nappears in the output of the renamer, and names the Haskell-source\ndata constructor.  The type checker translates it into either the wrapper Id\n(if it exists) or worker Id (otherwise).\n\nThe data con has one or two Ids associated with it:\n\nThe \"worker Id\", is the actual data constructor.\n* Every data constructor (newtype or data type) has a worker\n\n* The worker is very like a primop, in that it has no binding.\n\n* For a *data* type, the worker *is* the data constructor;\n  it has no unfolding\n\n* For a *newtype*, the worker has a compulsory unfolding which\n  does a cast, e.g.\n        newtype T = MkT Int\n        The worker for MkT has unfolding\n                \\\\(x:Int). x `cast` sym CoT\n  Here CoT is the type constructor, witnessing the FC axiom\n        axiom CoT : T = Int\n\nThe \"wrapper Id\", \\$WC, goes as follows\n\n* Its type is exactly what it looks like in the source program.\n\n* It is an ordinary function, and it gets a top-level binding\n  like any other function.\n\n* The wrapper Id isn't generated for a data type if there is\n  nothing for the wrapper to do.  That is, if its defn would be\n        \\$wC = C\n\nNote [Data constructor workers and wrappers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Algebraic data types\n  - Always have a worker, with no unfolding\n  - May or may not have a wrapper; see Note [The need for a wrapper]\n\n* Newtypes\n  - Always have a worker, which has a compulsory unfolding (just a cast)\n  - May or may not have a wrapper; see Note [The need for a wrapper]\n\n* INVARIANT: the dictionary constructor for a class\n             never has a wrapper.\n\n* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments\n\n* The wrapper (if it exists) takes dcOrigArgTys as its arguments\n  The worker takes dataConRepArgTys as its arguments\n  If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys\n\n* The 'NoDataConRep' case of DataConRep is important. Not only is it\n  efficient, but it also ensures that the wrapper is replaced by the\n  worker (because it *is* the worker) even when there are no\n  args. E.g. in\n               f (:) x\n  the (:) *is* the worker.  This is really important in rule matching,\n  (We could match on the wrappers, but that makes it less likely that\n  rules will match when we bring bits of unfoldings together.)\n\nNote [The need for a wrapper]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhy might the wrapper have anything to do?  The full story is\nin wrapper_reqd in MkId.mkDataConRep.\n\n* Unboxing strict fields (with -funbox-strict-fields)\n        data T = MkT !(Int,Int)\n        \\$wMkT :: (Int,Int) -> T\n        \\$wMkT (x,y) = MkT x y\n  Notice that the worker has two fields where the wapper has\n  just one.  That is, the worker has type\n                MkT :: Int -> Int -> T\n\n* Equality constraints for GADTs\n        data T a where { MkT :: a -> T [a] }\n\n  The worker gets a type with explicit equality\n  constraints, thus:\n        MkT :: forall a b. (a=[b]) => b -> T a\n\n  The wrapper has the programmer-specified type:\n        \\$wMkT :: a -> T [a]\n        \\$wMkT a x = MkT [a] a [a] x\n  The third argument is a coercion\n        [a] :: [a]~[a]\n\n* Data family instances may do a cast on the result\n\n* Type variables may be permuted; see MkId\n  Note [Data con wrappers and GADT syntax]\n\n\nNote [The stupid context]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nData types can have a context:\n\n        data (Eq a, Ord b) => T a b = T1 a b | T2 a\n\nand that makes the constructors have a context too\n(notice that T2's context is \"thinned\"):\n\n        T1 :: (Eq a, Ord b) => a -> b -> T a b\n        T2 :: (Eq a) => a -> T a b\n\nFurthermore, this context pops up when pattern matching\n(though GHC hasn't implemented this, but it is in H98, and\nI've fixed GHC so that it now does):\n\n        f (T2 x) = x\ngets inferred type\n        f :: Eq a => T a b -> a\n\nI say the context is \"stupid\" because the dictionaries passed\nare immediately discarded -- they do nothing and have no benefit.\nIt's a flaw in the language.\n\n        Up to now [March 2002] I have put this stupid context into the\n        type of the \"wrapper\" constructors functions, T1 and T2, but\n        that turned out to be jolly inconvenient for generics, and\n        record update, and other functions that build values of type T\n        (because they don't have suitable dictionaries available).\n\n        So now I've taken the stupid context out.  I simply deal with\n        it separately in the type checker on occurrences of a\n        constructor, either in an expression or in a pattern.\n\n        [May 2003: actually I think this decision could easily be\n        reversed now, and probably should be.  Generics could be\n        disabled for types with a stupid context; record updates now\n        (H98) needs the context too; etc.  It's an unforced change, so\n        I'm leaving it for now --- but it does seem odd that the\n        wrapper doesn't include the stupid context.]\n\n[July 04] With the advent of generalised data types, it's less obvious\nwhat the \"stupid context\" is.  Consider\n        C :: forall a. Ord a => a -> a -> T (Foo a)\nDoes the C constructor in Core contain the Ord dictionary?  Yes, it must:\n\n        f :: T b -> Ordering\n        f = /\\b. \\x:T b.\n            case x of\n                C a (d:Ord a) (p:a) (q:a) -> compare d p q\n\nNote that (Foo a) might not be an instance of Ord.\n\n************************************************************************\n*                                                                      *\n\\subsection{Data constructors}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A data constructor\n--\n-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n--             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma'\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata DataCon\n  = MkData {\n        dcName    :: Name,      -- This is the name of the *source data con*\n                                -- (see \"Note [Data Constructor Naming]\" above)\n        dcUnique :: Unique,     -- Cached from Name\n        dcTag    :: ConTag,     -- ^ Tag, used for ordering 'DataCon's\n\n        -- Running example:\n        --\n        --      *** As declared by the user\n        --  data T a b c where\n        --    MkT :: forall c y x b. (x~y,Ord x) => x -> y -> T (x,y) b c\n\n        --      *** As represented internally\n        --  data T a b c where\n        --    MkT :: forall a b c. forall x y. (a~(x,y),x~y,Ord x)\n        --        => x -> y -> T a b c\n        --\n        -- The next six fields express the type of the constructor, in pieces\n        -- e.g.\n        --\n        --      dcUnivTyVars       = [a,b,c]\n        --      dcExTyCoVars       = [x,y]\n        --      dcUserTyVarBinders = [c,y,x,b]\n        --      dcEqSpec           = [a~(x,y)]\n        --      dcOtherTheta       = [x~y, Ord x]\n        --      dcOrigArgTys       = [x,y]\n        --      dcRepTyCon         = T\n\n        -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE\n        -- TYVARS FOR THE PARENT TyCon. (This is a change (Oct05): previously,\n        -- vanilla datacons guaranteed to have the same type variables as their\n        -- parent TyCon, but that seems ugly.) They can be different in the case\n        -- where a GADT constructor uses different names for the universal\n        -- tyvars than does the tycon. For example:\n        --\n        --   data H a where\n        --     MkH :: b -> H b\n        --\n        -- Here, the tyConTyVars of H will be [a], but the dcUnivTyVars of MkH\n        -- will be [b].\n\n        dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor\n                                --          Its type is of form\n                                --              forall a1..an . t1 -> ... tm -> T a1..an\n                                --          No existentials, no coercions, nothing.\n                                -- That is: dcExTyCoVars = dcEqSpec = dcOtherTheta = []\n                -- NB 1: newtypes always have a vanilla data con\n                -- NB 2: a vanilla constructor can still be declared in GADT-style\n                --       syntax, provided its type looks like the above.\n                --       The declaration format is held in the TyCon (algTcGadtSyntax)\n\n        -- Universally-quantified type vars [a,b,c]\n        -- INVARIANT: length matches arity of the dcRepTyCon\n        -- INVARIANT: result type of data con worker is exactly (T a b c)\n        -- COROLLARY: The dcUnivTyVars are always in one-to-one correspondence with\n        --            the tyConTyVars of the parent TyCon\n        dcUnivTyVars     :: [TyVar],\n\n        -- Existentially-quantified type and coercion vars [x,y]\n        -- For an example involving coercion variables,\n        -- Why tycovars? See Note [Existential coercion variables]\n        dcExTyCoVars     :: [TyCoVar],\n\n        -- INVARIANT: the UnivTyVars and ExTyCoVars all have distinct OccNames\n        -- Reason: less confusing, and easier to generate IfaceSyn\n\n        -- The type/coercion vars in the order the user wrote them [c,y,x,b]\n        -- INVARIANT: the set of tyvars in dcUserTyVarBinders is exactly the set\n        --            of tyvars (*not* covars) of dcExTyCoVars unioned with the\n        --            set of dcUnivTyVars whose tyvars do not appear in dcEqSpec\n        -- See Note [DataCon user type variable binders]\n        dcUserTyVarBinders :: [TyVarBinder],\n\n        dcEqSpec :: [EqSpec],   -- Equalities derived from the result type,\n                                -- _as written by the programmer_.\n                                -- Only non-dependent GADT equalities (dependent\n                                -- GADT equalities are in the covars of\n                                -- dcExTyCoVars).\n\n                -- This field allows us to move conveniently between the two ways\n                -- of representing a GADT constructor's type:\n                --      MkT :: forall a b. (a ~ [b]) => b -> T a\n                --      MkT :: forall b. b -> T [b]\n                -- Each equality is of the form (a ~ ty), where 'a' is one of\n                -- the universally quantified type variables\n\n                -- The next two fields give the type context of the data constructor\n                --      (aside from the GADT constraints,\n                --       which are given by the dcExpSpec)\n                -- In GADT form, this is *exactly* what the programmer writes, even if\n                -- the context constrains only universally quantified variables\n                --      MkT :: forall a b. (a ~ b, Ord b) => a -> T a b\n        dcOtherTheta :: ThetaType,  -- The other constraints in the data con's type\n                                    -- other than those in the dcEqSpec\n\n        dcStupidTheta :: ThetaType,     -- The context of the data type declaration\n                                        --      data Eq a => T a = ...\n                                        -- or, rather, a \"thinned\" version thereof\n                -- \"Thinned\", because the Report says\n                -- to eliminate any constraints that don't mention\n                -- tyvars free in the arg types for this constructor\n                --\n                -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars\n                -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon\n                --\n                -- \"Stupid\", because the dictionaries aren't used for anything.\n                -- Indeed, [as of March 02] they are no longer in the type of\n                -- the wrapper Id, because that makes it harder to use the wrap-id\n                -- to rebuild values after record selection or in generics.\n\n        dcOrigArgTys :: [Type],         -- Original argument types\n                                        -- (before unboxing and flattening of strict fields)\n        dcOrigResTy :: Type,            -- Original result type, as seen by the user\n                -- NB: for a data instance, the original user result type may\n                -- differ from the DataCon's representation TyCon.  Example\n                --      data instance T [a] where MkT :: a -> T [a]\n                -- The OrigResTy is T [a], but the dcRepTyCon might be :T123\n\n        -- Now the strictness annotations and field labels of the constructor\n        dcSrcBangs :: [HsSrcBang],\n                -- See Note [Bangs on data constructor arguments]\n                --\n                -- The [HsSrcBang] as written by the programmer.\n                --\n                -- Matches 1-1 with dcOrigArgTys\n                -- Hence length = dataConSourceArity dataCon\n\n        dcFields  :: [FieldLabel],\n                -- Field labels for this constructor, in the\n                -- same order as the dcOrigArgTys;\n                -- length = 0 (if not a record) or dataConSourceArity.\n\n        -- The curried worker function that corresponds to the constructor:\n        -- It doesn't have an unfolding; the code generator saturates these Ids\n        -- and allocates a real constructor when it finds one.\n        dcWorkId :: Id,\n\n        -- Constructor representation\n        dcRep      :: DataConRep,\n\n        -- Cached; see Note [DataCon arities]\n        -- INVARIANT: dcRepArity    == length dataConRepArgTys + count isCoVar (dcExTyCoVars)\n        -- INVARIANT: dcSourceArity == length dcOrigArgTys\n        dcRepArity    :: Arity,\n        dcSourceArity :: Arity,\n\n        -- Result type of constructor is T t1..tn\n        dcRepTyCon  :: TyCon,           -- Result tycon, T\n\n        dcRepType   :: Type,    -- Type of the constructor\n                                --      forall a x y. (a~(x,y), x~y, Ord x) =>\n                                --        x -> y -> T a\n                                -- (this is *not* of the constructor wrapper Id:\n                                --  see Note [Data con representation] below)\n        -- Notice that the existential type parameters come *second*.\n        -- Reason: in a case expression we may find:\n        --      case (e :: T t) of\n        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...\n        -- It's convenient to apply the rep-type of MkT to 't', to get\n        --      forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t\n        -- and use that to check the pattern.  Mind you, this is really only\n        -- used in CoreLint.\n\n\n        dcInfix :: Bool,        -- True <=> declared infix\n                                -- Used for Template Haskell and 'deriving' only\n                                -- The actual fixity is stored elsewhere\n\n        dcPromoted :: TyCon    -- The promoted TyCon\n                               -- See Note [Promoted data constructors] in TyCon\n  }\n\n\n{- Note [TyVarBinders in DataCons]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor the TyVarBinders in a DataCon and PatSyn:\n\n * Each argument flag is Inferred or Specified.\n   None are Required. (A DataCon is a term-level function; see\n   Note [No Required TyCoBinder in terms] in TyCoRep.)\n\nWhy do we need the TyVarBinders, rather than just the TyVars?  So that\nwe can construct the right type for the DataCon with its foralls\nattributed the correct visibility.  That in turn governs whether you\ncan use visible type application at a call of the data constructor.\n\nSee also [DataCon user type variable binders] for an extended discussion on the\norder in which TyVarBinders appear in a DataCon.\n\nNote [Existential coercion variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nFor now (Aug 2018) we can't write coercion quantifications in source Haskell, but\nwe can in Core. Consider having:\n\n  data T :: forall k. k -> k -> Constraint where\n    MkT :: forall k (a::k) (b::k). forall k' (c::k') (co::k'~k). (b~(c|>co))\n        => T k a b\n\n  dcUnivTyVars       = [k,a,b]\n  dcExTyCoVars       = [k',c,co]\n  dcUserTyVarBinders = [k,a,k',c]\n  dcEqSpec           = [b~(c|>co)]\n  dcOtherTheta       = []\n  dcOrigArgTys       = []\n  dcRepTyCon         = T\n\n  Function call 'dataConKindEqSpec' returns [k'~k]\n\nNote [DataCon arities]\n~~~~~~~~~~~~~~~~~~~~~~\ndcSourceArity does not take constraints into account,\nbut dcRepArity does.  For example:\n   MkT :: Ord a => a -> T a\n    dcSourceArity = 1\n    dcRepArity    = 2\n\nNote [DataCon user type variable binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn System FC, data constructor type signatures always quantify over all of\ntheir universal type variables, followed by their existential type variables.\nNormally, this isn't a problem, as most datatypes naturally quantify their type\nvariables in this order anyway. For example:\n\n  data T a b = forall c. MkT b c\n\nHere, we have `MkT :: forall {k} (a :: k) (b :: *) (c :: *). b -> c -> T a b`,\nwhere k, a, and b are universal and c is existential. (The inferred variable k\nisn't available for TypeApplications, hence why it's in braces.) This is a\nperfectly reasonable order to use, as the syntax of H98-style datatypes\n(+ ExistentialQuantification) suggests it.\n\nThings become more complicated when GADT syntax enters the picture. Consider\nthis example:\n\n  data X a where\n    MkX :: forall b a. b -> Proxy a -> X a\n\nIf we adopt the earlier approach of quantifying all the universal variables\nfollowed by all the existential ones, GHC would come up with this type\nsignature for MkX:\n\n  MkX :: forall {k} (a :: k) (b :: *). b -> Proxy a -> X a\n\nBut this is not what we want at all! After all, if a user were to use\nTypeApplications on MkX, they would expect to instantiate `b` before `a`,\nas that's the order in which they were written in the `forall`. (See #11721.)\nInstead, we'd like GHC to come up with this type signature:\n\n  MkX :: forall {k} (b :: *) (a :: k). b -> Proxy a -> X a\n\nIn fact, even if we left off the explicit forall:\n\n  data X a where\n    MkX :: b -> Proxy a -> X a\n\nThen a user should still expect `b` to be quantified before `a`, since\naccording to the rules of TypeApplications, in the absence of `forall` GHC\nperforms a stable topological sort on the type variables in the user-written\ntype signature, which would place `b` before `a`.\n\nBut as noted above, enacting this behavior is not entirely trivial, as System\nFC demands the variables go in universal-then-existential order under the hood.\nOur solution is thus to equip DataCon with two different sets of type\nvariables:\n\n* dcUnivTyVars and dcExTyCoVars, for the universal type variable and existential\n  type/coercion variables, respectively. Their order is irrelevant for the\n  purposes of TypeApplications, and as a consequence, they do not come equipped\n  with visibilities (that is, they are TyVars/TyCoVars instead of\n  TyCoVarBinders).\n* dcUserTyVarBinders, for the type variables binders in the order in which they\n  originally arose in the user-written type signature. Their order *does* matter\n  for TypeApplications, so they are full TyVarBinders, complete with\n  visibilities.\n\nThis encoding has some redundancy. The set of tyvars in dcUserTyVarBinders\nconsists precisely of:\n\n* The set of tyvars in dcUnivTyVars whose type variables do not appear in\n  dcEqSpec, unioned with:\n* The set of tyvars (*not* covars) in dcExTyCoVars\n  No covars here because because they're not user-written\n\nThe word \"set\" is used above because the order in which the tyvars appear in\ndcUserTyVarBinders can be completely different from the order in dcUnivTyVars or\ndcExTyCoVars. That is, the tyvars in dcUserTyVarBinders are a permutation of\n(tyvars of dcExTyCoVars + a subset of dcUnivTyVars). But aside from the\nordering, they in fact share the same type variables (with the same Uniques). We\nsometimes refer to this as \"the dcUserTyVarBinders invariant\".\n\ndcUserTyVarBinders, as the name suggests, is the one that users will see most of\nthe time. It's used when computing the type signature of a data constructor (see\ndataConUserType), and as a result, it's what matters from a TypeApplications\nperspective.\n-}\n\n-- | Data Constructor Representation\n-- See Note [Data constructor workers and wrappers]\ndata DataConRep\n  = -- NoDataConRep means that the data con has no wrapper\n    NoDataConRep\n\n    -- DCR means that the data con has a wrapper\n  | DCR { dcr_wrap_id :: Id   -- Takes src args, unboxes/flattens,\n                              -- and constructs the representation\n\n        , dcr_boxer   :: DataConBoxer\n\n        , dcr_arg_tys :: [Type]  -- Final, representation argument types,\n                                 -- after unboxing and flattening,\n                                 -- and *including* all evidence args\n\n        , dcr_stricts :: [StrictnessMark]  -- 1-1 with dcr_arg_tys\n                -- See also Note [Data-con worker strictness] in MkId.hs\n\n        , dcr_bangs :: [HsImplBang]  -- The actual decisions made (including failures)\n                                     -- about the original arguments; 1-1 with orig_arg_tys\n                                     -- See Note [Bangs on data constructor arguments]\n\n    }\n\n-------------------------\n\n-- | Haskell Source Bang\n--\n-- Bangs on data constructor arguments as the user wrote them in the\n-- source code.\n--\n-- @(HsSrcBang _ SrcUnpack SrcLazy)@ and\n-- @(HsSrcBang _ SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we\n-- emit a warning (in checkValidDataCon) and treat it like\n-- @(HsSrcBang _ NoSrcUnpack SrcLazy)@\ndata HsSrcBang =\n  HsSrcBang SourceText -- Note [Pragma source text] in BasicTypes\n            SrcUnpackedness\n            SrcStrictness\n  deriving Data.Data\n\n-- | Haskell Implementation Bang\n--\n-- Bangs of data constructor arguments as generated by the compiler\n-- after consulting HsSrcBang, flags, etc.\ndata HsImplBang\n  = HsLazy    -- ^ Lazy field, or one with an unlifted type\n  | HsStrict  -- ^ Strict but not unpacked field\n  | HsUnpack (Maybe Coercion)\n    -- ^ Strict and unpacked field\n    -- co :: arg-ty ~ product-ty HsBang\n  deriving Data.Data\n\n-- | Source Strictness\n--\n-- What strictness annotation the user wrote\ndata SrcStrictness = SrcLazy -- ^ Lazy, ie '~'\n                   | SrcStrict -- ^ Strict, ie '!'\n                   | NoSrcStrict -- ^ no strictness annotation\n     deriving (Eq, Data.Data)\n\n-- | Source Unpackedness\n--\n-- What unpackedness the user requested\ndata SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified\n                     | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified\n                     | NoSrcUnpack -- ^ no unpack pragma\n     deriving (Eq, Data.Data)\n\n\n\n-------------------------\n-- StrictnessMark is internal only, used to indicate strictness\n-- of the DataCon *worker* fields\ndata StrictnessMark = MarkedStrict | NotMarkedStrict\n\n-- | An 'EqSpec' is a tyvar/type pair representing an equality made in\n-- rejigging a GADT constructor\ndata EqSpec = EqSpec TyVar\n                     Type\n\n-- | Make a non-dependent 'EqSpec'\nmkEqSpec :: TyVar -> Type -> EqSpec\nmkEqSpec tv ty = EqSpec tv ty\n\neqSpecTyVar :: EqSpec -> TyVar\neqSpecTyVar (EqSpec tv _) = tv\n\neqSpecType :: EqSpec -> Type\neqSpecType (EqSpec _ ty) = ty\n\neqSpecPair :: EqSpec -> (TyVar, Type)\neqSpecPair (EqSpec tv ty) = (tv, ty)\n\neqSpecPreds :: [EqSpec] -> ThetaType\neqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty\n                   | EqSpec tv ty <- spec ]\n\n-- | Substitute in an 'EqSpec'. Precondition: if the LHS of the EqSpec\n-- is mapped in the substitution, it is mapped to a type variable, not\n-- a full type.\nsubstEqSpec :: TCvSubst -> EqSpec -> EqSpec\nsubstEqSpec subst (EqSpec tv ty)\n  = EqSpec tv' (substTy subst ty)\n  where\n    tv' = getTyVar \"substEqSpec\" (substTyVar subst tv)\n\n-- | Filter out any 'TyVar's mentioned in an 'EqSpec'.\nfilterEqSpec :: [EqSpec] -> [TyVar] -> [TyVar]\nfilterEqSpec eq_spec\n  = filter not_in_eq_spec\n  where\n    not_in_eq_spec var = all (not . (== var) . eqSpecTyVar) eq_spec\n\ninstance Outputable EqSpec where\n  ppr (EqSpec tv ty) = ppr (tv, ty)\n\n{- Note [Bangs on data constructor arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data T = MkT !Int {-# UNPACK #-} !Int Bool\n\nWhen compiling the module, GHC will decide how to represent\nMkT, depending on the optimisation level, and settings of\nflags like -funbox-small-strict-fields.\n\nTerminology:\n  * HsSrcBang:  What the user wrote\n                Constructors: HsSrcBang\n\n  * HsImplBang: What GHC decided\n                Constructors: HsLazy, HsStrict, HsUnpack\n\n* If T was defined in this module, MkT's dcSrcBangs field\n  records the [HsSrcBang] of what the user wrote; in the example\n    [ HsSrcBang _ NoSrcUnpack SrcStrict\n    , HsSrcBang _ SrcUnpack SrcStrict\n    , HsSrcBang _ NoSrcUnpack NoSrcStrictness]\n\n* However, if T was defined in an imported module, the importing module\n  must follow the decisions made in the original module, regardless of\n  the flag settings in the importing module.\n  Also see Note [Bangs on imported data constructors] in MkId\n\n* The dcr_bangs field of the dcRep field records the [HsImplBang]\n  If T was defined in this module, Without -O the dcr_bangs might be\n    [HsStrict, HsStrict, HsLazy]\n  With -O it might be\n    [HsStrict, HsUnpack _, HsLazy]\n  With -funbox-small-strict-fields it might be\n    [HsUnpack, HsUnpack _, HsLazy]\n  With -XStrictData it might be\n    [HsStrict, HsUnpack _, HsStrict]\n\nNote [Data con representation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe dcRepType field contains the type of the representation of a constructor\nThis may differ from the type of the constructor *Id* (built\nby MkId.mkDataConId) for two reasons:\n        a) the constructor Id may be overloaded, but the dictionary isn't stored\n           e.g.    data Eq a => T a = MkT a a\n\n        b) the constructor may store an unboxed version of a strict field.\n\nHere's an example illustrating both:\n        data Ord a => T a = MkT Int! a\nHere\n        T :: Ord a => Int -> a -> T a\nbut the rep type is\n        Trep :: Int# -> a -> T a\nActually, the unboxed part isn't implemented yet!\n\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Instances}\n*                                                                      *\n************************************************************************\n-}\n\ninstance Eq DataCon where\n    a == b = getUnique a == getUnique b\n    a /= b = getUnique a /= getUnique b\n\ninstance Uniquable DataCon where\n    getUnique = dcUnique\n\ninstance NamedThing DataCon where\n    getName = dcName\n\ninstance Outputable DataCon where\n    ppr con = ppr (dataConName con)\n\ninstance OutputableBndr DataCon where\n    pprInfixOcc con = pprInfixName (dataConName con)\n    pprPrefixOcc con = pprPrefixName (dataConName con)\n\ninstance Data.Data DataCon where\n    -- don't traverse?\n    toConstr _   = abstractConstr \"DataCon\"\n    gunfold _ _  = error \"gunfold\"\n    dataTypeOf _ = mkNoRepType \"DataCon\"\n\ninstance Outputable HsSrcBang where\n    ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark\n\ninstance Outputable HsImplBang where\n    ppr HsLazy                  = text \"Lazy\"\n    ppr (HsUnpack Nothing)      = text \"Unpacked\"\n    ppr (HsUnpack (Just co))    = text \"Unpacked\" <> parens (ppr co)\n    ppr HsStrict                = text \"StrictNotUnpacked\"\n\ninstance Outputable SrcStrictness where\n    ppr SrcLazy     = char '~'\n    ppr SrcStrict   = char '!'\n    ppr NoSrcStrict = empty\n\ninstance Outputable SrcUnpackedness where\n    ppr SrcUnpack   = text \"{-# UNPACK #-}\"\n    ppr SrcNoUnpack = text \"{-# NOUNPACK #-}\"\n    ppr NoSrcUnpack = empty\n\ninstance Outputable StrictnessMark where\n    ppr MarkedStrict    = text \"!\"\n    ppr NotMarkedStrict = empty\n\ninstance Binary SrcStrictness where\n    put_ bh SrcLazy     = putByte bh 0\n    put_ bh SrcStrict   = putByte bh 1\n    put_ bh NoSrcStrict = putByte bh 2\n\n    get bh =\n      do h <- getByte bh\n         case h of\n           0 -> return SrcLazy\n           1 -> return SrcStrict\n           _ -> return NoSrcStrict\n\ninstance Binary SrcUnpackedness where\n    put_ bh SrcNoUnpack = putByte bh 0\n    put_ bh SrcUnpack   = putByte bh 1\n    put_ bh NoSrcUnpack = putByte bh 2\n\n    get bh =\n      do h <- getByte bh\n         case h of\n           0 -> return SrcNoUnpack\n           1 -> return SrcUnpack\n           _ -> return NoSrcUnpack\n\n-- | Compare strictness annotations\neqHsBang :: HsImplBang -> HsImplBang -> Bool\neqHsBang HsLazy               HsLazy              = True\neqHsBang HsStrict             HsStrict            = True\neqHsBang (HsUnpack Nothing)   (HsUnpack Nothing)  = True\neqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2))\n  = eqType (coercionType c1) (coercionType c2)\neqHsBang _ _                                       = False\n\nisBanged :: HsImplBang -> Bool\nisBanged (HsUnpack {}) = True\nisBanged (HsStrict {}) = True\nisBanged HsLazy        = False\n\nisSrcStrict :: SrcStrictness -> Bool\nisSrcStrict SrcStrict = True\nisSrcStrict _ = False\n\nisSrcUnpacked :: SrcUnpackedness -> Bool\nisSrcUnpacked SrcUnpack = True\nisSrcUnpacked _ = False\n\nisMarkedStrict :: StrictnessMark -> Bool\nisMarkedStrict NotMarkedStrict = False\nisMarkedStrict _               = True   -- All others are strict\n\n{- *********************************************************************\n*                                                                      *\n\\subsection{Construction}\n*                                                                      *\n********************************************************************* -}\n\n-- | Build a new data constructor\nmkDataCon :: Name\n          -> Bool           -- ^ Is the constructor declared infix?\n          -> TyConRepName   -- ^  TyConRepName for the promoted TyCon\n          -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user\n          -> [FieldLabel]   -- ^ Field labels for the constructor,\n                            -- if it is a record, otherwise empty\n          -> [TyVar]        -- ^ Universals.\n          -> [TyCoVar]      -- ^ Existentials.\n          -> [TyVarBinder]  -- ^ User-written 'TyVarBinder's.\n                            --   These must be Inferred/Specified.\n                            --   See @Note [TyVarBinders in DataCons]@\n          -> [EqSpec]       -- ^ GADT equalities\n          -> KnotTied ThetaType -- ^ Theta-type occurring before the arguments proper\n          -> [KnotTied Type]    -- ^ Original argument types\n          -> KnotTied Type      -- ^ Original result type\n          -> RuntimeRepInfo     -- ^ See comments on 'TyCon.RuntimeRepInfo'\n          -> KnotTied TyCon     -- ^ Representation type constructor\n          -> ConTag             -- ^ Constructor tag\n          -> ThetaType          -- ^ The \"stupid theta\", context of the data\n                                -- declaration e.g. @data Eq a => T a ...@\n          -> Id                 -- ^ Worker Id\n          -> DataConRep         -- ^ Representation\n          -> DataCon\n  -- Can get the tag from the TyCon\n\nmkDataCon name declared_infix prom_info\n          arg_stricts   -- Must match orig_arg_tys 1-1\n          fields\n          univ_tvs ex_tvs user_tvbs\n          eq_spec theta\n          orig_arg_tys orig_res_ty rep_info rep_tycon tag\n          stupid_theta work_id rep\n-- Warning: mkDataCon is not a good place to check certain invariants.\n-- If the programmer writes the wrong result type in the decl, thus:\n--      data T a where { MkT :: S }\n-- then it's possible that the univ_tvs may hit an assertion failure\n-- if you pull on univ_tvs.  This case is checked by checkValidDataCon,\n-- so the error is detected properly... it's just that assertions here\n-- are a little dodgy.\n\n  = con\n  where\n    is_vanilla = null ex_tvs && null eq_spec && null theta\n\n    con = MkData {dcName = name, dcUnique = nameUnique name,\n                  dcVanilla = is_vanilla, dcInfix = declared_infix,\n                  dcUnivTyVars = univ_tvs,\n                  dcExTyCoVars = ex_tvs,\n                  dcUserTyVarBinders = user_tvbs,\n                  dcEqSpec = eq_spec,\n                  dcOtherTheta = theta,\n                  dcStupidTheta = stupid_theta,\n                  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,\n                  dcRepTyCon = rep_tycon,\n                  dcSrcBangs = arg_stricts,\n                  dcFields = fields, dcTag = tag, dcRepType = rep_ty,\n                  dcWorkId = work_id,\n                  dcRep = rep,\n                  dcSourceArity = length orig_arg_tys,\n                  dcRepArity = length rep_arg_tys + count isCoVar ex_tvs,\n                  dcPromoted = promoted }\n\n        -- The 'arg_stricts' passed to mkDataCon are simply those for the\n        -- source-language arguments.  We add extra ones for the\n        -- dictionary arguments right here.\n\n    rep_arg_tys = dataConRepArgTys con\n\n    rep_ty =\n      case rep of\n        -- If the DataCon has no wrapper, then the worker's type *is* the\n        -- user-facing type, so we can simply use dataConUserType.\n        NoDataConRep -> dataConUserType con\n        -- If the DataCon has a wrapper, then the worker's type is never seen\n        -- by the user. The visibilities we pick do not matter here.\n        DCR{} -> mkInvForAllTys univ_tvs $ mkTyCoInvForAllTys ex_tvs $\n                 mkVisFunTys rep_arg_tys $\n                 mkTyConApp rep_tycon (mkTyVarTys univ_tvs)\n\n      -- See Note [Promoted data constructors] in TyCon\n    prom_tv_bndrs = [ mkNamedTyConBinder vis tv\n                    | Bndr tv vis <- user_tvbs ]\n\n    fresh_names = freshNames (map getName user_tvbs)\n      -- fresh_names: make sure that the \"anonymous\" tyvars don't\n      -- clash in name or unique with the universal/existential ones.\n      -- Tiresome!  And unnecessary because these tyvars are never looked at\n    prom_theta_bndrs = [ mkAnonTyConBinder InvisArg (mkTyVar n t)\n     {- Invisible -}   | (n,t) <- fresh_names `zip` theta ]\n    prom_arg_bndrs   = [ mkAnonTyConBinder VisArg (mkTyVar n t)\n     {- Visible -}     | (n,t) <- dropList theta fresh_names `zip` orig_arg_tys ]\n    prom_bndrs       = prom_tv_bndrs ++ prom_theta_bndrs ++ prom_arg_bndrs\n    prom_res_kind    = orig_res_ty\n    promoted         = mkPromotedDataCon con name prom_info prom_bndrs\n                                         prom_res_kind roles rep_info\n\n    roles = map (\\tv -> if isTyVar tv then Nominal else Phantom)\n                (univ_tvs ++ ex_tvs)\n            ++ map (const Representational) (theta ++ orig_arg_tys)\n\nfreshNames :: [Name] -> [Name]\n-- Make an infinite list of Names whose Uniques and OccNames\n-- differ from those in the 'avoid' list\nfreshNames avoids\n  = [ mkSystemName uniq occ\n    | n <- [0..]\n    , let uniq = mkAlphaTyVarUnique n\n          occ = mkTyVarOccFS (mkFastString ('x' : show n))\n\n    , not (uniq `elementOfUniqSet` avoid_uniqs)\n    , not (occ `elemOccSet` avoid_occs) ]\n\n  where\n    avoid_uniqs :: UniqSet Unique\n    avoid_uniqs = mkUniqSet (map getUnique avoids)\n\n    avoid_occs :: OccSet\n    avoid_occs = mkOccSet (map getOccName avoids)\n\n-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification\ndataConName :: DataCon -> Name\ndataConName = dcName\n\n-- | The tag used for ordering 'DataCon's\ndataConTag :: DataCon -> ConTag\ndataConTag  = dcTag\n\ndataConTagZ :: DataCon -> ConTagZ\ndataConTagZ con = dataConTag con - fIRST_TAG\n\n-- | The type constructor that we are building via this data constructor\ndataConTyCon :: DataCon -> TyCon\ndataConTyCon = dcRepTyCon\n\n-- | The original type constructor used in the definition of this data\n-- constructor.  In case of a data family instance, that will be the family\n-- type constructor.\ndataConOrigTyCon :: DataCon -> TyCon\ndataConOrigTyCon dc\n  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc\n  | otherwise                                          = dcRepTyCon dc\n\n-- | The representation type of the data constructor, i.e. the sort\n-- type that will represent values of this type at runtime\ndataConRepType :: DataCon -> Type\ndataConRepType = dcRepType\n\n-- | Should the 'DataCon' be presented infix?\ndataConIsInfix :: DataCon -> Bool\ndataConIsInfix = dcInfix\n\n-- | The universally-quantified type variables of the constructor\ndataConUnivTyVars :: DataCon -> [TyVar]\ndataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = tvbs\n\n-- | The existentially-quantified type/coercion variables of the constructor\n-- including dependent (kind-) GADT equalities\ndataConExTyCoVars :: DataCon -> [TyCoVar]\ndataConExTyCoVars (MkData { dcExTyCoVars = tvbs }) = tvbs\n\n-- | Both the universal and existential type/coercion variables of the constructor\ndataConUnivAndExTyCoVars :: DataCon -> [TyCoVar]\ndataConUnivAndExTyCoVars (MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs })\n  = univ_tvs ++ ex_tvs\n\n-- See Note [DataCon user type variable binders]\n-- | The type variables of the constructor, in the order the user wrote them\ndataConUserTyVars :: DataCon -> [TyVar]\ndataConUserTyVars (MkData { dcUserTyVarBinders = tvbs }) = binderVars tvbs\n\n-- See Note [DataCon user type variable binders]\n-- | 'TyCoVarBinder's for the type variables of the constructor, in the order the\n-- user wrote them\ndataConUserTyVarBinders :: DataCon -> [TyVarBinder]\ndataConUserTyVarBinders = dcUserTyVarBinders\n\n-- | Equalities derived from the result type of the data constructor, as written\n-- by the programmer in any GADT declaration. This includes *all* GADT-like\n-- equalities, including those written in by hand by the programmer.\ndataConEqSpec :: DataCon -> [EqSpec]\ndataConEqSpec con@(MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })\n  = dataConKindEqSpec con\n    ++ eq_spec ++\n    [ spec   -- heterogeneous equality\n    | Just (tc, [_k1, _k2, ty1, ty2]) <- map splitTyConApp_maybe theta\n    , tc `hasKey` heqTyConKey\n    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of\n                    (Just tv1, _) -> [mkEqSpec tv1 ty2]\n                    (_, Just tv2) -> [mkEqSpec tv2 ty1]\n                    _             -> []\n    ] ++\n    [ spec   -- homogeneous equality\n    | Just (tc, [_k, ty1, ty2]) <- map splitTyConApp_maybe theta\n    , tc `hasKey` eqTyConKey\n    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of\n                    (Just tv1, _) -> [mkEqSpec tv1 ty2]\n                    (_, Just tv2) -> [mkEqSpec tv2 ty1]\n                    _             -> []\n    ]\n\n-- | Dependent (kind-level) equalities in a constructor.\n-- There are extracted from the existential variables.\n-- See Note [Existential coercion variables]\ndataConKindEqSpec :: DataCon -> [EqSpec]\ndataConKindEqSpec (MkData {dcExTyCoVars = ex_tcvs})\n  -- It is used in 'dataConEqSpec' (maybe also 'dataConFullSig' in the future),\n  -- which are frequently used functions.\n  -- For now (Aug 2018) this function always return empty set as we don't really\n  -- have coercion variables.\n  -- In the future when we do, we might want to cache this information in DataCon\n  -- so it won't be computed every time when aforementioned functions are called.\n  = [ EqSpec tv ty\n    | cv <- ex_tcvs\n    , isCoVar cv\n    , let (_, _, ty1, ty, _) = coVarKindsTypesRole cv\n          tv = getTyVar \"dataConKindEqSpec\" ty1\n    ]\n\n-- | The *full* constraints on the constructor type, including dependent GADT\n-- equalities.\ndataConTheta :: DataCon -> ThetaType\ndataConTheta con@(MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })\n  = eqSpecPreds (dataConKindEqSpec con ++ eq_spec) ++ theta\n\n-- | Get the Id of the 'DataCon' worker: a function that is the \"actual\"\n-- constructor and has no top level binding in the program. The type may\n-- be different from the obvious one written in the source program. Panics\n-- if there is no such 'Id' for this 'DataCon'\ndataConWorkId :: DataCon -> Id\ndataConWorkId dc = dcWorkId dc\n\n-- | Get the Id of the 'DataCon' wrapper: a function that wraps the \"actual\"\n-- constructor so it has the type visible in the source program: c.f.\n-- 'dataConWorkId'.\n-- Returns Nothing if there is no wrapper, which occurs for an algebraic data\n-- constructor and also for a newtype (whose constructor is inlined\n-- compulsorily)\ndataConWrapId_maybe :: DataCon -> Maybe Id\ndataConWrapId_maybe dc = case dcRep dc of\n                           NoDataConRep -> Nothing\n                           DCR { dcr_wrap_id = wrap_id } -> Just wrap_id\n\n-- | Returns an Id which looks like the Haskell-source constructor by using\n-- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to\n-- the worker (see 'dataConWorkId')\ndataConWrapId :: DataCon -> Id\ndataConWrapId dc = case dcRep dc of\n                     NoDataConRep-> dcWorkId dc    -- worker=wrapper\n                     DCR { dcr_wrap_id = wrap_id } -> wrap_id\n\n-- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,\n-- the union of the 'dataConWorkId' and the 'dataConWrapId'\ndataConImplicitTyThings :: DataCon -> [TyThing]\ndataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep })\n  = [AnId work] ++ wrap_ids\n  where\n    wrap_ids = case rep of\n                 NoDataConRep               -> []\n                 DCR { dcr_wrap_id = wrap } -> [AnId wrap]\n\n-- | The labels for the fields of this particular 'DataCon'\ndataConFieldLabels :: DataCon -> [FieldLabel]\ndataConFieldLabels = dcFields\n\n-- | Extract the type for any given labelled field of the 'DataCon'\ndataConFieldType :: DataCon -> FieldLabelString -> Type\ndataConFieldType con label = case dataConFieldType_maybe con label of\n      Just (_, ty) -> ty\n      Nothing      -> pprPanic \"dataConFieldType\" (ppr con <+> ppr label)\n\n-- | Extract the label and type for any given labelled field of the\n-- 'DataCon', or return 'Nothing' if the field does not belong to it\ndataConFieldType_maybe :: DataCon -> FieldLabelString\n                       -> Maybe (FieldLabel, Type)\ndataConFieldType_maybe con label\n  = find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con)\n\n-- | Strictness/unpack annotations, from user; or, for imported\n-- DataCons, from the interface file\n-- The list is in one-to-one correspondence with the arity of the 'DataCon'\n\ndataConSrcBangs :: DataCon -> [HsSrcBang]\ndataConSrcBangs = dcSrcBangs\n\n-- | Source-level arity of the data constructor\ndataConSourceArity :: DataCon -> Arity\ndataConSourceArity (MkData { dcSourceArity = arity }) = arity\n\n-- | Gives the number of actual fields in the /representation/ of the\n-- data constructor. This may be more than appear in the source code;\n-- the extra ones are the existentially quantified dictionaries\ndataConRepArity :: DataCon -> Arity\ndataConRepArity (MkData { dcRepArity = arity }) = arity\n\n-- | Return whether there are any argument types for this 'DataCon's original source type\n-- See Note [DataCon arities]\nisNullarySrcDataCon :: DataCon -> Bool\nisNullarySrcDataCon dc = dataConSourceArity dc == 0\n\n-- | Return whether there are any argument types for this 'DataCon's runtime representation type\n-- See Note [DataCon arities]\nisNullaryRepDataCon :: DataCon -> Bool\nisNullaryRepDataCon dc = dataConRepArity dc == 0\n\ndataConRepStrictness :: DataCon -> [StrictnessMark]\n-- ^ Give the demands on the arguments of a\n-- Core constructor application (Con dc args)\ndataConRepStrictness dc = case dcRep dc of\n                            NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc]\n                            DCR { dcr_stricts = strs } -> strs\n\ndataConImplBangs :: DataCon -> [HsImplBang]\n-- The implementation decisions about the strictness/unpack of each\n-- source program argument to the data constructor\ndataConImplBangs dc\n  = case dcRep dc of\n      NoDataConRep              -> replicate (dcSourceArity dc) HsLazy\n      DCR { dcr_bangs = bangs } -> bangs\n\ndataConBoxer :: DataCon -> Maybe DataConBoxer\ndataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer\ndataConBoxer _ = Nothing\n\n-- | The \\\"signature\\\" of the 'DataCon' returns, in order:\n--\n-- 1) The result of 'dataConUnivAndExTyCoVars',\n--\n-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary,\n--    implicit parameter - whatever), including dependent GADT equalities.\n--    Dependent GADT equalities are *also* listed in return value (1), so be\n--    careful!\n--\n-- 3) The type arguments to the constructor\n--\n-- 4) The /original/ result type of the 'DataCon'\ndataConSig :: DataCon -> ([TyCoVar], ThetaType, [Type], Type)\ndataConSig con@(MkData {dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})\n  = (dataConUnivAndExTyCoVars con, dataConTheta con, arg_tys, res_ty)\n\ndataConInstSig\n  :: DataCon\n  -> [Type]    -- Instantiate the *universal* tyvars with these types\n  -> ([TyCoVar], ThetaType, [Type])  -- Return instantiated existentials\n                                     -- theta and arg tys\n-- ^ Instantiate the universal tyvars of a data con,\n--   returning\n--     ( instantiated existentials\n--     , instantiated constraints including dependent GADT equalities\n--         which are *also* listed in the instantiated existentials\n--     , instantiated args)\ndataConInstSig con@(MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs\n                           , dcOrigArgTys = arg_tys })\n               univ_tys\n  = ( ex_tvs'\n    , substTheta subst (dataConTheta con)\n    , substTys   subst arg_tys)\n  where\n    univ_subst = zipTvSubst univ_tvs univ_tys\n    (subst, ex_tvs') = Type.substVarBndrs univ_subst ex_tvs\n\n\n-- | The \\\"full signature\\\" of the 'DataCon' returns, in order:\n--\n-- 1) The result of 'dataConUnivTyVars'\n--\n-- 2) The result of 'dataConExTyCoVars'\n--\n-- 3) The non-dependent GADT equalities.\n--    Dependent GADT equalities are implied by coercion variables in\n--    return value (2).\n--\n-- 4) The other constraints of the data constructor type, excluding GADT\n-- equalities\n--\n-- 5) The original argument types to the 'DataCon' (i.e. before\n--    any change of the representation of the type)\n--\n-- 6) The original result type of the 'DataCon'\ndataConFullSig :: DataCon\n               -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Type], Type)\ndataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs,\n                        dcEqSpec = eq_spec, dcOtherTheta = theta,\n                        dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})\n  = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)\n\ndataConOrigResTy :: DataCon -> Type\ndataConOrigResTy dc = dcOrigResTy dc\n\n-- | The \\\"stupid theta\\\" of the 'DataCon', such as @data Eq a@ in:\n--\n-- > data Eq a => T a = ...\ndataConStupidTheta :: DataCon -> ThetaType\ndataConStupidTheta dc = dcStupidTheta dc\n\ndataConUserType :: DataCon -> Type\n-- ^ The user-declared type of the data constructor\n-- in the nice-to-read form:\n--\n-- > T :: forall a b. a -> b -> T [a]\n--\n-- rather than:\n--\n-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c\n--\n-- The type variables are quantified in the order that the user wrote them.\n-- See @Note [DataCon user type variable binders]@.\n--\n-- NB: If the constructor is part of a data instance, the result type\n-- mentions the family tycon, not the internal one.\ndataConUserType (MkData { dcUserTyVarBinders = user_tvbs,\n                          dcOtherTheta = theta, dcOrigArgTys = arg_tys,\n                          dcOrigResTy = res_ty })\n  = mkForAllTys user_tvbs $\n    mkInvisFunTys theta $\n    mkVisFunTys arg_tys $\n    res_ty\n\n-- | Finds the instantiated types of the arguments required to construct a\n-- 'DataCon' representation\n-- NB: these INCLUDE any dictionary args\n--     but EXCLUDE the data-declaration context, which is discarded\n-- It's all post-flattening etc; this is a representation type\ndataConInstArgTys :: DataCon    -- ^ A datacon with no existentials or equality constraints\n                                -- However, it can have a dcTheta (notably it can be a\n                                -- class dictionary, with superclasses)\n                  -> [Type]     -- ^ Instantiated at these types\n                  -> [Type]\ndataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,\n                              dcExTyCoVars = ex_tvs}) inst_tys\n = ASSERT2( univ_tvs `equalLength` inst_tys\n          , text \"dataConInstArgTys\" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)\n   ASSERT2( null ex_tvs, ppr dc )\n   map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)\n\n-- | Returns just the instantiated /value/ argument types of a 'DataCon',\n-- (excluding dictionary args)\ndataConInstOrigArgTys\n        :: DataCon      -- Works for any DataCon\n        -> [Type]       -- Includes existential tyvar args, but NOT\n                        -- equality constraints or dicts\n        -> [Type]\n-- For vanilla datacons, it's all quite straightforward\n-- But for the call in MatchCon, we really do want just the value args\ndataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,\n                                  dcUnivTyVars = univ_tvs,\n                                  dcExTyCoVars = ex_tvs}) inst_tys\n  = ASSERT2( tyvars `equalLength` inst_tys\n           , text \"dataConInstOrigArgTys\" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )\n    map (substTy subst) arg_tys\n  where\n    tyvars = univ_tvs ++ ex_tvs\n    subst  = zipTCvSubst tyvars inst_tys\n\n-- | Returns the argument types of the wrapper, excluding all dictionary arguments\n-- and without substituting for any type variables\ndataConOrigArgTys :: DataCon -> [Type]\ndataConOrigArgTys dc = dcOrigArgTys dc\n\n-- | Returns the arg types of the worker, including *all* non-dependent\n-- evidence, after any flattening has been done and without substituting for\n-- any type variables\ndataConRepArgTys :: DataCon -> [Type]\ndataConRepArgTys (MkData { dcRep = rep\n                         , dcEqSpec = eq_spec\n                         , dcOtherTheta = theta\n                         , dcOrigArgTys = orig_arg_tys })\n  = case rep of\n      NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys\n      DCR { dcr_arg_tys = arg_tys } -> arg_tys\n\n-- | The string @package:module.name@ identifying a constructor, which is attached\n-- to its info table and used by the GHCi debugger and the heap profiler\ndataConIdentity :: DataCon -> ByteString\n-- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.\ndataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat\n   [ BSB.byteString $ bytesFS (unitIdFS (moduleUnitId mod))\n   , BSB.int8 $ fromIntegral (ord ':')\n   , BSB.byteString $ bytesFS (moduleNameFS (moduleName mod))\n   , BSB.int8 $ fromIntegral (ord '.')\n   , BSB.byteString $ bytesFS (occNameFS (nameOccName name))\n   ]\n  where name = dataConName dc\n        mod  = ASSERT( isExternalName name ) nameModule name\n\nisTupleDataCon :: DataCon -> Bool\nisTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc\n\nisUnboxedTupleCon :: DataCon -> Bool\nisUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc\n\nisUnboxedSumCon :: DataCon -> Bool\nisUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc\n\n-- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors\nisVanillaDataCon :: DataCon -> Bool\nisVanillaDataCon dc = dcVanilla dc\n\n-- | Should this DataCon be allowed in a type even without -XDataKinds?\n-- Currently, only Lifted & Unlifted\nspecialPromotedDc :: DataCon -> Bool\nspecialPromotedDc = isKindTyCon . dataConTyCon\n\nclassDataCon :: Class -> DataCon\nclassDataCon clas = case tyConDataCons (classTyCon clas) of\n                      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr\n                      [] -> panic \"classDataCon\"\n\ndataConCannotMatch :: [Type] -> DataCon -> Bool\n-- Returns True iff the data con *definitely cannot* match a\n--                  scrutinee of type (T tys)\n--                  where T is the dcRepTyCon for the data con\ndataConCannotMatch tys con\n  | null inst_theta   = False   -- Common\n  | all isTyVarTy tys = False   -- Also common\n  | otherwise         = typesCantMatch (concatMap predEqs inst_theta)\n  where\n    (_, inst_theta, _) = dataConInstSig con tys\n\n    -- TODO: could gather equalities from superclasses too\n    predEqs pred = case classifyPredType pred of\n                     EqPred NomEq ty1 ty2       -> [(ty1, ty2)]\n                     ClassPred eq [_, ty1, ty2]\n                       | eq `hasKey` eqTyConKey -> [(ty1, ty2)]\n                     _                          -> []\n\n-- | Were the type variables of the data con written in a different order\n-- than the regular order (universal tyvars followed by existential tyvars)?\n--\n-- This is not a cheap test, so we minimize its use in GHC as much as possible.\n-- Currently, its only call site in the GHC codebase is in 'mkDataConRep' in\n-- \"MkId\", and so 'dataConUserTyVarsArePermuted' is only called at most once\n-- during a data constructor's lifetime.\n\n-- See Note [DataCon user type variable binders], as well as\n-- Note [Data con wrappers and GADT syntax] for an explanation of what\n-- mkDataConRep is doing with this function.\ndataConUserTyVarsArePermuted :: DataCon -> Bool\ndataConUserTyVarsArePermuted (MkData { dcUnivTyVars = univ_tvs\n                                     , dcExTyCoVars = ex_tvs, dcEqSpec = eq_spec\n                                     , dcUserTyVarBinders = user_tvbs }) =\n  (filterEqSpec eq_spec univ_tvs ++ ex_tvs) /= binderVars user_tvbs\n\n{-\n%************************************************************************\n%*                                                                      *\n        Promoting of data types to the kind level\n*                                                                      *\n************************************************************************\n\n-}\n\npromoteDataCon :: DataCon -> TyCon\npromoteDataCon (MkData { dcPromoted = tc }) = tc\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Splitting products}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Extract the type constructor, type argument, data constructor and it's\n-- /representation/ argument types from a type if it is a product type.\n--\n-- Precisely, we return @Just@ for any type that is all of:\n--\n--  * Concrete (i.e. constructors visible)\n--\n--  * Single-constructor\n--\n--  * Not existentially quantified\n--\n-- Whether the type is a @data@ type or a @newtype@\nsplitDataProductType_maybe\n        :: Type                         -- ^ A product type, perhaps\n        -> Maybe (TyCon,                -- The type constructor\n                  [Type],               -- Type args of the tycon\n                  DataCon,              -- The data constructor\n                  [Type])               -- Its /representation/ arg types\n\n        -- Rejecting existentials is conservative.  Maybe some things\n        -- could be made to work with them, but I'm not going to sweat\n        -- it through till someone finds it's important.\n\nsplitDataProductType_maybe ty\n  | Just (tycon, ty_args) <- splitTyConApp_maybe ty\n  , Just con <- isDataProductTyCon_maybe tycon\n  = Just (tycon, ty_args, con, dataConInstArgTys con ty_args)\n  | otherwise\n  = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n              Building an algebraic data type\n*                                                                      *\n************************************************************************\n\nbuildAlgTyCon is here because it is called from TysWiredIn, which can\ndepend on this module, but not on BuildTyCl.\n-}\n\nbuildAlgTyCon :: Name\n              -> [TyVar]               -- ^ Kind variables and type variables\n              -> [Role]\n              -> Maybe CType\n              -> ThetaType             -- ^ Stupid theta\n              -> AlgTyConRhs\n              -> Bool                  -- ^ True <=> was declared in GADT syntax\n              -> AlgTyConFlav\n              -> TyCon\n\nbuildAlgTyCon tc_name ktvs roles cType stupid_theta rhs\n              gadt_syn parent\n  = mkAlgTyCon tc_name binders liftedTypeKind roles cType stupid_theta\n               rhs parent gadt_syn\n  where\n    binders = mkTyConBindersPreferAnon ktvs emptyVarSet\n\nbuildSynTyCon :: Name -> [KnotTied TyConBinder] -> Kind   -- ^ /result/ kind\n              -> [Role] -> KnotTied Type -> TyCon\nbuildSynTyCon name binders res_kind roles rhs\n  = mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free\n  where\n    is_tau      = isTauTy rhs\n    is_fam_free = isFamFreeTy rhs\n", "num_lines": 1513}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[Demand]{@Demand@: A decoupled implementation of a demand domain}\n-}\n\n{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances, RecordWildCards #-}\n\nmodule Demand (\n        StrDmd, UseDmd(..), Count,\n\n        Demand, DmdShell, CleanDemand, getStrDmd, getUseDmd,\n        mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd,\n        toCleanDmd,\n        absDmd, topDmd, botDmd, seqDmd,\n        lubDmd, bothDmd,\n        lazyApply1Dmd, lazyApply2Dmd, strictApply1Dmd,\n        isTopDmd, isAbsDmd, isSeqDmd,\n        peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd,\n        addCaseBndrDmd,\n\n        DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,\n        nopDmdType, botDmdType, mkDmdType,\n        addDemand, removeDmdTyArgs,\n        BothDmdArg, mkBothDmdArg, toBothDmdArg,\n\n        DmdEnv, emptyDmdEnv,\n        peelFV, findIdDemand,\n\n        DmdResult, CPRResult,\n        isBotRes, isTopRes,\n        topRes, botRes, cprProdRes,\n        vanillaCprProdRes, cprSumRes,\n        appIsBottom, isBottomingSig, pprIfaceStrictSig,\n        trimCPRInfo, returnsCPR_maybe,\n        StrictSig(..), mkStrictSig, mkClosedStrictSig,\n        nopSig, botSig, cprProdSig,\n        isTopSig, hasDemandEnvSig,\n        splitStrictSig, strictSigDmdEnv,\n        increaseStrictSigArity, etaExpandStrictSig,\n\n        seqDemand, seqDemandList, seqDmdType, seqStrictSig,\n\n        evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd,\n        splitDmdTy, splitFVs,\n        deferAfterIO,\n        postProcessUnsat, postProcessDmdType,\n\n        splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd,\n        mkWorkerDemand, dmdTransformSig, dmdTransformDataConSig,\n        dmdTransformDictSelSig, argOneShots, argsOneShots, saturatedByOneShots,\n        trimToType, TypeShape(..),\n\n        useCount, isUsedOnce, reuseEnv,\n        killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig,\n        zapUsedOnceDemand, zapUsedOnceSig,\n        strictifyDictDmd, strictifyDmd\n\n     ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport Outputable\nimport Var ( Var )\nimport VarEnv\nimport UniqFM\nimport Util\nimport BasicTypes\nimport Binary\nimport Maybes           ( orElse )\n\nimport Type            ( Type )\nimport TyCon           ( isNewTyCon, isClassTyCon )\nimport DataCon         ( splitDataProductType_maybe )\n\n{-\n************************************************************************\n*                                                                      *\n        Joint domain for Strictness and Absence\n*                                                                      *\n************************************************************************\n-}\n\ndata JointDmd s u = JD { sd :: s, ud :: u }\n  deriving ( Eq, Show )\n\ngetStrDmd :: JointDmd s u -> s\ngetStrDmd = sd\n\ngetUseDmd :: JointDmd s u -> u\ngetUseDmd = ud\n\n-- Pretty-printing\ninstance (Outputable s, Outputable u) => Outputable (JointDmd s u) where\n  ppr (JD {sd = s, ud = u}) = angleBrackets (ppr s <> char ',' <> ppr u)\n\n-- Well-formedness preserving constructors for the joint domain\nmkJointDmd :: s -> u -> JointDmd s u\nmkJointDmd s u = JD { sd = s, ud = u }\n\nmkJointDmds :: [s] -> [u] -> [JointDmd s u]\nmkJointDmds ss as = zipWithEqual \"mkJointDmds\" mkJointDmd ss as\n\n\n{-\n************************************************************************\n*                                                                      *\n            Strictness domain\n*                                                                      *\n************************************************************************\n\n          Lazy\n           |\n        HeadStr\n        /     \\\n    SCall      SProd\n        \\     /\n        HyperStr\n\nNote [Exceptions and strictness]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used to smart about catching exceptions, but we aren't anymore.\nSee Trac #14998 for the way it's resolved at the moment.\n\nHere's a historic breakdown:\n\nApparently, exception handling prim-ops didn't use to have any special\nstrictness signatures, thus defaulting to topSig, which assumes they use their\narguments lazily. Joachim was the first to realise that we could provide richer\ninformation. Thus, in 0558911f91c (Dec 13), he added signatures to\nprimops.txt.pp indicating that functions like `catch#` and `catchRetry#` call\ntheir argument, which is useful information for usage analysis. Still with a\n'Lazy' strictness demand (i.e. 'lazyApply1Dmd'), though, and the world was fine.\n\nIn 7c0fff4 (July 15), Simon argued that giving `catch#` et al. a\n'strictApply1Dmd' leads to substantial performance gains. That was at the cost\nof correctness, as Trac #10712 proved. So, back to 'lazyApply1Dmd' in\n28638dfe79e (Dec 15).\n\nMotivated to reproduce the gains of 7c0fff4 without the breakage of Trac #10712,\nBen opened Trac #11222. Simon made the demand analyser \"understand catch\" in\n9915b656 (Jan 16) by adding a new 'catchArgDmd', which basically said to call\nits argument strictly, but also swallow any thrown exceptions in\n'postProcessDmdResult'. This was realized by extending the 'Str' constructor of\n'ArgStr' with a 'ExnStr' field, indicating that it catches the exception, and\nadding a 'ThrowsExn' constructor to the 'Termination' lattice as an element\nbetween 'Dunno' and 'Diverges'. Then along came Trac #11555 and finally #13330,\nso we had to revert to 'lazyApply1Dmd' again in 701256df88c (Mar 17).\n\nThis left the other variants like 'catchRetry#' having 'catchArgDmd', which is\nwhere #14998 picked up. Item 1 was concerned with measuring the impact of also\nmaking `catchRetry#` and `catchSTM#` have 'lazyApply1Dmd'. The result was that\nthere was none. We removed the last usages of 'catchArgDmd' in 00b8ecb7\n(Apr 18). There was a lot of dead code resulting from that change, that we\nremoved in ef6b283 (Jan 19): We got rid of 'ThrowsExn' and 'ExnStr' again and\nremoved any code that was dealing with the peculiarities.\n\nWhere did the speed-ups vanish to? In Trac #14998, item 3 established that\nturning 'catch#' strict in its first argument didn't bring back any of the\nalleged performance benefits. Item 2 of that ticket finally found out that it\nwas entirely due to 'catchException's new (since Trac #11555) definition, which\nwas simply\n\n    catchException !io handler = catch io handler\n\nWhile 'catchException' is arguably the saner semantics for 'catch', it is an\ninternal helper function in \"GHC.IO\". Its use in\n\"GHC.IO.Handle.Internals.do_operation\" made for the huge allocation differences:\nRemove the bang and you find the regressions we originally wanted to avoid with\n'catchArgDmd'. See also #exceptions_and_strictness# in \"GHC.IO\".\n\nSo history keeps telling us that the only possibly correct strictness annotation\nfor the first argument of 'catch#' is 'lazyApply1Dmd', because 'catch#' really\nis not strict in its argument: Just try this in GHCi\n\n  :set -XScopedTypeVariables\n  import Control.Exception\n  catch undefined (\\(_ :: SomeException) -> putStrLn \"you'll see this\")\n\nAny analysis that assumes otherwise will be broken in some way or another\n(beyond `-fno-pendantic-bottoms`).\n-}\n\n-- | Vanilla strictness domain\ndata StrDmd\n  = HyperStr             -- ^ Hyper-strict (bottom of the lattice).\n                         -- See Note [HyperStr and Use demands]\n\n  | SCall StrDmd         -- ^ Call demand\n                         -- Used only for values of function type\n\n  | SProd [ArgStr]       -- ^ Product\n                         -- Used only for values of product type\n                         -- Invariant: not all components are HyperStr (use HyperStr)\n                         --            not all components are Lazy     (use HeadStr)\n\n  | HeadStr              -- ^ Head-Strict\n                         -- A polymorphic demand: used for values of all types,\n                         --                       including a type variable\n\n  deriving ( Eq, Show )\n\n-- | Strictness of a function argument.\ntype ArgStr = Str StrDmd\n\n-- | Strictness demand.\ndata Str s = Lazy  -- ^ Lazy (top of the lattice)\n           | Str s -- ^ Strict\n  deriving ( Eq, Show )\n\n-- Well-formedness preserving constructors for the Strictness domain\nstrBot, strTop :: ArgStr\nstrBot = Str HyperStr\nstrTop = Lazy\n\nmkSCall :: StrDmd -> StrDmd\nmkSCall HyperStr = HyperStr\nmkSCall s        = SCall s\n\nmkSProd :: [ArgStr] -> StrDmd\nmkSProd sx\n  | any isHyperStr sx = HyperStr\n  | all isLazy     sx = HeadStr\n  | otherwise         = SProd sx\n\nisLazy :: ArgStr -> Bool\nisLazy Lazy     = True\nisLazy (Str {}) = False\n\nisHyperStr :: ArgStr -> Bool\nisHyperStr (Str HyperStr) = True\nisHyperStr _              = False\n\n-- Pretty-printing\ninstance Outputable StrDmd where\n  ppr HyperStr      = char 'B'\n  ppr (SCall s)     = char 'C' <> parens (ppr s)\n  ppr HeadStr       = char 'S'\n  ppr (SProd sx)    = char 'S' <> parens (hcat (map ppr sx))\n\ninstance Outputable ArgStr where\n  ppr (Str s) = ppr s\n  ppr Lazy    = char 'L'\n\nlubArgStr :: ArgStr -> ArgStr -> ArgStr\nlubArgStr Lazy     _        = Lazy\nlubArgStr _        Lazy     = Lazy\nlubArgStr (Str s1) (Str s2) = Str (s1 `lubStr` s2)\n\nlubStr :: StrDmd -> StrDmd -> StrDmd\nlubStr HyperStr s              = s\nlubStr (SCall s1) HyperStr     = SCall s1\nlubStr (SCall _)  HeadStr      = HeadStr\nlubStr (SCall s1) (SCall s2)   = SCall (s1 `lubStr` s2)\nlubStr (SCall _)  (SProd _)    = HeadStr\nlubStr (SProd sx) HyperStr     = SProd sx\nlubStr (SProd _)  HeadStr      = HeadStr\nlubStr (SProd s1) (SProd s2)\n    | s1 `equalLength` s2      = mkSProd (zipWith lubArgStr s1 s2)\n    | otherwise                = HeadStr\nlubStr (SProd _) (SCall _)     = HeadStr\nlubStr HeadStr   _             = HeadStr\n\nbothArgStr :: ArgStr -> ArgStr -> ArgStr\nbothArgStr Lazy     s        = s\nbothArgStr s        Lazy     = s\nbothArgStr (Str s1) (Str s2) = Str (s1 `bothStr` s2)\n\nbothStr :: StrDmd -> StrDmd -> StrDmd\nbothStr HyperStr _             = HyperStr\nbothStr HeadStr s              = s\nbothStr (SCall _)  HyperStr    = HyperStr\nbothStr (SCall s1) HeadStr     = SCall s1\nbothStr (SCall s1) (SCall s2)  = SCall (s1 `bothStr` s2)\nbothStr (SCall _)  (SProd _)   = HyperStr  -- Weird\n\nbothStr (SProd _)  HyperStr    = HyperStr\nbothStr (SProd s1) HeadStr     = SProd s1\nbothStr (SProd s1) (SProd s2)\n    | s1 `equalLength` s2      = mkSProd (zipWith bothArgStr s1 s2)\n    | otherwise                = HyperStr  -- Weird\nbothStr (SProd _) (SCall _)    = HyperStr\n\n-- utility functions to deal with memory leaks\nseqStrDmd :: StrDmd -> ()\nseqStrDmd (SProd ds)   = seqStrDmdList ds\nseqStrDmd (SCall s)    = seqStrDmd s\nseqStrDmd _            = ()\n\nseqStrDmdList :: [ArgStr] -> ()\nseqStrDmdList [] = ()\nseqStrDmdList (d:ds) = seqArgStr d `seq` seqStrDmdList ds\n\nseqArgStr :: ArgStr -> ()\nseqArgStr Lazy    = ()\nseqArgStr (Str s) = seqStrDmd s\n\n-- Splitting polymorphic demands\nsplitArgStrProdDmd :: Int -> ArgStr -> Maybe [ArgStr]\nsplitArgStrProdDmd n Lazy    = Just (replicate n Lazy)\nsplitArgStrProdDmd n (Str s) = splitStrProdDmd n s\n\nsplitStrProdDmd :: Int -> StrDmd -> Maybe [ArgStr]\nsplitStrProdDmd n HyperStr   = Just (replicate n strBot)\nsplitStrProdDmd n HeadStr    = Just (replicate n strTop)\nsplitStrProdDmd n (SProd ds) = WARN( not (ds `lengthIs` n),\n                                     text \"splitStrProdDmd\" $$ ppr n $$ ppr ds )\n                               Just ds\nsplitStrProdDmd _ (SCall {}) = Nothing\n      -- This can happen when the programmer uses unsafeCoerce,\n      -- and we don't then want to crash the compiler (Trac #9208)\n\n{-\n************************************************************************\n*                                                                      *\n            Absence domain\n*                                                                      *\n************************************************************************\n\n         Used\n         /   \\\n     UCall   UProd\n         \\   /\n         UHead\n          |\n  Count x -\n        |\n       Abs\n-}\n\n-- | Domain for genuine usage\ndata UseDmd\n  = UCall Count UseDmd   -- ^ Call demand for absence.\n                         -- Used only for values of function type\n\n  | UProd [ArgUse]       -- ^ Product.\n                         -- Used only for values of product type\n                         -- See Note [Don't optimise UProd(Used) to Used]\n                         --\n                         -- Invariant: Not all components are Abs\n                         -- (in that case, use UHead)\n\n  | UHead                -- ^ May be used but its sub-components are\n                         -- definitely *not* used.  For product types, UHead\n                         -- is equivalent to U(AAA); see mkUProd.\n                         --\n                         -- UHead is needed only to express the demand\n                         -- of 'seq' and 'case' which are polymorphic;\n                         -- i.e. the scrutinised value is of type 'a'\n                         -- rather than a product type. That's why we\n                         -- can't use UProd [A,A,A]\n                         --\n                         -- Since (UCall _ Abs) is ill-typed, UHead doesn't\n                         -- make sense for lambdas\n\n  | Used                 -- ^ May be used and its sub-components may be used.\n                         -- (top of the lattice)\n  deriving ( Eq, Show )\n\n-- Extended usage demand for absence and counting\ntype ArgUse = Use UseDmd\n\ndata Use u\n  = Abs             -- Definitely unused\n                    -- Bottom of the lattice\n\n  | Use Count u     -- May be used with some cardinality\n  deriving ( Eq, Show )\n\n-- | Abstract counting of usages\ndata Count = One | Many\n  deriving ( Eq, Show )\n\n-- Pretty-printing\ninstance Outputable ArgUse where\n  ppr Abs           = char 'A'\n  ppr (Use Many a)   = ppr a\n  ppr (Use One  a)   = char '1' <> char '*' <> ppr a\n\ninstance Outputable UseDmd where\n  ppr Used           = char 'U'\n  ppr (UCall c a)    = char 'C' <> ppr c <> parens (ppr a)\n  ppr UHead          = char 'H'\n  ppr (UProd as)     = char 'U' <> parens (hcat (punctuate (char ',') (map ppr as)))\n\ninstance Outputable Count where\n  ppr One  = char '1'\n  ppr Many = text \"\"\n\nuseBot, useTop :: ArgUse\nuseBot     = Abs\nuseTop     = Use Many Used\n\nmkUCall :: Count -> UseDmd -> UseDmd\n--mkUCall c Used = Used c\nmkUCall c a  = UCall c a\n\nmkUProd :: [ArgUse] -> UseDmd\nmkUProd ux\n  | all (== Abs) ux    = UHead\n  | otherwise          = UProd ux\n\nlubCount :: Count -> Count -> Count\nlubCount _ Many = Many\nlubCount Many _ = Many\nlubCount x _    = x\n\nlubArgUse :: ArgUse -> ArgUse -> ArgUse\nlubArgUse Abs x                   = x\nlubArgUse x Abs                   = x\nlubArgUse (Use c1 a1) (Use c2 a2) = Use (lubCount c1 c2) (lubUse a1 a2)\n\nlubUse :: UseDmd -> UseDmd -> UseDmd\nlubUse UHead       u               = u\nlubUse (UCall c u) UHead           = UCall c u\nlubUse (UCall c1 u1) (UCall c2 u2) = UCall (lubCount c1 c2) (lubUse u1 u2)\nlubUse (UCall _ _) _               = Used\nlubUse (UProd ux) UHead            = UProd ux\nlubUse (UProd ux1) (UProd ux2)\n     | ux1 `equalLength` ux2       = UProd $ zipWith lubArgUse ux1 ux2\n     | otherwise                   = Used\nlubUse (UProd {}) (UCall {})       = Used\n-- lubUse (UProd {}) Used             = Used\nlubUse (UProd ux) Used             = UProd (map (`lubArgUse` useTop) ux)\nlubUse Used       (UProd ux)       = UProd (map (`lubArgUse` useTop) ux)\nlubUse Used _                      = Used  -- Note [Used should win]\n\n-- `both` is different from `lub` in its treatment of counting; if\n-- `both` is computed for two used, the result always has\n--  cardinality `Many` (except for the inner demands of UCall demand -- [TODO] explain).\n--  Also,  x `bothUse` x /= x (for anything but Abs).\n\nbothArgUse :: ArgUse -> ArgUse -> ArgUse\nbothArgUse Abs x                   = x\nbothArgUse x Abs                   = x\nbothArgUse (Use _ a1) (Use _ a2)   = Use Many (bothUse a1 a2)\n\n\nbothUse :: UseDmd -> UseDmd -> UseDmd\nbothUse UHead       u               = u\nbothUse (UCall c u) UHead           = UCall c u\n\n-- Exciting special treatment of inner demand for call demands:\n--    use `lubUse` instead of `bothUse`!\nbothUse (UCall _ u1) (UCall _ u2)   = UCall Many (u1 `lubUse` u2)\n\nbothUse (UCall {}) _                = Used\nbothUse (UProd ux) UHead            = UProd ux\nbothUse (UProd ux1) (UProd ux2)\n      | ux1 `equalLength` ux2       = UProd $ zipWith bothArgUse ux1 ux2\n      | otherwise                   = Used\nbothUse (UProd {}) (UCall {})       = Used\n-- bothUse (UProd {}) Used             = Used  -- Note [Used should win]\nbothUse Used (UProd ux)             = UProd (map (`bothArgUse` useTop) ux)\nbothUse (UProd ux) Used             = UProd (map (`bothArgUse` useTop) ux)\nbothUse Used _                      = Used  -- Note [Used should win]\n\npeelUseCall :: UseDmd -> Maybe (Count, UseDmd)\npeelUseCall (UCall c u)   = Just (c,u)\npeelUseCall _             = Nothing\n\naddCaseBndrDmd :: Demand    -- On the case binder\n               -> [Demand]  -- On the components of the constructor\n               -> [Demand]  -- Final demands for the components of the constructor\n-- See Note [Demand on case-alternative binders]\naddCaseBndrDmd (JD { sd = ms, ud = mu }) alt_dmds\n  = case mu of\n     Abs     -> alt_dmds\n     Use _ u -> zipWith bothDmd alt_dmds (mkJointDmds ss us)\n             where\n                Just ss = splitArgStrProdDmd arity ms  -- Guaranteed not to be a call\n                Just us = splitUseProdDmd      arity u   -- Ditto\n  where\n    arity = length alt_dmds\n\n{- Note [Demand on case-alternative binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe demand on a binder in a case alternative comes\n  (a) From the demand on the binder itself\n  (b) From the demand on the case binder\nForgetting (b) led directly to Trac #10148.\n\nExample. Source code:\n  f x@(p,_) = if p then foo x else True\n\n  foo (p,True) = True\n  foo (p,q)    = foo (q,p)\n\nAfter strictness analysis:\n  f = \\ (x_an1 [Dmd=<S(SL),1*U(U,1*U)>] :: (Bool, Bool)) ->\n      case x_an1\n      of wild_X7 [Dmd=<L,1*U(1*U,1*U)>]\n      { (p_an2 [Dmd=<S,1*U>], ds_dnz [Dmd=<L,A>]) ->\n      case p_an2 of _ {\n        False -> GHC.Types.True;\n        True -> foo wild_X7 }\n\nIt's true that ds_dnz is *itself* absent, but the use of wild_X7 means\nthat it is very much alive and demanded.  See Trac #10148 for how the\nconsequences play out.\n\nThis is needed even for non-product types, in case the case-binder\nis used but the components of the case alternative are not.\n\nNote [Don't optimise UProd(Used) to Used]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThese two UseDmds:\n   UProd [Used, Used]   and    Used\nare semantically equivalent, but we do not turn the former into\nthe latter, for a regrettable-subtle reason.  Suppose we did.\nthen\n  f (x,y) = (y,x)\nwould get\n  StrDmd = Str  = SProd [Lazy, Lazy]\n  UseDmd = Used = UProd [Used, Used]\nBut with the joint demand of <Str, Used> doesn't convey any clue\nthat there is a product involved, and so the worthSplittingFun\nwill not fire.  (We'd need to use the type as well to make it fire.)\nMoreover, consider\n  g h p@(_,_) = h p\nThis too would get <Str, Used>, but this time there really isn't any\npoint in w/w since the components of the pair are not used at all.\n\nSo the solution is: don't aggressively collapse UProd [Used,Used] to\nUsed; intead leave it as-is. In effect we are using the UseDmd to do a\nlittle bit of boxity analysis.  Not very nice.\n\nNote [Used should win]\n~~~~~~~~~~~~~~~~~~~~~~\nBoth in lubUse and bothUse we want (Used `both` UProd us) to be Used.\nWhy?  Because Used carries the implication the whole thing is used,\nbox and all, so we don't want to w/w it.  If we use it both boxed and\nunboxed, then we are definitely using the box, and so we are quite\nlikely to pay a reboxing cost.  So we make Used win here.\n\nExample is in the Buffer argument of GHC.IO.Handle.Internals.writeCharBuffer\n\nBaseline: (A) Not making Used win (UProd wins)\nCompare with: (B) making Used win for lub and both\n\n            Min          -0.3%     -5.6%    -10.7%    -11.0%    -33.3%\n            Max          +0.3%    +45.6%    +11.5%    +11.5%     +6.9%\n Geometric Mean          -0.0%     +0.5%     +0.3%     +0.2%     -0.8%\n\nBaseline: (B) Making Used win for both lub and both\nCompare with: (C) making Used win for both, but UProd win for lub\n\n            Min          -0.1%     -0.3%     -7.9%     -8.0%     -6.5%\n            Max          +0.1%     +1.0%    +21.0%    +21.0%     +0.5%\n Geometric Mean          +0.0%     +0.0%     -0.0%     -0.1%     -0.1%\n-}\n\n-- If a demand is used multiple times (i.e. reused), than any use-once\n-- mentioned there, that is not protected by a UCall, can happen many times.\nmarkReusedDmd :: ArgUse -> ArgUse\nmarkReusedDmd Abs         = Abs\nmarkReusedDmd (Use _ a)   = Use Many (markReused a)\n\nmarkReused :: UseDmd -> UseDmd\nmarkReused (UCall _ u)      = UCall Many u   -- No need to recurse here\nmarkReused (UProd ux)       = UProd (map markReusedDmd ux)\nmarkReused u                = u\n\nisUsedMU :: ArgUse -> Bool\n-- True <=> markReusedDmd d = d\nisUsedMU Abs          = True\nisUsedMU (Use One _)  = False\nisUsedMU (Use Many u) = isUsedU u\n\nisUsedU :: UseDmd -> Bool\n-- True <=> markReused d = d\nisUsedU Used           = True\nisUsedU UHead          = True\nisUsedU (UProd us)     = all isUsedMU us\nisUsedU (UCall One _)  = False\nisUsedU (UCall Many _) = True  -- No need to recurse\n\n-- Squashing usage demand demands\nseqUseDmd :: UseDmd -> ()\nseqUseDmd (UProd ds)   = seqArgUseList ds\nseqUseDmd (UCall c d)  = c `seq` seqUseDmd d\nseqUseDmd _            = ()\n\nseqArgUseList :: [ArgUse] -> ()\nseqArgUseList []     = ()\nseqArgUseList (d:ds) = seqArgUse d `seq` seqArgUseList ds\n\nseqArgUse :: ArgUse -> ()\nseqArgUse (Use c u)  = c `seq` seqUseDmd u\nseqArgUse _          = ()\n\n-- Splitting polymorphic Maybe-Used demands\nsplitUseProdDmd :: Int -> UseDmd -> Maybe [ArgUse]\nsplitUseProdDmd n Used        = Just (replicate n useTop)\nsplitUseProdDmd n UHead       = Just (replicate n Abs)\nsplitUseProdDmd n (UProd ds)  = WARN( not (ds `lengthIs` n),\n                                      text \"splitUseProdDmd\" $$ ppr n\n                                                             $$ ppr ds )\n                                Just ds\nsplitUseProdDmd _ (UCall _ _) = Nothing\n      -- This can happen when the programmer uses unsafeCoerce,\n      -- and we don't then want to crash the compiler (Trac #9208)\n\nuseCount :: Use u -> Count\nuseCount Abs         = One\nuseCount (Use One _) = One\nuseCount _           = Many\n\n\n{-\n************************************************************************\n*                                                                      *\n         Clean demand for Strictness and Usage\n*                                                                      *\n************************************************************************\n\nThis domain differst from JointDemand in the sence that pure absence\nis taken away, i.e., we deal *only* with non-absent demands.\n\nNote [Strict demands]\n~~~~~~~~~~~~~~~~~~~~~\nisStrictDmd returns true only of demands that are\n   both strict\n   and  used\nIn particular, it is False for <HyperStr, Abs>, which can and does\narise in, say (Trac #7319)\n   f x = raise# <some exception>\nThen 'x' is not used, so f gets strictness <HyperStr,Abs> -> .\nNow the w/w generates\n   fx = let x <HyperStr,Abs> = absentError \"unused\"\n        in raise <some exception>\nAt this point we really don't want to convert to\n   fx = case absentError \"unused\" of x -> raise <some exception>\nSince the program is going to diverge, this swaps one error for another,\nbut it's really a bad idea to *ever* evaluate an absent argument.\nIn Trac #7319 we get\n   T7319.exe: Oops!  Entered absent arg w_s1Hd{v} [lid] [base:GHC.Base.String{tc 36u}]\n\nNote [Dealing with call demands]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCall demands are constructed and deconstructed coherently for\nstrictness and absence. For instance, the strictness signature for the\nfollowing function\n\nf :: (Int -> (Int, Int)) -> (Int, Bool)\nf g = (snd (g 3), True)\n\nshould be: <L,C(U(AU))>m\n-}\n\ntype CleanDemand = JointDmd StrDmd UseDmd\n     -- A demand that is at least head-strict\n\nbothCleanDmd :: CleanDemand -> CleanDemand -> CleanDemand\nbothCleanDmd (JD { sd = s1, ud = a1}) (JD { sd = s2, ud = a2})\n  = JD { sd = s1 `bothStr` s2, ud = a1 `bothUse` a2 }\n\nmkHeadStrict :: CleanDemand -> CleanDemand\nmkHeadStrict cd = cd { sd = HeadStr }\n\nmkOnceUsedDmd, mkManyUsedDmd :: CleanDemand -> Demand\nmkOnceUsedDmd (JD {sd = s,ud = a}) = JD { sd = Str s, ud = Use One a }\nmkManyUsedDmd (JD {sd = s,ud = a}) = JD { sd = Str s, ud = Use Many a }\n\nevalDmd :: Demand\n-- Evaluated strictly, and used arbitrarily deeply\nevalDmd = JD { sd = Str HeadStr, ud = useTop }\n\nmkProdDmd :: [Demand] -> CleanDemand\nmkProdDmd dx\n  = JD { sd = mkSProd $ map getStrDmd dx\n       , ud = mkUProd $ map getUseDmd dx }\n\nmkCallDmd :: CleanDemand -> CleanDemand\nmkCallDmd (JD {sd = d, ud = u})\n  = JD { sd = mkSCall d, ud = mkUCall One u }\n\n-- See Note [Demand on the worker] in WorkWrap\nmkWorkerDemand :: Int -> Demand\nmkWorkerDemand n = JD { sd = Lazy, ud = Use One (go n) }\n  where go 0 = Used\n        go n = mkUCall One $ go (n-1)\n\ncleanEvalDmd :: CleanDemand\ncleanEvalDmd = JD { sd = HeadStr, ud = Used }\n\ncleanEvalProdDmd :: Arity -> CleanDemand\ncleanEvalProdDmd n = JD { sd = HeadStr, ud = UProd (replicate n useTop) }\n\n\n{-\n************************************************************************\n*                                                                      *\n           Demand: combining stricness and usage\n*                                                                      *\n************************************************************************\n-}\n\ntype Demand = JointDmd ArgStr ArgUse\n\nlubDmd :: Demand -> Demand -> Demand\nlubDmd (JD {sd = s1, ud = a1}) (JD {sd = s2, ud = a2})\n = JD { sd = s1 `lubArgStr` s2\n      , ud = a1 `lubArgUse` a2 }\n\nbothDmd :: Demand -> Demand -> Demand\nbothDmd (JD {sd = s1, ud = a1}) (JD {sd = s2, ud = a2})\n = JD { sd = s1 `bothArgStr` s2\n      , ud = a1 `bothArgUse` a2 }\n\nlazyApply1Dmd, lazyApply2Dmd, strictApply1Dmd :: Demand\n\nstrictApply1Dmd = JD { sd = Str (SCall HeadStr)\n                     , ud = Use Many (UCall One Used) }\n\nlazyApply1Dmd = JD { sd = Lazy\n                   , ud = Use One (UCall One Used) }\n\n-- Second argument of catch#:\n--    uses its arg at most once, applies it once\n--    but is lazy (might not be called at all)\nlazyApply2Dmd = JD { sd = Lazy\n                   , ud = Use One (UCall One (UCall One Used)) }\n\nabsDmd :: Demand\nabsDmd = JD { sd = Lazy, ud = Abs }\n\ntopDmd :: Demand\ntopDmd = JD { sd = Lazy, ud = useTop }\n\nbotDmd :: Demand\nbotDmd = JD { sd = strBot, ud = useBot }\n\nseqDmd :: Demand\nseqDmd = JD { sd = Str HeadStr, ud = Use One UHead }\n\noneifyDmd :: JointDmd s (Use u) -> JointDmd s (Use u)\noneifyDmd (JD { sd = s, ud = Use _ a }) = JD { sd = s, ud = Use One a }\noneifyDmd jd                            = jd\n\nisTopDmd :: Demand -> Bool\n-- Used to suppress pretty-printing of an uninformative demand\nisTopDmd (JD {sd = Lazy, ud = Use Many Used}) = True\nisTopDmd _                                    = False\n\nisAbsDmd :: JointDmd (Str s) (Use u) -> Bool\nisAbsDmd (JD {ud = Abs}) = True   -- The strictness part can be HyperStr\nisAbsDmd _               = False  -- for a bottom demand\n\nisSeqDmd :: Demand -> Bool\nisSeqDmd (JD {sd = Str HeadStr, ud = Use _ UHead}) = True\nisSeqDmd _                                                = False\n\nisUsedOnce :: JointDmd (Str s) (Use u) -> Bool\nisUsedOnce (JD { ud = a }) = case useCount a of\n                               One  -> True\n                               Many -> False\n\n-- More utility functions for strictness\nseqDemand :: Demand -> ()\nseqDemand (JD {sd = s, ud = u}) = seqArgStr s `seq` seqArgUse u\n\nseqDemandList :: [Demand] -> ()\nseqDemandList [] = ()\nseqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds\n\nisStrictDmd :: JointDmd (Str s) (Use u) -> Bool\n-- See Note [Strict demands]\nisStrictDmd (JD {ud = Abs})  = False\nisStrictDmd (JD {sd = Lazy}) = False\nisStrictDmd _                = True\n\nisWeakDmd :: Demand -> Bool\nisWeakDmd (JD {sd = s, ud = a}) = isLazy s && isUsedMU a\n\ncleanUseDmd_maybe :: Demand -> Maybe UseDmd\ncleanUseDmd_maybe (JD { ud = Use _ u }) = Just u\ncleanUseDmd_maybe _                     = Nothing\n\nsplitFVs :: Bool   -- Thunk\n         -> DmdEnv -> (DmdEnv, DmdEnv)\nsplitFVs is_thunk rhs_fvs\n  | is_thunk  = nonDetFoldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs\n                -- It's OK to use nonDetFoldUFM_Directly because we\n                -- immediately forget the ordering by putting the elements\n                -- in the envs again\n  | otherwise = partitionVarEnv isWeakDmd rhs_fvs\n  where\n    add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv, sig_fv)\n      | Lazy <- s = (addToUFM_Directly lazy_fv uniq dmd, sig_fv)\n      | otherwise = ( addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })\n                    , addToUFM_Directly sig_fv  uniq (JD { sd = s,    ud = Abs }) )\n\ndata TypeShape = TsFun TypeShape\n               | TsProd [TypeShape]\n               | TsUnk\n\ninstance Outputable TypeShape where\n  ppr TsUnk        = text \"TsUnk\"\n  ppr (TsFun ts)   = text \"TsFun\" <> parens (ppr ts)\n  ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)\n\ntrimToType :: Demand -> TypeShape -> Demand\n-- See Note [Trimming a demand to a type]\ntrimToType (JD { sd = ms, ud = mu }) ts\n  = JD (go_ms ms ts) (go_mu mu ts)\n  where\n    go_ms :: ArgStr -> TypeShape -> ArgStr\n    go_ms Lazy    _  = Lazy\n    go_ms (Str s) ts = Str (go_s s ts)\n\n    go_s :: StrDmd -> TypeShape -> StrDmd\n    go_s HyperStr    _            = HyperStr\n    go_s (SCall s)   (TsFun ts)   = SCall (go_s s ts)\n    go_s (SProd mss) (TsProd tss)\n      | equalLength mss tss       = SProd (zipWith go_ms mss tss)\n    go_s _           _            = HeadStr\n\n    go_mu :: ArgUse -> TypeShape -> ArgUse\n    go_mu Abs _ = Abs\n    go_mu (Use c u) ts = Use c (go_u u ts)\n\n    go_u :: UseDmd -> TypeShape -> UseDmd\n    go_u UHead       _          = UHead\n    go_u (UCall c u) (TsFun ts) = UCall c (go_u u ts)\n    go_u (UProd mus) (TsProd tss)\n      | equalLength mus tss      = UProd (zipWith go_mu mus tss)\n    go_u _           _           = Used\n\n{-\nNote [Trimming a demand to a type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n\n  f :: a -> Bool\n  f x = case ... of\n          A g1 -> case (x |> g1) of (p,q) -> ...\n          B    -> error \"urk\"\n\nwhere A,B are the constructors of a GADT.  We'll get a U(U,U) demand\non x from the A branch, but that's a stupid demand for x itself, which\nhas type 'a'. Indeed we get ASSERTs going off (notably in\nsplitUseProdDmd, Trac #8569).\n\nBottom line: we really don't want to have a binder whose demand is more\ndeeply-nested than its type.  There are various ways to tackle this.\nWhen processing (x |> g1), we could \"trim\" the incoming demand U(U,U)\nto match x's type.  But I'm currently doing so just at the moment when\nwe pin a demand on a binder, in DmdAnal.findBndrDmd.\n\n\nNote [Threshold demands]\n~~~~~~~~~~~~~~~~~~~~~~~~\nThreshold usage demand is generated to figure out if\ncardinality-instrumented demands of a binding's free variables should\nbe unleashed. See also [Aggregated demand for cardinality].\n\nNote [Replicating polymorphic demands]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSome demands can be considered as polymorphic. Generally, it is\napplicable to such beasts as tops, bottoms as well as Head-Used and\nHead-stricts demands. For instance,\n\nS ~ S(L, ..., L)\n\nAlso, when top or bottom is occurred as a result demand, it in fact\ncan be expanded to saturate a callee's arity.\n-}\n\nsplitProdDmd_maybe :: Demand -> Maybe [Demand]\n-- Split a product into its components, iff there is any\n-- useful information to be extracted thereby\n-- The demand is not necessarily strict!\nsplitProdDmd_maybe (JD { sd = s, ud = u })\n  = case (s,u) of\n      (Str (SProd sx), Use _ u) | Just ux <- splitUseProdDmd (length sx) u\n                                -> Just (mkJointDmds sx ux)\n      (Str s, Use _ (UProd ux)) | Just sx <- splitStrProdDmd (length ux) s\n                                -> Just (mkJointDmds sx ux)\n      (Lazy,  Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux)\n      _ -> Nothing\n\n{-\n************************************************************************\n*                                                                      *\n                   Demand results\n*                                                                      *\n************************************************************************\n\n\nDmdResult:     Dunno CPRResult\n               /\n          Diverges\n\n\nCPRResult:         NoCPR\n                   /    \\\n            RetProd    RetSum ConTag\n\n\nProduct constructors return (Dunno (RetProd rs))\nIn a fixpoint iteration, start from Diverges\nWe have lubs, but not glbs; but that is ok.\n-}\n\n------------------------------------------------------------------------\n-- Constructed Product Result\n------------------------------------------------------------------------\n\ndata Termination r\n  = Diverges    -- Definitely diverges\n  | Dunno r     -- Might diverge or converge\n  deriving( Eq, Show )\n\n-- At this point, Termination is just the 'Lifted' lattice over 'r'\n-- (https://hackage.haskell.org/package/lattices/docs/Algebra-Lattice-Lifted.html)\n\ntype DmdResult = Termination CPRResult\n\ndata CPRResult = NoCPR          -- Top of the lattice\n               | RetProd        -- Returns a constructor from a product type\n               | RetSum ConTag  -- Returns a constructor from a data type\n               deriving( Eq, Show )\n\nlubCPR :: CPRResult -> CPRResult -> CPRResult\nlubCPR (RetSum t1) (RetSum t2)\n  | t1 == t2                       = RetSum t1\nlubCPR RetProd     RetProd     = RetProd\nlubCPR _ _                     = NoCPR\n\nlubDmdResult :: DmdResult -> DmdResult -> DmdResult\nlubDmdResult Diverges       r              = r\nlubDmdResult r              Diverges       = r\nlubDmdResult (Dunno c1)     (Dunno c2)     = Dunno (c1 `lubCPR` c2)\n-- This needs to commute with defaultDmd, i.e.\n-- defaultDmd (r1 `lubDmdResult` r2) = defaultDmd r1 `lubDmd` defaultDmd r2\n-- (See Note [Default demand on free variables] for why)\n\nbothDmdResult :: DmdResult -> Termination () -> DmdResult\n-- See Note [Asymmetry of 'both' for DmdType and DmdResult]\nbothDmdResult _ Diverges   = Diverges\nbothDmdResult r (Dunno {}) = r\n-- This needs to commute with defaultDmd, i.e.\n-- defaultDmd (r1 `bothDmdResult` r2) = defaultDmd r1 `bothDmd` defaultDmd r2\n-- (See Note [Default demand on free variables] for why)\n\ninstance Outputable r => Outputable (Termination r) where\n  ppr Diverges      = char 'b'\n  ppr (Dunno c)     = ppr c\n\ninstance Outputable CPRResult where\n  ppr NoCPR        = empty\n  ppr (RetSum n)   = char 'm' <> int n\n  ppr RetProd      = char 'm'\n\nseqDmdResult :: DmdResult -> ()\nseqDmdResult Diverges  = ()\nseqDmdResult (Dunno c) = seqCPRResult c\n\nseqCPRResult :: CPRResult -> ()\nseqCPRResult NoCPR        = ()\nseqCPRResult (RetSum n)   = n `seq` ()\nseqCPRResult RetProd      = ()\n\n\n------------------------------------------------------------------------\n-- Combined demand result                                             --\n------------------------------------------------------------------------\n\n-- [cprRes] lets us switch off CPR analysis\n-- by making sure that everything uses TopRes\ntopRes, botRes :: DmdResult\ntopRes = Dunno NoCPR\nbotRes = Diverges\n\ncprSumRes :: ConTag -> DmdResult\ncprSumRes tag = Dunno $ RetSum tag\n\ncprProdRes :: [DmdType] -> DmdResult\ncprProdRes _arg_tys = Dunno $ RetProd\n\nvanillaCprProdRes :: Arity -> DmdResult\nvanillaCprProdRes _arity = Dunno $ RetProd\n\nisTopRes :: DmdResult -> Bool\nisTopRes (Dunno NoCPR) = True\nisTopRes _             = False\n\n-- | True if the result diverges or throws an exception\nisBotRes :: DmdResult -> Bool\nisBotRes Diverges   = True\nisBotRes (Dunno {}) = False\n\ntrimCPRInfo :: Bool -> Bool -> DmdResult -> DmdResult\ntrimCPRInfo trim_all trim_sums res\n  = trimR res\n  where\n    trimR (Dunno c) = Dunno (trimC c)\n    trimR res       = res\n\n    trimC (RetSum n)   | trim_all || trim_sums = NoCPR\n                       | otherwise             = RetSum n\n    trimC RetProd      | trim_all  = NoCPR\n                       | otherwise = RetProd\n    trimC NoCPR = NoCPR\n\nreturnsCPR_maybe :: DmdResult -> Maybe ConTag\nreturnsCPR_maybe (Dunno c) = retCPR_maybe c\nreturnsCPR_maybe _         = Nothing\n\nretCPR_maybe :: CPRResult -> Maybe ConTag\nretCPR_maybe (RetSum t)  = Just t\nretCPR_maybe RetProd     = Just fIRST_TAG\nretCPR_maybe NoCPR       = Nothing\n\n-- See Notes [Default demand on free variables]\n-- and [defaultDmd vs. resTypeArgDmd]\ndefaultDmd :: Termination r -> Demand\ndefaultDmd (Dunno {}) = absDmd\ndefaultDmd _          = botDmd  -- Diverges\n\nresTypeArgDmd :: Termination r -> Demand\n-- TopRes and BotRes are polymorphic, so that\n--      BotRes === (Bot -> BotRes) === ...\n--      TopRes === (Top -> TopRes) === ...\n-- This function makes that concrete\n-- Also see Note [defaultDmd vs. resTypeArgDmd]\nresTypeArgDmd (Dunno _) = topDmd\nresTypeArgDmd _         = botDmd   -- Diverges\n\n{-\nNote [defaultDmd and resTypeArgDmd]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThese functions are similar: They express the demand on something not\nexplicitly mentioned in the environment resp. the argument list. Yet they are\ndifferent:\n * Variables not mentioned in the free variables environment are definitely\n   unused, so we can use absDmd there.\n * Further arguments *can* be used, of course. Hence topDmd is used.\n\n\n************************************************************************\n*                                                                      *\n           Demand environments and types\n*                                                                      *\n************************************************************************\n-}\n\ntype DmdEnv = VarEnv Demand   -- See Note [Default demand on free variables]\n\ndata DmdType = DmdType\n                  DmdEnv        -- Demand on explicitly-mentioned\n                                --      free variables\n                  [Demand]      -- Demand on arguments\n                  DmdResult     -- See [Nature of result demand]\n\n{-\nNote [Nature of result demand]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA DmdResult contains information about termination (currently distinguishing\ndefinite divergence and no information; it is possible to include definite\nconvergence here), and CPR information about the result.\n\nThe semantics of this depends on whether we are looking at a DmdType, i.e. the\ndemand put on by an expression _under a specific incoming demand_ on its\nenvironment, or at a StrictSig describing a demand transformer.\n\nFor a\n * DmdType, the termination information is true given the demand it was\n   generated with, while for\n * a StrictSig it holds after applying enough arguments.\n\nThe CPR information, though, is valid after the number of arguments mentioned\nin the type is given. Therefore, when forgetting the demand on arguments, as in\ndmdAnalRhs, this needs to be considere (via removeDmdTyArgs).\n\nConsider\n  b2 x y = x `seq` y `seq` error (show x)\nthis has a strictness signature of\n  <S><S>b\nmeaning that \"b2 `seq` ()\" and \"b2 1 `seq` ()\" might well terminate, but\nfor \"b2 1 2 `seq` ()\" we get definite divergence.\n\nFor comparison,\n  b1 x = x `seq` error (show x)\nhas a strictness signature of\n  <S>b\nand \"b1 1 `seq` ()\" is known to terminate.\n\nNow consider a function h with signature \"<C(S)>\", and the expression\n  e1 = h b1\nnow h puts a demand of <C(S)> onto its argument, and the demand transformer\nturns it into\n  <S>b\nNow the DmdResult \"b\" does apply to us, even though \"b1 `seq` ()\" does not\ndiverge, and we do not anything being passed to b.\n\nNote [Asymmetry of 'both' for DmdType and DmdResult]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n'both' for DmdTypes is *asymmetrical*, because there is only one\nresult!  For example, given (e1 e2), we get a DmdType dt1 for e1, use\nits arg demand to analyse e2 giving dt2, and then do (dt1 `bothType` dt2).\nSimilarly with\n  case e of { p -> rhs }\nwe get dt_scrut from the scrutinee and dt_rhs from the RHS, and then\ncompute (dt_rhs `bothType` dt_scrut).\n\nWe\n 1. combine the information on the free variables,\n 2. take the demand on arguments from the first argument\n 3. combine the termination results, but\n 4. take CPR info from the first argument.\n\n3 and 4 are implementd in bothDmdResult.\n-}\n\n-- Equality needed for fixpoints in DmdAnal\ninstance Eq DmdType where\n  (==) (DmdType fv1 ds1 res1)\n       (DmdType fv2 ds2 res2) = nonDetUFMToList fv1 == nonDetUFMToList fv2\n         -- It's OK to use nonDetUFMToList here because we're testing for\n         -- equality and even though the lists will be in some arbitrary\n         -- Unique order, it is the same order for both\n                              && ds1 == ds2 && res1 == res2\n\nlubDmdType :: DmdType -> DmdType -> DmdType\nlubDmdType d1 d2\n  = DmdType lub_fv lub_ds lub_res\n  where\n    n = max (dmdTypeDepth d1) (dmdTypeDepth d2)\n    (DmdType fv1 ds1 r1) = ensureArgs n d1\n    (DmdType fv2 ds2 r2) = ensureArgs n d2\n\n    lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultDmd r1) fv2 (defaultDmd r2)\n    lub_ds  = zipWithEqual \"lubDmdType\" lubDmd ds1 ds2\n    lub_res = lubDmdResult r1 r2\n\n{-\nNote [The need for BothDmdArg]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPreviously, the right argument to bothDmdType, as well as the return value of\ndmdAnalStar via postProcessDmdType, was a DmdType. But bothDmdType only needs\nto know about the free variables and termination information, but nothing about\nthe demand put on arguments, nor cpr information. So we make that explicit by\nonly passing the relevant information.\n-}\n\ntype BothDmdArg = (DmdEnv, Termination ())\n\nmkBothDmdArg :: DmdEnv -> BothDmdArg\nmkBothDmdArg env = (env, Dunno ())\n\ntoBothDmdArg :: DmdType -> BothDmdArg\ntoBothDmdArg (DmdType fv _ r) = (fv, go r)\n  where\n    go (Dunno {}) = Dunno ()\n    go Diverges   = Diverges\n\nbothDmdType :: DmdType -> BothDmdArg -> DmdType\nbothDmdType (DmdType fv1 ds1 r1) (fv2, t2)\n    -- See Note [Asymmetry of 'both' for DmdType and DmdResult]\n    -- 'both' takes the argument/result info from its *first* arg,\n    -- using its second arg just for its free-var info.\n  = DmdType (plusVarEnv_CD bothDmd fv1 (defaultDmd r1) fv2 (defaultDmd t2))\n            ds1\n            (r1 `bothDmdResult` t2)\n\ninstance Outputable DmdType where\n  ppr (DmdType fv ds res)\n    = hsep [hcat (map ppr ds) <> ppr res,\n            if null fv_elts then empty\n            else braces (fsep (map pp_elt fv_elts))]\n    where\n      pp_elt (uniq, dmd) = ppr uniq <> text \"->\" <> ppr dmd\n      fv_elts = nonDetUFMToList fv\n        -- It's OK to use nonDetUFMToList here because we only do it for\n        -- pretty printing\n\nemptyDmdEnv :: VarEnv Demand\nemptyDmdEnv = emptyVarEnv\n\n-- nopDmdType is the demand of doing nothing\n-- (lazy, absent, no CPR information, no termination information).\n-- Note that it is ''not'' the top of the lattice (which would be \"may use everything\"),\n-- so it is (no longer) called topDmd\nnopDmdType, botDmdType :: DmdType\nnopDmdType = DmdType emptyDmdEnv [] topRes\nbotDmdType = DmdType emptyDmdEnv [] botRes\n\ncprProdDmdType :: Arity -> DmdType\ncprProdDmdType arity\n  = DmdType emptyDmdEnv [] (vanillaCprProdRes arity)\n\nisTopDmdType :: DmdType -> Bool\nisTopDmdType (DmdType env [] res)\n  | isTopRes res && isEmptyVarEnv env = True\nisTopDmdType _                        = False\n\nmkDmdType :: DmdEnv -> [Demand] -> DmdResult -> DmdType\nmkDmdType fv ds res = DmdType fv ds res\n\ndmdTypeDepth :: DmdType -> Arity\ndmdTypeDepth (DmdType _ ds _) = length ds\n\n-- Remove any demand on arguments. This is used in dmdAnalRhs on the body\nremoveDmdTyArgs :: DmdType -> DmdType\nremoveDmdTyArgs = ensureArgs 0\n\n-- This makes sure we can use the demand type with n arguments,\n-- It extends the argument list with the correct resTypeArgDmd\n-- It also adjusts the DmdResult: Divergence survives additional arguments,\n-- CPR information does not (and definite converge also would not).\nensureArgs :: Arity -> DmdType -> DmdType\nensureArgs n d | n == depth = d\n               | otherwise  = DmdType fv ds' r'\n  where depth = dmdTypeDepth d\n        DmdType fv ds r = d\n\n        ds' = take n (ds ++ repeat (resTypeArgDmd r))\n        r' = case r of    -- See [Nature of result demand]\n              Dunno _ -> topRes\n              _       -> r\n\n\nseqDmdType :: DmdType -> ()\nseqDmdType (DmdType env ds res) =\n  seqDmdEnv env `seq` seqDemandList ds `seq` seqDmdResult res `seq` ()\n\nseqDmdEnv :: DmdEnv -> ()\nseqDmdEnv env = seqEltsUFM seqDemandList env\n\nsplitDmdTy :: DmdType -> (Demand, DmdType)\n-- Split off one function argument\n-- We already have a suitable demand on all\n-- free vars, so no need to add more!\nsplitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)\nsplitDmdTy ty@(DmdType _ [] res_ty)       = (resTypeArgDmd res_ty, ty)\n\n-- When e is evaluated after executing an IO action, and d is e's demand, then\n-- what of this demand should we consider, given that the IO action can cleanly\n-- exit?\n-- * We have to kill all strictness demands (i.e. lub with a lazy demand)\n-- * We can keep usage information (i.e. lub with an absent demand)\n-- * We have to kill definite divergence\n-- * We can keep CPR information.\n-- See Note [IO hack in the demand analyser] in DmdAnal\ndeferAfterIO :: DmdType -> DmdType\ndeferAfterIO d@(DmdType _ _ res) =\n    case d `lubDmdType` nopDmdType of\n        DmdType fv ds _ -> DmdType fv ds (defer_res res)\n  where\n  defer_res r@(Dunno {}) = r\n  defer_res _            = topRes  -- Diverges\n\nstrictenDmd :: Demand -> CleanDemand\nstrictenDmd (JD { sd = s, ud = u})\n  = JD { sd = poke_s s, ud = poke_u u }\n  where\n    poke_s Lazy      = HeadStr\n    poke_s (Str s)   = s\n    poke_u Abs       = UHead\n    poke_u (Use _ u) = u\n\n-- Deferring and peeling\n\ntype DmdShell   -- Describes the \"outer shell\"\n                -- of a Demand\n   = JointDmd (Str ()) (Use ())\n\ntoCleanDmd :: Demand -> (DmdShell, CleanDemand)\n-- Splits a Demand into its \"shell\" and the inner \"clean demand\"\ntoCleanDmd (JD { sd = s, ud = u })\n  = (JD { sd = ss, ud = us }, JD { sd = s', ud = u' })\n    -- See Note [Analyzing with lazy demand and lambdas]\n    -- See Note [Analysing with absent demand]\n  where\n    (ss, s') = case s of\n                Str s' -> (Str (), s')\n                Lazy   -> (Lazy,   HeadStr)\n\n    (us, u') = case u of\n                 Use c u' -> (Use c (), u')\n                 Abs      -> (Abs,      Used)\n\n-- This is used in dmdAnalStar when post-processing\n-- a function's argument demand. So we only care about what\n-- does to free variables, and whether it terminates.\n-- see Note [The need for BothDmdArg]\npostProcessDmdType :: DmdShell -> DmdType -> BothDmdArg\npostProcessDmdType du@(JD { sd = ss }) (DmdType fv _ res_ty)\n    = (postProcessDmdEnv du fv, term_info)\n    where\n       term_info = case postProcessDmdResult ss res_ty of\n                     Dunno _   -> Dunno ()\n                     Diverges  -> Diverges\n\npostProcessDmdResult :: Str () -> DmdResult -> DmdResult\npostProcessDmdResult Lazy _   = topRes\npostProcessDmdResult _    res = res\n\npostProcessDmdEnv :: DmdShell -> DmdEnv -> DmdEnv\npostProcessDmdEnv ds@(JD { sd = ss, ud = us }) env\n  | Abs <- us       = emptyDmdEnv\n    -- In this case (postProcessDmd ds) == id; avoid a redundant rebuild\n    -- of the environment. Be careful, bad things will happen if this doesn't\n    -- match postProcessDmd (see #13977).\n  | Str _ <- ss\n  , Use One _ <- us = env\n  | otherwise       = mapVarEnv (postProcessDmd ds) env\n  -- For the Absent case just discard all usage information\n  -- We only processed the thing at all to analyse the body\n  -- See Note [Always analyse in virgin pass]\n\nreuseEnv :: DmdEnv -> DmdEnv\nreuseEnv = mapVarEnv (postProcessDmd\n                        (JD { sd = Str (), ud = Use Many () }))\n\npostProcessUnsat :: DmdShell -> DmdType -> DmdType\npostProcessUnsat ds@(JD { sd = ss }) (DmdType fv args res_ty)\n  = DmdType (postProcessDmdEnv ds fv)\n            (map (postProcessDmd ds) args)\n            (postProcessDmdResult ss res_ty)\n\npostProcessDmd :: DmdShell -> Demand -> Demand\npostProcessDmd (JD { sd = ss, ud = us }) (JD { sd = s, ud = a})\n  = JD { sd = s', ud = a' }\n  where\n    s' = case ss of\n           Lazy  -> Lazy\n           Str _ -> s\n    a' = case us of\n           Abs        -> Abs\n           Use Many _ -> markReusedDmd a\n           Use One  _ -> a\n\n-- Peels one call level from the demand, and also returns\n-- whether it was unsaturated (separately for strictness and usage)\npeelCallDmd :: CleanDemand -> (CleanDemand, DmdShell)\n-- Exploiting the fact that\n-- on the strictness side      C(B) = B\n-- and on the usage side       C(U) = U\npeelCallDmd (JD {sd = s, ud = u})\n  = (JD { sd = s', ud = u' }, JD { sd = ss, ud = us })\n  where\n    (s', ss) = case s of\n                 SCall s' -> (s',       Str ())\n                 HyperStr -> (HyperStr, Str ())\n                 _        -> (HeadStr,  Lazy)\n    (u', us) = case u of\n                 UCall c u' -> (u',   Use c    ())\n                 _          -> (Used, Use Many ())\n       -- The _ cases for usage includes UHead which seems a bit wrong\n       -- because the body isn't used at all!\n       -- c.f. the Abs case in toCleanDmd\n\n-- Peels that multiple nestings of calls clean demand and also returns\n-- whether it was unsaturated (separately for strictness and usage\n-- see Note [Demands from unsaturated function calls]\npeelManyCalls :: Int -> CleanDemand -> DmdShell\npeelManyCalls n (JD { sd = str, ud = abs })\n  = JD { sd = go_str n str, ud = go_abs n abs }\n  where\n    go_str :: Int -> StrDmd -> Str ()  -- True <=> unsaturated, defer\n    go_str 0 _          = Str ()\n    go_str _ HyperStr   = Str () -- == go_str (n-1) HyperStr, as HyperStr = Call(HyperStr)\n    go_str n (SCall d') = go_str (n-1) d'\n    go_str _ _          = Lazy\n\n    go_abs :: Int -> UseDmd -> Use ()      -- Many <=> unsaturated, or at least\n    go_abs 0 _              = Use One ()   --          one UCall Many in the demand\n    go_abs n (UCall One d') = go_abs (n-1) d'\n    go_abs _ _              = Use Many ()\n\n{-\nNote [Demands from unsaturated function calls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nConsider a demand transformer d1 -> d2 -> r for f.\nIf a sufficiently detailed demand is fed into this transformer,\ne.g <C(C(S)), C1(C1(S))> arising from \"f x1 x2\" in a strict, use-once context,\nthen d1 and d2 is precisely the demand unleashed onto x1 and x2 (similar for\nthe free variable environment) and furthermore the result information r is the\none we want to use.\n\nAn anonymous lambda is also an unsaturated function all (needs one argument,\nnone given), so this applies to that case as well.\n\nBut the demand fed into f might be less than <C(C(S)), C1(C1(S))>. There are a few cases:\n * Not enough demand on the strictness side:\n   - In that case, we need to zap all strictness in the demand on arguments and\n     free variables.\n   - Furthermore, we remove CPR information. It could be left, but given the incoming\n     demand is not enough to evaluate so far we just do not bother.\n   - And finally termination information: If r says that f diverges for sure,\n     then this holds when the demand guarantees that two arguments are going to\n     be passed. If the demand is lower, we may just as well converge.\n     If we were tracking definite convegence, than that would still hold under\n     a weaker demand than expected by the demand transformer.\n * Not enough demand from the usage side: The missing usage can be expanded\n   using UCall Many, therefore this is subsumed by the third case:\n * At least one of the uses has a cardinality of Many.\n   - Even if f puts a One demand on any of its argument or free variables, if\n     we call f multiple times, we may evaluate this argument or free variable\n     multiple times. So forget about any occurrence of \"One\" in the demand.\n\nIn dmdTransformSig, we call peelManyCalls to find out if we are in any of these\ncases, and then call postProcessUnsat to reduce the demand appropriately.\n\nSimilarly, dmdTransformDictSelSig and dmdAnal, when analyzing a Lambda, use\npeelCallDmd, which peels only one level, but also returns the demand put on the\nbody of the function.\n-}\n\npeelFV :: DmdType -> Var -> (DmdType, Demand)\npeelFV (DmdType fv ds res) id = -- pprTrace \"rfv\" (ppr id <+> ppr dmd $$ ppr fv)\n                               (DmdType fv' ds res, dmd)\n  where\n  fv' = fv `delVarEnv` id\n  -- See Note [Default demand on free variables]\n  dmd  = lookupVarEnv fv id `orElse` defaultDmd res\n\naddDemand :: Demand -> DmdType -> DmdType\naddDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res\n\nfindIdDemand :: DmdType -> Var -> Demand\nfindIdDemand (DmdType fv _ res) id\n  = lookupVarEnv fv id `orElse` defaultDmd res\n\n{-\nNote [Default demand on free variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the variable is not mentioned in the environment of a demand type,\nits demand is taken to be a result demand of the type.\n    For the stricness component,\n     if the result demand is a Diverges, then we use HyperStr\n                                         else we use Lazy\n    For the usage component, we use Absent.\nSo we use either absDmd or botDmd.\n\nAlso note the equations for lubDmdResult (resp. bothDmdResult) noted there.\n\nNote [Always analyse in virgin pass]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTricky point: make sure that we analyse in the 'virgin' pass. Consider\n   rec { f acc x True  = f (...rec { g y = ...g... }...)\n         f acc x False = acc }\nIn the virgin pass for 'f' we'll give 'f' a very strict (bottom) type.\nThat might mean that we analyse the sub-expression containing the\nE = \"...rec g...\" stuff in a bottom demand.  Suppose we *didn't analyse*\nE, but just returned botType.\n\nThen in the *next* (non-virgin) iteration for 'f', we might analyse E\nin a weaker demand, and that will trigger doing a fixpoint iteration\nfor g.  But *because it's not the virgin pass* we won't start g's\niteration at bottom.  Disaster.  (This happened in $sfibToList' of\nnofib/spectral/fibheaps.)\n\nSo in the virgin pass we make sure that we do analyse the expression\nat least once, to initialise its signatures.\n\nNote [Analyzing with lazy demand and lambdas]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe insight for analyzing lambdas follows from the fact that for\nstrictness S = C(L). This polymorphic expansion is critical for\ncardinality analysis of the following example:\n\n{-# NOINLINE build #-}\nbuild g = (g (:) [], g (:) [])\n\nh c z = build (\\x ->\n                let z1 = z ++ z\n                 in if c\n                    then \\y -> x (y ++ z1)\n                    else \\y -> x (z1 ++ y))\n\nOne can see that `build` assigns to `g` demand <L,C(C1(U))>.\nTherefore, when analyzing the lambda `(\\x -> ...)`, we\nexpect each lambda \\y -> ... to be annotated as \"one-shot\"\none. Therefore (\\x -> \\y -> x (y ++ z)) should be analyzed with a\ndemand <C(C(..), C(C1(U))>.\n\nThis is achieved by, first, converting the lazy demand L into the\nstrict S by the second clause of the analysis.\n\nNote [Analysing with absent demand]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we analyse an expression with demand <L,A>.  The \"A\" means\n\"absent\", so this expression will never be needed.  What should happen?\nThere are several wrinkles:\n\n* We *do* want to analyse the expression regardless.\n  Reason: Note [Always analyse in virgin pass]\n\n  But we can post-process the results to ignore all the usage\n  demands coming back. This is done by postProcessDmdType.\n\n* In a previous incarnation of GHC we needed to be extra careful in the\n  case of an *unlifted type*, because unlifted values are evaluated\n  even if they are not used.  Example (see Trac #9254):\n     f :: (() -> (# Int#, () #)) -> ()\n          -- Strictness signature is\n          --    <C(S(LS)), 1*C1(U(A,1*U()))>\n          -- I.e. calls k, but discards first component of result\n     f k = case k () of (# _, r #) -> r\n\n     g :: Int -> ()\n     g y = f (\\n -> (# case y of I# y2 -> y2, n #))\n\n  Here f's strictness signature says (correctly) that it calls its\n  argument function and ignores the first component of its result.\n  This is correct in the sense that it'd be fine to (say) modify the\n  function so that always returned 0# in the first component.\n\n  But in function g, we *will* evaluate the 'case y of ...', because\n  it has type Int#.  So 'y' will be evaluated.  So we must record this\n  usage of 'y', else 'g' will say 'y' is absent, and will w/w so that\n  'y' is bound to an aBSENT_ERROR thunk.\n\n  However, the argument of toCleanDmd always satisfies the let/app\n  invariant; so if it is unlifted it is also okForSpeculation, and so\n  can be evaluated in a short finite time -- and that rules out nasty\n  cases like the one above.  (I'm not quite sure why this was a\n  problem in an earlier version of GHC, but it isn't now.)\n\n\n************************************************************************\n*                                                                      *\n                     Demand signatures\n*                                                                      *\n************************************************************************\n\nIn a let-bound Id we record its strictness info.\nIn principle, this strictness info is a demand transformer, mapping\na demand on the Id into a DmdType, which gives\n        a) the free vars of the Id's value\n        b) the Id's arguments\n        c) an indication of the result of applying\n           the Id to its arguments\n\nHowever, in fact we store in the Id an extremely emascuated demand\ntransfomer, namely\n\n                a single DmdType\n(Nevertheless we dignify StrictSig as a distinct type.)\n\nThis DmdType gives the demands unleashed by the Id when it is applied\nto as many arguments as are given in by the arg demands in the DmdType.\nAlso see Note [Nature of result demand] for the meaning of a DmdResult in a\nstrictness signature.\n\nIf an Id is applied to less arguments than its arity, it means that\nthe demand on the function at a call site is weaker than the vanilla\ncall demand, used for signature inference. Therefore we place a top\ndemand on all arguments. Otherwise, the demand is specified by Id's\nsignature.\n\nFor example, the demand transformer described by the demand signature\n        StrictSig (DmdType {x -> <S,1*U>} <L,A><L,U(U,U)>m)\nsays that when the function is applied to two arguments, it\nunleashes demand <S,1*U> on the free var x, <L,A> on the first arg,\nand <L,U(U,U)> on the second, then returning a constructor.\n\nIf this same function is applied to one arg, all we can say is that it\nuses x with <L,U>, and its arg with demand <L,U>.\n-}\n\nnewtype StrictSig = StrictSig DmdType\n                  deriving( Eq )\n\ninstance Outputable StrictSig where\n   ppr (StrictSig ty) = ppr ty\n\n-- Used for printing top-level strictness pragmas in interface files\npprIfaceStrictSig :: StrictSig -> SDoc\npprIfaceStrictSig (StrictSig (DmdType _ dmds res))\n  = hcat (map ppr dmds) <> ppr res\n\nmkStrictSig :: DmdType -> StrictSig\nmkStrictSig dmd_ty = StrictSig dmd_ty\n\nmkClosedStrictSig :: [Demand] -> DmdResult -> StrictSig\nmkClosedStrictSig ds res = mkStrictSig (DmdType emptyDmdEnv ds res)\n\nsplitStrictSig :: StrictSig -> ([Demand], DmdResult)\nsplitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)\n\nincreaseStrictSigArity :: Int -> StrictSig -> StrictSig\n-- Add extra arguments to a strictness signature\nincreaseStrictSigArity arity_increase sig@(StrictSig dmd_ty@(DmdType env dmds res))\n  | isTopDmdType dmd_ty = sig\n  | arity_increase <= 0 = sig\n  | otherwise           = StrictSig (DmdType env dmds' res)\n  where\n    dmds' = replicate arity_increase topDmd ++ dmds\n\netaExpandStrictSig :: Arity -> StrictSig -> StrictSig\n-- We are expanding (\\x y. e) to (\\x y z. e z)\n-- Add exta demands to the /end/ of the arg demands if necessary\netaExpandStrictSig arity sig@(StrictSig dmd_ty@(DmdType env dmds res))\n  | isTopDmdType dmd_ty = sig\n  | arity_increase <= 0 = sig\n  | otherwise           = StrictSig (DmdType env dmds' res)\n  where\n    arity_increase = arity - length dmds\n    dmds' = dmds ++ replicate arity_increase topDmd\n\nisTopSig :: StrictSig -> Bool\nisTopSig (StrictSig ty) = isTopDmdType ty\n\nhasDemandEnvSig :: StrictSig -> Bool\nhasDemandEnvSig (StrictSig (DmdType env _ _)) = not (isEmptyVarEnv env)\n\nstrictSigDmdEnv :: StrictSig -> DmdEnv\nstrictSigDmdEnv (StrictSig (DmdType env _ _)) = env\n\n-- | True if the signature diverges or throws an exception\nisBottomingSig :: StrictSig -> Bool\nisBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res\n\nnopSig, botSig :: StrictSig\nnopSig = StrictSig nopDmdType\nbotSig = StrictSig botDmdType\n\ncprProdSig :: Arity -> StrictSig\ncprProdSig arity = StrictSig (cprProdDmdType arity)\n\nseqStrictSig :: StrictSig -> ()\nseqStrictSig (StrictSig ty) = seqDmdType ty\n\ndmdTransformSig :: StrictSig -> CleanDemand -> DmdType\n-- (dmdTransformSig fun_sig dmd) considers a call to a function whose\n-- signature is fun_sig, with demand dmd.  We return the demand\n-- that the function places on its context (eg its args)\ndmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _)) cd\n  = postProcessUnsat (peelManyCalls (length arg_ds) cd) dmd_ty\n    -- see Note [Demands from unsaturated function calls]\n\ndmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType\n-- Same as dmdTransformSig but for a data constructor (worker),\n-- which has a special kind of demand transformer.\n-- If the constructor is saturated, we feed the demand on\n-- the result into the constructor arguments.\ndmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res))\n                             (JD { sd = str, ud = abs })\n  | Just str_dmds <- go_str arity str\n  , Just abs_dmds <- go_abs arity abs\n  = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) con_res\n                -- Must remember whether it's a product, hence con_res, not TopRes\n\n  | otherwise   -- Not saturated\n  = nopDmdType\n  where\n    go_str 0 dmd        = splitStrProdDmd arity dmd\n    go_str n (SCall s') = go_str (n-1) s'\n    go_str n HyperStr   = go_str (n-1) HyperStr\n    go_str _ _          = Nothing\n\n    go_abs 0 dmd            = splitUseProdDmd arity dmd\n    go_abs n (UCall One u') = go_abs (n-1) u'\n    go_abs _ _              = Nothing\n\ndmdTransformDictSelSig :: StrictSig -> CleanDemand -> DmdType\n-- Like dmdTransformDataConSig, we have a special demand transformer\n-- for dictionary selectors.  If the selector is saturated (ie has one\n-- argument: the dictionary), we feed the demand on the result into\n-- the indicated dictionary component.\ndmdTransformDictSelSig (StrictSig (DmdType _ [dict_dmd] _)) cd\n   | (cd',defer_use) <- peelCallDmd cd\n   , Just jds <- splitProdDmd_maybe dict_dmd\n   = postProcessUnsat defer_use $\n     DmdType emptyDmdEnv [mkOnceUsedDmd $ mkProdDmd $ map (enhance cd') jds] topRes\n   | otherwise\n   = nopDmdType              -- See Note [Demand transformer for a dictionary selector]\n  where\n    enhance cd old | isAbsDmd old = old\n                   | otherwise    = mkOnceUsedDmd cd  -- This is the one!\n\ndmdTransformDictSelSig _ _ = panic \"dmdTransformDictSelSig: no args\"\n\n{-\nNote [Demand transformer for a dictionary selector]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we evaluate (op dict-expr) under demand 'd', then we can push the demand 'd'\ninto the appropriate field of the dictionary. What *is* the appropriate field?\nWe just look at the strictness signature of the class op, which will be\nsomething like: U(AAASAAAAA).  Then replace the 'S' by the demand 'd'.\n\nFor single-method classes, which are represented by newtypes the signature\nof 'op' won't look like U(...), so the splitProdDmd_maybe will fail.\nThat's fine: if we are doing strictness analysis we are also doing inlining,\nso we'll have inlined 'op' into a cast.  So we can bale out in a conservative\nway, returning nopDmdType.\n\nIt is (just.. Trac #8329) possible to be running strictness analysis *without*\nhaving inlined class ops from single-method classes.  Suppose you are using\nghc --make; and the first module has a local -O0 flag.  So you may load a class\nwithout interface pragmas, ie (currently) without an unfolding for the class\nops.   Now if a subsequent module in the --make sweep has a local -O flag\nyou might do strictness analysis, but there is no inlining for the class op.\nThis is weird, so I'm not worried about whether this optimises brilliantly; but\nit should not fall over.\n-}\n\nargsOneShots :: StrictSig -> Arity -> [[OneShotInfo]]\n-- See Note [Computing one-shot info]\nargsOneShots (StrictSig (DmdType _ arg_ds _)) n_val_args\n  | unsaturated_call = []\n  | otherwise = go arg_ds\n  where\n    unsaturated_call = arg_ds `lengthExceeds` n_val_args\n\n    go []               = []\n    go (arg_d : arg_ds) = argOneShots arg_d `cons` go arg_ds\n\n    -- Avoid list tail like [ [], [], [] ]\n    cons [] [] = []\n    cons a  as = a:as\n\n-- saturatedByOneShots n C1(C1(...)) = True,\n--   <=>\n-- there are at least n nested C1(..) calls\n-- See Note [Demand on the worker] in WorkWrap\nsaturatedByOneShots :: Int -> Demand -> Bool\nsaturatedByOneShots n (JD { ud = usg })\n  = case usg of\n      Use _ arg_usg -> go n arg_usg\n      _             -> False\n  where\n    go 0 _             = True\n    go n (UCall One u) = go (n-1) u\n    go _ _             = False\n\nargOneShots :: Demand          -- depending on saturation\n            -> [OneShotInfo]\nargOneShots (JD { ud = usg })\n  = case usg of\n      Use _ arg_usg -> go arg_usg\n      _             -> []\n  where\n    go (UCall One  u) = OneShotLam : go u\n    go (UCall Many u) = NoOneShotInfo : go u\n    go _              = []\n\n{- Note [Computing one-shot info]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider a call\n    f (\\pqr. e1) (\\xyz. e2) e3\nwhere f has usage signature\n    C1(C(C1(U))) C1(U) U\nThen argsOneShots returns a [[OneShotInfo]] of\n    [[OneShot,NoOneShotInfo,OneShot],  [OneShot]]\nThe occurrence analyser propagates this one-shot infor to the\nbinders \\pqr and \\xyz; see Note [Use one-shot information] in OccurAnal.\n-}\n\n-- | Returns true if an application to n args\n-- would diverge or throw an exception\n-- See Note [Unsaturated applications]\nappIsBottom :: StrictSig -> Int -> Bool\nappIsBottom (StrictSig (DmdType _ ds res)) n\n            | isBotRes res                   = not $ lengthExceeds ds n\nappIsBottom _                              _ = False\n\n{-\nNote [Unsaturated applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf a function having bottom as its demand result is applied to a less\nnumber of arguments than its syntactic arity, we cannot say for sure\nthat it is going to diverge. This is the reason why we use the\nfunction appIsBottom, which, given a strictness signature and a number\nof arguments, says conservatively if the function is going to diverge\nor not.\n\nZap absence or one-shot information, under control of flags\n\nNote [Killing usage information]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe flags -fkill-one-shot and -fkill-absence let you switch off the generation\nof absence or one-shot information altogether.  This is only used for performance\ntests, to see how important they are.\n-}\n\nzapUsageEnvSig :: StrictSig -> StrictSig\n-- Remove the usage environment from the demand\nzapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r\n\nzapUsageDemand :: Demand -> Demand\n-- Remove the usage info, but not the strictness info, from the demand\nzapUsageDemand = kill_usage $ KillFlags\n    { kf_abs         = True\n    , kf_used_once   = True\n    , kf_called_once = True\n    }\n\n-- | Remove all 1* information (but not C1 information) from the demand\nzapUsedOnceDemand :: Demand -> Demand\nzapUsedOnceDemand = kill_usage $ KillFlags\n    { kf_abs         = False\n    , kf_used_once   = True\n    , kf_called_once = False\n    }\n\n-- | Remove all 1* information (but not C1 information) from the strictness\n--   signature\nzapUsedOnceSig :: StrictSig -> StrictSig\nzapUsedOnceSig (StrictSig (DmdType env ds r))\n    = StrictSig (DmdType env (map zapUsedOnceDemand ds) r)\n\nkillUsageDemand :: DynFlags -> Demand -> Demand\n-- See Note [Killing usage information]\nkillUsageDemand dflags dmd\n  | Just kfs <- killFlags dflags = kill_usage kfs dmd\n  | otherwise                    = dmd\n\nkillUsageSig :: DynFlags -> StrictSig -> StrictSig\n-- See Note [Killing usage information]\nkillUsageSig dflags sig@(StrictSig (DmdType env ds r))\n  | Just kfs <- killFlags dflags = StrictSig (DmdType env (map (kill_usage kfs) ds) r)\n  | otherwise                    = sig\n\ndata KillFlags = KillFlags\n    { kf_abs         :: Bool\n    , kf_used_once   :: Bool\n    , kf_called_once :: Bool\n    }\n\nkillFlags :: DynFlags -> Maybe KillFlags\n-- See Note [Killing usage information]\nkillFlags dflags\n  | not kf_abs && not kf_used_once = Nothing\n  | otherwise                      = Just (KillFlags {..})\n  where\n    kf_abs         = gopt Opt_KillAbsence dflags\n    kf_used_once   = gopt Opt_KillOneShot dflags\n    kf_called_once = kf_used_once\n\nkill_usage :: KillFlags -> Demand -> Demand\nkill_usage kfs (JD {sd = s, ud = u}) = JD {sd = s, ud = zap_musg kfs u}\n\nzap_musg :: KillFlags -> ArgUse -> ArgUse\nzap_musg kfs Abs\n  | kf_abs kfs = useTop\n  | otherwise  = Abs\nzap_musg kfs (Use c u)\n  | kf_used_once kfs = Use Many (zap_usg kfs u)\n  | otherwise        = Use c    (zap_usg kfs u)\n\nzap_usg :: KillFlags -> UseDmd -> UseDmd\nzap_usg kfs (UCall c u)\n    | kf_called_once kfs = UCall Many (zap_usg kfs u)\n    | otherwise          = UCall c    (zap_usg kfs u)\nzap_usg kfs (UProd us)   = UProd (map (zap_musg kfs) us)\nzap_usg _   u            = u\n\n-- If the argument is a used non-newtype dictionary, give it strict\n-- demand. Also split the product type & demand and recur in order to\n-- similarly strictify the argument's contained used non-newtype\n-- superclass dictionaries. We use the demand as our recursive measure\n-- to guarantee termination.\nstrictifyDictDmd :: Type -> Demand -> Demand\nstrictifyDictDmd ty dmd = case getUseDmd dmd of\n  Use n _ |\n    Just (tycon, _arg_tys, _data_con, inst_con_arg_tys)\n      <- splitDataProductType_maybe ty,\n    not (isNewTyCon tycon), isClassTyCon tycon -- is a non-newtype dictionary\n    -> seqDmd `bothDmd` -- main idea: ensure it's strict\n       case splitProdDmd_maybe dmd of\n         -- superclass cycles should not be a problem, since the demand we are\n         -- consuming would also have to be infinite in order for us to diverge\n         Nothing -> dmd -- no components have interesting demand, so stop\n                        -- looking for superclass dicts\n         Just dmds\n           | all (not . isAbsDmd) dmds -> evalDmd\n             -- abstract to strict w/ arbitrary component use, since this\n             -- smells like reboxing; results in CBV boxed\n             --\n             -- TODO revisit this if we ever do boxity analysis\n           | otherwise -> case mkProdDmd $ zipWith strictifyDictDmd inst_con_arg_tys dmds of\n               JD {sd = s,ud = a} -> JD (Str s) (Use n a)\n             -- TODO could optimize with an aborting variant of zipWith since\n             -- the superclass dicts are always a prefix\n  _ -> dmd -- unused or not a dictionary\n\nstrictifyDmd :: Demand -> Demand\nstrictifyDmd dmd@(JD { sd = str })\n  = dmd { sd = str `bothArgStr` Str HeadStr }\n\n{-\nNote [HyperStr and Use demands]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe information \"HyperStr\" needs to be in the strictness signature, and not in\nthe demand signature, because we still want to know about the demand on things. Consider\n\n    f (x,y) True  = error (show x)\n    f (x,y) False = x+1\n\nThe signature of f should be <S(SL),1*U(1*U(U),A)><S,1*U>m. If we were not\ndistinguishing the uses on x and y in the True case, we could either not figure\nout how deeply we can unpack x, or that we do not have to pass y.\n\n\n************************************************************************\n*                                                                      *\n                     Serialisation\n*                                                                      *\n************************************************************************\n-}\n\ninstance Binary StrDmd where\n  put_ bh HyperStr     = do putByte bh 0\n  put_ bh HeadStr      = do putByte bh 1\n  put_ bh (SCall s)    = do putByte bh 2\n                            put_ bh s\n  put_ bh (SProd sx)   = do putByte bh 3\n                            put_ bh sx\n  get bh = do\n         h <- getByte bh\n         case h of\n           0 -> do return HyperStr\n           1 -> do return HeadStr\n           2 -> do s  <- get bh\n                   return (SCall s)\n           _ -> do sx <- get bh\n                   return (SProd sx)\n\ninstance Binary ArgStr where\n    put_ bh Lazy         = do\n            putByte bh 0\n    put_ bh (Str s)    = do\n            putByte bh 1\n            put_ bh s\n\n    get  bh = do\n            h <- getByte bh\n            case h of\n              0 -> return Lazy\n              _ -> do s  <- get bh\n                      return $ Str s\n\ninstance Binary Count where\n    put_ bh One  = do putByte bh 0\n    put_ bh Many = do putByte bh 1\n\n    get  bh = do h <- getByte bh\n                 case h of\n                   0 -> return One\n                   _ -> return Many\n\ninstance Binary ArgUse where\n    put_ bh Abs          = do\n            putByte bh 0\n    put_ bh (Use c u)    = do\n            putByte bh 1\n            put_ bh c\n            put_ bh u\n\n    get  bh = do\n            h <- getByte bh\n            case h of\n              0 -> return Abs\n              _ -> do c  <- get bh\n                      u  <- get bh\n                      return $ Use c u\n\ninstance Binary UseDmd where\n    put_ bh Used         = do\n            putByte bh 0\n    put_ bh UHead        = do\n            putByte bh 1\n    put_ bh (UCall c u)    = do\n            putByte bh 2\n            put_ bh c\n            put_ bh u\n    put_ bh (UProd ux)   = do\n            putByte bh 3\n            put_ bh ux\n\n    get  bh = do\n            h <- getByte bh\n            case h of\n              0 -> return $ Used\n              1 -> return $ UHead\n              2 -> do c <- get bh\n                      u <- get bh\n                      return (UCall c u)\n              _ -> do ux <- get bh\n                      return (UProd ux)\n\ninstance (Binary s, Binary u) => Binary (JointDmd s u) where\n    put_ bh (JD { sd = x, ud = y }) = do put_ bh x; put_ bh y\n    get  bh = do\n              x <- get bh\n              y <- get bh\n              return $ JD { sd = x, ud = y }\n\ninstance Binary StrictSig where\n    put_ bh (StrictSig aa) = do\n            put_ bh aa\n    get bh = do\n          aa <- get bh\n          return (StrictSig aa)\n\ninstance Binary DmdType where\n  -- Ignore DmdEnv when spitting out the DmdType\n  put_ bh (DmdType _ ds dr)\n       = do put_ bh ds\n            put_ bh dr\n  get bh\n      = do ds <- get bh\n           dr <- get bh\n           return (DmdType emptyDmdEnv ds dr)\n\ninstance Binary DmdResult where\n  put_ bh (Dunno c)     = do { putByte bh 0; put_ bh c }\n  put_ bh Diverges      = putByte bh 1\n\n  get bh = do { h <- getByte bh\n              ; case h of\n                  0 -> do { c <- get bh; return (Dunno c) }\n                  _ -> return Diverges }\n\ninstance Binary CPRResult where\n    put_ bh (RetSum n)   = do { putByte bh 0; put_ bh n }\n    put_ bh RetProd      = putByte bh 1\n    put_ bh NoCPR        = putByte bh 2\n\n    get  bh = do\n            h <- getByte bh\n            case h of\n              0 -> do { n <- get bh; return (RetSum n) }\n              1 -> return RetProd\n              _ -> return NoCPR\n", "num_lines": 2039}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n%\n% (c) Adam Gundry 2013-2015\n%\n\nThis module defines the representation of FieldLabels as stored in\nTyCons.  As well as a selector name, these have some extra structure\nto support the DuplicateRecordFields extension.\n\nIn the normal case (with NoDuplicateRecordFields), a datatype like\n\n    data T = MkT { foo :: Int }\n\nhas\n\n    FieldLabel { flLabel        = \"foo\"\n               , flIsOverloaded = False\n               , flSelector     = foo }.\n\nIn particular, the Name of the selector has the same string\nrepresentation as the label.  If DuplicateRecordFields\nis enabled, however, the same declaration instead gives\n\n    FieldLabel { flLabel        = \"foo\"\n               , flIsOverloaded = True\n               , flSelector     = $sel:foo:MkT }.\n\nNow the name of the selector ($sel:foo:MkT) does not match the label of\nthe field (foo).  We must be careful not to show the selector name to\nthe user!  The point of mangling the selector name is to allow a\nmodule to define the same field label in different datatypes:\n\n    data T = MkT { foo :: Int }\n    data U = MkU { foo :: Bool }\n\nNow there will be two FieldLabel values for 'foo', one in T and one in\nU.  They share the same label (FieldLabelString), but the selector\nfunctions differ.\n\nSee also Note [Representing fields in AvailInfo] in Avail.\n\nNote [Why selector names include data constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nAs explained above, a selector name includes the name of the first\ndata constructor in the type, so that the same label can appear\nmultiple times in the same module.  (This is irrespective of whether\nthe first constructor has that field, for simplicity.)\n\nWe use a data constructor name, rather than the type constructor name,\nbecause data family instances do not have a representation type\nconstructor name generated until relatively late in the typechecking\nprocess.\n\nOf course, datatypes with no constructors cannot have any fields.\n\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE DeriveFoldable #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\nmodule FieldLabel ( FieldLabelString\n                  , FieldLabelEnv\n                  , FieldLbl(..)\n                  , FieldLabel\n                  , mkFieldLabelOccs\n                  ) where\n\nimport GhcPrelude\n\nimport OccName\nimport Name\n\nimport FastString\nimport FastStringEnv\nimport Outputable\nimport Binary\n\nimport Data.Data\n\n-- | Field labels are just represented as strings;\n-- they are not necessarily unique (even within a module)\ntype FieldLabelString = FastString\n\n-- | A map from labels to all the auxiliary information\ntype FieldLabelEnv = DFastStringEnv FieldLabel\n\n\ntype FieldLabel = FieldLbl Name\n\n-- | Fields in an algebraic record type\ndata FieldLbl a = FieldLabel {\n      flLabel        :: FieldLabelString, -- ^ User-visible label of the field\n      flIsOverloaded :: Bool,             -- ^ Was DuplicateRecordFields on\n                                          --   in the defining module for this datatype?\n      flSelector     :: a                 -- ^ Record selector function\n    }\n  deriving (Eq, Functor, Foldable, Traversable)\nderiving instance Data a => Data (FieldLbl a)\n\ninstance Outputable a => Outputable (FieldLbl a) where\n    ppr fl = ppr (flLabel fl) <> braces (ppr (flSelector fl))\n\ninstance Binary a => Binary (FieldLbl a) where\n    put_ bh (FieldLabel aa ab ac) = do\n        put_ bh aa\n        put_ bh ab\n        put_ bh ac\n    get bh = do\n        ab <- get bh\n        ac <- get bh\n        ad <- get bh\n        return (FieldLabel ab ac ad)\n\n\n-- | Record selector OccNames are built from the underlying field name\n-- and the name of the first data constructor of the type, to support\n-- duplicate record field names.\n-- See Note [Why selector names include data constructors].\nmkFieldLabelOccs :: FieldLabelString -> OccName -> Bool -> FieldLbl OccName\nmkFieldLabelOccs lbl dc is_overloaded\n  = FieldLabel { flLabel = lbl, flIsOverloaded = is_overloaded\n               , flSelector = sel_occ }\n  where\n    str     = \":\" ++ unpackFS lbl ++ \":\" ++ occNameString dc\n    sel_occ | is_overloaded = mkRecFldSelOcc str\n            | otherwise     = mkVarOccFS lbl\n", "num_lines": 131}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[Id]{@Ids@: Value and constructor identifiers}\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- |\n-- #name_types#\n-- GHC uses several kinds of name internally:\n--\n-- * 'OccName.OccName': see \"OccName#name_types\"\n--\n-- * 'RdrName.RdrName': see \"RdrName#name_types\"\n--\n-- * 'Name.Name': see \"Name#name_types\"\n--\n-- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional\n--   details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that\n--   are added, modified and inspected by various compiler passes. These 'Var.Var' names may either\n--   be global or local, see \"Var#globalvslocal\"\n--\n-- * 'Var.Var': see \"Var#name_types\"\n\nmodule Id (\n        -- * The main types\n        Var, Id, isId,\n\n        -- * In and Out variants\n        InVar,  InId,\n        OutVar, OutId,\n\n        -- ** Simple construction\n        mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,\n        mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,\n        mkLocalIdOrCoVarWithInfo,\n        mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,\n        mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,\n        mkUserLocal, mkUserLocalOrCoVar,\n        mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,\n        mkWorkerId,\n\n        -- ** Taking an Id apart\n        idName, idType, idUnique, idInfo, idDetails,\n        recordSelectorTyCon,\n\n        -- ** Modifying an Id\n        setIdName, setIdUnique, Id.setIdType,\n        setIdExported, setIdNotExported,\n        globaliseId, localiseId,\n        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,\n        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,\n        zapIdUsedOnceInfo, zapIdTailCallInfo,\n        zapFragileIdInfo, zapIdStrictness, zapStableUnfolding,\n        transferPolyIdInfo,\n\n        -- ** Predicates on Ids\n        isImplicitId, isDeadBinder,\n        isStrictId,\n        isExportedId, isLocalId, isGlobalId,\n        isRecordSelector, isNaughtyRecordSelector,\n        isPatSynRecordSelector,\n        isDataConRecordSelector,\n        isClassOpId_maybe, isDFunId,\n        isPrimOpId, isPrimOpId_maybe,\n        isFCallId, isFCallId_maybe,\n        isDataConWorkId, isDataConWorkId_maybe,\n        isDataConWrapId, isDataConWrapId_maybe,\n        isDataConId_maybe,\n        idDataCon,\n        isConLikeId, isBottomingId, idIsFrom,\n        hasNoBinding,\n\n        -- ** Evidence variables\n        DictId, isDictId, isEvVar,\n\n        -- ** Join variables\n        JoinId, isJoinId, isJoinId_maybe, idJoinArity,\n        asJoinId, asJoinId_maybe, zapJoinId,\n\n        -- ** Inline pragma stuff\n        idInlinePragma, setInlinePragma, modifyInlinePragma,\n        idInlineActivation, setInlineActivation, idRuleMatchInfo,\n\n        -- ** One-shot lambdas\n        isOneShotBndr, isProbablyOneShotLambda,\n        setOneShotLambda, clearOneShotLambda,\n        updOneShotInfo, setIdOneShotInfo,\n        isStateHackType, stateHackOneShot, typeOneShot,\n\n        -- ** Reading 'IdInfo' fields\n        idArity,\n        idCallArity, idFunRepArity,\n        idUnfolding, realIdUnfolding,\n        idSpecialisation, idCoreRules, idHasRules,\n        idCafInfo,\n        idOneShotInfo, idStateHackOneShotInfo,\n        idOccInfo,\n        isNeverLevPolyId,\n\n        -- ** Writing 'IdInfo' fields\n        setIdUnfolding, setCaseBndrEvald,\n        setIdArity,\n        setIdCallArity,\n\n        setIdSpecialisation,\n        setIdCafInfo,\n        setIdOccInfo, zapIdOccInfo,\n\n        setIdDemandInfo,\n        setIdStrictness,\n\n        idDemandInfo,\n        idStrictness,\n\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport CoreSyn ( CoreRule, isStableUnfolding, evaldUnfolding,\n                 isCompulsoryUnfolding, Unfolding( NoUnfolding ) )\n\nimport IdInfo\nimport BasicTypes\n\n-- Imported and re-exported\nimport Var( Id, CoVar, DictId, JoinId,\n            InId,  InVar,\n            OutId, OutVar,\n            idInfo, idDetails, setIdDetails, globaliseId, varType,\n            isId, isLocalId, isGlobalId, isExportedId )\nimport qualified Var\n\nimport Type\nimport RepType\nimport TysPrim\nimport DataCon\nimport Demand\nimport Name\nimport Module\nimport Class\nimport {-# SOURCE #-} PrimOp (PrimOp)\nimport ForeignCall\nimport Maybes\nimport SrcLoc\nimport Outputable\nimport Unique\nimport UniqSupply\nimport FastString\nimport Util\n\n-- infixl so you can say (id `set` a `set` b)\ninfixl  1 `setIdUnfolding`,\n          `setIdArity`,\n          `setIdCallArity`,\n          `setIdOccInfo`,\n          `setIdOneShotInfo`,\n\n          `setIdSpecialisation`,\n          `setInlinePragma`,\n          `setInlineActivation`,\n          `idCafInfo`,\n\n          `setIdDemandInfo`,\n          `setIdStrictness`,\n\n          `asJoinId`,\n          `asJoinId_maybe`\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Basic Id manipulation}\n*                                                                      *\n************************************************************************\n-}\n\nidName   :: Id -> Name\nidName    = Var.varName\n\nidUnique :: Id -> Unique\nidUnique  = Var.varUnique\n\nidType   :: Id -> Kind\nidType    = Var.varType\n\nsetIdName :: Id -> Name -> Id\nsetIdName = Var.setVarName\n\nsetIdUnique :: Id -> Unique -> Id\nsetIdUnique = Var.setVarUnique\n\n-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and\n-- reduce space usage\nsetIdType :: Id -> Type -> Id\nsetIdType id ty = seqType ty `seq` Var.setVarType id ty\n\nsetIdExported :: Id -> Id\nsetIdExported = Var.setIdExported\n\nsetIdNotExported :: Id -> Id\nsetIdNotExported = Var.setIdNotExported\n\nlocaliseId :: Id -> Id\n-- Make an Id with the same unique and type as the\n-- incoming Id, but with an *Internal* Name and *LocalId* flavour\nlocaliseId id\n  | ASSERT( isId id ) isLocalId id && isInternalName name\n  = id\n  | otherwise\n  = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)\n  where\n    name = idName id\n\nlazySetIdInfo :: Id -> IdInfo -> Id\nlazySetIdInfo = Var.lazySetIdInfo\n\nsetIdInfo :: Id -> IdInfo -> Id\nsetIdInfo id info = info `seq` (lazySetIdInfo id info)\n        -- Try to avoid space leaks by seq'ing\n\nmodifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id\nmodifyIdInfo fn id = setIdInfo id (fn (idInfo id))\n\n-- maybeModifyIdInfo tries to avoid unnecessary thrashing\nmaybeModifyIdInfo :: Maybe IdInfo -> Id -> Id\nmaybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info\nmaybeModifyIdInfo Nothing         id = id\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Simple Id construction}\n*                                                                      *\n************************************************************************\n\nAbsolutely all Ids are made by mkId.  It is just like Var.mkId,\nbut in addition it pins free-tyvar-info onto the Id's type,\nwhere it can easily be found.\n\nNote [Free type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nAt one time we cached the free type variables of the type of an Id\nat the root of the type in a TyNote.  The idea was to avoid repeating\nthe free-type-variable calculation.  But it turned out to slow down\nthe compiler overall. I don't quite know why; perhaps finding free\ntype variables of an Id isn't all that common whereas applying a\nsubstitution (which changes the free type variables) is more common.\nAnyway, we removed it in March 2008.\n-}\n\n-- | For an explanation of global vs. local 'Id's, see \"Var#globalvslocal\"\nmkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id\nmkGlobalId = Var.mkGlobalVar\n\n-- | Make a global 'Id' without any extra information at all\nmkVanillaGlobal :: Name -> Type -> Id\nmkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo\n\n-- | Make a global 'Id' with no global information but some generic 'IdInfo'\nmkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id\nmkVanillaGlobalWithInfo = mkGlobalId VanillaId\n\n\n-- | For an explanation of global vs. local 'Id's, see \"Var#globalvslocal\"\nmkLocalId :: Name -> Type -> Id\nmkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo\n -- It's tempting to ASSERT( not (isCoVarType ty) ), but don't. Sometimes,\n -- the type is a panic. (Search invented_id)\n\n-- | Make a local CoVar\nmkLocalCoVar :: Name -> Type -> CoVar\nmkLocalCoVar name ty\n  = ASSERT( isCoVarType ty )\n    Var.mkLocalVar CoVarId name ty vanillaIdInfo\n\n-- | Like 'mkLocalId', but checks the type to see if it should make a covar\nmkLocalIdOrCoVar :: Name -> Type -> Id\nmkLocalIdOrCoVar name ty\n  | isCoVarType ty = mkLocalCoVar name ty\n  | otherwise      = mkLocalId    name ty\n\n-- | Make a local id, with the IdDetails set to CoVarId if the type indicates\n-- so.\nmkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id\nmkLocalIdOrCoVarWithInfo name ty info\n  = Var.mkLocalVar details name ty info\n  where\n    details | isCoVarType ty = CoVarId\n            | otherwise      = VanillaId\n\n    -- proper ids only; no covars!\nmkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id\nmkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info\n        -- Note [Free type variables]\n\n-- | Create a local 'Id' that is marked as exported.\n-- This prevents things attached to it from being removed as dead code.\n-- See Note [Exported LocalIds]\nmkExportedLocalId :: IdDetails -> Name -> Type -> Id\nmkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo\n        -- Note [Free type variables]\n\nmkExportedVanillaId :: Name -> Type -> Id\nmkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo\n        -- Note [Free type variables]\n\n\n-- | Create a system local 'Id'. These are local 'Id's (see \"Var#globalvslocal\")\n-- that are created by the compiler out of thin air\nmkSysLocal :: FastString -> Unique -> Type -> Id\nmkSysLocal fs uniq ty = ASSERT( not (isCoVarType ty) )\n                        mkLocalId (mkSystemVarName uniq fs) ty\n\n-- | Like 'mkSysLocal', but checks to see if we have a covar type\nmkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id\nmkSysLocalOrCoVar fs uniq ty\n  = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty\n\nmkSysLocalM :: MonadUnique m => FastString -> Type -> m Id\nmkSysLocalM fs ty = getUniqueM >>= (\\uniq -> return (mkSysLocal fs uniq ty))\n\nmkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id\nmkSysLocalOrCoVarM fs ty\n  = getUniqueM >>= (\\uniq -> return (mkSysLocalOrCoVar fs uniq ty))\n\n-- | Create a user local 'Id'. These are local 'Id's (see \"Var#globalvslocal\") with a name and location that the user might recognize\nmkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id\nmkUserLocal occ uniq ty loc = ASSERT( not (isCoVarType ty) )\n                              mkLocalId (mkInternalName uniq occ loc) ty\n\n-- | Like 'mkUserLocal', but checks if we have a coercion type\nmkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id\nmkUserLocalOrCoVar occ uniq ty loc\n  = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty\n\n{-\nMake some local @Ids@ for a template @CoreExpr@.  These have bogus\n@Uniques@, but that's OK because the templates are supposed to be\ninstantiated before use.\n-}\n\n-- | Workers get local names. \"CoreTidy\" will externalise these if necessary\nmkWorkerId :: Unique -> Id -> Type -> Id\nmkWorkerId uniq unwrkr ty\n  = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty\n\n-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings\nmkTemplateLocal :: Int -> Type -> Id\nmkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit \"v\") (mkBuiltinUnique i) ty\n\n-- | Create a template local for a series of types\nmkTemplateLocals :: [Type] -> [Id]\nmkTemplateLocals = mkTemplateLocalsNum 1\n\n-- | Create a template local for a series of type, but start from a specified template local\nmkTemplateLocalsNum :: Int -> [Type] -> [Id]\nmkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys\n\n{- Note [Exported LocalIds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe use mkExportedLocalId for things like\n - Dictionary functions (DFunId)\n - Wrapper and matcher Ids for pattern synonyms\n - Default methods for classes\n - Pattern-synonym matcher and builder Ids\n - etc\n\nThey marked as \"exported\" in the sense that they should be kept alive\neven if apparently unused in other bindings, and not dropped as dead\ncode by the occurrence analyser.  (But \"exported\" here does not mean\n\"brought into lexical scope by an import declaration\". Indeed these\nthings are always internal Ids that the user never sees.)\n\nIt's very important that they are *LocalIds*, not GlobalIds, for lots\nof reasons:\n\n * We want to treat them as free variables for the purpose of\n   dependency analysis (e.g. CoreFVs.exprFreeVars).\n\n * Look them up in the current substitution when we come across\n   occurrences of them (in Subst.lookupIdSubst). Lacking this we\n   can get an out-of-date unfolding, which can in turn make the\n   simplifier go into an infinite loop (Trac #9857)\n\n * Ensure that for dfuns that the specialiser does not float dict uses\n   above their defns, which would prevent good simplifications happening.\n\n * The strictness analyser treats a occurrence of a GlobalId as\n   imported and assumes it contains strictness in its IdInfo, which\n   isn't true if the thing is bound in the same module as the\n   occurrence.\n\nIn CoreTidy we must make all these LocalIds into GlobalIds, so that in\nimporting modules (in --make mode) we treat them as properly global.\nThat is what is happening in, say tidy_insts in TidyPgm.\n\n************************************************************************\n*                                                                      *\n\\subsection{Special Ids}\n*                                                                      *\n************************************************************************\n-}\n\n-- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.\nrecordSelectorTyCon :: Id -> RecSelParent\nrecordSelectorTyCon id\n  = case Var.idDetails id of\n        RecSelId { sel_tycon = parent } -> parent\n        _ -> panic \"recordSelectorTyCon\"\n\n\nisRecordSelector        :: Id -> Bool\nisNaughtyRecordSelector :: Id -> Bool\nisPatSynRecordSelector  :: Id -> Bool\nisDataConRecordSelector  :: Id -> Bool\nisPrimOpId              :: Id -> Bool\nisFCallId               :: Id -> Bool\nisDataConWorkId         :: Id -> Bool\nisDataConWrapId         :: Id -> Bool\nisDFunId                :: Id -> Bool\n\nisClassOpId_maybe       :: Id -> Maybe Class\nisPrimOpId_maybe        :: Id -> Maybe PrimOp\nisFCallId_maybe         :: Id -> Maybe ForeignCall\nisDataConWorkId_maybe   :: Id -> Maybe DataCon\nisDataConWrapId_maybe   :: Id -> Maybe DataCon\n\nisRecordSelector id = case Var.idDetails id of\n                        RecSelId {}     -> True\n                        _               -> False\n\nisDataConRecordSelector id = case Var.idDetails id of\n                        RecSelId {sel_tycon = RecSelData _} -> True\n                        _               -> False\n\nisPatSynRecordSelector id = case Var.idDetails id of\n                        RecSelId {sel_tycon = RecSelPatSyn _} -> True\n                        _               -> False\n\nisNaughtyRecordSelector id = case Var.idDetails id of\n                        RecSelId { sel_naughty = n } -> n\n                        _                               -> False\n\nisClassOpId_maybe id = case Var.idDetails id of\n                        ClassOpId cls -> Just cls\n                        _other        -> Nothing\n\nisPrimOpId id = case Var.idDetails id of\n                        PrimOpId _ -> True\n                        _          -> False\n\nisDFunId id = case Var.idDetails id of\n                        DFunId {} -> True\n                        _         -> False\n\nisPrimOpId_maybe id = case Var.idDetails id of\n                        PrimOpId op -> Just op\n                        _           -> Nothing\n\nisFCallId id = case Var.idDetails id of\n                        FCallId _ -> True\n                        _         -> False\n\nisFCallId_maybe id = case Var.idDetails id of\n                        FCallId call -> Just call\n                        _            -> Nothing\n\nisDataConWorkId id = case Var.idDetails id of\n                        DataConWorkId _ -> True\n                        _               -> False\n\nisDataConWorkId_maybe id = case Var.idDetails id of\n                        DataConWorkId con -> Just con\n                        _                 -> Nothing\n\nisDataConWrapId id = case Var.idDetails id of\n                       DataConWrapId _ -> True\n                       _               -> False\n\nisDataConWrapId_maybe id = case Var.idDetails id of\n                        DataConWrapId con -> Just con\n                        _                 -> Nothing\n\nisDataConId_maybe :: Id -> Maybe DataCon\nisDataConId_maybe id = case Var.idDetails id of\n                         DataConWorkId con -> Just con\n                         DataConWrapId con -> Just con\n                         _                 -> Nothing\n\nisJoinId :: Var -> Bool\n-- It is convenient in SetLevels.lvlMFE to apply isJoinId\n-- to the free vars of an expression, so it's convenient\n-- if it returns False for type variables\nisJoinId id\n  | isId id = case Var.idDetails id of\n                JoinId {} -> True\n                _         -> False\n  | otherwise = False\n\nisJoinId_maybe :: Var -> Maybe JoinArity\nisJoinId_maybe id\n | isId id  = ASSERT2( isId id, ppr id )\n              case Var.idDetails id of\n                JoinId arity -> Just arity\n                _            -> Nothing\n | otherwise = Nothing\n\nidDataCon :: Id -> DataCon\n-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.\n--\n-- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker\nidDataCon id = isDataConId_maybe id `orElse` pprPanic \"idDataCon\" (ppr id)\n\nhasNoBinding :: Id -> Bool\n-- ^ Returns @True@ of an 'Id' which may not have a\n-- binding, even though it is defined in this module.\n\n-- Data constructor workers used to be things of this kind, but\n-- they aren't any more.  Instead, we inject a binding for\n-- them at the CorePrep stage.\n-- EXCEPT: unboxed tuples, which definitely have no binding\nhasNoBinding id = case Var.idDetails id of\n                        PrimOpId _       -> True        -- See Note [Primop wrappers]\n                        FCallId _        -> True\n                        DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc\n                        _                -> isCompulsoryUnfolding (idUnfolding id)\n                                            -- See Note [Levity-polymorphic Ids]\n\nisImplicitId :: Id -> Bool\n-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other\n-- declarations, so we don't need to put its signature in an interface\n-- file, even if it's mentioned in some other interface unfolding.\nisImplicitId id\n  = case Var.idDetails id of\n        FCallId {}       -> True\n        ClassOpId {}     -> True\n        PrimOpId {}      -> True\n        DataConWorkId {} -> True\n        DataConWrapId {} -> True\n                -- These are implied by their type or class decl;\n                -- remember that all type and class decls appear in the interface file.\n                -- The dfun id is not an implicit Id; it must *not* be omitted, because\n                -- it carries version info for the instance decl\n        _               -> False\n\nidIsFrom :: Module -> Id -> Bool\nidIsFrom mod id = nameIsLocalOrFrom mod (idName id)\n\n{- Note [Levity-polymorphic Ids]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSome levity-polymorphic Ids must be applied and and inlined, not left\nun-saturated.  Example:\n  unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b\n\nThis has a compulsory unfolding because we can't lambda-bind those\narguments.  But the compulsory unfolding may leave levity-polymorphic\nlambdas if it is not applied to enough arguments; e.g. (Trac #14561)\n  bad :: forall (a :: TYPE r). a -> a\n  bad = unsafeCoerce#\n\nThe desugar has special magic to detect such cases: DsExpr.badUseOfLevPolyPrimop.\nAnd we want that magic to apply to levity-polymorphic compulsory-inline things.\nThe easiest way to do this is for hasNoBinding to return True of all things\nthat have compulsory unfolding.  A very Ids with a compulsory unfolding also\nhave a binding, but it does not harm to say they don't here, and its a very\nsimple way to fix Trac #14561.\n\nNote [Primop wrappers]\n~~~~~~~~~~~~~~~~~~~~~~\nCurrently hasNoBinding claims that PrimOpIds don't have a curried\nfunction definition.  But actually they do, in GHC.PrimopWrappers,\nwhich is auto-generated from prelude/primops.txt.pp.  So actually, hasNoBinding\ncould return 'False' for PrimOpIds.\n\nBut we'd need to add something in CoreToStg to swizzle any unsaturated\napplications of GHC.Prim.plusInt# to GHC.PrimopWrappers.plusInt#.\n\nNota Bene: GHC.PrimopWrappers is needed *regardless*, because it's\nused by GHCi, which does not implement primops direct at all.\n-}\n\nisDeadBinder :: Id -> Bool\nisDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)\n                  | otherwise = False   -- TyVars count as not dead\n\n{-\n************************************************************************\n*                                                                      *\n              Evidence variables\n*                                                                      *\n************************************************************************\n-}\n\nisEvVar :: Var -> Bool\nisEvVar var = isEvVarType (varType var)\n\nisDictId :: Id -> Bool\nisDictId id = isDictTy (idType id)\n\n{-\n************************************************************************\n*                                                                      *\n              Join variables\n*                                                                      *\n************************************************************************\n-}\n\nidJoinArity :: JoinId -> JoinArity\nidJoinArity id = isJoinId_maybe id `orElse` pprPanic \"idJoinArity\" (ppr id)\n\nasJoinId :: Id -> JoinArity -> JoinId\nasJoinId id arity = WARN(not (isLocalId id),\n                         text \"global id being marked as join var:\" <+> ppr id)\n                    WARN(not (is_vanilla_or_join id),\n                         ppr id <+> pprIdDetails (idDetails id))\n                    id `setIdDetails` JoinId arity\n  where\n    is_vanilla_or_join id = case Var.idDetails id of\n                              VanillaId -> True\n                              JoinId {} -> True\n                              _         -> False\n\nzapJoinId :: Id -> Id\n-- May be a regular id already\nzapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId)\n                                 -- Core Lint may complain if still marked\n                                 -- as AlwaysTailCalled\n              | otherwise    = jid\n\nasJoinId_maybe :: Id -> Maybe JoinArity -> Id\nasJoinId_maybe id (Just arity) = asJoinId id arity\nasJoinId_maybe id Nothing      = zapJoinId id\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{IdInfo stuff}\n*                                                                      *\n************************************************************************\n-}\n\n        ---------------------------------\n        -- ARITY\nidArity :: Id -> Arity\nidArity id = arityInfo (idInfo id)\n\nsetIdArity :: Id -> Arity -> Id\nsetIdArity id arity = modifyIdInfo (`setArityInfo` arity) id\n\nidCallArity :: Id -> Arity\nidCallArity id = callArityInfo (idInfo id)\n\nsetIdCallArity :: Id -> Arity -> Id\nsetIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id\n\nidFunRepArity :: Id -> RepArity\nidFunRepArity x = countFunRepArgs (idArity x) (idType x)\n\n-- | Returns true if an application to n args would diverge\nisBottomingId :: Var -> Bool\nisBottomingId v\n  | isId v    = isBottomingSig (idStrictness v)\n  | otherwise = False\n\nidStrictness :: Id -> StrictSig\nidStrictness id = strictnessInfo (idInfo id)\n\nsetIdStrictness :: Id -> StrictSig -> Id\nsetIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id\n\nzapIdStrictness :: Id -> Id\nzapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id\n\n-- | This predicate says whether the 'Id' has a strict demand placed on it or\n-- has a type such that it can always be evaluated strictly (i.e an\n-- unlifted type, as of GHC 7.6).  We need to\n-- check separately whether the 'Id' has a so-called \\\"strict type\\\" because if\n-- the demand for the given @id@ hasn't been computed yet but @id@ has a strict\n-- type, we still want @isStrictId id@ to be @True@.\nisStrictId :: Id -> Bool\nisStrictId id\n  = ASSERT2( isId id, text \"isStrictId: not an id: \" <+> ppr id )\n         not (isJoinId id) && (\n           (isStrictType (idType id)) ||\n           -- Take the best of both strictnesses - old and new\n           (isStrictDmd (idDemandInfo id))\n         )\n\n        ---------------------------------\n        -- UNFOLDING\nidUnfolding :: Id -> Unfolding\n-- Do not expose the unfolding of a loop breaker!\nidUnfolding id\n  | isStrongLoopBreaker (occInfo info) = NoUnfolding\n  | otherwise                          = unfoldingInfo info\n  where\n    info = idInfo id\n\nrealIdUnfolding :: Id -> Unfolding\n-- Expose the unfolding if there is one, including for loop breakers\nrealIdUnfolding id = unfoldingInfo (idInfo id)\n\nsetIdUnfolding :: Id -> Unfolding -> Id\nsetIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id\n\nidDemandInfo       :: Id -> Demand\nidDemandInfo       id = demandInfo (idInfo id)\n\nsetIdDemandInfo :: Id -> Demand -> Id\nsetIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id\n\nsetCaseBndrEvald :: StrictnessMark -> Id -> Id\n-- Used for variables bound by a case expressions, both the case-binder\n-- itself, and any pattern-bound variables that are argument of a\n-- strict constructor.  It just marks the variable as already-evaluated,\n-- so that (for example) a subsequent 'seq' can be dropped\nsetCaseBndrEvald str id\n  | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding\n  | otherwise          = id\n\n        ---------------------------------\n        -- SPECIALISATION\n\n-- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs\n\nidSpecialisation :: Id -> RuleInfo\nidSpecialisation id = ruleInfo (idInfo id)\n\nidCoreRules :: Id -> [CoreRule]\nidCoreRules id = ruleInfoRules (idSpecialisation id)\n\nidHasRules :: Id -> Bool\nidHasRules id = not (isEmptyRuleInfo (idSpecialisation id))\n\nsetIdSpecialisation :: Id -> RuleInfo -> Id\nsetIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id\n\n        ---------------------------------\n        -- CAF INFO\nidCafInfo :: Id -> CafInfo\nidCafInfo id = cafInfo (idInfo id)\n\nsetIdCafInfo :: Id -> CafInfo -> Id\nsetIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id\n\n        ---------------------------------\n        -- Occurrence INFO\nidOccInfo :: Id -> OccInfo\nidOccInfo id = occInfo (idInfo id)\n\nsetIdOccInfo :: Id -> OccInfo -> Id\nsetIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id\n\nzapIdOccInfo :: Id -> Id\nzapIdOccInfo b = b `setIdOccInfo` noOccInfo\n\n{-\n        ---------------------------------\n        -- INLINING\nThe inline pragma tells us to be very keen to inline this Id, but it's still\nOK not to if optimisation is switched off.\n-}\n\nidInlinePragma :: Id -> InlinePragma\nidInlinePragma id = inlinePragInfo (idInfo id)\n\nsetInlinePragma :: Id -> InlinePragma -> Id\nsetInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id\n\nmodifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id\nmodifyInlinePragma id fn = modifyIdInfo (\\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id\n\nidInlineActivation :: Id -> Activation\nidInlineActivation id = inlinePragmaActivation (idInlinePragma id)\n\nsetInlineActivation :: Id -> Activation -> Id\nsetInlineActivation id act = modifyInlinePragma id (\\prag -> setInlinePragmaActivation prag act)\n\nidRuleMatchInfo :: Id -> RuleMatchInfo\nidRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)\n\nisConLikeId :: Id -> Bool\nisConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)\n\n{-\n        ---------------------------------\n        -- ONE-SHOT LAMBDAS\n-}\n\nidOneShotInfo :: Id -> OneShotInfo\nidOneShotInfo id = oneShotInfo (idInfo id)\n\n-- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account\n-- See Note [The state-transformer hack] in CoreArity\nidStateHackOneShotInfo :: Id -> OneShotInfo\nidStateHackOneShotInfo id\n    | isStateHackType (idType id) = stateHackOneShot\n    | otherwise                   = idOneShotInfo id\n\n-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once\n-- This one is the \"business end\", called externally.\n-- It works on type variables as well as Ids, returning True\n-- Its main purpose is to encapsulate the Horrible State Hack\n-- See Note [The state-transformer hack] in CoreArity\nisOneShotBndr :: Var -> Bool\nisOneShotBndr var\n  | isTyVar var                              = True\n  | OneShotLam <- idStateHackOneShotInfo var = True\n  | otherwise                                = False\n\n-- | Should we apply the state hack to values of this 'Type'?\nstateHackOneShot :: OneShotInfo\nstateHackOneShot = OneShotLam\n\ntypeOneShot :: Type -> OneShotInfo\ntypeOneShot ty\n   | isStateHackType ty = stateHackOneShot\n   | otherwise          = NoOneShotInfo\n\nisStateHackType :: Type -> Bool\nisStateHackType ty\n  | hasNoStateHack unsafeGlobalDynFlags\n  = False\n  | otherwise\n  = case tyConAppTyCon_maybe ty of\n        Just tycon -> tycon == statePrimTyCon\n        _          -> False\n        -- This is a gross hack.  It claims that\n        -- every function over realWorldStatePrimTy is a one-shot\n        -- function.  This is pretty true in practice, and makes a big\n        -- difference.  For example, consider\n        --      a `thenST` \\ r -> ...E...\n        -- The early full laziness pass, if it doesn't know that r is one-shot\n        -- will pull out E (let's say it doesn't mention r) to give\n        --      let lvl = E in a `thenST` \\ r -> ...lvl...\n        -- When `thenST` gets inlined, we end up with\n        --      let lvl = E in \\s -> case a s of (r, s') -> ...lvl...\n        -- and we don't re-inline E.\n        --\n        -- It would be better to spot that r was one-shot to start with, but\n        -- I don't want to rely on that.\n        --\n        -- Another good example is in fill_in in PrelPack.hs.  We should be able to\n        -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.\n\nisProbablyOneShotLambda :: Id -> Bool\nisProbablyOneShotLambda id = case idStateHackOneShotInfo id of\n                               OneShotLam    -> True\n                               NoOneShotInfo -> False\n\nsetOneShotLambda :: Id -> Id\nsetOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id\n\nclearOneShotLambda :: Id -> Id\nclearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id\n\nsetIdOneShotInfo :: Id -> OneShotInfo -> Id\nsetIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id\n\nupdOneShotInfo :: Id -> OneShotInfo -> Id\n-- Combine the info in the Id with new info\nupdOneShotInfo id one_shot\n  | do_upd    = setIdOneShotInfo id one_shot\n  | otherwise = id\n  where\n    do_upd = case (idOneShotInfo id, one_shot) of\n                (NoOneShotInfo, _) -> True\n                (OneShotLam,    _) -> False\n\n-- The OneShotLambda functions simply fiddle with the IdInfo flag\n-- But watch out: this may change the type of something else\n--      f = \\x -> e\n-- If we change the one-shot-ness of x, f's type changes\n\nzapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id\nzapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id\n\nzapLamIdInfo :: Id -> Id\nzapLamIdInfo = zapInfo zapLamInfo\n\nzapFragileIdInfo :: Id -> Id\nzapFragileIdInfo = zapInfo zapFragileInfo\n\nzapIdDemandInfo :: Id -> Id\nzapIdDemandInfo = zapInfo zapDemandInfo\n\nzapIdUsageInfo :: Id -> Id\nzapIdUsageInfo = zapInfo zapUsageInfo\n\nzapIdUsageEnvInfo :: Id -> Id\nzapIdUsageEnvInfo = zapInfo zapUsageEnvInfo\n\nzapIdUsedOnceInfo :: Id -> Id\nzapIdUsedOnceInfo = zapInfo zapUsedOnceInfo\n\nzapIdTailCallInfo :: Id -> Id\nzapIdTailCallInfo = zapInfo zapTailCallInfo\n\nzapStableUnfolding :: Id -> Id\nzapStableUnfolding id\n | isStableUnfolding (realIdUnfolding id) = setIdUnfolding id NoUnfolding\n | otherwise                              = id\n\n{-\nNote [transferPolyIdInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nThis transfer is used in three places:\n        FloatOut (long-distance let-floating)\n        SimplUtils.abstractFloats (short-distance let-floating)\n        StgLiftLams (selectively lambda-lift local functions to top-level)\n\nConsider the short-distance let-floating:\n\n   f = /\\a. let g = rhs in ...\n\nThen if we float thus\n\n   g' = /\\a. rhs\n   f = /\\a. ...[g' a/g]....\n\nwe *do not* want to lose g's\n  * strictness information\n  * arity\n  * inline pragma (though that is bit more debatable)\n  * occurrence info\n\nMostly this is just an optimisation, but it's *vital* to\ntransfer the occurrence info.  Consider\n\n   NonRec { f = /\\a. let Rec { g* = ..g.. } in ... }\n\nwhere the '*' means 'LoopBreaker'.  Then if we float we must get\n\n   Rec { g'* = /\\a. ...(g' a)... }\n   NonRec { f = /\\a. ...[g' a/g]....}\n\nwhere g' is also marked as LoopBreaker.  If not, terrible things\ncan happen if we re-simplify the binding (and the Simplifier does\nsometimes simplify a term twice); see Trac #4345.\n\nIt's not so simple to retain\n  * worker info\n  * rules\nso we simply discard those.  Sooner or later this may bite us.\n\nIf we abstract wrt one or more *value* binders, we must modify the\narity and strictness info before transferring it.  E.g.\n      f = \\x. e\n-->\n      g' = \\y. \\x. e\n      + substitute (g' y) for g\nNotice that g' has an arity one more than the original g\n-}\n\ntransferPolyIdInfo :: Id        -- Original Id\n                   -> [Var]     -- Abstract wrt these variables\n                   -> Id        -- New Id\n                   -> Id\ntransferPolyIdInfo old_id abstract_wrt new_id\n  = modifyIdInfo transfer new_id\n  where\n    arity_increase = count isId abstract_wrt    -- Arity increases by the\n                                                -- number of value binders\n\n    old_info        = idInfo old_id\n    old_arity       = arityInfo old_info\n    old_inline_prag = inlinePragInfo old_info\n    old_occ_info    = occInfo old_info\n    new_arity       = old_arity + arity_increase\n    new_occ_info    = zapOccTailCallInfo old_occ_info\n\n    old_strictness  = strictnessInfo old_info\n    new_strictness  = increaseStrictSigArity arity_increase old_strictness\n\n    transfer new_info = new_info `setArityInfo` new_arity\n                                 `setInlinePragInfo` old_inline_prag\n                                 `setOccInfo` new_occ_info\n                                 `setStrictnessInfo` new_strictness\n\nisNeverLevPolyId :: Id -> Bool\nisNeverLevPolyId = isNeverLevPolyIdInfo . idInfo\n", "num_lines": 988}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\\section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}\n\n(And a pretty good illustration of quite a few things wrong with\nHaskell. [WDP 94/11])\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule IdInfo (\n        -- * The IdDetails type\n        IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,\n        JoinArity, isJoinIdDetails_maybe,\n        RecSelParent(..),\n\n        -- * The IdInfo type\n        IdInfo,         -- Abstract\n        vanillaIdInfo, noCafIdInfo,\n\n        -- ** The OneShotInfo type\n        OneShotInfo(..),\n        oneShotInfo, noOneShotInfo, hasNoOneShotInfo,\n        setOneShotInfo,\n\n        -- ** Zapping various forms of Info\n        zapLamInfo, zapFragileInfo,\n        zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,\n        zapTailCallInfo, zapCallArityInfo, zapUnfolding,\n\n        -- ** The ArityInfo type\n        ArityInfo,\n        unknownArity,\n        arityInfo, setArityInfo, ppArityInfo,\n\n        callArityInfo, setCallArityInfo,\n\n        -- ** Demand and strictness Info\n        strictnessInfo, setStrictnessInfo,\n        demandInfo, setDemandInfo, pprStrictness,\n\n        -- ** Unfolding Info\n        unfoldingInfo, setUnfoldingInfo,\n\n        -- ** The InlinePragInfo type\n        InlinePragInfo,\n        inlinePragInfo, setInlinePragInfo,\n\n        -- ** The OccInfo type\n        OccInfo(..),\n        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,\n        occInfo, setOccInfo,\n\n        InsideLam, OneBranch,\n        insideLam, notInsideLam, oneBranch, notOneBranch,\n\n        TailCallInfo(..),\n        tailCallInfo, isAlwaysTailCalled,\n\n        -- ** The RuleInfo type\n        RuleInfo(..),\n        emptyRuleInfo,\n        isEmptyRuleInfo, ruleInfoFreeVars,\n        ruleInfoRules, setRuleInfoHead,\n        ruleInfo, setRuleInfo,\n\n        -- ** The CAFInfo type\n        CafInfo(..),\n        ppCafInfo, mayHaveCafRefs,\n        cafInfo, setCafInfo,\n\n        -- ** Tick-box Info\n        TickBoxOp(..), TickBoxId,\n\n        -- ** Levity info\n        LevityInfo, levityInfo, setNeverLevPoly, setLevityInfoWithType,\n        isNeverLevPolyIdInfo\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\n\nimport Class\nimport {-# SOURCE #-} PrimOp (PrimOp)\nimport Name\nimport VarSet\nimport BasicTypes\nimport DataCon\nimport TyCon\nimport PatSyn\nimport Type\nimport ForeignCall\nimport Outputable\nimport Module\nimport Demand\nimport Util\n\n-- infixl so you can say (id `set` a `set` b)\ninfixl  1 `setRuleInfo`,\n          `setArityInfo`,\n          `setInlinePragInfo`,\n          `setUnfoldingInfo`,\n          `setOneShotInfo`,\n          `setOccInfo`,\n          `setCafInfo`,\n          `setStrictnessInfo`,\n          `setDemandInfo`,\n          `setNeverLevPoly`,\n          `setLevityInfoWithType`\n\n{-\n************************************************************************\n*                                                                      *\n                     IdDetails\n*                                                                      *\n************************************************************************\n-}\n\n-- | Identifier Details\n--\n-- The 'IdDetails' of an 'Id' give stable, and necessary,\n-- information about the Id.\ndata IdDetails\n  = VanillaId\n\n  -- | The 'Id' for a record selector\n  | RecSelId\n    { sel_tycon   :: RecSelParent\n    , sel_naughty :: Bool       -- True <=> a \"naughty\" selector which can't actually exist, for example @x@ in:\n                                --    data T = forall a. MkT { x :: a }\n    }                           -- See Note [Naughty record selectors] in TcTyClsDecls\n\n  | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/\n  | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/\n\n                                -- [the only reasons we need to know is so that\n                                --  a) to support isImplicitId\n                                --  b) when desugaring a RecordCon we can get\n                                --     from the Id back to the data con]\n  | ClassOpId Class             -- ^ The 'Id' is a superclass selector,\n                                -- or class operation of a class\n\n  | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator\n  | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call.\n                                -- Type will be simple: no type families, newtypes, etc\n\n  | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)\n\n  | DFunId Bool                 -- ^ A dictionary function.\n       -- Bool = True <=> the class has only one method, so may be\n       --                  implemented with a newtype, so it might be bad\n       --                  to be strict on this dictionary\n\n  | CoVarId    -- ^ A coercion variable\n               -- This only covers /un-lifted/ coercions, of type\n               -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants\n  | JoinId JoinArity           -- ^ An 'Id' for a join point taking n arguments\n       -- Note [Join points] in CoreSyn\n\n-- | Recursive Selector Parent\ndata RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving Eq\n  -- Either `TyCon` or `PatSyn` depending\n  -- on the origin of the record selector.\n  -- For a data type family, this is the\n  -- /instance/ 'TyCon' not the family 'TyCon'\n\ninstance Outputable RecSelParent where\n  ppr p = case p of\n            RecSelData ty_con -> ppr ty_con\n            RecSelPatSyn ps   -> ppr ps\n\n-- | Just a synonym for 'CoVarId'. Written separately so it can be\n-- exported in the hs-boot file.\ncoVarDetails :: IdDetails\ncoVarDetails = CoVarId\n\n-- | Check if an 'IdDetails' says 'CoVarId'.\nisCoVarDetails :: IdDetails -> Bool\nisCoVarDetails CoVarId = True\nisCoVarDetails _       = False\n\nisJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity\nisJoinIdDetails_maybe (JoinId join_arity) = Just join_arity\nisJoinIdDetails_maybe _                   = Nothing\n\ninstance Outputable IdDetails where\n    ppr = pprIdDetails\n\npprIdDetails :: IdDetails -> SDoc\npprIdDetails VanillaId = empty\npprIdDetails other     = brackets (pp other)\n where\n   pp VanillaId               = panic \"pprIdDetails\"\n   pp (DataConWorkId _)       = text \"DataCon\"\n   pp (DataConWrapId _)       = text \"DataConWrapper\"\n   pp (ClassOpId {})          = text \"ClassOp\"\n   pp (PrimOpId _)            = text \"PrimOp\"\n   pp (FCallId _)             = text \"ForeignCall\"\n   pp (TickBoxOpId _)         = text \"TickBoxOp\"\n   pp (DFunId nt)             = text \"DFunId\" <> ppWhen nt (text \"(nt)\")\n   pp (RecSelId { sel_naughty = is_naughty })\n                              = brackets $ text \"RecSel\" <>\n                                           ppWhen is_naughty (text \"(naughty)\")\n   pp CoVarId                 = text \"CoVarId\"\n   pp (JoinId arity)          = text \"JoinId\" <> parens (int arity)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The main IdInfo type}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Identifier Information\n--\n-- An 'IdInfo' gives /optional/ information about an 'Id'.  If\n-- present it never lies, but it may not be present, in which case there\n-- is always a conservative assumption which can be made.\n--\n-- Two 'Id's may have different info even though they have the same\n-- 'Unique' (and are hence the same 'Id'); for example, one might lack\n-- the properties attached to the other.\n--\n-- Most of the 'IdInfo' gives information about the value, or definition, of\n-- the 'Id', independent of its usage. Exceptions to this\n-- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'.\n--\n-- Performance note: when we update 'IdInfo', we have to reallocate this\n-- entire record, so it is a good idea not to let this data structure get\n-- too big.\ndata IdInfo\n  = IdInfo {\n        arityInfo       :: !ArityInfo,          -- ^ 'Id' arity\n        ruleInfo        :: RuleInfo,            -- ^ Specialisations of the 'Id's function which exist\n                                                -- See Note [Specialisations and RULES in IdInfo]\n        unfoldingInfo   :: Unfolding,           -- ^ The 'Id's unfolding\n        cafInfo         :: CafInfo,             -- ^ 'Id' CAF info\n        oneShotInfo     :: OneShotInfo,         -- ^ Info about a lambda-bound variable, if the 'Id' is one\n        inlinePragInfo  :: InlinePragma,        -- ^ Any inline pragma atached to the 'Id'\n        occInfo         :: OccInfo,             -- ^ How the 'Id' occurs in the program\n\n        strictnessInfo  :: StrictSig,      --  ^ A strictness signature\n\n        demandInfo      :: Demand,       -- ^ ID demand information\n        callArityInfo   :: !ArityInfo,   -- ^ How this is called.\n                                         -- n <=> all calls have at least n arguments\n\n        levityInfo      :: LevityInfo    -- ^ when applied, will this Id ever have a levity-polymorphic type?\n    }\n\n-- Setters\n\nsetRuleInfo :: IdInfo -> RuleInfo -> IdInfo\nsetRuleInfo       info sp = sp `seq` info { ruleInfo = sp }\nsetInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo\nsetInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }\nsetOccInfo :: IdInfo -> OccInfo -> IdInfo\nsetOccInfo        info oc = oc `seq` info { occInfo = oc }\n        -- Try to avoid space leaks by seq'ing\n\nsetUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo\nsetUnfoldingInfo info uf\n  = -- We don't seq the unfolding, as we generate intermediate\n    -- unfoldings which are just thrown away, so evaluating them is a\n    -- waste of time.\n    -- seqUnfolding uf `seq`\n    info { unfoldingInfo = uf }\n\nsetArityInfo :: IdInfo -> ArityInfo -> IdInfo\nsetArityInfo      info ar  = info { arityInfo = ar  }\nsetCallArityInfo :: IdInfo -> ArityInfo -> IdInfo\nsetCallArityInfo info ar  = info { callArityInfo = ar  }\nsetCafInfo :: IdInfo -> CafInfo -> IdInfo\nsetCafInfo        info caf = info { cafInfo = caf }\n\nsetOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo\nsetOneShotInfo      info lb = {-lb `seq`-} info { oneShotInfo = lb }\n\nsetDemandInfo :: IdInfo -> Demand -> IdInfo\nsetDemandInfo info dd = dd `seq` info { demandInfo = dd }\n\nsetStrictnessInfo :: IdInfo -> StrictSig -> IdInfo\nsetStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }\n\n-- | Basic 'IdInfo' that carries no useful information whatsoever\nvanillaIdInfo :: IdInfo\nvanillaIdInfo\n  = IdInfo {\n            cafInfo             = vanillaCafInfo,\n            arityInfo           = unknownArity,\n            ruleInfo            = emptyRuleInfo,\n            unfoldingInfo       = noUnfolding,\n            oneShotInfo         = NoOneShotInfo,\n            inlinePragInfo      = defaultInlinePragma,\n            occInfo             = noOccInfo,\n            demandInfo          = topDmd,\n            strictnessInfo      = nopSig,\n            callArityInfo       = unknownArity,\n            levityInfo          = NoLevityInfo\n           }\n\n-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references\nnoCafIdInfo :: IdInfo\nnoCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs\n        -- Used for built-in type Ids in MkId.\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[arity-IdInfo]{Arity info about an @Id@}\n*                                                                      *\n************************************************************************\n\nFor locally-defined Ids, the code generator maintains its own notion\nof their arities; so it should not be asking...  (but other things\nbesides the code-generator need arity info!)\n-}\n\n-- | Arity Information\n--\n-- An 'ArityInfo' of @n@ tells us that partial application of this\n-- 'Id' to up to @n-1@ value arguments does essentially no work.\n--\n-- That is not necessarily the same as saying that it has @n@ leading\n-- lambdas, because coerces may get in the way.\n--\n-- The arity might increase later in the compilation process, if\n-- an extra lambda floats up to the binding site.\ntype ArityInfo = Arity\n\n-- | It is always safe to assume that an 'Id' has an arity of 0\nunknownArity :: Arity\nunknownArity = 0\n\nppArityInfo :: Int -> SDoc\nppArityInfo 0 = empty\nppArityInfo n = hsep [text \"Arity\", int n]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Inline-pragma information}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Inline Pragma Information\n--\n-- Tells when the inlining is active.\n-- When it is active the thing may be inlined, depending on how\n-- big it is.\n--\n-- If there was an @INLINE@ pragma, then as a separate matter, the\n-- RHS will have been made to look small with a Core inline 'Note'\n--\n-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves\n-- entirely as a way to inhibit inlining until we want it\ntype InlinePragInfo = InlinePragma\n\n{-\n************************************************************************\n*                                                                      *\n               Strictness\n*                                                                      *\n************************************************************************\n-}\n\npprStrictness :: StrictSig -> SDoc\npprStrictness sig = ppr sig\n\n{-\n************************************************************************\n*                                                                      *\n        RuleInfo\n*                                                                      *\n************************************************************************\n\nNote [Specialisations and RULES in IdInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGenerally speaking, a GlobalId has an *empty* RuleInfo.  All their\nRULES are contained in the globally-built rule-base.  In principle,\none could attach the to M.f the RULES for M.f that are defined in M.\nBut we don't do that for instance declarations and so we just treat\nthem all uniformly.\n\nThe EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is\njsut for convenience really.\n\nHowever, LocalIds may have non-empty RuleInfo.  We treat them\ndifferently because:\n  a) they might be nested, in which case a global table won't work\n  b) the RULE might mention free variables, which we use to keep things alive\n\nIn TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off\nand put in the global list.\n-}\n\n-- | Rule Information\n--\n-- Records the specializations of this 'Id' that we know about\n-- in the form of rewrite 'CoreRule's that target them\ndata RuleInfo\n  = RuleInfo\n        [CoreRule]\n        DVarSet         -- Locally-defined free vars of *both* LHS and RHS\n                        -- of rules.  I don't think it needs to include the\n                        -- ru_fn though.\n                        -- Note [Rule dependency info] in OccurAnal\n\n-- | Assume that no specilizations exist: always safe\nemptyRuleInfo :: RuleInfo\nemptyRuleInfo = RuleInfo [] emptyDVarSet\n\nisEmptyRuleInfo :: RuleInfo -> Bool\nisEmptyRuleInfo (RuleInfo rs _) = null rs\n\n-- | Retrieve the locally-defined free variables of both the left and\n-- right hand sides of the specialization rules\nruleInfoFreeVars :: RuleInfo -> DVarSet\nruleInfoFreeVars (RuleInfo _ fvs) = fvs\n\nruleInfoRules :: RuleInfo -> [CoreRule]\nruleInfoRules (RuleInfo rules _) = rules\n\n-- | Change the name of the function the rule is keyed on on all of the 'CoreRule's\nsetRuleInfoHead :: Name -> RuleInfo -> RuleInfo\nsetRuleInfoHead fn (RuleInfo rules fvs)\n  = RuleInfo (map (setRuleIdName fn) rules) fvs\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[CG-IdInfo]{Code generator-related information}\n*                                                                      *\n************************************************************************\n-}\n\n-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.hs).\n\n-- | Constant applicative form Information\n--\n-- Records whether an 'Id' makes Constant Applicative Form references\ndata CafInfo\n        = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:\n                                        --\n                                        -- 1. A function or static constructor\n                                        --    that refers to one or more CAFs, or\n                                        --\n                                        -- 2. A real live CAF\n\n        | NoCafRefs                     -- ^ A function or static constructor\n                                        -- that refers to no CAFs.\n        deriving (Eq, Ord)\n\n-- | Assumes that the 'Id' has CAF references: definitely safe\nvanillaCafInfo :: CafInfo\nvanillaCafInfo = MayHaveCafRefs\n\nmayHaveCafRefs :: CafInfo -> Bool\nmayHaveCafRefs  MayHaveCafRefs = True\nmayHaveCafRefs _               = False\n\ninstance Outputable CafInfo where\n   ppr = ppCafInfo\n\nppCafInfo :: CafInfo -> SDoc\nppCafInfo NoCafRefs = text \"NoCafRefs\"\nppCafInfo MayHaveCafRefs = empty\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Bulk operations on IdInfo}\n*                                                                      *\n************************************************************************\n-}\n\n-- | This is used to remove information on lambda binders that we have\n-- setup as part of a lambda group, assuming they will be applied all at once,\n-- but turn out to be part of an unsaturated lambda as in e.g:\n--\n-- > (\\x1. \\x2. e) arg1\nzapLamInfo :: IdInfo -> Maybe IdInfo\nzapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})\n  | is_safe_occ occ && is_safe_dmd demand\n  = Nothing\n  | otherwise\n  = Just (info {occInfo = safe_occ, demandInfo = topDmd})\n  where\n        -- The \"unsafe\" occ info is the ones that say I'm not in a lambda\n        -- because that might not be true for an unsaturated lambda\n    is_safe_occ occ | isAlwaysTailCalled occ     = False\n    is_safe_occ (OneOcc { occ_in_lam = in_lam }) = in_lam\n    is_safe_occ _other                           = True\n\n    safe_occ = case occ of\n                 OneOcc{} -> occ { occ_in_lam = True\n                                 , occ_tail   = NoTailCallInfo }\n                 IAmALoopBreaker{}\n                          -> occ { occ_tail   = NoTailCallInfo }\n                 _other   -> occ\n\n    is_safe_dmd dmd = not (isStrictDmd dmd)\n\n-- | Remove all demand info on the 'IdInfo'\nzapDemandInfo :: IdInfo -> Maybe IdInfo\nzapDemandInfo info = Just (info {demandInfo = topDmd})\n\n-- | Remove usage (but not strictness) info on the 'IdInfo'\nzapUsageInfo :: IdInfo -> Maybe IdInfo\nzapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})\n\n-- | Remove usage environment info from the strictness signature on the 'IdInfo'\nzapUsageEnvInfo :: IdInfo -> Maybe IdInfo\nzapUsageEnvInfo info\n    | hasDemandEnvSig (strictnessInfo info)\n    = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)})\n    | otherwise\n    = Nothing\n\nzapUsedOnceInfo :: IdInfo -> Maybe IdInfo\nzapUsedOnceInfo info\n    = Just $ info { strictnessInfo = zapUsedOnceSig    (strictnessInfo info)\n                  , demandInfo     = zapUsedOnceDemand (demandInfo     info) }\n\nzapFragileInfo :: IdInfo -> Maybe IdInfo\n-- ^ Zap info that depends on free variables\nzapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf })\n  = new_unf `seq`  -- The unfolding field is not (currently) strict, so we\n                   -- force it here to avoid a (zapFragileUnfolding unf) thunk\n                   -- which might leak space\n    Just (info `setRuleInfo` emptyRuleInfo\n               `setUnfoldingInfo` new_unf\n               `setOccInfo`       zapFragileOcc occ)\n  where\n    new_unf = zapFragileUnfolding unf\n\nzapFragileUnfolding :: Unfolding -> Unfolding\nzapFragileUnfolding unf\n | isFragileUnfolding unf = noUnfolding\n | otherwise              = unf\n\nzapUnfolding :: Unfolding -> Unfolding\n-- Squash all unfolding info, preserving only evaluated-ness\nzapUnfolding unf | isEvaldUnfolding unf = evaldUnfolding\n                 | otherwise            = noUnfolding\n\nzapTailCallInfo :: IdInfo -> Maybe IdInfo\nzapTailCallInfo info\n  = case occInfo info of\n      occ | isAlwaysTailCalled occ -> Just (info `setOccInfo` safe_occ)\n          | otherwise              -> Nothing\n        where\n          safe_occ = occ { occ_tail = NoTailCallInfo }\n\nzapCallArityInfo :: IdInfo -> IdInfo\nzapCallArityInfo info = setCallArityInfo info 0\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{TickBoxOp}\n*                                                                      *\n************************************************************************\n-}\n\ntype TickBoxId = Int\n\n-- | Tick box for Hpc-style coverage\ndata TickBoxOp\n   = TickBox Module {-# UNPACK #-} !TickBoxId\n\ninstance Outputable TickBoxOp where\n    ppr (TickBox mod n)         = text \"tick\" <+> ppr (mod,n)\n\n{-\n************************************************************************\n*                                                                      *\n   Levity\n*                                                                      *\n************************************************************************\n\nNote [Levity info]\n~~~~~~~~~~~~~~~~~~\n\nIds store whether or not they can be levity-polymorphic at any amount\nof saturation. This is helpful in optimizing the levity-polymorphism check\ndone in the desugarer, where we can usually learn that something is not\nlevity-polymorphic without actually figuring out its type. See\nisExprLevPoly in CoreUtils for where this info is used. Storing\nthis is required to prevent perf/compiler/T5631 from blowing up.\n\n-}\n\n-- See Note [Levity info]\ndata LevityInfo = NoLevityInfo  -- always safe\n                | NeverLevityPolymorphic\n  deriving Eq\n\ninstance Outputable LevityInfo where\n  ppr NoLevityInfo           = text \"NoLevityInfo\"\n  ppr NeverLevityPolymorphic = text \"NeverLevityPolymorphic\"\n\n-- | Marks an IdInfo describing an Id that is never levity polymorphic (even when\n-- applied). The Type is only there for checking that it's really never levity\n-- polymorphic\nsetNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo\nsetNeverLevPoly info ty\n  = ASSERT2( not (resultIsLevPoly ty), ppr ty )\n    info { levityInfo = NeverLevityPolymorphic }\n\nsetLevityInfoWithType :: IdInfo -> Type -> IdInfo\nsetLevityInfoWithType info ty\n  | not (resultIsLevPoly ty)\n  = info { levityInfo = NeverLevityPolymorphic }\n  | otherwise\n  = info\n\nisNeverLevPolyIdInfo :: IdInfo -> Bool\nisNeverLevPolyIdInfo info\n  | NeverLevityPolymorphic <- levityInfo info = True\n  | otherwise                                 = False\n", "num_lines": 630}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The GHC Team\n--\n-- Functions to evaluate whether or not a string is a valid identifier.\n-- There is considerable overlap between the logic here and the logic\n-- in Lexer.x, but sadly there seems to be no way to merge them.\n\nmodule Lexeme (\n          -- * Lexical characteristics of Haskell names\n\n          -- | Use these functions to figure what kind of name a 'FastString'\n          -- represents; these functions do /not/ check that the identifier\n          -- is valid.\n\n        isLexCon, isLexVar, isLexId, isLexSym,\n        isLexConId, isLexConSym, isLexVarId, isLexVarSym,\n        startsVarSym, startsVarId, startsConSym, startsConId,\n\n          -- * Validating identifiers\n\n          -- | These functions (working over plain old 'String's) check\n          -- to make sure that the identifier is valid.\n        okVarOcc, okConOcc, okTcOcc,\n        okVarIdOcc, okVarSymOcc, okConIdOcc, okConSymOcc\n\n        -- Some of the exports above are not used within GHC, but may\n        -- be of value to GHC API users.\n\n  ) where\n\nimport GhcPrelude\n\nimport FastString\n\nimport Data.Char\nimport qualified Data.Set as Set\n\nimport GHC.Lexeme\n\n{-\n\n************************************************************************\n*                                                                      *\n    Lexical categories\n*                                                                      *\n************************************************************************\n\nThese functions test strings to see if they fit the lexical categories\ndefined in the Haskell report.\n\nNote [Classification of generated names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nSome names generated for internal use can show up in debugging output,\ne.g.  when using -ddump-simpl. These generated names start with a $\nbut should still be pretty-printed using prefix notation. We make sure\nthis is the case in isLexVarSym by only classifying a name as a symbol\nif all its characters are symbols, not just its first one.\n-}\n\nisLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool\nisLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool\n\nisLexCon cs = isLexConId  cs || isLexConSym cs\nisLexVar cs = isLexVarId  cs || isLexVarSym cs\n\nisLexId  cs = isLexConId  cs || isLexVarId  cs\nisLexSym cs = isLexConSym cs || isLexVarSym cs\n\n-------------\nisLexConId cs                           -- Prefix type or data constructors\n  | nullFS cs          = False          --      e.g. \"Foo\", \"[]\", \"(,)\"\n  | cs == (fsLit \"[]\") = True\n  | otherwise          = startsConId (headFS cs)\n\nisLexVarId cs                           -- Ordinary prefix identifiers\n  | nullFS cs         = False           --      e.g. \"x\", \"_x\"\n  | otherwise         = startsVarId (headFS cs)\n\nisLexConSym cs                          -- Infix type or data constructors\n  | nullFS cs          = False          --      e.g. \":-:\", \":\", \"->\"\n  | cs == (fsLit \"->\") = True\n  | otherwise          = startsConSym (headFS cs)\n\nisLexVarSym fs                          -- Infix identifiers e.g. \"+\"\n  | fs == (fsLit \"~R#\") = True\n  | otherwise\n  = case (if nullFS fs then [] else unpackFS fs) of\n      [] -> False\n      (c:cs) -> startsVarSym c && all isVarSymChar cs\n        -- See Note [Classification of generated names]\n\n{-\n\n************************************************************************\n*                                                                      *\n    Detecting valid names for Template Haskell\n*                                                                      *\n************************************************************************\n\n-}\n\n----------------------\n-- External interface\n----------------------\n\n-- | Is this an acceptable variable name?\nokVarOcc :: String -> Bool\nokVarOcc str@(c:_)\n  | startsVarId c\n  = okVarIdOcc str\n  | startsVarSym c\n  = okVarSymOcc str\nokVarOcc _ = False\n\n-- | Is this an acceptable constructor name?\nokConOcc :: String -> Bool\nokConOcc str@(c:_)\n  | startsConId c\n  = okConIdOcc str\n  | startsConSym c\n  = okConSymOcc str\n  | str == \"[]\"\n  = True\nokConOcc _ = False\n\n-- | Is this an acceptable type name?\nokTcOcc :: String -> Bool\nokTcOcc \"[]\" = True\nokTcOcc \"->\" = True\nokTcOcc \"~\"  = True\nokTcOcc str@(c:_)\n  | startsConId c\n  = okConIdOcc str\n  | startsConSym c\n  = okConSymOcc str\n  | startsVarSym c\n  = okVarSymOcc str\nokTcOcc _ = False\n\n-- | Is this an acceptable alphanumeric variable name, assuming it starts\n-- with an acceptable letter?\nokVarIdOcc :: String -> Bool\nokVarIdOcc str = okIdOcc str &&\n                 -- admit \"_\" as a valid identifier.  Required to support typed\n                 -- holes in Template Haskell.  See #10267\n                 (str == \"_\" || not (str `Set.member` reservedIds))\n\n-- | Is this an acceptable symbolic variable name, assuming it starts\n-- with an acceptable character?\nokVarSymOcc :: String -> Bool\nokVarSymOcc str = all okSymChar str &&\n                  not (str `Set.member` reservedOps) &&\n                  not (isDashes str)\n\n-- | Is this an acceptable alphanumeric constructor name, assuming it\n-- starts with an acceptable letter?\nokConIdOcc :: String -> Bool\nokConIdOcc str = okIdOcc str ||\n                 is_tuple_name1 True  str ||\n                   -- Is it a boxed tuple...\n                 is_tuple_name1 False str ||\n                   -- ...or an unboxed tuple (Trac #12407)...\n                 is_sum_name1 str\n                   -- ...or an unboxed sum (Trac #12514)?\n  where\n    -- check for tuple name, starting at the beginning\n    is_tuple_name1 True  ('(' : rest)       = is_tuple_name2 True  rest\n    is_tuple_name1 False ('(' : '#' : rest) = is_tuple_name2 False rest\n    is_tuple_name1 _     _                  = False\n\n    -- check for tuple tail\n    is_tuple_name2 True  \")\"          = True\n    is_tuple_name2 False \"#)\"         = True\n    is_tuple_name2 boxed (',' : rest) = is_tuple_name2 boxed rest\n    is_tuple_name2 boxed (ws  : rest)\n      | isSpace ws                    = is_tuple_name2 boxed rest\n    is_tuple_name2 _     _            = False\n\n    -- check for sum name, starting at the beginning\n    is_sum_name1 ('(' : '#' : rest) = is_sum_name2 False rest\n    is_sum_name1 _                  = False\n\n    -- check for sum tail, only allowing at most one underscore\n    is_sum_name2 _          \"#)\"         = True\n    is_sum_name2 underscore ('|' : rest) = is_sum_name2 underscore rest\n    is_sum_name2 False      ('_' : rest) = is_sum_name2 True rest\n    is_sum_name2 underscore (ws  : rest)\n      | isSpace ws                       = is_sum_name2 underscore rest\n    is_sum_name2 _          _            = False\n\n-- | Is this an acceptable symbolic constructor name, assuming it\n-- starts with an acceptable character?\nokConSymOcc :: String -> Bool\nokConSymOcc \":\" = True\nokConSymOcc str = all okSymChar str &&\n                  not (str `Set.member` reservedOps)\n\n----------------------\n-- Internal functions\n----------------------\n\n-- | Is this string an acceptable id, possibly with a suffix of hashes,\n-- but not worrying about case or clashing with reserved words?\nokIdOcc :: String -> Bool\nokIdOcc str\n  = let hashes = dropWhile okIdChar str in\n    all (== '#') hashes   -- -XMagicHash allows a suffix of hashes\n                          -- of course, `all` says \"True\" to an empty list\n\n-- | Is this character acceptable in an identifier (after the first letter)?\n-- See alexGetByte in Lexer.x\nokIdChar :: Char -> Bool\nokIdChar c = case generalCategory c of\n  UppercaseLetter -> True\n  LowercaseLetter -> True\n  TitlecaseLetter -> True\n  ModifierLetter  -> True -- See #10196\n  OtherLetter     -> True -- See #1103\n  NonSpacingMark  -> True -- See #7650\n  DecimalNumber   -> True\n  OtherNumber     -> True -- See #4373\n  _               -> c == '\\'' || c == '_'\n\n-- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.\nreservedIds :: Set.Set String\nreservedIds = Set.fromList [ \"case\", \"class\", \"data\", \"default\", \"deriving\"\n                           , \"do\", \"else\", \"foreign\", \"if\", \"import\", \"in\"\n                           , \"infix\", \"infixl\", \"infixr\", \"instance\", \"let\"\n                           , \"module\", \"newtype\", \"of\", \"then\", \"type\", \"where\"\n                           , \"_\" ]\n\n-- | All reserved operators. Taken from section 2.4 of the 2010 Report.\nreservedOps :: Set.Set String\nreservedOps = Set.fromList [ \"..\", \":\", \"::\", \"=\", \"\\\\\", \"|\", \"<-\", \"->\"\n                           , \"@\", \"~\", \"=>\" ]\n\n-- | Does this string contain only dashes and has at least 2 of them?\nisDashes :: String -> Bool\nisDashes ('-' : '-' : rest) = all (== '-') rest\nisDashes _                  = False\n", "num_lines": 241}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1998\n\n\\section[Literal]{@Literal@: literals}\n-}\n\n{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}\n\nmodule Literal\n        (\n        -- * Main data type\n          Literal(..)           -- Exported to ParseIface\n        , LitNumType(..)\n\n        -- ** Creating Literals\n        , mkLitInt, mkLitIntWrap, mkLitIntWrapC\n        , mkLitWord, mkLitWordWrap, mkLitWordWrapC\n        , mkLitInt64, mkLitInt64Wrap\n        , mkLitWord64, mkLitWord64Wrap\n        , mkLitFloat, mkLitDouble\n        , mkLitChar, mkLitString\n        , mkLitInteger, mkLitNatural\n        , mkLitNumber, mkLitNumberWrap\n\n        -- ** Operations on Literals\n        , literalType\n        , absentLiteralOf\n        , pprLiteral\n        , litNumIsSigned\n        , litNumCheckRange\n\n        -- ** Predicates on Literals and their contents\n        , litIsDupable, litIsTrivial, litIsLifted\n        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange\n        , isZeroLit\n        , litFitsInChar\n        , litValue, isLitValue, isLitValue_maybe, mapLitValue\n\n        -- ** Coercions\n        , word2IntLit, int2WordLit\n        , narrowLit\n        , narrow8IntLit, narrow16IntLit, narrow32IntLit\n        , narrow8WordLit, narrow16WordLit, narrow32WordLit\n        , char2IntLit, int2CharLit\n        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit\n        , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit\n        ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TysPrim\nimport PrelNames\nimport Type\nimport TyCon\nimport Outputable\nimport FastString\nimport BasicTypes\nimport Binary\nimport Constants\nimport DynFlags\nimport Platform\nimport UniqFM\nimport Util\n\nimport Data.ByteString (ByteString)\nimport Data.Int\nimport Data.Word\nimport Data.Char\nimport Data.Maybe ( isJust )\nimport Data.Data ( Data )\nimport Data.Proxy\nimport Numeric ( fromRat )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Literals}\n*                                                                      *\n************************************************************************\n-}\n\n-- | So-called 'Literal's are one of:\n--\n-- * An unboxed numeric literal or floating-point literal which is presumed\n--   to be surrounded by appropriate constructors (@Int#@, etc.), so that\n--   the overall thing makes sense.\n--\n--   We maintain the invariant that the 'Integer' in the 'LitNumber'\n--   constructor is actually in the (possibly target-dependent) range.\n--   The mkLit{Int,Word}*Wrap smart constructors ensure this by applying\n--   the target machine's wrapping semantics. Use these in situations\n--   where you know the wrapping semantics are correct.\n--\n-- * The literal derived from the label mentioned in a \\\"foreign label\\\"\n--   declaration ('LitLabel')\n--\n-- * A 'LitRubbish' to be used in place of values of 'UnliftedRep'\n--   (i.e. 'MutVar#') when the the value is never used.\n--\n-- * A character\n-- * A string\n-- * The NULL pointer\n--\ndata Literal\n  = LitChar    Char             -- ^ @Char#@ - at least 31 bits. Create with\n                                -- 'mkLitChar'\n\n  | LitNumber !LitNumType !Integer Type\n                                -- ^ Any numeric literal that can be\n                                -- internally represented with an Integer\n\n  | LitString  ByteString       -- ^ A string-literal: stored and emitted\n                                -- UTF-8 encoded, we'll arrange to decode it\n                                -- at runtime.  Also emitted with a @\\'\\\\0\\'@\n                                -- terminator. Create with 'mkLitString'\n\n  | LitNullAddr                 -- ^ The @NULL@ pointer, the only pointer value\n                                -- that can be represented as a Literal. Create\n                                -- with 'nullAddrLit'\n\n  | LitRubbish                  -- ^ A nonsense value, used when an unlifted\n                                -- binding is absent and has type\n                                -- @forall (a :: 'TYPE' 'UnliftedRep'). a@.\n                                -- May be lowered by code-gen to any possible\n                                -- value. Also see Note [Rubbish literals]\n\n  | LitFloat   Rational         -- ^ @Float#@. Create with 'mkLitFloat'\n  | LitDouble  Rational         -- ^ @Double#@. Create with 'mkLitDouble'\n\n  | LitLabel   FastString (Maybe Int) FunctionOrData\n                                -- ^ A label literal. Parameters:\n                                --\n                                -- 1) The name of the symbol mentioned in the\n                                --    declaration\n                                --\n                                -- 2) The size (in bytes) of the arguments\n                                --    the label expects. Only applicable with\n                                --    @stdcall@ labels. @Just x@ => @\\<x\\>@ will\n                                --    be appended to label name when emitting\n                                --    assembly.\n                                --\n                                -- 3) Flag indicating whether the symbol\n                                --    references a function or a data\n  deriving Data\n\n-- | Numeric literal type\ndata LitNumType\n  = LitNumInteger -- ^ @Integer@ (see Note [Integer literals])\n  | LitNumNatural -- ^ @Natural@ (see Note [Natural literals])\n  | LitNumInt     -- ^ @Int#@ - according to target machine\n  | LitNumInt64   -- ^ @Int64#@ - exactly 64 bits\n  | LitNumWord    -- ^ @Word#@ - according to target machine\n  | LitNumWord64  -- ^ @Word64#@ - exactly 64 bits\n  deriving (Data,Enum,Eq,Ord)\n\n-- | Indicate if a numeric literal type supports negative numbers\nlitNumIsSigned :: LitNumType -> Bool\nlitNumIsSigned nt = case nt of\n  LitNumInteger -> True\n  LitNumNatural -> False\n  LitNumInt     -> True\n  LitNumInt64   -> True\n  LitNumWord    -> False\n  LitNumWord64  -> False\n\n{-\nNote [Integer literals]\n~~~~~~~~~~~~~~~~~~~~~~~\nAn Integer literal is represented using, well, an Integer, to make it\neasier to write RULEs for them. They also contain the Integer type, so\nthat e.g. literalType can return the right Type for them.\n\nThey only get converted into real Core,\n    mkInteger [c1, c2, .., cn]\nduring the CorePrep phase, although TidyPgm looks ahead at what the\ncore will be, so that it can see whether it involves CAFs.\n\nWhen we initally build an Integer literal, notably when\ndeserialising it from an interface file (see the Binary instance\nbelow), we don't have convenient access to the mkInteger Id.  So we\njust use an error thunk, and fill in the real Id when we do tcIfaceLit\nin TcIface.\n\nNote [Natural literals]\n~~~~~~~~~~~~~~~~~~~~~~~\nSimilar to Integer literals.\n\n-}\n\ninstance Binary LitNumType where\n   put_ bh numTyp = putByte bh (fromIntegral (fromEnum numTyp))\n   get bh = do\n      h <- getByte bh\n      return (toEnum (fromIntegral h))\n\ninstance Binary Literal where\n    put_ bh (LitChar aa)     = do putByte bh 0; put_ bh aa\n    put_ bh (LitString ab)   = do putByte bh 1; put_ bh ab\n    put_ bh (LitNullAddr)    = do putByte bh 2\n    put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah\n    put_ bh (LitDouble ai)   = do putByte bh 4; put_ bh ai\n    put_ bh (LitLabel aj mb fod)\n        = do putByte bh 5\n             put_ bh aj\n             put_ bh mb\n             put_ bh fod\n    put_ bh (LitNumber nt i _)\n        = do putByte bh 6\n             put_ bh nt\n             put_ bh i\n    put_ bh (LitRubbish)     = do putByte bh 7\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do\n                    aa <- get bh\n                    return (LitChar aa)\n              1 -> do\n                    ab <- get bh\n                    return (LitString ab)\n              2 -> do\n                    return (LitNullAddr)\n              3 -> do\n                    ah <- get bh\n                    return (LitFloat ah)\n              4 -> do\n                    ai <- get bh\n                    return (LitDouble ai)\n              5 -> do\n                    aj <- get bh\n                    mb <- get bh\n                    fod <- get bh\n                    return (LitLabel aj mb fod)\n              6 -> do\n                    nt <- get bh\n                    i  <- get bh\n                    let t = case nt of\n                            LitNumInt     -> intPrimTy\n                            LitNumInt64   -> int64PrimTy\n                            LitNumWord    -> wordPrimTy\n                            LitNumWord64  -> word64PrimTy\n                            -- See Note [Integer literals]\n                            LitNumInteger ->\n                              panic \"Evaluated the place holder for mkInteger\"\n                            -- and Note [Natural literals]\n                            LitNumNatural ->\n                              panic \"Evaluated the place holder for mkNatural\"\n                    return (LitNumber nt i t)\n              _ -> do\n                    return (LitRubbish)\n\ninstance Outputable Literal where\n    ppr lit = pprLiteral (\\d -> d) lit\n\ninstance Eq Literal where\n    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }\n    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }\n\n-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in\n-- 'TrieMap.CoreMap'.\ninstance Ord Literal where\n    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }\n    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }\n    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }\n    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }\n    compare a b = cmpLit a b\n\n{-\n        Construction\n        ~~~~~~~~~~~~\n-}\n\n{- Note [Word/Int underflow/overflow]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAccording to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and\nunsigned integral types): \"All arithmetic is performed modulo 2^n, where n is\nthe number of bits in the type.\"\n\nGHC stores Word# and Int# constant values as Integer. Core optimizations such\nas constant folding must ensure that the Integer value remains in the valid\ntarget Word/Int range (see #13172). The following functions are used to\nensure this.\n\nNote that we *don't* warn the user about overflow. It's not done at runtime\neither, and compilation of completely harmless things like\n   ((124076834 :: Word32) + (2147483647 :: Word32))\ndoesn't yield a warning. Instead we simply squash the value into the *target*\nInt/Word range.\n-}\n\n-- | Wrap a literal number according to its type\nwrapLitNumber :: DynFlags -> Literal -> Literal\nwrapLitNumber dflags v@(LitNumber nt i t) = case nt of\n  LitNumInt -> case platformWordSize (targetPlatform dflags) of\n    4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t\n    8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t\n    w -> panic (\"wrapLitNumber: Unknown platformWordSize: \" ++ show w)\n  LitNumWord -> case platformWordSize (targetPlatform dflags) of\n    4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t\n    8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t\n    w -> panic (\"wrapLitNumber: Unknown platformWordSize: \" ++ show w)\n  LitNumInt64   -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t\n  LitNumWord64  -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t\n  LitNumInteger -> v\n  LitNumNatural -> v\nwrapLitNumber _ x = x\n\n-- | Create a numeric 'Literal' of the given type\nmkLitNumberWrap :: DynFlags -> LitNumType -> Integer -> Type -> Literal\nmkLitNumberWrap dflags nt i t = wrapLitNumber dflags (LitNumber nt i t)\n\n-- | Check that a given number is in the range of a numeric literal\nlitNumCheckRange :: DynFlags -> LitNumType -> Integer -> Bool\nlitNumCheckRange dflags nt i = case nt of\n     LitNumInt     -> inIntRange dflags i\n     LitNumWord    -> inWordRange dflags i\n     LitNumInt64   -> inInt64Range i\n     LitNumWord64  -> inWord64Range i\n     LitNumNatural -> i >= 0\n     LitNumInteger -> True\n\n-- | Create a numeric 'Literal' of the given type\nmkLitNumber :: DynFlags -> LitNumType -> Integer -> Type -> Literal\nmkLitNumber dflags nt i t =\n  ASSERT2(litNumCheckRange dflags nt i, integer i)\n  (LitNumber nt i t)\n\n-- | Creates a 'Literal' of type @Int#@\nmkLitInt :: DynFlags -> Integer -> Literal\nmkLitInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )\n                       (mkLitIntUnchecked x)\n\n-- | Creates a 'Literal' of type @Int#@.\n--   If the argument is out of the (target-dependent) range, it is wrapped.\n--   See Note [Word/Int underflow/overflow]\nmkLitIntWrap :: DynFlags -> Integer -> Literal\nmkLitIntWrap dflags i = wrapLitNumber dflags $ mkLitIntUnchecked i\n\n-- | Creates a 'Literal' of type @Int#@ without checking its range.\nmkLitIntUnchecked :: Integer -> Literal\nmkLitIntUnchecked i = LitNumber LitNumInt i intPrimTy\n\n-- | Creates a 'Literal' of type @Int#@, as well as a 'Bool'ean flag indicating\n--   overflow. That is, if the argument is out of the (target-dependent) range\n--   the argument is wrapped and the overflow flag will be set.\n--   See Note [Word/Int underflow/overflow]\nmkLitIntWrapC :: DynFlags -> Integer -> (Literal, Bool)\nmkLitIntWrapC dflags i = (n, i /= i')\n  where\n    n@(LitNumber _ i' _) = mkLitIntWrap dflags i\n\n-- | Creates a 'Literal' of type @Word#@\nmkLitWord :: DynFlags -> Integer -> Literal\nmkLitWord dflags x   = ASSERT2( inWordRange dflags x, integer x )\n                        (mkLitWordUnchecked x)\n\n-- | Creates a 'Literal' of type @Word#@.\n--   If the argument is out of the (target-dependent) range, it is wrapped.\n--   See Note [Word/Int underflow/overflow]\nmkLitWordWrap :: DynFlags -> Integer -> Literal\nmkLitWordWrap dflags i = wrapLitNumber dflags $ mkLitWordUnchecked i\n\n-- | Creates a 'Literal' of type @Word#@ without checking its range.\nmkLitWordUnchecked :: Integer -> Literal\nmkLitWordUnchecked i = LitNumber LitNumWord i wordPrimTy\n\n-- | Creates a 'Literal' of type @Word#@, as well as a 'Bool'ean flag indicating\n--   carry. That is, if the argument is out of the (target-dependent) range\n--   the argument is wrapped and the carry flag will be set.\n--   See Note [Word/Int underflow/overflow]\nmkLitWordWrapC :: DynFlags -> Integer -> (Literal, Bool)\nmkLitWordWrapC dflags i = (n, i /= i')\n  where\n    n@(LitNumber _ i' _) = mkLitWordWrap dflags i\n\n-- | Creates a 'Literal' of type @Int64#@\nmkLitInt64 :: Integer -> Literal\nmkLitInt64  x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)\n\n-- | Creates a 'Literal' of type @Int64#@.\n--   If the argument is out of the range, it is wrapped.\nmkLitInt64Wrap :: DynFlags -> Integer -> Literal\nmkLitInt64Wrap dflags i = wrapLitNumber dflags $ mkLitInt64Unchecked i\n\n-- | Creates a 'Literal' of type @Int64#@ without checking its range.\nmkLitInt64Unchecked :: Integer -> Literal\nmkLitInt64Unchecked i = LitNumber LitNumInt64 i int64PrimTy\n\n-- | Creates a 'Literal' of type @Word64#@\nmkLitWord64 :: Integer -> Literal\nmkLitWord64 x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)\n\n-- | Creates a 'Literal' of type @Word64#@.\n--   If the argument is out of the range, it is wrapped.\nmkLitWord64Wrap :: DynFlags -> Integer -> Literal\nmkLitWord64Wrap dflags i = wrapLitNumber dflags $ mkLitWord64Unchecked i\n\n-- | Creates a 'Literal' of type @Word64#@ without checking its range.\nmkLitWord64Unchecked :: Integer -> Literal\nmkLitWord64Unchecked i = LitNumber LitNumWord64 i word64PrimTy\n\n-- | Creates a 'Literal' of type @Float#@\nmkLitFloat :: Rational -> Literal\nmkLitFloat = LitFloat\n\n-- | Creates a 'Literal' of type @Double#@\nmkLitDouble :: Rational -> Literal\nmkLitDouble = LitDouble\n\n-- | Creates a 'Literal' of type @Char#@\nmkLitChar :: Char -> Literal\nmkLitChar = LitChar\n\n-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to\n-- e.g. some of the \\\"error\\\" functions in GHC.Err such as @GHC.Err.runtimeError@\nmkLitString :: String -> Literal\n-- stored UTF-8 encoded\nmkLitString s = LitString (bytesFS $ mkFastString s)\n\nmkLitInteger :: Integer -> Type -> Literal\nmkLitInteger x ty = LitNumber LitNumInteger x ty\n\nmkLitNatural :: Integer -> Type -> Literal\nmkLitNatural x ty = ASSERT2( inNaturalRange x,  integer x )\n                    (LitNumber LitNumNatural x ty)\n\ninIntRange, inWordRange :: DynFlags -> Integer -> Bool\ninIntRange  dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags\ninWordRange dflags x = x >= 0                     && x <= tARGET_MAX_WORD dflags\n\ninNaturalRange :: Integer -> Bool\ninNaturalRange x = x >= 0\n\ninInt64Range, inWord64Range :: Integer -> Bool\ninInt64Range x  = x >= toInteger (minBound :: Int64) &&\n                  x <= toInteger (maxBound :: Int64)\ninWord64Range x = x >= toInteger (minBound :: Word64) &&\n                  x <= toInteger (maxBound :: Word64)\n\ninCharRange :: Char -> Bool\ninCharRange c =  c >= '\\0' && c <= chr tARGET_MAX_CHAR\n\n-- | Tests whether the literal represents a zero of whatever type it is\nisZeroLit :: Literal -> Bool\nisZeroLit (LitNumber _ 0 _) = True\nisZeroLit (LitFloat  0)     = True\nisZeroLit (LitDouble 0)     = True\nisZeroLit _                 = False\n\n-- | Returns the 'Integer' contained in the 'Literal', for when that makes\n-- sense, i.e. for 'Char', 'Int', 'Word', 'LitInteger' and 'LitNatural'.\nlitValue  :: Literal -> Integer\nlitValue l = case isLitValue_maybe l of\n   Just x  -> x\n   Nothing -> pprPanic \"litValue\" (ppr l)\n\n-- | Returns the 'Integer' contained in the 'Literal', for when that makes\n-- sense, i.e. for 'Char' and numbers.\nisLitValue_maybe  :: Literal -> Maybe Integer\nisLitValue_maybe (LitChar   c)     = Just $ toInteger $ ord c\nisLitValue_maybe (LitNumber _ i _) = Just i\nisLitValue_maybe _                 = Nothing\n\n-- | Apply a function to the 'Integer' contained in the 'Literal', for when that\n-- makes sense, e.g. for 'Char' and numbers.\n-- For fixed-size integral literals, the result will be wrapped in accordance\n-- with the semantics of the target type.\n-- See Note [Word/Int underflow/overflow]\nmapLitValue  :: DynFlags -> (Integer -> Integer) -> Literal -> Literal\nmapLitValue _      f (LitChar   c)      = mkLitChar (fchar c)\n   where fchar = chr . fromInteger . f . toInteger . ord\nmapLitValue dflags f (LitNumber nt i t) = wrapLitNumber dflags\n                                                        (LitNumber nt (f i) t)\nmapLitValue _      _ l                  = pprPanic \"mapLitValue\" (ppr l)\n\n-- | Indicate if the `Literal` contains an 'Integer' value, e.g. 'Char',\n-- 'Int', 'Word', 'LitInteger' and 'LitNatural'.\nisLitValue  :: Literal -> Bool\nisLitValue = isJust . isLitValue_maybe\n\n{-\n        Coercions\n        ~~~~~~~~~\n-}\n\nnarrow8IntLit, narrow16IntLit, narrow32IntLit,\n  narrow8WordLit, narrow16WordLit, narrow32WordLit,\n  char2IntLit, int2CharLit,\n  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,\n  float2DoubleLit, double2FloatLit\n  :: Literal -> Literal\n\nword2IntLit, int2WordLit :: DynFlags -> Literal -> Literal\nword2IntLit dflags (LitNumber LitNumWord w _)\n  -- Map Word range [max_int+1, max_word]\n  -- to Int range   [min_int  , -1]\n  -- Range [0,max_int] has the same representation with both Int and Word\n  | w > tARGET_MAX_INT dflags = mkLitInt dflags (w - tARGET_MAX_WORD dflags - 1)\n  | otherwise                 = mkLitInt dflags w\nword2IntLit _ l = pprPanic \"word2IntLit\" (ppr l)\n\nint2WordLit dflags (LitNumber LitNumInt i _)\n  -- Map Int range [min_int  , -1]\n  -- to Word range [max_int+1, max_word]\n  -- Range [0,max_int] has the same representation with both Int and Word\n  | i < 0     = mkLitWord dflags (1 + tARGET_MAX_WORD dflags + i)\n  | otherwise = mkLitWord dflags i\nint2WordLit _ l = pprPanic \"int2WordLit\" (ppr l)\n\n-- | Narrow a literal number (unchecked result range)\nnarrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal\nnarrowLit _ (LitNumber nt i t) = LitNumber nt (toInteger (fromInteger i :: a)) t\nnarrowLit _ l                  = pprPanic \"narrowLit\" (ppr l)\n\nnarrow8IntLit   = narrowLit (Proxy :: Proxy Int8)\nnarrow16IntLit  = narrowLit (Proxy :: Proxy Int16)\nnarrow32IntLit  = narrowLit (Proxy :: Proxy Int32)\nnarrow8WordLit  = narrowLit (Proxy :: Proxy Word8)\nnarrow16WordLit = narrowLit (Proxy :: Proxy Word16)\nnarrow32WordLit = narrowLit (Proxy :: Proxy Word32)\n\nchar2IntLit (LitChar c)       = mkLitIntUnchecked (toInteger (ord c))\nchar2IntLit l                 = pprPanic \"char2IntLit\" (ppr l)\nint2CharLit (LitNumber _ i _) = LitChar (chr (fromInteger i))\nint2CharLit l                 = pprPanic \"int2CharLit\" (ppr l)\n\nfloat2IntLit (LitFloat f)      = mkLitIntUnchecked (truncate f)\nfloat2IntLit l                 = pprPanic \"float2IntLit\" (ppr l)\nint2FloatLit (LitNumber _ i _) = LitFloat (fromInteger i)\nint2FloatLit l                 = pprPanic \"int2FloatLit\" (ppr l)\n\ndouble2IntLit (LitDouble f)     = mkLitIntUnchecked (truncate f)\ndouble2IntLit l                 = pprPanic \"double2IntLit\" (ppr l)\nint2DoubleLit (LitNumber _ i _) = LitDouble (fromInteger i)\nint2DoubleLit l                 = pprPanic \"int2DoubleLit\" (ppr l)\n\nfloat2DoubleLit (LitFloat  f) = LitDouble f\nfloat2DoubleLit l             = pprPanic \"float2DoubleLit\" (ppr l)\ndouble2FloatLit (LitDouble d) = LitFloat  d\ndouble2FloatLit l             = pprPanic \"double2FloatLit\" (ppr l)\n\nnullAddrLit :: Literal\nnullAddrLit = LitNullAddr\n\n-- | A nonsense literal of type @forall (a :: 'TYPE' 'UnliftedRep'). a@.\nrubbishLit :: Literal\nrubbishLit = LitRubbish\n\n{-\n        Predicates\n        ~~~~~~~~~~\n-}\n\n-- | True if there is absolutely no penalty to duplicating the literal.\n-- False principally of strings.\n--\n-- \"Why?\", you say? I'm glad you asked. Well, for one duplicating strings would\n-- blow up code sizes. Not only this, it's also unsafe.\n--\n-- Consider a program that wants to traverse a string. One way it might do this\n-- is to first compute the Addr# pointing to the end of the string, and then,\n-- starting from the beginning, bump a pointer using eqAddr# to determine the\n-- end. For instance,\n--\n-- @\n-- -- Given pointers to the start and end of a string, count how many zeros\n-- -- the string contains.\n-- countZeros :: Addr# -> Addr# -> -> Int\n-- countZeros start end = go start 0\n--   where\n--     go off n\n--       | off `addrEq#` end = n\n--       | otherwise         = go (off `plusAddr#` 1) n'\n--       where n' | isTrue# (indexInt8OffAddr# off 0# ==# 0#) = n + 1\n--                | otherwise                                 = n\n-- @\n--\n-- Consider what happens if we considered strings to be trivial (and therefore\n-- duplicable) and emitted a call like @countZeros \"hello\"# (\"hello\"#\n-- `plusAddr`# 5)@. The beginning and end pointers do not belong to the same\n-- string, meaning that an iteration like the above would blow up terribly.\n-- This is what happened in #12757.\n--\n-- Ultimately the solution here is to make primitive strings a bit more\n-- structured, ensuring that the compiler can't inline in ways that will break\n-- user code. One approach to this is described in #8472.\nlitIsTrivial :: Literal -> Bool\n--      c.f. CoreUtils.exprIsTrivial\nlitIsTrivial (LitString _)      = False\nlitIsTrivial (LitNumber nt _ _) = case nt of\n  LitNumInteger -> False\n  LitNumNatural -> False\n  LitNumInt     -> True\n  LitNumInt64   -> True\n  LitNumWord    -> True\n  LitNumWord64  -> True\nlitIsTrivial _                  = True\n\n-- | True if code space does not go bad if we duplicate this literal\nlitIsDupable :: DynFlags -> Literal -> Bool\n--      c.f. CoreUtils.exprIsDupable\nlitIsDupable _      (LitString _)      = False\nlitIsDupable dflags (LitNumber nt i _) = case nt of\n  LitNumInteger -> inIntRange dflags i\n  LitNumNatural -> inIntRange dflags i\n  LitNumInt     -> True\n  LitNumInt64   -> True\n  LitNumWord    -> True\n  LitNumWord64  -> True\nlitIsDupable _      _                  = True\n\nlitFitsInChar :: Literal -> Bool\nlitFitsInChar (LitNumber _ i _) = i >= toInteger (ord minBound)\n                               && i <= toInteger (ord maxBound)\nlitFitsInChar _                 = False\n\nlitIsLifted :: Literal -> Bool\nlitIsLifted (LitNumber nt _ _) = case nt of\n  LitNumInteger -> True\n  LitNumNatural -> True\n  LitNumInt     -> False\n  LitNumInt64   -> False\n  LitNumWord    -> False\n  LitNumWord64  -> False\nlitIsLifted _                  = False\n\n{-\n        Types\n        ~~~~~\n-}\n\n-- | Find the Haskell 'Type' the literal occupies\nliteralType :: Literal -> Type\nliteralType LitNullAddr       = addrPrimTy\nliteralType (LitChar _)       = charPrimTy\nliteralType (LitString  _)    = addrPrimTy\nliteralType (LitFloat _)      = floatPrimTy\nliteralType (LitDouble _)     = doublePrimTy\nliteralType (LitLabel _ _ _)  = addrPrimTy\nliteralType (LitNumber _ _ t) = t\nliteralType (LitRubbish)      = mkForAllTy a Inferred (mkTyVarTy a)\n  where\n    a = alphaTyVarUnliftedRep\n\nabsentLiteralOf :: TyCon -> Maybe Literal\n-- Return a literal of the appropriate primitive\n-- TyCon, to use as a placeholder when it doesn't matter\n-- Rubbish literals are handled in WwLib, because\n--  1. Looking at the TyCon is not enough, we need the actual type\n--  2. This would need to return a type application to a literal\nabsentLiteralOf tc = lookupUFM absent_lits (tyConName tc)\n\nabsent_lits :: UniqFM Literal\nabsent_lits = listToUFM [ (addrPrimTyConKey,    LitNullAddr)\n                        , (charPrimTyConKey,    LitChar 'x')\n                        , (intPrimTyConKey,     mkLitIntUnchecked 0)\n                        , (int64PrimTyConKey,   mkLitInt64Unchecked 0)\n                        , (wordPrimTyConKey,    mkLitWordUnchecked 0)\n                        , (word64PrimTyConKey,  mkLitWord64Unchecked 0)\n                        , (floatPrimTyConKey,   LitFloat 0)\n                        , (doublePrimTyConKey,  LitDouble 0)\n                        ]\n\n{-\n        Comparison\n        ~~~~~~~~~~\n-}\n\ncmpLit :: Literal -> Literal -> Ordering\ncmpLit (LitChar      a)     (LitChar       b)     = a `compare` b\ncmpLit (LitString    a)     (LitString     b)     = a `compare` b\ncmpLit (LitNullAddr)        (LitNullAddr)         = EQ\ncmpLit (LitFloat     a)     (LitFloat      b)     = a `compare` b\ncmpLit (LitDouble    a)     (LitDouble     b)     = a `compare` b\ncmpLit (LitLabel     a _ _) (LitLabel      b _ _) = a `compare` b\ncmpLit (LitNumber nt1 a _)  (LitNumber nt2  b _)\n  | nt1 == nt2 = a   `compare` b\n  | otherwise  = nt1 `compare` nt2\ncmpLit (LitRubbish)         (LitRubbish)          = EQ\ncmpLit lit1 lit2\n  | litTag lit1 < litTag lit2 = LT\n  | otherwise                 = GT\n\nlitTag :: Literal -> Int\nlitTag (LitChar      _)   = 1\nlitTag (LitString    _)   = 2\nlitTag (LitNullAddr)      = 3\nlitTag (LitFloat     _)   = 4\nlitTag (LitDouble    _)   = 5\nlitTag (LitLabel _ _ _)   = 6\nlitTag (LitNumber  {})    = 7\nlitTag (LitRubbish)       = 8\n\n{-\n        Printing\n        ~~~~~~~~\n* See Note [Printing of literals in Core]\n-}\n\npprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc\npprLiteral _       (LitChar c)     = pprPrimChar c\npprLiteral _       (LitString s)   = pprHsBytes s\npprLiteral _       (LitNullAddr)   = text \"__NULL\"\npprLiteral _       (LitFloat f)    = float (fromRat f) <> primFloatSuffix\npprLiteral _       (LitDouble d)   = double (fromRat d) <> primDoubleSuffix\npprLiteral add_par (LitNumber nt i _)\n   = case nt of\n       LitNumInteger -> pprIntegerVal add_par i\n       LitNumNatural -> pprIntegerVal add_par i\n       LitNumInt     -> pprPrimInt i\n       LitNumInt64   -> pprPrimInt64 i\n       LitNumWord    -> pprPrimWord i\n       LitNumWord64  -> pprPrimWord64 i\npprLiteral add_par (LitLabel l mb fod) =\n    add_par (text \"__label\" <+> b <+> ppr fod)\n    where b = case mb of\n              Nothing -> pprHsString l\n              Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))\npprLiteral _       (LitRubbish)     = text \"__RUBBISH\"\n\npprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc\n-- See Note [Printing of literals in Core].\npprIntegerVal add_par i | i < 0     = add_par (integer i)\n                        | otherwise = integer i\n\n{-\nNote [Printing of literals in Core]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe function `add_par` is used to wrap parenthesis around negative integers\n(`LitInteger`) and labels (`LitLabel`), if they occur in a context requiring\nan atomic thing (for example function application).\n\nAlthough not all Core literals would be valid Haskell, we are trying to stay\nas close as possible to Haskell syntax in the printing of Core, to make it\neasier for a Haskell user to read Core.\n\nTo that end:\n  * We do print parenthesis around negative `LitInteger`, because we print\n  `LitInteger` using plain number literals (no prefix or suffix), and plain\n  number literals in Haskell require parenthesis in contexts like function\n  application (i.e. `1 - -1` is not valid Haskell).\n\n  * We don't print parenthesis around other (negative) literals, because they\n  aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's\n  parser).\n\nLiteral         Output             Output if context requires\n                                   an atom (if different)\n-------         -------            ----------------------\nLitChar         'a'#\nLitString       \"aaa\"#\nLitNullAddr     \"__NULL\"\nLitInt          -1#\nLitInt64        -1L#\nLitWord          1##\nLitWord64        1L##\nLitFloat        -1.0#\nLitDouble       -1.0##\nLitInteger      -1                 (-1)\nLitLabel        \"__label\" ...      (\"__label\" ...)\nLitRubbish      \"__RUBBISH\"\n\nNote [Rubbish literals]\n~~~~~~~~~~~~~~~~~~~~~~~\nDuring worker/wrapper after demand analysis, where an argument\nis unused (absent) we do the following w/w split (supposing that\ny is absent):\n\n  f x y z = e\n===>\n  f x y z = $wf x z\n  $wf x z = let y = <absent value>\n            in e\n\nUsually the binding for y is ultimately optimised away, and\neven if not it should never be evaluated -- but that's the\nway the w/w split starts off.\n\nWhat is <absent value>?\n* For lifted values <absent value> can be a call to 'error'.\n* For primitive types like Int# or Word# we can use any random\n  value of that type.\n* But what about /unlifted/ but /boxed/ types like MutVar# or\n  Array#?   We need a literal value of that type.\n\nThat is 'LitRubbish'.  Since we need a rubbish literal for\nmany boxed, unlifted types, we say that LitRubbish has type\n  LitRubbish :: forall (a :: TYPE UnliftedRep). a\n\nSo we might see a w/w split like\n  $wf x z = let y :: Array# Int = LitRubbish @(Array# Int)\n            in e\n\nRecall that (TYPE UnliftedRep) is the kind of boxed, unlifted\nheap pointers.\n\nHere are the moving parts:\n\n* We define LitRubbish as a constructor in Literal.Literal\n\n* It is given its polymoprhic type by Literal.literalType\n\n* WwLib.mk_absent_let introduces a LitRubbish for absent\n  arguments of boxed, unlifted type.\n\n* In CoreToSTG we convert (RubishLit @t) to just ().  STG is\n  untyped, so it doesn't matter that it points to a lifted\n  value. The important thing is that it is a heap pointer,\n  which the garbage collector can follow if it encounters it.\n\n  We considered maintaining LitRubbish in STG, and lowering\n  it in the code genreators, but it seems simpler to do it\n  once and for all in CoreToSTG.\n\n  In ByteCodeAsm we just lower it as a 0 literal, because\n  it's all boxed and lifted to the host GC anyway.\n-}\n", "num_lines": 821}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1998\n\n\nThis module contains definitions for the IdInfo for things that\nhave a standard form, namely:\n\n- data constructors\n- record selectors\n- method and superclass selectors\n- primitive operations\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule MkId (\n        mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,\n\n        mkPrimOpId, mkFCallId,\n\n        unwrapNewTypeBody, wrapFamInstBody,\n        DataConBoxer(..), mkDataConRep, mkDataConWorkId,\n\n        -- And some particular Ids; see below for why they are wired in\n        wiredInIds, ghcPrimIds,\n        unsafeCoerceName, unsafeCoerceId, realWorldPrimId,\n        voidPrimId, voidArgId,\n        nullAddrId, seqId, lazyId, lazyIdKey,\n        coercionTokenId, magicDictId, coerceId,\n        proxyHashId, noinlineId, noinlineIdName,\n\n        -- Re-export error Ids\n        module PrelRules\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Rules\nimport TysPrim\nimport TysWiredIn\nimport PrelRules\nimport Type\nimport FamInstEnv\nimport Coercion\nimport TcType\nimport MkCore\nimport CoreUtils        ( exprType, mkCast )\nimport CoreUnfold\nimport Literal\nimport TyCon\nimport Class\nimport NameSet\nimport Name\nimport PrimOp\nimport ForeignCall\nimport DataCon\nimport Id\nimport IdInfo\nimport Demand\nimport CoreSyn\nimport Unique\nimport UniqSupply\nimport PrelNames\nimport BasicTypes       hiding ( SuccessFlag(..) )\nimport Util\nimport Pair\nimport DynFlags\nimport Outputable\nimport FastString\nimport ListSetOps\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.Maybe       ( maybeToList )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Wired in Ids}\n*                                                                      *\n************************************************************************\n\nNote [Wired-in Ids]\n~~~~~~~~~~~~~~~~~~~\nA \"wired-in\" Id can be referred to directly in GHC (e.g. 'voidPrimId')\nrather than by looking it up its name in some environment or fetching\nit from an interface file.\n\nThere are several reasons why an Id might appear in the wiredInIds:\n\n* ghcPrimIds: see Note [ghcPrimIds (aka pseudoops)]\n\n* magicIds: see Note [magicIds]\n\n* errorIds, defined in coreSyn/MkCore.hs.\n  These error functions (e.g. rUNTIME_ERROR_ID) are wired in\n  because the desugarer generates code that mentions them directly\n\nIn all cases except ghcPrimIds, there is a definition site in a\nlibrary module, which may be called (e.g. in higher order situations);\nbut the wired-in version means that the details are never read from\nthat module's interface file; instead, the full definition is right\nhere.\n\nNote [ghcPrimIds (aka pseudoops)]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe ghcPrimIds\n\n  * Are exported from GHC.Prim\n\n  * Can't be defined in Haskell, and hence no Haskell binding site,\n    but have perfectly reasonable unfoldings in Core\n\n  * Either have a CompulsoryUnfolding (hence always inlined), or\n        of an EvaldUnfolding and void representation (e.g. void#)\n\n  * Are (or should be) defined in primops.txt.pp as 'pseudoop'\n    Reason: that's how we generate documentation for them\n\nNote [magicIds]\n~~~~~~~~~~~~~~~\nThe magicIds\n\n  * Are exported from GHC.Magic\n\n  * Can be defined in Haskell (and are, in ghc-prim:GHC/Magic.hs).\n    This definition at least generates Haddock documentation for them.\n\n  * May or may not have a CompulsoryUnfolding.\n\n  * But have some special behaviour that can't be done via an\n    unfolding from an interface file\n-}\n\nwiredInIds :: [Id]\nwiredInIds\n  =  magicIds\n  ++ ghcPrimIds\n  ++ errorIds           -- Defined in MkCore\n\nmagicIds :: [Id]    -- See Note [magicIds]\nmagicIds = [lazyId, oneShotId, noinlineId]\n\nghcPrimIds :: [Id]  -- See Note [ghcPrimIds (aka pseudoops)]\nghcPrimIds\n  = [ realWorldPrimId\n    , voidPrimId\n    , unsafeCoerceId\n    , nullAddrId\n    , seqId\n    , magicDictId\n    , coerceId\n    , proxyHashId\n    ]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Data constructors}\n*                                                                      *\n************************************************************************\n\nThe wrapper for a constructor is an ordinary top-level binding that evaluates\nany strict args, unboxes any args that are going to be flattened, and calls\nthe worker.\n\nWe're going to build a constructor that looks like:\n\n        data (Data a, C b) =>  T a b = T1 !a !Int b\n\n        T1 = /\\ a b ->\n             \\d1::Data a, d2::C b ->\n             \\p q r -> case p of { p ->\n                       case q of { q ->\n                       Con T1 [a,b] [p,q,r]}}\n\nNotice that\n\n* d2 is thrown away --- a context in a data decl is used to make sure\n  one *could* construct dictionaries at the site the constructor\n  is used, but the dictionary isn't actually used.\n\n* We have to check that we can construct Data dictionaries for\n  the types a and Int.  Once we've done that we can throw d1 away too.\n\n* We use (case p of q -> ...) to evaluate p, rather than \"seq\" because\n  all that matters is that the arguments are evaluated.  \"seq\" is\n  very careful to preserve evaluation order, which we don't need\n  to be here.\n\n  You might think that we could simply give constructors some strictness\n  info, like PrimOps, and let CoreToStg do the let-to-case transformation.\n  But we don't do that because in the case of primops and functions strictness\n  is a *property* not a *requirement*.  In the case of constructors we need to\n  do something active to evaluate the argument.\n\n  Making an explicit case expression allows the simplifier to eliminate\n  it in the (common) case where the constructor arg is already evaluated.\n\nNote [Wrappers for data instance tycons]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the case of data instances, the wrapper also applies the coercion turning\nthe representation type into the family instance type to cast the result of\nthe wrapper.  For example, consider the declarations\n\n  data family Map k :: * -> *\n  data instance Map (a, b) v = MapPair (Map a (Pair b v))\n\nThe tycon to which the datacon MapPair belongs gets a unique internal\nname of the form :R123Map, and we call it the representation tycon.\nIn contrast, Map is the family tycon (accessible via\ntyConFamInst_maybe). A coercion allows you to move between\nrepresentation and family type.  It is accessible from :R123Map via\ntyConFamilyCoercion_maybe and has kind\n\n  Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}\n\nThe wrapper and worker of MapPair get the types\n\n        -- Wrapper\n  $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v\n  $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)\n\n        -- Worker\n  MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v\n\nThis coercion is conditionally applied by wrapFamInstBody.\n\nIt's a bit more complicated if the data instance is a GADT as well!\n\n   data instance T [a] where\n        T1 :: forall b. b -> T [Maybe b]\n\nHence we translate to\n\n        -- Wrapper\n  $WT1 :: forall b. b -> T [Maybe b]\n  $WT1 b v = T1 (Maybe b) b (Maybe b) v\n                        `cast` sym (Co7T (Maybe b))\n\n        -- Worker\n  T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c\n\n        -- Coercion from family type to representation type\n  Co7T a :: T [a] ~ :R7T a\n\nNewtype instances through an additional wrinkle into the mix. Consider the\nfollowing example (adapted from #15318, comment:2):\n\n  data family T a\n  newtype instance T [a] = MkT [a]\n\nWithin the newtype instance, there are three distinct types at play:\n\n1. The newtype's underlying type, [a].\n2. The instance's representation type, TList a (where TList is the\n   representation tycon).\n3. The family type, T [a].\n\nWe need two coercions in order to cast from (1) to (3):\n\n(a) A newtype coercion axiom:\n\n      axiom coTList a :: TList a ~ [a]\n\n    (Where TList is the representation tycon of the newtype instance.)\n\n(b) A data family instance coercion axiom:\n\n      axiom coT a :: T [a] ~ TList a\n\nWhen we translate the newtype instance to Core, we obtain:\n\n    -- Wrapper\n  $WMkT :: forall a. [a] -> T [a]\n  $WMkT a x = MkT a x |> Sym (coT a)\n\n    -- Worker\n  MkT :: forall a. [a] -> TList [a]\n  MkT a x = x |> Sym (coTList a)\n\nUnlike for data instances, the worker for a newtype instance is actually an\nexecutable function which expands to a cast, but otherwise, the general\nstrategy is essentially the same as for data instances. Also note that we have\na wrapper, which is unusual for a newtype, but we make GHC produce one anyway\nfor symmetry with the way data instances are handled.\n\nNote [Newtype datacons]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe \"data constructor\" for a newtype should always be vanilla.  At one\npoint this wasn't true, because the newtype arising from\n     class C a => D a\nlooked like\n       newtype T:D a = D:D (C a)\nso the data constructor for T:C had a single argument, namely the\npredicate (C a).  But now we treat that as an ordinary argument, not\npart of the theta-type, so all is well.\n\nNote [Compulsory newtype unfolding]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNewtype wrappers, just like workers, have compulsory unfoldings.\nThis is needed so that two optimizations involving newtypes have the same\neffect whether a wrapper is present or not:\n\n(1) Case-of-known constructor.\n    See Note [beta-reduction in exprIsConApp_maybe].\n\n(2) Matching against the map/coerce RULE. Suppose we have the RULE\n\n    {-# RULE \"map/coerce\" map coerce = ... #-}\n\n    As described in Note [Getting the map/coerce RULE to work],\n    the occurrence of 'coerce' is transformed into:\n\n    {-# RULE \"map/coerce\" forall (c :: T1 ~R# T2).\n                          map ((\\v -> v) `cast` c) = ... #-}\n\n    We'd like 'map Age' to match the LHS. For this to happen, Age\n    must be unfolded, otherwise we'll be stuck. This is tested in T16208.\n\n************************************************************************\n*                                                                      *\n\\subsection{Dictionary selectors}\n*                                                                      *\n************************************************************************\n\nSelecting a field for a dictionary.  If there is just one field, then\nthere's nothing to do.\n\nDictionary selectors may get nested forall-types.  Thus:\n\n        class Foo a where\n          op :: forall b. Ord b => a -> b -> b\n\nThen the top-level type for op is\n\n        op :: forall a. Foo a =>\n              forall b. Ord b =>\n              a -> b -> b\n\n-}\n\nmkDictSelId :: Name          -- Name of one of the *value* selectors\n                             -- (dictionary superclass or method)\n            -> Class -> Id\nmkDictSelId name clas\n  = mkGlobalId (ClassOpId clas) name sel_ty info\n  where\n    tycon          = classTyCon clas\n    sel_names      = map idName (classAllSelIds clas)\n    new_tycon      = isNewTyCon tycon\n    [data_con]     = tyConDataCons tycon\n    tyvars         = dataConUserTyVarBinders data_con\n    n_ty_args      = length tyvars\n    arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses\n    val_index      = assoc \"MkId.mkDictSelId\" (sel_names `zip` [0..]) name\n\n    sel_ty = mkForAllTys tyvars $\n             mkInvisFunTy (mkClassPred clas (mkTyVarTys (binderVars tyvars))) $\n             getNth arg_tys val_index\n\n    base_info = noCafIdInfo\n                `setArityInfo`          1\n                `setStrictnessInfo`     strict_sig\n                `setLevityInfoWithType` sel_ty\n\n    info | new_tycon\n         = base_info `setInlinePragInfo` alwaysInlinePragma\n                     `setUnfoldingInfo`  mkInlineUnfoldingWithArity 1\n                                           (mkDictSelRhs clas val_index)\n                   -- See Note [Single-method classes] in TcInstDcls\n                   -- for why alwaysInlinePragma\n\n         | otherwise\n         = base_info `setRuleInfo` mkRuleInfo [rule]\n                   -- Add a magic BuiltinRule, but no unfolding\n                   -- so that the rule is always available to fire.\n                   -- See Note [ClassOp/DFun selection] in TcInstDcls\n\n    -- This is the built-in rule that goes\n    --      op (dfT d1 d2) --->  opT d1 d2\n    rule = BuiltinRule { ru_name = fsLit \"Class op \" `appendFS`\n                                     occNameFS (getOccName name)\n                       , ru_fn    = name\n                       , ru_nargs = n_ty_args + 1\n                       , ru_try   = dictSelRule val_index n_ty_args }\n\n        -- The strictness signature is of the form U(AAAVAAAA) -> T\n        -- where the V depends on which item we are selecting\n        -- It's worth giving one, so that absence info etc is generated\n        -- even if the selector isn't inlined\n\n    strict_sig = mkClosedStrictSig [arg_dmd] topRes\n    arg_dmd | new_tycon = evalDmd\n            | otherwise = mkManyUsedDmd $\n                          mkProdDmd [ if name == sel_name then evalDmd else absDmd\n                                    | sel_name <- sel_names ]\n\nmkDictSelRhs :: Class\n             -> Int         -- 0-indexed selector among (superclasses ++ methods)\n             -> CoreExpr\nmkDictSelRhs clas val_index\n  = mkLams tyvars (Lam dict_id rhs_body)\n  where\n    tycon          = classTyCon clas\n    new_tycon      = isNewTyCon tycon\n    [data_con]     = tyConDataCons tycon\n    tyvars         = dataConUnivTyVars data_con\n    arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses\n\n    the_arg_id     = getNth arg_ids val_index\n    pred           = mkClassPred clas (mkTyVarTys tyvars)\n    dict_id        = mkTemplateLocal 1 pred\n    arg_ids        = mkTemplateLocalsNum 2 arg_tys\n\n    rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars)\n                                                   (Var dict_id)\n             | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)\n                                [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]\n                                -- varToCoreExpr needed for equality superclass selectors\n                                --   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }\n\ndictSelRule :: Int -> Arity -> RuleFun\n-- Tries to persuade the argument to look like a constructor\n-- application, using exprIsConApp_maybe, and then selects\n-- from it\n--       sel_i t1..tk (D t1..tk op1 ... opm) = opi\n--\ndictSelRule val_index n_ty_args _ id_unf _ args\n  | (dict_arg : _) <- drop n_ty_args args\n  , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe id_unf dict_arg\n  = Just (wrapFloats floats $ getNth con_args val_index)\n  | otherwise\n  = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n        Data constructors\n*                                                                      *\n************************************************************************\n-}\n\nmkDataConWorkId :: Name -> DataCon -> Id\nmkDataConWorkId wkr_name data_con\n  | isNewTyCon tycon\n  = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info\n  | otherwise\n  = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info\n\n  where\n    tycon  = dataConTyCon data_con  -- The representation TyCon\n    wkr_ty = dataConRepType data_con\n\n        ----------- Workers for data types --------------\n    alg_wkr_info = noCafIdInfo\n                   `setArityInfo`          wkr_arity\n                   `setStrictnessInfo`     wkr_sig\n                   `setUnfoldingInfo`      evaldUnfolding  -- Record that it's evaluated,\n                                                           -- even if arity = 0\n                   `setLevityInfoWithType` wkr_ty\n                     -- NB: unboxed tuples have workers, so we can't use\n                     -- setNeverLevPoly\n\n    wkr_arity = dataConRepArity data_con\n    wkr_sig   = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con)\n        --      Note [Data-con worker strictness]\n        -- Notice that we do *not* say the worker Id is strict\n        -- even if the data constructor is declared strict\n        --      e.g.    data T = MkT !(Int,Int)\n        -- Why?  Because the *wrapper* $WMkT is strict (and its unfolding has\n        -- case expressions that do the evals) but the *worker* MkT itself is\n        --  not. If we pretend it is strict then when we see\n        --      case x of y -> MkT y\n        -- the simplifier thinks that y is \"sure to be evaluated\" (because\n        -- the worker MkT is strict) and drops the case.  No, the workerId\n        -- MkT is not strict.\n        --\n        -- However, the worker does have StrictnessMarks.  When the simplifier\n        -- sees a pattern\n        --      case e of MkT x -> ...\n        -- it uses the dataConRepStrictness of MkT to mark x as evaluated;\n        -- but that's fine... dataConRepStrictness comes from the data con\n        -- not from the worker Id.\n\n        ----------- Workers for newtypes --------------\n    univ_tvs = dataConUnivTyVars data_con\n    arg_tys  = dataConRepArgTys  data_con  -- Should be same as dataConOrigArgTys\n    nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo\n                  `setArityInfo` 1      -- Arity 1\n                  `setInlinePragInfo`     alwaysInlinePragma\n                  `setUnfoldingInfo`      newtype_unf\n                  `setLevityInfoWithType` wkr_ty\n    id_arg1      = mkTemplateLocal 1 (head arg_tys)\n    res_ty_args  = mkTyCoVarTys univ_tvs\n    newtype_unf  = ASSERT2( isVanillaDataCon data_con &&\n                            isSingleton arg_tys\n                          , ppr data_con  )\n                              -- Note [Newtype datacons]\n                   mkCompulsoryUnfolding $\n                   mkLams univ_tvs $ Lam id_arg1 $\n                   wrapNewTypeBody tycon res_ty_args (Var id_arg1)\n\ndataConCPR :: DataCon -> DmdResult\ndataConCPR con\n  | isDataTyCon tycon     -- Real data types only; that is,\n                          -- not unboxed tuples or newtypes\n  , null (dataConExTyCoVars con)  -- No existentials\n  , wkr_arity > 0\n  , wkr_arity <= mAX_CPR_SIZE\n  = if is_prod then vanillaCprProdRes (dataConRepArity con)\n               else cprSumRes (dataConTag con)\n  | otherwise\n  = topRes\n  where\n    is_prod   = isProductTyCon tycon\n    tycon     = dataConTyCon con\n    wkr_arity = dataConRepArity con\n\n    mAX_CPR_SIZE :: Arity\n    mAX_CPR_SIZE = 10\n    -- We do not treat very big tuples as CPR-ish:\n    --      a) for a start we get into trouble because there aren't\n    --         \"enough\" unboxed tuple types (a tiresome restriction,\n    --         but hard to fix),\n    --      b) more importantly, big unboxed tuples get returned mainly\n    --         on the stack, and are often then allocated in the heap\n    --         by the caller.  So doing CPR for them may in fact make\n    --         things worse.\n\n{-\n-------------------------------------------------\n--         Data constructor representation\n--\n-- This is where we decide how to wrap/unwrap the\n-- constructor fields\n--\n--------------------------------------------------\n-}\n\ntype Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)\n  -- Unbox: bind rep vars by decomposing src var\n\ndata Boxer = UnitBox | Boxer (TCvSubst -> UniqSM ([Var], CoreExpr))\n  -- Box:   build src arg using these rep vars\n\n-- | Data Constructor Boxer\nnewtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))\n                       -- Bind these src-level vars, returning the\n                       -- rep-level vars to bind in the pattern\n\n{-\nNote [Inline partially-applied constructor wrappers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe allow the wrapper to inline when partially applied to avoid\nboxing values unnecessarily. For example, consider\n\n   data Foo a = Foo !Int a\n\n   instance Traversable Foo where\n     traverse f (Foo i a) = Foo i <$> f a\n\nThis desugars to\n\n   traverse f foo = case foo of\n        Foo i# a -> let i = I# i#\n                    in map ($WFoo i) (f a)\n\nIf the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`.\nBut if we inline the wrapper, we get\n\n   map (\\a. case i of I# i# a -> Foo i# a) (f a)\n\nand now case-of-known-constructor eliminates the redundant allocation.\n-}\n\nmkDataConRep :: DynFlags\n             -> FamInstEnvs\n             -> Name\n             -> Maybe [HsImplBang]\n                -- See Note [Bangs on imported data constructors]\n             -> DataCon\n             -> UniqSM DataConRep\nmkDataConRep dflags fam_envs wrap_name mb_bangs data_con\n  | not wrapper_reqd\n  = return NoDataConRep\n\n  | otherwise\n  = do { wrap_args <- mapM newLocal wrap_arg_tys\n       ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers)\n                                 initial_wrap_app\n\n       ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info\n             wrap_info = noCafIdInfo\n                         `setArityInfo`         wrap_arity\n                             -- It's important to specify the arity, so that partial\n                             -- applications are treated as values\n                         `setInlinePragInfo`    wrap_prag\n                         `setUnfoldingInfo`     wrap_unf\n                         `setStrictnessInfo`    wrap_sig\n                             -- We need to get the CAF info right here because TidyPgm\n                             -- does not tidy the IdInfo of implicit bindings (like the wrapper)\n                             -- so it not make sure that the CAF info is sane\n                         `setNeverLevPoly`      wrap_ty\n\n             wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR data_con)\n\n             wrap_arg_dmds =\n               replicate (length theta) topDmd ++ map mk_dmd arg_ibangs\n               -- Don't forget the dictionary arguments when building\n               -- the strictness signature (#14290).\n\n             mk_dmd str | isBanged str = evalDmd\n                        | otherwise           = topDmd\n\n             wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`\n                         activeDuringFinal\n                         -- See Note [Activation for data constructor wrappers]\n\n             -- The wrapper will usually be inlined (see wrap_unf), so its\n             -- strictness and CPR info is usually irrelevant. But this is\n             -- not always the case; GHC may choose not to inline it. In\n             -- particular, the wrapper constructor is not inlined inside\n             -- an INLINE rhs or when it is not applied to any arguments.\n             -- See Note [Inline partially-applied constructor wrappers]\n             -- Passing Nothing here allows the wrapper to inline when\n             -- unsaturated.\n             wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding wrap_rhs\n                        -- See Note [Compulsory newtype unfolding]\n                      | otherwise        = mkInlineUnfolding wrap_rhs\n             wrap_rhs = mkLams wrap_tvs $\n                        mkLams wrap_args $\n                        wrapFamInstBody tycon res_ty_args $\n                        wrap_body\n\n       ; return (DCR { dcr_wrap_id = wrap_id\n                     , dcr_boxer   = mk_boxer boxers\n                     , dcr_arg_tys = rep_tys\n                     , dcr_stricts = rep_strs\n                       -- For newtypes, dcr_bangs is always [HsLazy].\n                       -- See Note [HsImplBangs for newtypes].\n                     , dcr_bangs   = arg_ibangs }) }\n\n  where\n    (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty)\n      = dataConFullSig data_con\n    wrap_tvs     = dataConUserTyVars data_con\n    res_ty_args  = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs\n\n    tycon        = dataConTyCon data_con       -- The representation TyCon (not family)\n    wrap_ty      = dataConUserType data_con\n    ev_tys       = eqSpecPreds eq_spec ++ theta\n    all_arg_tys  = ev_tys ++ orig_arg_tys\n    ev_ibangs    = map (const HsLazy) ev_tys\n    orig_bangs   = dataConSrcBangs data_con\n\n    wrap_arg_tys = theta ++ orig_arg_tys\n    wrap_arity   = count isCoVar ex_tvs + length wrap_arg_tys\n             -- The wrap_args are the arguments *other than* the eq_spec\n             -- Because we are going to apply the eq_spec args manually in the\n             -- wrapper\n\n    new_tycon = isNewTyCon tycon\n    arg_ibangs\n      | new_tycon\n      = ASSERT( isSingleton orig_arg_tys )\n        [HsLazy] -- See Note [HsImplBangs for newtypes]\n      | otherwise\n      = case mb_bangs of\n          Nothing    -> zipWith (dataConSrcToImplBang dflags fam_envs)\n                                orig_arg_tys orig_bangs\n          Just bangs -> bangs\n\n    (rep_tys_w_strs, wrappers)\n      = unzip (zipWith dataConArgRep all_arg_tys (ev_ibangs ++ arg_ibangs))\n\n    (unboxers, boxers) = unzip wrappers\n    (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)\n\n    wrapper_reqd =\n        (not new_tycon\n                     -- (Most) newtypes have only a worker, with the exception\n                     -- of some newtypes written with GADT syntax. See below.\n         && (any isBanged (ev_ibangs ++ arg_ibangs)\n                     -- Some forcing/unboxing (includes eq_spec)\n             || (not $ null eq_spec))) -- GADT\n      || isFamInstTyCon tycon -- Cast result\n      || dataConUserTyVarsArePermuted data_con\n                     -- If the data type was written with GADT syntax and\n                     -- orders the type variables differently from what the\n                     -- worker expects, it needs a data con wrapper to reorder\n                     -- the type variables.\n                     -- See Note [Data con wrappers and GADT syntax].\n\n    initial_wrap_app = Var (dataConWorkId data_con)\n                       `mkTyApps`  res_ty_args\n                       `mkVarApps` ex_tvs\n                       `mkCoApps`  map (mkReflCo Nominal . eqSpecType) eq_spec\n\n    mk_boxer :: [Boxer] -> DataConBoxer\n    mk_boxer boxers = DCB (\\ ty_args src_vars ->\n                      do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars\n                               subst1 = zipTvSubst univ_tvs ty_args\n                               subst2 = extendTCvSubstList subst1 ex_tvs\n                                                           (mkTyCoVarTys ex_vars)\n                         ; (rep_ids, binds) <- go subst2 boxers term_vars\n                         ; return (ex_vars ++ rep_ids, binds) } )\n\n    go _ [] src_vars = ASSERT2( null src_vars, ppr data_con ) return ([], [])\n    go subst (UnitBox : boxers) (src_var : src_vars)\n      = do { (rep_ids2, binds) <- go subst boxers src_vars\n           ; return (src_var : rep_ids2, binds) }\n    go subst (Boxer boxer : boxers) (src_var : src_vars)\n      = do { (rep_ids1, arg)  <- boxer subst\n           ; (rep_ids2, binds) <- go subst boxers src_vars\n           ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }\n    go _ (_:_) [] = pprPanic \"mk_boxer\" (ppr data_con)\n\n    mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr\n    mk_rep_app [] con_app\n      = return con_app\n    mk_rep_app ((wrap_arg, unboxer) : prs) con_app\n      = do { (rep_ids, unbox_fn) <- unboxer wrap_arg\n           ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)\n           ; return (unbox_fn expr) }\n\n{- Note [Activation for data constructor wrappers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe Activation on a data constructor wrapper allows it to inline only in Phase\n0. This way rules have a chance to fire if they mention a data constructor on\nthe left\n   RULE \"foo\"  f (K a b) = ...\nSince the LHS of rules are simplified with InitialPhase, we won't\ninline the wrapper on the LHS either.\n\nOn the other hand, this means that exprIsConApp_maybe must be able to deal\nwith wrappers so that case-of-constructor is not delayed; see\nNote [exprIsConApp_maybe on data constructors with wrappers] for details.\n\nIt used to activate in phases 2 (afterInitial) and later, but it makes it\nawkward to write a RULE[1] with a constructor on the left: it would work if a\nconstructor has no wrapper, but whether a constructor has a wrapper depends, for\ninstance, on the order of type argument of that constructors. Therefore changing\nthe order of type argument could make previously working RULEs fail.\n\nSee also https://ghc.haskell.org/trac/ghc/ticket/15840 .\n\n\nNote [Bangs on imported data constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe pass Maybe [HsImplBang] to mkDataConRep to make use of HsImplBangs\nfrom imported modules.\n\n- Nothing <=> use HsSrcBangs\n- Just bangs <=> use HsImplBangs\n\nFor imported types we can't work it all out from the HsSrcBangs,\nbecause we want to be very sure to follow what the original module\n(where the data type was declared) decided, and that depends on what\nflags were enabled when it was compiled. So we record the decisions in\nthe interface file.\n\nThe HsImplBangs passed are in 1-1 correspondence with the\ndataConOrigArgTys of the DataCon.\n\nNote [Data con wrappers and unlifted types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   data T = MkT !Int#\n\nWe certainly do not want to make a wrapper\n   $WMkT x = case x of y { DEFAULT -> MkT y }\n\nFor a start, it's still to generate a no-op.  But worse, since wrappers\nare currently injected at TidyCore, we don't even optimise it away!\nSo the stupid case expression stays there.  This actually happened for\nthe Integer data type (see Trac #1600 comment:66)!\n\nNote [Data con wrappers and GADT syntax]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider these two very similar data types:\n\n  data T1 a b = MkT1 b\n\n  data T2 a b where\n    MkT2 :: forall b a. b -> T2 a b\n\nDespite their similar appearance, T2 will have a data con wrapper but T1 will\nnot. What sets them apart? The types of their constructors, which are:\n\n  MkT1 :: forall a b. b -> T1 a b\n  MkT2 :: forall b a. b -> T2 a b\n\nMkT2's use of GADT syntax allows it to permute the order in which `a` and `b`\nwould normally appear. See Note [DataCon user type variable binders] in DataCon\nfor further discussion on this topic.\n\nThe worker data cons for T1 and T2, however, both have types such that `a` is\nexpected to come before `b` as arguments. Because MkT2 permutes this order, it\nneeds a data con wrapper to swizzle around the type variables to be in the\norder the worker expects.\n\nA somewhat surprising consequence of this is that *newtypes* can have data con\nwrappers! After all, a newtype can also be written with GADT syntax:\n\n  newtype T3 a b where\n    MkT3 :: forall b a. b -> T3 a b\n\nAgain, this needs a wrapper data con to reorder the type variables. It does\nmean that this newtype constructor requires another level of indirection when\nbeing called, but the inliner should make swift work of that.\n\nNote [HsImplBangs for newtypes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMost of the time, we use the dataConSrctoImplBang function to decide what\nstrictness/unpackedness to use for the fields of a data type constructor. But\nthere is an exception to this rule: newtype constructors. You might not think\nthat newtypes would pose a challenge, since newtypes are seemingly forbidden\nfrom having strictness annotations in the first place. But consider this\n(from Trac #16141):\n\n  {-# LANGUAGE StrictData #-}\n  {-# OPTIONS_GHC -O #-}\n  newtype T a b where\n    MkT :: forall b a. Int -> T a b\n\nBecause StrictData (plus optimization) is enabled, invoking\ndataConSrcToImplBang would sneak in and unpack the field of type Int to Int#!\nThis would be disastrous, since the wrapper for `MkT` uses a coercion involving\nInt, not Int#.\n\nBottom line: dataConSrcToImplBang should never be invoked for newtypes. In the\ncase of a newtype constructor, we simply hardcode its dcr_bangs field to\n[HsLazy].\n-}\n\n-------------------------\nnewLocal :: Type -> UniqSM Var\nnewLocal ty = do { uniq <- getUniqueM\n                 ; return (mkSysLocalOrCoVar (fsLit \"dt\") uniq ty) }\n\n-- | Unpack/Strictness decisions from source module.\n--\n-- This function should only ever be invoked for data constructor fields, and\n-- never on the field of a newtype constructor.\n-- See @Note [HsImplBangs for newtypes]@.\ndataConSrcToImplBang\n   :: DynFlags\n   -> FamInstEnvs\n   -> Type\n   -> HsSrcBang\n   -> HsImplBang\n\ndataConSrcToImplBang dflags fam_envs arg_ty\n                     (HsSrcBang ann unpk NoSrcStrict)\n  | xopt LangExt.StrictData dflags -- StrictData => strict field\n  = dataConSrcToImplBang dflags fam_envs arg_ty\n                  (HsSrcBang ann unpk SrcStrict)\n  | otherwise -- no StrictData => lazy field\n  = HsLazy\n\ndataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)\n  = HsLazy\n\ndataConSrcToImplBang dflags fam_envs arg_ty\n                     (HsSrcBang _ unpk_prag SrcStrict)\n  | isUnliftedType arg_ty\n  = HsLazy  -- For !Int#, say, use HsLazy\n            -- See Note [Data con wrappers and unlifted types]\n\n  | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas\n          -- Don't unpack if we aren't optimising; rather arbitrarily,\n          -- we use -fomit-iface-pragmas as the indication\n  , let mb_co   = topNormaliseType_maybe fam_envs arg_ty\n                     -- Unwrap type families and newtypes\n        arg_ty' = case mb_co of { Just (_,ty) -> ty; Nothing -> arg_ty }\n  , isUnpackableType dflags fam_envs arg_ty'\n  , (rep_tys, _) <- dataConArgUnpack arg_ty'\n  , case unpk_prag of\n      NoSrcUnpack ->\n        gopt Opt_UnboxStrictFields dflags\n            || (gopt Opt_UnboxSmallStrictFields dflags\n                && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]\n      srcUnpack -> isSrcUnpacked srcUnpack\n  = case mb_co of\n      Nothing     -> HsUnpack Nothing\n      Just (co,_) -> HsUnpack (Just co)\n\n  | otherwise -- Record the strict-but-no-unpack decision\n  = HsStrict\n\n\n-- | Wrappers/Workers and representation following Unpack/Strictness\n-- decisions\ndataConArgRep\n  :: Type\n  -> HsImplBang\n  -> ([(Type,StrictnessMark)] -- Rep types\n     ,(Unboxer,Boxer))\n\ndataConArgRep arg_ty HsLazy\n  = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))\n\ndataConArgRep arg_ty HsStrict\n  = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))\n\ndataConArgRep arg_ty (HsUnpack Nothing)\n  | (rep_tys, wrappers) <- dataConArgUnpack arg_ty\n  = (rep_tys, wrappers)\n\ndataConArgRep _ (HsUnpack (Just co))\n  | let co_rep_ty = pSnd (coercionKind co)\n  , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty\n  = (rep_tys, wrapCo co co_rep_ty wrappers)\n\n\n-------------------------\nwrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer)\nwrapCo co rep_ty (unbox_rep, box_rep)  -- co :: arg_ty ~ rep_ty\n  = (unboxer, boxer)\n  where\n    unboxer arg_id = do { rep_id <- newLocal rep_ty\n                        ; (rep_ids, rep_fn) <- unbox_rep rep_id\n                        ; let co_bind = NonRec rep_id (Var arg_id `Cast` co)\n                        ; return (rep_ids, Let co_bind . rep_fn) }\n    boxer = Boxer $ \\ subst ->\n            do { (rep_ids, rep_expr)\n                    <- case box_rep of\n                         UnitBox -> do { rep_id <- newLocal (TcType.substTy subst rep_ty)\n                                       ; return ([rep_id], Var rep_id) }\n                         Boxer boxer -> boxer subst\n               ; let sco = substCoUnchecked subst co\n               ; return (rep_ids, rep_expr `Cast` mkSymCo sco) }\n\n------------------------\nseqUnboxer :: Unboxer\nseqUnboxer v = return ([v], \\e -> Case (Var v) v (exprType e) [(DEFAULT, [], e)])\n\nunitUnboxer :: Unboxer\nunitUnboxer v = return ([v], \\e -> e)\n\nunitBoxer :: Boxer\nunitBoxer = UnitBox\n\n-------------------------\ndataConArgUnpack\n   :: Type\n   ->  ( [(Type, StrictnessMark)]   -- Rep types\n       , (Unboxer, Boxer) )\n\ndataConArgUnpack arg_ty\n  | Just (tc, tc_args) <- splitTyConApp_maybe arg_ty\n  , Just con <- tyConSingleAlgDataCon_maybe tc\n      -- NB: check for an *algebraic* data type\n      -- A recursive newtype might mean that\n      -- 'arg_ty' is a newtype\n  , let rep_tys = dataConInstArgTys con tc_args\n  = ASSERT( null (dataConExTyCoVars con) )\n      -- Note [Unpacking GADTs and existentials]\n    ( rep_tys `zip` dataConRepStrictness con\n    ,( \\ arg_id ->\n       do { rep_ids <- mapM newLocal rep_tys\n          ; let unbox_fn body\n                  = Case (Var arg_id) arg_id (exprType body)\n                         [(DataAlt con, rep_ids, body)]\n          ; return (rep_ids, unbox_fn) }\n     , Boxer $ \\ subst ->\n       do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys\n          ; return (rep_ids, Var (dataConWorkId con)\n                             `mkTyApps` (substTysUnchecked subst tc_args)\n                             `mkVarApps` rep_ids ) } ) )\n  | otherwise\n  = pprPanic \"dataConArgUnpack\" (ppr arg_ty)\n    -- An interface file specified Unpacked, but we couldn't unpack it\n\nisUnpackableType :: DynFlags -> FamInstEnvs -> Type -> Bool\n-- True if we can unpack the UNPACK the argument type\n-- See Note [Recursive unboxing]\n-- We look \"deeply\" inside rather than relying on the DataCons\n-- we encounter on the way, because otherwise we might well\n-- end up relying on ourselves!\nisUnpackableType dflags fam_envs ty\n  | Just data_con <- unpackable_type ty\n  = ok_con_args emptyNameSet data_con\n  | otherwise\n  = False\n  where\n    ok_con_args dcs con\n       | dc_name `elemNameSet` dcs\n       = False\n       | otherwise\n       = all (ok_arg dcs')\n             (dataConOrigArgTys con `zip` dataConSrcBangs con)\n          -- NB: dataConSrcBangs gives the *user* request;\n          -- We'd get a black hole if we used dataConImplBangs\n       where\n         dc_name = getName con\n         dcs' = dcs `extendNameSet` dc_name\n\n    ok_arg dcs (ty, bang)\n      = not (attempt_unpack bang) || ok_ty dcs norm_ty\n      where\n        norm_ty = topNormaliseType fam_envs ty\n\n    ok_ty dcs ty\n      | Just data_con <- unpackable_type ty\n      = ok_con_args dcs data_con\n      | otherwise\n      = True        -- NB True here, in contrast to False at top level\n\n    attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict)\n      = xopt LangExt.StrictData dflags\n    attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict)\n      = True\n    attempt_unpack (HsSrcBang _  NoSrcUnpack SrcStrict)\n      = True  -- Be conservative\n    attempt_unpack (HsSrcBang _  NoSrcUnpack NoSrcStrict)\n      = xopt LangExt.StrictData dflags -- Be conservative\n    attempt_unpack _ = False\n\n    unpackable_type :: Type -> Maybe DataCon\n    -- Works just on a single level\n    unpackable_type ty\n      | Just (tc, _) <- splitTyConApp_maybe ty\n      , Just data_con <- tyConSingleAlgDataCon_maybe tc\n      , null (dataConExTyCoVars data_con)\n          -- See Note [Unpacking GADTs and existentials]\n      = Just data_con\n      | otherwise\n      = Nothing\n\n{-\nNote [Unpacking GADTs and existentials]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere is nothing stopping us unpacking a data type with equality\ncomponents, like\n  data Equal a b where\n    Equal :: Equal a a\n\nAnd it'd be fine to unpack a product type with existential components\ntoo, but that would require a bit more plumbing, so currently we don't.\n\nSo for now we require: null (dataConExTyCoVars data_con)\nSee Trac #14978\n\nNote [Unpack one-wide fields]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe flag UnboxSmallStrictFields ensures that any field that can\n(safely) be unboxed to a word-sized unboxed field, should be so unboxed.\nFor example:\n\n    data A = A Int#\n    newtype B = B A\n    data C = C !B\n    data D = D !C\n    data E = E !()\n    data F = F !D\n    data G = G !F !F\n\nAll of these should have an Int# as their representation, except\nG which should have two Int#s.\n\nHowever\n\n    data T = T !(S Int)\n    data S = S !a\n\nHere we can represent T with an Int#.\n\nNote [Recursive unboxing]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data R = MkR {-# UNPACK #-} !S Int\n  data S = MkS {-# UNPACK #-} !Int\nThe representation arguments of MkR are the *representation* arguments\nof S (plus Int); the rep args of MkS are Int#.  This is all fine.\n\nBut be careful not to try to unbox this!\n        data T = MkT {-# UNPACK #-} !T Int\nBecause then we'd get an infinite number of arguments.\n\nHere is a more complicated case:\n        data S = MkS {-# UNPACK #-} !T Int\n        data T = MkT {-# UNPACK #-} !S Int\nEach of S and T must decide independently whether to unpack\nand they had better not both say yes. So they must both say no.\n\nAlso behave conservatively when there is no UNPACK pragma\n        data T = MkS !T Int\nwith -funbox-strict-fields or -funbox-small-strict-fields\nwe need to behave as if there was an UNPACK pragma there.\n\nBut it's the *argument* type that matters. This is fine:\n        data S = MkS S !Int\nbecause Int is non-recursive.\n\n************************************************************************\n*                                                                      *\n        Wrapping and unwrapping newtypes and type families\n*                                                                      *\n************************************************************************\n-}\n\nwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr\n-- The wrapper for the data constructor for a newtype looks like this:\n--      newtype T a = MkT (a,Int)\n--      MkT :: forall a. (a,Int) -> T a\n--      MkT = /\\a. \\(x:(a,Int)). x `cast` sym (CoT a)\n-- where CoT is the coercion TyCon associated with the newtype\n--\n-- The call (wrapNewTypeBody T [a] e) returns the\n-- body of the wrapper, namely\n--      e `cast` (CoT [a])\n--\n-- If a coercion constructor is provided in the newtype, then we use\n-- it, otherwise the wrap/unwrap are both no-ops\n\nwrapNewTypeBody tycon args result_expr\n  = ASSERT( isNewTyCon tycon )\n    mkCast result_expr (mkSymCo co)\n  where\n    co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args []\n\n-- When unwrapping, we do *not* apply any family coercion, because this will\n-- be done via a CoPat by the type checker.  We have to do it this way as\n-- computing the right type arguments for the coercion requires more than just\n-- a spliting operation (cf, TcPat.tcConPat).\n\nunwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr\nunwrapNewTypeBody tycon args result_expr\n  = ASSERT( isNewTyCon tycon )\n    mkCast result_expr (mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [])\n\n-- If the type constructor is a representation type of a data instance, wrap\n-- the expression into a cast adjusting the expression type, which is an\n-- instance of the representation type, to the corresponding instance of the\n-- family instance type.\n-- See Note [Wrappers for data instance tycons]\nwrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr\nwrapFamInstBody tycon args body\n  | Just co_con <- tyConFamilyCoercion_maybe tycon\n  = mkCast body (mkSymCo (mkUnbranchedAxInstCo Representational co_con args []))\n  | otherwise\n  = body\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Primitive operations}\n*                                                                      *\n************************************************************************\n-}\n\nmkPrimOpId :: PrimOp -> Id\nmkPrimOpId prim_op\n  = id\n  where\n    (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op\n    ty   = mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)\n    name = mkWiredInName gHC_PRIM (primOpOcc prim_op)\n                         (mkPrimOpIdUnique (primOpTag prim_op))\n                         (AnId id) UserSyntax\n    id   = mkGlobalId (PrimOpId prim_op) name ty info\n\n    info = noCafIdInfo\n           `setRuleInfo`           mkRuleInfo (maybeToList $ primOpRules name prim_op)\n           `setArityInfo`          arity\n           `setStrictnessInfo`     strict_sig\n           `setInlinePragInfo`     neverInlinePragma\n           `setLevityInfoWithType` res_ty\n               -- We give PrimOps a NOINLINE pragma so that we don't\n               -- get silly warnings from Desugar.dsRule (the inline_shadows_rule\n               -- test) about a RULE conflicting with a possible inlining\n               -- cf Trac #7287\n\n-- For each ccall we manufacture a separate CCallOpId, giving it\n-- a fresh unique, a type that is correct for this particular ccall,\n-- and a CCall structure that gives the correct details about calling\n-- convention etc.\n--\n-- The *name* of this Id is a local name whose OccName gives the full\n-- details of the ccall, type and all.  This means that the interface\n-- file reader can reconstruct a suitable Id\n\nmkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id\nmkFCallId dflags uniq fcall ty\n  = ASSERT( noFreeVarsOfType ty )\n    -- A CCallOpId should have no free type variables;\n    -- when doing substitutions won't substitute over it\n    mkGlobalId (FCallId fcall) name ty info\n  where\n    occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))\n    -- The \"occurrence name\" of a ccall is the full info about the\n    -- ccall; it is encoded, but may have embedded spaces etc!\n\n    name = mkFCallName uniq occ_str\n\n    info = noCafIdInfo\n           `setArityInfo`          arity\n           `setStrictnessInfo`     strict_sig\n           `setLevityInfoWithType` ty\n\n    (bndrs, _) = tcSplitPiTys ty\n    arity      = count isAnonTyCoBinder bndrs\n    strict_sig = mkClosedStrictSig (replicate arity topDmd) topRes\n    -- the call does not claim to be strict in its arguments, since they\n    -- may be lifted (foreign import prim) and the called code doesn't\n    -- necessarily force them. See Trac #11076.\n{-\n************************************************************************\n*                                                                      *\n\\subsection{DictFuns and default methods}\n*                                                                      *\n************************************************************************\n\nNote [Dict funs and default methods]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDict funs and default methods are *not* ImplicitIds.  Their definition\ninvolves user-written code, so we can't figure out their strictness etc\nbased on fixed info, as we can for constructors and record selectors (say).\n\nNB: See also Note [Exported LocalIds] in Id\n-}\n\nmkDictFunId :: Name      -- Name to use for the dict fun;\n            -> [TyVar]\n            -> ThetaType\n            -> Class\n            -> [Type]\n            -> Id\n-- Implements the DFun Superclass Invariant (see TcInstDcls)\n-- See Note [Dict funs and default methods]\n\nmkDictFunId dfun_name tvs theta clas tys\n  = mkExportedLocalId (DFunId is_nt)\n                      dfun_name\n                      dfun_ty\n  where\n    is_nt = isNewTyCon (classTyCon clas)\n    dfun_ty = mkDictFunTy tvs theta clas tys\n\nmkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type\nmkDictFunTy tvs theta clas tys\n = mkSpecSigmaTy tvs theta (mkClassPred clas tys)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Un-definable}\n*                                                                      *\n************************************************************************\n\nThese Ids can't be defined in Haskell.  They could be defined in\nunfoldings in the wired-in GHC.Prim interface file, but we'd have to\nensure that they were definitely, definitely inlined, because there is\nno curried identifier for them.  That's what mkCompulsoryUnfolding\ndoes.  If we had a way to get a compulsory unfolding from an interface\nfile, we could do that, but we don't right now.\n\nunsafeCoerce# isn't so much a PrimOp as a phantom identifier, that\njust gets expanded into a type coercion wherever it occurs.  Hence we\nadd it as a built-in Id with an unfolding here.\n\nThe type variables we use here are \"open\" type variables: this means\nthey can unify with both unlifted and lifted types.  Hence we provide\nanother gun with which to shoot yourself in the foot.\n-}\n\nunsafeCoerceName, nullAddrName, seqName,\n   realWorldName, voidPrimIdName, coercionTokenName,\n   magicDictName, coerceName, proxyName :: Name\nunsafeCoerceName  = mkWiredInIdName gHC_PRIM  (fsLit \"unsafeCoerce#\")  unsafeCoerceIdKey  unsafeCoerceId\nnullAddrName      = mkWiredInIdName gHC_PRIM  (fsLit \"nullAddr#\")      nullAddrIdKey      nullAddrId\nseqName           = mkWiredInIdName gHC_PRIM  (fsLit \"seq\")            seqIdKey           seqId\nrealWorldName     = mkWiredInIdName gHC_PRIM  (fsLit \"realWorld#\")     realWorldPrimIdKey realWorldPrimId\nvoidPrimIdName    = mkWiredInIdName gHC_PRIM  (fsLit \"void#\")          voidPrimIdKey      voidPrimId\ncoercionTokenName = mkWiredInIdName gHC_PRIM  (fsLit \"coercionToken#\") coercionTokenIdKey coercionTokenId\nmagicDictName     = mkWiredInIdName gHC_PRIM  (fsLit \"magicDict\")      magicDictKey       magicDictId\ncoerceName        = mkWiredInIdName gHC_PRIM  (fsLit \"coerce\")         coerceKey          coerceId\nproxyName         = mkWiredInIdName gHC_PRIM  (fsLit \"proxy#\")         proxyHashKey       proxyHashId\n\nlazyIdName, oneShotName, noinlineIdName :: Name\nlazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit \"lazy\")           lazyIdKey          lazyId\noneShotName       = mkWiredInIdName gHC_MAGIC (fsLit \"oneShot\")        oneShotKey         oneShotId\nnoinlineIdName    = mkWiredInIdName gHC_MAGIC (fsLit \"noinline\")       noinlineIdKey      noinlineId\n\n------------------------------------------------\nproxyHashId :: Id\nproxyHashId\n  = pcMiscPrelId proxyName ty\n       (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]\n                    `setNeverLevPoly`  ty )\n  where\n    -- proxy# :: forall {k} (a:k). Proxy# k a\n    --\n    -- The visibility of the `k` binder is Inferred to match the type of the\n    -- Proxy data constructor (#16293).\n    [kv,tv] = mkTemplateKiTyVars [liftedTypeKind] id\n    kv_ty   = mkTyVarTy kv\n    tv_ty   = mkTyVarTy tv\n    ty      = mkInvForAllTy kv $ mkSpecForAllTy tv $ mkProxyPrimTy kv_ty tv_ty\n\n------------------------------------------------\nunsafeCoerceId :: Id\nunsafeCoerceId\n  = pcMiscPrelId unsafeCoerceName ty info\n  where\n    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma\n                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs\n\n    -- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n    --                         (a :: TYPE r1) (b :: TYPE r2).\n    --                         a -> b\n    bndrs = mkTemplateKiTyVars [runtimeRepTy, runtimeRepTy]\n                               (\\ks -> map tYPE ks)\n\n    [_, _, a, b] = mkTyVarTys bndrs\n\n    ty  = mkSpecForAllTys bndrs (mkVisFunTy a b)\n\n    [x] = mkTemplateLocals [a]\n    rhs = mkLams (bndrs ++ [x]) $\n          Cast (Var x) (mkUnsafeCo Representational a b)\n\n------------------------------------------------\nnullAddrId :: Id\n-- nullAddr# :: Addr#\n-- The reason it is here is because we don't provide\n-- a way to write this literal in Haskell.\nnullAddrId = pcMiscPrelId nullAddrName addrPrimTy info\n  where\n    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma\n                       `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)\n                       `setNeverLevPoly`   addrPrimTy\n\n------------------------------------------------\nseqId :: Id     -- See Note [seqId magic]\nseqId = pcMiscPrelId seqName ty info\n  where\n    info = noCafIdInfo `setInlinePragInfo` inline_prag\n                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs\n                       `setNeverLevPoly`   ty\n\n    inline_prag\n         = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter\n                 NoSourceText 0\n                  -- Make 'seq' not inline-always, so that simpleOptExpr\n                  -- (see CoreSubst.simple_app) won't inline 'seq' on the\n                  -- LHS of rules.  That way we can have rules for 'seq';\n                  -- see Note [seqId magic]\n\n    ty  = mkSpecForAllTys [alphaTyVar,betaTyVar]\n                          (mkVisFunTy alphaTy (mkVisFunTy betaTy betaTy))\n\n    [x,y] = mkTemplateLocals [alphaTy, betaTy]\n    rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])\n\n------------------------------------------------\nlazyId :: Id    -- See Note [lazyId magic]\nlazyId = pcMiscPrelId lazyIdName ty info\n  where\n    info = noCafIdInfo `setNeverLevPoly` ty\n    ty  = mkSpecForAllTys [alphaTyVar] (mkVisFunTy alphaTy alphaTy)\n\nnoinlineId :: Id -- See Note [noinlineId magic]\nnoinlineId = pcMiscPrelId noinlineIdName ty info\n  where\n    info = noCafIdInfo `setNeverLevPoly` ty\n    ty  = mkSpecForAllTys [alphaTyVar] (mkVisFunTy alphaTy alphaTy)\n\noneShotId :: Id -- See Note [The oneShot function]\noneShotId = pcMiscPrelId oneShotName ty info\n  where\n    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma\n                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs\n    ty  = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar\n                          , openAlphaTyVar, openBetaTyVar ]\n                          (mkVisFunTy fun_ty fun_ty)\n    fun_ty = mkVisFunTy openAlphaTy openBetaTy\n    [body, x] = mkTemplateLocals [fun_ty, openAlphaTy]\n    x' = setOneShotLambda x  -- Here is the magic bit!\n    rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar\n                 , openAlphaTyVar, openBetaTyVar\n                 , body, x'] $\n          Var body `App` Var x\n\n--------------------------------------------------------------------------------\nmagicDictId :: Id  -- See Note [magicDictId magic]\nmagicDictId = pcMiscPrelId magicDictName ty info\n  where\n  info = noCafIdInfo `setInlinePragInfo` neverInlinePragma\n                     `setNeverLevPoly`   ty\n  ty   = mkSpecForAllTys [alphaTyVar] alphaTy\n\n--------------------------------------------------------------------------------\n\ncoerceId :: Id\ncoerceId = pcMiscPrelId coerceName ty info\n  where\n    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma\n                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs\n                       `setNeverLevPoly`   ty\n    eqRTy     = mkTyConApp coercibleTyCon [ liftedTypeKind\n                                          , alphaTy, betaTy ]\n    eqRPrimTy = mkTyConApp eqReprPrimTyCon [ liftedTypeKind\n                                           , liftedTypeKind\n                                           , alphaTy, betaTy ]\n    ty        = mkSpecForAllTys [alphaTyVar, betaTyVar] $\n                mkInvisFunTy eqRTy                      $\n                mkVisFunTy alphaTy betaTy\n\n    [eqR,x,eq] = mkTemplateLocals [eqRTy, alphaTy, eqRPrimTy]\n    rhs = mkLams [alphaTyVar, betaTyVar, eqR, x] $\n          mkWildCase (Var eqR) eqRTy betaTy $\n          [(DataAlt coercibleDataCon, [eq], Cast (Var x) (mkCoVarCo eq))]\n\n{-\nNote [Unsafe coerce magic]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe define a *primitive*\n   GHC.Prim.unsafeCoerce#\nand then in the base library we define the ordinary function\n   Unsafe.Coerce.unsafeCoerce :: forall (a:*) (b:*). a -> b\n   unsafeCoerce x = unsafeCoerce# x\n\nNotice that unsafeCoerce has a civilized (albeit still dangerous)\npolymorphic type, whose type args have kind *.  So you can't use it on\nunboxed values (unsafeCoerce 3#).\n\nIn contrast unsafeCoerce# is even more dangerous because you *can* use\nit on unboxed things, (unsafeCoerce# 3#) :: Int. Its type is\n   forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a: TYPE r1) (b: TYPE r2). a -> b\n\nNote [seqId magic]\n~~~~~~~~~~~~~~~~~~\n'GHC.Prim.seq' is special in several ways.\n\na) In source Haskell its second arg can have an unboxed type\n      x `seq` (v +# w)\n   But see Note [Typing rule for seq] in TcExpr, which\n   explains why we give seq itself an ordinary type\n         seq :: forall a b. a -> b -> b\n   and treat it as a language construct from a typing point of view.\n\nb) Its fixity is set in LoadIface.ghcPrimIface\n\nc) It has quite a bit of desugaring magic.\n   See DsUtils.hs Note [Desugaring seq (1)] and (2) and (3)\n\nd) There is some special rule handing: Note [User-defined RULES for seq]\n\nNote [User-defined RULES for seq]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRoman found situations where he had\n      case (f n) of _ -> e\nwhere he knew that f (which was strict in n) would terminate if n did.\nNotice that the result of (f n) is discarded. So it makes sense to\ntransform to\n      case n of _ -> e\n\nRather than attempt some general analysis to support this, I've added\nenough support that you can do this using a rewrite rule:\n\n  RULE \"f/seq\" forall n.  seq (f n) = seq n\n\nYou write that rule.  When GHC sees a case expression that discards\nits result, it mentally transforms it to a call to 'seq' and looks for\na RULE.  (This is done in Simplify.trySeqRules.)  As usual, the\ncorrectness of the rule is up to you.\n\nVERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2.\nIf we wrote\n  RULE \"f/seq\" forall n e.  seq (f n) e = seq n e\nwith rule arity 2, then two bad things would happen:\n\n  - The magical desugaring done in Note [seqId magic] item (c)\n    for saturated application of 'seq' would turn the LHS into\n    a case expression!\n\n  - The code in Simplify.rebuildCase would need to actually supply\n    the value argument, which turns out to be awkward.\n\nNote [lazyId magic]\n~~~~~~~~~~~~~~~~~~~\nlazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)\n\n'lazy' is used to make sure that a sub-expression, and its free variables,\nare truly used call-by-need, with no code motion.  Key examples:\n\n* pseq:    pseq a b = a `seq` lazy b\n  We want to make sure that the free vars of 'b' are not evaluated\n  before 'a', even though the expression is plainly strict in 'b'.\n\n* catch:   catch a b = catch# (lazy a) b\n  Again, it's clear that 'a' will be evaluated strictly (and indeed\n  applied to a state token) but we want to make sure that any exceptions\n  arising from the evaluation of 'a' are caught by the catch (see\n  Trac #11555).\n\nImplementing 'lazy' is a bit tricky:\n\n* It must not have a strictness signature: by being a built-in Id,\n  all the info about lazyId comes from here, not from GHC.Base.hi.\n  This is important, because the strictness analyser will spot it as\n  strict!\n\n* It must not have an unfolding: it gets \"inlined\" by a HACK in\n  CorePrep. It's very important to do this inlining *after* unfoldings\n  are exposed in the interface file.  Otherwise, the unfolding for\n  (say) pseq in the interface file will not mention 'lazy', so if we\n  inline 'pseq' we'll totally miss the very thing that 'lazy' was\n  there for in the first place. See Trac #3259 for a real world\n  example.\n\n* Suppose CorePrep sees (catch# (lazy e) b).  At all costs we must\n  avoid using call by value here:\n     case e of r -> catch# r b\n  Avoiding that is the whole point of 'lazy'.  So in CorePrep (which\n  generate the 'case' expression for a call-by-value call) we must\n  spot the 'lazy' on the arg (in CorePrep.cpeApp), and build a 'let'\n  instead.\n\n* lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it\n  appears un-applied, we'll end up just calling it.\n\nNote [noinlineId magic]\n~~~~~~~~~~~~~~~~~~~~~~~\nnoinline :: forall a. a -> a\n\n'noinline' is used to make sure that a function f is never inlined,\ne.g., as in 'noinline f x'.  Ordinarily, the identity function with NOINLINE\ncould be used to achieve this effect; however, this has the unfortunate\nresult of leaving a (useless) call to noinline at runtime.  So we have\na little bit of magic to optimize away 'noinline' after we are done\nrunning the simplifier.\n\n'noinline' needs to be wired-in because it gets inserted automatically\nwhen we serialize an expression to the interface format. See\nNote [Inlining and hs-boot files] in ToIface\n\nNote [The oneShot function]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the context of making left-folds fuse somewhat okish (see ticket #7994\nand Note [Left folds via right fold]) it was determined that it would be useful\nif library authors could explicitly tell the compiler that a certain lambda is\ncalled at most once. The oneShot function allows that.\n\n'oneShot' is levity-polymorphic, i.e. the type variables can refer to unlifted\ntypes as well (Trac #10744); e.g.\n   oneShot (\\x:Int# -> x +# 1#)\n\nLike most magic functions it has a compulsory unfolding, so there is no need\nfor a real definition somewhere. We have one in GHC.Magic for the convenience\nof putting the documentation there.\n\nIt uses `setOneShotLambda` on the lambda's binder. That is the whole magic:\n\nA typical call looks like\n     oneShot (\\y. e)\nafter unfolding the definition `oneShot = \\f \\x[oneshot]. f x` we get\n     (\\f \\x[oneshot]. f x) (\\y. e)\n --> \\x[oneshot]. ((\\y.e) x)\n --> \\x[oneshot] e[x/y]\nwhich is what we want.\n\nIt is only effective if the one-shot info survives as long as possible; in\nparticular it must make it into the interface in unfoldings. See Note [Preserve\nOneShotInfo] in CoreTidy.\n\nAlso see https://ghc.haskell.org/trac/ghc/wiki/OneShot.\n\n\nNote [magicDictId magic]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nThe identifier `magicDict` is just a place-holder, which is used to\nimplement a primitive that we cannot define in Haskell but we can write\nin Core.  It is declared with a place-holder type:\n\n    magicDict :: forall a. a\n\nThe intention is that the identifier will be used in a very specific way,\nto create dictionaries for classes with a single method.  Consider a class\nlike this:\n\n   class C a where\n     f :: T a\n\nWe are going to use `magicDict`, in conjunction with a built-in Prelude\nrule, to cast values of type `T a` into dictionaries for `C a`.  To do\nthis, we define a function like this in the library:\n\n  data WrapC a b = WrapC (C a => Proxy a -> b)\n\n  withT :: (C a => Proxy a -> b)\n        ->  T a -> Proxy a -> b\n  withT f x y = magicDict (WrapC f) x y\n\nThe purpose of `WrapC` is to avoid having `f` instantiated.\nAlso, it avoids impredicativity, because `magicDict`'s type\ncannot be instantiated with a forall.  The field of `WrapC` contains\na `Proxy` parameter which is used to link the type of the constraint,\n`C a`, with the type of the `Wrap` value being made.\n\nNext, we add a built-in Prelude rule (see prelude/PrelRules.hs),\nwhich will replace the RHS of this definition with the appropriate\ndefinition in Core.  The rewrite rule works as follows:\n\n  magicDict @t (wrap @a @b f) x y\n---->\n  f (x `cast` co a) y\n\nThe `co` coercion is the newtype-coercion extracted from the type-class.\nThe type class is obtain by looking at the type of wrap.\n\n\n-------------------------------------------------------------\n@realWorld#@ used to be a magic literal, \\tr{void#}.  If things get\nnasty as-is, change it back to a literal (@Literal@).\n\nvoidArgId is a Local Id used simply as an argument in functions\nwhere we just want an arg to avoid having a thunk of unlifted type.\nE.g.\n        x = \\ void :: Void# -> (# p, q #)\n\nThis comes up in strictness analysis\n\nNote [evaldUnfoldings]\n~~~~~~~~~~~~~~~~~~~~~~\nThe evaldUnfolding makes it look that some primitive value is\nevaluated, which in turn makes Simplify.interestingArg return True,\nwhich in turn makes INLINE things applied to said value likely to be\ninlined.\n-}\n\nrealWorldPrimId :: Id   -- :: State# RealWorld\nrealWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy\n                     (noCafIdInfo `setUnfoldingInfo` evaldUnfolding    -- Note [evaldUnfoldings]\n                                  `setOneShotInfo` stateHackOneShot\n                                  `setNeverLevPoly` realWorldStatePrimTy)\n\nvoidPrimId :: Id     -- Global constant :: Void#\nvoidPrimId  = pcMiscPrelId voidPrimIdName voidPrimTy\n                (noCafIdInfo `setUnfoldingInfo` evaldUnfolding     -- Note [evaldUnfoldings]\n                             `setNeverLevPoly`  voidPrimTy)\n\nvoidArgId :: Id       -- Local lambda-bound :: Void#\nvoidArgId = mkSysLocal (fsLit \"void\") voidArgIdKey voidPrimTy\n\ncoercionTokenId :: Id         -- :: () ~ ()\ncoercionTokenId -- Used to replace Coercion terms when we go to STG\n  = pcMiscPrelId coercionTokenName\n                 (mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy])\n                 noCafIdInfo\n\npcMiscPrelId :: Name -> Type -> IdInfo -> Id\npcMiscPrelId name ty info\n  = mkVanillaGlobalWithInfo name ty info\n    -- We lie and say the thing is imported; otherwise, we get into\n    -- a mess with dependency analysis; e.g., core2stg may heave in\n    -- random calls to GHCbase.unpackPS__.  If GHCbase is the module\n    -- being compiled, then it's just a matter of luck if the definition\n    -- will be in \"the right place\" to be in scope.\n", "num_lines": 1667}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow, 2004-2006\n\n\nModule\n~~~~~~~~~~\nSimply the name of a module, represented as a FastString.\nThese are Uniquable, hence we can build Maps with Modules as\nthe keys.\n-}\n\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule Module\n    (\n        -- * The ModuleName type\n        ModuleName,\n        pprModuleName,\n        moduleNameFS,\n        moduleNameString,\n        moduleNameSlashes, moduleNameColons,\n        moduleStableString,\n        moduleFreeHoles,\n        moduleIsDefinite,\n        mkModuleName,\n        mkModuleNameFS,\n        stableModuleNameCmp,\n\n        -- * The UnitId type\n        ComponentId(..),\n        UnitId(..),\n        unitIdFS,\n        unitIdKey,\n        IndefUnitId(..),\n        IndefModule(..),\n        indefUnitIdToUnitId,\n        indefModuleToModule,\n        InstalledUnitId(..),\n        toInstalledUnitId,\n        ShHoleSubst,\n\n        unitIdIsDefinite,\n        unitIdString,\n        unitIdFreeHoles,\n\n        newUnitId,\n        newIndefUnitId,\n        newSimpleUnitId,\n        hashUnitId,\n        fsToUnitId,\n        stringToUnitId,\n        stableUnitIdCmp,\n\n        -- * HOLE renaming\n        renameHoleUnitId,\n        renameHoleModule,\n        renameHoleUnitId',\n        renameHoleModule',\n\n        -- * Generalization\n        splitModuleInsts,\n        splitUnitIdInsts,\n        generalizeIndefUnitId,\n        generalizeIndefModule,\n\n        -- * Parsers\n        parseModuleName,\n        parseUnitId,\n        parseComponentId,\n        parseModuleId,\n        parseModSubst,\n\n        -- * Wired-in UnitIds\n        -- $wired_in_packages\n        primUnitId,\n        integerUnitId,\n        baseUnitId,\n        rtsUnitId,\n        thUnitId,\n        mainUnitId,\n        thisGhcUnitId,\n        isHoleModule,\n        interactiveUnitId, isInteractiveModule,\n        wiredInUnitIds,\n\n        -- * The Module type\n        Module(Module),\n        moduleUnitId, moduleName,\n        pprModule,\n        mkModule,\n        mkHoleModule,\n        stableModuleCmp,\n        HasModule(..),\n        ContainsModule(..),\n\n        -- * Installed unit ids and modules\n        InstalledModule(..),\n        InstalledModuleEnv,\n        installedModuleEq,\n        installedUnitIdEq,\n        installedUnitIdString,\n        fsToInstalledUnitId,\n        componentIdToInstalledUnitId,\n        stringToInstalledUnitId,\n        emptyInstalledModuleEnv,\n        lookupInstalledModuleEnv,\n        extendInstalledModuleEnv,\n        filterInstalledModuleEnv,\n        delInstalledModuleEnv,\n        DefUnitId(..),\n\n        -- * The ModuleLocation type\n        ModLocation(..),\n        addBootSuffix, addBootSuffix_maybe,\n        addBootSuffixLocn, addBootSuffixLocnOut,\n\n        -- * Module mappings\n        ModuleEnv,\n        elemModuleEnv, extendModuleEnv, extendModuleEnvList,\n        extendModuleEnvList_C, plusModuleEnv_C,\n        delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,\n        lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,\n        moduleEnvKeys, moduleEnvElts, moduleEnvToList,\n        unitModuleEnv, isEmptyModuleEnv,\n        extendModuleEnvWith, filterModuleEnv,\n\n        -- * ModuleName mappings\n        ModuleNameEnv, DModuleNameEnv,\n\n        -- * Sets of Modules\n        ModuleSet,\n        emptyModuleSet, mkModuleSet, moduleSetElts,\n        extendModuleSet, extendModuleSetList, delModuleSet,\n        elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet,\n        unitModuleSet\n    ) where\n\nimport GhcPrelude\n\nimport Outputable\nimport Unique\nimport UniqFM\nimport UniqDFM\nimport UniqDSet\nimport FastString\nimport Binary\nimport Util\nimport Data.List\nimport Data.Ord\nimport GHC.PackageDb (BinaryStringRep(..), DbUnitIdModuleRep(..), DbModule(..), DbUnitId(..))\nimport Fingerprint\n\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Char8 as BS.Char8\nimport Encoding\n\nimport qualified Text.ParserCombinators.ReadP as Parse\nimport Text.ParserCombinators.ReadP (ReadP, (<++))\nimport Data.Char (isAlphaNum)\nimport Control.DeepSeq\nimport Data.Coerce\nimport Data.Data\nimport Data.Function\nimport Data.Map (Map)\nimport Data.Set (Set)\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport qualified FiniteMap as Map\nimport System.FilePath\n\nimport {-# SOURCE #-} DynFlags (DynFlags)\nimport {-# SOURCE #-} Packages (componentIdString, improveUnitId, PackageConfigMap, getPackageConfigMap, displayInstalledUnitId)\n\n-- Note [The identifier lexicon]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Unit IDs, installed package IDs, ABI hashes, package names,\n-- versions, there are a *lot* of different identifiers for closely\n-- related things.  What do they all mean? Here's what.  (See also\n-- https://ghc.haskell.org/trac/ghc/wiki/Commentary/Packages/Concepts )\n--\n-- THE IMPORTANT ONES\n--\n-- ComponentId: An opaque identifier provided by Cabal, which should\n-- uniquely identify such things as the package name, the package\n-- version, the name of the component, the hash of the source code\n-- tarball, the selected Cabal flags, GHC flags, direct dependencies of\n-- the component.  These are very similar to InstalledPackageId, but\n-- an 'InstalledPackageId' implies that it identifies a package, while\n-- a package may install multiple components with different\n-- 'ComponentId's.\n--      - Same as Distribution.Package.ComponentId\n--\n-- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names\n-- (ModuleName) to Modules.  This is how the compiler identifies instantiated\n-- components, and also is the main identifier by which GHC identifies things.\n--      - When Backpack is not being used, UnitId = ComponentId.\n--        this means a useful fiction for end-users is that there are\n--        only ever ComponentIds, and some ComponentIds happen to have\n--        more information (UnitIds).\n--      - Same as Language.Haskell.TH.Syntax:PkgName, see\n--          https://ghc.haskell.org/trac/ghc/ticket/10279\n--      - The same as PackageKey in GHC 7.10 (we renamed it because\n--        they don't necessarily identify packages anymore.)\n--      - Same as -this-package-key/-package-name flags\n--      - An InstalledUnitId corresponds to an actual package which\n--        we have installed on disk.  It could be definite or indefinite,\n--        but if it's indefinite, it has nothing instantiated (we\n--        never install partially instantiated units.)\n--\n-- Module/InstalledModule: A UnitId/InstalledUnitId + ModuleName. This is how\n-- the compiler identifies modules (e.g. a Name is a Module + OccName)\n--      - Same as Language.Haskell.TH.Syntax:Module\n--\n-- THE LESS IMPORTANT ONES\n--\n-- PackageName: The \"name\" field in a Cabal file, something like \"lens\".\n--      - Same as Distribution.Package.PackageName\n--      - DIFFERENT FROM Language.Haskell.TH.Syntax:PkgName, see\n--          https://ghc.haskell.org/trac/ghc/ticket/10279\n--      - DIFFERENT FROM -package-name flag\n--      - DIFFERENT FROM the 'name' field in an installed package\n--        information.  This field could more accurately be described\n--        as a munged package name: when it's for the main library\n--        it is the same as the package name, but if it's an internal\n--        library it's a munged combination of the package name and\n--        the component name.\n--\n-- LEGACY ONES\n--\n-- InstalledPackageId: This is what we used to call ComponentId.\n-- It's a still pretty useful concept for packages that have only\n-- one library; in that case the logical InstalledPackageId =\n-- ComponentId.  Also, the Cabal nix-local-build continues to\n-- compute an InstalledPackageId which is then forcibly used\n-- for all components in a package.  This means that if a dependency\n-- from one component in a package changes, the InstalledPackageId\n-- changes: you don't get as fine-grained dependency tracking,\n-- but it means your builds are hermetic.  Eventually, Cabal will\n-- deal completely in components and we can get rid of this.\n--\n-- PackageKey: This is what we used to call UnitId.  We ditched\n-- \"Package\" from the name when we realized that you might want to\n-- assign different \"PackageKeys\" to components from the same package.\n-- (For a brief, non-released period of time, we also called these\n-- UnitKeys).\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Module locations}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Module Location\n--\n-- Where a module lives on the file system: the actual locations\n-- of the .hs, .hi and .o files, if we have them\ndata ModLocation\n   = ModLocation {\n        ml_hs_file   :: Maybe FilePath,\n                -- The source file, if we have one.  Package modules\n                -- probably don't have source files.\n\n        ml_hi_file   :: FilePath,\n                -- Where the .hi file is, whether or not it exists\n                -- yet.  Always of form foo.hi, even if there is an\n                -- hi-boot file (we add the -boot suffix later)\n\n        ml_obj_file  :: FilePath,\n                -- Where the .o file is, whether or not it exists yet.\n                -- (might not exist either because the module hasn't\n                -- been compiled yet, or because it is part of a\n                -- package with a .a file)\n        ml_hie_file  :: FilePath\n  } deriving Show\n\ninstance Outputable ModLocation where\n   ppr = text . show\n\n{-\nFor a module in another package, the hs_file and obj_file\ncomponents of ModLocation are undefined.\n\nThe locations specified by a ModLocation may or may not\ncorrespond to actual files yet: for example, even if the object\nfile doesn't exist, the ModLocation still contains the path to\nwhere the object file will reside if/when it is created.\n-}\n\naddBootSuffix :: FilePath -> FilePath\n-- ^ Add the @-boot@ suffix to .hs, .hi and .o files\naddBootSuffix path = path ++ \"-boot\"\n\naddBootSuffix_maybe :: Bool -> FilePath -> FilePath\n-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@\naddBootSuffix_maybe is_boot path\n | is_boot   = addBootSuffix path\n | otherwise = path\n\naddBootSuffixLocn :: ModLocation -> ModLocation\n-- ^ Add the @-boot@ suffix to all file paths associated with the module\naddBootSuffixLocn locn\n  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)\n         , ml_hi_file  = addBootSuffix (ml_hi_file locn)\n         , ml_obj_file = addBootSuffix (ml_obj_file locn)\n         , ml_hie_file = addBootSuffix (ml_hie_file locn) }\n\naddBootSuffixLocnOut :: ModLocation -> ModLocation\n-- ^ Add the @-boot@ suffix to all output file paths associated with the\n-- module, not including the input file itself\naddBootSuffixLocnOut locn\n  = locn { ml_hi_file  = addBootSuffix (ml_hi_file locn)\n         , ml_obj_file = addBootSuffix (ml_obj_file locn)\n         , ml_hie_file = addBootSuffix (ml_hie_file locn) }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The name of a module}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A ModuleName is essentially a simple string, e.g. @Data.List@.\nnewtype ModuleName = ModuleName FastString\n\ninstance Uniquable ModuleName where\n  getUnique (ModuleName nm) = getUnique nm\n\ninstance Eq ModuleName where\n  nm1 == nm2 = getUnique nm1 == getUnique nm2\n\ninstance Ord ModuleName where\n  nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2\n\ninstance Outputable ModuleName where\n  ppr = pprModuleName\n\ninstance Binary ModuleName where\n  put_ bh (ModuleName fs) = put_ bh fs\n  get bh = do fs <- get bh; return (ModuleName fs)\n\ninstance BinaryStringRep ModuleName where\n  fromStringRep = mkModuleNameFS . mkFastStringByteString\n  toStringRep   = bytesFS . moduleNameFS\n\ninstance Data ModuleName where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"ModuleName\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"ModuleName\"\n\ninstance NFData ModuleName where\n  rnf x = x `seq` ()\n\nstableModuleNameCmp :: ModuleName -> ModuleName -> Ordering\n-- ^ Compares module names lexically, rather than by their 'Unique's\nstableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2\n\npprModuleName :: ModuleName -> SDoc\npprModuleName (ModuleName nm) =\n    getPprStyle $ \\ sty ->\n    if codeStyle sty\n        then ztext (zEncodeFS nm)\n        else ftext nm\n\nmoduleNameFS :: ModuleName -> FastString\nmoduleNameFS (ModuleName mod) = mod\n\nmoduleNameString :: ModuleName -> String\nmoduleNameString (ModuleName mod) = unpackFS mod\n\n-- | Get a string representation of a 'Module' that's unique and stable\n-- across recompilations.\n-- eg. \"$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal\"\nmoduleStableString :: Module -> String\nmoduleStableString Module{..} =\n  \"$\" ++ unitIdString moduleUnitId ++ \"$\" ++ moduleNameString moduleName\n\nmkModuleName :: String -> ModuleName\nmkModuleName s = ModuleName (mkFastString s)\n\nmkModuleNameFS :: FastString -> ModuleName\nmkModuleNameFS s = ModuleName s\n\n-- |Returns the string version of the module name, with dots replaced by slashes.\n--\nmoduleNameSlashes :: ModuleName -> String\nmoduleNameSlashes = dots_to_slashes . moduleNameString\n  where dots_to_slashes = map (\\c -> if c == '.' then pathSeparator else c)\n\n-- |Returns the string version of the module name, with dots replaced by colons.\n--\nmoduleNameColons :: ModuleName -> String\nmoduleNameColons = dots_to_colons . moduleNameString\n  where dots_to_colons = map (\\c -> if c == '.' then ':' else c)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{A fully qualified module}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A Module is a pair of a 'UnitId' and a 'ModuleName'.\n--\n-- Module variables (i.e. @<H>@) which can be instantiated to a\n-- specific module at some later point in time are represented\n-- with 'moduleUnitId' set to 'holeUnitId' (this allows us to\n-- avoid having to make 'moduleUnitId' a partial operation.)\n--\ndata Module = Module {\n   moduleUnitId :: !UnitId,  -- pkg-1.0\n   moduleName :: !ModuleName  -- A.B.C\n  }\n  deriving (Eq, Ord)\n\n-- | Calculate the free holes of a 'Module'.  If this set is non-empty,\n-- this module was defined in an indefinite library that had required\n-- signatures.\n--\n-- If a module has free holes, that means that substitutions can operate on it;\n-- if it has no free holes, substituting over a module has no effect.\nmoduleFreeHoles :: Module -> UniqDSet ModuleName\nmoduleFreeHoles m\n    | isHoleModule m = unitUniqDSet (moduleName m)\n    | otherwise = unitIdFreeHoles (moduleUnitId m)\n\n-- | A 'Module' is definite if it has no free holes.\nmoduleIsDefinite :: Module -> Bool\nmoduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles\n\n-- | Create a module variable at some 'ModuleName'.\n-- See Note [Representation of module/name variables]\nmkHoleModule :: ModuleName -> Module\nmkHoleModule = mkModule holeUnitId\n\ninstance Uniquable Module where\n  getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n)\n\ninstance Outputable Module where\n  ppr = pprModule\n\ninstance Binary Module where\n  put_ bh (Module p n) = put_ bh p >> put_ bh n\n  get bh = do p <- get bh; n <- get bh; return (Module p n)\n\ninstance Data Module where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"Module\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"Module\"\n\ninstance NFData Module where\n  rnf x = x `seq` ()\n\n-- | This gives a stable ordering, as opposed to the Ord instance which\n-- gives an ordering based on the 'Unique's of the components, which may\n-- not be stable from run to run of the compiler.\nstableModuleCmp :: Module -> Module -> Ordering\nstableModuleCmp (Module p1 n1) (Module p2 n2)\n   = (p1 `stableUnitIdCmp`  p2) `thenCmp`\n     (n1 `stableModuleNameCmp` n2)\n\nmkModule :: UnitId -> ModuleName -> Module\nmkModule = Module\n\npprModule :: Module -> SDoc\npprModule mod@(Module p n)  = getPprStyle doc\n where\n  doc sty\n    | codeStyle sty =\n        (if p == mainUnitId\n                then empty -- never qualify the main package in code\n                else ztext (zEncodeFS (unitIdFS p)) <> char '_')\n            <> pprModuleName n\n    | qualModule sty mod =\n        if isHoleModule mod\n            then angleBrackets (pprModuleName n)\n            else ppr (moduleUnitId mod) <> char ':' <> pprModuleName n\n    | otherwise =\n        pprModuleName n\n\nclass ContainsModule t where\n    extractModule :: t -> Module\n\nclass HasModule m where\n    getModule :: m Module\n\ninstance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module where\n  fromDbModule (DbModule uid mod_name)  = mkModule uid mod_name\n  fromDbModule (DbModuleVar mod_name)   = mkHoleModule mod_name\n  fromDbUnitId (DbUnitId cid insts)     = newUnitId cid insts\n  fromDbUnitId (DbInstalledUnitId iuid) = DefiniteUnitId (DefUnitId iuid)\n  -- GHC never writes to the database, so it's not needed\n  toDbModule = error \"toDbModule: not implemented\"\n  toDbUnitId = error \"toDbUnitId: not implemented\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{ComponentId}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A 'ComponentId' consists of the package name, package version, component\n-- ID, the transitive dependencies of the component, and other information to\n-- uniquely identify the source code and build configuration of a component.\n--\n-- This used to be known as an 'InstalledPackageId', but a package can contain\n-- multiple components and a 'ComponentId' uniquely identifies a component\n-- within a package.  When a package only has one component, the 'ComponentId'\n-- coincides with the 'InstalledPackageId'\nnewtype ComponentId        = ComponentId        FastString deriving (Eq, Ord)\n\ninstance BinaryStringRep ComponentId where\n  fromStringRep = ComponentId . mkFastStringByteString\n  toStringRep (ComponentId s) = bytesFS s\n\ninstance Uniquable ComponentId where\n  getUnique (ComponentId n) = getUnique n\n\ninstance Outputable ComponentId where\n  ppr cid@(ComponentId fs) =\n    getPprStyle $ \\sty ->\n    sdocWithDynFlags $ \\dflags ->\n      case componentIdString dflags cid of\n        Just str | not (debugStyle sty) -> text str\n        _ -> ftext fs\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{UnitId}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A unit identifier identifies a (possibly partially) instantiated\n-- library.  It is primarily used as part of 'Module', which in turn\n-- is used in 'Name', which is used to give names to entities when\n-- typechecking.\n--\n-- There are two possible forms for a 'UnitId'.  It can be a\n-- 'DefiniteUnitId', in which case we just have a string that uniquely\n-- identifies some fully compiled, installed library we have on disk.\n-- However, when we are typechecking a library with missing holes,\n-- we may need to instantiate a library on the fly (in which case\n-- we don't have any on-disk representation.)  In that case, you\n-- have an 'IndefiniteUnitId', which explicitly records the\n-- instantiation, so that we can substitute over it.\ndata UnitId\n    = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId\n    |   DefiniteUnitId {-# UNPACK #-} !DefUnitId\n\nunitIdFS :: UnitId -> FastString\nunitIdFS (IndefiniteUnitId x) = indefUnitIdFS x\nunitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x\n\nunitIdKey :: UnitId -> Unique\nunitIdKey (IndefiniteUnitId x) = indefUnitIdKey x\nunitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x\n\n-- | A unit identifier which identifies an indefinite\n-- library (with holes) that has been *on-the-fly* instantiated\n-- with a substitution 'indefUnitIdInsts'.  In fact, an indefinite\n-- unit identifier could have no holes, but we haven't gotten\n-- around to compiling the actual library yet.\n--\n-- An indefinite unit identifier pretty-prints to something like\n-- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'ComponentId', and the\n-- brackets enclose the module substitution).\ndata IndefUnitId\n    = IndefUnitId {\n        -- | A private, uniquely identifying representation of\n        -- a UnitId.  This string is completely private to GHC\n        -- and is just used to get a unique; in particular, we don't use it for\n        -- symbols (indefinite libraries are not compiled).\n        indefUnitIdFS :: FastString,\n        -- | Cached unique of 'unitIdFS'.\n        indefUnitIdKey :: Unique,\n        -- | The component identity of the indefinite library that\n        -- is being instantiated.\n        indefUnitIdComponentId :: !ComponentId,\n        -- | The sorted (by 'ModuleName') instantiations of this library.\n        indefUnitIdInsts :: ![(ModuleName, Module)],\n        -- | A cache of the free module variables of 'unitIdInsts'.\n        -- This lets us efficiently tell if a 'UnitId' has been\n        -- fully instantiated (free module variables are empty)\n        -- and whether or not a substitution can have any effect.\n        indefUnitIdFreeHoles :: UniqDSet ModuleName\n    }\n\ninstance Eq IndefUnitId where\n  u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2\n\ninstance Ord IndefUnitId where\n  u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2\n\ninstance Binary IndefUnitId where\n  put_ bh indef = do\n    put_ bh (indefUnitIdComponentId indef)\n    put_ bh (indefUnitIdInsts indef)\n  get bh = do\n    cid   <- get bh\n    insts <- get bh\n    let fs = hashUnitId cid insts\n    return IndefUnitId {\n            indefUnitIdComponentId = cid,\n            indefUnitIdInsts = insts,\n            indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),\n            indefUnitIdFS = fs,\n            indefUnitIdKey = getUnique fs\n           }\n\n-- | Create a new 'IndefUnitId' given an explicit module substitution.\nnewIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId\nnewIndefUnitId cid insts =\n    IndefUnitId {\n        indefUnitIdComponentId = cid,\n        indefUnitIdInsts = sorted_insts,\n        indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),\n        indefUnitIdFS = fs,\n        indefUnitIdKey = getUnique fs\n    }\n  where\n     fs = hashUnitId cid sorted_insts\n     sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts\n\n-- | Injects an 'IndefUnitId' (indefinite library which\n-- was on-the-fly instantiated) to a 'UnitId' (either\n-- an indefinite or definite library).\nindefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId\nindefUnitIdToUnitId dflags iuid =\n    -- NB: suppose that we want to compare the indefinite\n    -- unit id p[H=impl:H] against p+abcd (where p+abcd\n    -- happens to be the existing, installed version of\n    -- p[H=impl:H].  If we *only* wrap in p[H=impl:H]\n    -- IndefiniteUnitId, they won't compare equal; only\n    -- after improvement will the equality hold.\n    improveUnitId (getPackageConfigMap dflags) $\n        IndefiniteUnitId iuid\n\ndata IndefModule = IndefModule {\n        indefModuleUnitId :: IndefUnitId,\n        indefModuleName   :: ModuleName\n    } deriving (Eq, Ord)\n\ninstance Outputable IndefModule where\n  ppr (IndefModule uid m) =\n    ppr uid <> char ':' <> ppr m\n\n-- | Injects an 'IndefModule' to 'Module' (see also\n-- 'indefUnitIdToUnitId'.\nindefModuleToModule :: DynFlags -> IndefModule -> Module\nindefModuleToModule dflags (IndefModule iuid mod_name) =\n    mkModule (indefUnitIdToUnitId dflags iuid) mod_name\n\n-- | An installed unit identifier identifies a library which has\n-- been installed to the package database.  These strings are\n-- provided to us via the @-this-unit-id@ flag.  The library\n-- in question may be definite or indefinite; if it is indefinite,\n-- none of the holes have been filled (we never install partially\n-- instantiated libraries.)  Put another way, an installed unit id\n-- is either fully instantiated, or not instantiated at all.\n--\n-- Installed unit identifiers look something like @p+af23SAj2dZ219@,\n-- or maybe just @p@ if they don't use Backpack.\nnewtype InstalledUnitId =\n    InstalledUnitId {\n      -- | The full hashed unit identifier, including the component id\n      -- and the hash.\n      installedUnitIdFS :: FastString\n    }\n\ninstance Binary InstalledUnitId where\n  put_ bh (InstalledUnitId fs) = put_ bh fs\n  get bh = do fs <- get bh; return (InstalledUnitId fs)\n\ninstance BinaryStringRep InstalledUnitId where\n  fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)\n  -- GHC doesn't write to database\n  toStringRep   = error \"BinaryStringRep InstalledUnitId: not implemented\"\n\ninstance Eq InstalledUnitId where\n    uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2\n\ninstance Ord InstalledUnitId where\n    u1 `compare` u2 = installedUnitIdFS u1 `compare` installedUnitIdFS u2\n\ninstance Uniquable InstalledUnitId where\n    getUnique = installedUnitIdKey\n\ninstance Outputable InstalledUnitId where\n    ppr uid@(InstalledUnitId fs) =\n        getPprStyle $ \\sty ->\n        sdocWithDynFlags $ \\dflags ->\n          case displayInstalledUnitId dflags uid of\n            Just str | not (debugStyle sty) -> text str\n            _ -> ftext fs\n\ninstalledUnitIdKey :: InstalledUnitId -> Unique\ninstalledUnitIdKey = getUnique . installedUnitIdFS\n\n-- | Lossy conversion to the on-disk 'InstalledUnitId' for a component.\ntoInstalledUnitId :: UnitId -> InstalledUnitId\ntoInstalledUnitId (DefiniteUnitId (DefUnitId iuid)) = iuid\ntoInstalledUnitId (IndefiniteUnitId indef) =\n    componentIdToInstalledUnitId (indefUnitIdComponentId indef)\n\ninstalledUnitIdString :: InstalledUnitId -> String\ninstalledUnitIdString = unpackFS . installedUnitIdFS\n\ninstance Outputable IndefUnitId where\n    ppr uid =\n      -- getPprStyle $ \\sty ->\n      ppr cid <>\n        (if not (null insts) -- pprIf\n          then\n            brackets (hcat\n                (punctuate comma $\n                    [ ppr modname <> text \"=\" <> ppr m\n                    | (modname, m) <- insts]))\n          else empty)\n     where\n      cid   = indefUnitIdComponentId uid\n      insts = indefUnitIdInsts uid\n\n-- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.\ndata InstalledModule = InstalledModule {\n   installedModuleUnitId :: !InstalledUnitId,\n   installedModuleName :: !ModuleName\n  }\n  deriving (Eq, Ord)\n\ninstance Outputable InstalledModule where\n  ppr (InstalledModule p n) =\n    ppr p <> char ':' <> pprModuleName n\n\nfsToInstalledUnitId :: FastString -> InstalledUnitId\nfsToInstalledUnitId fs = InstalledUnitId fs\n\ncomponentIdToInstalledUnitId :: ComponentId -> InstalledUnitId\ncomponentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs\n\nstringToInstalledUnitId :: String -> InstalledUnitId\nstringToInstalledUnitId = fsToInstalledUnitId . mkFastString\n\n-- | Test if a 'Module' corresponds to a given 'InstalledModule',\n-- modulo instantiation.\ninstalledModuleEq :: InstalledModule -> Module -> Bool\ninstalledModuleEq imod mod =\n    fst (splitModuleInsts mod) == imod\n\n-- | Test if a 'UnitId' corresponds to a given 'InstalledUnitId',\n-- modulo instantiation.\ninstalledUnitIdEq :: InstalledUnitId -> UnitId -> Bool\ninstalledUnitIdEq iuid uid =\n    fst (splitUnitIdInsts uid) == iuid\n\n-- | A 'DefUnitId' is an 'InstalledUnitId' with the invariant that\n-- it only refers to a definite library; i.e., one we have generated\n-- code for.\nnewtype DefUnitId = DefUnitId { unDefUnitId :: InstalledUnitId }\n    deriving (Eq, Ord)\n\ninstance Outputable DefUnitId where\n    ppr (DefUnitId uid) = ppr uid\n\ninstance Binary DefUnitId where\n    put_ bh (DefUnitId uid) = put_ bh uid\n    get bh = do uid <- get bh; return (DefUnitId uid)\n\n-- | A map keyed off of 'InstalledModule'\nnewtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)\n\nemptyInstalledModuleEnv :: InstalledModuleEnv a\nemptyInstalledModuleEnv = InstalledModuleEnv Map.empty\n\nlookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a\nlookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e\n\nextendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a\nextendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)\n\nfilterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a\nfilterInstalledModuleEnv f (InstalledModuleEnv e) =\n  InstalledModuleEnv (Map.filterWithKey f e)\n\ndelInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a\ndelInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)\n\n-- Note [UnitId to InstalledUnitId improvement]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Just because a UnitId is definite (has no holes) doesn't\n-- mean it's necessarily a InstalledUnitId; it could just be\n-- that over the course of renaming UnitIds on the fly\n-- while typechecking an indefinite library, we\n-- ended up with a fully instantiated unit id with no hash,\n-- since we haven't built it yet.  This is fine.\n--\n-- However, if there is a hashed unit id for this instantiation\n-- in the package database, we *better use it*, because\n-- that hashed unit id may be lurking in another interface,\n-- and chaos will ensue if we attempt to compare the two\n-- (the unitIdFS for a UnitId never corresponds to a Cabal-provided\n-- hash of a compiled instantiated library).\n--\n-- There is one last niggle: improvement based on the package database means\n-- that we might end up developing on a package that is not transitively\n-- depended upon by the packages the user specified directly via command line\n-- flags.  This could lead to strange and difficult to understand bugs if those\n-- instantiations are out of date.  The solution is to only improve a\n-- unit id if the new unit id is part of the 'preloadClosure'; i.e., the\n-- closure of all the packages which were explicitly specified.\n\n-- | Retrieve the set of free holes of a 'UnitId'.\nunitIdFreeHoles :: UnitId -> UniqDSet ModuleName\nunitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x\n-- Hashed unit ids are always fully instantiated\nunitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet\n\ninstance Show UnitId where\n    show = unitIdString\n\n-- | A 'UnitId' is definite if it has no free holes.\nunitIdIsDefinite :: UnitId -> Bool\nunitIdIsDefinite = isEmptyUniqDSet . unitIdFreeHoles\n\n-- | Generate a uniquely identifying 'FastString' for a unit\n-- identifier.  This is a one-way function.  You can rely on one special\n-- property: if a unit identifier is in most general form, its 'FastString'\n-- coincides with its 'ComponentId'.  This hash is completely internal\n-- to GHC and is not used for symbol names or file paths.\nhashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString\nhashUnitId cid sorted_holes =\n    mkFastStringByteString\n  . fingerprintUnitId (toStringRep cid)\n  $ rawHashUnitId sorted_holes\n\n-- | Generate a hash for a sorted module substitution.\nrawHashUnitId :: [(ModuleName, Module)] -> Fingerprint\nrawHashUnitId sorted_holes =\n    fingerprintByteString\n  . BS.concat $ do\n        (m, b) <- sorted_holes\n        [ toStringRep m,                BS.Char8.singleton ' ',\n          bytesFS (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',\n          toStringRep (moduleName b),   BS.Char8.singleton '\\n']\n\nfingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString\nfingerprintUnitId prefix (Fingerprint a b)\n    = BS.concat\n    $ [ prefix\n      , BS.Char8.singleton '-'\n      , BS.Char8.pack (toBase62Padded a)\n      , BS.Char8.pack (toBase62Padded b) ]\n\n-- | Create a new, un-hashed unit identifier.\nnewUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId\nnewUnitId cid [] = newSimpleUnitId cid -- TODO: this indicates some latent bug...\nnewUnitId cid insts = IndefiniteUnitId $ newIndefUnitId cid insts\n\npprUnitId :: UnitId -> SDoc\npprUnitId (DefiniteUnitId uid) = ppr uid\npprUnitId (IndefiniteUnitId uid) = ppr uid\n\ninstance Eq UnitId where\n  uid1 == uid2 = unitIdKey uid1 == unitIdKey uid2\n\ninstance Uniquable UnitId where\n  getUnique = unitIdKey\n\ninstance Ord UnitId where\n  nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2\n\ninstance Data UnitId where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"UnitId\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"UnitId\"\n\ninstance NFData UnitId where\n  rnf x = x `seq` ()\n\nstableUnitIdCmp :: UnitId -> UnitId -> Ordering\n-- ^ Compares package ids lexically, rather than by their 'Unique's\nstableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2\n\ninstance Outputable UnitId where\n   ppr pk = pprUnitId pk\n\n-- Performance: would prefer to have a NameCache like thing\ninstance Binary UnitId where\n  put_ bh (DefiniteUnitId def_uid) = do\n    putByte bh 0\n    put_ bh def_uid\n  put_ bh (IndefiniteUnitId indef_uid) = do\n    putByte bh 1\n    put_ bh indef_uid\n  get bh = do b <- getByte bh\n              case b of\n                0 -> fmap DefiniteUnitId   (get bh)\n                _ -> fmap IndefiniteUnitId (get bh)\n\ninstance Binary ComponentId where\n  put_ bh (ComponentId fs) = put_ bh fs\n  get bh = do { fs <- get bh; return (ComponentId fs) }\n\n-- | Create a new simple unit identifier (no holes) from a 'ComponentId'.\nnewSimpleUnitId :: ComponentId -> UnitId\nnewSimpleUnitId (ComponentId fs) = fsToUnitId fs\n\n-- | Create a new simple unit identifier from a 'FastString'.  Internally,\n-- this is primarily used to specify wired-in unit identifiers.\nfsToUnitId :: FastString -> UnitId\nfsToUnitId = DefiniteUnitId . DefUnitId . InstalledUnitId\n\nstringToUnitId :: String -> UnitId\nstringToUnitId = fsToUnitId . mkFastString\n\nunitIdString :: UnitId -> String\nunitIdString = unpackFS . unitIdFS\n\n{-\n************************************************************************\n*                                                                      *\n                        Hole substitutions\n*                                                                      *\n************************************************************************\n-}\n\n-- | Substitution on module variables, mapping module names to module\n-- identifiers.\ntype ShHoleSubst = ModuleNameEnv Module\n\n-- | Substitutes holes in a 'Module'.  NOT suitable for being called\n-- directly on a 'nameModule', see Note [Representation of module/name variable].\n-- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;\n-- similarly, @<A>@ maps to @q():A@.\nrenameHoleModule :: DynFlags -> ShHoleSubst -> Module -> Module\nrenameHoleModule dflags = renameHoleModule' (getPackageConfigMap dflags)\n\n-- | Substitutes holes in a 'UnitId', suitable for renaming when\n-- an include occurs; see Note [Representation of module/name variable].\n--\n-- @p[A=<A>]@ maps to @p[A=<B>]@ with @A=<B>@.\nrenameHoleUnitId :: DynFlags -> ShHoleSubst -> UnitId -> UnitId\nrenameHoleUnitId dflags = renameHoleUnitId' (getPackageConfigMap dflags)\n\n-- | Like 'renameHoleModule', but requires only 'PackageConfigMap'\n-- so it can be used by \"Packages\".\nrenameHoleModule' :: PackageConfigMap -> ShHoleSubst -> Module -> Module\nrenameHoleModule' pkg_map env m\n  | not (isHoleModule m) =\n        let uid = renameHoleUnitId' pkg_map env (moduleUnitId m)\n        in mkModule uid (moduleName m)\n  | Just m' <- lookupUFM env (moduleName m) = m'\n  -- NB m = <Blah>, that's what's in scope.\n  | otherwise = m\n\n-- | Like 'renameHoleUnitId, but requires only 'PackageConfigMap'\n-- so it can be used by \"Packages\".\nrenameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId\nrenameHoleUnitId' pkg_map env uid =\n    case uid of\n      (IndefiniteUnitId\n        IndefUnitId{ indefUnitIdComponentId = cid\n                   , indefUnitIdInsts       = insts\n                   , indefUnitIdFreeHoles   = fh })\n          -> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)\n                then uid\n                -- Functorially apply the substitution to the instantiation,\n                -- then check the 'PackageConfigMap' to see if there is\n                -- a compiled version of this 'UnitId' we can improve to.\n                -- See Note [UnitId to InstalledUnitId] improvement\n                else improveUnitId pkg_map $\n                        newUnitId cid\n                            (map (\\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)\n      _ -> uid\n\n-- | Given a possibly on-the-fly instantiated module, split it into\n-- a 'Module' that we definitely can find on-disk, as well as an\n-- instantiation if we need to instantiate it on the fly.  If the\n-- instantiation is @Nothing@ no on-the-fly renaming is needed.\nsplitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)\nsplitModuleInsts m =\n    let (uid, mb_iuid) = splitUnitIdInsts (moduleUnitId m)\n    in (InstalledModule uid (moduleName m),\n        fmap (\\iuid -> IndefModule iuid (moduleName m)) mb_iuid)\n\n-- | See 'splitModuleInsts'.\nsplitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)\nsplitUnitIdInsts (IndefiniteUnitId iuid) =\n    (componentIdToInstalledUnitId (indefUnitIdComponentId iuid), Just iuid)\nsplitUnitIdInsts (DefiniteUnitId (DefUnitId uid)) = (uid, Nothing)\n\ngeneralizeIndefUnitId :: IndefUnitId -> IndefUnitId\ngeneralizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid\n                                 , indefUnitIdInsts = insts } =\n    newIndefUnitId cid (map (\\(m,_) -> (m, mkHoleModule m)) insts)\n\ngeneralizeIndefModule :: IndefModule -> IndefModule\ngeneralizeIndefModule (IndefModule uid n) = IndefModule (generalizeIndefUnitId uid) n\n\nparseModuleName :: ReadP ModuleName\nparseModuleName = fmap mkModuleName\n                $ Parse.munch1 (\\c -> isAlphaNum c || c `elem` \"_.\")\n\nparseUnitId :: ReadP UnitId\nparseUnitId = parseFullUnitId <++ parseDefiniteUnitId <++ parseSimpleUnitId\n  where\n    parseFullUnitId = do\n        cid <- parseComponentId\n        insts <- parseModSubst\n        return (newUnitId cid insts)\n    parseDefiniteUnitId = do\n        s <- Parse.munch1 (\\c -> isAlphaNum c || c `elem` \"-_.+\")\n        return (stringToUnitId s)\n    parseSimpleUnitId = do\n        cid <- parseComponentId\n        return (newSimpleUnitId cid)\n\nparseComponentId :: ReadP ComponentId\nparseComponentId = (ComponentId . mkFastString)  `fmap` Parse.munch1 abi_char\n   where abi_char c = isAlphaNum c || c `elem` \"-_.\"\n\nparseModuleId :: ReadP Module\nparseModuleId = parseModuleVar <++ parseModule\n    where\n      parseModuleVar = do\n        _ <- Parse.char '<'\n        modname <- parseModuleName\n        _ <- Parse.char '>'\n        return (mkHoleModule modname)\n      parseModule = do\n        uid <- parseUnitId\n        _ <- Parse.char ':'\n        modname <- parseModuleName\n        return (mkModule uid modname)\n\nparseModSubst :: ReadP [(ModuleName, Module)]\nparseModSubst = Parse.between (Parse.char '[') (Parse.char ']')\n      . flip Parse.sepBy (Parse.char ',')\n      $ do k <- parseModuleName\n           _ <- Parse.char '='\n           v <- parseModuleId\n           return (k, v)\n\n\n{-\nNote [Wired-in packages]\n~~~~~~~~~~~~~~~~~~~~~~~~\n\nCertain packages are known to the compiler, in that we know about certain\nentities that reside in these packages, and the compiler needs to\ndeclare static Modules and Names that refer to these packages.  Hence\nthe wired-in packages can't include version numbers in their package UnitId,\nsince we don't want to bake the version numbers of these packages into GHC.\n\nSo here's the plan.  Wired-in packages are still versioned as\nnormal in the packages database, and you can still have multiple\nversions of them installed. To the user, everything looks normal.\n\nHowever, for each invocation of GHC, only a single instance of each wired-in\npackage will be recognised (the desired one is selected via\n@-package@\\/@-hide-package@), and GHC will internall pretend that it has the\n*unversioned* 'UnitId', including in .hi files and object file symbols.\n\nUnselected versions of wired-in packages will be ignored, as will any other\npackage that depends directly or indirectly on it (much as if you\nhad used @-ignore-package@).\n\nThe affected packages are compiled with, e.g., @-this-unit-id base@, so that\nthe symbols in the object files have the unversioned unit id in their name.\n\nMake sure you change 'Packages.findWiredInPackages' if you add an entry here.\n\nFor `integer-gmp`/`integer-simple` we also change the base name to\n`integer-wired-in`, but this is fundamentally no different.\nSee Note [The integer library] in PrelNames.\n-}\n\nintegerUnitId, primUnitId,\n  baseUnitId, rtsUnitId,\n  thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId\nprimUnitId        = fsToUnitId (fsLit \"ghc-prim\")\nintegerUnitId     = fsToUnitId (fsLit \"integer-wired-in\")\n   -- See Note [The integer library] in PrelNames\nbaseUnitId        = fsToUnitId (fsLit \"base\")\nrtsUnitId         = fsToUnitId (fsLit \"rts\")\nthUnitId          = fsToUnitId (fsLit \"template-haskell\")\nthisGhcUnitId     = fsToUnitId (fsLit \"ghc\")\ninteractiveUnitId = fsToUnitId (fsLit \"interactive\")\n\n-- | This is the package Id for the current program.  It is the default\n-- package Id if you don't specify a package name.  We don't add this prefix\n-- to symbol names, since there can be only one main package per program.\nmainUnitId      = fsToUnitId (fsLit \"main\")\n\n-- | This is a fake package id used to provide identities to any un-implemented\n-- signatures.  The set of hole identities is global over an entire compilation.\n-- Don't use this directly: use 'mkHoleModule' or 'isHoleModule' instead.\n-- See Note [Representation of module/name variables]\nholeUnitId :: UnitId\nholeUnitId      = fsToUnitId (fsLit \"hole\")\n\nisInteractiveModule :: Module -> Bool\nisInteractiveModule mod = moduleUnitId mod == interactiveUnitId\n\n-- Note [Representation of module/name variables]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent\n-- name holes.  This could have been represented by adding some new cases\n-- to the core data types, but this would have made the existing 'nameModule'\n-- and 'moduleUnitId' partial, which would have required a lot of modifications\n-- to existing code.\n--\n-- Instead, we adopted the following encoding scheme:\n--\n--      <A>   ===> hole:A\n--      {A.T} ===> hole:A.T\n--\n-- This encoding is quite convenient, but it is also a bit dangerous too,\n-- because if you have a 'hole:A' you need to know if it's actually a\n-- 'Module' or just a module stored in a 'Name'; these two cases must be\n-- treated differently when doing substitutions.  'renameHoleModule'\n-- and 'renameHoleUnitId' assume they are NOT operating on a\n-- 'Name'; 'NameShape' handles name substitutions exclusively.\n\nisHoleModule :: Module -> Bool\nisHoleModule mod = moduleUnitId mod == holeUnitId\n\nwiredInUnitIds :: [UnitId]\nwiredInUnitIds = [ primUnitId,\n                       integerUnitId,\n                       baseUnitId,\n                       rtsUnitId,\n                       thUnitId,\n                       thisGhcUnitId ]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{@ModuleEnv@s}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A map keyed off of 'Module's\nnewtype ModuleEnv elt = ModuleEnv (Map NDModule elt)\n\n{-\nNote [ModuleEnv performance and determinism]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTo prevent accidental reintroduction of nondeterminism the Ord instance\nfor Module was changed to not depend on Unique ordering and to use the\nlexicographic order. This is potentially expensive, but when measured\nthere was no difference in performance.\n\nTo be on the safe side and not pessimize ModuleEnv uses nondeterministic\nordering on Module and normalizes by doing the lexicographic sort when\nturning the env to a list.\nSee Note [Unique Determinism] for more information about the source of\nnondeterminismand and Note [Deterministic UniqFM] for explanation of why\nit matters for maps.\n-}\n\nnewtype NDModule = NDModule { unNDModule :: Module }\n  deriving Eq\n  -- A wrapper for Module with faster nondeterministic Ord.\n  -- Don't export, See [ModuleEnv performance and determinism]\n\ninstance Ord NDModule where\n  compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =\n    (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`\n    (getUnique n1 `nonDetCmpUnique` getUnique n2)\n\nfilterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a\nfilterModuleEnv f (ModuleEnv e) =\n  ModuleEnv (Map.filterWithKey (f . unNDModule) e)\n\nelemModuleEnv :: Module -> ModuleEnv a -> Bool\nelemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e\n\nextendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a\nextendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)\n\nextendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a\n                    -> ModuleEnv a\nextendModuleEnvWith f (ModuleEnv e) m x =\n  ModuleEnv (Map.insertWith f (NDModule m) x e)\n\nextendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a\nextendModuleEnvList (ModuleEnv e) xs =\n  ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)\n\nextendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]\n                      -> ModuleEnv a\nextendModuleEnvList_C f (ModuleEnv e) xs =\n  ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)\n\nplusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a\nplusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =\n  ModuleEnv (Map.unionWith f e1 e2)\n\ndelModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a\ndelModuleEnvList (ModuleEnv e) ms =\n  ModuleEnv (Map.deleteList (map NDModule ms) e)\n\ndelModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a\ndelModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)\n\nplusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a\nplusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)\n\nlookupModuleEnv :: ModuleEnv a -> Module -> Maybe a\nlookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e\n\nlookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a\nlookupWithDefaultModuleEnv (ModuleEnv e) x m =\n  Map.findWithDefault x (NDModule m) e\n\nmapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b\nmapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\\_ v -> f v) e)\n\nmkModuleEnv :: [(Module, a)] -> ModuleEnv a\nmkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])\n\nemptyModuleEnv :: ModuleEnv a\nemptyModuleEnv = ModuleEnv Map.empty\n\nmoduleEnvKeys :: ModuleEnv a -> [Module]\nmoduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e\n  -- See Note [ModuleEnv performance and determinism]\n\nmoduleEnvElts :: ModuleEnv a -> [a]\nmoduleEnvElts e = map snd $ moduleEnvToList e\n  -- See Note [ModuleEnv performance and determinism]\n\nmoduleEnvToList :: ModuleEnv a -> [(Module, a)]\nmoduleEnvToList (ModuleEnv e) =\n  sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]\n  -- See Note [ModuleEnv performance and determinism]\n\nunitModuleEnv :: Module -> a -> ModuleEnv a\nunitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)\n\nisEmptyModuleEnv :: ModuleEnv a -> Bool\nisEmptyModuleEnv (ModuleEnv e) = Map.null e\n\n-- | A set of 'Module's\ntype ModuleSet = Set NDModule\n\nmkModuleSet :: [Module] -> ModuleSet\nmkModuleSet = Set.fromList . coerce\n\nextendModuleSet :: ModuleSet -> Module -> ModuleSet\nextendModuleSet s m = Set.insert (NDModule m) s\n\nextendModuleSetList :: ModuleSet -> [Module] -> ModuleSet\nextendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms\n\nemptyModuleSet :: ModuleSet\nemptyModuleSet = Set.empty\n\nmoduleSetElts :: ModuleSet -> [Module]\nmoduleSetElts = sort . coerce . Set.toList\n\nelemModuleSet :: Module -> ModuleSet -> Bool\nelemModuleSet = Set.member . coerce\n\nintersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet\nintersectModuleSet = coerce Set.intersection\n\nminusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet\nminusModuleSet = coerce Set.difference\n\ndelModuleSet :: ModuleSet -> Module -> ModuleSet\ndelModuleSet = coerce (flip Set.delete)\n\nunionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet\nunionModuleSet = coerce Set.union\n\nunitModuleSet :: Module -> ModuleSet\nunitModuleSet = coerce Set.singleton\n\n{-\nA ModuleName has a Unique, so we can build mappings of these using\nUniqFM.\n-}\n\n-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)\ntype ModuleNameEnv elt = UniqFM elt\n\n\n-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)\n-- Has deterministic folds and can be deterministically converted to a list\ntype DModuleNameEnv elt = UniqDFM elt\n", "num_lines": 1304}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[Name]{@Name@: to transmit name info from renamer to typechecker}\n-}\n\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE PatternSynonyms #-}\n\n-- |\n-- #name_types#\n-- GHC uses several kinds of name internally:\n--\n-- * 'OccName.OccName': see \"OccName#name_types\"\n--\n-- * 'RdrName.RdrName': see \"RdrName#name_types\"\n--\n-- *  'Name.Name' is the type of names that have had their scoping and binding resolved. They\n--   have an 'OccName.OccName' but also a 'Unique.Unique' that disambiguates Names that have\n--   the same 'OccName.OccName' and indeed is used for all 'Name.Name' comparison. Names\n--   also contain information about where they originated from, see \"Name#name_sorts\"\n--\n-- * 'Id.Id': see \"Id#name_types\"\n--\n-- * 'Var.Var': see \"Var#name_types\"\n--\n-- #name_sorts#\n-- Names are one of:\n--\n--  * External, if they name things declared in other modules. Some external\n--    Names are wired in, i.e. they name primitives defined in the compiler itself\n--\n--  * Internal, if they name things in the module being compiled. Some internal\n--    Names are system names, if they are names manufactured by the compiler\n\nmodule Name (\n        -- * The main types\n        Name,                                   -- Abstract\n        BuiltInSyntax(..),\n\n        -- ** Creating 'Name's\n        mkSystemName, mkSystemNameAt,\n        mkInternalName, mkClonedInternalName, mkDerivedInternalName,\n        mkSystemVarName, mkSysTvName,\n        mkFCallName,\n        mkExternalName, mkWiredInName,\n\n        -- ** Manipulating and deconstructing 'Name's\n        nameUnique, setNameUnique,\n        nameOccName, nameModule, nameModule_maybe,\n        setNameLoc,\n        tidyNameOcc,\n        localiseName,\n\n        nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,\n\n        -- ** Predicates on 'Name's\n        isSystemName, isInternalName, isExternalName,\n        isTyVarName, isTyConName, isDataConName,\n        isValName, isVarName,\n        isWiredInName, isBuiltInSyntax,\n        isHoleName,\n        wiredInNameTyThing_maybe,\n        nameIsLocalOrFrom, nameIsHomePackage,\n        nameIsHomePackageImport, nameIsFromExternalPackage,\n        stableNameCmp,\n\n        -- * Class 'NamedThing' and overloaded friends\n        NamedThing(..),\n        getSrcLoc, getSrcSpan, getOccString, getOccFS,\n\n        pprInfixName, pprPrefixName, pprModulePrefix, pprNameUnqualified,\n        nameStableString,\n\n        -- Re-export the OccName stuff\n        module OccName\n    ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TyCoRep( TyThing )\n\nimport OccName\nimport Module\nimport SrcLoc\nimport Unique\nimport Util\nimport Maybes\nimport Binary\nimport DynFlags\nimport FastString\nimport Outputable\n\nimport Control.DeepSeq\nimport Data.Data\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Name-datatype]{The @Name@ datatype, and name construction}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A unique, unambiguous name for something, containing information about where\n-- that thing originated.\ndata Name = Name {\n                n_sort :: NameSort,     -- What sort of name it is\n                n_occ  :: !OccName,     -- Its occurrence name\n                n_uniq :: {-# UNPACK #-} !Unique,\n                n_loc  :: !SrcSpan      -- Definition site\n            }\n\n-- NOTE: we make the n_loc field strict to eliminate some potential\n-- (and real!) space leaks, due to the fact that we don't look at\n-- the SrcLoc in a Name all that often.\n\n-- See Note [About the NameSorts]\ndata NameSort\n  = External Module\n\n  | WiredIn Module TyThing BuiltInSyntax\n        -- A variant of External, for wired-in things\n\n  | Internal            -- A user-defined Id or TyVar\n                        -- defined in the module being compiled\n\n  | System              -- A system-defined Id or TyVar.  Typically the\n                        -- OccName is very uninformative (like 's')\n\ninstance Outputable NameSort where\n  ppr (External _)    = text \"external\"\n  ppr (WiredIn _ _ _) = text \"wired-in\"\n  ppr  Internal       = text \"internal\"\n  ppr  System         = text \"system\"\n\ninstance NFData Name where\n  rnf Name{..} = rnf n_sort\n\ninstance NFData NameSort where\n  rnf (External m) = rnf m\n  rnf (WiredIn m t b) = rnf m `seq` t `seq` b `seq` ()\n    -- XXX this is a *lie*, we're not going to rnf the TyThing, but\n    -- since the TyThings for WiredIn Names are all static they can't\n    -- be hiding space leaks or errors.\n  rnf Internal = ()\n  rnf System = ()\n\n-- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples,\n-- which have special syntactic forms.  They aren't in scope\n-- as such.\ndata BuiltInSyntax = BuiltInSyntax | UserSyntax\n\n{-\nNote [About the NameSorts]\n\n1.  Initially, top-level Ids (including locally-defined ones) get External names,\n    and all other local Ids get Internal names\n\n2.  In any invocation of GHC, an External Name for \"M.x\" has one and only one\n    unique.  This unique association is ensured via the Name Cache;\n    see Note [The Name Cache] in IfaceEnv.\n\n3.  Things with a External name are given C static labels, so they finally\n    appear in the .o file's symbol table.  They appear in the symbol table\n    in the form M.n.  If originally-local things have this property they\n    must be made @External@ first.\n\n4.  In the tidy-core phase, a External that is not visible to an importer\n    is changed to Internal, and a Internal that is visible is changed to External\n\n5.  A System Name differs in the following ways:\n        a) has unique attached when printing dumps\n        b) unifier eliminates sys tyvars in favour of user provs where possible\n\n    Before anything gets printed in interface files or output code, it's\n    fed through a 'tidy' processor, which zaps the OccNames to have\n    unique names; and converts all sys-locals to user locals\n    If any desugarer sys-locals have survived that far, they get changed to\n    \"ds1\", \"ds2\", etc.\n\nBuilt-in syntax => It's a syntactic form, not \"in scope\" (e.g. [])\n\nWired-in thing  => The thing (Id, TyCon) is fully known to the compiler,\n                   not read from an interface file.\n                   E.g. Bool, True, Int, Float, and many others\n\nAll built-in syntax is for wired-in things.\n-}\n\ninstance HasOccName Name where\n  occName = nameOccName\n\nnameUnique              :: Name -> Unique\nnameOccName             :: Name -> OccName\nnameModule              :: HasDebugCallStack => Name -> Module\nnameSrcLoc              :: Name -> SrcLoc\nnameSrcSpan             :: Name -> SrcSpan\n\nnameUnique  name = n_uniq name\nnameOccName name = n_occ  name\nnameSrcLoc  name = srcSpanStart (n_loc name)\nnameSrcSpan name = n_loc  name\n\ntype instance SrcSpanLess Name = Name\ninstance HasSrcSpan Name where\n  composeSrcSpan   (L sp  n) = n {n_loc = sp}\n  decomposeSrcSpan n         = L (n_loc n) n\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Predicates on names}\n*                                                                      *\n************************************************************************\n-}\n\nisInternalName    :: Name -> Bool\nisExternalName    :: Name -> Bool\nisSystemName      :: Name -> Bool\nisWiredInName     :: Name -> Bool\n\nisWiredInName (Name {n_sort = WiredIn _ _ _}) = True\nisWiredInName _                               = False\n\nwiredInNameTyThing_maybe :: Name -> Maybe TyThing\nwiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing\nwiredInNameTyThing_maybe _                                   = Nothing\n\nisBuiltInSyntax :: Name -> Bool\nisBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True\nisBuiltInSyntax _                                           = False\n\nisExternalName (Name {n_sort = External _})    = True\nisExternalName (Name {n_sort = WiredIn _ _ _}) = True\nisExternalName _                               = False\n\nisInternalName name = not (isExternalName name)\n\nisHoleName :: Name -> Bool\nisHoleName = isHoleModule . nameModule\n\nnameModule name =\n  nameModule_maybe name `orElse`\n  pprPanic \"nameModule\" (ppr (n_sort name) <+> ppr name)\n\nnameModule_maybe :: Name -> Maybe Module\nnameModule_maybe (Name { n_sort = External mod})    = Just mod\nnameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod\nnameModule_maybe _                                  = Nothing\n\nnameIsLocalOrFrom :: Module -> Name -> Bool\n-- ^ Returns True if the name is\n--   (a) Internal\n--   (b) External but from the specified module\n--   (c) External but from the 'interactive' package\n--\n-- The key idea is that\n--    False means: the entity is defined in some other module\n--                 you can find the details (type, fixity, instances)\n--                     in some interface file\n--                 those details will be stored in the EPT or HPT\n--\n--    True means:  the entity is defined in this module or earlier in\n--                     the GHCi session\n--                 you can find details (type, fixity, instances) in the\n--                     TcGblEnv or TcLclEnv\n--\n-- The isInteractiveModule part is because successive interactions of a GHCi session\n-- each give rise to a fresh module (Ghci1, Ghci2, etc), but they all come\n-- from the magic 'interactive' package; and all the details are kept in the\n-- TcLclEnv, TcGblEnv, NOT in the HPT or EPT.\n-- See Note [The interactive package] in HscTypes\n\nnameIsLocalOrFrom from name\n  | Just mod <- nameModule_maybe name = from == mod || isInteractiveModule mod\n  | otherwise                         = True\n\nnameIsHomePackage :: Module -> Name -> Bool\n-- True if the Name is defined in module of this package\nnameIsHomePackage this_mod\n  = \\nm -> case n_sort nm of\n              External nm_mod    -> moduleUnitId nm_mod == this_pkg\n              WiredIn nm_mod _ _ -> moduleUnitId nm_mod == this_pkg\n              Internal -> True\n              System   -> False\n  where\n    this_pkg = moduleUnitId this_mod\n\nnameIsHomePackageImport :: Module -> Name -> Bool\n-- True if the Name is defined in module of this package\n-- /other than/ the this_mod\nnameIsHomePackageImport this_mod\n  = \\nm -> case nameModule_maybe nm of\n              Nothing -> False\n              Just nm_mod -> nm_mod /= this_mod\n                          && moduleUnitId nm_mod == this_pkg\n  where\n    this_pkg = moduleUnitId this_mod\n\n-- | Returns True if the Name comes from some other package: neither this\n-- package nor the interactive package.\nnameIsFromExternalPackage :: UnitId -> Name -> Bool\nnameIsFromExternalPackage this_pkg name\n  | Just mod <- nameModule_maybe name\n  , moduleUnitId mod /= this_pkg    -- Not this package\n  , not (isInteractiveModule mod)       -- Not the 'interactive' package\n  = True\n  | otherwise\n  = False\n\nisTyVarName :: Name -> Bool\nisTyVarName name = isTvOcc (nameOccName name)\n\nisTyConName :: Name -> Bool\nisTyConName name = isTcOcc (nameOccName name)\n\nisDataConName :: Name -> Bool\nisDataConName name = isDataOcc (nameOccName name)\n\nisValName :: Name -> Bool\nisValName name = isValOcc (nameOccName name)\n\nisVarName :: Name -> Bool\nisVarName = isVarOcc . nameOccName\n\nisSystemName (Name {n_sort = System}) = True\nisSystemName _                        = False\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Making names}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Create a name which is (for now at least) local to the current module and hence\n-- does not need a 'Module' to disambiguate it from other 'Name's\nmkInternalName :: Unique -> OccName -> SrcSpan -> Name\nmkInternalName uniq occ loc = Name { n_uniq = uniq\n                                   , n_sort = Internal\n                                   , n_occ = occ\n                                   , n_loc = loc }\n        -- NB: You might worry that after lots of huffing and\n        -- puffing we might end up with two local names with distinct\n        -- uniques, but the same OccName.  Indeed we can, but that's ok\n        --      * the insides of the compiler don't care: they use the Unique\n        --      * when printing for -ddump-xxx you can switch on -dppr-debug to get the\n        --        uniques if you get confused\n        --      * for interface files we tidyCore first, which makes\n        --        the OccNames distinct when they need to be\n\nmkClonedInternalName :: Unique -> Name -> Name\nmkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc })\n  = Name { n_uniq = uniq, n_sort = Internal\n         , n_occ = occ, n_loc = loc }\n\nmkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name\nmkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })\n  = Name { n_uniq = uniq, n_sort = Internal\n         , n_occ = derive_occ occ, n_loc = loc }\n\n-- | Create a name which definitely originates in the given module\nmkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name\n-- WATCH OUT! External Names should be in the Name Cache\n-- (see Note [The Name Cache] in IfaceEnv), so don't just call mkExternalName\n-- with some fresh unique without populating the Name Cache\nmkExternalName uniq mod occ loc\n  = Name { n_uniq = uniq, n_sort = External mod,\n           n_occ = occ, n_loc = loc }\n\n-- | Create a name which is actually defined by the compiler itself\nmkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name\nmkWiredInName mod occ uniq thing built_in\n  = Name { n_uniq = uniq,\n           n_sort = WiredIn mod thing built_in,\n           n_occ = occ, n_loc = wiredInSrcSpan }\n\n-- | Create a name brought into being by the compiler\nmkSystemName :: Unique -> OccName -> Name\nmkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan\n\nmkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name\nmkSystemNameAt uniq occ loc = Name { n_uniq = uniq, n_sort = System\n                                   , n_occ = occ, n_loc = loc }\n\nmkSystemVarName :: Unique -> FastString -> Name\nmkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)\n\nmkSysTvName :: Unique -> FastString -> Name\nmkSysTvName uniq fs = mkSystemName uniq (mkTyVarOccFS fs)\n\n-- | Make a name for a foreign call\nmkFCallName :: Unique -> String -> Name\nmkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan\n   -- The encoded string completely describes the ccall\n\n-- When we renumber/rename things, we need to be\n-- able to change a Name's Unique to match the cached\n-- one in the thing it's the name of.  If you know what I mean.\nsetNameUnique :: Name -> Unique -> Name\nsetNameUnique name uniq = name {n_uniq = uniq}\n\n-- This is used for hsigs: we want to use the name of the originally exported\n-- entity, but edit the location to refer to the reexport site\nsetNameLoc :: Name -> SrcSpan -> Name\nsetNameLoc name loc = name {n_loc = loc}\n\ntidyNameOcc :: Name -> OccName -> Name\n-- We set the OccName of a Name when tidying\n-- In doing so, we change System --> Internal, so that when we print\n-- it we don't get the unique by default.  It's tidy now!\ntidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}\ntidyNameOcc name                            occ = name { n_occ = occ }\n\n-- | Make the 'Name' into an internal name, regardless of what it was to begin with\nlocaliseName :: Name -> Name\nlocaliseName n = n { n_sort = Internal }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Hashing and comparison}\n*                                                                      *\n************************************************************************\n-}\n\ncmpName :: Name -> Name -> Ordering\ncmpName n1 n2 = n_uniq n1 `nonDetCmpUnique` n_uniq n2\n\n-- | Compare Names lexicographically\n-- This only works for Names that originate in the source code or have been\n-- tidied.\nstableNameCmp :: Name -> Name -> Ordering\nstableNameCmp (Name { n_sort = s1, n_occ = occ1 })\n              (Name { n_sort = s2, n_occ = occ2 })\n  = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2)\n    -- The ordinary compare on OccNames is lexicographic\n  where\n    -- Later constructors are bigger\n    sort_cmp (External m1) (External m2)       = m1 `stableModuleCmp` m2\n    sort_cmp (External {}) _                   = LT\n    sort_cmp (WiredIn {}) (External {})        = GT\n    sort_cmp (WiredIn m1 _ _) (WiredIn m2 _ _) = m1 `stableModuleCmp` m2\n    sort_cmp (WiredIn {})     _                = LT\n    sort_cmp Internal         (External {})    = GT\n    sort_cmp Internal         (WiredIn {})     = GT\n    sort_cmp Internal         Internal         = EQ\n    sort_cmp Internal         System           = LT\n    sort_cmp System           System           = EQ\n    sort_cmp System           _                = GT\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Name-instances]{Instance declarations}\n*                                                                      *\n************************************************************************\n-}\n\n-- | The same comments as for `Name`'s `Ord` instance apply.\ninstance Eq Name where\n    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }\n    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }\n\n-- | __Caution__: This instance is implemented via `nonDetCmpUnique`, which\n-- means that the ordering is not stable across deserialization or rebuilds.\n--\n-- See `nonDetCmpUnique` for further information, and trac #15240 for a bug\n-- caused by improper use of this instance.\n\n-- For a deterministic lexicographic ordering, use `stableNameCmp`.\ninstance Ord Name where\n    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }\n    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }\n    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }\n    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }\n    compare a b = cmpName a b\n\ninstance Uniquable Name where\n    getUnique = nameUnique\n\ninstance NamedThing Name where\n    getName n = n\n\ninstance Data Name where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"Name\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"Name\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Binary}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Assumes that the 'Name' is a non-binding one. See\n-- 'IfaceSyn.putIfaceTopBndr' and 'IfaceSyn.getIfaceTopBndr' for serializing\n-- binding 'Name's. See 'UserData' for the rationale for this distinction.\ninstance Binary Name where\n   put_ bh name =\n      case getUserData bh of\n        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name\n\n   get bh =\n      case getUserData bh of\n        UserData { ud_get_name = get_name } -> get_name bh\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Pretty printing}\n*                                                                      *\n************************************************************************\n-}\n\ninstance Outputable Name where\n    ppr name = pprName name\n\ninstance OutputableBndr Name where\n    pprBndr _ name = pprName name\n    pprInfixOcc  = pprInfixName\n    pprPrefixOcc = pprPrefixName\n\npprName :: Name -> SDoc\npprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})\n  = getPprStyle $ \\ sty ->\n    case sort of\n      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin\n      External mod            -> pprExternal sty uniq mod occ False UserSyntax\n      System                  -> pprSystem sty uniq occ\n      Internal                -> pprInternal sty uniq occ\n\n-- | Print the string of Name unqualifiedly directly.\npprNameUnqualified :: Name -> SDoc\npprNameUnqualified Name { n_occ = occ } = ppr_occ_name occ\n\npprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc\npprExternal sty uniq mod occ is_wired is_builtin\n  | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ\n        -- In code style, always qualify\n        -- ToDo: maybe we could print all wired-in things unqualified\n        --       in code style, to reduce symbol table bloat?\n  | debugStyle sty = pp_mod <> ppr_occ_name occ\n                     <> braces (hsep [if is_wired then text \"(w)\" else empty,\n                                      pprNameSpaceBrief (occNameSpace occ),\n                                      pprUnique uniq])\n  | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax\n  | otherwise                   =\n        if isHoleModule mod\n            then case qualName sty mod occ of\n                    NameUnqual -> ppr_occ_name occ\n                    _ -> braces (ppr (moduleName mod) <> dot <> ppr_occ_name occ)\n            else pprModulePrefix sty mod occ <> ppr_occ_name occ\n  where\n    pp_mod = sdocWithDynFlags $ \\dflags ->\n             if gopt Opt_SuppressModulePrefixes dflags\n             then empty\n             else ppr mod <> dot\n\npprInternal :: PprStyle -> Unique -> OccName -> SDoc\npprInternal sty uniq occ\n  | codeStyle sty  = pprUniqueAlways uniq\n  | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),\n                                                       pprUnique uniq])\n  | dumpStyle sty  = ppr_occ_name occ <> ppr_underscore_unique uniq\n                        -- For debug dumps, we're not necessarily dumping\n                        -- tidied code, so we need to print the uniques.\n  | otherwise      = ppr_occ_name occ   -- User style\n\n-- Like Internal, except that we only omit the unique in Iface style\npprSystem :: PprStyle -> Unique -> OccName -> SDoc\npprSystem sty uniq occ\n  | codeStyle sty  = pprUniqueAlways uniq\n  | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq\n                     <> braces (pprNameSpaceBrief (occNameSpace occ))\n  | otherwise      = ppr_occ_name occ <> ppr_underscore_unique uniq\n                                -- If the tidy phase hasn't run, the OccName\n                                -- is unlikely to be informative (like 's'),\n                                -- so print the unique\n\n\npprModulePrefix :: PprStyle -> Module -> OccName -> SDoc\n-- Print the \"M.\" part of a name, based on whether it's in scope or not\n-- See Note [Printing original names] in HscTypes\npprModulePrefix sty mod occ = sdocWithDynFlags $ \\dflags ->\n  if gopt Opt_SuppressModulePrefixes dflags\n  then empty\n  else\n    case qualName sty mod occ of              -- See Outputable.QualifyName:\n      NameQual modname -> ppr modname <> dot       -- Name is in scope\n      NameNotInScope1  -> ppr mod <> dot           -- Not in scope\n      NameNotInScope2  -> ppr (moduleUnitId mod) <> colon     -- Module not in\n                          <> ppr (moduleName mod) <> dot          -- scope either\n      NameUnqual       -> empty                   -- In scope unqualified\n\npprUnique :: Unique -> SDoc\n-- Print a unique unless we are suppressing them\npprUnique uniq\n  = sdocWithDynFlags $ \\dflags ->\n    ppUnless (gopt Opt_SuppressUniques dflags) $\n    pprUniqueAlways uniq\n\nppr_underscore_unique :: Unique -> SDoc\n-- Print an underscore separating the name from its unique\n-- But suppress it if we aren't printing the uniques anyway\nppr_underscore_unique uniq\n  = sdocWithDynFlags $ \\dflags ->\n    ppUnless (gopt Opt_SuppressUniques dflags) $\n    char '_' <> pprUniqueAlways uniq\n\nppr_occ_name :: OccName -> SDoc\nppr_occ_name occ = ftext (occNameFS occ)\n        -- Don't use pprOccName; instead, just print the string of the OccName;\n        -- we print the namespace in the debug stuff above\n\n-- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are\n-- cached behind the scenes in the FastString implementation.\nppr_z_occ_name :: OccName -> SDoc\nppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))\n\n-- Prints (if mod information is available) \"Defined at <loc>\" or\n--  \"Defined in <mod>\" information for a Name.\npprDefinedAt :: Name -> SDoc\npprDefinedAt name = text \"Defined\" <+> pprNameDefnLoc name\n\npprNameDefnLoc :: Name -> SDoc\n-- Prints \"at <loc>\" or\n--     or \"in <mod>\" depending on what info is available\npprNameDefnLoc name\n  = case nameSrcLoc name of\n         -- nameSrcLoc rather than nameSrcSpan\n         -- It seems less cluttered to show a location\n         -- rather than a span for the definition point\n       RealSrcLoc s -> text \"at\" <+> ppr s\n       UnhelpfulLoc s\n         | isInternalName name || isSystemName name\n         -> text \"at\" <+> ftext s\n         | otherwise\n         -> text \"in\" <+> quotes (ppr (nameModule name))\n\n\n-- | Get a string representation of a 'Name' that's unique and stable\n-- across recompilations. Used for deterministic generation of binds for\n-- derived instances.\n-- eg. \"$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal$String\"\nnameStableString :: Name -> String\nnameStableString Name{..} =\n  nameSortStableString n_sort ++ \"$\" ++ occNameString n_occ\n\nnameSortStableString :: NameSort -> String\nnameSortStableString System = \"$_sys\"\nnameSortStableString Internal = \"$_in\"\nnameSortStableString (External mod) = moduleStableString mod\nnameSortStableString (WiredIn mod _ _) = moduleStableString mod\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Overloaded functions related to Names}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A class allowing convenient access to the 'Name' of various datatypes\nclass NamedThing a where\n    getOccName :: a -> OccName\n    getName    :: a -> Name\n\n    getOccName n = nameOccName (getName n)      -- Default method\n\ninstance NamedThing e => NamedThing (Located e) where\n    getName = getName . unLoc\n\ngetSrcLoc           :: NamedThing a => a -> SrcLoc\ngetSrcSpan          :: NamedThing a => a -> SrcSpan\ngetOccString        :: NamedThing a => a -> String\ngetOccFS            :: NamedThing a => a -> FastString\n\ngetSrcLoc           = nameSrcLoc           . getName\ngetSrcSpan          = nameSrcSpan          . getName\ngetOccString        = occNameString        . getOccName\ngetOccFS            = occNameFS            . getOccName\n\npprInfixName :: (Outputable a, NamedThing a) => a -> SDoc\n-- See Outputable.pprPrefixVar, pprInfixVar;\n-- add parens or back-quotes as appropriate\npprInfixName  n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)\n\npprPrefixName :: NamedThing a => a -> SDoc\npprPrefixName thing = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)\n where\n   name = getName thing\n", "num_lines": 702}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE RankNTypes #-}\n\n-- | The Name Cache\nmodule NameCache\n    ( lookupOrigNameCache\n    , extendOrigNameCache\n    , extendNameCache\n    , initNameCache\n    , NameCache(..), OrigNameCache\n    ) where\n\nimport GhcPrelude\n\nimport Module\nimport Name\nimport UniqSupply\nimport TysWiredIn\nimport Util\nimport Outputable\nimport PrelNames\n\n#include \"HsVersions.h\"\n\n{-\n\nNote [The Name Cache]\n~~~~~~~~~~~~~~~~~~~~~\nThe Name Cache makes sure that, during any invocation of GHC, each\nExternal Name \"M.x\" has one, and only one globally-agreed Unique.\n\n* The first time we come across M.x we make up a Unique and record that\n  association in the Name Cache.\n\n* When we come across \"M.x\" again, we look it up in the Name Cache,\n  and get a hit.\n\nThe functions newGlobalBinder, allocateGlobalBinder do the main work.\nWhen you make an External name, you should probably be calling one\nof them.\n\n\nNote [Built-in syntax and the OrigNameCache]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nBuilt-in syntax like tuples and unboxed sums are quite ubiquitous. To lower\ntheir cost we use two tricks,\n\n  a. We specially encode tuple and sum Names in interface files' symbol tables\n     to avoid having to look up their names while loading interface files.\n     Namely these names are encoded as by their Uniques. We know how to get from\n     a Unique back to the Name which it represents via the mapping defined in\n     the SumTupleUniques module. See Note [Symbol table representation of names]\n     in BinIface and for details.\n\n  b. We don't include them in the Orig name cache but instead parse their\n     OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with\n     them.\n\nWhy is the second measure necessary? Good question; afterall, 1) the parser\nemits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never\nneeds to looked-up during interface loading due to (a). It turns out that there\nare two reasons why we might look up an Orig RdrName for built-in syntax,\n\n  * If you use setRdrNameSpace on an Exact RdrName it may be\n    turned into an Orig RdrName.\n\n  * Template Haskell turns a BuiltInSyntax Name into a TH.NameG\n    (DsMeta.globalVar), and parses a NameG into an Orig RdrName\n    (Convert.thRdrName).  So, e.g. $(do { reify '(,); ... }) will\n    go this route (Trac #8954).\n\n-}\n\n-- | Per-module cache of original 'OccName's given 'Name's\ntype OrigNameCache   = ModuleEnv (OccEnv Name)\n\nlookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name\nlookupOrigNameCache nc mod occ\n  | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE\n  , Just name <- isBuiltInOcc_maybe occ\n  =     -- See Note [Known-key names], 3(c) in PrelNames\n        -- Special case for tuples; there are too many\n        -- of them to pre-populate the original-name cache\n    Just name\n\n  | otherwise\n  = case lookupModuleEnv nc mod of\n        Nothing      -> Nothing\n        Just occ_env -> lookupOccEnv occ_env occ\n\nextendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache\nextendOrigNameCache nc name\n  = ASSERT2( isExternalName name, ppr name )\n    extendNameCache nc (nameModule name) (nameOccName name) name\n\nextendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache\nextendNameCache nc mod occ name\n  = extendModuleEnvWith combine nc mod (unitOccEnv occ name)\n  where\n    combine _ occ_env = extendOccEnv occ_env occ name\n\n-- | The NameCache makes sure that there is just one Unique assigned for\n-- each original name; i.e. (module-name, occ-name) pair and provides\n-- something of a lookup mechanism for those names.\ndata NameCache\n = NameCache {  nsUniqs :: !UniqSupply,\n                -- ^ Supply of uniques\n                nsNames :: !OrigNameCache\n                -- ^ Ensures that one original name gets one unique\n   }\n\n-- | Return a function to atomically update the name cache.\ninitNameCache :: UniqSupply -> [Name] -> NameCache\ninitNameCache us names\n  = NameCache { nsUniqs = us,\n                nsNames = initOrigNames names }\n\ninitOrigNames :: [Name] -> OrigNameCache\ninitOrigNames names = foldl' extendOrigNameCache emptyModuleEnv names\n", "num_lines": 121}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[NameEnv]{@NameEnv@: name environments}\n-}\n\n{-# LANGUAGE CPP #-}\nmodule NameEnv (\n        -- * Var, Id and TyVar environments (maps)\n        NameEnv,\n\n        -- ** Manipulating these environments\n        mkNameEnv,\n        emptyNameEnv, isEmptyNameEnv,\n        unitNameEnv, nameEnvElts,\n        extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,\n        extendNameEnvList, extendNameEnvList_C,\n        filterNameEnv, anyNameEnv,\n        plusNameEnv, plusNameEnv_C, alterNameEnv,\n        lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,\n        elemNameEnv, mapNameEnv, disjointNameEnv,\n\n        DNameEnv,\n\n        emptyDNameEnv,\n        lookupDNameEnv,\n        mapDNameEnv,\n        alterDNameEnv,\n        -- ** Dependency analysis\n        depAnal\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Digraph\nimport Name\nimport UniqFM\nimport UniqDFM\nimport Maybes\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Name environment}\n*                                                                      *\n************************************************************************\n-}\n\n{-\nNote [depAnal determinism]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\ndepAnal is deterministic provided it gets the nodes in a deterministic order.\nThe order of lists that get_defs and get_uses return doesn't matter, as these\nare only used to construct the edges, and stronglyConnCompFromEdgedVertices is\ndeterministic even when the edges are not in deterministic order as explained\nin Note [Deterministic SCC] in Digraph.\n-}\n\ndepAnal :: (node -> [Name])      -- Defs\n        -> (node -> [Name])      -- Uses\n        -> [node]\n        -> [SCC node]\n-- Perform dependency analysis on a group of definitions,\n-- where each definition may define more than one Name\n--\n-- The get_defs and get_uses functions are called only once per node\ndepAnal get_defs get_uses nodes\n  = stronglyConnCompFromEdgedVerticesUniq (map mk_node keyed_nodes)\n  where\n    keyed_nodes = nodes `zip` [(1::Int)..]\n    mk_node (node, key) =\n      DigraphNode node key (mapMaybe (lookupNameEnv key_map) (get_uses node))\n\n    key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it\n    key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Name environment}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Name Environment\ntype NameEnv a = UniqFM a       -- Domain is Name\n\nemptyNameEnv       :: NameEnv a\nisEmptyNameEnv     :: NameEnv a -> Bool\nmkNameEnv          :: [(Name,a)] -> NameEnv a\nnameEnvElts        :: NameEnv a -> [a]\nalterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a\nextendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a\nextendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b\nextendNameEnv      :: NameEnv a -> Name -> a -> NameEnv a\nplusNameEnv        :: NameEnv a -> NameEnv a -> NameEnv a\nplusNameEnv_C      :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a\nextendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a\nextendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a\ndelFromNameEnv     :: NameEnv a -> Name -> NameEnv a\ndelListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a\nelemNameEnv        :: Name -> NameEnv a -> Bool\nunitNameEnv        :: Name -> a -> NameEnv a\nlookupNameEnv      :: NameEnv a -> Name -> Maybe a\nlookupNameEnv_NF   :: NameEnv a -> Name -> a\nfilterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt\nanyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool\nmapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2\ndisjointNameEnv    :: NameEnv a -> NameEnv a -> Bool\n\nnameEnvElts x         = eltsUFM x\nemptyNameEnv          = emptyUFM\nisEmptyNameEnv        = isNullUFM\nunitNameEnv x y       = unitUFM x y\nextendNameEnv x y z   = addToUFM x y z\nextendNameEnvList x l = addListToUFM x l\nlookupNameEnv x y     = lookupUFM x y\nalterNameEnv          = alterUFM\nmkNameEnv     l       = listToUFM l\nelemNameEnv x y          = elemUFM x y\nplusNameEnv x y          = plusUFM x y\nplusNameEnv_C f x y      = plusUFM_C f x y\nextendNameEnv_C f x y z  = addToUFM_C f x y z\nmapNameEnv f x           = mapUFM f x\nextendNameEnv_Acc x y z a b  = addToUFM_Acc x y z a b\nextendNameEnvList_C x y z = addListToUFM_C x y z\ndelFromNameEnv x y      = delFromUFM x y\ndelListFromNameEnv x y  = delListFromUFM x y\nfilterNameEnv x y       = filterUFM x y\nanyNameEnv f x          = foldUFM ((||) . f) False x\ndisjointNameEnv x y     = isNullUFM (intersectUFM x y)\n\nlookupNameEnv_NF env n = expectJust \"lookupNameEnv_NF\" (lookupNameEnv env n)\n\n-- | Deterministic Name Environment\n--\n-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need\n-- DNameEnv.\ntype DNameEnv a = UniqDFM a\n\nemptyDNameEnv :: DNameEnv a\nemptyDNameEnv = emptyUDFM\n\nlookupDNameEnv :: DNameEnv a -> Name -> Maybe a\nlookupDNameEnv = lookupUDFM\n\nmapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b\nmapDNameEnv = mapUDFM\n\nalterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a\nalterDNameEnv = alterUDFM\n", "num_lines": 155}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1998\n-}\n\n{-# LANGUAGE CPP #-}\nmodule NameSet (\n        -- * Names set type\n        NameSet,\n\n        -- ** Manipulating these sets\n        emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,\n        minusNameSet, elemNameSet, extendNameSet, extendNameSetList,\n        delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,\n        intersectsNameSet, intersectNameSet,\n        nameSetAny, nameSetAll, nameSetElemsStable,\n\n        -- * Free variables\n        FreeVars,\n\n        -- ** Manipulating sets of free variables\n        isEmptyFVs, emptyFVs, plusFVs, plusFV,\n        mkFVs, addOneFV, unitFV, delFV, delFVs,\n        intersectFVs,\n\n        -- * Defs and uses\n        Defs, Uses, DefUse, DefUses,\n\n        -- ** Manipulating defs and uses\n        emptyDUs, usesOnly, mkDUs, plusDU,\n        findUses, duDefs, duUses, allUses\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Name\nimport UniqSet\nimport Data.List (sortBy)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Sets of names}\n*                                                                      *\n************************************************************************\n-}\n\ntype NameSet = UniqSet Name\n\nemptyNameSet       :: NameSet\nunitNameSet        :: Name -> NameSet\nextendNameSetList   :: NameSet -> [Name] -> NameSet\nextendNameSet    :: NameSet -> Name -> NameSet\nmkNameSet          :: [Name] -> NameSet\nunionNameSet      :: NameSet -> NameSet -> NameSet\nunionNameSets  :: [NameSet] -> NameSet\nminusNameSet       :: NameSet -> NameSet -> NameSet\nelemNameSet        :: Name -> NameSet -> Bool\nisEmptyNameSet     :: NameSet -> Bool\ndelFromNameSet     :: NameSet -> Name -> NameSet\ndelListFromNameSet :: NameSet -> [Name] -> NameSet\nfilterNameSet      :: (Name -> Bool) -> NameSet -> NameSet\nintersectNameSet   :: NameSet -> NameSet -> NameSet\nintersectsNameSet  :: NameSet -> NameSet -> Bool\n-- ^ True if there is a non-empty intersection.\n-- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty\n\nisEmptyNameSet    = isEmptyUniqSet\nemptyNameSet      = emptyUniqSet\nunitNameSet       = unitUniqSet\nmkNameSet         = mkUniqSet\nextendNameSetList  = addListToUniqSet\nextendNameSet   = addOneToUniqSet\nunionNameSet     = unionUniqSets\nunionNameSets = unionManyUniqSets\nminusNameSet      = minusUniqSet\nelemNameSet       = elementOfUniqSet\ndelFromNameSet    = delOneFromUniqSet\nfilterNameSet     = filterUniqSet\nintersectNameSet  = intersectUniqSets\n\ndelListFromNameSet set ns = foldl' delFromNameSet set ns\n\nintersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))\n\nnameSetAny :: (Name -> Bool) -> NameSet -> Bool\nnameSetAny = uniqSetAny\n\nnameSetAll :: (Name -> Bool) -> NameSet -> Bool\nnameSetAll = uniqSetAll\n\n-- | Get the elements of a NameSet with some stable ordering.\n-- This only works for Names that originate in the source code or have been\n-- tidied.\n-- See Note [Deterministic UniqFM] to learn about nondeterminism\nnameSetElemsStable :: NameSet -> [Name]\nnameSetElemsStable ns =\n  sortBy stableNameCmp $ nonDetEltsUniqSet ns\n  -- It's OK to use nonDetEltsUniqSet here because we immediately sort\n  -- with stableNameCmp\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Free variables}\n*                                                                      *\n************************************************************************\n\nThese synonyms are useful when we are thinking of free variables\n-}\n\ntype FreeVars   = NameSet\n\nplusFV   :: FreeVars -> FreeVars -> FreeVars\naddOneFV :: FreeVars -> Name -> FreeVars\nunitFV   :: Name -> FreeVars\nemptyFVs :: FreeVars\nplusFVs  :: [FreeVars] -> FreeVars\nmkFVs    :: [Name] -> FreeVars\ndelFV    :: Name -> FreeVars -> FreeVars\ndelFVs   :: [Name] -> FreeVars -> FreeVars\nintersectFVs :: FreeVars -> FreeVars -> FreeVars\n\nisEmptyFVs :: NameSet -> Bool\nisEmptyFVs  = isEmptyNameSet\nemptyFVs    = emptyNameSet\nplusFVs     = unionNameSets\nplusFV      = unionNameSet\nmkFVs       = mkNameSet\naddOneFV    = extendNameSet\nunitFV      = unitNameSet\ndelFV n s   = delFromNameSet s n\ndelFVs ns s = delListFromNameSet s ns\nintersectFVs = intersectNameSet\n\n{-\n************************************************************************\n*                                                                      *\n                Defs and uses\n*                                                                      *\n************************************************************************\n-}\n\n-- | A set of names that are defined somewhere\ntype Defs = NameSet\n\n-- | A set of names that are used somewhere\ntype Uses = NameSet\n\n-- | @(Just ds, us) =>@ The use of any member of the @ds@\n--                      implies that all the @us@ are used too.\n--                      Also, @us@ may mention @ds@.\n--\n-- @Nothing =>@ Nothing is defined in this group, but\n--              nevertheless all the uses are essential.\n--              Used for instance declarations, for example\ntype DefUse  = (Maybe Defs, Uses)\n\n-- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'\n--   In a single (def, use) pair, the defs also scope over the uses\ntype DefUses = [DefUse]\n\nemptyDUs :: DefUses\nemptyDUs = []\n\nusesOnly :: Uses -> DefUses\nusesOnly uses = [(Nothing, uses)]\n\nmkDUs :: [(Defs,Uses)] -> DefUses\nmkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]\n\nplusDU :: DefUses -> DefUses -> DefUses\nplusDU = (++)\n\nduDefs :: DefUses -> Defs\nduDefs dus = foldr get emptyNameSet dus\n  where\n    get (Nothing, _u1) d2 = d2\n    get (Just d1, _u1) d2 = d1 `unionNameSet` d2\n\nallUses :: DefUses -> Uses\n-- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned\nallUses dus = foldr get emptyNameSet dus\n  where\n    get (_d1, u1) u2 = u1 `unionNameSet` u2\n\nduUses :: DefUses -> Uses\n-- ^ Collect all 'Uses', regardless of whether the group is itself used,\n-- but remove 'Defs' on the way\nduUses dus = foldr get emptyNameSet dus\n  where\n    get (Nothing,   rhs_uses) uses = rhs_uses `unionNameSet` uses\n    get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)\n                                     `minusNameSet` defs\n\nfindUses :: DefUses -> Uses -> Uses\n-- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.\n-- The result is a superset of the input 'Uses'; and includes things defined\n-- in the input 'DefUses' (but only if they are used)\nfindUses dus uses\n  = foldr get uses dus\n  where\n    get (Nothing, rhs_uses) uses\n        = rhs_uses `unionNameSet` uses\n    get (Just defs, rhs_uses) uses\n        | defs `intersectsNameSet` uses         -- Used\n        || nameSetAny (startsWithUnderscore . nameOccName) defs\n                -- At least one starts with an \"_\",\n                -- so treat the group as used\n        = rhs_uses `unionNameSet` uses\n        | otherwise     -- No def is used\n        = uses\n", "num_lines": 215}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1998\n\n\\section[PatSyn]{@PatSyn@: Pattern synonyms}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule PatSyn (\n        -- * Main data types\n        PatSyn, mkPatSyn,\n\n        -- ** Type deconstruction\n        patSynName, patSynArity, patSynIsInfix,\n        patSynArgs,\n        patSynMatcher, patSynBuilder,\n        patSynUnivTyVarBinders, patSynExTyVars, patSynExTyVarBinders, patSynSig,\n        patSynInstArgTys, patSynInstResTy, patSynFieldLabels,\n        patSynFieldType,\n\n        tidyPatSynIds, pprPatSynType\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Type\nimport Name\nimport Outputable\nimport Unique\nimport Util\nimport BasicTypes\nimport Var\nimport FieldLabel\n\nimport qualified Data.Data as Data\nimport Data.Function\nimport Data.List\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Pattern synonyms}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Pattern Synonym\n--\n-- See Note [Pattern synonym representation]\n-- See Note [Pattern synonym signature contexts]\ndata PatSyn\n  = MkPatSyn {\n        psName        :: Name,\n        psUnique      :: Unique,       -- Cached from Name\n\n        psArgs        :: [Type],\n        psArity       :: Arity,        -- == length psArgs\n        psInfix       :: Bool,         -- True <=> declared infix\n        psFieldLabels :: [FieldLabel], -- List of fields for a\n                                       -- record pattern synonym\n                                       -- INVARIANT: either empty if no\n                                       -- record pat syn or same length as\n                                       -- psArgs\n\n        -- Universally-quantified type variables\n        psUnivTyVars  :: [TyVarBinder],\n\n        -- Required dictionaries (may mention psUnivTyVars)\n        psReqTheta    :: ThetaType,\n\n        -- Existentially-quantified type vars\n        psExTyVars    :: [TyVarBinder],\n\n        -- Provided dictionaries (may mention psUnivTyVars or psExTyVars)\n        psProvTheta   :: ThetaType,\n\n        -- Result type\n        psResultTy   :: Type,  -- Mentions only psUnivTyVars\n                               -- See Note [Pattern synonym result type]\n\n        -- See Note [Matchers and builders for pattern synonyms]\n        psMatcher     :: (Id, Bool),\n             -- Matcher function.\n             -- If Bool is True then prov_theta and arg_tys are empty\n             -- and type is\n             --   forall (p :: RuntimeRep) (r :: TYPE p) univ_tvs.\n             --                          req_theta\n             --                       => res_ty\n             --                       -> (forall ex_tvs. Void# -> r)\n             --                       -> (Void# -> r)\n             --                       -> r\n             --\n             -- Otherwise type is\n             --   forall (p :: RuntimeRep) (r :: TYPE r) univ_tvs.\n             --                          req_theta\n             --                       => res_ty\n             --                       -> (forall ex_tvs. prov_theta => arg_tys -> r)\n             --                       -> (Void# -> r)\n             --                       -> r\n\n        psBuilder     :: Maybe (Id, Bool)\n             -- Nothing  => uni-directional pattern synonym\n             -- Just (builder, is_unlifted) => bi-directional\n             -- Builder function, of type\n             --  forall univ_tvs, ex_tvs. (req_theta, prov_theta)\n             --                       =>  arg_tys -> res_ty\n             -- See Note [Builder for pattern synonyms with unboxed type]\n  }\n\n{- Note [Pattern synonym signature contexts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a pattern synonym signature we write\n   pattern P :: req => prov => t1 -> ... tn -> res_ty\n\nNote that the \"required\" context comes first, then the \"provided\"\ncontext.  Moreover, the \"required\" context must not mention\nexistentially-bound type variables; that is, ones not mentioned in\nres_ty.  See lots of discussion in Trac #10928.\n\nIf there is no \"provided\" context, you can omit it; but you\ncan't omit the \"required\" part (unless you omit both).\n\nExample 1:\n      pattern P1 :: (Num a, Eq a) => b -> Maybe (a,b)\n      pattern P1 x = Just (3,x)\n\n  We require (Num a, Eq a) to match the 3; there is no provided\n  context.\n\nExample 2:\n      data T2 where\n        MkT2 :: (Num a, Eq a) => a -> a -> T2\n\n      pattern P2 :: () => (Num a, Eq a) => a -> T2\n      pattern P2 x = MkT2 3 x\n\n  When we match against P2 we get a Num dictionary provided.\n  We can use that to check the match against 3.\n\nExample 3:\n      pattern P3 :: Eq a => a -> b -> T3 b\n\n   This signature is illegal because the (Eq a) is a required\n   constraint, but it mentions the existentially-bound variable 'a'.\n   You can see it's existential because it doesn't appear in the\n   result type (T3 b).\n\nNote [Pattern synonym result type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   data T a b = MkT b a\n\n   pattern P :: a -> T [a] Bool\n   pattern P x = MkT True [x]\n\nP's psResultTy is (T a Bool), and it really only matches values of\ntype (T [a] Bool).  For example, this is ill-typed\n\n   f :: T p q -> String\n   f (P x) = \"urk\"\n\nThis is different to the situation with GADTs:\n\n   data S a where\n     MkS :: Int -> S Bool\n\nNow MkS (and pattern synonyms coming from MkS) can match a\nvalue of type (S a), not just (S Bool); we get type refinement.\n\nThat in turn means that if you have a pattern\n\n   P x :: T [ty] Bool\n\nit's not entirely straightforward to work out the instantiation of\nP's universal tyvars. You have to /match/\n  the type of the pattern, (T [ty] Bool)\nagainst\n  the psResultTy for the pattern synonym, T [a] Bool\nto get the instantiation a := ty.\n\nThis is very unlike DataCons, where univ tyvars match 1-1 the\narguments of the TyCon.\n\n\nNote [Pattern synonym representation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following pattern synonym declaration\n\n        pattern P x = MkT [x] (Just 42)\n\nwhere\n        data T a where\n              MkT :: (Show a, Ord b) => [b] -> a -> T a\n\nso pattern P has type\n\n        b -> T (Maybe t)\n\nwith the following typeclass constraints:\n\n        requires: (Eq t, Num t)\n        provides: (Show (Maybe t), Ord b)\n\nIn this case, the fields of MkPatSyn will be set as follows:\n\n  psArgs       = [b]\n  psArity      = 1\n  psInfix      = False\n\n  psUnivTyVars = [t]\n  psExTyVars   = [b]\n  psProvTheta  = (Show (Maybe t), Ord b)\n  psReqTheta   = (Eq t, Num t)\n  psResultTy  = T (Maybe t)\n\nNote [Matchers and builders for pattern synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor each pattern synonym P, we generate\n\n  * a \"matcher\" function, used to desugar uses of P in patterns,\n    which implements pattern matching\n\n  * A \"builder\" function (for bidirectional pattern synonyms only),\n    used to desugar uses of P in expressions, which constructs P-values.\n\nFor the above example, the matcher function has type:\n\n        $mP :: forall (r :: ?) t. (Eq t, Num t)\n            => T (Maybe t)\n            -> (forall b. (Show (Maybe t), Ord b) => b -> r)\n            -> (Void# -> r)\n            -> r\n\nwith the following implementation:\n\n        $mP @r @t $dEq $dNum scrut cont fail\n          = case scrut of\n              MkT @b $dShow $dOrd [x] (Just 42) -> cont @b $dShow $dOrd x\n              _                                 -> fail Void#\n\nNotice that the return type 'r' has an open kind, so that it can\nbe instantiated by an unboxed type; for example where we see\n     f (P x) = 3#\n\nThe extra Void# argument for the failure continuation is needed so that\nit is lazy even when the result type is unboxed.\n\nFor the same reason, if the pattern has no arguments, an extra Void#\nargument is added to the success continuation as well.\n\nFor *bidirectional* pattern synonyms, we also generate a \"builder\"\nfunction which implements the pattern synonym in an expression\ncontext. For our running example, it will be:\n\n        $bP :: forall t b. (Eq t, Num t, Show (Maybe t), Ord b)\n            => b -> T (Maybe t)\n        $bP x = MkT [x] (Just 42)\n\nNB: the existential/universal and required/provided split does not\napply to the builder since you are only putting stuff in, not getting\nstuff out.\n\nInjectivity of bidirectional pattern synonyms is checked in\ntcPatToExpr which walks the pattern and returns its corresponding\nexpression when available.\n\nNote [Builder for pattern synonyms with unboxed type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor bidirectional pattern synonyms that have no arguments and have an\nunboxed type, we add an extra Void# argument to the builder, else it\nwould be a top-level declaration with an unboxed type.\n\n        pattern P = 0#\n\n        $bP :: Void# -> Int#\n        $bP _ = 0#\n\nThis means that when typechecking an occurrence of P in an expression,\nwe must remember that the builder has this void argument. This is\ndone by TcPatSyn.patSynBuilderOcc.\n\nNote [Pattern synonyms and the data type Type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe type of a pattern synonym is of the form (See Note\n[Pattern synonym signatures] in TcSigs):\n\n    forall univ_tvs. req => forall ex_tvs. prov => ...\n\nWe cannot in general represent this by a value of type Type:\n\n - if ex_tvs is empty, then req and prov cannot be distinguished from\n   each other\n - if req is empty, then univ_tvs and ex_tvs cannot be distinguished\n   from each other, and moreover, prov is seen as the \"required\" context\n   (as it is the only context)\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Instances}\n*                                                                      *\n************************************************************************\n-}\n\ninstance Eq PatSyn where\n    (==) = (==) `on` getUnique\n    (/=) = (/=) `on` getUnique\n\ninstance Uniquable PatSyn where\n    getUnique = psUnique\n\ninstance NamedThing PatSyn where\n    getName = patSynName\n\ninstance Outputable PatSyn where\n    ppr = ppr . getName\n\ninstance OutputableBndr PatSyn where\n    pprInfixOcc = pprInfixName . getName\n    pprPrefixOcc = pprPrefixName . getName\n\ninstance Data.Data PatSyn where\n    -- don't traverse?\n    toConstr _   = abstractConstr \"PatSyn\"\n    gunfold _ _  = error \"gunfold\"\n    dataTypeOf _ = mkNoRepType \"PatSyn\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Construction}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Build a new pattern synonym\nmkPatSyn :: Name\n         -> Bool                 -- ^ Is the pattern synonym declared infix?\n         -> ([TyVarBinder], ThetaType) -- ^ Universially-quantified type\n                                       -- variables and required dicts\n         -> ([TyVarBinder], ThetaType) -- ^ Existentially-quantified type\n                                       -- variables and provided dicts\n         -> [Type]               -- ^ Original arguments\n         -> Type                 -- ^ Original result type\n         -> (Id, Bool)           -- ^ Name of matcher\n         -> Maybe (Id, Bool)     -- ^ Name of builder\n         -> [FieldLabel]         -- ^ Names of fields for\n                                 --   a record pattern synonym\n         -> PatSyn\n -- NB: The univ and ex vars are both in TyBinder form and TyVar form for\n -- convenience. All the TyBinders should be Named!\nmkPatSyn name declared_infix\n         (univ_tvs, req_theta)\n         (ex_tvs, prov_theta)\n         orig_args\n         orig_res_ty\n         matcher builder field_labels\n    = MkPatSyn {psName = name, psUnique = getUnique name,\n                psUnivTyVars = univ_tvs,\n                psExTyVars = ex_tvs,\n                psProvTheta = prov_theta, psReqTheta = req_theta,\n                psInfix = declared_infix,\n                psArgs = orig_args,\n                psArity = length orig_args,\n                psResultTy = orig_res_ty,\n                psMatcher = matcher,\n                psBuilder = builder,\n                psFieldLabels = field_labels\n                }\n\n-- | The 'Name' of the 'PatSyn', giving it a unique, rooted identification\npatSynName :: PatSyn -> Name\npatSynName = psName\n\n-- | Should the 'PatSyn' be presented infix?\npatSynIsInfix :: PatSyn -> Bool\npatSynIsInfix = psInfix\n\n-- | Arity of the pattern synonym\npatSynArity :: PatSyn -> Arity\npatSynArity = psArity\n\npatSynArgs :: PatSyn -> [Type]\npatSynArgs = psArgs\n\npatSynFieldLabels :: PatSyn -> [FieldLabel]\npatSynFieldLabels = psFieldLabels\n\n-- | Extract the type for any given labelled field of the 'DataCon'\npatSynFieldType :: PatSyn -> FieldLabelString -> Type\npatSynFieldType ps label\n  = case find ((== label) . flLabel . fst) (psFieldLabels ps `zip` psArgs ps) of\n      Just (_, ty) -> ty\n      Nothing -> pprPanic \"dataConFieldType\" (ppr ps <+> ppr label)\n\npatSynUnivTyVarBinders :: PatSyn -> [TyVarBinder]\npatSynUnivTyVarBinders = psUnivTyVars\n\npatSynExTyVars :: PatSyn -> [TyVar]\npatSynExTyVars ps = binderVars (psExTyVars ps)\n\npatSynExTyVarBinders :: PatSyn -> [TyVarBinder]\npatSynExTyVarBinders = psExTyVars\n\npatSynSig :: PatSyn -> ([TyVar], ThetaType, [TyVar], ThetaType, [Type], Type)\npatSynSig (MkPatSyn { psUnivTyVars = univ_tvs, psExTyVars = ex_tvs\n                    , psProvTheta = prov, psReqTheta = req\n                    , psArgs = arg_tys, psResultTy = res_ty })\n  = (binderVars univ_tvs, req, binderVars ex_tvs, prov, arg_tys, res_ty)\n\npatSynMatcher :: PatSyn -> (Id,Bool)\npatSynMatcher = psMatcher\n\npatSynBuilder :: PatSyn -> Maybe (Id, Bool)\npatSynBuilder = psBuilder\n\ntidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn\ntidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = matcher, psBuilder = builder })\n  = ps { psMatcher = tidy_pr matcher, psBuilder = fmap tidy_pr builder }\n  where\n    tidy_pr (id, dummy) = (tidy_fn id, dummy)\n\npatSynInstArgTys :: PatSyn -> [Type] -> [Type]\n-- Return the types of the argument patterns\n-- e.g.  data D a = forall b. MkD a b (b->a)\n--       pattern P f x y = MkD (x,True) y f\n--          D :: forall a. forall b. a -> b -> (b->a) -> D a\n--          P :: forall c. forall b. (b->(c,Bool)) -> c -> b -> P c\n--   patSynInstArgTys P [Int,bb] = [bb->(Int,Bool), Int, bb]\n-- NB: the inst_tys should be both universal and existential\npatSynInstArgTys (MkPatSyn { psName = name, psUnivTyVars = univ_tvs\n                           , psExTyVars = ex_tvs, psArgs = arg_tys })\n                 inst_tys\n  = ASSERT2( tyvars `equalLength` inst_tys\n          , text \"patSynInstArgTys\" <+> ppr name $$ ppr tyvars $$ ppr inst_tys )\n    map (substTyWith tyvars inst_tys) arg_tys\n  where\n    tyvars = binderVars (univ_tvs ++ ex_tvs)\n\npatSynInstResTy :: PatSyn -> [Type] -> Type\n-- Return the type of whole pattern\n-- E.g.  pattern P x y = Just (x,x,y)\n--         P :: a -> b -> Just (a,a,b)\n--         (patSynInstResTy P [Int,Bool] = Maybe (Int,Int,Bool)\n-- NB: unlike patSynInstArgTys, the inst_tys should be just the *universal* tyvars\npatSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs\n                          , psResultTy = res_ty })\n                inst_tys\n  = ASSERT2( univ_tvs `equalLength` inst_tys\n           , text \"patSynInstResTy\" <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )\n    substTyWith (binderVars univ_tvs) inst_tys res_ty\n\n-- | Print the type of a pattern synonym. The foralls are printed explicitly\npprPatSynType :: PatSyn -> SDoc\npprPatSynType (MkPatSyn { psUnivTyVars = univ_tvs,  psReqTheta  = req_theta\n                        , psExTyVars   = ex_tvs,    psProvTheta = prov_theta\n                        , psArgs       = orig_args, psResultTy = orig_res_ty })\n  = sep [ pprForAll univ_tvs\n        , pprThetaArrowTy req_theta\n        , ppWhen insert_empty_ctxt $ parens empty <+> darrow\n        , pprType sigma_ty ]\n  where\n    sigma_ty = mkForAllTys ex_tvs  $\n               mkInvisFunTys prov_theta $\n               mkVisFunTys orig_args orig_res_ty\n    insert_empty_ctxt = null req_theta && not (null prov_theta && null ex_tvs)\n", "num_lines": 470}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP, DeriveDataTypeable #-}\n\n-- |\n-- #name_types#\n-- GHC uses several kinds of name internally:\n--\n-- * 'OccName.OccName': see \"OccName#name_types\"\n--\n-- * 'RdrName.RdrName' is the type of names that come directly from the parser. They\n--   have not yet had their scoping and binding resolved by the renamer and can be\n--   thought of to a first approximation as an 'OccName.OccName' with an optional module\n--   qualifier\n--\n-- * 'Name.Name': see \"Name#name_types\"\n--\n-- * 'Id.Id': see \"Id#name_types\"\n--\n-- * 'Var.Var': see \"Var#name_types\"\n\nmodule RdrName (\n        -- * The main type\n        RdrName(..),    -- Constructors exported only to BinIface\n\n        -- ** Construction\n        mkRdrUnqual, mkRdrQual,\n        mkUnqual, mkVarUnqual, mkQual, mkOrig,\n        nameRdrName, getRdrName,\n\n        -- ** Destruction\n        rdrNameOcc, rdrNameSpace, demoteRdrName,\n        isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,\n        isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,\n\n        -- * Local mapping of 'RdrName' to 'Name.Name'\n        LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,\n        lookupLocalRdrEnv, lookupLocalRdrOcc,\n        elemLocalRdrEnv, inLocalRdrEnvScope,\n        localRdrEnvElts, delLocalRdrEnvList,\n\n        -- * Global mapping of 'RdrName' to 'GlobalRdrElt's\n        GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,\n        lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames,\n        pprGlobalRdrEnv, globalRdrEnvElts,\n        lookupGRE_RdrName, lookupGRE_Name, lookupGRE_FieldLabel,\n        lookupGRE_Name_OccName,\n        getGRE_NameQualifier_maybes,\n        transformGREs, pickGREs, pickGREsModExp,\n\n        -- * GlobalRdrElts\n        gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE,\n        greRdrNames, greSrcSpan, greQualModName,\n        gresToAvailInfo,\n\n        -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'\n        GlobalRdrElt(..), isLocalGRE, isRecFldGRE, greLabel,\n        unQualOK, qualSpecOK, unQualSpecOK,\n        pprNameProvenance,\n        Parent(..), greParent_maybe,\n        ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),\n        importSpecLoc, importSpecModule, isExplicitItem, bestImport,\n\n        -- * Utils for StarIsType\n        starInfo\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Module\nimport Name\nimport Avail\nimport NameSet\nimport Maybes\nimport SrcLoc\nimport FastString\nimport FieldLabel\nimport Outputable\nimport Unique\nimport UniqFM\nimport UniqSet\nimport Util\nimport NameEnv\n\nimport Data.Data\nimport Data.List( sortBy )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The main data type}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Reader Name\n--\n-- Do not use the data constructors of RdrName directly: prefer the family\n-- of functions that creates them, such as 'mkRdrUnqual'\n--\n-- - Note: A Located RdrName will only have API Annotations if it is a\n--         compound one,\n--   e.g.\n--\n-- > `bar`\n-- > ( ~ )\n--\n-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',\n--           'ApiAnnotation.AnnOpen'  @'('@ or @'['@ or @'[:'@,\n--           'ApiAnnotation.AnnClose' @')'@ or @']'@ or @':]'@,,\n--           'ApiAnnotation.AnnBackquote' @'`'@,\n--           'ApiAnnotation.AnnVal'\n--           'ApiAnnotation.AnnTilde',\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata RdrName\n  = Unqual OccName\n        -- ^ Unqualified  name\n        --\n        -- Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.\n        -- Create such a 'RdrName' with 'mkRdrUnqual'\n\n  | Qual ModuleName OccName\n        -- ^ Qualified name\n        --\n        -- A qualified name written by the user in\n        -- /source/ code.  The module isn't necessarily\n        -- the module where the thing is defined;\n        -- just the one from which it is imported.\n        -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.\n        -- Create such a 'RdrName' with 'mkRdrQual'\n\n  | Orig Module OccName\n        -- ^ Original name\n        --\n        -- An original name; the module is the /defining/ module.\n        -- This is used when GHC generates code that will be fed\n        -- into the renamer (e.g. from deriving clauses), but where\n        -- we want to say \\\"Use Prelude.map dammit\\\". One of these\n        -- can be created with 'mkOrig'\n\n  | Exact Name\n        -- ^ Exact name\n        --\n        -- We know exactly the 'Name'. This is used:\n        --\n        --  (1) When the parser parses built-in syntax like @[]@\n        --      and @(,)@, but wants a 'RdrName' from it\n        --\n        --  (2) By Template Haskell, when TH has generated a unique name\n        --\n        -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'\n  deriving Data\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Simple functions}\n*                                                                      *\n************************************************************************\n-}\n\ninstance HasOccName RdrName where\n  occName = rdrNameOcc\n\nrdrNameOcc :: RdrName -> OccName\nrdrNameOcc (Qual _ occ) = occ\nrdrNameOcc (Unqual occ) = occ\nrdrNameOcc (Orig _ occ) = occ\nrdrNameOcc (Exact name) = nameOccName name\n\nrdrNameSpace :: RdrName -> NameSpace\nrdrNameSpace = occNameSpace . rdrNameOcc\n\n-- demoteRdrName lowers the NameSpace of RdrName.\n-- see Note [Demotion] in OccName\ndemoteRdrName :: RdrName -> Maybe RdrName\ndemoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)\ndemoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)\ndemoteRdrName (Orig _ _) = panic \"demoteRdrName\"\ndemoteRdrName (Exact _) = panic \"demoteRdrName\"\n\n        -- These two are the basic constructors\nmkRdrUnqual :: OccName -> RdrName\nmkRdrUnqual occ = Unqual occ\n\nmkRdrQual :: ModuleName -> OccName -> RdrName\nmkRdrQual mod occ = Qual mod occ\n\nmkOrig :: Module -> OccName -> RdrName\nmkOrig mod occ = Orig mod occ\n\n---------------\n        -- These two are used when parsing source files\n        -- They do encode the module and occurrence names\nmkUnqual :: NameSpace -> FastString -> RdrName\nmkUnqual sp n = Unqual (mkOccNameFS sp n)\n\nmkVarUnqual :: FastString -> RdrName\nmkVarUnqual n = Unqual (mkVarOccFS n)\n\n-- | Make a qualified 'RdrName' in the given namespace and where the 'ModuleName' and\n-- the 'OccName' are taken from the first and second elements of the tuple respectively\nmkQual :: NameSpace -> (FastString, FastString) -> RdrName\nmkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)\n\ngetRdrName :: NamedThing thing => thing -> RdrName\ngetRdrName name = nameRdrName (getName name)\n\nnameRdrName :: Name -> RdrName\nnameRdrName name = Exact name\n-- Keep the Name even for Internal names, so that the\n-- unique is still there for debug printing, particularly\n-- of Types (which are converted to IfaceTypes before printing)\n\nnukeExact :: Name -> RdrName\nnukeExact n\n  | isExternalName n = Orig (nameModule n) (nameOccName n)\n  | otherwise        = Unqual (nameOccName n)\n\nisRdrDataCon :: RdrName -> Bool\nisRdrTyVar   :: RdrName -> Bool\nisRdrTc      :: RdrName -> Bool\n\nisRdrDataCon rn = isDataOcc (rdrNameOcc rn)\nisRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)\nisRdrTc      rn = isTcOcc   (rdrNameOcc rn)\n\nisSrcRdrName :: RdrName -> Bool\nisSrcRdrName (Unqual _) = True\nisSrcRdrName (Qual _ _) = True\nisSrcRdrName _          = False\n\nisUnqual :: RdrName -> Bool\nisUnqual (Unqual _) = True\nisUnqual _          = False\n\nisQual :: RdrName -> Bool\nisQual (Qual _ _) = True\nisQual _          = False\n\nisQual_maybe :: RdrName -> Maybe (ModuleName, OccName)\nisQual_maybe (Qual m n) = Just (m,n)\nisQual_maybe _          = Nothing\n\nisOrig :: RdrName -> Bool\nisOrig (Orig _ _) = True\nisOrig _          = False\n\nisOrig_maybe :: RdrName -> Maybe (Module, OccName)\nisOrig_maybe (Orig m n) = Just (m,n)\nisOrig_maybe _          = Nothing\n\nisExact :: RdrName -> Bool\nisExact (Exact _) = True\nisExact _         = False\n\nisExact_maybe :: RdrName -> Maybe Name\nisExact_maybe (Exact n) = Just n\nisExact_maybe _         = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Instances}\n*                                                                      *\n************************************************************************\n-}\n\ninstance Outputable RdrName where\n    ppr (Exact name)   = ppr name\n    ppr (Unqual occ)   = ppr occ\n    ppr (Qual mod occ) = ppr mod <> dot <> ppr occ\n    ppr (Orig mod occ) = getPprStyle (\\sty -> pprModulePrefix sty mod occ <> ppr occ)\n\ninstance OutputableBndr RdrName where\n    pprBndr _ n\n        | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n\n        | otherwise              = ppr n\n\n    pprInfixOcc  rdr = pprInfixVar  (isSymOcc (rdrNameOcc rdr)) (ppr rdr)\n    pprPrefixOcc rdr\n      | Just name <- isExact_maybe rdr = pprPrefixName name\n             -- pprPrefixName has some special cases, so\n             -- we delegate to them rather than reproduce them\n      | otherwise = pprPrefixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)\n\ninstance Eq RdrName where\n    (Exact n1)    == (Exact n2)    = n1==n2\n        -- Convert exact to orig\n    (Exact n1)    == r2@(Orig _ _) = nukeExact n1 == r2\n    r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2\n\n    (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2\n    (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2\n    (Unqual o1)   == (Unqual o2)   = o1==o2\n    _             == _             = False\n\ninstance Ord RdrName where\n    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }\n    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }\n    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }\n    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }\n\n        -- Exact < Unqual < Qual < Orig\n        -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig\n        --      before comparing so that Prelude.map == the exact Prelude.map, but\n        --      that meant that we reported duplicates when renaming bindings\n        --      generated by Template Haskell; e.g\n        --      do { n1 <- newName \"foo\"; n2 <- newName \"foo\";\n        --           <decl involving n1,n2> }\n        --      I think we can do without this conversion\n    compare (Exact n1) (Exact n2) = n1 `compare` n2\n    compare (Exact _)  _          = LT\n\n    compare (Unqual _)   (Exact _)    = GT\n    compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2\n    compare (Unqual _)   _            = LT\n\n    compare (Qual _ _)   (Exact _)    = GT\n    compare (Qual _ _)   (Unqual _)   = GT\n    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)\n    compare (Qual _ _)   (Orig _ _)   = LT\n\n    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)\n    compare (Orig _ _)   _            = GT\n\n{-\n************************************************************************\n*                                                                      *\n                        LocalRdrEnv\n*                                                                      *\n************************************************************************\n-}\n\n-- | Local Reader Environment\n--\n-- This environment is used to store local bindings\n-- (@let@, @where@, lambda, @case@).\n-- It is keyed by OccName, because we never use it for qualified names\n-- We keep the current mapping, *and* the set of all Names in scope\n-- Reason: see Note [Splicing Exact names] in RnEnv\ndata LocalRdrEnv = LRE { lre_env      :: OccEnv Name\n                       , lre_in_scope :: NameSet }\n\ninstance Outputable LocalRdrEnv where\n  ppr (LRE {lre_env = env, lre_in_scope = ns})\n    = hang (text \"LocalRdrEnv {\")\n         2 (vcat [ text \"env =\" <+> pprOccEnv ppr_elt env\n                 , text \"in_scope =\"\n                    <+> pprUFM (getUniqSet ns) (braces . pprWithCommas ppr)\n                 ] <+> char '}')\n    where\n      ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name\n                     -- So we can see if the keys line up correctly\n\nemptyLocalRdrEnv :: LocalRdrEnv\nemptyLocalRdrEnv = LRE { lre_env = emptyOccEnv\n                       , lre_in_scope = emptyNameSet }\n\nextendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv\n-- The Name should be a non-top-level thing\nextendLocalRdrEnv lre@(LRE { lre_env = env, lre_in_scope = ns }) name\n  = WARN( isExternalName name, ppr name )\n    lre { lre_env      = extendOccEnv env (nameOccName name) name\n        , lre_in_scope = extendNameSet ns name }\n\nextendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv\nextendLocalRdrEnvList lre@(LRE { lre_env = env, lre_in_scope = ns }) names\n  = WARN( any isExternalName names, ppr names )\n    lre { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]\n        , lre_in_scope = extendNameSetList ns names }\n\nlookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name\nlookupLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) rdr\n  | Unqual occ <- rdr\n  = lookupOccEnv env occ\n\n  -- See Note [Local bindings with Exact Names]\n  | Exact name <- rdr\n  , name `elemNameSet` ns\n  = Just name\n\n  | otherwise\n  = Nothing\n\nlookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name\nlookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ\n\nelemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool\nelemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })\n  = case rdr_name of\n      Unqual occ -> occ  `elemOccEnv` env\n      Exact name -> name `elemNameSet` ns  -- See Note [Local bindings with Exact Names]\n      Qual {} -> False\n      Orig {} -> False\n\nlocalRdrEnvElts :: LocalRdrEnv -> [Name]\nlocalRdrEnvElts (LRE { lre_env = env }) = occEnvElts env\n\ninLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool\n-- This is the point of the NameSet\ninLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns\n\ndelLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv\ndelLocalRdrEnvList lre@(LRE { lre_env = env }) occs\n  = lre { lre_env = delListFromOccEnv env occs }\n\n{-\nNote [Local bindings with Exact Names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWith Template Haskell we can make local bindings that have Exact Names.\nComputing shadowing etc may use elemLocalRdrEnv (at least it certainly\ndoes so in RnTpes.bindHsQTyVars), so for an Exact Name we must consult\nthe in-scope-name-set.\n\n\n************************************************************************\n*                                                                      *\n                        GlobalRdrEnv\n*                                                                      *\n************************************************************************\n-}\n\n-- | Global Reader Environment\ntype GlobalRdrEnv = OccEnv [GlobalRdrElt]\n-- ^ Keyed by 'OccName'; when looking up a qualified name\n-- we look up the 'OccName' part, and then check the 'Provenance'\n-- to see if the appropriate qualification is valid.  This\n-- saves routinely doubling the size of the env by adding both\n-- qualified and unqualified names to the domain.\n--\n-- The list in the codomain is required because there may be name clashes\n-- These only get reported on lookup, not on construction\n--\n-- INVARIANT 1: All the members of the list have distinct\n--              'gre_name' fields; that is, no duplicate Names\n--\n-- INVARIANT 2: Imported provenance => Name is an ExternalName\n--              However LocalDefs can have an InternalName.  This\n--              happens only when type-checking a [d| ... |] Template\n--              Haskell quotation; see this note in RnNames\n--              Note [Top-level Names in Template Haskell decl quotes]\n--\n-- INVARIANT 3: If the GlobalRdrEnv maps [occ -> gre], then\n--                 greOccName gre = occ\n--\n--              NB: greOccName gre is usually the same as\n--                  nameOccName (gre_name gre), but not always in the\n--                  case of record seectors; see greOccName\n\n-- | Global Reader Element\n--\n-- An element of the 'GlobalRdrEnv'\ndata GlobalRdrElt\n  = GRE { gre_name :: Name\n        , gre_par  :: Parent\n        , gre_lcl :: Bool          -- ^ True <=> the thing was defined locally\n        , gre_imp :: [ImportSpec]  -- ^ In scope through these imports\n    } deriving (Data, Eq)\n         -- INVARIANT: either gre_lcl = True or gre_imp is non-empty\n         -- See Note [GlobalRdrElt provenance]\n\n-- | The children of a Name are the things that are abbreviated by the \"..\"\n--   notation in export lists.  See Note [Parents]\ndata Parent = NoParent\n            | ParentIs  { par_is :: Name }\n            | FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString }\n              -- ^ See Note [Parents for record fields]\n            deriving (Eq, Data)\n\ninstance Outputable Parent where\n   ppr NoParent        = empty\n   ppr (ParentIs n)    = text \"parent:\" <> ppr n\n   ppr (FldParent n f) = text \"fldparent:\"\n                             <> ppr n <> colon <> ppr f\n\nplusParent :: Parent -> Parent -> Parent\n-- See Note [Combining parents]\nplusParent p1@(ParentIs _)    p2 = hasParent p1 p2\nplusParent p1@(FldParent _ _) p2 = hasParent p1 p2\nplusParent p1 p2@(ParentIs _)    = hasParent p2 p1\nplusParent p1 p2@(FldParent _ _) = hasParent p2 p1\nplusParent _ _                   = NoParent\n\nhasParent :: Parent -> Parent -> Parent\n#if defined(DEBUG)\nhasParent p NoParent = p\nhasParent p p'\n  | p /= p' = pprPanic \"hasParent\" (ppr p <+> ppr p')  -- Parents should agree\n#endif\nhasParent p _  = p\n\n\n{- Note [GlobalRdrElt provenance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe gre_lcl and gre_imp fields of a GlobalRdrElt describe its \"provenance\",\ni.e. how the Name came to be in scope.  It can be in scope two ways:\n  - gre_lcl = True: it is bound in this module\n  - gre_imp: a list of all the imports that brought it into scope\n\nIt's an INVARIANT that you have one or the other; that is, either\ngre_lcl is True, or gre_imp is non-empty.\n\nIt is just possible to have *both* if there is a module loop: a Name\nis defined locally in A, and also brought into scope by importing a\nmodule that SOURCE-imported A.  Exapmle (Trac #7672):\n\n A.hs-boot   module A where\n               data T\n\n B.hs        module B(Decl.T) where\n               import {-# SOURCE #-} qualified A as Decl\n\n A.hs        module A where\n               import qualified B\n               data T = Z | S B.T\n\nIn A.hs, 'T' is locally bound, *and* imported as B.T.\n\nNote [Parents]\n~~~~~~~~~~~~~~~~~\n  Parent           Children\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  data T           Data constructors\n                   Record-field ids\n\n  data family T    Data constructors and record-field ids\n                   of all visible data instances of T\n\n  class C          Class operations\n                   Associated type constructors\n\n~~~~~~~~~~~~~~~~~~~~~~~~~\n Constructor      Meaning\n ~~~~~~~~~~~~~~~~~~~~~~~~\n  NoParent        Can not be bundled with a type constructor.\n  ParentIs n      Can be bundled with the type constructor corresponding to\n                  n.\n  FldParent       See Note [Parents for record fields]\n\n\n\n\nNote [Parents for record fields]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor record fields, in addition to the Name of the type constructor\n(stored in par_is), we use FldParent to store the field label.  This\nextra information is used for identifying overloaded record fields\nduring renaming.\n\nIn a definition arising from a normal module (without\n-XDuplicateRecordFields), par_lbl will be Nothing, meaning that the\nfield's label is the same as the OccName of the selector's Name.  The\nGlobalRdrEnv will contain an entry like this:\n\n    \"x\" |->  GRE x (FldParent T Nothing) LocalDef\n\nWhen -XDuplicateRecordFields is enabled for the module that contains\nT, the selector's Name will be mangled (see comments in FieldLabel).\nThus we store the actual field label in par_lbl, and the GlobalRdrEnv\nentry looks like this:\n\n    \"x\" |->  GRE $sel:x:MkT (FldParent T (Just \"x\")) LocalDef\n\nNote that the OccName used when adding a GRE to the environment\n(greOccName) now depends on the parent field: for FldParent it is the\nfield label, if present, rather than the selector name.\n\n~~\n\nRecord pattern synonym selectors are treated differently. Their parent\ninformation is `NoParent` in the module in which they are defined. This is because\na pattern synonym `P` has no parent constructor either.\n\nHowever, if `f` is bundled with a type constructor `T` then whenever `f` is\nimported the parent will use the `Parent` constructor so the parent of `f` is\nnow `T`.\n\n\nNote [Combining parents]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWith an associated type we might have\n   module M where\n     class C a where\n       data T a\n       op :: T a -> a\n     instance C Int where\n       data T Int = TInt\n     instance C Bool where\n       data T Bool = TBool\n\nThen:   C is the parent of T\n        T is the parent of TInt and TBool\nSo: in an export list\n    C(..) is short for C( op, T )\n    T(..) is short for T( TInt, TBool )\n\nModule M exports everything, so its exports will be\n   AvailTC C [C,T,op]\n   AvailTC T [T,TInt,TBool]\nOn import we convert to GlobalRdrElt and then combine\nthose.  For T that will mean we have\n  one GRE with Parent C\n  one GRE with NoParent\nThat's why plusParent picks the \"best\" case.\n-}\n\n-- | make a 'GlobalRdrEnv' where all the elements point to the same\n-- Provenance (useful for \"hiding\" imports, or imports with no details).\ngresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]\n-- prov = Nothing   => locally bound\n--        Just spec => imported as described by spec\ngresFromAvails prov avails\n  = concatMap (gresFromAvail (const prov)) avails\n\nlocalGREsFromAvail :: AvailInfo -> [GlobalRdrElt]\n-- Turn an Avail into a list of LocalDef GlobalRdrElts\nlocalGREsFromAvail = gresFromAvail (const Nothing)\n\ngresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]\ngresFromAvail prov_fn avail\n  = map mk_gre (availNonFldNames avail) ++ map mk_fld_gre (availFlds avail)\n  where\n    mk_gre n\n      = case prov_fn n of  -- Nothing => bound locally\n                           -- Just is => imported from 'is'\n          Nothing -> GRE { gre_name = n, gre_par = mkParent n avail\n                         , gre_lcl = True, gre_imp = [] }\n          Just is -> GRE { gre_name = n, gre_par = mkParent n avail\n                         , gre_lcl = False, gre_imp = [is] }\n\n    mk_fld_gre (FieldLabel { flLabel = lbl, flIsOverloaded = is_overloaded\n                           , flSelector = n })\n      = case prov_fn n of  -- Nothing => bound locally\n                           -- Just is => imported from 'is'\n          Nothing -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl\n                         , gre_lcl = True, gre_imp = [] }\n          Just is -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl\n                         , gre_lcl = False, gre_imp = [is] }\n      where\n        mb_lbl | is_overloaded = Just lbl\n               | otherwise     = Nothing\n\n\ngreQualModName :: GlobalRdrElt -> ModuleName\n-- Get a suitable module qualifier for the GRE\n-- (used in mkPrintUnqualified)\n-- Prerecondition: the gre_name is always External\ngreQualModName gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })\n | lcl, Just mod <- nameModule_maybe name = moduleName mod\n | (is:_) <- iss                          = is_as (is_decl is)\n | otherwise                              = pprPanic \"greQualModName\" (ppr gre)\n\ngreRdrNames :: GlobalRdrElt -> [RdrName]\ngreRdrNames gre@GRE{ gre_lcl = lcl, gre_imp = iss }\n  = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss)\n  where\n    occ    = greOccName gre\n    unqual = Unqual occ\n    do_spec decl_spec\n        | is_qual decl_spec = [qual]\n        | otherwise         = [unqual,qual]\n        where qual = Qual (is_as decl_spec) occ\n\n-- the SrcSpan that pprNameProvenance prints out depends on whether\n-- the Name is defined locally or not: for a local definition the\n-- definition site is used, otherwise the location of the import\n-- declaration.  We want to sort the export locations in\n-- exportClashErr by this SrcSpan, we need to extract it:\ngreSrcSpan :: GlobalRdrElt -> SrcSpan\ngreSrcSpan gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss } )\n  | lcl           = nameSrcSpan name\n  | (is:_) <- iss = is_dloc (is_decl is)\n  | otherwise     = pprPanic \"greSrcSpan\" (ppr gre)\n\nmkParent :: Name -> AvailInfo -> Parent\nmkParent _ (Avail _)           = NoParent\nmkParent n (AvailTC m _ _) | n == m    = NoParent\n                         | otherwise = ParentIs m\n\ngreParent_maybe :: GlobalRdrElt -> Maybe Name\ngreParent_maybe gre = case gre_par gre of\n                        NoParent      -> Nothing\n                        ParentIs n    -> Just n\n                        FldParent n _ -> Just n\n\n-- | Takes a list of distinct GREs and folds them\n-- into AvailInfos. This is more efficient than mapping each individual\n-- GRE to an AvailInfo and the folding using `plusAvail` but needs the\n-- uniqueness assumption.\ngresToAvailInfo :: [GlobalRdrElt] -> [AvailInfo]\ngresToAvailInfo gres\n  = nameEnvElts avail_env\n  where\n    avail_env :: NameEnv AvailInfo -- Keyed by the parent\n    (avail_env, _) = foldl' add (emptyNameEnv, emptyNameSet) gres\n\n    add :: (NameEnv AvailInfo, NameSet)\n        -> GlobalRdrElt\n        -> (NameEnv AvailInfo, NameSet)\n    add (env, done) gre\n      | name `elemNameSet` done\n      = (env, done)  -- Don't insert twice into the AvailInfo\n      | otherwise\n      = ( extendNameEnv_Acc comb availFromGRE env key gre\n        , done `extendNameSet` name )\n      where\n        name = gre_name gre\n        key = case greParent_maybe gre of\n                 Just parent -> parent\n                 Nothing     -> gre_name gre\n\n        -- We want to insert the child `k` into a list of children but\n        -- need to maintain the invariant that the parent is first.\n        --\n        -- We also use the invariant that `k` is not already in `ns`.\n        insertChildIntoChildren :: Name -> [Name] -> Name -> [Name]\n        insertChildIntoChildren _ [] k = [k]\n        insertChildIntoChildren p (n:ns) k\n          | p == k = k:n:ns\n          | otherwise = n:k:ns\n\n        comb :: GlobalRdrElt -> AvailInfo -> AvailInfo\n        comb _ (Avail n) = Avail n -- Duplicated name, should not happen\n        comb gre (AvailTC m ns fls)\n          = case gre_par gre of\n              NoParent    -> AvailTC m (name:ns) fls -- Not sure this ever happens\n              ParentIs {} -> AvailTC m (insertChildIntoChildren m ns name) fls\n              FldParent _ mb_lbl -> AvailTC m ns (mkFieldLabel name mb_lbl : fls)\n\navailFromGRE :: GlobalRdrElt -> AvailInfo\navailFromGRE (GRE { gre_name = me, gre_par = parent })\n  = case parent of\n      ParentIs p                  -> AvailTC p [me] []\n      NoParent   | isTyConName me -> AvailTC me [me] []\n                 | otherwise      -> avail   me\n      FldParent p mb_lbl -> AvailTC p [] [mkFieldLabel me mb_lbl]\n\nmkFieldLabel :: Name -> Maybe FastString -> FieldLabel\nmkFieldLabel me mb_lbl =\n          case mb_lbl of\n                 Nothing  -> FieldLabel { flLabel = occNameFS (nameOccName me)\n                                        , flIsOverloaded = False\n                                        , flSelector = me }\n                 Just lbl -> FieldLabel { flLabel = lbl\n                                        , flIsOverloaded = True\n                                        , flSelector = me }\n\nemptyGlobalRdrEnv :: GlobalRdrEnv\nemptyGlobalRdrEnv = emptyOccEnv\n\nglobalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]\nglobalRdrEnvElts env = foldOccEnv (++) [] env\n\ninstance Outputable GlobalRdrElt where\n  ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))\n               2 (pprNameProvenance gre)\n\npprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc\npprGlobalRdrEnv locals_only env\n  = vcat [ text \"GlobalRdrEnv\" <+> ppWhen locals_only (ptext (sLit \"(locals only)\"))\n             <+> lbrace\n         , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ]\n             <+> rbrace) ]\n  where\n    remove_locals gres | locals_only = filter isLocalGRE gres\n                       | otherwise   = gres\n    pp []   = empty\n    pp gres = hang (ppr occ\n                     <+> parens (text \"unique\" <+> ppr (getUnique occ))\n                     <> colon)\n                 2 (vcat (map ppr gres))\n      where\n        occ = nameOccName (gre_name (head gres))\n\nlookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]\nlookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of\n                                  Nothing   -> []\n                                  Just gres -> gres\n\ngreOccName :: GlobalRdrElt -> OccName\ngreOccName (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = mkVarOccFS lbl\ngreOccName gre                                            = nameOccName (gre_name gre)\n\nlookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]\nlookupGRE_RdrName rdr_name env\n  = case lookupOccEnv env (rdrNameOcc rdr_name) of\n    Nothing   -> []\n    Just gres -> pickGREs rdr_name gres\n\nlookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt\n-- ^ Look for precisely this 'Name' in the environment.  This tests\n-- whether it is in scope, ignoring anything else that might be in\n-- scope with the same 'OccName'.\nlookupGRE_Name env name\n  = lookupGRE_Name_OccName env name (nameOccName name)\n\nlookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt\n-- ^ Look for a particular record field selector in the environment, where the\n-- selector name and field label may be different: the GlobalRdrEnv is keyed on\n-- the label.  See Note [Parents for record fields] for why this happens.\nlookupGRE_FieldLabel env fl\n  = lookupGRE_Name_OccName env (flSelector fl) (mkVarOccFS (flLabel fl))\n\nlookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt\n-- ^ Look for precisely this 'Name' in the environment, but with an 'OccName'\n-- that might differ from that of the 'Name'.  See 'lookupGRE_FieldLabel' and\n-- Note [Parents for record fields].\nlookupGRE_Name_OccName env name occ\n  = case [ gre | gre <- lookupGlobalRdrEnv env occ\n               , gre_name gre == name ] of\n      []    -> Nothing\n      [gre] -> Just gre\n      gres  -> pprPanic \"lookupGRE_Name_OccName\"\n                        (ppr name $$ ppr occ $$ ppr gres)\n               -- See INVARIANT 1 on GlobalRdrEnv\n\n\ngetGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]\n-- Returns all the qualifiers by which 'x' is in scope\n-- Nothing means \"the unqualified version is in scope\"\n-- [] means the thing is not in scope at all\ngetGRE_NameQualifier_maybes env name\n  = case lookupGRE_Name env name of\n      Just gre -> [qualifier_maybe gre]\n      Nothing  -> []\n  where\n    qualifier_maybe (GRE { gre_lcl = lcl, gre_imp = iss })\n      | lcl       = Nothing\n      | otherwise = Just $ map (is_as . is_decl) iss\n\nisLocalGRE :: GlobalRdrElt -> Bool\nisLocalGRE (GRE {gre_lcl = lcl }) = lcl\n\nisRecFldGRE :: GlobalRdrElt -> Bool\nisRecFldGRE (GRE {gre_par = FldParent{}}) = True\nisRecFldGRE _                             = False\n\n-- Returns the field label of this GRE, if it has one\ngreLabel :: GlobalRdrElt -> Maybe FieldLabelString\ngreLabel (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = Just lbl\ngreLabel (GRE{gre_name = n, gre_par = FldParent{}})     = Just (occNameFS (nameOccName n))\ngreLabel _                                              = Nothing\n\nunQualOK :: GlobalRdrElt -> Bool\n-- ^ Test if an unqualified version of this thing would be in scope\nunQualOK (GRE {gre_lcl = lcl, gre_imp = iss })\n  | lcl = True\n  | otherwise = any unQualSpecOK iss\n\n{- Note [GRE filtering]\n~~~~~~~~~~~~~~~~~~~~~~~\n(pickGREs rdr gres) takes a list of GREs which have the same OccName\nas 'rdr', say \"x\".  It does two things:\n\n(a) filters the GREs to a subset that are in scope\n    * Qualified,   as 'M.x'  if want_qual    is Qual M _\n    * Unqualified, as 'x'    if want_unqual  is Unqual _\n\n(b) for that subset, filter the provenance field (gre_lcl and gre_imp)\n    to ones that brought it into scope qualified or unqualified resp.\n\nExample:\n      module A ( f ) where\n      import qualified Foo( f )\n      import Baz( f )\n      f = undefined\n\nLet's suppose that Foo.f and Baz.f are the same entity really, but the local\n'f' is different, so there will be two GREs matching \"f\":\n   gre1:  gre_lcl = True,  gre_imp = []\n   gre2:  gre_lcl = False, gre_imp = [ imported from Foo, imported from Bar ]\n\nThe use of \"f\" in the export list is ambiguous because it's in scope\nfrom the local def and the import Baz(f); but *not* the import qualified Foo.\npickGREs returns two GRE\n   gre1:   gre_lcl = True,  gre_imp = []\n   gre2:   gre_lcl = False, gre_imp = [ imported from Bar ]\n\nNow the \"ambiguous occurrence\" message can correctly report how the\nambiguity arises.\n-}\n\npickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]\n-- ^ Takes a list of GREs which have the right OccName 'x'\n-- Pick those GREs that are in scope\n--    * Qualified,   as 'M.x'  if want_qual    is Qual M _\n--    * Unqualified, as 'x'    if want_unqual  is Unqual _\n--\n-- Return each such GRE, with its ImportSpecs filtered, to reflect\n-- how it is in scope qualified or unqualified respectively.\n-- See Note [GRE filtering]\npickGREs (Unqual {})  gres = mapMaybe pickUnqualGRE     gres\npickGREs (Qual mod _) gres = mapMaybe (pickQualGRE mod) gres\npickGREs _            _    = []  -- I don't think this actually happens\n\npickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt\npickUnqualGRE gre@(GRE { gre_lcl = lcl, gre_imp = iss })\n  | not lcl, null iss' = Nothing\n  | otherwise          = Just (gre { gre_imp = iss' })\n  where\n    iss' = filter unQualSpecOK iss\n\npickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt\npickQualGRE mod gre@(GRE { gre_name = n, gre_lcl = lcl, gre_imp = iss })\n  | not lcl', null iss' = Nothing\n  | otherwise           = Just (gre { gre_lcl = lcl', gre_imp = iss' })\n  where\n    iss' = filter (qualSpecOK mod) iss\n    lcl' = lcl && name_is_from mod n\n\n    name_is_from :: ModuleName -> Name -> Bool\n    name_is_from mod name = case nameModule_maybe name of\n                              Just n_mod -> moduleName n_mod == mod\n                              Nothing    -> False\n\npickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)]\n-- ^ Pick GREs that are in scope *both* qualified *and* unqualified\n-- Return each GRE that is, as a pair\n--    (qual_gre, unqual_gre)\n-- These two GREs are the original GRE with imports filtered to express how\n-- it is in scope qualified an unqualified respectively\n--\n-- Used only for the 'module M' item in export list;\n--   see RnNames.exports_from_avail\npickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres\n\npickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)\npickBothGRE mod gre@(GRE { gre_name = n })\n  | isBuiltInSyntax n                = Nothing\n  | Just gre1 <- pickQualGRE mod gre\n  , Just gre2 <- pickUnqualGRE   gre = Just (gre1, gre2)\n  | otherwise                        = Nothing\n  where\n        -- isBuiltInSyntax filter out names for built-in syntax They\n        -- just clutter up the environment (esp tuples), and the\n        -- parser will generate Exact RdrNames for them, so the\n        -- cluttered envt is no use.  Really, it's only useful for\n        -- GHC.Base and GHC.Tuple.\n\n-- Building GlobalRdrEnvs\n\nplusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv\nplusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2\n\nmkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv\nmkGlobalRdrEnv gres\n  = foldr add emptyGlobalRdrEnv gres\n  where\n    add gre env = extendOccEnv_Acc insertGRE singleton env\n                                   (greOccName gre)\n                                   gre\n\ninsertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]\ninsertGRE new_g [] = [new_g]\ninsertGRE new_g (old_g : old_gs)\n        | gre_name new_g == gre_name old_g\n        = new_g `plusGRE` old_g : old_gs\n        | otherwise\n        = old_g : insertGRE new_g old_gs\n\nplusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt\n-- Used when the gre_name fields match\nplusGRE g1 g2\n  = GRE { gre_name = gre_name g1\n        , gre_lcl  = gre_lcl g1 || gre_lcl g2\n        , gre_imp  = gre_imp g1 ++ gre_imp g2\n        , gre_par  = gre_par  g1 `plusParent` gre_par  g2 }\n\ntransformGREs :: (GlobalRdrElt -> GlobalRdrElt)\n              -> [OccName]\n              -> GlobalRdrEnv -> GlobalRdrEnv\n-- ^ Apply a transformation function to the GREs for these OccNames\ntransformGREs trans_gre occs rdr_env\n  = foldr trans rdr_env occs\n  where\n    trans occ env\n      = case lookupOccEnv env occ of\n           Just gres -> extendOccEnv env occ (map trans_gre gres)\n           Nothing   -> env\n\nextendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv\nextendGlobalRdrEnv env gre\n  = extendOccEnv_Acc insertGRE singleton env\n                     (greOccName gre) gre\n\nshadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv\nshadowNames = foldl' shadowName\n\n{- Note [GlobalRdrEnv shadowing]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBefore adding new names to the GlobalRdrEnv we nuke some existing entries;\nthis is \"shadowing\".  The actual work is done by RdrEnv.shadowName.\nSuppose\n   env' = shadowName env M.f\n\nThen:\n   * Looking up (Unqual f) in env' should succeed, returning M.f,\n     even if env contains existing unqualified bindings for f.\n     They are shadowed\n\n   * Looking up (Qual M.f) in env' should succeed, returning M.f\n\n   * Looking up (Qual X.f) in env', where X /= M, should be the same as\n     looking up (Qual X.f) in env.\n     That is, shadowName does /not/ delete earlier qualified bindings\n\nThere are two reasons for shadowing:\n\n* The GHCi REPL\n\n  - Ids bought into scope on the command line (eg let x = True) have\n    External Names, like Ghci4.x.  We want a new binding for 'x' (say)\n    to override the existing binding for 'x'.  Example:\n\n           ghci> :load M    -- Brings `x` and `M.x` into scope\n           ghci> x\n           ghci> \"Hello\"\n           ghci> M.x\n           ghci> \"hello\"\n           ghci> let x = True  -- Shadows `x`\n           ghci> x             -- The locally bound `x`\n                               -- NOT an ambiguous reference\n           ghci> True\n           ghci> M.x           -- M.x is still in scope!\n           ghci> \"Hello\"\n    So when we add `x = True` we must not delete the `M.x` from the\n    `GlobalRdrEnv`; rather we just want to make it \"qualified only\";\n    hence the `mk_fake-imp_spec` in `shadowName`.  See also Note\n    [Interactively-bound Ids in GHCi] in HscTypes\n\n  - Data types also have External Names, like Ghci4.T; but we still want\n    'T' to mean the newly-declared 'T', not an old one.\n\n* Nested Template Haskell declaration brackets\n  See Note [Top-level Names in Template Haskell decl quotes] in RnNames\n\n  Consider a TH decl quote:\n      module M where\n        f x = h [d| f = ...f...M.f... |]\n  We must shadow the outer unqualified binding of 'f', else we'll get\n  a complaint when extending the GlobalRdrEnv, saying that there are\n  two bindings for 'f'.  There are several tricky points:\n\n    - This shadowing applies even if the binding for 'f' is in a\n      where-clause, and hence is in the *local* RdrEnv not the *global*\n      RdrEnv.  This is done in lcl_env_TH in extendGlobalRdrEnvRn.\n\n    - The External Name M.f from the enclosing module must certainly\n      still be available.  So we don't nuke it entirely; we just make\n      it seem like qualified import.\n\n    - We only shadow *External* names (which come from the main module),\n      or from earlier GHCi commands. Do not shadow *Internal* names\n      because in the bracket\n          [d| class C a where f :: a\n              f = 4 |]\n      rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the\n      class decl, and *separately* extend the envt with the value binding.\n      At that stage, the class op 'f' will have an Internal name.\n-}\n\nshadowName :: GlobalRdrEnv -> Name -> GlobalRdrEnv\n-- Remove certain old GREs that share the same OccName as this new Name.\n-- See Note [GlobalRdrEnv shadowing] for details\nshadowName env name\n  = alterOccEnv (fmap alter_fn) env (nameOccName name)\n  where\n    alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]\n    alter_fn gres = mapMaybe (shadow_with name) gres\n\n    shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt\n    shadow_with new_name\n       old_gre@(GRE { gre_name = old_name, gre_lcl = lcl, gre_imp = iss })\n       = case nameModule_maybe old_name of\n           Nothing -> Just old_gre   -- Old name is Internal; do not shadow\n           Just old_mod\n              | Just new_mod <- nameModule_maybe new_name\n              , new_mod == old_mod   -- Old name same as new name; shadow completely\n              -> Nothing\n\n              | null iss'            -- Nothing remains\n              -> Nothing\n\n              | otherwise\n              -> Just (old_gre { gre_lcl = False, gre_imp = iss' })\n\n              where\n                iss' = lcl_imp ++ mapMaybe (shadow_is new_name) iss\n                lcl_imp | lcl       = [mk_fake_imp_spec old_name old_mod]\n                        | otherwise = []\n\n    mk_fake_imp_spec old_name old_mod    -- Urgh!\n      = ImpSpec id_spec ImpAll\n      where\n        old_mod_name = moduleName old_mod\n        id_spec      = ImpDeclSpec { is_mod = old_mod_name\n                                   , is_as = old_mod_name\n                                   , is_qual = True\n                                   , is_dloc = nameSrcSpan old_name }\n\n    shadow_is :: Name -> ImportSpec -> Maybe ImportSpec\n    shadow_is new_name is@(ImpSpec { is_decl = id_spec })\n       | Just new_mod <- nameModule_maybe new_name\n       , is_as id_spec == moduleName new_mod\n       = Nothing   -- Shadow both qualified and unqualified\n       | otherwise -- Shadow unqualified only\n       = Just (is { is_decl = id_spec { is_qual = True } })\n\n\n{-\n************************************************************************\n*                                                                      *\n                        ImportSpec\n*                                                                      *\n************************************************************************\n-}\n\n-- | Import Specification\n--\n-- The 'ImportSpec' of something says how it came to be imported\n-- It's quite elaborate so that we can give accurate unused-name warnings.\ndata ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,\n                            is_item :: ImpItemSpec }\n                deriving( Eq, Ord, Data )\n\n-- | Import Declaration Specification\n--\n-- Describes a particular import declaration and is\n-- shared among all the 'Provenance's for that decl\ndata ImpDeclSpec\n  = ImpDeclSpec {\n        is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@\n                                   -- Note the @Muggle@ may well not be\n                                   -- the defining module for this thing!\n\n                                   -- TODO: either should be Module, or there\n                                   -- should be a Maybe UnitId here too.\n        is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)\n        is_qual     :: Bool,       -- ^ Was this import qualified?\n        is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration\n    } deriving Data\n\n-- | Import Item Specification\n--\n-- Describes import info a particular Name\ndata ImpItemSpec\n  = ImpAll              -- ^ The import had no import list,\n                        -- or had a hiding list\n\n  | ImpSome {\n        is_explicit :: Bool,\n        is_iloc     :: SrcSpan  -- Location of the import item\n    }   -- ^ The import had an import list.\n        -- The 'is_explicit' field is @True@ iff the thing was named\n        -- /explicitly/ in the import specs rather\n        -- than being imported as part of a \"...\" group. Consider:\n        --\n        -- > import C( T(..) )\n        --\n        -- Here the constructors of @T@ are not named explicitly;\n        -- only @T@ is named explicitly.\n  deriving Data\n\ninstance Eq ImpDeclSpec where\n  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False\n\ninstance Ord ImpDeclSpec where\n   compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`\n                     (is_dloc is1 `compare` is_dloc is2)\n\ninstance Eq ImpItemSpec where\n  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False\n\ninstance Ord ImpItemSpec where\n   compare is1 is2 =\n    case (is1, is2) of\n      (ImpAll, ImpAll) -> EQ\n      (ImpAll, _)      -> GT\n      (_, ImpAll)      -> LT\n      (ImpSome _ l1, ImpSome _ l2) -> l1 `compare` l2\n\n\nbestImport :: [ImportSpec] -> ImportSpec\n-- See Note [Choosing the best import declaration]\nbestImport iss\n  = case sortBy best iss of\n      (is:_) -> is\n      []     -> pprPanic \"bestImport\" (ppr iss)\n  where\n    best :: ImportSpec -> ImportSpec -> Ordering\n    -- Less means better\n    -- Unqualified always wins over qualified; then\n    -- import-all wins over import-some; then\n    -- earlier declaration wins over later\n    best (ImpSpec { is_item = item1, is_decl = d1 })\n         (ImpSpec { is_item = item2, is_decl = d2 })\n      = (is_qual d1 `compare` is_qual d2) `thenCmp`\n        (best_item item1 item2)           `thenCmp`\n        (is_dloc d1 `compare` is_dloc d2)\n\n    best_item :: ImpItemSpec -> ImpItemSpec -> Ordering\n    best_item ImpAll ImpAll = EQ\n    best_item ImpAll (ImpSome {}) = LT\n    best_item (ImpSome {}) ImpAll = GT\n    best_item (ImpSome { is_explicit = e1 })\n              (ImpSome { is_explicit = e2 }) = e1 `compare` e2\n     -- False < True, so if e1 is explicit and e2 is not, we get GT\n\n{- Note [Choosing the best import declaration]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen reporting unused import declarations we use the following rules.\n   (see [wiki:Commentary/Compiler/UnusedImports])\n\nSay that an import-item is either\n  * an entire import-all decl (eg import Foo), or\n  * a particular item in an import list (eg import Foo( ..., x, ...)).\nThe general idea is that for each /occurrence/ of an imported name, we will\nattribute that use to one import-item. Once we have processed all the\noccurrences, any import items with no uses attributed to them are unused,\nand are warned about. More precisely:\n\n1. For every RdrName in the program text, find its GlobalRdrElt.\n\n2. Then, from the [ImportSpec] (gre_imp) of that GRE, choose one\n   the \"chosen import-item\", and mark it \"used\". This is done\n   by 'bestImport'\n\n3. After processing all the RdrNames, bleat about any\n   import-items that are unused.\n   This is done in RnNames.warnUnusedImportDecls.\n\nThe function 'bestImport' returns the dominant import among the\nImportSpecs it is given, implementing Step 2.  We say import-item A\ndominates import-item B if we choose A over B. In general, we try to\nchoose the import that is most likely to render other imports\nunnecessary.  Here is the dominance relationship we choose:\n\n    a) import Foo dominates import qualified Foo.\n\n    b) import Foo dominates import Foo(x).\n\n    c) Otherwise choose the textually first one.\n\nRationale for (a).  Consider\n   import qualified M  -- Import #1\n   import M( x )       -- Import #2\n   foo = M.x + x\n\nThe unqualified 'x' can only come from import #2.  The qualified 'M.x'\ncould come from either, but bestImport picks import #2, because it is\nmore likely to be useful in other imports, as indeed it is in this\ncase (see Trac #5211 for a concrete example).\n\nBut the rules are not perfect; consider\n   import qualified M  -- Import #1\n   import M( x )       -- Import #2\n   foo = M.x + M.y\n\nThe M.x will use import #2, but M.y can only use import #1.\n-}\n\n\nunQualSpecOK :: ImportSpec -> Bool\n-- ^ Is in scope unqualified?\nunQualSpecOK is = not (is_qual (is_decl is))\n\nqualSpecOK :: ModuleName -> ImportSpec -> Bool\n-- ^ Is in scope qualified with the given module?\nqualSpecOK mod is = mod == is_as (is_decl is)\n\nimportSpecLoc :: ImportSpec -> SrcSpan\nimportSpecLoc (ImpSpec decl ImpAll) = is_dloc decl\nimportSpecLoc (ImpSpec _    item)   = is_iloc item\n\nimportSpecModule :: ImportSpec -> ModuleName\nimportSpecModule is = is_mod (is_decl is)\n\nisExplicitItem :: ImpItemSpec -> Bool\nisExplicitItem ImpAll                        = False\nisExplicitItem (ImpSome {is_explicit = exp}) = exp\n\npprNameProvenance :: GlobalRdrElt -> SDoc\n-- ^ Print out one place where the name was define/imported\n-- (With -dppr-debug, print them all)\npprNameProvenance (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })\n  = ifPprDebug (vcat pp_provs)\n               (head pp_provs)\n  where\n    pp_provs = pp_lcl ++ map pp_is iss\n    pp_lcl = if lcl then [text \"defined at\" <+> ppr (nameSrcLoc name)]\n                    else []\n    pp_is is = sep [ppr is, ppr_defn_site is name]\n\n-- If we know the exact definition point (which we may do with GHCi)\n-- then show that too.  But not if it's just \"imported from X\".\nppr_defn_site :: ImportSpec -> Name -> SDoc\nppr_defn_site imp_spec name\n  | same_module && not (isGoodSrcSpan loc)\n  = empty              -- Nothing interesting to say\n  | otherwise\n  = parens $ hang (text \"and originally defined\" <+> pp_mod)\n                2 (pprLoc loc)\n  where\n    loc = nameSrcSpan name\n    defining_mod = ASSERT2( isExternalName name, ppr name ) nameModule name\n    same_module = importSpecModule imp_spec == moduleName defining_mod\n    pp_mod | same_module = empty\n           | otherwise   = text \"in\" <+> quotes (ppr defining_mod)\n\n\ninstance Outputable ImportSpec where\n   ppr imp_spec\n     = text \"imported\" <+> qual\n        <+> text \"from\" <+> quotes (ppr (importSpecModule imp_spec))\n        <+> pprLoc (importSpecLoc imp_spec)\n     where\n       qual | is_qual (is_decl imp_spec) = text \"qualified\"\n            | otherwise                  = empty\n\npprLoc :: SrcSpan -> SDoc\npprLoc (RealSrcSpan s)    = text \"at\" <+> ppr s\npprLoc (UnhelpfulSpan {}) = empty\n\n-- | Display info about the treatment of '*' under NoStarIsType.\n--\n-- With StarIsType, three properties of '*' hold:\n--\n--   (a) it is not an infix operator\n--   (b) it is always in scope\n--   (c) it is a synonym for Data.Kind.Type\n--\n-- However, the user might not know that he's working on a module with\n-- NoStarIsType and write code that still assumes (a), (b), and (c), which\n-- actually do not hold in that module.\n--\n-- Violation of (a) shows up in the parser. For instance, in the following\n-- examples, we have '*' not applied to enough arguments:\n--\n--   data A :: *\n--   data F :: * -> *\n--\n-- Violation of (b) or (c) show up in the renamer and the typechecker\n-- respectively. For instance:\n--\n--   type K = Either * Bool\n--\n-- This will parse differently depending on whether StarIsType is enabled,\n-- but it will parse nonetheless. With NoStarIsType it is parsed as a type\n-- operator, thus we have ((*) Either Bool). Now there are two cases to\n-- consider:\n--\n--   1. There is no definition of (*) in scope. In this case the renamer will\n--      fail to look it up. This is a violation of assumption (b).\n--\n--   2. There is a definition of the (*) type operator in scope (for example\n--      coming from GHC.TypeNats). In this case the user will get a kind\n--      mismatch error. This is a violation of assumption (c).\n--\n-- The user might unknowingly be working on a module with NoStarIsType\n-- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a\n-- hint whenever an assumption about '*' is violated. Unfortunately, it is\n-- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).\n--\n-- 'starInfo' generates an appropriate hint to the user depending on the\n-- extensions enabled in the module and the name that triggered the error.\n-- That is, if we have NoStarIsType and the error is related to '*' or its\n-- Unicode variant, the resulting SDoc will contain a helpful suggestion.\n-- Otherwise it is empty.\n--\nstarInfo :: Bool -> RdrName -> SDoc\nstarInfo star_is_type rdr_name =\n  -- One might ask: if can use sdocWithDynFlags here, why bother to take\n  -- star_is_type as input? Why not refactor?\n  --\n  -- The reason is that sdocWithDynFlags would provide DynFlags that are active\n  -- in the module that tries to load the problematic definition, not\n  -- in the module that is being loaded.\n  --\n  -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint\n  -- must be displayed even if we load this definition from a module (or GHCi)\n  -- with StarIsType enabled!\n  --\n  if isUnqualStar && not star_is_type\n     then text \"With NoStarIsType, \" <>\n          quotes (ppr rdr_name) <>\n          text \" is treated as a regular type operator. \"\n        $$\n          text \"Did you mean to use \" <> quotes (text \"Type\") <>\n          text \" from Data.Kind instead?\"\n      else empty\n  where\n    -- Does rdr_name look like the user might have meant the '*' kind by it?\n    -- We focus on unqualified stars specifically, because qualified stars are\n    -- treated as type operators even under StarIsType.\n    isUnqualStar\n      | Unqual occName <- rdr_name\n      = let fs = occNameFS occName\n        in fs == fsLit \"*\" || fs == fsLit \"\u00e2\u02dc\u2026\"\n      | otherwise = False\n", "num_lines": 1407}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow, 1992-2006\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveFunctor      #-}\n{-# LANGUAGE DeriveFoldable     #-}\n{-# LANGUAGE DeriveTraversable  #-}\n{-# LANGUAGE FlexibleInstances  #-}\n{-# LANGUAGE RecordWildCards    #-}\n{-# LANGUAGE TypeFamilies       #-}\n{-# LANGUAGE ViewPatterns       #-}\n{-# LANGUAGE FlexibleContexts   #-}\n{-# LANGUAGE PatternSynonyms    #-}\n\n\n-- | This module contains types that relate to the positions of things\n-- in source files, and allow tagging of those things with locations\nmodule SrcLoc (\n        -- * SrcLoc\n        RealSrcLoc,             -- Abstract\n        SrcLoc(..),\n\n        -- ** Constructing SrcLoc\n        mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,\n\n        noSrcLoc,               -- \"I'm sorry, I haven't a clue\"\n        generatedSrcLoc,        -- Code generated within the compiler\n        interactiveSrcLoc,      -- Code from an interactive session\n\n        advanceSrcLoc,\n\n        -- ** Unsafely deconstructing SrcLoc\n        -- These are dubious exports, because they crash on some inputs\n        srcLocFile,             -- return the file name part\n        srcLocLine,             -- return the line part\n        srcLocCol,              -- return the column part\n\n        -- * SrcSpan\n        RealSrcSpan,            -- Abstract\n        SrcSpan(..),\n\n        -- ** Constructing SrcSpan\n        mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,\n        noSrcSpan,\n        wiredInSrcSpan,         -- Something wired into the compiler\n        interactiveSrcSpan,\n        srcLocSpan, realSrcLocSpan,\n        combineSrcSpans,\n        srcSpanFirstCharacter,\n\n        -- ** Deconstructing SrcSpan\n        srcSpanStart, srcSpanEnd,\n        realSrcSpanStart, realSrcSpanEnd,\n        srcSpanFileName_maybe,\n        pprUserRealSpan,\n\n        -- ** Unsafely deconstructing SrcSpan\n        -- These are dubious exports, because they crash on some inputs\n        srcSpanFile,\n        srcSpanStartLine, srcSpanEndLine,\n        srcSpanStartCol, srcSpanEndCol,\n\n        -- ** Predicates on SrcSpan\n        isGoodSrcSpan, isOneLineSpan,\n        containsSpan,\n\n        -- * Located\n        Located,\n        RealLocated,\n        GenLocated(..),\n\n        -- ** Constructing Located\n        noLoc,\n        mkGeneralLocated,\n\n        -- ** Deconstructing Located\n        getLoc, unLoc,\n        unRealSrcSpan, getRealSrcSpan,\n\n        -- ** Modifying Located\n        mapLoc,\n\n        -- ** Combining and comparing Located values\n        eqLocated, cmpLocated, combineLocs, addCLoc,\n        leftmost_smallest, leftmost_largest, rightmost,\n        spans, isSubspanOf, sortLocated,\n\n        -- ** HasSrcSpan\n        HasSrcSpan(..), SrcSpanLess, dL, cL,\n        pattern LL, onHasSrcSpan, liftL\n    ) where\n\nimport GhcPrelude\n\nimport Util\nimport Json\nimport Outputable\nimport FastString\n\nimport Control.DeepSeq\nimport Data.Bits\nimport Data.Data\nimport Data.List\nimport Data.Ord\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[SrcLoc-SrcLocations]{Source-location information}\n*                                                                      *\n************************************************************************\n\nWe keep information about the {\\em definition} point for each entity;\nthis is the obvious stuff:\n-}\n\n-- | Real Source Location\n--\n-- Represents a single point within a file\ndata RealSrcLoc\n  = SrcLoc      FastString              -- A precise location (file name)\n                {-# UNPACK #-} !Int     -- line number, begins at 1\n                {-# UNPACK #-} !Int     -- column number, begins at 1\n  deriving (Eq, Ord)\n\n-- | Source Location\ndata SrcLoc\n  = RealSrcLoc {-# UNPACK #-}!RealSrcLoc\n  | UnhelpfulLoc FastString     -- Just a general indication\n  deriving (Eq, Ord, Show)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[SrcLoc-access-fns]{Access functions}\n*                                                                      *\n************************************************************************\n-}\n\nmkSrcLoc :: FastString -> Int -> Int -> SrcLoc\nmkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)\n\nmkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc\nmkRealSrcLoc x line col = SrcLoc x line col\n\n-- | Built-in \"bad\" 'SrcLoc' values for particular locations\nnoSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc\nnoSrcLoc          = UnhelpfulLoc (fsLit \"<no location info>\")\ngeneratedSrcLoc   = UnhelpfulLoc (fsLit \"<compiler-generated code>\")\ninteractiveSrcLoc = UnhelpfulLoc (fsLit \"<interactive>\")\n\n-- | Creates a \"bad\" 'SrcLoc' that has no detailed information about its location\nmkGeneralSrcLoc :: FastString -> SrcLoc\nmkGeneralSrcLoc = UnhelpfulLoc\n\n-- | Gives the filename of the 'RealSrcLoc'\nsrcLocFile :: RealSrcLoc -> FastString\nsrcLocFile (SrcLoc fname _ _) = fname\n\n-- | Raises an error when used on a \"bad\" 'SrcLoc'\nsrcLocLine :: RealSrcLoc -> Int\nsrcLocLine (SrcLoc _ l _) = l\n\n-- | Raises an error when used on a \"bad\" 'SrcLoc'\nsrcLocCol :: RealSrcLoc -> Int\nsrcLocCol (SrcLoc _ _ c) = c\n\n-- | Move the 'SrcLoc' down by one line if the character is a newline,\n-- to the next 8-char tabstop if it is a tab, and across by one\n-- character in any other case\nadvanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc\nadvanceSrcLoc (SrcLoc f l _) '\\n' = SrcLoc f  (l + 1) 1\nadvanceSrcLoc (SrcLoc f l c) '\\t' = SrcLoc f  l (((((c - 1) `shiftR` 3) + 1)\n                                                  `shiftL` 3) + 1)\nadvanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[SrcLoc-instances]{Instance declarations for various names}\n*                                                                      *\n************************************************************************\n-}\n\nsortLocated :: HasSrcSpan a => [a] -> [a]\nsortLocated things = sortBy (comparing getLoc) things\n\ninstance Outputable RealSrcLoc where\n    ppr (SrcLoc src_path src_line src_col)\n      = hcat [ pprFastFilePath src_path <> colon\n             , int src_line <> colon\n             , int src_col ]\n\n-- I don't know why there is this style-based difference\n--        if userStyle sty || debugStyle sty then\n--            hcat [ pprFastFilePath src_path, char ':',\n--                   int src_line,\n--                   char ':', int src_col\n--                 ]\n--        else\n--            hcat [text \"{-# LINE \", int src_line, space,\n--                  char '\\\"', pprFastFilePath src_path, text \" #-}\"]\n\ninstance Outputable SrcLoc where\n    ppr (RealSrcLoc l) = ppr l\n    ppr (UnhelpfulLoc s)  = ftext s\n\ninstance Data RealSrcSpan where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"RealSrcSpan\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"RealSrcSpan\"\n\ninstance Data SrcSpan where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"SrcSpan\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"SrcSpan\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[SrcSpan]{Source Spans}\n*                                                                      *\n************************************************************************\n-}\n\n{- |\nA 'RealSrcSpan' delimits a portion of a text file.  It could be represented\nby a pair of (line,column) coordinates, but in fact we optimise\nslightly by using more compact representations for single-line and\nzero-length spans, both of which are quite common.\n\nThe end position is defined to be the column /after/ the end of the\nspan.  That is, a span of (1,1)-(1,2) is one character long, and a\nspan of (1,1)-(1,1) is zero characters long.\n-}\n\n-- | Real Source Span\ndata RealSrcSpan\n  = RealSrcSpan'\n        { srcSpanFile     :: !FastString,\n          srcSpanSLine    :: {-# UNPACK #-} !Int,\n          srcSpanSCol     :: {-# UNPACK #-} !Int,\n          srcSpanELine    :: {-# UNPACK #-} !Int,\n          srcSpanECol     :: {-# UNPACK #-} !Int\n        }\n  deriving Eq\n\n-- | Source Span\n--\n-- A 'SrcSpan' identifies either a specific portion of a text file\n-- or a human-readable description of a location.\ndata SrcSpan =\n    RealSrcSpan !RealSrcSpan\n  | UnhelpfulSpan !FastString   -- Just a general indication\n                                -- also used to indicate an empty span\n\n  deriving (Eq, Ord, Show) -- Show is used by Lexer.x, because we\n                           -- derive Show for Token\n\ninstance ToJson SrcSpan where\n  json (UnhelpfulSpan {} ) = JSNull --JSObject [( \"type\", \"unhelpful\")]\n  json (RealSrcSpan rss)  = json rss\n\ninstance ToJson RealSrcSpan where\n  json (RealSrcSpan'{..}) = JSObject [ (\"file\", JSString (unpackFS srcSpanFile))\n                                     , (\"startLine\", JSInt srcSpanSLine)\n                                     , (\"startCol\", JSInt srcSpanSCol)\n                                     , (\"endLine\", JSInt srcSpanELine)\n                                     , (\"endCol\", JSInt srcSpanECol)\n                                     ]\n\ninstance NFData SrcSpan where\n  rnf x = x `seq` ()\n\n-- | Built-in \"bad\" 'SrcSpan's for common sources of location uncertainty\nnoSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan\nnoSrcSpan          = UnhelpfulSpan (fsLit \"<no location info>\")\nwiredInSrcSpan     = UnhelpfulSpan (fsLit \"<wired into compiler>\")\ninteractiveSrcSpan = UnhelpfulSpan (fsLit \"<interactive>\")\n\n-- | Create a \"bad\" 'SrcSpan' that has not location information\nmkGeneralSrcSpan :: FastString -> SrcSpan\nmkGeneralSrcSpan = UnhelpfulSpan\n\n-- | Create a 'SrcSpan' corresponding to a single point\nsrcLocSpan :: SrcLoc -> SrcSpan\nsrcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str\nsrcLocSpan (RealSrcLoc l) = RealSrcSpan (realSrcLocSpan l)\n\nrealSrcLocSpan :: RealSrcLoc -> RealSrcSpan\nrealSrcLocSpan (SrcLoc file line col) = RealSrcSpan' file line col line col\n\n-- | Create a 'SrcSpan' between two points in a file\nmkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan\nmkRealSrcSpan loc1 loc2 = RealSrcSpan' file line1 col1 line2 col2\n  where\n        line1 = srcLocLine loc1\n        line2 = srcLocLine loc2\n        col1 = srcLocCol loc1\n        col2 = srcLocCol loc2\n        file = srcLocFile loc1\n\n-- | 'True' if the span is known to straddle only one line.\nisOneLineRealSpan :: RealSrcSpan -> Bool\nisOneLineRealSpan (RealSrcSpan' _ line1 _ line2 _)\n  = line1 == line2\n\n-- | 'True' if the span is a single point\nisPointRealSpan :: RealSrcSpan -> Bool\nisPointRealSpan (RealSrcSpan' _ line1 col1 line2 col2)\n  = line1 == line2 && col1 == col2\n\n-- | Create a 'SrcSpan' between two points in a file\nmkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan\nmkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str\nmkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str\nmkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)\n    = RealSrcSpan (mkRealSrcSpan loc1 loc2)\n\n-- | Combines two 'SrcSpan' into one that spans at least all the characters\n-- within both spans. Returns UnhelpfulSpan if the files differ.\ncombineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan\ncombineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful\ncombineSrcSpans l (UnhelpfulSpan _) = l\ncombineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)\n  | srcSpanFile span1 == srcSpanFile span2\n      = RealSrcSpan (combineRealSrcSpans span1 span2)\n  | otherwise = UnhelpfulSpan (fsLit \"<combineSrcSpans: files differ>\")\n\n-- | Combines two 'SrcSpan' into one that spans at least all the characters\n-- within both spans. Assumes the \"file\" part is the same in both inputs\ncombineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan\ncombineRealSrcSpans span1 span2\n  = RealSrcSpan' file line_start col_start line_end col_end\n  where\n    (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)\n                                  (srcSpanStartLine span2, srcSpanStartCol span2)\n    (line_end, col_end)     = max (srcSpanEndLine span1, srcSpanEndCol span1)\n                                  (srcSpanEndLine span2, srcSpanEndCol span2)\n    file = srcSpanFile span1\n\n-- | Convert a SrcSpan into one that represents only its first character\nsrcSpanFirstCharacter :: SrcSpan -> SrcSpan\nsrcSpanFirstCharacter l@(UnhelpfulSpan {}) = l\nsrcSpanFirstCharacter (RealSrcSpan span) = RealSrcSpan $ mkRealSrcSpan loc1 loc2\n  where\n    loc1@(SrcLoc f l c) = realSrcSpanStart span\n    loc2 = SrcLoc f l (c+1)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[SrcSpan-predicates]{Predicates}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Test if a 'SrcSpan' is \"good\", i.e. has precise location information\nisGoodSrcSpan :: SrcSpan -> Bool\nisGoodSrcSpan (RealSrcSpan _) = True\nisGoodSrcSpan (UnhelpfulSpan _) = False\n\nisOneLineSpan :: SrcSpan -> Bool\n-- ^ True if the span is known to straddle only one line.\n-- For \"bad\" 'SrcSpan', it returns False\nisOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s\nisOneLineSpan (UnhelpfulSpan _) = False\n\n-- | Tests whether the first span \"contains\" the other span, meaning\n-- that it covers at least as much source code. True where spans are equal.\ncontainsSpan :: RealSrcSpan -> RealSrcSpan -> Bool\ncontainsSpan s1 s2\n  = (srcSpanStartLine s1, srcSpanStartCol s1)\n       <= (srcSpanStartLine s2, srcSpanStartCol s2)\n    && (srcSpanEndLine s1, srcSpanEndCol s1)\n       >= (srcSpanEndLine s2, srcSpanEndCol s2)\n    && (srcSpanFile s1 == srcSpanFile s2)\n    -- We check file equality last because it is (presumably?) least\n    -- likely to fail.\n{-\n%************************************************************************\n%*                                                                      *\n\\subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}\n*                                                                      *\n************************************************************************\n-}\n\nsrcSpanStartLine :: RealSrcSpan -> Int\nsrcSpanEndLine :: RealSrcSpan -> Int\nsrcSpanStartCol :: RealSrcSpan -> Int\nsrcSpanEndCol :: RealSrcSpan -> Int\n\nsrcSpanStartLine RealSrcSpan'{ srcSpanSLine=l } = l\nsrcSpanEndLine RealSrcSpan'{ srcSpanELine=l } = l\nsrcSpanStartCol RealSrcSpan'{ srcSpanSCol=l } = l\nsrcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[SrcSpan-access-fns]{Access functions}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Returns the location at the start of the 'SrcSpan' or a \"bad\" 'SrcSpan' if that is unavailable\nsrcSpanStart :: SrcSpan -> SrcLoc\nsrcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str\nsrcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)\n\n-- | Returns the location at the end of the 'SrcSpan' or a \"bad\" 'SrcSpan' if that is unavailable\nsrcSpanEnd :: SrcSpan -> SrcLoc\nsrcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str\nsrcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)\n\nrealSrcSpanStart :: RealSrcSpan -> RealSrcLoc\nrealSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)\n                                  (srcSpanStartLine s)\n                                  (srcSpanStartCol s)\n\nrealSrcSpanEnd :: RealSrcSpan -> RealSrcLoc\nrealSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)\n                                (srcSpanEndLine s)\n                                (srcSpanEndCol s)\n\n-- | Obtains the filename for a 'SrcSpan' if it is \"good\"\nsrcSpanFileName_maybe :: SrcSpan -> Maybe FastString\nsrcSpanFileName_maybe (RealSrcSpan s)   = Just (srcSpanFile s)\nsrcSpanFileName_maybe (UnhelpfulSpan _) = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[SrcSpan-instances]{Instances}\n*                                                                      *\n************************************************************************\n-}\n\n-- We want to order RealSrcSpans first by the start point, then by the\n-- end point.\ninstance Ord RealSrcSpan where\n  a `compare` b =\n     (realSrcSpanStart a `compare` realSrcSpanStart b) `thenCmp`\n     (realSrcSpanEnd   a `compare` realSrcSpanEnd   b)\n\ninstance Show RealSrcLoc where\n  show (SrcLoc filename row col)\n      = \"SrcLoc \" ++ show filename ++ \" \" ++ show row ++ \" \" ++ show col\n\n-- Show is used by Lexer.x, because we derive Show for Token\ninstance Show RealSrcSpan where\n  show span@(RealSrcSpan' file sl sc el ec)\n    | isPointRealSpan span\n    = \"SrcSpanPoint \" ++ show file ++ \" \" ++ intercalate \" \" (map show [sl,sc])\n\n    | isOneLineRealSpan span\n    = \"SrcSpanOneLine \" ++ show file ++ \" \"\n                        ++ intercalate \" \" (map show [sl,sc,ec])\n\n    | otherwise\n    = \"SrcSpanMultiLine \" ++ show file ++ \" \"\n                          ++ intercalate \" \" (map show [sl,sc,el,ec])\n\n\ninstance Outputable RealSrcSpan where\n    ppr span = pprUserRealSpan True span\n\n-- I don't know why there is this style-based difference\n--      = getPprStyle $ \\ sty ->\n--        if userStyle sty || debugStyle sty then\n--           text (showUserRealSpan True span)\n--        else\n--           hcat [text \"{-# LINE \", int (srcSpanStartLine span), space,\n--                 char '\\\"', pprFastFilePath $ srcSpanFile span, text \" #-}\"]\n\ninstance Outputable SrcSpan where\n    ppr span = pprUserSpan True span\n\n-- I don't know why there is this style-based difference\n--      = getPprStyle $ \\ sty ->\n--        if userStyle sty || debugStyle sty then\n--           pprUserSpan True span\n--        else\n--           case span of\n--           UnhelpfulSpan _ -> panic \"Outputable UnhelpfulSpan\"\n--           RealSrcSpan s -> ppr s\n\npprUserSpan :: Bool -> SrcSpan -> SDoc\npprUserSpan _         (UnhelpfulSpan s) = ftext s\npprUserSpan show_path (RealSrcSpan s)   = pprUserRealSpan show_path s\n\npprUserRealSpan :: Bool -> RealSrcSpan -> SDoc\npprUserRealSpan show_path span@(RealSrcSpan' src_path line col _ _)\n  | isPointRealSpan span\n  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)\n         , int line <> colon\n         , int col ]\n\npprUserRealSpan show_path span@(RealSrcSpan' src_path line scol _ ecol)\n  | isOneLineRealSpan span\n  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)\n         , int line <> colon\n         , int scol\n         , ppUnless (ecol - scol <= 1) (char '-' <> int (ecol - 1)) ]\n            -- For single-character or point spans, we just\n            -- output the starting column number\n\npprUserRealSpan show_path (RealSrcSpan' src_path sline scol eline ecol)\n  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)\n         , parens (int sline <> comma <> int scol)\n         , char '-'\n         , parens (int eline <> comma <> int ecol') ]\n where\n   ecol' = if ecol == 0 then ecol else ecol - 1\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Located]{Attaching SrcSpans to things}\n*                                                                      *\n************************************************************************\n-}\n\n-- | We attach SrcSpans to lots of things, so let's have a datatype for it.\ndata GenLocated l e = L l e\n  deriving (Eq, Ord, Data, Functor, Foldable, Traversable)\n\ntype Located = GenLocated SrcSpan\ntype RealLocated = GenLocated RealSrcSpan\n\nmapLoc :: (a -> b) -> GenLocated l a -> GenLocated l b\nmapLoc = fmap\n\nunLoc :: HasSrcSpan a => a -> SrcSpanLess a\nunLoc (dL->L _ e) = e\n\ngetLoc :: HasSrcSpan a => a -> SrcSpan\ngetLoc (dL->L l _) = l\n\nnoLoc :: HasSrcSpan a => SrcSpanLess a -> a\nnoLoc e = cL noSrcSpan e\n\nmkGeneralLocated :: HasSrcSpan e => String -> SrcSpanLess e -> e\nmkGeneralLocated s e = cL (mkGeneralSrcSpan (fsLit s)) e\n\ncombineLocs :: (HasSrcSpan a , HasSrcSpan b) => a -> b -> SrcSpan\ncombineLocs a b = combineSrcSpans (getLoc a) (getLoc b)\n\n-- | Combine locations from two 'Located' things and add them to a third thing\naddCLoc :: (HasSrcSpan a , HasSrcSpan b , HasSrcSpan c) =>\n           a -> b -> SrcSpanLess c -> c\naddCLoc a b c = cL (combineSrcSpans (getLoc a) (getLoc b)) c\n\n-- not clear whether to add a general Eq instance, but this is useful sometimes:\n\n-- | Tests whether the two located things are equal\neqLocated :: (HasSrcSpan a , Eq (SrcSpanLess a)) => a -> a -> Bool\neqLocated a b = unLoc a == unLoc b\n\n-- not clear whether to add a general Ord instance, but this is useful sometimes:\n\n-- | Tests the ordering of the two located things\ncmpLocated :: (HasSrcSpan a , Ord (SrcSpanLess a)) => a -> a -> Ordering\ncmpLocated a b = unLoc a `compare` unLoc b\n\ninstance (Outputable l, Outputable e) => Outputable (GenLocated l e) where\n  ppr (L l e) = -- TODO: We can't do this since Located was refactored into\n                -- GenLocated:\n                -- Print spans without the file name etc\n                -- ifPprDebug (braces (pprUserSpan False l))\n                whenPprDebug (braces (ppr l))\n             $$ ppr e\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Ordering SrcSpans for InteractiveUI}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Alternative strategies for ordering 'SrcSpan's\nleftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering\nrightmost            = flip compare\nleftmost_smallest    = compare\nleftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)\n                                `thenCmp`\n                       (srcSpanEnd b `compare` srcSpanEnd a)\n\n-- | Determines whether a span encloses a given line and column index\nspans :: SrcSpan -> (Int, Int) -> Bool\nspans (UnhelpfulSpan _) _ = panic \"spans UnhelpfulSpan\"\nspans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span\n   where loc = mkRealSrcLoc (srcSpanFile span) l c\n\n-- | Determines whether a span is enclosed by another one\nisSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other\n            -> SrcSpan -- ^ The span it may be enclosed by\n            -> Bool\nisSubspanOf src parent\n    | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False\n    | otherwise = srcSpanStart parent <= srcSpanStart src &&\n                  srcSpanEnd parent   >= srcSpanEnd src\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{HasSrcSpan Typeclass to Set/Get Source Location Spans}\n*                                                                      *\n************************************************************************\n-}\n\n{-\nNote [HasSrcSpan Typeclass]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nTo be able to uniformly set/get source location spans (of `SrcSpan`) in\nsyntactic entities (`HsSyn`), we use the typeclass `HasSrcSpan`.\nMore details can be found at the following wiki page\n  ImplementingTreesThatGrow/HandlingSourceLocations\n\nFor most syntactic entities, the source location spans are stored in\na syntactic entity by a wapper constuctor (introduced by TTG's\nnew constructor extension), e.g., by `NewPat (WrapperPat sp pat)`\nfor a source location span `sp` and a pattern `pat`.\n-}\n\n-- | Determines the type of undecorated syntactic entities\n-- For most syntactic entities `E`, where source location spans are\n-- introduced by a wrapper construtor of the same syntactic entity,\n-- we have `SrcSpanLess E = E`.\n-- However, some syntactic entities have a different type compared to\n-- a syntactic entity `e :: E` may have the type `Located E` when\n-- decorated by wrapping it with `L sp e` for a source span `sp`.\ntype family SrcSpanLess a\n\n-- | A typeclass to set/get SrcSpans\nclass HasSrcSpan a where\n  -- | Composes a `SrcSpan` decoration with an undecorated syntactic\n  --   entity to form its decorated variant\n  composeSrcSpan   :: Located (SrcSpanLess a) -> a\n\n  -- | Decomposes a decorated syntactic entity into its `SrcSpan`\n  --   decoration and its undecorated variant\n  decomposeSrcSpan :: a -> Located (SrcSpanLess a)\n  {- laws:\n       composeSrcSpan . decomposeSrcSpan = id\n       decomposeSrcSpan . composeSrcSpan = id\n\n     in other words, `HasSrcSpan` defines an iso relation between\n     a `SrcSpan`-decorated syntactic entity and its undecorated variant\n     (together with the `SrcSpan`).\n  -}\n\ntype instance SrcSpanLess (GenLocated l e) = e\ninstance HasSrcSpan (Located a) where\n  composeSrcSpan   = id\n  decomposeSrcSpan = id\n\n\n-- | An abbreviated form of decomposeSrcSpan,\n--   mainly to be used in ViewPatterns\ndL :: HasSrcSpan a => a -> Located (SrcSpanLess a)\ndL = decomposeSrcSpan\n\n-- | An abbreviated form of composeSrcSpan,\n--   mainly to replace the hardcoded `L`\ncL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a\ncL sp e = composeSrcSpan (L sp e)\n\n-- | A Pattern Synonym to Set/Get SrcSpans\npattern LL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a\npattern LL sp e <- (dL->L sp e)\n  where\n        LL sp e = cL sp e\n\n-- | Lifts a function of undecorated entities to one of decorated ones\nonHasSrcSpan :: (HasSrcSpan a , HasSrcSpan b) =>\n                (SrcSpanLess a -> SrcSpanLess b) -> a -> b\nonHasSrcSpan f (dL->L l e) = cL l (f e)\n\nliftL :: (HasSrcSpan a, HasSrcSpan b, Monad m) =>\n         (SrcSpanLess a -> m (SrcSpanLess b)) -> a -> m b\nliftL f (dL->L loc a) = do\n  a' <- f a\n  return $ cL loc a'\n\n\ngetRealSrcSpan :: RealLocated a -> RealSrcSpan\ngetRealSrcSpan (L l _) = l\n\nunRealSrcSpan :: RealLocated a -> a\nunRealSrcSpan  (L _ e) = e\n", "num_lines": 697}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP, UnboxedTuples #-}\n\nmodule UniqSupply (\n        -- * Main data type\n        UniqSupply, -- Abstractly\n\n        -- ** Operations on supplies\n        uniqFromSupply, uniqsFromSupply, -- basic ops\n        takeUniqFromSupply,\n\n        mkSplitUniqSupply,\n        splitUniqSupply, listSplitUniqSupply,\n        splitUniqSupply3, splitUniqSupply4,\n\n        -- * Unique supply monad and its abstraction\n        UniqSM, MonadUnique(..), liftUs,\n\n        -- ** Operations on the monad\n        initUs, initUs_,\n        lazyThenUs, lazyMapUs,\n        getUniqueSupplyM3,\n\n        -- * Set supply strategy\n        initUniqSupply\n  ) where\n\nimport GhcPrelude\n\nimport Unique\nimport Panic (panic)\n\nimport GHC.IO\n\nimport MonadUtils\nimport Control.Monad\nimport Data.Bits\nimport Data.Char\nimport Control.Monad.Fail as Fail\n\n#include \"Unique.h\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Splittable Unique supply: @UniqSupply@}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Unique Supply\n--\n-- A value of type 'UniqSupply' is unique, and it can\n-- supply /one/ distinct 'Unique'.  Also, from the supply, one can\n-- also manufacture an arbitrary number of further 'UniqueSupply' values,\n-- which will be distinct from the first and from all others.\ndata UniqSupply\n  = MkSplitUniqSupply {-# UNPACK #-} !Int -- make the Unique with this\n                   UniqSupply UniqSupply\n                                -- when split => these two supplies\n\nmkSplitUniqSupply :: Char -> IO UniqSupply\n-- ^ Create a unique supply out of thin air. The character given must\n-- be distinct from those of all calls to this function in the compiler\n-- for the values generated to be truly unique.\n\nsplitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)\n-- ^ Build two 'UniqSupply' from a single one, each of which\n-- can supply its own 'Unique'.\nlistSplitUniqSupply :: UniqSupply -> [UniqSupply]\n-- ^ Create an infinite list of 'UniqSupply' from a single one\nuniqFromSupply  :: UniqSupply -> Unique\n-- ^ Obtain the 'Unique' from this particular 'UniqSupply'\nuniqsFromSupply :: UniqSupply -> [Unique] -- Infinite\n-- ^ Obtain an infinite list of 'Unique' that can be generated by constant splitting of the supply\ntakeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)\n-- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply\n\nmkSplitUniqSupply c\n  = case ord c `shiftL` uNIQUE_BITS of\n     mask -> let\n        -- here comes THE MAGIC:\n\n        -- This is one of the most hammered bits in the whole compiler\n        mk_supply\n          -- NB: Use unsafeInterleaveIO for thread-safety.\n          = unsafeInterleaveIO (\n                genSym      >>= \\ u ->\n                mk_supply   >>= \\ s1 ->\n                mk_supply   >>= \\ s2 ->\n                return (MkSplitUniqSupply (mask .|. u) s1 s2)\n            )\n       in\n       mk_supply\n\nforeign import ccall unsafe \"genSym\" genSym :: IO Int\nforeign import ccall unsafe \"initGenSym\" initUniqSupply :: Int -> Int -> IO ()\n\nsplitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)\nlistSplitUniqSupply  (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2\n\nuniqFromSupply  (MkSplitUniqSupply n _ _)  = mkUniqueGrimily n\nuniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2\ntakeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1)\n\n-- | Build three 'UniqSupply' from a single one,\n-- each of which can supply its own unique\nsplitUniqSupply3 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply)\nsplitUniqSupply3 us = (us1, us2, us3)\n  where\n    (us1, us') = splitUniqSupply us\n    (us2, us3) = splitUniqSupply us'\n\n-- | Build four 'UniqSupply' from a single one,\n-- each of which can supply its own unique\nsplitUniqSupply4 :: UniqSupply -> (UniqSupply, UniqSupply, UniqSupply, UniqSupply)\nsplitUniqSupply4 us = (us1, us2, us3, us4)\n  where\n    (us1, us2, us') = splitUniqSupply3 us\n    (us3, us4)      = splitUniqSupply us'\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[UniqSupply-monad]{@UniqSupply@ monad: @UniqSM@}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A monad which just gives the ability to obtain 'Unique's\nnewtype UniqSM result = USM { unUSM :: UniqSupply -> (# result, UniqSupply #) }\n\ninstance Monad UniqSM where\n  (>>=) = thenUs\n  (>>)  = (*>)\n\ninstance Functor UniqSM where\n    fmap f (USM x) = USM (\\us -> case x us of\n                                 (# r, us' #) -> (# f r, us' #))\n\ninstance Applicative UniqSM where\n    pure = returnUs\n    (USM f) <*> (USM x) = USM $ \\us -> case f us of\n                            (# ff, us' #)  -> case x us' of\n                              (# xx, us'' #) -> (# ff xx, us'' #)\n    (*>) = thenUs_\n\n-- TODO: try to get rid of this instance\ninstance Fail.MonadFail UniqSM where\n    fail = panic\n\n-- | Run the 'UniqSM' action, returning the final 'UniqSupply'\ninitUs :: UniqSupply -> UniqSM a -> (a, UniqSupply)\ninitUs init_us m = case unUSM m init_us of { (# r, us #) -> (r,us) }\n\n-- | Run the 'UniqSM' action, discarding the final 'UniqSupply'\ninitUs_ :: UniqSupply -> UniqSM a -> a\ninitUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r }\n\n{-# INLINE thenUs #-}\n{-# INLINE lazyThenUs #-}\n{-# INLINE returnUs #-}\n{-# INLINE splitUniqSupply #-}\n\n-- @thenUs@ is where we split the @UniqSupply@.\n\nliftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)\nliftUSM (USM m) us = case m us of (# a, us' #) -> (a, us')\n\ninstance MonadFix UniqSM where\n    mfix m = USM (\\us -> let (r,us') = liftUSM (m r) us in (# r,us' #))\n\nthenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b\nthenUs (USM expr) cont\n  = USM (\\us -> case (expr us) of\n                   (# result, us' #) -> unUSM (cont result) us')\n\nlazyThenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b\nlazyThenUs expr cont\n  = USM (\\us -> let (result, us') = liftUSM expr us in unUSM (cont result) us')\n\nthenUs_ :: UniqSM a -> UniqSM b -> UniqSM b\nthenUs_ (USM expr) (USM cont)\n  = USM (\\us -> case (expr us) of { (# _, us' #) -> cont us' })\n\nreturnUs :: a -> UniqSM a\nreturnUs result = USM (\\us -> (# result, us #))\n\ngetUs :: UniqSM UniqSupply\ngetUs = USM (\\us -> case splitUniqSupply us of (us1,us2) -> (# us1, us2 #))\n\n-- | A monad for generating unique identifiers\nclass Monad m => MonadUnique m where\n    -- | Get a new UniqueSupply\n    getUniqueSupplyM :: m UniqSupply\n    -- | Get a new unique identifier\n    getUniqueM  :: m Unique\n    -- | Get an infinite list of new unique identifiers\n    getUniquesM :: m [Unique]\n\n    -- This default definition of getUniqueM, while correct, is not as\n    -- efficient as it could be since it needlessly generates and throws away\n    -- an extra Unique. For your instances consider providing an explicit\n    -- definition for 'getUniqueM' which uses 'takeUniqFromSupply' directly.\n    getUniqueM  = liftM uniqFromSupply  getUniqueSupplyM\n    getUniquesM = liftM uniqsFromSupply getUniqueSupplyM\n\ninstance MonadUnique UniqSM where\n    getUniqueSupplyM = getUs\n    getUniqueM  = getUniqueUs\n    getUniquesM = getUniquesUs\n\ngetUniqueSupplyM3 :: MonadUnique m => m (UniqSupply, UniqSupply, UniqSupply)\ngetUniqueSupplyM3 = liftM3 (,,) getUniqueSupplyM getUniqueSupplyM getUniqueSupplyM\n\nliftUs :: MonadUnique m => UniqSM a -> m a\nliftUs m = getUniqueSupplyM >>= return . flip initUs_ m\n\ngetUniqueUs :: UniqSM Unique\ngetUniqueUs = USM (\\us -> case takeUniqFromSupply us of\n                          (u,us') -> (# u, us' #))\n\ngetUniquesUs :: UniqSM [Unique]\ngetUniquesUs = USM (\\us -> case splitUniqSupply us of\n                           (us1,us2) -> (# uniqsFromSupply us1, us2 #))\n\n-- {-# SPECIALIZE mapM          :: (a -> UniqSM b) -> [a] -> UniqSM [b] #-}\n-- {-# SPECIALIZE mapAndUnzipM  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c]) #-}\n-- {-# SPECIALIZE mapAndUnzip3M :: (a -> UniqSM (b,c,d)) -> [a] -> UniqSM ([b],[c],[d]) #-}\n\nlazyMapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]\nlazyMapUs _ []     = returnUs []\nlazyMapUs f (x:xs)\n  = f x             `lazyThenUs` \\ r  ->\n    lazyMapUs f xs  `lazyThenUs` \\ rs ->\n    returnUs (r:rs)\n", "num_lines": 241}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\n@Uniques@ are used to distinguish entities in the compiler (@Ids@,\n@Classes@, etc.) from each other.  Thus, @Uniques@ are the basic\ncomparison key in the compiler.\n\nIf there is any single operation that needs to be fast, it is @Unique@\n\ncomparison.  Unsurprisingly, there is quite a bit of huff-and-puff\ndirected to that end.\n\nSome of the other hair in this code is to be able to use a\n``splittable @UniqueSupply@'' if requested/possible (not standard\nHaskell).\n-}\n\n{-# LANGUAGE CPP, BangPatterns, MagicHash #-}\n\nmodule Unique (\n        -- * Main data types\n        Unique, Uniquable(..),\n        uNIQUE_BITS,\n\n        -- ** Constructors, destructors and operations on 'Unique's\n        hasKey,\n\n        pprUniqueAlways,\n\n        mkUniqueGrimily,                -- Used in UniqSupply only!\n        getKey,                         -- Used in Var, UniqFM, Name only!\n        mkUnique, unpkUnique,           -- Used in BinIface only\n        eqUnique, ltUnique,\n\n        deriveUnique,                   -- Ditto\n        newTagUnique,                   -- Used in CgCase\n        initTyVarUnique,\n        initExitJoinUnique,\n        nonDetCmpUnique,\n        isValidKnownKeyUnique,          -- Used in PrelInfo.knownKeyNamesOkay\n\n        -- ** Making built-in uniques\n\n        -- now all the built-in Uniques (and functions to make them)\n        -- [the Oh-So-Wonderful Haskell module system wins again...]\n        mkAlphaTyVarUnique,\n        mkPrimOpIdUnique,\n        mkPreludeMiscIdUnique, mkPreludeDataConUnique,\n        mkPreludeTyConUnique, mkPreludeClassUnique,\n        mkCoVarUnique,\n\n        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,\n        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,\n        mkCostCentreUnique,\n\n        mkBuiltinUnique,\n        mkPseudoUniqueD,\n        mkPseudoUniqueE,\n        mkPseudoUniqueH,\n\n        -- ** Deriving uniques\n        -- *** From TyCon name uniques\n        tyConRepNameUnique,\n        -- *** From DataCon name uniques\n        dataConWorkerUnique, dataConTyRepNameUnique\n    ) where\n\n#include \"HsVersions.h\"\n#include \"Unique.h\"\n\nimport GhcPrelude\n\nimport BasicTypes\nimport FastString\nimport Outputable\nimport Util\n\n-- just for implementing a fast [0,61) -> Char function\nimport GHC.Exts (indexCharOffAddr#, Char(..), Int(..))\n\nimport Data.Char        ( chr, ord )\nimport Data.Bits\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Unique-type]{@Unique@ type and operations}\n*                                                                      *\n************************************************************************\n\nThe @Chars@ are ``tag letters'' that identify the @UniqueSupply@.\nFast comparison is everything on @Uniques@:\n-}\n\n-- | Unique identifier.\n--\n-- The type of unique identifiers that are used in many places in GHC\n-- for fast ordering and equality tests. You should generate these with\n-- the functions from the 'UniqSupply' module\n--\n-- These are sometimes also referred to as \\\"keys\\\" in comments in GHC.\nnewtype Unique = MkUnique Int\n\n{-# INLINE uNIQUE_BITS #-}\nuNIQUE_BITS :: Int\nuNIQUE_BITS = finiteBitSize (0 :: Int) - UNIQUE_TAG_BITS\n\n{-\nNow come the functions which construct uniques from their pieces, and vice versa.\nThe stuff about unique *supplies* is handled further down this module.\n-}\n\nunpkUnique      :: Unique -> (Char, Int)        -- The reverse\n\nmkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply\ngetKey          :: Unique -> Int                -- for Var\n\nincrUnique   :: Unique -> Unique\nstepUnique   :: Unique -> Int -> Unique\nderiveUnique :: Unique -> Int -> Unique\nnewTagUnique :: Unique -> Char -> Unique\n\nmkUniqueGrimily = MkUnique\n\n{-# INLINE getKey #-}\ngetKey (MkUnique x) = x\n\nincrUnique (MkUnique i) = MkUnique (i + 1)\nstepUnique (MkUnique i) n = MkUnique (i + n)\n\n-- deriveUnique uses an 'X' tag so that it won't clash with\n-- any of the uniques produced any other way\n-- SPJ says: this looks terribly smelly to me!\nderiveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)\n\n-- newTagUnique changes the \"domain\" of a unique to a different char\nnewTagUnique u c = mkUnique c i where (_,i) = unpkUnique u\n\n-- | How many bits are devoted to the unique index (as opposed to the class\n-- character).\nuniqueMask :: Int\nuniqueMask = (1 `shiftL` uNIQUE_BITS) - 1\n\n-- pop the Char in the top 8 bits of the Unique(Supply)\n\n-- No 64-bit bugs here, as long as we have at least 32 bits. --JSM\n\n-- and as long as the Char fits in 8 bits, which we assume anyway!\n\nmkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces\n-- NOT EXPORTED, so that we can see all the Chars that\n--               are used in this one module\nmkUnique c i\n  = MkUnique (tag .|. bits)\n  where\n    tag  = ord c `shiftL` uNIQUE_BITS\n    bits = i .&. uniqueMask\n\nunpkUnique (MkUnique u)\n  = let\n        -- as long as the Char may have its eighth bit set, we\n        -- really do need the logical right-shift here!\n        tag = chr (u `shiftR` uNIQUE_BITS)\n        i   = u .&. uniqueMask\n    in\n    (tag, i)\n\n-- | The interface file symbol-table encoding assumes that known-key uniques fit\n-- in 30-bits; verify this.\n--\n-- See Note [Symbol table representation of names] in BinIface for details.\nisValidKnownKeyUnique :: Unique -> Bool\nisValidKnownKeyUnique u =\n    case unpkUnique u of\n      (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Uniquable-class]{The @Uniquable@ class}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Class of things that we can obtain a 'Unique' from\nclass Uniquable a where\n    getUnique :: a -> Unique\n\nhasKey          :: Uniquable a => a -> Unique -> Bool\nx `hasKey` k    = getUnique x == k\n\ninstance Uniquable FastString where\n getUnique fs = mkUniqueGrimily (uniqueOfFS fs)\n\ninstance Uniquable Int where\n getUnique i = mkUniqueGrimily i\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Unique-instances]{Instance declarations for @Unique@}\n*                                                                      *\n************************************************************************\n\nAnd the whole point (besides uniqueness) is fast equality.  We don't\nuse `deriving' because we want {\\em precise} control of ordering\n(equality on @Uniques@ is v common).\n-}\n\n-- Note [Unique Determinism]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~\n-- The order of allocated @Uniques@ is not stable across rebuilds.\n-- The main reason for that is that typechecking interface files pulls\n-- @Uniques@ from @UniqSupply@ and the interface file for the module being\n-- currently compiled can, but doesn't have to exist.\n--\n-- It gets more complicated if you take into account that the interface\n-- files are loaded lazily and that building multiple files at once has to\n-- work for any subset of interface files present. When you add parallelism\n-- this makes @Uniques@ hopelessly random.\n--\n-- As such, to get deterministic builds, the order of the allocated\n-- @Uniques@ should not affect the final result.\n-- see also wiki/DeterministicBuilds\n--\n-- Note [Unique Determinism and code generation]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- The goal of the deterministic builds (wiki/DeterministicBuilds, #4012)\n-- is to get ABI compatible binaries given the same inputs and environment.\n-- The motivation behind that is that if the ABI doesn't change the\n-- binaries can be safely reused.\n-- Note that this is weaker than bit-for-bit identical binaries and getting\n-- bit-for-bit identical binaries is not a goal for now.\n-- This means that we don't care about nondeterminism that happens after\n-- the interface files are created, in particular we don't care about\n-- register allocation and code generation.\n-- To track progress on bit-for-bit determinism see #12262.\n\neqUnique :: Unique -> Unique -> Bool\neqUnique (MkUnique u1) (MkUnique u2) = u1 == u2\n\nltUnique :: Unique -> Unique -> Bool\nltUnique (MkUnique u1) (MkUnique u2) = u1 < u2\n\n-- Provided here to make it explicit at the call-site that it can\n-- introduce non-determinism.\n-- See Note [Unique Determinism]\n-- See Note [No Ord for Unique]\nnonDetCmpUnique :: Unique -> Unique -> Ordering\nnonDetCmpUnique (MkUnique u1) (MkUnique u2)\n  = if u1 == u2 then EQ else if u1 < u2 then LT else GT\n\n{-\nNote [No Ord for Unique]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs explained in Note [Unique Determinism] the relative order of Uniques\nis nondeterministic. To prevent from accidental use the Ord Unique\ninstance has been removed.\nThis makes it easier to maintain deterministic builds, but comes with some\ndrawbacks.\nThe biggest drawback is that Maps keyed by Uniques can't directly be used.\nThe alternatives are:\n\n  1) Use UniqFM or UniqDFM, see Note [Deterministic UniqFM] to decide which\n  2) Create a newtype wrapper based on Unique ordering where nondeterminism\n     is controlled. See Module.ModuleEnv\n  3) Change the algorithm to use nonDetCmpUnique and document why it's still\n     deterministic\n  4) Use TrieMap as done in CmmCommonBlockElim.groupByLabel\n-}\n\ninstance Eq Unique where\n    a == b = eqUnique a b\n    a /= b = not (eqUnique a b)\n\ninstance Uniquable Unique where\n    getUnique u = u\n\n-- We do sometimes make strings with @Uniques@ in them:\n\nshowUnique :: Unique -> String\nshowUnique uniq\n  = case unpkUnique uniq of\n      (tag, u) -> finish_show tag u (iToBase62 u)\n\nfinish_show :: Char -> Int -> String -> String\nfinish_show 't' u _pp_u | u < 26\n  = -- Special case to make v common tyvars, t1, t2, ...\n    -- come out as a, b, ... (shorter, easier to read)\n    [chr (ord 'a' + u)]\nfinish_show tag _ pp_u = tag : pp_u\n\npprUniqueAlways :: Unique -> SDoc\n-- The \"always\" means regardless of -dsuppress-uniques\n-- It replaces the old pprUnique to remind callers that\n-- they should consider whether they want to consult\n-- Opt_SuppressUniques\npprUniqueAlways u\n  = text (showUnique u)\n\ninstance Outputable Unique where\n    ppr = pprUniqueAlways\n\ninstance Show Unique where\n    show uniq = showUnique uniq\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-base62]{Base-62 numbers}\n*                                                                      *\n************************************************************************\n\nA character-stingy way to read/write numbers (notably Uniques).\nThe ``62-its'' are \\tr{[0-9a-zA-Z]}.  We don't handle negative Ints.\nCode stolen from Lennart.\n-}\n\niToBase62 :: Int -> String\niToBase62 n_\n  = ASSERT(n_ >= 0) go n_ \"\"\n  where\n    go n cs | n < 62\n            = let !c = chooseChar62 n in c : cs\n            | otherwise\n            = go q (c : cs) where (!q, r) = quotRem n 62\n                                  !c = chooseChar62 r\n\n    chooseChar62 :: Int -> Char\n    {-# INLINE chooseChar62 #-}\n    chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)\n    chars62 = \"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\"#\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}\n*                                                                      *\n************************************************************************\n\nAllocation of unique supply characters:\n        v,t,u : for renumbering value-, type- and usage- vars.\n        B:   builtin\n        C-E: pseudo uniques     (used in native-code generator)\n        X:   uniques derived by deriveUnique\n        _:   unifiable tyvars   (above)\n        0-9: prelude things below\n             (no numbers left any more..)\n        ::   (prelude) parallel array data constructors\n\n        other a-z: lower case chars for unique supplies.  Used so far:\n\n        d       desugarer\n        f       AbsC flattener\n        g       SimplStg\n        k       constraint tuple tycons\n        m       constraint tuple datacons\n        n       Native codegen\n        r       Hsc name cache\n        s       simplifier\n        z       anonymous sums\n-}\n\nmkAlphaTyVarUnique     :: Int -> Unique\nmkPreludeClassUnique   :: Int -> Unique\nmkPreludeTyConUnique   :: Int -> Unique\nmkPreludeDataConUnique :: Arity -> Unique\nmkPrimOpIdUnique       :: Int -> Unique\nmkPreludeMiscIdUnique  :: Int -> Unique\nmkCoVarUnique          :: Int -> Unique\n\nmkAlphaTyVarUnique   i = mkUnique '1' i\nmkCoVarUnique        i = mkUnique 'g' i\nmkPreludeClassUnique i = mkUnique '2' i\n\n--------------------------------------------------\n-- Wired-in type constructor keys occupy *two* slots:\n--    * u: the TyCon itself\n--    * u+1: the TyConRepName of the TyCon\nmkPreludeTyConUnique i                = mkUnique '3' (2*i)\n\ntyConRepNameUnique :: Unique -> Unique\ntyConRepNameUnique  u = incrUnique u\n\n-- Data constructor keys occupy *two* slots.  The first is used for the\n-- data constructor itself and its wrapper function (the function that\n-- evaluates arguments as necessary and calls the worker). The second is\n-- used for the worker function (the function that builds the constructor\n-- representation).\n\n--------------------------------------------------\n-- Wired-in data constructor keys occupy *three* slots:\n--    * u: the DataCon itself\n--    * u+1: its worker Id\n--    * u+2: the TyConRepName of the promoted TyCon\n-- Prelude data constructors are too simple to need wrappers.\n\nmkPreludeDataConUnique i              = mkUnique '6' (3*i)    -- Must be alphabetic\n\n--------------------------------------------------\ndataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique\ndataConWorkerUnique  u = incrUnique u\ndataConTyRepNameUnique u = stepUnique u 2\n\n--------------------------------------------------\nmkPrimOpIdUnique op         = mkUnique '9' op\nmkPreludeMiscIdUnique  i    = mkUnique '0' i\n\n-- The \"tyvar uniques\" print specially nicely: a, b, c, etc.\n-- See pprUnique for details\n\ninitTyVarUnique :: Unique\ninitTyVarUnique = mkUnique 't' 0\n\nmkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,\n   mkBuiltinUnique :: Int -> Unique\n\nmkBuiltinUnique i = mkUnique 'B' i\nmkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs\nmkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs\nmkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs\n\nmkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique\nmkRegSingleUnique = mkUnique 'R'\nmkRegSubUnique    = mkUnique 'S'\nmkRegPairUnique   = mkUnique 'P'\nmkRegClassUnique  = mkUnique 'L'\n\nmkCostCentreUnique :: Int -> Unique\nmkCostCentreUnique = mkUnique 'C'\n\nmkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique\n-- See Note [The Unique of an OccName] in OccName\nmkVarOccUnique  fs = mkUnique 'i' (uniqueOfFS fs)\nmkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)\nmkTvOccUnique   fs = mkUnique 'v' (uniqueOfFS fs)\nmkTcOccUnique   fs = mkUnique 'c' (uniqueOfFS fs)\n\ninitExitJoinUnique :: Unique\ninitExitJoinUnique = mkUnique 's' 0\n", "num_lines": 443}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section{@Vars@: Variables}\n-}\n\n{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, FlexibleInstances, DeriveDataTypeable #-}\n\n-- |\n-- #name_types#\n-- GHC uses several kinds of name internally:\n--\n-- * 'OccName.OccName': see \"OccName#name_types\"\n--\n-- * 'RdrName.RdrName': see \"RdrName#name_types\"\n--\n-- * 'Name.Name': see \"Name#name_types\"\n--\n-- * 'Id.Id': see \"Id#name_types\"\n--\n-- * 'Var.Var' is a synonym for the 'Id.Id' type but it may additionally\n--   potentially contain type variables, which have a 'TyCoRep.Kind'\n--   rather than a 'TyCoRep.Type' and only contain some extra\n--   details during typechecking.\n--\n--   These 'Var.Var' names may either be global or local, see \"Var#globalvslocal\"\n--\n-- #globalvslocal#\n-- Global 'Id's and 'Var's are those that are imported or correspond\n--    to a data constructor, primitive operation, or record selectors.\n-- Local 'Id's and 'Var's are those bound within an expression\n--    (e.g. by a lambda) or at the top level of the module being compiled.\n\nmodule Var (\n        -- * The main data type and synonyms\n        Var, CoVar, Id, NcId, DictId, DFunId, EvVar, EqVar, EvId, IpId, JoinId,\n        TyVar, TcTyVar, TypeVar, KindVar, TKVar, TyCoVar,\n\n        -- * In and Out variants\n        InVar,  InCoVar,  InId,  InTyVar,\n        OutVar, OutCoVar, OutId, OutTyVar,\n\n        -- ** Taking 'Var's apart\n        varName, varUnique, varType,\n\n        -- ** Modifying 'Var's\n        setVarName, setVarUnique, setVarType, updateVarType,\n        updateVarTypeM,\n\n        -- ** Constructing, taking apart, modifying 'Id's\n        mkGlobalVar, mkLocalVar, mkExportedLocalVar, mkCoVar,\n        idInfo, idDetails,\n        lazySetIdInfo, setIdDetails, globaliseId,\n        setIdExported, setIdNotExported,\n\n        -- ** Predicates\n        isId, isTyVar, isTcTyVar,\n        isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar,\n        isGlobalId, isExportedId,\n        mustHaveLocalBinding,\n\n        -- * ArgFlags\n        ArgFlag(..), isVisibleArgFlag, isInvisibleArgFlag, sameVis,\n        AnonArgFlag(..), ForallVisFlag(..), argToForallVisFlag,\n\n        -- * TyVar's\n        VarBndr(..), TyCoVarBinder, TyVarBinder,\n        binderVar, binderVars, binderArgFlag, binderType,\n        mkTyCoVarBinder, mkTyCoVarBinders,\n        mkTyVarBinder, mkTyVarBinders,\n        isTyVarBinder,\n\n        -- ** Constructing TyVar's\n        mkTyVar, mkTcTyVar,\n\n        -- ** Taking 'TyVar's apart\n        tyVarName, tyVarKind, tcTyVarDetails, setTcTyVarDetails,\n\n        -- ** Modifying 'TyVar's\n        setTyVarName, setTyVarUnique, setTyVarKind, updateTyVarKind,\n        updateTyVarKindM,\n\n        nonDetCmpVar\n\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   TyCoRep( Type, Kind, pprKind )\nimport {-# SOURCE #-}   TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv )\nimport {-# SOURCE #-}   IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails,\n                                vanillaIdInfo, pprIdDetails )\n\nimport Name hiding (varName)\nimport Unique ( Uniquable, Unique, getKey, getUnique\n              , mkUniqueGrimily, nonDetCmpUnique )\nimport Util\nimport Binary\nimport DynFlags\nimport Outputable\n\nimport Data.Data\n\n{-\n************************************************************************\n*                                                                      *\n                     Synonyms\n*                                                                      *\n************************************************************************\n-- These synonyms are here and not in Id because otherwise we need a very\n-- large number of SOURCE imports of Id.hs :-(\n-}\n\n-- | Identifier\ntype Id    = Var       -- A term-level identifier\n                       --  predicate: isId\n\n-- | Coercion Variable\ntype CoVar = Id        -- See Note [Evidence: EvIds and CoVars]\n                       --   predicate: isCoVar\n\n-- |\ntype NcId  = Id        -- A term-level (value) variable that is\n                       -- /not/ an (unlifted) coercion\n                       --    predicate: isNonCoVarId\n\n-- | Type or kind Variable\ntype TyVar   = Var     -- Type *or* kind variable (historical)\n\n-- | Type or Kind Variable\ntype TKVar   = Var     -- Type *or* kind variable (historical)\n\n-- | Type variable that might be a metavariable\ntype TcTyVar = Var\n\n-- | Type Variable\ntype TypeVar = Var     -- Definitely a type variable\n\n-- | Kind Variable\ntype KindVar = Var     -- Definitely a kind variable\n                       -- See Note [Kind and type variables]\n\n-- See Note [Evidence: EvIds and CoVars]\n-- | Evidence Identifier\ntype EvId   = Id        -- Term-level evidence: DictId, IpId, or EqVar\n\n-- | Evidence Variable\ntype EvVar  = EvId      -- ...historical name for EvId\n\n-- | Dictionary Function Identifier\ntype DFunId = Id        -- A dictionary function\n\n-- | Dictionary Identifier\ntype DictId = EvId      -- A dictionary variable\n\n-- | Implicit parameter Identifier\ntype IpId   = EvId      -- A term-level implicit parameter\n\n-- | Equality Variable\ntype EqVar  = EvId      -- Boxed equality evidence\ntype JoinId = Id        -- A join variable\n\n-- | Type or Coercion Variable\ntype TyCoVar = Id       -- Type, *or* coercion variable\n                        --   predicate: isTyCoVar\n\n\n{- Many passes apply a substitution, and it's very handy to have type\n   synonyms to remind us whether or not the substitution has been applied -}\n\ntype InVar      = Var\ntype InTyVar    = TyVar\ntype InCoVar    = CoVar\ntype InId       = Id\ntype OutVar     = Var\ntype OutTyVar   = TyVar\ntype OutCoVar   = CoVar\ntype OutId      = Id\n\n\n\n{- Note [Evidence: EvIds and CoVars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* An EvId (evidence Id) is a term-level evidence variable\n  (dictionary, implicit parameter, or equality). Could be boxed or unboxed.\n\n* DictId, IpId, and EqVar are synonyms when we know what kind of\n  evidence we are talking about.  For example, an EqVar has type (t1 ~ t2).\n\n* A CoVar is always an un-lifted coercion, of type (t1 ~# t2) or (t1 ~R# t2)\n\nNote [Kind and type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBefore kind polymorphism, TyVar were used to mean type variables. Now\nthey are used to mean kind *or* type variables. KindVar is used when we\nknow for sure that it is a kind variable. In future, we might want to\ngo over the whole compiler code to use:\n   - TKVar   to mean kind or type variables\n   - TypeVar to mean         type variables only\n   - KindVar to mean kind         variables\n\n\n************************************************************************\n*                                                                      *\n\\subsection{The main data type declarations}\n*                                                                      *\n************************************************************************\n\n\nEvery @Var@ has a @Unique@, to uniquify it and for fast comparison, a\n@Type@, and an @IdInfo@ (non-essential info about it, e.g.,\nstrictness).  The essential info about different kinds of @Vars@ is\nin its @VarDetails@.\n-}\n\n-- | Variable\n--\n-- Essentially a typed 'Name', that may also contain some additional information\n-- about the 'Var' and its use sites.\ndata Var\n  = TyVar {  -- Type and kind variables\n             -- see Note [Kind and type variables]\n        varName    :: !Name,\n        realUnique :: {-# UNPACK #-} !Int,\n                                     -- ^ Key for fast comparison\n                                     -- Identical to the Unique in the name,\n                                     -- cached here for speed\n        varType    :: Kind           -- ^ The type or kind of the 'Var' in question\n }\n\n  | TcTyVar {                           -- Used only during type inference\n                                        -- Used for kind variables during\n                                        -- inference, as well\n        varName        :: !Name,\n        realUnique     :: {-# UNPACK #-} !Int,\n        varType        :: Kind,\n        tc_tv_details  :: TcTyVarDetails\n  }\n\n  | Id {\n        varName    :: !Name,\n        realUnique :: {-# UNPACK #-} !Int,\n        varType    :: Type,\n        idScope    :: IdScope,\n        id_details :: IdDetails,        -- Stable, doesn't change\n        id_info    :: IdInfo }          -- Unstable, updated by simplifier\n\n-- | Identifier Scope\ndata IdScope    -- See Note [GlobalId/LocalId]\n  = GlobalId\n  | LocalId ExportFlag\n\ndata ExportFlag   -- See Note [ExportFlag on binders]\n  = NotExported   -- ^ Not exported: may be discarded as dead code.\n  | Exported      -- ^ Exported: kept alive\n\n{- Note [ExportFlag on binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn ExportFlag of \"Exported\" on a top-level binder says \"keep this\nbinding alive; do not drop it as dead code\".  This transitively\nkeeps alive all the other top-level bindings that this binding refers\nto.  This property is persisted all the way down the pipeline, so that\nthe binding will be compiled all the way to object code, and its\nsymbols will appear in the linker symbol table.\n\nHowever, note that this use of \"exported\" is quite different to the\nexport list on a Haskell module.  Setting the ExportFlag on an Id does\n/not/ mean that if you import the module (in Haskell source code) you\nwill see this Id.  Of course, things that appear in the export list\nof the source Haskell module do indeed have their ExportFlag set.\nBut many other things, such as dictionary functions, are kept alive\nby having their ExportFlag set, even though they are not exported\nin the source-code sense.\n\nWe should probably use a different term for ExportFlag, like\nKeepAlive.\n\nNote [GlobalId/LocalId]\n~~~~~~~~~~~~~~~~~~~~~~~\nA GlobalId is\n  * always a constant (top-level)\n  * imported, or data constructor, or primop, or record selector\n  * has a Unique that is globally unique across the whole\n    GHC invocation (a single invocation may compile multiple modules)\n  * never treated as a candidate by the free-variable finder;\n        it's a constant!\n\nA LocalId is\n  * bound within an expression (lambda, case, local let(rec))\n  * or defined at top level in the module being compiled\n  * always treated as a candidate by the free-variable finder\n\nAfter CoreTidy, top-level LocalIds are turned into GlobalIds\n-}\n\ninstance Outputable Var where\n  ppr var = sdocWithDynFlags $ \\dflags ->\n            getPprStyle $ \\ppr_style ->\n            if |  debugStyle ppr_style && (not (gopt Opt_SuppressVarKinds dflags))\n                 -> parens (ppr (varName var) <+> ppr_debug var ppr_style <+>\n                          dcolon <+> pprKind (tyVarKind var))\n               |  otherwise\n                 -> ppr (varName var) <> ppr_debug var ppr_style\n\nppr_debug :: Var -> PprStyle -> SDoc\nppr_debug (TyVar {}) sty\n  | debugStyle sty = brackets (text \"tv\")\nppr_debug (TcTyVar {tc_tv_details = d}) sty\n  | dumpStyle sty || debugStyle sty = brackets (pprTcTyVarDetails d)\nppr_debug (Id { idScope = s, id_details = d }) sty\n  | debugStyle sty = brackets (ppr_id_scope s <> pprIdDetails d)\nppr_debug _ _ = empty\n\nppr_id_scope :: IdScope -> SDoc\nppr_id_scope GlobalId              = text \"gid\"\nppr_id_scope (LocalId Exported)    = text \"lidx\"\nppr_id_scope (LocalId NotExported) = text \"lid\"\n\ninstance NamedThing Var where\n  getName = varName\n\ninstance Uniquable Var where\n  getUnique = varUnique\n\ninstance Eq Var where\n    a == b = realUnique a == realUnique b\n\ninstance Ord Var where\n    a <= b = realUnique a <= realUnique b\n    a <  b = realUnique a <  realUnique b\n    a >= b = realUnique a >= realUnique b\n    a >  b = realUnique a >  realUnique b\n    a `compare` b = a `nonDetCmpVar` b\n\n-- | Compare Vars by their Uniques.\n-- This is what Ord Var does, provided here to make it explicit at the\n-- call-site that it can introduce non-determinism.\n-- See Note [Unique Determinism]\nnonDetCmpVar :: Var -> Var -> Ordering\nnonDetCmpVar a b = varUnique a `nonDetCmpUnique` varUnique b\n\ninstance Data Var where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"Var\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"Var\"\n\ninstance HasOccName Var where\n  occName = nameOccName . varName\n\nvarUnique :: Var -> Unique\nvarUnique var = mkUniqueGrimily (realUnique var)\n\nsetVarUnique :: Var -> Unique -> Var\nsetVarUnique var uniq\n  = var { realUnique = getKey uniq,\n          varName = setNameUnique (varName var) uniq }\n\nsetVarName :: Var -> Name -> Var\nsetVarName var new_name\n  = var { realUnique = getKey (getUnique new_name),\n          varName = new_name }\n\nsetVarType :: Id -> Type -> Id\nsetVarType id ty = id { varType = ty }\n\nupdateVarType :: (Type -> Type) -> Id -> Id\nupdateVarType f id = id { varType = f (varType id) }\n\nupdateVarTypeM :: Monad m => (Type -> m Type) -> Id -> m Id\nupdateVarTypeM f id = do { ty' <- f (varType id)\n                         ; return (id { varType = ty' }) }\n\n{- *********************************************************************\n*                                                                      *\n*                   ArgFlag\n*                                                                      *\n********************************************************************* -}\n\n-- | Argument Flag\n--\n-- Is something required to appear in source Haskell ('Required'),\n-- permitted by request ('Specified') (visible type application), or\n-- prohibited entirely from appearing in source Haskell ('Inferred')?\n-- See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep\ndata ArgFlag = Inferred | Specified | Required\n  deriving (Eq, Ord, Data)\n  -- (<) on ArgFlag means \"is less visible than\"\n\n-- | Does this 'ArgFlag' classify an argument that is written in Haskell?\nisVisibleArgFlag :: ArgFlag -> Bool\nisVisibleArgFlag Required = True\nisVisibleArgFlag _        = False\n\n-- | Does this 'ArgFlag' classify an argument that is not written in Haskell?\nisInvisibleArgFlag :: ArgFlag -> Bool\nisInvisibleArgFlag = not . isVisibleArgFlag\n\n-- | Do these denote the same level of visibility? 'Required'\n-- arguments are visible, others are not. So this function\n-- equates 'Specified' and 'Inferred'. Used for printing.\nsameVis :: ArgFlag -> ArgFlag -> Bool\nsameVis Required Required = True\nsameVis Required _        = False\nsameVis _        Required = False\nsameVis _        _        = True\n\ninstance Outputable ArgFlag where\n  ppr Required  = text \"[req]\"\n  ppr Specified = text \"[spec]\"\n  ppr Inferred  = text \"[infrd]\"\n\ninstance Binary ArgFlag where\n  put_ bh Required  = putByte bh 0\n  put_ bh Specified = putByte bh 1\n  put_ bh Inferred  = putByte bh 2\n\n  get bh = do\n    h <- getByte bh\n    case h of\n      0 -> return Required\n      1 -> return Specified\n      _ -> return Inferred\n\n-- | The non-dependent version of 'ArgFlag'.\n\n-- Appears here partly so that it's together with its friend ArgFlag,\n-- but also because it is used in IfaceType, rather early in the\n-- compilation chain\n-- See Note [AnonArgFlag vs. ForallVisFlag]\ndata AnonArgFlag\n  = VisArg    -- ^ Used for @(->)@: an ordinary non-dependent arrow.\n              --   The argument is visible in source code.\n  | InvisArg  -- ^ Used for @(=>)@: a non-dependent predicate arrow.\n              --   The argument is invisible in source code.\n  deriving (Eq, Ord, Data)\n\ninstance Outputable AnonArgFlag where\n  ppr VisArg   = text \"[vis]\"\n  ppr InvisArg = text \"[invis]\"\n\ninstance Binary AnonArgFlag where\n  put_ bh VisArg   = putByte bh 0\n  put_ bh InvisArg = putByte bh 1\n\n  get bh = do\n    h <- getByte bh\n    case h of\n      0 -> return VisArg\n      _ -> return InvisArg\n\n-- | Is a @forall@ invisible (e.g., @forall a b. {...}@, with a dot) or visible\n-- (e.g., @forall a b -> {...}@, with an arrow)?\n\n-- See Note [AnonArgFlag vs. ForallVisFlag]\ndata ForallVisFlag\n  = ForallVis   -- ^ A visible @forall@ (with an arrow)\n  | ForallInvis -- ^ An invisible @forall@ (with a dot)\n  deriving (Eq, Ord, Data)\n\ninstance Outputable ForallVisFlag where\n  ppr f = text $ case f of\n                   ForallVis   -> \"ForallVis\"\n                   ForallInvis -> \"ForallInvis\"\n\n-- | Convert an 'ArgFlag' to its corresponding 'ForallVisFlag'.\nargToForallVisFlag :: ArgFlag -> ForallVisFlag\nargToForallVisFlag Required  = ForallVis\nargToForallVisFlag Specified = ForallInvis\nargToForallVisFlag Inferred  = ForallInvis\n\n{-\nNote [AnonArgFlag vs. ForallVisFlag]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe AnonArgFlag and ForallVisFlag data types are quite similar at a first\nglance:\n\n  data AnonArgFlag   = VisArg    | InvisArg\n  data ForallVisFlag = ForallVis | ForallInvis\n\nBoth data types keep track of visibility of some sort. AnonArgFlag tracks\nwhether a FunTy has a visible argument (->) or an invisible predicate argument\n(=>). ForallVisFlag tracks whether a `forall` quantifier is visible\n(forall a -> {...}) or invisible (forall a. {...}).\n\nGiven their similarities, it's tempting to want to combine these two data types\ninto one, but they actually represent distinct concepts. AnonArgFlag reflects a\nproperty of *Core* types, whereas ForallVisFlag reflects a property of the GHC\nAST. In other words, AnonArgFlag is all about internals, whereas ForallVisFlag\nis all about surface syntax. Therefore, they are kept as separate data types.\n-}\n\n{- *********************************************************************\n*                                                                      *\n*                   VarBndr, TyCoVarBinder\n*                                                                      *\n********************************************************************* -}\n\n-- Variable Binder\n--\n-- VarBndr is polymorphic in both var and visibility fields.\n-- Currently there are six different uses of 'VarBndr':\n--   * Var.TyVarBinder   = VarBndr TyVar ArgFlag\n--   * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag\n--   * TyCon.TyConBinder     = VarBndr TyVar TyConBndrVis\n--   * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis\n--   * IfaceType.IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag\n--   * IfaceType.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis\ndata VarBndr var argf = Bndr var argf\n  deriving( Data )\n\n-- | Variable Binder\n--\n-- A 'TyCoVarBinder' is the binder of a ForAllTy\n-- It's convenient to define this synonym here rather its natural\n-- home in TyCoRep, because it's used in DataCon.hs-boot\n--\n-- A 'TyVarBinder' is a binder with only TyVar\ntype TyCoVarBinder = VarBndr TyCoVar ArgFlag\ntype TyVarBinder   = VarBndr TyVar ArgFlag\n\nbinderVar :: VarBndr tv argf -> tv\nbinderVar (Bndr v _) = v\n\nbinderVars :: [VarBndr tv argf] -> [tv]\nbinderVars tvbs = map binderVar tvbs\n\nbinderArgFlag :: VarBndr tv argf -> argf\nbinderArgFlag (Bndr _ argf) = argf\n\nbinderType :: VarBndr TyCoVar argf -> Type\nbinderType (Bndr tv _) = varType tv\n\n-- | Make a named binder\nmkTyCoVarBinder :: ArgFlag -> TyCoVar -> TyCoVarBinder\nmkTyCoVarBinder vis var = Bndr var vis\n\n-- | Make a named binder\n-- 'var' should be a type variable\nmkTyVarBinder :: ArgFlag -> TyVar -> TyVarBinder\nmkTyVarBinder vis var\n  = ASSERT( isTyVar var )\n    Bndr var vis\n\n-- | Make many named binders\nmkTyCoVarBinders :: ArgFlag -> [TyCoVar] -> [TyCoVarBinder]\nmkTyCoVarBinders vis = map (mkTyCoVarBinder vis)\n\n-- | Make many named binders\n-- Input vars should be type variables\nmkTyVarBinders :: ArgFlag -> [TyVar] -> [TyVarBinder]\nmkTyVarBinders vis = map (mkTyVarBinder vis)\n\nisTyVarBinder :: TyCoVarBinder -> Bool\nisTyVarBinder (Bndr v _) = isTyVar v\n\ninstance Outputable tv => Outputable (VarBndr tv ArgFlag) where\n  ppr (Bndr v Required)  = ppr v\n  ppr (Bndr v Specified) = char '@' <> ppr v\n  ppr (Bndr v Inferred)  = braces (ppr v)\n\ninstance (Binary tv, Binary vis) => Binary (VarBndr tv vis) where\n  put_ bh (Bndr tv vis) = do { put_ bh tv; put_ bh vis }\n\n  get bh = do { tv <- get bh; vis <- get bh; return (Bndr tv vis) }\n\ninstance NamedThing tv => NamedThing (VarBndr tv flag) where\n  getName (Bndr tv _) = getName tv\n\n{-\n************************************************************************\n*                                                                      *\n*                 Type and kind variables                              *\n*                                                                      *\n************************************************************************\n-}\n\ntyVarName :: TyVar -> Name\ntyVarName = varName\n\ntyVarKind :: TyVar -> Kind\ntyVarKind = varType\n\nsetTyVarUnique :: TyVar -> Unique -> TyVar\nsetTyVarUnique = setVarUnique\n\nsetTyVarName :: TyVar -> Name -> TyVar\nsetTyVarName   = setVarName\n\nsetTyVarKind :: TyVar -> Kind -> TyVar\nsetTyVarKind tv k = tv {varType = k}\n\nupdateTyVarKind :: (Kind -> Kind) -> TyVar -> TyVar\nupdateTyVarKind update tv = tv {varType = update (tyVarKind tv)}\n\nupdateTyVarKindM :: (Monad m) => (Kind -> m Kind) -> TyVar -> m TyVar\nupdateTyVarKindM update tv\n  = do { k' <- update (tyVarKind tv)\n       ; return $ tv {varType = k'} }\n\nmkTyVar :: Name -> Kind -> TyVar\nmkTyVar name kind = TyVar { varName    = name\n                          , realUnique = getKey (nameUnique name)\n                          , varType  = kind\n                          }\n\nmkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar\nmkTcTyVar name kind details\n  = -- NB: 'kind' may be a coercion kind; cf, 'TcMType.newMetaCoVar'\n    TcTyVar {   varName    = name,\n                realUnique = getKey (nameUnique name),\n                varType  = kind,\n                tc_tv_details = details\n        }\n\ntcTyVarDetails :: TyVar -> TcTyVarDetails\n-- See Note [TcTyVars in the typechecker] in TcType\ntcTyVarDetails (TcTyVar { tc_tv_details = details }) = details\ntcTyVarDetails (TyVar {})                            = vanillaSkolemTv\ntcTyVarDetails var = pprPanic \"tcTyVarDetails\" (ppr var <+> dcolon <+> pprKind (tyVarKind var))\n\nsetTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar\nsetTcTyVarDetails tv details = tv { tc_tv_details = details }\n\n{-\n%************************************************************************\n%*                                                                      *\n\\subsection{Ids}\n*                                                                      *\n************************************************************************\n-}\n\nidInfo :: HasDebugCallStack => Id -> IdInfo\nidInfo (Id { id_info = info }) = info\nidInfo other                   = pprPanic \"idInfo\" (ppr other)\n\nidDetails :: Id -> IdDetails\nidDetails (Id { id_details = details }) = details\nidDetails other                         = pprPanic \"idDetails\" (ppr other)\n\n-- The next three have a 'Var' suffix even though they always build\n-- Ids, because Id.hs uses 'mkGlobalId' etc with different types\nmkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id\nmkGlobalVar details name ty info\n  = mk_id name ty GlobalId details info\n\nmkLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id\nmkLocalVar details name ty info\n  = mk_id name ty (LocalId NotExported) details  info\n\nmkCoVar :: Name -> Type -> CoVar\n-- Coercion variables have no IdInfo\nmkCoVar name ty = mk_id name ty (LocalId NotExported) coVarDetails vanillaIdInfo\n\n-- | Exported 'Var's will not be removed as dead code\nmkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id\nmkExportedLocalVar details name ty info\n  = mk_id name ty (LocalId Exported) details info\n\nmk_id :: Name -> Type -> IdScope -> IdDetails -> IdInfo -> Id\nmk_id name ty scope details info\n  = Id { varName    = name,\n         realUnique = getKey (nameUnique name),\n         varType    = ty,\n         idScope    = scope,\n         id_details = details,\n         id_info    = info }\n\n-------------------\nlazySetIdInfo :: Id -> IdInfo -> Var\nlazySetIdInfo id info = id { id_info = info }\n\nsetIdDetails :: Id -> IdDetails -> Id\nsetIdDetails id details = id { id_details = details }\n\nglobaliseId :: Id -> Id\n-- ^ If it's a local, make it global\nglobaliseId id = id { idScope = GlobalId }\n\nsetIdExported :: Id -> Id\n-- ^ Exports the given local 'Id'. Can also be called on global 'Id's, such as data constructors\n-- and class operations, which are born as global 'Id's and automatically exported\nsetIdExported id@(Id { idScope = LocalId {} }) = id { idScope = LocalId Exported }\nsetIdExported id@(Id { idScope = GlobalId })   = id\nsetIdExported tv                               = pprPanic \"setIdExported\" (ppr tv)\n\nsetIdNotExported :: Id -> Id\n-- ^ We can only do this to LocalIds\nsetIdNotExported id = ASSERT( isLocalId id )\n                      id { idScope = LocalId NotExported }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Predicates over variables}\n*                                                                      *\n************************************************************************\n-}\n\nisTyVar :: Var -> Bool        -- True of both TyVar and TcTyVar\nisTyVar (TyVar {})   = True\nisTyVar (TcTyVar {}) = True\nisTyVar _            = False\n\nisTcTyVar :: Var -> Bool      -- True of TcTyVar only\nisTcTyVar (TcTyVar {}) = True\nisTcTyVar _            = False\n\nisTyCoVar :: Var -> Bool\nisTyCoVar v = isTyVar v || isCoVar v\n\nisId :: Var -> Bool\nisId (Id {}) = True\nisId _       = False\n\nisCoVar :: Var -> Bool\n-- A coercion variable\nisCoVar (Id { id_details = details }) = isCoVarDetails details\nisCoVar _                             = False\n\nisNonCoVarId :: Var -> Bool\n-- A term variable (Id) that is /not/ a coercion variable\nisNonCoVarId (Id { id_details = details }) = not (isCoVarDetails details)\nisNonCoVarId _                             = False\n\nisLocalId :: Var -> Bool\nisLocalId (Id { idScope = LocalId _ }) = True\nisLocalId _                            = False\n\n-- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's\n-- These are the variables that we need to pay attention to when finding free\n-- variables, or doing dependency analysis.\nisLocalVar :: Var -> Bool\nisLocalVar v = not (isGlobalId v)\n\nisGlobalId :: Var -> Bool\nisGlobalId (Id { idScope = GlobalId }) = True\nisGlobalId _                           = False\n\n-- | 'mustHaveLocalBinding' returns @True@ of 'Id's and 'TyVar's\n-- that must have a binding in this module.  The converse\n-- is not quite right: there are some global 'Id's that must have\n-- bindings, such as record selectors.  But that doesn't matter,\n-- because it's only used for assertions\nmustHaveLocalBinding        :: Var -> Bool\nmustHaveLocalBinding var = isLocalVar var\n\n-- | 'isExportedIdVar' means \\\"don't throw this away\\\"\nisExportedId :: Var -> Bool\nisExportedId (Id { idScope = GlobalId })        = True\nisExportedId (Id { idScope = LocalId Exported}) = True\nisExportedId _ = False\n", "num_lines": 756}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\nmodule VarEnv (\n        -- * Var, Id and TyVar environments (maps)\n        VarEnv, IdEnv, TyVarEnv, CoVarEnv, TyCoVarEnv,\n\n        -- ** Manipulating these environments\n        emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,\n        elemVarEnv, disjointVarEnv,\n        extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,\n        extendVarEnvList,\n        plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,\n        plusVarEnvList, alterVarEnv,\n        delVarEnvList, delVarEnv, delVarEnv_Directly,\n        minusVarEnv, intersectsVarEnv,\n        lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,\n        mapVarEnv, zipVarEnv,\n        modifyVarEnv, modifyVarEnv_Directly,\n        isEmptyVarEnv,\n        elemVarEnvByKey, lookupVarEnv_Directly,\n        filterVarEnv, filterVarEnv_Directly, restrictVarEnv,\n        partitionVarEnv,\n\n        -- * Deterministic Var environments (maps)\n        DVarEnv, DIdEnv, DTyVarEnv,\n\n        -- ** Manipulating these environments\n        emptyDVarEnv, mkDVarEnv,\n        dVarEnvElts,\n        extendDVarEnv, extendDVarEnv_C,\n        extendDVarEnvList,\n        lookupDVarEnv, elemDVarEnv,\n        isEmptyDVarEnv, foldDVarEnv,\n        mapDVarEnv, filterDVarEnv,\n        modifyDVarEnv,\n        alterDVarEnv,\n        plusDVarEnv, plusDVarEnv_C,\n        unitDVarEnv,\n        delDVarEnv,\n        delDVarEnvList,\n        minusDVarEnv,\n        partitionDVarEnv,\n        anyDVarEnv,\n\n        -- * The InScopeSet type\n        InScopeSet,\n\n        -- ** Operations on InScopeSets\n        emptyInScopeSet, mkInScopeSet, delInScopeSet,\n        extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,\n        getInScopeVars, lookupInScope, lookupInScope_Directly,\n        unionInScope, elemInScopeSet, uniqAway,\n        varSetInScope,\n\n        -- * The RnEnv2 type\n        RnEnv2,\n\n        -- ** Operations on RnEnv2s\n        mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var,\n        rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,\n        rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap,\n        delBndrL, delBndrR, delBndrsL, delBndrsR,\n        addRnInScopeSet,\n        rnEtaL, rnEtaR,\n        rnInScope, rnInScopeSet, lookupRnInScope,\n        rnEnvL, rnEnvR,\n\n        -- * TidyEnv and its operation\n        TidyEnv,\n        emptyTidyEnv, mkEmptyTidyEnv\n    ) where\n\nimport GhcPrelude\n\nimport OccName\nimport Var\nimport VarSet\nimport UniqSet\nimport UniqFM\nimport UniqDFM\nimport Unique\nimport Util\nimport Maybes\nimport Outputable\n\n{-\n************************************************************************\n*                                                                      *\n                In-scope sets\n*                                                                      *\n************************************************************************\n-}\n\n-- | A set of variables that are in scope at some point\n-- \"Secrets of the Glasgow Haskell Compiler inliner\" Section 3.2 provides\n-- the motivation for this abstraction.\ndata InScopeSet = InScope VarSet {-# UNPACK #-} !Int\n        -- We store a VarSet here, but we use this for lookups rather than\n        -- just membership tests. Typically the InScopeSet contains the\n        -- canonical version of the variable (e.g. with an informative\n        -- unfolding), so this lookup is useful.\n        --\n        -- The Int is a kind of hash-value used by uniqAway\n        -- For example, it might be the size of the set\n        -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway\n\ninstance Outputable InScopeSet where\n  ppr (InScope s _) =\n    text \"InScope\" <+>\n    braces (fsep (map (ppr . Var.varName) (nonDetEltsUniqSet s)))\n                      -- It's OK to use nonDetEltsUniqSet here because it's\n                      -- only for pretty printing\n                      -- In-scope sets get big, and with -dppr-debug\n                      -- the output is overwhelming\n\nemptyInScopeSet :: InScopeSet\nemptyInScopeSet = InScope emptyVarSet 1\n\ngetInScopeVars ::  InScopeSet -> VarSet\ngetInScopeVars (InScope vs _) = vs\n\nmkInScopeSet :: VarSet -> InScopeSet\nmkInScopeSet in_scope = InScope in_scope 1\n\nextendInScopeSet :: InScopeSet -> Var -> InScopeSet\nextendInScopeSet (InScope in_scope n) v\n   = InScope (extendVarSet in_scope v) (n + 1)\n\nextendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet\nextendInScopeSetList (InScope in_scope n) vs\n   = InScope (foldl' (\\s v -> extendVarSet s v) in_scope vs)\n                    (n + length vs)\n\nextendInScopeSetSet :: InScopeSet -> VarSet -> InScopeSet\nextendInScopeSetSet (InScope in_scope n) vs\n   = InScope (in_scope `unionVarSet` vs) (n + sizeUniqSet vs)\n\ndelInScopeSet :: InScopeSet -> Var -> InScopeSet\ndelInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarSet` v) n\n\nelemInScopeSet :: Var -> InScopeSet -> Bool\nelemInScopeSet v (InScope in_scope _) = v `elemVarSet` in_scope\n\n-- | Look up a variable the 'InScopeSet'.  This lets you map from\n-- the variable's identity (unique) to its full value.\nlookupInScope :: InScopeSet -> Var -> Maybe Var\nlookupInScope (InScope in_scope _) v  = lookupVarSet in_scope v\n\nlookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var\nlookupInScope_Directly (InScope in_scope _) uniq\n  = lookupVarSet_Directly in_scope uniq\n\nunionInScope :: InScopeSet -> InScopeSet -> InScopeSet\nunionInScope (InScope s1 _) (InScope s2 n2)\n  = InScope (s1 `unionVarSet` s2) n2\n\nvarSetInScope :: VarSet -> InScopeSet -> Bool\nvarSetInScope vars (InScope s1 _) = vars `subVarSet` s1\n\n-- | @uniqAway in_scope v@ finds a unique that is not used in the\n-- in-scope set, and gives that to v.\nuniqAway :: InScopeSet -> Var -> Var\n-- It starts with v's current unique, of course, in the hope that it won't\n-- have to change, and thereafter uses a combination of that and the hash-code\n-- found in the in-scope set\nuniqAway in_scope var\n  | var `elemInScopeSet` in_scope = uniqAway' in_scope var      -- Make a new one\n  | otherwise                     = var                         -- Nothing to do\n\nuniqAway' :: InScopeSet -> Var -> Var\n-- This one *always* makes up a new variable\nuniqAway' (InScope set n) var\n  = try 1\n  where\n    orig_unique = getUnique var\n    try k\n          | debugIsOn && (k > 1000)\n          = pprPanic \"uniqAway loop:\" msg\n          | uniq `elemVarSetByKey` set = try (k + 1)\n          | k > 3\n          = pprTraceDebug \"uniqAway:\" msg\n            setVarUnique var uniq\n          | otherwise = setVarUnique var uniq\n          where\n            msg  = ppr k <+> text \"tries\" <+> ppr var <+> int n\n            uniq = deriveUnique orig_unique (n * k)\n\n{-\n************************************************************************\n*                                                                      *\n                Dual renaming\n*                                                                      *\n************************************************************************\n-}\n\n-- | Rename Environment 2\n--\n-- When we are comparing (or matching) types or terms, we are faced with\n-- \\\"going under\\\" corresponding binders.  E.g. when comparing:\n--\n-- > \\x. e1     ~   \\y. e2\n--\n-- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of\n-- things we must be careful of.  In particular, @x@ might be free in @e2@, or\n-- y in @e1@.  So the idea is that we come up with a fresh binder that is free\n-- in neither, and rename @x@ and @y@ respectively.  That means we must maintain:\n--\n-- 1. A renaming for the left-hand expression\n--\n-- 2. A renaming for the right-hand expressions\n--\n-- 3. An in-scope set\n--\n-- Furthermore, when matching, we want to be able to have an 'occurs check',\n-- to prevent:\n--\n-- > \\x. f   ~   \\y. y\n--\n-- matching with [@f@ -> @y@].  So for each expression we want to know that set of\n-- locally-bound variables. That is precisely the domain of the mappings 1.\n-- and 2., but we must ensure that we always extend the mappings as we go in.\n--\n-- All of this information is bundled up in the 'RnEnv2'\ndata RnEnv2\n  = RV2 { envL     :: VarEnv Var        -- Renaming for Left term\n        , envR     :: VarEnv Var        -- Renaming for Right term\n        , in_scope :: InScopeSet }      -- In scope in left or right terms\n\n-- The renamings envL and envR are *guaranteed* to contain a binding\n-- for every variable bound as we go into the term, even if it is not\n-- renamed.  That way we can ask what variables are locally bound\n-- (inRnEnvL, inRnEnvR)\n\nmkRnEnv2 :: InScopeSet -> RnEnv2\nmkRnEnv2 vars = RV2     { envL     = emptyVarEnv\n                        , envR     = emptyVarEnv\n                        , in_scope = vars }\n\naddRnInScopeSet :: RnEnv2 -> VarSet -> RnEnv2\naddRnInScopeSet env vs\n  | isEmptyVarSet vs = env\n  | otherwise        = env { in_scope = extendInScopeSetSet (in_scope env) vs }\n\nrnInScope :: Var -> RnEnv2 -> Bool\nrnInScope x env = x `elemInScopeSet` in_scope env\n\nrnInScopeSet :: RnEnv2 -> InScopeSet\nrnInScopeSet = in_scope\n\n-- | Retrieve the left mapping\nrnEnvL :: RnEnv2 -> VarEnv Var\nrnEnvL = envL\n\n-- | Retrieve the right mapping\nrnEnvR :: RnEnv2 -> VarEnv Var\nrnEnvR = envR\n\nrnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2\n-- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length\nrnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR\n\nrnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2\n-- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,\n--                       and binder @bR@ in the Right term.\n-- It finds a new binder, @new_b@,\n-- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@\nrnBndr2 env bL bR = fst $ rnBndr2_var env bL bR\n\nrnBndr2_var :: RnEnv2 -> Var -> Var -> (RnEnv2, Var)\n-- ^ Similar to 'rnBndr2' but returns the new variable as well as the\n-- new environment\nrnBndr2_var (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR\n  = (RV2 { envL            = extendVarEnv envL bL new_b   -- See Note\n         , envR            = extendVarEnv envR bR new_b   -- [Rebinding]\n         , in_scope = extendInScopeSet in_scope new_b }, new_b)\n  where\n        -- Find a new binder not in scope in either term\n    new_b | not (bL `elemInScopeSet` in_scope) = bL\n          | not (bR `elemInScopeSet` in_scope) = bR\n          | otherwise                          = uniqAway' in_scope bL\n\n        -- Note [Rebinding]\n        -- If the new var is the same as the old one, note that\n        -- the extendVarEnv *deletes* any current renaming\n        -- E.g.   (\\x. \\x. ...)  ~  (\\y. \\z. ...)\n        --\n        --   Inside \\x  \\y      { [x->y], [y->y],       {y} }\n        --       \\x  \\z         { [x->x], [y->y, z->x], {y,x} }\n\nrnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)\n-- ^ Similar to 'rnBndr2' but used when there's a binder on the left\n-- side only.\nrnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL\n  = (RV2 { envL     = extendVarEnv envL bL new_b\n         , envR     = envR\n         , in_scope = extendInScopeSet in_scope new_b }, new_b)\n  where\n    new_b = uniqAway in_scope bL\n\nrnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)\n-- ^ Similar to 'rnBndr2' but used when there's a binder on the right\n-- side only.\nrnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR\n  = (RV2 { envR     = extendVarEnv envR bR new_b\n         , envL     = envL\n         , in_scope = extendInScopeSet in_scope new_b }, new_b)\n  where\n    new_b = uniqAway in_scope bR\n\nrnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)\n-- ^ Similar to 'rnBndrL' but used for eta expansion\n-- See Note [Eta expansion]\nrnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL\n  = (RV2 { envL     = extendVarEnv envL bL new_b\n         , envR     = extendVarEnv envR new_b new_b     -- Note [Eta expansion]\n         , in_scope = extendInScopeSet in_scope new_b }, new_b)\n  where\n    new_b = uniqAway in_scope bL\n\nrnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)\n-- ^ Similar to 'rnBndr2' but used for eta expansion\n-- See Note [Eta expansion]\nrnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR\n  = (RV2 { envL     = extendVarEnv envL new_b new_b     -- Note [Eta expansion]\n         , envR     = extendVarEnv envR bR new_b\n         , in_scope = extendInScopeSet in_scope new_b }, new_b)\n  where\n    new_b = uniqAway in_scope bR\n\ndelBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2\ndelBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v\n  = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }\ndelBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v\n  = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }\n\ndelBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2\ndelBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v\n  = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }\ndelBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v\n  = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }\n\nrnOccL, rnOccR :: RnEnv2 -> Var -> Var\n-- ^ Look up the renaming of an occurrence in the left or right term\nrnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v\nrnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v\n\nrnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var\n-- ^ Look up the renaming of an occurrence in the left or right term\nrnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v\nrnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v\n\ninRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool\n-- ^ Tells whether a variable is locally bound\ninRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env\ninRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env\n\nlookupRnInScope :: RnEnv2 -> Var -> Var\nlookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v\n\nnukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2\n-- ^ Wipe the left or right side renaming\nnukeRnEnvL env = env { envL = emptyVarEnv }\nnukeRnEnvR env = env { envR = emptyVarEnv }\n\nrnSwap :: RnEnv2 -> RnEnv2\n-- ^ swap the meaning of left and right\nrnSwap (RV2 { envL = envL, envR = envR, in_scope = in_scope })\n  = RV2 { envL = envR, envR = envL, in_scope = in_scope }\n\n{-\nNote [Eta expansion]\n~~~~~~~~~~~~~~~~~~~~\nWhen matching\n     (\\x.M) ~ N\nwe rename x to x' with, where x' is not in scope in\neither term.  Then we want to behave as if we'd seen\n     (\\x'.M) ~ (\\x'.N x')\nSince x' isn't in scope in N, the form (\\x'. N x') doesn't\ncapture any variables in N.  But we must nevertheless extend\nthe envR with a binding [x' -> x'], to support the occurs check.\nFor example, if we don't do this, we can get silly matches like\n        forall a.  (\\y.a)  ~   v\nsucceeding with [a -> v y], which is bogus of course.\n\n\n************************************************************************\n*                                                                      *\n                Tidying\n*                                                                      *\n************************************************************************\n-}\n\n-- | Tidy Environment\n--\n-- When tidying up print names, we keep a mapping of in-scope occ-names\n-- (the 'TidyOccEnv') and a Var-to-Var of the current renamings\ntype TidyEnv = (TidyOccEnv, VarEnv Var)\n\nemptyTidyEnv :: TidyEnv\nemptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)\n\nmkEmptyTidyEnv :: TidyOccEnv -> TidyEnv\nmkEmptyTidyEnv occ_env = (occ_env, emptyVarEnv)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{@VarEnv@s}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Variable Environment\ntype VarEnv elt     = UniqFM elt\n\n-- | Identifier Environment\ntype IdEnv elt      = VarEnv elt\n\n-- | Type Variable Environment\ntype TyVarEnv elt   = VarEnv elt\n\n-- | Type or Coercion Variable Environment\ntype TyCoVarEnv elt = VarEnv elt\n\n-- | Coercion Variable Environment\ntype CoVarEnv elt   = VarEnv elt\n\nemptyVarEnv       :: VarEnv a\nmkVarEnv          :: [(Var, a)] -> VarEnv a\nmkVarEnv_Directly :: [(Unique, a)] -> VarEnv a\nzipVarEnv         :: [Var] -> [a] -> VarEnv a\nunitVarEnv        :: Var -> a -> VarEnv a\nalterVarEnv       :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a\nextendVarEnv      :: VarEnv a -> Var -> a -> VarEnv a\nextendVarEnv_C    :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a\nextendVarEnv_Acc  :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b\nextendVarEnv_Directly :: VarEnv a -> Unique -> a -> VarEnv a\nplusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a\nplusVarEnvList    :: [VarEnv a] -> VarEnv a\nextendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a\n\nlookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a\nfilterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a\ndelVarEnv_Directly    :: VarEnv a -> Unique -> VarEnv a\npartitionVarEnv   :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)\nrestrictVarEnv    :: VarEnv a -> VarSet -> VarEnv a\ndelVarEnvList     :: VarEnv a -> [Var] -> VarEnv a\ndelVarEnv         :: VarEnv a -> Var -> VarEnv a\nminusVarEnv       :: VarEnv a -> VarEnv b -> VarEnv a\nintersectsVarEnv  :: VarEnv a -> VarEnv a -> Bool\nplusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a\nplusVarEnv_CD     :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a\nplusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a\nmapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b\nmodifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a\n\nisEmptyVarEnv     :: VarEnv a -> Bool\nlookupVarEnv      :: VarEnv a -> Var -> Maybe a\nfilterVarEnv      :: (a -> Bool) -> VarEnv a -> VarEnv a\nlookupVarEnv_NF   :: VarEnv a -> Var -> a\nlookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a\nelemVarEnv        :: Var -> VarEnv a -> Bool\nelemVarEnvByKey   :: Unique -> VarEnv a -> Bool\ndisjointVarEnv    :: VarEnv a -> VarEnv a -> Bool\n\nelemVarEnv       = elemUFM\nelemVarEnvByKey  = elemUFM_Directly\ndisjointVarEnv   = disjointUFM\nalterVarEnv      = alterUFM\nextendVarEnv     = addToUFM\nextendVarEnv_C   = addToUFM_C\nextendVarEnv_Acc = addToUFM_Acc\nextendVarEnv_Directly = addToUFM_Directly\nextendVarEnvList = addListToUFM\nplusVarEnv_C     = plusUFM_C\nplusVarEnv_CD    = plusUFM_CD\nplusMaybeVarEnv_C = plusMaybeUFM_C\ndelVarEnvList    = delListFromUFM\ndelVarEnv        = delFromUFM\nminusVarEnv      = minusUFM\nintersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))\nplusVarEnv       = plusUFM\nplusVarEnvList   = plusUFMList\nlookupVarEnv     = lookupUFM\nfilterVarEnv     = filterUFM\nlookupWithDefaultVarEnv = lookupWithDefaultUFM\nmapVarEnv        = mapUFM\nmkVarEnv         = listToUFM\nmkVarEnv_Directly= listToUFM_Directly\nemptyVarEnv      = emptyUFM\nunitVarEnv       = unitUFM\nisEmptyVarEnv    = isNullUFM\nlookupVarEnv_Directly = lookupUFM_Directly\nfilterVarEnv_Directly = filterUFM_Directly\ndelVarEnv_Directly    = delFromUFM_Directly\npartitionVarEnv       = partitionUFM\n\nrestrictVarEnv env vs = filterVarEnv_Directly keep env\n  where\n    keep u _ = u `elemVarSetByKey` vs\n\nzipVarEnv tyvars tys   = mkVarEnv (zipEqual \"zipVarEnv\" tyvars tys)\nlookupVarEnv_NF env id = case lookupVarEnv env id of\n                         Just xx -> xx\n                         Nothing -> panic \"lookupVarEnv_NF: Nothing\"\n\n{-\n@modifyVarEnv@: Look up a thing in the VarEnv,\nthen mash it with the modify function, and put it back.\n-}\n\nmodifyVarEnv mangle_fn env key\n  = case (lookupVarEnv env key) of\n      Nothing -> env\n      Just xx -> extendVarEnv env key (mangle_fn xx)\n\nmodifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a\nmodifyVarEnv_Directly mangle_fn env key\n  = case (lookupUFM_Directly env key) of\n      Nothing -> env\n      Just xx -> addToUFM_Directly env key (mangle_fn xx)\n\n-- Deterministic VarEnv\n-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need\n-- DVarEnv.\n\n-- | Deterministic Variable Environment\ntype DVarEnv elt = UniqDFM elt\n\n-- | Deterministic Identifier Environment\ntype DIdEnv elt = DVarEnv elt\n\n-- | Deterministic Type Variable Environment\ntype DTyVarEnv elt = DVarEnv elt\n\nemptyDVarEnv :: DVarEnv a\nemptyDVarEnv = emptyUDFM\n\ndVarEnvElts :: DVarEnv a -> [a]\ndVarEnvElts = eltsUDFM\n\nmkDVarEnv :: [(Var, a)] -> DVarEnv a\nmkDVarEnv = listToUDFM\n\nextendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a\nextendDVarEnv = addToUDFM\n\nminusDVarEnv :: DVarEnv a -> DVarEnv a' -> DVarEnv a\nminusDVarEnv = minusUDFM\n\nlookupDVarEnv :: DVarEnv a -> Var -> Maybe a\nlookupDVarEnv = lookupUDFM\n\nfoldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b\nfoldDVarEnv = foldUDFM\n\nmapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b\nmapDVarEnv = mapUDFM\n\nfilterDVarEnv      :: (a -> Bool) -> DVarEnv a -> DVarEnv a\nfilterDVarEnv = filterUDFM\n\nalterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a\nalterDVarEnv = alterUDFM\n\nplusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a\nplusDVarEnv = plusUDFM\n\nplusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a\nplusDVarEnv_C = plusUDFM_C\n\nunitDVarEnv :: Var -> a -> DVarEnv a\nunitDVarEnv = unitUDFM\n\ndelDVarEnv :: DVarEnv a -> Var -> DVarEnv a\ndelDVarEnv = delFromUDFM\n\ndelDVarEnvList :: DVarEnv a -> [Var] -> DVarEnv a\ndelDVarEnvList = delListFromUDFM\n\nisEmptyDVarEnv :: DVarEnv a -> Bool\nisEmptyDVarEnv = isNullUDFM\n\nelemDVarEnv :: Var -> DVarEnv a -> Bool\nelemDVarEnv = elemUDFM\n\nextendDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> Var -> a -> DVarEnv a\nextendDVarEnv_C = addToUDFM_C\n\nmodifyDVarEnv :: (a -> a) -> DVarEnv a -> Var -> DVarEnv a\nmodifyDVarEnv mangle_fn env key\n  = case (lookupDVarEnv env key) of\n      Nothing -> env\n      Just xx -> extendDVarEnv env key (mangle_fn xx)\n\npartitionDVarEnv :: (a -> Bool) -> DVarEnv a -> (DVarEnv a, DVarEnv a)\npartitionDVarEnv = partitionUDFM\n\nextendDVarEnvList :: DVarEnv a -> [(Var, a)] -> DVarEnv a\nextendDVarEnvList = addListToUDFM\n\nanyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool\nanyDVarEnv = anyUDFM\n", "num_lines": 607}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule VarSet (\n        -- * Var, Id and TyVar set types\n        VarSet, IdSet, TyVarSet, CoVarSet, TyCoVarSet,\n\n        -- ** Manipulating these sets\n        emptyVarSet, unitVarSet, mkVarSet,\n        extendVarSet, extendVarSetList,\n        elemVarSet, subVarSet,\n        unionVarSet, unionVarSets, mapUnionVarSet,\n        intersectVarSet, intersectsVarSet, disjointVarSet,\n        isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,\n        minusVarSet, filterVarSet, mapVarSet,\n        anyVarSet, allVarSet,\n        transCloVarSet, fixVarSet,\n        lookupVarSet_Directly, lookupVarSet, lookupVarSetByName,\n        sizeVarSet, seqVarSet,\n        elemVarSetByKey, partitionVarSet,\n        pluralVarSet, pprVarSet,\n\n        -- * Deterministic Var set types\n        DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,\n\n        -- ** Manipulating these sets\n        emptyDVarSet, unitDVarSet, mkDVarSet,\n        extendDVarSet, extendDVarSetList,\n        elemDVarSet, dVarSetElems, subDVarSet,\n        unionDVarSet, unionDVarSets, mapUnionDVarSet,\n        intersectDVarSet, dVarSetIntersectVarSet,\n        intersectsDVarSet, disjointDVarSet,\n        isEmptyDVarSet, delDVarSet, delDVarSetList,\n        minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet,\n        dVarSetMinusVarSet, anyDVarSet, allDVarSet,\n        transCloDVarSet,\n        sizeDVarSet, seqDVarSet,\n        partitionDVarSet,\n        dVarSetToVarSet,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Var      ( Var, TyVar, CoVar, TyCoVar, Id )\nimport Unique\nimport Name     ( Name )\nimport UniqSet\nimport UniqDSet\nimport UniqFM( disjointUFM, pluralUFM, pprUFM )\nimport UniqDFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )\nimport Outputable (SDoc)\n\n-- | A non-deterministic Variable Set\n--\n-- A non-deterministic set of variables.\n-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not\n-- deterministic and why it matters. Use DVarSet if the set eventually\n-- gets converted into a list or folded over in a way where the order\n-- changes the generated code, for example when abstracting variables.\ntype VarSet       = UniqSet Var\n\n-- | Identifier Set\ntype IdSet        = UniqSet Id\n\n-- | Type Variable Set\ntype TyVarSet     = UniqSet TyVar\n\n-- | Coercion Variable Set\ntype CoVarSet     = UniqSet CoVar\n\n-- | Type or Coercion Variable Set\ntype TyCoVarSet   = UniqSet TyCoVar\n\nemptyVarSet     :: VarSet\nintersectVarSet :: VarSet -> VarSet -> VarSet\nunionVarSet     :: VarSet -> VarSet -> VarSet\nunionVarSets    :: [VarSet] -> VarSet\n\nmapUnionVarSet  :: (a -> VarSet) -> [a] -> VarSet\n-- ^ map the function over the list, and union the results\n\nunitVarSet      :: Var -> VarSet\nextendVarSet    :: VarSet -> Var -> VarSet\nextendVarSetList:: VarSet -> [Var] -> VarSet\nelemVarSet      :: Var -> VarSet -> Bool\ndelVarSet       :: VarSet -> Var -> VarSet\ndelVarSetList   :: VarSet -> [Var] -> VarSet\nminusVarSet     :: VarSet -> VarSet -> VarSet\nisEmptyVarSet   :: VarSet -> Bool\nmkVarSet        :: [Var] -> VarSet\nlookupVarSet_Directly :: VarSet -> Unique -> Maybe Var\nlookupVarSet    :: VarSet -> Var -> Maybe Var\n                        -- Returns the set element, which may be\n                        -- (==) to the argument, but not the same as\nlookupVarSetByName :: VarSet -> Name -> Maybe Var\nsizeVarSet      :: VarSet -> Int\nfilterVarSet    :: (Var -> Bool) -> VarSet -> VarSet\n\ndelVarSetByKey  :: VarSet -> Unique -> VarSet\nelemVarSetByKey :: Unique -> VarSet -> Bool\npartitionVarSet :: (Var -> Bool) -> VarSet -> (VarSet, VarSet)\n\nemptyVarSet     = emptyUniqSet\nunitVarSet      = unitUniqSet\nextendVarSet    = addOneToUniqSet\nextendVarSetList= addListToUniqSet\nintersectVarSet = intersectUniqSets\n\nintersectsVarSet:: VarSet -> VarSet -> Bool     -- True if non-empty intersection\ndisjointVarSet  :: VarSet -> VarSet -> Bool     -- True if empty intersection\nsubVarSet       :: VarSet -> VarSet -> Bool     -- True if first arg is subset of second\n        -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty;\n        -- ditto disjointVarSet, subVarSet\n\nunionVarSet     = unionUniqSets\nunionVarSets    = unionManyUniqSets\nelemVarSet      = elementOfUniqSet\nminusVarSet     = minusUniqSet\ndelVarSet       = delOneFromUniqSet\ndelVarSetList   = delListFromUniqSet\nisEmptyVarSet   = isEmptyUniqSet\nmkVarSet        = mkUniqSet\nlookupVarSet_Directly = lookupUniqSet_Directly\nlookupVarSet    = lookupUniqSet\nlookupVarSetByName = lookupUniqSet\nsizeVarSet      = sizeUniqSet\nfilterVarSet    = filterUniqSet\ndelVarSetByKey  = delOneFromUniqSet_Directly\nelemVarSetByKey = elemUniqSet_Directly\npartitionVarSet = partitionUniqSet\n\nmapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs\n\n-- See comments with type signatures\nintersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)\ndisjointVarSet   s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)\nsubVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)\n\nanyVarSet :: (Var -> Bool) -> VarSet -> Bool\nanyVarSet = uniqSetAny\n\nallVarSet :: (Var -> Bool) -> VarSet -> Bool\nallVarSet = uniqSetAll\n\nmapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b\nmapVarSet = mapUniqSet\n\nfixVarSet :: (VarSet -> VarSet)   -- Map the current set to a new set\n          -> VarSet -> VarSet\n-- (fixVarSet f s) repeatedly applies f to the set s,\n-- until it reaches a fixed point.\nfixVarSet fn vars\n  | new_vars `subVarSet` vars = vars\n  | otherwise                 = fixVarSet fn new_vars\n  where\n    new_vars = fn vars\n\ntransCloVarSet :: (VarSet -> VarSet)\n                  -- Map some variables in the set to\n                  -- extra variables that should be in it\n               -> VarSet -> VarSet\n-- (transCloVarSet f s) repeatedly applies f to new candidates, adding any\n-- new variables to s that it finds thereby, until it reaches a fixed point.\n--\n-- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet)\n-- for efficiency, so that the test can be batched up.\n-- It's essential that fn will work fine if given new candidates\n-- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2\n-- Use fixVarSet if the function needs to see the whole set all at once\ntransCloVarSet fn seeds\n  = go seeds seeds\n  where\n    go :: VarSet  -- Accumulating result\n       -> VarSet  -- Work-list; un-processed subset of accumulating result\n       -> VarSet\n    -- Specification: go acc vs = acc `union` transClo fn vs\n\n    go acc candidates\n       | isEmptyVarSet new_vs = acc\n       | otherwise            = go (acc `unionVarSet` new_vs) new_vs\n       where\n         new_vs = fn candidates `minusVarSet` acc\n\nseqVarSet :: VarSet -> ()\nseqVarSet s = sizeVarSet s `seq` ()\n\n-- | Determines the pluralisation suffix appropriate for the length of a set\n-- in the same way that plural from Outputable does for lists.\npluralVarSet :: VarSet -> SDoc\npluralVarSet = pluralUFM . getUniqSet\n\n-- | Pretty-print a non-deterministic set.\n-- The order of variables is non-deterministic and for pretty-printing that\n-- shouldn't be a problem.\n-- Having this function helps contain the non-determinism created with\n-- nonDetEltsUFM.\n-- Passing a list to the pretty-printing function allows the caller\n-- to decide on the order of Vars (eg. toposort them) without them having\n-- to use nonDetEltsUFM at the call site. This prevents from let-binding\n-- non-deterministically ordered lists and reusing them where determinism\n-- matters.\npprVarSet :: VarSet          -- ^ The things to be pretty printed\n          -> ([Var] -> SDoc) -- ^ The pretty printing function to use on the\n                             -- elements\n          -> SDoc            -- ^ 'SDoc' where the things have been pretty\n                             -- printed\npprVarSet = pprUFM . getUniqSet\n\n-- Deterministic VarSet\n-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need\n-- DVarSet.\n\n-- | Deterministic Variable Set\ntype DVarSet     = UniqDSet Var\n\n-- | Deterministic Identifier Set\ntype DIdSet      = UniqDSet Id\n\n-- | Deterministic Type Variable Set\ntype DTyVarSet   = UniqDSet TyVar\n\n-- | Deterministic Type or Coercion Variable Set\ntype DTyCoVarSet = UniqDSet TyCoVar\n\nemptyDVarSet :: DVarSet\nemptyDVarSet = emptyUniqDSet\n\nunitDVarSet :: Var -> DVarSet\nunitDVarSet = unitUniqDSet\n\nmkDVarSet :: [Var] -> DVarSet\nmkDVarSet = mkUniqDSet\n\n-- The new element always goes to the right of existing ones.\nextendDVarSet :: DVarSet -> Var -> DVarSet\nextendDVarSet = addOneToUniqDSet\n\nelemDVarSet :: Var -> DVarSet -> Bool\nelemDVarSet = elementOfUniqDSet\n\ndVarSetElems :: DVarSet -> [Var]\ndVarSetElems = uniqDSetToList\n\nsubDVarSet :: DVarSet -> DVarSet -> Bool\nsubDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)\n\nunionDVarSet :: DVarSet -> DVarSet -> DVarSet\nunionDVarSet = unionUniqDSets\n\nunionDVarSets :: [DVarSet] -> DVarSet\nunionDVarSets = unionManyUniqDSets\n\n-- | Map the function over the list, and union the results\nmapUnionDVarSet  :: (a -> DVarSet) -> [a] -> DVarSet\nmapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs\n\nintersectDVarSet :: DVarSet -> DVarSet -> DVarSet\nintersectDVarSet = intersectUniqDSets\n\ndVarSetIntersectVarSet :: DVarSet -> VarSet -> DVarSet\ndVarSetIntersectVarSet = uniqDSetIntersectUniqSet\n\n-- | True if empty intersection\ndisjointDVarSet :: DVarSet -> DVarSet -> Bool\ndisjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2)\n\n-- | True if non-empty intersection\nintersectsDVarSet :: DVarSet -> DVarSet -> Bool\nintersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)\n\nisEmptyDVarSet :: DVarSet -> Bool\nisEmptyDVarSet = isEmptyUniqDSet\n\ndelDVarSet :: DVarSet -> Var -> DVarSet\ndelDVarSet = delOneFromUniqDSet\n\nminusDVarSet :: DVarSet -> DVarSet -> DVarSet\nminusDVarSet = minusUniqDSet\n\ndVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet\ndVarSetMinusVarSet = uniqDSetMinusUniqSet\n\nfoldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a\nfoldDVarSet = foldUniqDSet\n\nanyDVarSet :: (Var -> Bool) -> DVarSet -> Bool\nanyDVarSet p = anyUDFM p . getUniqDSet\n\nallDVarSet :: (Var -> Bool) -> DVarSet -> Bool\nallDVarSet p = allUDFM p . getUniqDSet\n\nmapDVarSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b\nmapDVarSet = mapUniqDSet\n\nfilterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet\nfilterDVarSet = filterUniqDSet\n\nsizeDVarSet :: DVarSet -> Int\nsizeDVarSet = sizeUniqDSet\n\n-- | Partition DVarSet according to the predicate given\npartitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)\npartitionDVarSet = partitionUniqDSet\n\n-- | Delete a list of variables from DVarSet\ndelDVarSetList :: DVarSet -> [Var] -> DVarSet\ndelDVarSetList = delListFromUniqDSet\n\nseqDVarSet :: DVarSet -> ()\nseqDVarSet s = sizeDVarSet s `seq` ()\n\n-- | Add a list of variables to DVarSet\nextendDVarSetList :: DVarSet -> [Var] -> DVarSet\nextendDVarSetList = addListToUniqDSet\n\n-- | Convert a DVarSet to a VarSet by forgeting the order of insertion\ndVarSetToVarSet :: DVarSet -> VarSet\ndVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm . getUniqDSet\n\n-- | transCloVarSet for DVarSet\ntransCloDVarSet :: (DVarSet -> DVarSet)\n                  -- Map some variables in the set to\n                  -- extra variables that should be in it\n                -> DVarSet -> DVarSet\n-- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any\n-- new variables to s that it finds thereby, until it reaches a fixed point.\n--\n-- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)\n-- for efficiency, so that the test can be batched up.\n-- It's essential that fn will work fine if given new candidates\n-- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2\ntransCloDVarSet fn seeds\n  = go seeds seeds\n  where\n    go :: DVarSet  -- Accumulating result\n       -> DVarSet  -- Work-list; un-processed subset of accumulating result\n       -> DVarSet\n    -- Specification: go acc vs = acc `union` transClo fn vs\n\n    go acc candidates\n       | isEmptyDVarSet new_vs = acc\n       | otherwise            = go (acc `unionDVarSet` new_vs) new_vs\n       where\n         new_vs = fn candidates `minusDVarSet` acc\n", "num_lines": 351}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\n--\n-- (c) The University of Glasgow 2003-2006\n--\n\n-- Functions for constructing bitmaps, which are used in various\n-- places in generated code (stack frame liveness masks, function\n-- argument liveness masks, SRT bitmaps).\n\nmodule Bitmap (\n        Bitmap, mkBitmap,\n        intsToBitmap, intsToReverseBitmap,\n        mAX_SMALL_BITMAP_SIZE,\n        seqBitmap,\n  ) where\n\nimport GhcPrelude\n\nimport SMRep\nimport DynFlags\nimport Util\n\nimport Data.Bits\n\n{-|\nA bitmap represented by a sequence of 'StgWord's on the /target/\narchitecture.  These are used for bitmaps in info tables and other\ngenerated code which need to be emitted as sequences of StgWords.\n-}\ntype Bitmap = [StgWord]\n\n-- | Make a bitmap from a sequence of bits\nmkBitmap :: DynFlags -> [Bool] -> Bitmap\nmkBitmap _ [] = []\nmkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest\n  where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff\n\nchunkToBitmap :: DynFlags -> [Bool] -> StgWord\nchunkToBitmap dflags chunk =\n  foldl' (.|.) (toStgWord dflags 0) [ oneAt n | (True,n) <- zip chunk [0..] ]\n  where\n    oneAt :: Int -> StgWord\n    oneAt i = toStgWord dflags 1 `shiftL` i\n\n-- | Make a bitmap where the slots specified are the /ones/ in the bitmap.\n-- eg. @[0,1,3], size 4 ==> 0xb@.\n--\n-- The list of @Int@s /must/ be already sorted.\nintsToBitmap :: DynFlags\n             -> Int        -- ^ size in bits\n             -> [Int]      -- ^ sorted indices of ones\n             -> Bitmap\nintsToBitmap dflags size = go 0\n  where\n    word_sz = wORD_SIZE_IN_BITS dflags\n    oneAt :: Int -> StgWord\n    oneAt i = toStgWord dflags 1 `shiftL` i\n\n    -- It is important that we maintain strictness here.\n    -- See Note [Strictness when building Bitmaps].\n    go :: Int -> [Int] -> Bitmap\n    go !pos slots\n      | size <= pos = []\n      | otherwise =\n        (foldl' (.|.) (toStgWord dflags 0) (map (\\i->oneAt (i - pos)) these)) :\n          go (pos + word_sz) rest\n      where\n        (these,rest) = span (< (pos + word_sz)) slots\n\n-- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.\n-- eg. @[0,1,3], size 4 ==> 0x4@  (we leave any bits outside the size as zero,\n-- just to make the bitmap easier to read).\n--\n-- The list of @Int@s /must/ be already sorted and duplicate-free.\nintsToReverseBitmap :: DynFlags\n                    -> Int      -- ^ size in bits\n                    -> [Int]    -- ^ sorted indices of zeros free of duplicates\n                    -> Bitmap\nintsToReverseBitmap dflags size = go 0\n  where\n    word_sz = wORD_SIZE_IN_BITS dflags\n    oneAt :: Int -> StgWord\n    oneAt i = toStgWord dflags 1 `shiftL` i\n\n    -- It is important that we maintain strictness here.\n    -- See Note [Strictness when building Bitmaps].\n    go :: Int -> [Int] -> Bitmap\n    go !pos slots\n      | size <= pos = []\n      | otherwise =\n        (foldl' xor (toStgWord dflags init) (map (\\i->oneAt (i - pos)) these)) :\n          go (pos + word_sz) rest\n      where\n        (these,rest) = span (< (pos + word_sz)) slots\n        remain = size - pos\n        init\n          | remain >= word_sz = -1\n          | otherwise         = (1 `shiftL` remain) - 1\n\n{-\n\nNote [Strictness when building Bitmaps]\n========================================\n\nOne of the places where @Bitmap@ is used is in in building Static Reference\nTables (SRTs) (in @CmmBuildInfoTables.procpointSRT@). In #7450 it was noticed\nthat some test cases (particularly those whose C-- have large numbers of CAFs)\nproduced large quantities of allocations from this function.\n\nThe source traced back to 'intsToBitmap', which was lazily subtracting the word\nsize from the elements of the tail of the @slots@ list and recursively invoking\nitself with the result. This resulted in large numbers of subtraction thunks\nbeing built up. Here we take care to avoid passing new thunks to the recursive\ncall. Instead we pass the unmodified tail along with an explicit position\naccumulator, which get subtracted in the fold when we compute the Word.\n\n-}\n\n{- |\nMagic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.\nSome kinds of bitmap pack a size\\/bitmap into a single word if\npossible, or fall back to an external pointer when the bitmap is too\nlarge.  This value represents the largest size of bitmap that can be\npacked into a single word.\n-}\nmAX_SMALL_BITMAP_SIZE :: DynFlags -> Int\nmAX_SMALL_BITMAP_SIZE dflags\n | wORD_SIZE dflags == 4 = 27\n | otherwise             = 58\n\nseqBitmap :: Bitmap -> a -> a\nseqBitmap = seqList\n\n", "num_lines": 135}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeSynonymInstances #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n{- BlockId module should probably go away completely, being superseded by Label -}\nmodule BlockId\n  ( BlockId, mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet\n  , newBlockId\n  , blockLbl, infoTblLbl\n  ) where\n\nimport GhcPrelude\n\nimport CLabel\nimport IdInfo\nimport Name\nimport Unique\nimport UniqSupply\n\nimport Hoopl.Label (Label, mkHooplLabel)\n\n----------------------------------------------------------------\n--- Block Ids, their environments, and their sets\n\n{- Note [Unique BlockId]\n~~~~~~~~~~~~~~~~~~~~~~~~\nAlthough a 'BlockId' is a local label, for reasons of implementation,\n'BlockId's must be unique within an entire compilation unit.  The reason\nis that each local label is mapped to an assembly-language label, and in\nmost assembly languages allow, a label is visible throughout the entire\ncompilation unit in which it appears.\n-}\n\ntype BlockId = Label\n\nmkBlockId :: Unique -> BlockId\nmkBlockId unique = mkHooplLabel $ getKey unique\n\nnewBlockId :: MonadUnique m => m BlockId\nnewBlockId = mkBlockId <$> getUniqueM\n\nblockLbl :: BlockId -> CLabel\nblockLbl label = mkLocalBlockLabel (getUnique label)\n\ninfoTblLbl :: BlockId -> CLabel\ninfoTblLbl label\n  = mkBlockInfoTableLabel (mkFCallName (getUnique label) \"block\") NoCafRefs\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Object-file symbols (called CLabel for histerical raisins).\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\n{-# LANGUAGE CPP #-}\n\nmodule CLabel (\n        CLabel, -- abstract type\n        ForeignLabelSource(..),\n        pprDebugCLabel,\n\n        mkClosureLabel,\n        mkSRTLabel,\n        mkInfoTableLabel,\n        mkEntryLabel,\n        mkRednCountsLabel,\n        mkConInfoTableLabel,\n        mkApEntryLabel,\n        mkApInfoTableLabel,\n        mkClosureTableLabel,\n        mkBytesLabel,\n\n        mkLocalBlockLabel,\n        mkLocalClosureLabel,\n        mkLocalInfoTableLabel,\n        mkLocalClosureTableLabel,\n\n        mkBlockInfoTableLabel,\n\n        mkBitmapLabel,\n        mkStringLitLabel,\n\n        mkAsmTempLabel,\n        mkAsmTempDerivedLabel,\n        mkAsmTempEndLabel,\n        mkAsmTempDieLabel,\n\n        mkDirty_MUT_VAR_Label,\n        mkUpdInfoLabel,\n        mkBHUpdInfoLabel,\n        mkIndStaticInfoLabel,\n        mkMainCapabilityLabel,\n        mkMAP_FROZEN_CLEAN_infoLabel,\n        mkMAP_FROZEN_DIRTY_infoLabel,\n        mkMAP_DIRTY_infoLabel,\n        mkSMAP_FROZEN_CLEAN_infoLabel,\n        mkSMAP_FROZEN_DIRTY_infoLabel,\n        mkSMAP_DIRTY_infoLabel,\n        mkBadAlignmentLabel,\n        mkArrWords_infoLabel,\n        mkSRTInfoLabel,\n\n        mkTopTickyCtrLabel,\n        mkCAFBlackHoleInfoTableLabel,\n        mkRtsPrimOpLabel,\n        mkRtsSlowFastTickyCtrLabel,\n\n        mkSelectorInfoLabel,\n        mkSelectorEntryLabel,\n\n        mkCmmInfoLabel,\n        mkCmmEntryLabel,\n        mkCmmRetInfoLabel,\n        mkCmmRetLabel,\n        mkCmmCodeLabel,\n        mkCmmDataLabel,\n        mkCmmClosureLabel,\n\n        mkRtsApFastLabel,\n\n        mkPrimCallLabel,\n\n        mkForeignLabel,\n        addLabelSize,\n\n        foreignLabelStdcallInfo,\n        isBytesLabel,\n        isForeignLabel,\n        isSomeRODataLabel,\n        isStaticClosureLabel,\n        mkCCLabel, mkCCSLabel,\n\n        DynamicLinkerLabelInfo(..),\n        mkDynamicLinkerLabel,\n        dynamicLinkerLabelInfo,\n\n        mkPicBaseLabel,\n        mkDeadStripPreventer,\n\n        mkHpcTicksLabel,\n\n        -- * Predicates\n        hasCAF,\n        needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,\n        isMathFun,\n        isCFunctionLabel, isGcPtrLabel, labelDynamic,\n        isLocalCLabel,\n\n        -- * Conversions\n        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,\n\n        pprCLabel,\n        isInfoTableLabel,\n        isConInfoTableLabel\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport IdInfo\nimport BasicTypes\nimport {-# SOURCE #-} BlockId (BlockId, mkBlockId)\nimport Packages\nimport Module\nimport Name\nimport Unique\nimport PrimOp\nimport Config\nimport CostCentre\nimport Outputable\nimport FastString\nimport DynFlags\nimport Platform\nimport UniqSet\nimport Util\nimport PprCore ( {- instances -} )\n\n-- -----------------------------------------------------------------------------\n-- The CLabel type\n\n{- |\n  'CLabel' is an abstract type that supports the following operations:\n\n  - Pretty printing\n\n  - In a C file, does it need to be declared before use?  (i.e. is it\n    guaranteed to be already in scope in the places we need to refer to it?)\n\n  - If it needs to be declared, what type (code or data) should it be\n    declared to have?\n\n  - Is it visible outside this object file or not?\n\n  - Is it \"dynamic\" (see details below)\n\n  - Eq and Ord, so that we can make sets of CLabels (currently only\n    used in outputting C as far as I can tell, to avoid generating\n    more than one declaration for any given label).\n\n  - Converting an info table label into an entry label.\n\n  CLabel usage is a bit messy in GHC as they are used in a number of different\n  contexts:\n\n  - By the C-- AST to identify labels\n\n  - By the unregisterised C code generator (\"PprC\") for naming functions (hence\n    the name 'CLabel')\n\n  - By the native and LLVM code generators to identify labels\n\n  For extra fun, each of these uses a slightly different subset of constructors\n  (e.g. 'AsmTempLabel' and 'AsmTempDerivedLabel' are used only in the NCG and\n  LLVM backends).\n\n  In general, we use 'IdLabel' to represent Haskell things early in the\n  pipeline. However, later optimization passes will often represent blocks they\n  create with 'LocalBlockLabel' where there is no obvious 'Name' to hang off the\n  label.\n-}\n\ndata CLabel\n  = -- | A label related to the definition of a particular Id or Con in a .hs file.\n    IdLabel\n        Name\n        CafInfo\n        IdLabelInfo             -- encodes the suffix of the label\n\n  -- | A label from a .cmm file that is not associated with a .hs level Id.\n  | CmmLabel\n        UnitId               -- what package the label belongs to.\n        FastString              -- identifier giving the prefix of the label\n        CmmLabelInfo            -- encodes the suffix of the label\n\n  -- | A label with a baked-in \\/ algorithmically generated name that definitely\n  --    comes from the RTS. The code for it must compile into libHSrts.a \\/ libHSrts.so\n  --    If it doesn't have an algorithmically generated name then use a CmmLabel\n  --    instead and give it an appropriate UnitId argument.\n  | RtsLabel\n        RtsLabelInfo\n\n  -- | A label associated with a block. These aren't visible outside of the\n  -- compilation unit in which they are defined. These are generally used to\n  -- name blocks produced by Cmm-to-Cmm passes and the native code generator,\n  -- where we don't have a 'Name' to associate the label to and therefore can't\n  -- use 'IdLabel'.\n  | LocalBlockLabel\n        {-# UNPACK #-} !Unique\n\n  -- | A 'C' (or otherwise foreign) label.\n  --\n  | ForeignLabel\n        FastString              -- name of the imported label.\n\n        (Maybe Int)             -- possible '@n' suffix for stdcall functions\n                                -- When generating C, the '@n' suffix is omitted, but when\n                                -- generating assembler we must add it to the label.\n\n        ForeignLabelSource      -- what package the foreign label is in.\n\n        FunctionOrData\n\n  -- | Local temporary label used for native (or LLVM) code generation; must not\n  -- appear outside of these contexts. Use primarily for debug information\n  | AsmTempLabel\n        {-# UNPACK #-} !Unique\n\n  -- | A label \\\"derived\\\" from another 'CLabel' by the addition of a suffix.\n  -- Must not occur outside of the NCG or LLVM code generators.\n  | AsmTempDerivedLabel\n        CLabel\n        FastString              -- suffix\n\n  | StringLitLabel\n        {-# UNPACK #-} !Unique\n\n  | CC_Label  CostCentre\n  | CCS_Label CostCentreStack\n\n\n  -- | These labels are generated and used inside the NCG only.\n  --    They are special variants of a label used for dynamic linking\n  --    see module PositionIndependentCode for details.\n  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel\n\n  -- | This label is generated and used inside the NCG only.\n  --    It is used as a base for PIC calculations on some platforms.\n  --    It takes the form of a local numeric assembler label '1'; and\n  --    is pretty-printed as 1b, referring to the previous definition\n  --    of 1: in the assembler source file.\n  | PicBaseLabel\n\n  -- | A label before an info table to prevent excessive dead-stripping on darwin\n  | DeadStripPreventer CLabel\n\n\n  -- | Per-module table of tick locations\n  | HpcTicksLabel Module\n\n  -- | Static reference table\n  | SRTLabel\n        {-# UNPACK #-} !Unique\n\n  -- | A bitmap (function or case return)\n  | LargeBitmapLabel\n        {-# UNPACK #-} !Unique\n\n  deriving Eq\n\n-- This is laborious, but necessary. We can't derive Ord because\n-- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the\n-- implementation. See Note [No Ord for Unique]\n-- This is non-deterministic but we do not currently support deterministic\n-- code-generation. See Note [Unique Determinism and code generation]\ninstance Ord CLabel where\n  compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =\n    compare a1 a2 `thenCmp`\n    compare b1 b2 `thenCmp`\n    compare c1 c2\n  compare (CmmLabel a1 b1 c1) (CmmLabel a2 b2 c2) =\n    compare a1 a2 `thenCmp`\n    compare b1 b2 `thenCmp`\n    compare c1 c2\n  compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2\n  compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2\n  compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =\n    compare a1 a2 `thenCmp`\n    compare b1 b2 `thenCmp`\n    compare c1 c2 `thenCmp`\n    compare d1 d2\n  compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2\n  compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =\n    compare a1 a2 `thenCmp`\n    compare b1 b2\n  compare (StringLitLabel u1) (StringLitLabel u2) =\n    nonDetCmpUnique u1 u2\n  compare (CC_Label a1) (CC_Label a2) =\n    compare a1 a2\n  compare (CCS_Label a1) (CCS_Label a2) =\n    compare a1 a2\n  compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =\n    compare a1 a2 `thenCmp`\n    compare b1 b2\n  compare PicBaseLabel PicBaseLabel = EQ\n  compare (DeadStripPreventer a1) (DeadStripPreventer a2) =\n    compare a1 a2\n  compare (HpcTicksLabel a1) (HpcTicksLabel a2) =\n    compare a1 a2\n  compare (SRTLabel u1) (SRTLabel u2) =\n    nonDetCmpUnique u1 u2\n  compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =\n    nonDetCmpUnique u1 u2\n  compare IdLabel{} _ = LT\n  compare _ IdLabel{} = GT\n  compare CmmLabel{} _ = LT\n  compare _ CmmLabel{} = GT\n  compare RtsLabel{} _ = LT\n  compare _ RtsLabel{} = GT\n  compare LocalBlockLabel{} _ = LT\n  compare _ LocalBlockLabel{} = GT\n  compare ForeignLabel{} _ = LT\n  compare _ ForeignLabel{} = GT\n  compare AsmTempLabel{} _ = LT\n  compare _ AsmTempLabel{} = GT\n  compare AsmTempDerivedLabel{} _ = LT\n  compare _ AsmTempDerivedLabel{} = GT\n  compare StringLitLabel{} _ = LT\n  compare _ StringLitLabel{} = GT\n  compare CC_Label{} _ = LT\n  compare _ CC_Label{} = GT\n  compare CCS_Label{} _ = LT\n  compare _ CCS_Label{} = GT\n  compare DynamicLinkerLabel{} _ = LT\n  compare _ DynamicLinkerLabel{} = GT\n  compare PicBaseLabel{} _ = LT\n  compare _ PicBaseLabel{} = GT\n  compare DeadStripPreventer{} _ = LT\n  compare _ DeadStripPreventer{} = GT\n  compare HpcTicksLabel{} _ = LT\n  compare _ HpcTicksLabel{} = GT\n  compare SRTLabel{} _ = LT\n  compare _ SRTLabel{} = GT\n\n-- | Record where a foreign label is stored.\ndata ForeignLabelSource\n\n   -- | Label is in a named package\n   = ForeignLabelInPackage      UnitId\n\n   -- | Label is in some external, system package that doesn't also\n   --   contain compiled Haskell code, and is not associated with any .hi files.\n   --   We don't have to worry about Haskell code being inlined from\n   --   external packages. It is safe to treat the RTS package as \"external\".\n   | ForeignLabelInExternalPackage\n\n   -- | Label is in the package currenly being compiled.\n   --   This is only used for creating hacky tmp labels during code generation.\n   --   Don't use it in any code that might be inlined across a package boundary\n   --   (ie, core code) else the information will be wrong relative to the\n   --   destination module.\n   | ForeignLabelInThisPackage\n\n   deriving (Eq, Ord)\n\n\n-- | For debugging problems with the CLabel representation.\n--      We can't make a Show instance for CLabel because lots of its components don't have instances.\n--      The regular Outputable instance only shows the label name, and not its other info.\n--\npprDebugCLabel :: CLabel -> SDoc\npprDebugCLabel lbl\n = case lbl of\n        IdLabel _ _ info-> ppr lbl <> (parens $ text \"IdLabel\"\n                                       <> whenPprDebug (text \":\" <> text (show info)))\n        CmmLabel pkg _name _info\n         -> ppr lbl <> (parens $ text \"CmmLabel\" <+> ppr pkg)\n\n        RtsLabel{}      -> ppr lbl <> (parens $ text \"RtsLabel\")\n\n        ForeignLabel _name mSuffix src funOrData\n            -> ppr lbl <> (parens $ text \"ForeignLabel\"\n                                <+> ppr mSuffix\n                                <+> ppr src\n                                <+> ppr funOrData)\n\n        _               -> ppr lbl <> (parens $ text \"other CLabel\")\n\n\ndata IdLabelInfo\n  = Closure             -- ^ Label for closure\n  | InfoTable           -- ^ Info tables for closures; always read-only\n  | Entry               -- ^ Entry point\n  | Slow                -- ^ Slow entry point\n\n  | LocalInfoTable      -- ^ Like InfoTable but not externally visible\n  | LocalEntry          -- ^ Like Entry but not externally visible\n\n  | RednCounts          -- ^ Label of place to keep Ticky-ticky  info for this Id\n\n  | ConEntry            -- ^ Constructor entry point\n  | ConInfoTable        -- ^ Corresponding info table\n\n  | ClosureTable        -- ^ Table of closures for Enum tycons\n\n  | Bytes               -- ^ Content of a string literal. See\n                        -- Note [Bytes label].\n  | BlockInfoTable      -- ^ Like LocalInfoTable but for a proc-point block\n                        -- instead of a closure entry-point.\n                        -- See Note [Proc-point local block entry-point].\n\n  deriving (Eq, Ord, Show)\n\n\ndata RtsLabelInfo\n  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks\n  | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}\n\n  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks\n  | RtsApEntry           Bool{-updatable-} Int{-arity-}\n\n  | RtsPrimOp PrimOp\n  | RtsApFast     FastString    -- ^ _fast versions of generic apply\n  | RtsSlowFastTickyCtr String\n\n  deriving (Eq, Ord)\n  -- NOTE: Eq on PtrString compares the pointer only, so this isn't\n  -- a real equality.\n\n\n-- | What type of Cmm label we're dealing with.\n--      Determines the suffix appended to the name when a CLabel.CmmLabel\n--      is pretty printed.\ndata CmmLabelInfo\n  = CmmInfo                     -- ^ misc rts info tables,      suffix _info\n  | CmmEntry                    -- ^ misc rts entry points,     suffix _entry\n  | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info\n  | CmmRet                      -- ^ misc rts return points,    suffix _ret\n  | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure\n  | CmmCode                     -- ^ misc rts code\n  | CmmClosure                  -- ^ closures eg CHARLIKE_closure\n  | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code\n  deriving (Eq, Ord)\n\ndata DynamicLinkerLabelInfo\n  = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt\n  | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo\n  | GotSymbolPtr                -- ELF: foo@got\n  | GotSymbolOffset             -- ELF: foo@gotoff\n\n  deriving (Eq, Ord)\n\n\n-- -----------------------------------------------------------------------------\n-- Constructing CLabels\n-- -----------------------------------------------------------------------------\n\n-- Constructing IdLabels\n-- These are always local:\n\nmkSRTLabel     :: Unique -> CLabel\nmkSRTLabel u = SRTLabel u\n\nmkRednCountsLabel :: Name -> CLabel\nmkRednCountsLabel       name    =\n  IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]\n\n-- These have local & (possibly) external variants:\nmkLocalClosureLabel      :: Name -> CafInfo -> CLabel\nmkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel\nmkLocalClosureTableLabel :: Name -> CafInfo -> CLabel\nmkLocalClosureLabel     name c  = IdLabel name  c Closure\nmkLocalInfoTableLabel   name c  = IdLabel name  c LocalInfoTable\nmkLocalClosureTableLabel name c = IdLabel name  c ClosureTable\n\nmkClosureLabel              :: Name -> CafInfo -> CLabel\nmkInfoTableLabel            :: Name -> CafInfo -> CLabel\nmkEntryLabel                :: Name -> CafInfo -> CLabel\nmkClosureTableLabel         :: Name -> CafInfo -> CLabel\nmkConInfoTableLabel         :: Name -> CafInfo -> CLabel\nmkBytesLabel                :: Name -> CLabel\nmkClosureLabel name         c     = IdLabel name c Closure\nmkInfoTableLabel name       c     = IdLabel name c InfoTable\nmkEntryLabel name           c     = IdLabel name c Entry\nmkClosureTableLabel name    c     = IdLabel name c ClosureTable\nmkConInfoTableLabel name    c     = IdLabel name c ConInfoTable\nmkBytesLabel name                 = IdLabel name NoCafRefs Bytes\n\nmkBlockInfoTableLabel :: Name -> CafInfo -> CLabel\nmkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable\n                               -- See Note [Proc-point local block entry-point].\n\n-- Constructing Cmm Labels\nmkDirty_MUT_VAR_Label, mkUpdInfoLabel,\n    mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,\n    mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel,\n    mkMAP_DIRTY_infoLabel,\n    mkArrWords_infoLabel,\n    mkTopTickyCtrLabel,\n    mkCAFBlackHoleInfoTableLabel,\n    mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,\n    mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel\nmkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit \"dirty_MUT_VAR\") Nothing ForeignLabelInExternalPackage IsFunction\nmkUpdInfoLabel                  = CmmLabel rtsUnitId (fsLit \"stg_upd_frame\")         CmmInfo\nmkBHUpdInfoLabel                = CmmLabel rtsUnitId (fsLit \"stg_bh_upd_frame\" )     CmmInfo\nmkIndStaticInfoLabel            = CmmLabel rtsUnitId (fsLit \"stg_IND_STATIC\")        CmmInfo\nmkMainCapabilityLabel           = CmmLabel rtsUnitId (fsLit \"MainCapability\")        CmmData\nmkMAP_FROZEN_CLEAN_infoLabel    = CmmLabel rtsUnitId (fsLit \"stg_MUT_ARR_PTRS_FROZEN_CLEAN\") CmmInfo\nmkMAP_FROZEN_DIRTY_infoLabel    = CmmLabel rtsUnitId (fsLit \"stg_MUT_ARR_PTRS_FROZEN_DIRTY\") CmmInfo\nmkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (fsLit \"stg_MUT_ARR_PTRS_DIRTY\") CmmInfo\nmkTopTickyCtrLabel              = CmmLabel rtsUnitId (fsLit \"top_ct\")                CmmData\nmkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (fsLit \"stg_CAF_BLACKHOLE\")     CmmInfo\nmkArrWords_infoLabel            = CmmLabel rtsUnitId (fsLit \"stg_ARR_WORDS\")         CmmInfo\nmkSMAP_FROZEN_CLEAN_infoLabel   = CmmLabel rtsUnitId (fsLit \"stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN\") CmmInfo\nmkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (fsLit \"stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY\") CmmInfo\nmkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (fsLit \"stg_SMALL_MUT_ARR_PTRS_DIRTY\") CmmInfo\nmkBadAlignmentLabel             = CmmLabel rtsUnitId (fsLit \"stg_badAlignment\")      CmmEntry\n\nmkSRTInfoLabel :: Int -> CLabel\nmkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo\n where\n   lbl =\n     case n of\n       1 -> fsLit \"stg_SRT_1\"\n       2 -> fsLit \"stg_SRT_2\"\n       3 -> fsLit \"stg_SRT_3\"\n       4 -> fsLit \"stg_SRT_4\"\n       5 -> fsLit \"stg_SRT_5\"\n       6 -> fsLit \"stg_SRT_6\"\n       7 -> fsLit \"stg_SRT_7\"\n       8 -> fsLit \"stg_SRT_8\"\n       9 -> fsLit \"stg_SRT_9\"\n       10 -> fsLit \"stg_SRT_10\"\n       11 -> fsLit \"stg_SRT_11\"\n       12 -> fsLit \"stg_SRT_12\"\n       13 -> fsLit \"stg_SRT_13\"\n       14 -> fsLit \"stg_SRT_14\"\n       15 -> fsLit \"stg_SRT_15\"\n       16 -> fsLit \"stg_SRT_16\"\n       _ -> panic \"mkSRTInfoLabel\"\n\n-----\nmkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,\n  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmClosureLabel\n        :: UnitId -> FastString -> CLabel\n\nmkCmmInfoLabel      pkg str     = CmmLabel pkg str CmmInfo\nmkCmmEntryLabel     pkg str     = CmmLabel pkg str CmmEntry\nmkCmmRetInfoLabel   pkg str     = CmmLabel pkg str CmmRetInfo\nmkCmmRetLabel       pkg str     = CmmLabel pkg str CmmRet\nmkCmmCodeLabel      pkg str     = CmmLabel pkg str CmmCode\nmkCmmDataLabel      pkg str     = CmmLabel pkg str CmmData\nmkCmmClosureLabel   pkg str     = CmmLabel pkg str CmmClosure\n\nmkLocalBlockLabel :: Unique -> CLabel\nmkLocalBlockLabel u = LocalBlockLabel u\n\n-- Constructing RtsLabels\nmkRtsPrimOpLabel :: PrimOp -> CLabel\nmkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)\n\nmkSelectorInfoLabel  :: Bool -> Int -> CLabel\nmkSelectorEntryLabel :: Bool -> Int -> CLabel\nmkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)\nmkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)\n\nmkApInfoTableLabel :: Bool -> Int -> CLabel\nmkApEntryLabel     :: Bool -> Int -> CLabel\nmkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)\nmkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)\n\n\n-- A call to some primitive hand written Cmm code\nmkPrimCallLabel :: PrimCall -> CLabel\nmkPrimCallLabel (PrimCall str pkg)\n        = CmmLabel pkg str CmmPrimCall\n\n\n-- Constructing ForeignLabels\n\n-- | Make a foreign label\nmkForeignLabel\n        :: FastString           -- name\n        -> Maybe Int            -- size prefix\n        -> ForeignLabelSource   -- what package it's in\n        -> FunctionOrData\n        -> CLabel\n\nmkForeignLabel str mb_sz src fod\n    = ForeignLabel str mb_sz src  fod\n\n\n-- | Update the label size field in a ForeignLabel\naddLabelSize :: CLabel -> Int -> CLabel\naddLabelSize (ForeignLabel str _ src  fod) sz\n    = ForeignLabel str (Just sz) src fod\naddLabelSize label _\n    = label\n\n-- | Whether label is a top-level string literal\nisBytesLabel :: CLabel -> Bool\nisBytesLabel (IdLabel _ _ Bytes) = True\nisBytesLabel _lbl = False\n\n-- | Whether label is a non-haskell label (defined in C code)\nisForeignLabel :: CLabel -> Bool\nisForeignLabel (ForeignLabel _ _ _ _) = True\nisForeignLabel _lbl = False\n\n-- | Whether label is a static closure label (can come from haskell or cmm)\nisStaticClosureLabel :: CLabel -> Bool\n-- Closure defined in haskell (.hs)\nisStaticClosureLabel (IdLabel _ _ Closure) = True\n-- Closure defined in cmm\nisStaticClosureLabel (CmmLabel _ _ CmmClosure) = True\nisStaticClosureLabel _lbl = False\n\n-- | Whether label is a .rodata label\nisSomeRODataLabel :: CLabel -> Bool\n-- info table defined in haskell (.hs)\nisSomeRODataLabel (IdLabel _ _ ClosureTable) = True\nisSomeRODataLabel (IdLabel _ _ ConInfoTable) = True\nisSomeRODataLabel (IdLabel _ _ InfoTable) = True\nisSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True\nisSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True\n-- info table defined in cmm (.cmm)\nisSomeRODataLabel (CmmLabel _ _ CmmInfo) = True\nisSomeRODataLabel _lbl = False\n\n-- | Whether label is points to some kind of info table\nisInfoTableLabel :: CLabel -> Bool\nisInfoTableLabel (IdLabel _ _ InfoTable)      = True\nisInfoTableLabel (IdLabel _ _ LocalInfoTable) = True\nisInfoTableLabel (IdLabel _ _ ConInfoTable)   = True\nisInfoTableLabel (IdLabel _ _ BlockInfoTable) = True\nisInfoTableLabel _                            = False\n\n-- | Whether label is points to constructor info table\nisConInfoTableLabel :: CLabel -> Bool\nisConInfoTableLabel (IdLabel _ _ ConInfoTable)   = True\nisConInfoTableLabel _                            = False\n\n-- | Get the label size field from a ForeignLabel\nforeignLabelStdcallInfo :: CLabel -> Maybe Int\nforeignLabelStdcallInfo (ForeignLabel _ info _ _) = info\nforeignLabelStdcallInfo _lbl = Nothing\n\n\n-- Constructing Large*Labels\nmkBitmapLabel   :: Unique -> CLabel\nmkBitmapLabel   uniq            = LargeBitmapLabel uniq\n\n-- Constructing Cost Center Labels\nmkCCLabel  :: CostCentre      -> CLabel\nmkCCSLabel :: CostCentreStack -> CLabel\nmkCCLabel           cc          = CC_Label cc\nmkCCSLabel          ccs         = CCS_Label ccs\n\nmkRtsApFastLabel :: FastString -> CLabel\nmkRtsApFastLabel str = RtsLabel (RtsApFast str)\n\nmkRtsSlowFastTickyCtrLabel :: String -> CLabel\nmkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)\n\n\n-- Constructing Code Coverage Labels\nmkHpcTicksLabel :: Module -> CLabel\nmkHpcTicksLabel                = HpcTicksLabel\n\n\n-- Constructing labels used for dynamic linking\nmkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel\nmkDynamicLinkerLabel            = DynamicLinkerLabel\n\ndynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)\ndynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)\ndynamicLinkerLabelInfo _        = Nothing\n\nmkPicBaseLabel :: CLabel\nmkPicBaseLabel                  = PicBaseLabel\n\n\n-- Constructing miscellaneous other labels\nmkDeadStripPreventer :: CLabel -> CLabel\nmkDeadStripPreventer lbl        = DeadStripPreventer lbl\n\nmkStringLitLabel :: Unique -> CLabel\nmkStringLitLabel                = StringLitLabel\n\nmkAsmTempLabel :: Uniquable a => a -> CLabel\nmkAsmTempLabel a                = AsmTempLabel (getUnique a)\n\nmkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel\nmkAsmTempDerivedLabel = AsmTempDerivedLabel\n\nmkAsmTempEndLabel :: CLabel -> CLabel\nmkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit \"_end\")\n\n-- | Construct a label for a DWARF Debug Information Entity (DIE)\n-- describing another symbol.\nmkAsmTempDieLabel :: CLabel -> CLabel\nmkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit \"_die\")\n\n-- -----------------------------------------------------------------------------\n-- Convert between different kinds of label\n\ntoClosureLbl :: CLabel -> CLabel\ntoClosureLbl (IdLabel n c _) = IdLabel n c Closure\ntoClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure\ntoClosureLbl l = pprPanic \"toClosureLbl\" (ppr l)\n\ntoSlowEntryLbl :: CLabel -> CLabel\ntoSlowEntryLbl (IdLabel n _ BlockInfoTable)\n  = pprPanic \"toSlowEntryLbl\" (ppr n)\ntoSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow\ntoSlowEntryLbl l = pprPanic \"toSlowEntryLbl\" (ppr l)\n\ntoEntryLbl :: CLabel -> CLabel\ntoEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry\ntoEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry\ntoEntryLbl (IdLabel n _ BlockInfoTable)  = mkLocalBlockLabel (nameUnique n)\n                              -- See Note [Proc-point local block entry-point].\ntoEntryLbl (IdLabel n c _)               = IdLabel n c Entry\ntoEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry\ntoEntryLbl (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet\ntoEntryLbl l = pprPanic \"toEntryLbl\" (ppr l)\n\ntoInfoLbl :: CLabel -> CLabel\ntoInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable\ntoInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable\ntoInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable\ntoInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo\ntoInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo\ntoInfoLbl l = pprPanic \"CLabel.toInfoLbl\" (ppr l)\n\nhasHaskellName :: CLabel -> Maybe Name\nhasHaskellName (IdLabel n _ _) = Just n\nhasHaskellName _               = Nothing\n\n-- -----------------------------------------------------------------------------\n-- Does a CLabel's referent itself refer to a CAF?\nhasCAF :: CLabel -> Bool\nhasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]\nhasCAF (IdLabel _ MayHaveCafRefs _) = True\nhasCAF _                            = False\n\n-- Note [ticky for LNE]\n-- ~~~~~~~~~~~~~~~~~~~~~\n\n-- Until 14 Feb 2013, every ticky counter was associated with a\n-- closure. Thus, ticky labels used IdLabel. It is odd that\n-- CmmBuildInfoTables.cafTransfers would consider such a ticky label\n-- reason to add the name to the CAFEnv (and thus eventually the SRT),\n-- but it was harmless because the ticky was only used if the closure\n-- was also.\n--\n-- Since we now have ticky counters for LNEs, it is no longer the case\n-- that every ticky counter has an actual closure. So I changed the\n-- generation of ticky counters' CLabels to not result in their\n-- associated id ending up in the SRT.\n--\n-- NB IdLabel is still appropriate for ticky ids (as opposed to\n-- CmmLabel) because the LNE's counter is still related to an .hs Id,\n-- that Id just isn't for a proper closure.\n\n-- -----------------------------------------------------------------------------\n-- Does a CLabel need declaring before use or not?\n--\n-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes\n\nneedsCDecl :: CLabel -> Bool\n  -- False <=> it's pre-declared; don't bother\n  -- don't bother declaring Bitmap labels, we always make sure\n  -- they are defined before use.\nneedsCDecl (SRTLabel _)                 = True\nneedsCDecl (LargeBitmapLabel _)         = False\nneedsCDecl (IdLabel _ _ _)              = True\nneedsCDecl (LocalBlockLabel _)          = True\n\nneedsCDecl (StringLitLabel _)           = False\nneedsCDecl (AsmTempLabel _)             = False\nneedsCDecl (AsmTempDerivedLabel _ _)    = False\nneedsCDecl (RtsLabel _)                 = False\n\nneedsCDecl (CmmLabel pkgId _ _)\n        -- Prototypes for labels defined in the runtime system are imported\n        --      into HC files via includes/Stg.h.\n        | pkgId == rtsUnitId         = False\n\n        -- For other labels we inline one into the HC file directly.\n        | otherwise                     = True\n\nneedsCDecl l@(ForeignLabel{})           = not (isMathFun l)\nneedsCDecl (CC_Label _)                 = True\nneedsCDecl (CCS_Label _)                = True\nneedsCDecl (HpcTicksLabel _)            = True\nneedsCDecl (DynamicLinkerLabel {})      = panic \"needsCDecl DynamicLinkerLabel\"\nneedsCDecl PicBaseLabel                 = panic \"needsCDecl PicBaseLabel\"\nneedsCDecl (DeadStripPreventer {})      = panic \"needsCDecl DeadStripPreventer\"\n\n-- | If a label is a local block label then return just its 'BlockId', otherwise\n-- 'Nothing'.\nmaybeLocalBlockLabel :: CLabel -> Maybe BlockId\nmaybeLocalBlockLabel (LocalBlockLabel uq)  = Just $ mkBlockId uq\nmaybeLocalBlockLabel _                     = Nothing\n\n\n-- | Check whether a label corresponds to a C function that has\n--      a prototype in a system header somehere, or is built-in\n--      to the C compiler. For these labels we avoid generating our\n--      own C prototypes.\nisMathFun :: CLabel -> Bool\nisMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs\nisMathFun _ = False\n\nmath_funs :: UniqSet FastString\nmath_funs = mkUniqSet [\n        -- _ISOC99_SOURCE\n        (fsLit \"acos\"),         (fsLit \"acosf\"),        (fsLit \"acosh\"),\n        (fsLit \"acoshf\"),       (fsLit \"acoshl\"),       (fsLit \"acosl\"),\n        (fsLit \"asin\"),         (fsLit \"asinf\"),        (fsLit \"asinl\"),\n        (fsLit \"asinh\"),        (fsLit \"asinhf\"),       (fsLit \"asinhl\"),\n        (fsLit \"atan\"),         (fsLit \"atanf\"),        (fsLit \"atanl\"),\n        (fsLit \"atan2\"),        (fsLit \"atan2f\"),       (fsLit \"atan2l\"),\n        (fsLit \"atanh\"),        (fsLit \"atanhf\"),       (fsLit \"atanhl\"),\n        (fsLit \"cbrt\"),         (fsLit \"cbrtf\"),        (fsLit \"cbrtl\"),\n        (fsLit \"ceil\"),         (fsLit \"ceilf\"),        (fsLit \"ceill\"),\n        (fsLit \"copysign\"),     (fsLit \"copysignf\"),    (fsLit \"copysignl\"),\n        (fsLit \"cos\"),          (fsLit \"cosf\"),         (fsLit \"cosl\"),\n        (fsLit \"cosh\"),         (fsLit \"coshf\"),        (fsLit \"coshl\"),\n        (fsLit \"erf\"),          (fsLit \"erff\"),         (fsLit \"erfl\"),\n        (fsLit \"erfc\"),         (fsLit \"erfcf\"),        (fsLit \"erfcl\"),\n        (fsLit \"exp\"),          (fsLit \"expf\"),         (fsLit \"expl\"),\n        (fsLit \"exp2\"),         (fsLit \"exp2f\"),        (fsLit \"exp2l\"),\n        (fsLit \"expm1\"),        (fsLit \"expm1f\"),       (fsLit \"expm1l\"),\n        (fsLit \"fabs\"),         (fsLit \"fabsf\"),        (fsLit \"fabsl\"),\n        (fsLit \"fdim\"),         (fsLit \"fdimf\"),        (fsLit \"fdiml\"),\n        (fsLit \"floor\"),        (fsLit \"floorf\"),       (fsLit \"floorl\"),\n        (fsLit \"fma\"),          (fsLit \"fmaf\"),         (fsLit \"fmal\"),\n        (fsLit \"fmax\"),         (fsLit \"fmaxf\"),        (fsLit \"fmaxl\"),\n        (fsLit \"fmin\"),         (fsLit \"fminf\"),        (fsLit \"fminl\"),\n        (fsLit \"fmod\"),         (fsLit \"fmodf\"),        (fsLit \"fmodl\"),\n        (fsLit \"frexp\"),        (fsLit \"frexpf\"),       (fsLit \"frexpl\"),\n        (fsLit \"hypot\"),        (fsLit \"hypotf\"),       (fsLit \"hypotl\"),\n        (fsLit \"ilogb\"),        (fsLit \"ilogbf\"),       (fsLit \"ilogbl\"),\n        (fsLit \"ldexp\"),        (fsLit \"ldexpf\"),       (fsLit \"ldexpl\"),\n        (fsLit \"lgamma\"),       (fsLit \"lgammaf\"),      (fsLit \"lgammal\"),\n        (fsLit \"llrint\"),       (fsLit \"llrintf\"),      (fsLit \"llrintl\"),\n        (fsLit \"llround\"),      (fsLit \"llroundf\"),     (fsLit \"llroundl\"),\n        (fsLit \"log\"),          (fsLit \"logf\"),         (fsLit \"logl\"),\n        (fsLit \"log10l\"),       (fsLit \"log10\"),        (fsLit \"log10f\"),\n        (fsLit \"log1pl\"),       (fsLit \"log1p\"),        (fsLit \"log1pf\"),\n        (fsLit \"log2\"),         (fsLit \"log2f\"),        (fsLit \"log2l\"),\n        (fsLit \"logb\"),         (fsLit \"logbf\"),        (fsLit \"logbl\"),\n        (fsLit \"lrint\"),        (fsLit \"lrintf\"),       (fsLit \"lrintl\"),\n        (fsLit \"lround\"),       (fsLit \"lroundf\"),      (fsLit \"lroundl\"),\n        (fsLit \"modf\"),         (fsLit \"modff\"),        (fsLit \"modfl\"),\n        (fsLit \"nan\"),          (fsLit \"nanf\"),         (fsLit \"nanl\"),\n        (fsLit \"nearbyint\"),    (fsLit \"nearbyintf\"),   (fsLit \"nearbyintl\"),\n        (fsLit \"nextafter\"),    (fsLit \"nextafterf\"),   (fsLit \"nextafterl\"),\n        (fsLit \"nexttoward\"),   (fsLit \"nexttowardf\"),  (fsLit \"nexttowardl\"),\n        (fsLit \"pow\"),          (fsLit \"powf\"),         (fsLit \"powl\"),\n        (fsLit \"remainder\"),    (fsLit \"remainderf\"),   (fsLit \"remainderl\"),\n        (fsLit \"remquo\"),       (fsLit \"remquof\"),      (fsLit \"remquol\"),\n        (fsLit \"rint\"),         (fsLit \"rintf\"),        (fsLit \"rintl\"),\n        (fsLit \"round\"),        (fsLit \"roundf\"),       (fsLit \"roundl\"),\n        (fsLit \"scalbln\"),      (fsLit \"scalblnf\"),     (fsLit \"scalblnl\"),\n        (fsLit \"scalbn\"),       (fsLit \"scalbnf\"),      (fsLit \"scalbnl\"),\n        (fsLit \"sin\"),          (fsLit \"sinf\"),         (fsLit \"sinl\"),\n        (fsLit \"sinh\"),         (fsLit \"sinhf\"),        (fsLit \"sinhl\"),\n        (fsLit \"sqrt\"),         (fsLit \"sqrtf\"),        (fsLit \"sqrtl\"),\n        (fsLit \"tan\"),          (fsLit \"tanf\"),         (fsLit \"tanl\"),\n        (fsLit \"tanh\"),         (fsLit \"tanhf\"),        (fsLit \"tanhl\"),\n        (fsLit \"tgamma\"),       (fsLit \"tgammaf\"),      (fsLit \"tgammal\"),\n        (fsLit \"trunc\"),        (fsLit \"truncf\"),       (fsLit \"truncl\"),\n        -- ISO C 99 also defines these function-like macros in math.h:\n        -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,\n        -- isgreaterequal, isless, islessequal, islessgreater, isunordered\n\n        -- additional symbols from _BSD_SOURCE\n        (fsLit \"drem\"),         (fsLit \"dremf\"),        (fsLit \"dreml\"),\n        (fsLit \"finite\"),       (fsLit \"finitef\"),      (fsLit \"finitel\"),\n        (fsLit \"gamma\"),        (fsLit \"gammaf\"),       (fsLit \"gammal\"),\n        (fsLit \"isinf\"),        (fsLit \"isinff\"),       (fsLit \"isinfl\"),\n        (fsLit \"isnan\"),        (fsLit \"isnanf\"),       (fsLit \"isnanl\"),\n        (fsLit \"j0\"),           (fsLit \"j0f\"),          (fsLit \"j0l\"),\n        (fsLit \"j1\"),           (fsLit \"j1f\"),          (fsLit \"j1l\"),\n        (fsLit \"jn\"),           (fsLit \"jnf\"),          (fsLit \"jnl\"),\n        (fsLit \"lgamma_r\"),     (fsLit \"lgammaf_r\"),    (fsLit \"lgammal_r\"),\n        (fsLit \"scalb\"),        (fsLit \"scalbf\"),       (fsLit \"scalbl\"),\n        (fsLit \"significand\"),  (fsLit \"significandf\"), (fsLit \"significandl\"),\n        (fsLit \"y0\"),           (fsLit \"y0f\"),          (fsLit \"y0l\"),\n        (fsLit \"y1\"),           (fsLit \"y1f\"),          (fsLit \"y1l\"),\n        (fsLit \"yn\"),           (fsLit \"ynf\"),          (fsLit \"ynl\"),\n\n        -- These functions are described in IEEE Std 754-2008 -\n        -- Standard for Floating-Point Arithmetic and ISO/IEC TS 18661\n        (fsLit \"nextup\"),       (fsLit \"nextupf\"),      (fsLit \"nextupl\"),\n        (fsLit \"nextdown\"),     (fsLit \"nextdownf\"),    (fsLit \"nextdownl\")\n    ]\n\n-- -----------------------------------------------------------------------------\n-- | Is a CLabel visible outside this object file or not?\n--      From the point of view of the code generator, a name is\n--      externally visible if it has to be declared as exported\n--      in the .o file's symbol table; that is, made non-static.\nexternallyVisibleCLabel :: CLabel -> Bool -- not C \"static\"\nexternallyVisibleCLabel (StringLitLabel _)      = False\nexternallyVisibleCLabel (AsmTempLabel _)        = False\nexternallyVisibleCLabel (AsmTempDerivedLabel _ _)= False\nexternallyVisibleCLabel (RtsLabel _)            = True\nexternallyVisibleCLabel (LocalBlockLabel _)     = False\nexternallyVisibleCLabel (CmmLabel _ _ _)        = True\nexternallyVisibleCLabel (ForeignLabel{})        = True\nexternallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info\nexternallyVisibleCLabel (CC_Label _)            = True\nexternallyVisibleCLabel (CCS_Label _)           = True\nexternallyVisibleCLabel (DynamicLinkerLabel _ _)  = False\nexternallyVisibleCLabel (HpcTicksLabel _)       = True\nexternallyVisibleCLabel (LargeBitmapLabel _)    = False\nexternallyVisibleCLabel (SRTLabel _)            = False\nexternallyVisibleCLabel (PicBaseLabel {}) = panic \"externallyVisibleCLabel PicBaseLabel\"\nexternallyVisibleCLabel (DeadStripPreventer {}) = panic \"externallyVisibleCLabel DeadStripPreventer\"\n\nexternallyVisibleIdLabel :: IdLabelInfo -> Bool\nexternallyVisibleIdLabel LocalInfoTable  = False\nexternallyVisibleIdLabel LocalEntry      = False\nexternallyVisibleIdLabel BlockInfoTable  = False\nexternallyVisibleIdLabel _               = True\n\n-- -----------------------------------------------------------------------------\n-- Finding the \"type\" of a CLabel\n\n-- For generating correct types in label declarations:\n\ndata CLabelType\n  = CodeLabel   -- Address of some executable instructions\n  | DataLabel   -- Address of data, not a GC ptr\n  | GcPtrLabel  -- Address of a (presumably static) GC object\n\nisCFunctionLabel :: CLabel -> Bool\nisCFunctionLabel lbl = case labelType lbl of\n                        CodeLabel -> True\n                        _other    -> False\n\nisGcPtrLabel :: CLabel -> Bool\nisGcPtrLabel lbl = case labelType lbl of\n                        GcPtrLabel -> True\n                        _other     -> False\n\n\n-- | Work out the general type of data at the address of this label\n--    whether it be code, data, or static GC object.\nlabelType :: CLabel -> CLabelType\nlabelType (IdLabel _ _ info)                    = idInfoLabelType info\nlabelType (CmmLabel _ _ CmmData)                = DataLabel\nlabelType (CmmLabel _ _ CmmClosure)             = GcPtrLabel\nlabelType (CmmLabel _ _ CmmCode)                = CodeLabel\nlabelType (CmmLabel _ _ CmmInfo)                = DataLabel\nlabelType (CmmLabel _ _ CmmEntry)               = CodeLabel\nlabelType (CmmLabel _ _ CmmPrimCall)            = CodeLabel\nlabelType (CmmLabel _ _ CmmRetInfo)             = DataLabel\nlabelType (CmmLabel _ _ CmmRet)                 = CodeLabel\nlabelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel\nlabelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel\nlabelType (RtsLabel (RtsApFast _))              = CodeLabel\nlabelType (RtsLabel _)                          = DataLabel\nlabelType (LocalBlockLabel _)                   = CodeLabel\nlabelType (SRTLabel _)                          = DataLabel\nlabelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel\nlabelType (ForeignLabel _ _ _ IsData)           = DataLabel\nlabelType (AsmTempLabel _)                      = panic \"labelType(AsmTempLabel)\"\nlabelType (AsmTempDerivedLabel _ _)             = panic \"labelType(AsmTempDerivedLabel)\"\nlabelType (StringLitLabel _)                    = DataLabel\nlabelType (CC_Label _)                          = DataLabel\nlabelType (CCS_Label _)                         = DataLabel\nlabelType (DynamicLinkerLabel _ _)              = DataLabel -- Is this right?\nlabelType PicBaseLabel                          = DataLabel\nlabelType (DeadStripPreventer _)                = DataLabel\nlabelType (HpcTicksLabel _)                     = DataLabel\nlabelType (LargeBitmapLabel _)                  = DataLabel\n\nidInfoLabelType :: IdLabelInfo -> CLabelType\nidInfoLabelType info =\n  case info of\n    InfoTable     -> DataLabel\n    LocalInfoTable -> DataLabel\n    BlockInfoTable -> DataLabel\n    Closure       -> GcPtrLabel\n    ConInfoTable  -> DataLabel\n    ClosureTable  -> DataLabel\n    RednCounts    -> DataLabel\n    Bytes         -> DataLabel\n    _             -> CodeLabel\n\n\n-- -----------------------------------------------------------------------------\n\n-- | Is a 'CLabel' defined in the current module being compiled?\n--\n-- Sometimes we can optimise references within a compilation unit in ways that\n-- we couldn't for inter-module references. This provides a conservative\n-- estimate of whether a 'CLabel' lives in the current module.\nisLocalCLabel :: Module -> CLabel -> Bool\nisLocalCLabel this_mod lbl =\n  case lbl of\n    IdLabel name _ _\n      | isInternalName name -> True\n      | otherwise           -> nameModule name == this_mod\n    LocalBlockLabel _       -> True\n    _                       -> False\n\n-- -----------------------------------------------------------------------------\n\n-- | Does a 'CLabel' need dynamic linkage?\n--\n-- When referring to data in code, we need to know whether\n-- that data resides in a DLL or not. [Win32 only.]\n-- @labelDynamic@ returns @True@ if the label is located\n-- in a DLL, be it a data reference or not.\nlabelDynamic :: DynFlags -> Module -> CLabel -> Bool\nlabelDynamic dflags this_mod lbl =\n  case lbl of\n   -- is the RTS in a DLL or not?\n   RtsLabel _ ->\n     externalDynamicRefs && (this_pkg /= rtsUnitId)\n\n   IdLabel n _ _ ->\n     isDllName dflags this_mod n\n\n   -- When compiling in the \"dyn\" way, each package is to be linked into\n   -- its own shared library.\n   CmmLabel pkg _ _\n    | os == OSMinGW32 ->\n       externalDynamicRefs && (this_pkg /= pkg)\n    | otherwise ->\n       gopt Opt_ExternalDynamicRefs dflags\n\n   LocalBlockLabel _    -> False\n\n   ForeignLabel _ _ source _  ->\n       if os == OSMinGW32\n       then case source of\n            -- Foreign label is in some un-named foreign package (or DLL).\n            ForeignLabelInExternalPackage -> True\n\n            -- Foreign label is linked into the same package as the\n            -- source file currently being compiled.\n            ForeignLabelInThisPackage -> False\n\n            -- Foreign label is in some named package.\n            -- When compiling in the \"dyn\" way, each package is to be\n            -- linked into its own DLL.\n            ForeignLabelInPackage pkgId ->\n                externalDynamicRefs && (this_pkg /= pkgId)\n\n       else -- On Mac OS X and on ELF platforms, false positives are OK,\n            -- so we claim that all foreign imports come from dynamic\n            -- libraries\n            True\n\n   CC_Label cc ->\n     externalDynamicRefs && not (ccFromThisModule cc this_mod)\n\n   -- CCS_Label always contains a CostCentre defined in the current module\n   CCS_Label _ -> False\n\n   HpcTicksLabel m ->\n     externalDynamicRefs && this_mod /= m\n\n   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.\n   _                 -> False\n  where\n    externalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags\n    os = platformOS (targetPlatform dflags)\n    this_pkg = moduleUnitId this_mod\n\n\n-----------------------------------------------------------------------------\n-- Printing out CLabels.\n\n{-\nConvention:\n\n      <name>_<type>\n\nwhere <name> is <Module>_<name> for external names and <unique> for\ninternal names. <type> is one of the following:\n\n         info                   Info table\n         srt                    Static reference table\n         entry                  Entry code (function, closure)\n         slow                   Slow entry code (if any)\n         ret                    Direct return address\n         vtbl                   Vector table\n         <n>_alt                Case alternative (tag n)\n         dflt                   Default case alternative\n         btm                    Large bitmap vector\n         closure                Static closure\n         con_entry              Dynamic Constructor entry code\n         con_info               Dynamic Constructor info table\n         static_entry           Static Constructor entry code\n         static_info            Static Constructor info table\n         sel_info               Selector info table\n         sel_entry              Selector entry code\n         cc                     Cost centre\n         ccs                    Cost centre stack\n\nMany of these distinctions are only for documentation reasons.  For\nexample, _ret is only distinguished from _entry to make it easy to\ntell whether a code fragment is a return point or a closure/function\nentry.\n\nNote [Closure and info labels]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor a function 'foo, we have:\n   foo_info    : Points to the info table describing foo's closure\n                 (and entry code for foo with tables next to code)\n   foo_closure : Static (no-free-var) closure only:\n                 points to the statically-allocated closure\n\nFor a data constructor (such as Just or Nothing), we have:\n    Just_con_info: Info table for the data constructor itself\n                   the first word of a heap-allocated Just\n    Just_info:     Info table for the *worker function*, an\n                   ordinary Haskell function of arity 1 that\n                   allocates a (Just x) box:\n                      Just = \\x -> Just x\n    Just_closure:  The closure for this worker\n\n    Nothing_closure: a statically allocated closure for Nothing\n    Nothing_static_info: info table for Nothing_closure\n\nAll these must be exported symbol, EXCEPT Just_info.  We don't need to\nexport this because in other modules we either have\n       * A reference to 'Just'; use Just_closure\n       * A saturated call 'Just x'; allocate using Just_con_info\nNot exporting these Just_info labels reduces the number of symbols\nsomewhat.\n\nNote [Bytes label]\n~~~~~~~~~~~~~~~~~~\nFor a top-level string literal 'foo', we have just one symbol 'foo_bytes', which\npoints to a static data block containing the content of the literal.\n\nNote [Proc-point local block entry-points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA label for a proc-point local block entry-point has no \"_entry\" suffix. With\n`infoTblLbl` we derive an info table label from a proc-point block ID. If\nwe convert such an info table label into an entry label we must produce\nthe label without an \"_entry\" suffix. So an info table label records\nthe fact that it was derived from a block ID in `IdLabelInfo` as\n`BlockInfoTable`.\n\nThe info table label and the local block label are both local labels\nand are not externally visible.\n-}\n\ninstance Outputable CLabel where\n  ppr c = sdocWithPlatform $ \\platform -> pprCLabel platform c\n\npprCLabel :: Platform -> CLabel -> SDoc\n\npprCLabel _ (LocalBlockLabel u)\n  =  tempLabelPrefixOrUnderscore <> pprUniqueAlways u\n\npprCLabel platform (AsmTempLabel u)\n | not (platformUnregisterised platform)\n  =  tempLabelPrefixOrUnderscore <> pprUniqueAlways u\n\npprCLabel platform (AsmTempDerivedLabel l suf)\n | cGhcWithNativeCodeGen == \"YES\"\n   = ptext (asmTempLabelPrefix platform)\n     <> case l of AsmTempLabel u    -> pprUniqueAlways u\n                  LocalBlockLabel u -> pprUniqueAlways u\n                  _other            -> pprCLabel platform l\n     <> ftext suf\n\npprCLabel platform (DynamicLinkerLabel info lbl)\n | cGhcWithNativeCodeGen == \"YES\"\n   = pprDynamicLinkerAsmLabel platform info lbl\n\npprCLabel _ PicBaseLabel\n | cGhcWithNativeCodeGen == \"YES\"\n   = text \"1b\"\n\npprCLabel platform (DeadStripPreventer lbl)\n | cGhcWithNativeCodeGen == \"YES\"\n   =\n   {-\n      `lbl` can be temp one but we need to ensure that dsp label will stay\n      in the final binary so we prepend non-temp prefix (\"dsp_\") and\n      optional `_` (underscore) because this is how you mark non-temp symbols\n      on some platforms (Darwin)\n   -}\n   maybe_underscore $ text \"dsp_\"\n   <> pprCLabel platform lbl <> text \"_dsp\"\n\npprCLabel _ (StringLitLabel u)\n | cGhcWithNativeCodeGen == \"YES\"\n  = pprUniqueAlways u <> ptext (sLit \"_str\")\n\npprCLabel platform lbl\n   = getPprStyle $ \\ sty ->\n     if cGhcWithNativeCodeGen == \"YES\" && asmStyle sty\n     then maybe_underscore (pprAsmCLbl platform lbl)\n     else pprCLbl lbl\n\nmaybe_underscore :: SDoc -> SDoc\nmaybe_underscore doc\n  | underscorePrefix = pp_cSEP <> doc\n  | otherwise        = doc\n\npprAsmCLbl :: Platform -> CLabel -> SDoc\npprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)\n | platformOS platform == OSMinGW32\n    -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.\n    -- (The C compiler does this itself).\n    = ftext fs <> char '@' <> int sz\npprAsmCLbl _ lbl\n   = pprCLbl lbl\n\npprCLbl :: CLabel -> SDoc\npprCLbl (StringLitLabel u)\n  = pprUniqueAlways u <> text \"_str\"\n\npprCLbl (SRTLabel u)\n  = tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text \"srt\"\n\npprCLbl (LargeBitmapLabel u)  =\n  tempLabelPrefixOrUnderscore\n  <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text \"btm\"\n-- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')\n-- until that gets resolved we'll just force them to start\n-- with a letter so the label will be legal assembly code.\n\n\npprCLbl (CmmLabel _ str CmmCode)        = ftext str\npprCLbl (CmmLabel _ str CmmData)        = ftext str\npprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str\n\npprCLbl (LocalBlockLabel u)             =\n    tempLabelPrefixOrUnderscore <> text \"blk_\" <> pprUniqueAlways u\n\npprCLbl (RtsLabel (RtsApFast str))   = ftext str <> text \"_fast\"\n\npprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))\n  = sdocWithDynFlags $ \\dflags ->\n    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)\n    hcat [text \"stg_sel_\", text (show offset),\n          ptext (if upd_reqd\n                 then (sLit \"_upd_info\")\n                 else (sLit \"_noupd_info\"))\n        ]\n\npprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))\n  = sdocWithDynFlags $ \\dflags ->\n    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)\n    hcat [text \"stg_sel_\", text (show offset),\n                ptext (if upd_reqd\n                        then (sLit \"_upd_entry\")\n                        else (sLit \"_noupd_entry\"))\n        ]\n\npprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))\n  = sdocWithDynFlags $ \\dflags ->\n    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)\n    hcat [text \"stg_ap_\", text (show arity),\n                ptext (if upd_reqd\n                        then (sLit \"_upd_info\")\n                        else (sLit \"_noupd_info\"))\n        ]\n\npprCLbl (RtsLabel (RtsApEntry upd_reqd arity))\n  = sdocWithDynFlags $ \\dflags ->\n    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)\n    hcat [text \"stg_ap_\", text (show arity),\n                ptext (if upd_reqd\n                        then (sLit \"_upd_entry\")\n                        else (sLit \"_noupd_entry\"))\n        ]\n\npprCLbl (CmmLabel _ fs CmmInfo)\n  = ftext fs <> text \"_info\"\n\npprCLbl (CmmLabel _ fs CmmEntry)\n  = ftext fs <> text \"_entry\"\n\npprCLbl (CmmLabel _ fs CmmRetInfo)\n  = ftext fs <> text \"_info\"\n\npprCLbl (CmmLabel _ fs CmmRet)\n  = ftext fs <> text \"_ret\"\n\npprCLbl (CmmLabel _ fs CmmClosure)\n  = ftext fs <> text \"_closure\"\n\npprCLbl (RtsLabel (RtsPrimOp primop))\n  = text \"stg_\" <> ppr primop\n\npprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))\n  = text \"SLOW_CALL_fast_\" <> text pat <> ptext (sLit \"_ctr\")\n\npprCLbl (ForeignLabel str _ _ _)\n  = ftext str\n\npprCLbl (IdLabel name _cafs flavor) =\n  internalNamePrefix name <> ppr name <> ppIdFlavor flavor\n\npprCLbl (CC_Label cc)           = ppr cc\npprCLbl (CCS_Label ccs)         = ppr ccs\n\npprCLbl (HpcTicksLabel mod)\n  = text \"_hpc_tickboxes_\"  <> ppr mod <> ptext (sLit \"_hpc\")\n\npprCLbl (AsmTempLabel {})       = panic \"pprCLbl AsmTempLabel\"\npprCLbl (AsmTempDerivedLabel {})= panic \"pprCLbl AsmTempDerivedLabel\"\npprCLbl (DynamicLinkerLabel {}) = panic \"pprCLbl DynamicLinkerLabel\"\npprCLbl (PicBaseLabel {})       = panic \"pprCLbl PicBaseLabel\"\npprCLbl (DeadStripPreventer {}) = panic \"pprCLbl DeadStripPreventer\"\n\nppIdFlavor :: IdLabelInfo -> SDoc\nppIdFlavor x = pp_cSEP <> text\n               (case x of\n                       Closure          -> \"closure\"\n                       InfoTable        -> \"info\"\n                       LocalInfoTable   -> \"info\"\n                       Entry            -> \"entry\"\n                       LocalEntry       -> \"entry\"\n                       Slow             -> \"slow\"\n                       RednCounts       -> \"ct\"\n                       ConEntry         -> \"con_entry\"\n                       ConInfoTable     -> \"con_info\"\n                       ClosureTable     -> \"closure_tbl\"\n                       Bytes            -> \"bytes\"\n                       BlockInfoTable   -> \"info\"\n                      )\n\n\npp_cSEP :: SDoc\npp_cSEP = char '_'\n\n\ninstance Outputable ForeignLabelSource where\n ppr fs\n  = case fs of\n        ForeignLabelInPackage pkgId     -> parens $ text \"package: \" <> ppr pkgId\n        ForeignLabelInThisPackage       -> parens $ text \"this package\"\n        ForeignLabelInExternalPackage   -> parens $ text \"external package\"\n\ninternalNamePrefix :: Name -> SDoc\ninternalNamePrefix name = getPprStyle $ \\ sty ->\n  if asmStyle sty && isRandomGenerated then\n    sdocWithPlatform $ \\platform ->\n      ptext (asmTempLabelPrefix platform)\n  else\n    empty\n  where\n    isRandomGenerated = not $ isExternalName name\n\ntempLabelPrefixOrUnderscore :: SDoc\ntempLabelPrefixOrUnderscore = sdocWithPlatform $ \\platform ->\n  getPprStyle $ \\ sty ->\n   if asmStyle sty then\n      ptext (asmTempLabelPrefix platform)\n   else\n      char '_'\n\n-- -----------------------------------------------------------------------------\n-- Machine-dependent knowledge about labels.\n\nunderscorePrefix :: Bool   -- leading underscore on assembler labels?\nunderscorePrefix = (cLeadingUnderscore == \"YES\")\n\nasmTempLabelPrefix :: Platform -> PtrString  -- for formatting labels\nasmTempLabelPrefix platform = case platformOS platform of\n    OSDarwin -> sLit \"L\"\n    OSAIX    -> sLit \"__L\" -- follow IBM XL C's convention\n    _        -> sLit \".L\"\n\npprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc\npprDynamicLinkerAsmLabel platform dllInfo lbl =\n    case platformOS platform of\n      OSDarwin\n        | platformArch platform == ArchX86_64 ->\n          case dllInfo of\n            CodeStub        -> char 'L' <> ppr lbl <> text \"$stub\"\n            SymbolPtr       -> char 'L' <> ppr lbl <> text \"$non_lazy_ptr\"\n            GotSymbolPtr    -> ppr lbl <> text \"@GOTPCREL\"\n            GotSymbolOffset -> ppr lbl\n        | otherwise ->\n          case dllInfo of\n            CodeStub  -> char 'L' <> ppr lbl <> text \"$stub\"\n            SymbolPtr -> char 'L' <> ppr lbl <> text \"$non_lazy_ptr\"\n            _         -> panic \"pprDynamicLinkerAsmLabel\"\n\n      OSAIX ->\n          case dllInfo of\n            SymbolPtr -> text \"LC..\" <> ppr lbl -- GCC's naming convention\n            _         -> panic \"pprDynamicLinkerAsmLabel\"\n\n      _ | osElfTarget (platformOS platform) -> elfLabel\n\n      OSMinGW32 ->\n          case dllInfo of\n            SymbolPtr -> text \"__imp_\" <> ppr lbl\n            _         -> panic \"pprDynamicLinkerAsmLabel\"\n\n      _ -> panic \"pprDynamicLinkerAsmLabel\"\n  where\n    elfLabel\n      | platformArch platform == ArchPPC\n      = case dllInfo of\n          CodeStub  -> -- See Note [.LCTOC1 in PPC PIC code]\n                       ppr lbl <> text \"+32768@plt\"\n          SymbolPtr -> text \".LC_\" <> ppr lbl\n          _         -> panic \"pprDynamicLinkerAsmLabel\"\n\n      | platformArch platform == ArchX86_64\n      = case dllInfo of\n          CodeStub        -> ppr lbl <> text \"@plt\"\n          GotSymbolPtr    -> ppr lbl <> text \"@gotpcrel\"\n          GotSymbolOffset -> ppr lbl\n          SymbolPtr       -> text \".LC_\" <> ppr lbl\n\n      | platformArch platform == ArchPPC_64 ELF_V1\n        || platformArch platform == ArchPPC_64 ELF_V2\n      = case dllInfo of\n          GotSymbolPtr    -> text \".LC_\"  <> ppr lbl\n                                  <> text \"@toc\"\n          GotSymbolOffset -> ppr lbl\n          SymbolPtr       -> text \".LC_\" <> ppr lbl\n          _               -> panic \"pprDynamicLinkerAsmLabel\"\n\n      | otherwise\n      = case dllInfo of\n          CodeStub        -> ppr lbl <> text \"@plt\"\n          SymbolPtr       -> text \".LC_\" <> ppr lbl\n          GotSymbolPtr    -> ppr lbl <> text \"@got\"\n          GotSymbolOffset -> ppr lbl <> text \"@gotoff\"\n", "num_lines": 1435}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Cmm representations using Hoopl's Graph CmmNode e x.\n{-# LANGUAGE GADTs #-}\n\nmodule Cmm (\n     -- * Cmm top-level datatypes\n     CmmProgram, CmmGroup, GenCmmGroup,\n     CmmDecl, GenCmmDecl(..),\n     CmmGraph, GenCmmGraph(..),\n     CmmBlock,\n     RawCmmDecl, RawCmmGroup,\n     Section(..), SectionType(..), CmmStatics(..), CmmStatic(..),\n     isSecConstant,\n\n     -- ** Blocks containing lists\n     GenBasicBlock(..), blockId,\n     ListGraph(..), pprBBlock,\n\n     -- * Info Tables\n     CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,\n     ClosureTypeInfo(..),\n     ProfilingInfo(..), ConstrDescription,\n\n     -- * Statements, expressions and types\n     module CmmNode,\n     module CmmExpr,\n  ) where\n\nimport GhcPrelude\n\nimport Id\nimport CostCentre\nimport CLabel\nimport BlockId\nimport CmmNode\nimport SMRep\nimport CmmExpr\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport Hoopl.Label\nimport Outputable\nimport Data.ByteString (ByteString)\n\n-----------------------------------------------------------------------------\n--  Cmm, GenCmm\n-----------------------------------------------------------------------------\n\n-- A CmmProgram is a list of CmmGroups\n-- A CmmGroup is a list of top-level declarations\n\n-- When object-splitting is on, each group is compiled into a separate\n-- .o file. So typically we put closely related stuff in a CmmGroup.\n-- Section-splitting follows suit and makes one .text subsection for each\n-- CmmGroup.\n\ntype CmmProgram = [CmmGroup]\n\ntype GenCmmGroup d h g = [GenCmmDecl d h g]\ntype CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph\ntype RawCmmGroup = GenCmmGroup CmmStatics (LabelMap CmmStatics) CmmGraph\n\n-----------------------------------------------------------------------------\n--  CmmDecl, GenCmmDecl\n-----------------------------------------------------------------------------\n\n-- GenCmmDecl is abstracted over\n--   d, the type of static data elements in CmmData\n--   h, the static info preceding the code of a CmmProc\n--   g, the control-flow graph of a CmmProc\n--\n-- We expect there to be two main instances of this type:\n--   (a) C--, i.e. populated with various C-- constructs\n--   (b) Native code, populated with data/instructions\n\n-- | A top-level chunk, abstracted over the type of the contents of\n-- the basic blocks (Cmm or instructions are the likely instantiations).\ndata GenCmmDecl d h g\n  = CmmProc     -- A procedure\n     h                 -- Extra header such as the info table\n     CLabel            -- Entry label\n     [GlobalReg]       -- Registers live on entry. Note that the set of live\n                       -- registers will be correct in generated C-- code, but\n                       -- not in hand-written C-- code. However,\n                       -- splitAtProcPoints calculates correct liveness\n                       -- information for CmmProcs.\n     g                 -- Control-flow graph for the procedure's code\n\n  | CmmData     -- Static data\n        Section\n        d\n\ntype CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph\n\ntype RawCmmDecl\n   = GenCmmDecl\n        CmmStatics\n        (LabelMap CmmStatics)\n        CmmGraph\n\n-----------------------------------------------------------------------------\n--     Graphs\n-----------------------------------------------------------------------------\n\ntype CmmGraph = GenCmmGraph CmmNode\ndata GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }\ntype CmmBlock = Block CmmNode C C\n\n-----------------------------------------------------------------------------\n--     Info Tables\n-----------------------------------------------------------------------------\n\ndata CmmTopInfo   = TopInfo { info_tbls  :: LabelMap CmmInfoTable\n                            , stack_info :: CmmStackInfo }\n\ntopInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable\ntopInfoTable (CmmProc infos _ _ g) = mapLookup (g_entry g) (info_tbls infos)\ntopInfoTable _                     = Nothing\n\ndata CmmStackInfo\n   = StackInfo {\n       arg_space :: ByteOff,\n               -- number of bytes of arguments on the stack on entry to the\n               -- the proc.  This is filled in by StgCmm.codeGen, and used\n               -- by the stack allocator later.\n       updfr_space :: Maybe ByteOff,\n               -- XXX: this never contains anything useful, but it should.\n               -- See comment in CmmLayoutStack.\n       do_layout :: Bool\n               -- Do automatic stack layout for this proc.  This is\n               -- True for all code generated by the code generator,\n               -- but is occasionally False for hand-written Cmm where\n               -- we want to do the stack manipulation manually.\n  }\n\n-- | Info table as a haskell data type\ndata CmmInfoTable\n  = CmmInfoTable {\n      cit_lbl  :: CLabel, -- Info table label\n      cit_rep  :: SMRep,\n      cit_prof :: ProfilingInfo,\n      cit_srt  :: Maybe CLabel,   -- empty, or a closure address\n      cit_clo  :: Maybe (Id, CostCentreStack)\n        -- Just (id,ccs) <=> build a static closure later\n        -- Nothing <=> don't build a static closure\n        --\n        -- Static closures for FUNs and THUNKs are *not* generated by\n        -- the code generator, because we might want to add SRT\n        -- entries to them later (for FUNs at least; THUNKs are\n        -- treated the same for consistency). See Note [SRTs] in\n        -- CmmBuildInfoTables, in particular the [FUN] optimisation.\n        --\n        -- This is strictly speaking not a part of the info table that\n        -- will be finally generated, but it's the only convenient\n        -- place to convey this information from the code generator to\n        -- where we build the static closures in\n        -- CmmBuildInfoTables.doSRTs.\n    }\n\ndata ProfilingInfo\n  = NoProfilingInfo\n  | ProfilingInfo ByteString ByteString -- closure_type, closure_desc\n\n-----------------------------------------------------------------------------\n--              Static Data\n-----------------------------------------------------------------------------\n\ndata SectionType\n  = Text\n  | Data\n  | ReadOnlyData\n  | RelocatableReadOnlyData\n  | UninitialisedData\n  | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned\n  | CString\n  | OtherSection String\n  deriving (Show)\n\n-- | Should a data in this section be considered constant\nisSecConstant :: Section -> Bool\nisSecConstant (Section t _) = case t of\n    Text                    -> True\n    ReadOnlyData            -> True\n    RelocatableReadOnlyData -> True\n    ReadOnlyData16          -> True\n    CString                 -> True\n    Data                    -> False\n    UninitialisedData       -> False\n    (OtherSection _)        -> False\n\ndata Section = Section SectionType CLabel\n\ndata CmmStatic\n  = CmmStaticLit CmmLit\n        -- a literal value, size given by cmmLitRep of the literal.\n  | CmmUninitialised Int\n        -- uninitialised data, N bytes long\n  | CmmString ByteString\n        -- string of 8-bit values only, not zero terminated.\n\ndata CmmStatics\n   = Statics\n       CLabel      -- Label of statics\n       [CmmStatic] -- The static data itself\n\n-- -----------------------------------------------------------------------------\n-- Basic blocks consisting of lists\n\n-- These are used by the LLVM and NCG backends, when populating Cmm\n-- with lists of instructions.\n\ndata GenBasicBlock i = BasicBlock BlockId [i]\n\n-- | The branch block id is that of the first block in\n-- the branch, which is that branch's entry point\nblockId :: GenBasicBlock i -> BlockId\nblockId (BasicBlock blk_id _ ) = blk_id\n\nnewtype ListGraph i = ListGraph [GenBasicBlock i]\n\ninstance Outputable instr => Outputable (ListGraph instr) where\n    ppr (ListGraph blocks) = vcat (map ppr blocks)\n\ninstance Outputable instr => Outputable (GenBasicBlock instr) where\n    ppr = pprBBlock\n\npprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc\npprBBlock (BasicBlock ident stmts) =\n    hang (ppr ident <> colon) 4 (vcat (map ppr stmts))\n\n", "num_lines": 230}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, BangPatterns, RecordWildCards,\n    GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections #-}\n\nmodule CmmBuildInfoTables\n  ( CAFSet, CAFEnv, cafAnal\n  , doSRTs, ModuleSRTInfo, emptySRT\n  ) where\n\nimport GhcPrelude hiding (succ)\n\nimport Id\nimport BlockId\nimport Hoopl.Block\nimport Hoopl.Graph\nimport Hoopl.Label\nimport Hoopl.Collections\nimport Hoopl.Dataflow\nimport Module\nimport Platform\nimport Digraph\nimport CLabel\nimport PprCmmDecl ()\nimport Cmm\nimport CmmUtils\nimport DynFlags\nimport Maybes\nimport Outputable\nimport SMRep\nimport UniqSupply\nimport CostCentre\nimport StgCmmHeap\n\nimport PprCmm()\nimport Control.Monad\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport Data.Set (Set)\nimport qualified Data.Set as Set\nimport Data.Tuple\nimport Control.Monad.Trans.State\nimport Control.Monad.Trans.Class\n\n\n{- Note [SRTs]\n\nSRTs are the mechanism by which the garbage collector can determine\nthe live CAFs in the program.\n\nRepresentation\n^^^^^^^^^^^^^^\n\n+------+\n| info |\n|      |     +-----+---+---+---+\n|   -------->|SRT_2| | | | | 0 |\n|------|     +-----+-|-+-|-+---+\n|      |             |   |\n| code |             |   |\n|      |             v   v\n\nAn SRT is simply an object in the program's data segment. It has the\nsame representation as a static constructor.  There are 16\npre-compiled SRT info tables: stg_SRT_1_info, .. stg_SRT_16_info,\nrepresenting SRT objects with 1-16 pointers, respectively.\n\nThe entries of an SRT object point to static closures, which are either\n- FUN_STATIC, THUNK_STATIC or CONSTR\n- Another SRT (actually just a CONSTR)\n\nThe final field of the SRT is the static link field, used by the\ngarbage collector to chain together static closures that it visits and\nto determine whether a static closure has been visited or not. (see\nNote [STATIC_LINK fields])\n\nBy traversing the transitive closure of an SRT, the GC will reach all\nof the CAFs that are reachable from the code associated with this SRT.\n\nIf we need to create an SRT with more than 16 entries, we build a\nchain of SRT objects with all but the last having 16 entries.\n\n+-----+---+- -+---+---+\n|SRT16| | |   | | | 0 |\n+-----+-|-+- -+-|-+---+\n        |       |\n        v       v\n              +----+---+---+---+\n              |SRT2| | | | | 0 |\n              +----+-|-+-|-+---+\n                     |   |\n                     |   |\n                     v   v\n\nReferring to an SRT from the info table\n^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n\nThe following things have SRTs:\n\n- Static functions (FUN)\n- Static thunks (THUNK), ie. CAFs\n- Continuations (RET_SMALL, etc.)\n\nIn each case, the info table points to the SRT.\n\n- info->srt is zero if there's no SRT, otherwise:\n- info->srt == 1 and info->f.srt_offset points to the SRT\n\ne.g. for a FUN with an SRT:\n\nStgFunInfoTable       +------+\n  info->f.srt_offset  |  ------------> offset to SRT object\nStgStdInfoTable       +------+\n  info->layout.ptrs   | ...  |\n  info->layout.nptrs  | ...  |\n  info->srt           |  1   |\n  info->type          | ...  |\n                      |------|\n\nOn x86_64, we optimise the info table representation further.  The\noffset to the SRT can be stored in 32 bits (all code lives within a\n2GB region in x86_64's small memory model), so we can save a word in\nthe info table by storing the srt_offset in the srt field, which is\nhalf a word.\n\nOn x86_64 with TABLES_NEXT_TO_CODE (except on MachO, due to #15169):\n\n- info->srt is zero if there's no SRT, otherwise:\n- info->srt is an offset from the info pointer to the SRT object\n\nStgStdInfoTable       +------+\n  info->layout.ptrs   |      |\n  info->layout.nptrs  |      |\n  info->srt           |  ------------> offset to SRT object\n                      |------|\n\n\nEXAMPLE\n^^^^^^^\n\nf = \\x. ... g ...\n  where\n    g = \\y. ... h ... c1 ...\n    h = \\z. ... c2 ...\n\nc1 & c2 are CAFs\n\ng and h are local functions, but they have no static closures.  When\nwe generate code for f, we start with a CmmGroup of four CmmDecls:\n\n   [ f_closure, f_entry, g_entry, h_entry ]\n\nwe process each CmmDecl separately in cpsTop, giving us a list of\nCmmDecls. e.g. for f_entry, we might end up with\n\n   [ f_entry, f1_ret, f2_proc ]\n\nwhere f1_ret is a return point, and f2_proc is a proc-point.  We have\na CAFSet for each of these CmmDecls, let's suppose they are\n\n   [ f_entry{g_info}, f1_ret{g_info}, f2_proc{} ]\n   [ g_entry{h_info, c1_closure} ]\n   [ h_entry{c2_closure} ]\n\nNext, we make an SRT for each of these functions:\n\n  f_srt : [g_info]\n  g_srt : [h_info, c1_closure]\n  h_srt : [c2_closure]\n\nNow, for g_info and h_info, we want to refer to the SRTs for g and h\nrespectively, which we'll label g_srt and h_srt:\n\n  f_srt : [g_srt]\n  g_srt : [h_srt, c1_closure]\n  h_srt : [c2_closure]\n\nNow, when an SRT has a single entry, we don't actually generate an SRT\nclosure for it, instead we just replace references to it with its\nsingle element.  So, since h_srt == c2_closure, we have\n\n  f_srt : [g_srt]\n  g_srt : [c2_closure, c1_closure]\n  h_srt : [c2_closure]\n\nand the only SRT closure we generate is\n\n  g_srt = SRT_2 [c2_closure, c1_closure]\n\n\nOptimisations\n^^^^^^^^^^^^^\n\nTo reduce the code size overhead and the cost of traversing SRTs in\nthe GC, we want to simplify SRTs where possible. We therefore apply\nthe following optimisations.  Each has a [keyword]; search for the\nkeyword in the code below to see where the optimisation is\nimplemented.\n\n1. [Inline] we never create an SRT with a single entry, instead we\n   point to the single entry directly from the info table.\n\n   i.e. instead of\n\n    +------+\n    | info |\n    |      |     +-----+---+---+\n    |   -------->|SRT_1| | | 0 |\n    |------|     +-----+-|-+---+\n    |      |             |\n    | code |             |\n    |      |             v\n                         C\n\n   we can point directly to the closure:\n\n    +------+\n    | info |\n    |      |\n    |   -------->C\n    |------|\n    |      |\n    | code |\n    |      |\n\n\n   Furthermore, the SRT for any code that refers to this info table\n   can point directly to C.\n\n   The exception to this is when we're doing dynamic linking. In that\n   case, if the closure is not locally defined then we can't point to\n   it directly from the info table, because this is the text section\n   which cannot contain runtime relocations. In this case we skip this\n   optimisation and generate the singleton SRT, becase SRTs are in the\n   data section and *can* have relocatable references.\n\n2. [FUN] A static function closure can also be an SRT, we simply put\n   the SRT entries as fields in the static closure.  This makes a lot\n   of sense: the static references are just like the free variables of\n   the FUN closure.\n\n   i.e. instead of\n\n   f_closure:\n   +-----+---+\n   |  |  | 0 |\n   +- |--+---+\n      |            +------+\n      |            | info |     f_srt:\n      |            |      |     +-----+---+---+---+\n      |            |   -------->|SRT_2| | | | + 0 |\n      `----------->|------|     +-----+-|-+-|-+---+\n                   |      |             |   |\n                   | code |             |   |\n                   |      |             v   v\n\n\n   We can generate:\n\n   f_closure:\n   +-----+---+---+---+\n   |  |  | | | | | 0 |\n   +- |--+-|-+-|-+---+\n      |    |   |   +------+\n      |    v   v   | info |\n      |            |      |\n      |            |   0  |\n      `----------->|------|\n                   |      |\n                   | code |\n                   |      |\n\n\n   (note: we can't do this for THUNKs, because the thunk gets\n   overwritten when it is entered, so we wouldn't be able to share\n   this SRT with other info tables that want to refer to it (see\n   [Common] below). FUNs are immutable so don't have this problem.)\n\n3. [Common] Identical SRTs can be commoned up.\n\n4. [Filter] If an SRT A refers to an SRT B and a closure C, and B also\n   refers to C (perhaps transitively), then we can omit the reference\n   to C from A.\n\n\nNote that there are many other optimisations that we could do, but\naren't implemented. In general, we could omit any reference from an\nSRT if everything reachable from it is also reachable from the other\nfields in the SRT. Our [Filter] optimisation is a special case of\nthis.\n\nAnother opportunity we don't exploit is this:\n\nA = {X,Y,Z}\nB = {Y,Z}\nC = {X,B}\n\nHere we could use C = {A} and therefore [Inline] C = A.\n-}\n\n-- ---------------------------------------------------------------------\n{- Note [Invalid optimisation: shortcutting]\n\nYou might think that if we have something like\n\nA's SRT = {B}\nB's SRT = {X}\n\nthat we could replace the reference to B in A's SRT with X.\n\nA's SRT = {X}\nB's SRT = {X}\n\nand thereby perhaps save a little work at runtime, because we don't\nhave to visit B.\n\nBut this is NOT valid.\n\nConsider these cases:\n\n0. B can't be a constructor, because constructors don't have SRTs\n\n1. B is a CAF. This is the easy one. Obviously we want A's SRT to\n   point to B, so that it keeps B alive.\n\n2. B is a function.  This is the tricky one. The reason we can't\nshortcut in this case is that we aren't allowed to resurrect static\nobjects.\n\n== How does this cause a problem? ==\n\nThe particular case that cropped up when we tried this was #15544.\n- A is a thunk\n- B is a static function\n- X is a CAF\n- suppose we GC when A is alive, and B is not otherwise reachable.\n- B is \"collected\", meaning that it doesn't make it onto the static\n  objects list during this GC, but nothing bad happens yet.\n- Next, suppose we enter A, and then call B. (remember that A refers to B)\n  At the entry point to B, we GC. This puts B on the stack, as part of the\n  RET_FUN stack frame that gets pushed when we GC at a function entry point.\n- This GC will now reach B\n- But because B was previous \"collected\", it breaks the assumption\n  that static objects are never resurrected. See Note [STATIC_LINK\n  fields] in rts/sm/Storage.h for why this is bad.\n- In practice, the GC thinks that B has already been visited, and so\n  doesn't visit X, and catastrophe ensues.\n\n== Isn't this caused by the RET_FUN business? ==\n\nMaybe, but could you prove that RET_FUN is the only way that\nresurrection can occur?\n\nSo, no shortcutting.\n-}\n\n-- ---------------------------------------------------------------------\n-- Label types\n\n-- Labels that come from cafAnal can be:\n--   - _closure labels for static functions or CAFs\n--   - _info labels for dynamic functions, thunks, or continuations\n--   - _entry labels for functions or thunks\n--\n-- Meanwhile the labels on top-level blocks are _entry labels.\n--\n-- To put everything in the same namespace we convert all labels to\n-- closure labels using toClosureLbl.  Note that some of these\n-- labels will not actually exist; that's ok because we're going to\n-- map them to SRTEntry later, which ranges over labels that do exist.\n--\nnewtype CAFLabel = CAFLabel CLabel\n  deriving (Eq,Ord,Outputable)\n\ntype CAFSet = Set CAFLabel\ntype CAFEnv = LabelMap CAFSet\n\nmkCAFLabel :: CLabel -> CAFLabel\nmkCAFLabel lbl = CAFLabel (toClosureLbl lbl)\n\n-- This is a label that we can put in an SRT.  It *must* be a closure label,\n-- pointing to either a FUN_STATIC, THUNK_STATIC, or CONSTR.\nnewtype SRTEntry = SRTEntry CLabel\n  deriving (Eq, Ord, Outputable)\n\n-- ---------------------------------------------------------------------\n-- CAF analysis\n\n-- |\n-- For each code block:\n--   - collect the references reachable from this code block to FUN,\n--     THUNK or RET labels for which hasCAF == True\n--\n-- This gives us a `CAFEnv`: a mapping from code block to sets of labels\n--\ncafAnal\n  :: LabelSet   -- The blocks representing continuations, ie. those\n                -- that will get RET info tables.  These labels will\n                -- get their own SRTs, so we don't aggregate CAFs from\n                -- references to these labels, we just use the label.\n  -> CLabel     -- The top label of the proc\n  -> CmmGraph\n  -> CAFEnv\ncafAnal contLbls topLbl cmmGraph =\n  analyzeCmmBwd cafLattice\n    (cafTransfers contLbls (g_entry cmmGraph) topLbl) cmmGraph mapEmpty\n\n\ncafLattice :: DataflowLattice CAFSet\ncafLattice = DataflowLattice Set.empty add\n  where\n    add (OldFact old) (NewFact new) =\n        let !new' = old `Set.union` new\n        in changedIf (Set.size new' > Set.size old) new'\n\n\ncafTransfers :: LabelSet -> Label -> CLabel -> TransferFun CAFSet\ncafTransfers contLbls entry topLbl\n  (BlockCC eNode middle xNode) fBase =\n    let joined = cafsInNode xNode $! live'\n        !result = foldNodesBwdOO cafsInNode middle joined\n\n        facts = mapMaybe successorFact (successors xNode)\n        live' = joinFacts cafLattice facts\n\n        successorFact s\n          -- If this is a loop back to the entry, we can refer to the\n          -- entry label.\n          | s == entry = Just (add topLbl Set.empty)\n          -- If this is a continuation, we want to refer to the\n          -- SRT for the continuation's info table\n          | s `setMember` contLbls\n          = Just (Set.singleton (mkCAFLabel (infoTblLbl s)))\n          -- Otherwise, takes the CAF references from the destination\n          | otherwise\n          = lookupFact s fBase\n\n        cafsInNode :: CmmNode e x -> CAFSet -> CAFSet\n        cafsInNode node set = foldExpDeep addCaf node set\n\n        addCaf expr !set =\n          case expr of\n              CmmLit (CmmLabel c) -> add c set\n              CmmLit (CmmLabelOff c _) -> add c set\n              CmmLit (CmmLabelDiffOff c1 c2 _ _) -> add c1 $! add c2 set\n              _ -> set\n        add l s | hasCAF l  = Set.insert (mkCAFLabel l) s\n                | otherwise = s\n\n    in mapSingleton (entryLabel eNode) result\n\n\n-- -----------------------------------------------------------------------------\n-- ModuleSRTInfo\n\ndata ModuleSRTInfo = ModuleSRTInfo\n  { thisModule :: Module\n    -- ^ Current module being compiled. Required for calling labelDynamic.\n  , dedupSRTs :: Map (Set SRTEntry) SRTEntry\n    -- ^ previous SRTs we've emitted, so we can de-duplicate.\n    -- Used to implement the [Common] optimisation.\n  , flatSRTs :: Map SRTEntry (Set SRTEntry)\n    -- ^ The reverse mapping, so that we can remove redundant\n    -- entries. e.g.  if we have an SRT [a,b,c], and we know that b\n    -- points to [c,d], we can omit c and emit [a,b].\n    -- Used to implement the [Filter] optimisation.\n  }\ninstance Outputable ModuleSRTInfo where\n  ppr ModuleSRTInfo{..} =\n    text \"ModuleSRTInfo:\" <+> ppr dedupSRTs <+> ppr flatSRTs\n\nemptySRT :: Module -> ModuleSRTInfo\nemptySRT mod =\n  ModuleSRTInfo\n    { thisModule = mod\n    , dedupSRTs = Map.empty\n    , flatSRTs = Map.empty }\n\n-- -----------------------------------------------------------------------------\n-- Constructing SRTs\n\n{- Implementation notes\n\n- In each CmmDecl there is a mapping info_tbls from Label -> CmmInfoTable\n\n- The entry in info_tbls corresponding to g_entry is the closure info\n  table, the rest are continuations.\n\n- Each entry in info_tbls possibly needs an SRT.  We need to make a\n  label for each of these.\n\n- We get the CAFSet for each entry from the CAFEnv\n\n-}\n\n-- | Return a (Label,CLabel) pair for each labelled block of a CmmDecl,\n--   where the label is\n--   - the info label for a continuation or dynamic closure\n--   - the closure label for a top-level function (not a CAF)\ngetLabelledBlocks :: CmmDecl -> [(Label, CAFLabel)]\ngetLabelledBlocks (CmmData _ _) = []\ngetLabelledBlocks (CmmProc top_info _ _ _) =\n  [ (blockId, mkCAFLabel (cit_lbl info))\n  | (blockId, info) <- mapToList (info_tbls top_info)\n  , let rep = cit_rep info\n  , not (isStaticRep rep) || not (isThunkRep rep)\n  ]\n\n\n-- | Put the labelled blocks that we will be annotating with SRTs into\n-- dependency order.  This is so that we can process them one at a\n-- time, resolving references to earlier blocks to point to their\n-- SRTs. CAFs themselves are not included here; see getCAFs below.\ndepAnalSRTs\n  :: CAFEnv\n  -> [CmmDecl]\n  -> [SCC (Label, CAFLabel, Set CAFLabel)]\ndepAnalSRTs cafEnv decls =\n  srtTrace \"depAnalSRTs\" (ppr graph) graph\n where\n  labelledBlocks = concatMap getLabelledBlocks decls\n  labelToBlock = Map.fromList (map swap labelledBlocks)\n  graph = stronglyConnCompFromEdgedVerticesOrd\n             [ let cafs' = Set.delete lbl cafs in\n               DigraphNode (l,lbl,cafs') l\n                 (mapMaybe (flip Map.lookup labelToBlock) (Set.toList cafs'))\n             | (l, lbl) <- labelledBlocks\n             , Just cafs <- [mapLookup l cafEnv] ]\n\n\n-- | Get (Label, CAFLabel, Set CAFLabel) for each block that represents a CAF.\n-- These are treated differently from other labelled blocks:\n--  - we never shortcut a reference to a CAF to the contents of its\n--    SRT, since the point of SRTs is to keep CAFs alive.\n--  - CAFs therefore don't take part in the dependency analysis in depAnalSRTs.\n--    instead we generate their SRTs after everything else.\ngetCAFs :: CAFEnv -> [CmmDecl] -> [(Label, CAFLabel, Set CAFLabel)]\ngetCAFs cafEnv decls =\n  [ (g_entry g, mkCAFLabel topLbl, cafs)\n  | CmmProc top_info topLbl _ g <- decls\n  , Just info <- [mapLookup (g_entry g) (info_tbls top_info)]\n  , let rep = cit_rep info\n  , isStaticRep rep && isThunkRep rep\n  , Just cafs <- [mapLookup (g_entry g) cafEnv]\n  ]\n\n\n-- | Get the list of blocks that correspond to the entry points for\n-- FUN_STATIC closures.  These are the blocks for which if we have an\n-- SRT we can merge it with the static closure. [FUN]\ngetStaticFuns :: [CmmDecl] -> [(BlockId, CLabel)]\ngetStaticFuns decls =\n  [ (g_entry g, lbl)\n  | CmmProc top_info _ _ g <- decls\n  , Just info <- [mapLookup (g_entry g) (info_tbls top_info)]\n  , Just (id, _) <- [cit_clo info]\n  , let rep = cit_rep info\n  , isStaticRep rep && isFunRep rep\n  , let lbl = mkLocalClosureLabel (idName id) (idCafInfo id)\n  ]\n\n\n-- | Maps labels from 'cafAnal' to the final CLabel that will appear\n-- in the SRT.\n--   - closures with singleton SRTs resolve to their single entry\n--   - closures with larger SRTs map to the label for that SRT\n--   - CAFs must not map to anything!\n--   - if a labels maps to Nothing, we found that this label's SRT\n--     is empty, so we don't need to refer to it from other SRTs.\ntype SRTMap = Map CAFLabel (Maybe SRTEntry)\n\n-- | resolve a CAFLabel to its SRTEntry using the SRTMap\nresolveCAF :: SRTMap -> CAFLabel -> Maybe SRTEntry\nresolveCAF srtMap lbl@(CAFLabel l) =\n  Map.findWithDefault (Just (SRTEntry (toClosureLbl l))) lbl srtMap\n\n\n-- | Attach SRTs to all info tables in the CmmDecls, and add SRT\n-- declarations to the ModuleSRTInfo.\n--\ndoSRTs\n  :: DynFlags\n  -> ModuleSRTInfo\n  -> [(CAFEnv, [CmmDecl])]\n  -> IO (ModuleSRTInfo, [CmmDecl])\n\ndoSRTs dflags moduleSRTInfo tops = do\n  us <- mkSplitUniqSupply 'u'\n\n  -- Ignore the original grouping of decls, and combine all the\n  -- CAFEnvs into a single CAFEnv.\n  let (cafEnvs, declss) = unzip tops\n      cafEnv = mapUnions cafEnvs\n      decls = concat declss\n      staticFuns = mapFromList (getStaticFuns decls)\n\n  -- Put the decls in dependency order. Why? So that we can implement\n  -- [Inline] and [Filter].  If we need to refer to an SRT that has\n  -- a single entry, we use the entry itself, which means that we\n  -- don't need to generate the singleton SRT in the first place.  But\n  -- to do this we need to process blocks before things that depend on\n  -- them.\n  let\n    sccs = depAnalSRTs cafEnv decls\n    cafsWithSRTs = getCAFs cafEnv decls\n\n  -- On each strongly-connected group of decls, construct the SRT\n  -- closures and the SRT fields for info tables.\n  let result ::\n        [ ( [CmmDecl]              -- generated SRTs\n          , [(Label, CLabel)]      -- SRT fields for info tables\n          , [(Label, [SRTEntry])]  -- SRTs to attach to static functions\n          ) ]\n      ((result, _srtMap), moduleSRTInfo') =\n        initUs_ us $\n        flip runStateT moduleSRTInfo $\n        flip runStateT Map.empty $ do\n          nonCAFs <- mapM (doSCC dflags staticFuns) sccs\n          cAFs <- forM cafsWithSRTs $ \\(l, cafLbl, cafs) ->\n            oneSRT dflags staticFuns [l] [cafLbl] True{-is a CAF-} cafs\n          return (nonCAFs ++ cAFs)\n\n      (declss, pairs, funSRTs) = unzip3 result\n\n  -- Next, update the info tables with the SRTs\n  let\n    srtFieldMap = mapFromList (concat pairs)\n    funSRTMap = mapFromList (concat funSRTs)\n    decls' = concatMap (updInfoSRTs dflags srtFieldMap funSRTMap) decls\n\n  return (moduleSRTInfo', concat declss ++ decls')\n\n\n-- | Build the SRT for a strongly-connected component of blocks\ndoSCC\n  :: DynFlags\n  -> LabelMap CLabel           -- which blocks are static function entry points\n  -> SCC (Label, CAFLabel, Set CAFLabel)\n  -> StateT SRTMap\n        (StateT ModuleSRTInfo UniqSM)\n        ( [CmmDecl]              -- generated SRTs\n        , [(Label, CLabel)]      -- SRT fields for info tables\n        , [(Label, [SRTEntry])]  -- SRTs to attach to static functions\n        )\n\ndoSCC dflags staticFuns  (AcyclicSCC (l, cafLbl, cafs)) =\n  oneSRT dflags staticFuns [l] [cafLbl] False cafs\n\ndoSCC dflags staticFuns (CyclicSCC nodes) = do\n  -- build a single SRT for the whole cycle, see Note [recursive SRTs]\n  let (blockids, lbls, cafsets) = unzip3 nodes\n      cafs = Set.unions cafsets\n  oneSRT dflags staticFuns blockids lbls False cafs\n\n\n{- Note [recursive SRTs]\n\nIf the dependency analyser has found us a recursive group of\ndeclarations, then we build a single SRT for the whole group, on the\ngrounds that everything in the group is reachable from everything\nelse, so we lose nothing by having a single SRT.\n\nHowever, there are a couple of wrinkles to be aware of.\n\n* The Set CAFLabel for this SRT will contain labels in the group\nitself. The SRTMap will therefore not contain entries for these labels\nyet, so we can't turn them into SRTEntries using resolveCAF. BUT we\ncan just remove recursive references from the Set CAFLabel before\ngenerating the SRT - the SRT will still contain all the CAFLabels that\nwe need to refer to from this group's SRT.\n\n* That is, EXCEPT for static function closures. For the same reason\ndescribed in Note [Invalid optimisation: shortcutting], we cannot omit\nreferences to static function closures.\n  - But, since we will merge the SRT with one of the static function\n    closures (see [FUN]), we can omit references to *that* static\n    function closure from the SRT.\n-}\n\n-- | Build an SRT for a set of blocks\noneSRT\n  :: DynFlags\n  -> LabelMap CLabel            -- which blocks are static function entry points\n  -> [Label]                    -- blocks in this set\n  -> [CAFLabel]                 -- labels for those blocks\n  -> Bool                       -- True <=> this SRT is for a CAF\n  -> Set CAFLabel               -- SRT for this set\n  -> StateT SRTMap\n       (StateT ModuleSRTInfo UniqSM)\n       ( [CmmDecl]                    -- SRT objects we built\n       , [(Label, CLabel)]            -- SRT fields for these blocks' itbls\n       , [(Label, [SRTEntry])]        -- SRTs to attach to static functions\n       )\n\noneSRT dflags staticFuns blockids lbls isCAF cafs = do\n  srtMap <- get\n  topSRT <- lift get\n  let\n    -- Can we merge this SRT with a FUN_STATIC closure?\n    (maybeFunClosure, otherFunLabels) =\n      case [ (l,b) | b <- blockids, Just l <- [mapLookup b staticFuns] ] of\n        [] -> (Nothing, [])\n        ((l,b):xs) -> (Just (l,b), map (mkCAFLabel . fst) xs)\n\n    -- Remove recursive references from the SRT, except for (all but\n    -- one of the) static functions. See Note [recursive SRTs].\n    nonRec = cafs `Set.difference`\n      (Set.fromList lbls `Set.difference` Set.fromList otherFunLabels)\n\n    -- First resolve all the CAFLabels to SRTEntries\n    -- Implements the [Inline] optimisation.\n    resolved =\n       Set.fromList $\n       catMaybes (map (resolveCAF srtMap) (Set.toList nonRec))\n\n    -- The set of all SRTEntries in SRTs that we refer to from here.\n    allBelow =\n      Set.unions [ lbls | caf <- Set.toList resolved\n                        , Just lbls <- [Map.lookup caf (flatSRTs topSRT)] ]\n\n    -- Remove SRTEntries that are also in an SRT that we refer to.\n    -- Implements the [Filter] optimisation.\n    filtered = Set.difference resolved allBelow\n\n  srtTrace \"oneSRT:\"\n     (ppr cafs <+> ppr resolved <+> ppr allBelow <+> ppr filtered) $ return ()\n\n  let\n    isStaticFun = isJust maybeFunClosure\n\n    -- For a label without a closure (e.g. a continuation), we must\n    -- update the SRTMap for the label to point to a closure. It's\n    -- important that we don't do this for static functions or CAFs,\n    -- see Note [Invalid optimisation: shortcutting].\n    updateSRTMap srtEntry =\n      when (not isCAF && not isStaticFun) $ do\n        let newSRTMap = Map.fromList [(cafLbl, srtEntry) | cafLbl <- lbls]\n        put (Map.union newSRTMap srtMap)\n\n    this_mod = thisModule topSRT\n\n  case Set.toList filtered of\n    [] -> do\n      srtTrace \"oneSRT: empty\" (ppr lbls) $ return ()\n      updateSRTMap Nothing\n      return ([], [], [])\n\n    -- [Inline] - when we have only one entry there is no need to\n    -- build an SRT object at all, instead we put the singleton SRT\n    -- entry in the info table.\n    [one@(SRTEntry lbl)]\n      | -- Info tables refer to SRTs by offset (as noted in the section\n        -- \"Referring to an SRT from the info table\" of Note [SRTs]). However,\n        -- when dynamic linking is used we cannot guarantee that the offset\n        -- between the SRT and the info table will fit in the offset field.\n        -- Consequently we build a singleton SRT in in this case.\n        not (labelDynamic dflags this_mod lbl)\n\n        -- MachO relocations can't express offsets between compilation units at\n        -- all, so we are always forced to build a singleton SRT in this case.\n          && (not (osMachOTarget $ platformOS $ targetPlatform dflags)\n             || isLocalCLabel this_mod lbl) -> do\n\n        -- If we have a static function closure, then it becomes the\n        -- SRT object, and everything else points to it. (the only way\n        -- we could have multiple labels here is if this is a\n        -- recursive group, see Note [recursive SRTs])\n        case maybeFunClosure of\n          Just (staticFunLbl,staticFunBlock) -> return ([], withLabels, [])\n            where\n              withLabels =\n                [ (b, if b == staticFunBlock then lbl else staticFunLbl)\n                | b <- blockids ]\n          Nothing -> do\n            updateSRTMap (Just one)\n            return ([], map (,lbl) blockids, [])\n\n    cafList ->\n      -- Check whether an SRT with the same entries has been emitted already.\n      -- Implements the [Common] optimisation.\n      case Map.lookup filtered (dedupSRTs topSRT) of\n        Just srtEntry@(SRTEntry srtLbl)  -> do\n          srtTrace \"oneSRT [Common]\" (ppr lbls <+> ppr srtLbl) $ return ()\n          updateSRTMap (Just srtEntry)\n          return ([], map (,srtLbl) blockids, [])\n        Nothing -> do\n          -- No duplicates: we have to build a new SRT object\n          srtTrace \"oneSRT: new\" (ppr lbls <+> ppr filtered) $ return ()\n          (decls, funSRTs, srtEntry) <-\n            case maybeFunClosure of\n              Just (fun,block) ->\n                return ( [], [(block, cafList)], SRTEntry fun )\n              Nothing -> do\n                (decls, entry) <- lift . lift $ buildSRTChain dflags cafList\n                return (decls, [], entry)\n          updateSRTMap (Just srtEntry)\n          let allBelowThis = Set.union allBelow filtered\n              oldFlatSRTs = flatSRTs topSRT\n              newFlatSRTs = Map.insert srtEntry allBelowThis oldFlatSRTs\n              newDedupSRTs = Map.insert filtered srtEntry (dedupSRTs topSRT)\n          lift (put (topSRT { dedupSRTs = newDedupSRTs\n                            , flatSRTs = newFlatSRTs }))\n          let SRTEntry lbl = srtEntry\n          return (decls, map (,lbl) blockids, funSRTs)\n\n\n-- | build a static SRT object (or a chain of objects) from a list of\n-- SRTEntries.\nbuildSRTChain\n   :: DynFlags\n   -> [SRTEntry]\n   -> UniqSM\n        ( [CmmDecl]    -- The SRT object(s)\n        , SRTEntry     -- label to use in the info table\n        )\nbuildSRTChain _ [] = panic \"buildSRT: empty\"\nbuildSRTChain dflags cafSet =\n  case splitAt mAX_SRT_SIZE cafSet of\n    (these, []) -> do\n      (decl,lbl) <- buildSRT dflags these\n      return ([decl], lbl)\n    (these,those) -> do\n      (rest, rest_lbl) <- buildSRTChain dflags (head these : those)\n      (decl,lbl) <- buildSRT dflags (rest_lbl : tail these)\n      return (decl:rest, lbl)\n  where\n    mAX_SRT_SIZE = 16\n\n\nbuildSRT :: DynFlags -> [SRTEntry] -> UniqSM (CmmDecl, SRTEntry)\nbuildSRT dflags refs = do\n  id <- getUniqueM\n  let\n    lbl = mkSRTLabel id\n    srt_n_info = mkSRTInfoLabel (length refs)\n    fields =\n      mkStaticClosure dflags srt_n_info dontCareCCS\n        [ CmmLabel lbl | SRTEntry lbl <- refs ]\n        [] -- no padding\n        [mkIntCLit dflags 0] -- link field\n        [] -- no saved info\n  return (mkDataLits (Section Data lbl) lbl fields, SRTEntry lbl)\n\n\n-- | Update info tables with references to their SRTs. Also generate\n-- static closures, splicing in SRT fields as necessary.\nupdInfoSRTs\n  :: DynFlags\n  -> LabelMap CLabel               -- SRT labels for each block\n  -> LabelMap [SRTEntry]           -- SRTs to merge into FUN_STATIC closures\n  -> CmmDecl\n  -> [CmmDecl]\n\nupdInfoSRTs dflags srt_env funSRTEnv (CmmProc top_info top_l live g)\n  | Just (_,closure) <- maybeStaticClosure = [ proc, closure ]\n  | otherwise = [ proc ]\n  where\n    proc = CmmProc top_info { info_tbls = newTopInfo } top_l live g\n    newTopInfo = mapMapWithKey updInfoTbl (info_tbls top_info)\n    updInfoTbl l info_tbl\n      | l == g_entry g, Just (inf, _) <- maybeStaticClosure = inf\n      | otherwise  = info_tbl { cit_srt = mapLookup l srt_env }\n\n    -- Generate static closures [FUN].  Note that this also generates\n    -- static closures for thunks (CAFs), because it's easier to treat\n    -- them uniformly in the code generator.\n    maybeStaticClosure :: Maybe (CmmInfoTable, CmmDecl)\n    maybeStaticClosure\n      | Just info_tbl@CmmInfoTable{..} <-\n           mapLookup (g_entry g) (info_tbls top_info)\n      , Just (id, ccs) <- cit_clo\n      , isStaticRep cit_rep =\n        let\n          (newInfo, srtEntries) = case mapLookup (g_entry g) funSRTEnv of\n            Nothing ->\n              -- if we don't add SRT entries to this closure, then we\n              -- want to set the srt field in its info table as usual\n              (info_tbl { cit_srt = mapLookup (g_entry g) srt_env }, [])\n            Just srtEntries -> srtTrace \"maybeStaticFun\" (ppr res)\n              (info_tbl { cit_rep = new_rep }, res)\n              where res = [ CmmLabel lbl | SRTEntry lbl <- srtEntries ]\n          fields = mkStaticClosureFields dflags info_tbl ccs (idCafInfo id)\n            srtEntries\n          new_rep = case cit_rep of\n             HeapRep sta ptrs nptrs ty ->\n               HeapRep sta (ptrs + length srtEntries) nptrs ty\n             _other -> panic \"maybeStaticFun\"\n          lbl = mkLocalClosureLabel (idName id) (idCafInfo id)\n        in\n          Just (newInfo, mkDataLits (Section Data lbl) lbl fields)\n      | otherwise = Nothing\n\nupdInfoSRTs _ _ _ t = [t]\n\n\nsrtTrace :: String -> SDoc -> b -> b\n-- srtTrace = pprTrace\nsrtTrace _ _ b = b\n", "num_lines": 897}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CmmCallConv (\n  ParamLocation(..),\n  assignArgumentsPos,\n  assignStack,\n  realArgRegsCover\n) where\n\nimport GhcPrelude\n\nimport CmmExpr\nimport SMRep\nimport Cmm (Convention(..))\nimport PprCmm ()\n\nimport DynFlags\nimport Platform\nimport Outputable\n\n-- Calculate the 'GlobalReg' or stack locations for function call\n-- parameters as used by the Cmm calling convention.\n\ndata ParamLocation\n  = RegisterParam GlobalReg\n  | StackParam ByteOff\n\ninstance Outputable ParamLocation where\n  ppr (RegisterParam g) = ppr g\n  ppr (StackParam p)    = ppr p\n\n-- |\n-- Given a list of arguments, and a function that tells their types,\n-- return a list showing where each argument is passed\n--\nassignArgumentsPos :: DynFlags\n                   -> ByteOff           -- stack offset to start with\n                   -> Convention\n                   -> (a -> CmmType)    -- how to get a type from an arg\n                   -> [a]               -- args\n                   -> (\n                        ByteOff              -- bytes of stack args\n                      , [(a, ParamLocation)] -- args and locations\n                      )\n\nassignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)\n    where\n      regs = case (reps, conv) of\n               (_,   NativeNodeCall)   -> getRegsWithNode dflags\n               (_,   NativeDirectCall) -> getRegsWithoutNode dflags\n               ([_], NativeReturn)     -> allRegs dflags\n               (_,   NativeReturn)     -> getRegsWithNode dflags\n               -- GC calling convention *must* put values in registers\n               (_,   GC)               -> allRegs dflags\n               (_,   Slow)             -> nodeOnly\n      -- The calling conventions first assign arguments to registers,\n      -- then switch to the stack when we first run out of registers\n      -- (even if there are still available registers for args of a\n      -- different type).  When returning an unboxed tuple, we also\n      -- separate the stack arguments by pointerhood.\n      (reg_assts, stk_args)  = assign_regs [] reps regs\n      (stk_off,   stk_assts) = assignStack dflags off arg_ty stk_args\n      assignments = reg_assts ++ stk_assts\n\n      assign_regs assts []     _    = (assts, [])\n      assign_regs assts (r:rs) regs | isVecType ty   = vec\n                                    | isFloatType ty = float\n                                    | otherwise      = int\n        where vec = case (w, regs) of\n                      (W128, (vs, fs, ds, ls, s:ss))\n                          | passVectorInReg W128 dflags -> k (RegisterParam (XmmReg s), (vs, fs, ds, ls, ss))\n                      (W256, (vs, fs, ds, ls, s:ss))\n                          | passVectorInReg W256 dflags -> k (RegisterParam (YmmReg s), (vs, fs, ds, ls, ss))\n                      (W512, (vs, fs, ds, ls, s:ss))\n                          | passVectorInReg W512 dflags -> k (RegisterParam (ZmmReg s), (vs, fs, ds, ls, ss))\n                      _ -> (assts, (r:rs))\n              float = case (w, regs) of\n                        (W32, (vs, fs, ds, ls, s:ss))\n                            | passFloatInXmm          -> k (RegisterParam (FloatReg s), (vs, fs, ds, ls, ss))\n                        (W32, (vs, f:fs, ds, ls, ss))\n                            | not passFloatInXmm      -> k (RegisterParam f, (vs, fs, ds, ls, ss))\n                        (W64, (vs, fs, ds, ls, s:ss))\n                            | passFloatInXmm          -> k (RegisterParam (DoubleReg s), (vs, fs, ds, ls, ss))\n                        (W64, (vs, fs, d:ds, ls, ss))\n                            | not passFloatInXmm      -> k (RegisterParam d, (vs, fs, ds, ls, ss))\n                        (W80, _) -> panic \"F80 unsupported register type\"\n                        _ -> (assts, (r:rs))\n              int = case (w, regs) of\n                      (W128, _) -> panic \"W128 unsupported register type\"\n                      (_, (v:vs, fs, ds, ls, ss)) | widthInBits w <= widthInBits (wordWidth dflags)\n                          -> k (RegisterParam (v gcp), (vs, fs, ds, ls, ss))\n                      (_, (vs, fs, ds, l:ls, ss)) | widthInBits w > widthInBits (wordWidth dflags)\n                          -> k (RegisterParam l, (vs, fs, ds, ls, ss))\n                      _   -> (assts, (r:rs))\n              k (asst, regs') = assign_regs ((r, asst) : assts) rs regs'\n              ty = arg_ty r\n              w  = typeWidth ty\n              gcp | isGcPtrType ty = VGcPtr\n                  | otherwise      = VNonGcPtr\n              passFloatInXmm = passFloatArgsInXmm dflags\n\npassFloatArgsInXmm :: DynFlags -> Bool\npassFloatArgsInXmm dflags = case platformArch (targetPlatform dflags) of\n                              ArchX86_64 -> True\n                              _          -> False\n\n-- We used to spill vector registers to the stack since the LLVM backend didn't\n-- support vector registers in its calling convention. However, this has now\n-- been fixed. This function remains only as a convenient way to re-enable\n-- spilling when debugging code generation.\npassVectorInReg :: Width -> DynFlags -> Bool\npassVectorInReg _ _ = True\n\nassignStack :: DynFlags -> ByteOff -> (a -> CmmType) -> [a]\n            -> (\n                 ByteOff              -- bytes of stack args\n               , [(a, ParamLocation)] -- args and locations\n               )\nassignStack dflags offset arg_ty args = assign_stk offset [] (reverse args)\n where\n      assign_stk offset assts [] = (offset, assts)\n      assign_stk offset assts (r:rs)\n        = assign_stk off' ((r, StackParam off') : assts) rs\n        where w    = typeWidth (arg_ty r)\n              off' = offset + size\n              -- Stack arguments always take a whole number of words, we never\n              -- pack them unlike constructor fields.\n              size = roundUpToWords dflags (widthInBytes w)\n\n-----------------------------------------------------------------------------\n-- Local information about the registers available\n\ntype AvailRegs = ( [VGcPtr -> GlobalReg]   -- available vanilla regs.\n                 , [GlobalReg]   -- floats\n                 , [GlobalReg]   -- doubles\n                 , [GlobalReg]   -- longs (int64 and word64)\n                 , [Int]         -- XMM (floats and doubles)\n                 )\n\n-- Vanilla registers can contain pointers, Ints, Chars.\n-- Floats and doubles have separate register supplies.\n--\n-- We take these register supplies from the *real* registers, i.e. those\n-- that are guaranteed to map to machine registers.\n\ngetRegsWithoutNode, getRegsWithNode :: DynFlags -> AvailRegs\ngetRegsWithoutNode dflags =\n  ( filter (\\r -> r VGcPtr /= node) (realVanillaRegs dflags)\n  , realFloatRegs dflags\n  , realDoubleRegs dflags\n  , realLongRegs dflags\n  , realXmmRegNos dflags)\n\n-- getRegsWithNode uses R1/node even if it isn't a register\ngetRegsWithNode dflags =\n  ( if null (realVanillaRegs dflags)\n    then [VanillaReg 1]\n    else realVanillaRegs dflags\n  , realFloatRegs dflags\n  , realDoubleRegs dflags\n  , realLongRegs dflags\n  , realXmmRegNos dflags)\n\nallFloatRegs, allDoubleRegs, allLongRegs :: DynFlags -> [GlobalReg]\nallVanillaRegs :: DynFlags -> [VGcPtr -> GlobalReg]\nallXmmRegs :: DynFlags -> [Int]\n\nallVanillaRegs dflags = map VanillaReg $ regList (mAX_Vanilla_REG dflags)\nallFloatRegs   dflags = map FloatReg   $ regList (mAX_Float_REG   dflags)\nallDoubleRegs  dflags = map DoubleReg  $ regList (mAX_Double_REG  dflags)\nallLongRegs    dflags = map LongReg    $ regList (mAX_Long_REG    dflags)\nallXmmRegs     dflags =                  regList (mAX_XMM_REG     dflags)\n\nrealFloatRegs, realDoubleRegs, realLongRegs :: DynFlags -> [GlobalReg]\nrealVanillaRegs :: DynFlags -> [VGcPtr -> GlobalReg]\nrealXmmRegNos :: DynFlags -> [Int]\n\nrealVanillaRegs dflags = map VanillaReg $ regList (mAX_Real_Vanilla_REG dflags)\nrealFloatRegs   dflags = map FloatReg   $ regList (mAX_Real_Float_REG   dflags)\nrealDoubleRegs  dflags = map DoubleReg  $ regList (mAX_Real_Double_REG  dflags)\nrealLongRegs    dflags = map LongReg    $ regList (mAX_Real_Long_REG    dflags)\n\nrealXmmRegNos dflags\n    | isSse2Enabled dflags = regList (mAX_Real_XMM_REG     dflags)\n    | otherwise            = []\n\nregList :: Int -> [Int]\nregList n = [1 .. n]\n\nallRegs :: DynFlags -> AvailRegs\nallRegs dflags = (allVanillaRegs dflags,\n                  allFloatRegs dflags,\n                  allDoubleRegs dflags,\n                  allLongRegs dflags,\n                  allXmmRegs dflags)\n\nnodeOnly :: AvailRegs\nnodeOnly = ([VanillaReg 1], [], [], [], [])\n\n-- This returns the set of global registers that *cover* the machine registers\n-- used for argument passing. On platforms where registers can overlap---right\n-- now just x86-64, where Float and Double registers overlap---passing this set\n-- of registers is guaranteed to preserve the contents of all live registers. We\n-- only use this functionality in hand-written C-- code in the RTS.\nrealArgRegsCover :: DynFlags -> [GlobalReg]\nrealArgRegsCover dflags\n    | passFloatArgsInXmm dflags = map ($VGcPtr) (realVanillaRegs dflags) ++\n                                  realLongRegs dflags ++\n                                  map XmmReg (realXmmRegNos dflags)\n    | otherwise                 = map ($VGcPtr) (realVanillaRegs dflags) ++\n                                  realFloatRegs dflags ++\n                                  realDoubleRegs dflags ++\n                                  realLongRegs dflags ++\n                                  map XmmReg (realXmmRegNos dflags)\n", "num_lines": 213}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, BangPatterns, ScopedTypeVariables #-}\n\nmodule CmmCommonBlockElim\n  ( elimCommonBlocks\n  )\nwhere\n\n\nimport GhcPrelude hiding (iterate, succ, unzip, zip)\n\nimport BlockId\nimport Cmm\nimport CmmUtils\nimport CmmSwitch (eqSwitchTargetWith)\nimport CmmContFlowOpt\n-- import PprCmm ()\n\nimport Hoopl.Block\nimport Hoopl.Graph\nimport Hoopl.Label\nimport Hoopl.Collections\nimport Data.Bits\nimport Data.Maybe (mapMaybe)\nimport qualified Data.List as List\nimport Data.Word\nimport qualified Data.Map as M\nimport Outputable\nimport qualified TrieMap as TM\nimport UniqFM\nimport Unique\nimport Control.Arrow (first, second)\n\n-- -----------------------------------------------------------------------------\n-- Eliminate common blocks\n\n-- If two blocks are identical except for the label on the first node,\n-- then we can eliminate one of the blocks. To ensure that the semantics\n-- of the program are preserved, we have to rewrite each predecessor of the\n-- eliminated block to proceed with the block we keep.\n\n-- The algorithm iterates over the blocks in the graph,\n-- checking whether it has seen another block that is equal modulo labels.\n-- If so, then it adds an entry in a map indicating that the new block\n-- is made redundant by the old block.\n-- Otherwise, it is added to the useful blocks.\n\n-- To avoid comparing every block with every other block repeatedly, we group\n-- them by\n--   * a hash of the block, ignoring labels (explained below)\n--   * the list of outgoing labels\n-- The hash is invariant under relabeling, so we only ever compare within\n-- the same group of blocks.\n--\n-- The list of outgoing labels is updated as we merge blocks (that is why they\n-- are not included in the hash, which we want to calculate only once).\n--\n-- All in all, two blocks should never be compared if they have different\n-- hashes, and at most once otherwise. Previously, we were slower, and people\n-- rightfully complained: #10397\n\n-- TODO: Use optimization fuel\nelimCommonBlocks :: CmmGraph -> CmmGraph\nelimCommonBlocks g = replaceLabels env $ copyTicks env g\n  where\n     env = iterate mapEmpty blocks_with_key\n     -- The order of blocks doesn't matter here. While we could use\n     -- revPostorder which drops unreachable blocks this is done in\n     -- ContFlowOpt already which runs before this pass. So we use\n     -- toBlockList since it is faster.\n     groups = groupByInt hash_block (toBlockList g) :: [[CmmBlock]]\n     blocks_with_key = [ [ (successors b, [b]) | b <- bs] | bs <- groups]\n\n-- Invariant: The blocks in the list are pairwise distinct\n-- (so avoid comparing them again)\ntype DistinctBlocks = [CmmBlock]\ntype Key = [Label]\ntype Subst = LabelMap BlockId\n\n-- The outer list groups by hash. We retain this grouping throughout.\niterate :: Subst -> [[(Key, DistinctBlocks)]] -> Subst\niterate subst blocks\n    | mapNull new_substs = subst\n    | otherwise = iterate subst' updated_blocks\n  where\n    grouped_blocks :: [[(Key, [DistinctBlocks])]]\n    grouped_blocks = map groupByLabel blocks\n\n    merged_blocks :: [[(Key, DistinctBlocks)]]\n    (new_substs, merged_blocks) = List.mapAccumL (List.mapAccumL go) mapEmpty grouped_blocks\n      where\n        go !new_subst1 (k,dbs) = (new_subst1 `mapUnion` new_subst2, (k,db))\n          where\n            (new_subst2, db) = mergeBlockList subst dbs\n\n    subst' = subst `mapUnion` new_substs\n    updated_blocks = map (map (first (map (lookupBid subst')))) merged_blocks\n\n-- Combine two lists of blocks.\n-- While they are internally distinct they can still share common blocks.\nmergeBlocks :: Subst -> DistinctBlocks -> DistinctBlocks -> (Subst, DistinctBlocks)\nmergeBlocks subst existing new = go new\n  where\n    go [] = (mapEmpty, existing)\n    go (b:bs) = case List.find (eqBlockBodyWith (eqBid subst) b) existing of\n        -- This block is a duplicate. Drop it, and add it to the substitution\n        Just b' -> first (mapInsert (entryLabel b) (entryLabel b')) $ go bs\n        -- This block is not a duplicate, keep it.\n        Nothing -> second (b:) $ go bs\n\nmergeBlockList :: Subst -> [DistinctBlocks] -> (Subst, DistinctBlocks)\nmergeBlockList _ [] = pprPanic \"mergeBlockList\" empty\nmergeBlockList subst (b:bs) = go mapEmpty b bs\n  where\n    go !new_subst1 b [] = (new_subst1, b)\n    go !new_subst1 b1 (b2:bs) = go new_subst b bs\n      where\n        (new_subst2, b) =  mergeBlocks subst b1 b2\n        new_subst = new_subst1 `mapUnion` new_subst2\n\n\n-- -----------------------------------------------------------------------------\n-- Hashing and equality on blocks\n\n-- Below here is mostly boilerplate: hashing blocks ignoring labels,\n-- and comparing blocks modulo a label mapping.\n\n-- To speed up comparisons, we hash each basic block modulo jump labels.\n-- The hashing is a bit arbitrary (the numbers are completely arbitrary),\n-- but it should be fast and good enough.\n\n-- We want to get as many small buckets as possible, as comparing blocks is\n-- expensive. So include as much as possible in the hash. Ideally everything\n-- that is compared with (==) in eqBlockBodyWith.\n\ntype HashCode = Int\n\nhash_block :: CmmBlock -> HashCode\nhash_block block =\n  fromIntegral (foldBlockNodesB3 (hash_fst, hash_mid, hash_lst) block (0 :: Word32) .&. (0x7fffffff :: Word32))\n  -- UniqFM doesn't like negative Ints\n  where hash_fst _ h = h\n        hash_mid m h = hash_node m + h `shiftL` 1\n        hash_lst m h = hash_node m + h `shiftL` 1\n\n        hash_node :: CmmNode O x -> Word32\n        hash_node n | dont_care n = 0 -- don't care\n        hash_node (CmmAssign r e) = hash_reg r + hash_e e\n        hash_node (CmmStore e e') = hash_e e + hash_e e'\n        hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as\n        hash_node (CmmBranch _) = 23 -- NB. ignore the label\n        hash_node (CmmCondBranch p _ _ _) = hash_e p\n        hash_node (CmmCall e _ _ _ _ _) = hash_e e\n        hash_node (CmmForeignCall t _ _ _ _ _ _) = hash_tgt t\n        hash_node (CmmSwitch e _) = hash_e e\n        hash_node _ = error \"hash_node: unknown Cmm node!\"\n\n        hash_reg :: CmmReg -> Word32\n        hash_reg   (CmmLocal localReg) = hash_unique localReg -- important for performance, see #10397\n        hash_reg   (CmmGlobal _)    = 19\n\n        hash_e :: CmmExpr -> Word32\n        hash_e (CmmLit l) = hash_lit l\n        hash_e (CmmLoad e _) = 67 + hash_e e\n        hash_e (CmmReg r) = hash_reg r\n        hash_e (CmmMachOp _ es) = hash_list hash_e es -- pessimal - no operator check\n        hash_e (CmmRegOff r i) = hash_reg r + cvt i\n        hash_e (CmmStackSlot _ _) = 13\n\n        hash_lit :: CmmLit -> Word32\n        hash_lit (CmmInt i _) = fromInteger i\n        hash_lit (CmmFloat r _) = truncate r\n        hash_lit (CmmVec ls) = hash_list hash_lit ls\n        hash_lit (CmmLabel _) = 119 -- ugh\n        hash_lit (CmmLabelOff _ i) = cvt $ 199 + i\n        hash_lit (CmmLabelDiffOff _ _ i _) = cvt $ 299 + i\n        hash_lit (CmmBlock _) = 191 -- ugh\n        hash_lit (CmmHighStackMark) = cvt 313\n\n        hash_tgt (ForeignTarget e _) = hash_e e\n        hash_tgt (PrimTarget _) = 31 -- lots of these\n\n        hash_list f = foldl' (\\z x -> f x + z) (0::Word32)\n\n        cvt = fromInteger . toInteger\n\n        hash_unique :: Uniquable a => a -> Word32\n        hash_unique = cvt . getKey . getUnique\n\n-- | Ignore these node types for equality\ndont_care :: CmmNode O x -> Bool\ndont_care CmmComment {}  = True\ndont_care CmmTick {}     = True\ndont_care CmmUnwind {}   = True\ndont_care _other         = False\n\n-- Utilities: equality and substitution on the graph.\n\n-- Given a map ``subst'' from BlockID -> BlockID, we define equality.\neqBid :: LabelMap BlockId -> BlockId -> BlockId -> Bool\neqBid subst bid bid' = lookupBid subst bid == lookupBid subst bid'\nlookupBid :: LabelMap BlockId -> BlockId -> BlockId\nlookupBid subst bid = case mapLookup bid subst of\n                        Just bid  -> lookupBid subst bid\n                        Nothing -> bid\n\n-- Middle nodes and expressions can contain BlockIds, in particular in\n-- CmmStackSlot and CmmBlock, so we have to use a special equality for\n-- these.\n--\neqMiddleWith :: (BlockId -> BlockId -> Bool)\n             -> CmmNode O O -> CmmNode O O -> Bool\neqMiddleWith eqBid (CmmAssign r1 e1) (CmmAssign r2 e2)\n  = r1 == r2 && eqExprWith eqBid e1 e2\neqMiddleWith eqBid (CmmStore l1 r1) (CmmStore l2 r2)\n  = eqExprWith eqBid l1 l2 && eqExprWith eqBid r1 r2\neqMiddleWith eqBid (CmmUnsafeForeignCall t1 r1 a1)\n                   (CmmUnsafeForeignCall t2 r2 a2)\n  = t1 == t2 && r1 == r2 && eqListWith (eqExprWith eqBid) a1 a2\neqMiddleWith _ _ _ = False\n\neqExprWith :: (BlockId -> BlockId -> Bool)\n           -> CmmExpr -> CmmExpr -> Bool\neqExprWith eqBid = eq\n where\n  CmmLit l1          `eq` CmmLit l2          = eqLit l1 l2\n  CmmLoad e1 _       `eq` CmmLoad e2 _       = e1 `eq` e2\n  CmmReg r1          `eq` CmmReg r2          = r1==r2\n  CmmRegOff r1 i1    `eq` CmmRegOff r2 i2    = r1==r2 && i1==i2\n  CmmMachOp op1 es1  `eq` CmmMachOp op2 es2  = op1==op2 && es1 `eqs` es2\n  CmmStackSlot a1 i1 `eq` CmmStackSlot a2 i2 = eqArea a1 a2 && i1==i2\n  _e1                `eq` _e2                = False\n\n  xs `eqs` ys = eqListWith eq xs ys\n\n  eqLit (CmmBlock id1) (CmmBlock id2) = eqBid id1 id2\n  eqLit l1 l2 = l1 == l2\n\n  eqArea Old Old = True\n  eqArea (Young id1) (Young id2) = eqBid id1 id2\n  eqArea _ _ = False\n\n-- Equality on the body of a block, modulo a function mapping block\n-- IDs to block IDs.\neqBlockBodyWith :: (BlockId -> BlockId -> Bool) -> CmmBlock -> CmmBlock -> Bool\neqBlockBodyWith eqBid block block'\n  {-\n  | equal     = pprTrace \"equal\" (vcat [ppr block, ppr block']) True\n  | otherwise = pprTrace \"not equal\" (vcat [ppr block, ppr block']) False\n  -}\n  = equal\n  where (_,m,l)   = blockSplit block\n        nodes     = filter (not . dont_care) (blockToList m)\n        (_,m',l') = blockSplit block'\n        nodes'    = filter (not . dont_care) (blockToList m')\n\n        equal = eqListWith (eqMiddleWith eqBid) nodes nodes' &&\n                eqLastWith eqBid l l'\n\n\neqLastWith :: (BlockId -> BlockId -> Bool) -> CmmNode O C -> CmmNode O C -> Bool\neqLastWith eqBid (CmmBranch bid1) (CmmBranch bid2) = eqBid bid1 bid2\neqLastWith eqBid (CmmCondBranch c1 t1 f1 l1) (CmmCondBranch c2 t2 f2 l2) =\n  c1 == c2 && l1 == l2 && eqBid t1 t2 && eqBid f1 f2\neqLastWith eqBid (CmmCall t1 c1 g1 a1 r1 u1) (CmmCall t2 c2 g2 a2 r2 u2) =\n  t1 == t2 && eqMaybeWith eqBid c1 c2 && a1 == a2 && r1 == r2 && u1 == u2 && g1 == g2\neqLastWith eqBid (CmmSwitch e1 ids1) (CmmSwitch e2 ids2) =\n  e1 == e2 && eqSwitchTargetWith eqBid ids1 ids2\neqLastWith _ _ _ = False\n\neqMaybeWith :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool\neqMaybeWith eltEq (Just e) (Just e') = eltEq e e'\neqMaybeWith _ Nothing Nothing = True\neqMaybeWith _ _ _ = False\n\neqListWith :: (a -> b -> Bool) -> [a] -> [b] -> Bool\neqListWith f (a : as) (b : bs) = f a b && eqListWith f as bs\neqListWith _ []       []       = True\neqListWith _ _        _        = False\n\n-- | Given a block map, ensure that all \"target\" blocks are covered by\n-- the same ticks as the respective \"source\" blocks. This not only\n-- means copying ticks, but also adjusting tick scopes where\n-- necessary.\ncopyTicks :: LabelMap BlockId -> CmmGraph -> CmmGraph\ncopyTicks env g\n  | mapNull env = g\n  | otherwise   = ofBlockMap (g_entry g) $ mapMap copyTo blockMap\n  where -- Reverse block merge map\n        blockMap = toBlockMap g\n        revEnv = mapFoldlWithKey insertRev M.empty env\n        insertRev m k x = M.insertWith (const (k:)) x [k] m\n        -- Copy ticks and scopes into the given block\n        copyTo block = case M.lookup (entryLabel block) revEnv of\n          Nothing -> block\n          Just ls -> foldr copy block $ mapMaybe (flip mapLookup blockMap) ls\n        copy from to =\n          let ticks = blockTicks from\n              CmmEntry  _   scp0        = firstNode from\n              (CmmEntry lbl scp1, code) = blockSplitHead to\n          in CmmEntry lbl (combineTickScopes scp0 scp1) `blockJoinHead`\n             foldr blockCons code (map CmmTick ticks)\n\n-- Group by [Label]\n-- See Note [Compressed TrieMap] in coreSyn/TrieMap about the usage of GenMap.\ngroupByLabel :: [(Key, DistinctBlocks)] -> [(Key, [DistinctBlocks])]\ngroupByLabel =\n  go (TM.emptyTM :: TM.ListMap (TM.GenMap LabelMap) (Key, [DistinctBlocks]))\n    where\n      go !m [] = TM.foldTM (:) m []\n      go !m ((k,v) : entries) = go (TM.alterTM k adjust m) entries\n        where --k' = map (getKey . getUnique) k\n              adjust Nothing       = Just (k,[v])\n              adjust (Just (_,vs)) = Just (k,v:vs)\n\ngroupByInt :: (a -> Int) -> [a] -> [[a]]\ngroupByInt f xs = nonDetEltsUFM $ List.foldl' go emptyUFM xs\n   -- See Note [Unique Determinism and code generation]\n  where\n    go m x = alterUFM addEntry m (f x)\n      where\n        addEntry xs = Just $! maybe [x] (x:) xs\n", "num_lines": 322}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE BangPatterns #-}\n{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}\nmodule CmmContFlowOpt\n    ( cmmCfgOpts\n    , cmmCfgOptsProc\n    , removeUnreachableBlocksProc\n    , replaceLabels\n    )\nwhere\n\nimport GhcPrelude hiding (succ, unzip, zip)\n\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport Hoopl.Label\nimport BlockId\nimport Cmm\nimport CmmUtils\nimport CmmSwitch (mapSwitchTargets)\nimport Maybes\nimport Panic\nimport Util\n\nimport Control.Monad\n\n\n-- Note [What is shortcutting]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Consider this Cmm code:\n--\n-- L1: ...\n--     goto L2;\n-- L2: goto L3;\n-- L3: ...\n--\n-- Here L2 is an empty block and contains only an unconditional branch\n-- to L3. In this situation any block that jumps to L2 can jump\n-- directly to L3:\n--\n-- L1: ...\n--     goto L3;\n-- L2: goto L3;\n-- L3: ...\n--\n-- In this situation we say that we shortcut L2 to L3. One of\n-- consequences of shortcutting is that some blocks of code may become\n-- unreachable (in the example above this is true for L2).\n\n\n-- Note [Control-flow optimisations]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- This optimisation does three things:\n--\n--   - If a block finishes in an unconditional branch to another block\n--     and that is the only jump to that block we concatenate the\n--     destination block at the end of the current one.\n--\n--   - If a block finishes in a call whose continuation block is a\n--     goto, then we can shortcut the destination, making the\n--     continuation block the destination of the goto - but see Note\n--     [Shortcut call returns].\n--\n--   - For any block that is not a call we try to shortcut the\n--     destination(s). Additionally, if a block ends with a\n--     conditional branch we try to invert the condition.\n--\n-- Blocks are processed using postorder DFS traversal. A side effect\n-- of determining traversal order with a graph search is elimination\n-- of any blocks that are unreachable.\n--\n-- Transformations are improved by working from the end of the graph\n-- towards the beginning, because we may be able to perform many\n-- shortcuts in one go.\n\n\n-- Note [Shortcut call returns]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- We are going to maintain the \"current\" graph (LabelMap CmmBlock) as\n-- we go, and also a mapping from BlockId to BlockId, representing\n-- continuation labels that we have renamed.  This latter mapping is\n-- important because we might shortcut a CmmCall continuation.  For\n-- example:\n--\n--    Sp[0] = L\n--    call g returns to L\n--    L: goto M\n--    M: ...\n--\n-- So when we shortcut the L block, we need to replace not only\n-- the continuation of the call, but also references to L in the\n-- code (e.g. the assignment Sp[0] = L):\n--\n--    Sp[0] = M\n--    call g returns to M\n--    M: ...\n--\n-- So we keep track of which labels we have renamed and apply the mapping\n-- at the end with replaceLabels.\n\n\n-- Note [Shortcut call returns and proc-points]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Consider this code that you might get from a recursive\n-- let-no-escape:\n--\n--       goto L1\n--      L1:\n--       if (Hp > HpLim) then L2 else L3\n--      L2:\n--       call stg_gc_noregs returns to L4\n--      L4:\n--       goto L1\n--      L3:\n--       ...\n--       goto L1\n--\n-- Then the control-flow optimiser shortcuts L4.  But that turns L1\n-- into the call-return proc point, and every iteration of the loop\n-- has to shuffle variables to and from the stack.  So we must *not*\n-- shortcut L4.\n--\n-- Moreover not shortcutting call returns is probably fine.  If L4 can\n-- concat with its branch target then it will still do so.  And we\n-- save some compile time because we don't have to traverse all the\n-- code in replaceLabels.\n--\n-- However, we probably do want to do this if we are splitting proc\n-- points, because L1 will be a proc-point anyway, so merging it with\n-- L4 reduces the number of proc points.  Unfortunately recursive\n-- let-no-escapes won't generate very good code with proc-point\n-- splitting on - we should probably compile them to explicitly use\n-- the native calling convention instead.\n\ncmmCfgOpts :: Bool -> CmmGraph -> CmmGraph\ncmmCfgOpts split g = fst (blockConcat split g)\n\ncmmCfgOptsProc :: Bool -> CmmDecl -> CmmDecl\ncmmCfgOptsProc split (CmmProc info lbl live g) = CmmProc info' lbl live g'\n    where (g', env) = blockConcat split g\n          info' = info{ info_tbls = new_info_tbls }\n          new_info_tbls = mapFromList (map upd_info (mapToList (info_tbls info)))\n\n          -- If we changed any labels, then we have to update the info tables\n          -- too, except for the top-level info table because that might be\n          -- referred to by other procs.\n          upd_info (k,info)\n             | Just k' <- mapLookup k env\n             = (k', if k' == g_entry g'\n                       then info\n                       else info{ cit_lbl = infoTblLbl k' })\n             | otherwise\n             = (k,info)\ncmmCfgOptsProc _ top = top\n\n\nblockConcat :: Bool -> CmmGraph -> (CmmGraph, LabelMap BlockId)\nblockConcat splitting_procs g@CmmGraph { g_entry = entry_id }\n  = (replaceLabels shortcut_map $ ofBlockMap new_entry new_blocks, shortcut_map')\n  where\n     -- We might be able to shortcut the entry BlockId itself.\n     -- Remember to update the shortcut_map, since we also have to\n     -- update the info_tbls mapping now.\n     (new_entry, shortcut_map')\n       | Just entry_blk <- mapLookup entry_id new_blocks\n       , Just dest      <- canShortcut entry_blk\n       = (dest, mapInsert entry_id dest shortcut_map)\n       | otherwise\n       = (entry_id, shortcut_map)\n\n     -- blocks are sorted in reverse postorder, but we want to go from the exit\n     -- towards beginning, so we use foldr below.\n     blocks = revPostorder g\n     blockmap = foldl' (flip addBlock) emptyBody blocks\n\n     -- Accumulator contains three components:\n     --  * map of blocks in a graph\n     --  * map of shortcut labels. See Note [Shortcut call returns]\n     --  * map containing number of predecessors for each block. We discard\n     --    it after we process all blocks.\n     (new_blocks, shortcut_map, _) =\n           foldr maybe_concat (blockmap, mapEmpty, initialBackEdges) blocks\n\n     -- Map of predecessors for initial graph. We increase number of\n     -- predecessors for entry block by one to denote that it is\n     -- target of a jump, even if no block in the current graph jumps\n     -- to it.\n     initialBackEdges = incPreds entry_id (predMap blocks)\n\n     maybe_concat :: CmmBlock\n                  -> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int)\n                  -> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int)\n     maybe_concat block (!blocks, !shortcut_map, !backEdges)\n        -- If:\n        --   (1) current block ends with unconditional branch to b' and\n        --   (2) it has exactly one predecessor (namely, current block)\n        --\n        -- Then:\n        --   (1) append b' block at the end of current block\n        --   (2) remove b' from the map of blocks\n        --   (3) remove information about b' from predecessors map\n        --\n        -- Since we know that the block has only one predecessor we call\n        -- mapDelete directly instead of calling decPreds.\n        --\n        -- Note that we always maintain an up-to-date list of predecessors, so\n        -- we can ignore the contents of shortcut_map\n        | CmmBranch b' <- last\n        , hasOnePredecessor b'\n        , Just blk' <- mapLookup b' blocks\n        = let bid' = entryLabel blk'\n          in ( mapDelete bid' $ mapInsert bid (splice head blk') blocks\n             , shortcut_map\n             , mapDelete b' backEdges )\n\n        -- If:\n        --   (1) we are splitting proc points (see Note\n        --       [Shortcut call returns and proc-points]) and\n        --   (2) current block is a CmmCall or CmmForeignCall with\n        --       continuation b' and\n        --   (3) we can shortcut that continuation to dest\n        -- Then:\n        --   (1) we change continuation to point to b'\n        --   (2) create mapping from b' to dest\n        --   (3) increase number of predecessors of dest by 1\n        --   (4) decrease number of predecessors of b' by 1\n        --\n        -- Later we will use replaceLabels to substitute all occurrences of b'\n        -- with dest.\n        | splitting_procs\n        , Just b'   <- callContinuation_maybe last\n        , Just blk' <- mapLookup b' blocks\n        , Just dest <- canShortcut blk'\n        = ( mapInsert bid (blockJoinTail head (update_cont dest)) blocks\n          , mapInsert b' dest shortcut_map\n          , decPreds b' $ incPreds dest backEdges )\n\n        -- If:\n        --   (1) a block does not end with a call\n        -- Then:\n        --   (1) if it ends with a conditional attempt to invert the\n        --       conditional\n        --   (2) attempt to shortcut all destination blocks\n        --   (3) if new successors of a block are different from the old ones\n        --       update the of predecessors accordingly\n        --\n        -- A special case of this is a situation when a block ends with an\n        -- unconditional jump to a block that can be shortcut.\n        | Nothing <- callContinuation_maybe last\n        = let oldSuccs = successors last\n              newSuccs = successors rewrite_last\n          in ( mapInsert bid (blockJoinTail head rewrite_last) blocks\n             , shortcut_map\n             , if oldSuccs == newSuccs\n               then backEdges\n               else foldr incPreds (foldr decPreds backEdges oldSuccs) newSuccs )\n\n        -- Otherwise don't do anything\n        | otherwise\n        = ( blocks, shortcut_map, backEdges )\n        where\n          (head, last) = blockSplitTail block\n          bid = entryLabel block\n\n          -- Changes continuation of a call to a specified label\n          update_cont dest =\n              case last of\n                CmmCall{}        -> last { cml_cont = Just dest }\n                CmmForeignCall{} -> last { succ = dest }\n                _                -> panic \"Can't shortcut continuation.\"\n\n          -- Attempts to shortcut successors of last node\n          shortcut_last = mapSuccessors shortcut last\n            where\n              shortcut l =\n                 case mapLookup l blocks of\n                   Just b | Just dest <- canShortcut b -> dest\n                   _otherwise -> l\n\n          rewrite_last\n            -- Sometimes we can get rid of the conditional completely.\n            | CmmCondBranch _cond t f _l <- shortcut_last\n            , t == f\n            = CmmBranch t\n\n            -- See Note [Invert Cmm conditionals]\n            | CmmCondBranch cond t f l <- shortcut_last\n            , hasOnePredecessor t -- inverting will make t a fallthrough\n            , likelyTrue l || (numPreds f > 1)\n            , Just cond' <- maybeInvertCmmExpr cond\n            = CmmCondBranch cond' f t (invertLikeliness l)\n\n            | otherwise\n            = shortcut_last\n\n          likelyTrue (Just True)   = True\n          likelyTrue _             = False\n\n          invertLikeliness :: Maybe Bool -> Maybe Bool\n          invertLikeliness         = fmap not\n\n          -- Number of predecessors for a block\n          numPreds bid = mapLookup bid backEdges `orElse` 0\n\n          hasOnePredecessor b = numPreds b == 1\n\n{-\n  Note [Invert Cmm conditionals]\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  The native code generator always produces jumps to the true branch.\n  Falling through to the false branch is however faster. So we try to\n  arrange for that to happen.\n  This means we invert the condition if:\n  * The likely path will become a fallthrough.\n  * We can't guarantee a fallthrough for the false branch but for the\n    true branch.\n\n  In some cases it's faster to avoid inverting when the false branch is likely.\n  However determining when that is the case is neither easy nor cheap so for\n  now we always invert as this produces smaller binaries and code that is\n  equally fast on average. (On an i7-6700K)\n\n  TODO:\n  There is also the edge case when both branches have multiple predecessors.\n  In this case we could assume that we will end up with a jump for BOTH\n  branches. In this case it might be best to put the likely path in the true\n  branch especially if there are large numbers of predecessors as this saves\n  us the jump thats not taken. However I haven't tested this and as of early\n  2018 we almost never generate cmm where this would apply.\n-}\n\n-- Functions for incrementing and decrementing number of predecessors. If\n-- decrementing would set the predecessor count to 0, we remove entry from the\n-- map.\n-- Invariant: if a block has no predecessors it should be dropped from the\n-- graph because it is unreachable. maybe_concat is constructed to maintain\n-- that invariant, but calling replaceLabels may introduce unreachable blocks.\n-- We rely on subsequent passes in the Cmm pipeline to remove unreachable\n-- blocks.\nincPreds, decPreds :: BlockId -> LabelMap Int -> LabelMap Int\nincPreds bid edges = mapInsertWith (+) bid 1 edges\ndecPreds bid edges = case mapLookup bid edges of\n                       Just preds | preds > 1 -> mapInsert bid (preds - 1) edges\n                       Just _                 -> mapDelete bid edges\n                       _                      -> edges\n\n\n-- Checks if a block consists only of \"goto dest\". If it does than we return\n-- \"Just dest\" label. See Note [What is shortcutting]\ncanShortcut :: CmmBlock -> Maybe BlockId\ncanShortcut block\n    | (_, middle, CmmBranch dest) <- blockSplit block\n    , all dont_care $ blockToList middle\n    = Just dest\n    | otherwise\n    = Nothing\n    where dont_care CmmComment{} = True\n          dont_care CmmTick{}    = True\n          dont_care _other       = False\n\n-- Concatenates two blocks. First one is assumed to be open on exit, the second\n-- is assumed to be closed on entry (i.e. it has a label attached to it, which\n-- the splice function removes by calling snd on result of blockSplitHead).\nsplice :: Block CmmNode C O -> CmmBlock -> CmmBlock\nsplice head rest = entry `blockJoinHead` code0 `blockAppend` code1\n  where (CmmEntry lbl sc0, code0) = blockSplitHead head\n        (CmmEntry _   sc1, code1) = blockSplitHead rest\n        entry = CmmEntry lbl (combineTickScopes sc0 sc1)\n\n-- If node is a call with continuation call return Just label of that\n-- continuation. Otherwise return Nothing.\ncallContinuation_maybe :: CmmNode O C -> Maybe BlockId\ncallContinuation_maybe (CmmCall { cml_cont = Just b }) = Just b\ncallContinuation_maybe (CmmForeignCall { succ = b })   = Just b\ncallContinuation_maybe _ = Nothing\n\n\n-- Map over the CmmGraph, replacing each label with its mapping in the\n-- supplied LabelMap.\nreplaceLabels :: LabelMap BlockId -> CmmGraph -> CmmGraph\nreplaceLabels env g\n  | mapNull env = g\n  | otherwise   = replace_eid $ mapGraphNodes1 txnode g\n   where\n     replace_eid g = g {g_entry = lookup (g_entry g)}\n     lookup id = mapLookup id env `orElse` id\n\n     txnode :: CmmNode e x -> CmmNode e x\n     txnode (CmmBranch bid) = CmmBranch (lookup bid)\n     txnode (CmmCondBranch p t f l) =\n       mkCmmCondBranch (exp p) (lookup t) (lookup f) l\n     txnode (CmmSwitch e ids) =\n       CmmSwitch (exp e) (mapSwitchTargets lookup ids)\n     txnode (CmmCall t k rg a res r) =\n       CmmCall (exp t) (liftM lookup k) rg a res r\n     txnode fc@CmmForeignCall{} =\n       fc{ args = map exp (args fc), succ = lookup (succ fc) }\n     txnode other = mapExpDeep exp other\n\n     exp :: CmmExpr -> CmmExpr\n     exp (CmmLit (CmmBlock bid))                = CmmLit (CmmBlock (lookup bid))\n     exp (CmmStackSlot (Young id) i) = CmmStackSlot (Young (lookup id)) i\n     exp e                                      = e\n\nmkCmmCondBranch :: CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode O C\nmkCmmCondBranch p t f l =\n  if t == f then CmmBranch t else CmmCondBranch p t f l\n\n-- Build a map from a block to its set of predecessors.\npredMap :: [CmmBlock] -> LabelMap Int\npredMap blocks = foldr add_preds mapEmpty blocks\n  where\n    add_preds block env = foldr add env (successors block)\n      where add lbl env = mapInsertWith (+) lbl 1 env\n\n-- Removing unreachable blocks\nremoveUnreachableBlocksProc :: CmmDecl -> CmmDecl\nremoveUnreachableBlocksProc proc@(CmmProc info lbl live g)\n   | used_blocks `lengthLessThan` mapSize (toBlockMap g)\n   = CmmProc info' lbl live g'\n   | otherwise\n   = proc\n   where\n     g'    = ofBlockList (g_entry g) used_blocks\n     info' = info { info_tbls = keep_used (info_tbls info) }\n             -- Remove any info_tbls for unreachable\n\n     keep_used :: LabelMap CmmInfoTable -> LabelMap CmmInfoTable\n     keep_used bs = mapFoldlWithKey keep mapEmpty bs\n\n     keep :: LabelMap CmmInfoTable -> Label -> CmmInfoTable -> LabelMap CmmInfoTable\n     keep env l i | l `setMember` used_lbls = mapInsert l i env\n                  | otherwise               = env\n\n     used_blocks :: [CmmBlock]\n     used_blocks = revPostorder g\n\n     used_lbls :: LabelSet\n     used_lbls = setFromList $ map entryLabel used_blocks\n", "num_lines": 445}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule CmmExpr\n    ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr\n    , CmmReg(..), cmmRegType, cmmRegWidth\n    , CmmLit(..), cmmLitType\n    , LocalReg(..), localRegType\n    , GlobalReg(..), isArgReg, globalRegType\n    , spReg, hpReg, spLimReg, hpLimReg, nodeReg\n    , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg\n    , node, baseReg\n    , VGcPtr(..)\n\n    , DefinerOfRegs, UserOfRegs\n    , foldRegsDefd, foldRegsUsed\n    , foldLocalRegsDefd, foldLocalRegsUsed\n\n    , RegSet, LocalRegSet, GlobalRegSet\n    , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet\n    , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet\n    , regSetToList\n\n    , Area(..)\n    , module CmmMachOp\n    , module CmmType\n    )\nwhere\n\nimport GhcPrelude\n\nimport BlockId\nimport CLabel\nimport CmmMachOp\nimport CmmType\nimport DynFlags\nimport Outputable (panic)\nimport Unique\n\nimport Data.Set (Set)\nimport qualified Data.Set as Set\n\n-----------------------------------------------------------------------------\n--              CmmExpr\n-- An expression.  Expressions have no side effects.\n-----------------------------------------------------------------------------\n\ndata CmmExpr\n  = CmmLit CmmLit               -- Literal\n  | CmmLoad !CmmExpr !CmmType   -- Read memory location\n  | CmmReg !CmmReg              -- Contents of register\n  | CmmMachOp MachOp [CmmExpr]  -- Machine operation (+, -, *, etc.)\n  | CmmStackSlot Area {-# UNPACK #-} !Int\n                                -- addressing expression of a stack slot\n                                -- See Note [CmmStackSlot aliasing]\n  | CmmRegOff !CmmReg Int\n        -- CmmRegOff reg i\n        --        ** is shorthand only, meaning **\n        -- CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)]\n        --      where rep = typeWidth (cmmRegType reg)\n\ninstance Eq CmmExpr where       -- Equality ignores the types\n  CmmLit l1          == CmmLit l2          = l1==l2\n  CmmLoad e1 _       == CmmLoad e2 _       = e1==e2\n  CmmReg r1          == CmmReg r2          = r1==r2\n  CmmRegOff r1 i1    == CmmRegOff r2 i2    = r1==r2 && i1==i2\n  CmmMachOp op1 es1  == CmmMachOp op2 es2  = op1==op2 && es1==es2\n  CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2\n  _e1                == _e2                = False\n\ndata CmmReg\n  = CmmLocal  {-# UNPACK #-} !LocalReg\n  | CmmGlobal GlobalReg\n  deriving( Eq, Ord )\n\n-- | A stack area is either the stack slot where a variable is spilled\n-- or the stack space where function arguments and results are passed.\ndata Area\n  = Old            -- See Note [Old Area]\n  | Young {-# UNPACK #-} !BlockId  -- Invariant: must be a continuation BlockId\n                   -- See Note [Continuation BlockId] in CmmNode.\n  deriving (Eq, Ord)\n\n{- Note [Old Area]\n~~~~~~~~~~~~~~~~~~\nThere is a single call area 'Old', allocated at the extreme old\nend of the stack frame (ie just younger than the return address)\nwhich holds:\n  * incoming (overflow) parameters,\n  * outgoing (overflow) parameter to tail calls,\n  * outgoing (overflow) result values\n  * the update frame (if any)\n\nIts size is the max of all these requirements.  On entry, the stack\npointer will point to the youngest incoming parameter, which is not\nnecessarily at the young end of the Old area.\n\nEnd of note -}\n\n\n{- Note [CmmStackSlot aliasing]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen do two CmmStackSlots alias?\n\n - T[old+N] aliases with U[young(L)+M] for all T, U, L, N and M\n - T[old+N] aliases with U[old+M] only if the areas actually overlap\n\nOr more informally, different Areas may overlap with each other.\n\nAn alternative semantics, that we previously had, was that different\nAreas do not overlap.  The problem that lead to redefining the\nsemantics of stack areas is described below.\n\ne.g. if we had\n\n    x = Sp[old + 8]\n    y = Sp[old + 16]\n\n    Sp[young(L) + 8]  = L\n    Sp[young(L) + 16] = y\n    Sp[young(L) + 24] = x\n    call f() returns to L\n\nif areas semantically do not overlap, then we might optimise this to\n\n    Sp[young(L) + 8]  = L\n    Sp[young(L) + 16] = Sp[old + 8]\n    Sp[young(L) + 24] = Sp[old + 16]\n    call f() returns to L\n\nand now young(L) cannot be allocated at the same place as old, and we\nare doomed to use more stack.\n\n  - old+8  conflicts with young(L)+8\n  - old+16 conflicts with young(L)+16 and young(L)+8\n\nso young(L)+8 == old+24 and we get\n\n    Sp[-8]  = L\n    Sp[-16] = Sp[8]\n    Sp[-24] = Sp[0]\n    Sp -= 24\n    call f() returns to L\n\nHowever, if areas are defined to be \"possibly overlapping\" in the\nsemantics, then we cannot commute any loads/stores of old with\nyoung(L), and we will be able to re-use both old+8 and old+16 for\nyoung(L).\n\n    x = Sp[8]\n    y = Sp[0]\n\n    Sp[8] = L\n    Sp[0] = y\n    Sp[-8] = x\n    Sp = Sp - 8\n    call f() returns to L\n\nNow, the assignments of y go away,\n\n    x = Sp[8]\n    Sp[8] = L\n    Sp[-8] = x\n    Sp = Sp - 8\n    call f() returns to L\n-}\n\ndata CmmLit\n  = CmmInt !Integer  Width\n        -- Interpretation: the 2's complement representation of the value\n        -- is truncated to the specified size.  This is easier than trying\n        -- to keep the value within range, because we don't know whether\n        -- it will be used as a signed or unsigned value (the CmmType doesn't\n        -- distinguish between signed & unsigned).\n  | CmmFloat  Rational Width\n  | CmmVec [CmmLit]                     -- Vector literal\n  | CmmLabel    CLabel                  -- Address of label\n  | CmmLabelOff CLabel Int              -- Address of label + byte offset\n\n        -- Due to limitations in the C backend, the following\n        -- MUST ONLY be used inside the info table indicated by label2\n        -- (label2 must be the info label), and label1 must be an\n        -- SRT, a slow entrypoint or a large bitmap (see the Mangler)\n        -- Don't use it at all unless tablesNextToCode.\n        -- It is also used inside the NCG during when generating\n        -- position-independent code.\n  | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset\n        -- In an expression, the width just has the effect of MO_SS_Conv\n        -- from wordWidth to the desired width.\n        --\n        -- In a static literal, the supported Widths depend on the\n        -- architecture: wordWidth is supported on all\n        -- architectures. Additionally W32 is supported on x86_64 when\n        -- using the small memory model.\n\n  | CmmBlock {-# UNPACK #-} !BlockId     -- Code label\n        -- Invariant: must be a continuation BlockId\n        -- See Note [Continuation BlockId] in CmmNode.\n\n  | CmmHighStackMark -- A late-bound constant that stands for the max\n                     -- #bytes of stack space used during a procedure.\n                     -- During the stack-layout pass, CmmHighStackMark\n                     -- is replaced by a CmmInt for the actual number\n                     -- of bytes used\n  deriving Eq\n\ncmmExprType :: DynFlags -> CmmExpr -> CmmType\ncmmExprType dflags (CmmLit lit)        = cmmLitType dflags lit\ncmmExprType _      (CmmLoad _ rep)     = rep\ncmmExprType dflags (CmmReg reg)        = cmmRegType dflags reg\ncmmExprType dflags (CmmMachOp op args) = machOpResultType dflags op (map (cmmExprType dflags) args)\ncmmExprType dflags (CmmRegOff reg _)   = cmmRegType dflags reg\ncmmExprType dflags (CmmStackSlot _ _)  = bWord dflags -- an address\n-- Careful though: what is stored at the stack slot may be bigger than\n-- an address\n\ncmmLitType :: DynFlags -> CmmLit -> CmmType\ncmmLitType _      (CmmInt _ width)     = cmmBits  width\ncmmLitType _      (CmmFloat _ width)   = cmmFloat width\ncmmLitType _      (CmmVec [])          = panic \"cmmLitType: CmmVec []\"\ncmmLitType cflags (CmmVec (l:ls))      = let ty = cmmLitType cflags l\n                                         in if all (`cmmEqType` ty) (map (cmmLitType cflags) ls)\n                                            then cmmVec (1+length ls) ty\n                                            else panic \"cmmLitType: CmmVec\"\ncmmLitType dflags (CmmLabel lbl)       = cmmLabelType dflags lbl\ncmmLitType dflags (CmmLabelOff lbl _)  = cmmLabelType dflags lbl\ncmmLitType _      (CmmLabelDiffOff _ _ _ width) = cmmBits width\ncmmLitType dflags (CmmBlock _)         = bWord dflags\ncmmLitType dflags (CmmHighStackMark)   = bWord dflags\n\ncmmLabelType :: DynFlags -> CLabel -> CmmType\ncmmLabelType dflags lbl\n | isGcPtrLabel lbl = gcWord dflags\n | otherwise        = bWord dflags\n\ncmmExprWidth :: DynFlags -> CmmExpr -> Width\ncmmExprWidth dflags e = typeWidth (cmmExprType dflags e)\n\n--------\n--- Negation for conditional branches\n\nmaybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr\nmaybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op\n                                            return (CmmMachOp op' args)\nmaybeInvertCmmExpr _ = Nothing\n\n-----------------------------------------------------------------------------\n--              Local registers\n-----------------------------------------------------------------------------\n\ndata LocalReg\n  = LocalReg {-# UNPACK #-} !Unique CmmType\n    -- ^ Parameters:\n    --   1. Identifier\n    --   2. Type\n\ninstance Eq LocalReg where\n  (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2\n\n-- This is non-deterministic but we do not currently support deterministic\n-- code-generation. See Note [Unique Determinism and code generation]\n-- See Note [No Ord for Unique]\ninstance Ord LocalReg where\n  compare (LocalReg u1 _) (LocalReg u2 _) = nonDetCmpUnique u1 u2\n\ninstance Uniquable LocalReg where\n  getUnique (LocalReg uniq _) = uniq\n\ncmmRegType :: DynFlags -> CmmReg -> CmmType\ncmmRegType _      (CmmLocal  reg) = localRegType reg\ncmmRegType dflags (CmmGlobal reg) = globalRegType dflags reg\n\ncmmRegWidth :: DynFlags -> CmmReg -> Width\ncmmRegWidth dflags = typeWidth . cmmRegType dflags\n\nlocalRegType :: LocalReg -> CmmType\nlocalRegType (LocalReg _ rep) = rep\n\n-----------------------------------------------------------------------------\n--    Register-use information for expressions and other types\n-----------------------------------------------------------------------------\n\n-- | Sets of registers\n\n-- These are used for dataflow facts, and a common operation is taking\n-- the union of two RegSets and then asking whether the union is the\n-- same as one of the inputs.  UniqSet isn't good here, because\n-- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary\n-- Sets.\n\ntype RegSet r     = Set r\ntype LocalRegSet  = RegSet LocalReg\ntype GlobalRegSet = RegSet GlobalReg\n\nemptyRegSet             :: RegSet r\nnullRegSet              :: RegSet r -> Bool\nelemRegSet              :: Ord r => r -> RegSet r -> Bool\nextendRegSet            :: Ord r => RegSet r -> r -> RegSet r\ndeleteFromRegSet        :: Ord r => RegSet r -> r -> RegSet r\nmkRegSet                :: Ord r => [r] -> RegSet r\nminusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r\nsizeRegSet              :: RegSet r -> Int\nregSetToList            :: RegSet r -> [r]\n\nemptyRegSet      = Set.empty\nnullRegSet       = Set.null\nelemRegSet       = Set.member\nextendRegSet     = flip Set.insert\ndeleteFromRegSet = flip Set.delete\nmkRegSet         = Set.fromList\nminusRegSet      = Set.difference\nplusRegSet       = Set.union\ntimesRegSet      = Set.intersection\nsizeRegSet       = Set.size\nregSetToList     = Set.toList\n\nclass Ord r => UserOfRegs r a where\n  foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b\n\nfoldLocalRegsUsed :: UserOfRegs LocalReg a\n                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b\nfoldLocalRegsUsed = foldRegsUsed\n\nclass Ord r => DefinerOfRegs r a where\n  foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b\n\nfoldLocalRegsDefd :: DefinerOfRegs LocalReg a\n                  => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b\nfoldLocalRegsDefd = foldRegsDefd\n\ninstance UserOfRegs LocalReg CmmReg where\n    foldRegsUsed _ f z (CmmLocal reg) = f z reg\n    foldRegsUsed _ _ z (CmmGlobal _)  = z\n\ninstance DefinerOfRegs LocalReg CmmReg where\n    foldRegsDefd _ f z (CmmLocal reg) = f z reg\n    foldRegsDefd _ _ z (CmmGlobal _)  = z\n\ninstance UserOfRegs GlobalReg CmmReg where\n    foldRegsUsed _ _ z (CmmLocal _)    = z\n    foldRegsUsed _ f z (CmmGlobal reg) = f z reg\n\ninstance DefinerOfRegs GlobalReg CmmReg where\n    foldRegsDefd _ _ z (CmmLocal _)    = z\n    foldRegsDefd _ f z (CmmGlobal reg) = f z reg\n\ninstance Ord r => UserOfRegs r r where\n    foldRegsUsed _ f z r = f z r\n\ninstance Ord r => DefinerOfRegs r r where\n    foldRegsDefd _ f z r = f z r\n\ninstance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where\n  -- The (Ord r) in the context is necessary here\n  -- See Note [Recursive superclasses] in TcInstDcls\n  foldRegsUsed dflags f !z e = expr z e\n    where expr z (CmmLit _)          = z\n          expr z (CmmLoad addr _)    = foldRegsUsed dflags f z addr\n          expr z (CmmReg r)          = foldRegsUsed dflags f z r\n          expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs\n          expr z (CmmRegOff r _)     = foldRegsUsed dflags f z r\n          expr z (CmmStackSlot _ _)  = z\n\ninstance UserOfRegs r a => UserOfRegs r [a] where\n  foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as\n  {-# INLINABLE foldRegsUsed #-}\n\ninstance DefinerOfRegs r a => DefinerOfRegs r [a] where\n  foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as\n  {-# INLINABLE foldRegsDefd #-}\n\n-----------------------------------------------------------------------------\n--              Global STG registers\n-----------------------------------------------------------------------------\n\ndata VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )\n\n-----------------------------------------------------------------------------\n--              Global STG registers\n-----------------------------------------------------------------------------\n{-\nNote [Overlapping global registers]\n\nThe backend might not faithfully implement the abstraction of the STG\nmachine with independent registers for different values of type\nGlobalReg. Specifically, certain pairs of registers (r1, r2) may\noverlap in the sense that a store to r1 invalidates the value in r2,\nand vice versa.\n\nCurrently this occurs only on the x86_64 architecture where FloatReg n\nand DoubleReg n are assigned the same microarchitectural register, in\norder to allow functions to receive more Float# or Double# arguments\nin registers (as opposed to on the stack).\n\nThere are no specific rules about which registers might overlap with\nwhich other registers, but presumably it's safe to assume that nothing\nwill overlap with special registers like Sp or BaseReg.\n\nUse CmmUtils.regsOverlap to determine whether two GlobalRegs overlap\non a particular platform. The instance Eq GlobalReg is syntactic\nequality of STG registers and does not take overlap into\naccount. However it is still used in UserOfRegs/DefinerOfRegs and\nthere are likely still bugs there, beware!\n-}\n\ndata GlobalReg\n  -- Argument and return registers\n  = VanillaReg                  -- pointers, unboxed ints and chars\n        {-# UNPACK #-} !Int     -- its number\n        VGcPtr\n\n  | FloatReg            -- single-precision floating-point registers\n        {-# UNPACK #-} !Int     -- its number\n\n  | DoubleReg           -- double-precision floating-point registers\n        {-# UNPACK #-} !Int     -- its number\n\n  | LongReg             -- long int registers (64-bit, really)\n        {-# UNPACK #-} !Int     -- its number\n\n  | XmmReg                      -- 128-bit SIMD vector register\n        {-# UNPACK #-} !Int     -- its number\n\n  | YmmReg                      -- 256-bit SIMD vector register\n        {-# UNPACK #-} !Int     -- its number\n\n  | ZmmReg                      -- 512-bit SIMD vector register\n        {-# UNPACK #-} !Int     -- its number\n\n  -- STG registers\n  | Sp                  -- Stack ptr; points to last occupied stack location.\n  | SpLim               -- Stack limit\n  | Hp                  -- Heap ptr; points to last occupied heap location.\n  | HpLim               -- Heap limit register\n  | CCCS                -- Current cost-centre stack\n  | CurrentTSO          -- pointer to current thread's TSO\n  | CurrentNursery      -- pointer to allocation area\n  | HpAlloc             -- allocation count for heap check failure\n\n                -- We keep the address of some commonly-called\n                -- functions in the register table, to keep code\n                -- size down:\n  | EagerBlackholeInfo  -- stg_EAGER_BLACKHOLE_info\n  | GCEnter1            -- stg_gc_enter_1\n  | GCFun               -- stg_gc_fun\n\n  -- Base offset for the register table, used for accessing registers\n  -- which do not have real registers assigned to them.  This register\n  -- will only appear after we have expanded GlobalReg into memory accesses\n  -- (where necessary) in the native code generator.\n  | BaseReg\n\n  -- The register used by the platform for the C stack pointer. This is\n  -- a break in the STG abstraction used exclusively to setup stack unwinding\n  -- information.\n  | MachSp\n\n  -- The is a dummy register used to indicate to the stack unwinder where\n  -- a routine would return to.\n  | UnwindReturnReg\n\n  -- Base Register for PIC (position-independent code) calculations\n  -- Only used inside the native code generator. It's exact meaning differs\n  -- from platform to platform (see module PositionIndependentCode).\n  | PicBaseReg\n\n  deriving( Show )\n\ninstance Eq GlobalReg where\n   VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes\n   FloatReg i == FloatReg j = i==j\n   DoubleReg i == DoubleReg j = i==j\n   LongReg i == LongReg j = i==j\n   XmmReg i == XmmReg j = i==j\n   YmmReg i == YmmReg j = i==j\n   ZmmReg i == ZmmReg j = i==j\n   Sp == Sp = True\n   SpLim == SpLim = True\n   Hp == Hp = True\n   HpLim == HpLim = True\n   CCCS == CCCS = True\n   CurrentTSO == CurrentTSO = True\n   CurrentNursery == CurrentNursery = True\n   HpAlloc == HpAlloc = True\n   EagerBlackholeInfo == EagerBlackholeInfo = True\n   GCEnter1 == GCEnter1 = True\n   GCFun == GCFun = True\n   BaseReg == BaseReg = True\n   MachSp == MachSp = True\n   UnwindReturnReg == UnwindReturnReg = True\n   PicBaseReg == PicBaseReg = True\n   _r1 == _r2 = False\n\ninstance Ord GlobalReg where\n   compare (VanillaReg i _) (VanillaReg j _) = compare i j\n     -- Ignore type when seeking clashes\n   compare (FloatReg i)  (FloatReg  j) = compare i j\n   compare (DoubleReg i) (DoubleReg j) = compare i j\n   compare (LongReg i)   (LongReg   j) = compare i j\n   compare (XmmReg i)    (XmmReg    j) = compare i j\n   compare (YmmReg i)    (YmmReg    j) = compare i j\n   compare (ZmmReg i)    (ZmmReg    j) = compare i j\n   compare Sp Sp = EQ\n   compare SpLim SpLim = EQ\n   compare Hp Hp = EQ\n   compare HpLim HpLim = EQ\n   compare CCCS CCCS = EQ\n   compare CurrentTSO CurrentTSO = EQ\n   compare CurrentNursery CurrentNursery = EQ\n   compare HpAlloc HpAlloc = EQ\n   compare EagerBlackholeInfo EagerBlackholeInfo = EQ\n   compare GCEnter1 GCEnter1 = EQ\n   compare GCFun GCFun = EQ\n   compare BaseReg BaseReg = EQ\n   compare MachSp MachSp = EQ\n   compare UnwindReturnReg UnwindReturnReg = EQ\n   compare PicBaseReg PicBaseReg = EQ\n   compare (VanillaReg _ _) _ = LT\n   compare _ (VanillaReg _ _) = GT\n   compare (FloatReg _) _     = LT\n   compare _ (FloatReg _)     = GT\n   compare (DoubleReg _) _    = LT\n   compare _ (DoubleReg _)    = GT\n   compare (LongReg _) _      = LT\n   compare _ (LongReg _)      = GT\n   compare (XmmReg _) _       = LT\n   compare _ (XmmReg _)       = GT\n   compare (YmmReg _) _       = LT\n   compare _ (YmmReg _)       = GT\n   compare (ZmmReg _) _       = LT\n   compare _ (ZmmReg _)       = GT\n   compare Sp _ = LT\n   compare _ Sp = GT\n   compare SpLim _ = LT\n   compare _ SpLim = GT\n   compare Hp _ = LT\n   compare _ Hp = GT\n   compare HpLim _ = LT\n   compare _ HpLim = GT\n   compare CCCS _ = LT\n   compare _ CCCS = GT\n   compare CurrentTSO _ = LT\n   compare _ CurrentTSO = GT\n   compare CurrentNursery _ = LT\n   compare _ CurrentNursery = GT\n   compare HpAlloc _ = LT\n   compare _ HpAlloc = GT\n   compare GCEnter1 _ = LT\n   compare _ GCEnter1 = GT\n   compare GCFun _ = LT\n   compare _ GCFun = GT\n   compare BaseReg _ = LT\n   compare _ BaseReg = GT\n   compare MachSp _ = LT\n   compare _ MachSp = GT\n   compare UnwindReturnReg _ = LT\n   compare _ UnwindReturnReg = GT\n   compare EagerBlackholeInfo _ = LT\n   compare _ EagerBlackholeInfo = GT\n\n-- convenient aliases\nbaseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,\n  currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg  :: CmmReg\nbaseReg = CmmGlobal BaseReg\nspReg = CmmGlobal Sp\nhpReg = CmmGlobal Hp\nhpLimReg = CmmGlobal HpLim\nspLimReg = CmmGlobal SpLim\nnodeReg = CmmGlobal node\ncurrentTSOReg = CmmGlobal CurrentTSO\ncurrentNurseryReg = CmmGlobal CurrentNursery\nhpAllocReg = CmmGlobal HpAlloc\ncccsReg = CmmGlobal CCCS\n\nnode :: GlobalReg\nnode = VanillaReg 1 VGcPtr\n\nglobalRegType :: DynFlags -> GlobalReg -> CmmType\nglobalRegType dflags (VanillaReg _ VGcPtr)    = gcWord dflags\nglobalRegType dflags (VanillaReg _ VNonGcPtr) = bWord dflags\nglobalRegType _      (FloatReg _)      = cmmFloat W32\nglobalRegType _      (DoubleReg _)     = cmmFloat W64\nglobalRegType _      (LongReg _)       = cmmBits W64\nglobalRegType _      (XmmReg _)        = cmmVec 4 (cmmBits W32)\nglobalRegType _      (YmmReg _)        = cmmVec 8 (cmmBits W32)\nglobalRegType _      (ZmmReg _)        = cmmVec 16 (cmmBits W32)\n\nglobalRegType dflags Hp                = gcWord dflags\n                                            -- The initialiser for all\n                                            -- dynamically allocated closures\nglobalRegType dflags _                 = bWord dflags\n\nisArgReg :: GlobalReg -> Bool\nisArgReg (VanillaReg {}) = True\nisArgReg (FloatReg {})   = True\nisArgReg (DoubleReg {})  = True\nisArgReg (LongReg {})    = True\nisArgReg (XmmReg {})     = True\nisArgReg (YmmReg {})     = True\nisArgReg (ZmmReg {})     = True\nisArgReg _               = False\n", "num_lines": 605}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule CmmImplementSwitchPlans\n  ( cmmImplementSwitchPlans\n  )\nwhere\n\nimport GhcPrelude\n\nimport Hoopl.Block\nimport BlockId\nimport Cmm\nimport CmmUtils\nimport CmmSwitch\nimport UniqSupply\nimport DynFlags\n\n--\n-- This module replaces Switch statements as generated by the Stg -> Cmm\n-- transformation, which might be huge and sparse and hence unsuitable for\n-- assembly code, by proper constructs (if-then-else trees, dense jump tables).\n--\n-- The actual, abstract strategy is determined by createSwitchPlan in\n-- CmmSwitch and returned as a SwitchPlan; here is just the implementation in\n-- terms of Cmm code. See Note [Cmm Switches, the general plan] in CmmSwitch.\n--\n-- This division into different modules is both to clearly separate concerns,\n-- but also because createSwitchPlan needs access to the constructors of\n-- SwitchTargets, a data type exported abstractly by CmmSwitch.\n--\n\n-- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for\n-- code generation.\ncmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph\ncmmImplementSwitchPlans dflags g\n    | targetSupportsSwitch (hscTarget dflags) = return g\n    | otherwise = do\n    blocks' <- concat `fmap` mapM (visitSwitches dflags) (toBlockList g)\n    return $ ofBlockList (g_entry g) blocks'\n\nvisitSwitches :: DynFlags -> CmmBlock -> UniqSM [CmmBlock]\nvisitSwitches dflags block\n  | (entry@(CmmEntry _ scope), middle, CmmSwitch expr ids) <- blockSplit block\n  = do\n    let plan = createSwitchPlan ids\n\n    (newTail, newBlocks) <- implementSwitchPlan dflags scope expr plan\n\n    let block' = entry `blockJoinHead` middle `blockAppend` newTail\n\n    return $ block' : newBlocks\n\n  | otherwise\n  = return [block]\n\n\n-- Implementing a switch plan (returning a tail block)\nimplementSwitchPlan :: DynFlags -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqSM (Block CmmNode O C, [CmmBlock])\nimplementSwitchPlan dflags scope expr = go\n  where\n    go (Unconditionally l)\n      = return (emptyBlock `blockJoinTail` CmmBranch l, [])\n    go (JumpTable ids)\n      = return (emptyBlock `blockJoinTail` CmmSwitch expr ids, [])\n    go (IfLT signed i ids1 ids2)\n      = do\n        (bid1, newBlocks1) <- go' ids1\n        (bid2, newBlocks2) <- go' ids2\n\n        let lt | signed    = cmmSLtWord\n               | otherwise = cmmULtWord\n            scrut = lt dflags expr $ CmmLit $ mkWordCLit dflags i\n            lastNode = CmmCondBranch scrut bid1 bid2 Nothing\n            lastBlock = emptyBlock `blockJoinTail` lastNode\n        return (lastBlock, newBlocks1++newBlocks2)\n    go (IfEqual i l ids2)\n      = do\n        (bid2, newBlocks2) <- go' ids2\n\n        let scrut = cmmNeWord dflags expr $ CmmLit $ mkWordCLit dflags i\n            lastNode = CmmCondBranch scrut bid2 l Nothing\n            lastBlock = emptyBlock `blockJoinTail` lastNode\n        return (lastBlock, newBlocks2)\n\n    -- Same but returning a label to branch to\n    go' (Unconditionally l)\n      = return (l, [])\n    go' p\n      = do\n        bid <- mkBlockId `fmap` getUniqueM\n        (last, newBlocks) <- go p\n        let block = CmmEntry bid scope `blockJoinHead` last\n        return (bid, block: newBlocks)\n", "num_lines": 93}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule CmmInfo (\n  mkEmptyContInfoTable,\n  cmmToRawCmm,\n  mkInfoTable,\n  srtEscape,\n\n  -- info table accessors\n  closureInfoPtr,\n  entryCode,\n  getConstrTag,\n  cmmGetClosureType,\n  infoTable,\n  infoTableConstrTag,\n  infoTableSrtBitmap,\n  infoTableClosureType,\n  infoTablePtrs,\n  infoTableNonPtrs,\n  funInfoTable,\n  funInfoArity,\n\n  -- info table sizes and offsets\n  stdInfoTableSizeW,\n  fixedInfoTableSizeW,\n  profInfoTableSizeW,\n  maxStdInfoTableSizeW,\n  maxRetInfoTableSizeW,\n  stdInfoTableSizeB,\n  conInfoTableSizeB,\n  stdSrtBitmapOffset,\n  stdClosureTypeOffset,\n  stdPtrsOffset, stdNonPtrsOffset,\n) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Cmm\nimport CmmUtils\nimport CLabel\nimport SMRep\nimport Bitmap\nimport Stream (Stream)\nimport qualified Stream\nimport Hoopl.Collections\n\nimport Platform\nimport Maybes\nimport DynFlags\nimport Panic\nimport UniqSupply\nimport MonadUtils\nimport Util\nimport Outputable\n\nimport Data.ByteString (ByteString)\nimport Data.Bits\n\n-- When we split at proc points, we need an empty info table.\nmkEmptyContInfoTable :: CLabel -> CmmInfoTable\nmkEmptyContInfoTable info_lbl\n  = CmmInfoTable { cit_lbl  = info_lbl\n                 , cit_rep  = mkStackRep []\n                 , cit_prof = NoProfilingInfo\n                 , cit_srt  = Nothing\n                 , cit_clo  = Nothing }\n\ncmmToRawCmm :: DynFlags -> Stream IO CmmGroup ()\n            -> IO (Stream IO RawCmmGroup ())\ncmmToRawCmm dflags cmms\n  = do { uniqs <- mkSplitUniqSupply 'i'\n       ; let do_one uniqs cmm = do\n                case initUs uniqs $ concatMapM (mkInfoTable dflags) cmm of\n                  (b,uniqs') -> return (uniqs',b)\n                  -- NB. strictness fixes a space leak.  DO NOT REMOVE.\n       ; return (Stream.mapAccumL do_one uniqs cmms >> return ())\n       }\n\n-- Make a concrete info table, represented as a list of CmmStatic\n-- (it can't be simply a list of Word, because the SRT field is\n-- represented by a label+offset expression).\n--\n-- With tablesNextToCode, the layout is\n--      <reversed variable part>\n--      <normal forward StgInfoTable, but without\n--              an entry point at the front>\n--      <code>\n--\n-- Without tablesNextToCode, the layout of an info table is\n--      <entry label>\n--      <normal forward rest of StgInfoTable>\n--      <forward variable part>\n--\n--      See includes/rts/storage/InfoTables.h\n--\n-- For return-points these are as follows\n--\n-- Tables next to code:\n--\n--                      <srt slot>\n--                      <standard info table>\n--      ret-addr -->    <entry code (if any)>\n--\n-- Not tables-next-to-code:\n--\n--      ret-addr -->    <ptr to entry code>\n--                      <standard info table>\n--                      <srt slot>\n--\n--  * The SRT slot is only there if there is SRT info to record\n\nmkInfoTable :: DynFlags -> CmmDecl -> UniqSM [RawCmmDecl]\nmkInfoTable _ (CmmData sec dat)\n  = return [CmmData sec dat]\n\nmkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)\n  --\n  -- in the non-tables-next-to-code case, procs can have at most a\n  -- single info table associated with the entry label of the proc.\n  --\n  | not (tablesNextToCode dflags)\n  = case topInfoTable proc of   --  must be at most one\n      -- no info table\n      Nothing ->\n         return [CmmProc mapEmpty entry_lbl live blocks]\n\n      Just info@CmmInfoTable { cit_lbl = info_lbl } -> do\n        (top_decls, (std_info, extra_bits)) <-\n             mkInfoTableContents dflags info Nothing\n        let\n          rel_std_info   = map (makeRelativeRefTo dflags info_lbl) std_info\n          rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits\n        --\n        -- Separately emit info table (with the function entry\n        -- point as first entry) and the entry code\n        --\n        return (top_decls ++\n                [CmmProc mapEmpty entry_lbl live blocks,\n                 mkRODataLits info_lbl\n                    (CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])\n\n  --\n  -- With tables-next-to-code, we can have many info tables,\n  -- associated with some of the BlockIds of the proc.  For each info\n  -- table we need to turn it into CmmStatics, and collect any new\n  -- CmmDecls that arise from doing so.\n  --\n  | otherwise\n  = do\n    (top_declss, raw_infos) <-\n       unzip `fmap` mapM do_one_info (mapToList (info_tbls infos))\n    return (concat top_declss ++\n            [CmmProc (mapFromList raw_infos) entry_lbl live blocks])\n\n  where\n   do_one_info (lbl,itbl) = do\n     (top_decls, (std_info, extra_bits)) <-\n         mkInfoTableContents dflags itbl Nothing\n     let\n        info_lbl = cit_lbl itbl\n        rel_std_info   = map (makeRelativeRefTo dflags info_lbl) std_info\n        rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits\n     --\n     return (top_decls, (lbl, Statics info_lbl $ map CmmStaticLit $\n                              reverse rel_extra_bits ++ rel_std_info))\n\n-----------------------------------------------------\ntype InfoTableContents = ( [CmmLit]          -- The standard part\n                         , [CmmLit] )        -- The \"extra bits\"\n-- These Lits have *not* had mkRelativeTo applied to them\n\nmkInfoTableContents :: DynFlags\n                    -> CmmInfoTable\n                    -> Maybe Int               -- Override default RTS type tag?\n                    -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls\n                               InfoTableContents)       -- Info tbl + extra bits\n\nmkInfoTableContents dflags\n                    info@(CmmInfoTable { cit_lbl  = info_lbl\n                                       , cit_rep  = smrep\n                                       , cit_prof = prof\n                                       , cit_srt = srt })\n                    mb_rts_tag\n  | RTSRep rts_tag rep <- smrep\n  = mkInfoTableContents dflags info{cit_rep = rep} (Just rts_tag)\n    -- Completely override the rts_tag that mkInfoTableContents would\n    -- otherwise compute, with the rts_tag stored in the RTSRep\n    -- (which in turn came from a handwritten .cmm file)\n\n  | StackRep frame <- smrep\n  = do { (prof_lits, prof_data) <- mkProfLits dflags prof\n       ; let (srt_label, srt_bitmap) = mkSRTLit dflags info_lbl srt\n       ; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame\n       ; let\n             std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit\n             rts_tag | Just tag <- mb_rts_tag = tag\n                     | null liveness_data     = rET_SMALL -- Fits in extra_bits\n                     | otherwise              = rET_BIG   -- Does not; extra_bits is\n                                                          -- a label\n       ; return (prof_data ++ liveness_data, (std_info, srt_label)) }\n\n  | HeapRep _ ptrs nonptrs closure_type <- smrep\n  = do { let layout  = packIntsCLit dflags ptrs nonptrs\n       ; (prof_lits, prof_data) <- mkProfLits dflags prof\n       ; let (srt_label, srt_bitmap) = mkSRTLit dflags info_lbl srt\n       ; (mb_srt_field, mb_layout, extra_bits, ct_data)\n                                <- mk_pieces closure_type srt_label\n       ; let std_info = mkStdInfoTable dflags prof_lits\n                                       (mb_rts_tag   `orElse` rtsClosureType smrep)\n                                       (mb_srt_field `orElse` srt_bitmap)\n                                       (mb_layout    `orElse` layout)\n       ; return (prof_data ++ ct_data, (std_info, extra_bits)) }\n  where\n    mk_pieces :: ClosureTypeInfo -> [CmmLit]\n              -> UniqSM ( Maybe CmmLit  -- Override the SRT field with this\n                        , Maybe CmmLit  -- Override the layout field with this\n                        , [CmmLit]           -- \"Extra bits\" for info table\n                        , [RawCmmDecl])      -- Auxiliary data decls\n    mk_pieces (Constr con_tag con_descr) _no_srt    -- A data constructor\n      = do { (descr_lit, decl) <- newStringLit con_descr\n           ; return ( Just (CmmInt (fromIntegral con_tag)\n                                   (halfWordWidth dflags))\n                    , Nothing, [descr_lit], [decl]) }\n\n    mk_pieces Thunk srt_label\n      = return (Nothing, Nothing, srt_label, [])\n\n    mk_pieces (ThunkSelector offset) _no_srt\n      = return (Just (CmmInt 0 (halfWordWidth dflags)),\n                Just (mkWordCLit dflags (fromIntegral offset)), [], [])\n         -- Layout known (one free var); we use the layout field for offset\n\n    mk_pieces (Fun arity (ArgSpec fun_type)) srt_label\n      = do { let extra_bits = packIntsCLit dflags fun_type arity : srt_label\n           ; return (Nothing, Nothing,  extra_bits, []) }\n\n    mk_pieces (Fun arity (ArgGen arg_bits)) srt_label\n      = do { (liveness_lit, liveness_data) <- mkLivenessBits dflags arg_bits\n           ; let fun_type | null liveness_data = aRG_GEN\n                          | otherwise          = aRG_GEN_BIG\n                 extra_bits = [ packIntsCLit dflags fun_type arity ]\n                           ++ (if inlineSRT dflags then [] else [ srt_lit ])\n                           ++ [ liveness_lit, slow_entry ]\n           ; return (Nothing, Nothing, extra_bits, liveness_data) }\n      where\n        slow_entry = CmmLabel (toSlowEntryLbl info_lbl)\n        srt_lit = case srt_label of\n                    []          -> mkIntCLit dflags 0\n                    (lit:_rest) -> ASSERT( null _rest ) lit\n\n    mk_pieces other _ = pprPanic \"mk_pieces\" (ppr other)\n\nmkInfoTableContents _ _ _ = panic \"mkInfoTableContents\"   -- NonInfoTable dealt with earlier\n\npackIntsCLit :: DynFlags -> Int -> Int -> CmmLit\npackIntsCLit dflags a b = packHalfWordsCLit dflags\n                           (toStgHalfWord dflags (fromIntegral a))\n                           (toStgHalfWord dflags (fromIntegral b))\n\n\nmkSRTLit :: DynFlags\n         -> CLabel\n         -> Maybe CLabel\n         -> ([CmmLit],    -- srt_label, if any\n             CmmLit)      -- srt_bitmap\nmkSRTLit dflags info_lbl (Just lbl)\n  | inlineSRT dflags\n  = ([], CmmLabelDiffOff lbl info_lbl 0 (halfWordWidth dflags))\nmkSRTLit dflags _ Nothing    = ([], CmmInt 0 (halfWordWidth dflags))\nmkSRTLit dflags _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth dflags))\n\n\n-- | Is the SRT offset field inline in the info table on this platform?\n--\n-- See the section \"Referring to an SRT from the info table\" in\n-- Note [SRTs] in CmmBuildInfoTables.hs\ninlineSRT :: DynFlags -> Bool\ninlineSRT dflags = platformArch (targetPlatform dflags) == ArchX86_64\n  && tablesNextToCode dflags\n\n-------------------------------------------------------------------------\n--\n--      Lay out the info table and handle relative offsets\n--\n-------------------------------------------------------------------------\n\n-- This function takes\n--   * the standard info table portion (StgInfoTable)\n--   * the \"extra bits\" (StgFunInfoExtraRev etc.)\n--   * the entry label\n--   * the code\n-- and lays them out in memory, producing a list of RawCmmDecl\n\n-------------------------------------------------------------------------\n--\n--      Position independent code\n--\n-------------------------------------------------------------------------\n-- In order to support position independent code, we mustn't put absolute\n-- references into read-only space. Info tables in the tablesNextToCode\n-- case must be in .text, which is read-only, so we doctor the CmmLits\n-- to use relative offsets instead.\n\n-- Note that this is done even when the -fPIC flag is not specified,\n-- as we want to keep binary compatibility between PIC and non-PIC.\n\nmakeRelativeRefTo :: DynFlags -> CLabel -> CmmLit -> CmmLit\n\nmakeRelativeRefTo dflags info_lbl (CmmLabel lbl)\n  | tablesNextToCode dflags\n  = CmmLabelDiffOff lbl info_lbl 0 (wordWidth dflags)\nmakeRelativeRefTo dflags info_lbl (CmmLabelOff lbl off)\n  | tablesNextToCode dflags\n  = CmmLabelDiffOff lbl info_lbl off (wordWidth dflags)\nmakeRelativeRefTo _ _ lit = lit\n\n\n-------------------------------------------------------------------------\n--\n--              Build a liveness mask for the stack layout\n--\n-------------------------------------------------------------------------\n\n-- There are four kinds of things on the stack:\n--\n--      - pointer variables (bound in the environment)\n--      - non-pointer variables (bound in the environment)\n--      - free slots (recorded in the stack free list)\n--      - non-pointer data slots (recorded in the stack free list)\n--\n-- The first two are represented with a 'Just' of a 'LocalReg'.\n-- The last two with one or more 'Nothing' constructors.\n-- Each 'Nothing' represents one used word.\n--\n-- The head of the stack layout is the top of the stack and\n-- the least-significant bit.\n\nmkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])\n              -- ^ Returns:\n              --   1. The bitmap (literal value or label)\n              --   2. Large bitmap CmmData if needed\n\nmkLivenessBits dflags liveness\n  | n_bits > mAX_SMALL_BITMAP_SIZE dflags -- does not fit in one word\n  = do { uniq <- getUniqueM\n       ; let bitmap_lbl = mkBitmapLabel uniq\n       ; return (CmmLabel bitmap_lbl,\n                 [mkRODataLits bitmap_lbl lits]) }\n\n  | otherwise -- Fits in one word\n  = return (mkStgWordCLit dflags bitmap_word, [])\n  where\n    n_bits = length liveness\n\n    bitmap :: Bitmap\n    bitmap = mkBitmap dflags liveness\n\n    small_bitmap = case bitmap of\n                     []  -> toStgWord dflags 0\n                     [b] -> b\n                     _   -> panic \"mkLiveness\"\n    bitmap_word = toStgWord dflags (fromIntegral n_bits)\n              .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT dflags)\n\n    lits = mkWordCLit dflags (fromIntegral n_bits)\n         : map (mkStgWordCLit dflags) bitmap\n      -- The first word is the size.  The structure must match\n      -- StgLargeBitmap in includes/rts/storage/InfoTable.h\n\n-------------------------------------------------------------------------\n--\n--      Generating a standard info table\n--\n-------------------------------------------------------------------------\n\n-- The standard bits of an info table.  This part of the info table\n-- corresponds to the StgInfoTable type defined in\n-- includes/rts/storage/InfoTables.h.\n--\n-- Its shape varies with ticky/profiling/tables next to code etc\n-- so we can't use constant offsets from Constants\n\nmkStdInfoTable\n   :: DynFlags\n   -> (CmmLit,CmmLit)   -- Closure type descr and closure descr  (profiling)\n   -> Int               -- Closure RTS tag\n   -> CmmLit            -- SRT length\n   -> CmmLit            -- layout field\n   -> [CmmLit]\n\nmkStdInfoTable dflags (type_descr, closure_descr) cl_type srt layout_lit\n =      -- Parallel revertible-black hole field\n    prof_info\n        -- Ticky info (none at present)\n        -- Debug info (none at present)\n ++ [layout_lit, tag, srt]\n\n where\n    prof_info\n        | gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]\n        | otherwise = []\n\n    tag = CmmInt (fromIntegral cl_type) (halfWordWidth dflags)\n\n-------------------------------------------------------------------------\n--\n--      Making string literals\n--\n-------------------------------------------------------------------------\n\nmkProfLits :: DynFlags -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])\nmkProfLits dflags NoProfilingInfo       = return ((zeroCLit dflags, zeroCLit dflags), [])\nmkProfLits _ (ProfilingInfo td cd)\n  = do { (td_lit, td_decl) <- newStringLit td\n       ; (cd_lit, cd_decl) <- newStringLit cd\n       ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }\n\nnewStringLit :: ByteString -> UniqSM (CmmLit, GenCmmDecl CmmStatics info stmt)\nnewStringLit bytes\n  = do { uniq <- getUniqueM\n       ; return (mkByteStringCLit (mkStringLitLabel uniq) bytes) }\n\n\n-- Misc utils\n\n-- | Value of the srt field of an info table when using an StgLargeSRT\nsrtEscape :: DynFlags -> StgHalfWord\nsrtEscape dflags = toStgHalfWord dflags (-1)\n\n-------------------------------------------------------------------------\n--\n--      Accessing fields of an info table\n--\n-------------------------------------------------------------------------\n\n-- | Wrap a 'CmmExpr' in an alignment check when @-falignment-sanitisation@ is\n-- enabled.\nwordAligned :: DynFlags -> CmmExpr -> CmmExpr\nwordAligned dflags e\n  | gopt Opt_AlignmentSanitisation dflags\n  = CmmMachOp (MO_AlignmentCheck (wORD_SIZE dflags) (wordWidth dflags)) [e]\n  | otherwise\n  = e\n\nclosureInfoPtr :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes a closure pointer and returns the info table pointer\nclosureInfoPtr dflags e =\n    CmmLoad (wordAligned dflags e) (bWord dflags)\n\nentryCode :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes an info pointer (the first word of a closure)\n-- and returns its entry code\nentryCode dflags e\n | tablesNextToCode dflags = e\n | otherwise               = CmmLoad e (bWord dflags)\n\ngetConstrTag :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes a closure pointer, and return the *zero-indexed*\n-- constructor tag obtained from the info table\n-- This lives in the SRT field of the info table\n-- (constructors don't need SRTs).\ngetConstrTag dflags closure_ptr\n  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableConstrTag dflags info_table]\n  where\n    info_table = infoTable dflags (closureInfoPtr dflags closure_ptr)\n\ncmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes a closure pointer, and return the closure type\n-- obtained from the info table\ncmmGetClosureType dflags closure_ptr\n  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableClosureType dflags info_table]\n  where\n    info_table = infoTable dflags (closureInfoPtr dflags closure_ptr)\n\ninfoTable :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes an info pointer (the first word of a closure)\n-- and returns a pointer to the first word of the standard-form\n-- info table, excluding the entry-code word (if present)\ninfoTable dflags info_ptr\n  | tablesNextToCode dflags = cmmOffsetB dflags info_ptr (- stdInfoTableSizeB dflags)\n  | otherwise               = cmmOffsetW dflags info_ptr 1 -- Past the entry code pointer\n\ninfoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes an info table pointer (from infoTable) and returns the constr tag\n-- field of the info table (same as the srt_bitmap field)\ninfoTableConstrTag = infoTableSrtBitmap\n\ninfoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes an info table pointer (from infoTable) and returns the srt_bitmap\n-- field of the info table\ninfoTableSrtBitmap dflags info_tbl\n  = CmmLoad (cmmOffsetB dflags info_tbl (stdSrtBitmapOffset dflags)) (bHalfWord dflags)\n\ninfoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes an info table pointer (from infoTable) and returns the closure type\n-- field of the info table.\ninfoTableClosureType dflags info_tbl\n  = CmmLoad (cmmOffsetB dflags info_tbl (stdClosureTypeOffset dflags)) (bHalfWord dflags)\n\ninfoTablePtrs :: DynFlags -> CmmExpr -> CmmExpr\ninfoTablePtrs dflags info_tbl\n  = CmmLoad (cmmOffsetB dflags info_tbl (stdPtrsOffset dflags)) (bHalfWord dflags)\n\ninfoTableNonPtrs :: DynFlags -> CmmExpr -> CmmExpr\ninfoTableNonPtrs dflags info_tbl\n  = CmmLoad (cmmOffsetB dflags info_tbl (stdNonPtrsOffset dflags)) (bHalfWord dflags)\n\nfunInfoTable :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes the info pointer of a function,\n-- and returns a pointer to the first word of the StgFunInfoExtra struct\n-- in the info table.\nfunInfoTable dflags info_ptr\n  | tablesNextToCode dflags\n  = cmmOffsetB dflags info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags)\n  | otherwise\n  = cmmOffsetW dflags info_ptr (1 + stdInfoTableSizeW dflags)\n                                -- Past the entry code pointer\n\n-- Takes the info pointer of a function, returns the function's arity\nfunInfoArity :: DynFlags -> CmmExpr -> CmmExpr\nfunInfoArity dflags iptr\n  = cmmToWord dflags (cmmLoadIndex dflags rep fun_info (offset `div` rep_bytes))\n  where\n   fun_info = funInfoTable dflags iptr\n   rep = cmmBits (widthFromBytes rep_bytes)\n\n   (rep_bytes, offset)\n    | tablesNextToCode dflags = ( pc_REP_StgFunInfoExtraRev_arity pc\n                                , oFFSET_StgFunInfoExtraRev_arity dflags )\n    | otherwise               = ( pc_REP_StgFunInfoExtraFwd_arity pc\n                                , oFFSET_StgFunInfoExtraFwd_arity dflags )\n\n   pc = sPlatformConstants (settings dflags)\n\n-----------------------------------------------------------------------------\n--\n--      Info table sizes & offsets\n--\n-----------------------------------------------------------------------------\n\nstdInfoTableSizeW :: DynFlags -> WordOff\n-- The size of a standard info table varies with profiling/ticky etc,\n-- so we can't get it from Constants\n-- It must vary in sync with mkStdInfoTable\nstdInfoTableSizeW dflags\n  = fixedInfoTableSizeW\n  + if gopt Opt_SccProfilingOn dflags\n       then profInfoTableSizeW\n       else 0\n\nfixedInfoTableSizeW :: WordOff\nfixedInfoTableSizeW = 2 -- layout, type\n\nprofInfoTableSizeW :: WordOff\nprofInfoTableSizeW = 2\n\nmaxStdInfoTableSizeW :: WordOff\nmaxStdInfoTableSizeW =\n  1 {- entry, when !tablesNextToCode -}\n  + fixedInfoTableSizeW\n  + profInfoTableSizeW\n\nmaxRetInfoTableSizeW :: WordOff\nmaxRetInfoTableSizeW =\n  maxStdInfoTableSizeW\n  + 1 {- srt label -}\n\nstdInfoTableSizeB  :: DynFlags -> ByteOff\nstdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags\n\nstdSrtBitmapOffset :: DynFlags -> ByteOff\n-- Byte offset of the SRT bitmap half-word which is\n-- in the *higher-addressed* part of the type_lit\nstdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE dflags\n\nstdClosureTypeOffset :: DynFlags -> ByteOff\n-- Byte offset of the closure type half-word\nstdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags\n\nstdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff\nstdPtrsOffset    dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags\nstdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE dflags\n\nconInfoTableSizeB :: DynFlags -> Int\nconInfoTableSizeB dflags = stdInfoTableSizeB dflags + wORD_SIZE dflags\n", "num_lines": 587}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, RecordWildCards, GADTs #-}\nmodule CmmLayoutStack (\n       cmmLayoutStack, setInfoTableStackMap\n  ) where\n\nimport GhcPrelude hiding ((<*>))\n\nimport StgCmmUtils      ( callerSaveVolatileRegs ) -- XXX layering violation\nimport StgCmmForeign    ( saveThreadState, loadThreadState ) -- XXX layering violation\n\nimport BasicTypes\nimport Cmm\nimport CmmInfo\nimport BlockId\nimport CLabel\nimport CmmUtils\nimport MkGraph\nimport ForeignCall\nimport CmmLive\nimport CmmProcPoint\nimport SMRep\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Dataflow\nimport Hoopl.Graph\nimport Hoopl.Label\nimport UniqSupply\nimport StgCmmUtils      ( newTemp )\nimport Maybes\nimport UniqFM\nimport Util\n\nimport DynFlags\nimport FastString\nimport Outputable hiding ( isEmpty )\nimport qualified Data.Set as Set\nimport Control.Monad.Fix\nimport Data.Array as Array\nimport Data.Bits\nimport Data.List (nub)\n\n{- Note [Stack Layout]\n\nThe job of this pass is to\n\n - replace references to abstract stack Areas with fixed offsets from Sp.\n\n - replace the CmmHighStackMark constant used in the stack check with\n   the maximum stack usage of the proc.\n\n - save any variables that are live across a call, and reload them as\n   necessary.\n\nBefore stack allocation, local variables remain live across native\ncalls (CmmCall{ cmm_cont = Just _ }), and after stack allocation local\nvariables are clobbered by native calls.\n\nWe want to do stack allocation so that as far as possible\n - stack use is minimized, and\n - unnecessary stack saves and loads are avoided.\n\nThe algorithm we use is a variant of linear-scan register allocation,\nwhere the stack is our register file.\n\nWe proceed in two passes, see Note [Two pass approach] for why they are not easy\nto merge into one.\n\nPass 1:\n\n - First, we do a liveness analysis, which annotates every block with\n   the variables live on entry to the block.\n\n - We traverse blocks in reverse postorder DFS; that is, we visit at\n   least one predecessor of a block before the block itself.  The\n   stack layout flowing from the predecessor of the block will\n   determine the stack layout on entry to the block.\n\n - We maintain a data structure\n\n     Map Label StackMap\n\n   which describes the contents of the stack and the stack pointer on\n   entry to each block that is a successor of a block that we have\n   visited.\n\n - For each block we visit:\n\n    - Look up the StackMap for this block.\n\n    - If this block is a proc point (or a call continuation, if we aren't\n      splitting proc points), we need to reload all the live variables from the\n      stack - but this is done in Pass 2, which calculates more precise liveness\n      information (see description of Pass 2).\n\n    - Walk forwards through the instructions:\n      - At an assignment  x = Sp[loc]\n        - Record the fact that Sp[loc] contains x, so that we won't\n          need to save x if it ever needs to be spilled.\n      - At an assignment  x = E\n        - If x was previously on the stack, it isn't any more\n      - At the last node, if it is a call or a jump to a proc point\n        - Lay out the stack frame for the call (see setupStackFrame)\n        - emit instructions to save all the live variables\n        - Remember the StackMaps for all the successors\n        - emit an instruction to adjust Sp\n      - If the last node is a branch, then the current StackMap is the\n        StackMap for the successors.\n\n    - Manifest Sp: replace references to stack areas in this block\n      with real Sp offsets. We cannot do this until we have laid out\n      the stack area for the successors above.\n\n      In this phase we also eliminate redundant stores to the stack;\n      see elimStackStores.\n\n  - There is one important gotcha: sometimes we'll encounter a control\n    transfer to a block that we've already processed (a join point),\n    and in that case we might need to rearrange the stack to match\n    what the block is expecting. (exactly the same as in linear-scan\n    register allocation, except here we have the luxury of an infinite\n    supply of temporary variables).\n\n  - Finally, we update the magic CmmHighStackMark constant with the\n    stack usage of the function, and eliminate the whole stack check\n    if there was no stack use. (in fact this is done as part of the\n    main traversal, by feeding the high-water-mark output back in as\n    an input. I hate cyclic programming, but it's just too convenient\n    sometimes.)\n\n  There are plenty of tricky details: update frames, proc points, return\n  addresses, foreign calls, and some ad-hoc optimisations that are\n  convenient to do here and effective in common cases.  Comments in the\n  code below explain these.\n\nPass 2:\n\n- Calculate live registers, but taking into account that nothing is live at the\n  entry to a proc point.\n\n- At each proc point and call continuation insert reloads of live registers from\n  the stack (they were saved by Pass 1).\n\n\nNote [Two pass approach]\n\nThe main reason for Pass 2 is being able to insert only the reloads that are\nneeded and the fact that the two passes need different liveness information.\nLet's consider an example:\n\n  .....\n   \\ /\n    D   <- proc point\n   / \\\n  E   F\n   \\ /\n    G   <- proc point\n    |\n    X\n\nPass 1 needs liveness assuming that local variables are preserved across calls.\nThis is important because it needs to save any local registers to the stack\n(e.g., if register a is used in block X, it must be saved before any native\ncall).\nHowever, for Pass 2, where we want to reload registers from stack (in a proc\npoint), this is overly conservative and would lead us to generate reloads in D\nfor things used in X, even though we're going to generate reloads in G anyway\n(since it's also a proc point).\nSo Pass 2 calculates liveness knowing that nothing is live at the entry to a\nproc point. This means that in D we only need to reload things used in E or F.\nThis can be quite important, for an extreme example see testcase for #3294.\n\nMerging the two passes is not trivial - Pass 2 is a backward rewrite and Pass 1\nis a forward one. Furthermore, Pass 1 is creating code that uses local registers\n(saving them before a call), which the liveness analysis for Pass 2 must see to\nbe correct.\n\n-}\n\n\n-- All stack locations are expressed as positive byte offsets from the\n-- \"base\", which is defined to be the address above the return address\n-- on the stack on entry to this CmmProc.\n--\n-- Lower addresses have higher StackLocs.\n--\ntype StackLoc = ByteOff\n\n{-\n A StackMap describes the stack at any given point.  At a continuation\n it has a particular layout, like this:\n\n         |             | <- base\n         |-------------|\n         |     ret0    | <- base + 8\n         |-------------|\n         .  upd frame  . <- base + sm_ret_off\n         |-------------|\n         |             |\n         .    vars     .\n         . (live/dead) .\n         |             | <- base + sm_sp - sm_args\n         |-------------|\n         |    ret1     |\n         .  ret vals   . <- base + sm_sp    (<--- Sp points here)\n         |-------------|\n\nWhy do we include the final return address (ret0) in our stack map?  I\nhave absolutely no idea, but it seems to be done that way consistently\nin the rest of the code generator, so I played along here. --SDM\n\nNote that we will be constructing an info table for the continuation\n(ret1), which needs to describe the stack down to, but not including,\nthe update frame (or ret0, if there is no update frame).\n-}\n\ndata StackMap = StackMap\n {  sm_sp   :: StackLoc\n       -- ^ the offset of Sp relative to the base on entry\n       -- to this block.\n ,  sm_args :: ByteOff\n       -- ^ the number of bytes of arguments in the area for this block\n       -- Defn: the offset of young(L) relative to the base is given by\n       -- (sm_sp - sm_args) of the StackMap for block L.\n ,  sm_ret_off :: ByteOff\n       -- ^ Number of words of stack that we do not describe with an info\n       -- table, because it contains an update frame.\n ,  sm_regs :: UniqFM (LocalReg,StackLoc)\n       -- ^ regs on the stack\n }\n\ninstance Outputable StackMap where\n  ppr StackMap{..} =\n     text \"Sp = \" <> int sm_sp $$\n     text \"sm_args = \" <> int sm_args $$\n     text \"sm_ret_off = \" <> int sm_ret_off $$\n     text \"sm_regs = \" <> pprUFM sm_regs ppr\n\n\ncmmLayoutStack :: DynFlags -> ProcPointSet -> ByteOff -> CmmGraph\n               -> UniqSM (CmmGraph, LabelMap StackMap)\ncmmLayoutStack dflags procpoints entry_args\n               graph@(CmmGraph { g_entry = entry })\n  = do\n    -- We need liveness info. Dead assignments are removed later\n    -- by the sinking pass.\n    let liveness = cmmLocalLiveness dflags graph\n        blocks = revPostorder graph\n\n    (final_stackmaps, _final_high_sp, new_blocks) <-\n          mfix $ \\ ~(rec_stackmaps, rec_high_sp, _new_blocks) ->\n            layout dflags procpoints liveness entry entry_args\n                   rec_stackmaps rec_high_sp blocks\n\n    blocks_with_reloads <-\n        insertReloadsAsNeeded dflags procpoints final_stackmaps entry new_blocks\n    new_blocks' <- mapM (lowerSafeForeignCall dflags) blocks_with_reloads\n    return (ofBlockList entry new_blocks', final_stackmaps)\n\n-- -----------------------------------------------------------------------------\n-- Pass 1\n-- -----------------------------------------------------------------------------\n\nlayout :: DynFlags\n       -> LabelSet                      -- proc points\n       -> LabelMap CmmLocalLive         -- liveness\n       -> BlockId                       -- entry\n       -> ByteOff                       -- stack args on entry\n\n       -> LabelMap StackMap             -- [final] stack maps\n       -> ByteOff                       -- [final] Sp high water mark\n\n       -> [CmmBlock]                    -- [in] blocks\n\n       -> UniqSM\n          ( LabelMap StackMap           -- [out] stack maps\n          , ByteOff                     -- [out] Sp high water mark\n          , [CmmBlock]                  -- [out] new blocks\n          )\n\nlayout dflags procpoints liveness entry entry_args final_stackmaps final_sp_high blocks\n  = go blocks init_stackmap entry_args []\n  where\n    (updfr, cont_info)  = collectContInfo blocks\n\n    init_stackmap = mapSingleton entry StackMap{ sm_sp   = entry_args\n                                               , sm_args = entry_args\n                                               , sm_ret_off = updfr\n                                               , sm_regs = emptyUFM\n                                               }\n\n    go [] acc_stackmaps acc_hwm acc_blocks\n      = return (acc_stackmaps, acc_hwm, acc_blocks)\n\n    go (b0 : bs) acc_stackmaps acc_hwm acc_blocks\n      = do\n       let (entry0@(CmmEntry entry_lbl tscope), middle0, last0) = blockSplit b0\n\n       let stack0@StackMap { sm_sp = sp0 }\n               = mapFindWithDefault\n                     (pprPanic \"no stack map for\" (ppr entry_lbl))\n                     entry_lbl acc_stackmaps\n\n       -- (a) Update the stack map to include the effects of\n       --     assignments in this block\n       let stack1 = foldBlockNodesF (procMiddle acc_stackmaps) middle0 stack0\n\n       -- (b) Look at the last node and if we are making a call or\n       --     jumping to a proc point, we must save the live\n       --     variables, adjust Sp, and construct the StackMaps for\n       --     each of the successor blocks.  See handleLastNode for\n       --     details.\n       (middle1, sp_off, last1, fixup_blocks, out)\n           <- handleLastNode dflags procpoints liveness cont_info\n                             acc_stackmaps stack1 tscope middle0 last0\n\n       -- (c) Manifest Sp: run over the nodes in the block and replace\n       --     CmmStackSlot with CmmLoad from Sp with a concrete offset.\n       --\n       -- our block:\n       --    middle0          -- the original middle nodes\n       --    middle1          -- live variable saves from handleLastNode\n       --    Sp = Sp + sp_off -- Sp adjustment goes here\n       --    last1            -- the last node\n       --\n       let middle_pre = blockToList $ foldl' blockSnoc middle0 middle1\n\n       let final_blocks =\n               manifestSp dflags final_stackmaps stack0 sp0 final_sp_high\n                          entry0 middle_pre sp_off last1 fixup_blocks\n\n       let acc_stackmaps' = mapUnion acc_stackmaps out\n\n           -- If this block jumps to the GC, then we do not take its\n           -- stack usage into account for the high-water mark.\n           -- Otherwise, if the only stack usage is in the stack-check\n           -- failure block itself, we will do a redundant stack\n           -- check.  The stack has a buffer designed to accommodate\n           -- the largest amount of stack needed for calling the GC.\n           --\n           this_sp_hwm | isGcJump last0 = 0\n                       | otherwise      = sp0 - sp_off\n\n           hwm' = maximum (acc_hwm : this_sp_hwm : map sm_sp (mapElems out))\n\n       go bs acc_stackmaps' hwm' (final_blocks ++ acc_blocks)\n\n\n-- -----------------------------------------------------------------------------\n\n-- Not foolproof, but GCFun is the culprit we most want to catch\nisGcJump :: CmmNode O C -> Bool\nisGcJump (CmmCall { cml_target = CmmReg (CmmGlobal l) })\n  = l == GCFun || l == GCEnter1\nisGcJump _something_else = False\n\n-- -----------------------------------------------------------------------------\n\n-- This doesn't seem right somehow.  We need to find out whether this\n-- proc will push some update frame material at some point, so that we\n-- can avoid using that area of the stack for spilling.  The\n-- updfr_space field of the CmmProc *should* tell us, but it doesn't\n-- (I think maybe it gets filled in later when we do proc-point\n-- splitting).\n--\n-- So we'll just take the max of all the cml_ret_offs.  This could be\n-- unnecessarily pessimistic, but probably not in the code we\n-- generate.\n\ncollectContInfo :: [CmmBlock] -> (ByteOff, LabelMap ByteOff)\ncollectContInfo blocks\n  = (maximum ret_offs, mapFromList (catMaybes mb_argss))\n where\n  (mb_argss, ret_offs) = mapAndUnzip get_cont blocks\n\n  get_cont :: Block CmmNode x C -> (Maybe (Label, ByteOff), ByteOff)\n  get_cont b =\n     case lastNode b of\n        CmmCall { cml_cont = Just l, .. }\n           -> (Just (l, cml_ret_args), cml_ret_off)\n        CmmForeignCall { .. }\n           -> (Just (succ, ret_args), ret_off)\n        _other -> (Nothing, 0)\n\n\n-- -----------------------------------------------------------------------------\n-- Updating the StackMap from middle nodes\n\n-- Look for loads from stack slots, and update the StackMap.  This is\n-- purely for optimisation reasons, so that we can avoid saving a\n-- variable back to a different stack slot if it is already on the\n-- stack.\n--\n-- This happens a lot: for example when function arguments are passed\n-- on the stack and need to be immediately saved across a call, we\n-- want to just leave them where they are on the stack.\n--\nprocMiddle :: LabelMap StackMap -> CmmNode e x -> StackMap -> StackMap\nprocMiddle stackmaps node sm\n  = case node of\n     CmmAssign (CmmLocal r) (CmmLoad (CmmStackSlot area off) _)\n       -> sm { sm_regs = addToUFM (sm_regs sm) r (r,loc) }\n        where loc = getStackLoc area off stackmaps\n     CmmAssign (CmmLocal r) _other\n       -> sm { sm_regs = delFromUFM (sm_regs sm) r }\n     _other\n       -> sm\n\ngetStackLoc :: Area -> ByteOff -> LabelMap StackMap -> StackLoc\ngetStackLoc Old       n _         = n\ngetStackLoc (Young l) n stackmaps =\n  case mapLookup l stackmaps of\n    Nothing -> pprPanic \"getStackLoc\" (ppr l)\n    Just sm -> sm_sp sm - sm_args sm + n\n\n\n-- -----------------------------------------------------------------------------\n-- Handling stack allocation for a last node\n\n-- We take a single last node and turn it into:\n--\n--    C1 (some statements)\n--    Sp = Sp + N\n--    C2 (some more statements)\n--    call f()          -- the actual last node\n--\n-- plus possibly some more blocks (we may have to add some fixup code\n-- between the last node and the continuation).\n--\n-- C1: is the code for saving the variables across this last node onto\n-- the stack, if the continuation is a call or jumps to a proc point.\n--\n-- C2: if the last node is a safe foreign call, we have to inject some\n-- extra code that goes *after* the Sp adjustment.\n\nhandleLastNode\n   :: DynFlags -> ProcPointSet -> LabelMap CmmLocalLive -> LabelMap ByteOff\n   -> LabelMap StackMap -> StackMap -> CmmTickScope\n   -> Block CmmNode O O\n   -> CmmNode O C\n   -> UniqSM\n      ( [CmmNode O O]      -- nodes to go *before* the Sp adjustment\n      , ByteOff            -- amount to adjust Sp\n      , CmmNode O C        -- new last node\n      , [CmmBlock]         -- new blocks\n      , LabelMap StackMap  -- stackmaps for the continuations\n      )\n\nhandleLastNode dflags procpoints liveness cont_info stackmaps\n               stack0@StackMap { sm_sp = sp0 } tscp middle last\n = case last of\n    --  At each return / tail call,\n    --  adjust Sp to point to the last argument pushed, which\n    --  is cml_args, after popping any other junk from the stack.\n    CmmCall{ cml_cont = Nothing, .. } -> do\n      let sp_off = sp0 - cml_args\n      return ([], sp_off, last, [], mapEmpty)\n\n    --  At each CmmCall with a continuation:\n    CmmCall{ cml_cont = Just cont_lbl, .. } ->\n       return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off\n\n    CmmForeignCall{ succ = cont_lbl, .. } -> do\n       return $ lastCall cont_lbl (wORD_SIZE dflags) ret_args ret_off\n            -- one word of args: the return address\n\n    CmmBranch {}     ->  handleBranches\n    CmmCondBranch {} ->  handleBranches\n    CmmSwitch {}     ->  handleBranches\n\n  where\n     -- Calls and ForeignCalls are handled the same way:\n     lastCall :: BlockId -> ByteOff -> ByteOff -> ByteOff\n              -> ( [CmmNode O O]\n                 , ByteOff\n                 , CmmNode O C\n                 , [CmmBlock]\n                 , LabelMap StackMap\n                 )\n     lastCall lbl cml_args cml_ret_args cml_ret_off\n      =  ( assignments\n         , spOffsetForCall sp0 cont_stack cml_args\n         , last\n         , [] -- no new blocks\n         , mapSingleton lbl cont_stack )\n      where\n         (assignments, cont_stack) = prepareStack lbl cml_ret_args cml_ret_off\n\n\n     prepareStack lbl cml_ret_args cml_ret_off\n       | Just cont_stack <- mapLookup lbl stackmaps\n             -- If we have already seen this continuation before, then\n             -- we just have to make the stack look the same:\n       = (fixupStack stack0 cont_stack, cont_stack)\n             -- Otherwise, we have to allocate the stack frame\n       | otherwise\n       = (save_assignments, new_cont_stack)\n       where\n        (new_cont_stack, save_assignments)\n           = setupStackFrame dflags lbl liveness cml_ret_off cml_ret_args stack0\n\n\n     -- For other last nodes (branches), if any of the targets is a\n     -- proc point, we have to set up the stack to match what the proc\n     -- point is expecting.\n     --\n     handleBranches :: UniqSM ( [CmmNode O O]\n                                , ByteOff\n                                , CmmNode O C\n                                , [CmmBlock]\n                                , LabelMap StackMap )\n\n     handleBranches\n         -- Note [diamond proc point]\n       | Just l <- futureContinuation middle\n       , (nub $ filter (`setMember` procpoints) $ successors last) == [l]\n       = do\n         let cont_args = mapFindWithDefault 0 l cont_info\n             (assigs, cont_stack) = prepareStack l cont_args (sm_ret_off stack0)\n             out = mapFromList [ (l', cont_stack)\n                               | l' <- successors last ]\n         return ( assigs\n                , spOffsetForCall sp0 cont_stack (wORD_SIZE dflags)\n                , last\n                , []\n                , out)\n\n        | otherwise = do\n          pps <- mapM handleBranch (successors last)\n          let lbl_map :: LabelMap Label\n              lbl_map = mapFromList [ (l,tmp) | (l,tmp,_,_) <- pps ]\n              fix_lbl l = mapFindWithDefault l l lbl_map\n          return ( []\n                 , 0\n                 , mapSuccessors fix_lbl last\n                 , concat [ blk | (_,_,_,blk) <- pps ]\n                 , mapFromList [ (l, sm) | (l,_,sm,_) <- pps ] )\n\n     -- For each successor of this block\n     handleBranch :: BlockId -> UniqSM (BlockId, BlockId, StackMap, [CmmBlock])\n     handleBranch l\n        --   (a) if the successor already has a stackmap, we need to\n        --       shuffle the current stack to make it look the same.\n        --       We have to insert a new block to make this happen.\n        | Just stack2 <- mapLookup l stackmaps\n        = do\n             let assigs = fixupStack stack0 stack2\n             (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 tscp assigs\n             return (l, tmp_lbl, stack2, block)\n\n        --   (b) if the successor is a proc point, save everything\n        --       on the stack.\n        | l `setMember` procpoints\n        = do\n             let cont_args = mapFindWithDefault 0 l cont_info\n                 (stack2, assigs) =\n                      setupStackFrame dflags l liveness (sm_ret_off stack0)\n                                                        cont_args stack0\n             (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 tscp assigs\n             return (l, tmp_lbl, stack2, block)\n\n        --   (c) otherwise, the current StackMap is the StackMap for\n        --       the continuation.  But we must remember to remove any\n        --       variables from the StackMap that are *not* live at\n        --       the destination, because this StackMap might be used\n        --       by fixupStack if this is a join point.\n        | otherwise = return (l, l, stack1, [])\n        where live = mapFindWithDefault (panic \"handleBranch\") l liveness\n              stack1 = stack0 { sm_regs = filterUFM is_live (sm_regs stack0) }\n              is_live (r,_) = r `elemRegSet` live\n\n\nmakeFixupBlock :: DynFlags -> ByteOff -> Label -> StackMap\n               -> CmmTickScope -> [CmmNode O O]\n               -> UniqSM (Label, [CmmBlock])\nmakeFixupBlock dflags sp0 l stack tscope assigs\n  | null assigs && sp0 == sm_sp stack = return (l, [])\n  | otherwise = do\n    tmp_lbl <- newBlockId\n    let sp_off = sp0 - sm_sp stack\n        block = blockJoin (CmmEntry tmp_lbl tscope)\n                          ( maybeAddSpAdj dflags sp0 sp_off\n                           $ blockFromList assigs )\n                          (CmmBranch l)\n    return (tmp_lbl, [block])\n\n\n-- Sp is currently pointing to current_sp,\n-- we want it to point to\n--    (sm_sp cont_stack - sm_args cont_stack + args)\n-- so the difference is\n--    sp0 - (sm_sp cont_stack - sm_args cont_stack + args)\nspOffsetForCall :: ByteOff -> StackMap -> ByteOff -> ByteOff\nspOffsetForCall current_sp cont_stack args\n  = current_sp - (sm_sp cont_stack - sm_args cont_stack + args)\n\n\n-- | create a sequence of assignments to establish the new StackMap,\n-- given the old StackMap.\nfixupStack :: StackMap -> StackMap -> [CmmNode O O]\nfixupStack old_stack new_stack = concatMap move new_locs\n where\n     old_map  = sm_regs old_stack\n     new_locs = stackSlotRegs new_stack\n\n     move (r,n)\n       | Just (_,m) <- lookupUFM old_map r, n == m = []\n       | otherwise = [CmmStore (CmmStackSlot Old n)\n                               (CmmReg (CmmLocal r))]\n\n\n\nsetupStackFrame\n             :: DynFlags\n             -> BlockId                 -- label of continuation\n             -> LabelMap CmmLocalLive   -- liveness\n             -> ByteOff      -- updfr\n             -> ByteOff      -- bytes of return values on stack\n             -> StackMap     -- current StackMap\n             -> (StackMap, [CmmNode O O])\n\nsetupStackFrame dflags lbl liveness updfr_off ret_args stack0\n  = (cont_stack, assignments)\n  where\n      -- get the set of LocalRegs live in the continuation\n      live = mapFindWithDefault Set.empty lbl liveness\n\n      -- the stack from the base to updfr_off is off-limits.\n      -- our new stack frame contains:\n      --   * saved live variables\n      --   * the return address [young(C) + 8]\n      --   * the args for the call,\n      --     which are replaced by the return values at the return\n      --     point.\n\n      -- everything up to updfr_off is off-limits\n      -- stack1 contains updfr_off, plus everything we need to save\n      (stack1, assignments) = allocate dflags updfr_off live stack0\n\n      -- And the Sp at the continuation is:\n      --   sm_sp stack1 + ret_args\n      cont_stack = stack1{ sm_sp = sm_sp stack1 + ret_args\n                         , sm_args = ret_args\n                         , sm_ret_off = updfr_off\n                         }\n\n\n-- -----------------------------------------------------------------------------\n-- Note [diamond proc point]\n--\n-- This special case looks for the pattern we get from a typical\n-- tagged case expression:\n--\n--    Sp[young(L1)] = L1\n--    if (R1 & 7) != 0 goto L1 else goto L2\n--  L2:\n--    call [R1] returns to L1\n--  L1: live: {y}\n--    x = R1\n--\n-- If we let the generic case handle this, we get\n--\n--    Sp[-16] = L1\n--    if (R1 & 7) != 0 goto L1a else goto L2\n--  L2:\n--    Sp[-8] = y\n--    Sp = Sp - 16\n--    call [R1] returns to L1\n--  L1a:\n--    Sp[-8] = y\n--    Sp = Sp - 16\n--    goto L1\n--  L1:\n--    x = R1\n--\n-- The code for saving the live vars is duplicated in each branch, and\n-- furthermore there is an extra jump in the fast path (assuming L1 is\n-- a proc point, which it probably is if there is a heap check).\n--\n-- So to fix this we want to set up the stack frame before the\n-- conditional jump.  How do we know when to do this, and when it is\n-- safe?  The basic idea is, when we see the assignment\n--\n--   Sp[young(L)] = L\n--\n-- we know that\n--   * we are definitely heading for L\n--   * there can be no more reads from another stack area, because young(L)\n--     overlaps with it.\n--\n-- We don't necessarily know that everything live at L is live now\n-- (some might be assigned between here and the jump to L).  So we\n-- simplify and only do the optimisation when we see\n--\n--   (1) a block containing an assignment of a return address L\n--   (2) ending in a branch where one (and only) continuation goes to L,\n--       and no other continuations go to proc points.\n--\n-- then we allocate the stack frame for L at the end of the block,\n-- before the branch.\n--\n-- We could generalise (2), but that would make it a bit more\n-- complicated to handle, and this currently catches the common case.\n\nfutureContinuation :: Block CmmNode O O -> Maybe BlockId\nfutureContinuation middle = foldBlockNodesB f middle Nothing\n   where f :: CmmNode a b -> Maybe BlockId -> Maybe BlockId\n         f (CmmStore (CmmStackSlot (Young l) _) (CmmLit (CmmBlock _))) _\n               = Just l\n         f _ r = r\n\n-- -----------------------------------------------------------------------------\n-- Saving live registers\n\n-- | Given a set of live registers and a StackMap, save all the registers\n-- on the stack and return the new StackMap and the assignments to do\n-- the saving.\n--\nallocate :: DynFlags -> ByteOff -> LocalRegSet -> StackMap\n         -> (StackMap, [CmmNode O O])\nallocate dflags ret_off live stackmap@StackMap{ sm_sp = sp0\n                                              , sm_regs = regs0 }\n =\n   -- we only have to save regs that are not already in a slot\n   let to_save = filter (not . (`elemUFM` regs0)) (Set.elems live)\n       regs1   = filterUFM (\\(r,_) -> elemRegSet r live) regs0\n   in\n\n   -- make a map of the stack\n   let stack = reverse $ Array.elems $\n               accumArray (\\_ x -> x) Empty (1, toWords dflags (max sp0 ret_off)) $\n                 ret_words ++ live_words\n            where ret_words =\n                   [ (x, Occupied)\n                   | x <- [ 1 .. toWords dflags ret_off] ]\n                  live_words =\n                   [ (toWords dflags x, Occupied)\n                   | (r,off) <- nonDetEltsUFM regs1,\n                   -- See Note [Unique Determinism and code generation]\n                     let w = localRegBytes dflags r,\n                     x <- [ off, off - wORD_SIZE dflags .. off - w + 1] ]\n   in\n\n   -- Pass over the stack: find slots to save all the new live variables,\n   -- choosing the oldest slots first (hence a foldr).\n   let\n       save slot ([], stack, n, assigs, regs) -- no more regs to save\n          = ([], slot:stack, plusW dflags n 1, assigs, regs)\n       save slot (to_save, stack, n, assigs, regs)\n          = case slot of\n               Occupied ->  (to_save, Occupied:stack, plusW dflags n 1, assigs, regs)\n               Empty\n                 | Just (stack', r, to_save') <-\n                       select_save to_save (slot:stack)\n                 -> let assig = CmmStore (CmmStackSlot Old n')\n                                         (CmmReg (CmmLocal r))\n                        n' = plusW dflags n 1\n                   in\n                        (to_save', stack', n', assig : assigs, (r,(r,n')):regs)\n\n                 | otherwise\n                 -> (to_save, slot:stack, plusW dflags n 1, assigs, regs)\n\n       -- we should do better here: right now we'll fit the smallest first,\n       -- but it would make more sense to fit the biggest first.\n       select_save :: [LocalReg] -> [StackSlot]\n                   -> Maybe ([StackSlot], LocalReg, [LocalReg])\n       select_save regs stack = go regs []\n         where go []     _no_fit = Nothing\n               go (r:rs) no_fit\n                 | Just rest <- dropEmpty words stack\n                 = Just (replicate words Occupied ++ rest, r, rs++no_fit)\n                 | otherwise\n                 = go rs (r:no_fit)\n                 where words = localRegWords dflags r\n\n       -- fill in empty slots as much as possible\n       (still_to_save, save_stack, n, save_assigs, save_regs)\n          = foldr save (to_save, [], 0, [], []) stack\n\n       -- push any remaining live vars on the stack\n       (push_sp, push_assigs, push_regs)\n          = foldr push (n, [], []) still_to_save\n          where\n              push r (n, assigs, regs)\n                = (n', assig : assigs, (r,(r,n')) : regs)\n                where\n                  n' = n + localRegBytes dflags r\n                  assig = CmmStore (CmmStackSlot Old n')\n                                   (CmmReg (CmmLocal r))\n\n       trim_sp\n          | not (null push_regs) = push_sp\n          | otherwise\n          = plusW dflags n (- length (takeWhile isEmpty save_stack))\n\n       final_regs = regs1 `addListToUFM` push_regs\n                          `addListToUFM` save_regs\n\n   in\n  -- XXX should be an assert\n   if ( n /= max sp0 ret_off ) then pprPanic \"allocate\" (ppr n <+> ppr sp0 <+> ppr ret_off) else\n\n   if (trim_sp .&. (wORD_SIZE dflags - 1)) /= 0  then pprPanic \"allocate2\" (ppr trim_sp <+> ppr final_regs <+> ppr push_sp) else\n\n   ( stackmap { sm_regs = final_regs , sm_sp = trim_sp }\n   , push_assigs ++ save_assigs )\n\n\n-- -----------------------------------------------------------------------------\n-- Manifesting Sp\n\n-- | Manifest Sp: turn all the CmmStackSlots into CmmLoads from Sp.  The\n-- block looks like this:\n--\n--    middle_pre       -- the middle nodes\n--    Sp = Sp + sp_off -- Sp adjustment goes here\n--    last             -- the last node\n--\n-- And we have some extra blocks too (that don't contain Sp adjustments)\n--\n-- The adjustment for middle_pre will be different from that for\n-- middle_post, because the Sp adjustment intervenes.\n--\nmanifestSp\n   :: DynFlags\n   -> LabelMap StackMap  -- StackMaps for other blocks\n   -> StackMap           -- StackMap for this block\n   -> ByteOff            -- Sp on entry to the block\n   -> ByteOff            -- SpHigh\n   -> CmmNode C O        -- first node\n   -> [CmmNode O O]      -- middle\n   -> ByteOff            -- sp_off\n   -> CmmNode O C        -- last node\n   -> [CmmBlock]         -- new blocks\n   -> [CmmBlock]         -- final blocks with Sp manifest\n\nmanifestSp dflags stackmaps stack0 sp0 sp_high\n           first middle_pre sp_off last fixup_blocks\n  = final_block : fixup_blocks'\n  where\n    area_off = getAreaOff stackmaps\n\n    adj_pre_sp, adj_post_sp :: CmmNode e x -> CmmNode e x\n    adj_pre_sp  = mapExpDeep (areaToSp dflags sp0            sp_high area_off)\n    adj_post_sp = mapExpDeep (areaToSp dflags (sp0 - sp_off) sp_high area_off)\n\n    final_middle = maybeAddSpAdj dflags sp0 sp_off\n                 . blockFromList\n                 . map adj_pre_sp\n                 . elimStackStores stack0 stackmaps area_off\n                 $ middle_pre\n    final_last    = optStackCheck (adj_post_sp last)\n\n    final_block   = blockJoin first final_middle final_last\n\n    fixup_blocks' = map (mapBlock3' (id, adj_post_sp, id)) fixup_blocks\n\ngetAreaOff :: LabelMap StackMap -> (Area -> StackLoc)\ngetAreaOff _ Old = 0\ngetAreaOff stackmaps (Young l) =\n  case mapLookup l stackmaps of\n    Just sm -> sm_sp sm - sm_args sm\n    Nothing -> pprPanic \"getAreaOff\" (ppr l)\n\n\nmaybeAddSpAdj\n  :: DynFlags -> ByteOff -> ByteOff -> Block CmmNode O O -> Block CmmNode O O\nmaybeAddSpAdj dflags sp0 sp_off block =\n  add_initial_unwind $ add_adj_unwind $ adj block\n  where\n    adj block\n      | sp_off /= 0\n      = block `blockSnoc` CmmAssign spReg (cmmOffset dflags spExpr sp_off)\n      | otherwise = block\n    -- Add unwind pseudo-instruction at the beginning of each block to\n    -- document Sp level for debugging\n    add_initial_unwind block\n      | debugLevel dflags > 0\n      = CmmUnwind [(Sp, Just sp_unwind)] `blockCons` block\n      | otherwise\n      = block\n      where sp_unwind = CmmRegOff spReg (sp0 - wORD_SIZE dflags)\n\n    -- Add unwind pseudo-instruction right after the Sp adjustment\n    -- if there is one.\n    add_adj_unwind block\n      | debugLevel dflags > 0\n      , sp_off /= 0\n      = block `blockSnoc` CmmUnwind [(Sp, Just sp_unwind)]\n      | otherwise\n      = block\n      where sp_unwind = CmmRegOff spReg (sp0 - wORD_SIZE dflags - sp_off)\n\n{- Note [SP old/young offsets]\n\nSp(L) is the Sp offset on entry to block L relative to the base of the\nOLD area.\n\nSpArgs(L) is the size of the young area for L, i.e. the number of\narguments.\n\n - in block L, each reference to [old + N] turns into\n   [Sp + Sp(L) - N]\n\n - in block L, each reference to [young(L') + N] turns into\n   [Sp + Sp(L) - Sp(L') + SpArgs(L') - N]\n\n - be careful with the last node of each block: Sp has already been adjusted\n   to be Sp + Sp(L) - Sp(L')\n-}\n\nareaToSp :: DynFlags -> ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr\n\nareaToSp dflags sp_old _sp_hwm area_off (CmmStackSlot area n)\n  = cmmOffset dflags spExpr (sp_old - area_off area - n)\n    -- Replace (CmmStackSlot area n) with an offset from Sp\n\nareaToSp dflags _ sp_hwm _ (CmmLit CmmHighStackMark)\n  = mkIntExpr dflags sp_hwm\n    -- Replace CmmHighStackMark with the number of bytes of stack used,\n    -- the sp_hwm.   See Note [Stack usage] in StgCmmHeap\n\nareaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _) args)\n  | falseStackCheck args\n  = zeroExpr dflags\nareaToSp dflags _ _ _ (CmmMachOp (MO_U_Ge _) args)\n  | falseStackCheck args\n  = mkIntExpr dflags 1\n    -- Replace a stack-overflow test that cannot fail with a no-op\n    -- See Note [Always false stack check]\n\nareaToSp _ _ _ _ other = other\n\n-- | Determine whether a stack check cannot fail.\nfalseStackCheck :: [CmmExpr] -> Bool\nfalseStackCheck [ CmmMachOp (MO_Sub _)\n                      [ CmmRegOff (CmmGlobal Sp) x_off\n                      , CmmLit (CmmInt y_lit _)]\n                , CmmReg (CmmGlobal SpLim)]\n  = fromIntegral x_off >= y_lit\nfalseStackCheck _ = False\n\n-- Note [Always false stack check]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- We can optimise stack checks of the form\n--\n--   if ((Sp + x) - y < SpLim) then .. else ..\n--\n-- where are non-negative integer byte offsets.  Since we know that\n-- SpLim <= Sp (remember the stack grows downwards), this test must\n-- yield False if (x >= y), so we can rewrite the comparison to False.\n-- A subsequent sinking pass will later drop the dead code.\n-- Optimising this away depends on knowing that SpLim <= Sp, so it is\n-- really the job of the stack layout algorithm, hence we do it now.\n--\n-- The control flow optimiser may negate a conditional to increase\n-- the likelihood of a fallthrough if the branch is not taken.  But\n-- not every conditional is inverted as the control flow optimiser\n-- places some requirements on the predecessors of both branch targets.\n-- So we better look for the inverted comparison too.\n\noptStackCheck :: CmmNode O C -> CmmNode O C\noptStackCheck n = -- Note [Always false stack check]\n case n of\n   CmmCondBranch (CmmLit (CmmInt 0 _)) _true false _ -> CmmBranch false\n   CmmCondBranch (CmmLit (CmmInt _ _)) true _false _ -> CmmBranch true\n   other -> other\n\n\n-- -----------------------------------------------------------------------------\n\n-- | Eliminate stores of the form\n--\n--    Sp[area+n] = r\n--\n-- when we know that r is already in the same slot as Sp[area+n].  We\n-- could do this in a later optimisation pass, but that would involve\n-- a separate analysis and we already have the information to hand\n-- here.  It helps clean up some extra stack stores in common cases.\n--\n-- Note that we may have to modify the StackMap as we walk through the\n-- code using procMiddle, since an assignment to a variable in the\n-- StackMap will invalidate its mapping there.\n--\nelimStackStores :: StackMap\n                -> LabelMap StackMap\n                -> (Area -> ByteOff)\n                -> [CmmNode O O]\n                -> [CmmNode O O]\nelimStackStores stackmap stackmaps area_off nodes\n  = go stackmap nodes\n  where\n    go _stackmap [] = []\n    go stackmap (n:ns)\n     = case n of\n         CmmStore (CmmStackSlot area m) (CmmReg (CmmLocal r))\n            | Just (_,off) <- lookupUFM (sm_regs stackmap) r\n            , area_off area + m == off\n            -> go stackmap ns\n         _otherwise\n            -> n : go (procMiddle stackmaps n stackmap) ns\n\n\n-- -----------------------------------------------------------------------------\n-- Update info tables to include stack liveness\n\n\nsetInfoTableStackMap :: DynFlags -> LabelMap StackMap -> CmmDecl -> CmmDecl\nsetInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l v g)\n  = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l v g\n  where\n    fix_info lbl info_tbl@CmmInfoTable{ cit_rep = StackRep _ } =\n       info_tbl { cit_rep = StackRep (get_liveness lbl) }\n    fix_info _ other = other\n\n    get_liveness :: BlockId -> Liveness\n    get_liveness lbl\n      = case mapLookup lbl stackmaps of\n          Nothing -> pprPanic \"setInfoTableStackMap\" (ppr lbl <+> ppr info_tbls)\n          Just sm -> stackMapToLiveness dflags sm\n\nsetInfoTableStackMap _ _ d = d\n\n\nstackMapToLiveness :: DynFlags -> StackMap -> Liveness\nstackMapToLiveness dflags StackMap{..} =\n   reverse $ Array.elems $\n        accumArray (\\_ x -> x) True (toWords dflags sm_ret_off + 1,\n                                     toWords dflags (sm_sp - sm_args)) live_words\n   where\n     live_words =  [ (toWords dflags off, False)\n                   | (r,off) <- nonDetEltsUFM sm_regs\n                   , isGcPtrType (localRegType r) ]\n                   -- See Note [Unique Determinism and code generation]\n\n-- -----------------------------------------------------------------------------\n-- Pass 2\n-- -----------------------------------------------------------------------------\n\ninsertReloadsAsNeeded\n    :: DynFlags\n    -> ProcPointSet\n    -> LabelMap StackMap\n    -> BlockId\n    -> [CmmBlock]\n    -> UniqSM [CmmBlock]\ninsertReloadsAsNeeded dflags procpoints final_stackmaps entry blocks = do\n    toBlockList . fst <$>\n        rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty\n  where\n    rewriteCC :: RewriteFun CmmLocalLive\n    rewriteCC (BlockCC e_node middle0 x_node) fact_base0 = do\n        let entry_label = entryLabel e_node\n            stackmap = case mapLookup entry_label final_stackmaps of\n                Just sm -> sm\n                Nothing -> panic \"insertReloadsAsNeeded: rewriteCC: stackmap\"\n\n            -- Merge the liveness from successor blocks and analyse the last\n            -- node.\n            joined = gen_kill dflags x_node $!\n                         joinOutFacts liveLattice x_node fact_base0\n            -- What is live at the start of middle0.\n            live_at_middle0 = foldNodesBwdOO (gen_kill dflags) middle0 joined\n\n            -- If this is a procpoint we need to add the reloads, but only if\n            -- they're actually live. Furthermore, nothing is live at the entry\n            -- to a proc point.\n            (middle1, live_with_reloads)\n                | entry_label `setMember` procpoints\n                = let reloads = insertReloads dflags stackmap live_at_middle0\n                  in (foldr blockCons middle0 reloads, emptyRegSet)\n                | otherwise\n                = (middle0, live_at_middle0)\n\n            -- Final liveness for this block.\n            !fact_base2 = mapSingleton entry_label live_with_reloads\n\n        return (BlockCC e_node middle1 x_node, fact_base2)\n\ninsertReloads :: DynFlags -> StackMap -> CmmLocalLive -> [CmmNode O O]\ninsertReloads dflags stackmap live =\n     [ CmmAssign (CmmLocal reg)\n                 -- This cmmOffset basically corresponds to manifesting\n                 -- @CmmStackSlot Old sp_off@, see Note [SP old/young offsets]\n                 (CmmLoad (cmmOffset dflags spExpr (sp_off - reg_off))\n                          (localRegType reg))\n     | (reg, reg_off) <- stackSlotRegs stackmap\n     , reg `elemRegSet` live\n     ]\n   where\n     sp_off = sm_sp stackmap\n\n-- -----------------------------------------------------------------------------\n-- Lowering safe foreign calls\n\n{-\nNote [Lower safe foreign calls]\n\nWe start with\n\n   Sp[young(L1)] = L1\n ,-----------------------\n | r1 = foo(x,y,z) returns to L1\n '-----------------------\n L1:\n   R1 = r1 -- copyIn, inserted by mkSafeCall\n   ...\n\nthe stack layout algorithm will arrange to save and reload everything\nlive across the call.  Our job now is to expand the call so we get\n\n   Sp[young(L1)] = L1\n ,-----------------------\n | SAVE_THREAD_STATE()\n | token = suspendThread(BaseReg, interruptible)\n | r = foo(x,y,z)\n | BaseReg = resumeThread(token)\n | LOAD_THREAD_STATE()\n | R1 = r  -- copyOut\n | jump Sp[0]\n '-----------------------\n L1:\n   r = R1 -- copyIn, inserted by mkSafeCall\n   ...\n\nNote the copyOut, which saves the results in the places that L1 is\nexpecting them (see Note [safe foreign call convention]). Note also\nthat safe foreign call is replace by an unsafe one in the Cmm graph.\n-}\n\nlowerSafeForeignCall :: DynFlags -> CmmBlock -> UniqSM CmmBlock\nlowerSafeForeignCall dflags block\n  | (entry@(CmmEntry _ tscp), middle, CmmForeignCall { .. }) <- blockSplit block\n  = do\n    -- Both 'id' and 'new_base' are KindNonPtr because they're\n    -- RTS-only objects and are not subject to garbage collection\n    id <- newTemp (bWord dflags)\n    new_base <- newTemp (cmmRegType dflags baseReg)\n    let (caller_save, caller_load) = callerSaveVolatileRegs dflags\n    save_state_code <- saveThreadState dflags\n    load_state_code <- loadThreadState dflags\n    let suspend = save_state_code  <*>\n                  caller_save <*>\n                  mkMiddle (callSuspendThread dflags id intrbl)\n        midCall = mkUnsafeCall tgt res args\n        resume  = mkMiddle (callResumeThread new_base id) <*>\n                  -- Assign the result to BaseReg: we\n                  -- might now have a different Capability!\n                  mkAssign baseReg (CmmReg (CmmLocal new_base)) <*>\n                  caller_load <*>\n                  load_state_code\n\n        (_, regs, copyout) =\n             copyOutOflow dflags NativeReturn Jump (Young succ)\n                            (map (CmmReg . CmmLocal) res)\n                            ret_off []\n\n        -- NB. after resumeThread returns, the top-of-stack probably contains\n        -- the stack frame for succ, but it might not: if the current thread\n        -- received an exception during the call, then the stack might be\n        -- different.  Hence we continue by jumping to the top stack frame,\n        -- not by jumping to succ.\n        jump = CmmCall { cml_target    = entryCode dflags $\n                                         CmmLoad spExpr (bWord dflags)\n                       , cml_cont      = Just succ\n                       , cml_args_regs = regs\n                       , cml_args      = widthInBytes (wordWidth dflags)\n                       , cml_ret_args  = ret_args\n                       , cml_ret_off   = ret_off }\n\n    graph' <- lgraphOfAGraph ( suspend <*>\n                               midCall <*>\n                               resume  <*>\n                               copyout <*>\n                               mkLast jump, tscp)\n\n    case toBlockList graph' of\n      [one] -> let (_, middle', last) = blockSplit one\n               in return (blockJoin entry (middle `blockAppend` middle') last)\n      _ -> panic \"lowerSafeForeignCall0\"\n\n  -- Block doesn't end in a safe foreign call:\n  | otherwise = return block\n\n\nforeignLbl :: FastString -> CmmExpr\nforeignLbl name = CmmLit (CmmLabel (mkForeignLabel name Nothing ForeignLabelInExternalPackage IsFunction))\n\ncallSuspendThread :: DynFlags -> LocalReg -> Bool -> CmmNode O O\ncallSuspendThread dflags id intrbl =\n  CmmUnsafeForeignCall\n       (ForeignTarget (foreignLbl (fsLit \"suspendThread\"))\n        (ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint] CmmMayReturn))\n       [id] [baseExpr, mkIntExpr dflags (fromEnum intrbl)]\n\ncallResumeThread :: LocalReg -> LocalReg -> CmmNode O O\ncallResumeThread new_base id =\n  CmmUnsafeForeignCall\n       (ForeignTarget (foreignLbl (fsLit \"resumeThread\"))\n            (ForeignConvention CCallConv [AddrHint] [AddrHint] CmmMayReturn))\n       [new_base] [CmmReg (CmmLocal id)]\n\n-- -----------------------------------------------------------------------------\n\nplusW :: DynFlags -> ByteOff -> WordOff -> ByteOff\nplusW dflags b w = b + w * wORD_SIZE dflags\n\ndata StackSlot = Occupied | Empty\n     -- Occupied: a return address or part of an update frame\n\ninstance Outputable StackSlot where\n  ppr Occupied = text \"XXX\"\n  ppr Empty    = text \"---\"\n\ndropEmpty :: WordOff -> [StackSlot] -> Maybe [StackSlot]\ndropEmpty 0 ss           = Just ss\ndropEmpty n (Empty : ss) = dropEmpty (n-1) ss\ndropEmpty _ _            = Nothing\n\nisEmpty :: StackSlot -> Bool\nisEmpty Empty = True\nisEmpty _ = False\n\nlocalRegBytes :: DynFlags -> LocalReg -> ByteOff\nlocalRegBytes dflags r\n    = roundUpToWords dflags (widthInBytes (typeWidth (localRegType r)))\n\nlocalRegWords :: DynFlags -> LocalReg -> WordOff\nlocalRegWords dflags = toWords dflags . localRegBytes dflags\n\ntoWords :: DynFlags -> ByteOff -> WordOff\ntoWords dflags x = x `quot` wORD_SIZE dflags\n\n\nstackSlotRegs :: StackMap -> [(LocalReg, StackLoc)]\nstackSlotRegs sm = nonDetEltsUFM (sm_regs sm)\n  -- See Note [Unique Determinism and code generation]\n", "num_lines": 1238}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2011\n--\n-- CmmLint: checking the correctness of Cmm statements and expressions\n--\n-----------------------------------------------------------------------------\n{-# LANGUAGE GADTs #-}\nmodule CmmLint (\n    cmmLint, cmmLintGraph\n  ) where\n\nimport GhcPrelude\n\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport Hoopl.Label\nimport Cmm\nimport CmmUtils\nimport CmmLive\nimport CmmSwitch (switchTargetsToList)\nimport PprCmm ()\nimport Outputable\nimport DynFlags\n\nimport Control.Monad (liftM, ap)\n\n-- Things to check:\n--     - invariant on CmmBlock in CmmExpr (see comment there)\n--     - check for branches to blocks that don't exist\n--     - check types\n\n-- -----------------------------------------------------------------------------\n-- Exported entry points:\n\ncmmLint :: (Outputable d, Outputable h)\n        => DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc\ncmmLint dflags tops = runCmmLint dflags (mapM_ (lintCmmDecl dflags)) tops\n\ncmmLintGraph :: DynFlags -> CmmGraph -> Maybe SDoc\ncmmLintGraph dflags g = runCmmLint dflags (lintCmmGraph dflags) g\n\nrunCmmLint :: Outputable a => DynFlags -> (a -> CmmLint b) -> a -> Maybe SDoc\nrunCmmLint dflags l p =\n   case unCL (l p) dflags of\n     Left err -> Just (vcat [text \"Cmm lint error:\",\n                             nest 2 err,\n                             text \"Program was:\",\n                             nest 2 (ppr p)])\n     Right _  -> Nothing\n\nlintCmmDecl :: DynFlags -> GenCmmDecl h i CmmGraph -> CmmLint ()\nlintCmmDecl dflags (CmmProc _ lbl _ g)\n  = addLintInfo (text \"in proc \" <> ppr lbl) $ lintCmmGraph dflags g\nlintCmmDecl _ (CmmData {})\n  = return ()\n\n\nlintCmmGraph :: DynFlags -> CmmGraph -> CmmLint ()\nlintCmmGraph dflags g =\n    cmmLocalLiveness dflags g `seq` mapM_ (lintCmmBlock labels) blocks\n    -- cmmLiveness throws an error if there are registers\n    -- live on entry to the graph (i.e. undefined\n    -- variables)\n  where\n       blocks = toBlockList g\n       labels = setFromList (map entryLabel blocks)\n\n\nlintCmmBlock :: LabelSet -> CmmBlock -> CmmLint ()\nlintCmmBlock labels block\n  = addLintInfo (text \"in basic block \" <> ppr (entryLabel block)) $ do\n        let (_, middle, last) = blockSplit block\n        mapM_ lintCmmMiddle (blockToList middle)\n        lintCmmLast labels last\n\n-- -----------------------------------------------------------------------------\n-- lintCmmExpr\n\n-- Checks whether a CmmExpr is \"type-correct\", and check for obvious-looking\n-- byte/word mismatches.\n\nlintCmmExpr :: CmmExpr -> CmmLint CmmType\nlintCmmExpr (CmmLoad expr rep) = do\n  _ <- lintCmmExpr expr\n  -- Disabled, if we have the inlining phase before the lint phase,\n  -- we can have funny offsets due to pointer tagging. -- EZY\n  -- when (widthInBytes (typeWidth rep) >= wORD_SIZE) $\n  --   cmmCheckWordAddress expr\n  return rep\nlintCmmExpr expr@(CmmMachOp op args) = do\n  dflags <- getDynFlags\n  tys <- mapM lintCmmExpr args\n  if map (typeWidth . cmmExprType dflags) args == machOpArgReps dflags op\n        then cmmCheckMachOp op args tys\n        else cmmLintMachOpErr expr (map (cmmExprType dflags) args) (machOpArgReps dflags op)\nlintCmmExpr (CmmRegOff reg offset)\n  = do dflags <- getDynFlags\n       let rep = typeWidth (cmmRegType dflags reg)\n       lintCmmExpr (CmmMachOp (MO_Add rep)\n                [CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])\nlintCmmExpr expr =\n  do dflags <- getDynFlags\n     return (cmmExprType dflags expr)\n\n-- Check for some common byte/word mismatches (eg. Sp + 1)\ncmmCheckMachOp   :: MachOp -> [CmmExpr] -> [CmmType] -> CmmLint CmmType\ncmmCheckMachOp op [lit@(CmmLit (CmmInt { })), reg@(CmmReg _)] tys\n  = cmmCheckMachOp op [reg, lit] tys\ncmmCheckMachOp op _ tys\n  = do dflags <- getDynFlags\n       return (machOpResultType dflags op tys)\n\n{-\nisOffsetOp :: MachOp -> Bool\nisOffsetOp (MO_Add _) = True\nisOffsetOp (MO_Sub _) = True\nisOffsetOp _ = False\n\n-- This expression should be an address from which a word can be loaded:\n-- check for funny-looking sub-word offsets.\n_cmmCheckWordAddress :: CmmExpr -> CmmLint ()\n_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])\n  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0\n  = cmmLintDubiousWordOffset e\n_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])\n  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0\n  = cmmLintDubiousWordOffset e\n_cmmCheckWordAddress _\n  = return ()\n\n-- No warnings for unaligned arithmetic with the node register,\n-- which is used to extract fields from tagged constructor closures.\nnotNodeReg :: CmmExpr -> Bool\nnotNodeReg (CmmReg reg) | reg == nodeReg = False\nnotNodeReg _                             = True\n-}\n\nlintCmmMiddle :: CmmNode O O -> CmmLint ()\nlintCmmMiddle node = case node of\n  CmmComment _ -> return ()\n  CmmTick _    -> return ()\n  CmmUnwind{}  -> return ()\n\n  CmmAssign reg expr -> do\n            dflags <- getDynFlags\n            erep <- lintCmmExpr expr\n            let reg_ty = cmmRegType dflags reg\n            if (erep `cmmEqType_ignoring_ptrhood` reg_ty)\n                then return ()\n                else cmmLintAssignErr (CmmAssign reg expr) erep reg_ty\n\n  CmmStore l r -> do\n            _ <- lintCmmExpr l\n            _ <- lintCmmExpr r\n            return ()\n\n  CmmUnsafeForeignCall target _formals actuals -> do\n            lintTarget target\n            mapM_ lintCmmExpr actuals\n\n\nlintCmmLast :: LabelSet -> CmmNode O C -> CmmLint ()\nlintCmmLast labels node = case node of\n  CmmBranch id -> checkTarget id\n\n  CmmCondBranch e t f _ -> do\n            dflags <- getDynFlags\n            mapM_ checkTarget [t,f]\n            _ <- lintCmmExpr e\n            checkCond dflags e\n\n  CmmSwitch e ids -> do\n            dflags <- getDynFlags\n            mapM_ checkTarget $ switchTargetsToList ids\n            erep <- lintCmmExpr e\n            if (erep `cmmEqType_ignoring_ptrhood` bWord dflags)\n              then return ()\n              else cmmLintErr (text \"switch scrutinee is not a word: \" <>\n                               ppr e <> text \" :: \" <> ppr erep)\n\n  CmmCall { cml_target = target, cml_cont = cont } -> do\n          _ <- lintCmmExpr target\n          maybe (return ()) checkTarget cont\n\n  CmmForeignCall tgt _ args succ _ _ _ -> do\n          lintTarget tgt\n          mapM_ lintCmmExpr args\n          checkTarget succ\n where\n  checkTarget id\n     | setMember id labels = return ()\n     | otherwise = cmmLintErr (text \"Branch to nonexistent id\" <+> ppr id)\n\n\nlintTarget :: ForeignTarget -> CmmLint ()\nlintTarget (ForeignTarget e _) = lintCmmExpr e >> return ()\nlintTarget (PrimTarget {})     = return ()\n\n\ncheckCond :: DynFlags -> CmmExpr -> CmmLint ()\ncheckCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()\ncheckCond dflags (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth dflags = return () -- constant values\ncheckCond _ expr\n    = cmmLintErr (hang (text \"expression is not a conditional:\") 2\n                         (ppr expr))\n\n-- -----------------------------------------------------------------------------\n-- CmmLint monad\n\n-- just a basic error monad:\n\nnewtype CmmLint a = CmmLint { unCL :: DynFlags -> Either SDoc a }\n\ninstance Functor CmmLint where\n      fmap = liftM\n\ninstance Applicative CmmLint where\n      pure a = CmmLint (\\_ -> Right a)\n      (<*>) = ap\n\ninstance Monad CmmLint where\n  CmmLint m >>= k = CmmLint $ \\dflags ->\n                                case m dflags of\n                                Left e -> Left e\n                                Right a -> unCL (k a) dflags\n\ninstance HasDynFlags CmmLint where\n    getDynFlags = CmmLint (\\dflags -> Right dflags)\n\ncmmLintErr :: SDoc -> CmmLint a\ncmmLintErr msg = CmmLint (\\_ -> Left msg)\n\naddLintInfo :: SDoc -> CmmLint a -> CmmLint a\naddLintInfo info thing = CmmLint $ \\dflags ->\n   case unCL thing dflags of\n        Left err -> Left (hang info 2 err)\n        Right a  -> Right a\n\ncmmLintMachOpErr :: CmmExpr -> [CmmType] -> [Width] -> CmmLint a\ncmmLintMachOpErr expr argsRep opExpectsRep\n     = cmmLintErr (text \"in MachOp application: \" $$\n                   nest 2 (ppr  expr) $$\n                      (text \"op is expecting: \" <+> ppr opExpectsRep) $$\n                      (text \"arguments provide: \" <+> ppr argsRep))\n\ncmmLintAssignErr :: CmmNode e x -> CmmType -> CmmType -> CmmLint a\ncmmLintAssignErr stmt e_ty r_ty\n  = cmmLintErr (text \"in assignment: \" $$\n                nest 2 (vcat [ppr stmt,\n                              text \"Reg ty:\" <+> ppr r_ty,\n                              text \"Rhs ty:\" <+> ppr e_ty]))\n\n\n{-\ncmmLintDubiousWordOffset :: CmmExpr -> CmmLint a\ncmmLintDubiousWordOffset expr\n   = cmmLintErr (text \"offset is not a multiple of words: \" $$\n                 nest 2 (ppr expr))\n-}\n\n", "num_lines": 263}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule CmmLive\n    ( CmmLocalLive\n    , cmmLocalLiveness\n    , cmmGlobalLiveness\n    , liveLattice\n    , gen_kill\n    )\nwhere\n\nimport GhcPrelude\n\nimport DynFlags\nimport BlockId\nimport Cmm\nimport PprCmmExpr ()\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Dataflow\nimport Hoopl.Label\n\nimport Maybes\nimport Outputable\n\n-----------------------------------------------------------------------------\n-- Calculating what variables are live on entry to a basic block\n-----------------------------------------------------------------------------\n\n-- | The variables live on entry to a block\ntype CmmLive r = RegSet r\ntype CmmLocalLive = CmmLive LocalReg\n\n-- | The dataflow lattice\nliveLattice :: Ord r => DataflowLattice (CmmLive r)\n{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}\n{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}\nliveLattice = DataflowLattice emptyRegSet add\n  where\n    add (OldFact old) (NewFact new) =\n        let !join = plusRegSet old new\n        in changedIf (sizeRegSet join > sizeRegSet old) join\n\n-- | A mapping from block labels to the variables live on entry\ntype BlockEntryLiveness r = LabelMap (CmmLive r)\n\n-----------------------------------------------------------------------------\n-- | Calculated liveness info for a CmmGraph\n-----------------------------------------------------------------------------\n\ncmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg\ncmmLocalLiveness dflags graph =\n    check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty\n  where\n    entry = g_entry graph\n    check facts =\n        noLiveOnEntry entry (expectJust \"check\" $ mapLookup entry facts) facts\n\ncmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg\ncmmGlobalLiveness dflags graph =\n    analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty\n\n-- | On entry to the procedure, there had better not be any LocalReg's live-in.\nnoLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a\nnoLiveOnEntry bid in_fact x =\n  if nullRegSet in_fact then x\n  else pprPanic \"LocalReg's live-in to graph\" (ppr bid <+> ppr in_fact)\n\ngen_kill\n    :: (DefinerOfRegs r n, UserOfRegs r n)\n    => DynFlags -> n -> CmmLive r -> CmmLive r\ngen_kill dflags node set =\n    let !afterKill = foldRegsDefd dflags deleteFromRegSet set node\n    in foldRegsUsed dflags extendRegSet afterKill node\n{-# INLINE gen_kill #-}\n\nxferLive\n    :: forall r.\n       ( UserOfRegs r (CmmNode O O)\n       , DefinerOfRegs r (CmmNode O O)\n       , UserOfRegs r (CmmNode O C)\n       , DefinerOfRegs r (CmmNode O C)\n       )\n    => DynFlags -> TransferFun (CmmLive r)\nxferLive dflags (BlockCC eNode middle xNode) fBase =\n    let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase\n        !result = foldNodesBwdOO (gen_kill dflags) middle joined\n    in mapSingleton (entryLabel eNode) result\n{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-}\n{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-}\n", "num_lines": 94}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CmmMachOp\n    ( MachOp(..)\n    , pprMachOp, isCommutableMachOp, isAssociativeMachOp\n    , isComparisonMachOp, maybeIntComparison, machOpResultType\n    , machOpArgReps, maybeInvertComparison, isFloatComparison\n\n    -- MachOp builders\n    , mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot\n    , mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem\n    , mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe\n    , mo_wordULe, mo_wordUGt, mo_wordULt\n    , mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot\n    , mo_wordShl, mo_wordSShr, mo_wordUShr\n    , mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32\n    , mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord\n    , mo_u_32ToWord, mo_s_32ToWord\n    , mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64\n\n    -- CallishMachOp\n    , CallishMachOp(..), callishMachOpHints\n    , pprCallishMachOp\n    , machOpMemcpyishAlign\n\n    -- Atomic read-modify-write\n    , AtomicMachOp(..)\n   )\nwhere\n\nimport GhcPrelude\n\nimport CmmType\nimport Outputable\nimport DynFlags\n\n-----------------------------------------------------------------------------\n--              MachOp\n-----------------------------------------------------------------------------\n\n{- |\nMachine-level primops; ones which we can reasonably delegate to the\nnative code generators to handle.\n\nMost operations are parameterised by the 'Width' that they operate on.\nSome operations have separate signed and unsigned versions, and float\nand integer versions.\n-}\n\ndata MachOp\n  -- Integer operations (insensitive to signed/unsigned)\n  = MO_Add Width\n  | MO_Sub Width\n  | MO_Eq  Width\n  | MO_Ne  Width\n  | MO_Mul Width                -- low word of multiply\n\n  -- Signed multiply/divide\n  | MO_S_MulMayOflo Width       -- nonzero if signed multiply overflows\n  | MO_S_Quot Width             -- signed / (same semantics as IntQuotOp)\n  | MO_S_Rem  Width             -- signed % (same semantics as IntRemOp)\n  | MO_S_Neg  Width             -- unary -\n\n  -- Unsigned multiply/divide\n  | MO_U_MulMayOflo Width       -- nonzero if unsigned multiply overflows\n  | MO_U_Quot Width             -- unsigned / (same semantics as WordQuotOp)\n  | MO_U_Rem  Width             -- unsigned % (same semantics as WordRemOp)\n\n  -- Signed comparisons\n  | MO_S_Ge Width\n  | MO_S_Le Width\n  | MO_S_Gt Width\n  | MO_S_Lt Width\n\n  -- Unsigned comparisons\n  | MO_U_Ge Width\n  | MO_U_Le Width\n  | MO_U_Gt Width\n  | MO_U_Lt Width\n\n  -- Floating point arithmetic\n  | MO_F_Add  Width\n  | MO_F_Sub  Width\n  | MO_F_Neg  Width             -- unary -\n  | MO_F_Mul  Width\n  | MO_F_Quot Width\n\n  -- Floating point comparison\n  | MO_F_Eq Width\n  | MO_F_Ne Width\n  | MO_F_Ge Width\n  | MO_F_Le Width\n  | MO_F_Gt Width\n  | MO_F_Lt Width\n\n  -- Bitwise operations.  Not all of these may be supported\n  -- at all sizes, and only integral Widths are valid.\n  | MO_And   Width\n  | MO_Or    Width\n  | MO_Xor   Width\n  | MO_Not   Width\n  | MO_Shl   Width\n  | MO_U_Shr Width      -- unsigned shift right\n  | MO_S_Shr Width      -- signed shift right\n\n  -- Conversions.  Some of these will be NOPs.\n  -- Floating-point conversions use the signed variant.\n  | MO_SF_Conv Width Width      -- Signed int -> Float\n  | MO_FS_Conv Width Width      -- Float -> Signed int\n  | MO_SS_Conv Width Width      -- Signed int -> Signed int\n  | MO_UU_Conv Width Width      -- unsigned int -> unsigned int\n  | MO_XX_Conv Width Width      -- int -> int; puts no requirements on the\n                                -- contents of upper bits when extending;\n                                -- narrowing is simply truncation; the only\n                                -- expectation is that we can recover the\n                                -- original value by applying the opposite\n                                -- MO_XX_Conv, e.g.,\n                                --   MO_XX_CONV W64 W8 (MO_XX_CONV W8 W64 x)\n                                -- is equivalent to just x.\n  | MO_FF_Conv Width Width      -- Float -> Float\n\n  -- Vector element insertion and extraction operations\n  | MO_V_Insert  Length Width   -- Insert scalar into vector\n  | MO_V_Extract Length Width   -- Extract scalar from vector\n\n  -- Integer vector operations\n  | MO_V_Add Length Width\n  | MO_V_Sub Length Width\n  | MO_V_Mul Length Width\n\n  -- Signed vector multiply/divide\n  | MO_VS_Quot Length Width\n  | MO_VS_Rem  Length Width\n  | MO_VS_Neg  Length Width\n\n  -- Unsigned vector multiply/divide\n  | MO_VU_Quot Length Width\n  | MO_VU_Rem  Length Width\n\n  -- Floting point vector element insertion and extraction operations\n  | MO_VF_Insert  Length Width   -- Insert scalar into vector\n  | MO_VF_Extract Length Width   -- Extract scalar from vector\n\n  -- Floating point vector operations\n  | MO_VF_Add  Length Width\n  | MO_VF_Sub  Length Width\n  | MO_VF_Neg  Length Width      -- unary negation\n  | MO_VF_Mul  Length Width\n  | MO_VF_Quot Length Width\n\n  -- Alignment check (for -falignment-sanitisation)\n  | MO_AlignmentCheck Int Width\n  deriving (Eq, Show)\n\npprMachOp :: MachOp -> SDoc\npprMachOp mo = text (show mo)\n\n\n\n-- -----------------------------------------------------------------------------\n-- Some common MachReps\n\n-- A 'wordRep' is a machine word on the target architecture\n-- Specifically, it is the size of an Int#, Word#, Addr#\n-- and the unit of allocation on the stack and the heap\n-- Any pointer is also guaranteed to be a wordRep.\n\nmo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot\n    , mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem\n    , mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe\n    , mo_wordULe, mo_wordUGt, mo_wordULt\n    , mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr\n    , mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord\n    , mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64\n    :: DynFlags -> MachOp\n\nmo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32\n    , mo_32To8, mo_32To16\n    :: MachOp\n\nmo_wordAdd      dflags = MO_Add (wordWidth dflags)\nmo_wordSub      dflags = MO_Sub (wordWidth dflags)\nmo_wordEq       dflags = MO_Eq  (wordWidth dflags)\nmo_wordNe       dflags = MO_Ne  (wordWidth dflags)\nmo_wordMul      dflags = MO_Mul (wordWidth dflags)\nmo_wordSQuot    dflags = MO_S_Quot (wordWidth dflags)\nmo_wordSRem     dflags = MO_S_Rem (wordWidth dflags)\nmo_wordSNeg     dflags = MO_S_Neg (wordWidth dflags)\nmo_wordUQuot    dflags = MO_U_Quot (wordWidth dflags)\nmo_wordURem     dflags = MO_U_Rem (wordWidth dflags)\n\nmo_wordSGe      dflags = MO_S_Ge  (wordWidth dflags)\nmo_wordSLe      dflags = MO_S_Le  (wordWidth dflags)\nmo_wordSGt      dflags = MO_S_Gt  (wordWidth dflags)\nmo_wordSLt      dflags = MO_S_Lt  (wordWidth dflags)\n\nmo_wordUGe      dflags = MO_U_Ge  (wordWidth dflags)\nmo_wordULe      dflags = MO_U_Le  (wordWidth dflags)\nmo_wordUGt      dflags = MO_U_Gt  (wordWidth dflags)\nmo_wordULt      dflags = MO_U_Lt  (wordWidth dflags)\n\nmo_wordAnd      dflags = MO_And (wordWidth dflags)\nmo_wordOr       dflags = MO_Or  (wordWidth dflags)\nmo_wordXor      dflags = MO_Xor (wordWidth dflags)\nmo_wordNot      dflags = MO_Not (wordWidth dflags)\nmo_wordShl      dflags = MO_Shl (wordWidth dflags)\nmo_wordSShr     dflags = MO_S_Shr (wordWidth dflags)\nmo_wordUShr     dflags = MO_U_Shr (wordWidth dflags)\n\nmo_u_8To32             = MO_UU_Conv W8 W32\nmo_s_8To32             = MO_SS_Conv W8 W32\nmo_u_16To32            = MO_UU_Conv W16 W32\nmo_s_16To32            = MO_SS_Conv W16 W32\n\nmo_u_8ToWord    dflags = MO_UU_Conv W8  (wordWidth dflags)\nmo_s_8ToWord    dflags = MO_SS_Conv W8  (wordWidth dflags)\nmo_u_16ToWord   dflags = MO_UU_Conv W16 (wordWidth dflags)\nmo_s_16ToWord   dflags = MO_SS_Conv W16 (wordWidth dflags)\nmo_s_32ToWord   dflags = MO_SS_Conv W32 (wordWidth dflags)\nmo_u_32ToWord   dflags = MO_UU_Conv W32 (wordWidth dflags)\n\nmo_WordTo8      dflags = MO_UU_Conv (wordWidth dflags) W8\nmo_WordTo16     dflags = MO_UU_Conv (wordWidth dflags) W16\nmo_WordTo32     dflags = MO_UU_Conv (wordWidth dflags) W32\nmo_WordTo64     dflags = MO_UU_Conv (wordWidth dflags) W64\n\nmo_32To8               = MO_UU_Conv W32 W8\nmo_32To16              = MO_UU_Conv W32 W16\n\n\n-- ----------------------------------------------------------------------------\n-- isCommutableMachOp\n\n{- |\nReturns 'True' if the MachOp has commutable arguments.  This is used\nin the platform-independent Cmm optimisations.\n\nIf in doubt, return 'False'.  This generates worse code on the\nnative routes, but is otherwise harmless.\n-}\nisCommutableMachOp :: MachOp -> Bool\nisCommutableMachOp mop =\n  case mop of\n        MO_Add _                -> True\n        MO_Eq _                 -> True\n        MO_Ne _                 -> True\n        MO_Mul _                -> True\n        MO_S_MulMayOflo _       -> True\n        MO_U_MulMayOflo _       -> True\n        MO_And _                -> True\n        MO_Or _                 -> True\n        MO_Xor _                -> True\n        MO_F_Add _              -> True\n        MO_F_Mul _              -> True\n        _other                  -> False\n\n-- ----------------------------------------------------------------------------\n-- isAssociativeMachOp\n\n{- |\nReturns 'True' if the MachOp is associative (i.e. @(x+y)+z == x+(y+z)@)\nThis is used in the platform-independent Cmm optimisations.\n\nIf in doubt, return 'False'.  This generates worse code on the\nnative routes, but is otherwise harmless.\n-}\nisAssociativeMachOp :: MachOp -> Bool\nisAssociativeMachOp mop =\n  case mop of\n        MO_Add {} -> True       -- NB: does not include\n        MO_Mul {} -> True --     floatint point!\n        MO_And {} -> True\n        MO_Or  {} -> True\n        MO_Xor {} -> True\n        _other    -> False\n\n\n-- ----------------------------------------------------------------------------\n-- isComparisonMachOp\n\n{- |\nReturns 'True' if the MachOp is a comparison.\n\nIf in doubt, return False.  This generates worse code on the\nnative routes, but is otherwise harmless.\n-}\nisComparisonMachOp :: MachOp -> Bool\nisComparisonMachOp mop =\n  case mop of\n    MO_Eq   _  -> True\n    MO_Ne   _  -> True\n    MO_S_Ge _  -> True\n    MO_S_Le _  -> True\n    MO_S_Gt _  -> True\n    MO_S_Lt _  -> True\n    MO_U_Ge _  -> True\n    MO_U_Le _  -> True\n    MO_U_Gt _  -> True\n    MO_U_Lt _  -> True\n    MO_F_Eq {} -> True\n    MO_F_Ne {} -> True\n    MO_F_Ge {} -> True\n    MO_F_Le {} -> True\n    MO_F_Gt {} -> True\n    MO_F_Lt {} -> True\n    _other     -> False\n\n{- |\nReturns @Just w@ if the operation is an integer comparison with width\n@w@, or @Nothing@ otherwise.\n-}\nmaybeIntComparison :: MachOp -> Maybe Width\nmaybeIntComparison mop =\n  case mop of\n    MO_Eq   w  -> Just w\n    MO_Ne   w  -> Just w\n    MO_S_Ge w  -> Just w\n    MO_S_Le w  -> Just w\n    MO_S_Gt w  -> Just w\n    MO_S_Lt w  -> Just w\n    MO_U_Ge w  -> Just w\n    MO_U_Le w  -> Just w\n    MO_U_Gt w  -> Just w\n    MO_U_Lt w  -> Just w\n    _ -> Nothing\n\nisFloatComparison :: MachOp -> Bool\nisFloatComparison mop =\n  case mop of\n    MO_F_Eq {} -> True\n    MO_F_Ne {} -> True\n    MO_F_Ge {} -> True\n    MO_F_Le {} -> True\n    MO_F_Gt {} -> True\n    MO_F_Lt {} -> True\n    _other     -> False\n\n-- -----------------------------------------------------------------------------\n-- Inverting conditions\n\n-- Sometimes it's useful to be able to invert the sense of a\n-- condition.  Not all conditional tests are invertible: in\n-- particular, floating point conditionals cannot be inverted, because\n-- there exist floating-point values which return False for both senses\n-- of a condition (eg. !(NaN > NaN) && !(NaN /<= NaN)).\n\nmaybeInvertComparison :: MachOp -> Maybe MachOp\nmaybeInvertComparison op\n  = case op of  -- None of these Just cases include floating point\n        MO_Eq r   -> Just (MO_Ne r)\n        MO_Ne r   -> Just (MO_Eq r)\n        MO_U_Lt r -> Just (MO_U_Ge r)\n        MO_U_Gt r -> Just (MO_U_Le r)\n        MO_U_Le r -> Just (MO_U_Gt r)\n        MO_U_Ge r -> Just (MO_U_Lt r)\n        MO_S_Lt r -> Just (MO_S_Ge r)\n        MO_S_Gt r -> Just (MO_S_Le r)\n        MO_S_Le r -> Just (MO_S_Gt r)\n        MO_S_Ge r -> Just (MO_S_Lt r)\n        _other    -> Nothing\n\n-- ----------------------------------------------------------------------------\n-- machOpResultType\n\n{- |\nReturns the MachRep of the result of a MachOp.\n-}\nmachOpResultType :: DynFlags -> MachOp -> [CmmType] -> CmmType\nmachOpResultType dflags mop tys =\n  case mop of\n    MO_Add {}           -> ty1  -- Preserve GC-ptr-hood\n    MO_Sub {}           -> ty1  -- of first arg\n    MO_Mul    r         -> cmmBits r\n    MO_S_MulMayOflo r   -> cmmBits r\n    MO_S_Quot r         -> cmmBits r\n    MO_S_Rem  r         -> cmmBits r\n    MO_S_Neg  r         -> cmmBits r\n    MO_U_MulMayOflo r   -> cmmBits r\n    MO_U_Quot r         -> cmmBits r\n    MO_U_Rem  r         -> cmmBits r\n\n    MO_Eq {}            -> comparisonResultRep dflags\n    MO_Ne {}            -> comparisonResultRep dflags\n    MO_S_Ge {}          -> comparisonResultRep dflags\n    MO_S_Le {}          -> comparisonResultRep dflags\n    MO_S_Gt {}          -> comparisonResultRep dflags\n    MO_S_Lt {}          -> comparisonResultRep dflags\n\n    MO_U_Ge {}          -> comparisonResultRep dflags\n    MO_U_Le {}          -> comparisonResultRep dflags\n    MO_U_Gt {}          -> comparisonResultRep dflags\n    MO_U_Lt {}          -> comparisonResultRep dflags\n\n    MO_F_Add r          -> cmmFloat r\n    MO_F_Sub r          -> cmmFloat r\n    MO_F_Mul r          -> cmmFloat r\n    MO_F_Quot r         -> cmmFloat r\n    MO_F_Neg r          -> cmmFloat r\n    MO_F_Eq  {}         -> comparisonResultRep dflags\n    MO_F_Ne  {}         -> comparisonResultRep dflags\n    MO_F_Ge  {}         -> comparisonResultRep dflags\n    MO_F_Le  {}         -> comparisonResultRep dflags\n    MO_F_Gt  {}         -> comparisonResultRep dflags\n    MO_F_Lt  {}         -> comparisonResultRep dflags\n\n    MO_And {}           -> ty1  -- Used for pointer masking\n    MO_Or {}            -> ty1\n    MO_Xor {}           -> ty1\n    MO_Not   r          -> cmmBits r\n    MO_Shl   r          -> cmmBits r\n    MO_U_Shr r          -> cmmBits r\n    MO_S_Shr r          -> cmmBits r\n\n    MO_SS_Conv _ to     -> cmmBits to\n    MO_UU_Conv _ to     -> cmmBits to\n    MO_XX_Conv _ to     -> cmmBits to\n    MO_FS_Conv _ to     -> cmmBits to\n    MO_SF_Conv _ to     -> cmmFloat to\n    MO_FF_Conv _ to     -> cmmFloat to\n\n    MO_V_Insert  l w    -> cmmVec l (cmmBits w)\n    MO_V_Extract _ w    -> cmmBits w\n\n    MO_V_Add l w        -> cmmVec l (cmmBits w)\n    MO_V_Sub l w        -> cmmVec l (cmmBits w)\n    MO_V_Mul l w        -> cmmVec l (cmmBits w)\n\n    MO_VS_Quot l w      -> cmmVec l (cmmBits w)\n    MO_VS_Rem  l w      -> cmmVec l (cmmBits w)\n    MO_VS_Neg  l w      -> cmmVec l (cmmBits w)\n\n    MO_VU_Quot l w      -> cmmVec l (cmmBits w)\n    MO_VU_Rem  l w      -> cmmVec l (cmmBits w)\n\n    MO_VF_Insert  l w   -> cmmVec l (cmmFloat w)\n    MO_VF_Extract _ w   -> cmmFloat w\n\n    MO_VF_Add  l w      -> cmmVec l (cmmFloat w)\n    MO_VF_Sub  l w      -> cmmVec l (cmmFloat w)\n    MO_VF_Mul  l w      -> cmmVec l (cmmFloat w)\n    MO_VF_Quot l w      -> cmmVec l (cmmFloat w)\n    MO_VF_Neg  l w      -> cmmVec l (cmmFloat w)\n\n    MO_AlignmentCheck _ _ -> ty1\n  where\n    (ty1:_) = tys\n\ncomparisonResultRep :: DynFlags -> CmmType\ncomparisonResultRep = bWord  -- is it?\n\n\n-- -----------------------------------------------------------------------------\n-- machOpArgReps\n\n-- | This function is used for debugging only: we can check whether an\n-- application of a MachOp is \"type-correct\" by checking that the MachReps of\n-- its arguments are the same as the MachOp expects.  This is used when\n-- linting a CmmExpr.\n\nmachOpArgReps :: DynFlags -> MachOp -> [Width]\nmachOpArgReps dflags op =\n  case op of\n    MO_Add    r         -> [r,r]\n    MO_Sub    r         -> [r,r]\n    MO_Eq     r         -> [r,r]\n    MO_Ne     r         -> [r,r]\n    MO_Mul    r         -> [r,r]\n    MO_S_MulMayOflo r   -> [r,r]\n    MO_S_Quot r         -> [r,r]\n    MO_S_Rem  r         -> [r,r]\n    MO_S_Neg  r         -> [r]\n    MO_U_MulMayOflo r   -> [r,r]\n    MO_U_Quot r         -> [r,r]\n    MO_U_Rem  r         -> [r,r]\n\n    MO_S_Ge r           -> [r,r]\n    MO_S_Le r           -> [r,r]\n    MO_S_Gt r           -> [r,r]\n    MO_S_Lt r           -> [r,r]\n\n    MO_U_Ge r           -> [r,r]\n    MO_U_Le r           -> [r,r]\n    MO_U_Gt r           -> [r,r]\n    MO_U_Lt r           -> [r,r]\n\n    MO_F_Add r          -> [r,r]\n    MO_F_Sub r          -> [r,r]\n    MO_F_Mul r          -> [r,r]\n    MO_F_Quot r         -> [r,r]\n    MO_F_Neg r          -> [r]\n    MO_F_Eq  r          -> [r,r]\n    MO_F_Ne  r          -> [r,r]\n    MO_F_Ge  r          -> [r,r]\n    MO_F_Le  r          -> [r,r]\n    MO_F_Gt  r          -> [r,r]\n    MO_F_Lt  r          -> [r,r]\n\n    MO_And   r          -> [r,r]\n    MO_Or    r          -> [r,r]\n    MO_Xor   r          -> [r,r]\n    MO_Not   r          -> [r]\n    MO_Shl   r          -> [r, wordWidth dflags]\n    MO_U_Shr r          -> [r, wordWidth dflags]\n    MO_S_Shr r          -> [r, wordWidth dflags]\n\n    MO_SS_Conv from _   -> [from]\n    MO_UU_Conv from _   -> [from]\n    MO_XX_Conv from _   -> [from]\n    MO_SF_Conv from _   -> [from]\n    MO_FS_Conv from _   -> [from]\n    MO_FF_Conv from _   -> [from]\n\n    MO_V_Insert  l r    -> [typeWidth (vec l (cmmBits r)),r,wordWidth dflags]\n    MO_V_Extract l r    -> [typeWidth (vec l (cmmBits r)),wordWidth dflags]\n\n    MO_V_Add _ r        -> [r,r]\n    MO_V_Sub _ r        -> [r,r]\n    MO_V_Mul _ r        -> [r,r]\n\n    MO_VS_Quot _ r      -> [r,r]\n    MO_VS_Rem  _ r      -> [r,r]\n    MO_VS_Neg  _ r      -> [r]\n\n    MO_VU_Quot _ r      -> [r,r]\n    MO_VU_Rem  _ r      -> [r,r]\n\n    MO_VF_Insert  l r   -> [typeWidth (vec l (cmmFloat r)),r,wordWidth dflags]\n    MO_VF_Extract l r   -> [typeWidth (vec l (cmmFloat r)),wordWidth dflags]\n\n    MO_VF_Add  _ r      -> [r,r]\n    MO_VF_Sub  _ r      -> [r,r]\n    MO_VF_Mul  _ r      -> [r,r]\n    MO_VF_Quot _ r      -> [r,r]\n    MO_VF_Neg  _ r      -> [r]\n\n    MO_AlignmentCheck _ r -> [r]\n\n-----------------------------------------------------------------------------\n-- CallishMachOp\n-----------------------------------------------------------------------------\n\n-- CallishMachOps tend to be implemented by foreign calls in some backends,\n-- so we separate them out.  In Cmm, these can only occur in a\n-- statement position, in contrast to an ordinary MachOp which can occur\n-- anywhere in an expression.\ndata CallishMachOp\n  = MO_F64_Pwr\n  | MO_F64_Sin\n  | MO_F64_Cos\n  | MO_F64_Tan\n  | MO_F64_Sinh\n  | MO_F64_Cosh\n  | MO_F64_Tanh\n  | MO_F64_Asin\n  | MO_F64_Acos\n  | MO_F64_Atan\n  | MO_F64_Asinh\n  | MO_F64_Acosh\n  | MO_F64_Atanh\n  | MO_F64_Log\n  | MO_F64_Exp\n  | MO_F64_Fabs\n  | MO_F64_Sqrt\n  | MO_F32_Pwr\n  | MO_F32_Sin\n  | MO_F32_Cos\n  | MO_F32_Tan\n  | MO_F32_Sinh\n  | MO_F32_Cosh\n  | MO_F32_Tanh\n  | MO_F32_Asin\n  | MO_F32_Acos\n  | MO_F32_Atan\n  | MO_F32_Asinh\n  | MO_F32_Acosh\n  | MO_F32_Atanh\n  | MO_F32_Log\n  | MO_F32_Exp\n  | MO_F32_Fabs\n  | MO_F32_Sqrt\n\n  | MO_UF_Conv Width\n\n  | MO_S_QuotRem Width\n  | MO_U_QuotRem Width\n  | MO_U_QuotRem2 Width\n  | MO_Add2      Width\n  | MO_AddWordC  Width\n  | MO_SubWordC  Width\n  | MO_AddIntC   Width\n  | MO_SubIntC   Width\n  | MO_U_Mul2    Width\n\n  | MO_WriteBarrier\n  | MO_Touch         -- Keep variables live (when using interior pointers)\n\n  -- Prefetch\n  | MO_Prefetch_Data Int -- Prefetch hint. May change program performance but not\n                     -- program behavior.\n                     -- the Int can be 0-3. Needs to be known at compile time\n                     -- to interact with code generation correctly.\n                     --  TODO: add support for prefetch WRITES,\n                     --  currently only exposes prefetch reads, which\n                     -- would the majority of use cases in ghc anyways\n\n\n  -- These three MachOps are parameterised by the known alignment\n  -- of the destination and source (for memcpy/memmove) pointers.\n  -- This information may be used for optimisation in backends.\n  | MO_Memcpy Int\n  | MO_Memset Int\n  | MO_Memmove Int\n  | MO_Memcmp Int\n\n  | MO_PopCnt Width\n  | MO_Pdep Width\n  | MO_Pext Width\n  | MO_Clz Width\n  | MO_Ctz Width\n\n  | MO_BSwap Width\n\n  -- Atomic read-modify-write.\n  | MO_AtomicRMW Width AtomicMachOp\n  | MO_AtomicRead Width\n  | MO_AtomicWrite Width\n  | MO_Cmpxchg Width\n  deriving (Eq, Show)\n\n-- | The operation to perform atomically.\ndata AtomicMachOp =\n      AMO_Add\n    | AMO_Sub\n    | AMO_And\n    | AMO_Nand\n    | AMO_Or\n    | AMO_Xor\n      deriving (Eq, Show)\n\npprCallishMachOp :: CallishMachOp -> SDoc\npprCallishMachOp mo = text (show mo)\n\ncallishMachOpHints :: CallishMachOp -> ([ForeignHint], [ForeignHint])\ncallishMachOpHints op = case op of\n  MO_Memcpy _  -> ([], [AddrHint,AddrHint,NoHint])\n  MO_Memset _  -> ([], [AddrHint,NoHint,NoHint])\n  MO_Memmove _ -> ([], [AddrHint,AddrHint,NoHint])\n  MO_Memcmp _  -> ([], [AddrHint, AddrHint, NoHint])\n  _            -> ([],[])\n  -- empty lists indicate NoHint\n\n-- | The alignment of a 'memcpy'-ish operation.\nmachOpMemcpyishAlign :: CallishMachOp -> Maybe Int\nmachOpMemcpyishAlign op = case op of\n  MO_Memcpy  align -> Just align\n  MO_Memset  align -> Just align\n  MO_Memmove align -> Just align\n  MO_Memcmp  align -> Just align\n  _                -> Nothing\n", "num_lines": 658}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n-- A Parser monad with access to the 'DynFlags'.\n--\n-- The 'P' monad  only has access to the subset of of 'DynFlags'\n-- required for parsing Haskell.\n\n-- The parser for C-- requires access to a lot more of the 'DynFlags',\n-- so 'PD' provides access to 'DynFlags' via a 'HasDynFlags' instance.\n-----------------------------------------------------------------------------\nmodule CmmMonad (\n    PD(..)\n  , liftP\n  ) where\n\nimport GhcPrelude\n\nimport Control.Monad\nimport qualified Control.Monad.Fail as MonadFail\n\nimport DynFlags\nimport Lexer\n\nnewtype PD a = PD { unPD :: DynFlags -> PState -> ParseResult a }\n\ninstance Functor PD where\n  fmap = liftM\n\ninstance Applicative PD where\n  pure = returnPD\n  (<*>) = ap\n\ninstance Monad PD where\n  (>>=) = thenPD\n#if !MIN_VERSION_base(4,13,0)\n  fail = MonadFail.fail\n#endif\n\ninstance MonadFail.MonadFail PD where\n  fail = failPD\n\nliftP :: P a -> PD a\nliftP (P f) = PD $ \\_ s -> f s\n\nreturnPD :: a -> PD a\nreturnPD = liftP . return\n\nthenPD :: PD a -> (a -> PD b) -> PD b\n(PD m) `thenPD` k = PD $ \\d s ->\n        case m d s of\n                POk s1 a         -> unPD (k a) d s1\n                PFailed s1 -> PFailed s1\n\nfailPD :: String -> PD a\nfailPD = liftP . fail\n\ninstance HasDynFlags PD where\n   getDynFlags = PD $ \\d s -> POk s d\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n\n-- CmmNode type for representation using Hoopl graphs.\n\nmodule CmmNode (\n     CmmNode(..), CmmFormal, CmmActual, CmmTickish,\n     UpdFrameOffset, Convention(..),\n     ForeignConvention(..), ForeignTarget(..), foreignTargetHints,\n     CmmReturnInfo(..),\n     mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf,\n     mapExpM, mapExpDeepM, wrapRecExpM, mapSuccessors, mapCollectSuccessors,\n\n     -- * Tick scopes\n     CmmTickScope(..), isTickSubScope, combineTickScopes,\n  ) where\n\nimport GhcPrelude hiding (succ)\n\nimport CodeGen.Platform\nimport CmmExpr\nimport CmmSwitch\nimport DynFlags\nimport FastString\nimport ForeignCall\nimport Outputable\nimport SMRep\nimport CoreSyn (Tickish)\nimport qualified Unique as U\n\nimport Hoopl.Block\nimport Hoopl.Graph\nimport Hoopl.Collections\nimport Hoopl.Label\nimport Data.Maybe\nimport Data.List (tails,sortBy)\nimport Unique (nonDetCmpUnique)\nimport Util\n\n\n------------------------\n-- CmmNode\n\n#define ULabel {-# UNPACK #-} !Label\n\ndata CmmNode e x where\n  CmmEntry :: ULabel -> CmmTickScope -> CmmNode C O\n\n  CmmComment :: FastString -> CmmNode O O\n\n    -- Tick annotation, covering Cmm code in our tick scope. We only\n    -- expect non-code @Tickish@ at this point (e.g. @SourceNote@).\n    -- See Note [CmmTick scoping details]\n  CmmTick :: !CmmTickish -> CmmNode O O\n\n    -- Unwind pseudo-instruction, encoding stack unwinding\n    -- instructions for a debugger. This describes how to reconstruct\n    -- the \"old\" value of a register if we want to navigate the stack\n    -- up one frame. Having unwind information for @Sp@ will allow the\n    -- debugger to \"walk\" the stack.\n    --\n    -- See Note [What is this unwinding business?] in Debug\n  CmmUnwind :: [(GlobalReg, Maybe CmmExpr)] -> CmmNode O O\n\n  CmmAssign :: !CmmReg -> !CmmExpr -> CmmNode O O\n    -- Assign to register\n\n  CmmStore :: !CmmExpr -> !CmmExpr -> CmmNode O O\n    -- Assign to memory location.  Size is\n    -- given by cmmExprType of the rhs.\n\n  CmmUnsafeForeignCall ::       -- An unsafe foreign call;\n                                -- see Note [Foreign calls]\n                                -- Like a \"fat machine instruction\"; can occur\n                                -- in the middle of a block\n      ForeignTarget ->          -- call target\n      [CmmFormal] ->            -- zero or more results\n      [CmmActual] ->            -- zero or more arguments\n      CmmNode O O\n      -- Semantics: clobbers any GlobalRegs for which callerSaves r == True\n      -- See Note [Unsafe foreign calls clobber caller-save registers]\n      --\n      -- Invariant: the arguments and the ForeignTarget must not\n      -- mention any registers for which CodeGen.Platform.callerSaves\n      -- is True.  See Note [Register Parameter Passing].\n\n  CmmBranch :: ULabel -> CmmNode O C\n                                   -- Goto another block in the same procedure\n\n  CmmCondBranch :: {                 -- conditional branch\n      cml_pred :: CmmExpr,\n      cml_true, cml_false :: ULabel,\n      cml_likely :: Maybe Bool       -- likely result of the conditional,\n                                     -- if known\n  } -> CmmNode O C\n\n  CmmSwitch\n    :: CmmExpr       -- Scrutinee, of some integral type\n    -> SwitchTargets -- Cases. See [Note SwitchTargets]\n    -> CmmNode O C\n\n  CmmCall :: {                -- A native call or tail call\n      cml_target :: CmmExpr,  -- never a CmmPrim to a CallishMachOp!\n\n      cml_cont :: Maybe Label,\n          -- Label of continuation (Nothing for return or tail call)\n          --\n          -- Note [Continuation BlockId]: these BlockIds are called\n          -- Continuation BlockIds, and are the only BlockIds that can\n          -- occur in CmmExprs, namely as (CmmLit (CmmBlock b)) or\n          -- (CmmStackSlot (Young b) _).\n\n      cml_args_regs :: [GlobalReg],\n          -- The argument GlobalRegs (Rx, Fx, Dx, Lx) that are passed\n          -- to the call.  This is essential information for the\n          -- native code generator's register allocator; without\n          -- knowing which GlobalRegs are live it has to assume that\n          -- they are all live.  This list should only include\n          -- GlobalRegs that are mapped to real machine registers on\n          -- the target platform.\n\n      cml_args :: ByteOff,\n          -- Byte offset, from the *old* end of the Area associated with\n          -- the Label (if cml_cont = Nothing, then Old area), of\n          -- youngest outgoing arg.  Set the stack pointer to this before\n          -- transferring control.\n          -- (NB: an update frame might also have been stored in the Old\n          --      area, but it'll be in an older part than the args.)\n\n      cml_ret_args :: ByteOff,\n          -- For calls *only*, the byte offset for youngest returned value\n          -- This is really needed at the *return* point rather than here\n          -- at the call, but in practice it's convenient to record it here.\n\n      cml_ret_off :: ByteOff\n        -- For calls *only*, the byte offset of the base of the frame that\n        -- must be described by the info table for the return point.\n        -- The older words are an update frames, which have their own\n        -- info-table and layout information\n\n        -- From a liveness point of view, the stack words older than\n        -- cml_ret_off are treated as live, even if the sequel of\n        -- the call goes into a loop.\n  } -> CmmNode O C\n\n  CmmForeignCall :: {           -- A safe foreign call; see Note [Foreign calls]\n                                -- Always the last node of a block\n      tgt   :: ForeignTarget,   -- call target and convention\n      res   :: [CmmFormal],     -- zero or more results\n      args  :: [CmmActual],     -- zero or more arguments; see Note [Register parameter passing]\n      succ  :: ULabel,          -- Label of continuation\n      ret_args :: ByteOff,      -- same as cml_ret_args\n      ret_off :: ByteOff,       -- same as cml_ret_off\n      intrbl:: Bool             -- whether or not the call is interruptible\n  } -> CmmNode O C\n\n{- Note [Foreign calls]\n~~~~~~~~~~~~~~~~~~~~~~~\nA CmmUnsafeForeignCall is used for *unsafe* foreign calls;\na CmmForeignCall call is used for *safe* foreign calls.\n\nUnsafe ones are mostly easy: think of them as a \"fat machine\ninstruction\".  In particular, they do *not* kill all live registers,\njust the registers they return to (there was a bit of code in GHC that\nconservatively assumed otherwise.)  However, see [Register parameter passing].\n\nSafe ones are trickier.  A safe foreign call\n     r = f(x)\nultimately expands to\n     push \"return address\"      -- Never used to return to;\n                                -- just points an info table\n     save registers into TSO\n     call suspendThread\n     r = f(x)                   -- Make the call\n     call resumeThread\n     restore registers\n     pop \"return address\"\nWe cannot \"lower\" a safe foreign call to this sequence of Cmms, because\nafter we've saved Sp all the Cmm optimiser's assumptions are broken.\n\nNote that a safe foreign call needs an info table.\n\nSo Safe Foreign Calls must remain as last nodes until the stack is\nmade manifest in CmmLayoutStack, where they are lowered into the above\nsequence.\n-}\n\n{- Note [Unsafe foreign calls clobber caller-save registers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA foreign call is defined to clobber any GlobalRegs that are mapped to\ncaller-saves machine registers (according to the prevailing C ABI).\nStgCmmUtils.callerSaves tells you which GlobalRegs are caller-saves.\n\nThis is a design choice that makes it easier to generate code later.\nWe could instead choose to say that foreign calls do *not* clobber\ncaller-saves regs, but then we would have to figure out which regs\nwere live across the call later and insert some saves/restores.\n\nFurthermore when we generate code we never have any GlobalRegs live\nacross a call, because they are always copied-in to LocalRegs and\ncopied-out again before making a call/jump.  So all we have to do is\navoid any code motion that would make a caller-saves GlobalReg live\nacross a foreign call during subsequent optimisations.\n-}\n\n{- Note [Register parameter passing]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOn certain architectures, some registers are utilized for parameter\npassing in the C calling convention.  For example, in x86-64 Linux\nconvention, rdi, rsi, rdx and rcx (as well as r8 and r9) may be used for\nargument passing.  These are registers R3-R6, which our generated\ncode may also be using; as a result, it's necessary to save these\nvalues before doing a foreign call.  This is done during initial\ncode generation in callerSaveVolatileRegs in StgCmmUtils.hs.  However,\none result of doing this is that the contents of these registers\nmay mysteriously change if referenced inside the arguments.  This\nis dangerous, so you'll need to disable inlining much in the same\nway is done in cmm/CmmOpt.hs currently.  We should fix this!\n-}\n\n---------------------------------------------\n-- Eq instance of CmmNode\n\nderiving instance Eq (CmmNode e x)\n\n----------------------------------------------\n-- Hoopl instances of CmmNode\n\ninstance NonLocal CmmNode where\n  entryLabel (CmmEntry l _) = l\n\n  successors (CmmBranch l) = [l]\n  successors (CmmCondBranch {cml_true=t, cml_false=f}) = [f, t] -- meets layout constraint\n  successors (CmmSwitch _ ids) = switchTargetsToList ids\n  successors (CmmCall {cml_cont=l}) = maybeToList l\n  successors (CmmForeignCall {succ=l}) = [l]\n\n\n--------------------------------------------------\n-- Various helper types\n\ntype CmmActual = CmmExpr\ntype CmmFormal = LocalReg\n\ntype UpdFrameOffset = ByteOff\n\n-- | A convention maps a list of values (function arguments or return\n-- values) to registers or stack locations.\ndata Convention\n  = NativeDirectCall\n       -- ^ top-level Haskell functions use @NativeDirectCall@, which\n       -- maps arguments to registers starting with R2, according to\n       -- how many registers are available on the platform.  This\n       -- convention ignores R1, because for a top-level function call\n       -- the function closure is implicit, and doesn't need to be passed.\n  | NativeNodeCall\n       -- ^ non-top-level Haskell functions, which pass the address of\n       -- the function closure in R1 (regardless of whether R1 is a\n       -- real register or not), and the rest of the arguments in\n       -- registers or on the stack.\n  | NativeReturn\n       -- ^ a native return.  The convention for returns depends on\n       -- how many values are returned: for just one value returned,\n       -- the appropriate register is used (R1, F1, etc.). regardless\n       -- of whether it is a real register or not.  For multiple\n       -- values returned, they are mapped to registers or the stack.\n  | Slow\n       -- ^ Slow entry points: all args pushed on the stack\n  | GC\n       -- ^ Entry to the garbage collector: uses the node reg!\n       -- (TODO: I don't think we need this --SDM)\n  deriving( Eq )\n\ndata ForeignConvention\n  = ForeignConvention\n        CCallConv               -- Which foreign-call convention\n        [ForeignHint]           -- Extra info about the args\n        [ForeignHint]           -- Extra info about the result\n        CmmReturnInfo\n  deriving Eq\n\ndata CmmReturnInfo\n  = CmmMayReturn\n  | CmmNeverReturns\n  deriving ( Eq )\n\ndata ForeignTarget        -- The target of a foreign call\n  = ForeignTarget                -- A foreign procedure\n        CmmExpr                  -- Its address\n        ForeignConvention        -- Its calling convention\n  | PrimTarget            -- A possibly-side-effecting machine operation\n        CallishMachOp            -- Which one\n  deriving Eq\n\nforeignTargetHints :: ForeignTarget -> ([ForeignHint], [ForeignHint])\nforeignTargetHints target\n  = ( res_hints ++ repeat NoHint\n    , arg_hints ++ repeat NoHint )\n  where\n    (res_hints, arg_hints) =\n       case target of\n          PrimTarget op -> callishMachOpHints op\n          ForeignTarget _ (ForeignConvention _ arg_hints res_hints _) ->\n             (res_hints, arg_hints)\n\n--------------------------------------------------\n-- Instances of register and slot users / definers\n\ninstance UserOfRegs LocalReg (CmmNode e x) where\n  foldRegsUsed dflags f !z n = case n of\n    CmmAssign _ expr -> fold f z expr\n    CmmStore addr rval -> fold f (fold f z addr) rval\n    CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args\n    CmmCondBranch expr _ _ _ -> fold f z expr\n    CmmSwitch expr _ -> fold f z expr\n    CmmCall {cml_target=tgt} -> fold f z tgt\n    CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args\n    _ -> z\n    where fold :: forall a b. UserOfRegs LocalReg a\n               => (b -> LocalReg -> b) -> b -> a -> b\n          fold f z n = foldRegsUsed dflags f z n\n\ninstance UserOfRegs GlobalReg (CmmNode e x) where\n  foldRegsUsed dflags f !z n = case n of\n    CmmAssign _ expr -> fold f z expr\n    CmmStore addr rval -> fold f (fold f z addr) rval\n    CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args\n    CmmCondBranch expr _ _ _ -> fold f z expr\n    CmmSwitch expr _ -> fold f z expr\n    CmmCall {cml_target=tgt, cml_args_regs=args} -> fold f (fold f z args) tgt\n    CmmForeignCall {tgt=tgt, args=args} -> fold f (fold f z tgt) args\n    _ -> z\n    where fold :: forall a b.  UserOfRegs GlobalReg a\n               => (b -> GlobalReg -> b) -> b -> a -> b\n          fold f z n = foldRegsUsed dflags f z n\n\ninstance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where\n  -- The (Ord r) in the context is necessary here\n  -- See Note [Recursive superclasses] in TcInstDcls\n  foldRegsUsed _      _ !z (PrimTarget _)      = z\n  foldRegsUsed dflags f !z (ForeignTarget e _) = foldRegsUsed dflags f z e\n\ninstance DefinerOfRegs LocalReg (CmmNode e x) where\n  foldRegsDefd dflags f !z n = case n of\n    CmmAssign lhs _ -> fold f z lhs\n    CmmUnsafeForeignCall _ fs _ -> fold f z fs\n    CmmForeignCall {res=res} -> fold f z res\n    _ -> z\n    where fold :: forall a b. DefinerOfRegs LocalReg a\n               => (b -> LocalReg -> b) -> b -> a -> b\n          fold f z n = foldRegsDefd dflags f z n\n\ninstance DefinerOfRegs GlobalReg (CmmNode e x) where\n  foldRegsDefd dflags f !z n = case n of\n    CmmAssign lhs _ -> fold f z lhs\n    CmmUnsafeForeignCall tgt _ _  -> fold f z (foreignTargetRegs tgt)\n    CmmCall        {} -> fold f z activeRegs\n    CmmForeignCall {} -> fold f z activeRegs\n                      -- See Note [Safe foreign calls clobber STG registers]\n    _ -> z\n    where fold :: forall a b. DefinerOfRegs GlobalReg a\n               => (b -> GlobalReg -> b) -> b -> a -> b\n          fold f z n = foldRegsDefd dflags f z n\n\n          platform = targetPlatform dflags\n          activeRegs = activeStgRegs platform\n          activeCallerSavesRegs = filter (callerSaves platform) activeRegs\n\n          foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = []\n          foreignTargetRegs _ = activeCallerSavesRegs\n\n-- Note [Safe foreign calls clobber STG registers]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- During stack layout phase every safe foreign call is expanded into a block\n-- that contains unsafe foreign call (instead of safe foreign call) and ends\n-- with a normal call (See Note [Foreign calls]). This means that we must\n-- treat safe foreign call as if it was a normal call (because eventually it\n-- will be). This is important if we try to run sinking pass before stack\n-- layout phase. Consider this example of what might go wrong (this is cmm\n-- code from stablename001 test). Here is code after common block elimination\n-- (before stack layout):\n--\n--  c1q6:\n--      _s1pf::P64 = R1;\n--      _c1q8::I64 = performMajorGC;\n--      I64[(young<c1q9> + 8)] = c1q9;\n--      foreign call \"ccall\" arg hints:  []  result hints:  [] (_c1q8::I64)(...)\n--                   returns to c1q9 args: ([]) ress: ([])ret_args: 8ret_off: 8;\n--  c1q9:\n--      I64[(young<c1qb> + 8)] = c1qb;\n--      R1 = _s1pc::P64;\n--      call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;\n--\n-- If we run sinking pass now (still before stack layout) we will get this:\n--\n--  c1q6:\n--      I64[(young<c1q9> + 8)] = c1q9;\n--      foreign call \"ccall\" arg hints:  []  result hints:  [] performMajorGC(...)\n--                   returns to c1q9 args: ([]) ress: ([])ret_args: 8ret_off: 8;\n--  c1q9:\n--      I64[(young<c1qb> + 8)] = c1qb;\n--      _s1pf::P64 = R1;         <------ _s1pf sunk past safe foreign call\n--      R1 = _s1pc::P64;\n--      call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;\n--\n-- Notice that _s1pf was sunk past a foreign call. When we run stack layout\n-- safe call to performMajorGC will be turned into:\n--\n--  c1q6:\n--      _s1pc::P64 = P64[Sp + 8];\n--      I64[Sp - 8] = c1q9;\n--      Sp = Sp - 8;\n--      I64[I64[CurrentTSO + 24] + 16] = Sp;\n--      P64[CurrentNursery + 8] = Hp + 8;\n--      (_u1qI::I64) = call \"ccall\" arg hints:  [PtrHint,]\n--                           result hints:  [PtrHint] suspendThread(BaseReg, 0);\n--      call \"ccall\" arg hints:  []  result hints:  [] performMajorGC();\n--      (_u1qJ::I64) = call \"ccall\" arg hints:  [PtrHint]\n--                           result hints:  [PtrHint] resumeThread(_u1qI::I64);\n--      BaseReg = _u1qJ::I64;\n--      _u1qK::P64 = CurrentTSO;\n--      _u1qL::P64 = I64[_u1qK::P64 + 24];\n--      Sp = I64[_u1qL::P64 + 16];\n--      SpLim = _u1qL::P64 + 192;\n--      HpAlloc = 0;\n--      Hp = I64[CurrentNursery + 8] - 8;\n--      HpLim = I64[CurrentNursery] + (%MO_SS_Conv_W32_W64(I32[CurrentNursery + 48]) * 4096 - 1);\n--      call (I64[Sp])() returns to c1q9, args: 8, res: 8, upd: 8;\n--  c1q9:\n--      I64[(young<c1qb> + 8)] = c1qb;\n--      _s1pf::P64 = R1;         <------ INCORRECT!\n--      R1 = _s1pc::P64;\n--      call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;\n--\n-- Notice that c1q6 now ends with a call. Sinking _s1pf::P64 = R1 past that\n-- call is clearly incorrect. This is what would happen if we assumed that\n-- safe foreign call has the same semantics as unsafe foreign call. To prevent\n-- this we need to treat safe foreign call as if was normal call.\n\n-----------------------------------\n-- mapping Expr in CmmNode\n\nmapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget\nmapForeignTarget exp   (ForeignTarget e c) = ForeignTarget (exp e) c\nmapForeignTarget _   m@(PrimTarget _)      = m\n\nwrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr\n-- Take a transformer on expressions and apply it recursively.\n-- (wrapRecExp f e) first recursively applies itself to sub-expressions of e\n--                  then  uses f to rewrite the resulting expression\nwrapRecExp f (CmmMachOp op es)    = f (CmmMachOp op $ map (wrapRecExp f) es)\nwrapRecExp f (CmmLoad addr ty)    = f (CmmLoad (wrapRecExp f addr) ty)\nwrapRecExp f e                    = f e\n\nmapExp :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x\nmapExp _ f@(CmmEntry{})                          = f\nmapExp _ m@(CmmComment _)                        = m\nmapExp _ m@(CmmTick _)                           = m\nmapExp f   (CmmUnwind regs)                      = CmmUnwind (map (fmap (fmap f)) regs)\nmapExp f   (CmmAssign r e)                       = CmmAssign r (f e)\nmapExp f   (CmmStore addr e)                     = CmmStore (f addr) (f e)\nmapExp f   (CmmUnsafeForeignCall tgt fs as)      = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as)\nmapExp _ l@(CmmBranch _)                         = l\nmapExp f   (CmmCondBranch e ti fi l)             = CmmCondBranch (f e) ti fi l\nmapExp f   (CmmSwitch e ids)                     = CmmSwitch (f e) ids\nmapExp f   n@CmmCall {cml_target=tgt}            = n{cml_target = f tgt}\nmapExp f   (CmmForeignCall tgt fs as succ ret_args updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ ret_args updfr intrbl\n\nmapExpDeep :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x\nmapExpDeep f = mapExp $ wrapRecExp f\n\n------------------------------------------------------------------------\n-- mapping Expr in CmmNode, but not performing allocation if no changes\n\nmapForeignTargetM :: (CmmExpr -> Maybe CmmExpr) -> ForeignTarget -> Maybe ForeignTarget\nmapForeignTargetM f (ForeignTarget e c) = (\\x -> ForeignTarget x c) `fmap` f e\nmapForeignTargetM _ (PrimTarget _)      = Nothing\n\nwrapRecExpM :: (CmmExpr -> Maybe CmmExpr) -> (CmmExpr -> Maybe CmmExpr)\n-- (wrapRecExpM f e) first recursively applies itself to sub-expressions of e\n--                   then  gives f a chance to rewrite the resulting expression\nwrapRecExpM f n@(CmmMachOp op es)  = maybe (f n) (f . CmmMachOp op)    (mapListM (wrapRecExpM f) es)\nwrapRecExpM f n@(CmmLoad addr ty)  = maybe (f n) (f . flip CmmLoad ty) (wrapRecExpM f addr)\nwrapRecExpM f e                    = f e\n\nmapExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)\nmapExpM _ (CmmEntry{})              = Nothing\nmapExpM _ (CmmComment _)            = Nothing\nmapExpM _ (CmmTick _)               = Nothing\nmapExpM f (CmmUnwind regs)          = CmmUnwind `fmap` mapM (\\(r,e) -> mapM f e >>= \\e' -> pure (r,e')) regs\nmapExpM f (CmmAssign r e)           = CmmAssign r `fmap` f e\nmapExpM f (CmmStore addr e)         = (\\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e]\nmapExpM _ (CmmBranch _)             = Nothing\nmapExpM f (CmmCondBranch e ti fi l) = (\\x -> CmmCondBranch x ti fi l) `fmap` f e\nmapExpM f (CmmSwitch e tbl)         = (\\x -> CmmSwitch x tbl)       `fmap` f e\nmapExpM f (CmmCall tgt mb_id r o i s) = (\\x -> CmmCall x mb_id r o i s) `fmap` f tgt\nmapExpM f (CmmUnsafeForeignCall tgt fs as)\n    = case mapForeignTargetM f tgt of\n        Just tgt' -> Just (CmmUnsafeForeignCall tgt' fs (mapListJ f as))\n        Nothing   -> (\\xs -> CmmUnsafeForeignCall tgt fs xs) `fmap` mapListM f as\nmapExpM f (CmmForeignCall tgt fs as succ ret_args updfr intrbl)\n    = case mapForeignTargetM f tgt of\n        Just tgt' -> Just (CmmForeignCall tgt' fs (mapListJ f as) succ ret_args updfr intrbl)\n        Nothing   -> (\\xs -> CmmForeignCall tgt fs xs succ ret_args updfr intrbl) `fmap` mapListM f as\n\n-- share as much as possible\nmapListM :: (a -> Maybe a) -> [a] -> Maybe [a]\nmapListM f xs = let (b, r) = mapListT f xs\n                in if b then Just r else Nothing\n\nmapListJ :: (a -> Maybe a) -> [a] -> [a]\nmapListJ f xs = snd (mapListT f xs)\n\nmapListT :: (a -> Maybe a) -> [a] -> (Bool, [a])\nmapListT f xs = foldr g (False, []) (zip3 (tails xs) xs (map f xs))\n    where g (_,   y, Nothing) (True, ys)  = (True,  y:ys)\n          g (_,   _, Just y)  (True, ys)  = (True,  y:ys)\n          g (ys', _, Nothing) (False, _)  = (False, ys')\n          g (_,   _, Just y)  (False, ys) = (True,  y:ys)\n\nmapExpDeepM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)\nmapExpDeepM f = mapExpM $ wrapRecExpM f\n\n-----------------------------------\n-- folding Expr in CmmNode\n\nfoldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z\nfoldExpForeignTarget exp (ForeignTarget e _) z = exp e z\nfoldExpForeignTarget _   (PrimTarget _)      z = z\n\n-- Take a folder on expressions and apply it recursively.\n-- Specifically (wrapRecExpf f e z) deals with CmmMachOp and CmmLoad\n-- itself, delegating all the other CmmExpr forms to 'f'.\nwrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z\nwrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es\nwrapRecExpf f e@(CmmLoad addr _) z = wrapRecExpf f addr (f e z)\nwrapRecExpf f e                  z = f e z\n\nfoldExp :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z\nfoldExp _ (CmmEntry {}) z                         = z\nfoldExp _ (CmmComment {}) z                       = z\nfoldExp _ (CmmTick {}) z                          = z\nfoldExp f (CmmUnwind xs) z                        = foldr (maybe id f) z (map snd xs)\nfoldExp f (CmmAssign _ e) z                       = f e z\nfoldExp f (CmmStore addr e) z                     = f addr $ f e z\nfoldExp f (CmmUnsafeForeignCall t _ as) z         = foldr f (foldExpForeignTarget f t z) as\nfoldExp _ (CmmBranch _) z                         = z\nfoldExp f (CmmCondBranch e _ _ _) z               = f e z\nfoldExp f (CmmSwitch e _) z                       = f e z\nfoldExp f (CmmCall {cml_target=tgt}) z            = f tgt z\nfoldExp f (CmmForeignCall {tgt=tgt, args=args}) z = foldr f (foldExpForeignTarget f tgt z) args\n\nfoldExpDeep :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z\nfoldExpDeep f = foldExp (wrapRecExpf f)\n\n-- -----------------------------------------------------------------------------\n\nmapSuccessors :: (Label -> Label) -> CmmNode O C -> CmmNode O C\nmapSuccessors f (CmmBranch bid)         = CmmBranch (f bid)\nmapSuccessors f (CmmCondBranch p y n l) = CmmCondBranch p (f y) (f n) l\nmapSuccessors f (CmmSwitch e ids)       = CmmSwitch e (mapSwitchTargets f ids)\nmapSuccessors _ n = n\n\nmapCollectSuccessors :: forall a. (Label -> (Label,a)) -> CmmNode O C\n                     -> (CmmNode O C, [a])\nmapCollectSuccessors f (CmmBranch bid)\n  = let (bid', acc) = f bid in (CmmBranch bid', [acc])\nmapCollectSuccessors f (CmmCondBranch p y n l)\n  = let (bidt, acct) = f y\n        (bidf, accf) = f n\n    in  (CmmCondBranch p bidt bidf l, [accf, acct])\nmapCollectSuccessors f (CmmSwitch e ids)\n  = let lbls = switchTargetsToList ids :: [Label]\n        lblMap = mapFromList $ zip lbls (map f lbls) :: LabelMap (Label, a)\n    in ( CmmSwitch e\n          (mapSwitchTargets\n            (\\l -> fst $ mapFindWithDefault (error \"impossible\") l lblMap) ids)\n          , map snd (mapElems lblMap)\n        )\nmapCollectSuccessors _ n = (n, [])\n\n-- -----------------------------------------------------------------------------\n\n-- | Tickish in Cmm context (annotations only)\ntype CmmTickish = Tickish ()\n\n-- | Tick scope identifier, allowing us to reason about what\n-- annotations in a Cmm block should scope over. We especially take\n-- care to allow optimisations to reorganise blocks without losing\n-- tick association in the process.\ndata CmmTickScope\n  = GlobalScope\n    -- ^ The global scope is the \"root\" of the scope graph. Every\n    -- scope is a sub-scope of the global scope. It doesn't make sense\n    -- to add ticks to this scope. On the other hand, this means that\n    -- setting this scope on a block means no ticks apply to it.\n\n  | SubScope !U.Unique CmmTickScope\n    -- ^ Constructs a new sub-scope to an existing scope. This allows\n    -- us to translate Core-style scoping rules (see @tickishScoped@)\n    -- into the Cmm world. Suppose the following code:\n    --\n    --   tick<1> case ... of\n    --             A -> tick<2> ...\n    --             B -> tick<3> ...\n    --\n    -- We want the top-level tick annotation to apply to blocks\n    -- generated for the A and B alternatives. We can achieve that by\n    -- generating tick<1> into a block with scope a, while the code\n    -- for alternatives A and B gets generated into sub-scopes a/b and\n    -- a/c respectively.\n\n  | CombinedScope CmmTickScope CmmTickScope\n    -- ^ A combined scope scopes over everything that the two given\n    -- scopes cover. It is therefore a sub-scope of either scope. This\n    -- is required for optimisations. Consider common block elimination:\n    --\n    --   A -> tick<2> case ... of\n    --     C -> [common]\n    --   B -> tick<3> case ... of\n    --     D -> [common]\n    --\n    -- We will generate code for the C and D alternatives, and figure\n    -- out afterwards that it's actually common code. Scoping rules\n    -- dictate that the resulting common block needs to be covered by\n    -- both tick<2> and tick<3>, therefore we need to construct a\n    -- scope that is a child to *both* scope. Now we can do that - if\n    -- we assign the scopes a/c and b/d to the common-ed up blocks,\n    -- the new block could have a combined tick scope a/c+b/d, which\n    -- both tick<2> and tick<3> apply to.\n\n-- Note [CmmTick scoping details]:\n--\n-- The scope of a @CmmTick@ is given by the @CmmEntry@ node of the\n-- same block. Note that as a result of this, optimisations making\n-- tick scopes more specific can *reduce* the amount of code a tick\n-- scopes over. Fixing this would require a separate @CmmTickScope@\n-- field for @CmmTick@. Right now we do not do this simply because I\n-- couldn't find an example where it actually mattered -- multiple\n-- blocks within the same scope generally jump to each other, which\n-- prevents common block elimination from happening in the first\n-- place. But this is no strong reason, so if Cmm optimisations become\n-- more involved in future this might have to be revisited.\n\n-- | Output all scope paths.\nscopeToPaths :: CmmTickScope -> [[U.Unique]]\nscopeToPaths GlobalScope           = [[]]\nscopeToPaths (SubScope u s)        = map (u:) (scopeToPaths s)\nscopeToPaths (CombinedScope s1 s2) = scopeToPaths s1 ++ scopeToPaths s2\n\n-- | Returns the head uniques of the scopes. This is based on the\n-- assumption that the @Unique@ of @SubScope@ identifies the\n-- underlying super-scope. Used for efficient equality and comparison,\n-- see below.\nscopeUniques :: CmmTickScope -> [U.Unique]\nscopeUniques GlobalScope           = []\nscopeUniques (SubScope u _)        = [u]\nscopeUniques (CombinedScope s1 s2) = scopeUniques s1 ++ scopeUniques s2\n\n-- Equality and order is based on the head uniques defined above. We\n-- take care to short-cut the (extremly) common cases.\ninstance Eq CmmTickScope where\n  GlobalScope    == GlobalScope     = True\n  GlobalScope    == _               = False\n  _              == GlobalScope     = False\n  (SubScope u _) == (SubScope u' _) = u == u'\n  (SubScope _ _) == _               = False\n  _              == (SubScope _ _)  = False\n  scope          == scope'          =\n    sortBy nonDetCmpUnique (scopeUniques scope) ==\n    sortBy nonDetCmpUnique (scopeUniques scope')\n    -- This is still deterministic because\n    -- the order is the same for equal lists\n\n-- This is non-deterministic but we do not currently support deterministic\n-- code-generation. See Note [Unique Determinism and code generation]\n-- See Note [No Ord for Unique]\ninstance Ord CmmTickScope where\n  compare GlobalScope    GlobalScope     = EQ\n  compare GlobalScope    _               = LT\n  compare _              GlobalScope     = GT\n  compare (SubScope u _) (SubScope u' _) = nonDetCmpUnique u u'\n  compare scope scope'                   = cmpList nonDetCmpUnique\n     (sortBy nonDetCmpUnique $ scopeUniques scope)\n     (sortBy nonDetCmpUnique $ scopeUniques scope')\n\ninstance Outputable CmmTickScope where\n  ppr GlobalScope     = text \"global\"\n  ppr (SubScope us GlobalScope)\n                      = ppr us\n  ppr (SubScope us s) = ppr s <> char '/' <> ppr us\n  ppr combined        = parens $ hcat $ punctuate (char '+') $\n                        map (hcat . punctuate (char '/') . map ppr . reverse) $\n                        scopeToPaths combined\n\n-- | Checks whether two tick scopes are sub-scopes of each other. True\n-- if the two scopes are equal.\nisTickSubScope :: CmmTickScope -> CmmTickScope -> Bool\nisTickSubScope = cmp\n  where cmp _              GlobalScope             = True\n        cmp GlobalScope    _                       = False\n        cmp (CombinedScope s1 s2) s'               = cmp s1 s' && cmp s2 s'\n        cmp s              (CombinedScope s1' s2') = cmp s s1' || cmp s s2'\n        cmp (SubScope u s) s'@(SubScope u' _)      = u == u' || cmp s s'\n\n-- | Combine two tick scopes. The new scope should be sub-scope of\n-- both parameters. We simplfy automatically if one tick scope is a\n-- sub-scope of the other already.\ncombineTickScopes :: CmmTickScope -> CmmTickScope -> CmmTickScope\ncombineTickScopes s1 s2\n  | s1 `isTickSubScope` s2 = s1\n  | s2 `isTickSubScope` s1 = s2\n  | otherwise              = CombinedScope s1 s2\n", "num_lines": 725}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The default iteration limit is a bit too low for the definitions\n-- in this module.\n{-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}\n\n-----------------------------------------------------------------------------\n--\n-- Cmm optimisation\n--\n-- (c) The University of Glasgow 2006\n--\n-----------------------------------------------------------------------------\n\nmodule CmmOpt (\n        constantFoldNode,\n        constantFoldExpr,\n        cmmMachOpFold,\n        cmmMachOpFoldM\n ) where\n\nimport GhcPrelude\n\nimport CmmUtils\nimport Cmm\nimport DynFlags\nimport Util\n\nimport Outputable\nimport Platform\n\nimport Data.Bits\nimport Data.Maybe\n\n\nconstantFoldNode :: DynFlags -> CmmNode e x -> CmmNode e x\nconstantFoldNode dflags = mapExp (constantFoldExpr dflags)\n\nconstantFoldExpr :: DynFlags -> CmmExpr -> CmmExpr\nconstantFoldExpr dflags = wrapRecExp f\n  where f (CmmMachOp op args) = cmmMachOpFold dflags op args\n        f (CmmRegOff r 0) = CmmReg r\n        f e = e\n\n-- -----------------------------------------------------------------------------\n-- MachOp constant folder\n\n-- Now, try to constant-fold the MachOps.  The arguments have already\n-- been optimized and folded.\n\ncmmMachOpFold\n    :: DynFlags\n    -> MachOp       -- The operation from an CmmMachOp\n    -> [CmmExpr]    -- The optimized arguments\n    -> CmmExpr\n\ncmmMachOpFold dflags op args = fromMaybe (CmmMachOp op args) (cmmMachOpFoldM dflags op args)\n\n-- Returns Nothing if no changes, useful for Hoopl, also reduces\n-- allocation!\ncmmMachOpFoldM\n    :: DynFlags\n    -> MachOp\n    -> [CmmExpr]\n    -> Maybe CmmExpr\n\ncmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]\n  = Just $ case op of\n      MO_S_Neg _ -> CmmLit (CmmInt (-x) rep)\n      MO_Not _   -> CmmLit (CmmInt (complement x) rep)\n\n        -- these are interesting: we must first narrow to the\n        -- \"from\" type, in order to truncate to the correct size.\n        -- The final narrow/widen to the destination type\n        -- is implicit in the CmmLit.\n      MO_SF_Conv _from to -> CmmLit (CmmFloat (fromInteger x) to)\n      MO_SS_Conv  from to -> CmmLit (CmmInt (narrowS from x) to)\n      MO_UU_Conv  from to -> CmmLit (CmmInt (narrowU from x) to)\n\n      _ -> panic $ \"cmmMachOpFoldM: unknown unary op: \" ++ show op\n\n\n-- Eliminate conversion NOPs\ncmmMachOpFoldM _ (MO_SS_Conv rep1 rep2) [x] | rep1 == rep2 = Just x\ncmmMachOpFoldM _ (MO_UU_Conv rep1 rep2) [x] | rep1 == rep2 = Just x\n\n-- Eliminate nested conversions where possible\ncmmMachOpFoldM dflags conv_outer [CmmMachOp conv_inner [x]]\n  | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,\n    Just (_,   rep3,signed2) <- isIntConversion conv_outer\n  = case () of\n        -- widen then narrow to the same size is a nop\n      _ | rep1 < rep2 && rep1 == rep3 -> Just x\n        -- Widen then narrow to different size: collapse to single conversion\n        -- but remember to use the signedness from the widening, just in case\n        -- the final conversion is a widen.\n        | rep1 < rep2 && rep2 > rep3 ->\n            Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]\n        -- Nested widenings: collapse if the signedness is the same\n        | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->\n            Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]\n        -- Nested narrowings: collapse\n        | rep1 > rep2 && rep2 > rep3 ->\n            Just $ cmmMachOpFold dflags (MO_UU_Conv rep1 rep3) [x]\n        | otherwise ->\n            Nothing\n  where\n        isIntConversion (MO_UU_Conv rep1 rep2)\n          = Just (rep1,rep2,False)\n        isIntConversion (MO_SS_Conv rep1 rep2)\n          = Just (rep1,rep2,True)\n        isIntConversion _ = Nothing\n\n        intconv True  = MO_SS_Conv\n        intconv False = MO_UU_Conv\n\n-- ToDo: a narrow of a load can be collapsed into a narrow load, right?\n-- but what if the architecture only supports word-sized loads, should\n-- we do the transformation anyway?\n\ncmmMachOpFoldM dflags mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]\n  = case mop of\n        -- for comparisons: don't forget to narrow the arguments before\n        -- comparing, since they might be out of range.\n        MO_Eq _   -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth dflags))\n        MO_Ne _   -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth dflags))\n\n        MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u >  y_u then 1 else 0) (wordWidth dflags))\n        MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth dflags))\n        MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u <  y_u then 1 else 0) (wordWidth dflags))\n        MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth dflags))\n\n        MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s >  y_s then 1 else 0) (wordWidth dflags))\n        MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth dflags))\n        MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s <  y_s then 1 else 0) (wordWidth dflags))\n        MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth dflags))\n\n        MO_Add r -> Just $ CmmLit (CmmInt (x + y) r)\n        MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r)\n        MO_Mul r -> Just $ CmmLit (CmmInt (x * y) r)\n        MO_U_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `quot` y_u) r)\n        MO_U_Rem  r | y /= 0 -> Just $ CmmLit (CmmInt (x_u `rem`  y_u) r)\n        MO_S_Quot r | y /= 0 -> Just $ CmmLit (CmmInt (x `quot` y) r)\n        MO_S_Rem  r | y /= 0 -> Just $ CmmLit (CmmInt (x `rem` y) r)\n\n        MO_And   r -> Just $ CmmLit (CmmInt (x .&. y) r)\n        MO_Or    r -> Just $ CmmLit (CmmInt (x .|. y) r)\n        MO_Xor   r -> Just $ CmmLit (CmmInt (x `xor` y) r)\n\n        MO_Shl   r -> Just $ CmmLit (CmmInt (x `shiftL` fromIntegral y) r)\n        MO_U_Shr r -> Just $ CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)\n        MO_S_Shr r -> Just $ CmmLit (CmmInt (x `shiftR` fromIntegral y) r)\n\n        _          -> Nothing\n\n   where\n        x_u = narrowU xrep x\n        y_u = narrowU xrep y\n        x_s = narrowS xrep x\n        y_s = narrowS xrep y\n\n\n-- When possible, shift the constants to the right-hand side, so that we\n-- can match for strength reductions.  Note that the code generator will\n-- also assume that constants have been shifted to the right when\n-- possible.\n\ncmmMachOpFoldM dflags op [x@(CmmLit _), y]\n   | not (isLit y) && isCommutableMachOp op\n   = Just (cmmMachOpFold dflags op [y, x])\n\n-- Turn (a+b)+c into a+(b+c) where possible.  Because literals are\n-- moved to the right, it is more likely that we will find\n-- opportunities for constant folding when the expression is\n-- right-associated.\n--\n-- ToDo: this appears to introduce a quadratic behaviour due to the\n-- nested cmmMachOpFold.  Can we fix this?\n--\n-- Why do we check isLit arg1?  If arg1 is a lit, it means that arg2\n-- is also a lit (otherwise arg1 would be on the right).  If we\n-- put arg1 on the left of the rearranged expression, we'll get into a\n-- loop:  (x1+x2)+x3 => x1+(x2+x3)  => (x2+x3)+x1 => x2+(x3+x1) ...\n--\n-- Also don't do it if arg1 is PicBaseReg, so that we don't separate the\n-- PicBaseReg from the corresponding label (or label difference).\n--\ncmmMachOpFoldM dflags mop1 [CmmMachOp mop2 [arg1,arg2], arg3]\n   | mop2 `associates_with` mop1\n     && not (isLit arg1) && not (isPicReg arg1)\n   = Just (cmmMachOpFold dflags mop2 [arg1, cmmMachOpFold dflags mop1 [arg2,arg3]])\n   where\n     MO_Add{} `associates_with` MO_Sub{} = True\n     mop1 `associates_with` mop2 =\n        mop1 == mop2 && isAssociativeMachOp mop1\n\n-- special case: (a - b) + c  ==>  a + (c - b)\ncmmMachOpFoldM dflags mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3]\n   | not (isLit arg1) && not (isPicReg arg1)\n   = Just (cmmMachOpFold dflags mop1 [arg1, cmmMachOpFold dflags mop2 [arg3,arg2]])\n\n-- special case: (PicBaseReg + lit) + N  ==>  PicBaseReg + (lit+N)\n--\n-- this is better because lit+N is a single link-time constant (e.g. a\n-- CmmLabelOff), so the right-hand expression needs only one\n-- instruction, whereas the left needs two.  This happens when pointer\n-- tagging gives us label+offset, and PIC turns the label into\n-- PicBaseReg + label.\n--\ncmmMachOpFoldM _ MO_Add{} [ CmmMachOp op@MO_Add{} [pic, CmmLit lit]\n                          , CmmLit (CmmInt n rep) ]\n  | isPicReg pic\n  = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]\n  where off = fromIntegral (narrowS rep n)\n\n-- Make a RegOff if we can\ncmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]\n  = Just $ cmmRegOff reg (fromIntegral (narrowS rep n))\ncmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]\n  = Just $ cmmRegOff reg (off + fromIntegral (narrowS rep n))\ncmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]\n  = Just $ cmmRegOff reg (- fromIntegral (narrowS rep n))\ncmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]\n  = Just $ cmmRegOff reg (off - fromIntegral (narrowS rep n))\n\n-- Fold label(+/-)offset into a CmmLit where possible\n\ncmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)]\n  = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))\ncmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit]\n  = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))\ncmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)]\n  = Just $ CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i))))\n\n\n-- Comparison of literal with widened operand: perform the comparison\n-- at the smaller width, as long as the literal is within range.\n\n-- We can't do the reverse trick, when the operand is narrowed:\n-- narrowing throws away bits from the operand, there's no way to do\n-- the same comparison at the larger size.\n\ncmmMachOpFoldM dflags cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]\n  |     -- powerPC NCG has a TODO for I8/I16 comparisons, so don't try\n    platformArch (targetPlatform dflags) `elem` [ArchX86, ArchX86_64],\n        -- if the operand is widened:\n    Just (rep, signed, narrow_fn) <- maybe_conversion conv,\n        -- and this is a comparison operation:\n    Just narrow_cmp <- maybe_comparison cmp rep signed,\n        -- and the literal fits in the smaller size:\n    i == narrow_fn rep i\n        -- then we can do the comparison at the smaller size\n  = Just (cmmMachOpFold dflags narrow_cmp [x, CmmLit (CmmInt i rep)])\n where\n    maybe_conversion (MO_UU_Conv from to)\n        | to > from\n        = Just (from, False, narrowU)\n    maybe_conversion (MO_SS_Conv from to)\n        | to > from\n        = Just (from, True, narrowS)\n\n        -- don't attempt to apply this optimisation when the source\n        -- is a float; see #1916\n    maybe_conversion _ = Nothing\n\n        -- careful (#2080): if the original comparison was signed, but\n        -- we were doing an unsigned widen, then we must do an\n        -- unsigned comparison at the smaller size.\n    maybe_comparison (MO_U_Gt _) rep _     = Just (MO_U_Gt rep)\n    maybe_comparison (MO_U_Ge _) rep _     = Just (MO_U_Ge rep)\n    maybe_comparison (MO_U_Lt _) rep _     = Just (MO_U_Lt rep)\n    maybe_comparison (MO_U_Le _) rep _     = Just (MO_U_Le rep)\n    maybe_comparison (MO_Eq   _) rep _     = Just (MO_Eq   rep)\n    maybe_comparison (MO_S_Gt _) rep True  = Just (MO_S_Gt rep)\n    maybe_comparison (MO_S_Ge _) rep True  = Just (MO_S_Ge rep)\n    maybe_comparison (MO_S_Lt _) rep True  = Just (MO_S_Lt rep)\n    maybe_comparison (MO_S_Le _) rep True  = Just (MO_S_Le rep)\n    maybe_comparison (MO_S_Gt _) rep False = Just (MO_U_Gt rep)\n    maybe_comparison (MO_S_Ge _) rep False = Just (MO_U_Ge rep)\n    maybe_comparison (MO_S_Lt _) rep False = Just (MO_U_Lt rep)\n    maybe_comparison (MO_S_Le _) rep False = Just (MO_U_Le rep)\n    maybe_comparison _ _ _ = Nothing\n\n-- We can often do something with constants of 0 and 1 ...\n-- See Note [Comparison operators]\n\ncmmMachOpFoldM dflags mop [x, y@(CmmLit (CmmInt 0 _))]\n  = case mop of\n        -- Arithmetic\n        MO_Add   _ -> Just x   -- x + 0 = x\n        MO_Sub   _ -> Just x   -- x - 0 = x\n        MO_Mul   _ -> Just y   -- x * 0 = 0\n\n        -- Logical operations\n        MO_And   _ -> Just y   -- x &     0 = 0\n        MO_Or    _ -> Just x   -- x |     0 = x\n        MO_Xor   _ -> Just x   -- x `xor` 0 = x\n\n        -- Shifts\n        MO_Shl   _ -> Just x   -- x << 0 = x\n        MO_S_Shr _ -> Just x   -- ditto shift-right\n        MO_U_Shr _ -> Just x\n\n        -- Comparisons; these ones are trickier\n        -- See Note [Comparison operators]\n        MO_Ne    _ | isComparisonExpr x -> Just x                -- (x > y) != 0  =  x > y\n        MO_Eq    _ | Just x' <- maybeInvertCmmExpr x -> Just x'  -- (x > y) == 0  =  x <= y\n        MO_U_Gt  _ | isComparisonExpr x -> Just x                -- (x > y) > 0   =  x > y\n        MO_S_Gt  _ | isComparisonExpr x -> Just x                -- ditto\n        MO_U_Lt  _ | isComparisonExpr x -> Just zero             -- (x > y) < 0  =  0\n        MO_S_Lt  _ | isComparisonExpr x -> Just zero\n        MO_U_Ge  _ | isComparisonExpr x -> Just one              -- (x > y) >= 0  =  1\n        MO_S_Ge  _ | isComparisonExpr x -> Just one\n\n        MO_U_Le  _ | Just x' <- maybeInvertCmmExpr x -> Just x'  -- (x > y) <= 0  =  x <= y\n        MO_S_Le  _ | Just x' <- maybeInvertCmmExpr x -> Just x'\n        _ -> Nothing\n  where\n    zero = CmmLit (CmmInt 0 (wordWidth dflags))\n    one  = CmmLit (CmmInt 1 (wordWidth dflags))\n\ncmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt 1 rep))]\n  = case mop of\n        -- Arithmetic: x*1 = x, etc\n        MO_Mul    _ -> Just x\n        MO_S_Quot _ -> Just x\n        MO_U_Quot _ -> Just x\n        MO_S_Rem  _ -> Just $ CmmLit (CmmInt 0 rep)\n        MO_U_Rem  _ -> Just $ CmmLit (CmmInt 0 rep)\n\n        -- Comparisons; trickier\n        -- See Note [Comparison operators]\n        MO_Ne    _ | Just x' <- maybeInvertCmmExpr x -> Just x'  -- (x>y) != 1  =  x<=y\n        MO_Eq    _ | isComparisonExpr x -> Just x                -- (x>y) == 1  =  x>y\n        MO_U_Lt  _ | Just x' <- maybeInvertCmmExpr x -> Just x'  -- (x>y) < 1   =  x<=y\n        MO_S_Lt  _ | Just x' <- maybeInvertCmmExpr x -> Just x'  -- ditto\n        MO_U_Gt  _ | isComparisonExpr x -> Just zero             -- (x>y) > 1   = 0\n        MO_S_Gt  _ | isComparisonExpr x -> Just zero\n        MO_U_Le  _ | isComparisonExpr x -> Just one              -- (x>y) <= 1  = 1\n        MO_S_Le  _ | isComparisonExpr x -> Just one\n        MO_U_Ge  _ | isComparisonExpr x -> Just x                -- (x>y) >= 1  = x>y\n        MO_S_Ge  _ | isComparisonExpr x -> Just x\n        _ -> Nothing\n  where\n    zero = CmmLit (CmmInt 0 (wordWidth dflags))\n    one  = CmmLit (CmmInt 1 (wordWidth dflags))\n\n-- Now look for multiplication/division by powers of 2 (integers).\n\ncmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt n _))]\n  = case mop of\n        MO_Mul rep\n           | Just p <- exactLog2 n ->\n                 Just (cmmMachOpFold dflags (MO_Shl rep) [x, CmmLit (CmmInt p rep)])\n        MO_U_Quot rep\n           | Just p <- exactLog2 n ->\n                 Just (cmmMachOpFold dflags (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)])\n        MO_U_Rem rep\n           | Just _ <- exactLog2 n ->\n                 Just (cmmMachOpFold dflags (MO_And rep) [x, CmmLit (CmmInt (n - 1) rep)])\n        MO_S_Quot rep\n           | Just p <- exactLog2 n,\n             CmmReg _ <- x ->   -- We duplicate x in signedQuotRemHelper, hence require\n                                -- it is a reg.  FIXME: remove this restriction.\n                Just (cmmMachOpFold dflags (MO_S_Shr rep)\n                  [signedQuotRemHelper rep p, CmmLit (CmmInt p rep)])\n        MO_S_Rem rep\n           | Just p <- exactLog2 n,\n             CmmReg _ <- x ->   -- We duplicate x in signedQuotRemHelper, hence require\n                                -- it is a reg.  FIXME: remove this restriction.\n                -- We replace (x `rem` 2^p) by (x - (x `quot` 2^p) * 2^p).\n                -- Moreover, we fuse MO_S_Shr (last operation of MO_S_Quot)\n                -- and MO_S_Shl (multiplication by 2^p) into a single MO_And operation.\n                Just (cmmMachOpFold dflags (MO_Sub rep)\n                    [x, cmmMachOpFold dflags (MO_And rep)\n                      [signedQuotRemHelper rep p, CmmLit (CmmInt (- n) rep)]])\n        _ -> Nothing\n  where\n    -- In contrast with unsigned integers, for signed ones\n    -- shift right is not the same as quot, because it rounds\n    -- to minus infinity, whereas quot rounds toward zero.\n    -- To fix this up, we add one less than the divisor to the\n    -- dividend if it is a negative number.\n    --\n    -- to avoid a test/jump, we use the following sequence:\n    --      x1 = x >> word_size-1  (all 1s if -ve, all 0s if +ve)\n    --      x2 = y & (divisor-1)\n    --      result = x + x2\n    -- this could be done a bit more simply using conditional moves,\n    -- but we're processor independent here.\n    --\n    -- we optimise the divide by 2 case slightly, generating\n    --      x1 = x >> word_size-1  (unsigned)\n    --      return = x + x1\n    signedQuotRemHelper :: Width -> Integer -> CmmExpr\n    signedQuotRemHelper rep p = CmmMachOp (MO_Add rep) [x, x2]\n      where\n        bits = fromIntegral (widthInBits rep) - 1\n        shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep\n        x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]\n        x2 = if p == 1 then x1 else\n             CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]\n\n-- ToDo (#7116): optimise floating-point multiplication, e.g. x*2.0 -> x+x\n-- Unfortunately this needs a unique supply because x might not be a\n-- register.  See #2253 (program 6) for an example.\n\n\n-- Anything else is just too hard.\n\ncmmMachOpFoldM _ _ _ = Nothing\n\n{- Note [Comparison operators]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have\n   CmmCondBranch ((x>#y) == 1) t f\nwe really want to convert to\n   CmmCondBranch (x>#y) t f\n\nThat's what the constant-folding operations on comparison operators do above.\n-}\n\n\n-- -----------------------------------------------------------------------------\n-- Utils\n\nisPicReg :: CmmExpr -> Bool\nisPicReg (CmmReg (CmmGlobal PicBaseReg)) = True\nisPicReg _ = False\n", "num_lines": 428}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule CmmPipeline (\n  -- | Converts C-- with an implicit stack and native C-- calls into\n  -- optimized, CPS converted and native-call-less C--.  The latter\n  -- C-- can be used to generate assembly.\n  cmmPipeline\n) where\n\nimport GhcPrelude\n\nimport Cmm\nimport CmmLint\nimport CmmBuildInfoTables\nimport CmmCommonBlockElim\nimport CmmImplementSwitchPlans\nimport CmmProcPoint\nimport CmmContFlowOpt\nimport CmmLayoutStack\nimport CmmSink\nimport Hoopl.Collections\n\nimport UniqSupply\nimport DynFlags\nimport ErrUtils\nimport HscTypes\nimport Control.Monad\nimport Outputable\nimport Platform\n\n-----------------------------------------------------------------------------\n-- | Top level driver for C-- pipeline\n-----------------------------------------------------------------------------\n\ncmmPipeline\n :: HscEnv -- Compilation env including\n           -- dynamic flags: -dcmm-lint -ddump-cmm-cps\n -> ModuleSRTInfo        -- Info about SRTs generated so far\n -> CmmGroup             -- Input C-- with Procedures\n -> IO (ModuleSRTInfo, CmmGroup) -- Output CPS transformed C--\n\ncmmPipeline hsc_env srtInfo prog =\n  do let dflags = hsc_dflags hsc_env\n\n     tops <- {-# SCC \"tops\" #-} mapM (cpsTop hsc_env) prog\n\n     (srtInfo, cmms) <- {-# SCC \"doSRTs\" #-} doSRTs dflags srtInfo tops\n     dumpWith dflags Opt_D_dump_cmm_cps \"Post CPS Cmm\" (ppr cmms)\n\n     return (srtInfo, cmms)\n\n\ncpsTop :: HscEnv -> CmmDecl -> IO (CAFEnv, [CmmDecl])\ncpsTop _ p@(CmmData {}) = return (mapEmpty, [p])\ncpsTop hsc_env proc =\n    do\n       ----------- Control-flow optimisations ----------------------------------\n\n       -- The first round of control-flow optimisation speeds up the\n       -- later passes by removing lots of empty blocks, so we do it\n       -- even when optimisation isn't turned on.\n       --\n       CmmProc h l v g <- {-# SCC \"cmmCfgOpts(1)\" #-}\n            return $ cmmCfgOptsProc splitting_proc_points proc\n       dump Opt_D_dump_cmm_cfg \"Post control-flow optimisations\" g\n\n       let !TopInfo {stack_info=StackInfo { arg_space = entry_off\n                                          , do_layout = do_layout }} = h\n\n       ----------- Eliminate common blocks -------------------------------------\n       g <- {-# SCC \"elimCommonBlocks\" #-}\n            condPass Opt_CmmElimCommonBlocks elimCommonBlocks g\n                          Opt_D_dump_cmm_cbe \"Post common block elimination\"\n\n       -- Any work storing block Labels must be performed _after_\n       -- elimCommonBlocks\n\n       g <- {-# SCC \"createSwitchPlans\" #-}\n            runUniqSM $ cmmImplementSwitchPlans dflags g\n       dump Opt_D_dump_cmm_switch \"Post switch plan\" g\n\n       ----------- Proc points -------------------------------------------------\n       let call_pps = {-# SCC \"callProcPoints\" #-} callProcPoints g\n       proc_points <-\n          if splitting_proc_points\n             then do\n               pp <- {-# SCC \"minimalProcPointSet\" #-} runUniqSM $\n                  minimalProcPointSet (targetPlatform dflags) call_pps g\n               dumpWith dflags Opt_D_dump_cmm_proc \"Proc points\"\n                     (ppr l $$ ppr pp $$ ppr g)\n               return pp\n             else\n               return call_pps\n\n       ----------- Layout the stack and manifest Sp ----------------------------\n       (g, stackmaps) <-\n            {-# SCC \"layoutStack\" #-}\n            if do_layout\n               then runUniqSM $ cmmLayoutStack dflags proc_points entry_off g\n               else return (g, mapEmpty)\n       dump Opt_D_dump_cmm_sp \"Layout Stack\" g\n\n       ----------- Sink and inline assignments  --------------------------------\n       g <- {-# SCC \"sink\" #-} -- See Note [Sinking after stack layout]\n            condPass Opt_CmmSink (cmmSink dflags) g\n                     Opt_D_dump_cmm_sink \"Sink assignments\"\n\n       ------------- CAF analysis ----------------------------------------------\n       let cafEnv = {-# SCC \"cafAnal\" #-} cafAnal call_pps l g\n       dumpWith dflags Opt_D_dump_cmm_caf \"CAFEnv\" (ppr cafEnv)\n\n       g <- if splitting_proc_points\n            then do\n               ------------- Split into separate procedures -----------------------\n               let pp_map = {-# SCC \"procPointAnalysis\" #-}\n                            procPointAnalysis proc_points g\n               dumpWith dflags Opt_D_dump_cmm_procmap \"procpoint map\" $\n                    ppr pp_map\n               g <- {-# SCC \"splitAtProcPoints\" #-} runUniqSM $\n                    splitAtProcPoints dflags l call_pps proc_points pp_map\n                                      (CmmProc h l v g)\n               dumps Opt_D_dump_cmm_split \"Post splitting\" g\n               return g\n             else do\n               -- attach info tables to return points\n               return $ [attachContInfoTables call_pps (CmmProc h l v g)]\n\n       ------------- Populate info tables with stack info -----------------\n       g <- {-# SCC \"setInfoTableStackMap\" #-}\n            return $ map (setInfoTableStackMap dflags stackmaps) g\n       dumps Opt_D_dump_cmm_info \"after setInfoTableStackMap\" g\n\n       ----------- Control-flow optimisations -----------------------------\n       g <- {-# SCC \"cmmCfgOpts(2)\" #-}\n            return $ if optLevel dflags >= 1\n                     then map (cmmCfgOptsProc splitting_proc_points) g\n                     else g\n       g <- return (map removeUnreachableBlocksProc g)\n            -- See Note [unreachable blocks]\n       dumps Opt_D_dump_cmm_cfg \"Post control-flow optimisations\" g\n\n       return (cafEnv, g)\n\n  where dflags = hsc_dflags hsc_env\n        platform = targetPlatform dflags\n        dump = dumpGraph dflags\n\n        dumps flag name\n           = mapM_ (dumpWith dflags flag name . ppr)\n\n        condPass flag pass g dumpflag dumpname =\n            if gopt flag dflags\n               then do\n                    g <- return $ pass g\n                    dump dumpflag dumpname g\n                    return g\n               else return g\n\n        -- we don't need to split proc points for the NCG, unless\n        -- tablesNextToCode is off.  The latter is because we have no\n        -- label to put on info tables for basic blocks that are not\n        -- the entry point.\n        splitting_proc_points = hscTarget dflags /= HscAsm\n                             || not (tablesNextToCode dflags)\n                             || -- Note [inconsistent-pic-reg]\n                                usingInconsistentPicReg\n        usingInconsistentPicReg\n           = case (platformArch platform, platformOS platform, positionIndependent dflags)\n             of   (ArchX86, OSDarwin, pic) -> pic\n                  _                        -> False\n\n-- Note [Sinking after stack layout]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- In the past we considered running sinking pass also before stack\n-- layout, but after making some measurements we realized that:\n--\n--   a) running sinking only before stack layout produces slower\n--      code than running sinking only before stack layout\n--\n--   b) running sinking both before and after stack layout produces\n--      code that has the same performance as when running sinking\n--      only after stack layout.\n--\n-- In other words sinking before stack layout doesn't buy as anything.\n--\n-- An interesting question is \"why is it better to run sinking after\n-- stack layout\"? It seems that the major reason are stores and loads\n-- generated by stack layout. Consider this code before stack layout:\n--\n--  c1E:\n--      _c1C::P64 = R3;\n--      _c1B::P64 = R2;\n--      _c1A::P64 = R1;\n--      I64[(young<c1D> + 8)] = c1D;\n--      call stg_gc_noregs() returns to c1D, args: 8, res: 8, upd: 8;\n--  c1D:\n--      R3 = _c1C::P64;\n--      R2 = _c1B::P64;\n--      R1 = _c1A::P64;\n--      call (P64[(old + 8)])(R3, R2, R1) args: 8, res: 0, upd: 8;\n--\n-- Stack layout pass will save all local variables live across a call\n-- (_c1C, _c1B and _c1A in this example) on the stack just before\n-- making a call and reload them from the stack after returning from a\n-- call:\n--\n--  c1E:\n--      _c1C::P64 = R3;\n--      _c1B::P64 = R2;\n--      _c1A::P64 = R1;\n--      I64[Sp - 32] = c1D;\n--      P64[Sp - 24] = _c1A::P64;\n--      P64[Sp - 16] = _c1B::P64;\n--      P64[Sp - 8] = _c1C::P64;\n--      Sp = Sp - 32;\n--      call stg_gc_noregs() returns to c1D, args: 8, res: 8, upd: 8;\n--  c1D:\n--      _c1A::P64 = P64[Sp + 8];\n--      _c1B::P64 = P64[Sp + 16];\n--      _c1C::P64 = P64[Sp + 24];\n--      R3 = _c1C::P64;\n--      R2 = _c1B::P64;\n--      R1 = _c1A::P64;\n--      Sp = Sp + 32;\n--      call (P64[Sp])(R3, R2, R1) args: 8, res: 0, upd: 8;\n--\n-- If we don't run sinking pass after stack layout we are basically\n-- left with such code. However, running sinking on this code can lead\n-- to significant improvements:\n--\n--  c1E:\n--      I64[Sp - 32] = c1D;\n--      P64[Sp - 24] = R1;\n--      P64[Sp - 16] = R2;\n--      P64[Sp - 8] = R3;\n--      Sp = Sp - 32;\n--      call stg_gc_noregs() returns to c1D, args: 8, res: 8, upd: 8;\n--  c1D:\n--      R3 = P64[Sp + 24];\n--      R2 = P64[Sp + 16];\n--      R1 = P64[Sp + 8];\n--      Sp = Sp + 32;\n--      call (P64[Sp])(R3, R2, R1) args: 8, res: 0, upd: 8;\n--\n-- Now we only have 9 assignments instead of 15.\n--\n-- There is one case when running sinking before stack layout could\n-- be beneficial. Consider this:\n--\n--   L1:\n--      x = y\n--      call f() returns L2\n--   L2: ...x...y...\n--\n-- Since both x and y are live across a call to f, they will be stored\n-- on the stack during stack layout and restored after the call:\n--\n--   L1:\n--      x = y\n--      P64[Sp - 24] = L2\n--      P64[Sp - 16] = x\n--      P64[Sp - 8]  = y\n--      Sp = Sp - 24\n--      call f() returns L2\n--   L2:\n--      y = P64[Sp + 16]\n--      x = P64[Sp + 8]\n--      Sp = Sp + 24\n--      ...x...y...\n--\n-- However, if we run sinking before stack layout we would propagate x\n-- to its usage place (both x and y must be local register for this to\n-- be possible - global registers cannot be floated past a call):\n--\n--   L1:\n--      x = y\n--      call f() returns L2\n--   L2: ...y...y...\n--\n-- Thus making x dead at the call to f(). If we ran stack layout now\n-- we would generate less stores and loads:\n--\n--   L1:\n--      x = y\n--      P64[Sp - 16] = L2\n--      P64[Sp - 8]  = y\n--      Sp = Sp - 16\n--      call f() returns L2\n--   L2:\n--      y = P64[Sp + 8]\n--      Sp = Sp + 16\n--      ...y...y...\n--\n-- But since we don't see any benefits from running sinking befroe stack\n-- layout, this situation probably doesn't arise too often in practice.\n--\n\n{- Note [inconsistent-pic-reg]\n\nOn x86/Darwin, PIC is implemented by inserting a sequence like\n\n    call 1f\n 1: popl %reg\n\nat the proc entry point, and then referring to labels as offsets from\n%reg.  If we don't split proc points, then we could have many entry\npoints in a proc that would need this sequence, and each entry point\nwould then get a different value for %reg.  If there are any join\npoints, then at the join point we don't have a consistent value for\n%reg, so we don't know how to refer to labels.\n\nHence, on x86/Darwin, we have to split proc points, and then each proc\npoint will get its own PIC initialisation sequence.\n\nThis isn't an issue on x86/ELF, where the sequence is\n\n    call 1f\n 1: popl %reg\n    addl $_GLOBAL_OFFSET_TABLE_+(.-1b), %reg\n\nso %reg always has a consistent value: the address of\n_GLOBAL_OFFSET_TABLE_, regardless of which entry point we arrived via.\n\n-}\n\n{- Note [unreachable blocks]\n\nThe control-flow optimiser sometimes leaves unreachable blocks behind\ncontaining junk code.  These aren't necessarily a problem, but\nremoving them is good because it might save time in the native code\ngenerator later.\n\n-}\n\nrunUniqSM :: UniqSM a -> IO a\nrunUniqSM m = do\n  us <- mkSplitUniqSupply 'u'\n  return (initUs_ us m)\n\n\ndumpGraph :: DynFlags -> DumpFlag -> String -> CmmGraph -> IO ()\ndumpGraph dflags flag name g = do\n  when (gopt Opt_DoCmmLinting dflags) $ do_lint g\n  dumpWith dflags flag name (ppr g)\n where\n  do_lint g = case cmmLintGraph dflags g of\n                 Just err -> do { fatalErrorMsg dflags err\n                                ; ghcExit dflags 1\n                                }\n                 Nothing  -> return ()\n\ndumpWith :: DynFlags -> DumpFlag -> String -> SDoc -> IO ()\ndumpWith dflags flag txt sdoc = do\n         -- ToDo: No easy way of say \"dump all the cmm, *and* split\n         -- them into files.\"  Also, -ddump-cmm-verbose doesn't play\n         -- nicely with -ddump-to-file, since the headers get omitted.\n   dumpIfSet_dyn dflags flag txt sdoc\n   when (not (dopt flag dflags)) $\n      dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose txt sdoc\n", "num_lines": 361}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DisambiguateRecordFields, BangPatterns #-}\n\nmodule CmmProcPoint\n    ( ProcPointSet, Status(..)\n    , callProcPoints, minimalProcPointSet\n    , splitAtProcPoints, procPointAnalysis\n    , attachContInfoTables\n    )\nwhere\n\nimport GhcPrelude hiding (last, unzip, succ, zip)\n\nimport DynFlags\nimport BlockId\nimport CLabel\nimport Cmm\nimport PprCmm ()\nimport CmmUtils\nimport CmmInfo\nimport CmmLive\nimport CmmSwitch\nimport Data.List (sortBy)\nimport Maybes\nimport Control.Monad\nimport Outputable\nimport Platform\nimport UniqSupply\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Dataflow\nimport Hoopl.Graph\nimport Hoopl.Label\n\n-- Compute a minimal set of proc points for a control-flow graph.\n\n-- Determine a protocol for each proc point (which live variables will\n-- be passed as arguments and which will be on the stack).\n\n{-\nA proc point is a basic block that, after CPS transformation, will\nstart a new function.  The entry block of the original function is a\nproc point, as is the continuation of each function call.\nA third kind of proc point arises if we want to avoid copying code.\nSuppose we have code like the following:\n\n  f() {\n    if (...) { ..1..; call foo(); ..2..}\n    else     { ..3..; call bar(); ..4..}\n    x = y + z;\n    return x;\n  }\n\nThe statement 'x = y + z' can be reached from two different proc\npoints: the continuations of foo() and bar().  We would prefer not to\nput a copy in each continuation; instead we would like 'x = y + z' to\nbe the start of a new procedure to which the continuations can jump:\n\n  f_cps () {\n    if (...) { ..1..; push k_foo; jump foo_cps(); }\n    else     { ..3..; push k_bar; jump bar_cps(); }\n  }\n  k_foo() { ..2..; jump k_join(y, z); }\n  k_bar() { ..4..; jump k_join(y, z); }\n  k_join(y, z) { x = y + z; return x; }\n\nYou might think then that a criterion to make a node a proc point is\nthat it is directly reached by two distinct proc points.  (Note\n[Direct reachability].)  But this criterion is a bit too simple; for\nexample, 'return x' is also reached by two proc points, yet there is\nno point in pulling it out of k_join.  A good criterion would be to\nsay that a node should be made a proc point if it is reached by a set\nof proc points that is different than its immediate dominator.  NR\nbelieves this criterion can be shown to produce a minimum set of proc\npoints, and given a dominator tree, the proc points can be chosen in\ntime linear in the number of blocks.  Lacking a dominator analysis,\nhowever, we turn instead to an iterative solution, starting with no\nproc points and adding them according to these rules:\n\n  1. The entry block is a proc point.\n  2. The continuation of a call is a proc point.\n  3. A node is a proc point if it is directly reached by more proc\n     points than one of its predecessors.\n\nBecause we don't understand the problem very well, we apply rule 3 at\nmost once per iteration, then recompute the reachability information.\n(See Note [No simple dataflow].)  The choice of the new proc point is\narbitrary, and I don't know if the choice affects the final solution,\nso I don't know if the number of proc points chosen is the\nminimum---but the set will be minimal.\n\n\n\nNote [Proc-point analysis]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nGiven a specified set of proc-points (a set of block-ids), \"proc-point\nanalysis\" figures out, for every block, which proc-point it belongs to.\nAll the blocks belonging to proc-point P will constitute a single\ntop-level C procedure.\n\nA non-proc-point block B \"belongs to\" a proc-point P iff B is\nreachable from P without going through another proc-point.\n\nInvariant: a block B should belong to at most one proc-point; if it\nbelongs to two, that's a bug.\n\nNote [Non-existing proc-points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nOn some architectures it might happen that the list of proc-points\ncomputed before stack layout pass will be invalidated by the stack\nlayout. This will happen if stack layout removes from the graph\nblocks that were determined to be proc-points. Later on in the pipeline\nwe use list of proc-points to perform [Proc-point analysis], but\nif a proc-point does not exist anymore then we will get compiler panic.\nSee #8205.\n-}\n\ntype ProcPointSet = LabelSet\n\ndata Status\n  = ReachedBy ProcPointSet  -- set of proc points that directly reach the block\n  | ProcPoint               -- this block is itself a proc point\n\ninstance Outputable Status where\n  ppr (ReachedBy ps)\n      | setNull ps = text \"<not-reached>\"\n      | otherwise = text \"reached by\" <+>\n                    (hsep $ punctuate comma $ map ppr $ setElems ps)\n  ppr ProcPoint = text \"<procpt>\"\n\n--------------------------------------------------\n-- Proc point analysis\n\n-- Once you know what the proc-points are, figure out\n-- what proc-points each block is reachable from\n-- See Note [Proc-point analysis]\nprocPointAnalysis :: ProcPointSet -> CmmGraph -> LabelMap Status\nprocPointAnalysis procPoints cmmGraph@(CmmGraph {g_graph = graph}) =\n    analyzeCmmFwd procPointLattice procPointTransfer cmmGraph initProcPoints\n  where\n    initProcPoints =\n        mkFactBase\n            procPointLattice\n            [ (id, ProcPoint)\n            | id <- setElems procPoints\n            -- See Note [Non-existing proc-points]\n            , id `setMember` labelsInGraph\n            ]\n    labelsInGraph = labelsDefined graph\n\nprocPointTransfer :: TransferFun Status\nprocPointTransfer block facts =\n    let label = entryLabel block\n        !fact = case getFact procPointLattice label facts of\n            ProcPoint -> ReachedBy $! setSingleton label\n            f -> f\n        result = map (\\id -> (id, fact)) (successors block)\n    in mkFactBase procPointLattice result\n\nprocPointLattice :: DataflowLattice Status\nprocPointLattice = DataflowLattice unreached add_to\n  where\n    unreached = ReachedBy setEmpty\n    add_to (OldFact ProcPoint) _ = NotChanged ProcPoint\n    add_to _ (NewFact ProcPoint) = Changed ProcPoint -- because of previous case\n    add_to (OldFact (ReachedBy p)) (NewFact (ReachedBy p'))\n        | setSize union > setSize p = Changed (ReachedBy union)\n        | otherwise = NotChanged (ReachedBy p)\n      where\n        union = setUnion p' p\n\n----------------------------------------------------------------------\n\n-- It is worth distinguishing two sets of proc points: those that are\n-- induced by calls in the original graph and those that are\n-- introduced because they're reachable from multiple proc points.\n--\n-- Extract the set of Continuation BlockIds, see Note [Continuation BlockIds].\ncallProcPoints      :: CmmGraph -> ProcPointSet\ncallProcPoints g = foldlGraphBlocks add (setSingleton (g_entry g)) g\n  where add :: LabelSet -> CmmBlock -> LabelSet\n        add set b = case lastNode b of\n                      CmmCall {cml_cont = Just k} -> setInsert k set\n                      CmmForeignCall {succ=k}     -> setInsert k set\n                      _ -> set\n\nminimalProcPointSet :: Platform -> ProcPointSet -> CmmGraph\n                    -> UniqSM ProcPointSet\n-- Given the set of successors of calls (which must be proc-points)\n-- figure out the minimal set of necessary proc-points\nminimalProcPointSet platform callProcPoints g\n  = extendPPSet platform g (revPostorder g) callProcPoints\n\nextendPPSet\n    :: Platform -> CmmGraph -> [CmmBlock] -> ProcPointSet -> UniqSM ProcPointSet\nextendPPSet platform g blocks procPoints =\n    let env = procPointAnalysis procPoints g\n        add pps block = let id = entryLabel block\n                        in  case mapLookup id env of\n                              Just ProcPoint -> setInsert id pps\n                              _ -> pps\n        procPoints' = foldlGraphBlocks add setEmpty g\n        newPoints = mapMaybe ppSuccessor blocks\n        newPoint  = listToMaybe newPoints\n        ppSuccessor b =\n            let nreached id = case mapLookup id env `orElse`\n                                    pprPanic \"no ppt\" (ppr id <+> ppr b) of\n                                ProcPoint -> 1\n                                ReachedBy ps -> setSize ps\n                block_procpoints = nreached (entryLabel b)\n                -- | Looking for a successor of b that is reached by\n                -- more proc points than b and is not already a proc\n                -- point.  If found, it can become a proc point.\n                newId succ_id = not (setMember succ_id procPoints') &&\n                                nreached succ_id > block_procpoints\n            in  listToMaybe $ filter newId $ successors b\n\n    in case newPoint of\n         Just id ->\n             if setMember id procPoints'\n                then panic \"added old proc pt\"\n                else extendPPSet platform g blocks (setInsert id procPoints')\n         Nothing -> return procPoints'\n\n\n-- At this point, we have found a set of procpoints, each of which should be\n-- the entry point of a procedure.\n-- Now, we create the procedure for each proc point,\n-- which requires that we:\n-- 1. build a map from proc points to the blocks reachable from the proc point\n-- 2. turn each branch to a proc point into a jump\n-- 3. turn calls and returns into jumps\n-- 4. build info tables for the procedures -- and update the info table for\n--    the SRTs in the entry procedure as well.\n-- Input invariant: A block should only be reachable from a single ProcPoint.\n-- ToDo: use the _ret naming convention that the old code generator\n-- used. -- EZY\nsplitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status ->\n                     CmmDecl -> UniqSM [CmmDecl]\nsplitAtProcPoints dflags entry_label callPPs procPoints procMap\n                  (CmmProc (TopInfo {info_tbls = info_tbls})\n                           top_l _ g@(CmmGraph {g_entry=entry})) =\n  do -- Build a map from procpoints to the blocks they reach\n     let add_block\n             :: LabelMap (LabelMap CmmBlock)\n             -> CmmBlock\n             -> LabelMap (LabelMap CmmBlock)\n         add_block graphEnv b =\n           case mapLookup bid procMap of\n             Just ProcPoint -> add graphEnv bid bid b\n             Just (ReachedBy set) ->\n               case setElems set of\n                 []   -> graphEnv\n                 [id] -> add graphEnv id bid b\n                 _    -> panic \"Each block should be reachable from only one ProcPoint\"\n             Nothing -> graphEnv\n           where bid = entryLabel b\n         add graphEnv procId bid b = mapInsert procId graph' graphEnv\n               where graph  = mapLookup procId graphEnv `orElse` mapEmpty\n                     graph' = mapInsert bid b graph\n\n     let liveness = cmmGlobalLiveness dflags g\n     let ppLiveness pp = filter isArgReg $\n                         regSetToList $\n                         expectJust \"ppLiveness\" $ mapLookup pp liveness\n\n     graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g\n\n     -- Build a map from proc point BlockId to pairs of:\n     --  * Labels for their new procedures\n     --  * Labels for the info tables of their new procedures (only if\n     --    the proc point is a callPP)\n     -- Due to common blockification, we may overestimate the set of procpoints.\n     let add_label map pp = mapInsert pp lbls map\n           where lbls | pp == entry = (entry_label, fmap cit_lbl (mapLookup entry info_tbls))\n                      | otherwise   = (block_lbl, guard (setMember pp callPPs) >>\n                                                    Just info_table_lbl)\n                      where block_lbl      = blockLbl pp\n                            info_table_lbl = infoTblLbl pp\n\n         procLabels :: LabelMap (CLabel, Maybe CLabel)\n         procLabels = foldl' add_label mapEmpty\n                             (filter (flip mapMember (toBlockMap g)) (setElems procPoints))\n\n     -- In each new graph, add blocks jumping off to the new procedures,\n     -- and replace branches to procpoints with branches to the jump-off blocks\n     let add_jump_block\n             :: (LabelMap Label, [CmmBlock])\n             -> (Label, CLabel)\n             -> UniqSM (LabelMap Label, [CmmBlock])\n         add_jump_block (env, bs) (pp, l) =\n           do bid <- liftM mkBlockId getUniqueM\n              let b = blockJoin (CmmEntry bid GlobalScope) emptyBlock jump\n                  live = ppLiveness pp\n                  jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0\n              return (mapInsert pp bid env, b : bs)\n\n         add_jumps\n             :: LabelMap CmmGraph\n             -> (Label, LabelMap CmmBlock)\n             -> UniqSM (LabelMap CmmGraph)\n         add_jumps newGraphEnv (ppId, blockEnv) =\n           do let needed_jumps = -- find which procpoints we currently branch to\n                    mapFoldr add_if_branch_to_pp [] blockEnv\n                  add_if_branch_to_pp :: CmmBlock -> [(BlockId, CLabel)] -> [(BlockId, CLabel)]\n                  add_if_branch_to_pp block rst =\n                    case lastNode block of\n                      CmmBranch id          -> add_if_pp id rst\n                      CmmCondBranch _ ti fi _ -> add_if_pp ti (add_if_pp fi rst)\n                      CmmSwitch _ ids       -> foldr add_if_pp rst $ switchTargetsToList ids\n                      _                     -> rst\n\n                  -- when jumping to a PP that has an info table, if\n                  -- tablesNextToCode is off we must jump to the entry\n                  -- label instead.\n                  jump_label (Just info_lbl) _\n                             | tablesNextToCode dflags = info_lbl\n                             | otherwise               = toEntryLbl info_lbl\n                  jump_label Nothing         block_lbl = block_lbl\n\n                  add_if_pp id rst = case mapLookup id procLabels of\n                                       Just (lbl, mb_info_lbl) -> (id, jump_label mb_info_lbl lbl) : rst\n                                       Nothing                 -> rst\n              (jumpEnv, jumpBlocks) <-\n                 foldM add_jump_block (mapEmpty, []) needed_jumps\n                  -- update the entry block\n              let b = expectJust \"block in env\" $ mapLookup ppId blockEnv\n                  blockEnv' = mapInsert ppId b blockEnv\n                  -- replace branches to procpoints with branches to jumps\n                  blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv'\n                  -- add the jump blocks to the graph\n                  blockEnv''' = foldl' (flip addBlock) blockEnv'' jumpBlocks\n              let g' = ofBlockMap ppId blockEnv'''\n              -- pprTrace \"g' pre jumps\" (ppr g') $ do\n              return (mapInsert ppId g' newGraphEnv)\n\n     graphEnv <- foldM add_jumps mapEmpty $ mapToList graphEnv\n\n     let to_proc (bid, g)\n             | bid == entry\n             =  CmmProc (TopInfo {info_tbls  = info_tbls,\n                                  stack_info = stack_info})\n                        top_l live g'\n             | otherwise\n             = case expectJust \"pp label\" $ mapLookup bid procLabels of\n                 (lbl, Just info_lbl)\n                    -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)\n                                        , stack_info=stack_info})\n                               lbl live g'\n                 (lbl, Nothing)\n                    -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})\n                               lbl live g'\n                where\n                 g' = replacePPIds g\n                 live = ppLiveness (g_entry g')\n                 stack_info = StackInfo { arg_space = 0\n                                        , updfr_space =  Nothing\n                                        , do_layout = True }\n                               -- cannot use panic, this is printed by -ddump-cmm\n\n         -- References to procpoint IDs can now be replaced with the\n         -- infotable's label\n         replacePPIds g = {-# SCC \"replacePPIds\" #-}\n                          mapGraphNodes (id, mapExp repl, mapExp repl) g\n           where repl e@(CmmLit (CmmBlock bid)) =\n                   case mapLookup bid procLabels of\n                     Just (_, Just info_lbl)  -> CmmLit (CmmLabel info_lbl)\n                     _ -> e\n                 repl e = e\n\n     -- The C back end expects to see return continuations before the\n     -- call sites.  Here, we sort them in reverse order -- it gets\n     -- reversed later.\n     let (_, block_order) =\n             foldl' add_block_num (0::Int, mapEmpty :: LabelMap Int)\n                   (revPostorder g)\n         add_block_num (i, map) block =\n           (i + 1, mapInsert (entryLabel block) i map)\n         sort_fn (bid, _) (bid', _) =\n           compare (expectJust \"block_order\" $ mapLookup bid  block_order)\n                   (expectJust \"block_order\" $ mapLookup bid' block_order)\n     procs <- return $ map to_proc $ sortBy sort_fn $ mapToList graphEnv\n     return -- pprTrace \"procLabels\" (ppr procLabels)\n            -- pprTrace \"splitting graphs\" (ppr procs)\n            procs\nsplitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]\n\n-- Only called from CmmProcPoint.splitAtProcPoints. NB. does a\n-- recursive lookup, see comment below.\nreplaceBranches :: LabelMap BlockId -> CmmGraph -> CmmGraph\nreplaceBranches env cmmg\n  = {-# SCC \"replaceBranches\" #-}\n    ofBlockMap (g_entry cmmg) $ mapMap f $ toBlockMap cmmg\n  where\n    f block = replaceLastNode block $ last (lastNode block)\n\n    last :: CmmNode O C -> CmmNode O C\n    last (CmmBranch id)          = CmmBranch (lookup id)\n    last (CmmCondBranch e ti fi l) = CmmCondBranch e (lookup ti) (lookup fi) l\n    last (CmmSwitch e ids)       = CmmSwitch e (mapSwitchTargets lookup ids)\n    last l@(CmmCall {})          = l { cml_cont = Nothing }\n            -- NB. remove the continuation of a CmmCall, since this\n            -- label will now be in a different CmmProc.  Not only\n            -- is this tidier, it stops CmmLint from complaining.\n    last l@(CmmForeignCall {})   = l\n    lookup id = fmap lookup (mapLookup id env) `orElse` id\n            -- XXX: this is a recursive lookup, it follows chains\n            -- until the lookup returns Nothing, at which point we\n            -- return the last BlockId\n\n-- --------------------------------------------------------------\n-- Not splitting proc points: add info tables for continuations\n\nattachContInfoTables :: ProcPointSet -> CmmDecl -> CmmDecl\nattachContInfoTables call_proc_points (CmmProc top_info top_l live g)\n = CmmProc top_info{info_tbls = info_tbls'} top_l live g\n where\n   info_tbls' = mapUnion (info_tbls top_info) $\n                mapFromList [ (l, mkEmptyContInfoTable (infoTblLbl l))\n                            | l <- setElems call_proc_points\n                            , l /= g_entry g ]\nattachContInfoTables _ other_decl\n = other_decl\n\n----------------------------------------------------------------\n\n{-\nNote [Direct reachability]\n\nBlock B is directly reachable from proc point P iff control can flow\nfrom P to B without passing through an intervening proc point.\n-}\n\n----------------------------------------------------------------\n\n{-\nNote [No simple dataflow]\n\nSadly, it seems impossible to compute the proc points using a single\ndataflow pass.  One might attempt to use this simple lattice:\n\n  data Location = Unknown\n                | InProc BlockId -- node is in procedure headed by the named proc point\n                | ProcPoint      -- node is itself a proc point\n\nAt a join, a node in two different blocks becomes a proc point.\nThe difficulty is that the change of information during iterative\ncomputation may promote a node prematurely.  Here's a program that\nillustrates the difficulty:\n\n  f () {\n  entry:\n    ....\n  L1:\n    if (...) { ... }\n    else { ... }\n\n  L2: if (...) { g(); goto L1; }\n      return x + y;\n  }\n\nThe only proc-point needed (besides the entry) is L1.  But in an\niterative analysis, consider what happens to L2.  On the first pass\nthrough, it rises from Unknown to 'InProc entry', but when L1 is\npromoted to a proc point (because it's the successor of g()), L1's\nsuccessors will be promoted to 'InProc L1'.  The problem hits when the\nnew fact 'InProc L1' flows into L2 which is already bound to 'InProc entry'.\nThe join operation makes it a proc point when in fact it needn't be,\nbecause its immediate dominator L1 is already a proc point and there\nare no other proc points that directly reach L2.\n-}\n\n\n\n{- Note [Separate Adams optimization]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt may be worthwhile to attempt the Adams optimization by rewriting\nthe graph before the assignment of proc-point protocols.  Here are a\ncouple of rules:\n\n  g() returns to k;                    g() returns to L;\n  k: CopyIn c ress; goto L:\n   ...                        ==>        ...\n  L: // no CopyIn node here            L: CopyIn c ress;\n\n\nAnd when c == c' and ress == ress', this also:\n\n  g() returns to k;                    g() returns to L;\n  k: CopyIn c ress; goto L:\n   ...                        ==>        ...\n  L: CopyIn c' ress'                   L: CopyIn c' ress' ;\n\nIn both cases the goal is to eliminate k.\n-}\n", "num_lines": 497}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule CmmSink (\n     cmmSink\n  ) where\n\nimport GhcPrelude\n\nimport Cmm\nimport CmmOpt\nimport CmmLive\nimport CmmUtils\nimport Hoopl.Block\nimport Hoopl.Label\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport CodeGen.Platform\nimport Platform (isARM, platformArch)\n\nimport DynFlags\nimport Unique\nimport UniqFM\nimport PprCmm ()\n\nimport qualified Data.IntSet as IntSet\nimport Data.List (partition)\nimport qualified Data.Set as Set\nimport Data.Maybe\n\n-- Compact sets for membership tests of local variables.\n\ntype LRegSet = IntSet.IntSet\n\nemptyLRegSet :: LRegSet\nemptyLRegSet = IntSet.empty\n\nnullLRegSet :: LRegSet -> Bool\nnullLRegSet = IntSet.null\n\ninsertLRegSet :: LocalReg -> LRegSet -> LRegSet\ninsertLRegSet l = IntSet.insert (getKey (getUnique l))\n\nelemLRegSet :: LocalReg -> LRegSet -> Bool\nelemLRegSet l = IntSet.member (getKey (getUnique l))\n\n-- -----------------------------------------------------------------------------\n-- Sinking and inlining\n\n-- This is an optimisation pass that\n--  (a) moves assignments closer to their uses, to reduce register pressure\n--  (b) pushes assignments into a single branch of a conditional if possible\n--  (c) inlines assignments to registers that are mentioned only once\n--  (d) discards dead assignments\n--\n-- This tightens up lots of register-heavy code.  It is particularly\n-- helpful in the Cmm generated by the Stg->Cmm code generator, in\n-- which every function starts with a copyIn sequence like:\n--\n--    x1 = R1\n--    x2 = Sp[8]\n--    x3 = Sp[16]\n--    if (Sp - 32 < SpLim) then L1 else L2\n--\n-- we really want to push the x1..x3 assignments into the L2 branch.\n--\n-- Algorithm:\n--\n--  * Start by doing liveness analysis.\n--\n--  * Keep a list of assignments A; earlier ones may refer to later ones.\n--    Currently we only sink assignments to local registers, because we don't\n--    have liveness information about global registers.\n--\n--  * Walk forwards through the graph, look at each node N:\n--\n--    * If it is a dead assignment, i.e. assignment to a register that is\n--      not used after N, discard it.\n--\n--    * Try to inline based on current list of assignments\n--      * If any assignments in A (1) occur only once in N, and (2) are\n--        not live after N, inline the assignment and remove it\n--        from A.\n--\n--      * If an assignment in A is cheap (RHS is local register), then\n--        inline the assignment and keep it in A in case it is used afterwards.\n--\n--      * Otherwise don't inline.\n--\n--    * If N is assignment to a local register pick up the assignment\n--      and add it to A.\n--\n--    * If N is not an assignment to a local register:\n--      * remove any assignments from A that conflict with N, and\n--        place them before N in the current block.  We call this\n--        \"dropping\" the assignments.\n--\n--      * An assignment conflicts with N if it:\n--        - assigns to a register mentioned in N\n--        - mentions a register assigned by N\n--        - reads from memory written by N\n--      * do this recursively, dropping dependent assignments\n--\n--    * At an exit node:\n--      * drop any assignments that are live on more than one successor\n--        and are not trivial\n--      * if any successor has more than one predecessor (a join-point),\n--        drop everything live in that successor. Since we only propagate\n--        assignments that are not dead at the successor, we will therefore\n--        eliminate all assignments dead at this point. Thus analysis of a\n--        join-point will always begin with an empty list of assignments.\n--\n--\n-- As a result of above algorithm, sinking deletes some dead assignments\n-- (transitively, even).  This isn't as good as removeDeadAssignments,\n-- but it's much cheaper.\n\n-- -----------------------------------------------------------------------------\n-- things that we aren't optimising very well yet.\n--\n-- -----------\n-- (1) From GHC's FastString.hashStr:\n--\n--  s2ay:\n--      if ((_s2an::I64 == _s2ao::I64) >= 1) goto c2gn; else goto c2gp;\n--  c2gn:\n--      R1 = _s2au::I64;\n--      call (I64[Sp])(R1) args: 8, res: 0, upd: 8;\n--  c2gp:\n--      _s2cO::I64 = %MO_S_Rem_W64(%MO_UU_Conv_W8_W64(I8[_s2aq::I64 + (_s2an::I64 << 0)]) + _s2au::I64 * 128,\n--                                 4091);\n--      _s2an::I64 = _s2an::I64 + 1;\n--      _s2au::I64 = _s2cO::I64;\n--      goto s2ay;\n--\n-- a nice loop, but we didn't eliminate the silly assignment at the end.\n-- See Note [dependent assignments], which would probably fix this.\n-- This is #8336 on Trac.\n--\n-- -----------\n-- (2) From stg_atomically_frame in PrimOps.cmm\n--\n-- We have a diamond control flow:\n--\n--     x = ...\n--       |\n--      / \\\n--     A   B\n--      \\ /\n--       |\n--    use of x\n--\n-- Now x won't be sunk down to its use, because we won't push it into\n-- both branches of the conditional.  We certainly do have to check\n-- that we can sink it past all the code in both A and B, but having\n-- discovered that, we could sink it to its use.\n--\n\n-- -----------------------------------------------------------------------------\n\ntype Assignment = (LocalReg, CmmExpr, AbsMem)\n  -- Assignment caches AbsMem, an abstraction of the memory read by\n  -- the RHS of the assignment.\n\ntype Assignments = [Assignment]\n  -- A sequence of assignments; kept in *reverse* order\n  -- So the list [ x=e1, y=e2 ] means the sequence of assignments\n  --     y = e2\n  --     x = e1\n\ncmmSink :: DynFlags -> CmmGraph -> CmmGraph\ncmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks\n  where\n  liveness = cmmLocalLiveness dflags graph\n  getLive l = mapFindWithDefault Set.empty l liveness\n\n  blocks = revPostorder graph\n\n  join_pts = findJoinPoints blocks\n\n  sink :: LabelMap Assignments -> [CmmBlock] -> [CmmBlock]\n  sink _ [] = []\n  sink sunk (b:bs) =\n    -- pprTrace \"sink\" (ppr lbl) $\n    blockJoin first final_middle final_last : sink sunk' bs\n    where\n      lbl = entryLabel b\n      (first, middle, last) = blockSplit b\n\n      succs = successors last\n\n      -- Annotate the middle nodes with the registers live *after*\n      -- the node.  This will help us decide whether we can inline\n      -- an assignment in the current node or not.\n      live = Set.unions (map getLive succs)\n      live_middle = gen_kill dflags last live\n      ann_middles = annotate dflags live_middle (blockToList middle)\n\n      -- Now sink and inline in this block\n      (middle', assigs) = walk dflags ann_middles (mapFindWithDefault [] lbl sunk)\n      fold_last = constantFoldNode dflags last\n      (final_last, assigs') = tryToInline dflags live fold_last assigs\n\n      -- We cannot sink into join points (successors with more than\n      -- one predecessor), so identify the join points and the set\n      -- of registers live in them.\n      (joins, nonjoins) = partition (`mapMember` join_pts) succs\n      live_in_joins = Set.unions (map getLive joins)\n\n      -- We do not want to sink an assignment into multiple branches,\n      -- so identify the set of registers live in multiple successors.\n      -- This is made more complicated because when we sink an assignment\n      -- into one branch, this might change the set of registers that are\n      -- now live in multiple branches.\n      init_live_sets = map getLive nonjoins\n      live_in_multi live_sets r =\n         case filter (Set.member r) live_sets of\n           (_one:_two:_) -> True\n           _ -> False\n\n      -- Now, drop any assignments that we will not sink any further.\n      (dropped_last, assigs'') = dropAssignments dflags drop_if init_live_sets assigs'\n\n      drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets')\n          where\n            should_drop =  conflicts dflags a final_last\n                        || not (isTrivial dflags rhs) && live_in_multi live_sets r\n                        || r `Set.member` live_in_joins\n\n            live_sets' | should_drop = live_sets\n                       | otherwise   = map upd live_sets\n\n            upd set | r `Set.member` set = set `Set.union` live_rhs\n                    | otherwise          = set\n\n            live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs\n\n      final_middle = foldl' blockSnoc middle' dropped_last\n\n      sunk' = mapUnion sunk $\n                 mapFromList [ (l, filterAssignments dflags (getLive l) assigs'')\n                             | l <- succs ]\n\n{- TODO: enable this later, when we have some good tests in place to\n   measure the effect and tune it.\n\n-- small: an expression we don't mind duplicating\nisSmall :: CmmExpr -> Bool\nisSmall (CmmReg (CmmLocal _)) = True  --\nisSmall (CmmLit _) = True\nisSmall (CmmMachOp (MO_Add _) [x,y]) = isTrivial x && isTrivial y\nisSmall (CmmRegOff (CmmLocal _) _) = True\nisSmall _ = False\n-}\n\n--\n-- We allow duplication of trivial expressions: registers (both local and\n-- global) and literals.\n--\nisTrivial :: DynFlags -> CmmExpr -> Bool\nisTrivial _ (CmmReg (CmmLocal _)) = True\nisTrivial dflags (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?]\n  if isARM (platformArch (targetPlatform dflags))\n  then True -- CodeGen.Platform.ARM does not have globalRegMaybe\n  else isJust (globalRegMaybe (targetPlatform dflags) r)\n  -- GlobalRegs that are loads from BaseReg are not trivial\nisTrivial _ (CmmLit _) = True\nisTrivial _ _          = False\n\n--\n-- annotate each node with the set of registers live *after* the node\n--\nannotate :: DynFlags -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)]\nannotate dflags live nodes = snd $ foldr ann (live,[]) nodes\n  where ann n (live,nodes) = (gen_kill dflags n live, (live,n) : nodes)\n\n--\n-- Find the blocks that have multiple successors (join points)\n--\nfindJoinPoints :: [CmmBlock] -> LabelMap Int\nfindJoinPoints blocks = mapFilter (>1) succ_counts\n where\n  all_succs = concatMap successors blocks\n\n  succ_counts :: LabelMap Int\n  succ_counts = foldr (\\l -> mapInsertWith (+) l 1) mapEmpty all_succs\n\n--\n-- filter the list of assignments to remove any assignments that\n-- are not live in a continuation.\n--\nfilterAssignments :: DynFlags -> LocalRegSet -> Assignments -> Assignments\nfilterAssignments dflags live assigs = reverse (go assigs [])\n  where go []             kept = kept\n        go (a@(r,_,_):as) kept | needed    = go as (a:kept)\n                               | otherwise = go as kept\n           where\n              needed = r `Set.member` live\n                       || any (conflicts dflags a) (map toNode kept)\n                       --  Note that we must keep assignments that are\n                       -- referred to by other assignments we have\n                       -- already kept.\n\n-- -----------------------------------------------------------------------------\n-- Walk through the nodes of a block, sinking and inlining assignments\n-- as we go.\n--\n-- On input we pass in a:\n--    * list of nodes in the block\n--    * a list of assignments that appeared *before* this block and\n--      that are being sunk.\n--\n-- On output we get:\n--    * a new block\n--    * a list of assignments that will be placed *after* that block.\n--\n\nwalk :: DynFlags\n     -> [(LocalRegSet, CmmNode O O)]    -- nodes of the block, annotated with\n                                        -- the set of registers live *after*\n                                        -- this node.\n\n     -> Assignments                     -- The current list of\n                                        -- assignments we are sinking.\n                                        -- Earlier assignments may refer\n                                        -- to later ones.\n\n     -> ( Block CmmNode O O             -- The new block\n        , Assignments                   -- Assignments to sink further\n        )\n\nwalk dflags nodes assigs = go nodes emptyBlock assigs\n where\n   go []               block as = (block, as)\n   go ((live,node):ns) block as\n    | shouldDiscard node live           = go ns block as\n       -- discard dead assignment\n    | Just a <- shouldSink dflags node2 = go ns block (a : as1)\n    | otherwise                         = go ns block' as'\n    where\n      node1 = constantFoldNode dflags node\n\n      (node2, as1) = tryToInline dflags live node1 as\n\n      (dropped, as') = dropAssignmentsSimple dflags\n                          (\\a -> conflicts dflags a node2) as1\n\n      block' = foldl' blockSnoc block dropped `blockSnoc` node2\n\n\n--\n-- Heuristic to decide whether to pick up and sink an assignment\n-- Currently we pick up all assignments to local registers.  It might\n-- be profitable to sink assignments to global regs too, but the\n-- liveness analysis doesn't track those (yet) so we can't.\n--\nshouldSink :: DynFlags -> CmmNode e x -> Maybe Assignment\nshouldSink dflags (CmmAssign (CmmLocal r) e) | no_local_regs = Just (r, e, exprMem dflags e)\n  where no_local_regs = True -- foldRegsUsed (\\_ _ -> False) True e\nshouldSink _ _other = Nothing\n\n--\n-- discard dead assignments.  This doesn't do as good a job as\n-- removeDeadAssignments, because it would need multiple passes\n-- to get all the dead code, but it catches the common case of\n-- superfluous reloads from the stack that the stack allocator\n-- leaves behind.\n--\n-- Also we catch \"r = r\" here.  You might think it would fall\n-- out of inlining, but the inliner will see that r is live\n-- after the instruction and choose not to inline r in the rhs.\n--\nshouldDiscard :: CmmNode e x -> LocalRegSet -> Bool\nshouldDiscard node live\n   = case node of\n       CmmAssign r (CmmReg r') | r == r' -> True\n       CmmAssign (CmmLocal r) _ -> not (r `Set.member` live)\n       _otherwise -> False\n\n\ntoNode :: Assignment -> CmmNode O O\ntoNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs\n\ndropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> Assignments\n                      -> ([CmmNode O O], Assignments)\ndropAssignmentsSimple dflags f = dropAssignments dflags (\\a _ -> (f a, ())) ()\n\ndropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> Assignments\n                -> ([CmmNode O O], Assignments)\ndropAssignments dflags should_drop state assigs\n = (dropped, reverse kept)\n where\n   (dropped,kept) = go state assigs [] []\n\n   go _ []             dropped kept = (dropped, kept)\n   go state (assig : rest) dropped kept\n      | conflict  = go state' rest (toNode assig : dropped) kept\n      | otherwise = go state' rest dropped (assig:kept)\n      where\n        (dropit, state') = should_drop assig state\n        conflict = dropit || any (conflicts dflags assig) dropped\n\n\n-- -----------------------------------------------------------------------------\n-- Try to inline assignments into a node.\n-- This also does constant folding for primpops, since\n-- inlining opens up opportunities for doing so.\n\ntryToInline\n   :: DynFlags\n   -> LocalRegSet               -- set of registers live after this\n                                -- node.  We cannot inline anything\n                                -- that is live after the node, unless\n                                -- it is small enough to duplicate.\n   -> CmmNode O x               -- The node to inline into\n   -> Assignments               -- Assignments to inline\n   -> (\n        CmmNode O x             -- New node\n      , Assignments             -- Remaining assignments\n      )\n\ntryToInline dflags live node assigs = go usages node emptyLRegSet assigs\n where\n  usages :: UniqFM Int -- Maps each LocalReg to a count of how often it is used\n  usages = foldLocalRegsUsed dflags addUsage emptyUFM node\n\n  go _usages node _skipped [] = (node, [])\n\n  go usages node skipped (a@(l,rhs,_) : rest)\n   | cannot_inline           = dont_inline\n   | occurs_none             = discard  -- Note [discard during inlining]\n   | occurs_once             = inline_and_discard\n   | isTrivial dflags rhs    = inline_and_keep\n   | otherwise               = dont_inline\n   where\n        inline_and_discard = go usages' inl_node skipped rest\n          where usages' = foldLocalRegsUsed dflags addUsage usages rhs\n\n        discard = go usages node skipped rest\n\n        dont_inline        = keep node  -- don't inline the assignment, keep it\n        inline_and_keep    = keep inl_node -- inline the assignment, keep it\n\n        keep node' = (final_node, a : rest')\n          where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest\n                usages' = foldLocalRegsUsed dflags (\\m r -> addToUFM m r 2)\n                                            usages rhs\n                -- we must not inline anything that is mentioned in the RHS\n                -- of a binding that we have already skipped, so we set the\n                -- usages of the regs on the RHS to 2.\n\n        cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments]\n                        || l `elemLRegSet` skipped\n                        || not (okToInline dflags rhs node)\n\n        l_usages = lookupUFM usages l\n        l_live   = l `elemRegSet` live\n\n        occurs_once = not l_live && l_usages == Just 1\n        occurs_none = not l_live && l_usages == Nothing\n\n        inl_node = improveConditional (mapExpDeep inl_exp node)\n\n        inl_exp :: CmmExpr -> CmmExpr\n        -- inl_exp is where the inlining actually takes place!\n        inl_exp (CmmReg    (CmmLocal l'))     | l == l' = rhs\n        inl_exp (CmmRegOff (CmmLocal l') off) | l == l'\n                    = cmmOffset dflags rhs off\n                    -- re-constant fold after inlining\n        inl_exp (CmmMachOp op args) = cmmMachOpFold dflags op args\n        inl_exp other = other\n\n\n{- Note [improveConditional]\n\ncmmMachOpFold tries to simplify conditionals to turn things like\n  (a == b) != 1\ninto\n  (a != b)\nbut there's one case it can't handle: when the comparison is over\nfloating-point values, we can't invert it, because floating-point\ncomparisons aren't invertible (because of NaNs).\n\nBut we *can* optimise this conditional by swapping the true and false\nbranches. Given\n  CmmCondBranch ((a >## b) != 1) t f\nwe can turn it into\n  CmmCondBranch (a >## b) f t\n\nSo here we catch conditionals that weren't optimised by cmmMachOpFold,\nand apply above transformation to eliminate the comparison against 1.\n\nIt's tempting to just turn every != into == and then let cmmMachOpFold\ndo its thing, but that risks changing a nice fall-through conditional\ninto one that requires two jumps. (see swapcond_last in\nCmmContFlowOpt), so instead we carefully look for just the cases where\nwe can eliminate a comparison.\n-}\nimproveConditional :: CmmNode O x -> CmmNode O x\nimproveConditional\n  (CmmCondBranch (CmmMachOp mop [x, CmmLit (CmmInt 1 _)]) t f l)\n  | neLike mop, isComparisonExpr x\n  = CmmCondBranch x f t (fmap not l)\n  where\n    neLike (MO_Ne _) = True\n    neLike (MO_U_Lt _) = True   -- (x<y) < 1 behaves like (x<y) != 1\n    neLike (MO_S_Lt _) = True   -- (x<y) < 1 behaves like (x<y) != 1\n    neLike _ = False\nimproveConditional other = other\n\n-- Note [dependent assignments]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- If our assignment list looks like\n--\n--    [ y = e,  x = ... y ... ]\n--\n-- We cannot inline x.  Remember this list is really in reverse order,\n-- so it means  x = ... y ...; y = e\n--\n-- Hence if we inline x, the outer assignment to y will capture the\n-- reference in x's right hand side.\n--\n-- In this case we should rename the y in x's right-hand side,\n-- i.e. change the list to [ y = e, x = ... y1 ..., y1 = y ]\n-- Now we can go ahead and inline x.\n--\n-- For now we do nothing, because this would require putting\n-- everything inside UniqSM.\n--\n-- One more variant of this (#7366):\n--\n--   [ y = e, y = z ]\n--\n-- If we don't want to inline y = e, because y is used many times, we\n-- might still be tempted to inline y = z (because we always inline\n-- trivial rhs's).  But of course we can't, because y is equal to e,\n-- not z.\n\n-- Note [discard during inlining]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Opportunities to discard assignments sometimes appear after we've\n-- done some inlining.  Here's an example:\n--\n--      x = R1;\n--      y = P64[x + 7];\n--      z = P64[x + 15];\n--      /* z is dead */\n--      R1 = y & (-8);\n--\n-- The x assignment is trivial, so we inline it in the RHS of y, and\n-- keep both x and y.  z gets dropped because it is dead, then we\n-- inline y, and we have a dead assignment to x.  If we don't notice\n-- that x is dead in tryToInline, we end up retaining it.\n\naddUsage :: UniqFM Int -> LocalReg -> UniqFM Int\naddUsage m r = addToUFM_C (+) m r 1\n\nregsUsedIn :: LRegSet -> CmmExpr -> Bool\nregsUsedIn ls _ | nullLRegSet ls = False\nregsUsedIn ls e = wrapRecExpf f e False\n  where f (CmmReg (CmmLocal l))      _ | l `elemLRegSet` ls = True\n        f (CmmRegOff (CmmLocal l) _) _ | l `elemLRegSet` ls = True\n        f _ z = z\n\n-- we don't inline into CmmUnsafeForeignCall if the expression refers\n-- to global registers.  This is a HACK to avoid global registers\n-- clashing with C argument-passing registers, really the back-end\n-- ought to be able to handle it properly, but currently neither PprC\n-- nor the NCG can do it.  See Note [Register parameter passing]\n-- See also StgCmmForeign:load_args_into_temps.\nokToInline :: DynFlags -> CmmExpr -> CmmNode e x -> Bool\nokToInline dflags expr node@(CmmUnsafeForeignCall{}) =\n    not (globalRegistersConflict dflags expr node)\nokToInline _ _ _ = True\n\n-- -----------------------------------------------------------------------------\n\n-- | @conflicts (r,e) node@ is @False@ if and only if the assignment\n-- @r = e@ can be safely commuted past statement @node@.\nconflicts :: DynFlags -> Assignment -> CmmNode O x -> Bool\nconflicts dflags (r, rhs, addr) node\n\n  -- (1) node defines registers used by rhs of assignment. This catches\n  -- assignments and all three kinds of calls. See Note [Sinking and calls]\n  | globalRegistersConflict dflags rhs node                       = True\n  | localRegistersConflict  dflags rhs node                       = True\n\n  -- (2) node uses register defined by assignment\n  | foldRegsUsed dflags (\\b r' -> r == r' || b) False node        = True\n\n  -- (3) a store to an address conflicts with a read of the same memory\n  | CmmStore addr' e <- node\n  , memConflicts addr (loadAddr dflags addr' (cmmExprWidth dflags e)) = True\n\n  -- (4) an assignment to Hp/Sp conflicts with a heap/stack read respectively\n  | HeapMem    <- addr, CmmAssign (CmmGlobal Hp) _ <- node        = True\n  | StackMem   <- addr, CmmAssign (CmmGlobal Sp) _ <- node        = True\n  | SpMem{}    <- addr, CmmAssign (CmmGlobal Sp) _ <- node        = True\n\n  -- (5) foreign calls clobber heap: see Note [Foreign calls clobber heap]\n  | CmmUnsafeForeignCall{} <- node, memConflicts addr AnyMem      = True\n\n  -- (6) native calls clobber any memory\n  | CmmCall{} <- node, memConflicts addr AnyMem                   = True\n\n  -- (7) otherwise, no conflict\n  | otherwise = False\n\n-- Returns True if node defines any global registers that are used in the\n-- Cmm expression\nglobalRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool\nglobalRegistersConflict dflags expr node =\n    foldRegsDefd dflags (\\b r -> b || regUsedIn dflags (CmmGlobal r) expr)\n                 False node\n\n-- Returns True if node defines any local registers that are used in the\n-- Cmm expression\nlocalRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool\nlocalRegistersConflict dflags expr node =\n    foldRegsDefd dflags (\\b r -> b || regUsedIn dflags (CmmLocal  r) expr)\n                 False node\n\n-- Note [Sinking and calls]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- We have three kinds of calls: normal (CmmCall), safe foreign (CmmForeignCall)\n-- and unsafe foreign (CmmUnsafeForeignCall). We perform sinking pass after\n-- stack layout (see Note [Sinking after stack layout]) which leads to two\n-- invariants related to calls:\n--\n--   a) during stack layout phase all safe foreign calls are turned into\n--      unsafe foreign calls (see Note [Lower safe foreign calls]). This\n--      means that we will never encounter CmmForeignCall node when running\n--      sinking after stack layout\n--\n--   b) stack layout saves all variables live across a call on the stack\n--      just before making a call (remember we are not sinking assignments to\n--      stack):\n--\n--       L1:\n--          x = R1\n--          P64[Sp - 16] = L2\n--          P64[Sp - 8]  = x\n--          Sp = Sp - 16\n--          call f() returns L2\n--       L2:\n--\n--      We will attempt to sink { x = R1 } but we will detect conflict with\n--      { P64[Sp - 8]  = x } and hence we will drop { x = R1 } without even\n--      checking whether it conflicts with { call f() }. In this way we will\n--      never need to check any assignment conflicts with CmmCall. Remember\n--      that we still need to check for potential memory conflicts.\n--\n-- So the result is that we only need to worry about CmmUnsafeForeignCall nodes\n-- when checking conflicts (see Note [Unsafe foreign calls clobber caller-save registers]).\n-- This assumption holds only when we do sinking after stack layout. If we run\n-- it before stack layout we need to check for possible conflicts with all three\n-- kinds of calls. Our `conflicts` function does that by using a generic\n-- foldRegsDefd and foldRegsUsed functions defined in DefinerOfRegs and\n-- UserOfRegs typeclasses.\n--\n\n-- An abstraction of memory read or written.\ndata AbsMem\n  = NoMem            -- no memory accessed\n  | AnyMem           -- arbitrary memory\n  | HeapMem          -- definitely heap memory\n  | StackMem         -- definitely stack memory\n  | SpMem            -- <size>[Sp+n]\n       {-# UNPACK #-} !Int\n       {-# UNPACK #-} !Int\n\n-- Having SpMem is important because it lets us float loads from Sp\n-- past stores to Sp as long as they don't overlap, and this helps to\n-- unravel some long sequences of\n--    x1 = [Sp + 8]\n--    x2 = [Sp + 16]\n--    ...\n--    [Sp + 8]  = xi\n--    [Sp + 16] = xj\n--\n-- Note that SpMem is invalidated if Sp is changed, but the definition\n-- of 'conflicts' above handles that.\n\n-- ToDo: this won't currently fix the following commonly occurring code:\n--    x1 = [R1 + 8]\n--    x2 = [R1 + 16]\n--    ..\n--    [Hp - 8] = x1\n--    [Hp - 16] = x2\n--    ..\n\n-- because [R1 + 8] and [Hp - 8] are both HeapMem.  We know that\n-- assignments to [Hp + n] do not conflict with any other heap memory,\n-- but this is tricky to nail down.  What if we had\n--\n--   x = Hp + n\n--   [x] = ...\n--\n--  the store to [x] should be \"new heap\", not \"old heap\".\n--  Furthermore, you could imagine that if we started inlining\n--  functions in Cmm then there might well be reads of heap memory\n--  that was written in the same basic block.  To take advantage of\n--  non-aliasing of heap memory we will have to be more clever.\n\n-- Note [Foreign calls clobber heap]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- It is tempting to say that foreign calls clobber only\n-- non-heap/stack memory, but unfortunately we break this invariant in\n-- the RTS.  For example, in stg_catch_retry_frame we call\n-- stmCommitNestedTransaction() which modifies the contents of the\n-- TRec it is passed (this actually caused incorrect code to be\n-- generated).\n--\n-- Since the invariant is true for the majority of foreign calls,\n-- perhaps we ought to have a special annotation for calls that can\n-- modify heap/stack memory.  For now we just use the conservative\n-- definition here.\n--\n-- Some CallishMachOp imply a memory barrier e.g. AtomicRMW and\n-- therefore we should never float any memory operations across one of\n-- these calls.\n\n\nbothMems :: AbsMem -> AbsMem -> AbsMem\nbothMems NoMem    x         = x\nbothMems x        NoMem     = x\nbothMems HeapMem  HeapMem   = HeapMem\nbothMems StackMem StackMem     = StackMem\nbothMems (SpMem o1 w1) (SpMem o2 w2)\n  | o1 == o2  = SpMem o1 (max w1 w2)\n  | otherwise = StackMem\nbothMems SpMem{}  StackMem  = StackMem\nbothMems StackMem SpMem{}   = StackMem\nbothMems _         _        = AnyMem\n\nmemConflicts :: AbsMem -> AbsMem -> Bool\nmemConflicts NoMem      _          = False\nmemConflicts _          NoMem      = False\nmemConflicts HeapMem    StackMem   = False\nmemConflicts StackMem   HeapMem    = False\nmemConflicts SpMem{}    HeapMem    = False\nmemConflicts HeapMem    SpMem{}    = False\nmemConflicts (SpMem o1 w1) (SpMem o2 w2)\n  | o1 < o2   = o1 + w1 > o2\n  | otherwise = o2 + w2 > o1\nmemConflicts _         _         = True\n\nexprMem :: DynFlags -> CmmExpr -> AbsMem\nexprMem dflags (CmmLoad addr w)  = bothMems (loadAddr dflags addr (typeWidth w)) (exprMem dflags addr)\nexprMem dflags (CmmMachOp _ es)  = foldr bothMems NoMem (map (exprMem dflags) es)\nexprMem _      _                 = NoMem\n\nloadAddr :: DynFlags -> CmmExpr -> Width -> AbsMem\nloadAddr dflags e w =\n  case e of\n   CmmReg r       -> regAddr dflags r 0 w\n   CmmRegOff r i  -> regAddr dflags r i w\n   _other | regUsedIn dflags spReg e -> StackMem\n          | otherwise -> AnyMem\n\nregAddr :: DynFlags -> CmmReg -> Int -> Width -> AbsMem\nregAddr _      (CmmGlobal Sp) i w = SpMem i (widthInBytes w)\nregAddr _      (CmmGlobal Hp) _ _ = HeapMem\nregAddr _      (CmmGlobal CurrentTSO) _ _ = HeapMem -- important for PrimOps\nregAddr dflags r _ _ | isGcPtrType (cmmRegType dflags r) = HeapMem -- yay! GCPtr pays for itself\nregAddr _      _ _ _ = AnyMem\n\n{-\nNote [Inline GlobalRegs?]\n\nShould we freely inline GlobalRegs?\n\nActually it doesn't make a huge amount of difference either way, so we\n*do* currently treat GlobalRegs as \"trivial\" and inline them\neverywhere, but for what it's worth, here is what I discovered when I\n(SimonM) looked into this:\n\nCommon sense says we should not inline GlobalRegs, because when we\nhave\n\n  x = R1\n\nthe register allocator will coalesce this assignment, generating no\ncode, and simply record the fact that x is bound to $rbx (or\nwhatever).  Furthermore, if we were to sink this assignment, then the\nrange of code over which R1 is live increases, and the range of code\nover which x is live decreases.  All things being equal, it is better\nfor x to be live than R1, because R1 is a fixed register whereas x can\nlive in any register.  So we should neither sink nor inline 'x = R1'.\n\nHowever, not inlining GlobalRegs can have surprising\nconsequences. e.g. (cgrun020)\n\n  c3EN:\n      _s3DB::P64 = R1;\n      _c3ES::P64 = _s3DB::P64 & 7;\n      if (_c3ES::P64 >= 2) goto c3EU; else goto c3EV;\n  c3EU:\n      _s3DD::P64 = P64[_s3DB::P64 + 6];\n      _s3DE::P64 = P64[_s3DB::P64 + 14];\n      I64[Sp - 8] = c3F0;\n      R1 = _s3DE::P64;\n      P64[Sp] = _s3DD::P64;\n\ninlining the GlobalReg gives:\n\n  c3EN:\n      if (R1 & 7 >= 2) goto c3EU; else goto c3EV;\n  c3EU:\n      I64[Sp - 8] = c3F0;\n      _s3DD::P64 = P64[R1 + 6];\n      R1 = P64[R1 + 14];\n      P64[Sp] = _s3DD::P64;\n\nbut if we don't inline the GlobalReg, instead we get:\n\n      _s3DB::P64 = R1;\n      if (_s3DB::P64 & 7 >= 2) goto c3EU; else goto c3EV;\n  c3EU:\n      I64[Sp - 8] = c3F0;\n      R1 = P64[_s3DB::P64 + 14];\n      P64[Sp] = P64[_s3DB::P64 + 6];\n\nThis looks better - we managed to inline _s3DD - but in fact it\ngenerates an extra reg-reg move:\n\n.Lc3EU:\n        movq $c3F0_info,-8(%rbp)\n        movq %rbx,%rax\n        movq 14(%rbx),%rbx\n        movq 6(%rax),%rax\n        movq %rax,(%rbp)\n\nbecause _s3DB is now live across the R1 assignment, we lost the\nbenefit of coalescing.\n\nWho is at fault here?  Perhaps if we knew that _s3DB was an alias for\nR1, then we would not sink a reference to _s3DB past the R1\nassignment.  Or perhaps we *should* do that - we might gain by sinking\nit, despite losing the coalescing opportunity.\n\nSometimes not inlining global registers wins by virtue of the rule\nabout not inlining into arguments of a foreign call, e.g. (T7163) this\nis what happens when we inlined F1:\n\n      _s3L2::F32 = F1;\n      _c3O3::F32 = %MO_F_Mul_W32(F1, 10.0 :: W32);\n      (_s3L7::F32) = call \"ccall\" arg hints:  []  result hints:  [] rintFloat(_c3O3::F32);\n\nbut if we don't inline F1:\n\n      (_s3L7::F32) = call \"ccall\" arg hints:  []  result hints:  [] rintFloat(%MO_F_Mul_W32(_s3L2::F32,\n                                                                                            10.0 :: W32));\n-}\n", "num_lines": 856}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule CmmSwitch (\n     SwitchTargets,\n     mkSwitchTargets,\n     switchTargetsCases, switchTargetsDefault, switchTargetsRange, switchTargetsSigned,\n     mapSwitchTargets, switchTargetsToTable, switchTargetsFallThrough,\n     switchTargetsToList, eqSwitchTargetWith,\n\n     SwitchPlan(..),\n     targetSupportsSwitch,\n     createSwitchPlan,\n  ) where\n\nimport GhcPrelude\n\nimport Outputable\nimport DynFlags\nimport Hoopl.Label (Label)\n\nimport Data.Maybe\nimport Data.List (groupBy)\nimport Data.Function (on)\nimport qualified Data.Map as M\n\n-- Note [Cmm Switches, the general plan]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Compiling a high-level switch statement, as it comes out of a STG case\n-- expression, for example, allows for a surprising amount of design decisions.\n-- Therefore, we cleanly separated this from the Stg \u00e2\u2020\u2019 Cmm transformation, as\n-- well as from the actual code generation.\n--\n-- The overall plan is:\n--  * The Stg \u00e2\u2020\u2019 Cmm transformation creates a single `SwitchTargets` in\n--    emitSwitch and emitCmmLitSwitch in StgCmmUtils.hs.\n--    At this stage, they are unsuitable for code generation.\n--  * A dedicated Cmm transformation (CmmImplementSwitchPlans) replaces these\n--    switch statements with code that is suitable for code generation, i.e.\n--    a nice balanced tree of decisions with dense jump tables in the leafs.\n--    The actual planning of this tree is performed in pure code in createSwitchPlan\n--    in this module. See Note [createSwitchPlan].\n--  * The actual code generation will not do any further processing and\n--    implement each CmmSwitch with a jump tables.\n--\n-- When compiling to LLVM or C, CmmImplementSwitchPlans leaves the switch\n-- statements alone, as we can turn a SwitchTargets value into a nice\n-- switch-statement in LLVM resp. C, and leave the rest to the compiler.\n--\n-- See Note [CmmSwitch vs. CmmImplementSwitchPlans] why the two module are\n-- separated.\n\n-----------------------------------------------------------------------------\n-- Note [Magic Constants in CmmSwitch]\n--\n-- There are a lot of heuristics here that depend on magic values where it is\n-- hard to determine the \"best\" value (for whatever that means). These are the\n-- magic values:\n\n-- | Number of consecutive default values allowed in a jump table. If there are\n-- more of them, the jump tables are split.\n--\n-- Currently 7, as it costs 7 words of additional code when a jump table is\n-- split (at least on x64, determined experimentally).\nmaxJumpTableHole :: Integer\nmaxJumpTableHole = 7\n\n-- | Minimum size of a jump table. If the number is smaller, the switch is\n-- implemented using conditionals.\n-- Currently 5, because an if-then-else tree of 4 values is nice and compact.\nminJumpTableSize :: Int\nminJumpTableSize = 5\n\n-- | Minimum non-zero offset for a jump table. See Note [Jump Table Offset].\nminJumpTableOffset :: Integer\nminJumpTableOffset = 2\n\n\n-----------------------------------------------------------------------------\n-- Switch Targets\n\n-- Note [SwitchTargets]:\n-- ~~~~~~~~~~~~~~~~~~~~~\n--\n-- The branches of a switch are stored in a SwitchTargets, which consists of an\n-- (optional) default jump target, and a map from values to jump targets.\n--\n-- If the default jump target is absent, the behaviour of the switch outside the\n-- values of the map is undefined.\n--\n-- We use an Integer for the keys the map so that it can be used in switches on\n-- unsigned as well as signed integers.\n--\n-- The map may be empty (we prune out-of-range branches here, so it could be us\n-- emptying it).\n--\n-- Before code generation, the table needs to be brought into a form where all\n-- entries are non-negative, so that it can be compiled into a jump table.\n-- See switchTargetsToTable.\n\n\n-- | A value of type SwitchTargets contains the alternatives for a 'CmmSwitch'\n-- value, and knows whether the value is signed, the possible range, an\n-- optional default value and a map from values to jump labels.\ndata SwitchTargets =\n    SwitchTargets\n        Bool                       -- Signed values\n        (Integer, Integer)         -- Range\n        (Maybe Label)              -- Default value\n        (M.Map Integer Label)      -- The branches\n    deriving (Show, Eq)\n\n-- | The smart constructor mkSwitchTargets normalises the map a bit:\n--  * No entries outside the range\n--  * No entries equal to the default\n--  * No default if all elements have explicit values\nmkSwitchTargets :: Bool -> (Integer, Integer) -> Maybe Label -> M.Map Integer Label -> SwitchTargets\nmkSwitchTargets signed range@(lo,hi) mbdef ids\n    = SwitchTargets signed range mbdef' ids'\n  where\n    ids' = dropDefault $ restrict ids\n    mbdef' | defaultNeeded = mbdef\n           | otherwise     = Nothing\n\n    -- Drop entries outside the range, if there is a range\n    restrict = restrictMap (lo,hi)\n\n    -- Drop entries that equal the default, if there is a default\n    dropDefault | Just l <- mbdef = M.filter (/= l)\n                | otherwise       = id\n\n    -- Check if the default is still needed\n    defaultNeeded = fromIntegral (M.size ids') /= hi-lo+1\n\n\n-- | Changes all labels mentioned in the SwitchTargets value\nmapSwitchTargets :: (Label -> Label) -> SwitchTargets -> SwitchTargets\nmapSwitchTargets f (SwitchTargets signed range mbdef branches)\n    = SwitchTargets signed range (fmap f mbdef) (fmap f branches)\n\n-- | Returns the list of non-default branches of the SwitchTargets value\nswitchTargetsCases :: SwitchTargets -> [(Integer, Label)]\nswitchTargetsCases (SwitchTargets _ _ _ branches) = M.toList branches\n\n-- | Return the default label of the SwitchTargets value\nswitchTargetsDefault :: SwitchTargets -> Maybe Label\nswitchTargetsDefault (SwitchTargets _ _ mbdef _) = mbdef\n\n-- | Return the range of the SwitchTargets value\nswitchTargetsRange :: SwitchTargets -> (Integer, Integer)\nswitchTargetsRange (SwitchTargets _ range _ _) = range\n\n-- | Return whether this is used for a signed value\nswitchTargetsSigned :: SwitchTargets -> Bool\nswitchTargetsSigned (SwitchTargets signed _ _ _) = signed\n\n-- | switchTargetsToTable creates a dense jump table, usable for code generation.\n--\n-- Also returns an offset to add to the value; the list is 0-based on the\n-- result of that addition.\n--\n-- The conversion from Integer to Int is a bit of a wart, as the actual\n-- scrutinee might be an unsigned word, but it just works, due to wrap-around\n-- arithmetic (as verified by the CmmSwitchTest test case).\nswitchTargetsToTable :: SwitchTargets -> (Int, [Maybe Label])\nswitchTargetsToTable (SwitchTargets _ (lo,hi) mbdef branches)\n    = (fromIntegral (-start), [ labelFor i | i <- [start..hi] ])\n  where\n    labelFor i = case M.lookup i branches of Just l -> Just l\n                                             Nothing -> mbdef\n    start | lo >= 0 && lo < minJumpTableOffset  = 0  -- See Note [Jump Table Offset]\n          | otherwise                           = lo\n\n-- Note [Jump Table Offset]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Usually, the code for a jump table starting at x will first subtract x from\n-- the value, to avoid a large amount of empty entries. But if x is very small,\n-- the extra entries are no worse than the subtraction in terms of code size, and\n-- not having to do the subtraction is quicker.\n--\n-- I.e. instead of\n--     _u20N:\n--             leaq -1(%r14),%rax\n--             jmp *_n20R(,%rax,8)\n--     _n20R:\n--             .quad   _c20p\n--             .quad   _c20q\n-- do\n--     _u20N:\n--             jmp *_n20Q(,%r14,8)\n--\n--     _n20Q:\n--             .quad   0\n--             .quad   _c20p\n--             .quad   _c20q\n--             .quad   _c20r\n\n-- | The list of all labels occuring in the SwitchTargets value.\nswitchTargetsToList :: SwitchTargets -> [Label]\nswitchTargetsToList (SwitchTargets _ _ mbdef branches)\n    = maybeToList mbdef ++ M.elems branches\n\n-- | Groups cases with equal targets, suitable for pretty-printing to a\n-- c-like switch statement with fall-through semantics.\nswitchTargetsFallThrough :: SwitchTargets -> ([([Integer], Label)], Maybe Label)\nswitchTargetsFallThrough (SwitchTargets _ _ mbdef branches) = (groups, mbdef)\n  where\n    groups = map (\\xs -> (map fst xs, snd (head xs))) $\n             groupBy ((==) `on` snd) $\n             M.toList branches\n\n-- | Custom equality helper, needed for \"CmmCommonBlockElim\"\neqSwitchTargetWith :: (Label -> Label -> Bool) -> SwitchTargets -> SwitchTargets -> Bool\neqSwitchTargetWith eq (SwitchTargets signed1 range1 mbdef1 ids1) (SwitchTargets signed2 range2 mbdef2 ids2) =\n    signed1 == signed2 && range1 == range2 && goMB mbdef1 mbdef2 && goList (M.toList ids1) (M.toList ids2)\n  where\n    goMB Nothing Nothing = True\n    goMB (Just l1) (Just l2) = l1 `eq` l2\n    goMB _ _ = False\n    goList [] [] = True\n    goList ((i1,l1):ls1) ((i2,l2):ls2) = i1 == i2 && l1 `eq` l2 && goList ls1 ls2\n    goList _ _ = False\n\n-----------------------------------------------------------------------------\n-- Code generation for Switches\n\n\n-- | A SwitchPlan abstractly describes how a Switch statement ought to be\n-- implemented. See Note [createSwitchPlan]\ndata SwitchPlan\n    = Unconditionally Label\n    | IfEqual Integer Label SwitchPlan\n    | IfLT Bool Integer SwitchPlan SwitchPlan\n    | JumpTable SwitchTargets\n  deriving Show\n--\n-- Note [createSwitchPlan]\n-- ~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- A SwitchPlan describes how a Switch statement is to be broken down into\n-- smaller pieces suitable for code generation.\n--\n-- createSwitchPlan creates such a switch plan, in these steps:\n--  1. It splits the switch statement at segments of non-default values that\n--     are too large. See splitAtHoles and Note [Magic Constants in CmmSwitch]\n--  2. Too small jump tables should be avoided, so we break up smaller pieces\n--     in breakTooSmall.\n--  3. We fill in the segments between those pieces with a jump to the default\n--     label (if there is one), returning a SeparatedList in mkFlatSwitchPlan\n--  4. We find and replace two less-than branches by a single equal-to-test in\n--     findSingleValues\n--  5. The thus collected pieces are assembled to a balanced binary tree.\n\n{-\n  Note [Two alts + default]\n  ~~~~~~~~~~~~~~~~~~~~~~~~~\n\nDiscussion and a bit more info at #14644\n\nWhen dealing with a switch of the form:\nswitch(e) {\n  case 1: goto l1;\n  case 3000: goto l2;\n  default: goto ldef;\n}\n\nIf we treat it as a sparse jump table we would generate:\n\nif (e > 3000) //Check if value is outside of the jump table.\n    goto ldef;\nelse {\n    if (e < 3000) { //Compare to upper value\n        if(e != 1) //Compare to remaining value\n            goto ldef;\n          else\n            goto l2;\n    }\n    else\n        goto l1;\n}\n\nInstead we special case this to :\n\nif (e==1) goto l1;\nelse if (e==3000) goto l2;\nelse goto l3;\n\nThis means we have:\n* Less comparisons for: 1,<3000\n* Unchanged for 3000\n* One more for >3000\n\nThis improves code in a few ways:\n* One comparison less means smaller code which helps with cache.\n* It exchanges a taken jump for two jumps no taken in the >range case.\n  Jumps not taken are cheaper (See Agner guides) making this about as fast.\n* For all other cases the first range check is removed making it faster.\n\nThe end result is that the change is not measurably slower for the case\n>3000 and faster for the other cases.\n\nThis makes running this kind of match in an inner loop cheaper by 10-20%\ndepending on the data.\nIn nofib this improves wheel-sieve1 by 4-9% depending on problem\nsize.\n\nWe could also add a second conditional jump after the comparison to\nkeep the range check like this:\n    cmp 3000, rArgument\n    jg <default>\n    je <branch 2>\nWhile this is fairly cheap it made no big difference for the >3000 case\nand slowed down all other cases making it not worthwhile.\n-}\n\n\n-- | Does the target support switch out of the box? Then leave this to the\n-- target!\ntargetSupportsSwitch :: HscTarget -> Bool\ntargetSupportsSwitch HscC = True\ntargetSupportsSwitch HscLlvm = True\ntargetSupportsSwitch _ = False\n\n-- | This function creates a SwitchPlan from a SwitchTargets value, breaking it\n-- down into smaller pieces suitable for code generation.\ncreateSwitchPlan :: SwitchTargets -> SwitchPlan\n-- Lets do the common case of a singleton map quicky and efficiently (#10677)\ncreateSwitchPlan (SwitchTargets _signed _range (Just defLabel) m)\n    | [(x, l)] <- M.toList m\n    = IfEqual x l (Unconditionally defLabel)\n-- And another common case, matching \"booleans\"\ncreateSwitchPlan (SwitchTargets _signed (lo,hi) Nothing m)\n    | [(x1, l1), (_x2,l2)] <- M.toAscList m\n    --Checking If |range| = 2 is enough if we have two unique literals\n    , hi - lo == 1\n    = IfEqual x1 l1 (Unconditionally l2)\n-- See Note [Two alts + default]\ncreateSwitchPlan (SwitchTargets _signed _range (Just defLabel) m)\n    | [(x1, l1), (x2,l2)] <- M.toAscList m\n    = IfEqual x1 l1 (IfEqual x2 l2 (Unconditionally defLabel))\ncreateSwitchPlan (SwitchTargets signed range mbdef m) =\n    -- pprTrace \"createSwitchPlan\" (text (show ids) $$ text (show (range,m)) $$ text (show pieces) $$ text (show flatPlan) $$ text (show plan)) $\n    plan\n  where\n    pieces = concatMap breakTooSmall $ splitAtHoles maxJumpTableHole m\n    flatPlan = findSingleValues $ mkFlatSwitchPlan signed mbdef range pieces\n    plan = buildTree signed $ flatPlan\n\n\n---\n--- Step 1: Splitting at large holes\n---\nsplitAtHoles :: Integer -> M.Map Integer a -> [M.Map Integer a]\nsplitAtHoles _        m | M.null m = []\nsplitAtHoles holeSize m = map (\\range -> restrictMap range m) nonHoles\n  where\n    holes = filter (\\(l,h) -> h - l > holeSize) $ zip (M.keys m) (tail (M.keys m))\n    nonHoles = reassocTuples lo holes hi\n\n    (lo,_) = M.findMin m\n    (hi,_) = M.findMax m\n\n---\n--- Step 2: Avoid small jump tables\n---\n-- We do not want jump tables below a certain size. This breaks them up\n-- (into singleton maps, for now).\nbreakTooSmall :: M.Map Integer a -> [M.Map Integer a]\nbreakTooSmall m\n  | M.size m > minJumpTableSize = [m]\n  | otherwise                   = [M.singleton k v | (k,v) <- M.toList m]\n\n---\n---  Step 3: Fill in the blanks\n---\n\n-- | A FlatSwitchPlan is a list of SwitchPlans, with an integer inbetween every\n-- two entries, dividing the range.\n-- So if we have (abusing list syntax) [plan1,n,plan2], then we use plan1 if\n-- the expression is < n, and plan2 otherwise.\n\ntype FlatSwitchPlan = SeparatedList Integer SwitchPlan\n\nmkFlatSwitchPlan :: Bool -> Maybe Label -> (Integer, Integer) -> [M.Map Integer Label] -> FlatSwitchPlan\n\n-- If we have no default (i.e. undefined where there is no entry), we can\n-- branch at the minimum of each map\nmkFlatSwitchPlan _ Nothing _ [] = pprPanic \"mkFlatSwitchPlan with nothing left to do\" empty\nmkFlatSwitchPlan signed  Nothing _ (m:ms)\n  = (mkLeafPlan signed Nothing m , [ (fst (M.findMin m'), mkLeafPlan signed Nothing m') | m' <- ms ])\n\n-- If we have a default, we have to interleave segments that jump\n-- to the default between the maps\nmkFlatSwitchPlan signed (Just l) r ms = let ((_,p1):ps) = go r ms in (p1, ps)\n  where\n    go (lo,hi) []\n        | lo > hi = []\n        | otherwise = [(lo, Unconditionally l)]\n    go (lo,hi) (m:ms)\n        | lo < min\n        = (lo, Unconditionally l) : go (min,hi) (m:ms)\n        | lo == min\n        = (lo, mkLeafPlan signed (Just l) m) : go (max+1,hi) ms\n        | otherwise\n        = pprPanic \"mkFlatSwitchPlan\" (integer lo <+> integer min)\n      where\n        min = fst (M.findMin m)\n        max = fst (M.findMax m)\n\n\nmkLeafPlan :: Bool -> Maybe Label -> M.Map Integer Label -> SwitchPlan\nmkLeafPlan signed mbdef m\n    | [(_,l)] <- M.toList m -- singleton map\n    = Unconditionally l\n    | otherwise\n    = JumpTable $ mkSwitchTargets signed (min,max) mbdef m\n  where\n    min = fst (M.findMin m)\n    max = fst (M.findMax m)\n\n---\n---  Step 4: Reduce the number of branches using ==\n---\n\n-- A sequence of three unconditional jumps, with the outer two pointing to the\n-- same value and the bounds off by exactly one can be improved\nfindSingleValues :: FlatSwitchPlan -> FlatSwitchPlan\nfindSingleValues (Unconditionally l, (i, Unconditionally l2) : (i', Unconditionally l3) : xs)\n  | l == l3 && i + 1 == i'\n  = findSingleValues (IfEqual i l2 (Unconditionally l), xs)\nfindSingleValues (p, (i,p'):xs)\n  = (p,i) `consSL` findSingleValues (p', xs)\nfindSingleValues (p, [])\n  = (p, [])\n\n---\n---  Step 5: Actually build the tree\n---\n\n-- Build a balanced tree from a separated list\nbuildTree :: Bool -> FlatSwitchPlan -> SwitchPlan\nbuildTree _ (p,[]) = p\nbuildTree signed sl = IfLT signed m (buildTree signed sl1) (buildTree signed sl2)\n  where\n    (sl1, m, sl2) = divideSL sl\n\n\n\n--\n-- Utility data type: Non-empty lists with extra markers in between each\n-- element:\n--\n\ntype SeparatedList b a = (a, [(b,a)])\n\nconsSL :: (a, b) -> SeparatedList b a -> SeparatedList b a\nconsSL (a, b) (a', xs) = (a, (b,a'):xs)\n\ndivideSL :: SeparatedList b a -> (SeparatedList b a, b, SeparatedList b a)\ndivideSL (_,[]) = error \"divideSL: Singleton SeparatedList\"\ndivideSL (p,xs) = ((p, xs1), m, (p', xs2))\n  where\n    (xs1, (m,p'):xs2) = splitAt (length xs `div` 2) xs\n\n--\n-- Other Utilities\n--\n\nrestrictMap :: (Integer,Integer) -> M.Map Integer b -> M.Map Integer b\nrestrictMap (lo,hi) m = mid\n  where (_,   mid_hi) = M.split (lo-1) m\n        (mid, _) =      M.split (hi+1) mid_hi\n\n-- for example: reassocTuples a [(b,c),(d,e)] f == [(a,b),(c,d),(e,f)]\nreassocTuples :: a -> [(a,a)] -> a -> [(a,a)]\nreassocTuples initial [] last\n    = [(initial,last)]\nreassocTuples initial ((a,b):tuples) last\n    = (initial,a) : reassocTuples b tuples last\n\n-- Note [CmmSwitch vs. CmmImplementSwitchPlans]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- I (Joachim) separated the two somewhat closely related modules\n--\n--  - CmmSwitch, which provides the CmmSwitchTargets type and contains the strategy\n--    for implementing a Cmm switch (createSwitchPlan), and\n--  - CmmImplementSwitchPlans, which contains the actuall Cmm graph modification,\n--\n-- for these reasons:\n--\n--  * CmmSwitch is very low in the dependency tree, i.e. does not depend on any\n--    GHC specific modules at all (with the exception of Output and Hoople\n--    (Literal)). CmmImplementSwitchPlans is the Cmm transformation and hence very\n--    high in the dependency tree.\n--  * CmmSwitch provides the CmmSwitchTargets data type, which is abstract, but\n--    used in CmmNodes.\n--  * Because CmmSwitch is low in the dependency tree, the separation allows\n--    for more parallelism when building GHC.\n--  * The interaction between the modules is very explicit and easy to\n--    understand, due to the small and simple interface.\n", "num_lines": 501}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CmmType\n    ( CmmType   -- Abstract\n    , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord\n    , cInt\n    , cmmBits, cmmFloat\n    , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood\n    , isFloatType, isGcPtrType, isBitsType\n    , isWord32, isWord64, isFloat64, isFloat32\n\n    , Width(..)\n    , widthInBits, widthInBytes, widthInLog, widthFromBytes\n    , wordWidth, halfWordWidth, cIntWidth\n    , halfWordMask\n    , narrowU, narrowS\n    , rEP_CostCentreStack_mem_alloc\n    , rEP_CostCentreStack_scc_count\n    , rEP_StgEntCounter_allocs\n    , rEP_StgEntCounter_allocd\n\n    , ForeignHint(..)\n\n    , Length\n    , vec, vec2, vec4, vec8, vec16\n    , vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8\n    , cmmVec\n    , vecLength, vecElemType\n    , isVecType\n   )\nwhere\n\n\nimport GhcPrelude\n\nimport DynFlags\nimport FastString\nimport Outputable\n\nimport Data.Word\nimport Data.Int\n\n-----------------------------------------------------------------------------\n--              CmmType\n-----------------------------------------------------------------------------\n\n  -- NOTE: CmmType is an abstract type, not exported from this\n  --       module so you can easily change its representation\n  --\n  -- However Width is exported in a concrete way,\n  -- and is used extensively in pattern-matching\n\ndata CmmType    -- The important one!\n  = CmmType CmmCat Width\n\ndata CmmCat                -- \"Category\" (not exported)\n   = GcPtrCat              -- GC pointer\n   | BitsCat               -- Non-pointer\n   | FloatCat              -- Float\n   | VecCat Length CmmCat  -- Vector\n   deriving( Eq )\n        -- See Note [Signed vs unsigned] at the end\n\ninstance Outputable CmmType where\n  ppr (CmmType cat wid) = ppr cat <> ppr (widthInBits wid)\n\ninstance Outputable CmmCat where\n  ppr FloatCat       = text \"F\"\n  ppr GcPtrCat       = text \"P\"\n  ppr BitsCat        = text \"I\"\n  ppr (VecCat n cat) = ppr cat <> text \"x\" <> ppr n <> text \"V\"\n\n-- Why is CmmType stratified?  For native code generation,\n-- most of the time you just want to know what sort of register\n-- to put the thing in, and for this you need to know how\n-- many bits thing has, and whether it goes in a floating-point\n-- register.  By contrast, the distinction between GcPtr and\n-- GcNonPtr is of interest to only a few parts of the code generator.\n\n-------- Equality on CmmType --------------\n-- CmmType is *not* an instance of Eq; sometimes we care about the\n-- Gc/NonGc distinction, and sometimes we don't\n-- So we use an explicit function to force you to think about it\ncmmEqType :: CmmType -> CmmType -> Bool -- Exact equality\ncmmEqType (CmmType c1 w1) (CmmType c2 w2) = c1==c2 && w1==w2\n\ncmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool\n  -- This equality is temporary; used in CmmLint\n  -- but the RTS files are not yet well-typed wrt pointers\ncmmEqType_ignoring_ptrhood (CmmType c1 w1) (CmmType c2 w2)\n   = c1 `weak_eq` c2 && w1==w2\n   where\n     weak_eq :: CmmCat -> CmmCat -> Bool\n     FloatCat         `weak_eq` FloatCat         = True\n     FloatCat         `weak_eq` _other           = False\n     _other           `weak_eq` FloatCat         = False\n     (VecCat l1 cat1) `weak_eq` (VecCat l2 cat2) = l1 == l2\n                                                   && cat1 `weak_eq` cat2\n     (VecCat {})      `weak_eq` _other           = False\n     _other           `weak_eq` (VecCat {})      = False\n     _word1           `weak_eq` _word2           = True        -- Ignores GcPtr\n\n--- Simple operations on CmmType -----\ntypeWidth :: CmmType -> Width\ntypeWidth (CmmType _ w) = w\n\ncmmBits, cmmFloat :: Width -> CmmType\ncmmBits  = CmmType BitsCat\ncmmFloat = CmmType FloatCat\n\n-------- Common CmmTypes ------------\n-- Floats and words of specific widths\nb8, b16, b32, b64, b128, b256, b512, f32, f64 :: CmmType\nb8     = cmmBits W8\nb16    = cmmBits W16\nb32    = cmmBits W32\nb64    = cmmBits W64\nb128   = cmmBits W128\nb256   = cmmBits W256\nb512   = cmmBits W512\nf32    = cmmFloat W32\nf64    = cmmFloat W64\n\n-- CmmTypes of native word widths\nbWord :: DynFlags -> CmmType\nbWord dflags = cmmBits (wordWidth dflags)\n\nbHalfWord :: DynFlags -> CmmType\nbHalfWord dflags = cmmBits (halfWordWidth dflags)\n\ngcWord :: DynFlags -> CmmType\ngcWord dflags = CmmType GcPtrCat (wordWidth dflags)\n\ncInt :: DynFlags -> CmmType\ncInt dflags = cmmBits (cIntWidth  dflags)\n\n------------ Predicates ----------------\nisFloatType, isGcPtrType, isBitsType :: CmmType -> Bool\nisFloatType (CmmType FloatCat    _) = True\nisFloatType _other                  = False\n\nisGcPtrType (CmmType GcPtrCat _) = True\nisGcPtrType _other               = False\n\nisBitsType (CmmType BitsCat _) = True\nisBitsType _                   = False\n\nisWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool\n-- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)\n-- isFloat32 and 64 are obvious\n\nisWord64 (CmmType BitsCat  W64) = True\nisWord64 (CmmType GcPtrCat W64) = True\nisWord64 _other                 = False\n\nisWord32 (CmmType BitsCat  W32) = True\nisWord32 (CmmType GcPtrCat W32) = True\nisWord32 _other                 = False\n\nisFloat32 (CmmType FloatCat W32) = True\nisFloat32 _other                 = False\n\nisFloat64 (CmmType FloatCat W64) = True\nisFloat64 _other                 = False\n\n-----------------------------------------------------------------------------\n--              Width\n-----------------------------------------------------------------------------\n\ndata Width   = W8 | W16 | W32 | W64\n             | W80      -- Extended double-precision float,\n                        -- used in x86 native codegen only.\n                        -- (we use Ord, so it'd better be in this order)\n             | W128\n             | W256\n             | W512\n             deriving (Eq, Ord, Show)\n\ninstance Outputable Width where\n   ppr rep = ptext (mrStr rep)\n\nmrStr :: Width -> PtrString\nmrStr W8   = sLit(\"W8\")\nmrStr W16  = sLit(\"W16\")\nmrStr W32  = sLit(\"W32\")\nmrStr W64  = sLit(\"W64\")\nmrStr W128 = sLit(\"W128\")\nmrStr W256 = sLit(\"W256\")\nmrStr W512 = sLit(\"W512\")\nmrStr W80  = sLit(\"W80\")\n\n\n-------- Common Widths  ------------\nwordWidth :: DynFlags -> Width\nwordWidth dflags\n | wORD_SIZE dflags == 4 = W32\n | wORD_SIZE dflags == 8 = W64\n | otherwise             = panic \"MachOp.wordRep: Unknown word size\"\n\nhalfWordWidth :: DynFlags -> Width\nhalfWordWidth dflags\n | wORD_SIZE dflags == 4 = W16\n | wORD_SIZE dflags == 8 = W32\n | otherwise             = panic \"MachOp.halfWordRep: Unknown word size\"\n\nhalfWordMask :: DynFlags -> Integer\nhalfWordMask dflags\n | wORD_SIZE dflags == 4 = 0xFFFF\n | wORD_SIZE dflags == 8 = 0xFFFFFFFF\n | otherwise             = panic \"MachOp.halfWordMask: Unknown word size\"\n\n-- cIntRep is the Width for a C-language 'int'\ncIntWidth :: DynFlags -> Width\ncIntWidth dflags = case cINT_SIZE dflags of\n                   4 -> W32\n                   8 -> W64\n                   s -> panic (\"cIntWidth: Unknown cINT_SIZE: \" ++ show s)\n\nwidthInBits :: Width -> Int\nwidthInBits W8   = 8\nwidthInBits W16  = 16\nwidthInBits W32  = 32\nwidthInBits W64  = 64\nwidthInBits W128 = 128\nwidthInBits W256 = 256\nwidthInBits W512 = 512\nwidthInBits W80  = 80\n\nwidthInBytes :: Width -> Int\nwidthInBytes W8   = 1\nwidthInBytes W16  = 2\nwidthInBytes W32  = 4\nwidthInBytes W64  = 8\nwidthInBytes W128 = 16\nwidthInBytes W256 = 32\nwidthInBytes W512 = 64\nwidthInBytes W80  = 10\n\nwidthFromBytes :: Int -> Width\nwidthFromBytes 1  = W8\nwidthFromBytes 2  = W16\nwidthFromBytes 4  = W32\nwidthFromBytes 8  = W64\nwidthFromBytes 16 = W128\nwidthFromBytes 32 = W256\nwidthFromBytes 64 = W512\nwidthFromBytes 10 = W80\nwidthFromBytes n  = pprPanic \"no width for given number of bytes\" (ppr n)\n\n-- log_2 of the width in bytes, useful for generating shifts.\nwidthInLog :: Width -> Int\nwidthInLog W8   = 0\nwidthInLog W16  = 1\nwidthInLog W32  = 2\nwidthInLog W64  = 3\nwidthInLog W128 = 4\nwidthInLog W256 = 5\nwidthInLog W512 = 6\nwidthInLog W80  = panic \"widthInLog: F80\"\n\n-- widening / narrowing\n\nnarrowU :: Width -> Integer -> Integer\nnarrowU W8  x = fromIntegral (fromIntegral x :: Word8)\nnarrowU W16 x = fromIntegral (fromIntegral x :: Word16)\nnarrowU W32 x = fromIntegral (fromIntegral x :: Word32)\nnarrowU W64 x = fromIntegral (fromIntegral x :: Word64)\nnarrowU _ _ = panic \"narrowTo\"\n\nnarrowS :: Width -> Integer -> Integer\nnarrowS W8  x = fromIntegral (fromIntegral x :: Int8)\nnarrowS W16 x = fromIntegral (fromIntegral x :: Int16)\nnarrowS W32 x = fromIntegral (fromIntegral x :: Int32)\nnarrowS W64 x = fromIntegral (fromIntegral x :: Int64)\nnarrowS _ _ = panic \"narrowTo\"\n\n-----------------------------------------------------------------------------\n--              SIMD\n-----------------------------------------------------------------------------\n\ntype Length = Int\n\nvec :: Length -> CmmType -> CmmType\nvec l (CmmType cat w) = CmmType (VecCat l cat) vecw\n  where\n    vecw :: Width\n    vecw = widthFromBytes (l*widthInBytes w)\n\nvec2, vec4, vec8, vec16 :: CmmType -> CmmType\nvec2  = vec 2\nvec4  = vec 4\nvec8  = vec 8\nvec16 = vec 16\n\nvec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8 :: CmmType\nvec2f64 = vec 2 f64\nvec2b64 = vec 2 b64\nvec4f32 = vec 4 f32\nvec4b32 = vec 4 b32\nvec8b16 = vec 8 b16\nvec16b8 = vec 16 b8\n\ncmmVec :: Int -> CmmType -> CmmType\ncmmVec n (CmmType cat w) =\n    CmmType (VecCat n cat) (widthFromBytes (n*widthInBytes w))\n\nvecLength :: CmmType -> Length\nvecLength (CmmType (VecCat l _) _) = l\nvecLength _                        = panic \"vecLength: not a vector\"\n\nvecElemType :: CmmType -> CmmType\nvecElemType (CmmType (VecCat l cat) w) = CmmType cat scalw\n  where\n    scalw :: Width\n    scalw = widthFromBytes (widthInBytes w `div` l)\nvecElemType _ = panic \"vecElemType: not a vector\"\n\nisVecType :: CmmType -> Bool\nisVecType (CmmType (VecCat {}) _) = True\nisVecType _                       = False\n\n-------------------------------------------------------------------------\n-- Hints\n\n-- Hints are extra type information we attach to the arguments and\n-- results of a foreign call, where more type information is sometimes\n-- needed by the ABI to make the correct kind of call.\n\ndata ForeignHint\n  = NoHint | AddrHint | SignedHint\n  deriving( Eq )\n        -- Used to give extra per-argument or per-result\n        -- information needed by foreign calling conventions\n\n-------------------------------------------------------------------------\n\n-- These don't really belong here, but I don't know where is best to\n-- put them.\n\nrEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType\nrEP_CostCentreStack_mem_alloc dflags\n    = cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc))\n    where pc = sPlatformConstants (settings dflags)\n\nrEP_CostCentreStack_scc_count :: DynFlags -> CmmType\nrEP_CostCentreStack_scc_count dflags\n    = cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc))\n    where pc = sPlatformConstants (settings dflags)\n\nrEP_StgEntCounter_allocs :: DynFlags -> CmmType\nrEP_StgEntCounter_allocs dflags\n    = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))\n    where pc = sPlatformConstants (settings dflags)\n\nrEP_StgEntCounter_allocd :: DynFlags -> CmmType\nrEP_StgEntCounter_allocd dflags\n    = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))\n    where pc = sPlatformConstants (settings dflags)\n\n-------------------------------------------------------------------------\n{-      Note [Signed vs unsigned]\n        ~~~~~~~~~~~~~~~~~~~~~~~~~\nShould a CmmType include a signed vs. unsigned distinction?\n\nThis is very much like a \"hint\" in C-- terminology: it isn't necessary\nin order to generate correct code, but it might be useful in that the\ncompiler can generate better code if it has access to higher-level\nhints about data.  This is important at call boundaries, because the\ndefinition of a function is not visible at all of its call sites, so\nthe compiler cannot infer the hints.\n\nHere in Cmm, we're taking a slightly different approach.  We include\nthe int vs. float hint in the CmmType, because (a) the majority of\nplatforms have a strong distinction between float and int registers,\nand (b) we don't want to do any heavyweight hint-inference in the\nnative code backend in order to get good code.  We're treating the\nhint more like a type: our Cmm is always completely consistent with\nrespect to hints.  All coercions between float and int are explicit.\n\nWhat about the signed vs. unsigned hint?  This information might be\nuseful if we want to keep sub-word-sized values in word-size\nregisters, which we must do if we only have word-sized registers.\n\nOn such a system, there are two straightforward conventions for\nrepresenting sub-word-sized values:\n\n(a) Leave the upper bits undefined.  Comparison operations must\n    sign- or zero-extend both operands before comparing them,\n    depending on whether the comparison is signed or unsigned.\n\n(b) Always keep the values sign- or zero-extended as appropriate.\n    Arithmetic operations must narrow the result to the appropriate\n    size.\n\nA clever compiler might not use either (a) or (b) exclusively, instead\nit would attempt to minimize the coercions by analysis: the same kind\nof analysis that propagates hints around.  In Cmm we don't want to\nhave to do this, so we plump for having richer types and keeping the\ntype information consistent.\n\nIf signed/unsigned hints are missing from CmmType, then the only\nchoice we have is (a), because we don't know whether the result of an\noperation should be sign- or zero-extended.\n\nMany architectures have extending load operations, which work well\nwith (b).  To make use of them with (a), you need to know whether the\nvalue is going to be sign- or zero-extended by an enclosing comparison\n(for example), which involves knowing above the context.  This is\ndoable but more complex.\n\nFurther complicating the issue is foreign calls: a foreign calling\nconvention can specify that signed 8-bit quantities are passed as\nsign-extended 32 bit quantities, for example (this is the case on the\nPowerPC).  So we *do* need sign information on foreign call arguments.\n\nPros for adding signed vs. unsigned to CmmType:\n\n  - It would let us use convention (b) above, and get easier\n    code generation for extending loads.\n\n  - Less information required on foreign calls.\n\n  - MachOp type would be simpler\n\nCons:\n\n  - More complexity\n\n  - What is the CmmType for a VanillaReg?  Currently it is\n    always wordRep, but now we have to decide whether it is\n    signed or unsigned.  The same VanillaReg can thus have\n    different CmmType in different parts of the program.\n\n  - Extra coercions cluttering up expressions.\n\nCurrently for GHC, the foreign call point is moot, because we do our\nown promotion of sub-word-sized values to word-sized values.  The Int8\ntype is represented by an Int# which is kept sign-extended at all times\n(this is slightly naughty, because we're making assumptions about the\nC calling convention rather early on in the compiler).  However, given\nthis, the cons outweigh the pros.\n\n-}\n\n", "num_lines": 443}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes #-}\n\n-----------------------------------------------------------------------------\n--\n-- Cmm utilities.\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule CmmUtils(\n        -- CmmType\n        primRepCmmType, slotCmmType, slotForeignHint,\n        typeCmmType, typeForeignHint, primRepForeignHint,\n\n        -- CmmLit\n        zeroCLit, mkIntCLit,\n        mkWordCLit, packHalfWordsCLit,\n        mkByteStringCLit,\n        mkDataLits, mkRODataLits,\n        mkStgWordCLit,\n\n        -- CmmExpr\n        mkIntExpr, zeroExpr,\n        mkLblExpr,\n        cmmRegOff,  cmmOffset,  cmmLabelOff,  cmmOffsetLit,  cmmOffsetExpr,\n        cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB,\n        cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW,\n        cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW,\n        cmmNegate,\n        cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord,\n        cmmSLtWord,\n        cmmNeWord, cmmEqWord,\n        cmmOrWord, cmmAndWord,\n        cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord,\n        cmmToWord,\n\n        isTrivialCmmExpr, hasNoGlobalRegs, isLit, isComparisonExpr,\n\n        baseExpr, spExpr, hpExpr, spLimExpr, hpLimExpr,\n        currentTSOExpr, currentNurseryExpr, cccsExpr,\n\n        -- Statics\n        blankWord,\n\n        -- Tagging\n        cmmTagMask, cmmPointerMask, cmmUntag, cmmIsTagged,\n        cmmConstrTag1,\n\n        -- Overlap and usage\n        regsOverlap, regUsedIn,\n\n        -- Liveness and bitmaps\n        mkLiveness,\n\n        -- * Operations that probably don't belong here\n        modifyGraph,\n\n        ofBlockMap, toBlockMap,\n        ofBlockList, toBlockList, bodyToBlockList,\n        toBlockListEntryFirst, toBlockListEntryFirstFalseFallthrough,\n        foldlGraphBlocks, mapGraphNodes, revPostorder, mapGraphNodes1,\n\n        -- * Ticks\n        blockTicks\n  ) where\n\nimport GhcPrelude\n\nimport TyCon    ( PrimRep(..), PrimElemRep(..) )\nimport RepType  ( UnaryType, SlotTy (..), typePrimRep1 )\n\nimport SMRep\nimport Cmm\nimport BlockId\nimport CLabel\nimport Outputable\nimport DynFlags\nimport CodeGen.Platform\n\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString as BS\nimport Data.Bits\nimport Hoopl.Graph\nimport Hoopl.Label\nimport Hoopl.Block\nimport Hoopl.Collections\n\n---------------------------------------------------\n--\n--      CmmTypes\n--\n---------------------------------------------------\n\nprimRepCmmType :: DynFlags -> PrimRep -> CmmType\nprimRepCmmType _      VoidRep          = panic \"primRepCmmType:VoidRep\"\nprimRepCmmType dflags LiftedRep        = gcWord dflags\nprimRepCmmType dflags UnliftedRep      = gcWord dflags\nprimRepCmmType dflags IntRep           = bWord dflags\nprimRepCmmType dflags WordRep          = bWord dflags\nprimRepCmmType _      Int8Rep          = b8\nprimRepCmmType _      Word8Rep         = b8\nprimRepCmmType _      Int16Rep         = b16\nprimRepCmmType _      Word16Rep        = b16\nprimRepCmmType _      Int64Rep         = b64\nprimRepCmmType _      Word64Rep        = b64\nprimRepCmmType dflags AddrRep          = bWord dflags\nprimRepCmmType _      FloatRep         = f32\nprimRepCmmType _      DoubleRep        = f64\nprimRepCmmType _      (VecRep len rep) = vec len (primElemRepCmmType rep)\n\nslotCmmType :: DynFlags -> SlotTy -> CmmType\nslotCmmType dflags PtrSlot    = gcWord dflags\nslotCmmType dflags WordSlot   = bWord dflags\nslotCmmType _      Word64Slot = b64\nslotCmmType _      FloatSlot  = f32\nslotCmmType _      DoubleSlot = f64\n\nprimElemRepCmmType :: PrimElemRep -> CmmType\nprimElemRepCmmType Int8ElemRep   = b8\nprimElemRepCmmType Int16ElemRep  = b16\nprimElemRepCmmType Int32ElemRep  = b32\nprimElemRepCmmType Int64ElemRep  = b64\nprimElemRepCmmType Word8ElemRep  = b8\nprimElemRepCmmType Word16ElemRep = b16\nprimElemRepCmmType Word32ElemRep = b32\nprimElemRepCmmType Word64ElemRep = b64\nprimElemRepCmmType FloatElemRep  = f32\nprimElemRepCmmType DoubleElemRep = f64\n\ntypeCmmType :: DynFlags -> UnaryType -> CmmType\ntypeCmmType dflags ty = primRepCmmType dflags (typePrimRep1 ty)\n\nprimRepForeignHint :: PrimRep -> ForeignHint\nprimRepForeignHint VoidRep      = panic \"primRepForeignHint:VoidRep\"\nprimRepForeignHint LiftedRep    = AddrHint\nprimRepForeignHint UnliftedRep  = AddrHint\nprimRepForeignHint IntRep       = SignedHint\nprimRepForeignHint Int8Rep      = SignedHint\nprimRepForeignHint Int16Rep     = SignedHint\nprimRepForeignHint Int64Rep     = SignedHint\nprimRepForeignHint WordRep      = NoHint\nprimRepForeignHint Word8Rep     = NoHint\nprimRepForeignHint Word16Rep    = NoHint\nprimRepForeignHint Word64Rep    = NoHint\nprimRepForeignHint AddrRep      = AddrHint -- NB! AddrHint, but NonPtrArg\nprimRepForeignHint FloatRep     = NoHint\nprimRepForeignHint DoubleRep    = NoHint\nprimRepForeignHint (VecRep {})  = NoHint\n\nslotForeignHint :: SlotTy -> ForeignHint\nslotForeignHint PtrSlot       = AddrHint\nslotForeignHint WordSlot      = NoHint\nslotForeignHint Word64Slot    = NoHint\nslotForeignHint FloatSlot     = NoHint\nslotForeignHint DoubleSlot    = NoHint\n\ntypeForeignHint :: UnaryType -> ForeignHint\ntypeForeignHint = primRepForeignHint . typePrimRep1\n\n---------------------------------------------------\n--\n--      CmmLit\n--\n---------------------------------------------------\n\n-- XXX: should really be Integer, since Int doesn't necessarily cover\n-- the full range of target Ints.\nmkIntCLit :: DynFlags -> Int -> CmmLit\nmkIntCLit dflags i = CmmInt (toInteger i) (wordWidth dflags)\n\nmkIntExpr :: DynFlags -> Int -> CmmExpr\nmkIntExpr dflags i = CmmLit $! mkIntCLit dflags i\n\nzeroCLit :: DynFlags -> CmmLit\nzeroCLit dflags = CmmInt 0 (wordWidth dflags)\n\nzeroExpr :: DynFlags -> CmmExpr\nzeroExpr dflags = CmmLit (zeroCLit dflags)\n\nmkWordCLit :: DynFlags -> Integer -> CmmLit\nmkWordCLit dflags wd = CmmInt wd (wordWidth dflags)\n\nmkByteStringCLit\n  :: CLabel -> ByteString -> (CmmLit, GenCmmDecl CmmStatics info stmt)\n-- We have to make a top-level decl for the string,\n-- and return a literal pointing to it\nmkByteStringCLit lbl bytes\n  = (CmmLabel lbl, CmmData (Section sec lbl) $ Statics lbl [CmmString bytes])\n  where\n    -- This can not happen for String literals (as there \\NUL is replaced by\n    -- C0 80). However, it can happen with Addr# literals.\n    sec = if 0 `BS.elem` bytes then ReadOnlyData else CString\n\nmkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt\n-- Build a data-segment data block\nmkDataLits section lbl lits\n  = CmmData section (Statics lbl $ map CmmStaticLit lits)\n\nmkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt\n-- Build a read-only data block\nmkRODataLits lbl lits\n  = mkDataLits section lbl lits\n  where\n    section | any needsRelocation lits = Section RelocatableReadOnlyData lbl\n            | otherwise                = Section ReadOnlyData lbl\n    needsRelocation (CmmLabel _)      = True\n    needsRelocation (CmmLabelOff _ _) = True\n    needsRelocation _                 = False\n\nmkStgWordCLit :: DynFlags -> StgWord -> CmmLit\nmkStgWordCLit dflags wd = CmmInt (fromStgWord wd) (wordWidth dflags)\n\npackHalfWordsCLit :: DynFlags -> StgHalfWord -> StgHalfWord -> CmmLit\n-- Make a single word literal in which the lower_half_word is\n-- at the lower address, and the upper_half_word is at the\n-- higher address\n-- ToDo: consider using half-word lits instead\n--       but be careful: that's vulnerable when reversed\npackHalfWordsCLit dflags lower_half_word upper_half_word\n   = if wORDS_BIGENDIAN dflags\n     then mkWordCLit dflags ((l `shiftL` hALF_WORD_SIZE_IN_BITS dflags) .|. u)\n     else mkWordCLit dflags (l .|. (u `shiftL` hALF_WORD_SIZE_IN_BITS dflags))\n    where l = fromStgHalfWord lower_half_word\n          u = fromStgHalfWord upper_half_word\n\n---------------------------------------------------\n--\n--      CmmExpr\n--\n---------------------------------------------------\n\nmkLblExpr :: CLabel -> CmmExpr\nmkLblExpr lbl = CmmLit (CmmLabel lbl)\n\ncmmOffsetExpr :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr\n-- assumes base and offset have the same CmmType\ncmmOffsetExpr dflags e (CmmLit (CmmInt n _)) = cmmOffset dflags e (fromInteger n)\ncmmOffsetExpr dflags e byte_off = CmmMachOp (MO_Add (cmmExprWidth dflags e)) [e, byte_off]\n\ncmmOffset :: DynFlags -> CmmExpr -> Int -> CmmExpr\ncmmOffset _ e                 0        = e\ncmmOffset _ (CmmReg reg)      byte_off = cmmRegOff reg byte_off\ncmmOffset _ (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)\ncmmOffset _ (CmmLit lit)      byte_off = CmmLit (cmmOffsetLit lit byte_off)\ncmmOffset _ (CmmStackSlot area off) byte_off\n  = CmmStackSlot area (off - byte_off)\n  -- note stack area offsets increase towards lower addresses\ncmmOffset _ (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2\n  = CmmMachOp (MO_Add rep)\n              [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]\ncmmOffset dflags expr byte_off\n  = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)]\n  where\n    width = cmmExprWidth dflags expr\n\n-- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.\ncmmRegOff :: CmmReg -> Int -> CmmExpr\ncmmRegOff reg 0        = CmmReg reg\ncmmRegOff reg byte_off = CmmRegOff reg byte_off\n\ncmmOffsetLit :: CmmLit -> Int -> CmmLit\ncmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff l byte_off\ncmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)\ncmmOffsetLit (CmmLabelDiffOff l1 l2 m w) byte_off\n                                        = CmmLabelDiffOff l1 l2 (m+byte_off) w\ncmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep\ncmmOffsetLit _                 byte_off = pprPanic \"cmmOffsetLit\" (ppr byte_off)\n\ncmmLabelOff :: CLabel -> Int -> CmmLit\n-- Smart constructor for CmmLabelOff\ncmmLabelOff lbl 0        = CmmLabel lbl\ncmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off\n\n-- | Useful for creating an index into an array, with a statically known offset.\n-- The type is the element type; used for making the multiplier\ncmmIndex :: DynFlags\n         -> Width       -- Width w\n         -> CmmExpr     -- Address of vector of items of width w\n         -> Int         -- Which element of the vector (0 based)\n         -> CmmExpr     -- Address of i'th element\ncmmIndex dflags width base idx = cmmOffset dflags base (idx * widthInBytes width)\n\n-- | Useful for creating an index into an array, with an unknown offset.\ncmmIndexExpr :: DynFlags\n             -> Width           -- Width w\n             -> CmmExpr         -- Address of vector of items of width w\n             -> CmmExpr         -- Which element of the vector (0 based)\n             -> CmmExpr         -- Address of i'th element\ncmmIndexExpr dflags width base (CmmLit (CmmInt n _)) = cmmIndex dflags width base (fromInteger n)\ncmmIndexExpr dflags width base idx =\n  cmmOffsetExpr dflags base byte_off\n  where\n    idx_w = cmmExprWidth dflags idx\n    byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr dflags (widthInLog width)]\n\ncmmLoadIndex :: DynFlags -> CmmType -> CmmExpr -> Int -> CmmExpr\ncmmLoadIndex dflags ty expr ix = CmmLoad (cmmIndex dflags (typeWidth ty) expr ix) ty\n\n-- The \"B\" variants take byte offsets\ncmmRegOffB :: CmmReg -> ByteOff -> CmmExpr\ncmmRegOffB = cmmRegOff\n\ncmmOffsetB :: DynFlags -> CmmExpr -> ByteOff -> CmmExpr\ncmmOffsetB = cmmOffset\n\ncmmOffsetExprB :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr\ncmmOffsetExprB = cmmOffsetExpr\n\ncmmLabelOffB :: CLabel -> ByteOff -> CmmLit\ncmmLabelOffB = cmmLabelOff\n\ncmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit\ncmmOffsetLitB = cmmOffsetLit\n\n-----------------------\n-- The \"W\" variants take word offsets\n\ncmmOffsetExprW :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr\n-- The second arg is a *word* offset; need to change it to bytes\ncmmOffsetExprW dflags  e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromInteger n)\ncmmOffsetExprW dflags e wd_off = cmmIndexExpr dflags (wordWidth dflags) e wd_off\n\ncmmOffsetW :: DynFlags -> CmmExpr -> WordOff -> CmmExpr\ncmmOffsetW dflags e n = cmmOffsetB dflags e (wordsToBytes dflags n)\n\ncmmRegOffW :: DynFlags -> CmmReg -> WordOff -> CmmExpr\ncmmRegOffW dflags reg wd_off = cmmRegOffB reg (wordsToBytes dflags wd_off)\n\ncmmOffsetLitW :: DynFlags -> CmmLit -> WordOff -> CmmLit\ncmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wordsToBytes dflags wd_off)\n\ncmmLabelOffW :: DynFlags -> CLabel -> WordOff -> CmmLit\ncmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wordsToBytes dflags wd_off)\n\ncmmLoadIndexW :: DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr\ncmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty\n\n-----------------------\ncmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord,\n  cmmSLtWord,\n  cmmNeWord, cmmEqWord,\n  cmmOrWord, cmmAndWord,\n  cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord\n  :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr\ncmmOrWord dflags  e1 e2 = CmmMachOp (mo_wordOr dflags)  [e1, e2]\ncmmAndWord dflags e1 e2 = CmmMachOp (mo_wordAnd dflags) [e1, e2]\ncmmNeWord dflags  e1 e2 = CmmMachOp (mo_wordNe dflags)  [e1, e2]\ncmmEqWord dflags  e1 e2 = CmmMachOp (mo_wordEq dflags)  [e1, e2]\ncmmULtWord dflags e1 e2 = CmmMachOp (mo_wordULt dflags) [e1, e2]\ncmmUGeWord dflags e1 e2 = CmmMachOp (mo_wordUGe dflags) [e1, e2]\ncmmUGtWord dflags e1 e2 = CmmMachOp (mo_wordUGt dflags) [e1, e2]\ncmmSLtWord dflags e1 e2 = CmmMachOp (mo_wordSLt dflags) [e1, e2]\ncmmUShrWord dflags e1 e2 = CmmMachOp (mo_wordUShr dflags) [e1, e2]\ncmmAddWord dflags e1 e2 = CmmMachOp (mo_wordAdd dflags) [e1, e2]\ncmmSubWord dflags e1 e2 = CmmMachOp (mo_wordSub dflags) [e1, e2]\ncmmMulWord dflags e1 e2 = CmmMachOp (mo_wordMul dflags) [e1, e2]\ncmmQuotWord dflags e1 e2 = CmmMachOp (mo_wordUQuot dflags) [e1, e2]\n\ncmmNegate :: DynFlags -> CmmExpr -> CmmExpr\ncmmNegate _      (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)\ncmmNegate dflags e                       = CmmMachOp (MO_S_Neg (cmmExprWidth dflags e)) [e]\n\nblankWord :: DynFlags -> CmmStatic\nblankWord dflags = CmmUninitialised (wORD_SIZE dflags)\n\ncmmToWord :: DynFlags -> CmmExpr -> CmmExpr\ncmmToWord dflags e\n  | w == word  = e\n  | otherwise  = CmmMachOp (MO_UU_Conv w word) [e]\n  where\n    w = cmmExprWidth dflags e\n    word = wordWidth dflags\n\n---------------------------------------------------\n--\n--      CmmExpr predicates\n--\n---------------------------------------------------\n\nisTrivialCmmExpr :: CmmExpr -> Bool\nisTrivialCmmExpr (CmmLoad _ _)      = False\nisTrivialCmmExpr (CmmMachOp _ _)    = False\nisTrivialCmmExpr (CmmLit _)         = True\nisTrivialCmmExpr (CmmReg _)         = True\nisTrivialCmmExpr (CmmRegOff _ _)    = True\nisTrivialCmmExpr (CmmStackSlot _ _) = panic \"isTrivialCmmExpr CmmStackSlot\"\n\nhasNoGlobalRegs :: CmmExpr -> Bool\nhasNoGlobalRegs (CmmLoad e _)              = hasNoGlobalRegs e\nhasNoGlobalRegs (CmmMachOp _ es)           = all hasNoGlobalRegs es\nhasNoGlobalRegs (CmmLit _)                 = True\nhasNoGlobalRegs (CmmReg (CmmLocal _))      = True\nhasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True\nhasNoGlobalRegs _ = False\n\nisLit :: CmmExpr -> Bool\nisLit (CmmLit _) = True\nisLit _          = False\n\nisComparisonExpr :: CmmExpr -> Bool\nisComparisonExpr (CmmMachOp op _) = isComparisonMachOp op\nisComparisonExpr _                  = False\n\n---------------------------------------------------\n--\n--      Tagging\n--\n---------------------------------------------------\n\n-- Tag bits mask\ncmmTagMask, cmmPointerMask :: DynFlags -> CmmExpr\ncmmTagMask dflags = mkIntExpr dflags (tAG_MASK dflags)\ncmmPointerMask dflags = mkIntExpr dflags (complement (tAG_MASK dflags))\n\n-- Used to untag a possibly tagged pointer\n-- A static label need not be untagged\ncmmUntag, cmmIsTagged, cmmConstrTag1 :: DynFlags -> CmmExpr -> CmmExpr\ncmmUntag _ e@(CmmLit (CmmLabel _)) = e\n-- Default case\ncmmUntag dflags e = cmmAndWord dflags e (cmmPointerMask dflags)\n\n-- Test if a closure pointer is untagged\ncmmIsTagged dflags e = cmmNeWord dflags (cmmAndWord dflags e (cmmTagMask dflags)) (zeroExpr dflags)\n\n-- Get constructor tag, but one based.\ncmmConstrTag1 dflags e = cmmAndWord dflags e (cmmTagMask dflags)\n\n\n-----------------------------------------------------------------------------\n-- Overlap and usage\n\n-- | Returns True if the two STG registers overlap on the specified\n-- platform, in the sense that writing to one will clobber the\n-- other. This includes the case that the two registers are the same\n-- STG register. See Note [Overlapping global registers] for details.\nregsOverlap :: DynFlags -> CmmReg -> CmmReg -> Bool\nregsOverlap dflags (CmmGlobal g) (CmmGlobal g')\n  | Just real  <- globalRegMaybe (targetPlatform dflags) g,\n    Just real' <- globalRegMaybe (targetPlatform dflags) g',\n    real == real'\n    = True\nregsOverlap _ reg reg' = reg == reg'\n\n-- | Returns True if the STG register is used by the expression, in\n-- the sense that a store to the register might affect the value of\n-- the expression.\n--\n-- We must check for overlapping registers and not just equal\n-- registers here, otherwise CmmSink may incorrectly reorder\n-- assignments that conflict due to overlap. See Trac #10521 and Note\n-- [Overlapping global registers].\nregUsedIn :: DynFlags -> CmmReg -> CmmExpr -> Bool\nregUsedIn dflags = regUsedIn_ where\n  _   `regUsedIn_` CmmLit _         = False\n  reg `regUsedIn_` CmmLoad e  _     = reg `regUsedIn_` e\n  reg `regUsedIn_` CmmReg reg'      = regsOverlap dflags reg reg'\n  reg `regUsedIn_` CmmRegOff reg' _ = regsOverlap dflags reg reg'\n  reg `regUsedIn_` CmmMachOp _ es   = any (reg `regUsedIn_`) es\n  _   `regUsedIn_` CmmStackSlot _ _ = False\n\n--------------------------------------------\n--\n--        mkLiveness\n--\n---------------------------------------------\n\nmkLiveness :: DynFlags -> [LocalReg] -> Liveness\nmkLiveness _      [] = []\nmkLiveness dflags (reg:regs)\n  = bits ++ mkLiveness dflags regs\n  where\n    sizeW = (widthInBytes (typeWidth (localRegType reg)) + wORD_SIZE dflags - 1)\n            `quot` wORD_SIZE dflags\n            -- number of words, rounded up\n    bits = replicate sizeW is_non_ptr -- True <=> Non Ptr\n\n    is_non_ptr = not $ isGcPtrType (localRegType reg)\n\n\n-- ============================================== -\n-- ============================================== -\n-- ============================================== -\n\n---------------------------------------------------\n--\n--      Manipulating CmmGraphs\n--\n---------------------------------------------------\n\nmodifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'\nmodifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}\n\ntoBlockMap :: CmmGraph -> LabelMap CmmBlock\ntoBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body\n\nofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph\nofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}\n\ntoBlockList :: CmmGraph -> [CmmBlock]\ntoBlockList g = mapElems $ toBlockMap g\n\n-- | like 'toBlockList', but the entry block always comes first\ntoBlockListEntryFirst :: CmmGraph -> [CmmBlock]\ntoBlockListEntryFirst g\n  | mapNull m  = []\n  | otherwise  = entry_block : others\n  where\n    m = toBlockMap g\n    entry_id = g_entry g\n    Just entry_block = mapLookup entry_id m\n    others = filter ((/= entry_id) . entryLabel) (mapElems m)\n\n-- | Like 'toBlockListEntryFirst', but we strive to ensure that we order blocks\n-- so that the false case of a conditional jumps to the next block in the output\n-- list of blocks. This matches the way OldCmm blocks were output since in\n-- OldCmm the false case was a fallthrough, whereas in Cmm conditional branches\n-- have both true and false successors. Block ordering can make a big difference\n-- in performance in the LLVM backend. Note that we rely crucially on the order\n-- of successors returned for CmmCondBranch by the NonLocal instance for CmmNode\n-- defined in cmm/CmmNode.hs. -GBM\ntoBlockListEntryFirstFalseFallthrough :: CmmGraph -> [CmmBlock]\ntoBlockListEntryFirstFalseFallthrough g\n  | mapNull m  = []\n  | otherwise  = dfs setEmpty [entry_block]\n  where\n    m = toBlockMap g\n    entry_id = g_entry g\n    Just entry_block = mapLookup entry_id m\n\n    dfs :: LabelSet -> [CmmBlock] -> [CmmBlock]\n    dfs _ [] = []\n    dfs visited (block:bs)\n      | id `setMember` visited = dfs visited bs\n      | otherwise              = block : dfs (setInsert id visited) bs'\n      where id = entryLabel block\n            bs' = foldr add_id bs (successors block)\n            add_id id bs = case mapLookup id m of\n                              Just b  -> b : bs\n                              Nothing -> bs\n\nofBlockList :: BlockId -> [CmmBlock] -> CmmGraph\nofBlockList entry blocks = CmmGraph { g_entry = entry\n                                    , g_graph = GMany NothingO body NothingO }\n  where body = foldr addBlock emptyBody blocks\n\nbodyToBlockList :: Body CmmNode -> [CmmBlock]\nbodyToBlockList body = mapElems body\n\nmapGraphNodes :: ( CmmNode C O -> CmmNode C O\n                 , CmmNode O O -> CmmNode O O\n                 , CmmNode O C -> CmmNode O C)\n              -> CmmGraph -> CmmGraph\nmapGraphNodes funs@(mf,_,_) g =\n  ofBlockMap (entryLabel $ mf $ CmmEntry (g_entry g) GlobalScope) $\n  mapMap (mapBlock3' funs) $ toBlockMap g\n\nmapGraphNodes1 :: (forall e x. CmmNode e x -> CmmNode e x) -> CmmGraph -> CmmGraph\nmapGraphNodes1 f = modifyGraph (mapGraph f)\n\n\nfoldlGraphBlocks :: (a -> CmmBlock -> a) -> a -> CmmGraph -> a\nfoldlGraphBlocks k z g = mapFoldl k z $ toBlockMap g\n\nrevPostorder :: CmmGraph -> [CmmBlock]\nrevPostorder g = {-# SCC \"revPostorder\" #-}\n    revPostorderFrom (toBlockMap g) (g_entry g)\n\n-------------------------------------------------\n-- Tick utilities\n\n-- | Extract all tick annotations from the given block\nblockTicks :: Block CmmNode C C -> [CmmTickish]\nblockTicks b = reverse $ foldBlockNodesF goStmt b []\n  where goStmt :: CmmNode e x -> [CmmTickish] -> [CmmTickish]\n        goStmt  (CmmTick t) ts = t:ts\n        goStmt  _other      ts = ts\n\n\n-- -----------------------------------------------------------------------------\n-- Access to common global registers\n\nbaseExpr, spExpr, hpExpr, currentTSOExpr, currentNurseryExpr,\n  spLimExpr, hpLimExpr, cccsExpr :: CmmExpr\nbaseExpr = CmmReg baseReg\nspExpr = CmmReg spReg\nspLimExpr = CmmReg spLimReg\nhpExpr = CmmReg hpReg\nhpLimExpr = CmmReg hpLimReg\ncurrentTSOExpr = CmmReg currentTSOReg\ncurrentNurseryExpr = CmmReg currentNurseryReg\ncccsExpr = CmmReg cccsReg\n", "num_lines": 593}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-----------------------------------------------------------------------------\n--\n-- Debugging data\n--\n-- Association of debug data on the Cmm level, with methods to encode it in\n-- event log format for later inclusion in profiling event logs.\n--\n-----------------------------------------------------------------------------\n\nmodule Debug (\n\n  DebugBlock(..), dblIsEntry,\n  cmmDebugGen,\n  cmmDebugLabels,\n  cmmDebugLink,\n  debugToMap,\n\n  -- * Unwinding information\n  UnwindTable, UnwindPoint(..),\n  UnwindExpr(..), toUnwindExpr\n  ) where\n\nimport GhcPrelude\n\nimport BlockId\nimport CLabel\nimport Cmm\nimport CmmUtils\nimport CoreSyn\nimport FastString      ( nilFS, mkFastString )\nimport Module\nimport Outputable\nimport PprCore         ()\nimport PprCmmExpr      ( pprExpr )\nimport SrcLoc\nimport Util            ( seqList )\n\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport Hoopl.Label\n\nimport Data.Maybe\nimport Data.List     ( minimumBy, nubBy )\nimport Data.Ord      ( comparing )\nimport qualified Data.Map as Map\nimport Data.Either   ( partitionEithers )\n\n-- | Debug information about a block of code. Ticks scope over nested\n-- blocks.\ndata DebugBlock =\n  DebugBlock\n  { dblProcedure  :: !Label        -- ^ Entry label of containing proc\n  , dblLabel      :: !Label        -- ^ Hoopl label\n  , dblCLabel     :: !CLabel       -- ^ Output label\n  , dblHasInfoTbl :: !Bool         -- ^ Has an info table?\n  , dblParent     :: !(Maybe DebugBlock)\n    -- ^ The parent of this proc. See Note [Splitting DebugBlocks]\n  , dblTicks      :: ![CmmTickish] -- ^ Ticks defined in this block\n  , dblSourceTick\n            :: !(Maybe CmmTickish) -- ^ Best source tick covering block\n  , dblPosition   :: !(Maybe Int)  -- ^ Output position relative to\n                                   -- other blocks. @Nothing@ means\n                                   -- the block was optimized out\n  , dblUnwind     :: [UnwindPoint]\n  , dblBlocks     :: ![DebugBlock] -- ^ Nested blocks\n  }\n\n-- | Is this the entry block?\ndblIsEntry :: DebugBlock -> Bool\ndblIsEntry blk = dblProcedure blk == dblLabel blk\n\ninstance Outputable DebugBlock where\n  ppr blk = (if dblProcedure blk == dblLabel blk\n             then text \"proc \"\n             else if dblHasInfoTbl blk\n                  then text \"pp-blk \"\n                  else text \"blk \") <>\n            ppr (dblLabel blk) <+> parens (ppr (dblCLabel blk)) <+>\n            (maybe empty ppr (dblSourceTick blk)) <+>\n            (maybe (text \"removed\") ((text \"pos \" <>) . ppr)\n                   (dblPosition blk)) <+>\n            (ppr (dblUnwind blk)) <+>\n            (if null (dblBlocks blk) then empty else ppr (dblBlocks blk))\n\n-- | Intermediate data structure holding debug-relevant context information\n-- about a block.\ntype BlockContext = (CmmBlock, RawCmmDecl)\n\n-- | Extract debug data from a group of procedures. We will prefer\n-- source notes that come from the given module (presumably the module\n-- that we are currently compiling).\ncmmDebugGen :: ModLocation -> RawCmmGroup -> [DebugBlock]\ncmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes\n  where\n      blockCtxs :: Map.Map CmmTickScope [BlockContext]\n      blockCtxs = blockContexts decls\n\n      -- Analyse tick scope structure: Each one is either a top-level\n      -- tick scope, or the child of another.\n      (topScopes, childScopes)\n        = partitionEithers $ map (\\a -> findP a a) $ Map.keys blockCtxs\n      findP tsc GlobalScope = Left tsc -- top scope\n      findP tsc scp | scp' `Map.member` blockCtxs = Right (scp', tsc)\n                    | otherwise                   = findP tsc scp'\n        where -- Note that we only following the left parent of\n              -- combined scopes. This loses us ticks, which we will\n              -- recover by copying ticks below.\n              scp' | SubScope _ scp' <- scp      = scp'\n                   | CombinedScope scp' _ <- scp = scp'\n                   | otherwise                   = panic \"findP impossible\"\n\n      scopeMap = foldr (uncurry insertMulti) Map.empty childScopes\n\n      -- This allows us to recover ticks that we lost by flattening\n      -- the graph. Basically, if the parent is A but the child is\n      -- CBA, we know that there is no BA, because it would have taken\n      -- priority - but there might be a B scope, with ticks that\n      -- would not be associated with our child anymore. Note however\n      -- that there might be other childs (DB), which we have to\n      -- filter out.\n      --\n      -- We expect this to be called rarely, which is why we are not\n      -- trying too hard to be efficient here. In many cases we won't\n      -- have to construct blockCtxsU in the first place.\n      ticksToCopy :: CmmTickScope -> [CmmTickish]\n      ticksToCopy (CombinedScope scp s) = go s\n        where go s | scp `isTickSubScope` s   = [] -- done\n                   | SubScope _ s' <- s       = ticks ++ go s'\n                   | CombinedScope s1 s2 <- s = ticks ++ go s1 ++ go s2\n                   | otherwise                = panic \"ticksToCopy impossible\"\n                where ticks = bCtxsTicks $ fromMaybe [] $ Map.lookup s blockCtxs\n      ticksToCopy _ = []\n      bCtxsTicks = concatMap (blockTicks . fst)\n\n      -- Finding the \"best\" source tick is somewhat arbitrary -- we\n      -- select the first source span, while preferring source ticks\n      -- from the same source file.  Furthermore, dumps take priority\n      -- (if we generated one, we probably want debug information to\n      -- refer to it).\n      bestSrcTick = minimumBy (comparing rangeRating)\n      rangeRating (SourceNote span _)\n        | srcSpanFile span == thisFile = 1\n        | otherwise                    = 2 :: Int\n      rangeRating note                 = pprPanic \"rangeRating\" (ppr note)\n      thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc\n\n      -- Returns block tree for this scope as well as all nested\n      -- scopes. Note that if there are multiple blocks in the (exact)\n      -- same scope we elect one as the \"branch\" node and add the rest\n      -- as children.\n      blocksForScope :: Maybe CmmTickish -> CmmTickScope -> DebugBlock\n      blocksForScope cstick scope = mkBlock True (head bctxs)\n        where bctxs = fromJust $ Map.lookup scope blockCtxs\n              nested = fromMaybe [] $ Map.lookup scope scopeMap\n              childs = map (mkBlock False) (tail bctxs) ++\n                       map (blocksForScope stick) nested\n\n              mkBlock :: Bool -> BlockContext -> DebugBlock\n              mkBlock top (block, prc)\n                = DebugBlock { dblProcedure    = g_entry graph\n                             , dblLabel        = label\n                             , dblCLabel       = case info of\n                                 Just (Statics infoLbl _)   -> infoLbl\n                                 Nothing\n                                   | g_entry graph == label -> entryLbl\n                                   | otherwise              -> blockLbl label\n                             , dblHasInfoTbl   = isJust info\n                             , dblParent       = Nothing\n                             , dblTicks        = ticks\n                             , dblPosition     = Nothing -- see cmmDebugLink\n                             , dblSourceTick   = stick\n                             , dblBlocks       = blocks\n                             , dblUnwind       = []\n                             }\n                where (CmmProc infos entryLbl _ graph) = prc\n                      label = entryLabel block\n                      info = mapLookup label infos\n                      blocks | top       = seqList childs childs\n                             | otherwise = []\n\n              -- A source tick scopes over all nested blocks. However\n              -- their source ticks might take priority.\n              isSourceTick SourceNote {} = True\n              isSourceTick _             = False\n              -- Collect ticks from all blocks inside the tick scope.\n              -- We attempt to filter out duplicates while we're at it.\n              ticks = nubBy (flip tickishContains) $\n                      bCtxsTicks bctxs ++ ticksToCopy scope\n              stick = case filter isSourceTick ticks of\n                []     -> cstick\n                sticks -> Just $! bestSrcTick (sticks ++ maybeToList cstick)\n\n-- | Build a map of blocks sorted by their tick scopes\n--\n-- This involves a pre-order traversal, as we want blocks in rough\n-- control flow order (so ticks have a chance to be sorted in the\n-- right order).\nblockContexts :: RawCmmGroup -> Map.Map CmmTickScope [BlockContext]\nblockContexts decls = Map.map reverse $ foldr walkProc Map.empty decls\n  where walkProc :: RawCmmDecl\n                 -> Map.Map CmmTickScope [BlockContext]\n                 -> Map.Map CmmTickScope [BlockContext]\n        walkProc CmmData{}                 m = m\n        walkProc prc@(CmmProc _ _ _ graph) m\n          | mapNull blocks = m\n          | otherwise      = snd $ walkBlock prc entry (emptyLbls, m)\n          where blocks = toBlockMap graph\n                entry  = [mapFind (g_entry graph) blocks]\n                emptyLbls = setEmpty :: LabelSet\n\n        walkBlock :: RawCmmDecl -> [Block CmmNode C C]\n                  -> (LabelSet, Map.Map CmmTickScope [BlockContext])\n                  -> (LabelSet, Map.Map CmmTickScope [BlockContext])\n        walkBlock _   []             c            = c\n        walkBlock prc (block:blocks) (visited, m)\n          | lbl `setMember` visited\n          = walkBlock prc blocks (visited, m)\n          | otherwise\n          = walkBlock prc blocks $\n            walkBlock prc succs\n              (lbl `setInsert` visited,\n               insertMulti scope (block, prc) m)\n          where CmmEntry lbl scope = firstNode block\n                (CmmProc _ _ _ graph) = prc\n                succs = map (flip mapFind (toBlockMap graph))\n                            (successors (lastNode block))\n        mapFind = mapFindWithDefault (error \"contextTree: block not found!\")\n\ninsertMulti :: Ord k => k -> a -> Map.Map k [a] -> Map.Map k [a]\ninsertMulti k v = Map.insertWith (const (v:)) k [v]\n\ncmmDebugLabels :: (i -> Bool) -> GenCmmGroup d g (ListGraph i) -> [Label]\ncmmDebugLabels isMeta nats = seqList lbls lbls\n  where -- Find order in which procedures will be generated by the\n        -- back-end (that actually matters for DWARF generation).\n        --\n        -- Note that we might encounter blocks that are missing or only\n        -- consist of meta instructions -- we will declare them missing,\n        -- which will skip debug data generation without messing up the\n        -- block hierarchy.\n        lbls = map blockId $ filter (not . allMeta) $ concatMap getBlocks nats\n        getBlocks (CmmProc _ _ _ (ListGraph bs)) = bs\n        getBlocks _other                         = []\n        allMeta (BasicBlock _ instrs) = all isMeta instrs\n\n-- | Sets position and unwind table fields in the debug block tree according to\n-- native generated code.\ncmmDebugLink :: [Label] -> LabelMap [UnwindPoint]\n             -> [DebugBlock] -> [DebugBlock]\ncmmDebugLink labels unwindPts blocks = map link blocks\n  where blockPos :: LabelMap Int\n        blockPos = mapFromList $ flip zip [0..] labels\n        link block = block { dblPosition = mapLookup (dblLabel block) blockPos\n                           , dblBlocks   = map link (dblBlocks block)\n                           , dblUnwind   = fromMaybe mempty\n                                         $ mapLookup (dblLabel block) unwindPts\n                           }\n\n-- | Converts debug blocks into a label map for easier lookups\ndebugToMap :: [DebugBlock] -> LabelMap DebugBlock\ndebugToMap = mapUnions . map go\n   where go b = mapInsert (dblLabel b) b $ mapUnions $ map go (dblBlocks b)\n\n{-\nNote [What is this unwinding business?]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nUnwinding tables are a variety of debugging information used by debugging tools\nto reconstruct the execution history of a program at runtime. These tables\nconsist of sets of \"instructions\", one set for every instruction in the program,\nwhich describe how to reconstruct the state of the machine at the point where\nthe current procedure was called. For instance, consider the following annotated\npseudo-code,\n\n  a_fun:\n    add rsp, 8            -- unwind: rsp = rsp - 8\n    mov rax, 1            -- unwind: rax = unknown\n    call another_block\n    sub rsp, 8            -- unwind: rsp = rsp\n\nWe see that attached to each instruction there is an \"unwind\" annotation, which\nprovides a relationship between each updated register and its value at the\ntime of entry to a_fun. This is the sort of information that allows gdb to give\nyou a stack backtrace given the execution state of your program. This\nunwinding information is captured in various ways by various debug information\nformats; in the case of DWARF (the only format supported by GHC) it is known as\nCall Frame Information (CFI) and can be found in the .debug.frames section of\nyour object files.\n\nCurrently we only bother to produce unwinding information for registers which\nare necessary to reconstruct flow-of-execution. On x86_64 this includes $rbp\n(which is the STG stack pointer) and $rsp (the C stack pointer).\n\nLet's consider how GHC would annotate a C-- program with unwinding information\nwith a typical C-- procedure as would come from the STG-to-Cmm code generator,\n\n  entry()\n     { c2fe:\n           v :: P64 = R2;\n           if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;\n       c2ff:\n           R2 = v :: P64;\n           R1 = test_closure;\n           call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;\n       c2fg:\n           I64[Sp - 8] = c2dD;\n           R1 = v :: P64;\n           Sp = Sp - 8;          // Sp updated here\n           if (R1 & 7 != 0) goto c2dD; else goto c2dE;\n       c2dE:\n           call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;\n       c2dD:\n           w :: P64 = R1;\n           Hp = Hp + 48;\n           if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;\n       ...\n  },\n\nLet's consider how this procedure will be decorated with unwind information\n(largely by CmmLayoutStack). Naturally, when we enter the procedure `entry` the\nvalue of Sp is no different from what it was at its call site. Therefore we will\nadd an `unwind` statement saying this at the beginning of its unwind-annotated\ncode,\n\n  entry()\n     { c2fe:\n           unwind Sp = Just Sp + 0;\n           v :: P64 = R2;\n           if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;\n\nAfter c2fe we may pass to either c2ff or c2fg; let's first consider the\nformer. In this case there is nothing in particular that we need to do other\nthan reiterate what we already know about Sp,\n\n       c2ff:\n           unwind Sp = Just Sp + 0;\n           R2 = v :: P64;\n           R1 = test_closure;\n           call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;\n\nIn contrast, c2fg updates Sp midway through its body. To ensure that unwinding\ncan happen correctly after this point we must include an unwind statement there,\nin addition to the usual beginning-of-block statement,\n\n       c2fg:\n           unwind Sp = Just Sp + 0;\n           I64[Sp - 8] = c2dD;\n           R1 = v :: P64;\n           Sp = Sp - 8;\n           unwind Sp = Just Sp + 8;\n           if (R1 & 7 != 0) goto c2dD; else goto c2dE;\n\nThe remaining blocks are simple,\n\n       c2dE:\n           unwind Sp = Just Sp + 8;\n           call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;\n       c2dD:\n           unwind Sp = Just Sp + 8;\n           w :: P64 = R1;\n           Hp = Hp + 48;\n           if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;\n       ...\n  },\n\n\nThe flow of unwinding information through the compiler is a bit convoluted:\n\n * C-- begins life in StgCmm without any unwind information. This is because we\n   haven't actually done any register assignment or stack layout yet, so there\n   is no need for unwind information.\n\n * CmmLayoutStack figures out how to layout each procedure's stack, and produces\n   appropriate unwinding nodes for each adjustment of the STG Sp register.\n\n * The unwind nodes are carried through the sinking pass. Currently this is\n   guaranteed not to invalidate unwind information since it won't touch stores\n   to Sp, but this will need revisiting if CmmSink gets smarter in the future.\n\n * Eventually we make it to the native code generator backend which can then\n   preserve the unwind nodes in its machine-specific instructions. In so doing\n   the backend can also modify or add unwinding information; this is necessary,\n   for instance, in the case of x86-64, where adjustment of $rsp may be\n   necessary during calls to native foreign code due to the native calling\n   convention.\n\n * The NCG then retrieves the final unwinding table for each block from the\n   backend with extractUnwindPoints.\n\n * This unwind information is converted to DebugBlocks by Debug.cmmDebugGen\n\n * These DebugBlocks are then converted to, e.g., DWARF unwinding tables\n   (by the Dwarf module) and emitted in the final object.\n\nSee also:\n  Note [Unwinding information in the NCG] in AsmCodeGen,\n  Note [Unwind pseudo-instruction in Cmm],\n  Note [Debugging DWARF unwinding info].\n\n\nNote [Debugging DWARF unwinding info]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nFor debugging generated unwinding info I've found it most useful to dump the\ndisassembled binary with objdump -D and dump the debug info with\nreadelf --debug-dump=frames-interp.\n\nYou should get something like this:\n\n  0000000000000010 <stg_catch_frame_info>:\n    10:   48 83 c5 18             add    $0x18,%rbp\n    14:   ff 65 00                jmpq   *0x0(%rbp)\n\nand:\n\n  Contents of the .debug_frame section:\n\n  00000000 0000000000000014 ffffffff CIE \"\" cf=1 df=-8 ra=16\n     LOC           CFA      rbp   rsp   ra\n  0000000000000000 rbp+0    v+0   s     c+0\n\n  00000018 0000000000000024 00000000 FDE cie=00000000 pc=000000000000000f..0000000000000017\n     LOC           CFA      rbp   rsp   ra\n  000000000000000f rbp+0    v+0   s     c+0\n  000000000000000f rbp+24   v+0   s     c+0\n\nTo read it http://www.dwarfstd.org/doc/dwarf-2.0.0.pdf has a nice example in\nAppendix 5 (page 101 of the pdf) and more details in the relevant section.\n\nThe key thing to keep in mind is that the value at LOC is the value from\n*before* the instruction at LOC executes. In other words it answers the\nquestion: if my $rip is at LOC, how do I get the relevant values given the\nvalues obtained through unwinding so far.\n\nIf the readelf --debug-dump=frames-interp output looks wrong, it may also be\nuseful to look at readelf --debug-dump=frames, which is closer to the\ninformation that GHC generated.\n\nIt's also useful to dump the relevant Cmm with -ddump-cmm -ddump-opt-cmm\n-ddump-cmm-proc -ddump-cmm-verbose. Note [Unwind pseudo-instruction in Cmm]\nexplains how to interpret it.\n\nInside gdb there are a couple useful commands for inspecting frames.\nFor example:\n\n  gdb> info frame <num>\n\nIt shows the values of registers obtained through unwinding.\n\nAnother useful thing to try when debugging the DWARF unwinding is to enable\nextra debugging output in GDB:\n\n  gdb> set debug frame 1\n\nThis makes GDB produce a trace of its internal workings. Having gone this far,\nit's just a tiny step to run GDB in GDB. Make sure you install debugging\nsymbols for gdb if you obtain it through a package manager.\n\nKeep in mind that the current release of GDB has an instruction pointer handling\nheuristic that works well for C-like languages, but doesn't always work for\nHaskell. See Note [Info Offset] in Dwarf.Types for more details.\n\nNote [Unwind pseudo-instruction in Cmm]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nOne of the possible CmmNodes is a CmmUnwind pseudo-instruction. It doesn't\ngenerate any assembly, but controls what DWARF unwinding information gets\ngenerated.\n\nIt's important to understand what ranges of code the unwind pseudo-instruction\nrefers to.\nFor a sequence of CmmNodes like:\n\n  A // starts at addr X and ends at addr Y-1\n  unwind Sp = Just Sp + 16;\n  B // starts at addr Y and ends at addr Z\n\nthe unwind statement reflects the state after A has executed, but before B\nhas executed. If you consult the Note [Debugging DWARF unwinding info], the\nLOC this information will end up in is Y.\n-}\n\n-- | A label associated with an 'UnwindTable'\ndata UnwindPoint = UnwindPoint !CLabel !UnwindTable\n\ninstance Outputable UnwindPoint where\n  ppr (UnwindPoint lbl uws) =\n      braces $ ppr lbl<>colon\n      <+> hsep (punctuate comma $ map pprUw $ Map.toList uws)\n    where\n      pprUw (g, expr) = ppr g <> char '=' <> ppr expr\n\n-- | Maps registers to expressions that yield their \"old\" values\n-- further up the stack. Most interesting for the stack pointer @Sp@,\n-- but might be useful to document saved registers, too. Note that a\n-- register's value will be 'Nothing' when the register's previous\n-- value cannot be reconstructed.\ntype UnwindTable = Map.Map GlobalReg (Maybe UnwindExpr)\n\n-- | Expressions, used for unwind information\ndata UnwindExpr = UwConst !Int                  -- ^ literal value\n                | UwReg !GlobalReg !Int         -- ^ register plus offset\n                | UwDeref UnwindExpr            -- ^ pointer dereferencing\n                | UwLabel CLabel\n                | UwPlus UnwindExpr UnwindExpr\n                | UwMinus UnwindExpr UnwindExpr\n                | UwTimes UnwindExpr UnwindExpr\n                deriving (Eq)\n\ninstance Outputable UnwindExpr where\n  pprPrec _ (UwConst i)     = ppr i\n  pprPrec _ (UwReg g 0)     = ppr g\n  pprPrec p (UwReg g x)     = pprPrec p (UwPlus (UwReg g 0) (UwConst x))\n  pprPrec _ (UwDeref e)     = char '*' <> pprPrec 3 e\n  pprPrec _ (UwLabel l)     = pprPrec 3 l\n  pprPrec p (UwPlus e0 e1)  | p <= 0\n                            = pprPrec 0 e0 <> char '+' <> pprPrec 0 e1\n  pprPrec p (UwMinus e0 e1) | p <= 0\n                            = pprPrec 1 e0 <> char '-' <> pprPrec 1 e1\n  pprPrec p (UwTimes e0 e1) | p <= 1\n                            = pprPrec 2 e0 <> char '*' <> pprPrec 2 e1\n  pprPrec _ other           = parens (pprPrec 0 other)\n\n-- | Conversion of Cmm expressions to unwind expressions. We check for\n-- unsupported operator usages and simplify the expression as far as\n-- possible.\ntoUnwindExpr :: CmmExpr -> UnwindExpr\ntoUnwindExpr (CmmLit (CmmInt i _))       = UwConst (fromIntegral i)\ntoUnwindExpr (CmmLit (CmmLabel l))       = UwLabel l\ntoUnwindExpr (CmmRegOff (CmmGlobal g) i) = UwReg g i\ntoUnwindExpr (CmmReg (CmmGlobal g))      = UwReg g 0\ntoUnwindExpr (CmmLoad e _)               = UwDeref (toUnwindExpr e)\ntoUnwindExpr e@(CmmMachOp op [e1, e2])   =\n  case (op, toUnwindExpr e1, toUnwindExpr e2) of\n    (MO_Add{}, UwReg r x, UwConst y) -> UwReg r (x + y)\n    (MO_Sub{}, UwReg r x, UwConst y) -> UwReg r (x - y)\n    (MO_Add{}, UwConst x, UwReg r y) -> UwReg r (x + y)\n    (MO_Add{}, UwConst x, UwConst y) -> UwConst (x + y)\n    (MO_Sub{}, UwConst x, UwConst y) -> UwConst (x - y)\n    (MO_Mul{}, UwConst x, UwConst y) -> UwConst (x * y)\n    (MO_Add{}, u1,        u2       ) -> UwPlus u1 u2\n    (MO_Sub{}, u1,        u2       ) -> UwMinus u1 u2\n    (MO_Mul{}, u1,        u2       ) -> UwTimes u1 u2\n    _otherwise -> pprPanic \"Unsupported operator in unwind expression!\"\n                           (pprExpr e)\ntoUnwindExpr e\n  = pprPanic \"Unsupported unwind expression!\" (ppr e)\n", "num_lines": 551}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, GADTs #-}\n\nmodule MkGraph\n  ( CmmAGraph, CmmAGraphScoped, CgStmt(..)\n  , (<*>), catAGraphs\n  , mkLabel, mkMiddle, mkLast, outOfLine\n  , lgraphOfAGraph, labelAGraph\n\n  , stackStubExpr\n  , mkNop, mkAssign, mkStore\n  , mkUnsafeCall, mkFinalCall, mkCallReturnsTo\n  , mkJumpReturnsTo\n  , mkJump, mkJumpExtra\n  , mkRawJump\n  , mkCbranch, mkSwitch\n  , mkReturn, mkComment, mkCallEntry, mkBranch\n  , mkUnwind\n  , copyInOflow, copyOutOflow\n  , noExtraStack\n  , toCall, Transfer(..)\n  )\nwhere\n\nimport GhcPrelude hiding ( (<*>) ) -- avoid importing (<*>)\n\nimport BlockId\nimport Cmm\nimport CmmCallConv\nimport CmmSwitch (SwitchTargets)\n\nimport Hoopl.Block\nimport Hoopl.Graph\nimport Hoopl.Label\nimport DynFlags\nimport FastString\nimport ForeignCall\nimport OrdList\nimport SMRep (ByteOff)\nimport UniqSupply\nimport Util\nimport Panic\n\n\n-----------------------------------------------------------------------------\n-- Building Graphs\n\n\n-- | CmmAGraph is a chunk of code consisting of:\n--\n--   * ordinary statements (assignments, stores etc.)\n--   * jumps\n--   * labels\n--   * out-of-line labelled blocks\n--\n-- The semantics is that control falls through labels and out-of-line\n-- blocks.  Everything after a jump up to the next label is by\n-- definition unreachable code, and will be discarded.\n--\n-- Two CmmAGraphs can be stuck together with <*>, with the meaning that\n-- control flows from the first to the second.\n--\n-- A 'CmmAGraph' can be turned into a 'CmmGraph' (closed at both ends)\n-- by providing a label for the entry point and a tick scope; see\n-- 'labelAGraph'.\ntype CmmAGraph = OrdList CgStmt\n-- | Unlabeled graph with tick scope\ntype CmmAGraphScoped = (CmmAGraph, CmmTickScope)\n\ndata CgStmt\n  = CgLabel BlockId CmmTickScope\n  | CgStmt  (CmmNode O O)\n  | CgLast  (CmmNode O C)\n  | CgFork  BlockId CmmAGraph CmmTickScope\n\nflattenCmmAGraph :: BlockId -> CmmAGraphScoped -> CmmGraph\nflattenCmmAGraph id (stmts_t, tscope) =\n    CmmGraph { g_entry = id,\n               g_graph = GMany NothingO body NothingO }\n  where\n  body = foldr addBlock emptyBody $ flatten id stmts_t tscope []\n\n  --\n  -- flatten: given an entry label and a CmmAGraph, make a list of blocks.\n  --\n  -- NB. avoid the quadratic-append trap by passing in the tail of the\n  -- list.  This is important for Very Long Functions (e.g. in T783).\n  --\n  flatten :: Label -> CmmAGraph -> CmmTickScope -> [Block CmmNode C C]\n          -> [Block CmmNode C C]\n  flatten id g tscope blocks\n      = flatten1 (fromOL g) block' blocks\n      where !block' = blockJoinHead (CmmEntry id tscope) emptyBlock\n  --\n  -- flatten0: we are outside a block at this point: any code before\n  -- the first label is unreachable, so just drop it.\n  --\n  flatten0 :: [CgStmt] -> [Block CmmNode C C] -> [Block CmmNode C C]\n  flatten0 [] blocks = blocks\n\n  flatten0 (CgLabel id tscope : stmts) blocks\n    = flatten1 stmts block blocks\n    where !block = blockJoinHead (CmmEntry id tscope) emptyBlock\n\n  flatten0 (CgFork fork_id stmts_t tscope : rest) blocks\n    = flatten fork_id stmts_t tscope $ flatten0 rest blocks\n\n  flatten0 (CgLast _ : stmts) blocks = flatten0 stmts blocks\n  flatten0 (CgStmt _ : stmts) blocks = flatten0 stmts blocks\n\n  --\n  -- flatten1: we have a partial block, collect statements until the\n  -- next last node to make a block, then call flatten0 to get the rest\n  -- of the blocks\n  --\n  flatten1 :: [CgStmt] -> Block CmmNode C O\n           -> [Block CmmNode C C] -> [Block CmmNode C C]\n\n  -- The current block falls through to the end of a function or fork:\n  -- this code should not be reachable, but it may be referenced by\n  -- other code that is not reachable.  We'll remove it later with\n  -- dead-code analysis, but for now we have to keep the graph\n  -- well-formed, so we terminate the block with a branch to the\n  -- beginning of the current block.\n  flatten1 [] block blocks\n    = blockJoinTail block (CmmBranch (entryLabel block)) : blocks\n\n  flatten1 (CgLast stmt : stmts) block blocks\n    = block' : flatten0 stmts blocks\n    where !block' = blockJoinTail block stmt\n\n  flatten1 (CgStmt stmt : stmts) block blocks\n    = flatten1 stmts block' blocks\n    where !block' = blockSnoc block stmt\n\n  flatten1 (CgFork fork_id stmts_t tscope : rest) block blocks\n    = flatten fork_id stmts_t tscope $ flatten1 rest block blocks\n\n  -- a label here means that we should start a new block, and the\n  -- current block should fall through to the new block.\n  flatten1 (CgLabel id tscp : stmts) block blocks\n    = blockJoinTail block (CmmBranch id) :\n      flatten1 stmts (blockJoinHead (CmmEntry id tscp) emptyBlock) blocks\n\n\n\n---------- AGraph manipulation\n\n(<*>)          :: CmmAGraph -> CmmAGraph -> CmmAGraph\n(<*>)           = appOL\n\ncatAGraphs     :: [CmmAGraph] -> CmmAGraph\ncatAGraphs      = concatOL\n\n-- | created a sequence \"goto id; id:\" as an AGraph\nmkLabel        :: BlockId -> CmmTickScope -> CmmAGraph\nmkLabel bid scp = unitOL (CgLabel bid scp)\n\n-- | creates an open AGraph from a given node\nmkMiddle        :: CmmNode O O -> CmmAGraph\nmkMiddle middle = unitOL (CgStmt middle)\n\n-- | created a closed AGraph from a given node\nmkLast         :: CmmNode O C -> CmmAGraph\nmkLast last     = unitOL (CgLast last)\n\n-- | A labelled code block; should end in a last node\noutOfLine      :: BlockId -> CmmAGraphScoped -> CmmAGraph\noutOfLine l (c,s) = unitOL (CgFork l c s)\n\n-- | allocate a fresh label for the entry point\nlgraphOfAGraph :: CmmAGraphScoped -> UniqSM CmmGraph\nlgraphOfAGraph g = do\n  u <- getUniqueM\n  return (labelAGraph (mkBlockId u) g)\n\n-- | use the given BlockId as the label of the entry point\nlabelAGraph    :: BlockId -> CmmAGraphScoped -> CmmGraph\nlabelAGraph lbl ag = flattenCmmAGraph lbl ag\n\n---------- No-ops\nmkNop        :: CmmAGraph\nmkNop         = nilOL\n\nmkComment    :: FastString -> CmmAGraph\nmkComment fs\n  -- SDM: generating all those comments takes time, this saved about 4% for me\n  | debugIsOn = mkMiddle $ CmmComment fs\n  | otherwise = nilOL\n\n---------- Assignment and store\nmkAssign     :: CmmReg  -> CmmExpr -> CmmAGraph\nmkAssign l (CmmReg r) | l == r  = mkNop\nmkAssign l r  = mkMiddle $ CmmAssign l r\n\nmkStore      :: CmmExpr -> CmmExpr -> CmmAGraph\nmkStore  l r  = mkMiddle $ CmmStore  l r\n\n---------- Control transfer\nmkJump          :: DynFlags -> Convention -> CmmExpr\n                -> [CmmExpr]\n                -> UpdFrameOffset\n                -> CmmAGraph\nmkJump dflags conv e actuals updfr_off =\n  lastWithArgs dflags Jump Old conv actuals updfr_off $\n    toCall e Nothing updfr_off 0\n\n-- | A jump where the caller says what the live GlobalRegs are.  Used\n-- for low-level hand-written Cmm.\nmkRawJump       :: DynFlags -> CmmExpr -> UpdFrameOffset -> [GlobalReg]\n                -> CmmAGraph\nmkRawJump dflags e updfr_off vols =\n  lastWithArgs dflags Jump Old NativeNodeCall [] updfr_off $\n    \\arg_space _  -> toCall e Nothing updfr_off 0 arg_space vols\n\n\nmkJumpExtra :: DynFlags -> Convention -> CmmExpr -> [CmmExpr]\n                -> UpdFrameOffset -> [CmmExpr]\n                -> CmmAGraph\nmkJumpExtra dflags conv e actuals updfr_off extra_stack =\n  lastWithArgsAndExtraStack dflags Jump Old conv actuals updfr_off extra_stack $\n    toCall e Nothing updfr_off 0\n\nmkCbranch       :: CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph\nmkCbranch pred ifso ifnot likely =\n  mkLast (CmmCondBranch pred ifso ifnot likely)\n\nmkSwitch        :: CmmExpr -> SwitchTargets -> CmmAGraph\nmkSwitch e tbl   = mkLast $ CmmSwitch e tbl\n\nmkReturn        :: DynFlags -> CmmExpr -> [CmmExpr] -> UpdFrameOffset\n                -> CmmAGraph\nmkReturn dflags e actuals updfr_off =\n  lastWithArgs dflags Ret  Old NativeReturn actuals updfr_off $\n    toCall e Nothing updfr_off 0\n\nmkBranch        :: BlockId -> CmmAGraph\nmkBranch bid     = mkLast (CmmBranch bid)\n\nmkFinalCall   :: DynFlags\n              -> CmmExpr -> CCallConv -> [CmmExpr] -> UpdFrameOffset\n              -> CmmAGraph\nmkFinalCall dflags f _ actuals updfr_off =\n  lastWithArgs dflags Call Old NativeDirectCall actuals updfr_off $\n    toCall f Nothing updfr_off 0\n\nmkCallReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmExpr]\n                -> BlockId\n                -> ByteOff\n                -> UpdFrameOffset\n                -> [CmmExpr]\n                -> CmmAGraph\nmkCallReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off extra_stack = do\n  lastWithArgsAndExtraStack dflags Call (Young ret_lbl) callConv actuals\n     updfr_off extra_stack $\n       toCall f (Just ret_lbl) updfr_off ret_off\n\n-- Like mkCallReturnsTo, but does not push the return address (it is assumed to be\n-- already on the stack).\nmkJumpReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmExpr]\n                -> BlockId\n                -> ByteOff\n                -> UpdFrameOffset\n                -> CmmAGraph\nmkJumpReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off  = do\n  lastWithArgs dflags JumpRet (Young ret_lbl) callConv actuals updfr_off $\n       toCall f (Just ret_lbl) updfr_off ret_off\n\nmkUnsafeCall  :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmAGraph\nmkUnsafeCall t fs as = mkMiddle $ CmmUnsafeForeignCall t fs as\n\n-- | Construct a 'CmmUnwind' node for the given register and unwinding\n-- expression.\nmkUnwind     :: GlobalReg -> CmmExpr -> CmmAGraph\nmkUnwind r e  = mkMiddle $ CmmUnwind [(r, Just e)]\n\n--------------------------------------------------------------------------\n\n\n\n\n-- Why are we inserting extra blocks that simply branch to the successors?\n-- Because in addition to the branch instruction, @mkBranch@ will insert\n-- a necessary adjustment to the stack pointer.\n\n\n-- For debugging purposes, we can stub out dead stack slots:\nstackStubExpr :: Width -> CmmExpr\nstackStubExpr w = CmmLit (CmmInt 0 w)\n\n-- When we copy in parameters, we usually want to put overflow\n-- parameters on the stack, but sometimes we want to pass the\n-- variables in their spill slots.  Therefore, for copying arguments\n-- and results, we provide different functions to pass the arguments\n-- in an overflow area and to pass them in spill slots.\ncopyInOflow  :: DynFlags -> Convention -> Area\n             -> [CmmFormal]\n             -> [CmmFormal]\n             -> (Int, [GlobalReg], CmmAGraph)\n\ncopyInOflow dflags conv area formals extra_stk\n  = (offset, gregs, catAGraphs $ map mkMiddle nodes)\n  where (offset, gregs, nodes) = copyIn dflags conv area formals extra_stk\n\n-- Return the number of bytes used for copying arguments, as well as the\n-- instructions to copy the arguments.\ncopyIn :: DynFlags -> Convention -> Area\n       -> [CmmFormal]\n       -> [CmmFormal]\n       -> (ByteOff, [GlobalReg], [CmmNode O O])\ncopyIn dflags conv area formals extra_stk\n  = (stk_size, [r | (_, RegisterParam r) <- args], map ci (stk_args ++ args))\n  where\n    -- See Note [Width of parameters]\n    ci (reg, RegisterParam r@(VanillaReg {})) =\n        let local = CmmLocal reg\n            global = CmmReg (CmmGlobal r)\n            width = cmmRegWidth dflags local\n            expr\n                | width == wordWidth dflags = global\n                | width < wordWidth dflags =\n                    CmmMachOp (MO_XX_Conv (wordWidth dflags) width) [global]\n                | otherwise = panic \"Parameter width greater than word width\"\n\n        in CmmAssign local expr\n\n    -- Non VanillaRegs\n    ci (reg, RegisterParam r) =\n        CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal r))\n\n    ci (reg, StackParam off)\n      | isBitsType $ localRegType reg\n      , typeWidth (localRegType reg) < wordWidth dflags =\n        let\n          stack_slot = (CmmLoad (CmmStackSlot area off) (cmmBits $ wordWidth dflags))\n          local = CmmLocal reg\n          width = cmmRegWidth dflags local\n          expr  = CmmMachOp (MO_XX_Conv (wordWidth dflags) width) [stack_slot]\n        in CmmAssign local expr \n         \n      | otherwise =\n         CmmAssign (CmmLocal reg) (CmmLoad (CmmStackSlot area off) ty)\n         where ty = localRegType reg\n\n    init_offset = widthInBytes (wordWidth dflags) -- infotable\n\n    (stk_off, stk_args) = assignStack dflags init_offset localRegType extra_stk\n\n    (stk_size, args) = assignArgumentsPos dflags stk_off conv\n                                          localRegType formals\n\n-- Factoring out the common parts of the copyout functions yielded something\n-- more complicated:\n\ndata Transfer = Call | JumpRet | Jump | Ret deriving Eq\n\ncopyOutOflow :: DynFlags -> Convention -> Transfer -> Area -> [CmmExpr]\n             -> UpdFrameOffset\n             -> [CmmExpr] -- extra stack args\n             -> (Int, [GlobalReg], CmmAGraph)\n\n-- Generate code to move the actual parameters into the locations\n-- required by the calling convention.  This includes a store for the\n-- return address.\n--\n-- The argument layout function ignores the pointer to the info table,\n-- so we slot that in here. When copying-out to a young area, we set\n-- the info table for return and adjust the offsets of the other\n-- parameters.  If this is a call instruction, we adjust the offsets\n-- of the other parameters.\ncopyOutOflow dflags conv transfer area actuals updfr_off extra_stack_stuff\n  = (stk_size, regs, graph)\n  where\n    (regs, graph) = foldr co ([], mkNop) (setRA ++ args ++ stack_params)\n\n    -- See Note [Width of parameters]\n    co (v, RegisterParam r@(VanillaReg {})) (rs, ms) =\n        let width = cmmExprWidth dflags v\n            value\n                | width == wordWidth dflags = v\n                | width < wordWidth dflags =\n                    CmmMachOp (MO_XX_Conv width (wordWidth dflags)) [v]\n                | otherwise = panic \"Parameter width greater than word width\"\n\n        in (r:rs, mkAssign (CmmGlobal r) value <*> ms)\n\n    -- Non VanillaRegs\n    co (v, RegisterParam r) (rs, ms) =\n        (r:rs, mkAssign (CmmGlobal r) v <*> ms)\n\n    -- See Note [Width of parameters]\n    co (v, StackParam off)  (rs, ms)\n      = (rs, mkStore (CmmStackSlot area off) (value v) <*> ms)\n\n    width v = cmmExprWidth dflags v\n    value v\n      | isBitsType $ cmmExprType dflags v\n      , width v < wordWidth dflags =\n        CmmMachOp (MO_XX_Conv (width v) (wordWidth dflags)) [v]\n      | otherwise = v\n\n    (setRA, init_offset) =\n      case area of\n            Young id ->  -- Generate a store instruction for\n                         -- the return address if making a call\n                  case transfer of\n                     Call ->\n                       ([(CmmLit (CmmBlock id), StackParam init_offset)],\n                       widthInBytes (wordWidth dflags))\n                     JumpRet ->\n                       ([],\n                       widthInBytes (wordWidth dflags))\n                     _other ->\n                       ([], 0)\n            Old -> ([], updfr_off)\n\n    (extra_stack_off, stack_params) =\n       assignStack dflags init_offset (cmmExprType dflags) extra_stack_stuff\n\n    args :: [(CmmExpr, ParamLocation)]   -- The argument and where to put it\n    (stk_size, args) = assignArgumentsPos dflags extra_stack_off conv\n                                          (cmmExprType dflags) actuals\n\n\n-- Note [Width of parameters]\n--\n-- Consider passing a small (< word width) primitive like Int8# to a function.\n-- It's actually non-trivial to do this without extending/narrowing:\n-- * Global registers are considered to have native word width (i.e., 64-bits on\n--   x86-64), so CmmLint would complain if we assigned an 8-bit parameter to a\n--   global register.\n-- * Same problem exists with LLVM IR.\n-- * Lowering gets harder since on x86-32 not every register exposes its lower\n--   8 bits (e.g., for %eax we can use %al, but there isn't a corresponding\n--   8-bit register for %edi). So we would either need to extend/narrow anyway,\n--   or complicate the calling convention.\n-- * Passing a small integer in a stack slot, which has native word width,\n--   requires extending to word width when writing to the stack and narrowing\n--   when reading off the stack (see #16258).\n-- So instead, we always extend every parameter smaller than native word width\n-- in copyOutOflow and then truncate it back to the expected width in copyIn.\n-- Note that we do this in cmm using MO_XX_Conv to avoid requiring\n-- zero-/sign-extending - it's up to a backend to handle this in a most\n-- efficient way (e.g., a simple register move or a smaller size store).\n-- This convention (of ignoring the upper bits) is different from some C ABIs,\n-- e.g. all PowerPC ELF ABIs, that require sign or zero extending parameters.\n--\n-- There was some discussion about this on this PR:\n-- https://github.com/ghc-proposals/ghc-proposals/pull/74\n\n\nmkCallEntry :: DynFlags -> Convention -> [CmmFormal] -> [CmmFormal]\n            -> (Int, [GlobalReg], CmmAGraph)\nmkCallEntry dflags conv formals extra_stk\n  = copyInOflow dflags conv Old formals extra_stk\n\nlastWithArgs :: DynFlags -> Transfer -> Area -> Convention -> [CmmExpr]\n             -> UpdFrameOffset\n             -> (ByteOff -> [GlobalReg] -> CmmAGraph)\n             -> CmmAGraph\nlastWithArgs dflags transfer area conv actuals updfr_off last =\n  lastWithArgsAndExtraStack dflags transfer area conv actuals\n                            updfr_off noExtraStack last\n\nlastWithArgsAndExtraStack :: DynFlags\n             -> Transfer -> Area -> Convention -> [CmmExpr]\n             -> UpdFrameOffset -> [CmmExpr]\n             -> (ByteOff -> [GlobalReg] -> CmmAGraph)\n             -> CmmAGraph\nlastWithArgsAndExtraStack dflags transfer area conv actuals updfr_off\n                          extra_stack last =\n  copies <*> last outArgs regs\n where\n  (outArgs, regs, copies) = copyOutOflow dflags conv transfer area actuals\n                               updfr_off extra_stack\n\n\nnoExtraStack :: [CmmExpr]\nnoExtraStack = []\n\ntoCall :: CmmExpr -> Maybe BlockId -> UpdFrameOffset -> ByteOff\n       -> ByteOff -> [GlobalReg]\n       -> CmmAGraph\ntoCall e cont updfr_off res_space arg_space regs =\n  mkLast $ CmmCall e cont regs arg_space res_space updfr_off\n", "num_lines": 485}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GADTs #-}\n\n-----------------------------------------------------------------------------\n--\n-- Pretty-printing of Cmm as C, suitable for feeding gcc\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-- Print Cmm as real C, for -fvia-C\n--\n-- See wiki:Commentary/Compiler/Backends/PprC\n--\n-- This is simpler than the old PprAbsC, because Cmm is \"macro-expanded\"\n-- relative to the old AbstractC, and many oddities/decorations have\n-- disappeared from the data type.\n--\n-- This code generator is only supported in unregisterised mode.\n--\n-----------------------------------------------------------------------------\n\nmodule PprC (\n        writeCs,\n        pprStringInCStyle\n  ) where\n\n#include \"HsVersions.h\"\n\n-- Cmm stuff\nimport GhcPrelude\n\nimport BlockId\nimport CLabel\nimport ForeignCall\nimport Cmm hiding (pprBBlock)\nimport PprCmm ()\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport CmmUtils\nimport CmmSwitch\n\n-- Utils\nimport CPrim\nimport DynFlags\nimport FastString\nimport Outputable\nimport Platform\nimport UniqSet\nimport UniqFM\nimport Unique\nimport Util\n\n-- The rest\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString as BS\nimport Control.Monad.ST\nimport Data.Bits\nimport Data.Char\nimport Data.List\nimport Data.Map (Map)\nimport Data.Word\nimport System.IO\nimport qualified Data.Map as Map\nimport Control.Monad (liftM, ap)\nimport qualified Data.Array.Unsafe as U ( castSTUArray )\nimport Data.Array.ST\n\n-- --------------------------------------------------------------------------\n-- Top level\n\npprCs :: [RawCmmGroup] -> SDoc\npprCs cmms\n = pprCode CStyle (vcat $ map pprC cmms)\n\nwriteCs :: DynFlags -> Handle -> [RawCmmGroup] -> IO ()\nwriteCs dflags handle cmms\n  = printForC dflags handle (pprCs cmms)\n\n-- --------------------------------------------------------------------------\n-- Now do some real work\n--\n-- for fun, we could call cmmToCmm over the tops...\n--\n\npprC :: RawCmmGroup -> SDoc\npprC tops = vcat $ intersperse blankLine $ map pprTop tops\n\n--\n-- top level procs\n--\npprTop :: RawCmmDecl -> SDoc\npprTop (CmmProc infos clbl _in_live_regs graph) =\n\n    (case mapLookup (g_entry graph) infos of\n       Nothing -> empty\n       Just (Statics info_clbl info_dat) ->\n           pprDataExterns info_dat $$\n           pprWordArray info_is_in_rodata info_clbl info_dat) $$\n    (vcat [\n           blankLine,\n           extern_decls,\n           (if (externallyVisibleCLabel clbl)\n                    then mkFN_ else mkIF_) (ppr clbl) <+> lbrace,\n           nest 8 temp_decls,\n           vcat (map pprBBlock blocks),\n           rbrace ]\n    )\n  where\n        -- info tables are always in .rodata\n        info_is_in_rodata = True\n        blocks = toBlockListEntryFirst graph\n        (temp_decls, extern_decls) = pprTempAndExternDecls blocks\n\n\n-- Chunks of static data.\n\n-- We only handle (a) arrays of word-sized things and (b) strings.\n\npprTop (CmmData section (Statics lbl [CmmString str])) =\n  pprExternDecl lbl $$\n  hcat [\n    pprLocalness lbl, pprConstness (isSecConstant section), text \"char \", ppr lbl,\n    text \"[] = \", pprStringInCStyle str, semi\n  ]\n\npprTop (CmmData section (Statics lbl [CmmUninitialised size])) =\n  pprExternDecl lbl $$\n  hcat [\n    pprLocalness lbl, pprConstness (isSecConstant section), text \"char \", ppr lbl,\n    brackets (int size), semi\n  ]\n\npprTop (CmmData section (Statics lbl lits)) =\n  pprDataExterns lits $$\n  pprWordArray (isSecConstant section) lbl lits\n\n-- --------------------------------------------------------------------------\n-- BasicBlocks are self-contained entities: they always end in a jump.\n--\n-- Like nativeGen/AsmCodeGen, we could probably reorder blocks to turn\n-- as many jumps as possible into fall throughs.\n--\n\npprBBlock :: CmmBlock -> SDoc\npprBBlock block =\n  nest 4 (pprBlockId (entryLabel block) <> colon) $$\n  nest 8 (vcat (map pprStmt (blockToList nodes)) $$ pprStmt last)\n where\n  (_, nodes, last)  = blockSplit block\n\n-- --------------------------------------------------------------------------\n-- Info tables. Just arrays of words.\n-- See codeGen/ClosureInfo, and nativeGen/PprMach\n\npprWordArray :: Bool -> CLabel -> [CmmStatic] -> SDoc\npprWordArray is_ro lbl ds\n  = sdocWithDynFlags $ \\dflags ->\n    -- TODO: align closures only\n    pprExternDecl lbl $$\n    hcat [ pprLocalness lbl, pprConstness is_ro, text \"StgWord\"\n         , space, ppr lbl, text \"[]\"\n         -- See Note [StgWord alignment]\n         , pprAlignment (wordWidth dflags)\n         , text \"= {\" ]\n    $$ nest 8 (commafy (pprStatics dflags ds))\n    $$ text \"};\"\n\npprAlignment :: Width -> SDoc\npprAlignment words =\n     text \"__attribute__((aligned(\" <> int (widthInBytes words) <> text \")))\"\n\n-- Note [StgWord alignment]\n-- C codegen builds static closures as StgWord C arrays (pprWordArray).\n-- Their real C type is 'StgClosure'. Macros like UNTAG_CLOSURE assume\n-- pointers to 'StgClosure' are aligned at pointer size boundary:\n--  4 byte boundary on 32 systems\n--  and 8 bytes on 64-bit systems\n-- see TAG_MASK and TAG_BITS definition and usage.\n--\n-- It's a reasonable assumption also known as natural alignment.\n-- Although some architectures have different alignment rules.\n-- One of known exceptions is m68k (Trac #11395, comment:16) where:\n--   __alignof__(StgWord) == 2, sizeof(StgWord) == 4\n--\n-- Thus we explicitly increase alignment by using\n--    __attribute__((aligned(4)))\n-- declaration.\n\n--\n-- has to be static, if it isn't globally visible\n--\npprLocalness :: CLabel -> SDoc\npprLocalness lbl | not $ externallyVisibleCLabel lbl = text \"static \"\n                 | otherwise = empty\n\npprConstness :: Bool -> SDoc\npprConstness is_ro | is_ro = text \"const \"\n                   | otherwise = empty\n\n-- --------------------------------------------------------------------------\n-- Statements.\n--\n\npprStmt :: CmmNode e x -> SDoc\n\npprStmt stmt =\n    sdocWithDynFlags $ \\dflags ->\n    case stmt of\n    CmmEntry{}   -> empty\n    CmmComment _ -> empty -- (hang (text \"/*\") 3 (ftext s)) $$ ptext (sLit \"*/\")\n                          -- XXX if the string contains \"*/\", we need to fix it\n                          -- XXX we probably want to emit these comments when\n                          -- some debugging option is on.  They can get quite\n                          -- large.\n\n    CmmTick _ -> empty\n    CmmUnwind{} -> empty\n\n    CmmAssign dest src -> pprAssign dflags dest src\n\n    CmmStore  dest src\n        | typeWidth rep == W64 && wordWidth dflags /= W64\n        -> (if isFloatType rep then text \"ASSIGN_DBL\"\n                               else ptext (sLit (\"ASSIGN_Word64\"))) <>\n           parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi\n\n        | otherwise\n        -> hsep [ pprExpr (CmmLoad dest rep), equals, pprExpr src <> semi ]\n        where\n          rep = cmmExprType dflags src\n\n    CmmUnsafeForeignCall target@(ForeignTarget fn conv) results args ->\n        fnCall\n        where\n        (res_hints, arg_hints) = foreignTargetHints target\n        hresults = zip results res_hints\n        hargs    = zip args arg_hints\n\n        ForeignConvention cconv _ _ ret = conv\n\n        cast_fn = parens (cCast (pprCFunType (char '*') cconv hresults hargs) fn)\n\n        -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes\n        fnCall =\n            case fn of\n              CmmLit (CmmLabel lbl)\n                | StdCallConv <- cconv ->\n                    pprCall (ppr lbl) cconv hresults hargs\n                        -- stdcall functions must be declared with\n                        -- a function type, otherwise the C compiler\n                        -- doesn't add the @n suffix to the label.  We\n                        -- can't add the @n suffix ourselves, because\n                        -- it isn't valid C.\n                | CmmNeverReturns <- ret ->\n                    pprCall cast_fn cconv hresults hargs <> semi\n                | not (isMathFun lbl) ->\n                    pprForeignCall (ppr lbl) cconv hresults hargs\n              _ ->\n                    pprCall cast_fn cconv hresults hargs <> semi\n                        -- for a dynamic call, no declaration is necessary.\n\n    CmmUnsafeForeignCall (PrimTarget MO_Touch) _results _args -> empty\n    CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data _)) _results _args -> empty\n\n    CmmUnsafeForeignCall target@(PrimTarget op) results args ->\n        fn_call\n      where\n        cconv = CCallConv\n        fn = pprCallishMachOp_for_C op\n\n        (res_hints, arg_hints) = foreignTargetHints target\n        hresults = zip results res_hints\n        hargs    = zip args arg_hints\n\n        fn_call\n          -- The mem primops carry an extra alignment arg.\n          -- We could maybe emit an alignment directive using this info.\n          -- We also need to cast mem primops to prevent conflicts with GCC\n          -- builtins (see bug #5967).\n          | Just _align <- machOpMemcpyishAlign op\n          = (text \";EFF_(\" <> fn <> char ')' <> semi) $$\n            pprForeignCall fn cconv hresults hargs\n          | otherwise\n          = pprCall fn cconv hresults hargs\n\n    CmmBranch ident          -> pprBranch ident\n    CmmCondBranch expr yes no _ -> pprCondBranch expr yes no\n    CmmCall { cml_target = expr } -> mkJMP_ (pprExpr expr) <> semi\n    CmmSwitch arg ids        -> sdocWithDynFlags $ \\dflags ->\n                                pprSwitch dflags arg ids\n\n    _other -> pprPanic \"PprC.pprStmt\" (ppr stmt)\n\ntype Hinted a = (a, ForeignHint)\n\npprForeignCall :: SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual]\n               -> SDoc\npprForeignCall fn cconv results args = fn_call\n  where\n    fn_call = braces (\n                 pprCFunType (char '*' <> text \"ghcFunPtr\") cconv results args <> semi\n              $$ text \"ghcFunPtr\" <+> equals <+> cast_fn <> semi\n              $$ pprCall (text \"ghcFunPtr\") cconv results args <> semi\n             )\n    cast_fn = parens (parens (pprCFunType (char '*') cconv results args) <> fn)\n\npprCFunType :: SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc\npprCFunType ppr_fn cconv ress args\n  = sdocWithDynFlags $ \\dflags ->\n    let res_type [] = text \"void\"\n        res_type [(one, hint)] = machRepHintCType (localRegType one) hint\n        res_type _ = panic \"pprCFunType: only void or 1 return value supported\"\n\n        arg_type (expr, hint) = machRepHintCType (cmmExprType dflags expr) hint\n    in res_type ress <+>\n       parens (ccallConvAttribute cconv <> ppr_fn) <>\n       parens (commafy (map arg_type args))\n\n-- ---------------------------------------------------------------------\n-- unconditional branches\npprBranch :: BlockId -> SDoc\npprBranch ident = text \"goto\" <+> pprBlockId ident <> semi\n\n\n-- ---------------------------------------------------------------------\n-- conditional branches to local labels\npprCondBranch :: CmmExpr -> BlockId -> BlockId -> SDoc\npprCondBranch expr yes no\n        = hsep [ text \"if\" , parens(pprExpr expr) ,\n                        text \"goto\", pprBlockId yes <> semi,\n                        text \"else goto\", pprBlockId no <> semi ]\n\n-- ---------------------------------------------------------------------\n-- a local table branch\n--\n-- we find the fall-through cases\n--\npprSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> SDoc\npprSwitch dflags e ids\n  = (hang (text \"switch\" <+> parens ( pprExpr e ) <+> lbrace)\n                4 (vcat ( map caseify pairs ) $$ def)) $$ rbrace\n  where\n    (pairs, mbdef) = switchTargetsFallThrough ids\n\n    -- fall through case\n    caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix\n        where\n        do_fallthrough ix =\n                 hsep [ text \"case\" , pprHexVal ix (wordWidth dflags) <> colon ,\n                        text \"/* fall through */\" ]\n\n        final_branch ix =\n                hsep [ text \"case\" , pprHexVal ix (wordWidth dflags) <> colon ,\n                       text \"goto\" , (pprBlockId ident) <> semi ]\n\n    caseify (_     , _    ) = panic \"pprSwitch: switch with no cases!\"\n\n    def | Just l <- mbdef = text \"default: goto\" <+> pprBlockId l <> semi\n        | otherwise       = empty\n\n-- ---------------------------------------------------------------------\n-- Expressions.\n--\n\n-- C Types: the invariant is that the C expression generated by\n--\n--      pprExpr e\n--\n-- has a type in C which is also given by\n--\n--      machRepCType (cmmExprType e)\n--\n-- (similar invariants apply to the rest of the pretty printer).\n\npprExpr :: CmmExpr -> SDoc\npprExpr e = case e of\n    CmmLit lit -> pprLit lit\n\n\n    CmmLoad e ty -> sdocWithDynFlags $ \\dflags -> pprLoad dflags e ty\n    CmmReg reg      -> pprCastReg reg\n    CmmRegOff reg 0 -> pprCastReg reg\n\n    -- CmmRegOff is an alias of MO_Add\n    CmmRegOff reg i -> sdocWithDynFlags $ \\dflags ->\n                       pprCastReg reg <> char '+' <>\n                       pprHexVal (fromIntegral i) (wordWidth dflags)\n\n    CmmMachOp mop args -> pprMachOpApp mop args\n\n    CmmStackSlot _ _   -> panic \"pprExpr: CmmStackSlot not supported!\"\n\n\npprLoad :: DynFlags -> CmmExpr -> CmmType -> SDoc\npprLoad dflags e ty\n  | width == W64, wordWidth dflags /= W64\n  = (if isFloatType ty then text \"PK_DBL\"\n                       else text \"PK_Word64\")\n    <> parens (mkP_ <> pprExpr1 e)\n\n  | otherwise\n  = case e of\n        CmmReg r | isPtrReg r && width == wordWidth dflags && not (isFloatType ty)\n                 -> char '*' <> pprAsPtrReg r\n\n        CmmRegOff r 0 | isPtrReg r && width == wordWidth dflags && not (isFloatType ty)\n                      -> char '*' <> pprAsPtrReg r\n\n        CmmRegOff r off | isPtrReg r && width == wordWidth dflags\n                        , off `rem` wORD_SIZE dflags == 0 && not (isFloatType ty)\n        -- ToDo: check that the offset is a word multiple?\n        --       (For tagging to work, I had to avoid unaligned loads. --ARY)\n                        -> pprAsPtrReg r <> brackets (ppr (off `shiftR` wordShift dflags))\n\n        _other -> cLoad e ty\n  where\n    width = typeWidth ty\n\npprExpr1 :: CmmExpr -> SDoc\npprExpr1 (CmmLit lit)     = pprLit1 lit\npprExpr1 e@(CmmReg _reg)  = pprExpr e\npprExpr1 other            = parens (pprExpr other)\n\n-- --------------------------------------------------------------------------\n-- MachOp applications\n\npprMachOpApp :: MachOp -> [CmmExpr] -> SDoc\n\npprMachOpApp op args\n  | isMulMayOfloOp op\n  = text \"mulIntMayOflo\" <> parens (commafy (map pprExpr args))\n  where isMulMayOfloOp (MO_U_MulMayOflo _) = True\n        isMulMayOfloOp (MO_S_MulMayOflo _) = True\n        isMulMayOfloOp _ = False\n\npprMachOpApp mop args\n  | Just ty <- machOpNeedsCast mop\n  = ty <> parens (pprMachOpApp' mop args)\n  | otherwise\n  = pprMachOpApp' mop args\n\n-- Comparisons in C have type 'int', but we want type W_ (this is what\n-- resultRepOfMachOp says).  The other C operations inherit their type\n-- from their operands, so no casting is required.\nmachOpNeedsCast :: MachOp -> Maybe SDoc\nmachOpNeedsCast mop\n  | isComparisonMachOp mop = Just mkW_\n  | otherwise              = Nothing\n\npprMachOpApp' :: MachOp -> [CmmExpr] -> SDoc\npprMachOpApp' mop args\n = case args of\n    -- dyadic\n    [x,y] -> pprArg x <+> pprMachOp_for_C mop <+> pprArg y\n\n    -- unary\n    [x]   -> pprMachOp_for_C mop <> parens (pprArg x)\n\n    _     -> panic \"PprC.pprMachOp : machop with wrong number of args\"\n\n  where\n        -- Cast needed for signed integer ops\n    pprArg e | signedOp    mop = sdocWithDynFlags $ \\dflags ->\n                                 cCast (machRep_S_CType (typeWidth (cmmExprType dflags e))) e\n             | needsFCasts mop = sdocWithDynFlags $ \\dflags ->\n                                 cCast (machRep_F_CType (typeWidth (cmmExprType dflags e))) e\n             | otherwise    = pprExpr1 e\n    needsFCasts (MO_F_Eq _)   = False\n    needsFCasts (MO_F_Ne _)   = False\n    needsFCasts (MO_F_Neg _)  = True\n    needsFCasts (MO_F_Quot _) = True\n    needsFCasts mop  = floatComparison mop\n\n-- --------------------------------------------------------------------------\n-- Literals\n\npprLit :: CmmLit -> SDoc\npprLit lit = case lit of\n    CmmInt i rep      -> pprHexVal i rep\n\n    CmmFloat f w       -> parens (machRep_F_CType w) <> str\n        where d = fromRational f :: Double\n              str | isInfinite d && d < 0 = text \"-INFINITY\"\n                  | isInfinite d          = text \"INFINITY\"\n                  | isNaN d               = text \"NAN\"\n                  | otherwise             = text (show d)\n                -- these constants come from <math.h>\n                -- see #1861\n\n    CmmVec {} -> panic \"PprC printing vector literal\"\n\n    CmmBlock bid       -> mkW_ <> pprCLabelAddr (infoTblLbl bid)\n    CmmHighStackMark   -> panic \"PprC printing high stack mark\"\n    CmmLabel clbl      -> mkW_ <> pprCLabelAddr clbl\n    CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i\n    CmmLabelDiffOff clbl1 _ i _   -- non-word widths not supported via C\n        -- WARNING:\n        --  * the lit must occur in the info table clbl2\n        --  * clbl1 must be an SRT, a slow entry point or a large bitmap\n        -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i\n\n    where\n        pprCLabelAddr lbl = char '&' <> ppr lbl\n\npprLit1 :: CmmLit -> SDoc\npprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)\npprLit1 lit@(CmmLabelDiffOff _ _ _ _) = parens (pprLit lit)\npprLit1 lit@(CmmFloat _ _)    = parens (pprLit lit)\npprLit1 other = pprLit other\n\n-- ---------------------------------------------------------------------------\n-- Static data\n\npprStatics :: DynFlags -> [CmmStatic] -> [SDoc]\npprStatics _ [] = []\npprStatics dflags (CmmStaticLit (CmmFloat f W32) : rest)\n  -- odd numbers of floats are padded to a word by mkVirtHeapOffsetsWithPadding\n  | wORD_SIZE dflags == 8, CmmStaticLit (CmmInt 0 W32) : rest' <- rest\n  = pprLit1 (floatToWord dflags f) : pprStatics dflags rest'\n  -- adjacent floats aren't padded but combined into a single word\n  | wORD_SIZE dflags == 8, CmmStaticLit (CmmFloat g W32) : rest' <- rest\n  = pprLit1 (floatPairToWord dflags f g) : pprStatics dflags rest'\n  | wORD_SIZE dflags == 4\n  = pprLit1 (floatToWord dflags f) : pprStatics dflags rest\n  | otherwise\n  = pprPanic \"pprStatics: float\" (vcat (map ppr' rest))\n    where ppr' (CmmStaticLit l) = sdocWithDynFlags $ \\dflags ->\n                                  ppr (cmmLitType dflags l)\n          ppr' _other           = text \"bad static!\"\npprStatics dflags (CmmStaticLit (CmmFloat f W64) : rest)\n  = map pprLit1 (doubleToWords dflags f) ++ pprStatics dflags rest\n\npprStatics dflags (CmmStaticLit (CmmInt i W64) : rest)\n  | wordWidth dflags == W32\n  = if wORDS_BIGENDIAN dflags\n    then pprStatics dflags (CmmStaticLit (CmmInt q W32) :\n                            CmmStaticLit (CmmInt r W32) : rest)\n    else pprStatics dflags (CmmStaticLit (CmmInt r W32) :\n                            CmmStaticLit (CmmInt q W32) : rest)\n  where r = i .&. 0xffffffff\n        q = i `shiftR` 32\npprStatics dflags (CmmStaticLit (CmmInt a W32) :\n                   CmmStaticLit (CmmInt b W32) : rest)\n  | wordWidth dflags == W64\n  = if wORDS_BIGENDIAN dflags\n    then pprStatics dflags (CmmStaticLit (CmmInt ((shiftL a 32) .|. b) W64) :\n                            rest)\n    else pprStatics dflags (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) :\n                            rest)\npprStatics dflags (CmmStaticLit (CmmInt a W16) :\n                   CmmStaticLit (CmmInt b W16) : rest)\n  | wordWidth dflags == W32\n  = if wORDS_BIGENDIAN dflags\n    then pprStatics dflags (CmmStaticLit (CmmInt ((shiftL a 16) .|. b) W32) :\n                            rest)\n    else pprStatics dflags (CmmStaticLit (CmmInt ((shiftL b 16) .|. a) W32) :\n                            rest)\npprStatics dflags (CmmStaticLit (CmmInt _ w) : _)\n  | w /= wordWidth dflags\n  = pprPanic \"pprStatics: cannot emit a non-word-sized static literal\" (ppr w)\npprStatics dflags (CmmStaticLit lit : rest)\n  = pprLit1 lit : pprStatics dflags rest\npprStatics _ (other : _)\n  = pprPanic \"pprStatics: other\" (pprStatic other)\n\npprStatic :: CmmStatic -> SDoc\npprStatic s = case s of\n\n    CmmStaticLit lit   -> nest 4 (pprLit lit)\n    CmmUninitialised i -> nest 4 (mkC_ <> brackets (int i))\n\n    -- these should be inlined, like the old .hc\n    CmmString s'       -> nest 4 (mkW_ <> parens(pprStringInCStyle s'))\n\n\n-- ---------------------------------------------------------------------------\n-- Block Ids\n\npprBlockId :: BlockId -> SDoc\npprBlockId b = char '_' <> ppr (getUnique b)\n\n-- --------------------------------------------------------------------------\n-- Print a MachOp in a way suitable for emitting via C.\n--\n\npprMachOp_for_C :: MachOp -> SDoc\n\npprMachOp_for_C mop = case mop of\n\n        -- Integer operations\n        MO_Add          _ -> char '+'\n        MO_Sub          _ -> char '-'\n        MO_Eq           _ -> text \"==\"\n        MO_Ne           _ -> text \"!=\"\n        MO_Mul          _ -> char '*'\n\n        MO_S_Quot       _ -> char '/'\n        MO_S_Rem        _ -> char '%'\n        MO_S_Neg        _ -> char '-'\n\n        MO_U_Quot       _ -> char '/'\n        MO_U_Rem        _ -> char '%'\n\n        -- & Floating-point operations\n        MO_F_Add        _ -> char '+'\n        MO_F_Sub        _ -> char '-'\n        MO_F_Neg        _ -> char '-'\n        MO_F_Mul        _ -> char '*'\n        MO_F_Quot       _ -> char '/'\n\n        -- Signed comparisons\n        MO_S_Ge         _ -> text \">=\"\n        MO_S_Le         _ -> text \"<=\"\n        MO_S_Gt         _ -> char '>'\n        MO_S_Lt         _ -> char '<'\n\n        -- & Unsigned comparisons\n        MO_U_Ge         _ -> text \">=\"\n        MO_U_Le         _ -> text \"<=\"\n        MO_U_Gt         _ -> char '>'\n        MO_U_Lt         _ -> char '<'\n\n        -- & Floating-point comparisons\n        MO_F_Eq         _ -> text \"==\"\n        MO_F_Ne         _ -> text \"!=\"\n        MO_F_Ge         _ -> text \">=\"\n        MO_F_Le         _ -> text \"<=\"\n        MO_F_Gt         _ -> char '>'\n        MO_F_Lt         _ -> char '<'\n\n        -- Bitwise operations.  Not all of these may be supported at all\n        -- sizes, and only integral MachReps are valid.\n        MO_And          _ -> char '&'\n        MO_Or           _ -> char '|'\n        MO_Xor          _ -> char '^'\n        MO_Not          _ -> char '~'\n        MO_Shl          _ -> text \"<<\"\n        MO_U_Shr        _ -> text \">>\" -- unsigned shift right\n        MO_S_Shr        _ -> text \">>\" -- signed shift right\n\n-- Conversions.  Some of these will be NOPs, but never those that convert\n-- between ints and floats.\n-- Floating-point conversions use the signed variant.\n-- We won't know to generate (void*) casts here, but maybe from\n-- context elsewhere\n\n-- noop casts\n        MO_UU_Conv from to | from == to -> empty\n        MO_UU_Conv _from to -> parens (machRep_U_CType to)\n\n        MO_SS_Conv from to | from == to -> empty\n        MO_SS_Conv _from to -> parens (machRep_S_CType to)\n\n        MO_XX_Conv from to | from == to -> empty\n        MO_XX_Conv _from to -> parens (machRep_U_CType to)\n\n        MO_FF_Conv from to | from == to -> empty\n        MO_FF_Conv _from to -> parens (machRep_F_CType to)\n\n        MO_SF_Conv _from to -> parens (machRep_F_CType to)\n        MO_FS_Conv _from to -> parens (machRep_S_CType to)\n\n        MO_S_MulMayOflo _ -> pprTrace \"offending mop:\"\n                                (text \"MO_S_MulMayOflo\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_S_MulMayOflo\"\n                                      ++ \" should have been handled earlier!\")\n        MO_U_MulMayOflo _ -> pprTrace \"offending mop:\"\n                                (text \"MO_U_MulMayOflo\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_U_MulMayOflo\"\n                                      ++ \" should have been handled earlier!\")\n\n        MO_V_Insert {}    -> pprTrace \"offending mop:\"\n                                (text \"MO_V_Insert\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_V_Insert\"\n                                      ++ \" should have been handled earlier!\")\n        MO_V_Extract {}   -> pprTrace \"offending mop:\"\n                                (text \"MO_V_Extract\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_V_Extract\"\n                                      ++ \" should have been handled earlier!\")\n\n        MO_V_Add {}       -> pprTrace \"offending mop:\"\n                                (text \"MO_V_Add\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_V_Add\"\n                                      ++ \" should have been handled earlier!\")\n        MO_V_Sub {}       -> pprTrace \"offending mop:\"\n                                (text \"MO_V_Sub\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_V_Sub\"\n                                      ++ \" should have been handled earlier!\")\n        MO_V_Mul {}       -> pprTrace \"offending mop:\"\n                                (text \"MO_V_Mul\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_V_Mul\"\n                                      ++ \" should have been handled earlier!\")\n\n        MO_VS_Quot {}     -> pprTrace \"offending mop:\"\n                                (text \"MO_VS_Quot\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VS_Quot\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VS_Rem {}      -> pprTrace \"offending mop:\"\n                                (text \"MO_VS_Rem\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VS_Rem\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VS_Neg {}      -> pprTrace \"offending mop:\"\n                                (text \"MO_VS_Neg\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VS_Neg\"\n                                      ++ \" should have been handled earlier!\")\n\n        MO_VU_Quot {}     -> pprTrace \"offending mop:\"\n                                (text \"MO_VU_Quot\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VU_Quot\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VU_Rem {}      -> pprTrace \"offending mop:\"\n                                (text \"MO_VU_Rem\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VU_Rem\"\n                                      ++ \" should have been handled earlier!\")\n\n        MO_VF_Insert {}   -> pprTrace \"offending mop:\"\n                                (text \"MO_VF_Insert\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VF_Insert\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VF_Extract {}  -> pprTrace \"offending mop:\"\n                                (text \"MO_VF_Extract\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VF_Extract\"\n                                      ++ \" should have been handled earlier!\")\n\n        MO_VF_Add {}      -> pprTrace \"offending mop:\"\n                                (text \"MO_VF_Add\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VF_Add\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VF_Sub {}      -> pprTrace \"offending mop:\"\n                                (text \"MO_VF_Sub\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VF_Sub\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VF_Neg {}      -> pprTrace \"offending mop:\"\n                                (text \"MO_VF_Neg\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VF_Neg\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VF_Mul {}      -> pprTrace \"offending mop:\"\n                                (text \"MO_VF_Mul\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VF_Mul\"\n                                      ++ \" should have been handled earlier!\")\n        MO_VF_Quot {}     -> pprTrace \"offending mop:\"\n                                (text \"MO_VF_Quot\")\n                                (panic $ \"PprC.pprMachOp_for_C: MO_VF_Quot\"\n                                      ++ \" should have been handled earlier!\")\n\n        MO_AlignmentCheck {} -> panic \"-falignment-santisation not supported by unregisterised backend\"\n\nsignedOp :: MachOp -> Bool      -- Argument type(s) are signed ints\nsignedOp (MO_S_Quot _)    = True\nsignedOp (MO_S_Rem  _)    = True\nsignedOp (MO_S_Neg  _)    = True\nsignedOp (MO_S_Ge   _)    = True\nsignedOp (MO_S_Le   _)    = True\nsignedOp (MO_S_Gt   _)    = True\nsignedOp (MO_S_Lt   _)    = True\nsignedOp (MO_S_Shr  _)    = True\nsignedOp (MO_SS_Conv _ _) = True\nsignedOp (MO_SF_Conv _ _) = True\nsignedOp _                = False\n\nfloatComparison :: MachOp -> Bool  -- comparison between float args\nfloatComparison (MO_F_Eq   _) = True\nfloatComparison (MO_F_Ne   _) = True\nfloatComparison (MO_F_Ge   _) = True\nfloatComparison (MO_F_Le   _) = True\nfloatComparison (MO_F_Gt   _) = True\nfloatComparison (MO_F_Lt   _) = True\nfloatComparison _             = False\n\n-- ---------------------------------------------------------------------\n-- tend to be implemented by foreign calls\n\npprCallishMachOp_for_C :: CallishMachOp -> SDoc\n\npprCallishMachOp_for_C mop\n    = case mop of\n        MO_F64_Pwr      -> text \"pow\"\n        MO_F64_Sin      -> text \"sin\"\n        MO_F64_Cos      -> text \"cos\"\n        MO_F64_Tan      -> text \"tan\"\n        MO_F64_Sinh     -> text \"sinh\"\n        MO_F64_Cosh     -> text \"cosh\"\n        MO_F64_Tanh     -> text \"tanh\"\n        MO_F64_Asin     -> text \"asin\"\n        MO_F64_Acos     -> text \"acos\"\n        MO_F64_Atanh    -> text \"atanh\"\n        MO_F64_Asinh    -> text \"asinh\"\n        MO_F64_Acosh    -> text \"acosh\"\n        MO_F64_Atan     -> text \"atan\"\n        MO_F64_Log      -> text \"log\"\n        MO_F64_Exp      -> text \"exp\"\n        MO_F64_Sqrt     -> text \"sqrt\"\n        MO_F64_Fabs     -> text \"fabs\"\n        MO_F32_Pwr      -> text \"powf\"\n        MO_F32_Sin      -> text \"sinf\"\n        MO_F32_Cos      -> text \"cosf\"\n        MO_F32_Tan      -> text \"tanf\"\n        MO_F32_Sinh     -> text \"sinhf\"\n        MO_F32_Cosh     -> text \"coshf\"\n        MO_F32_Tanh     -> text \"tanhf\"\n        MO_F32_Asin     -> text \"asinf\"\n        MO_F32_Acos     -> text \"acosf\"\n        MO_F32_Atan     -> text \"atanf\"\n        MO_F32_Asinh    -> text \"asinhf\"\n        MO_F32_Acosh    -> text \"acoshf\"\n        MO_F32_Atanh    -> text \"atanhf\"\n        MO_F32_Log      -> text \"logf\"\n        MO_F32_Exp      -> text \"expf\"\n        MO_F32_Sqrt     -> text \"sqrtf\"\n        MO_F32_Fabs     -> text \"fabsf\"\n        MO_WriteBarrier -> text \"write_barrier\"\n        MO_Memcpy _     -> text \"memcpy\"\n        MO_Memset _     -> text \"memset\"\n        MO_Memmove _    -> text \"memmove\"\n        MO_Memcmp _     -> text \"memcmp\"\n        (MO_BSwap w)    -> ptext (sLit $ bSwapLabel w)\n        (MO_PopCnt w)   -> ptext (sLit $ popCntLabel w)\n        (MO_Pext w)     -> ptext (sLit $ pextLabel w)\n        (MO_Pdep w)     -> ptext (sLit $ pdepLabel w)\n        (MO_Clz w)      -> ptext (sLit $ clzLabel w)\n        (MO_Ctz w)      -> ptext (sLit $ ctzLabel w)\n        (MO_AtomicRMW w amop) -> ptext (sLit $ atomicRMWLabel w amop)\n        (MO_Cmpxchg w)  -> ptext (sLit $ cmpxchgLabel w)\n        (MO_AtomicRead w)  -> ptext (sLit $ atomicReadLabel w)\n        (MO_AtomicWrite w) -> ptext (sLit $ atomicWriteLabel w)\n        (MO_UF_Conv w)  -> ptext (sLit $ word2FloatLabel w)\n\n        MO_S_QuotRem  {} -> unsupported\n        MO_U_QuotRem  {} -> unsupported\n        MO_U_QuotRem2 {} -> unsupported\n        MO_Add2       {} -> unsupported\n        MO_AddWordC   {} -> unsupported\n        MO_SubWordC   {} -> unsupported\n        MO_AddIntC    {} -> unsupported\n        MO_SubIntC    {} -> unsupported\n        MO_U_Mul2     {} -> unsupported\n        MO_Touch         -> unsupported\n        (MO_Prefetch_Data _ ) -> unsupported\n        --- we could support prefetch via \"__builtin_prefetch\"\n        --- Not adding it for now\n    where unsupported = panic (\"pprCallishMachOp_for_C: \" ++ show mop\n                            ++ \" not supported!\")\n\n-- ---------------------------------------------------------------------\n-- Useful #defines\n--\n\nmkJMP_, mkFN_, mkIF_ :: SDoc -> SDoc\n\nmkJMP_ i = text \"JMP_\" <> parens i\nmkFN_  i = text \"FN_\"  <> parens i -- externally visible function\nmkIF_  i = text \"IF_\"  <> parens i -- locally visible\n\n-- from includes/Stg.h\n--\nmkC_,mkW_,mkP_ :: SDoc\n\nmkC_  = text \"(C_)\"        -- StgChar\nmkW_  = text \"(W_)\"        -- StgWord\nmkP_  = text \"(P_)\"        -- StgWord*\n\n-- ---------------------------------------------------------------------\n--\n-- Assignments\n--\n-- Generating assignments is what we're all about, here\n--\npprAssign :: DynFlags -> CmmReg -> CmmExpr -> SDoc\n\n-- dest is a reg, rhs is a reg\npprAssign _ r1 (CmmReg r2)\n   | isPtrReg r1 && isPtrReg r2\n   = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, semi ]\n\n-- dest is a reg, rhs is a CmmRegOff\npprAssign dflags r1 (CmmRegOff r2 off)\n   | isPtrReg r1 && isPtrReg r2 && (off `rem` wORD_SIZE dflags == 0)\n   = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, op, int off', semi ]\n  where\n        off1 = off `shiftR` wordShift dflags\n\n        (op,off') | off >= 0  = (char '+', off1)\n                  | otherwise = (char '-', -off1)\n\n-- dest is a reg, rhs is anything.\n-- We can't cast the lvalue, so we have to cast the rhs if necessary.  Casting\n-- the lvalue elicits a warning from new GCC versions (3.4+).\npprAssign _ r1 r2\n  | isFixedPtrReg r1             = mkAssign (mkP_ <> pprExpr1 r2)\n  | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 r2)\n  | otherwise                    = mkAssign (pprExpr r2)\n    where mkAssign x = if r1 == CmmGlobal BaseReg\n                       then text \"ASSIGN_BaseReg\" <> parens x <> semi\n                       else pprReg r1 <> text \" = \" <> x <> semi\n\n-- ---------------------------------------------------------------------\n-- Registers\n\npprCastReg :: CmmReg -> SDoc\npprCastReg reg\n   | isStrangeTypeReg reg = mkW_ <> pprReg reg\n   | otherwise            = pprReg reg\n\n-- True if (pprReg reg) will give an expression with type StgPtr.  We\n-- need to take care with pointer arithmetic on registers with type\n-- StgPtr.\nisFixedPtrReg :: CmmReg -> Bool\nisFixedPtrReg (CmmLocal _) = False\nisFixedPtrReg (CmmGlobal r) = isFixedPtrGlobalReg r\n\n-- True if (pprAsPtrReg reg) will give an expression with type StgPtr\n-- JD: THIS IS HORRIBLE AND SHOULD BE RENAMED, AT THE VERY LEAST.\n-- THE GARBAGE WITH THE VNonGcPtr HELPS MATCH THE OLD CODE GENERATOR'S OUTPUT;\n-- I'M NOT SURE IF IT SHOULD REALLY STAY THAT WAY.\nisPtrReg :: CmmReg -> Bool\nisPtrReg (CmmLocal _)                         = False\nisPtrReg (CmmGlobal (VanillaReg _ VGcPtr))    = True  -- if we print via pprAsPtrReg\nisPtrReg (CmmGlobal (VanillaReg _ VNonGcPtr)) = False -- if we print via pprAsPtrReg\nisPtrReg (CmmGlobal reg)                      = isFixedPtrGlobalReg reg\n\n-- True if this global reg has type StgPtr\nisFixedPtrGlobalReg :: GlobalReg -> Bool\nisFixedPtrGlobalReg Sp    = True\nisFixedPtrGlobalReg Hp    = True\nisFixedPtrGlobalReg HpLim = True\nisFixedPtrGlobalReg SpLim = True\nisFixedPtrGlobalReg _     = False\n\n-- True if in C this register doesn't have the type given by\n-- (machRepCType (cmmRegType reg)), so it has to be cast.\nisStrangeTypeReg :: CmmReg -> Bool\nisStrangeTypeReg (CmmLocal _)   = False\nisStrangeTypeReg (CmmGlobal g)  = isStrangeTypeGlobal g\n\nisStrangeTypeGlobal :: GlobalReg -> Bool\nisStrangeTypeGlobal CCCS                = True\nisStrangeTypeGlobal CurrentTSO          = True\nisStrangeTypeGlobal CurrentNursery      = True\nisStrangeTypeGlobal BaseReg             = True\nisStrangeTypeGlobal r                   = isFixedPtrGlobalReg r\n\nstrangeRegType :: CmmReg -> Maybe SDoc\nstrangeRegType (CmmGlobal CCCS) = Just (text \"struct CostCentreStack_ *\")\nstrangeRegType (CmmGlobal CurrentTSO) = Just (text \"struct StgTSO_ *\")\nstrangeRegType (CmmGlobal CurrentNursery) = Just (text \"struct bdescr_ *\")\nstrangeRegType (CmmGlobal BaseReg) = Just (text \"struct StgRegTable_ *\")\nstrangeRegType _ = Nothing\n\n-- pprReg just prints the register name.\n--\npprReg :: CmmReg -> SDoc\npprReg r = case r of\n        CmmLocal  local  -> pprLocalReg local\n        CmmGlobal global -> pprGlobalReg global\n\npprAsPtrReg :: CmmReg -> SDoc\npprAsPtrReg (CmmGlobal (VanillaReg n gcp))\n  = WARN( gcp /= VGcPtr, ppr n ) char 'R' <> int n <> text \".p\"\npprAsPtrReg other_reg = pprReg other_reg\n\npprGlobalReg :: GlobalReg -> SDoc\npprGlobalReg gr = case gr of\n    VanillaReg n _ -> char 'R' <> int n  <> text \".w\"\n        -- pprGlobalReg prints a VanillaReg as a .w regardless\n        -- Example:     R1.w = R1.w & (-0x8UL);\n        --              JMP_(*R1.p);\n    FloatReg   n   -> char 'F' <> int n\n    DoubleReg  n   -> char 'D' <> int n\n    LongReg    n   -> char 'L' <> int n\n    Sp             -> text \"Sp\"\n    SpLim          -> text \"SpLim\"\n    Hp             -> text \"Hp\"\n    HpLim          -> text \"HpLim\"\n    CCCS           -> text \"CCCS\"\n    CurrentTSO     -> text \"CurrentTSO\"\n    CurrentNursery -> text \"CurrentNursery\"\n    HpAlloc        -> text \"HpAlloc\"\n    BaseReg        -> text \"BaseReg\"\n    EagerBlackholeInfo -> text \"stg_EAGER_BLACKHOLE_info\"\n    GCEnter1       -> text \"stg_gc_enter_1\"\n    GCFun          -> text \"stg_gc_fun\"\n    other          -> panic $ \"pprGlobalReg: Unsupported register: \" ++ show other\n\npprLocalReg :: LocalReg -> SDoc\npprLocalReg (LocalReg uniq _) = char '_' <> ppr uniq\n\n-- -----------------------------------------------------------------------------\n-- Foreign Calls\n\npprCall :: SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc\npprCall ppr_fn cconv results args\n  | not (is_cishCC cconv)\n  = panic $ \"pprCall: unknown calling convention\"\n\n  | otherwise\n  =\n    ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi\n  where\n     ppr_assign []           rhs = rhs\n     ppr_assign [(one,hint)] rhs\n         = pprLocalReg one <> text \" = \"\n                 <> pprUnHint hint (localRegType one) <> rhs\n     ppr_assign _other _rhs = panic \"pprCall: multiple results\"\n\n     pprArg (expr, AddrHint)\n        = cCast (text \"void *\") expr\n        -- see comment by machRepHintCType below\n     pprArg (expr, SignedHint)\n        = sdocWithDynFlags $ \\dflags ->\n          cCast (machRep_S_CType $ typeWidth $ cmmExprType dflags expr) expr\n     pprArg (expr, _other)\n        = pprExpr expr\n\n     pprUnHint AddrHint   rep = parens (machRepCType rep)\n     pprUnHint SignedHint rep = parens (machRepCType rep)\n     pprUnHint _          _   = empty\n\n-- Currently we only have these two calling conventions, but this might\n-- change in the future...\nis_cishCC :: CCallConv -> Bool\nis_cishCC CCallConv    = True\nis_cishCC CApiConv     = True\nis_cishCC StdCallConv  = True\nis_cishCC PrimCallConv = False\nis_cishCC JavaScriptCallConv = False\n\n-- ---------------------------------------------------------------------\n-- Find and print local and external declarations for a list of\n-- Cmm statements.\n--\npprTempAndExternDecls :: [CmmBlock] -> (SDoc{-temps-}, SDoc{-externs-})\npprTempAndExternDecls stmts\n  = (pprUFM (getUniqSet temps) (vcat . map pprTempDecl),\n     vcat (map pprExternDecl (Map.keys lbls)))\n  where (temps, lbls) = runTE (mapM_ te_BB stmts)\n\npprDataExterns :: [CmmStatic] -> SDoc\npprDataExterns statics\n  = vcat (map pprExternDecl (Map.keys lbls))\n  where (_, lbls) = runTE (mapM_ te_Static statics)\n\npprTempDecl :: LocalReg -> SDoc\npprTempDecl l@(LocalReg _ rep)\n  = hcat [ machRepCType rep, space, pprLocalReg l, semi ]\n\npprExternDecl :: CLabel -> SDoc\npprExternDecl lbl\n  -- do not print anything for \"known external\" things\n  | not (needsCDecl lbl) = empty\n  | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz\n  | otherwise =\n        hcat [ visibility, label_type lbl , lparen, ppr lbl, text \");\"\n             -- occasionally useful to see label type\n             -- , text \"/* \", pprDebugCLabel lbl, text \" */\"\n             ]\n where\n  label_type lbl | isBytesLabel lbl         = text \"B_\"\n                 | isForeignLabel lbl && isCFunctionLabel lbl\n                                            = text \"FF_\"\n                 | isCFunctionLabel lbl     = text \"F_\"\n                 | isStaticClosureLabel lbl = text \"C_\"\n                 -- generic .rodata labels\n                 | isSomeRODataLabel lbl    = text \"RO_\"\n                 -- generic .data labels (common case)\n                 | otherwise                = text \"RW_\"\n\n  visibility\n     | externallyVisibleCLabel lbl = char 'E'\n     | otherwise                   = char 'I'\n\n  -- If the label we want to refer to is a stdcall function (on Windows) then\n  -- we must generate an appropriate prototype for it, so that the C compiler will\n  -- add the @n suffix to the label (#2276)\n  stdcall_decl sz = sdocWithDynFlags $ \\dflags ->\n        text \"extern __attribute__((stdcall)) void \" <> ppr lbl\n        <> parens (commafy (replicate (sz `quot` wORD_SIZE dflags) (machRep_U_CType (wordWidth dflags))))\n        <> semi\n\ntype TEState = (UniqSet LocalReg, Map CLabel ())\nnewtype TE a = TE { unTE :: TEState -> (a, TEState) }\n\ninstance Functor TE where\n      fmap = liftM\n\ninstance Applicative TE where\n      pure a = TE $ \\s -> (a, s)\n      (<*>) = ap\n\ninstance Monad TE where\n   TE m >>= k  = TE $ \\s -> case m s of (a, s') -> unTE (k a) s'\n\nte_lbl :: CLabel -> TE ()\nte_lbl lbl = TE $ \\(temps,lbls) -> ((), (temps, Map.insert lbl () lbls))\n\nte_temp :: LocalReg -> TE ()\nte_temp r = TE $ \\(temps,lbls) -> ((), (addOneToUniqSet temps r, lbls))\n\nrunTE :: TE () -> TEState\nrunTE (TE m) = snd (m (emptyUniqSet, Map.empty))\n\nte_Static :: CmmStatic -> TE ()\nte_Static (CmmStaticLit lit) = te_Lit lit\nte_Static _ = return ()\n\nte_BB :: CmmBlock -> TE ()\nte_BB block = mapM_ te_Stmt (blockToList mid) >> te_Stmt last\n  where (_, mid, last) = blockSplit block\n\nte_Lit :: CmmLit -> TE ()\nte_Lit (CmmLabel l) = te_lbl l\nte_Lit (CmmLabelOff l _) = te_lbl l\nte_Lit (CmmLabelDiffOff l1 _ _ _) = te_lbl l1\nte_Lit _ = return ()\n\nte_Stmt :: CmmNode e x -> TE ()\nte_Stmt (CmmAssign r e)         = te_Reg r >> te_Expr e\nte_Stmt (CmmStore l r)          = te_Expr l >> te_Expr r\nte_Stmt (CmmUnsafeForeignCall target rs es)\n  = do  te_Target target\n        mapM_ te_temp rs\n        mapM_ te_Expr es\nte_Stmt (CmmCondBranch e _ _ _) = te_Expr e\nte_Stmt (CmmSwitch e _)         = te_Expr e\nte_Stmt (CmmCall { cml_target = e }) = te_Expr e\nte_Stmt _                       = return ()\n\nte_Target :: ForeignTarget -> TE ()\nte_Target (ForeignTarget e _)      = te_Expr e\nte_Target (PrimTarget{})           = return ()\n\nte_Expr :: CmmExpr -> TE ()\nte_Expr (CmmLit lit)            = te_Lit lit\nte_Expr (CmmLoad e _)           = te_Expr e\nte_Expr (CmmReg r)              = te_Reg r\nte_Expr (CmmMachOp _ es)        = mapM_ te_Expr es\nte_Expr (CmmRegOff r _)         = te_Reg r\nte_Expr (CmmStackSlot _ _)      = panic \"te_Expr: CmmStackSlot not supported!\"\n\nte_Reg :: CmmReg -> TE ()\nte_Reg (CmmLocal l) = te_temp l\nte_Reg _            = return ()\n\n\n-- ---------------------------------------------------------------------\n-- C types for MachReps\n\ncCast :: SDoc -> CmmExpr -> SDoc\ncCast ty expr = parens ty <> pprExpr1 expr\n\ncLoad :: CmmExpr -> CmmType -> SDoc\ncLoad expr rep\n    = sdocWithPlatform $ \\platform ->\n      if bewareLoadStoreAlignment (platformArch platform)\n      then let decl = machRepCType rep <+> text \"x\" <> semi\n               struct = text \"struct\" <+> braces (decl)\n               packed_attr = text \"__attribute__((packed))\"\n               cast = parens (struct <+> packed_attr <> char '*')\n           in parens (cast <+> pprExpr1 expr) <> text \"->x\"\n      else char '*' <> parens (cCast (machRepPtrCType rep) expr)\n    where -- On these platforms, unaligned loads are known to cause problems\n          bewareLoadStoreAlignment ArchAlpha    = True\n          bewareLoadStoreAlignment ArchMipseb   = True\n          bewareLoadStoreAlignment ArchMipsel   = True\n          bewareLoadStoreAlignment (ArchARM {}) = True\n          bewareLoadStoreAlignment ArchARM64    = True\n          bewareLoadStoreAlignment ArchSPARC    = True\n          bewareLoadStoreAlignment ArchSPARC64  = True\n          -- Pessimistically assume that they will also cause problems\n          -- on unknown arches\n          bewareLoadStoreAlignment ArchUnknown  = True\n          bewareLoadStoreAlignment _            = False\n\nisCmmWordType :: DynFlags -> CmmType -> Bool\n-- True of GcPtrReg/NonGcReg of native word size\nisCmmWordType dflags ty = not (isFloatType ty)\n                       && typeWidth ty == wordWidth dflags\n\n-- This is for finding the types of foreign call arguments.  For a pointer\n-- argument, we always cast the argument to (void *), to avoid warnings from\n-- the C compiler.\nmachRepHintCType :: CmmType -> ForeignHint -> SDoc\nmachRepHintCType _   AddrHint   = text \"void *\"\nmachRepHintCType rep SignedHint = machRep_S_CType (typeWidth rep)\nmachRepHintCType rep _other     = machRepCType rep\n\nmachRepPtrCType :: CmmType -> SDoc\nmachRepPtrCType r\n = sdocWithDynFlags $ \\dflags ->\n   if isCmmWordType dflags r then text \"P_\"\n                             else machRepCType r <> char '*'\n\nmachRepCType :: CmmType -> SDoc\nmachRepCType ty | isFloatType ty = machRep_F_CType w\n                | otherwise      = machRep_U_CType w\n                where\n                  w = typeWidth ty\n\nmachRep_F_CType :: Width -> SDoc\nmachRep_F_CType W32 = text \"StgFloat\" -- ToDo: correct?\nmachRep_F_CType W64 = text \"StgDouble\"\nmachRep_F_CType _   = panic \"machRep_F_CType\"\n\nmachRep_U_CType :: Width -> SDoc\nmachRep_U_CType w\n = sdocWithDynFlags $ \\dflags ->\n   case w of\n   _ | w == wordWidth dflags -> text \"W_\"\n   W8  -> text \"StgWord8\"\n   W16 -> text \"StgWord16\"\n   W32 -> text \"StgWord32\"\n   W64 -> text \"StgWord64\"\n   _   -> panic \"machRep_U_CType\"\n\nmachRep_S_CType :: Width -> SDoc\nmachRep_S_CType w\n = sdocWithDynFlags $ \\dflags ->\n   case w of\n   _ | w == wordWidth dflags -> text \"I_\"\n   W8  -> text \"StgInt8\"\n   W16 -> text \"StgInt16\"\n   W32 -> text \"StgInt32\"\n   W64 -> text \"StgInt64\"\n   _   -> panic \"machRep_S_CType\"\n\n\n-- ---------------------------------------------------------------------\n-- print strings as valid C strings\n\npprStringInCStyle :: ByteString -> SDoc\npprStringInCStyle s = doubleQuotes (text (concatMap charToC (BS.unpack s)))\n\n-- ---------------------------------------------------------------------------\n-- Initialising static objects with floating-point numbers.  We can't\n-- just emit the floating point number, because C will cast it to an int\n-- by rounding it.  We want the actual bit-representation of the float.\n--\n-- Consider a concrete C example:\n--    double d = 2.5e-10;\n--    float f  = 2.5e-10f;\n--\n--    int * i2 = &d;      printf (\"i2: %08X %08X\\n\", i2[0], i2[1]);\n--    long long * l = &d; printf (\" l: %016llX\\n\",   l[0]);\n--    int * i = &f;       printf (\" i: %08X\\n\",      i[0]);\n-- Result on 64-bit LE (x86_64):\n--     i2: E826D695 3DF12E0B\n--      l: 3DF12E0BE826D695\n--      i: 2F89705F\n-- Result on 32-bit BE (m68k):\n--     i2: 3DF12E0B E826D695\n--      l: 3DF12E0BE826D695\n--      i: 2F89705F\n--\n-- The trick here is to notice that binary representation does not\n-- change much: only Word32 values get swapped on LE hosts / targets.\n\n-- This is a hack to turn the floating point numbers into ints that we\n-- can safely initialise to static locations.\n\ncastFloatToWord32Array :: STUArray s Int Float -> ST s (STUArray s Int Word32)\ncastFloatToWord32Array = U.castSTUArray\n\ncastDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)\ncastDoubleToWord64Array = U.castSTUArray\n\nfloatToWord :: DynFlags -> Rational -> CmmLit\nfloatToWord dflags r\n  = runST (do\n        arr <- newArray_ ((0::Int),0)\n        writeArray arr 0 (fromRational r)\n        arr' <- castFloatToWord32Array arr\n        w32 <- readArray arr' 0\n        return (CmmInt (toInteger w32 `shiftL` wo) (wordWidth dflags))\n    )\n    where wo | wordWidth dflags == W64\n             , wORDS_BIGENDIAN dflags    = 32\n             | otherwise                 = 0\n\nfloatPairToWord :: DynFlags -> Rational -> Rational -> CmmLit\nfloatPairToWord dflags r1 r2\n  = runST (do\n        arr <- newArray_ ((0::Int),1)\n        writeArray arr 0 (fromRational r1)\n        writeArray arr 1 (fromRational r2)\n        arr' <- castFloatToWord32Array arr\n        w32_1 <- readArray arr' 0\n        w32_2 <- readArray arr' 1\n        return (pprWord32Pair w32_1 w32_2)\n    )\n    where pprWord32Pair w32_1 w32_2\n              | wORDS_BIGENDIAN dflags =\n                  CmmInt ((shiftL i1 32) .|. i2) W64\n              | otherwise =\n                  CmmInt ((shiftL i2 32) .|. i1) W64\n              where i1 = toInteger w32_1\n                    i2 = toInteger w32_2\n\ndoubleToWords :: DynFlags -> Rational -> [CmmLit]\ndoubleToWords dflags r\n  = runST (do\n        arr <- newArray_ ((0::Int),1)\n        writeArray arr 0 (fromRational r)\n        arr' <- castDoubleToWord64Array arr\n        w64 <- readArray arr' 0\n        return (pprWord64 w64)\n    )\n    where targetWidth = wordWidth dflags\n          targetBE    = wORDS_BIGENDIAN dflags\n          pprWord64 w64\n              | targetWidth == W64 =\n                  [ CmmInt (toInteger w64) targetWidth ]\n              | targetWidth == W32 =\n                  [ CmmInt (toInteger targetW1) targetWidth\n                  , CmmInt (toInteger targetW2) targetWidth\n                  ]\n              | otherwise = panic \"doubleToWords.pprWord64\"\n              where (targetW1, targetW2)\n                        | targetBE  = (wHi, wLo)\n                        | otherwise = (wLo, wHi)\n                    wHi = w64 `shiftR` 32\n                    wLo = w64 .&. 0xFFFFffff\n\n-- ---------------------------------------------------------------------------\n-- Utils\n\nwordShift :: DynFlags -> Int\nwordShift dflags = widthInLog (wordWidth dflags)\n\ncommafy :: [SDoc] -> SDoc\ncommafy xs = hsep $ punctuate comma xs\n\n-- Print in C hex format: 0x13fa\npprHexVal :: Integer -> Width -> SDoc\npprHexVal w rep\n  | w < 0     = parens (char '-' <>\n                    text \"0x\" <> intToDoc (-w) <> repsuffix rep)\n  | otherwise =     text \"0x\" <> intToDoc   w  <> repsuffix rep\n  where\n        -- type suffix for literals:\n        -- Integer literals are unsigned in Cmm/C.  We explicitly cast to\n        -- signed values for doing signed operations, but at all other\n        -- times values are unsigned.  This also helps eliminate occasional\n        -- warnings about integer overflow from gcc.\n\n      repsuffix W64 = sdocWithDynFlags $ \\dflags ->\n               if cINT_SIZE       dflags == 8 then char 'U'\n          else if cLONG_SIZE      dflags == 8 then text \"UL\"\n          else if cLONG_LONG_SIZE dflags == 8 then text \"ULL\"\n          else panic \"pprHexVal: Can't find a 64-bit type\"\n      repsuffix _ = char 'U'\n\n      intToDoc :: Integer -> SDoc\n      intToDoc i = case truncInt i of\n                       0 -> char '0'\n                       v -> go v\n\n      -- We need to truncate value as Cmm backend does not drop\n      -- redundant bits to ease handling of negative values.\n      -- Thus the following Cmm code on 64-bit arch, like amd64:\n      --     CInt v;\n      --     v = {something};\n      --     if (v == %lobits32(-1)) { ...\n      -- leads to the following C code:\n      --     StgWord64 v = (StgWord32)({something});\n      --     if (v == 0xFFFFffffFFFFffffU) { ...\n      -- Such code is incorrect as it promotes both operands to StgWord64\n      -- and the whole condition is always false.\n      truncInt :: Integer -> Integer\n      truncInt i =\n          case rep of\n              W8  -> i `rem` (2^(8 :: Int))\n              W16 -> i `rem` (2^(16 :: Int))\n              W32 -> i `rem` (2^(32 :: Int))\n              W64 -> i `rem` (2^(64 :: Int))\n              _   -> panic (\"pprHexVal/truncInt: C backend can't encode \"\n                            ++ show rep ++ \" literals\")\n\n      go 0 = empty\n      go w' = go q <> dig\n           where\n             (q,r) = w' `quotRem` 16\n             dig | r < 10    = char (chr (fromInteger r + ord '0'))\n                 | otherwise = char (chr (fromInteger r - 10 + ord 'a'))\n", "num_lines": 1383}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts, FlexibleInstances #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n----------------------------------------------------------------------------\n--\n-- Pretty-printing of Cmm as (a superset of) C--\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n--\n-- This is where we walk over CmmNode emitting an external representation,\n-- suitable for parsing, in a syntax strongly reminiscent of C--. This\n-- is the \"External Core\" for the Cmm layer.\n--\n-- As such, this should be a well-defined syntax: we want it to look nice.\n-- Thus, we try wherever possible to use syntax defined in [1],\n-- \"The C-- Reference Manual\", http://www.cs.tufts.edu/~nr/c--/index.html. We\n-- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather\n-- than C--'s bits8 .. bits64.\n--\n-- We try to ensure that all information available in the abstract\n-- syntax is reproduced, or reproducible, in the concrete syntax.\n-- Data that is not in printed out can be reconstructed according to\n-- conventions used in the pretty printer. There are at least two such\n-- cases:\n--      1) if a value has wordRep type, the type is not appended in the\n--      output.\n--      2) MachOps that operate over wordRep type are printed in a\n--      C-style, rather than as their internal MachRep name.\n--\n-- These conventions produce much more readable Cmm output.\n--\n-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs\n\nmodule PprCmm\n  ( module PprCmmDecl\n  , module PprCmmExpr\n  )\nwhere\n\nimport GhcPrelude hiding (succ)\n\nimport BlockId ()\nimport CLabel\nimport Cmm\nimport CmmUtils\nimport CmmSwitch\nimport DynFlags\nimport FastString\nimport Outputable\nimport PprCmmDecl\nimport PprCmmExpr\nimport Util\nimport PprCore ()\n\nimport BasicTypes\nimport Hoopl.Block\nimport Hoopl.Graph\n\n-------------------------------------------------\n-- Outputable instances\n\ninstance Outputable CmmStackInfo where\n    ppr = pprStackInfo\n\ninstance Outputable CmmTopInfo where\n    ppr = pprTopInfo\n\n\ninstance Outputable (CmmNode e x) where\n    ppr = pprNode\n\ninstance Outputable Convention where\n    ppr = pprConvention\n\ninstance Outputable ForeignConvention where\n    ppr = pprForeignConvention\n\ninstance Outputable ForeignTarget where\n    ppr = pprForeignTarget\n\ninstance Outputable CmmReturnInfo where\n    ppr = pprReturnInfo\n\ninstance Outputable (Block CmmNode C C) where\n    ppr = pprBlock\ninstance Outputable (Block CmmNode C O) where\n    ppr = pprBlock\ninstance Outputable (Block CmmNode O C) where\n    ppr = pprBlock\ninstance Outputable (Block CmmNode O O) where\n    ppr = pprBlock\n\ninstance Outputable (Graph CmmNode e x) where\n    ppr = pprGraph\n\ninstance Outputable CmmGraph where\n    ppr = pprCmmGraph\n\n----------------------------------------------------------\n-- Outputting types Cmm contains\n\npprStackInfo :: CmmStackInfo -> SDoc\npprStackInfo (StackInfo {arg_space=arg_space, updfr_space=updfr_space}) =\n  text \"arg_space: \" <> ppr arg_space <+>\n  text \"updfr_space: \" <> ppr updfr_space\n\npprTopInfo :: CmmTopInfo -> SDoc\npprTopInfo (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =\n  vcat [text \"info_tbls: \" <> ppr info_tbl,\n        text \"stack_info: \" <> ppr stack_info]\n\n----------------------------------------------------------\n-- Outputting blocks and graphs\n\npprBlock :: IndexedCO x SDoc SDoc ~ SDoc\n         => Block CmmNode e x -> IndexedCO e SDoc SDoc\npprBlock block\n    = foldBlockNodesB3 ( ($$) . ppr\n                       , ($$) . (nest 4) . ppr\n                       , ($$) . (nest 4) . ppr\n                       )\n                       block\n                       empty\n\npprGraph :: Graph CmmNode e x -> SDoc\npprGraph GNil = empty\npprGraph (GUnit block) = ppr block\npprGraph (GMany entry body exit)\n   = text \"{\"\n  $$ nest 2 (pprMaybeO entry $$ (vcat $ map ppr $ bodyToBlockList body) $$ pprMaybeO exit)\n  $$ text \"}\"\n  where pprMaybeO :: Outputable (Block CmmNode e x)\n                  => MaybeO ex (Block CmmNode e x) -> SDoc\n        pprMaybeO NothingO = empty\n        pprMaybeO (JustO block) = ppr block\n\npprCmmGraph :: CmmGraph -> SDoc\npprCmmGraph g\n   = text \"{\" <> text \"offset\"\n  $$ nest 2 (vcat $ map ppr blocks)\n  $$ text \"}\"\n  where blocks = revPostorder g\n    -- revPostorder has the side-effect of discarding unreachable code,\n    -- so pretty-printed Cmm will omit any unreachable blocks.  This can\n    -- sometimes be confusing.\n\n---------------------------------------------\n-- Outputting CmmNode and types which it contains\n\npprConvention :: Convention -> SDoc\npprConvention (NativeNodeCall   {}) = text \"<native-node-call-convention>\"\npprConvention (NativeDirectCall {}) = text \"<native-direct-call-convention>\"\npprConvention (NativeReturn {})     = text \"<native-ret-convention>\"\npprConvention  Slow                 = text \"<slow-convention>\"\npprConvention  GC                   = text \"<gc-convention>\"\n\npprForeignConvention :: ForeignConvention -> SDoc\npprForeignConvention (ForeignConvention c args res ret) =\n          doubleQuotes (ppr c) <+> text \"arg hints: \" <+> ppr args <+> text \" result hints: \" <+> ppr res <+> ppr ret\n\npprReturnInfo :: CmmReturnInfo -> SDoc\npprReturnInfo CmmMayReturn = empty\npprReturnInfo CmmNeverReturns = text \"never returns\"\n\npprForeignTarget :: ForeignTarget -> SDoc\npprForeignTarget (ForeignTarget fn c) = ppr c <+> ppr_target fn\n  where\n        ppr_target :: CmmExpr -> SDoc\n        ppr_target t@(CmmLit _) = ppr t\n        ppr_target fn'          = parens (ppr fn')\n\npprForeignTarget (PrimTarget op)\n -- HACK: We're just using a ForeignLabel to get this printed, the label\n --       might not really be foreign.\n = ppr\n               (CmmLabel (mkForeignLabel\n                         (mkFastString (show op))\n                         Nothing ForeignLabelInThisPackage IsFunction))\n\npprNode :: CmmNode e x -> SDoc\npprNode node = pp_node <+> pp_debug\n  where\n    pp_node :: SDoc\n    pp_node = sdocWithDynFlags $ \\dflags -> case node of\n      -- label:\n      CmmEntry id tscope -> lbl <> colon <+>\n         (sdocWithDynFlags $ \\dflags ->\n           ppUnless (gopt Opt_SuppressTicks dflags) (text \"//\" <+> ppr tscope))\n          where\n            lbl = if gopt Opt_SuppressUniques dflags\n                then text \"_lbl_\"\n                else ppr id\n\n      -- // text\n      CmmComment s -> text \"//\" <+> ftext s\n\n      -- //tick bla<...>\n      CmmTick t -> ppUnless (gopt Opt_SuppressTicks dflags) $\n                   text \"//tick\" <+> ppr t\n\n      -- unwind reg = expr;\n      CmmUnwind regs ->\n          text \"unwind \"\n          <> commafy (map (\\(r,e) -> ppr r <+> char '=' <+> ppr e) regs) <> semi\n\n      -- reg = expr;\n      CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi\n\n      -- rep[lv] = expr;\n      CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi\n          where\n            rep = sdocWithDynFlags $ \\dflags ->\n                  ppr ( cmmExprType dflags expr )\n\n      -- call \"ccall\" foo(x, y)[r1, r2];\n      -- ToDo ppr volatile\n      CmmUnsafeForeignCall target results args ->\n          hsep [ ppUnless (null results) $\n                    parens (commafy $ map ppr results) <+> equals,\n                 text \"call\",\n                 ppr target <> parens (commafy $ map ppr args) <> semi]\n\n      -- goto label;\n      CmmBranch ident -> text \"goto\" <+> ppr ident <> semi\n\n      -- if (expr) goto t; else goto f;\n      CmmCondBranch expr t f l ->\n          hsep [ text \"if\"\n               , parens(ppr expr)\n               , case l of\n                   Nothing -> empty\n                   Just b -> parens (text \"likely:\" <+> ppr b)\n               , text \"goto\"\n               , ppr t <> semi\n               , text \"else goto\"\n               , ppr f <> semi\n               ]\n\n      CmmSwitch expr ids ->\n          hang (hsep [ text \"switch\"\n                     , range\n                     , if isTrivialCmmExpr expr\n                       then ppr expr\n                       else parens (ppr expr)\n                     , text \"{\"\n                     ])\n             4 (vcat (map ppCase cases) $$ def) $$ rbrace\n          where\n            (cases, mbdef) = switchTargetsFallThrough ids\n            ppCase (is,l) = hsep\n                            [ text \"case\"\n                            , commafy $ map integer is\n                            , text \": goto\"\n                            , ppr l <> semi\n                            ]\n            def | Just l <- mbdef = hsep\n                            [ text \"default:\"\n                            , braces (text \"goto\" <+> ppr l <> semi)\n                            ]\n                | otherwise = empty\n\n            range = brackets $ hsep [integer lo, text \"..\", integer hi]\n              where (lo,hi) = switchTargetsRange ids\n\n      CmmCall tgt k regs out res updfr_off ->\n          hcat [ text \"call\", space\n               , pprFun tgt, parens (interpp'SP regs), space\n               , returns <+>\n                 text \"args: \" <> ppr out <> comma <+>\n                 text \"res: \" <> ppr res <> comma <+>\n                 text \"upd: \" <> ppr updfr_off\n               , semi ]\n          where pprFun f@(CmmLit _) = ppr f\n                pprFun f = parens (ppr f)\n\n                returns\n                  | Just r <- k = text \"returns to\" <+> ppr r <> comma\n                  | otherwise   = empty\n\n      CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->\n          hcat $ if i then [text \"interruptible\", space] else [] ++\n               [ text \"foreign call\", space\n               , ppr t, text \"(...)\", space\n               , text \"returns to\" <+> ppr s\n                    <+> text \"args:\" <+> parens (ppr as)\n                    <+> text \"ress:\" <+> parens (ppr rs)\n               , text \"ret_args:\" <+> ppr a\n               , text \"ret_off:\" <+> ppr u\n               , semi ]\n\n    pp_debug :: SDoc\n    pp_debug =\n      if not debugIsOn then empty\n      else case node of\n             CmmEntry {}             -> empty -- Looks terrible with text \"  // CmmEntry\"\n             CmmComment {}           -> empty -- Looks also terrible with text \"  // CmmComment\"\n             CmmTick {}              -> empty\n             CmmUnwind {}            -> text \"  // CmmUnwind\"\n             CmmAssign {}            -> text \"  // CmmAssign\"\n             CmmStore {}             -> text \"  // CmmStore\"\n             CmmUnsafeForeignCall {} -> text \"  // CmmUnsafeForeignCall\"\n             CmmBranch {}            -> text \"  // CmmBranch\"\n             CmmCondBranch {}        -> text \"  // CmmCondBranch\"\n             CmmSwitch {}            -> text \"  // CmmSwitch\"\n             CmmCall {}              -> text \"  // CmmCall\"\n             CmmForeignCall {}       -> text \"  // CmmForeignCall\"\n\n    commafy :: [SDoc] -> SDoc\n    commafy xs = hsep $ punctuate comma xs\n", "num_lines": 312}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "----------------------------------------------------------------------------\n--\n-- Pretty-printing of common Cmm types\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\n--\n-- This is where we walk over Cmm emitting an external representation,\n-- suitable for parsing, in a syntax strongly reminiscent of C--. This\n-- is the \"External Core\" for the Cmm layer.\n--\n-- As such, this should be a well-defined syntax: we want it to look nice.\n-- Thus, we try wherever possible to use syntax defined in [1],\n-- \"The C-- Reference Manual\", http://www.cs.tufts.edu/~nr/c--/index.html. We\n-- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather\n-- than C--'s bits8 .. bits64.\n--\n-- We try to ensure that all information available in the abstract\n-- syntax is reproduced, or reproducible, in the concrete syntax.\n-- Data that is not in printed out can be reconstructed according to\n-- conventions used in the pretty printer. There are at least two such\n-- cases:\n--      1) if a value has wordRep type, the type is not appended in the\n--      output.\n--      2) MachOps that operate over wordRep type are printed in a\n--      C-style, rather than as their internal MachRep name.\n--\n-- These conventions produce much more readable Cmm output.\n--\n-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs\n--\n\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule PprCmmDecl\n    ( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic\n    )\nwhere\n\nimport GhcPrelude\n\nimport PprCmmExpr\nimport Cmm\n\nimport DynFlags\nimport Outputable\nimport FastString\n\nimport Data.List\nimport System.IO\n\nimport qualified Data.ByteString as BS\n\n\npprCmms :: (Outputable info, Outputable g)\n        => [GenCmmGroup CmmStatics info g] -> SDoc\npprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))\n        where\n          separator = space $$ text \"-------------------\" $$ space\n\nwriteCmms :: (Outputable info, Outputable g)\n          => DynFlags -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()\nwriteCmms dflags handle cmms = printForC dflags handle (pprCmms cmms)\n\n-----------------------------------------------------------------------------\n\ninstance (Outputable d, Outputable info, Outputable i)\n      => Outputable (GenCmmDecl d info i) where\n    ppr t = pprTop t\n\ninstance Outputable CmmStatics where\n    ppr = pprStatics\n\ninstance Outputable CmmStatic where\n    ppr = pprStatic\n\ninstance Outputable CmmInfoTable where\n    ppr = pprInfoTable\n\n\n-----------------------------------------------------------------------------\n\npprCmmGroup :: (Outputable d, Outputable info, Outputable g)\n            => GenCmmGroup d info g -> SDoc\npprCmmGroup tops\n    = vcat $ intersperse blankLine $ map pprTop tops\n\n-- --------------------------------------------------------------------------\n-- Top level `procedure' blocks.\n--\npprTop :: (Outputable d, Outputable info, Outputable i)\n       => GenCmmDecl d info i -> SDoc\n\npprTop (CmmProc info lbl live graph)\n\n  = vcat [ ppr lbl <> lparen <> rparen <+> text \"// \" <+> ppr live\n         , nest 8 $ lbrace <+> ppr info $$ rbrace\n         , nest 4 $ ppr graph\n         , rbrace ]\n\n-- --------------------------------------------------------------------------\n-- We follow [1], 4.5\n--\n--      section \"data\" { ... }\n--\npprTop (CmmData section ds) =\n    (hang (pprSection section <+> lbrace) 4 (ppr ds))\n    $$ rbrace\n\n-- --------------------------------------------------------------------------\n-- Info tables.\n\npprInfoTable :: CmmInfoTable -> SDoc\npprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep\n                           , cit_prof = prof_info\n                           , cit_srt = srt })\n  = vcat [ text \"label: \" <> ppr lbl\n         , text \"rep: \" <> ppr rep\n         , case prof_info of\n             NoProfilingInfo -> empty\n             ProfilingInfo ct cd ->\n               vcat [ text \"type: \" <> text (show (BS.unpack ct))\n                    , text \"desc: \" <> text (show (BS.unpack cd)) ]\n         , text \"srt: \" <> ppr srt ]\n\ninstance Outputable ForeignHint where\n  ppr NoHint     = empty\n  ppr SignedHint = quotes(text \"signed\")\n--  ppr AddrHint   = quotes(text \"address\")\n-- Temp Jan08\n  ppr AddrHint   = (text \"PtrHint\")\n\n-- --------------------------------------------------------------------------\n-- Static data.\n--      Strings are printed as C strings, and we print them as I8[],\n--      following C--\n--\npprStatics :: CmmStatics -> SDoc\npprStatics (Statics lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)\n\npprStatic :: CmmStatic -> SDoc\npprStatic s = case s of\n    CmmStaticLit lit   -> nest 4 $ text \"const\" <+> pprLit lit <> semi\n    CmmUninitialised i -> nest 4 $ text \"I8\" <> brackets (int i)\n    CmmString s'       -> nest 4 $ text \"I8[]\" <+> text (show s')\n\n-- --------------------------------------------------------------------------\n-- data sections\n--\npprSection :: Section -> SDoc\npprSection (Section t suffix) =\n  section <+> doubleQuotes (pprSectionType t <+> char '.' <+> ppr suffix)\n  where\n    section = text \"section\"\n\npprSectionType :: SectionType -> SDoc\npprSectionType s = doubleQuotes (ptext t)\n where\n  t = case s of\n    Text              -> sLit \"text\"\n    Data              -> sLit \"data\"\n    ReadOnlyData      -> sLit \"readonly\"\n    ReadOnlyData16    -> sLit \"readonly16\"\n    RelocatableReadOnlyData\n                      -> sLit \"relreadonly\"\n    UninitialisedData -> sLit \"uninitialised\"\n    CString           -> sLit \"cstring\"\n    OtherSection s'   -> sLit s' -- Not actually a literal though.\n", "num_lines": 170}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "----------------------------------------------------------------------------\n--\n-- Pretty-printing of common Cmm types\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\n--\n-- This is where we walk over Cmm emitting an external representation,\n-- suitable for parsing, in a syntax strongly reminiscent of C--. This\n-- is the \"External Core\" for the Cmm layer.\n--\n-- As such, this should be a well-defined syntax: we want it to look nice.\n-- Thus, we try wherever possible to use syntax defined in [1],\n-- \"The C-- Reference Manual\", http://www.cs.tufts.edu/~nr/c--/index.html. We\n-- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather\n-- than C--'s bits8 .. bits64.\n--\n-- We try to ensure that all information available in the abstract\n-- syntax is reproduced, or reproducible, in the concrete syntax.\n-- Data that is not in printed out can be reconstructed according to\n-- conventions used in the pretty printer. There are at least two such\n-- cases:\n--      1) if a value has wordRep type, the type is not appended in the\n--      output.\n--      2) MachOps that operate over wordRep type are printed in a\n--      C-style, rather than as their internal MachRep name.\n--\n-- These conventions produce much more readable Cmm output.\n--\n-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs\n--\n\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule PprCmmExpr\n    ( pprExpr, pprLit\n    )\nwhere\n\nimport GhcPrelude\n\nimport CmmExpr\n\nimport Outputable\nimport DynFlags\n\nimport Data.Maybe\nimport Numeric ( fromRat )\n\n-----------------------------------------------------------------------------\n\ninstance Outputable CmmExpr where\n    ppr e = pprExpr e\n\ninstance Outputable CmmReg where\n    ppr e = pprReg e\n\ninstance Outputable CmmLit where\n    ppr l = pprLit l\n\ninstance Outputable LocalReg where\n    ppr e = pprLocalReg e\n\ninstance Outputable Area where\n    ppr e = pprArea e\n\ninstance Outputable GlobalReg where\n    ppr e = pprGlobalReg e\n\n-- --------------------------------------------------------------------------\n-- Expressions\n--\n\npprExpr :: CmmExpr -> SDoc\npprExpr e\n    = sdocWithDynFlags $ \\dflags ->\n      case e of\n        CmmRegOff reg i ->\n                pprExpr (CmmMachOp (MO_Add rep)\n                           [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])\n                where rep = typeWidth (cmmRegType dflags reg)\n        CmmLit lit -> pprLit lit\n        _other     -> pprExpr1 e\n\n-- Here's the precedence table from CmmParse.y:\n-- %nonassoc '>=' '>' '<=' '<' '!=' '=='\n-- %left '|'\n-- %left '^'\n-- %left '&'\n-- %left '>>' '<<'\n-- %left '-' '+'\n-- %left '/' '*' '%'\n-- %right '~'\n\n-- We just cope with the common operators for now, the rest will get\n-- a default conservative behaviour.\n\n-- %nonassoc '>=' '>' '<=' '<' '!=' '=='\npprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc\npprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op\n   = pprExpr7 x <+> doc <+> pprExpr7 y\npprExpr1 e = pprExpr7 e\n\ninfixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc\n\ninfixMachOp1 (MO_Eq     _) = Just (text \"==\")\ninfixMachOp1 (MO_Ne     _) = Just (text \"!=\")\ninfixMachOp1 (MO_Shl    _) = Just (text \"<<\")\ninfixMachOp1 (MO_U_Shr  _) = Just (text \">>\")\ninfixMachOp1 (MO_U_Ge   _) = Just (text \">=\")\ninfixMachOp1 (MO_U_Le   _) = Just (text \"<=\")\ninfixMachOp1 (MO_U_Gt   _) = Just (char '>')\ninfixMachOp1 (MO_U_Lt   _) = Just (char '<')\ninfixMachOp1 _             = Nothing\n\n-- %left '-' '+'\npprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0\n   = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])\npprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op\n   = pprExpr7 x <+> doc <+> pprExpr8 y\npprExpr7 e = pprExpr8 e\n\ninfixMachOp7 (MO_Add _)  = Just (char '+')\ninfixMachOp7 (MO_Sub _)  = Just (char '-')\ninfixMachOp7 _           = Nothing\n\n-- %left '/' '*' '%'\npprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op\n   = pprExpr8 x <+> doc <+> pprExpr9 y\npprExpr8 e = pprExpr9 e\n\ninfixMachOp8 (MO_U_Quot _) = Just (char '/')\ninfixMachOp8 (MO_Mul _)    = Just (char '*')\ninfixMachOp8 (MO_U_Rem _)  = Just (char '%')\ninfixMachOp8 _             = Nothing\n\npprExpr9 :: CmmExpr -> SDoc\npprExpr9 e =\n   case e of\n        CmmLit    lit       -> pprLit1 lit\n        CmmLoad   expr rep  -> ppr rep <> brackets (ppr expr)\n        CmmReg    reg       -> ppr reg\n        CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)\n        CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)\n        CmmMachOp mop args  -> genMachOp mop args\n\ngenMachOp :: MachOp -> [CmmExpr] -> SDoc\ngenMachOp mop args\n   | Just doc <- infixMachOp mop = case args of\n        -- dyadic\n        [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y\n\n        -- unary\n        [x]   -> doc <> pprExpr9 x\n\n        _     -> pprTrace \"PprCmm.genMachOp: machop with strange number of args\"\n                          (pprMachOp mop <+>\n                            parens (hcat $ punctuate comma (map pprExpr args)))\n                          empty\n\n   | isJust (infixMachOp1 mop)\n   || isJust (infixMachOp7 mop)\n   || isJust (infixMachOp8 mop)  = parens (pprExpr (CmmMachOp mop args))\n\n   | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))\n        where ppr_op = text (map (\\c -> if c == ' ' then '_' else c)\n                                 (show mop))\n                -- replace spaces in (show mop) with underscores,\n\n--\n-- Unsigned ops on the word size of the machine get nice symbols.\n-- All else get dumped in their ugly format.\n--\ninfixMachOp :: MachOp -> Maybe SDoc\ninfixMachOp mop\n        = case mop of\n            MO_And    _ -> Just $ char '&'\n            MO_Or     _ -> Just $ char '|'\n            MO_Xor    _ -> Just $ char '^'\n            MO_Not    _ -> Just $ char '~'\n            MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)\n            _ -> Nothing\n\n-- --------------------------------------------------------------------------\n-- Literals.\n--  To minimise line noise we adopt the convention that if the literal\n--  has the natural machine word size, we do not append the type\n--\npprLit :: CmmLit -> SDoc\npprLit lit = sdocWithDynFlags $ \\dflags ->\n             case lit of\n    CmmInt i rep ->\n        hcat [ (if i < 0 then parens else id)(integer i)\n             , ppUnless (rep == wordWidth dflags) $\n               space <> dcolon <+> ppr rep ]\n\n    CmmFloat f rep     -> hsep [ double (fromRat f), dcolon, ppr rep ]\n    CmmVec lits        -> char '<' <> commafy (map pprLit lits) <> char '>'\n    CmmLabel clbl      -> ppr clbl\n    CmmLabelOff clbl i -> ppr clbl <> ppr_offset i\n    CmmLabelDiffOff clbl1 clbl2 i _ -> ppr clbl1 <> char '-'\n                                  <> ppr clbl2 <> ppr_offset i\n    CmmBlock id        -> ppr id\n    CmmHighStackMark -> text \"<highSp>\"\n\npprLit1 :: CmmLit -> SDoc\npprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)\npprLit1 lit                  = pprLit lit\n\nppr_offset :: Int -> SDoc\nppr_offset i\n    | i==0      = empty\n    | i>=0      = char '+' <> int i\n    | otherwise = char '-' <> int (-i)\n\n-- --------------------------------------------------------------------------\n-- Registers, whether local (temps) or global\n--\npprReg :: CmmReg -> SDoc\npprReg r\n    = case r of\n        CmmLocal  local  -> pprLocalReg  local\n        CmmGlobal global -> pprGlobalReg global\n\n--\n-- We only print the type of the local reg if it isn't wordRep\n--\npprLocalReg :: LocalReg -> SDoc\npprLocalReg (LocalReg uniq rep) = sdocWithDynFlags $ \\dflags ->\n--   = ppr rep <> char '_' <> ppr uniq\n-- Temp Jan08\n    char '_' <> pprUnique dflags uniq <>\n       (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08               -- sigh\n                    then dcolon <> ptr <> ppr rep\n                    else dcolon <> ptr <> ppr rep)\n   where\n     pprUnique dflags unique =\n        if gopt Opt_SuppressUniques dflags\n            then text \"_locVar_\"\n            else ppr unique\n     ptr = empty\n         --if isGcPtrType rep\n         --      then doubleQuotes (text \"ptr\")\n         --      else empty\n\n-- Stack areas\npprArea :: Area -> SDoc\npprArea Old        = text \"old\"\npprArea (Young id) = hcat [ text \"young<\", ppr id, text \">\" ]\n\n-- needs to be kept in syn with CmmExpr.hs.GlobalReg\n--\npprGlobalReg :: GlobalReg -> SDoc\npprGlobalReg gr\n    = case gr of\n        VanillaReg n _ -> char 'R' <> int n\n-- Temp Jan08\n--        VanillaReg n VNonGcPtr -> char 'R' <> int n\n--        VanillaReg n VGcPtr    -> char 'P' <> int n\n        FloatReg   n   -> char 'F' <> int n\n        DoubleReg  n   -> char 'D' <> int n\n        LongReg    n   -> char 'L' <> int n\n        XmmReg     n   -> text \"XMM\" <> int n\n        YmmReg     n   -> text \"YMM\" <> int n\n        ZmmReg     n   -> text \"ZMM\" <> int n\n        Sp             -> text \"Sp\"\n        SpLim          -> text \"SpLim\"\n        Hp             -> text \"Hp\"\n        HpLim          -> text \"HpLim\"\n        MachSp         -> text \"MachSp\"\n        UnwindReturnReg-> text \"UnwindReturnReg\"\n        CCCS           -> text \"CCCS\"\n        CurrentTSO     -> text \"CurrentTSO\"\n        CurrentNursery -> text \"CurrentNursery\"\n        HpAlloc        -> text \"HpAlloc\"\n        EagerBlackholeInfo -> text \"stg_EAGER_BLACKHOLE_info\"\n        GCEnter1       -> text \"stg_gc_enter_1\"\n        GCFun          -> text \"stg_gc_fun\"\n        BaseReg        -> text \"BaseReg\"\n        PicBaseReg     -> text \"PicBaseReg\"\n\n-----------------------------------------------------------------------------\n\ncommafy :: [SDoc] -> SDoc\ncommafy xs = fsep $ punctuate comma xs\n", "num_lines": 287}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n--\n-- Storage manager representation of closures\n\n{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}\n\nmodule SMRep (\n        -- * Words and bytes\n        WordOff, ByteOff,\n        wordsToBytes, bytesToWordsRoundUp,\n        roundUpToWords, roundUpTo,\n\n        StgWord, fromStgWord, toStgWord,\n        StgHalfWord, fromStgHalfWord, toStgHalfWord,\n        hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,\n\n        -- * Closure repesentation\n        SMRep(..), -- CmmInfo sees the rep; no one else does\n        IsStatic,\n        ClosureTypeInfo(..), ArgDescr(..), Liveness,\n        ConstrDescription,\n\n        -- ** Construction\n        mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,\n        smallArrPtrsRep, arrWordsRep,\n\n        -- ** Predicates\n        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,\n        isStackRep,\n\n        -- ** Size-related things\n        heapClosureSizeW,\n        fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,\n        arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,\n        smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,\n        fixedHdrSize,\n\n        -- ** RTS closure types\n        rtsClosureType, rET_SMALL, rET_BIG,\n        aRG_GEN, aRG_GEN_BIG,\n\n        -- ** Arrays\n        card, cardRoundUp, cardTableSizeB, cardTableSizeW\n    ) where\n\nimport GhcPrelude\n\nimport BasicTypes( ConTagZ )\nimport DynFlags\nimport Outputable\nimport Platform\nimport FastString\n\nimport Data.Word\nimport Data.Bits\nimport Data.ByteString (ByteString)\n\n{-\n************************************************************************\n*                                                                      *\n                Words and bytes\n*                                                                      *\n************************************************************************\n-}\n\n-- | Word offset, or word count\ntype WordOff = Int\n\n-- | Byte offset, or byte count\ntype ByteOff = Int\n\n-- | Round up the given byte count to the next byte count that's a\n-- multiple of the machine's word size.\nroundUpToWords :: DynFlags -> ByteOff -> ByteOff\nroundUpToWords dflags n = roundUpTo n (wORD_SIZE dflags)\n\n-- | Round up @base@ to a multiple of @size@.\nroundUpTo :: ByteOff -> ByteOff -> ByteOff\nroundUpTo base size = (base + (size - 1)) .&. (complement (size - 1))\n\n-- | Convert the given number of words to a number of bytes.\n--\n-- This function morally has type @WordOff -> ByteOff@, but uses @Num\n-- a@ to allow for overloading.\nwordsToBytes :: Num a => DynFlags -> a -> a\nwordsToBytes dflags n = fromIntegral (wORD_SIZE dflags) * n\n{-# SPECIALIZE wordsToBytes :: DynFlags -> Int -> Int #-}\n{-# SPECIALIZE wordsToBytes :: DynFlags -> Word -> Word #-}\n{-# SPECIALIZE wordsToBytes :: DynFlags -> Integer -> Integer #-}\n\n-- | First round the given byte count up to a multiple of the\n-- machine's word size and then convert the result to words.\nbytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff\nbytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size\n where word_size = wORD_SIZE dflags\n-- StgWord is a type representing an StgWord on the target platform.\n-- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform\nnewtype StgWord = StgWord Word64\n    deriving (Eq, Bits)\n\nfromStgWord :: StgWord -> Integer\nfromStgWord (StgWord i) = toInteger i\n\ntoStgWord :: DynFlags -> Integer -> StgWord\ntoStgWord dflags i\n    = case platformWordSize (targetPlatform dflags) of\n      -- These conversions mean that things like toStgWord (-1)\n      -- do the right thing\n      4 -> StgWord (fromIntegral (fromInteger i :: Word32))\n      8 -> StgWord (fromInteger i :: Word64)\n      w -> panic (\"toStgWord: Unknown platformWordSize: \" ++ show w)\n\ninstance Outputable StgWord where\n    ppr (StgWord i) = integer (toInteger i)\n\n--\n\n-- A Word32 is large enough to hold half a Word for either a 32bit or\n-- 64bit platform\nnewtype StgHalfWord = StgHalfWord Word32\n    deriving Eq\n\nfromStgHalfWord :: StgHalfWord -> Integer\nfromStgHalfWord (StgHalfWord w) = toInteger w\n\ntoStgHalfWord :: DynFlags -> Integer -> StgHalfWord\ntoStgHalfWord dflags i\n    = case platformWordSize (targetPlatform dflags) of\n      -- These conversions mean that things like toStgHalfWord (-1)\n      -- do the right thing\n      4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))\n      8 -> StgHalfWord (fromInteger i :: Word32)\n      w -> panic (\"toStgHalfWord: Unknown platformWordSize: \" ++ show w)\n\ninstance Outputable StgHalfWord where\n    ppr (StgHalfWord w) = integer (toInteger w)\n\nhALF_WORD_SIZE :: DynFlags -> ByteOff\nhALF_WORD_SIZE dflags = platformWordSize (targetPlatform dflags) `shiftR` 1\nhALF_WORD_SIZE_IN_BITS :: DynFlags -> Int\nhALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A description of the layout of a closure.  Corresponds directly\n-- to the closure types in includes/rts/storage/ClosureTypes.h.\ndata SMRep\n  = HeapRep              -- GC routines consult sizes in info tbl\n        IsStatic\n        !WordOff         --  # ptr words\n        !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)\n        ClosureTypeInfo  -- type-specific info\n\n  | ArrayPtrsRep\n        !WordOff        -- # ptr words\n        !WordOff        -- # card table words\n\n  | SmallArrayPtrsRep\n        !WordOff        -- # ptr words\n\n  | ArrayWordsRep\n        !WordOff        -- # bytes expressed in words, rounded up\n\n  | StackRep            -- Stack frame (RET_SMALL or RET_BIG)\n        Liveness\n\n  | RTSRep              -- The RTS needs to declare info tables with specific\n        Int             -- type tags, so this form lets us override the default\n        SMRep           -- tag for an SMRep.\n\n-- | True <=> This is a static closure.  Affects how we garbage-collect it.\n-- Static closure have an extra static link field at the end.\n-- Constructors do not have a static variant; see Note [static constructors]\ntype IsStatic = Bool\n\n-- From an SMRep you can get to the closure type defined in\n-- includes/rts/storage/ClosureTypes.h. Described by the function\n-- rtsClosureType below.\n\ndata ClosureTypeInfo\n  = Constr        ConTagZ ConstrDescription\n  | Fun           FunArity ArgDescr\n  | Thunk\n  | ThunkSelector SelectorOffset\n  | BlackHole\n  | IndStatic\n\ntype ConstrDescription = ByteString -- result of dataConIdentity\ntype FunArity          = Int\ntype SelectorOffset    = Int\n\n-------------------------\n-- We represent liveness bitmaps as a Bitmap (whose internal\n-- representation really is a bitmap).  These are pinned onto case return\n-- vectors to indicate the state of the stack for the garbage collector.\n--\n-- In the compiled program, liveness bitmaps that fit inside a single\n-- word (StgWord) are stored as a single word, while larger bitmaps are\n-- stored as a pointer to an array of words.\n\ntype Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead\n                         --                    False <=> ptr\n\n-------------------------\n-- An ArgDescr describes the argument pattern of a function\n\ndata ArgDescr\n  = ArgSpec             -- Fits one of the standard patterns\n        !Int            -- RTS type identifier ARG_P, ARG_N, ...\n\n  | ArgGen              -- General case\n        Liveness        -- Details about the arguments\n\n\n-----------------------------------------------------------------------------\n-- Construction\n\nmkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo\n          -> SMRep\nmkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info\n  = HeapRep is_static\n            ptr_wds\n            (nonptr_wds + slop_wds)\n            cl_type_info\n  where\n     slop_wds\n      | is_static = 0\n      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))\n\n     hdr_size     = closureTypeHdrSize dflags cl_type_info\n     payload_size = ptr_wds + nonptr_wds\n\nmkRTSRep :: Int -> SMRep -> SMRep\nmkRTSRep = RTSRep\n\nmkStackRep :: [Bool] -> SMRep\nmkStackRep liveness = StackRep liveness\n\nblackHoleRep :: SMRep\nblackHoleRep = HeapRep False 0 0 BlackHole\n\nindStaticRep :: SMRep\nindStaticRep = HeapRep True 1 0 IndStatic\n\narrPtrsRep :: DynFlags -> WordOff -> SMRep\narrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)\n\nsmallArrPtrsRep :: WordOff -> SMRep\nsmallArrPtrsRep elems = SmallArrayPtrsRep elems\n\narrWordsRep :: DynFlags -> ByteOff -> SMRep\narrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)\n\n-----------------------------------------------------------------------------\n-- Predicates\n\nisStaticRep :: SMRep -> IsStatic\nisStaticRep (HeapRep is_static _ _ _) = is_static\nisStaticRep (RTSRep _ rep)            = isStaticRep rep\nisStaticRep _                         = False\n\nisStackRep :: SMRep -> Bool\nisStackRep StackRep{}     = True\nisStackRep (RTSRep _ rep) = isStackRep rep\nisStackRep _              = False\n\nisConRep :: SMRep -> Bool\nisConRep (HeapRep _ _ _ Constr{}) = True\nisConRep _                        = False\n\nisThunkRep :: SMRep -> Bool\nisThunkRep (HeapRep _ _ _ Thunk)           = True\nisThunkRep (HeapRep _ _ _ ThunkSelector{}) = True\nisThunkRep (HeapRep _ _ _ BlackHole)       = True\nisThunkRep (HeapRep _ _ _ IndStatic)       = True\nisThunkRep _                               = False\n\nisFunRep :: SMRep -> Bool\nisFunRep (HeapRep _ _ _ Fun{}) = True\nisFunRep _                     = False\n\nisStaticNoCafCon :: SMRep -> Bool\n-- This should line up exactly with CONSTR_NOCAF below\n-- See Note [Static NoCaf constructors]\nisStaticNoCafCon (HeapRep _ 0 _ Constr{}) = True\nisStaticNoCafCon _                        = False\n\n\n-----------------------------------------------------------------------------\n-- Size-related things\n\nfixedHdrSize :: DynFlags -> ByteOff\nfixedHdrSize dflags = wordsToBytes dflags (fixedHdrSizeW dflags)\n\n-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)\nfixedHdrSizeW :: DynFlags -> WordOff\nfixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags\n\n-- | Size of the profiling part of a closure header\n-- (StgProfHeader in includes/rts/storage/Closures.h)\nprofHdrSize  :: DynFlags -> WordOff\nprofHdrSize dflags\n | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags\n | otherwise                      = 0\n\n-- | The garbage collector requires that every closure is at least as\n--   big as this.\nminClosureSize :: DynFlags -> WordOff\nminClosureSize dflags = fixedHdrSizeW dflags + mIN_PAYLOAD_SIZE dflags\n\narrWordsHdrSize :: DynFlags -> ByteOff\narrWordsHdrSize dflags\n = fixedHdrSize dflags + sIZEOF_StgArrBytes_NoHdr dflags\n\narrWordsHdrSizeW :: DynFlags -> WordOff\narrWordsHdrSizeW dflags =\n    fixedHdrSizeW dflags +\n    (sIZEOF_StgArrBytes_NoHdr dflags `quot` wORD_SIZE dflags)\n\narrPtrsHdrSize :: DynFlags -> ByteOff\narrPtrsHdrSize dflags\n = fixedHdrSize dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags\n\narrPtrsHdrSizeW :: DynFlags -> WordOff\narrPtrsHdrSizeW dflags =\n    fixedHdrSizeW dflags +\n    (sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)\n\nsmallArrPtrsHdrSize :: DynFlags -> ByteOff\nsmallArrPtrsHdrSize dflags\n = fixedHdrSize dflags + sIZEOF_StgSmallMutArrPtrs_NoHdr dflags\n\nsmallArrPtrsHdrSizeW :: DynFlags -> WordOff\nsmallArrPtrsHdrSizeW dflags =\n    fixedHdrSizeW dflags +\n    (sIZEOF_StgSmallMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)\n\n-- Thunks have an extra header word on SMP, so the update doesn't\n-- splat the payload.\nthunkHdrSize :: DynFlags -> WordOff\nthunkHdrSize dflags = fixedHdrSizeW dflags + smp_hdr\n        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags\n\nhdrSize :: DynFlags -> SMRep -> ByteOff\nhdrSize dflags rep = wordsToBytes dflags (hdrSizeW dflags rep)\n\nhdrSizeW :: DynFlags -> SMRep -> WordOff\nhdrSizeW dflags (HeapRep _ _ _ ty)    = closureTypeHdrSize dflags ty\nhdrSizeW dflags (ArrayPtrsRep _ _)    = arrPtrsHdrSizeW dflags\nhdrSizeW dflags (SmallArrayPtrsRep _) = smallArrPtrsHdrSizeW dflags\nhdrSizeW dflags (ArrayWordsRep _)     = arrWordsHdrSizeW dflags\nhdrSizeW _ _                          = panic \"SMRep.hdrSizeW\"\n\nnonHdrSize :: DynFlags -> SMRep -> ByteOff\nnonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep)\n\nnonHdrSizeW :: SMRep -> WordOff\nnonHdrSizeW (HeapRep _ p np _) = p + np\nnonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct\nnonHdrSizeW (SmallArrayPtrsRep elems) = elems\nnonHdrSizeW (ArrayWordsRep words) = words\nnonHdrSizeW (StackRep bs)      = length bs\nnonHdrSizeW (RTSRep _ rep)     = nonHdrSizeW rep\n\n-- | The total size of the closure, in words.\nheapClosureSizeW :: DynFlags -> SMRep -> WordOff\nheapClosureSizeW dflags (HeapRep _ p np ty)\n = closureTypeHdrSize dflags ty + p + np\nheapClosureSizeW dflags (ArrayPtrsRep elems ct)\n = arrPtrsHdrSizeW dflags + elems + ct\nheapClosureSizeW dflags (SmallArrayPtrsRep elems)\n = smallArrPtrsHdrSizeW dflags + elems\nheapClosureSizeW dflags (ArrayWordsRep words)\n = arrWordsHdrSizeW dflags + words\nheapClosureSizeW _ _ = panic \"SMRep.heapClosureSize\"\n\nclosureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff\nclosureTypeHdrSize dflags ty = case ty of\n                  Thunk           -> thunkHdrSize dflags\n                  ThunkSelector{} -> thunkHdrSize dflags\n                  BlackHole       -> thunkHdrSize dflags\n                  IndStatic       -> thunkHdrSize dflags\n                  _               -> fixedHdrSizeW dflags\n        -- All thunks use thunkHdrSize, even if they are non-updatable.\n        -- this is because we don't have separate closure types for\n        -- updatable vs. non-updatable thunks, so the GC can't tell the\n        -- difference.  If we ever have significant numbers of non-\n        -- updatable thunks, it might be worth fixing this.\n\n-- ---------------------------------------------------------------------------\n-- Arrays\n\n-- | The byte offset into the card table of the card for a given element\ncard :: DynFlags -> Int -> Int\ncard dflags i = i `shiftR` mUT_ARR_PTRS_CARD_BITS dflags\n\n-- | Convert a number of elements to a number of cards, rounding up\ncardRoundUp :: DynFlags -> Int -> Int\ncardRoundUp dflags i =\n  card dflags (i + ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))\n\n-- | The size of a card table, in bytes\ncardTableSizeB :: DynFlags -> Int -> ByteOff\ncardTableSizeB dflags elems = cardRoundUp dflags elems\n\n-- | The size of a card table, in words\ncardTableSizeW :: DynFlags -> Int -> WordOff\ncardTableSizeW dflags elems =\n  bytesToWordsRoundUp dflags (cardTableSizeB dflags elems)\n\n-----------------------------------------------------------------------------\n-- deriving the RTS closure type from an SMRep\n\n#include \"../includes/rts/storage/ClosureTypes.h\"\n#include \"../includes/rts/storage/FunTypes.h\"\n-- Defines CONSTR, CONSTR_1_0 etc\n\n-- | Derives the RTS closure type from an 'SMRep'\nrtsClosureType :: SMRep -> Int\nrtsClosureType rep\n    = case rep of\n      RTSRep ty _ -> ty\n\n      -- See Note [static constructors]\n      HeapRep _     1 0 Constr{} -> CONSTR_1_0\n      HeapRep _     0 1 Constr{} -> CONSTR_0_1\n      HeapRep _     2 0 Constr{} -> CONSTR_2_0\n      HeapRep _     1 1 Constr{} -> CONSTR_1_1\n      HeapRep _     0 2 Constr{} -> CONSTR_0_2\n      HeapRep _     0 _ Constr{} -> CONSTR_NOCAF\n           -- See Note [Static NoCaf constructors]\n      HeapRep _     _ _ Constr{} -> CONSTR\n\n      HeapRep False 1 0 Fun{} -> FUN_1_0\n      HeapRep False 0 1 Fun{} -> FUN_0_1\n      HeapRep False 2 0 Fun{} -> FUN_2_0\n      HeapRep False 1 1 Fun{} -> FUN_1_1\n      HeapRep False 0 2 Fun{} -> FUN_0_2\n      HeapRep False _ _ Fun{} -> FUN\n\n      HeapRep False 1 0 Thunk -> THUNK_1_0\n      HeapRep False 0 1 Thunk -> THUNK_0_1\n      HeapRep False 2 0 Thunk -> THUNK_2_0\n      HeapRep False 1 1 Thunk -> THUNK_1_1\n      HeapRep False 0 2 Thunk -> THUNK_0_2\n      HeapRep False _ _ Thunk -> THUNK\n\n      HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR\n\n      HeapRep True _ _ Fun{}      -> FUN_STATIC\n      HeapRep True _ _ Thunk      -> THUNK_STATIC\n      HeapRep False _ _ BlackHole -> BLACKHOLE\n      HeapRep False _ _ IndStatic -> IND_STATIC\n\n      _ -> panic \"rtsClosureType\"\n\n-- We export these ones\nrET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int\nrET_SMALL   = RET_SMALL\nrET_BIG     = RET_BIG\naRG_GEN     = ARG_GEN\naRG_GEN_BIG = ARG_GEN_BIG\n\n{-\nNote [static constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe used to have a CONSTR_STATIC closure type, and each constructor had\ntwo info tables: one with CONSTR (or CONSTR_1_0 etc.), and one with\nCONSTR_STATIC.\n\nThis distinction was removed, because when copying a data structure\ninto a compact region, we must copy static constructors into the\ncompact region too.  If we didn't do this, we would need to track the\nreferences from the compact region out to the static constructors,\nbecause they might (indirectly) refer to CAFs.\n\nSince static constructors will be copied to the heap, if we wanted to\nuse different info tables for static and dynamic constructors, we\nwould have to switch the info pointer when copying the constructor\ninto the compact region, which means we would need an extra field of\nthe static info table to point to the dynamic one.\n\nHowever, since the distinction between static and dynamic closure\ntypes is never actually needed (other than for assertions), we can\njust drop the distinction and use the same info table for both.\n\nThe GC *does* need to distinguish between static and dynamic closures,\nbut it does this using the HEAP_ALLOCED() macro which checks whether\nthe address of the closure resides within the dynamic heap.\nHEAP_ALLOCED() doesn't read the closure's info table.\n\nNote [Static NoCaf constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we know that a top-level binding 'x' is not Caffy (ie no CAFs are\nreachable from 'x'), then a statically allocated constructor (Just x)\nis also not Caffy, and the garbage collector need not follow its\nargument fields.  Exploiting this would require two static info tables\nfor Just, for the two cases where the argument was Caffy or non-Caffy.\n\nCurrently we don't do this; instead we treat nullary constructors\nas non-Caffy, and the others as potentially Caffy.\n\n\n************************************************************************\n*                                                                      *\n             Pretty printing of SMRep and friends\n*                                                                      *\n************************************************************************\n-}\n\ninstance Outputable ClosureTypeInfo where\n   ppr = pprTypeInfo\n\ninstance Outputable SMRep where\n   ppr (HeapRep static ps nps tyinfo)\n     = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)\n     where\n       header = text \"HeapRep\"\n                <+> if static then text \"static\" else empty\n                <+> pp_n \"ptrs\" ps <+> pp_n \"nonptrs\" nps\n       pp_n :: String -> Int -> SDoc\n       pp_n _ 0 = empty\n       pp_n s n = int n <+> text s\n\n   ppr (ArrayPtrsRep size _) = text \"ArrayPtrsRep\" <+> ppr size\n\n   ppr (SmallArrayPtrsRep size) = text \"SmallArrayPtrsRep\" <+> ppr size\n\n   ppr (ArrayWordsRep words) = text \"ArrayWordsRep\" <+> ppr words\n\n   ppr (StackRep bs) = text \"StackRep\" <+> ppr bs\n\n   ppr (RTSRep ty rep) = text \"tag:\" <> ppr ty <+> ppr rep\n\ninstance Outputable ArgDescr where\n  ppr (ArgSpec n) = text \"ArgSpec\" <+> ppr n\n  ppr (ArgGen ls) = text \"ArgGen\" <+> ppr ls\n\npprTypeInfo :: ClosureTypeInfo -> SDoc\npprTypeInfo (Constr tag descr)\n  = text \"Con\" <+>\n    braces (sep [ text \"tag:\" <+> ppr tag\n                , text \"descr:\" <> text (show descr) ])\n\npprTypeInfo (Fun arity args)\n  = text \"Fun\" <+>\n    braces (sep [ text \"arity:\" <+> ppr arity\n                , ptext (sLit (\"fun_type:\")) <+> ppr args ])\n\npprTypeInfo (ThunkSelector offset)\n  = text \"ThunkSel\" <+> ppr offset\n\npprTypeInfo Thunk     = text \"Thunk\"\npprTypeInfo BlackHole = text \"BlackHole\"\npprTypeInfo IndStatic = text \"IndStatic\"\n", "num_lines": 564}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Hoopl.Block\n    ( C\n    , O\n    , MaybeO(..)\n    , IndexedCO\n    , Block(..)\n    , blockAppend\n    , blockCons\n    , blockFromList\n    , blockJoin\n    , blockJoinHead\n    , blockJoinTail\n    , blockSnoc\n    , blockSplit\n    , blockSplitHead\n    , blockSplitTail\n    , blockToList\n    , emptyBlock\n    , firstNode\n    , foldBlockNodesB\n    , foldBlockNodesB3\n    , foldBlockNodesF\n    , isEmptyBlock\n    , lastNode\n    , mapBlock\n    , mapBlock'\n    , mapBlock3'\n    , replaceFirstNode\n    , replaceLastNode\n    ) where\n\nimport GhcPrelude\n\n-- -----------------------------------------------------------------------------\n-- Shapes: Open and Closed\n\n-- | Used at the type level to indicate an \"open\" structure with\n-- a unique, unnamed control-flow edge flowing in or out.\n-- \"Fallthrough\" and concatenation are permitted at an open point.\ndata O\n\n-- | Used at the type level to indicate a \"closed\" structure which\n-- supports control transfer only through the use of named\n-- labels---no \"fallthrough\" is permitted.  The number of control-flow\n-- edges is unconstrained.\ndata C\n\n-- | Either type indexed by closed/open using type families\ntype family IndexedCO ex a b :: *\ntype instance IndexedCO C a _b = a\ntype instance IndexedCO O _a b = b\n\n-- | Maybe type indexed by open/closed\ndata MaybeO ex t where\n  JustO    :: t -> MaybeO O t\n  NothingO ::      MaybeO C t\n\n-- | Maybe type indexed by closed/open\ndata MaybeC ex t where\n  JustC    :: t -> MaybeC C t\n  NothingC ::      MaybeC O t\n\n\ninstance Functor (MaybeO ex) where\n  fmap _ NothingO = NothingO\n  fmap f (JustO a) = JustO (f a)\n\ninstance Functor (MaybeC ex) where\n  fmap _ NothingC = NothingC\n  fmap f (JustC a) = JustC (f a)\n\n-- -----------------------------------------------------------------------------\n-- The Block type\n\n-- | A sequence of nodes.  May be any of four shapes (O/O, O/C, C/O, C/C).\n-- Open at the entry means single entry, mutatis mutandis for exit.\n-- A closed/closed block is a /basic/ block and can't be extended further.\n-- Clients should avoid manipulating blocks and should stick to either nodes\n-- or graphs.\ndata Block n e x where\n  BlockCO  :: n C O -> Block n O O          -> Block n C O\n  BlockCC  :: n C O -> Block n O O -> n O C -> Block n C C\n  BlockOC  ::          Block n O O -> n O C -> Block n O C\n\n  BNil    :: Block n O O\n  BMiddle :: n O O                      -> Block n O O\n  BCat    :: Block n O O -> Block n O O -> Block n O O\n  BSnoc   :: Block n O O -> n O O       -> Block n O O\n  BCons   :: n O O       -> Block n O O -> Block n O O\n\n\n-- -----------------------------------------------------------------------------\n-- Simple operations on Blocks\n\n-- Predicates\n\nisEmptyBlock :: Block n e x -> Bool\nisEmptyBlock BNil       = True\nisEmptyBlock (BCat l r) = isEmptyBlock l && isEmptyBlock r\nisEmptyBlock _          = False\n\n\n-- Building\n\nemptyBlock :: Block n O O\nemptyBlock = BNil\n\nblockCons :: n O O -> Block n O x -> Block n O x\nblockCons n b = case b of\n  BlockOC b l  -> (BlockOC $! (n `blockCons` b)) l\n  BNil{}    -> BMiddle n\n  BMiddle{} -> n `BCons` b\n  BCat{}    -> n `BCons` b\n  BSnoc{}   -> n `BCons` b\n  BCons{}   -> n `BCons` b\n\nblockSnoc :: Block n e O -> n O O -> Block n e O\nblockSnoc b n = case b of\n  BlockCO f b -> BlockCO f $! (b `blockSnoc` n)\n  BNil{}      -> BMiddle n\n  BMiddle{}   -> b `BSnoc` n\n  BCat{}      -> b `BSnoc` n\n  BSnoc{}     -> b `BSnoc` n\n  BCons{}     -> b `BSnoc` n\n\nblockJoinHead :: n C O -> Block n O x -> Block n C x\nblockJoinHead f (BlockOC b l) = BlockCC f b l\nblockJoinHead f b = BlockCO f BNil `cat` b\n\nblockJoinTail :: Block n e O -> n O C -> Block n e C\nblockJoinTail (BlockCO f b) t = BlockCC f b t\nblockJoinTail b t = b `cat` BlockOC BNil t\n\nblockJoin :: n C O -> Block n O O -> n O C -> Block n C C\nblockJoin f b t = BlockCC f b t\n\nblockAppend :: Block n e O -> Block n O x -> Block n e x\nblockAppend = cat\n\n\n-- Taking apart\n\nfirstNode :: Block n C x -> n C O\nfirstNode (BlockCO n _)   = n\nfirstNode (BlockCC n _ _) = n\n\nlastNode :: Block n x C -> n O C\nlastNode (BlockOC   _ n) = n\nlastNode (BlockCC _ _ n) = n\n\nblockSplitHead :: Block n C x -> (n C O, Block n O x)\nblockSplitHead (BlockCO n b)   = (n, b)\nblockSplitHead (BlockCC n b t) = (n, BlockOC b t)\n\nblockSplitTail :: Block n e C -> (Block n e O, n O C)\nblockSplitTail (BlockOC b n)   = (b, n)\nblockSplitTail (BlockCC f b t) = (BlockCO f b, t)\n\n-- | Split a closed block into its entry node, open middle block, and\n-- exit node.\nblockSplit :: Block n C C -> (n C O, Block n O O, n O C)\nblockSplit (BlockCC f b t) = (f, b, t)\n\nblockToList :: Block n O O -> [n O O]\nblockToList b = go b []\n   where go :: Block n O O -> [n O O] -> [n O O]\n         go BNil         r = r\n         go (BMiddle n)  r = n : r\n         go (BCat b1 b2) r = go b1 $! go b2 r\n         go (BSnoc b1 n) r = go b1 (n:r)\n         go (BCons n b1) r = n : go b1 r\n\nblockFromList :: [n O O] -> Block n O O\nblockFromList = foldr BCons BNil\n\n-- Modifying\n\nreplaceFirstNode :: Block n C x -> n C O -> Block n C x\nreplaceFirstNode (BlockCO _ b)   f = BlockCO f b\nreplaceFirstNode (BlockCC _ b n) f = BlockCC f b n\n\nreplaceLastNode :: Block n x C -> n O C -> Block n x C\nreplaceLastNode (BlockOC   b _) n = BlockOC b n\nreplaceLastNode (BlockCC l b _) n = BlockCC l b n\n\n-- -----------------------------------------------------------------------------\n-- General concatenation\n\ncat :: Block n e O -> Block n O x -> Block n e x\ncat x y = case x of\n  BNil -> y\n\n  BlockCO l b1 -> case y of\n                   BlockOC b2 n -> (BlockCC l $! (b1 `cat` b2)) n\n                   BNil         -> x\n                   BMiddle _    -> BlockCO l $! (b1 `cat` y)\n                   BCat{}       -> BlockCO l $! (b1 `cat` y)\n                   BSnoc{}      -> BlockCO l $! (b1 `cat` y)\n                   BCons{}      -> BlockCO l $! (b1 `cat` y)\n\n  BMiddle n -> case y of\n                   BlockOC b2 n2 -> (BlockOC $! (x `cat` b2)) n2\n                   BNil          -> x\n                   BMiddle{}     -> BCons n y\n                   BCat{}        -> BCons n y\n                   BSnoc{}       -> BCons n y\n                   BCons{}       -> BCons n y\n\n  BCat{} -> case y of\n                   BlockOC b3 n2 -> (BlockOC $! (x `cat` b3)) n2\n                   BNil          -> x\n                   BMiddle n     -> BSnoc x n\n                   BCat{}        -> BCat x y\n                   BSnoc{}       -> BCat x y\n                   BCons{}       -> BCat x y\n\n  BSnoc{} -> case y of\n                   BlockOC b2 n2 -> (BlockOC $! (x `cat` b2)) n2\n                   BNil          -> x\n                   BMiddle n     -> BSnoc x n\n                   BCat{}        -> BCat x y\n                   BSnoc{}       -> BCat x y\n                   BCons{}       -> BCat x y\n\n\n  BCons{} -> case y of\n                   BlockOC b2 n2 -> (BlockOC $! (x `cat` b2)) n2\n                   BNil          -> x\n                   BMiddle n     -> BSnoc x n\n                   BCat{}        -> BCat x y\n                   BSnoc{}       -> BCat x y\n                   BCons{}       -> BCat x y\n\n\n-- -----------------------------------------------------------------------------\n-- Mapping\n\n-- | map a function over the nodes of a 'Block'\nmapBlock :: (forall e x. n e x -> n' e x) -> Block n e x -> Block n' e x\nmapBlock f (BlockCO n b  ) = BlockCO (f n) (mapBlock f b)\nmapBlock f (BlockOC   b n) = BlockOC       (mapBlock f b) (f n)\nmapBlock f (BlockCC n b m) = BlockCC (f n) (mapBlock f b) (f m)\nmapBlock _  BNil           = BNil\nmapBlock f (BMiddle n)     = BMiddle (f n)\nmapBlock f (BCat b1 b2)    = BCat    (mapBlock f b1) (mapBlock f b2)\nmapBlock f (BSnoc b n)     = BSnoc   (mapBlock f b)  (f n)\nmapBlock f (BCons n b)     = BCons   (f n)  (mapBlock f b)\n\n-- | A strict 'mapBlock'\nmapBlock' :: (forall e x. n e x -> n' e x) -> (Block n e x -> Block n' e x)\nmapBlock' f = mapBlock3' (f, f, f)\n\n-- | map over a block, with different functions to apply to first nodes,\n-- middle nodes and last nodes respectively.  The map is strict.\n--\nmapBlock3' :: forall n n' e x .\n             ( n C O -> n' C O\n             , n O O -> n' O O,\n               n O C -> n' O C)\n          -> Block n e x -> Block n' e x\nmapBlock3' (f, m, l) b = go b\n  where go :: forall e x . Block n e x -> Block n' e x\n        go (BlockOC b y)   = (BlockOC $! go b) $! l y\n        go (BlockCO x b)   = (BlockCO $! f x) $! (go b)\n        go (BlockCC x b y) = ((BlockCC $! f x) $! go b) $! (l y)\n        go BNil            = BNil\n        go (BMiddle n)     = BMiddle $! m n\n        go (BCat x y)      = (BCat $! go x) $! (go y)\n        go (BSnoc x n)     = (BSnoc $! go x) $! (m n)\n        go (BCons n x)     = (BCons $! m n) $! (go x)\n\n-- -----------------------------------------------------------------------------\n-- Folding\n\n\n-- | Fold a function over every node in a block, forward or backward.\n-- The fold function must be polymorphic in the shape of the nodes.\nfoldBlockNodesF3 :: forall n a b c .\n                   ( n C O       -> a -> b\n                   , n O O       -> b -> b\n                   , n O C       -> b -> c)\n                 -> (forall e x . Block n e x -> IndexedCO e a b -> IndexedCO x c b)\nfoldBlockNodesF  :: forall n a .\n                    (forall e x . n e x       -> a -> a)\n                 -> (forall e x . Block n e x -> IndexedCO e a a -> IndexedCO x a a)\nfoldBlockNodesB3 :: forall n a b c .\n                   ( n C O       -> b -> c\n                   , n O O       -> b -> b\n                   , n O C       -> a -> b)\n                 -> (forall e x . Block n e x -> IndexedCO x a b -> IndexedCO e c b)\nfoldBlockNodesB  :: forall n a .\n                    (forall e x . n e x       -> a -> a)\n                 -> (forall e x . Block n e x -> IndexedCO x a a -> IndexedCO e a a)\n\nfoldBlockNodesF3 (ff, fm, fl) = block\n  where block :: forall e x . Block n e x -> IndexedCO e a b -> IndexedCO x c b\n        block (BlockCO f b  )   = ff f `cat` block b\n        block (BlockCC f b l)   = ff f `cat` block b `cat` fl l\n        block (BlockOC   b l)   =            block b `cat` fl l\n        block BNil              = id\n        block (BMiddle node)    = fm node\n        block (b1 `BCat`    b2) = block b1 `cat` block b2\n        block (b1 `BSnoc` n)    = block b1 `cat` fm n\n        block (n `BCons` b2)    = fm n `cat` block b2\n        cat :: forall a b c. (a -> b) -> (b -> c) -> a -> c\n        cat f f' = f' . f\n\nfoldBlockNodesF f = foldBlockNodesF3 (f, f, f)\n\nfoldBlockNodesB3 (ff, fm, fl) = block\n  where block :: forall e x . Block n e x -> IndexedCO x a b -> IndexedCO e c b\n        block (BlockCO f b  )   = ff f `cat` block b\n        block (BlockCC f b l)   = ff f `cat` block b `cat` fl l\n        block (BlockOC   b l)   =            block b `cat` fl l\n        block BNil              = id\n        block (BMiddle node)    = fm node\n        block (b1 `BCat`    b2) = block b1 `cat` block b2\n        block (b1 `BSnoc` n)    = block b1 `cat` fm n\n        block (n `BCons` b2)    = fm n `cat` block b2\n        cat :: forall a b c. (b -> c) -> (a -> b) -> a -> c\n        cat f f' = f . f'\n\nfoldBlockNodesB f = foldBlockNodesB3 (f, f, f)\n\n", "num_lines": 329}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE DeriveFoldable #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule Hoopl.Collections\n    ( IsSet(..)\n    , setInsertList, setDeleteList, setUnions\n    , IsMap(..)\n    , mapInsertList, mapDeleteList, mapUnions\n    , UniqueMap, UniqueSet\n    ) where\n\nimport GhcPrelude\n\nimport qualified Data.IntMap.Strict as M\nimport qualified Data.IntSet as S\n\nimport Data.List (foldl1')\n\nclass IsSet set where\n  type ElemOf set\n\n  setNull :: set -> Bool\n  setSize :: set -> Int\n  setMember :: ElemOf set -> set -> Bool\n\n  setEmpty :: set\n  setSingleton :: ElemOf set -> set\n  setInsert :: ElemOf set -> set -> set\n  setDelete :: ElemOf set -> set -> set\n\n  setUnion :: set -> set -> set\n  setDifference :: set -> set -> set\n  setIntersection :: set -> set -> set\n  setIsSubsetOf :: set -> set -> Bool\n  setFilter :: (ElemOf set -> Bool) -> set -> set\n\n  setFoldl :: (b -> ElemOf set -> b) -> b -> set -> b\n  setFoldr :: (ElemOf set -> b -> b) -> b -> set -> b\n\n  setElems :: set -> [ElemOf set]\n  setFromList :: [ElemOf set] -> set\n\n-- Helper functions for IsSet class\nsetInsertList :: IsSet set => [ElemOf set] -> set -> set\nsetInsertList keys set = foldl' (flip setInsert) set keys\n\nsetDeleteList :: IsSet set => [ElemOf set] -> set -> set\nsetDeleteList keys set = foldl' (flip setDelete) set keys\n\nsetUnions :: IsSet set => [set] -> set\nsetUnions [] = setEmpty\nsetUnions sets = foldl1' setUnion sets\n\n\nclass IsMap map where\n  type KeyOf map\n\n  mapNull :: map a -> Bool\n  mapSize :: map a -> Int\n  mapMember :: KeyOf map -> map a -> Bool\n  mapLookup :: KeyOf map -> map a -> Maybe a\n  mapFindWithDefault :: a -> KeyOf map -> map a -> a\n\n  mapEmpty :: map a\n  mapSingleton :: KeyOf map -> a -> map a\n  mapInsert :: KeyOf map -> a -> map a -> map a\n  mapInsertWith :: (a -> a -> a) -> KeyOf map -> a -> map a -> map a\n  mapDelete :: KeyOf map -> map a -> map a\n  mapAlter :: (Maybe a -> Maybe a) -> KeyOf map -> map a -> map a\n  mapAdjust :: (a -> a) -> KeyOf map -> map a -> map a\n\n  mapUnion :: map a -> map a -> map a\n  mapUnionWithKey :: (KeyOf map -> a -> a -> a) -> map a -> map a -> map a\n  mapDifference :: map a -> map a -> map a\n  mapIntersection :: map a -> map a -> map a\n  mapIsSubmapOf :: Eq a => map a -> map a -> Bool\n\n  mapMap :: (a -> b) -> map a -> map b\n  mapMapWithKey :: (KeyOf map -> a -> b) -> map a -> map b\n  mapFoldl :: (b -> a -> b) -> b -> map a -> b\n  mapFoldr :: (a -> b -> b) -> b -> map a -> b\n  mapFoldlWithKey :: (b -> KeyOf map -> a -> b) -> b -> map a -> b\n  mapFoldMapWithKey :: Monoid m => (KeyOf map -> a -> m) -> map a -> m\n  mapFilter :: (a -> Bool) -> map a -> map a\n  mapFilterWithKey :: (KeyOf map -> a -> Bool) -> map a -> map a\n\n\n  mapElems :: map a -> [a]\n  mapKeys :: map a -> [KeyOf map]\n  mapToList :: map a -> [(KeyOf map, a)]\n  mapFromList :: [(KeyOf map, a)] -> map a\n  mapFromListWith :: (a -> a -> a) -> [(KeyOf map,a)] -> map a\n\n-- Helper functions for IsMap class\nmapInsertList :: IsMap map => [(KeyOf map, a)] -> map a -> map a\nmapInsertList assocs map = foldl' (flip (uncurry mapInsert)) map assocs\n\nmapDeleteList :: IsMap map => [KeyOf map] -> map a -> map a\nmapDeleteList keys map = foldl' (flip mapDelete) map keys\n\nmapUnions :: IsMap map => [map a] -> map a\nmapUnions [] = mapEmpty\nmapUnions maps = foldl1' mapUnion maps\n\n-----------------------------------------------------------------------------\n-- Basic instances\n-----------------------------------------------------------------------------\n\nnewtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show, Semigroup, Monoid)\n\ninstance IsSet UniqueSet where\n  type ElemOf UniqueSet = Int\n\n  setNull (US s) = S.null s\n  setSize (US s) = S.size s\n  setMember k (US s) = S.member k s\n\n  setEmpty = US S.empty\n  setSingleton k = US (S.singleton k)\n  setInsert k (US s) = US (S.insert k s)\n  setDelete k (US s) = US (S.delete k s)\n\n  setUnion (US x) (US y) = US (S.union x y)\n  setDifference (US x) (US y) = US (S.difference x y)\n  setIntersection (US x) (US y) = US (S.intersection x y)\n  setIsSubsetOf (US x) (US y) = S.isSubsetOf x y\n  setFilter f (US s) = US (S.filter f s)\n\n  setFoldl k z (US s) = S.foldl' k z s\n  setFoldr k z (US s) = S.foldr k z s\n\n  setElems (US s) = S.elems s\n  setFromList ks = US (S.fromList ks)\n\nnewtype UniqueMap v = UM (M.IntMap v)\n  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)\n\ninstance IsMap UniqueMap where\n  type KeyOf UniqueMap = Int\n\n  mapNull (UM m) = M.null m\n  mapSize (UM m) = M.size m\n  mapMember k (UM m) = M.member k m\n  mapLookup k (UM m) = M.lookup k m\n  mapFindWithDefault def k (UM m) = M.findWithDefault def k m\n\n  mapEmpty = UM M.empty\n  mapSingleton k v = UM (M.singleton k v)\n  mapInsert k v (UM m) = UM (M.insert k v m)\n  mapInsertWith f k v (UM m) = UM (M.insertWith f k v m)\n  mapDelete k (UM m) = UM (M.delete k m)\n  mapAlter f k (UM m) = UM (M.alter f k m)\n  mapAdjust f k (UM m) = UM (M.adjust f k m)\n\n  mapUnion (UM x) (UM y) = UM (M.union x y)\n  mapUnionWithKey f (UM x) (UM y) = UM (M.unionWithKey f x y)\n  mapDifference (UM x) (UM y) = UM (M.difference x y)\n  mapIntersection (UM x) (UM y) = UM (M.intersection x y)\n  mapIsSubmapOf (UM x) (UM y) = M.isSubmapOf x y\n\n  mapMap f (UM m) = UM (M.map f m)\n  mapMapWithKey f (UM m) = UM (M.mapWithKey f m)\n  mapFoldl k z (UM m) = M.foldl' k z m\n  mapFoldr k z (UM m) = M.foldr k z m\n  mapFoldlWithKey k z (UM m) = M.foldlWithKey' k z m\n  mapFoldMapWithKey f (UM m) = M.foldMapWithKey f m\n  mapFilter f (UM m) = UM (M.filter f m)\n  mapFilterWithKey f (UM m) = UM (M.filterWithKey f m)\n\n  mapElems (UM m) = M.elems m\n  mapKeys (UM m) = M.keys m\n  mapToList (UM m) = M.toList m\n  mapFromList assocs = UM (M.fromList assocs)\n  mapFromListWith f assocs = UM (M.fromListWith f assocs)\n", "num_lines": 178}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses  #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fprof-auto-top #-}\n\n--\n-- Copyright (c) 2010, Jo\u00c3\u00a3o Dias, Simon Marlow, Simon Peyton Jones,\n-- and Norman Ramsey\n--\n-- Modifications copyright (c) The University of Glasgow 2012\n--\n-- This module is a specialised and optimised version of\n-- Compiler.Hoopl.Dataflow in the hoopl package.  In particular it is\n-- specialised to the UniqSM monad.\n--\n\nmodule Hoopl.Dataflow\n  ( C, O, Block\n  , lastNode, entryLabel\n  , foldNodesBwdOO\n  , foldRewriteNodesBwdOO\n  , DataflowLattice(..), OldFact(..), NewFact(..), JoinedFact(..)\n  , TransferFun, RewriteFun\n  , Fact, FactBase\n  , getFact, mkFactBase\n  , analyzeCmmFwd, analyzeCmmBwd\n  , rewriteCmmBwd\n  , changedIf\n  , joinOutFacts\n  , joinFacts\n  )\nwhere\n\nimport GhcPrelude\n\nimport Cmm\nimport UniqSupply\n\nimport Data.Array\nimport Data.Maybe\nimport Data.IntSet (IntSet)\nimport qualified Data.IntSet as IntSet\n\nimport Hoopl.Block\nimport Hoopl.Graph\nimport Hoopl.Collections\nimport Hoopl.Label\n\ntype family   Fact x f :: *\ntype instance Fact C f = FactBase f\ntype instance Fact O f = f\n\nnewtype OldFact a = OldFact a\n\nnewtype NewFact a = NewFact a\n\n-- | The result of joining OldFact and NewFact.\ndata JoinedFact a\n    = Changed !a     -- ^ Result is different than OldFact.\n    | NotChanged !a  -- ^ Result is the same as OldFact.\n\ngetJoined :: JoinedFact a -> a\ngetJoined (Changed a) = a\ngetJoined (NotChanged a) = a\n\nchangedIf :: Bool -> a -> JoinedFact a\nchangedIf True = Changed\nchangedIf False = NotChanged\n\ntype JoinFun a = OldFact a -> NewFact a -> JoinedFact a\n\ndata DataflowLattice a = DataflowLattice\n    { fact_bot :: a\n    , fact_join :: JoinFun a\n    }\n\ndata Direction = Fwd | Bwd\n\ntype TransferFun f = CmmBlock -> FactBase f -> FactBase f\n\n-- | Function for rewrtiting and analysis combined. To be used with\n-- @rewriteCmm@.\n--\n-- Currently set to work with @UniqSM@ monad, but we could probably abstract\n-- that away (if we do that, we might want to specialize the fixpoint algorithms\n-- to the particular monads through SPECIALIZE).\ntype RewriteFun f = CmmBlock -> FactBase f -> UniqSM (CmmBlock, FactBase f)\n\nanalyzeCmmBwd, analyzeCmmFwd\n    :: DataflowLattice f\n    -> TransferFun f\n    -> CmmGraph\n    -> FactBase f\n    -> FactBase f\nanalyzeCmmBwd = analyzeCmm Bwd\nanalyzeCmmFwd = analyzeCmm Fwd\n\nanalyzeCmm\n    :: Direction\n    -> DataflowLattice f\n    -> TransferFun f\n    -> CmmGraph\n    -> FactBase f\n    -> FactBase f\nanalyzeCmm dir lattice transfer cmmGraph initFact =\n    let entry = g_entry cmmGraph\n        hooplGraph = g_graph cmmGraph\n        blockMap =\n            case hooplGraph of\n                GMany NothingO bm NothingO -> bm\n    in fixpointAnalysis dir lattice transfer entry blockMap initFact\n\n-- Fixpoint algorithm.\nfixpointAnalysis\n    :: forall f.\n       Direction\n    -> DataflowLattice f\n    -> TransferFun f\n    -> Label\n    -> LabelMap CmmBlock\n    -> FactBase f\n    -> FactBase f\nfixpointAnalysis direction lattice do_block entry blockmap = loop start\n  where\n    -- Sorting the blocks helps to minimize the number of times we need to\n    -- process blocks. For instance, for forward analysis we want to look at\n    -- blocks in reverse postorder. Also, see comments for sortBlocks.\n    blocks     = sortBlocks direction entry blockmap\n    num_blocks = length blocks\n    block_arr  = {-# SCC \"block_arr\" #-} listArray (0, num_blocks - 1) blocks\n    start      = {-# SCC \"start\" #-} IntSet.fromDistinctAscList\n      [0 .. num_blocks - 1]\n    dep_blocks = {-# SCC \"dep_blocks\" #-} mkDepBlocks direction blocks\n    join       = fact_join lattice\n\n    loop\n        :: IntHeap     -- ^ Worklist, i.e., blocks to process\n        -> FactBase f  -- ^ Current result (increases monotonically)\n        -> FactBase f\n    loop todo !fbase1 | Just (index, todo1) <- IntSet.minView todo =\n        let block = block_arr ! index\n            out_facts = {-# SCC \"do_block\" #-} do_block block fbase1\n            -- For each of the outgoing edges, we join it with the current\n            -- information in fbase1 and (if something changed) we update it\n            -- and add the affected blocks to the worklist.\n            (todo2, fbase2) = {-# SCC \"mapFoldWithKey\" #-}\n                mapFoldlWithKey\n                    (updateFact join dep_blocks) (todo1, fbase1) out_facts\n        in loop todo2 fbase2\n    loop _ !fbase1 = fbase1\n\nrewriteCmmBwd\n    :: DataflowLattice f\n    -> RewriteFun f\n    -> CmmGraph\n    -> FactBase f\n    -> UniqSM (CmmGraph, FactBase f)\nrewriteCmmBwd = rewriteCmm Bwd\n\nrewriteCmm\n    :: Direction\n    -> DataflowLattice f\n    -> RewriteFun f\n    -> CmmGraph\n    -> FactBase f\n    -> UniqSM (CmmGraph, FactBase f)\nrewriteCmm dir lattice rwFun cmmGraph initFact = do\n    let entry = g_entry cmmGraph\n        hooplGraph = g_graph cmmGraph\n        blockMap1 =\n            case hooplGraph of\n                GMany NothingO bm NothingO -> bm\n    (blockMap2, facts) <-\n        fixpointRewrite dir lattice rwFun entry blockMap1 initFact\n    return (cmmGraph {g_graph = GMany NothingO blockMap2 NothingO}, facts)\n\nfixpointRewrite\n    :: forall f.\n       Direction\n    -> DataflowLattice f\n    -> RewriteFun f\n    -> Label\n    -> LabelMap CmmBlock\n    -> FactBase f\n    -> UniqSM (LabelMap CmmBlock, FactBase f)\nfixpointRewrite dir lattice do_block entry blockmap = loop start blockmap\n  where\n    -- Sorting the blocks helps to minimize the number of times we need to\n    -- process blocks. For instance, for forward analysis we want to look at\n    -- blocks in reverse postorder. Also, see comments for sortBlocks.\n    blocks     = sortBlocks dir entry blockmap\n    num_blocks = length blocks\n    block_arr  = {-# SCC \"block_arr_rewrite\" #-}\n                 listArray (0, num_blocks - 1) blocks\n    start      = {-# SCC \"start_rewrite\" #-}\n                 IntSet.fromDistinctAscList [0 .. num_blocks - 1]\n    dep_blocks = {-# SCC \"dep_blocks_rewrite\" #-} mkDepBlocks dir blocks\n    join       = fact_join lattice\n\n    loop\n        :: IntHeap            -- ^ Worklist, i.e., blocks to process\n        -> LabelMap CmmBlock  -- ^ Rewritten blocks.\n        -> FactBase f         -- ^ Current facts.\n        -> UniqSM (LabelMap CmmBlock, FactBase f)\n    loop todo !blocks1 !fbase1\n      | Just (index, todo1) <- IntSet.minView todo = do\n        -- Note that we use the *original* block here. This is important.\n        -- We're optimistically rewriting blocks even before reaching the fixed\n        -- point, which means that the rewrite might be incorrect. So if the\n        -- facts change, we need to rewrite the original block again (taking\n        -- into account the new facts).\n        let block = block_arr ! index\n        (new_block, out_facts) <- {-# SCC \"do_block_rewrite\" #-}\n            do_block block fbase1\n        let blocks2 = mapInsert (entryLabel new_block) new_block blocks1\n            (todo2, fbase2) = {-# SCC \"mapFoldWithKey_rewrite\" #-}\n                mapFoldlWithKey\n                    (updateFact join dep_blocks) (todo1, fbase1) out_facts\n        loop todo2 blocks2 fbase2\n    loop _ !blocks1 !fbase1 = return (blocks1, fbase1)\n\n\n{-\nNote [Unreachable blocks]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nA block that is not in the domain of tfb_fbase is \"currently unreachable\".\nA currently-unreachable block is not even analyzed.  Reason: consider\nconstant prop and this graph, with entry point L1:\n  L1: x:=3; goto L4\n  L2: x:=4; goto L4\n  L4: if x>3 goto L2 else goto L5\nHere L2 is actually unreachable, but if we process it with bottom input fact,\nwe'll propagate (x=4) to L4, and nuke the otherwise-good rewriting of L4.\n\n* If a currently-unreachable block is not analyzed, then its rewritten\n  graph will not be accumulated in tfb_rg.  And that is good:\n  unreachable blocks simply do not appear in the output.\n\n* Note that clients must be careful to provide a fact (even if bottom)\n  for each entry point. Otherwise useful blocks may be garbage collected.\n\n* Note that updateFact must set the change-flag if a label goes from\n  not-in-fbase to in-fbase, even if its fact is bottom.  In effect the\n  real fact lattice is\n       UNR\n       bottom\n       the points above bottom\n\n* Even if the fact is going from UNR to bottom, we still call the\n  client's fact_join function because it might give the client\n  some useful debugging information.\n\n* All of this only applies for *forward* ixpoints.  For the backward\n  case we must treat every block as reachable; it might finish with a\n  'return', and therefore have no successors, for example.\n-}\n\n\n-----------------------------------------------------------------------------\n--  Pieces that are shared by fixpoint and fixpoint_anal\n-----------------------------------------------------------------------------\n\n-- | Sort the blocks into the right order for analysis. This means reverse\n-- postorder for a forward analysis. For the backward one, we simply reverse\n-- that (see Note [Backward vs forward analysis]).\nsortBlocks\n    :: NonLocal n\n    => Direction -> Label -> LabelMap (Block n C C) -> [Block n C C]\nsortBlocks direction entry blockmap =\n    case direction of\n        Fwd -> fwd\n        Bwd -> reverse fwd\n  where\n    fwd = revPostorderFrom blockmap entry\n\n-- Note [Backward vs forward analysis]\n--\n-- The forward and backward cases are not dual.  In the forward case, the entry\n-- points are known, and one simply traverses the body blocks from those points.\n-- In the backward case, something is known about the exit points, but a\n-- backward analysis must also include reachable blocks that don't reach the\n-- exit, as in a procedure that loops forever and has side effects.)\n-- For instance, let E be the entry and X the exit blocks (arrows indicate\n-- control flow)\n--   E -> X\n--   E -> B\n--   B -> C\n--   C -> B\n-- We do need to include B and C even though they're unreachable in the\n-- *reverse* graph (that we could use for backward analysis):\n--   E <- X\n--   E <- B\n--   B <- C\n--   C <- B\n-- So when sorting the blocks for the backward analysis, we simply take the\n-- reverse of what is used for the forward one.\n\n\n-- | Construct a mapping from a @Label@ to the block indexes that should be\n-- re-analyzed if the facts at that @Label@ change.\n--\n-- Note that we're considering here the entry point of the block, so if the\n-- facts change at the entry:\n-- * for a backward analysis we need to re-analyze all the predecessors, but\n-- * for a forward analysis, we only need to re-analyze the current block\n--   (and that will in turn propagate facts into its successors).\nmkDepBlocks :: Direction -> [CmmBlock] -> LabelMap IntSet\nmkDepBlocks Fwd blocks = go blocks 0 mapEmpty\n  where\n    go []     !_ !dep_map = dep_map\n    go (b:bs) !n !dep_map =\n        go bs (n + 1) $ mapInsert (entryLabel b) (IntSet.singleton n) dep_map\nmkDepBlocks Bwd blocks = go blocks 0 mapEmpty\n  where\n    go []     !_ !dep_map = dep_map\n    go (b:bs) !n !dep_map =\n        let insert m l = mapInsertWith IntSet.union l (IntSet.singleton n) m\n        in go bs (n + 1) $ foldl' insert dep_map (successors b)\n\n-- | After some new facts have been generated by analysing a block, we\n-- fold this function over them to generate (a) a list of block\n-- indices to (re-)analyse, and (b) the new FactBase.\nupdateFact\n    :: JoinFun f\n    -> LabelMap IntSet\n    -> (IntHeap, FactBase f)\n    -> Label\n    -> f -- out fact\n    -> (IntHeap, FactBase f)\nupdateFact fact_join dep_blocks (todo, fbase) lbl new_fact\n  = case lookupFact lbl fbase of\n      Nothing ->\n          -- Note [No old fact]\n          let !z = mapInsert lbl new_fact fbase in (changed, z)\n      Just old_fact ->\n          case fact_join (OldFact old_fact) (NewFact new_fact) of\n              (NotChanged _) -> (todo, fbase)\n              (Changed f) -> let !z = mapInsert lbl f fbase in (changed, z)\n  where\n    changed = todo `IntSet.union`\n              mapFindWithDefault IntSet.empty lbl dep_blocks\n\n{-\nNote [No old fact]\n\nWe know that the new_fact is >= _|_, so we don't need to join.  However,\nif the new fact is also _|_, and we have already analysed its block,\nwe don't need to record a change.  So there's a tradeoff here.  It turns\nout that always recording a change is faster.\n-}\n\n----------------------------------------------------------------\n--       Utilities\n----------------------------------------------------------------\n\n-- Fact lookup: the fact `orelse` bottom\ngetFact  :: DataflowLattice f -> Label -> FactBase f -> f\ngetFact lat l fb = case lookupFact l fb of Just  f -> f\n                                           Nothing -> fact_bot lat\n\n-- | Returns the result of joining the facts from all the successors of the\n-- provided node or block.\njoinOutFacts :: (NonLocal n) => DataflowLattice f -> n e C -> FactBase f -> f\njoinOutFacts lattice nonLocal fact_base = foldl' join (fact_bot lattice) facts\n  where\n    join new old = getJoined $ fact_join lattice (OldFact old) (NewFact new)\n    facts =\n        [ fromJust fact\n        | s <- successors nonLocal\n        , let fact = lookupFact s fact_base\n        , isJust fact\n        ]\n\njoinFacts :: DataflowLattice f -> [f] -> f\njoinFacts lattice facts  = foldl' join (fact_bot lattice) facts\n  where\n    join new old = getJoined $ fact_join lattice (OldFact old) (NewFact new)\n\n-- | Returns the joined facts for each label.\nmkFactBase :: DataflowLattice f -> [(Label, f)] -> FactBase f\nmkFactBase lattice = foldl' add mapEmpty\n  where\n    join = fact_join lattice\n\n    add result (l, f1) =\n        let !newFact =\n                case mapLookup l result of\n                    Nothing -> f1\n                    Just f2 -> getJoined $ join (OldFact f1) (NewFact f2)\n        in mapInsert l newFact result\n\n-- | Folds backward over all nodes of an open-open block.\n-- Strict in the accumulator.\nfoldNodesBwdOO :: (CmmNode O O -> f -> f) -> Block CmmNode O O -> f -> f\nfoldNodesBwdOO funOO = go\n  where\n    go (BCat b1 b2) f = go b1 $! go b2 f\n    go (BSnoc h n) f = go h $! funOO n f\n    go (BCons n t) f = funOO n $! go t f\n    go (BMiddle n) f = funOO n f\n    go BNil f = f\n{-# INLINABLE foldNodesBwdOO #-}\n\n-- | Folds backward over all the nodes of an open-open block and allows\n-- rewriting them. The accumulator is both the block of nodes and @f@ (usually\n-- dataflow facts).\n-- Strict in both accumulated parts.\nfoldRewriteNodesBwdOO\n    :: forall f.\n       (CmmNode O O -> f -> UniqSM (Block CmmNode O O, f))\n    -> Block CmmNode O O\n    -> f\n    -> UniqSM (Block CmmNode O O, f)\nfoldRewriteNodesBwdOO rewriteOO initBlock initFacts = go initBlock initFacts\n  where\n    go (BCons node1 block1) !fact1 = (rewriteOO node1 `comp` go block1) fact1\n    go (BSnoc block1 node1) !fact1 = (go block1 `comp` rewriteOO node1) fact1\n    go (BCat blockA1 blockB1) !fact1 = (go blockA1 `comp` go blockB1) fact1\n    go (BMiddle node) !fact1 = rewriteOO node fact1\n    go BNil !fact = return (BNil, fact)\n\n    comp rew1 rew2 = \\f1 -> do\n        (b, f2) <- rew2 f1\n        (a, !f3) <- rew1 f2\n        let !c = joinBlocksOO a b\n        return (c, f3)\n    {-# INLINE comp #-}\n{-# INLINABLE foldRewriteNodesBwdOO #-}\n\njoinBlocksOO :: Block n O O -> Block n O O -> Block n O O\njoinBlocksOO BNil b = b\njoinBlocksOO b BNil = b\njoinBlocksOO (BMiddle n) b = blockCons n b\njoinBlocksOO b (BMiddle n) = blockSnoc b n\njoinBlocksOO b1 b2 = BCat b1 b2\n\ntype IntHeap = IntSet\n", "num_lines": 441}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Hoopl.Graph\n    ( Body\n    , Graph\n    , Graph'(..)\n    , NonLocal(..)\n    , addBlock\n    , bodyList\n    , emptyBody\n    , labelsDefined\n    , mapGraph\n    , mapGraphBlocks\n    , revPostorderFrom\n    ) where\n\n\nimport GhcPrelude\nimport Util\n\nimport Hoopl.Label\nimport Hoopl.Block\nimport Hoopl.Collections\n\n-- | A (possibly empty) collection of closed/closed blocks\ntype Body n = LabelMap (Block n C C)\n\n-- | @Body@ abstracted over @block@\ntype Body' block (n :: * -> * -> *) = LabelMap (block n C C)\n\n-------------------------------\n-- | Gives access to the anchor points for\n-- nonlocal edges as well as the edges themselves\nclass NonLocal thing where\n  entryLabel :: thing C x -> Label   -- ^ The label of a first node or block\n  successors :: thing e C -> [Label] -- ^ Gives control-flow successors\n\ninstance NonLocal n => NonLocal (Block n) where\n  entryLabel (BlockCO f _)   = entryLabel f\n  entryLabel (BlockCC f _ _) = entryLabel f\n\n  successors (BlockOC   _ n) = successors n\n  successors (BlockCC _ _ n) = successors n\n\n\nemptyBody :: Body' block n\nemptyBody = mapEmpty\n\nbodyList :: Body' block n -> [(Label,block n C C)]\nbodyList body = mapToList body\n\naddBlock\n    :: (NonLocal block, HasDebugCallStack)\n    => block C C -> LabelMap (block C C) -> LabelMap (block C C)\naddBlock block body = mapAlter add lbl body\n  where\n    lbl = entryLabel block\n    add Nothing = Just block\n    add _ = error $ \"duplicate label \" ++ show lbl ++ \" in graph\"\n\n\n-- ---------------------------------------------------------------------------\n-- Graph\n\n-- | A control-flow graph, which may take any of four shapes (O/O,\n-- O/C, C/O, C/C).  A graph open at the entry has a single,\n-- distinguished, anonymous entry point; if a graph is closed at the\n-- entry, its entry point(s) are supplied by a context.\ntype Graph = Graph' Block\n\n-- | @Graph'@ is abstracted over the block type, so that we can build\n-- graphs of annotated blocks for example (Compiler.Hoopl.Dataflow\n-- needs this).\ndata Graph' block (n :: * -> * -> *) e x where\n  GNil  :: Graph' block n O O\n  GUnit :: block n O O -> Graph' block n O O\n  GMany :: MaybeO e (block n O C)\n        -> Body' block n\n        -> MaybeO x (block n C O)\n        -> Graph' block n e x\n\n\n-- -----------------------------------------------------------------------------\n-- Mapping over graphs\n\n-- | Maps over all nodes in a graph.\nmapGraph :: (forall e x. n e x -> n' e x) -> Graph n e x -> Graph n' e x\nmapGraph f = mapGraphBlocks (mapBlock f)\n\n-- | Function 'mapGraphBlocks' enables a change of representation of blocks,\n-- nodes, or both.  It lifts a polymorphic block transform into a polymorphic\n-- graph transform.  When the block representation stabilizes, a similar\n-- function should be provided for blocks.\nmapGraphBlocks :: forall block n block' n' e x .\n                  (forall e x . block n e x -> block' n' e x)\n               -> (Graph' block n e x -> Graph' block' n' e x)\n\nmapGraphBlocks f = map\n  where map :: Graph' block n e x -> Graph' block' n' e x\n        map GNil = GNil\n        map (GUnit b) = GUnit (f b)\n        map (GMany e b x) = GMany (fmap f e) (mapMap f b) (fmap f x)\n\n-- -----------------------------------------------------------------------------\n-- Extracting Labels from graphs\n\nlabelsDefined :: forall block n e x . NonLocal (block n) => Graph' block n e x\n              -> LabelSet\nlabelsDefined GNil      = setEmpty\nlabelsDefined (GUnit{}) = setEmpty\nlabelsDefined (GMany _ body x) = mapFoldlWithKey addEntry (exitLabel x) body\n  where addEntry :: forall a. LabelSet -> ElemOf LabelSet -> a -> LabelSet\n        addEntry labels label _ = setInsert label labels\n        exitLabel :: MaybeO x (block n C O) -> LabelSet\n        exitLabel NothingO  = setEmpty\n        exitLabel (JustO b) = setSingleton (entryLabel b)\n\n\n----------------------------------------------------------------\n\n-- | Returns a list of blocks reachable from the provided Labels in the reverse\n-- postorder.\n--\n-- This is the most important traversal over this data structure.  It drops\n-- unreachable code and puts blocks in an order that is good for solving forward\n-- dataflow problems quickly.  The reverse order is good for solving backward\n-- dataflow problems quickly.  The forward order is also reasonably good for\n-- emitting instructions, except that it will not usually exploit Forrest\n-- Baskett's trick of eliminating the unconditional branch from a loop.  For\n-- that you would need a more serious analysis, probably based on dominators, to\n-- identify loop headers.\n--\n-- For forward analyses we want reverse postorder visitation, consider:\n-- @\n--      A -> [B,C]\n--      B -> D\n--      C -> D\n-- @\n-- Postorder: [D, C, B, A] (or [D, B, C, A])\n-- Reverse postorder: [A, B, C, D] (or [A, C, B, D])\n-- This matters for, e.g., forward analysis, because we want to analyze *both*\n-- B and C before we analyze D.\nrevPostorderFrom\n  :: forall block.  (NonLocal block)\n  => LabelMap (block C C) -> Label -> [block C C]\nrevPostorderFrom graph start = go start_worklist setEmpty []\n  where\n    start_worklist = lookup_for_descend start Nil\n\n    -- To compute the postorder we need to \"visit\" a block (mark as done)\n    -- *after* visiting all its successors. So we need to know whether we\n    -- already processed all successors of each block (and @NonLocal@ allows\n    -- arbitrary many successors). So we use an explicit stack with an extra bit\n    -- of information:\n    -- * @ConsTodo@ means to explore the block if it wasn't visited before\n    -- * @ConsMark@ means that all successors were already done and we can add\n    --   the block to the result.\n    --\n    -- NOTE: We add blocks to the result list in postorder, but we *prepend*\n    -- them (i.e., we use @(:)@), which means that the final list is in reverse\n    -- postorder.\n    go :: DfsStack (block C C) -> LabelSet -> [block C C] -> [block C C]\n    go Nil                      !_           !result = result\n    go (ConsMark block rest)    !wip_or_done !result =\n        go rest wip_or_done (block : result)\n    go (ConsTodo block rest)    !wip_or_done !result\n        | entryLabel block `setMember` wip_or_done = go rest wip_or_done result\n        | otherwise =\n            let new_worklist =\n                    foldr lookup_for_descend\n                          (ConsMark block rest)\n                          (successors block)\n            in go new_worklist (setInsert (entryLabel block) wip_or_done) result\n\n    lookup_for_descend :: Label -> DfsStack (block C C) -> DfsStack (block C C)\n    lookup_for_descend label wl\n      | Just b <- mapLookup label graph = ConsTodo b wl\n      | otherwise =\n           error $ \"Label that doesn't have a block?! \" ++ show label\n\ndata DfsStack a = ConsTodo a (DfsStack a) | ConsMark a (DfsStack a) | Nil\n", "num_lines": 186}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFoldable #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule Hoopl.Label\n    ( Label\n    , LabelMap\n    , LabelSet\n    , FactBase\n    , lookupFact\n    , mkHooplLabel\n    ) where\n\nimport GhcPrelude\n\nimport Outputable\n\n-- TODO: This should really just use GHC's Unique and Uniq{Set,FM}\nimport Hoopl.Collections\n\nimport Unique (Uniquable(..))\nimport TrieMap\n\n\n-----------------------------------------------------------------------------\n--              Label\n-----------------------------------------------------------------------------\n\nnewtype Label = Label { lblToUnique :: Int }\n  deriving (Eq, Ord)\n\nmkHooplLabel :: Int -> Label\nmkHooplLabel = Label\n\ninstance Show Label where\n  show (Label n) = \"L\" ++ show n\n\ninstance Uniquable Label where\n  getUnique label = getUnique (lblToUnique label)\n\ninstance Outputable Label where\n  ppr label = ppr (getUnique label)\n\n-----------------------------------------------------------------------------\n-- LabelSet\n\nnewtype LabelSet = LS UniqueSet deriving (Eq, Ord, Show, Monoid, Semigroup)\n\ninstance IsSet LabelSet where\n  type ElemOf LabelSet = Label\n\n  setNull (LS s) = setNull s\n  setSize (LS s) = setSize s\n  setMember (Label k) (LS s) = setMember k s\n\n  setEmpty = LS setEmpty\n  setSingleton (Label k) = LS (setSingleton k)\n  setInsert (Label k) (LS s) = LS (setInsert k s)\n  setDelete (Label k) (LS s) = LS (setDelete k s)\n\n  setUnion (LS x) (LS y) = LS (setUnion x y)\n  setDifference (LS x) (LS y) = LS (setDifference x y)\n  setIntersection (LS x) (LS y) = LS (setIntersection x y)\n  setIsSubsetOf (LS x) (LS y) = setIsSubsetOf x y\n  setFilter f (LS s) = LS (setFilter (f . mkHooplLabel) s)\n  setFoldl k z (LS s) = setFoldl (\\a v -> k a (mkHooplLabel v)) z s\n  setFoldr k z (LS s) = setFoldr (\\v a -> k (mkHooplLabel v) a) z s\n\n  setElems (LS s) = map mkHooplLabel (setElems s)\n  setFromList ks = LS (setFromList (map lblToUnique ks))\n\n-----------------------------------------------------------------------------\n-- LabelMap\n\nnewtype LabelMap v = LM (UniqueMap v)\n  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)\n\ninstance IsMap LabelMap where\n  type KeyOf LabelMap = Label\n\n  mapNull (LM m) = mapNull m\n  mapSize (LM m) = mapSize m\n  mapMember (Label k) (LM m) = mapMember k m\n  mapLookup (Label k) (LM m) = mapLookup k m\n  mapFindWithDefault def (Label k) (LM m) = mapFindWithDefault def k m\n\n  mapEmpty = LM mapEmpty\n  mapSingleton (Label k) v = LM (mapSingleton k v)\n  mapInsert (Label k) v (LM m) = LM (mapInsert k v m)\n  mapInsertWith f (Label k) v (LM m) = LM (mapInsertWith f k v m)\n  mapDelete (Label k) (LM m) = LM (mapDelete k m)\n  mapAlter f (Label k) (LM m) = LM (mapAlter f k m)\n  mapAdjust f (Label k) (LM m) = LM (mapAdjust f k m)\n\n  mapUnion (LM x) (LM y) = LM (mapUnion x y)\n  mapUnionWithKey f (LM x) (LM y) = LM (mapUnionWithKey (f . mkHooplLabel) x y)\n  mapDifference (LM x) (LM y) = LM (mapDifference x y)\n  mapIntersection (LM x) (LM y) = LM (mapIntersection x y)\n  mapIsSubmapOf (LM x) (LM y) = mapIsSubmapOf x y\n\n  mapMap f (LM m) = LM (mapMap f m)\n  mapMapWithKey f (LM m) = LM (mapMapWithKey (f . mkHooplLabel) m)\n  mapFoldl k z (LM m) = mapFoldl k z m\n  mapFoldr k z (LM m) = mapFoldr k z m\n  mapFoldlWithKey k z (LM m) =\n      mapFoldlWithKey (\\a v -> k a (mkHooplLabel v)) z m\n  mapFoldMapWithKey f (LM m) = mapFoldMapWithKey (\\k v -> f (mkHooplLabel k) v) m\n  mapFilter f (LM m) = LM (mapFilter f m)\n  mapFilterWithKey f (LM m) = LM (mapFilterWithKey (f . mkHooplLabel) m)\n\n  mapElems (LM m) = mapElems m\n  mapKeys (LM m) = map mkHooplLabel (mapKeys m)\n  mapToList (LM m) = [(mkHooplLabel k, v) | (k, v) <- mapToList m]\n  mapFromList assocs = LM (mapFromList [(lblToUnique k, v) | (k, v) <- assocs])\n  mapFromListWith f assocs = LM (mapFromListWith f [(lblToUnique k, v) | (k, v) <- assocs])\n\n-----------------------------------------------------------------------------\n-- Instances\n\ninstance Outputable LabelSet where\n  ppr = ppr . setElems\n\ninstance Outputable a => Outputable (LabelMap a) where\n  ppr = ppr . mapToList\n\ninstance TrieMap LabelMap where\n  type Key LabelMap = Label\n  emptyTM = mapEmpty\n  lookupTM k m = mapLookup k m\n  alterTM k f m = mapAlter f k m\n  foldTM k m z = mapFoldr k z m\n  mapTM f m = mapMap f m\n\n-----------------------------------------------------------------------------\n-- FactBase\n\ntype FactBase f = LabelMap f\n\nlookupFact :: Label -> FactBase f -> Maybe f\nlookupFact = mapLookup\n", "num_lines": 143}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-----------------------------------------------------------------------------\n--\n-- Code generator utilities; mostly monadic\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule CgUtils ( fixStgRegisters ) where\n\nimport GhcPrelude\n\nimport CodeGen.Platform\nimport Cmm\nimport Hoopl.Block\nimport Hoopl.Graph\nimport CmmUtils\nimport CLabel\nimport DynFlags\nimport Outputable\n\n-- -----------------------------------------------------------------------------\n-- Information about global registers\n\nbaseRegOffset :: DynFlags -> GlobalReg -> Int\n\nbaseRegOffset dflags (VanillaReg 1 _)    = oFFSET_StgRegTable_rR1 dflags\nbaseRegOffset dflags (VanillaReg 2 _)    = oFFSET_StgRegTable_rR2 dflags\nbaseRegOffset dflags (VanillaReg 3 _)    = oFFSET_StgRegTable_rR3 dflags\nbaseRegOffset dflags (VanillaReg 4 _)    = oFFSET_StgRegTable_rR4 dflags\nbaseRegOffset dflags (VanillaReg 5 _)    = oFFSET_StgRegTable_rR5 dflags\nbaseRegOffset dflags (VanillaReg 6 _)    = oFFSET_StgRegTable_rR6 dflags\nbaseRegOffset dflags (VanillaReg 7 _)    = oFFSET_StgRegTable_rR7 dflags\nbaseRegOffset dflags (VanillaReg 8 _)    = oFFSET_StgRegTable_rR8 dflags\nbaseRegOffset dflags (VanillaReg 9 _)    = oFFSET_StgRegTable_rR9 dflags\nbaseRegOffset dflags (VanillaReg 10 _)   = oFFSET_StgRegTable_rR10 dflags\nbaseRegOffset _      (VanillaReg n _)    = panic (\"Registers above R10 are not supported (tried to use R\" ++ show n ++ \")\")\nbaseRegOffset dflags (FloatReg  1)       = oFFSET_StgRegTable_rF1 dflags\nbaseRegOffset dflags (FloatReg  2)       = oFFSET_StgRegTable_rF2 dflags\nbaseRegOffset dflags (FloatReg  3)       = oFFSET_StgRegTable_rF3 dflags\nbaseRegOffset dflags (FloatReg  4)       = oFFSET_StgRegTable_rF4 dflags\nbaseRegOffset dflags (FloatReg  5)       = oFFSET_StgRegTable_rF5 dflags\nbaseRegOffset dflags (FloatReg  6)       = oFFSET_StgRegTable_rF6 dflags\nbaseRegOffset _      (FloatReg  n)       = panic (\"Registers above F6 are not supported (tried to use F\" ++ show n ++ \")\")\nbaseRegOffset dflags (DoubleReg 1)       = oFFSET_StgRegTable_rD1 dflags\nbaseRegOffset dflags (DoubleReg 2)       = oFFSET_StgRegTable_rD2 dflags\nbaseRegOffset dflags (DoubleReg 3)       = oFFSET_StgRegTable_rD3 dflags\nbaseRegOffset dflags (DoubleReg 4)       = oFFSET_StgRegTable_rD4 dflags\nbaseRegOffset dflags (DoubleReg 5)       = oFFSET_StgRegTable_rD5 dflags\nbaseRegOffset dflags (DoubleReg 6)       = oFFSET_StgRegTable_rD6 dflags\nbaseRegOffset _      (DoubleReg n)       = panic (\"Registers above D6 are not supported (tried to use D\" ++ show n ++ \")\")\nbaseRegOffset dflags (XmmReg 1)          = oFFSET_StgRegTable_rXMM1 dflags\nbaseRegOffset dflags (XmmReg 2)          = oFFSET_StgRegTable_rXMM2 dflags\nbaseRegOffset dflags (XmmReg 3)          = oFFSET_StgRegTable_rXMM3 dflags\nbaseRegOffset dflags (XmmReg 4)          = oFFSET_StgRegTable_rXMM4 dflags\nbaseRegOffset dflags (XmmReg 5)          = oFFSET_StgRegTable_rXMM5 dflags\nbaseRegOffset dflags (XmmReg 6)          = oFFSET_StgRegTable_rXMM6 dflags\nbaseRegOffset _      (XmmReg n)          = panic (\"Registers above XMM6 are not supported (tried to use XMM\" ++ show n ++ \")\")\nbaseRegOffset dflags (YmmReg 1)          = oFFSET_StgRegTable_rYMM1 dflags\nbaseRegOffset dflags (YmmReg 2)          = oFFSET_StgRegTable_rYMM2 dflags\nbaseRegOffset dflags (YmmReg 3)          = oFFSET_StgRegTable_rYMM3 dflags\nbaseRegOffset dflags (YmmReg 4)          = oFFSET_StgRegTable_rYMM4 dflags\nbaseRegOffset dflags (YmmReg 5)          = oFFSET_StgRegTable_rYMM5 dflags\nbaseRegOffset dflags (YmmReg 6)          = oFFSET_StgRegTable_rYMM6 dflags\nbaseRegOffset _      (YmmReg n)          = panic (\"Registers above YMM6 are not supported (tried to use YMM\" ++ show n ++ \")\")\nbaseRegOffset dflags (ZmmReg 1)          = oFFSET_StgRegTable_rZMM1 dflags\nbaseRegOffset dflags (ZmmReg 2)          = oFFSET_StgRegTable_rZMM2 dflags\nbaseRegOffset dflags (ZmmReg 3)          = oFFSET_StgRegTable_rZMM3 dflags\nbaseRegOffset dflags (ZmmReg 4)          = oFFSET_StgRegTable_rZMM4 dflags\nbaseRegOffset dflags (ZmmReg 5)          = oFFSET_StgRegTable_rZMM5 dflags\nbaseRegOffset dflags (ZmmReg 6)          = oFFSET_StgRegTable_rZMM6 dflags\nbaseRegOffset _      (ZmmReg n)          = panic (\"Registers above ZMM6 are not supported (tried to use ZMM\" ++ show n ++ \")\")\nbaseRegOffset dflags Sp                  = oFFSET_StgRegTable_rSp dflags\nbaseRegOffset dflags SpLim               = oFFSET_StgRegTable_rSpLim dflags\nbaseRegOffset dflags (LongReg 1)         = oFFSET_StgRegTable_rL1 dflags\nbaseRegOffset _      (LongReg n)         = panic (\"Registers above L1 are not supported (tried to use L\" ++ show n ++ \")\")\nbaseRegOffset dflags Hp                  = oFFSET_StgRegTable_rHp dflags\nbaseRegOffset dflags HpLim               = oFFSET_StgRegTable_rHpLim dflags\nbaseRegOffset dflags CCCS                = oFFSET_StgRegTable_rCCCS dflags\nbaseRegOffset dflags CurrentTSO          = oFFSET_StgRegTable_rCurrentTSO dflags\nbaseRegOffset dflags CurrentNursery      = oFFSET_StgRegTable_rCurrentNursery dflags\nbaseRegOffset dflags HpAlloc             = oFFSET_StgRegTable_rHpAlloc dflags\nbaseRegOffset dflags EagerBlackholeInfo  = oFFSET_stgEagerBlackholeInfo dflags\nbaseRegOffset dflags GCEnter1            = oFFSET_stgGCEnter1 dflags\nbaseRegOffset dflags GCFun               = oFFSET_stgGCFun dflags\nbaseRegOffset _      BaseReg             = panic \"CgUtils.baseRegOffset:BaseReg\"\nbaseRegOffset _      PicBaseReg          = panic \"CgUtils.baseRegOffset:PicBaseReg\"\nbaseRegOffset _      MachSp              = panic \"CgUtils.baseRegOffset:MachSp\"\nbaseRegOffset _      UnwindReturnReg     = panic \"CgUtils.baseRegOffset:UnwindReturnReg\"\n\n\n-- -----------------------------------------------------------------------------\n--\n-- STG/Cmm GlobalReg\n--\n-- -----------------------------------------------------------------------------\n\n-- | We map STG registers onto appropriate CmmExprs.  Either they map\n-- to real machine registers or stored as offsets from BaseReg.  Given\n-- a GlobalReg, get_GlobalReg_addr always produces the\n-- register table address for it.\nget_GlobalReg_addr :: DynFlags -> GlobalReg -> CmmExpr\nget_GlobalReg_addr dflags BaseReg = regTableOffset dflags 0\nget_GlobalReg_addr dflags mid\n    = get_Regtable_addr_from_offset dflags\n                                    (globalRegType dflags mid) (baseRegOffset dflags mid)\n\n-- Calculate a literal representing an offset into the register table.\n-- Used when we don't have an actual BaseReg to offset from.\nregTableOffset :: DynFlags -> Int -> CmmExpr\nregTableOffset dflags n =\n  CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r dflags + n))\n\nget_Regtable_addr_from_offset :: DynFlags -> CmmType -> Int -> CmmExpr\nget_Regtable_addr_from_offset dflags _ offset =\n    if haveRegBase (targetPlatform dflags)\n    then CmmRegOff baseReg offset\n    else regTableOffset dflags offset\n\n-- | Fixup global registers so that they assign to locations within the\n-- RegTable if they aren't pinned for the current target.\nfixStgRegisters :: DynFlags -> RawCmmDecl -> RawCmmDecl\nfixStgRegisters _ top@(CmmData _ _) = top\n\nfixStgRegisters dflags (CmmProc info lbl live graph) =\n  let graph' = modifyGraph (mapGraphBlocks (fixStgRegBlock dflags)) graph\n  in CmmProc info lbl live graph'\n\nfixStgRegBlock :: DynFlags -> Block CmmNode e x -> Block CmmNode e x\nfixStgRegBlock dflags block = mapBlock (fixStgRegStmt dflags) block\n\nfixStgRegStmt :: DynFlags -> CmmNode e x -> CmmNode e x\nfixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt\n  where\n    platform = targetPlatform dflags\n\n    fixAssign stmt =\n      case stmt of\n        CmmAssign (CmmGlobal reg) src\n          -- MachSp isn't an STG register; it's merely here for tracking unwind\n          -- information\n          | reg == MachSp -> stmt\n          | otherwise ->\n            let baseAddr = get_GlobalReg_addr dflags reg\n            in case reg `elem` activeStgRegs (targetPlatform dflags) of\n                True  -> CmmAssign (CmmGlobal reg) src\n                False -> CmmStore baseAddr src\n        other_stmt -> other_stmt\n\n    fixExpr expr = case expr of\n        -- MachSp isn't an STG; it's merely here for tracking unwind information\n        CmmReg (CmmGlobal MachSp) -> expr\n        CmmReg (CmmGlobal reg) ->\n            -- Replace register leaves with appropriate StixTrees for\n            -- the given target.  MagicIds which map to a reg on this\n            -- arch are left unchanged.  For the rest, BaseReg is taken\n            -- to mean the address of the reg table in MainCapability,\n            -- and for all others we generate an indirection to its\n            -- location in the register table.\n            case reg `elem` activeStgRegs platform of\n                True  -> expr\n                False ->\n                    let baseAddr = get_GlobalReg_addr dflags reg\n                    in case reg of\n                        BaseReg -> baseAddr\n                        _other  -> CmmLoad baseAddr (globalRegType dflags reg)\n\n        CmmRegOff (CmmGlobal reg) offset ->\n            -- RegOf leaves are just a shorthand form. If the reg maps\n            -- to a real reg, we keep the shorthand, otherwise, we just\n            -- expand it and defer to the above code.\n            case reg `elem` activeStgRegs platform of\n                True  -> expr\n                False -> CmmMachOp (MO_Add (wordWidth dflags)) [\n                                    fixExpr (CmmReg (CmmGlobal reg)),\n                                    CmmLit (CmmInt (fromIntegral offset)\n                                                   (wordWidth dflags))]\n\n        other_expr -> other_expr\n\n", "num_lines": 183}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DataKinds #-}\n\n-----------------------------------------------------------------------------\n--\n-- Stg to C-- code generation\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmm ( codeGen ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude as Prelude\n\nimport StgCmmProf (initCostCentres, ldvEnter)\nimport StgCmmMonad\nimport StgCmmEnv\nimport StgCmmBind\nimport StgCmmCon\nimport StgCmmLayout\nimport StgCmmUtils\nimport StgCmmClosure\nimport StgCmmHpc\nimport StgCmmTicky\n\nimport Cmm\nimport CmmUtils\nimport CLabel\n\nimport StgSyn\nimport DynFlags\n\nimport HscTypes\nimport CostCentre\nimport Id\nimport IdInfo\nimport RepType\nimport DataCon\nimport TyCon\nimport Module\nimport Outputable\nimport Stream\nimport BasicTypes\nimport VarSet ( isEmptyDVarSet )\n\nimport OrdList\nimport MkGraph\n\nimport Data.IORef\nimport Control.Monad (when,void)\nimport Util\n\ncodeGen :: DynFlags\n        -> Module\n        -> [TyCon]\n        -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.\n        -> [CgStgTopBinding]           -- Bindings to convert\n        -> HpcInfo\n        -> Stream IO CmmGroup ()       -- Output as a stream, so codegen can\n                                       -- be interleaved with output\n\ncodeGen dflags this_mod data_tycons\n        cost_centre_info stg_binds hpc_info\n  = do  {     -- cg: run the code generator, and yield the resulting CmmGroup\n              -- Using an IORef to store the state is a bit crude, but otherwise\n              -- we would need to add a state monad layer.\n        ; cgref <- liftIO $ newIORef =<< initC\n        ; let cg :: FCode () -> Stream IO CmmGroup ()\n              cg fcode = do\n                cmm <- liftIO $ do\n                         st <- readIORef cgref\n                         let (a,st') = runC dflags this_mod st (getCmm fcode)\n\n                         -- NB. stub-out cgs_tops and cgs_stmts.  This fixes\n                         -- a big space leak.  DO NOT REMOVE!\n                         writeIORef cgref $! st'{ cgs_tops = nilOL,\n                                                  cgs_stmts = mkNop }\n                         return a\n                yield cmm\n\n               -- Note [codegen-split-init] the cmm_init block must come\n               -- FIRST.  This is because when -split-objs is on we need to\n               -- combine this block with its initialisation routines; see\n               -- Note [pipeline-split-init].\n        ; cg (mkModuleInit cost_centre_info this_mod hpc_info)\n\n        ; mapM_ (cg . cgTopBinding dflags) stg_binds\n\n                -- Put datatype_stuff after code_stuff, because the\n                -- datatype closure table (for enumeration types) to\n                -- (say) PrelBase_True_closure, which is defined in\n                -- code_stuff\n        ; let do_tycon tycon = do\n                -- Generate a table of static closures for an\n                -- enumeration type Note that the closure pointers are\n                -- tagged.\n                 when (isEnumerationTyCon tycon) $ cg (cgEnumerationTyCon tycon)\n                 mapM_ (cg . cgDataCon) (tyConDataCons tycon)\n\n        ; mapM_ do_tycon data_tycons\n        }\n\n---------------------------------------------------------------\n--      Top-level bindings\n---------------------------------------------------------------\n\n{- 'cgTopBinding' is only used for top-level bindings, since they need\nto be allocated statically (not in the heap) and need to be labelled.\nNo unboxed bindings can happen at top level.\n\nIn the code below, the static bindings are accumulated in the\n@MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.\nThis is so that we can write the top level processing in a compositional\nstyle, with the increasing static environment being plumbed as a state\nvariable. -}\n\ncgTopBinding :: DynFlags -> CgStgTopBinding -> FCode ()\ncgTopBinding dflags (StgTopLifted (StgNonRec id rhs))\n  = do  { let (info, fcode) = cgTopRhs dflags NonRecursive id rhs\n        ; fcode\n        ; addBindC info\n        }\n\ncgTopBinding dflags (StgTopLifted (StgRec pairs))\n  = do  { let (bndrs, rhss) = unzip pairs\n        ; let pairs' = zip bndrs rhss\n              r = unzipWith (cgTopRhs dflags Recursive) pairs'\n              (infos, fcodes) = unzip r\n        ; addBindsC infos\n        ; sequence_ fcodes\n        }\n\ncgTopBinding dflags (StgTopStringLit id str)\n  = do  { let label = mkBytesLabel (idName id)\n        ; let (lit, decl) = mkByteStringCLit label str\n        ; emitDecl decl\n        ; addBindC (litIdInfo dflags id mkLFStringLit lit)\n        }\n\ncgTopRhs :: DynFlags -> RecFlag -> Id -> CgStgRhs -> (CgIdInfo, FCode ())\n        -- The Id is passed along for setting up a binding...\n\ncgTopRhs dflags _rec bndr (StgRhsCon _cc con args)\n  = cgTopRhsCon dflags bndr con (assertNonVoidStgArgs args)\n      -- con args are always non-void,\n      -- see Note [Post-unarisation invariants] in UnariseStg\n\ncgTopRhs dflags rec bndr (StgRhsClosure fvs cc upd_flag args body)\n  = ASSERT(isEmptyDVarSet fvs)    -- There should be no free variables\n    cgTopRhsClosure dflags rec bndr cc upd_flag args body\n\n\n---------------------------------------------------------------\n--      Module initialisation code\n---------------------------------------------------------------\n\nmkModuleInit\n        :: CollectedCCs         -- cost centre info\n        -> Module\n        -> HpcInfo\n        -> FCode ()\n\nmkModuleInit cost_centre_info this_mod hpc_info\n  = do  { initHpc this_mod hpc_info\n        ; initCostCentres cost_centre_info\n        }\n\n\n---------------------------------------------------------------\n--      Generating static stuff for algebraic data types\n---------------------------------------------------------------\n\n\ncgEnumerationTyCon :: TyCon -> FCode ()\ncgEnumerationTyCon tycon\n  = do dflags <- getDynFlags\n       emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)\n             [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs)\n                           (tagForCon dflags con)\n             | con <- tyConDataCons tycon]\n\n\ncgDataCon :: DataCon -> FCode ()\n-- Generate the entry code, info tables, and (for niladic constructor)\n-- the static closure, for a constructor.\ncgDataCon data_con\n  = do  { dflags <- getDynFlags\n        ; let\n            (tot_wds, --  #ptr_wds + #nonptr_wds\n             ptr_wds) --  #ptr_wds\n              = mkVirtConstrSizes dflags arg_reps\n\n            nonptr_wds   = tot_wds - ptr_wds\n\n            dyn_info_tbl =\n              mkDataConInfoTable dflags data_con False ptr_wds nonptr_wds\n\n            -- We're generating info tables, so we don't know and care about\n            -- what the actual arguments are. Using () here as the place holder.\n            arg_reps :: [NonVoid PrimRep]\n            arg_reps = [ NonVoid rep_ty\n                       | ty <- dataConRepArgTys data_con\n                       , rep_ty <- typePrimRep ty\n                       , not (isVoidRep rep_ty) ]\n\n        ; emitClosureAndInfoTable dyn_info_tbl NativeDirectCall [] $\n            -- NB: the closure pointer is assumed *untagged* on\n            -- entry to a constructor.  If the pointer is tagged,\n            -- then we should not be entering it.  This assumption\n            -- is used in ldvEnter and when tagging the pointer to\n            -- return it.\n            -- NB 2: We don't set CC when entering data (WDP 94/06)\n            do { tickyEnterDynCon\n               ; ldvEnter (CmmReg nodeReg)\n               ; tickyReturnOldCon (length arg_reps)\n               ; void $ emitReturn [cmmOffsetB dflags (CmmReg nodeReg) (tagForCon dflags data_con)]\n               }\n                    -- The case continuation code expects a tagged pointer\n        }\n", "num_lines": 223}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Argument representations used in StgCmmLayout.\n--\n-- (c) The University of Glasgow 2013\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmArgRep (\n        ArgRep(..), toArgRep, argRepSizeW,\n\n        argRepString, isNonV, idArgRep,\n\n        slowCallPattern,\n\n        ) where\n\nimport GhcPrelude\n\nimport StgCmmClosure    ( idPrimRep )\n\nimport SMRep            ( WordOff )\nimport Id               ( Id )\nimport TyCon            ( PrimRep(..), primElemRepSizeB )\nimport BasicTypes       ( RepArity )\nimport Constants        ( wORD64_SIZE )\nimport DynFlags\n\nimport Outputable\nimport FastString\n\n-- I extricated this code as this new module in order to avoid a\n-- cyclic dependency between StgCmmLayout and StgCmmTicky.\n--\n-- NSF 18 Feb 2013\n\n-------------------------------------------------------------------------\n--      Classifying arguments: ArgRep\n-------------------------------------------------------------------------\n\n-- ArgRep is re-exported by StgCmmLayout, but only for use in the\n-- byte-code generator which also needs to know about the\n-- classification of arguments.\n\ndata ArgRep = P   -- GC Ptr\n            | N   -- Word-sized non-ptr\n            | L   -- 64-bit non-ptr (long)\n            | V   -- Void\n            | F   -- Float\n            | D   -- Double\n            | V16 -- 16-byte (128-bit) vectors of Float/Double/Int8/Word32/etc.\n            | V32 -- 32-byte (256-bit) vectors of Float/Double/Int8/Word32/etc.\n            | V64 -- 64-byte (512-bit) vectors of Float/Double/Int8/Word32/etc.\ninstance Outputable ArgRep where ppr = text . argRepString\n\nargRepString :: ArgRep -> String\nargRepString P = \"P\"\nargRepString N = \"N\"\nargRepString L = \"L\"\nargRepString V = \"V\"\nargRepString F = \"F\"\nargRepString D = \"D\"\nargRepString V16 = \"V16\"\nargRepString V32 = \"V32\"\nargRepString V64 = \"V64\"\n\ntoArgRep :: PrimRep -> ArgRep\ntoArgRep VoidRep           = V\ntoArgRep LiftedRep         = P\ntoArgRep UnliftedRep       = P\ntoArgRep IntRep            = N\ntoArgRep WordRep           = N\ntoArgRep Int8Rep           = N  -- Gets widened to native word width for calls\ntoArgRep Word8Rep          = N  -- Gets widened to native word width for calls\ntoArgRep Int16Rep          = N  -- Gets widened to native word width for calls\ntoArgRep Word16Rep         = N  -- Gets widened to native word width for calls\ntoArgRep AddrRep           = N\ntoArgRep Int64Rep          = L\ntoArgRep Word64Rep         = L\ntoArgRep FloatRep          = F\ntoArgRep DoubleRep         = D\ntoArgRep (VecRep len elem) = case len*primElemRepSizeB elem of\n                               16 -> V16\n                               32 -> V32\n                               64 -> V64\n                               _  -> error \"toArgRep: bad vector primrep\"\n\nisNonV :: ArgRep -> Bool\nisNonV V = False\nisNonV _ = True\n\nargRepSizeW :: DynFlags -> ArgRep -> WordOff                -- Size in words\nargRepSizeW _      N   = 1\nargRepSizeW _      P   = 1\nargRepSizeW _      F   = 1\nargRepSizeW dflags L   = wORD64_SIZE        `quot` wORD_SIZE dflags\nargRepSizeW dflags D   = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags\nargRepSizeW _      V   = 0\nargRepSizeW dflags V16 = 16                 `quot` wORD_SIZE dflags\nargRepSizeW dflags V32 = 32                 `quot` wORD_SIZE dflags\nargRepSizeW dflags V64 = 64                 `quot` wORD_SIZE dflags\n\nidArgRep :: Id -> ArgRep\nidArgRep = toArgRep . idPrimRep\n\n-- This list of argument patterns should be kept in sync with at least\n-- the following:\n--\n--  * StgCmmLayout.stdPattern maybe to some degree?\n--\n--  * the RTS_RET(stg_ap_*) and RTS_FUN_DECL(stg_ap_*_fast)\n--  declarations in includes/stg/MiscClosures.h\n--\n--  * the SLOW_CALL_*_ctr declarations in includes/stg/Ticky.h,\n--\n--  * the TICK_SLOW_CALL_*() #defines in includes/Cmm.h,\n--\n--  * the PR_CTR(SLOW_CALL_*_ctr) calls in rts/Ticky.c,\n--\n--  * and the SymI_HasProto(stg_ap_*_{ret,info,fast}) calls and\n--  SymI_HasProto(SLOW_CALL_*_ctr) calls in rts/Linker.c\n--\n-- There may be more places that I haven't found; I merely igrep'd for\n-- pppppp and excluded things that seemed ghci-specific.\n--\n-- Also, it seems at the moment that ticky counters with void\n-- arguments will never be bumped, but I'm still declaring those\n-- counters, defensively.\n--\n-- NSF 6 Mar 2013\n\nslowCallPattern :: [ArgRep] -> (FastString, RepArity)\n-- Returns the generic apply function and arity\n--\n-- The first batch of cases match (some) specialised entries\n-- The last group deals exhaustively with the cases for the first argument\n--   (and the zero-argument case)\n--\n-- In 99% of cases this function will match *all* the arguments in one batch\n\nslowCallPattern (P: P: P: P: P: P: _) = (fsLit \"stg_ap_pppppp\", 6)\nslowCallPattern (P: P: P: P: P: _)    = (fsLit \"stg_ap_ppppp\", 5)\nslowCallPattern (P: P: P: P: _)       = (fsLit \"stg_ap_pppp\", 4)\nslowCallPattern (P: P: P: V: _)       = (fsLit \"stg_ap_pppv\", 4)\nslowCallPattern (P: P: P: _)          = (fsLit \"stg_ap_ppp\", 3)\nslowCallPattern (P: P: V: _)          = (fsLit \"stg_ap_ppv\", 3)\nslowCallPattern (P: P: _)             = (fsLit \"stg_ap_pp\", 2)\nslowCallPattern (P: V: _)             = (fsLit \"stg_ap_pv\", 2)\nslowCallPattern (P: _)                = (fsLit \"stg_ap_p\", 1)\nslowCallPattern (V: _)                = (fsLit \"stg_ap_v\", 1)\nslowCallPattern (N: _)                = (fsLit \"stg_ap_n\", 1)\nslowCallPattern (F: _)                = (fsLit \"stg_ap_f\", 1)\nslowCallPattern (D: _)                = (fsLit \"stg_ap_d\", 1)\nslowCallPattern (L: _)                = (fsLit \"stg_ap_l\", 1)\nslowCallPattern (V16: _)              = (fsLit \"stg_ap_v16\", 1)\nslowCallPattern (V32: _)              = (fsLit \"stg_ap_v32\", 1)\nslowCallPattern (V64: _)              = (fsLit \"stg_ap_v64\", 1)\nslowCallPattern []                    = (fsLit \"stg_ap_0\", 0)\n", "num_lines": 159}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Stg to C-- code generation: bindings\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmBind (\n        cgTopRhsClosure,\n        cgBind,\n        emitBlackHoleCode,\n        pushUpdateFrame, emitUpdateFrame\n  ) where\n\nimport GhcPrelude hiding ((<*>))\n\nimport StgCmmExpr\nimport StgCmmMonad\nimport StgCmmEnv\nimport StgCmmCon\nimport StgCmmHeap\nimport StgCmmProf (ldvEnterClosure, enterCostCentreFun, enterCostCentreThunk,\n                   initUpdFrameProf)\nimport StgCmmTicky\nimport StgCmmLayout\nimport StgCmmUtils\nimport StgCmmClosure\nimport StgCmmForeign    (emitPrimCall)\n\nimport MkGraph\nimport CoreSyn          ( AltCon(..), tickishIsCode )\nimport BlockId\nimport SMRep\nimport Cmm\nimport CmmInfo\nimport CmmUtils\nimport CLabel\nimport StgSyn\nimport CostCentre\nimport Id\nimport IdInfo\nimport Name\nimport Module\nimport ListSetOps\nimport Util\nimport VarSet\nimport BasicTypes\nimport Outputable\nimport FastString\nimport DynFlags\n\nimport Control.Monad\n\n------------------------------------------------------------------------\n--              Top-level bindings\n------------------------------------------------------------------------\n\n-- For closures bound at top level, allocate in static space.\n-- They should have no free variables.\n\ncgTopRhsClosure :: DynFlags\n                -> RecFlag              -- member of a recursive group?\n                -> Id\n                -> CostCentreStack      -- Optional cost centre annotation\n                -> UpdateFlag\n                -> [Id]                 -- Args\n                -> CgStgExpr\n                -> (CgIdInfo, FCode ())\n\ncgTopRhsClosure dflags rec id ccs upd_flag args body =\n  let closure_label = mkLocalClosureLabel (idName id) (idCafInfo id)\n      cg_id_info    = litIdInfo dflags id lf_info (CmmLabel closure_label)\n      lf_info       = mkClosureLFInfo dflags id TopLevel [] upd_flag args\n  in (cg_id_info, gen_code dflags lf_info closure_label)\n  where\n  -- special case for a indirection (f = g).  We create an IND_STATIC\n  -- closure pointing directly to the indirectee.  This is exactly\n  -- what the CAF will eventually evaluate to anyway, we're just\n  -- shortcutting the whole process, and generating a lot less code\n  -- (#7308)\n  --\n  -- Note: we omit the optimisation when this binding is part of a\n  -- recursive group, because the optimisation would inhibit the black\n  -- hole detection from working in that case.  Test\n  -- concurrent/should_run/4030 fails, for instance.\n  --\n  gen_code dflags _ closure_label\n    | StgApp f [] <- body, null args, isNonRec rec\n    = do\n         cg_info <- getCgIdInfo f\n         let closure_rep   = mkStaticClosureFields dflags\n                                    indStaticInfoTable ccs MayHaveCafRefs\n                                    [unLit (idInfoToAmode cg_info)]\n         emitDataLits closure_label closure_rep\n         return ()\n\n  gen_code dflags lf_info _closure_label\n   = do { let name = idName id\n        ; mod_name <- getModuleName\n        ; let descr         = closureDescription dflags mod_name name\n              closure_info  = mkClosureInfo dflags True id lf_info 0 0 descr\n\n        -- We don't generate the static closure here, because we might\n        -- want to add references to static closures to it later.  The\n        -- static closure is generated by CmmBuildInfoTables.updInfoSRTs,\n        -- See Note [SRTs], specifically the [FUN] optimisation.\n\n        ; let fv_details :: [(NonVoid Id, ByteOff)]\n              header = if isLFThunk lf_info then ThunkHeader else StdHeader\n              (_, _, fv_details) = mkVirtHeapOffsets dflags header []\n        -- Don't drop the non-void args until the closure info has been made\n        ; forkClosureBody (closureCodeBody True id closure_info ccs\n                                (nonVoidIds args) (length args) body fv_details)\n\n        ; return () }\n\n  unLit (CmmLit l) = l\n  unLit _ = panic \"unLit\"\n\n------------------------------------------------------------------------\n--              Non-top-level bindings\n------------------------------------------------------------------------\n\ncgBind :: CgStgBinding -> FCode ()\ncgBind (StgNonRec name rhs)\n  = do  { (info, fcode) <- cgRhs name rhs\n        ; addBindC info\n        ; init <- fcode\n        ; emit init }\n        -- init cannot be used in body, so slightly better to sink it eagerly\n\ncgBind (StgRec pairs)\n  = do  {  r <- sequence $ unzipWith cgRhs pairs\n        ;  let (id_infos, fcodes) = unzip r\n        ;  addBindsC id_infos\n        ;  (inits, body) <- getCodeR $ sequence fcodes\n        ;  emit (catAGraphs inits <*> body) }\n\n{- Note [cgBind rec]\n\n   Recursive let-bindings are tricky.\n   Consider the following pseudocode:\n\n     let x = \\_ ->  ... y ...\n         y = \\_ ->  ... z ...\n         z = \\_ ->  ... x ...\n     in ...\n\n   For each binding, we need to allocate a closure, and each closure must\n   capture the address of the other closures.\n   We want to generate the following C-- code:\n     // Initialization Code\n     x = hp - 24; // heap address of x's closure\n     y = hp - 40; // heap address of x's closure\n     z = hp - 64; // heap address of x's closure\n     // allocate and initialize x\n     m[hp-8]   = ...\n     m[hp-16]  = y       // the closure for x captures y\n     m[hp-24] = x_info;\n     // allocate and initialize y\n     m[hp-32] = z;       // the closure for y captures z\n     m[hp-40] = y_info;\n     // allocate and initialize z\n     ...\n\n   For each closure, we must generate not only the code to allocate and\n   initialize the closure itself, but also some initialization Code that\n   sets a variable holding the closure pointer.\n\n   We could generate a pair of the (init code, body code), but since\n   the bindings are recursive we also have to initialise the\n   environment with the CgIdInfo for all the bindings before compiling\n   anything.  So we do this in 3 stages:\n\n     1. collect all the CgIdInfos and initialise the environment\n     2. compile each binding into (init, body) code\n     3. emit all the inits, and then all the bodies\n\n   We'd rather not have separate functions to do steps 1 and 2 for\n   each binding, since in pratice they share a lot of code.  So we\n   have just one function, cgRhs, that returns a pair of the CgIdInfo\n   for step 1, and a monadic computation to generate the code in step\n   2.\n\n   The alternative to separating things in this way is to use a\n   fixpoint.  That's what we used to do, but it introduces a\n   maintenance nightmare because there is a subtle dependency on not\n   being too strict everywhere.  Doing things this way means that the\n   FCode monad can be strict, for example.\n -}\n\ncgRhs :: Id\n      -> CgStgRhs\n      -> FCode (\n                 CgIdInfo         -- The info for this binding\n               , FCode CmmAGraph  -- A computation which will generate the\n                                  -- code for the binding, and return an\n                                  -- assignent of the form \"x = Hp - n\"\n                                  -- (see above)\n               )\n\ncgRhs id (StgRhsCon cc con args)\n  = withNewTickyCounterCon (idName id) $\n    buildDynCon id True cc con (assertNonVoidStgArgs args)\n      -- con args are always non-void,\n      -- see Note [Post-unarisation invariants] in UnariseStg\n\n{- See Note [GC recovery] in compiler/codeGen/StgCmmClosure.hs -}\ncgRhs id (StgRhsClosure fvs cc upd_flag args body)\n  = do dflags <- getDynFlags\n       mkRhsClosure dflags id cc (nonVoidIds (dVarSetElems fvs)) upd_flag args body\n\n------------------------------------------------------------------------\n--              Non-constructor right hand sides\n------------------------------------------------------------------------\n\nmkRhsClosure :: DynFlags -> Id -> CostCentreStack\n             -> [NonVoid Id]                    -- Free vars\n             -> UpdateFlag\n             -> [Id]                            -- Args\n             -> CgStgExpr\n             -> FCode (CgIdInfo, FCode CmmAGraph)\n\n{- mkRhsClosure looks for two special forms of the right-hand side:\n        a) selector thunks\n        b) AP thunks\n\nIf neither happens, it just calls mkClosureLFInfo.  You might think\nthat mkClosureLFInfo should do all this, but it seems wrong for the\nlatter to look at the structure of an expression\n\nNote [Selectors]\n~~~~~~~~~~~~~~~~\nWe look at the body of the closure to see if it's a selector---turgid,\nbut nothing deep.  We are looking for a closure of {\\em exactly} the\nform:\n\n...  = [the_fv] \\ u [] ->\n         case the_fv of\n           con a_1 ... a_n -> a_i\n\nNote [Ap thunks]\n~~~~~~~~~~~~~~~~\nA more generic AP thunk of the form\n\n        x = [ x_1...x_n ] \\.. [] -> x_1 ... x_n\n\nA set of these is compiled statically into the RTS, so we just use\nthose.  We could extend the idea to thunks where some of the x_i are\nglobal ids (and hence not free variables), but this would entail\ngenerating a larger thunk.  It might be an option for non-optimising\ncompilation, though.\n\nWe only generate an Ap thunk if all the free variables are pointers,\nfor semi-obvious reasons.\n\n-}\n\n---------- Note [Selectors] ------------------\nmkRhsClosure    dflags bndr _cc\n                [NonVoid the_fv]                -- Just one free var\n                upd_flag                -- Updatable thunk\n                []                      -- A thunk\n                expr\n  | let strip = snd . stripStgTicksTop (not . tickishIsCode)\n  , StgCase (StgApp scrutinee [{-no args-}])\n         _   -- ignore bndr\n         (AlgAlt _)\n         [(DataAlt _, params, sel_expr)] <- strip expr\n  , StgApp selectee [{-no args-}] <- strip sel_expr\n  , the_fv == scrutinee                -- Scrutinee is the only free variable\n\n  , let (_, _, params_w_offsets) = mkVirtConstrOffsets dflags (addIdReps (assertNonVoidIds params))\n                                   -- pattern binders are always non-void,\n                                   -- see Note [Post-unarisation invariants] in UnariseStg\n  , Just the_offset <- assocMaybe params_w_offsets (NonVoid selectee)\n\n  , let offset_into_int = bytesToWordsRoundUp dflags the_offset\n                          - fixedHdrSizeW dflags\n  , offset_into_int <= mAX_SPEC_SELECTEE_SIZE dflags -- Offset is small enough\n  = -- NOT TRUE: ASSERT(is_single_constructor)\n    -- The simplifier may have statically determined that the single alternative\n    -- is the only possible case and eliminated the others, even if there are\n    -- other constructors in the datatype.  It's still ok to make a selector\n    -- thunk in this case, because we *know* which constructor the scrutinee\n    -- will evaluate to.\n    --\n    -- srt is discarded; it must be empty\n    let lf_info = mkSelectorLFInfo bndr offset_into_int (isUpdatable upd_flag)\n    in cgRhsStdThunk bndr lf_info [StgVarArg the_fv]\n\n---------- Note [Ap thunks] ------------------\nmkRhsClosure    dflags bndr _cc\n                fvs\n                upd_flag\n                []                      -- No args; a thunk\n                (StgApp fun_id args)\n\n  -- We are looking for an \"ApThunk\"; see data con ApThunk in StgCmmClosure\n  -- of form (x1 x2 .... xn), where all the xi are locals (not top-level)\n  -- So the xi will all be free variables\n  | args `lengthIs` (n_fvs-1)  -- This happens only if the fun_id and\n                               -- args are all distinct local variables\n                               -- The \"-1\" is for fun_id\n    -- Missed opportunity:   (f x x) is not detected\n  , all (isGcPtrRep . idPrimRep . fromNonVoid) fvs\n  , isUpdatable upd_flag\n  , n_fvs <= mAX_SPEC_AP_SIZE dflags\n  , not (gopt Opt_SccProfilingOn dflags)\n                         -- not when profiling: we don't want to\n                         -- lose information about this particular\n                         -- thunk (e.g. its type) (#949)\n  , idArity fun_id == unknownArity -- don't spoil a known call\n\n          -- Ha! an Ap thunk\n  = cgRhsStdThunk bndr lf_info payload\n\n  where\n    n_fvs   = length fvs\n    lf_info = mkApLFInfo bndr upd_flag n_fvs\n    -- the payload has to be in the correct order, hence we can't\n    -- just use the fvs.\n    payload = StgVarArg fun_id : args\n\n---------- Default case ------------------\nmkRhsClosure dflags bndr cc fvs upd_flag args body\n  = do  { let lf_info = mkClosureLFInfo dflags bndr NotTopLevel fvs upd_flag args\n        ; (id_info, reg) <- rhsIdInfo bndr lf_info\n        ; return (id_info, gen_code lf_info reg) }\n where\n gen_code lf_info reg\n  = do  {       -- LAY OUT THE OBJECT\n        -- If the binder is itself a free variable, then don't store\n        -- it in the closure.  Instead, just bind it to Node on entry.\n        -- NB we can be sure that Node will point to it, because we\n        -- haven't told mkClosureLFInfo about this; so if the binder\n        -- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is*\n        -- stored in the closure itself, so it will make sure that\n        -- Node points to it...\n        ; let   reduced_fvs = filter (NonVoid bndr /=) fvs\n\n        -- MAKE CLOSURE INFO FOR THIS CLOSURE\n        ; mod_name <- getModuleName\n        ; dflags <- getDynFlags\n        ; let   name  = idName bndr\n                descr = closureDescription dflags mod_name name\n                fv_details :: [(NonVoid Id, ByteOff)]\n                header = if isLFThunk lf_info then ThunkHeader else StdHeader\n                (tot_wds, ptr_wds, fv_details)\n                   = mkVirtHeapOffsets dflags header (addIdReps reduced_fvs)\n                closure_info = mkClosureInfo dflags False       -- Not static\n                                             bndr lf_info tot_wds ptr_wds\n                                             descr\n\n        -- BUILD ITS INFO TABLE AND CODE\n        ; forkClosureBody $\n                -- forkClosureBody: (a) ensure that bindings in here are not seen elsewhere\n                --                  (b) ignore Sequel from context; use empty Sequel\n                -- And compile the body\n                closureCodeBody False bndr closure_info cc (nonVoidIds args)\n                                (length args) body fv_details\n\n        -- BUILD THE OBJECT\n--      ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body\n        ; let use_cc = cccsExpr; blame_cc = cccsExpr\n        ; emit (mkComment $ mkFastString \"calling allocDynClosure\")\n        ; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)\n        ; let info_tbl = mkCmmInfo closure_info bndr currentCCS\n        ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info use_cc blame_cc\n                                         (map toVarArg fv_details)\n\n        -- RETURN\n        ; return (mkRhsInit dflags reg lf_info hp_plus_n) }\n\n-------------------------\ncgRhsStdThunk\n        :: Id\n        -> LambdaFormInfo\n        -> [StgArg]             -- payload\n        -> FCode (CgIdInfo, FCode CmmAGraph)\n\ncgRhsStdThunk bndr lf_info payload\n = do  { (id_info, reg) <- rhsIdInfo bndr lf_info\n       ; return (id_info, gen_code reg)\n       }\n where\n gen_code reg  -- AHA!  A STANDARD-FORM THUNK\n  = withNewTickyCounterStdThunk (lfUpdatable lf_info) (idName bndr) $\n    do\n  {     -- LAY OUT THE OBJECT\n    mod_name <- getModuleName\n  ; dflags <- getDynFlags\n  ; let header = if isLFThunk lf_info then ThunkHeader else StdHeader\n        (tot_wds, ptr_wds, payload_w_offsets)\n            = mkVirtHeapOffsets dflags header\n                (addArgReps (nonVoidStgArgs payload))\n\n        descr = closureDescription dflags mod_name (idName bndr)\n        closure_info = mkClosureInfo dflags False       -- Not static\n                                     bndr lf_info tot_wds ptr_wds\n                                     descr\n\n--  ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body\n  ; let use_cc = cccsExpr; blame_cc = cccsExpr\n\n\n        -- BUILD THE OBJECT\n  ; let info_tbl = mkCmmInfo closure_info bndr currentCCS\n  ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info\n                                   use_cc blame_cc payload_w_offsets\n\n        -- RETURN\n  ; return (mkRhsInit dflags reg lf_info hp_plus_n) }\n\n\nmkClosureLFInfo :: DynFlags\n                -> Id           -- The binder\n                -> TopLevelFlag -- True of top level\n                -> [NonVoid Id] -- Free vars\n                -> UpdateFlag   -- Update flag\n                -> [Id]         -- Args\n                -> LambdaFormInfo\nmkClosureLFInfo dflags bndr top fvs upd_flag args\n  | null args =\n        mkLFThunk (idType bndr) top (map fromNonVoid fvs) upd_flag\n  | otherwise =\n        mkLFReEntrant top (map fromNonVoid fvs) args (mkArgDescr dflags args)\n\n\n------------------------------------------------------------------------\n--              The code for closures\n------------------------------------------------------------------------\n\nclosureCodeBody :: Bool            -- whether this is a top-level binding\n                -> Id              -- the closure's name\n                -> ClosureInfo     -- Lots of information about this closure\n                -> CostCentreStack -- Optional cost centre attached to closure\n                -> [NonVoid Id]    -- incoming args to the closure\n                -> Int             -- arity, including void args\n                -> CgStgExpr\n                -> [(NonVoid Id, ByteOff)] -- the closure's free vars\n                -> FCode ()\n\n{- There are two main cases for the code for closures.\n\n* If there are *no arguments*, then the closure is a thunk, and not in\n  normal form. So it should set up an update frame (if it is\n  shared). NB: Thunks cannot have a primitive type!\n\n* If there is *at least one* argument, then this closure is in\n  normal form, so there is no need to set up an update frame.\n-}\n\nclosureCodeBody top_lvl bndr cl_info cc _args arity body fv_details\n  | arity == 0 -- No args i.e. thunk\n  = withNewTickyCounterThunk\n        (isStaticClosure cl_info)\n        (closureUpdReqd cl_info)\n        (closureName cl_info) $\n    emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl [] $\n      \\(_, node, _) -> thunkCode cl_info fv_details cc node arity body\n   where\n     lf_info  = closureLFInfo cl_info\n     info_tbl = mkCmmInfo cl_info bndr cc\n\nclosureCodeBody top_lvl bndr cl_info cc args arity body fv_details\n  = -- Note: args may be [], if all args are Void\n    withNewTickyCounterFun\n        (closureSingleEntry cl_info)\n        (closureName cl_info)\n        args $ do {\n\n        ; let\n             lf_info  = closureLFInfo cl_info\n             info_tbl = mkCmmInfo cl_info bndr cc\n\n        -- Emit the main entry code\n        ; emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args $\n            \\(_offset, node, arg_regs) -> do\n                -- Emit slow-entry code (for entering a closure through a PAP)\n                { mkSlowEntryCode bndr cl_info arg_regs\n                ; dflags <- getDynFlags\n                ; let node_points = nodeMustPointToIt dflags lf_info\n                      node' = if node_points then Just node else Nothing\n                ; loop_header_id <- newBlockId\n                -- Extend reader monad with information that\n                -- self-recursive tail calls can be optimized into local\n                -- jumps. See Note [Self-recursive tail calls] in StgCmmExpr.\n                ; withSelfLoop (bndr, loop_header_id, arg_regs) $ do\n                {\n                -- Main payload\n                ; entryHeapCheck cl_info node' arity arg_regs $ do\n                { -- emit LDV code when profiling\n                  when node_points (ldvEnterClosure cl_info (CmmLocal node))\n                -- ticky after heap check to avoid double counting\n                ; tickyEnterFun cl_info\n                ; enterCostCentreFun cc\n                    (CmmMachOp (mo_wordSub dflags)\n                         [ CmmReg (CmmLocal node) -- See [NodeReg clobbered with loopification]\n                         , mkIntExpr dflags (funTag dflags cl_info) ])\n                ; fv_bindings <- mapM bind_fv fv_details\n                -- Load free vars out of closure *after*\n                -- heap check, to reduce live vars over check\n                ; when node_points $ load_fvs node lf_info fv_bindings\n                ; void $ cgExpr body\n                }}}\n\n  }\n\n-- Note [NodeReg clobbered with loopification]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Previously we used to pass nodeReg (aka R1) here. With profiling, upon\n-- entering a closure, enterFunCCS was called with R1 passed to it. But since R1\n-- may get clobbered inside the body of a closure, and since a self-recursive\n-- tail call does not restore R1, a subsequent call to enterFunCCS received a\n-- possibly bogus value from R1. The solution is to not pass nodeReg (aka R1) to\n-- enterFunCCS. Instead, we pass node, the callee-saved temporary that stores\n-- the original value of R1. This way R1 may get modified but loopification will\n-- not care.\n\n-- A function closure pointer may be tagged, so we\n-- must take it into account when accessing the free variables.\nbind_fv :: (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff)\nbind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) }\n\nload_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode ()\nload_fvs node lf_info = mapM_ (\\ (reg, off) ->\n   do dflags <- getDynFlags\n      let tag = lfDynTag dflags lf_info\n      emit $ mkTaggedObjectLoad dflags reg node off tag)\n\n-----------------------------------------\n-- The \"slow entry\" code for a function.  This entry point takes its\n-- arguments on the stack.  It loads the arguments into registers\n-- according to the calling convention, and jumps to the function's\n-- normal entry point.  The function's closure is assumed to be in\n-- R1/node.\n--\n-- The slow entry point is used for unknown calls: eg. stg_PAP_entry\n\nmkSlowEntryCode :: Id -> ClosureInfo -> [LocalReg] -> FCode ()\n-- If this function doesn't have a specialised ArgDescr, we need\n-- to generate the function's arg bitmap and slow-entry code.\n-- Here, we emit the slow-entry code.\nmkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'\n  | Just (_, ArgGen _) <- closureFunInfo cl_info\n  = do dflags <- getDynFlags\n       let node = idToReg dflags (NonVoid bndr)\n           slow_lbl = closureSlowEntryLabel  cl_info\n           fast_lbl = closureLocalEntryLabel dflags cl_info\n           -- mkDirectJump does not clobber `Node' containing function closure\n           jump = mkJump dflags NativeNodeCall\n                                (mkLblExpr fast_lbl)\n                                (map (CmmReg . CmmLocal) (node : arg_regs))\n                                (initUpdFrameOff dflags)\n       tscope <- getTickScope\n       emitProcWithConvention Slow Nothing slow_lbl\n         (node : arg_regs) (jump, tscope)\n  | otherwise = return ()\n\n-----------------------------------------\nthunkCode :: ClosureInfo -> [(NonVoid Id, ByteOff)] -> CostCentreStack\n          -> LocalReg -> Int -> CgStgExpr -> FCode ()\nthunkCode cl_info fv_details _cc node arity body\n  = do { dflags <- getDynFlags\n       ; let node_points = nodeMustPointToIt dflags (closureLFInfo cl_info)\n             node'       = if node_points then Just node else Nothing\n        ; ldvEnterClosure cl_info (CmmLocal node) -- NB: Node always points when profiling\n\n        -- Heap overflow check\n        ; entryHeapCheck cl_info node' arity [] $ do\n        { -- Overwrite with black hole if necessary\n          -- but *after* the heap-overflow check\n        ; tickyEnterThunk cl_info\n        ; when (blackHoleOnEntry cl_info && node_points)\n                (blackHoleIt node)\n\n          -- Push update frame\n        ; setupUpdate cl_info node $\n            -- We only enter cc after setting up update so\n            -- that cc of enclosing scope will be recorded\n            -- in update frame CAF/DICT functions will be\n            -- subsumed by this enclosing cc\n            do { enterCostCentreThunk (CmmReg nodeReg)\n               ; let lf_info = closureLFInfo cl_info\n               ; fv_bindings <- mapM bind_fv fv_details\n               ; load_fvs node lf_info fv_bindings\n               ; void $ cgExpr body }}}\n\n\n------------------------------------------------------------------------\n--              Update and black-hole wrappers\n------------------------------------------------------------------------\n\nblackHoleIt :: LocalReg -> FCode ()\n-- Only called for closures with no args\n-- Node points to the closure\nblackHoleIt node_reg\n  = emitBlackHoleCode (CmmReg (CmmLocal node_reg))\n\nemitBlackHoleCode :: CmmExpr -> FCode ()\nemitBlackHoleCode node = do\n  dflags <- getDynFlags\n\n  -- Eager blackholing is normally disabled, but can be turned on with\n  -- -feager-blackholing.  When it is on, we replace the info pointer\n  -- of the thunk with stg_EAGER_BLACKHOLE_info on entry.\n\n  -- If we wanted to do eager blackholing with slop filling, we'd need\n  -- to do it at the *end* of a basic block, otherwise we overwrite\n  -- the free variables in the thunk that we still need.  We have a\n  -- patch for this from Andy Cheadle, but not incorporated yet. --SDM\n  -- [6/2004]\n  --\n  -- Previously, eager blackholing was enabled when ticky-ticky was\n  -- on. But it didn't work, and it wasn't strictly necessary to bring\n  -- back minimal ticky-ticky, so now EAGER_BLACKHOLING is\n  -- unconditionally disabled. -- krc 1/2007\n\n  -- Note the eager-blackholing check is here rather than in blackHoleOnEntry,\n  -- because emitBlackHoleCode is called from CmmParse.\n\n  let  eager_blackholing =  not (gopt Opt_SccProfilingOn dflags)\n                         && gopt Opt_EagerBlackHoling dflags\n             -- Profiling needs slop filling (to support LDV\n             -- profiling), so currently eager blackholing doesn't\n             -- work with profiling.\n\n  when eager_blackholing $ do\n    emitStore (cmmOffsetW dflags node (fixedHdrSizeW dflags)) currentTSOExpr\n    emitPrimCall [] MO_WriteBarrier []\n    emitStore node (CmmReg (CmmGlobal EagerBlackholeInfo))\n\nsetupUpdate :: ClosureInfo -> LocalReg -> FCode () -> FCode ()\n        -- Nota Bene: this function does not change Node (even if it's a CAF),\n        -- so that the cost centre in the original closure can still be\n        -- extracted by a subsequent enterCostCentre\nsetupUpdate closure_info node body\n  | not (lfUpdatable (closureLFInfo closure_info))\n  = body\n\n  | not (isStaticClosure closure_info)\n  = if not (closureUpdReqd closure_info)\n      then do tickyUpdateFrameOmitted; body\n      else do\n          tickyPushUpdateFrame\n          dflags <- getDynFlags\n          let\n              bh = blackHoleOnEntry closure_info &&\n                   not (gopt Opt_SccProfilingOn dflags) &&\n                   gopt Opt_EagerBlackHoling dflags\n\n              lbl | bh        = mkBHUpdInfoLabel\n                  | otherwise = mkUpdInfoLabel\n\n          pushUpdateFrame lbl (CmmReg (CmmLocal node)) body\n\n  | otherwise   -- A static closure\n  = do  { tickyUpdateBhCaf closure_info\n\n        ; if closureUpdReqd closure_info\n          then do       -- Blackhole the (updatable) CAF:\n                { upd_closure <- link_caf node True\n                ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body }\n          else do {tickyUpdateFrameOmitted; body}\n    }\n\n-----------------------------------------------------------------------------\n-- Setting up update frames\n\n-- Push the update frame on the stack in the Entry area,\n-- leaving room for the return address that is already\n-- at the old end of the area.\n--\npushUpdateFrame :: CLabel -> CmmExpr -> FCode () -> FCode ()\npushUpdateFrame lbl updatee body\n  = do\n       updfr  <- getUpdFrameOff\n       dflags <- getDynFlags\n       let\n           hdr         = fixedHdrSize dflags\n           frame       = updfr + hdr + sIZEOF_StgUpdateFrame_NoHdr dflags\n       --\n       emitUpdateFrame dflags (CmmStackSlot Old frame) lbl updatee\n       withUpdFrameOff frame body\n\nemitUpdateFrame :: DynFlags -> CmmExpr -> CLabel -> CmmExpr -> FCode ()\nemitUpdateFrame dflags frame lbl updatee = do\n  let\n           hdr         = fixedHdrSize dflags\n           off_updatee = hdr + oFFSET_StgUpdateFrame_updatee dflags\n  --\n  emitStore frame (mkLblExpr lbl)\n  emitStore (cmmOffset dflags frame off_updatee) updatee\n  initUpdFrameProf frame\n\n-----------------------------------------------------------------------------\n-- Entering a CAF\n--\n-- See Note [CAF management] in rts/sm/Storage.c\n\nlink_caf :: LocalReg           -- pointer to the closure\n         -> Bool               -- True <=> updatable, False <=> single-entry\n         -> FCode CmmExpr      -- Returns amode for closure to be updated\n-- This function returns the address of the black hole, so it can be\n-- updated with the new value when available.\nlink_caf node _is_upd = do\n  { dflags <- getDynFlags\n        -- Call the RTS function newCAF, returning the newly-allocated\n        -- blackhole indirection closure\n  ; let newCAF_lbl = mkForeignLabel (fsLit \"newCAF\") Nothing\n                                    ForeignLabelInExternalPackage IsFunction\n  ; bh <- newTemp (bWord dflags)\n  ; emitRtsCallGen [(bh,AddrHint)] newCAF_lbl\n      [ (baseExpr,  AddrHint),\n        (CmmReg (CmmLocal node), AddrHint) ]\n      False\n\n  -- see Note [atomic CAF entry] in rts/sm/Storage.c\n  ; updfr  <- getUpdFrameOff\n  ; let target = entryCode dflags (closureInfoPtr dflags (CmmReg (CmmLocal node)))\n  ; emit =<< mkCmmIfThen\n      (cmmEqWord dflags (CmmReg (CmmLocal bh)) (zeroExpr dflags))\n        -- re-enter the CAF\n       (mkJump dflags NativeNodeCall target [] updfr)\n\n  ; return (CmmReg (CmmLocal bh)) }\n\n------------------------------------------------------------------------\n--              Profiling\n------------------------------------------------------------------------\n\n-- For \"global\" data constructors the description is simply occurrence\n-- name of the data constructor itself.  Otherwise it is determined by\n-- @closureDescription@ from the let binding information.\n\nclosureDescription :: DynFlags\n           -> Module            -- Module\n                   -> Name              -- Id of closure binding\n                   -> String\n        -- Not called for StgRhsCon which have global info tables built in\n        -- CgConTbls.hs with a description generated from the data constructor\nclosureDescription dflags mod_name name\n  = showSDocDump dflags (char '<' <>\n                    (if isExternalName name\n                      then ppr name -- ppr will include the module name prefix\n                      else pprModule mod_name <> char '.' <> ppr name) <>\n                    char '>')\n   -- showSDocDump, because we want to see the unique on the Name.\n", "num_lines": 752}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, RecordWildCards #-}\n\n-----------------------------------------------------------------------------\n--\n-- Stg to C-- code generation:\n--\n-- The types   LambdaFormInfo\n--             ClosureInfo\n--\n-- Nothing monadic in here!\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmClosure (\n        DynTag,  tagForCon, isSmallFamily,\n\n        idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,\n        argPrimRep,\n\n        NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs,\n        assertNonVoidIds, assertNonVoidStgArgs,\n\n        -- * LambdaFormInfo\n        LambdaFormInfo,         -- Abstract\n        StandardFormInfo,        -- ...ditto...\n        mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,\n        mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,\n        mkLFStringLit,\n        lfDynTag,\n        isLFThunk, isLFReEntrant, lfUpdatable,\n\n        -- * Used by other modules\n        CgLoc(..), SelfLoopInfo, CallMethod(..),\n        nodeMustPointToIt, isKnownFun, funTag, tagForArity, getCallMethod,\n\n        -- * ClosureInfo\n        ClosureInfo,\n        mkClosureInfo,\n        mkCmmInfo,\n\n        -- ** Inspection\n        closureLFInfo, closureName,\n\n        -- ** Labels\n        -- These just need the info table label\n        closureInfoLabel, staticClosureLabel,\n        closureSlowEntryLabel, closureLocalEntryLabel,\n\n        -- ** Predicates\n        -- These are really just functions on LambdaFormInfo\n        closureUpdReqd, closureSingleEntry,\n        closureReEntrant, closureFunInfo,\n        isToplevClosure,\n\n        blackHoleOnEntry,  -- Needs LambdaFormInfo and SMRep\n        isStaticClosure,   -- Needs SMPre\n\n        -- * InfoTables\n        mkDataConInfoTable,\n        cafBlackHoleInfoTable,\n        indStaticInfoTable,\n        staticClosureNeedsLink,\n    ) where\n\n#include \"../includes/MachDeps.h\"\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport StgSyn\nimport SMRep\nimport Cmm\nimport PprCmmExpr()\n\nimport CostCentre\nimport BlockId\nimport CLabel\nimport Id\nimport IdInfo\nimport DataCon\nimport Name\nimport Type\nimport TyCoRep\nimport TcType\nimport TyCon\nimport RepType\nimport BasicTypes\nimport Outputable\nimport DynFlags\nimport Util\n\nimport Data.Coerce (coerce)\nimport qualified Data.ByteString.Char8 as BS8\n\n-----------------------------------------------------------------------------\n--                Data types and synonyms\n-----------------------------------------------------------------------------\n\n-- These data types are mostly used by other modules, especially StgCmmMonad,\n-- but we define them here because some functions in this module need to\n-- have access to them as well\n\ndata CgLoc\n  = CmmLoc CmmExpr      -- A stable CmmExpr; that is, one not mentioning\n                        -- Hp, so that it remains valid across calls\n\n  | LneLoc BlockId [LocalReg]             -- A join point\n        -- A join point (= let-no-escape) should only\n        -- be tail-called, and in a saturated way.\n        -- To tail-call it, assign to these locals,\n        -- and branch to the block id\n\ninstance Outputable CgLoc where\n  ppr (CmmLoc e)    = text \"cmm\" <+> ppr e\n  ppr (LneLoc b rs) = text \"lne\" <+> ppr b <+> ppr rs\n\ntype SelfLoopInfo = (Id, BlockId, [LocalReg])\n\n-- used by ticky profiling\nisKnownFun :: LambdaFormInfo -> Bool\nisKnownFun LFReEntrant{} = True\nisKnownFun LFLetNoEscape = True\nisKnownFun _             = False\n\n\n-------------------------------------\n--        Non-void types\n-------------------------------------\n-- We frequently need the invariant that an Id or a an argument\n-- is of a non-void type. This type is a witness to the invariant.\n\nnewtype NonVoid a = NonVoid a\n  deriving (Eq, Show)\n\nfromNonVoid :: NonVoid a -> a\nfromNonVoid (NonVoid a) = a\n\ninstance (Outputable a) => Outputable (NonVoid a) where\n  ppr (NonVoid a) = ppr a\n\nnonVoidIds :: [Id] -> [NonVoid Id]\nnonVoidIds ids = [NonVoid id | id <- ids, not (isVoidTy (idType id))]\n\n-- | Used in places where some invariant ensures that all these Ids are\n-- non-void; e.g. constructor field binders in case expressions.\n-- See Note [Post-unarisation invariants] in UnariseStg.\nassertNonVoidIds :: [Id] -> [NonVoid Id]\nassertNonVoidIds ids = ASSERT(not (any (isVoidTy . idType) ids))\n                       coerce ids\n\nnonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]\nnonVoidStgArgs args = [NonVoid arg | arg <- args, not (isVoidTy (stgArgType arg))]\n\n-- | Used in places where some invariant ensures that all these arguments are\n-- non-void; e.g. constructor arguments.\n-- See Note [Post-unarisation invariants] in UnariseStg.\nassertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]\nassertNonVoidStgArgs args = ASSERT(not (any (isVoidTy . stgArgType) args))\n                            coerce args\n\n\n-----------------------------------------------------------------------------\n--                Representations\n-----------------------------------------------------------------------------\n\n-- Why are these here?\n\nidPrimRep :: Id -> PrimRep\nidPrimRep id = typePrimRep1 (idType id)\n    -- NB: typePrimRep1 fails on unboxed tuples,\n    --     but by StgCmm no Ids have unboxed tuple type\n\naddIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)]\naddIdReps = map (\\id -> let id' = fromNonVoid id\n                         in NonVoid (idPrimRep id', id'))\n\naddArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]\naddArgReps = map (\\arg -> let arg' = fromNonVoid arg\n                           in NonVoid (argPrimRep arg', arg'))\n\nargPrimRep :: StgArg -> PrimRep\nargPrimRep arg = typePrimRep1 (stgArgType arg)\n\n\n-----------------------------------------------------------------------------\n--                LambdaFormInfo\n-----------------------------------------------------------------------------\n\n-- Information about an identifier, from the code generator's point of\n-- view.  Every identifier is bound to a LambdaFormInfo in the\n-- environment, which gives the code generator enough info to be able to\n-- tail call or return that identifier.\n\ndata LambdaFormInfo\n  = LFReEntrant         -- Reentrant closure (a function)\n        TopLevelFlag    -- True if top level\n        OneShotInfo\n        !RepArity       -- Arity. Invariant: always > 0\n        !Bool           -- True <=> no fvs\n        ArgDescr        -- Argument descriptor (should really be in ClosureInfo)\n\n  | LFThunk             -- Thunk (zero arity)\n        TopLevelFlag\n        !Bool           -- True <=> no free vars\n        !Bool           -- True <=> updatable (i.e., *not* single-entry)\n        StandardFormInfo\n        !Bool           -- True <=> *might* be a function type\n\n  | LFCon               -- A saturated constructor application\n        DataCon         -- The constructor\n\n  | LFUnknown           -- Used for function arguments and imported things.\n                        -- We know nothing about this closure.\n                        -- Treat like updatable \"LFThunk\"...\n                        -- Imported things which we *do* know something about use\n                        -- one of the other LF constructors (eg LFReEntrant for\n                        -- known functions)\n        !Bool           -- True <=> *might* be a function type\n                        --      The False case is good when we want to enter it,\n                        --        because then we know the entry code will do\n                        --        For a function, the entry code is the fast entry point\n\n  | LFUnlifted          -- A value of unboxed type;\n                        -- always a value, needs evaluation\n\n  | LFLetNoEscape       -- See LetNoEscape module for precise description\n\n\n-------------------------\n-- StandardFormInfo tells whether this thunk has one of\n-- a small number of standard forms\n\ndata StandardFormInfo\n  = NonStandardThunk\n        -- The usual case: not of the standard forms\n\n  | SelectorThunk\n        -- A SelectorThunk is of form\n        --      case x of\n        --           con a1,..,an -> ak\n        -- and the constructor is from a single-constr type.\n       WordOff          -- 0-origin offset of ak within the \"goods\" of\n                        -- constructor (Recall that the a1,...,an may be laid\n                        -- out in the heap in a non-obvious order.)\n\n  | ApThunk\n        -- An ApThunk is of form\n        --        x1 ... xn\n        -- The code for the thunk just pushes x2..xn on the stack and enters x1.\n        -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled\n        -- in the RTS to save space.\n        RepArity                -- Arity, n\n\n\n------------------------------------------------------\n--                Building LambdaFormInfo\n------------------------------------------------------\n\nmkLFArgument :: Id -> LambdaFormInfo\nmkLFArgument id\n  | isUnliftedType ty      = LFUnlifted\n  | might_be_a_function ty = LFUnknown True\n  | otherwise              = LFUnknown False\n  where\n    ty = idType id\n\n-------------\nmkLFLetNoEscape :: LambdaFormInfo\nmkLFLetNoEscape = LFLetNoEscape\n\n-------------\nmkLFReEntrant :: TopLevelFlag    -- True of top level\n              -> [Id]            -- Free vars\n              -> [Id]            -- Args\n              -> ArgDescr        -- Argument descriptor\n              -> LambdaFormInfo\n\nmkLFReEntrant _ _ [] _\n  = pprPanic \"mkLFReEntrant\" empty\nmkLFReEntrant top fvs args arg_descr\n  = LFReEntrant top os_info (length args) (null fvs) arg_descr\n  where os_info = idOneShotInfo (head args)\n\n-------------\nmkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo\nmkLFThunk thunk_ty top fvs upd_flag\n  = ASSERT( not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty) )\n    LFThunk top (null fvs)\n            (isUpdatable upd_flag)\n            NonStandardThunk\n            (might_be_a_function thunk_ty)\n\n--------------\nmight_be_a_function :: Type -> Bool\n-- Return False only if we are *sure* it's a data type\n-- Look through newtypes etc as much as poss\nmight_be_a_function ty\n  | [LiftedRep] <- typePrimRep ty\n  , Just tc <- tyConAppTyCon_maybe (unwrapType ty)\n  , isDataTyCon tc\n  = False\n  | otherwise\n  = True\n\n-------------\nmkConLFInfo :: DataCon -> LambdaFormInfo\nmkConLFInfo con = LFCon con\n\n-------------\nmkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo\nmkSelectorLFInfo id offset updatable\n  = LFThunk NotTopLevel False updatable (SelectorThunk offset)\n        (might_be_a_function (idType id))\n\n-------------\nmkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo\nmkApLFInfo id upd_flag arity\n  = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)\n        (might_be_a_function (idType id))\n\n-------------\nmkLFImported :: Id -> LambdaFormInfo\nmkLFImported id\n  | Just con <- isDataConWorkId_maybe id\n  , isNullaryRepDataCon con\n  = LFCon con   -- An imported nullary constructor\n                -- We assume that the constructor is evaluated so that\n                -- the id really does point directly to the constructor\n\n  | arity > 0\n  = LFReEntrant TopLevel noOneShotInfo arity True (panic \"arg_descr\")\n\n  | otherwise\n  = mkLFArgument id -- Not sure of exact arity\n  where\n    arity = idFunRepArity id\n\n-------------\nmkLFStringLit :: LambdaFormInfo\nmkLFStringLit = LFUnlifted\n\n-----------------------------------------------------\n--                Dynamic pointer tagging\n-----------------------------------------------------\n\ntype DynTag = Int       -- The tag on a *pointer*\n                        -- (from the dynamic-tagging paper)\n\n-- Note [Data constructor dynamic tags]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- The family size of a data type (the number of constructors\n-- or the arity of a function) can be either:\n--    * small, if the family size < 2**tag_bits\n--    * big, otherwise.\n--\n-- Small families can have the constructor tag in the tag bits.\n-- Big families only use the tag value 1 to represent evaluatedness.\n-- We don't have very many tag bits: for example, we have 2 bits on\n-- x86-32 and 3 bits on x86-64.\n\nisSmallFamily :: DynFlags -> Int -> Bool\nisSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags\n\ntagForCon :: DynFlags -> DataCon -> DynTag\ntagForCon dflags con\n  | isSmallFamily dflags fam_size = con_tag\n  | otherwise                     = 1\n  where\n    con_tag  = dataConTag con -- NB: 1-indexed\n    fam_size = tyConFamilySize (dataConTyCon con)\n\ntagForArity :: DynFlags -> RepArity -> DynTag\ntagForArity dflags arity\n | isSmallFamily dflags arity = arity\n | otherwise                  = 0\n\nlfDynTag :: DynFlags -> LambdaFormInfo -> DynTag\n-- Return the tag in the low order bits of a variable bound\n-- to this LambdaForm\nlfDynTag dflags (LFCon con)                 = tagForCon dflags con\nlfDynTag dflags (LFReEntrant _ _ arity _ _) = tagForArity dflags arity\nlfDynTag _      _other                      = 0\n\n\n-----------------------------------------------------------------------------\n--                Observing LambdaFormInfo\n-----------------------------------------------------------------------------\n\n------------\nisLFThunk :: LambdaFormInfo -> Bool\nisLFThunk (LFThunk {})  = True\nisLFThunk _ = False\n\nisLFReEntrant :: LambdaFormInfo -> Bool\nisLFReEntrant (LFReEntrant {}) = True\nisLFReEntrant _                = False\n\n-----------------------------------------------------------------------------\n--                Choosing SM reps\n-----------------------------------------------------------------------------\n\nlfClosureType :: LambdaFormInfo -> ClosureTypeInfo\nlfClosureType (LFReEntrant _ _ arity _ argd) = Fun arity argd\nlfClosureType (LFCon con)                    = Constr (dataConTagZ con)\n                                                      (dataConIdentity con)\nlfClosureType (LFThunk _ _ _ is_sel _)       = thunkClosureType is_sel\nlfClosureType _                              = panic \"lfClosureType\"\n\nthunkClosureType :: StandardFormInfo -> ClosureTypeInfo\nthunkClosureType (SelectorThunk off) = ThunkSelector off\nthunkClosureType _                   = Thunk\n\n-- We *do* get non-updatable top-level thunks sometimes.  eg. f = g\n-- gets compiled to a jump to g (if g has non-zero arity), instead of\n-- messing around with update frames and PAPs.  We set the closure type\n-- to FUN_STATIC in this case.\n\n-----------------------------------------------------------------------------\n--                nodeMustPointToIt\n-----------------------------------------------------------------------------\n\nnodeMustPointToIt :: DynFlags -> LambdaFormInfo -> Bool\n-- If nodeMustPointToIt is true, then the entry convention for\n-- this closure has R1 (the \"Node\" register) pointing to the\n-- closure itself --- the \"self\" argument\n\nnodeMustPointToIt _ (LFReEntrant top _ _ no_fvs _)\n  =  not no_fvs          -- Certainly if it has fvs we need to point to it\n  || isNotTopLevel top   -- See Note [GC recovery]\n        -- For lex_profiling we also access the cost centre for a\n        -- non-inherited (i.e. non-top-level) function.\n        -- The isNotTopLevel test above ensures this is ok.\n\nnodeMustPointToIt dflags (LFThunk top no_fvs updatable NonStandardThunk _)\n  =  not no_fvs            -- Self parameter\n  || isNotTopLevel top     -- Note [GC recovery]\n  || updatable             -- Need to push update frame\n  || gopt Opt_SccProfilingOn dflags\n          -- For the non-updatable (single-entry case):\n          --\n          -- True if has fvs (in which case we need access to them, and we\n          --                    should black-hole it)\n          -- or profiling (in which case we need to recover the cost centre\n          --                 from inside it)  ToDo: do we need this even for\n          --                                    top-level thunks? If not,\n          --                                    isNotTopLevel subsumes this\n\nnodeMustPointToIt _ (LFThunk {})        -- Node must point to a standard-form thunk\n  = True\n\nnodeMustPointToIt _ (LFCon _) = True\n\n        -- Strictly speaking, the above two don't need Node to point\n        -- to it if the arity = 0.  But this is a *really* unlikely\n        -- situation.  If we know it's nil (say) and we are entering\n        -- it. Eg: let x = [] in x then we will certainly have inlined\n        -- x, since nil is a simple atom.  So we gain little by not\n        -- having Node point to known zero-arity things.  On the other\n        -- hand, we do lose something; Patrick's code for figuring out\n        -- when something has been updated but not entered relies on\n        -- having Node point to the result of an update.  SLPJ\n        -- 27/11/92.\n\nnodeMustPointToIt _ (LFUnknown _)   = True\nnodeMustPointToIt _ LFUnlifted      = False\nnodeMustPointToIt _ LFLetNoEscape   = False\n\n{- Note [GC recovery]\n~~~~~~~~~~~~~~~~~~~~~\nIf we a have a local let-binding (function or thunk)\n   let f = <body> in ...\nAND <body> allocates, then the heap-overflow check needs to know how\nto re-start the evaluation.  It uses the \"self\" pointer to do this.\nSo even if there are no free variables in <body>, we still make\nnodeMustPointToIt be True for non-top-level bindings.\n\nWhy do any such bindings exist?  After all, let-floating should have\nfloated them out.  Well, a clever optimiser might leave one there to\navoid a space leak, deliberately recomputing a thunk.  Also (and this\nreally does happen occasionally) let-floating may make a function f smaller\nso it can be inlined, so now (f True) may generate a local no-fv closure.\nThis actually happened during bootstrapping GHC itself, with f=mkRdrFunBind\nin TcGenDeriv.) -}\n\n-----------------------------------------------------------------------------\n--                getCallMethod\n-----------------------------------------------------------------------------\n\n{- The entry conventions depend on the type of closure being entered,\nwhether or not it has free variables, and whether we're running\nsequentially or in parallel.\n\nClosure                           Node   Argument   Enter\nCharacteristics              Par   Req'd  Passing    Via\n---------------------------------------------------------------------------\nUnknown                     & no  & yes & stack     & node\nKnown fun (>1 arg), no fvs  & no  & no  & registers & fast entry (enough args)\n                                                    & slow entry (otherwise)\nKnown fun (>1 arg), fvs     & no  & yes & registers & fast entry (enough args)\n0 arg, no fvs \\r,\\s         & no  & no  & n/a       & direct entry\n0 arg, no fvs \\u            & no  & yes & n/a       & node\n0 arg, fvs \\r,\\s,selector   & no  & yes & n/a       & node\n0 arg, fvs \\r,\\s            & no  & yes & n/a       & direct entry\n0 arg, fvs \\u               & no  & yes & n/a       & node\nUnknown                     & yes & yes & stack     & node\nKnown fun (>1 arg), no fvs  & yes & no  & registers & fast entry (enough args)\n                                                    & slow entry (otherwise)\nKnown fun (>1 arg), fvs     & yes & yes & registers & node\n0 arg, fvs \\r,\\s,selector   & yes & yes & n/a       & node\n0 arg, no fvs \\r,\\s         & yes & no  & n/a       & direct entry\n0 arg, no fvs \\u            & yes & yes & n/a       & node\n0 arg, fvs \\r,\\s            & yes & yes & n/a       & node\n0 arg, fvs \\u               & yes & yes & n/a       & node\n\nWhen black-holing, single-entry closures could also be entered via node\n(rather than directly) to catch double-entry. -}\n\ndata CallMethod\n  = EnterIt             -- No args, not a function\n\n  | JumpToIt BlockId [LocalReg] -- A join point or a header of a local loop\n\n  | ReturnIt            -- It's a value (function, unboxed value,\n                        -- or constructor), so just return it.\n\n  | SlowCall                -- Unknown fun, or known fun with\n                        -- too few args.\n\n  | DirectEntry         -- Jump directly, with args in regs\n        CLabel          --   The code label\n        RepArity        --   Its arity\n\ngetCallMethod :: DynFlags\n              -> Name           -- Function being applied\n              -> Id             -- Function Id used to chech if it can refer to\n                                -- CAF's and whether the function is tail-calling\n                                -- itself\n              -> LambdaFormInfo -- Its info\n              -> RepArity       -- Number of available arguments\n              -> RepArity       -- Number of them being void arguments\n              -> CgLoc          -- Passed in from cgIdApp so that we can\n                                -- handle let-no-escape bindings and self-recursive\n                                -- tail calls using the same data constructor,\n                                -- JumpToIt. This saves us one case branch in\n                                -- cgIdApp\n              -> Maybe SelfLoopInfo -- can we perform a self-recursive tail call?\n              -> CallMethod\n\ngetCallMethod dflags _ id _ n_args v_args _cg_loc\n              (Just (self_loop_id, block_id, args))\n  | gopt Opt_Loopification dflags\n  , id == self_loop_id\n  , args `lengthIs` (n_args - v_args)\n  -- If these patterns match then we know that:\n  --   * loopification optimisation is turned on\n  --   * function is performing a self-recursive call in a tail position\n  --   * number of non-void parameters of the function matches functions arity.\n  -- See Note [Self-recursive tail calls] and Note [Void arguments in\n  -- self-recursive tail calls] in StgCmmExpr for more details\n  = JumpToIt block_id args\n\ngetCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc\n              _self_loop_info\n  | n_args == 0 -- No args at all\n  && not (gopt Opt_SccProfilingOn dflags)\n     -- See Note [Evaluating functions with profiling] in rts/Apply.cmm\n  = ASSERT( arity /= 0 ) ReturnIt\n  | n_args < arity = SlowCall        -- Not enough args\n  | otherwise      = DirectEntry (enterIdLabel dflags name (idCafInfo id)) arity\n\ngetCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info\n  = ASSERT( n_args == 0 ) ReturnIt\n\ngetCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info\n  = ASSERT( n_args == 0 ) ReturnIt\n    -- n_args=0 because it'd be ill-typed to apply a saturated\n    --          constructor application to anything\n\ngetCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun)\n              n_args _v_args _cg_loc _self_loop_info\n  | is_fun      -- it *might* be a function, so we must \"call\" it (which is always safe)\n  = SlowCall    -- We cannot just enter it [in eval/apply, the entry code\n                -- is the fast-entry code]\n\n  -- Since is_fun is False, we are *definitely* looking at a data value\n  | updatable || gopt Opt_Ticky dflags -- to catch double entry\n      {- OLD: || opt_SMP\n         I decided to remove this, because in SMP mode it doesn't matter\n         if we enter the same thunk multiple times, so the optimisation\n         of jumping directly to the entry code is still valid.  --SDM\n        -}\n  = EnterIt\n\n  -- even a non-updatable selector thunk can be updated by the garbage\n  -- collector, so we must enter it. (#8817)\n  | SelectorThunk{} <- std_form_info\n  = EnterIt\n\n    -- We used to have ASSERT( n_args == 0 ), but actually it is\n    -- possible for the optimiser to generate\n    --   let bot :: Int = error Int \"urk\"\n    --   in (bot `cast` unsafeCoerce Int (Int -> Int)) 3\n    -- This happens as a result of the case-of-error transformation\n    -- So the right thing to do is just to enter the thing\n\n  | otherwise        -- Jump direct to code for single-entry thunks\n  = ASSERT( n_args == 0 )\n    DirectEntry (thunkEntryLabel dflags name (idCafInfo id) std_form_info\n                updatable) 0\n\ngetCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info\n  = SlowCall -- might be a function\n\ngetCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info\n  = ASSERT2( n_args == 0, ppr name <+> ppr n_args )\n    EnterIt -- Not a function\n\ngetCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs)\n              _self_loop_info\n  = JumpToIt blk_id lne_regs\n\ngetCallMethod _ _ _ _ _ _ _ _ = panic \"Unknown call method\"\n\n-----------------------------------------------------------------------------\n--              Data types for closure information\n-----------------------------------------------------------------------------\n\n\n{- ClosureInfo: information about a binding\n\n   We make a ClosureInfo for each let binding (both top level and not),\n   but not bindings for data constructors: for those we build a CmmInfoTable\n   directly (see mkDataConInfoTable).\n\n   To a first approximation:\n       ClosureInfo = (LambdaFormInfo, CmmInfoTable)\n\n   A ClosureInfo has enough information\n     a) to construct the info table itself, and build other things\n        related to the binding (e.g. slow entry points for a function)\n     b) to allocate a closure containing that info pointer (i.e.\n           it knows the info table label)\n-}\n\ndata ClosureInfo\n  = ClosureInfo {\n        closureName :: !Name,           -- The thing bound to this closure\n           -- we don't really need this field: it's only used in generating\n           -- code for ticky and profiling, and we could pass the information\n           -- around separately, but it doesn't do much harm to keep it here.\n\n        closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon\n          -- this tells us about what the closure contains: it's right-hand-side.\n\n          -- the rest is just an unpacked CmmInfoTable.\n        closureInfoLabel :: !CLabel,\n        closureSMRep     :: !SMRep,          -- representation used by storage mgr\n        closureProf      :: !ProfilingInfo\n    }\n\n-- | Convert from 'ClosureInfo' to 'CmmInfoTable'.\nmkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable\nmkCmmInfo ClosureInfo {..} id ccs\n  = CmmInfoTable { cit_lbl  = closureInfoLabel\n                 , cit_rep  = closureSMRep\n                 , cit_prof = closureProf\n                 , cit_srt  = Nothing\n                 , cit_clo  = if isStaticRep closureSMRep\n                                then Just (id,ccs)\n                                else Nothing }\n\n--------------------------------------\n--        Building ClosureInfos\n--------------------------------------\n\nmkClosureInfo :: DynFlags\n              -> Bool                -- Is static\n              -> Id\n              -> LambdaFormInfo\n              -> Int -> Int        -- Total and pointer words\n              -> String         -- String descriptor\n              -> ClosureInfo\nmkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr\n  = ClosureInfo { closureName      = name\n                , closureLFInfo    = lf_info\n                , closureInfoLabel = info_lbl   -- These three fields are\n                , closureSMRep     = sm_rep     -- (almost) an info table\n                , closureProf      = prof }     -- (we don't have an SRT yet)\n  where\n    name       = idName id\n    sm_rep     = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info)\n    prof       = mkProfilingInfo dflags id val_descr\n    nonptr_wds = tot_wds - ptr_wds\n\n    info_lbl = mkClosureInfoTableLabel id lf_info\n\n--------------------------------------\n--   Other functions over ClosureInfo\n--------------------------------------\n\n-- Eager blackholing is normally disabled, but can be turned on with\n-- -feager-blackholing.  When it is on, we replace the info pointer of\n-- the thunk with stg_EAGER_BLACKHOLE_info on entry.\n\n-- If we wanted to do eager blackholing with slop filling,\n-- we'd need to do it at the *end* of a basic block, otherwise\n-- we overwrite the free variables in the thunk that we still\n-- need.  We have a patch for this from Andy Cheadle, but not\n-- incorporated yet. --SDM [6/2004]\n--\n-- Previously, eager blackholing was enabled when ticky-ticky\n-- was on. But it didn't work, and it wasn't strictly necessary\n-- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING\n-- is unconditionally disabled. -- krc 1/2007\n--\n-- Static closures are never themselves black-holed.\n\nblackHoleOnEntry :: ClosureInfo -> Bool\nblackHoleOnEntry cl_info\n  | isStaticRep (closureSMRep cl_info)\n  = False        -- Never black-hole a static closure\n\n  | otherwise\n  = case closureLFInfo cl_info of\n      LFReEntrant {}            -> False\n      LFLetNoEscape             -> False\n      LFThunk _ _no_fvs upd _ _ -> upd   -- See Note [Black-holing non-updatable thunks]\n      _other -> panic \"blackHoleOnEntry\"\n\n{- Note [Black-holing non-updatable thunks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must not black-hole non-updatable (single-entry) thunks otherwise\nwe run into issues like Trac #10414. Specifically:\n\n  * There is no reason to black-hole a non-updatable thunk: it should\n    not be competed for by multiple threads\n\n  * It could, conceivably, cause a space leak if we don't black-hole\n    it, if there was a live but never-followed pointer pointing to it.\n    Let's hope that doesn't happen.\n\n  * It is dangerous to black-hole a non-updatable thunk because\n     - is not updated (of course)\n     - hence, if it is black-holed and another thread tries to evaluate\n       it, that thread will block forever\n    This actually happened in Trac #10414.  So we do not black-hole\n    non-updatable thunks.\n\n  * How could two threads evaluate the same non-updatable (single-entry)\n    thunk?  See Reid Barton's example below.\n\n  * Only eager blackholing could possibly black-hole a non-updatable\n    thunk, because lazy black-holing only affects thunks with an\n    update frame on the stack.\n\nHere is and example due to Reid Barton (Trac #10414):\n    x = \\u []  concat [[1], []]\nwith the following definitions,\n\n    concat x = case x of\n        []       -> []\n        (:) x xs -> (++) x (concat xs)\n\n    (++) xs ys = case xs of\n        []         -> ys\n        (:) x rest -> (:) x ((++) rest ys)\n\nWhere we use the syntax @\\u []@ to denote an updatable thunk and @\\s []@ to\ndenote a single-entry (i.e. non-updatable) thunk. After a thread evaluates @x@\nto WHNF and calls @(++)@ the heap will contain the following thunks,\n\n    x = 1 : y\n    y = \\u []  (++) [] z\n    z = \\s []  concat []\n\nNow that the stage is set, consider the follow evaluations by two racing threads\nA and B,\n\n  1. Both threads enter @y@ before either is able to replace it with an\n     indirection\n\n  2. Thread A does the case analysis in @(++)@ and consequently enters @z@,\n     replacing it with a black-hole\n\n  3. At some later point thread B does the same case analysis and also attempts\n     to enter @z@. However, it finds that it has been replaced with a black-hole\n     so it blocks.\n\n  4. Thread A eventually finishes evaluating @z@ (to @[]@) and updates @y@\n     accordingly. It does *not* update @z@, however, as it is single-entry. This\n     leaves Thread B blocked forever on a black-hole which will never be\n     updated.\n\nTo avoid this sort of condition we never black-hole non-updatable thunks.\n-}\n\nisStaticClosure :: ClosureInfo -> Bool\nisStaticClosure cl_info = isStaticRep (closureSMRep cl_info)\n\nclosureUpdReqd :: ClosureInfo -> Bool\nclosureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info\n\nlfUpdatable :: LambdaFormInfo -> Bool\nlfUpdatable (LFThunk _ _ upd _ _)  = upd\nlfUpdatable _ = False\n\nclosureSingleEntry :: ClosureInfo -> Bool\nclosureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd\nclosureSingleEntry (ClosureInfo { closureLFInfo = LFReEntrant _ OneShotLam _ _ _}) = True\nclosureSingleEntry _ = False\n\nclosureReEntrant :: ClosureInfo -> Bool\nclosureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant {} }) = True\nclosureReEntrant _ = False\n\nclosureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)\nclosureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info\n\nlfFunInfo :: LambdaFormInfo ->  Maybe (RepArity, ArgDescr)\nlfFunInfo (LFReEntrant _ _ arity _ arg_desc)  = Just (arity, arg_desc)\nlfFunInfo _                                   = Nothing\n\nfunTag :: DynFlags -> ClosureInfo -> DynTag\nfunTag dflags (ClosureInfo { closureLFInfo = lf_info })\n    = lfDynTag dflags lf_info\n\nisToplevClosure :: ClosureInfo -> Bool\nisToplevClosure (ClosureInfo { closureLFInfo = lf_info })\n  = case lf_info of\n      LFReEntrant TopLevel _ _ _ _ -> True\n      LFThunk TopLevel _ _ _ _     -> True\n      _other                       -> False\n\n--------------------------------------\n--   Label generation\n--------------------------------------\n\nstaticClosureLabel :: ClosureInfo -> CLabel\nstaticClosureLabel = toClosureLbl .  closureInfoLabel\n\nclosureSlowEntryLabel :: ClosureInfo -> CLabel\nclosureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel\n\nclosureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel\nclosureLocalEntryLabel dflags\n  | tablesNextToCode dflags = toInfoLbl  . closureInfoLabel\n  | otherwise               = toEntryLbl . closureInfoLabel\n\nmkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel\nmkClosureInfoTableLabel id lf_info\n  = case lf_info of\n        LFThunk _ _ upd_flag (SelectorThunk offset) _\n                      -> mkSelectorInfoLabel upd_flag offset\n\n        LFThunk _ _ upd_flag (ApThunk arity) _\n                      -> mkApInfoTableLabel upd_flag arity\n\n        LFThunk{}     -> std_mk_lbl name cafs\n        LFReEntrant{} -> std_mk_lbl name cafs\n        _other        -> panic \"closureInfoTableLabel\"\n\n  where\n    name = idName id\n\n    std_mk_lbl | is_local  = mkLocalInfoTableLabel\n               | otherwise = mkInfoTableLabel\n\n    cafs     = idCafInfo id\n    is_local = isDataConWorkId id\n       -- Make the _info pointer for the implicit datacon worker\n       -- binding local. The reason we can do this is that importing\n       -- code always either uses the _closure or _con_info. By the\n       -- invariants in CorePrep anything else gets eta expanded.\n\n\nthunkEntryLabel :: DynFlags -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel\n-- thunkEntryLabel is a local help function, not exported.  It's used from\n-- getCallMethod.\nthunkEntryLabel dflags _thunk_id _ (ApThunk arity) upd_flag\n  = enterApLabel dflags upd_flag arity\nthunkEntryLabel dflags _thunk_id _ (SelectorThunk offset) upd_flag\n  = enterSelectorLabel dflags upd_flag offset\nthunkEntryLabel dflags thunk_id c _ _\n  = enterIdLabel dflags thunk_id c\n\nenterApLabel :: DynFlags -> Bool -> Arity -> CLabel\nenterApLabel dflags is_updatable arity\n  | tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity\n  | otherwise               = mkApEntryLabel is_updatable arity\n\nenterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel\nenterSelectorLabel dflags upd_flag offset\n  | tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset\n  | otherwise               = mkSelectorEntryLabel upd_flag offset\n\nenterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel\nenterIdLabel dflags id c\n  | tablesNextToCode dflags = mkInfoTableLabel id c\n  | otherwise               = mkEntryLabel id c\n\n\n--------------------------------------\n--   Profiling\n--------------------------------------\n\n-- Profiling requires two pieces of information to be determined for\n-- each closure's info table --- description and type.\n\n-- The description is stored directly in the @CClosureInfoTable@ when the\n-- info table is built.\n\n-- The type is determined from the type information stored with the @Id@\n-- in the closure info using @closureTypeDescr@.\n\nmkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo\nmkProfilingInfo dflags id val_descr\n  | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo\n  | otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr)\n  where\n    ty_descr_w8  = BS8.pack (getTyDescription (idType id))\n\ngetTyDescription :: Type -> String\ngetTyDescription ty\n  = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->\n    case tau_ty of\n      TyVarTy _              -> \"*\"\n      AppTy fun _            -> getTyDescription fun\n      TyConApp tycon _       -> getOccString tycon\n      FunTy {}              -> '-' : fun_result tau_ty\n      ForAllTy _  ty         -> getTyDescription ty\n      LitTy n                -> getTyLitDescription n\n      CastTy ty _            -> getTyDescription ty\n      CoercionTy co          -> pprPanic \"getTyDescription\" (ppr co)\n    }\n  where\n    fun_result (FunTy { ft_res = res }) = '>' : fun_result res\n    fun_result other                    = getTyDescription other\n\ngetTyLitDescription :: TyLit -> String\ngetTyLitDescription l =\n  case l of\n    NumTyLit n -> show n\n    StrTyLit n -> show n\n\n--------------------------------------\n--   CmmInfoTable-related things\n--------------------------------------\n\nmkDataConInfoTable :: DynFlags -> DataCon -> Bool -> Int -> Int -> CmmInfoTable\nmkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds\n = CmmInfoTable { cit_lbl  = info_lbl\n                , cit_rep  = sm_rep\n                , cit_prof = prof\n                , cit_srt  = Nothing\n                , cit_clo  = Nothing }\n where\n   name = dataConName data_con\n   info_lbl = mkConInfoTableLabel name NoCafRefs\n   sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type\n   cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con)\n                  -- We keep the *zero-indexed* tag in the srt_len field\n                  -- of the info table of a data constructor.\n\n   prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo\n        | otherwise                            = ProfilingInfo ty_descr val_descr\n\n   ty_descr  = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con\n   val_descr = BS8.pack $ occNameString $ getOccName data_con\n\n-- We need a black-hole closure info to pass to @allocDynClosure@ when we\n-- want to allocate the black hole on entry to a CAF.\n\ncafBlackHoleInfoTable :: CmmInfoTable\ncafBlackHoleInfoTable\n  = CmmInfoTable { cit_lbl  = mkCAFBlackHoleInfoTableLabel\n                 , cit_rep  = blackHoleRep\n                 , cit_prof = NoProfilingInfo\n                 , cit_srt  = Nothing\n                 , cit_clo  = Nothing }\n\nindStaticInfoTable :: CmmInfoTable\nindStaticInfoTable\n  = CmmInfoTable { cit_lbl  = mkIndStaticInfoLabel\n                 , cit_rep  = indStaticRep\n                 , cit_prof = NoProfilingInfo\n                 , cit_srt  = Nothing\n                 , cit_clo  = Nothing }\n\nstaticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool\n-- A static closure needs a link field to aid the GC when traversing\n-- the static closure graph.  But it only needs such a field if either\n--        a) it has an SRT\n--        b) it's a constructor with one or more pointer fields\n-- In case (b), the constructor's fields themselves play the role\n-- of the SRT.\nstaticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }\n  | isConRep smrep         = not (isStaticNoCafCon smrep)\n  | otherwise              = has_srt\n", "num_lines": 1001}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Stg to C--: code generation for constructors\n--\n-- This module provides the support code for StgCmm to deal with with\n-- constructors on the RHSs of let(rec)s.\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmCon (\n        cgTopRhsCon, buildDynCon, bindConArgs\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport StgSyn\nimport CoreSyn  ( AltCon(..) )\n\nimport StgCmmMonad\nimport StgCmmEnv\nimport StgCmmHeap\nimport StgCmmLayout\nimport StgCmmUtils\nimport StgCmmClosure\n\nimport CmmExpr\nimport CmmUtils\nimport CLabel\nimport MkGraph\nimport SMRep\nimport CostCentre\nimport Module\nimport DataCon\nimport DynFlags\nimport FastString\nimport Id\nimport RepType (countConRepArgs)\nimport Literal\nimport PrelInfo\nimport Outputable\nimport Platform\nimport Util\nimport MonadUtils (mapMaybeM)\n\nimport Control.Monad\nimport Data.Char\n\n\n\n---------------------------------------------------------------\n--      Top-level constructors\n---------------------------------------------------------------\n\ncgTopRhsCon :: DynFlags\n            -> Id               -- Name of thing bound to this RHS\n            -> DataCon          -- Id\n            -> [NonVoid StgArg] -- Args\n            -> (CgIdInfo, FCode ())\ncgTopRhsCon dflags id con args =\n    let id_info = litIdInfo dflags id (mkConLFInfo con) (CmmLabel closure_label)\n    in (id_info, gen_code)\n  where\n   name          = idName id\n   caffy         = idCafInfo id -- any stgArgHasCafRefs args\n   closure_label = mkClosureLabel name caffy\n\n   gen_code =\n     do { this_mod <- getModuleName\n        ; when (platformOS (targetPlatform dflags) == OSMinGW32) $\n              -- Windows DLLs have a problem with static cross-DLL refs.\n              MASSERT( not (isDllConApp dflags this_mod con (map fromNonVoid args)) )\n        ; ASSERT( args `lengthIs` countConRepArgs con ) return ()\n\n        -- LAY IT OUT\n        ; let\n            (tot_wds, --  #ptr_wds + #nonptr_wds\n             ptr_wds, --  #ptr_wds\n             nv_args_w_offsets) =\n                 mkVirtHeapOffsetsWithPadding dflags StdHeader (addArgReps args)\n\n            mk_payload (Padding len _) = return (CmmInt 0 (widthFromBytes len))\n            mk_payload (FieldOff arg _) = do\n                amode <- getArgAmode arg\n                case amode of\n                  CmmLit lit -> return lit\n                  _          -> panic \"StgCmmCon.cgTopRhsCon\"\n\n            nonptr_wds = tot_wds - ptr_wds\n\n             -- we're not really going to emit an info table, so having\n             -- to make a CmmInfoTable is a bit overkill, but mkStaticClosureFields\n             -- needs to poke around inside it.\n            info_tbl = mkDataConInfoTable dflags con True ptr_wds nonptr_wds\n\n\n        ; payload <- mapM mk_payload nv_args_w_offsets\n                -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs\n                -- NB2: all the amodes should be Lits!\n                --      TODO (osa): Why?\n\n        ; let closure_rep = mkStaticClosureFields\n                             dflags\n                             info_tbl\n                             dontCareCCS                -- Because it's static data\n                             caffy                      -- Has CAF refs\n                             payload\n\n                -- BUILD THE OBJECT\n        ; emitDataLits closure_label closure_rep\n\n        ; return () }\n\n\n---------------------------------------------------------------\n--      Lay out and allocate non-top-level constructors\n---------------------------------------------------------------\n\nbuildDynCon :: Id                 -- Name of the thing to which this constr will\n                                  -- be bound\n            -> Bool               -- is it genuinely bound to that name, or just\n                                  -- for profiling?\n            -> CostCentreStack    -- Where to grab cost centre from;\n                                  -- current CCS if currentOrSubsumedCCS\n            -> DataCon            -- The data constructor\n            -> [NonVoid StgArg]   -- Its args\n            -> FCode (CgIdInfo, FCode CmmAGraph)\n               -- Return details about how to find it and initialization code\nbuildDynCon binder actually_bound cc con args\n    = do dflags <- getDynFlags\n         buildDynCon' dflags (targetPlatform dflags) binder actually_bound cc con args\n\n\nbuildDynCon' :: DynFlags\n             -> Platform\n             -> Id -> Bool\n             -> CostCentreStack\n             -> DataCon\n             -> [NonVoid StgArg]\n             -> FCode (CgIdInfo, FCode CmmAGraph)\n\n{- We used to pass a boolean indicating whether all the\nargs were of size zero, so we could use a static\nconstructor; but I concluded that it just isn't worth it.\nNow I/O uses unboxed tuples there just aren't any constructors\nwith all size-zero args.\n\nThe reason for having a separate argument, rather than looking at\nthe addr modes of the args is that we may be in a \"knot\", and\npremature looking at the args will cause the compiler to black-hole!\n-}\n\n\n-------- buildDynCon': Nullary constructors --------------\n-- First we deal with the case of zero-arity constructors.  They\n-- will probably be unfolded, so we don't expect to see this case much,\n-- if at all, but it does no harm, and sets the scene for characters.\n--\n-- In the case of zero-arity constructors, or, more accurately, those\n-- which have exclusively size-zero (VoidRep) args, we generate no code\n-- at all.\n\nbuildDynCon' dflags _ binder _ _cc con []\n  | isNullaryRepDataCon con\n  = return (litIdInfo dflags binder (mkConLFInfo con)\n                (CmmLabel (mkClosureLabel (dataConName con) (idCafInfo binder))),\n            return mkNop)\n\n-------- buildDynCon': Charlike and Intlike constructors -----------\n{- The following three paragraphs about @Char@-like and @Int@-like\nclosures are obsolete, but I don't understand the details well enough\nto properly word them, sorry. I've changed the treatment of @Char@s to\nbe analogous to @Int@s: only a subset is preallocated, because @Char@\nhas now 31 bits. Only literals are handled here. -- Qrczak\n\nNow for @Char@-like closures.  We generate an assignment of the\naddress of the closure to a temporary.  It would be possible simply to\ngenerate no code, and record the addressing mode in the environment,\nbut we'd have to be careful if the argument wasn't a constant --- so\nfor simplicity we just always assign to a temporary.\n\nLast special case: @Int@-like closures.  We only special-case the\nsituation in which the argument is a literal in the range\n@mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can\nwork with any old argument, but for @Int@-like ones the argument has\nto be a literal.  Reason: @Char@ like closures have an argument type\nwhich is guaranteed in range.\n\nBecause of this, we use can safely return an addressing mode.\n\nWe don't support this optimisation when compiling into Windows DLLs yet\nbecause they don't support cross package data references well.\n-}\n\nbuildDynCon' dflags platform binder _ _cc con [arg]\n  | maybeIntLikeCon con\n  , platformOS platform /= OSMinGW32 || not (positionIndependent dflags)\n  , NonVoid (StgLitArg (LitNumber LitNumInt val _)) <- arg\n  , val <= fromIntegral (mAX_INTLIKE dflags) -- Comparisons at type Integer!\n  , val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto...\n  = do  { let intlike_lbl   = mkCmmClosureLabel rtsUnitId (fsLit \"stg_INTLIKE\")\n              val_int = fromIntegral val :: Int\n              offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSizeW dflags + 1)\n                -- INTLIKE closures consist of a header and one word payload\n              intlike_amode = cmmLabelOffW dflags intlike_lbl offsetW\n        ; return ( litIdInfo dflags binder (mkConLFInfo con) intlike_amode\n                 , return mkNop) }\n\nbuildDynCon' dflags platform binder _ _cc con [arg]\n  | maybeCharLikeCon con\n  , platformOS platform /= OSMinGW32 || not (positionIndependent dflags)\n  , NonVoid (StgLitArg (LitChar val)) <- arg\n  , let val_int = ord val :: Int\n  , val_int <= mAX_CHARLIKE dflags\n  , val_int >= mIN_CHARLIKE dflags\n  = do  { let charlike_lbl   = mkCmmClosureLabel rtsUnitId (fsLit \"stg_CHARLIKE\")\n              offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSizeW dflags + 1)\n                -- CHARLIKE closures consist of a header and one word payload\n              charlike_amode = cmmLabelOffW dflags charlike_lbl offsetW\n        ; return ( litIdInfo dflags binder (mkConLFInfo con) charlike_amode\n                 , return mkNop) }\n\n-------- buildDynCon': the general case -----------\nbuildDynCon' dflags _ binder actually_bound ccs con args\n  = do  { (id_info, reg) <- rhsIdInfo binder lf_info\n        ; return (id_info, gen_code reg)\n        }\n where\n  lf_info = mkConLFInfo con\n\n  gen_code reg\n    = do  { let (tot_wds, ptr_wds, args_w_offsets)\n                  = mkVirtConstrOffsets dflags (addArgReps args)\n                nonptr_wds = tot_wds - ptr_wds\n                info_tbl = mkDataConInfoTable dflags con False\n                                ptr_wds nonptr_wds\n          ; let ticky_name | actually_bound = Just binder\n                           | otherwise = Nothing\n\n          ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info\n                                          use_cc blame_cc args_w_offsets\n          ; return (mkRhsInit dflags reg lf_info hp_plus_n) }\n    where\n      use_cc      -- cost-centre to stick in the object\n        | isCurrentCCS ccs = cccsExpr\n        | otherwise        = panic \"buildDynCon: non-current CCS not implemented\"\n\n      blame_cc = use_cc -- cost-centre on which to blame the alloc (same)\n\n\n---------------------------------------------------------------\n--      Binding constructor arguments\n---------------------------------------------------------------\n\nbindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg]\n-- bindConArgs is called from cgAlt of a case\n-- (bindConArgs con args) augments the environment with bindings for the\n-- binders args, assuming that we have just returned from a 'case' which\n-- found a con\nbindConArgs (DataAlt con) base args\n  = ASSERT(not (isUnboxedTupleCon con))\n    do dflags <- getDynFlags\n       let (_, _, args_w_offsets) = mkVirtConstrOffsets dflags (addIdReps args)\n           tag = tagForCon dflags con\n\n           -- The binding below forces the masking out of the tag bits\n           -- when accessing the constructor field.\n           bind_arg :: (NonVoid Id, ByteOff) -> FCode (Maybe LocalReg)\n           bind_arg (arg@(NonVoid b), offset)\n             | isDeadBinder b  -- See Note [Dead-binder optimisation] in StgCmmExpr\n             = return Nothing\n             | otherwise\n             = do { emit $ mkTaggedObjectLoad dflags (idToReg dflags arg)\n                                              base offset tag\n                  ; Just <$> bindArgToReg arg }\n\n       mapMaybeM bind_arg args_w_offsets\n\nbindConArgs _other_con _base args\n  = ASSERT( null args ) return []\n", "num_lines": 286}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Stg to C-- code generation: the binding environment\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\nmodule StgCmmEnv (\n        CgIdInfo,\n\n        litIdInfo, lneIdInfo, rhsIdInfo, mkRhsInit,\n        idInfoToAmode,\n\n        addBindC, addBindsC,\n\n        bindArgsToRegs, bindToReg, rebindToReg,\n        bindArgToReg, idToReg,\n        getArgAmode, getNonVoidArgAmodes,\n        getCgIdInfo,\n        maybeLetNoEscape,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TyCon\nimport StgCmmMonad\nimport StgCmmUtils\nimport StgCmmClosure\n\nimport CLabel\n\nimport BlockId\nimport CmmExpr\nimport CmmUtils\nimport DynFlags\nimport Id\nimport MkGraph\nimport Name\nimport Outputable\nimport StgSyn\nimport Type\nimport TysPrim\nimport UniqFM\nimport Util\nimport VarEnv\n\n-------------------------------------\n--        Manipulating CgIdInfo\n-------------------------------------\n\nmkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo\nmkCgIdInfo id lf expr\n  = CgIdInfo { cg_id = id, cg_lf = lf\n             , cg_loc = CmmLoc expr }\n\nlitIdInfo :: DynFlags -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo\nlitIdInfo dflags id lf lit\n  = CgIdInfo { cg_id = id, cg_lf = lf\n             , cg_loc = CmmLoc (addDynTag dflags (CmmLit lit) tag) }\n  where\n    tag = lfDynTag dflags lf\n\nlneIdInfo :: DynFlags -> Id -> [NonVoid Id] -> CgIdInfo\nlneIdInfo dflags id regs\n  = CgIdInfo { cg_id = id, cg_lf = lf\n             , cg_loc = LneLoc blk_id (map (idToReg dflags) regs) }\n  where\n    lf     = mkLFLetNoEscape\n    blk_id = mkBlockId (idUnique id)\n\n\nrhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)\nrhsIdInfo id lf_info\n  = do dflags <- getDynFlags\n       reg <- newTemp (gcWord dflags)\n       return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg)\n\nmkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph\nmkRhsInit dflags reg lf_info expr\n  = mkAssign (CmmLocal reg) (addDynTag dflags expr (lfDynTag dflags lf_info))\n\nidInfoToAmode :: CgIdInfo -> CmmExpr\n-- Returns a CmmExpr for the *tagged* pointer\nidInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e\nidInfoToAmode cg_info\n  = pprPanic \"idInfoToAmode\" (ppr (cg_id cg_info))        -- LneLoc\n\naddDynTag :: DynFlags -> CmmExpr -> DynTag -> CmmExpr\n-- A tag adds a byte offset to the pointer\naddDynTag dflags expr tag = cmmOffsetB dflags expr tag\n\nmaybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])\nmaybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)\nmaybeLetNoEscape _other                                      = Nothing\n\n\n\n---------------------------------------------------------\n--        The binding environment\n--\n-- There are three basic routines, for adding (addBindC),\n-- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.\n---------------------------------------------------------\n\naddBindC :: CgIdInfo -> FCode ()\naddBindC stuff_to_bind = do\n        binds <- getBinds\n        setBinds $ extendVarEnv binds (cg_id stuff_to_bind) stuff_to_bind\n\naddBindsC :: [CgIdInfo] -> FCode ()\naddBindsC new_bindings = do\n        binds <- getBinds\n        let new_binds = foldl' (\\ binds info -> extendVarEnv binds (cg_id info) info)\n                               binds\n                               new_bindings\n        setBinds new_binds\n\ngetCgIdInfo :: Id -> FCode CgIdInfo\ngetCgIdInfo id\n  = do  { dflags <- getDynFlags\n        ; local_binds <- getBinds -- Try local bindings first\n        ; case lookupVarEnv local_binds id of {\n            Just info -> return info ;\n            Nothing   -> do {\n\n                -- Should be imported; make up a CgIdInfo for it\n          let name = idName id\n        ; if isExternalName name then\n              let ext_lbl\n                      | isUnliftedType (idType id) =\n                          -- An unlifted external Id must refer to a top-level\n                          -- string literal. See Note [Bytes label] in CLabel.\n                          ASSERT( idType id `eqType` addrPrimTy )\n                          mkBytesLabel name\n                      | otherwise = mkClosureLabel name $ idCafInfo id\n              in return $\n                  litIdInfo dflags id (mkLFImported id) (CmmLabel ext_lbl)\n          else\n              cgLookupPanic id -- Bug\n        }}}\n\ncgLookupPanic :: Id -> FCode a\ncgLookupPanic id\n  = do  local_binds <- getBinds\n        pprPanic \"StgCmmEnv: variable not found\"\n                (vcat [ppr id,\n                text \"local binds for:\",\n                pprUFM local_binds $ \\infos ->\n                  vcat [ ppr (cg_id info) | info <- infos ]\n              ])\n\n\n--------------------\ngetArgAmode :: NonVoid StgArg -> FCode CmmExpr\ngetArgAmode (NonVoid (StgVarArg var)) = idInfoToAmode <$> getCgIdInfo var\ngetArgAmode (NonVoid (StgLitArg lit)) = CmmLit <$> cgLit lit\n\ngetNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]\n-- NB: Filters out void args,\n--     so the result list may be shorter than the argument list\ngetNonVoidArgAmodes [] = return []\ngetNonVoidArgAmodes (arg:args)\n  | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args\n  | otherwise = do { amode  <- getArgAmode (NonVoid arg)\n                   ; amodes <- getNonVoidArgAmodes args\n                   ; return ( amode : amodes ) }\n\n\n------------------------------------------------------------------------\n--        Interface functions for binding and re-binding names\n------------------------------------------------------------------------\n\nbindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg\n-- Bind an Id to a fresh LocalReg\nbindToReg nvid@(NonVoid id) lf_info\n  = do dflags <- getDynFlags\n       let reg = idToReg dflags nvid\n       addBindC (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))\n       return reg\n\nrebindToReg :: NonVoid Id -> FCode LocalReg\n-- Like bindToReg, but the Id is already in scope, so\n-- get its LF info from the envt\nrebindToReg nvid@(NonVoid id)\n  = do  { info <- getCgIdInfo id\n        ; bindToReg nvid (cg_lf info) }\n\nbindArgToReg :: NonVoid Id -> FCode LocalReg\nbindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)\n\nbindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]\nbindArgsToRegs args = mapM bindArgToReg args\n\nidToReg :: DynFlags -> NonVoid Id -> LocalReg\n-- Make a register from an Id, typically a function argument,\n-- free variable, or case binder\n--\n-- We re-use the Unique from the Id to make it easier to see what is going on\n--\n-- By now the Ids should be uniquely named; else one would worry\n-- about accidental collision\nidToReg dflags (NonVoid id)\n             = LocalReg (idUnique id)\n                        (primRepCmmType dflags (idPrimRep id))\n", "num_lines": 209}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Stg to C-- code generation: expressions\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmExpr ( cgExpr ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude hiding ((<*>))\n\nimport {-# SOURCE #-} StgCmmBind ( cgBind )\n\nimport StgCmmMonad\nimport StgCmmHeap\nimport StgCmmEnv\nimport StgCmmCon\nimport StgCmmProf (saveCurrentCostCentre, restoreCurrentCostCentre, emitSetCCC)\nimport StgCmmLayout\nimport StgCmmPrim\nimport StgCmmHpc\nimport StgCmmTicky\nimport StgCmmUtils\nimport StgCmmClosure\n\nimport StgSyn\n\nimport MkGraph\nimport BlockId\nimport Cmm\nimport CmmInfo\nimport CoreSyn\nimport DataCon\nimport ForeignCall\nimport Id\nimport PrimOp\nimport TyCon\nimport Type             ( isUnliftedType )\nimport RepType          ( isVoidTy, countConRepArgs, primRepSlot )\nimport CostCentre       ( CostCentreStack, currentCCS )\nimport Maybes\nimport Util\nimport FastString\nimport Outputable\n\nimport Control.Monad (unless,void)\nimport Control.Arrow (first)\nimport Data.Function ( on )\n\n------------------------------------------------------------------------\n--              cgExpr: the main function\n------------------------------------------------------------------------\n\ncgExpr  :: CgStgExpr -> FCode ReturnKind\n\ncgExpr (StgApp fun args)     = cgIdApp fun args\n\n-- seq# a s ==> a\n-- See Note [seq# magic] in PrelRules\ncgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) =\n  cgIdApp a []\n\n-- dataToTag# :: a -> Int#\n-- See Note [dataToTag#] in primops.txt.pp\ncgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do\n  dflags <- getDynFlags\n  emitComment (mkFastString \"dataToTag#\")\n  tmp <- newTemp (bWord dflags)\n  _ <- withSequel (AssignTo [tmp] False) (cgIdApp a [])\n  -- TODO: For small types look at the tag bits instead of reading info table\n  emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))]\n\ncgExpr (StgOpApp op args ty) = cgOpApp op args ty\ncgExpr (StgConApp con args _)= cgConApp con args\ncgExpr (StgTick t e)         = cgTick t >> cgExpr e\ncgExpr (StgLit lit)       = do cmm_lit <- cgLit lit\n                               emitReturn [CmmLit cmm_lit]\n\ncgExpr (StgLet _ binds expr) = do { cgBind binds;     cgExpr expr }\ncgExpr (StgLetNoEscape _ binds expr) =\n  do { u <- newUnique\n     ; let join_id = mkBlockId u\n     ; cgLneBinds join_id binds\n     ; r <- cgExpr expr\n     ; emitLabel join_id\n     ; return r }\n\ncgExpr (StgCase expr bndr alt_type alts) =\n  cgCase expr bndr alt_type alts\n\ncgExpr (StgLam {}) = panic \"cgExpr: StgLam\"\n\n------------------------------------------------------------------------\n--              Let no escape\n------------------------------------------------------------------------\n\n{- Generating code for a let-no-escape binding, aka join point is very\nvery similar to what we do for a case expression.  The duality is\nbetween\n        let-no-escape x = b\n        in e\nand\n        case e of ... -> b\n\nThat is, the RHS of 'x' (ie 'b') will execute *later*, just like\nthe alternative of the case; it needs to be compiled in an environment\nin which all volatile bindings are forgotten, and the free vars are\nbound only to stable things like stack locations..  The 'e' part will\nexecute *next*, just like the scrutinee of a case. -}\n\n-------------------------\ncgLneBinds :: BlockId -> CgStgBinding -> FCode ()\ncgLneBinds join_id (StgNonRec bndr rhs)\n  = do  { local_cc <- saveCurrentCostCentre\n                -- See Note [Saving the current cost centre]\n        ; (info, fcode) <- cgLetNoEscapeRhs join_id local_cc bndr rhs\n        ; fcode\n        ; addBindC info }\n\ncgLneBinds join_id (StgRec pairs)\n  = do  { local_cc <- saveCurrentCostCentre\n        ; r <- sequence $ unzipWith (cgLetNoEscapeRhs join_id local_cc) pairs\n        ; let (infos, fcodes) = unzip r\n        ; addBindsC infos\n        ; sequence_ fcodes\n        }\n\n-------------------------\ncgLetNoEscapeRhs\n    :: BlockId          -- join point for successor of let-no-escape\n    -> Maybe LocalReg   -- Saved cost centre\n    -> Id\n    -> CgStgRhs\n    -> FCode (CgIdInfo, FCode ())\n\ncgLetNoEscapeRhs join_id local_cc bndr rhs =\n  do { (info, rhs_code) <- cgLetNoEscapeRhsBody local_cc bndr rhs\n     ; let (bid, _) = expectJust \"cgLetNoEscapeRhs\" $ maybeLetNoEscape info\n     ; let code = do { (_, body) <- getCodeScoped rhs_code\n                     ; emitOutOfLine bid (first (<*> mkBranch join_id) body) }\n     ; return (info, code)\n     }\n\ncgLetNoEscapeRhsBody\n    :: Maybe LocalReg   -- Saved cost centre\n    -> Id\n    -> CgStgRhs\n    -> FCode (CgIdInfo, FCode ())\ncgLetNoEscapeRhsBody local_cc bndr (StgRhsClosure _ cc _upd args body)\n  = cgLetNoEscapeClosure bndr local_cc cc (nonVoidIds args) body\ncgLetNoEscapeRhsBody local_cc bndr (StgRhsCon cc con args)\n  = cgLetNoEscapeClosure bndr local_cc cc []\n      (StgConApp con args (pprPanic \"cgLetNoEscapeRhsBody\" $\n                           text \"StgRhsCon doesn't have type args\"))\n        -- For a constructor RHS we want to generate a single chunk of\n        -- code which can be jumped to from many places, which will\n        -- return the constructor. It's easy; just behave as if it\n        -- was an StgRhsClosure with a ConApp inside!\n\n-------------------------\ncgLetNoEscapeClosure\n        :: Id                   -- binder\n        -> Maybe LocalReg       -- Slot for saved current cost centre\n        -> CostCentreStack      -- XXX: *** NOT USED *** why not?\n        -> [NonVoid Id]         -- Args (as in \\ args -> body)\n        -> CgStgExpr            -- Body (as in above)\n        -> FCode (CgIdInfo, FCode ())\n\ncgLetNoEscapeClosure bndr cc_slot _unused_cc args body\n  = do dflags <- getDynFlags\n       return ( lneIdInfo dflags bndr args\n              , code )\n  where\n   code = forkLneBody $ do {\n            ; withNewTickyCounterLNE (idName bndr) args $ do\n            ; restoreCurrentCostCentre cc_slot\n            ; arg_regs <- bindArgsToRegs args\n            ; void $ noEscapeHeapCheck arg_regs (tickyEnterLNE >> cgExpr body) }\n\n\n------------------------------------------------------------------------\n--              Case expressions\n------------------------------------------------------------------------\n\n{- Note [Compiling case expressions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is quite interesting to decide whether to put a heap-check at the\nstart of each alternative.  Of course we certainly have to do so if\nthe case forces an evaluation, or if there is a primitive op which can\ntrigger GC.\n\nA more interesting situation is this (a Plan-B situation)\n\n        !P!;\n        ...P...\n        case x# of\n          0#      -> !Q!; ...Q...\n          default -> !R!; ...R...\n\nwhere !x! indicates a possible heap-check point. The heap checks\nin the alternatives *can* be omitted, in which case the topmost\nheapcheck will take their worst case into account.\n\nIn favour of omitting !Q!, !R!:\n\n - *May* save a heap overflow test,\n   if ...P... allocates anything.\n\n - We can use relative addressing from a single Hp to\n   get at all the closures so allocated.\n\n - No need to save volatile vars etc across heap checks\n   in !Q!, !R!\n\nAgainst omitting !Q!, !R!\n\n  - May put a heap-check into the inner loop.  Suppose\n        the main loop is P -> R -> P -> R...\n        Q is the loop exit, and only it does allocation.\n    This only hurts us if P does no allocation.  If P allocates,\n    then there is a heap check in the inner loop anyway.\n\n  - May do more allocation than reqd.  This sometimes bites us\n    badly.  For example, nfib (ha!) allocates about 30\\% more space if the\n    worst-casing is done, because many many calls to nfib are leaf calls\n    which don't need to allocate anything.\n\n    We can un-allocate, but that costs an instruction\n\nNeither problem hurts us if there is only one alternative.\n\nSuppose the inner loop is P->R->P->R etc.  Then here is\nhow many heap checks we get in the *inner loop* under various\nconditions\n\n  Alloc   Heap check in branches (!Q!, !R!)?\n  P Q R      yes     no (absorb to !P!)\n--------------------------------------\n  n n n      0          0\n  n y n      0          1\n  n . y      1          1\n  y . y      2          1\n  y . n      1          1\n\nBest choices: absorb heap checks from Q and R into !P! iff\n  a) P itself does some allocation\nor\n  b) P does allocation, or there is exactly one alternative\n\nWe adopt (b) because that is more likely to put the heap check at the\nentry to a function, when not many things are live.  After a bunch of\nsingle-branch cases, we may have lots of things live\n\nHence: two basic plans for\n\n        case e of r { alts }\n\n------ Plan A: the general case ---------\n\n        ...save current cost centre...\n\n        ...code for e,\n           with sequel (SetLocals r)\n\n        ...restore current cost centre...\n        ...code for alts...\n        ...alts do their own heap checks\n\n------ Plan B: special case when ---------\n  (i)  e does not allocate or call GC\n  (ii) either upstream code performs allocation\n       or there is just one alternative\n\n  Then heap allocation in the (single) case branch\n  is absorbed by the upstream check.\n  Very common example: primops on unboxed values\n\n        ...code for e,\n           with sequel (SetLocals r)...\n\n        ...code for alts...\n        ...no heap check...\n-}\n\n\n\n-------------------------------------\ndata GcPlan\n  = GcInAlts            -- Put a GC check at the start the case alternatives,\n        [LocalReg]      -- which binds these registers\n  | NoGcInAlts          -- The scrutinee is a primitive value, or a call to a\n                        -- primitive op which does no GC.  Absorb the allocation\n                        -- of the case alternative(s) into the upstream check\n\n-------------------------------------\ncgCase :: CgStgExpr -> Id -> AltType -> [CgStgAlt] -> FCode ReturnKind\n\ncgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts\n  | isEnumerationTyCon tycon -- Note [case on bool]\n  = do { tag_expr <- do_enum_primop op args\n\n       -- If the binder is not dead, convert the tag to a constructor\n       -- and assign it. See Note [Dead-binder optimisation]\n       ; unless (isDeadBinder bndr) $ do\n            { dflags <- getDynFlags\n            ; tmp_reg <- bindArgToReg (NonVoid bndr)\n            ; emitAssign (CmmLocal tmp_reg)\n                         (tagToClosure dflags tycon tag_expr) }\n\n       ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly)\n                                              (NonVoid bndr) alts\n                                 -- See Note [GC for conditionals]\n       ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1)\n       ; return AssignedDirectly\n       }\n  where\n    do_enum_primop :: PrimOp -> [StgArg] -> FCode CmmExpr\n    do_enum_primop TagToEnumOp [arg]  -- No code!\n      = getArgAmode (NonVoid arg)\n    do_enum_primop primop args\n      = do dflags <- getDynFlags\n           tmp <- newTemp (bWord dflags)\n           cgPrimOp [tmp] primop args\n           return (CmmReg (CmmLocal tmp))\n\n{-\nNote [case on bool]\n~~~~~~~~~~~~~~~~~~~\nThis special case handles code like\n\n  case a <# b of\n    True ->\n    False ->\n\n-->  case tagToEnum# (a <$# b) of\n        True -> .. ; False -> ...\n\n--> case (a <$# b) of r ->\n    case tagToEnum# r of\n        True -> .. ; False -> ...\n\nIf we let the ordinary case code handle it, we'll get something like\n\n tmp1 = a < b\n tmp2 = Bool_closure_tbl[tmp1]\n if (tmp2 & 7 != 0) then ... // normal tagged case\n\nbut this junk won't optimise away.  What we really want is just an\ninline comparison:\n\n if (a < b) then ...\n\nSo we add a special case to generate\n\n tmp1 = a < b\n if (tmp1 == 0) then ...\n\nand later optimisations will further improve this.\n\nNow that #6135 has been resolved it should be possible to remove that\nspecial case. The idea behind this special case and pre-6135 implementation\nof Bool-returning primops was that tagToEnum# was added implicitly in the\ncodegen and then optimized away. Now the call to tagToEnum# is explicit\nin the source code, which allows to optimize it away at the earlier stages\nof compilation (i.e. at the Core level).\n\nNote [Scrutinising VoidRep]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have this STG code:\n   f = \\[s : State# RealWorld] ->\n       case s of _ -> blah\nThis is very odd.  Why are we scrutinising a state token?  But it\ncan arise with bizarre NOINLINE pragmas (Trac #9964)\n    crash :: IO ()\n    crash = IO (\\s -> let {-# NOINLINE s' #-}\n                          s' = s\n                      in (# s', () #))\n\nNow the trouble is that 's' has VoidRep, and we do not bind void\narguments in the environment; they don't live anywhere.  See the\ncalls to nonVoidIds in various places.  So we must not look up\n's' in the environment.  Instead, just evaluate the RHS!  Simple.\n\nNote [Dead-binder optimisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA case-binder, or data-constructor argument, may be marked as dead,\nbecause we preserve occurrence-info on binders in CoreTidy (see\nCoreTidy.tidyIdBndr).\n\nIf the binder is dead, we can sometimes eliminate a load.  While\nCmmSink will eliminate that load, it's very easy to kill it at source\n(giving CmmSink less work to do), and in any case CmmSink only runs\nwith -O. Since the majority of case binders are dead, this\noptimisation probably still has a great benefit-cost ratio and we want\nto keep it for -O0. See also Phab:D5358.\n\nThis probably also was the reason for occurrence hack in Phab:D5339 to\nexist, perhaps because the occurrence information preserved by\n'CoreTidy.tidyIdBndr' was insufficient.  But now that CmmSink does the\njob we deleted the hacks.\n-}\n\ncgCase (StgApp v []) _ (PrimAlt _) alts\n  | isVoidRep (idPrimRep v)  -- See Note [Scrutinising VoidRep]\n  , [(DEFAULT, _, rhs)] <- alts\n  = cgExpr rhs\n\n{- Note [Dodgy unsafeCoerce 1]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n    case (x :: HValue) |> co of (y :: MutVar# Int)\n        DEFAULT -> ...\nWe want to gnerate an assignment\n     y := x\nWe want to allow this assignment to be generated in the case when the\ntypes are compatible, because this allows some slightly-dodgy but\noccasionally-useful casts to be used, such as in RtClosureInspect\nwhere we cast an HValue to a MutVar# so we can print out the contents\nof the MutVar#.  If instead we generate code that enters the HValue,\nthen we'll get a runtime panic, because the HValue really is a\nMutVar#.  The types are compatible though, so we can just generate an\nassignment.\n-}\ncgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts\n  | isUnliftedType (idType v)  -- Note [Dodgy unsafeCoerce 1]\n  || reps_compatible\n  = -- assignment suffices for unlifted types\n    do { dflags <- getDynFlags\n       ; unless reps_compatible $\n           pprPanic \"cgCase: reps do not match, perhaps a dodgy unsafeCoerce?\"\n                    (pp_bndr v $$ pp_bndr bndr)\n       ; v_info <- getCgIdInfo v\n       ; emitAssign (CmmLocal (idToReg dflags (NonVoid bndr)))\n                    (idInfoToAmode v_info)\n       -- Add bndr to the environment\n       ; _ <- bindArgToReg (NonVoid bndr)\n       ; cgAlts (NoGcInAlts,AssignedDirectly) (NonVoid bndr) alt_type alts }\n  where\n    reps_compatible = ((==) `on` (primRepSlot . idPrimRep)) v bndr\n      -- Must compare SlotTys, not proper PrimReps, because with unboxed sums,\n      -- the types of the binders are generated from slotPrimRep and might not\n      -- match. Test case:\n      --   swap :: (# Int | Int #) -> (# Int | Int #)\n      --   swap (# x | #) = (# | x #)\n      --   swap (# | y #) = (# y | #)\n\n    pp_bndr id = ppr id <+> dcolon <+> ppr (idType id) <+> parens (ppr (idPrimRep id))\n\n{- Note [Dodgy unsafeCoerce 2, #3132]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn all other cases of a lifted Id being cast to an unlifted type, the\nId should be bound to bottom, otherwise this is an unsafe use of\nunsafeCoerce.  We can generate code to enter the Id and assume that\nit will never return.  Hence, we emit the usual enter/return code, and\nbecause bottom must be untagged, it will be entered.  The Sequel is a\ntype-correct assignment, albeit bogus.  The (dead) continuation loops;\nit would be better to invoke some kind of panic function here.\n-}\ncgCase scrut@(StgApp v []) _ (PrimAlt _) _\n  = do { dflags <- getDynFlags\n       ; mb_cc <- maybeSaveCostCentre True\n       ; _ <- withSequel\n                  (AssignTo [idToReg dflags (NonVoid v)] False) (cgExpr scrut)\n       ; restoreCurrentCostCentre mb_cc\n       ; emitComment $ mkFastString \"should be unreachable code\"\n       ; l <- newBlockId\n       ; emitLabel l\n       ; emit (mkBranch l)  -- an infinite loop\n       ; return AssignedDirectly\n       }\n\n{- Note [Handle seq#]\n~~~~~~~~~~~~~~~~~~~~~\nSee Note [seq# magic] in PrelRules.\nThe special case for seq# in cgCase does this:\n\n  case seq# a s of v\n    (# s', a' #) -> e\n==>\n  case a of v\n    (# s', a' #) -> e\n\n(taking advantage of the fact that the return convention for (# State#, a #)\nis the same as the return convention for just 'a')\n-}\n\ncgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts\n  = -- Note [Handle seq#]\n    -- And see Note [seq# magic] in PrelRules\n    -- Use the same return convention as vanilla 'a'.\n    cgCase (StgApp a []) bndr alt_type alts\n\ncgCase scrut bndr alt_type alts\n  = -- the general case\n    do { dflags <- getDynFlags\n       ; up_hp_usg <- getVirtHp        -- Upstream heap usage\n       ; let ret_bndrs = chooseReturnBndrs bndr alt_type alts\n             alt_regs  = map (idToReg dflags) ret_bndrs\n       ; simple_scrut <- isSimpleScrut scrut alt_type\n       ; let do_gc  | is_cmp_op scrut  = False  -- See Note [GC for conditionals]\n                    | not simple_scrut = True\n                    | isSingleton alts = False\n                    | up_hp_usg > 0    = False\n                    | otherwise        = True\n               -- cf Note [Compiling case expressions]\n             gc_plan = if do_gc then GcInAlts alt_regs else NoGcInAlts\n\n       ; mb_cc <- maybeSaveCostCentre simple_scrut\n\n       ; let sequel = AssignTo alt_regs do_gc{- Note [scrut sequel] -}\n       ; ret_kind <- withSequel sequel (cgExpr scrut)\n       ; restoreCurrentCostCentre mb_cc\n       ; _ <- bindArgsToRegs ret_bndrs\n       ; cgAlts (gc_plan,ret_kind) (NonVoid bndr) alt_type alts\n       }\n  where\n    is_cmp_op (StgOpApp (StgPrimOp op) _ _) = isComparisonPrimOp op\n    is_cmp_op _                             = False\n\n{- Note [GC for conditionals]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor boolean conditionals it seems that we have always done NoGcInAlts.\nThat is, we have always done the GC check before the conditional.\nThis is enshrined in the special case for\n   case tagToEnum# (a>b) of ...\nSee Note [case on bool]\n\nIt's odd, and it's flagrantly inconsistent with the rules described\nNote [Compiling case expressions].  However, after eliminating the\ntagToEnum# (Trac #13397) we will have:\n   case (a>b) of ...\nRather than make it behave quite differently, I am testing for a\ncomparison operator here in in the general case as well.\n\nToDo: figure out what the Right Rule should be.\n\nNote [scrut sequel]\n~~~~~~~~~~~~~~~~~~~\nThe job of the scrutinee is to assign its value(s) to alt_regs.\nAdditionally, if we plan to do a heap-check in the alternatives (see\nNote [Compiling case expressions]), then we *must* retreat Hp to\nrecover any unused heap before passing control to the sequel.  If we\ndon't do this, then any unused heap will become slop because the heap\ncheck will reset the heap usage. Slop in the heap breaks LDV profiling\n(+RTS -hb) which needs to do a linear sweep through the nursery.\n\n\nNote [Inlining out-of-line primops and heap checks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf shouldInlinePrimOp returns True when called from StgCmmExpr for the\npurpose of heap check placement, we *must* inline the primop later in\nStgCmmPrim. If we don't things will go wrong.\n-}\n\n-----------------\nmaybeSaveCostCentre :: Bool -> FCode (Maybe LocalReg)\nmaybeSaveCostCentre simple_scrut\n  | simple_scrut = return Nothing\n  | otherwise    = saveCurrentCostCentre\n\n\n-----------------\nisSimpleScrut :: CgStgExpr -> AltType -> FCode Bool\n-- Simple scrutinee, does not block or allocate; hence safe to amalgamate\n-- heap usage from alternatives into the stuff before the case\n-- NB: if you get this wrong, and claim that the expression doesn't allocate\n--     when it does, you'll deeply mess up allocation\nisSimpleScrut (StgOpApp op args _) _       = isSimpleOp op args\nisSimpleScrut (StgLit _)       _           = return True       -- case 1# of { 0# -> ..; ... }\nisSimpleScrut (StgApp _ [])    (PrimAlt _) = return True       -- case x# of { 0# -> ..; ... }\nisSimpleScrut _                _           = return False\n\nisSimpleOp :: StgOp -> [StgArg] -> FCode Bool\n-- True iff the op cannot block or allocate\nisSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSafe safe)\n-- dataToTag# evalautes its argument, see Note [dataToTag#] in primops.txt.pp\nisSimpleOp (StgPrimOp DataToTagOp) _ = return False\nisSimpleOp (StgPrimOp op) stg_args                  = do\n    arg_exprs <- getNonVoidArgAmodes stg_args\n    dflags <- getDynFlags\n    -- See Note [Inlining out-of-line primops and heap checks]\n    return $! isJust $ shouldInlinePrimOp dflags op arg_exprs\nisSimpleOp (StgPrimCallOp _) _                           = return False\n\n-----------------\nchooseReturnBndrs :: Id -> AltType -> [CgStgAlt] -> [NonVoid Id]\n-- These are the binders of a case that are assigned by the evaluation of the\n-- scrutinee.\n-- They're non-void, see Note [Post-unarisation invariants] in UnariseStg.\nchooseReturnBndrs bndr (PrimAlt _) _alts\n  = assertNonVoidIds [bndr]\n\nchooseReturnBndrs _bndr (MultiValAlt n) [(_, ids, _)]\n  = ASSERT2(ids `lengthIs` n, ppr n $$ ppr ids $$ ppr _bndr)\n    assertNonVoidIds ids     -- 'bndr' is not assigned!\n\nchooseReturnBndrs bndr (AlgAlt _) _alts\n  = assertNonVoidIds [bndr]  -- Only 'bndr' is assigned\n\nchooseReturnBndrs bndr PolyAlt _alts\n  = assertNonVoidIds [bndr]  -- Only 'bndr' is assigned\n\nchooseReturnBndrs _ _ _ = panic \"chooseReturnBndrs\"\n                             -- MultiValAlt has only one alternative\n\n-------------------------------------\ncgAlts :: (GcPlan,ReturnKind) -> NonVoid Id -> AltType -> [CgStgAlt]\n       -> FCode ReturnKind\n-- At this point the result of the case are in the binders\ncgAlts gc_plan _bndr PolyAlt [(_, _, rhs)]\n  = maybeAltHeapCheck gc_plan (cgExpr rhs)\n\ncgAlts gc_plan _bndr (MultiValAlt _) [(_, _, rhs)]\n  = maybeAltHeapCheck gc_plan (cgExpr rhs)\n        -- Here bndrs are *already* in scope, so don't rebind them\n\ncgAlts gc_plan bndr (PrimAlt _) alts\n  = do  { dflags <- getDynFlags\n\n        ; tagged_cmms <- cgAltRhss gc_plan bndr alts\n\n        ; let bndr_reg = CmmLocal (idToReg dflags bndr)\n              (DEFAULT,deflt) = head tagged_cmms\n                -- PrimAlts always have a DEFAULT case\n                -- and it always comes first\n\n              tagged_cmms' = [(lit,code)\n                             | (LitAlt lit, code) <- tagged_cmms]\n        ; emitCmmLitSwitch (CmmReg bndr_reg) tagged_cmms' deflt\n        ; return AssignedDirectly }\n\ncgAlts gc_plan bndr (AlgAlt tycon) alts\n  = do  { dflags <- getDynFlags\n\n        ; (mb_deflt, branches) <- cgAlgAltRhss gc_plan bndr alts\n\n        ; let fam_sz   = tyConFamilySize tycon\n              bndr_reg = CmmLocal (idToReg dflags bndr)\n\n                    -- Is the constructor tag in the node reg?\n        ; if isSmallFamily dflags fam_sz\n          then do\n                let   -- Yes, bndr_reg has constr. tag in ls bits\n                   tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg)\n                   branches' = [(tag+1,branch) | (tag,branch) <- branches]\n                emitSwitch tag_expr branches' mb_deflt 1 fam_sz\n\n           else -- No, get tag from info table\n                let -- Note that ptr _always_ has tag 1\n                    -- when the family size is big enough\n                    untagged_ptr = cmmRegOffB bndr_reg (-1)\n                    tag_expr = getConstrTag dflags (untagged_ptr)\n                in emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)\n\n        ; return AssignedDirectly }\n\ncgAlts _ _ _ _ = panic \"cgAlts\"\n        -- UbxTupAlt and PolyAlt have only one alternative\n\n\n-- Note [alg-alt heap check]\n--\n-- In an algebraic case with more than one alternative, we will have\n-- code like\n--\n-- L0:\n--   x = R1\n--   goto L1\n-- L1:\n--   if (x & 7 >= 2) then goto L2 else goto L3\n-- L2:\n--   Hp = Hp + 16\n--   if (Hp > HpLim) then goto L4\n--   ...\n-- L4:\n--   call gc() returns to L5\n-- L5:\n--   x = R1\n--   goto L1\n\n-------------------\ncgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [CgStgAlt]\n             -> FCode ( Maybe CmmAGraphScoped\n                      , [(ConTagZ, CmmAGraphScoped)] )\ncgAlgAltRhss gc_plan bndr alts\n  = do { tagged_cmms <- cgAltRhss gc_plan bndr alts\n\n       ; let { mb_deflt = case tagged_cmms of\n                           ((DEFAULT,rhs) : _) -> Just rhs\n                           _other              -> Nothing\n                            -- DEFAULT is always first, if present\n\n              ; branches = [ (dataConTagZ con, cmm)\n                           | (DataAlt con, cmm) <- tagged_cmms ]\n              }\n\n       ; return (mb_deflt, branches)\n       }\n\n\n-------------------\ncgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [CgStgAlt]\n          -> FCode [(AltCon, CmmAGraphScoped)]\ncgAltRhss gc_plan bndr alts = do\n  dflags <- getDynFlags\n  let\n    base_reg = idToReg dflags bndr\n    cg_alt :: CgStgAlt -> FCode (AltCon, CmmAGraphScoped)\n    cg_alt (con, bndrs, rhs)\n      = getCodeScoped             $\n        maybeAltHeapCheck gc_plan $\n        do { _ <- bindConArgs con base_reg (assertNonVoidIds bndrs)\n                    -- alt binders are always non-void,\n                    -- see Note [Post-unarisation invariants] in UnariseStg\n           ; _ <- cgExpr rhs\n           ; return con }\n  forkAlts (map cg_alt alts)\n\nmaybeAltHeapCheck :: (GcPlan,ReturnKind) -> FCode a -> FCode a\nmaybeAltHeapCheck (NoGcInAlts,_)  code = code\nmaybeAltHeapCheck (GcInAlts regs, AssignedDirectly) code =\n  altHeapCheck regs code\nmaybeAltHeapCheck (GcInAlts regs, ReturnedTo lret off) code =\n  altHeapCheckReturnsTo regs lret off code\n\n-----------------------------------------------------------------------------\n--      Tail calls\n-----------------------------------------------------------------------------\n\ncgConApp :: DataCon -> [StgArg] -> FCode ReturnKind\ncgConApp con stg_args\n  | isUnboxedTupleCon con       -- Unboxed tuple: assign and return\n  = do { arg_exprs <- getNonVoidArgAmodes stg_args\n       ; tickyUnboxedTupleReturn (length arg_exprs)\n       ; emitReturn arg_exprs }\n\n  | otherwise   --  Boxed constructors; allocate and return\n  = ASSERT2( stg_args `lengthIs` countConRepArgs con, ppr con <> parens (ppr (countConRepArgs con)) <+> ppr stg_args )\n    do  { (idinfo, fcode_init) <- buildDynCon (dataConWorkId con) False\n                                     currentCCS con (assertNonVoidStgArgs stg_args)\n                                     -- con args are always non-void,\n                                     -- see Note [Post-unarisation invariants] in UnariseStg\n                -- The first \"con\" says that the name bound to this\n                -- closure is \"con\", which is a bit of a fudge, but\n                -- it only affects profiling (hence the False)\n\n        ; emit =<< fcode_init\n        ; tickyReturnNewCon (length stg_args)\n        ; emitReturn [idInfoToAmode idinfo] }\n\ncgIdApp :: Id -> [StgArg] -> FCode ReturnKind\ncgIdApp fun_id args = do\n    dflags         <- getDynFlags\n    fun_info       <- getCgIdInfo fun_id\n    self_loop_info <- getSelfLoop\n    let fun_arg     = StgVarArg fun_id\n        fun_name    = idName    fun_id\n        fun         = idInfoToAmode fun_info\n        lf_info     = cg_lf         fun_info\n        n_args      = length args\n        v_args      = length $ filter (isVoidTy . stgArgType) args\n        node_points dflags = nodeMustPointToIt dflags lf_info\n    case getCallMethod dflags fun_name fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of\n            -- A value in WHNF, so we can just return it.\n        ReturnIt\n          | isVoidTy (idType fun_id) -> emitReturn []\n          | otherwise                -> emitReturn [fun]\n          -- ToDo: does ReturnIt guarantee tagged?\n\n        EnterIt -> ASSERT( null args )  -- Discarding arguments\n                   emitEnter fun\n\n        SlowCall -> do      -- A slow function call via the RTS apply routines\n                { tickySlowCall lf_info args\n                ; emitComment $ mkFastString \"slowCall\"\n                ; slowCall fun args }\n\n        -- A direct function call (possibly with some left-over arguments)\n        DirectEntry lbl arity -> do\n                { tickyDirectCall arity args\n                ; if node_points dflags\n                     then directCall NativeNodeCall   lbl arity (fun_arg:args)\n                     else directCall NativeDirectCall lbl arity args }\n\n        -- Let-no-escape call or self-recursive tail-call\n        JumpToIt blk_id lne_regs -> do\n          { adjustHpBackwards -- always do this before a tail-call\n          ; cmm_args <- getNonVoidArgAmodes args\n          ; emitMultiAssign lne_regs cmm_args\n          ; emit (mkBranch blk_id)\n          ; return AssignedDirectly }\n\n-- Note [Self-recursive tail calls]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Self-recursive tail calls can be optimized into a local jump in the same\n-- way as let-no-escape bindings (see Note [What is a non-escaping let] in\n-- stgSyn/CoreToStg.hs). Consider this:\n--\n-- foo.info:\n--     a = R1  // calling convention\n--     b = R2\n--     goto L1\n-- L1: ...\n--     ...\n-- ...\n-- L2: R1 = x\n--     R2 = y\n--     call foo(R1,R2)\n--\n-- Instead of putting x and y into registers (or other locations required by the\n-- calling convention) and performing a call we can put them into local\n-- variables a and b and perform jump to L1:\n--\n-- foo.info:\n--     a = R1\n--     b = R2\n--     goto L1\n-- L1: ...\n--     ...\n-- ...\n-- L2: a = x\n--     b = y\n--     goto L1\n--\n-- This can be done only when function is calling itself in a tail position\n-- and only if the call passes number of parameters equal to function's arity.\n-- Note that this cannot be performed if a function calls itself with a\n-- continuation.\n--\n-- This in fact implements optimization known as \"loopification\". It was\n-- described in \"Low-level code optimizations in the Glasgow Haskell Compiler\"\n-- by Krzysztof Wo\u00c5\u203a, though we use different approach. Krzysztof performed his\n-- optimization at the Cmm level, whereas we perform ours during code generation\n-- (Stg-to-Cmm pass) essentially making sure that optimized Cmm code is\n-- generated in the first place.\n--\n-- Implementation is spread across a couple of places in the code:\n--\n--   * FCode monad stores additional information in its reader environment\n--     (cgd_self_loop field). This information tells us which function can\n--     tail call itself in an optimized way (it is the function currently\n--     being compiled), what is the label of a loop header (L1 in example above)\n--     and information about local registers in which we should arguments\n--     before making a call (this would be a and b in example above).\n--\n--   * Whenever we are compiling a function, we set that information to reflect\n--     the fact that function currently being compiled can be jumped to, instead\n--     of called. This is done in closureCodyBody in StgCmmBind.\n--\n--   * We also have to emit a label to which we will be jumping. We make sure\n--     that the label is placed after a stack check but before the heap\n--     check. The reason is that making a recursive tail-call does not increase\n--     the stack so we only need to check once. But it may grow the heap, so we\n--     have to repeat the heap check in every self-call. This is done in\n--     do_checks in StgCmmHeap.\n--\n--   * When we begin compilation of another closure we remove the additional\n--     information from the environment. This is done by forkClosureBody\n--     in StgCmmMonad. Other functions that duplicate the environment -\n--     forkLneBody, forkAlts, codeOnly - duplicate that information. In other\n--     words, we only need to clean the environment of the self-loop information\n--     when compiling right hand side of a closure (binding).\n--\n--   * When compiling a call (cgIdApp) we use getCallMethod to decide what kind\n--     of call will be generated. getCallMethod decides to generate a self\n--     recursive tail call when (a) environment stores information about\n--     possible self tail-call; (b) that tail call is to a function currently\n--     being compiled; (c) number of passed non-void arguments is equal to\n--     function's arity. (d) loopification is turned on via -floopification\n--     command-line option.\n--\n--   * Command line option to turn loopification on and off is implemented in\n--     DynFlags.\n--\n--\n-- Note [Void arguments in self-recursive tail calls]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- State# tokens can get in the way of the loopification optimization as seen in\n-- #11372. Consider this:\n--\n-- foo :: [a]\n--     -> (a -> State# s -> (# State s, Bool #))\n--     -> State# s\n--     -> (# State# s, Maybe a #)\n-- foo [] f s = (# s, Nothing #)\n-- foo (x:xs) f s = case f x s of\n--      (# s', b #) -> case b of\n--          True -> (# s', Just x #)\n--          False -> foo xs f s'\n--\n-- We would like to compile the call to foo as a local jump instead of a call\n-- (see Note [Self-recursive tail calls]). However, the generated function has\n-- an arity of 2 while we apply it to 3 arguments, one of them being of void\n-- type. Thus, we mustn't count arguments of void type when checking whether\n-- we can turn a call into a self-recursive jump.\n--\n\nemitEnter :: CmmExpr -> FCode ReturnKind\nemitEnter fun = do\n  { dflags <- getDynFlags\n  ; adjustHpBackwards\n  ; sequel <- getSequel\n  ; updfr_off <- getUpdFrameOff\n  ; case sequel of\n      -- For a return, we have the option of generating a tag-test or\n      -- not.  If the value is tagged, we can return directly, which\n      -- is quicker than entering the value.  This is a code\n      -- size/speed trade-off: when optimising for speed rather than\n      -- size we could generate the tag test.\n      --\n      -- Right now, we do what the old codegen did, and omit the tag\n      -- test, just generating an enter.\n      Return -> do\n        { let entry = entryCode dflags $ closureInfoPtr dflags $ CmmReg nodeReg\n        ; emit $ mkJump dflags NativeNodeCall entry\n                        [cmmUntag dflags fun] updfr_off\n        ; return AssignedDirectly\n        }\n\n      -- The result will be scrutinised in the sequel.  This is where\n      -- we generate a tag-test to avoid entering the closure if\n      -- possible.\n      --\n      -- The generated code will be something like this:\n      --\n      --    R1 = fun  -- copyout\n      --    if (fun & 7 != 0) goto Lret else goto Lcall\n      --  Lcall:\n      --    call [fun] returns to Lret\n      --  Lret:\n      --    fun' = R1  -- copyin\n      --    ...\n      --\n      -- Note in particular that the label Lret is used as a\n      -- destination by both the tag-test and the call.  This is\n      -- because Lret will necessarily be a proc-point, and we want to\n      -- ensure that we generate only one proc-point for this\n      -- sequence.\n      --\n      -- Furthermore, we tell the caller that we generated a native\n      -- return continuation by returning (ReturnedTo Lret off), so\n      -- that the continuation can be reused by the heap-check failure\n      -- code in the enclosing case expression.\n      --\n      AssignTo res_regs _ -> do\n       { lret <- newBlockId\n       ; let (off, _, copyin) = copyInOflow dflags NativeReturn (Young lret) res_regs []\n       ; lcall <- newBlockId\n       ; updfr_off <- getUpdFrameOff\n       ; let area = Young lret\n       ; let (outArgs, regs, copyout) = copyOutOflow dflags NativeNodeCall Call area\n                                          [fun] updfr_off []\n         -- refer to fun via nodeReg after the copyout, to avoid having\n         -- both live simultaneously; this sometimes enables fun to be\n         -- inlined in the RHS of the R1 assignment.\n       ; let entry = entryCode dflags (closureInfoPtr dflags (CmmReg nodeReg))\n             the_call = toCall entry (Just lret) updfr_off off outArgs regs\n       ; tscope <- getTickScope\n       ; emit $\n           copyout <*>\n           mkCbranch (cmmIsTagged dflags (CmmReg nodeReg))\n                     lret lcall Nothing <*>\n           outOfLine lcall (the_call,tscope) <*>\n           mkLabel lret tscope <*>\n           copyin\n       ; return (ReturnedTo lret off)\n       }\n  }\n\n------------------------------------------------------------------------\n--              Ticks\n------------------------------------------------------------------------\n\n-- | Generate Cmm code for a tick. Depending on the type of Tickish,\n-- this will either generate actual Cmm instrumentation code, or\n-- simply pass on the annotation as a @CmmTickish@.\ncgTick :: Tickish Id -> FCode ()\ncgTick tick\n  = do { dflags <- getDynFlags\n       ; case tick of\n           ProfNote   cc t p -> emitSetCCC cc t p\n           HpcTick    m n    -> emit (mkTickBox dflags m n)\n           SourceNote s n    -> emitTick $ SourceNote s n\n           _other            -> return () -- ignore\n       }\n", "num_lines": 993}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Our extended FCode monad.\n\n-- We add a mapping from names to CmmExpr, to support local variable names in\n-- the concrete C-- code.  The unique supply of the underlying FCode monad\n-- is used to grab a new unique for each local variable.\n\n-- In C--, a local variable can be declared anywhere within a proc,\n-- and it scopes from the beginning of the proc to the end.  Hence, we have\n-- to collect declarations as we parse the proc, and feed the environment\n-- back in circularly (to avoid a two-pass algorithm).\n\nmodule StgCmmExtCode (\n        CmmParse, unEC,\n        Named(..), Env,\n\n        loopDecls,\n        getEnv,\n\n        withName,\n        getName,\n\n        newLocal,\n        newLabel,\n        newBlockId,\n        newFunctionName,\n        newImport,\n        lookupLabel,\n        lookupName,\n\n        code,\n        emit, emitLabel, emitAssign, emitStore,\n        getCode, getCodeR, getCodeScoped,\n        emitOutOfLine,\n        withUpdFrameOff, getUpdFrameOff\n)\n\nwhere\n\nimport GhcPrelude\n\nimport qualified StgCmmMonad as F\nimport StgCmmMonad (FCode, newUnique)\n\nimport Cmm\nimport CLabel\nimport MkGraph\n\nimport BlockId\nimport DynFlags\nimport FastString\nimport Module\nimport UniqFM\nimport Unique\nimport UniqSupply\n\nimport Control.Monad (liftM, ap)\n\n-- | The environment contains variable definitions or blockids.\ndata Named\n        = VarN CmmExpr          -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,\n                                --      eg, RtsLabel, ForeignLabel, CmmLabel etc.\n\n        | FunN   UnitId      -- ^ A function name from this package\n        | LabelN BlockId                -- ^ A blockid of some code or data.\n\n-- | An environment of named things.\ntype Env        = UniqFM Named\n\n-- | Local declarations that are in scope during code generation.\ntype Decls      = [(FastString,Named)]\n\n-- | Does a computation in the FCode monad, with a current environment\n--      and a list of local declarations. Returns the resulting list of declarations.\nnewtype CmmParse a\n        = EC { unEC :: String -> Env -> Decls -> FCode (Decls, a) }\n\ntype ExtCode = CmmParse ()\n\nreturnExtFC :: a -> CmmParse a\nreturnExtFC a   = EC $ \\_ _ s -> return (s, a)\n\nthenExtFC :: CmmParse a -> (a -> CmmParse b) -> CmmParse b\nthenExtFC (EC m) k = EC $ \\c e s -> do (s',r) <- m c e s; unEC (k r) c e s'\n\ninstance Functor CmmParse where\n      fmap = liftM\n\ninstance Applicative CmmParse where\n      pure = returnExtFC\n      (<*>) = ap\n\ninstance Monad CmmParse where\n  (>>=) = thenExtFC\n\ninstance MonadUnique CmmParse where\n  getUniqueSupplyM = code getUniqueSupplyM\n  getUniqueM = EC $ \\_ _ decls -> do\n    u <- getUniqueM\n    return (decls, u)\n\ninstance HasDynFlags CmmParse where\n    getDynFlags = EC (\\_ _ d -> do dflags <- getDynFlags\n                                   return (d, dflags))\n\n\n-- | Takes the variable decarations and imports from the monad\n--      and makes an environment, which is looped back into the computation.\n--      In this way, we can have embedded declarations that scope over the whole\n--      procedure, and imports that scope over the entire module.\n--      Discards the local declaration contained within decl'\n--\nloopDecls :: CmmParse a -> CmmParse a\nloopDecls (EC fcode) =\n      EC $ \\c e globalDecls -> do\n        (_, a) <- F.fixC $ \\ ~(decls, _) ->\n          fcode c (addListToUFM e decls) globalDecls\n        return (globalDecls, a)\n\n\n-- | Get the current environment from the monad.\ngetEnv :: CmmParse Env\ngetEnv  = EC $ \\_ e s -> return (s, e)\n\n-- | Get the current context name from the monad\ngetName :: CmmParse String\ngetName  = EC $ \\c _ s -> return (s, c)\n\n-- | Set context name for a sub-parse\nwithName :: String -> CmmParse a -> CmmParse a\nwithName c' (EC fcode) = EC $ \\_ e s -> fcode c' e s\n\naddDecl :: FastString -> Named -> ExtCode\naddDecl name named = EC $ \\_ _ s -> return ((name, named) : s, ())\n\n\n-- | Add a new variable to the list of local declarations.\n--      The CmmExpr says where the value is stored.\naddVarDecl :: FastString -> CmmExpr -> ExtCode\naddVarDecl var expr = addDecl var (VarN expr)\n\n-- | Add a new label to the list of local declarations.\naddLabel :: FastString -> BlockId -> ExtCode\naddLabel name block_id = addDecl name (LabelN block_id)\n\n\n-- | Create a fresh local variable of a given type.\nnewLocal\n        :: CmmType              -- ^ data type\n        -> FastString           -- ^ name of variable\n        -> CmmParse LocalReg    -- ^ register holding the value\n\nnewLocal ty name = do\n   u <- code newUnique\n   let reg = LocalReg u ty\n   addVarDecl name (CmmReg (CmmLocal reg))\n   return reg\n\n\n-- | Allocate a fresh label.\nnewLabel :: FastString -> CmmParse BlockId\nnewLabel name = do\n   u <- code newUnique\n   addLabel name (mkBlockId u)\n   return (mkBlockId u)\n\n-- | Add add a local function to the environment.\nnewFunctionName\n        :: FastString   -- ^ name of the function\n        -> UnitId    -- ^ package of the current module\n        -> ExtCode\n\nnewFunctionName name pkg = addDecl name (FunN pkg)\n\n\n-- | Add an imported foreign label to the list of local declarations.\n--      If this is done at the start of the module the declaration will scope\n--      over the whole module.\nnewImport\n        :: (FastString, CLabel)\n        -> CmmParse ()\n\nnewImport (name, cmmLabel)\n   = addVarDecl name (CmmLit (CmmLabel cmmLabel))\n\n\n-- | Lookup the BlockId bound to the label with this name.\n--      If one hasn't been bound yet, create a fresh one based on the\n--      Unique of the name.\nlookupLabel :: FastString -> CmmParse BlockId\nlookupLabel name = do\n  env <- getEnv\n  return $\n     case lookupUFM env name of\n        Just (LabelN l) -> l\n        _other          -> mkBlockId (newTagUnique (getUnique name) 'L')\n\n\n-- | Lookup the location of a named variable.\n--      Unknown names are treated as if they had been 'import'ed from the runtime system.\n--      This saves us a lot of bother in the RTS sources, at the expense of\n--      deferring some errors to link time.\nlookupName :: FastString -> CmmParse CmmExpr\nlookupName name = do\n  env    <- getEnv\n  return $\n     case lookupUFM env name of\n        Just (VarN e)   -> e\n        Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg          name))\n        _other          -> CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId name))\n\n\n-- | Lift an FCode computation into the CmmParse monad\ncode :: FCode a -> CmmParse a\ncode fc = EC $ \\_ _ s -> do\n                r <- fc\n                return (s, r)\n\nemit :: CmmAGraph -> CmmParse ()\nemit = code . F.emit\n\nemitLabel :: BlockId -> CmmParse ()\nemitLabel = code . F.emitLabel\n\nemitAssign :: CmmReg  -> CmmExpr -> CmmParse ()\nemitAssign l r = code (F.emitAssign l r)\n\nemitStore :: CmmExpr  -> CmmExpr -> CmmParse ()\nemitStore l r = code (F.emitStore l r)\n\ngetCode :: CmmParse a -> CmmParse CmmAGraph\ngetCode (EC ec) = EC $ \\c e s -> do\n  ((s',_), gr) <- F.getCodeR (ec c e s)\n  return (s', gr)\n\ngetCodeR :: CmmParse a -> CmmParse (a, CmmAGraph)\ngetCodeR (EC ec) = EC $ \\c e s -> do\n  ((s', r), gr) <- F.getCodeR (ec c e s)\n  return (s', (r,gr))\n\ngetCodeScoped :: CmmParse a -> CmmParse (a, CmmAGraphScoped)\ngetCodeScoped (EC ec) = EC $ \\c e s -> do\n  ((s', r), gr) <- F.getCodeScoped (ec c e s)\n  return (s', (r,gr))\n\nemitOutOfLine :: BlockId -> CmmAGraphScoped -> CmmParse ()\nemitOutOfLine l g = code (F.emitOutOfLine l g)\n\nwithUpdFrameOff :: UpdFrameOffset -> CmmParse () -> CmmParse ()\nwithUpdFrameOff size inner\n  = EC $ \\c e s -> F.withUpdFrameOff size $ (unEC inner) c e s\n\ngetUpdFrameOff :: CmmParse UpdFrameOffset\ngetUpdFrameOff = code $ F.getUpdFrameOff\n", "num_lines": 254}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Code generation for foreign calls.\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmForeign (\n  cgForeignCall,\n  emitPrimCall, emitCCall,\n  emitForeignCall,     -- For CmmParse\n  emitSaveThreadState,\n  saveThreadState,\n  emitLoadThreadState,\n  loadThreadState,\n  emitOpenNursery,\n  emitCloseNursery,\n ) where\n\nimport GhcPrelude hiding( succ, (<*>) )\n\nimport StgSyn\nimport StgCmmProf (storeCurCCS, ccsType)\nimport StgCmmEnv\nimport StgCmmMonad\nimport StgCmmUtils\nimport StgCmmClosure\nimport StgCmmLayout\n\nimport BlockId (newBlockId)\nimport Cmm\nimport CmmUtils\nimport MkGraph\nimport Type\nimport RepType\nimport TysPrim\nimport CLabel\nimport SMRep\nimport ForeignCall\nimport DynFlags\nimport Maybes\nimport Outputable\nimport UniqSupply\nimport BasicTypes\n\nimport Control.Monad\n\n-----------------------------------------------------------------------------\n-- Code generation for Foreign Calls\n-----------------------------------------------------------------------------\n\n-- | emit code for a foreign call, and return the results to the sequel.\n--\ncgForeignCall :: ForeignCall            -- the op\n              -> [StgArg]               -- x,y    arguments\n              -> Type                   -- result type\n              -> FCode ReturnKind\n\ncgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty\n  = do  { dflags <- getDynFlags\n        ; let -- in the stdcall calling convention, the symbol needs @size appended\n              -- to it, where size is the total number of bytes of arguments.  We\n              -- attach this info to the CLabel here, and the CLabel pretty printer\n              -- will generate the suffix when the label is printed.\n            call_size args\n              | StdCallConv <- cconv = Just (sum (map arg_size args))\n              | otherwise            = Nothing\n\n              -- ToDo: this might not be correct for 64-bit API\n            arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType dflags arg)\n                                     (wORD_SIZE dflags)\n        ; cmm_args <- getFCallArgs stg_args\n        ; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty\n        ; let ((call_args, arg_hints), cmm_target)\n                = case target of\n                   StaticTarget _ _   _      False ->\n                       panic \"cgForeignCall: unexpected FFI value import\"\n                   StaticTarget _ lbl mPkgId True\n                     -> let labelSource\n                                = case mPkgId of\n                                        Nothing         -> ForeignLabelInThisPackage\n                                        Just pkgId      -> ForeignLabelInPackage pkgId\n                            size = call_size cmm_args\n                        in  ( unzip cmm_args\n                            , CmmLit (CmmLabel\n                                        (mkForeignLabel lbl size labelSource IsFunction)))\n\n                   DynamicTarget    ->  case cmm_args of\n                                           (fn,_):rest -> (unzip rest, fn)\n                                           [] -> panic \"cgForeignCall []\"\n              fc = ForeignConvention cconv arg_hints res_hints CmmMayReturn\n              call_target = ForeignTarget cmm_target fc\n\n        -- we want to emit code for the call, and then emitReturn.\n        -- However, if the sequel is AssignTo, we shortcut a little\n        -- and generate a foreign call that assigns the results\n        -- directly.  Otherwise we end up generating a bunch of\n        -- useless \"r = r\" assignments, which are not merely annoying:\n        -- they prevent the common block elimination from working correctly\n        -- in the case of a safe foreign call.\n        -- See Note [safe foreign call convention]\n        --\n        ; sequel <- getSequel\n        ; case sequel of\n            AssignTo assign_to_these _ ->\n                emitForeignCall safety assign_to_these call_target call_args\n\n            _something_else ->\n                do { _ <- emitForeignCall safety res_regs call_target call_args\n                   ; emitReturn (map (CmmReg . CmmLocal) res_regs)\n                   }\n         }\n\n{- Note [safe foreign call convention]\n\nThe simple thing to do for a safe foreign call would be the same as an\nunsafe one: just\n\n    emitForeignCall ...\n    emitReturn ...\n\nbut consider what happens in this case\n\n   case foo x y z of\n     (# s, r #) -> ...\n\nThe sequel is AssignTo [r].  The call to newUnboxedTupleRegs picks [r]\nas the result reg, and we generate\n\n  r = foo(x,y,z) returns to L1  -- emitForeignCall\n L1:\n  r = r  -- emitReturn\n  goto L2\nL2:\n  ...\n\nNow L1 is a proc point (by definition, it is the continuation of the\nsafe foreign call).  If L2 does a heap check, then L2 will also be a\nproc point.\n\nFurthermore, the stack layout algorithm has to arrange to save r\nsomewhere between the call and the jump to L1, which is annoying: we\nwould have to treat r differently from the other live variables, which\nhave to be saved *before* the call.\n\nSo we adopt a special convention for safe foreign calls: the results\nare copied out according to the NativeReturn convention by the call,\nand the continuation of the call should copyIn the results.  (The\ncopyOut code is actually inserted when the safe foreign call is\nlowered later).  The result regs attached to the safe foreign call are\nonly used temporarily to hold the results before they are copied out.\n\nWe will now generate this:\n\n  r = foo(x,y,z) returns to L1\n L1:\n  r = R1  -- copyIn, inserted by mkSafeCall\n  goto L2\n L2:\n  ... r ...\n\nAnd when the safe foreign call is lowered later (see Note [lower safe\nforeign calls]) we get this:\n\n  suspendThread()\n  r = foo(x,y,z)\n  resumeThread()\n  R1 = r  -- copyOut, inserted by lowerSafeForeignCall\n  jump L1\n L1:\n  r = R1  -- copyIn, inserted by mkSafeCall\n  goto L2\n L2:\n  ... r ...\n\nNow consider what happens if L2 does a heap check: the Adams\noptimisation kicks in and commons up L1 with the heap-check\ncontinuation, resulting in just one proc point instead of two. Yay!\n-}\n\n\nemitCCall :: [(CmmFormal,ForeignHint)]\n          -> CmmExpr\n          -> [(CmmActual,ForeignHint)]\n          -> FCode ()\nemitCCall hinted_results fn hinted_args\n  = void $ emitForeignCall PlayRisky results target args\n  where\n    (args, arg_hints) = unzip hinted_args\n    (results, result_hints) = unzip hinted_results\n    target = ForeignTarget fn fc\n    fc = ForeignConvention CCallConv arg_hints result_hints CmmMayReturn\n\n\nemitPrimCall :: [CmmFormal] -> CallishMachOp -> [CmmActual] -> FCode ()\nemitPrimCall res op args\n  = void $ emitForeignCall PlayRisky res (PrimTarget op) args\n\n-- alternative entry point, used by CmmParse\nemitForeignCall\n        :: Safety\n        -> [CmmFormal]          -- where to put the results\n        -> ForeignTarget        -- the op\n        -> [CmmActual]          -- arguments\n        -> FCode ReturnKind\nemitForeignCall safety results target args\n  | not (playSafe safety) = do\n    dflags <- getDynFlags\n    let (caller_save, caller_load) = callerSaveVolatileRegs dflags\n    emit caller_save\n    target' <- load_target_into_temp target\n    args' <- mapM maybe_assign_temp args\n    emit $ mkUnsafeCall target' results args'\n    emit caller_load\n    return AssignedDirectly\n\n  | otherwise = do\n    dflags <- getDynFlags\n    updfr_off <- getUpdFrameOff\n    target' <- load_target_into_temp target\n    args' <- mapM maybe_assign_temp args\n    k <- newBlockId\n    let (off, _, copyout) = copyInOflow dflags NativeReturn (Young k) results []\n       -- see Note [safe foreign call convention]\n    tscope <- getTickScope\n    emit $\n           (    mkStore (CmmStackSlot (Young k) (widthInBytes (wordWidth dflags)))\n                        (CmmLit (CmmBlock k))\n            <*> mkLast (CmmForeignCall { tgt  = target'\n                                       , res  = results\n                                       , args = args'\n                                       , succ = k\n                                       , ret_args = off\n                                       , ret_off = updfr_off\n                                       , intrbl = playInterruptible safety })\n            <*> mkLabel k tscope\n            <*> copyout\n           )\n    return (ReturnedTo k off)\n\nload_target_into_temp :: ForeignTarget -> FCode ForeignTarget\nload_target_into_temp (ForeignTarget expr conv) = do\n  tmp <- maybe_assign_temp expr\n  return (ForeignTarget tmp conv)\nload_target_into_temp other_target@(PrimTarget _) =\n  return other_target\n\n-- What we want to do here is create a new temporary for the foreign\n-- call argument if it is not safe to use the expression directly,\n-- because the expression mentions caller-saves GlobalRegs (see\n-- Note [Register Parameter Passing]).\n--\n-- However, we can't pattern-match on the expression here, because\n-- this is used in a loop by CmmParse, and testing the expression\n-- results in a black hole.  So we always create a temporary, and rely\n-- on CmmSink to clean it up later.  (Yuck, ToDo).  The generated code\n-- ends up being the same, at least for the RTS .cmm code.\n--\nmaybe_assign_temp :: CmmExpr -> FCode CmmExpr\nmaybe_assign_temp e = do\n  dflags <- getDynFlags\n  reg <- newTemp (cmmExprType dflags e)\n  emitAssign (CmmLocal reg) e\n  return (CmmReg (CmmLocal reg))\n\n-- -----------------------------------------------------------------------------\n-- Save/restore the thread state in the TSO\n\n-- This stuff can't be done in suspendThread/resumeThread, because it\n-- refers to global registers which aren't available in the C world.\n\nemitSaveThreadState :: FCode ()\nemitSaveThreadState = do\n  dflags <- getDynFlags\n  code <- saveThreadState dflags\n  emit code\n\n-- | Produce code to save the current thread state to @CurrentTSO@\nsaveThreadState :: MonadUnique m => DynFlags -> m CmmAGraph\nsaveThreadState dflags = do\n  tso <- newTemp (gcWord dflags)\n  close_nursery <- closeNursery dflags tso\n  pure $ catAGraphs [\n    -- tso = CurrentTSO;\n    mkAssign (CmmLocal tso) currentTSOExpr,\n    -- tso->stackobj->sp = Sp;\n    mkStore (cmmOffset dflags\n                       (CmmLoad (cmmOffset dflags\n                                           (CmmReg (CmmLocal tso))\n                                           (tso_stackobj dflags))\n                                (bWord dflags))\n                       (stack_SP dflags))\n            spExpr,\n    close_nursery,\n    -- and save the current cost centre stack in the TSO when profiling:\n    if gopt Opt_SccProfilingOn dflags then\n        mkStore (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) cccsExpr\n      else mkNop\n    ]\n\nemitCloseNursery :: FCode ()\nemitCloseNursery = do\n  dflags <- getDynFlags\n  tso <- newTemp (bWord dflags)\n  code <- closeNursery dflags tso\n  emit $ mkAssign (CmmLocal tso) currentTSOExpr <*> code\n\n{- |\n@closeNursery dflags tso@ produces code to close the nursery.\nA local register holding the value of @CurrentTSO@ is expected for\nefficiency.\n\nClosing the nursery corresponds to the following code:\n\n@\n  tso = CurrentTSO;\n  cn = CurrentNuresry;\n\n  // Update the allocation limit for the current thread.  We don't\n  // check to see whether it has overflowed at this point, that check is\n  // made when we run out of space in the current heap block (stg_gc_noregs)\n  // and in the scheduler when context switching (schedulePostRunThread).\n  tso->alloc_limit -= Hp + WDS(1) - cn->start;\n\n  // Set cn->free to the next unoccupied word in the block\n  cn->free = Hp + WDS(1);\n@\n-}\ncloseNursery :: MonadUnique m => DynFlags -> LocalReg -> m CmmAGraph\ncloseNursery df tso = do\n  let tsoreg  = CmmLocal tso\n  cnreg      <- CmmLocal <$> newTemp (bWord df)\n  pure $ catAGraphs [\n    mkAssign cnreg currentNurseryExpr,\n\n    -- CurrentNursery->free = Hp+1;\n    mkStore (nursery_bdescr_free df cnreg) (cmmOffsetW df hpExpr 1),\n\n    let alloc =\n           CmmMachOp (mo_wordSub df)\n              [ cmmOffsetW df hpExpr 1\n              , CmmLoad (nursery_bdescr_start df cnreg) (bWord df)\n              ]\n\n        alloc_limit = cmmOffset df (CmmReg tsoreg) (tso_alloc_limit df)\n    in\n\n    -- tso->alloc_limit += alloc\n    mkStore alloc_limit (CmmMachOp (MO_Sub W64)\n                               [ CmmLoad alloc_limit b64\n                               , CmmMachOp (mo_WordTo64 df) [alloc] ])\n   ]\n\nemitLoadThreadState :: FCode ()\nemitLoadThreadState = do\n  dflags <- getDynFlags\n  code <- loadThreadState dflags\n  emit code\n\n-- | Produce code to load the current thread state from @CurrentTSO@\nloadThreadState :: MonadUnique m => DynFlags -> m CmmAGraph\nloadThreadState dflags = do\n  tso <- newTemp (gcWord dflags)\n  stack <- newTemp (gcWord dflags)\n  open_nursery <- openNursery dflags tso\n  pure $ catAGraphs [\n    -- tso = CurrentTSO;\n    mkAssign (CmmLocal tso) currentTSOExpr,\n    -- stack = tso->stackobj;\n    mkAssign (CmmLocal stack) (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)),\n    -- Sp = stack->sp;\n    mkAssign spReg (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),\n    -- SpLim = stack->stack + RESERVED_STACK_WORDS;\n    mkAssign spLimReg (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))\n                                (rESERVED_STACK_WORDS dflags)),\n    -- HpAlloc = 0;\n    --   HpAlloc is assumed to be set to non-zero only by a failed\n    --   a heap check, see HeapStackCheck.cmm:GC_GENERIC\n    mkAssign hpAllocReg (zeroExpr dflags),\n    open_nursery,\n    -- and load the current cost centre stack from the TSO when profiling:\n    if gopt Opt_SccProfilingOn dflags\n       then storeCurCCS\n              (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso))\n                 (tso_CCCS dflags)) (ccsType dflags))\n       else mkNop\n   ]\n\n\nemitOpenNursery :: FCode ()\nemitOpenNursery = do\n  dflags <- getDynFlags\n  tso <- newTemp (bWord dflags)\n  code <- openNursery dflags tso\n  emit $ mkAssign (CmmLocal tso) currentTSOExpr <*> code\n\n{- |\n@openNursery dflags tso@ produces code to open the nursery. A local register\nholding the value of @CurrentTSO@ is expected for efficiency.\n\nOpening the nursery corresponds to the following code:\n\n@\n   tso = CurrentTSO;\n   cn = CurrentNursery;\n   bdfree = CurrentNursery->free;\n   bdstart = CurrentNursery->start;\n\n   // We *add* the currently occupied portion of the nursery block to\n   // the allocation limit, because we will subtract it again in\n   // closeNursery.\n   tso->alloc_limit += bdfree - bdstart;\n\n   // Set Hp to the last occupied word of the heap block.  Why not the\n   // next unocupied word?  Doing it this way means that we get to use\n   // an offset of zero more often, which might lead to slightly smaller\n   // code on some architectures.\n   Hp = bdfree - WDS(1);\n\n   // Set HpLim to the end of the current nursery block (note that this block\n   // might be a block group, consisting of several adjacent blocks.\n   HpLim = bdstart + CurrentNursery->blocks*BLOCK_SIZE_W - 1;\n@\n-}\nopenNursery :: MonadUnique m => DynFlags -> LocalReg -> m CmmAGraph\nopenNursery df tso = do\n  let tsoreg =  CmmLocal tso\n  cnreg      <- CmmLocal <$> newTemp (bWord df)\n  bdfreereg  <- CmmLocal <$> newTemp (bWord df)\n  bdstartreg <- CmmLocal <$> newTemp (bWord df)\n\n  -- These assignments are carefully ordered to reduce register\n  -- pressure and generate not completely awful code on x86.  To see\n  -- what code we generate, look at the assembly for\n  -- stg_returnToStackTop in rts/StgStartup.cmm.\n  pure $ catAGraphs [\n     mkAssign cnreg currentNurseryExpr,\n     mkAssign bdfreereg  (CmmLoad (nursery_bdescr_free df cnreg)  (bWord df)),\n\n     -- Hp = CurrentNursery->free - 1;\n     mkAssign hpReg (cmmOffsetW df (CmmReg bdfreereg) (-1)),\n\n     mkAssign bdstartreg (CmmLoad (nursery_bdescr_start df cnreg) (bWord df)),\n\n     -- HpLim = CurrentNursery->start +\n     --              CurrentNursery->blocks*BLOCK_SIZE_W - 1;\n     mkAssign hpLimReg\n         (cmmOffsetExpr df\n             (CmmReg bdstartreg)\n             (cmmOffset df\n               (CmmMachOp (mo_wordMul df) [\n                 CmmMachOp (MO_SS_Conv W32 (wordWidth df))\n                   [CmmLoad (nursery_bdescr_blocks df cnreg) b32],\n                 mkIntExpr df (bLOCK_SIZE df)\n                ])\n               (-1)\n             )\n         ),\n\n     -- alloc = bd->free - bd->start\n     let alloc =\n           CmmMachOp (mo_wordSub df) [CmmReg bdfreereg, CmmReg bdstartreg]\n\n         alloc_limit = cmmOffset df (CmmReg tsoreg) (tso_alloc_limit df)\n     in\n\n     -- tso->alloc_limit += alloc\n     mkStore alloc_limit (CmmMachOp (MO_Add W64)\n                               [ CmmLoad alloc_limit b64\n                               , CmmMachOp (mo_WordTo64 df) [alloc] ])\n\n   ]\n\nnursery_bdescr_free, nursery_bdescr_start, nursery_bdescr_blocks\n  :: DynFlags -> CmmReg -> CmmExpr\nnursery_bdescr_free   dflags cn =\n  cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_free dflags)\nnursery_bdescr_start  dflags cn =\n  cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_start dflags)\nnursery_bdescr_blocks dflags cn =\n  cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_blocks dflags)\n\ntso_stackobj, tso_CCCS, tso_alloc_limit, stack_STACK, stack_SP :: DynFlags -> ByteOff\ntso_stackobj dflags = closureField dflags (oFFSET_StgTSO_stackobj dflags)\ntso_alloc_limit dflags = closureField dflags (oFFSET_StgTSO_alloc_limit dflags)\ntso_CCCS     dflags = closureField dflags (oFFSET_StgTSO_cccs dflags)\nstack_STACK  dflags = closureField dflags (oFFSET_StgStack_stack dflags)\nstack_SP     dflags = closureField dflags (oFFSET_StgStack_sp dflags)\n\n\nclosureField :: DynFlags -> ByteOff -> ByteOff\nclosureField dflags off = off + fixedHdrSize dflags\n\n-- -----------------------------------------------------------------------------\n-- For certain types passed to foreign calls, we adjust the actual\n-- value passed to the call.  For ByteArray#/Array# we pass the\n-- address of the actual array, not the address of the heap object.\n\ngetFCallArgs :: [StgArg] -> FCode [(CmmExpr, ForeignHint)]\n-- (a) Drop void args\n-- (b) Add foreign-call shim code\n-- It's (b) that makes this differ from getNonVoidArgAmodes\n\ngetFCallArgs args\n  = do  { mb_cmms <- mapM get args\n        ; return (catMaybes mb_cmms) }\n  where\n    get arg | null arg_reps\n            = return Nothing\n            | otherwise\n            = do { cmm <- getArgAmode (NonVoid arg)\n                 ; dflags <- getDynFlags\n                 ; return (Just (add_shim dflags arg_ty cmm, hint)) }\n            where\n              arg_ty   = stgArgType arg\n              arg_reps = typePrimRep arg_ty\n              hint     = typeForeignHint arg_ty\n\nadd_shim :: DynFlags -> Type -> CmmExpr -> CmmExpr\nadd_shim dflags arg_ty expr\n  | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon\n  = cmmOffsetB dflags expr (arrPtrsHdrSize dflags)\n\n  | tycon == smallArrayPrimTyCon || tycon == smallMutableArrayPrimTyCon\n  = cmmOffsetB dflags expr (smallArrPtrsHdrSize dflags)\n\n  | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon\n  = cmmOffsetB dflags expr (arrWordsHdrSize dflags)\n\n  | otherwise = expr\n  where\n    tycon           = tyConAppTyCon (unwrapType arg_ty)\n        -- should be a tycon app, since this is a foreign call\n", "num_lines": 535}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Stg to C--: heap management functions\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmHeap (\n        getVirtHp, setVirtHp, setRealHp,\n        getHpRelOffset,\n\n        entryHeapCheck, altHeapCheck, noEscapeHeapCheck, altHeapCheckReturnsTo,\n        heapStackCheckGen,\n        entryHeapCheck',\n\n        mkStaticClosureFields, mkStaticClosure,\n\n        allocDynClosure, allocDynClosureCmm, allocHeapClosure,\n        emitSetDynHdr\n    ) where\n\nimport GhcPrelude hiding ((<*>))\n\nimport StgSyn\nimport CLabel\nimport StgCmmLayout\nimport StgCmmUtils\nimport StgCmmMonad\nimport StgCmmProf (profDynAlloc, dynProfHdr, staticProfHdr)\nimport StgCmmTicky\nimport StgCmmClosure\nimport StgCmmEnv\n\nimport MkGraph\n\nimport Hoopl.Label\nimport SMRep\nimport BlockId\nimport Cmm\nimport CmmUtils\nimport CostCentre\nimport IdInfo( CafInfo(..), mayHaveCafRefs )\nimport Id ( Id )\nimport Module\nimport DynFlags\nimport FastString( mkFastString, fsLit )\nimport Panic( sorry )\n\nimport Control.Monad (when)\nimport Data.Maybe (isJust)\n\n-----------------------------------------------------------\n--              Initialise dynamic heap objects\n-----------------------------------------------------------\n\nallocDynClosure\n        :: Maybe Id\n        -> CmmInfoTable\n        -> LambdaFormInfo\n        -> CmmExpr              -- Cost Centre to stick in the object\n        -> CmmExpr              -- Cost Centre to blame for this alloc\n                                -- (usually the same; sometimes \"OVERHEAD\")\n\n        -> [(NonVoid StgArg, VirtualHpOffset)]  -- Offsets from start of object\n                                                -- ie Info ptr has offset zero.\n                                                -- No void args in here\n        -> FCode CmmExpr -- returns Hp+n\n\nallocDynClosureCmm\n        :: Maybe Id -> CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr\n        -> [(CmmExpr, ByteOff)]\n        -> FCode CmmExpr -- returns Hp+n\n\n-- allocDynClosure allocates the thing in the heap,\n-- and modifies the virtual Hp to account for this.\n-- The second return value is the graph that sets the value of the\n-- returned LocalReg, which should point to the closure after executing\n-- the graph.\n\n-- allocDynClosure returns an (Hp+8) CmmExpr, and hence the result is\n-- only valid until Hp is changed.  The caller should assign the\n-- result to a LocalReg if it is required to remain live.\n--\n-- The reason we don't assign it to a LocalReg here is that the caller\n-- is often about to call regIdInfo, which immediately assigns the\n-- result of allocDynClosure to a new temp in order to add the tag.\n-- So by not generating a LocalReg here we avoid a common source of\n-- new temporaries and save some compile time.  This can be quite\n-- significant - see test T4801.\n\n\nallocDynClosure mb_id info_tbl lf_info use_cc _blame_cc args_w_offsets = do\n  let (args, offsets) = unzip args_w_offsets\n  cmm_args <- mapM getArgAmode args     -- No void args\n  allocDynClosureCmm mb_id info_tbl lf_info\n                     use_cc _blame_cc (zip cmm_args offsets)\n\n\nallocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets = do\n  -- SAY WHAT WE ARE ABOUT TO DO\n  let rep = cit_rep info_tbl\n  tickyDynAlloc mb_id rep lf_info\n  let info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl))\n  allocHeapClosure rep info_ptr use_cc amodes_w_offsets\n\n\n-- | Low-level heap object allocation.\nallocHeapClosure\n  :: SMRep                            -- ^ representation of the object\n  -> CmmExpr                          -- ^ info pointer\n  -> CmmExpr                          -- ^ cost centre\n  -> [(CmmExpr,ByteOff)]              -- ^ payload\n  -> FCode CmmExpr                    -- ^ returns the address of the object\nallocHeapClosure rep info_ptr use_cc payload = do\n  profDynAlloc rep use_cc\n\n  virt_hp <- getVirtHp\n\n  -- Find the offset of the info-ptr word\n  let info_offset = virt_hp + 1\n            -- info_offset is the VirtualHpOffset of the first\n            -- word of the new object\n            -- Remember, virtHp points to last allocated word,\n            -- ie 1 *before* the info-ptr word of new object.\n\n  base <- getHpRelOffset info_offset\n  emitComment $ mkFastString \"allocHeapClosure\"\n  emitSetDynHdr base info_ptr use_cc\n\n  -- Fill in the fields\n  hpStore base payload\n\n  -- Bump the virtual heap pointer\n  dflags <- getDynFlags\n  setVirtHp (virt_hp + heapClosureSizeW dflags rep)\n\n  return base\n\n\nemitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()\nemitSetDynHdr base info_ptr ccs\n  = do dflags <- getDynFlags\n       hpStore base (zip (header dflags) [0, wORD_SIZE dflags ..])\n  where\n    header :: DynFlags -> [CmmExpr]\n    header dflags = [info_ptr] ++ dynProfHdr dflags ccs\n        -- ToDo: Parallel stuff\n        -- No ticky header\n\n-- Store the item (expr,off) in base[off]\nhpStore :: CmmExpr -> [(CmmExpr, ByteOff)] -> FCode ()\nhpStore base vals = do\n  dflags <- getDynFlags\n  sequence_ $\n    [ emitStore (cmmOffsetB dflags base off) val | (val,off) <- vals ]\n\n-----------------------------------------------------------\n--              Layout of static closures\n-----------------------------------------------------------\n\n-- Make a static closure, adding on any extra padding needed for CAFs,\n-- and adding a static link field if necessary.\n\nmkStaticClosureFields\n        :: DynFlags\n        -> CmmInfoTable\n        -> CostCentreStack\n        -> CafInfo\n        -> [CmmLit]             -- Payload\n        -> [CmmLit]             -- The full closure\nmkStaticClosureFields dflags info_tbl ccs caf_refs payload\n  = mkStaticClosure dflags info_lbl ccs payload padding\n        static_link_field saved_info_field\n  where\n    info_lbl = cit_lbl info_tbl\n\n    -- CAFs must have consistent layout, regardless of whether they\n    -- are actually updatable or not.  The layout of a CAF is:\n    --\n    --        3 saved_info\n    --        2 static_link\n    --        1 indirectee\n    --        0 info ptr\n    --\n    -- the static_link and saved_info fields must always be in the\n    -- same place.  So we use isThunkRep rather than closureUpdReqd\n    -- here:\n\n    is_caf = isThunkRep (cit_rep info_tbl)\n\n    padding\n        | is_caf && null payload = [mkIntCLit dflags 0]\n        | otherwise = []\n\n    static_link_field\n        | is_caf || staticClosureNeedsLink (mayHaveCafRefs caf_refs) info_tbl\n        = [static_link_value]\n        | otherwise\n        = []\n\n    saved_info_field\n        | is_caf     = [mkIntCLit dflags 0]\n        | otherwise  = []\n\n        -- For a static constructor which has NoCafRefs, we set the\n        -- static link field to a non-zero value so the garbage\n        -- collector will ignore it.\n    static_link_value\n        | mayHaveCafRefs caf_refs  = mkIntCLit dflags 0\n        | otherwise                = mkIntCLit dflags 3  -- No CAF refs\n                                      -- See Note [STATIC_LINK fields]\n                                      -- in rts/sm/Storage.h\n\nmkStaticClosure :: DynFlags -> CLabel -> CostCentreStack -> [CmmLit]\n  -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]\nmkStaticClosure dflags info_lbl ccs payload padding static_link_field saved_info_field\n  =  [CmmLabel info_lbl]\n  ++ staticProfHdr dflags ccs\n  ++ payload\n  ++ padding\n  ++ static_link_field\n  ++ saved_info_field\n\n-----------------------------------------------------------\n--              Heap overflow checking\n-----------------------------------------------------------\n\n{- Note [Heap checks]\n   ~~~~~~~~~~~~~~~~~~\nHeap checks come in various forms.  We provide the following entry\npoints to the runtime system, all of which use the native C-- entry\nconvention.\n\n  * gc() performs garbage collection and returns\n    nothing to its caller\n\n  * A series of canned entry points like\n        r = gc_1p( r )\n    where r is a pointer.  This performs gc, and\n    then returns its argument r to its caller.\n\n  * A series of canned entry points like\n        gcfun_2p( f, x, y )\n    where f is a function closure of arity 2\n    This performs garbage collection, keeping alive the\n    three argument ptrs, and then tail-calls f(x,y)\n\nThese are used in the following circumstances\n\n* entryHeapCheck: Function entry\n    (a) With a canned GC entry sequence\n        f( f_clo, x:ptr, y:ptr ) {\n             Hp = Hp+8\n             if Hp > HpLim goto L\n             ...\n          L: HpAlloc = 8\n             jump gcfun_2p( f_clo, x, y ) }\n     Note the tail call to the garbage collector;\n     it should do no register shuffling\n\n    (b) No canned sequence\n        f( f_clo, x:ptr, y:ptr, ...etc... ) {\n          T: Hp = Hp+8\n             if Hp > HpLim goto L\n             ...\n          L: HpAlloc = 8\n             call gc()  -- Needs an info table\n             goto T }\n\n* altHeapCheck: Immediately following an eval\n  Started as\n        case f x y of r { (p,q) -> rhs }\n  (a) With a canned sequence for the results of f\n       (which is the very common case since\n       all boxed cases return just one pointer\n           ...\n           r = f( x, y )\n        K:      -- K needs an info table\n           Hp = Hp+8\n           if Hp > HpLim goto L\n           ...code for rhs...\n\n        L: r = gc_1p( r )\n           goto K }\n\n        Here, the info table needed by the call\n        to gc_1p should be the *same* as the\n        one for the call to f; the C-- optimiser\n        spots this sharing opportunity)\n\n   (b) No canned sequence for results of f\n       Note second info table\n           ...\n           (r1,r2,r3) = call f( x, y )\n        K:\n           Hp = Hp+8\n           if Hp > HpLim goto L\n           ...code for rhs...\n\n        L: call gc()    -- Extra info table here\n           goto K\n\n* generalHeapCheck: Anywhere else\n  e.g. entry to thunk\n       case branch *not* following eval,\n       or let-no-escape\n  Exactly the same as the previous case:\n\n        K:      -- K needs an info table\n           Hp = Hp+8\n           if Hp > HpLim goto L\n           ...\n\n        L: call gc()\n           goto K\n-}\n\n--------------------------------------------------------------\n-- A heap/stack check at a function or thunk entry point.\n\nentryHeapCheck :: ClosureInfo\n               -> Maybe LocalReg -- Function (closure environment)\n               -> Int            -- Arity -- not same as len args b/c of voids\n               -> [LocalReg]     -- Non-void args (empty for thunk)\n               -> FCode ()\n               -> FCode ()\n\nentryHeapCheck cl_info nodeSet arity args code\n  = entryHeapCheck' is_fastf node arity args code\n  where\n    node = case nodeSet of\n              Just r  -> CmmReg (CmmLocal r)\n              Nothing -> CmmLit (CmmLabel $ staticClosureLabel cl_info)\n\n    is_fastf = case closureFunInfo cl_info of\n                 Just (_, ArgGen _) -> False\n                 _otherwise         -> True\n\n-- | lower-level version for CmmParse\nentryHeapCheck' :: Bool           -- is a known function pattern\n                -> CmmExpr        -- expression for the closure pointer\n                -> Int            -- Arity -- not same as len args b/c of voids\n                -> [LocalReg]     -- Non-void args (empty for thunk)\n                -> FCode ()\n                -> FCode ()\nentryHeapCheck' is_fastf node arity args code\n  = do dflags <- getDynFlags\n       let is_thunk = arity == 0\n\n           args' = map (CmmReg . CmmLocal) args\n           stg_gc_fun    = CmmReg (CmmGlobal GCFun)\n           stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1)\n\n           {- Thunks:          jump stg_gc_enter_1\n\n              Function (fast): call (NativeNode) stg_gc_fun(fun, args)\n\n              Function (slow): call (slow) stg_gc_fun(fun, args)\n           -}\n           gc_call upd\n               | is_thunk\n                 = mkJump dflags NativeNodeCall stg_gc_enter1 [node] upd\n\n               | is_fastf\n                 = mkJump dflags NativeNodeCall stg_gc_fun (node : args') upd\n\n               | otherwise\n                 = mkJump dflags Slow stg_gc_fun (node : args') upd\n\n       updfr_sz <- getUpdFrameOff\n\n       loop_id <- newBlockId\n       emitLabel loop_id\n       heapCheck True True (gc_call updfr_sz <*> mkBranch loop_id) code\n\n-- ------------------------------------------------------------\n-- A heap/stack check in a case alternative\n\n\n-- If there are multiple alts and we need to GC, but don't have a\n-- continuation already (the scrut was simple), then we should\n-- pre-generate the continuation.  (if there are multiple alts it is\n-- always a canned GC point).\n\n-- altHeapCheck:\n-- If we have a return continuation,\n--   then if it is a canned GC pattern,\n--           then we do mkJumpReturnsTo\n--           else we do a normal call to stg_gc_noregs\n--   else if it is a canned GC pattern,\n--           then generate the continuation and do mkCallReturnsTo\n--           else we do a normal call to stg_gc_noregs\n\naltHeapCheck :: [LocalReg] -> FCode a -> FCode a\naltHeapCheck regs code = altOrNoEscapeHeapCheck False regs code\n\naltOrNoEscapeHeapCheck :: Bool -> [LocalReg] -> FCode a -> FCode a\naltOrNoEscapeHeapCheck checkYield regs code = do\n    dflags <- getDynFlags\n    case cannedGCEntryPoint dflags regs of\n      Nothing -> genericGC checkYield code\n      Just gc -> do\n        lret <- newBlockId\n        let (off, _, copyin) = copyInOflow dflags NativeReturn (Young lret) regs []\n        lcont <- newBlockId\n        tscope <- getTickScope\n        emitOutOfLine lret (copyin <*> mkBranch lcont, tscope)\n        emitLabel lcont\n        cannedGCReturnsTo checkYield False gc regs lret off code\n\naltHeapCheckReturnsTo :: [LocalReg] -> Label -> ByteOff -> FCode a -> FCode a\naltHeapCheckReturnsTo regs lret off code\n  = do dflags <- getDynFlags\n       case cannedGCEntryPoint dflags regs of\n           Nothing -> genericGC False code\n           Just gc -> cannedGCReturnsTo False True gc regs lret off code\n\n-- noEscapeHeapCheck is implemented identically to altHeapCheck (which\n-- is more efficient), but cannot be optimized away in the non-allocating\n-- case because it may occur in a loop\nnoEscapeHeapCheck :: [LocalReg] -> FCode a -> FCode a\nnoEscapeHeapCheck regs code = altOrNoEscapeHeapCheck True regs code\n\ncannedGCReturnsTo :: Bool -> Bool -> CmmExpr -> [LocalReg] -> Label -> ByteOff\n                  -> FCode a\n                  -> FCode a\ncannedGCReturnsTo checkYield cont_on_stack gc regs lret off code\n  = do dflags <- getDynFlags\n       updfr_sz <- getUpdFrameOff\n       heapCheck False checkYield (gc_call dflags gc updfr_sz) code\n  where\n    reg_exprs = map (CmmReg . CmmLocal) regs\n      -- Note [stg_gc arguments]\n\n      -- NB. we use the NativeReturn convention for passing arguments\n      -- to the canned heap-check routines, because we are in a case\n      -- alternative and hence the [LocalReg] was passed to us in the\n      -- NativeReturn convention.\n    gc_call dflags label sp\n      | cont_on_stack\n      = mkJumpReturnsTo dflags label NativeReturn reg_exprs lret off sp\n      | otherwise\n      = mkCallReturnsTo dflags label NativeReturn reg_exprs lret off sp []\n\ngenericGC :: Bool -> FCode a -> FCode a\ngenericGC checkYield code\n  = do updfr_sz <- getUpdFrameOff\n       lretry <- newBlockId\n       emitLabel lretry\n       call <- mkCall generic_gc (GC, GC) [] [] updfr_sz []\n       heapCheck False checkYield (call <*> mkBranch lretry) code\n\ncannedGCEntryPoint :: DynFlags -> [LocalReg] -> Maybe CmmExpr\ncannedGCEntryPoint dflags regs\n  = case map localRegType regs of\n      []  -> Just (mkGcLabel \"stg_gc_noregs\")\n      [ty]\n          | isGcPtrType ty -> Just (mkGcLabel \"stg_gc_unpt_r1\")\n          | isFloatType ty -> case width of\n                                  W32       -> Just (mkGcLabel \"stg_gc_f1\")\n                                  W64       -> Just (mkGcLabel \"stg_gc_d1\")\n                                  _         -> Nothing\n\n          | width == wordWidth dflags -> Just (mkGcLabel \"stg_gc_unbx_r1\")\n          | width == W64              -> Just (mkGcLabel \"stg_gc_l1\")\n          | otherwise                 -> Nothing\n          where\n              width = typeWidth ty\n      [ty1,ty2]\n          |  isGcPtrType ty1\n          && isGcPtrType ty2 -> Just (mkGcLabel \"stg_gc_pp\")\n      [ty1,ty2,ty3]\n          |  isGcPtrType ty1\n          && isGcPtrType ty2\n          && isGcPtrType ty3 -> Just (mkGcLabel \"stg_gc_ppp\")\n      [ty1,ty2,ty3,ty4]\n          |  isGcPtrType ty1\n          && isGcPtrType ty2\n          && isGcPtrType ty3\n          && isGcPtrType ty4 -> Just (mkGcLabel \"stg_gc_pppp\")\n      _otherwise -> Nothing\n\n-- Note [stg_gc arguments]\n-- It might seem that we could avoid passing the arguments to the\n-- stg_gc function, because they are already in the right registers.\n-- While this is usually the case, it isn't always.  Sometimes the\n-- code generator has cleverly avoided the eval in a case, e.g. in\n-- ffi/should_run/4221.hs we found\n--\n--   case a_r1mb of z\n--     FunPtr x y -> ...\n--\n-- where a_r1mb is bound a top-level constructor, and is known to be\n-- evaluated.  The codegen just assigns x, y and z, and continues;\n-- R1 is never assigned.\n--\n-- So we'll have to rely on optimisations to eliminatethese\n-- assignments where possible.\n\n\n-- | The generic GC procedure; no params, no results\ngeneric_gc :: CmmExpr\ngeneric_gc = mkGcLabel \"stg_gc_noregs\"\n\n-- | Create a CLabel for calling a garbage collector entry point\nmkGcLabel :: String -> CmmExpr\nmkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s)))\n\n-------------------------------\nheapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a\nheapCheck checkStack checkYield do_gc code\n  = getHeapUsage $ \\ hpHw ->\n    -- Emit heap checks, but be sure to do it lazily so\n    -- that the conditionals on hpHw don't cause a black hole\n    do  { dflags <- getDynFlags\n        ; let mb_alloc_bytes\n                 | hpHw > mBLOCK_SIZE = sorry $ unlines\n                    [\" Trying to allocate more than \"++show mBLOCK_SIZE++\" bytes.\",\n                     \"\",\n                     \"This is currently not possible due to a limitation of GHC's code generator.\",\n                     \"See http://ghc.haskell.org/trac/ghc/ticket/4505 for details.\",\n                     \"Suggestion: read data from a file instead of having large static data\",\n                     \"structures in code.\"]\n                 | hpHw > 0  = Just (mkIntExpr dflags (hpHw * (wORD_SIZE dflags)))\n                 | otherwise = Nothing\n                 where mBLOCK_SIZE = bLOCKS_PER_MBLOCK dflags * bLOCK_SIZE_W dflags\n              stk_hwm | checkStack = Just (CmmLit CmmHighStackMark)\n                      | otherwise  = Nothing\n        ; codeOnly $ do_checks stk_hwm checkYield mb_alloc_bytes do_gc\n        ; tickyAllocHeap True hpHw\n        ; setRealHp hpHw\n        ; code }\n\nheapStackCheckGen :: Maybe CmmExpr -> Maybe CmmExpr -> FCode ()\nheapStackCheckGen stk_hwm mb_bytes\n  = do updfr_sz <- getUpdFrameOff\n       lretry <- newBlockId\n       emitLabel lretry\n       call <- mkCall generic_gc (GC, GC) [] [] updfr_sz []\n       do_checks stk_hwm False mb_bytes (call <*> mkBranch lretry)\n\n-- Note [Single stack check]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~\n-- When compiling a function we can determine how much stack space it\n-- will use. We therefore need to perform only a single stack check at\n-- the beginning of a function to see if we have enough stack space.\n--\n-- The check boils down to comparing Sp-N with SpLim, where N is the\n-- amount of stack space needed (see Note [Stack usage] below).  *BUT*\n-- at this stage of the pipeline we are not supposed to refer to Sp\n-- itself, because the stack is not yet manifest, so we don't quite\n-- know where Sp pointing.\n\n-- So instead of referring directly to Sp - as we used to do in the\n-- past - the code generator uses (old + 0) in the stack check. That\n-- is the address of the first word of the old area, so if we add N\n-- we'll get the address of highest used word.\n--\n-- This makes the check robust.  For example, while we need to perform\n-- only one stack check for each function, we could in theory place\n-- more stack checks later in the function. They would be redundant,\n-- but not incorrect (in a sense that they should not change program\n-- behaviour). We need to make sure however that a stack check\n-- inserted after incrementing the stack pointer checks for a\n-- respectively smaller stack space. This would not be the case if the\n-- code generator produced direct references to Sp. By referencing\n-- (old + 0) we make sure that we always check for a correct amount of\n-- stack: when converting (old + 0) to Sp the stack layout phase takes\n-- into account changes already made to stack pointer. The idea for\n-- this change came from observations made while debugging #8275.\n\n-- Note [Stack usage]\n-- ~~~~~~~~~~~~~~~~~~\n-- At the moment we convert from STG to Cmm we don't know N, the\n-- number of bytes of stack that the function will use, so we use a\n-- special late-bound CmmLit, namely\n--       CmmHighStackMark\n-- to stand for the number of bytes needed. When the stack is made\n-- manifest, the number of bytes needed is calculated, and used to\n-- replace occurrences of CmmHighStackMark\n--\n-- The (Maybe CmmExpr) passed to do_checks is usually\n--     Just (CmmLit CmmHighStackMark)\n-- but can also (in certain hand-written RTS functions)\n--     Just (CmmLit 8)  or some other fixed valuet\n-- If it is Nothing, we don't generate a stack check at all.\n\ndo_checks :: Maybe CmmExpr    -- Should we check the stack?\n                              -- See Note [Stack usage]\n          -> Bool             -- Should we check for preemption?\n          -> Maybe CmmExpr    -- Heap headroom (bytes)\n          -> CmmAGraph        -- What to do on failure\n          -> FCode ()\ndo_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do\n  dflags <- getDynFlags\n  gc_id <- newBlockId\n\n  let\n    Just alloc_lit = mb_alloc_lit\n\n    bump_hp   = cmmOffsetExprB dflags hpExpr alloc_lit\n\n    -- Sp overflow if ((old + 0) - CmmHighStack < SpLim)\n    -- At the beginning of a function old + 0 = Sp\n    -- See Note [Single stack check]\n    sp_oflo sp_hwm =\n         CmmMachOp (mo_wordULt dflags)\n                  [CmmMachOp (MO_Sub (typeWidth (cmmRegType dflags spReg)))\n                             [CmmStackSlot Old 0, sp_hwm],\n                   CmmReg spLimReg]\n\n    -- Hp overflow if (Hp > HpLim)\n    -- (Hp has been incremented by now)\n    -- HpLim points to the LAST WORD of valid allocation space.\n    hp_oflo = CmmMachOp (mo_wordUGt dflags) [hpExpr, hpLimExpr]\n\n    alloc_n = mkAssign hpAllocReg alloc_lit\n\n  case mb_stk_hwm of\n    Nothing -> return ()\n    Just stk_hwm -> tickyStackCheck\n      >> (emit =<< mkCmmIfGoto' (sp_oflo stk_hwm) gc_id (Just False) )\n\n  -- Emit new label that might potentially be a header\n  -- of a self-recursive tail call.\n  -- See Note [Self-recursive loop header].\n  self_loop_info <- getSelfLoop\n  case self_loop_info of\n    Just (_, loop_header_id, _)\n        | checkYield && isJust mb_stk_hwm -> emitLabel loop_header_id\n    _otherwise -> return ()\n\n  if (isJust mb_alloc_lit)\n    then do\n     tickyHeapCheck\n     emitAssign hpReg bump_hp\n     emit =<< mkCmmIfThen' hp_oflo (alloc_n <*> mkBranch gc_id) (Just False)\n    else do\n      when (checkYield && not (gopt Opt_OmitYields dflags)) $ do\n         -- Yielding if HpLim == 0\n         let yielding = CmmMachOp (mo_wordEq dflags)\n                                  [CmmReg hpLimReg,\n                                   CmmLit (zeroCLit dflags)]\n         emit =<< mkCmmIfGoto' yielding gc_id (Just False)\n\n  tscope <- getTickScope\n  emitOutOfLine gc_id\n   (do_gc, tscope) -- this is expected to jump back somewhere\n\n                -- Test for stack pointer exhaustion, then\n                -- bump heap pointer, and test for heap exhaustion\n                -- Note that we don't move the heap pointer unless the\n                -- stack check succeeds.  Otherwise we might end up\n                -- with slop at the end of the current block, which can\n                -- confuse the LDV profiler.\n\n-- Note [Self-recursive loop header]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Self-recursive loop header is required by loopification optimization (See\n-- Note [Self-recursive tail calls] in StgCmmExpr). We emit it if:\n--\n--  1. There is information about self-loop in the FCode environment. We don't\n--     check the binder (first component of the self_loop_info) because we are\n--     certain that if the self-loop info is present then we are compiling the\n--     binder body. Reason: the only possible way to get here with the\n--     self_loop_info present is from closureCodeBody.\n--\n--  2. checkYield && isJust mb_stk_hwm. checkYield tells us that it is possible\n--     to preempt the heap check (see #367 for motivation behind this check). It\n--     is True for heap checks placed at the entry to a function and\n--     let-no-escape heap checks but false for other heap checks (eg. in case\n--     alternatives or created from hand-written high-level Cmm). The second\n--     check (isJust mb_stk_hwm) is true for heap checks at the entry to a\n--     function and some heap checks created in hand-written Cmm. Otherwise it\n--     is Nothing. In other words the only situation when both conditions are\n--     true is when compiling stack and heap checks at the entry to a\n--     function. This is the only situation when we want to emit a self-loop\n--     label.\n", "num_lines": 681}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Code generation for coverage\n--\n-- (c) Galois Connections, Inc. 2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmHpc ( initHpc, mkTickBox ) where\n\nimport GhcPrelude\n\nimport StgCmmMonad\n\nimport MkGraph\nimport CmmExpr\nimport CLabel\nimport Module\nimport CmmUtils\nimport StgCmmUtils\nimport HscTypes\nimport DynFlags\n\nimport Control.Monad\n\nmkTickBox :: DynFlags -> Module -> Int -> CmmAGraph\nmkTickBox dflags mod n\n  = mkStore tick_box (CmmMachOp (MO_Add W64)\n                                [ CmmLoad tick_box b64\n                                , CmmLit (CmmInt 1 W64)\n                                ])\n  where\n    tick_box = cmmIndex dflags W64\n                        (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)\n                        n\n\ninitHpc :: Module -> HpcInfo -> FCode ()\n-- Emit top-level tables for HPC and return code to initialise\ninitHpc _ (NoHpcInfo {})\n  = return ()\ninitHpc this_mod (HpcInfo tickCount _hashNo)\n  = do dflags <- getDynFlags\n       when (gopt Opt_Hpc dflags) $\n           do emitDataLits (mkHpcTicksLabel this_mod)\n                           [ (CmmInt 0 W64)\n                           | _ <- take tickCount [0 :: Int ..]\n                           ]\n\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Building info tables.\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmLayout (\n        mkArgDescr,\n        emitCall, emitReturn, adjustHpBackwards,\n\n        emitClosureProcAndInfoTable,\n        emitClosureAndInfoTable,\n\n        slowCall, directCall,\n\n        FieldOffOrPadding(..),\n        ClosureHeader(..),\n        mkVirtHeapOffsets,\n        mkVirtHeapOffsetsWithPadding,\n        mkVirtConstrOffsets,\n        mkVirtConstrSizes,\n        getHpRelOffset,\n\n        ArgRep(..), toArgRep, argRepSizeW -- re-exported from StgCmmArgRep\n  ) where\n\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude hiding ((<*>))\n\nimport StgCmmClosure\nimport StgCmmEnv\nimport StgCmmArgRep -- notably: ( slowCallPattern )\nimport StgCmmTicky\nimport StgCmmMonad\nimport StgCmmUtils\n\nimport MkGraph\nimport SMRep\nimport BlockId\nimport Cmm\nimport CmmUtils\nimport CmmInfo\nimport CLabel\nimport StgSyn\nimport Id\nimport TyCon             ( PrimRep(..), primRepSizeB )\nimport BasicTypes        ( RepArity )\nimport DynFlags\nimport Module\n\nimport Util\nimport Data.List\nimport Outputable\nimport FastString\nimport Control.Monad\n\n------------------------------------------------------------------------\n--                Call and return sequences\n------------------------------------------------------------------------\n\n-- | Return multiple values to the sequel\n--\n-- If the sequel is @Return@\n--\n-- >     return (x,y)\n--\n-- If the sequel is @AssignTo [p,q]@\n--\n-- >    p=x; q=y;\n--\nemitReturn :: [CmmExpr] -> FCode ReturnKind\nemitReturn results\n  = do { dflags    <- getDynFlags\n       ; sequel    <- getSequel\n       ; updfr_off <- getUpdFrameOff\n       ; case sequel of\n           Return ->\n             do { adjustHpBackwards\n                ; let e = CmmLoad (CmmStackSlot Old updfr_off) (gcWord dflags)\n                ; emit (mkReturn dflags (entryCode dflags e) results updfr_off)\n                }\n           AssignTo regs adjust ->\n             do { when adjust adjustHpBackwards\n                ; emitMultiAssign  regs results }\n       ; return AssignedDirectly\n       }\n\n\n-- | @emitCall conv fun args@ makes a call to the entry-code of @fun@,\n-- using the call/return convention @conv@, passing @args@, and\n-- returning the results to the current sequel.\n--\nemitCall :: (Convention, Convention) -> CmmExpr -> [CmmExpr] -> FCode ReturnKind\nemitCall convs fun args\n  = emitCallWithExtraStack convs fun args noExtraStack\n\n\n-- | @emitCallWithExtraStack conv fun args stack@ makes a call to the\n-- entry-code of @fun@, using the call/return convention @conv@,\n-- passing @args@, pushing some extra stack frames described by\n-- @stack@, and returning the results to the current sequel.\n--\nemitCallWithExtraStack\n   :: (Convention, Convention) -> CmmExpr -> [CmmExpr]\n   -> [CmmExpr] -> FCode ReturnKind\nemitCallWithExtraStack (callConv, retConv) fun args extra_stack\n  = do  { dflags <- getDynFlags\n        ; adjustHpBackwards\n        ; sequel <- getSequel\n        ; updfr_off <- getUpdFrameOff\n        ; case sequel of\n            Return -> do\n              emit $ mkJumpExtra dflags callConv fun args updfr_off extra_stack\n              return AssignedDirectly\n            AssignTo res_regs _ -> do\n              k <- newBlockId\n              let area = Young k\n                  (off, _, copyin) = copyInOflow dflags retConv area res_regs []\n                  copyout = mkCallReturnsTo dflags fun callConv args k off updfr_off\n                                   extra_stack\n              tscope <- getTickScope\n              emit (copyout <*> mkLabel k tscope <*> copyin)\n              return (ReturnedTo k off)\n      }\n\n\nadjustHpBackwards :: FCode ()\n-- This function adjusts the heap pointer just before a tail call or\n-- return.  At a call or return, the virtual heap pointer may be less\n-- than the real Hp, because the latter was advanced to deal with\n-- the worst-case branch of the code, and we may be in a better-case\n-- branch.  In that case, move the real Hp *back* and retract some\n-- ticky allocation count.\n--\n-- It *does not* deal with high-water-mark adjustment.  That's done by\n-- functions which allocate heap.\nadjustHpBackwards\n  = do  { hp_usg <- getHpUsage\n        ; let rHp = realHp hp_usg\n              vHp = virtHp hp_usg\n              adjust_words = vHp -rHp\n        ; new_hp <- getHpRelOffset vHp\n\n        ; emit (if adjust_words == 0\n                then mkNop\n                else mkAssign hpReg new_hp) -- Generates nothing when vHp==rHp\n\n        ; tickyAllocHeap False adjust_words -- ...ditto\n\n        ; setRealHp vHp\n        }\n\n\n-------------------------------------------------------------------------\n--        Making calls: directCall and slowCall\n-------------------------------------------------------------------------\n\n-- General plan is:\n--   - we'll make *one* fast call, either to the function itself\n--     (directCall) or to stg_ap_<pat>_fast (slowCall)\n--     Any left-over arguments will be pushed on the stack,\n--\n--     e.g. Sp[old+8]  = arg1\n--          Sp[old+16] = arg2\n--          Sp[old+32] = stg_ap_pp_info\n--          R2 = arg3\n--          R3 = arg4\n--          call f() return to Nothing updfr_off: 32\n\n\ndirectCall :: Convention -> CLabel -> RepArity -> [StgArg] -> FCode ReturnKind\n-- (directCall f n args)\n-- calls f(arg1, ..., argn), and applies the result to the remaining args\n-- The function f has arity n, and there are guaranteed at least n args\n-- Both arity and args include void args\ndirectCall conv lbl arity stg_args\n  = do  { argreps <- getArgRepsAmodes stg_args\n        ; direct_call \"directCall\" conv lbl arity argreps }\n\n\nslowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind\n-- (slowCall fun args) applies fun to args, returning the results to Sequel\nslowCall fun stg_args\n  = do  dflags <- getDynFlags\n        argsreps <- getArgRepsAmodes stg_args\n        let (rts_fun, arity) = slowCallPattern (map fst argsreps)\n\n        (r, slow_code) <- getCodeR $ do\n           r <- direct_call \"slow_call\" NativeNodeCall\n                 (mkRtsApFastLabel rts_fun) arity ((P,Just fun):argsreps)\n           emitComment $ mkFastString (\"slow_call for \" ++\n                                      showSDoc dflags (ppr fun) ++\n                                      \" with pat \" ++ unpackFS rts_fun)\n           return r\n\n        -- Note [avoid intermediate PAPs]\n        let n_args = length stg_args\n        if n_args > arity && optLevel dflags >= 2\n           then do\n             funv <- (CmmReg . CmmLocal) `fmap` assignTemp fun\n             fun_iptr <- (CmmReg . CmmLocal) `fmap`\n                    assignTemp (closureInfoPtr dflags (cmmUntag dflags funv))\n\n             -- ToDo: we could do slightly better here by reusing the\n             -- continuation from the slow call, which we have in r.\n             -- Also we'd like to push the continuation on the stack\n             -- before the branch, so that we only get one copy of the\n             -- code that saves all the live variables across the\n             -- call, but that might need some improvements to the\n             -- special case in the stack layout code to handle this\n             -- (see Note [diamond proc point]).\n\n             fast_code <- getCode $\n                emitCall (NativeNodeCall, NativeReturn)\n                  (entryCode dflags fun_iptr)\n                  (nonVArgs ((P,Just funv):argsreps))\n\n             slow_lbl <- newBlockId\n             fast_lbl <- newBlockId\n             is_tagged_lbl <- newBlockId\n             end_lbl <- newBlockId\n\n             let correct_arity = cmmEqWord dflags (funInfoArity dflags fun_iptr)\n                                                  (mkIntExpr dflags n_args)\n\n             tscope <- getTickScope\n             emit (mkCbranch (cmmIsTagged dflags funv)\n                             is_tagged_lbl slow_lbl (Just True)\n                   <*> mkLabel is_tagged_lbl tscope\n                   <*> mkCbranch correct_arity fast_lbl slow_lbl (Just True)\n                   <*> mkLabel fast_lbl tscope\n                   <*> fast_code\n                   <*> mkBranch end_lbl\n                   <*> mkLabel slow_lbl tscope\n                   <*> slow_code\n                   <*> mkLabel end_lbl tscope)\n             return r\n\n           else do\n             emit slow_code\n             return r\n\n\n-- Note [avoid intermediate PAPs]\n--\n-- A slow call which needs multiple generic apply patterns will be\n-- almost guaranteed to create one or more intermediate PAPs when\n-- applied to a function that takes the correct number of arguments.\n-- We try to avoid this situation by generating code to test whether\n-- we are calling a function with the correct number of arguments\n-- first, i.e.:\n--\n--   if (TAG(f) != 0} {  // f is not a thunk\n--      if (f->info.arity == n) {\n--         ... make a fast call to f ...\n--      }\n--   }\n--   ... otherwise make the slow call ...\n--\n-- We *only* do this when the call requires multiple generic apply\n-- functions, which requires pushing extra stack frames and probably\n-- results in intermediate PAPs.  (I say probably, because it might be\n-- that we're over-applying a function, but that seems even less\n-- likely).\n--\n-- This very rarely applies, but if it does happen in an inner loop it\n-- can have a severe impact on performance (#6084).\n\n\n--------------\ndirect_call :: String\n            -> Convention     -- e.g. NativeNodeCall or NativeDirectCall\n            -> CLabel -> RepArity\n            -> [(ArgRep,Maybe CmmExpr)] -> FCode ReturnKind\ndirect_call caller call_conv lbl arity args\n  | debugIsOn && args `lengthLessThan` real_arity  -- Too few args\n  = do -- Caller should ensure that there enough args!\n       pprPanic \"direct_call\" $\n            text caller <+> ppr arity <+>\n            ppr lbl <+> ppr (length args) <+>\n            ppr (map snd args) <+> ppr (map fst args)\n\n  | null rest_args  -- Precisely the right number of arguments\n  = emitCall (call_conv, NativeReturn) target (nonVArgs args)\n\n  | otherwise       -- Note [over-saturated calls]\n  = do dflags <- getDynFlags\n       emitCallWithExtraStack (call_conv, NativeReturn)\n                              target\n                              (nonVArgs fast_args)\n                              (nonVArgs (stack_args dflags))\n  where\n    target = CmmLit (CmmLabel lbl)\n    (fast_args, rest_args) = splitAt real_arity args\n    stack_args dflags = slowArgs dflags rest_args\n    real_arity = case call_conv of\n                   NativeNodeCall -> arity+1\n                   _              -> arity\n\n\n-- When constructing calls, it is easier to keep the ArgReps and the\n-- CmmExprs zipped together.  However, a void argument has no\n-- representation, so we need to use Maybe CmmExpr (the alternative of\n-- using zeroCLit or even undefined would work, but would be ugly).\n--\ngetArgRepsAmodes :: [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]\ngetArgRepsAmodes = mapM getArgRepAmode\n  where getArgRepAmode arg\n           | V <- rep  = return (V, Nothing)\n           | otherwise = do expr <- getArgAmode (NonVoid arg)\n                            return (rep, Just expr)\n           where rep = toArgRep (argPrimRep arg)\n\nnonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]\nnonVArgs [] = []\nnonVArgs ((_,Nothing)  : args) = nonVArgs args\nnonVArgs ((_,Just arg) : args) = arg : nonVArgs args\n\n{-\nNote [over-saturated calls]\n\nThe natural thing to do for an over-saturated call would be to call\nthe function with the correct number of arguments, and then apply the\nremaining arguments to the value returned, e.g.\n\n  f a b c d   (where f has arity 2)\n  -->\n  r = call f(a,b)\n  call r(c,d)\n\nbut this entails\n  - saving c and d on the stack\n  - making a continuation info table\n  - at the continuation, loading c and d off the stack into regs\n  - finally, call r\n\nNote that since there are a fixed number of different r's\n(e.g.  stg_ap_pp_fast), we can also pre-compile continuations\nthat correspond to each of them, rather than generating a fresh\none for each over-saturated call.\n\nNot only does this generate much less code, it is faster too.  We will\ngenerate something like:\n\nSp[old+16] = c\nSp[old+24] = d\nSp[old+32] = stg_ap_pp_info\ncall f(a,b) -- usual calling convention\n\nFor the purposes of the CmmCall node, we count this extra stack as\njust more arguments that we are passing on the stack (cml_args).\n-}\n\n-- | 'slowArgs' takes a list of function arguments and prepares them for\n-- pushing on the stack for \"extra\" arguments to a function which requires\n-- fewer arguments than we currently have.\nslowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]\nslowArgs _ [] = []\nslowArgs dflags args -- careful: reps contains voids (V), but args does not\n  | gopt Opt_SccProfilingOn dflags\n              = save_cccs ++ this_pat ++ slowArgs dflags rest_args\n  | otherwise =              this_pat ++ slowArgs dflags rest_args\n  where\n    (arg_pat, n)            = slowCallPattern (map fst args)\n    (call_args, rest_args)  = splitAt n args\n\n    stg_ap_pat = mkCmmRetInfoLabel rtsUnitId arg_pat\n    this_pat   = (N, Just (mkLblExpr stg_ap_pat)) : call_args\n    save_cccs  = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just cccsExpr)]\n    save_cccs_lbl = mkCmmRetInfoLabel rtsUnitId (fsLit \"stg_restore_cccs\")\n\n-------------------------------------------------------------------------\n----        Laying out objects on the heap and stack\n-------------------------------------------------------------------------\n\n-- The heap always grows upwards, so hpRel is easy to compute\nhpRel :: VirtualHpOffset         -- virtual offset of Hp\n      -> VirtualHpOffset         -- virtual offset of The Thing\n      -> WordOff                -- integer word offset\nhpRel hp off = off - hp\n\ngetHpRelOffset :: VirtualHpOffset -> FCode CmmExpr\n-- See Note [Virtual and real heap pointers] in StgCmmMonad\ngetHpRelOffset virtual_offset\n  = do dflags <- getDynFlags\n       hp_usg <- getHpUsage\n       return (cmmRegOffW dflags hpReg (hpRel (realHp hp_usg) virtual_offset))\n\ndata FieldOffOrPadding a\n    = FieldOff (NonVoid a) -- Something that needs an offset.\n               ByteOff     -- Offset in bytes.\n    | Padding ByteOff  -- Length of padding in bytes.\n              ByteOff  -- Offset in bytes.\n\n-- | Used to tell the various @mkVirtHeapOffsets@ functions what kind\n-- of header the object has.  This will be accounted for in the\n-- offsets of the fields returned.\ndata ClosureHeader\n  = NoHeader\n  | StdHeader\n  | ThunkHeader\n\nmkVirtHeapOffsetsWithPadding\n  :: DynFlags\n  -> ClosureHeader            -- What kind of header to account for\n  -> [NonVoid (PrimRep, a)]   -- Things to make offsets for\n  -> ( WordOff                -- Total number of words allocated\n     , WordOff                -- Number of words allocated for *pointers*\n     , [FieldOffOrPadding a]  -- Either an offset or padding.\n     )\n\n-- Things with their offsets from start of object in order of\n-- increasing offset; BUT THIS MAY BE DIFFERENT TO INPUT ORDER\n-- First in list gets lowest offset, which is initial offset + 1.\n--\n-- mkVirtHeapOffsetsWithPadding always returns boxed things with smaller offsets\n-- than the unboxed things\n\nmkVirtHeapOffsetsWithPadding dflags header things =\n    ASSERT(not (any (isVoidRep . fst . fromNonVoid) things))\n    ( tot_wds\n    , bytesToWordsRoundUp dflags bytes_of_ptrs\n    , concat (ptrs_w_offsets ++ non_ptrs_w_offsets) ++ final_pad\n    )\n  where\n    hdr_words = case header of\n      NoHeader -> 0\n      StdHeader -> fixedHdrSizeW dflags\n      ThunkHeader -> thunkHdrSize dflags\n    hdr_bytes = wordsToBytes dflags hdr_words\n\n    (ptrs, non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things\n\n    (bytes_of_ptrs, ptrs_w_offsets) =\n       mapAccumL computeOffset 0 ptrs\n    (tot_bytes, non_ptrs_w_offsets) =\n       mapAccumL computeOffset bytes_of_ptrs non_ptrs\n\n    tot_wds = bytesToWordsRoundUp dflags tot_bytes\n\n    final_pad_size = tot_wds * word_size - tot_bytes\n    final_pad\n        | final_pad_size > 0 = [(Padding final_pad_size\n                                         (hdr_bytes + tot_bytes))]\n        | otherwise          = []\n\n    word_size = wORD_SIZE dflags\n\n    computeOffset bytes_so_far nv_thing =\n        (new_bytes_so_far, with_padding field_off)\n      where\n        (rep, thing) = fromNonVoid nv_thing\n\n        -- Size of the field in bytes.\n        !sizeB = primRepSizeB dflags rep\n\n        -- Align the start offset (eg, 2-byte value should be 2-byte aligned).\n        -- But not more than to a word.\n        !align = min word_size sizeB\n        !start = roundUpTo bytes_so_far align\n        !padding = start - bytes_so_far\n\n        -- Final offset is:\n        --   size of header + bytes_so_far + padding\n        !final_offset = hdr_bytes + bytes_so_far + padding\n        !new_bytes_so_far = start + sizeB\n        field_off = FieldOff (NonVoid thing) final_offset\n\n        with_padding field_off\n            | padding == 0 = [field_off]\n            | otherwise    = [ Padding padding (hdr_bytes + bytes_so_far)\n                             , field_off\n                             ]\n\n\nmkVirtHeapOffsets\n  :: DynFlags\n  -> ClosureHeader            -- What kind of header to account for\n  -> [NonVoid (PrimRep,a)]    -- Things to make offsets for\n  -> (WordOff,                -- _Total_ number of words allocated\n      WordOff,                -- Number of words allocated for *pointers*\n      [(NonVoid a, ByteOff)])\nmkVirtHeapOffsets dflags header things =\n    ( tot_wds\n    , ptr_wds\n    , [ (field, offset) | (FieldOff field offset) <- things_offsets ]\n    )\n  where\n   (tot_wds, ptr_wds, things_offsets) =\n       mkVirtHeapOffsetsWithPadding dflags header things\n\n-- | Just like mkVirtHeapOffsets, but for constructors\nmkVirtConstrOffsets\n  :: DynFlags -> [NonVoid (PrimRep, a)]\n  -> (WordOff, WordOff, [(NonVoid a, ByteOff)])\nmkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags StdHeader\n\n-- | Just like mkVirtConstrOffsets, but used when we don't have the actual\n-- arguments. Useful when e.g. generating info tables; we just need to know\n-- sizes of pointer and non-pointer fields.\nmkVirtConstrSizes :: DynFlags -> [NonVoid PrimRep] -> (WordOff, WordOff)\nmkVirtConstrSizes dflags field_reps\n  = (tot_wds, ptr_wds)\n  where\n    (tot_wds, ptr_wds, _) =\n       mkVirtConstrOffsets dflags\n         (map (\\nv_rep -> NonVoid (fromNonVoid nv_rep, ())) field_reps)\n\n-------------------------------------------------------------------------\n--\n--        Making argument descriptors\n--\n--  An argument descriptor describes the layout of args on the stack,\n--  both for         * GC (stack-layout) purposes, and\n--                * saving/restoring registers when a heap-check fails\n--\n-- Void arguments aren't important, therefore (contrast constructSlowCall)\n--\n-------------------------------------------------------------------------\n\n-- bring in ARG_P, ARG_N, etc.\n#include \"../includes/rts/storage/FunTypes.h\"\n\nmkArgDescr :: DynFlags -> [Id] -> ArgDescr\nmkArgDescr dflags args\n  = let arg_bits = argBits dflags arg_reps\n        arg_reps = filter isNonV (map idArgRep args)\n           -- Getting rid of voids eases matching of standard patterns\n    in case stdPattern arg_reps of\n         Just spec_id -> ArgSpec spec_id\n         Nothing      -> ArgGen  arg_bits\n\nargBits :: DynFlags -> [ArgRep] -> [Bool]        -- True for non-ptr, False for ptr\nargBits _      []           = []\nargBits dflags (P   : args) = False : argBits dflags args\nargBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True)\n                    ++ argBits dflags args\n\n----------------------\nstdPattern :: [ArgRep] -> Maybe Int\nstdPattern reps\n  = case reps of\n        []    -> Just ARG_NONE        -- just void args, probably\n        [N]   -> Just ARG_N\n        [P]   -> Just ARG_P\n        [F]   -> Just ARG_F\n        [D]   -> Just ARG_D\n        [L]   -> Just ARG_L\n        [V16] -> Just ARG_V16\n        [V32] -> Just ARG_V32\n        [V64] -> Just ARG_V64\n\n        [N,N] -> Just ARG_NN\n        [N,P] -> Just ARG_NP\n        [P,N] -> Just ARG_PN\n        [P,P] -> Just ARG_PP\n\n        [N,N,N] -> Just ARG_NNN\n        [N,N,P] -> Just ARG_NNP\n        [N,P,N] -> Just ARG_NPN\n        [N,P,P] -> Just ARG_NPP\n        [P,N,N] -> Just ARG_PNN\n        [P,N,P] -> Just ARG_PNP\n        [P,P,N] -> Just ARG_PPN\n        [P,P,P] -> Just ARG_PPP\n\n        [P,P,P,P]     -> Just ARG_PPPP\n        [P,P,P,P,P]   -> Just ARG_PPPPP\n        [P,P,P,P,P,P] -> Just ARG_PPPPPP\n\n        _ -> Nothing\n\n-------------------------------------------------------------------------\n--\n--        Generating the info table and code for a closure\n--\n-------------------------------------------------------------------------\n\n-- Here we make an info table of type 'CmmInfo'.  The concrete\n-- representation as a list of 'CmmAddr' is handled later\n-- in the pipeline by 'cmmToRawCmm'.\n-- When loading the free variables, a function closure pointer may be tagged,\n-- so we must take it into account.\n\nemitClosureProcAndInfoTable :: Bool                    -- top-level?\n                            -> Id                      -- name of the closure\n                            -> LambdaFormInfo\n                            -> CmmInfoTable\n                            -> [NonVoid Id]            -- incoming arguments\n                            -> ((Int, LocalReg, [LocalReg]) -> FCode ()) -- function body\n                            -> FCode ()\nemitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body\n = do   { dflags <- getDynFlags\n        -- Bind the binder itself, but only if it's not a top-level\n        -- binding. We need non-top let-bindings to refer to the\n        -- top-level binding, which this binding would incorrectly shadow.\n        ; node <- if top_lvl then return $ idToReg dflags (NonVoid bndr)\n                  else bindToReg (NonVoid bndr) lf_info\n        ; let node_points = nodeMustPointToIt dflags lf_info\n        ; arg_regs <- bindArgsToRegs args\n        ; let args' = if node_points then (node : arg_regs) else arg_regs\n              conv  = if nodeMustPointToIt dflags lf_info then NativeNodeCall\n                                                          else NativeDirectCall\n              (offset, _, _) = mkCallEntry dflags conv args' []\n        ; emitClosureAndInfoTable info_tbl conv args' $ body (offset, node, arg_regs)\n        }\n\n-- Data constructors need closures, but not with all the argument handling\n-- needed for functions. The shared part goes here.\nemitClosureAndInfoTable ::\n  CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()\nemitClosureAndInfoTable info_tbl conv args body\n  = do { (_, blks) <- getCodeScoped body\n       ; let entry_lbl = toEntryLbl (cit_lbl info_tbl)\n       ; emitProcWithConvention conv (Just info_tbl) entry_lbl args blks\n       }\n", "num_lines": 624}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, UnboxedTuples #-}\n\n-----------------------------------------------------------------------------\n--\n-- Monad for Stg to C-- code generation\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmMonad (\n        FCode,        -- type\n\n        initC, runC, fixC,\n        newUnique,\n\n        emitLabel,\n\n        emit, emitDecl, emitProc,\n        emitProcWithConvention, emitProcWithStackFrame,\n        emitOutOfLine, emitAssign, emitStore,\n        emitComment, emitTick, emitUnwind,\n\n        getCmm, aGraphToGraph,\n        getCodeR, getCode, getCodeScoped, getHeapUsage,\n\n        mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto,\n        mkCmmIfThenElse', mkCmmIfThen', mkCmmIfGoto',\n\n        mkCall, mkCmmCall,\n\n        forkClosureBody, forkLneBody, forkAlts, forkAltPair, codeOnly,\n\n        ConTagZ,\n\n        Sequel(..), ReturnKind(..),\n        withSequel, getSequel,\n\n        setTickyCtrLabel, getTickyCtrLabel,\n        tickScope, getTickScope,\n\n        withUpdFrameOff, getUpdFrameOff, initUpdFrameOff,\n\n        HeapUsage(..), VirtualHpOffset,        initHpUsage,\n        getHpUsage,  setHpUsage, heapHWM,\n        setVirtHp, getVirtHp, setRealHp,\n\n        getModuleName,\n\n        -- ideally we wouldn't export these, but some other modules access internal state\n        getState, setState, getSelfLoop, withSelfLoop, getInfoDown, getDynFlags, getThisPackage,\n\n        -- more localised access to monad state\n        CgIdInfo(..),\n        getBinds, setBinds,\n\n        -- out of general friendliness, we also export ...\n        CgInfoDownwards(..), CgState(..)        -- non-abstract\n    ) where\n\nimport GhcPrelude hiding( sequence, succ )\n\nimport Cmm\nimport StgCmmClosure\nimport DynFlags\nimport Hoopl.Collections\nimport MkGraph\nimport BlockId\nimport CLabel\nimport SMRep\nimport Module\nimport Id\nimport VarEnv\nimport OrdList\nimport BasicTypes( ConTagZ )\nimport Unique\nimport UniqSupply\nimport FastString\nimport Outputable\nimport Util\n\nimport Control.Monad\nimport Data.List\n\n\n\n--------------------------------------------------------\n-- The FCode monad and its types\n--\n-- FCode is the monad plumbed through the Stg->Cmm code generator, and\n-- the Cmm parser.  It contains the following things:\n--\n--  - A writer monad, collecting:\n--    - code for the current function, in the form of a CmmAGraph.\n--      The function \"emit\" appends more code to this.\n--    - the top-level CmmDecls accumulated so far\n--\n--  - A state monad with:\n--    - the local bindings in scope\n--    - the current heap usage\n--    - a UniqSupply\n--\n--  - A reader monad, for CgInfoDownwards, containing\n--    - DynFlags,\n--    - the current Module\n--    - the update-frame offset\n--    - the ticky counter label\n--    - the Sequel (the continuation to return to)\n--    - the self-recursive tail call information\n\n--------------------------------------------------------\n\nnewtype FCode a = FCode { doFCode :: CgInfoDownwards -> CgState -> (a, CgState) }\n\ninstance Functor FCode where\n    fmap f (FCode g) = FCode $ \\i s -> case g i s of (a, s') -> (f a, s')\n\ninstance Applicative FCode where\n    pure val = FCode (\\_info_down state -> (val, state))\n    {-# INLINE pure #-}\n    (<*>) = ap\n\ninstance Monad FCode where\n    FCode m >>= k = FCode $\n        \\info_down state ->\n            case m info_down state of\n              (m_result, new_state) ->\n                 case k m_result of\n                   FCode kcode -> kcode info_down new_state\n    {-# INLINE (>>=) #-}\n\ninstance MonadUnique FCode where\n  getUniqueSupplyM = cgs_uniqs <$> getState\n  getUniqueM = FCode $ \\_ st ->\n    let (u, us') = takeUniqFromSupply (cgs_uniqs st)\n    in (u, st { cgs_uniqs = us' })\n\ninitC :: IO CgState\ninitC  = do { uniqs <- mkSplitUniqSupply 'c'\n            ; return (initCgState uniqs) }\n\nrunC :: DynFlags -> Module -> CgState -> FCode a -> (a,CgState)\nrunC dflags mod st fcode = doFCode fcode (initCgInfoDown dflags mod) st\n\nfixC :: (a -> FCode a) -> FCode a\nfixC fcode = FCode $\n    \\info_down state -> let (v, s) = doFCode (fcode v) info_down state\n                        in (v, s)\n\n--------------------------------------------------------\n--        The code generator environment\n--------------------------------------------------------\n\n-- This monadery has some information that it only passes\n-- *downwards*, as well as some ``state'' which is modified\n-- as we go along.\n\ndata CgInfoDownwards        -- information only passed *downwards* by the monad\n  = MkCgInfoDown {\n        cgd_dflags    :: DynFlags,\n        cgd_mod       :: Module,            -- Module being compiled\n        cgd_updfr_off :: UpdFrameOffset,    -- Size of current update frame\n        cgd_ticky     :: CLabel,            -- Current destination for ticky counts\n        cgd_sequel    :: Sequel,            -- What to do at end of basic block\n        cgd_self_loop :: Maybe SelfLoopInfo,-- Which tail calls can be compiled\n                                            -- as local jumps? See Note\n                                            -- [Self-recursive tail calls] in\n                                            -- StgCmmExpr\n        cgd_tick_scope:: CmmTickScope       -- Tick scope for new blocks & ticks\n  }\n\ntype CgBindings = IdEnv CgIdInfo\n\ndata CgIdInfo\n  = CgIdInfo\n        { cg_id :: Id   -- Id that this is the info for\n        , cg_lf  :: LambdaFormInfo\n        , cg_loc :: CgLoc                     -- CmmExpr for the *tagged* value\n        }\n\ninstance Outputable CgIdInfo where\n  ppr (CgIdInfo { cg_id = id, cg_loc = loc })\n    = ppr id <+> text \"-->\" <+> ppr loc\n\n-- Sequel tells what to do with the result of this expression\ndata Sequel\n  = Return              -- Return result(s) to continuation found on the stack.\n\n  | AssignTo\n        [LocalReg]      -- Put result(s) in these regs and fall through\n                        -- NB: no void arguments here\n                        --\n        Bool            -- Should we adjust the heap pointer back to\n                        -- recover space that's unused on this path?\n                        -- We need to do this only if the expression\n                        -- may allocate (e.g. it's a foreign call or\n                        -- allocating primOp)\n\ninstance Outputable Sequel where\n    ppr Return = text \"Return\"\n    ppr (AssignTo regs b) = text \"AssignTo\" <+> ppr regs <+> ppr b\n\n-- See Note [sharing continuations] below\ndata ReturnKind\n  = AssignedDirectly\n  | ReturnedTo BlockId ByteOff\n\n-- Note [sharing continuations]\n--\n-- ReturnKind says how the expression being compiled returned its\n-- results: either by assigning directly to the registers specified\n-- by the Sequel, or by returning to a continuation that does the\n-- assignments.  The point of this is we might be able to re-use the\n-- continuation in a subsequent heap-check.  Consider:\n--\n--    case f x of z\n--      True  -> <True code>\n--      False -> <False code>\n--\n-- Naively we would generate\n--\n--    R2 = x   -- argument to f\n--    Sp[young(L1)] = L1\n--    call f returns to L1\n--  L1:\n--    z = R1\n--    if (z & 1) then Ltrue else Lfalse\n--  Ltrue:\n--    Hp = Hp + 24\n--    if (Hp > HpLim) then L4 else L7\n--  L4:\n--    HpAlloc = 24\n--    goto L5\n--  L5:\n--    R1 = z\n--    Sp[young(L6)] = L6\n--    call stg_gc_unpt_r1 returns to L6\n--  L6:\n--    z = R1\n--    goto L1\n--  L7:\n--    <True code>\n--  Lfalse:\n--    <False code>\n--\n-- We want the gc call in L4 to return to L1, and discard L6.  Note\n-- that not only can we share L1 and L6, but the assignment of the\n-- return address in L4 is unnecessary because the return address for\n-- L1 is already on the stack.  We used to catch the sharing of L1 and\n-- L6 in the common-block-eliminator, but not the unnecessary return\n-- address assignment.\n--\n-- Since this case is so common I decided to make it more explicit and\n-- robust by programming the sharing directly, rather than relying on\n-- the common-block eliminator to catch it.  This makes\n-- common-block-elimination an optional optimisation, and furthermore\n-- generates less code in the first place that we have to subsequently\n-- clean up.\n--\n-- There are some rarer cases of common blocks that we don't catch\n-- this way, but that's ok.  Common-block-elimination is still available\n-- to catch them when optimisation is enabled.  Some examples are:\n--\n--   - when both the True and False branches do a heap check, we\n--     can share the heap-check failure code L4a and maybe L4\n--\n--   - in a case-of-case, there might be multiple continuations that\n--     we can common up.\n--\n-- It is always safe to use AssignedDirectly.  Expressions that jump\n-- to the continuation from multiple places (e.g. case expressions)\n-- fall back to AssignedDirectly.\n--\n\n\ninitCgInfoDown :: DynFlags -> Module -> CgInfoDownwards\ninitCgInfoDown dflags mod\n  = MkCgInfoDown { cgd_dflags    = dflags\n                 , cgd_mod       = mod\n                 , cgd_updfr_off = initUpdFrameOff dflags\n                 , cgd_ticky     = mkTopTickyCtrLabel\n                 , cgd_sequel    = initSequel\n                 , cgd_self_loop = Nothing\n                 , cgd_tick_scope= GlobalScope }\n\ninitSequel :: Sequel\ninitSequel = Return\n\ninitUpdFrameOff :: DynFlags -> UpdFrameOffset\ninitUpdFrameOff dflags = widthInBytes (wordWidth dflags) -- space for the RA\n\n\n--------------------------------------------------------\n--        The code generator state\n--------------------------------------------------------\n\ndata CgState\n  = MkCgState {\n     cgs_stmts :: CmmAGraph,          -- Current procedure\n\n     cgs_tops  :: OrdList CmmDecl,\n        -- Other procedures and data blocks in this compilation unit\n        -- Both are ordered only so that we can\n        -- reduce forward references, when it's easy to do so\n\n     cgs_binds :: CgBindings,\n\n     cgs_hp_usg  :: HeapUsage,\n\n     cgs_uniqs :: UniqSupply }\n\ndata HeapUsage   -- See Note [Virtual and real heap pointers]\n  = HeapUsage {\n        virtHp :: VirtualHpOffset,       -- Virtual offset of highest-allocated word\n                                         --   Incremented whenever we allocate\n        realHp :: VirtualHpOffset        -- realHp: Virtual offset of real heap ptr\n                                         --   Used in instruction addressing modes\n    }\n\ntype VirtualHpOffset = WordOff\n\n\n{- Note [Virtual and real heap pointers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe code generator can allocate one or more objects contiguously, performing\none heap check to cover allocation of all the objects at once.  Let's call\nthis little chunk of heap space an \"allocation chunk\".  The code generator\nwill emit code to\n  * Perform a heap-exhaustion check\n  * Move the heap pointer to the end of the allocation chunk\n  * Allocate multiple objects within the chunk\n\nThe code generator uses VirtualHpOffsets to address words within a\nsingle allocation chunk; these start at one and increase positively.\nThe first word of the chunk has VirtualHpOffset=1, the second has\nVirtualHpOffset=2, and so on.\n\n * The field realHp tracks (the VirtualHpOffset) where the real Hp\n   register is pointing.  Typically it'll be pointing to the end of the\n   allocation chunk.\n\n * The field virtHp gives the VirtualHpOffset of the highest-allocated\n   word so far.  It starts at zero (meaning no word has been allocated),\n   and increases whenever an object is allocated.\n\nThe difference between realHp and virtHp gives the offset from the\nreal Hp register of a particular word in the allocation chunk. This\nis what getHpRelOffset does.  Since the returned offset is relative\nto the real Hp register, it is valid only until you change the real\nHp register.  (Changing virtHp doesn't matter.)\n-}\n\n\ninitCgState :: UniqSupply -> CgState\ninitCgState uniqs\n  = MkCgState { cgs_stmts  = mkNop\n              , cgs_tops   = nilOL\n              , cgs_binds  = emptyVarEnv\n              , cgs_hp_usg = initHpUsage\n              , cgs_uniqs  = uniqs }\n\nstateIncUsage :: CgState -> CgState -> CgState\n-- stateIncUsage@ e1 e2 incorporates in e1\n-- the heap high water mark found in e2.\nstateIncUsage s1 s2@(MkCgState { cgs_hp_usg = hp_usg })\n     = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg }\n       `addCodeBlocksFrom` s2\n\naddCodeBlocksFrom :: CgState -> CgState -> CgState\n-- Add code blocks from the latter to the former\n-- (The cgs_stmts will often be empty, but not always; see codeOnly)\ns1 `addCodeBlocksFrom` s2\n  = s1 { cgs_stmts = cgs_stmts s1 MkGraph.<*> cgs_stmts s2,\n         cgs_tops  = cgs_tops  s1 `appOL` cgs_tops  s2 }\n\n\n-- The heap high water mark is the larger of virtHp and hwHp.  The latter is\n-- only records the high water marks of forked-off branches, so to find the\n-- heap high water mark you have to take the max of virtHp and hwHp.  Remember,\n-- virtHp never retreats!\n--\n-- Note Jan 04: ok, so why do we only look at the virtual Hp??\n\nheapHWM :: HeapUsage -> VirtualHpOffset\nheapHWM = virtHp\n\ninitHpUsage :: HeapUsage\ninitHpUsage = HeapUsage { virtHp = 0, realHp = 0 }\n\nmaxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage\nhp_usg `maxHpHw` hw = hp_usg { virtHp = virtHp hp_usg `max` hw }\n\n--------------------------------------------------------\n-- Operators for getting and setting the state and \"info_down\".\n--------------------------------------------------------\n\ngetState :: FCode CgState\ngetState = FCode $ \\_info_down state -> (state, state)\n\nsetState :: CgState -> FCode ()\nsetState state = FCode $ \\_info_down _ -> ((), state)\n\ngetHpUsage :: FCode HeapUsage\ngetHpUsage = do\n        state <- getState\n        return $ cgs_hp_usg state\n\nsetHpUsage :: HeapUsage -> FCode ()\nsetHpUsage new_hp_usg = do\n        state <- getState\n        setState $ state {cgs_hp_usg = new_hp_usg}\n\nsetVirtHp :: VirtualHpOffset -> FCode ()\nsetVirtHp new_virtHp\n  = do  { hp_usage <- getHpUsage\n        ; setHpUsage (hp_usage {virtHp = new_virtHp}) }\n\ngetVirtHp :: FCode VirtualHpOffset\ngetVirtHp\n  = do  { hp_usage <- getHpUsage\n        ; return (virtHp hp_usage) }\n\nsetRealHp ::  VirtualHpOffset -> FCode ()\nsetRealHp new_realHp\n  = do  { hp_usage <- getHpUsage\n        ; setHpUsage (hp_usage {realHp = new_realHp}) }\n\ngetBinds :: FCode CgBindings\ngetBinds = do\n        state <- getState\n        return $ cgs_binds state\n\nsetBinds :: CgBindings -> FCode ()\nsetBinds new_binds = do\n        state <- getState\n        setState $ state {cgs_binds = new_binds}\n\nwithState :: FCode a -> CgState -> FCode (a,CgState)\nwithState (FCode fcode) newstate = FCode $ \\info_down state ->\n  case fcode info_down newstate of\n    (retval, state2) -> ((retval,state2), state)\n\nnewUniqSupply :: FCode UniqSupply\nnewUniqSupply = do\n        state <- getState\n        let (us1, us2) = splitUniqSupply (cgs_uniqs state)\n        setState $ state { cgs_uniqs = us1 }\n        return us2\n\nnewUnique :: FCode Unique\nnewUnique = do\n        state <- getState\n        let (u,us') = takeUniqFromSupply (cgs_uniqs state)\n        setState $ state { cgs_uniqs = us' }\n        return u\n\n------------------\ngetInfoDown :: FCode CgInfoDownwards\ngetInfoDown = FCode $ \\info_down state -> (info_down,state)\n\ngetSelfLoop :: FCode (Maybe SelfLoopInfo)\ngetSelfLoop = do\n        info_down <- getInfoDown\n        return $ cgd_self_loop info_down\n\nwithSelfLoop :: SelfLoopInfo -> FCode a -> FCode a\nwithSelfLoop self_loop code = do\n        info_down <- getInfoDown\n        withInfoDown code (info_down {cgd_self_loop = Just self_loop})\n\ninstance HasDynFlags FCode where\n    getDynFlags = liftM cgd_dflags getInfoDown\n\ngetThisPackage :: FCode UnitId\ngetThisPackage = liftM thisPackage getDynFlags\n\nwithInfoDown :: FCode a -> CgInfoDownwards -> FCode a\nwithInfoDown (FCode fcode) info_down = FCode $ \\_ state -> fcode info_down state\n\n-- ----------------------------------------------------------------------------\n-- Get the current module name\n\ngetModuleName :: FCode Module\ngetModuleName = do { info <- getInfoDown; return (cgd_mod info) }\n\n-- ----------------------------------------------------------------------------\n-- Get/set the end-of-block info\n\nwithSequel :: Sequel -> FCode a -> FCode a\nwithSequel sequel code\n  = do  { info  <- getInfoDown\n        ; withInfoDown code (info {cgd_sequel = sequel, cgd_self_loop = Nothing }) }\n\ngetSequel :: FCode Sequel\ngetSequel = do  { info <- getInfoDown\n                ; return (cgd_sequel info) }\n\n-- ----------------------------------------------------------------------------\n-- Get/set the size of the update frame\n\n-- We keep track of the size of the update frame so that we\n-- can set the stack pointer to the proper address on return\n-- (or tail call) from the closure.\n-- There should be at most one update frame for each closure.\n-- Note: I'm including the size of the original return address\n-- in the size of the update frame -- hence the default case on `get'.\n\nwithUpdFrameOff :: UpdFrameOffset -> FCode a -> FCode a\nwithUpdFrameOff size code\n  = do  { info  <- getInfoDown\n        ; withInfoDown code (info {cgd_updfr_off = size }) }\n\ngetUpdFrameOff :: FCode UpdFrameOffset\ngetUpdFrameOff\n  = do  { info  <- getInfoDown\n        ; return $ cgd_updfr_off info }\n\n-- ----------------------------------------------------------------------------\n-- Get/set the current ticky counter label\n\ngetTickyCtrLabel :: FCode CLabel\ngetTickyCtrLabel = do\n        info <- getInfoDown\n        return (cgd_ticky info)\n\nsetTickyCtrLabel :: CLabel -> FCode a -> FCode a\nsetTickyCtrLabel ticky code = do\n        info <- getInfoDown\n        withInfoDown code (info {cgd_ticky = ticky})\n\n-- ----------------------------------------------------------------------------\n-- Manage tick scopes\n\n-- | The current tick scope. We will assign this to generated blocks.\ngetTickScope :: FCode CmmTickScope\ngetTickScope = do\n        info <- getInfoDown\n        return (cgd_tick_scope info)\n\n-- | Places blocks generated by the given code into a fresh\n-- (sub-)scope. This will make sure that Cmm annotations in our scope\n-- will apply to the Cmm blocks generated therein - but not the other\n-- way around.\ntickScope :: FCode a -> FCode a\ntickScope code = do\n        info <- getInfoDown\n        if debugLevel (cgd_dflags info) == 0 then code else do\n          u <- newUnique\n          let scope' = SubScope u (cgd_tick_scope info)\n          withInfoDown code info{ cgd_tick_scope = scope' }\n\n\n--------------------------------------------------------\n--                 Forking\n--------------------------------------------------------\n\nforkClosureBody :: FCode () -> FCode ()\n-- forkClosureBody compiles body_code in environment where:\n--   - sequel, update stack frame and self loop info are\n--     set to fresh values\n--   - state is set to a fresh value, except for local bindings\n--     that are passed in unchanged. It's up to the enclosed code to\n--     re-bind the free variables to a field of the closure.\n\nforkClosureBody body_code\n  = do  { dflags <- getDynFlags\n        ; info   <- getInfoDown\n        ; us     <- newUniqSupply\n        ; state  <- getState\n        ; let body_info_down = info { cgd_sequel    = initSequel\n                                    , cgd_updfr_off = initUpdFrameOff dflags\n                                    , cgd_self_loop = Nothing }\n              fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }\n              ((),fork_state_out) = doFCode body_code body_info_down fork_state_in\n        ; setState $ state `addCodeBlocksFrom` fork_state_out }\n\nforkLneBody :: FCode a -> FCode a\n-- 'forkLneBody' takes a body of let-no-escape binding and compiles\n-- it in the *current* environment, returning the graph thus constructed.\n--\n-- The current environment is passed on completely unchanged to\n-- the successor.  In particular, any heap usage from the enclosed\n-- code is discarded; it should deal with its own heap consumption.\nforkLneBody body_code\n  = do  { info_down <- getInfoDown\n        ; us        <- newUniqSupply\n        ; state     <- getState\n        ; let fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }\n              (result, fork_state_out) = doFCode body_code info_down fork_state_in\n        ; setState $ state `addCodeBlocksFrom` fork_state_out\n        ; return result }\n\ncodeOnly :: FCode () -> FCode ()\n-- Emit any code from the inner thing into the outer thing\n-- Do not affect anything else in the outer state\n-- Used in almost-circular code to prevent false loop dependencies\ncodeOnly body_code\n  = do  { info_down <- getInfoDown\n        ; us        <- newUniqSupply\n        ; state     <- getState\n        ; let   fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state\n                                                 , cgs_hp_usg  = cgs_hp_usg state }\n                ((), fork_state_out) = doFCode body_code info_down fork_state_in\n        ; setState $ state `addCodeBlocksFrom` fork_state_out }\n\nforkAlts :: [FCode a] -> FCode [a]\n-- (forkAlts' bs d) takes fcodes 'bs' for the branches of a 'case', and\n-- an fcode for the default case 'd', and compiles each in the current\n-- environment.  The current environment is passed on unmodified, except\n-- that the virtual Hp is moved on to the worst virtual Hp for the branches\n\nforkAlts branch_fcodes\n  = do  { info_down <- getInfoDown\n        ; us <- newUniqSupply\n        ; state <- getState\n        ; let compile us branch\n                = (us2, doFCode branch info_down branch_state)\n                where\n                  (us1,us2) = splitUniqSupply us\n                  branch_state = (initCgState us1) {\n                                        cgs_binds  = cgs_binds state\n                                      , cgs_hp_usg = cgs_hp_usg state }\n              (_us, results) = mapAccumL compile us branch_fcodes\n              (branch_results, branch_out_states) = unzip results\n        ; setState $ foldl' stateIncUsage state branch_out_states\n                -- NB foldl.  state is the *left* argument to stateIncUsage\n        ; return branch_results }\n\nforkAltPair :: FCode a -> FCode a -> FCode (a,a)\n-- Most common use of 'forkAlts'; having this helper function avoids\n-- accidental use of failible pattern-matches in @do@-notation\nforkAltPair x y = do\n  xy' <- forkAlts [x,y]\n  case xy' of\n    [x',y'] -> return (x',y')\n    _ -> panic \"forkAltPair\"\n\n-- collect the code emitted by an FCode computation\ngetCodeR :: FCode a -> FCode (a, CmmAGraph)\ngetCodeR fcode\n  = do  { state1 <- getState\n        ; (a, state2) <- withState fcode (state1 { cgs_stmts = mkNop })\n        ; setState $ state2 { cgs_stmts = cgs_stmts state1  }\n        ; return (a, cgs_stmts state2) }\n\ngetCode :: FCode a -> FCode CmmAGraph\ngetCode fcode = do { (_,stmts) <- getCodeR fcode; return stmts }\n\n-- | Generate code into a fresh tick (sub-)scope and gather generated code\ngetCodeScoped :: FCode a -> FCode (a, CmmAGraphScoped)\ngetCodeScoped fcode\n  = do  { state1 <- getState\n        ; ((a, tscope), state2) <-\n            tickScope $\n            flip withState state1 { cgs_stmts = mkNop } $\n            do { a   <- fcode\n               ; scp <- getTickScope\n               ; return (a, scp) }\n        ; setState $ state2 { cgs_stmts = cgs_stmts state1  }\n        ; return (a, (cgs_stmts state2, tscope)) }\n\n\n-- 'getHeapUsage' applies a function to the amount of heap that it uses.\n-- It initialises the heap usage to zeros, and passes on an unchanged\n-- heap usage.\n--\n-- It is usually a prelude to performing a GC check, so everything must\n-- be in a tidy and consistent state.\n--\n-- Note the slightly subtle fixed point behaviour needed here\n\ngetHeapUsage :: (VirtualHpOffset -> FCode a) -> FCode a\ngetHeapUsage fcode\n  = do  { info_down <- getInfoDown\n        ; state <- getState\n        ; let   fstate_in = state { cgs_hp_usg  = initHpUsage }\n                (r, fstate_out) = doFCode (fcode hp_hw) info_down fstate_in\n                hp_hw = heapHWM (cgs_hp_usg fstate_out)        -- Loop here!\n\n        ; setState $ fstate_out { cgs_hp_usg = cgs_hp_usg state }\n        ; return r }\n\n-- ----------------------------------------------------------------------------\n-- Combinators for emitting code\n\nemitCgStmt :: CgStmt -> FCode ()\nemitCgStmt stmt\n  = do  { state <- getState\n        ; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }\n        }\n\nemitLabel :: BlockId -> FCode ()\nemitLabel id = do tscope <- getTickScope\n                  emitCgStmt (CgLabel id tscope)\n\nemitComment :: FastString -> FCode ()\nemitComment s\n  | debugIsOn = emitCgStmt (CgStmt (CmmComment s))\n  | otherwise = return ()\n\nemitTick :: CmmTickish -> FCode ()\nemitTick = emitCgStmt . CgStmt . CmmTick\n\nemitUnwind :: [(GlobalReg, Maybe CmmExpr)] -> FCode ()\nemitUnwind regs = do\n  dflags <- getDynFlags\n  when (debugLevel dflags > 0) $ do\n     emitCgStmt $ CgStmt $ CmmUnwind regs\n\nemitAssign :: CmmReg  -> CmmExpr -> FCode ()\nemitAssign l r = emitCgStmt (CgStmt (CmmAssign l r))\n\nemitStore :: CmmExpr  -> CmmExpr -> FCode ()\nemitStore l r = emitCgStmt (CgStmt (CmmStore l r))\n\nemit :: CmmAGraph -> FCode ()\nemit ag\n  = do  { state <- getState\n        ; setState $ state { cgs_stmts = cgs_stmts state MkGraph.<*> ag } }\n\nemitDecl :: CmmDecl -> FCode ()\nemitDecl decl\n  = do  { state <- getState\n        ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }\n\nemitOutOfLine :: BlockId -> CmmAGraphScoped -> FCode ()\nemitOutOfLine l (stmts, tscope) = emitCgStmt (CgFork l stmts tscope)\n\nemitProcWithStackFrame\n   :: Convention                        -- entry convention\n   -> Maybe CmmInfoTable                -- info table?\n   -> CLabel                            -- label for the proc\n   -> [CmmFormal]                       -- stack frame\n   -> [CmmFormal]                       -- arguments\n   -> CmmAGraphScoped                   -- code\n   -> Bool                              -- do stack layout?\n   -> FCode ()\n\nemitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False\n  = do  { dflags <- getDynFlags\n        ; emitProc_ mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False\n        }\nemitProcWithStackFrame conv mb_info lbl stk_args args (graph, tscope) True\n        -- do layout\n  = do  { dflags <- getDynFlags\n        ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args\n              graph' = entry MkGraph.<*> graph\n        ; emitProc_ mb_info lbl live (graph', tscope) offset True\n        }\nemitProcWithStackFrame _ _ _ _ _ _ _ = panic \"emitProcWithStackFrame\"\n\nemitProcWithConvention :: Convention -> Maybe CmmInfoTable -> CLabel\n                       -> [CmmFormal]\n                       -> CmmAGraphScoped\n                       -> FCode ()\nemitProcWithConvention conv mb_info lbl args blocks\n  = emitProcWithStackFrame conv mb_info lbl [] args blocks True\n\nemitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped\n         -> Int -> FCode ()\nemitProc  mb_info lbl live blocks offset\n = emitProc_ mb_info lbl live blocks offset True\n\nemitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped\n          -> Int -> Bool -> FCode ()\nemitProc_ mb_info lbl live blocks offset do_layout\n  = do  { dflags <- getDynFlags\n        ; l <- newBlockId\n        ; let\n              blks = labelAGraph l blocks\n\n              infos | Just info <- mb_info = mapSingleton (g_entry blks) info\n                    | otherwise            = mapEmpty\n\n              sinfo = StackInfo { arg_space = offset\n                                , updfr_space = Just (initUpdFrameOff dflags)\n                                , do_layout = do_layout }\n\n              tinfo = TopInfo { info_tbls = infos\n                              , stack_info=sinfo}\n\n              proc_block = CmmProc tinfo lbl live blks\n\n        ; state <- getState\n        ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }\n\ngetCmm :: FCode () -> FCode CmmGroup\n-- Get all the CmmTops (there should be no stmts)\n-- Return a single Cmm which may be split from other Cmms by\n-- object splitting (at a later stage)\ngetCmm code\n  = do  { state1 <- getState\n        ; ((), state2) <- withState code (state1 { cgs_tops  = nilOL })\n        ; setState $ state2 { cgs_tops = cgs_tops state1 }\n        ; return (fromOL (cgs_tops state2)) }\n\n\nmkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph\nmkCmmIfThenElse e tbranch fbranch = mkCmmIfThenElse' e tbranch fbranch Nothing\n\nmkCmmIfThenElse' :: CmmExpr -> CmmAGraph -> CmmAGraph\n                 -> Maybe Bool -> FCode CmmAGraph\nmkCmmIfThenElse' e tbranch fbranch likely = do\n  tscp  <- getTickScope\n  endif <- newBlockId\n  tid   <- newBlockId\n  fid   <- newBlockId\n\n  let\n    (test, then_, else_, likely') = case likely of\n      Just False | Just e' <- maybeInvertCmmExpr e\n        -- currently NCG doesn't know about likely\n        -- annotations. We manually switch then and\n        -- else branch so the likely false branch\n        -- becomes a fallthrough.\n        -> (e', fbranch, tbranch, Just True)\n      _ -> (e, tbranch, fbranch, likely)\n\n  return $ catAGraphs [ mkCbranch test tid fid likely'\n                      , mkLabel tid tscp, then_, mkBranch endif\n                      , mkLabel fid tscp, else_, mkLabel endif tscp ]\n\nmkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph\nmkCmmIfGoto e tid = mkCmmIfGoto' e tid Nothing\n\nmkCmmIfGoto' :: CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph\nmkCmmIfGoto' e tid l = do\n  endif <- newBlockId\n  tscp  <- getTickScope\n  return $ catAGraphs [ mkCbranch e tid endif l, mkLabel endif tscp ]\n\nmkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph\nmkCmmIfThen e tbranch = mkCmmIfThen' e tbranch Nothing\n\nmkCmmIfThen' :: CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph\nmkCmmIfThen' e tbranch l = do\n  endif <- newBlockId\n  tid   <- newBlockId\n  tscp  <- getTickScope\n  return $ catAGraphs [ mkCbranch e tid endif l\n                      , mkLabel tid tscp, tbranch, mkLabel endif tscp ]\n\nmkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmExpr]\n       -> UpdFrameOffset -> [CmmExpr] -> FCode CmmAGraph\nmkCall f (callConv, retConv) results actuals updfr_off extra_stack = do\n  dflags <- getDynFlags\n  k      <- newBlockId\n  tscp   <- getTickScope\n  let area = Young k\n      (off, _, copyin) = copyInOflow dflags retConv area results []\n      copyout = mkCallReturnsTo dflags f callConv actuals k off updfr_off extra_stack\n  return $ catAGraphs [copyout, mkLabel k tscp, copyin]\n\nmkCmmCall :: CmmExpr -> [CmmFormal] -> [CmmExpr] -> UpdFrameOffset\n          -> FCode CmmAGraph\nmkCmmCall f results actuals updfr_off\n   = mkCall f (NativeDirectCall, NativeReturn) results actuals updfr_off []\n\n\n-- ----------------------------------------------------------------------------\n-- turn CmmAGraph into CmmGraph, for making a new proc.\n\naGraphToGraph :: CmmAGraphScoped -> FCode CmmGraph\naGraphToGraph stmts\n  = do  { l <- newBlockId\n        ; return (labelAGraph l stmts) }\n", "num_lines": 867}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n-- emitPrimOp is quite large\n{-# OPTIONS_GHC -fmax-pmcheck-iterations=4000000 #-}\n\n----------------------------------------------------------------------------\n--\n-- Stg to C--: primitive operations\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmPrim (\n   cgOpApp,\n   cgPrimOp, -- internal(ish), used by cgCase to get code for a\n             -- comparison without also turning it into a Bool.\n   shouldInlinePrimOp\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude hiding ((<*>))\n\nimport StgCmmLayout\nimport StgCmmForeign\nimport StgCmmEnv\nimport StgCmmMonad\nimport StgCmmUtils\nimport StgCmmTicky\nimport StgCmmHeap\nimport StgCmmProf ( costCentreFrom )\n\nimport DynFlags\nimport Platform\nimport BasicTypes\nimport BlockId\nimport MkGraph\nimport StgSyn\nimport Cmm\nimport Type     ( Type, tyConAppTyCon )\nimport TyCon\nimport CLabel\nimport CmmUtils\nimport PrimOp\nimport SMRep\nimport FastString\nimport Outputable\nimport Util\n\nimport Data.Bits ((.&.), bit)\nimport Control.Monad (liftM, when, unless)\n\n------------------------------------------------------------------------\n--      Primitive operations and foreign calls\n------------------------------------------------------------------------\n\n{- Note [Foreign call results]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA foreign call always returns an unboxed tuple of results, one\nof which is the state token.  This seems to happen even for pure\ncalls.\n\nEven if we returned a single result for pure calls, it'd still be\nright to wrap it in a singleton unboxed tuple, because the result\nmight be a Haskell closure pointer, we don't want to evaluate it. -}\n\n----------------------------------\ncgOpApp :: StgOp        -- The op\n        -> [StgArg]     -- Arguments\n        -> Type         -- Result type (always an unboxed tuple)\n        -> FCode ReturnKind\n\n-- Foreign calls\ncgOpApp (StgFCallOp fcall _) stg_args res_ty\n  = cgForeignCall fcall stg_args res_ty\n      -- Note [Foreign call results]\n\n-- tagToEnum# is special: we need to pull the constructor\n-- out of the table, and perform an appropriate return.\n\ncgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty\n  = ASSERT(isEnumerationTyCon tycon)\n    do  { dflags <- getDynFlags\n        ; args' <- getNonVoidArgAmodes [arg]\n        ; let amode = case args' of [amode] -> amode\n                                    _ -> panic \"TagToEnumOp had void arg\"\n        ; emitReturn [tagToClosure dflags tycon amode] }\n   where\n          -- If you're reading this code in the attempt to figure\n          -- out why the compiler panic'ed here, it is probably because\n          -- you used tagToEnum# in a non-monomorphic setting, e.g.,\n          --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#\n          -- That won't work.\n        tycon = tyConAppTyCon res_ty\n\ncgOpApp (StgPrimOp primop) args res_ty = do\n    dflags <- getDynFlags\n    cmm_args <- getNonVoidArgAmodes args\n    case shouldInlinePrimOp dflags primop cmm_args of\n        Nothing -> do  -- out-of-line\n          let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))\n          emitCall (NativeNodeCall, NativeReturn) fun cmm_args\n\n        Just f  -- inline\n          | ReturnsPrim VoidRep <- result_info\n          -> do f []\n                emitReturn []\n\n          | ReturnsPrim rep <- result_info\n          -> do dflags <- getDynFlags\n                res <- newTemp (primRepCmmType dflags rep)\n                f [res]\n                emitReturn [CmmReg (CmmLocal res)]\n\n          | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon\n          -> do (regs, _hints) <- newUnboxedTupleRegs res_ty\n                f regs\n                emitReturn (map (CmmReg . CmmLocal) regs)\n\n          | otherwise -> panic \"cgPrimop\"\n          where\n             result_info = getPrimOpResultInfo primop\n\ncgOpApp (StgPrimCallOp primcall) args _res_ty\n  = do  { cmm_args <- getNonVoidArgAmodes args\n        ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))\n        ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }\n\n-- | Interpret the argument as an unsigned value, assuming the value\n-- is given in two-complement form in the given width.\n--\n-- Example: @asUnsigned W64 (-1)@ is 18446744073709551615.\n--\n-- This function is used to work around the fact that many array\n-- primops take Int# arguments, but we interpret them as unsigned\n-- quantities in the code gen. This means that we have to be careful\n-- every time we work on e.g. a CmmInt literal that corresponds to the\n-- array size, as it might contain a negative Integer value if the\n-- user passed a value larger than 2^(wORD_SIZE_IN_BITS-1) as the Int#\n-- literal.\nasUnsigned :: Width -> Integer -> Integer\nasUnsigned w n = n .&. (bit (widthInBits w) - 1)\n\n-- TODO: Several primop implementations (e.g. 'doNewByteArrayOp') use\n--     ByteOff (or some other fixed width signed type) to represent\n--     array sizes or indices. This means that these will overflow for\n--     large enough sizes.\n\n-- | Decide whether an out-of-line primop should be replaced by an\n-- inline implementation. This might happen e.g. if there's enough\n-- static information, such as statically know arguments, to emit a\n-- more efficient implementation inline.\n--\n-- Returns 'Nothing' if this primop should use its out-of-line\n-- implementation (defined elsewhere) and 'Just' together with a code\n-- generating function that takes the output regs as arguments\n-- otherwise.\nshouldInlinePrimOp :: DynFlags\n                   -> PrimOp     -- ^ The primop\n                   -> [CmmExpr]  -- ^ The primop arguments\n                   -> Maybe ([LocalReg] -> FCode ())\n\nshouldInlinePrimOp dflags NewByteArrayOp_Char [(CmmLit (CmmInt n w))]\n  | asUnsigned w n <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> doNewByteArrayOp res (fromInteger n)\n\nshouldInlinePrimOp dflags NewArrayOp [(CmmLit (CmmInt n w)), init]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] ->\n      doNewArrayOp res (arrPtrsRep dflags (fromInteger n)) mkMAP_DIRTY_infoLabel\n      [ (mkIntExpr dflags (fromInteger n),\n         fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags)\n      , (mkIntExpr dflags (nonHdrSizeW (arrPtrsRep dflags (fromInteger n))),\n         fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags)\n      ]\n      (fromInteger n) init\n\nshouldInlinePrimOp _ CopyArrayOp\n    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =\n        Just $ \\ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)\n\nshouldInlinePrimOp _ CopyMutableArrayOp\n    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =\n        Just $ \\ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)\n\nshouldInlinePrimOp _ CopyArrayArrayOp\n    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =\n        Just $ \\ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)\n\nshouldInlinePrimOp _ CopyMutableArrayArrayOp\n    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =\n        Just $ \\ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)\n\nshouldInlinePrimOp dflags CloneArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags CloneMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags FreezeArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags ThawArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags NewSmallArrayOp [(CmmLit (CmmInt n w)), init]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] ->\n      doNewArrayOp res (smallArrPtrsRep (fromInteger n)) mkSMAP_DIRTY_infoLabel\n      [ (mkIntExpr dflags (fromInteger n),\n         fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags)\n      ]\n      (fromInteger n) init\n\nshouldInlinePrimOp _ CopySmallArrayOp\n    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =\n        Just $ \\ [] -> doCopySmallArrayOp src src_off dst dst_off (fromInteger n)\n\nshouldInlinePrimOp _ CopySmallMutableArrayOp\n    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =\n        Just $ \\ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n)\n\nshouldInlinePrimOp dflags CloneSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags CloneSmallMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags FreezeSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags ThawSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]\n  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =\n      Just $ \\ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)\n\nshouldInlinePrimOp dflags primop args\n  | primOpOutOfLine primop = Nothing\n  | otherwise = Just $ \\ regs -> emitPrimOp dflags regs primop args\n\n-- TODO: Several primops, such as 'copyArray#', only have an inline\n-- implementation (below) but could possibly have both an inline\n-- implementation and an out-of-line implementation, just like\n-- 'newArray#'. This would lower the amount of code generated,\n-- hopefully without a performance impact (needs to be measured).\n\n---------------------------------------------------\ncgPrimOp   :: [LocalReg]        -- where to put the results\n           -> PrimOp            -- the op\n           -> [StgArg]          -- arguments\n           -> FCode ()\n\ncgPrimOp results op args\n  = do dflags <- getDynFlags\n       arg_exprs <- getNonVoidArgAmodes args\n       emitPrimOp dflags results op arg_exprs\n\n\n------------------------------------------------------------------------\n--      Emitting code for a primop\n------------------------------------------------------------------------\n\nemitPrimOp :: DynFlags\n           -> [LocalReg]        -- where to put the results\n           -> PrimOp            -- the op\n           -> [CmmExpr]         -- arguments\n           -> FCode ()\n\n-- First we handle various awkward cases specially.  The remaining\n-- easy cases are then handled by translateOp, defined below.\n\nemitPrimOp _ [res] ParOp [arg]\n  =\n        -- for now, just implement this in a C function\n        -- later, we might want to inline it.\n    emitCCall\n        [(res,NoHint)]\n        (CmmLit (CmmLabel (mkForeignLabel (fsLit \"newSpark\") Nothing ForeignLabelInExternalPackage IsFunction)))\n        [(baseExpr, AddrHint), (arg,AddrHint)]\n\nemitPrimOp dflags [res] SparkOp [arg]\n  = do\n        -- returns the value of arg in res.  We're going to therefore\n        -- refer to arg twice (once to pass to newSpark(), and once to\n        -- assign to res), so put it in a temporary.\n        tmp <- assignTemp arg\n        tmp2 <- newTemp (bWord dflags)\n        emitCCall\n            [(tmp2,NoHint)]\n            (CmmLit (CmmLabel (mkForeignLabel (fsLit \"newSpark\") Nothing ForeignLabelInExternalPackage IsFunction)))\n            [(baseExpr, AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)]\n        emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp))\n\nemitPrimOp dflags [res] GetCCSOfOp [arg]\n  = emitAssign (CmmLocal res) val\n  where\n    val\n     | gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)\n     | otherwise                      = CmmLit (zeroCLit dflags)\n\nemitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg]\n   = emitAssign (CmmLocal res) cccsExpr\n\nemitPrimOp _ [res] MyThreadIdOp []\n   = emitAssign (CmmLocal res) currentTSOExpr\n\nemitPrimOp dflags [res] ReadMutVarOp [mutv]\n   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))\n\nemitPrimOp dflags res@[] WriteMutVarOp [mutv,var]\n   = do -- Without this write barrier, other CPUs may see this pointer before\n        -- the writes for the closure it points to have occurred.\n        emitPrimCall res MO_WriteBarrier []\n        emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var\n        emitCCall\n                [{-no results-}]\n                (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))\n                [(baseExpr, AddrHint), (mutv,AddrHint)]\n\n--  #define sizzeofByteArrayzh(r,a) \\\n--     r = ((StgArrBytes *)(a))->bytes\nemitPrimOp dflags [res] SizeofByteArrayOp [arg]\n   = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))\n\n--  #define sizzeofMutableByteArrayzh(r,a) \\\n--      r = ((StgArrBytes *)(a))->bytes\nemitPrimOp dflags [res] SizeofMutableByteArrayOp [arg]\n   = emitPrimOp dflags [res] SizeofByteArrayOp [arg]\n\n--  #define getSizzeofMutableByteArrayzh(r,a) \\\n--      r = ((StgArrBytes *)(a))->bytes\nemitPrimOp dflags [res] GetSizeofMutableByteArrayOp [arg]\n   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))\n\n\n--  #define touchzh(o)                  /* nothing */\nemitPrimOp _ res@[] TouchOp args@[_arg]\n   = do emitPrimCall res MO_Touch args\n\n--  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)\nemitPrimOp dflags [res] ByteArrayContents_Char [arg]\n   = emitAssign (CmmLocal res) (cmmOffsetB dflags arg (arrWordsHdrSize dflags))\n\n--  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)\nemitPrimOp dflags [res] StableNameToIntOp [arg]\n   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))\n\nemitPrimOp dflags [res] ReallyUnsafePtrEqualityOp [arg1,arg2]\n   = emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2])\n\n--  #define addrToHValuezh(r,a) r=(P_)a\nemitPrimOp _      [res] AddrToAnyOp [arg]\n   = emitAssign (CmmLocal res) arg\n\n--  #define hvalueToAddrzh(r, a) r=(W_)a\nemitPrimOp _      [res] AnyToAddrOp [arg]\n   = emitAssign (CmmLocal res) arg\n\n{- Freezing arrays-of-ptrs requires changing an info table, for the\n   benefit of the generational collector.  It needs to scavenge mutable\n   objects, even if they are in old space.  When they become immutable,\n   they can be removed from this scavenge list.  -}\n\n--  #define unsafeFreezzeArrayzh(r,a)\n--      {\n--        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_DIRTY_info);\n--        r = a;\n--      }\nemitPrimOp _      [res] UnsafeFreezeArrayOp [arg]\n   = emit $ catAGraphs\n   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),\n     mkAssign (CmmLocal res) arg ]\nemitPrimOp _      [res] UnsafeFreezeArrayArrayOp [arg]\n   = emit $ catAGraphs\n   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),\n     mkAssign (CmmLocal res) arg ]\nemitPrimOp _      [res] UnsafeFreezeSmallArrayOp [arg]\n   = emit $ catAGraphs\n   [ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN_DIRTY_infoLabel)),\n     mkAssign (CmmLocal res) arg ]\n\n--  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)\nemitPrimOp _      [res] UnsafeFreezeByteArrayOp [arg]\n   = emitAssign (CmmLocal res) arg\n\n-- Reading/writing pointer arrays\n\nemitPrimOp _      [res] ReadArrayOp  [obj,ix]    = doReadPtrArrayOp res obj ix\nemitPrimOp _      [res] IndexArrayOp [obj,ix]    = doReadPtrArrayOp res obj ix\nemitPrimOp _      []  WriteArrayOp [obj,ix,v]  = doWritePtrArrayOp obj ix v\n\nemitPrimOp _      [res] IndexArrayArrayOp_ByteArray         [obj,ix]   = doReadPtrArrayOp res obj ix\nemitPrimOp _      [res] IndexArrayArrayOp_ArrayArray        [obj,ix]   = doReadPtrArrayOp res obj ix\nemitPrimOp _      [res] ReadArrayArrayOp_ByteArray          [obj,ix]   = doReadPtrArrayOp res obj ix\nemitPrimOp _      [res] ReadArrayArrayOp_MutableByteArray   [obj,ix]   = doReadPtrArrayOp res obj ix\nemitPrimOp _      [res] ReadArrayArrayOp_ArrayArray         [obj,ix]   = doReadPtrArrayOp res obj ix\nemitPrimOp _      [res] ReadArrayArrayOp_MutableArrayArray  [obj,ix]   = doReadPtrArrayOp res obj ix\nemitPrimOp _      []  WriteArrayArrayOp_ByteArray         [obj,ix,v] = doWritePtrArrayOp obj ix v\nemitPrimOp _      []  WriteArrayArrayOp_MutableByteArray  [obj,ix,v] = doWritePtrArrayOp obj ix v\nemitPrimOp _      []  WriteArrayArrayOp_ArrayArray        [obj,ix,v] = doWritePtrArrayOp obj ix v\nemitPrimOp _      []  WriteArrayArrayOp_MutableArrayArray [obj,ix,v] = doWritePtrArrayOp obj ix v\n\nemitPrimOp _      [res] ReadSmallArrayOp  [obj,ix] = doReadSmallPtrArrayOp res obj ix\nemitPrimOp _      [res] IndexSmallArrayOp [obj,ix] = doReadSmallPtrArrayOp res obj ix\nemitPrimOp _      []  WriteSmallArrayOp [obj,ix,v] = doWriteSmallPtrArrayOp obj ix v\n\n-- Getting the size of pointer arrays\n\nemitPrimOp dflags [res] SizeofArrayOp [arg]\n   = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg\n    (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgMutArrPtrs_ptrs dflags))\n        (bWord dflags))\nemitPrimOp dflags [res] SizeofMutableArrayOp [arg]\n   = emitPrimOp dflags [res] SizeofArrayOp [arg]\nemitPrimOp dflags [res] SizeofArrayArrayOp [arg]\n   = emitPrimOp dflags [res] SizeofArrayOp [arg]\nemitPrimOp dflags [res] SizeofMutableArrayArrayOp [arg]\n   = emitPrimOp dflags [res] SizeofArrayOp [arg]\n\nemitPrimOp dflags [res] SizeofSmallArrayOp [arg] =\n    emit $ mkAssign (CmmLocal res)\n    (cmmLoadIndexW dflags arg\n     (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgSmallMutArrPtrs_ptrs dflags))\n        (bWord dflags))\nemitPrimOp dflags [res] SizeofSmallMutableArrayOp [arg] =\n    emitPrimOp dflags [res] SizeofSmallArrayOp [arg]\n\n-- IndexXXXoffAddr\n\nemitPrimOp dflags res IndexOffAddrOp_Char             args = doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8 res args\nemitPrimOp dflags res IndexOffAddrOp_WideChar         args = doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args\nemitPrimOp dflags res IndexOffAddrOp_Int              args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res IndexOffAddrOp_Word             args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res IndexOffAddrOp_Addr             args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp _      res IndexOffAddrOp_Float            args = doIndexOffAddrOp   Nothing f32 res args\nemitPrimOp _      res IndexOffAddrOp_Double           args = doIndexOffAddrOp   Nothing f64 res args\nemitPrimOp dflags res IndexOffAddrOp_StablePtr        args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res IndexOffAddrOp_Int8             args = doIndexOffAddrOp   (Just (mo_s_8ToWord dflags)) b8  res args\nemitPrimOp dflags res IndexOffAddrOp_Int16            args = doIndexOffAddrOp   (Just (mo_s_16ToWord dflags)) b16 res args\nemitPrimOp dflags res IndexOffAddrOp_Int32            args = doIndexOffAddrOp   (Just (mo_s_32ToWord dflags)) b32 res args\nemitPrimOp _      res IndexOffAddrOp_Int64            args = doIndexOffAddrOp   Nothing b64 res args\nemitPrimOp dflags res IndexOffAddrOp_Word8            args = doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8  res args\nemitPrimOp dflags res IndexOffAddrOp_Word16           args = doIndexOffAddrOp   (Just (mo_u_16ToWord dflags)) b16 res args\nemitPrimOp dflags res IndexOffAddrOp_Word32           args = doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args\nemitPrimOp _      res IndexOffAddrOp_Word64           args = doIndexOffAddrOp   Nothing b64 res args\n\n-- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.\n\nemitPrimOp dflags res ReadOffAddrOp_Char             args = doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8 res args\nemitPrimOp dflags res ReadOffAddrOp_WideChar         args = doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args\nemitPrimOp dflags res ReadOffAddrOp_Int              args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res ReadOffAddrOp_Word             args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res ReadOffAddrOp_Addr             args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp _      res ReadOffAddrOp_Float            args = doIndexOffAddrOp   Nothing f32 res args\nemitPrimOp _      res ReadOffAddrOp_Double           args = doIndexOffAddrOp   Nothing f64 res args\nemitPrimOp dflags res ReadOffAddrOp_StablePtr        args = doIndexOffAddrOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res ReadOffAddrOp_Int8             args = doIndexOffAddrOp   (Just (mo_s_8ToWord dflags)) b8  res args\nemitPrimOp dflags res ReadOffAddrOp_Int16            args = doIndexOffAddrOp   (Just (mo_s_16ToWord dflags)) b16 res args\nemitPrimOp dflags res ReadOffAddrOp_Int32            args = doIndexOffAddrOp   (Just (mo_s_32ToWord dflags)) b32 res args\nemitPrimOp _      res ReadOffAddrOp_Int64            args = doIndexOffAddrOp   Nothing b64 res args\nemitPrimOp dflags res ReadOffAddrOp_Word8            args = doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8  res args\nemitPrimOp dflags res ReadOffAddrOp_Word16           args = doIndexOffAddrOp   (Just (mo_u_16ToWord dflags)) b16 res args\nemitPrimOp dflags res ReadOffAddrOp_Word32           args = doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args\nemitPrimOp _      res ReadOffAddrOp_Word64           args = doIndexOffAddrOp   Nothing b64 res args\n\n-- IndexXXXArray\n\nemitPrimOp dflags res IndexByteArrayOp_Char             args = doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8 res args\nemitPrimOp dflags res IndexByteArrayOp_WideChar         args = doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32 res args\nemitPrimOp dflags res IndexByteArrayOp_Int              args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res IndexByteArrayOp_Word             args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res IndexByteArrayOp_Addr             args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp _      res IndexByteArrayOp_Float            args = doIndexByteArrayOp   Nothing f32 res args\nemitPrimOp _      res IndexByteArrayOp_Double           args = doIndexByteArrayOp   Nothing f64 res args\nemitPrimOp dflags res IndexByteArrayOp_StablePtr        args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res IndexByteArrayOp_Int8             args = doIndexByteArrayOp   (Just (mo_s_8ToWord dflags)) b8  res args\nemitPrimOp dflags res IndexByteArrayOp_Int16            args = doIndexByteArrayOp   (Just (mo_s_16ToWord dflags)) b16  res args\nemitPrimOp dflags res IndexByteArrayOp_Int32            args = doIndexByteArrayOp   (Just (mo_s_32ToWord dflags)) b32  res args\nemitPrimOp _      res IndexByteArrayOp_Int64            args = doIndexByteArrayOp   Nothing b64  res args\nemitPrimOp dflags res IndexByteArrayOp_Word8            args = doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8  res args\nemitPrimOp dflags res IndexByteArrayOp_Word16           args = doIndexByteArrayOp   (Just (mo_u_16ToWord dflags)) b16  res args\nemitPrimOp dflags res IndexByteArrayOp_Word32           args = doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32  res args\nemitPrimOp _      res IndexByteArrayOp_Word64           args = doIndexByteArrayOp   Nothing b64  res args\n\n-- ReadXXXArray, identical to IndexXXXArray.\n\nemitPrimOp dflags res ReadByteArrayOp_Char             args = doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8 res args\nemitPrimOp dflags res ReadByteArrayOp_WideChar         args = doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32 res args\nemitPrimOp dflags res ReadByteArrayOp_Int              args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res ReadByteArrayOp_Word             args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res ReadByteArrayOp_Addr             args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp _      res ReadByteArrayOp_Float            args = doIndexByteArrayOp   Nothing f32 res args\nemitPrimOp _      res ReadByteArrayOp_Double           args = doIndexByteArrayOp   Nothing f64 res args\nemitPrimOp dflags res ReadByteArrayOp_StablePtr        args = doIndexByteArrayOp   Nothing (bWord dflags) res args\nemitPrimOp dflags res ReadByteArrayOp_Int8             args = doIndexByteArrayOp   (Just (mo_s_8ToWord dflags)) b8  res args\nemitPrimOp dflags res ReadByteArrayOp_Int16            args = doIndexByteArrayOp   (Just (mo_s_16ToWord dflags)) b16  res args\nemitPrimOp dflags res ReadByteArrayOp_Int32            args = doIndexByteArrayOp   (Just (mo_s_32ToWord dflags)) b32  res args\nemitPrimOp _      res ReadByteArrayOp_Int64            args = doIndexByteArrayOp   Nothing b64  res args\nemitPrimOp dflags res ReadByteArrayOp_Word8            args = doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8  res args\nemitPrimOp dflags res ReadByteArrayOp_Word16           args = doIndexByteArrayOp   (Just (mo_u_16ToWord dflags)) b16  res args\nemitPrimOp dflags res ReadByteArrayOp_Word32           args = doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32  res args\nemitPrimOp _      res ReadByteArrayOp_Word64           args = doIndexByteArrayOp   Nothing b64  res args\n\n-- IndexWord8ArrayAsXXX\n\nemitPrimOp dflags res IndexByteArrayOp_Word8AsChar      args = doIndexByteArrayOpAs   (Just (mo_u_8ToWord dflags)) b8 b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsWideChar  args = doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsInt       args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsWord      args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsAddr      args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp _      res IndexByteArrayOp_Word8AsFloat     args = doIndexByteArrayOpAs   Nothing f32 b8 res args\nemitPrimOp _      res IndexByteArrayOp_Word8AsDouble    args = doIndexByteArrayOpAs   Nothing f64 b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsStablePtr args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsInt16     args = doIndexByteArrayOpAs   (Just (mo_s_16ToWord dflags)) b16 b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsInt32     args = doIndexByteArrayOpAs   (Just (mo_s_32ToWord dflags)) b32 b8 res args\nemitPrimOp _      res IndexByteArrayOp_Word8AsInt64     args = doIndexByteArrayOpAs   Nothing b64 b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsWord16    args = doIndexByteArrayOpAs   (Just (mo_u_16ToWord dflags)) b16 b8 res args\nemitPrimOp dflags res IndexByteArrayOp_Word8AsWord32    args = doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args\nemitPrimOp _      res IndexByteArrayOp_Word8AsWord64    args = doIndexByteArrayOpAs   Nothing b64 b8 res args\n\n-- ReadInt8ArrayAsXXX, identical to IndexInt8ArrayAsXXX\n\nemitPrimOp dflags res ReadByteArrayOp_Word8AsChar      args = doIndexByteArrayOpAs   (Just (mo_u_8ToWord dflags)) b8 b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsWideChar  args = doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsInt       args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsWord      args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsAddr      args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp _      res ReadByteArrayOp_Word8AsFloat     args = doIndexByteArrayOpAs   Nothing f32 b8 res args\nemitPrimOp _      res ReadByteArrayOp_Word8AsDouble    args = doIndexByteArrayOpAs   Nothing f64 b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsStablePtr args = doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsInt16     args = doIndexByteArrayOpAs   (Just (mo_s_16ToWord dflags)) b16 b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsInt32     args = doIndexByteArrayOpAs   (Just (mo_s_32ToWord dflags)) b32 b8 res args\nemitPrimOp _      res ReadByteArrayOp_Word8AsInt64     args = doIndexByteArrayOpAs   Nothing b64 b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsWord16    args = doIndexByteArrayOpAs   (Just (mo_u_16ToWord dflags)) b16 b8 res args\nemitPrimOp dflags res ReadByteArrayOp_Word8AsWord32    args = doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args\nemitPrimOp _      res ReadByteArrayOp_Word8AsWord64    args = doIndexByteArrayOpAs   Nothing b64 b8 res args\n\n-- WriteXXXoffAddr\n\nemitPrimOp dflags res WriteOffAddrOp_Char             args = doWriteOffAddrOp (Just (mo_WordTo8 dflags))  b8 res args\nemitPrimOp dflags res WriteOffAddrOp_WideChar         args = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args\nemitPrimOp dflags res WriteOffAddrOp_Int              args = doWriteOffAddrOp Nothing (bWord dflags) res args\nemitPrimOp dflags res WriteOffAddrOp_Word             args = doWriteOffAddrOp Nothing (bWord dflags) res args\nemitPrimOp dflags res WriteOffAddrOp_Addr             args = doWriteOffAddrOp Nothing (bWord dflags) res args\nemitPrimOp _      res WriteOffAddrOp_Float            args = doWriteOffAddrOp Nothing f32 res args\nemitPrimOp _      res WriteOffAddrOp_Double           args = doWriteOffAddrOp Nothing f64 res args\nemitPrimOp dflags res WriteOffAddrOp_StablePtr        args = doWriteOffAddrOp Nothing (bWord dflags) res args\nemitPrimOp dflags res WriteOffAddrOp_Int8             args = doWriteOffAddrOp (Just (mo_WordTo8 dflags))  b8 res args\nemitPrimOp dflags res WriteOffAddrOp_Int16            args = doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args\nemitPrimOp dflags res WriteOffAddrOp_Int32            args = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args\nemitPrimOp _      res WriteOffAddrOp_Int64            args = doWriteOffAddrOp Nothing b64 res args\nemitPrimOp dflags res WriteOffAddrOp_Word8            args = doWriteOffAddrOp (Just (mo_WordTo8 dflags))  b8 res args\nemitPrimOp dflags res WriteOffAddrOp_Word16           args = doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args\nemitPrimOp dflags res WriteOffAddrOp_Word32           args = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args\nemitPrimOp _      res WriteOffAddrOp_Word64           args = doWriteOffAddrOp Nothing b64 res args\n\n-- WriteXXXArray\n\nemitPrimOp dflags res WriteByteArrayOp_Char             args = doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8 res args\nemitPrimOp dflags res WriteByteArrayOp_WideChar         args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args\nemitPrimOp dflags res WriteByteArrayOp_Int              args = doWriteByteArrayOp Nothing (bWord dflags) res args\nemitPrimOp dflags res WriteByteArrayOp_Word             args = doWriteByteArrayOp Nothing (bWord dflags) res args\nemitPrimOp dflags res WriteByteArrayOp_Addr             args = doWriteByteArrayOp Nothing (bWord dflags) res args\nemitPrimOp _      res WriteByteArrayOp_Float            args = doWriteByteArrayOp Nothing f32 res args\nemitPrimOp _      res WriteByteArrayOp_Double           args = doWriteByteArrayOp Nothing f64 res args\nemitPrimOp dflags res WriteByteArrayOp_StablePtr        args = doWriteByteArrayOp Nothing (bWord dflags) res args\nemitPrimOp dflags res WriteByteArrayOp_Int8             args = doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8 res args\nemitPrimOp dflags res WriteByteArrayOp_Int16            args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16 res args\nemitPrimOp dflags res WriteByteArrayOp_Int32            args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args\nemitPrimOp _      res WriteByteArrayOp_Int64            args = doWriteByteArrayOp Nothing b64 res args\nemitPrimOp dflags res WriteByteArrayOp_Word8            args = doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8  res args\nemitPrimOp dflags res WriteByteArrayOp_Word16           args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16 res args\nemitPrimOp dflags res WriteByteArrayOp_Word32           args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args\nemitPrimOp _      res WriteByteArrayOp_Word64           args = doWriteByteArrayOp Nothing b64 res args\n\n-- WriteInt8ArrayAsXXX\n\nemitPrimOp dflags res WriteByteArrayOp_Word8AsChar       args = doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8 res args\nemitPrimOp dflags res WriteByteArrayOp_Word8AsWideChar   args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsInt        args = doWriteByteArrayOp Nothing b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsWord       args = doWriteByteArrayOp Nothing b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsAddr       args = doWriteByteArrayOp Nothing b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsFloat      args = doWriteByteArrayOp Nothing b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsDouble     args = doWriteByteArrayOp Nothing b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsStablePtr  args = doWriteByteArrayOp Nothing b8 res args\nemitPrimOp dflags res WriteByteArrayOp_Word8AsInt16      args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args\nemitPrimOp dflags res WriteByteArrayOp_Word8AsInt32      args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsInt64      args = doWriteByteArrayOp Nothing b8 res args\nemitPrimOp dflags res WriteByteArrayOp_Word8AsWord16     args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args\nemitPrimOp dflags res WriteByteArrayOp_Word8AsWord32     args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args\nemitPrimOp _      res WriteByteArrayOp_Word8AsWord64     args = doWriteByteArrayOp Nothing b8 res args\n\n-- Copying and setting byte arrays\nemitPrimOp _      [] CopyByteArrayOp [src,src_off,dst,dst_off,n] =\n    doCopyByteArrayOp src src_off dst dst_off n\nemitPrimOp _      [] CopyMutableByteArrayOp [src,src_off,dst,dst_off,n] =\n    doCopyMutableByteArrayOp src src_off dst dst_off n\nemitPrimOp _      [] CopyByteArrayToAddrOp [src,src_off,dst,n] =\n    doCopyByteArrayToAddrOp src src_off dst n\nemitPrimOp _      [] CopyMutableByteArrayToAddrOp [src,src_off,dst,n] =\n    doCopyMutableByteArrayToAddrOp src src_off dst n\nemitPrimOp _      [] CopyAddrToByteArrayOp [src,dst,dst_off,n] =\n    doCopyAddrToByteArrayOp src dst dst_off n\nemitPrimOp _      [] SetByteArrayOp [ba,off,len,c] =\n    doSetByteArrayOp ba off len c\n\n-- Comparing byte arrays\nemitPrimOp _      [res] CompareByteArraysOp [ba1,ba1_off,ba2,ba2_off,n] =\n    doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n\n\nemitPrimOp _      [res] BSwap16Op [w] = emitBSwapCall res w W16\nemitPrimOp _      [res] BSwap32Op [w] = emitBSwapCall res w W32\nemitPrimOp _      [res] BSwap64Op [w] = emitBSwapCall res w W64\nemitPrimOp dflags [res] BSwapOp   [w] = emitBSwapCall res w (wordWidth dflags)\n\n-- Population count\nemitPrimOp _      [res] PopCnt8Op  [w] = emitPopCntCall res w W8\nemitPrimOp _      [res] PopCnt16Op [w] = emitPopCntCall res w W16\nemitPrimOp _      [res] PopCnt32Op [w] = emitPopCntCall res w W32\nemitPrimOp _      [res] PopCnt64Op [w] = emitPopCntCall res w W64\nemitPrimOp dflags [res] PopCntOp   [w] = emitPopCntCall res w (wordWidth dflags)\n\n-- Parallel bit deposit\nemitPrimOp _      [res] Pdep8Op  [src, mask] = emitPdepCall res src mask W8\nemitPrimOp _      [res] Pdep16Op [src, mask] = emitPdepCall res src mask W16\nemitPrimOp _      [res] Pdep32Op [src, mask] = emitPdepCall res src mask W32\nemitPrimOp _      [res] Pdep64Op [src, mask] = emitPdepCall res src mask W64\nemitPrimOp dflags [res] PdepOp   [src, mask] = emitPdepCall res src mask (wordWidth dflags)\n\n-- Parallel bit extract\nemitPrimOp _      [res] Pext8Op  [src, mask] = emitPextCall res src mask W8\nemitPrimOp _      [res] Pext16Op [src, mask] = emitPextCall res src mask W16\nemitPrimOp _      [res] Pext32Op [src, mask] = emitPextCall res src mask W32\nemitPrimOp _      [res] Pext64Op [src, mask] = emitPextCall res src mask W64\nemitPrimOp dflags [res] PextOp   [src, mask] = emitPextCall res src mask (wordWidth dflags)\n\n-- count leading zeros\nemitPrimOp _      [res] Clz8Op  [w] = emitClzCall res w W8\nemitPrimOp _      [res] Clz16Op [w] = emitClzCall res w W16\nemitPrimOp _      [res] Clz32Op [w] = emitClzCall res w W32\nemitPrimOp _      [res] Clz64Op [w] = emitClzCall res w W64\nemitPrimOp dflags [res] ClzOp   [w] = emitClzCall res w (wordWidth dflags)\n\n-- count trailing zeros\nemitPrimOp _      [res] Ctz8Op [w]  = emitCtzCall res w W8\nemitPrimOp _      [res] Ctz16Op [w] = emitCtzCall res w W16\nemitPrimOp _      [res] Ctz32Op [w] = emitCtzCall res w W32\nemitPrimOp _      [res] Ctz64Op [w] = emitCtzCall res w W64\nemitPrimOp dflags [res] CtzOp   [w] = emitCtzCall res w (wordWidth dflags)\n\n-- Unsigned int to floating point conversions\nemitPrimOp _      [res] Word2FloatOp  [w] = emitPrimCall [res]\n                                            (MO_UF_Conv W32) [w]\nemitPrimOp _      [res] Word2DoubleOp [w] = emitPrimCall [res]\n                                            (MO_UF_Conv W64) [w]\n\n-- SIMD primops\nemitPrimOp dflags [res] (VecBroadcastOp vcat n w) [e] = do\n    checkVecCompatibility dflags vcat n w\n    doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros (replicate n e) res\n  where\n    zeros :: CmmExpr\n    zeros = CmmLit $ CmmVec (replicate n zero)\n\n    zero :: CmmLit\n    zero = case vcat of\n             IntVec   -> CmmInt 0 w\n             WordVec  -> CmmInt 0 w\n             FloatVec -> CmmFloat 0 w\n\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags [res] (VecPackOp vcat n w) es = do\n    checkVecCompatibility dflags vcat n w\n    when (es `lengthIsNot` n) $\n        panic \"emitPrimOp: VecPackOp has wrong number of arguments\"\n    doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros es res\n  where\n    zeros :: CmmExpr\n    zeros = CmmLit $ CmmVec (replicate n zero)\n\n    zero :: CmmLit\n    zero = case vcat of\n             IntVec   -> CmmInt 0 w\n             WordVec  -> CmmInt 0 w\n             FloatVec -> CmmFloat 0 w\n\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecUnpackOp vcat n w) [arg] = do\n    checkVecCompatibility dflags vcat n w\n    when (res `lengthIsNot` n) $\n        panic \"emitPrimOp: VecUnpackOp has wrong number of results\"\n    doVecUnpackOp (vecElemProjectCast dflags vcat w) ty arg res\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags [res] (VecInsertOp vcat n w) [v,e,i] = do\n    checkVecCompatibility dflags vcat n w\n    doVecInsertOp (vecElemInjectCast dflags vcat w) ty v e i res\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecIndexByteArrayOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexByteArrayOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecReadByteArrayOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexByteArrayOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecWriteByteArrayOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doWriteByteArrayOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecIndexOffAddrOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexOffAddrOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecReadOffAddrOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexOffAddrOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecWriteOffAddrOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doWriteOffAddrOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecVmmType vcat n w\n\nemitPrimOp dflags res (VecIndexScalarByteArrayOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexByteArrayOpAs Nothing vecty ty res args\n  where\n    vecty :: CmmType\n    vecty = vecVmmType vcat n w\n\n    ty :: CmmType\n    ty = vecCmmCat vcat w\n\nemitPrimOp dflags res (VecReadScalarByteArrayOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexByteArrayOpAs Nothing vecty ty res args\n  where\n    vecty :: CmmType\n    vecty = vecVmmType vcat n w\n\n    ty :: CmmType\n    ty = vecCmmCat vcat w\n\nemitPrimOp dflags res (VecWriteScalarByteArrayOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doWriteByteArrayOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecCmmCat vcat w\n\nemitPrimOp dflags res (VecIndexScalarOffAddrOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexOffAddrOpAs Nothing vecty ty res args\n  where\n    vecty :: CmmType\n    vecty = vecVmmType vcat n w\n\n    ty :: CmmType\n    ty = vecCmmCat vcat w\n\nemitPrimOp dflags res (VecReadScalarOffAddrOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doIndexOffAddrOpAs Nothing vecty ty res args\n  where\n    vecty :: CmmType\n    vecty = vecVmmType vcat n w\n\n    ty :: CmmType\n    ty = vecCmmCat vcat w\n\nemitPrimOp dflags res (VecWriteScalarOffAddrOp vcat n w) args = do\n    checkVecCompatibility dflags vcat n w\n    doWriteOffAddrOp Nothing ty res args\n  where\n    ty :: CmmType\n    ty = vecCmmCat vcat w\n\n-- Prefetch\nemitPrimOp _ [] PrefetchByteArrayOp3        args = doPrefetchByteArrayOp 3  args\nemitPrimOp _ [] PrefetchMutableByteArrayOp3 args = doPrefetchMutableByteArrayOp 3  args\nemitPrimOp _ [] PrefetchAddrOp3             args = doPrefetchAddrOp  3  args\nemitPrimOp _ [] PrefetchValueOp3            args = doPrefetchValueOp 3 args\n\nemitPrimOp _ [] PrefetchByteArrayOp2        args = doPrefetchByteArrayOp 2  args\nemitPrimOp _ [] PrefetchMutableByteArrayOp2 args = doPrefetchMutableByteArrayOp 2  args\nemitPrimOp _ [] PrefetchAddrOp2             args = doPrefetchAddrOp 2  args\nemitPrimOp _ [] PrefetchValueOp2           args = doPrefetchValueOp 2 args\n\nemitPrimOp _ [] PrefetchByteArrayOp1        args = doPrefetchByteArrayOp 1  args\nemitPrimOp _ [] PrefetchMutableByteArrayOp1 args = doPrefetchMutableByteArrayOp 1  args\nemitPrimOp _ [] PrefetchAddrOp1             args = doPrefetchAddrOp 1  args\nemitPrimOp _ [] PrefetchValueOp1            args = doPrefetchValueOp 1 args\n\nemitPrimOp _ [] PrefetchByteArrayOp0        args = doPrefetchByteArrayOp 0  args\nemitPrimOp _ [] PrefetchMutableByteArrayOp0 args = doPrefetchMutableByteArrayOp 0  args\nemitPrimOp _ [] PrefetchAddrOp0             args = doPrefetchAddrOp 0  args\nemitPrimOp _ [] PrefetchValueOp0            args = doPrefetchValueOp 0 args\n\n-- Atomic read-modify-write\nemitPrimOp dflags [res] FetchAddByteArrayOp_Int [mba, ix, n] =\n    doAtomicRMW res AMO_Add mba ix (bWord dflags) n\nemitPrimOp dflags [res] FetchSubByteArrayOp_Int [mba, ix, n] =\n    doAtomicRMW res AMO_Sub mba ix (bWord dflags) n\nemitPrimOp dflags [res] FetchAndByteArrayOp_Int [mba, ix, n] =\n    doAtomicRMW res AMO_And mba ix (bWord dflags) n\nemitPrimOp dflags [res] FetchNandByteArrayOp_Int [mba, ix, n] =\n    doAtomicRMW res AMO_Nand mba ix (bWord dflags) n\nemitPrimOp dflags [res] FetchOrByteArrayOp_Int [mba, ix, n] =\n    doAtomicRMW res AMO_Or mba ix (bWord dflags) n\nemitPrimOp dflags [res] FetchXorByteArrayOp_Int [mba, ix, n] =\n    doAtomicRMW res AMO_Xor mba ix (bWord dflags) n\nemitPrimOp dflags [res] AtomicReadByteArrayOp_Int [mba, ix] =\n    doAtomicReadByteArray res mba ix (bWord dflags)\nemitPrimOp dflags [] AtomicWriteByteArrayOp_Int [mba, ix, val] =\n    doAtomicWriteByteArray mba ix (bWord dflags) val\nemitPrimOp dflags [res] CasByteArrayOp_Int [mba, ix, old, new] =\n    doCasByteArray res mba ix (bWord dflags) old new\n\n-- The rest just translate straightforwardly\nemitPrimOp dflags [res] op [arg]\n   | nopOp op\n   = emitAssign (CmmLocal res) arg\n\n   | Just (mop,rep) <- narrowOp op\n   = emitAssign (CmmLocal res) $\n           CmmMachOp (mop rep (wordWidth dflags)) [CmmMachOp (mop (wordWidth dflags) rep) [arg]]\n\nemitPrimOp dflags r@[res] op args\n   | Just prim <- callishOp op\n   = do emitPrimCall r prim args\n\n   | Just mop <- translateOp dflags op\n   = let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in\n     emit stmt\n\nemitPrimOp dflags results op args\n   = case callishPrimOpSupported dflags op of\n          Left op   -> emit $ mkUnsafeCall (PrimTarget op) results args\n          Right gen -> gen results args\n\ntype GenericOp = [CmmFormal] -> [CmmActual] -> FCode ()\n\ncallishPrimOpSupported :: DynFlags -> PrimOp -> Either CallishMachOp GenericOp\ncallishPrimOpSupported dflags op\n  = case op of\n      IntQuotRemOp   | ncg && (x86ish || ppc) ->\n                         Left (MO_S_QuotRem  (wordWidth dflags))\n                     | otherwise              ->\n                         Right (genericIntQuotRemOp (wordWidth dflags))\n\n      Int8QuotRemOp  | ncg && (x86ish || ppc)\n                                     -> Left (MO_S_QuotRem W8)\n                     | otherwise     -> Right (genericIntQuotRemOp W8)\n\n      Int16QuotRemOp | ncg && (x86ish || ppc)\n                                     -> Left (MO_S_QuotRem W16)\n                     | otherwise     -> Right (genericIntQuotRemOp W16)\n\n\n      WordQuotRemOp  | ncg && (x86ish || ppc) ->\n                         Left (MO_U_QuotRem  (wordWidth dflags))\n                     | otherwise      ->\n                         Right (genericWordQuotRemOp (wordWidth dflags))\n\n      WordQuotRem2Op | (ncg && (x86ish || ppc))\n                          || llvm     -> Left (MO_U_QuotRem2 (wordWidth dflags))\n                     | otherwise      -> Right (genericWordQuotRem2Op dflags)\n\n      Word8QuotRemOp | ncg && (x86ish || ppc)\n                                      -> Left (MO_U_QuotRem W8)\n                     | otherwise      -> Right (genericWordQuotRemOp W8)\n\n      Word16QuotRemOp| ncg && (x86ish || ppc)\n                                     -> Left (MO_U_QuotRem W16)\n                     | otherwise     -> Right (genericWordQuotRemOp W16)\n\n      WordAdd2Op     | (ncg && (x86ish || ppc))\n                         || llvm      -> Left (MO_Add2       (wordWidth dflags))\n                     | otherwise      -> Right genericWordAdd2Op\n\n      WordAddCOp     | (ncg && (x86ish || ppc))\n                         || llvm      -> Left (MO_AddWordC   (wordWidth dflags))\n                     | otherwise      -> Right genericWordAddCOp\n\n      WordSubCOp     | (ncg && (x86ish || ppc))\n                         || llvm      -> Left (MO_SubWordC   (wordWidth dflags))\n                     | otherwise      -> Right genericWordSubCOp\n\n      IntAddCOp      | (ncg && (x86ish || ppc))\n                         || llvm      -> Left (MO_AddIntC    (wordWidth dflags))\n                     | otherwise      -> Right genericIntAddCOp\n\n      IntSubCOp      | (ncg && (x86ish || ppc))\n                         || llvm      -> Left (MO_SubIntC    (wordWidth dflags))\n                     | otherwise      -> Right genericIntSubCOp\n\n      WordMul2Op     | ncg && (x86ish || ppc)\n                         || llvm      -> Left (MO_U_Mul2     (wordWidth dflags))\n                     | otherwise      -> Right genericWordMul2Op\n      FloatFabsOp    | (ncg && x86ish || ppc)\n                         || llvm      -> Left MO_F32_Fabs\n                     | otherwise      -> Right $ genericFabsOp W32\n      DoubleFabsOp   | (ncg && x86ish || ppc)\n                         || llvm      -> Left MO_F64_Fabs\n                     | otherwise      -> Right $ genericFabsOp W64\n\n      _ -> pprPanic \"emitPrimOp: can't translate PrimOp \" (ppr op)\n where\n  ncg = case hscTarget dflags of\n           HscAsm -> True\n           _      -> False\n  llvm = case hscTarget dflags of\n           HscLlvm -> True\n           _       -> False\n  x86ish = case platformArch (targetPlatform dflags) of\n             ArchX86    -> True\n             ArchX86_64 -> True\n             _          -> False\n  ppc = case platformArch (targetPlatform dflags) of\n          ArchPPC      -> True\n          ArchPPC_64 _ -> True\n          _            -> False\n\ngenericIntQuotRemOp :: Width -> GenericOp\ngenericIntQuotRemOp width [res_q, res_r] [arg_x, arg_y]\n   = emit $ mkAssign (CmmLocal res_q)\n              (CmmMachOp (MO_S_Quot width) [arg_x, arg_y]) <*>\n            mkAssign (CmmLocal res_r)\n              (CmmMachOp (MO_S_Rem  width) [arg_x, arg_y])\ngenericIntQuotRemOp _ _ _ = panic \"genericIntQuotRemOp\"\n\ngenericWordQuotRemOp :: Width -> GenericOp\ngenericWordQuotRemOp width [res_q, res_r] [arg_x, arg_y]\n    = emit $ mkAssign (CmmLocal res_q)\n               (CmmMachOp (MO_U_Quot width) [arg_x, arg_y]) <*>\n             mkAssign (CmmLocal res_r)\n               (CmmMachOp (MO_U_Rem  width) [arg_x, arg_y])\ngenericWordQuotRemOp _ _ _ = panic \"genericWordQuotRemOp\"\n\ngenericWordQuotRem2Op :: DynFlags -> GenericOp\ngenericWordQuotRem2Op dflags [res_q, res_r] [arg_x_high, arg_x_low, arg_y]\n    = emit =<< f (widthInBits (wordWidth dflags)) zero arg_x_high arg_x_low\n    where    ty = cmmExprType dflags arg_x_high\n             shl   x i = CmmMachOp (MO_Shl   (wordWidth dflags)) [x, i]\n             shr   x i = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, i]\n             or    x y = CmmMachOp (MO_Or    (wordWidth dflags)) [x, y]\n             ge    x y = CmmMachOp (MO_U_Ge  (wordWidth dflags)) [x, y]\n             ne    x y = CmmMachOp (MO_Ne    (wordWidth dflags)) [x, y]\n             minus x y = CmmMachOp (MO_Sub   (wordWidth dflags)) [x, y]\n             times x y = CmmMachOp (MO_Mul   (wordWidth dflags)) [x, y]\n             zero   = lit 0\n             one    = lit 1\n             negone = lit (fromIntegral (widthInBits (wordWidth dflags)) - 1)\n             lit i = CmmLit (CmmInt i (wordWidth dflags))\n\n             f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode CmmAGraph\n             f 0 acc high _ = return (mkAssign (CmmLocal res_q) acc <*>\n                                      mkAssign (CmmLocal res_r) high)\n             f i acc high low =\n                 do roverflowedBit <- newTemp ty\n                    rhigh'         <- newTemp ty\n                    rhigh''        <- newTemp ty\n                    rlow'          <- newTemp ty\n                    risge          <- newTemp ty\n                    racc'          <- newTemp ty\n                    let high'         = CmmReg (CmmLocal rhigh')\n                        isge          = CmmReg (CmmLocal risge)\n                        overflowedBit = CmmReg (CmmLocal roverflowedBit)\n                    let this = catAGraphs\n                               [mkAssign (CmmLocal roverflowedBit)\n                                          (shr high negone),\n                                mkAssign (CmmLocal rhigh')\n                                          (or (shl high one) (shr low negone)),\n                                mkAssign (CmmLocal rlow')\n                                          (shl low one),\n                                mkAssign (CmmLocal risge)\n                                          (or (overflowedBit `ne` zero)\n                                              (high' `ge` arg_y)),\n                                mkAssign (CmmLocal rhigh'')\n                                          (high' `minus` (arg_y `times` isge)),\n                                mkAssign (CmmLocal racc')\n                                          (or (shl acc one) isge)]\n                    rest <- f (i - 1) (CmmReg (CmmLocal racc'))\n                                      (CmmReg (CmmLocal rhigh''))\n                                      (CmmReg (CmmLocal rlow'))\n                    return (this <*> rest)\ngenericWordQuotRem2Op _ _ _ = panic \"genericWordQuotRem2Op\"\n\ngenericWordAdd2Op :: GenericOp\ngenericWordAdd2Op [res_h, res_l] [arg_x, arg_y]\n  = do dflags <- getDynFlags\n       r1 <- newTemp (cmmExprType dflags arg_x)\n       r2 <- newTemp (cmmExprType dflags arg_x)\n       let topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]\n           toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]\n           bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]\n           add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]\n           or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]\n           hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))\n                                (wordWidth dflags))\n           hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))\n       emit $ catAGraphs\n          [mkAssign (CmmLocal r1)\n               (add (bottomHalf arg_x) (bottomHalf arg_y)),\n           mkAssign (CmmLocal r2)\n               (add (topHalf (CmmReg (CmmLocal r1)))\n                    (add (topHalf arg_x) (topHalf arg_y))),\n           mkAssign (CmmLocal res_h)\n               (topHalf (CmmReg (CmmLocal r2))),\n           mkAssign (CmmLocal res_l)\n               (or (toTopHalf (CmmReg (CmmLocal r2)))\n                   (bottomHalf (CmmReg (CmmLocal r1))))]\ngenericWordAdd2Op _ _ = panic \"genericWordAdd2Op\"\n\n-- | Implements branchless recovery of the carry flag @c@ by checking the\n-- leftmost bits of both inputs @a@ and @b@ and result @r = a + b@:\n--\n-- @\n--    c = a&b | (a|b)&~r\n-- @\n--\n-- https://brodowsky.it-sky.net/2015/04/02/how-to-recover-the-carry-bit/\ngenericWordAddCOp :: GenericOp\ngenericWordAddCOp [res_r, res_c] [aa, bb]\n = do dflags <- getDynFlags\n      emit $ catAGraphs [\n        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),\n        mkAssign (CmmLocal res_c) $\n          CmmMachOp (mo_wordUShr dflags) [\n            CmmMachOp (mo_wordOr dflags) [\n              CmmMachOp (mo_wordAnd dflags) [aa,bb],\n              CmmMachOp (mo_wordAnd dflags) [\n                CmmMachOp (mo_wordOr dflags) [aa,bb],\n                CmmMachOp (mo_wordNot dflags) [CmmReg (CmmLocal res_r)]\n              ]\n            ],\n            mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)\n          ]\n        ]\ngenericWordAddCOp _ _ = panic \"genericWordAddCOp\"\n\n-- | Implements branchless recovery of the carry flag @c@ by checking the\n-- leftmost bits of both inputs @a@ and @b@ and result @r = a - b@:\n--\n-- @\n--    c = ~a&b | (~a|b)&r\n-- @\n--\n-- https://brodowsky.it-sky.net/2015/04/02/how-to-recover-the-carry-bit/\ngenericWordSubCOp :: GenericOp\ngenericWordSubCOp [res_r, res_c] [aa, bb]\n = do dflags <- getDynFlags\n      emit $ catAGraphs [\n        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),\n        mkAssign (CmmLocal res_c) $\n          CmmMachOp (mo_wordUShr dflags) [\n            CmmMachOp (mo_wordOr dflags) [\n              CmmMachOp (mo_wordAnd dflags) [\n                CmmMachOp (mo_wordNot dflags) [aa],\n                bb\n              ],\n              CmmMachOp (mo_wordAnd dflags) [\n                CmmMachOp (mo_wordOr dflags) [\n                  CmmMachOp (mo_wordNot dflags) [aa],\n                  bb\n                ],\n                CmmReg (CmmLocal res_r)\n              ]\n            ],\n            mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)\n          ]\n        ]\ngenericWordSubCOp _ _ = panic \"genericWordSubCOp\"\n\ngenericIntAddCOp :: GenericOp\ngenericIntAddCOp [res_r, res_c] [aa, bb]\n{-\n   With some bit-twiddling, we can define int{Add,Sub}Czh portably in\n   C, and without needing any comparisons.  This may not be the\n   fastest way to do it - if you have better code, please send it! --SDM\n\n   Return : r = a + b,  c = 0 if no overflow, 1 on overflow.\n\n   We currently don't make use of the r value if c is != 0 (i.e.\n   overflow), we just convert to big integers and try again.  This\n   could be improved by making r and c the correct values for\n   plugging into a new J#.\n\n   { r = ((I_)(a)) + ((I_)(b));                                 \\\n     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \\\n         >> (BITS_IN (I_) - 1);                                 \\\n   }\n   Wading through the mass of bracketry, it seems to reduce to:\n   c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)\n\n-}\n = do dflags <- getDynFlags\n      emit $ catAGraphs [\n        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),\n        mkAssign (CmmLocal res_c) $\n          CmmMachOp (mo_wordUShr dflags) [\n                CmmMachOp (mo_wordAnd dflags) [\n                    CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],\n                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]\n                ],\n                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)\n          ]\n        ]\ngenericIntAddCOp _ _ = panic \"genericIntAddCOp\"\n\ngenericIntSubCOp :: GenericOp\ngenericIntSubCOp [res_r, res_c] [aa, bb]\n{- Similarly:\n   #define subIntCzh(r,c,a,b)                                   \\\n   { r = ((I_)(a)) - ((I_)(b));                                 \\\n     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \\\n         >> (BITS_IN (I_) - 1);                                 \\\n   }\n\n   c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)\n-}\n = do dflags <- getDynFlags\n      emit $ catAGraphs [\n        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),\n        mkAssign (CmmLocal res_c) $\n          CmmMachOp (mo_wordUShr dflags) [\n                CmmMachOp (mo_wordAnd dflags) [\n                    CmmMachOp (mo_wordXor dflags) [aa,bb],\n                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]\n                ],\n                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)\n          ]\n        ]\ngenericIntSubCOp _ _ = panic \"genericIntSubCOp\"\n\ngenericWordMul2Op :: GenericOp\ngenericWordMul2Op [res_h, res_l] [arg_x, arg_y]\n = do dflags <- getDynFlags\n      let t = cmmExprType dflags arg_x\n      xlyl <- liftM CmmLocal $ newTemp t\n      xlyh <- liftM CmmLocal $ newTemp t\n      xhyl <- liftM CmmLocal $ newTemp t\n      r    <- liftM CmmLocal $ newTemp t\n      -- This generic implementation is very simple and slow. We might\n      -- well be able to do better, but for now this at least works.\n      let topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]\n          toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]\n          bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]\n          add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]\n          sum = foldl1 add\n          mul x y = CmmMachOp (MO_Mul (wordWidth dflags)) [x, y]\n          or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]\n          hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))\n                               (wordWidth dflags))\n          hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))\n      emit $ catAGraphs\n             [mkAssign xlyl\n                  (mul (bottomHalf arg_x) (bottomHalf arg_y)),\n              mkAssign xlyh\n                  (mul (bottomHalf arg_x) (topHalf arg_y)),\n              mkAssign xhyl\n                  (mul (topHalf arg_x) (bottomHalf arg_y)),\n              mkAssign r\n                  (sum [topHalf    (CmmReg xlyl),\n                        bottomHalf (CmmReg xhyl),\n                        bottomHalf (CmmReg xlyh)]),\n              mkAssign (CmmLocal res_l)\n                  (or (bottomHalf (CmmReg xlyl))\n                      (toTopHalf (CmmReg r))),\n              mkAssign (CmmLocal res_h)\n                  (sum [mul (topHalf arg_x) (topHalf arg_y),\n                        topHalf (CmmReg xhyl),\n                        topHalf (CmmReg xlyh),\n                        topHalf (CmmReg r)])]\ngenericWordMul2Op _ _ = panic \"genericWordMul2Op\"\n\n-- This replicates what we had in libraries/base/GHC/Float.hs:\n--\n--    abs x    | x == 0    = 0 -- handles (-0.0)\n--             | x >  0    = x\n--             | otherwise = negateFloat x\ngenericFabsOp :: Width -> GenericOp\ngenericFabsOp w [res_r] [aa]\n = do dflags <- getDynFlags\n      let zero   = CmmLit (CmmFloat 0 w)\n\n          eq x y = CmmMachOp (MO_F_Eq w) [x, y]\n          gt x y = CmmMachOp (MO_F_Gt w) [x, y]\n\n          neg x  = CmmMachOp (MO_F_Neg w) [x]\n\n          g1 = catAGraphs [mkAssign (CmmLocal res_r) zero]\n          g2 = catAGraphs [mkAssign (CmmLocal res_r) aa]\n\n      res_t <- CmmLocal <$> newTemp (cmmExprType dflags aa)\n      let g3 = catAGraphs [mkAssign res_t aa,\n                           mkAssign (CmmLocal res_r) (neg (CmmReg res_t))]\n\n      g4 <- mkCmmIfThenElse (gt aa zero) g2 g3\n\n      emit =<< mkCmmIfThenElse (eq aa zero) g1 g4\n\ngenericFabsOp _ _ _ = panic \"genericFabsOp\"\n\n-- These PrimOps are NOPs in Cmm\n\nnopOp :: PrimOp -> Bool\nnopOp Int2WordOp     = True\nnopOp Word2IntOp     = True\nnopOp Int2AddrOp     = True\nnopOp Addr2IntOp     = True\nnopOp ChrOp          = True  -- Int# and Char# are rep'd the same\nnopOp OrdOp          = True\nnopOp _              = False\n\n-- These PrimOps turn into double casts\n\nnarrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)\nnarrowOp Narrow8IntOp   = Just (MO_SS_Conv, W8)\nnarrowOp Narrow16IntOp  = Just (MO_SS_Conv, W16)\nnarrowOp Narrow32IntOp  = Just (MO_SS_Conv, W32)\nnarrowOp Narrow8WordOp  = Just (MO_UU_Conv, W8)\nnarrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)\nnarrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)\nnarrowOp _              = Nothing\n\n-- Native word signless ops\n\ntranslateOp :: DynFlags -> PrimOp -> Maybe MachOp\ntranslateOp dflags IntAddOp       = Just (mo_wordAdd dflags)\ntranslateOp dflags IntSubOp       = Just (mo_wordSub dflags)\ntranslateOp dflags WordAddOp      = Just (mo_wordAdd dflags)\ntranslateOp dflags WordSubOp      = Just (mo_wordSub dflags)\ntranslateOp dflags AddrAddOp      = Just (mo_wordAdd dflags)\ntranslateOp dflags AddrSubOp      = Just (mo_wordSub dflags)\n\ntranslateOp dflags IntEqOp        = Just (mo_wordEq dflags)\ntranslateOp dflags IntNeOp        = Just (mo_wordNe dflags)\ntranslateOp dflags WordEqOp       = Just (mo_wordEq dflags)\ntranslateOp dflags WordNeOp       = Just (mo_wordNe dflags)\ntranslateOp dflags AddrEqOp       = Just (mo_wordEq dflags)\ntranslateOp dflags AddrNeOp       = Just (mo_wordNe dflags)\n\ntranslateOp dflags AndOp          = Just (mo_wordAnd dflags)\ntranslateOp dflags OrOp           = Just (mo_wordOr dflags)\ntranslateOp dflags XorOp          = Just (mo_wordXor dflags)\ntranslateOp dflags NotOp          = Just (mo_wordNot dflags)\ntranslateOp dflags SllOp          = Just (mo_wordShl dflags)\ntranslateOp dflags SrlOp          = Just (mo_wordUShr dflags)\n\ntranslateOp dflags AddrRemOp      = Just (mo_wordURem dflags)\n\n-- Native word signed ops\n\ntranslateOp dflags IntMulOp        = Just (mo_wordMul dflags)\ntranslateOp dflags IntMulMayOfloOp = Just (MO_S_MulMayOflo (wordWidth dflags))\ntranslateOp dflags IntQuotOp       = Just (mo_wordSQuot dflags)\ntranslateOp dflags IntRemOp        = Just (mo_wordSRem dflags)\ntranslateOp dflags IntNegOp        = Just (mo_wordSNeg dflags)\n\n\ntranslateOp dflags IntGeOp        = Just (mo_wordSGe dflags)\ntranslateOp dflags IntLeOp        = Just (mo_wordSLe dflags)\ntranslateOp dflags IntGtOp        = Just (mo_wordSGt dflags)\ntranslateOp dflags IntLtOp        = Just (mo_wordSLt dflags)\n\ntranslateOp dflags AndIOp         = Just (mo_wordAnd dflags)\ntranslateOp dflags OrIOp          = Just (mo_wordOr dflags)\ntranslateOp dflags XorIOp         = Just (mo_wordXor dflags)\ntranslateOp dflags NotIOp         = Just (mo_wordNot dflags)\ntranslateOp dflags ISllOp         = Just (mo_wordShl dflags)\ntranslateOp dflags ISraOp         = Just (mo_wordSShr dflags)\ntranslateOp dflags ISrlOp         = Just (mo_wordUShr dflags)\n\n-- Native word unsigned ops\n\ntranslateOp dflags WordGeOp       = Just (mo_wordUGe dflags)\ntranslateOp dflags WordLeOp       = Just (mo_wordULe dflags)\ntranslateOp dflags WordGtOp       = Just (mo_wordUGt dflags)\ntranslateOp dflags WordLtOp       = Just (mo_wordULt dflags)\n\ntranslateOp dflags WordMulOp      = Just (mo_wordMul dflags)\ntranslateOp dflags WordQuotOp     = Just (mo_wordUQuot dflags)\ntranslateOp dflags WordRemOp      = Just (mo_wordURem dflags)\n\ntranslateOp dflags AddrGeOp       = Just (mo_wordUGe dflags)\ntranslateOp dflags AddrLeOp       = Just (mo_wordULe dflags)\ntranslateOp dflags AddrGtOp       = Just (mo_wordUGt dflags)\ntranslateOp dflags AddrLtOp       = Just (mo_wordULt dflags)\n\n-- Int8# signed ops\n\ntranslateOp dflags Int8Extend     = Just (MO_SS_Conv W8 (wordWidth dflags))\ntranslateOp dflags Int8Narrow     = Just (MO_SS_Conv (wordWidth dflags) W8)\ntranslateOp _      Int8NegOp      = Just (MO_S_Neg W8)\ntranslateOp _      Int8AddOp      = Just (MO_Add W8)\ntranslateOp _      Int8SubOp      = Just (MO_Sub W8)\ntranslateOp _      Int8MulOp      = Just (MO_Mul W8)\ntranslateOp _      Int8QuotOp     = Just (MO_S_Quot W8)\ntranslateOp _      Int8RemOp      = Just (MO_S_Rem W8)\n\ntranslateOp _      Int8EqOp       = Just (MO_Eq W8)\ntranslateOp _      Int8GeOp       = Just (MO_S_Ge W8)\ntranslateOp _      Int8GtOp       = Just (MO_S_Gt W8)\ntranslateOp _      Int8LeOp       = Just (MO_S_Le W8)\ntranslateOp _      Int8LtOp       = Just (MO_S_Lt W8)\ntranslateOp _      Int8NeOp       = Just (MO_Ne W8)\n\n-- Word8# unsigned ops\n\ntranslateOp dflags Word8Extend     = Just (MO_UU_Conv W8 (wordWidth dflags))\ntranslateOp dflags Word8Narrow     = Just (MO_UU_Conv (wordWidth dflags) W8)\ntranslateOp _      Word8NotOp      = Just (MO_Not W8)\ntranslateOp _      Word8AddOp      = Just (MO_Add W8)\ntranslateOp _      Word8SubOp      = Just (MO_Sub W8)\ntranslateOp _      Word8MulOp      = Just (MO_Mul W8)\ntranslateOp _      Word8QuotOp     = Just (MO_U_Quot W8)\ntranslateOp _      Word8RemOp      = Just (MO_U_Rem W8)\n\ntranslateOp _      Word8EqOp       = Just (MO_Eq W8)\ntranslateOp _      Word8GeOp       = Just (MO_U_Ge W8)\ntranslateOp _      Word8GtOp       = Just (MO_U_Gt W8)\ntranslateOp _      Word8LeOp       = Just (MO_U_Le W8)\ntranslateOp _      Word8LtOp       = Just (MO_U_Lt W8)\ntranslateOp _      Word8NeOp       = Just (MO_Ne W8)\n\n-- Int16# signed ops\n\ntranslateOp dflags Int16Extend     = Just (MO_SS_Conv W16 (wordWidth dflags))\ntranslateOp dflags Int16Narrow     = Just (MO_SS_Conv (wordWidth dflags) W16)\ntranslateOp _      Int16NegOp      = Just (MO_S_Neg W16)\ntranslateOp _      Int16AddOp      = Just (MO_Add W16)\ntranslateOp _      Int16SubOp      = Just (MO_Sub W16)\ntranslateOp _      Int16MulOp      = Just (MO_Mul W16)\ntranslateOp _      Int16QuotOp     = Just (MO_S_Quot W16)\ntranslateOp _      Int16RemOp      = Just (MO_S_Rem W16)\n\ntranslateOp _      Int16EqOp       = Just (MO_Eq W16)\ntranslateOp _      Int16GeOp       = Just (MO_S_Ge W16)\ntranslateOp _      Int16GtOp       = Just (MO_S_Gt W16)\ntranslateOp _      Int16LeOp       = Just (MO_S_Le W16)\ntranslateOp _      Int16LtOp       = Just (MO_S_Lt W16)\ntranslateOp _      Int16NeOp       = Just (MO_Ne W16)\n\n-- Word16# unsigned ops\n\ntranslateOp dflags Word16Extend     = Just (MO_UU_Conv W16 (wordWidth dflags))\ntranslateOp dflags Word16Narrow     = Just (MO_UU_Conv (wordWidth dflags) W16)\ntranslateOp _      Word16NotOp      = Just (MO_Not W16)\ntranslateOp _      Word16AddOp      = Just (MO_Add W16)\ntranslateOp _      Word16SubOp      = Just (MO_Sub W16)\ntranslateOp _      Word16MulOp      = Just (MO_Mul W16)\ntranslateOp _      Word16QuotOp     = Just (MO_U_Quot W16)\ntranslateOp _      Word16RemOp      = Just (MO_U_Rem W16)\n\ntranslateOp _      Word16EqOp       = Just (MO_Eq W16)\ntranslateOp _      Word16GeOp       = Just (MO_U_Ge W16)\ntranslateOp _      Word16GtOp       = Just (MO_U_Gt W16)\ntranslateOp _      Word16LeOp       = Just (MO_U_Le W16)\ntranslateOp _      Word16LtOp       = Just (MO_U_Lt W16)\ntranslateOp _      Word16NeOp       = Just (MO_Ne W16)\n\n-- Char# ops\n\ntranslateOp dflags CharEqOp       = Just (MO_Eq (wordWidth dflags))\ntranslateOp dflags CharNeOp       = Just (MO_Ne (wordWidth dflags))\ntranslateOp dflags CharGeOp       = Just (MO_U_Ge (wordWidth dflags))\ntranslateOp dflags CharLeOp       = Just (MO_U_Le (wordWidth dflags))\ntranslateOp dflags CharGtOp       = Just (MO_U_Gt (wordWidth dflags))\ntranslateOp dflags CharLtOp       = Just (MO_U_Lt (wordWidth dflags))\n\n-- Double ops\n\ntranslateOp _      DoubleEqOp     = Just (MO_F_Eq W64)\ntranslateOp _      DoubleNeOp     = Just (MO_F_Ne W64)\ntranslateOp _      DoubleGeOp     = Just (MO_F_Ge W64)\ntranslateOp _      DoubleLeOp     = Just (MO_F_Le W64)\ntranslateOp _      DoubleGtOp     = Just (MO_F_Gt W64)\ntranslateOp _      DoubleLtOp     = Just (MO_F_Lt W64)\n\ntranslateOp _      DoubleAddOp    = Just (MO_F_Add W64)\ntranslateOp _      DoubleSubOp    = Just (MO_F_Sub W64)\ntranslateOp _      DoubleMulOp    = Just (MO_F_Mul W64)\ntranslateOp _      DoubleDivOp    = Just (MO_F_Quot W64)\ntranslateOp _      DoubleNegOp    = Just (MO_F_Neg W64)\n\n-- Float ops\n\ntranslateOp _      FloatEqOp     = Just (MO_F_Eq W32)\ntranslateOp _      FloatNeOp     = Just (MO_F_Ne W32)\ntranslateOp _      FloatGeOp     = Just (MO_F_Ge W32)\ntranslateOp _      FloatLeOp     = Just (MO_F_Le W32)\ntranslateOp _      FloatGtOp     = Just (MO_F_Gt W32)\ntranslateOp _      FloatLtOp     = Just (MO_F_Lt W32)\n\ntranslateOp _      FloatAddOp    = Just (MO_F_Add  W32)\ntranslateOp _      FloatSubOp    = Just (MO_F_Sub  W32)\ntranslateOp _      FloatMulOp    = Just (MO_F_Mul  W32)\ntranslateOp _      FloatDivOp    = Just (MO_F_Quot W32)\ntranslateOp _      FloatNegOp    = Just (MO_F_Neg  W32)\n\n-- Vector ops\n\ntranslateOp _ (VecAddOp FloatVec n w) = Just (MO_VF_Add  n w)\ntranslateOp _ (VecSubOp FloatVec n w) = Just (MO_VF_Sub  n w)\ntranslateOp _ (VecMulOp FloatVec n w) = Just (MO_VF_Mul  n w)\ntranslateOp _ (VecDivOp FloatVec n w) = Just (MO_VF_Quot n w)\ntranslateOp _ (VecNegOp FloatVec n w) = Just (MO_VF_Neg  n w)\n\ntranslateOp _ (VecAddOp  IntVec n w) = Just (MO_V_Add   n w)\ntranslateOp _ (VecSubOp  IntVec n w) = Just (MO_V_Sub   n w)\ntranslateOp _ (VecMulOp  IntVec n w) = Just (MO_V_Mul   n w)\ntranslateOp _ (VecQuotOp IntVec n w) = Just (MO_VS_Quot n w)\ntranslateOp _ (VecRemOp  IntVec n w) = Just (MO_VS_Rem  n w)\ntranslateOp _ (VecNegOp  IntVec n w) = Just (MO_VS_Neg  n w)\n\ntranslateOp _ (VecAddOp  WordVec n w) = Just (MO_V_Add   n w)\ntranslateOp _ (VecSubOp  WordVec n w) = Just (MO_V_Sub   n w)\ntranslateOp _ (VecMulOp  WordVec n w) = Just (MO_V_Mul   n w)\ntranslateOp _ (VecQuotOp WordVec n w) = Just (MO_VU_Quot n w)\ntranslateOp _ (VecRemOp  WordVec n w) = Just (MO_VU_Rem  n w)\n\n-- Conversions\n\ntranslateOp dflags Int2DoubleOp   = Just (MO_SF_Conv (wordWidth dflags) W64)\ntranslateOp dflags Double2IntOp   = Just (MO_FS_Conv W64 (wordWidth dflags))\n\ntranslateOp dflags Int2FloatOp    = Just (MO_SF_Conv (wordWidth dflags) W32)\ntranslateOp dflags Float2IntOp    = Just (MO_FS_Conv W32 (wordWidth dflags))\n\ntranslateOp _      Float2DoubleOp = Just (MO_FF_Conv W32 W64)\ntranslateOp _      Double2FloatOp = Just (MO_FF_Conv W64 W32)\n\n-- Word comparisons masquerading as more exotic things.\n\ntranslateOp dflags SameMutVarOp           = Just (mo_wordEq dflags)\ntranslateOp dflags SameMVarOp             = Just (mo_wordEq dflags)\ntranslateOp dflags SameMutableArrayOp     = Just (mo_wordEq dflags)\ntranslateOp dflags SameMutableByteArrayOp = Just (mo_wordEq dflags)\ntranslateOp dflags SameMutableArrayArrayOp= Just (mo_wordEq dflags)\ntranslateOp dflags SameSmallMutableArrayOp= Just (mo_wordEq dflags)\ntranslateOp dflags SameTVarOp             = Just (mo_wordEq dflags)\ntranslateOp dflags EqStablePtrOp          = Just (mo_wordEq dflags)\n-- See Note [Comparing stable names]\ntranslateOp dflags EqStableNameOp         = Just (mo_wordEq dflags)\n\ntranslateOp _      _ = Nothing\n\n-- Note [Comparing stable names]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- A StableName# is actually a pointer to a stable name object (SNO)\n-- containing an index into the stable name table (SNT). We\n-- used to compare StableName#s by following the pointers to the\n-- SNOs and checking whether they held the same SNT indices. However,\n-- this is not necessary: there is a one-to-one correspondence\n-- between SNOs and entries in the SNT, so simple pointer equality\n-- does the trick.\n\n-- These primops are implemented by CallishMachOps, because they sometimes\n-- turn into foreign calls depending on the backend.\n\ncallishOp :: PrimOp -> Maybe CallishMachOp\ncallishOp DoublePowerOp  = Just MO_F64_Pwr\ncallishOp DoubleSinOp    = Just MO_F64_Sin\ncallishOp DoubleCosOp    = Just MO_F64_Cos\ncallishOp DoubleTanOp    = Just MO_F64_Tan\ncallishOp DoubleSinhOp   = Just MO_F64_Sinh\ncallishOp DoubleCoshOp   = Just MO_F64_Cosh\ncallishOp DoubleTanhOp   = Just MO_F64_Tanh\ncallishOp DoubleAsinOp   = Just MO_F64_Asin\ncallishOp DoubleAcosOp   = Just MO_F64_Acos\ncallishOp DoubleAtanOp   = Just MO_F64_Atan\ncallishOp DoubleAsinhOp  = Just MO_F64_Asinh\ncallishOp DoubleAcoshOp  = Just MO_F64_Acosh\ncallishOp DoubleAtanhOp  = Just MO_F64_Atanh\ncallishOp DoubleLogOp    = Just MO_F64_Log\ncallishOp DoubleExpOp    = Just MO_F64_Exp\ncallishOp DoubleSqrtOp   = Just MO_F64_Sqrt\n\ncallishOp FloatPowerOp  = Just MO_F32_Pwr\ncallishOp FloatSinOp    = Just MO_F32_Sin\ncallishOp FloatCosOp    = Just MO_F32_Cos\ncallishOp FloatTanOp    = Just MO_F32_Tan\ncallishOp FloatSinhOp   = Just MO_F32_Sinh\ncallishOp FloatCoshOp   = Just MO_F32_Cosh\ncallishOp FloatTanhOp   = Just MO_F32_Tanh\ncallishOp FloatAsinOp   = Just MO_F32_Asin\ncallishOp FloatAcosOp   = Just MO_F32_Acos\ncallishOp FloatAtanOp   = Just MO_F32_Atan\ncallishOp FloatAsinhOp  = Just MO_F32_Asinh\ncallishOp FloatAcoshOp  = Just MO_F32_Acosh\ncallishOp FloatAtanhOp  = Just MO_F32_Atanh\ncallishOp FloatLogOp    = Just MO_F32_Log\ncallishOp FloatExpOp    = Just MO_F32_Exp\ncallishOp FloatSqrtOp   = Just MO_F32_Sqrt\n\ncallishOp _ = Nothing\n\n------------------------------------------------------------------------------\n-- Helpers for translating various minor variants of array indexing.\n\ndoIndexOffAddrOp :: Maybe MachOp\n                 -> CmmType\n                 -> [LocalReg]\n                 -> [CmmExpr]\n                 -> FCode ()\ndoIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]\n   = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr rep idx\ndoIndexOffAddrOp _ _ _ _\n   = panic \"StgCmmPrim: doIndexOffAddrOp\"\n\ndoIndexOffAddrOpAs :: Maybe MachOp\n                   -> CmmType\n                   -> CmmType\n                   -> [LocalReg]\n                   -> [CmmExpr]\n                   -> FCode ()\ndoIndexOffAddrOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx]\n   = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx_rep idx\ndoIndexOffAddrOpAs _ _ _ _ _\n   = panic \"StgCmmPrim: doIndexOffAddrOpAs\"\n\ndoIndexByteArrayOp :: Maybe MachOp\n                   -> CmmType\n                   -> [LocalReg]\n                   -> [CmmExpr]\n                   -> FCode ()\ndoIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]\n   = do dflags <- getDynFlags\n        mkBasicIndexedRead (arrWordsHdrSize dflags) maybe_post_read_cast rep res addr rep idx\ndoIndexByteArrayOp _ _ _ _\n   = panic \"StgCmmPrim: doIndexByteArrayOp\"\n\ndoIndexByteArrayOpAs :: Maybe MachOp\n                    -> CmmType\n                    -> CmmType\n                    -> [LocalReg]\n                    -> [CmmExpr]\n                    -> FCode ()\ndoIndexByteArrayOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx]\n   = do dflags <- getDynFlags\n        mkBasicIndexedRead (arrWordsHdrSize dflags) maybe_post_read_cast rep res addr idx_rep idx\ndoIndexByteArrayOpAs _ _ _ _ _\n   = panic \"StgCmmPrim: doIndexByteArrayOpAs\"\n\ndoReadPtrArrayOp :: LocalReg\n                 -> CmmExpr\n                 -> CmmExpr\n                 -> FCode ()\ndoReadPtrArrayOp res addr idx\n   = do dflags <- getDynFlags\n        mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr (gcWord dflags) idx\n\ndoWriteOffAddrOp :: Maybe MachOp\n                 -> CmmType\n                 -> [LocalReg]\n                 -> [CmmExpr]\n                 -> FCode ()\ndoWriteOffAddrOp maybe_pre_write_cast idx_ty [] [addr,idx,val]\n   = mkBasicIndexedWrite 0 maybe_pre_write_cast addr idx_ty idx val\ndoWriteOffAddrOp _ _ _ _\n   = panic \"StgCmmPrim: doWriteOffAddrOp\"\n\ndoWriteByteArrayOp :: Maybe MachOp\n                   -> CmmType\n                   -> [LocalReg]\n                   -> [CmmExpr]\n                   -> FCode ()\ndoWriteByteArrayOp maybe_pre_write_cast idx_ty [] [addr,idx,val]\n   = do dflags <- getDynFlags\n        mkBasicIndexedWrite (arrWordsHdrSize dflags) maybe_pre_write_cast addr idx_ty idx val\ndoWriteByteArrayOp _ _ _ _\n   = panic \"StgCmmPrim: doWriteByteArrayOp\"\n\ndoWritePtrArrayOp :: CmmExpr\n                  -> CmmExpr\n                  -> CmmExpr\n                  -> FCode ()\ndoWritePtrArrayOp addr idx val\n  = do dflags <- getDynFlags\n       let ty = cmmExprType dflags val\n       -- This write barrier is to ensure that the heap writes to the object\n       -- referred to by val have happened before we write val into the array.\n       -- See #12469 for details.\n       emitPrimCall [] MO_WriteBarrier []\n       mkBasicIndexedWrite (arrPtrsHdrSize dflags) Nothing addr ty idx val\n       emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))\n  -- the write barrier.  We must write a byte into the mark table:\n  -- bits8[a + header_size + StgMutArrPtrs_size(a) + x >> N]\n       emit $ mkStore (\n         cmmOffsetExpr dflags\n          (cmmOffsetExprW dflags (cmmOffsetB dflags addr (arrPtrsHdrSize dflags))\n                         (loadArrPtrsSize dflags addr))\n          (CmmMachOp (mo_wordUShr dflags) [idx,\n                                           mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags)])\n         ) (CmmLit (CmmInt 1 W8))\n\nloadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr\nloadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags)\n where off = fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags\n\nmkBasicIndexedRead :: ByteOff      -- Initial offset in bytes\n                   -> Maybe MachOp -- Optional result cast\n                   -> CmmType      -- Type of element we are accessing\n                   -> LocalReg     -- Destination\n                   -> CmmExpr      -- Base address\n                   -> CmmType      -- Type of element by which we are indexing\n                   -> CmmExpr      -- Index\n                   -> FCode ()\nmkBasicIndexedRead off Nothing ty res base idx_ty idx\n   = do dflags <- getDynFlags\n        emitAssign (CmmLocal res) (cmmLoadIndexOffExpr dflags off ty base idx_ty idx)\nmkBasicIndexedRead off (Just cast) ty res base idx_ty idx\n   = do dflags <- getDynFlags\n        emitAssign (CmmLocal res) (CmmMachOp cast [\n                                   cmmLoadIndexOffExpr dflags off ty base idx_ty idx])\n\nmkBasicIndexedWrite :: ByteOff      -- Initial offset in bytes\n                    -> Maybe MachOp -- Optional value cast\n                    -> CmmExpr      -- Base address\n                    -> CmmType      -- Type of element by which we are indexing\n                    -> CmmExpr      -- Index\n                    -> CmmExpr      -- Value to write\n                    -> FCode ()\nmkBasicIndexedWrite off Nothing base idx_ty idx val\n   = do dflags <- getDynFlags\n        emitStore (cmmIndexOffExpr dflags off (typeWidth idx_ty) base idx) val\nmkBasicIndexedWrite off (Just cast) base idx_ty idx val\n   = mkBasicIndexedWrite off Nothing base idx_ty idx (CmmMachOp cast [val])\n\n-- ----------------------------------------------------------------------------\n-- Misc utils\n\ncmmIndexOffExpr :: DynFlags\n                -> ByteOff  -- Initial offset in bytes\n                -> Width    -- Width of element by which we are indexing\n                -> CmmExpr  -- Base address\n                -> CmmExpr  -- Index\n                -> CmmExpr\ncmmIndexOffExpr dflags off width base idx\n   = cmmIndexExpr dflags width (cmmOffsetB dflags base off) idx\n\ncmmLoadIndexOffExpr :: DynFlags\n                    -> ByteOff  -- Initial offset in bytes\n                    -> CmmType  -- Type of element we are accessing\n                    -> CmmExpr  -- Base address\n                    -> CmmType  -- Type of element by which we are indexing\n                    -> CmmExpr  -- Index\n                    -> CmmExpr\ncmmLoadIndexOffExpr dflags off ty base idx_ty idx\n   = CmmLoad (cmmIndexOffExpr dflags off (typeWidth idx_ty) base idx) ty\n\nsetInfo :: CmmExpr -> CmmExpr -> CmmAGraph\nsetInfo closure_ptr info_ptr = mkStore closure_ptr info_ptr\n\n------------------------------------------------------------------------------\n-- Helpers for translating vector primops.\n\nvecVmmType :: PrimOpVecCat -> Length -> Width -> CmmType\nvecVmmType pocat n w = vec n (vecCmmCat pocat w)\n\nvecCmmCat :: PrimOpVecCat -> Width -> CmmType\nvecCmmCat IntVec   = cmmBits\nvecCmmCat WordVec  = cmmBits\nvecCmmCat FloatVec = cmmFloat\n\nvecElemInjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp\nvecElemInjectCast _      FloatVec _   =  Nothing\nvecElemInjectCast dflags IntVec   W8  =  Just (mo_WordTo8  dflags)\nvecElemInjectCast dflags IntVec   W16 =  Just (mo_WordTo16 dflags)\nvecElemInjectCast dflags IntVec   W32 =  Just (mo_WordTo32 dflags)\nvecElemInjectCast _      IntVec   W64 =  Nothing\nvecElemInjectCast dflags WordVec  W8  =  Just (mo_WordTo8  dflags)\nvecElemInjectCast dflags WordVec  W16 =  Just (mo_WordTo16 dflags)\nvecElemInjectCast dflags WordVec  W32 =  Just (mo_WordTo32 dflags)\nvecElemInjectCast _      WordVec  W64 =  Nothing\nvecElemInjectCast _      _        _   =  Nothing\n\nvecElemProjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp\nvecElemProjectCast _      FloatVec _   =  Nothing\nvecElemProjectCast dflags IntVec   W8  =  Just (mo_s_8ToWord  dflags)\nvecElemProjectCast dflags IntVec   W16 =  Just (mo_s_16ToWord dflags)\nvecElemProjectCast dflags IntVec   W32 =  Just (mo_s_32ToWord dflags)\nvecElemProjectCast _      IntVec   W64 =  Nothing\nvecElemProjectCast dflags WordVec  W8  =  Just (mo_u_8ToWord  dflags)\nvecElemProjectCast dflags WordVec  W16 =  Just (mo_u_16ToWord dflags)\nvecElemProjectCast dflags WordVec  W32 =  Just (mo_u_32ToWord dflags)\nvecElemProjectCast _      WordVec  W64 =  Nothing\nvecElemProjectCast _      _        _   =  Nothing\n\n-- Check to make sure that we can generate code for the specified vector type\n-- given the current set of dynamic flags.\ncheckVecCompatibility :: DynFlags -> PrimOpVecCat -> Length -> Width -> FCode ()\ncheckVecCompatibility dflags vcat l w = do\n    when (hscTarget dflags /= HscLlvm) $ do\n        sorry $ unlines [\"SIMD vector instructions require the LLVM back-end.\"\n                         ,\"Please use -fllvm.\"]\n    check vecWidth vcat l w\n  where\n    check :: Width -> PrimOpVecCat -> Length -> Width -> FCode ()\n    check W128 FloatVec 4 W32 | not (isSseEnabled dflags) =\n        sorry $ \"128-bit wide single-precision floating point \" ++\n                \"SIMD vector instructions require at least -msse.\"\n    check W128 _ _ _ | not (isSse2Enabled dflags) =\n        sorry $ \"128-bit wide integer and double precision \" ++\n                \"SIMD vector instructions require at least -msse2.\"\n    check W256 FloatVec _ _ | not (isAvxEnabled dflags) =\n        sorry $ \"256-bit wide floating point \" ++\n                \"SIMD vector instructions require at least -mavx.\"\n    check W256 _ _ _ | not (isAvx2Enabled dflags) =\n        sorry $ \"256-bit wide integer \" ++\n                \"SIMD vector instructions require at least -mavx2.\"\n    check W512 _ _ _ | not (isAvx512fEnabled dflags) =\n        sorry $ \"512-bit wide \" ++\n                \"SIMD vector instructions require -mavx512f.\"\n    check _ _ _ _ = return ()\n\n    vecWidth = typeWidth (vecVmmType vcat l w)\n\n------------------------------------------------------------------------------\n-- Helpers for translating vector packing and unpacking.\n\ndoVecPackOp :: Maybe MachOp  -- Cast from element to vector component\n            -> CmmType       -- Type of vector\n            -> CmmExpr       -- Initial vector\n            -> [CmmExpr]     -- Elements\n            -> CmmFormal     -- Destination for result\n            -> FCode ()\ndoVecPackOp maybe_pre_write_cast ty z es res = do\n    dst <- newTemp ty\n    emitAssign (CmmLocal dst) z\n    vecPack dst es 0\n  where\n    vecPack :: CmmFormal -> [CmmExpr] -> Int -> FCode ()\n    vecPack src [] _ =\n        emitAssign (CmmLocal res) (CmmReg (CmmLocal src))\n\n    vecPack src (e : es) i = do\n        dst <- newTemp ty\n        if isFloatType (vecElemType ty)\n          then emitAssign (CmmLocal dst) (CmmMachOp (MO_VF_Insert len wid)\n                                                    [CmmReg (CmmLocal src), cast e, iLit])\n          else emitAssign (CmmLocal dst) (CmmMachOp (MO_V_Insert len wid)\n                                                    [CmmReg (CmmLocal src), cast e, iLit])\n        vecPack dst es (i + 1)\n      where\n        -- vector indices are always 32-bits\n        iLit = CmmLit (CmmInt (toInteger i) W32)\n\n    cast :: CmmExpr -> CmmExpr\n    cast val = case maybe_pre_write_cast of\n                 Nothing   -> val\n                 Just cast -> CmmMachOp cast [val]\n\n    len :: Length\n    len = vecLength ty\n\n    wid :: Width\n    wid = typeWidth (vecElemType ty)\n\ndoVecUnpackOp :: Maybe MachOp  -- Cast from vector component to element result\n              -> CmmType       -- Type of vector\n              -> CmmExpr       -- Vector\n              -> [CmmFormal]   -- Element results\n              -> FCode ()\ndoVecUnpackOp maybe_post_read_cast ty e res =\n    vecUnpack res 0\n  where\n    vecUnpack :: [CmmFormal] -> Int -> FCode ()\n    vecUnpack [] _ =\n        return ()\n\n    vecUnpack (r : rs) i = do\n        if isFloatType (vecElemType ty)\n          then emitAssign (CmmLocal r) (cast (CmmMachOp (MO_VF_Extract len wid)\n                                             [e, iLit]))\n          else emitAssign (CmmLocal r) (cast (CmmMachOp (MO_V_Extract len wid)\n                                             [e, iLit]))\n        vecUnpack rs (i + 1)\n      where\n        -- vector indices are always 32-bits\n        iLit = CmmLit (CmmInt (toInteger i) W32)\n\n    cast :: CmmExpr -> CmmExpr\n    cast val = case maybe_post_read_cast of\n                 Nothing   -> val\n                 Just cast -> CmmMachOp cast [val]\n\n    len :: Length\n    len = vecLength ty\n\n    wid :: Width\n    wid = typeWidth (vecElemType ty)\n\ndoVecInsertOp :: Maybe MachOp  -- Cast from element to vector component\n              -> CmmType       -- Vector type\n              -> CmmExpr       -- Source vector\n              -> CmmExpr       -- Element\n              -> CmmExpr       -- Index at which to insert element\n              -> CmmFormal     -- Destination for result\n              -> FCode ()\ndoVecInsertOp maybe_pre_write_cast ty src e idx res = do\n    dflags <- getDynFlags\n    -- vector indices are always 32-bits\n    let idx' :: CmmExpr\n        idx' = CmmMachOp (MO_SS_Conv (wordWidth dflags) W32) [idx]\n    if isFloatType (vecElemType ty)\n      then emitAssign (CmmLocal res) (CmmMachOp (MO_VF_Insert len wid) [src, cast e, idx'])\n      else emitAssign (CmmLocal res) (CmmMachOp (MO_V_Insert len wid) [src, cast e, idx'])\n  where\n    cast :: CmmExpr -> CmmExpr\n    cast val = case maybe_pre_write_cast of\n                 Nothing   -> val\n                 Just cast -> CmmMachOp cast [val]\n\n    len :: Length\n    len = vecLength ty\n\n    wid :: Width\n    wid = typeWidth (vecElemType ty)\n\n------------------------------------------------------------------------------\n-- Helpers for translating prefetching.\n\n\n-- | Translate byte array prefetch operations into proper primcalls.\ndoPrefetchByteArrayOp :: Int\n                      -> [CmmExpr]\n                      -> FCode ()\ndoPrefetchByteArrayOp locality  [addr,idx]\n   = do dflags <- getDynFlags\n        mkBasicPrefetch locality (arrWordsHdrSize dflags)  addr idx\ndoPrefetchByteArrayOp _ _\n   = panic \"StgCmmPrim: doPrefetchByteArrayOp\"\n\n-- | Translate mutable byte array prefetch operations into proper primcalls.\ndoPrefetchMutableByteArrayOp :: Int\n                      -> [CmmExpr]\n                      -> FCode ()\ndoPrefetchMutableByteArrayOp locality  [addr,idx]\n   = do dflags <- getDynFlags\n        mkBasicPrefetch locality (arrWordsHdrSize dflags)  addr idx\ndoPrefetchMutableByteArrayOp _ _\n   = panic \"StgCmmPrim: doPrefetchByteArrayOp\"\n\n-- | Translate address prefetch operations into proper primcalls.\ndoPrefetchAddrOp ::Int\n                 -> [CmmExpr]\n                 -> FCode ()\ndoPrefetchAddrOp locality   [addr,idx]\n   = mkBasicPrefetch locality 0  addr idx\ndoPrefetchAddrOp _ _\n   = panic \"StgCmmPrim: doPrefetchAddrOp\"\n\n-- | Translate value prefetch operations into proper primcalls.\ndoPrefetchValueOp :: Int\n                 -> [CmmExpr]\n                 -> FCode ()\ndoPrefetchValueOp  locality   [addr]\n  =  do dflags <- getDynFlags\n        mkBasicPrefetch locality 0 addr  (CmmLit (CmmInt 0 (wordWidth dflags)))\ndoPrefetchValueOp _ _\n  = panic \"StgCmmPrim: doPrefetchValueOp\"\n\n-- | helper to generate prefetch primcalls\nmkBasicPrefetch :: Int          -- Locality level 0-3\n                -> ByteOff      -- Initial offset in bytes\n                -> CmmExpr      -- Base address\n                -> CmmExpr      -- Index\n                -> FCode ()\nmkBasicPrefetch locality off base idx\n   = do dflags <- getDynFlags\n        emitPrimCall [] (MO_Prefetch_Data locality) [cmmIndexExpr dflags W8 (cmmOffsetB dflags base off) idx]\n        return ()\n\n-- ----------------------------------------------------------------------------\n-- Allocating byte arrays\n\n-- | Takes a register to return the newly allocated array in and the\n-- size of the new array in bytes. Allocates a new\n-- 'MutableByteArray#'.\ndoNewByteArrayOp :: CmmFormal -> ByteOff -> FCode ()\ndoNewByteArrayOp res_r n = do\n    dflags <- getDynFlags\n\n    let info_ptr = mkLblExpr mkArrWords_infoLabel\n        rep = arrWordsRep dflags n\n\n    tickyAllocPrim (mkIntExpr dflags (arrWordsHdrSize dflags))\n        (mkIntExpr dflags (nonHdrSize dflags rep))\n        (zeroExpr dflags)\n\n    let hdr_size = fixedHdrSize dflags\n\n    base <- allocHeapClosure rep info_ptr cccsExpr\n                     [ (mkIntExpr dflags n,\n                        hdr_size + oFFSET_StgArrBytes_bytes dflags)\n                     ]\n\n    emit $ mkAssign (CmmLocal res_r) base\n\n-- ----------------------------------------------------------------------------\n-- Comparing byte arrays\n\ndoCompareByteArraysOp :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr\n                     -> FCode ()\ndoCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n = do\n    dflags <- getDynFlags\n    ba1_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba1 (arrWordsHdrSize dflags)) ba1_off\n    ba2_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba2 (arrWordsHdrSize dflags)) ba2_off\n\n    -- short-cut in case of equal pointers avoiding a costly\n    -- subroutine call to the memcmp(3) routine; the Cmm logic below\n    -- results in assembly code being generated for\n    --\n    --   cmpPrefix10 :: ByteArray# -> ByteArray# -> Int#\n    --   cmpPrefix10 ba1 ba2 = compareByteArrays# ba1 0# ba2 0# 10#\n    --\n    -- that looks like\n    --\n    --          leaq 16(%r14),%rax\n    --          leaq 16(%rsi),%rbx\n    --          xorl %ecx,%ecx\n    --          cmpq %rbx,%rax\n    --          je l_ptr_eq\n    --\n    --          ; NB: the common case (unequal pointers) falls-through\n    --          ; the conditional jump, and therefore matches the\n    --          ; usual static branch prediction convention of modern cpus\n    --\n    --          subq $8,%rsp\n    --          movq %rbx,%rsi\n    --          movq %rax,%rdi\n    --          movl $10,%edx\n    --          xorl %eax,%eax\n    --          call memcmp\n    --          addq $8,%rsp\n    --          movslq %eax,%rax\n    --          movq %rax,%rcx\n    --  l_ptr_eq:\n    --          movq %rcx,%rbx\n    --          jmp *(%rbp)\n\n    l_ptr_eq <- newBlockId\n    l_ptr_ne <- newBlockId\n\n    emit (mkAssign (CmmLocal res) (zeroExpr dflags))\n    emit (mkCbranch (cmmEqWord dflags ba1_p ba2_p)\n                    l_ptr_eq l_ptr_ne (Just False))\n\n    emitLabel l_ptr_ne\n    emitMemcmpCall res ba1_p ba2_p n 1\n\n    emitLabel l_ptr_eq\n\n-- ----------------------------------------------------------------------------\n-- Copying byte arrays\n\n-- | Takes a source 'ByteArray#', an offset in the source array, a\n-- destination 'MutableByteArray#', an offset into the destination\n-- array, and the number of bytes to copy.  Copies the given number of\n-- bytes from the source array to the destination array.\ndoCopyByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr\n                  -> FCode ()\ndoCopyByteArrayOp = emitCopyByteArray copy\n  where\n    -- Copy data (we assume the arrays aren't overlapping since\n    -- they're of different types)\n    copy _src _dst dst_p src_p bytes =\n        emitMemcpyCall dst_p src_p bytes 1\n\n-- | Takes a source 'MutableByteArray#', an offset in the source\n-- array, a destination 'MutableByteArray#', an offset into the\n-- destination array, and the number of bytes to copy.  Copies the\n-- given number of bytes from the source array to the destination\n-- array.\ndoCopyMutableByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr\n                         -> FCode ()\ndoCopyMutableByteArrayOp = emitCopyByteArray copy\n  where\n    -- The only time the memory might overlap is when the two arrays\n    -- we were provided are the same array!\n    -- TODO: Optimize branch for common case of no aliasing.\n    copy src dst dst_p src_p bytes = do\n        dflags <- getDynFlags\n        (moveCall, cpyCall) <- forkAltPair\n            (getCode $ emitMemmoveCall dst_p src_p bytes 1)\n            (getCode $ emitMemcpyCall  dst_p src_p bytes 1)\n        emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall\n\nemitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr\n                      -> FCode ())\n                  -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr\n                  -> FCode ()\nemitCopyByteArray copy src src_off dst dst_off n = do\n    dflags <- getDynFlags\n    dst_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags dst (arrWordsHdrSize dflags)) dst_off\n    src_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags src (arrWordsHdrSize dflags)) src_off\n    copy src dst dst_p src_p n\n\n-- | Takes a source 'ByteArray#', an offset in the source array, a\n-- destination 'Addr#', and the number of bytes to copy.  Copies the given\n-- number of bytes from the source array to the destination memory region.\ndoCopyByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()\ndoCopyByteArrayToAddrOp src src_off dst_p bytes = do\n    -- Use memcpy (we are allowed to assume the arrays aren't overlapping)\n    dflags <- getDynFlags\n    src_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags src (arrWordsHdrSize dflags)) src_off\n    emitMemcpyCall dst_p src_p bytes 1\n\n-- | Takes a source 'MutableByteArray#', an offset in the source array, a\n-- destination 'Addr#', and the number of bytes to copy.  Copies the given\n-- number of bytes from the source array to the destination memory region.\ndoCopyMutableByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr\n                               -> FCode ()\ndoCopyMutableByteArrayToAddrOp = doCopyByteArrayToAddrOp\n\n-- | Takes a source 'Addr#', a destination 'MutableByteArray#', an offset into\n-- the destination array, and the number of bytes to copy.  Copies the given\n-- number of bytes from the source memory region to the destination array.\ndoCopyAddrToByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()\ndoCopyAddrToByteArrayOp src_p dst dst_off bytes = do\n    -- Use memcpy (we are allowed to assume the arrays aren't overlapping)\n    dflags <- getDynFlags\n    dst_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags dst (arrWordsHdrSize dflags)) dst_off\n    emitMemcpyCall dst_p src_p bytes 1\n\n\n-- ----------------------------------------------------------------------------\n-- Setting byte arrays\n\n-- | Takes a 'MutableByteArray#', an offset into the array, a length,\n-- and a byte, and sets each of the selected bytes in the array to the\n-- character.\ndoSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr\n                 -> FCode ()\ndoSetByteArrayOp ba off len c\n    = do dflags <- getDynFlags\n         p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off\n         emitMemsetCall p c len 1\n\n-- ----------------------------------------------------------------------------\n-- Allocating arrays\n\n-- | Allocate a new array.\ndoNewArrayOp :: CmmFormal             -- ^ return register\n             -> SMRep                 -- ^ representation of the array\n             -> CLabel                -- ^ info pointer\n             -> [(CmmExpr, ByteOff)]  -- ^ header payload\n             -> WordOff               -- ^ array size\n             -> CmmExpr               -- ^ initial element\n             -> FCode ()\ndoNewArrayOp res_r rep info payload n init = do\n    dflags <- getDynFlags\n\n    let info_ptr = mkLblExpr info\n\n    tickyAllocPrim (mkIntExpr dflags (hdrSize dflags rep))\n        (mkIntExpr dflags (nonHdrSize dflags rep))\n        (zeroExpr dflags)\n\n    base <- allocHeapClosure rep info_ptr cccsExpr payload\n\n    arr <- CmmLocal `fmap` newTemp (bWord dflags)\n    emit $ mkAssign arr base\n\n    -- Initialise all elements of the array\n    p <- assignTemp $ cmmOffsetB dflags (CmmReg arr) (hdrSize dflags rep)\n    for <- newBlockId\n    emitLabel for\n    let loopBody =\n            [ mkStore (CmmReg (CmmLocal p)) init\n            , mkAssign (CmmLocal p) (cmmOffsetW dflags (CmmReg (CmmLocal p)) 1)\n            , mkBranch for ]\n    emit =<< mkCmmIfThen\n        (cmmULtWord dflags (CmmReg (CmmLocal p))\n         (cmmOffsetW dflags (CmmReg arr)\n          (hdrSizeW dflags rep + n)))\n        (catAGraphs loopBody)\n\n    emit $ mkAssign (CmmLocal res_r) (CmmReg arr)\n\n-- ----------------------------------------------------------------------------\n-- Copying pointer arrays\n\n-- EZY: This code has an unusually high amount of assignTemp calls, seen\n-- nowhere else in the code generator.  This is mostly because these\n-- \"primitive\" ops result in a surprisingly large amount of code.  It\n-- will likely be worthwhile to optimize what is emitted here, so that\n-- our optimization passes don't waste time repeatedly optimizing the\n-- same bits of code.\n\n-- More closely imitates 'assignTemp' from the old code generator, which\n-- returns a CmmExpr rather than a LocalReg.\nassignTempE :: CmmExpr -> FCode CmmExpr\nassignTempE e = do\n    t <- assignTemp e\n    return (CmmReg (CmmLocal t))\n\n-- | Takes a source 'Array#', an offset in the source array, a\n-- destination 'MutableArray#', an offset into the destination array,\n-- and the number of elements to copy.  Copies the given number of\n-- elements from the source array to the destination array.\ndoCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff\n              -> FCode ()\ndoCopyArrayOp = emitCopyArray copy\n  where\n    -- Copy data (we assume the arrays aren't overlapping since\n    -- they're of different types)\n    copy _src _dst dst_p src_p bytes =\n        do dflags <- getDynFlags\n           emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)\n               (wORD_SIZE dflags)\n\n\n-- | Takes a source 'MutableArray#', an offset in the source array, a\n-- destination 'MutableArray#', an offset into the destination array,\n-- and the number of elements to copy.  Copies the given number of\n-- elements from the source array to the destination array.\ndoCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff\n                     -> FCode ()\ndoCopyMutableArrayOp = emitCopyArray copy\n  where\n    -- The only time the memory might overlap is when the two arrays\n    -- we were provided are the same array!\n    -- TODO: Optimize branch for common case of no aliasing.\n    copy src dst dst_p src_p bytes = do\n        dflags <- getDynFlags\n        (moveCall, cpyCall) <- forkAltPair\n            (getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)\n             (wORD_SIZE dflags))\n            (getCode $ emitMemcpyCall  dst_p src_p (mkIntExpr dflags bytes)\n             (wORD_SIZE dflags))\n        emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall\n\nemitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff\n                  -> FCode ())  -- ^ copy function\n              -> CmmExpr        -- ^ source array\n              -> CmmExpr        -- ^ offset in source array\n              -> CmmExpr        -- ^ destination array\n              -> CmmExpr        -- ^ offset in destination array\n              -> WordOff        -- ^ number of elements to copy\n              -> FCode ()\nemitCopyArray copy src0 src_off dst0 dst_off0 n = do\n    dflags <- getDynFlags\n    when (n /= 0) $ do\n        -- Passed as arguments (be careful)\n        src     <- assignTempE src0\n        dst     <- assignTempE dst0\n        dst_off <- assignTempE dst_off0\n\n        -- Set the dirty bit in the header.\n        emit (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))\n\n        dst_elems_p <- assignTempE $ cmmOffsetB dflags dst\n                       (arrPtrsHdrSize dflags)\n        dst_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p dst_off\n        src_p <- assignTempE $ cmmOffsetExprW dflags\n                 (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off\n        let bytes = wordsToBytes dflags n\n\n        copy src dst dst_p src_p bytes\n\n        -- The base address of the destination card table\n        dst_cards_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p\n                       (loadArrPtrsSize dflags dst)\n\n        emitSetCards dst_off dst_cards_p n\n\ndoCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff\n                   -> FCode ()\ndoCopySmallArrayOp = emitCopySmallArray copy\n  where\n    -- Copy data (we assume the arrays aren't overlapping since\n    -- they're of different types)\n    copy _src _dst dst_p src_p bytes =\n        do dflags <- getDynFlags\n           emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)\n               (wORD_SIZE dflags)\n\n\ndoCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff\n                          -> FCode ()\ndoCopySmallMutableArrayOp = emitCopySmallArray copy\n  where\n    -- The only time the memory might overlap is when the two arrays\n    -- we were provided are the same array!\n    -- TODO: Optimize branch for common case of no aliasing.\n    copy src dst dst_p src_p bytes = do\n        dflags <- getDynFlags\n        (moveCall, cpyCall) <- forkAltPair\n            (getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)\n             (wORD_SIZE dflags))\n            (getCode $ emitMemcpyCall  dst_p src_p (mkIntExpr dflags bytes)\n             (wORD_SIZE dflags))\n        emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall\n\nemitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff\n                       -> FCode ())  -- ^ copy function\n                   -> CmmExpr        -- ^ source array\n                   -> CmmExpr        -- ^ offset in source array\n                   -> CmmExpr        -- ^ destination array\n                   -> CmmExpr        -- ^ offset in destination array\n                   -> WordOff        -- ^ number of elements to copy\n                   -> FCode ()\nemitCopySmallArray copy src0 src_off dst0 dst_off n = do\n    dflags <- getDynFlags\n\n    -- Passed as arguments (be careful)\n    src     <- assignTempE src0\n    dst     <- assignTempE dst0\n\n    -- Set the dirty bit in the header.\n    emit (setInfo dst (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))\n\n    dst_p <- assignTempE $ cmmOffsetExprW dflags\n             (cmmOffsetB dflags dst (smallArrPtrsHdrSize dflags)) dst_off\n    src_p <- assignTempE $ cmmOffsetExprW dflags\n             (cmmOffsetB dflags src (smallArrPtrsHdrSize dflags)) src_off\n    let bytes = wordsToBytes dflags n\n\n    copy src dst dst_p src_p bytes\n\n-- | Takes an info table label, a register to return the newly\n-- allocated array in, a source array, an offset in the source array,\n-- and the number of elements to copy. Allocates a new array and\n-- initializes it from the source array.\nemitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff\n               -> FCode ()\nemitCloneArray info_p res_r src src_off n = do\n    dflags <- getDynFlags\n\n    let info_ptr = mkLblExpr info_p\n        rep = arrPtrsRep dflags n\n\n    tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags))\n        (mkIntExpr dflags (nonHdrSize dflags rep))\n        (zeroExpr dflags)\n\n    let hdr_size = fixedHdrSize dflags\n\n    base <- allocHeapClosure rep info_ptr cccsExpr\n                     [ (mkIntExpr dflags n,\n                        hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags)\n                     , (mkIntExpr dflags (nonHdrSizeW rep),\n                        hdr_size + oFFSET_StgMutArrPtrs_size dflags)\n                     ]\n\n    arr <- CmmLocal `fmap` newTemp (bWord dflags)\n    emit $ mkAssign arr base\n\n    dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)\n             (arrPtrsHdrSize dflags)\n    src_p <- assignTempE $ cmmOffsetExprW dflags src\n             (cmmAddWord dflags\n              (mkIntExpr dflags (arrPtrsHdrSizeW dflags)) src_off)\n\n    emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))\n        (wORD_SIZE dflags)\n\n    emit $ mkAssign (CmmLocal res_r) (CmmReg arr)\n\n-- | Takes an info table label, a register to return the newly\n-- allocated array in, a source array, an offset in the source array,\n-- and the number of elements to copy. Allocates a new array and\n-- initializes it from the source array.\nemitCloneSmallArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff\n                    -> FCode ()\nemitCloneSmallArray info_p res_r src src_off n = do\n    dflags <- getDynFlags\n\n    let info_ptr = mkLblExpr info_p\n        rep = smallArrPtrsRep n\n\n    tickyAllocPrim (mkIntExpr dflags (smallArrPtrsHdrSize dflags))\n        (mkIntExpr dflags (nonHdrSize dflags rep))\n        (zeroExpr dflags)\n\n    let hdr_size = fixedHdrSize dflags\n\n    base <- allocHeapClosure rep info_ptr cccsExpr\n                     [ (mkIntExpr dflags n,\n                        hdr_size + oFFSET_StgSmallMutArrPtrs_ptrs dflags)\n                     ]\n\n    arr <- CmmLocal `fmap` newTemp (bWord dflags)\n    emit $ mkAssign arr base\n\n    dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)\n             (smallArrPtrsHdrSize dflags)\n    src_p <- assignTempE $ cmmOffsetExprW dflags src\n             (cmmAddWord dflags\n              (mkIntExpr dflags (smallArrPtrsHdrSizeW dflags)) src_off)\n\n    emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))\n        (wORD_SIZE dflags)\n\n    emit $ mkAssign (CmmLocal res_r) (CmmReg arr)\n\n-- | Takes and offset in the destination array, the base address of\n-- the card table, and the number of elements affected (*not* the\n-- number of cards). The number of elements may not be zero.\n-- Marks the relevant cards as dirty.\nemitSetCards :: CmmExpr -> CmmExpr -> WordOff -> FCode ()\nemitSetCards dst_start dst_cards_start n = do\n    dflags <- getDynFlags\n    start_card <- assignTempE $ cardCmm dflags dst_start\n    let end_card = cardCmm dflags\n                   (cmmSubWord dflags\n                    (cmmAddWord dflags dst_start (mkIntExpr dflags n))\n                    (mkIntExpr dflags 1))\n    emitMemsetCall (cmmAddWord dflags dst_cards_start start_card)\n        (mkIntExpr dflags 1)\n        (cmmAddWord dflags (cmmSubWord dflags end_card start_card) (mkIntExpr dflags 1))\n        1 -- no alignment (1 byte)\n\n-- Convert an element index to a card index\ncardCmm :: DynFlags -> CmmExpr -> CmmExpr\ncardCmm dflags i =\n    cmmUShrWord dflags i (mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags))\n\n------------------------------------------------------------------------------\n-- SmallArray PrimOp implementations\n\ndoReadSmallPtrArrayOp :: LocalReg\n                      -> CmmExpr\n                      -> CmmExpr\n                      -> FCode ()\ndoReadSmallPtrArrayOp res addr idx = do\n    dflags <- getDynFlags\n    mkBasicIndexedRead (smallArrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr\n        (gcWord dflags) idx\n\ndoWriteSmallPtrArrayOp :: CmmExpr\n                       -> CmmExpr\n                       -> CmmExpr\n                       -> FCode ()\ndoWriteSmallPtrArrayOp addr idx val = do\n    dflags <- getDynFlags\n    let ty = cmmExprType dflags val\n    emitPrimCall [] MO_WriteBarrier [] -- #12469\n    mkBasicIndexedWrite (smallArrPtrsHdrSize dflags) Nothing addr ty idx val\n    emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))\n\n------------------------------------------------------------------------------\n-- Atomic read-modify-write\n\n-- | Emit an atomic modification to a byte array element. The result\n-- reg contains that previous value of the element. Implies a full\n-- memory barrier.\ndoAtomicRMW :: LocalReg      -- ^ Result reg\n            -> AtomicMachOp  -- ^ Atomic op (e.g. add)\n            -> CmmExpr       -- ^ MutableByteArray#\n            -> CmmExpr       -- ^ Index\n            -> CmmType       -- ^ Type of element by which we are indexing\n            -> CmmExpr       -- ^ Op argument (e.g. amount to add)\n            -> FCode ()\ndoAtomicRMW res amop mba idx idx_ty n = do\n    dflags <- getDynFlags\n    let width = typeWidth idx_ty\n        addr  = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)\n                width mba idx\n    emitPrimCall\n        [ res ]\n        (MO_AtomicRMW width amop)\n        [ addr, n ]\n\n-- | Emit an atomic read to a byte array that acts as a memory barrier.\ndoAtomicReadByteArray\n    :: LocalReg  -- ^ Result reg\n    -> CmmExpr   -- ^ MutableByteArray#\n    -> CmmExpr   -- ^ Index\n    -> CmmType   -- ^ Type of element by which we are indexing\n    -> FCode ()\ndoAtomicReadByteArray res mba idx idx_ty = do\n    dflags <- getDynFlags\n    let width = typeWidth idx_ty\n        addr  = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)\n                width mba idx\n    emitPrimCall\n        [ res ]\n        (MO_AtomicRead width)\n        [ addr ]\n\n-- | Emit an atomic write to a byte array that acts as a memory barrier.\ndoAtomicWriteByteArray\n    :: CmmExpr   -- ^ MutableByteArray#\n    -> CmmExpr   -- ^ Index\n    -> CmmType   -- ^ Type of element by which we are indexing\n    -> CmmExpr   -- ^ Value to write\n    -> FCode ()\ndoAtomicWriteByteArray mba idx idx_ty val = do\n    dflags <- getDynFlags\n    let width = typeWidth idx_ty\n        addr  = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)\n                width mba idx\n    emitPrimCall\n        [ {- no results -} ]\n        (MO_AtomicWrite width)\n        [ addr, val ]\n\ndoCasByteArray\n    :: LocalReg  -- ^ Result reg\n    -> CmmExpr   -- ^ MutableByteArray#\n    -> CmmExpr   -- ^ Index\n    -> CmmType   -- ^ Type of element by which we are indexing\n    -> CmmExpr   -- ^ Old value\n    -> CmmExpr   -- ^ New value\n    -> FCode ()\ndoCasByteArray res mba idx idx_ty old new = do\n    dflags <- getDynFlags\n    let width = (typeWidth idx_ty)\n        addr = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)\n               width mba idx\n    emitPrimCall\n        [ res ]\n        (MO_Cmpxchg width)\n        [ addr, old, new ]\n\n------------------------------------------------------------------------------\n-- Helpers for emitting function calls\n\n-- | Emit a call to @memcpy@.\nemitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()\nemitMemcpyCall dst src n align = do\n    emitPrimCall\n        [ {-no results-} ]\n        (MO_Memcpy align)\n        [ dst, src, n ]\n\n-- | Emit a call to @memmove@.\nemitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()\nemitMemmoveCall dst src n align = do\n    emitPrimCall\n        [ {- no results -} ]\n        (MO_Memmove align)\n        [ dst, src, n ]\n\n-- | Emit a call to @memset@.  The second argument must fit inside an\n-- unsigned char.\nemitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()\nemitMemsetCall dst c n align = do\n    emitPrimCall\n        [ {- no results -} ]\n        (MO_Memset align)\n        [ dst, c, n ]\n\nemitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()\nemitMemcmpCall res ptr1 ptr2 n align = do\n    -- 'MO_Memcmp' is assumed to return an 32bit 'CInt' because all\n    -- code-gens currently call out to the @memcmp(3)@ C function.\n    -- This was easier than moving the sign-extensions into\n    -- all the code-gens.\n    dflags <- getDynFlags\n    let is32Bit = typeWidth (localRegType res) == W32\n\n    cres <- if is32Bit\n              then return res\n              else newTemp b32\n\n    emitPrimCall\n        [ cres ]\n        (MO_Memcmp align)\n        [ ptr1, ptr2, n ]\n\n    unless is32Bit $ do\n      emit $ mkAssign (CmmLocal res)\n                      (CmmMachOp\n                         (mo_s_32ToWord dflags)\n                         [(CmmReg (CmmLocal cres))])\n\nemitBSwapCall :: LocalReg -> CmmExpr -> Width -> FCode ()\nemitBSwapCall res x width = do\n    emitPrimCall\n        [ res ]\n        (MO_BSwap width)\n        [ x ]\n\nemitPopCntCall :: LocalReg -> CmmExpr -> Width -> FCode ()\nemitPopCntCall res x width = do\n    emitPrimCall\n        [ res ]\n        (MO_PopCnt width)\n        [ x ]\n\nemitPdepCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()\nemitPdepCall res x y width = do\n    emitPrimCall\n        [ res ]\n        (MO_Pdep width)\n        [ x, y ]\n\nemitPextCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()\nemitPextCall res x y width = do\n    emitPrimCall\n        [ res ]\n        (MO_Pext width)\n        [ x, y ]\n\nemitClzCall :: LocalReg -> CmmExpr -> Width -> FCode ()\nemitClzCall res x width = do\n    emitPrimCall\n        [ res ]\n        (MO_Clz width)\n        [ x ]\n\nemitCtzCall :: LocalReg -> CmmExpr -> Width -> FCode ()\nemitCtzCall res x width = do\n    emitPrimCall\n        [ res ]\n        (MO_Ctz width)\n        [ x ]\n", "num_lines": 2546}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Code generation for profiling\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmProf (\n        initCostCentres, ccType, ccsType,\n        mkCCostCentre, mkCCostCentreStack,\n\n        -- Cost-centre Profiling\n        dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,\n        enterCostCentreThunk, enterCostCentreFun,\n        costCentreFrom,\n        storeCurCCS,\n        emitSetCCC,\n\n        saveCurrentCostCentre, restoreCurrentCostCentre,\n\n        -- Lag/drag/void stuff\n        ldvEnter, ldvEnterClosure, ldvRecordCreate\n  ) where\n\nimport GhcPrelude\n\nimport StgCmmClosure\nimport StgCmmUtils\nimport StgCmmMonad\nimport SMRep\n\nimport MkGraph\nimport Cmm\nimport CmmUtils\nimport CLabel\n\nimport CostCentre\nimport DynFlags\nimport FastString\nimport Module\nimport Outputable\n\nimport Control.Monad\nimport Data.Char (ord)\n\n-----------------------------------------------------------------------------\n--\n-- Cost-centre-stack Profiling\n--\n-----------------------------------------------------------------------------\n\n-- Expression representing the current cost centre stack\nccsType :: DynFlags -> CmmType -- Type of a cost-centre stack\nccsType = bWord\n\nccType :: DynFlags -> CmmType -- Type of a cost centre\nccType = bWord\n\nstoreCurCCS :: CmmExpr -> CmmAGraph\nstoreCurCCS e = mkAssign cccsReg e\n\nmkCCostCentre :: CostCentre -> CmmLit\nmkCCostCentre cc = CmmLabel (mkCCLabel cc)\n\nmkCCostCentreStack :: CostCentreStack -> CmmLit\nmkCCostCentreStack ccs = CmmLabel (mkCCSLabel ccs)\n\ncostCentreFrom :: DynFlags\n               -> CmmExpr         -- A closure pointer\n               -> CmmExpr        -- The cost centre from that closure\ncostCentreFrom dflags cl = CmmLoad (cmmOffsetB dflags cl (oFFSET_StgHeader_ccs dflags)) (ccsType dflags)\n\n-- | The profiling header words in a static closure\nstaticProfHdr :: DynFlags -> CostCentreStack -> [CmmLit]\nstaticProfHdr dflags ccs\n = ifProfilingL dflags [mkCCostCentreStack ccs, staticLdvInit dflags]\n\n-- | Profiling header words in a dynamic closure\ndynProfHdr :: DynFlags -> CmmExpr -> [CmmExpr]\ndynProfHdr dflags ccs = ifProfilingL dflags [ccs, dynLdvInit dflags]\n\n-- | Initialise the profiling field of an update frame\ninitUpdFrameProf :: CmmExpr -> FCode ()\ninitUpdFrameProf frame\n  = ifProfiling $        -- frame->header.prof.ccs = CCCS\n    do dflags <- getDynFlags\n       emitStore (cmmOffset dflags frame (oFFSET_StgHeader_ccs dflags)) cccsExpr\n        -- frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0)\n        -- is unnecessary because it is not used anyhow.\n\n---------------------------------------------------------------------------\n--         Saving and restoring the current cost centre\n---------------------------------------------------------------------------\n\n{-        Note [Saving the current cost centre]\n        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe current cost centre is like a global register.  Like other\nglobal registers, it's a caller-saves one.  But consider\n        case (f x) of (p,q) -> rhs\nSince 'f' may set the cost centre, we must restore it\nbefore resuming rhs.  So we want code like this:\n        local_cc = CCC  -- save\n        r = f( x )\n        CCC = local_cc  -- restore\nThat is, we explicitly \"save\" the current cost centre in\na LocalReg, local_cc; and restore it after the call. The\nC-- infrastructure will arrange to save local_cc across the\ncall.\n\nThe same goes for join points;\n        let j x = join-stuff\n        in blah-blah\nWe want this kind of code:\n        local_cc = CCC  -- save\n        blah-blah\n     J:\n        CCC = local_cc  -- restore\n-}\n\nsaveCurrentCostCentre :: FCode (Maybe LocalReg)\n        -- Returns Nothing if profiling is off\nsaveCurrentCostCentre\n  = do dflags <- getDynFlags\n       if not (gopt Opt_SccProfilingOn dflags)\n           then return Nothing\n           else do local_cc <- newTemp (ccType dflags)\n                   emitAssign (CmmLocal local_cc) cccsExpr\n                   return (Just local_cc)\n\nrestoreCurrentCostCentre :: Maybe LocalReg -> FCode ()\nrestoreCurrentCostCentre Nothing\n  = return ()\nrestoreCurrentCostCentre (Just local_cc)\n  = emit (storeCurCCS (CmmReg (CmmLocal local_cc)))\n\n\n-------------------------------------------------------------------------------\n-- Recording allocation in a cost centre\n-------------------------------------------------------------------------------\n\n-- | Record the allocation of a closure.  The CmmExpr is the cost\n-- centre stack to which to attribute the allocation.\nprofDynAlloc :: SMRep -> CmmExpr -> FCode ()\nprofDynAlloc rep ccs\n  = ifProfiling $\n    do dflags <- getDynFlags\n       profAlloc (mkIntExpr dflags (heapClosureSizeW dflags rep)) ccs\n\n-- | Record the allocation of a closure (size is given by a CmmExpr)\n-- The size must be in words, because the allocation counter in a CCS counts\n-- in words.\nprofAlloc :: CmmExpr -> CmmExpr -> FCode ()\nprofAlloc words ccs\n  = ifProfiling $\n        do dflags <- getDynFlags\n           let alloc_rep = rEP_CostCentreStack_mem_alloc dflags\n           emit (addToMemE alloc_rep\n                       (cmmOffsetB dflags ccs (oFFSET_CostCentreStack_mem_alloc dflags))\n                       (CmmMachOp (MO_UU_Conv (wordWidth dflags) (typeWidth alloc_rep)) $\n                         [CmmMachOp (mo_wordSub dflags) [words,\n                                                         mkIntExpr dflags (profHdrSize dflags)]]))\n                       -- subtract the \"profiling overhead\", which is the\n                       -- profiling header in a closure.\n\n-- -----------------------------------------------------------------------\n-- Setting the current cost centre on entry to a closure\n\nenterCostCentreThunk :: CmmExpr -> FCode ()\nenterCostCentreThunk closure =\n  ifProfiling $ do\n      dflags <- getDynFlags\n      emit $ storeCurCCS (costCentreFrom dflags closure)\n\nenterCostCentreFun :: CostCentreStack -> CmmExpr -> FCode ()\nenterCostCentreFun ccs closure =\n  ifProfiling $ do\n    if isCurrentCCS ccs\n       then do dflags <- getDynFlags\n               emitRtsCall rtsUnitId (fsLit \"enterFunCCS\")\n                   [(baseExpr, AddrHint),\n                    (costCentreFrom dflags closure, AddrHint)] False\n       else return () -- top-level function, nothing to do\n\nifProfiling :: FCode () -> FCode ()\nifProfiling code\n  = do dflags <- getDynFlags\n       if gopt Opt_SccProfilingOn dflags\n           then code\n           else return ()\n\nifProfilingL :: DynFlags -> [a] -> [a]\nifProfilingL dflags xs\n  | gopt Opt_SccProfilingOn dflags = xs\n  | otherwise                      = []\n\n\n---------------------------------------------------------------\n--        Initialising Cost Centres & CCSs\n---------------------------------------------------------------\n\ninitCostCentres :: CollectedCCs -> FCode ()\n-- Emit the declarations\ninitCostCentres (local_CCs, singleton_CCSs)\n  = do dflags <- getDynFlags\n       when (gopt Opt_SccProfilingOn dflags) $\n           do mapM_ emitCostCentreDecl local_CCs\n              mapM_ emitCostCentreStackDecl singleton_CCSs\n\n\nemitCostCentreDecl :: CostCentre -> FCode ()\nemitCostCentreDecl cc = do\n  { dflags <- getDynFlags\n  ; let is_caf | isCafCC cc = mkIntCLit dflags (ord 'c') -- 'c' == is a CAF\n               | otherwise  = zero dflags\n                        -- NB. bytesFS: we want the UTF-8 bytes here (#5559)\n  ; label <- newByteStringCLit (bytesFS $ costCentreUserNameFS cc)\n  ; modl  <- newByteStringCLit (bytesFS $ Module.moduleNameFS\n                                        $ Module.moduleName\n                                        $ cc_mod cc)\n  ; loc <- newByteStringCLit $ bytesFS $ mkFastString $\n                   showPpr dflags (costCentreSrcSpan cc)\n           -- XXX going via FastString to get UTF-8 encoding is silly\n  ; let\n     lits = [ zero dflags,           -- StgInt ccID,\n              label,        -- char *label,\n              modl,        -- char *module,\n              loc,      -- char *srcloc,\n              zero64,   -- StgWord64 mem_alloc\n              zero dflags,     -- StgWord time_ticks\n              is_caf,   -- StgInt is_caf\n              zero dflags      -- struct _CostCentre *link\n            ]\n  ; emitDataLits (mkCCLabel cc) lits\n  }\n\nemitCostCentreStackDecl :: CostCentreStack -> FCode ()\nemitCostCentreStackDecl ccs\n  = case maybeSingletonCCS ccs of\n    Just cc ->\n        do dflags <- getDynFlags\n           let mk_lits cc = zero dflags :\n                            mkCCostCentre cc :\n                            replicate (sizeof_ccs_words dflags - 2) (zero dflags)\n                -- Note: to avoid making any assumptions about how the\n                -- C compiler (that compiles the RTS, in particular) does\n                -- layouts of structs containing long-longs, simply\n                -- pad out the struct with zero words until we hit the\n                -- size of the overall struct (which we get via DerivedConstants.h)\n           emitDataLits (mkCCSLabel ccs) (mk_lits cc)\n    Nothing -> pprPanic \"emitCostCentreStackDecl\" (ppr ccs)\n\nzero :: DynFlags -> CmmLit\nzero dflags = mkIntCLit dflags 0\nzero64 :: CmmLit\nzero64 = CmmInt 0 W64\n\nsizeof_ccs_words :: DynFlags -> Int\nsizeof_ccs_words dflags\n    -- round up to the next word.\n  | ms == 0   = ws\n  | otherwise = ws + 1\n  where\n   (ws,ms) = sIZEOF_CostCentreStack dflags `divMod` wORD_SIZE dflags\n\n-- ---------------------------------------------------------------------------\n-- Set the current cost centre stack\n\nemitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()\nemitSetCCC cc tick push\n = do dflags <- getDynFlags\n      if not (gopt Opt_SccProfilingOn dflags)\n          then return ()\n          else do tmp <- newTemp (ccsType dflags)\n                  pushCostCentre tmp cccsExpr cc\n                  when tick $ emit (bumpSccCount dflags (CmmReg (CmmLocal tmp)))\n                  when push $ emit (storeCurCCS (CmmReg (CmmLocal tmp)))\n\npushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()\npushCostCentre result ccs cc\n  = emitRtsCallWithResult result AddrHint\n        rtsUnitId\n        (fsLit \"pushCostCentre\") [(ccs,AddrHint),\n                                (CmmLit (mkCCostCentre cc), AddrHint)]\n        False\n\nbumpSccCount :: DynFlags -> CmmExpr -> CmmAGraph\nbumpSccCount dflags ccs\n  = addToMem (rEP_CostCentreStack_scc_count dflags)\n         (cmmOffsetB dflags ccs (oFFSET_CostCentreStack_scc_count dflags)) 1\n\n-----------------------------------------------------------------------------\n--\n--                Lag/drag/void stuff\n--\n-----------------------------------------------------------------------------\n\n--\n-- Initial value for the LDV field in a static closure\n--\nstaticLdvInit :: DynFlags -> CmmLit\nstaticLdvInit = zeroCLit\n\n--\n-- Initial value of the LDV field in a dynamic closure\n--\ndynLdvInit :: DynFlags -> CmmExpr\ndynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE\n  CmmMachOp (mo_wordOr dflags) [\n      CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags (lDV_SHIFT dflags)],\n      CmmLit (mkWordCLit dflags (iLDV_STATE_CREATE dflags))\n  ]\n\n--\n-- Initialise the LDV word of a new closure\n--\nldvRecordCreate :: CmmExpr -> FCode ()\nldvRecordCreate closure = do\n  dflags <- getDynFlags\n  emit $ mkStore (ldvWord dflags closure) (dynLdvInit dflags)\n\n--\n-- | Called when a closure is entered, marks the closure as having\n-- been \"used\".  The closure is not an \"inherently used\" one.  The\n-- closure is not @IND@ because that is not considered for LDV profiling.\n--\nldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()\nldvEnterClosure closure_info node_reg = do\n    dflags <- getDynFlags\n    let tag = funTag dflags closure_info\n    -- don't forget to substract node's tag\n    ldvEnter (cmmOffsetB dflags (CmmReg node_reg) (-tag))\n\nldvEnter :: CmmExpr -> FCode ()\n-- Argument is a closure pointer\nldvEnter cl_ptr = do\n    dflags <- getDynFlags\n    let -- don't forget to substract node's tag\n        ldv_wd = ldvWord dflags cl_ptr\n        new_ldv_wd = cmmOrWord dflags (cmmAndWord dflags (CmmLoad ldv_wd (bWord dflags))\n                                                         (CmmLit (mkWordCLit dflags (iLDV_CREATE_MASK dflags))))\n                                      (cmmOrWord dflags (loadEra dflags) (CmmLit (mkWordCLit dflags (iLDV_STATE_USE dflags))))\n    ifProfiling $\n         -- if (era > 0) {\n         --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |\n         --                era | LDV_STATE_USE }\n        emit =<< mkCmmIfThenElse (CmmMachOp (mo_wordUGt dflags) [loadEra dflags, CmmLit (zeroCLit dflags)])\n                     (mkStore ldv_wd new_ldv_wd)\n                     mkNop\n\nloadEra :: DynFlags -> CmmExpr\nloadEra dflags = CmmMachOp (MO_UU_Conv (cIntWidth dflags) (wordWidth dflags))\n    [CmmLoad (mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit \"era\")))\n             (cInt dflags)]\n\nldvWord :: DynFlags -> CmmExpr -> CmmExpr\n-- Takes the address of a closure, and returns\n-- the address of the LDV word in the closure\nldvWord dflags closure_ptr\n    = cmmOffsetB dflags closure_ptr (oFFSET_StgHeader_ldvw dflags)\n", "num_lines": 361}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\n-----------------------------------------------------------------------------\n--\n-- Code generation for ticky-ticky profiling\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\n{- OVERVIEW: ticky ticky profiling\n\nPlease see\nhttp://ghc.haskell.org/trac/ghc/wiki/Debugging/TickyTicky and also\nedit it and the rest of this comment to keep them up-to-date if you\nchange ticky-ticky. Thanks!\n\n *** All allocation ticky numbers are in bytes. ***\n\nSome of the relevant source files:\n\n       ***not necessarily an exhaustive list***\n\n  * some codeGen/ modules import this one\n\n  * this module imports cmm/CLabel.hs to manage labels\n\n  * cmm/CmmParse.y expands some macros using generators defined in\n    this module\n\n  * includes/stg/Ticky.h declares all of the global counters\n\n  * includes/rts/Ticky.h declares the C data type for an\n    STG-declaration's counters\n\n  * some macros defined in includes/Cmm.h (and used within the RTS's\n    CMM code) update the global ticky counters\n\n  * at the end of execution rts/Ticky.c generates the final report\n    +RTS -r<report-file> -RTS\n\nThe rts/Ticky.c function that generates the report includes an\nSTG-declaration's ticky counters if\n\n  * that declaration was entered, or\n\n  * it was allocated (if -ticky-allocd)\n\nOn either of those events, the counter is \"registered\" by adding it to\na linked list; cf the CMM generated by registerTickyCtr.\n\nTicky-ticky profiling has evolved over many years. Many of the\ncounters from its most sophisticated days are no longer\nactive/accurate. As the RTS has changed, sometimes the ticky code for\nrelevant counters was not accordingly updated. Unfortunately, neither\nwere the comments.\n\nAs of March 2013, there still exist deprecated code and comments in\nthe code generator as well as the RTS because:\n\n  * I don't know what is out-of-date versus merely commented out for\n    momentary convenience, and\n\n  * someone else might know how to repair it!\n\n-}\n\nmodule StgCmmTicky (\n  withNewTickyCounterFun,\n  withNewTickyCounterLNE,\n  withNewTickyCounterThunk,\n  withNewTickyCounterStdThunk,\n  withNewTickyCounterCon,\n\n  tickyDynAlloc,\n  tickyAllocHeap,\n\n  tickyAllocPrim,\n  tickyAllocThunk,\n  tickyAllocPAP,\n  tickyHeapCheck,\n  tickyStackCheck,\n\n  tickyUnknownCall, tickyDirectCall,\n\n  tickyPushUpdateFrame,\n  tickyUpdateFrameOmitted,\n\n  tickyEnterDynCon,\n  tickyEnterStaticCon,\n  tickyEnterViaNode,\n\n  tickyEnterFun,\n  tickyEnterThunk, tickyEnterStdThunk,        -- dynamic non-value\n                                              -- thunks only\n  tickyEnterLNE,\n\n  tickyUpdateBhCaf,\n  tickyBlackHole,\n  tickyUnboxedTupleReturn,\n  tickyReturnOldCon, tickyReturnNewCon,\n\n  tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs,\n  tickySlowCall, tickySlowCallPat,\n  ) where\n\nimport GhcPrelude\n\nimport StgCmmArgRep    ( slowCallPattern , toArgRep , argRepString )\nimport StgCmmClosure\nimport StgCmmUtils\nimport StgCmmMonad\n\nimport StgSyn\nimport CmmExpr\nimport MkGraph\nimport CmmUtils\nimport CLabel\nimport SMRep\n\nimport Module\nimport Name\nimport Id\nimport BasicTypes\nimport FastString\nimport Outputable\nimport Util\n\nimport DynFlags\n\n-- Turgid imports for showTypeCategory\nimport PrelNames\nimport TcType\nimport Type\nimport TyCon\n\nimport Data.Maybe\nimport qualified Data.Char\nimport Control.Monad ( when )\n\n-----------------------------------------------------------------------------\n--\n-- Ticky-ticky profiling\n--\n-----------------------------------------------------------------------------\n\ndata TickyClosureType\n    = TickyFun\n        Bool -- True <-> single entry\n    | TickyCon\n    | TickyThunk\n        Bool -- True <-> updateable\n        Bool -- True <-> standard thunk (AP or selector), has no entry counter\n    | TickyLNE\n\nwithNewTickyCounterFun :: Bool -> Name  -> [NonVoid Id] -> FCode a -> FCode a\nwithNewTickyCounterFun single_entry = withNewTickyCounter (TickyFun single_entry)\n\nwithNewTickyCounterLNE :: Name  -> [NonVoid Id] -> FCode a -> FCode a\nwithNewTickyCounterLNE nm args code = do\n  b <- tickyLNEIsOn\n  if not b then code else withNewTickyCounter TickyLNE nm args code\n\nthunkHasCounter :: Bool -> FCode Bool\nthunkHasCounter isStatic = do\n  b <- tickyDynThunkIsOn\n  pure (not isStatic && b)\n\nwithNewTickyCounterThunk\n  :: Bool -- ^ static\n  -> Bool -- ^ updateable\n  -> Name\n  -> FCode a\n  -> FCode a\nwithNewTickyCounterThunk isStatic isUpdatable name code = do\n    has_ctr <- thunkHasCounter isStatic\n    if not has_ctr\n      then code\n      else withNewTickyCounter (TickyThunk isUpdatable False) name [] code\n\nwithNewTickyCounterStdThunk\n  :: Bool -- ^ updateable\n  -> Name\n  -> FCode a\n  -> FCode a\nwithNewTickyCounterStdThunk isUpdatable name code = do\n    has_ctr <- thunkHasCounter False\n    if not has_ctr\n      then code\n      else withNewTickyCounter (TickyThunk isUpdatable True) name [] code\n\nwithNewTickyCounterCon\n  :: Name\n  -> FCode a\n  -> FCode a\nwithNewTickyCounterCon name code = do\n    has_ctr <- thunkHasCounter False\n    if not has_ctr\n      then code\n      else withNewTickyCounter TickyCon name [] code\n\n-- args does not include the void arguments\nwithNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a\nwithNewTickyCounter cloType name args m = do\n  lbl <- emitTickyCounter cloType name args\n  setTickyCtrLabel lbl m\n\nemitTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode CLabel\nemitTickyCounter cloType name args\n  = let ctr_lbl = mkRednCountsLabel name in\n    (>> return ctr_lbl) $\n    ifTicky $ do\n        { dflags <- getDynFlags\n        ; parent <- getTickyCtrLabel\n        ; mod_name <- getModuleName\n\n          -- When printing the name of a thing in a ticky file, we\n          -- want to give the module name even for *local* things.  We\n          -- print just \"x (M)\" rather that \"M.x\" to distinguish them\n          -- from the global kind.\n        ; let ppr_for_ticky_name :: SDoc\n              ppr_for_ticky_name =\n                let n = ppr name\n                    ext = case cloType of\n                              TickyFun single_entry -> parens $ hcat $ punctuate comma $\n                                  [text \"fun\"] ++ [text \"se\"|single_entry]\n                              TickyCon -> parens (text \"con\")\n                              TickyThunk upd std -> parens $ hcat $ punctuate comma $\n                                  [text \"thk\"] ++ [text \"se\"|not upd] ++ [text \"std\"|std]\n                              TickyLNE | isInternalName name -> parens (text \"LNE\")\n                                       | otherwise -> panic \"emitTickyCounter: how is this an external LNE?\"\n                    p = case hasHaskellName parent of\n                            -- NB the default \"top\" ticky ctr does not\n                            -- have a Haskell name\n                          Just pname -> text \"in\" <+> ppr (nameUnique pname)\n                          _ -> empty\n                in if isInternalName name\n                   then n <+> parens (ppr mod_name) <+> ext <+> p\n                   else n <+> ext <+> p\n\n        ; fun_descr_lit <- newStringCLit $ showSDocDebug dflags ppr_for_ticky_name\n        ; arg_descr_lit <- newStringCLit $ map (showTypeCategory . idType . fromNonVoid) args\n        ; emitDataLits ctr_lbl\n        -- Must match layout of includes/rts/Ticky.h's StgEntCounter\n        --\n        -- krc: note that all the fields are I32 now; some were I16\n        -- before, but the code generator wasn't handling that\n        -- properly and it led to chaos, panic and disorder.\n            [ mkIntCLit dflags 0,               -- registered?\n              mkIntCLit dflags (length args),   -- Arity\n              mkIntCLit dflags 0,               -- Heap allocated for this thing\n              fun_descr_lit,\n              arg_descr_lit,\n              zeroCLit dflags,          -- Entries into this thing\n              zeroCLit dflags,          -- Heap allocated by this thing\n              zeroCLit dflags                   -- Link to next StgEntCounter\n            ]\n        }\n\n-- -----------------------------------------------------------------------------\n-- Ticky stack frames\n\ntickyPushUpdateFrame, tickyUpdateFrameOmitted :: FCode ()\ntickyPushUpdateFrame    = ifTicky $ bumpTickyCounter (fsLit \"UPDF_PUSHED_ctr\")\ntickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (fsLit \"UPDF_OMITTED_ctr\")\n\n-- -----------------------------------------------------------------------------\n-- Ticky entries\n\n-- NB the name-specific entries are only available for names that have\n-- dedicated Cmm code. As far as I know, this just rules out\n-- constructor thunks. For them, there is no CMM code block to put the\n-- bump of name-specific ticky counter into. On the other hand, we can\n-- still track allocation their allocation.\n\ntickyEnterDynCon, tickyEnterStaticCon, tickyEnterViaNode :: FCode ()\ntickyEnterDynCon      = ifTicky $ bumpTickyCounter (fsLit \"ENT_DYN_CON_ctr\")\ntickyEnterStaticCon   = ifTicky $ bumpTickyCounter (fsLit \"ENT_STATIC_CON_ctr\")\ntickyEnterViaNode     = ifTicky $ bumpTickyCounter (fsLit \"ENT_VIA_NODE_ctr\")\n\ntickyEnterThunk :: ClosureInfo -> FCode ()\ntickyEnterThunk cl_info\n  = ifTicky $ do\n    { bumpTickyCounter ctr\n    ; has_ctr <- thunkHasCounter static\n    ; when has_ctr $ do\n      ticky_ctr_lbl <- getTickyCtrLabel\n      registerTickyCtrAtEntryDyn ticky_ctr_lbl\n      bumpTickyEntryCount ticky_ctr_lbl }\n  where\n    updatable = closureSingleEntry cl_info\n    static    = isStaticClosure cl_info\n\n    ctr | static    = if updatable then fsLit \"ENT_STATIC_THK_SINGLE_ctr\"\n                                   else fsLit \"ENT_STATIC_THK_MANY_ctr\"\n        | otherwise = if updatable then fsLit \"ENT_DYN_THK_SINGLE_ctr\"\n                                   else fsLit \"ENT_DYN_THK_MANY_ctr\"\n\ntickyEnterStdThunk :: ClosureInfo -> FCode ()\ntickyEnterStdThunk = tickyEnterThunk\n\ntickyBlackHole :: Bool{-updatable-} -> FCode ()\ntickyBlackHole updatable\n  = ifTicky (bumpTickyCounter ctr)\n  where\n    ctr | updatable = (fsLit \"UPD_BH_SINGLE_ENTRY_ctr\")\n        | otherwise = (fsLit \"UPD_BH_UPDATABLE_ctr\")\n\ntickyUpdateBhCaf :: ClosureInfo -> FCode ()\ntickyUpdateBhCaf cl_info\n  = ifTicky (bumpTickyCounter ctr)\n  where\n    ctr | closureUpdReqd cl_info = (fsLit \"UPD_CAF_BH_SINGLE_ENTRY_ctr\")\n        | otherwise              = (fsLit \"UPD_CAF_BH_UPDATABLE_ctr\")\n\ntickyEnterFun :: ClosureInfo -> FCode ()\ntickyEnterFun cl_info = ifTicky $ do\n  ctr_lbl <- getTickyCtrLabel\n\n  if isStaticClosure cl_info\n    then do bumpTickyCounter (fsLit \"ENT_STATIC_FUN_DIRECT_ctr\")\n            registerTickyCtr ctr_lbl\n    else do bumpTickyCounter (fsLit \"ENT_DYN_FUN_DIRECT_ctr\")\n            registerTickyCtrAtEntryDyn ctr_lbl\n\n  bumpTickyEntryCount ctr_lbl\n\ntickyEnterLNE :: FCode ()\ntickyEnterLNE = ifTicky $ do\n  bumpTickyCounter (fsLit \"ENT_LNE_ctr\")\n  ifTickyLNE $ do\n    ctr_lbl <- getTickyCtrLabel\n    registerTickyCtr ctr_lbl\n    bumpTickyEntryCount ctr_lbl\n\n-- needn't register a counter upon entry if\n--\n-- 1) it's for a dynamic closure, and\n--\n-- 2) -ticky-allocd is on\n--\n-- since the counter was registered already upon being alloc'd\nregisterTickyCtrAtEntryDyn :: CLabel -> FCode ()\nregisterTickyCtrAtEntryDyn ctr_lbl = do\n  already_registered <- tickyAllocdIsOn\n  when (not already_registered) $ registerTickyCtr ctr_lbl\n\nregisterTickyCtr :: CLabel -> FCode ()\n-- Register a ticky counter\n--   if ( ! f_ct.registeredp ) {\n--          f_ct.link = ticky_entry_ctrs;       /* hook this one onto the front of the list */\n--          ticky_entry_ctrs = & (f_ct);        /* mark it as \"registered\" */\n--          f_ct.registeredp = 1 }\nregisterTickyCtr ctr_lbl = do\n  dflags <- getDynFlags\n  let\n    -- krc: code generator doesn't handle Not, so we test for Eq 0 instead\n    test = CmmMachOp (MO_Eq (wordWidth dflags))\n              [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl\n                                (oFFSET_StgEntCounter_registeredp dflags))) (bWord dflags),\n               zeroExpr dflags]\n    register_stmts\n      = [ mkStore (CmmLit (cmmLabelOffB ctr_lbl (oFFSET_StgEntCounter_link dflags)))\n                   (CmmLoad ticky_entry_ctrs (bWord dflags))\n        , mkStore ticky_entry_ctrs (mkLblExpr ctr_lbl)\n        , mkStore (CmmLit (cmmLabelOffB ctr_lbl\n                                (oFFSET_StgEntCounter_registeredp dflags)))\n                   (mkIntExpr dflags 1) ]\n    ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit \"ticky_entry_ctrs\"))\n  emit =<< mkCmmIfThen test (catAGraphs register_stmts)\n\ntickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()\ntickyReturnOldCon arity\n  = ifTicky $ do { bumpTickyCounter (fsLit \"RET_OLD_ctr\")\n                 ; bumpHistogram    (fsLit \"RET_OLD_hst\") arity }\ntickyReturnNewCon arity\n  = ifTicky $ do { bumpTickyCounter (fsLit \"RET_NEW_ctr\")\n                 ; bumpHistogram    (fsLit \"RET_NEW_hst\") arity }\n\ntickyUnboxedTupleReturn :: RepArity -> FCode ()\ntickyUnboxedTupleReturn arity\n  = ifTicky $ do { bumpTickyCounter (fsLit \"RET_UNBOXED_TUP_ctr\")\n                 ; bumpHistogram    (fsLit \"RET_UNBOXED_TUP_hst\") arity }\n\n-- -----------------------------------------------------------------------------\n-- Ticky calls\n\n-- Ticks at a *call site*:\ntickyDirectCall :: RepArity -> [StgArg] -> FCode ()\ntickyDirectCall arity args\n  | args `lengthIs` arity = tickyKnownCallExact\n  | otherwise = do tickyKnownCallExtraArgs\n                   tickySlowCallPat (map argPrimRep (drop arity args))\n\ntickyKnownCallTooFewArgs :: FCode ()\ntickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (fsLit \"KNOWN_CALL_TOO_FEW_ARGS_ctr\")\n\ntickyKnownCallExact :: FCode ()\ntickyKnownCallExact      = ifTicky $ bumpTickyCounter (fsLit \"KNOWN_CALL_ctr\")\n\ntickyKnownCallExtraArgs :: FCode ()\ntickyKnownCallExtraArgs  = ifTicky $ bumpTickyCounter (fsLit \"KNOWN_CALL_EXTRA_ARGS_ctr\")\n\ntickyUnknownCall :: FCode ()\ntickyUnknownCall         = ifTicky $ bumpTickyCounter (fsLit \"UNKNOWN_CALL_ctr\")\n\n-- Tick for the call pattern at slow call site (i.e. in addition to\n-- tickyUnknownCall, tickyKnownCallExtraArgs, etc.)\ntickySlowCall :: LambdaFormInfo -> [StgArg] -> FCode ()\ntickySlowCall _ [] = return ()\ntickySlowCall lf_info args = do\n -- see Note [Ticky for slow calls]\n if isKnownFun lf_info\n   then tickyKnownCallTooFewArgs\n   else tickyUnknownCall\n tickySlowCallPat (map argPrimRep args)\n\ntickySlowCallPat :: [PrimRep] -> FCode ()\ntickySlowCallPat args = ifTicky $\n  let argReps = map toArgRep args\n      (_, n_matched) = slowCallPattern argReps\n  in if n_matched > 0 && args `lengthIs` n_matched\n     then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps\n     else bumpTickyCounter $ fsLit \"VERY_SLOW_CALL_ctr\"\n\n{-\n\nNote [Ticky for slow calls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTerminology is unfortunately a bit mixed up for these calls. codeGen\nuses \"slow call\" to refer to unknown calls and under-saturated known\ncalls.\n\nNowadays, though (ie as of the eval/apply paper), the significantly\nslower calls are actually just a subset of these: the ones with no\nbuilt-in argument pattern (cf StgCmmArgRep.slowCallPattern)\n\nSo for ticky profiling, we split slow calls into\n\"SLOW_CALL_fast_<pattern>_ctr\" (those matching a built-in pattern) and\nVERY_SLOW_CALL_ctr (those without a built-in pattern; these are very\nbad for both space and time).\n\n-}\n\n-- -----------------------------------------------------------------------------\n-- Ticky allocation\n\ntickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode ()\n-- Called when doing a dynamic heap allocation; the LambdaFormInfo\n-- used to distinguish between closure types\n--\n-- TODO what else to count while we're here?\ntickyDynAlloc mb_id rep lf = ifTicky $ getDynFlags >>= \\dflags ->\n  let bytes = wORD_SIZE dflags * heapClosureSizeW dflags rep\n\n      countGlobal tot ctr = do\n        bumpTickyCounterBy tot bytes\n        bumpTickyCounter   ctr\n      countSpecific = ifTickyAllocd $ case mb_id of\n        Nothing -> return ()\n        Just id -> do\n          let ctr_lbl = mkRednCountsLabel (idName id)\n          registerTickyCtr ctr_lbl\n          bumpTickyAllocd ctr_lbl bytes\n\n  -- TODO are we still tracking \"good stuff\" (_gds) versus\n  -- administrative (_adm) versus slop (_slp)? I'm going with all _gds\n  -- for now, since I don't currently know neither if we do nor how to\n  -- distinguish. NSF Mar 2013\n\n  in case () of\n    _ | isConRep rep   ->\n          ifTickyDynThunk countSpecific >>\n          countGlobal (fsLit \"ALLOC_CON_gds\") (fsLit \"ALLOC_CON_ctr\")\n      | isThunkRep rep ->\n          ifTickyDynThunk countSpecific >>\n          if lfUpdatable lf\n          then countGlobal (fsLit \"ALLOC_THK_gds\") (fsLit \"ALLOC_UP_THK_ctr\")\n          else countGlobal (fsLit \"ALLOC_THK_gds\") (fsLit \"ALLOC_SE_THK_ctr\")\n      | isFunRep   rep ->\n          countSpecific >>\n          countGlobal (fsLit \"ALLOC_FUN_gds\") (fsLit \"ALLOC_FUN_ctr\")\n      | otherwise      -> panic \"How is this heap object not a con, thunk, or fun?\"\n\n\n\ntickyAllocHeap ::\n  Bool -> -- is this a genuine allocation? As opposed to\n          -- StgCmmLayout.adjustHpBackwards\n  VirtualHpOffset -> FCode ()\n-- Called when doing a heap check [TICK_ALLOC_HEAP]\n-- Must be lazy in the amount of allocation!\ntickyAllocHeap genuine hp\n  = ifTicky $\n    do  { dflags <- getDynFlags\n        ; ticky_ctr <- getTickyCtrLabel\n        ; emit $ catAGraphs $\n            -- only test hp from within the emit so that the monadic\n            -- computation itself is not strict in hp (cf knot in\n            -- StgCmmMonad.getHeapUsage)\n          if hp == 0 then []\n          else let !bytes = wORD_SIZE dflags * hp in [\n            -- Bump the allocation total in the closure's StgEntCounter\n            addToMem (rEP_StgEntCounter_allocs dflags)\n                     (CmmLit (cmmLabelOffB ticky_ctr (oFFSET_StgEntCounter_allocs dflags)))\n                     bytes,\n            -- Bump the global allocation total ALLOC_HEAP_tot\n            addToMemLbl (bWord dflags)\n                        (mkCmmDataLabel rtsUnitId (fsLit \"ALLOC_HEAP_tot\"))\n                        bytes,\n            -- Bump the global allocation counter ALLOC_HEAP_ctr\n            if not genuine then mkNop\n            else addToMemLbl (bWord dflags)\n                             (mkCmmDataLabel rtsUnitId (fsLit \"ALLOC_HEAP_ctr\"))\n                             1\n            ]}\n\n\n--------------------------------------------------------------------------------\n-- these three are only called from CmmParse.y (ie ultimately from the RTS)\n\n-- the units are bytes\n\ntickyAllocPrim :: CmmExpr  -- ^ size of the full header, in bytes\n               -> CmmExpr  -- ^ size of the payload, in bytes\n               -> CmmExpr -> FCode ()\ntickyAllocPrim _hdr _goods _slop = ifTicky $ do\n  bumpTickyCounter    (fsLit \"ALLOC_PRIM_ctr\")\n  bumpTickyCounterByE (fsLit \"ALLOC_PRIM_adm\") _hdr\n  bumpTickyCounterByE (fsLit \"ALLOC_PRIM_gds\") _goods\n  bumpTickyCounterByE (fsLit \"ALLOC_PRIM_slp\") _slop\n\ntickyAllocThunk :: CmmExpr -> CmmExpr -> FCode ()\ntickyAllocThunk _goods _slop = ifTicky $ do\n    -- TODO is it ever called with a Single-Entry thunk?\n  bumpTickyCounter    (fsLit \"ALLOC_UP_THK_ctr\")\n  bumpTickyCounterByE (fsLit \"ALLOC_THK_gds\") _goods\n  bumpTickyCounterByE (fsLit \"ALLOC_THK_slp\") _slop\n\ntickyAllocPAP :: CmmExpr -> CmmExpr -> FCode ()\ntickyAllocPAP _goods _slop = ifTicky $ do\n  bumpTickyCounter    (fsLit \"ALLOC_PAP_ctr\")\n  bumpTickyCounterByE (fsLit \"ALLOC_PAP_gds\") _goods\n  bumpTickyCounterByE (fsLit \"ALLOC_PAP_slp\") _slop\n\ntickyHeapCheck :: FCode ()\ntickyHeapCheck = ifTicky $ bumpTickyCounter (fsLit \"HEAP_CHK_ctr\")\n\ntickyStackCheck :: FCode ()\ntickyStackCheck = ifTicky $ bumpTickyCounter (fsLit \"STK_CHK_ctr\")\n\n-- -----------------------------------------------------------------------------\n-- Ticky utils\n\nifTicky :: FCode () -> FCode ()\nifTicky code =\n  getDynFlags >>= \\dflags -> when (gopt Opt_Ticky dflags) code\n\ntickyAllocdIsOn :: FCode Bool\ntickyAllocdIsOn = gopt Opt_Ticky_Allocd `fmap` getDynFlags\n\ntickyLNEIsOn :: FCode Bool\ntickyLNEIsOn = gopt Opt_Ticky_LNE `fmap` getDynFlags\n\ntickyDynThunkIsOn :: FCode Bool\ntickyDynThunkIsOn = gopt Opt_Ticky_Dyn_Thunk `fmap` getDynFlags\n\nifTickyAllocd :: FCode () -> FCode ()\nifTickyAllocd code = tickyAllocdIsOn >>= \\b -> when b code\n\nifTickyLNE :: FCode () -> FCode ()\nifTickyLNE code = tickyLNEIsOn >>= \\b -> when b code\n\nifTickyDynThunk :: FCode () -> FCode ()\nifTickyDynThunk code = tickyDynThunkIsOn >>= \\b -> when b code\n\nbumpTickyCounter :: FastString -> FCode ()\nbumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsUnitId lbl)\n\nbumpTickyCounterBy :: FastString -> Int -> FCode ()\nbumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsUnitId lbl)\n\nbumpTickyCounterByE :: FastString -> CmmExpr -> FCode ()\nbumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsUnitId lbl)\n\nbumpTickyEntryCount :: CLabel -> FCode ()\nbumpTickyEntryCount lbl = do\n  dflags <- getDynFlags\n  bumpTickyLit (cmmLabelOffB lbl (oFFSET_StgEntCounter_entry_count dflags))\n\nbumpTickyAllocd :: CLabel -> Int -> FCode ()\nbumpTickyAllocd lbl bytes = do\n  dflags <- getDynFlags\n  bumpTickyLitBy (cmmLabelOffB lbl (oFFSET_StgEntCounter_allocd dflags)) bytes\n\nbumpTickyLbl :: CLabel -> FCode ()\nbumpTickyLbl lhs = bumpTickyLitBy (cmmLabelOffB lhs 0) 1\n\nbumpTickyLblBy :: CLabel -> Int -> FCode ()\nbumpTickyLblBy lhs = bumpTickyLitBy (cmmLabelOffB lhs 0)\n\nbumpTickyLblByE :: CLabel -> CmmExpr -> FCode ()\nbumpTickyLblByE lhs = bumpTickyLitByE (cmmLabelOffB lhs 0)\n\nbumpTickyLit :: CmmLit -> FCode ()\nbumpTickyLit lhs = bumpTickyLitBy lhs 1\n\nbumpTickyLitBy :: CmmLit -> Int -> FCode ()\nbumpTickyLitBy lhs n = do\n  dflags <- getDynFlags\n  emit (addToMem (bWord dflags) (CmmLit lhs) n)\n\nbumpTickyLitByE :: CmmLit -> CmmExpr -> FCode ()\nbumpTickyLitByE lhs e = do\n  dflags <- getDynFlags\n  emit (addToMemE (bWord dflags) (CmmLit lhs) e)\n\nbumpHistogram :: FastString -> Int -> FCode ()\nbumpHistogram lbl n = do\n    dflags <- getDynFlags\n    let offset = n `min` (tICKY_BIN_COUNT dflags - 1)\n    emit (addToMem (bWord dflags)\n           (cmmIndexExpr dflags\n                (wordWidth dflags)\n                (CmmLit (CmmLabel (mkCmmDataLabel rtsUnitId lbl)))\n                (CmmLit (CmmInt (fromIntegral offset) (wordWidth dflags))))\n           1)\n\n------------------------------------------------------------------\n-- Showing the \"type category\" for ticky-ticky profiling\n\nshowTypeCategory :: Type -> Char\n  {-\n        +           dictionary\n\n        >           function\n\n        {C,I,F,D,W} char, int, float, double, word\n        {c,i,f,d,w} unboxed ditto\n\n        T           tuple\n\n        P           other primitive type\n        p           unboxed ditto\n\n        L           list\n        E           enumeration type\n        S           other single-constructor type\n        M           other multi-constructor data-con type\n\n        .           other type\n\n        -           reserved for others to mark as \"uninteresting\"\n\n  Accurate as of Mar 2013, but I eliminated the Array category instead\n  of updating it, for simplicity. It's in P/p, I think --NSF\n\n    -}\nshowTypeCategory ty\n  | isDictTy ty = '+'\n  | otherwise = case tcSplitTyConApp_maybe ty of\n  Nothing -> '.'\n  Just (tycon, _) ->\n    (if isUnliftedTyCon tycon then Data.Char.toLower else id) $\n    let anyOf us = getUnique tycon `elem` us in\n    case () of\n      _ | anyOf [funTyConKey] -> '>'\n        | anyOf [charPrimTyConKey, charTyConKey] -> 'C'\n        | anyOf [doublePrimTyConKey, doubleTyConKey] -> 'D'\n        | anyOf [floatPrimTyConKey, floatTyConKey] -> 'F'\n        | anyOf [intPrimTyConKey, int32PrimTyConKey, int64PrimTyConKey,\n                 intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey\n                ] -> 'I'\n        | anyOf [wordPrimTyConKey, word32PrimTyConKey, word64PrimTyConKey, wordTyConKey,\n                 word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey\n                ] -> 'W'\n        | anyOf [listTyConKey] -> 'L'\n        | isTupleTyCon tycon       -> 'T'\n        | isPrimTyCon tycon        -> 'P'\n        | isEnumerationTyCon tycon -> 'E'\n        | isJust (tyConSingleDataCon_maybe tycon) -> 'S'\n        | otherwise -> 'M' -- oh, well...\n", "num_lines": 683}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Code generator utilities; mostly monadic\n--\n-- (c) The University of Glasgow 2004-2006\n--\n-----------------------------------------------------------------------------\n\nmodule StgCmmUtils (\n        cgLit, mkSimpleLit,\n        emitDataLits, mkDataLits,\n        emitRODataLits, mkRODataLits,\n        emitRtsCall, emitRtsCallWithResult, emitRtsCallGen,\n        assignTemp, newTemp,\n\n        newUnboxedTupleRegs,\n\n        emitMultiAssign, emitCmmLitSwitch, emitSwitch,\n\n        tagToClosure, mkTaggedObjectLoad,\n\n        callerSaves, callerSaveVolatileRegs, get_GlobalReg_addr,\n\n        cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,\n        cmmUGtWord, cmmSubWord, cmmMulWord, cmmAddWord, cmmUShrWord,\n        cmmOffsetExprW, cmmOffsetExprB,\n        cmmRegOffW, cmmRegOffB,\n        cmmLabelOffW, cmmLabelOffB,\n        cmmOffsetW, cmmOffsetB,\n        cmmOffsetLitW, cmmOffsetLitB,\n        cmmLoadIndexW,\n        cmmConstrTag1,\n\n        cmmUntag, cmmIsTagged,\n\n        addToMem, addToMemE, addToMemLblE, addToMemLbl,\n        mkWordCLit,\n        newStringCLit, newByteStringCLit,\n        blankWord,\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport StgCmmMonad\nimport StgCmmClosure\nimport Cmm\nimport BlockId\nimport MkGraph\nimport CodeGen.Platform\nimport CLabel\nimport CmmUtils\nimport CmmSwitch\n\nimport ForeignCall\nimport IdInfo\nimport Type\nimport TyCon\nimport SMRep\nimport Module\nimport Literal\nimport Digraph\nimport Util\nimport Unique\nimport UniqSupply (MonadUnique(..))\nimport DynFlags\nimport FastString\nimport Outputable\nimport RepType\n\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString.Char8 as BS8\nimport qualified Data.Map as M\nimport Data.Char\nimport Data.List\nimport Data.Ord\n\n\n-------------------------------------------------------------------------\n--\n--      Literals\n--\n-------------------------------------------------------------------------\n\ncgLit :: Literal -> FCode CmmLit\ncgLit (LitString s) = newByteStringCLit s\n -- not unpackFS; we want the UTF-8 byte stream.\ncgLit other_lit     = do dflags <- getDynFlags\n                         return (mkSimpleLit dflags other_lit)\n\nmkSimpleLit :: DynFlags -> Literal -> CmmLit\nmkSimpleLit dflags (LitChar   c)                = CmmInt (fromIntegral (ord c))\n                                                         (wordWidth dflags)\nmkSimpleLit dflags LitNullAddr                  = zeroCLit dflags\nmkSimpleLit dflags (LitNumber LitNumInt i _)    = CmmInt i (wordWidth dflags)\nmkSimpleLit _      (LitNumber LitNumInt64 i _)  = CmmInt i W64\nmkSimpleLit dflags (LitNumber LitNumWord i _)   = CmmInt i (wordWidth dflags)\nmkSimpleLit _      (LitNumber LitNumWord64 i _) = CmmInt i W64\nmkSimpleLit _      (LitFloat r)                 = CmmFloat r W32\nmkSimpleLit _      (LitDouble r)                = CmmFloat r W64\nmkSimpleLit _      (LitLabel fs ms fod)\n  = let -- TODO: Literal labels might not actually be in the current package...\n        labelSrc = ForeignLabelInThisPackage\n    in CmmLabel (mkForeignLabel fs ms labelSrc fod)\n-- NB: LitRubbish should have been lowered in \"CoreToStg\"\nmkSimpleLit _      other = pprPanic \"mkSimpleLit\" (ppr other)\n\n--------------------------------------------------------------------------\n--\n-- Incrementing a memory location\n--\n--------------------------------------------------------------------------\n\naddToMemLbl :: CmmType -> CLabel -> Int -> CmmAGraph\naddToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n\n\naddToMemLblE :: CmmType -> CLabel -> CmmExpr -> CmmAGraph\naddToMemLblE rep lbl = addToMemE rep (CmmLit (CmmLabel lbl))\n\naddToMem :: CmmType     -- rep of the counter\n         -> CmmExpr     -- Address\n         -> Int         -- What to add (a word)\n         -> CmmAGraph\naddToMem rep ptr n = addToMemE rep ptr (CmmLit (CmmInt (toInteger n) (typeWidth rep)))\n\naddToMemE :: CmmType    -- rep of the counter\n          -> CmmExpr    -- Address\n          -> CmmExpr    -- What to add (a word-typed expression)\n          -> CmmAGraph\naddToMemE rep ptr n\n  = mkStore ptr (CmmMachOp (MO_Add (typeWidth rep)) [CmmLoad ptr rep, n])\n\n\n-------------------------------------------------------------------------\n--\n--      Loading a field from an object,\n--      where the object pointer is itself tagged\n--\n-------------------------------------------------------------------------\n\nmkTaggedObjectLoad\n  :: DynFlags -> LocalReg -> LocalReg -> ByteOff -> DynTag -> CmmAGraph\n-- (loadTaggedObjectField reg base off tag) generates assignment\n--      reg = bitsK[ base + off - tag ]\n-- where K is fixed by 'reg'\nmkTaggedObjectLoad dflags reg base offset tag\n  = mkAssign (CmmLocal reg)\n             (CmmLoad (cmmOffsetB dflags\n                                  (CmmReg (CmmLocal base))\n                                  (offset - tag))\n                      (localRegType reg))\n\n-------------------------------------------------------------------------\n--\n--      Converting a closure tag to a closure for enumeration types\n--      (this is the implementation of tagToEnum#).\n--\n-------------------------------------------------------------------------\n\ntagToClosure :: DynFlags -> TyCon -> CmmExpr -> CmmExpr\ntagToClosure dflags tycon tag\n  = CmmLoad (cmmOffsetExprW dflags closure_tbl tag) (bWord dflags)\n  where closure_tbl = CmmLit (CmmLabel lbl)\n        lbl = mkClosureTableLabel (tyConName tycon) NoCafRefs\n\n-------------------------------------------------------------------------\n--\n--      Conditionals and rts calls\n--\n-------------------------------------------------------------------------\n\nemitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()\nemitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe\n\nemitRtsCallWithResult :: LocalReg -> ForeignHint -> UnitId -> FastString\n        -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()\nemitRtsCallWithResult res hint pkg fun args safe\n   = emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) args safe\n\n-- Make a call to an RTS C procedure\nemitRtsCallGen\n   :: [(LocalReg,ForeignHint)]\n   -> CLabel\n   -> [(CmmExpr,ForeignHint)]\n   -> Bool -- True <=> CmmSafe call\n   -> FCode ()\nemitRtsCallGen res lbl args safe\n  = do { dflags <- getDynFlags\n       ; updfr_off <- getUpdFrameOff\n       ; let (caller_save, caller_load) = callerSaveVolatileRegs dflags\n       ; emit caller_save\n       ; call updfr_off\n       ; emit caller_load }\n  where\n    call updfr_off =\n      if safe then\n        emit =<< mkCmmCall fun_expr res' args' updfr_off\n      else do\n        let conv = ForeignConvention CCallConv arg_hints res_hints CmmMayReturn\n        emit $ mkUnsafeCall (ForeignTarget fun_expr conv) res' args'\n    (args', arg_hints) = unzip args\n    (res',  res_hints) = unzip res\n    fun_expr = mkLblExpr lbl\n\n\n-----------------------------------------------------------------------------\n--\n--      Caller-Save Registers\n--\n-----------------------------------------------------------------------------\n\n-- Here we generate the sequence of saves/restores required around a\n-- foreign call instruction.\n\n-- TODO: reconcile with includes/Regs.h\n--  * Regs.h claims that BaseReg should be saved last and loaded first\n--    * This might not have been tickled before since BaseReg is callee save\n--  * Regs.h saves SparkHd, ParkT1, SparkBase and SparkLim\n--\n-- This code isn't actually used right now, because callerSaves\n-- only ever returns true in the current universe for registers NOT in\n-- system_regs (just do a grep for CALLER_SAVES in\n-- includes/stg/MachRegs.h).  It's all one giant no-op, and for\n-- good reason: having to save system registers on every foreign call\n-- would be very expensive, so we avoid assigning them to those\n-- registers when we add support for an architecture.\n--\n-- Note that the old code generator actually does more work here: it\n-- also saves other global registers.  We can't (nor want) to do that\n-- here, as we don't have liveness information.  And really, we\n-- shouldn't be doing the workaround at this point in the pipeline, see\n-- Note [Register parameter passing] and the ToDo on CmmCall in\n-- cmm/CmmNode.hs.  Right now the workaround is to avoid inlining across\n-- unsafe foreign calls in rewriteAssignments, but this is strictly\n-- temporary.\ncallerSaveVolatileRegs :: DynFlags -> (CmmAGraph, CmmAGraph)\ncallerSaveVolatileRegs dflags = (caller_save, caller_load)\n  where\n    platform = targetPlatform dflags\n\n    caller_save = catAGraphs (map callerSaveGlobalReg    regs_to_save)\n    caller_load = catAGraphs (map callerRestoreGlobalReg regs_to_save)\n\n    system_regs = [ Sp,SpLim,Hp,HpLim,CCCS,CurrentTSO,CurrentNursery\n                    {- ,SparkHd,SparkTl,SparkBase,SparkLim -}\n                  , BaseReg ]\n\n    regs_to_save = filter (callerSaves platform) system_regs\n\n    callerSaveGlobalReg reg\n        = mkStore (get_GlobalReg_addr dflags reg) (CmmReg (CmmGlobal reg))\n\n    callerRestoreGlobalReg reg\n        = mkAssign (CmmGlobal reg)\n                   (CmmLoad (get_GlobalReg_addr dflags reg) (globalRegType dflags reg))\n\n-- -----------------------------------------------------------------------------\n-- Global registers\n\n-- We map STG registers onto appropriate CmmExprs.  Either they map\n-- to real machine registers or stored as offsets from BaseReg.  Given\n-- a GlobalReg, get_GlobalReg_addr always produces the\n-- register table address for it.\n-- (See also get_GlobalReg_reg_or_addr in MachRegs)\n\nget_GlobalReg_addr :: DynFlags -> GlobalReg -> CmmExpr\nget_GlobalReg_addr dflags BaseReg = regTableOffset dflags 0\nget_GlobalReg_addr dflags mid\n    = get_Regtable_addr_from_offset dflags\n                                    (globalRegType dflags mid) (baseRegOffset dflags mid)\n\n-- Calculate a literal representing an offset into the register table.\n-- Used when we don't have an actual BaseReg to offset from.\nregTableOffset :: DynFlags -> Int -> CmmExpr\nregTableOffset dflags n =\n  CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r dflags + n))\n\nget_Regtable_addr_from_offset :: DynFlags -> CmmType -> Int -> CmmExpr\nget_Regtable_addr_from_offset dflags _rep offset =\n    if haveRegBase (targetPlatform dflags)\n    then CmmRegOff baseReg offset\n    else regTableOffset dflags offset\n\n\n-- -----------------------------------------------------------------------------\n-- Information about global registers\n\nbaseRegOffset :: DynFlags -> GlobalReg -> Int\n\nbaseRegOffset dflags Sp             = oFFSET_StgRegTable_rSp dflags\nbaseRegOffset dflags SpLim          = oFFSET_StgRegTable_rSpLim dflags\nbaseRegOffset dflags (LongReg 1)    = oFFSET_StgRegTable_rL1 dflags\nbaseRegOffset dflags Hp             = oFFSET_StgRegTable_rHp dflags\nbaseRegOffset dflags HpLim          = oFFSET_StgRegTable_rHpLim dflags\nbaseRegOffset dflags CCCS           = oFFSET_StgRegTable_rCCCS dflags\nbaseRegOffset dflags CurrentTSO     = oFFSET_StgRegTable_rCurrentTSO dflags\nbaseRegOffset dflags CurrentNursery = oFFSET_StgRegTable_rCurrentNursery dflags\nbaseRegOffset dflags HpAlloc        = oFFSET_StgRegTable_rHpAlloc dflags\nbaseRegOffset dflags GCEnter1       = oFFSET_stgGCEnter1 dflags\nbaseRegOffset dflags GCFun          = oFFSET_stgGCFun dflags\nbaseRegOffset _      reg            = pprPanic \"StgCmmUtils.baseRegOffset:\" (ppr reg)\n\n-------------------------------------------------------------------------\n--\n--      Strings generate a top-level data block\n--\n-------------------------------------------------------------------------\n\nemitDataLits :: CLabel -> [CmmLit] -> FCode ()\n-- Emit a data-segment data block\nemitDataLits lbl lits = emitDecl (mkDataLits (Section Data lbl) lbl lits)\n\nemitRODataLits :: CLabel -> [CmmLit] -> FCode ()\n-- Emit a read-only data block\nemitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits)\n\nnewStringCLit :: String -> FCode CmmLit\n-- Make a global definition for the string,\n-- and return its label\nnewStringCLit str = newByteStringCLit (BS8.pack str)\n\nnewByteStringCLit :: ByteString -> FCode CmmLit\nnewByteStringCLit bytes\n  = do  { uniq <- newUnique\n        ; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes\n        ; emitDecl decl\n        ; return lit }\n\n-------------------------------------------------------------------------\n--\n--      Assigning expressions to temporaries\n--\n-------------------------------------------------------------------------\n\nassignTemp :: CmmExpr -> FCode LocalReg\n-- Make sure the argument is in a local register.\n-- We don't bother being particularly aggressive with avoiding\n-- unnecessary local registers, since we can rely on a later\n-- optimization pass to inline as necessary (and skipping out\n-- on things like global registers can be a little dangerous\n-- due to them being trashed on foreign calls--though it means\n-- the optimization pass doesn't have to do as much work)\nassignTemp (CmmReg (CmmLocal reg)) = return reg\nassignTemp e = do { dflags <- getDynFlags\n                  ; uniq <- newUnique\n                  ; let reg = LocalReg uniq (cmmExprType dflags e)\n                  ; emitAssign (CmmLocal reg) e\n                  ; return reg }\n\nnewTemp :: MonadUnique m => CmmType -> m LocalReg\nnewTemp rep = do { uniq <- getUniqueM\n                 ; return (LocalReg uniq rep) }\n\nnewUnboxedTupleRegs :: Type -> FCode ([LocalReg], [ForeignHint])\n-- Choose suitable local regs to use for the components\n-- of an unboxed tuple that we are about to return to\n-- the Sequel.  If the Sequel is a join point, using the\n-- regs it wants will save later assignments.\nnewUnboxedTupleRegs res_ty\n  = ASSERT( isUnboxedTupleType res_ty )\n    do  { dflags <- getDynFlags\n        ; sequel <- getSequel\n        ; regs <- choose_regs dflags sequel\n        ; ASSERT( regs `equalLength` reps )\n          return (regs, map primRepForeignHint reps) }\n  where\n    reps = typePrimRep res_ty\n    choose_regs _ (AssignTo regs _) = return regs\n    choose_regs dflags _            = mapM (newTemp . primRepCmmType dflags) reps\n\n\n\n-------------------------------------------------------------------------\n--      emitMultiAssign\n-------------------------------------------------------------------------\n\nemitMultiAssign :: [LocalReg] -> [CmmExpr] -> FCode ()\n-- Emit code to perform the assignments in the\n-- input simultaneously, using temporary variables when necessary.\n\ntype Key  = Int\ntype Vrtx = (Key, Stmt) -- Give each vertex a unique number,\n                        -- for fast comparison\ntype Stmt = (LocalReg, CmmExpr) -- r := e\n\n-- We use the strongly-connected component algorithm, in which\n--      * the vertices are the statements\n--      * an edge goes from s1 to s2 iff\n--              s1 assigns to something s2 uses\n--        that is, if s1 should *follow* s2 in the final order\n\nemitMultiAssign []    []    = return ()\nemitMultiAssign [reg] [rhs] = emitAssign (CmmLocal reg) rhs\nemitMultiAssign regs rhss   = do\n  dflags <- getDynFlags\n  ASSERT2( equalLength regs rhss, ppr regs $$ ppr rhss )\n    unscramble dflags ([1..] `zip` (regs `zip` rhss))\n\nunscramble :: DynFlags -> [Vrtx] -> FCode ()\nunscramble dflags vertices = mapM_ do_component components\n  where\n        edges :: [ Node Key Vrtx ]\n        edges = [ DigraphNode vertex key1 (edges_from stmt1)\n                | vertex@(key1, stmt1) <- vertices ]\n\n        edges_from :: Stmt -> [Key]\n        edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices,\n                                    stmt1 `mustFollow` stmt2 ]\n\n        components :: [SCC Vrtx]\n        components = stronglyConnCompFromEdgedVerticesUniq edges\n\n        -- do_components deal with one strongly-connected component\n        -- Not cyclic, or singleton?  Just do it\n        do_component :: SCC Vrtx -> FCode ()\n        do_component (AcyclicSCC (_,stmt))  = mk_graph stmt\n        do_component (CyclicSCC [])         = panic \"do_component\"\n        do_component (CyclicSCC [(_,stmt)]) = mk_graph stmt\n\n                -- Cyclic?  Then go via temporaries.  Pick one to\n                -- break the loop and try again with the rest.\n        do_component (CyclicSCC ((_,first_stmt) : rest)) = do\n            dflags <- getDynFlags\n            u <- newUnique\n            let (to_tmp, from_tmp) = split dflags u first_stmt\n            mk_graph to_tmp\n            unscramble dflags rest\n            mk_graph from_tmp\n\n        split :: DynFlags -> Unique -> Stmt -> (Stmt, Stmt)\n        split dflags uniq (reg, rhs)\n          = ((tmp, rhs), (reg, CmmReg (CmmLocal tmp)))\n          where\n            rep = cmmExprType dflags rhs\n            tmp = LocalReg uniq rep\n\n        mk_graph :: Stmt -> FCode ()\n        mk_graph (reg, rhs) = emitAssign (CmmLocal reg) rhs\n\n        mustFollow :: Stmt -> Stmt -> Bool\n        (reg, _) `mustFollow` (_, rhs) = regUsedIn dflags (CmmLocal reg) rhs\n\n-------------------------------------------------------------------------\n--      mkSwitch\n-------------------------------------------------------------------------\n\n\nemitSwitch :: CmmExpr                      -- Tag to switch on\n           -> [(ConTagZ, CmmAGraphScoped)] -- Tagged branches\n           -> Maybe CmmAGraphScoped        -- Default branch (if any)\n           -> ConTagZ -> ConTagZ           -- Min and Max possible values;\n                                           -- behaviour outside this range is\n                                           -- undefined\n           -> FCode ()\n\n-- First, two rather common cases in which there is no work to do\nemitSwitch _ []         (Just code) _ _ = emit (fst code)\nemitSwitch _ [(_,code)] Nothing     _ _ = emit (fst code)\n\n-- Right, off we go\nemitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do\n    join_lbl      <- newBlockId\n    mb_deflt_lbl  <- label_default join_lbl mb_deflt\n    branches_lbls <- label_branches join_lbl branches\n    tag_expr'     <- assignTemp' tag_expr\n\n    -- Sort the branches before calling mk_discrete_switch\n    let branches_lbls' = [ (fromIntegral i, l) | (i,l) <- sortBy (comparing fst) branches_lbls ]\n    let range = (fromIntegral lo_tag, fromIntegral hi_tag)\n\n    emit $ mk_discrete_switch False tag_expr' branches_lbls' mb_deflt_lbl range\n\n    emitLabel join_lbl\n\nmk_discrete_switch :: Bool -- ^ Use signed comparisons\n          -> CmmExpr\n          -> [(Integer, BlockId)]\n          -> Maybe BlockId\n          -> (Integer, Integer)\n          -> CmmAGraph\n\n-- SINGLETON TAG RANGE: no case analysis to do\nmk_discrete_switch _ _tag_expr [(tag, lbl)] _ (lo_tag, hi_tag)\n  | lo_tag == hi_tag\n  = ASSERT( tag == lo_tag )\n    mkBranch lbl\n\n-- SINGLETON BRANCH, NO DEFAULT: no case analysis to do\nmk_discrete_switch _ _tag_expr [(_tag,lbl)] Nothing _\n  = mkBranch lbl\n        -- The simplifier might have eliminated a case\n        --       so we may have e.g. case xs of\n        --                               [] -> e\n        -- In that situation we can be sure the (:) case\n        -- can't happen, so no need to test\n\n-- SOMETHING MORE COMPLICATED: defer to CmmImplementSwitchPlans\n-- See Note [Cmm Switches, the general plan] in CmmSwitch\nmk_discrete_switch signed tag_expr branches mb_deflt range\n  = mkSwitch tag_expr $ mkSwitchTargets signed range mb_deflt (M.fromList branches)\n\ndivideBranches :: Ord a => [(a,b)] -> ([(a,b)], a, [(a,b)])\ndivideBranches branches = (lo_branches, mid, hi_branches)\n  where\n    -- 2 branches => n_branches `div` 2 = 1\n    --            => branches !! 1 give the *second* tag\n    -- There are always at least 2 branches here\n    (mid,_) = branches !! (length branches `div` 2)\n    (lo_branches, hi_branches) = span is_lo branches\n    is_lo (t,_) = t < mid\n\n--------------\nemitCmmLitSwitch :: CmmExpr                    -- Tag to switch on\n               -> [(Literal, CmmAGraphScoped)] -- Tagged branches\n               -> CmmAGraphScoped              -- Default branch (always)\n               -> FCode ()                     -- Emit the code\nemitCmmLitSwitch _scrut []       deflt = emit $ fst deflt\nemitCmmLitSwitch scrut  branches deflt = do\n    scrut' <- assignTemp' scrut\n    join_lbl <- newBlockId\n    deflt_lbl <- label_code join_lbl deflt\n    branches_lbls <- label_branches join_lbl branches\n\n    dflags <- getDynFlags\n    let cmm_ty = cmmExprType dflags scrut\n        rep = typeWidth cmm_ty\n\n    -- We find the necessary type information in the literals in the branches\n    let signed = case head branches of\n                    (LitNumber nt _ _, _) -> litNumIsSigned nt\n                    _ -> False\n\n    let range | signed    = (tARGET_MIN_INT dflags, tARGET_MAX_INT dflags)\n              | otherwise = (0, tARGET_MAX_WORD dflags)\n\n    if isFloatType cmm_ty\n    then emit =<< mk_float_switch rep scrut' deflt_lbl noBound branches_lbls\n    else emit $ mk_discrete_switch\n        signed\n        scrut'\n        [(litValue lit,l) | (lit,l) <- branches_lbls]\n        (Just deflt_lbl)\n        range\n    emitLabel join_lbl\n\n-- | lower bound (inclusive), upper bound (exclusive)\ntype LitBound = (Maybe Literal, Maybe Literal)\n\nnoBound :: LitBound\nnoBound = (Nothing, Nothing)\n\nmk_float_switch :: Width -> CmmExpr -> BlockId\n              -> LitBound\n              -> [(Literal,BlockId)]\n              -> FCode CmmAGraph\nmk_float_switch rep scrut deflt _bounds [(lit,blk)]\n  = do dflags <- getDynFlags\n       return $ mkCbranch (cond dflags) deflt blk Nothing\n  where\n    cond dflags = CmmMachOp ne [scrut, CmmLit cmm_lit]\n      where\n        cmm_lit = mkSimpleLit dflags lit\n        ne      = MO_F_Ne rep\n\nmk_float_switch rep scrut deflt_blk_id (lo_bound, hi_bound) branches\n  = do dflags <- getDynFlags\n       lo_blk <- mk_float_switch rep scrut deflt_blk_id bounds_lo lo_branches\n       hi_blk <- mk_float_switch rep scrut deflt_blk_id bounds_hi hi_branches\n       mkCmmIfThenElse (cond dflags) lo_blk hi_blk\n  where\n    (lo_branches, mid_lit, hi_branches) = divideBranches branches\n\n    bounds_lo = (lo_bound, Just mid_lit)\n    bounds_hi = (Just mid_lit, hi_bound)\n\n    cond dflags = CmmMachOp lt [scrut, CmmLit cmm_lit]\n      where\n        cmm_lit = mkSimpleLit dflags mid_lit\n        lt      = MO_F_Lt rep\n\n\n--------------\nlabel_default :: BlockId -> Maybe CmmAGraphScoped -> FCode (Maybe BlockId)\nlabel_default _ Nothing\n  = return Nothing\nlabel_default join_lbl (Just code)\n  = do lbl <- label_code join_lbl code\n       return (Just lbl)\n\n--------------\nlabel_branches :: BlockId -> [(a,CmmAGraphScoped)] -> FCode [(a,BlockId)]\nlabel_branches _join_lbl []\n  = return []\nlabel_branches join_lbl ((tag,code):branches)\n  = do lbl <- label_code join_lbl code\n       branches' <- label_branches join_lbl branches\n       return ((tag,lbl):branches')\n\n--------------\nlabel_code :: BlockId -> CmmAGraphScoped -> FCode BlockId\n--  label_code J code\n--      generates\n--  [L: code; goto J]\n-- and returns L\nlabel_code join_lbl (code,tsc) = do\n    lbl <- newBlockId\n    emitOutOfLine lbl (code MkGraph.<*> mkBranch join_lbl, tsc)\n    return lbl\n\n--------------\nassignTemp' :: CmmExpr -> FCode CmmExpr\nassignTemp' e\n  | isTrivialCmmExpr e = return e\n  | otherwise = do\n       dflags <- getDynFlags\n       lreg <- newTemp (cmmExprType dflags e)\n       let reg = CmmLocal lreg\n       emitAssign reg e\n       return (CmmReg reg)\n", "num_lines": 623}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule CodeGen.Platform\n       (callerSaves, activeStgRegs, haveRegBase, globalRegMaybe, freeReg)\n       where\n\nimport GhcPrelude\n\nimport CmmExpr\nimport Platform\nimport Reg\n\nimport qualified CodeGen.Platform.ARM        as ARM\nimport qualified CodeGen.Platform.ARM64      as ARM64\nimport qualified CodeGen.Platform.PPC        as PPC\nimport qualified CodeGen.Platform.SPARC      as SPARC\nimport qualified CodeGen.Platform.X86        as X86\nimport qualified CodeGen.Platform.X86_64     as X86_64\nimport qualified CodeGen.Platform.NoRegs     as NoRegs\n\n-- | Returns 'True' if this global register is stored in a caller-saves\n-- machine register.\n\ncallerSaves :: Platform -> GlobalReg -> Bool\ncallerSaves platform\n | platformUnregisterised platform = NoRegs.callerSaves\n | otherwise\n = case platformArch platform of\n   ArchX86    -> X86.callerSaves\n   ArchX86_64 -> X86_64.callerSaves\n   ArchSPARC  -> SPARC.callerSaves\n   ArchARM {} -> ARM.callerSaves\n   ArchARM64  -> ARM64.callerSaves\n   arch\n    | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->\n        PPC.callerSaves\n\n    | otherwise -> NoRegs.callerSaves\n\n-- | Here is where the STG register map is defined for each target arch.\n-- The order matters (for the llvm backend anyway)! We must make sure to\n-- maintain the order here with the order used in the LLVM calling conventions.\n-- Note that also, this isn't all registers, just the ones that are currently\n-- possbily mapped to real registers.\nactiveStgRegs :: Platform -> [GlobalReg]\nactiveStgRegs platform\n | platformUnregisterised platform = NoRegs.activeStgRegs\n | otherwise\n = case platformArch platform of\n   ArchX86    -> X86.activeStgRegs\n   ArchX86_64 -> X86_64.activeStgRegs\n   ArchSPARC  -> SPARC.activeStgRegs\n   ArchARM {} -> ARM.activeStgRegs\n   ArchARM64  -> ARM64.activeStgRegs\n   arch\n    | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->\n        PPC.activeStgRegs\n\n    | otherwise -> NoRegs.activeStgRegs\n\nhaveRegBase :: Platform -> Bool\nhaveRegBase platform\n | platformUnregisterised platform = NoRegs.haveRegBase\n | otherwise\n = case platformArch platform of\n   ArchX86    -> X86.haveRegBase\n   ArchX86_64 -> X86_64.haveRegBase\n   ArchSPARC  -> SPARC.haveRegBase\n   ArchARM {} -> ARM.haveRegBase\n   ArchARM64  -> ARM64.haveRegBase\n   arch\n    | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->\n        PPC.haveRegBase\n\n    | otherwise -> NoRegs.haveRegBase\n\nglobalRegMaybe :: Platform -> GlobalReg -> Maybe RealReg\nglobalRegMaybe platform\n | platformUnregisterised platform = NoRegs.globalRegMaybe\n | otherwise\n = case platformArch platform of\n   ArchX86    -> X86.globalRegMaybe\n   ArchX86_64 -> X86_64.globalRegMaybe\n   ArchSPARC  -> SPARC.globalRegMaybe\n   ArchARM {} -> ARM.globalRegMaybe\n   ArchARM64  -> ARM64.globalRegMaybe\n   arch\n    | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->\n        PPC.globalRegMaybe\n\n    | otherwise -> NoRegs.globalRegMaybe\n\nfreeReg :: Platform -> RegNo -> Bool\nfreeReg platform\n | platformUnregisterised platform = NoRegs.freeReg\n | otherwise\n = case platformArch platform of\n   ArchX86    -> X86.freeReg\n   ArchX86_64 -> X86_64.freeReg\n   ArchSPARC  -> SPARC.freeReg\n   ArchARM {} -> ARM.freeReg\n   ArchARM64  -> ARM64.freeReg\n   arch\n    | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->\n        PPC.freeReg\n\n    | otherwise -> NoRegs.freeReg\n\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule CodeGen.Platform.ARM where\n\nimport GhcPrelude\n\n#define MACHREGS_NO_REGS 0\n#define MACHREGS_arm 1\n#include \"../../../../includes/CodeGen.Platform.hs\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule CodeGen.Platform.ARM64 where\n\nimport GhcPrelude\n\n#define MACHREGS_NO_REGS 0\n#define MACHREGS_aarch64 1\n#include \"../../../../includes/CodeGen.Platform.hs\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule CodeGen.Platform.NoRegs where\n\nimport GhcPrelude\n\n#define MACHREGS_NO_REGS 1\n#include \"../../../../includes/CodeGen.Platform.hs\"\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule CodeGen.Platform.PPC where\n\nimport GhcPrelude\n\n#define MACHREGS_NO_REGS 0\n#define MACHREGS_powerpc 1\n#include \"../../../../includes/CodeGen.Platform.hs\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule CodeGen.Platform.SPARC where\n\nimport GhcPrelude\n\n#define MACHREGS_NO_REGS 0\n#define MACHREGS_sparc 1\n#include \"../../../../includes/CodeGen.Platform.hs\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule CodeGen.Platform.X86 where\n\nimport GhcPrelude\n\n#define MACHREGS_NO_REGS 0\n#define MACHREGS_i386 1\n#include \"../../../../includes/CodeGen.Platform.hs\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule CodeGen.Platform.X86_64 where\n\nimport GhcPrelude\n\n#define MACHREGS_NO_REGS 0\n#define MACHREGS_x86_64 1\n#include \"../../../../includes/CodeGen.Platform.hs\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\n        Arity and eta expansion\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- | Arity and eta expansion\nmodule CoreArity (\n        manifestArity, joinRhsArity, exprArity, typeArity,\n        exprEtaExpandArity, findRhsArity, CheapFun, etaExpand,\n        etaExpandToJoinPoint, etaExpandToJoinPointRule,\n        exprBotStrictness_maybe\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreFVs\nimport CoreUtils\nimport CoreSubst\nimport Demand\nimport Var\nimport VarEnv\nimport Id\nimport Type\nimport TyCon    ( initRecTc, checkRecTc )\nimport Coercion\nimport BasicTypes\nimport Unique\nimport DynFlags ( DynFlags, GeneralFlag(..), gopt )\nimport Outputable\nimport FastString\nimport Pair\nimport Util     ( debugIsOn )\n\n{-\n************************************************************************\n*                                                                      *\n              manifestArity and exprArity\n*                                                                      *\n************************************************************************\n\nexprArity is a cheap-and-cheerful version of exprEtaExpandArity.\nIt tells how many things the expression can be applied to before doing\nany work.  It doesn't look inside cases, lets, etc.  The idea is that\nexprEtaExpandArity will do the hard work, leaving something that's easy\nfor exprArity to grapple with.  In particular, Simplify uses exprArity to\ncompute the ArityInfo for the Id.\n\nOriginally I thought that it was enough just to look for top-level lambdas, but\nit isn't.  I've seen this\n\n        foo = PrelBase.timesInt\n\nWe want foo to get arity 2 even though the eta-expander will leave it\nunchanged, in the expectation that it'll be inlined.  But occasionally it\nisn't, because foo is blacklisted (used in a rule).\n\nSimilarly, see the ok_note check in exprEtaExpandArity.  So\n        f = __inline_me (\\x -> e)\nwon't be eta-expanded.\n\nAnd in any case it seems more robust to have exprArity be a bit more intelligent.\nBut note that   (\\x y z -> f x y z)\nshould have arity 3, regardless of f's arity.\n-}\n\nmanifestArity :: CoreExpr -> Arity\n-- ^ manifestArity sees how many leading value lambdas there are,\n--   after looking through casts\nmanifestArity (Lam v e) | isId v        = 1 + manifestArity e\n                        | otherwise     = manifestArity e\nmanifestArity (Tick t e) | not (tickishIsCode t) =  manifestArity e\nmanifestArity (Cast e _)                = manifestArity e\nmanifestArity _                         = 0\n\njoinRhsArity :: CoreExpr -> JoinArity\n-- Join points are supposed to have manifestly-visible\n-- lambdas at the top: no ticks, no casts, nothing\n-- Moreover, type lambdas count in JoinArity\njoinRhsArity (Lam _ e) = 1 + joinRhsArity e\njoinRhsArity _         = 0\n\n\n---------------\nexprArity :: CoreExpr -> Arity\n-- ^ An approximate, fast, version of 'exprEtaExpandArity'\nexprArity e = go e\n  where\n    go (Var v)                     = idArity v\n    go (Lam x e) | isId x          = go e + 1\n                 | otherwise       = go e\n    go (Tick t e) | not (tickishIsCode t) = go e\n    go (Cast e co)                 = trim_arity (go e) (pSnd (coercionKind co))\n                                        -- Note [exprArity invariant]\n    go (App e (Type _))            = go e\n    go (App f a) | exprIsTrivial a = (go f - 1) `max` 0\n        -- See Note [exprArity for applications]\n        -- NB: coercions count as a value argument\n\n    go _                           = 0\n\n    trim_arity :: Arity -> Type -> Arity\n    trim_arity arity ty = arity `min` length (typeArity ty)\n\n---------------\ntypeArity :: Type -> [OneShotInfo]\n-- How many value arrows are visible in the type?\n-- We look through foralls, and newtypes\n-- See Note [exprArity invariant]\ntypeArity ty\n  = go initRecTc ty\n  where\n    go rec_nts ty\n      | Just (_, ty')  <- splitForAllTy_maybe ty\n      = go rec_nts ty'\n\n      | Just (arg,res) <- splitFunTy_maybe ty\n      = typeOneShot arg : go rec_nts res\n\n      | Just (tc,tys) <- splitTyConApp_maybe ty\n      , Just (ty', _) <- instNewTyCon_maybe tc tys\n      , Just rec_nts' <- checkRecTc rec_nts tc  -- See Note [Expanding newtypes]\n                                                -- in TyCon\n--   , not (isClassTyCon tc)    -- Do not eta-expand through newtype classes\n--                              -- See Note [Newtype classes and eta expansion]\n--                              (no longer required)\n      = go rec_nts' ty'\n        -- Important to look through non-recursive newtypes, so that, eg\n        --      (f x)   where f has arity 2, f :: Int -> IO ()\n        -- Here we want to get arity 1 for the result!\n        --\n        -- AND through a layer of recursive newtypes\n        -- e.g. newtype Stream m a b = Stream (m (Either b (a, Stream m a b)))\n\n      | otherwise\n      = []\n\n---------------\nexprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig)\n-- A cheap and cheerful function that identifies bottoming functions\n-- and gives them a suitable strictness signatures.  It's used during\n-- float-out\nexprBotStrictness_maybe e\n  = case getBotArity (arityType env e) of\n        Nothing -> Nothing\n        Just ar -> Just (ar, sig ar)\n  where\n    env    = AE { ae_ped_bot = True, ae_cheap_fn = \\ _ _ -> False }\n    sig ar = mkClosedStrictSig (replicate ar topDmd) botRes\n\n{-\nNote [exprArity invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nexprArity has the following invariant:\n\n  (1) If typeArity (exprType e) = n,\n      then manifestArity (etaExpand e n) = n\n\n      That is, etaExpand can always expand as much as typeArity says\n      So the case analysis in etaExpand and in typeArity must match\n\n  (2) exprArity e <= typeArity (exprType e)\n\n  (3) Hence if (exprArity e) = n, then manifestArity (etaExpand e n) = n\n\n      That is, if exprArity says \"the arity is n\" then etaExpand really\n      can get \"n\" manifest lambdas to the top.\n\nWhy is this important?  Because\n  - In TidyPgm we use exprArity to fix the *final arity* of\n    each top-level Id, and in\n  - In CorePrep we use etaExpand on each rhs, so that the visible lambdas\n    actually match that arity, which in turn means\n    that the StgRhs has the right number of lambdas\n\nAn alternative would be to do the eta-expansion in TidyPgm, at least\nfor top-level bindings, in which case we would not need the trim_arity\nin exprArity.  That is a less local change, so I'm going to leave it for today!\n\nNote [Newtype classes and eta expansion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    NB: this nasty special case is no longer required, because\n    for newtype classes we don't use the class-op rule mechanism\n    at all.  See Note [Single-method classes] in TcInstDcls. SLPJ May 2013\n\n-------- Old out of date comments, just for interest -----------\nWe have to be careful when eta-expanding through newtypes.  In general\nit's a good idea, but annoyingly it interacts badly with the class-op\nrule mechanism.  Consider\n\n   class C a where { op :: a -> a }\n   instance C b => C [b] where\n     op x = ...\n\nThese translate to\n\n   co :: forall a. (a->a) ~ C a\n\n   $copList :: C b -> [b] -> [b]\n   $copList d x = ...\n\n   $dfList :: C b -> C [b]\n   {-# DFunUnfolding = [$copList] #-}\n   $dfList d = $copList d |> co@[b]\n\nNow suppose we have:\n\n   dCInt :: C Int\n\n   blah :: [Int] -> [Int]\n   blah = op ($dfList dCInt)\n\nNow we want the built-in op/$dfList rule will fire to give\n   blah = $copList dCInt\n\nBut with eta-expansion 'blah' might (and in Trac #3772, which is\nslightly more complicated, does) turn into\n\n   blah = op (\\eta. ($dfList dCInt |> sym co) eta)\n\nand now it is *much* harder for the op/$dfList rule to fire, because\nexprIsConApp_maybe won't hold of the argument to op.  I considered\ntrying to *make* it hold, but it's tricky and I gave up.\n\nThe test simplCore/should_compile/T3722 is an excellent example.\n-------- End of old out of date comments, just for interest -----------\n\n\nNote [exprArity for applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we come to an application we check that the arg is trivial.\n   eg  f (fac x) does not have arity 2,\n                 even if f has arity 3!\n\n* We require that is trivial rather merely cheap.  Suppose f has arity 2.\n  Then    f (Just y)\n  has arity 0, because if we gave it arity 1 and then inlined f we'd get\n          let v = Just y in \\w. <f-body>\n  which has arity 0.  And we try to maintain the invariant that we don't\n  have arity decreases.\n\n*  The `max 0` is important!  (\\x y -> f x) has arity 2, even if f is\n   unknown, hence arity 0\n\n\n************************************************************************\n*                                                                      *\n           Computing the \"arity\" of an expression\n*                                                                      *\n************************************************************************\n\nNote [Definition of arity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe \"arity\" of an expression 'e' is n if\n   applying 'e' to *fewer* than n *value* arguments\n   converges rapidly\n\nOr, to put it another way\n\n   there is no work lost in duplicating the partial\n   application (e x1 .. x(n-1))\n\nIn the divegent case, no work is lost by duplicating because if the thing\nis evaluated once, that's the end of the program.\n\nOr, to put it another way, in any context C\n\n   C[ (\\x1 .. xn. e x1 .. xn) ]\n         is as efficient as\n   C[ e ]\n\nIt's all a bit more subtle than it looks:\n\nNote [One-shot lambdas]\n~~~~~~~~~~~~~~~~~~~~~~~\nConsider one-shot lambdas\n                let x = expensive in \\y z -> E\nWe want this to have arity 1 if the \\y-abstraction is a 1-shot lambda.\n\nNote [Dealing with bottom]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nA Big Deal with computing arities is expressions like\n\n   f = \\x -> case x of\n               True  -> \\s -> e1\n               False -> \\s -> e2\n\nThis happens all the time when f :: Bool -> IO ()\nIn this case we do eta-expand, in order to get that \\s to the\ntop, and give f arity 2.\n\nThis isn't really right in the presence of seq.  Consider\n        (f bot) `seq` 1\n\nThis should diverge!  But if we eta-expand, it won't.  We ignore this\n\"problem\" (unless -fpedantic-bottoms is on), because being scrupulous\nwould lose an important transformation for many programs. (See\nTrac #5587 for an example.)\n\nConsider also\n        f = \\x -> error \"foo\"\nHere, arity 1 is fine.  But if it is\n        f = \\x -> case x of\n                        True  -> error \"foo\"\n                        False -> \\y -> x+y\nthen we want to get arity 2.  Technically, this isn't quite right, because\n        (f True) `seq` 1\nshould diverge, but it'll converge if we eta-expand f.  Nevertheless, we\ndo so; it improves some programs significantly, and increasing convergence\nisn't a bad thing.  Hence the ABot/ATop in ArityType.\n\nSo these two transformations aren't always the Right Thing, and we\nhave several tickets reporting unexpected behaviour resulting from\nthis transformation.  So we try to limit it as much as possible:\n\n (1) Do NOT move a lambda outside a known-bottom case expression\n       case undefined of { (a,b) -> \\y -> e }\n     This showed up in Trac #5557\n\n (2) Do NOT move a lambda outside a case if all the branches of\n     the case are known to return bottom.\n        case x of { (a,b) -> \\y -> error \"urk\" }\n     This case is less important, but the idea is that if the fn is\n     going to diverge eventually anyway then getting the best arity\n     isn't an issue, so we might as well play safe\n\n (3) Do NOT move a lambda outside a case unless\n     (a) The scrutinee is ok-for-speculation, or\n     (b) more liberally: the scrutinee is cheap (e.g. a variable), and\n         -fpedantic-bottoms is not enforced (see Trac #2915 for an example)\n\nOf course both (1) and (2) are readily defeated by disguising the bottoms.\n\n4. Note [Newtype arity]\n~~~~~~~~~~~~~~~~~~~~~~~~\nNon-recursive newtypes are transparent, and should not get in the way.\nWe do (currently) eta-expand recursive newtypes too.  So if we have, say\n\n        newtype T = MkT ([T] -> Int)\n\nSuppose we have\n        e = coerce T f\nwhere f has arity 1.  Then: etaExpandArity e = 1;\nthat is, etaExpandArity looks through the coerce.\n\nWhen we eta-expand e to arity 1: eta_expand 1 e T\nwe want to get:                  coerce T (\\x::[T] -> (coerce ([T]->Int) e) x)\n\n  HOWEVER, note that if you use coerce bogusly you can ge\n        coerce Int negate\n  And since negate has arity 2, you might try to eta expand.  But you can't\n  decopose Int to a function type.   Hence the final case in eta_expand.\n\nNote [The state-transformer hack]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n        f = e\nwhere e has arity n.  Then, if we know from the context that f has\na usage type like\n        t1 -> ... -> tn -1-> t(n+1) -1-> ... -1-> tm -> ...\nthen we can expand the arity to m.  This usage type says that\nany application (x e1 .. en) will be applied to uniquely to (m-n) more args\nConsider f = \\x. let y = <expensive>\n                 in case x of\n                      True  -> foo\n                      False -> \\(s:RealWorld) -> e\nwhere foo has arity 1.  Then we want the state hack to\napply to foo too, so we can eta expand the case.\n\nThen we expect that if f is applied to one arg, it'll be applied to two\n(that's the hack -- we don't really know, and sometimes it's false)\nSee also Id.isOneShotBndr.\n\nNote [State hack and bottoming functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's a terrible idea to use the state hack on a bottoming function.\nHere's what happens (Trac #2861):\n\n  f :: String -> IO T\n  f = \\p. error \"...\"\n\nEta-expand, using the state hack:\n\n  f = \\p. (\\s. ((error \"...\") |> g1) s) |> g2\n  g1 :: IO T ~ (S -> (S,T))\n  g2 :: (S -> (S,T)) ~ IO T\n\nExtrude the g2\n\n  f' = \\p. \\s. ((error \"...\") |> g1) s\n  f = f' |> (String -> g2)\n\nDiscard args for bottomming function\n\n  f' = \\p. \\s. ((error \"...\") |> g1 |> g3\n  g3 :: (S -> (S,T)) ~ (S,T)\n\nExtrude g1.g3\n\n  f'' = \\p. \\s. (error \"...\")\n  f' = f'' |> (String -> S -> g1.g3)\n\nAnd now we can repeat the whole loop.  Aargh!  The bug is in applying the\nstate hack to a function which then swallows the argument.\n\nThis arose in another guise in Trac #3959.  Here we had\n\n     catch# (throw exn >> return ())\n\nNote that (throw :: forall a e. Exn e => e -> a) is called with [a = IO ()].\nAfter inlining (>>) we get\n\n     catch# (\\_. throw {IO ()} exn)\n\nWe must *not* eta-expand to\n\n     catch# (\\_ _. throw {...} exn)\n\nbecause 'catch#' expects to get a (# _,_ #) after applying its argument to\na State#, not another function!\n\nIn short, we use the state hack to allow us to push let inside a lambda,\nbut not to introduce a new lambda.\n\n\nNote [ArityType]\n~~~~~~~~~~~~~~~~\nArityType is the result of a compositional analysis on expressions,\nfrom which we can decide the real arity of the expression (extracted\nwith function exprEtaExpandArity).\n\nHere is what the fields mean. If an arbitrary expression 'f' has\nArityType 'at', then\n\n * If at = ABot n, then (f x1..xn) definitely diverges. Partial\n   applications to fewer than n args may *or may not* diverge.\n\n   We allow ourselves to eta-expand bottoming functions, even\n   if doing so may lose some `seq` sharing,\n       let x = <expensive> in \\y. error (g x y)\n       ==> \\y. let x = <expensive> in error (g x y)\n\n * If at = ATop as, and n=length as,\n   then expanding 'f' to (\\x1..xn. f x1 .. xn) loses no sharing,\n   assuming the calls of f respect the one-shot-ness of\n   its definition.\n\n   NB 'f' is an arbitrary expression, eg (f = g e1 e2).  This 'f'\n   can have ArityType as ATop, with length as > 0, only if e1 e2 are\n   themselves.\n\n * In both cases, f, (f x1), ... (f x1 ... f(n-1)) are definitely\n   really functions, or bottom, but *not* casts from a data type, in\n   at least one case branch.  (If it's a function in one case branch but\n   an unsafe cast from a data type in another, the program is bogus.)\n   So eta expansion is dynamically ok; see Note [State hack and\n   bottoming functions], the part about catch#\n\nExample:\n      f = \\x\\y. let v = <expensive> in\n          \\s(one-shot) \\t(one-shot). blah\n      'f' has ArityType [ManyShot,ManyShot,OneShot,OneShot]\n      The one-shot-ness means we can, in effect, push that\n      'let' inside the \\st.\n\n\nSuppose f = \\xy. x+y\nThen  f             :: AT [False,False] ATop\n      f v           :: AT [False]       ATop\n      f <expensive> :: AT []            ATop\n\n-------------------- Main arity code ----------------------------\n-}\n\n-- See Note [ArityType]\ndata ArityType = ATop [OneShotInfo] | ABot Arity\n     -- There is always an explicit lambda\n     -- to justify the [OneShot], or the Arity\n\ninstance Outputable ArityType where\n  ppr (ATop os) = text \"ATop\" <> parens (ppr (length os))\n  ppr (ABot n)  = text \"ABot\" <> parens (ppr n)\n\nvanillaArityType :: ArityType\nvanillaArityType = ATop []      -- Totally uninformative\n\n-- ^ The Arity returned is the number of value args the\n-- expression can be applied to without doing much work\nexprEtaExpandArity :: DynFlags -> CoreExpr -> Arity\n-- exprEtaExpandArity is used when eta expanding\n--      e  ==>  \\xy -> e x y\nexprEtaExpandArity dflags e\n  = case (arityType env e) of\n      ATop oss -> length oss\n      ABot n   -> n\n  where\n    env = AE { ae_cheap_fn = mk_cheap_fn dflags isCheapApp\n             , ae_ped_bot  = gopt Opt_PedanticBottoms dflags }\n\ngetBotArity :: ArityType -> Maybe Arity\n-- Arity of a divergent function\ngetBotArity (ABot n) = Just n\ngetBotArity _        = Nothing\n\nmk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun\nmk_cheap_fn dflags cheap_app\n  | not (gopt Opt_DictsCheap dflags)\n  = \\e _     -> exprIsCheapX cheap_app e\n  | otherwise\n  = \\e mb_ty -> exprIsCheapX cheap_app e\n             || case mb_ty of\n                  Nothing -> False\n                  Just ty -> isDictLikeTy ty\n\n\n----------------------\nfindRhsArity :: DynFlags -> Id -> CoreExpr -> Arity -> (Arity, Bool)\n-- This implements the fixpoint loop for arity analysis\n-- See Note [Arity analysis]\n-- If findRhsArity e = (n, is_bot) then\n--  (a) any application of e to <n arguments will not do much work,\n--      so it is safe to expand e  ==>  (\\x1..xn. e x1 .. xn)\n--  (b) if is_bot=True, then e applied to n args is guaranteed bottom\nfindRhsArity dflags bndr rhs old_arity\n  = go (get_arity init_cheap_app)\n       -- We always call exprEtaExpandArity once, but usually\n       -- that produces a result equal to old_arity, and then\n       -- we stop right away (since arities should not decrease)\n       -- Result: the common case is that there is just one iteration\n  where\n    is_lam = has_lam rhs\n\n    has_lam (Tick _ e) = has_lam e\n    has_lam (Lam b e)  = isId b || has_lam e\n    has_lam _          = False\n\n    init_cheap_app :: CheapAppFun\n    init_cheap_app fn n_val_args\n      | fn == bndr = True   -- On the first pass, this binder gets infinite arity\n      | otherwise  = isCheapApp fn n_val_args\n\n    go :: (Arity, Bool) -> (Arity, Bool)\n    go cur_info@(cur_arity, _)\n      | cur_arity <= old_arity = cur_info\n      | new_arity == cur_arity = cur_info\n      | otherwise = ASSERT( new_arity < cur_arity )\n#if defined(DEBUG)\n                    pprTrace \"Exciting arity\"\n                       (vcat [ ppr bndr <+> ppr cur_arity <+> ppr new_arity\n                             , ppr rhs])\n#endif\n                    go new_info\n      where\n        new_info@(new_arity, _) = get_arity cheap_app\n\n        cheap_app :: CheapAppFun\n        cheap_app fn n_val_args\n          | fn == bndr = n_val_args < cur_arity\n          | otherwise  = isCheapApp fn n_val_args\n\n    get_arity :: CheapAppFun -> (Arity, Bool)\n    get_arity cheap_app\n      = case (arityType env rhs) of\n          ABot n -> (n, True)\n          ATop (os:oss) | isOneShotInfo os || is_lam\n                  -> (1 + length oss, False)    -- Don't expand PAPs/thunks\n          ATop _  -> (0,              False)    -- Note [Eta expanding thunks]\n       where\n         env = AE { ae_cheap_fn = mk_cheap_fn dflags cheap_app\n                  , ae_ped_bot  = gopt Opt_PedanticBottoms dflags }\n\n{-\nNote [Arity analysis]\n~~~~~~~~~~~~~~~~~~~~~\nThe motivating example for arity analysis is this:\n\n  f = \\x. let g = f (x+1)\n          in \\y. ...g...\n\nWhat arity does f have?  Really it should have arity 2, but a naive\nlook at the RHS won't see that.  You need a fixpoint analysis which\nsays it has arity \"infinity\" the first time round.\n\nThis example happens a lot; it first showed up in Andy Gill's thesis,\nfifteen years ago!  It also shows up in the code for 'rnf' on lists\nin Trac #4138.\n\nThe analysis is easy to achieve because exprEtaExpandArity takes an\nargument\n     type CheapFun = CoreExpr -> Maybe Type -> Bool\nused to decide if an expression is cheap enough to push inside a\nlambda.  And exprIsCheapX in turn takes an argument\n     type CheapAppFun = Id -> Int -> Bool\nwhich tells when an application is cheap. This makes it easy to\nwrite the analysis loop.\n\nThe analysis is cheap-and-cheerful because it doesn't deal with\nmutual recursion.  But the self-recursive case is the important one.\n\n\nNote [Eta expanding through dictionaries]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the experimental -fdicts-cheap flag is on, we eta-expand through\ndictionary bindings.  This improves arities. Thereby, it also\nmeans that full laziness is less prone to floating out the\napplication of a function to its dictionary arguments, which\ncan thereby lose opportunities for fusion.  Example:\n        foo :: Ord a => a -> ...\n     foo = /\\a \\(d:Ord a). let d' = ...d... in \\(x:a). ....\n        -- So foo has arity 1\n\n     f = \\x. foo dInt $ bar x\n\nThe (foo DInt) is floated out, and makes ineffective a RULE\n     foo (bar x) = ...\n\nOne could go further and make exprIsCheap reply True to any\ndictionary-typed expression, but that's more work.\n\nSee Note [Dictionary-like types] in TcType.hs for why we use\nisDictLikeTy here rather than isDictTy\n\nNote [Eta expanding thunks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't eta-expand\n   * Trivial RHSs     x = y\n   * PAPs             x = map g\n   * Thunks           f = case y of p -> \\x -> blah\n\nWhen we see\n     f = case y of p -> \\x -> blah\nshould we eta-expand it? Well, if 'x' is a one-shot state token\nthen 'yes' because 'f' will only be applied once.  But otherwise\nwe (conservatively) say no.  My main reason is to avoid expanding\nPAPSs\n        f = g d  ==>  f = \\x. g d x\nbecause that might in turn make g inline (if it has an inline pragma),\nwhich we might not want.  After all, INLINE pragmas say \"inline only\nwhen saturated\" so we don't want to be too gung-ho about saturating!\n-}\n\narityLam :: Id -> ArityType -> ArityType\narityLam id (ATop as) = ATop (idStateHackOneShotInfo id : as)\narityLam _  (ABot n)  = ABot (n+1)\n\nfloatIn :: Bool -> ArityType -> ArityType\n-- We have something like (let x = E in b),\n-- where b has the given arity type.\nfloatIn _     (ABot n)  = ABot n\nfloatIn True  (ATop as) = ATop as\nfloatIn False (ATop as) = ATop (takeWhile isOneShotInfo as)\n   -- If E is not cheap, keep arity only for one-shots\n\narityApp :: ArityType -> Bool -> ArityType\n-- Processing (fun arg) where at is the ArityType of fun,\n-- Knock off an argument and behave like 'let'\narityApp (ABot 0)      _     = ABot 0\narityApp (ABot n)      _     = ABot (n-1)\narityApp (ATop [])     _     = ATop []\narityApp (ATop (_:as)) cheap = floatIn cheap (ATop as)\n\nandArityType :: ArityType -> ArityType -> ArityType   -- Used for branches of a 'case'\nandArityType (ABot n1) (ABot n2)  = ABot (n1 `max` n2) -- Note [ABot branches: use max]\nandArityType (ATop as)  (ABot _)  = ATop as\nandArityType (ABot _)   (ATop bs) = ATop bs\nandArityType (ATop as)  (ATop bs) = ATop (as `combine` bs)\n  where      -- See Note [Combining case branches]\n    combine (a:as) (b:bs) = (a `bestOneShot` b) : combine as bs\n    combine []     bs     = takeWhile isOneShotInfo bs\n    combine as     []     = takeWhile isOneShotInfo as\n\n{- Note [ABot branches: use max]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider   case x of\n             True  -> \\x.  error \"urk\"\n             False -> \\xy. error \"urk2\"\n\nRemember: ABot n means \"if you apply to n args, it'll definitely diverge\".\nSo we need (ABot 2) for the whole thing, the /max/ of the ABot arities.\n\nNote [Combining case branches]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  go = \\x. let z = go e0\n               go2 = \\x. case x of\n                           True  -> z\n                           False -> \\s(one-shot). e1\n           in go2 x\nWe *really* want to eta-expand go and go2.\nWhen combining the barnches of the case we have\n     ATop [] `andAT` ATop [OneShotLam]\nand we want to get ATop [OneShotLam].  But if the inner\nlambda wasn't one-shot we don't want to do this.\n(We need a proper arity analysis to justify that.)\n\nSo we combine the best of the two branches, on the (slightly dodgy)\nbasis that if we know one branch is one-shot, then they all must be.\n-}\n\n---------------------------\ntype CheapFun = CoreExpr -> Maybe Type -> Bool\n        -- How to decide if an expression is cheap\n        -- If the Maybe is Just, the type is the type\n        -- of the expression; Nothing means \"don't know\"\n\ndata ArityEnv\n  = AE { ae_cheap_fn :: CheapFun\n       , ae_ped_bot  :: Bool       -- True <=> be pedantic about bottoms\n  }\n\narityType :: ArityEnv -> CoreExpr -> ArityType\n\narityType env (Cast e co)\n  = case arityType env e of\n      ATop os -> ATop (take co_arity os)\n      ABot n  -> ABot (n `min` co_arity)\n  where\n    co_arity = length (typeArity (pSnd (coercionKind co)))\n    -- See Note [exprArity invariant] (2); must be true of\n    -- arityType too, since that is how we compute the arity\n    -- of variables, and they in turn affect result of exprArity\n    -- Trac #5441 is a nice demo\n    -- However, do make sure that ATop -> ATop and ABot -> ABot!\n    --   Casts don't affect that part. Getting this wrong provoked #5475\n\narityType _ (Var v)\n  | strict_sig <- idStrictness v\n  , not $ isTopSig strict_sig\n  , (ds, res) <- splitStrictSig strict_sig\n  , let arity = length ds\n  = if isBotRes res then ABot arity\n                    else ATop (take arity one_shots)\n  | otherwise\n  = ATop (take (idArity v) one_shots)\n  where\n    one_shots :: [OneShotInfo]  -- One-shot-ness derived from the type\n    one_shots = typeArity (idType v)\n\n        -- Lambdas; increase arity\narityType env (Lam x e)\n  | isId x    = arityLam x (arityType env e)\n  | otherwise = arityType env e\n\n        -- Applications; decrease arity, except for types\narityType env (App fun (Type _))\n   = arityType env fun\narityType env (App fun arg )\n   = arityApp (arityType env fun) (ae_cheap_fn env arg Nothing)\n\n        -- Case/Let; keep arity if either the expression is cheap\n        -- or it's a 1-shot lambda\n        -- The former is not really right for Haskell\n        --      f x = case x of { (a,b) -> \\y. e }\n        --  ===>\n        --      f x y = case x of { (a,b) -> e }\n        -- The difference is observable using 'seq'\n        --\narityType env (Case scrut _ _ alts)\n  | exprIsBottom scrut || null alts\n  = ABot 0     -- Do not eta expand\n               -- See Note [Dealing with bottom (1)]\n  | otherwise\n  = case alts_type of\n     ABot n  | n>0       -> ATop []    -- Don't eta expand\n             | otherwise -> ABot 0     -- if RHS is bottomming\n                                       -- See Note [Dealing with bottom (2)]\n\n     ATop as | not (ae_ped_bot env)    -- See Note [Dealing with bottom (3)]\n             , ae_cheap_fn env scrut Nothing -> ATop as\n             | exprOkForSpeculation scrut    -> ATop as\n             | otherwise                     -> ATop (takeWhile isOneShotInfo as)\n  where\n    alts_type = foldr1 andArityType [arityType env rhs | (_,_,rhs) <- alts]\n\narityType env (Let b e)\n  = floatIn (cheap_bind b) (arityType env e)\n  where\n    cheap_bind (NonRec b e) = is_cheap (b,e)\n    cheap_bind (Rec prs)    = all is_cheap prs\n    is_cheap (b,e) = ae_cheap_fn env e (Just (idType b))\n\narityType env (Tick t e)\n  | not (tickishIsCode t)     = arityType env e\n\narityType _ _ = vanillaArityType\n\n{-\n%************************************************************************\n%*                                                                      *\n              The main eta-expander\n%*                                                                      *\n%************************************************************************\n\nWe go for:\n   f = \\x1..xn -> N  ==>   f = \\x1..xn y1..ym -> N y1..ym\n                                 (n >= 0)\n\nwhere (in both cases)\n\n        * The xi can include type variables\n\n        * The yi are all value variables\n\n        * N is a NORMAL FORM (i.e. no redexes anywhere)\n          wanting a suitable number of extra args.\n\nThe biggest reason for doing this is for cases like\n\n        f = \\x -> case x of\n                    True  -> \\y -> e1\n                    False -> \\y -> e2\n\nHere we want to get the lambdas together.  A good example is the nofib\nprogram fibheaps, which gets 25% more allocation if you don't do this\neta-expansion.\n\nWe may have to sandwich some coerces between the lambdas\nto make the types work.   exprEtaExpandArity looks through coerces\nwhen computing arity; and etaExpand adds the coerces as necessary when\nactually computing the expansion.\n\nNote [No crap in eta-expanded code]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe eta expander is careful not to introduce \"crap\".  In particular,\ngiven a CoreExpr satisfying the 'CpeRhs' invariant (in CorePrep), it\nreturns a CoreExpr satisfying the same invariant. See Note [Eta\nexpansion and the CorePrep invariants] in CorePrep.\n\nThis means the eta-expander has to do a bit of on-the-fly\nsimplification but it's not too hard.  The alernative, of relying on\na subsequent clean-up phase of the Simplifier to de-crapify the result,\nmeans you can't really use it in CorePrep, which is painful.\n\nNote [Eta expansion for join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe no-crap rule is very tiresome to guarantee when\nwe have join points. Consider eta-expanding\n   let j :: Int -> Int -> Bool\n       j x = e\n   in b\n\nThe simple way is\n  \\(y::Int). (let j x = e in b) y\n\nThe no-crap way is\n  \\(y::Int). let j' :: Int -> Bool\n                 j' x = e y\n             in b[j'/j] y\nwhere I have written to stress that j's type has\nchanged.  Note that (of course!) we have to push the application\ninside the RHS of the join as well as into the body.  AND if j\nhas an unfolding we have to push it into there too.  AND j might\nbe recursive...\n\nSo for now I'm abandonig the no-crap rule in this case. I think\nthat for the use in CorePrep it really doesn't matter; and if\nit does, then CoreToStg.myCollectArgs will fall over.\n\n(Moreover, I think that casts can make the no-crap rule fail too.)\n\nNote [Eta expansion and SCCs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNote that SCCs are not treated specially by etaExpand.  If we have\n        etaExpand 2 (\\x -> scc \"foo\" e)\n        = (\\xy -> (scc \"foo\" e) y)\nSo the costs of evaluating 'e' (not 'e y') are attributed to \"foo\"\n\nNote [Eta expansion and source notes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCorePrep puts floatable ticks outside of value applications, but not\ntype applications. As a result we might be trying to eta-expand an\nexpression like\n\n  (src<...> v) @a\n\nwhich we want to lead to code like\n\n  \\x -> src<...> v @a x\n\nThis means that we need to look through type applications and be ready\nto re-add floats on the top.\n\n-}\n\n-- | @etaExpand n e@ returns an expression with\n-- the same meaning as @e@, but with arity @n@.\n--\n-- Given:\n--\n-- > e' = etaExpand n e\n--\n-- We should have that:\n--\n-- > ty = exprType e = exprType e'\netaExpand :: Arity              -- ^ Result should have this number of value args\n          -> CoreExpr           -- ^ Expression to expand\n          -> CoreExpr\n-- etaExpand arity e = res\n-- Then 'res' has at least 'arity' lambdas at the top\n--\n-- etaExpand deals with for-alls. For example:\n--              etaExpand 1 E\n-- where  E :: forall a. a -> a\n-- would return\n--      (/\\b. \\y::a -> E b y)\n--\n-- It deals with coerces too, though they are now rare\n-- so perhaps the extra code isn't worth it\n\netaExpand n orig_expr\n  = go n orig_expr\n  where\n      -- Strip off existing lambdas and casts\n      -- Note [Eta expansion and SCCs]\n    go 0 expr = expr\n    go n (Lam v body) | isTyVar v = Lam v (go n     body)\n                      | otherwise = Lam v (go (n-1) body)\n    go n (Cast expr co)           = Cast (go n expr) co\n    go n expr\n      = -- pprTrace \"ee\" (vcat [ppr orig_expr, ppr expr, ppr etas]) $\n        retick $ etaInfoAbs etas (etaInfoApp subst' sexpr etas)\n      where\n          in_scope = mkInScopeSet (exprFreeVars expr)\n          (in_scope', etas) = mkEtaWW n orig_expr in_scope (exprType expr)\n          subst' = mkEmptySubst in_scope'\n\n          -- Find ticks behind type apps.\n          -- See Note [Eta expansion and source notes]\n          (expr', args) = collectArgs expr\n          (ticks, expr'') = stripTicksTop tickishFloatable expr'\n          sexpr = foldl' App expr'' args\n          retick expr = foldr mkTick expr ticks\n\n                                -- Abstraction    Application\n--------------\ndata EtaInfo = EtaVar Var       -- /\\a. []        [] a\n                                -- \\x.  []        [] x\n             | EtaCo Coercion   -- [] |> sym co   [] |> co\n\ninstance Outputable EtaInfo where\n   ppr (EtaVar v) = text \"EtaVar\" <+> ppr v\n   ppr (EtaCo co) = text \"EtaCo\"  <+> ppr co\n\npushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo]\npushCoercion co1 (EtaCo co2 : eis)\n  | isReflCo co = eis\n  | otherwise   = EtaCo co : eis\n  where\n    co = co1 `mkTransCo` co2\n\npushCoercion co eis = EtaCo co : eis\n\n--------------\netaInfoAbs :: [EtaInfo] -> CoreExpr -> CoreExpr\netaInfoAbs []               expr = expr\netaInfoAbs (EtaVar v : eis) expr = Lam v (etaInfoAbs eis expr)\netaInfoAbs (EtaCo co : eis) expr = Cast (etaInfoAbs eis expr) (mkSymCo co)\n\n--------------\netaInfoApp :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr\n-- (etaInfoApp s e eis) returns something equivalent to\n--             ((substExpr s e) `appliedto` eis)\n\netaInfoApp subst (Lam v1 e) (EtaVar v2 : eis)\n  = etaInfoApp (CoreSubst.extendSubstWithVar subst v1 v2) e eis\n\netaInfoApp subst (Cast e co1) eis\n  = etaInfoApp subst e (pushCoercion co' eis)\n  where\n    co' = CoreSubst.substCo subst co1\n\netaInfoApp subst (Case e b ty alts) eis\n  = Case (subst_expr subst e) b1 ty' alts'\n  where\n    (subst1, b1) = substBndr subst b\n    alts' = map subst_alt alts\n    ty'   = etaInfoAppTy (CoreSubst.substTy subst ty) eis\n    subst_alt (con, bs, rhs) = (con, bs', etaInfoApp subst2 rhs eis)\n              where\n                 (subst2,bs') = substBndrs subst1 bs\n\netaInfoApp subst (Let b e) eis\n  | not (isJoinBind b)\n    -- See Note [Eta expansion for join points]\n  = Let b' (etaInfoApp subst' e eis)\n  where\n    (subst', b') = substBindSC subst b\n\netaInfoApp subst (Tick t e) eis\n  = Tick (substTickish subst t) (etaInfoApp subst e eis)\n\netaInfoApp subst expr _\n  | (Var fun, _) <- collectArgs expr\n  , Var fun' <- lookupIdSubst (text \"etaInfoApp\" <+> ppr fun) subst fun\n  , isJoinId fun'\n  = subst_expr subst expr\n\netaInfoApp subst e eis\n  = go (subst_expr subst e) eis\n  where\n    go e []                  = e\n    go e (EtaVar v    : eis) = go (App e (varToCoreExpr v)) eis\n    go e (EtaCo co    : eis) = go (Cast e co) eis\n\n\n--------------\netaInfoAppTy :: Type -> [EtaInfo] -> Type\n-- If                    e :: ty\n-- then   etaInfoApp e eis :: etaInfoApp ty eis\netaInfoAppTy ty []               = ty\netaInfoAppTy ty (EtaVar v : eis) = etaInfoAppTy (applyTypeToArg ty (varToCoreExpr v)) eis\netaInfoAppTy _  (EtaCo co : eis) = etaInfoAppTy (pSnd (coercionKind co)) eis\n\n--------------\nmkEtaWW :: Arity -> CoreExpr -> InScopeSet -> Type\n        -> (InScopeSet, [EtaInfo])\n        -- EtaInfo contains fresh variables,\n        --   not free in the incoming CoreExpr\n        -- Outgoing InScopeSet includes the EtaInfo vars\n        --   and the original free vars\n\nmkEtaWW orig_n orig_expr in_scope orig_ty\n  = go orig_n empty_subst orig_ty []\n  where\n    empty_subst = mkEmptyTCvSubst in_scope\n\n    go n subst ty eis       -- See Note [exprArity invariant]\n       | n == 0\n       = (getTCvInScope subst, reverse eis)\n\n       | Just (tcv,ty') <- splitForAllTy_maybe ty\n       , let (subst', tcv') = Type.substVarBndr subst tcv\n       = let ((n_subst, n_tcv), n_n)\n               -- We want to have at least 'n' lambdas at the top.\n               -- If tcv is a tyvar, it corresponds to one Lambda (/\\).\n               --   And we won't reduce n.\n               -- If tcv is a covar, we could eta-expand the expr with one\n               --   lambda \\co:ty. e co. In this case we generate a new variable\n               --   of the coercion type, update the scope, and reduce n by 1.\n               | isTyVar tcv = ((subst', tcv'), n)\n               | otherwise  = (freshEtaId n subst' (varType tcv'), n-1)\n           -- Avoid free vars of the original expression\n         in go n_n n_subst ty' (EtaVar n_tcv : eis)\n\n       | Just (arg_ty, res_ty) <- splitFunTy_maybe ty\n       , not (isTypeLevPoly arg_ty)\n          -- See Note [Levity polymorphism invariants] in CoreSyn\n          -- See also test case typecheck/should_run/EtaExpandLevPoly\n\n       , let (subst', eta_id') = freshEtaId n subst arg_ty\n           -- Avoid free vars of the original expression\n       = go (n-1) subst' res_ty (EtaVar eta_id' : eis)\n\n       | Just (co, ty') <- topNormaliseNewType_maybe ty\n       =        -- Given this:\n                --      newtype T = MkT ([T] -> Int)\n                -- Consider eta-expanding this\n                --      eta_expand 1 e T\n                -- We want to get\n                --      coerce T (\\x::[T] -> (coerce ([T]->Int) e) x)\n         go n subst ty' (pushCoercion co eis)\n\n       | otherwise       -- We have an expression of arity > 0,\n                         -- but its type isn't a function, or a binder\n                         -- is levity-polymorphic\n       = WARN( True, (ppr orig_n <+> ppr orig_ty) $$ ppr orig_expr )\n         (getTCvInScope subst, reverse eis)\n        -- This *can* legitmately happen:\n        -- e.g.  coerce Int (\\x. x) Essentially the programmer is\n        -- playing fast and loose with types (Happy does this a lot).\n        -- So we simply decline to eta-expand.  Otherwise we'd end up\n        -- with an explicit lambda having a non-function type\n\n\n\n--------------\n-- Don't use short-cutting substitution - we may be changing the types of join\n-- points, so applying the in-scope set is necessary\n-- TODO Check if we actually *are* changing any join points' types\n\nsubst_expr :: Subst -> CoreExpr -> CoreExpr\nsubst_expr = substExpr (text \"CoreArity:substExpr\")\n\n\n--------------\n\n-- | Split an expression into the given number of binders and a body,\n-- eta-expanding if necessary. Counts value *and* type binders.\netaExpandToJoinPoint :: JoinArity -> CoreExpr -> ([CoreBndr], CoreExpr)\netaExpandToJoinPoint join_arity expr\n  = go join_arity [] expr\n  where\n    go 0 rev_bs e         = (reverse rev_bs, e)\n    go n rev_bs (Lam b e) = go (n-1) (b : rev_bs) e\n    go n rev_bs e         = case etaBodyForJoinPoint n e of\n                              (bs, e') -> (reverse rev_bs ++ bs, e')\n\netaExpandToJoinPointRule :: JoinArity -> CoreRule -> CoreRule\netaExpandToJoinPointRule _ rule@(BuiltinRule {})\n  = WARN(True, (sep [text \"Can't eta-expand built-in rule:\", ppr rule]))\n      -- How did a local binding get a built-in rule anyway? Probably a plugin.\n    rule\netaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs\n                                               , ru_args  = args })\n  | need_args == 0\n  = rule\n  | need_args < 0\n  = pprPanic \"etaExpandToJoinPointRule\" (ppr join_arity $$ ppr rule)\n  | otherwise\n  = rule { ru_bndrs = bndrs ++ new_bndrs, ru_args = args ++ new_args\n         , ru_rhs = new_rhs }\n  where\n    need_args = join_arity - length args\n    (new_bndrs, new_rhs) = etaBodyForJoinPoint need_args rhs\n    new_args = varsToCoreExprs new_bndrs\n\n-- Adds as many binders as asked for; assumes expr is not a lambda\netaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr)\netaBodyForJoinPoint need_args body\n  = go need_args (exprType body) (init_subst body) [] body\n  where\n    go 0 _  _     rev_bs e\n      = (reverse rev_bs, e)\n    go n ty subst rev_bs e\n      | Just (tv, res_ty) <- splitForAllTy_maybe ty\n      , let (subst', tv') = Type.substVarBndr subst tv\n      = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv')\n      | Just (arg_ty, res_ty) <- splitFunTy_maybe ty\n      , let (subst', b) = freshEtaId n subst arg_ty\n      = go (n-1) res_ty subst' (b : rev_bs) (e `App` Var b)\n      | otherwise\n      = pprPanic \"etaBodyForJoinPoint\" $ int need_args $$\n                                         ppr body $$ ppr (exprType body)\n\n    init_subst e = mkEmptyTCvSubst (mkInScopeSet (exprFreeVars e))\n\n--------------\nfreshEtaId :: Int -> TCvSubst -> Type -> (TCvSubst, Id)\n-- Make a fresh Id, with specified type (after applying substitution)\n-- It should be \"fresh\" in the sense that it's not in the in-scope set\n-- of the TvSubstEnv; and it should itself then be added to the in-scope\n-- set of the TvSubstEnv\n--\n-- The Int is just a reasonable starting point for generating a unique;\n-- it does not necessarily have to be unique itself.\nfreshEtaId n subst ty\n      = (subst', eta_id')\n      where\n        ty'     = Type.substTy subst ty\n        eta_id' = uniqAway (getTCvInScope subst) $\n                  mkSysLocalOrCoVar (fsLit \"eta\") (mkBuiltinUnique n) ty'\n        subst'  = extendTCvInScope subst eta_id'\n", "num_lines": 1160}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\nTaken quite directly from the Peyton Jones/Lester paper.\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- | A module concerned with finding the free variables of an expression.\nmodule CoreFVs (\n        -- * Free variables of expressions and binding groups\n        exprFreeVars,\n        exprFreeVarsDSet,\n        exprFreeVarsList,\n        exprFreeIds,\n        exprFreeIdsDSet,\n        exprFreeIdsList,\n        exprsFreeIdsDSet,\n        exprsFreeIdsList,\n        exprsFreeVars,\n        exprsFreeVarsList,\n        bindFreeVars,\n\n        -- * Selective free variables of expressions\n        InterestingVarFun,\n        exprSomeFreeVars, exprsSomeFreeVars,\n        exprSomeFreeVarsList, exprsSomeFreeVarsList,\n\n        -- * Free variables of Rules, Vars and Ids\n        varTypeTyCoVars,\n        varTypeTyCoFVs,\n        idUnfoldingVars, idFreeVars, dIdFreeVars,\n        bndrRuleAndUnfoldingVarsDSet,\n        idFVs,\n        idRuleVars, idRuleRhsVars, stableUnfoldingVars,\n        ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,\n        rulesFreeVarsDSet,\n        ruleLhsFreeIds, ruleLhsFreeIdsList,\n\n        expr_fvs,\n\n        -- * Orphan names\n        orphNamesOfType, orphNamesOfCo, orphNamesOfAxiom,\n        orphNamesOfTypes, orphNamesOfCoCon,\n        exprsOrphNames, orphNamesOfFamInst,\n\n        -- * Core syntax tree annotation with free variables\n        FVAnn,                  -- annotation, abstract\n        CoreExprWithFVs,        -- = AnnExpr Id FVAnn\n        CoreExprWithFVs',       -- = AnnExpr' Id FVAnn\n        CoreBindWithFVs,        -- = AnnBind Id FVAnn\n        CoreAltWithFVs,         -- = AnnAlt Id FVAnn\n        freeVars,               -- CoreExpr -> CoreExprWithFVs\n        freeVarsBind,           -- CoreBind -> DVarSet -> (DVarSet, CoreBindWithFVs)\n        freeVarsOf,             -- CoreExprWithFVs -> DIdSet\n        freeVarsOfAnn\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport Id\nimport IdInfo\nimport NameSet\nimport UniqSet\nimport Unique (Uniquable (..))\nimport Name\nimport VarSet\nimport Var\nimport Type\nimport TyCoRep\nimport TyCon\nimport CoAxiom\nimport FamInstEnv\nimport TysPrim( funTyConName )\nimport Maybes( orElse )\nimport Util\nimport BasicTypes( Activation )\nimport Outputable\nimport FV\n\n{-\n************************************************************************\n*                                                                      *\n\\section{Finding the free variables of an expression}\n*                                                                      *\n************************************************************************\n\nThis function simply finds the free variables of an expression.\nSo far as type variables are concerned, it only finds tyvars that are\n\n        * free in type arguments,\n        * free in the type of a binder,\n\nbut not those that are free in the type of variable occurrence.\n-}\n\n-- | Find all locally-defined free Ids or type variables in an expression\n-- returning a non-deterministic set.\nexprFreeVars :: CoreExpr -> VarSet\nexprFreeVars = fvVarSet . exprFVs\n\n-- | Find all locally-defined free Ids or type variables in an expression\n-- returning a composable FV computation. See Note [FV naming conventions] in FV\n-- for why export it.\nexprFVs :: CoreExpr -> FV\nexprFVs = filterFV isLocalVar . expr_fvs\n\n-- | Find all locally-defined free Ids or type variables in an expression\n-- returning a deterministic set.\nexprFreeVarsDSet :: CoreExpr -> DVarSet\nexprFreeVarsDSet = fvDVarSet . exprFVs\n\n-- | Find all locally-defined free Ids or type variables in an expression\n-- returning a deterministically ordered list.\nexprFreeVarsList :: CoreExpr -> [Var]\nexprFreeVarsList = fvVarList . exprFVs\n\n-- | Find all locally-defined free Ids in an expression\nexprFreeIds :: CoreExpr -> IdSet        -- Find all locally-defined free Ids\nexprFreeIds = exprSomeFreeVars isLocalId\n\n-- | Find all locally-defined free Ids in an expression\n-- returning a deterministic set.\nexprFreeIdsDSet :: CoreExpr -> DIdSet -- Find all locally-defined free Ids\nexprFreeIdsDSet = exprSomeFreeVarsDSet isLocalId\n\n-- | Find all locally-defined free Ids in an expression\n-- returning a deterministically ordered list.\nexprFreeIdsList :: CoreExpr -> [Id] -- Find all locally-defined free Ids\nexprFreeIdsList = exprSomeFreeVarsList isLocalId\n\n-- | Find all locally-defined free Ids in several expressions\n-- returning a deterministic set.\nexprsFreeIdsDSet :: [CoreExpr] -> DIdSet -- Find all locally-defined free Ids\nexprsFreeIdsDSet = exprsSomeFreeVarsDSet isLocalId\n\n-- | Find all locally-defined free Ids in several expressions\n-- returning a deterministically ordered list.\nexprsFreeIdsList :: [CoreExpr] -> [Id]   -- Find all locally-defined free Ids\nexprsFreeIdsList = exprsSomeFreeVarsList isLocalId\n\n-- | Find all locally-defined free Ids or type variables in several expressions\n-- returning a non-deterministic set.\nexprsFreeVars :: [CoreExpr] -> VarSet\nexprsFreeVars = fvVarSet . exprsFVs\n\n-- | Find all locally-defined free Ids or type variables in several expressions\n-- returning a composable FV computation. See Note [FV naming conventions] in FV\n-- for why export it.\nexprsFVs :: [CoreExpr] -> FV\nexprsFVs exprs = mapUnionFV exprFVs exprs\n\n-- | Find all locally-defined free Ids or type variables in several expressions\n-- returning a deterministically ordered list.\nexprsFreeVarsList :: [CoreExpr] -> [Var]\nexprsFreeVarsList = fvVarList . exprsFVs\n\n-- | Find all locally defined free Ids in a binding group\nbindFreeVars :: CoreBind -> VarSet\nbindFreeVars (NonRec b r) = fvVarSet $ filterFV isLocalVar $ rhs_fvs (b,r)\nbindFreeVars (Rec prs)    = fvVarSet $ filterFV isLocalVar $\n                                addBndrs (map fst prs)\n                                     (mapUnionFV rhs_fvs prs)\n\n-- | Finds free variables in an expression selected by a predicate\nexprSomeFreeVars :: InterestingVarFun   -- ^ Says which 'Var's are interesting\n                 -> CoreExpr\n                 -> VarSet\nexprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ expr_fvs e\n\n-- | Finds free variables in an expression selected by a predicate\n-- returning a deterministically ordered list.\nexprSomeFreeVarsList :: InterestingVarFun -- ^ Says which 'Var's are interesting\n                     -> CoreExpr\n                     -> [Var]\nexprSomeFreeVarsList fv_cand e = fvVarList $ filterFV fv_cand $ expr_fvs e\n\n-- | Finds free variables in an expression selected by a predicate\n-- returning a deterministic set.\nexprSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting\n                     -> CoreExpr\n                     -> DVarSet\nexprSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ expr_fvs e\n\n-- | Finds free variables in several expressions selected by a predicate\nexprsSomeFreeVars :: InterestingVarFun  -- Says which 'Var's are interesting\n                  -> [CoreExpr]\n                  -> VarSet\nexprsSomeFreeVars fv_cand es =\n  fvVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs es\n\n-- | Finds free variables in several expressions selected by a predicate\n-- returning a deterministically ordered list.\nexprsSomeFreeVarsList :: InterestingVarFun  -- Says which 'Var's are interesting\n                      -> [CoreExpr]\n                      -> [Var]\nexprsSomeFreeVarsList fv_cand es =\n  fvVarList $ filterFV fv_cand $ mapUnionFV expr_fvs es\n\n-- | Finds free variables in several expressions selected by a predicate\n-- returning a deterministic set.\nexprsSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting\n                      -> [CoreExpr]\n                      -> DVarSet\nexprsSomeFreeVarsDSet fv_cand e =\n  fvDVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs e\n\n--      Comment about obselete code\n-- We used to gather the free variables the RULES at a variable occurrence\n-- with the following cryptic comment:\n--     \"At a variable occurrence, add in any free variables of its rule rhss\n--     Curiously, we gather the Id's free *type* variables from its binding\n--     site, but its free *rule-rhs* variables from its usage sites.  This\n--     is a little weird.  The reason is that the former is more efficient,\n--     but the latter is more fine grained, and a makes a difference when\n--     a variable mentions itself one of its own rule RHSs\"\n-- Not only is this \"weird\", but it's also pretty bad because it can make\n-- a function seem more recursive than it is.  Suppose\n--      f  = ...g...\n--      g  = ...\n--         RULE g x = ...f...\n-- Then f is not mentioned in its own RHS, and needn't be a loop breaker\n-- (though g may be).  But if we collect the rule fvs from g's occurrence,\n-- it looks as if f mentions itself.  (This bites in the eftInt/eftIntFB\n-- code in GHC.Enum.)\n--\n-- Anyway, it seems plain wrong.  The RULE is like an extra RHS for the\n-- function, so its free variables belong at the definition site.\n--\n-- Deleted code looked like\n--     foldVarSet add_rule_var var_itself_set (idRuleVars var)\n--     add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var\n--                          | otherwise                    = set\n--      SLPJ Feb06\n\naddBndr :: CoreBndr -> FV -> FV\naddBndr bndr fv fv_cand in_scope acc\n  = (varTypeTyCoFVs bndr `unionFV`\n        -- Include type variables in the binder's type\n        --      (not just Ids; coercion variables too!)\n     FV.delFV bndr fv) fv_cand in_scope acc\n\naddBndrs :: [CoreBndr] -> FV -> FV\naddBndrs bndrs fv = foldr addBndr fv bndrs\n\nexpr_fvs :: CoreExpr -> FV\nexpr_fvs (Type ty) fv_cand in_scope acc =\n  tyCoFVsOfType ty fv_cand in_scope acc\nexpr_fvs (Coercion co) fv_cand in_scope acc =\n  tyCoFVsOfCo co fv_cand in_scope acc\nexpr_fvs (Var var) fv_cand in_scope acc = FV.unitFV var fv_cand in_scope acc\nexpr_fvs (Lit _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc\nexpr_fvs (Tick t expr) fv_cand in_scope acc =\n  (tickish_fvs t `unionFV` expr_fvs expr) fv_cand in_scope acc\nexpr_fvs (App fun arg) fv_cand in_scope acc =\n  (expr_fvs fun `unionFV` expr_fvs arg) fv_cand in_scope acc\nexpr_fvs (Lam bndr body) fv_cand in_scope acc =\n  addBndr bndr (expr_fvs body) fv_cand in_scope acc\nexpr_fvs (Cast expr co) fv_cand in_scope acc =\n  (expr_fvs expr `unionFV` tyCoFVsOfCo co) fv_cand in_scope acc\n\nexpr_fvs (Case scrut bndr ty alts) fv_cand in_scope acc\n  = (expr_fvs scrut `unionFV` tyCoFVsOfType ty `unionFV` addBndr bndr\n      (mapUnionFV alt_fvs alts)) fv_cand in_scope acc\n  where\n    alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)\n\nexpr_fvs (Let (NonRec bndr rhs) body) fv_cand in_scope acc\n  = (rhs_fvs (bndr, rhs) `unionFV` addBndr bndr (expr_fvs body))\n      fv_cand in_scope acc\n\nexpr_fvs (Let (Rec pairs) body) fv_cand in_scope acc\n  = addBndrs (map fst pairs)\n             (mapUnionFV rhs_fvs pairs `unionFV` expr_fvs body)\n               fv_cand in_scope acc\n\n---------\nrhs_fvs :: (Id, CoreExpr) -> FV\nrhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV`\n                      bndrRuleAndUnfoldingFVs bndr\n        -- Treat any RULES as extra RHSs of the binding\n\n---------\nexprs_fvs :: [CoreExpr] -> FV\nexprs_fvs exprs = mapUnionFV expr_fvs exprs\n\ntickish_fvs :: Tickish Id -> FV\ntickish_fvs (Breakpoint _ ids) = FV.mkFVs ids\ntickish_fvs _ = emptyFV\n\n{-\n************************************************************************\n*                                                                      *\n\\section{Free names}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Finds the free /external/ names of an expression, notably\n-- including the names of type constructors (which of course do not show\n-- up in 'exprFreeVars').\nexprOrphNames :: CoreExpr -> NameSet\n-- There's no need to delete local binders, because they will all\n-- be /internal/ names.\nexprOrphNames e\n  = go e\n  where\n    go (Var v)\n      | isExternalName n    = unitNameSet n\n      | otherwise           = emptyNameSet\n      where n = idName v\n    go (Lit _)              = emptyNameSet\n    go (Type ty)            = orphNamesOfType ty        -- Don't need free tyvars\n    go (Coercion co)        = orphNamesOfCo co\n    go (App e1 e2)          = go e1 `unionNameSet` go e2\n    go (Lam v e)            = go e `delFromNameSet` idName v\n    go (Tick _ e)           = go e\n    go (Cast e co)          = go e `unionNameSet` orphNamesOfCo co\n    go (Let (NonRec _ r) e) = go e `unionNameSet` go r\n    go (Let (Rec prs) e)    = exprsOrphNames (map snd prs) `unionNameSet` go e\n    go (Case e _ ty as)     = go e `unionNameSet` orphNamesOfType ty\n                              `unionNameSet` unionNameSets (map go_alt as)\n\n    go_alt (_,_,r) = go r\n\n-- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details\nexprsOrphNames :: [CoreExpr] -> NameSet\nexprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es\n\n\n{- **********************************************************************\n%*                                                                      *\n                    orphNamesXXX\n\n%*                                                                      *\n%********************************************************************* -}\n\norphNamesOfTyCon :: TyCon -> NameSet\norphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSet` case tyConClass_maybe tycon of\n    Nothing  -> emptyNameSet\n    Just cls -> unitNameSet (getName cls)\n\norphNamesOfType :: Type -> NameSet\norphNamesOfType ty | Just ty' <- coreView ty = orphNamesOfType ty'\n                -- Look through type synonyms (Trac #4912)\norphNamesOfType (TyVarTy _)          = emptyNameSet\norphNamesOfType (LitTy {})           = emptyNameSet\norphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon\n                                       `unionNameSet` orphNamesOfTypes tys\norphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderType bndr)\n                                       `unionNameSet` orphNamesOfType res\norphNamesOfType (FunTy _ arg res)    = unitNameSet funTyConName    -- NB!  See Trac #8535\n                                       `unionNameSet` orphNamesOfType arg\n                                       `unionNameSet` orphNamesOfType res\norphNamesOfType (AppTy fun arg)      = orphNamesOfType fun `unionNameSet` orphNamesOfType arg\norphNamesOfType (CastTy ty co)       = orphNamesOfType ty `unionNameSet` orphNamesOfCo co\norphNamesOfType (CoercionTy co)      = orphNamesOfCo co\n\norphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet\norphNamesOfThings f = foldr (unionNameSet . f) emptyNameSet\n\norphNamesOfTypes :: [Type] -> NameSet\norphNamesOfTypes = orphNamesOfThings orphNamesOfType\n\norphNamesOfMCo :: MCoercion -> NameSet\norphNamesOfMCo MRefl    = emptyNameSet\norphNamesOfMCo (MCo co) = orphNamesOfCo co\n\norphNamesOfCo :: Coercion -> NameSet\norphNamesOfCo (Refl ty)             = orphNamesOfType ty\norphNamesOfCo (GRefl _ ty mco)      = orphNamesOfType ty `unionNameSet` orphNamesOfMCo mco\norphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos\norphNamesOfCo (AppCo co1 co2)       = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2\norphNamesOfCo (ForAllCo _ kind_co co)\n  = orphNamesOfCo kind_co `unionNameSet` orphNamesOfCo co\norphNamesOfCo (FunCo _ co1 co2)     = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2\norphNamesOfCo (CoVarCo _)           = emptyNameSet\norphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSet` orphNamesOfCos cos\norphNamesOfCo (UnivCo p _ t1 t2)    = orphNamesOfProv p `unionNameSet` orphNamesOfType t1 `unionNameSet` orphNamesOfType t2\norphNamesOfCo (SymCo co)            = orphNamesOfCo co\norphNamesOfCo (TransCo co1 co2)     = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2\norphNamesOfCo (NthCo _ _ co)        = orphNamesOfCo co\norphNamesOfCo (LRCo  _ co)          = orphNamesOfCo co\norphNamesOfCo (InstCo co arg)       = orphNamesOfCo co `unionNameSet` orphNamesOfCo arg\norphNamesOfCo (KindCo co)           = orphNamesOfCo co\norphNamesOfCo (SubCo co)            = orphNamesOfCo co\norphNamesOfCo (AxiomRuleCo _ cs)    = orphNamesOfCos cs\norphNamesOfCo (HoleCo _)            = emptyNameSet\n\norphNamesOfProv :: UnivCoProvenance -> NameSet\norphNamesOfProv UnsafeCoerceProv    = emptyNameSet\norphNamesOfProv (PhantomProv co)    = orphNamesOfCo co\norphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co\norphNamesOfProv (PluginProv _)      = emptyNameSet\n\norphNamesOfCos :: [Coercion] -> NameSet\norphNamesOfCos = orphNamesOfThings orphNamesOfCo\n\norphNamesOfCoCon :: CoAxiom br -> NameSet\norphNamesOfCoCon (CoAxiom { co_ax_tc = tc, co_ax_branches = branches })\n  = orphNamesOfTyCon tc `unionNameSet` orphNamesOfCoAxBranches branches\n\norphNamesOfAxiom :: CoAxiom br -> NameSet\norphNamesOfAxiom axiom\n  = orphNamesOfTypes (concatMap coAxBranchLHS $ fromBranches $ coAxiomBranches axiom)\n    `extendNameSet` getName (coAxiomTyCon axiom)\n\norphNamesOfCoAxBranches :: Branches br -> NameSet\norphNamesOfCoAxBranches\n  = foldr (unionNameSet . orphNamesOfCoAxBranch) emptyNameSet . fromBranches\n\norphNamesOfCoAxBranch :: CoAxBranch -> NameSet\norphNamesOfCoAxBranch (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })\n  = orphNamesOfTypes lhs `unionNameSet` orphNamesOfType rhs\n\n-- | orphNamesOfAxiom collects the names of the concrete types and\n-- type constructors that make up the LHS of a type family instance,\n-- including the family name itself.\n--\n-- For instance, given `type family Foo a b`:\n-- `type instance Foo (F (G (H a))) b = ...` would yield [Foo,F,G,H]\n--\n-- Used in the implementation of \":info\" in GHCi.\norphNamesOfFamInst :: FamInst -> NameSet\norphNamesOfFamInst fam_inst = orphNamesOfAxiom (famInstAxiom fam_inst)\n\n{-\n************************************************************************\n*                                                                      *\n\\section[freevars-everywhere]{Attaching free variables to every sub-expression}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Those variables free in the right hand side of a rule returned as a\n-- non-deterministic set\nruleRhsFreeVars :: CoreRule -> VarSet\nruleRhsFreeVars (BuiltinRule {}) = noFVs\nruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })\n  = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)\n      -- See Note [Rule free var hack]\n\n-- | Those variables free in the both the left right hand sides of a rule\n-- returned as a non-deterministic set\nruleFreeVars :: CoreRule -> VarSet\nruleFreeVars = fvVarSet . ruleFVs\n\n-- | Those variables free in the both the left right hand sides of a rule\n-- returned as FV computation\nruleFVs :: CoreRule -> FV\nruleFVs (BuiltinRule {}) = emptyFV\nruleFVs (Rule { ru_fn = _do_not_include\n                  -- See Note [Rule free var hack]\n              , ru_bndrs = bndrs\n              , ru_rhs = rhs, ru_args = args })\n  = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))\n\n-- | Those variables free in the both the left right hand sides of rules\n-- returned as FV computation\nrulesFVs :: [CoreRule] -> FV\nrulesFVs = mapUnionFV ruleFVs\n\n-- | Those variables free in the both the left right hand sides of rules\n-- returned as a deterministic set\nrulesFreeVarsDSet :: [CoreRule] -> DVarSet\nrulesFreeVarsDSet rules = fvDVarSet $ rulesFVs rules\n\nidRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet\n-- Just the variables free on the *rhs* of a rule\nidRuleRhsVars is_active id\n  = mapUnionVarSet get_fvs (idCoreRules id)\n  where\n    get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs\n                  , ru_rhs = rhs, ru_act = act })\n      | is_active act\n            -- See Note [Finding rule RHS free vars] in OccAnal.hs\n      = delOneFromUniqSet_Directly fvs (getUnique fn)\n            -- Note [Rule free var hack]\n      where\n        fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)\n    get_fvs _ = noFVs\n\n-- | Those variables free in the right hand side of several rules\nrulesFreeVars :: [CoreRule] -> VarSet\nrulesFreeVars rules = mapUnionVarSet ruleFreeVars rules\n\nruleLhsFreeIds :: CoreRule -> VarSet\n-- ^ This finds all locally-defined free Ids on the left hand side of a rule\n-- and returns them as a non-deterministic set\nruleLhsFreeIds = fvVarSet . ruleLhsFVIds\n\nruleLhsFreeIdsList :: CoreRule -> [Var]\n-- ^ This finds all locally-defined free Ids on the left hand side of a rule\n-- and returns them as a determinisitcally ordered list\nruleLhsFreeIdsList = fvVarList . ruleLhsFVIds\n\nruleLhsFVIds :: CoreRule -> FV\n-- ^ This finds all locally-defined free Ids on the left hand side of a rule\n-- and returns an FV computation\nruleLhsFVIds (BuiltinRule {}) = emptyFV\nruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args })\n  = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args)\n\n{-\nNote [Rule free var hack]  (Not a hack any more)\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used not to include the Id in its own rhs free-var set.\nOtherwise the occurrence analyser makes bindings recursive:\n        f x y = x+y\n        RULE:  f (f x y) z  ==>  f x (f y z)\nHowever, the occurrence analyser distinguishes \"non-rule loop breakers\"\nfrom \"rule-only loop breakers\" (see BasicTypes.OccInfo).  So it will\nput this 'f' in a Rec block, but will mark the binding as a non-rule loop\nbreaker, which is perfectly inlinable.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n\\section[freevars-everywhere]{Attaching free variables to every sub-expression}\n*                                                                      *\n************************************************************************\n\nThe free variable pass annotates every node in the expression with its\nNON-GLOBAL free variables and type variables.\n-}\n\ntype FVAnn = DVarSet  -- See Note [The FVAnn invariant]\n\n{- Note [The FVAnn invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInvariant: a FVAnn, say S, is closed:\n  That is: if v is in S,\n           then freevars( v's type/kind ) is also in S\n-}\n\n-- | Every node in a binding group annotated with its\n-- (non-global) free variables, both Ids and TyVars, and type.\ntype CoreBindWithFVs = AnnBind Id FVAnn\n\n-- | Every node in an expression annotated with its\n-- (non-global) free variables, both Ids and TyVars, and type.\n-- NB: see Note [The FVAnn invariant]\ntype CoreExprWithFVs  = AnnExpr  Id FVAnn\ntype CoreExprWithFVs' = AnnExpr' Id FVAnn\n\n-- | Every node in an expression annotated with its\n-- (non-global) free variables, both Ids and TyVars, and type.\ntype CoreAltWithFVs = AnnAlt Id FVAnn\n\nfreeVarsOf :: CoreExprWithFVs -> DIdSet\n-- ^ Inverse function to 'freeVars'\nfreeVarsOf (fvs, _) = fvs\n\n-- | Extract the vars reported in a FVAnn\nfreeVarsOfAnn :: FVAnn -> DIdSet\nfreeVarsOfAnn fvs = fvs\n\nnoFVs :: VarSet\nnoFVs = emptyVarSet\n\naFreeVar :: Var -> DVarSet\naFreeVar = unitDVarSet\n\nunionFVs :: DVarSet -> DVarSet -> DVarSet\nunionFVs = unionDVarSet\n\nunionFVss :: [DVarSet] -> DVarSet\nunionFVss = unionDVarSets\n\ndelBindersFV :: [Var] -> DVarSet -> DVarSet\ndelBindersFV bs fvs = foldr delBinderFV fvs bs\n\ndelBinderFV :: Var -> DVarSet -> DVarSet\n-- This way round, so we can do it multiple times using foldr\n\n-- (b `delBinderFV` s)\n--   * removes the binder b from the free variable set s,\n--   * AND *adds* to s the free variables of b's type\n--\n-- This is really important for some lambdas:\n--      In (\\x::a -> x) the only mention of \"a\" is in the binder.\n--\n-- Also in\n--      let x::a = b in ...\n-- we should really note that \"a\" is free in this expression.\n-- It'll be pinned inside the /\\a by the binding for b, but\n-- it seems cleaner to make sure that a is in the free-var set\n-- when it is mentioned.\n--\n-- This also shows up in recursive bindings.  Consider:\n--      /\\a -> letrec x::a = x in E\n-- Now, there are no explicit free type variables in the RHS of x,\n-- but nevertheless \"a\" is free in its definition.  So we add in\n-- the free tyvars of the types of the binders, and include these in the\n-- free vars of the group, attached to the top level of each RHS.\n--\n-- This actually happened in the defn of errorIO in IOBase.hs:\n--      errorIO (ST io) = case (errorIO# io) of\n--                          _ -> bottom\n--                        where\n--                          bottom = bottom -- Never evaluated\n\ndelBinderFV b s = (s `delDVarSet` b) `unionFVs` dVarTypeTyCoVars b\n        -- Include coercion variables too!\n\nvarTypeTyCoVars :: Var -> TyCoVarSet\n-- Find the type/kind variables free in the type of the id/tyvar\nvarTypeTyCoVars var = fvVarSet $ varTypeTyCoFVs var\n\ndVarTypeTyCoVars :: Var -> DTyCoVarSet\n-- Find the type/kind/coercion variables free in the type of the id/tyvar\ndVarTypeTyCoVars var = fvDVarSet $ varTypeTyCoFVs var\n\nvarTypeTyCoFVs :: Var -> FV\nvarTypeTyCoFVs var = tyCoFVsOfType (varType var)\n\nidFreeVars :: Id -> VarSet\nidFreeVars id = ASSERT( isId id) fvVarSet $ idFVs id\n\ndIdFreeVars :: Id -> DVarSet\ndIdFreeVars id = fvDVarSet $ idFVs id\n\nidFVs :: Id -> FV\n-- Type variables, rule variables, and inline variables\nidFVs id = ASSERT( isId id)\n           varTypeTyCoFVs id `unionFV`\n           bndrRuleAndUnfoldingFVs id\n\nbndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet\nbndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id\n\nbndrRuleAndUnfoldingFVs :: Id -> FV\nbndrRuleAndUnfoldingFVs id\n  | isId id   = idRuleFVs id `unionFV` idUnfoldingFVs id\n  | otherwise = emptyFV\n\nidRuleVars ::Id -> VarSet  -- Does *not* include CoreUnfolding vars\nidRuleVars id = fvVarSet $ idRuleFVs id\n\nidRuleFVs :: Id -> FV\nidRuleFVs id = ASSERT( isId id)\n  FV.mkFVs (dVarSetElems $ ruleInfoFreeVars (idSpecialisation id))\n\nidUnfoldingVars :: Id -> VarSet\n-- Produce free vars for an unfolding, but NOT for an ordinary\n-- (non-inline) unfolding, since it is a dup of the rhs\n-- and we'll get exponential behaviour if we look at both unf and rhs!\n-- But do look at the *real* unfolding, even for loop breakers, else\n-- we might get out-of-scope variables\nidUnfoldingVars id = fvVarSet $ idUnfoldingFVs id\n\nidUnfoldingFVs :: Id -> FV\nidUnfoldingFVs id = stableUnfoldingFVs (realIdUnfolding id) `orElse` emptyFV\n\nstableUnfoldingVars :: Unfolding -> Maybe VarSet\nstableUnfoldingVars unf = fvVarSet `fmap` stableUnfoldingFVs unf\n\nstableUnfoldingFVs :: Unfolding -> Maybe FV\nstableUnfoldingFVs unf\n  = case unf of\n      CoreUnfolding { uf_tmpl = rhs, uf_src = src }\n         | isStableSource src\n         -> Just (filterFV isLocalVar $ expr_fvs rhs)\n      DFunUnfolding { df_bndrs = bndrs, df_args = args }\n         -> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprs_fvs args)\n            -- DFuns are top level, so no fvs from types of bndrs\n      _other -> Nothing\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Free variables (and types)}\n*                                                                      *\n************************************************************************\n-}\n\nfreeVarsBind :: CoreBind\n             -> DVarSet                     -- Free vars of scope of binding\n             -> (CoreBindWithFVs, DVarSet)  -- Return free vars of binding + scope\nfreeVarsBind (NonRec binder rhs) body_fvs\n  = ( AnnNonRec binder rhs2\n    , freeVarsOf rhs2 `unionFVs` body_fvs2\n                      `unionFVs` bndrRuleAndUnfoldingVarsDSet binder )\n    where\n      rhs2      = freeVars rhs\n      body_fvs2 = binder `delBinderFV` body_fvs\n\nfreeVarsBind (Rec binds) body_fvs\n  = ( AnnRec (binders `zip` rhss2)\n    , delBindersFV binders all_fvs )\n  where\n    (binders, rhss) = unzip binds\n    rhss2        = map freeVars rhss\n    rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2\n    binders_fvs  = fvDVarSet $ mapUnionFV bndrRuleAndUnfoldingFVs binders\n                   -- See Note [The FVAnn invariant]\n    all_fvs      = rhs_body_fvs `unionFVs` binders_fvs\n            -- The \"delBinderFV\" happens after adding the idSpecVars,\n            -- since the latter may add some of the binders as fvs\n\nfreeVars :: CoreExpr -> CoreExprWithFVs\n-- ^ Annotate a 'CoreExpr' with its (non-global) free type\n--   and value variables at every tree node.\nfreeVars = go\n  where\n    go :: CoreExpr -> CoreExprWithFVs\n    go (Var v)\n      | isLocalVar v = (aFreeVar v `unionFVs` ty_fvs, AnnVar v)\n      | otherwise    = (emptyDVarSet,                 AnnVar v)\n      where\n        ty_fvs = dVarTypeTyCoVars v\n                 -- See Note [The FVAnn invariant]\n\n    go (Lit lit) = (emptyDVarSet, AnnLit lit)\n    go (Lam b body)\n      = ( b_fvs `unionFVs` (b `delBinderFV` body_fvs)\n        , AnnLam b body' )\n      where\n        body'@(body_fvs, _) = go body\n        b_ty  = idType b\n        b_fvs = tyCoVarsOfTypeDSet b_ty\n                -- See Note [The FVAnn invariant]\n\n    go (App fun arg)\n      = ( freeVarsOf fun' `unionFVs` freeVarsOf arg'\n        , AnnApp fun' arg' )\n      where\n        fun'   = go fun\n        arg'   = go arg\n\n    go (Case scrut bndr ty alts)\n      = ( (bndr `delBinderFV` alts_fvs)\n           `unionFVs` freeVarsOf scrut2\n           `unionFVs` tyCoVarsOfTypeDSet ty\n          -- Don't need to look at (idType bndr)\n          -- because that's redundant with scrut\n        , AnnCase scrut2 bndr ty alts2 )\n      where\n        scrut2 = go scrut\n\n        (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts\n        alts_fvs            = unionFVss alts_fvs_s\n\n        fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),\n                                 (con, args, rhs2))\n                              where\n                                 rhs2 = go rhs\n\n    go (Let bind body)\n      = (bind_fvs, AnnLet bind2 body2)\n      where\n        (bind2, bind_fvs) = freeVarsBind bind (freeVarsOf body2)\n        body2             = go body\n\n    go (Cast expr co)\n      = ( freeVarsOf expr2 `unionFVs` cfvs\n        , AnnCast expr2 (cfvs, co) )\n      where\n        expr2 = go expr\n        cfvs  = tyCoVarsOfCoDSet co\n\n    go (Tick tickish expr)\n      = ( tickishFVs tickish `unionFVs` freeVarsOf expr2\n        , AnnTick tickish expr2 )\n      where\n        expr2 = go expr\n        tickishFVs (Breakpoint _ ids) = mkDVarSet ids\n        tickishFVs _                  = emptyDVarSet\n\n    go (Type ty)     = (tyCoVarsOfTypeDSet ty, AnnType ty)\n    go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co)\n", "num_lines": 778}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\nA ``lint'' pass to check for Core correctness\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule CoreLint (\n    lintCoreBindings, lintUnfolding,\n    lintPassResult, lintInteractiveExpr, lintExpr,\n    lintAnnots, lintTypes,\n\n    -- ** Debug output\n    endPass, endPassIO,\n    dumpPassResult,\n    CoreLint.dumpIfSet,\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreFVs\nimport CoreUtils\nimport CoreStats   ( coreBindsStats )\nimport CoreMonad\nimport Bag\nimport Literal\nimport DataCon\nimport TysWiredIn\nimport TysPrim\nimport TcType ( isFloatingTy )\nimport Var\nimport VarEnv\nimport VarSet\nimport Name\nimport Id\nimport IdInfo\nimport PprCore\nimport ErrUtils\nimport Coercion\nimport SrcLoc\nimport Kind\nimport Type\nimport RepType\nimport TyCoRep       -- checks validity of types/coercions\nimport TyCon\nimport CoAxiom\nimport BasicTypes\nimport ErrUtils as Err\nimport ListSetOps\nimport PrelNames\nimport Outputable\nimport FastString\nimport Util\nimport InstEnv     ( instanceDFunId )\nimport OptCoercion ( checkAxInstCo )\nimport UniqSupply\nimport CoreArity ( typeArity )\nimport Demand ( splitStrictSig, isBotRes )\n\nimport HscTypes\nimport DynFlags\nimport Control.Monad\nimport qualified Control.Monad.Fail as MonadFail\nimport MonadUtils\nimport Data.Foldable      ( toList )\nimport Data.List.NonEmpty ( NonEmpty )\nimport Data.Maybe\nimport Pair\nimport qualified GHC.LanguageExtensions as LangExt\n\n{-\nNote [GHC Formalism]\n~~~~~~~~~~~~~~~~~~~~\nThis file implements the type-checking algorithm for System FC, the \"official\"\nname of the Core language. Type safety of FC is heart of the claim that\nexecutables produced by GHC do not have segmentation faults. Thus, it is\nuseful to be able to reason about System FC independently of reading the code.\nTo this purpose, there is a document core-spec.pdf built in docs/core-spec that\ncontains a formalism of the types and functions dealt with here. If you change\njust about anything in this file or you change other types/functions throughout\nthe Core language (all signposted to this note), you should update that\nformalism. See docs/core-spec/README for more info about how to do so.\n\nNote [check vs lint]\n~~~~~~~~~~~~~~~~~~~~\nThis file implements both a type checking algorithm and also general sanity\nchecking. For example, the \"sanity checking\" checks for TyConApp on the left\nof an AppTy, which should never happen. These sanity checks don't really\naffect any notion of type soundness. Yet, it is convenient to do the sanity\nchecks at the same time as the type checks. So, we use the following naming\nconvention:\n\n- Functions that begin with 'lint'... are involved in type checking. These\n  functions might also do some sanity checking.\n\n- Functions that begin with 'check'... are *not* involved in type checking.\n  They exist only for sanity checking.\n\nIssues surrounding variable naming, shadowing, and such are considered *not*\nto be part of type checking, as the formalism omits these details.\n\nSummary of checks\n~~~~~~~~~~~~~~~~~\nChecks that a set of core bindings is well-formed.  The PprStyle and String\njust control what we print in the event of an error.  The Bool value\nindicates whether we have done any specialisation yet (in which case we do\nsome extra checks).\n\nWe check for\n        (a) type errors\n        (b) Out-of-scope type variables\n        (c) Out-of-scope local variables\n        (d) Ill-kinded types\n        (e) Incorrect unsafe coercions\n\nIf we have done specialisation the we check that there are\n        (a) No top-level bindings of primitive (unboxed type)\n\nOutstanding issues:\n\n    -- Things are *not* OK if:\n    --\n    --  * Unsaturated type app before specialisation has been done;\n    --\n    --  * Oversaturated type app after specialisation (eta reduction\n    --   may well be happening...);\n\n\nNote [Linting function types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs described in Note [Representation of function types], all saturated\napplications of funTyCon are represented with the FunTy constructor. We check\nthis invariant in lintType.\n\nNote [Linting type lets]\n~~~~~~~~~~~~~~~~~~~~~~~~\nIn the desugarer, it's very very convenient to be able to say (in effect)\n        let a = Type Int in <body>\nThat is, use a type let.   See Note [Type let] in CoreSyn.\n\nHowever, when linting <body> we need to remember that a=Int, else we might\nreject a correct program.  So we carry a type substitution (in this example\n[a -> Int]) and apply this substitution before comparing types.  The functin\n        lintInTy :: Type -> LintM (Type, Kind)\nreturns a substituted type.\n\nWhen we encounter a binder (like x::a) we must apply the substitution\nto the type of the binding variable.  lintBinders does this.\n\nFor Ids, the type-substituted Id is added to the in_scope set (which\nitself is part of the TCvSubst we are carrying down), and when we\nfind an occurrence of an Id, we fetch it from the in-scope set.\n\nNote [Bad unsafe coercion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor discussion see https://ghc.haskell.org/trac/ghc/wiki/BadUnsafeCoercions\nLinter introduces additional rules that checks improper coercion between\ndifferent types, called bad coercions. Following coercions are forbidden:\n\n  (a) coercions between boxed and unboxed values;\n  (b) coercions between unlifted values of the different sizes, here\n      active size is checked, i.e. size of the actual value but not\n      the space allocated for value;\n  (c) coercions between floating and integral boxed values, this check\n      is not yet supported for unboxed tuples, as no semantics were\n      specified for that;\n  (d) coercions from / to vector type\n  (e) If types are unboxed tuples then tuple (# A_1,..,A_n #) can be\n      coerced to (# B_1,..,B_m #) if n=m and for each pair A_i, B_i rules\n      (a-e) holds.\n\nNote [Join points]\n~~~~~~~~~~~~~~~~~~\nWe check the rules listed in Note [Invariants on join points] in CoreSyn. The\nonly one that causes any difficulty is the first: All occurrences must be tail\ncalls. To this end, along with the in-scope set, we remember in le_joins the\nsubset of in-scope Ids that are valid join ids. For example:\n\n  join j x = ... in\n  case e of\n    A -> jump j y -- good\n    B -> case (jump j z) of -- BAD\n           C -> join h = jump j w in ... -- good\n           D -> let x = jump j v in ... -- BAD\n\nA join point remains valid in case branches, so when checking the A\nbranch, j is still valid. When we check the scrutinee of the inner\ncase, however, we set le_joins to empty, and catch the\nerror. Similarly, join points can occur free in RHSes of other join\npoints but not the RHSes of value bindings (thunks and functions).\n\n************************************************************************\n*                                                                      *\n                 Beginning and ending passes\n*                                                                      *\n************************************************************************\n\nThese functions are not CoreM monad stuff, but they probably ought to\nbe, and it makes a convenient place for them.  They print out stuff\nbefore and after core passes, and do Core Lint when necessary.\n-}\n\nendPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM ()\nendPass pass binds rules\n  = do { hsc_env <- getHscEnv\n       ; print_unqual <- getPrintUnqualified\n       ; liftIO $ endPassIO hsc_env print_unqual pass binds rules }\n\nendPassIO :: HscEnv -> PrintUnqualified\n          -> CoreToDo -> CoreProgram -> [CoreRule] -> IO ()\n-- Used by the IO-is CorePrep too\nendPassIO hsc_env print_unqual pass binds rules\n  = do { dumpPassResult dflags print_unqual mb_flag\n                        (ppr pass) (pprPassDetails pass) binds rules\n       ; lintPassResult hsc_env pass binds }\n  where\n    dflags  = hsc_dflags hsc_env\n    mb_flag = case coreDumpFlag pass of\n                Just flag | dopt flag dflags                    -> Just flag\n                          | dopt Opt_D_verbose_core2core dflags -> Just flag\n                _ -> Nothing\n\ndumpIfSet :: DynFlags -> Bool -> CoreToDo -> SDoc -> SDoc -> IO ()\ndumpIfSet dflags dump_me pass extra_info doc\n  = Err.dumpIfSet dflags dump_me (showSDoc dflags (ppr pass <+> extra_info)) doc\n\ndumpPassResult :: DynFlags\n               -> PrintUnqualified\n               -> Maybe DumpFlag        -- Just df => show details in a file whose\n                                        --            name is specified by df\n               -> SDoc                  -- Header\n               -> SDoc                  -- Extra info to appear after header\n               -> CoreProgram -> [CoreRule]\n               -> IO ()\ndumpPassResult dflags unqual mb_flag hdr extra_info binds rules\n  = do { forM_ mb_flag $ \\flag ->\n           Err.dumpSDoc dflags unqual flag (showSDoc dflags hdr) dump_doc\n\n         -- Report result size\n         -- This has the side effect of forcing the intermediate to be evaluated\n         -- if it's not already forced by a -ddump flag.\n       ; Err.debugTraceMsg dflags 2 size_doc\n       }\n\n  where\n    size_doc = sep [text \"Result size of\" <+> hdr, nest 2 (equals <+> ppr (coreBindsStats binds))]\n\n    dump_doc  = vcat [ nest 2 extra_info\n                     , size_doc\n                     , blankLine\n                     , pprCoreBindingsWithSize binds\n                     , ppUnless (null rules) pp_rules ]\n    pp_rules = vcat [ blankLine\n                    , text \"------ Local rules for imported ids --------\"\n                    , pprRules rules ]\n\ncoreDumpFlag :: CoreToDo -> Maybe DumpFlag\ncoreDumpFlag (CoreDoSimplify {})      = Just Opt_D_verbose_core2core\ncoreDumpFlag (CoreDoPluginPass {})    = Just Opt_D_verbose_core2core\ncoreDumpFlag CoreDoFloatInwards       = Just Opt_D_verbose_core2core\ncoreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_verbose_core2core\ncoreDumpFlag CoreLiberateCase         = Just Opt_D_verbose_core2core\ncoreDumpFlag CoreDoStaticArgs         = Just Opt_D_verbose_core2core\ncoreDumpFlag CoreDoCallArity          = Just Opt_D_dump_call_arity\ncoreDumpFlag CoreDoExitify            = Just Opt_D_dump_exitify\ncoreDumpFlag CoreDoStrictness         = Just Opt_D_dump_stranal\ncoreDumpFlag CoreDoWorkerWrapper      = Just Opt_D_dump_worker_wrapper\ncoreDumpFlag CoreDoSpecialising       = Just Opt_D_dump_spec\ncoreDumpFlag CoreDoSpecConstr         = Just Opt_D_dump_spec\ncoreDumpFlag CoreCSE                  = Just Opt_D_dump_cse\ncoreDumpFlag CoreDesugar              = Just Opt_D_dump_ds_preopt\ncoreDumpFlag CoreDesugarOpt           = Just Opt_D_dump_ds\ncoreDumpFlag CoreTidy                 = Just Opt_D_dump_simpl\ncoreDumpFlag CorePrep                 = Just Opt_D_dump_prep\ncoreDumpFlag CoreOccurAnal            = Just Opt_D_dump_occur_anal\n\ncoreDumpFlag CoreDoPrintCore          = Nothing\ncoreDumpFlag (CoreDoRuleCheck {})     = Nothing\ncoreDumpFlag CoreDoNothing            = Nothing\ncoreDumpFlag (CoreDoPasses {})        = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n                 Top-level interfaces\n*                                                                      *\n************************************************************************\n-}\n\nlintPassResult :: HscEnv -> CoreToDo -> CoreProgram -> IO ()\nlintPassResult hsc_env pass binds\n  | not (gopt Opt_DoCoreLinting dflags)\n  = return ()\n  | otherwise\n  = do { let (warns, errs) = lintCoreBindings dflags pass (interactiveInScope hsc_env) binds\n       ; Err.showPass dflags (\"Core Linted result of \" ++ showPpr dflags pass)\n       ; displayLintResults dflags pass warns errs binds  }\n  where\n    dflags = hsc_dflags hsc_env\n\ndisplayLintResults :: DynFlags -> CoreToDo\n                   -> Bag Err.MsgDoc -> Bag Err.MsgDoc -> CoreProgram\n                   -> IO ()\ndisplayLintResults dflags pass warns errs binds\n  | not (isEmptyBag errs)\n  = do { putLogMsg dflags NoReason Err.SevDump noSrcSpan\n           (defaultDumpStyle dflags)\n           (vcat [ lint_banner \"errors\" (ppr pass), Err.pprMessageBag errs\n                 , text \"*** Offending Program ***\"\n                 , pprCoreBindings binds\n                 , text \"*** End of Offense ***\" ])\n       ; Err.ghcExit dflags 1 }\n\n  | not (isEmptyBag warns)\n  , not (hasNoDebugOutput dflags)\n  , showLintWarnings pass\n  -- If the Core linter encounters an error, output to stderr instead of\n  -- stdout (#13342)\n  = putLogMsg dflags NoReason Err.SevInfo noSrcSpan\n        (defaultDumpStyle dflags)\n        (lint_banner \"warnings\" (ppr pass) $$ Err.pprMessageBag (mapBag ($$ blankLine) warns))\n\n  | otherwise = return ()\n  where\n\nlint_banner :: String -> SDoc -> SDoc\nlint_banner string pass = text \"*** Core Lint\"      <+> text string\n                          <+> text \": in result of\" <+> pass\n                          <+> text \"***\"\n\nshowLintWarnings :: CoreToDo -> Bool\n-- Disable Lint warnings on the first simplifier pass, because\n-- there may be some INLINE knots still tied, which is tiresomely noisy\nshowLintWarnings (CoreDoSimplify _ (SimplMode { sm_phase = InitialPhase })) = False\nshowLintWarnings _ = True\n\nlintInteractiveExpr :: String -> HscEnv -> CoreExpr -> IO ()\nlintInteractiveExpr what hsc_env expr\n  | not (gopt Opt_DoCoreLinting dflags)\n  = return ()\n  | Just err <- lintExpr dflags (interactiveInScope hsc_env) expr\n  = do { display_lint_err err\n       ; Err.ghcExit dflags 1 }\n  | otherwise\n  = return ()\n  where\n    dflags = hsc_dflags hsc_env\n\n    display_lint_err err\n      = do { putLogMsg dflags NoReason Err.SevDump\n               noSrcSpan (defaultDumpStyle dflags)\n               (vcat [ lint_banner \"errors\" (text what)\n                     , err\n                     , text \"*** Offending Program ***\"\n                     , pprCoreExpr expr\n                     , text \"*** End of Offense ***\" ])\n           ; Err.ghcExit dflags 1 }\n\ninteractiveInScope :: HscEnv -> [Var]\n-- In GHCi we may lint expressions, or bindings arising from 'deriving'\n-- clauses, that mention variables bound in the interactive context.\n-- These are Local things (see Note [Interactively-bound Ids in GHCi] in HscTypes).\n-- So we have to tell Lint about them, lest it reports them as out of scope.\n--\n-- We do this by find local-named things that may appear free in interactive\n-- context.  This function is pretty revolting and quite possibly not quite right.\n-- When we are not in GHCi, the interactive context (hsc_IC hsc_env) is empty\n-- so this is a (cheap) no-op.\n--\n-- See Trac #8215 for an example\ninteractiveInScope hsc_env\n  = tyvars ++ ids\n  where\n    -- C.f. TcRnDriver.setInteractiveContext, Desugar.deSugarExpr\n    ictxt                   = hsc_IC hsc_env\n    (cls_insts, _fam_insts) = ic_instances ictxt\n    te1    = mkTypeEnvWithImplicits (ic_tythings ictxt)\n    te     = extendTypeEnvWithIds te1 (map instanceDFunId cls_insts)\n    ids    = typeEnvIds te\n    tyvars = tyCoVarsOfTypesList $ map idType ids\n              -- Why the type variables?  How can the top level envt have free tyvars?\n              -- I think it's because of the GHCi debugger, which can bind variables\n              --   f :: [t] -> [t]\n              -- where t is a RuntimeUnk (see TcType)\n\nlintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, Bag MsgDoc)\n--   Returns (warnings, errors)\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintCoreBindings dflags pass local_in_scope binds\n  = initL dflags flags in_scope_set $\n    addLoc TopLevelBindings         $\n    lintLetBndrs TopLevel binders   $\n        -- Put all the top-level binders in scope at the start\n        -- This is because transformation rules can bring something\n        -- into use 'unexpectedly'\n    do { checkL (null dups) (dupVars dups)\n       ; checkL (null ext_dups) (dupExtVars ext_dups)\n       ; mapM lint_bind binds }\n  where\n    in_scope_set = mkInScopeSet (mkVarSet local_in_scope)\n\n    flags = defaultLintFlags\n               { lf_check_global_ids = check_globals\n               , lf_check_inline_loop_breakers = check_lbs\n               , lf_check_static_ptrs = check_static_ptrs }\n\n    -- See Note [Checking for global Ids]\n    check_globals = case pass of\n                      CoreTidy -> False\n                      CorePrep -> False\n                      _        -> True\n\n    -- See Note [Checking for INLINE loop breakers]\n    check_lbs = case pass of\n                      CoreDesugar    -> False\n                      CoreDesugarOpt -> False\n                      _              -> True\n\n    -- See Note [Checking StaticPtrs]\n    check_static_ptrs | not (xopt LangExt.StaticPointers dflags) = AllowAnywhere\n                      | otherwise = case pass of\n                          CoreDoFloatOutwards _ -> AllowAtTopLevel\n                          CoreTidy              -> RejectEverywhere\n                          CorePrep              -> AllowAtTopLevel\n                          _                     -> AllowAnywhere\n\n    binders = bindersOfBinds binds\n    (_, dups) = removeDups compare binders\n\n    -- dups_ext checks for names with different uniques\n    -- but but the same External name M.n.  We don't\n    -- allow this at top level:\n    --    M.n{r3}  = ...\n    --    M.n{r29} = ...\n    -- because they both get the same linker symbol\n    ext_dups = snd (removeDups ord_ext (map Var.varName binders))\n    ord_ext n1 n2 | Just m1 <- nameModule_maybe n1\n                  , Just m2 <- nameModule_maybe n2\n                  = compare (m1, nameOccName n1) (m2, nameOccName n2)\n                  | otherwise = LT\n\n    -- If you edit this function, you may need to update the GHC formalism\n    -- See Note [GHC Formalism]\n    lint_bind (Rec prs)         = mapM_ (lintSingleBinding TopLevel Recursive) prs\n    lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[lintUnfolding]{lintUnfolding}\n*                                                                      *\n************************************************************************\n\nNote [Linting Unfoldings from Interfaces]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe use this to check all top-level unfoldings that come in from interfaces\n(it is very painful to catch errors otherwise).\n\nWe do not need to call lintUnfolding on unfoldings that are nested within\ntop-level unfoldings; they are linted when we lint the top-level unfolding;\nhence the `TopLevelFlag` on `tcPragExpr` in TcIface.\n\n-}\n\nlintUnfolding :: DynFlags\n              -> SrcLoc\n              -> VarSet         -- Treat these as in scope\n              -> CoreExpr\n              -> Maybe MsgDoc   -- Nothing => OK\n\nlintUnfolding dflags locn vars expr\n  | isEmptyBag errs = Nothing\n  | otherwise       = Just (pprMessageBag errs)\n  where\n    in_scope = mkInScopeSet vars\n    (_warns, errs) = initL dflags defaultLintFlags in_scope linter\n    linter = addLoc (ImportedUnfolding locn) $\n             lintCoreExpr expr\n\nlintExpr :: DynFlags\n         -> [Var]               -- Treat these as in scope\n         -> CoreExpr\n         -> Maybe MsgDoc        -- Nothing => OK\n\nlintExpr dflags vars expr\n  | isEmptyBag errs = Nothing\n  | otherwise       = Just (pprMessageBag errs)\n  where\n    in_scope = mkInScopeSet (mkVarSet vars)\n    (_warns, errs) = initL dflags defaultLintFlags in_scope linter\n    linter = addLoc TopLevelBindings $\n             lintCoreExpr expr\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[lintCoreBinding]{lintCoreBinding}\n*                                                                      *\n************************************************************************\n\nCheck a core binding, returning the list of variables bound.\n-}\n\nlintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM ()\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintSingleBinding top_lvl_flag rec_flag (binder,rhs)\n  = addLoc (RhsOf binder) $\n         -- Check the rhs\n    do { ty <- lintRhs binder rhs\n       ; binder_ty <- applySubstTy (idType binder)\n       ; ensureEqTys binder_ty ty (mkRhsMsg binder (text \"RHS\") ty)\n\n       -- If the binding is for a CoVar, the RHS should be (Coercion co)\n       -- See Note [CoreSyn type and coercion invariant] in CoreSyn\n       ; checkL (not (isCoVar binder) || isCoArg rhs)\n                (mkLetErr binder rhs)\n\n       -- Check that it's not levity-polymorphic\n       -- Do this first, because otherwise isUnliftedType panics\n       -- Annoyingly, this duplicates the test in lintIdBdr,\n       -- because for non-rec lets we call lintSingleBinding first\n       ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty))\n                (badBndrTyMsg binder (text \"levity-polymorphic\"))\n\n        -- Check the let/app invariant\n        -- See Note [CoreSyn let/app invariant] in CoreSyn\n       ; checkL ( isJoinId binder\n               || not (isUnliftedType binder_ty)\n               || (isNonRec rec_flag && exprOkForSpeculation rhs)\n               || exprIsTickedString rhs)\n           (badBndrTyMsg binder (text \"unlifted\"))\n\n        -- Check that if the binder is top-level or recursive, it's not\n        -- demanded. Primitive string literals are exempt as there is no\n        -- computation to perform, see Note [CoreSyn top-level string literals].\n       ; checkL (not (isStrictId binder)\n            || (isNonRec rec_flag && not (isTopLevel top_lvl_flag))\n            || exprIsTickedString rhs)\n           (mkStrictMsg binder)\n\n        -- Check that if the binder is at the top level and has type Addr#,\n        -- that it is a string literal, see\n        -- Note [CoreSyn top-level string literals].\n       ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy)\n                 || exprIsTickedString rhs)\n           (mkTopNonLitStrMsg binder)\n\n       ; flags <- getLintFlags\n\n         -- Check that a join-point binder has a valid type\n         -- NB: lintIdBinder has checked that it is not top-level bound\n       ; case isJoinId_maybe binder of\n            Nothing    -> return ()\n            Just arity ->  checkL (isValidJoinPointType arity binder_ty)\n                                  (mkInvalidJoinPointMsg binder binder_ty)\n\n       ; when (lf_check_inline_loop_breakers flags\n               && isStableUnfolding (realIdUnfolding binder)\n               && isStrongLoopBreaker (idOccInfo binder)\n               && isInlinePragma (idInlinePragma binder))\n              (addWarnL (text \"INLINE binder is (non-rule) loop breaker:\" <+> ppr binder))\n              -- Only non-rule loop breakers inhibit inlining\n\n      -- Check whether arity and demand type are consistent (only if demand analysis\n      -- already happened)\n      --\n      -- Note (Apr 2014): this is actually ok.  See Note [Demand analysis for trivial right-hand sides]\n      --                  in DmdAnal.  After eta-expansion in CorePrep the rhs is no longer trivial.\n      --       ; let dmdTy = idStrictness binder\n      --       ; checkL (case dmdTy of\n      --                  StrictSig dmd_ty -> idArity binder >= dmdTypeDepth dmd_ty || exprIsTrivial rhs)\n      --           (mkArityMsg binder)\n\n       -- Check that the binder's arity is within the bounds imposed by\n       -- the type and the strictness signature. See Note [exprArity invariant]\n       -- and Note [Trimming arity]\n       ; checkL (typeArity (idType binder) `lengthAtLeast` idArity binder)\n           (text \"idArity\" <+> ppr (idArity binder) <+>\n           text \"exceeds typeArity\" <+>\n           ppr (length (typeArity (idType binder))) <> colon <+>\n           ppr binder)\n\n       ; case splitStrictSig (idStrictness binder) of\n           (demands, result_info) | isBotRes result_info ->\n             checkL (demands `lengthAtLeast` idArity binder)\n               (text \"idArity\" <+> ppr (idArity binder) <+>\n               text \"exceeds arity imposed by the strictness signature\" <+>\n               ppr (idStrictness binder) <> colon <+>\n               ppr binder)\n           _ -> return ()\n\n       ; mapM_ (lintCoreRule binder binder_ty) (idCoreRules binder)\n\n       ; addLoc (UnfoldingOf binder) $\n         lintIdUnfolding binder binder_ty (idUnfolding binder) }\n\n        -- We should check the unfolding, if any, but this is tricky because\n        -- the unfolding is a SimplifiableCoreExpr. Give up for now.\n\n-- | Checks the RHS of bindings. It only differs from 'lintCoreExpr'\n-- in that it doesn't reject occurrences of the function 'makeStatic' when they\n-- appear at the top level and @lf_check_static_ptrs == AllowAtTopLevel@, and\n-- for join points, it skips the outer lambdas that take arguments to the\n-- join point.\n--\n-- See Note [Checking StaticPtrs].\nlintRhs :: Id -> CoreExpr -> LintM OutType\nlintRhs bndr rhs\n    | Just arity <- isJoinId_maybe bndr\n    = lint_join_lams arity arity True rhs\n    | AlwaysTailCalled arity <- tailCallInfo (idOccInfo bndr)\n    = lint_join_lams arity arity False rhs\n  where\n    lint_join_lams 0 _ _ rhs\n      = lintCoreExpr rhs\n\n    lint_join_lams n tot enforce (Lam var expr)\n      = addLoc (LambdaBodyOf var) $\n        lintBinder LambdaBind var $ \\ var' ->\n        do { body_ty <- lint_join_lams (n-1) tot enforce expr\n           ; return $ mkLamType var' body_ty }\n\n    lint_join_lams n tot True _other\n      = failWithL $ mkBadJoinArityMsg bndr tot (tot-n) rhs\n    lint_join_lams _ _ False rhs\n      = markAllJoinsBad $ lintCoreExpr rhs\n          -- Future join point, not yet eta-expanded\n          -- Body is not a tail position\n\n-- Allow applications of the data constructor @StaticPtr@ at the top\n-- but produce errors otherwise.\nlintRhs _bndr rhs = fmap lf_check_static_ptrs getLintFlags >>= go\n  where\n    -- Allow occurrences of 'makeStatic' at the top-level but produce errors\n    -- otherwise.\n    go AllowAtTopLevel\n      | (binders0, rhs') <- collectTyBinders rhs\n      , Just (fun, t, info, e) <- collectMakeStaticArgs rhs'\n      = markAllJoinsBad $\n        foldr\n        -- imitate @lintCoreExpr (Lam ...)@\n        (\\var loopBinders ->\n          addLoc (LambdaBodyOf var) $\n            lintBinder LambdaBind var $ \\var' ->\n              do { body_ty <- loopBinders\n                 ; return $ mkLamType var' body_ty }\n        )\n        -- imitate @lintCoreExpr (App ...)@\n        (do fun_ty <- lintCoreExpr fun\n            addLoc (AnExpr rhs') $ lintCoreArgs fun_ty [Type t, info, e]\n        )\n        binders0\n    go _ = markAllJoinsBad $ lintCoreExpr rhs\n\nlintIdUnfolding :: Id -> Type -> Unfolding -> LintM ()\nlintIdUnfolding bndr bndr_ty uf\n  | isStableUnfolding uf\n  , Just rhs <- maybeUnfoldingTemplate uf\n  = do { ty <- lintRhs bndr rhs\n       ; ensureEqTys bndr_ty ty (mkRhsMsg bndr (text \"unfolding\") ty) }\nlintIdUnfolding  _ _ _\n  = return ()       -- Do not Lint unstable unfoldings, because that leads\n                    -- to exponential behaviour; c.f. CoreFVs.idUnfoldingVars\n\n{-\nNote [Checking for INLINE loop breakers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's very suspicious if a strong loop breaker is marked INLINE.\n\nHowever, the desugarer generates instance methods with INLINE pragmas\nthat form a mutually recursive group.  Only after a round of\nsimplification are they unravelled.  So we suppress the test for\nthe desugarer.\n\n************************************************************************\n*                                                                      *\n\\subsection[lintCoreExpr]{lintCoreExpr}\n*                                                                      *\n************************************************************************\n-}\n\n-- For OutType, OutKind, the substitution has been applied,\n--                       but has not been linted yet\n\ntype LintedType  = Type -- Substitution applied, and type is linted\ntype LintedKind  = Kind\n\nlintCoreExpr :: CoreExpr -> LintM OutType\n-- The returned type has the substitution from the monad\n-- already applied to it:\n--      lintCoreExpr e subst = exprType (subst e)\n--\n-- The returned \"type\" can be a kind, if the expression is (Type ty)\n\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintCoreExpr (Var var)\n  = lintVarOcc var 0\n\nlintCoreExpr (Lit lit)\n  = return (literalType lit)\n\nlintCoreExpr (Cast expr co)\n  = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr\n       ; co' <- applySubstCo co\n       ; (_, k2, from_ty, to_ty, r) <- lintCoercion co'\n       ; checkValueKind k2 (text \"target of cast\" <+> quotes (ppr co))\n       ; lintRole co' Representational r\n       ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty)\n       ; return to_ty }\n\nlintCoreExpr (Tick tickish expr)\n  = do case tickish of\n         Breakpoint _ ids -> forM_ ids $ \\id -> do\n                               checkDeadIdOcc id\n                               lookupIdInScope id\n         _                -> return ()\n       markAllJoinsBadIf block_joins $ lintCoreExpr expr\n  where\n    block_joins = not (tickish `tickishScopesLike` SoftScope)\n      -- TODO Consider whether this is the correct rule. It is consistent with\n      -- the simplifier's behaviour - cost-centre-scoped ticks become part of\n      -- the continuation, and thus they behave like part of an evaluation\n      -- context, but soft-scoped and non-scoped ticks simply wrap the result\n      -- (see Simplify.simplTick).\n\nlintCoreExpr (Let (NonRec tv (Type ty)) body)\n  | isTyVar tv\n  =     -- See Note [Linting type lets]\n    do  { ty' <- applySubstTy ty\n        ; lintTyBndr tv              $ \\ tv' ->\n    do  { addLoc (RhsOf tv) $ lintTyKind tv' ty'\n                -- Now extend the substitution so we\n                -- take advantage of it in the body\n        ; extendSubstL tv ty'        $\n          addLoc (BodyOfLetRec [tv]) $\n          lintCoreExpr body } }\n\nlintCoreExpr (Let (NonRec bndr rhs) body)\n  | isId bndr\n  = do  { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs)\n        ; addLoc (BodyOfLetRec [bndr])\n                 (lintBinder LetBind bndr $ \\_ ->\n                  addGoodJoins [bndr] $\n                  lintCoreExpr body) }\n\n  | otherwise\n  = failWithL (mkLetErr bndr rhs)       -- Not quite accurate\n\nlintCoreExpr e@(Let (Rec pairs) body)\n  = lintLetBndrs NotTopLevel bndrs $\n    addGoodJoins bndrs             $\n    do  { -- Check that the list of pairs is non-empty\n          checkL (not (null pairs)) (emptyRec e)\n\n          -- Check that there are no duplicated binders\n        ; checkL (null dups) (dupVars dups)\n\n          -- Check that either all the binders are joins, or none\n        ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $\n            mkInconsistentRecMsg bndrs\n\n        ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs\n        ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) }\n  where\n    bndrs = map fst pairs\n    (_, dups) = removeDups compare bndrs\n\nlintCoreExpr e@(App _ _)\n  = addLoc (AnExpr e) $\n    do { fun_ty <- lintCoreFun fun (length args)\n       ; lintCoreArgs fun_ty args }\n  where\n    (fun, args) = collectArgs e\n\nlintCoreExpr (Lam var expr)\n  = addLoc (LambdaBodyOf var) $\n    markAllJoinsBad $\n    lintBinder LambdaBind var $ \\ var' ->\n    do { body_ty <- lintCoreExpr expr\n       ; return $ mkLamType var' body_ty }\n\nlintCoreExpr e@(Case scrut var alt_ty alts) =\n       -- Check the scrutinee\n  do { let scrut_diverges = exprIsBottom scrut\n     ; scrut_ty <- markAllJoinsBad $ lintCoreExpr scrut\n     ; (alt_ty, _) <- lintInTy alt_ty\n     ; (var_ty, _) <- lintInTy (idType var)\n\n     -- We used to try to check whether a case expression with no\n     -- alternatives was legitimate, but this didn't work.\n     -- See Note [No alternatives lint check] for details.\n\n     -- See Note [Rules for floating-point comparisons] in PrelRules\n     ; let isLitPat (LitAlt _, _ , _) = True\n           isLitPat _                 = False\n     ; checkL (not $ isFloatingTy scrut_ty && any isLitPat alts)\n         (ptext (sLit $ \"Lint warning: Scrutinising floating-point \" ++\n                        \"expression with literal pattern in case \" ++\n                        \"analysis (see Trac #9238).\")\n          $$ text \"scrut\" <+> ppr scrut)\n\n     ; case tyConAppTyCon_maybe (idType var) of\n         Just tycon\n              | debugIsOn\n              , isAlgTyCon tycon\n              , not (isAbstractTyCon tycon)\n              , null (tyConDataCons tycon)\n              , not scrut_diverges\n              -> pprTrace \"Lint warning: case binder's type has no constructors\" (ppr var <+> ppr (idType var))\n                        -- This can legitimately happen for type families\n                      $ return ()\n         _otherwise -> return ()\n\n        -- Don't use lintIdBndr on var, because unboxed tuple is legitimate\n\n     ; subst <- getTCvSubst\n     ; ensureEqTys var_ty scrut_ty (mkScrutMsg var var_ty scrut_ty subst)\n\n     ; lintBinder CaseBind var $ \\_ ->\n       do { -- Check the alternatives\n            mapM_ (lintCoreAlt scrut_ty alt_ty) alts\n          ; checkCaseAlts e scrut_ty alts\n          ; return alt_ty } }\n\n-- This case can't happen; linting types in expressions gets routed through\n-- lintCoreArgs\nlintCoreExpr (Type ty)\n  = failWithL (text \"Type found as expression\" <+> ppr ty)\n\nlintCoreExpr (Coercion co)\n  = do { (k1, k2, ty1, ty2, role) <- lintInCo co\n       ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) }\n\n----------------------\nlintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed\n            -> LintM Type -- returns type of the *variable*\nlintVarOcc var nargs\n  = do  { checkL (isNonCoVarId var)\n                 (text \"Non term variable\" <+> ppr var)\n                 -- See CoreSyn Note [Variable occurrences in Core]\n\n        -- Cneck that the type of the occurrence is the same\n        -- as the type of the binding site\n        ; ty   <- applySubstTy (idType var)\n        ; var' <- lookupIdInScope var\n        ; let ty' = idType var'\n        ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty\n\n          -- Check for a nested occurrence of the StaticPtr constructor.\n          -- See Note [Checking StaticPtrs].\n        ; lf <- getLintFlags\n        ; when (nargs /= 0 && lf_check_static_ptrs lf /= AllowAnywhere) $\n            checkL (idName var /= makeStaticName) $\n              text \"Found makeStatic nested in an expression\"\n\n        ; checkDeadIdOcc var\n        ; checkJoinOcc var nargs\n\n        ; return (idType var') }\n\nlintCoreFun :: CoreExpr\n            -> Int        -- Number of arguments (type or val) being passed\n            -> LintM Type -- Returns type of the *function*\nlintCoreFun (Var var) nargs\n  = lintVarOcc var nargs\n\nlintCoreFun (Lam var body) nargs\n  -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; see\n  -- Note [Beta redexes]\n  | nargs /= 0\n  = addLoc (LambdaBodyOf var) $\n    lintBinder LambdaBind var $ \\ var' ->\n    do { body_ty <- lintCoreFun body (nargs - 1)\n       ; return $ mkLamType var' body_ty }\n\nlintCoreFun expr nargs\n  = markAllJoinsBadIf (nargs /= 0) $\n    lintCoreExpr expr\n\n------------------\ncheckDeadIdOcc :: Id -> LintM ()\n-- Occurrences of an Id should never be dead....\n-- except when we are checking a case pattern\ncheckDeadIdOcc id\n  | isDeadOcc (idOccInfo id)\n  = do { in_case <- inCasePat\n       ; checkL in_case\n                (text \"Occurrence of a dead Id\" <+> ppr id) }\n  | otherwise\n  = return ()\n\n------------------\ncheckJoinOcc :: Id -> JoinArity -> LintM ()\n-- Check that if the occurrence is a JoinId, then so is the\n-- binding site, and it's a valid join Id\ncheckJoinOcc var n_args\n  | Just join_arity_occ <- isJoinId_maybe var\n  = do { mb_join_arity_bndr <- lookupJoinId var\n       ; case mb_join_arity_bndr of {\n           Nothing -> -- Binder is not a join point\n                      addErrL (invalidJoinOcc var) ;\n\n           Just join_arity_bndr ->\n\n    do { checkL (join_arity_bndr == join_arity_occ) $\n           -- Arity differs at binding site and occurrence\n         mkJoinBndrOccMismatchMsg var join_arity_bndr join_arity_occ\n\n       ; checkL (n_args == join_arity_occ) $\n           -- Arity doesn't match #args\n         mkBadJumpMsg var join_arity_occ n_args } } }\n\n  | otherwise\n  = return ()\n\n{-\nNote [No alternatives lint check]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCase expressions with no alternatives are odd beasts, and it would seem\nlike they would worth be looking at in the linter (cf Trac #10180). We\nused to check two things:\n\n* exprIsHNF is false: it would *seem* to be terribly wrong if\n  the scrutinee was already in head normal form.\n\n* exprIsBottom is true: we should be able to see why GHC believes the\n  scrutinee is diverging for sure.\n\nIt was already known that the second test was not entirely reliable.\nUnfortunately (Trac #13990), the first test turned out not to be reliable\neither. Getting the checks right turns out to be somewhat complicated.\n\nFor example, suppose we have (comment 8)\n\n  data T a where\n    TInt :: T Int\n\n  absurdTBool :: T Bool -> a\n  absurdTBool v = case v of\n\n  data Foo = Foo !(T Bool)\n\n  absurdFoo :: Foo -> a\n  absurdFoo (Foo x) = absurdTBool x\n\nGHC initially accepts the empty case because of the GADT conditions. But then\nwe inline absurdTBool, getting\n\n  absurdFoo (Foo x) = case x of\n\nx is in normal form (because the Foo constructor is strict) but the\ncase is empty. To avoid this problem, GHC would have to recognize\nthat matching on Foo x is already absurd, which is not so easy.\n\nMore generally, we don't really know all the ways that GHC can\nlose track of why an expression is bottom, so we shouldn't make too\nmuch fuss when that happens.\n\n\nNote [Beta redexes]\n~~~~~~~~~~~~~~~~~~~\nConsider:\n\n  join j @x y z = ... in\n  (\\@x y z -> jump j @x y z) @t e1 e2\n\nThis is clearly ill-typed, since the jump is inside both an application and a\nlambda, either of which is enough to disqualify it as a tail call (see Note\n[Invariants on join points] in CoreSyn). However, strictly from a\nlambda-calculus perspective, the term doesn't go wrong---after the two beta\nreductions, the jump *is* a tail call and everything is fine.\n\nWhy would we want to allow this when we have let? One reason is that a compound\nbeta redex (that is, one with more than one argument) has different scoping\nrules: naively reducing the above example using lets will capture any free\noccurrence of y in e2. More fundamentally, type lets are tricky; many passes,\nsuch as Float Out, tacitly assume that the incoming program's type lets have\nall been dealt with by the simplifier. Thus we don't want to let-bind any types\nin, say, CoreSubst.simpleOptPgm, which in some circumstances can run immediately\nbefore Float Out.\n\nAll that said, currently CoreSubst.simpleOptPgm is the only thing using this\nloophole, doing so to avoid re-traversing large functions (beta-reducing a type\nlambda without introducing a type let requires a substitution). TODO: Improve\nsimpleOptPgm so that we can forget all this ever happened.\n\n************************************************************************\n*                                                                      *\n\\subsection[lintCoreArgs]{lintCoreArgs}\n*                                                                      *\n************************************************************************\n\nThe basic version of these functions checks that the argument is a\nsubtype of the required type, as one would expect.\n-}\n\n\nlintCoreArgs  :: OutType -> [CoreArg] -> LintM OutType\nlintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args\n\nlintCoreArg  :: OutType -> CoreArg -> LintM OutType\nlintCoreArg fun_ty (Type arg_ty)\n  = do { checkL (not (isCoercionTy arg_ty))\n                (text \"Unnecessary coercion-to-type injection:\"\n                  <+> ppr arg_ty)\n       ; arg_ty' <- applySubstTy arg_ty\n       ; lintTyApp fun_ty arg_ty' }\n\nlintCoreArg fun_ty arg\n  = do { arg_ty <- markAllJoinsBad $ lintCoreExpr arg\n           -- See Note [Levity polymorphism invariants] in CoreSyn\n       ; lintL (not (isTypeLevPoly arg_ty))\n           (text \"Levity-polymorphic argument:\" <+>\n             (ppr arg <+> dcolon <+> parens (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))))\n          -- check for levity polymorphism first, because otherwise isUnliftedType panics\n\n       ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg)\n                (mkLetAppMsg arg)\n       ; lintValApp arg fun_ty arg_ty }\n\n-----------------\nlintAltBinders :: OutType     -- Scrutinee type\n               -> OutType     -- Constructor type\n               -> [OutVar]    -- Binders\n               -> LintM ()\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintAltBinders scrut_ty con_ty []\n  = ensureEqTys con_ty scrut_ty (mkBadPatMsg con_ty scrut_ty)\nlintAltBinders scrut_ty con_ty (bndr:bndrs)\n  | isTyVar bndr\n  = do { con_ty' <- lintTyApp con_ty (mkTyVarTy bndr)\n       ; lintAltBinders scrut_ty con_ty' bndrs }\n  | otherwise\n  = do { con_ty' <- lintValApp (Var bndr) con_ty (idType bndr)\n       ; lintAltBinders scrut_ty con_ty' bndrs }\n\n-----------------\nlintTyApp :: OutType -> OutType -> LintM OutType\nlintTyApp fun_ty arg_ty\n  | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty\n  = do  { lintTyKind tv arg_ty\n        ; in_scope <- getInScope\n        -- substTy needs the set of tyvars in scope to avoid generating\n        -- uniques that are already in scope.\n        -- See Note [The substitution invariant] in TyCoRep\n        ; return (substTyWithInScope in_scope [tv] [arg_ty] body_ty) }\n\n  | otherwise\n  = failWithL (mkTyAppMsg fun_ty arg_ty)\n\n-----------------\nlintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType\nlintValApp arg fun_ty arg_ty\n  | Just (arg,res) <- splitFunTy_maybe fun_ty\n  = do { ensureEqTys arg arg_ty err1\n       ; return res }\n  | otherwise\n  = failWithL err2\n  where\n    err1 = mkAppMsg       fun_ty arg_ty arg\n    err2 = mkNonFunAppMsg fun_ty arg_ty arg\n\nlintTyKind :: OutTyVar -> OutType -> LintM ()\n-- Both args have had substitution applied\n\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintTyKind tyvar arg_ty\n        -- Arg type might be boxed for a function with an uncommitted\n        -- tyvar; notably this is used so that we can give\n        --      error :: forall a:*. String -> a\n        -- and then apply it to both boxed and unboxed types.\n  = do { arg_kind <- lintType arg_ty\n       ; unless (arg_kind `eqType` tyvar_kind)\n                (addErrL (mkKindErrMsg tyvar arg_ty $$ (text \"Linted Arg kind:\" <+> ppr arg_kind))) }\n  where\n    tyvar_kind = tyVarKind tyvar\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[lintCoreAlts]{lintCoreAlts}\n*                                                                      *\n************************************************************************\n-}\n\ncheckCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM ()\n-- a) Check that the alts are non-empty\n-- b1) Check that the DEFAULT comes first, if it exists\n-- b2) Check that the others are in increasing order\n-- c) Check that there's a default for infinite types\n-- NB: Algebraic cases are not necessarily exhaustive, because\n--     the simplifier correctly eliminates case that can't\n--     possibly match.\n\ncheckCaseAlts e ty alts =\n  do { checkL (all non_deflt con_alts) (mkNonDefltMsg e)\n     ; checkL (increasing_tag con_alts) (mkNonIncreasingAltsMsg e)\n\n          -- For types Int#, Word# with an infinite (well, large!) number of\n          -- possible values, there should usually be a DEFAULT case\n          -- But (see Note [Empty case alternatives] in CoreSyn) it's ok to\n          -- have *no* case alternatives.\n          -- In effect, this is a kind of partial test. I suppose it's possible\n          -- that we might *know* that 'x' was 1 or 2, in which case\n          --   case x of { 1 -> e1; 2 -> e2 }\n          -- would be fine.\n     ; checkL (isJust maybe_deflt || not is_infinite_ty || null alts)\n              (nonExhaustiveAltsMsg e) }\n  where\n    (con_alts, maybe_deflt) = findDefault alts\n\n        -- Check that successive alternatives have strictly increasing tags\n    increasing_tag (alt1 : rest@( alt2 : _)) = alt1 `ltAlt` alt2 && increasing_tag rest\n    increasing_tag _                         = True\n\n    non_deflt (DEFAULT, _, _) = False\n    non_deflt _               = True\n\n    is_infinite_ty = case tyConAppTyCon_maybe ty of\n                        Nothing    -> False\n                        Just tycon -> isPrimTyCon tycon\n\nlintAltExpr :: CoreExpr -> OutType -> LintM ()\nlintAltExpr expr ann_ty\n  = do { actual_ty <- lintCoreExpr expr\n       ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) }\n\nlintCoreAlt :: OutType          -- Type of scrutinee\n            -> OutType          -- Type of the alternative\n            -> CoreAlt\n            -> LintM ()\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintCoreAlt _ alt_ty (DEFAULT, args, rhs) =\n  do { lintL (null args) (mkDefaultArgsMsg args)\n     ; lintAltExpr rhs alt_ty }\n\nlintCoreAlt scrut_ty alt_ty (LitAlt lit, args, rhs)\n  | litIsLifted lit\n  = failWithL integerScrutinisedMsg\n  | otherwise\n  = do { lintL (null args) (mkDefaultArgsMsg args)\n       ; ensureEqTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty)\n       ; lintAltExpr rhs alt_ty }\n  where\n    lit_ty = literalType lit\n\nlintCoreAlt scrut_ty alt_ty alt@(DataAlt con, args, rhs)\n  | isNewTyCon (dataConTyCon con)\n  = addErrL (mkNewTyDataConAltMsg scrut_ty alt)\n  | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty\n  = addLoc (CaseAlt alt) $  do\n    {   -- First instantiate the universally quantified\n        -- type variables of the data constructor\n        -- We've already check\n      lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con)\n    ; let con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys\n\n        -- And now bring the new binders into scope\n    ; lintBinders CasePatBind args $ \\ args' -> do\n    { addLoc (CasePat alt) (lintAltBinders scrut_ty con_payload_ty args')\n    ; lintAltExpr rhs alt_ty } }\n\n  | otherwise   -- Scrut-ty is wrong shape\n  = addErrL (mkBadAltMsg scrut_ty alt)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[lint-types]{Types}\n*                                                                      *\n************************************************************************\n-}\n\n-- When we lint binders, we (one at a time and in order):\n--  1. Lint var types or kinds (possibly substituting)\n--  2. Add the binder to the in scope set, and if its a coercion var,\n--     we may extend the substitution to reflect its (possibly) new kind\nlintBinders :: BindingSite -> [Var] -> ([Var] -> LintM a) -> LintM a\nlintBinders _    []         linterF = linterF []\nlintBinders site (var:vars) linterF = lintBinder site var $ \\var' ->\n                                      lintBinders site vars $ \\ vars' ->\n                                      linterF (var':vars')\n\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a\nlintBinder site var linterF\n  | isTyVar var = lintTyBndr                  var linterF\n  | isCoVar var = lintCoBndr                  var linterF\n  | otherwise   = lintIdBndr NotTopLevel site var linterF\n\nlintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a\nlintTyBndr tv thing_inside\n  = do { subst <- getTCvSubst\n       ; let (subst', tv') = substTyVarBndr subst tv\n       ; lintKind (varType tv')\n       ; updateTCvSubst subst' (thing_inside tv') }\n\nlintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a\nlintCoBndr cv thing_inside\n  = do { subst <- getTCvSubst\n       ; let (subst', cv') = substCoVarBndr subst cv\n       ; lintKind (varType cv')\n       ; lintL (isCoVarType (varType cv'))\n               (text \"CoVar with non-coercion type:\" <+> pprTyVar cv)\n       ; updateTCvSubst subst' (thing_inside cv') }\n\nlintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a\nlintLetBndrs top_lvl ids linterF\n  = go ids\n  where\n    go []       = linterF\n    go (id:ids) = lintIdBndr top_lvl LetBind id  $ \\_ ->\n                  go ids\n\nlintIdBndr :: TopLevelFlag -> BindingSite\n           -> InVar -> (OutVar -> LintM a) -> LintM a\n-- Do substitution on the type of a binder and add the var with this\n-- new type to the in-scope set of the second argument\n-- ToDo: lint its rules\nlintIdBndr top_lvl bind_site id linterF\n  = ASSERT2( isId id, ppr id )\n    do { flags <- getLintFlags\n       ; checkL (not (lf_check_global_ids flags) || isLocalId id)\n                (text \"Non-local Id binder\" <+> ppr id)\n                -- See Note [Checking for global Ids]\n\n       -- Check that if the binder is nested, it is not marked as exported\n       ; checkL (not (isExportedId id) || is_top_lvl)\n           (mkNonTopExportedMsg id)\n\n       -- Check that if the binder is nested, it does not have an external name\n       ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl)\n           (mkNonTopExternalNameMsg id)\n\n       ; (ty, k) <- lintInTy (idType id)\n\n          -- See Note [Levity polymorphism invariants] in CoreSyn\n       ; lintL (isJoinId id || not (isKindLevPoly k))\n           (text \"Levity-polymorphic binder:\" <+>\n                 (ppr id <+> dcolon <+> parens (ppr ty <+> dcolon <+> ppr k)))\n\n       -- Check that a join-id is a not-top-level let-binding\n       ; when (isJoinId id) $\n         checkL (not is_top_lvl && is_let_bind) $\n         mkBadJoinBindMsg id\n\n       -- Check that the Id does not have type (t1 ~# t2) or (t1 ~R# t2);\n       -- if so, it should be a CoVar, and checked by lintCoVarBndr\n       ; lintL (not (isCoVarType ty))\n               (text \"Non-CoVar has coercion type\" <+> ppr id <+> dcolon <+> ppr ty)\n\n       ; let id' = setIdType id ty\n       ; addInScopeVar id' $ (linterF id') }\n  where\n    is_top_lvl = isTopLevel top_lvl\n    is_let_bind = case bind_site of\n                    LetBind -> True\n                    _       -> False\n\n{-\n%************************************************************************\n%*                                                                      *\n             Types\n%*                                                                      *\n%************************************************************************\n-}\n\nlintTypes :: DynFlags\n          -> [TyCoVar]   -- Treat these as in scope\n          -> [Type]\n          -> Maybe MsgDoc -- Nothing => OK\nlintTypes dflags vars tys\n  | isEmptyBag errs = Nothing\n  | otherwise       = Just (pprMessageBag errs)\n  where\n    in_scope = emptyInScopeSet\n    (_warns, errs) = initL dflags defaultLintFlags in_scope linter\n    linter = lintBinders LambdaBind vars $ \\_ ->\n             mapM_ lintInTy tys\n\nlintInTy :: InType -> LintM (LintedType, LintedKind)\n-- Types only, not kinds\n-- Check the type, and apply the substitution to it\n-- See Note [Linting type lets]\nlintInTy ty\n  = addLoc (InType ty) $\n    do  { ty' <- applySubstTy ty\n        ; k  <- lintType ty'\n        ; lintKind k  -- The kind returned by lintType is already\n                      -- a LintedKind but we also want to check that\n                      -- k :: *, which lintKind does\n        ; return (ty', k) }\n\ncheckTyCon :: TyCon -> LintM ()\ncheckTyCon tc\n  = checkL (not (isTcTyCon tc)) (text \"Found TcTyCon:\" <+> ppr tc)\n\n-------------------\nlintType :: OutType -> LintM LintedKind\n-- The returned Kind has itself been linted\n\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintType (TyVarTy tv)\n  = do { checkL (isTyVar tv) (mkBadTyVarMsg tv)\n       ; lintTyCoVarInScope tv\n       ; return (tyVarKind tv) }\n         -- We checked its kind when we added it to the envt\n\nlintType ty@(AppTy t1 t2)\n  | TyConApp {} <- t1\n  = failWithL $ text \"TyConApp to the left of AppTy:\" <+> ppr ty\n  | otherwise\n  = do { k1 <- lintType t1\n       ; k2 <- lintType t2\n       ; lint_ty_app ty k1 [(t2,k2)] }\n\nlintType ty@(TyConApp tc tys)\n  | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc\n  = do { report_unsat <- lf_report_unsat_syns <$> getLintFlags\n       ; lintTySynFamApp report_unsat ty tc tys }\n\n  | isFunTyCon tc\n  , tys `lengthIs` 4\n    -- We should never see a saturated application of funTyCon; such\n    -- applications should be represented with the FunTy constructor.\n    -- See Note [Linting function types] and\n    -- Note [Representation of function types].\n  = failWithL (hang (text \"Saturated application of (->)\") 2 (ppr ty))\n\n  | otherwise  -- Data types, data families, primitive types\n  = do { checkTyCon tc\n       ; ks <- mapM lintType tys\n       ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) }\n\n-- arrows can related *unlifted* kinds, so this has to be separate from\n-- a dependent forall.\nlintType ty@(FunTy _ t1 t2)\n  = do { k1 <- lintType t1\n       ; k2 <- lintType t2\n       ; lintArrow (text \"type or kind\" <+> quotes (ppr ty)) k1 k2 }\n\nlintType t@(ForAllTy (Bndr tv _vis) ty)\n  -- forall over types\n  | isTyVar tv\n  = lintTyBndr tv $ \\tv' ->\n    do { k <- lintType ty\n       ; checkValueKind k (text \"the body of forall:\" <+> ppr t)\n       ; case occCheckExpand [tv'] k of  -- See Note [Stupid type synonyms]\n           Just k' -> return k'\n           Nothing -> failWithL (hang (text \"Variable escape in forall:\")\n                                    2 (vcat [ text \"type:\" <+> ppr t\n                                            , text \"kind:\" <+> ppr k ]))\n    }\n\nlintType t@(ForAllTy (Bndr cv _vis) ty)\n  -- forall over coercions\n  = do { lintL (isCoVar cv)\n               (text \"Non-Tyvar or Non-Covar bound in type:\" <+> ppr t)\n       ; lintL (cv `elemVarSet` tyCoVarsOfType ty)\n               (text \"Covar does not occur in the body:\" <+> ppr t)\n       ; lintCoBndr cv $ \\_ ->\n    do { k <- lintType ty\n       ; checkValueKind k (text \"the body of forall:\" <+> ppr t)\n       ; return liftedTypeKind\n           -- We don't check variable escape here. Namely, k could refer to cv'\n           -- See Note [NthCo and newtypes] in TyCoRep\n    }}\n\nlintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty)\n\nlintType (CastTy ty co)\n  = do { k1 <- lintType ty\n       ; (k1', k2) <- lintStarCoercion co\n       ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1)\n       ; return k2 }\n\nlintType (CoercionTy co)\n  = do { (k1, k2, ty1, ty2, r) <- lintCoercion co\n       ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 }\n\n{- Note [Stupid type synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #14939)\n   type Alg cls ob = ob\n   f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b\n\nHere 'cls' appears free in b's kind, which would usually be illegal\n(because in (forall a. ty), ty's kind should not mention 'a'). But\n#in this case (Alg cls *) = *, so all is well.  Currently we allow\nthis, and make Lint expand synonyms where necessary to make it so.\n\nc.f. TcUnify.occCheckExpand and CoreUtils.coreAltsType which deal\nwith the same problem. A single systematic solution eludes me.\n-}\n\n-----------------\nlintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind\n-- The TyCon is a type synonym or a type family (not a data family)\n-- See Note [Linting type synonym applications]\n-- c.f. TcValidity.check_syn_tc_app\nlintTySynFamApp report_unsat ty tc tys\n  | report_unsat   -- Report unsaturated only if report_unsat is on\n  , tys `lengthLessThan` tyConArity tc\n  = failWithL (hang (text \"Un-saturated type application\") 2 (ppr ty))\n\n  -- Deal with type synonyms\n  | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys\n  , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys'\n  = do { -- Kind-check the argument types, but without reporting\n         -- un-saturated type families/synonyms\n         ks <- setReportUnsat False (mapM lintType tys)\n\n       ; when report_unsat $\n         do { _ <- lintType expanded_ty\n            ; return () }\n\n       ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) }\n\n  -- Otherwise this must be a type family\n  | otherwise\n  = do { ks <- mapM lintType tys\n       ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) }\n\n-----------------\nlintKind :: OutKind -> LintM ()\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintKind k = do { sk <- lintType k\n                ; unless (classifiesTypeWithValues sk)\n                         (addErrL (hang (text \"Ill-kinded kind:\" <+> ppr k)\n                                      2 (text \"has kind:\" <+> ppr sk))) }\n\n-----------------\n-- Confirms that a type is really *, #, Constraint etc\ncheckValueKind :: OutKind -> SDoc -> LintM ()\ncheckValueKind k doc\n  = lintL (classifiesTypeWithValues k)\n          (text \"Non-*-like kind when *-like expected:\" <+> ppr k $$\n           text \"when checking\" <+> doc)\n\n-----------------\nlintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintArrow what k1 k2   -- Eg lintArrow \"type or kind `blah'\" k1 k2\n                       -- or lintarrow \"coercion `blah'\" k1 k2\n  = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text \"argument\") k1))\n       ; unless (classifiesTypeWithValues k2) (addErrL (msg (text \"result\")   k2))\n       ; return liftedTypeKind }\n  where\n    msg ar k\n      = vcat [ hang (text \"Ill-kinded\" <+> ar)\n                  2 (text \"in\" <+> what)\n             , what <+> text \"kind:\" <+> ppr k ]\n\n-----------------\nlint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind\nlint_ty_app ty k tys\n  = lint_app (text \"type\" <+> quotes (ppr ty)) k tys\n\n----------------\nlint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind\nlint_co_app ty k tys\n  = lint_app (text \"coercion\" <+> quotes (ppr ty)) k tys\n\n----------------\nlintTyLit :: TyLit -> LintM ()\nlintTyLit (NumTyLit n)\n  | n >= 0    = return ()\n  | otherwise = failWithL msg\n    where msg = text \"Negative type literal:\" <+> integer n\nlintTyLit (StrTyLit _) = return ()\n\nlint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind\n-- (lint_app d fun_kind arg_tys)\n--    We have an application (f arg_ty1 .. arg_tyn),\n--    where f :: fun_kind\n-- Takes care of linting the OutTypes\n\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlint_app doc kfn kas\n    = do { in_scope <- getInScope\n         -- We need the in_scope set to satisfy the invariant in\n         -- Note [The substitution invariant] in TyCoRep\n         ; foldlM (go_app in_scope) kfn kas }\n  where\n    fail_msg extra = vcat [ hang (text \"Kind application error in\") 2 doc\n                          , nest 2 (text \"Function kind =\" <+> ppr kfn)\n                          , nest 2 (text \"Arg kinds =\" <+> ppr kas)\n                          , extra ]\n\n    go_app in_scope kfn tka\n      | Just kfn' <- coreView kfn\n      = go_app in_scope kfn' tka\n\n    go_app _ (FunTy _ kfa kfb) tka@(_,ka)\n      = do { unless (ka `eqType` kfa) $\n             addErrL (fail_msg (text \"Fun:\" <+> (ppr kfa $$ ppr tka)))\n           ; return kfb }\n\n    go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka)\n      = do { let kv_kind = varType kv\n           ; unless (ka `eqType` kv_kind) $\n             addErrL (fail_msg (text \"Forall:\" <+> (ppr kv $$ ppr kv_kind $$ ppr tka)))\n           ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn }\n\n    go_app _ kfn ka\n       = failWithL (fail_msg (text \"Not a fun:\" <+> (ppr kfn $$ ppr ka)))\n\n{- *********************************************************************\n*                                                                      *\n        Linting rules\n*                                                                      *\n********************************************************************* -}\n\nlintCoreRule :: OutVar -> OutType -> CoreRule -> LintM ()\nlintCoreRule _ _ (BuiltinRule {})\n  = return ()  -- Don't bother\n\nlintCoreRule fun fun_ty rule@(Rule { ru_name = name, ru_bndrs = bndrs\n                                   , ru_args = args, ru_rhs = rhs })\n  = lintBinders LambdaBind bndrs $ \\ _ ->\n    do { lhs_ty <- lintCoreArgs fun_ty args\n       ; rhs_ty <- case isJoinId_maybe fun of\n                     Just join_arity\n                       -> do { checkL (args `lengthIs` join_arity) $\n                                mkBadJoinPointRuleMsg fun join_arity rule\n                               -- See Note [Rules for join points]\n                             ; lintCoreExpr rhs }\n                     _ -> markAllJoinsBad $ lintCoreExpr rhs\n       ; ensureEqTys lhs_ty rhs_ty $\n         (rule_doc <+> vcat [ text \"lhs type:\" <+> ppr lhs_ty\n                            , text \"rhs type:\" <+> ppr rhs_ty\n                            , text \"fun_ty:\" <+> ppr fun_ty ])\n       ; let bad_bndrs = filter is_bad_bndr bndrs\n\n       ; checkL (null bad_bndrs)\n                (rule_doc <+> text \"unbound\" <+> ppr bad_bndrs)\n            -- See Note [Linting rules]\n    }\n  where\n    rule_doc = text \"Rule\" <+> doubleQuotes (ftext name) <> colon\n\n    lhs_fvs = exprsFreeVars args\n    rhs_fvs = exprFreeVars rhs\n\n    is_bad_bndr :: Var -> Bool\n    -- See Note [Unbound RULE binders] in Rules\n    is_bad_bndr bndr = not (bndr `elemVarSet` lhs_fvs)\n                    && bndr `elemVarSet` rhs_fvs\n                    && isNothing (isReflCoVar_maybe bndr)\n\n\n{- Note [Linting rules]\n~~~~~~~~~~~~~~~~~~~~~~~\nIt's very bad if simplifying a rule means that one of the template\nvariables (ru_bndrs) that /is/ mentioned on the RHS becomes\nnot-mentioned in the LHS (ru_args).  How can that happen?  Well, in\nTrac #10602, SpecConstr stupidly constructed a rule like\n\n  forall x,c1,c2.\n     f (x |> c1 |> c2) = ....\n\nBut simplExpr collapses those coercions into one.  (Indeed in\nTrac #10602, it collapsed to the identity and was removed altogether.)\n\nWe don't have a great story for what to do here, but at least\nthis check will nail it.\n\nNB (Trac #11643): it's possible that a variable listed in the\nbinders becomes not-mentioned on both LHS and RHS.  Here's a silly\nexample:\n   RULE forall x y. f (g x y) = g (x+1) (y-1)\nAnd suppose worker/wrapper decides that 'x' is Absent.  Then\nwe'll end up with\n   RULE forall x y. f ($gw y) = $gw (x+1)\nThis seems sufficiently obscure that there isn't enough payoff to\ntry to trim the forall'd binder list.\n\nNote [Rules for join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA join point cannot be partially applied. However, the left-hand side of a rule\nfor a join point is effectively a *pattern*, not a piece of code, so there's an\nargument to be made for allowing a situation like this:\n\n  join $sj :: Int -> Int -> String\n       $sj n m = ...\n       j :: forall a. Eq a => a -> a -> String\n       {-# RULES \"SPEC j\" jump j @ Int $dEq = jump $sj #-}\n       j @a $dEq x y = ...\n\nApplying this rule can't turn a well-typed program into an ill-typed one, so\nconceivably we could allow it. But we can always eta-expand such an\n\"undersaturated\" rule (see 'CoreArity.etaExpandToJoinPointRule'), and in fact\nthe simplifier would have to in order to deal with the RHS. So we take a\nconservative view and don't allow undersaturated rules for join points. See\nNote [Rules and join points] in OccurAnal for further discussion.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n         Linting coercions\n*                                                                      *\n************************************************************************\n-}\n\nlintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role)\n-- Check the coercion, and apply the substitution to it\n-- See Note [Linting type lets]\nlintInCo co\n  = addLoc (InCo co) $\n    do  { co' <- applySubstCo co\n        ; lintCoercion co' }\n\n-- lints a coercion, confirming that its lh kind and its rh kind are both *\n-- also ensures that the role is Nominal\nlintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType)\nlintStarCoercion g\n  = do { (k1, k2, t1, t2, r) <- lintCoercion g\n       ; checkValueKind k1 (text \"the kind of the left type in\" <+> ppr g)\n       ; checkValueKind k2 (text \"the kind of the right type in\" <+> ppr g)\n       ; lintRole g Nominal r\n       ; return (t1, t2) }\n\nlintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role)\n-- Check the kind of a coercion term, returning the kind\n-- Post-condition: the returned OutTypes are lint-free\n--\n-- If   lintCoercion co = (k1, k2, s1, s2, r)\n-- then co :: s1 ~r s2\n--      s1 :: k1\n--      s2 :: k2\n\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\nlintCoercion (Refl ty)\n  = do { k <- lintType ty\n       ; return (k, k, ty, ty, Nominal) }\n\nlintCoercion (GRefl r ty MRefl)\n  = do { k <- lintType ty\n       ; return (k, k, ty, ty, r) }\n\nlintCoercion (GRefl r ty (MCo co))\n  = do { k <- lintType ty\n       ; (_, _, k1, k2, r') <- lintCoercion co\n       ; ensureEqTys k k1\n               (hang (text \"GRefl coercion kind mis-match:\" <+> ppr co)\n                   2 (vcat [ppr ty, ppr k, ppr k1]))\n       ; lintRole co Nominal r'\n       ; return (k1, k2, ty, mkCastTy ty co, r) }\n\nlintCoercion co@(TyConAppCo r tc cos)\n  | tc `hasKey` funTyConKey\n  , [_rep1,_rep2,_co1,_co2] <- cos\n  = do { failWithL (text \"Saturated TyConAppCo (->):\" <+> ppr co)\n       } -- All saturated TyConAppCos should be FunCos\n\n  | Just {} <- synTyConDefn_maybe tc\n  = failWithL (text \"Synonym in TyConAppCo:\" <+> ppr co)\n\n  | otherwise\n  = do { checkTyCon tc\n       ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos\n       ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's)\n       ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks)\n       ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs\n       ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) }\n\nlintCoercion co@(AppCo co1 co2)\n  | TyConAppCo {} <- co1\n  = failWithL (text \"TyConAppCo to the left of AppCo:\" <+> ppr co)\n  | Just (TyConApp {}, _) <- isReflCo_maybe co1\n  = failWithL (text \"Refl (TyConApp ...) to the left of AppCo:\" <+> ppr co)\n  | otherwise\n  = do { (k1,  k2,  s1, s2, r1) <- lintCoercion co1\n       ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2\n       ; k3 <- lint_co_app co k1 [(t1,k'1)]\n       ; k4 <- lint_co_app co k2 [(t2,k'2)]\n       ; if r1 == Phantom\n         then lintL (r2 == Phantom || r2 == Nominal)\n                     (text \"Second argument in AppCo cannot be R:\" $$\n                      ppr co)\n         else lintRole co Nominal r2\n       ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) }\n\n----------\nlintCoercion (ForAllCo tv1 kind_co co)\n  -- forall over types\n  | isTyVar tv1\n  = do { (_, k2) <- lintStarCoercion kind_co\n       ; let tv2 = setTyVarKind tv1 k2\n       ; addInScopeVar tv1 $\n    do {\n       ; (k3, k4, t1, t2, r) <- lintCoercion co\n       ; in_scope <- getInScope\n       ; let tyl = mkInvForAllTy tv1 t1\n             subst = mkTvSubst in_scope $\n                     -- We need both the free vars of the `t2` and the\n                     -- free vars of the range of the substitution in\n                     -- scope. All the free vars of `t2` and `kind_co` should\n                     -- already be in `in_scope`, because they've been\n                     -- linted and `tv2` has the same unique as `tv1`.\n                     -- See Note [The substitution invariant]\n                     unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co)\n             tyr = mkInvForAllTy tv2 $\n                   substTy subst t2\n       ; return (k3, k4, tyl, tyr, r) } }\n\nlintCoercion (ForAllCo cv1 kind_co co)\n  -- forall over coercions\n  = ASSERT( isCoVar cv1 )\n    do { lintL (almostDevoidCoVarOfCo cv1 co)\n               (text \"Covar can only appear in Refl and GRefl: \" <+> ppr co)\n       ; (_, k2) <- lintStarCoercion kind_co\n       ; let cv2 = setVarType cv1 k2\n       ; addInScopeVar cv1 $\n    do {\n       ; (k3, k4, t1, t2, r) <- lintCoercion co\n       ; checkValueKind k3 (text \"the body of a ForAllCo over covar:\" <+> ppr co)\n       ; checkValueKind k4 (text \"the body of a ForAllCo over covar:\" <+> ppr co)\n           -- See Note [Weird typing rule for ForAllTy] in Type\n       ; in_scope <- getInScope\n       ; let tyl   = mkTyCoInvForAllTy cv1 t1\n             r2    = coVarRole cv1\n             kind_co' = downgradeRole r2 Nominal kind_co\n             eta1  = mkNthCo r2 2 kind_co'\n             eta2  = mkNthCo r2 3 kind_co'\n             subst = mkCvSubst in_scope $\n                     -- We need both the free vars of the `t2` and the\n                     -- free vars of the range of the substitution in\n                     -- scope. All the free vars of `t2` and `kind_co` should\n                     -- already be in `in_scope`, because they've been\n                     -- linted and `cv2` has the same unique as `cv1`.\n                     -- See Note [The substitution invariant]\n                     unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2)\n                                          `mkTransCo` (mkSymCo eta2))\n             tyr = mkTyCoInvForAllTy cv2 $\n                   substTy subst t2\n       ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } }\n                   -- See Note [Weird typing rule for ForAllTy] in Type\n\nlintCoercion co@(FunCo r co1 co2)\n  = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1\n       ; (k2,k'2,s2,t2,r2) <- lintCoercion co2\n       ; k <- lintArrow (text \"coercion\" <+> quotes (ppr co)) k1 k2\n       ; k' <- lintArrow (text \"coercion\" <+> quotes (ppr co)) k'1 k'2\n       ; lintRole co1 r r1\n       ; lintRole co2 r r2\n       ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) }\n\nlintCoercion (CoVarCo cv)\n  | not (isCoVar cv)\n  = failWithL (hang (text \"Bad CoVarCo:\" <+> ppr cv)\n                  2 (text \"With offending type:\" <+> ppr (varType cv)))\n  | otherwise\n  = do { lintTyCoVarInScope cv\n       ; cv' <- lookupIdInScope cv\n       ; lintUnliftedCoVar cv\n       ; return $ coVarKindsTypesRole cv' }\n\n-- See Note [Bad unsafe coercion]\nlintCoercion co@(UnivCo prov r ty1 ty2)\n  = do { k1 <- lintType ty1\n       ; k2 <- lintType ty2\n       ; case prov of\n           UnsafeCoerceProv -> return ()  -- no extra checks\n\n           PhantomProv kco    -> do { lintRole co Phantom r\n                                    ; check_kinds kco k1 k2 }\n\n           ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $\n                                          mkBadProofIrrelMsg ty1 co\n                                    ; lintL (isCoercionTy ty2) $\n                                          mkBadProofIrrelMsg ty2 co\n                                    ; check_kinds kco k1 k2 }\n\n           PluginProv _     -> return ()  -- no extra checks\n\n       ; when (r /= Phantom && classifiesTypeWithValues k1\n                            && classifiesTypeWithValues k2)\n              (checkTypes ty1 ty2)\n       ; return (k1, k2, ty1, ty2, r) }\n   where\n     report s = hang (text $ \"Unsafe coercion: \" ++ s)\n                     2 (vcat [ text \"From:\" <+> ppr ty1\n                             , text \"  To:\" <+> ppr ty2])\n     isUnBoxed :: PrimRep -> Bool\n     isUnBoxed = not . isGcPtrRep\n\n       -- see #9122 for discussion of these checks\n     checkTypes t1 t2\n       = do { checkWarnL (not lev_poly1)\n                         (report \"left-hand type is levity-polymorphic\")\n            ; checkWarnL (not lev_poly2)\n                         (report \"right-hand type is levity-polymorphic\")\n            ; when (not (lev_poly1 || lev_poly2)) $\n              do { checkWarnL (reps1 `equalLength` reps2)\n                              (report \"between values with different # of reps\")\n                 ; zipWithM_ validateCoercion reps1 reps2 }}\n       where\n         lev_poly1 = isTypeLevPoly t1\n         lev_poly2 = isTypeLevPoly t2\n\n         -- don't look at these unless lev_poly1/2 are False\n         -- Otherwise, we get #13458\n         reps1 = typePrimRep t1\n         reps2 = typePrimRep t2\n\n     validateCoercion :: PrimRep -> PrimRep -> LintM ()\n     validateCoercion rep1 rep2\n       = do { dflags <- getDynFlags\n            ; checkWarnL (isUnBoxed rep1 == isUnBoxed rep2)\n                         (report \"between unboxed and boxed value\")\n            ; checkWarnL (TyCon.primRepSizeB dflags rep1\n                           == TyCon.primRepSizeB dflags rep2)\n                         (report \"between unboxed values of different size\")\n            ; let fl = liftM2 (==) (TyCon.primRepIsFloat rep1)\n                                   (TyCon.primRepIsFloat rep2)\n            ; case fl of\n                Nothing    -> addWarnL (report \"between vector types\")\n                Just False -> addWarnL (report \"between float and integral values\")\n                _          -> return ()\n            }\n\n     check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco\n                                ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft  co)\n                                ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) }\n\n\nlintCoercion (SymCo co)\n  = do { (k1, k2, ty1, ty2, r) <- lintCoercion co\n       ; return (k2, k1, ty2, ty1, r) }\n\nlintCoercion co@(TransCo co1 co2)\n  = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1\n       ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2\n       ; ensureEqTys ty1b ty2a\n               (hang (text \"Trans coercion mis-match:\" <+> ppr co)\n                   2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b]))\n       ; lintRole co r1 r2\n       ; return (k1a, k2b, ty1a, ty2b, r1) }\n\nlintCoercion the_co@(NthCo r0 n co)\n  = do { (_, _, s, t, r) <- lintCoercion co\n       ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of\n         { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t))\n             -- works for both tyvar and covar\n             | n == 0\n             ,  (isForAllTy_ty s && isForAllTy_ty t)\n             || (isForAllTy_co s && isForAllTy_co t)\n             -> do { lintRole the_co Nominal r0\n                   ; return (ks, kt, ts, tt, r0) }\n             where\n               ts = varType tcv_s\n               tt = varType tcv_t\n               ks = typeKind ts\n               kt = typeKind tt\n\n         ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of\n         { (Just (tc_s, tys_s), Just (tc_t, tys_t))\n             | tc_s == tc_t\n             , isInjectiveTyCon tc_s r\n                 -- see Note [NthCo and newtypes] in TyCoRep\n             , tys_s `equalLength` tys_t\n             , tys_s `lengthExceeds` n\n             -> do { lintRole the_co tr r0\n                   ; return (ks, kt, ts, tt, r0) }\n             where\n               ts = getNth tys_s n\n               tt = getNth tys_t n\n               tr = nthRole r tc_s n\n               ks = typeKind ts\n               kt = typeKind tt\n\n         ; _ -> failWithL (hang (text \"Bad getNth:\")\n                              2 (ppr the_co $$ ppr s $$ ppr t)) }}}\n\nlintCoercion the_co@(LRCo lr co)\n  = do { (_,_,s,t,r) <- lintCoercion co\n       ; lintRole co Nominal r\n       ; case (splitAppTy_maybe s, splitAppTy_maybe t) of\n           (Just s_pr, Just t_pr)\n             -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal)\n             where\n               s_pick  = pickLR lr s_pr\n               t_pick  = pickLR lr t_pr\n               ks_pick = typeKind s_pick\n               kt_pick = typeKind t_pick\n\n           _ -> failWithL (hang (text \"Bad LRCo:\")\n                              2 (ppr the_co $$ ppr s $$ ppr t)) }\n\nlintCoercion (InstCo co arg)\n  = do { (k3, k4, t1',t2', r) <- lintCoercion co\n       ; (k1',k2',s1,s2, r') <- lintCoercion arg\n       ; lintRole arg Nominal r'\n       ; in_scope <- getInScope\n       ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of\n         -- forall over tvar\n         { (Just (tv1,t1), Just (tv2,t2))\n             | k1' `eqType` tyVarKind tv1\n             , k2' `eqType` tyVarKind tv2\n             -> return (k3, k4,\n                        substTyWithInScope in_scope [tv1] [s1] t1,\n                        substTyWithInScope in_scope [tv2] [s2] t2, r)\n             | otherwise\n             -> failWithL (text \"Kind mis-match in inst coercion\")\n         ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of\n         -- forall over covar\n         { (Just (cv1, t1), Just (cv2, t2))\n             | k1' `eqType` varType cv1\n             , k2' `eqType` varType cv2\n             , CoercionTy s1' <- s1\n             , CoercionTy s2' <- s2\n             -> do { return $\n                       (liftedTypeKind, liftedTypeKind\n                          -- See Note [Weird typing rule for ForAllTy] in Type\n                       , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1\n                       , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2\n                       , r) }\n             | otherwise\n             -> failWithL (text \"Kind mis-match in inst coercion\")\n         ; _ -> failWithL (text \"Bad argument of inst\") }}}\n\nlintCoercion co@(AxiomInstCo con ind cos)\n  = do { unless (0 <= ind && ind < numBranches (coAxiomBranches con))\n                (bad_ax (text \"index out of range\"))\n       ; let CoAxBranch { cab_tvs   = ktvs\n                        , cab_cvs   = cvs\n                        , cab_roles = roles\n                        , cab_lhs   = lhs\n                        , cab_rhs   = rhs } = coAxiomNthBranch con ind\n       ; unless (cos `equalLength` (ktvs ++ cvs)) $\n           bad_ax (text \"lengths\")\n       ; subst <- getTCvSubst\n       ; let empty_subst = zapTCvSubst subst\n       ; (subst_l, subst_r) <- foldlM check_ki\n                                      (empty_subst, empty_subst)\n                                      (zip3 (ktvs ++ cvs) roles cos)\n       ; let lhs' = substTys subst_l lhs\n             rhs' = substTy  subst_r rhs\n             fam_tc = coAxiomTyCon con\n       ; case checkAxInstCo co of\n           Just bad_branch -> bad_ax $ text \"inconsistent with\" <+>\n                                       pprCoAxBranch fam_tc bad_branch\n           Nothing -> return ()\n       ; let s2 = mkTyConApp fam_tc lhs'\n       ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) }\n  where\n    bad_ax what = addErrL (hang (text  \"Bad axiom application\" <+> parens what)\n                        2 (ppr co))\n\n    check_ki (subst_l, subst_r) (ktv, role, arg)\n      = do { (k', k'', s', t', r) <- lintCoercion arg\n           ; lintRole arg role r\n           ; let ktv_kind_l = substTy subst_l (tyVarKind ktv)\n                 ktv_kind_r = substTy subst_r (tyVarKind ktv)\n           ; unless (k' `eqType` ktv_kind_l)\n                    (bad_ax (text \"check_ki1\" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] ))\n           ; unless (k'' `eqType` ktv_kind_r)\n                    (bad_ax (text \"check_ki2\" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] ))\n           ; return (extendTCvSubst subst_l ktv s',\n                     extendTCvSubst subst_r ktv t') }\n\nlintCoercion (KindCo co)\n  = do { (k1, k2, _, _, _) <- lintCoercion co\n       ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) }\n\nlintCoercion (SubCo co')\n  = do { (k1,k2,s,t,r) <- lintCoercion co'\n       ; lintRole co' Nominal r\n       ; return (k1,k2,s,t,Representational) }\n\nlintCoercion this@(AxiomRuleCo co cs)\n  = do { eqs <- mapM lintCoercion cs\n       ; lintRoles 0 (coaxrAsmpRoles co) eqs\n       ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of\n           Nothing -> err \"Malformed use of AxiomRuleCo\" [ ppr this ]\n           Just (Pair l r) ->\n             return (typeKind l, typeKind r, l, r, coaxrRole co) }\n  where\n  err m xs  = failWithL $\n                hang (text m) 2 $ vcat (text \"Rule:\" <+> ppr (coaxrName co) : xs)\n\n  lintRoles n (e : es) ((_,_,_,_,r) : rs)\n    | e == r    = lintRoles (n+1) es rs\n    | otherwise = err \"Argument roles mismatch\"\n                      [ text \"In argument:\" <+> int (n+1)\n                      , text \"Expected:\" <+> ppr e\n                      , text \"Found:\" <+> ppr r ]\n  lintRoles _ [] []  = return ()\n  lintRoles n [] rs  = err \"Too many coercion arguments\"\n                          [ text \"Expected:\" <+> int n\n                          , text \"Provided:\" <+> int (n + length rs) ]\n\n  lintRoles n es []  = err \"Not enough coercion arguments\"\n                          [ text \"Expected:\" <+> int (n + length es)\n                          , text \"Provided:\" <+> int n ]\n\nlintCoercion (HoleCo h)\n  = do { addErrL $ text \"Unfilled coercion hole:\" <+> ppr h\n       ; lintCoercion (CoVarCo (coHoleCoVar h)) }\n\n\n----------\nlintUnliftedCoVar :: CoVar -> LintM ()\nlintUnliftedCoVar cv\n  = when (not (isUnliftedType (coVarKind cv))) $\n    failWithL (text \"Bad lifted equality:\" <+> ppr cv\n                 <+> dcolon <+> ppr (coVarKind cv))\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[lint-monad]{The Lint monad}\n*                                                                      *\n************************************************************************\n-}\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism]\ndata LintEnv\n  = LE { le_flags :: LintFlags       -- Linting the result of this pass\n       , le_loc   :: [LintLocInfo]   -- Locations\n\n       , le_subst :: TCvSubst  -- Current type substitution\n                               -- We also use le_subst to keep track of\n                               -- /all variables/ in scope, both Ids and TyVars\n\n       , le_joins :: IdSet     -- Join points in scope that are valid\n                               -- A subset of the InScopeSet in le_subst\n                               -- See Note [Join points]\n\n       , le_dynflags :: DynFlags     -- DynamicFlags\n       }\n\ndata LintFlags\n  = LF { lf_check_global_ids           :: Bool -- See Note [Checking for global Ids]\n       , lf_check_inline_loop_breakers :: Bool -- See Note [Checking for INLINE loop breakers]\n       , lf_check_static_ptrs :: StaticPtrCheck -- ^ See Note [Checking StaticPtrs]\n       , lf_report_unsat_syns :: Bool -- ^ See Note [Linting type synonym applications]\n    }\n\n-- See Note [Checking StaticPtrs]\ndata StaticPtrCheck\n    = AllowAnywhere\n        -- ^ Allow 'makeStatic' to occur anywhere.\n    | AllowAtTopLevel\n        -- ^ Allow 'makeStatic' calls at the top-level only.\n    | RejectEverywhere\n        -- ^ Reject any 'makeStatic' occurrence.\n  deriving Eq\n\ndefaultLintFlags :: LintFlags\ndefaultLintFlags = LF { lf_check_global_ids = False\n                      , lf_check_inline_loop_breakers = True\n                      , lf_check_static_ptrs = AllowAnywhere\n                      , lf_report_unsat_syns = True\n                      }\n\nnewtype LintM a =\n   LintM { unLintM ::\n            LintEnv ->\n            WarnsAndErrs ->           -- Error and warning messages so far\n            (Maybe a, WarnsAndErrs) } -- Result and messages (if any)\n\ntype WarnsAndErrs = (Bag MsgDoc, Bag MsgDoc)\n\n{- Note [Checking for global Ids]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBefore CoreTidy, all locally-bound Ids must be LocalIds, even\ntop-level ones. See Note [Exported LocalIds] and Trac #9857.\n\nNote [Checking StaticPtrs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee Note [Grand plan for static forms] in StaticPtrTable for an overview.\n\nEvery occurrence of the function 'makeStatic' should be moved to the\ntop level by the FloatOut pass.  It's vital that we don't have nested\n'makeStatic' occurrences after CorePrep, because we populate the Static\nPointer Table from the top-level bindings. See SimplCore Note [Grand\nplan for static forms].\n\nThe linter checks that no occurrence is left behind, nested within an\nexpression. The check is enabled only after the FloatOut, CorePrep,\nand CoreTidy passes and only if the module uses the StaticPointers\nlanguage extension. Checking more often doesn't help since the condition\ndoesn't hold until after the first FloatOut pass.\n\nNote [Type substitution]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWhy do we need a type substitution?  Consider\n        /\\(a:*). \\(x:a). /\\(a:*). id a x\nThis is ill typed, because (renaming variables) it is really\n        /\\(a:*). \\(x:a). /\\(b:*). id b x\nHence, when checking an application, we can't naively compare x's type\n(at its binding site) with its expected type (at a use site).  So we\nrename type binders as we go, maintaining a substitution.\n\nThe same substitution also supports let-type, current expressed as\n        (/\\(a:*). body) ty\nHere we substitute 'ty' for 'a' in 'body', on the fly.\n\nNote [Linting type synonym applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen linting a type-synonym, or type-family, application\n  S ty1 .. tyn\nwe behave as follows (Trac #15057, #T15664):\n\n* If lf_report_unsat_syns = True, and S has arity < n,\n  complain about an unsaturated type synonym or type family\n\n* Switch off lf_report_unsat_syns, and lint ty1 .. tyn.\n\n  Reason: catch out of scope variables or other ill-kinded gubbins,\n  even if S discards that argument entirely. E.g. (#15012):\n     type FakeOut a = Int\n     type family TF a\n     type instance TF Int = FakeOut a\n  Here 'a' is out of scope; but if we expand FakeOut, we conceal\n  that out-of-scope error.\n\n  Reason for switching off lf_report_unsat_syns: with\n  LiberalTypeSynonyms, GHC allows unsaturated synonyms provided they\n  are saturated when the type is expanded. Example\n     type T f = f Int\n     type S a = a -> a\n     type Z = T S\n  In Z's RHS, S appears unsaturated, but it is saturated when T is expanded.\n\n* If lf_report_unsat_syns is on, expand the synonym application and\n  lint the result.  Reason: want to check that synonyms are saturated\n  when the type is expanded.\n-}\n\ninstance Functor LintM where\n      fmap = liftM\n\ninstance Applicative LintM where\n      pure x = LintM $ \\ _ errs -> (Just x, errs)\n      (<*>) = ap\n\ninstance Monad LintM where\n#if !MIN_VERSION_base(4,13,0)\n  fail = MonadFail.fail\n#endif\n  m >>= k  = LintM (\\ env errs ->\n                       let (res, errs') = unLintM m env errs in\n                         case res of\n                           Just r -> unLintM (k r) env errs'\n                           Nothing -> (Nothing, errs'))\n\ninstance MonadFail.MonadFail LintM where\n    fail err = failWithL (text err)\n\ninstance HasDynFlags LintM where\n  getDynFlags = LintM (\\ e errs -> (Just (le_dynflags e), errs))\n\ndata LintLocInfo\n  = RhsOf Id            -- The variable bound\n  | LambdaBodyOf Id     -- The lambda-binder\n  | UnfoldingOf Id      -- Unfolding of a binder\n  | BodyOfLetRec [Id]   -- One of the binders\n  | CaseAlt CoreAlt     -- Case alternative\n  | CasePat CoreAlt     -- The *pattern* of the case alternative\n  | AnExpr CoreExpr     -- Some expression\n  | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which)\n  | TopLevelBindings\n  | InType Type         -- Inside a type\n  | InCo   Coercion     -- Inside a coercion\n\ninitL :: DynFlags -> LintFlags -> InScopeSet\n       -> LintM a -> WarnsAndErrs    -- Errors and warnings\ninitL dflags flags in_scope m\n  = case unLintM m env (emptyBag, emptyBag) of\n      (_, errs) -> errs\n  where\n    env = LE { le_flags = flags\n             , le_subst = mkEmptyTCvSubst in_scope\n             , le_joins = emptyVarSet\n             , le_loc = []\n             , le_dynflags = dflags }\n\nsetReportUnsat :: Bool -> LintM a -> LintM a\n-- Switch off lf_report_unsat_syns\nsetReportUnsat ru thing_inside\n  = LintM $ \\ env errs ->\n    let env' = env { le_flags = (le_flags env) { lf_report_unsat_syns = ru } }\n    in unLintM thing_inside env' errs\n\ngetLintFlags :: LintM LintFlags\ngetLintFlags = LintM $ \\ env errs -> (Just (le_flags env), errs)\n\ncheckL :: Bool -> MsgDoc -> LintM ()\ncheckL True  _   = return ()\ncheckL False msg = failWithL msg\n\n-- like checkL, but relevant to type checking\nlintL :: Bool -> MsgDoc -> LintM ()\nlintL = checkL\n\ncheckWarnL :: Bool -> MsgDoc -> LintM ()\ncheckWarnL True   _  = return ()\ncheckWarnL False msg = addWarnL msg\n\nfailWithL :: MsgDoc -> LintM a\nfailWithL msg = LintM $ \\ env (warns,errs) ->\n                (Nothing, (warns, addMsg env errs msg))\n\naddErrL :: MsgDoc -> LintM ()\naddErrL msg = LintM $ \\ env (warns,errs) ->\n              (Just (), (warns, addMsg env errs msg))\n\naddWarnL :: MsgDoc -> LintM ()\naddWarnL msg = LintM $ \\ env (warns,errs) ->\n              (Just (), (addMsg env warns msg, errs))\n\naddMsg :: LintEnv ->  Bag MsgDoc -> MsgDoc -> Bag MsgDoc\naddMsg env msgs msg\n  = ASSERT( notNull locs )\n    msgs `snocBag` mk_msg msg\n  where\n   locs = le_loc env\n   (loc, cxt1) = dumpLoc (head locs)\n   cxts        = [snd (dumpLoc loc) | loc <- locs]\n   context     = ifPprDebug (vcat (reverse cxts) $$ cxt1 $$\n                             text \"Substitution:\" <+> ppr (le_subst env))\n                            cxt1\n\n   mk_msg msg = mkLocMessage SevWarning (mkSrcSpan loc loc) (context $$ msg)\n\naddLoc :: LintLocInfo -> LintM a -> LintM a\naddLoc extra_loc m\n  = LintM $ \\ env errs ->\n    unLintM m (env { le_loc = extra_loc : le_loc env }) errs\n\ninCasePat :: LintM Bool         -- A slight hack; see the unique call site\ninCasePat = LintM $ \\ env errs -> (Just (is_case_pat env), errs)\n  where\n    is_case_pat (LE { le_loc = CasePat {} : _ }) = True\n    is_case_pat _other                           = False\n\naddInScopeVar :: Var -> LintM a -> LintM a\naddInScopeVar var m\n  = LintM $ \\ env errs ->\n    unLintM m (env { le_subst = extendTCvInScope (le_subst env) var\n                   , le_joins = delVarSet        (le_joins env) var\n               }) errs\n\nextendSubstL :: TyVar -> Type -> LintM a -> LintM a\nextendSubstL tv ty m\n  = LintM $ \\ env errs ->\n    unLintM m (env { le_subst = Type.extendTvSubst (le_subst env) tv ty }) errs\n\nupdateTCvSubst :: TCvSubst -> LintM a -> LintM a\nupdateTCvSubst subst' m\n  = LintM $ \\ env errs -> unLintM m (env { le_subst = subst' }) errs\n\nmarkAllJoinsBad :: LintM a -> LintM a\nmarkAllJoinsBad m\n  = LintM $ \\ env errs -> unLintM m (env { le_joins = emptyVarSet }) errs\n\nmarkAllJoinsBadIf :: Bool -> LintM a -> LintM a\nmarkAllJoinsBadIf True  m = markAllJoinsBad m\nmarkAllJoinsBadIf False m = m\n\naddGoodJoins :: [Var] -> LintM a -> LintM a\naddGoodJoins vars thing_inside\n  | null join_ids\n  = thing_inside\n  | otherwise\n  = LintM $ \\ env errs -> unLintM thing_inside (add_joins env) errs\n  where\n    add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids }\n    join_ids = filter isJoinId vars\n\ngetValidJoins :: LintM IdSet\ngetValidJoins = LintM (\\ env errs -> (Just (le_joins env), errs))\n\ngetTCvSubst :: LintM TCvSubst\ngetTCvSubst = LintM (\\ env errs -> (Just (le_subst env), errs))\n\ngetInScope :: LintM InScopeSet\ngetInScope = LintM (\\ env errs -> (Just (getTCvInScope $ le_subst env), errs))\n\napplySubstTy :: InType -> LintM OutType\napplySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) }\n\napplySubstCo :: InCoercion -> LintM OutCoercion\napplySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) }\n\nlookupIdInScope :: Id -> LintM Id\nlookupIdInScope id_occ\n  = do { subst <- getTCvSubst\n       ; case lookupInScope (getTCvInScope subst) id_occ of\n           Just id_bnd  -> do { checkL (not (bad_global id_bnd)) global_in_scope\n                              ; return id_bnd }\n           Nothing -> do { checkL (not is_local) local_out_of_scope\n                         ; return id_occ } }\n  where\n    is_local = mustHaveLocalBinding id_occ\n    local_out_of_scope = text \"Out of scope:\" <+> pprBndr LetBind id_occ\n    global_in_scope    = hang (text \"Occurrence is GlobalId, but binding is LocalId\")\n                            2 (pprBndr LetBind id_occ)\n    bad_global id_bnd = isGlobalId id_occ\n                     && isLocalId id_bnd\n                     && not (isWiredInName (idName id_occ))\n       -- 'bad_global' checks for the case where an /occurrence/ is\n       -- a GlobalId, but there is an enclosing binding fora a LocalId.\n       -- NB: the in-scope variables are mostly LocalIds, checked by lintIdBndr,\n       --     but GHCi adds GlobalIds from the interactive context.  These\n       --     are fine; hence the test (isLocalId id == isLocalId v)\n       -- NB: when compiling Control.Exception.Base, things like absentError\n       --     are defined locally, but appear in expressions as (global)\n       --     wired-in Ids after worker/wrapper\n       --     So we simply disable the test in this case\n\nlookupJoinId :: Id -> LintM (Maybe JoinArity)\n-- Look up an Id which should be a join point, valid here\n-- If so, return its arity, if not return Nothing\nlookupJoinId id\n  = do { join_set <- getValidJoins\n       ; case lookupVarSet join_set id of\n            Just id' -> return (isJoinId_maybe id')\n            Nothing  -> return Nothing }\n\nlintTyCoVarInScope :: TyCoVar -> LintM ()\nlintTyCoVarInScope var\n  = do { subst <- getTCvSubst\n       ; lintL (var `isInScope` subst)\n               (pprBndr LetBind var <+> text \"is out of scope\") }\n\nensureEqTys :: OutType -> OutType -> MsgDoc -> LintM ()\n-- check ty2 is subtype of ty1 (ie, has same structure but usage\n-- annotations need only be consistent, not equal)\n-- Assumes ty1,ty2 are have already had the substitution applied\nensureEqTys ty1 ty2 msg = lintL (ty1 `eqType` ty2) msg\n\nlintRole :: Outputable thing\n          => thing     -- where the role appeared\n          -> Role      -- expected\n          -> Role      -- actual\n          -> LintM ()\nlintRole co r1 r2\n  = lintL (r1 == r2)\n          (text \"Role incompatibility: expected\" <+> ppr r1 <> comma <+>\n           text \"got\" <+> ppr r2 $$\n           text \"in\" <+> ppr co)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Error messages}\n*                                                                      *\n************************************************************************\n-}\n\ndumpLoc :: LintLocInfo -> (SrcLoc, SDoc)\n\ndumpLoc (RhsOf v)\n  = (getSrcLoc v, brackets (text \"RHS of\" <+> pp_binders [v]))\n\ndumpLoc (LambdaBodyOf b)\n  = (getSrcLoc b, brackets (text \"in body of lambda with binder\" <+> pp_binder b))\n\ndumpLoc (UnfoldingOf b)\n  = (getSrcLoc b, brackets (text \"in the unfolding of\" <+> pp_binder b))\n\ndumpLoc (BodyOfLetRec [])\n  = (noSrcLoc, brackets (text \"In body of a letrec with no binders\"))\n\ndumpLoc (BodyOfLetRec bs@(_:_))\n  = ( getSrcLoc (head bs), brackets (text \"in body of letrec with binders\" <+> pp_binders bs))\n\ndumpLoc (AnExpr e)\n  = (noSrcLoc, text \"In the expression:\" <+> ppr e)\n\ndumpLoc (CaseAlt (con, args, _))\n  = (noSrcLoc, text \"In a case alternative:\" <+> parens (ppr con <+> pp_binders args))\n\ndumpLoc (CasePat (con, args, _))\n  = (noSrcLoc, text \"In the pattern of a case alternative:\" <+> parens (ppr con <+> pp_binders args))\n\ndumpLoc (ImportedUnfolding locn)\n  = (locn, brackets (text \"in an imported unfolding\"))\ndumpLoc TopLevelBindings\n  = (noSrcLoc, Outputable.empty)\ndumpLoc (InType ty)\n  = (noSrcLoc, text \"In the type\" <+> quotes (ppr ty))\ndumpLoc (InCo co)\n  = (noSrcLoc, text \"In the coercion\" <+> quotes (ppr co))\n\npp_binders :: [Var] -> SDoc\npp_binders bs = sep (punctuate comma (map pp_binder bs))\n\npp_binder :: Var -> SDoc\npp_binder b | isId b    = hsep [ppr b, dcolon, ppr (idType b)]\n            | otherwise = hsep [ppr b, dcolon, ppr (tyVarKind b)]\n\n------------------------------------------------------\n--      Messages for case expressions\n\nmkDefaultArgsMsg :: [Var] -> MsgDoc\nmkDefaultArgsMsg args\n  = hang (text \"DEFAULT case with binders\")\n         4 (ppr args)\n\nmkCaseAltMsg :: CoreExpr -> Type -> Type -> MsgDoc\nmkCaseAltMsg e ty1 ty2\n  = hang (text \"Type of case alternatives not the same as the annotation on case:\")\n         4 (vcat [ text \"Actual type:\" <+> ppr ty1,\n                   text \"Annotation on case:\" <+> ppr ty2,\n                   text \"Alt Rhs:\" <+> ppr e ])\n\nmkScrutMsg :: Id -> Type -> Type -> TCvSubst -> MsgDoc\nmkScrutMsg var var_ty scrut_ty subst\n  = vcat [text \"Result binder in case doesn't match scrutinee:\" <+> ppr var,\n          text \"Result binder type:\" <+> ppr var_ty,--(idType var),\n          text \"Scrutinee type:\" <+> ppr scrut_ty,\n     hsep [text \"Current TCv subst\", ppr subst]]\n\nmkNonDefltMsg, mkNonIncreasingAltsMsg :: CoreExpr -> MsgDoc\nmkNonDefltMsg e\n  = hang (text \"Case expression with DEFAULT not at the beginning\") 4 (ppr e)\nmkNonIncreasingAltsMsg e\n  = hang (text \"Case expression with badly-ordered alternatives\") 4 (ppr e)\n\nnonExhaustiveAltsMsg :: CoreExpr -> MsgDoc\nnonExhaustiveAltsMsg e\n  = hang (text \"Case expression with non-exhaustive alternatives\") 4 (ppr e)\n\nmkBadConMsg :: TyCon -> DataCon -> MsgDoc\nmkBadConMsg tycon datacon\n  = vcat [\n        text \"In a case alternative, data constructor isn't in scrutinee type:\",\n        text \"Scrutinee type constructor:\" <+> ppr tycon,\n        text \"Data con:\" <+> ppr datacon\n    ]\n\nmkBadPatMsg :: Type -> Type -> MsgDoc\nmkBadPatMsg con_result_ty scrut_ty\n  = vcat [\n        text \"In a case alternative, pattern result type doesn't match scrutinee type:\",\n        text \"Pattern result type:\" <+> ppr con_result_ty,\n        text \"Scrutinee type:\" <+> ppr scrut_ty\n    ]\n\nintegerScrutinisedMsg :: MsgDoc\nintegerScrutinisedMsg\n  = text \"In a LitAlt, the literal is lifted (probably Integer)\"\n\nmkBadAltMsg :: Type -> CoreAlt -> MsgDoc\nmkBadAltMsg scrut_ty alt\n  = vcat [ text \"Data alternative when scrutinee is not a tycon application\",\n           text \"Scrutinee type:\" <+> ppr scrut_ty,\n           text \"Alternative:\" <+> pprCoreAlt alt ]\n\nmkNewTyDataConAltMsg :: Type -> CoreAlt -> MsgDoc\nmkNewTyDataConAltMsg scrut_ty alt\n  = vcat [ text \"Data alternative for newtype datacon\",\n           text \"Scrutinee type:\" <+> ppr scrut_ty,\n           text \"Alternative:\" <+> pprCoreAlt alt ]\n\n\n------------------------------------------------------\n--      Other error messages\n\nmkAppMsg :: Type -> Type -> CoreExpr -> MsgDoc\nmkAppMsg fun_ty arg_ty arg\n  = vcat [text \"Argument value doesn't match argument type:\",\n              hang (text \"Fun type:\") 4 (ppr fun_ty),\n              hang (text \"Arg type:\") 4 (ppr arg_ty),\n              hang (text \"Arg:\") 4 (ppr arg)]\n\nmkNonFunAppMsg :: Type -> Type -> CoreExpr -> MsgDoc\nmkNonFunAppMsg fun_ty arg_ty arg\n  = vcat [text \"Non-function type in function position\",\n              hang (text \"Fun type:\") 4 (ppr fun_ty),\n              hang (text \"Arg type:\") 4 (ppr arg_ty),\n              hang (text \"Arg:\") 4 (ppr arg)]\n\nmkLetErr :: TyVar -> CoreExpr -> MsgDoc\nmkLetErr bndr rhs\n  = vcat [text \"Bad `let' binding:\",\n          hang (text \"Variable:\")\n                 4 (ppr bndr <+> dcolon <+> ppr (varType bndr)),\n          hang (text \"Rhs:\")\n                 4 (ppr rhs)]\n\nmkTyAppMsg :: Type -> Type -> MsgDoc\nmkTyAppMsg ty arg_ty\n  = vcat [text \"Illegal type application:\",\n              hang (text \"Exp type:\")\n                 4 (ppr ty <+> dcolon <+> ppr (typeKind ty)),\n              hang (text \"Arg type:\")\n                 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]\n\nemptyRec :: CoreExpr -> MsgDoc\nemptyRec e = hang (text \"Empty Rec binding:\") 2 (ppr e)\n\nmkRhsMsg :: Id -> SDoc -> Type -> MsgDoc\nmkRhsMsg binder what ty\n  = vcat\n    [hsep [text \"The type of this binder doesn't match the type of its\" <+> what <> colon,\n            ppr binder],\n     hsep [text \"Binder's type:\", ppr (idType binder)],\n     hsep [text \"Rhs type:\", ppr ty]]\n\nmkLetAppMsg :: CoreExpr -> MsgDoc\nmkLetAppMsg e\n  = hang (text \"This argument does not satisfy the let/app invariant:\")\n       2 (ppr e)\n\nbadBndrTyMsg :: Id -> SDoc -> MsgDoc\nbadBndrTyMsg binder what\n  = vcat [ text \"The type of this binder is\" <+> what <> colon <+> ppr binder\n         , text \"Binder's type:\" <+> ppr (idType binder) ]\n\nmkStrictMsg :: Id -> MsgDoc\nmkStrictMsg binder\n  = vcat [hsep [text \"Recursive or top-level binder has strict demand info:\",\n                     ppr binder],\n              hsep [text \"Binder's demand info:\", ppr (idDemandInfo binder)]\n             ]\n\nmkNonTopExportedMsg :: Id -> MsgDoc\nmkNonTopExportedMsg binder\n  = hsep [text \"Non-top-level binder is marked as exported:\", ppr binder]\n\nmkNonTopExternalNameMsg :: Id -> MsgDoc\nmkNonTopExternalNameMsg binder\n  = hsep [text \"Non-top-level binder has an external name:\", ppr binder]\n\nmkTopNonLitStrMsg :: Id -> MsgDoc\nmkTopNonLitStrMsg binder\n  = hsep [text \"Top-level Addr# binder has a non-literal rhs:\", ppr binder]\n\nmkKindErrMsg :: TyVar -> Type -> MsgDoc\nmkKindErrMsg tyvar arg_ty\n  = vcat [text \"Kinds don't match in type application:\",\n          hang (text \"Type variable:\")\n                 4 (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)),\n          hang (text \"Arg type:\")\n                 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]\n\n{- Not needed now\nmkArityMsg :: Id -> MsgDoc\nmkArityMsg binder\n  = vcat [hsep [text \"Demand type has\",\n                ppr (dmdTypeDepth dmd_ty),\n                text \"arguments, rhs has\",\n                ppr (idArity binder),\n                text \"arguments,\",\n                ppr binder],\n              hsep [text \"Binder's strictness signature:\", ppr dmd_ty]\n\n         ]\n           where (StrictSig dmd_ty) = idStrictness binder\n-}\nmkCastErr :: CoreExpr -> Coercion -> Type -> Type -> MsgDoc\nmkCastErr expr = mk_cast_err \"expression\" \"type\" (ppr expr)\n\nmkCastTyErr :: Type -> Coercion -> Kind -> Kind -> MsgDoc\nmkCastTyErr ty = mk_cast_err \"type\" \"kind\" (ppr ty)\n\nmk_cast_err :: String -- ^ What sort of casted thing this is\n                      --   (\\\"expression\\\" or \\\"type\\\").\n            -> String -- ^ What sort of coercion is being used\n                      --   (\\\"type\\\" or \\\"kind\\\").\n            -> SDoc   -- ^ The thing being casted.\n            -> Coercion -> Type -> Type -> MsgDoc\nmk_cast_err thing_str co_str pp_thing co from_ty thing_ty\n  = vcat [from_msg <+> text \"of Cast differs from\" <+> co_msg\n            <+> text \"of\" <+> enclosed_msg,\n          from_msg <> colon <+> ppr from_ty,\n          text (capitalise co_str) <+> text \"of\" <+> enclosed_msg <> colon\n            <+> ppr thing_ty,\n          text \"Actual\" <+> enclosed_msg <> colon <+> pp_thing,\n          text \"Coercion used in cast:\" <+> ppr co\n         ]\n  where\n    co_msg, from_msg, enclosed_msg :: SDoc\n    co_msg       = text co_str\n    from_msg     = text \"From-\" <> co_msg\n    enclosed_msg = text \"enclosed\" <+> text thing_str\n\nmkBadUnivCoMsg :: LeftOrRight -> Coercion -> SDoc\nmkBadUnivCoMsg lr co\n  = text \"Kind mismatch on the\" <+> pprLeftOrRight lr <+>\n    text \"side of a UnivCo:\" <+> ppr co\n\nmkBadProofIrrelMsg :: Type -> Coercion -> SDoc\nmkBadProofIrrelMsg ty co\n  = hang (text \"Found a non-coercion in a proof-irrelevance UnivCo:\")\n       2 (vcat [ text \"type:\" <+> ppr ty\n               , text \"co:\" <+> ppr co ])\n\nmkBadTyVarMsg :: Var -> SDoc\nmkBadTyVarMsg tv\n  = text \"Non-tyvar used in TyVarTy:\"\n      <+> ppr tv <+> dcolon <+> ppr (varType tv)\n\nmkBadJoinBindMsg :: Var -> SDoc\nmkBadJoinBindMsg var\n  = vcat [ text \"Bad join point binding:\" <+> ppr var\n         , text \"Join points can be bound only by a non-top-level let\" ]\n\nmkInvalidJoinPointMsg :: Var -> Type -> SDoc\nmkInvalidJoinPointMsg var ty\n  = hang (text \"Join point has invalid type:\")\n        2 (ppr var <+> dcolon <+> ppr ty)\n\nmkBadJoinArityMsg :: Var -> Int -> Int -> CoreExpr -> SDoc\nmkBadJoinArityMsg var ar nlams rhs\n  = vcat [ text \"Join point has too few lambdas\",\n           text \"Join var:\" <+> ppr var,\n           text \"Join arity:\" <+> ppr ar,\n           text \"Number of lambdas:\" <+> ppr nlams,\n           text \"Rhs = \" <+> ppr rhs\n           ]\n\ninvalidJoinOcc :: Var -> SDoc\ninvalidJoinOcc var\n  = vcat [ text \"Invalid occurrence of a join variable:\" <+> ppr var\n         , text \"The binder is either not a join point, or not valid here\" ]\n\nmkBadJumpMsg :: Var -> Int -> Int -> SDoc\nmkBadJumpMsg var ar nargs\n  = vcat [ text \"Join point invoked with wrong number of arguments\",\n           text \"Join var:\" <+> ppr var,\n           text \"Join arity:\" <+> ppr ar,\n           text \"Number of arguments:\" <+> int nargs ]\n\nmkInconsistentRecMsg :: [Var] -> SDoc\nmkInconsistentRecMsg bndrs\n  = vcat [ text \"Recursive let binders mix values and join points\",\n           text \"Binders:\" <+> hsep (map ppr_with_details bndrs) ]\n  where\n    ppr_with_details bndr = ppr bndr <> ppr (idDetails bndr)\n\nmkJoinBndrOccMismatchMsg :: Var -> JoinArity -> JoinArity -> SDoc\nmkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ\n  = vcat [ text \"Mismatch in join point arity between binder and occurrence\"\n         , text \"Var:\" <+> ppr bndr\n         , text \"Arity at binding site:\" <+> ppr join_arity_bndr\n         , text \"Arity at occurrence:  \" <+> ppr join_arity_occ ]\n\nmkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc\nmkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty\n  = vcat [ text \"Mismatch in type between binder and occurrence\"\n         , text \"Var:\" <+> ppr bndr\n         , text \"Binder type:\" <+> ppr bndr_ty\n         , text \"Occurrence type:\" <+> ppr var_ty\n         , text \"  Before subst:\" <+> ppr (idType var) ]\n\nmkBadJoinPointRuleMsg :: JoinId -> JoinArity -> CoreRule -> SDoc\nmkBadJoinPointRuleMsg bndr join_arity rule\n  = vcat [ text \"Join point has rule with wrong number of arguments\"\n         , text \"Var:\" <+> ppr bndr\n         , text \"Join arity:\" <+> ppr join_arity\n         , text \"Rule:\" <+> ppr rule ]\n\npprLeftOrRight :: LeftOrRight -> MsgDoc\npprLeftOrRight CLeft  = text \"left\"\npprLeftOrRight CRight = text \"right\"\n\ndupVars :: [NonEmpty Var] -> MsgDoc\ndupVars vars\n  = hang (text \"Duplicate variables brought into scope\")\n       2 (ppr (map toList vars))\n\ndupExtVars :: [NonEmpty Name] -> MsgDoc\ndupExtVars vars\n  = hang (text \"Duplicate top-level variables with the same qualified name\")\n       2 (ppr (map toList vars))\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Annotation Linting}\n*                                                                      *\n************************************************************************\n-}\n\n-- | This checks whether a pass correctly looks through debug\n-- annotations (@SourceNote@). This works a bit different from other\n-- consistency checks: We check this by running the given task twice,\n-- noting all differences between the results.\nlintAnnots :: SDoc -> (ModGuts -> CoreM ModGuts) -> ModGuts -> CoreM ModGuts\nlintAnnots pname pass guts = do\n  -- Run the pass as we normally would\n  dflags <- getDynFlags\n  when (gopt Opt_DoAnnotationLinting dflags) $\n    liftIO $ Err.showPass dflags \"Annotation linting - first run\"\n  nguts <- pass guts\n  -- If appropriate re-run it without debug annotations to make sure\n  -- that they made no difference.\n  when (gopt Opt_DoAnnotationLinting dflags) $ do\n    liftIO $ Err.showPass dflags \"Annotation linting - second run\"\n    nguts' <- withoutAnnots pass guts\n    -- Finally compare the resulting bindings\n    liftIO $ Err.showPass dflags \"Annotation linting - comparison\"\n    let binds = flattenBinds $ mg_binds nguts\n        binds' = flattenBinds $ mg_binds nguts'\n        (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds'\n    when (not (null diffs)) $ CoreMonad.putMsg $ vcat\n      [ lint_banner \"warning\" pname\n      , text \"Core changes with annotations:\"\n      , withPprStyle (defaultDumpStyle dflags) $ nest 2 $ vcat diffs\n      ]\n  -- Return actual new guts\n  return nguts\n\n-- | Run the given pass without annotations. This means that we both\n-- set the debugLevel setting to 0 in the environment as well as all\n-- annotations from incoming modules.\nwithoutAnnots :: (ModGuts -> CoreM ModGuts) -> ModGuts -> CoreM ModGuts\nwithoutAnnots pass guts = do\n  -- Remove debug flag from environment.\n  dflags <- getDynFlags\n  let removeFlag env = env{ hsc_dflags = dflags{ debugLevel = 0} }\n      withoutFlag corem =\n        liftIO =<< runCoreM <$> fmap removeFlag getHscEnv <*> getRuleBase <*>\n                                getUniqueSupplyM <*> getModule <*>\n                                getVisibleOrphanMods <*>\n                                getPrintUnqualified <*> getSrcSpanM <*>\n                                pure corem\n  -- Nuke existing ticks in module.\n  -- TODO: Ticks in unfoldings. Maybe change unfolding so it removes\n  -- them in absence of debugLevel > 0.\n  let nukeTicks = stripTicksE (not . tickishIsCode)\n      nukeAnnotsBind :: CoreBind -> CoreBind\n      nukeAnnotsBind bind = case bind of\n        Rec bs     -> Rec $ map (\\(b,e) -> (b, nukeTicks e)) bs\n        NonRec b e -> NonRec b $ nukeTicks e\n      nukeAnnotsMod mg@ModGuts{mg_binds=binds}\n        = mg{mg_binds = map nukeAnnotsBind binds}\n  -- Perform pass with all changes applied\n  fmap fst $ withoutFlag $ pass (nukeAnnotsMod guts)\n", "num_lines": 2759}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule CoreMap(\n   -- * Maps over Core expressions\n   CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,\n   -- * Maps over 'Type's\n   TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap, foldTypeMap,\n   LooseTypeMap,\n   -- ** With explicit scoping\n   CmEnv, lookupCME, extendTypeMapWithScope, lookupTypeMapWithScope,\n   mkDeBruijnContext,\n   -- * Maps over 'Maybe' values\n   MaybeMap,\n   -- * Maps over 'List' values\n   ListMap,\n   -- * Maps over 'Literal's\n   LiteralMap,\n   -- * Map for compressing leaves. See Note [Compressed TrieMap]\n   GenMap,\n   -- * 'TrieMap' class\n   TrieMap(..), insertTM, deleteTM,\n   lkDFreeVar, xtDFreeVar,\n   lkDNamed, xtDNamed,\n   (>.>), (|>), (|>>),\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TrieMap\nimport CoreSyn\nimport Coercion\nimport Name\nimport Type\nimport TyCoRep\nimport Var\nimport FastString(FastString)\nimport Util\n\nimport qualified Data.Map    as Map\nimport qualified Data.IntMap as IntMap\nimport VarEnv\nimport NameEnv\nimport Outputable\nimport Control.Monad( (>=>) )\n\n{-\nThis module implements TrieMaps over Core related data structures\nlike CoreExpr or Type. It is built on the Tries from the TrieMap\nmodule.\n\nThe code is very regular and boilerplate-like, but there is\nsome neat handling of *binders*.  In effect they are deBruijn\nnumbered on the fly.\n\n\n-}\n\n----------------------\n-- Recall that\n--   Control.Monad.(>=>) :: (a -> Maybe b) -> (b -> Maybe c) -> a -> Maybe c\n\n-- NB: Be careful about RULES and type families (#5821).  So we should make sure\n-- to specify @Key TypeMapX@ (and not @DeBruijn Type@, the reduced form)\n\n-- The CoreMap makes heavy use of GenMap. However the CoreMap Types are not\n-- known when defining GenMap so we can only specialize them here.\n\n{-# SPECIALIZE lkG :: Key TypeMapX     -> TypeMapG a     -> Maybe a #-}\n{-# SPECIALIZE lkG :: Key CoercionMapX -> CoercionMapG a -> Maybe a #-}\n{-# SPECIALIZE lkG :: Key CoreMapX     -> CoreMapG a     -> Maybe a #-}\n\n\n{-# SPECIALIZE xtG :: Key TypeMapX     -> XT a -> TypeMapG a -> TypeMapG a #-}\n{-# SPECIALIZE xtG :: Key CoercionMapX -> XT a -> CoercionMapG a -> CoercionMapG a #-}\n{-# SPECIALIZE xtG :: Key CoreMapX     -> XT a -> CoreMapG a -> CoreMapG a #-}\n\n{-# SPECIALIZE mapG :: (a -> b) -> TypeMapG a     -> TypeMapG b #-}\n{-# SPECIALIZE mapG :: (a -> b) -> CoercionMapG a -> CoercionMapG b #-}\n{-# SPECIALIZE mapG :: (a -> b) -> CoreMapG a     -> CoreMapG b #-}\n\n{-# SPECIALIZE fdG :: (a -> b -> b) -> TypeMapG a     -> b -> b #-}\n{-# SPECIALIZE fdG :: (a -> b -> b) -> CoercionMapG a -> b -> b #-}\n{-# SPECIALIZE fdG :: (a -> b -> b) -> CoreMapG a     -> b -> b #-}\n\n\n{-\n************************************************************************\n*                                                                      *\n                   CoreMap\n*                                                                      *\n************************************************************************\n-}\n\nlkDNamed :: NamedThing n => n -> DNameEnv a -> Maybe a\nlkDNamed n env = lookupDNameEnv env (getName n)\n\nxtDNamed :: NamedThing n => n -> XT a -> DNameEnv a -> DNameEnv a\nxtDNamed tc f m = alterDNameEnv f m (getName tc)\n\n\n{-\nNote [Binders]\n~~~~~~~~~~~~~~\n * In general we check binders as late as possible because types are\n   less likely to differ than expression structure.  That's why\n      cm_lam :: CoreMapG (TypeMapG a)\n   rather than\n      cm_lam :: TypeMapG (CoreMapG a)\n\n * We don't need to look at the type of some binders, notably\n     - the case binder in (Case _ b _ _)\n     - the binders in an alternative\n   because they are totally fixed by the context\n\nNote [Empty case alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* For a key (Case e b ty (alt:alts))  we don't need to look the return type\n  'ty', because every alternative has that type.\n\n* For a key (Case e b ty []) we MUST look at the return type 'ty', because\n  otherwise (Case (error () \"urk\") _ Int  []) would compare equal to\n            (Case (error () \"urk\") _ Bool [])\n  which is utterly wrong (Trac #6097)\n\nWe could compare the return type regardless, but the wildly common case\nis that it's unnecessary, so we have two fields (cm_case and cm_ecase)\nfor the two possibilities.  Only cm_ecase looks at the type.\n\nSee also Note [Empty case alternatives] in CoreSyn.\n-}\n\n-- | @CoreMap a@ is a map from 'CoreExpr' to @a@.  If you are a client, this\n-- is the type you want.\nnewtype CoreMap a = CoreMap (CoreMapG a)\n\ninstance TrieMap CoreMap where\n    type Key CoreMap = CoreExpr\n    emptyTM = CoreMap emptyTM\n    lookupTM k (CoreMap m) = lookupTM (deBruijnize k) m\n    alterTM k f (CoreMap m) = CoreMap (alterTM (deBruijnize k) f m)\n    foldTM k (CoreMap m) = foldTM k m\n    mapTM f (CoreMap m) = CoreMap (mapTM f m)\n\n-- | @CoreMapG a@ is a map from @DeBruijn CoreExpr@ to @a@.  The extended\n-- key makes it suitable for recursive traversal, since it can track binders,\n-- but it is strictly internal to this module.  If you are including a 'CoreMap'\n-- inside another 'TrieMap', this is the type you want.\ntype CoreMapG = GenMap CoreMapX\n\n-- | @CoreMapX a@ is the base map from @DeBruijn CoreExpr@ to @a@, but without\n-- the 'GenMap' optimization.\ndata CoreMapX a\n  = CM { cm_var   :: VarMap a\n       , cm_lit   :: LiteralMap a\n       , cm_co    :: CoercionMapG a\n       , cm_type  :: TypeMapG a\n       , cm_cast  :: CoreMapG (CoercionMapG a)\n       , cm_tick  :: CoreMapG (TickishMap a)\n       , cm_app   :: CoreMapG (CoreMapG a)\n       , cm_lam   :: CoreMapG (BndrMap a)    -- Note [Binders]\n       , cm_letn  :: CoreMapG (CoreMapG (BndrMap a))\n       , cm_letr  :: ListMap CoreMapG (CoreMapG (ListMap BndrMap a))\n       , cm_case  :: CoreMapG (ListMap AltMap a)\n       , cm_ecase :: CoreMapG (TypeMapG a)    -- Note [Empty case alternatives]\n     }\n\ninstance Eq (DeBruijn CoreExpr) where\n  D env1 e1 == D env2 e2 = go e1 e2 where\n    go (Var v1) (Var v2) = case (lookupCME env1 v1, lookupCME env2 v2) of\n                            (Just b1, Just b2) -> b1 == b2\n                            (Nothing, Nothing) -> v1 == v2\n                            _ -> False\n    go (Lit lit1)    (Lit lit2)      = lit1 == lit2\n    go (Type t1)    (Type t2)        = D env1 t1 == D env2 t2\n    go (Coercion co1) (Coercion co2) = D env1 co1 == D env2 co2\n    go (Cast e1 co1) (Cast e2 co2) = D env1 co1 == D env2 co2 && go e1 e2\n    go (App f1 a1)   (App f2 a2)   = go f1 f2 && go a1 a2\n    -- This seems a bit dodgy, see 'eqTickish'\n    go (Tick n1 e1)  (Tick n2 e2)  = n1 == n2 && go e1 e2\n\n    go (Lam b1 e1)  (Lam b2 e2)\n      =  D env1 (varType b1) == D env2 (varType b2)\n      && D (extendCME env1 b1) e1 == D (extendCME env2 b2) e2\n\n    go (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2)\n      =  go r1 r2\n      && D (extendCME env1 v1) e1 == D (extendCME env2 v2) e2\n\n    go (Let (Rec ps1) e1) (Let (Rec ps2) e2)\n      = equalLength ps1 ps2\n      && D env1' rs1 == D env2' rs2\n      && D env1' e1  == D env2' e2\n      where\n        (bs1,rs1) = unzip ps1\n        (bs2,rs2) = unzip ps2\n        env1' = extendCMEs env1 bs1\n        env2' = extendCMEs env2 bs2\n\n    go (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)\n      | null a1   -- See Note [Empty case alternatives]\n      = null a2 && go e1 e2 && D env1 t1 == D env2 t2\n      | otherwise\n      =  go e1 e2 && D (extendCME env1 b1) a1 == D (extendCME env2 b2) a2\n\n    go _ _ = False\n\nemptyE :: CoreMapX a\nemptyE = CM { cm_var = emptyTM, cm_lit = emptyTM\n            , cm_co = emptyTM, cm_type = emptyTM\n            , cm_cast = emptyTM, cm_app = emptyTM\n            , cm_lam = emptyTM, cm_letn = emptyTM\n            , cm_letr = emptyTM, cm_case = emptyTM\n            , cm_ecase = emptyTM, cm_tick = emptyTM }\n\ninstance TrieMap CoreMapX where\n   type Key CoreMapX = DeBruijn CoreExpr\n   emptyTM  = emptyE\n   lookupTM = lkE\n   alterTM  = xtE\n   foldTM   = fdE\n   mapTM    = mapE\n\n--------------------------\nmapE :: (a->b) -> CoreMapX a -> CoreMapX b\nmapE f (CM { cm_var = cvar, cm_lit = clit\n           , cm_co = cco, cm_type = ctype\n           , cm_cast = ccast , cm_app = capp\n           , cm_lam = clam, cm_letn = cletn\n           , cm_letr = cletr, cm_case = ccase\n           , cm_ecase = cecase, cm_tick = ctick })\n  = CM { cm_var = mapTM f cvar, cm_lit = mapTM f clit\n       , cm_co = mapTM f cco, cm_type = mapTM f ctype\n       , cm_cast = mapTM (mapTM f) ccast, cm_app = mapTM (mapTM f) capp\n       , cm_lam = mapTM (mapTM f) clam, cm_letn = mapTM (mapTM (mapTM f)) cletn\n       , cm_letr = mapTM (mapTM (mapTM f)) cletr, cm_case = mapTM (mapTM f) ccase\n       , cm_ecase = mapTM (mapTM f) cecase, cm_tick = mapTM (mapTM f) ctick }\n\n--------------------------\nlookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a\nlookupCoreMap cm e = lookupTM e cm\n\nextendCoreMap :: CoreMap a -> CoreExpr -> a -> CoreMap a\nextendCoreMap m e v = alterTM e (\\_ -> Just v) m\n\nfoldCoreMap :: (a -> b -> b) -> b -> CoreMap a -> b\nfoldCoreMap k z m = foldTM k m z\n\nemptyCoreMap :: CoreMap a\nemptyCoreMap = emptyTM\n\ninstance Outputable a => Outputable (CoreMap a) where\n  ppr m = text \"CoreMap elts\" <+> ppr (foldTM (:) m [])\n\n-------------------------\nfdE :: (a -> b -> b) -> CoreMapX a -> b -> b\nfdE k m\n  = foldTM k (cm_var m)\n  . foldTM k (cm_lit m)\n  . foldTM k (cm_co m)\n  . foldTM k (cm_type m)\n  . foldTM (foldTM k) (cm_cast m)\n  . foldTM (foldTM k) (cm_tick m)\n  . foldTM (foldTM k) (cm_app m)\n  . foldTM (foldTM k) (cm_lam m)\n  . foldTM (foldTM (foldTM k)) (cm_letn m)\n  . foldTM (foldTM (foldTM k)) (cm_letr m)\n  . foldTM (foldTM k) (cm_case m)\n  . foldTM (foldTM k) (cm_ecase m)\n\n-- lkE: lookup in trie for expressions\nlkE :: DeBruijn CoreExpr -> CoreMapX a -> Maybe a\nlkE (D env expr) cm = go expr cm\n  where\n    go (Var v)              = cm_var  >.> lkVar env v\n    go (Lit l)              = cm_lit  >.> lookupTM l\n    go (Type t)             = cm_type >.> lkG (D env t)\n    go (Coercion c)         = cm_co   >.> lkG (D env c)\n    go (Cast e c)           = cm_cast >.> lkG (D env e) >=> lkG (D env c)\n    go (Tick tickish e)     = cm_tick >.> lkG (D env e) >=> lkTickish tickish\n    go (App e1 e2)          = cm_app  >.> lkG (D env e2) >=> lkG (D env e1)\n    go (Lam v e)            = cm_lam  >.> lkG (D (extendCME env v) e)\n                              >=> lkBndr env v\n    go (Let (NonRec b r) e) = cm_letn >.> lkG (D env r)\n                              >=> lkG (D (extendCME env b) e) >=> lkBndr env b\n    go (Let (Rec prs) e)    = let (bndrs,rhss) = unzip prs\n                                  env1 = extendCMEs env bndrs\n                              in cm_letr\n                                 >.> lkList (lkG . D env1) rhss\n                                 >=> lkG (D env1 e)\n                                 >=> lkList (lkBndr env1) bndrs\n    go (Case e b ty as)     -- See Note [Empty case alternatives]\n               | null as    = cm_ecase >.> lkG (D env e) >=> lkG (D env ty)\n               | otherwise  = cm_case >.> lkG (D env e)\n                              >=> lkList (lkA (extendCME env b)) as\n\nxtE :: DeBruijn CoreExpr -> XT a -> CoreMapX a -> CoreMapX a\nxtE (D env (Var v))              f m = m { cm_var  = cm_var m\n                                                 |> xtVar env v f }\nxtE (D env (Type t))             f m = m { cm_type = cm_type m\n                                                 |> xtG (D env t) f }\nxtE (D env (Coercion c))         f m = m { cm_co   = cm_co m\n                                                 |> xtG (D env c) f }\nxtE (D _   (Lit l))              f m = m { cm_lit  = cm_lit m  |> alterTM l f }\nxtE (D env (Cast e c))           f m = m { cm_cast = cm_cast m |> xtG (D env e)\n                                                 |>> xtG (D env c) f }\nxtE (D env (Tick t e))           f m = m { cm_tick = cm_tick m |> xtG (D env e)\n                                                 |>> xtTickish t f }\nxtE (D env (App e1 e2))          f m = m { cm_app = cm_app m |> xtG (D env e2)\n                                                 |>> xtG (D env e1) f }\nxtE (D env (Lam v e))            f m = m { cm_lam = cm_lam m\n                                                 |> xtG (D (extendCME env v) e)\n                                                 |>> xtBndr env v f }\nxtE (D env (Let (NonRec b r) e)) f m = m { cm_letn = cm_letn m\n                                                 |> xtG (D (extendCME env b) e)\n                                                 |>> xtG (D env r)\n                                                 |>> xtBndr env b f }\nxtE (D env (Let (Rec prs) e))    f m = m { cm_letr =\n                                              let (bndrs,rhss) = unzip prs\n                                                  env1 = extendCMEs env bndrs\n                                              in cm_letr m\n                                                 |>  xtList (xtG . D env1) rhss\n                                                 |>> xtG (D env1 e)\n                                                 |>> xtList (xtBndr env1)\n                                                            bndrs f }\nxtE (D env (Case e b ty as))     f m\n                     | null as   = m { cm_ecase = cm_ecase m |> xtG (D env e)\n                                                 |>> xtG (D env ty) f }\n                     | otherwise = m { cm_case = cm_case m |> xtG (D env e)\n                                                 |>> let env1 = extendCME env b\n                                                     in xtList (xtA env1) as f }\n\n-- TODO: this seems a bit dodgy, see 'eqTickish'\ntype TickishMap a = Map.Map (Tickish Id) a\nlkTickish :: Tickish Id -> TickishMap a -> Maybe a\nlkTickish = lookupTM\n\nxtTickish :: Tickish Id -> XT a -> TickishMap a -> TickishMap a\nxtTickish = alterTM\n\n------------------------\ndata AltMap a   -- A single alternative\n  = AM { am_deflt :: CoreMapG a\n       , am_data  :: DNameEnv (CoreMapG a)\n       , am_lit   :: LiteralMap (CoreMapG a) }\n\ninstance TrieMap AltMap where\n   type Key AltMap = CoreAlt\n   emptyTM  = AM { am_deflt = emptyTM\n                 , am_data = emptyDNameEnv\n                 , am_lit  = emptyTM }\n   lookupTM = lkA emptyCME\n   alterTM  = xtA emptyCME\n   foldTM   = fdA\n   mapTM    = mapA\n\ninstance Eq (DeBruijn CoreAlt) where\n  D env1 a1 == D env2 a2 = go a1 a2 where\n    go (DEFAULT, _, rhs1) (DEFAULT, _, rhs2)\n        = D env1 rhs1 == D env2 rhs2\n    go (LitAlt lit1, _, rhs1) (LitAlt lit2, _, rhs2)\n        = lit1 == lit2 && D env1 rhs1 == D env2 rhs2\n    go (DataAlt dc1, bs1, rhs1) (DataAlt dc2, bs2, rhs2)\n        = dc1 == dc2 &&\n          D (extendCMEs env1 bs1) rhs1 == D (extendCMEs env2 bs2) rhs2\n    go _ _ = False\n\nmapA :: (a->b) -> AltMap a -> AltMap b\nmapA f (AM { am_deflt = adeflt, am_data = adata, am_lit = alit })\n  = AM { am_deflt = mapTM f adeflt\n       , am_data = mapTM (mapTM f) adata\n       , am_lit = mapTM (mapTM f) alit }\n\nlkA :: CmEnv -> CoreAlt -> AltMap a -> Maybe a\nlkA env (DEFAULT,    _, rhs)  = am_deflt >.> lkG (D env rhs)\nlkA env (LitAlt lit, _, rhs)  = am_lit >.> lookupTM lit >=> lkG (D env rhs)\nlkA env (DataAlt dc, bs, rhs) = am_data >.> lkDNamed dc\n                                        >=> lkG (D (extendCMEs env bs) rhs)\n\nxtA :: CmEnv -> CoreAlt -> XT a -> AltMap a -> AltMap a\nxtA env (DEFAULT, _, rhs)    f m =\n    m { am_deflt = am_deflt m |> xtG (D env rhs) f }\nxtA env (LitAlt l, _, rhs)   f m =\n    m { am_lit   = am_lit m   |> alterTM l |>> xtG (D env rhs) f }\nxtA env (DataAlt d, bs, rhs) f m =\n    m { am_data  = am_data m  |> xtDNamed d\n                             |>> xtG (D (extendCMEs env bs) rhs) f }\n\nfdA :: (a -> b -> b) -> AltMap a -> b -> b\nfdA k m = foldTM k (am_deflt m)\n        . foldTM (foldTM k) (am_data m)\n        . foldTM (foldTM k) (am_lit m)\n\n{-\n************************************************************************\n*                                                                      *\n                   Coercions\n*                                                                      *\n************************************************************************\n-}\n\n-- We should really never care about the contents of a coercion. Instead,\n-- just look up the coercion's type.\nnewtype CoercionMap a = CoercionMap (CoercionMapG a)\n\ninstance TrieMap CoercionMap where\n   type Key CoercionMap = Coercion\n   emptyTM                     = CoercionMap emptyTM\n   lookupTM k  (CoercionMap m) = lookupTM (deBruijnize k) m\n   alterTM k f (CoercionMap m) = CoercionMap (alterTM (deBruijnize k) f m)\n   foldTM k    (CoercionMap m) = foldTM k m\n   mapTM f     (CoercionMap m) = CoercionMap (mapTM f m)\n\ntype CoercionMapG = GenMap CoercionMapX\nnewtype CoercionMapX a = CoercionMapX (TypeMapX a)\n\ninstance TrieMap CoercionMapX where\n  type Key CoercionMapX = DeBruijn Coercion\n  emptyTM = CoercionMapX emptyTM\n  lookupTM = lkC\n  alterTM  = xtC\n  foldTM f (CoercionMapX core_tm) = foldTM f core_tm\n  mapTM f (CoercionMapX core_tm)  = CoercionMapX (mapTM f core_tm)\n\ninstance Eq (DeBruijn Coercion) where\n  D env1 co1 == D env2 co2\n    = D env1 (coercionType co1) ==\n      D env2 (coercionType co2)\n\nlkC :: DeBruijn Coercion -> CoercionMapX a -> Maybe a\nlkC (D env co) (CoercionMapX core_tm) = lkT (D env $ coercionType co)\n                                        core_tm\n\nxtC :: DeBruijn Coercion -> XT a -> CoercionMapX a -> CoercionMapX a\nxtC (D env co) f (CoercionMapX m)\n  = CoercionMapX (xtT (D env $ coercionType co) f m)\n\n{-\n************************************************************************\n*                                                                      *\n                   Types\n*                                                                      *\n************************************************************************\n-}\n\n-- | @TypeMapG a@ is a map from @DeBruijn Type@ to @a@.  The extended\n-- key makes it suitable for recursive traversal, since it can track binders,\n-- but it is strictly internal to this module.  If you are including a 'TypeMap'\n-- inside another 'TrieMap', this is the type you want. Note that this\n-- lookup does not do a kind-check. Thus, all keys in this map must have\n-- the same kind. Also note that this map respects the distinction between\n-- @Type@ and @Constraint@, despite the fact that they are equivalent type\n-- synonyms in Core.\ntype TypeMapG = GenMap TypeMapX\n\n-- | @TypeMapX a@ is the base map from @DeBruijn Type@ to @a@, but without the\n-- 'GenMap' optimization.\ndata TypeMapX a\n  = TM { tm_var    :: VarMap a\n       , tm_app    :: TypeMapG (TypeMapG a)\n       , tm_tycon  :: DNameEnv a\n       , tm_forall :: TypeMapG (BndrMap a) -- See Note [Binders]\n       , tm_tylit  :: TyLitMap a\n       , tm_coerce :: Maybe a\n       }\n    -- Note that there is no tyconapp case; see Note [Equality on AppTys] in Type\n\n-- | Squeeze out any synonyms, and change TyConApps to nested AppTys. Why the\n-- last one? See Note [Equality on AppTys] in Type\n--\n-- Note, however, that we keep Constraint and Type apart here, despite the fact\n-- that they are both synonyms of TYPE 'LiftedRep (see #11715).\ntrieMapView :: Type -> Maybe Type\ntrieMapView ty\n  -- First check for TyConApps that need to be expanded to\n  -- AppTy chains.\n  | Just (tc, tys@(_:_)) <- tcSplitTyConApp_maybe ty\n  = Just $ foldl' AppTy (TyConApp tc []) tys\n\n  -- Then resolve any remaining nullary synonyms.\n  | Just ty' <- tcView ty = Just ty'\ntrieMapView _ = Nothing\n\ninstance TrieMap TypeMapX where\n   type Key TypeMapX = DeBruijn Type\n   emptyTM  = emptyT\n   lookupTM = lkT\n   alterTM  = xtT\n   foldTM   = fdT\n   mapTM    = mapT\n\ninstance Eq (DeBruijn Type) where\n  env_t@(D env t) == env_t'@(D env' t')\n    | Just new_t  <- tcView t  = D env new_t == env_t'\n    | Just new_t' <- tcView t' = env_t       == D env' new_t'\n    | otherwise\n    = case (t, t') of\n        (CastTy t1 _, _)  -> D env t1 == D env t'\n        (_, CastTy t1' _) -> D env t  == D env t1'\n\n        (TyVarTy v, TyVarTy v')\n            -> case (lookupCME env v, lookupCME env' v') of\n                (Just bv, Just bv') -> bv == bv'\n                (Nothing, Nothing)  -> v == v'\n                _ -> False\n                -- See Note [Equality on AppTys] in Type\n        (AppTy t1 t2, s) | Just (t1', t2') <- repSplitAppTy_maybe s\n            -> D env t1 == D env' t1' && D env t2 == D env' t2'\n        (s, AppTy t1' t2') | Just (t1, t2) <- repSplitAppTy_maybe s\n            -> D env t1 == D env' t1' && D env t2 == D env' t2'\n        (FunTy _ t1 t2, FunTy _ t1' t2')\n            -> D env t1 == D env' t1' && D env t2 == D env' t2'\n        (TyConApp tc tys, TyConApp tc' tys')\n            -> tc == tc' && D env tys == D env' tys'\n        (LitTy l, LitTy l')\n            -> l == l'\n        (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty')\n            -> D env (varType tv)      == D env' (varType tv') &&\n               D (extendCME env tv) ty == D (extendCME env' tv') ty'\n        (CoercionTy {}, CoercionTy {})\n            -> True\n        _ -> False\n\ninstance {-# OVERLAPPING #-}\n         Outputable a => Outputable (TypeMapG a) where\n  ppr m = text \"TypeMap elts\" <+> ppr (foldTM (:) m [])\n\nemptyT :: TypeMapX a\nemptyT = TM { tm_var  = emptyTM\n            , tm_app  = emptyTM\n            , tm_tycon  = emptyDNameEnv\n            , tm_forall = emptyTM\n            , tm_tylit  = emptyTyLitMap\n            , tm_coerce = Nothing }\n\nmapT :: (a->b) -> TypeMapX a -> TypeMapX b\nmapT f (TM { tm_var  = tvar, tm_app = tapp, tm_tycon = ttycon\n           , tm_forall = tforall, tm_tylit = tlit\n           , tm_coerce = tcoerce })\n  = TM { tm_var    = mapTM f tvar\n       , tm_app    = mapTM (mapTM f) tapp\n       , tm_tycon  = mapTM f ttycon\n       , tm_forall = mapTM (mapTM f) tforall\n       , tm_tylit  = mapTM f tlit\n       , tm_coerce = fmap f tcoerce }\n\n-----------------\nlkT :: DeBruijn Type -> TypeMapX a -> Maybe a\nlkT (D env ty) m = go ty m\n  where\n    go ty | Just ty' <- trieMapView ty = go ty'\n    go (TyVarTy v)                 = tm_var    >.> lkVar env v\n    go (AppTy t1 t2)               = tm_app    >.> lkG (D env t1)\n                                               >=> lkG (D env t2)\n    go (TyConApp tc [])            = tm_tycon  >.> lkDNamed tc\n    go ty@(TyConApp _ (_:_))       = pprPanic \"lkT TyConApp\" (ppr ty)\n    go (LitTy l)                   = tm_tylit  >.> lkTyLit l\n    go (ForAllTy (Bndr tv _) ty)   = tm_forall >.> lkG (D (extendCME env tv) ty)\n                                               >=> lkBndr env tv\n    go ty@(FunTy {})               = pprPanic \"lkT FunTy\" (ppr ty)\n    go (CastTy t _)                = go t\n    go (CoercionTy {})             = tm_coerce\n\n-----------------\nxtT :: DeBruijn Type -> XT a -> TypeMapX a -> TypeMapX a\nxtT (D env ty) f m | Just ty' <- trieMapView ty = xtT (D env ty') f m\n\nxtT (D env (TyVarTy v))       f m = m { tm_var    = tm_var m |> xtVar env v f }\nxtT (D env (AppTy t1 t2))     f m = m { tm_app    = tm_app m |> xtG (D env t1)\n                                                            |>> xtG (D env t2) f }\nxtT (D _   (TyConApp tc []))  f m = m { tm_tycon  = tm_tycon m |> xtDNamed tc f }\nxtT (D _   (LitTy l))         f m = m { tm_tylit  = tm_tylit m |> xtTyLit l f }\nxtT (D env (CastTy t _))      f m = xtT (D env t) f m\nxtT (D _   (CoercionTy {}))   f m = m { tm_coerce = tm_coerce m |> f }\nxtT (D env (ForAllTy (Bndr tv _) ty))  f m\n  = m { tm_forall = tm_forall m |> xtG (D (extendCME env tv) ty)\n                                |>> xtBndr env tv f }\nxtT (D _   ty@(TyConApp _ (_:_))) _ _ = pprPanic \"xtT TyConApp\" (ppr ty)\nxtT (D _   ty@(FunTy {}))         _ _ = pprPanic \"xtT FunTy\" (ppr ty)\n\nfdT :: (a -> b -> b) -> TypeMapX a -> b -> b\nfdT k m = foldTM k (tm_var m)\n        . foldTM (foldTM k) (tm_app m)\n        . foldTM k (tm_tycon m)\n        . foldTM (foldTM k) (tm_forall m)\n        . foldTyLit k (tm_tylit m)\n        . foldMaybe k (tm_coerce m)\n\n------------------------\ndata TyLitMap a = TLM { tlm_number :: Map.Map Integer a\n                      , tlm_string :: Map.Map FastString a\n                      }\n\ninstance TrieMap TyLitMap where\n   type Key TyLitMap = TyLit\n   emptyTM  = emptyTyLitMap\n   lookupTM = lkTyLit\n   alterTM  = xtTyLit\n   foldTM   = foldTyLit\n   mapTM    = mapTyLit\n\nemptyTyLitMap :: TyLitMap a\nemptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = Map.empty }\n\nmapTyLit :: (a->b) -> TyLitMap a -> TyLitMap b\nmapTyLit f (TLM { tlm_number = tn, tlm_string = ts })\n  = TLM { tlm_number = Map.map f tn, tlm_string = Map.map f ts }\n\nlkTyLit :: TyLit -> TyLitMap a -> Maybe a\nlkTyLit l =\n  case l of\n    NumTyLit n -> tlm_number >.> Map.lookup n\n    StrTyLit n -> tlm_string >.> Map.lookup n\n\nxtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a\nxtTyLit l f m =\n  case l of\n    NumTyLit n -> m { tlm_number = tlm_number m |> Map.alter f n }\n    StrTyLit n -> m { tlm_string = tlm_string m |> Map.alter f n }\n\nfoldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b\nfoldTyLit l m = flip (Map.foldr l) (tlm_string m)\n              . flip (Map.foldr l) (tlm_number m)\n\n-------------------------------------------------\n-- | @TypeMap a@ is a map from 'Type' to @a@.  If you are a client, this\n-- is the type you want. The keys in this map may have different kinds.\nnewtype TypeMap a = TypeMap (TypeMapG (TypeMapG a))\n\nlkTT :: DeBruijn Type -> TypeMap a -> Maybe a\nlkTT (D env ty) (TypeMap m) = lkG (D env $ typeKind ty) m\n                          >>= lkG (D env ty)\n\nxtTT :: DeBruijn Type -> XT a -> TypeMap a -> TypeMap a\nxtTT (D env ty) f (TypeMap m)\n  = TypeMap (m |> xtG (D env $ typeKind ty)\n               |>> xtG (D env ty) f)\n\n-- Below are some client-oriented functions which operate on 'TypeMap'.\n\ninstance TrieMap TypeMap where\n    type Key TypeMap = Type\n    emptyTM = TypeMap emptyTM\n    lookupTM k m = lkTT (deBruijnize k) m\n    alterTM k f m = xtTT (deBruijnize k) f m\n    foldTM k (TypeMap m) = foldTM (foldTM k) m\n    mapTM f (TypeMap m) = TypeMap (mapTM (mapTM f) m)\n\nfoldTypeMap :: (a -> b -> b) -> b -> TypeMap a -> b\nfoldTypeMap k z m = foldTM k m z\n\nemptyTypeMap :: TypeMap a\nemptyTypeMap = emptyTM\n\nlookupTypeMap :: TypeMap a -> Type -> Maybe a\nlookupTypeMap cm t = lookupTM t cm\n\nextendTypeMap :: TypeMap a -> Type -> a -> TypeMap a\nextendTypeMap m t v = alterTM t (const (Just v)) m\n\nlookupTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> Maybe a\nlookupTypeMapWithScope m cm t = lkTT (D cm t) m\n\n-- | Extend a 'TypeMap' with a type in the given context.\n-- @extendTypeMapWithScope m (mkDeBruijnContext [a,b,c]) t v@ is equivalent to\n-- @extendTypeMap m (forall a b c. t) v@, but allows reuse of the context over\n-- multiple insertions.\nextendTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> a -> TypeMap a\nextendTypeMapWithScope m cm t v = xtTT (D cm t) (const (Just v)) m\n\n-- | Construct a deBruijn environment with the given variables in scope.\n-- e.g. @mkDeBruijnEnv [a,b,c]@ constructs a context @forall a b c.@\nmkDeBruijnContext :: [Var] -> CmEnv\nmkDeBruijnContext = extendCMEs emptyCME\n\n-- | A 'LooseTypeMap' doesn't do a kind-check. Thus, when lookup up (t |> g),\n-- you'll find entries inserted under (t), even if (g) is non-reflexive.\nnewtype LooseTypeMap a\n  = LooseTypeMap (TypeMapG a)\n\ninstance TrieMap LooseTypeMap where\n  type Key LooseTypeMap = Type\n  emptyTM = LooseTypeMap emptyTM\n  lookupTM k (LooseTypeMap m) = lookupTM (deBruijnize k) m\n  alterTM k f (LooseTypeMap m) = LooseTypeMap (alterTM (deBruijnize k) f m)\n  foldTM f (LooseTypeMap m) = foldTM f m\n  mapTM f (LooseTypeMap m) = LooseTypeMap (mapTM f m)\n\n{-\n************************************************************************\n*                                                                      *\n                   Variables\n*                                                                      *\n************************************************************************\n-}\n\ntype BoundVar = Int  -- Bound variables are deBruijn numbered\ntype BoundVarMap a = IntMap.IntMap a\n\ndata CmEnv = CME { cme_next :: !BoundVar\n                 , cme_env  :: VarEnv BoundVar }\n\nemptyCME :: CmEnv\nemptyCME = CME { cme_next = 0, cme_env = emptyVarEnv }\n\nextendCME :: CmEnv -> Var -> CmEnv\nextendCME (CME { cme_next = bv, cme_env = env }) v\n  = CME { cme_next = bv+1, cme_env = extendVarEnv env v bv }\n\nextendCMEs :: CmEnv -> [Var] -> CmEnv\nextendCMEs env vs = foldl' extendCME env vs\n\nlookupCME :: CmEnv -> Var -> Maybe BoundVar\nlookupCME (CME { cme_env = env }) v = lookupVarEnv env v\n\n-- | @DeBruijn a@ represents @a@ modulo alpha-renaming.  This is achieved\n-- by equipping the value with a 'CmEnv', which tracks an on-the-fly deBruijn\n-- numbering.  This allows us to define an 'Eq' instance for @DeBruijn a@, even\n-- if this was not (easily) possible for @a@.  Note: we purposely don't\n-- export the constructor.  Make a helper function if you find yourself\n-- needing it.\ndata DeBruijn a = D CmEnv a\n\n-- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no\n-- bound binders (an empty 'CmEnv').  This is usually what you want if there\n-- isn't already a 'CmEnv' in scope.\ndeBruijnize :: a -> DeBruijn a\ndeBruijnize = D emptyCME\n\ninstance Eq (DeBruijn a) => Eq (DeBruijn [a]) where\n    D _   []     == D _    []       = True\n    D env (x:xs) == D env' (x':xs') = D env x  == D env' x' &&\n                                      D env xs == D env' xs'\n    _            == _               = False\n\n--------- Variable binders -------------\n\n-- | A 'BndrMap' is a 'TypeMapG' which allows us to distinguish between\n-- binding forms whose binders have different types.  For example,\n-- if we are doing a 'TrieMap' lookup on @\\(x :: Int) -> ()@, we should\n-- not pick up an entry in the 'TrieMap' for @\\(x :: Bool) -> ()@:\n-- we can disambiguate this by matching on the type (or kind, if this\n-- a binder in a type) of the binder.\ntype BndrMap = TypeMapG\n\n-- Note [Binders]\n-- ~~~~~~~~~~~~~~\n-- We need to use 'BndrMap' for 'Coercion', 'CoreExpr' AND 'Type', since all\n-- of these data types have binding forms.\n\nlkBndr :: CmEnv -> Var -> BndrMap a -> Maybe a\nlkBndr env v m = lkG (D env (varType v)) m\n\nxtBndr :: CmEnv -> Var -> XT a -> BndrMap a -> BndrMap a\nxtBndr env v f = xtG (D env (varType v)) f\n\n--------- Variable occurrence -------------\ndata VarMap a = VM { vm_bvar   :: BoundVarMap a  -- Bound variable\n                   , vm_fvar   :: DVarEnv a }      -- Free variable\n\ninstance TrieMap VarMap where\n   type Key VarMap = Var\n   emptyTM  = VM { vm_bvar = IntMap.empty, vm_fvar = emptyDVarEnv }\n   lookupTM = lkVar emptyCME\n   alterTM  = xtVar emptyCME\n   foldTM   = fdVar\n   mapTM    = mapVar\n\nmapVar :: (a->b) -> VarMap a -> VarMap b\nmapVar f (VM { vm_bvar = bv, vm_fvar = fv })\n  = VM { vm_bvar = mapTM f bv, vm_fvar = mapTM f fv }\n\nlkVar :: CmEnv -> Var -> VarMap a -> Maybe a\nlkVar env v\n  | Just bv <- lookupCME env v = vm_bvar >.> lookupTM bv\n  | otherwise                  = vm_fvar >.> lkDFreeVar v\n\nxtVar :: CmEnv -> Var -> XT a -> VarMap a -> VarMap a\nxtVar env v f m\n  | Just bv <- lookupCME env v = m { vm_bvar = vm_bvar m |> alterTM bv f }\n  | otherwise                  = m { vm_fvar = vm_fvar m |> xtDFreeVar v f }\n\nfdVar :: (a -> b -> b) -> VarMap a -> b -> b\nfdVar k m = foldTM k (vm_bvar m)\n          . foldTM k (vm_fvar m)\n\nlkDFreeVar :: Var -> DVarEnv a -> Maybe a\nlkDFreeVar var env = lookupDVarEnv env var\n\nxtDFreeVar :: Var -> XT a -> DVarEnv a -> DVarEnv a\nxtDFreeVar v f m = alterDVarEnv f m v\n", "num_lines": 804}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP #-}\nmodule CoreOpt (\n        -- ** Simple expression optimiser\n        simpleOptPgm, simpleOptExpr, simpleOptExprWith,\n\n        -- ** Join points\n        joinPointBinding_maybe, joinPointBindings_maybe,\n\n        -- ** Predicates on expressions\n        exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe,\n\n        -- ** Coercions and casts\n        pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreArity( etaExpandToJoinPoint )\n\nimport CoreSyn\nimport CoreSubst\nimport CoreUtils\nimport CoreFVs\nimport MkCore ( FloatBind(..) )\nimport PprCore  ( pprCoreBindings, pprRules )\nimport OccurAnal( occurAnalyseExpr, occurAnalysePgm )\nimport Literal  ( Literal(LitString) )\nimport Id\nimport Var      ( isNonCoVarId )\nimport VarSet\nimport VarEnv\nimport DataCon\nimport Demand( etaExpandStrictSig )\nimport OptCoercion ( optCoercion )\nimport Type     hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList\n                       , isInScope, substTyVarBndr, cloneTyVarBndr )\nimport Coercion hiding ( substCo, substCoVarBndr )\nimport TyCon        ( tyConArity )\nimport TysWiredIn\nimport PrelNames\nimport BasicTypes\nimport Module       ( Module )\nimport ErrUtils\nimport DynFlags\nimport Outputable\nimport Pair\nimport Util\nimport Maybes       ( orElse )\nimport FastString\nimport Data.List\nimport qualified Data.ByteString as BS\n\n{-\n************************************************************************\n*                                                                      *\n        The Simple Optimiser\n*                                                                      *\n************************************************************************\n\nNote [The simple optimiser]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe simple optimiser is a lightweight, pure (non-monadic) function\nthat rapidly does a lot of simple optimisations, including\n\n  - inlining things that occur just once,\n      or whose RHS turns out to be trivial\n  - beta reduction\n  - case of known constructor\n  - dead code elimination\n\nIt does NOT do any call-site inlining; it only inlines a function if\nit can do so unconditionally, dropping the binding.  It thereby\nguarantees to leave no un-reduced beta-redexes.\n\nIt is careful to follow the guidance of \"Secrets of the GHC inliner\",\nand in particular the pre-inline-unconditionally and\npost-inline-unconditionally story, to do effective beta reduction on\nfunctions called precisely once, without repeatedly optimising the same\nexpression.  In fact, the simple optimiser is a good example of this\nlittle dance in action; the full Simplifier is a lot more complicated.\n\n-}\n\nsimpleOptExpr :: DynFlags -> CoreExpr -> CoreExpr\n-- See Note [The simple optimiser]\n-- Do simple optimisation on an expression\n-- The optimisation is very straightforward: just\n-- inline non-recursive bindings that are used only once,\n-- or where the RHS is trivial\n--\n-- We also inline bindings that bind a Eq# box: see\n-- See Note [Getting the map/coerce RULE to work].\n--\n-- Also we convert functions to join points where possible (as\n-- the occurrence analyser does most of the work anyway).\n--\n-- The result is NOT guaranteed occurrence-analysed, because\n-- in  (let x = y in ....) we substitute for x; so y's occ-info\n-- may change radically\n\nsimpleOptExpr dflags expr\n  = -- pprTrace \"simpleOptExpr\" (ppr init_subst $$ ppr expr)\n    simpleOptExprWith dflags init_subst expr\n  where\n    init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))\n        -- It's potentially important to make a proper in-scope set\n        -- Consider  let x = ..y.. in \\y. ...x...\n        -- Then we should remember to clone y before substituting\n        -- for x.  It's very unlikely to occur, because we probably\n        -- won't *be* substituting for x if it occurs inside a\n        -- lambda.\n        --\n        -- It's a bit painful to call exprFreeVars, because it makes\n        -- three passes instead of two (occ-anal, and go)\n\nsimpleOptExprWith :: DynFlags -> Subst -> InExpr -> OutExpr\n-- See Note [The simple optimiser]\nsimpleOptExprWith dflags subst expr\n  = simple_opt_expr init_env (occurAnalyseExpr expr)\n  where\n    init_env = SOE { soe_dflags = dflags\n                   , soe_inl = emptyVarEnv\n                   , soe_subst = subst }\n\n----------------------\nsimpleOptPgm :: DynFlags -> Module\n             -> CoreProgram -> [CoreRule]\n             -> IO (CoreProgram, [CoreRule])\n-- See Note [The simple optimiser]\nsimpleOptPgm dflags this_mod binds rules\n  = do { dumpIfSet_dyn dflags Opt_D_dump_occur_anal \"Occurrence analysis\"\n                       (pprCoreBindings occ_anald_binds $$ pprRules rules );\n\n       ; return (reverse binds', rules') }\n  where\n    occ_anald_binds  = occurAnalysePgm this_mod\n                          (\\_ -> True)  {- All unfoldings active -}\n                          (\\_ -> False) {- No rules active -}\n                          rules binds\n\n    (final_env, binds') = foldl' do_one (emptyEnv dflags, []) occ_anald_binds\n    final_subst = soe_subst final_env\n\n    rules' = substRulesForImportedIds final_subst rules\n             -- We never unconditionally inline into rules,\n             -- hence paying just a substitution\n\n    do_one (env, binds') bind\n      = case simple_opt_bind env bind of\n          (env', Nothing)    -> (env', binds')\n          (env', Just bind') -> (env', bind':binds')\n\n-- In these functions the substitution maps InVar -> OutExpr\n\n----------------------\ntype SimpleClo = (SimpleOptEnv, InExpr)\n\ndata SimpleOptEnv\n  = SOE { soe_dflags :: DynFlags\n        , soe_inl   :: IdEnv SimpleClo\n             -- Deals with preInlineUnconditionally; things\n             -- that occur exactly once and are inlined\n             -- without having first been simplified\n\n        , soe_subst :: Subst\n             -- Deals with cloning; includes the InScopeSet\n        }\n\ninstance Outputable SimpleOptEnv where\n  ppr (SOE { soe_inl = inl, soe_subst = subst })\n    = text \"SOE {\" <+> vcat [ text \"soe_inl   =\" <+> ppr inl\n                            , text \"soe_subst =\" <+> ppr subst ]\n                   <+> text \"}\"\n\nemptyEnv :: DynFlags -> SimpleOptEnv\nemptyEnv dflags\n  = SOE { soe_dflags = dflags\n        , soe_inl = emptyVarEnv\n        , soe_subst = emptySubst }\n\nsoeZapSubst :: SimpleOptEnv -> SimpleOptEnv\nsoeZapSubst env@(SOE { soe_subst = subst })\n  = env { soe_inl = emptyVarEnv, soe_subst = zapSubstEnv subst }\n\nsoeSetInScope :: SimpleOptEnv -> SimpleOptEnv -> SimpleOptEnv\n-- Take in-scope set from env1, and the rest from env2\nsoeSetInScope (SOE { soe_subst = subst1 })\n              env2@(SOE { soe_subst = subst2 })\n  = env2 { soe_subst = setInScope subst2 (substInScope subst1) }\n\n---------------\nsimple_opt_clo :: SimpleOptEnv -> SimpleClo -> OutExpr\nsimple_opt_clo env (e_env, e)\n  = simple_opt_expr (soeSetInScope env e_env) e\n\nsimple_opt_expr :: SimpleOptEnv -> InExpr -> OutExpr\nsimple_opt_expr env expr\n  = go expr\n  where\n    subst        = soe_subst env\n    in_scope     = substInScope subst\n    in_scope_env = (in_scope, simpleUnfoldingFun)\n\n    go (Var v)\n       | Just clo <- lookupVarEnv (soe_inl env) v\n       = simple_opt_clo env clo\n       | otherwise\n       = lookupIdSubst (text \"simpleOptExpr\") (soe_subst env) v\n\n    go (App e1 e2)      = simple_app env e1 [(env,e2)]\n    go (Type ty)        = Type     (substTy subst ty)\n    go (Coercion co)    = Coercion (optCoercion (soe_dflags env) (getTCvSubst subst) co)\n    go (Lit lit)        = Lit lit\n    go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)\n    go (Cast e co)      | isReflCo co' = go e\n                        | otherwise    = Cast (go e) co'\n                        where\n                          co' = optCoercion (soe_dflags env) (getTCvSubst subst) co\n\n    go (Let bind body) = case simple_opt_bind env bind of\n                           (env', Nothing)   -> simple_opt_expr env' body\n                           (env', Just bind) -> Let bind (simple_opt_expr env' body)\n\n    go lam@(Lam {})     = go_lam env [] lam\n    go (Case e b ty as)\n       -- See Note [Getting the map/coerce RULE to work]\n      | isDeadBinder b\n      , Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e'\n        -- We don't need to be concerned about floats when looking for coerce.\n      , Just (altcon, bs, rhs) <- findAlt (DataAlt con) as\n      = case altcon of\n          DEFAULT -> go rhs\n          _       -> foldr wrapLet (simple_opt_expr env' rhs) mb_prs\n            where\n              (env', mb_prs) = mapAccumL simple_out_bind env $\n                               zipEqual \"simpleOptExpr\" bs es\n\n         -- Note [Getting the map/coerce RULE to work]\n      | isDeadBinder b\n      , [(DEFAULT, _, rhs)] <- as\n      , isCoVarType (varType b)\n      , (Var fun, _args) <- collectArgs e\n      , fun `hasKey` coercibleSCSelIdKey\n         -- without this last check, we get #11230\n      = go rhs\n\n      | otherwise\n      = Case e' b' (substTy subst ty)\n                   (map (go_alt env') as)\n      where\n        e' = go e\n        (env', b') = subst_opt_bndr env b\n\n    ----------------------\n    go_alt env (con, bndrs, rhs)\n      = (con, bndrs', simple_opt_expr env' rhs)\n      where\n        (env', bndrs') = subst_opt_bndrs env bndrs\n\n    ----------------------\n    -- go_lam tries eta reduction\n    go_lam env bs' (Lam b e)\n       = go_lam env' (b':bs') e\n       where\n         (env', b') = subst_opt_bndr env b\n    go_lam env bs' e\n       | Just etad_e <- tryEtaReduce bs e' = etad_e\n       | otherwise                         = mkLams bs e'\n       where\n         bs = reverse bs'\n         e' = simple_opt_expr env e\n\n----------------------\n-- simple_app collects arguments for beta reduction\nsimple_app :: SimpleOptEnv -> InExpr -> [SimpleClo] -> CoreExpr\n\nsimple_app env (Var v) as\n  | Just (env', e) <- lookupVarEnv (soe_inl env) v\n  = simple_app (soeSetInScope env env') e as\n\n  | let unf = idUnfolding v\n  , isCompulsoryUnfolding (idUnfolding v)\n  , isAlwaysActive (idInlineActivation v)\n    -- See Note [Unfold compulsory unfoldings in LHSs]\n  = simple_app (soeZapSubst env) (unfoldingTemplate unf) as\n\n  | otherwise\n  , let out_fn = lookupIdSubst (text \"simple_app\") (soe_subst env) v\n  = finish_app env out_fn as\n\nsimple_app env (App e1 e2) as\n  = simple_app env e1 ((env, e2) : as)\n\nsimple_app env (Lam b e) (a:as)\n  = wrapLet mb_pr (simple_app env' e as)\n  where\n     (env', mb_pr) = simple_bind_pair env b Nothing a\n\nsimple_app env (Tick t e) as\n  -- Okay to do \"(Tick t e) x ==> Tick t (e x)\"?\n  | t `tickishScopesLike` SoftScope\n  = mkTick t $ simple_app env e as\n\n-- (let x = e in b) a1 .. an  =>  let x = e in (b a1 .. an)\n-- The let might appear there as a result of inlining\n-- e.g.   let f = let x = e in b\n--        in f a1 a2\n-- (Trac #13208)\nsimple_app env (Let bind body) as\n  = case simple_opt_bind env bind of\n      (env', Nothing)   -> simple_app env' body as\n      (env', Just bind) -> Let bind (simple_app env' body as)\n\nsimple_app env e as\n  = finish_app env (simple_opt_expr env e) as\n\nfinish_app :: SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr\nfinish_app _ fun []\n  = fun\nfinish_app env fun (arg:args)\n  = finish_app env (App fun (simple_opt_clo env arg)) args\n\n----------------------\nsimple_opt_bind :: SimpleOptEnv -> InBind\n                -> (SimpleOptEnv, Maybe OutBind)\nsimple_opt_bind env (NonRec b r)\n  = (env', case mb_pr of\n            Nothing    -> Nothing\n            Just (b,r) -> Just (NonRec b r))\n  where\n    (b', r') = joinPointBinding_maybe b r `orElse` (b, r)\n    (env', mb_pr) = simple_bind_pair env b' Nothing (env,r')\n\nsimple_opt_bind env (Rec prs)\n  = (env'', res_bind)\n  where\n    res_bind          = Just (Rec (reverse rev_prs'))\n    prs'              = joinPointBindings_maybe prs `orElse` prs\n    (env', bndrs')    = subst_opt_bndrs env (map fst prs')\n    (env'', rev_prs') = foldl' do_pr (env', []) (prs' `zip` bndrs')\n    do_pr (env, prs) ((b,r), b')\n       = (env', case mb_pr of\n                  Just pr -> pr : prs\n                  Nothing -> prs)\n       where\n         (env', mb_pr) = simple_bind_pair env b (Just b') (env,r)\n\n----------------------\nsimple_bind_pair :: SimpleOptEnv\n                 -> InVar -> Maybe OutVar\n                 -> SimpleClo\n                 -> (SimpleOptEnv, Maybe (OutVar, OutExpr))\n    -- (simple_bind_pair subst in_var out_rhs)\n    --   either extends subst with (in_var -> out_rhs)\n    --   or     returns Nothing\nsimple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst })\n                 in_bndr mb_out_bndr clo@(rhs_env, in_rhs)\n  | Type ty <- in_rhs        -- let a::* = TYPE ty in <body>\n  , let out_ty = substTy (soe_subst rhs_env) ty\n  = ASSERT( isTyVar in_bndr )\n    (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)\n\n  | Coercion co <- in_rhs\n  , let out_co = optCoercion (soe_dflags env) (getTCvSubst (soe_subst rhs_env)) co\n  = ASSERT( isCoVar in_bndr )\n    (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)\n\n  | ASSERT2( isNonCoVarId in_bndr, ppr in_bndr )\n    -- The previous two guards got rid of tyvars and coercions\n    -- See Note [CoreSyn type and coercion invariant] in CoreSyn\n    pre_inline_unconditionally\n  = (env { soe_inl = extendVarEnv inl_env in_bndr clo }, Nothing)\n\n  | otherwise\n  = simple_out_bind_pair env in_bndr mb_out_bndr out_rhs\n                         occ active stable_unf\n  where\n    stable_unf = isStableUnfolding (idUnfolding in_bndr)\n    active     = isAlwaysActive (idInlineActivation in_bndr)\n    occ        = idOccInfo in_bndr\n\n    out_rhs | Just join_arity <- isJoinId_maybe in_bndr\n            = simple_join_rhs join_arity\n            | otherwise\n            = simple_opt_clo env clo\n\n    simple_join_rhs join_arity -- See Note [Preserve join-binding arity]\n      = mkLams join_bndrs' (simple_opt_expr env_body join_body)\n      where\n        env0 = soeSetInScope env rhs_env\n        (join_bndrs, join_body) = collectNBinders join_arity in_rhs\n        (env_body, join_bndrs') = subst_opt_bndrs env0 join_bndrs\n\n    pre_inline_unconditionally :: Bool\n    pre_inline_unconditionally\n       | isExportedId in_bndr     = False\n       | stable_unf               = False\n       | not active               = False    -- Note [Inline prag in simplOpt]\n       | not (safe_to_inline occ) = False\n       | otherwise                = True\n\n        -- Unconditionally safe to inline\n    safe_to_inline :: OccInfo -> Bool\n    safe_to_inline (IAmALoopBreaker {}) = False\n    safe_to_inline IAmDead              = True\n    safe_to_inline occ@(OneOcc {})      =  not (occ_in_lam occ)\n                                        && occ_one_br occ\n    safe_to_inline (ManyOccs {})        = False\n\n-------------------\nsimple_out_bind :: SimpleOptEnv -> (InVar, OutExpr)\n                -> (SimpleOptEnv, Maybe (OutVar, OutExpr))\nsimple_out_bind env@(SOE { soe_subst = subst }) (in_bndr, out_rhs)\n  | Type out_ty <- out_rhs\n  = ASSERT( isTyVar in_bndr )\n    (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)\n\n  | Coercion out_co <- out_rhs\n  = ASSERT( isCoVar in_bndr )\n    (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)\n\n  | otherwise\n  = simple_out_bind_pair env in_bndr Nothing out_rhs\n                         (idOccInfo in_bndr) True False\n\n-------------------\nsimple_out_bind_pair :: SimpleOptEnv\n                     -> InId -> Maybe OutId -> OutExpr\n                     -> OccInfo -> Bool -> Bool\n                     -> (SimpleOptEnv, Maybe (OutVar, OutExpr))\nsimple_out_bind_pair env in_bndr mb_out_bndr out_rhs\n                     occ_info active stable_unf\n  | ASSERT2( isNonCoVarId in_bndr, ppr in_bndr )\n    -- Type and coercion bindings are caught earlier\n    -- See Note [CoreSyn type and coercion invariant]\n    post_inline_unconditionally\n  = ( env' { soe_subst = extendIdSubst (soe_subst env) in_bndr out_rhs }\n    , Nothing)\n\n  | otherwise\n  = ( env', Just (out_bndr, out_rhs) )\n  where\n    (env', bndr1) = case mb_out_bndr of\n                      Just out_bndr -> (env, out_bndr)\n                      Nothing       -> subst_opt_bndr env in_bndr\n    out_bndr = add_info env' in_bndr bndr1\n\n    post_inline_unconditionally :: Bool\n    post_inline_unconditionally\n       | isExportedId in_bndr  = False -- Note [Exported Ids and trivial RHSs]\n       | stable_unf            = False -- Note [Stable unfoldings and postInlineUnconditionally]\n       | not active            = False --     in SimplUtils\n       | is_loop_breaker       = False -- If it's a loop-breaker of any kind, don't inline\n                                       -- because it might be referred to \"earlier\"\n       | exprIsTrivial out_rhs = True\n       | coercible_hack        = True\n       | otherwise             = False\n\n    is_loop_breaker = isWeakLoopBreaker occ_info\n\n    -- See Note [Getting the map/coerce RULE to work]\n    coercible_hack | (Var fun, args) <- collectArgs out_rhs\n                   , Just dc <- isDataConWorkId_maybe fun\n                   , dc `hasKey` heqDataConKey || dc `hasKey` coercibleDataConKey\n                   = all exprIsTrivial args\n                   | otherwise\n                   = False\n\n{- Note [Exported Ids and trivial RHSs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe obviously do not want to unconditionally inline an Id that is exported.\nIn SimplUtils, Note [Top level and postInlineUnconditionally], we\nexplain why we don't inline /any/ top-level things unconditionally, even\ntrivial ones.  But we do here!  Why?  In the simple optimiser\n\n  * We do no rule rewrites\n  * We do no call-site inlining\n\nThose differences obviate the reasons for not inlining a trivial rhs,\nand increase the benefit for doing so.  So we unconditionally inline trivial\nrhss here.\n\nNote [Preserve join-binding arity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBe careful /not/ to eta-reduce the RHS of a join point, lest we lose\nthe join-point arity invariant.  Trac #15108 was caused by simplifying\nthe RHS with simple_opt_expr, which does eta-reduction.  Solution:\nsimplify the RHS of a join point by simplifying under the lambdas\n(which of course should be there).\n-}\n\n----------------------\nsubst_opt_bndrs :: SimpleOptEnv -> [InVar] -> (SimpleOptEnv, [OutVar])\nsubst_opt_bndrs env bndrs = mapAccumL subst_opt_bndr env bndrs\n\nsubst_opt_bndr :: SimpleOptEnv -> InVar -> (SimpleOptEnv, OutVar)\nsubst_opt_bndr env bndr\n  | isTyVar bndr  = (env { soe_subst = subst_tv }, tv')\n  | isCoVar bndr  = (env { soe_subst = subst_cv }, cv')\n  | otherwise     = subst_opt_id_bndr env bndr\n  where\n    subst           = soe_subst env\n    (subst_tv, tv') = substTyVarBndr subst bndr\n    (subst_cv, cv') = substCoVarBndr subst bndr\n\nsubst_opt_id_bndr :: SimpleOptEnv -> InId -> (SimpleOptEnv, OutId)\n-- Nuke all fragile IdInfo, unfolding, and RULES;\n--    it gets added back later by add_info\n-- Rather like SimplEnv.substIdBndr\n--\n-- It's important to zap fragile OccInfo (which CoreSubst.substIdBndr\n-- carefully does not do) because simplOptExpr invalidates it\n\nsubst_opt_id_bndr env@(SOE { soe_subst = subst, soe_inl = inl }) old_id\n  = (env { soe_subst = new_subst, soe_inl = new_inl }, new_id)\n  where\n    Subst in_scope id_subst tv_subst cv_subst = subst\n\n    id1    = uniqAway in_scope old_id\n    id2    = setIdType id1 (substTy subst (idType old_id))\n    new_id = zapFragileIdInfo id2\n             -- Zaps rules, unfolding, and fragile OccInfo\n             -- The unfolding and rules will get added back later, by add_info\n\n    new_in_scope = in_scope `extendInScopeSet` new_id\n\n    no_change = new_id == old_id\n\n        -- Extend the substitution if the unique has changed,\n        -- See the notes with substTyVarBndr for the delSubstEnv\n    new_id_subst\n      | no_change = delVarEnv id_subst old_id\n      | otherwise = extendVarEnv id_subst old_id (Var new_id)\n\n    new_subst = Subst new_in_scope new_id_subst tv_subst cv_subst\n    new_inl   = delVarEnv inl old_id\n\n----------------------\nadd_info :: SimpleOptEnv -> InVar -> OutVar -> OutVar\nadd_info env old_bndr new_bndr\n | isTyVar old_bndr = new_bndr\n | otherwise        = maybeModifyIdInfo mb_new_info new_bndr\n where\n   subst = soe_subst env\n   mb_new_info = substIdInfo subst new_bndr (idInfo old_bndr)\n\nsimpleUnfoldingFun :: IdUnfoldingFun\nsimpleUnfoldingFun id\n  | isAlwaysActive (idInlineActivation id) = idUnfolding id\n  | otherwise                              = noUnfolding\n\nwrapLet :: Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr\nwrapLet Nothing      body = body\nwrapLet (Just (b,r)) body = Let (NonRec b r) body\n\n{-\nNote [Inline prag in simplOpt]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf there's an INLINE/NOINLINE pragma that restricts the phase in\nwhich the binder can be inlined, we don't inline here; after all,\nwe don't know what phase we're in.  Here's an example\n\n  foo :: Int -> Int -> Int\n  {-# INLINE foo #-}\n  foo m n = inner m\n     where\n       {-# INLINE [1] inner #-}\n       inner m = m+n\n\n  bar :: Int -> Int\n  bar n = foo n 1\n\nWhen inlining 'foo' in 'bar' we want the let-binding for 'inner'\nto remain visible until Phase 1\n\nNote [Unfold compulsory unfoldings in LHSs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the user writes `RULES map coerce = coerce` as a rule, the rule\nwill only ever match if simpleOptExpr replaces coerce by its unfolding\non the LHS, because that is the core that the rule matching engine\nwill find. So do that for everything that has a compulsory\nunfolding. Also see Note [Desugaring coerce as cast] in Desugar.\n\nHowever, we don't want to inline 'seq', which happens to also have a\ncompulsory unfolding, so we only do this unfolding only for things\nthat are always-active.  See Note [User-defined RULES for seq] in MkId.\n\nNote [Getting the map/coerce RULE to work]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe wish to allow the \"map/coerce\" RULE to fire:\n\n  {-# RULES \"map/coerce\" map coerce = coerce #-}\n\nThe naive core produced for this is\n\n  forall a b (dict :: Coercible * a b).\n    map @a @b (coerce @a @b @dict) = coerce @[a] @[b] @dict'\n\n  where dict' :: Coercible [a] [b]\n        dict' = ...\n\nThis matches literal uses of `map coerce` in code, but that's not what we\nwant. We want it to match, say, `map MkAge` (where newtype Age = MkAge Int)\ntoo. Some of this is addressed by compulsorily unfolding coerce on the LHS,\nyielding\n\n  forall a b (dict :: Coercible * a b).\n    map @a @b (\\(x :: a) -> case dict of\n      MkCoercible (co :: a ~R# b) -> x |> co) = ...\n\nGetting better. But this isn't exactly what gets produced. This is because\nCoercible essentially has ~R# as a superclass, and superclasses get eagerly\nextracted during solving. So we get this:\n\n  forall a b (dict :: Coercible * a b).\n    case Coercible_SCSel @* @a @b dict of\n      _ [Dead] -> map @a @b (\\(x :: a) -> case dict of\n                               MkCoercible (co :: a ~R# b) -> x |> co) = ...\n\nUnfortunately, this still abstracts over a Coercible dictionary. We really\nwant it to abstract over the ~R# evidence. So, we have Desugar.unfold_coerce,\nwhich transforms the above to (see also Note [Desugaring coerce as cast] in\nDesugar)\n\n  forall a b (co :: a ~R# b).\n    let dict = MkCoercible @* @a @b co in\n    case Coercible_SCSel @* @a @b dict of\n      _ [Dead] -> map @a @b (\\(x :: a) -> case dict of\n         MkCoercible (co :: a ~R# b) -> x |> co) = let dict = ... in ...\n\nNow, we need simpleOptExpr to fix this up. It does so by taking three\nseparate actions:\n  1. Inline certain non-recursive bindings. The choice whether to inline\n     is made in simple_bind_pair. Note the rather specific check for\n     MkCoercible in there.\n\n  2. Stripping case expressions like the Coercible_SCSel one.\n     See the `Case` case of simple_opt_expr's `go` function.\n\n  3. Look for case expressions that unpack something that was\n     just packed and inline them. This is also done in simple_opt_expr's\n     `go` function.\n\nThis is all a fair amount of special-purpose hackery, but it's for\na good cause. And it won't hurt other RULES and such that it comes across.\n\n\n************************************************************************\n*                                                                      *\n                Join points\n*                                                                      *\n************************************************************************\n-}\n\n-- | Returns Just (bndr,rhs) if the binding is a join point:\n-- If it's a JoinId, just return it\n-- If it's not yet a JoinId but is always tail-called,\n--    make it into a JoinId and return it.\n-- In the latter case, eta-expand the RHS if necessary, to make the\n-- lambdas explicit, as is required for join points\n--\n-- Precondition: the InBndr has been occurrence-analysed,\n--               so its OccInfo is valid\njoinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr)\njoinPointBinding_maybe bndr rhs\n  | not (isId bndr)\n  = Nothing\n\n  | isJoinId bndr\n  = Just (bndr, rhs)\n\n  | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr)\n  , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs\n  , let str_sig   = idStrictness bndr\n        str_arity = count isId bndrs  -- Strictness demands are for Ids only\n        join_bndr = bndr `asJoinId`        join_arity\n                         `setIdStrictness` etaExpandStrictSig str_arity str_sig\n  = Just (join_bndr, mkLams bndrs body)\n\n  | otherwise\n  = Nothing\n\njoinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)]\njoinPointBindings_maybe bndrs\n  = mapM (uncurry joinPointBinding_maybe) bndrs\n\n\n{- Note [Strictness and join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n   let f = \\x.  if x>200 then e1 else e1\n\nand we know that f is strict in x.  Then if we subsequently\ndiscover that f is an arity-2 join point, we'll eta-expand it to\n\n   let f = \\x y.  if x>200 then e1 else e1\n\nand now it's only strict if applied to two arguments.  So we should\nadjust the strictness info.\n\nA more common case is when\n\n   f = \\x. error \"..\"\n\nand again its arity increses (Trac #15517)\n-}\n\n{- *********************************************************************\n*                                                                      *\n         exprIsConApp_maybe\n*                                                                      *\n************************************************************************\n\nNote [exprIsConApp_maybe]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nexprIsConApp_maybe is a very important function.  There are two principal\nuses:\n  * case e of { .... }\n  * cls_op e, where cls_op is a class operation\n\nIn both cases you want to know if e is of form (C e1..en) where C is\na data constructor.\n\nHowever e might not *look* as if\n\n\nNote [exprIsConApp_maybe on literal strings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee #9400 and #13317.\n\nConceptually, a string literal \"abc\" is just ('a':'b':'c':[]), but in Core\nthey are represented as unpackCString# \"abc\"# by MkCore.mkStringExprFS, or\nunpackCStringUtf8# when the literal contains multi-byte UTF8 characters.\n\nFor optimizations we want to be able to treat it as a list, so they can be\ndecomposed when used in a case-statement. exprIsConApp_maybe detects those\ncalls to unpackCString# and returns:\n\nJust (':', [Char], ['a', unpackCString# \"bc\"]).\n\nWe need to be careful about UTF8 strings here. \"\"# contains a ByteString, so\nwe must parse it back into a FastString to split off the first character.\nThat way we can treat unpackCString# and unpackCStringUtf8# in the same way.\n\nWe must also be caeful about\n   lvl = \"foo\"#\n   ...(unpackCString# lvl)...\nto ensure that we see through the let-binding for 'lvl'.  Hence the\n(exprIsLiteral_maybe .. arg) in the guard before the call to\ndealWithStringLiteral.\n\nNote [Push coercions in exprIsConApp_maybe]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn Trac #13025 I found a case where we had\n    op (df @t1 @t2)     -- op is a ClassOp\nwhere\n    df = (/\\a b. K e1 e2) |> g\n\nTo get this to come out we need to simplify on the fly\n   ((/\\a b. K e1 e2) |> g) @t1 @t2\n\nHence the use of pushCoArgs.\n\nNote [exprIsConApp_maybe on data constructors with wrappers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nProblem:\n- some data constructors have wrappers\n- these wrappers inline late (see MkId Note [Activation for data constructor wrappers])\n- but we still want case-of-known-constructor to fire early.\n\nExample:\n   data T = MkT !Int\n   $WMkT n = case n of n' -> MkT n'   -- Wrapper for MkT\n   foo x = case $WMkT e of MkT y -> blah\n\nHere we want the case-of-known-constructor transformation to fire, giving\n   foo x = case e of x' -> let y = x' in blah\n\nHere's how exprIsConApp_maybe achieves this:\n\n0.  Start with scrutinee = $WMkT e\n\n1.  Inline $WMkT on-the-fly.  That's why data-constructor wrappers are marked\n    as expandable. (See CoreUtils.isExpandableApp.) Now we have\n      scrutinee = (\\n. case n of n' -> MkT n') e\n\n2.  Beta-reduce the application, generating a floated 'let'.\n    See Note [beta-reduction in exprIsConApp_maybe] below.  Now we have\n      scrutinee = case n of n' -> MkT n'\n      with floats {Let n = e}\n\n3.  Float the \"case x of x' ->\" binding out.  Now we have\n      scrutinee = MkT n'\n      with floats {Let n = e; case n of n' ->}\n\nAnd now we have a known-constructor MkT that we can return.\n\nNotice that both (2) and (3) require exprIsConApp_maybe to gather and return\na bunch of floats, both let and case bindings.\n\nNote [beta-reduction in exprIsConApp_maybe]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe unfolding a definition (_e.g._ a let-bound variable or a datacon wrapper) is\ntypically a function. For instance, take the wrapper for MkT in Note\n[exprIsConApp_maybe on data constructors with wrappers]:\n\n    $WMkT n = case n of { n' -> T n' }\n\nIf `exprIsConApp_maybe` is trying to analyse `$MkT arg`, upon unfolding of $MkT,\nit will see\n\n   (\\n -> case n of { n' -> T n' }) arg\n\nIn order to go progress, `exprIsConApp_maybe` must perform a beta-reduction.\n\nWe don't want to blindly substitute `arg` in the body of the function, because\nit duplicates work. We can (and, in fact, used to) substitute `arg` in the body,\nbut only when `arg` is a variable (or something equally work-free).\n\nBut, because of Note [exprIsConApp_maybe on data constructors with wrappers],\n'exprIsConApp_maybe' now returns floats. So, instead, we can beta-reduce\n_always_:\n\n    (\\x -> body) arg\n\nIs transformed into\n\n   let x = arg in body\n\nWhich, effectively, means emitting a float `let x = arg` and recursively\nanalysing the body.\n\nFor newtypes, this strategy requires that their wrappers have compulsory unfoldings.\nSuppose we have\n   newtype T a b where\n     MkT :: a -> T b a   -- Note args swapped\n\nThis defines a worker function MkT, a wrapper function $WMkT, and an axT:\n   $WMkT :: forall a b. a -> T b a\n   $WMkT = /\\b a. \\(x:a). MkT a b x    -- A real binding\n\n   MkT :: forall a b. a -> T a b\n   MkT = /\\a b. \\(x:a). x |> (ax a b)  -- A compulsory unfolding\n\n   axiom axT :: a ~R# T a b\n\nNow we are optimising\n   case $WMkT (I# 3) |> sym axT of I# y -> ...\nwe clearly want to simplify this. If $WMkT did not have a compulsory\nunfolding, we would end up with\n   let a = I#3 in case a of I# y -> ...\nbecause in general, we do this on-the-fly beta-reduction\n   (\\x. e) blah  -->  let x = blah in e\nand then float the the let.  (Substitution would risk duplicating 'blah'.)\n\nBut if the case-of-known-constructor doesn't actually fire (i.e.\nexprIsConApp_maybe does not return Just) then nothing happens, and nothing\nwill happen the next time either.\n\nSee test T16254, which checks the behavior of newtypes.\n-}\n\ndata ConCont = CC [CoreExpr] Coercion\n                  -- Substitution already applied\n\n-- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument\n-- expression is a *saturated* constructor application of the form @let b1 in\n-- .. let bp in dc t1..tk x1 .. xn@, where t1..tk are the\n-- *universally-quantified* type args of 'dc'. Floats can also be (and most\n-- likely are) single-alternative case expressions. Why does\n-- 'exprIsConApp_maybe' return floats? We may have to look through lets and\n-- cases to detect that we are in the presence of a data constructor wrapper. In\n-- this case, we need to return the lets and cases that we traversed. See Note\n-- [exprIsConApp_maybe on data constructors with wrappers]. Data constructor wrappers\n-- are unfolded late, but we really want to trigger case-of-known-constructor as\n-- early as possible. See also Note [Activation for data constructor wrappers]\n-- in MkId.\n--\n-- We also return the incoming InScopeSet, augmented with\n-- the binders from any [FloatBind] that we return\nexprIsConApp_maybe :: InScopeEnv -> CoreExpr\n                   -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])\nexprIsConApp_maybe (in_scope, id_unf) expr\n  = go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr)))\n  where\n    go :: Either InScopeSet Subst\n             -- Left in-scope  means \"empty substitution\"\n             -- Right subst    means \"apply this substitution to the CoreExpr\"\n             -- NB: in the call (go subst floats expr cont)\n             --     the substitution applies to 'expr', but /not/ to 'floats' or 'cont'\n       -> [FloatBind] -> CoreExpr -> ConCont\n             -- Notice that the floats here are in reverse order\n       -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])\n    go subst floats (Tick t expr) cont\n       | not (tickishIsCode t) = go subst floats expr cont\n\n    go subst floats (Cast expr co1) (CC args co2)\n       | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args\n            -- See Note [Push coercions in exprIsConApp_maybe]\n       = case m_co1' of\n           MCo co1' -> go subst floats expr (CC args' (co1' `mkTransCo` co2))\n           MRefl    -> go subst floats expr (CC args' co2)\n\n    go subst floats (App fun arg) (CC args co)\n       = go subst floats fun (CC (subst_expr subst arg : args) co)\n\n    go subst floats (Lam bndr body) (CC (arg:args) co)\n       | exprIsTrivial arg          -- Don't duplicate stuff!\n       = go (extend subst bndr arg) floats body (CC args co)\n       | otherwise\n       = let (subst', bndr') = subst_bndr subst bndr\n             float           = FloatLet (NonRec bndr' arg)\n         in go subst' (float:floats) body (CC args co)\n\n    go subst floats (Let (NonRec bndr rhs) expr) cont\n       = let rhs'            = subst_expr subst rhs\n             (subst', bndr') = subst_bndr subst bndr\n             float           = FloatLet (NonRec bndr' rhs')\n         in go subst' (float:floats) expr cont\n\n    go subst floats (Case scrut b _ [(con, vars, expr)]) cont\n       = let\n          scrut'           = subst_expr subst scrut\n          (subst', b')     = subst_bndr subst b\n          (subst'', vars') = subst_bndrs subst' vars\n          float            = FloatCase scrut' b' con vars'\n         in\n           go subst'' (float:floats) expr cont\n\n    go (Right sub) floats (Var v) cont\n       = go (Left (substInScope sub))\n            floats\n            (lookupIdSubst (text \"exprIsConApp\" <+> ppr expr) sub v)\n            cont\n\n    go (Left in_scope) floats (Var fun) cont@(CC args co)\n\n        | Just con <- isDataConWorkId_maybe fun\n        , count isValArg args == idArity fun\n        = succeedWith in_scope floats $\n          pushCoDataCon con args co\n\n        -- Look through data constructor wrappers: they inline late (See Note\n        -- [Activation for data constructor wrappers]) but we want to do\n        -- case-of-known-constructor optimisation eagerly.\n        | isDataConWrapId fun\n        , let rhs = uf_tmpl (realIdUnfolding fun)\n        = go (Left in_scope) floats rhs cont\n\n        -- Look through dictionary functions; see Note [Unfolding DFuns]\n        | DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = dfun_args } <- unfolding\n        , bndrs `equalLength` args    -- See Note [DFun arity check]\n        , let subst = mkOpenSubst in_scope (bndrs `zip` args)\n        = succeedWith in_scope floats $\n          pushCoDataCon con (map (substExpr (text \"exprIsConApp1\") subst) dfun_args) co\n\n        -- Look through unfoldings, but only arity-zero one;\n        -- if arity > 0 we are effectively inlining a function call,\n        -- and that is the business of callSiteInline.\n        -- In practice, without this test, most of the \"hits\" were\n        -- CPR'd workers getting inlined back into their wrappers,\n        | idArity fun == 0\n        , Just rhs <- expandUnfolding_maybe unfolding\n        , let in_scope' = extendInScopeSetSet in_scope (exprFreeVars rhs)\n        = go (Left in_scope') floats rhs cont\n\n        -- See Note [exprIsConApp_maybe on literal strings]\n        | (fun `hasKey` unpackCStringIdKey) ||\n          (fun `hasKey` unpackCStringUtf8IdKey)\n        , [arg]              <- args\n        , Just (LitString str) <- exprIsLiteral_maybe (in_scope, id_unf) arg\n        = succeedWith in_scope floats $\n          dealWithStringLiteral fun str co\n        where\n          unfolding = id_unf fun\n\n    go _ _ _ _ = Nothing\n\n    succeedWith :: InScopeSet -> [FloatBind]\n                -> Maybe (DataCon, [Type], [CoreExpr])\n                -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])\n    succeedWith in_scope rev_floats x\n      = do { (con, tys, args) <- x\n           ; let floats = reverse rev_floats\n           ; return (in_scope, floats, con, tys, args) }\n\n    ----------------------------\n    -- Operations on the (Either InScopeSet CoreSubst)\n    -- The Left case is wildly dominant\n    subst_co (Left {}) co = co\n    subst_co (Right s) co = CoreSubst.substCo s co\n\n    subst_expr (Left {}) e = e\n    subst_expr (Right s) e = substExpr (text \"exprIsConApp2\") s e\n\n    subst_bndr msubst bndr\n      = (Right subst', bndr')\n      where\n        (subst', bndr') = substBndr subst bndr\n        subst = case msubst of\n                  Left in_scope -> mkEmptySubst in_scope\n                  Right subst   -> subst\n\n    subst_bndrs subst bs = mapAccumL subst_bndr subst bs\n\n    extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e)\n    extend (Right s)       v e = Right (extendSubst s v e)\n\n\n-- See Note [exprIsConApp_maybe on literal strings]\ndealWithStringLiteral :: Var -> BS.ByteString -> Coercion\n                      -> Maybe (DataCon, [Type], [CoreExpr])\n\n-- This is not possible with user-supplied empty literals, MkCore.mkStringExprFS\n-- turns those into [] automatically, but just in case something else in GHC\n-- generates a string literal directly.\ndealWithStringLiteral _   str co\n  | BS.null str\n  = pushCoDataCon nilDataCon [Type charTy] co\n\ndealWithStringLiteral fun str co\n  = let strFS = mkFastStringByteString str\n\n        char = mkConApp charDataCon [mkCharLit (headFS strFS)]\n        charTail = bytesFS (tailFS strFS)\n\n        -- In singleton strings, just add [] instead of unpackCstring# \"\"#.\n        rest = if BS.null charTail\n                 then mkConApp nilDataCon [Type charTy]\n                 else App (Var fun)\n                          (Lit (LitString charTail))\n\n    in pushCoDataCon consDataCon [Type charTy, char, rest] co\n\n{-\nNote [Unfolding DFuns]\n~~~~~~~~~~~~~~~~~~~~~~\nDFuns look like\n\n  df :: forall a b. (Eq a, Eq b) -> Eq (a,b)\n  df a b d_a d_b = MkEqD (a,b) ($c1 a b d_a d_b)\n                               ($c2 a b d_a d_b)\n\nSo to split it up we just need to apply the ops $c1, $c2 etc\nto the very same args as the dfun.  It takes a little more work\nto compute the type arguments to the dictionary constructor.\n\nNote [DFun arity check]\n~~~~~~~~~~~~~~~~~~~~~~~\nHere we check that the total number of supplied arguments (inclding\ntype args) matches what the dfun is expecting.  This may be *less*\nthan the ordinary arity of the dfun: see Note [DFun unfoldings] in CoreSyn\n-}\n\nexprIsLiteral_maybe :: InScopeEnv -> CoreExpr -> Maybe Literal\n-- Same deal as exprIsConApp_maybe, but much simpler\n-- Nevertheless we do need to look through unfoldings for\n-- Integer and string literals, which are vigorously hoisted to top level\n-- and not subsequently inlined\nexprIsLiteral_maybe env@(_, id_unf) e\n  = case e of\n      Lit l     -> Just l\n      Tick _ e' -> exprIsLiteral_maybe env e' -- dubious?\n      Var v     | Just rhs <- expandUnfolding_maybe (id_unf v)\n                -> exprIsLiteral_maybe env rhs\n      _         -> Nothing\n\n{-\nNote [exprIsLambda_maybe]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nexprIsLambda_maybe will, given an expression `e`, try to turn it into the form\n`Lam v e'` (returned as `Just (v,e')`). Besides using lambdas, it looks through\ncasts (using the Push rule), and it unfolds function calls if the unfolding\nhas a greater arity than arguments are present.\n\nCurrently, it is used in Rules.match, and is required to make\n\"map coerce = coerce\" match.\n-}\n\nexprIsLambda_maybe :: InScopeEnv -> CoreExpr\n                      -> Maybe (Var, CoreExpr,[Tickish Id])\n    -- See Note [exprIsLambda_maybe]\n\n-- The simple case: It is a lambda already\nexprIsLambda_maybe _ (Lam x e)\n    = Just (x, e, [])\n\n-- Still straightforward: Ticks that we can float out of the way\nexprIsLambda_maybe (in_scope_set, id_unf) (Tick t e)\n    | tickishFloatable t\n    , Just (x, e, ts) <- exprIsLambda_maybe (in_scope_set, id_unf) e\n    = Just (x, e, t:ts)\n\n-- Also possible: A casted lambda. Push the coercion inside\nexprIsLambda_maybe (in_scope_set, id_unf) (Cast casted_e co)\n    | Just (x, e,ts) <- exprIsLambda_maybe (in_scope_set, id_unf) casted_e\n    -- Only do value lambdas.\n    -- this implies that x is not in scope in gamma (makes this code simpler)\n    , not (isTyVar x) && not (isCoVar x)\n    , ASSERT( not $ x `elemVarSet` tyCoVarsOfCo co) True\n    , Just (x',e') <- pushCoercionIntoLambda in_scope_set x e co\n    , let res = Just (x',e',ts)\n    = --pprTrace \"exprIsLambda_maybe:Cast\" (vcat [ppr casted_e,ppr co,ppr res)])\n      res\n\n-- Another attempt: See if we find a partial unfolding\nexprIsLambda_maybe (in_scope_set, id_unf) e\n    | (Var f, as, ts) <- collectArgsTicks tickishFloatable e\n    , idArity f > count isValArg as\n    -- Make sure there is hope to get a lambda\n    , Just rhs <- expandUnfolding_maybe (id_unf f)\n    -- Optimize, for beta-reduction\n    , let e' = simpleOptExprWith unsafeGlobalDynFlags (mkEmptySubst in_scope_set) (rhs `mkApps` as)\n    -- Recurse, because of possible casts\n    , Just (x', e'', ts') <- exprIsLambda_maybe (in_scope_set, id_unf) e'\n    , let res = Just (x', e'', ts++ts')\n    = -- pprTrace \"exprIsLambda_maybe:Unfold\" (vcat [ppr e, ppr (x',e'')])\n      res\n\nexprIsLambda_maybe _ _e\n    = -- pprTrace \"exprIsLambda_maybe:Fail\" (vcat [ppr _e])\n      Nothing\n\n\n{- *********************************************************************\n*                                                                      *\n              The \"push rules\"\n*                                                                      *\n************************************************************************\n\nHere we implement the \"push rules\" from FC papers:\n\n* The push-argument rules, where we can move a coercion past an argument.\n  We have\n      (fun |> co) arg\n  and we want to transform it to\n    (fun arg') |> co'\n  for some suitable co' and tranformed arg'.\n\n* The PushK rule for data constructors.  We have\n       (K e1 .. en) |> co\n  and we want to tranform to\n       (K e1' .. en')\n  by pushing the coercion into the arguments\n-}\n\npushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], MCoercion)\npushCoArgs co []         = return ([], MCo co)\npushCoArgs co (arg:args) = do { (arg',  m_co1) <- pushCoArg  co  arg\n                              ; case m_co1 of\n                                  MCo co1 -> do { (args', m_co2) <- pushCoArgs co1 args\n                                                 ; return (arg':args', m_co2) }\n                                  MRefl  -> return (arg':args, MRefl) }\n\npushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion)\n-- We have (fun |> co) arg, and we want to transform it to\n--         (fun arg) |> co\n-- This may fail, e.g. if (fun :: N) where N is a newtype\n-- C.f. simplCast in Simplify.hs\n-- 'co' is always Representational\n-- If the returned coercion is Nothing, then it would have been reflexive\npushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty\n                            ; return (Type ty', m_co') }\npushCoArg co val_arg   = do { (arg_co, m_co') <- pushCoValArg co\n                            ; return (val_arg `mkCast` arg_co, m_co') }\n\npushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR)\n-- We have (fun |> co) @ty\n-- Push the coercion through to return\n--         (fun @ty') |> co'\n-- 'co' is always Representational\n-- If the returned coercion is Nothing, then it would have been reflexive;\n-- it's faster not to compute it, though.\npushCoTyArg co ty\n  -- The following is inefficient - don't do `eqType` here, the coercion\n  -- optimizer will take care of it. See Trac #14737.\n  -- -- | tyL `eqType` tyR\n  -- -- = Just (ty, Nothing)\n\n  | isReflCo co\n  = Just (ty, MRefl)\n\n  | isForAllTy_ty tyL\n  = ASSERT2( isForAllTy_ty tyR, ppr co $$ ppr ty )\n    Just (ty `mkCastTy` co1, MCo co2)\n\n  | otherwise\n  = Nothing\n  where\n    Pair tyL tyR = coercionKind co\n       -- co :: tyL ~ tyR\n       -- tyL = forall (a1 :: k1). ty1\n       -- tyR = forall (a2 :: k2). ty2\n\n    co1 = mkSymCo (mkNthCo Nominal 0 co)\n       -- co1 :: k2 ~N k1\n       -- Note that NthCo can extract a Nominal equality between the\n       -- kinds of the types related by a coercion between forall-types.\n       -- See the NthCo case in CoreLint.\n\n    co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1)\n        -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ]\n        -- Arg of mkInstCo is always nominal, hence mkNomReflCo\n\npushCoValArg :: CoercionR -> Maybe (Coercion, MCoercion)\n-- We have (fun |> co) arg\n-- Push the coercion through to return\n--         (fun (arg |> co_arg)) |> co_res\n-- 'co' is always Representational\n-- If the second returned Coercion is actually Nothing, then no cast is necessary;\n-- the returned coercion would have been reflexive.\npushCoValArg co\n  -- The following is inefficient - don't do `eqType` here, the coercion\n  -- optimizer will take care of it. See Trac #14737.\n  -- -- | tyL `eqType` tyR\n  -- -- = Just (mkRepReflCo arg, Nothing)\n\n  | isReflCo co\n  = Just (mkRepReflCo arg, MRefl)\n\n  | isFunTy tyL\n  , (co1, co2) <- decomposeFunCo Representational co\n              -- If   co  :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2)\n              -- then co1 :: tyL1 ~ tyR1\n              --      co2 :: tyL2 ~ tyR2\n  = ASSERT2( isFunTy tyR, ppr co $$ ppr arg )\n    Just (mkSymCo co1, MCo co2)\n\n  | otherwise\n  = Nothing\n  where\n    arg = funArgTy tyR\n    Pair tyL tyR = coercionKind co\n\npushCoercionIntoLambda\n    :: InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr)\n-- This implements the Push rule from the paper on coercions\n--    (\\x. e) |> co\n-- ===>\n--    (\\x'. e |> co')\npushCoercionIntoLambda in_scope x e co\n    | ASSERT(not (isTyVar x) && not (isCoVar x)) True\n    , Pair s1s2 t1t2 <- coercionKind co\n    , Just (_s1,_s2) <- splitFunTy_maybe s1s2\n    , Just (t1,_t2) <- splitFunTy_maybe t1t2\n    = let (co1, co2) = decomposeFunCo Representational co\n          -- Should we optimize the coercions here?\n          -- Otherwise they might not match too well\n          x' = x `setIdType` t1\n          in_scope' = in_scope `extendInScopeSet` x'\n          subst = extendIdSubst (mkEmptySubst in_scope')\n                                x\n                                (mkCast (Var x') co1)\n      in Just (x', substExpr (text \"pushCoercionIntoLambda\") subst e `mkCast` co2)\n    | otherwise\n    = pprTrace \"exprIsLambda_maybe: Unexpected lambda in case\" (ppr (Lam x e))\n      Nothing\n\npushCoDataCon :: DataCon -> [CoreExpr] -> Coercion\n              -> Maybe (DataCon\n                       , [Type]      -- Universal type args\n                       , [CoreExpr]) -- All other args incl existentials\n-- Implement the KPush reduction rule as described in \"Down with kinds\"\n-- The transformation applies iff we have\n--      (C e1 ... en) `cast` co\n-- where co :: (T t1 .. tn) ~ to_ty\n-- The left-hand one must be a T, because exprIsConApp returned True\n-- but the right-hand one might not be.  (Though it usually will.)\npushCoDataCon dc dc_args co\n  | isReflCo co || from_ty `eqType` to_ty  -- try cheap test first\n  , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args\n  = Just (dc, map exprToType univ_ty_args, rest_args)\n\n  | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty\n  , to_tc == dataConTyCon dc\n        -- These two tests can fail; we might see\n        --      (C x y) `cast` (g :: T a ~ S [a]),\n        -- where S is a type function.  In fact, exprIsConApp\n        -- will probably not be called in such circumstances,\n        -- but there's nothing wrong with it\n\n  = let\n        tc_arity       = tyConArity to_tc\n        dc_univ_tyvars = dataConUnivTyVars dc\n        dc_ex_tcvars   = dataConExTyCoVars dc\n        arg_tys        = dataConRepArgTys dc\n\n        non_univ_args  = dropList dc_univ_tyvars dc_args\n        (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args\n\n        -- Make the \"Psi\" from the paper\n        omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc)\n        (psi_subst, to_ex_arg_tys)\n          = liftCoSubstWithEx Representational\n                              dc_univ_tyvars\n                              omegas\n                              dc_ex_tcvars\n                              (map exprToType ex_args)\n\n          -- Cast the value arguments (which include dictionaries)\n        new_val_args = zipWith cast_arg arg_tys val_args\n        cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty)\n\n        to_ex_args = map Type to_ex_arg_tys\n\n        dump_doc = vcat [ppr dc,      ppr dc_univ_tyvars, ppr dc_ex_tcvars,\n                         ppr arg_tys, ppr dc_args,\n                         ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc ]\n    in\n    ASSERT2( eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args)), dump_doc )\n    ASSERT2( equalLength val_args arg_tys, dump_doc )\n    Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args)\n\n  | otherwise\n  = Nothing\n\n  where\n    Pair from_ty to_ty = coercionKind co\n\ncollectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr)\n-- Collect lambda binders, pushing coercions inside if possible\n-- E.g.   (\\x.e) |> g         g :: <Int> -> blah\n--        = (\\x. e |> Nth 1 g)\n--\n-- That is,\n--\n-- collectBindersPushingCo ((\\x.e) |> g) === ([x], e |> Nth 1 g)\ncollectBindersPushingCo e\n  = go [] e\n  where\n    -- Peel off lambdas until we hit a cast.\n    go :: [Var] -> CoreExpr -> ([Var], CoreExpr)\n    -- The accumulator is in reverse order\n    go bs (Lam b e)   = go (b:bs) e\n    go bs (Cast e co) = go_c bs e co\n    go bs e           = (reverse bs, e)\n\n    -- We are in a cast; peel off casts until we hit a lambda.\n    go_c :: [Var] -> CoreExpr -> CoercionR -> ([Var], CoreExpr)\n    -- (go_c bs e c) is same as (go bs e (e |> c))\n    go_c bs (Cast e co1) co2 = go_c bs e (co1 `mkTransCo` co2)\n    go_c bs (Lam b e)    co  = go_lam bs b e co\n    go_c bs e            co  = (reverse bs, mkCast e co)\n\n    -- We are in a lambda under a cast; peel off lambdas and build a\n    -- new coercion for the body.\n    go_lam :: [Var] -> Var -> CoreExpr -> CoercionR -> ([Var], CoreExpr)\n    -- (go_lam bs b e c) is same as (go_c bs (\\b.e) c)\n    go_lam bs b e co\n      | isTyVar b\n      , let Pair tyL tyR = coercionKind co\n      , ASSERT( isForAllTy_ty tyL )\n        isForAllTy_ty tyR\n      , isReflCo (mkNthCo Nominal 0 co)  -- See Note [collectBindersPushingCo]\n      = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b)))\n\n      | isCoVar b\n      , let Pair tyL tyR = coercionKind co\n      , ASSERT( isForAllTy_co tyL )\n        isForAllTy_co tyR\n      , isReflCo (mkNthCo Nominal 0 co)  -- See Note [collectBindersPushingCo]\n      , let cov = mkCoVarCo b\n      = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov)))\n\n      | isId b\n      , let Pair tyL tyR = coercionKind co\n      , ASSERT( isFunTy tyL) isFunTy tyR\n      , (co_arg, co_res) <- decomposeFunCo Representational co\n      , isReflCo co_arg  -- See Note [collectBindersPushingCo]\n      = go_c (b:bs) e co_res\n\n      | otherwise = (reverse bs, mkCast (Lam b e) co)\n\n{- Note [collectBindersPushingCo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe just look for coercions of form\n   <type> -> blah\n(and similarly for foralls) to keep this function simple.  We could do\nmore elaborate stuff, but it'd involve substitution etc.\n-}\n", "num_lines": 1389}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow, 1994-2006\n\n\nCore pass to saturate constructors and PrimOps\n-}\n\n{-# LANGUAGE BangPatterns, CPP, MultiWayIf #-}\n\nmodule CorePrep (\n      corePrepPgm, corePrepExpr, cvtLitInteger, cvtLitNatural,\n      lookupMkIntegerName, lookupIntegerSDataConName,\n      lookupMkNaturalName, lookupNaturalSDataConName\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport OccurAnal\n\nimport HscTypes\nimport PrelNames\nimport MkId             ( realWorldPrimId )\nimport CoreUtils\nimport CoreArity\nimport CoreFVs\nimport CoreMonad        ( CoreToDo(..) )\nimport CoreLint         ( endPassIO )\nimport CoreSyn\nimport CoreSubst\nimport MkCore hiding( FloatBind(..) )   -- We use our own FloatBind here\nimport Type\nimport Literal\nimport Coercion\nimport TcEnv\nimport TyCon\nimport Demand\nimport Var\nimport VarSet\nimport VarEnv\nimport Id\nimport IdInfo\nimport TysWiredIn\nimport DataCon\nimport BasicTypes\nimport Module\nimport UniqSupply\nimport Maybes\nimport OrdList\nimport ErrUtils\nimport DynFlags\nimport Util\nimport Pair\nimport Outputable\nimport Platform\nimport FastString\nimport Config\nimport Name             ( NamedThing(..), nameSrcSpan )\nimport SrcLoc           ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )\nimport Data.Bits\nimport MonadUtils       ( mapAccumLM )\nimport Data.List        ( mapAccumL )\nimport Control.Monad\nimport CostCentre       ( CostCentre, ccFromThisModule )\nimport qualified Data.Set as S\n\n{-\n-- ---------------------------------------------------------------------------\n-- Note [CorePrep Overview]\n-- ---------------------------------------------------------------------------\n\nThe goal of this pass is to prepare for code generation.\n\n1.  Saturate constructor and primop applications.\n\n2.  Convert to A-normal form; that is, function arguments\n    are always variables.\n\n    * Use case for strict arguments:\n        f E ==> case E of x -> f x\n        (where f is strict)\n\n    * Use let for non-trivial lazy arguments\n        f E ==> let x = E in f x\n        (were f is lazy and x is non-trivial)\n\n3.  Similarly, convert any unboxed lets into cases.\n    [I'm experimenting with leaving 'ok-for-speculation'\n     rhss in let-form right up to this point.]\n\n4.  Ensure that *value* lambdas only occur as the RHS of a binding\n    (The code generator can't deal with anything else.)\n    Type lambdas are ok, however, because the code gen discards them.\n\n5.  [Not any more; nuked Jun 2002] Do the seq/par munging.\n\n6.  Clone all local Ids.\n    This means that all such Ids are unique, rather than the\n    weaker guarantee of no clashes which the simplifier provides.\n    And that is what the code generator needs.\n\n    We don't clone TyVars or CoVars. The code gen doesn't need that,\n    and doing so would be tiresome because then we'd need\n    to substitute in types and coercions.\n\n7.  Give each dynamic CCall occurrence a fresh unique; this is\n    rather like the cloning step above.\n\n8.  Inject bindings for the \"implicit\" Ids:\n        * Constructor wrappers\n        * Constructor workers\n    We want curried definitions for all of these in case they\n    aren't inlined by some caller.\n\n9.  Replace (lazy e) by e.  See Note [lazyId magic] in MkId.hs\n    Also replace (noinline e) by e.\n\n10. Convert (LitInteger i t) into the core representation\n    for the Integer i. Normally this uses mkInteger, but if\n    we are using the integer-gmp implementation then there is a\n    special case where we use the S# constructor for Integers that\n    are in the range of Int.\n\n11. Same for LitNatural.\n\n12. Uphold tick consistency while doing this: We move ticks out of\n    (non-type) applications where we can, and make sure that we\n    annotate according to scoping rules when floating.\n\n13. Collect cost centres (including cost centres in unfoldings) if we're in\n    profiling mode. We have to do this here beucase we won't have unfoldings\n    after this pass (see `zapUnfolding` and Note [Drop unfoldings and rules].\n\nThis is all done modulo type applications and abstractions, so that\nwhen type erasure is done for conversion to STG, we don't end up with\nany trivial or useless bindings.\n\n\nNote [CorePrep invariants]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere is the syntax of the Core produced by CorePrep:\n\n    Trivial expressions\n       arg ::= lit |  var\n              | arg ty  |  /\\a. arg\n              | truv co  |  /\\c. arg  |  arg |> co\n\n    Applications\n       app ::= lit  |  var  |  app arg  |  app ty  | app co | app |> co\n\n    Expressions\n       body ::= app\n              | let(rec) x = rhs in body     -- Boxed only\n              | case body of pat -> body\n              | /\\a. body | /\\c. body\n              | body |> co\n\n    Right hand sides (only place where value lambdas can occur)\n       rhs ::= /\\a.rhs  |  \\x.rhs  |  body\n\nWe define a synonym for each of these non-terminals.  Functions\nwith the corresponding name produce a result in that syntax.\n-}\n\ntype CpeArg  = CoreExpr    -- Non-terminal 'arg'\ntype CpeApp  = CoreExpr    -- Non-terminal 'app'\ntype CpeBody = CoreExpr    -- Non-terminal 'body'\ntype CpeRhs  = CoreExpr    -- Non-terminal 'rhs'\n\n{-\n************************************************************************\n*                                                                      *\n                Top level stuff\n*                                                                      *\n************************************************************************\n-}\n\ncorePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon]\n            -> IO (CoreProgram, S.Set CostCentre)\ncorePrepPgm hsc_env this_mod mod_loc binds data_tycons =\n    withTiming (pure dflags)\n               (text \"CorePrep\"<+>brackets (ppr this_mod))\n               (const ()) $ do\n    us <- mkSplitUniqSupply 's'\n    initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env\n\n    let cost_centres\n          | WayProf `elem` ways dflags\n          = collectCostCentres this_mod binds\n          | otherwise\n          = S.empty\n\n        implicit_binds = mkDataConWorkers dflags mod_loc data_tycons\n            -- NB: we must feed mkImplicitBinds through corePrep too\n            -- so that they are suitably cloned and eta-expanded\n\n        binds_out = initUs_ us $ do\n                      floats1 <- corePrepTopBinds initialCorePrepEnv binds\n                      floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds\n                      return (deFloatTop (floats1 `appendFloats` floats2))\n\n    endPassIO hsc_env alwaysQualify CorePrep binds_out []\n    return (binds_out, cost_centres)\n  where\n    dflags = hsc_dflags hsc_env\n\ncorePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr\ncorePrepExpr dflags hsc_env expr =\n    withTiming (pure dflags) (text \"CorePrep [expr]\") (const ()) $ do\n    us <- mkSplitUniqSupply 's'\n    initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env\n    let new_expr = initUs_ us (cpeBodyNF initialCorePrepEnv expr)\n    dumpIfSet_dyn dflags Opt_D_dump_prep \"CorePrep\" (ppr new_expr)\n    return new_expr\n\ncorePrepTopBinds :: CorePrepEnv -> [CoreBind] -> UniqSM Floats\n-- Note [Floating out of top level bindings]\ncorePrepTopBinds initialCorePrepEnv binds\n  = go initialCorePrepEnv binds\n  where\n    go _   []             = return emptyFloats\n    go env (bind : binds) = do (env', floats, maybe_new_bind)\n                                 <- cpeBind TopLevel env bind\n                               MASSERT(isNothing maybe_new_bind)\n                                 -- Only join points get returned this way by\n                                 -- cpeBind, and no join point may float to top\n                               floatss <- go env' binds\n                               return (floats `appendFloats` floatss)\n\nmkDataConWorkers :: DynFlags -> ModLocation -> [TyCon] -> [CoreBind]\n-- See Note [Data constructor workers]\n-- c.f. Note [Injecting implicit bindings] in TidyPgm\nmkDataConWorkers dflags mod_loc data_tycons\n  = [ NonRec id (tick_it (getName data_con) (Var id))\n                                -- The ice is thin here, but it works\n    | tycon <- data_tycons,     -- CorePrep will eta-expand it\n      data_con <- tyConDataCons tycon,\n      let id = dataConWorkId data_con\n    ]\n where\n   -- If we want to generate debug info, we put a source note on the\n   -- worker. This is useful, especially for heap profiling.\n   tick_it name\n     | debugLevel dflags == 0                = id\n     | RealSrcSpan span <- nameSrcSpan name  = tick span\n     | Just file <- ml_hs_file mod_loc       = tick (span1 file)\n     | otherwise                             = tick (span1 \"???\")\n     where tick span  = Tick (SourceNote span $ showSDoc dflags (ppr name))\n           span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1\n\n{-\nNote [Floating out of top level bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNB: we do need to float out of top-level bindings\nConsider        x = length [True,False]\nWe want to get\n                s1 = False : []\n                s2 = True  : s1\n                x  = length s2\n\nWe return a *list* of bindings, because we may start with\n        x* = f (g y)\nwhere x is demanded, in which case we want to finish with\n        a = g y\n        x* = f a\nAnd then x will actually end up case-bound\n\nNote [CafInfo and floating]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat happens when we try to float bindings to the top level?  At this\npoint all the CafInfo is supposed to be correct, and we must make certain\nthat is true of the new top-level bindings.  There are two cases\nto consider\n\na) The top-level binding is marked asCafRefs.  In that case we are\n   basically fine.  The floated bindings had better all be lazy lets,\n   so they can float to top level, but they'll all have HasCafRefs\n   (the default) which is safe.\n\nb) The top-level binding is marked NoCafRefs.  This really happens\n   Example.  CoreTidy produces\n      $fApplicativeSTM [NoCafRefs] = D:Alternative retry# ...blah...\n   Now CorePrep has to eta-expand to\n      $fApplicativeSTM = let sat = \\xy. retry x y\n                         in D:Alternative sat ...blah...\n   So what we *want* is\n      sat [NoCafRefs] = \\xy. retry x y\n      $fApplicativeSTM [NoCafRefs] = D:Alternative sat ...blah...\n\n   So, gruesomely, we must set the NoCafRefs flag on the sat bindings,\n   *and* substitute the modified 'sat' into the old RHS.\n\n   It should be the case that 'sat' is itself [NoCafRefs] (a value, no\n   cafs) else the original top-level binding would not itself have been\n   marked [NoCafRefs].  The DEBUG check in CoreToStg for\n   consistentCafInfo will find this.\n\nThis is all very gruesome and horrible. It would be better to figure\nout CafInfo later, after CorePrep.  We'll do that in due course.\nMeanwhile this horrible hack works.\n\nNote [Join points and floating]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nJoin points can float out of other join points but not out of value bindings:\n\n  let z =\n    let  w = ... in -- can float\n    join k = ... in -- can't float\n    ... jump k ...\n  join j x1 ... xn =\n    let  y = ... in -- can float (but don't want to)\n    join h = ... in -- can float (but not much point)\n    ... jump h ...\n  in ...\n\nHere, the jump to h remains valid if h is floated outward, but the jump to k\ndoes not.\n\nWe don't float *out* of join points. It would only be safe to float out of\nnullary join points (or ones where the arguments are all either type arguments\nor dead binders). Nullary join points aren't ever recursive, so they're always\neffectively one-shot functions, which we don't float out of. We *could* float\njoin points from nullary join points, but there's no clear benefit at this\nstage.\n\nNote [Data constructor workers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCreate any necessary \"implicit\" bindings for data con workers.  We\ncreate the rather strange (non-recursive!) binding\n\n        $wC = \\x y -> $wC x y\n\ni.e. a curried constructor that allocates.  This means that we can\ntreat the worker for a constructor like any other function in the rest\nof the compiler.  The point here is that CoreToStg will generate a\nStgConApp for the RHS, rather than a call to the worker (which would\ngive a loop).  As Lennart says: the ice is thin here, but it works.\n\nHmm.  Should we create bindings for dictionary constructors?  They are\nalways fully applied, and the bindings are just there to support\npartial applications. But it's easier to let them through.\n\n\nNote [Dead code in CorePrep]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nImagine that we got an input program like this (see Trac #4962):\n\n  f :: Show b => Int -> (Int, b -> Maybe Int -> Int)\n  f x = (g True (Just x) + g () (Just x), g)\n    where\n      g :: Show a => a -> Maybe Int -> Int\n      g _ Nothing = x\n      g y (Just z) = if z > 100 then g y (Just (z + length (show y))) else g y unknown\n\nAfter specialisation and SpecConstr, we would get something like this:\n\n  f :: Show b => Int -> (Int, b -> Maybe Int -> Int)\n  f x = (g$Bool_True_Just x + g$Unit_Unit_Just x, g)\n    where\n      {-# RULES g $dBool = g$Bool\n                g $dUnit = g$Unit #-}\n      g = ...\n      {-# RULES forall x. g$Bool True (Just x) = g$Bool_True_Just x #-}\n      g$Bool = ...\n      {-# RULES forall x. g$Unit () (Just x) = g$Unit_Unit_Just x #-}\n      g$Unit = ...\n      g$Bool_True_Just = ...\n      g$Unit_Unit_Just = ...\n\nNote that the g$Bool and g$Unit functions are actually dead code: they\nare only kept alive by the occurrence analyser because they are\nreferred to by the rules of g, which is being kept alive by the fact\nthat it is used (unspecialised) in the returned pair.\n\nHowever, at the CorePrep stage there is no way that the rules for g\nwill ever fire, and it really seems like a shame to produce an output\nprogram that goes to the trouble of allocating a closure for the\nunreachable g$Bool and g$Unit functions.\n\nThe way we fix this is to:\n * In cloneBndr, drop all unfoldings/rules\n\n * In deFloatTop, run a simple dead code analyser on each top-level\n   RHS to drop the dead local bindings. For that call to OccAnal, we\n   disable the binder swap, else the occurrence analyser sometimes\n   introduces new let bindings for cased binders, which lead to the bug\n   in #5433.\n\nThe reason we don't just OccAnal the whole output of CorePrep is that\nthe tidier ensures that all top-level binders are GlobalIds, so they\ndon't show up in the free variables any longer. So if you run the\noccurrence analyser on the output of CoreTidy (or later) you e.g. turn\nthis program:\n\n  Rec {\n  f = ... f ...\n  }\n\nInto this one:\n\n  f = ... f ...\n\n(Since f is not considered to be free in its own RHS.)\n\n\n************************************************************************\n*                                                                      *\n                The main code\n*                                                                      *\n************************************************************************\n-}\n\ncpeBind :: TopLevelFlag -> CorePrepEnv -> CoreBind\n        -> UniqSM (CorePrepEnv,\n                   Floats,         -- Floating value bindings\n                   Maybe CoreBind) -- Just bind' <=> returned new bind; no float\n                                   -- Nothing <=> added bind' to floats instead\ncpeBind top_lvl env (NonRec bndr rhs)\n  | not (isJoinId bndr)\n  = do { (_, bndr1) <- cpCloneBndr env bndr\n       ; let dmd         = idDemandInfo bndr\n             is_unlifted = isUnliftedType (idType bndr)\n       ; (floats, rhs1) <- cpePair top_lvl NonRecursive\n                                   dmd is_unlifted\n                                   env bndr1 rhs\n       -- See Note [Inlining in CorePrep]\n       ; if exprIsTrivial rhs1 && isNotTopLevel top_lvl\n            then return (extendCorePrepEnvExpr env bndr rhs1, floats, Nothing)\n            else do {\n\n       ; let new_float = mkFloat dmd is_unlifted bndr1 rhs1\n\n       ; return (extendCorePrepEnv env bndr bndr1,\n                 addFloat floats new_float,\n                 Nothing) }}\n\n  | otherwise -- A join point; see Note [Join points and floating]\n  = ASSERT(not (isTopLevel top_lvl)) -- can't have top-level join point\n    do { (_, bndr1) <- cpCloneBndr env bndr\n       ; (bndr2, rhs1) <- cpeJoinPair env bndr1 rhs\n       ; return (extendCorePrepEnv env bndr bndr2,\n                 emptyFloats,\n                 Just (NonRec bndr2 rhs1)) }\n\ncpeBind top_lvl env (Rec pairs)\n  | not (isJoinId (head bndrs))\n  = do { (env', bndrs1) <- cpCloneBndrs env bndrs\n       ; stuff <- zipWithM (cpePair top_lvl Recursive topDmd False env')\n                           bndrs1 rhss\n\n       ; let (floats_s, rhss1) = unzip stuff\n             all_pairs = foldrOL add_float (bndrs1 `zip` rhss1)\n                                           (concatFloats floats_s)\n\n       ; return (extendCorePrepEnvList env (bndrs `zip` bndrs1),\n                 unitFloat (FloatLet (Rec all_pairs)),\n                 Nothing) }\n\n  | otherwise -- See Note [Join points and floating]\n  = do { (env', bndrs1) <- cpCloneBndrs env bndrs\n       ; pairs1 <- zipWithM (cpeJoinPair env') bndrs1 rhss\n\n       ; let bndrs2 = map fst pairs1\n       ; return (extendCorePrepEnvList env' (bndrs `zip` bndrs2),\n                 emptyFloats,\n                 Just (Rec pairs1)) }\n  where\n    (bndrs, rhss) = unzip pairs\n\n        -- Flatten all the floats, and the current\n        -- group into a single giant Rec\n    add_float (FloatLet (NonRec b r)) prs2 = (b,r) : prs2\n    add_float (FloatLet (Rec prs1))   prs2 = prs1 ++ prs2\n    add_float b                       _    = pprPanic \"cpeBind\" (ppr b)\n\n---------------\ncpePair :: TopLevelFlag -> RecFlag -> Demand -> Bool\n        -> CorePrepEnv -> OutId -> CoreExpr\n        -> UniqSM (Floats, CpeRhs)\n-- Used for all bindings\n-- The binder is already cloned, hence an OutId\ncpePair top_lvl is_rec dmd is_unlifted env bndr rhs\n  = ASSERT(not (isJoinId bndr)) -- those should use cpeJoinPair\n    do { (floats1, rhs1) <- cpeRhsE env rhs\n\n       -- See if we are allowed to float this stuff out of the RHS\n       ; (floats2, rhs2) <- float_from_rhs floats1 rhs1\n\n       -- Make the arity match up\n       ; (floats3, rhs3)\n            <- if manifestArity rhs1 <= arity\n               then return (floats2, cpeEtaExpand arity rhs2)\n               else WARN(True, text \"CorePrep: silly extra arguments:\" <+> ppr bndr)\n                               -- Note [Silly extra arguments]\n                    (do { v <- newVar (idType bndr)\n                        ; let float = mkFloat topDmd False v rhs2\n                        ; return ( addFloat floats2 float\n                                 , cpeEtaExpand arity (Var v)) })\n\n        -- Wrap floating ticks\n       ; let (floats4, rhs4) = wrapTicks floats3 rhs3\n\n       ; return (floats4, rhs4) }\n  where\n    platform = targetPlatform (cpe_dynFlags env)\n\n    arity = idArity bndr        -- We must match this arity\n\n    ---------------------\n    float_from_rhs floats rhs\n      | isEmptyFloats floats = return (emptyFloats, rhs)\n      | isTopLevel top_lvl   = float_top    floats rhs\n      | otherwise            = float_nested floats rhs\n\n    ---------------------\n    float_nested floats rhs\n      | wantFloatNested is_rec dmd is_unlifted floats rhs\n                  = return (floats, rhs)\n      | otherwise = dontFloat floats rhs\n\n    ---------------------\n    float_top floats rhs        -- Urhgh!  See Note [CafInfo and floating]\n      | mayHaveCafRefs (idCafInfo bndr)\n      , allLazyTop floats\n      = return (floats, rhs)\n\n      -- So the top-level binding is marked NoCafRefs\n      | Just (floats', rhs') <- canFloatFromNoCaf platform floats rhs\n      = return (floats', rhs')\n\n      | otherwise\n      = dontFloat floats rhs\n\ndontFloat :: Floats -> CpeRhs -> UniqSM (Floats, CpeBody)\n-- Non-empty floats, but do not want to float from rhs\n-- So wrap the rhs in the floats\n-- But: rhs1 might have lambdas, and we can't\n--      put them inside a wrapBinds\ndontFloat floats1 rhs\n  = do { (floats2, body) <- rhsToBody rhs\n        ; return (emptyFloats, wrapBinds floats1 $\n                               wrapBinds floats2 body) }\n\n{- Note [Silly extra arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we had this\n        f{arity=1} = \\x\\y. e\nWe *must* match the arity on the Id, so we have to generate\n        f' = \\x\\y. e\n        f  = \\x. f' x\n\nIt's a bizarre case: why is the arity on the Id wrong?  Reason\n(in the days of __inline_me__):\n        f{arity=0} = __inline_me__ (let v = expensive in \\xy. e)\nWhen InlineMe notes go away this won't happen any more.  But\nit seems good for CorePrep to be robust.\n-}\n\n---------------\ncpeJoinPair :: CorePrepEnv -> JoinId -> CoreExpr\n            -> UniqSM (JoinId, CpeRhs)\n-- Used for all join bindings\ncpeJoinPair env bndr rhs\n  = ASSERT(isJoinId bndr)\n    do { let Just join_arity = isJoinId_maybe bndr\n             (bndrs, body)   = collectNBinders join_arity rhs\n\n       ; (env', bndrs') <- cpCloneBndrs env bndrs\n\n       ; body' <- cpeBodyNF env' body -- Will let-bind the body if it starts\n                                      -- with a lambda\n\n       ; let rhs'  = mkCoreLams bndrs' body'\n             bndr' = bndr `setIdUnfolding` evaldUnfolding\n                          `setIdArity` count isId bndrs\n                            -- See Note [Arity and join points]\n\n       ; return (bndr', rhs') }\n\n{-\nNote [Arity and join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nUp to now, we've allowed a join point to have an arity greater than its join\narity (minus type arguments), since this is what's useful for eta expansion.\nHowever, for code gen purposes, its arity must be exactly the number of value\narguments it will be called with, and it must have exactly that many value\nlambdas. Hence if there are extra lambdas we must let-bind the body of the RHS:\n\n  join j x y z = \\w -> ... in ...\n    =>\n  join j x y z = (let f = \\w -> ... in f) in ...\n\nThis is also what happens with Note [Silly extra arguments]. Note that it's okay\nfor us to mess with the arity because a join point is never exported.\n-}\n\n-- ---------------------------------------------------------------------------\n--              CpeRhs: produces a result satisfying CpeRhs\n-- ---------------------------------------------------------------------------\n\ncpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)\n-- If\n--      e  ===>  (bs, e')\n-- then\n--      e = let bs in e'        (semantically, that is!)\n--\n-- For example\n--      f (g x)   ===>   ([v = g x], f v)\n\ncpeRhsE _env expr@(Type {})      = return (emptyFloats, expr)\ncpeRhsE _env expr@(Coercion {})  = return (emptyFloats, expr)\ncpeRhsE env (Lit (LitNumber LitNumInteger i _))\n    = cpeRhsE env (cvtLitInteger (cpe_dynFlags env) (getMkIntegerId env)\n                   (cpe_integerSDataCon env) i)\ncpeRhsE env (Lit (LitNumber LitNumNatural i _))\n    = cpeRhsE env (cvtLitNatural (cpe_dynFlags env) (getMkNaturalId env)\n                   (cpe_naturalSDataCon env) i)\ncpeRhsE _env expr@(Lit {}) = return (emptyFloats, expr)\ncpeRhsE env expr@(Var {})  = cpeApp env expr\ncpeRhsE env expr@(App {}) = cpeApp env expr\n\ncpeRhsE env (Let bind body)\n  = do { (env', bind_floats, maybe_bind') <- cpeBind NotTopLevel env bind\n       ; (body_floats, body') <- cpeRhsE env' body\n       ; let expr' = case maybe_bind' of Just bind' -> Let bind' body'\n                                         Nothing    -> body'\n       ; return (bind_floats `appendFloats` body_floats, expr') }\n\ncpeRhsE env (Tick tickish expr)\n  | tickishPlace tickish == PlaceNonLam && tickish `tickishScopesLike` SoftScope\n  = do { (floats, body) <- cpeRhsE env expr\n         -- See [Floating Ticks in CorePrep]\n       ; return (unitFloat (FloatTick tickish) `appendFloats` floats, body) }\n  | otherwise\n  = do { body <- cpeBodyNF env expr\n       ; return (emptyFloats, mkTick tickish' body) }\n  where\n    tickish' | Breakpoint n fvs <- tickish\n             -- See also 'substTickish'\n             = Breakpoint n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs)\n             | otherwise\n             = tickish\n\ncpeRhsE env (Cast expr co)\n   = do { (floats, expr') <- cpeRhsE env expr\n        ; return (floats, Cast expr' co) }\n\ncpeRhsE env expr@(Lam {})\n   = do { let (bndrs,body) = collectBinders expr\n        ; (env', bndrs') <- cpCloneBndrs env bndrs\n        ; body' <- cpeBodyNF env' body\n        ; return (emptyFloats, mkLams bndrs' body') }\n\ncpeRhsE env (Case scrut bndr ty alts)\n  = do { (floats, scrut') <- cpeBody env scrut\n       ; (env', bndr2) <- cpCloneBndr env bndr\n       ; let alts'\n                 -- This flag is intended to aid in debugging strictness\n                 -- analysis bugs. These are particularly nasty to chase down as\n                 -- they may manifest as segmentation faults. When this flag is\n                 -- enabled we instead produce an 'error' expression to catch\n                 -- the case where a function we think should bottom\n                 -- unexpectedly returns.\n               | gopt Opt_CatchBottoms (cpe_dynFlags env)\n               , not (altsAreExhaustive alts)\n               = addDefault alts (Just err)\n               | otherwise = alts\n               where err = mkRuntimeErrorApp rUNTIME_ERROR_ID ty\n                                             \"Bottoming expression returned\"\n       ; alts'' <- mapM (sat_alt env') alts'\n       ; return (floats, Case scrut' bndr2 ty alts'') }\n  where\n    sat_alt env (con, bs, rhs)\n       = do { (env2, bs') <- cpCloneBndrs env bs\n            ; rhs' <- cpeBodyNF env2 rhs\n            ; return (con, bs', rhs') }\n\ncvtLitInteger :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr\n-- Here we convert a literal Integer to the low-level\n-- representation. Exactly how we do this depends on the\n-- library that implements Integer.  If it's GMP we\n-- use the S# data constructor for small literals.\n-- See Note [Integer literals] in Literal\ncvtLitInteger dflags _ (Just sdatacon) i\n  | inIntRange dflags i -- Special case for small integers\n    = mkConApp sdatacon [Lit (mkLitInt dflags i)]\n\ncvtLitInteger dflags mk_integer _ i\n    = mkApps (Var mk_integer) [isNonNegative, ints]\n  where isNonNegative = if i < 0 then mkConApp falseDataCon []\n                                 else mkConApp trueDataCon  []\n        ints = mkListExpr intTy (f (abs i))\n        f 0 = []\n        f x = let low  = x .&. mask\n                  high = x `shiftR` bits\n              in mkConApp intDataCon [Lit (mkLitInt dflags low)] : f high\n        bits = 31\n        mask = 2 ^ bits - 1\n\ncvtLitNatural :: DynFlags -> Id -> Maybe DataCon -> Integer -> CoreExpr\n-- Here we convert a literal Natural to the low-level\n-- representation.\n-- See Note [Natural literals] in Literal\ncvtLitNatural dflags _ (Just sdatacon) i\n  | inWordRange dflags i -- Special case for small naturals\n    = mkConApp sdatacon [Lit (mkLitWord dflags i)]\n\ncvtLitNatural dflags mk_natural _ i\n    = mkApps (Var mk_natural) [words]\n  where words = mkListExpr wordTy (f i)\n        f 0 = []\n        f x = let low  = x .&. mask\n                  high = x `shiftR` bits\n              in mkConApp wordDataCon [Lit (mkLitWord dflags low)] : f high\n        bits = 32\n        mask = 2 ^ bits - 1\n\n-- ---------------------------------------------------------------------------\n--              CpeBody: produces a result satisfying CpeBody\n-- ---------------------------------------------------------------------------\n\n-- | Convert a 'CoreExpr' so it satisfies 'CpeBody', without\n-- producing any floats (any generated floats are immediately\n-- let-bound using 'wrapBinds').  Generally you want this, esp.\n-- when you've reached a binding form (e.g., a lambda) and\n-- floating any further would be incorrect.\ncpeBodyNF :: CorePrepEnv -> CoreExpr -> UniqSM CpeBody\ncpeBodyNF env expr\n  = do { (floats, body) <- cpeBody env expr\n       ; return (wrapBinds floats body) }\n\n-- | Convert a 'CoreExpr' so it satisfies 'CpeBody'; also produce\n-- a list of 'Floats' which are being propagated upwards.  In\n-- fact, this function is used in only two cases: to\n-- implement 'cpeBodyNF' (which is what you usually want),\n-- and in the case when a let-binding is in a case scrutinee--here,\n-- we can always float out:\n--\n--      case (let x = y in z) of ...\n--      ==> let x = y in case z of ...\n--\ncpeBody :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeBody)\ncpeBody env expr\n  = do { (floats1, rhs) <- cpeRhsE env expr\n       ; (floats2, body) <- rhsToBody rhs\n       ; return (floats1 `appendFloats` floats2, body) }\n\n--------\nrhsToBody :: CpeRhs -> UniqSM (Floats, CpeBody)\n-- Remove top level lambdas by let-binding\n\nrhsToBody (Tick t expr)\n  | tickishScoped t == NoScope  -- only float out of non-scoped annotations\n  = do { (floats, expr') <- rhsToBody expr\n       ; return (floats, mkTick t expr') }\n\nrhsToBody (Cast e co)\n        -- You can get things like\n        --      case e of { p -> coerce t (\\s -> ...) }\n  = do { (floats, e') <- rhsToBody e\n       ; return (floats, Cast e' co) }\n\nrhsToBody expr@(Lam {})\n  | Just no_lam_result <- tryEtaReducePrep bndrs body\n  = return (emptyFloats, no_lam_result)\n  | all isTyVar bndrs           -- Type lambdas are ok\n  = return (emptyFloats, expr)\n  | otherwise                   -- Some value lambdas\n  = do { fn <- newVar (exprType expr)\n       ; let rhs   = cpeEtaExpand (exprArity expr) expr\n             float = FloatLet (NonRec fn rhs)\n       ; return (unitFloat float, Var fn) }\n  where\n    (bndrs,body) = collectBinders expr\n\nrhsToBody expr = return (emptyFloats, expr)\n\n\n\n-- ---------------------------------------------------------------------------\n--              CpeApp: produces a result satisfying CpeApp\n-- ---------------------------------------------------------------------------\n\ndata ArgInfo = CpeApp  CoreArg\n             | CpeCast Coercion\n             | CpeTick (Tickish Id)\n\n{- Note [runRW arg]\n~~~~~~~~~~~~~~~~~~~\nIf we got, say\n   runRW# (case bot of {})\nwhich happened in Trac #11291, we do /not/ want to turn it into\n   (case bot of {}) realWorldPrimId#\nbecause that gives a panic in CoreToStg.myCollectArgs, which expects\nonly variables in function position.  But if we are sure to make\nrunRW# strict (which we do in MkId), this can't happen\n-}\n\ncpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)\n-- May return a CpeRhs because of saturating primops\ncpeApp top_env expr\n  = do { let (terminal, args, depth) = collect_args expr\n       ; cpe_app top_env terminal args depth\n       }\n\n  where\n    -- We have a nested data structure of the form\n    -- e `App` a1 `App` a2 ... `App` an, convert it into\n    -- (e, [CpeApp a1, CpeApp a2, ..., CpeApp an], depth)\n    -- We use 'ArgInfo' because we may also need to\n    -- record casts and ticks.  Depth counts the number\n    -- of arguments that would consume strictness information\n    -- (so, no type or coercion arguments.)\n    collect_args :: CoreExpr -> (CoreExpr, [ArgInfo], Int)\n    collect_args e = go e [] 0\n      where\n        go (App fun arg)      as !depth\n            = go fun (CpeApp arg : as)\n                (if isTyCoArg arg then depth else depth + 1)\n        go (Cast fun co)      as depth\n            = go fun (CpeCast co : as) depth\n        go (Tick tickish fun) as depth\n            | tickishPlace tickish == PlaceNonLam\n            && tickish `tickishScopesLike` SoftScope\n            = go fun (CpeTick tickish : as) depth\n        go terminal as depth = (terminal, as, depth)\n\n    cpe_app :: CorePrepEnv\n            -> CoreExpr\n            -> [ArgInfo]\n            -> Int\n            -> UniqSM (Floats, CpeRhs)\n    cpe_app env (Var f) (CpeApp Type{} : CpeApp arg : args) depth\n        | f `hasKey` lazyIdKey          -- Replace (lazy a) with a, and\n       || f `hasKey` noinlineIdKey      -- Replace (noinline a) with a\n        -- Consider the code:\n        --\n        --      lazy (f x) y\n        --\n        -- We need to make sure that we need to recursively collect arguments on\n        -- \"f x\", otherwise we'll float \"f x\" out (it's not a variable) and\n        -- end up with this awful -ddump-prep:\n        --\n        --      case f x of f_x {\n        --        __DEFAULT -> f_x y\n        --      }\n        --\n        -- rather than the far superior \"f x y\".  Test case is par01.\n        = let (terminal, args', depth') = collect_args arg\n          in cpe_app env terminal (args' ++ args) (depth + depth' - 1)\n    cpe_app env (Var f) [CpeApp _runtimeRep@Type{}, CpeApp _type@Type{}, CpeApp arg] 1\n        | f `hasKey` runRWKey\n        -- See Note [runRW magic]\n        -- Replace (runRW# f) by (f realWorld#), beta reducing if possible (this\n        -- is why we return a CorePrepEnv as well)\n        = case arg of\n            Lam s body -> cpe_app (extendCorePrepEnv env s realWorldPrimId) body [] 0\n            _          -> cpe_app env arg [CpeApp (Var realWorldPrimId)] 1\n    cpe_app env (Var v) args depth\n      = do { v1 <- fiddleCCall v\n           ; let e2 = lookupCorePrepEnv env v1\n                 hd = getIdFromTrivialExpr_maybe e2\n           -- NB: depth from collect_args is right, because e2 is a trivial expression\n           -- and thus its embedded Id *must* be at the same depth as any\n           -- Apps it is under are type applications only (c.f.\n           -- exprIsTrivial).  But note that we need the type of the\n           -- expression, not the id.\n           ; (app, floats) <- rebuild_app args e2 (exprType e2) emptyFloats stricts\n           ; mb_saturate hd app floats depth }\n        where\n          stricts = case idStrictness v of\n                            StrictSig (DmdType _ demands _)\n                              | listLengthCmp demands depth /= GT -> demands\n                                    -- length demands <= depth\n                              | otherwise                         -> []\n                -- If depth < length demands, then we have too few args to\n                -- satisfy strictness  info so we have to  ignore all the\n                -- strictness info, e.g. + (error \"urk\")\n                -- Here, we can't evaluate the arg strictly, because this\n                -- partial application might be seq'd\n\n        -- We inlined into something that's not a var and has no args.\n        -- Bounce it back up to cpeRhsE.\n    cpe_app env fun [] _ = cpeRhsE env fun\n\n        -- N-variable fun, better let-bind it\n    cpe_app env fun args depth\n      = do { (fun_floats, fun') <- cpeArg env evalDmd fun ty\n                          -- The evalDmd says that it's sure to be evaluated,\n                          -- so we'll end up case-binding it\n           ; (app, floats) <- rebuild_app args fun' ty fun_floats []\n           ; mb_saturate Nothing app floats depth }\n        where\n          ty = exprType fun\n\n    -- Saturate if necessary\n    mb_saturate head app floats depth =\n       case head of\n         Just fn_id -> do { sat_app <- maybeSaturate fn_id app depth\n                          ; return (floats, sat_app) }\n         _other              -> return (floats, app)\n\n    -- Deconstruct and rebuild the application, floating any non-atomic\n    -- arguments to the outside.  We collect the type of the expression,\n    -- the head of the application, and the number of actual value arguments,\n    -- all of which are used to possibly saturate this application if it\n    -- has a constructor or primop at the head.\n    rebuild_app\n        :: [ArgInfo]                  -- The arguments (inner to outer)\n        -> CpeApp\n        -> Type\n        -> Floats\n        -> [Demand]\n        -> UniqSM (CpeApp, Floats)\n    rebuild_app [] app _ floats ss = do\n      MASSERT(null ss) -- make sure we used all the strictness info\n      return (app, floats)\n    rebuild_app (a : as) fun' fun_ty floats ss = case a of\n      CpeApp arg@(Type arg_ty) ->\n        rebuild_app as (App fun' arg) (piResultTy fun_ty arg_ty) floats ss\n      CpeApp arg@(Coercion {}) ->\n        rebuild_app as (App fun' arg) (funResultTy fun_ty) floats ss\n      CpeApp arg -> do\n        let (ss1, ss_rest)  -- See Note [lazyId magic] in MkId\n               = case (ss, isLazyExpr arg) of\n                   (_   : ss_rest, True)  -> (topDmd, ss_rest)\n                   (ss1 : ss_rest, False) -> (ss1,    ss_rest)\n                   ([],            _)     -> (topDmd, [])\n            (arg_ty, res_ty) = expectJust \"cpeBody:collect_args\" $\n                               splitFunTy_maybe fun_ty\n        (fs, arg') <- cpeArg top_env ss1 arg arg_ty\n        rebuild_app as (App fun' arg') res_ty (fs `appendFloats` floats) ss_rest\n      CpeCast co ->\n        let Pair _ty1 ty2 = coercionKind co\n        in rebuild_app as (Cast fun' co) ty2 floats ss\n      CpeTick tickish ->\n        -- See [Floating Ticks in CorePrep]\n        rebuild_app as fun' fun_ty (addFloat floats (FloatTick tickish)) ss\n\nisLazyExpr :: CoreExpr -> Bool\n-- See Note [lazyId magic] in MkId\nisLazyExpr (Cast e _)              = isLazyExpr e\nisLazyExpr (Tick _ e)              = isLazyExpr e\nisLazyExpr (Var f `App` _ `App` _) = f `hasKey` lazyIdKey\nisLazyExpr _                       = False\n\n{- Note [runRW magic]\n~~~~~~~~~~~~~~~~~~~~~\nSome definitions, for instance @runST@, must have careful control over float out\nof the bindings in their body. Consider this use of @runST@,\n\n    f x = runST ( \\ s -> let (a, s')  = newArray# 100 [] s\n                             (_, s'') = fill_in_array_or_something a x s'\n                         in freezeArray# a s'' )\n\nIf we inline @runST@, we'll get:\n\n    f x = let (a, s')  = newArray# 100 [] realWorld#{-NB-}\n              (_, s'') = fill_in_array_or_something a x s'\n          in freezeArray# a s''\n\nAnd now if we allow the @newArray#@ binding to float out to become a CAF,\nwe end up with a result that is totally and utterly wrong:\n\n    f = let (a, s')  = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!\n        in \\ x ->\n            let (_, s'') = fill_in_array_or_something a x s'\n            in freezeArray# a s''\n\nAll calls to @f@ will share a {\\em single} array! Clearly this is nonsense and\nmust be prevented.\n\nThis is what @runRW#@ gives us: by being inlined extremely late in the\noptimization (right before lowering to STG, in CorePrep), we can ensure that\nno further floating will occur. This allows us to safely inline things like\n@runST@, which are otherwise needlessly expensive (see #10678 and #5916).\n\n'runRW' is defined (for historical reasons) in GHC.Magic, with a NOINLINE\npragma.  It is levity-polymorphic.\n\n    runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r)\n           => (State# RealWorld -> (# State# RealWorld, o #))\n                              -> (# State# RealWorld, o #)\n\nIt needs no special treatment in GHC except this special inlining here\nin CorePrep (and in ByteCodeGen).\n\n-- ---------------------------------------------------------------------------\n--      CpeArg: produces a result satisfying CpeArg\n-- ---------------------------------------------------------------------------\n\nNote [ANF-ising literal string arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nConsider a program like,\n\n    data Foo = Foo Addr#\n\n    foo = Foo \"turtle\"#\n\nWhen we go to ANFise this we might think that we want to float the string\nliteral like we do any other non-trivial argument. This would look like,\n\n    foo = u\\ [] case \"turtle\"# of s { __DEFAULT__ -> Foo s }\n\nHowever, this 1) isn't necessary since strings are in a sense \"trivial\"; and 2)\nwreaks havoc on the CAF annotations that we produce here since we the result\nabove is caffy since it is updateable. Ideally at some point in the future we\nwould like to just float the literal to the top level as suggested in #11312,\n\n    s = \"turtle\"#\n    foo = Foo s\n\nHowever, until then we simply add a special case excluding literals from the\nfloating done by cpeArg.\n-}\n\n-- | Is an argument okay to CPE?\nokCpeArg :: CoreExpr -> Bool\n-- Don't float literals. See Note [ANF-ising literal string arguments].\nokCpeArg (Lit _) = False\n-- Do not eta expand a trivial argument\nokCpeArg expr    = not (exprIsTrivial expr)\n\n-- This is where we arrange that a non-trivial argument is let-bound\ncpeArg :: CorePrepEnv -> Demand\n       -> CoreArg -> Type -> UniqSM (Floats, CpeArg)\ncpeArg env dmd arg arg_ty\n  = do { (floats1, arg1) <- cpeRhsE env arg     -- arg1 can be a lambda\n       ; (floats2, arg2) <- if want_float floats1 arg1\n                            then return (floats1, arg1)\n                            else dontFloat floats1 arg1\n                -- Else case: arg1 might have lambdas, and we can't\n                --            put them inside a wrapBinds\n\n       ; if okCpeArg arg2\n         then do { v <- newVar arg_ty\n                 ; let arg3      = cpeEtaExpand (exprArity arg2) arg2\n                       arg_float = mkFloat dmd is_unlifted v arg3\n                 ; return (addFloat floats2 arg_float, varToCoreExpr v) }\n         else return (floats2, arg2)\n       }\n  where\n    is_unlifted = isUnliftedType arg_ty\n    want_float  = wantFloatNested NonRecursive dmd is_unlifted\n\n{-\nNote [Floating unlifted arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider    C (let v* = expensive in v)\n\nwhere the \"*\" indicates \"will be demanded\".  Usually v will have been\ninlined by now, but let's suppose it hasn't (see Trac #2756).  Then we\ndo *not* want to get\n\n     let v* = expensive in C v\n\nbecause that has different strictness.  Hence the use of 'allLazy'.\n(NB: the let v* turns into a FloatCase, in mkLocalNonRec.)\n\n\n------------------------------------------------------------------------------\n-- Building the saturated syntax\n-- ---------------------------------------------------------------------------\n\nmaybeSaturate deals with saturating primops and constructors\nThe type is the type of the entire application\n-}\n\nmaybeSaturate :: Id -> CpeApp -> Int -> UniqSM CpeRhs\nmaybeSaturate fn expr n_args\n  | hasNoBinding fn        -- There's no binding\n  = return sat_expr\n\n  | otherwise\n  = return expr\n  where\n    fn_arity     = idArity fn\n    excess_arity = fn_arity - n_args\n    sat_expr     = cpeEtaExpand excess_arity expr\n\n{-\n************************************************************************\n*                                                                      *\n                Simple CoreSyn operations\n*                                                                      *\n************************************************************************\n-}\n\n{-\n-- -----------------------------------------------------------------------------\n--      Eta reduction\n-- -----------------------------------------------------------------------------\n\nNote [Eta expansion]\n~~~~~~~~~~~~~~~~~~~~~\nEta expand to match the arity claimed by the binder Remember,\nCorePrep must not change arity\n\nEta expansion might not have happened already, because it is done by\nthe simplifier only when there at least one lambda already.\n\nNB1:we could refrain when the RHS is trivial (which can happen\n    for exported things).  This would reduce the amount of code\n    generated (a little) and make things a little words for\n    code compiled without -O.  The case in point is data constructor\n    wrappers.\n\nNB2: we have to be careful that the result of etaExpand doesn't\n   invalidate any of the assumptions that CorePrep is attempting\n   to establish.  One possible cause is eta expanding inside of\n   an SCC note - we're now careful in etaExpand to make sure the\n   SCC is pushed inside any new lambdas that are generated.\n\nNote [Eta expansion and the CorePrep invariants]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt turns out to be much much easier to do eta expansion\n*after* the main CorePrep stuff.  But that places constraints\non the eta expander: given a CpeRhs, it must return a CpeRhs.\n\nFor example here is what we do not want:\n                f = /\\a -> g (h 3)      -- h has arity 2\nAfter ANFing we get\n                f = /\\a -> let s = h 3 in g s\nand now we do NOT want eta expansion to give\n                f = /\\a -> \\ y -> (let s = h 3 in g s) y\n\nInstead CoreArity.etaExpand gives\n                f = /\\a -> \\y -> let s = h 3 in g s y\n-}\n\ncpeEtaExpand :: Arity -> CpeRhs -> CpeRhs\ncpeEtaExpand arity expr\n  | arity == 0 = expr\n  | otherwise  = etaExpand arity expr\n\n{-\n-- -----------------------------------------------------------------------------\n--      Eta reduction\n-- -----------------------------------------------------------------------------\n\nWhy try eta reduction?  Hasn't the simplifier already done eta?\nBut the simplifier only eta reduces if that leaves something\ntrivial (like f, or f Int).  But for deLam it would be enough to\nget to a partial application:\n        case x of { p -> \\xs. map f xs }\n    ==> case x of { p -> map f }\n-}\n\ntryEtaReducePrep :: [CoreBndr] -> CoreExpr -> Maybe CoreExpr\ntryEtaReducePrep bndrs expr@(App _ _)\n  | ok_to_eta_reduce f\n  , n_remaining >= 0\n  , and (zipWith ok bndrs last_args)\n  , not (any (`elemVarSet` fvs_remaining) bndrs)\n  , exprIsHNF remaining_expr   -- Don't turn value into a non-value\n                               -- else the behaviour with 'seq' changes\n  = Just remaining_expr\n  where\n    (f, args) = collectArgs expr\n    remaining_expr = mkApps f remaining_args\n    fvs_remaining = exprFreeVars remaining_expr\n    (remaining_args, last_args) = splitAt n_remaining args\n    n_remaining = length args - length bndrs\n\n    ok bndr (Var arg) = bndr == arg\n    ok _    _         = False\n\n          -- We can't eta reduce something which must be saturated.\n    ok_to_eta_reduce (Var f) = not (hasNoBinding f)\n    ok_to_eta_reduce _       = False -- Safe. ToDo: generalise\n\ntryEtaReducePrep bndrs (Let bind@(NonRec _ r) body)\n  | not (any (`elemVarSet` fvs) bndrs)\n  = case tryEtaReducePrep bndrs body of\n        Just e -> Just (Let bind e)\n        Nothing -> Nothing\n  where\n    fvs = exprFreeVars r\n\n-- NB: do not attempt to eta-reduce across ticks\n-- Otherwise we risk reducing\n--       \\x. (Tick (Breakpoint {x}) f x)\n--   ==> Tick (breakpoint {x}) f\n-- which is bogus (Trac #17228)\n-- tryEtaReducePrep bndrs (Tick tickish e)\n--   = fmap (mkTick tickish) $ tryEtaReducePrep bndrs e\n\ntryEtaReducePrep _ _ = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n                Floats\n*                                                                      *\n************************************************************************\n\nNote [Pin demand info on floats]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe pin demand info on floated lets, so that we can see the one-shot thunks.\n-}\n\ndata FloatingBind\n  = FloatLet CoreBind    -- Rhs of bindings are CpeRhss\n                         -- They are always of lifted type;\n                         -- unlifted ones are done with FloatCase\n\n | FloatCase\n      Id CpeBody\n      Bool              -- The bool indicates \"ok-for-speculation\"\n\n -- | See Note [Floating Ticks in CorePrep]\n | FloatTick (Tickish Id)\n\ndata Floats = Floats OkToSpec (OrdList FloatingBind)\n\ninstance Outputable FloatingBind where\n  ppr (FloatLet b) = ppr b\n  ppr (FloatCase b r ok) = brackets (ppr ok) <+> ppr b <+> equals <+> ppr r\n  ppr (FloatTick t) = ppr t\n\ninstance Outputable Floats where\n  ppr (Floats flag fs) = text \"Floats\" <> brackets (ppr flag) <+>\n                         braces (vcat (map ppr (fromOL fs)))\n\ninstance Outputable OkToSpec where\n  ppr OkToSpec    = text \"OkToSpec\"\n  ppr IfUnboxedOk = text \"IfUnboxedOk\"\n  ppr NotOkToSpec = text \"NotOkToSpec\"\n\n-- Can we float these binds out of the rhs of a let?  We cache this decision\n-- to avoid having to recompute it in a non-linear way when there are\n-- deeply nested lets.\ndata OkToSpec\n   = OkToSpec           -- Lazy bindings of lifted type\n   | IfUnboxedOk        -- A mixture of lazy lifted bindings and n\n                        -- ok-to-speculate unlifted bindings\n   | NotOkToSpec        -- Some not-ok-to-speculate unlifted bindings\n\nmkFloat :: Demand -> Bool -> Id -> CpeRhs -> FloatingBind\nmkFloat dmd is_unlifted bndr rhs\n  | use_case  = FloatCase bndr rhs (exprOkForSpeculation rhs)\n  | is_hnf    = FloatLet (NonRec bndr                       rhs)\n  | otherwise = FloatLet (NonRec (setIdDemandInfo bndr dmd) rhs)\n                   -- See Note [Pin demand info on floats]\n  where\n    is_hnf    = exprIsHNF rhs\n    is_strict = isStrictDmd dmd\n    use_case  = is_unlifted || is_strict && not is_hnf\n                -- Don't make a case for a value binding,\n                -- even if it's strict.  Otherwise we get\n                --      case (\\x -> e) of ...!\n\nemptyFloats :: Floats\nemptyFloats = Floats OkToSpec nilOL\n\nisEmptyFloats :: Floats -> Bool\nisEmptyFloats (Floats _ bs) = isNilOL bs\n\nwrapBinds :: Floats -> CpeBody -> CpeBody\nwrapBinds (Floats _ binds) body\n  = foldrOL mk_bind body binds\n  where\n    mk_bind (FloatCase bndr rhs _) body = Case rhs bndr (exprType body) [(DEFAULT, [], body)]\n    mk_bind (FloatLet bind)        body = Let bind body\n    mk_bind (FloatTick tickish)    body = mkTick tickish body\n\naddFloat :: Floats -> FloatingBind -> Floats\naddFloat (Floats ok_to_spec floats) new_float\n  = Floats (combine ok_to_spec (check new_float)) (floats `snocOL` new_float)\n  where\n    check (FloatLet _) = OkToSpec\n    check (FloatCase _ _ ok_for_spec)\n        | ok_for_spec  =  IfUnboxedOk\n        | otherwise    =  NotOkToSpec\n    check FloatTick{}  = OkToSpec\n        -- The ok-for-speculation flag says that it's safe to\n        -- float this Case out of a let, and thereby do it more eagerly\n        -- We need the top-level flag because it's never ok to float\n        -- an unboxed binding to the top level\n\nunitFloat :: FloatingBind -> Floats\nunitFloat = addFloat emptyFloats\n\nappendFloats :: Floats -> Floats -> Floats\nappendFloats (Floats spec1 floats1) (Floats spec2 floats2)\n  = Floats (combine spec1 spec2) (floats1 `appOL` floats2)\n\nconcatFloats :: [Floats] -> OrdList FloatingBind\nconcatFloats = foldr (\\ (Floats _ bs1) bs2 -> appOL bs1 bs2) nilOL\n\ncombine :: OkToSpec -> OkToSpec -> OkToSpec\ncombine NotOkToSpec _ = NotOkToSpec\ncombine _ NotOkToSpec = NotOkToSpec\ncombine IfUnboxedOk _ = IfUnboxedOk\ncombine _ IfUnboxedOk = IfUnboxedOk\ncombine _ _           = OkToSpec\n\ndeFloatTop :: Floats -> [CoreBind]\n-- For top level only; we don't expect any FloatCases\ndeFloatTop (Floats _ floats)\n  = foldrOL get [] floats\n  where\n    get (FloatLet b) bs = occurAnalyseRHSs b : bs\n    get (FloatCase var body _) bs  =\n      occurAnalyseRHSs (NonRec var body) : bs\n    get b _ = pprPanic \"corePrepPgm\" (ppr b)\n\n    -- See Note [Dead code in CorePrep]\n    occurAnalyseRHSs (NonRec x e) = NonRec x (occurAnalyseExpr_NoBinderSwap e)\n    occurAnalyseRHSs (Rec xes)    = Rec [(x, occurAnalyseExpr_NoBinderSwap e) | (x, e) <- xes]\n\n---------------------------------------------------------------------------\n\ncanFloatFromNoCaf :: Platform -> Floats -> CpeRhs -> Maybe (Floats, CpeRhs)\n       -- Note [CafInfo and floating]\ncanFloatFromNoCaf platform (Floats ok_to_spec fs) rhs\n  | OkToSpec <- ok_to_spec           -- Worth trying\n  , Just (subst, fs') <- go (emptySubst, nilOL) (fromOL fs)\n  = Just (Floats OkToSpec fs', subst_expr subst rhs)\n  | otherwise\n  = Nothing\n  where\n    subst_expr = substExpr (text \"CorePrep\")\n\n    go :: (Subst, OrdList FloatingBind) -> [FloatingBind]\n       -> Maybe (Subst, OrdList FloatingBind)\n\n    go (subst, fbs_out) [] = Just (subst, fbs_out)\n\n    go (subst, fbs_out) (FloatLet (NonRec b r) : fbs_in)\n      | rhs_ok r\n      = go (subst', fbs_out `snocOL` new_fb) fbs_in\n      where\n        (subst', b') = set_nocaf_bndr subst b\n        new_fb = FloatLet (NonRec b' (subst_expr subst r))\n\n    go (subst, fbs_out) (FloatLet (Rec prs) : fbs_in)\n      | all rhs_ok rs\n      = go (subst', fbs_out `snocOL` new_fb) fbs_in\n      where\n        (bs,rs) = unzip prs\n        (subst', bs') = mapAccumL set_nocaf_bndr subst bs\n        rs' = map (subst_expr subst') rs\n        new_fb = FloatLet (Rec (bs' `zip` rs'))\n\n    go (subst, fbs_out) (ft@FloatTick{} : fbs_in)\n      = go (subst, fbs_out `snocOL` ft) fbs_in\n\n    go _ _ = Nothing      -- Encountered a caffy binding\n\n    ------------\n    set_nocaf_bndr subst bndr\n      = (extendIdSubst subst bndr (Var bndr'), bndr')\n      where\n        bndr' = bndr `setIdCafInfo` NoCafRefs\n\n    ------------\n    rhs_ok :: CoreExpr -> Bool\n    -- We can only float to top level from a NoCaf thing if\n    -- the new binding is static. However it can't mention\n    -- any non-static things or it would *already* be Caffy\n    rhs_ok = rhsIsStatic platform (\\_ -> False)\n                         (\\_nt i -> pprPanic \"rhsIsStatic\" (integer i))\n                         -- Integer or Natural literals should not show up\n\nwantFloatNested :: RecFlag -> Demand -> Bool -> Floats -> CpeRhs -> Bool\nwantFloatNested is_rec dmd is_unlifted floats rhs\n  =  isEmptyFloats floats\n  || isStrictDmd dmd\n  || is_unlifted\n  || (allLazyNested is_rec floats && exprIsHNF rhs)\n        -- Why the test for allLazyNested?\n        --      v = f (x `divInt#` y)\n        -- we don't want to float the case, even if f has arity 2,\n        -- because floating the case would make it evaluated too early\n\nallLazyTop :: Floats -> Bool\nallLazyTop (Floats OkToSpec _) = True\nallLazyTop _                   = False\n\nallLazyNested :: RecFlag -> Floats -> Bool\nallLazyNested _      (Floats OkToSpec    _) = True\nallLazyNested _      (Floats NotOkToSpec _) = False\nallLazyNested is_rec (Floats IfUnboxedOk _) = isNonRec is_rec\n\n{-\n************************************************************************\n*                                                                      *\n                Cloning\n*                                                                      *\n************************************************************************\n-}\n\n-- ---------------------------------------------------------------------------\n--                      The environment\n-- ---------------------------------------------------------------------------\n\n-- Note [Inlining in CorePrep]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- There is a subtle but important invariant that must be upheld in the output\n-- of CorePrep: there are no \"trivial\" updatable thunks.  Thus, this Core\n-- is impermissible:\n--\n--      let x :: ()\n--          x = y\n--\n-- (where y is a reference to a GLOBAL variable).  Thunks like this are silly:\n-- they can always be profitably replaced by inlining x with y. Consequently,\n-- the code generator/runtime does not bother implementing this properly\n-- (specifically, there is no implementation of stg_ap_0_upd_info, which is the\n-- stack frame that would be used to update this thunk.  The \"0\" means it has\n-- zero free variables.)\n--\n-- In general, the inliner is good at eliminating these let-bindings.  However,\n-- there is one case where these trivial updatable thunks can arise: when\n-- we are optimizing away 'lazy' (see Note [lazyId magic], and also\n-- 'cpeRhsE'.)  Then, we could have started with:\n--\n--      let x :: ()\n--          x = lazy @ () y\n--\n-- which is a perfectly fine, non-trivial thunk, but then CorePrep will\n-- drop 'lazy', giving us 'x = y' which is trivial and impermissible.\n-- The solution is CorePrep to have a miniature inlining pass which deals\n-- with cases like this.  We can then drop the let-binding altogether.\n--\n-- Why does the removal of 'lazy' have to occur in CorePrep?\n-- The gory details are in Note [lazyId magic] in MkId, but the\n-- main reason is that lazy must appear in unfoldings (optimizer\n-- output) and it must prevent call-by-value for catch# (which\n-- is implemented by CorePrep.)\n--\n-- An alternate strategy for solving this problem is to have the\n-- inliner treat 'lazy e' as a trivial expression if 'e' is trivial.\n-- We decided not to adopt this solution to keep the definition\n-- of 'exprIsTrivial' simple.\n--\n-- There is ONE caveat however: for top-level bindings we have\n-- to preserve the binding so that we float the (hacky) non-recursive\n-- binding for data constructors; see Note [Data constructor workers].\n--\n-- Note [CorePrep inlines trivial CoreExpr not Id]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Why does cpe_env need to be an IdEnv CoreExpr, as opposed to an\n-- IdEnv Id?  Naively, we might conjecture that trivial updatable thunks\n-- as per Note [Inlining in CorePrep] always have the form\n-- 'lazy @ SomeType gbl_id'.  But this is not true: the following is\n-- perfectly reasonable Core:\n--\n--      let x :: ()\n--          x = lazy @ (forall a. a) y @ Bool\n--\n-- When we inline 'x' after eliminating 'lazy', we need to replace\n-- occurrences of 'x' with 'y @ bool', not just 'y'.  Situations like\n-- this can easily arise with higher-rank types; thus, cpe_env must\n-- map to CoreExprs, not Ids.\n\ndata CorePrepEnv\n  = CPE { cpe_dynFlags        :: DynFlags\n        , cpe_env             :: IdEnv CoreExpr   -- Clone local Ids\n        -- ^ This environment is used for three operations:\n        --\n        --      1. To support cloning of local Ids so that they are\n        --      all unique (see item (6) of CorePrep overview).\n        --\n        --      2. To support beta-reduction of runRW, see\n        --      Note [runRW magic] and Note [runRW arg].\n        --\n        --      3. To let us inline trivial RHSs of non top-level let-bindings,\n        --      see Note [lazyId magic], Note [Inlining in CorePrep]\n        --      and Note [CorePrep inlines trivial CoreExpr not Id] (#12076)\n        , cpe_mkIntegerId     :: Id\n        , cpe_mkNaturalId     :: Id\n        , cpe_integerSDataCon :: Maybe DataCon\n        , cpe_naturalSDataCon :: Maybe DataCon\n    }\n\nlookupMkIntegerName :: DynFlags -> HscEnv -> IO Id\nlookupMkIntegerName dflags hsc_env\n    = guardIntegerUse dflags $ liftM tyThingId $\n      lookupGlobal hsc_env mkIntegerName\n\nlookupMkNaturalName :: DynFlags -> HscEnv -> IO Id\nlookupMkNaturalName dflags hsc_env\n    = guardNaturalUse dflags $ liftM tyThingId $\n      lookupGlobal hsc_env mkNaturalName\n\n-- See Note [The integer library] in PrelNames\nlookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon)\nlookupIntegerSDataConName dflags hsc_env = case integerLibrary dflags of\n    IntegerGMP -> guardIntegerUse dflags $ liftM (Just . tyThingDataCon) $\n                  lookupGlobal hsc_env integerSDataConName\n    IntegerSimple -> return Nothing\n\nlookupNaturalSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon)\nlookupNaturalSDataConName dflags hsc_env = case integerLibrary dflags of\n    IntegerGMP -> guardNaturalUse dflags $ liftM (Just . tyThingDataCon) $\n                  lookupGlobal hsc_env naturalSDataConName\n    IntegerSimple -> return Nothing\n\n-- | Helper for 'lookupMkIntegerName', 'lookupIntegerSDataConName'\nguardIntegerUse :: DynFlags -> IO a -> IO a\nguardIntegerUse dflags act\n  | thisPackage dflags == primUnitId\n  = return $ panic \"Can't use Integer in ghc-prim\"\n  | thisPackage dflags == integerUnitId\n  = return $ panic \"Can't use Integer in integer-*\"\n  | otherwise = act\n\n-- | Helper for 'lookupMkNaturalName', 'lookupNaturalSDataConName'\n--\n-- Just like we can't use Integer literals in `integer-*`, we can't use Natural\n-- literals in `base`. If we do, we get interface loading error for GHC.Natural.\nguardNaturalUse :: DynFlags -> IO a -> IO a\nguardNaturalUse dflags act\n  | thisPackage dflags == primUnitId\n  = return $ panic \"Can't use Natural in ghc-prim\"\n  | thisPackage dflags == integerUnitId\n  = return $ panic \"Can't use Natural in integer-*\"\n  | thisPackage dflags == baseUnitId\n  = return $ panic \"Can't use Natural in base\"\n  | otherwise = act\n\nmkInitialCorePrepEnv :: DynFlags -> HscEnv -> IO CorePrepEnv\nmkInitialCorePrepEnv dflags hsc_env\n    = do mkIntegerId <- lookupMkIntegerName dflags hsc_env\n         mkNaturalId <- lookupMkNaturalName dflags hsc_env\n         integerSDataCon <- lookupIntegerSDataConName dflags hsc_env\n         naturalSDataCon <- lookupNaturalSDataConName dflags hsc_env\n         return $ CPE {\n                      cpe_dynFlags = dflags,\n                      cpe_env = emptyVarEnv,\n                      cpe_mkIntegerId = mkIntegerId,\n                      cpe_mkNaturalId = mkNaturalId,\n                      cpe_integerSDataCon = integerSDataCon,\n                      cpe_naturalSDataCon = naturalSDataCon\n                  }\n\nextendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv\nextendCorePrepEnv cpe id id'\n    = cpe { cpe_env = extendVarEnv (cpe_env cpe) id (Var id') }\n\nextendCorePrepEnvExpr :: CorePrepEnv -> Id -> CoreExpr -> CorePrepEnv\nextendCorePrepEnvExpr cpe id expr\n    = cpe { cpe_env = extendVarEnv (cpe_env cpe) id expr }\n\nextendCorePrepEnvList :: CorePrepEnv -> [(Id,Id)] -> CorePrepEnv\nextendCorePrepEnvList cpe prs\n    = cpe { cpe_env = extendVarEnvList (cpe_env cpe)\n                        (map (\\(id, id') -> (id, Var id')) prs) }\n\nlookupCorePrepEnv :: CorePrepEnv -> Id -> CoreExpr\nlookupCorePrepEnv cpe id\n  = case lookupVarEnv (cpe_env cpe) id of\n        Nothing  -> Var id\n        Just exp -> exp\n\ngetMkIntegerId :: CorePrepEnv -> Id\ngetMkIntegerId = cpe_mkIntegerId\n\ngetMkNaturalId :: CorePrepEnv -> Id\ngetMkNaturalId = cpe_mkNaturalId\n\n------------------------------------------------------------------------------\n-- Cloning binders\n-- ---------------------------------------------------------------------------\n\ncpCloneBndrs :: CorePrepEnv -> [InVar] -> UniqSM (CorePrepEnv, [OutVar])\ncpCloneBndrs env bs = mapAccumLM cpCloneBndr env bs\n\ncpCloneBndr  :: CorePrepEnv -> InVar -> UniqSM (CorePrepEnv, OutVar)\ncpCloneBndr env bndr\n  | not (isId bndr)\n  = return (env, bndr)\n\n  | otherwise\n  = do { bndr' <- clone_it bndr\n\n       -- Drop (now-useless) rules/unfoldings\n       -- See Note [Drop unfoldings and rules]\n       -- and Note [Preserve evaluatedness] in CoreTidy\n       ; let unfolding' = zapUnfolding (realIdUnfolding bndr)\n                          -- Simplifier will set the Id's unfolding\n\n             bndr'' = bndr' `setIdUnfolding`      unfolding'\n                            `setIdSpecialisation` emptyRuleInfo\n\n       ; return (extendCorePrepEnv env bndr bndr'', bndr'') }\n  where\n    clone_it bndr\n      | isLocalId bndr, not (isCoVar bndr)\n      = do { uniq <- getUniqueM; return (setVarUnique bndr uniq) }\n      | otherwise   -- Top level things, which we don't want\n                    -- to clone, have become GlobalIds by now\n                    -- And we don't clone tyvars, or coercion variables\n      = return bndr\n\n{- Note [Drop unfoldings and rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to drop the unfolding/rules on every Id:\n\n  - We are now past interface-file generation, and in the\n    codegen pipeline, so we really don't need full unfoldings/rules\n\n  - The unfolding/rule may be keeping stuff alive that we'd like\n    to discard.  See  Note [Dead code in CorePrep]\n\n  - Getting rid of unnecessary unfoldings reduces heap usage\n\n  - We are changing uniques, so if we didn't discard unfoldings/rules\n    we'd have to substitute in them\n\nHOWEVER, we want to preserve evaluated-ness;\nsee Note [Preserve evaluatedness] in CoreTidy.\n-}\n\n------------------------------------------------------------------------------\n-- Cloning ccall Ids; each must have a unique name,\n-- to give the code generator a handle to hang it on\n-- ---------------------------------------------------------------------------\n\nfiddleCCall :: Id -> UniqSM Id\nfiddleCCall id\n  | isFCallId id = (id `setVarUnique`) <$> getUniqueM\n  | otherwise    = return id\n\n------------------------------------------------------------------------------\n-- Generating new binders\n-- ---------------------------------------------------------------------------\n\nnewVar :: Type -> UniqSM Id\nnewVar ty\n = seqType ty `seq` do\n     uniq <- getUniqueM\n     return (mkSysLocalOrCoVar (fsLit \"sat\") uniq ty)\n\n\n------------------------------------------------------------------------------\n-- Floating ticks\n-- ---------------------------------------------------------------------------\n--\n-- Note [Floating Ticks in CorePrep]\n--\n-- It might seem counter-intuitive to float ticks by default, given\n-- that we don't actually want to move them if we can help it. On the\n-- other hand, nothing gets very far in CorePrep anyway, and we want\n-- to preserve the order of let bindings and tick annotations in\n-- relation to each other. For example, if we just wrapped let floats\n-- when they pass through ticks, we might end up performing the\n-- following transformation:\n--\n--   src<...> let foo = bar in baz\n--   ==>  let foo = src<...> bar in src<...> baz\n--\n-- Because the let-binding would float through the tick, and then\n-- immediately materialize, achieving nothing but decreasing tick\n-- accuracy. The only special case is the following scenario:\n--\n--   let foo = src<...> (let a = b in bar) in baz\n--   ==>  let foo = src<...> bar; a = src<...> b in baz\n--\n-- Here we would not want the source tick to end up covering \"baz\" and\n-- therefore refrain from pushing ticks outside. Instead, we copy them\n-- into the floating binds (here \"a\") in cpePair. Note that where \"b\"\n-- or \"bar\" are (value) lambdas we have to push the annotations\n-- further inside in order to uphold our rules.\n--\n-- All of this is implemented below in @wrapTicks@.\n\n-- | Like wrapFloats, but only wraps tick floats\nwrapTicks :: Floats -> CoreExpr -> (Floats, CoreExpr)\nwrapTicks (Floats flag floats0) expr =\n    (Floats flag (toOL $ reverse floats1), foldr mkTick expr (reverse ticks1))\n  where (floats1, ticks1) = foldlOL go ([], []) $ floats0\n        -- Deeply nested constructors will produce long lists of\n        -- redundant source note floats here. We need to eliminate\n        -- those early, as relying on mkTick to spot it after the fact\n        -- can yield O(n^3) complexity [#11095]\n        go (floats, ticks) (FloatTick t)\n          = ASSERT(tickishPlace t == PlaceNonLam)\n            (floats, if any (flip tickishContains t) ticks\n                     then ticks else t:ticks)\n        go (floats, ticks) f\n          = (foldr wrap f (reverse ticks):floats, ticks)\n\n        wrap t (FloatLet bind)    = FloatLet (wrapBind t bind)\n        wrap t (FloatCase b r ok) = FloatCase b (mkTick t r) ok\n        wrap _ other              = pprPanic \"wrapTicks: unexpected float!\"\n                                             (ppr other)\n        wrapBind t (NonRec binder rhs) = NonRec binder (mkTick t rhs)\n        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTick t) pairs)\n\n------------------------------------------------------------------------------\n-- Collecting cost centres\n-- ---------------------------------------------------------------------------\n\n-- | Collect cost centres defined in the current module, including those in\n-- unfoldings.\ncollectCostCentres :: Module -> CoreProgram -> S.Set CostCentre\ncollectCostCentres mod_name\n  = foldl' go_bind S.empty\n  where\n    go cs e = case e of\n      Var{} -> cs\n      Lit{} -> cs\n      App e1 e2 -> go (go cs e1) e2\n      Lam _ e -> go cs e\n      Let b e -> go (go_bind cs b) e\n      Case scrt _ _ alts -> go_alts (go cs scrt) alts\n      Cast e _ -> go cs e\n      Tick (ProfNote cc _ _) e ->\n        go (if ccFromThisModule cc mod_name then S.insert cc cs else cs) e\n      Tick _ e -> go cs e\n      Type{} -> cs\n      Coercion{} -> cs\n\n    go_alts = foldl' (\\cs (_con, _bndrs, e) -> go cs e)\n\n    go_bind :: S.Set CostCentre -> CoreBind -> S.Set CostCentre\n    go_bind cs (NonRec b e) =\n      go (maybe cs (go cs) (get_unf b)) e\n    go_bind cs (Rec bs) =\n      foldl' (\\cs' (b, e) -> go (maybe cs' (go cs') (get_unf b)) e) cs bs\n\n    -- Unfoldings may have cost centres that in the original definion are\n    -- optimized away, see #5889.\n    get_unf = maybeUnfoldingTemplate . realIdUnfolding\n", "num_lines": 1730}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- |\n-- Various utilities for forcing Core structures\n--\n-- It can often be useful to force various parts of the AST. This module\n-- provides a number of @seq@-like functions to accomplish this.\n\nmodule CoreSeq (\n        -- * Utilities for forcing Core structures\n        seqExpr, seqExprs, seqUnfolding, seqRules,\n        megaSeqIdInfo, seqRuleInfo, seqBinds,\n    ) where\n\nimport GhcPrelude\n\nimport CoreSyn\nimport IdInfo\nimport Demand( seqDemand, seqStrictSig )\nimport BasicTypes( seqOccInfo )\nimport VarSet( seqDVarSet )\nimport Var( varType, tyVarKind )\nimport Type( seqType, isTyVar )\nimport Coercion( seqCo )\nimport Id( Id, idInfo )\n\n-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the\n-- compiler\nmegaSeqIdInfo :: IdInfo -> ()\nmegaSeqIdInfo info\n  = seqRuleInfo (ruleInfo info)                 `seq`\n\n-- Omitting this improves runtimes a little, presumably because\n-- some unfoldings are not calculated at all\n--    seqUnfolding (unfoldingInfo info)         `seq`\n\n    seqDemand (demandInfo info)                 `seq`\n    seqStrictSig (strictnessInfo info)          `seq`\n    seqCaf (cafInfo info)                       `seq`\n    seqOneShot (oneShotInfo info)               `seq`\n    seqOccInfo (occInfo info)\n\nseqOneShot :: OneShotInfo -> ()\nseqOneShot l = l `seq` ()\n\nseqRuleInfo :: RuleInfo -> ()\nseqRuleInfo (RuleInfo rules fvs) = seqRules rules `seq` seqDVarSet fvs\n\nseqCaf :: CafInfo -> ()\nseqCaf c = c `seq` ()\n\nseqRules :: [CoreRule] -> ()\nseqRules [] = ()\nseqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)\n  = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules\nseqRules (BuiltinRule {} : rules) = seqRules rules\n\nseqExpr :: CoreExpr -> ()\nseqExpr (Var v)         = v `seq` ()\nseqExpr (Lit lit)       = lit `seq` ()\nseqExpr (App f a)       = seqExpr f `seq` seqExpr a\nseqExpr (Lam b e)       = seqBndr b `seq` seqExpr e\nseqExpr (Let b e)       = seqBind b `seq` seqExpr e\nseqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as\nseqExpr (Cast e co)     = seqExpr e `seq` seqCo co\nseqExpr (Tick n e)      = seqTickish n `seq` seqExpr e\nseqExpr (Type t)        = seqType t\nseqExpr (Coercion co)   = seqCo co\n\nseqExprs :: [CoreExpr] -> ()\nseqExprs [] = ()\nseqExprs (e:es) = seqExpr e `seq` seqExprs es\n\nseqTickish :: Tickish Id -> ()\nseqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()\nseqTickish HpcTick{} = ()\nseqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids\nseqTickish SourceNote{} = ()\n\nseqBndr :: CoreBndr -> ()\nseqBndr b | isTyVar b = seqType (tyVarKind b)\n          | otherwise = seqType (varType b)             `seq`\n                        megaSeqIdInfo (idInfo b)\n\nseqBndrs :: [CoreBndr] -> ()\nseqBndrs [] = ()\nseqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs\n\nseqBinds :: [Bind CoreBndr] -> ()\nseqBinds bs = foldr (seq . seqBind) () bs\n\nseqBind :: Bind CoreBndr -> ()\nseqBind (NonRec b e) = seqBndr b `seq` seqExpr e\nseqBind (Rec prs)    = seqPairs prs\n\nseqPairs :: [(CoreBndr, CoreExpr)] -> ()\nseqPairs [] = ()\nseqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs\n\nseqAlts :: [CoreAlt] -> ()\nseqAlts [] = ()\nseqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts\n\nseqUnfolding :: Unfolding -> ()\nseqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,\n                uf_is_value = b1, uf_is_work_free = b2,\n                uf_expandable = b3, uf_is_conlike = b4,\n                uf_guidance = g})\n  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g\n\nseqUnfolding _ = ()\n\nseqGuidance :: UnfoldingGuidance -> ()\nseqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()\nseqGuidance _                      = ()\n", "num_lines": 114}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-2015\n-}\n\n-- | Functions to computing the statistics reflective of the \"size\"\n-- of a Core expression\nmodule CoreStats (\n        -- * Expression and bindings size\n        coreBindsSize, exprSize,\n        CoreStats(..), coreBindsStats, exprStats,\n    ) where\n\nimport GhcPrelude\n\nimport BasicTypes\nimport CoreSyn\nimport Outputable\nimport Coercion\nimport Var\nimport Type (Type, typeSize)\nimport Id (isJoinId)\n\ndata CoreStats = CS { cs_tm :: !Int    -- Terms\n                    , cs_ty :: !Int    -- Types\n                    , cs_co :: !Int    -- Coercions\n                    , cs_vb :: !Int    -- Local value bindings\n                    , cs_jb :: !Int }  -- Local join bindings\n\n\ninstance Outputable CoreStats where\n ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5 })\n   = braces (sep [text \"terms:\"     <+> intWithCommas i1 <> comma,\n                  text \"types:\"     <+> intWithCommas i2 <> comma,\n                  text \"coercions:\" <+> intWithCommas i3 <> comma,\n                  text \"joins:\"     <+> intWithCommas i5 <> char '/' <>\n                                        intWithCommas (i4 + i5) ])\n\nplusCS :: CoreStats -> CoreStats -> CoreStats\nplusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1 })\n       (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2 })\n  = CS { cs_tm = p1+p2, cs_ty = q1+q2, cs_co = r1+r2, cs_vb = v1+v2\n       , cs_jb = j1+j2 }\n\nzeroCS, oneTM :: CoreStats\nzeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0 }\noneTM  = zeroCS { cs_tm = 1 }\n\nsumCS :: (a -> CoreStats) -> [a] -> CoreStats\nsumCS f = foldl' (\\s a -> plusCS s (f a)) zeroCS\n\ncoreBindsStats :: [CoreBind] -> CoreStats\ncoreBindsStats = sumCS (bindStats TopLevel)\n\nbindStats :: TopLevelFlag -> CoreBind -> CoreStats\nbindStats top_lvl (NonRec v r) = bindingStats top_lvl v r\nbindStats top_lvl (Rec prs)    = sumCS (\\(v,r) -> bindingStats top_lvl v r) prs\n\nbindingStats :: TopLevelFlag -> Var -> CoreExpr -> CoreStats\nbindingStats top_lvl v r = letBndrStats top_lvl v `plusCS` exprStats r\n\nbndrStats :: Var -> CoreStats\nbndrStats v = oneTM `plusCS` tyStats (varType v)\n\nletBndrStats :: TopLevelFlag -> Var -> CoreStats\nletBndrStats top_lvl v\n  | isTyVar v || isTopLevel top_lvl = bndrStats v\n  | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats\n  | otherwise  = oneTM { cs_vb = 1 } `plusCS` ty_stats\n  where\n    ty_stats = tyStats (varType v)\n\nexprStats :: CoreExpr -> CoreStats\nexprStats (Var {})        = oneTM\nexprStats (Lit {})        = oneTM\nexprStats (Type t)        = tyStats t\nexprStats (Coercion c)    = coStats c\nexprStats (App f a)       = exprStats f `plusCS` exprStats a\nexprStats (Lam b e)       = bndrStats b `plusCS` exprStats e\nexprStats (Let b e)       = bindStats NotTopLevel b `plusCS` exprStats e\nexprStats (Case e b _ as) = exprStats e `plusCS` bndrStats b\n                                        `plusCS` sumCS altStats as\nexprStats (Cast e co)     = coStats co `plusCS` exprStats e\nexprStats (Tick _ e)      = exprStats e\n\naltStats :: CoreAlt -> CoreStats\naltStats (_, bs, r) = altBndrStats bs `plusCS` exprStats r\n\naltBndrStats :: [Var] -> CoreStats\n-- Charge one for the alternative, not for each binder\naltBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs\n\ntyStats :: Type -> CoreStats\ntyStats ty = zeroCS { cs_ty = typeSize ty }\n\ncoStats :: Coercion -> CoreStats\ncoStats co = zeroCS { cs_co = coercionSize co }\n\ncoreBindsSize :: [CoreBind] -> Int\n-- We use coreBindStats for user printout\n-- but this one is a quick and dirty basis for\n-- the simplifier's tick limit\ncoreBindsSize bs = sum (map bindSize bs)\n\nexprSize :: CoreExpr -> Int\n-- ^ A measure of the size of the expressions, strictly greater than 0\n-- Counts *leaves*, not internal nodes. Types and coercions are not counted.\nexprSize (Var _)         = 1\nexprSize (Lit _)         = 1\nexprSize (App f a)       = exprSize f + exprSize a\nexprSize (Lam b e)       = bndrSize b + exprSize e\nexprSize (Let b e)       = bindSize b + exprSize e\nexprSize (Case e b _ as) = exprSize e + bndrSize b + 1 + sum (map altSize as)\nexprSize (Cast e _)      = 1 + exprSize e\nexprSize (Tick n e)      = tickSize n + exprSize e\nexprSize (Type _)        = 1\nexprSize (Coercion _)    = 1\n\ntickSize :: Tickish Id -> Int\ntickSize (ProfNote _ _ _) = 1\ntickSize _ = 1\n\nbndrSize :: Var -> Int\nbndrSize _ = 1\n\nbndrsSize :: [Var] -> Int\nbndrsSize = sum . map bndrSize\n\nbindSize :: CoreBind -> Int\nbindSize (NonRec b e) = bndrSize b + exprSize e\nbindSize (Rec prs)    = sum (map pairSize prs)\n\npairSize :: (Var, CoreExpr) -> Int\npairSize (b,e) = bndrSize b + exprSize e\n\naltSize :: CoreAlt -> Int\naltSize (_,bs,e) = bndrsSize bs + exprSize e\n", "num_lines": 138}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nUtility functions on @Core@ syntax\n-}\n\n{-# LANGUAGE CPP #-}\nmodule CoreSubst (\n        -- * Main data types\n        Subst(..), -- Implementation exported for supercompiler's Renaming.hs only\n        TvSubstEnv, IdSubstEnv, InScopeSet,\n\n        -- ** Substituting into expressions and related types\n        deShadowBinds, substSpec, substRulesForImportedIds,\n        substTy, substCo, substExpr, substExprSC, substBind, substBindSC,\n        substUnfolding, substUnfoldingSC,\n        lookupIdSubst, lookupTCvSubst, substIdOcc,\n        substTickish, substDVarSet, substIdInfo,\n\n        -- ** Operations on substitutions\n        emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,\n        extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList,\n        extendSubst, extendSubstList, extendSubstWithVar, zapSubstEnv,\n        addInScopeSet, extendInScope, extendInScopeList, extendInScopeIds,\n        isInScope, setInScope, getTCvSubst, extendTvSubst, extendCvSubst,\n        delBndr, delBndrs,\n\n        -- ** Substituting and cloning binders\n        substBndr, substBndrs, substRecBndrs, substTyVarBndr, substCoVarBndr,\n        cloneBndr, cloneBndrs, cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,\n\n    ) where\n\n#include \"HsVersions.h\"\n\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreFVs\nimport CoreSeq\nimport CoreUtils\nimport qualified Type\nimport qualified Coercion\n\n        -- We are defining local versions\nimport Type     hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList\n                       , isInScope, substTyVarBndr, cloneTyVarBndr )\nimport Coercion hiding ( substCo, substCoVarBndr )\n\nimport PrelNames\nimport VarSet\nimport VarEnv\nimport Id\nimport Name     ( Name )\nimport Var\nimport IdInfo\nimport UniqSupply\nimport Maybes\nimport Util\nimport Outputable\nimport PprCore          ()              -- Instances\nimport Data.List\n\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Substitutions}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A substitution environment, containing 'Id', 'TyVar', and 'CoVar'\n-- substitutions.\n--\n-- Some invariants apply to how you use the substitution:\n--\n-- 1. Note [The substitution invariant] in TyCoRep\n--\n-- 2. Note [Substitutions apply only once] in TyCoRep\ndata Subst\n  = Subst InScopeSet  -- Variables in in scope (both Ids and TyVars) /after/\n                      -- applying the substitution\n          IdSubstEnv  -- Substitution from NcIds to CoreExprs\n          TvSubstEnv  -- Substitution from TyVars to Types\n          CvSubstEnv  -- Substitution from CoVars to Coercions\n\n        -- INVARIANT 1: See TyCoRep Note [The substitution invariant]\n        -- This is what lets us deal with name capture properly\n        -- It's a hard invariant to check...\n        --\n        -- INVARIANT 2: The substitution is apply-once; see Note [Apply once] with\n        --              Types.TvSubstEnv\n        --\n        -- INVARIANT 3: See Note [Extending the Subst]\n\n{-\nNote [Extending the Subst]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor a core Subst, which binds Ids as well, we make a different choice for Ids\nthan we do for TyVars.\n\nFor TyVars, see Note [Extending the TCvSubst] with Type.TvSubstEnv\n\nFor Ids, we have a different invariant\n        The IdSubstEnv is extended *only* when the Unique on an Id changes\n        Otherwise, we just extend the InScopeSet\n\nIn consequence:\n\n* If all subst envs are empty, substExpr would be a\n  no-op, so substExprSC (\"short cut\") does nothing.\n\n  However, substExpr still goes ahead and substitutes.  Reason: we may\n  want to replace existing Ids with new ones from the in-scope set, to\n  avoid space leaks.\n\n* In substIdBndr, we extend the IdSubstEnv only when the unique changes\n\n* If the CvSubstEnv, TvSubstEnv and IdSubstEnv are all empty,\n  substExpr does nothing (Note that the above rule for substIdBndr\n  maintains this property.  If the incoming envts are both empty, then\n  substituting the type and IdInfo can't change anything.)\n\n* In lookupIdSubst, we *must* look up the Id in the in-scope set, because\n  it may contain non-trivial changes.  Example:\n        (/\\a. \\x:a. ...x...) Int\n  We extend the TvSubstEnv with [a |-> Int]; but x's unique does not change\n  so we only extend the in-scope set.  Then we must look up in the in-scope\n  set when we find the occurrence of x.\n\n* The requirement to look up the Id in the in-scope set means that we\n  must NOT take no-op short cut when the IdSubst is empty.\n  We must still look up every Id in the in-scope set.\n\n* (However, we don't need to do so for expressions found in the IdSubst\n  itself, whose range is assumed to be correct wrt the in-scope set.)\n\nWhy do we make a different choice for the IdSubstEnv than the\nTvSubstEnv and CvSubstEnv?\n\n* For Ids, we change the IdInfo all the time (e.g. deleting the\n  unfolding), and adding it back later, so using the TyVar convention\n  would entail extending the substitution almost all the time\n\n* The simplifier wants to look up in the in-scope set anyway, in case it\n  can see a better unfolding from an enclosing case expression\n\n* For TyVars, only coercion variables can possibly change, and they are\n  easy to spot\n-}\n\n-- | An environment for substituting for 'Id's\ntype IdSubstEnv = IdEnv CoreExpr   -- Domain is NcIds, i.e. not coercions\n\n----------------------------\nisEmptySubst :: Subst -> Bool\nisEmptySubst (Subst _ id_env tv_env cv_env)\n  = isEmptyVarEnv id_env && isEmptyVarEnv tv_env && isEmptyVarEnv cv_env\n\nemptySubst :: Subst\nemptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv emptyVarEnv\n\nmkEmptySubst :: InScopeSet -> Subst\nmkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv\n\nmkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst\nmkSubst in_scope tvs cvs ids = Subst in_scope ids tvs cvs\n\n-- | Find the in-scope set: see TyCoRep Note [The substitution invariant]\nsubstInScope :: Subst -> InScopeSet\nsubstInScope (Subst in_scope _ _ _) = in_scope\n\n-- | Remove all substitutions for 'Id's and 'Var's that might have been built up\n-- while preserving the in-scope set\nzapSubstEnv :: Subst -> Subst\nzapSubstEnv (Subst in_scope _ _ _) = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv\n\n-- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is\n-- such that TyCoRep Note [The substitution invariant]\n-- holds after extending the substitution like this\nextendIdSubst :: Subst -> Id -> CoreExpr -> Subst\n-- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set\nextendIdSubst (Subst in_scope ids tvs cvs) v r\n  = ASSERT2( isNonCoVarId v, ppr v $$ ppr r )\n    Subst in_scope (extendVarEnv ids v r) tvs cvs\n\n-- | Adds multiple 'Id' substitutions to the 'Subst': see also 'extendIdSubst'\nextendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst\nextendIdSubstList (Subst in_scope ids tvs cvs) prs\n  = ASSERT( all (isNonCoVarId . fst) prs )\n    Subst in_scope (extendVarEnvList ids prs) tvs cvs\n\n-- | Add a substitution for a 'TyVar' to the 'Subst'\n-- The 'TyVar' *must* be a real TyVar, and not a CoVar\n-- You must ensure that the in-scope set is such that\n-- TyCoRep Note [The substitution invariant] holds\n-- after extending the substitution like this.\nextendTvSubst :: Subst -> TyVar -> Type -> Subst\nextendTvSubst (Subst in_scope ids tvs cvs) tv ty\n  = ASSERT( isTyVar tv )\n    Subst in_scope ids (extendVarEnv tvs tv ty) cvs\n\n-- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTvSubst'\nextendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst\nextendTvSubstList subst vrs\n  = foldl' extend subst vrs\n  where\n    extend subst (v, r) = extendTvSubst subst v r\n\n-- | Add a substitution from a 'CoVar' to a 'Coercion' to the 'Subst':\n-- you must ensure that the in-scope set satisfies\n-- TyCoRep Note [The substitution invariant]\n-- after extending the substitution like this\nextendCvSubst :: Subst -> CoVar -> Coercion -> Subst\nextendCvSubst (Subst in_scope ids tvs cvs) v r\n  = ASSERT( isCoVar v )\n    Subst in_scope ids tvs (extendVarEnv cvs v r)\n\n-- | Add a substitution appropriate to the thing being substituted\n--   (whether an expression, type, or coercion). See also\n--   'extendIdSubst', 'extendTvSubst', 'extendCvSubst'\nextendSubst :: Subst -> Var -> CoreArg -> Subst\nextendSubst subst var arg\n  = case arg of\n      Type ty     -> ASSERT( isTyVar var ) extendTvSubst subst var ty\n      Coercion co -> ASSERT( isCoVar var ) extendCvSubst subst var co\n      _           -> ASSERT( isId    var ) extendIdSubst subst var arg\n\nextendSubstWithVar :: Subst -> Var -> Var -> Subst\nextendSubstWithVar subst v1 v2\n  | isTyVar v1 = ASSERT( isTyVar v2 ) extendTvSubst subst v1 (mkTyVarTy v2)\n  | isCoVar v1 = ASSERT( isCoVar v2 ) extendCvSubst subst v1 (mkCoVarCo v2)\n  | otherwise  = ASSERT( isId    v2 ) extendIdSubst subst v1 (Var v2)\n\n-- | Add a substitution as appropriate to each of the terms being\n--   substituted (whether expressions, types, or coercions). See also\n--   'extendSubst'.\nextendSubstList :: Subst -> [(Var,CoreArg)] -> Subst\nextendSubstList subst []              = subst\nextendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs\n\n-- | Find the substitution for an 'Id' in the 'Subst'\nlookupIdSubst :: SDoc -> Subst -> Id -> CoreExpr\nlookupIdSubst doc (Subst in_scope ids _ _) v\n  | not (isLocalId v) = Var v\n  | Just e  <- lookupVarEnv ids       v = e\n  | Just v' <- lookupInScope in_scope v = Var v'\n        -- Vital! See Note [Extending the Subst]\n  | otherwise = WARN( True, text \"CoreSubst.lookupIdSubst\" <+> doc <+> ppr v\n                            $$ ppr in_scope)\n                Var v\n\n-- | Find the substitution for a 'TyVar' in the 'Subst'\nlookupTCvSubst :: Subst -> TyVar -> Type\nlookupTCvSubst (Subst _ _ tvs cvs) v\n  | isTyVar v\n  = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v\n  | otherwise\n  = mkCoercionTy $ lookupVarEnv cvs v `orElse` mkCoVarCo v\n\ndelBndr :: Subst -> Var -> Subst\ndelBndr (Subst in_scope ids tvs cvs) v\n  | isCoVar v = Subst in_scope ids tvs (delVarEnv cvs v)\n  | isTyVar v = Subst in_scope ids (delVarEnv tvs v) cvs\n  | otherwise = Subst in_scope (delVarEnv ids v) tvs cvs\n\ndelBndrs :: Subst -> [Var] -> Subst\ndelBndrs (Subst in_scope ids tvs cvs) vs\n  = Subst in_scope (delVarEnvList ids vs) (delVarEnvList tvs vs) (delVarEnvList cvs vs)\n      -- Easiest thing is just delete all from all!\n\n-- | Simultaneously substitute for a bunch of variables\n--   No left-right shadowing\n--   ie the substitution for   (\\x \\y. e) a1 a2\n--      so neither x nor y scope over a1 a2\nmkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst\nmkOpenSubst in_scope pairs = Subst in_scope\n                                   (mkVarEnv [(id,e)  | (id, e) <- pairs, isId id])\n                                   (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])\n                                   (mkVarEnv [(v,co)  | (v, Coercion co) <- pairs])\n\n------------------------------\nisInScope :: Var -> Subst -> Bool\nisInScope v (Subst in_scope _ _ _) = v `elemInScopeSet` in_scope\n\n-- | Add the 'Var' to the in-scope set, but do not remove\n-- any existing substitutions for it\naddInScopeSet :: Subst -> VarSet -> Subst\naddInScopeSet (Subst in_scope ids tvs cvs) vs\n  = Subst (in_scope `extendInScopeSetSet` vs) ids tvs cvs\n\n-- | Add the 'Var' to the in-scope set: as a side effect,\n-- and remove any existing substitutions for it\nextendInScope :: Subst -> Var -> Subst\nextendInScope (Subst in_scope ids tvs cvs) v\n  = Subst (in_scope `extendInScopeSet` v)\n          (ids `delVarEnv` v) (tvs `delVarEnv` v) (cvs `delVarEnv` v)\n\n-- | Add the 'Var's to the in-scope set: see also 'extendInScope'\nextendInScopeList :: Subst -> [Var] -> Subst\nextendInScopeList (Subst in_scope ids tvs cvs) vs\n  = Subst (in_scope `extendInScopeSetList` vs)\n          (ids `delVarEnvList` vs) (tvs `delVarEnvList` vs) (cvs `delVarEnvList` vs)\n\n-- | Optimized version of 'extendInScopeList' that can be used if you are certain\n-- all the things being added are 'Id's and hence none are 'TyVar's or 'CoVar's\nextendInScopeIds :: Subst -> [Id] -> Subst\nextendInScopeIds (Subst in_scope ids tvs cvs) vs\n  = Subst (in_scope `extendInScopeSetList` vs)\n          (ids `delVarEnvList` vs) tvs cvs\n\nsetInScope :: Subst -> InScopeSet -> Subst\nsetInScope (Subst _ ids tvs cvs) in_scope = Subst in_scope ids tvs cvs\n\n-- Pretty printing, for debugging only\n\ninstance Outputable Subst where\n  ppr (Subst in_scope ids tvs cvs)\n        =  text \"<InScope =\" <+> in_scope_doc\n        $$ text \" IdSubst   =\" <+> ppr ids\n        $$ text \" TvSubst   =\" <+> ppr tvs\n        $$ text \" CvSubst   =\" <+> ppr cvs\n         <> char '>'\n    where\n    in_scope_doc = pprVarSet (getInScopeVars in_scope) (braces . fsep . map ppr)\n\n{-\n************************************************************************\n*                                                                      *\n        Substituting expressions\n*                                                                      *\n************************************************************************\n-}\n\n-- | Apply a substitution to an entire 'CoreExpr'. Remember, you may only\n-- apply the substitution /once/:\n-- see Note [Substitutions apply only once] in TyCoRep\n--\n-- Do *not* attempt to short-cut in the case of an empty substitution!\n-- See Note [Extending the Subst]\nsubstExprSC :: SDoc -> Subst -> CoreExpr -> CoreExpr\nsubstExprSC doc subst orig_expr\n  | isEmptySubst subst = orig_expr\n  | otherwise          = -- pprTrace \"enter subst-expr\" (doc $$ ppr orig_expr) $\n                         subst_expr doc subst orig_expr\n\nsubstExpr :: SDoc -> Subst -> CoreExpr -> CoreExpr\nsubstExpr doc subst orig_expr = subst_expr doc subst orig_expr\n\nsubst_expr :: SDoc -> Subst -> CoreExpr -> CoreExpr\nsubst_expr doc subst expr\n  = go expr\n  where\n    go (Var v)         = lookupIdSubst (doc $$ text \"subst_expr\") subst v\n    go (Type ty)       = Type (substTy subst ty)\n    go (Coercion co)   = Coercion (substCo subst co)\n    go (Lit lit)       = Lit lit\n    go (App fun arg)   = App (go fun) (go arg)\n    go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)\n    go (Cast e co)     = Cast (go e) (substCo subst co)\n       -- Do not optimise even identity coercions\n       -- Reason: substitution applies to the LHS of RULES, and\n       --         if you \"optimise\" an identity coercion, you may\n       --         lose a binder. We optimise the LHS of rules at\n       --         construction time\n\n    go (Lam bndr body) = Lam bndr' (subst_expr doc subst' body)\n                       where\n                         (subst', bndr') = substBndr subst bndr\n\n    go (Let bind body) = Let bind' (subst_expr doc subst' body)\n                       where\n                         (subst', bind') = substBind subst bind\n\n    go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)\n                                 where\n                                 (subst', bndr') = substBndr subst bndr\n\n    go_alt subst (con, bndrs, rhs) = (con, bndrs', subst_expr doc subst' rhs)\n                                 where\n                                   (subst', bndrs') = substBndrs subst bndrs\n\n-- | Apply a substitution to an entire 'CoreBind', additionally returning an updated 'Subst'\n-- that should be used by subsequent substitutions.\nsubstBind, substBindSC :: Subst -> CoreBind -> (Subst, CoreBind)\n\nsubstBindSC subst bind    -- Short-cut if the substitution is empty\n  | not (isEmptySubst subst)\n  = substBind subst bind\n  | otherwise\n  = case bind of\n       NonRec bndr rhs -> (subst', NonRec bndr' rhs)\n          where\n            (subst', bndr') = substBndr subst bndr\n       Rec pairs -> (subst', Rec (bndrs' `zip` rhss'))\n          where\n            (bndrs, rhss)    = unzip pairs\n            (subst', bndrs') = substRecBndrs subst bndrs\n            rhss' | isEmptySubst subst'\n                  = rhss\n                  | otherwise\n                  = map (subst_expr (text \"substBindSC\") subst') rhss\n\nsubstBind subst (NonRec bndr rhs)\n  = (subst', NonRec bndr' (subst_expr (text \"substBind\") subst rhs))\n  where\n    (subst', bndr') = substBndr subst bndr\n\nsubstBind subst (Rec pairs)\n   = (subst', Rec (bndrs' `zip` rhss'))\n   where\n       (bndrs, rhss)    = unzip pairs\n       (subst', bndrs') = substRecBndrs subst bndrs\n       rhss' = map (subst_expr (text \"substBind\") subst') rhss\n\n-- | De-shadowing the program is sometimes a useful pre-pass. It can be done simply\n-- by running over the bindings with an empty substitution, because substitution\n-- returns a result that has no-shadowing guaranteed.\n--\n-- (Actually, within a single /type/ there might still be shadowing, because\n-- 'substTy' is a no-op for the empty substitution, but that's probably OK.)\n--\n-- [Aug 09] This function is not used in GHC at the moment, but seems so\n--          short and simple that I'm going to leave it here\ndeShadowBinds :: CoreProgram -> CoreProgram\ndeShadowBinds binds = snd (mapAccumL substBind emptySubst binds)\n\n{-\n************************************************************************\n*                                                                      *\n        Substituting binders\n*                                                                      *\n************************************************************************\n\nRemember that substBndr and friends are used when doing expression\nsubstitution only.  Their only business is substitution, so they\npreserve all IdInfo (suitably substituted).  For example, we *want* to\npreserve occ info in rules.\n-}\n\n-- | Substitutes a 'Var' for another one according to the 'Subst' given, returning\n-- the result and an updated 'Subst' that should be used by subsequent substitutions.\n-- 'IdInfo' is preserved by this process, although it is substituted into appropriately.\nsubstBndr :: Subst -> Var -> (Subst, Var)\nsubstBndr subst bndr\n  | isTyVar bndr  = substTyVarBndr subst bndr\n  | isCoVar bndr  = substCoVarBndr subst bndr\n  | otherwise     = substIdBndr (text \"var-bndr\") subst subst bndr\n\n-- | Applies 'substBndr' to a number of 'Var's, accumulating a new 'Subst' left-to-right\nsubstBndrs :: Subst -> [Var] -> (Subst, [Var])\nsubstBndrs subst bndrs = mapAccumL substBndr subst bndrs\n\n-- | Substitute in a mutually recursive group of 'Id's\nsubstRecBndrs :: Subst -> [Id] -> (Subst, [Id])\nsubstRecBndrs subst bndrs\n  = (new_subst, new_bndrs)\n  where         -- Here's the reason we need to pass rec_subst to subst_id\n    (new_subst, new_bndrs) = mapAccumL (substIdBndr (text \"rec-bndr\") new_subst) subst bndrs\n\nsubstIdBndr :: SDoc\n            -> Subst            -- ^ Substitution to use for the IdInfo\n            -> Subst -> Id      -- ^ Substitution and Id to transform\n            -> (Subst, Id)      -- ^ Transformed pair\n                                -- NB: unfolding may be zapped\n\nsubstIdBndr _doc rec_subst subst@(Subst in_scope env tvs cvs) old_id\n  = -- pprTrace \"substIdBndr\" (doc $$ ppr old_id $$ ppr in_scope) $\n    (Subst (in_scope `extendInScopeSet` new_id) new_env tvs cvs, new_id)\n  where\n    id1 = uniqAway in_scope old_id      -- id1 is cloned if necessary\n    id2 | no_type_change = id1\n        | otherwise      = setIdType id1 (substTy subst old_ty)\n\n    old_ty = idType old_id\n    no_type_change = (isEmptyVarEnv tvs && isEmptyVarEnv cvs) ||\n                     noFreeVarsOfType old_ty\n\n        -- new_id has the right IdInfo\n        -- The lazy-set is because we're in a loop here, with\n        -- rec_subst, when dealing with a mutually-recursive group\n    new_id = maybeModifyIdInfo mb_new_info id2\n    mb_new_info = substIdInfo rec_subst id2 (idInfo id2)\n        -- NB: unfolding info may be zapped\n\n        -- Extend the substitution if the unique has changed\n        -- See the notes with substTyVarBndr for the delVarEnv\n    new_env | no_change = delVarEnv env old_id\n            | otherwise = extendVarEnv env old_id (Var new_id)\n\n    no_change = id1 == old_id\n        -- See Note [Extending the Subst]\n        -- it's /not/ necessary to check mb_new_info and no_type_change\n\n{-\nNow a variant that unconditionally allocates a new unique.\nIt also unconditionally zaps the OccInfo.\n-}\n\n-- | Very similar to 'substBndr', but it always allocates a new 'Unique' for\n-- each variable in its output.  It substitutes the IdInfo though.\ncloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)\ncloneIdBndr subst us old_id\n  = clone_id subst subst (old_id, uniqFromSupply us)\n\n-- | Applies 'cloneIdBndr' to a number of 'Id's, accumulating a final\n-- substitution from left to right\ncloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])\ncloneIdBndrs subst us ids\n  = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us)\n\ncloneBndrs :: Subst -> UniqSupply -> [Var] -> (Subst, [Var])\n-- Works for all kinds of variables (typically case binders)\n-- not just Ids\ncloneBndrs subst us vs\n  = mapAccumL (\\subst (v, u) -> cloneBndr subst u v) subst (vs `zip` uniqsFromSupply us)\n\ncloneBndr :: Subst -> Unique -> Var -> (Subst, Var)\ncloneBndr subst uniq v\n  | isTyVar v = cloneTyVarBndr subst v uniq\n  | otherwise = clone_id subst subst (v,uniq)  -- Works for coercion variables too\n\n-- | Clone a mutually recursive group of 'Id's\ncloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])\ncloneRecIdBndrs subst us ids\n  = (subst', ids')\n  where\n    (subst', ids') = mapAccumL (clone_id subst') subst\n                               (ids `zip` uniqsFromSupply us)\n\n-- Just like substIdBndr, except that it always makes a new unique\n-- It is given the unique to use\nclone_id    :: Subst                    -- Substitution for the IdInfo\n            -> Subst -> (Id, Unique)    -- Substitution and Id to transform\n            -> (Subst, Id)              -- Transformed pair\n\nclone_id rec_subst subst@(Subst in_scope idvs tvs cvs) (old_id, uniq)\n  = (Subst (in_scope `extendInScopeSet` new_id) new_idvs tvs new_cvs, new_id)\n  where\n    id1     = setVarUnique old_id uniq\n    id2     = substIdType subst id1\n    new_id  = maybeModifyIdInfo (substIdInfo rec_subst id2 (idInfo old_id)) id2\n    (new_idvs, new_cvs) | isCoVar old_id = (idvs, extendVarEnv cvs old_id (mkCoVarCo new_id))\n                        | otherwise      = (extendVarEnv idvs old_id (Var new_id), cvs)\n\n{-\n************************************************************************\n*                                                                      *\n                Types and Coercions\n*                                                                      *\n************************************************************************\n\nFor types and coercions we just call the corresponding functions in\nType and Coercion, but we have to repackage the substitution, from a\nSubst to a TCvSubst.\n-}\n\nsubstTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)\nsubstTyVarBndr (Subst in_scope id_env tv_env cv_env) tv\n  = case Type.substTyVarBndr (TCvSubst in_scope tv_env cv_env) tv of\n        (TCvSubst in_scope' tv_env' cv_env', tv')\n           -> (Subst in_scope' id_env tv_env' cv_env', tv')\n\ncloneTyVarBndr :: Subst -> TyVar -> Unique -> (Subst, TyVar)\ncloneTyVarBndr (Subst in_scope id_env tv_env cv_env) tv uniq\n  = case Type.cloneTyVarBndr (TCvSubst in_scope tv_env cv_env) tv uniq of\n        (TCvSubst in_scope' tv_env' cv_env', tv')\n           -> (Subst in_scope' id_env tv_env' cv_env', tv')\n\nsubstCoVarBndr :: Subst -> TyVar -> (Subst, TyVar)\nsubstCoVarBndr (Subst in_scope id_env tv_env cv_env) cv\n  = case Coercion.substCoVarBndr (TCvSubst in_scope tv_env cv_env) cv of\n        (TCvSubst in_scope' tv_env' cv_env', cv')\n           -> (Subst in_scope' id_env tv_env' cv_env', cv')\n\n-- | See 'Type.substTy'\nsubstTy :: Subst -> Type -> Type\nsubstTy subst ty = Type.substTyUnchecked (getTCvSubst subst) ty\n\ngetTCvSubst :: Subst -> TCvSubst\ngetTCvSubst (Subst in_scope _ tenv cenv) = TCvSubst in_scope tenv cenv\n\n-- | See 'Coercion.substCo'\nsubstCo :: Subst -> Coercion -> Coercion\nsubstCo subst co = Coercion.substCo (getTCvSubst subst) co\n\n{-\n************************************************************************\n*                                                                      *\n\\section{IdInfo substitution}\n*                                                                      *\n************************************************************************\n-}\n\nsubstIdType :: Subst -> Id -> Id\nsubstIdType subst@(Subst _ _ tv_env cv_env) id\n  | (isEmptyVarEnv tv_env && isEmptyVarEnv cv_env) || noFreeVarsOfType old_ty = id\n  | otherwise   = setIdType id (substTy subst old_ty)\n                -- The tyCoVarsOfType is cheaper than it looks\n                -- because we cache the free tyvars of the type\n                -- in a Note in the id's type itself\n  where\n    old_ty = idType id\n\n------------------\n-- | Substitute into some 'IdInfo' with regard to the supplied new 'Id'.\nsubstIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo\nsubstIdInfo subst new_id info\n  | nothing_to_do = Nothing\n  | otherwise     = Just (info `setRuleInfo`      substSpec subst new_id old_rules\n                               `setUnfoldingInfo` substUnfolding subst old_unf)\n  where\n    old_rules     = ruleInfo info\n    old_unf       = unfoldingInfo info\n    nothing_to_do = isEmptyRuleInfo old_rules && not (isFragileUnfolding old_unf)\n\n------------------\n-- | Substitutes for the 'Id's within an unfolding\nsubstUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding\n        -- Seq'ing on the returned Unfolding is enough to cause\n        -- all the substitutions to happen completely\n\nsubstUnfoldingSC subst unf       -- Short-cut version\n  | isEmptySubst subst = unf\n  | otherwise          = substUnfolding subst unf\n\nsubstUnfolding subst df@(DFunUnfolding { df_bndrs = bndrs, df_args = args })\n  = df { df_bndrs = bndrs', df_args = args' }\n  where\n    (subst',bndrs') = substBndrs subst bndrs\n    args'           = map (substExpr (text \"subst-unf:dfun\") subst') args\n\nsubstUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src })\n        -- Retain an InlineRule!\n  | not (isStableSource src)  -- Zap an unstable unfolding, to save substitution work\n  = NoUnfolding\n  | otherwise                 -- But keep a stable one!\n  = seqExpr new_tmpl `seq`\n    unf { uf_tmpl = new_tmpl }\n  where\n    new_tmpl = substExpr (text \"subst-unf\") subst tmpl\n\nsubstUnfolding _ unf = unf      -- NoUnfolding, OtherCon\n\n------------------\nsubstIdOcc :: Subst -> Id -> Id\n-- These Ids should not be substituted to non-Ids\nsubstIdOcc subst v = case lookupIdSubst (text \"substIdOcc\") subst v of\n                        Var v' -> v'\n                        other  -> pprPanic \"substIdOcc\" (vcat [ppr v <+> ppr other, ppr subst])\n\n------------------\n-- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'\nsubstSpec :: Subst -> Id -> RuleInfo -> RuleInfo\nsubstSpec subst new_id (RuleInfo rules rhs_fvs)\n  = seqRuleInfo new_spec `seq` new_spec\n  where\n    subst_ru_fn = const (idName new_id)\n    new_spec = RuleInfo (map (substRule subst subst_ru_fn) rules)\n                        (substDVarSet subst rhs_fvs)\n\n------------------\nsubstRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]\nsubstRulesForImportedIds subst rules\n  = map (substRule subst not_needed) rules\n  where\n    not_needed name = pprPanic \"substRulesForImportedIds\" (ppr name)\n\n------------------\nsubstRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule\n\n-- The subst_ru_fn argument is applied to substitute the ru_fn field\n-- of the rule:\n--    - Rules for *imported* Ids never change ru_fn\n--    - Rules for *local* Ids are in the IdInfo for that Id,\n--      and the ru_fn field is simply replaced by the new name\n--      of the Id\nsubstRule _ _ rule@(BuiltinRule {}) = rule\nsubstRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args\n                                       , ru_fn = fn_name, ru_rhs = rhs\n                                       , ru_local = is_local })\n  = rule { ru_bndrs = bndrs'\n         , ru_fn    = if is_local\n                        then subst_ru_fn fn_name\n                        else fn_name\n         , ru_args  = map (substExpr doc subst') args\n         , ru_rhs   = substExpr (text \"foo\") subst' rhs }\n           -- Do NOT optimise the RHS (previously we did simplOptExpr here)\n           -- See Note [Substitute lazily]\n  where\n    doc = text \"subst-rule\" <+> ppr fn_name\n    (subst', bndrs') = substBndrs subst bndrs\n\n------------------\nsubstDVarSet :: Subst -> DVarSet -> DVarSet\nsubstDVarSet subst fvs\n  = mkDVarSet $ fst $ foldr (subst_fv subst) ([], emptyVarSet) $ dVarSetElems fvs\n  where\n  subst_fv subst fv acc\n     | isId fv = expr_fvs (lookupIdSubst (text \"substDVarSet\") subst fv) isLocalVar emptyVarSet $! acc\n     | otherwise = tyCoFVsOfType (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc\n\n------------------\nsubstTickish :: Subst -> Tickish Id -> Tickish Id\nsubstTickish subst (Breakpoint n ids)\n   = Breakpoint n (map do_one ids)\n where\n    do_one = getIdFromTrivialExpr . lookupIdSubst (text \"subst_tickish\") subst\nsubstTickish _subst other = other\n\n{- Note [Substitute lazily]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe functions that substitute over IdInfo must be pretty lazy, because\nthey are knot-tied by substRecBndrs.\n\nOne case in point was Trac #10627 in which a rule for a function 'f'\nreferred to 'f' (at a different type) on the RHS.  But instead of just\nsubstituting in the rhs of the rule, we were calling simpleOptExpr, which\nlooked at the idInfo for 'f'; result <<loop>>.\n\nIn any case we don't need to optimise the RHS of rules, or unfoldings,\nbecause the simplifier will do that.\n\n\nNote [substTickish]\n~~~~~~~~~~~~~~~~~~~~~~\nA Breakpoint contains a list of Ids.  What happens if we ever want to\nsubstitute an expression for one of these Ids?\n\nFirst, we ensure that we only ever substitute trivial expressions for\nthese Ids, by marking them as NoOccInfo in the occurrence analyser.\nThen, when substituting for the Id, we unwrap any type applications\nand abstractions to get back to an Id, with getIdFromTrivialExpr.\n\nSecond, we have to ensure that we never try to substitute a literal\nfor an Id in a breakpoint.  We ensure this by never storing an Id with\nan unlifted type in a Breakpoint - see Coverage.mkTickish.\nBreakpoints can't handle free variables with unlifted types anyway.\n-}\n\n{-\nNote [Worker inlining]\n~~~~~~~~~~~~~~~~~~~~~~\nA worker can get sustituted away entirely.\n        - it might be trivial\n        - it might simply be very small\nWe do not treat an InlWrapper as an 'occurrence' in the occurrence\nanalyser, so it's possible that the worker is not even in scope any more.\n\nIn all all these cases we simply drop the special case, returning to\nInlVanilla.  The WARN is just so I can see if it happens a lot.\n-}\n\n", "num_lines": 759}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts #-}\n{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE BangPatterns #-}\n\n-- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection\nmodule CoreSyn (\n        -- * Main data types\n        Expr(..), Alt, Bind(..), AltCon(..), Arg,\n        Tickish(..), TickishScoping(..), TickishPlacement(..),\n        CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,\n        TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,\n\n        -- * In/Out type synonyms\n        InId, InBind, InExpr, InAlt, InArg, InType, InKind,\n               InBndr, InVar, InCoercion, InTyVar, InCoVar,\n        OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind,\n               OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar, MOutCoercion,\n\n        -- ** 'Expr' construction\n        mkLet, mkLets, mkLetNonRec, mkLetRec, mkLams,\n        mkApps, mkTyApps, mkCoApps, mkVarApps, mkTyArg,\n\n        mkIntLit, mkIntLitInt,\n        mkWordLit, mkWordLitWord,\n        mkWord64LitWord64, mkInt64LitInt64,\n        mkCharLit, mkStringLit,\n        mkFloatLit, mkFloatLitFloat,\n        mkDoubleLit, mkDoubleLitDouble,\n\n        mkConApp, mkConApp2, mkTyBind, mkCoBind,\n        varToCoreExpr, varsToCoreExprs,\n\n        isId, cmpAltCon, cmpAlt, ltAlt,\n\n        -- ** Simple 'Expr' access functions and predicates\n        bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,\n        collectBinders, collectTyBinders, collectTyAndValBinders,\n        collectNBinders,\n        collectArgs, stripNArgs, collectArgsTicks, flattenBinds,\n\n        exprToType, exprToCoercion_maybe,\n        applyTypeToArg,\n\n        isValArg, isTypeArg, isCoArg, isTyCoArg, valArgCount, valBndrCount,\n        isRuntimeArg, isRuntimeVar,\n\n        -- * Tick-related functions\n        tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,\n        tickishCanSplit, mkNoCount, mkNoScope,\n        tickishIsCode, tickishPlace,\n        tickishContains,\n\n        -- * Unfolding data types\n        Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),\n\n        -- ** Constructing 'Unfolding's\n        noUnfolding, bootUnfolding, evaldUnfolding, mkOtherCon,\n        unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,\n\n        -- ** Predicates and deconstruction on 'Unfolding'\n        unfoldingTemplate, expandUnfolding_maybe,\n        maybeUnfoldingTemplate, otherCons,\n        isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,\n        isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,\n        isStableUnfolding, isFragileUnfolding, hasSomeUnfolding,\n        isBootUnfolding,\n        canUnfold, neverUnfoldGuidance, isStableSource,\n\n        -- * Annotated expression data types\n        AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,\n\n        -- ** Operations on annotated expressions\n        collectAnnArgs, collectAnnArgsTicks,\n\n        -- ** Operations on annotations\n        deAnnotate, deAnnotate', deAnnAlt, deAnnBind,\n        collectAnnBndrs, collectNAnnBndrs,\n\n        -- * Orphanhood\n        IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor,\n\n        -- * Core rule data types\n        CoreRule(..), RuleBase,\n        RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,\n        RuleEnv(..), mkRuleEnv, emptyRuleEnv,\n\n        -- ** Operations on 'CoreRule's\n        ruleArity, ruleName, ruleIdName, ruleActivation,\n        setRuleIdName, ruleModule,\n        isBuiltinRule, isLocalRule, isAutoRule,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CostCentre\nimport VarEnv( InScopeSet )\nimport Var\nimport Type\nimport Coercion\nimport Name\nimport NameSet\nimport NameEnv( NameEnv, emptyNameEnv )\nimport Literal\nimport DataCon\nimport Module\nimport BasicTypes\nimport DynFlags\nimport Outputable\nimport Util\nimport UniqSet\nimport SrcLoc     ( RealSrcSpan, containsSpan )\nimport Binary\n\nimport Data.Data hiding (TyCon)\nimport Data.Int\nimport Data.Word\n\ninfixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`\n-- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The main data types}\n*                                                                      *\n************************************************************************\n\nThese data types are the heart of the compiler\n-}\n\n-- | This is the data type that represents GHCs core intermediate language. Currently\n-- GHC uses System FC <https://www.microsoft.com/en-us/research/publication/system-f-with-type-equality-coercions/> for this purpose,\n-- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.\n--\n-- We get from Haskell source to this Core language in a number of stages:\n--\n-- 1. The source code is parsed into an abstract syntax tree, which is represented\n--    by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'\n--\n-- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'\n--    (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.\n--    For example, this program:\n--\n-- @\n--      f x = let f x = x + 1\n--            in f (x - 2)\n-- @\n--\n--    Would be renamed by having 'Unique's attached so it looked something like this:\n--\n-- @\n--      f_1 x_2 = let f_3 x_4 = x_4 + 1\n--                in f_3 (x_2 - 2)\n-- @\n--    But see Note [Shadowing] below.\n--\n-- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating\n--    type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.\n--\n-- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into\n--    this 'Expr' type, which has far fewer constructors and hence is easier to perform\n--    optimization, analysis and code generation on.\n--\n-- The type parameter @b@ is for the type of binders in the expression tree.\n--\n-- The language consists of the following elements:\n--\n-- *  Variables\n--    See Note [Variable occurrences in Core]\n--\n-- *  Primitive literals\n--\n-- *  Applications: note that the argument may be a 'Type'.\n--    See Note [CoreSyn let/app invariant]\n--    See Note [Levity polymorphism invariants]\n--\n-- *  Lambda abstraction\n--    See Note [Levity polymorphism invariants]\n--\n-- *  Recursive and non recursive @let@s. Operationally\n--    this corresponds to allocating a thunk for the things\n--    bound and then executing the sub-expression.\n--\n--    See Note [CoreSyn letrec invariant]\n--    See Note [CoreSyn let/app invariant]\n--    See Note [Levity polymorphism invariants]\n--    See Note [CoreSyn type and coercion invariant]\n--\n-- *  Case expression. Operationally this corresponds to evaluating\n--    the scrutinee (expression examined) to weak head normal form\n--    and then examining at most one level of resulting constructor (i.e. you\n--    cannot do nested pattern matching directly with this).\n--\n--    The binder gets bound to the value of the scrutinee,\n--    and the 'Type' must be that of all the case alternatives\n--\n--    #case_invariants#\n--    This is one of the more complicated elements of the Core language,\n--    and comes with a number of restrictions:\n--\n--    1. The list of alternatives may be empty;\n--       See Note [Empty case alternatives]\n--\n--    2. The 'DEFAULT' case alternative must be first in the list,\n--       if it occurs at all.\n--\n--    3. The remaining cases are in order of increasing\n--         tag  (for 'DataAlts') or\n--         lit  (for 'LitAlts').\n--       This makes finding the relevant constructor easy,\n--       and makes comparison easier too.\n--\n--    4. The list of alternatives must be exhaustive. An /exhaustive/ case\n--       does not necessarily mention all constructors:\n--\n--       @\n--            data Foo = Red | Green | Blue\n--       ... case x of\n--            Red   -> True\n--            other -> f (case x of\n--                            Green -> ...\n--                            Blue  -> ... ) ...\n--       @\n--\n--       The inner case does not need a @Red@ alternative, because @x@\n--       can't be @Red@ at that program point.\n--\n--    5. Floating-point values must not be scrutinised against literals.\n--       See Trac #9238 and Note [Rules for floating-point comparisons]\n--       in PrelRules for rationale.\n--\n-- *  Cast an expression to a particular type.\n--    This is used to implement @newtype@s (a @newtype@ constructor or\n--    destructor just becomes a 'Cast' in Core) and GADTs.\n--\n-- *  Notes. These allow general information to be added to expressions\n--    in the syntax tree\n--\n-- *  A type: this should only show up at the top level of an Arg\n--\n-- *  A coercion\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata Expr b\n  = Var   Id\n  | Lit   Literal\n  | App   (Expr b) (Arg b)\n  | Lam   b (Expr b)\n  | Let   (Bind b) (Expr b)\n  | Case  (Expr b) b Type [Alt b]       -- See #case_invariants#\n  | Cast  (Expr b) Coercion\n  | Tick  (Tickish Id) (Expr b)\n  | Type  Type\n  | Coercion Coercion\n  deriving Data\n\n-- | Type synonym for expressions that occur in function argument positions.\n-- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not\ntype Arg b = Expr b\n\n-- | A case split alternative. Consists of the constructor leading to the alternative,\n-- the variables bound from the constructor, and the expression to be executed given that binding.\n-- The default alternative is @(DEFAULT, [], rhs)@\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ntype Alt b = (AltCon, [b], Expr b)\n\n-- | A case alternative constructor (i.e. pattern match)\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata AltCon\n  = DataAlt DataCon   --  ^ A plain data constructor: @case e of { Foo x -> ... }@.\n                      -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@\n\n  | LitAlt  Literal   -- ^ A literal: @case e of { 1 -> ... }@\n                      -- Invariant: always an *unlifted* literal\n                      -- See Note [Literal alternatives]\n\n  | DEFAULT           -- ^ Trivial alternative: @case e of { _ -> ... }@\n   deriving (Eq, Data)\n\n-- This instance is a bit shady. It can only be used to compare AltCons for\n-- a single type constructor. Fortunately, it seems quite unlikely that we'll\n-- ever need to compare AltCons for different type constructors.\n-- The instance adheres to the order described in [CoreSyn case invariants]\ninstance Ord AltCon where\n  compare (DataAlt con1) (DataAlt con2) =\n    ASSERT( dataConTyCon con1 == dataConTyCon con2 )\n    compare (dataConTag con1) (dataConTag con2)\n  compare (DataAlt _) _ = GT\n  compare _ (DataAlt _) = LT\n  compare (LitAlt l1) (LitAlt l2) = compare l1 l2\n  compare (LitAlt _) DEFAULT = GT\n  compare DEFAULT DEFAULT = EQ\n  compare DEFAULT _ = LT\n\n-- | Binding, used for top level bindings in a module and local bindings in a @let@.\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata Bind b = NonRec b (Expr b)\n            | Rec [(b, (Expr b))]\n  deriving Data\n\n{-\nNote [Shadowing]\n~~~~~~~~~~~~~~~~\nWhile various passes attempt to rename on-the-fly in a manner that\navoids \"shadowing\" (thereby simplifying downstream optimizations),\nneither the simplifier nor any other pass GUARANTEES that shadowing is\navoided. Thus, all passes SHOULD work fine even in the presence of\narbitrary shadowing in their inputs.\n\nIn particular, scrutinee variables `x` in expressions of the form\n`Case e x t` are often renamed to variables with a prefix\n\"wild_\". These \"wild\" variables may appear in the body of the\ncase-expression, and further, may be shadowed within the body.\n\nSo the Unique in a Var is not really unique at all.  Still, it's very\nuseful to give a constant-time equality/ordering for Vars, and to give\na key that can be used to make sets of Vars (VarSet), or mappings from\nVars to other things (VarEnv).   Moreover, if you do want to eliminate\nshadowing, you can give a new Unique to an Id without changing its\nprintable name, which makes debugging easier.\n\nNote [Literal alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLiteral alternatives (LitAlt lit) are always for *un-lifted* literals.\nWe have one literal, a literal Integer, that is lifted, and we don't\nallow in a LitAlt, because LitAlt cases don't do any evaluation. Also\n(see Trac #5603) if you say\n    case 3 of\n      S# x -> ...\n      J# _ _ -> ...\n(where S#, J# are the constructors for Integer) we don't want the\nsimplifier calling findAlt with argument (LitAlt 3).  No no.  Integer\nliterals are an opaque encoding of an algebraic data type, not of\nan unlifted literal, like all the others.\n\nAlso, we do not permit case analysis with literal patterns on floating-point\ntypes. See Trac #9238 and Note [Rules for floating-point comparisons] in\nPrelRules for the rationale for this restriction.\n\n-------------------------- CoreSyn INVARIANTS ---------------------------\n\nNote [Variable occurrences in Core]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nVariable /occurrences/ are never CoVars, though /bindings/ can be.\nAll CoVars appear in Coercions.\n\nFor example\n  \\(c :: Age~#Int) (d::Int). d |> (sym c)\nHere 'c' is a CoVar, which is lambda-bound, but it /occurs/ in\na Coercion, (sym c).\n\nNote [CoreSyn letrec invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe right hand sides of all top-level and recursive @let@s\n/must/ be of lifted type (see \"Type#type_classification\" for\nthe meaning of /lifted/ vs. /unlifted/).\n\nThere is one exception to this rule, top-level @let@s are\nallowed to bind primitive string literals: see\nNote [CoreSyn top-level string literals].\n\nNote [CoreSyn top-level string literals]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs an exception to the usual rule that top-level binders must be lifted,\nwe allow binding primitive string literals (of type Addr#) of type Addr# at the\ntop level. This allows us to share string literals earlier in the pipeline and\ncrucially allows other optimizations in the Core2Core pipeline to fire.\nConsider,\n\n  f n = let a::Addr# = \"foo\"#\n        in \\x -> blah\n\nIn order to be able to inline `f`, we would like to float `a` to the top.\nAnother option would be to inline `a`, but that would lead to duplicating string\nliterals, which we want to avoid. See Trac #8472.\n\nThe solution is simply to allow top-level unlifted binders. We can't allow\narbitrary unlifted expression at the top-level though, unlifted binders cannot\nbe thunks, so we just allow string literals.\n\nWe allow the top-level primitive string literals to be wrapped in Ticks\nin the same way they can be wrapped when nested in an expression.\nCoreToSTG currently discards Ticks around top-level primitive string literals.\nSee Trac #14779.\n\nAlso see Note [Compilation plan for top-level string literals].\n\nNote [Compilation plan for top-level string literals]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere is a summary on how top-level string literals are handled by various\nparts of the compilation pipeline.\n\n* In the source language, there is no way to bind a primitive string literal\n  at the top level.\n\n* In Core, we have a special rule that permits top-level Addr# bindings. See\n  Note [CoreSyn top-level string literals]. Core-to-core passes may introduce\n  new top-level string literals.\n\n* In STG, top-level string literals are explicitly represented in the syntax\n  tree.\n\n* A top-level string literal may end up exported from a module. In this case,\n  in the object file, the content of the exported literal is given a label with\n  the _bytes suffix.\n\nNote [CoreSyn let/app invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe let/app invariant\n     the right hand side of a non-recursive 'Let', and\n     the argument of an 'App',\n    /may/ be of unlifted type, but only if\n    the expression is ok-for-speculation\n    or the 'Let' is for a join point.\n\nThis means that the let can be floated around\nwithout difficulty. For example, this is OK:\n\n   y::Int# = x +# 1#\n\nBut this is not, as it may affect termination if the\nexpression is floated out:\n\n   y::Int# = fac 4#\n\nIn this situation you should use @case@ rather than a @let@. The function\n'CoreUtils.needsCaseBinding' can help you determine which to generate, or\nalternatively use 'MkCore.mkCoreLet' rather than this constructor directly,\nwhich will generate a @case@ if necessary\n\nThe let/app invariant is initially enforced by mkCoreLet and mkCoreApp in\ncoreSyn/MkCore.\n\nNote [CoreSyn type and coercion invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe allow a /non-recursive/, /non-top-level/ let to bind type and\ncoercion variables.  These can be very convenient for postponing type\nsubstitutions until the next run of the simplifier.\n\n* A type variable binding must have a RHS of (Type ty)\n\n* A coercion variable binding must have a RHS of (Coercion co)\n\n  It is possible to have terms that return a coercion, but we use\n  case-binding for those; e.g.\n     case (eq_sel d) of (co :: a ~# b) -> blah\n  where eq_sel :: (a~b) -> (a~#b)\n\n  Or even even\n      case (df @Int) of (co :: a ~# b) -> blah\n  Which is very exotic, and I think never encountered; but see\n  Note [Equality superclasses in quantified constraints]\n  in TcCanonical\n\nNote [CoreSyn case invariants]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee #case_invariants#\n\nNote [Levity polymorphism invariants]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe levity-polymorphism invariants are these (as per \"Levity Polymorphism\",\nPLDI '17):\n\n* The type of a term-binder must not be levity-polymorphic,\n  unless it is a let(rec)-bound join point\n     (see Note [Invariants on join points])\n\n* The type of the argument of an App must not be levity-polymorphic.\n\nA type (t::TYPE r) is \"levity polymorphic\" if 'r' has any free variables.\n\nFor example\n  \\(r::RuntimeRep). \\(a::TYPE r). \\(x::a). e\nis illegal because x's type has kind (TYPE r), which has 'r' free.\n\nSee Note [Levity polymorphism checking] in DsMonad to see where these\ninvariants are established for user-written code.\n\nNote [CoreSyn let goal]\n~~~~~~~~~~~~~~~~~~~~~~~\n* The simplifier tries to ensure that if the RHS of a let is a constructor\n  application, its arguments are trivial, so that the constructor can be\n  inlined vigorously.\n\nNote [Type let]\n~~~~~~~~~~~~~~~\nSee #type_let#\n\nNote [Empty case alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe alternatives of a case expression should be exhaustive.  But\nthis exhaustive list can be empty!\n\n* A case expression can have empty alternatives if (and only if) the\n  scrutinee is bound to raise an exception or diverge. When do we know\n  this?  See Note [Bottoming expressions] in CoreUtils.\n\n* The possibility of empty alternatives is one reason we need a type on\n  the case expression: if the alternatives are empty we can't get the\n  type from the alternatives!\n\n* In the case of empty types (see Note [Bottoming expressions]), say\n    data T\n  we do NOT want to replace\n    case (x::T) of Bool {}   -->   error Bool \"Inaccessible case\"\n  because x might raise an exception, and *that*'s what we want to see!\n  (Trac #6067 is an example.) To preserve semantics we'd have to say\n     x `seq` error Bool \"Inaccessible case\"\n  but the 'seq' is just a case, so we are back to square 1.  Or I suppose\n  we could say\n     x |> UnsafeCoerce T Bool\n  but that loses all trace of the fact that this originated with an empty\n  set of alternatives.\n\n* We can use the empty-alternative construct to coerce error values from\n  one type to another.  For example\n\n    f :: Int -> Int\n    f n = error \"urk\"\n\n    g :: Int -> (# Char, Bool #)\n    g x = case f x of { 0 -> ..., n -> ... }\n\n  Then if we inline f in g's RHS we get\n    case (error Int \"urk\") of (# Char, Bool #) { ... }\n  and we can discard the alternatives since the scrutinee is bottom to give\n    case (error Int \"urk\") of (# Char, Bool #) {}\n\n  This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),\n  if for no other reason that we don't need to instantiate the (~) at an\n  unboxed type.\n\n* We treat a case expression with empty alternatives as trivial iff\n  its scrutinee is (see CoreUtils.exprIsTrivial).  This is actually\n  important; see Note [Empty case is trivial] in CoreUtils\n\n* An empty case is replaced by its scrutinee during the CoreToStg\n  conversion; remember STG is un-typed, so there is no need for\n  the empty case to do the type conversion.\n\nNote [Join points]\n~~~~~~~~~~~~~~~~~~\nIn Core, a *join point* is a specially tagged function whose only occurrences\nare saturated tail calls. A tail call can appear in these places:\n\n  1. In the branches (not the scrutinee) of a case\n  2. Underneath a let (value or join point)\n  3. Inside another join point\n\nWe write a join-point declaration as\n  join j @a @b x y = e1 in e2,\nlike a let binding but with \"join\" instead (or \"join rec\" for \"let rec\"). Note\nthat we put the parameters before the = rather than using lambdas; this is\nbecause it's relevant how many parameters the join point takes *as a join\npoint.* This number is called the *join arity,* distinct from arity because it\ncounts types as well as values. Note that a join point may return a lambda! So\n  join j x = x + 1\nis different from\n  join j = \\x -> x + 1\nThe former has join arity 1, while the latter has join arity 0.\n\nThe identifier for a join point is called a join id or a *label.* An invocation\nis called a *jump.* We write a jump using the jump keyword:\n\n  jump j 3\n\nThe words *label* and *jump* are evocative of assembly code (or Cmm) for a\nreason: join points are indeed compiled as labeled blocks, and jumps become\nactual jumps (plus argument passing and stack adjustment). There is no closure\nallocated and only a fraction of the function-call overhead. Hence we would\nlike as many functions as possible to become join points (see OccurAnal) and\nthe type rules for join points ensure we preserve the properties that make them\nefficient.\n\nIn the actual AST, a join point is indicated by the IdDetails of the binder: a\nlocal value binding gets 'VanillaId' but a join point gets a 'JoinId' with its\njoin arity.\n\nFor more details, see the paper:\n\n  Luke Maurer, Paul Downen, Zena Ariola, and Simon Peyton Jones. \"Compiling\n  without continuations.\" Submitted to PLDI'17.\n\n  https://www.microsoft.com/en-us/research/publication/compiling-without-continuations/\n\nNote [Invariants on join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nJoin points must follow these invariants:\n\n  1. All occurrences must be tail calls. Each of these tail calls must pass the\n     same number of arguments, counting both types and values; we call this the\n     \"join arity\" (to distinguish from regular arity, which only counts values).\n\n  2. For join arity n, the right-hand side must begin with at least n lambdas.\n     No ticks, no casts, just lambdas!  C.f. CoreUtils.joinRhsArity.\n\n  2a. Moreover, this same constraint applies to any unfolding of the binder.\n     Reason: if we want to push a continuation into the RHS we must push it\n     into the unfolding as well.\n\n  3. If the binding is recursive, then all other bindings in the recursive group\n     must also be join points.\n\n  4. The binding's type must not be polymorphic in its return type (as defined\n     in Note [The polymorphism rule of join points]).\n\nHowever, join points have simpler invariants in other ways\n\n  5. A join point can have an unboxed type without the RHS being\n     ok-for-speculation (i.e. drop the let/app invariant)\n     e.g.  let j :: Int# = factorial x in ...\n\n  6. A join point can have a levity-polymorphic RHS\n     e.g.  let j :: r :: TYPE l = fail void# in ...\n     This happened in an intermediate program Trac #13394\n\nExamples:\n\n  join j1  x = 1 + x in jump j (jump j x)  -- Fails 1: non-tail call\n  join j1' x = 1 + x in if even a\n                          then jump j1 a\n                          else jump j1 a b -- Fails 1: inconsistent calls\n  join j2  x = flip (+) x in j2 1 2        -- Fails 2: not enough lambdas\n  join j2' x = \\y -> x + y in j3 1         -- Passes: extra lams ok\n  join j @a (x :: a) = x                   -- Fails 4: polymorphic in ret type\n\nInvariant 1 applies to left-hand sides of rewrite rules, so a rule for a join\npoint must have an exact call as its LHS.\n\nStrictly speaking, invariant 3 is redundant, since a call from inside a lazy\nbinding isn't a tail call. Since a let-bound value can't invoke a free join\npoint, then, they can't be mutually recursive. (A Core binding group *can*\ninclude spurious extra bindings if the occurrence analyser hasn't run, so\ninvariant 3 does still need to be checked.) For the rigorous definition of\n\"tail call\", see Section 3 of the paper (Note [Join points]).\n\nInvariant 4 is subtle; see Note [The polymorphism rule of join points].\n\nCore Lint will check these invariants, anticipating that any binder whose\nOccInfo is marked AlwaysTailCalled will become a join point as soon as the\nsimplifier (or simpleOptPgm) runs.\n\nNote [The type of a join point]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA join point has the same type it would have as a function. That is, if it takes\nan Int and a Bool and its body produces a String, its type is `Int -> Bool ->\nString`. Natural as this may seem, it can be awkward. A join point shouldn't be\nthought to \"return\" in the same sense a function does---a jump is one-way. This\nis crucial for understanding how case-of-case interacts with join points:\n\n  case (join\n          j :: Int -> Bool -> String\n          j x y = ...\n        in\n          jump j z w) of\n    \"\" -> True\n    _  -> False\n\nThe simplifier will pull the case into the join point (see Note [Case-of-case\nand join points] in Simplify):\n\n  join\n    j :: Int -> Bool -> Bool -- changed!\n    j x y = case ... of \"\" -> True\n                        _  -> False\n  in\n    jump j z w\n\nThe body of the join point now returns a Bool, so the label `j` has to have its\ntype updated accordingly. Inconvenient though this may be, it has the advantage\nthat 'CoreUtils.exprType' can still return a type for any expression, including\na jump.\n\nThis differs from the paper (see Note [Invariants on join points]). In the\npaper, we instead give j the type `Int -> Bool -> forall a. a`. Then each jump\ncarries the \"return type\" as a parameter, exactly the way other non-returning\nfunctions like `error` work:\n\n  case (join\n          j :: Int -> Bool -> forall a. a\n          j x y = ...\n        in\n          jump j z w @String) of\n    \"\" -> True\n    _  -> False\n\nNow we can move the case inward and we only have to change the jump:\n\n  join\n    j :: Int -> Bool -> forall a. a\n    j x y = case ... of \"\" -> True\n                        _  -> False\n  in\n    jump j z w @Bool\n\n(Core Lint would still check that the body of the join point has the right type;\nthat type would simply not be reflected in the join id.)\n\nNote [The polymorphism rule of join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInvariant 4 of Note [Invariants on join points] forbids a join point to be\npolymorphic in its return type. That is, if its type is\n\n  forall a1 ... ak. t1 -> ... -> tn -> r\n\nwhere its join arity is k+n, none of the type parameters ai may occur free in r.\n\nIn some way, this falls out of the fact that given\n\n  join\n     j @a1 ... @ak x1 ... xn = e1\n  in e2\n\nthen all calls to `j` are in tail-call positions of `e`, and expressions in\ntail-call positions in `e` have the same type as `e`.\nTherefore the type of `e1` -- the return type of the join point -- must be the\nsame as the type of e2.\nSince the type variables aren't bound in `e2`, its type can't include them, and\nthus neither can the type of `e1`.\n\nThis unfortunately prevents the `go` in the following code from being a\njoin-point:\n\n  iter :: forall a. Int -> (a -> a) -> a -> a\n  iter @a n f x = go @a n f x\n    where\n      go :: forall a. Int -> (a -> a) -> a -> a\n      go @a 0 _ x = x\n      go @a n f x = go @a (n-1) f (f x)\n\nIn this case, a static argument transformation would fix that (see\nticket #14620):\n\n  iter :: forall a. Int -> (a -> a) -> a -> a\n  iter @a n f x = go' @a n f x\n    where\n      go' :: Int -> (a -> a) -> a -> a\n      go' 0 _ x = x\n      go' n f x = go' (n-1) f (f x)\n\nIn general, loopification could be employed to do that (see #14068.)\n\nCan we simply drop the requirement, and allow `go` to be a join-point? We\ncould, and it would work. But we could not longer apply the case-of-join-point\ntransformation universally. This transformation would do:\n\n  case (join go @a n f x = case n of 0 -> x\n                                     n -> go @a (n-1) f (f x)\n        in go @Bool n neg True) of\n    True -> e1; False -> e2\n\n ===>\n\n  join go @a n f x = case n of 0 -> case x of True -> e1; False -> e2\n                          n -> go @a (n-1) f (f x)\n  in go @Bool n neg True\n\nbut that is ill-typed, as `x` is type `a`, not `Bool`.\n\n\nThis also justifies why we do not consider the `e` in `e |> co` to be in\ntail position: A cast changes the type, but the type must be the same. But\noperationally, casts are vacuous, so this is a bit unfortunate! See #14610 for\nideas how to fix this.\n\n************************************************************************\n*                                                                      *\n            In/Out type synonyms\n*                                                                      *\n********************************************************************* -}\n\n{- Many passes apply a substitution, and it's very handy to have type\n   synonyms to remind us whether or not the substitution has been applied -}\n\n-- Pre-cloning or substitution\ntype InBndr     = CoreBndr\ntype InType     = Type\ntype InKind     = Kind\ntype InBind     = CoreBind\ntype InExpr     = CoreExpr\ntype InAlt      = CoreAlt\ntype InArg      = CoreArg\ntype InCoercion = Coercion\n\n-- Post-cloning or substitution\ntype OutBndr     = CoreBndr\ntype OutType     = Type\ntype OutKind     = Kind\ntype OutCoercion = Coercion\ntype OutBind     = CoreBind\ntype OutExpr     = CoreExpr\ntype OutAlt      = CoreAlt\ntype OutArg      = CoreArg\ntype MOutCoercion = MCoercion\n\n\n{- *********************************************************************\n*                                                                      *\n              Ticks\n*                                                                      *\n************************************************************************\n-}\n\n-- | Allows attaching extra information to points in expressions\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata Tickish id =\n    -- | An @{-# SCC #-}@ profiling annotation, either automatically\n    -- added by the desugarer as a result of -auto-all, or added by\n    -- the user.\n    ProfNote {\n      profNoteCC    :: CostCentre, -- ^ the cost centre\n      profNoteCount :: !Bool,      -- ^ bump the entry count?\n      profNoteScope :: !Bool       -- ^ scopes over the enclosed expression\n                                   -- (i.e. not just a tick)\n    }\n\n  -- | A \"tick\" used by HPC to track the execution of each\n  -- subexpression in the original source code.\n  | HpcTick {\n      tickModule :: Module,\n      tickId     :: !Int\n    }\n\n  -- | A breakpoint for the GHCi debugger.  This behaves like an HPC\n  -- tick, but has a list of free variables which will be available\n  -- for inspection in GHCi when the program stops at the breakpoint.\n  --\n  -- NB. we must take account of these Ids when (a) counting free variables,\n  -- and (b) substituting (don't substitute for them)\n  | Breakpoint\n    { breakpointId     :: !Int\n    , breakpointFVs    :: [id]  -- ^ the order of this list is important:\n                                -- it matches the order of the lists in the\n                                -- appropriate entry in HscTypes.ModBreaks.\n                                --\n                                -- Careful about substitution!  See\n                                -- Note [substTickish] in CoreSubst.\n    }\n\n  -- | A source note.\n  --\n  -- Source notes are pure annotations: Their presence should neither\n  -- influence compilation nor execution. The semantics are given by\n  -- causality: The presence of a source note means that a local\n  -- change in the referenced source code span will possibly provoke\n  -- the generated code to change. On the flip-side, the functionality\n  -- of annotated code *must* be invariant against changes to all\n  -- source code *except* the spans referenced in the source notes\n  -- (see \"Causality of optimized Haskell\" paper for details).\n  --\n  -- Therefore extending the scope of any given source note is always\n  -- valid. Note that it is still undesirable though, as this reduces\n  -- their usefulness for debugging and profiling. Therefore we will\n  -- generally try only to make use of this property where it is\n  -- necessary to enable optimizations.\n  | SourceNote\n    { sourceSpan :: RealSrcSpan -- ^ Source covered\n    , sourceName :: String      -- ^ Name for source location\n                                --   (uses same names as CCs)\n    }\n\n  deriving (Eq, Ord, Data)\n\n-- | A \"counting tick\" (where tickishCounts is True) is one that\n-- counts evaluations in some way.  We cannot discard a counting tick,\n-- and the compiler should preserve the number of counting ticks as\n-- far as possible.\n--\n-- However, we still allow the simplifier to increase or decrease\n-- sharing, so in practice the actual number of ticks may vary, except\n-- that we never change the value from zero to non-zero or vice versa.\ntickishCounts :: Tickish id -> Bool\ntickishCounts n@ProfNote{} = profNoteCount n\ntickishCounts HpcTick{}    = True\ntickishCounts Breakpoint{} = True\ntickishCounts _            = False\n\n\n-- | Specifies the scoping behaviour of ticks. This governs the\n-- behaviour of ticks that care about the covered code and the cost\n-- associated with it. Important for ticks relating to profiling.\ndata TickishScoping =\n    -- | No scoping: The tick does not care about what code it\n    -- covers. Transformations can freely move code inside as well as\n    -- outside without any additional annotation obligations\n    NoScope\n\n    -- | Soft scoping: We want all code that is covered to stay\n    -- covered.  Note that this scope type does not forbid\n    -- transformations from happening, as long as all results of\n    -- the transformations are still covered by this tick or a copy of\n    -- it. For example\n    --\n    --   let x = tick<...> (let y = foo in bar) in baz\n    --     ===>\n    --   let x = tick<...> bar; y = tick<...> foo in baz\n    --\n    -- Is a valid transformation as far as \"bar\" and \"foo\" is\n    -- concerned, because both still are scoped over by the tick.\n    --\n    -- Note though that one might object to the \"let\" not being\n    -- covered by the tick any more. However, we are generally lax\n    -- with this - constant costs don't matter too much, and given\n    -- that the \"let\" was effectively merged we can view it as having\n    -- lost its identity anyway.\n    --\n    -- Also note that this scoping behaviour allows floating a tick\n    -- \"upwards\" in pretty much any situation. For example:\n    --\n    --   case foo of x -> tick<...> bar\n    --     ==>\n    --   tick<...> case foo of x -> bar\n    --\n    -- While this is always leagl, we want to make a best effort to\n    -- only make us of this where it exposes transformation\n    -- opportunities.\n  | SoftScope\n\n    -- | Cost centre scoping: We don't want any costs to move to other\n    -- cost-centre stacks. This means we not only want no code or cost\n    -- to get moved out of their cost centres, but we also object to\n    -- code getting associated with new cost-centre ticks - or\n    -- changing the order in which they get applied.\n    --\n    -- A rule of thumb is that we don't want any code to gain new\n    -- annotations. However, there are notable exceptions, for\n    -- example:\n    --\n    --   let f = \\y -> foo in tick<...> ... (f x) ...\n    --     ==>\n    --   tick<...> ... foo[x/y] ...\n    --\n    -- In-lining lambdas like this is always legal, because inlining a\n    -- function does not change the cost-centre stack when the\n    -- function is called.\n  | CostCentreScope\n\n  deriving (Eq)\n\n-- | Returns the intended scoping rule for a Tickish\ntickishScoped :: Tickish id -> TickishScoping\ntickishScoped n@ProfNote{}\n  | profNoteScope n        = CostCentreScope\n  | otherwise              = NoScope\ntickishScoped HpcTick{}    = NoScope\ntickishScoped Breakpoint{} = CostCentreScope\n   -- Breakpoints are scoped: eventually we're going to do call\n   -- stacks, but also this helps prevent the simplifier from moving\n   -- breakpoints around and changing their result type (see #1531).\ntickishScoped SourceNote{} = SoftScope\n\n-- | Returns whether the tick scoping rule is at least as permissive\n-- as the given scoping rule.\ntickishScopesLike :: Tickish id -> TickishScoping -> Bool\ntickishScopesLike t scope = tickishScoped t `like` scope\n  where NoScope         `like` _               = True\n        _               `like` NoScope         = False\n        SoftScope       `like` _               = True\n        _               `like` SoftScope       = False\n        CostCentreScope `like` _               = True\n\n-- | Returns @True@ for ticks that can be floated upwards easily even\n-- where it might change execution counts, such as:\n--\n--   Just (tick<...> foo)\n--     ==>\n--   tick<...> (Just foo)\n--\n-- This is a combination of @tickishSoftScope@ and\n-- @tickishCounts@. Note that in principle splittable ticks can become\n-- floatable using @mkNoTick@ -- even though there's currently no\n-- tickish for which that is the case.\ntickishFloatable :: Tickish id -> Bool\ntickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)\n\n-- | Returns @True@ for a tick that is both counting /and/ scoping and\n-- can be split into its (tick, scope) parts using 'mkNoScope' and\n-- 'mkNoTick' respectively.\ntickishCanSplit :: Tickish id -> Bool\ntickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}\n                   = True\ntickishCanSplit _  = False\n\nmkNoCount :: Tickish id -> Tickish id\nmkNoCount n | not (tickishCounts n)   = n\n            | not (tickishCanSplit n) = panic \"mkNoCount: Cannot split!\"\nmkNoCount n@ProfNote{}                = n {profNoteCount = False}\nmkNoCount _                           = panic \"mkNoCount: Undefined split!\"\n\nmkNoScope :: Tickish id -> Tickish id\nmkNoScope n | tickishScoped n == NoScope  = n\n            | not (tickishCanSplit n)     = panic \"mkNoScope: Cannot split!\"\nmkNoScope n@ProfNote{}                    = n {profNoteScope = False}\nmkNoScope _                               = panic \"mkNoScope: Undefined split!\"\n\n-- | Return @True@ if this source annotation compiles to some backend\n-- code. Without this flag, the tickish is seen as a simple annotation\n-- that does not have any associated evaluation code.\n--\n-- What this means that we are allowed to disregard the tick if doing\n-- so means that we can skip generating any code in the first place. A\n-- typical example is top-level bindings:\n--\n--   foo = tick<...> \\y -> ...\n--     ==>\n--   foo = \\y -> tick<...> ...\n--\n-- Here there is just no operational difference between the first and\n-- the second version. Therefore code generation should simply\n-- translate the code as if it found the latter.\ntickishIsCode :: Tickish id -> Bool\ntickishIsCode SourceNote{} = False\ntickishIsCode _tickish     = True  -- all the rest for now\n\n\n-- | Governs the kind of expression that the tick gets placed on when\n-- annotating for example using @mkTick@. If we find that we want to\n-- put a tickish on an expression ruled out here, we try to float it\n-- inwards until we find a suitable expression.\ndata TickishPlacement =\n\n    -- | Place ticks exactly on run-time expressions. We can still\n    -- move the tick through pure compile-time constructs such as\n    -- other ticks, casts or type lambdas. This is the most\n    -- restrictive placement rule for ticks, as all tickishs have in\n    -- common that they want to track runtime processes. The only\n    -- legal placement rule for counting ticks.\n    PlaceRuntime\n\n    -- | As @PlaceRuntime@, but we float the tick through all\n    -- lambdas. This makes sense where there is little difference\n    -- between annotating the lambda and annotating the lambda's code.\n  | PlaceNonLam\n\n    -- | In addition to floating through lambdas, cost-centre style\n    -- tickishs can also be moved from constructors, non-function\n    -- variables and literals. For example:\n    --\n    --   let x = scc<...> C (scc<...> y) (scc<...> 3) in ...\n    --\n    -- Neither the constructor application, the variable or the\n    -- literal are likely to have any cost worth mentioning. And even\n    -- if y names a thunk, the call would not care about the\n    -- evaluation context. Therefore removing all annotations in the\n    -- above example is safe.\n  | PlaceCostCentre\n\n  deriving (Eq)\n\n-- | Placement behaviour we want for the ticks\ntickishPlace :: Tickish id -> TickishPlacement\ntickishPlace n@ProfNote{}\n  | profNoteCount n        = PlaceRuntime\n  | otherwise              = PlaceCostCentre\ntickishPlace HpcTick{}     = PlaceRuntime\ntickishPlace Breakpoint{}  = PlaceRuntime\ntickishPlace SourceNote{}  = PlaceNonLam\n\n-- | Returns whether one tick \"contains\" the other one, therefore\n-- making the second tick redundant.\ntickishContains :: Eq b => Tickish b -> Tickish b -> Bool\ntickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)\n  = containsSpan sp1 sp2 && n1 == n2\n    -- compare the String last\ntickishContains t1 t2\n  = t1 == t2\n\n{-\n************************************************************************\n*                                                                      *\n                Orphans\n*                                                                      *\n************************************************************************\n-}\n\n-- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'\n-- witnessing the instance's non-orphanhood.\n-- See Note [Orphans]\ndata IsOrphan\n  = IsOrphan\n  | NotOrphan OccName -- The OccName 'n' witnesses the instance's non-orphanhood\n                      -- In that case, the instance is fingerprinted as part\n                      -- of the definition of 'n's definition\n    deriving Data\n\n-- | Returns true if 'IsOrphan' is orphan.\nisOrphan :: IsOrphan -> Bool\nisOrphan IsOrphan = True\nisOrphan _ = False\n\n-- | Returns true if 'IsOrphan' is not an orphan.\nnotOrphan :: IsOrphan -> Bool\nnotOrphan NotOrphan{} = True\nnotOrphan _ = False\n\nchooseOrphanAnchor :: NameSet -> IsOrphan\n-- Something (rule, instance) is relate to all the Names in this\n-- list. Choose one of them to be an \"anchor\" for the orphan.  We make\n-- the choice deterministic to avoid gratuitious changes in the ABI\n-- hash (Trac #4012).  Specifically, use lexicographic comparison of\n-- OccName rather than comparing Uniques\n--\n-- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically\n--\nchooseOrphanAnchor local_names\n  | isEmptyNameSet local_names = IsOrphan\n  | otherwise                  = NotOrphan (minimum occs)\n  where\n    occs = map nameOccName $ nonDetEltsUniqSet local_names\n    -- It's OK to use nonDetEltsUFM here, see comments above\n\ninstance Binary IsOrphan where\n    put_ bh IsOrphan = putByte bh 0\n    put_ bh (NotOrphan n) = do\n        putByte bh 1\n        put_ bh n\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return IsOrphan\n            _ -> do\n                n <- get bh\n                return $ NotOrphan n\n\n{-\nNote [Orphans]\n~~~~~~~~~~~~~~\nClass instances, rules, and family instances are divided into orphans\nand non-orphans.  Roughly speaking, an instance/rule is an orphan if\nits left hand side mentions nothing defined in this module.  Orphan-hood\nhas two major consequences\n\n * A module that contains orphans is called an \"orphan module\".  If\n   the module being compiled depends (transitively) on an oprhan\n   module M, then M.hi is read in regardless of whether M is oherwise\n   needed. This is to ensure that we don't miss any instance decls in\n   M.  But it's painful, because it means we need to keep track of all\n   the orphan modules below us.\n\n * A non-orphan is not finger-printed separately.  Instead, for\n   fingerprinting purposes it is treated as part of the entity it\n   mentions on the LHS.  For example\n      data T = T1 | T2\n      instance Eq T where ....\n   The instance (Eq T) is incorprated as part of T's fingerprint.\n\n   In contrast, orphans are all fingerprinted together in the\n   mi_orph_hash field of the ModIface.\n\n   See MkIface.addFingerprints.\n\nOrphan-hood is computed\n  * For class instances:\n      when we make a ClsInst\n    (because it is needed during instance lookup)\n\n  * For rules and family instances:\n       when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)\n                     or IfaceFamInst (MkIface.instanceToIfaceInst)\n-}\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Transformation rules}\n*                                                                      *\n************************************************************************\n\nThe CoreRule type and its friends are dealt with mainly in CoreRules,\nbut CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.\n-}\n\n-- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules\ntype RuleBase = NameEnv [CoreRule]\n        -- The rules are unordered;\n        -- we sort out any overlaps on lookup\n\n-- | A full rule environment which we can apply rules from.  Like a 'RuleBase',\n-- but it also includes the set of visible orphans we use to filter out orphan\n-- rules which are not visible (even though we can see them...)\ndata RuleEnv\n    = RuleEnv { re_base          :: RuleBase\n              , re_visible_orphs :: ModuleSet\n              }\n\nmkRuleEnv :: RuleBase -> [Module] -> RuleEnv\nmkRuleEnv rules vis_orphs = RuleEnv rules (mkModuleSet vis_orphs)\n\nemptyRuleEnv :: RuleEnv\nemptyRuleEnv = RuleEnv emptyNameEnv emptyModuleSet\n\n-- | A 'CoreRule' is:\n--\n-- * \\\"Local\\\" if the function it is a rule for is defined in the\n--   same module as the rule itself.\n--\n-- * \\\"Orphan\\\" if nothing on the LHS is defined in the same module\n--   as the rule itself\ndata CoreRule\n  = Rule {\n        ru_name :: RuleName,            -- ^ Name of the rule, for communication with the user\n        ru_act  :: Activation,          -- ^ When the rule is active\n\n        -- Rough-matching stuff\n        -- see comments with InstEnv.ClsInst( is_cls, is_rough )\n        ru_fn    :: Name,               -- ^ Name of the 'Id.Id' at the head of this rule\n        ru_rough :: [Maybe Name],       -- ^ Name at the head of each argument to the left hand side\n\n        -- Proper-matching stuff\n        -- see comments with InstEnv.ClsInst( is_tvs, is_tys )\n        ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over\n        ru_args  :: [CoreExpr],         -- ^ Left hand side arguments\n\n        -- And the right-hand side\n        ru_rhs   :: CoreExpr,           -- ^ Right hand side of the rule\n                                        -- Occurrence info is guaranteed correct\n                                        -- See Note [OccInfo in unfoldings and rules]\n\n        -- Locality\n        ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated\n                           --               (notably by Specialise or SpecConstr)\n                           --   @False@ <=> generated at the user's behest\n                           -- See Note [Trimming auto-rules] in TidyPgm\n                           -- for the sole purpose of this field.\n\n        ru_origin :: !Module,   -- ^ 'Module' the rule was defined in, used\n                                -- to test if we should see an orphan rule.\n\n        ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan.\n\n        ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is\n                                -- defined in the same module as the rule\n                                -- and is not an implicit 'Id' (like a record selector,\n                                -- class operation, or data constructor).  This\n                                -- is different from 'ru_orphan', where a rule\n                                -- can avoid being an orphan if *any* Name in\n                                -- LHS of the rule was defined in the same\n                                -- module as the rule.\n    }\n\n  -- | Built-in rules are used for constant folding\n  -- and suchlike.  They have no free variables.\n  -- A built-in rule is always visible (there is no such thing as\n  -- an orphan built-in rule.)\n  | BuiltinRule {\n        ru_name  :: RuleName,   -- ^ As above\n        ru_fn    :: Name,       -- ^ As above\n        ru_nargs :: Int,        -- ^ Number of arguments that 'ru_try' consumes,\n                                -- if it fires, including type arguments\n        ru_try   :: RuleFun\n                -- ^ This function does the rewrite.  It given too many\n                -- arguments, it simply discards them; the returned 'CoreExpr'\n                -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args\n    }\n                -- See Note [Extra args in rule matching] in Rules.hs\n\ntype RuleFun = DynFlags -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr\ntype InScopeEnv = (InScopeSet, IdUnfoldingFun)\n\ntype IdUnfoldingFun = Id -> Unfolding\n-- A function that embodies how to unfold an Id if you need\n-- to do that in the Rule.  The reason we need to pass this info in\n-- is that whether an Id is unfoldable depends on the simplifier phase\n\nisBuiltinRule :: CoreRule -> Bool\nisBuiltinRule (BuiltinRule {}) = True\nisBuiltinRule _                = False\n\nisAutoRule :: CoreRule -> Bool\nisAutoRule (BuiltinRule {}) = False\nisAutoRule (Rule { ru_auto = is_auto }) = is_auto\n\n-- | The number of arguments the 'ru_fn' must be applied\n-- to before the rule can match on it\nruleArity :: CoreRule -> Int\nruleArity (BuiltinRule {ru_nargs = n}) = n\nruleArity (Rule {ru_args = args})      = length args\n\nruleName :: CoreRule -> RuleName\nruleName = ru_name\n\nruleModule :: CoreRule -> Maybe Module\nruleModule Rule { ru_origin } = Just ru_origin\nruleModule BuiltinRule {} = Nothing\n\nruleActivation :: CoreRule -> Activation\nruleActivation (BuiltinRule { })       = AlwaysActive\nruleActivation (Rule { ru_act = act }) = act\n\n-- | The 'Name' of the 'Id.Id' at the head of the rule left hand side\nruleIdName :: CoreRule -> Name\nruleIdName = ru_fn\n\nisLocalRule :: CoreRule -> Bool\nisLocalRule = ru_local\n\n-- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side\nsetRuleIdName :: Name -> CoreRule -> CoreRule\nsetRuleIdName nm ru = ru { ru_fn = nm }\n\n{-\n************************************************************************\n*                                                                      *\n                Unfoldings\n*                                                                      *\n************************************************************************\n\nThe @Unfolding@ type is declared here to avoid numerous loops\n-}\n\n-- | Records the /unfolding/ of an identifier, which is approximately the form the\n-- identifier would have if we substituted its definition in for the identifier.\n-- This type should be treated as abstract everywhere except in \"CoreUnfold\"\ndata Unfolding\n  = NoUnfolding        -- ^ We have no information about the unfolding.\n\n  | BootUnfolding      -- ^ We have no information about the unfolding, because\n                       -- this 'Id' came from an @hi-boot@ file.\n                       -- See Note [Inlining and hs-boot files] in ToIface\n                       -- for what this is used for.\n\n  | OtherCon [AltCon]  -- ^ It ain't one of these constructors.\n                       -- @OtherCon xs@ also indicates that something has been evaluated\n                       -- and hence there's no point in re-evaluating it.\n                       -- @OtherCon []@ is used even for non-data-type values\n                       -- to indicated evaluated-ness.  Notably:\n                       --\n                       -- > data C = C !(Int -> Int)\n                       -- > case x of { C f -> ... }\n                       --\n                       -- Here, @f@ gets an @OtherCon []@ unfolding.\n\n  | DFunUnfolding {     -- The Unfolding of a DFunId\n                        -- See Note [DFun unfoldings]\n                        --     df = /\\a1..am. \\d1..dn. MkD t1 .. tk\n                        --                                 (op1 a1..am d1..dn)\n                        --                                 (op2 a1..am d1..dn)\n        df_bndrs :: [Var],      -- The bound variables [a1..m],[d1..dn]\n        df_con   :: DataCon,    -- The dictionary data constructor (never a newtype datacon)\n        df_args  :: [CoreExpr]  -- Args of the data con: types, superclasses and methods,\n    }                           -- in positional order\n\n  | CoreUnfolding {             -- An unfolding for an Id with no pragma,\n                                -- or perhaps a NOINLINE pragma\n                                -- (For NOINLINE, the phase, if any, is in the\n                                -- InlinePragInfo for this Id.)\n        uf_tmpl       :: CoreExpr,        -- Template; occurrence info is correct\n        uf_src        :: UnfoldingSource, -- Where the unfolding came from\n        uf_is_top     :: Bool,          -- True <=> top level binding\n        uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard\n                                        --      a `seq` on this variable\n        uf_is_conlike :: Bool,          -- True <=> applicn of constructor or CONLIKE function\n                                        --      Cached version of exprIsConLike\n        uf_is_work_free :: Bool,                -- True <=> doesn't waste (much) work to expand\n                                        --          inside an inlining\n                                        --      Cached version of exprIsCheap\n        uf_expandable :: Bool,          -- True <=> can expand in RULE matching\n                                        --      Cached version of exprIsExpandable\n        uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.\n    }\n  -- ^ An unfolding with redundant cached information. Parameters:\n  --\n  --  uf_tmpl: Template used to perform unfolding;\n  --           NB: Occurrence info is guaranteed correct:\n  --               see Note [OccInfo in unfoldings and rules]\n  --\n  --  uf_is_top: Is this a top level binding?\n  --\n  --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on\n  --     this variable\n  --\n  --  uf_is_work_free:  Does this waste only a little work if we expand it inside an inlining?\n  --     Basically this is a cached version of 'exprIsWorkFree'\n  --\n  --  uf_guidance:  Tells us about the /size/ of the unfolding template\n\n\n------------------------------------------------\ndata UnfoldingSource\n  = -- See also Note [Historical note: unfoldings for wrappers]\n\n    InlineRhs          -- The current rhs of the function\n                       -- Replace uf_tmpl each time around\n\n  | InlineStable       -- From an INLINE or INLINABLE pragma\n                       --   INLINE     if guidance is UnfWhen\n                       --   INLINABLE  if guidance is UnfIfGoodArgs/UnfoldNever\n                       -- (well, technically an INLINABLE might be made\n                       -- UnfWhen if it was small enough, and then\n                       -- it will behave like INLINE outside the current\n                       -- module, but that is the way automatic unfoldings\n                       -- work so it is consistent with the intended\n                       -- meaning of INLINABLE).\n                       --\n                       -- uf_tmpl may change, but only as a result of\n                       -- gentle simplification, it doesn't get updated\n                       -- to the current RHS during compilation as with\n                       -- InlineRhs.\n                       --\n                       -- See Note [InlineStable]\n\n  | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it\n                       -- Only a few primop-like things have this property\n                       -- (see MkId.hs, calls to mkCompulsoryUnfolding).\n                       -- Inline absolutely always, however boring the context.\n\n\n\n-- | 'UnfoldingGuidance' says when unfolding should take place\ndata UnfoldingGuidance\n  = UnfWhen {   -- Inline without thinking about the *size* of the uf_tmpl\n                -- Used (a) for small *and* cheap unfoldings\n                --      (b) for INLINE functions\n                -- See Note [INLINE for small functions] in CoreUnfold\n      ug_arity    :: Arity,     -- Number of value arguments expected\n\n      ug_unsat_ok  :: Bool,     -- True <=> ok to inline even if unsaturated\n      ug_boring_ok :: Bool      -- True <=> ok to inline even if the context is boring\n                -- So True,True means \"always\"\n    }\n\n  | UnfIfGoodArgs {     -- Arose from a normal Id; the info here is the\n                        -- result of a simple analysis of the RHS\n\n      ug_args ::  [Int],  -- Discount if the argument is evaluated.\n                          -- (i.e., a simplification will definitely\n                          -- be possible).  One elt of the list per *value* arg.\n\n      ug_size :: Int,     -- The \"size\" of the unfolding.\n\n      ug_res :: Int       -- Scrutinee discount: the discount to substract if the thing is in\n    }                     -- a context (case (thing args) of ...),\n                          -- (where there are the right number of arguments.)\n\n  | UnfNever        -- The RHS is big, so don't inline it\n  deriving (Eq)\n\n{-\nNote [Historical note: unfoldings for wrappers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used to have a nice clever scheme in interface files for\nwrappers. A wrapper's unfolding can be reconstructed from its worker's\nid and its strictness. This decreased .hi file size (sometimes\nsignificantly, for modules like GHC.Classes with many high-arity w/w\nsplits) and had a slight corresponding effect on compile times.\n\nHowever, when we added the second demand analysis, this scheme lead to\nsome Core lint errors. The second analysis could change the strictness\nsignatures, which sometimes resulted in a wrapper's regenerated\nunfolding applying the wrapper to too many arguments.\n\nInstead of repairing the clever .hi scheme, we abandoned it in favor\nof simplicity. The .hi sizes are usually insignificant (excluding the\n+1M for base libraries), and compile time barely increases (~+1% for\nnofib). The nicer upshot is that the UnfoldingSource no longer mentions\nan Id, so, eg, substitutions need not traverse them.\n\n\nNote [DFun unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~\nThe Arity in a DFunUnfolding is total number of args (type and value)\nthat the DFun needs to produce a dictionary.  That's not necessarily\nrelated to the ordinary arity of the dfun Id, esp if the class has\none method, so the dictionary is represented by a newtype.  Example\n\n     class C a where { op :: a -> Int }\n     instance C a -> C [a] where op xs = op (head xs)\n\nThe instance translates to\n\n     $dfCList :: forall a. C a => C [a]  -- Arity 2!\n     $dfCList = /\\a.\\d. $copList {a} d |> co\n\n     $copList :: forall a. C a => [a] -> Int  -- Arity 2!\n     $copList = /\\a.\\d.\\xs. op {a} d (head xs)\n\nNow we might encounter (op (dfCList {ty} d) a1 a2)\nand we want the (op (dfList {ty} d)) rule to fire, because $dfCList\nhas all its arguments, even though its (value) arity is 2.  That's\nwhy we record the number of expected arguments in the DFunUnfolding.\n\nNote that although it's an Arity, it's most convenient for it to give\nthe *total* number of arguments, both type and value.  See the use\nsite in exprIsConApp_maybe.\n-}\n\n-- Constants for the UnfWhen constructor\nneedSaturated, unSaturatedOk :: Bool\nneedSaturated = False\nunSaturatedOk = True\n\nboringCxtNotOk, boringCxtOk :: Bool\nboringCxtOk    = True\nboringCxtNotOk = False\n\n------------------------------------------------\nnoUnfolding :: Unfolding\n-- ^ There is no known 'Unfolding'\nevaldUnfolding :: Unfolding\n-- ^ This unfolding marks the associated thing as being evaluated\n\nnoUnfolding    = NoUnfolding\nevaldUnfolding = OtherCon []\n\n-- | There is no known 'Unfolding', because this came from an\n-- hi-boot file.\nbootUnfolding :: Unfolding\nbootUnfolding = BootUnfolding\n\nmkOtherCon :: [AltCon] -> Unfolding\nmkOtherCon = OtherCon\n\nisStableSource :: UnfoldingSource -> Bool\n-- Keep the unfolding template\nisStableSource InlineCompulsory   = True\nisStableSource InlineStable       = True\nisStableSource InlineRhs          = False\n\n-- | Retrieves the template of an unfolding: panics if none is known\nunfoldingTemplate :: Unfolding -> CoreExpr\nunfoldingTemplate = uf_tmpl\n\n-- | Retrieves the template of an unfolding if possible\n-- maybeUnfoldingTemplate is used mainly wnen specialising, and we do\n-- want to specialise DFuns, so it's important to return a template\n-- for DFunUnfoldings\nmaybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr\nmaybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })\n  = Just expr\nmaybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })\n  = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args))\nmaybeUnfoldingTemplate _\n  = Nothing\n\n-- | The constructors that the unfolding could never be:\n-- returns @[]@ if no information is available\notherCons :: Unfolding -> [AltCon]\notherCons (OtherCon cons) = cons\notherCons _               = []\n\n-- | Determines if it is certainly the case that the unfolding will\n-- yield a value (something in HNF): returns @False@ if unsure\nisValueUnfolding :: Unfolding -> Bool\n        -- Returns False for OtherCon\nisValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald\nisValueUnfolding _                                          = False\n\n-- | Determines if it possibly the case that the unfolding will\n-- yield a value. Unlike 'isValueUnfolding' it returns @True@\n-- for 'OtherCon'\nisEvaldUnfolding :: Unfolding -> Bool\n        -- Returns True for OtherCon\nisEvaldUnfolding (OtherCon _)                               = True\nisEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald\nisEvaldUnfolding _                                          = False\n\n-- | @True@ if the unfolding is a constructor application, the application\n-- of a CONLIKE function or 'OtherCon'\nisConLikeUnfolding :: Unfolding -> Bool\nisConLikeUnfolding (OtherCon _)                             = True\nisConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con\nisConLikeUnfolding _                                        = False\n\n-- | Is the thing we will unfold into certainly cheap?\nisCheapUnfolding :: Unfolding -> Bool\nisCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf\nisCheapUnfolding _                                           = False\n\nisExpandableUnfolding :: Unfolding -> Bool\nisExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable\nisExpandableUnfolding _                                              = False\n\nexpandUnfolding_maybe :: Unfolding -> Maybe CoreExpr\n-- Expand an expandable unfolding; this is used in rule matching\n--   See Note [Expanding variables] in Rules.hs\n-- The key point here is that CONLIKE things can be expanded\nexpandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs\nexpandUnfolding_maybe _                                                       = Nothing\n\nisCompulsoryUnfolding :: Unfolding -> Bool\nisCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True\nisCompulsoryUnfolding _                                             = False\n\nisStableUnfolding :: Unfolding -> Bool\n-- True of unfoldings that should not be overwritten\n-- by a CoreUnfolding for the RHS of a let-binding\nisStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src\nisStableUnfolding (DFunUnfolding {})               = True\nisStableUnfolding _                                = False\n\n-- | Only returns False if there is no unfolding information available at all\nhasSomeUnfolding :: Unfolding -> Bool\nhasSomeUnfolding NoUnfolding   = False\nhasSomeUnfolding BootUnfolding = False\nhasSomeUnfolding _             = True\n\nisBootUnfolding :: Unfolding -> Bool\nisBootUnfolding BootUnfolding = True\nisBootUnfolding _             = False\n\nneverUnfoldGuidance :: UnfoldingGuidance -> Bool\nneverUnfoldGuidance UnfNever = True\nneverUnfoldGuidance _        = False\n\nisFragileUnfolding :: Unfolding -> Bool\n-- An unfolding is fragile if it mentions free variables or\n-- is otherwise subject to change.  A robust one can be kept.\n-- See Note [Fragile unfoldings]\nisFragileUnfolding (CoreUnfolding {}) = True\nisFragileUnfolding (DFunUnfolding {}) = True\nisFragileUnfolding _                  = False\n  -- NoUnfolding, BootUnfolding, OtherCon are all non-fragile\n\ncanUnfold :: Unfolding -> Bool\ncanUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)\ncanUnfold _                                   = False\n\n{- Note [Fragile unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn unfolding is \"fragile\" if it mentions free variables (and hence would\nneed substitution) or might be affected by optimisation.  The non-fragile\nones are\n\n   NoUnfolding, BootUnfolding\n\n   OtherCon {}    If we know this binder (say a lambda binder) will be\n                  bound to an evaluated thing, we want to retain that\n                  info in simpleOptExpr; see Trac #13077.\n\nWe consider even a StableUnfolding as fragile, because it needs substitution.\n\nNote [InlineStable]\n~~~~~~~~~~~~~~~~~\nWhen you say\n      {-# INLINE f #-}\n      f x = <rhs>\nyou intend that calls (f e) are replaced by <rhs>[e/x] So we\nshould capture (\\x.<rhs>) in the Unfolding of 'f', and never meddle\nwith it.  Meanwhile, we can optimise <rhs> to our heart's content,\nleaving the original unfolding intact in Unfolding of 'f'. For example\n        all xs = foldr (&&) True xs\n        any p = all . map p  {-# INLINE any #-}\nWe optimise any's RHS fully, but leave the InlineRule saying \"all . map p\",\nwhich deforests well at the call site.\n\nSo INLINE pragma gives rise to an InlineRule, which captures the original RHS.\n\nMoreover, it's only used when 'f' is applied to the\nspecified number of arguments; that is, the number of argument on\nthe LHS of the '=' sign in the original source definition.\nFor example, (.) is now defined in the libraries like this\n   {-# INLINE (.) #-}\n   (.) f g = \\x -> f (g x)\nso that it'll inline when applied to two arguments. If 'x' appeared\non the left, thus\n   (.) f g x = f (g x)\nit'd only inline when applied to three arguments.  This slightly-experimental\nchange was requested by Roman, but it seems to make sense.\n\nSee also Note [Inlining an InlineRule] in CoreUnfold.\n\n\nNote [OccInfo in unfoldings and rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn unfoldings and rules, we guarantee that the template is occ-analysed,\nso that the occurrence info on the binders is correct.  This is important,\nbecause the Simplifier does not re-analyse the template when using it. If\nthe occurrence info is wrong\n  - We may get more simplifier iterations than necessary, because\n    once-occ info isn't there\n  - More seriously, we may get an infinite loop if there's a Rec\n    without a loop breaker marked\n\n\n************************************************************************\n*                                                                      *\n                  AltCon\n*                                                                      *\n************************************************************************\n-}\n\n-- The Ord is needed for the FiniteMap used in the lookForConstructor\n-- in SimplEnv.  If you declared that lookForConstructor *ignores*\n-- constructor-applications with LitArg args, then you could get\n-- rid of this Ord.\n\ninstance Outputable AltCon where\n  ppr (DataAlt dc) = ppr dc\n  ppr (LitAlt lit) = ppr lit\n  ppr DEFAULT      = text \"__DEFAULT\"\n\ncmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering\ncmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2\n\nltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool\nltAlt a1 a2 = (a1 `cmpAlt` a2) == LT\n\ncmpAltCon :: AltCon -> AltCon -> Ordering\n-- ^ Compares 'AltCon's within a single list of alternatives\n-- DEFAULT comes out smallest, so that sorting by AltCon\n-- puts alternatives in the order required by #case_invariants#\ncmpAltCon DEFAULT      DEFAULT     = EQ\ncmpAltCon DEFAULT      _           = LT\n\ncmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2\ncmpAltCon (DataAlt _)  DEFAULT      = GT\ncmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2\ncmpAltCon (LitAlt _)   DEFAULT      = GT\n\ncmpAltCon con1 con2 = WARN( True, text \"Comparing incomparable AltCons\" <+>\n                                  ppr con1 <+> ppr con2 )\n                      LT\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Useful synonyms}\n*                                                                      *\n************************************************************************\n\nNote [CoreProgram]\n~~~~~~~~~~~~~~~~~~\nThe top level bindings of a program, a CoreProgram, are represented as\na list of CoreBind\n\n * Later bindings in the list can refer to earlier ones, but not vice\n   versa.  So this is OK\n      NonRec { x = 4 }\n      Rec { p = ...q...x...\n          ; q = ...p...x }\n      Rec { f = ...p..x..f.. }\n      NonRec { g = ..f..q...x.. }\n   But it would NOT be ok for 'f' to refer to 'g'.\n\n * The occurrence analyser does strongly-connected component analysis\n   on each Rec binding, and splits it into a sequence of smaller\n   bindings where possible.  So the program typically starts life as a\n   single giant Rec, which is then dependency-analysed into smaller\n   chunks.\n-}\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ntype CoreProgram = [CoreBind]   -- See Note [CoreProgram]\n\n-- | The common case for the type of binders and variables when\n-- we are manipulating the Core language within GHC\ntype CoreBndr = Var\n-- | Expressions where binders are 'CoreBndr's\ntype CoreExpr = Expr CoreBndr\n-- | Argument expressions where binders are 'CoreBndr's\ntype CoreArg  = Arg  CoreBndr\n-- | Binding groups where binders are 'CoreBndr's\ntype CoreBind = Bind CoreBndr\n-- | Case alternatives where binders are 'CoreBndr's\ntype CoreAlt  = Alt  CoreBndr\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Tagging}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Binders are /tagged/ with a t\ndata TaggedBndr t = TB CoreBndr t       -- TB for \"tagged binder\"\n\ntype TaggedBind t = Bind (TaggedBndr t)\ntype TaggedExpr t = Expr (TaggedBndr t)\ntype TaggedArg  t = Arg  (TaggedBndr t)\ntype TaggedAlt  t = Alt  (TaggedBndr t)\n\ninstance Outputable b => Outputable (TaggedBndr b) where\n  ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'\n\ndeTagExpr :: TaggedExpr t -> CoreExpr\ndeTagExpr (Var v)                   = Var v\ndeTagExpr (Lit l)                   = Lit l\ndeTagExpr (Type ty)                 = Type ty\ndeTagExpr (Coercion co)             = Coercion co\ndeTagExpr (App e1 e2)               = App (deTagExpr e1) (deTagExpr e2)\ndeTagExpr (Lam (TB b _) e)          = Lam b (deTagExpr e)\ndeTagExpr (Let bind body)           = Let (deTagBind bind) (deTagExpr body)\ndeTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)\ndeTagExpr (Tick t e)                = Tick t (deTagExpr e)\ndeTagExpr (Cast e co)               = Cast (deTagExpr e) co\n\ndeTagBind :: TaggedBind t -> CoreBind\ndeTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)\ndeTagBind (Rec prs)             = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]\n\ndeTagAlt :: TaggedAlt t -> CoreAlt\ndeTagAlt (con, bndrs, rhs) = (con, [b | TB b _ <- bndrs], deTagExpr rhs)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Core-constructing functions with checking}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to\n-- use 'MkCore.mkCoreApps' if possible\nmkApps    :: Expr b -> [Arg b]  -> Expr b\n-- | Apply a list of type argument expressions to a function expression in a nested fashion\nmkTyApps  :: Expr b -> [Type]   -> Expr b\n-- | Apply a list of coercion argument expressions to a function expression in a nested fashion\nmkCoApps  :: Expr b -> [Coercion] -> Expr b\n-- | Apply a list of type or value variables to a function expression in a nested fashion\nmkVarApps :: Expr b -> [Var] -> Expr b\n-- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to\n-- use 'MkCore.mkCoreConApps' if possible\nmkConApp      :: DataCon -> [Arg b] -> Expr b\n\nmkApps    f args = foldl' App                       f args\nmkCoApps  f args = foldl' (\\ e a -> App e (Coercion a)) f args\nmkVarApps f vars = foldl' (\\ e a -> App e (varToCoreExpr a)) f vars\nmkConApp con args = mkApps (Var (dataConWorkId con)) args\n\nmkTyApps  f args = foldl' (\\ e a -> App e (mkTyArg a)) f args\n\nmkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b\nmkConApp2 con tys arg_ids = Var (dataConWorkId con)\n                            `mkApps` map Type tys\n                            `mkApps` map varToCoreExpr arg_ids\n\nmkTyArg :: Type -> Expr b\nmkTyArg ty\n  | Just co <- isCoercionTy_maybe ty = Coercion co\n  | otherwise                        = Type ty\n\n-- | Create a machine integer literal expression of type @Int#@ from an @Integer@.\n-- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'\nmkIntLit      :: DynFlags -> Integer -> Expr b\n-- | Create a machine integer literal expression of type @Int#@ from an @Int@.\n-- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'\nmkIntLitInt   :: DynFlags -> Int     -> Expr b\n\nmkIntLit    dflags n = Lit (mkLitInt dflags n)\nmkIntLitInt dflags n = Lit (mkLitInt dflags (toInteger n))\n\n-- | Create a machine word literal expression of type  @Word#@ from an @Integer@.\n-- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'\nmkWordLit     :: DynFlags -> Integer -> Expr b\n-- | Create a machine word literal expression of type  @Word#@ from a @Word@.\n-- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'\nmkWordLitWord :: DynFlags -> Word -> Expr b\n\nmkWordLit     dflags w = Lit (mkLitWord dflags w)\nmkWordLitWord dflags w = Lit (mkLitWord dflags (toInteger w))\n\nmkWord64LitWord64 :: Word64 -> Expr b\nmkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))\n\nmkInt64LitInt64 :: Int64 -> Expr b\nmkInt64LitInt64 w = Lit (mkLitInt64 (toInteger w))\n\n-- | Create a machine character literal expression of type @Char#@.\n-- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'\nmkCharLit :: Char -> Expr b\n-- | Create a machine string literal expression of type @Addr#@.\n-- If you want an expression of type @String@ use 'MkCore.mkStringExpr'\nmkStringLit :: String -> Expr b\n\nmkCharLit   c = Lit (mkLitChar c)\nmkStringLit s = Lit (mkLitString s)\n\n-- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.\n-- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'\nmkFloatLit :: Rational -> Expr b\n-- | Create a machine single precision literal expression of type @Float#@ from a @Float@.\n-- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'\nmkFloatLitFloat :: Float -> Expr b\n\nmkFloatLit      f = Lit (mkLitFloat f)\nmkFloatLitFloat f = Lit (mkLitFloat (toRational f))\n\n-- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.\n-- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'\nmkDoubleLit :: Rational -> Expr b\n-- | Create a machine double precision literal expression of type @Double#@ from a @Double@.\n-- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'\nmkDoubleLitDouble :: Double -> Expr b\n\nmkDoubleLit       d = Lit (mkLitDouble d)\nmkDoubleLitDouble d = Lit (mkLitDouble (toRational d))\n\n-- | Bind all supplied binding groups over an expression in a nested let expression. Assumes\n-- that the rhs satisfies the let/app invariant.  Prefer to use 'MkCore.mkCoreLets' if\n-- possible, which does guarantee the invariant\nmkLets        :: [Bind b] -> Expr b -> Expr b\n-- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to\n-- use 'MkCore.mkCoreLams' if possible\nmkLams        :: [b] -> Expr b -> Expr b\n\nmkLams binders body = foldr Lam body binders\nmkLets binds body   = foldr mkLet body binds\n\nmkLet :: Bind b -> Expr b -> Expr b\n-- The desugarer sometimes generates an empty Rec group\n-- which Lint rejects, so we kill it off right away\nmkLet (Rec []) body = body\nmkLet bind     body = Let bind body\n\n-- | @mkLetNonRec bndr rhs body@ wraps @body@ in a @let@ binding @bndr@.\nmkLetNonRec :: b -> Expr b -> Expr b -> Expr b\nmkLetNonRec b rhs body = Let (NonRec b rhs) body\n\n-- | @mkLetRec binds body@ wraps @body@ in a @let rec@ with the given set of\n-- @binds@ if binds is non-empty.\nmkLetRec :: [(b, Expr b)] -> Expr b -> Expr b\nmkLetRec [] body = body\nmkLetRec bs body = Let (Rec bs) body\n\n-- | Create a binding group where a type variable is bound to a type. Per \"CoreSyn#type_let\",\n-- this can only be used to bind something in a non-recursive @let@ expression\nmkTyBind :: TyVar -> Type -> CoreBind\nmkTyBind tv ty      = NonRec tv (Type ty)\n\n-- | Create a binding group where a type variable is bound to a type. Per \"CoreSyn#type_let\",\n-- this can only be used to bind something in a non-recursive @let@ expression\nmkCoBind :: CoVar -> Coercion -> CoreBind\nmkCoBind cv co      = NonRec cv (Coercion co)\n\n-- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately\nvarToCoreExpr :: CoreBndr -> Expr b\nvarToCoreExpr v | isTyVar v = Type (mkTyVarTy v)\n                | isCoVar v = Coercion (mkCoVarCo v)\n                | otherwise = ASSERT( isId v ) Var v\n\nvarsToCoreExprs :: [CoreBndr] -> [Expr b]\nvarsToCoreExprs vs = map varToCoreExpr vs\n\n{-\n************************************************************************\n*                                                                      *\n   Getting a result type\n*                                                                      *\n************************************************************************\n\nThese are defined here to avoid a module loop between CoreUtils and CoreFVs\n\n-}\n\napplyTypeToArg :: Type -> CoreExpr -> Type\n-- ^ Determines the type resulting from applying an expression with given type\n-- to a given argument expression\napplyTypeToArg fun_ty arg = piResultTy fun_ty (exprToType arg)\n\n-- | If the expression is a 'Type', converts. Otherwise,\n-- panics. NB: This does /not/ convert 'Coercion' to 'CoercionTy'.\nexprToType :: CoreExpr -> Type\nexprToType (Type ty)     = ty\nexprToType _bad          = pprPanic \"exprToType\" empty\n\n-- | If the expression is a 'Coercion', converts.\nexprToCoercion_maybe :: CoreExpr -> Maybe Coercion\nexprToCoercion_maybe (Coercion co) = Just co\nexprToCoercion_maybe _             = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Simple access functions}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Extract every variable by this group\nbindersOf  :: Bind b -> [b]\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\nbindersOf (NonRec binder _) = [binder]\nbindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]\n\n-- | 'bindersOf' applied to a list of binding groups\nbindersOfBinds :: [Bind b] -> [b]\nbindersOfBinds binds = foldr ((++) . bindersOf) [] binds\n\nrhssOfBind :: Bind b -> [Expr b]\nrhssOfBind (NonRec _ rhs) = [rhs]\nrhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]\n\nrhssOfAlts :: [Alt b] -> [Expr b]\nrhssOfAlts alts = [e | (_,_,e) <- alts]\n\n-- | Collapse all the bindings in the supplied groups into a single\n-- list of lhs\\/rhs pairs suitable for binding in a 'Rec' binding group\nflattenBinds :: [Bind b] -> [(b, Expr b)]\nflattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds\nflattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds\nflattenBinds []                   = []\n\n-- | We often want to strip off leading lambdas before getting down to\n-- business. Variants are 'collectTyBinders', 'collectValBinders',\n-- and 'collectTyAndValBinders'\ncollectBinders         :: Expr b   -> ([b],     Expr b)\ncollectTyBinders       :: CoreExpr -> ([TyVar], CoreExpr)\ncollectValBinders      :: CoreExpr -> ([Id],    CoreExpr)\ncollectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)\n-- | Strip off exactly N leading lambdas (type or value). Good for use with\n-- join points.\ncollectNBinders        :: Int -> Expr b -> ([b], Expr b)\n\ncollectBinders expr\n  = go [] expr\n  where\n    go bs (Lam b e) = go (b:bs) e\n    go bs e          = (reverse bs, e)\n\ncollectTyBinders expr\n  = go [] expr\n  where\n    go tvs (Lam b e) | isTyVar b = go (b:tvs) e\n    go tvs e                     = (reverse tvs, e)\n\ncollectValBinders expr\n  = go [] expr\n  where\n    go ids (Lam b e) | isId b = go (b:ids) e\n    go ids body               = (reverse ids, body)\n\ncollectTyAndValBinders expr\n  = (tvs, ids, body)\n  where\n    (tvs, body1) = collectTyBinders expr\n    (ids, body)  = collectValBinders body1\n\ncollectNBinders orig_n orig_expr\n  = go orig_n [] orig_expr\n  where\n    go 0 bs expr      = (reverse bs, expr)\n    go n bs (Lam b e) = go (n-1) (b:bs) e\n    go _ _  _         = pprPanic \"collectNBinders\" $ int orig_n\n\n-- | Takes a nested application expression and returns the function\n-- being applied and the arguments to which it is applied\ncollectArgs :: Expr b -> (Expr b, [Arg b])\ncollectArgs expr\n  = go expr []\n  where\n    go (App f a) as = go f (a:as)\n    go e         as = (e, as)\n\n-- | Attempt to remove the last N arguments of a function call.\n-- Strip off any ticks or coercions encountered along the way and any\n-- at the end.\nstripNArgs :: Word -> Expr a -> Maybe (Expr a)\nstripNArgs !n (Tick _ e) = stripNArgs n e\nstripNArgs n (Cast f _) = stripNArgs n f\nstripNArgs 0 e = Just e\nstripNArgs n (App f _) = stripNArgs (n - 1) f\nstripNArgs _ _ = Nothing\n\n-- | Like @collectArgs@, but also collects looks through floatable\n-- ticks if it means that we can find more arguments.\ncollectArgsTicks :: (Tickish Id -> Bool) -> Expr b\n                 -> (Expr b, [Arg b], [Tickish Id])\ncollectArgsTicks skipTick expr\n  = go expr [] []\n  where\n    go (App f a)  as ts = go f (a:as) ts\n    go (Tick t e) as ts\n      | skipTick t      = go e as (t:ts)\n    go e          as ts = (e, as, reverse ts)\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Predicates}\n*                                                                      *\n************************************************************************\n\nAt one time we optionally carried type arguments through to runtime.\n@isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,\ni.e. if type applications are actual lambdas because types are kept around\nat runtime.  Similarly isRuntimeArg.\n-}\n\n-- | Will this variable exist at runtime?\nisRuntimeVar :: Var -> Bool\nisRuntimeVar = isId\n\n-- | Will this argument expression exist at runtime?\nisRuntimeArg :: CoreExpr -> Bool\nisRuntimeArg = isValArg\n\n-- | Returns @True@ for value arguments, false for type args\n-- NB: coercions are value arguments (zero width, to be sure,\n-- like State#, but still value args).\nisValArg :: Expr b -> Bool\nisValArg e = not (isTypeArg e)\n\n-- | Returns @True@ iff the expression is a 'Type' or 'Coercion'\n-- expression at its top level\nisTyCoArg :: Expr b -> Bool\nisTyCoArg (Type {})     = True\nisTyCoArg (Coercion {}) = True\nisTyCoArg _             = False\n\n-- | Returns @True@ iff the expression is a 'Coercion'\n-- expression at its top level\nisCoArg :: Expr b -> Bool\nisCoArg (Coercion {}) = True\nisCoArg _             = False\n\n-- | Returns @True@ iff the expression is a 'Type' expression at its\n-- top level.  Note this does NOT include 'Coercion's.\nisTypeArg :: Expr b -> Bool\nisTypeArg (Type {}) = True\nisTypeArg _         = False\n\n-- | The number of binders that bind values rather than types\nvalBndrCount :: [CoreBndr] -> Int\nvalBndrCount = count isId\n\n-- | The number of argument expressions that are values rather than types at their top level\nvalArgCount :: [Arg b] -> Int\nvalArgCount = count isValArg\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Annotated core}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Annotated core: allows annotation at every node in the tree\ntype AnnExpr bndr annot = (annot, AnnExpr' bndr annot)\n\n-- | A clone of the 'Expr' type but allowing annotation at every tree node\ndata AnnExpr' bndr annot\n  = AnnVar      Id\n  | AnnLit      Literal\n  | AnnLam      bndr (AnnExpr bndr annot)\n  | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)\n  | AnnCase     (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]\n  | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)\n  | AnnCast     (AnnExpr bndr annot) (annot, Coercion)\n                   -- Put an annotation on the (root of) the coercion\n  | AnnTick     (Tickish Id) (AnnExpr bndr annot)\n  | AnnType     Type\n  | AnnCoercion Coercion\n\n-- | A clone of the 'Alt' type but allowing annotation at every tree node\ntype AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)\n\n-- | A clone of the 'Bind' type but allowing annotation at every tree node\ndata AnnBind bndr annot\n  = AnnNonRec bndr (AnnExpr bndr annot)\n  | AnnRec    [(bndr, AnnExpr bndr annot)]\n\n-- | Takes a nested application expression and returns the function\n-- being applied and the arguments to which it is applied\ncollectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])\ncollectAnnArgs expr\n  = go expr []\n  where\n    go (_, AnnApp f a) as = go f (a:as)\n    go e               as = (e, as)\n\ncollectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a\n                       -> (AnnExpr b a, [AnnExpr b a], [Tickish Var])\ncollectAnnArgsTicks tickishOk expr\n  = go expr [] []\n  where\n    go (_, AnnApp f a)  as ts = go f (a:as) ts\n    go (_, AnnTick t e) as ts | tickishOk t\n                              = go e as (t:ts)\n    go e                as ts = (e, as, reverse ts)\n\ndeAnnotate :: AnnExpr bndr annot -> Expr bndr\ndeAnnotate (_, e) = deAnnotate' e\n\ndeAnnotate' :: AnnExpr' bndr annot -> Expr bndr\ndeAnnotate' (AnnType t)           = Type t\ndeAnnotate' (AnnCoercion co)      = Coercion co\ndeAnnotate' (AnnVar  v)           = Var v\ndeAnnotate' (AnnLit  lit)         = Lit lit\ndeAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)\ndeAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)\ndeAnnotate' (AnnCast e (_,co))    = Cast (deAnnotate e) co\ndeAnnotate' (AnnTick tick body)   = Tick tick (deAnnotate body)\n\ndeAnnotate' (AnnLet bind body)\n  = Let (deAnnBind bind) (deAnnotate body)\ndeAnnotate' (AnnCase scrut v t alts)\n  = Case (deAnnotate scrut) v t (map deAnnAlt alts)\n\ndeAnnAlt :: AnnAlt bndr annot -> Alt bndr\ndeAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)\n\ndeAnnBind  :: AnnBind b annot -> Bind b\ndeAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)\ndeAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]\n\n-- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'\ncollectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)\ncollectAnnBndrs e\n  = collect [] e\n  where\n    collect bs (_, AnnLam b body) = collect (b:bs) body\n    collect bs body               = (reverse bs, body)\n\n-- | As 'collectNBinders' but for 'AnnExpr' rather than 'Expr'\ncollectNAnnBndrs :: Int -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)\ncollectNAnnBndrs orig_n e\n  = collect orig_n [] e\n  where\n    collect 0 bs body               = (reverse bs, body)\n    collect n bs (_, AnnLam b body) = collect (n-1) (b:bs) body\n    collect _ _  _                  = pprPanic \"collectNBinders\" $ int orig_n\n", "num_lines": 2233}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1996-1998\n\n\nThis module contains \"tidying\" code for *nested* expressions, bindings, rules.\nThe code for *top-level* bindings is in TidyPgm.\n-}\n\n{-# LANGUAGE CPP #-}\nmodule CoreTidy (\n        tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreSeq ( seqUnfolding )\nimport CoreArity\nimport Id\nimport IdInfo\nimport Demand ( zapUsageEnvSig )\nimport Type( tidyType, tidyVarBndr )\nimport Coercion( tidyCo )\nimport Var\nimport VarEnv\nimport UniqFM\nimport Name hiding (tidyNameOcc)\nimport SrcLoc\nimport Maybes\nimport Data.List\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Tidying expressions, rules}\n*                                                                      *\n************************************************************************\n-}\n\ntidyBind :: TidyEnv\n         -> CoreBind\n         ->  (TidyEnv, CoreBind)\n\ntidyBind env (NonRec bndr rhs)\n  = tidyLetBndr env env (bndr,rhs) =: \\ (env', bndr') ->\n    (env', NonRec bndr' (tidyExpr env' rhs))\n\ntidyBind env (Rec prs)\n  = let\n       (env', bndrs') = mapAccumL (tidyLetBndr env') env prs\n    in\n    map (tidyExpr env') (map snd prs)   =: \\ rhss' ->\n    (env', Rec (zip bndrs' rhss'))\n\n\n------------  Expressions  --------------\ntidyExpr :: TidyEnv -> CoreExpr -> CoreExpr\ntidyExpr env (Var v)       = Var (tidyVarOcc env v)\ntidyExpr env (Type ty)     = Type (tidyType env ty)\ntidyExpr env (Coercion co) = Coercion (tidyCo env co)\ntidyExpr _   (Lit lit)     = Lit lit\ntidyExpr env (App f a)     = App (tidyExpr env f) (tidyExpr env a)\ntidyExpr env (Tick t e)    = Tick (tidyTickish env t) (tidyExpr env e)\ntidyExpr env (Cast e co)   = Cast (tidyExpr env e) (tidyCo env co)\n\ntidyExpr env (Let b e)\n  = tidyBind env b      =: \\ (env', b') ->\n    Let b' (tidyExpr env' e)\n\ntidyExpr env (Case e b ty alts)\n  = tidyBndr env b  =: \\ (env', b) ->\n    Case (tidyExpr env e) b (tidyType env ty)\n         (map (tidyAlt env') alts)\n\ntidyExpr env (Lam b e)\n  = tidyBndr env b      =: \\ (env', b) ->\n    Lam b (tidyExpr env' e)\n\n------------  Case alternatives  --------------\ntidyAlt :: TidyEnv -> CoreAlt -> CoreAlt\ntidyAlt env (con, vs, rhs)\n  = tidyBndrs env vs    =: \\ (env', vs) ->\n    (con, vs, tidyExpr env' rhs)\n\n------------  Tickish  --------------\ntidyTickish :: TidyEnv -> Tickish Id -> Tickish Id\ntidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)\ntidyTickish _   other_tickish       = other_tickish\n\n------------  Rules  --------------\ntidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]\ntidyRules _   [] = []\ntidyRules env (rule : rules)\n  = tidyRule env rule           =: \\ rule ->\n    tidyRules env rules         =: \\ rules ->\n    (rule : rules)\n\ntidyRule :: TidyEnv -> CoreRule -> CoreRule\ntidyRule _   rule@(BuiltinRule {}) = rule\ntidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,\n                          ru_fn = fn, ru_rough = mb_ns })\n  = tidyBndrs env bndrs         =: \\ (env', bndrs) ->\n    map (tidyExpr env') args    =: \\ args ->\n    rule { ru_bndrs = bndrs, ru_args = args,\n           ru_rhs   = tidyExpr env' rhs,\n           ru_fn    = tidyNameOcc env fn,\n           ru_rough = map (fmap (tidyNameOcc env')) mb_ns }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Tidying non-top-level binders}\n*                                                                      *\n************************************************************************\n-}\n\ntidyNameOcc :: TidyEnv -> Name -> Name\n-- In rules and instances, we have Names, and we must tidy them too\n-- Fortunately, we can lookup in the VarEnv with a name\ntidyNameOcc (_, var_env) n = case lookupUFM var_env n of\n                                Nothing -> n\n                                Just v  -> idName v\n\ntidyVarOcc :: TidyEnv -> Var -> Var\ntidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v\n\n-- tidyBndr is used for lambda and case binders\ntidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)\ntidyBndr env var\n  | isTyCoVar var = tidyVarBndr env var\n  | otherwise     = tidyIdBndr env var\n\ntidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])\ntidyBndrs env vars = mapAccumL tidyBndr env vars\n\n-- Non-top-level variables, not covars\ntidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)\ntidyIdBndr env@(tidy_env, var_env) id\n  = -- Do this pattern match strictly, otherwise we end up holding on to\n    -- stuff in the OccName.\n    case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->\n    let\n        -- Give the Id a fresh print-name, *and* rename its type\n        -- The SrcLoc isn't important now,\n        -- though we could extract it from the Id\n        --\n        ty'      = tidyType env (idType id)\n        name'    = mkInternalName (idUnique id) occ' noSrcSpan\n        id'      = mkLocalIdWithInfo name' ty' new_info\n        var_env' = extendVarEnv var_env id id'\n\n        -- Note [Tidy IdInfo]\n        new_info = vanillaIdInfo `setOccInfo` occInfo old_info\n                                 `setUnfoldingInfo` new_unf\n                                  -- see Note [Preserve OneShotInfo]\n                                 `setOneShotInfo` oneShotInfo old_info\n        old_info = idInfo id\n        old_unf  = unfoldingInfo old_info\n        new_unf  = zapUnfolding old_unf  -- See Note [Preserve evaluatedness]\n    in\n    ((tidy_env', var_env'), id')\n   }\n\ntidyLetBndr :: TidyEnv         -- Knot-tied version for unfoldings\n            -> TidyEnv         -- The one to extend\n            -> (Id, CoreExpr) -> (TidyEnv, Var)\n-- Used for local (non-top-level) let(rec)s\n-- Just like tidyIdBndr above, but with more IdInfo\ntidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)\n  = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->\n    let\n        ty'      = tidyType env (idType id)\n        name'    = mkInternalName (idUnique id) occ' noSrcSpan\n        details  = idDetails id\n        id'      = mkLocalVar details name' ty' new_info\n        var_env' = extendVarEnv var_env id id'\n\n        -- Note [Tidy IdInfo]\n        -- We need to keep around any interesting strictness and\n        -- demand info because later on we may need to use it when\n        -- converting to A-normal form.\n        -- eg.\n        --      f (g x),  where f is strict in its argument, will be converted\n        --      into  case (g x) of z -> f z  by CorePrep, but only if f still\n        --      has its strictness info.\n        --\n        -- Similarly for the demand info - on a let binder, this tells\n        -- CorePrep to turn the let into a case.\n        -- But: Remove the usage demand here\n        --      (See Note [Zapping DmdEnv after Demand Analyzer] in WorkWrap)\n        --\n        -- Similarly arity info for eta expansion in CorePrep\n        --\n        -- Set inline-prag info so that we preseve it across\n        -- separate compilation boundaries\n        old_info = idInfo id\n        new_info = vanillaIdInfo\n                    `setOccInfo`        occInfo old_info\n                    `setArityInfo`      exprArity rhs\n                    `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info)\n                    `setDemandInfo`     demandInfo old_info\n                    `setInlinePragInfo` inlinePragInfo old_info\n                    `setUnfoldingInfo`  new_unf\n\n        old_unf = unfoldingInfo old_info\n        new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf\n                | otherwise                 = zapUnfolding old_unf\n                                              -- See Note [Preserve evaluatedness]\n    in\n    ((tidy_env', var_env'), id') }\n\n------------ Unfolding  --------------\ntidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding\ntidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _\n  = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }\n  where\n    (tidy_env', bndrs') = tidyBndrs tidy_env bndrs\n\ntidyUnfolding tidy_env\n              unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })\n              unf_from_rhs\n  | isStableSource src\n  = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo\n    -- This seqIt avoids a space leak: otherwise the uf_is_value,\n    -- uf_is_conlike, ... fields may retain a reference to the\n    -- pre-tidied expression forever (ToIface doesn't look at them)\n\n  | otherwise\n  = unf_from_rhs\n  where seqIt unf = seqUnfolding unf `seq` unf\ntidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon\n\n{-\nNote [Tidy IdInfo]\n~~~~~~~~~~~~~~~~~~\nAll nested Ids now have the same IdInfo, namely vanillaIdInfo, which\nshould save some space; except that we preserve occurrence info for\ntwo reasons:\n\n  (a) To make printing tidy core nicer\n\n  (b) Because we tidy RULES and InlineRules, which may then propagate\n      via --make into the compilation of the next module, and we want\n      the benefit of that occurrence analysis when we use the rule or\n      or inline the function.  In particular, it's vital not to lose\n      loop-breaker info, else we get an infinite inlining loop\n\nNote that tidyLetBndr puts more IdInfo back.\n\nNote [Preserve evaluatedness]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data T = MkT !Bool\n  ....(case v of MkT y ->\n       let z# = case y of\n                  True -> 1#\n                  False -> 2#\n       in ...)\n\nThe z# binding is ok because the RHS is ok-for-speculation,\nbut Lint will complain unless it can *see* that.  So we\npreserve the evaluated-ness on 'y' in tidyBndr.\n\n(Another alternative would be to tidy unboxed lets into cases,\nbut that seems more indirect and surprising.)\n\nNote [Preserve OneShotInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe keep the OneShotInfo because we want it to propagate into the interface.\nNot all OneShotInfo is determined by a compiler analysis; some is added by a\ncall of GHC.Exts.oneShot, which is then discarded before the end of the\noptimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we\nmust preserve this info in inlinings. See Note [The oneShot function] in MkId.\n\nThis applies to lambda binders only, hence it is stored in IfaceLamBndr.\n-}\n\n(=:) :: a -> (a -> b) -> b\nm =: k = m `seq` k m\n", "num_lines": 283}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1994-1998\n\n\nCore-syntax unfoldings\n\nUnfoldings (which can travel across module boundaries) are in Core\nsyntax (namely @CoreExpr@s).\n\nThe type @Unfolding@ sits ``above'' simply-Core-expressions\nunfoldings, capturing ``higher-level'' things we know about a binding,\nusually things that the simplifier found out (e.g., ``it's a\nliteral'').  In the corner of a @CoreUnfolding@ unfolding, you will\nfind, unsurprisingly, a Core expression.\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule CoreUnfold (\n        Unfolding, UnfoldingGuidance,   -- Abstract types\n\n        noUnfolding, mkImplicitUnfolding,\n        mkUnfolding, mkCoreUnfolding,\n        mkTopUnfolding, mkSimpleUnfolding, mkWorkerUnfolding,\n        mkInlineUnfolding, mkInlineUnfoldingWithArity,\n        mkInlinableUnfolding, mkWwInlineRule,\n        mkCompulsoryUnfolding, mkDFunUnfolding,\n        specUnfolding,\n\n        ArgSummary(..),\n\n        couldBeSmallEnoughToInline, inlineBoringOk,\n        certainlyWillInline, smallEnoughToInline,\n\n        callSiteInline, CallCtxt(..),\n\n        -- Reexport from CoreSubst (it only live there so it can be used\n        -- by the Very Simple Optimiser)\n        exprIsConApp_maybe, exprIsLiteral_maybe\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport CoreSyn\nimport PprCore          ()      -- Instances\nimport OccurAnal        ( occurAnalyseExpr_NoBinderSwap )\nimport CoreOpt\nimport CoreArity       ( manifestArity )\nimport CoreUtils\nimport Id\nimport Demand          ( isBottomingSig )\nimport DataCon\nimport Literal\nimport PrimOp\nimport IdInfo\nimport BasicTypes       ( Arity, InlineSpec(..), inlinePragmaSpec )\nimport Type\nimport PrelNames\nimport TysPrim          ( realWorldStatePrimTy )\nimport Bag\nimport Util\nimport Outputable\nimport ForeignCall\nimport Name\n\nimport qualified Data.ByteString as BS\nimport Data.List\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Making unfoldings}\n*                                                                      *\n************************************************************************\n-}\n\nmkTopUnfolding :: DynFlags -> Bool -> CoreExpr -> Unfolding\nmkTopUnfolding dflags is_bottoming rhs\n  = mkUnfolding dflags InlineRhs True is_bottoming rhs\n\nmkImplicitUnfolding :: DynFlags -> CoreExpr -> Unfolding\n-- For implicit Ids, do a tiny bit of optimising first\nmkImplicitUnfolding dflags expr\n  = mkTopUnfolding dflags False (simpleOptExpr dflags expr)\n\n-- Note [Top-level flag on inline rules]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Slight hack: note that mk_inline_rules conservatively sets the\n-- top-level flag to True.  It gets set more accurately by the simplifier\n-- Simplify.simplUnfolding.\n\nmkSimpleUnfolding :: DynFlags -> CoreExpr -> Unfolding\nmkSimpleUnfolding dflags rhs\n  = mkUnfolding dflags InlineRhs False False rhs\n\nmkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding\nmkDFunUnfolding bndrs con ops\n  = DFunUnfolding { df_bndrs = bndrs\n                  , df_con = con\n                  , df_args = map occurAnalyseExpr_NoBinderSwap ops }\n                  -- See Note [Occurrence analysis of unfoldings]\n\nmkWwInlineRule :: DynFlags -> CoreExpr -> Arity -> Unfolding\nmkWwInlineRule dflags expr arity\n  = mkCoreUnfolding InlineStable True\n                   (simpleOptExpr dflags expr)\n                   (UnfWhen { ug_arity = arity, ug_unsat_ok = unSaturatedOk\n                            , ug_boring_ok = boringCxtNotOk })\n\nmkCompulsoryUnfolding :: CoreExpr -> Unfolding\nmkCompulsoryUnfolding expr         -- Used for things that absolutely must be unfolded\n  = mkCoreUnfolding InlineCompulsory True\n                    (simpleOptExpr unsafeGlobalDynFlags expr)\n                    (UnfWhen { ug_arity = 0    -- Arity of unfolding doesn't matter\n                             , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk })\n\nmkWorkerUnfolding :: DynFlags -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding\n-- See Note [Worker-wrapper for INLINABLE functions] in WorkWrap\nmkWorkerUnfolding dflags work_fn\n                  (CoreUnfolding { uf_src = src, uf_tmpl = tmpl\n                                 , uf_is_top = top_lvl })\n  | isStableSource src\n  = mkCoreUnfolding src top_lvl new_tmpl guidance\n  where\n    new_tmpl = simpleOptExpr dflags (work_fn tmpl)\n    guidance = calcUnfoldingGuidance dflags False new_tmpl\n\nmkWorkerUnfolding _ _ _ = noUnfolding\n\n-- | Make an unfolding that may be used unsaturated\n-- (ug_unsat_ok = unSaturatedOk) and that is reported as having its\n-- manifest arity (the number of outer lambdas applications will\n-- resolve before doing any work).\nmkInlineUnfolding :: CoreExpr -> Unfolding\nmkInlineUnfolding expr\n  = mkCoreUnfolding InlineStable\n                    True         -- Note [Top-level flag on inline rules]\n                    expr' guide\n  where\n    expr' = simpleOptExpr unsafeGlobalDynFlags expr\n    guide = UnfWhen { ug_arity = manifestArity expr'\n                    , ug_unsat_ok = unSaturatedOk\n                    , ug_boring_ok = boring_ok }\n    boring_ok = inlineBoringOk expr'\n\n-- | Make an unfolding that will be used once the RHS has been saturated\n-- to the given arity.\nmkInlineUnfoldingWithArity :: Arity -> CoreExpr -> Unfolding\nmkInlineUnfoldingWithArity arity expr\n  = mkCoreUnfolding InlineStable\n                    True         -- Note [Top-level flag on inline rules]\n                    expr' guide\n  where\n    expr' = simpleOptExpr unsafeGlobalDynFlags expr\n    guide = UnfWhen { ug_arity = arity\n                    , ug_unsat_ok = needSaturated\n                    , ug_boring_ok = boring_ok }\n    -- See Note [INLINE pragmas and boring contexts] as to why we need to look\n    -- at the arity here.\n    boring_ok | arity == 0 = True\n              | otherwise  = inlineBoringOk expr'\n\nmkInlinableUnfolding :: DynFlags -> CoreExpr -> Unfolding\nmkInlinableUnfolding dflags expr\n  = mkUnfolding dflags InlineStable False False expr'\n  where\n    expr' = simpleOptExpr dflags expr\n\nspecUnfolding :: DynFlags -> [Var] -> (CoreExpr -> CoreExpr) -> Arity\n              -> Unfolding -> Unfolding\n-- See Note [Specialising unfoldings]\n-- specUnfolding spec_bndrs spec_app arity_decrease unf\n--   = \\spec_bndrs. spec_app( unf )\n--\nspecUnfolding dflags spec_bndrs spec_app arity_decrease\n              df@(DFunUnfolding { df_bndrs = old_bndrs, df_con = con, df_args = args })\n  = ASSERT2( arity_decrease == count isId old_bndrs - count isId spec_bndrs, ppr df )\n    mkDFunUnfolding spec_bndrs con (map spec_arg args)\n      -- There is a hard-to-check assumption here that the spec_app has\n      -- enough applications to exactly saturate the old_bndrs\n      -- For DFunUnfoldings we transform\n      --       \\old_bndrs. MkD <op1> ... <opn>\n      -- to\n      --       \\new_bndrs. MkD (spec_app(\\old_bndrs. <op1>)) ... ditto <opn>\n      -- The ASSERT checks the value part of that\n  where\n    spec_arg arg = simpleOptExpr dflags (spec_app (mkLams old_bndrs arg))\n                   -- The beta-redexes created by spec_app will be\n                   -- simplified away by simplOptExpr\n\nspecUnfolding dflags spec_bndrs spec_app arity_decrease\n              (CoreUnfolding { uf_src = src, uf_tmpl = tmpl\n                             , uf_is_top = top_lvl\n                             , uf_guidance = old_guidance })\n | isStableSource src  -- See Note [Specialising unfoldings]\n , UnfWhen { ug_arity     = old_arity\n           , ug_unsat_ok  = unsat_ok\n           , ug_boring_ok = boring_ok } <- old_guidance\n = let guidance = UnfWhen { ug_arity     = old_arity - arity_decrease\n                          , ug_unsat_ok  = unsat_ok\n                          , ug_boring_ok = boring_ok }\n       new_tmpl = simpleOptExpr dflags (mkLams spec_bndrs (spec_app tmpl))\n                   -- The beta-redexes created by spec_app will be\n                   -- simplified away by simplOptExpr\n\n   in mkCoreUnfolding src top_lvl new_tmpl guidance\n\nspecUnfolding _ _ _ _ _ = noUnfolding\n\n{- Note [Specialising unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we specialise a function for some given type-class arguments, we use\nspecUnfolding to specialise its unfolding.  Some important points:\n\n* If the original function has a DFunUnfolding, the specialised one\n  must do so too!  Otherwise we lose the magic rules that make it\n  interact with ClassOps\n\n* There is a bit of hack for INLINABLE functions:\n     f :: Ord a => ....\n     f = <big-rhs>\n     {- INLINABLE f #-}\n  Now if we specialise f, should the specialised version still have\n  an INLINABLE pragma?  If it does, we'll capture a specialised copy\n  of <big-rhs> as its unfolding, and that probaby won't inline.  But\n  if we don't, the specialised version of <big-rhs> might be small\n  enough to inline at a call site. This happens with Control.Monad.liftM3,\n  and can cause a lot more allocation as a result (nofib n-body shows this).\n\n  Moreover, keeping the INLINABLE thing isn't much help, because\n  the specialised function (probaby) isn't overloaded any more.\n\n  Conclusion: drop the INLINEALE pragma.  In practice what this means is:\n     if a stable unfolding has UnfoldingGuidance of UnfWhen,\n        we keep it (so the specialised thing too will always inline)\n     if a stable unfolding has UnfoldingGuidance of UnfIfGoodArgs\n        (which arises from INLINABLE), we discard it\n\nNote [Honour INLINE on 0-ary bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n   x = <expensive>\n   {-# INLINE x #-}\n\n   f y = ...x...\n\nThe semantics of an INLINE pragma is\n\n  inline x at every call site, provided it is saturated;\n  that is, applied to at least as many arguments as appear\n  on the LHS of the Haskell source definition.\n\n(This soure-code-derived arity is stored in the `ug_arity` field of\nthe `UnfoldingGuidance`.)\n\nIn the example, x's ug_arity is 0, so we should inline it at every use\nsite.  It's rare to have such an INLINE pragma (usually INLINE Is on\nfunctions), but it's occasionally very important (Trac #15578, #15519).\nIn #15519 we had something like\n   x = case (g a b) of I# r -> T r\n   {-# INLINE x #-}\n   f y = ...(h x)....\n\nwhere h is strict.  So we got\n   f y = ...(case g a b of I# r -> h (T r))...\n\nand that in turn allowed SpecConstr to ramp up performance.\n\nHow do we deliver on this?  By adjusting the ug_boring_ok\nflag in mkInlineUnfoldingWithArity; see\nNote [INLINE pragmas and boring contexts]\n\nNB: there is a real risk that full laziness will float it right back\nout again. Consider again\n  x = factorial 200\n  {-# INLINE x #-}\n  f y = ...x...\n\nAfter inlining we get\n  f y = ...(factorial 200)...\n\nbut it's entirely possible that full laziness will do\n  lvl23 = factorial 200\n  f y = ...lvl23...\n\nThat's a problem for another day.\n\nNote [INLINE pragmas and boring contexts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn INLINE pragma uses mkInlineUnfoldingWithArity to build the\nunfolding.  That sets the ug_boring_ok flag to False if the function\nis not tiny (inlineBoringOK), so that even INLINE functions are not\ninlined in an utterly boring context.  E.g.\n     \\x y. Just (f y x)\nNothing is gained by inlining f here, even if it has an INLINE\npragma.\n\nBut for 0-ary bindings, we want to inline regardless; see\nNote [Honour INLINE on 0-ary bindings].\n\nI'm a bit worried that it's possible for the same kind of problem\nto arise for non-0-ary functions too, but let's wait and see.\n-}\n\nmkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr\n                -> UnfoldingGuidance -> Unfolding\n-- Occurrence-analyses the expression before capturing it\nmkCoreUnfolding src top_lvl expr guidance\n  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr_NoBinderSwap expr,\n                      -- See Note [Occurrence analysis of unfoldings]\n                    uf_src          = src,\n                    uf_is_top       = top_lvl,\n                    uf_is_value     = exprIsHNF        expr,\n                    uf_is_conlike   = exprIsConLike    expr,\n                    uf_is_work_free = exprIsWorkFree   expr,\n                    uf_expandable   = exprIsExpandable expr,\n                    uf_guidance     = guidance }\n\nmkUnfolding :: DynFlags -> UnfoldingSource\n            -> Bool       -- Is top-level\n            -> Bool       -- Definitely a bottoming binding\n                          -- (only relevant for top-level bindings)\n            -> CoreExpr\n            -> Unfolding\n-- Calculates unfolding guidance\n-- Occurrence-analyses the expression before capturing it\nmkUnfolding dflags src is_top_lvl is_bottoming expr\n  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr_NoBinderSwap expr,\n                      -- See Note [Occurrence analysis of unfoldings]\n                    uf_src          = src,\n                    uf_is_top       = is_top_lvl,\n                    uf_is_value     = exprIsHNF        expr,\n                    uf_is_conlike   = exprIsConLike    expr,\n                    uf_expandable   = exprIsExpandable expr,\n                    uf_is_work_free = exprIsWorkFree   expr,\n                    uf_guidance     = guidance }\n  where\n    is_top_bottoming = is_top_lvl && is_bottoming\n    guidance         = calcUnfoldingGuidance dflags is_top_bottoming expr\n        -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr_NoBinderSwap expr))!\n        -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]\n\n{-\nNote [Occurrence analysis of unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe do occurrence-analysis of unfoldings once and for all, when the\nunfolding is built, rather than each time we inline them.\n\nBut given this decision it's vital that we do\n*always* do it.  Consider this unfolding\n    \\x -> letrec { f = ...g...; g* = f } in body\nwhere g* is (for some strange reason) the loop breaker.  If we don't\nocc-anal it when reading it in, we won't mark g as a loop breaker, and\nwe may inline g entirely in body, dropping its binding, and leaving\nthe occurrence in f out of scope. This happened in Trac #8892, where\nthe unfolding in question was a DFun unfolding.\n\nBut more generally, the simplifier is designed on the\nbasis that it is looking at occurrence-analysed expressions, so better\nensure that they acutally are.\n\nWe use occurAnalyseExpr_NoBinderSwap instead of occurAnalyseExpr;\nsee Note [No binder swap in unfoldings].\n\nNote [No binder swap in unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe binder swap can temporarily violate Core Lint, by assinging\na LocalId binding to a GlobalId. For example, if A.foo{r872}\nis a GlobalId with unique r872, then\n\n case A.foo{r872} of bar {\n   K x -> ...(A.foo{r872})...\n }\n\ngets transformed to\n\n  case A.foo{r872} of bar {\n    K x -> let foo{r872} = bar\n           in ...(A.foo{r872})...\n\nThis is usually not a problem, because the simplifier will transform\nthis to:\n\n  case A.foo{r872} of bar {\n    K x -> ...(bar)...\n\nHowever, after occurrence analysis but before simplification, this extra 'let'\nviolates the Core Lint invariant that we do not have local 'let' bindings for\nGlobalIds.  That seems (just) tolerable for the occurrence analysis that happens\njust before the Simplifier, but not for unfoldings, which are Linted\nindependently.\nAs a quick workaround, we disable binder swap in this module.\nSee Trac #16288 and #16296 for further plans.\n\nNote [Calculate unfolding guidance on the non-occ-anal'd expression]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNotice that we give the non-occur-analysed expression to\ncalcUnfoldingGuidance.  In some ways it'd be better to occur-analyse\nfirst; for example, sometimes during simplification, there's a large\nlet-bound thing which has been substituted, and so is now dead; so\n'expr' contains two copies of the thing while the occurrence-analysed\nexpression doesn't.\n\nNevertheless, we *don't* and *must not* occ-analyse before computing\nthe size because\n\na) The size computation bales out after a while, whereas occurrence\n   analysis does not.\n\nb) Residency increases sharply if you occ-anal first.  I'm not\n   100% sure why, but it's a large effect.  Compiling Cabal went\n   from residency of 534M to over 800M with this one change.\n\nThis can occasionally mean that the guidance is very pessimistic;\nit gets fixed up next round.  And it should be rare, because large\nlet-bound things that are dead are usually caught by preInlineUnconditionally\n\n\n************************************************************************\n*                                                                      *\n\\subsection{The UnfoldingGuidance type}\n*                                                                      *\n************************************************************************\n-}\n\ninlineBoringOk :: CoreExpr -> Bool\n-- See Note [INLINE for small functions]\n-- True => the result of inlining the expression is\n--         no bigger than the expression itself\n--     eg      (\\x y -> f y x)\n-- This is a quick and dirty version. It doesn't attempt\n-- to deal with  (\\x y z -> x (y z))\n-- The really important one is (x `cast` c)\ninlineBoringOk e\n  = go 0 e\n  where\n    go :: Int -> CoreExpr -> Bool\n    go credit (Lam x e) | isId x           = go (credit+1) e\n                        | otherwise        = go credit e\n    go credit (App f (Type {}))            = go credit f\n    go credit (App f a) | credit > 0\n                        , exprIsTrivial a  = go (credit-1) f\n    go credit (Tick _ e)                 = go credit e -- dubious\n    go credit (Cast e _)                   = go credit e\n    go _      (Var {})                     = boringCxtOk\n    go _      _                            = boringCxtNotOk\n\ncalcUnfoldingGuidance\n        :: DynFlags\n        -> Bool          -- Definitely a top-level, bottoming binding\n        -> CoreExpr      -- Expression to look at\n        -> UnfoldingGuidance\ncalcUnfoldingGuidance dflags is_top_bottoming (Tick t expr)\n  | not (tickishIsCode t)  -- non-code ticks don't matter for unfolding\n  = calcUnfoldingGuidance dflags is_top_bottoming expr\ncalcUnfoldingGuidance dflags is_top_bottoming expr\n  = case sizeExpr dflags bOMB_OUT_SIZE val_bndrs body of\n      TooBig -> UnfNever\n      SizeIs size cased_bndrs scrut_discount\n        | uncondInline expr n_val_bndrs size\n        -> UnfWhen { ug_unsat_ok = unSaturatedOk\n                   , ug_boring_ok =  boringCxtOk\n                   , ug_arity = n_val_bndrs }   -- Note [INLINE for small functions]\n\n        | is_top_bottoming\n        -> UnfNever   -- See Note [Do not inline top-level bottoming functions]\n\n        | otherwise\n        -> UnfIfGoodArgs { ug_args  = map (mk_discount cased_bndrs) val_bndrs\n                         , ug_size  = size\n                         , ug_res   = scrut_discount }\n\n  where\n    (bndrs, body) = collectBinders expr\n    bOMB_OUT_SIZE = ufCreationThreshold dflags\n           -- Bomb out if size gets bigger than this\n    val_bndrs   = filter isId bndrs\n    n_val_bndrs = length val_bndrs\n\n    mk_discount :: Bag (Id,Int) -> Id -> Int\n    mk_discount cbs bndr = foldlBag combine 0 cbs\n           where\n             combine acc (bndr', disc)\n               | bndr == bndr' = acc `plus_disc` disc\n               | otherwise     = acc\n\n             plus_disc :: Int -> Int -> Int\n             plus_disc | isFunTy (idType bndr) = max\n                       | otherwise             = (+)\n             -- See Note [Function and non-function discounts]\n\n{-\nNote [Computing the size of an expression]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe basic idea of sizeExpr is obvious enough: count nodes.  But getting the\nheuristics right has taken a long time.  Here's the basic strategy:\n\n    * Variables, literals: 0\n      (Exception for string literals, see litSize.)\n\n    * Function applications (f e1 .. en): 1 + #value args\n\n    * Constructor applications: 1, regardless of #args\n\n    * Let(rec): 1 + size of components\n\n    * Note, cast: 0\n\nExamples\n\n  Size  Term\n  --------------\n    0     42#\n    0     x\n    0     True\n    2     f x\n    1     Just x\n    4     f (g x)\n\nNotice that 'x' counts 0, while (f x) counts 2.  That's deliberate: there's\na function call to account for.  Notice also that constructor applications\nare very cheap, because exposing them to a caller is so valuable.\n\n[25/5/11] All sizes are now multiplied by 10, except for primops\n(which have sizes like 1 or 4.  This makes primops look fantastically\ncheap, and seems to be almost unversally beneficial.  Done partly as a\nresult of #4978.\n\nNote [Do not inline top-level bottoming functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe FloatOut pass has gone to some trouble to float out calls to 'error'\nand similar friends.  See Note [Bottoming floats] in SetLevels.\nDo not re-inline them!  But we *do* still inline if they are very small\n(the uncondInline stuff).\n\nNote [INLINE for small functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider        {-# INLINE f #-}\n                f x = Just x\n                g y = f y\nThen f's RHS is no larger than its LHS, so we should inline it into\neven the most boring context.  In general, f the function is\nsufficiently small that its body is as small as the call itself, the\ninline unconditionally, regardless of how boring the context is.\n\nThings to note:\n\n(1) We inline *unconditionally* if inlined thing is smaller (using sizeExpr)\n    than the thing it's replacing.  Notice that\n      (f x) --> (g 3)             -- YES, unconditionally\n      (f x) --> x : []            -- YES, *even though* there are two\n                                  --      arguments to the cons\n      x     --> g 3               -- NO\n      x     --> Just v            -- NO\n\n    It's very important not to unconditionally replace a variable by\n    a non-atomic term.\n\n(2) We do this even if the thing isn't saturated, else we end up with the\n    silly situation that\n       f x y = x\n       ...map (f 3)...\n    doesn't inline.  Even in a boring context, inlining without being\n    saturated will give a lambda instead of a PAP, and will be more\n    efficient at runtime.\n\n(3) However, when the function's arity > 0, we do insist that it\n    has at least one value argument at the call site.  (This check is\n    made in the UnfWhen case of callSiteInline.) Otherwise we find this:\n         f = /\\a \\x:a. x\n         d = /\\b. MkD (f b)\n    If we inline f here we get\n         d = /\\b. MkD (\\x:b. x)\n    and then prepareRhs floats out the argument, abstracting the type\n    variables, so we end up with the original again!\n\n(4) We must be much more cautious about arity-zero things. Consider\n       let x = y +# z in ...\n    In *size* terms primops look very small, because the generate a\n    single instruction, but we do not want to unconditionally replace\n    every occurrence of x with (y +# z).  So we only do the\n    unconditional-inline thing for *trivial* expressions.\n\n    NB: you might think that PostInlineUnconditionally would do this\n    but it doesn't fire for top-level things; see SimplUtils\n    Note [Top level and postInlineUnconditionally]\n-}\n\nuncondInline :: CoreExpr -> Arity -> Int -> Bool\n-- Inline unconditionally if there no size increase\n-- Size of call is arity (+1 for the function)\n-- See Note [INLINE for small functions]\nuncondInline rhs arity size\n  | arity > 0 = size <= 10 * (arity + 1) -- See Note [INLINE for small functions] (1)\n  | otherwise = exprIsTrivial rhs        -- See Note [INLINE for small functions] (4)\n\nsizeExpr :: DynFlags\n         -> Int             -- Bomb out if it gets bigger than this\n         -> [Id]            -- Arguments; we're interested in which of these\n                            -- get case'd\n         -> CoreExpr\n         -> ExprSize\n\n-- Note [Computing the size of an expression]\n\nsizeExpr dflags bOMB_OUT_SIZE top_args expr\n  = size_up expr\n  where\n    size_up (Cast e _) = size_up e\n    size_up (Tick _ e) = size_up e\n    size_up (Type _)   = sizeZero           -- Types cost nothing\n    size_up (Coercion _) = sizeZero\n    size_up (Lit lit)  = sizeN (litSize lit)\n    size_up (Var f) | isRealWorldId f = sizeZero\n                      -- Make sure we get constructor discounts even\n                      -- on nullary constructors\n                    | otherwise       = size_up_call f [] 0\n\n    size_up (App fun arg)\n      | isTyCoArg arg = size_up fun\n      | otherwise     = size_up arg  `addSizeNSD`\n                        size_up_app fun [arg] (if isRealWorldExpr arg then 1 else 0)\n\n    size_up (Lam b e)\n      | isId b && not (isRealWorldId b) = lamScrutDiscount dflags (size_up e `addSizeN` 10)\n      | otherwise = size_up e\n\n    size_up (Let (NonRec binder rhs) body)\n      = size_up_rhs (binder, rhs) `addSizeNSD`\n        size_up body              `addSizeN`\n        size_up_alloc binder\n\n    size_up (Let (Rec pairs) body)\n      = foldr (addSizeNSD . size_up_rhs)\n              (size_up body `addSizeN` sum (map (size_up_alloc . fst) pairs))\n              pairs\n\n    size_up (Case e _ _ alts)\n        | null alts\n        = size_up e    -- case e of {} never returns, so take size of scrutinee\n\n    size_up (Case e _ _ alts)\n        -- Now alts is non-empty\n        | Just v <- is_top_arg e -- We are scrutinising an argument variable\n        = let\n            alt_sizes = map size_up_alt alts\n\n                  -- alts_size tries to compute a good discount for\n                  -- the case when we are scrutinising an argument variable\n            alts_size (SizeIs tot tot_disc tot_scrut)\n                          -- Size of all alternatives\n                      (SizeIs max _        _)\n                          -- Size of biggest alternative\n                  = SizeIs tot (unitBag (v, 20 + tot - max)\n                      `unionBags` tot_disc) tot_scrut\n                          -- If the variable is known, we produce a\n                          -- discount that will take us back to 'max',\n                          -- the size of the largest alternative The\n                          -- 1+ is a little discount for reduced\n                          -- allocation in the caller\n                          --\n                          -- Notice though, that we return tot_disc,\n                          -- the total discount from all branches.  I\n                          -- think that's right.\n\n            alts_size tot_size _ = tot_size\n          in\n          alts_size (foldr1 addAltSize alt_sizes)  -- alts is non-empty\n                    (foldr1 maxSize    alt_sizes)\n                -- Good to inline if an arg is scrutinised, because\n                -- that may eliminate allocation in the caller\n                -- And it eliminates the case itself\n        where\n          is_top_arg (Var v) | v `elem` top_args = Just v\n          is_top_arg (Cast e _) = is_top_arg e\n          is_top_arg _ = Nothing\n\n\n    size_up (Case e _ _ alts) = size_up e  `addSizeNSD`\n                                foldr (addAltSize . size_up_alt) case_size alts\n      where\n          case_size\n           | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)\n           | otherwise = sizeZero\n                -- Normally we don't charge for the case itself, but\n                -- we charge one per alternative (see size_up_alt,\n                -- below) to account for the cost of the info table\n                -- and comparisons.\n                --\n                -- However, in certain cases (see is_inline_scrut\n                -- below), no code is generated for the case unless\n                -- there are multiple alts.  In these cases we\n                -- subtract one, making the first alt free.\n                -- e.g. case x# +# y# of _ -> ...   should cost 1\n                --      case touch# x# of _ -> ...  should cost 0\n                -- (see #4978)\n                --\n                -- I would like to not have the \"lengthAtMost alts 1\"\n                -- condition above, but without that some programs got worse\n                -- (spectral/hartel/event and spectral/para).  I don't fully\n                -- understand why. (SDM 24/5/11)\n\n                -- unboxed variables, inline primops and unsafe foreign calls\n                -- are all \"inline\" things:\n          is_inline_scrut (Var v) = isUnliftedType (idType v)\n          is_inline_scrut scrut\n              | (Var f, _) <- collectArgs scrut\n                = case idDetails f of\n                    FCallId fc  -> not (isSafeForeignCall fc)\n                    PrimOpId op -> not (primOpOutOfLine op)\n                    _other      -> False\n              | otherwise\n                = False\n\n    size_up_rhs (bndr, rhs)\n      | Just join_arity <- isJoinId_maybe bndr\n        -- Skip arguments to join point\n      , (_bndrs, body) <- collectNBinders join_arity rhs\n      = size_up body\n      | otherwise\n      = size_up rhs\n\n    ------------\n    -- size_up_app is used when there's ONE OR MORE value args\n    size_up_app (App fun arg) args voids\n        | isTyCoArg arg                  = size_up_app fun args voids\n        | isRealWorldExpr arg            = size_up_app fun (arg:args) (voids + 1)\n        | otherwise                      = size_up arg  `addSizeNSD`\n                                           size_up_app fun (arg:args) voids\n    size_up_app (Var fun)     args voids = size_up_call fun args voids\n    size_up_app (Tick _ expr) args voids = size_up_app expr args voids\n    size_up_app (Cast expr _) args voids = size_up_app expr args voids\n    size_up_app other         args voids = size_up other `addSizeN`\n                                           callSize (length args) voids\n       -- if the lhs is not an App or a Var, or an invisible thing like a\n       -- Tick or Cast, then we should charge for a complete call plus the\n       -- size of the lhs itself.\n\n    ------------\n    size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize\n    size_up_call fun val_args voids\n       = case idDetails fun of\n           FCallId _        -> sizeN (callSize (length val_args) voids)\n           DataConWorkId dc -> conSize    dc (length val_args)\n           PrimOpId op      -> primOpSize op (length val_args)\n           ClassOpId _      -> classOpSize dflags top_args val_args\n           _                -> funSize dflags top_args fun (length val_args) voids\n\n    ------------\n    size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10\n        -- Don't charge for args, so that wrappers look cheap\n        -- (See comments about wrappers with Case)\n        --\n        -- IMPORTANT: *do* charge 1 for the alternative, else we\n        -- find that giant case nests are treated as practically free\n        -- A good example is Foreign.C.Error.errnoToIOError\n\n    ------------\n    -- Cost to allocate binding with given binder\n    size_up_alloc bndr\n      |  isTyVar bndr                 -- Doesn't exist at runtime\n      || isJoinId bndr                -- Not allocated at all\n      || isUnliftedType (idType bndr) -- Doesn't live in heap\n      = 0\n      | otherwise\n      = 10\n\n    ------------\n        -- These addSize things have to be here because\n        -- I don't want to give them bOMB_OUT_SIZE as an argument\n    addSizeN TooBig          _  = TooBig\n    addSizeN (SizeIs n xs d) m  = mkSizeIs bOMB_OUT_SIZE (n + m) xs d\n\n        -- addAltSize is used to add the sizes of case alternatives\n    addAltSize TooBig            _      = TooBig\n    addAltSize _                 TooBig = TooBig\n    addAltSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)\n        = mkSizeIs bOMB_OUT_SIZE (n1 + n2)\n                                 (xs `unionBags` ys)\n                                 (d1 + d2) -- Note [addAltSize result discounts]\n\n        -- This variant ignores the result discount from its LEFT argument\n        -- It's used when the second argument isn't part of the result\n    addSizeNSD TooBig            _      = TooBig\n    addSizeNSD _                 TooBig = TooBig\n    addSizeNSD (SizeIs n1 xs _) (SizeIs n2 ys d2)\n        = mkSizeIs bOMB_OUT_SIZE (n1 + n2)\n                                 (xs `unionBags` ys)\n                                 d2  -- Ignore d1\n\n    isRealWorldId id = idType id `eqType` realWorldStatePrimTy\n\n    -- an expression of type State# RealWorld must be a variable\n    isRealWorldExpr (Var id)   = isRealWorldId id\n    isRealWorldExpr (Tick _ e) = isRealWorldExpr e\n    isRealWorldExpr _          = False\n\n-- | Finds a nominal size of a string literal.\nlitSize :: Literal -> Int\n-- Used by CoreUnfold.sizeExpr\nlitSize (LitNumber LitNumInteger _ _) = 100   -- Note [Size of literal integers]\nlitSize (LitNumber LitNumNatural _ _) = 100\nlitSize (LitString str) = 10 + 10 * ((BS.length str + 3) `div` 4)\n        -- If size could be 0 then @f \"x\"@ might be too small\n        -- [Sept03: make literal strings a bit bigger to avoid fruitless\n        --  duplication of little strings]\nlitSize _other = 0    -- Must match size of nullary constructors\n                      -- Key point: if  x |-> 4, then x must inline unconditionally\n                      --            (eg via case binding)\n\nclassOpSize :: DynFlags -> [Id] -> [CoreExpr] -> ExprSize\n-- See Note [Conlike is interesting]\nclassOpSize _ _ []\n  = sizeZero\nclassOpSize dflags top_args (arg1 : other_args)\n  = SizeIs size arg_discount 0\n  where\n    size = 20 + (10 * length other_args)\n    -- If the class op is scrutinising a lambda bound dictionary then\n    -- give it a discount, to encourage the inlining of this function\n    -- The actual discount is rather arbitrarily chosen\n    arg_discount = case arg1 of\n                     Var dict | dict `elem` top_args\n                              -> unitBag (dict, ufDictDiscount dflags)\n                     _other   -> emptyBag\n\n-- | The size of a function call\ncallSize\n :: Int  -- ^ number of value args\n -> Int  -- ^ number of value args that are void\n -> Int\ncallSize n_val_args voids = 10 * (1 + n_val_args - voids)\n        -- The 1+ is for the function itself\n        -- Add 1 for each non-trivial arg;\n        -- the allocation cost, as in let(rec)\n\n-- | The size of a jump to a join point\njumpSize\n :: Int  -- ^ number of value args\n -> Int  -- ^ number of value args that are void\n -> Int\njumpSize n_val_args voids = 2 * (1 + n_val_args - voids)\n  -- A jump is 20% the size of a function call. Making jumps free reopens\n  -- bug #6048, but making them any more expensive loses a 21% improvement in\n  -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a\n  -- better solution?\n\nfunSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize\n-- Size for functions that are not constructors or primops\n-- Note [Function applications]\nfunSize dflags top_args fun n_val_args voids\n  | fun `hasKey` buildIdKey   = buildSize\n  | fun `hasKey` augmentIdKey = augmentSize\n  | otherwise = SizeIs size arg_discount res_discount\n  where\n    some_val_args = n_val_args > 0\n    is_join = isJoinId fun\n\n    size | is_join              = jumpSize n_val_args voids\n         | not some_val_args    = 0\n         | otherwise            = callSize n_val_args voids\n\n        --                  DISCOUNTS\n        --  See Note [Function and non-function discounts]\n    arg_discount | some_val_args && fun `elem` top_args\n                 = unitBag (fun, ufFunAppDiscount dflags)\n                 | otherwise = emptyBag\n        -- If the function is an argument and is applied\n        -- to some values, give it an arg-discount\n\n    res_discount | idArity fun > n_val_args = ufFunAppDiscount dflags\n                 | otherwise                = 0\n        -- If the function is partially applied, show a result discount\n-- XXX maybe behave like ConSize for eval'd variable\n\nconSize :: DataCon -> Int -> ExprSize\nconSize dc n_val_args\n  | n_val_args == 0 = SizeIs 0 emptyBag 10    -- Like variables\n\n-- See Note [Unboxed tuple size and result discount]\n  | isUnboxedTupleCon dc = SizeIs 0 emptyBag (10 * (1 + n_val_args))\n\n-- See Note [Constructor size and result discount]\n  | otherwise = SizeIs 10 emptyBag (10 * (1 + n_val_args))\n\n-- XXX still looks to large to me\n\n{-\nNote [Constructor size and result discount]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTreat a constructors application as size 10, regardless of how many\narguments it has; we are keen to expose them (and we charge separately\nfor their args).  We can't treat them as size zero, else we find that\n(Just x) has size 0, which is the same as a lone variable; and hence\n'v' will always be replaced by (Just x), where v is bound to Just x.\n\nThe \"result discount\" is applied if the result of the call is\nscrutinised (say by a case).  For a constructor application that will\nmean the constructor application will disappear, so we don't need to\ncharge it to the function.  So the discount should at least match the\ncost of the constructor application, namely 10.  But to give a bit\nof extra incentive we give a discount of 10*(1 + n_val_args).\n\nSimon M tried a MUCH bigger discount: (10 * (10 + n_val_args)),\nand said it was an \"unambiguous win\", but its terribly dangerous\nbecause a function with many many case branches, each finishing with\na constructor, can have an arbitrarily large discount.  This led to\nterrible code bloat: see Trac #6099.\n\nNote [Unboxed tuple size and result discount]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHowever, unboxed tuples count as size zero. I found occasions where we had\n        f x y z = case op# x y z of { s -> (# s, () #) }\nand f wasn't getting inlined.\n\nI tried giving unboxed tuples a *result discount* of zero (see the\ncommented-out line).  Why?  When returned as a result they do not\nallocate, so maybe we don't want to charge so much for them If you\nhave a non-zero discount here, we find that workers often get inlined\nback into wrappers, because it look like\n    f x = case $wf x of (# a,b #) -> (a,b)\nand we are keener because of the case.  However while this change\nshrank binary sizes by 0.5% it also made spectral/boyer allocate 5%\nmore. All other changes were very small. So it's not a big deal but I\ndidn't adopt the idea.\n\nNote [Function and non-function discounts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want a discount if the function is applied. A good example is\nmonadic combinators with continuation arguments, where inlining is\nquite important.\n\nBut we don't want a big discount when a function is called many times\n(see the detailed comments with Trac #6048) because if the function is\nbig it won't be inlined at its many call sites and no benefit results.\nIndeed, we can get exponentially big inlinings this way; that is what\nTrac #6048 is about.\n\nOn the other hand, for data-valued arguments, if there are lots of\ncase expressions in the body, each one will get smaller if we apply\nthe function to a constructor application, so we *want* a big discount\nif the argument is scrutinised by many case expressions.\n\nConclusion:\n  - For functions, take the max of the discounts\n  - For data values, take the sum of the discounts\n\n\nNote [Literal integer size]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLiteral integers *can* be big (mkInteger [...coefficients...]), but\nneed not be (S# n).  We just use an arbitrary big-ish constant here\nso that, in particular, we don't inline top-level defns like\n   n = S# 5\nThere's no point in doing so -- any optimisations will see the S#\nthrough n's unfolding.  Nor will a big size inhibit unfoldings functions\nthat mention a literal Integer, because the float-out pass will float\nall those constants to top level.\n-}\n\nprimOpSize :: PrimOp -> Int -> ExprSize\nprimOpSize op n_val_args\n = if primOpOutOfLine op\n      then sizeN (op_size + n_val_args)\n      else sizeN op_size\n where\n   op_size = primOpCodeSize op\n\n\nbuildSize :: ExprSize\nbuildSize = SizeIs 0 emptyBag 40\n        -- We really want to inline applications of build\n        -- build t (\\cn -> e) should cost only the cost of e (because build will be inlined later)\n        -- Indeed, we should add a result_discount because build is\n        -- very like a constructor.  We don't bother to check that the\n        -- build is saturated (it usually is).  The \"-2\" discounts for the \\c n,\n        -- The \"4\" is rather arbitrary.\n\naugmentSize :: ExprSize\naugmentSize = SizeIs 0 emptyBag 40\n        -- Ditto (augment t (\\cn -> e) ys) should cost only the cost of\n        -- e plus ys. The -2 accounts for the \\cn\n\n-- When we return a lambda, give a discount if it's used (applied)\nlamScrutDiscount :: DynFlags -> ExprSize -> ExprSize\nlamScrutDiscount dflags (SizeIs n vs _) = SizeIs n vs (ufFunAppDiscount dflags)\nlamScrutDiscount _      TooBig          = TooBig\n\n{-\nNote [addAltSize result discounts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen adding the size of alternatives, we *add* the result discounts\ntoo, rather than take the *maximum*.  For a multi-branch case, this\ngives a discount for each branch that returns a constructor, making us\nkeener to inline.  I did try using 'max' instead, but it makes nofib\n'rewrite' and 'puzzle' allocate significantly more, and didn't make\nbinary sizes shrink significantly either.\n\nNote [Discounts and thresholds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConstants for discounts and thesholds are defined in main/DynFlags,\nall of form ufXxxx.   They are:\n\nufCreationThreshold\n     At a definition site, if the unfolding is bigger than this, we\n     may discard it altogether\n\nufUseThreshold\n     At a call site, if the unfolding, less discounts, is smaller than\n     this, then it's small enough inline\n\nufKeenessFactor\n     Factor by which the discounts are multiplied before\n     subtracting from size\n\nufDictDiscount\n     The discount for each occurrence of a dictionary argument\n     as an argument of a class method.  Should be pretty small\n     else big functions may get inlined\n\nufFunAppDiscount\n     Discount for a function argument that is applied.  Quite\n     large, because if we inline we avoid the higher-order call.\n\nufDearOp\n     The size of a foreign call or not-dupable PrimOp\n\nufVeryAggressive\n     If True, the compiler ignores all the thresholds and inlines very\n     aggressively. It still adheres to arity, simplifier phase control and\n     loop breakers.\n\n\nNote [Function applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a function application (f a b)\n\n  - If 'f' is an argument to the function being analysed,\n    and there's at least one value arg, record a FunAppDiscount for f\n\n  - If the application if a PAP (arity > 2 in this example)\n    record a *result* discount (because inlining\n    with \"extra\" args in the call may mean that we now\n    get a saturated application)\n\nCode for manipulating sizes\n-}\n\n-- | The size of a candidate expression for unfolding\ndata ExprSize\n    = TooBig\n    | SizeIs { _es_size_is  :: {-# UNPACK #-} !Int -- ^ Size found\n             , _es_args     :: !(Bag (Id,Int))\n               -- ^ Arguments cased herein, and discount for each such\n             , _es_discount :: {-# UNPACK #-} !Int\n               -- ^ Size to subtract if result is scrutinised by a case\n               -- expression\n             }\n\ninstance Outputable ExprSize where\n  ppr TooBig         = text \"TooBig\"\n  ppr (SizeIs a _ c) = brackets (int a <+> int c)\n\n-- subtract the discount before deciding whether to bale out. eg. we\n-- want to inline a large constructor application into a selector:\n--      tup = (a_1, ..., a_99)\n--      x = case tup of ...\n--\nmkSizeIs :: Int -> Int -> Bag (Id, Int) -> Int -> ExprSize\nmkSizeIs max n xs d | (n - d) > max = TooBig\n                    | otherwise     = SizeIs n xs d\n\nmaxSize :: ExprSize -> ExprSize -> ExprSize\nmaxSize TooBig         _                                  = TooBig\nmaxSize _              TooBig                             = TooBig\nmaxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 > n2   = s1\n                                              | otherwise = s2\n\nsizeZero :: ExprSize\nsizeN :: Int -> ExprSize\n\nsizeZero = SizeIs 0 emptyBag 0\nsizeN n  = SizeIs n emptyBag 0\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}\n*                                                                      *\n************************************************************************\n\nWe use 'couldBeSmallEnoughToInline' to avoid exporting inlinings that\nwe ``couldn't possibly use'' on the other side.  Can be overridden w/\nflaggery.  Just the same as smallEnoughToInline, except that it has no\nactual arguments.\n-}\n\ncouldBeSmallEnoughToInline :: DynFlags -> Int -> CoreExpr -> Bool\ncouldBeSmallEnoughToInline dflags threshold rhs\n  = case sizeExpr dflags threshold [] body of\n       TooBig -> False\n       _      -> True\n  where\n    (_, body) = collectBinders rhs\n\n----------------\nsmallEnoughToInline :: DynFlags -> Unfolding -> Bool\nsmallEnoughToInline dflags (CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_size = size}})\n  = size <= ufUseThreshold dflags\nsmallEnoughToInline _ _\n  = False\n\n----------------\n\ncertainlyWillInline :: DynFlags -> IdInfo -> Maybe Unfolding\n-- Sees if the unfolding is pretty certain to inline\n-- If so, return a *stable* unfolding for it, that will always inline\ncertainlyWillInline dflags fn_info\n  = case unfoldingInfo fn_info of\n      CoreUnfolding { uf_tmpl = e, uf_guidance = g }\n        | loop_breaker -> Nothing       -- Won't inline, so try w/w\n        | otherwise    -> do_cunf e g   -- Depends on size, so look at that\n\n      DFunUnfolding {} -> Just fn_unf  -- Don't w/w DFuns; it never makes sense\n                                       -- to do so, and even if it is currently a\n                                       -- loop breaker, it may not be later\n\n      _other_unf       -> Nothing\n\n  where\n    loop_breaker = isStrongLoopBreaker (occInfo fn_info)\n    fn_unf       = unfoldingInfo fn_info\n\n    do_cunf :: CoreExpr -> UnfoldingGuidance -> Maybe Unfolding\n    do_cunf _ UnfNever     = Nothing\n    do_cunf _ (UnfWhen {}) = Just (fn_unf { uf_src = InlineStable })\n                             -- INLINE functions have UnfWhen\n\n        -- The UnfIfGoodArgs case seems important.  If we w/w small functions\n        -- binary sizes go up by 10%!  (This is with SplitObjs.)\n        -- I'm not totally sure why.\n        -- INLINABLE functions come via this path\n        --    See Note [certainlyWillInline: INLINABLE]\n    do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args })\n      | not (null args)  -- See Note [certainlyWillInline: be careful of thunks]\n      , case inlinePragmaSpec (inlinePragInfo fn_info) of\n          NoInline -> False -- NOINLINE; do not say certainlyWillInline!\n          _        -> True  -- INLINE, INLINABLE, or nothing\n      , not (isBottomingSig (strictnessInfo fn_info))\n              -- Do not unconditionally inline a bottoming functions even if\n              -- it seems smallish. We've carefully lifted it out to top level,\n              -- so we don't want to re-inline it.\n      , let arity = length args\n      , size - (10 * (arity + 1)) <= ufUseThreshold dflags\n      = Just (fn_unf { uf_src      = InlineStable\n                     , uf_guidance = UnfWhen { ug_arity     = arity\n                                             , ug_unsat_ok  = unSaturatedOk\n                                             , ug_boring_ok = inlineBoringOk expr } })\n             -- Note the \"unsaturatedOk\". A function like  f = \\ab. a\n             -- will certainly inline, even if partially applied (f e), so we'd\n             -- better make sure that the transformed inlining has the same property\n      | otherwise\n      = Nothing\n\n{- Note [certainlyWillInline: be careful of thunks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDon't claim that thunks will certainly inline, because that risks work\nduplication.  Even if the work duplication is not great (eg is_cheap\nholds), it can make a big difference in an inner loop In Trac #5623 we\nfound that the WorkWrap phase thought that\n       y = case x of F# v -> F# (v +# v)\nwas certainlyWillInline, so the addition got duplicated.\n\nNote [certainlyWillInline: INLINABLE]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ncertainlyWillInline /must/ return Nothing for a large INLINABLE thing,\neven though we have a stable inlining, so that strictness w/w takes\nplace.  It makes a big difference to efficiency, and the w/w pass knows\nhow to transfer the INLINABLE info to the worker; see WorkWrap\nNote [Worker-wrapper for INLINABLE functions]\n\n************************************************************************\n*                                                                      *\n\\subsection{callSiteInline}\n*                                                                      *\n************************************************************************\n\nThis is the key function.  It decides whether to inline a variable at a call site\n\ncallSiteInline is used at call sites, so it is a bit more generous.\nIt's a very important function that embodies lots of heuristics.\nA non-WHNF can be inlined if it doesn't occur inside a lambda,\nand occurs exactly once or\n    occurs once in each branch of a case and is small\n\nIf the thing is in WHNF, there's no danger of duplicating work,\nso we can inline if it occurs once, or is small\n\nNOTE: we don't want to inline top-level functions that always diverge.\nIt just makes the code bigger.  Tt turns out that the convenient way to prevent\nthem inlining is to give them a NOINLINE pragma, which we do in\nStrictAnal.addStrictnessInfoToTopId\n-}\n\ncallSiteInline :: DynFlags\n               -> Id                    -- The Id\n               -> Bool                  -- True <=> unfolding is active\n               -> Bool                  -- True if there are no arguments at all (incl type args)\n               -> [ArgSummary]          -- One for each value arg; True if it is interesting\n               -> CallCtxt              -- True <=> continuation is interesting\n               -> Maybe CoreExpr        -- Unfolding, if any\n\ndata ArgSummary = TrivArg       -- Nothing interesting\n                | NonTrivArg    -- Arg has structure\n                | ValueArg      -- Arg is a con-app or PAP\n                                -- ..or con-like. Note [Conlike is interesting]\n\ninstance Outputable ArgSummary where\n  ppr TrivArg    = text \"TrivArg\"\n  ppr NonTrivArg = text \"NonTrivArg\"\n  ppr ValueArg   = text \"ValueArg\"\n\nnonTriv ::  ArgSummary -> Bool\nnonTriv TrivArg = False\nnonTriv _       = True\n\ndata CallCtxt\n  = BoringCtxt\n  | RhsCtxt             -- Rhs of a let-binding; see Note [RHS of lets]\n  | DiscArgCtxt         -- Argument of a function with non-zero arg discount\n  | RuleArgCtxt         -- We are somewhere in the argument of a function with rules\n\n  | ValAppCtxt          -- We're applied to at least one value arg\n                        -- This arises when we have ((f x |> co) y)\n                        -- Then the (f x) has argument 'x' but in a ValAppCtxt\n\n  | CaseCtxt            -- We're the scrutinee of a case\n                        -- that decomposes its scrutinee\n\ninstance Outputable CallCtxt where\n  ppr CaseCtxt    = text \"CaseCtxt\"\n  ppr ValAppCtxt  = text \"ValAppCtxt\"\n  ppr BoringCtxt  = text \"BoringCtxt\"\n  ppr RhsCtxt     = text \"RhsCtxt\"\n  ppr DiscArgCtxt = text \"DiscArgCtxt\"\n  ppr RuleArgCtxt = text \"RuleArgCtxt\"\n\ncallSiteInline dflags id active_unfolding lone_variable arg_infos cont_info\n  = case idUnfolding id of\n      -- idUnfolding checks for loop-breakers, returning NoUnfolding\n      -- Things with an INLINE pragma may have an unfolding *and*\n      -- be a loop breaker  (maybe the knot is not yet untied)\n        CoreUnfolding { uf_tmpl = unf_template\n                      , uf_is_work_free = is_wf\n                      , uf_guidance = guidance, uf_expandable = is_exp }\n          | active_unfolding -> tryUnfolding dflags id lone_variable\n                                    arg_infos cont_info unf_template\n                                    is_wf is_exp guidance\n          | otherwise -> traceInline dflags id \"Inactive unfolding:\" (ppr id) Nothing\n        NoUnfolding      -> Nothing\n        BootUnfolding    -> Nothing\n        OtherCon {}      -> Nothing\n        DFunUnfolding {} -> Nothing     -- Never unfold a DFun\n\ntraceInline :: DynFlags -> Id -> String -> SDoc -> a -> a\ntraceInline dflags inline_id str doc result\n | Just prefix <- inlineCheck dflags\n =  if prefix `isPrefixOf` occNameString (getOccName inline_id)\n      then pprTrace str doc result\n      else result\n | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags\n = pprTrace str doc result\n | otherwise\n = result\n\ntryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt\n             -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance\n             -> Maybe CoreExpr\ntryUnfolding dflags id lone_variable\n             arg_infos cont_info unf_template\n             is_wf is_exp guidance\n = case guidance of\n     UnfNever -> traceInline dflags id str (text \"UnfNever\") Nothing\n\n     UnfWhen { ug_arity = uf_arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }\n        | enough_args && (boring_ok || some_benefit || ufVeryAggressive dflags)\n                -- See Note [INLINE for small functions (3)]\n        -> traceInline dflags id str (mk_doc some_benefit empty True) (Just unf_template)\n        | otherwise\n        -> traceInline dflags id str (mk_doc some_benefit empty False) Nothing\n        where\n          some_benefit = calc_some_benefit uf_arity\n          enough_args = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)\n\n     UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }\n        | ufVeryAggressive dflags\n        -> traceInline dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)\n        | is_wf && some_benefit && small_enough\n        -> traceInline dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)\n        | otherwise\n        -> traceInline dflags id str (mk_doc some_benefit extra_doc False) Nothing\n        where\n          some_benefit = calc_some_benefit (length arg_discounts)\n          extra_doc = text \"discounted size =\" <+> int discounted_size\n          discounted_size = size - discount\n          small_enough = discounted_size <= ufUseThreshold dflags\n          discount = computeDiscount dflags arg_discounts\n                                     res_discount arg_infos cont_info\n\n  where\n    mk_doc some_benefit extra_doc yes_or_no\n      = vcat [ text \"arg infos\" <+> ppr arg_infos\n             , text \"interesting continuation\" <+> ppr cont_info\n             , text \"some_benefit\" <+> ppr some_benefit\n             , text \"is exp:\" <+> ppr is_exp\n             , text \"is work-free:\" <+> ppr is_wf\n             , text \"guidance\" <+> ppr guidance\n             , extra_doc\n             , text \"ANSWER =\" <+> if yes_or_no then text \"YES\" else text \"NO\"]\n\n    str = \"Considering inlining: \" ++ showSDocDump dflags (ppr id)\n    n_val_args = length arg_infos\n\n           -- some_benefit is used when the RHS is small enough\n           -- and the call has enough (or too many) value\n           -- arguments (ie n_val_args >= arity). But there must\n           -- be *something* interesting about some argument, or the\n           -- result context, to make it worth inlining\n    calc_some_benefit :: Arity -> Bool   -- The Arity is the number of args\n                                         -- expected by the unfolding\n    calc_some_benefit uf_arity\n       | not saturated = interesting_args       -- Under-saturated\n                                        -- Note [Unsaturated applications]\n       | otherwise = interesting_args   -- Saturated or over-saturated\n                  || interesting_call\n      where\n        saturated      = n_val_args >= uf_arity\n        over_saturated = n_val_args > uf_arity\n        interesting_args = any nonTriv arg_infos\n                -- NB: (any nonTriv arg_infos) looks at the\n                -- over-saturated args too which is \"wrong\";\n                -- but if over-saturated we inline anyway.\n\n        interesting_call\n          | over_saturated\n          = True\n          | otherwise\n          = case cont_info of\n              CaseCtxt   -> not (lone_variable && is_exp)  -- Note [Lone variables]\n              ValAppCtxt -> True                           -- Note [Cast then apply]\n              RuleArgCtxt -> uf_arity > 0  -- See Note [Unfold info lazy contexts]\n              DiscArgCtxt -> uf_arity > 0  -- Note [Inlining in ArgCtxt]\n              RhsCtxt     -> uf_arity > 0  --\n              _other      -> False         -- See Note [Nested functions]\n\n\n{-\nNote [Unfold into lazy contexts], Note [RHS of lets]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the call is the argument of a function with a RULE, or the RHS of a let,\nwe are a little bit keener to inline.  For example\n     f y = (y,y,y)\n     g y = let x = f y in ...(case x of (a,b,c) -> ...) ...\nWe'd inline 'f' if the call was in a case context, and it kind-of-is,\nonly we can't see it.  Also\n     x = f v\ncould be expensive whereas\n     x = case v of (a,b) -> a\nis patently cheap and may allow more eta expansion.\nSo we treat the RHS of a let as not-totally-boring.\n\nNote [Unsaturated applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen a call is not saturated, we *still* inline if one of the\narguments has interesting structure.  That's sometimes very important.\nA good example is the Ord instance for Bool in Base:\n\n Rec {\n    $fOrdBool =GHC.Classes.D:Ord\n                 @ Bool\n                 ...\n                 $cmin_ajX\n\n    $cmin_ajX [Occ=LoopBreaker] :: Bool -> Bool -> Bool\n    $cmin_ajX = GHC.Classes.$dmmin @ Bool $fOrdBool\n  }\n\nBut the defn of GHC.Classes.$dmmin is:\n\n  $dmmin :: forall a. GHC.Classes.Ord a => a -> a -> a\n    {- Arity: 3, HasNoCafRefs, Strictness: SLL,\n       Unfolding: (\\ @ a $dOrd :: GHC.Classes.Ord a x :: a y :: a ->\n                   case @ a GHC.Classes.<= @ a $dOrd x y of wild {\n                     GHC.Types.False -> y GHC.Types.True -> x }) -}\n\nWe *really* want to inline $dmmin, even though it has arity 3, in\norder to unravel the recursion.\n\n\nNote [Things to watch]\n~~~~~~~~~~~~~~~~~~~~~~\n*   { y = I# 3; x = y `cast` co; ...case (x `cast` co) of ... }\n    Assume x is exported, so not inlined unconditionally.\n    Then we want x to inline unconditionally; no reason for it\n    not to, and doing so avoids an indirection.\n\n*   { x = I# 3; ....f x.... }\n    Make sure that x does not inline unconditionally!\n    Lest we get extra allocation.\n\nNote [Inlining an InlineRule]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn InlineRules is used for\n  (a) programmer INLINE pragmas\n  (b) inlinings from worker/wrapper\n\nFor (a) the RHS may be large, and our contract is that we *only* inline\nwhen the function is applied to all the arguments on the LHS of the\nsource-code defn.  (The uf_arity in the rule.)\n\nHowever for worker/wrapper it may be worth inlining even if the\narity is not satisfied (as we do in the CoreUnfolding case) so we don't\nrequire saturation.\n\nNote [Nested functions]\n~~~~~~~~~~~~~~~~~~~~~~~\nAt one time we treated a call of a non-top-level function as\n\"interesting\" (regardless of how boring the context) in the hope\nthat inlining it would eliminate the binding, and its allocation.\nSpecifically, in the default case of interesting_call we had\n   _other -> not is_top && uf_arity > 0\n\nBut actually postInlineUnconditionally does some of this and overall\nit makes virtually no difference to nofib.  So I simplified away this\nspecial case\n\nNote [Cast then apply]\n~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   myIndex = __inline_me ( (/\\a. <blah>) |> co )\n   co :: (forall a. a -> a) ~ (forall a. T a)\n     ... /\\a.\\x. case ((myIndex a) |> sym co) x of { ... } ...\n\nWe need to inline myIndex to unravel this; but the actual call (myIndex a) has\nno value arguments.  The ValAppCtxt gives it enough incentive to inline.\n\nNote [Inlining in ArgCtxt]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe condition (arity > 0) here is very important, because otherwise\nwe end up inlining top-level stuff into useless places; eg\n   x = I# 3#\n   f = \\y.  g x\nThis can make a very big difference: it adds 16% to nofib 'integer' allocs,\nand 20% to 'power'.\n\nAt one stage I replaced this condition by 'True' (leading to the above\nslow-down).  The motivation was test eyeball/inline1.hs; but that seems\nto work ok now.\n\nNOTE: arguably, we should inline in ArgCtxt only if the result of the\ncall is at least CONLIKE.  At least for the cases where we use ArgCtxt\nfor the RHS of a 'let', we only profit from the inlining if we get a\nCONLIKE thing (modulo lets).\n\nNote [Lone variables]   See also Note [Interaction of exprIsWorkFree and lone variables]\n~~~~~~~~~~~~~~~~~~~~~   which appears below\nThe \"lone-variable\" case is important.  I spent ages messing about\nwith unsatisfactory variants, but this is nice.  The idea is that if a\nvariable appears all alone\n\n        as an arg of lazy fn, or rhs    BoringCtxt\n        as scrutinee of a case          CaseCtxt\n        as arg of a fn                  ArgCtxt\nAND\n        it is bound to a cheap expression\n\nthen we should not inline it (unless there is some other reason,\ne.g. it is the sole occurrence).  That is what is happening at\nthe use of 'lone_variable' in 'interesting_call'.\n\nWhy?  At least in the case-scrutinee situation, turning\n        let x = (a,b) in case x of y -> ...\ninto\n        let x = (a,b) in case (a,b) of y -> ...\nand thence to\n        let x = (a,b) in let y = (a,b) in ...\nis bad if the binding for x will remain.\n\nAnother example: I discovered that strings\nwere getting inlined straight back into applications of 'error'\nbecause the latter is strict.\n        s = \"foo\"\n        f = \\x -> ...(error s)...\n\nFundamentally such contexts should not encourage inlining because, provided\nthe RHS is \"expandable\" (see Note [exprIsExpandable] in CoreUtils) the\ncontext can ``see'' the unfolding of the variable (e.g. case or a\nRULE) so there's no gain.\n\nHowever, watch out:\n\n * Consider this:\n        foo = _inline_ (\\n. [n])\n        bar = _inline_ (foo 20)\n        baz = \\n. case bar of { (m:_) -> m + n }\n   Here we really want to inline 'bar' so that we can inline 'foo'\n   and the whole thing unravels as it should obviously do.  This is\n   important: in the NDP project, 'bar' generates a closure data\n   structure rather than a list.\n\n   So the non-inlining of lone_variables should only apply if the\n   unfolding is regarded as cheap; because that is when exprIsConApp_maybe\n   looks through the unfolding.  Hence the \"&& is_wf\" in the\n   InlineRule branch.\n\n * Even a type application or coercion isn't a lone variable.\n   Consider\n        case $fMonadST @ RealWorld of { :DMonad a b c -> c }\n   We had better inline that sucker!  The case won't see through it.\n\n   For now, I'm treating treating a variable applied to types\n   in a *lazy* context \"lone\". The motivating example was\n        f = /\\a. \\x. BIG\n        g = /\\a. \\y.  h (f a)\n   There's no advantage in inlining f here, and perhaps\n   a significant disadvantage.  Hence some_val_args in the Stop case\n\nNote [Interaction of exprIsWorkFree and lone variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe lone-variable test says \"don't inline if a case expression\nscrutinises a lone variable whose unfolding is cheap\".  It's very\nimportant that, under these circumstances, exprIsConApp_maybe\ncan spot a constructor application. So, for example, we don't\nconsider\n        let x = e in (x,x)\nto be cheap, and that's good because exprIsConApp_maybe doesn't\nthink that expression is a constructor application.\n\nIn the 'not (lone_variable && is_wf)' test, I used to test is_value\nrather than is_wf, which was utterly wrong, because the above\nexpression responds True to exprIsHNF, which is what sets is_value.\n\nThis kind of thing can occur if you have\n\n        {-# INLINE foo #-}\n        foo = let x = e in (x,x)\n\nwhich Roman did.\n\n\n-}\n\ncomputeDiscount :: DynFlags -> [Int] -> Int -> [ArgSummary] -> CallCtxt\n                -> Int\ncomputeDiscount dflags arg_discounts res_discount arg_infos cont_info\n        -- We multiple the raw discounts (args_discount and result_discount)\n        -- ty opt_UnfoldingKeenessFactor because the former have to do with\n        --  *size* whereas the discounts imply that there's some extra\n        --  *efficiency* to be gained (e.g. beta reductions, case reductions)\n        -- by inlining.\n\n  = 10          -- Discount of 10 because the result replaces the call\n                -- so we count 10 for the function itself\n\n    + 10 * length actual_arg_discounts\n               -- Discount of 10 for each arg supplied,\n               -- because the result replaces the call\n\n    + round (ufKeenessFactor dflags *\n             fromIntegral (total_arg_discount + res_discount'))\n  where\n    actual_arg_discounts = zipWith mk_arg_discount arg_discounts arg_infos\n    total_arg_discount   = sum actual_arg_discounts\n\n    mk_arg_discount _        TrivArg    = 0\n    mk_arg_discount _        NonTrivArg = 10\n    mk_arg_discount discount ValueArg   = discount\n\n    res_discount'\n      | LT <- arg_discounts `compareLength` arg_infos\n      = res_discount   -- Over-saturated\n      | otherwise\n      = case cont_info of\n           BoringCtxt  -> 0\n           CaseCtxt    -> res_discount  -- Presumably a constructor\n           ValAppCtxt  -> res_discount  -- Presumably a function\n           _           -> 40 `min` res_discount\n                -- ToDo: this 40 `min` res_discount doesn't seem right\n                --   for DiscArgCtxt it shouldn't matter because the function will\n                --       get the arg discount for any non-triv arg\n                --   for RuleArgCtxt we do want to be keener to inline; but not only\n                --       constructor results\n                --   for RhsCtxt I suppose that exposing a data con is good in general\n                --   And 40 seems very arbitrary\n                --\n                -- res_discount can be very large when a function returns\n                -- constructors; but we only want to invoke that large discount\n                -- when there's a case continuation.\n                -- Otherwise we, rather arbitrarily, threshold it.  Yuk.\n                -- But we want to aovid inlining large functions that return\n                -- constructors into contexts that are simply \"interesting\"\n", "num_lines": 1607}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nUtility functions on @Core@ syntax\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- | Commonly useful utilites for manipulating the Core language\nmodule CoreUtils (\n        -- * Constructing expressions\n        mkCast,\n        mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,\n        bindNonRec, needsCaseBinding,\n        mkAltExpr,\n\n        -- * Taking expressions apart\n        findDefault, addDefault, findAlt, isDefaultAlt,\n        mergeAlts, trimConArgs,\n        filterAlts, combineIdenticalAlts, refineDefaultAlt,\n\n        -- * Properties of expressions\n        exprType, coreAltType, coreAltsType, isExprLevPoly,\n        exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsBottom,\n        getIdFromTrivialExpr_maybe,\n        exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,\n        exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprIsWorkFree,\n        exprIsBig, exprIsConLike,\n        rhsIsStatic, isCheapApp, isExpandableApp,\n        exprIsTickedString, exprIsTickedString_maybe,\n        exprIsTopLevelBindable,\n        altsAreExhaustive,\n\n        -- * Equality\n        cheapEqExpr, cheapEqExpr', eqExpr,\n        diffExpr, diffBinds,\n\n        -- * Eta reduction\n        tryEtaReduce,\n\n        -- * Manipulating data constructors and types\n        exprToType, exprToCoercion_maybe,\n        applyTypeToArgs, applyTypeToArg,\n        dataConRepInstPat, dataConRepFSInstPat,\n        isEmptyTy,\n\n        -- * Working with ticks\n        stripTicksTop, stripTicksTopE, stripTicksTopT,\n        stripTicksE, stripTicksT,\n\n        -- * StaticPtr\n        collectMakeStaticArgs,\n\n        -- * Join points\n        isJoinBind\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport PrelNames ( makeStaticName )\nimport PprCore\nimport CoreFVs( exprFreeVars )\nimport Var\nimport SrcLoc\nimport VarEnv\nimport VarSet\nimport Name\nimport Literal\nimport DataCon\nimport PrimOp\nimport Id\nimport IdInfo\nimport PrelNames( absentErrorIdKey )\nimport Type\nimport TyCoRep( TyCoBinder(..), TyBinder )\nimport Coercion\nimport TyCon\nimport Unique\nimport Outputable\nimport TysPrim\nimport DynFlags\nimport FastString\nimport Maybes\nimport ListSetOps       ( minusList )\nimport BasicTypes       ( Arity, isConLike )\nimport Platform\nimport Util\nimport Pair\nimport Data.ByteString     ( ByteString )\nimport Data.Function       ( on )\nimport Data.List\nimport Data.Ord            ( comparing )\nimport OrdList\nimport qualified Data.Set as Set\nimport UniqSet\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Find the type of a Core atom/expression}\n*                                                                      *\n************************************************************************\n-}\n\nexprType :: CoreExpr -> Type\n-- ^ Recover the type of a well-typed Core expression. Fails when\n-- applied to the actual 'CoreSyn.Type' expression as it cannot\n-- really be said to have a type\nexprType (Var var)           = idType var\nexprType (Lit lit)           = literalType lit\nexprType (Coercion co)       = coercionType co\nexprType (Let bind body)\n  | NonRec tv rhs <- bind    -- See Note [Type bindings]\n  , Type ty <- rhs           = substTyWithUnchecked [tv] [ty] (exprType body)\n  | otherwise                = exprType body\nexprType (Case _ _ ty _)     = ty\nexprType (Cast _ co)         = pSnd (coercionKind co)\nexprType (Tick _ e)          = exprType e\nexprType (Lam binder expr)   = mkLamType binder (exprType expr)\nexprType e@(App _ _)\n  = case collectArgs e of\n        (fun, args) -> applyTypeToArgs e (exprType fun) args\n\nexprType other = pprTrace \"exprType\" (pprCoreExpr other) alphaTy\n\ncoreAltType :: CoreAlt -> Type\n-- ^ Returns the type of the alternatives right hand side\ncoreAltType alt@(_,bs,rhs)\n  = case occCheckExpand bs rhs_ty of\n      -- Note [Existential variables and silly type synonyms]\n      Just ty -> ty\n      Nothing -> pprPanic \"coreAltType\" (pprCoreAlt alt $$ ppr rhs_ty)\n  where\n    rhs_ty = exprType rhs\n\ncoreAltsType :: [CoreAlt] -> Type\n-- ^ Returns the type of the first alternative, which should be the same as for all alternatives\ncoreAltsType (alt:_) = coreAltType alt\ncoreAltsType []      = panic \"corAltsType\"\n\n-- | Is this expression levity polymorphic? This should be the\n-- same as saying (isKindLevPoly . typeKind . exprType) but\n-- much faster.\nisExprLevPoly :: CoreExpr -> Bool\nisExprLevPoly = go\n  where\n   go (Var _)                      = False  -- no levity-polymorphic binders\n   go (Lit _)                      = False  -- no levity-polymorphic literals\n   go e@(App f _) | not (go_app f) = False\n                  | otherwise      = check_type e\n   go (Lam _ _)                    = False\n   go (Let _ e)                    = go e\n   go e@(Case {})                  = check_type e -- checking type is fast\n   go e@(Cast {})                  = check_type e\n   go (Tick _ e)                   = go e\n   go e@(Type {})                  = pprPanic \"isExprLevPoly ty\" (ppr e)\n   go (Coercion {})                = False  -- this case can happen in SetLevels\n\n   check_type = isTypeLevPoly . exprType  -- slow approach\n\n      -- if the function is a variable (common case), check its\n      -- levityInfo. This might mean we don't need to look up and compute\n      -- on the type. Spec of these functions: return False if there is\n      -- no possibility, ever, of this expression becoming levity polymorphic,\n      -- no matter what it's applied to; return True otherwise.\n      -- returning True is always safe. See also Note [Levity info] in\n      -- IdInfo\n   go_app (Var id)        = not (isNeverLevPolyId id)\n   go_app (Lit _)         = False\n   go_app (App f _)       = go_app f\n   go_app (Lam _ e)       = go_app e\n   go_app (Let _ e)       = go_app e\n   go_app (Case _ _ ty _) = resultIsLevPoly ty\n   go_app (Cast _ co)     = resultIsLevPoly (pSnd $ coercionKind co)\n   go_app (Tick _ e)      = go_app e\n   go_app e@(Type {})     = pprPanic \"isExprLevPoly app ty\" (ppr e)\n   go_app e@(Coercion {}) = pprPanic \"isExprLevPoly app co\" (ppr e)\n\n\n{-\nNote [Type bindings]\n~~~~~~~~~~~~~~~~~~~~\nCore does allow type bindings, although such bindings are\nnot much used, except in the output of the desugarer.\nExample:\n     let a = Int in (\\x:a. x)\nGiven this, exprType must be careful to substitute 'a' in the\nresult type (Trac #8522).\n\nNote [Existential variables and silly type synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n        data T = forall a. T (Funny a)\n        type Funny a = Bool\n        f :: T -> Bool\n        f (T x) = x\n\nNow, the type of 'x' is (Funny a), where 'a' is existentially quantified.\nThat means that 'exprType' and 'coreAltsType' may give a result that *appears*\nto mention an out-of-scope type variable.  See Trac #3409 for a more real-world\nexample.\n\nVarious possibilities suggest themselves:\n\n - Ignore the problem, and make Lint not complain about such variables\n\n - Expand all type synonyms (or at least all those that discard arguments)\n      This is tricky, because at least for top-level things we want to\n      retain the type the user originally specified.\n\n - Expand synonyms on the fly, when the problem arises. That is what\n   we are doing here.  It's not too expensive, I think.\n\nNote that there might be existentially quantified coercion variables, too.\n-}\n\n-- Not defined with applyTypeToArg because you can't print from CoreSyn.\napplyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type\n-- ^ A more efficient version of 'applyTypeToArg' when we have several arguments.\n-- The first argument is just for debugging, and gives some context\napplyTypeToArgs e op_ty args\n  = go op_ty args\n  where\n    go op_ty []                   = op_ty\n    go op_ty (Type ty : args)     = go_ty_args op_ty [ty] args\n    go op_ty (Coercion co : args) = go_ty_args op_ty [mkCoercionTy co] args\n    go op_ty (_ : args)           | Just (_, res_ty) <- splitFunTy_maybe op_ty\n                                  = go res_ty args\n    go _ _ = pprPanic \"applyTypeToArgs\" panic_msg\n\n    -- go_ty_args: accumulate type arguments so we can\n    -- instantiate all at once with piResultTys\n    go_ty_args op_ty rev_tys (Type ty : args)\n       = go_ty_args op_ty (ty:rev_tys) args\n    go_ty_args op_ty rev_tys (Coercion co : args)\n       = go_ty_args op_ty (mkCoercionTy co : rev_tys) args\n    go_ty_args op_ty rev_tys args\n       = go (piResultTys op_ty (reverse rev_tys)) args\n\n    panic_msg = vcat [ text \"Expression:\" <+> pprCoreExpr e\n                     , text \"Type:\" <+> ppr op_ty\n                     , text \"Args:\" <+> ppr args ]\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Attaching notes}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Wrap the given expression in the coercion safely, dropping\n-- identity coercions and coalescing nested coercions\nmkCast :: CoreExpr -> CoercionR -> CoreExpr\nmkCast e co\n  | ASSERT2( coercionRole co == Representational\n           , text \"coercion\" <+> ppr co <+> ptext (sLit \"passed to mkCast\")\n             <+> ppr e <+> text \"has wrong role\" <+> ppr (coercionRole co) )\n    isReflCo co\n  = e\n\nmkCast (Coercion e_co) co\n  | isCoVarType (pSnd (coercionKind co))\n       -- The guard here checks that g has a (~#) on both sides,\n       -- otherwise decomposeCo fails.  Can in principle happen\n       -- with unsafeCoerce\n  = Coercion (mkCoCast e_co co)\n\nmkCast (Cast expr co2) co\n  = WARN(let { Pair  from_ty  _to_ty  = coercionKind co;\n               Pair _from_ty2  to_ty2 = coercionKind co2} in\n            not (from_ty `eqType` to_ty2),\n             vcat ([ text \"expr:\" <+> ppr expr\n                   , text \"co2:\" <+> ppr co2\n                   , text \"co:\" <+> ppr co ]) )\n    mkCast expr (mkTransCo co2 co)\n\nmkCast (Tick t expr) co\n   = Tick t (mkCast expr co)\n\nmkCast expr co\n  = let Pair from_ty _to_ty = coercionKind co in\n    WARN( not (from_ty `eqType` exprType expr),\n          text \"Trying to coerce\" <+> text \"(\" <> ppr expr\n          $$ text \"::\" <+> ppr (exprType expr) <> text \")\"\n          $$ ppr co $$ ppr (coercionType co) )\n    (Cast expr co)\n\n-- | Wraps the given expression in the source annotation, dropping the\n-- annotation if possible.\nmkTick :: Tickish Id -> CoreExpr -> CoreExpr\nmkTick t orig_expr = mkTick' id id orig_expr\n where\n  -- Some ticks (cost-centres) can be split in two, with the\n  -- non-counting part having laxer placement properties.\n  canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t\n\n  mkTick' :: (CoreExpr -> CoreExpr) -- ^ apply after adding tick (float through)\n          -> (CoreExpr -> CoreExpr) -- ^ apply before adding tick (float with)\n          -> CoreExpr               -- ^ current expression\n          -> CoreExpr\n  mkTick' top rest expr = case expr of\n\n    -- Cost centre ticks should never be reordered relative to each\n    -- other. Therefore we can stop whenever two collide.\n    Tick t2 e\n      | ProfNote{} <- t2, ProfNote{} <- t -> top $ Tick t $ rest expr\n\n    -- Otherwise we assume that ticks of different placements float\n    -- through each other.\n      | tickishPlace t2 /= tickishPlace t -> mkTick' (top . Tick t2) rest e\n\n    -- For annotations this is where we make sure to not introduce\n    -- redundant ticks.\n      | tickishContains t t2              -> mkTick' top rest e\n      | tickishContains t2 t              -> orig_expr\n      | otherwise                         -> mkTick' top (rest . Tick t2) e\n\n    -- Ticks don't care about types, so we just float all ticks\n    -- through them. Note that it's not enough to check for these\n    -- cases top-level. While mkTick will never produce Core with type\n    -- expressions below ticks, such constructs can be the result of\n    -- unfoldings. We therefore make an effort to put everything into\n    -- the right place no matter what we start with.\n    Cast e co   -> mkTick' (top . flip Cast co) rest e\n    Coercion co -> Coercion co\n\n    Lam x e\n      -- Always float through type lambdas. Even for non-type lambdas,\n      -- floating is allowed for all but the most strict placement rule.\n      | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime\n      -> mkTick' (top . Lam x) rest e\n\n      -- If it is both counting and scoped, we split the tick into its\n      -- two components, often allowing us to keep the counting tick on\n      -- the outside of the lambda and push the scoped tick inside.\n      -- The point of this is that the counting tick can probably be\n      -- floated, and the lambda may then be in a position to be\n      -- beta-reduced.\n      | canSplit\n      -> top $ Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e\n\n    App f arg\n      -- Always float through type applications.\n      | not (isRuntimeArg arg)\n      -> mkTick' (top . flip App arg) rest f\n\n      -- We can also float through constructor applications, placement\n      -- permitting. Again we can split.\n      | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit)\n      -> if tickishPlace t == PlaceCostCentre\n         then top $ rest $ tickHNFArgs t expr\n         else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr\n\n    Var x\n      | notFunction && tickishPlace t == PlaceCostCentre\n      -> orig_expr\n      | notFunction && canSplit\n      -> top $ Tick (mkNoScope t) $ rest expr\n      where\n        -- SCCs can be eliminated on variables provided the variable\n        -- is not a function.  In these cases the SCC makes no difference:\n        -- the cost of evaluating the variable will be attributed to its\n        -- definition site.  When the variable refers to a function, however,\n        -- an SCC annotation on the variable affects the cost-centre stack\n        -- when the function is called, so we must retain those.\n        notFunction = not (isFunTy (idType x))\n\n    Lit{}\n      | tickishPlace t == PlaceCostCentre\n      -> orig_expr\n\n    -- Catch-all: Annotate where we stand\n    _any -> top $ Tick t $ rest expr\n\nmkTicks :: [Tickish Id] -> CoreExpr -> CoreExpr\nmkTicks ticks expr = foldr mkTick expr ticks\n\nisSaturatedConApp :: CoreExpr -> Bool\nisSaturatedConApp e = go e []\n  where go (App f a) as = go f (a:as)\n        go (Var fun) args\n           = isConLikeId fun && idArity fun == valArgCount args\n        go (Cast f _) as = go f as\n        go _ _ = False\n\nmkTickNoHNF :: Tickish Id -> CoreExpr -> CoreExpr\nmkTickNoHNF t e\n  | exprIsHNF e = tickHNFArgs t e\n  | otherwise   = mkTick t e\n\n-- push a tick into the arguments of a HNF (call or constructor app)\ntickHNFArgs :: Tickish Id -> CoreExpr -> CoreExpr\ntickHNFArgs t e = push t e\n where\n  push t (App f (Type u)) = App (push t f) (Type u)\n  push t (App f arg) = App (push t f) (mkTick t arg)\n  push _t e = e\n\n-- | Strip ticks satisfying a predicate from top of an expression\nstripTicksTop :: (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b)\nstripTicksTop p = go []\n  where go ts (Tick t e) | p t = go (t:ts) e\n        go ts other            = (reverse ts, other)\n\n-- | Strip ticks satisfying a predicate from top of an expression,\n-- returning the remaining expression\nstripTicksTopE :: (Tickish Id -> Bool) -> Expr b -> Expr b\nstripTicksTopE p = go\n  where go (Tick t e) | p t = go e\n        go other            = other\n\n-- | Strip ticks satisfying a predicate from top of an expression,\n-- returning the ticks\nstripTicksTopT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id]\nstripTicksTopT p = go []\n  where go ts (Tick t e) | p t = go (t:ts) e\n        go ts _                = ts\n\n-- | Completely strip ticks satisfying a predicate from an\n-- expression. Note this is O(n) in the size of the expression!\nstripTicksE :: (Tickish Id -> Bool) -> Expr b -> Expr b\nstripTicksE p expr = go expr\n  where go (App e a)        = App (go e) (go a)\n        go (Lam b e)        = Lam b (go e)\n        go (Let b e)        = Let (go_bs b) (go e)\n        go (Case e b t as)  = Case (go e) b t (map go_a as)\n        go (Cast e c)       = Cast (go e) c\n        go (Tick t e)\n          | p t             = go e\n          | otherwise       = Tick t (go e)\n        go other            = other\n        go_bs (NonRec b e)  = NonRec b (go e)\n        go_bs (Rec bs)      = Rec (map go_b bs)\n        go_b (b, e)         = (b, go e)\n        go_a (c,bs,e)       = (c,bs, go e)\n\nstripTicksT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id]\nstripTicksT p expr = fromOL $ go expr\n  where go (App e a)        = go e `appOL` go a\n        go (Lam _ e)        = go e\n        go (Let b e)        = go_bs b `appOL` go e\n        go (Case e _ _ as)  = go e `appOL` concatOL (map go_a as)\n        go (Cast e _)       = go e\n        go (Tick t e)\n          | p t             = t `consOL` go e\n          | otherwise       = go e\n        go _                = nilOL\n        go_bs (NonRec _ e)  = go e\n        go_bs (Rec bs)      = concatOL (map go_b bs)\n        go_b (_, e)         = go e\n        go_a (_, _, e)      = go e\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Other expression construction}\n*                                                                      *\n************************************************************************\n-}\n\nbindNonRec :: Id -> CoreExpr -> CoreExpr -> CoreExpr\n-- ^ @bindNonRec x r b@ produces either:\n--\n-- > let x = r in b\n--\n-- or:\n--\n-- > case r of x { _DEFAULT_ -> b }\n--\n-- depending on whether we have to use a @case@ or @let@\n-- binding for the expression (see 'needsCaseBinding').\n-- It's used by the desugarer to avoid building bindings\n-- that give Core Lint a heart attack, although actually\n-- the simplifier deals with them perfectly well. See\n-- also 'MkCore.mkCoreLet'\nbindNonRec bndr rhs body\n  | isTyVar bndr                       = let_bind\n  | isCoVar bndr                       = if isCoArg rhs then let_bind\n    {- See Note [Binding coercions] -}                  else case_bind\n  | isJoinId bndr                      = let_bind\n  | needsCaseBinding (idType bndr) rhs = case_bind\n  | otherwise                          = let_bind\n  where\n    case_bind = Case rhs bndr (exprType body) [(DEFAULT, [], body)]\n    let_bind  = Let (NonRec bndr rhs) body\n\n-- | Tests whether we have to use a @case@ rather than @let@ binding for this expression\n-- as per the invariants of 'CoreExpr': see \"CoreSyn#let_app_invariant\"\nneedsCaseBinding :: Type -> CoreExpr -> Bool\nneedsCaseBinding ty rhs = isUnliftedType ty && not (exprOkForSpeculation rhs)\n        -- Make a case expression instead of a let\n        -- These can arise either from the desugarer,\n        -- or from beta reductions: (\\x.e) (x +# y)\n\nmkAltExpr :: AltCon     -- ^ Case alternative constructor\n          -> [CoreBndr] -- ^ Things bound by the pattern match\n          -> [Type]     -- ^ The type arguments to the case alternative\n          -> CoreExpr\n-- ^ This guy constructs the value that the scrutinee must have\n-- given that you are in one particular branch of a case\nmkAltExpr (DataAlt con) args inst_tys\n  = mkConApp con (map Type inst_tys ++ varsToCoreExprs args)\nmkAltExpr (LitAlt lit) [] []\n  = Lit lit\nmkAltExpr (LitAlt _) _ _ = panic \"mkAltExpr LitAlt\"\nmkAltExpr DEFAULT _ _ = panic \"mkAltExpr DEFAULT\"\n\n{- Note [Binding coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider binding a CoVar, c = e.  Then, we must atisfy\nNote [CoreSyn type and coercion invariant] in CoreSyn,\nwhich allows only (Coercion co) on the RHS.\n\n************************************************************************\n*                                                                      *\n               Operations oer case alternatives\n*                                                                      *\n************************************************************************\n\nThe default alternative must be first, if it exists at all.\nThis makes it easy to find, though it makes matching marginally harder.\n-}\n\n-- | Extract the default case alternative\nfindDefault :: [(AltCon, [a], b)] -> ([(AltCon, [a], b)], Maybe b)\nfindDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null args ) (alts, Just rhs)\nfindDefault alts                        =                     (alts, Nothing)\n\naddDefault :: [(AltCon, [a], b)] -> Maybe b -> [(AltCon, [a], b)]\naddDefault alts Nothing    = alts\naddDefault alts (Just rhs) = (DEFAULT, [], rhs) : alts\n\nisDefaultAlt :: (AltCon, a, b) -> Bool\nisDefaultAlt (DEFAULT, _, _) = True\nisDefaultAlt _               = False\n\n-- | Find the case alternative corresponding to a particular\n-- constructor: panics if no such constructor exists\nfindAlt :: AltCon -> [(AltCon, a, b)] -> Maybe (AltCon, a, b)\n    -- A \"Nothing\" result *is* legitimate\n    -- See Note [Unreachable code]\nfindAlt con alts\n  = case alts of\n        (deflt@(DEFAULT,_,_):alts) -> go alts (Just deflt)\n        _                          -> go alts Nothing\n  where\n    go []                     deflt = deflt\n    go (alt@(con1,_,_) : alts) deflt\n      = case con `cmpAltCon` con1 of\n          LT -> deflt   -- Missed it already; the alts are in increasing order\n          EQ -> Just alt\n          GT -> ASSERT( not (con1 == DEFAULT) ) go alts deflt\n\n{- Note [Unreachable code]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is possible (although unusual) for GHC to find a case expression\nthat cannot match.  For example:\n\n     data Col = Red | Green | Blue\n     x = Red\n     f v = case x of\n              Red -> ...\n              _ -> ...(case x of { Green -> e1; Blue -> e2 })...\n\nSuppose that for some silly reason, x isn't substituted in the case\nexpression.  (Perhaps there's a NOINLINE on it, or profiling SCC stuff\ngets in the way; cf Trac #3118.)  Then the full-lazines pass might produce\nthis\n\n     x = Red\n     lvl = case x of { Green -> e1; Blue -> e2 })\n     f v = case x of\n             Red -> ...\n             _ -> ...lvl...\n\nNow if x gets inlined, we won't be able to find a matching alternative\nfor 'Red'.  That's because 'lvl' is unreachable.  So rather than crashing\nwe generate (error \"Inaccessible alternative\").\n\nSimilar things can happen (augmented by GADTs) when the Simplifier\nfilters down the matching alternatives in Simplify.rebuildCase.\n-}\n\n---------------------------------\nmergeAlts :: [(AltCon, a, b)] -> [(AltCon, a, b)] -> [(AltCon, a, b)]\n-- ^ Merge alternatives preserving order; alternatives in\n-- the first argument shadow ones in the second\nmergeAlts [] as2 = as2\nmergeAlts as1 [] = as1\nmergeAlts (a1:as1) (a2:as2)\n  = case a1 `cmpAlt` a2 of\n        LT -> a1 : mergeAlts as1      (a2:as2)\n        EQ -> a1 : mergeAlts as1      as2       -- Discard a2\n        GT -> a2 : mergeAlts (a1:as1) as2\n\n\n---------------------------------\ntrimConArgs :: AltCon -> [CoreArg] -> [CoreArg]\n-- ^ Given:\n--\n-- > case (C a b x y) of\n-- >        C b x y -> ...\n--\n-- We want to drop the leading type argument of the scrutinee\n-- leaving the arguments to match against the pattern\n\ntrimConArgs DEFAULT      args = ASSERT( null args ) []\ntrimConArgs (LitAlt _)   args = ASSERT( null args ) []\ntrimConArgs (DataAlt dc) args = dropList (dataConUnivTyVars dc) args\n\nfilterAlts :: TyCon                -- ^ Type constructor of scrutinee's type (used to prune possibilities)\n           -> [Type]               -- ^ And its type arguments\n           -> [AltCon]             -- ^ 'imposs_cons': constructors known to be impossible due to the form of the scrutinee\n           -> [(AltCon, [Var], a)] -- ^ Alternatives\n           -> ([AltCon], [(AltCon, [Var], a)])\n             -- Returns:\n             --  1. Constructors that will never be encountered by the\n             --     *default* case (if any).  A superset of imposs_cons\n             --  2. The new alternatives, trimmed by\n             --        a) remove imposs_cons\n             --        b) remove constructors which can't match because of GADTs\n             --\n             -- NB: the final list of alternatives may be empty:\n             -- This is a tricky corner case.  If the data type has no constructors,\n             -- which GHC allows, or if the imposs_cons covers all constructors (after taking\n             -- account of GADTs), then no alternatives can match.\n             --\n             -- If callers need to preserve the invariant that there is always at least one branch\n             -- in a \"case\" statement then they will need to manually add a dummy case branch that just\n             -- calls \"error\" or similar.\nfilterAlts _tycon inst_tys imposs_cons alts\n  = (imposs_deflt_cons, addDefault trimmed_alts maybe_deflt)\n  where\n    (alts_wo_default, maybe_deflt) = findDefault alts\n    alt_cons = [con | (con,_,_) <- alts_wo_default]\n\n    trimmed_alts = filterOut (impossible_alt inst_tys) alts_wo_default\n\n    imposs_cons_set = Set.fromList imposs_cons\n    imposs_deflt_cons =\n      imposs_cons ++ filterOut (`Set.member` imposs_cons_set) alt_cons\n         -- \"imposs_deflt_cons\" are handled\n         --   EITHER by the context,\n         --   OR by a non-DEFAULT branch in this case expression.\n\n    impossible_alt :: [Type] -> (AltCon, a, b) -> Bool\n    impossible_alt _ (con, _, _) | con `Set.member` imposs_cons_set = True\n    impossible_alt inst_tys (DataAlt con, _, _) = dataConCannotMatch inst_tys con\n    impossible_alt _  _                         = False\n\n-- | Refine the default alternative to a 'DataAlt', if there is a unique way to do so.\n-- See Note [Refine Default Alts]\nrefineDefaultAlt :: [Unique]          -- ^ Uniques for constructing new binders\n                 -> TyCon             -- ^ Type constructor of scrutinee's type\n                 -> [Type]            -- ^ Type arguments of scrutinee's type\n                 -> [AltCon]          -- ^ Constructors that cannot match the DEFAULT (if any)\n                 -> [CoreAlt]\n                 -> (Bool, [CoreAlt]) -- ^ 'True', if a default alt was replaced with a 'DataAlt'\nrefineDefaultAlt us tycon tys imposs_deflt_cons all_alts\n  | (DEFAULT,_,rhs) : rest_alts <- all_alts\n  , isAlgTyCon tycon            -- It's a data type, tuple, or unboxed tuples.\n  , not (isNewTyCon tycon)      -- We can have a newtype, if we are just doing an eval:\n                                --      case x of { DEFAULT -> e }\n                                -- and we don't want to fill in a default for them!\n  , Just all_cons <- tyConDataCons_maybe tycon\n  , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons]\n                             -- We now know it's a data type, so we can use\n                             -- UniqSet rather than Set (more efficient)\n        impossible con   = con `elementOfUniqSet` imposs_data_cons\n                             || dataConCannotMatch tys con\n  = case filterOut impossible all_cons of\n       -- Eliminate the default alternative\n       -- altogether if it can't match:\n       []    -> (False, rest_alts)\n\n       -- It matches exactly one constructor, so fill it in:\n       [con] -> (True, mergeAlts rest_alts [(DataAlt con, ex_tvs ++ arg_ids, rhs)])\n                       -- We need the mergeAlts to keep the alternatives in the right order\n             where\n                (ex_tvs, arg_ids) = dataConRepInstPat us con tys\n\n       -- It matches more than one, so do nothing\n       _  -> (False, all_alts)\n\n  | debugIsOn, isAlgTyCon tycon, null (tyConDataCons tycon)\n  , not (isFamilyTyCon tycon || isAbstractTyCon tycon)\n        -- Check for no data constructors\n        -- This can legitimately happen for abstract types and type families,\n        -- so don't report that\n  = (False, all_alts)\n\n  | otherwise      -- The common case\n  = (False, all_alts)\n\n{- Note [Refine Default Alts]\n\nrefineDefaultAlt replaces the DEFAULT alt with a constructor if there is one\npossible value it could be.\n\nThe simplest example being\n\nfoo :: () -> ()\nfoo x = case x of !_ -> ()\n\nrewrites to\n\nfoo :: () -> ()\nfoo x = case x of () -> ()\n\nThere are two reasons in general why this is desirable.\n\n1. We can simplify inner expressions\n\nIn this example we can eliminate the inner case by refining the outer case.\nIf we don't refine it, we are left with both case expressions.\n\n```\n{-# LANGUAGE BangPatterns #-}\nmodule Test where\n\nmid x = x\n{-# NOINLINE mid #-}\n\ndata Foo = Foo1 ()\n\ntest :: Foo -> ()\ntest x =\n  case x of\n    !_ -> mid (case x of\n                Foo1 x1 -> x1)\n\n```\n\nrefineDefaultAlt fills in the DEFAULT here with `Foo ip1` and then x\nbecomes bound to `Foo ip1` so is inlined into the other case which\ncauses the KnownBranch optimisation to kick in.\n\n\n2. combineIdenticalAlts does a better job\n\nSimon Jakobi also points out that that combineIdenticalAlts will do a better job\nif we refine the DEFAULT first.\n\n```\ndata D = C0 | C1 | C2\n\ncase e of\n   DEFAULT -> e0\n   C0 -> e1\n   C1 -> e1\n```\n\nWhen we apply combineIdenticalAlts to this expression, it can't\ncombine the alts for C0 and C1, as we already have a default case.\n\nIf we apply refineDefaultAlt first, we get\n\n```\ncase e of\n  C0 -> e1\n  C1 -> e1\n  C2 -> e0\n```\n\nand combineIdenticalAlts can turn that into\n\n```\ncase e of\n  DEFAULT -> e1\n  C2 -> e0\n```\n\nIt isn't obvious that refineDefaultAlt does this but if you look at its one\ncall site in SimplUtils then the `imposs_deflt_cons` argument is populated with\nconstructors which are matched elsewhere.\n\n-}\n\n\n\n\n{- Note [Combine identical alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf several alternatives are identical, merge them into a single\nDEFAULT alternative.  I've occasionally seen this making a big\ndifference:\n\n     case e of               =====>     case e of\n       C _ -> f x                         D v -> ....v....\n       D v -> ....v....                   DEFAULT -> f x\n       DEFAULT -> f x\n\nThe point is that we merge common RHSs, at least for the DEFAULT case.\n[One could do something more elaborate but I've never seen it needed.]\nTo avoid an expensive test, we just merge branches equal to the *first*\nalternative; this picks up the common cases\n     a) all branches equal\n     b) some branches equal to the DEFAULT (which occurs first)\n\nThe case where Combine Identical Alternatives transformation showed up\nwas like this (base/Foreign/C/Err/Error.hs):\n\n        x | p `is` 1 -> e1\n          | p `is` 2 -> e2\n        ...etc...\n\nwhere @is@ was something like\n\n        p `is` n = p /= (-1) && p == n\n\nThis gave rise to a horrible sequence of cases\n\n        case p of\n          (-1) -> $j p\n          1    -> e1\n          DEFAULT -> $j p\n\nand similarly in cascade for all the join points!\n\nNB: it's important that all this is done in [InAlt], *before* we work\non the alternatives themselves, because Simplify.simplAlt may zap the\noccurrence info on the binders in the alternatives, which in turn\ndefeats combineIdenticalAlts (see Trac #7360).\n\nNote [Care with impossible-constructors when combining alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have (Trac #10538)\n   data T = A | B | C | D\n\n      case x::T of   (Imposs-default-cons {A,B})\n         DEFAULT -> e1\n         A -> e2\n         B -> e1\n\nWhen calling combineIdentialAlts, we'll have computed that the\n\"impossible constructors\" for the DEFAULT alt is {A,B}, since if x is\nA or B we'll take the other alternatives.  But suppose we combine B\ninto the DEFAULT, to get\n\n      case x::T of   (Imposs-default-cons {A})\n         DEFAULT -> e1\n         A -> e2\n\nThen we must be careful to trim the impossible constructors to just {A},\nelse we risk compiling 'e1' wrong!\n\nNot only that, but we take care when there is no DEFAULT beforehand,\nbecause we are introducing one.  Consider\n\n   case x of   (Imposs-default-cons {A,B,C})\n     A -> e1\n     B -> e2\n     C -> e1\n\nThen when combining the A and C alternatives we get\n\n   case x of   (Imposs-default-cons {B})\n     DEFAULT -> e1\n     B -> e2\n\nNote that we have a new DEFAULT branch that we didn't have before.  So\nwe need delete from the \"impossible-default-constructors\" all the\nknown-con alternatives that we have eliminated. (In Trac #11172 we\nmissed the first one.)\n\n-}\n\ncombineIdenticalAlts :: [AltCon]    -- Constructors that cannot match DEFAULT\n                     -> [CoreAlt]\n                     -> (Bool,      -- True <=> something happened\n                         [AltCon],  -- New constructors that cannot match DEFAULT\n                         [CoreAlt]) -- New alternatives\n-- See Note [Combine identical alternatives]\n-- True <=> we did some combining, result is a single DEFAULT alternative\ncombineIdenticalAlts imposs_deflt_cons ((con1,bndrs1,rhs1) : rest_alts)\n  | all isDeadBinder bndrs1    -- Remember the default\n  , not (null elim_rest) -- alternative comes first\n  = (True, imposs_deflt_cons', deflt_alt : filtered_rest)\n  where\n    (elim_rest, filtered_rest) = partition identical_to_alt1 rest_alts\n    deflt_alt = (DEFAULT, [], mkTicks (concat tickss) rhs1)\n\n     -- See Note [Care with impossible-constructors when combining alternatives]\n    imposs_deflt_cons' = imposs_deflt_cons `minusList` elim_cons\n    elim_cons = elim_con1 ++ map fstOf3 elim_rest\n    elim_con1 = case con1 of     -- Don't forget con1!\n                  DEFAULT -> []  -- See Note [\n                  _       -> [con1]\n\n    cheapEqTicked e1 e2 = cheapEqExpr' tickishFloatable e1 e2\n    identical_to_alt1 (_con,bndrs,rhs)\n      = all isDeadBinder bndrs && rhs `cheapEqTicked` rhs1\n    tickss = map (stripTicksT tickishFloatable . thdOf3) elim_rest\n\ncombineIdenticalAlts imposs_cons alts\n  = (False, imposs_cons, alts)\n\n{- *********************************************************************\n*                                                                      *\n             exprIsTrivial\n*                                                                      *\n************************************************************************\n\nNote [exprIsTrivial]\n~~~~~~~~~~~~~~~~~~~~\n@exprIsTrivial@ is true of expressions we are unconditionally happy to\n                duplicate; simple variables and constants, and type\n                applications.  Note that primop Ids aren't considered\n                trivial unless\n\nNote [Variables are trivial]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere used to be a gruesome test for (hasNoBinding v) in the\nVar case:\n        exprIsTrivial (Var v) | hasNoBinding v = idArity v == 0\nThe idea here is that a constructor worker, like \\$wJust, is\nreally short for (\\x -> \\$wJust x), because \\$wJust has no binding.\nSo it should be treated like a lambda.  Ditto unsaturated primops.\nBut now constructor workers are not \"have-no-binding\" Ids.  And\ncompletely un-applied primops and foreign-call Ids are sufficiently\nrare that I plan to allow them to be duplicated and put up with\nsaturating them.\n\nNote [Tick trivial]\n~~~~~~~~~~~~~~~~~~~\nTicks are only trivial if they are pure annotations. If we treat\n\"tick<n> x\" as trivial, it will be inlined inside lambdas and the\nentry count will be skewed, for example.  Furthermore \"scc<n> x\" will\nturn into just \"x\" in mkTick.\n\nNote [Empty case is trivial]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe expression (case (x::Int) Bool of {}) is just a type-changing\ncase used when we are sure that 'x' will not return.  See\nNote [Empty case alternatives] in CoreSyn.\n\nIf the scrutinee is trivial, then so is the whole expression; and the\nCoreToSTG pass in fact drops the case expression leaving only the\nscrutinee.\n\nHaving more trivial expressions is good.  Moreover, if we don't treat\nit as trivial we may land up with let-bindings like\n   let v = case x of {} in ...\nand after CoreToSTG that gives\n   let v = x in ...\nand that confuses the code generator (Trac #11155). So best to kill\nit off at source.\n-}\n\nexprIsTrivial :: CoreExpr -> Bool\n-- If you modify this function, you may also\n-- need to modify getIdFromTrivialExpr\nexprIsTrivial (Var _)          = True        -- See Note [Variables are trivial]\nexprIsTrivial (Type _)         = True\nexprIsTrivial (Coercion _)     = True\nexprIsTrivial (Lit lit)        = litIsTrivial lit\nexprIsTrivial (App e arg)      = not (isRuntimeArg arg) && exprIsTrivial e\nexprIsTrivial (Lam b e)        = not (isRuntimeVar b) && exprIsTrivial e\nexprIsTrivial (Tick t e)       = not (tickishIsCode t) && exprIsTrivial e\n                                 -- See Note [Tick trivial]\nexprIsTrivial (Cast e _)       = exprIsTrivial e\nexprIsTrivial (Case e _ _ [])  = exprIsTrivial e  -- See Note [Empty case is trivial]\nexprIsTrivial _                = False\n\n{-\nNote [getIdFromTrivialExpr]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen substituting in a breakpoint we need to strip away the type cruft\nfrom a trivial expression and get back to the Id.  The invariant is\nthat the expression we're substituting was originally trivial\naccording to exprIsTrivial, AND the expression is not a literal.\nSee Note [substTickish] for how breakpoint substitution preserves\nthis extra invariant.\n\nWe also need this functionality in CorePrep to extract out Id of a\nfunction which we are saturating.  However, in this case we don't know\nif the variable actually refers to a literal; thus we use\n'getIdFromTrivialExpr_maybe' to handle this case.  See test\nT12076lit for an example where this matters.\n-}\n\ngetIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id\ngetIdFromTrivialExpr e\n    = fromMaybe (pprPanic \"getIdFromTrivialExpr\" (ppr e))\n                (getIdFromTrivialExpr_maybe e)\n\ngetIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id\n-- See Note [getIdFromTrivialExpr]\n-- Th equations for this should line up with those for exprIsTrivial\ngetIdFromTrivialExpr_maybe e\n  = go e\n  where\n    go (App f t) | not (isRuntimeArg t)   = go f\n    go (Tick t e) | not (tickishIsCode t) = go e\n    go (Cast e _)                         = go e\n    go (Lam b e) | not (isRuntimeVar b)   = go e\n    go (Case e _ _ [])                    = go e\n    go (Var v) = Just v\n    go _       = Nothing\n\n{-\nexprIsBottom is a very cheap and cheerful function; it may return\nFalse for bottoming expressions, but it never costs much to ask.  See\nalso CoreArity.exprBotStrictness_maybe, but that's a bit more\nexpensive.\n-}\n\nexprIsBottom :: CoreExpr -> Bool\n-- See Note [Bottoming expressions]\nexprIsBottom e\n  | isEmptyTy (exprType e)\n  = True\n  | otherwise\n  = go 0 e\n  where\n    go n (Var v) = isBottomingId v &&  n >= idArity v\n    go n (App e a) | isTypeArg a = go n e\n                   | otherwise   = go (n+1) e\n    go n (Tick _ e)              = go n e\n    go n (Cast e _)              = go n e\n    go n (Let _ e)               = go n e\n    go n (Lam v e) | isTyVar v   = go n e\n    go _ (Case _ _ _ alts)       = null alts\n       -- See Note [Empty case alternatives] in CoreSyn\n    go _ _                       = False\n\n{- Note [Bottoming expressions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA bottoming expression is guaranteed to diverge, or raise an\nexception.  We can test for it in two different ways, and exprIsBottom\nchecks for both of these situations:\n\n* Visibly-bottom computations.  For example\n      (error Int \"Hello\")\n  is visibly bottom.  The strictness analyser also finds out if\n  a function diverges or raises an exception, and puts that info\n  in its strictness signature.\n\n* Empty types.  If a type is empty, its only inhabitant is bottom.\n  For example:\n      data T\n      f :: T -> Bool\n      f = \\(x:t). case x of Bool {}\n  Since T has no data constructors, the case alternatives are of course\n  empty.  However note that 'x' is not bound to a visibly-bottom value;\n  it's the *type* that tells us it's going to diverge.\n\nA GADT may also be empty even though it has constructors:\n        data T a where\n          T1 :: a -> T Bool\n          T2 :: T Int\n        ...(case (x::T Char) of {})...\nHere (T Char) is uninhabited.  A more realistic case is (Int ~ Bool),\nwhich is likewise uninhabited.\n\n\n************************************************************************\n*                                                                      *\n             exprIsDupable\n*                                                                      *\n************************************************************************\n\nNote [exprIsDupable]\n~~~~~~~~~~~~~~~~~~~~\n@exprIsDupable@ is true of expressions that can be duplicated at a modest\n                cost in code size.  This will only happen in different case\n                branches, so there's no issue about duplicating work.\n\n                That is, exprIsDupable returns True of (f x) even if\n                f is very very expensive to call.\n\n                Its only purpose is to avoid fruitless let-binding\n                and then inlining of case join points\n-}\n\nexprIsDupable :: DynFlags -> CoreExpr -> Bool\nexprIsDupable dflags e\n  = isJust (go dupAppSize e)\n  where\n    go :: Int -> CoreExpr -> Maybe Int\n    go n (Type {})     = Just n\n    go n (Coercion {}) = Just n\n    go n (Var {})      = decrement n\n    go n (Tick _ e)    = go n e\n    go n (Cast e _)    = go n e\n    go n (App f a) | Just n' <- go n a = go n' f\n    go n (Lit lit) | litIsDupable dflags lit = decrement n\n    go _ _ = Nothing\n\n    decrement :: Int -> Maybe Int\n    decrement 0 = Nothing\n    decrement n = Just (n-1)\n\ndupAppSize :: Int\ndupAppSize = 8   -- Size of term we are prepared to duplicate\n                 -- This is *just* big enough to make test MethSharing\n                 -- inline enough join points.  Really it should be\n                 -- smaller, and could be if we fixed Trac #4960.\n\n{-\n************************************************************************\n*                                                                      *\n             exprIsCheap, exprIsExpandable\n*                                                                      *\n************************************************************************\n\nNote [exprIsWorkFree]\n~~~~~~~~~~~~~~~~~~~~~\nexprIsWorkFree is used when deciding whether to inline something; we\ndon't inline it if doing so might duplicate work, by peeling off a\ncomplete copy of the expression.  Here we do not want even to\nduplicate a primop (Trac #5623):\n   eg   let x = a #+ b in x +# x\n   we do not want to inline/duplicate x\n\nPreviously we were a bit more liberal, which led to the primop-duplicating\nproblem.  However, being more conservative did lead to a big regression in\none nofib benchmark, wheel-sieve1.  The situation looks like this:\n\n   let noFactor_sZ3 :: GHC.Types.Int -> GHC.Types.Bool\n       noFactor_sZ3 = case s_adJ of _ { GHC.Types.I# x_aRs ->\n         case GHC.Prim.<=# x_aRs 2 of _ {\n           GHC.Types.False -> notDivBy ps_adM qs_adN;\n           GHC.Types.True -> lvl_r2Eb }}\n       go = \\x. ...(noFactor (I# y))....(go x')...\n\nThe function 'noFactor' is heap-allocated and then called.  Turns out\nthat 'notDivBy' is strict in its THIRD arg, but that is invisible to\nthe caller of noFactor, which therefore cannot do w/w and\nheap-allocates noFactor's argument.  At the moment (May 12) we are just\ngoing to put up with this, because the previous more aggressive inlining\n(which treated 'noFactor' as work-free) was duplicating primops, which\nin turn was making inner loops of array calculations runs slow (#5623)\n\nNote [Case expressions are work-free]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAre case-expressions work-free?  Consider\n    let v = case x of (p,q) -> p\n        go = \\y -> ...case v of ...\nShould we inline 'v' at its use site inside the loop?  At the moment\nwe do.  I experimented with saying that case are *not* work-free, but\nthat increased allocation slightly.  It's a fairly small effect, and at\nthe moment we go for the slightly more aggressive version which treats\n(case x of ....) as work-free if the alternatives are.\n\nMoreover it improves arities of overloaded functions where\nthere is only dictionary selection (no construction) involved\n\nNote [exprIsCheap]   See also Note [Interaction of exprIsCheap and lone variables]\n~~~~~~~~~~~~~~~~~~   in CoreUnfold.hs\n@exprIsCheap@ looks at a Core expression and returns \\tr{True} if\nit is obviously in weak head normal form, or is cheap to get to WHNF.\n[Note that that's not the same as exprIsDupable; an expression might be\nbig, and hence not dupable, but still cheap.]\n\nBy ``cheap'' we mean a computation we're willing to:\n        push inside a lambda, or\n        inline at more than one place\nThat might mean it gets evaluated more than once, instead of being\nshared.  The main examples of things which aren't WHNF but are\n``cheap'' are:\n\n  *     case e of\n          pi -> ei\n        (where e, and all the ei are cheap)\n\n  *     let x = e in b\n        (where e and b are cheap)\n\n  *     op x1 ... xn\n        (where op is a cheap primitive operator)\n\n  *     error \"foo\"\n        (because we are happy to substitute it inside a lambda)\n\nNotice that a variable is considered 'cheap': we can push it inside a lambda,\nbecause sharing will make sure it is only evaluated once.\n\nNote [exprIsCheap and exprIsHNF]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNote that exprIsHNF does not imply exprIsCheap.  Eg\n        let x = fac 20 in Just x\nThis responds True to exprIsHNF (you can discard a seq), but\nFalse to exprIsCheap.\n\nNote [Arguments and let-bindings exprIsCheapX]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat predicate should we apply to the argument of an application, or the\nRHS of a let-binding?\n\nWe used to say \"exprIsTrivial arg\" due to concerns about duplicating\nnested constructor applications, but see #4978.  So now we just recursively\nuse exprIsCheapX.\n\nWe definitely want to treat let and app the same.  The principle here is\nthat\n   let x = blah in f x\nshould behave equivalently to\n   f blah\n\nThis in turn means that the 'letrec g' does not prevent eta expansion\nin this (which it previously was):\n    f = \\x. let v = case x of\n                      True -> letrec g = \\w. blah\n                              in g\n                      False -> \\x. x\n            in \\w. v True\n-}\n\n--------------------\nexprIsWorkFree :: CoreExpr -> Bool   -- See Note [exprIsWorkFree]\nexprIsWorkFree = exprIsCheapX isWorkFreeApp\n\nexprIsCheap :: CoreExpr -> Bool\nexprIsCheap = exprIsCheapX isCheapApp\n\nexprIsCheapX :: CheapAppFun -> CoreExpr -> Bool\nexprIsCheapX ok_app e\n  = ok e\n  where\n    ok e = go 0 e\n\n    -- n is the number of value arguments\n    go n (Var v)                      = ok_app v n\n    go _ (Lit {})                     = True\n    go _ (Type {})                    = True\n    go _ (Coercion {})                = True\n    go n (Cast e _)                   = go n e\n    go n (Case scrut _ _ alts)        = ok scrut &&\n                                        and [ go n rhs | (_,_,rhs) <- alts ]\n    go n (Tick t e) | tickishCounts t = False\n                    | otherwise       = go n e\n    go n (Lam x e)  | isRuntimeVar x  = n==0 || go (n-1) e\n                    | otherwise       = go n e\n    go n (App f e)  | isRuntimeArg e  = go (n+1) f && ok e\n                    | otherwise       = go n f\n    go n (Let (NonRec _ r) e)         = go n e && ok r\n    go n (Let (Rec prs) e)            = go n e && all (ok . snd) prs\n\n      -- Case: see Note [Case expressions are work-free]\n      -- App, Let: see Note [Arguments and let-bindings exprIsCheapX]\n\n\n{- Note [exprIsExpandable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn expression is \"expandable\" if we are willing to duplicate it, if doing\nso might make a RULE or case-of-constructor fire.  Consider\n   let x = (a,b)\n       y = build g\n   in ....(case x of (p,q) -> rhs)....(foldr k z y)....\n\nWe don't inline 'x' or 'y' (see Note [Lone variables] in CoreUnfold),\nbut we do want\n\n * the case-expression to simplify\n   (via exprIsConApp_maybe, exprIsLiteral_maybe)\n\n * the foldr/build RULE to fire\n   (by expanding the unfolding during rule matching)\n\nSo we classify the unfolding of a let-binding as \"expandable\" (via the\nuf_expandable field) if we want to do this kind of on-the-fly\nexpansion.  Specifically:\n\n* True of constructor applications (K a b)\n\n* True of applications of a \"CONLIKE\" Id; see Note [CONLIKE pragma] in BasicTypes.\n  (NB: exprIsCheap might not be true of this)\n\n* False of case-expressions.  If we have\n    let x = case ... in ...(case x of ...)...\n  we won't simplify.  We have to inline x.  See Trac #14688.\n\n* False of let-expressions (same reason); and in any case we\n  float lets out of an RHS if doing so will reveal an expandable\n  application (see SimplEnv.doFloatFromRhs).\n\n* Take care: exprIsExpandable should /not/ be true of primops.  I\n  found this in test T5623a:\n    let q = /\\a. Ptr a (a +# b)\n    in case q @ Float of Ptr v -> ...q...\n\n  q's inlining should not be expandable, else exprIsConApp_maybe will\n  say that (q @ Float) expands to (Ptr a (a +# b)), and that will\n  duplicate the (a +# b) primop, which we should not do lightly.\n  (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.)\n-}\n\n-------------------------------------\nexprIsExpandable :: CoreExpr -> Bool\n-- See Note [exprIsExpandable]\nexprIsExpandable e\n  = ok e\n  where\n    ok e = go 0 e\n\n    -- n is the number of value arguments\n    go n (Var v)                      = isExpandableApp v n\n    go _ (Lit {})                     = True\n    go _ (Type {})                    = True\n    go _ (Coercion {})                = True\n    go n (Cast e _)                   = go n e\n    go n (Tick t e) | tickishCounts t = False\n                    | otherwise       = go n e\n    go n (Lam x e)  | isRuntimeVar x  = n==0 || go (n-1) e\n                    | otherwise       = go n e\n    go n (App f e)  | isRuntimeArg e  = go (n+1) f && ok e\n                    | otherwise       = go n f\n    go _ (Case {})                    = False\n    go _ (Let {})                     = False\n\n\n-------------------------------------\ntype CheapAppFun = Id -> Arity -> Bool\n  -- Is an application of this function to n *value* args\n  -- always cheap, assuming the arguments are cheap?\n  -- True mainly of data constructors, partial applications;\n  -- but with minor variations:\n  --    isWorkFreeApp\n  --    isCheapApp\n  --    isExpandableApp\n\nisWorkFreeApp :: CheapAppFun\nisWorkFreeApp fn n_val_args\n  | n_val_args == 0           -- No value args\n  = True\n  | n_val_args < idArity fn   -- Partial application\n  = True\n  | otherwise\n  = case idDetails fn of\n      DataConWorkId {} -> True\n      _                -> False\n\nisCheapApp :: CheapAppFun\nisCheapApp fn n_val_args\n  | isWorkFreeApp fn n_val_args = True\n  | isBottomingId fn            = True  -- See Note [isCheapApp: bottoming functions]\n  | otherwise\n  = case idDetails fn of\n      DataConWorkId {} -> True  -- Actually handled by isWorkFreeApp\n      RecSelId {}      -> n_val_args == 1  -- See Note [Record selection]\n      ClassOpId {}     -> n_val_args == 1\n      PrimOpId op      -> primOpIsCheap op\n      _                -> False\n        -- In principle we should worry about primops\n        -- that return a type variable, since the result\n        -- might be applied to something, but I'm not going\n        -- to bother to check the number of args\n\nisExpandableApp :: CheapAppFun\nisExpandableApp fn n_val_args\n  | isWorkFreeApp fn n_val_args = True\n  | otherwise\n  = case idDetails fn of\n      DataConWorkId {} -> True  -- Actually handled by isWorkFreeApp\n      RecSelId {}      -> n_val_args == 1  -- See Note [Record selection]\n      ClassOpId {}     -> n_val_args == 1\n      PrimOpId {}      -> False\n      _ | isBottomingId fn               -> False\n          -- See Note [isExpandableApp: bottoming functions]\n        | isConLike (idRuleMatchInfo fn) -> True\n        | all_args_are_preds             -> True\n        | otherwise                      -> False\n\n  where\n     -- See if all the arguments are PredTys (implicit params or classes)\n     -- If so we'll regard it as expandable; see Note [Expandable overloadings]\n     all_args_are_preds = all_pred_args n_val_args (idType fn)\n\n     all_pred_args n_val_args ty\n       | n_val_args == 0\n       = True\n\n       | Just (bndr, ty) <- splitPiTy_maybe ty\n       = case bndr of\n           Named {}        -> all_pred_args n_val_args ty\n           Anon InvisArg _ -> all_pred_args (n_val_args-1) ty\n           Anon VisArg _   -> False\n\n       | otherwise\n       = False\n\n{- Note [isCheapApp: bottoming functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nI'm not sure why we have a special case for bottoming\nfunctions in isCheapApp.  Maybe we don't need it.\n\nNote [isExpandableApp: bottoming functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's important that isExpandableApp does not respond True to bottoming\nfunctions.  Recall  undefined :: HasCallStack => a\nSuppose isExpandableApp responded True to (undefined d), and we had:\n\n  x = undefined <dict-expr>\n\nThen Simplify.prepareRhs would ANF the RHS:\n\n  d = <dict-expr>\n  x = undefined d\n\nThis is already bad: we gain nothing from having x bound to (undefined\nvar), unlike the case for data constructors.  Worse, we get the\nsimplifier loop described in OccurAnal Note [Cascading inlines].\nSuppose x occurs just once; OccurAnal.occAnalNonRecRhs decides x will\ncertainly_inline; so we end up inlining d right back into x; but in\nthe end x doesn't inline because it is bottom (preInlineUnconditionally);\nso the process repeats.. We could elaborate the certainly_inline logic\nsome more, but it's better just to treat bottoming bindings as\nnon-expandable, because ANFing them is a bad idea in the first place.\n\nNote [Record selection]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nI'm experimenting with making record selection\nlook cheap, so we will substitute it inside a\nlambda.  Particularly for dictionary field selection.\n\nBUT: Take care with (sel d x)!  The (sel d) might be cheap, but\nthere's no guarantee that (sel d x) will be too.  Hence (n_val_args == 1)\n\nNote [Expandable overloadings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose the user wrote this\n   {-# RULE  forall x. foo (negate x) = h x #-}\n   f x = ....(foo (negate x))....\nHe'd expect the rule to fire. But since negate is overloaded, we might\nget this:\n    f = \\d -> let n = negate d in \\x -> ...foo (n x)...\nSo we treat the application of a function (negate in this case) to a\n*dictionary* as expandable.  In effect, every function is CONLIKE when\nit's applied only to dictionaries.\n\n\n************************************************************************\n*                                                                      *\n             exprOkForSpeculation\n*                                                                      *\n************************************************************************\n-}\n\n-----------------------------\n-- | 'exprOkForSpeculation' returns True of an expression that is:\n--\n--  * Safe to evaluate even if normal order eval might not\n--    evaluate the expression at all, or\n--\n--  * Safe /not/ to evaluate even if normal order would do so\n--\n-- It is usually called on arguments of unlifted type, but not always\n-- In particular, Simplify.rebuildCase calls it on lifted types\n-- when a 'case' is a plain 'seq'. See the example in\n-- Note [exprOkForSpeculation: case expressions] below\n--\n-- Precisely, it returns @True@ iff:\n--  a) The expression guarantees to terminate,\n--  b) soon,\n--  c) without causing a write side effect (e.g. writing a mutable variable)\n--  d) without throwing a Haskell exception\n--  e) without risking an unchecked runtime exception (array out of bounds,\n--     divide by zero)\n--\n-- For @exprOkForSideEffects@ the list is the same, but omitting (e).\n--\n-- Note that\n--    exprIsHNF            implies exprOkForSpeculation\n--    exprOkForSpeculation implies exprOkForSideEffects\n--\n-- See Note [PrimOp can_fail and has_side_effects] in PrimOp\n-- and Note [Transformations affected by can_fail and has_side_effects]\n--\n-- As an example of the considerations in this test, consider:\n--\n-- > let x = case y# +# 1# of { r# -> I# r# }\n-- > in E\n--\n-- being translated to:\n--\n-- > case y# +# 1# of { r# ->\n-- >    let x = I# r#\n-- >    in E\n-- > }\n--\n-- We can only do this if the @y + 1@ is ok for speculation: it has no\n-- side effects, and can't diverge or raise an exception.\n\nexprOkForSpeculation, exprOkForSideEffects :: CoreExpr -> Bool\nexprOkForSpeculation = expr_ok primOpOkForSpeculation\nexprOkForSideEffects = expr_ok primOpOkForSideEffects\n\nexpr_ok :: (PrimOp -> Bool) -> CoreExpr -> Bool\nexpr_ok _ (Lit _)      = True\nexpr_ok _ (Type _)     = True\nexpr_ok _ (Coercion _) = True\n\nexpr_ok primop_ok (Var v)    = app_ok primop_ok v []\nexpr_ok primop_ok (Cast e _) = expr_ok primop_ok e\nexpr_ok primop_ok (Lam b e)\n                 | isTyVar b = expr_ok primop_ok  e\n                 | otherwise = True\n\n-- Tick annotations that *tick* cannot be speculated, because these\n-- are meant to identify whether or not (and how often) the particular\n-- source expression was evaluated at runtime.\nexpr_ok primop_ok (Tick tickish e)\n   | tickishCounts tickish = False\n   | otherwise             = expr_ok primop_ok e\n\nexpr_ok _ (Let {}) = False\n  -- Lets can be stacked deeply, so just give up.\n  -- In any case, the argument of exprOkForSpeculation is\n  -- usually in a strict context, so any lets will have been\n  -- floated away.\n\nexpr_ok primop_ok (Case scrut bndr _ alts)\n  =  -- See Note [exprOkForSpeculation: case expressions]\n     expr_ok primop_ok scrut\n  && isUnliftedType (idType bndr)\n  && all (\\(_,_,rhs) -> expr_ok primop_ok rhs) alts\n  && altsAreExhaustive alts\n\nexpr_ok primop_ok other_expr\n  | (expr, args) <- collectArgs other_expr\n  = case stripTicksTopE (not . tickishCounts) expr of\n        Var f   -> app_ok primop_ok f args\n        -- 'LitRubbish' is the only literal that can occur in the head of an\n        -- application and will not be matched by the above case (Var /= Lit).\n        Lit lit -> ASSERT( lit == rubbishLit ) True\n        _       -> False\n\n-----------------------------\napp_ok :: (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool\napp_ok primop_ok fun args\n  = case idDetails fun of\n      DFunId new_type ->  not new_type\n         -- DFuns terminate, unless the dict is implemented\n         -- with a newtype in which case they may not\n\n      DataConWorkId {} -> True\n                -- The strictness of the constructor has already\n                -- been expressed by its \"wrapper\", so we don't need\n                -- to take the arguments into account\n\n      PrimOpId op\n        | isDivOp op\n        , [arg1, Lit lit] <- args\n        -> not (isZeroLit lit) && expr_ok primop_ok arg1\n              -- Special case for dividing operations that fail\n              -- In general they are NOT ok-for-speculation\n              -- (which primop_ok will catch), but they ARE OK\n              -- if the divisor is definitely non-zero.\n              -- Often there is a literal divisor, and this\n              -- can get rid of a thunk in an inner loop\n\n        | SeqOp <- op  -- See Note [exprOkForSpeculation and SeqOp/DataToTagOp]\n        -> False       --     for the special cases for SeqOp and DataToTagOp\n        | DataToTagOp <- op\n        -> False\n\n        | otherwise\n        -> primop_ok op  -- Check the primop itself\n        && and (zipWith primop_arg_ok arg_tys args)  -- Check the arguments\n\n      _other -> isUnliftedType (idType fun)          -- c.f. the Var case of exprIsHNF\n             || idArity fun > n_val_args             -- Partial apps\n             -- NB: even in the nullary case, do /not/ check\n             --     for evaluated-ness of the fun;\n             --     see Note [exprOkForSpeculation and evaluated variables]\n             where\n               n_val_args = valArgCount args\n  where\n    (arg_tys, _) = splitPiTys (idType fun)\n\n    primop_arg_ok :: TyBinder -> CoreExpr -> Bool\n    primop_arg_ok (Named _) _ = True   -- A type argument\n    primop_arg_ok (Anon _ ty) arg      -- A term argument\n       | isUnliftedType ty = expr_ok primop_ok arg\n       | otherwise         = True  -- See Note [Primops with lifted arguments]\n\n-----------------------------\naltsAreExhaustive :: [Alt b] -> Bool\n-- True  <=> the case alternatives are definiely exhaustive\n-- False <=> they may or may not be\naltsAreExhaustive []\n  = False    -- Should not happen\naltsAreExhaustive ((con1,_,_) : alts)\n  = case con1 of\n      DEFAULT   -> True\n      LitAlt {} -> False\n      DataAlt c -> alts `lengthIs` (tyConFamilySize (dataConTyCon c) - 1)\n      -- It is possible to have an exhaustive case that does not\n      -- enumerate all constructors, notably in a GADT match, but\n      -- we behave conservatively here -- I don't think it's important\n      -- enough to deserve special treatment\n\n-- | True of dyadic operators that can fail only if the second arg is zero!\nisDivOp :: PrimOp -> Bool\n-- This function probably belongs in PrimOp, or even in\n-- an automagically generated file.. but it's such a\n-- special case I thought I'd leave it here for now.\nisDivOp IntQuotOp        = True\nisDivOp IntRemOp         = True\nisDivOp WordQuotOp       = True\nisDivOp WordRemOp        = True\nisDivOp FloatDivOp       = True\nisDivOp DoubleDivOp      = True\nisDivOp _                = False\n\n{- Note [exprOkForSpeculation: case expressions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nexprOkForSpeculation accepts very special case expressions.\nReason: (a ==# b) is ok-for-speculation, but the litEq rules\nin PrelRules convert it (a ==# 3#) to\n   case a of { DEFAULT -> 0#; 3# -> 1# }\nfor excellent reasons described in\n  PrelRules Note [The litEq rule: converting equality to case].\nSo, annoyingly, we want that case expression to be\nok-for-speculation too. Bother.\n\nBut we restrict it sharply:\n\n* We restrict it to unlifted scrutinees. Consider this:\n     case x of y {\n       DEFAULT -> ... (let v::Int# = case y of { True  -> e1\n                                               ; False -> e2 }\n                       in ...) ...\n\n  Does the RHS of v satisfy the let/app invariant?  Previously we said\n  yes, on the grounds that y is evaluated.  But the binder-swap done\n  by SetLevels would transform the inner alternative to\n     DEFAULT -> ... (let v::Int# = case x of { ... }\n                     in ...) ....\n  which does /not/ satisfy the let/app invariant, because x is\n  not evaluated. See Note [Binder-swap during float-out]\n  in SetLevels.  To avoid this awkwardness it seems simpler\n  to stick to unlifted scrutinees where the issue does not\n  arise.\n\n* We restrict it to exhaustive alternatives. A non-exhaustive\n  case manifestly isn't ok-for-speculation. for example,\n  this is a valid program (albeit a slightly dodgy one)\n    let v = case x of { B -> ...; C -> ... }\n    in case x of\n         A -> ...\n         _ ->  ...v...v....\n  Should v be considered ok-for-speculation?  Its scrutinee may be\n  evaluated, but the alternatives are incomplete so we should not\n  evaluate it strictly.\n\n  Now, all this is for lifted types, but it'd be the same for any\n  finite unlifted type. We don't have many of them, but we might\n  add unlifted algebraic types in due course.\n\n\n----- Historical note: Trac #15696: --------\n  Previously SetLevels used exprOkForSpeculation to guide\n  floating of single-alternative cases; it now uses exprIsHNF\n  Note [Floating single-alternative cases].\n\n  But in those days, consider\n    case e of x { DEAFULT ->\n      ...(case x of y\n            A -> ...\n            _ -> ...(case (case x of { B -> p; C -> p }) of\n                       I# r -> blah)...\n  If SetLevels considers the inner nested case as\n  ok-for-speculation it can do case-floating (in SetLevels).\n  So we'd float to:\n    case e of x { DEAFULT ->\n    case (case x of { B -> p; C -> p }) of I# r ->\n    ...(case x of y\n            A -> ...\n            _ -> ...blah...)...\n  which is utterly bogus (seg fault); see Trac #5453.\n\n----- Historical note: Trac #3717: --------\n    foo :: Int -> Int\n    foo 0 = 0\n    foo n = (if n < 5 then 1 else 2) `seq` foo (n-1)\n\nIn earlier GHCs, we got this:\n    T.$wfoo =\n      \\ (ww :: GHC.Prim.Int#) ->\n        case ww of ds {\n          __DEFAULT -> case (case <# ds 5 of _ {\n                          GHC.Types.False -> lvl1;\n                          GHC.Types.True -> lvl})\n                       of _ { __DEFAULT ->\n                       T.$wfoo (GHC.Prim.-# ds_XkE 1) };\n          0 -> 0 }\n\nBefore join-points etc we could only get rid of two cases (which are\nredundant) by recognising that the (case <# ds 5 of { ... }) is\nok-for-speculation, even though it has /lifted/ type.  But now join\npoints do the job nicely.\n------- End of historical note ------------\n\n\nNote [Primops with lifted arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIs this ok-for-speculation (see Trac #13027)?\n   reallyUnsafePtrEq# a b\nWell, yes.  The primop accepts lifted arguments and does not\nevaluate them.  Indeed, in general primops are, well, primitive\nand do not perform evaluation.\n\nBottom line:\n  * In exprOkForSpeculation we simply ignore all lifted arguments.\n  * In the rare case of primops that /do/ evaluate their arguments,\n    (namely DataToTagOp and SeqOp) return False; see\n    Note [exprOkForSpeculation and evaluated variables]\n\nNote [exprOkForSpeculation and SeqOp/DataToTagOp]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMost primops with lifted arguments don't evaluate them\n(see Note [Primops with lifted arguments]), so we can ignore\nthat argument entirely when doing exprOkForSpeculation.\n\nBut DataToTagOp and SeqOp are exceptions to that rule.\nFor reasons described in Note [exprOkForSpeculation and\nevaluated variables], we simply return False for them.\n\nNot doing this made #5129 go bad.\nLots of discussion in #15696.\n\nNote [exprOkForSpeculation and evaluated variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRecall that\n  seq#       :: forall a s. a -> State# s -> (# State# s, a #)\n  dataToTag# :: forall a.   a -> Int#\nmust always evaluate their first argument.\n\nNow consider these examples:\n * case x of y { DEFAULT -> ....y.... }\n   Should 'y' (alone) be considered ok-for-speculation?\n\n * case x of y { DEFAULT -> ....f (dataToTag# y)... }\n   Should (dataToTag# y) be considered ok-for-spec?\n\nYou could argue 'yes', because in the case alternative we know that\n'y' is evaluated.  But the binder-swap transformation, which is\nextremely useful for float-out, changes these expressions to\n   case x of y { DEFAULT -> ....x.... }\n   case x of y { DEFAULT -> ....f (dataToTag# x)... }\n\nAnd now the expression does not obey the let/app invariant!  Yikes!\nMoreover we really might float (f (dataToTag# x)) outside the case,\nand then it really, really doesn't obey the let/app invariant.\n\nThe solution is simple: exprOkForSpeculation does not try to take\nadvantage of the evaluated-ness of (lifted) variables.  And it returns\nFalse (always) for DataToTagOp and SeqOp.\n\nNote that exprIsHNF /can/ and does take advantage of evaluated-ness;\nit doesn't have the trickiness of the let/app invariant to worry about.\n\n************************************************************************\n*                                                                      *\n             exprIsHNF, exprIsConLike\n*                                                                      *\n************************************************************************\n-}\n\n-- Note [exprIsHNF]             See also Note [exprIsCheap and exprIsHNF]\n-- ~~~~~~~~~~~~~~~~\n-- | exprIsHNF returns true for expressions that are certainly /already/\n-- evaluated to /head/ normal form.  This is used to decide whether it's ok\n-- to change:\n--\n-- > case x of _ -> e\n--\n--    into:\n--\n-- > e\n--\n-- and to decide whether it's safe to discard a 'seq'.\n--\n-- So, it does /not/ treat variables as evaluated, unless they say they are.\n-- However, it /does/ treat partial applications and constructor applications\n-- as values, even if their arguments are non-trivial, provided the argument\n-- type is lifted. For example, both of these are values:\n--\n-- > (:) (f x) (map f xs)\n-- > map (...redex...)\n--\n-- because 'seq' on such things completes immediately.\n--\n-- For unlifted argument types, we have to be careful:\n--\n-- > C (f x :: Int#)\n--\n-- Suppose @f x@ diverges; then @C (f x)@ is not a value. However this can't\n-- happen: see \"CoreSyn#let_app_invariant\". This invariant states that arguments of\n-- unboxed type must be ok-for-speculation (or trivial).\nexprIsHNF :: CoreExpr -> Bool           -- True => Value-lambda, constructor, PAP\nexprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding\n\n-- | Similar to 'exprIsHNF' but includes CONLIKE functions as well as\n-- data constructors. Conlike arguments are considered interesting by the\n-- inliner.\nexprIsConLike :: CoreExpr -> Bool       -- True => lambda, conlike, PAP\nexprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding\n\n-- | Returns true for values or value-like expressions. These are lambdas,\n-- constructors / CONLIKE functions (as determined by the function argument)\n-- or PAPs.\n--\nexprIsHNFlike :: (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool\nexprIsHNFlike is_con is_con_unf = is_hnf_like\n  where\n    is_hnf_like (Var v) -- NB: There are no value args at this point\n      =  id_app_is_value v 0 -- Catches nullary constructors,\n                             --      so that [] and () are values, for example\n                             -- and (e.g.) primops that don't have unfoldings\n      || is_con_unf (idUnfolding v)\n        -- Check the thing's unfolding; it might be bound to a value\n        --   or to a guaranteed-evaluated variable (isEvaldUnfolding)\n        --   Contrast with Note [exprOkForSpeculation and evaluated variables]\n        -- We don't look through loop breakers here, which is a bit conservative\n        -- but otherwise I worry that if an Id's unfolding is just itself,\n        -- we could get an infinite loop\n\n    is_hnf_like (Lit _)          = True\n    is_hnf_like (Type _)         = True       -- Types are honorary Values;\n                                              -- we don't mind copying them\n    is_hnf_like (Coercion _)     = True       -- Same for coercions\n    is_hnf_like (Lam b e)        = isRuntimeVar b || is_hnf_like e\n    is_hnf_like (Tick tickish e) = not (tickishCounts tickish)\n                                   && is_hnf_like e\n                                      -- See Note [exprIsHNF Tick]\n    is_hnf_like (Cast e _)       = is_hnf_like e\n    is_hnf_like (App e a)\n      | isValArg a               = app_is_value e 1\n      | otherwise                = is_hnf_like e\n    is_hnf_like (Let _ e)        = is_hnf_like e  -- Lazy let(rec)s don't affect us\n    is_hnf_like _                = False\n\n    -- 'n' is the number of value args to which the expression is applied\n    -- And n>0: there is at least one value argument\n    app_is_value :: CoreExpr -> Int -> Bool\n    app_is_value (Var f)    nva = id_app_is_value f nva\n    app_is_value (Tick _ f) nva = app_is_value f nva\n    app_is_value (Cast f _) nva = app_is_value f nva\n    app_is_value (App f a)  nva\n      | isValArg a              = app_is_value f (nva + 1)\n      | otherwise               = app_is_value f nva\n    app_is_value _          _   = False\n\n    id_app_is_value id n_val_args\n       = is_con id\n       || idArity id > n_val_args\n       || id `hasKey` absentErrorIdKey  -- See Note [aBSENT_ERROR_ID] in MkCore\n                      -- absentError behaves like an honorary data constructor\n\n\n{-\nNote [exprIsHNF Tick]\n\nWe can discard source annotations on HNFs as long as they aren't\ntick-like:\n\n  scc c (\\x . e)    =>  \\x . e\n  scc c (C x1..xn)  =>  C x1..xn\n\nSo we regard these as HNFs.  Tick annotations that tick are not\nregarded as HNF if the expression they surround is HNF, because the\ntick is there to tell us that the expression was evaluated, so we\ndon't want to discard a seq on it.\n-}\n\n-- | Can we bind this 'CoreExpr' at the top level?\nexprIsTopLevelBindable :: CoreExpr -> Type -> Bool\n-- See Note [CoreSyn top-level string literals]\n-- Precondition: exprType expr = ty\n-- Top-level literal strings can't even be wrapped in ticks\n--   see Note [CoreSyn top-level string literals] in CoreSyn\nexprIsTopLevelBindable expr ty\n  = not (isUnliftedType ty)\n  || exprIsTickedString expr\n\n-- | Check if the expression is zero or more Ticks wrapped around a literal\n-- string.\nexprIsTickedString :: CoreExpr -> Bool\nexprIsTickedString = isJust . exprIsTickedString_maybe\n\n-- | Extract a literal string from an expression that is zero or more Ticks\n-- wrapped around a literal string. Returns Nothing if the expression has a\n-- different shape.\n-- Used to \"look through\" Ticks in places that need to handle literal strings.\nexprIsTickedString_maybe :: CoreExpr -> Maybe ByteString\nexprIsTickedString_maybe (Lit (LitString bs)) = Just bs\nexprIsTickedString_maybe (Tick t e)\n  -- we don't tick literals with CostCentre ticks, compare to mkTick\n  | tickishPlace t == PlaceCostCentre = Nothing\n  | otherwise = exprIsTickedString_maybe e\nexprIsTickedString_maybe _ = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n             Instantiating data constructors\n*                                                                      *\n************************************************************************\n\nThese InstPat functions go here to avoid circularity between DataCon and Id\n-}\n\ndataConRepInstPat   ::                 [Unique] -> DataCon -> [Type] -> ([TyCoVar], [Id])\ndataConRepFSInstPat :: [FastString] -> [Unique] -> DataCon -> [Type] -> ([TyCoVar], [Id])\n\ndataConRepInstPat   = dataConInstPat (repeat ((fsLit \"ipv\")))\ndataConRepFSInstPat = dataConInstPat\n\ndataConInstPat :: [FastString]          -- A long enough list of FSs to use for names\n               -> [Unique]              -- An equally long list of uniques, at least one for each binder\n               -> DataCon\n               -> [Type]                -- Types to instantiate the universally quantified tyvars\n               -> ([TyCoVar], [Id])     -- Return instantiated variables\n-- dataConInstPat arg_fun fss us con inst_tys returns a tuple\n-- (ex_tvs, arg_ids),\n--\n--   ex_tvs are intended to be used as binders for existential type args\n--\n--   arg_ids are indended to be used as binders for value arguments,\n--     and their types have been instantiated with inst_tys and ex_tys\n--     The arg_ids include both evidence and\n--     programmer-specified arguments (both after rep-ing)\n--\n-- Example.\n--  The following constructor T1\n--\n--  data T a where\n--    T1 :: forall b. Int -> b -> T(a,b)\n--    ...\n--\n--  has representation type\n--   forall a. forall a1. forall b. (a ~ (a1,b)) =>\n--     Int -> b -> T a\n--\n--  dataConInstPat fss us T1 (a1',b') will return\n--\n--  ([a1'', b''], [c :: (a1', b')~(a1'', b''), x :: Int, y :: b''])\n--\n--  where the double-primed variables are created with the FastStrings and\n--  Uniques given as fss and us\ndataConInstPat fss uniqs con inst_tys\n  = ASSERT( univ_tvs `equalLength` inst_tys )\n    (ex_bndrs, arg_ids)\n  where\n    univ_tvs = dataConUnivTyVars con\n    ex_tvs   = dataConExTyCoVars con\n    arg_tys  = dataConRepArgTys con\n    arg_strs = dataConRepStrictness con  -- 1-1 with arg_tys\n    n_ex = length ex_tvs\n\n      -- split the Uniques and FastStrings\n    (ex_uniqs, id_uniqs) = splitAt n_ex uniqs\n    (ex_fss,   id_fss)   = splitAt n_ex fss\n\n      -- Make the instantiating substitution for universals\n    univ_subst = zipTvSubst univ_tvs inst_tys\n\n      -- Make existential type variables, applying and extending the substitution\n    (full_subst, ex_bndrs) = mapAccumL mk_ex_var univ_subst\n                                       (zip3 ex_tvs ex_fss ex_uniqs)\n\n    mk_ex_var :: TCvSubst -> (TyCoVar, FastString, Unique) -> (TCvSubst, TyCoVar)\n    mk_ex_var subst (tv, fs, uniq) = (Type.extendTCvSubstWithClone subst tv\n                                       new_tv\n                                     , new_tv)\n      where\n        new_tv | isTyVar tv\n               = mkTyVar (mkSysTvName uniq fs) kind\n               | otherwise\n               = mkCoVar (mkSystemVarName uniq fs) kind\n        kind   = Type.substTyUnchecked subst (varType tv)\n\n      -- Make value vars, instantiating types\n    arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs\n    mk_id_var uniq fs ty str\n      = setCaseBndrEvald str $  -- See Note [Mark evaluated arguments]\n        mkLocalIdOrCoVar name (Type.substTy full_subst ty)\n      where\n        name = mkInternalName uniq (mkVarOccFS fs) noSrcSpan\n\n{-\nNote [Mark evaluated arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen pattern matching on a constructor with strict fields, the binder\ncan have an 'evaldUnfolding'.  Moreover, it *should* have one, so that\nwhen loading an interface file unfolding like:\n  data T = MkT !Int\n  f x = case x of { MkT y -> let v::Int# = case y of I# n -> n+1\n                             in ... }\nwe don't want Lint to complain.  The 'y' is evaluated, so the\ncase in the RHS of the binding for 'v' is fine.  But only if we\n*know* that 'y' is evaluated.\n\nc.f. add_evals in Simplify.simplAlt\n\n************************************************************************\n*                                                                      *\n         Equality\n*                                                                      *\n************************************************************************\n-}\n\n-- | A cheap equality test which bales out fast!\n--      If it returns @True@ the arguments are definitely equal,\n--      otherwise, they may or may not be equal.\n--\n-- See also 'exprIsBig'\ncheapEqExpr :: Expr b -> Expr b -> Bool\ncheapEqExpr = cheapEqExpr' (const False)\n\n-- | Cheap expression equality test, can ignore ticks by type.\ncheapEqExpr' :: (Tickish Id -> Bool) -> Expr b -> Expr b -> Bool\ncheapEqExpr' ignoreTick = go_s\n  where go_s = go `on` stripTicksTopE ignoreTick\n        go (Var v1)   (Var v2)   = v1 == v2\n        go (Lit lit1) (Lit lit2) = lit1 == lit2\n        go (Type t1)  (Type t2)  = t1 `eqType` t2\n        go (Coercion c1) (Coercion c2) = c1 `eqCoercion` c2\n\n        go (App f1 a1) (App f2 a2)\n          = f1 `go_s` f2 && a1 `go_s` a2\n\n        go (Cast e1 t1) (Cast e2 t2)\n          = e1 `go_s` e2 && t1 `eqCoercion` t2\n\n        go (Tick t1 e1) (Tick t2 e2)\n          = t1 == t2 && e1 `go_s` e2\n\n        go _ _ = False\n        {-# INLINE go #-}\n{-# INLINE cheapEqExpr' #-}\n\nexprIsBig :: Expr b -> Bool\n-- ^ Returns @True@ of expressions that are too big to be compared by 'cheapEqExpr'\nexprIsBig (Lit _)      = False\nexprIsBig (Var _)      = False\nexprIsBig (Type _)     = False\nexprIsBig (Coercion _) = False\nexprIsBig (Lam _ e)    = exprIsBig e\nexprIsBig (App f a)    = exprIsBig f || exprIsBig a\nexprIsBig (Cast e _)   = exprIsBig e    -- Hopefully coercions are not too big!\nexprIsBig (Tick _ e)   = exprIsBig e\nexprIsBig _            = True\n\neqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool\n-- Compares for equality, modulo alpha\neqExpr in_scope e1 e2\n  = go (mkRnEnv2 in_scope) e1 e2\n  where\n    go env (Var v1) (Var v2)\n      | rnOccL env v1 == rnOccR env v2\n      = True\n\n    go _   (Lit lit1)    (Lit lit2)      = lit1 == lit2\n    go env (Type t1)    (Type t2)        = eqTypeX env t1 t2\n    go env (Coercion co1) (Coercion co2) = eqCoercionX env co1 co2\n    go env (Cast e1 co1) (Cast e2 co2) = eqCoercionX env co1 co2 && go env e1 e2\n    go env (App f1 a1)   (App f2 a2)   = go env f1 f2 && go env a1 a2\n    go env (Tick n1 e1)  (Tick n2 e2)  = eqTickish env n1 n2 && go env e1 e2\n\n    go env (Lam b1 e1)  (Lam b2 e2)\n      =  eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination\n      && go (rnBndr2 env b1 b2) e1 e2\n\n    go env (Let (NonRec v1 r1) e1) (Let (NonRec v2 r2) e2)\n      =  go env r1 r2  -- No need to check binder types, since RHSs match\n      && go (rnBndr2 env v1 v2) e1 e2\n\n    go env (Let (Rec ps1) e1) (Let (Rec ps2) e2)\n      = equalLength ps1 ps2\n      && all2 (go env') rs1 rs2 && go env' e1 e2\n      where\n        (bs1,rs1) = unzip ps1\n        (bs2,rs2) = unzip ps2\n        env' = rnBndrs2 env bs1 bs2\n\n    go env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)\n      | null a1   -- See Note [Empty case alternatives] in TrieMap\n      = null a2 && go env e1 e2 && eqTypeX env t1 t2\n      | otherwise\n      =  go env e1 e2 && all2 (go_alt (rnBndr2 env b1 b2)) a1 a2\n\n    go _ _ _ = False\n\n    -----------\n    go_alt env (c1, bs1, e1) (c2, bs2, e2)\n      = c1 == c2 && go (rnBndrs2 env bs1 bs2) e1 e2\n\neqTickish :: RnEnv2 -> Tickish Id -> Tickish Id -> Bool\neqTickish env (Breakpoint lid lids) (Breakpoint rid rids)\n      = lid == rid  &&  map (rnOccL env) lids == map (rnOccR env) rids\neqTickish _ l r = l == r\n\n-- | Finds differences between core expressions, modulo alpha and\n-- renaming. Setting @top@ means that the @IdInfo@ of bindings will be\n-- checked for differences as well.\ndiffExpr :: Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]\ndiffExpr _   env (Var v1)   (Var v2)   | rnOccL env v1 == rnOccR env v2 = []\ndiffExpr _   _   (Lit lit1) (Lit lit2) | lit1 == lit2                   = []\ndiffExpr _   env (Type t1)  (Type t2)  | eqTypeX env t1 t2              = []\ndiffExpr _   env (Coercion co1) (Coercion co2)\n                                       | eqCoercionX env co1 co2        = []\ndiffExpr top env (Cast e1 co1)  (Cast e2 co2)\n  | eqCoercionX env co1 co2                = diffExpr top env e1 e2\ndiffExpr top env (Tick n1 e1)   e2\n  | not (tickishIsCode n1)                 = diffExpr top env e1 e2\ndiffExpr top env e1             (Tick n2 e2)\n  | not (tickishIsCode n2)                 = diffExpr top env e1 e2\ndiffExpr top env (Tick n1 e1)   (Tick n2 e2)\n  | eqTickish env n1 n2                    = diffExpr top env e1 e2\n -- The error message of failed pattern matches will contain\n -- generated names, which are allowed to differ.\ndiffExpr _   _   (App (App (Var absent) _) _)\n                 (App (App (Var absent2) _) _)\n  | isBottomingId absent && isBottomingId absent2 = []\ndiffExpr top env (App f1 a1)    (App f2 a2)\n  = diffExpr top env f1 f2 ++ diffExpr top env a1 a2\ndiffExpr top env (Lam b1 e1)  (Lam b2 e2)\n  | eqTypeX env (varType b1) (varType b2)   -- False for Id/TyVar combination\n  = diffExpr top (rnBndr2 env b1 b2) e1 e2\ndiffExpr top env (Let bs1 e1) (Let bs2 e2)\n  = let (ds, env') = diffBinds top env (flattenBinds [bs1]) (flattenBinds [bs2])\n    in ds ++ diffExpr top env' e1 e2\ndiffExpr top env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)\n  | equalLength a1 a2 && not (null a1) || eqTypeX env t1 t2\n    -- See Note [Empty case alternatives] in TrieMap\n  = diffExpr top env e1 e2 ++ concat (zipWith diffAlt a1 a2)\n  where env' = rnBndr2 env b1 b2\n        diffAlt (c1, bs1, e1) (c2, bs2, e2)\n          | c1 /= c2  = [text \"alt-cons \" <> ppr c1 <> text \" /= \" <> ppr c2]\n          | otherwise = diffExpr top (rnBndrs2 env' bs1 bs2) e1 e2\ndiffExpr _  _ e1 e2\n  = [fsep [ppr e1, text \"/=\", ppr e2]]\n\n-- | Finds differences between core bindings, see @diffExpr@.\n--\n-- The main problem here is that while we expect the binds to have the\n-- same order in both lists, this is not guaranteed. To do this\n-- properly we'd either have to do some sort of unification or check\n-- all possible mappings, which would be seriously expensive. So\n-- instead we simply match single bindings as far as we can. This\n-- leaves us just with mutually recursive and/or mismatching bindings,\n-- which we then speculatively match by ordering them. It's by no means\n-- perfect, but gets the job done well enough.\ndiffBinds :: Bool -> RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]\n          -> ([SDoc], RnEnv2)\ndiffBinds top env binds1 = go (length binds1) env binds1\n where go _    env []     []\n          = ([], env)\n       go fuel env binds1 binds2\n          -- No binds left to compare? Bail out early.\n          | null binds1 || null binds2\n          = (warn env binds1 binds2, env)\n          -- Iterated over all binds without finding a match? Then\n          -- try speculatively matching binders by order.\n          | fuel == 0\n          = if not $ env `inRnEnvL` fst (head binds1)\n            then let env' = uncurry (rnBndrs2 env) $ unzip $\n                            zip (sort $ map fst binds1) (sort $ map fst binds2)\n                 in go (length binds1) env' binds1 binds2\n            -- If we have already tried that, give up\n            else (warn env binds1 binds2, env)\n       go fuel env ((bndr1,expr1):binds1) binds2\n          | let matchExpr (bndr,expr) =\n                  (not top || null (diffIdInfo env bndr bndr1)) &&\n                  null (diffExpr top (rnBndr2 env bndr1 bndr) expr1 expr)\n          , (binds2l, (bndr2,_):binds2r) <- break matchExpr binds2\n          = go (length binds1) (rnBndr2 env bndr1 bndr2)\n                binds1 (binds2l ++ binds2r)\n          | otherwise -- No match, so push back (FIXME O(n^2))\n          = go (fuel-1) env (binds1++[(bndr1,expr1)]) binds2\n       go _ _ _ _ = panic \"diffBinds: impossible\" -- GHC isn't smart enough\n\n       -- We have tried everything, but couldn't find a good match. So\n       -- now we just return the comparison results when we pair up\n       -- the binds in a pseudo-random order.\n       warn env binds1 binds2 =\n         concatMap (uncurry (diffBind env)) (zip binds1' binds2') ++\n         unmatched \"unmatched left-hand:\" (drop l binds1') ++\n         unmatched \"unmatched right-hand:\" (drop l binds2')\n        where binds1' = sortBy (comparing fst) binds1\n              binds2' = sortBy (comparing fst) binds2\n              l = min (length binds1') (length binds2')\n       unmatched _   [] = []\n       unmatched txt bs = [text txt $$ ppr (Rec bs)]\n       diffBind env (bndr1,expr1) (bndr2,expr2)\n         | ds@(_:_) <- diffExpr top env expr1 expr2\n         = locBind \"in binding\" bndr1 bndr2 ds\n         | otherwise\n         = diffIdInfo env bndr1 bndr2\n\n-- | Find differences in @IdInfo@. We will especially check whether\n-- the unfoldings match, if present (see @diffUnfold@).\ndiffIdInfo :: RnEnv2 -> Var -> Var -> [SDoc]\ndiffIdInfo env bndr1 bndr2\n  | arityInfo info1 == arityInfo info2\n    && cafInfo info1 == cafInfo info2\n    && oneShotInfo info1 == oneShotInfo info2\n    && inlinePragInfo info1 == inlinePragInfo info2\n    && occInfo info1 == occInfo info2\n    && demandInfo info1 == demandInfo info2\n    && callArityInfo info1 == callArityInfo info2\n    && levityInfo info1 == levityInfo info2\n  = locBind \"in unfolding of\" bndr1 bndr2 $\n    diffUnfold env (unfoldingInfo info1) (unfoldingInfo info2)\n  | otherwise\n  = locBind \"in Id info of\" bndr1 bndr2\n    [fsep [pprBndr LetBind bndr1, text \"/=\", pprBndr LetBind bndr2]]\n  where info1 = idInfo bndr1; info2 = idInfo bndr2\n\n-- | Find differences in unfoldings. Note that we will not check for\n-- differences of @IdInfo@ in unfoldings, as this is generally\n-- redundant, and can lead to an exponential blow-up in complexity.\ndiffUnfold :: RnEnv2 -> Unfolding -> Unfolding -> [SDoc]\ndiffUnfold _   NoUnfolding    NoUnfolding                 = []\ndiffUnfold _   BootUnfolding  BootUnfolding               = []\ndiffUnfold _   (OtherCon cs1) (OtherCon cs2) | cs1 == cs2 = []\ndiffUnfold env (DFunUnfolding bs1 c1 a1)\n               (DFunUnfolding bs2 c2 a2)\n  | c1 == c2 && equalLength bs1 bs2\n  = concatMap (uncurry (diffExpr False env')) (zip a1 a2)\n  where env' = rnBndrs2 env bs1 bs2\ndiffUnfold env (CoreUnfolding t1 _ _ v1 cl1 wf1 x1 g1)\n               (CoreUnfolding t2 _ _ v2 cl2 wf2 x2 g2)\n  | v1 == v2 && cl1 == cl2\n    && wf1 == wf2 && x1 == x2 && g1 == g2\n  = diffExpr False env t1 t2\ndiffUnfold _   uf1 uf2\n  = [fsep [ppr uf1, text \"/=\", ppr uf2]]\n\n-- | Add location information to diff messages\nlocBind :: String -> Var -> Var -> [SDoc] -> [SDoc]\nlocBind loc b1 b2 diffs = map addLoc diffs\n  where addLoc d            = d $$ nest 2 (parens (text loc <+> bindLoc))\n        bindLoc | b1 == b2  = ppr b1\n                | otherwise = ppr b1 <> char '/' <> ppr b2\n\n{-\n************************************************************************\n*                                                                      *\n                Eta reduction\n*                                                                      *\n************************************************************************\n\nNote [Eta reduction conditions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe try for eta reduction here, but *only* if we get all the way to an\ntrivial expression.  We don't want to remove extra lambdas unless we\nare going to avoid allocating this thing altogether.\n\nThere are some particularly delicate points here:\n\n* We want to eta-reduce if doing so leaves a trivial expression,\n  *including* a cast.  For example\n       \\x. f |> co  -->  f |> co\n  (provided co doesn't mention x)\n\n* Eta reduction is not valid in general:\n        \\x. bot  /=  bot\n  This matters, partly for old-fashioned correctness reasons but,\n  worse, getting it wrong can yield a seg fault. Consider\n        f = \\x.f x\n        h y = case (case y of { True -> f `seq` True; False -> False }) of\n                True -> ...; False -> ...\n\n  If we (unsoundly) eta-reduce f to get f=f, the strictness analyser\n  says f=bottom, and replaces the (f `seq` True) with just\n  (f `cast` unsafe-co).  BUT, as thing stand, 'f' got arity 1, and it\n  *keeps* arity 1 (perhaps also wrongly).  So CorePrep eta-expands\n  the definition again, so that it does not termninate after all.\n  Result: seg-fault because the boolean case actually gets a function value.\n  See Trac #1947.\n\n  So it's important to do the right thing.\n\n* Note [Arity care]: we need to be careful if we just look at f's\n  arity. Currently (Dec07), f's arity is visible in its own RHS (see\n  Note [Arity robustness] in SimplEnv) so we must *not* trust the\n  arity when checking that 'f' is a value.  Otherwise we will\n  eta-reduce\n      f = \\x. f x\n  to\n      f = f\n  Which might change a terminating program (think (f `seq` e)) to a\n  non-terminating one.  So we check for being a loop breaker first.\n\n  However for GlobalIds we can look at the arity; and for primops we\n  must, since they have no unfolding.\n\n* Regardless of whether 'f' is a value, we always want to\n  reduce (/\\a -> f a) to f\n  This came up in a RULE: foldr (build (/\\a -> g a))\n  did not match           foldr (build (/\\b -> ...something complex...))\n  The type checker can insert these eta-expanded versions,\n  with both type and dictionary lambdas; hence the slightly\n  ad-hoc isDictId\n\n* Never *reduce* arity. For example\n      f = \\xy. g x y\n  Then if h has arity 1 we don't want to eta-reduce because then\n  f's arity would decrease, and that is bad\n\nThese delicacies are why we don't use exprIsTrivial and exprIsHNF here.\nAlas.\n\nNote [Eta reduction with casted arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n    (\\(x:t3). f (x |> g)) :: t3 -> t2\n  where\n    f :: t1 -> t2\n    g :: t3 ~ t1\nThis should be eta-reduced to\n\n    f |> (sym g -> t2)\n\nSo we need to accumulate a coercion, pushing it inward (past\nvariable arguments only) thus:\n   f (x |> co_arg) |> co  -->  (f |> (sym co_arg -> co)) x\n   f (x:t)         |> co  -->  (f |> (t -> co)) x\n   f @ a           |> co  -->  (f |> (forall a.co)) @ a\n   f @ (g:t1~t2)   |> co  -->  (f |> (t1~t2 => co)) @ (g:t1~t2)\nThese are the equations for ok_arg.\n\nIt's true that we could also hope to eta reduce these:\n    (\\xy. (f x |> g) y)\n    (\\xy. (f x y) |> g)\nBut the simplifier pushes those casts outwards, so we don't\nneed to address that here.\n-}\n\ntryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr\ntryEtaReduce bndrs body\n  = go (reverse bndrs) body (mkRepReflCo (exprType body))\n  where\n    incoming_arity = count isId bndrs\n\n    go :: [Var]            -- Binders, innermost first, types [a3,a2,a1]\n       -> CoreExpr         -- Of type tr\n       -> Coercion         -- Of type tr ~ ts\n       -> Maybe CoreExpr   -- Of type a1 -> a2 -> a3 -> ts\n    -- See Note [Eta reduction with casted arguments]\n    -- for why we have an accumulating coercion\n    go [] fun co\n      | ok_fun fun\n      , let used_vars = exprFreeVars fun `unionVarSet` tyCoVarsOfCo co\n      , not (any (`elemVarSet` used_vars) bndrs)\n      = Just (mkCast fun co)   -- Check for any of the binders free in the result\n                               -- including the accumulated coercion\n\n    go bs (Tick t e) co\n      | tickishFloatable t\n      = fmap (Tick t) $ go bs e co\n      -- Float app ticks: \\x -> Tick t (e x) ==> Tick t e\n\n    go (b : bs) (App fun arg) co\n      | Just (co', ticks) <- ok_arg b arg co\n      = fmap (flip (foldr mkTick) ticks) $ go bs fun co'\n            -- Float arg ticks: \\x -> e (Tick t x) ==> Tick t e\n\n    go _ _ _  = Nothing         -- Failure!\n\n    ---------------\n    -- Note [Eta reduction conditions]\n    ok_fun (App fun (Type {})) = ok_fun fun\n    ok_fun (Cast fun _)        = ok_fun fun\n    ok_fun (Tick _ expr)       = ok_fun expr\n    ok_fun (Var fun_id)        = ok_fun_id fun_id || all ok_lam bndrs\n    ok_fun _fun                = False\n\n    ---------------\n    ok_fun_id fun = fun_arity fun >= incoming_arity\n\n    ---------------\n    fun_arity fun             -- See Note [Arity care]\n       | isLocalId fun\n       , isStrongLoopBreaker (idOccInfo fun) = 0\n       | arity > 0                           = arity\n       | isEvaldUnfolding (idUnfolding fun)  = 1\n            -- See Note [Eta reduction of an eval'd function]\n       | otherwise                           = 0\n       where\n         arity = idArity fun\n\n    ---------------\n    ok_lam v = isTyVar v || isEvVar v\n\n    ---------------\n    ok_arg :: Var              -- Of type bndr_t\n           -> CoreExpr         -- Of type arg_t\n           -> Coercion         -- Of kind (t1~t2)\n           -> Maybe (Coercion  -- Of type (arg_t -> t1 ~  bndr_t -> t2)\n                               --   (and similarly for tyvars, coercion args)\n                    , [Tickish Var])\n    -- See Note [Eta reduction with casted arguments]\n    ok_arg bndr (Type ty) co\n       | Just tv <- getTyVar_maybe ty\n       , bndr == tv  = Just (mkHomoForAllCos [tv] co, [])\n    ok_arg bndr (Var v) co\n       | bndr == v   = let reflCo = mkRepReflCo (idType bndr)\n                       in Just (mkFunCo Representational reflCo co, [])\n    ok_arg bndr (Cast e co_arg) co\n       | (ticks, Var v) <- stripTicksTop tickishFloatable e\n       , bndr == v\n       = Just (mkFunCo Representational (mkSymCo co_arg) co, ticks)\n       -- The simplifier combines multiple casts into one,\n       -- so we can have a simple-minded pattern match here\n    ok_arg bndr (Tick t arg) co\n       | tickishFloatable t, Just (co', ticks) <- ok_arg bndr arg co\n       = Just (co', t:ticks)\n\n    ok_arg _ _ _ = Nothing\n\n{-\nNote [Eta reduction of an eval'd function]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn Haskell it is not true that    f = \\x. f x\nbecause f might be bottom, and 'seq' can distinguish them.\n\nBut it *is* true that   f = f `seq` \\x. f x\nand we'd like to simplify the latter to the former.  This amounts\nto the rule that\n  * when there is just *one* value argument,\n  * f is not bottom\nwe can eta-reduce    \\x. f x  ===>  f\n\nThis turned up in Trac #7542.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Determining non-updatable right-hand-sides}\n*                                                                      *\n************************************************************************\n\nTop-level constructor applications can usually be allocated\nstatically, but they can't if the constructor, or any of the\narguments, come from another DLL (because we can't refer to static\nlabels in other DLLs).\n\nIf this happens we simply make the RHS into an updatable thunk,\nand 'execute' it rather than allocating it statically.\n-}\n\n-- | This function is called only on *top-level* right-hand sides.\n-- Returns @True@ if the RHS can be allocated statically in the output,\n-- with no thunks involved at all.\nrhsIsStatic\n   :: Platform\n   -> (Name -> Bool)         -- Which names are dynamic\n   -> (LitNumType -> Integer -> Maybe CoreExpr)\n      -- Desugaring for some literals (disgusting)\n      -- C.f. Note [Disgusting computation of CafRefs] in TidyPgm\n   -> CoreExpr -> Bool\n-- It's called (i) in TidyPgm.hasCafRefs to decide if the rhs is, or\n-- refers to, CAFs; (ii) in CoreToStg to decide whether to put an\n-- update flag on it and (iii) in DsExpr to decide how to expand\n-- list literals\n--\n-- The basic idea is that rhsIsStatic returns True only if the RHS is\n--      (a) a value lambda\n--      (b) a saturated constructor application with static args\n--\n-- BUT watch out for\n--  (i) Any cross-DLL references kill static-ness completely\n--      because they must be 'executed' not statically allocated\n--      (\"DLL\" here really only refers to Windows DLLs, on other platforms,\n--      this is not necessary)\n--\n-- (ii) We treat partial applications as redexes, because in fact we\n--      make a thunk for them that runs and builds a PAP\n--      at run-time.  The only applications that are treated as\n--      static are *saturated* applications of constructors.\n\n-- We used to try to be clever with nested structures like this:\n--              ys = (:) w ((:) w [])\n-- on the grounds that CorePrep will flatten ANF-ise it later.\n-- But supporting this special case made the function much more\n-- complicated, because the special case only applies if there are no\n-- enclosing type lambdas:\n--              ys = /\\ a -> Foo (Baz ([] a))\n-- Here the nested (Baz []) won't float out to top level in CorePrep.\n--\n-- But in fact, even without -O, nested structures at top level are\n-- flattened by the simplifier, so we don't need to be super-clever here.\n--\n-- Examples\n--\n--      f = \\x::Int. x+7        TRUE\n--      p = (True,False)        TRUE\n--\n--      d = (fst p, False)      FALSE because there's a redex inside\n--                              (this particular one doesn't happen but...)\n--\n--      h = D# (1.0## /## 2.0##)        FALSE (redex again)\n--      n = /\\a. Nil a                  TRUE\n--\n--      t = /\\a. (:) (case w a of ...) (Nil a)  FALSE (redex)\n--\n--\n-- This is a bit like CoreUtils.exprIsHNF, with the following differences:\n--    a) scc \"foo\" (\\x -> ...) is updatable (so we catch the right SCC)\n--\n--    b) (C x xs), where C is a constructor is updatable if the application is\n--         dynamic\n--\n--    c) don't look through unfolding of f in (f x).\n\nrhsIsStatic platform is_dynamic_name cvt_literal rhs = is_static False rhs\n  where\n  is_static :: Bool     -- True <=> in a constructor argument; must be atomic\n            -> CoreExpr -> Bool\n\n  is_static False  (Lam b e)              = isRuntimeVar b || is_static False e\n  is_static in_arg (Tick n e)             = not (tickishIsCode n)\n                                              && is_static in_arg e\n  is_static in_arg (Cast e _)             = is_static in_arg e\n  is_static _      (Coercion {})          = True   -- Behaves just like a literal\n  is_static in_arg (Lit (LitNumber nt i _)) = case cvt_literal nt i of\n    Just e  -> is_static in_arg e\n    Nothing -> True\n  is_static _      (Lit (LitLabel {}))    = False\n  is_static _      (Lit _)                = True\n        -- A LitLabel (foreign import \"&foo\") in an argument\n        -- prevents a constructor application from being static.  The\n        -- reason is that it might give rise to unresolvable symbols\n        -- in the object file: under Linux, references to \"weak\"\n        -- symbols from the data segment give rise to \"unresolvable\n        -- relocation\" errors at link time This might be due to a bug\n        -- in the linker, but we'll work around it here anyway.\n        -- SDM 24/2/2004\n\n  is_static in_arg other_expr = go other_expr 0\n   where\n    go (Var f) n_val_args\n        | (platformOS platform /= OSMinGW32) ||\n          not (is_dynamic_name (idName f))\n        =  saturated_data_con f n_val_args\n        || (in_arg && n_val_args == 0)\n                -- A naked un-applied variable is *not* deemed a static RHS\n                -- E.g.         f = g\n                -- Reason: better to update so that the indirection gets shorted\n                --         out, and the true value will be seen\n                -- NB: if you change this, you'll break the invariant that THUNK_STATICs\n                --     are always updatable.  If you do so, make sure that non-updatable\n                --     ones have enough space for their static link field!\n\n    go (App f a) n_val_args\n        | isTypeArg a                    = go f n_val_args\n        | not in_arg && is_static True a = go f (n_val_args + 1)\n        -- The (not in_arg) checks that we aren't in a constructor argument;\n        -- if we are, we don't allow (value) applications of any sort\n        --\n        -- NB. In case you wonder, args are sometimes not atomic.  eg.\n        --   x = D# (1.0## /## 2.0##)\n        -- can't float because /## can fail.\n\n    go (Tick n f) n_val_args = not (tickishIsCode n) && go f n_val_args\n    go (Cast e _) n_val_args = go e n_val_args\n    go _          _          = False\n\n    saturated_data_con f n_val_args\n        = case isDataConWorkId_maybe f of\n            Just dc -> n_val_args == dataConRepArity dc\n            Nothing -> False\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Type utilities}\n*                                                                      *\n************************************************************************\n-}\n\n-- | True if the type has no non-bottom elements, e.g. when it is an empty\n-- datatype, or a GADT with non-satisfiable type parameters, e.g. Int :~: Bool.\n-- See Note [Bottoming expressions]\n--\n-- See Note [No alternatives lint check] for another use of this function.\nisEmptyTy :: Type -> Bool\nisEmptyTy ty\n    -- Data types where, given the particular type parameters, no data\n    -- constructor matches, are empty.\n    -- This includes data types with no constructors, e.g. Data.Void.Void.\n    | Just (tc, inst_tys) <- splitTyConApp_maybe ty\n    , Just dcs <- tyConDataCons_maybe tc\n    , all (dataConCannotMatch inst_tys) dcs\n    = True\n    | otherwise\n    = False\n\n{-\n*****************************************************\n*\n* StaticPtr\n*\n*****************************************************\n-}\n\n-- | @collectMakeStaticArgs (makeStatic t srcLoc e)@ yields\n-- @Just (makeStatic, t, srcLoc, e)@.\n--\n-- Returns @Nothing@ for every other expression.\ncollectMakeStaticArgs\n  :: CoreExpr -> Maybe (CoreExpr, Type, CoreExpr, CoreExpr)\ncollectMakeStaticArgs e\n    | (fun@(Var b), [Type t, loc, arg], _) <- collectArgsTicks (const True) e\n    , idName b == makeStaticName = Just (fun, t, loc, arg)\ncollectMakeStaticArgs _          = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Join points}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Does this binding bind a join point (or a recursive group of join points)?\nisJoinBind :: CoreBind -> Bool\nisJoinBind (NonRec b _)       = isJoinId b\nisJoinBind (Rec ((b, _) : _)) = isJoinId b\nisJoinBind _                  = False\n", "num_lines": 2634}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- | Handy functions for creating much Core syntax\nmodule MkCore (\n        -- * Constructing normal syntax\n        mkCoreLet, mkCoreLets,\n        mkCoreApp, mkCoreApps, mkCoreConApps,\n        mkCoreLams, mkWildCase, mkIfThenElse,\n        mkWildValBinder, mkWildEvBinder,\n        sortQuantVars, castBottomExpr,\n\n        -- * Constructing boxed literals\n        mkWordExpr, mkWordExprWord,\n        mkIntExpr, mkIntExprInt,\n        mkIntegerExpr, mkNaturalExpr,\n        mkFloatExpr, mkDoubleExpr,\n        mkCharExpr, mkStringExpr, mkStringExprFS, mkStringExprFSWith,\n\n        -- * Floats\n        FloatBind(..), wrapFloat, wrapFloats, floatBindings,\n\n        -- * Constructing small tuples\n        mkCoreVarTup, mkCoreVarTupTy, mkCoreTup, mkCoreUbxTup,\n        mkCoreTupBoxity, unitExpr,\n\n        -- * Constructing big tuples\n        mkBigCoreVarTup, mkBigCoreVarTup1,\n        mkBigCoreVarTupTy, mkBigCoreTupTy,\n        mkBigCoreTup,\n\n        -- * Deconstructing small tuples\n        mkSmallTupleSelector, mkSmallTupleCase,\n\n        -- * Deconstructing big tuples\n        mkTupleSelector, mkTupleSelector1, mkTupleCase,\n\n        -- * Constructing list expressions\n        mkNilExpr, mkConsExpr, mkListExpr,\n        mkFoldrExpr, mkBuildExpr,\n\n        -- * Constructing Maybe expressions\n        mkNothingExpr, mkJustExpr,\n\n        -- * Error Ids\n        mkRuntimeErrorApp, mkImpossibleExpr, mkAbsentErrorApp, errorIds,\n        rEC_CON_ERROR_ID, rUNTIME_ERROR_ID,\n        nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,\n        pAT_ERROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID,\n        tYPE_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Id\nimport Var      ( EvVar, setTyVarUnique )\n\nimport CoreSyn\nimport CoreUtils        ( exprType, needsCaseBinding, bindNonRec )\nimport Literal\nimport HscTypes\n\nimport TysWiredIn\nimport PrelNames\n\nimport HsUtils          ( mkChunkified, chunkify )\nimport Type\nimport Coercion         ( isCoVar )\nimport TysPrim\nimport DataCon          ( DataCon, dataConWorkId )\nimport IdInfo\nimport Demand\nimport Name      hiding ( varName )\nimport Outputable\nimport FastString\nimport UniqSupply\nimport BasicTypes\nimport Util\nimport DynFlags\nimport Data.List\n\nimport Data.Char        ( ord )\nimport Control.Monad.Fail as MonadFail ( MonadFail )\n\ninfixl 4 `mkCoreApp`, `mkCoreApps`\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Basic CoreSyn construction}\n*                                                                      *\n************************************************************************\n-}\nsortQuantVars :: [Var] -> [Var]\n-- Sort the variables, putting type and covars first, in scoped order,\n-- and then other Ids\n-- It is a deterministic sort, meaining it doesn't look at the values of\n-- Uniques. For explanation why it's important See Note [Unique Determinism]\n-- in Unique.\nsortQuantVars vs = sorted_tcvs ++ ids\n  where\n    (tcvs, ids) = partition (isTyVar <||> isCoVar) vs\n    sorted_tcvs = scopedSort tcvs\n\n-- | Bind a binding group over an expression, using a @let@ or @case@ as\n-- appropriate (see \"CoreSyn#let_app_invariant\")\nmkCoreLet :: CoreBind -> CoreExpr -> CoreExpr\nmkCoreLet (NonRec bndr rhs) body        -- See Note [CoreSyn let/app invariant]\n  = bindNonRec bndr rhs body\nmkCoreLet bind body\n  = Let bind body\n\n-- | Bind a list of binding groups over an expression. The leftmost binding\n-- group becomes the outermost group in the resulting expression\nmkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr\nmkCoreLets binds body = foldr mkCoreLet body binds\n\n-- | Construct an expression which represents the application of one expression\n-- paired with its type to an argument. The result is paired with its type. This\n-- function is not exported and used in the definition of 'mkCoreApp' and\n-- 'mkCoreApps'.\n-- Respects the let/app invariant by building a case expression where necessary\n--   See CoreSyn Note [CoreSyn let/app invariant]\nmkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)\nmkCoreAppTyped _ (fun, fun_ty) (Type ty)\n  = (App fun (Type ty), piResultTy fun_ty ty)\nmkCoreAppTyped _ (fun, fun_ty) (Coercion co)\n  = (App fun (Coercion co), res_ty)\n  where\n    (_, res_ty) = splitFunTy fun_ty\nmkCoreAppTyped d (fun, fun_ty) arg\n  = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg $$ d )\n    (mk_val_app fun arg arg_ty res_ty, res_ty)\n  where\n    (arg_ty, res_ty) = splitFunTy fun_ty\n\n-- | Construct an expression which represents the application of one expression\n-- to the other\n-- Respects the let/app invariant by building a case expression where necessary\n--   See CoreSyn Note [CoreSyn let/app invariant]\nmkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr\nmkCoreApp s fun arg\n  = fst $ mkCoreAppTyped s (fun, exprType fun) arg\n\n-- | Construct an expression which represents the application of a number of\n-- expressions to another. The leftmost expression in the list is applied first\n-- Respects the let/app invariant by building a case expression where necessary\n--   See CoreSyn Note [CoreSyn let/app invariant]\nmkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr\nmkCoreApps fun args\n  = fst $\n    foldl' (mkCoreAppTyped doc_string) (fun, fun_ty) args\n  where\n    doc_string = ppr fun_ty $$ ppr fun $$ ppr args\n    fun_ty = exprType fun\n\n-- | Construct an expression which represents the application of a number of\n-- expressions to that of a data constructor expression. The leftmost expression\n-- in the list is applied first\nmkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr\nmkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args\n\nmk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr\n-- Build an application (e1 e2),\n-- or a strict binding  (case e2 of x -> e1 x)\n-- using the latter when necessary to respect the let/app invariant\n--   See Note [CoreSyn let/app invariant]\nmk_val_app fun arg arg_ty res_ty\n  | not (needsCaseBinding arg_ty arg)\n  = App fun arg                -- The vastly common case\n\n  | otherwise\n  = Case arg arg_id res_ty [(DEFAULT,[],App fun (Var arg_id))]\n  where\n    arg_id = mkWildValBinder arg_ty\n        -- Lots of shadowing, but it doesn't matter,\n        -- because 'fun ' should not have a free wild-id\n        --\n        -- This is Dangerous.  But this is the only place we play this\n        -- game, mk_val_app returns an expression that does not have\n        -- a free wild-id.  So the only thing that can go wrong\n        -- is if you take apart this case expression, and pass a\n        -- fragment of it as the fun part of a 'mk_val_app'.\n\n-----------\nmkWildEvBinder :: PredType -> EvVar\nmkWildEvBinder pred = mkWildValBinder pred\n\n-- | Make a /wildcard binder/. This is typically used when you need a binder\n-- that you expect to use only at a *binding* site.  Do not use it at\n-- occurrence sites because it has a single, fixed unique, and it's very\n-- easy to get into difficulties with shadowing.  That's why it is used so little.\n-- See Note [WildCard binders] in SimplEnv\nmkWildValBinder :: Type -> Id\nmkWildValBinder ty = mkLocalIdOrCoVar wildCardName ty\n\nmkWildCase :: CoreExpr -> Type -> Type -> [CoreAlt] -> CoreExpr\n-- Make a case expression whose case binder is unused\n-- The alts should not have any occurrences of WildId\nmkWildCase scrut scrut_ty res_ty alts\n  = Case scrut (mkWildValBinder scrut_ty) res_ty alts\n\nmkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr\nmkIfThenElse guard then_expr else_expr\n-- Not going to be refining, so okay to take the type of the \"then\" clause\n  = mkWildCase guard boolTy (exprType then_expr)\n         [ (DataAlt falseDataCon, [], else_expr),       -- Increasing order of tag!\n           (DataAlt trueDataCon,  [], then_expr) ]\n\ncastBottomExpr :: CoreExpr -> Type -> CoreExpr\n-- (castBottomExpr e ty), assuming that 'e' diverges,\n-- return an expression of type 'ty'\n-- See Note [Empty case alternatives] in CoreSyn\ncastBottomExpr e res_ty\n  | e_ty `eqType` res_ty = e\n  | otherwise            = Case e (mkWildValBinder e_ty) res_ty []\n  where\n    e_ty = exprType e\n\n{-\nThe functions from this point don't really do anything cleverer than\ntheir counterparts in CoreSyn, but they are here for consistency\n-}\n\n-- | Create a lambda where the given expression has a number of variables\n-- bound over it. The leftmost binder is that bound by the outermost\n-- lambda in the result\nmkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr\nmkCoreLams = mkLams\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Making literals}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Int@\nmkIntExpr :: DynFlags -> Integer -> CoreExpr        -- Result = I# i :: Int\nmkIntExpr dflags i = mkCoreConApps intDataCon  [mkIntLit dflags i]\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Int@\nmkIntExprInt :: DynFlags -> Int -> CoreExpr         -- Result = I# i :: Int\nmkIntExprInt dflags i = mkCoreConApps intDataCon  [mkIntLitInt dflags i]\n\n-- | Create a 'CoreExpr' which will evaluate to the a @Word@ with the given value\nmkWordExpr :: DynFlags -> Integer -> CoreExpr\nmkWordExpr dflags w = mkCoreConApps wordDataCon [mkWordLit dflags w]\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Word@\nmkWordExprWord :: DynFlags -> Word -> CoreExpr\nmkWordExprWord dflags w = mkCoreConApps wordDataCon [mkWordLitWord dflags w]\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Integer@\nmkIntegerExpr  :: MonadThings m => Integer -> m CoreExpr  -- Result :: Integer\nmkIntegerExpr i = do t <- lookupTyCon integerTyConName\n                     return (Lit (mkLitInteger i (mkTyConTy t)))\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Natural@\nmkNaturalExpr  :: MonadThings m => Integer -> m CoreExpr\nmkNaturalExpr i = do t <- lookupTyCon naturalTyConName\n                     return (Lit (mkLitNatural i (mkTyConTy t)))\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Float@\nmkFloatExpr :: Float -> CoreExpr\nmkFloatExpr f = mkCoreConApps floatDataCon [mkFloatLitFloat f]\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Double@\nmkDoubleExpr :: Double -> CoreExpr\nmkDoubleExpr d = mkCoreConApps doubleDataCon [mkDoubleLitDouble d]\n\n\n-- | Create a 'CoreExpr' which will evaluate to the given @Char@\nmkCharExpr     :: Char             -> CoreExpr      -- Result = C# c :: Int\nmkCharExpr c = mkCoreConApps charDataCon [mkCharLit c]\n\n-- | Create a 'CoreExpr' which will evaluate to the given @String@\nmkStringExpr   :: MonadThings m => String     -> m CoreExpr  -- Result :: String\n\n-- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@\nmkStringExprFS :: MonadThings m => FastString -> m CoreExpr  -- Result :: String\n\nmkStringExpr str = mkStringExprFS (mkFastString str)\n\nmkStringExprFS = mkStringExprFSWith lookupId\n\nmkStringExprFSWith :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr\nmkStringExprFSWith lookupM str\n  | nullFS str\n  = return (mkNilExpr charTy)\n\n  | all safeChar chars\n  = do unpack_id <- lookupM unpackCStringName\n       return (App (Var unpack_id) lit)\n\n  | otherwise\n  = do unpack_utf8_id <- lookupM unpackCStringUtf8Name\n       return (App (Var unpack_utf8_id) lit)\n\n  where\n    chars = unpackFS str\n    safeChar c = ord c >= 1 && ord c <= 0x7F\n    lit = Lit (LitString (bytesFS str))\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Tuple constructors}\n*                                                                      *\n************************************************************************\n-}\n\n{-\nCreating tuples and their types for Core expressions\n\n@mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@.\n\n* If it has only one element, it is the identity function.\n\n* If there are more elements than a big tuple can have, it nests\n  the tuples.\n\nNote [Flattening one-tuples]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis family of functions creates a tuple of variables/expressions/types.\n  mkCoreTup [e1,e2,e3] = (e1,e2,e3)\nWhat if there is just one variable/expression/type in the argument?\nWe could do one of two things:\n\n* Flatten it out, so that\n    mkCoreTup [e1] = e1\n\n* Build a one-tuple (see Note [One-tuples] in TysWiredIn)\n    mkCoreTup1 [e1] = Unit e1\n  We use a suffix \"1\" to indicate this.\n\nUsually we want the former, but occasionally the latter.\n-}\n\n-- | Build a small tuple holding the specified variables\n-- One-tuples are flattened; see Note [Flattening one-tuples]\nmkCoreVarTup :: [Id] -> CoreExpr\nmkCoreVarTup ids = mkCoreTup (map Var ids)\n\n-- | Build the type of a small tuple that holds the specified variables\n-- One-tuples are flattened; see Note [Flattening one-tuples]\nmkCoreVarTupTy :: [Id] -> Type\nmkCoreVarTupTy ids = mkBoxedTupleTy (map idType ids)\n\n-- | Build a small tuple holding the specified expressions\n-- One-tuples are flattened; see Note [Flattening one-tuples]\nmkCoreTup :: [CoreExpr] -> CoreExpr\nmkCoreTup []  = Var unitDataConId\nmkCoreTup [c] = c\nmkCoreTup cs  = mkCoreConApps (tupleDataCon Boxed (length cs))\n                              (map (Type . exprType) cs ++ cs)\n\n-- | Build a small unboxed tuple holding the specified expressions,\n-- with the given types. The types must be the types of the expressions.\n-- Do not include the RuntimeRep specifiers; this function calculates them\n-- for you.\n-- Does /not/ flatten one-tuples; see Note [Flattening one-tuples]\nmkCoreUbxTup :: [Type] -> [CoreExpr] -> CoreExpr\nmkCoreUbxTup tys exps\n  = ASSERT( tys `equalLength` exps)\n    mkCoreConApps (tupleDataCon Unboxed (length tys))\n             (map (Type . getRuntimeRep) tys ++ map Type tys ++ exps)\n\n-- | Make a core tuple of the given boxity\nmkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr\nmkCoreTupBoxity Boxed   exps = mkCoreTup exps\nmkCoreTupBoxity Unboxed exps = mkCoreUbxTup (map exprType exps) exps\n\n-- | Build a big tuple holding the specified variables\n-- One-tuples are flattened; see Note [Flattening one-tuples]\nmkBigCoreVarTup :: [Id] -> CoreExpr\nmkBigCoreVarTup ids = mkBigCoreTup (map Var ids)\n\nmkBigCoreVarTup1 :: [Id] -> CoreExpr\n-- Same as mkBigCoreVarTup, but one-tuples are NOT flattened\n--                          see Note [Flattening one-tuples]\nmkBigCoreVarTup1 [id] = mkCoreConApps (tupleDataCon Boxed 1)\n                                      [Type (idType id), Var id]\nmkBigCoreVarTup1 ids  = mkBigCoreTup (map Var ids)\n\n-- | Build the type of a big tuple that holds the specified variables\n-- One-tuples are flattened; see Note [Flattening one-tuples]\nmkBigCoreVarTupTy :: [Id] -> Type\nmkBigCoreVarTupTy ids = mkBigCoreTupTy (map idType ids)\n\n-- | Build a big tuple holding the specified expressions\n-- One-tuples are flattened; see Note [Flattening one-tuples]\nmkBigCoreTup :: [CoreExpr] -> CoreExpr\nmkBigCoreTup = mkChunkified mkCoreTup\n\n-- | Build the type of a big tuple that holds the specified type of thing\n-- One-tuples are flattened; see Note [Flattening one-tuples]\nmkBigCoreTupTy :: [Type] -> Type\nmkBigCoreTupTy = mkChunkified mkBoxedTupleTy\n\n-- | The unit expression\nunitExpr :: CoreExpr\nunitExpr = Var unitDataConId\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Tuple destructors}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Builds a selector which scrutises the given\n-- expression and extracts the one name from the list given.\n-- If you want the no-shadowing rule to apply, the caller\n-- is responsible for making sure that none of these names\n-- are in scope.\n--\n-- If there is just one 'Id' in the tuple, then the selector is\n-- just the identity.\n--\n-- If necessary, we pattern match on a \\\"big\\\" tuple.\nmkTupleSelector, mkTupleSelector1\n    :: [Id]         -- ^ The 'Id's to pattern match the tuple against\n    -> Id           -- ^ The 'Id' to select\n    -> Id           -- ^ A variable of the same type as the scrutinee\n    -> CoreExpr     -- ^ Scrutinee\n    -> CoreExpr     -- ^ Selector expression\n\n-- mkTupleSelector [a,b,c,d] b v e\n--          = case e of v {\n--                (p,q) -> case p of p {\n--                           (a,b) -> b }}\n-- We use 'tpl' vars for the p,q, since shadowing does not matter.\n--\n-- In fact, it's more convenient to generate it innermost first, getting\n--\n--        case (case e of v\n--                (p,q) -> p) of p\n--          (a,b) -> b\nmkTupleSelector vars the_var scrut_var scrut\n  = mk_tup_sel (chunkify vars) the_var\n  where\n    mk_tup_sel [vars] the_var = mkSmallTupleSelector vars the_var scrut_var scrut\n    mk_tup_sel vars_s the_var = mkSmallTupleSelector group the_var tpl_v $\n                                mk_tup_sel (chunkify tpl_vs) tpl_v\n        where\n          tpl_tys = [mkBoxedTupleTy (map idType gp) | gp <- vars_s]\n          tpl_vs  = mkTemplateLocals tpl_tys\n          [(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual \"mkTupleSelector\" tpl_vs vars_s,\n                                         the_var `elem` gp ]\n-- ^ 'mkTupleSelector1' is like 'mkTupleSelector'\n-- but one-tuples are NOT flattened (see Note [Flattening one-tuples])\nmkTupleSelector1 vars the_var scrut_var scrut\n  | [_] <- vars\n  = mkSmallTupleSelector1 vars the_var scrut_var scrut\n  | otherwise\n  = mkTupleSelector vars the_var scrut_var scrut\n\n-- | Like 'mkTupleSelector' but for tuples that are guaranteed\n-- never to be \\\"big\\\".\n--\n-- > mkSmallTupleSelector [x] x v e = [| e |]\n-- > mkSmallTupleSelector [x,y,z] x v e = [| case e of v { (x,y,z) -> x } |]\nmkSmallTupleSelector, mkSmallTupleSelector1\n          :: [Id]        -- The tuple args\n          -> Id          -- The selected one\n          -> Id          -- A variable of the same type as the scrutinee\n          -> CoreExpr    -- Scrutinee\n          -> CoreExpr\nmkSmallTupleSelector [var] should_be_the_same_var _ scrut\n  = ASSERT(var == should_be_the_same_var)\n    scrut  -- Special case for 1-tuples\nmkSmallTupleSelector vars the_var scrut_var scrut\n  = mkSmallTupleSelector1 vars the_var scrut_var scrut\n\n-- ^ 'mkSmallTupleSelector1' is like 'mkSmallTupleSelector'\n-- but one-tuples are NOT flattened (see Note [Flattening one-tuples])\nmkSmallTupleSelector1 vars the_var scrut_var scrut\n  = ASSERT( notNull vars )\n    Case scrut scrut_var (idType the_var)\n         [(DataAlt (tupleDataCon Boxed (length vars)), vars, Var the_var)]\n\n-- | A generalization of 'mkTupleSelector', allowing the body\n-- of the case to be an arbitrary expression.\n--\n-- To avoid shadowing, we use uniques to invent new variables.\n--\n-- If necessary we pattern match on a \\\"big\\\" tuple.\nmkTupleCase :: UniqSupply       -- ^ For inventing names of intermediate variables\n            -> [Id]             -- ^ The tuple identifiers to pattern match on\n            -> CoreExpr         -- ^ Body of the case\n            -> Id               -- ^ A variable of the same type as the scrutinee\n            -> CoreExpr         -- ^ Scrutinee\n            -> CoreExpr\n-- ToDo: eliminate cases where none of the variables are needed.\n--\n--         mkTupleCase uniqs [a,b,c,d] body v e\n--           = case e of v { (p,q) ->\n--             case p of p { (a,b) ->\n--             case q of q { (c,d) ->\n--             body }}}\nmkTupleCase uniqs vars body scrut_var scrut\n  = mk_tuple_case uniqs (chunkify vars) body\n  where\n    -- This is the case where don't need any nesting\n    mk_tuple_case _ [vars] body\n      = mkSmallTupleCase vars body scrut_var scrut\n\n    -- This is the case where we must make nest tuples at least once\n    mk_tuple_case us vars_s body\n      = let (us', vars', body') = foldr one_tuple_case (us, [], body) vars_s\n            in mk_tuple_case us' (chunkify vars') body'\n\n    one_tuple_case chunk_vars (us, vs, body)\n      = let (uniq, us') = takeUniqFromSupply us\n            scrut_var = mkSysLocal (fsLit \"ds\") uniq\n              (mkBoxedTupleTy (map idType chunk_vars))\n            body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)\n        in (us', scrut_var:vs, body')\n\n-- | As 'mkTupleCase', but for a tuple that is small enough to be guaranteed\n-- not to need nesting.\nmkSmallTupleCase\n        :: [Id]         -- ^ The tuple args\n        -> CoreExpr     -- ^ Body of the case\n        -> Id           -- ^ A variable of the same type as the scrutinee\n        -> CoreExpr     -- ^ Scrutinee\n        -> CoreExpr\n\nmkSmallTupleCase [var] body _scrut_var scrut\n  = bindNonRec var scrut body\nmkSmallTupleCase vars body scrut_var scrut\n-- One branch no refinement?\n  = Case scrut scrut_var (exprType body)\n         [(DataAlt (tupleDataCon Boxed (length vars)), vars, body)]\n\n{-\n************************************************************************\n*                                                                      *\n                Floats\n*                                                                      *\n************************************************************************\n-}\n\ndata FloatBind\n  = FloatLet  CoreBind\n  | FloatCase CoreExpr Id AltCon [Var]\n      -- case e of y { C ys -> ... }\n      -- See Note [Floating single-alternative cases] in SetLevels\n\ninstance Outputable FloatBind where\n  ppr (FloatLet b) = text \"LET\" <+> ppr b\n  ppr (FloatCase e b c bs) = hang (text \"CASE\" <+> ppr e <+> ptext (sLit \"of\") <+> ppr b)\n                                2 (ppr c <+> ppr bs)\n\nwrapFloat :: FloatBind -> CoreExpr -> CoreExpr\nwrapFloat (FloatLet defns)       body = Let defns body\nwrapFloat (FloatCase e b con bs) body = Case e b (exprType body) [(con, bs, body)]\n\n-- | Applies the floats from right to left. That is @wrapFloats [b1, b2, \u00e2\u20ac\u00a6, bn]\n-- u = let b1 in let b2 in \u00e2\u20ac\u00a6 in let bn in u@\nwrapFloats :: [FloatBind] -> CoreExpr -> CoreExpr\nwrapFloats floats expr = foldr wrapFloat expr floats\n\nbindBindings :: CoreBind -> [Var]\nbindBindings (NonRec b _) = [b]\nbindBindings (Rec bnds) = map fst bnds\n\nfloatBindings :: FloatBind -> [Var]\nfloatBindings (FloatLet bnd) = bindBindings bnd\nfloatBindings (FloatCase _ b _ bs) = b:bs\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Common list manipulation expressions}\n*                                                                      *\n************************************************************************\n\nCall the constructor Ids when building explicit lists, so that they\ninteract well with rules.\n-}\n\n-- | Makes a list @[]@ for lists of the specified type\nmkNilExpr :: Type -> CoreExpr\nmkNilExpr ty = mkCoreConApps nilDataCon [Type ty]\n\n-- | Makes a list @(:)@ for lists of the specified type\nmkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr\nmkConsExpr ty hd tl = mkCoreConApps consDataCon [Type ty, hd, tl]\n\n-- | Make a list containing the given expressions, where the list has the given type\nmkListExpr :: Type -> [CoreExpr] -> CoreExpr\nmkListExpr ty xs = foldr (mkConsExpr ty) (mkNilExpr ty) xs\n\n-- | Make a fully applied 'foldr' expression\nmkFoldrExpr :: MonadThings m\n            => Type             -- ^ Element type of the list\n            -> Type             -- ^ Fold result type\n            -> CoreExpr         -- ^ \"Cons\" function expression for the fold\n            -> CoreExpr         -- ^ \"Nil\" expression for the fold\n            -> CoreExpr         -- ^ List expression being folded acress\n            -> m CoreExpr\nmkFoldrExpr elt_ty result_ty c n list = do\n    foldr_id <- lookupId foldrName\n    return (Var foldr_id `App` Type elt_ty\n           `App` Type result_ty\n           `App` c\n           `App` n\n           `App` list)\n\n-- | Make a 'build' expression applied to a locally-bound worker function\nmkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m)\n            => Type                                     -- ^ Type of list elements to be built\n            -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's\n                                                        -- of the binders for the build worker function, returns\n                                                        -- the body of that worker\n            -> m CoreExpr\nmkBuildExpr elt_ty mk_build_inside = do\n    [n_tyvar] <- newTyVars [alphaTyVar]\n    let n_ty = mkTyVarTy n_tyvar\n        c_ty = mkVisFunTys [elt_ty, n_ty] n_ty\n    [c, n] <- sequence [mkSysLocalM (fsLit \"c\") c_ty, mkSysLocalM (fsLit \"n\") n_ty]\n\n    build_inside <- mk_build_inside (c, c_ty) (n, n_ty)\n\n    build_id <- lookupId buildName\n    return $ Var build_id `App` Type elt_ty `App` mkLams [n_tyvar, c, n] build_inside\n  where\n    newTyVars tyvar_tmpls = do\n      uniqs <- getUniquesM\n      return (zipWith setTyVarUnique tyvar_tmpls uniqs)\n\n{-\n************************************************************************\n*                                                                      *\n             Manipulating Maybe data type\n*                                                                      *\n************************************************************************\n-}\n\n\n-- | Makes a Nothing for the specified type\nmkNothingExpr :: Type -> CoreExpr\nmkNothingExpr ty = mkConApp nothingDataCon [Type ty]\n\n-- | Makes a Just from a value of the specified type\nmkJustExpr :: Type -> CoreExpr -> CoreExpr\nmkJustExpr ty val = mkConApp justDataCon [Type ty, val]\n\n\n{-\n************************************************************************\n*                                                                      *\n                      Error expressions\n*                                                                      *\n************************************************************************\n-}\n\nmkRuntimeErrorApp\n        :: Id           -- Should be of type (forall a. Addr# -> a)\n                        --      where Addr# points to a UTF8 encoded string\n        -> Type         -- The type to instantiate 'a'\n        -> String       -- The string to print\n        -> CoreExpr\n\nmkRuntimeErrorApp err_id res_ty err_msg\n  = mkApps (Var err_id) [ Type (getRuntimeRep res_ty)\n                        , Type res_ty, err_string ]\n  where\n    err_string = Lit (mkLitString err_msg)\n\nmkImpossibleExpr :: Type -> CoreExpr\nmkImpossibleExpr res_ty\n  = mkRuntimeErrorApp rUNTIME_ERROR_ID res_ty \"Impossible case alternative\"\n\n{-\n************************************************************************\n*                                                                      *\n                     Error Ids\n*                                                                      *\n************************************************************************\n\nGHC randomly injects these into the code.\n\n@patError@ is just a version of @error@ for pattern-matching\nfailures.  It knows various ``codes'' which expand to longer\nstrings---this saves space!\n\n@absentErr@ is a thing we put in for ``absent'' arguments.  They jolly\nwell shouldn't be yanked on, but if one is, then you will get a\nfriendly message from @absentErr@ (rather than a totally random\ncrash).\n\n@parError@ is a special version of @error@ which the compiler does\nnot know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@\ntemplates, but we don't ever expect to generate code for it.\n-}\n\nerrorIds :: [Id]\nerrorIds\n  = [ rUNTIME_ERROR_ID,\n      nON_EXHAUSTIVE_GUARDS_ERROR_ID,\n      nO_METHOD_BINDING_ERROR_ID,\n      pAT_ERROR_ID,\n      rEC_CON_ERROR_ID,\n      rEC_SEL_ERROR_ID,\n      aBSENT_ERROR_ID,\n      tYPE_ERROR_ID   -- Used with Opt_DeferTypeErrors, see #10284\n      ]\n\nrecSelErrorName, runtimeErrorName, absentErrorName :: Name\nrecConErrorName, patErrorName :: Name\nnonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name\ntypeErrorName :: Name\nabsentSumFieldErrorName :: Name\n\nrecSelErrorName     = err_nm \"recSelError\"     recSelErrorIdKey     rEC_SEL_ERROR_ID\nabsentErrorName     = err_nm \"absentError\"     absentErrorIdKey     aBSENT_ERROR_ID\nabsentSumFieldErrorName = err_nm \"absentSumFieldError\"  absentSumFieldErrorIdKey\n                            aBSENT_SUM_FIELD_ERROR_ID\nruntimeErrorName    = err_nm \"runtimeError\"    runtimeErrorIdKey    rUNTIME_ERROR_ID\nrecConErrorName     = err_nm \"recConError\"     recConErrorIdKey     rEC_CON_ERROR_ID\npatErrorName        = err_nm \"patError\"        patErrorIdKey        pAT_ERROR_ID\ntypeErrorName       = err_nm \"typeError\"       typeErrorIdKey       tYPE_ERROR_ID\n\nnoMethodBindingErrorName     = err_nm \"noMethodBindingError\"\n                                  noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID\nnonExhaustiveGuardsErrorName = err_nm \"nonExhaustiveGuardsError\"\n                                  nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID\n\nerr_nm :: String -> Unique -> Id -> Name\nerr_nm str uniq id = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit str) uniq id\n\nrEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, rEC_CON_ERROR_ID :: Id\npAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id\ntYPE_ERROR_ID, aBSENT_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID :: Id\nrEC_SEL_ERROR_ID                = mkRuntimeErrorId recSelErrorName\nrUNTIME_ERROR_ID                = mkRuntimeErrorId runtimeErrorName\nrEC_CON_ERROR_ID                = mkRuntimeErrorId recConErrorName\npAT_ERROR_ID                    = mkRuntimeErrorId patErrorName\nnO_METHOD_BINDING_ERROR_ID      = mkRuntimeErrorId noMethodBindingErrorName\nnON_EXHAUSTIVE_GUARDS_ERROR_ID  = mkRuntimeErrorId nonExhaustiveGuardsErrorName\ntYPE_ERROR_ID                   = mkRuntimeErrorId typeErrorName\n\n-- Note [aBSENT_SUM_FIELD_ERROR_ID]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Absent argument error for unused unboxed sum fields are different than absent\n-- error used in dummy worker functions (see `mkAbsentErrorApp`):\n--\n-- - `absentSumFieldError` can't take arguments because it's used in unarise for\n--   unused pointer fields in unboxed sums, and applying an argument would\n--   require allocating a thunk.\n--\n-- - `absentSumFieldError` can't be CAFFY because that would mean making some\n--   non-CAFFY definitions that use unboxed sums CAFFY in unarise.\n--\n--   To make `absentSumFieldError` non-CAFFY we get a stable pointer to it in\n--   RtsStartup.c and mark it as non-CAFFY here.\n--\n-- Getting this wrong causes hard-to-debug runtime issues, see #15038.\n--\n-- TODO: Remove stable pointer hack after fixing #9718.\n--       However, we should still be careful about not making things CAFFY just\n--       because they use unboxed sums. Unboxed objects are supposed to be\n--       efficient, and none of the other unboxed literals make things CAFFY.\n\naBSENT_SUM_FIELD_ERROR_ID\n  = mkVanillaGlobalWithInfo absentSumFieldErrorName\n      (mkSpecForAllTys [alphaTyVar] (mkTyVarTy alphaTyVar)) -- forall a . a\n      (vanillaIdInfo `setStrictnessInfo` mkClosedStrictSig [] botRes\n                     `setArityInfo` 0\n                     `setCafInfo` NoCafRefs) -- #15038\n\nmkRuntimeErrorId :: Name -> Id\n-- Error function\n--   with type:  forall (r:RuntimeRep) (a:TYPE r). Addr# -> a\n--   with arity: 1\n-- which diverges after being given one argument\n-- The Addr# is expected to be the address of\n--   a UTF8-encoded error string\nmkRuntimeErrorId name\n = mkVanillaGlobalWithInfo name runtimeErrorTy bottoming_info\n where\n    bottoming_info = vanillaIdInfo `setStrictnessInfo`    strict_sig\n                                   `setArityInfo`         1\n                        -- Make arity and strictness agree\n\n        -- Do *not* mark them as NoCafRefs, because they can indeed have\n        -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,\n        -- which has some CAFs\n        -- In due course we may arrange that these error-y things are\n        -- regarded by the GC as permanently live, in which case we\n        -- can give them NoCaf info.  As it is, any function that calls\n        -- any pc_bottoming_Id will itself have CafRefs, which bloats\n        -- SRTs.\n\n    strict_sig = mkClosedStrictSig [evalDmd] botRes\n\nruntimeErrorTy :: Type\n-- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a\n--   See Note [Error and friends have an \"open-tyvar\" forall]\nruntimeErrorTy = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar]\n                                 (mkVisFunTy addrPrimTy openAlphaTy)\n\n{- Note [Error and friends have an \"open-tyvar\" forall]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n'error' and 'undefined' have types\n        error     :: forall (v :: RuntimeRep) (a :: TYPE v). String -> a\n        undefined :: forall (v :: RuntimeRep) (a :: TYPE v). a\nNotice the runtime-representation polymorphism. This ensures that\n\"error\" can be instantiated at unboxed as well as boxed types.\nThis is OK because it never returns, so the return type is irrelevant.\n\n\n************************************************************************\n*                                                                      *\n                     aBSENT_ERROR_ID\n*                                                                      *\n************************************************************************\n\nNote [aBSENT_ERROR_ID]\n~~~~~~~~~~~~~~~~~~~~~~\nWe use aBSENT_ERROR_ID to build dummy values in workers.  E.g.\n\n   f x = (case x of (a,b) -> b) + 1::Int\n\nThe demand analyser figures ot that only the second component of x is\nused, and does a w/w split thus\n\n   f x = case x of (a,b) -> $wf b\n\n   $wf b = let a = absentError \"blah\"\n               x = (a,b)\n           in <the original RHS of f>\n\nAfter some simplification, the (absentError \"blah\") thunk goes away.\n\n------ Tricky wrinkle -------\nTrac #14285 had, roughly\n\n   data T a = MkT a !a\n   {-# INLINABLE f #-}\n   f x = case x of MkT a b -> g (MkT b a)\n\nIt turned out that g didn't use the second component, and hence f doesn't use\nthe first.  But the stable-unfolding for f looks like\n   \\x. case x of MkT a b -> g ($WMkT b a)\nwhere $WMkT is the wrapper for MkT that evaluates its arguments.  We\napply the same w/w split to this unfolding (see Note [Worker-wrapper\nfor INLINEABLE functions] in WorkWrap) so the template ends up like\n   \\b. let a = absentError \"blah\"\n           x = MkT a b\n        in case x of MkT a b -> g ($WMkT b a)\n\nAfter doing case-of-known-constructor, and expanding $WMkT we get\n   \\b -> g (case absentError \"blah\" of a -> MkT b a)\n\nYikes!  That bogusly appears to evaluate the absentError!\n\nThis is extremely tiresome.  Another way to think of this is that, in\nCore, it is an invariant that a strict data contructor, like MkT, must\nbe applied only to an argument in HNF. So (absentError \"blah\") had\nbetter be non-bottom.\n\nSo the \"solution\" is to add a special case for absentError to exprIsHNFlike.\nThis allows Simplify.rebuildCase, in the Note [Case to let transformation]\nbranch, to convert the case on absentError into a let. We also make\nabsentError *not* be diverging, unlike the other error-ids, so that we\ncan be sure not to remove the case branches before converting the case to\na let.\n\nIf, by some bug or bizarre happenstance, we ever call absentError, we should\nthrow an exception.  This should never happen, of course, but we definitely\ncan't return anything.  e.g. if somehow we had\n    case absentError \"foo\" of\n       Nothing -> ...\n       Just x  -> ...\nthen if we return, the case expression will select a field and continue.\nSeg fault city. Better to throw an exception. (Even though we've said\nit is in HNF :-)\n\nIt might seem a bit surprising that seq on absentError is simply erased\n\n    absentError \"foo\" `seq` x ==> x\n\nbut that should be okay; since there's no pattern match we can't really\nbe relying on anything from it.\n-}\n\naBSENT_ERROR_ID\n = mkVanillaGlobalWithInfo absentErrorName absent_ty arity_info\n where\n   absent_ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTy addrPrimTy alphaTy)\n   -- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for\n   -- lifted-type things; see Note [Absent errors] in WwLib\n   arity_info = vanillaIdInfo `setArityInfo` 1\n   -- NB: no bottoming strictness info, unlike other error-ids.\n   -- See Note [aBSENT_ERROR_ID]\n\nmkAbsentErrorApp :: Type         -- The type to instantiate 'a'\n                 -> String       -- The string to print\n                 -> CoreExpr\n\nmkAbsentErrorApp res_ty err_msg\n  = mkApps (Var aBSENT_ERROR_ID) [ Type res_ty, err_string ]\n  where\n    err_string = Lit (mkLitString err_msg)\n", "num_lines": 912}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1996-1998\n\n\nPrinting of Core syntax\n-}\n\n{-# LANGUAGE MultiWayIf #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule PprCore (\n        pprCoreExpr, pprParendExpr,\n        pprCoreBinding, pprCoreBindings, pprCoreAlt,\n        pprCoreBindingWithSize, pprCoreBindingsWithSize,\n        pprRules, pprOptCo\n    ) where\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreStats (exprStats)\nimport Literal( pprLiteral )\nimport Name( pprInfixName, pprPrefixName )\nimport Var\nimport Id\nimport IdInfo\nimport Demand\nimport DataCon\nimport TyCon\nimport Type\nimport Coercion\nimport DynFlags\nimport BasicTypes\nimport Maybes\nimport Util\nimport Outputable\nimport FastString\nimport SrcLoc      ( pprUserRealSpan )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Public interfaces for Core printing (excluding instances)}\n*                                                                      *\n************************************************************************\n\n@pprParendCoreExpr@ puts parens around non-atomic Core expressions.\n-}\n\npprCoreBindings :: OutputableBndr b => [Bind b] -> SDoc\npprCoreBinding  :: OutputableBndr b => Bind b  -> SDoc\npprCoreExpr     :: OutputableBndr b => Expr b  -> SDoc\npprParendExpr   :: OutputableBndr b => Expr b  -> SDoc\n\npprCoreBindings = pprTopBinds noAnn\npprCoreBinding  = pprTopBind noAnn\n\npprCoreBindingsWithSize :: [CoreBind] -> SDoc\npprCoreBindingWithSize  :: CoreBind  -> SDoc\n\npprCoreBindingsWithSize = pprTopBinds sizeAnn\npprCoreBindingWithSize = pprTopBind sizeAnn\n\ninstance OutputableBndr b => Outputable (Bind b) where\n    ppr bind = ppr_bind noAnn bind\n\ninstance OutputableBndr b => Outputable (Expr b) where\n    ppr expr = pprCoreExpr expr\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The guts}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A function to produce an annotation for a given right-hand-side\ntype Annotation b = Expr b -> SDoc\n\n-- | Annotate with the size of the right-hand-side\nsizeAnn :: CoreExpr -> SDoc\nsizeAnn e = text \"-- RHS size:\" <+> ppr (exprStats e)\n\n-- | No annotation\nnoAnn :: Expr b -> SDoc\nnoAnn _ = empty\n\npprTopBinds :: OutputableBndr a\n            => Annotation a -- ^ generate an annotation to place before the\n                            -- binding\n            -> [Bind a]     -- ^ bindings to show\n            -> SDoc         -- ^ the pretty result\npprTopBinds ann binds = vcat (map (pprTopBind ann) binds)\n\npprTopBind :: OutputableBndr a => Annotation a -> Bind a -> SDoc\npprTopBind ann (NonRec binder expr)\n = ppr_binding ann (binder,expr) $$ blankLine\n\npprTopBind _ (Rec [])\n  = text \"Rec { }\"\npprTopBind ann (Rec (b:bs))\n  = vcat [text \"Rec {\",\n          ppr_binding ann b,\n          vcat [blankLine $$ ppr_binding ann b | b <- bs],\n          text \"end Rec }\",\n          blankLine]\n\nppr_bind :: OutputableBndr b => Annotation b -> Bind b -> SDoc\n\nppr_bind ann (NonRec val_bdr expr) = ppr_binding ann (val_bdr, expr)\nppr_bind ann (Rec binds)           = vcat (map pp binds)\n                                    where\n                                      pp bind = ppr_binding ann bind <> semi\n\nppr_binding :: OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc\nppr_binding ann (val_bdr, expr)\n  = sdocWithDynFlags $ \\dflags ->\n      vcat [ ann expr\n           , if gopt Opt_SuppressTypeSignatures dflags\n               then empty\n               else pprBndr LetBind val_bdr\n           , pp_bind\n           ]\n  where\n    pp_bind = case bndrIsJoin_maybe val_bdr of\n                Nothing -> pp_normal_bind\n                Just ar -> pp_join_bind ar\n\n    pp_normal_bind = hang (ppr val_bdr) 2 (equals <+> pprCoreExpr expr)\n\n      -- For a join point of join arity n, we want to print j = \\x1 ... xn -> e\n      -- as \"j x1 ... xn = e\" to differentiate when a join point returns a\n      -- lambda (the first rendering looks like a nullary join point returning\n      -- an n-argument function).\n    pp_join_bind join_arity\n      | bndrs `lengthAtLeast` join_arity\n      = hang (ppr val_bdr <+> sep (map (pprBndr LambdaBind) lhs_bndrs))\n           2 (equals <+> pprCoreExpr rhs)\n      | otherwise -- Yikes!  A join-binding with too few lambda\n                  -- Lint will complain, but we don't want to crash\n                  -- the pretty-printer else we can't see what's wrong\n                  -- So refer to printing  j = e\n      = pp_normal_bind\n      where\n        (bndrs, body) = collectBinders expr\n        lhs_bndrs = take join_arity bndrs\n        rhs       = mkLams (drop join_arity bndrs) body\n\npprParendExpr expr = ppr_expr parens expr\npprCoreExpr   expr = ppr_expr noParens expr\n\nnoParens :: SDoc -> SDoc\nnoParens pp = pp\n\npprOptCo :: Coercion -> SDoc\n-- Print a coercion optionally; i.e. honouring -dsuppress-coercions\npprOptCo co = sdocWithDynFlags $ \\dflags ->\n              if gopt Opt_SuppressCoercions dflags\n              then angleBrackets (text \"Co:\" <> int (coercionSize co))\n              else parens (sep [ppr co, dcolon <+> ppr (coercionType co)])\n\nppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc\n        -- The function adds parens in context that need\n        -- an atomic value (e.g. function args)\n\nppr_expr add_par (Var name)\n | isJoinId name               = add_par ((text \"jump\") <+> ppr name)\n | otherwise                   = ppr name\nppr_expr add_par (Type ty)     = add_par (text \"TYPE:\" <+> ppr ty)       -- Weird\nppr_expr add_par (Coercion co) = add_par (text \"CO:\" <+> ppr co)\nppr_expr add_par (Lit lit)     = pprLiteral add_par lit\n\nppr_expr add_par (Cast expr co)\n  = add_par $ sep [pprParendExpr expr, text \"`cast`\" <+> pprOptCo co]\n\nppr_expr add_par expr@(Lam _ _)\n  = let\n        (bndrs, body) = collectBinders expr\n    in\n    add_par $\n    hang (text \"\\\\\" <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)\n         2 (pprCoreExpr body)\n\nppr_expr add_par expr@(App {})\n  = sdocWithDynFlags $ \\dflags ->\n    case collectArgs expr of { (fun, args) ->\n    let\n        pp_args     = sep (map pprArg args)\n        val_args    = dropWhile isTypeArg args   -- Drop the type arguments for tuples\n        pp_tup_args = pprWithCommas pprCoreExpr val_args\n        args'\n          | gopt Opt_SuppressTypeApplications dflags = val_args\n          | otherwise = args\n        parens\n          | null args' = id\n          | otherwise  = add_par\n    in\n    case fun of\n        Var f -> case isDataConWorkId_maybe f of\n                        -- Notice that we print the *worker*\n                        -- for tuples in paren'd format.\n                   Just dc | saturated\n                           , Just sort <- tyConTuple_maybe tc\n                           -> tupleParens sort pp_tup_args\n                           where\n                             tc        = dataConTyCon dc\n                             saturated = val_args `lengthIs` idArity f\n\n                   _ -> parens (hang fun_doc 2 pp_args)\n                   where\n                     fun_doc | isJoinId f = text \"jump\" <+> ppr f\n                             | otherwise  = ppr f\n\n        _ -> parens (hang (pprParendExpr fun) 2 pp_args)\n    }\n\nppr_expr add_par (Case expr var ty [(con,args,rhs)])\n  = sdocWithDynFlags $ \\dflags ->\n    if gopt Opt_PprCaseAsLet dflags\n    then add_par $  -- See Note [Print case as let]\n         sep [ sep [ text \"let! {\"\n                     <+> ppr_case_pat con args\n                     <+> text \"~\"\n                     <+> ppr_bndr var\n                   , text \"<-\" <+> ppr_expr id expr\n                     <+> text \"} in\" ]\n             , pprCoreExpr rhs\n             ]\n    else add_par $\n         sep [sep [sep [ text \"case\" <+> pprCoreExpr expr\n                       , whenPprDebug (text \"return\" <+> ppr ty)\n                       , text \"of\" <+> ppr_bndr var\n                       ]\n                  , char '{' <+> ppr_case_pat con args <+> arrow\n                  ]\n              , pprCoreExpr rhs\n              , char '}'\n              ]\n  where\n    ppr_bndr = pprBndr CaseBind\n\nppr_expr add_par (Case expr var ty alts)\n  = add_par $\n    sep [sep [text \"case\"\n                <+> pprCoreExpr expr\n                <+> whenPprDebug (text \"return\" <+> ppr ty),\n              text \"of\" <+> ppr_bndr var <+> char '{'],\n         nest 2 (vcat (punctuate semi (map pprCoreAlt alts))),\n         char '}'\n    ]\n  where\n    ppr_bndr = pprBndr CaseBind\n\n\n-- special cases: let ... in let ...\n-- (\"disgusting\" SLPJ)\n\n{-\nppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body)\n  = add_par $\n    vcat [\n      hsep [text \"let {\", (pprBndr LetBind val_bdr $$ ppr val_bndr), equals],\n      nest 2 (pprCoreExpr rhs),\n      text \"} in\",\n      pprCoreExpr body ]\n\nppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))\n  = add_par\n    (hang (text \"let {\")\n          2 (hsep [ppr_binding (val_bdr,rhs),\n                   text \"} in\"])\n     $$\n     pprCoreExpr expr)\n-}\n\n\n-- General case (recursive case, too)\nppr_expr add_par (Let bind expr)\n  = add_par $\n    sep [hang (keyword bind <+> char '{') 2 (ppr_bind noAnn bind <+> text \"} in\"),\n         pprCoreExpr expr]\n  where\n    keyword (NonRec b _)\n     | isJust (bndrIsJoin_maybe b) = text \"join\"\n     | otherwise                   = text \"let\"\n    keyword (Rec pairs)\n     | ((b,_):_) <- pairs\n     , isJust (bndrIsJoin_maybe b) = text \"joinrec\"\n     | otherwise                   = text \"letrec\"\n\nppr_expr add_par (Tick tickish expr)\n  = sdocWithDynFlags $ \\dflags ->\n  if gopt Opt_SuppressTicks dflags\n  then ppr_expr add_par expr\n  else add_par (sep [ppr tickish, pprCoreExpr expr])\n\npprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc\npprCoreAlt (con, args, rhs)\n  = hang (ppr_case_pat con args <+> arrow) 2 (pprCoreExpr rhs)\n\nppr_case_pat :: OutputableBndr a => AltCon -> [a] -> SDoc\nppr_case_pat (DataAlt dc) args\n  | Just sort <- tyConTuple_maybe tc\n  = tupleParens sort (pprWithCommas ppr_bndr args)\n  where\n    ppr_bndr = pprBndr CasePatBind\n    tc = dataConTyCon dc\n\nppr_case_pat con args\n  = ppr con <+> (fsep (map ppr_bndr args))\n  where\n    ppr_bndr = pprBndr CasePatBind\n\n\n-- | Pretty print the argument in a function application.\npprArg :: OutputableBndr a => Expr a -> SDoc\npprArg (Type ty)\n = sdocWithDynFlags $ \\dflags ->\n   if gopt Opt_SuppressTypeApplications dflags\n   then empty\n   else text \"@\" <+> pprParendType ty\npprArg (Coercion co) = text \"@~\" <+> pprOptCo co\npprArg expr          = pprParendExpr expr\n\n{-\nNote [Print case as let]\n~~~~~~~~~~~~~~~~~~~~~~~~\nSingle-branch case expressions are very common:\n   case x of y { I# x' ->\n   case p of q { I# p' -> ... } }\nThese are, in effect, just strict let's, with pattern matching.\nWith -dppr-case-as-let we print them as such:\n   let! { I# x' ~ y <- x } in\n   let! { I# p' ~ q <- p } in ...\n\n\nOther printing bits-and-bobs used with the general @pprCoreBinding@\nand @pprCoreExpr@ functions.\n\n\nNote [Binding-site specific printing]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\npprCoreBinder and pprTypedLamBinder receive a BindingSite argument to adjust\nthe information printed.\n\nLet-bound binders are printed with their full type and idInfo.\n\nCase-bound variables (both the case binder and pattern variables) are printed\nwithout a type and without their unfolding.\n\nFurthermore, a dead case-binder is completely ignored, while otherwise, dead\nbinders are printed as \"_\".\n-}\n\n-- These instances are sadly orphans\n\ninstance OutputableBndr Var where\n  pprBndr = pprCoreBinder\n  pprInfixOcc  = pprInfixName  . varName\n  pprPrefixOcc = pprPrefixName . varName\n  bndrIsJoin_maybe = isJoinId_maybe\n\ninstance Outputable b => OutputableBndr (TaggedBndr b) where\n  pprBndr _    b = ppr b   -- Simple\n  pprInfixOcc  b = ppr b\n  pprPrefixOcc b = ppr b\n  bndrIsJoin_maybe (TB b _) = isJoinId_maybe b\n\npprCoreBinder :: BindingSite -> Var -> SDoc\npprCoreBinder LetBind binder\n  | isTyVar binder = pprKindedTyVarBndr binder\n  | otherwise      = pprTypedLetBinder binder $$\n                     ppIdInfo binder (idInfo binder)\n\n-- Lambda bound type variables are preceded by \"@\"\npprCoreBinder bind_site bndr\n  = getPprStyle $ \\ sty ->\n    pprTypedLamBinder bind_site (debugStyle sty) bndr\n\npprUntypedBinder :: Var -> SDoc\npprUntypedBinder binder\n  | isTyVar binder = text \"@\" <+> ppr binder    -- NB: don't print kind\n  | otherwise      = pprIdBndr binder\n\npprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc\n-- For lambda and case binders, show the unfolding info (usually none)\npprTypedLamBinder bind_site debug_on var\n  = sdocWithDynFlags $ \\dflags ->\n    case () of\n    _\n      | not debug_on            -- Show case-bound wild binders only if debug is on\n      , CaseBind <- bind_site\n      , isDeadBinder var        -> empty\n\n      | not debug_on            -- Even dead binders can be one-shot\n      , isDeadBinder var        -> char '_' <+> ppWhen (isId var)\n                                                (pprIdBndrInfo (idInfo var))\n\n      | not debug_on            -- No parens, no kind info\n      , CaseBind <- bind_site   -> pprUntypedBinder var\n\n      | not debug_on\n      , CasePatBind <- bind_site    -> pprUntypedBinder var\n\n      | suppress_sigs dflags    -> pprUntypedBinder var\n\n      | isTyVar var  -> parens (pprKindedTyVarBndr var)\n\n      | otherwise    -> parens (hang (pprIdBndr var)\n                                   2 (vcat [ dcolon <+> pprType (idType var)\n                                           , pp_unf]))\n  where\n    suppress_sigs = gopt Opt_SuppressTypeSignatures\n\n    unf_info = unfoldingInfo (idInfo var)\n    pp_unf | hasSomeUnfolding unf_info = text \"Unf=\" <> ppr unf_info\n           | otherwise                 = empty\n\npprTypedLetBinder :: Var -> SDoc\n-- Print binder with a type or kind signature (not paren'd)\npprTypedLetBinder binder\n  = sdocWithDynFlags $ \\dflags ->\n    case () of\n    _\n      | isTyVar binder                         -> pprKindedTyVarBndr binder\n      | gopt Opt_SuppressTypeSignatures dflags -> pprIdBndr binder\n      | otherwise                              -> hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))\n\npprKindedTyVarBndr :: TyVar -> SDoc\n-- Print a type variable binder with its kind (but not if *)\npprKindedTyVarBndr tyvar\n  = text \"@\" <+> pprTyVar tyvar\n\n-- pprIdBndr does *not* print the type\n-- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness\npprIdBndr :: Id -> SDoc\npprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)\n\npprIdBndrInfo :: IdInfo -> SDoc\npprIdBndrInfo info\n  = sdocWithDynFlags $ \\dflags ->\n    ppUnless (gopt Opt_SuppressIdInfo dflags) $\n    info `seq` doc -- The seq is useful for poking on black holes\n  where\n    prag_info = inlinePragInfo info\n    occ_info  = occInfo info\n    dmd_info  = demandInfo info\n    lbv_info  = oneShotInfo info\n\n    has_prag  = not (isDefaultInlinePragma prag_info)\n    has_occ   = not (isManyOccs occ_info)\n    has_dmd   = not $ isTopDmd dmd_info\n    has_lbv   = not (hasNoOneShotInfo lbv_info)\n\n    doc = showAttributes\n          [ (has_prag, text \"InlPrag=\" <> pprInlineDebug prag_info)\n          , (has_occ,  text \"Occ=\" <> ppr occ_info)\n          , (has_dmd,  text \"Dmd=\" <> ppr dmd_info)\n          , (has_lbv , text \"OS=\" <> ppr lbv_info)\n          ]\n\n{-\n-----------------------------------------------------\n--      IdDetails and IdInfo\n-----------------------------------------------------\n-}\n\nppIdInfo :: Id -> IdInfo -> SDoc\nppIdInfo id info\n  = sdocWithDynFlags $ \\dflags ->\n    ppUnless (gopt Opt_SuppressIdInfo dflags) $\n    showAttributes\n    [ (True, pp_scope <> ppr (idDetails id))\n    , (has_arity,        text \"Arity=\" <> int arity)\n    , (has_called_arity, text \"CallArity=\" <> int called_arity)\n    , (has_caf_info,     text \"Caf=\" <> ppr caf_info)\n    , (has_str_info,     text \"Str=\" <> pprStrictness str_info)\n    , (has_unf,          text \"Unf=\" <> ppr unf_info)\n    , (not (null rules), text \"RULES:\" <+> vcat (map pprRule rules))\n    ]   -- Inline pragma, occ, demand, one-shot info\n        -- printed out with all binders (when debug is on);\n        -- see PprCore.pprIdBndr\n  where\n    pp_scope | isGlobalId id   = text \"GblId\"\n             | isExportedId id = text \"LclIdX\"\n             | otherwise       = text \"LclId\"\n\n    arity = arityInfo info\n    has_arity = arity /= 0\n\n    called_arity = callArityInfo info\n    has_called_arity = called_arity /= 0\n\n    caf_info = cafInfo info\n    has_caf_info = not (mayHaveCafRefs caf_info)\n\n    str_info = strictnessInfo info\n    has_str_info = not (isTopSig str_info)\n\n    unf_info = unfoldingInfo info\n    has_unf = hasSomeUnfolding unf_info\n\n    rules = ruleInfoRules (ruleInfo info)\n\nshowAttributes :: [(Bool,SDoc)] -> SDoc\nshowAttributes stuff\n  | null docs = empty\n  | otherwise = brackets (sep (punctuate comma docs))\n  where\n    docs = [d | (True,d) <- stuff]\n\n{-\n-----------------------------------------------------\n--      Unfolding and UnfoldingGuidance\n-----------------------------------------------------\n-}\n\ninstance Outputable UnfoldingGuidance where\n    ppr UnfNever  = text \"NEVER\"\n    ppr (UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok })\n      = text \"ALWAYS_IF\" <>\n        parens (text \"arity=\"     <> int arity    <> comma <>\n                text \"unsat_ok=\"  <> ppr unsat_ok <> comma <>\n                text \"boring_ok=\" <> ppr boring_ok)\n    ppr (UnfIfGoodArgs { ug_args = cs, ug_size = size, ug_res = discount })\n      = hsep [ text \"IF_ARGS\",\n               brackets (hsep (map int cs)),\n               int size,\n               int discount ]\n\ninstance Outputable UnfoldingSource where\n  ppr InlineCompulsory  = text \"Compulsory\"\n  ppr InlineStable      = text \"InlineStable\"\n  ppr InlineRhs         = text \"<vanilla>\"\n\ninstance Outputable Unfolding where\n  ppr NoUnfolding                = text \"No unfolding\"\n  ppr BootUnfolding              = text \"No unfolding (from boot)\"\n  ppr (OtherCon cs)              = text \"OtherCon\" <+> ppr cs\n  ppr (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })\n       = hang (text \"DFun:\" <+> ptext (sLit \"\\\\\")\n                <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)\n            2 (ppr con <+> sep (map ppr args))\n  ppr (CoreUnfolding { uf_src = src\n                     , uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf\n                     , uf_is_conlike=conlike, uf_is_work_free=wf\n                     , uf_expandable=exp, uf_guidance=g })\n        = text \"Unf\" <> braces (pp_info $$ pp_rhs)\n    where\n      pp_info = fsep $ punctuate comma\n                [ text \"Src=\"        <> ppr src\n                , text \"TopLvl=\"     <> ppr top\n                , text \"Value=\"      <> ppr hnf\n                , text \"ConLike=\"    <> ppr conlike\n                , text \"WorkFree=\"   <> ppr wf\n                , text \"Expandable=\" <> ppr exp\n                , text \"Guidance=\"   <> ppr g ]\n      pp_tmpl = sdocWithDynFlags $ \\dflags ->\n                ppUnless (gopt Opt_SuppressUnfoldings dflags) $\n                text \"Tmpl=\" <+> ppr rhs\n      pp_rhs | isStableSource src = pp_tmpl\n             | otherwise          = empty\n            -- Don't print the RHS or we get a quadratic\n            -- blowup in the size of the printout!\n\n{-\n-----------------------------------------------------\n--      Rules\n-----------------------------------------------------\n-}\n\ninstance Outputable CoreRule where\n   ppr = pprRule\n\npprRules :: [CoreRule] -> SDoc\npprRules rules = vcat (map pprRule rules)\n\npprRule :: CoreRule -> SDoc\npprRule (BuiltinRule { ru_fn = fn, ru_name = name})\n  = text \"Built in rule for\" <+> ppr fn <> colon <+> doubleQuotes (ftext name)\n\npprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,\n                ru_bndrs = tpl_vars, ru_args = tpl_args,\n                ru_rhs = rhs })\n  = hang (doubleQuotes (ftext name) <+> ppr act)\n       4 (sep [text \"forall\" <+>\n                  sep (map (pprCoreBinder LambdaBind) tpl_vars) <> dot,\n               nest 2 (ppr fn <+> sep (map pprArg tpl_args)),\n               nest 2 (text \"=\" <+> pprCoreExpr rhs)\n            ])\n\n{-\n-----------------------------------------------------\n--      Tickish\n-----------------------------------------------------\n-}\n\ninstance Outputable id => Outputable (Tickish id) where\n  ppr (HpcTick modl ix) =\n      hcat [text \"hpc<\",\n            ppr modl, comma,\n            ppr ix,\n            text \">\"]\n  ppr (Breakpoint ix vars) =\n      hcat [text \"break<\",\n            ppr ix,\n            text \">\",\n            parens (hcat (punctuate comma (map ppr vars)))]\n  ppr (ProfNote { profNoteCC = cc,\n                  profNoteCount = tick,\n                  profNoteScope = scope }) =\n      case (tick,scope) of\n         (True,True)  -> hcat [text \"scctick<\", ppr cc, char '>']\n         (True,False) -> hcat [text \"tick<\",    ppr cc, char '>']\n         _            -> hcat [text \"scc<\",     ppr cc, char '>']\n  ppr (SourceNote span _) =\n      hcat [ text \"src<\", pprUserRealSpan True span, char '>']\n\n", "num_lines": 621}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nAuthor: George Karachalias <george.karachalias@cs.kuleuven.be>\n\nPattern Matching Coverage Checking.\n-}\n\n{-# LANGUAGE CPP, GADTs, DataKinds, KindSignatures #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE ViewPatterns  #-}\n\nmodule Check (\n        -- Checking and printing\n        checkSingle, checkMatches, checkGuardMatches, isAnyPmCheckEnabled,\n\n        -- See Note [Type and Term Equality Propagation]\n        genCaseTmCs1, genCaseTmCs2\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TmOracle\nimport Unify( tcMatchTy )\nimport DynFlags\nimport HsSyn\nimport TcHsSyn\nimport Id\nimport ConLike\nimport Name\nimport FamInstEnv\nimport TysPrim (tYPETyCon)\nimport TysWiredIn\nimport TyCon\nimport SrcLoc\nimport Util\nimport Outputable\nimport FastString\nimport DataCon\nimport PatSyn\nimport HscTypes (CompleteMatch(..))\n\nimport DsMonad\nimport TcSimplify    (tcCheckSatisfiability)\nimport TcType        (isStringTy)\nimport Bag\nimport ErrUtils\nimport Var           (EvVar)\nimport TyCoRep\nimport Type\nimport UniqSupply\nimport DsUtils       (isTrueLHsExpr)\nimport Maybes        (expectJust)\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.List     (find)\nimport Data.Maybe    (catMaybes, isJust, fromMaybe)\nimport Control.Monad (forM, when, forM_, zipWithM)\nimport Coercion\nimport TcEvidence\nimport TcSimplify    (tcNormalise)\nimport IOEnv\nimport qualified Data.Semigroup as Semi\n\nimport ListT (ListT(..), fold, select)\n\n{-\nThis module checks pattern matches for:\n\\begin{enumerate}\n  \\item Equations that are redundant\n  \\item Equations with inaccessible right-hand-side\n  \\item Exhaustiveness\n\\end{enumerate}\n\nThe algorithm is based on the paper:\n\n  \"GADTs Meet Their Match:\n     Pattern-matching Warnings That Account for GADTs, Guards, and Laziness\"\n\n    http://people.cs.kuleuven.be/~george.karachalias/papers/p424-karachalias.pdf\n\n%************************************************************************\n%*                                                                      *\n                     Pattern Match Check Types\n%*                                                                      *\n%************************************************************************\n-}\n\n-- We use the non-determinism monad to apply the algorithm to several\n-- possible sets of constructors. Users can specify complete sets of\n-- constructors by using COMPLETE pragmas.\n-- The algorithm only picks out constructor\n-- sets deep in the bowels which makes a simpler `mapM` more difficult to\n-- implement. The non-determinism is only used in one place, see the ConVar\n-- case in `pmCheckHd`.\n\ntype PmM a = ListT DsM a\n\nliftD :: DsM a -> PmM a\nliftD m = ListT $ \\sk fk -> m >>= \\a -> sk a fk\n\n-- Pick the first match complete covered match or otherwise the \"best\" match.\n-- The best match is the one with the least uncovered clauses, ties broken\n-- by the number of inaccessible clauses followed by number of redundant\n-- clauses.\n--\n-- This is specified in the\n-- \"Disambiguating between multiple ``COMPLETE`` pragmas\" section of the\n-- users' guide. If you update the implementation of this function, make sure\n-- to update that section of the users' guide as well.\ngetResult :: PmM PmResult -> DsM PmResult\ngetResult ls\n  = do { res <- fold ls goM (pure Nothing)\n       ; case res of\n            Nothing -> panic \"getResult is empty\"\n            Just a  -> return a }\n  where\n    goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult)\n    goM mpm dpm = do { pmr <- dpm\n                     ; return $ Just $ go pmr mpm }\n\n    -- Careful not to force unecessary results\n    go :: Maybe PmResult -> PmResult -> PmResult\n    go Nothing rs = rs\n    go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new\n      | null us && null rs && null is = old\n      | otherwise =\n        let PmResult prov' rs' (UncoveredPatterns us') is' = new\n        in case compareLength us us'\n                `mappend` (compareLength is is')\n                `mappend` (compareLength rs rs')\n                `mappend` (compare prov prov') of\n              GT  -> new\n              EQ  -> new\n              LT  -> old\n    go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new\n      = panic \"getResult: No inhabitation candidates\"\n\ndata PatTy = PAT | VA -- Used only as a kind, to index PmPat\n\n-- The *arity* of a PatVec [p1,..,pn] is\n-- the number of p1..pn that are not Guards\n\ndata PmPat :: PatTy -> * where\n  PmCon  :: { pm_con_con     :: ConLike\n            , pm_con_arg_tys :: [Type]\n            , pm_con_tvs     :: [TyVar]\n            , pm_con_dicts   :: [EvVar]\n            , pm_con_args    :: [PmPat t] } -> PmPat t\n            -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs\n  PmVar  :: { pm_var_id   :: Id } -> PmPat t\n  PmLit  :: { pm_lit_lit  :: PmLit } -> PmPat t -- See Note [Literals in PmPat]\n  PmNLit :: { pm_lit_id   :: Id\n            , pm_lit_not  :: [PmLit] } -> PmPat 'VA\n  PmGrd  :: { pm_grd_pv   :: PatVec\n            , pm_grd_expr :: PmExpr  } -> PmPat 'PAT\n\ninstance Outputable (PmPat a) where\n  ppr = pprPmPatDebug\n\n-- data T a where\n--     MkT :: forall p q. (Eq p, Ord q) => p -> q -> T [p]\n-- or  MkT :: forall p q r. (Eq p, Ord q, [p] ~ r) => p -> q -> T r\n\ntype Pattern = PmPat 'PAT -- ^ Patterns\ntype ValAbs  = PmPat 'VA  -- ^ Value Abstractions\n\ntype PatVec = [Pattern]             -- ^ Pattern Vectors\ndata ValVec = ValVec [ValAbs] Delta -- ^ Value Vector Abstractions\n\n-- | Term and type constraints to accompany each value vector abstraction.\n-- For efficiency, we store the term oracle state instead of the term\n-- constraints. TODO: Do the same for the type constraints?\ndata Delta = MkDelta { delta_ty_cs :: Bag EvVar\n                     , delta_tm_cs :: TmState }\n\ntype ValSetAbs = [ValVec]  -- ^ Value Set Abstractions\ntype Uncovered = ValSetAbs\n\n-- Instead of keeping the whole sets in memory, we keep a boolean for both the\n-- covered and the divergent set (we store the uncovered set though, since we\n-- want to print it). For both the covered and the divergent we have:\n--\n--   True <=> The set is non-empty\n--\n-- hence:\n--  C = True             ==> Useful clause (no warning)\n--  C = False, D = True  ==> Clause with inaccessible RHS\n--  C = False, D = False ==> Redundant clause\n\ndata Covered = Covered | NotCovered\n  deriving Show\n\ninstance Outputable Covered where\n  ppr (Covered) = text \"Covered\"\n  ppr (NotCovered) = text \"NotCovered\"\n\n-- Like the or monoid for booleans\n-- Covered = True, Uncovered = False\ninstance Semi.Semigroup Covered where\n  Covered <> _ = Covered\n  _ <> Covered = Covered\n  NotCovered <> NotCovered = NotCovered\n\ninstance Monoid Covered where\n  mempty = NotCovered\n  mappend = (Semi.<>)\n\ndata Diverged = Diverged | NotDiverged\n  deriving Show\n\ninstance Outputable Diverged where\n  ppr Diverged = text \"Diverged\"\n  ppr NotDiverged = text \"NotDiverged\"\n\ninstance Semi.Semigroup Diverged where\n  Diverged <> _ = Diverged\n  _ <> Diverged = Diverged\n  NotDiverged <> NotDiverged = NotDiverged\n\ninstance Monoid Diverged where\n  mempty = NotDiverged\n  mappend = (Semi.<>)\n\n-- | When we learned that a given match group is complete\ndata Provenance =\n                  FromBuiltin -- ^  From the original definition of the type\n                              --    constructor.\n                | FromComplete -- ^ From a user-provided @COMPLETE@ pragma\n  deriving (Show, Eq, Ord)\n\ninstance Outputable Provenance where\n  ppr  = text . show\n\ninstance Semi.Semigroup Provenance where\n  FromComplete <> _ = FromComplete\n  _ <> FromComplete = FromComplete\n  _ <> _ = FromBuiltin\n\ninstance Monoid Provenance where\n  mempty = FromBuiltin\n  mappend = (Semi.<>)\n\ndata PartialResult = PartialResult {\n                        presultProvenance :: Provenance\n                         -- keep track of provenance because we don't want\n                         -- to warn about redundant matches if the result\n                         -- is contaminated with a COMPLETE pragma\n                      , presultCovered :: Covered\n                      , presultUncovered :: Uncovered\n                      , presultDivergent :: Diverged }\n\ninstance Outputable PartialResult where\n  ppr (PartialResult prov c vsa d)\n           = text \"PartialResult\" <+> ppr prov <+> ppr c\n                                  <+> ppr d <+> ppr vsa\n\n\ninstance Semi.Semigroup PartialResult where\n  (PartialResult prov1 cs1 vsa1 ds1)\n    <> (PartialResult prov2 cs2 vsa2 ds2)\n      = PartialResult (prov1 Semi.<> prov2)\n                      (cs1 Semi.<> cs2)\n                      (vsa1 Semi.<> vsa2)\n                      (ds1 Semi.<> ds2)\n\n\ninstance Monoid PartialResult where\n  mempty = PartialResult mempty mempty [] mempty\n  mappend = (Semi.<>)\n\n-- newtype ChoiceOf a = ChoiceOf [a]\n\n-- | Pattern check result\n--\n-- * Redundant clauses\n-- * Not-covered clauses (or their type, if no pattern is available)\n-- * Clauses with inaccessible RHS\n--\n-- More details about the classification of clauses into useful, redundant\n-- and with inaccessible right hand side can be found here:\n--\n--     https://ghc.haskell.org/trac/ghc/wiki/PatternMatchCheck\n--\ndata PmResult =\n  PmResult {\n      pmresultProvenance   :: Provenance\n    , pmresultRedundant    :: [Located [LPat GhcTc]]\n    , pmresultUncovered    :: UncoveredCandidates\n    , pmresultInaccessible :: [Located [LPat GhcTc]] }\n\n-- | Either a list of patterns that are not covered, or their type, in case we\n-- have no patterns at hand. Not having patterns at hand can arise when\n-- handling EmptyCase expressions, in two cases:\n--\n-- * The type of the scrutinee is a trivially inhabited type (like Int or Char)\n-- * The type of the scrutinee cannot be reduced to WHNF.\n--\n-- In both these cases we have no inhabitation candidates for the type at hand,\n-- but we don't want to issue just a wildcard as missing. Instead, we print a\n-- type annotated wildcard, so that the user knows what kind of patterns is\n-- expected (e.g. (_ :: Int), or (_ :: F Int), where F Int does not reduce).\ndata UncoveredCandidates = UncoveredPatterns Uncovered\n                         | TypeOfUncovered Type\n\n-- | The empty pattern check result\nemptyPmResult :: PmResult\nemptyPmResult = PmResult FromBuiltin [] (UncoveredPatterns []) []\n\n-- | Non-exhaustive empty case with unknown/trivial inhabitants\nuncoveredWithTy :: Type -> PmResult\nuncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) []\n\n{-\n%************************************************************************\n%*                                                                      *\n       Entry points to the checker: checkSingle and checkMatches\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | Check a single pattern binding (let)\ncheckSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM ()\ncheckSingle dflags ctxt@(DsMatchContext _ locn) var p = do\n  tracePmD \"checkSingle\" (vcat [ppr ctxt, ppr var, ppr p])\n  mb_pm_res <- tryM (getResult (checkSingle' locn var p))\n  case mb_pm_res of\n    Left  _   -> warnPmIters dflags ctxt\n    Right res -> dsPmWarn dflags ctxt res\n\n-- | Check a single pattern binding (let)\ncheckSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult\ncheckSingle' locn var p = do\n  liftD resetPmIterDs -- set the iter-no to zero\n  fam_insts <- liftD dsGetFamInstEnvs\n  clause    <- liftD $ translatePat fam_insts p\n  missing   <- mkInitialUncovered [var]\n  tracePm \"checkSingle: missing\" (vcat (map pprValVecDebug missing))\n                                 -- no guards\n  PartialResult prov cs us ds <- runMany (pmcheckI clause []) missing\n  let us' = UncoveredPatterns us\n  return $ case (cs,ds) of\n    (Covered,  _    )         -> PmResult prov [] us' [] -- useful\n    (NotCovered, NotDiverged) -> PmResult prov m  us' [] -- redundant\n    (NotCovered, Diverged )   -> PmResult prov [] us' m  -- inaccessible rhs\n  where m = [cL locn [cL locn p]]\n\n-- | Exhaustive for guard matches, is used for guards in pattern bindings and\n-- in @MultiIf@ expressions.\ncheckGuardMatches :: HsMatchContext Name          -- Match context\n                  -> GRHSs GhcTc (LHsExpr GhcTc)  -- Guarded RHSs\n                  -> DsM ()\ncheckGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do\n    dflags <- getDynFlags\n    let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss)\n        dsMatchContext = DsMatchContext hs_ctx combinedLoc\n        match = cL combinedLoc $\n                  Match { m_ext = noExt\n                        , m_ctxt = hs_ctx\n                        , m_pats = []\n                        , m_grhss = guards }\n    checkMatches dflags dsMatchContext [] [match]\ncheckGuardMatches _ (XGRHSs _) = panic \"checkGuardMatches\"\n\n-- | Check a matchgroup (case, functions, etc.)\ncheckMatches :: DynFlags -> DsMatchContext\n             -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM ()\ncheckMatches dflags ctxt vars matches = do\n  tracePmD \"checkMatches\" (hang (vcat [ppr ctxt\n                               , ppr vars\n                               , text \"Matches:\"])\n                               2\n                               (vcat (map ppr matches)))\n  mb_pm_res <- tryM $ getResult $ case matches of\n    -- Check EmptyCase separately\n    -- See Note [Checking EmptyCase Expressions]\n    [] | [var] <- vars -> checkEmptyCase' var\n    _normal_match      -> checkMatches' vars matches\n  case mb_pm_res of\n    Left  _   -> warnPmIters dflags ctxt\n    Right res -> dsPmWarn dflags ctxt res\n\n-- | Check a matchgroup (case, functions, etc.). To be called on a non-empty\n-- list of matches. For empty case expressions, use checkEmptyCase' instead.\ncheckMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult\ncheckMatches' vars matches\n  | null matches = panic \"checkMatches': EmptyCase\"\n  | otherwise = do\n      liftD resetPmIterDs -- set the iter-no to zero\n      missing    <- mkInitialUncovered vars\n      tracePm \"checkMatches': missing\" (vcat (map pprValVecDebug missing))\n      (prov, rs,us,ds) <- go matches missing\n      return $ PmResult {\n                   pmresultProvenance   = prov\n                 , pmresultRedundant    = map hsLMatchToLPats rs\n                 , pmresultUncovered    = UncoveredPatterns us\n                 , pmresultInaccessible = map hsLMatchToLPats ds }\n  where\n    go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered\n       -> PmM (Provenance\n              , [LMatch GhcTc (LHsExpr GhcTc)]\n              , Uncovered\n              , [LMatch GhcTc (LHsExpr GhcTc)])\n    go []     missing = return (mempty, [], missing, [])\n    go (m:ms) missing = do\n      tracePm \"checMatches': go\" (ppr m $$ ppr missing)\n      fam_insts          <- liftD dsGetFamInstEnvs\n      (clause, guards)   <- liftD $ translateMatch fam_insts m\n      r@(PartialResult prov cs missing' ds)\n        <- runMany (pmcheckI clause guards) missing\n      tracePm \"checMatches': go: res\" (ppr r)\n      (ms_prov, rs, final_u, is)  <- go ms missing'\n      let final_prov = prov `mappend` ms_prov\n      return $ case (cs, ds) of\n        -- useful\n        (Covered,  _    )        -> (final_prov,  rs, final_u,   is)\n        -- redundant\n        (NotCovered, NotDiverged) -> (final_prov, m:rs, final_u,is)\n        -- inaccessible\n        (NotCovered, Diverged )   -> (final_prov,  rs, final_u, m:is)\n\n    hsLMatchToLPats :: LMatch id body -> Located [LPat id]\n    hsLMatchToLPats (dL->L l (Match { m_pats = pats })) = cL l pats\n    hsLMatchToLPats _                                   = panic \"checMatches'\"\n\n-- | Check an empty case expression. Since there are no clauses to process, we\n--   only compute the uncovered set. See Note [Checking EmptyCase Expressions]\n--   for details.\ncheckEmptyCase' :: Id -> PmM PmResult\ncheckEmptyCase' var = do\n  tm_ty_css     <- pmInitialTmTyCs\n  mb_candidates <- inhabitationCandidates (delta_ty_cs tm_ty_css) (idType var)\n  case mb_candidates of\n    -- Inhabitation checking failed / the type is trivially inhabited\n    Left ty -> return (uncoveredWithTy ty)\n\n    -- A list of inhabitant candidates is available: Check for each\n    -- one for the satisfiability of the constraints it gives rise to.\n    Right (_, candidates) -> do\n      missing_m <- flip mapMaybeM candidates $\n          \\InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct\n                                , ic_ty_cs = ty_cs\n                                , ic_strict_arg_tys = strict_arg_tys } -> do\n        mb_sat <- pmIsSatisfiable tm_ty_css tm_ct ty_cs strict_arg_tys\n        pure $ fmap (ValVec [va]) mb_sat\n      return $ if null missing_m\n        then emptyPmResult\n        else PmResult FromBuiltin [] (UncoveredPatterns missing_m) []\n\n-- | Returns 'True' if the argument 'Type' is a fully saturated application of\n-- a closed type constructor.\n--\n-- Closed type constructors are those with a fixed right hand side, as\n-- opposed to e.g. associated types. These are of particular interest for\n-- pattern-match coverage checking, because GHC can exhaustively consider all\n-- possible forms that values of a closed type can take on.\n--\n-- Note that this function is intended to be used to check types of value-level\n-- patterns, so as a consequence, the 'Type' supplied as an argument to this\n-- function should be of kind @Type@.\npmIsClosedType :: Type -> Bool\npmIsClosedType ty\n  = case splitTyConApp_maybe ty of\n      Just (tc, ty_args)\n             | is_algebraic_like tc && not (isFamilyTyCon tc)\n             -> ASSERT2( ty_args `lengthIs` tyConArity tc, ppr ty ) True\n      _other -> False\n  where\n    -- This returns True for TyCons which /act like/ algebraic types.\n    -- (See \"Type#type_classification\" for what an algebraic type is.)\n    --\n    -- This is qualified with \\\"like\\\" because of a particular special\n    -- case: TYPE (the underlyind kind behind Type, among others). TYPE\n    -- is conceptually a datatype (and thus algebraic), but in practice it is\n    -- a primitive builtin type, so we must check for it specially.\n    --\n    -- NB: it makes sense to think of TYPE as a closed type in a value-level,\n    -- pattern-matching context. However, at the kind level, TYPE is certainly\n    -- not closed! Since this function is specifically tailored towards pattern\n    -- matching, however, it's OK to label TYPE as closed.\n    is_algebraic_like :: TyCon -> Bool\n    is_algebraic_like tc = isAlgTyCon tc || tc == tYPETyCon\n\npmTopNormaliseType_maybe :: FamInstEnvs -> Bag EvVar -> Type\n                         -> PmM (Maybe (Type, [DataCon], Type))\n-- ^ Get rid of *outermost* (or toplevel)\n--      * type function redex\n--      * data family redex\n--      * newtypes\n--\n-- Behaves exactly like `topNormaliseType_maybe`, but instead of returning a\n-- coercion, it returns useful information for issuing pattern matching\n-- warnings. See Note [Type normalisation for EmptyCase] for details.\n--\n-- NB: Normalisation can potentially change kinds, if the head of the type\n-- is a type family with a variable result kind. I (Richard E) can't think\n-- of a way to cause trouble here, though.\npmTopNormaliseType_maybe env ty_cs typ\n  = do (_, mb_typ') <- liftD $ initTcDsForSolver $ tcNormalise ty_cs typ\n         -- Before proceeding, we chuck typ into the constraint solver, in case\n         -- solving for given equalities may reduce typ some. See\n         -- \"Wrinkle: local equalities\" in\n         -- Note [Type normalisation for EmptyCase].\n       pure $ do typ' <- mb_typ'\n                 ((ty_f,tm_f), ty) <- topNormaliseTypeX stepper comb typ'\n                 -- We need to do topNormaliseTypeX in addition to tcNormalise,\n                 -- since topNormaliseX looks through newtypes, which\n                 -- tcNormalise does not do.\n                 Just (eq_src_ty ty (typ' : ty_f [ty]), tm_f [], ty)\n  where\n    -- Find the first type in the sequence of rewrites that is a data type,\n    -- newtype, or a data family application (not the representation tycon!).\n    -- This is the one that is equal (in source Haskell) to the initial type.\n    -- If none is found in the list, then all of them are type family\n    -- applications, so we simply return the last one, which is the *simplest*.\n    eq_src_ty :: Type -> [Type] -> Type\n    eq_src_ty ty tys = maybe ty id (find is_closed_or_data_family tys)\n\n    is_closed_or_data_family :: Type -> Bool\n    is_closed_or_data_family ty = pmIsClosedType ty || isDataFamilyAppType ty\n\n    -- For efficiency, represent both lists as difference lists.\n    -- comb performs the concatenation, for both lists.\n    comb (tyf1, tmf1) (tyf2, tmf2) = (tyf1 . tyf2, tmf1 . tmf2)\n\n    stepper = newTypeStepper `composeSteppers` tyFamStepper\n\n    -- A 'NormaliseStepper' that unwraps newtypes, careful not to fall into\n    -- a loop. If it would fall into a loop, it produces 'NS_Abort'.\n    newTypeStepper :: NormaliseStepper ([Type] -> [Type],[DataCon] -> [DataCon])\n    newTypeStepper rec_nts tc tys\n      | Just (ty', _co) <- instNewTyCon_maybe tc tys\n      = case checkRecTc rec_nts tc of\n          Just rec_nts' -> let tyf = ((TyConApp tc tys):)\n                               tmf = ((tyConSingleDataCon tc):)\n                           in  NS_Step rec_nts' ty' (tyf, tmf)\n          Nothing       -> NS_Abort\n      | otherwise\n      = NS_Done\n\n    tyFamStepper :: NormaliseStepper ([Type] -> [Type], [DataCon] -> [DataCon])\n    tyFamStepper rec_nts tc tys  -- Try to step a type/data family\n      = let (_args_co, ntys, _res_co) = normaliseTcArgs env Representational tc tys in\n          -- NB: It's OK to use normaliseTcArgs here instead of\n          -- normalise_tc_args (which takes the LiftingContext described\n          -- in Note [Normalising types]) because the reduceTyFamApp below\n          -- works only at top level. We'll never recur in this function\n          -- after reducing the kind of a bound tyvar.\n\n        case reduceTyFamApp_maybe env Representational tc ntys of\n          Just (_co, rhs) -> NS_Step rec_nts rhs ((rhs:), id)\n          _               -> NS_Done\n\n-- | Determine suitable constraints to use at the beginning of pattern-match\n-- coverage checking by consulting the sets of term and type constraints\n-- currently in scope. If one of these sets of constraints is unsatisfiable,\n-- use an empty set in its place. (See\n-- @Note [Recovering from unsatisfiable pattern-matching constraints]@\n-- for why this is done.)\npmInitialTmTyCs :: PmM Delta\npmInitialTmTyCs = do\n  ty_cs  <- liftD getDictsDs\n  tm_cs  <- map toComplex . bagToList <$> liftD getTmCsDs\n  sat_ty <- tyOracle ty_cs\n  let initTyCs = if sat_ty then ty_cs else emptyBag\n      initTmState = fromMaybe initialTmState (tmOracle initialTmState tm_cs)\n  pure $ MkDelta{ delta_tm_cs = initTmState, delta_ty_cs = initTyCs }\n\n{-\nNote [Recovering from unsatisfiable pattern-matching constraints]\n~~~~~~~~~~~~~~~~\nConsider the following code (see #12957 and #15450):\n\n  f :: Int ~ Bool => ()\n  f = case True of { False -> () }\n\nWe want to warn that the pattern-matching in `f` is non-exhaustive. But GHC\nused not to do this; in fact, it would warn that the match was /redundant/!\nThis is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the\ncoverage checker deems any matches with unsatifiable constraint sets to be\nunreachable.\n\nWe decide to better than this. When beginning coverage checking, we first\ncheck if the constraints in scope are unsatisfiable, and if so, we start\nafresh with an empty set of constraints. This way, we'll get the warnings\nthat we expect.\n-}\n\n-- | Given a conlike's term constraints, type constraints, and strict argument\n-- types, check if they are satisfiable.\n-- (In other words, this is the \u00e2\u0160\u00a2_Sat oracle judgment from the GADTs Meet\n-- Their Match paper.)\n--\n-- For the purposes of efficiency, this takes as separate arguments the\n-- ambient term and type constraints (which are known beforehand to be\n-- satisfiable), as well as the new term and type constraints (which may not\n-- be satisfiable). This lets us implement two mini-optimizations:\n--\n-- * If there are no new type constraints, then don't bother initializing\n--   the type oracle, since it's redundant to do so.\n-- * Since the new term constraint is a separate argument, we only need to\n--   execute one iteration of the term oracle (instead of traversing the\n--   entire set of term constraints).\n--\n-- Taking strict argument types into account is something which was not\n-- discussed in GADTs Meet Their Match. For an explanation of what role they\n-- serve, see @Note [Extensions to GADTs Meet Their Match]@.\npmIsSatisfiable\n  :: Delta     -- ^ The ambient term and type constraints\n               --   (known to be satisfiable).\n  -> ComplexEq -- ^ The new term constraint.\n  -> Bag EvVar -- ^ The new type constraints.\n  -> [Type]    -- ^ The strict argument types.\n  -> PmM (Maybe Delta)\n               -- ^ @'Just' delta@ if the constraints (@delta@) are\n               -- satisfiable, and each strict argument type is inhabitable.\n               -- 'Nothing' otherwise.\npmIsSatisfiable amb_cs new_tm_c new_ty_cs strict_arg_tys = do\n  mb_sat <- tmTyCsAreSatisfiable amb_cs new_tm_c new_ty_cs\n  case mb_sat of\n    Nothing -> pure Nothing\n    Just delta -> do\n      -- We know that the term and type constraints are inhabitable, so now\n      -- check if each strict argument type is inhabitable.\n      all_non_void <- checkAllNonVoid initRecTc delta strict_arg_tys\n      pure $ if all_non_void -- Check if each strict argument type\n                             -- is inhabitable\n                then Just delta\n                else Nothing\n\n-- | Like 'pmIsSatisfiable', but only checks if term and type constraints are\n-- satisfiable, and doesn't bother checking anything related to strict argument\n-- types.\ntmTyCsAreSatisfiable\n  :: Delta     -- ^ The ambient term and type constraints\n               --   (known to be satisfiable).\n  -> ComplexEq -- ^ The new term constraint.\n  -> Bag EvVar -- ^ The new type constraints.\n  -> PmM (Maybe Delta)\n       -- ^ @'Just' delta@ if the constraints (@delta@) are\n       -- satisfiable. 'Nothing' otherwise.\ntmTyCsAreSatisfiable\n    (MkDelta{ delta_tm_cs = amb_tm_cs, delta_ty_cs = amb_ty_cs })\n    new_tm_c new_ty_cs = do\n  let ty_cs = new_ty_cs `unionBags` amb_ty_cs\n  sat_ty <- if isEmptyBag new_ty_cs\n               then pure True\n               else tyOracle ty_cs\n  pure $ case (sat_ty, solveOneEq amb_tm_cs new_tm_c) of\n           (True, Just term_cs) -> Just $ MkDelta{ delta_ty_cs = ty_cs\n                                                 , delta_tm_cs = term_cs }\n           _unsat               -> Nothing\n\n-- | Implements two performance optimizations, as described in the\n-- \\\"Strict argument type constraints\\\" section of\n-- @Note [Extensions to GADTs Meet Their Match]@.\ncheckAllNonVoid :: RecTcChecker -> Delta -> [Type] -> PmM Bool\ncheckAllNonVoid rec_ts amb_cs strict_arg_tys = do\n  fam_insts <- liftD dsGetFamInstEnvs\n  let definitely_inhabited =\n        definitelyInhabitedType fam_insts (delta_ty_cs amb_cs)\n  tys_to_check <- filterOutM definitely_inhabited strict_arg_tys\n  let rec_max_bound | tys_to_check `lengthExceeds` 1\n                    = 1\n                    | otherwise\n                    = defaultRecTcMaxBound\n      rec_ts' = setRecTcMaxBound rec_max_bound rec_ts\n  allM (nonVoid rec_ts' amb_cs) tys_to_check\n\n-- | Checks if a strict argument type of a conlike is inhabitable by a\n-- terminating value (i.e, an 'InhabitationCandidate').\n-- See @Note [Extensions to GADTs Meet Their Match]@.\nnonVoid\n  :: RecTcChecker -- ^ The per-'TyCon' recursion depth limit.\n  -> Delta        -- ^ The ambient term/type constraints (known to be\n                  --   satisfiable).\n  -> Type         -- ^ The strict argument type.\n  -> PmM Bool     -- ^ 'True' if the strict argument type might be inhabited by\n                  --   a terminating value (i.e., an 'InhabitationCandidate').\n                  --   'False' if it is definitely uninhabitable by anything\n                  --   (except bottom).\nnonVoid rec_ts amb_cs strict_arg_ty = do\n  mb_cands <- inhabitationCandidates (delta_ty_cs amb_cs) strict_arg_ty\n  case mb_cands of\n    Right (tc, cands)\n      |  Just rec_ts' <- checkRecTc rec_ts tc\n      -> anyM (cand_is_inhabitable rec_ts' amb_cs) cands\n           -- A strict argument type is inhabitable by a terminating value if\n           -- at least one InhabitationCandidate is inhabitable.\n    _ -> pure True\n           -- Either the type is trivially inhabited or we have exceeded the\n           -- recursion depth for some TyCon (so bail out and conservatively\n           -- claim the type is inhabited).\n  where\n    -- Checks if an InhabitationCandidate for a strict argument type:\n    --\n    -- (1) Has satisfiable term and type constraints.\n    -- (2) Has 'nonVoid' strict argument types (we bail out of this\n    --     check if recursion is detected).\n    --\n    -- See Note [Extensions to GADTs Meet Their Match]\n    cand_is_inhabitable :: RecTcChecker -> Delta\n                        -> InhabitationCandidate -> PmM Bool\n    cand_is_inhabitable rec_ts amb_cs\n      (InhabitationCandidate{ ic_tm_ct          = new_term_c\n                            , ic_ty_cs          = new_ty_cs\n                            , ic_strict_arg_tys = new_strict_arg_tys }) = do\n        mb_sat <- tmTyCsAreSatisfiable amb_cs new_term_c new_ty_cs\n        case mb_sat of\n          Nothing -> pure False\n          Just new_delta -> do\n            checkAllNonVoid rec_ts new_delta new_strict_arg_tys\n\n-- | @'definitelyInhabitedType' ty@ returns 'True' if @ty@ has at least one\n-- constructor @C@ such that:\n--\n-- 1. @C@ has no equality constraints.\n-- 2. @C@ has no strict argument types.\n--\n-- See the \\\"Strict argument type constraints\\\" section of\n-- @Note [Extensions to GADTs Meet Their Match]@.\ndefinitelyInhabitedType :: FamInstEnvs -> Bag EvVar -> Type -> PmM Bool\ndefinitelyInhabitedType env ty_cs ty = do\n  mb_res <- pmTopNormaliseType_maybe env ty_cs ty\n  pure $ case mb_res of\n           Just (_, cons, _) -> any meets_criteria cons\n           Nothing           -> False\n  where\n    meets_criteria :: DataCon -> Bool\n    meets_criteria con =\n      null (dataConEqSpec con) && -- (1)\n      null (dataConImplBangs con) -- (2)\n\n{- Note [Type normalisation for EmptyCase]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEmptyCase is an exception for pattern matching, since it is strict. This means\nthat it boils down to checking whether the type of the scrutinee is inhabited.\nFunction pmTopNormaliseType_maybe gets rid of the outermost type function/data\nfamily redex and newtypes, in search of an algebraic type constructor, which is\neasier to check for inhabitation.\n\nIt returns 3 results instead of one, because there are 2 subtle points:\n1. Newtypes are isomorphic to the underlying type in core but not in the source\n   language,\n2. The representational data family tycon is used internally but should not be\n   shown to the user\n\nHence, if pmTopNormaliseType_maybe env ty_cs ty = Just (src_ty, dcs, core_ty),\nthen\n  (a) src_ty is the rewritten type which we can show to the user. That is, the\n      type we get if we rewrite type families but not data families or\n      newtypes.\n  (b) dcs is the list of data constructors \"skipped\", every time we normalise a\n      newtype to its core representation, we keep track of the source data\n      constructor.\n  (c) core_ty is the rewritten type. That is,\n        pmTopNormaliseType_maybe env ty_cs ty = Just (src_ty, dcs, core_ty)\n      implies\n        topNormaliseType_maybe env ty = Just (co, core_ty)\n      for some coercion co.\n\nTo see how all cases come into play, consider the following example:\n\n  data family T a :: *\n  data instance T Int = T1 | T2 Bool\n  -- Which gives rise to FC:\n  --   data T a\n  --   data R:TInt = T1 | T2 Bool\n  --   axiom ax_ti : T Int ~R R:TInt\n\n  newtype G1 = MkG1 (T Int)\n  newtype G2 = MkG2 G1\n\n  type instance F Int  = F Char\n  type instance F Char = G2\n\nIn this case pmTopNormaliseType_maybe env ty_cs (F Int) results in\n\n  Just (G2, [MkG2,MkG1], R:TInt)\n\nWhich means that in source Haskell:\n  - G2 is equivalent to F Int (in contrast, G1 isn't).\n  - if (x : R:TInt) then (MkG2 (MkG1 x) : F Int).\n\n-----\n-- Wrinkle: Local equalities\n-----\n\nGiven the following type family:\n\n  type family F a\n  type instance F Int = Void\n\nShould the following program (from #14813) be considered exhaustive?\n\n  f :: (i ~ Int) => F i -> a\n  f x = case x of {}\n\nYou might think \"of course, since `x` is obviously of type Void\". But the\nidType of `x` is technically F i, not Void, so if we pass F i to\ninhabitationCandidates, we'll mistakenly conclude that `f` is non-exhaustive.\nIn order to avoid this pitfall, we need to normalise the type passed to\npmTopNormaliseType_maybe, using the constraint solver to solve for any local\nequalities (such as i ~ Int) that may be in scope.\n-}\n\n-- | Generate all 'InhabitationCandidate's for a given type. The result is\n-- either @'Left' ty@, if the type cannot be reduced to a closed algebraic type\n-- (or if it's one trivially inhabited, like 'Int'), or @'Right' candidates@,\n-- if it can. In this case, the candidates are the signature of the tycon, each\n-- one accompanied by the term- and type- constraints it gives rise to.\n-- See also Note [Checking EmptyCase Expressions]\ninhabitationCandidates :: Bag EvVar -> Type\n                       -> PmM (Either Type (TyCon, [InhabitationCandidate]))\ninhabitationCandidates ty_cs ty = do\n  fam_insts   <- liftD dsGetFamInstEnvs\n  mb_norm_res <- pmTopNormaliseType_maybe fam_insts ty_cs ty\n  case mb_norm_res of\n    Just (src_ty, dcs, core_ty) -> alts_to_check src_ty core_ty dcs\n    Nothing                     -> alts_to_check ty     ty      []\n  where\n    -- All these types are trivially inhabited\n    trivially_inhabited = [ charTyCon, doubleTyCon, floatTyCon\n                          , intTyCon, wordTyCon, word8TyCon ]\n\n    -- Note: At the moment we leave all the typing and constraint fields of\n    -- PmCon empty, since we know that they are not gonna be used. Is the\n    -- right-thing-to-do to actually create them, even if they are never used?\n    build_tm :: ValAbs -> [DataCon] -> ValAbs\n    build_tm = foldr (\\dc e -> PmCon (RealDataCon dc) [] [] [] [e])\n\n    -- Inhabitation candidates, using the result of pmTopNormaliseType_maybe\n    alts_to_check :: Type -> Type -> [DataCon]\n                  -> PmM (Either Type (TyCon, [InhabitationCandidate]))\n    alts_to_check src_ty core_ty dcs = case splitTyConApp_maybe core_ty of\n      Just (tc, _)\n        |  tc `elem` trivially_inhabited\n        -> case dcs of\n             []    -> return (Left src_ty)\n             (_:_) -> do var <- liftD $ mkPmId core_ty\n                         let va = build_tm (PmVar var) dcs\n                         return $ Right (tc, [InhabitationCandidate\n                           { ic_val_abs = va, ic_tm_ct = mkIdEq var\n                           , ic_ty_cs = emptyBag, ic_strict_arg_tys = [] }])\n\n        |  pmIsClosedType core_ty && not (isAbstractTyCon tc)\n           -- Don't consider abstract tycons since we don't know what their\n           -- constructors are, which makes the results of coverage checking\n           -- them extremely misleading.\n        -> liftD $ do\n             var  <- mkPmId core_ty -- it would be wrong to unify x\n             alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc)\n             return $ Right\n               (tc, [ alt{ic_val_abs = build_tm (ic_val_abs alt) dcs}\n                    | alt <- alts ])\n      -- For other types conservatively assume that they are inhabited.\n      _other -> return (Left src_ty)\n\n{- Note [Checking EmptyCase Expressions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEmpty case expressions are strict on the scrutinee. That is, `case x of {}`\nwill force argument `x`. Hence, `checkMatches` is not sufficient for checking\nempty cases, because it assumes that the match is not strict (which is true\nfor all other cases, apart from EmptyCase). This gave rise to #10746. Instead,\nwe do the following:\n\n1. We normalise the outermost type family redex, data family redex or newtype,\n   using pmTopNormaliseType_maybe (in types/FamInstEnv.hs). This computes 3\n   things:\n   (a) A normalised type src_ty, which is equal to the type of the scrutinee in\n       source Haskell (does not normalise newtypes or data families)\n   (b) The actual normalised type core_ty, which coincides with the result\n       topNormaliseType_maybe. This type is not necessarily equal to the input\n       type in source Haskell. And this is precicely the reason we compute (a)\n       and (c): the reasoning happens with the underlying types, but both the\n       patterns and types we print should respect newtypes and also show the\n       family type constructors and not the representation constructors.\n\n   (c) A list of all newtype data constructors dcs, each one corresponding to a\n       newtype rewrite performed in (b).\n\n   For an example see also Note [Type normalisation for EmptyCase]\n   in types/FamInstEnv.hs.\n\n2. Function checkEmptyCase' performs the check:\n   - If core_ty is not an algebraic type, then we cannot check for\n     inhabitation, so we emit (_ :: src_ty) as missing, conservatively assuming\n     that the type is inhabited.\n   - If core_ty is an algebraic type, then we unfold the scrutinee to all\n     possible constructor patterns, using inhabitationCandidates, and then\n     check each one for constraint satisfiability, same as we for normal\n     pattern match checking.\n\n%************************************************************************\n%*                                                                      *\n              Transform source syntax to *our* syntax\n%*                                                                      *\n%************************************************************************\n-}\n\n-- -----------------------------------------------------------------------\n-- * Utilities\n\nnullaryConPattern :: ConLike -> Pattern\n-- Nullary data constructor and nullary type constructor\nnullaryConPattern con =\n  PmCon { pm_con_con = con, pm_con_arg_tys = []\n        , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = [] }\n{-# INLINE nullaryConPattern #-}\n\ntruePattern :: Pattern\ntruePattern = nullaryConPattern (RealDataCon trueDataCon)\n{-# INLINE truePattern #-}\n\n-- | A fake guard pattern (True <- _) used to represent cases we cannot handle\nfake_pat :: Pattern\nfake_pat = PmGrd { pm_grd_pv   = [truePattern]\n                 , pm_grd_expr = PmExprOther (EWildPat noExt) }\n{-# INLINE fake_pat #-}\n\n-- | Check whether a guard pattern is generated by the checker (unhandled)\nisFakeGuard :: [Pattern] -> PmExpr -> Bool\nisFakeGuard [PmCon { pm_con_con = RealDataCon c }] (PmExprOther (EWildPat _))\n  | c == trueDataCon = True\n  | otherwise        = False\nisFakeGuard _pats _e = False\n\n-- | Generate a `canFail` pattern vector of a specific type\nmkCanFailPmPat :: Type -> DsM PatVec\nmkCanFailPmPat ty = do\n  var <- mkPmVar ty\n  return [var, fake_pat]\n\nvanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern\n-- ADT constructor pattern => no existentials, no local constraints\nvanillaConPattern con arg_tys args =\n  PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys\n        , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = args }\n{-# INLINE vanillaConPattern #-}\n\n-- | Create an empty list pattern of a given type\nnilPattern :: Type -> Pattern\nnilPattern ty =\n  PmCon { pm_con_con = RealDataCon nilDataCon, pm_con_arg_tys = [ty]\n        , pm_con_tvs = [], pm_con_dicts = []\n        , pm_con_args = [] }\n{-# INLINE nilPattern #-}\n\nmkListPatVec :: Type -> PatVec -> PatVec -> PatVec\nmkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon\n                               , pm_con_arg_tys = [ty]\n                               , pm_con_tvs = [], pm_con_dicts = []\n                               , pm_con_args = xs++ys }]\n{-# INLINE mkListPatVec #-}\n\n-- | Create a (non-overloaded) literal pattern\nmkLitPattern :: HsLit GhcTc -> Pattern\nmkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit }\n{-# INLINE mkLitPattern #-}\n\n-- -----------------------------------------------------------------------\n-- * Transform (Pat Id) into of (PmPat Id)\n\ntranslatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec\ntranslatePat fam_insts pat = case pat of\n  WildPat  ty  -> mkPmVars [ty]\n  VarPat _ id  -> return [PmVar (unLoc id)]\n  ParPat _ p   -> translatePat fam_insts (unLoc p)\n  LazyPat _ _  -> mkPmVars [hsPatType pat] -- like a variable\n\n  -- ignore strictness annotations for now\n  BangPat _ p  -> translatePat fam_insts (unLoc p)\n\n  AsPat _ lid p -> do\n     -- Note [Translating As Patterns]\n    ps <- translatePat fam_insts (unLoc p)\n    let [e] = map vaToPmExpr (coercePatVec ps)\n        g   = PmGrd [PmVar (unLoc lid)] e\n    return (ps ++ [g])\n\n  SigPat _ p _ty -> translatePat fam_insts (unLoc p)\n\n  -- See Note [Translate CoPats]\n  CoPat _ wrapper p ty\n    | isIdHsWrapper wrapper                   -> translatePat fam_insts p\n    | WpCast co <-  wrapper, isReflexiveCo co -> translatePat fam_insts p\n    | otherwise -> do\n        ps      <- translatePat fam_insts p\n        (xp,xe) <- mkPmId2Forms ty\n        let g = mkGuard ps (mkHsWrap wrapper (unLoc xe))\n        return [xp,g]\n\n  -- (n + k)  ===>   x (True <- x >= k) (n <- x-k)\n  NPlusKPat ty (dL->L _ _n) _k1 _k2 _ge _minus -> mkCanFailPmPat ty\n\n  -- (fun -> pat)   ===>   x (pat <- fun x)\n  ViewPat arg_ty lexpr lpat -> do\n    ps <- translatePat fam_insts (unLoc lpat)\n    -- See Note [Guards and Approximation]\n    case all cantFailPattern ps of\n      True  -> do\n        (xp,xe) <- mkPmId2Forms arg_ty\n        let g = mkGuard ps (HsApp noExt lexpr xe)\n        return [xp,g]\n      False -> mkCanFailPmPat arg_ty\n\n  -- list\n  ListPat (ListPatTc ty Nothing) ps -> do\n    foldr (mkListPatVec ty) [nilPattern ty]\n      <$> translatePatVec fam_insts (map unLoc ps)\n\n  -- overloaded list\n  ListPat (ListPatTc _elem_ty (Just (pat_ty, _to_list))) lpats -> do\n    dflags <- getDynFlags\n    if xopt LangExt.RebindableSyntax dflags\n       then mkCanFailPmPat pat_ty\n       else case splitListTyConApp_maybe pat_ty of\n              Just e_ty -> translatePat fam_insts\n                                        (ListPat (ListPatTc e_ty Nothing) lpats)\n              Nothing   -> mkCanFailPmPat pat_ty\n    -- (a) In the presence of RebindableSyntax, we don't know anything about\n    --     `toList`, we should treat `ListPat` as any other view pattern.\n    --\n    -- (b) In the absence of RebindableSyntax,\n    --     - If the pat_ty is `[a]`, then we treat the overloaded list pattern\n    --       as ordinary list pattern. Although we can give an instance\n    --       `IsList [Int]` (more specific than the default `IsList [a]`), in\n    --       practice, we almost never do that. We assume the `_to_list` is\n    --       the `toList` from `instance IsList [a]`.\n    --\n    --     - Otherwise, we treat the `ListPat` as ordinary view pattern.\n    --\n    -- See Trac #14547, especially comment#9 and comment#10.\n    --\n    -- Here we construct CanFailPmPat directly, rather can construct a view\n    -- pattern and do further translation as an optimization, for the reason,\n    -- see Note [Guards and Approximation].\n\n  ConPatOut { pat_con     = (dL->L _ con)\n            , pat_arg_tys = arg_tys\n            , pat_tvs     = ex_tvs\n            , pat_dicts   = dicts\n            , pat_args    = ps } -> do\n    groups <- allCompleteMatches con arg_tys\n    case groups of\n      [] -> mkCanFailPmPat (conLikeResTy con arg_tys)\n      _  -> do\n        args <- translateConPatVec fam_insts arg_tys ex_tvs con ps\n        return [PmCon { pm_con_con     = con\n                      , pm_con_arg_tys = arg_tys\n                      , pm_con_tvs     = ex_tvs\n                      , pm_con_dicts   = dicts\n                      , pm_con_args    = args }]\n\n  -- See Note [Translate Overloaded Literal for Exhaustiveness Checking]\n  NPat _ (dL->L _ olit) mb_neg _\n    | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit\n    , isStringTy ty ->\n        foldr (mkListPatVec charTy) [nilPattern charTy] <$>\n          translatePatVec fam_insts\n            (map (LitPat noExt . HsChar src) (unpackFS s))\n    | otherwise -> return [PmLit { pm_lit_lit = PmOLit (isJust mb_neg) olit }]\n\n  -- See Note [Translate Overloaded Literal for Exhaustiveness Checking]\n  LitPat _ lit\n    | HsString src s <- lit ->\n        foldr (mkListPatVec charTy) [nilPattern charTy] <$>\n          translatePatVec fam_insts\n            (map (LitPat noExt . HsChar src) (unpackFS s))\n    | otherwise -> return [mkLitPattern lit]\n\n  TuplePat tys ps boxity -> do\n    tidy_ps <- translatePatVec fam_insts (map unLoc ps)\n    let tuple_con = RealDataCon (tupleDataCon boxity (length ps))\n    return [vanillaConPattern tuple_con tys (concat tidy_ps)]\n\n  SumPat ty p alt arity -> do\n    tidy_p <- translatePat fam_insts (unLoc p)\n    let sum_con = RealDataCon (sumDataCon alt arity)\n    return [vanillaConPattern sum_con ty tidy_p]\n\n  -- --------------------------------------------------------------------------\n  -- Not supposed to happen\n  ConPatIn  {} -> panic \"Check.translatePat: ConPatIn\"\n  SplicePat {} -> panic \"Check.translatePat: SplicePat\"\n  XPat      {} -> panic \"Check.translatePat: XPat\"\n\n{- Note [Translate Overloaded Literal for Exhaustiveness Checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe translation of @NPat@ in exhaustiveness checker is a bit different\nfrom translation in pattern matcher.\n\n  * In pattern matcher (see `tidyNPat' in deSugar/MatchLit.hs), we\n    translate integral literals to HsIntPrim or HsWordPrim and translate\n    overloaded strings to HsString.\n\n  * In exhaustiveness checker, in `genCaseTmCs1/genCaseTmCs2`, we use\n    `lhsExprToPmExpr` to generate uncovered set. In `hsExprToPmExpr`,\n    however we generate `PmOLit` for HsOverLit, rather than refine\n    `HsOverLit` inside `NPat` to HsIntPrim/HsWordPrim. If we do\n    the same thing in `translatePat` as in `tidyNPat`, the exhaustiveness\n    checker will fail to match the literals patterns correctly. See\n    Trac #14546.\n\n  In Note [Undecidable Equality for Overloaded Literals], we say: \"treat\n  overloaded literals that look different as different\", but previously we\n  didn't do such things.\n\n  Now, we translate the literal value to match and the literal patterns\n  consistently:\n\n  * For integral literals, we parse both the integral literal value and\n    the patterns as OverLit HsIntegral. For example:\n\n      case 0::Int of\n          0 -> putStrLn \"A\"\n          1 -> putStrLn \"B\"\n          _ -> putStrLn \"C\"\n\n    When checking the exhaustiveness of pattern matching, we translate the 0\n    in value position as PmOLit, but translate the 0 and 1 in pattern position\n    as PmSLit. The inconsistency leads to the failure of eqPmLit to detect the\n    equality and report warning of \"Pattern match is redundant\" on pattern 0,\n    as reported in Trac #14546. In this patch we remove the specialization of\n    OverLit patterns, and keep the overloaded number literal in pattern as it\n    is to maintain the consistency. We know nothing about the `fromInteger`\n    method (see Note [Undecidable Equality for Overloaded Literals]). Now we\n    can capture the exhaustiveness of pattern 0 and the redundancy of pattern\n    1 and _.\n\n  * For string literals, we parse the string literals as HsString. When\n    OverloadedStrings is enabled, it further be turned as HsOverLit HsIsString.\n    For example:\n\n      case \"foo\" of\n          \"foo\" -> putStrLn \"A\"\n          \"bar\" -> putStrLn \"B\"\n          \"baz\" -> putStrLn \"C\"\n\n    Previously, the overloaded string values are translated to PmOLit and the\n    non-overloaded string values are translated to PmSLit. However the string\n    patterns, both overloaded and non-overloaded, are translated to list of\n    characters. The inconsistency leads to wrong warnings about redundant and\n    non-exhaustive pattern matching warnings, as reported in Trac #14546.\n\n    In order to catch the redundant pattern in following case:\n\n      case \"foo\" of\n          ('f':_) -> putStrLn \"A\"\n          \"bar\" -> putStrLn \"B\"\n\n    in this patch, we translate non-overloaded string literals, both in value\n    position and pattern position, as list of characters. For overloaded string\n    literals, we only translate it to list of characters only when it's type\n    is stringTy, since we know nothing about the toString methods. But we know\n    that if two overloaded strings are syntax equal, then they are equal. Then\n    if it's type is not stringTy, we just translate it to PmOLit. We can still\n    capture the exhaustiveness of pattern \"foo\" and the redundancy of pattern\n    \"bar\" and \"baz\" in the following code:\n\n      {-# LANGUAGE OverloadedStrings #-}\n      main = do\n        case \"foo\" of\n            \"foo\" -> putStrLn \"A\"\n            \"bar\" -> putStrLn \"B\"\n            \"baz\" -> putStrLn \"C\"\n\n  We must ensure that doing the same translation to literal values and patterns\n  in `translatePat` and `hsExprToPmExpr`. The previous inconsistent work led to\n  Trac #14546.\n-}\n\n-- | Translate a list of patterns (Note: each pattern is translated\n-- to a pattern vector but we do not concatenate the results).\ntranslatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec]\ntranslatePatVec fam_insts pats = mapM (translatePat fam_insts) pats\n\n-- | Translate a constructor pattern\ntranslateConPatVec :: FamInstEnvs -> [Type] -> [TyVar]\n                   -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec\ntranslateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps)\n  = concat <$> translatePatVec fam_insts (map unLoc ps)\ntranslateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2)\n  = concat <$> translatePatVec fam_insts (map unLoc [p1,p2])\ntranslateConPatVec fam_insts  univ_tys  ex_tvs c (RecCon (HsRecFields fs _))\n    -- Nothing matched. Make up some fresh term variables\n  | null fs        = mkPmVars arg_tys\n    -- The data constructor was not defined using record syntax. For the\n    -- pattern to be in record syntax it should be empty (e.g. Just {}).\n    -- So just like the previous case.\n  | null orig_lbls = ASSERT(null matched_lbls) mkPmVars arg_tys\n    -- Some of the fields appear, in the original order (there may be holes).\n    -- Generate a simple constructor pattern and make up fresh variables for\n    -- the rest of the fields\n  | matched_lbls `subsetOf` orig_lbls\n  = ASSERT(orig_lbls `equalLength` arg_tys)\n      let translateOne (lbl, ty) = case lookup lbl matched_pats of\n            Just p  -> translatePat fam_insts p\n            Nothing -> mkPmVars [ty]\n      in  concatMapM translateOne (zip orig_lbls arg_tys)\n    -- The fields that appear are not in the correct order. Make up fresh\n    -- variables for all fields and add guards after matching, to force the\n    -- evaluation in the correct order.\n  | otherwise = do\n      arg_var_pats    <- mkPmVars arg_tys\n      translated_pats <- forM matched_pats $ \\(x,pat) -> do\n        pvec <- translatePat fam_insts pat\n        return (x, pvec)\n\n      let zipped = zip orig_lbls [ x | PmVar x <- arg_var_pats ]\n          guards = map (\\(name,pvec) -> case lookup name zipped of\n                            Just x  -> PmGrd pvec (PmExprVar (idName x))\n                            Nothing -> panic \"translateConPatVec: lookup\")\n                       translated_pats\n\n      return (arg_var_pats ++ guards)\n  where\n    -- The actual argument types (instantiated)\n    arg_tys = conLikeInstOrigArgTys c (univ_tys ++ mkTyVarTys ex_tvs)\n\n    -- Some label information\n    orig_lbls    = map flSelector $ conLikeFieldLabels c\n    matched_pats = [ (getName (unLoc (hsRecFieldId x)), unLoc (hsRecFieldArg x))\n                   | (dL->L _ x) <- fs]\n    matched_lbls = [ name | (name, _pat) <- matched_pats ]\n\n    subsetOf :: Eq a => [a] -> [a] -> Bool\n    subsetOf []     _  = True\n    subsetOf (_:_)  [] = False\n    subsetOf (x:xs) (y:ys)\n      | x == y    = subsetOf    xs  ys\n      | otherwise = subsetOf (x:xs) ys\n\n-- Translate a single match\ntranslateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc)\n               -> DsM (PatVec,[PatVec])\ntranslateMatch fam_insts (dL->L _ (Match { m_pats = lpats, m_grhss = grhss })) =\n  do\n  pats'   <- concat <$> translatePatVec fam_insts pats\n  guards' <- mapM (translateGuards fam_insts) guards\n  return (pats', guards')\n  where\n    extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc]\n    extractGuards (dL->L _ (GRHS _ gs _)) = map unLoc gs\n    extractGuards _                       = panic \"translateMatch\"\n\n    pats   = map unLoc lpats\n    guards = map extractGuards (grhssGRHSs grhss)\ntranslateMatch _ _ = panic \"translateMatch\"\n\n-- -----------------------------------------------------------------------\n-- * Transform source guards (GuardStmt Id) to PmPats (Pattern)\n\n-- | Translate a list of guard statements to a pattern vector\ntranslateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec\ntranslateGuards fam_insts guards = do\n  all_guards <- concat <$> mapM (translateGuard fam_insts) guards\n  return (replace_unhandled all_guards)\n  -- It should have been (return all_guards) but it is too expressive.\n  -- Since the term oracle does not handle all constraints we generate,\n  -- we (hackily) replace all constraints the oracle cannot handle with a\n  -- single one (we need to know if there is a possibility of falure).\n  -- See Note [Guards and Approximation] for all guard-related approximations\n  -- we implement.\n  where\n    replace_unhandled :: PatVec -> PatVec\n    replace_unhandled gv\n      | any_unhandled gv = fake_pat : [ p | p <- gv, shouldKeep p ]\n      | otherwise        = gv\n\n    any_unhandled :: PatVec -> Bool\n    any_unhandled gv = any (not . shouldKeep) gv\n\n    shouldKeep :: Pattern -> Bool\n    shouldKeep p\n      | PmVar {} <- p      = True\n      | PmCon {} <- p      = singleConstructor (pm_con_con p)\n                             && all shouldKeep (pm_con_args p)\n    shouldKeep (PmGrd pv e)\n      | all shouldKeep pv  = True\n      | isNotPmExprOther e = True  -- expensive but we want it\n    shouldKeep _other_pat  = False -- let the rest..\n\n-- | Check whether a pattern can fail to match\ncantFailPattern :: Pattern -> Bool\ncantFailPattern p\n  | PmVar {} <- p = True\n  | PmCon {} <- p = singleConstructor (pm_con_con p)\n                    && all cantFailPattern (pm_con_args p)\ncantFailPattern (PmGrd pv _e)\n                  = all cantFailPattern pv\ncantFailPattern _ = False\n\n-- | Translate a guard statement to Pattern\ntranslateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec\ntranslateGuard fam_insts guard = case guard of\n  BodyStmt _   e _ _ -> translateBoolGuard e\n  LetStmt  _   binds -> translateLet (unLoc binds)\n  BindStmt _ p e _ _ -> translateBind fam_insts p e\n  LastStmt        {} -> panic \"translateGuard LastStmt\"\n  ParStmt         {} -> panic \"translateGuard ParStmt\"\n  TransStmt       {} -> panic \"translateGuard TransStmt\"\n  RecStmt         {} -> panic \"translateGuard RecStmt\"\n  ApplicativeStmt {} -> panic \"translateGuard ApplicativeLastStmt\"\n  XStmtLR         {} -> panic \"translateGuard RecStmt\"\n\n-- | Translate let-bindings\ntranslateLet :: HsLocalBinds GhcTc -> DsM PatVec\ntranslateLet _binds = return []\n\n-- | Translate a pattern guard\ntranslateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec\ntranslateBind fam_insts (dL->L _ p) e = do\n  ps <- translatePat fam_insts p\n  return [mkGuard ps (unLoc e)]\n\n-- | Translate a boolean guard\ntranslateBoolGuard :: LHsExpr GhcTc -> DsM PatVec\ntranslateBoolGuard e\n  | isJust (isTrueLHsExpr e) = return []\n    -- The formal thing to do would be to generate (True <- True)\n    -- but it is trivial to solve so instead we give back an empty\n    -- PatVec for efficiency\n  | otherwise = return [mkGuard [truePattern] (unLoc e)]\n\n{- Note [Guards and Approximation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEven if the algorithm is really expressive, the term oracle we use is not.\nHence, several features are not translated *properly* but we approximate.\nThe list includes:\n\n1. View Patterns\n----------------\nA view pattern @(f -> p)@ should be translated to @x (p <- f x)@. The term\noracle does not handle function applications so we know that the generated\nconstraints will not be handled at the end. Hence, we distinguish between two\ncases:\n  a) Pattern @p@ cannot fail. Then this is just a binding and we do the *right\n     thing*.\n  b) Pattern @p@ can fail. This means that when checking the guard, we will\n     generate several cases, with no useful information. E.g.:\n\n       h (f -> [a,b]) = ...\n       h x ([a,b] <- f x) = ...\n\n       uncovered set = { [x |> { False ~ (f x ~ [])            }]\n                       , [x |> { False ~ (f x ~ (t1:[]))       }]\n                       , [x |> { False ~ (f x ~ (t1:t2:t3:t4)) }] }\n\n     So we have two problems:\n       1) Since we do not print the constraints in the general case (they may\n          be too many), the warning will look like this:\n\n            Pattern match(es) are non-exhaustive\n            In an equation for `h':\n                Patterns not matched:\n                    _\n                    _\n                    _\n          Which is not short and not more useful than a single underscore.\n       2) The size of the uncovered set increases a lot, without gaining more\n          expressivity in our warnings.\n\n     Hence, in this case, we replace the guard @([a,b] <- f x)@ with a *dummy*\n     @fake_pat@: @True <- _@. That is, we record that there is a possibility\n     of failure but we minimize it to a True/False. This generates a single\n     warning and much smaller uncovered sets.\n\n2. Overloaded Lists\n-------------------\nAn overloaded list @[...]@ should be translated to @x ([...] <- toList x)@. The\nproblem is exactly like above, as its solution. For future reference, the code\nbelow is the *right thing to do*:\n\n   ListPat (ListPatTc elem_ty (Just (pat_ty, _to_list))) lpats\n     otherwise -> do\n       (xp, xe) <- mkPmId2Forms pat_ty\n       ps       <- translatePatVec (map unLoc lpats)\n       let pats = foldr (mkListPatVec elem_ty) [nilPattern elem_ty] ps\n           g    = mkGuard pats (HsApp (noLoc to_list) xe)\n       return [xp,g]\n\n3. Overloaded Literals\n----------------------\nThe case with literals is a bit different. a literal @l@ should be translated\nto @x (True <- x == from l)@. Since we want to have better warnings for\noverloaded literals as it is a very common feature, we treat them differently.\nThey are mainly covered in Note [Undecidable Equality for Overloaded Literals]\nin PmExpr.\n\n4. N+K Patterns & Pattern Synonyms\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn n+k pattern (n+k) should be translated to @x (True <- x >= k) (n <- x-k)@.\nSince the only pattern of the three that causes failure is guard @(n <- x-k)@,\nand has two possible outcomes. Hence, there is no benefit in using a dummy and\nwe implement the proper thing. Pattern synonyms are simply not implemented yet.\nHence, to be conservative, we generate a dummy pattern, assuming that the\npattern can fail.\n\n5. Actual Guards\n----------------\nDuring translation, boolean guards and pattern guards are translated properly.\nLet bindings though are omitted by function @translateLet@. Since they are lazy\nbindings, we do not actually want to generate a (strict) equality (like we do\nin the pattern bind case). Hence, we safely drop them.\n\nAdditionally, top-level guard translation (performed by @translateGuards@)\nreplaces guards that cannot be reasoned about (like the ones we described in\n1-4) with a single @fake_pat@ to record the possibility of failure to match.\n\nNote [Translate CoPats]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe pattern match checker did not know how to handle coerced patterns `CoPat`\nefficiently, which gave rise to #11276. The original approach translated\n`CoPat`s:\n\n    pat |> co    ===>    x (pat <- (e |> co))\n\nInstead, we now check whether the coercion is a hole or if it is just refl, in\nwhich case we can drop it. Unfortunately, data families generate useful\ncoercions so guards are still generated in these cases and checking data\nfamilies is not really efficient.\n\n%************************************************************************\n%*                                                                      *\n                 Utilities for Pattern Match Checking\n%*                                                                      *\n%************************************************************************\n-}\n\n-- ----------------------------------------------------------------------------\n-- * Basic utilities\n\n-- | Get the type out of a PmPat. For guard patterns (ps <- e) we use the type\n-- of the first (or the single -WHEREVER IT IS- valid to use?) pattern\npmPatType :: PmPat p -> Type\npmPatType (PmCon { pm_con_con = con, pm_con_arg_tys = tys })\n  = conLikeResTy con tys\npmPatType (PmVar  { pm_var_id  = x }) = idType x\npmPatType (PmLit  { pm_lit_lit = l }) = pmLitType l\npmPatType (PmNLit { pm_lit_id  = x }) = idType x\npmPatType (PmGrd  { pm_grd_pv  = pv })\n  = ASSERT(patVecArity pv == 1) (pmPatType p)\n  where Just p = find ((==1) . patternArity) pv\n\n-- | Information about a conlike that is relevant to coverage checking.\n-- It is called an \\\"inhabitation candidate\\\" since it is a value which may\n-- possibly inhabit some type, but only if its term constraint ('ic_tm_ct')\n-- and type constraints ('ic_ty_cs') are permitting, and if all of its strict\n-- argument types ('ic_strict_arg_tys') are inhabitable.\n-- See @Note [Extensions to GADTs Meet Their Match]@.\ndata InhabitationCandidate =\n  InhabitationCandidate\n  { ic_val_abs        :: ValAbs\n  , ic_tm_ct          :: ComplexEq\n  , ic_ty_cs          :: Bag EvVar\n  , ic_strict_arg_tys :: [Type]\n  }\n\n{-\nNote [Extensions to GADTs Meet Their Match]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe GADTs Meet Their Match paper presents the formalism that GHC's coverage\nchecker adheres to. Since the paper's publication, there have been some\nadditional features added to the coverage checker which are not described in\nthe paper. This Note serves as a reference for these new features.\n\n-----\n-- Strict argument type constraints\n-----\n\nIn the ConVar case of clause processing, each conlike K traditionally\ngenerates two different forms of constraints:\n\n* A term constraint (e.g., x ~ K y1 ... yn)\n* Type constraints from the conlike's context (e.g., if K has type\n  forall bs. Q => s1 .. sn -> T tys, then Q would be its type constraints)\n\nAs it turns out, these alone are not enough to detect a certain class of\nunreachable code. Consider the following example (adapted from #15305):\n\n  data K = K1 | K2 !Void\n\n  f :: K -> ()\n  f K1 = ()\n\nEven though `f` doesn't match on `K2`, `f` is exhaustive in its patterns. Why?\nBecause it's impossible to construct a terminating value of type `K` using the\n`K2` constructor, and thus it's impossible for `f` to ever successfully match\non `K2`.\n\nThe reason is because `K2`'s field of type `Void` is //strict//. Because there\nare no terminating values of type `Void`, any attempt to construct something\nusing `K2` will immediately loop infinitely or throw an exception due to the\nstrictness annotation. (If the field were not strict, then `f` could match on,\nsay, `K2 undefined` or `K2 (let x = x in x)`.)\n\nSince neither the term nor type constraints mentioned above take strict\nargument types into account, we make use of the `nonVoid` function to\ndetermine whether a strict type is inhabitable by a terminating value or not.\n\n`nonVoid ty` returns True when either:\n1. `ty` has at least one InhabitationCandidate for which both its term and type\n   constraints are satifiable, and `nonVoid` returns `True` for all of the\n   strict argument types in that InhabitationCandidate.\n2. We're unsure if it's inhabited by a terminating value.\n\n`nonVoid ty` returns False when `ty` is definitely uninhabited by anything\n(except bottom). Some examples:\n\n* `nonVoid Void` returns False, since Void has no InhabitationCandidates.\n  (This is what lets us discard the `K2` constructor in the earlier example.)\n* `nonVoid (Int :~: Int)` returns True, since it has an InhabitationCandidate\n  (through the Refl constructor), and its term constraint (x ~ Refl) and\n  type constraint (Int ~ Int) are satisfiable.\n* `nonVoid (Int :~: Bool)` returns False. Although it has an\n  InhabitationCandidate (by way of Refl), its type constraint (Int ~ Bool) is\n  not satisfiable.\n* Given the following definition of `MyVoid`:\n\n    data MyVoid = MkMyVoid !Void\n\n  `nonVoid MyVoid` returns False. The InhabitationCandidate for the MkMyVoid\n  constructor contains Void as a strict argument type, and since `nonVoid Void`\n  returns False, that InhabitationCandidate is discarded, leaving no others.\n\n* Performance considerations\n\nWe must be careful when recursively calling `nonVoid` on the strict argument\ntypes of an InhabitationCandidate, because doing so na\u00c3\u00afvely can cause GHC to\nfall into an infinite loop. Consider the following example:\n\n  data Abyss = MkAbyss !Abyss\n\n  stareIntoTheAbyss :: Abyss -> a\n  stareIntoTheAbyss x = case x of {}\n\nIn principle, stareIntoTheAbyss is exhaustive, since there is no way to\nconstruct a terminating value using MkAbyss. However, both the term and type\nconstraints for MkAbyss are satisfiable, so the only way one could determine\nthat MkAbyss is unreachable is to check if `nonVoid Abyss` returns False.\nThere is only one InhabitationCandidate for Abyss\u00e2\u20ac\u201dMkAbyss\u00e2\u20ac\u201dand both its term\nand type constraints are satisfiable, so we'd need to check if `nonVoid Abyss`\nreturns False... and now we've entered an infinite loop!\n\nTo avoid this sort of conundrum, `nonVoid` uses a simple test to detect the\npresence of recursive types (through `checkRecTc`), and if recursion is\ndetected, we bail out and conservatively assume that the type is inhabited by\nsome terminating value. This avoids infinite loops at the expense of making\nthe coverage checker incomplete with respect to functions like\nstareIntoTheAbyss above. Then again, the same problem occurs with recursive\nnewtypes, like in the following code:\n\n  newtype Chasm = MkChasm Chasm\n\n  gazeIntoTheChasm :: Chasm -> a\n  gazeIntoTheChasm x = case x of {} -- Erroneously warned as non-exhaustive\n\nSo this limitation is somewhat understandable.\n\nNote that even with this recursion detection, there is still a possibility that\n`nonVoid` can run in exponential time. Consider the following data type:\n\n  data T = MkT !T !T !T\n\nIf we call `nonVoid` on each of its fields, that will require us to once again\ncheck if `MkT` is inhabitable in each of those three fields, which in turn will\nrequire us to check if `MkT` is inhabitable again... As you can see, the\nbranching factor adds up quickly, and if the recursion depth limit is, say,\n100, then `nonVoid T` will effectively take forever.\n\nTo mitigate this, we check the branching factor every time we are about to call\n`nonVoid` on a list of strict argument types. If the branching factor exceeds 1\n(i.e., if there is potential for exponential runtime), then we limit the\nmaximum recursion depth to 1 to mitigate the problem. If the branching factor\nis exactly 1 (i.e., we have a linear chain instead of a tree), then it's okay\nto stick with a larger maximum recursion depth.\n\nAnother microoptimization applies to data types like this one:\n\n  data S a = ![a] !T\n\nEven though there is a strict field of type [a], it's quite silly to call\nnonVoid on it, since it's \"obvious\" that it is inhabitable. To make this\nintuition formal, we say that a type is definitely inhabitable (DI) if:\n\n  * It has at least one constructor C such that:\n    1. C has no equality constraints (since they might be unsatisfiable)\n    2. C has no strict argument types (since they might be uninhabitable)\n\nIt's relatively cheap to cheap if a type is DI, so before we call `nonVoid`\non a list of strict argument types, we filter out all of the DI ones.\n-}\n\ninstance Outputable InhabitationCandidate where\n  ppr (InhabitationCandidate { ic_val_abs = va, ic_tm_ct = tm_ct\n                             , ic_ty_cs = ty_cs\n                             , ic_strict_arg_tys = strict_arg_tys }) =\n    text \"InhabitationCandidate\" <+>\n      vcat [ text \"ic_val_abs        =\" <+> ppr va\n           , text \"ic_tm_ct          =\" <+> ppr tm_ct\n           , text \"ic_ty_cs          =\" <+> ppr ty_cs\n           , text \"ic_strict_arg_tys =\" <+> ppr strict_arg_tys ]\n\n-- | Generate an 'InhabitationCandidate' for a given conlike (generate\n-- fresh variables of the appropriate type for arguments)\nmkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate\n--  *  x :: T tys, where T is an algebraic data type\n--     NB: in the case of a data family, T is the *representation* TyCon\n--     e.g.   data instance T (a,b) = T1 a b\n--       leads to\n--            data TPair a b = T1 a b  -- The \"representation\" type\n--       It is TPair, not T, that is given to mkOneConFull\n--\n--  * 'con' K is a conlike of data type T\n--\n-- After instantiating the universal tyvars of K we get\n--          K tys :: forall bs. Q => s1 .. sn -> T tys\n--\n-- Suppose y1 is a strict field. Then we get\n-- Results: ic_val_abs:        K (y1::s1) .. (yn::sn)\n--          ic_tm_ct:          x ~ K y1..yn\n--          ic_ty_cs:          Q\n--          ic_strict_arg_tys: [s1]\nmkOneConFull x con = do\n  let res_ty  = idType x\n      (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta , arg_tys, con_res_ty)\n        = conLikeFullSig con\n      arg_is_banged = map isBanged $ conLikeImplBangs con\n      tc_args = tyConAppArgs res_ty\n      subst1  = case con of\n                  RealDataCon {} -> zipTvSubst univ_tvs tc_args\n                  PatSynCon {}   -> expectJust \"mkOneConFull\" (tcMatchTy con_res_ty res_ty)\n                                    -- See Note [Pattern synonym result type] in PatSyn\n\n  (subst, ex_tvs') <- cloneTyVarBndrs subst1 ex_tvs <$> getUniqueSupplyM\n\n  let arg_tys' = substTys subst arg_tys\n  -- Fresh term variables (VAs) as arguments to the constructor\n  arguments <-  mapM mkPmVar arg_tys'\n  -- All constraints bound by the constructor (alpha-renamed)\n  let theta_cs = substTheta subst (eqSpecPreds eq_spec ++ thetas)\n  evvars <- mapM (nameType \"pm\") theta_cs\n  let con_abs  = PmCon { pm_con_con     = con\n                       , pm_con_arg_tys = tc_args\n                       , pm_con_tvs     = ex_tvs'\n                       , pm_con_dicts   = evvars\n                       , pm_con_args    = arguments }\n      strict_arg_tys = filterByList arg_is_banged arg_tys'\n  return $ InhabitationCandidate\n           { ic_val_abs        = con_abs\n           , ic_tm_ct          = (PmExprVar (idName x), vaToPmExpr con_abs)\n           , ic_ty_cs          = listToBag evvars\n           , ic_strict_arg_tys = strict_arg_tys\n           }\n\n-- ----------------------------------------------------------------------------\n-- * More smart constructors and fresh variable generation\n\n-- | Create a guard pattern\nmkGuard :: PatVec -> HsExpr GhcTc -> Pattern\nmkGuard pv e\n  | all cantFailPattern pv = PmGrd pv expr\n  | PmExprOther {} <- expr = fake_pat\n  | otherwise              = PmGrd pv expr\n  where\n    expr = hsExprToPmExpr e\n\n-- | Create a term equality of the form: `(False ~ (x ~ lit))`\nmkNegEq :: Id -> PmLit -> ComplexEq\nmkNegEq x l = (falsePmExpr, PmExprVar (idName x) `PmExprEq` PmExprLit l)\n{-# INLINE mkNegEq #-}\n\n-- | Create a term equality of the form: `(x ~ lit)`\nmkPosEq :: Id -> PmLit -> ComplexEq\nmkPosEq x l = (PmExprVar (idName x), PmExprLit l)\n{-# INLINE mkPosEq #-}\n\n-- | Create a term equality of the form: `(x ~ x)`\n-- (always discharged by the term oracle)\nmkIdEq :: Id -> ComplexEq\nmkIdEq x = (PmExprVar name, PmExprVar name)\n  where name = idName x\n{-# INLINE mkIdEq #-}\n\n-- | Generate a variable pattern of a given type\nmkPmVar :: Type -> DsM (PmPat p)\nmkPmVar ty = PmVar <$> mkPmId ty\n{-# INLINE mkPmVar #-}\n\n-- | Generate many variable patterns, given a list of types\nmkPmVars :: [Type] -> DsM PatVec\nmkPmVars tys = mapM mkPmVar tys\n{-# INLINE mkPmVars #-}\n\n-- | Generate a fresh `Id` of a given type\nmkPmId :: Type -> DsM Id\nmkPmId ty = getUniqueM >>= \\unique ->\n  let occname = mkVarOccFS $ fsLit \"$pm\"\n      name    = mkInternalName unique occname noSrcSpan\n  in  return (mkLocalId name ty)\n\n-- | Generate a fresh term variable of a given and return it in two forms:\n-- * A variable pattern\n-- * A variable expression\nmkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc)\nmkPmId2Forms ty = do\n  x <- mkPmId ty\n  return (PmVar x, noLoc (HsVar noExt (noLoc x)))\n\n-- ----------------------------------------------------------------------------\n-- * Converting between Value Abstractions, Patterns and PmExpr\n\n-- | Convert a value abstraction an expression\nvaToPmExpr :: ValAbs -> PmExpr\nvaToPmExpr (PmCon  { pm_con_con = c, pm_con_args = ps })\n  = PmExprCon c (map vaToPmExpr ps)\nvaToPmExpr (PmVar  { pm_var_id  = x }) = PmExprVar (idName x)\nvaToPmExpr (PmLit  { pm_lit_lit = l }) = PmExprLit l\nvaToPmExpr (PmNLit { pm_lit_id  = x }) = PmExprVar (idName x)\n\n-- | Convert a pattern vector to a list of value abstractions by dropping the\n-- guards (See Note [Translating As Patterns])\ncoercePatVec :: PatVec -> [ValAbs]\ncoercePatVec pv = concatMap coercePmPat pv\n\n-- | Convert a pattern to a list of value abstractions (will be either an empty\n-- list if the pattern is a guard pattern, or a singleton list in all other\n-- cases) by dropping the guards (See Note [Translating As Patterns])\ncoercePmPat :: Pattern -> [ValAbs]\ncoercePmPat (PmVar { pm_var_id  = x }) = [PmVar { pm_var_id  = x }]\ncoercePmPat (PmLit { pm_lit_lit = l }) = [PmLit { pm_lit_lit = l }]\ncoercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys\n                   , pm_con_tvs = tvs, pm_con_dicts = dicts\n                   , pm_con_args = args })\n  = [PmCon { pm_con_con  = con, pm_con_arg_tys = arg_tys\n           , pm_con_tvs  = tvs, pm_con_dicts = dicts\n           , pm_con_args = coercePatVec args }]\ncoercePmPat (PmGrd {}) = [] -- drop the guards\n\n-- | Check whether a data constructor is the only way to construct\n-- a data type.\nsingleConstructor :: ConLike -> Bool\nsingleConstructor (RealDataCon dc) =\n  case tyConDataCons (dataConTyCon dc) of\n    [_] -> True\n    _   -> False\nsingleConstructor _ = False\n\n-- | For a given conlike, finds all the sets of patterns which could\n-- be relevant to that conlike by consulting the result type.\n--\n-- These come from two places.\n--  1. From data constructors defined with the result type constructor.\n--  2. From `COMPLETE` pragmas which have the same type as the result\n--     type constructor. Note that we only use `COMPLETE` pragmas\n--     *all* of whose pattern types match. See #14135\nallCompleteMatches :: ConLike -> [Type] -> DsM [(Provenance, [ConLike])]\nallCompleteMatches cl tys = do\n  let fam = case cl of\n           RealDataCon dc ->\n            [(FromBuiltin, map RealDataCon (tyConDataCons (dataConTyCon dc)))]\n           PatSynCon _    -> []\n      ty  = conLikeResTy cl tys\n  pragmas <- case splitTyConApp_maybe ty of\n               Just (tc, _) -> dsGetCompleteMatches tc\n               Nothing      -> return []\n  let fams cm = (FromComplete,) <$>\n                mapM dsLookupConLike (completeMatchConLikes cm)\n  from_pragma <- filter (\\(_,m) -> isValidCompleteMatch ty m) <$>\n                mapM fams pragmas\n  let final_groups = fam ++ from_pragma\n  return final_groups\n    where\n      -- Check that all the pattern synonym return types in a `COMPLETE`\n      -- pragma subsume the type we're matching.\n      -- See Note [Filtering out non-matching COMPLETE sets]\n      isValidCompleteMatch :: Type -> [ConLike] -> Bool\n      isValidCompleteMatch ty = all go\n        where\n          go (RealDataCon {}) = True\n          go (PatSynCon psc)  = isJust $ flip tcMatchTy ty $ patSynResTy\n                                       $ patSynSig psc\n\n          patSynResTy (_, _, _, _, _, res_ty) = res_ty\n\n{-\nNote [Filtering out non-matching COMPLETE sets]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCurrently, conlikes in a COMPLETE set are simply grouped by the\ntype constructor heading the return type. This is nice and simple, but it does\nmean that there are scenarios when a COMPLETE set might be incompatible with\nthe type of a scrutinee. For instance, consider (from #14135):\n\n  data Foo a = Foo1 a | Foo2 a\n\n  pattern MyFoo2 :: Int -> Foo Int\n  pattern MyFoo2 i = Foo2 i\n\n  {-# COMPLETE Foo1, MyFoo2 #-}\n\n  f :: Foo a -> a\n  f (Foo1 x) = x\n\n`f` has an incomplete pattern-match, so when choosing which constructors to\nreport as unmatched in a warning, GHC must choose between the original set of\ndata constructors {Foo1, Foo2} and the COMPLETE set {Foo1, MyFoo2}. But observe\nthat GHC shouldn't even consider the COMPLETE set as a possibility: the return\ntype of MyFoo2, Foo Int, does not match the type of the scrutinee, Foo a, since\nthere's no substitution `s` such that s(Foo Int) = Foo a.\n\nTo ensure that GHC doesn't pick this COMPLETE set, it checks each pattern\nsynonym constructor's return type matches the type of the scrutinee, and if one\ndoesn't, then we remove the whole COMPLETE set from consideration.\n\nOne might wonder why GHC only checks /pattern synonym/ constructors, and not\n/data/ constructors as well. The reason is because that the type of a\nGADT constructor very well may not match the type of a scrutinee, and that's\nOK. Consider this example (from #14059):\n\n  data SBool (z :: Bool) where\n    SFalse :: SBool False\n    STrue  :: SBool True\n\n  pattern STooGoodToBeTrue :: forall (z :: Bool). ()\n                           => z ~ True\n                           => SBool z\n  pattern STooGoodToBeTrue = STrue\n  {-# COMPLETE SFalse, STooGoodToBeTrue #-}\n\n  wobble :: SBool z -> Bool\n  wobble STooGoodToBeTrue = True\n\nIn the incomplete pattern match for `wobble`, we /do/ want to warn that SFalse\nshould be matched against, even though its type, SBool False, does not match\nthe scrutinee type, SBool z.\n-}\n\n-- -----------------------------------------------------------------------\n-- * Types and constraints\n\nnewEvVar :: Name -> Type -> EvVar\nnewEvVar name ty = mkLocalId name ty\n\nnameType :: String -> Type -> DsM EvVar\nnameType name ty = do\n  unique <- getUniqueM\n  let occname = mkVarOccFS (fsLit (name++\"_\"++show unique))\n      idname  = mkInternalName unique occname noSrcSpan\n  return (newEvVar idname ty)\n\n{-\n%************************************************************************\n%*                                                                      *\n                              The type oracle\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | Check whether a set of type constraints is satisfiable.\ntyOracle :: Bag EvVar -> PmM Bool\ntyOracle evs\n  = liftD $\n    do { ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability evs\n       ; case res of\n            Just sat -> return sat\n            Nothing  -> pprPanic \"tyOracle\" (vcat $ pprErrMsgBagWithLoc errs) }\n\n{-\n%************************************************************************\n%*                                                                      *\n                             Sanity Checks\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | The arity of a pattern/pattern vector is the\n-- number of top-level patterns that are not guards\ntype PmArity = Int\n\n-- | Compute the arity of a pattern vector\npatVecArity :: PatVec -> PmArity\npatVecArity = sum . map patternArity\n\n-- | Compute the arity of a pattern\npatternArity :: Pattern -> PmArity\npatternArity (PmGrd {}) = 0\npatternArity _other_pat = 1\n\n{-\n%************************************************************************\n%*                                                                      *\n            Heart of the algorithm: Function pmcheck\n%*                                                                      *\n%************************************************************************\n\nMain functions are:\n\n* mkInitialUncovered :: [Id] -> PmM Uncovered\n\n  Generates the initial uncovered set. Term and type constraints in scope\n  are checked, if they are inconsistent, the set is empty, otherwise, the\n  set contains only a vector of variables with the constraints in scope.\n\n* pmcheck :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult\n\n  Checks redundancy, coverage and inaccessibility, using auxilary functions\n  `pmcheckGuards` and `pmcheckHd`. Mainly handles the guard case which is\n  common in all three checks (see paper) and calls `pmcheckGuards` when the\n  whole clause is checked, or `pmcheckHd` when the pattern vector does not\n  start with a guard.\n\n* pmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult\n\n  Processes the guards.\n\n* pmcheckHd :: Pattern -> PatVec -> [PatVec]\n          -> ValAbs -> ValVec -> PmM PartialResult\n\n  Worker: This function implements functions `covered`, `uncovered` and\n  `divergent` from the paper at once. Slightly different from the paper because\n  it does not even produce the covered and uncovered sets. Since we only care\n  about whether a clause covers SOMETHING or if it may forces ANY argument, we\n  only store a boolean in both cases, for efficiency.\n-}\n\n-- | Lift a pattern matching action from a single value vector abstration to a\n-- value set abstraction, but calling it on every vector and the combining the\n-- results.\nrunMany :: (ValVec -> PmM PartialResult) -> (Uncovered -> PmM PartialResult)\nrunMany _ [] = return mempty\nrunMany pm (m:ms) = mappend <$> pm m <*> runMany pm ms\n\n-- | Generate the initial uncovered set. It initializes the\n-- delta with all term and type constraints in scope.\nmkInitialUncovered :: [Id] -> PmM Uncovered\nmkInitialUncovered vars = do\n  delta <- pmInitialTmTyCs\n  let patterns = map PmVar vars\n  return [ValVec patterns delta]\n\n-- | Increase the counter for elapsed algorithm iterations, check that the\n-- limit is not exceeded and call `pmcheck`\npmcheckI :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult\npmcheckI ps guards vva = do\n  n <- liftD incrCheckPmIterDs\n  tracePm \"pmCheck\" (ppr n <> colon <+> pprPatVec ps\n                        $$ hang (text \"guards:\") 2 (vcat (map pprPatVec guards))\n                        $$ pprValVecDebug vva)\n  res <- pmcheck ps guards vva\n  tracePm \"pmCheckResult:\" (ppr res)\n  return res\n{-# INLINE pmcheckI #-}\n\n-- | Increase the counter for elapsed algorithm iterations, check that the\n-- limit is not exceeded and call `pmcheckGuards`\npmcheckGuardsI :: [PatVec] -> ValVec -> PmM PartialResult\npmcheckGuardsI gvs vva = liftD incrCheckPmIterDs >> pmcheckGuards gvs vva\n{-# INLINE pmcheckGuardsI #-}\n\n-- | Increase the counter for elapsed algorithm iterations, check that the\n-- limit is not exceeded and call `pmcheckHd`\npmcheckHdI :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec\n           -> PmM PartialResult\npmcheckHdI p ps guards va vva = do\n  n <- liftD incrCheckPmIterDs\n  tracePm \"pmCheckHdI\" (ppr n <> colon <+> pprPmPatDebug p\n                        $$ pprPatVec ps\n                        $$ hang (text \"guards:\") 2 (vcat (map pprPatVec guards))\n                        $$ pprPmPatDebug va\n                        $$ pprValVecDebug vva)\n\n  res <- pmcheckHd p ps guards va vva\n  tracePm \"pmCheckHdI: res\" (ppr res)\n  return res\n{-# INLINE pmcheckHdI #-}\n\n-- | Matching function: Check simultaneously a clause (takes separately the\n-- patterns and the list of guards) for exhaustiveness, redundancy and\n-- inaccessibility.\npmcheck :: PatVec -> [PatVec] -> ValVec -> PmM PartialResult\npmcheck [] guards vva@(ValVec [] _)\n  | null guards = return $ mempty { presultCovered = Covered }\n  | otherwise   = pmcheckGuardsI guards vva\n\n-- Guard\npmcheck (p@(PmGrd pv e) : ps) guards vva@(ValVec vas delta)\n    -- short-circuit if the guard pattern is useless.\n    -- we just have two possible outcomes: fail here or match and recurse\n    -- none of the two contains any useful information about the failure\n    -- though. So just have these two cases but do not do all the boilerplate\n  | isFakeGuard pv e = forces . mkCons vva <$> pmcheckI ps guards vva\n  | otherwise = do\n      y <- liftD $ mkPmId (pmPatType p)\n      let tm_state = extendSubst y e (delta_tm_cs delta)\n          delta'   = delta { delta_tm_cs = tm_state }\n      utail <$> pmcheckI (pv ++ ps) guards (ValVec (PmVar y : vas) delta')\n\npmcheck [] _ (ValVec (_:_) _) = panic \"pmcheck: nil-cons\"\npmcheck (_:_) _ (ValVec [] _) = panic \"pmcheck: cons-nil\"\n\npmcheck (p:ps) guards (ValVec (va:vva) delta)\n  = pmcheckHdI p ps guards va (ValVec vva delta)\n\n-- | Check the list of guards\npmcheckGuards :: [PatVec] -> ValVec -> PmM PartialResult\npmcheckGuards []       vva = return (usimple [vva])\npmcheckGuards (gv:gvs) vva = do\n  (PartialResult prov1 cs vsa ds) <- pmcheckI gv [] vva\n  (PartialResult prov2 css vsas dss) <- runMany (pmcheckGuardsI gvs) vsa\n  return $ PartialResult (prov1 `mappend` prov2)\n                         (cs `mappend` css)\n                         vsas\n                         (ds `mappend` dss)\n\n-- | Worker function: Implements all cases described in the paper for all three\n-- functions (`covered`, `uncovered` and `divergent`) apart from the `Guard`\n-- cases which are handled by `pmcheck`\npmcheckHd :: Pattern -> PatVec -> [PatVec] -> ValAbs -> ValVec\n          -> PmM PartialResult\n\n-- Var\npmcheckHd (PmVar x) ps guards va (ValVec vva delta)\n  | Just tm_state <- solveOneEq (delta_tm_cs delta)\n                                (PmExprVar (idName x), vaToPmExpr va)\n  = ucon va <$> pmcheckI ps guards (ValVec vva (delta {delta_tm_cs = tm_state}))\n  | otherwise = return mempty\n\n-- ConCon\npmcheckHd ( p@(PmCon { pm_con_con = c1, pm_con_tvs = ex_tvs1\n                     , pm_con_args = args1})) ps guards\n          (va@(PmCon { pm_con_con = c2, pm_con_tvs = ex_tvs2\n                     , pm_con_args = args2})) (ValVec vva delta)\n  | c1 /= c2  =\n    return (usimple [ValVec (va:vva) delta])\n  | otherwise = do\n    let to_evvar tv1 tv2 = nameType \"pmConCon\" $\n                           mkPrimEqPred (mkTyVarTy tv1) (mkTyVarTy tv2)\n        mb_to_evvar tv1 tv2\n            -- If we have identical constructors but different existential\n            -- tyvars, then generate extra equality constraints to ensure the\n            -- existential tyvars.\n            -- See Note [Coverage checking and existential tyvars].\n          | tv1 == tv2 = pure Nothing\n          | otherwise  = Just <$> to_evvar tv1 tv2\n    evvars <- (listToBag . catMaybes) <$>\n              ASSERT(ex_tvs1 `equalLength` ex_tvs2)\n              liftD (zipWithM mb_to_evvar ex_tvs1 ex_tvs2)\n    let delta' = delta { delta_ty_cs = evvars `unionBags` delta_ty_cs delta }\n    kcon c1 (pm_con_arg_tys p) (pm_con_tvs p) (pm_con_dicts p)\n      <$> pmcheckI (args1 ++ ps) guards (ValVec (args2 ++ vva) delta')\n\n-- LitLit\npmcheckHd (PmLit l1) ps guards (va@(PmLit l2)) vva =\n  case eqPmLit l1 l2 of\n    True  -> ucon va <$> pmcheckI ps guards vva\n    False -> return $ ucon va (usimple [vva])\n\n-- ConVar\npmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys }))\n          ps guards\n          (PmVar x) (ValVec vva delta) = do\n  (prov, complete_match) <- select =<< liftD (allCompleteMatches con tys)\n\n  cons_cs <- mapM (liftD . mkOneConFull x) complete_match\n\n  inst_vsa <- flip mapMaybeM cons_cs $\n      \\InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct\n                            , ic_ty_cs = ty_cs\n                            , ic_strict_arg_tys = strict_arg_tys } -> do\n    mb_sat <- pmIsSatisfiable delta tm_ct ty_cs strict_arg_tys\n    pure $ fmap (ValVec (va:vva)) mb_sat\n\n  set_provenance prov .\n    force_if (canDiverge (idName x) (delta_tm_cs delta)) <$>\n      runMany (pmcheckI (p:ps) guards) inst_vsa\n\n-- LitVar\npmcheckHd (p@(PmLit l)) ps guards (PmVar x) (ValVec vva delta)\n  = force_if (canDiverge (idName x) (delta_tm_cs delta)) <$>\n      mkUnion non_matched <$>\n        case solveOneEq (delta_tm_cs delta) (mkPosEq x l) of\n          Just tm_state -> pmcheckHdI p ps guards (PmLit l) $\n                             ValVec vva (delta {delta_tm_cs = tm_state})\n          Nothing       -> return mempty\n  where\n    us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l)\n       = [ValVec (PmNLit x [l] : vva) (delta { delta_tm_cs = tm_state })]\n       | otherwise = []\n\n    non_matched = usimple us\n\n-- LitNLit\npmcheckHd (p@(PmLit l)) ps guards\n          (PmNLit { pm_lit_id = x, pm_lit_not = lits }) (ValVec vva delta)\n  | all (not . eqPmLit l) lits\n  , Just tm_state <- solveOneEq (delta_tm_cs delta) (mkPosEq x l)\n    -- Both guards check the same so it would be sufficient to have only\n    -- the second one. Nevertheless, it is much cheaper to check whether\n    -- the literal is in the list so we check it first, to avoid calling\n    -- the term oracle (`solveOneEq`) if possible\n  = mkUnion non_matched <$>\n      pmcheckHdI p ps guards (PmLit l)\n                (ValVec vva (delta { delta_tm_cs = tm_state }))\n  | otherwise = return non_matched\n  where\n    us | Just tm_state <- solveOneEq (delta_tm_cs delta) (mkNegEq x l)\n       = [ValVec (PmNLit x (l:lits) : vva) (delta { delta_tm_cs = tm_state })]\n       | otherwise = []\n\n    non_matched = usimple us\n\n-- ----------------------------------------------------------------------------\n-- The following three can happen only in cases like #322 where constructors\n-- and overloaded literals appear in the same match. The general strategy is\n-- to replace the literal (positive/negative) by a variable and recurse. The\n-- fact that the variable is equal to the literal is recorded in `delta` so\n-- no information is lost\n\n-- LitCon\npmcheckHd (PmLit l) ps guards (va@(PmCon {})) (ValVec vva delta)\n  = do y <- liftD $ mkPmId (pmPatType va)\n       let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta)\n           delta'   = delta { delta_tm_cs = tm_state }\n       pmcheckHdI (PmVar y) ps guards va (ValVec vva delta')\n\n-- ConLit\npmcheckHd (p@(PmCon {})) ps guards (PmLit l) (ValVec vva delta)\n  = do y <- liftD $ mkPmId (pmPatType p)\n       let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta)\n           delta'   = delta { delta_tm_cs = tm_state }\n       pmcheckHdI p ps guards (PmVar y) (ValVec vva delta')\n\n-- ConNLit\npmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva\n  = pmcheckHdI p ps guards (PmVar x) vva\n\n-- Impossible: handled by pmcheck\npmcheckHd (PmGrd {}) _ _ _ _ = panic \"pmcheckHd: Guard\"\n\n{-\nNote [Coverage checking and existential tyvars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC's implementation of the pattern-match coverage algorithm (as described in\nthe GADTs Meet Their Match paper) must take some care to emit enough type\nconstraints when handling data constructors with exisentially quantified type\nvariables. To better explain what the challenge is, consider a constructor K\nof the form:\n\n  K @e_1 ... @e_m ev_1 ... ev_v ty_1 ... ty_n :: T u_1 ... u_p\n\nWhere:\n\n* e_1, ..., e_m are the existentially bound type variables.\n* ev_1, ..., ev_v are evidence variables, which may inhabit a dictionary type\n  (e.g., Eq) or an equality constraint (e.g., e_1 ~ Int).\n* ty_1, ..., ty_n are the types of K's fields.\n* T u_1 ... u_p is the return type, where T is the data type constructor, and\n  u_1, ..., u_p are the universally quantified type variables.\n\nIn the ConVar case, the coverage algorithm will have in hand the constructor\nK as well as a pattern variable (pv :: T PV_1 ... PV_p), where PV_1, ..., PV_p\nare some types that instantiate u_1, ... u_p. The idea is that we should\nsubstitute PV_1 for u_1, ..., and PV_p for u_p when forming a PmCon (the\nmkOneConFull function accomplishes this) and then hand this PmCon off to the\nConCon case.\n\nThe presence of existentially quantified type variables adds a significant\nwrinkle. We always grab e_1, ..., e_m from the definition of K to begin with,\nbut we don't want them to appear in the final PmCon, because then\ncalling (mkOneConFull K) for other pattern variables might reuse the same\nexistential tyvars, which is certainly wrong.\n\nPreviously, GHC's solution to this wrinkle was to always create fresh names\nfor the existential tyvars and put them into the PmCon. This works well for\nmany cases, but it can break down if you nest GADT pattern matches in just\nthe right way. For instance, consider the following program:\n\n    data App f a where\n      App :: f a -> App f (Maybe a)\n\n    data Ty a where\n      TBool :: Ty Bool\n      TInt  :: Ty Int\n\n    data T f a where\n      C :: T Ty (Maybe Bool)\n\n    foo :: T f a -> App f a -> ()\n    foo C (App TBool) = ()\n\nfoo is a total program, but with the previous approach to handling existential\ntyvars, GHC would mark foo's patterns as non-exhaustive.\n\nWhen foo is desugared to Core, it looks roughly like so:\n\n    foo @f @a (C co1 _co2) (App @a1 _co3 (TBool |> co1)) = ()\n\n(Where `a1` is an existential tyvar.)\n\nThat, in turn, is processed by the coverage checker to become:\n\n    foo @f @a (C co1 _co2) (App @a1 _co3 (pmvar123 :: f a1))\n      | TBool <- pmvar123 |> co1\n      = ()\n\nNote that the type of pmvar123 is `f a1`\u00e2\u20ac\u201dthis will be important later.\n\nNow, we proceed with coverage-checking as usual. When we come to the\nConVar case for App, we create a fresh variable `a2` to represent its\nexistential tyvar. At this point, we have the equality constraints\n`(a ~ Maybe a2, a ~ Maybe Bool, f ~ Ty)` in scope.\n\nHowever, when we check the guard, it will use the type of pmvar123, which is\n`f a1`. Thus, when considering if pmvar123 can match the constructor TInt,\nit will generate the constraint `a1 ~ Int`. This means our final set of\nequality constraints would be:\n\n    f  ~ Ty\n    a  ~ Maybe Bool\n    a  ~ Maybe a2\n    a1 ~ Int\n\nWhich is satisfiable! Freshening the existential tyvar `a` to `a2` doomed us,\nbecause GHC is unable to relate `a2` to `a1`, which really should be the same\ntyvar.\n\nLuckily, we can avoid this pitfall. Recall that the ConVar case was where we\ngenerated a PmCon with too-fresh existentials. But after ConVar, we have the\nConCon case, which considers whether each constructor of a particular data type\ncan be matched on in a particular spot.\n\nIn the case of App, when we get to the ConCon case, we will compare our\noriginal App PmCon (from the source program) to the App PmCon created from the\nConVar case. In the former PmCon, we have `a1` in hand, which is exactly the\nexistential tyvar we want! Thus, we can force `a1` to be the same as `a2` here\nby emitting an additional `a1 ~ a2` constraint. Now our final set of equality\nconstraints will be:\n\n    f  ~ Ty\n    a  ~ Maybe Bool\n    a  ~ Maybe a2\n    a1 ~ Int\n    a1 ~ a2\n\nWhich is unsatisfiable, as we desired, since we now have that\nInt ~ a1 ~ a2 ~ Bool.\n\nIn general, App might have more than one constructor, in which case we\ncouldn't reuse the existential tyvar for App for a different constructor. This\nmeans that we can only use this trick in ConCon when the constructors are the\nsame. But this is fine, since this is the only scenario where this situation\narises in the first place!\n-}\n\n-- ----------------------------------------------------------------------------\n-- * Utilities for main checking\n\nupdateVsa :: (ValSetAbs -> ValSetAbs) -> (PartialResult -> PartialResult)\nupdateVsa f p@(PartialResult { presultUncovered = old })\n  = p { presultUncovered = f old }\n\n\n-- | Initialise with default values for covering and divergent information.\nusimple :: ValSetAbs -> PartialResult\nusimple vsa = mempty { presultUncovered = vsa }\n\n-- | Take the tail of all value vector abstractions in the uncovered set\nutail :: PartialResult -> PartialResult\nutail = updateVsa upd\n  where upd vsa = [ ValVec vva delta | ValVec (_:vva) delta <- vsa ]\n\n-- | Prepend a value abstraction to all value vector abstractions in the\n-- uncovered set\nucon :: ValAbs -> PartialResult -> PartialResult\nucon va = updateVsa upd\n  where\n    upd vsa = [ ValVec (va:vva) delta | ValVec vva delta <- vsa ]\n\n-- | Given a data constructor of arity `a` and an uncovered set containing\n-- value vector abstractions of length `(a+n)`, pass the first `n` value\n-- abstractions to the constructor (Hence, the resulting value vector\n-- abstractions will have length `n+1`)\nkcon :: ConLike -> [Type] -> [TyVar] -> [EvVar]\n     -> PartialResult -> PartialResult\nkcon con arg_tys ex_tvs dicts\n  = let n = conLikeArity con\n        upd vsa =\n          [ ValVec (va:vva) delta\n          | ValVec vva' delta <- vsa\n          , let (args, vva) = splitAt n vva'\n          , let va = PmCon { pm_con_con     = con\n                            , pm_con_arg_tys = arg_tys\n                            , pm_con_tvs     = ex_tvs\n                            , pm_con_dicts   = dicts\n                            , pm_con_args    = args } ]\n    in updateVsa upd\n\n-- | Get the union of two covered, uncovered and divergent value set\n-- abstractions. Since the covered and divergent sets are represented by a\n-- boolean, union means computing the logical or (at least one of the two is\n-- non-empty).\n\nmkUnion :: PartialResult -> PartialResult -> PartialResult\nmkUnion = mappend\n\n-- | Add a value vector abstraction to a value set abstraction (uncovered).\nmkCons :: ValVec -> PartialResult -> PartialResult\nmkCons vva = updateVsa (vva:)\n\n-- | Set the divergent set to not empty\nforces :: PartialResult -> PartialResult\nforces pres = pres { presultDivergent = Diverged }\n\n-- | Set the divergent set to non-empty if the flag is `True`\nforce_if :: Bool -> PartialResult -> PartialResult\nforce_if True  pres = forces pres\nforce_if False pres = pres\n\nset_provenance :: Provenance -> PartialResult -> PartialResult\nset_provenance prov pr = pr { presultProvenance = prov }\n\n-- ----------------------------------------------------------------------------\n-- * Propagation of term constraints inwards when checking nested matches\n\n{- Note [Type and Term Equality Propagation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen checking a match it would be great to have all type and term information\navailable so we can get more precise results. For this reason we have functions\n`addDictsDs' and `addTmCsDs' in PmMonad that store in the environment type and\nterm constraints (respectively) as we go deeper.\n\nThe type constraints we propagate inwards are collected by `collectEvVarsPats'\nin HsPat.hs. This handles bug #4139 ( see example\n  https://ghc.haskell.org/trac/ghc/attachment/ticket/4139/GADTbug.hs )\nwhere this is needed.\n\nFor term equalities we do less, we just generate equalities for HsCase. For\nexample we accurately give 2 redundancy warnings for the marked cases:\n\nf :: [a] -> Bool\nf x = case x of\n\n  []    -> case x of        -- brings (x ~ []) in scope\n             []    -> True\n             (_:_) -> False -- can't happen\n\n  (_:_) -> case x of        -- brings (x ~ (_:_)) in scope\n             (_:_) -> True\n             []    -> False -- can't happen\n\nFunctions `genCaseTmCs1' and `genCaseTmCs2' are responsible for generating\nthese constraints.\n-}\n\n-- | Generate equalities when checking a case expression:\n--     case x of { p1 -> e1; ... pn -> en }\n-- When we go deeper to check e.g. e1 we record two equalities:\n-- (x ~ y), where y is the initial uncovered when checking (p1; .. ; pn)\n-- and (x ~ p1).\ngenCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee\n             -> [Pat GhcTc]           -- LHS       (should have length 1)\n             -> [Id]                  -- MatchVars (should have length 1)\n             -> DsM (Bag SimpleEq)\ngenCaseTmCs2 Nothing _ _ = return emptyBag\ngenCaseTmCs2 (Just scr) [p] [var] = do\n  fam_insts <- dsGetFamInstEnvs\n  [e] <- map vaToPmExpr . coercePatVec <$> translatePat fam_insts p\n  let scr_e = lhsExprToPmExpr scr\n  return $ listToBag [(var, e), (var, scr_e)]\ngenCaseTmCs2 _ _ _ = panic \"genCaseTmCs2: HsCase\"\n\n-- | Generate a simple equality when checking a case expression:\n--     case x of { matches }\n-- When checking matches we record that (x ~ y) where y is the initial\n-- uncovered. All matches will have to satisfy this equality.\ngenCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq\ngenCaseTmCs1 Nothing     _    = emptyBag\ngenCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr)\ngenCaseTmCs1 _ _              = panic \"genCaseTmCs1: HsCase\"\n\n{- Note [Literals in PmPat]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInstead of translating a literal to a variable accompanied with a guard, we\ntreat them like constructor patterns. The following example from\n\"./libraries/base/GHC/IO/Encoding.hs\" shows why:\n\nmkTextEncoding' :: CodingFailureMode -> String -> IO TextEncoding\nmkTextEncoding' cfm enc = case [toUpper c | c <- enc, c /= '-'] of\n    \"UTF8\"    -> return $ UTF8.mkUTF8 cfm\n    \"UTF16\"   -> return $ UTF16.mkUTF16 cfm\n    \"UTF16LE\" -> return $ UTF16.mkUTF16le cfm\n    ...\n\nEach clause gets translated to a list of variables with an equal number of\nguards. For every guard we generate two cases (equals True/equals False) which\nmeans that we generate 2^n cases to feed the oracle with, where n is the sum of\nthe length of all strings that appear in the patterns. For this particular\nexample this means over 2^40 cases. Instead, by representing them like with\nconstructor we get the following:\n  1. We exploit the common prefix with our representation of VSAs\n  2. We prune immediately non-reachable cases\n     (e.g. False == (x == \"U\"), True == (x == \"U\"))\n\nNote [Translating As Patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInstead of translating x@p as:  x (p <- x)\nwe instead translate it as:     p (x <- coercePattern p)\nfor performance reasons. For example:\n\n  f x@True  = 1\n  f y@False = 2\n\nGives the following with the first translation:\n\n  x |> {x == False, x == y, y == True}\n\nIf we use the second translation we get an empty set, independently of the\noracle. Since the pattern `p' may contain guard patterns though, it cannot be\nused as an expression. That's why we call `coercePatVec' to drop the guard and\n`vaToPmExpr' to transform the value abstraction to an expression in the\nguard pattern (value abstractions are a subset of expressions). We keep the\nguards in the first pattern `p' though.\n\n\n%************************************************************************\n%*                                                                      *\n      Pretty printing of exhaustiveness/redundancy check warnings\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | Check whether any part of pattern match checking is enabled (does not\n-- matter whether it is the redundancy check or the exhaustiveness check).\nisAnyPmCheckEnabled :: DynFlags -> DsMatchContext -> Bool\nisAnyPmCheckEnabled dflags (DsMatchContext kind _loc)\n  = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind\n\ninstance Outputable ValVec where\n  ppr (ValVec vva delta)\n    = let (residual_eqs, subst) = wrapUpTmState (delta_tm_cs delta)\n          vector                = substInValAbs subst vva\n      in  ppr_uncovered (vector, residual_eqs)\n\n-- | Apply a term substitution to a value vector abstraction. All VAs are\n-- transformed to PmExpr (used only before pretty printing).\nsubstInValAbs :: PmVarEnv -> [ValAbs] -> [PmExpr]\nsubstInValAbs subst = map (exprDeepLookup subst . vaToPmExpr)\n\n-- | Wrap up the term oracle's state once solving is complete. Drop any\n-- information about unhandled constraints (involving HsExprs) and flatten\n-- (height 1) the substitution.\nwrapUpTmState :: TmState -> ([ComplexEq], PmVarEnv)\nwrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst)\n\n-- | Issue all the warnings (coverage, exhaustiveness, inaccessibility)\ndsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM ()\ndsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result\n  = when (flag_i || flag_u) $ do\n      let exists_r = flag_i && notNull redundant && onlyBuiltin\n          exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd\n          exists_u = flag_u && (case uncovered of\n                                  TypeOfUncovered   _ -> True\n                                  UncoveredPatterns u -> notNull u)\n\n      when exists_r $ forM_ redundant $ \\(dL->L l q) -> do\n        putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns)\n                               (pprEqn q \"is redundant\"))\n      when exists_i $ forM_ inaccessible $ \\(dL->L l q) -> do\n        putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns)\n                               (pprEqn q \"has inaccessible right hand side\"))\n      when exists_u $ putSrcSpanDs loc $ warnDs flag_u_reason $\n        case uncovered of\n          TypeOfUncovered ty           -> warnEmptyCase ty\n          UncoveredPatterns candidates -> pprEqns candidates\n  where\n    PmResult\n      { pmresultProvenance = prov\n      , pmresultRedundant = redundant\n      , pmresultUncovered = uncovered\n      , pmresultInaccessible = inaccessible } = pm_result\n\n    flag_i = wopt Opt_WarnOverlappingPatterns dflags\n    flag_u = exhaustive dflags kind\n    flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag kind)\n\n    is_rec_upd = case kind of { RecUpd -> True; _ -> False }\n       -- See Note [Inaccessible warnings for record updates]\n\n    onlyBuiltin = prov == FromBuiltin\n\n    maxPatterns = maxUncoveredPatterns dflags\n\n    -- Print a single clause (for redundant/with-inaccessible-rhs)\n    pprEqn q txt = pp_context True ctx (text txt) $ \\f -> ppr_eqn f kind q\n\n    -- Print several clauses (for uncovered clauses)\n    pprEqns qs = pp_context False ctx (text \"are non-exhaustive\") $ \\_ ->\n      case qs of -- See #11245\n           [ValVec [] _]\n                    -> text \"Guards do not cover entire pattern space\"\n           _missing -> let us = map ppr qs\n                       in  hang (text \"Patterns not matched:\") 4\n                                (vcat (take maxPatterns us)\n                                 $$ dots maxPatterns us)\n\n    -- Print a type-annotated wildcard (for non-exhaustive `EmptyCase`s for\n    -- which we only know the type and have no inhabitants at hand)\n    warnEmptyCase ty = pp_context False ctx (text \"are non-exhaustive\") $ \\_ ->\n      hang (text \"Patterns not matched:\") 4 (underscore <+> dcolon <+> ppr ty)\n\n{- Note [Inaccessible warnings for record updates]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #12957)\n  data T a where\n    T1 :: { x :: Int } -> T Bool\n    T2 :: { x :: Int } -> T a\n    T3 :: T a\n\n  f :: T Char -> T a\n  f r = r { x = 3 }\n\nThe desugarer will (conservatively generate a case for T1 even though\nit's impossible:\n  f r = case r of\n          T1 x -> T1 3   -- Inaccessible branch\n          T2 x -> T2 3\n          _    -> error \"Missing\"\n\nWe don't want to warn about the inaccessible branch because the programmer\ndidn't put it there!  So we filter out the warning here.\n-}\n\n-- | Issue a warning when the predefined number of iterations is exceeded\n-- for the pattern match checker\nwarnPmIters :: DynFlags -> DsMatchContext -> DsM ()\nwarnPmIters dflags (DsMatchContext kind loc)\n  = when (flag_i || flag_u) $ do\n      iters <- maxPmCheckIterations <$> getDynFlags\n      putSrcSpanDs loc (warnDs NoReason (msg iters))\n  where\n    ctxt   = pprMatchContext kind\n    msg is = fsep [ text \"Pattern match checker exceeded\"\n                  , parens (ppr is), text \"iterations in\", ctxt <> dot\n                  , text \"(Use -fmax-pmcheck-iterations=n\"\n                  , text \"to set the maximun number of iterations to n)\" ]\n\n    flag_i = wopt Opt_WarnOverlappingPatterns dflags\n    flag_u = exhaustive dflags kind\n\ndots :: Int -> [a] -> SDoc\ndots maxPatterns qs\n    | qs `lengthExceeds` maxPatterns = text \"...\"\n    | otherwise                      = empty\n\n-- | Check whether the exhaustiveness checker should run (exhaustiveness only)\nexhaustive :: DynFlags -> HsMatchContext id -> Bool\nexhaustive  dflags = maybe False (`wopt` dflags) . exhaustiveWarningFlag\n\n-- | Denotes whether an exhaustiveness check is supported, and if so,\n-- via which 'WarningFlag' it's controlled.\n-- Returns 'Nothing' if check is not supported.\nexhaustiveWarningFlag :: HsMatchContext id -> Maybe WarningFlag\nexhaustiveWarningFlag (FunRhs {})   = Just Opt_WarnIncompletePatterns\nexhaustiveWarningFlag CaseAlt       = Just Opt_WarnIncompletePatterns\nexhaustiveWarningFlag IfAlt         = Just Opt_WarnIncompletePatterns\nexhaustiveWarningFlag LambdaExpr    = Just Opt_WarnIncompleteUniPatterns\nexhaustiveWarningFlag PatBindRhs    = Just Opt_WarnIncompleteUniPatterns\nexhaustiveWarningFlag PatBindGuards = Just Opt_WarnIncompletePatterns\nexhaustiveWarningFlag ProcExpr      = Just Opt_WarnIncompleteUniPatterns\nexhaustiveWarningFlag RecUpd        = Just Opt_WarnIncompletePatternsRecUpd\nexhaustiveWarningFlag ThPatSplice   = Nothing\nexhaustiveWarningFlag PatSyn        = Nothing\nexhaustiveWarningFlag ThPatQuote    = Nothing\nexhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete patterns\n                                       -- in list comprehensions, pattern guards\n                                       -- etc. They are often *supposed* to be\n                                       -- incomplete\n\n-- True <==> singular\npp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc\npp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun\n  = vcat [text txt <+> msg,\n          sep [ text \"In\" <+> ppr_match <> char ':'\n              , nest 4 (rest_of_msg_fun pref)]]\n  where\n    txt | singular  = \"Pattern match\"\n        | otherwise = \"Pattern match(es)\"\n\n    (ppr_match, pref)\n        = case kind of\n             FunRhs { mc_fun = (dL->L _ fun) }\n                  -> (pprMatchContext kind, \\ pp -> ppr fun <+> pp)\n             _    -> (pprMatchContext kind, \\ pp -> pp)\n\nppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc\nppr_pats kind pats\n  = sep [sep (map ppr pats), matchSeparator kind, text \"...\"]\n\nppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc\nppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn))\n\nppr_constraint :: (SDoc,[PmLit]) -> SDoc\nppr_constraint (var, lits) = var <+> text \"is not one of\"\n                                 <+> braces (pprWithCommas ppr lits)\n\nppr_uncovered :: ([PmExpr], [ComplexEq]) -> SDoc\nppr_uncovered (expr_vec, complex)\n  | null cs   = fsep vec -- there are no literal constraints\n  | otherwise = hang (fsep vec) 4 $\n                  text \"where\" <+> vcat (map ppr_constraint cs)\n  where\n    sdoc_vec = mapM pprPmExprWithParens expr_vec\n    (vec,cs) = runPmPprM sdoc_vec (filterComplex complex)\n\n{- Note [Representation of Term Equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the paper, term constraints always take the form (x ~ e). Of course, a more\ngeneral constraint of the form (e1 ~ e1) can always be transformed to an\nequivalent set of the former constraints, by introducing a fresh, intermediate\nvariable: { y ~ e1, y ~ e1 }. Yet, implementing this representation gave rise\nto #11160 (incredibly bad performance for literal pattern matching). Two are\nthe main sources of this problem (the actual problem is how these two interact\nwith each other):\n\n1. Pattern matching on literals generates twice as many constraints as needed.\n   Consider the following (tests/ghci/should_run/ghcirun004):\n\n    foo :: Int -> Int\n    foo 1    = 0\n    ...\n    foo 5000 = 4999\n\n   The covered and uncovered set *should* look like:\n     U0 = { x |> {} }\n\n     C1  = { 1  |> { x ~ 1 } }\n     U1  = { x  |> { False ~ (x ~ 1) } }\n     ...\n     C10 = { 10 |> { False ~ (x ~ 1), .., False ~ (x ~ 9), x ~ 10 } }\n     U10 = { x  |> { False ~ (x ~ 1), .., False ~ (x ~ 9), False ~ (x ~ 10) } }\n     ...\n\n     If we replace { False ~ (x ~ 1) } with { y ~ False, y ~ (x ~ 1) }\n     we get twice as many constraints. Also note that half of them are just the\n     substitution [x |-> False].\n\n2. The term oracle (`tmOracle` in deSugar/TmOracle) uses equalities of the form\n   (x ~ e) as substitutions [x |-> e]. More specifically, function\n   `extendSubstAndSolve` applies such substitutions in the residual constraints\n   and partitions them in the affected and non-affected ones, which are the new\n   worklist. Essentially, this gives quadradic behaviour on the number of the\n   residual constraints. (This would not be the case if the term oracle used\n   mutable variables but, since we use it to handle disjunctions on value set\n   abstractions (`Union` case), we chose a pure, incremental interface).\n\nNow the problem becomes apparent (e.g. for clause 300):\n  * Set U300 contains 300 substituting constraints [y_i |-> False] and 300\n    constraints that we know that will not reduce (stay in the worklist).\n  * To check for consistency, we apply the substituting constraints ONE BY ONE\n    (since `tmOracle` is called incrementally, it does not have all of them\n    available at once). Hence, we go through the (non-progressing) constraints\n    over and over, achieving over-quadradic behaviour.\n\nIf instead we allow constraints of the form (e ~ e),\n  * All uncovered sets Ui contain no substituting constraints and i\n    non-progressing constraints of the form (False ~ (x ~ lit)) so the oracle\n    behaves linearly.\n  * All covered sets Ci contain exactly (i-1) non-progressing constraints and\n    a single substituting constraint. So the term oracle goes through the\n    constraints only once.\n\nThe performance improvement becomes even more important when more arguments are\ninvolved.\n-}\n\n-- Debugging Infrastructre\n\ntracePm :: String -> SDoc -> PmM ()\ntracePm herald doc = liftD $ tracePmD herald doc\n\n\ntracePmD :: String -> SDoc -> DsM ()\ntracePmD herald doc = do\n  dflags <- getDynFlags\n  printer <- mkPrintUnqualifiedDs\n  liftIO $ dumpIfSet_dyn_printer printer dflags\n            Opt_D_dump_ec_trace (text herald $$ (nest 2 doc))\n\n\npprPmPatDebug :: PmPat a -> SDoc\npprPmPatDebug (PmCon cc _arg_tys _con_tvs _con_dicts con_args)\n  = hsep [text \"PmCon\", ppr cc, hsep (map pprPmPatDebug con_args)]\npprPmPatDebug (PmVar vid) = text \"PmVar\" <+> ppr vid\npprPmPatDebug (PmLit li)  = text \"PmLit\" <+> ppr li\npprPmPatDebug (PmNLit i nl) = text \"PmNLit\" <+> ppr i <+> ppr nl\npprPmPatDebug (PmGrd pv ge) = text \"PmGrd\" <+> hsep (map pprPmPatDebug pv)\n                                           <+> ppr ge\n\npprPatVec :: PatVec -> SDoc\npprPatVec ps = hang (text \"Pattern:\") 2\n                (brackets $ sep\n                  $ punctuate (comma <> char '\\n') (map pprPmPatDebug ps))\n\npprValAbs :: [ValAbs] -> SDoc\npprValAbs ps = hang (text \"ValAbs:\") 2\n                (brackets $ sep\n                  $ punctuate (comma) (map pprPmPatDebug ps))\n\npprValVecDebug :: ValVec -> SDoc\npprValVecDebug (ValVec vas _d) = text \"ValVec\" <+>\n                                  parens (pprValAbs vas)\n", "num_lines": 2713}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) Galois, 2006\n(c) University of Glasgow, 2007\n-}\n\n{-# LANGUAGE NondecreasingIndentation, RecordWildCards #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Coverage (addTicksToBinds, hpcInitCode) where\n\nimport GhcPrelude as Prelude\n\nimport qualified GHCi\nimport GHCi.RemoteTypes\nimport Data.Array\nimport ByteCodeTypes\nimport GHC.Stack.CCS\nimport Type\nimport HsSyn\nimport Module\nimport Outputable\nimport DynFlags\nimport ConLike\nimport Control.Monad\nimport SrcLoc\nimport ErrUtils\nimport NameSet hiding (FreeVars)\nimport Name\nimport Bag\nimport CostCentre\nimport CostCentreState\nimport CoreSyn\nimport Id\nimport VarSet\nimport Data.List\nimport FastString\nimport HscTypes\nimport TyCon\nimport BasicTypes\nimport MonadUtils\nimport Maybes\nimport CLabel\nimport Util\n\nimport Data.Time\nimport System.Directory\n\nimport Trace.Hpc.Mix\nimport Trace.Hpc.Util\n\nimport qualified Data.ByteString as BS\nimport Data.Map (Map)\nimport qualified Data.Map as Map\n\n{-\n************************************************************************\n*                                                                      *\n*              The main function: addTicksToBinds\n*                                                                      *\n************************************************************************\n-}\n\naddTicksToBinds\n        :: HscEnv\n        -> Module\n        -> ModLocation          -- ... off the current module\n        -> NameSet              -- Exported Ids.  When we call addTicksToBinds,\n                                -- isExportedId doesn't work yet (the desugarer\n                                -- hasn't set it), so we have to work from this set.\n        -> [TyCon]              -- Type constructor in this module\n        -> LHsBinds GhcTc\n        -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)\n\naddTicksToBinds hsc_env mod mod_loc exports tyCons binds\n  | let dflags = hsc_dflags hsc_env\n        passes = coveragePasses dflags, not (null passes),\n    Just orig_file <- ml_hs_file mod_loc,\n    not (\"boot\" `isSuffixOf` orig_file) = do\n\n     let  orig_file2 = guessSourceFile binds orig_file\n\n          tickPass tickish (binds,st) =\n            let env = TTE\n                      { fileName     = mkFastString orig_file2\n                      , declPath     = []\n                      , tte_dflags   = dflags\n                      , exports      = exports\n                      , inlines      = emptyVarSet\n                      , inScope      = emptyVarSet\n                      , blackList    = Map.fromList\n                                          [ (getSrcSpan (tyConName tyCon),())\n                                          | tyCon <- tyCons ]\n                      , density      = mkDensity tickish dflags\n                      , this_mod     = mod\n                      , tickishType  = tickish\n                      }\n                (binds',_,st') = unTM (addTickLHsBinds binds) env st\n            in (binds', st')\n\n          initState = TT { tickBoxCount = 0\n                         , mixEntries   = []\n                         , ccIndices    = newCostCentreState\n                         }\n\n          (binds1,st) = foldr tickPass (binds, initState) passes\n\n     let tickCount = tickBoxCount st\n         entries = reverse $ mixEntries st\n     hashNo <- writeMixEntries dflags mod tickCount entries orig_file2\n     modBreaks <- mkModBreaks hsc_env mod tickCount entries\n\n     dumpIfSet_dyn dflags Opt_D_dump_ticked \"HPC\" (pprLHsBinds binds1)\n\n     return (binds1, HpcInfo tickCount hashNo, Just modBreaks)\n\n  | otherwise = return (binds, emptyHpcInfo False, Nothing)\n\nguessSourceFile :: LHsBinds GhcTc -> FilePath -> FilePath\nguessSourceFile binds orig_file =\n     -- Try look for a file generated from a .hsc file to a\n     -- .hs file, by peeking ahead.\n     let top_pos = catMaybes $ foldrBag (\\ (dL->L pos _) rest ->\n                                 srcSpanFileName_maybe pos : rest) [] binds\n     in\n     case top_pos of\n        (file_name:_) | \".hsc\" `isSuffixOf` unpackFS file_name\n                      -> unpackFS file_name\n        _ -> orig_file\n\n\nmkModBreaks :: HscEnv -> Module -> Int -> [MixEntry_] -> IO ModBreaks\nmkModBreaks hsc_env mod count entries\n  | HscInterpreted <- hscTarget (hsc_dflags hsc_env) = do\n    breakArray <- GHCi.newBreakArray hsc_env (length entries)\n    ccs <- mkCCSArray hsc_env mod count entries\n    let\n           locsTicks  = listArray (0,count-1) [ span  | (span,_,_,_)  <- entries ]\n           varsTicks  = listArray (0,count-1) [ vars  | (_,_,vars,_)  <- entries ]\n           declsTicks = listArray (0,count-1) [ decls | (_,decls,_,_) <- entries ]\n    return emptyModBreaks\n                       { modBreaks_flags = breakArray\n                       , modBreaks_locs  = locsTicks\n                       , modBreaks_vars  = varsTicks\n                       , modBreaks_decls = declsTicks\n                       , modBreaks_ccs   = ccs\n                       }\n  | otherwise = return emptyModBreaks\n\nmkCCSArray\n  :: HscEnv -> Module -> Int -> [MixEntry_]\n  -> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre))\nmkCCSArray hsc_env modul count entries = do\n  if interpreterProfiled dflags\n    then do\n      let module_str = moduleNameString (moduleName modul)\n      costcentres <- GHCi.mkCostCentres hsc_env module_str (map mk_one entries)\n      return (listArray (0,count-1) costcentres)\n    else do\n      return (listArray (0,-1) [])\n where\n    dflags = hsc_dflags hsc_env\n    mk_one (srcspan, decl_path, _, _) = (name, src)\n      where name = concat (intersperse \".\" decl_path)\n            src = showSDoc dflags (ppr srcspan)\n\n\nwriteMixEntries\n  :: DynFlags -> Module -> Int -> [MixEntry_] -> FilePath -> IO Int\nwriteMixEntries dflags mod count entries filename\n  | not (gopt Opt_Hpc dflags) = return 0\n  | otherwise   = do\n        let\n            hpc_dir = hpcDir dflags\n            mod_name = moduleNameString (moduleName mod)\n\n            hpc_mod_dir\n              | moduleUnitId mod == mainUnitId  = hpc_dir\n              | otherwise = hpc_dir ++ \"/\" ++ unitIdString (moduleUnitId mod)\n\n            tabStop = 8 -- <tab> counts as a normal char in GHC's\n                        -- location ranges.\n\n        createDirectoryIfMissing True hpc_mod_dir\n        modTime <- getModificationUTCTime filename\n        let entries' = [ (hpcPos, box)\n                       | (span,_,_,box) <- entries, hpcPos <- [mkHpcPos span] ]\n        when (entries' `lengthIsNot` count) $ do\n          panic \"the number of .mix entries are inconsistent\"\n        let hashNo = mixHash filename modTime tabStop entries'\n        mixCreate hpc_mod_dir mod_name\n                       $ Mix filename modTime (toHash hashNo) tabStop entries'\n        return hashNo\n\n\n-- -----------------------------------------------------------------------------\n-- TickDensity: where to insert ticks\n\ndata TickDensity\n  = TickForCoverage       -- for Hpc\n  | TickForBreakPoints    -- for GHCi\n  | TickAllFunctions      -- for -prof-auto-all\n  | TickTopFunctions      -- for -prof-auto-top\n  | TickExportedFunctions -- for -prof-auto-exported\n  | TickCallSites         -- for stack tracing\n  deriving Eq\n\nmkDensity :: TickishType -> DynFlags -> TickDensity\nmkDensity tickish dflags = case tickish of\n  HpcTicks             -> TickForCoverage\n  SourceNotes          -> TickForCoverage\n  Breakpoints          -> TickForBreakPoints\n  ProfNotes ->\n    case profAuto dflags of\n      ProfAutoAll      -> TickAllFunctions\n      ProfAutoTop      -> TickTopFunctions\n      ProfAutoExports  -> TickExportedFunctions\n      ProfAutoCalls    -> TickCallSites\n      _other           -> panic \"mkDensity\"\n\n-- | Decide whether to add a tick to a binding or not.\nshouldTickBind  :: TickDensity\n                -> Bool         -- top level?\n                -> Bool         -- exported?\n                -> Bool         -- simple pat bind?\n                -> Bool         -- INLINE pragma?\n                -> Bool\n\nshouldTickBind density top_lev exported _simple_pat inline\n = case density of\n      TickForBreakPoints    -> False\n        -- we never add breakpoints to simple pattern bindings\n        -- (there's always a tick on the rhs anyway).\n      TickAllFunctions      -> not inline\n      TickTopFunctions      -> top_lev && not inline\n      TickExportedFunctions -> exported && not inline\n      TickForCoverage       -> True\n      TickCallSites         -> False\n\nshouldTickPatBind :: TickDensity -> Bool -> Bool\nshouldTickPatBind density top_lev\n  = case density of\n      TickForBreakPoints    -> False\n      TickAllFunctions      -> True\n      TickTopFunctions      -> top_lev\n      TickExportedFunctions -> False\n      TickForCoverage       -> False\n      TickCallSites         -> False\n\n-- -----------------------------------------------------------------------------\n-- Adding ticks to bindings\n\naddTickLHsBinds :: LHsBinds GhcTc -> TM (LHsBinds GhcTc)\naddTickLHsBinds = mapBagM addTickLHsBind\n\naddTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)\naddTickLHsBind (dL->L pos bind@(AbsBinds { abs_binds   = binds,\n                                       abs_exports = abs_exports })) = do\n  withEnv add_exports $ do\n  withEnv add_inlines $ do\n  binds' <- addTickLHsBinds binds\n  return $ cL pos $ bind { abs_binds = binds' }\n where\n   -- in AbsBinds, the Id on each binding is not the actual top-level\n   -- Id that we are defining, they are related by the abs_exports\n   -- field of AbsBinds.  So if we're doing TickExportedFunctions we need\n   -- to add the local Ids to the set of exported Names so that we know to\n   -- tick the right bindings.\n   add_exports env =\n     env{ exports = exports env `extendNameSetList`\n                      [ idName mid\n                      | ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports\n                      , idName pid `elemNameSet` (exports env) ] }\n\n   -- See Note [inline sccs]\n   add_inlines env =\n     env{ inlines = inlines env `extendVarSetList`\n                      [ mid\n                      | ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports\n                      , isInlinePragma (idInlinePragma pid) ] }\n\naddTickLHsBind (dL->L pos (funBind@(FunBind { fun_id = (dL->L _ id)  }))) = do\n  let name = getOccString id\n  decl_path <- getPathEntry\n  density <- getDensity\n\n  inline_ids <- liftM inlines getEnv\n  -- See Note [inline sccs]\n  let inline   = isInlinePragma (idInlinePragma id)\n                 || id `elemVarSet` inline_ids\n\n  -- See Note [inline sccs]\n  tickish <- tickishType `liftM` getEnv\n  if inline && tickish == ProfNotes then return (cL pos funBind) else do\n\n  (fvs, mg) <-\n        getFreeVars $\n        addPathEntry name $\n        addTickMatchGroup False (fun_matches funBind)\n\n  case mg of\n    MG {} -> return ()\n    _     -> panic \"addTickLHsBind\"\n\n  blackListed <- isBlackListed pos\n  exported_names <- liftM exports getEnv\n\n  -- We don't want to generate code for blacklisted positions\n  -- We don't want redundant ticks on simple pattern bindings\n  -- We don't want to tick non-exported bindings in TickExportedFunctions\n  let simple = isSimplePatBind funBind\n      toplev = null decl_path\n      exported = idName id `elemNameSet` exported_names\n\n  tick <- if not blackListed &&\n               shouldTickBind density toplev exported simple inline\n             then\n                bindTick density name pos fvs\n             else\n                return Nothing\n\n  let mbCons = maybe Prelude.id (:)\n  return $ cL pos $ funBind { fun_matches = mg\n                            , fun_tick = tick `mbCons` fun_tick funBind }\n\n   where\n   -- a binding is a simple pattern binding if it is a funbind with\n   -- zero patterns\n   isSimplePatBind :: HsBind a -> Bool\n   isSimplePatBind funBind = matchGroupArity (fun_matches funBind) == 0\n\n-- TODO: Revisit this\naddTickLHsBind (dL->L pos (pat@(PatBind { pat_lhs = lhs\n                                        , pat_rhs = rhs }))) = do\n  let name = \"(...)\"\n  (fvs, rhs') <- getFreeVars $ addPathEntry name $ addTickGRHSs False False rhs\n  let pat' = pat { pat_rhs = rhs'}\n\n  -- Should create ticks here?\n  density <- getDensity\n  decl_path <- getPathEntry\n  let top_lev = null decl_path\n  if not (shouldTickPatBind density top_lev)\n    then return (cL pos pat')\n    else do\n\n    -- Allocate the ticks\n    rhs_tick <- bindTick density name pos fvs\n    let patvars = map getOccString (collectPatBinders lhs)\n    patvar_ticks <- mapM (\\v -> bindTick density v pos fvs) patvars\n\n    -- Add to pattern\n    let mbCons = maybe id (:)\n        rhs_ticks = rhs_tick `mbCons` fst (pat_ticks pat')\n        patvar_tickss = zipWith mbCons patvar_ticks\n                        (snd (pat_ticks pat') ++ repeat [])\n    return $ cL pos $ pat' { pat_ticks = (rhs_ticks, patvar_tickss) }\n\n-- Only internal stuff, not from source, uses VarBind, so we ignore it.\naddTickLHsBind var_bind@(dL->L _ (VarBind {})) = return var_bind\naddTickLHsBind patsyn_bind@(dL->L _ (PatSynBind {})) = return patsyn_bind\naddTickLHsBind bind@(dL->L _ (XHsBindsLR {})) = return bind\naddTickLHsBind _  = panic \"addTickLHsBind: Impossible Match\" -- due to #15884\n\n\n\nbindTick\n  :: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))\nbindTick density name pos fvs = do\n  decl_path <- getPathEntry\n  let\n      toplev        = null decl_path\n      count_entries = toplev || density == TickAllFunctions\n      top_only      = density /= TickAllFunctions\n      box_label     = if toplev then TopLevelBox [name]\n                                else LocalBox (decl_path ++ [name])\n  --\n  allocATickBox box_label count_entries top_only pos fvs\n\n\n-- Note [inline sccs]\n--\n-- The reason not to add ticks to INLINE functions is that this is\n-- sometimes handy for avoiding adding a tick to a particular function\n-- (see #6131)\n--\n-- So for now we do not add any ticks to INLINE functions at all.\n--\n-- We used to use isAnyInlinePragma to figure out whether to avoid adding\n-- ticks for this purpose. However, #12962 indicates that this contradicts\n-- the documentation on profiling (which only mentions INLINE pragmas).\n-- So now we're more careful about what we avoid adding ticks to.\n\n-- -----------------------------------------------------------------------------\n-- Decorate an LHsExpr with ticks\n\n-- selectively add ticks to interesting expressions\naddTickLHsExpr :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTickLHsExpr e@(dL->L pos e0) = do\n  d <- getDensity\n  case d of\n    TickForBreakPoints | isGoodBreakExpr e0 -> tick_it\n    TickForCoverage    -> tick_it\n    TickCallSites      | isCallSite e0      -> tick_it\n    _other             -> dont_tick_it\n where\n   tick_it      = allocTickBox (ExpBox False) False False pos $ addTickHsExpr e0\n   dont_tick_it = addTickLHsExprNever e\n\n-- Add a tick to an expression which is the RHS of an equation or a binding.\n-- We always consider these to be breakpoints, unless the expression is a 'let'\n-- (because the body will definitely have a tick somewhere).  ToDo: perhaps\n-- we should treat 'case' and 'if' the same way?\naddTickLHsExprRHS :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTickLHsExprRHS e@(dL->L pos e0) = do\n  d <- getDensity\n  case d of\n     TickForBreakPoints | HsLet{} <- e0 -> dont_tick_it\n                        | otherwise     -> tick_it\n     TickForCoverage -> tick_it\n     TickCallSites   | isCallSite e0 -> tick_it\n     _other          -> dont_tick_it\n where\n   tick_it      = allocTickBox (ExpBox False) False False pos $ addTickHsExpr e0\n   dont_tick_it = addTickLHsExprNever e\n\n-- The inner expression of an evaluation context:\n--    let binds in [], ( [] )\n-- we never tick these if we're doing HPC, but otherwise\n-- we treat it like an ordinary expression.\naddTickLHsExprEvalInner :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTickLHsExprEvalInner e = do\n   d <- getDensity\n   case d of\n     TickForCoverage -> addTickLHsExprNever e\n     _otherwise      -> addTickLHsExpr e\n\n-- | A let body is treated differently from addTickLHsExprEvalInner\n-- above with TickForBreakPoints, because for breakpoints we always\n-- want to tick the body, even if it is not a redex.  See test\n-- break012.  This gives the user the opportunity to inspect the\n-- values of the let-bound variables.\naddTickLHsExprLetBody :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTickLHsExprLetBody e@(dL->L pos e0) = do\n  d <- getDensity\n  case d of\n     TickForBreakPoints | HsLet{} <- e0 -> dont_tick_it\n                        | otherwise     -> tick_it\n     _other -> addTickLHsExprEvalInner e\n where\n   tick_it      = allocTickBox (ExpBox False) False False pos $ addTickHsExpr e0\n   dont_tick_it = addTickLHsExprNever e\n\n-- version of addTick that does not actually add a tick,\n-- because the scope of this tick is completely subsumed by\n-- another.\naddTickLHsExprNever :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTickLHsExprNever (dL->L pos e0) = do\n    e1 <- addTickHsExpr e0\n    return $ cL pos e1\n\n-- general heuristic: expressions which do not denote values are good\n-- break points\nisGoodBreakExpr :: HsExpr GhcTc -> Bool\nisGoodBreakExpr (HsApp {})     = True\nisGoodBreakExpr (HsAppType {}) = True\nisGoodBreakExpr (OpApp {})     = True\nisGoodBreakExpr _other         = False\n\nisCallSite :: HsExpr GhcTc -> Bool\nisCallSite HsApp{}     = True\nisCallSite HsAppType{} = True\nisCallSite OpApp{}     = True\nisCallSite _ = False\n\naddTickLHsExprOptAlt :: Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTickLHsExprOptAlt oneOfMany (dL->L pos e0)\n  = ifDensity TickForCoverage\n        (allocTickBox (ExpBox oneOfMany) False False pos $ addTickHsExpr e0)\n        (addTickLHsExpr (cL pos e0))\n\naddBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddBinTickLHsExpr boxLabel (dL->L pos e0)\n  = ifDensity TickForCoverage\n        (allocBinTickBox boxLabel pos $ addTickHsExpr e0)\n        (addTickLHsExpr (cL pos e0))\n\n\n-- -----------------------------------------------------------------------------\n-- Decorate the body of an HsExpr with ticks.\n-- (Whether to put a tick around the whole expression was already decided,\n-- in the addTickLHsExpr family of functions.)\n\naddTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)\naddTickHsExpr e@(HsVar _ (dL->L _ id)) = do freeVar id; return e\naddTickHsExpr (HsUnboundVar {})    = panic \"addTickHsExpr.HsUnboundVar\"\naddTickHsExpr e@(HsConLikeOut _ con)\n  | Just id <- conLikeWrapId_maybe con = do freeVar id; return e\naddTickHsExpr e@(HsIPVar {})       = return e\naddTickHsExpr e@(HsOverLit {})     = return e\naddTickHsExpr e@(HsOverLabel{})    = return e\naddTickHsExpr e@(HsLit {})         = return e\naddTickHsExpr (HsLam x matchgroup) = liftM (HsLam x)\n                                           (addTickMatchGroup True matchgroup)\naddTickHsExpr (HsLamCase x mgs)    = liftM (HsLamCase x)\n                                           (addTickMatchGroup True mgs)\naddTickHsExpr (HsApp x e1 e2)      = liftM2 (HsApp x) (addTickLHsExprNever e1)\n                                                      (addTickLHsExpr      e2)\naddTickHsExpr (HsAppType x e ty)   = liftM3 HsAppType (return x)\n                                                      (addTickLHsExprNever e)\n                                                      (return ty)\n\naddTickHsExpr (OpApp fix e1 e2 e3) =\n        liftM4 OpApp\n                (return fix)\n                (addTickLHsExpr e1)\n                (addTickLHsExprNever e2)\n                (addTickLHsExpr e3)\naddTickHsExpr (NegApp x e neg) =\n        liftM2 (NegApp x)\n                (addTickLHsExpr e)\n                (addTickSyntaxExpr hpcSrcSpan neg)\naddTickHsExpr (HsPar x e) =\n        liftM (HsPar x) (addTickLHsExprEvalInner e)\naddTickHsExpr (SectionL x e1 e2) =\n        liftM2 (SectionL x)\n                (addTickLHsExpr e1)\n                (addTickLHsExprNever e2)\naddTickHsExpr (SectionR x e1 e2) =\n        liftM2 (SectionR x)\n                (addTickLHsExprNever e1)\n                (addTickLHsExpr e2)\naddTickHsExpr (ExplicitTuple x es boxity) =\n        liftM2 (ExplicitTuple x)\n                (mapM addTickTupArg es)\n                (return boxity)\naddTickHsExpr (ExplicitSum ty tag arity e) = do\n        e' <- addTickLHsExpr e\n        return (ExplicitSum ty tag arity e')\naddTickHsExpr (HsCase x e mgs) =\n        liftM2 (HsCase x)\n                (addTickLHsExpr e) -- not an EvalInner; e might not necessarily\n                                   -- be evaluated.\n                (addTickMatchGroup False mgs)\naddTickHsExpr (HsIf x cnd e1 e2 e3) =\n        liftM3 (HsIf x cnd)\n                (addBinTickLHsExpr (BinBox CondBinBox) e1)\n                (addTickLHsExprOptAlt True e2)\n                (addTickLHsExprOptAlt True e3)\naddTickHsExpr (HsMultiIf ty alts)\n  = do { let isOneOfMany = case alts of [_] -> False; _ -> True\n       ; alts' <- mapM (liftL $ addTickGRHS isOneOfMany False) alts\n       ; return $ HsMultiIf ty alts' }\naddTickHsExpr (HsLet x (dL->L l binds) e) =\n        bindLocals (collectLocalBinders binds) $\n          liftM2 (HsLet x . cL l)\n                  (addTickHsLocalBinds binds) -- to think about: !patterns.\n                  (addTickLHsExprLetBody e)\naddTickHsExpr (HsDo srcloc cxt (dL->L l stmts))\n  = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())\n       ; return (HsDo srcloc cxt (cL l stmts')) }\n  where\n        forQual = case cxt of\n                    ListComp -> Just $ BinBox QualBinBox\n                    _        -> Nothing\naddTickHsExpr (ExplicitList ty wit es) =\n        liftM3 ExplicitList\n                (return ty)\n                (addTickWit wit)\n                (mapM (addTickLHsExpr) es)\n             where addTickWit Nothing = return Nothing\n                   addTickWit (Just fln)\n                     = do fln' <- addTickSyntaxExpr hpcSrcSpan fln\n                          return (Just fln')\n\naddTickHsExpr (HsStatic fvs e) = HsStatic fvs <$> addTickLHsExpr e\n\naddTickHsExpr expr@(RecordCon { rcon_flds = rec_binds })\n  = do { rec_binds' <- addTickHsRecordBinds rec_binds\n       ; return (expr { rcon_flds = rec_binds' }) }\n\naddTickHsExpr expr@(RecordUpd { rupd_expr = e, rupd_flds = flds })\n  = do { e' <- addTickLHsExpr e\n       ; flds' <- mapM addTickHsRecField flds\n       ; return (expr { rupd_expr = e', rupd_flds = flds' }) }\n\naddTickHsExpr (ExprWithTySig x e ty) =\n        liftM3 ExprWithTySig\n                (return x)\n                (addTickLHsExprNever e) -- No need to tick the inner expression\n                                        -- for expressions with signatures\n                (return ty)\naddTickHsExpr (ArithSeq ty wit arith_seq) =\n        liftM3 ArithSeq\n                (return ty)\n                (addTickWit wit)\n                (addTickArithSeqInfo arith_seq)\n             where addTickWit Nothing = return Nothing\n                   addTickWit (Just fl) = do fl' <- addTickSyntaxExpr hpcSrcSpan fl\n                                             return (Just fl')\n\n-- We might encounter existing ticks (multiple Coverage passes)\naddTickHsExpr (HsTick x t e) =\n        liftM (HsTick x t) (addTickLHsExprNever e)\naddTickHsExpr (HsBinTick x t0 t1 e) =\n        liftM (HsBinTick x t0 t1) (addTickLHsExprNever e)\n\naddTickHsExpr (HsTickPragma _ _ _ _ (dL->L pos e0)) = do\n    e2 <- allocTickBox (ExpBox False) False False pos $\n                addTickHsExpr e0\n    return $ unLoc e2\naddTickHsExpr (HsSCC x src nm e) =\n        liftM3 (HsSCC x)\n                (return src)\n                (return nm)\n                (addTickLHsExpr e)\naddTickHsExpr (HsCoreAnn x src nm e) =\n        liftM3 (HsCoreAnn x)\n                (return src)\n                (return nm)\n                (addTickLHsExpr e)\naddTickHsExpr e@(HsBracket     {})   = return e\naddTickHsExpr e@(HsTcBracketOut  {}) = return e\naddTickHsExpr e@(HsRnBracketOut  {}) = return e\naddTickHsExpr e@(HsSpliceE  {})      = return e\naddTickHsExpr (HsProc x pat cmdtop) =\n        liftM2 (HsProc x)\n                (addTickLPat pat)\n                (liftL (addTickHsCmdTop) cmdtop)\naddTickHsExpr (HsWrap x w e) =\n        liftM2 (HsWrap x)\n                (return w)\n                (addTickHsExpr e)       -- Explicitly no tick on inside\n\n-- Others should never happen in expression content.\naddTickHsExpr e  = pprPanic \"addTickHsExpr\" (ppr e)\n\naddTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)\naddTickTupArg (dL->L l (Present x e))  = do { e' <- addTickLHsExpr e\n                                            ; return (cL l (Present x e')) }\naddTickTupArg (dL->L l (Missing ty)) = return (cL l (Missing ty))\naddTickTupArg (dL->L _ (XTupArg _)) = panic \"addTickTupArg\"\naddTickTupArg _  = panic \"addTickTupArg: Impossible Match\" -- due to #15884\n\n\naddTickMatchGroup :: Bool{-is lambda-} -> MatchGroup GhcTc (LHsExpr GhcTc)\n                  -> TM (MatchGroup GhcTc (LHsExpr GhcTc))\naddTickMatchGroup is_lam mg@(MG { mg_alts = dL->L l matches }) = do\n  let isOneOfMany = matchesOneOfMany matches\n  matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches\n  return $ mg { mg_alts = cL l matches' }\naddTickMatchGroup _ (XMatchGroup _) = panic \"addTickMatchGroup\"\n\naddTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)\n             -> TM (Match GhcTc (LHsExpr GhcTc))\naddTickMatch isOneOfMany isLambda match@(Match { m_pats = pats\n                                               , m_grhss = gRHSs }) =\n  bindLocals (collectPatsBinders pats) $ do\n    gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs\n    return $ match { m_grhss = gRHSs' }\naddTickMatch _ _ (XMatch _) = panic \"addTickMatch\"\n\naddTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)\n             -> TM (GRHSs GhcTc (LHsExpr GhcTc))\naddTickGRHSs isOneOfMany isLambda (GRHSs x guarded (dL->L l local_binds)) = do\n  bindLocals binders $ do\n    local_binds' <- addTickHsLocalBinds local_binds\n    guarded' <- mapM (liftL (addTickGRHS isOneOfMany isLambda)) guarded\n    return $ GRHSs x guarded' (cL l local_binds')\n  where\n    binders = collectLocalBinders local_binds\naddTickGRHSs _ _ (XGRHSs _) = panic \"addTickGRHSs\"\n\naddTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)\n            -> TM (GRHS GhcTc (LHsExpr GhcTc))\naddTickGRHS isOneOfMany isLambda (GRHS x stmts expr) = do\n  (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) stmts\n                        (addTickGRHSBody isOneOfMany isLambda expr)\n  return $ GRHS x stmts' expr'\naddTickGRHS _ _ (XGRHS _) = panic \"addTickGRHS\"\n\naddTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTickGRHSBody isOneOfMany isLambda expr@(dL->L pos e0) = do\n  d <- getDensity\n  case d of\n    TickForCoverage  -> addTickLHsExprOptAlt isOneOfMany expr\n    TickAllFunctions | isLambda ->\n       addPathEntry \"\\\\\" $\n         allocTickBox (ExpBox False) True{-count-} False{-not top-} pos $\n           addTickHsExpr e0\n    _otherwise ->\n       addTickLHsExprRHS expr\n\naddTickLStmts :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc]\n              -> TM [ExprLStmt GhcTc]\naddTickLStmts isGuard stmts = do\n  (stmts, _) <- addTickLStmts' isGuard stmts (return ())\n  return stmts\n\naddTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a\n               -> TM ([ExprLStmt GhcTc], a)\naddTickLStmts' isGuard lstmts res\n  = bindLocals (collectLStmtsBinders lstmts) $\n    do { lstmts' <- mapM (liftL (addTickStmt isGuard)) lstmts\n       ; a <- res\n       ; return (lstmts', a) }\n\naddTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt GhcTc (LHsExpr GhcTc)\n            -> TM (Stmt GhcTc (LHsExpr GhcTc))\naddTickStmt _isGuard (LastStmt x e noret ret) = do\n        liftM3 (LastStmt x)\n                (addTickLHsExpr e)\n                (pure noret)\n                (addTickSyntaxExpr hpcSrcSpan ret)\naddTickStmt _isGuard (BindStmt x pat e bind fail) = do\n        liftM4 (BindStmt x)\n                (addTickLPat pat)\n                (addTickLHsExprRHS e)\n                (addTickSyntaxExpr hpcSrcSpan bind)\n                (addTickSyntaxExpr hpcSrcSpan fail)\naddTickStmt isGuard (BodyStmt x e bind' guard') = do\n        liftM3 (BodyStmt x)\n                (addTick isGuard e)\n                (addTickSyntaxExpr hpcSrcSpan bind')\n                (addTickSyntaxExpr hpcSrcSpan guard')\naddTickStmt _isGuard (LetStmt x (dL->L l binds)) = do\n        liftM (LetStmt x . cL l)\n                (addTickHsLocalBinds binds)\naddTickStmt isGuard (ParStmt x pairs mzipExpr bindExpr) = do\n    liftM3 (ParStmt x)\n        (mapM (addTickStmtAndBinders isGuard) pairs)\n        (unLoc <$> addTickLHsExpr (cL hpcSrcSpan mzipExpr))\n        (addTickSyntaxExpr hpcSrcSpan bindExpr)\naddTickStmt isGuard (ApplicativeStmt body_ty args mb_join) = do\n    args' <- mapM (addTickApplicativeArg isGuard) args\n    return (ApplicativeStmt body_ty args' mb_join)\n\naddTickStmt isGuard stmt@(TransStmt { trS_stmts = stmts\n                                    , trS_by = by, trS_using = using\n                                    , trS_ret = returnExpr, trS_bind = bindExpr\n                                    , trS_fmap = liftMExpr }) = do\n    t_s <- addTickLStmts isGuard stmts\n    t_y <- fmapMaybeM  addTickLHsExprRHS by\n    t_u <- addTickLHsExprRHS using\n    t_f <- addTickSyntaxExpr hpcSrcSpan returnExpr\n    t_b <- addTickSyntaxExpr hpcSrcSpan bindExpr\n    t_m <- fmap unLoc (addTickLHsExpr (cL hpcSrcSpan liftMExpr))\n    return $ stmt { trS_stmts = t_s, trS_by = t_y, trS_using = t_u\n                  , trS_ret = t_f, trS_bind = t_b, trS_fmap = t_m }\n\naddTickStmt isGuard stmt@(RecStmt {})\n  = do { stmts' <- addTickLStmts isGuard (recS_stmts stmt)\n       ; ret'   <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt)\n       ; mfix'  <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt)\n       ; bind'  <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt)\n       ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'\n                      , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }\n\naddTickStmt _ (XStmtLR _) = panic \"addTickStmt\"\n\naddTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)\naddTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e\n                  | otherwise          = addTickLHsExprRHS e\n\naddTickApplicativeArg\n  :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)\n  -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc)\naddTickApplicativeArg isGuard (op, arg) =\n  liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)\n where\n  addTickArg (ApplicativeArgOne x pat expr isBody) =\n    (ApplicativeArgOne x)\n      <$> addTickLPat pat\n      <*> addTickLHsExpr expr\n      <*> pure isBody\n  addTickArg (ApplicativeArgMany x stmts ret pat) =\n    (ApplicativeArgMany x)\n      <$> addTickLStmts isGuard stmts\n      <*> (unLoc <$> addTickLHsExpr (cL hpcSrcSpan ret))\n      <*> addTickLPat pat\n  addTickArg (XApplicativeArg _) = panic \"addTickApplicativeArg\"\n\naddTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc\n                      -> TM (ParStmtBlock GhcTc GhcTc)\naddTickStmtAndBinders isGuard (ParStmtBlock x stmts ids returnExpr) =\n    liftM3 (ParStmtBlock x)\n        (addTickLStmts isGuard stmts)\n        (return ids)\n        (addTickSyntaxExpr hpcSrcSpan returnExpr)\naddTickStmtAndBinders _ (XParStmtBlock{}) = panic \"addTickStmtAndBinders\"\n\naddTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)\naddTickHsLocalBinds (HsValBinds x binds) =\n        liftM (HsValBinds x)\n                (addTickHsValBinds binds)\naddTickHsLocalBinds (HsIPBinds x binds)  =\n        liftM (HsIPBinds x)\n                (addTickHsIPBinds binds)\naddTickHsLocalBinds (EmptyLocalBinds x)  = return (EmptyLocalBinds x)\naddTickHsLocalBinds (XHsLocalBindsLR x)  = return (XHsLocalBindsLR x)\n\naddTickHsValBinds :: HsValBindsLR GhcTc (GhcPass a)\n                  -> TM (HsValBindsLR GhcTc (GhcPass b))\naddTickHsValBinds (XValBindsLR (NValBinds binds sigs)) = do\n        b <- liftM2 NValBinds\n                (mapM (\\ (rec,binds') ->\n                                liftM2 (,)\n                                        (return rec)\n                                        (addTickLHsBinds binds'))\n                        binds)\n                (return sigs)\n        return $ XValBindsLR b\naddTickHsValBinds _ = panic \"addTickHsValBinds\"\n\naddTickHsIPBinds :: HsIPBinds GhcTc -> TM (HsIPBinds GhcTc)\naddTickHsIPBinds (IPBinds dictbinds ipbinds) =\n        liftM2 IPBinds\n                (return dictbinds)\n                (mapM (liftL (addTickIPBind)) ipbinds)\naddTickHsIPBinds (XHsIPBinds x) = return (XHsIPBinds x)\n\naddTickIPBind :: IPBind GhcTc -> TM (IPBind GhcTc)\naddTickIPBind (IPBind x nm e) =\n        liftM2 (IPBind x)\n                (return nm)\n                (addTickLHsExpr e)\naddTickIPBind (XIPBind x) = return (XIPBind x)\n\n-- There is no location here, so we might need to use a context location??\naddTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)\naddTickSyntaxExpr pos syn@(SyntaxExpr { syn_expr = x }) = do\n        x' <- fmap unLoc (addTickLHsExpr (cL pos x))\n        return $ syn { syn_expr = x' }\n-- we do not walk into patterns.\naddTickLPat :: LPat GhcTc -> TM (LPat GhcTc)\naddTickLPat pat = return pat\n\naddTickHsCmdTop :: HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)\naddTickHsCmdTop (HsCmdTop x cmd) =\n        liftM2 HsCmdTop\n                (return x)\n                (addTickLHsCmd cmd)\naddTickHsCmdTop (XCmdTop{}) = panic \"addTickHsCmdTop\"\n\naddTickLHsCmd ::  LHsCmd GhcTc -> TM (LHsCmd GhcTc)\naddTickLHsCmd (dL->L pos c0) = do\n        c1 <- addTickHsCmd c0\n        return $ cL pos c1\n\naddTickHsCmd :: HsCmd GhcTc -> TM (HsCmd GhcTc)\naddTickHsCmd (HsCmdLam x matchgroup) =\n        liftM (HsCmdLam x) (addTickCmdMatchGroup matchgroup)\naddTickHsCmd (HsCmdApp x c e) =\n        liftM2 (HsCmdApp x) (addTickLHsCmd c) (addTickLHsExpr e)\n{-\naddTickHsCmd (OpApp e1 c2 fix c3) =\n        liftM4 OpApp\n                (addTickLHsExpr e1)\n                (addTickLHsCmd c2)\n                (return fix)\n                (addTickLHsCmd c3)\n-}\naddTickHsCmd (HsCmdPar x e) = liftM (HsCmdPar x) (addTickLHsCmd e)\naddTickHsCmd (HsCmdCase x e mgs) =\n        liftM2 (HsCmdCase x)\n                (addTickLHsExpr e)\n                (addTickCmdMatchGroup mgs)\naddTickHsCmd (HsCmdIf x cnd e1 c2 c3) =\n        liftM3 (HsCmdIf x cnd)\n                (addBinTickLHsExpr (BinBox CondBinBox) e1)\n                (addTickLHsCmd c2)\n                (addTickLHsCmd c3)\naddTickHsCmd (HsCmdLet x (dL->L l binds) c) =\n        bindLocals (collectLocalBinders binds) $\n          liftM2 (HsCmdLet x . cL l)\n                   (addTickHsLocalBinds binds) -- to think about: !patterns.\n                   (addTickLHsCmd c)\naddTickHsCmd (HsCmdDo srcloc (dL->L l stmts))\n  = do { (stmts', _) <- addTickLCmdStmts' stmts (return ())\n       ; return (HsCmdDo srcloc (cL l stmts')) }\n\naddTickHsCmd (HsCmdArrApp  arr_ty e1 e2 ty1 lr) =\n        liftM5 HsCmdArrApp\n               (return arr_ty)\n               (addTickLHsExpr e1)\n               (addTickLHsExpr e2)\n               (return ty1)\n               (return lr)\naddTickHsCmd (HsCmdArrForm x e f fix cmdtop) =\n        liftM4 (HsCmdArrForm x)\n               (addTickLHsExpr e)\n               (return f)\n               (return fix)\n               (mapM (liftL (addTickHsCmdTop)) cmdtop)\n\naddTickHsCmd (HsCmdWrap x w cmd)\n  = liftM2 (HsCmdWrap x) (return w) (addTickHsCmd cmd)\n\naddTickHsCmd e@(XCmd {})  = pprPanic \"addTickHsCmd\" (ppr e)\n\n-- Others should never happen in a command context.\n--addTickHsCmd e  = pprPanic \"addTickHsCmd\" (ppr e)\n\naddTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)\n                     -> TM (MatchGroup GhcTc (LHsCmd GhcTc))\naddTickCmdMatchGroup mg@(MG { mg_alts = (dL->L l matches) }) = do\n  matches' <- mapM (liftL addTickCmdMatch) matches\n  return $ mg { mg_alts = cL l matches' }\naddTickCmdMatchGroup (XMatchGroup _) = panic \"addTickCmdMatchGroup\"\n\naddTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))\naddTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =\n  bindLocals (collectPatsBinders pats) $ do\n    gRHSs' <- addTickCmdGRHSs gRHSs\n    return $ match { m_grhss = gRHSs' }\naddTickCmdMatch (XMatch _) = panic \"addTickCmdMatch\"\n\naddTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))\naddTickCmdGRHSs (GRHSs x guarded (dL->L l local_binds)) = do\n  bindLocals binders $ do\n    local_binds' <- addTickHsLocalBinds local_binds\n    guarded' <- mapM (liftL addTickCmdGRHS) guarded\n    return $ GRHSs x guarded' (cL l local_binds')\n  where\n    binders = collectLocalBinders local_binds\naddTickCmdGRHSs (XGRHSs _) = panic \"addTickCmdGRHSs\"\n\naddTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))\n-- The *guards* are *not* Cmds, although the body is\n-- C.f. addTickGRHS for the BinBox stuff\naddTickCmdGRHS (GRHS x stmts cmd)\n  = do { (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox)\n                                   stmts (addTickLHsCmd cmd)\n       ; return $ GRHS x stmts' expr' }\naddTickCmdGRHS (XGRHS _) = panic \"addTickCmdGRHS\"\n\naddTickLCmdStmts :: [LStmt GhcTc (LHsCmd GhcTc)]\n                 -> TM [LStmt GhcTc (LHsCmd GhcTc)]\naddTickLCmdStmts stmts = do\n  (stmts, _) <- addTickLCmdStmts' stmts (return ())\n  return stmts\n\naddTickLCmdStmts' :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM a\n                  -> TM ([LStmt GhcTc (LHsCmd GhcTc)], a)\naddTickLCmdStmts' lstmts res\n  = bindLocals binders $ do\n        lstmts' <- mapM (liftL addTickCmdStmt) lstmts\n        a <- res\n        return (lstmts', a)\n  where\n        binders = collectLStmtsBinders lstmts\n\naddTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))\naddTickCmdStmt (BindStmt x pat c bind fail) = do\n        liftM4 (BindStmt x)\n                (addTickLPat pat)\n                (addTickLHsCmd c)\n                (return bind)\n                (return fail)\naddTickCmdStmt (LastStmt x c noret ret) = do\n        liftM3 (LastStmt x)\n                (addTickLHsCmd c)\n                (pure noret)\n                (addTickSyntaxExpr hpcSrcSpan ret)\naddTickCmdStmt (BodyStmt x c bind' guard') = do\n        liftM3 (BodyStmt x)\n                (addTickLHsCmd c)\n                (addTickSyntaxExpr hpcSrcSpan bind')\n                (addTickSyntaxExpr hpcSrcSpan guard')\naddTickCmdStmt (LetStmt x (dL->L l binds)) = do\n        liftM (LetStmt x . cL l)\n                (addTickHsLocalBinds binds)\naddTickCmdStmt stmt@(RecStmt {})\n  = do { stmts' <- addTickLCmdStmts (recS_stmts stmt)\n       ; ret'   <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt)\n       ; mfix'  <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt)\n       ; bind'  <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt)\n       ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'\n                      , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }\naddTickCmdStmt ApplicativeStmt{} =\n  panic \"ToDo: addTickCmdStmt ApplicativeLastStmt\"\naddTickCmdStmt XStmtLR{} =\n  panic \"addTickCmdStmt XStmtLR\"\n\n-- Others should never happen in a command context.\naddTickCmdStmt stmt  = pprPanic \"addTickHsCmd\" (ppr stmt)\n\naddTickHsRecordBinds :: HsRecordBinds GhcTc -> TM (HsRecordBinds GhcTc)\naddTickHsRecordBinds (HsRecFields fields dd)\n  = do  { fields' <- mapM addTickHsRecField fields\n        ; return (HsRecFields fields' dd) }\n\naddTickHsRecField :: LHsRecField' id (LHsExpr GhcTc)\n                  -> TM (LHsRecField' id (LHsExpr GhcTc))\naddTickHsRecField (dL->L l (HsRecField id expr pun))\n        = do { expr' <- addTickLHsExpr expr\n             ; return (cL l (HsRecField id expr' pun)) }\n\n\naddTickArithSeqInfo :: ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)\naddTickArithSeqInfo (From e1) =\n        liftM From\n                (addTickLHsExpr e1)\naddTickArithSeqInfo (FromThen e1 e2) =\n        liftM2 FromThen\n                (addTickLHsExpr e1)\n                (addTickLHsExpr e2)\naddTickArithSeqInfo (FromTo e1 e2) =\n        liftM2 FromTo\n                (addTickLHsExpr e1)\n                (addTickLHsExpr e2)\naddTickArithSeqInfo (FromThenTo e1 e2 e3) =\n        liftM3 FromThenTo\n                (addTickLHsExpr e1)\n                (addTickLHsExpr e2)\n                (addTickLHsExpr e3)\n\ndata TickTransState = TT { tickBoxCount:: Int\n                         , mixEntries  :: [MixEntry_]\n                         , ccIndices   :: CostCentreState\n                         }\n\ndata TickTransEnv = TTE { fileName     :: FastString\n                        , density      :: TickDensity\n                        , tte_dflags   :: DynFlags\n                        , exports      :: NameSet\n                        , inlines      :: VarSet\n                        , declPath     :: [String]\n                        , inScope      :: VarSet\n                        , blackList    :: Map SrcSpan ()\n                        , this_mod     :: Module\n                        , tickishType  :: TickishType\n                        }\n\n--      deriving Show\n\ndata TickishType = ProfNotes | HpcTicks | Breakpoints | SourceNotes\n                 deriving (Eq)\n\ncoveragePasses :: DynFlags -> [TickishType]\ncoveragePasses dflags =\n    ifa (hscTarget dflags == HscInterpreted) Breakpoints $\n    ifa (gopt Opt_Hpc dflags)                HpcTicks $\n    ifa (gopt Opt_SccProfilingOn dflags &&\n         profAuto dflags /= NoProfAuto)      ProfNotes $\n    ifa (debugLevel dflags > 0)              SourceNotes []\n  where ifa f x xs | f         = x:xs\n                   | otherwise = xs\n\n-- | Tickishs that only make sense when their source code location\n-- refers to the current file. This might not always be true due to\n-- LINE pragmas in the code - which would confuse at least HPC.\ntickSameFileOnly :: TickishType -> Bool\ntickSameFileOnly HpcTicks = True\ntickSameFileOnly _other   = False\n\ntype FreeVars = OccEnv Id\nnoFVs :: FreeVars\nnoFVs = emptyOccEnv\n\n-- Note [freevars]\n--   For breakpoints we want to collect the free variables of an\n--   expression for pinning on the HsTick.  We don't want to collect\n--   *all* free variables though: in particular there's no point pinning\n--   on free variables that are will otherwise be in scope at the GHCi\n--   prompt, which means all top-level bindings.  Unfortunately detecting\n--   top-level bindings isn't easy (collectHsBindsBinders on the top-level\n--   bindings doesn't do it), so we keep track of a set of \"in-scope\"\n--   variables in addition to the free variables, and the former is used\n--   to filter additions to the latter.  This gives us complete control\n--   over what free variables we track.\n\ndata TM a = TM { unTM :: TickTransEnv -> TickTransState -> (a,FreeVars,TickTransState) }\n        -- a combination of a state monad (TickTransState) and a writer\n        -- monad (FreeVars).\n\ninstance Functor TM where\n    fmap = liftM\n\ninstance Applicative TM where\n    pure a = TM $ \\ _env st -> (a,noFVs,st)\n    (<*>) = ap\n\ninstance Monad TM where\n  (TM m) >>= k = TM $ \\ env st ->\n                                case m env st of\n                                  (r1,fv1,st1) ->\n                                     case unTM (k r1) env st1 of\n                                       (r2,fv2,st2) ->\n                                          (r2, fv1 `plusOccEnv` fv2, st2)\n\ninstance HasDynFlags TM where\n  getDynFlags = TM $ \\ env st -> (tte_dflags env, noFVs, st)\n\n-- | Get the next HPC cost centre index for a given centre name\ngetCCIndexM :: FastString -> TM CostCentreIndex\ngetCCIndexM n = TM $ \\_ st -> let (idx, is') = getCCIndex n $\n                                                 ccIndices st\n                              in (idx, noFVs, st { ccIndices = is' })\n\ngetState :: TM TickTransState\ngetState = TM $ \\ _ st -> (st, noFVs, st)\n\nsetState :: (TickTransState -> TickTransState) -> TM ()\nsetState f = TM $ \\ _ st -> ((), noFVs, f st)\n\ngetEnv :: TM TickTransEnv\ngetEnv = TM $ \\ env st -> (env, noFVs, st)\n\nwithEnv :: (TickTransEnv -> TickTransEnv) -> TM a -> TM a\nwithEnv f (TM m) = TM $ \\ env st ->\n                                 case m (f env) st of\n                                   (a, fvs, st') -> (a, fvs, st')\n\ngetDensity :: TM TickDensity\ngetDensity = TM $ \\env st -> (density env, noFVs, st)\n\nifDensity :: TickDensity -> TM a -> TM a -> TM a\nifDensity d th el = do d0 <- getDensity; if d == d0 then th else el\n\ngetFreeVars :: TM a -> TM (FreeVars, a)\ngetFreeVars (TM m)\n  = TM $ \\ env st -> case m env st of (a, fv, st') -> ((fv,a), fv, st')\n\nfreeVar :: Id -> TM ()\nfreeVar id = TM $ \\ env st ->\n                if id `elemVarSet` inScope env\n                   then ((), unitOccEnv (nameOccName (idName id)) id, st)\n                   else ((), noFVs, st)\n\naddPathEntry :: String -> TM a -> TM a\naddPathEntry nm = withEnv (\\ env -> env { declPath = declPath env ++ [nm] })\n\ngetPathEntry :: TM [String]\ngetPathEntry = declPath `liftM` getEnv\n\ngetFileName :: TM FastString\ngetFileName = fileName `liftM` getEnv\n\nisGoodSrcSpan' :: SrcSpan -> Bool\nisGoodSrcSpan' pos@(RealSrcSpan _) = srcSpanStart pos /= srcSpanEnd pos\nisGoodSrcSpan' (UnhelpfulSpan _) = False\n\nisGoodTickSrcSpan :: SrcSpan -> TM Bool\nisGoodTickSrcSpan pos = do\n  file_name <- getFileName\n  tickish <- tickishType `liftM` getEnv\n  let need_same_file = tickSameFileOnly tickish\n      same_file      = Just file_name == srcSpanFileName_maybe pos\n  return (isGoodSrcSpan' pos && (not need_same_file || same_file))\n\nifGoodTickSrcSpan :: SrcSpan -> TM a -> TM a -> TM a\nifGoodTickSrcSpan pos then_code else_code = do\n  good <- isGoodTickSrcSpan pos\n  if good then then_code else else_code\n\nbindLocals :: [Id] -> TM a -> TM a\nbindLocals new_ids (TM m)\n  = TM $ \\ env st ->\n                 case m env{ inScope = inScope env `extendVarSetList` new_ids } st of\n                   (r, fv, st') -> (r, fv `delListFromOccEnv` occs, st')\n  where occs = [ nameOccName (idName id) | id <- new_ids ]\n\nisBlackListed :: SrcSpan -> TM Bool\nisBlackListed pos = TM $ \\ env st ->\n              case Map.lookup pos (blackList env) of\n                Nothing -> (False,noFVs,st)\n                Just () -> (True,noFVs,st)\n\n-- the tick application inherits the source position of its\n-- expression argument to support nested box allocations\nallocTickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> TM (HsExpr GhcTc)\n             -> TM (LHsExpr GhcTc)\nallocTickBox boxLabel countEntries topOnly pos m =\n  ifGoodTickSrcSpan pos (do\n    (fvs, e) <- getFreeVars m\n    env <- getEnv\n    tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env)\n    return (cL pos (HsTick noExt tickish (cL pos e)))\n  ) (do\n    e <- m\n    return (cL pos e)\n  )\n\n-- the tick application inherits the source position of its\n-- expression argument to support nested box allocations\nallocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars\n              -> TM (Maybe (Tickish Id))\nallocATickBox boxLabel countEntries topOnly  pos fvs =\n  ifGoodTickSrcSpan pos (do\n    let\n      mydecl_path = case boxLabel of\n                      TopLevelBox x -> x\n                      LocalBox xs  -> xs\n                      _ -> panic \"allocATickBox\"\n    tickish <- mkTickish boxLabel countEntries topOnly pos fvs mydecl_path\n    return (Just tickish)\n  ) (return Nothing)\n\n\nmkTickish :: BoxLabel -> Bool -> Bool -> SrcSpan -> OccEnv Id -> [String]\n          -> TM (Tickish Id)\nmkTickish boxLabel countEntries topOnly pos fvs decl_path = do\n\n  let ids = filter (not . isUnliftedType . idType) $ occEnvElts fvs\n          -- unlifted types cause two problems here:\n          --   * we can't bind them  at the GHCi prompt\n          --     (bindLocalsAtBreakpoint already fliters them out),\n          --   * the simplifier might try to substitute a literal for\n          --     the Id, and we can't handle that.\n\n      me = (pos, decl_path, map (nameOccName.idName) ids, boxLabel)\n\n      cc_name | topOnly   = head decl_path\n              | otherwise = concat (intersperse \".\" decl_path)\n\n  dflags <- getDynFlags\n  env <- getEnv\n  case tickishType env of\n    HpcTicks -> do\n      c <- liftM tickBoxCount getState\n      setState $ \\st -> st { tickBoxCount = c + 1\n                           , mixEntries = me : mixEntries st }\n      return $ HpcTick (this_mod env) c\n\n    ProfNotes -> do\n      let nm = mkFastString cc_name\n      flavour <- HpcCC <$> getCCIndexM nm\n      let cc = mkUserCC nm (this_mod env) pos flavour\n          count = countEntries && gopt Opt_ProfCountEntries dflags\n      return $ ProfNote cc count True{-scopes-}\n\n    Breakpoints -> do\n      c <- liftM tickBoxCount getState\n      setState $ \\st -> st { tickBoxCount = c + 1\n                           , mixEntries = me:mixEntries st }\n      return $ Breakpoint c ids\n\n    SourceNotes | RealSrcSpan pos' <- pos ->\n      return $ SourceNote pos' cc_name\n\n    _otherwise -> panic \"mkTickish: bad source span!\"\n\n\nallocBinTickBox :: (Bool -> BoxLabel) -> SrcSpan -> TM (HsExpr GhcTc)\n                -> TM (LHsExpr GhcTc)\nallocBinTickBox boxLabel pos m = do\n  env <- getEnv\n  case tickishType env of\n    HpcTicks -> do e <- liftM (cL pos) m\n                   ifGoodTickSrcSpan pos\n                     (mkBinTickBoxHpc boxLabel pos e)\n                     (return e)\n    _other   -> allocTickBox (ExpBox False) False False pos m\n\nmkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc\n                -> TM (LHsExpr GhcTc)\nmkBinTickBoxHpc boxLabel pos e =\n TM $ \\ env st ->\n  let meT = (pos,declPath env, [],boxLabel True)\n      meF = (pos,declPath env, [],boxLabel False)\n      meE = (pos,declPath env, [],ExpBox False)\n      c = tickBoxCount st\n      mes = mixEntries st\n  in\n     ( cL pos $ HsTick noExt (HpcTick (this_mod env) c)\n          $ cL pos $ HsBinTick noExt (c+1) (c+2) e\n   -- notice that F and T are reversed,\n   -- because we are building the list in\n   -- reverse...\n     , noFVs\n     , st {tickBoxCount=c+3 , mixEntries=meF:meT:meE:mes}\n     )\n\nmkHpcPos :: SrcSpan -> HpcPos\nmkHpcPos pos@(RealSrcSpan s)\n   | isGoodSrcSpan' pos = toHpcPos (srcSpanStartLine s,\n                                    srcSpanStartCol s,\n                                    srcSpanEndLine s,\n                                    srcSpanEndCol s - 1)\n                              -- the end column of a SrcSpan is one\n                              -- greater than the last column of the\n                              -- span (see SrcLoc), whereas HPC\n                              -- expects to the column range to be\n                              -- inclusive, hence we subtract one above.\nmkHpcPos _ = panic \"bad source span; expected such spans to be filtered out\"\n\nhpcSrcSpan :: SrcSpan\nhpcSrcSpan = mkGeneralSrcSpan (fsLit \"Haskell Program Coverage internals\")\n\nmatchesOneOfMany :: [LMatch GhcTc body] -> Bool\nmatchesOneOfMany lmatches = sum (map matchCount lmatches) > 1\n  where\n        matchCount (dL->L _ (Match { m_grhss = GRHSs _ grhss _ }))\n          = length grhss\n        matchCount (dL->L _ (Match { m_grhss = XGRHSs _ }))\n          = panic \"matchesOneOfMany\"\n        matchCount (dL->L _ (XMatch _)) = panic \"matchesOneOfMany\"\n        matchCount _ = panic \"matchCount: Impossible Match\" -- due to #15884\n\ntype MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)\n\n-- For the hash value, we hash everything: the file name,\n--  the timestamp of the original source file, the tab stop,\n--  and the mix entries. We cheat, and hash the show'd string.\n-- This hash only has to be hashed at Mix creation time,\n-- and is for sanity checking only.\n\nmixHash :: FilePath -> UTCTime -> Int -> [MixEntry] -> Int\nmixHash file tm tabstop entries = fromIntegral $ hashString\n        (show $ Mix file tm 0 tabstop entries)\n\n{-\n************************************************************************\n*                                                                      *\n*              initialisation\n*                                                                      *\n************************************************************************\n\nEach module compiled with -fhpc declares an initialisation function of\nthe form `hpc_init_<module>()`, which is emitted into the _stub.c file\nand annotated with __attribute__((constructor)) so that it gets\nexecuted at startup time.\n\nThe function's purpose is to call hs_hpc_module to register this\nmodule with the RTS, and it looks something like this:\n\nstatic void hpc_init_Main(void) __attribute__((constructor));\nstatic void hpc_init_Main(void)\n{extern StgWord64 _hpc_tickboxes_Main_hpc[];\n hs_hpc_module(\"Main\",8,1150288664,_hpc_tickboxes_Main_hpc);}\n-}\n\nhpcInitCode :: Module -> HpcInfo -> SDoc\nhpcInitCode _ (NoHpcInfo {}) = Outputable.empty\nhpcInitCode this_mod (HpcInfo tickCount hashNo)\n = vcat\n    [ text \"static void hpc_init_\" <> ppr this_mod\n         <> text \"(void) __attribute__((constructor));\"\n    , text \"static void hpc_init_\" <> ppr this_mod <> text \"(void)\"\n    , braces (vcat [\n        text \"extern StgWord64 \" <> tickboxes <>\n               text \"[]\" <> semi,\n        text \"hs_hpc_module\" <>\n          parens (hcat (punctuate comma [\n              doubleQuotes full_name_str,\n              int tickCount, -- really StgWord32\n              int hashNo,    -- really StgWord32\n              tickboxes\n            ])) <> semi\n       ])\n    ]\n  where\n    tickboxes = ppr (mkHpcTicksLabel $ this_mod)\n\n    module_name  = hcat (map (text.charToC) $ BS.unpack $\n                         bytesFS (moduleNameFS (Module.moduleName this_mod)))\n    package_name = hcat (map (text.charToC) $ BS.unpack $\n                         bytesFS (unitIdFS  (moduleUnitId this_mod)))\n    full_name_str\n       | moduleUnitId this_mod == mainUnitId\n       = module_name\n       | otherwise\n       = package_name <> char '/' <> module_name\n", "num_lines": 1365}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nDesugaring arrow commands\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule DsArrows ( dsProcExpr ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Match\nimport DsUtils\nimport DsMonad\n\nimport HsSyn    hiding (collectPatBinders, collectPatsBinders,\n                        collectLStmtsBinders, collectLStmtBinders,\n                        collectStmtBinders )\nimport TcHsSyn\nimport qualified HsUtils\n\n-- NB: The desugarer, which straddles the source and Core worlds, sometimes\n--     needs to see source types (newtypes etc), and sometimes not\n--     So WATCH OUT; check each use of split*Ty functions.\n-- Sigh.  This is a pain.\n\nimport {-# SOURCE #-} DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds,\n                               dsSyntaxExpr )\n\nimport TcType\nimport Type ( splitPiTy )\nimport TcEvidence\nimport CoreSyn\nimport CoreFVs\nimport CoreUtils\nimport MkCore\nimport DsBinds (dsHsWrapper)\n\nimport Name\nimport Id\nimport ConLike\nimport TysWiredIn\nimport BasicTypes\nimport PrelNames\nimport Outputable\nimport Bag\nimport VarSet\nimport SrcLoc\nimport ListSetOps( assocMaybe )\nimport Data.List\nimport Util\nimport UniqDSet\n\ndata DsCmdEnv = DsCmdEnv {\n        arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr\n    }\n\nmkCmdEnv :: CmdSyntaxTable GhcTc -> DsM ([CoreBind], DsCmdEnv)\n-- See Note [CmdSyntaxTable] in HsExpr\nmkCmdEnv tc_meths\n  = do { (meth_binds, prs) <- mapAndUnzipM mk_bind tc_meths\n\n       -- NB: Some of these lookups might fail, but that's OK if the\n       -- symbol is never used. That's why we use Maybe first and then\n       -- panic. An eager panic caused trouble in typecheck/should_compile/tc192\n       ; let the_arr_id     = assocMaybe prs arrAName\n             the_compose_id = assocMaybe prs composeAName\n             the_first_id   = assocMaybe prs firstAName\n             the_app_id     = assocMaybe prs appAName\n             the_choice_id  = assocMaybe prs choiceAName\n             the_loop_id    = assocMaybe prs loopAName\n\n           -- used as an argument in, e.g., do_premap\n       ; check_lev_poly 3 the_arr_id\n\n           -- used as an argument in, e.g., dsCmdStmt/BodyStmt\n       ; check_lev_poly 5 the_compose_id\n\n           -- used as an argument in, e.g., dsCmdStmt/BodyStmt\n       ; check_lev_poly 4 the_first_id\n\n           -- the result of the_app_id is used as an argument in, e.g.,\n           -- dsCmd/HsCmdArrApp/HsHigherOrderApp\n       ; check_lev_poly 2 the_app_id\n\n           -- used as an argument in, e.g., HsCmdIf\n       ; check_lev_poly 5 the_choice_id\n\n           -- used as an argument in, e.g., RecStmt\n       ; check_lev_poly 4 the_loop_id\n\n       ; return (meth_binds, DsCmdEnv {\n               arr_id     = Var (unmaybe the_arr_id arrAName),\n               compose_id = Var (unmaybe the_compose_id composeAName),\n               first_id   = Var (unmaybe the_first_id firstAName),\n               app_id     = Var (unmaybe the_app_id appAName),\n               choice_id  = Var (unmaybe the_choice_id choiceAName),\n               loop_id    = Var (unmaybe the_loop_id loopAName)\n             }) }\n  where\n    mk_bind (std_name, expr)\n      = do { rhs <- dsExpr expr\n           ; id <- newSysLocalDs (exprType rhs)\n           -- no check needed; these are functions\n           ; return (NonRec id rhs, (std_name, id)) }\n\n    unmaybe Nothing name = pprPanic \"mkCmdEnv\" (text \"Not found:\" <+> ppr name)\n    unmaybe (Just id) _  = id\n\n      -- returns the result type of a pi-type (that is, a forall or a function)\n      -- Note that this result type may be ill-scoped.\n    res_type :: Type -> Type\n    res_type ty = res_ty\n      where\n        (_, res_ty) = splitPiTy ty\n\n    check_lev_poly :: Int -- arity\n                   -> Maybe Id -> DsM ()\n    check_lev_poly _     Nothing = return ()\n    check_lev_poly arity (Just id)\n      = dsNoLevPoly (nTimes arity res_type (idType id))\n          (text \"In the result of the function\" <+> quotes (ppr id))\n\n\n-- arr :: forall b c. (b -> c) -> a b c\ndo_arr :: DsCmdEnv -> Type -> Type -> CoreExpr -> CoreExpr\ndo_arr ids b_ty c_ty f = mkApps (arr_id ids) [Type b_ty, Type c_ty, f]\n\n-- (>>>) :: forall b c d. a b c -> a c d -> a b d\ndo_compose :: DsCmdEnv -> Type -> Type -> Type ->\n                CoreExpr -> CoreExpr -> CoreExpr\ndo_compose ids b_ty c_ty d_ty f g\n  = mkApps (compose_id ids) [Type b_ty, Type c_ty, Type d_ty, f, g]\n\n-- first :: forall b c d. a b c -> a (b,d) (c,d)\ndo_first :: DsCmdEnv -> Type -> Type -> Type -> CoreExpr -> CoreExpr\ndo_first ids b_ty c_ty d_ty f\n  = mkApps (first_id ids) [Type b_ty, Type c_ty, Type d_ty, f]\n\n-- app :: forall b c. a (a b c, b) c\ndo_app :: DsCmdEnv -> Type -> Type -> CoreExpr\ndo_app ids b_ty c_ty = mkApps (app_id ids) [Type b_ty, Type c_ty]\n\n-- (|||) :: forall b d c. a b d -> a c d -> a (Either b c) d\n-- note the swapping of d and c\ndo_choice :: DsCmdEnv -> Type -> Type -> Type ->\n                CoreExpr -> CoreExpr -> CoreExpr\ndo_choice ids b_ty c_ty d_ty f g\n  = mkApps (choice_id ids) [Type b_ty, Type d_ty, Type c_ty, f, g]\n\n-- loop :: forall b d c. a (b,d) (c,d) -> a b c\n-- note the swapping of d and c\ndo_loop :: DsCmdEnv -> Type -> Type -> Type -> CoreExpr -> CoreExpr\ndo_loop ids b_ty c_ty d_ty f\n  = mkApps (loop_id ids) [Type b_ty, Type d_ty, Type c_ty, f]\n\n-- premap :: forall b c d. (b -> c) -> a c d -> a b d\n-- premap f g = arr f >>> g\ndo_premap :: DsCmdEnv -> Type -> Type -> Type ->\n                CoreExpr -> CoreExpr -> CoreExpr\ndo_premap ids b_ty c_ty d_ty f g\n   = do_compose ids b_ty c_ty d_ty (do_arr ids b_ty c_ty f) g\n\nmkFailExpr :: HsMatchContext Id -> Type -> DsM CoreExpr\nmkFailExpr ctxt ty\n  = mkErrorAppDs pAT_ERROR_ID ty (matchContextErrString ctxt)\n\n-- construct CoreExpr for \\ (a :: a_ty, b :: b_ty) -> a\nmkFstExpr :: Type -> Type -> DsM CoreExpr\nmkFstExpr a_ty b_ty = do\n    a_var <- newSysLocalDs a_ty\n    b_var <- newSysLocalDs b_ty\n    pair_var <- newSysLocalDs (mkCorePairTy a_ty b_ty)\n    return (Lam pair_var\n               (coreCasePair pair_var a_var b_var (Var a_var)))\n\n-- construct CoreExpr for \\ (a :: a_ty, b :: b_ty) -> b\nmkSndExpr :: Type -> Type -> DsM CoreExpr\nmkSndExpr a_ty b_ty = do\n    a_var <- newSysLocalDs a_ty\n    b_var <- newSysLocalDs b_ty\n    pair_var <- newSysLocalDs (mkCorePairTy a_ty b_ty)\n    return (Lam pair_var\n               (coreCasePair pair_var a_var b_var (Var b_var)))\n\n{-\nBuild case analysis of a tuple.  This cannot be done in the DsM monad,\nbecause the list of variables is typically not yet defined.\n-}\n\n-- coreCaseTuple [u1..] v [x1..xn] body\n--      = case v of v { (x1, .., xn) -> body }\n-- But the matching may be nested if the tuple is very big\n\ncoreCaseTuple :: UniqSupply -> Id -> [Id] -> CoreExpr -> CoreExpr\ncoreCaseTuple uniqs scrut_var vars body\n  = mkTupleCase uniqs vars body scrut_var (Var scrut_var)\n\ncoreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr\ncoreCasePair scrut_var var1 var2 body\n  = Case (Var scrut_var) scrut_var (exprType body)\n         [(DataAlt (tupleDataCon Boxed 2), [var1, var2], body)]\n\nmkCorePairTy :: Type -> Type -> Type\nmkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2]\n\nmkCorePairExpr :: CoreExpr -> CoreExpr -> CoreExpr\nmkCorePairExpr e1 e2 = mkCoreTup [e1, e2]\n\nmkCoreUnitExpr :: CoreExpr\nmkCoreUnitExpr = mkCoreTup []\n\n{-\nThe input is divided into a local environment, which is a flat tuple\n(unless it's too big), and a stack, which is a right-nested pair.\nIn general, the input has the form\n\n        ((x1,...,xn), (s1,...(sk,())...))\n\nwhere xi are the environment values, and si the ones on the stack,\nwith s1 being the \"top\", the first one to be matched with a lambda.\n-}\n\nenvStackType :: [Id] -> Type -> Type\nenvStackType ids stack_ty = mkCorePairTy (mkBigCoreVarTupTy ids) stack_ty\n\n-- splitTypeAt n (t1,... (tn,t)...) = ([t1, ..., tn], t)\nsplitTypeAt :: Int -> Type -> ([Type], Type)\nsplitTypeAt n ty\n  | n == 0 = ([], ty)\n  | otherwise = case tcTyConAppArgs ty of\n      [t, ty'] -> let (ts, ty_r) = splitTypeAt (n-1) ty' in (t:ts, ty_r)\n      _ -> pprPanic \"splitTypeAt\" (ppr ty)\n\n----------------------------------------------\n--              buildEnvStack\n--\n--      ((x1,...,xn),stk)\n\nbuildEnvStack :: [Id] -> Id -> CoreExpr\nbuildEnvStack env_ids stack_id\n  = mkCorePairExpr (mkBigCoreVarTup env_ids) (Var stack_id)\n\n----------------------------------------------\n--              matchEnvStack\n--\n--      \\ ((x1,...,xn),stk) -> body\n--      =>\n--      \\ pair ->\n--      case pair of (tup,stk) ->\n--      case tup of (x1,...,xn) ->\n--      body\n\nmatchEnvStack   :: [Id]         -- x1..xn\n                -> Id           -- stk\n                -> CoreExpr     -- e\n                -> DsM CoreExpr\nmatchEnvStack env_ids stack_id body = do\n    uniqs <- newUniqueSupply\n    tup_var <- newSysLocalDs (mkBigCoreVarTupTy env_ids)\n    let match_env = coreCaseTuple uniqs tup_var env_ids body\n    pair_id <- newSysLocalDs (mkCorePairTy (idType tup_var) (idType stack_id))\n    return (Lam pair_id (coreCasePair pair_id tup_var stack_id match_env))\n\n----------------------------------------------\n--              matchEnv\n--\n--      \\ (x1,...,xn) -> body\n--      =>\n--      \\ tup ->\n--      case tup of (x1,...,xn) ->\n--      body\n\nmatchEnv :: [Id]        -- x1..xn\n         -> CoreExpr    -- e\n         -> DsM CoreExpr\nmatchEnv env_ids body = do\n    uniqs <- newUniqueSupply\n    tup_id <- newSysLocalDs (mkBigCoreVarTupTy env_ids)\n    return (Lam tup_id (coreCaseTuple uniqs tup_id env_ids body))\n\n----------------------------------------------\n--              matchVarStack\n--\n--      case (x1, ...(xn, s)...) -> e\n--      =>\n--      case z0 of (x1,z1) ->\n--      case zn-1 of (xn,s) ->\n--      e\nmatchVarStack :: [Id] -> Id -> CoreExpr -> DsM (Id, CoreExpr)\nmatchVarStack [] stack_id body = return (stack_id, body)\nmatchVarStack (param_id:param_ids) stack_id body = do\n    (tail_id, tail_code) <- matchVarStack param_ids stack_id body\n    pair_id <- newSysLocalDs (mkCorePairTy (idType param_id) (idType tail_id))\n    return (pair_id, coreCasePair pair_id param_id tail_id tail_code)\n\nmkHsEnvStackExpr :: [Id] -> Id -> LHsExpr GhcTc\nmkHsEnvStackExpr env_ids stack_id\n  = mkLHsTupleExpr [mkLHsVarTuple env_ids, nlHsVar stack_id]\n\n-- Translation of arrow abstraction\n\n-- D; xs |-a c : () --> t'      ---> c'\n-- --------------------------\n-- D |- proc p -> c :: a t t'   ---> premap (\\ p -> ((xs),())) c'\n--\n--              where (xs) is the tuple of variables bound by p\n\ndsProcExpr\n        :: LPat GhcTc\n        -> LHsCmdTop GhcTc\n        -> DsM CoreExpr\ndsProcExpr pat (dL->L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do\n    (meth_binds, meth_ids) <- mkCmdEnv ids\n    let locals = mkVarSet (collectPatBinders pat)\n    (core_cmd, _free_vars, env_ids)\n       <- dsfixCmd meth_ids locals unitTy cmd_ty cmd\n    let env_ty = mkBigCoreVarTupTy env_ids\n    let env_stk_ty = mkCorePairTy env_ty unitTy\n    let env_stk_expr = mkCorePairExpr (mkBigCoreVarTup env_ids) mkCoreUnitExpr\n    fail_expr <- mkFailExpr ProcExpr env_stk_ty\n    var <- selectSimpleMatchVarL pat\n    match_code <- matchSimply (Var var) ProcExpr pat env_stk_expr fail_expr\n    let pat_ty = hsLPatType pat\n    let proc_code = do_premap meth_ids pat_ty env_stk_ty cmd_ty\n                    (Lam var match_code)\n                    core_cmd\n    return (mkLets meth_binds proc_code)\ndsProcExpr _ _ = panic \"dsProcExpr\"\n\n{-\nTranslation of a command judgement of the form\n\n        D; xs |-a c : stk --> t\n\nto an expression e such that\n\n        D |- e :: a (xs, stk) t\n-}\n\ndsLCmd :: DsCmdEnv -> IdSet -> Type -> Type -> LHsCmd GhcTc -> [Id]\n       -> DsM (CoreExpr, DIdSet)\ndsLCmd ids local_vars stk_ty res_ty cmd env_ids\n  = dsCmd ids local_vars stk_ty res_ty (unLoc cmd) env_ids\n\ndsCmd   :: DsCmdEnv             -- arrow combinators\n        -> IdSet                -- set of local vars available to this command\n        -> Type                 -- type of the stack (right-nested tuple)\n        -> Type                 -- return type of the command\n        -> HsCmd GhcTc           -- command to desugar\n        -> [Id]           -- list of vars in the input to this command\n                                -- This is typically fed back,\n                                -- so don't pull on it too early\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet)         -- subset of local vars that occur free\n\n-- D |- fun :: a t1 t2\n-- D, xs |- arg :: t1\n-- -----------------------------\n-- D; xs |-a fun -< arg : stk --> t2\n--\n--              ---> premap (\\ ((xs), _stk) -> arg) fun\n\ndsCmd ids local_vars stack_ty res_ty\n        (HsCmdArrApp arrow_ty arrow arg HsFirstOrderApp _)\n        env_ids = do\n    let\n        (a_arg_ty, _res_ty') = tcSplitAppTy arrow_ty\n        (_a_ty, arg_ty) = tcSplitAppTy a_arg_ty\n    core_arrow <- dsLExprNoLP arrow\n    core_arg   <- dsLExpr arg\n    stack_id   <- newSysLocalDs stack_ty\n    core_make_arg <- matchEnvStack env_ids stack_id core_arg\n    return (do_premap ids\n              (envStackType env_ids stack_ty)\n              arg_ty\n              res_ty\n              core_make_arg\n              core_arrow,\n            exprFreeIdsDSet core_arg `uniqDSetIntersectUniqSet` local_vars)\n\n-- D, xs |- fun :: a t1 t2\n-- D, xs |- arg :: t1\n-- ------------------------------\n-- D; xs |-a fun -<< arg : stk --> t2\n--\n--              ---> premap (\\ ((xs), _stk) -> (fun, arg)) app\n\ndsCmd ids local_vars stack_ty res_ty\n        (HsCmdArrApp arrow_ty arrow arg HsHigherOrderApp _)\n        env_ids = do\n    let\n        (a_arg_ty, _res_ty') = tcSplitAppTy arrow_ty\n        (_a_ty, arg_ty) = tcSplitAppTy a_arg_ty\n\n    core_arrow <- dsLExpr arrow\n    core_arg   <- dsLExpr arg\n    stack_id   <- newSysLocalDs stack_ty\n    core_make_pair <- matchEnvStack env_ids stack_id\n          (mkCorePairExpr core_arrow core_arg)\n\n    return (do_premap ids\n              (envStackType env_ids stack_ty)\n              (mkCorePairTy arrow_ty arg_ty)\n              res_ty\n              core_make_pair\n              (do_app ids arg_ty res_ty),\n            (exprsFreeIdsDSet [core_arrow, core_arg])\n              `uniqDSetIntersectUniqSet` local_vars)\n\n-- D; ys |-a cmd : (t,stk) --> t'\n-- D, xs |-  exp :: t\n-- ------------------------\n-- D; xs |-a cmd exp : stk --> t'\n--\n--              ---> premap (\\ ((xs),stk) -> ((ys),(e,stk))) cmd\n\ndsCmd ids local_vars stack_ty res_ty (HsCmdApp _ cmd arg) env_ids = do\n    core_arg <- dsLExpr arg\n    let\n        arg_ty = exprType core_arg\n        stack_ty' = mkCorePairTy arg_ty stack_ty\n    (core_cmd, free_vars, env_ids')\n             <- dsfixCmd ids local_vars stack_ty' res_ty cmd\n    stack_id <- newSysLocalDs stack_ty\n    arg_id <- newSysLocalDsNoLP arg_ty\n    -- push the argument expression onto the stack\n    let\n        stack' = mkCorePairExpr (Var arg_id) (Var stack_id)\n        core_body = bindNonRec arg_id core_arg\n                        (mkCorePairExpr (mkBigCoreVarTup env_ids') stack')\n\n    -- match the environment and stack against the input\n    core_map <- matchEnvStack env_ids stack_id core_body\n    return (do_premap ids\n                      (envStackType env_ids stack_ty)\n                      (envStackType env_ids' stack_ty')\n                      res_ty\n                      core_map\n                      core_cmd,\n            free_vars `unionDVarSet`\n              (exprFreeIdsDSet core_arg `uniqDSetIntersectUniqSet` local_vars))\n\n-- D; ys |-a cmd : stk t'\n-- -----------------------------------------------\n-- D; xs |-a \\ p1 ... pk -> cmd : (t1,...(tk,stk)...) t'\n--\n--              ---> premap (\\ ((xs), (p1, ... (pk,stk)...)) -> ((ys),stk)) cmd\n\ndsCmd ids local_vars stack_ty res_ty\n        (HsCmdLam _ (MG { mg_alts\n          = (dL->L _ [dL->L _ (Match { m_pats  = pats\n                       , m_grhss = GRHSs _ [dL->L _ (GRHS _ [] body)] _ })]) }))\n        env_ids = do\n    let pat_vars = mkVarSet (collectPatsBinders pats)\n    let\n        local_vars' = pat_vars `unionVarSet` local_vars\n        (pat_tys, stack_ty') = splitTypeAt (length pats) stack_ty\n    (core_body, free_vars, env_ids')\n       <- dsfixCmd ids local_vars' stack_ty' res_ty body\n    param_ids <- mapM newSysLocalDsNoLP pat_tys\n    stack_id' <- newSysLocalDs stack_ty'\n\n    -- the expression is built from the inside out, so the actions\n    -- are presented in reverse order\n\n    let\n        -- build a new environment, plus what's left of the stack\n        core_expr = buildEnvStack env_ids' stack_id'\n        in_ty = envStackType env_ids stack_ty\n        in_ty' = envStackType env_ids' stack_ty'\n\n    fail_expr <- mkFailExpr LambdaExpr in_ty'\n    -- match the patterns against the parameters\n    match_code <- matchSimplys (map Var param_ids) LambdaExpr pats core_expr\n                    fail_expr\n    -- match the parameters against the top of the old stack\n    (stack_id, param_code) <- matchVarStack param_ids stack_id' match_code\n    -- match the old environment and stack against the input\n    select_code <- matchEnvStack env_ids stack_id param_code\n    return (do_premap ids in_ty in_ty' res_ty select_code core_body,\n            free_vars `uniqDSetMinusUniqSet` pat_vars)\n\ndsCmd ids local_vars stack_ty res_ty (HsCmdPar _ cmd) env_ids\n  = dsLCmd ids local_vars stack_ty res_ty cmd env_ids\n\n-- D, xs |- e :: Bool\n-- D; xs1 |-a c1 : stk --> t\n-- D; xs2 |-a c2 : stk --> t\n-- ----------------------------------------\n-- D; xs |-a if e then c1 else c2 : stk --> t\n--\n--              ---> premap (\\ ((xs),stk) ->\n--                       if e then Left ((xs1),stk) else Right ((xs2),stk))\n--                     (c1 ||| c2)\n\ndsCmd ids local_vars stack_ty res_ty (HsCmdIf _ mb_fun cond then_cmd else_cmd)\n        env_ids = do\n    core_cond <- dsLExpr cond\n    (core_then, fvs_then, then_ids)\n       <- dsfixCmd ids local_vars stack_ty res_ty then_cmd\n    (core_else, fvs_else, else_ids)\n       <- dsfixCmd ids local_vars stack_ty res_ty else_cmd\n    stack_id   <- newSysLocalDs stack_ty\n    either_con <- dsLookupTyCon eitherTyConName\n    left_con   <- dsLookupDataCon leftDataConName\n    right_con  <- dsLookupDataCon rightDataConName\n\n    let mk_left_expr ty1 ty2 e = mkCoreConApps left_con   [Type ty1,Type ty2, e]\n        mk_right_expr ty1 ty2 e = mkCoreConApps right_con [Type ty1,Type ty2, e]\n\n        in_ty = envStackType env_ids stack_ty\n        then_ty = envStackType then_ids stack_ty\n        else_ty = envStackType else_ids stack_ty\n        sum_ty = mkTyConApp either_con [then_ty, else_ty]\n        fvs_cond = exprFreeIdsDSet core_cond\n                   `uniqDSetIntersectUniqSet` local_vars\n\n        core_left  = mk_left_expr  then_ty else_ty\n                       (buildEnvStack then_ids stack_id)\n        core_right = mk_right_expr then_ty else_ty\n                       (buildEnvStack else_ids stack_id)\n\n    core_if <- case mb_fun of\n       Just fun -> do { fun_apps <- dsSyntaxExpr fun\n                                      [core_cond, core_left, core_right]\n                      ; matchEnvStack env_ids stack_id fun_apps }\n       Nothing  -> matchEnvStack env_ids stack_id $\n                   mkIfThenElse core_cond core_left core_right\n\n    return (do_premap ids in_ty sum_ty res_ty\n                core_if\n                (do_choice ids then_ty else_ty res_ty core_then core_else),\n        fvs_cond `unionDVarSet` fvs_then `unionDVarSet` fvs_else)\n\n{-\nCase commands are treated in much the same way as if commands\n(see above) except that there are more alternatives.  For example\n\n        case e of { p1 -> c1; p2 -> c2; p3 -> c3 }\n\nis translated to\n\n        premap (\\ ((xs)*ts) -> case e of\n                p1 -> (Left (Left (xs1)*ts))\n                p2 -> Left ((Right (xs2)*ts))\n                p3 -> Right ((xs3)*ts))\n        ((c1 ||| c2) ||| c3)\n\nThe idea is to extract the commands from the case, build a balanced tree\nof choices, and replace the commands with expressions that build tagged\ntuples, obtaining a case expression that can be desugared normally.\nTo build all this, we use triples describing segments of the list of\ncase bodies, containing the following fields:\n * a list of expressions of the form (Left|Right)* ((xs)*ts), to be put\n   into the case replacing the commands\n * a sum type that is the common type of these expressions, and also the\n   input type of the arrow\n * a CoreExpr for an arrow built by combining the translated command\n   bodies with |||.\n-}\n\ndsCmd ids local_vars stack_ty res_ty\n      (HsCmdCase _ exp (MG { mg_alts = (dL->L l matches)\n                           , mg_ext = MatchGroupTc arg_tys _\n                           , mg_origin = origin }))\n      env_ids = do\n    stack_id <- newSysLocalDs stack_ty\n\n    -- Extract and desugar the leaf commands in the case, building tuple\n    -- expressions that will (after tagging) replace these leaves\n\n    let\n        leaves = concatMap leavesMatch matches\n        make_branch (leaf, bound_vars) = do\n            (core_leaf, _fvs, leaf_ids)\n               <- dsfixCmd ids (bound_vars `unionVarSet` local_vars) stack_ty\n                    res_ty leaf\n            return ([mkHsEnvStackExpr leaf_ids stack_id],\n                    envStackType leaf_ids stack_ty,\n                    core_leaf)\n\n    branches <- mapM make_branch leaves\n    either_con <- dsLookupTyCon eitherTyConName\n    left_con <- dsLookupDataCon leftDataConName\n    right_con <- dsLookupDataCon rightDataConName\n    let\n        left_id  = HsConLikeOut noExt (RealDataCon left_con)\n        right_id = HsConLikeOut noExt (RealDataCon right_con)\n        left_expr  ty1 ty2 e = noLoc $ HsApp noExt\n                           (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) left_id ) e\n        right_expr ty1 ty2 e = noLoc $ HsApp noExt\n                           (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) right_id) e\n\n        -- Prefix each tuple with a distinct series of Left's and Right's,\n        -- in a balanced way, keeping track of the types.\n\n        merge_branches (builds1, in_ty1, core_exp1)\n                       (builds2, in_ty2, core_exp2)\n          = (map (left_expr in_ty1 in_ty2) builds1 ++\n                map (right_expr in_ty1 in_ty2) builds2,\n             mkTyConApp either_con [in_ty1, in_ty2],\n             do_choice ids in_ty1 in_ty2 res_ty core_exp1 core_exp2)\n        (leaves', sum_ty, core_choices) = foldb merge_branches branches\n\n        -- Replace the commands in the case with these tagged tuples,\n        -- yielding a HsExpr Id we can feed to dsExpr.\n\n        (_, matches') = mapAccumL (replaceLeavesMatch res_ty) leaves' matches\n        in_ty = envStackType env_ids stack_ty\n\n    core_body <- dsExpr (HsCase noExt exp\n                         (MG { mg_alts = cL l matches'\n                             , mg_ext = MatchGroupTc arg_tys sum_ty\n                             , mg_origin = origin }))\n        -- Note that we replace the HsCase result type by sum_ty,\n        -- which is the type of matches'\n\n    core_matches <- matchEnvStack env_ids stack_id core_body\n    return (do_premap ids in_ty sum_ty res_ty core_matches core_choices,\n            exprFreeIdsDSet core_body `uniqDSetIntersectUniqSet` local_vars)\n\n-- D; ys |-a cmd : stk --> t\n-- ----------------------------------\n-- D; xs |-a let binds in cmd : stk --> t\n--\n--              ---> premap (\\ ((xs),stk) -> let binds in ((ys),stk)) c\n\ndsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@(dL->L _ binds) body)\n                                                                    env_ids = do\n    let\n        defined_vars = mkVarSet (collectLocalBinders binds)\n        local_vars' = defined_vars `unionVarSet` local_vars\n\n    (core_body, _free_vars, env_ids')\n       <- dsfixCmd ids local_vars' stack_ty res_ty body\n    stack_id <- newSysLocalDs stack_ty\n    -- build a new environment, plus the stack, using the let bindings\n    core_binds <- dsLocalBinds lbinds (buildEnvStack env_ids' stack_id)\n    -- match the old environment and stack against the input\n    core_map <- matchEnvStack env_ids stack_id core_binds\n    return (do_premap ids\n                        (envStackType env_ids stack_ty)\n                        (envStackType env_ids' stack_ty)\n                        res_ty\n                        core_map\n                        core_body,\n        exprFreeIdsDSet core_binds `uniqDSetIntersectUniqSet` local_vars)\n\n-- D; xs |-a ss : t\n-- ----------------------------------\n-- D; xs |-a do { ss } : () --> t\n--\n--              ---> premap (\\ (env,stk) -> env) c\n\ndsCmd ids local_vars stack_ty res_ty do_block@(HsCmdDo stmts_ty\n                                               (dL->L loc stmts))\n                                                                   env_ids = do\n    putSrcSpanDs loc $\n      dsNoLevPoly stmts_ty\n        (text \"In the do-command:\" <+> ppr do_block)\n    (core_stmts, env_ids') <- dsCmdDo ids local_vars res_ty stmts env_ids\n    let env_ty = mkBigCoreVarTupTy env_ids\n    core_fst <- mkFstExpr env_ty stack_ty\n    return (do_premap ids\n                (mkCorePairTy env_ty stack_ty)\n                env_ty\n                res_ty\n                core_fst\n                core_stmts,\n        env_ids')\n\n-- D |- e :: forall e. a1 (e,stk1) t1 -> ... an (e,stkn) tn -> a (e,stk) t\n-- D; xs |-a ci :: stki --> ti\n-- -----------------------------------\n-- D; xs |-a (|e c1 ... cn|) :: stk --> t       ---> e [t_xs] c1 ... cn\n\ndsCmd _ local_vars _stack_ty _res_ty (HsCmdArrForm _ op _ _ args) env_ids = do\n    let env_ty = mkBigCoreVarTupTy env_ids\n    core_op <- dsLExpr op\n    (core_args, fv_sets) <- mapAndUnzipM (dsTrimCmdArg local_vars env_ids) args\n    return (mkApps (App core_op (Type env_ty)) core_args,\n            unionDVarSets fv_sets)\n\ndsCmd ids local_vars stack_ty res_ty (HsCmdWrap _ wrap cmd) env_ids = do\n    (core_cmd, env_ids') <- dsCmd ids local_vars stack_ty res_ty cmd env_ids\n    core_wrap <- dsHsWrapper wrap\n    return (core_wrap core_cmd, env_ids')\n\ndsCmd _ _ _ _ _ c = pprPanic \"dsCmd\" (ppr c)\n\n-- D; ys |-a c : stk --> t      (ys <= xs)\n-- ---------------------\n-- D; xs |-a c : stk --> t      ---> premap (\\ ((xs),stk) -> ((ys),stk)) c\n\ndsTrimCmdArg\n        :: IdSet                -- set of local vars available to this command\n        -> [Id]           -- list of vars in the input to this command\n        -> LHsCmdTop GhcTc       -- command argument to desugar\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet)         -- subset of local vars that occur free\ndsTrimCmdArg local_vars env_ids\n                       (dL->L _ (HsCmdTop\n                                 (CmdTopTc stack_ty cmd_ty ids) cmd )) = do\n    (meth_binds, meth_ids) <- mkCmdEnv ids\n    (core_cmd, free_vars, env_ids')\n       <- dsfixCmd meth_ids local_vars stack_ty cmd_ty cmd\n    stack_id <- newSysLocalDs stack_ty\n    trim_code\n      <- matchEnvStack env_ids stack_id (buildEnvStack env_ids' stack_id)\n    let\n        in_ty = envStackType env_ids stack_ty\n        in_ty' = envStackType env_ids' stack_ty\n        arg_code = if env_ids' == env_ids then core_cmd else\n                do_premap meth_ids in_ty in_ty' cmd_ty trim_code core_cmd\n    return (mkLets meth_binds arg_code, free_vars)\ndsTrimCmdArg _ _ _ = panic \"dsTrimCmdArg\"\n\n-- Given D; xs |-a c : stk --> t, builds c with xs fed back.\n-- Typically needs to be prefixed with arr (\\(p, stk) -> ((xs),stk))\n\ndsfixCmd\n        :: DsCmdEnv             -- arrow combinators\n        -> IdSet                -- set of local vars available to this command\n        -> Type                 -- type of the stack (right-nested tuple)\n        -> Type                 -- return type of the command\n        -> LHsCmd GhcTc         -- command to desugar\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet,         -- subset of local vars that occur free\n                [Id])           -- the same local vars as a list, fed back\ndsfixCmd ids local_vars stk_ty cmd_ty cmd\n  = do { putSrcSpanDs (getLoc cmd) $ dsNoLevPoly cmd_ty\n           (text \"When desugaring the command:\" <+> ppr cmd)\n       ; trimInput (dsLCmd ids local_vars stk_ty cmd_ty cmd) }\n\n-- Feed back the list of local variables actually used a command,\n-- for use as the input tuple of the generated arrow.\n\ntrimInput\n        :: ([Id] -> DsM (CoreExpr, DIdSet))\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet,         -- subset of local vars that occur free\n                [Id])           -- same local vars as a list, fed back to\n                                -- the inner function to form the tuple of\n                                -- inputs to the arrow.\ntrimInput build_arrow\n  = fixDs (\\ ~(_,_,env_ids) -> do\n        (core_cmd, free_vars) <- build_arrow env_ids\n        return (core_cmd, free_vars, dVarSetElems free_vars))\n\n{-\nTranslation of command judgements of the form\n\n        D |-a do { ss } : t\n-}\n\ndsCmdDo :: DsCmdEnv             -- arrow combinators\n        -> IdSet                -- set of local vars available to this statement\n        -> Type                 -- return type of the statement\n        -> [CmdLStmt GhcTc]     -- statements to desugar\n        -> [Id]                 -- list of vars in the input to this statement\n                                -- This is typically fed back,\n                                -- so don't pull on it too early\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet)         -- subset of local vars that occur free\n\ndsCmdDo _ _ _ [] _ = panic \"dsCmdDo\"\n\n-- D; xs |-a c : () --> t\n-- --------------------------\n-- D; xs |-a do { c } : t\n--\n--              ---> premap (\\ (xs) -> ((xs), ())) c\n\ndsCmdDo ids local_vars res_ty [dL->L loc (LastStmt _ body _ _)] env_ids = do\n    putSrcSpanDs loc $ dsNoLevPoly res_ty\n                         (text \"In the command:\" <+> ppr body)\n    (core_body, env_ids') <- dsLCmd ids local_vars unitTy res_ty body env_ids\n    let env_ty = mkBigCoreVarTupTy env_ids\n    env_var <- newSysLocalDs env_ty\n    let core_map = Lam env_var (mkCorePairExpr (Var env_var) mkCoreUnitExpr)\n    return (do_premap ids\n                        env_ty\n                        (mkCorePairTy env_ty unitTy)\n                        res_ty\n                        core_map\n                        core_body,\n        env_ids')\n\ndsCmdDo ids local_vars res_ty (stmt:stmts) env_ids = do\n    let bound_vars  = mkVarSet (collectLStmtBinders stmt)\n    let local_vars' = bound_vars `unionVarSet` local_vars\n    (core_stmts, _, env_ids') <- trimInput (dsCmdDo ids local_vars' res_ty stmts)\n    (core_stmt, fv_stmt) <- dsCmdLStmt ids local_vars env_ids' stmt env_ids\n    return (do_compose ids\n                (mkBigCoreVarTupTy env_ids)\n                (mkBigCoreVarTupTy env_ids')\n                res_ty\n                core_stmt\n                core_stmts,\n              fv_stmt)\n\n{-\nA statement maps one local environment to another, and is represented\nas an arrow from one tuple type to another.  A statement sequence is\ntranslated to a composition of such arrows.\n-}\n\ndsCmdLStmt :: DsCmdEnv -> IdSet -> [Id] -> CmdLStmt GhcTc -> [Id]\n           -> DsM (CoreExpr, DIdSet)\ndsCmdLStmt ids local_vars out_ids cmd env_ids\n  = dsCmdStmt ids local_vars out_ids (unLoc cmd) env_ids\n\ndsCmdStmt\n        :: DsCmdEnv             -- arrow combinators\n        -> IdSet                -- set of local vars available to this statement\n        -> [Id]                 -- list of vars in the output of this statement\n        -> CmdStmt GhcTc        -- statement to desugar\n        -> [Id]                 -- list of vars in the input to this statement\n                                -- This is typically fed back,\n                                -- so don't pull on it too early\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet)         -- subset of local vars that occur free\n\n-- D; xs1 |-a c : () --> t\n-- D; xs' |-a do { ss } : t'\n-- ------------------------------\n-- D; xs  |-a do { c; ss } : t'\n--\n--              ---> premap (\\ ((xs)) -> (((xs1),()),(xs')))\n--                      (first c >>> arr snd) >>> ss\n\ndsCmdStmt ids local_vars out_ids (BodyStmt c_ty cmd _ _) env_ids = do\n    (core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars unitTy c_ty cmd\n    core_mux <- matchEnv env_ids\n        (mkCorePairExpr\n            (mkCorePairExpr (mkBigCoreVarTup env_ids1) mkCoreUnitExpr)\n            (mkBigCoreVarTup out_ids))\n    let\n        in_ty = mkBigCoreVarTupTy env_ids\n        in_ty1 = mkCorePairTy (mkBigCoreVarTupTy env_ids1) unitTy\n        out_ty = mkBigCoreVarTupTy out_ids\n        before_c_ty = mkCorePairTy in_ty1 out_ty\n        after_c_ty = mkCorePairTy c_ty out_ty\n    dsNoLevPoly c_ty empty -- I (Richard E, Dec '16) have no idea what to say here\n    snd_fn <- mkSndExpr c_ty out_ty\n    return (do_premap ids in_ty before_c_ty out_ty core_mux $\n                do_compose ids before_c_ty after_c_ty out_ty\n                        (do_first ids in_ty1 c_ty out_ty core_cmd) $\n                do_arr ids after_c_ty out_ty snd_fn,\n              extendDVarSetList fv_cmd out_ids)\n\n-- D; xs1 |-a c : () --> t\n-- D; xs' |-a do { ss } : t'            xs2 = xs' - defs(p)\n-- -----------------------------------\n-- D; xs  |-a do { p <- c; ss } : t'\n--\n--              ---> premap (\\ (xs) -> (((xs1),()),(xs2)))\n--                      (first c >>> arr (\\ (p, (xs2)) -> (xs'))) >>> ss\n--\n-- It would be simpler and more consistent to do this using second,\n-- but that's likely to be defined in terms of first.\n\ndsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd _ _) env_ids = do\n    let pat_ty = hsLPatType pat\n    (core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars unitTy pat_ty cmd\n    let pat_vars = mkVarSet (collectPatBinders pat)\n    let\n        env_ids2 = filterOut (`elemVarSet` pat_vars) out_ids\n        env_ty2 = mkBigCoreVarTupTy env_ids2\n\n    -- multiplexing function\n    --          \\ (xs) -> (((xs1),()),(xs2))\n\n    core_mux <- matchEnv env_ids\n        (mkCorePairExpr\n            (mkCorePairExpr (mkBigCoreVarTup env_ids1) mkCoreUnitExpr)\n            (mkBigCoreVarTup env_ids2))\n\n    -- projection function\n    --          \\ (p, (xs2)) -> (zs)\n\n    env_id <- newSysLocalDs env_ty2\n    uniqs <- newUniqueSupply\n    let\n       after_c_ty = mkCorePairTy pat_ty env_ty2\n       out_ty = mkBigCoreVarTupTy out_ids\n       body_expr = coreCaseTuple uniqs env_id env_ids2 (mkBigCoreVarTup out_ids)\n\n    fail_expr <- mkFailExpr (StmtCtxt DoExpr) out_ty\n    pat_id    <- selectSimpleMatchVarL pat\n    match_code\n      <- matchSimply (Var pat_id) (StmtCtxt DoExpr) pat body_expr fail_expr\n    pair_id   <- newSysLocalDs after_c_ty\n    let\n        proj_expr = Lam pair_id (coreCasePair pair_id pat_id env_id match_code)\n\n    -- put it all together\n    let\n        in_ty = mkBigCoreVarTupTy env_ids\n        in_ty1 = mkCorePairTy (mkBigCoreVarTupTy env_ids1) unitTy\n        in_ty2 = mkBigCoreVarTupTy env_ids2\n        before_c_ty = mkCorePairTy in_ty1 in_ty2\n    return (do_premap ids in_ty before_c_ty out_ty core_mux $\n                do_compose ids before_c_ty after_c_ty out_ty\n                        (do_first ids in_ty1 pat_ty in_ty2 core_cmd) $\n                do_arr ids after_c_ty out_ty proj_expr,\n              fv_cmd `unionDVarSet` (mkDVarSet out_ids\n                                     `uniqDSetMinusUniqSet` pat_vars))\n\n-- D; xs' |-a do { ss } : t\n-- --------------------------------------\n-- D; xs  |-a do { let binds; ss } : t\n--\n--              ---> arr (\\ (xs) -> let binds in (xs')) >>> ss\n\ndsCmdStmt ids local_vars out_ids (LetStmt _ binds) env_ids = do\n    -- build a new environment using the let bindings\n    core_binds <- dsLocalBinds binds (mkBigCoreVarTup out_ids)\n    -- match the old environment against the input\n    core_map <- matchEnv env_ids core_binds\n    return (do_arr ids\n                        (mkBigCoreVarTupTy env_ids)\n                        (mkBigCoreVarTupTy out_ids)\n                        core_map,\n            exprFreeIdsDSet core_binds `uniqDSetIntersectUniqSet` local_vars)\n\n-- D; ys  |-a do { ss; returnA -< ((xs1), (ys2)) } : ...\n-- D; xs' |-a do { ss' } : t\n-- ------------------------------------\n-- D; xs  |-a do { rec ss; ss' } : t\n--\n--                      xs1 = xs' /\\ defs(ss)\n--                      xs2 = xs' - defs(ss)\n--                      ys1 = ys - defs(ss)\n--                      ys2 = ys /\\ defs(ss)\n--\n--              ---> arr (\\(xs) -> ((ys1),(xs2))) >>>\n--                      first (loop (arr (\\((ys1),~(ys2)) -> (ys)) >>> ss)) >>>\n--                      arr (\\((xs1),(xs2)) -> (xs')) >>> ss'\n\ndsCmdStmt ids local_vars out_ids\n        (RecStmt { recS_stmts = stmts\n                 , recS_later_ids = later_ids, recS_rec_ids = rec_ids\n                 , recS_ext = RecStmtTc { recS_later_rets = later_rets\n                                        , recS_rec_rets = rec_rets } })\n        env_ids = do\n    let\n        later_ids_set = mkVarSet later_ids\n        env2_ids = filterOut (`elemVarSet` later_ids_set) out_ids\n        env2_id_set = mkDVarSet env2_ids\n        env2_ty = mkBigCoreVarTupTy env2_ids\n\n    -- post_loop_fn = \\((later_ids),(env2_ids)) -> (out_ids)\n\n    uniqs <- newUniqueSupply\n    env2_id <- newSysLocalDs env2_ty\n    let\n        later_ty = mkBigCoreVarTupTy later_ids\n        post_pair_ty = mkCorePairTy later_ty env2_ty\n        post_loop_body = coreCaseTuple uniqs env2_id env2_ids (mkBigCoreVarTup out_ids)\n\n    post_loop_fn <- matchEnvStack later_ids env2_id post_loop_body\n\n    --- loop (...)\n\n    (core_loop, env1_id_set, env1_ids)\n               <- dsRecCmd ids local_vars stmts later_ids later_rets rec_ids rec_rets\n\n    -- pre_loop_fn = \\(env_ids) -> ((env1_ids),(env2_ids))\n\n    let\n        env1_ty = mkBigCoreVarTupTy env1_ids\n        pre_pair_ty = mkCorePairTy env1_ty env2_ty\n        pre_loop_body = mkCorePairExpr (mkBigCoreVarTup env1_ids)\n                                        (mkBigCoreVarTup env2_ids)\n\n    pre_loop_fn <- matchEnv env_ids pre_loop_body\n\n    -- arr pre_loop_fn >>> first (loop (...)) >>> arr post_loop_fn\n\n    let\n        env_ty = mkBigCoreVarTupTy env_ids\n        out_ty = mkBigCoreVarTupTy out_ids\n        core_body = do_premap ids env_ty pre_pair_ty out_ty\n                pre_loop_fn\n                (do_compose ids pre_pair_ty post_pair_ty out_ty\n                        (do_first ids env1_ty later_ty env2_ty\n                                core_loop)\n                        (do_arr ids post_pair_ty out_ty\n                                post_loop_fn))\n\n    return (core_body, env1_id_set `unionDVarSet` env2_id_set)\n\ndsCmdStmt _ _ _ _ s = pprPanic \"dsCmdStmt\" (ppr s)\n\n--      loop (premap (\\ ((env1_ids), ~(rec_ids)) -> (env_ids))\n--            (ss >>> arr (\\ (out_ids) -> ((later_rets),(rec_rets))))) >>>\n\ndsRecCmd\n        :: DsCmdEnv             -- arrow combinators\n        -> IdSet                -- set of local vars available to this statement\n        -> [CmdLStmt GhcTc]     -- list of statements inside the RecCmd\n        -> [Id]                 -- list of vars defined here and used later\n        -> [HsExpr GhcTc]       -- expressions corresponding to later_ids\n        -> [Id]                 -- list of vars fed back through the loop\n        -> [HsExpr GhcTc]       -- expressions corresponding to rec_ids\n        -> DsM (CoreExpr,       -- desugared statement\n                DIdSet,         -- subset of local vars that occur free\n                [Id])           -- same local vars as a list\n\ndsRecCmd ids local_vars stmts later_ids later_rets rec_ids rec_rets = do\n    let\n        later_id_set = mkVarSet later_ids\n        rec_id_set = mkVarSet rec_ids\n        local_vars' = rec_id_set `unionVarSet` later_id_set `unionVarSet` local_vars\n\n    -- mk_pair_fn = \\ (out_ids) -> ((later_rets),(rec_rets))\n\n    core_later_rets <- mapM dsExpr later_rets\n    core_rec_rets <- mapM dsExpr rec_rets\n    let\n        -- possibly polymorphic version of vars of later_ids and rec_ids\n        out_ids = exprsFreeIdsList (core_later_rets ++ core_rec_rets)\n        out_ty = mkBigCoreVarTupTy out_ids\n\n        later_tuple = mkBigCoreTup core_later_rets\n        later_ty = mkBigCoreVarTupTy later_ids\n\n        rec_tuple = mkBigCoreTup core_rec_rets\n        rec_ty = mkBigCoreVarTupTy rec_ids\n\n        out_pair = mkCorePairExpr later_tuple rec_tuple\n        out_pair_ty = mkCorePairTy later_ty rec_ty\n\n    mk_pair_fn <- matchEnv out_ids out_pair\n\n    -- ss\n\n    (core_stmts, fv_stmts, env_ids) <- dsfixCmdStmts ids local_vars' out_ids stmts\n\n    -- squash_pair_fn = \\ ((env1_ids), ~(rec_ids)) -> (env_ids)\n\n    rec_id <- newSysLocalDs rec_ty\n    let\n        env1_id_set = fv_stmts `uniqDSetMinusUniqSet` rec_id_set\n        env1_ids = dVarSetElems env1_id_set\n        env1_ty = mkBigCoreVarTupTy env1_ids\n        in_pair_ty = mkCorePairTy env1_ty rec_ty\n        core_body = mkBigCoreTup (map selectVar env_ids)\n          where\n            selectVar v\n                | v `elemVarSet` rec_id_set\n                  = mkTupleSelector rec_ids v rec_id (Var rec_id)\n                | otherwise = Var v\n\n    squash_pair_fn <- matchEnvStack env1_ids rec_id core_body\n\n    -- loop (premap squash_pair_fn (ss >>> arr mk_pair_fn))\n\n    let\n        env_ty = mkBigCoreVarTupTy env_ids\n        core_loop = do_loop ids env1_ty later_ty rec_ty\n                (do_premap ids in_pair_ty env_ty out_pair_ty\n                        squash_pair_fn\n                        (do_compose ids env_ty out_ty out_pair_ty\n                                core_stmts\n                                (do_arr ids out_ty out_pair_ty mk_pair_fn)))\n\n    return (core_loop, env1_id_set, env1_ids)\n\n{-\nA sequence of statements (as in a rec) is desugared to an arrow between\ntwo environments (no stack)\n-}\n\ndsfixCmdStmts\n        :: DsCmdEnv             -- arrow combinators\n        -> IdSet                -- set of local vars available to this statement\n        -> [Id]                 -- output vars of these statements\n        -> [CmdLStmt GhcTc]     -- statements to desugar\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet,         -- subset of local vars that occur free\n                [Id])           -- same local vars as a list\n\ndsfixCmdStmts ids local_vars out_ids stmts\n  = trimInput (dsCmdStmts ids local_vars out_ids stmts)\n   -- TODO: Add levity polymorphism check for the resulting expression.\n   -- But I (Richard E.) don't know enough about arrows to do so.\n\ndsCmdStmts\n        :: DsCmdEnv             -- arrow combinators\n        -> IdSet                -- set of local vars available to this statement\n        -> [Id]                 -- output vars of these statements\n        -> [CmdLStmt GhcTc]     -- statements to desugar\n        -> [Id]                 -- list of vars in the input to these statements\n        -> DsM (CoreExpr,       -- desugared expression\n                DIdSet)         -- subset of local vars that occur free\n\ndsCmdStmts ids local_vars out_ids [stmt] env_ids\n  = dsCmdLStmt ids local_vars out_ids stmt env_ids\n\ndsCmdStmts ids local_vars out_ids (stmt:stmts) env_ids = do\n    let bound_vars  = mkVarSet (collectLStmtBinders stmt)\n    let local_vars' = bound_vars `unionVarSet` local_vars\n    (core_stmts, _fv_stmts, env_ids') <- dsfixCmdStmts ids local_vars' out_ids stmts\n    (core_stmt, fv_stmt) <- dsCmdLStmt ids local_vars env_ids' stmt env_ids\n    return (do_compose ids\n                (mkBigCoreVarTupTy env_ids)\n                (mkBigCoreVarTupTy env_ids')\n                (mkBigCoreVarTupTy out_ids)\n                core_stmt\n                core_stmts,\n              fv_stmt)\n\ndsCmdStmts _ _ _ [] _ = panic \"dsCmdStmts []\"\n\n-- Match a list of expressions against a list of patterns, left-to-right.\n\nmatchSimplys :: [CoreExpr]              -- Scrutinees\n             -> HsMatchContext Name     -- Match kind\n             -> [LPat GhcTc]            -- Patterns they should match\n             -> CoreExpr                -- Return this if they all match\n             -> CoreExpr                -- Return this if they don't\n             -> DsM CoreExpr\nmatchSimplys [] _ctxt [] result_expr _fail_expr = return result_expr\nmatchSimplys (exp:exps) ctxt (pat:pats) result_expr fail_expr = do\n    match_code <- matchSimplys exps ctxt pats result_expr fail_expr\n    matchSimply exp ctxt pat match_code fail_expr\nmatchSimplys _ _ _ _ _ = panic \"matchSimplys\"\n\n-- List of leaf expressions, with set of variables bound in each\n\nleavesMatch :: LMatch GhcTc (Located (body GhcTc))\n            -> [(Located (body GhcTc), IdSet)]\nleavesMatch (dL->L _ (Match { m_pats = pats\n                            , m_grhss = GRHSs _ grhss (dL->L _ binds) }))\n  = let\n        defined_vars = mkVarSet (collectPatsBinders pats)\n                        `unionVarSet`\n                       mkVarSet (collectLocalBinders binds)\n    in\n    [(body,\n      mkVarSet (collectLStmtsBinders stmts)\n        `unionVarSet` defined_vars)\n    | (dL->L _ (GRHS _ stmts body)) <- grhss]\nleavesMatch _ = panic \"leavesMatch\"\n\n-- Replace the leaf commands in a match\n\nreplaceLeavesMatch\n        :: Type                                 -- new result type\n        -> [Located (body' GhcTc)] -- replacement leaf expressions of that type\n        -> LMatch GhcTc (Located (body GhcTc))  -- the matches of a case command\n        -> ([Located (body' GhcTc)],            -- remaining leaf expressions\n            LMatch GhcTc (Located (body' GhcTc))) -- updated match\nreplaceLeavesMatch _res_ty leaves\n                        (dL->L loc\n                          match@(Match { m_grhss = GRHSs x grhss binds }))\n  = let\n        (leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss\n    in\n    (leaves', cL loc (match { m_ext = noExt, m_grhss = GRHSs x grhss' binds }))\nreplaceLeavesMatch _ _ _ = panic \"replaceLeavesMatch\"\n\nreplaceLeavesGRHS\n        :: [Located (body' GhcTc)]  -- replacement leaf expressions of that type\n        -> LGRHS GhcTc (Located (body GhcTc))     -- rhss of a case command\n        -> ([Located (body' GhcTc)],              -- remaining leaf expressions\n            LGRHS GhcTc (Located (body' GhcTc)))  -- updated GRHS\nreplaceLeavesGRHS (leaf:leaves) (dL->L loc (GRHS x stmts _))\n  = (leaves, cL loc (GRHS x stmts leaf))\nreplaceLeavesGRHS [] _ = panic \"replaceLeavesGRHS []\"\nreplaceLeavesGRHS _ _ = panic \"replaceLeavesGRHS\"\n\n-- Balanced fold of a non-empty list.\n\nfoldb :: (a -> a -> a) -> [a] -> a\nfoldb _ [] = error \"foldb of empty list\"\nfoldb _ [x] = x\nfoldb f xs = foldb f (fold_pairs xs)\n  where\n    fold_pairs [] = []\n    fold_pairs [x] = [x]\n    fold_pairs (x1:x2:xs) = f x1 x2:fold_pairs xs\n\n{-\nNote [Dictionary binders in ConPatOut] See also same Note in HsUtils\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe following functions to collect value variables from patterns are\ncopied from HsUtils, with one change: we also collect the dictionary\nbindings (pat_binds) from ConPatOut.  We need them for cases like\n\nh :: Arrow a => Int -> a (Int,Int) Int\nh x = proc (y,z) -> case compare x y of\n                GT -> returnA -< z+x\n\nThe type checker turns the case into\n\n                case compare x y of\n                  GT { p77 = plusInt } -> returnA -< p77 z x\n\nHere p77 is a local binding for the (+) operation.\n\nSee comments in HsUtils for why the other version does not include\nthese bindings.\n-}\n\ncollectPatBinders :: LPat GhcTc -> [Id]\ncollectPatBinders pat = collectl pat []\n\ncollectPatsBinders :: [LPat GhcTc] -> [Id]\ncollectPatsBinders pats = foldr collectl [] pats\n\n---------------------\ncollectl :: LPat GhcTc -> [Id] -> [Id]\n-- See Note [Dictionary binders in ConPatOut]\ncollectl (dL->L _ pat) bndrs\n  = go pat\n  where\n    go (VarPat _ (dL->L _ var))   = var : bndrs\n    go (WildPat _)                = bndrs\n    go (LazyPat _ pat)            = collectl pat bndrs\n    go (BangPat _ pat)            = collectl pat bndrs\n    go (AsPat _ (dL->L _ a) pat)  = a : collectl pat bndrs\n    go (ParPat _ pat)             = collectl pat bndrs\n\n    go (ListPat _ pats)           = foldr collectl bndrs pats\n    go (TuplePat _ pats _)        = foldr collectl bndrs pats\n    go (SumPat _ pat _ _)         = collectl pat bndrs\n\n    go (ConPatIn _ ps)            = foldr collectl bndrs (hsConPatArgs ps)\n    go (ConPatOut {pat_args=ps, pat_binds=ds}) =\n                                    collectEvBinders ds\n                                    ++ foldr collectl bndrs (hsConPatArgs ps)\n    go (LitPat _ _)               = bndrs\n    go (NPat {})                  = bndrs\n    go (NPlusKPat _ (dL->L _ n) _ _ _ _) = n : bndrs\n\n    go (SigPat _ pat _)           = collectl pat bndrs\n    go (CoPat _ _ pat _)          = collectl (noLoc pat) bndrs\n    go (ViewPat _ _ pat)          = collectl pat bndrs\n    go p@(SplicePat {})           = pprPanic \"collectl/go\" (ppr p)\n    go p@(XPat {})                = pprPanic \"collectl/go\" (ppr p)\n\ncollectEvBinders :: TcEvBinds -> [Id]\ncollectEvBinders (EvBinds bs)   = foldrBag add_ev_bndr [] bs\ncollectEvBinders (TcEvBinds {}) = panic \"ToDo: collectEvBinders\"\n\nadd_ev_bndr :: EvBind -> [Id] -> [Id]\nadd_ev_bndr (EvBind { eb_lhs = b }) bs | isId b    = b:bs\n                                       | otherwise = bs\n  -- A worry: what about coercion variable binders??\n\ncollectLStmtsBinders :: [LStmt GhcTc body] -> [Id]\ncollectLStmtsBinders = concatMap collectLStmtBinders\n\ncollectLStmtBinders :: LStmt GhcTc body -> [Id]\ncollectLStmtBinders = collectStmtBinders . unLoc\n\ncollectStmtBinders :: Stmt GhcTc body -> [Id]\ncollectStmtBinders (RecStmt { recS_later_ids = later_ids }) = later_ids\ncollectStmtBinders stmt = HsUtils.collectStmtBinders stmt\n", "num_lines": 1271}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nPattern-matching bindings (HsBinds and MonoBinds)\n\nHandles @HsBinds@; those at the top level require different handling,\nin that the @Rec@/@NonRec@/etc structure is thrown away (whereas at\nlower levels it is preserved with @let@/@letrec@s).\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,\n                 dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   DsExpr( dsLExpr )\nimport {-# SOURCE #-}   Match( matchWrapper )\n\nimport DsMonad\nimport DsGRHSs\nimport DsUtils\nimport Check ( checkGuardMatches )\n\nimport HsSyn            -- lots of things\nimport CoreSyn          -- lots of things\nimport CoreOpt          ( simpleOptExpr )\nimport OccurAnal        ( occurAnalyseExpr )\nimport MkCore\nimport CoreUtils\nimport CoreArity ( etaExpand )\nimport CoreUnfold\nimport CoreFVs\nimport Digraph\n\nimport PrelNames\nimport TyCon\nimport TcEvidence\nimport TcType\nimport Type\nimport Coercion\nimport TysWiredIn ( typeNatKind, typeSymbolKind )\nimport Id\nimport MkId(proxyHashId)\nimport Name\nimport VarSet\nimport Rules\nimport VarEnv\nimport Var( EvVar )\nimport Outputable\nimport Module\nimport SrcLoc\nimport Maybes\nimport OrdList\nimport Bag\nimport BasicTypes\nimport DynFlags\nimport FastString\nimport Util\nimport UniqSet( nonDetEltsUniqSet )\nimport MonadUtils\nimport qualified GHC.LanguageExtensions as LangExt\nimport Control.Monad\n\n{-**********************************************************************\n*                                                                      *\n           Desugaring a MonoBinds\n*                                                                      *\n**********************************************************************-}\n\n-- | Desugar top level binds, strict binds are treated like normal\n-- binds since there is no good time to force before first usage.\ndsTopLHsBinds :: LHsBinds GhcTc -> DsM (OrdList (Id,CoreExpr))\ndsTopLHsBinds binds\n     -- see Note [Strict binds checks]\n  | not (isEmptyBag unlifted_binds) || not (isEmptyBag bang_binds)\n  = do { mapBagM_ (top_level_err \"bindings for unlifted types\") unlifted_binds\n       ; mapBagM_ (top_level_err \"strict bindings\")             bang_binds\n       ; return nilOL }\n\n  | otherwise\n  = do { (force_vars, prs) <- dsLHsBinds binds\n       ; when debugIsOn $\n         do { xstrict <- xoptM LangExt.Strict\n            ; MASSERT2( null force_vars || xstrict, ppr binds $$ ppr force_vars ) }\n              -- with -XStrict, even top-level vars are listed as force vars.\n\n       ; return (toOL prs) }\n\n  where\n    unlifted_binds = filterBag (isUnliftedHsBind . unLoc) binds\n    bang_binds     = filterBag (isBangedHsBind   . unLoc) binds\n\n    top_level_err desc (dL->L loc bind)\n      = putSrcSpanDs loc $\n        errDs (hang (text \"Top-level\" <+> text desc <+> text \"aren't allowed:\")\n                  2 (ppr bind))\n\n\n-- | Desugar all other kind of bindings, Ids of strict binds are returned to\n-- later be forced in the binding group body, see Note [Desugar Strict binds]\ndsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)])\ndsLHsBinds binds\n  = do { ds_bs <- mapBagM dsLHsBind binds\n       ; return (foldBag (\\(a, a') (b, b') -> (a ++ b, a' ++ b'))\n                         id ([], []) ds_bs) }\n\n------------------------\ndsLHsBind :: LHsBind GhcTc\n          -> DsM ([Id], [(Id,CoreExpr)])\ndsLHsBind (dL->L loc bind) = do dflags <- getDynFlags\n                                putSrcSpanDs loc $ dsHsBind dflags bind\n\n-- | Desugar a single binding (or group of recursive binds).\ndsHsBind :: DynFlags\n         -> HsBind GhcTc\n         -> DsM ([Id], [(Id,CoreExpr)])\n         -- ^ The Ids of strict binds, to be forced in the body of the\n         -- binding group see Note [Desugar Strict binds] and all\n         -- bindings and their desugared right hand sides.\n\ndsHsBind dflags (VarBind { var_id = var\n                         , var_rhs = expr\n                         , var_inline = inline_regardless })\n  = do  { core_expr <- dsLExpr expr\n                -- Dictionary bindings are always VarBinds,\n                -- so we only need do this here\n        ; let var' | inline_regardless = var `setIdUnfolding` mkCompulsoryUnfolding core_expr\n                   | otherwise         = var\n        ; let core_bind@(id,_) = makeCorePair dflags var' False 0 core_expr\n              force_var = if xopt LangExt.Strict dflags\n                          then [id]\n                          else []\n        ; return (force_var, [core_bind]) }\n\ndsHsBind dflags b@(FunBind { fun_id = (dL->L _ fun)\n                           , fun_matches = matches\n                           , fun_co_fn = co_fn\n                           , fun_tick = tick })\n = do   { (args, body) <- matchWrapper\n                           (mkPrefixFunRhs (noLoc $ idName fun))\n                           Nothing matches\n        ; core_wrap <- dsHsWrapper co_fn\n        ; let body' = mkOptTickBox tick body\n              rhs   = core_wrap (mkLams args body')\n              core_binds@(id,_) = makeCorePair dflags fun False 0 rhs\n              force_var\n                  -- Bindings are strict when -XStrict is enabled\n                | xopt LangExt.Strict dflags\n                , matchGroupArity matches == 0 -- no need to force lambdas\n                = [id]\n                | isBangedHsBind b\n                = [id]\n                | otherwise\n                = []\n        ; --pprTrace \"dsHsBind\" (vcat [ ppr fun <+> ppr (idInlinePragma fun)\n          --                          , ppr (mg_alts matches)\n          --                          , ppr args, ppr core_binds]) $\n          return (force_var, [core_binds]) }\n\ndsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss\n                         , pat_ext = NPatBindTc _ ty\n                         , pat_ticks = (rhs_tick, var_ticks) })\n  = do  { body_expr <- dsGuarded grhss ty\n        ; checkGuardMatches PatBindGuards grhss\n        ; let body' = mkOptTickBox rhs_tick body_expr\n              pat'  = decideBangHood dflags pat\n        ; (force_var,sel_binds) <- mkSelectorBinds var_ticks pat body'\n          -- We silently ignore inline pragmas; no makeCorePair\n          -- Not so cool, but really doesn't matter\n        ; let force_var' = if isBangedLPat pat'\n                           then [force_var]\n                           else []\n        ; return (force_var', sel_binds) }\n\ndsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts\n                          , abs_exports = exports\n                          , abs_ev_binds = ev_binds\n                          , abs_binds = binds, abs_sig = has_sig })\n  = do { ds_binds <- addDictsDs (listToBag dicts) $\n                     dsLHsBinds binds\n                         -- addDictsDs: push type constraints deeper\n                         --             for inner pattern match check\n                         -- See Check, Note [Type and Term Equality Propagation]\n\n       ; ds_ev_binds <- dsTcEvBinds_s ev_binds\n\n       -- dsAbsBinds does the hard work\n       ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds has_sig }\n\ndsHsBind _ (PatSynBind{}) = panic \"dsHsBind: PatSynBind\"\ndsHsBind _ (XHsBindsLR{}) = panic \"dsHsBind: XHsBindsLR\"\n\n\n-----------------------\ndsAbsBinds :: DynFlags\n           -> [TyVar] -> [EvVar] -> [ABExport GhcTc]\n           -> [CoreBind]                -- Desugared evidence bindings\n           -> ([Id], [(Id,CoreExpr)])   -- Desugared value bindings\n           -> Bool                      -- Single binding with signature\n           -> DsM ([Id], [(Id,CoreExpr)])\n\ndsAbsBinds dflags tyvars dicts exports\n           ds_ev_binds (force_vars, bind_prs) has_sig\n\n    -- A very important common case: one exported variable\n    -- Non-recursive bindings come through this way\n    -- So do self-recursive bindings\n  | [export] <- exports\n  , ABE { abe_poly = global_id, abe_mono = local_id\n        , abe_wrap = wrap, abe_prags = prags } <- export\n  , Just force_vars' <- case force_vars of\n                           []                  -> Just []\n                           [v] | v == local_id -> Just [global_id]\n                           _                   -> Nothing\n       -- If there is a variable to force, it's just the\n       -- single variable we are binding here\n  = do { core_wrap <- dsHsWrapper wrap -- Usually the identity\n\n       ; let rhs = core_wrap $\n                   mkLams tyvars $ mkLams dicts $\n                   mkCoreLets ds_ev_binds $\n                   body\n\n             body | has_sig\n                  , [(_, lrhs)] <- bind_prs\n                  = lrhs\n                  | otherwise\n                  = mkLetRec bind_prs (Var local_id)\n\n       ; (spec_binds, rules) <- dsSpecs rhs prags\n\n       ; let global_id' = addIdSpecialisations global_id rules\n             main_bind  = makeCorePair dflags global_id'\n                                       (isDefaultMethod prags)\n                                       (dictArity dicts) rhs\n\n       ; return (force_vars', main_bind : fromOL spec_binds) }\n\n    -- Another common case: no tyvars, no dicts\n    -- In this case we can have a much simpler desugaring\n  | null tyvars, null dicts\n\n  = do { let mk_bind (ABE { abe_wrap = wrap\n                          , abe_poly = global\n                          , abe_mono = local\n                          , abe_prags = prags })\n              = do { core_wrap <- dsHsWrapper wrap\n                   ; return (makeCorePair dflags global\n                                          (isDefaultMethod prags)\n                                          0 (core_wrap (Var local))) }\n             mk_bind (XABExport _) = panic \"dsAbsBinds\"\n       ; main_binds <- mapM mk_bind exports\n\n       ; return (force_vars, flattenBinds ds_ev_binds ++ bind_prs ++ main_binds) }\n\n    -- The general case\n    -- See Note [Desugaring AbsBinds]\n  | otherwise\n  = do { let core_bind = Rec [ makeCorePair dflags (add_inline lcl_id) False 0 rhs\n                              | (lcl_id, rhs) <- bind_prs ]\n                -- Monomorphic recursion possible, hence Rec\n             new_force_vars = get_new_force_vars force_vars\n             locals       = map abe_mono exports\n             all_locals   = locals ++ new_force_vars\n             tup_expr     = mkBigCoreVarTup all_locals\n             tup_ty       = exprType tup_expr\n       ; let poly_tup_rhs = mkLams tyvars $ mkLams dicts $\n                            mkCoreLets ds_ev_binds $\n                            mkLet core_bind $\n                            tup_expr\n\n       ; poly_tup_id <- newSysLocalDs (exprType poly_tup_rhs)\n\n        -- Find corresponding global or make up a new one: sometimes\n        -- we need to make new export to desugar strict binds, see\n        -- Note [Desugar Strict binds]\n       ; (exported_force_vars, extra_exports) <- get_exports force_vars\n\n       ; let mk_bind (ABE { abe_wrap = wrap\n                          , abe_poly = global\n                          , abe_mono = local, abe_prags = spec_prags })\n                          -- See Note [AbsBinds wrappers] in HsBinds\n                = do { tup_id  <- newSysLocalDs tup_ty\n                     ; core_wrap <- dsHsWrapper wrap\n                     ; let rhs = core_wrap $ mkLams tyvars $ mkLams dicts $\n                                 mkTupleSelector all_locals local tup_id $\n                                 mkVarApps (Var poly_tup_id) (tyvars ++ dicts)\n                           rhs_for_spec = Let (NonRec poly_tup_id poly_tup_rhs) rhs\n                     ; (spec_binds, rules) <- dsSpecs rhs_for_spec spec_prags\n                     ; let global' = (global `setInlinePragma` defaultInlinePragma)\n                                             `addIdSpecialisations` rules\n                           -- Kill the INLINE pragma because it applies to\n                           -- the user written (local) function.  The global\n                           -- Id is just the selector.  Hmm.\n                     ; return ((global', rhs) : fromOL spec_binds) }\n             mk_bind (XABExport _) = panic \"dsAbsBinds\"\n\n       ; export_binds_s <- mapM mk_bind (exports ++ extra_exports)\n\n       ; return ( exported_force_vars\n                , (poly_tup_id, poly_tup_rhs) :\n                   concat export_binds_s) }\n  where\n    inline_env :: IdEnv Id -- Maps a monomorphic local Id to one with\n                             -- the inline pragma from the source\n                             -- The type checker put the inline pragma\n                             -- on the *global* Id, so we need to transfer it\n    inline_env\n      = mkVarEnv [ (lcl_id, setInlinePragma lcl_id prag)\n                 | ABE { abe_mono = lcl_id, abe_poly = gbl_id } <- exports\n                 , let prag = idInlinePragma gbl_id ]\n\n    add_inline :: Id -> Id    -- tran\n    add_inline lcl_id = lookupVarEnv inline_env lcl_id\n                        `orElse` lcl_id\n\n    global_env :: IdEnv Id -- Maps local Id to its global exported Id\n    global_env =\n      mkVarEnv [ (local, global)\n               | ABE { abe_mono = local, abe_poly = global } <- exports\n               ]\n\n    -- find variables that are not exported\n    get_new_force_vars lcls =\n      foldr (\\lcl acc -> case lookupVarEnv global_env lcl of\n                           Just _ -> acc\n                           Nothing -> lcl:acc)\n            [] lcls\n\n    -- find exports or make up new exports for force variables\n    get_exports :: [Id] -> DsM ([Id], [ABExport GhcTc])\n    get_exports lcls =\n      foldM (\\(glbls, exports) lcl ->\n              case lookupVarEnv global_env lcl of\n                Just glbl -> return (glbl:glbls, exports)\n                Nothing   -> do export <- mk_export lcl\n                                let glbl = abe_poly export\n                                return (glbl:glbls, export:exports))\n            ([],[]) lcls\n\n    mk_export local =\n      do global <- newSysLocalDs\n                     (exprType (mkLams tyvars (mkLams dicts (Var local))))\n         return (ABE { abe_ext   = noExt\n                     , abe_poly  = global\n                     , abe_mono  = local\n                     , abe_wrap  = WpHole\n                     , abe_prags = SpecPrags [] })\n\n-- | This is where we apply INLINE and INLINABLE pragmas. All we need to\n-- do is to attach the unfolding information to the Id.\n--\n-- Other decisions about whether to inline are made in\n-- `calcUnfoldingGuidance` but the decision about whether to then expose\n-- the unfolding in the interface file is made in `TidyPgm.addExternal`\n-- using this information.\n------------------------\nmakeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr\n             -> (Id, CoreExpr)\nmakeCorePair dflags gbl_id is_default_method dict_arity rhs\n  | is_default_method    -- Default methods are *always* inlined\n                         -- See Note [INLINE and default methods] in TcInstDcls\n  = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs)\n\n  | otherwise\n  = case inlinePragmaSpec inline_prag of\n          NoUserInline -> (gbl_id, rhs)\n          NoInline     -> (gbl_id, rhs)\n          Inlinable    -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)\n          Inline       -> inline_pair\n\n  where\n    inline_prag   = idInlinePragma gbl_id\n    inlinable_unf = mkInlinableUnfolding dflags rhs\n    inline_pair\n       | Just arity <- inlinePragmaSat inline_prag\n        -- Add an Unfolding for an INLINE (but not for NOINLINE)\n        -- And eta-expand the RHS; see Note [Eta-expanding INLINE things]\n       , let real_arity = dict_arity + arity\n        -- NB: The arity in the InlineRule takes account of the dictionaries\n       = ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity real_arity rhs\n         , etaExpand real_arity rhs)\n\n       | otherwise\n       = pprTrace \"makeCorePair: arity missing\" (ppr gbl_id) $\n         (gbl_id `setIdUnfolding` mkInlineUnfolding rhs, rhs)\n\ndictArity :: [Var] -> Arity\n-- Don't count coercion variables in arity\ndictArity dicts = count isId dicts\n\n{-\nNote [Desugaring AbsBinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the general AbsBinds case we desugar the binding to this:\n\n       tup a (d:Num a) = let fm = ...gm...\n                             gm = ...fm...\n                         in (fm,gm)\n       f a d = case tup a d of { (fm,gm) -> fm }\n       g a d = case tup a d of { (fm,gm) -> fm }\n\nNote [Rules and inlining]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nCommon special case: no type or dictionary abstraction\nThis is a bit less trivial than you might suppose\nThe naive way would be to desugar to something like\n        f_lcl = ...f_lcl...     -- The \"binds\" from AbsBinds\n        M.f = f_lcl             -- Generated from \"exports\"\nBut we don't want that, because if M.f isn't exported,\nit'll be inlined unconditionally at every call site (its rhs is\ntrivial).  That would be ok unless it has RULES, which would\nthereby be completely lost.  Bad, bad, bad.\n\nInstead we want to generate\n        M.f = ...f_lcl...\n        f_lcl = M.f\nNow all is cool. The RULES are attached to M.f (by SimplCore),\nand f_lcl is rapidly inlined away.\n\nThis does not happen in the same way to polymorphic binds,\nbecause they desugar to\n        M.f = /\\a. let f_lcl = ...f_lcl... in f_lcl\nAlthough I'm a bit worried about whether full laziness might\nfloat the f_lcl binding out and then inline M.f at its call site\n\nNote [Specialising in no-dict case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEven if there are no tyvars or dicts, we may have specialisation pragmas.\nClass methods can generate\n      AbsBinds [] [] [( ... spec-prag]\n         { AbsBinds [tvs] [dicts] ...blah }\nSo the overloading is in the nested AbsBinds. A good example is in GHC.Float:\n\n  class  (Real a, Fractional a) => RealFrac a  where\n    round :: (Integral b) => a -> b\n\n  instance  RealFrac Float  where\n    {-# SPECIALIZE round :: Float -> Int #-}\n\nThe top-level AbsBinds for $cround has no tyvars or dicts (because the\ninstance does not).  But the method is locally overloaded!\n\nNote [Abstracting over tyvars only]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen abstracting over type variable only (not dictionaries), we don't really need to\nbuilt a tuple and select from it, as we do in the general case. Instead we can take\n\n        AbsBinds [a,b] [ ([a,b], fg, fl, _),\n                         ([b],   gg, gl, _) ]\n                { fl = e1\n                  gl = e2\n                   h = e3 }\n\nand desugar it to\n\n        fg = /\\ab. let B in e1\n        gg = /\\b. let a = () in let B in S(e2)\n        h  = /\\ab. let B in e3\n\nwhere B is the *non-recursive* binding\n        fl = fg a b\n        gl = gg b\n        h  = h a b    -- See (b); note shadowing!\n\nNotice (a) g has a different number of type variables to f, so we must\n             use the mkArbitraryType thing to fill in the gaps.\n             We use a type-let to do that.\n\n         (b) The local variable h isn't in the exports, and rather than\n             clone a fresh copy we simply replace h by (h a b), where\n             the two h's have different types!  Shadowing happens here,\n             which looks confusing but works fine.\n\n         (c) The result is *still* quadratic-sized if there are a lot of\n             small bindings.  So if there are more than some small\n             number (10), we filter the binding set B by the free\n             variables of the particular RHS.  Tiresome.\n\nWhy got to this trouble?  It's a common case, and it removes the\nquadratic-sized tuple desugaring.  Less clutter, hopefully faster\ncompilation, especially in a case where there are a *lot* of\nbindings.\n\n\nNote [Eta-expanding INLINE things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   foo :: Eq a => a -> a\n   {-# INLINE foo #-}\n   foo x = ...\n\nIf (foo d) ever gets floated out as a common sub-expression (which can\nhappen as a result of method sharing), there's a danger that we never\nget to do the inlining, which is a Terribly Bad thing given that the\nuser said \"inline\"!\n\nTo avoid this we pre-emptively eta-expand the definition, so that foo\nhas the arity with which it is declared in the source code.  In this\nexample it has arity 2 (one for the Eq and one for x). Doing this\nshould mean that (foo d) is a PAP and we don't share it.\n\nNote [Nested arities]\n~~~~~~~~~~~~~~~~~~~~~\nFor reasons that are not entirely clear, method bindings come out looking like\nthis:\n\n  AbsBinds [] [] [$cfromT <= [] fromT]\n    $cfromT [InlPrag=INLINE] :: T Bool -> Bool\n    { AbsBinds [] [] [fromT <= [] fromT_1]\n        fromT :: T Bool -> Bool\n        { fromT_1 ((TBool b)) = not b } } }\n\nNote the nested AbsBind.  The arity for the InlineRule on $cfromT should be\ngotten from the binding for fromT_1.\n\nIt might be better to have just one level of AbsBinds, but that requires more\nthought!\n\n\nNote [Desugar Strict binds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee https://ghc.haskell.org/trac/ghc/wiki/StrictPragma\n\nDesugaring strict variable bindings looks as follows (core below ==>)\n\n  let !x = rhs\n  in  body\n==>\n  let x = rhs\n  in x `seq` body -- seq the variable\n\nand if it is a pattern binding the desugaring looks like\n\n  let !pat = rhs\n  in body\n==>\n  let x = rhs -- bind the rhs to a new variable\n      pat = x\n  in x `seq` body -- seq the new variable\n\nif there is no variable in the pattern desugaring looks like\n\n  let False = rhs\n  in body\n==>\n  let x = case rhs of {False -> (); _ -> error \"Match failed\"}\n  in x `seq` body\n\nIn order to force the Ids in the binding group they are passed around\nin the dsHsBind family of functions, and later seq'ed in DsExpr.ds_val_bind.\n\nConsider a recursive group like this\n\n  letrec\n     f : g = rhs[f,g]\n  in <body>\n\nWithout `Strict`, we get a translation like this:\n\n  let t = /\\a. letrec tm = rhs[fm,gm]\n                      fm = case t of fm:_ -> fm\n                      gm = case t of _:gm -> gm\n                in\n                (fm,gm)\n\n  in let f = /\\a. case t a of (fm,_) -> fm\n  in let g = /\\a. case t a of (_,gm) -> gm\n  in <body>\n\nHere `tm` is the monomorphic binding for `rhs`.\n\nWith `Strict`, we want to force `tm`, but NOT `fm` or `gm`.\nAlas, `tm` isn't in scope in the `in <body>` part.\n\nThe simplest thing is to return it in the polymorphic\ntuple `t`, thus:\n\n  let t = /\\a. letrec tm = rhs[fm,gm]\n                      fm = case t of fm:_ -> fm\n                      gm = case t of _:gm -> gm\n                in\n                (tm, fm, gm)\n\n  in let f = /\\a. case t a of (_,fm,_) -> fm\n  in let g = /\\a. case t a of (_,_,gm) -> gm\n  in let tm = /\\a. case t a of (tm,_,_) -> tm\n  in tm `seq` <body>\n\n\nSee https://ghc.haskell.org/trac/ghc/wiki/StrictPragma for a more\ndetailed explanation of the desugaring of strict bindings.\n\nNote [Strict binds checks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are several checks around properly formed strict bindings. They\nall link to this Note. These checks must be here in the desugarer because\nwe cannot know whether or not a type is unlifted until after zonking, due\nto levity polymorphism. These checks all used to be handled in the typechecker\nin checkStrictBinds (before Jan '17).\n\nWe define an \"unlifted bind\" to be any bind that binds an unlifted id. Note that\n\n  x :: Char\n  (# True, x #) = blah\n\nis *not* an unlifted bind. Unlifted binds are detected by HsUtils.isUnliftedHsBind.\n\nDefine a \"banged bind\" to have a top-level bang. Detected by HsPat.isBangedHsBind.\nDefine a \"strict bind\" to be either an unlifted bind or a banged bind.\n\nThe restrictions are:\n  1. Strict binds may not be top-level. Checked in dsTopLHsBinds.\n\n  2. Unlifted binds must also be banged. (There is no trouble to compile an unbanged\n     unlifted bind, but an unbanged bind looks lazy, and we don't want users to be\n     surprised by the strictness of an unlifted bind.) Checked in first clause\n     of DsExpr.ds_val_bind.\n\n  3. Unlifted binds may not have polymorphism (#6078). (That is, no quantified type\n     variables or constraints.) Checked in first clause\n     of DsExpr.ds_val_bind.\n\n  4. Unlifted binds may not be recursive. Checked in second clause of ds_val_bind.\n\n-}\n\n------------------------\ndsSpecs :: CoreExpr     -- Its rhs\n        -> TcSpecPrags\n        -> DsM ( OrdList (Id,CoreExpr)  -- Binding for specialised Ids\n               , [CoreRule] )           -- Rules for the Global Ids\n-- See Note [Handling SPECIALISE pragmas] in TcBinds\ndsSpecs _ IsDefaultMethod = return (nilOL, [])\ndsSpecs poly_rhs (SpecPrags sps)\n  = do { pairs <- mapMaybeM (dsSpec (Just poly_rhs)) sps\n       ; let (spec_binds_s, rules) = unzip pairs\n       ; return (concatOL spec_binds_s, rules) }\n\ndsSpec :: Maybe CoreExpr        -- Just rhs => RULE is for a local binding\n                                -- Nothing => RULE is for an imported Id\n                                --            rhs is in the Id's unfolding\n       -> Located TcSpecPrag\n       -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule))\ndsSpec mb_poly_rhs (dL->L loc (SpecPrag poly_id spec_co spec_inl))\n  | isJust (isClassOpId_maybe poly_id)\n  = putSrcSpanDs loc $\n    do { warnDs NoReason (text \"Ignoring useless SPECIALISE pragma for class method selector\"\n                          <+> quotes (ppr poly_id))\n       ; return Nothing  }  -- There is no point in trying to specialise a class op\n                            -- Moreover, classops don't (currently) have an inl_sat arity set\n                            -- (it would be Just 0) and that in turn makes makeCorePair bleat\n\n  | no_act_spec && isNeverActive rule_act\n  = putSrcSpanDs loc $\n    do { warnDs NoReason (text \"Ignoring useless SPECIALISE pragma for NOINLINE function:\"\n                          <+> quotes (ppr poly_id))\n       ; return Nothing  }  -- Function is NOINLINE, and the specialisation inherits that\n                            -- See Note [Activation pragmas for SPECIALISE]\n\n  | otherwise\n  = putSrcSpanDs loc $\n    do { uniq <- newUnique\n       ; let poly_name = idName poly_id\n             spec_occ  = mkSpecOcc (getOccName poly_name)\n             spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name)\n             (spec_bndrs, spec_app) = collectHsWrapBinders spec_co\n               -- spec_co looks like\n               --         \\spec_bndrs. [] spec_args\n               -- perhaps with the body of the lambda wrapped in some WpLets\n               -- E.g. /\\a \\(d:Eq a). let d2 = $df d in [] (Maybe a) d2\n\n       ; core_app <- dsHsWrapper spec_app\n\n       ; let ds_lhs  = core_app (Var poly_id)\n             spec_ty = mkLamTypes spec_bndrs (exprType ds_lhs)\n       ; -- pprTrace \"dsRule\" (vcat [ text \"Id:\" <+> ppr poly_id\n         --                         , text \"spec_co:\" <+> ppr spec_co\n         --                         , text \"ds_rhs:\" <+> ppr ds_lhs ]) $\n         dflags <- getDynFlags\n       ; case decomposeRuleLhs dflags spec_bndrs ds_lhs of {\n           Left msg -> do { warnDs NoReason msg; return Nothing } ;\n           Right (rule_bndrs, _fn, args) -> do\n\n       { this_mod <- getModule\n       ; let fn_unf    = realIdUnfolding poly_id\n             spec_unf  = specUnfolding dflags spec_bndrs core_app arity_decrease fn_unf\n             spec_id   = mkLocalId spec_name spec_ty\n                            `setInlinePragma` inl_prag\n                            `setIdUnfolding`  spec_unf\n             arity_decrease = count isValArg args - count isId spec_bndrs\n\n       ; rule <- dsMkUserRule this_mod is_local_id\n                        (mkFastString (\"SPEC \" ++ showPpr dflags poly_name))\n                        rule_act poly_name\n                        rule_bndrs args\n                        (mkVarApps (Var spec_id) spec_bndrs)\n\n       ; let spec_rhs = mkLams spec_bndrs (core_app poly_rhs)\n\n-- Commented out: see Note [SPECIALISE on INLINE functions]\n--       ; when (isInlinePragma id_inl)\n--              (warnDs $ text \"SPECIALISE pragma on INLINE function probably won't fire:\"\n--                        <+> quotes (ppr poly_name))\n\n       ; return (Just (unitOL (spec_id, spec_rhs), rule))\n            -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because\n            --     makeCorePair overwrites the unfolding, which we have\n            --     just created using specUnfolding\n       } } }\n  where\n    is_local_id = isJust mb_poly_rhs\n    poly_rhs | Just rhs <-  mb_poly_rhs\n             = rhs          -- Local Id; this is its rhs\n             | Just unfolding <- maybeUnfoldingTemplate (realIdUnfolding poly_id)\n             = unfolding    -- Imported Id; this is its unfolding\n                            -- Use realIdUnfolding so we get the unfolding\n                            -- even when it is a loop breaker.\n                            -- We want to specialise recursive functions!\n             | otherwise = pprPanic \"dsImpSpecs\" (ppr poly_id)\n                            -- The type checker has checked that it *has* an unfolding\n\n    id_inl = idInlinePragma poly_id\n\n    -- See Note [Activation pragmas for SPECIALISE]\n    inl_prag | not (isDefaultInlinePragma spec_inl)    = spec_inl\n             | not is_local_id  -- See Note [Specialising imported functions]\n                                 -- in OccurAnal\n             , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma\n             | otherwise                               = id_inl\n     -- Get the INLINE pragma from SPECIALISE declaration, or,\n     -- failing that, from the original Id\n\n    spec_prag_act = inlinePragmaActivation spec_inl\n\n    -- See Note [Activation pragmas for SPECIALISE]\n    -- no_act_spec is True if the user didn't write an explicit\n    -- phase specification in the SPECIALISE pragma\n    no_act_spec = case inlinePragmaSpec spec_inl of\n                    NoInline -> isNeverActive  spec_prag_act\n                    _        -> isAlwaysActive spec_prag_act\n    rule_act | no_act_spec = inlinePragmaActivation id_inl   -- Inherit\n             | otherwise   = spec_prag_act                   -- Specified by user\n\n\ndsMkUserRule :: Module -> Bool -> RuleName -> Activation\n       -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> DsM CoreRule\ndsMkUserRule this_mod is_local name act fn bndrs args rhs = do\n    let rule = mkRule this_mod False is_local name act fn bndrs args rhs\n    dflags <- getDynFlags\n    when (isOrphan (ru_orphan rule) && wopt Opt_WarnOrphans dflags) $\n        warnDs (Reason Opt_WarnOrphans) (ruleOrphWarn rule)\n    return rule\n\nruleOrphWarn :: CoreRule -> SDoc\nruleOrphWarn rule = text \"Orphan rule:\" <+> ppr rule\n\n{- Note [SPECIALISE on INLINE functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used to warn that using SPECIALISE for a function marked INLINE\nwould be a no-op; but it isn't!  Especially with worker/wrapper split\nwe might have\n   {-# INLINE f #-}\n   f :: Ord a => Int -> a -> ...\n   f d x y = case x of I# x' -> $wf d x' y\n\nWe might want to specialise 'f' so that we in turn specialise '$wf'.\nWe can't even /name/ '$wf' in the source code, so we can't specialise\nit even if we wanted to.  Trac #10721 is a case in point.\n\nNote [Activation pragmas for SPECIALISE]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFrom a user SPECIALISE pragma for f, we generate\n  a) A top-level binding    spec_fn = rhs\n  b) A RULE                 f dOrd = spec_fn\n\nWe need two pragma-like things:\n\n* spec_fn's inline pragma: inherited from f's inline pragma (ignoring\n                           activation on SPEC), unless overriden by SPEC INLINE\n\n* Activation of RULE: from SPECIALISE pragma (if activation given)\n                      otherwise from f's inline pragma\n\nThis is not obvious (see Trac #5237)!\n\nExamples      Rule activation   Inline prag on spec'd fn\n---------------------------------------------------------------------\nSPEC [n] f :: ty            [n]   Always, or NOINLINE [n]\n                                  copy f's prag\n\nNOINLINE f\nSPEC [n] f :: ty            [n]   NOINLINE\n                                  copy f's prag\n\nNOINLINE [k] f\nSPEC [n] f :: ty            [n]   NOINLINE [k]\n                                  copy f's prag\n\nINLINE [k] f\nSPEC [n] f :: ty            [n]   INLINE [k]\n                                  copy f's prag\n\nSPEC INLINE [n] f :: ty     [n]   INLINE [n]\n                                  (ignore INLINE prag on f,\n                                  same activation for rule and spec'd fn)\n\nNOINLINE [k] f\nSPEC f :: ty                [n]   INLINE [k]\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Adding inline pragmas}\n*                                                                      *\n************************************************************************\n-}\n\ndecomposeRuleLhs :: DynFlags -> [Var] -> CoreExpr\n                 -> Either SDoc ([Var], Id, [CoreExpr])\n-- (decomposeRuleLhs bndrs lhs) takes apart the LHS of a RULE,\n-- The 'bndrs' are the quantified binders of the rules, but decomposeRuleLhs\n-- may add some extra dictionary binders (see Note [Free dictionaries])\n--\n-- Returns an error message if the LHS isn't of the expected shape\n-- Note [Decomposing the left-hand side of a RULE]\ndecomposeRuleLhs dflags orig_bndrs orig_lhs\n  | not (null unbound)    -- Check for things unbound on LHS\n                          -- See Note [Unused spec binders]\n  = Left (vcat (map dead_msg unbound))\n  | Var funId <- fun2\n  , Just con <- isDataConId_maybe funId\n  = Left (constructor_msg con) -- See Note [No RULES on datacons]\n  | Just (fn_id, args) <- decompose fun2 args2\n  , let extra_bndrs = mk_extra_bndrs fn_id args\n  = -- pprTrace \"decmposeRuleLhs\" (vcat [ text \"orig_bndrs:\" <+> ppr orig_bndrs\n    --                                  , text \"orig_lhs:\" <+> ppr orig_lhs\n    --                                  , text \"lhs1:\"     <+> ppr lhs1\n    --                                  , text \"extra_dict_bndrs:\" <+> ppr extra_dict_bndrs\n    --                                  , text \"fn_id:\" <+> ppr fn_id\n    --                                  , text \"args:\"   <+> ppr args]) $\n    Right (orig_bndrs ++ extra_bndrs, fn_id, args)\n\n  | otherwise\n  = Left bad_shape_msg\n where\n   lhs1         = drop_dicts orig_lhs\n   lhs2         = simpleOptExpr dflags lhs1  -- See Note [Simplify rule LHS]\n   (fun2,args2) = collectArgs lhs2\n\n   lhs_fvs    = exprFreeVars lhs2\n   unbound    = filterOut (`elemVarSet` lhs_fvs) orig_bndrs\n\n   orig_bndr_set = mkVarSet orig_bndrs\n\n        -- Add extra tyvar binders: Note [Free tyvars in rule LHS]\n        -- and extra dict binders: Note [Free dictionaries in rule LHS]\n   mk_extra_bndrs fn_id args\n     = scopedSort unbound_tvs ++ unbound_dicts\n     where\n       unbound_tvs   = [ v | v <- unbound_vars, isTyVar v ]\n       unbound_dicts = [ mkLocalId (localiseName (idName d)) (idType d)\n                       | d <- unbound_vars, isDictId d ]\n       unbound_vars  = [ v | v <- exprsFreeVarsList args\n                           , not (v `elemVarSet` orig_bndr_set)\n                           , not (v == fn_id) ]\n         -- fn_id: do not quantify over the function itself, which may\n         -- itself be a dictionary (in pathological cases, Trac #10251)\n\n   decompose (Var fn_id) args\n      | not (fn_id `elemVarSet` orig_bndr_set)\n      = Just (fn_id, args)\n\n   decompose _ _ = Nothing\n\n   bad_shape_msg = hang (text \"RULE left-hand side too complicated to desugar\")\n                      2 (vcat [ text \"Optimised lhs:\" <+> ppr lhs2\n                              , text \"Orig lhs:\" <+> ppr orig_lhs])\n   dead_msg bndr = hang (sep [ text \"Forall'd\" <+> pp_bndr bndr\n                             , text \"is not bound in RULE lhs\"])\n                      2 (vcat [ text \"Orig bndrs:\" <+> ppr orig_bndrs\n                              , text \"Orig lhs:\" <+> ppr orig_lhs\n                              , text \"optimised lhs:\" <+> ppr lhs2 ])\n   pp_bndr bndr\n    | isTyVar bndr = text \"type variable\" <+> quotes (ppr bndr)\n    | isEvVar bndr = text \"constraint\"    <+> quotes (ppr (varType bndr))\n    | otherwise    = text \"variable\"      <+> quotes (ppr bndr)\n\n   constructor_msg con = vcat\n     [ text \"A constructor,\" <+> ppr con <>\n         text \", appears as outermost match in RULE lhs.\"\n     , text \"This rule will be ignored.\" ]\n\n   drop_dicts :: CoreExpr -> CoreExpr\n   drop_dicts e\n       = wrap_lets needed bnds body\n     where\n       needed = orig_bndr_set `minusVarSet` exprFreeVars body\n       (bnds, body) = split_lets (occurAnalyseExpr e)\n           -- The occurAnalyseExpr drops dead bindings which is\n           -- crucial to ensure that every binding is used later;\n           -- which in turn makes wrap_lets work right\n\n   split_lets :: CoreExpr -> ([(DictId,CoreExpr)], CoreExpr)\n   split_lets (Let (NonRec d r) body)\n     | isDictId d\n     = ((d,r):bs, body')\n     where (bs, body') = split_lets body\n\n    -- handle \"unlifted lets\" too, needed for \"map/coerce\"\n   split_lets (Case r d _ [(DEFAULT, _, body)])\n     | isCoVar d\n     = ((d,r):bs, body')\n     where (bs, body') = split_lets body\n\n   split_lets e = ([], e)\n\n   wrap_lets :: VarSet -> [(DictId,CoreExpr)] -> CoreExpr -> CoreExpr\n   wrap_lets _ [] body = body\n   wrap_lets needed ((d, r) : bs) body\n     | rhs_fvs `intersectsVarSet` needed = mkCoreLet (NonRec d r) (wrap_lets needed' bs body)\n     | otherwise                         = wrap_lets needed bs body\n     where\n       rhs_fvs = exprFreeVars r\n       needed' = (needed `minusVarSet` rhs_fvs) `extendVarSet` d\n\n{-\nNote [Decomposing the left-hand side of a RULE]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are several things going on here.\n* drop_dicts: see Note [Drop dictionary bindings on rule LHS]\n* simpleOptExpr: see Note [Simplify rule LHS]\n* extra_dict_bndrs: see Note [Free dictionaries]\n\nNote [Free tyvars on rule LHS]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data T a = C\n\n  foo :: T a -> Int\n  foo C = 1\n\n  {-# RULES \"myrule\"  foo C = 1 #-}\n\nAfter type checking the LHS becomes (foo alpha (C alpha)), where alpha\nis an unbound meta-tyvar.  The zonker in TcHsSyn is careful not to\nturn the free alpha into Any (as it usually does).  Instead it turns it\ninto a TyVar 'a'.  See TcHsSyn Note [Zonking the LHS of a RULE].\n\nNow we must quantify over that 'a'.  It's /really/ inconvenient to do that\nin the zonker, because the HsExpr data type is very large.  But it's /easy/\nto do it here in the desugarer.\n\nMoreover, we have to do something rather similar for dictionaries;\nsee Note [Free dictionaries on rule LHS].   So that's why we look for\ntype variables free on the LHS, and quantify over them.\n\nNote [Free dictionaries on rule LHS]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the LHS of a specialisation rule, (/\\as\\ds. f es) has a free dict,\nwhich is presumably in scope at the function definition site, we can quantify\nover it too.  *Any* dict with that type will do.\n\nSo for example when you have\n        f :: Eq a => a -> a\n        f = <rhs>\n        ... SPECIALISE f :: Int -> Int ...\n\nThen we get the SpecPrag\n        SpecPrag (f Int dInt)\n\nAnd from that we want the rule\n\n        RULE forall dInt. f Int dInt = f_spec\n        f_spec = let f = <rhs> in f Int dInt\n\nBut be careful!  That dInt might be GHC.Base.$fOrdInt, which is an External\nName, and you can't bind them in a lambda or forall without getting things\nconfused.   Likewise it might have an InlineRule or something, which would be\nutterly bogus. So we really make a fresh Id, with the same unique and type\nas the old one, but with an Internal name and no IdInfo.\n\nNote [Drop dictionary bindings on rule LHS]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ndrop_dicts drops dictionary bindings on the LHS where possible.\n   E.g.  let d:Eq [Int] = $fEqList $fEqInt in f d\n     --> f d\n   Reasoning here is that there is only one d:Eq [Int], and so we can\n   quantify over it. That makes 'd' free in the LHS, but that is later\n   picked up by extra_dict_bndrs (Note [Dead spec binders]).\n\n   NB 1: We can only drop the binding if the RHS doesn't bind\n         one of the orig_bndrs, which we assume occur on RHS.\n         Example\n            f :: (Eq a) => b -> a -> a\n            {-# SPECIALISE f :: Eq a => b -> [a] -> [a] #-}\n         Here we want to end up with\n            RULE forall d:Eq a.  f ($dfEqList d) = f_spec d\n         Of course, the ($dfEqlist d) in the pattern makes it less likely\n         to match, but there is no other way to get d:Eq a\n\n   NB 2: We do drop_dicts *before* simplOptEpxr, so that we expect all\n         the evidence bindings to be wrapped around the outside of the\n         LHS.  (After simplOptExpr they'll usually have been inlined.)\n         dsHsWrapper does dependency analysis, so that civilised ones\n         will be simple NonRec bindings.  We don't handle recursive\n         dictionaries!\n\n    NB3: In the common case of a non-overloaded, but perhaps-polymorphic\n         specialisation, we don't need to bind *any* dictionaries for use\n         in the RHS. For example (Trac #8331)\n             {-# SPECIALIZE INLINE useAbstractMonad :: ReaderST s Int #-}\n             useAbstractMonad :: MonadAbstractIOST m => m Int\n         Here, deriving (MonadAbstractIOST (ReaderST s)) is a lot of code\n         but the RHS uses no dictionaries, so we want to end up with\n             RULE forall s (d :: MonadAbstractIOST (ReaderT s)).\n                useAbstractMonad (ReaderT s) d = $suseAbstractMonad s\n\n   Trac #8848 is a good example of where there are some interesting\n   dictionary bindings to discard.\n\nThe drop_dicts algorithm is based on these observations:\n\n  * Given (let d = rhs in e) where d is a DictId,\n    matching 'e' will bind e's free variables.\n\n  * So we want to keep the binding if one of the needed variables (for\n    which we need a binding) is in fv(rhs) but not already in fv(e).\n\n  * The \"needed variables\" are simply the orig_bndrs.  Consider\n       f :: (Eq a, Show b) => a -> b -> String\n       ... SPECIALISE f :: (Show b) => Int -> b -> String ...\n    Then orig_bndrs includes the *quantified* dictionaries of the type\n    namely (dsb::Show b), but not the one for Eq Int\n\nSo we work inside out, applying the above criterion at each step.\n\n\nNote [Simplify rule LHS]\n~~~~~~~~~~~~~~~~~~~~~~~~\nsimplOptExpr occurrence-analyses and simplifies the LHS:\n\n   (a) Inline any remaining dictionary bindings (which hopefully\n       occur just once)\n\n   (b) Substitute trivial lets, so that they don't get in the way.\n       Note that we substitute the function too; we might\n       have this as a LHS:  let f71 = M.f Int in f71\n\n   (c) Do eta reduction.  To see why, consider the fold/build rule,\n       which without simplification looked like:\n          fold k z (build (/\\a. g a))  ==>  ...\n       This doesn't match unless you do eta reduction on the build argument.\n       Similarly for a LHS like\n         augment g (build h)\n       we do not want to get\n         augment (\\a. g a) (build h)\n       otherwise we don't match when given an argument like\n          augment (\\a. h a a) (build h)\n\nNote [Matching seqId]\n~~~~~~~~~~~~~~~~~~~\nThe desugarer turns (seq e r) into (case e of _ -> r), via a special-case hack\nand this code turns it back into an application of seq!\nSee Note [Rules for seq] in MkId for the details.\n\nNote [Unused spec binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n        f :: a -> a\n        ... SPECIALISE f :: Eq a => a -> a ...\nIt's true that this *is* a more specialised type, but the rule\nwe get is something like this:\n        f_spec d = f\n        RULE: f = f_spec d\nNote that the rule is bogus, because it mentions a 'd' that is\nnot bound on the LHS!  But it's a silly specialisation anyway, because\nthe constraint is unused.  We could bind 'd' to (error \"unused\")\nbut it seems better to reject the program because it's almost certainly\na mistake.  That's what the isDeadBinder call detects.\n\nNote [No RULES on datacons]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nPreviously, `RULES` like\n\n    \"JustNothing\" forall x . Just x = Nothing\n\nwere allowed. Simon Peyton Jones says this seems to have been a\nmistake, that such rules have never been supported intentionally,\nand that he doesn't know if they can break in horrible ways.\nFurthermore, Ben Gamari and Reid Barton are considering trying to\ndetect the presence of \"static data\" that the simplifier doesn't\nneed to traverse at all. Such rules do not play well with that.\nSo for now, we ban them altogether as requested by #13290. See also #7398.\n\n\n************************************************************************\n*                                                                      *\n                Desugaring evidence\n*                                                                      *\n************************************************************************\n\n-}\n\ndsHsWrapper :: HsWrapper -> DsM (CoreExpr -> CoreExpr)\ndsHsWrapper WpHole            = return $ \\e -> e\ndsHsWrapper (WpTyApp ty)      = return $ \\e -> App e (Type ty)\ndsHsWrapper (WpEvLam ev)      = return $ Lam ev\ndsHsWrapper (WpTyLam tv)      = return $ Lam tv\ndsHsWrapper (WpLet ev_binds)  = do { bs <- dsTcEvBinds ev_binds\n                                   ; return (mkCoreLets bs) }\ndsHsWrapper (WpCompose c1 c2) = do { w1 <- dsHsWrapper c1\n                                   ; w2 <- dsHsWrapper c2\n                                   ; return (w1 . w2) }\n -- See comments on WpFun in TcEvidence for an explanation of what\n -- the specification of this clause is\ndsHsWrapper (WpFun c1 c2 t1 doc)\n                              = do { x  <- newSysLocalDsNoLP t1\n                                   ; w1 <- dsHsWrapper c1\n                                   ; w2 <- dsHsWrapper c2\n                                   ; let app f a = mkCoreAppDs (text \"dsHsWrapper\") f a\n                                         arg     = w1 (Var x)\n                                   ; (_, ok) <- askNoErrsDs $ dsNoLevPolyExpr arg doc\n                                   ; if ok\n                                     then return (\\e -> (Lam x (w2 (app e arg))))\n                                     else return id }  -- this return is irrelevant\ndsHsWrapper (WpCast co)       = ASSERT(coercionRole co == Representational)\n                                return $ \\e -> mkCastDs e co\ndsHsWrapper (WpEvApp tm)      = do { core_tm <- dsEvTerm tm\n                                   ; return (\\e -> App e core_tm) }\n\n--------------------------------------\ndsTcEvBinds_s :: [TcEvBinds] -> DsM [CoreBind]\ndsTcEvBinds_s []       = return []\ndsTcEvBinds_s (b:rest) = ASSERT( null rest )  -- Zonker ensures null\n                         dsTcEvBinds b\n\ndsTcEvBinds :: TcEvBinds -> DsM [CoreBind]\ndsTcEvBinds (TcEvBinds {}) = panic \"dsEvBinds\"    -- Zonker has got rid of this\ndsTcEvBinds (EvBinds bs)   = dsEvBinds bs\n\ndsEvBinds :: Bag EvBind -> DsM [CoreBind]\ndsEvBinds bs\n  = do { ds_bs <- mapBagM dsEvBind bs\n       ; return (mk_ev_binds ds_bs) }\n\nmk_ev_binds :: Bag (Id,CoreExpr) -> [CoreBind]\n-- We do SCC analysis of the evidence bindings, /after/ desugaring\n-- them. This is convenient: it means we can use the CoreSyn\n-- free-variable functions rather than having to do accurate free vars\n-- for EvTerm.\nmk_ev_binds ds_binds\n  = map ds_scc (stronglyConnCompFromEdgedVerticesUniq edges)\n  where\n    edges :: [ Node EvVar (EvVar,CoreExpr) ]\n    edges = foldrBag ((:) . mk_node) [] ds_binds\n\n    mk_node :: (Id, CoreExpr) -> Node EvVar (EvVar,CoreExpr)\n    mk_node b@(var, rhs)\n      = DigraphNode { node_payload = b\n                    , node_key = var\n                    , node_dependencies = nonDetEltsUniqSet $\n                                          exprFreeVars rhs `unionVarSet`\n                                          coVarsOfType (varType var) }\n      -- It's OK to use nonDetEltsUniqSet here as stronglyConnCompFromEdgedVertices\n      -- is still deterministic even if the edges are in nondeterministic order\n      -- as explained in Note [Deterministic SCC] in Digraph.\n\n    ds_scc (AcyclicSCC (v,r)) = NonRec v r\n    ds_scc (CyclicSCC prs)    = Rec prs\n\ndsEvBind :: EvBind -> DsM (Id, CoreExpr)\ndsEvBind (EvBind { eb_lhs = v, eb_rhs = r}) = liftM ((,) v) (dsEvTerm r)\n\n\n{-**********************************************************************\n*                                                                      *\n           Desugaring EvTerms\n*                                                                      *\n**********************************************************************-}\n\ndsEvTerm :: EvTerm -> DsM CoreExpr\ndsEvTerm (EvExpr e)          = return e\ndsEvTerm (EvTypeable ty ev)  = dsEvTypeable ty ev\ndsEvTerm (EvFun { et_tvs = tvs, et_given = given\n                , et_binds = ev_binds, et_body = wanted_id })\n  = do { ds_ev_binds <- dsTcEvBinds ev_binds\n       ; return $ (mkLams (tvs ++ given) $\n                   mkCoreLets ds_ev_binds $\n                   Var wanted_id) }\n\n\n{-**********************************************************************\n*                                                                      *\n           Desugaring Typeable dictionaries\n*                                                                      *\n**********************************************************************-}\n\ndsEvTypeable :: Type -> EvTypeable -> DsM CoreExpr\n-- Return a CoreExpr :: Typeable ty\n-- This code is tightly coupled to the representation\n-- of TypeRep, in base library Data.Typeable.Internals\ndsEvTypeable ty ev\n  = do { tyCl <- dsLookupTyCon typeableClassName    -- Typeable\n       ; let kind = typeKind ty\n             Just typeable_data_con\n                 = tyConSingleDataCon_maybe tyCl    -- \"Data constructor\"\n                                                    -- for Typeable\n\n       ; rep_expr <- ds_ev_typeable ty ev           -- :: TypeRep a\n\n       -- Package up the method as `Typeable` dictionary\n       ; return $ mkConApp typeable_data_con [Type kind, Type ty, rep_expr] }\n\ntype TypeRepExpr = CoreExpr\n\n-- | Returns a @CoreExpr :: TypeRep ty@\nds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr\nds_ev_typeable ty (EvTypeableTyCon tc kind_ev)\n  = do { mkTrCon <- dsLookupGlobalId mkTrConName\n                    -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a\n       ; someTypeRepTyCon <- dsLookupTyCon someTypeRepTyConName\n       ; someTypeRepDataCon <- dsLookupDataCon someTypeRepDataConName\n                    -- SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep\n\n       ; tc_rep <- tyConRep tc                      -- :: TyCon\n       ; let ks = tyConAppArgs ty\n             -- Construct a SomeTypeRep\n             toSomeTypeRep :: Type -> EvTerm -> DsM CoreExpr\n             toSomeTypeRep t ev = do\n                 rep <- getRep ev t\n                 return $ mkCoreConApps someTypeRepDataCon [Type (typeKind t), Type t, rep]\n       ; kind_arg_reps <- sequence $ zipWith toSomeTypeRep ks kind_ev   -- :: TypeRep t\n       ; let -- :: [SomeTypeRep]\n             kind_args = mkListExpr (mkTyConTy someTypeRepTyCon) kind_arg_reps\n\n         -- Note that we use the kind of the type, not the TyCon from which it\n         -- is constructed since the latter may be kind polymorphic whereas the\n         -- former we know is not (we checked in the solver).\n       ; let expr = mkApps (Var mkTrCon) [ Type (typeKind ty)\n                                         , Type ty\n                                         , tc_rep\n                                         , kind_args ]\n       -- ; pprRuntimeTrace \"Trace mkTrTyCon\" (ppr expr) expr\n       ; return expr\n       }\n\nds_ev_typeable ty (EvTypeableTyApp ev1 ev2)\n  | Just (t1,t2) <- splitAppTy_maybe ty\n  = do { e1  <- getRep ev1 t1\n       ; e2  <- getRep ev2 t2\n       ; mkTrApp <- dsLookupGlobalId mkTrAppName\n                    -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n                    --            TypeRep a -> TypeRep b -> TypeRep (a b)\n       ; let (k1, k2) = splitFunTy (typeKind t1)\n       ; let expr =  mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])\n                            [ e1, e2 ]\n       -- ; pprRuntimeTrace \"Trace mkTrApp\" (ppr expr) expr\n       ; return expr\n       }\n\nds_ev_typeable ty (EvTypeableTrFun ev1 ev2)\n  | Just (t1,t2) <- splitFunTy_maybe ty\n  = do { e1 <- getRep ev1 t1\n       ; e2 <- getRep ev2 t2\n       ; mkTrFun <- dsLookupGlobalId mkTrFunName\n                    -- mkTrFun :: forall r1 r2 (a :: TYPE r1) (b :: TYPE r2).\n                    --            TypeRep a -> TypeRep b -> TypeRep (a -> b)\n       ; let r1 = getRuntimeRep t1\n             r2 = getRuntimeRep t2\n       ; return $ mkApps (mkTyApps (Var mkTrFun) [r1, r2, t1, t2])\n                         [ e1, e2 ]\n       }\n\nds_ev_typeable ty (EvTypeableTyLit ev)\n  = -- See Note [Typeable for Nat and Symbol] in TcInteract\n    do { fun  <- dsLookupGlobalId tr_fun\n       ; dict <- dsEvTerm ev       -- Of type KnownNat/KnownSymbol\n       ; let proxy = mkTyApps (Var proxyHashId) [ty_kind, ty]\n       ; return (mkApps (mkTyApps (Var fun) [ty]) [ dict, proxy ]) }\n  where\n    ty_kind = typeKind ty\n\n    -- tr_fun is the Name of\n    --       typeNatTypeRep    :: KnownNat    a => Proxy# a -> TypeRep a\n    -- of    typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a\n    tr_fun | ty_kind `eqType` typeNatKind    = typeNatTypeRepName\n           | ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepName\n           | otherwise = panic \"dsEvTypeable: unknown type lit kind\"\n\nds_ev_typeable ty ev\n  = pprPanic \"dsEvTypeable\" (ppr ty $$ ppr ev)\n\ngetRep :: EvTerm          -- ^ EvTerm for @Typeable ty@\n       -> Type            -- ^ The type @ty@\n       -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@\n                          -- namely @typeRep# dict@\n-- Remember that\n--   typeRep# :: forall k (a::k). Typeable k a -> TypeRep a\ngetRep ev ty\n  = do { typeable_expr <- dsEvTerm ev\n       ; typeRepId     <- dsLookupGlobalId typeRepIdName\n       ; let ty_args = [typeKind ty, ty]\n       ; return (mkApps (mkTyApps (Var typeRepId) ty_args) [ typeable_expr ]) }\n\ntyConRep :: TyCon -> DsM CoreExpr\n-- Returns CoreExpr :: TyCon\ntyConRep tc\n  | Just tc_rep_nm <- tyConRepName_maybe tc\n  = do { tc_rep_id <- dsLookupGlobalId tc_rep_nm\n       ; return (Var tc_rep_id) }\n  | otherwise\n  = pprPanic \"tyConRep\" (ppr tc)\n", "num_lines": 1325}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1994-1998\n\n\nDesugaring foreign calls\n-}\n\n{-# LANGUAGE CPP #-}\nmodule DsCCall\n        ( dsCCall\n        , mkFCall\n        , unboxArg\n        , boxResult\n        , resultWrapper\n        ) where\n\n#include \"HsVersions.h\"\n\n\nimport GhcPrelude\n\nimport CoreSyn\n\nimport DsMonad\nimport CoreUtils\nimport MkCore\nimport MkId\nimport ForeignCall\nimport DataCon\nimport DsUtils\n\nimport TcType\nimport Type\nimport Id   ( Id )\nimport Coercion\nimport PrimOp\nimport TysPrim\nimport TyCon\nimport TysWiredIn\nimport BasicTypes\nimport Literal\nimport PrelNames\nimport DynFlags\nimport Outputable\nimport Util\n\nimport Data.Maybe\n\n{-\nDesugaring of @ccall@s consists of adding some state manipulation,\nunboxing any boxed primitive arguments and boxing the result if\ndesired.\n\nThe state stuff just consists of adding in\n@PrimIO (\\ s -> case s of { S# s# -> ... })@ in an appropriate place.\n\nThe unboxing is straightforward, as all information needed to unbox is\navailable from the type.  For each boxed-primitive argument, we\ntransform:\n\\begin{verbatim}\n   _ccall_ foo [ r, t1, ... tm ] e1 ... em\n   |\n   |\n   V\n   case e1 of { T1# x1# ->\n   ...\n   case em of { Tm# xm# -> xm#\n   ccall# foo [ r, t1#, ... tm# ] x1# ... xm#\n   } ... }\n\\end{verbatim}\n\nThe reboxing of a @_ccall_@ result is a bit tricker: the types don't\ncontain information about the state-pairing functions so we have to\nkeep a list of \\tr{(type, s-p-function)} pairs.  We transform as\nfollows:\n\\begin{verbatim}\n   ccall# foo [ r, t1#, ... tm# ] e1# ... em#\n   |\n   |\n   V\n   \\ s# -> case (ccall# foo [ r, t1#, ... tm# ] s# e1# ... em#) of\n          (StateAnd<r># result# state#) -> (R# result#, realWorld#)\n\\end{verbatim}\n-}\n\ndsCCall :: CLabelString -- C routine to invoke\n        -> [CoreExpr]   -- Arguments (desugared)\n                        -- Precondition: none have levity-polymorphic types\n        -> Safety       -- Safety of the call\n        -> Type         -- Type of the result: IO t\n        -> DsM CoreExpr -- Result, of type ???\n\ndsCCall lbl args may_gc result_ty\n  = do (unboxed_args, arg_wrappers) <- mapAndUnzipM unboxArg args\n       (ccall_result_ty, res_wrapper) <- boxResult result_ty\n       uniq <- newUnique\n       dflags <- getDynFlags\n       let\n           target = StaticTarget NoSourceText lbl Nothing True\n           the_fcall    = CCall (CCallSpec target CCallConv may_gc)\n           the_prim_app = mkFCall dflags uniq the_fcall unboxed_args ccall_result_ty\n       return (foldr ($) (res_wrapper the_prim_app) arg_wrappers)\n\nmkFCall :: DynFlags -> Unique -> ForeignCall\n        -> [CoreExpr]     -- Args\n        -> Type           -- Result type\n        -> CoreExpr\n-- Construct the ccall.  The only tricky bit is that the ccall Id should have\n-- no free vars, so if any of the arg tys do we must give it a polymorphic type.\n--      [I forget *why* it should have no free vars!]\n-- For example:\n--      mkCCall ... [s::StablePtr (a->b), x::Addr, c::Char]\n--\n-- Here we build a ccall thus\n--      (ccallid::(forall a b.  StablePtr (a -> b) -> Addr -> Char -> IO Addr))\n--                      a b s x c\nmkFCall dflags uniq the_fcall val_args res_ty\n  = ASSERT( all isTyVar tyvars )  -- this must be true because the type is top-level\n    mkApps (mkVarApps (Var the_fcall_id) tyvars) val_args\n  where\n    arg_tys = map exprType val_args\n    body_ty = (mkVisFunTys arg_tys res_ty)\n    tyvars  = tyCoVarsOfTypeWellScoped body_ty\n    ty      = mkInvForAllTys tyvars body_ty\n    the_fcall_id = mkFCallId dflags uniq the_fcall ty\n\nunboxArg :: CoreExpr                    -- The supplied argument, not levity-polymorphic\n         -> DsM (CoreExpr,              -- To pass as the actual argument\n                 CoreExpr -> CoreExpr   -- Wrapper to unbox the arg\n                )\n-- Example: if the arg is e::Int, unboxArg will return\n--      (x#::Int#, \\W. case x of I# x# -> W)\n-- where W is a CoreExpr that probably mentions x#\n\n-- always returns a non-levity-polymorphic expression\n\nunboxArg arg\n  -- Primitive types: nothing to unbox\n  | isPrimitiveType arg_ty\n  = return (arg, \\body -> body)\n\n  -- Recursive newtypes\n  | Just(co, _rep_ty) <- topNormaliseNewType_maybe arg_ty\n  = unboxArg (mkCastDs arg co)\n\n  -- Booleans\n  | Just tc <- tyConAppTyCon_maybe arg_ty,\n    tc `hasKey` boolTyConKey\n  = do dflags <- getDynFlags\n       prim_arg <- newSysLocalDs intPrimTy\n       return (Var prim_arg,\n              \\ body -> Case (mkWildCase arg arg_ty intPrimTy\n                                       [(DataAlt falseDataCon,[],mkIntLit dflags 0),\n                                        (DataAlt trueDataCon, [],mkIntLit dflags 1)])\n                                        -- In increasing tag order!\n                             prim_arg\n                             (exprType body)\n                             [(DEFAULT,[],body)])\n\n  -- Data types with a single constructor, which has a single, primitive-typed arg\n  -- This deals with Int, Float etc; also Ptr, ForeignPtr\n  | is_product_type && data_con_arity == 1\n  = ASSERT2(isUnliftedType data_con_arg_ty1, pprType arg_ty)\n                        -- Typechecker ensures this\n    do case_bndr <- newSysLocalDs arg_ty\n       prim_arg <- newSysLocalDs data_con_arg_ty1\n       return (Var prim_arg,\n               \\ body -> Case arg case_bndr (exprType body) [(DataAlt data_con,[prim_arg],body)]\n              )\n\n  -- Byte-arrays, both mutable and otherwise; hack warning\n  -- We're looking for values of type ByteArray, MutableByteArray\n  --    data ByteArray          ix = ByteArray        ix ix ByteArray#\n  --    data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)\n  | is_product_type &&\n    data_con_arity == 3 &&\n    isJust maybe_arg3_tycon &&\n    (arg3_tycon ==  byteArrayPrimTyCon ||\n     arg3_tycon ==  mutableByteArrayPrimTyCon)\n  = do case_bndr <- newSysLocalDs arg_ty\n       vars@[_l_var, _r_var, arr_cts_var] <- newSysLocalsDs data_con_arg_tys\n       return (Var arr_cts_var,\n               \\ body -> Case arg case_bndr (exprType body) [(DataAlt data_con,vars,body)]\n              )\n\n  | otherwise\n  = do l <- getSrcSpanDs\n       pprPanic \"unboxArg: \" (ppr l <+> ppr arg_ty)\n  where\n    arg_ty                                      = exprType arg\n    maybe_product_type                          = splitDataProductType_maybe arg_ty\n    is_product_type                             = isJust maybe_product_type\n    Just (_, _, data_con, data_con_arg_tys)     = maybe_product_type\n    data_con_arity                              = dataConSourceArity data_con\n    (data_con_arg_ty1 : _)                      = data_con_arg_tys\n\n    (_ : _ : data_con_arg_ty3 : _) = data_con_arg_tys\n    maybe_arg3_tycon               = tyConAppTyCon_maybe data_con_arg_ty3\n    Just arg3_tycon                = maybe_arg3_tycon\n\nboxResult :: Type\n          -> DsM (Type, CoreExpr -> CoreExpr)\n\n-- Takes the result of the user-level ccall:\n--      either (IO t),\n--      or maybe just t for a side-effect-free call\n-- Returns a wrapper for the primitive ccall itself, along with the\n-- type of the result of the primitive ccall.  This result type\n-- will be of the form\n--      State# RealWorld -> (# State# RealWorld, t' #)\n-- where t' is the unwrapped form of t.  If t is simply (), then\n-- the result type will be\n--      State# RealWorld -> (# State# RealWorld #)\n\nboxResult result_ty\n  | Just (io_tycon, io_res_ty) <- tcSplitIOType_maybe result_ty\n        -- isIOType_maybe handles the case where the type is a\n        -- simple wrapping of IO.  E.g.\n        --      newtype Wrap a = W (IO a)\n        -- No coercion necessary because its a non-recursive newtype\n        -- (If we wanted to handle a *recursive* newtype too, we'd need\n        -- another case, and a coercion.)\n        -- The result is IO t, so wrap the result in an IO constructor\n  = do  { res <- resultWrapper io_res_ty\n        ; let extra_result_tys\n                = case res of\n                     (Just ty,_)\n                       | isUnboxedTupleType ty\n                       -> let Just ls = tyConAppArgs_maybe ty in tail ls\n                     _ -> []\n\n              return_result state anss\n                = mkCoreUbxTup\n                    (realWorldStatePrimTy : io_res_ty : extra_result_tys)\n                    (state : anss)\n\n        ; (ccall_res_ty, the_alt) <- mk_alt return_result res\n\n        ; state_id <- newSysLocalDs realWorldStatePrimTy\n        ; let io_data_con = head (tyConDataCons io_tycon)\n              toIOCon     = dataConWrapId io_data_con\n\n              wrap the_call =\n                              mkApps (Var toIOCon)\n                                     [ Type io_res_ty,\n                                       Lam state_id $\n                                       mkWildCase (App the_call (Var state_id))\n                                             ccall_res_ty\n                                             (coreAltType the_alt)\n                                             [the_alt]\n                                     ]\n\n        ; return (realWorldStatePrimTy `mkVisFunTy` ccall_res_ty, wrap) }\n\nboxResult result_ty\n  = do -- It isn't IO, so do unsafePerformIO\n       -- It's not conveniently available, so we inline it\n       res <- resultWrapper result_ty\n       (ccall_res_ty, the_alt) <- mk_alt return_result res\n       let\n           wrap = \\ the_call -> mkWildCase (App the_call (Var realWorldPrimId))\n                                           ccall_res_ty\n                                           (coreAltType the_alt)\n                                           [the_alt]\n       return (realWorldStatePrimTy `mkVisFunTy` ccall_res_ty, wrap)\n  where\n    return_result _ [ans] = ans\n    return_result _ _     = panic \"return_result: expected single result\"\n\n\nmk_alt :: (Expr Var -> [Expr Var] -> Expr Var)\n       -> (Maybe Type, Expr Var -> Expr Var)\n       -> DsM (Type, (AltCon, [Id], Expr Var))\nmk_alt return_result (Nothing, wrap_result)\n  = do -- The ccall returns ()\n       state_id <- newSysLocalDs realWorldStatePrimTy\n       let\n             the_rhs = return_result (Var state_id)\n                                     [wrap_result (panic \"boxResult\")]\n\n             ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy]\n             the_alt      = (DataAlt (tupleDataCon Unboxed 1), [state_id], the_rhs)\n\n       return (ccall_res_ty, the_alt)\n\nmk_alt return_result (Just prim_res_ty, wrap_result)\n  = -- The ccall returns a non-() value\n    ASSERT2( isPrimitiveType prim_res_ty, ppr prim_res_ty )\n             -- True because resultWrapper ensures it is so\n    do { result_id <- newSysLocalDs prim_res_ty\n       ; state_id <- newSysLocalDs realWorldStatePrimTy\n       ; let the_rhs = return_result (Var state_id)\n                                [wrap_result (Var result_id)]\n             ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy, prim_res_ty]\n             the_alt      = (DataAlt (tupleDataCon Unboxed 2), [state_id, result_id], the_rhs)\n       ; return (ccall_res_ty, the_alt) }\n\n\nresultWrapper :: Type\n              -> DsM (Maybe Type,               -- Type of the expected result, if any\n                      CoreExpr -> CoreExpr)     -- Wrapper for the result\n-- resultWrapper deals with the result *value*\n-- E.g. foreign import foo :: Int -> IO T\n-- Then resultWrapper deals with marshalling the 'T' part\n-- So if    resultWrapper ty = (Just ty_rep, marshal)\n--  then      marshal (e :: ty_rep) :: ty\n-- That is, 'marshal' wrape the result returned by the foreign call,\n-- of type ty_rep, into the value Haskell expected, of type 'ty'\n--\n-- Invariant: ty_rep is always a primitive type\n--            i.e. (isPrimitiveType ty_rep) is True\n\nresultWrapper result_ty\n  -- Base case 1: primitive types\n  | isPrimitiveType result_ty\n  = return (Just result_ty, \\e -> e)\n\n  -- Base case 2: the unit type ()\n  | Just (tc,_) <- maybe_tc_app\n  , tc `hasKey` unitTyConKey\n  = return (Nothing, \\_ -> Var unitDataConId)\n\n  -- Base case 3: the boolean type\n  | Just (tc,_) <- maybe_tc_app\n  , tc `hasKey` boolTyConKey\n  = do { dflags <- getDynFlags\n       ; let marshal_bool e\n               = mkWildCase e intPrimTy boolTy\n                   [ (DEFAULT                   ,[],Var trueDataConId )\n                   , (LitAlt (mkLitInt dflags 0),[],Var falseDataConId)]\n       ; return (Just intPrimTy, marshal_bool) }\n\n  -- Newtypes\n  | Just (co, rep_ty) <- topNormaliseNewType_maybe result_ty\n  = do { (maybe_ty, wrapper) <- resultWrapper rep_ty\n       ; return (maybe_ty, \\e -> mkCastDs (wrapper e) (mkSymCo co)) }\n\n  -- The type might contain foralls (eg. for dummy type arguments,\n  -- referring to 'Ptr a' is legal).\n  | Just (tyvar, rest) <- splitForAllTy_maybe result_ty\n  = do { (maybe_ty, wrapper) <- resultWrapper rest\n       ; return (maybe_ty, \\e -> Lam tyvar (wrapper e)) }\n\n  -- Data types with a single constructor, which has a single arg\n  -- This includes types like Ptr and ForeignPtr\n  | Just (tycon, tycon_arg_tys) <- maybe_tc_app\n  , Just data_con <- isDataProductTyCon_maybe tycon  -- One constructor, no existentials\n  , [unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys  -- One argument\n  = do { dflags <- getDynFlags\n       ; (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty\n       ; let narrow_wrapper = maybeNarrow dflags tycon\n             marshal_con e  = Var (dataConWrapId data_con)\n                              `mkTyApps` tycon_arg_tys\n                              `App` wrapper (narrow_wrapper e)\n       ; return (maybe_ty, marshal_con) }\n\n  | otherwise\n  = pprPanic \"resultWrapper\" (ppr result_ty)\n  where\n    maybe_tc_app = splitTyConApp_maybe result_ty\n\n-- When the result of a foreign call is smaller than the word size, we\n-- need to sign- or zero-extend the result up to the word size.  The C\n-- standard appears to say that this is the responsibility of the\n-- caller, not the callee.\n\nmaybeNarrow :: DynFlags -> TyCon -> (CoreExpr -> CoreExpr)\nmaybeNarrow dflags tycon\n  | tycon `hasKey` int8TyConKey   = \\e -> App (Var (mkPrimOpId Narrow8IntOp)) e\n  | tycon `hasKey` int16TyConKey  = \\e -> App (Var (mkPrimOpId Narrow16IntOp)) e\n  | tycon `hasKey` int32TyConKey\n         && wORD_SIZE dflags > 4         = \\e -> App (Var (mkPrimOpId Narrow32IntOp)) e\n\n  | tycon `hasKey` word8TyConKey  = \\e -> App (Var (mkPrimOpId Narrow8WordOp)) e\n  | tycon `hasKey` word16TyConKey = \\e -> App (Var (mkPrimOpId Narrow16WordOp)) e\n  | tycon `hasKey` word32TyConKey\n         && wORD_SIZE dflags > 4         = \\e -> App (Var (mkPrimOpId Narrow32WordOp)) e\n  | otherwise                     = id\n", "num_lines": 380}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nDesugaring expressions.\n-}\n\n{-# LANGUAGE CPP, MultiWayIf #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds\n              , dsValBinds, dsLit, dsSyntaxExpr ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Match\nimport MatchLit\nimport DsBinds\nimport DsGRHSs\nimport DsListComp\nimport DsUtils\nimport DsArrows\nimport DsMonad\nimport Check ( checkGuardMatches )\nimport Name\nimport NameEnv\nimport FamInstEnv( topNormaliseType )\nimport DsMeta\nimport HsSyn\n\n-- NB: The desugarer, which straddles the source and Core worlds, sometimes\n--     needs to see source types\nimport TcType\nimport TcEvidence\nimport TcRnMonad\nimport TcHsSyn\nimport Type\nimport CoreSyn\nimport CoreUtils\nimport MkCore\n\nimport DynFlags\nimport CostCentre\nimport Id\nimport MkId\nimport Module\nimport ConLike\nimport DataCon\nimport TysWiredIn\nimport PrelNames\nimport BasicTypes\nimport Maybes\nimport VarEnv\nimport SrcLoc\nimport Util\nimport Bag\nimport Outputable\nimport PatSyn\n\nimport Control.Monad\n\n{-\n************************************************************************\n*                                                                      *\n                dsLocalBinds, dsValBinds\n*                                                                      *\n************************************************************************\n-}\n\ndsLocalBinds :: LHsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr\ndsLocalBinds (dL->L _   (EmptyLocalBinds _))  body = return body\ndsLocalBinds (dL->L loc (HsValBinds _ binds)) body = putSrcSpanDs loc $\n                                                   dsValBinds binds body\ndsLocalBinds (dL->L _ (HsIPBinds _ binds))    body = dsIPBinds  binds body\ndsLocalBinds _                                _    = panic \"dsLocalBinds\"\n\n-------------------------\n-- caller sets location\ndsValBinds :: HsValBinds GhcTc -> CoreExpr -> DsM CoreExpr\ndsValBinds (XValBindsLR (NValBinds binds _)) body\n  = foldrM ds_val_bind body binds\ndsValBinds (ValBinds {})       _    = panic \"dsValBinds ValBindsIn\"\n\n-------------------------\ndsIPBinds :: HsIPBinds GhcTc -> CoreExpr -> DsM CoreExpr\ndsIPBinds (IPBinds ev_binds ip_binds) body\n  = do  { ds_binds <- dsTcEvBinds ev_binds\n        ; let inner = mkCoreLets ds_binds body\n                -- The dict bindings may not be in\n                -- dependency order; hence Rec\n        ; foldrM ds_ip_bind inner ip_binds }\n  where\n    ds_ip_bind (dL->L _ (IPBind _ ~(Right n) e)) body\n      = do e' <- dsLExpr e\n           return (Let (NonRec n e') body)\n    ds_ip_bind _ _ = panic \"dsIPBinds\"\ndsIPBinds (XHsIPBinds _) _ = panic \"dsIPBinds\"\n\n-------------------------\n-- caller sets location\nds_val_bind :: (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr\n-- Special case for bindings which bind unlifted variables\n-- We need to do a case right away, rather than building\n-- a tuple and doing selections.\n-- Silently ignore INLINE and SPECIALISE pragmas...\nds_val_bind (NonRecursive, hsbinds) body\n  | [dL->L loc bind] <- bagToList hsbinds\n        -- Non-recursive, non-overloaded bindings only come in ones\n        -- ToDo: in some bizarre case it's conceivable that there\n        --       could be dict binds in the 'binds'.  (See the notes\n        --       below.  Then pattern-match would fail.  Urk.)\n  , isUnliftedHsBind bind\n  = putSrcSpanDs loc $\n     -- see Note [Strict binds checks] in DsBinds\n    if is_polymorphic bind\n    then errDsCoreExpr (poly_bind_err bind)\n            -- data Ptr a = Ptr Addr#\n            -- f x = let p@(Ptr y) = ... in ...\n            -- Here the binding for 'p' is polymorphic, but does\n            -- not mix with an unlifted binding for 'y'.  You should\n            -- use a bang pattern.  Trac #6078.\n\n    else do { when (looksLazyPatBind bind) $\n              warnIfSetDs Opt_WarnUnbangedStrictPatterns (unlifted_must_be_bang bind)\n        -- Complain about a binding that looks lazy\n        --    e.g.    let I# y = x in ...\n        -- Remember, in checkStrictBinds we are going to do strict\n        -- matching, so (for software engineering reasons) we insist\n        -- that the strictness is manifest on each binding\n        -- However, lone (unboxed) variables are ok\n\n\n            ; dsUnliftedBind bind body }\n  where\n    is_polymorphic (AbsBinds { abs_tvs = tvs, abs_ev_vars = evs })\n                     = not (null tvs && null evs)\n    is_polymorphic _ = False\n\n    unlifted_must_be_bang bind\n      = hang (text \"Pattern bindings containing unlifted types should use\" $$\n              text \"an outermost bang pattern:\")\n           2 (ppr bind)\n\n    poly_bind_err bind\n      = hang (text \"You can't mix polymorphic and unlifted bindings:\")\n           2 (ppr bind) $$\n        text \"Probable fix: add a type signature\"\n\nds_val_bind (is_rec, binds) _body\n  | anyBag (isUnliftedHsBind . unLoc) binds  -- see Note [Strict binds checks] in DsBinds\n  = ASSERT( isRec is_rec )\n    errDsCoreExpr $\n    hang (text \"Recursive bindings for unlifted types aren't allowed:\")\n       2 (vcat (map ppr (bagToList binds)))\n\n-- Ordinary case for bindings; none should be unlifted\nds_val_bind (is_rec, binds) body\n  = do  { MASSERT( isRec is_rec || isSingletonBag binds )\n               -- we should never produce a non-recursive list of multiple binds\n\n        ; (force_vars,prs) <- dsLHsBinds binds\n        ; let body' = foldr seqVar body force_vars\n        ; ASSERT2( not (any (isUnliftedType . idType . fst) prs), ppr is_rec $$ ppr binds )\n          case prs of\n            [] -> return body\n            _  -> return (Let (Rec prs) body') }\n        -- Use a Rec regardless of is_rec.\n        -- Why? Because it allows the binds to be all\n        -- mixed up, which is what happens in one rare case\n        -- Namely, for an AbsBind with no tyvars and no dicts,\n        --         but which does have dictionary bindings.\n        -- See notes with TcSimplify.inferLoop [NO TYVARS]\n        -- It turned out that wrapping a Rec here was the easiest solution\n        --\n        -- NB The previous case dealt with unlifted bindings, so we\n        --    only have to deal with lifted ones now; so Rec is ok\n\n------------------\ndsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr\ndsUnliftedBind (AbsBinds { abs_tvs = [], abs_ev_vars = []\n               , abs_exports = exports\n               , abs_ev_binds = ev_binds\n               , abs_binds = lbinds }) body\n  = do { let body1 = foldr bind_export body exports\n             bind_export export b = bindNonRec (abe_poly export) (Var (abe_mono export)) b\n       ; body2 <- foldlBagM (\\body lbind -> dsUnliftedBind (unLoc lbind) body)\n                            body1 lbinds\n       ; ds_binds <- dsTcEvBinds_s ev_binds\n       ; return (mkCoreLets ds_binds body2) }\n\ndsUnliftedBind (FunBind { fun_id = (dL->L l fun)\n                        , fun_matches = matches\n                        , fun_co_fn = co_fn\n                        , fun_tick = tick }) body\n               -- Can't be a bang pattern (that looks like a PatBind)\n               -- so must be simply unboxed\n  = do { (args, rhs) <- matchWrapper (mkPrefixFunRhs (cL l $ idName fun))\n                                     Nothing matches\n       ; MASSERT( null args ) -- Functions aren't lifted\n       ; MASSERT( isIdHsWrapper co_fn )\n       ; let rhs' = mkOptTickBox tick rhs\n       ; return (bindNonRec fun rhs' body) }\n\ndsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss\n                        , pat_ext = NPatBindTc _ ty }) body\n  =     -- let C x# y# = rhs in body\n        -- ==> case rhs of C x# y# -> body\n    do { rhs <- dsGuarded grhss ty\n       ; checkGuardMatches PatBindGuards grhss\n       ; let upat = unLoc pat\n             eqn = EqnInfo { eqn_pats = [upat],\n                             eqn_orig = FromSource,\n                             eqn_rhs = cantFailMatchResult body }\n       ; var    <- selectMatchVar upat\n       ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)\n       ; return (bindNonRec var rhs result) }\n\ndsUnliftedBind bind body = pprPanic \"dsLet: unlifted\" (ppr bind $$ ppr body)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DsExpr-vars-and-cons]{Variables, constructors, literals}\n*                                                                      *\n************************************************************************\n-}\n\ndsLExpr :: LHsExpr GhcTc -> DsM CoreExpr\n\ndsLExpr (dL->L loc e)\n  = putSrcSpanDs loc $\n    do { core_expr <- dsExpr e\n   -- uncomment this check to test the hsExprType function in TcHsSyn\n   --    ; MASSERT2( exprType core_expr `eqType` hsExprType e\n   --              , ppr e <+> dcolon <+> ppr (hsExprType e) $$\n   --                ppr core_expr <+> dcolon <+> ppr (exprType core_expr) )\n       ; return core_expr }\n\n-- | Variant of 'dsLExpr' that ensures that the result is not levity\n-- polymorphic. This should be used when the resulting expression will\n-- be an argument to some other function.\n-- See Note [Levity polymorphism checking] in DsMonad\n-- See Note [Levity polymorphism invariants] in CoreSyn\ndsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr\ndsLExprNoLP (dL->L loc e)\n  = putSrcSpanDs loc $\n    do { e' <- dsExpr e\n       ; dsNoLevPolyExpr e' (text \"In the type of expression:\" <+> ppr e)\n       ; return e' }\n\ndsExpr :: HsExpr GhcTc -> DsM CoreExpr\ndsExpr = ds_expr False\n\nds_expr :: Bool   -- are we directly inside an HsWrap?\n                  -- See Wrinkle in Note [Detecting forced eta expansion]\n        -> HsExpr GhcTc -> DsM CoreExpr\nds_expr _ (HsPar _ e)            = dsLExpr e\nds_expr _ (ExprWithTySig _ e _)  = dsLExpr e\nds_expr w (HsVar _ (dL->L _ var)) = dsHsVar w var\nds_expr _ (HsUnboundVar {})      = panic \"dsExpr: HsUnboundVar\" -- Typechecker eliminates them\nds_expr w (HsConLikeOut _ con)   = dsConLike w con\nds_expr _ (HsIPVar {})           = panic \"dsExpr: HsIPVar\"\nds_expr _ (HsOverLabel{})        = panic \"dsExpr: HsOverLabel\"\n\nds_expr _ (HsLit _ lit)\n  = do { warnAboutOverflowedLit lit\n       ; dsLit (convertLit lit) }\n\nds_expr _ (HsOverLit _ lit)\n  = do { warnAboutOverflowedOverLit lit\n       ; dsOverLit lit }\n\nds_expr _ (HsWrap _ co_fn e)\n  = do { e' <- ds_expr True e    -- This is the one place where we recurse to\n                                 -- ds_expr (passing True), rather than dsExpr\n       ; wrap' <- dsHsWrapper co_fn\n       ; dflags <- getDynFlags\n       ; let wrapped_e = wrap' e'\n             wrapped_ty = exprType wrapped_e\n       ; checkForcedEtaExpansion e wrapped_ty -- See Note [Detecting forced eta expansion]\n       ; warnAboutIdentities dflags e' wrapped_ty\n       ; return wrapped_e }\n\nds_expr _ (NegApp _ (dL->L loc\n                      (HsOverLit _ lit@(OverLit { ol_val = HsIntegral i})))\n                  neg_expr)\n  = do { expr' <- putSrcSpanDs loc $ do\n          { warnAboutOverflowedOverLit\n              (lit { ol_val = HsIntegral (negateIntegralLit i) })\n          ; dsOverLit lit }\n       ; dsSyntaxExpr neg_expr [expr'] }\n\nds_expr _ (NegApp _ expr neg_expr)\n  = do { expr' <- dsLExpr expr\n       ; dsSyntaxExpr neg_expr [expr'] }\n\nds_expr _ (HsLam _ a_Match)\n  = uncurry mkLams <$> matchWrapper LambdaExpr Nothing a_Match\n\nds_expr _ (HsLamCase _ matches)\n  = do { ([discrim_var], matching_code) <- matchWrapper CaseAlt Nothing matches\n       ; return $ Lam discrim_var matching_code }\n\nds_expr _ e@(HsApp _ fun arg)\n  = do { fun' <- dsLExpr fun\n       ; dsWhenNoErrs (dsLExprNoLP arg)\n                      (\\arg' -> mkCoreAppDs (text \"HsApp\" <+> ppr e) fun' arg') }\n\nds_expr _ (HsAppType _ e _)\n    -- ignore type arguments here; they're in the wrappers instead at this point\n  = dsLExpr e\n\n{-\nNote [Desugaring vars]\n~~~~~~~~~~~~~~~~~~~~~~\nIn one situation we can get a *coercion* variable in a HsVar, namely\nthe support method for an equality superclass:\n   class (a~b) => C a b where ...\n   instance (blah) => C (T a) (T b) where ..\nThen we get\n   $dfCT :: forall ab. blah => C (T a) (T b)\n   $dfCT ab blah = MkC ($c$p1C a blah) ($cop a blah)\n\n   $c$p1C :: forall ab. blah => (T a ~ T b)\n   $c$p1C ab blah = let ...; g :: T a ~ T b = ... } in g\n\nThat 'g' in the 'in' part is an evidence variable, and when\nconverting to core it must become a CO.\n\nOperator sections.  At first it looks as if we can convert\n\\begin{verbatim}\n        (expr op)\n\\end{verbatim}\nto\n\\begin{verbatim}\n        \\x -> op expr x\n\\end{verbatim}\n\nBut no!  expr might be a redex, and we can lose laziness badly this\nway.  Consider\n\\begin{verbatim}\n        map (expr op) xs\n\\end{verbatim}\nfor example.  So we convert instead to\n\\begin{verbatim}\n        let y = expr in \\x -> op y x\n\\end{verbatim}\nIf \\tr{expr} is actually just a variable, say, then the simplifier\nwill sort it out.\n-}\n\nds_expr _ e@(OpApp _ e1 op e2)\n  = -- for the type of y, we need the type of op's 2nd argument\n    do { op' <- dsLExpr op\n       ; dsWhenNoErrs (mapM dsLExprNoLP [e1, e2])\n                      (\\exprs' -> mkCoreAppsDs (text \"opapp\" <+> ppr e) op' exprs') }\n\nds_expr _ (SectionL _ expr op)       -- Desugar (e !) to ((!) e)\n  = do { op' <- dsLExpr op\n       ; dsWhenNoErrs (dsLExprNoLP expr)\n                      (\\expr' -> mkCoreAppDs (text \"sectionl\" <+> ppr expr) op' expr') }\n\n-- dsLExpr (SectionR op expr)   -- \\ x -> op x expr\nds_expr _ e@(SectionR _ op expr) = do\n    core_op <- dsLExpr op\n    -- for the type of x, we need the type of op's 2nd argument\n    let (x_ty:y_ty:_, _) = splitFunTys (exprType core_op)\n        -- See comment with SectionL\n    y_core <- dsLExpr expr\n    dsWhenNoErrs (mapM newSysLocalDsNoLP [x_ty, y_ty])\n                 (\\[x_id, y_id] -> bindNonRec y_id y_core $\n                                   Lam x_id (mkCoreAppsDs (text \"sectionr\" <+> ppr e)\n                                                          core_op [Var x_id, Var y_id]))\n\nds_expr _ (ExplicitTuple _ tup_args boxity)\n  = do { let go (lam_vars, args) (dL->L _ (Missing ty))\n                    -- For every missing expression, we need\n                    -- another lambda in the desugaring.\n               = do { lam_var <- newSysLocalDsNoLP ty\n                    ; return (lam_var : lam_vars, Var lam_var : args) }\n             go (lam_vars, args) (dL->L _ (Present _ expr))\n                    -- Expressions that are present don't generate\n                    -- lambdas, just arguments.\n               = do { core_expr <- dsLExprNoLP expr\n                    ; return (lam_vars, core_expr : args) }\n             go _ _ = panic \"ds_expr\"\n\n       ; dsWhenNoErrs (foldM go ([], []) (reverse tup_args))\n                -- The reverse is because foldM goes left-to-right\n                      (\\(lam_vars, args) -> mkCoreLams lam_vars $\n                                            mkCoreTupBoxity boxity args) }\n\nds_expr _ (ExplicitSum types alt arity expr)\n  = do { dsWhenNoErrs (dsLExprNoLP expr)\n                      (\\core_expr -> mkCoreConApps (sumDataCon alt arity)\n                                     (map (Type . getRuntimeRep) types ++\n                                      map Type types ++\n                                      [core_expr]) ) }\n\nds_expr _ (HsSCC _ _ cc expr@(dL->L loc _)) = do\n    dflags <- getDynFlags\n    if gopt Opt_SccProfilingOn dflags\n      then do\n        mod_name <- getModule\n        count <- goptM Opt_ProfCountEntries\n        let nm = sl_fs cc\n        flavour <- ExprCC <$> getCCIndexM nm\n        Tick (ProfNote (mkUserCC nm mod_name loc flavour) count True)\n               <$> dsLExpr expr\n      else dsLExpr expr\n\nds_expr _ (HsCoreAnn _ _ _ expr)\n  = dsLExpr expr\n\nds_expr _ (HsCase _ discrim matches)\n  = do { core_discrim <- dsLExpr discrim\n       ; ([discrim_var], matching_code) <- matchWrapper CaseAlt (Just discrim) matches\n       ; return (bindNonRec discrim_var core_discrim matching_code) }\n\n-- Pepe: The binds are in scope in the body but NOT in the binding group\n--       This is to avoid silliness in breakpoints\nds_expr _ (HsLet _ binds body) = do\n    body' <- dsLExpr body\n    dsLocalBinds binds body'\n\n-- We need the `ListComp' form to use `deListComp' (rather than the \"do\" form)\n-- because the interpretation of `stmts' depends on what sort of thing it is.\n--\nds_expr _ (HsDo res_ty ListComp (dL->L _ stmts)) = dsListComp stmts res_ty\nds_expr _ (HsDo _ DoExpr        (dL->L _ stmts)) = dsDo stmts\nds_expr _ (HsDo _ GhciStmtCtxt  (dL->L _ stmts)) = dsDo stmts\nds_expr _ (HsDo _ MDoExpr       (dL->L _ stmts)) = dsDo stmts\nds_expr _ (HsDo _ MonadComp     (dL->L _ stmts)) = dsMonadComp stmts\n\nds_expr _ (HsIf _ mb_fun guard_expr then_expr else_expr)\n  = do { pred <- dsLExpr guard_expr\n       ; b1 <- dsLExpr then_expr\n       ; b2 <- dsLExpr else_expr\n       ; case mb_fun of\n           Just fun -> dsSyntaxExpr fun [pred, b1, b2]\n           Nothing  -> return $ mkIfThenElse pred b1 b2 }\n\nds_expr _ (HsMultiIf res_ty alts)\n  | null alts\n  = mkErrorExpr\n\n  | otherwise\n  = do { match_result <- liftM (foldr1 combineMatchResults)\n                               (mapM (dsGRHS IfAlt res_ty) alts)\n       ; checkGuardMatches IfAlt (GRHSs noExt alts (noLoc emptyLocalBinds))\n       ; error_expr   <- mkErrorExpr\n       ; extractMatchResult match_result error_expr }\n  where\n    mkErrorExpr = mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID res_ty\n                               (text \"multi-way if\")\n\n{-\n\\noindent\n\\underline{\\bf Various data construction things}\n             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-}\n\nds_expr _ (ExplicitList elt_ty wit xs)\n  = dsExplicitList elt_ty wit xs\n\nds_expr _ (ArithSeq expr witness seq)\n  = case witness of\n     Nothing -> dsArithSeq expr seq\n     Just fl -> do { newArithSeq <- dsArithSeq expr seq\n                   ; dsSyntaxExpr fl [newArithSeq] }\n\n{-\nStatic Pointers\n~~~~~~~~~~~~~~~\n\nSee Note [Grand plan for static forms] in StaticPtrTable for an overview.\n\n    g = ... static f ...\n==>\n    g = ... makeStatic loc f ...\n-}\n\nds_expr _ (HsStatic _ expr@(dL->L loc _)) = do\n    expr_ds <- dsLExprNoLP expr\n    let ty = exprType expr_ds\n    makeStaticId <- dsLookupGlobalId makeStaticName\n\n    dflags <- getDynFlags\n    let (line, col) = case loc of\n           RealSrcSpan r -> ( srcLocLine $ realSrcSpanStart r\n                            , srcLocCol  $ realSrcSpanStart r\n                            )\n           _             -> (0, 0)\n        srcLoc = mkCoreConApps (tupleDataCon Boxed 2)\n                     [ Type intTy              , Type intTy\n                     , mkIntExprInt dflags line, mkIntExprInt dflags col\n                     ]\n\n    putSrcSpanDs loc $ return $\n      mkCoreApps (Var makeStaticId) [ Type ty, srcLoc, expr_ds ]\n\n{-\n\\noindent\n\\underline{\\bf Record construction and update}\n             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor record construction we do this (assuming T has three arguments)\n\\begin{verbatim}\n        T { op2 = e }\n==>\n        let err = /\\a -> recConErr a\n        T (recConErr t1 \"M.hs/230/op1\")\n          e\n          (recConErr t1 \"M.hs/230/op3\")\n\\end{verbatim}\n@recConErr@ then converts its argument string into a proper message\nbefore printing it as\n\\begin{verbatim}\n        M.hs, line 230: missing field op1 was evaluated\n\\end{verbatim}\n\nWe also handle @C{}@ as valid construction syntax for an unlabelled\nconstructor @C@, setting all of @C@'s fields to bottom.\n-}\n\nds_expr _ (RecordCon { rcon_flds = rbinds\n                     , rcon_ext = RecordConTc { rcon_con_expr = con_expr\n                                              , rcon_con_like = con_like }})\n  = do { con_expr' <- dsExpr con_expr\n       ; let\n             (arg_tys, _) = tcSplitFunTys (exprType con_expr')\n             -- A newtype in the corner should be opaque;\n             -- hence TcType.tcSplitFunTys\n\n             mk_arg (arg_ty, fl)\n               = case findField (rec_flds rbinds) (flSelector fl) of\n                   (rhs:rhss) -> ASSERT( null rhss )\n                                 dsLExprNoLP rhs\n                   []         -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (ppr (flLabel fl))\n             unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty Outputable.empty\n\n             labels = conLikeFieldLabels con_like\n\n       ; con_args <- if null labels\n                     then mapM unlabelled_bottom arg_tys\n                     else mapM mk_arg (zipEqual \"dsExpr:RecordCon\" arg_tys labels)\n\n       ; return (mkCoreApps con_expr' con_args) }\n\n{-\nRecord update is a little harder. Suppose we have the decl:\n\\begin{verbatim}\n        data T = T1 {op1, op2, op3 :: Int}\n               | T2 {op4, op2 :: Int}\n               | T3\n\\end{verbatim}\nThen we translate as follows:\n\\begin{verbatim}\n        r { op2 = e }\n===>\n        let op2 = e in\n        case r of\n          T1 op1 _ op3 -> T1 op1 op2 op3\n          T2 op4 _     -> T2 op4 op2\n          other        -> recUpdError \"M.hs/230\"\n\\end{verbatim}\nIt's important that we use the constructor Ids for @T1@, @T2@ etc on the\nRHSs, and do not generate a Core constructor application directly, because the constructor\nmight do some argument-evaluation first; and may have to throw away some\ndictionaries.\n\nNote [Update for GADTs]\n~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   data T a b where\n     T1 :: { f1 :: a } -> T a Int\n\nThen the wrapper function for T1 has type\n   $WT1 :: a -> T a Int\nBut if x::T a b, then\n   x { f1 = v } :: T a b   (not T a Int!)\nSo we need to cast (T a Int) to (T a b).  Sigh.\n\n-}\n\nds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields\n                          , rupd_ext = RecordUpdTc\n                              { rupd_cons = cons_to_upd\n                              , rupd_in_tys = in_inst_tys\n                              , rupd_out_tys = out_inst_tys\n                              , rupd_wrap = dict_req_wrap }} )\n  | null fields\n  = dsLExpr record_expr\n  | otherwise\n  = ASSERT2( notNull cons_to_upd, ppr expr )\n\n    do  { record_expr' <- dsLExpr record_expr\n        ; field_binds' <- mapM ds_field fields\n        ; let upd_fld_env :: NameEnv Id -- Maps field name to the LocalId of the field binding\n              upd_fld_env = mkNameEnv [(f,l) | (f,l,_) <- field_binds']\n\n        -- It's important to generate the match with matchWrapper,\n        -- and the right hand sides with applications of the wrapper Id\n        -- so that everything works when we are doing fancy unboxing on the\n        -- constructor arguments.\n        ; alts <- mapM (mk_alt upd_fld_env) cons_to_upd\n        ; ([discrim_var], matching_code)\n                <- matchWrapper RecUpd Nothing\n                                      (MG { mg_alts = noLoc alts\n                                          , mg_ext = MatchGroupTc [in_ty] out_ty\n                                          , mg_origin = FromSource })\n                                     -- FromSource is not strictly right, but we\n                                     -- want incomplete pattern-match warnings\n\n        ; return (add_field_binds field_binds' $\n                  bindNonRec discrim_var record_expr' matching_code) }\n  where\n    ds_field :: LHsRecUpdField GhcTc -> DsM (Name, Id, CoreExpr)\n      -- Clone the Id in the HsRecField, because its Name is that\n      -- of the record selector, and we must not make that a local binder\n      -- else we shadow other uses of the record selector\n      -- Hence 'lcl_id'.  Cf Trac #2735\n    ds_field (dL->L _ rec_field)\n      = do { rhs <- dsLExpr (hsRecFieldArg rec_field)\n           ; let fld_id = unLoc (hsRecUpdFieldId rec_field)\n           ; lcl_id <- newSysLocalDs (idType fld_id)\n           ; return (idName fld_id, lcl_id, rhs) }\n\n    add_field_binds [] expr = expr\n    add_field_binds ((_,b,r):bs) expr = bindNonRec b r (add_field_binds bs expr)\n\n        -- Awkwardly, for families, the match goes\n        -- from instance type to family type\n    (in_ty, out_ty) =\n      case (head cons_to_upd) of\n        RealDataCon data_con ->\n          let tycon = dataConTyCon data_con in\n          (mkTyConApp tycon in_inst_tys, mkFamilyTyConApp tycon out_inst_tys)\n        PatSynCon pat_syn ->\n          ( patSynInstResTy pat_syn in_inst_tys\n          , patSynInstResTy pat_syn out_inst_tys)\n    mk_alt upd_fld_env con\n      = do { let (univ_tvs, ex_tvs, eq_spec,\n                  prov_theta, _req_theta, arg_tys, _) = conLikeFullSig con\n                 user_tvs =\n                   case con of\n                     RealDataCon data_con -> dataConUserTyVars data_con\n                     PatSynCon _          -> univ_tvs ++ ex_tvs\n                       -- The order here is because of the order in `TcPatSyn`.\n                 in_subst  = zipTvSubst univ_tvs in_inst_tys\n                 out_subst = zipTvSubst univ_tvs out_inst_tys\n\n                -- I'm not bothering to clone the ex_tvs\n           ; eqs_vars   <- mapM newPredVarDs (substTheta in_subst (eqSpecPreds eq_spec))\n           ; theta_vars <- mapM newPredVarDs (substTheta in_subst prov_theta)\n           ; arg_ids    <- newSysLocalsDs (substTysUnchecked in_subst arg_tys)\n           ; let field_labels = conLikeFieldLabels con\n                 val_args = zipWithEqual \"dsExpr:RecordUpd\" mk_val_arg\n                                         field_labels arg_ids\n                 mk_val_arg fl pat_arg_id\n                     = nlHsVar (lookupNameEnv upd_fld_env (flSelector fl) `orElse` pat_arg_id)\n\n                 inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExt con)\n                        -- Reconstruct with the WrapId so that unpacking happens\n                 wrap = mkWpEvVarApps theta_vars                                <.>\n                        dict_req_wrap                                           <.>\n                        mkWpTyApps    [ lookupTyVar out_subst tv\n                                          `orElse` mkTyVarTy tv\n                                      | tv <- user_tvs\n                                      , not (tv `elemVarEnv` wrap_subst) ]\n                          -- Be sure to use user_tvs (which may be ordered\n                          -- differently than `univ_tvs ++ ex_tvs) above.\n                          -- See Note [DataCon user type variable binders]\n                          -- in DataCon.\n                 rhs = foldl' (\\a b -> nlHsApp a b) inst_con val_args\n\n                        -- Tediously wrap the application in a cast\n                        -- Note [Update for GADTs]\n                 wrapped_rhs =\n                  case con of\n                    RealDataCon data_con ->\n                      let\n                        wrap_co =\n                          mkTcTyConAppCo Nominal\n                            (dataConTyCon data_con)\n                            [ lookup tv ty\n                              | (tv,ty) <- univ_tvs `zip` out_inst_tys ]\n                        lookup univ_tv ty =\n                          case lookupVarEnv wrap_subst univ_tv of\n                            Just co' -> co'\n                            Nothing  -> mkTcReflCo Nominal ty\n                        in if null eq_spec\n                             then rhs\n                             else mkLHsWrap (mkWpCastN wrap_co) rhs\n                    -- eq_spec is always null for a PatSynCon\n                    PatSynCon _ -> rhs\n\n                 wrap_subst =\n                  mkVarEnv [ (tv, mkTcSymCo (mkTcCoVarCo eq_var))\n                           | (spec, eq_var) <- eq_spec `zip` eqs_vars\n                           , let tv = eqSpecTyVar spec ]\n\n                 req_wrap = dict_req_wrap <.> mkWpTyApps in_inst_tys\n\n                 pat = noLoc $ ConPatOut { pat_con = noLoc con\n                                         , pat_tvs = ex_tvs\n                                         , pat_dicts = eqs_vars ++ theta_vars\n                                         , pat_binds = emptyTcEvBinds\n                                         , pat_args = PrefixCon $ map nlVarPat arg_ids\n                                         , pat_arg_tys = in_inst_tys\n                                         , pat_wrap = req_wrap }\n           ; return (mkSimpleMatch RecUpd [pat] wrapped_rhs) }\n\n-- Here is where we desugar the Template Haskell brackets and escapes\n\n-- Template Haskell stuff\n\nds_expr _ (HsRnBracketOut _ _ _)  = panic \"dsExpr HsRnBracketOut\"\nds_expr _ (HsTcBracketOut _ x ps) = dsBracket x ps\nds_expr _ (HsSpliceE _ s)         = pprPanic \"dsExpr:splice\" (ppr s)\n\n-- Arrow notation extension\nds_expr _ (HsProc _ pat cmd) = dsProcExpr pat cmd\n\n-- Hpc Support\n\nds_expr _ (HsTick _ tickish e) = do\n  e' <- dsLExpr e\n  return (Tick tickish e')\n\n-- There is a problem here. The then and else branches\n-- have no free variables, so they are open to lifting.\n-- We need someway of stopping this.\n-- This will make no difference to binary coverage\n-- (did you go here: YES or NO), but will effect accurate\n-- tick counting.\n\nds_expr _ (HsBinTick _ ixT ixF e) = do\n  e2 <- dsLExpr e\n  do { ASSERT(exprType e2 `eqType` boolTy)\n       mkBinaryTickBox ixT ixF e2\n     }\n\nds_expr _ (HsTickPragma _ _ _ _ expr) = do\n  dflags <- getDynFlags\n  if gopt Opt_Hpc dflags\n    then panic \"dsExpr:HsTickPragma\"\n    else dsLExpr expr\n\n-- HsSyn constructs that just shouldn't be here:\nds_expr _ (HsBracket     {})  = panic \"dsExpr:HsBracket\"\nds_expr _ (EWildPat      {})  = panic \"dsExpr:EWildPat\"\nds_expr _ (EAsPat        {})  = panic \"dsExpr:EAsPat\"\nds_expr _ (EViewPat      {})  = panic \"dsExpr:EViewPat\"\nds_expr _ (ELazyPat      {})  = panic \"dsExpr:ELazyPat\"\nds_expr _ (HsDo          {})  = panic \"dsExpr:HsDo\"\nds_expr _ (HsRecFld      {})  = panic \"dsExpr:HsRecFld\"\nds_expr _ (XExpr         {})  = panic \"dsExpr: XExpr\"\n\n\n------------------------------\ndsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr\ndsSyntaxExpr (SyntaxExpr { syn_expr      = expr\n                         , syn_arg_wraps = arg_wraps\n                         , syn_res_wrap  = res_wrap })\n             arg_exprs\n  = do { fun            <- dsExpr expr\n       ; core_arg_wraps <- mapM dsHsWrapper arg_wraps\n       ; core_res_wrap  <- dsHsWrapper res_wrap\n       ; let wrapped_args = zipWith ($) core_arg_wraps arg_exprs\n       ; dsWhenNoErrs (zipWithM_ dsNoLevPolyExpr wrapped_args [ mk_doc n | n <- [1..] ])\n                      (\\_ -> core_res_wrap (mkApps fun wrapped_args)) }\n  where\n    mk_doc n = text \"In the\" <+> speakNth n <+> text \"argument of\" <+> quotes (ppr expr)\n\nfindField :: [LHsRecField GhcTc arg] -> Name -> [arg]\nfindField rbinds sel\n  = [hsRecFieldArg fld | (dL->L _ fld) <- rbinds\n                       , sel == idName (unLoc $ hsRecFieldId fld) ]\n\n{-\n%--------------------------------------------------------------------\n\nNote [Desugaring explicit lists]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nExplicit lists are desugared in a cleverer way to prevent some\nfruitless allocations.  Essentially, whenever we see a list literal\n[x_1, ..., x_n] we generate the corresponding expression in terms of\nbuild:\n\nExplicit lists (literals) are desugared to allow build/foldr fusion when\nbeneficial. This is a bit of a trade-off,\n\n * build/foldr fusion can generate far larger code than the corresponding\n   cons-chain (e.g. see #11707)\n\n * even when it doesn't produce more code, build can still fail to fuse,\n   requiring that the simplifier do more work to bring the expression\n   back into cons-chain form; this costs compile time\n\n * when it works, fusion can be a significant win. Allocations are reduced\n   by up to 25% in some nofib programs. Specifically,\n\n        Program           Size    Allocs   Runtime  CompTime\n        rewrite          +0.0%    -26.3%      0.02     -1.8%\n           ansi          -0.3%    -13.8%      0.00     +0.0%\n           lift          +0.0%     -8.7%      0.00     -2.3%\n\nAt the moment we use a simple heuristic to determine whether build will be\nfruitful: for small lists we assume the benefits of fusion will be worthwhile;\nfor long lists we assume that the benefits will be outweighted by the cost of\ncode duplication. This magic length threshold is @maxBuildLength@. Also, fusion\nwon't work at all if rewrite rules are disabled, so we don't use the build-based\ndesugaring in this case.\n\nWe used to have a more complex heuristic which would try to break the list into\n\"static\" and \"dynamic\" parts and only build-desugar the dynamic part.\nUnfortunately, determining \"static-ness\" reliably is a bit tricky and the\nheuristic at times produced surprising behavior (see #11710) so it was dropped.\n-}\n\n{- | The longest list length which we will desugar using @build@.\n\nThis is essentially a magic number and its setting is unfortunate rather\narbitrary. The idea here, as mentioned in Note [Desugaring explicit lists],\nis to avoid deforesting large static data into large(r) code. Ideally we'd\nwant a smaller threshold with larger consumers and vice-versa, but we have no\nway of knowing what will be consuming our list in the desugaring impossible to\nset generally correctly.\n\nThe effect of reducing this number will be that 'build' fusion is applied\nless often. From a runtime performance perspective, applying 'build' more\nliberally on \"moderately\" sized lists should rarely hurt and will often it can\nonly expose further optimization opportunities; if no fusion is possible it will\neventually get rule-rewritten back to a list). We do, however, pay in compile\ntime.\n-}\nmaxBuildLength :: Int\nmaxBuildLength = 32\n\ndsExplicitList :: Type -> Maybe (SyntaxExpr GhcTc) -> [LHsExpr GhcTc]\n               -> DsM CoreExpr\n-- See Note [Desugaring explicit lists]\ndsExplicitList elt_ty Nothing xs\n  = do { dflags <- getDynFlags\n       ; xs' <- mapM dsLExprNoLP xs\n       ; if xs' `lengthExceeds` maxBuildLength\n                -- Don't generate builds if the list is very long.\n         || null xs'\n                -- Don't generate builds when the [] constructor will do\n         || not (gopt Opt_EnableRewriteRules dflags)  -- Rewrite rules off\n                -- Don't generate a build if there are no rules to eliminate it!\n                -- See Note [Desugaring RULE left hand sides] in Desugar\n         then return $ mkListExpr elt_ty xs'\n         else mkBuildExpr elt_ty (mk_build_list xs') }\n  where\n    mk_build_list xs' (cons, _) (nil, _)\n      = return (foldr (App . App (Var cons)) (Var nil) xs')\n\ndsExplicitList elt_ty (Just fln) xs\n  = do { list <- dsExplicitList elt_ty Nothing xs\n       ; dflags <- getDynFlags\n       ; dsSyntaxExpr fln [mkIntExprInt dflags (length xs), list] }\n\ndsArithSeq :: PostTcExpr -> (ArithSeqInfo GhcTc) -> DsM CoreExpr\ndsArithSeq expr (From from)\n  = App <$> dsExpr expr <*> dsLExprNoLP from\ndsArithSeq expr (FromTo from to)\n  = do dflags <- getDynFlags\n       warnAboutEmptyEnumerations dflags from Nothing to\n       expr' <- dsExpr expr\n       from' <- dsLExprNoLP from\n       to'   <- dsLExprNoLP to\n       return $ mkApps expr' [from', to']\ndsArithSeq expr (FromThen from thn)\n  = mkApps <$> dsExpr expr <*> mapM dsLExprNoLP [from, thn]\ndsArithSeq expr (FromThenTo from thn to)\n  = do dflags <- getDynFlags\n       warnAboutEmptyEnumerations dflags from (Just thn) to\n       expr' <- dsExpr expr\n       from' <- dsLExprNoLP from\n       thn'  <- dsLExprNoLP thn\n       to'   <- dsLExprNoLP to\n       return $ mkApps expr' [from', thn', to']\n\n{-\nDesugar 'do' and 'mdo' expressions (NOT list comprehensions, they're\nhandled in DsListComp).  Basically does the translation given in the\nHaskell 98 report:\n-}\n\ndsDo :: [ExprLStmt GhcTc] -> DsM CoreExpr\ndsDo stmts\n  = goL stmts\n  where\n    goL [] = panic \"dsDo\"\n    goL ((dL->L loc stmt):lstmts) = putSrcSpanDs loc (go loc stmt lstmts)\n\n    go _ (LastStmt _ body _ _) stmts\n      = ASSERT( null stmts ) dsLExpr body\n        -- The 'return' op isn't used for 'do' expressions\n\n    go _ (BodyStmt _ rhs then_expr _) stmts\n      = do { rhs2 <- dsLExpr rhs\n           ; warnDiscardedDoBindings rhs (exprType rhs2)\n           ; rest <- goL stmts\n           ; dsSyntaxExpr then_expr [rhs2, rest] }\n\n    go _ (LetStmt _ binds) stmts\n      = do { rest <- goL stmts\n           ; dsLocalBinds binds rest }\n\n    go _ (BindStmt res1_ty pat rhs bind_op fail_op) stmts\n      = do  { body     <- goL stmts\n            ; rhs'     <- dsLExpr rhs\n            ; var   <- selectSimpleMatchVarL pat\n            ; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat\n                                      res1_ty (cantFailMatchResult body)\n            ; match_code <- handle_failure pat match fail_op\n            ; dsSyntaxExpr bind_op [rhs', Lam var match_code] }\n\n    go _ (ApplicativeStmt body_ty args mb_join) stmts\n      = do {\n             let\n               (pats, rhss) = unzip (map (do_arg . snd) args)\n\n               do_arg (ApplicativeArgOne _ pat expr _) =\n                 (pat, dsLExpr expr)\n               do_arg (ApplicativeArgMany _ stmts ret pat) =\n                 (pat, dsDo (stmts ++ [noLoc $ mkLastStmt (noLoc ret)]))\n               do_arg (XApplicativeArg _) = panic \"dsDo\"\n\n               arg_tys = map hsLPatType pats\n\n           ; rhss' <- sequence rhss\n\n           ; let body' = noLoc $ HsDo body_ty DoExpr (noLoc stmts)\n\n           ; let fun = cL noSrcSpan $ HsLam noExt $\n                   MG { mg_alts = noLoc [mkSimpleMatch LambdaExpr pats\n                                                       body']\n                      , mg_ext = MatchGroupTc arg_tys body_ty\n                      , mg_origin = Generated }\n\n           ; fun' <- dsLExpr fun\n           ; let mk_ap_call l (op,r) = dsSyntaxExpr op [l,r]\n           ; expr <- foldlM mk_ap_call fun' (zip (map fst args) rhss')\n           ; case mb_join of\n               Nothing -> return expr\n               Just join_op -> dsSyntaxExpr join_op [expr] }\n\n    go loc (RecStmt { recS_stmts = rec_stmts, recS_later_ids = later_ids\n                    , recS_rec_ids = rec_ids, recS_ret_fn = return_op\n                    , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op\n                    , recS_ext = RecStmtTc\n                        { recS_bind_ty = bind_ty\n                        , recS_rec_rets = rec_rets\n                        , recS_ret_ty = body_ty} }) stmts\n      = goL (new_bind_stmt : stmts)  -- rec_ids can be empty; eg  rec { print 'x' }\n      where\n        new_bind_stmt = cL loc $ BindStmt bind_ty (mkBigLHsPatTupId later_pats)\n                                         mfix_app bind_op\n                                         noSyntaxExpr  -- Tuple cannot fail\n\n        tup_ids      = rec_ids ++ filterOut (`elem` rec_ids) later_ids\n        tup_ty       = mkBigCoreTupTy (map idType tup_ids) -- Deals with singleton case\n        rec_tup_pats = map nlVarPat tup_ids\n        later_pats   = rec_tup_pats\n        rets         = map noLoc rec_rets\n        mfix_app     = nlHsSyntaxApps mfix_op [mfix_arg]\n        mfix_arg     = noLoc $ HsLam noExt\n                           (MG { mg_alts = noLoc [mkSimpleMatch\n                                                    LambdaExpr\n                                                    [mfix_pat] body]\n                               , mg_ext = MatchGroupTc [tup_ty] body_ty\n                               , mg_origin = Generated })\n        mfix_pat     = noLoc $ LazyPat noExt $ mkBigLHsPatTupId rec_tup_pats\n        body         = noLoc $ HsDo body_ty\n                                DoExpr (noLoc (rec_stmts ++ [ret_stmt]))\n        ret_app      = nlHsSyntaxApps return_op [mkBigLHsTupId rets]\n        ret_stmt     = noLoc $ mkLastStmt ret_app\n                     -- This LastStmt will be desugared with dsDo,\n                     -- which ignores the return_op in the LastStmt,\n                     -- so we must apply the return_op explicitly\n\n    go _ (ParStmt   {}) _ = panic \"dsDo ParStmt\"\n    go _ (TransStmt {}) _ = panic \"dsDo TransStmt\"\n    go _ (XStmtLR   {}) _ = panic \"dsDo XStmtLR\"\n\nhandle_failure :: LPat GhcTc -> MatchResult -> SyntaxExpr GhcTc -> DsM CoreExpr\n    -- In a do expression, pattern-match failure just calls\n    -- the monadic 'fail' rather than throwing an exception\nhandle_failure pat match fail_op\n  | matchCanFail match\n  = do { dflags <- getDynFlags\n       ; fail_msg <- mkStringExpr (mk_fail_msg dflags pat)\n       ; fail_expr <- dsSyntaxExpr fail_op [fail_msg]\n       ; extractMatchResult match fail_expr }\n  | otherwise\n  = extractMatchResult match (error \"It can't fail\")\n\nmk_fail_msg :: HasSrcSpan e => DynFlags -> e -> String\nmk_fail_msg dflags pat = \"Pattern match failure in do expression at \" ++\n                         showPpr dflags (getLoc pat)\n\n{-\n************************************************************************\n*                                                                      *\n   Desugaring Variables\n*                                                                      *\n************************************************************************\n-}\n\ndsHsVar :: Bool  -- are we directly inside an HsWrap?\n                 -- See Wrinkle in Note [Detecting forced eta expansion]\n        -> Id -> DsM CoreExpr\ndsHsVar w var\n  | not w\n  , let bad_tys = badUseOfLevPolyPrimop var ty\n  , not (null bad_tys)\n  = do { levPolyPrimopErr var ty bad_tys\n       ; return unitExpr }  -- return something eminently safe\n\n  | otherwise\n  = return (varToCoreExpr var)   -- See Note [Desugaring vars]\n\n  where\n    ty = idType var\n\ndsConLike :: Bool  -- as in dsHsVar\n          -> ConLike -> DsM CoreExpr\ndsConLike w (RealDataCon dc) = dsHsVar w (dataConWrapId dc)\ndsConLike _ (PatSynCon ps)   = return $ case patSynBuilder ps of\n  Just (id, add_void)\n    | add_void  -> mkCoreApp (text \"dsConLike\" <+> ppr ps) (Var id) (Var voidPrimId)\n    | otherwise -> Var id\n  _ -> pprPanic \"dsConLike\" (ppr ps)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Errors and contexts}\n*                                                                      *\n************************************************************************\n-}\n\n-- Warn about certain types of values discarded in monadic bindings (#3263)\nwarnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> DsM ()\nwarnDiscardedDoBindings rhs rhs_ty\n  | Just (m_ty, elt_ty) <- tcSplitAppTy_maybe rhs_ty\n  = do { warn_unused <- woptM Opt_WarnUnusedDoBind\n       ; warn_wrong <- woptM Opt_WarnWrongDoBind\n       ; when (warn_unused || warn_wrong) $\n    do { fam_inst_envs <- dsGetFamInstEnvs\n       ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty\n\n           -- Warn about discarding non-() things in 'monadic' binding\n       ; if warn_unused && not (isUnitTy norm_elt_ty)\n         then warnDs (Reason Opt_WarnUnusedDoBind)\n                     (badMonadBind rhs elt_ty)\n         else\n\n           -- Warn about discarding m a things in 'monadic' binding of the same type,\n           -- but only if we didn't already warn due to Opt_WarnUnusedDoBind\n           when warn_wrong $\n                do { case tcSplitAppTy_maybe norm_elt_ty of\n                         Just (elt_m_ty, _)\n                            | m_ty `eqType` topNormaliseType fam_inst_envs elt_m_ty\n                            -> warnDs (Reason Opt_WarnWrongDoBind)\n                                      (badMonadBind rhs elt_ty)\n                         _ -> return () } } }\n\n  | otherwise   -- RHS does have type of form (m ty), which is weird\n  = return ()   -- but at lesat this warning is irrelevant\n\nbadMonadBind :: LHsExpr GhcTc -> Type -> SDoc\nbadMonadBind rhs elt_ty\n  = vcat [ hang (text \"A do-notation statement discarded a result of type\")\n              2 (quotes (ppr elt_ty))\n         , hang (text \"Suppress this warning by saying\")\n              2 (quotes $ text \"_ <-\" <+> ppr rhs)\n         ]\n\n{-\n************************************************************************\n*                                                                      *\n   Forced eta expansion and levity polymorphism\n*                                                                      *\n************************************************************************\n\nNote [Detecting forced eta expansion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe cannot have levity polymorphic function arguments. See\nNote [Levity polymorphism invariants] in CoreSyn. But we *can* have\nfunctions that take levity polymorphism arguments, as long as these\nfunctions are eta-reduced. (See #12708 for an example.)\n\nHowever, we absolutely cannot do this for functions that have no\nbinding (i.e., say True to Id.hasNoBinding), like primops and unboxed\ntuple constructors. These get eta-expanded in CorePrep.maybeSaturate.\n\nDetecting when this is about to happen is a bit tricky, though. When\nthe desugarer is looking at the Id itself (let's be concrete and\nsuppose we have (#,#)), we don't know whether it will be levity\npolymorphic. So the right spot seems to be to look after the Id has\nbeen applied to its type arguments. To make the algorithm efficient,\nit's important to be able to spot ((#,#) @a @b @c @d) without looking\npast all the type arguments. We thus require that\n  * The body of an HsWrap is not an HsWrap.\nWith that representation invariant, we simply look inside every HsWrap\nto see if its body is an HsVar whose Id hasNoBinding. Then, we look\nat the wrapped type. If it has any levity polymorphic arguments, reject.\n\nInterestingly, this approach does not look to see whether the Id in\nquestion will be eta expanded. The logic is this:\n  * Either the Id in question is saturated or not.\n  * If it is, then it surely can't have levity polymorphic arguments.\n    If its wrapped type contains levity polymorphic arguments, reject.\n  * If it's not, then it can't be eta expanded with levity polymorphic\n    argument. If its wrapped type contains levity polymorphic arguments, reject.\nSo, either way, we're good to reject.\n\nWrinkle\n~~~~~~~\nNot all polymorphic Ids are wrapped in\nHsWrap, due to the lazy instantiation of TypeApplications. (See \"Visible type\napplication\", ESOP '16.) But if we spot a levity-polymorphic hasNoBinding Id\nwithout a wrapper, then that is surely problem and we can reject.\n\nWe thus have a parameter to `dsExpr` that tracks whether or not we are\ndirectly in an HsWrap. If we find a levity-polymorphic hasNoBinding Id when\nwe're not directly in an HsWrap, reject.\n\n-}\n\n-- | Takes an expression and its instantiated type. If the expression is an\n-- HsVar with a hasNoBinding primop and the type has levity-polymorphic arguments,\n-- issue an error. See Note [Detecting forced eta expansion]\ncheckForcedEtaExpansion :: HsExpr GhcTc -> Type -> DsM ()\ncheckForcedEtaExpansion expr ty\n  | Just var <- case expr of\n                  HsVar _ (dL->L _ var)           -> Just var\n                  HsConLikeOut _ (RealDataCon dc) -> Just (dataConWrapId dc)\n                  _                               -> Nothing\n  , let bad_tys = badUseOfLevPolyPrimop var ty\n  , not (null bad_tys)\n  = levPolyPrimopErr var ty bad_tys\ncheckForcedEtaExpansion _ _ = return ()\n\n-- | Is this a hasNoBinding Id with a levity-polymorphic type?\n-- Returns the arguments that are levity polymorphic if they are bad;\n-- or an empty list otherwise\n-- See Note [Detecting forced eta expansion]\nbadUseOfLevPolyPrimop :: Id -> Type -> [Type]\nbadUseOfLevPolyPrimop id ty\n  | hasNoBinding id\n  = filter isTypeLevPoly arg_tys\n  | otherwise\n  = []\n  where\n    (binders, _) = splitPiTys ty\n    arg_tys      = mapMaybe binderRelevantType_maybe binders\n\nlevPolyPrimopErr :: Id -> Type -> [Type] -> DsM ()\nlevPolyPrimopErr primop ty bad_tys\n  = errDs $ vcat [ hang (text \"Cannot use primitive with levity-polymorphic arguments:\")\n                      2 (ppr primop <+> dcolon <+> pprWithTYPE ty)\n                 , hang (text \"Levity-polymorphic arguments:\")\n                      2 (vcat (map (\\t -> pprWithTYPE t <+> dcolon <+> pprWithTYPE (typeKind t)) bad_tys)) ]\n", "num_lines": 1173}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1998\n\n\nDesugaring foreign declarations (see also DsCCall).\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule DsForeign ( dsForeigns ) where\n\n#include \"HsVersions.h\"\nimport GhcPrelude\n\nimport TcRnMonad        -- temp\n\nimport CoreSyn\n\nimport DsCCall\nimport DsMonad\n\nimport HsSyn\nimport DataCon\nimport CoreUnfold\nimport Id\nimport Literal\nimport Module\nimport Name\nimport Type\nimport RepType\nimport TyCon\nimport Coercion\nimport TcEnv\nimport TcType\n\nimport CmmExpr\nimport CmmUtils\nimport HscTypes\nimport ForeignCall\nimport TysWiredIn\nimport TysPrim\nimport PrelNames\nimport BasicTypes\nimport SrcLoc\nimport Outputable\nimport FastString\nimport DynFlags\nimport Platform\nimport Config\nimport OrdList\nimport Pair\nimport Util\nimport Hooks\nimport Encoding\n\nimport Data.Maybe\nimport Data.List\n\n{-\nDesugaring of @foreign@ declarations is naturally split up into\nparts, an @import@ and an @export@  part. A @foreign import@\ndeclaration\n\\begin{verbatim}\n  foreign import cc nm f :: prim_args -> IO prim_res\n\\end{verbatim}\nis the same as\n\\begin{verbatim}\n  f :: prim_args -> IO prim_res\n  f a1 ... an = _ccall_ nm cc a1 ... an\n\\end{verbatim}\nso we reuse the desugaring code in @DsCCall@ to deal with these.\n-}\n\ntype Binding = (Id, CoreExpr) -- No rec/nonrec structure;\n                              -- the occurrence analyser will sort it all out\n\ndsForeigns :: [LForeignDecl GhcTc]\n           -> DsM (ForeignStubs, OrdList Binding)\ndsForeigns fos = getHooked dsForeignsHook dsForeigns' >>= ($ fos)\n\ndsForeigns' :: [LForeignDecl GhcTc]\n            -> DsM (ForeignStubs, OrdList Binding)\ndsForeigns' []\n  = return (NoStubs, nilOL)\ndsForeigns' fos = do\n    fives <- mapM do_ldecl fos\n    let\n        (hs, cs, idss, bindss) = unzip4 fives\n        fe_ids = concat idss\n        fe_init_code = map foreignExportInitialiser fe_ids\n    --\n    return (ForeignStubs\n             (vcat hs)\n             (vcat cs $$ vcat fe_init_code),\n            foldr (appOL . toOL) nilOL bindss)\n  where\n   do_ldecl (dL->L loc decl) = putSrcSpanDs loc (do_decl decl)\n\n   do_decl (ForeignImport { fd_name = id, fd_i_ext = co, fd_fi = spec }) = do\n      traceIf (text \"fi start\" <+> ppr id)\n      let id' = unLoc id\n      (bs, h, c) <- dsFImport id' co spec\n      traceIf (text \"fi end\" <+> ppr id)\n      return (h, c, [], bs)\n\n   do_decl (ForeignExport { fd_name = (dL->L _ id)\n                          , fd_e_ext = co\n                          , fd_fe = CExport\n                              (dL->L _ (CExportStatic _ ext_nm cconv)) _ }) = do\n      (h, c, _, _) <- dsFExport id co ext_nm cconv False\n      return (h, c, [id], [])\n   do_decl (XForeignDecl _) = panic \"dsForeigns'\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Foreign import}\n*                                                                      *\n************************************************************************\n\nDesugaring foreign imports is just the matter of creating a binding\nthat on its RHS unboxes its arguments, performs the external call\n(using the @CCallOp@ primop), before boxing the result up and returning it.\n\nHowever, we create a worker/wrapper pair, thus:\n\n        foreign import f :: Int -> IO Int\n==>\n        f x = IO ( \\s -> case x of { I# x# ->\n                         case fw s x# of { (# s1, y# #) ->\n                         (# s1, I# y# #)}})\n\n        fw s x# = ccall f s x#\n\nThe strictness/CPR analyser won't do this automatically because it doesn't look\ninside returned tuples; but inlining this wrapper is a Really Good Idea\nbecause it exposes the boxing to the call site.\n-}\n\ndsFImport :: Id\n          -> Coercion\n          -> ForeignImport\n          -> DsM ([Binding], SDoc, SDoc)\ndsFImport id co (CImport cconv safety mHeader spec _) =\n    dsCImport id co spec (unLoc cconv) (unLoc safety) mHeader\n\ndsCImport :: Id\n          -> Coercion\n          -> CImportSpec\n          -> CCallConv\n          -> Safety\n          -> Maybe Header\n          -> DsM ([Binding], SDoc, SDoc)\ndsCImport id co (CLabel cid) cconv _ _ = do\n   dflags <- getDynFlags\n   let ty  = pFst $ coercionKind co\n       fod = case tyConAppTyCon_maybe (dropForAlls ty) of\n             Just tycon\n              | tyConUnique tycon == funPtrTyConKey ->\n                 IsFunction\n             _ -> IsData\n   (resTy, foRhs) <- resultWrapper ty\n   ASSERT(fromJust resTy `eqType` addrPrimTy)    -- typechecker ensures this\n    let\n        rhs = foRhs (Lit (LitLabel cid stdcall_info fod))\n        rhs' = Cast rhs co\n        stdcall_info = fun_type_arg_stdcall_info dflags cconv ty\n    in\n    return ([(id, rhs')], empty, empty)\n\ndsCImport id co (CFunction target) cconv@PrimCallConv safety _\n  = dsPrimCall id co (CCall (CCallSpec target cconv safety))\ndsCImport id co (CFunction target) cconv safety mHeader\n  = dsFCall id co (CCall (CCallSpec target cconv safety)) mHeader\ndsCImport id co CWrapper cconv _ _\n  = dsFExportDynamic id co cconv\n\n-- For stdcall labels, if the type was a FunPtr or newtype thereof,\n-- then we need to calculate the size of the arguments in order to add\n-- the @n suffix to the label.\nfun_type_arg_stdcall_info :: DynFlags -> CCallConv -> Type -> Maybe Int\nfun_type_arg_stdcall_info dflags StdCallConv ty\n  | Just (tc,[arg_ty]) <- splitTyConApp_maybe ty,\n    tyConUnique tc == funPtrTyConKey\n  = let\n       (bndrs, _) = tcSplitPiTys arg_ty\n       fe_arg_tys = mapMaybe binderRelevantType_maybe bndrs\n    in Just $ sum (map (widthInBytes . typeWidth . typeCmmType dflags . getPrimTyOf) fe_arg_tys)\nfun_type_arg_stdcall_info _ _other_conv _\n  = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Foreign calls}\n*                                                                      *\n************************************************************************\n-}\n\ndsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header\n        -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)\ndsFCall fn_id co fcall mDeclHeader = do\n    let\n        ty                   = pFst $ coercionKind co\n        (tv_bndrs, rho)      = tcSplitForAllVarBndrs ty\n        (arg_tys, io_res_ty) = tcSplitFunTys rho\n\n    args <- newSysLocalsDs arg_tys  -- no FFI levity-polymorphism\n    (val_args, arg_wrappers) <- mapAndUnzipM unboxArg (map Var args)\n\n    let\n        work_arg_ids  = [v | Var v <- val_args] -- All guaranteed to be vars\n\n    (ccall_result_ty, res_wrapper) <- boxResult io_res_ty\n\n    ccall_uniq <- newUnique\n    work_uniq  <- newUnique\n\n    dflags <- getDynFlags\n    (fcall', cDoc) <-\n              case fcall of\n              CCall (CCallSpec (StaticTarget _ cName mUnitId isFun)\n                               CApiConv safety) ->\n               do wrapperName <- mkWrapperName \"ghc_wrapper\" (unpackFS cName)\n                  let fcall' = CCall (CCallSpec\n                                      (StaticTarget NoSourceText\n                                                    wrapperName mUnitId\n                                                    True)\n                                      CApiConv safety)\n                      c = includes\n                       $$ fun_proto <+> braces (cRet <> semi)\n                      includes = vcat [ text \"#include \\\"\" <> ftext h\n                                        <> text \"\\\"\"\n                                      | Header _ h <- nub headers ]\n                      fun_proto = cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes\n                      cRet\n                       | isVoidRes =                   cCall\n                       | otherwise = text \"return\" <+> cCall\n                      cCall = if isFun\n                              then ppr cName <> parens argVals\n                              else if null arg_tys\n                                    then ppr cName\n                                    else panic \"dsFCall: Unexpected arguments to FFI value import\"\n                      raw_res_ty = case tcSplitIOType_maybe io_res_ty of\n                                   Just (_ioTyCon, res_ty) -> res_ty\n                                   Nothing                 -> io_res_ty\n                      isVoidRes = raw_res_ty `eqType` unitTy\n                      (mHeader, cResType)\n                       | isVoidRes = (Nothing, text \"void\")\n                       | otherwise = toCType raw_res_ty\n                      pprCconv = ccallConvAttribute CApiConv\n                      mHeadersArgTypeList\n                          = [ (header, cType <+> char 'a' <> int n)\n                            | (t, n) <- zip arg_tys [1..]\n                            , let (header, cType) = toCType t ]\n                      (mHeaders, argTypeList) = unzip mHeadersArgTypeList\n                      argTypes = if null argTypeList\n                                 then text \"void\"\n                                 else hsep $ punctuate comma argTypeList\n                      mHeaders' = mDeclHeader : mHeader : mHeaders\n                      headers = catMaybes mHeaders'\n                      argVals = hsep $ punctuate comma\n                                    [ char 'a' <> int n\n                                    | (_, n) <- zip arg_tys [1..] ]\n                  return (fcall', c)\n              _ ->\n                  return (fcall, empty)\n    let\n        -- Build the worker\n        worker_ty     = mkForAllTys tv_bndrs (mkVisFunTys (map idType work_arg_ids) ccall_result_ty)\n        tvs           = map binderVar tv_bndrs\n        the_ccall_app = mkFCall dflags ccall_uniq fcall' val_args ccall_result_ty\n        work_rhs      = mkLams tvs (mkLams work_arg_ids the_ccall_app)\n        work_id       = mkSysLocal (fsLit \"$wccall\") work_uniq worker_ty\n\n        -- Build the wrapper\n        work_app     = mkApps (mkVarApps (Var work_id) tvs) val_args\n        wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers\n        wrap_rhs     = mkLams (tvs ++ args) wrapper_body\n        wrap_rhs'    = Cast wrap_rhs co\n        fn_id_w_inl  = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity\n                                                (length args) wrap_rhs'\n\n    return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], empty, cDoc)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Primitive calls}\n*                                                                      *\n************************************************************************\n\nThis is for `@foreign import prim@' declarations.\n\nCurrently, at the core level we pretend that these primitive calls are\nforeign calls. It may make more sense in future to have them as a distinct\nkind of Id, or perhaps to bundle them with PrimOps since semantically and\nfor calling convention they are really prim ops.\n-}\n\ndsPrimCall :: Id -> Coercion -> ForeignCall\n           -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)\ndsPrimCall fn_id co fcall = do\n    let\n        ty                   = pFst $ coercionKind co\n        (tvs, fun_ty)        = tcSplitForAllTys ty\n        (arg_tys, io_res_ty) = tcSplitFunTys fun_ty\n\n    args <- newSysLocalsDs arg_tys  -- no FFI levity-polymorphism\n\n    ccall_uniq <- newUnique\n    dflags <- getDynFlags\n    let\n        call_app = mkFCall dflags ccall_uniq fcall (map Var args) io_res_ty\n        rhs      = mkLams tvs (mkLams args call_app)\n        rhs'     = Cast rhs co\n    return ([(fn_id, rhs')], empty, empty)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Foreign export}\n*                                                                      *\n************************************************************************\n\nThe function that does most of the work for `@foreign export@' declarations.\n(see below for the boilerplate code a `@foreign export@' declaration expands\n into.)\n\nFor each `@foreign export foo@' in a module M we generate:\n\\begin{itemize}\n\\item a C function `@foo@', which calls\n\\item a Haskell stub `@M.\\$ffoo@', which calls\n\\end{itemize}\nthe user-written Haskell function `@M.foo@'.\n-}\n\ndsFExport :: Id                 -- Either the exported Id,\n                                -- or the foreign-export-dynamic constructor\n          -> Coercion           -- Coercion between the Haskell type callable\n                                -- from C, and its representation type\n          -> CLabelString       -- The name to export to C land\n          -> CCallConv\n          -> Bool               -- True => foreign export dynamic\n                                --         so invoke IO action that's hanging off\n                                --         the first argument's stable pointer\n          -> DsM ( SDoc         -- contents of Module_stub.h\n                 , SDoc         -- contents of Module_stub.c\n                 , String       -- string describing type to pass to createAdj.\n                 , Int          -- size of args to stub function\n                 )\n\ndsFExport fn_id co ext_name cconv isDyn = do\n    let\n       ty                     = pSnd $ coercionKind co\n       (bndrs, orig_res_ty)   = tcSplitPiTys ty\n       fe_arg_tys'            = mapMaybe binderRelevantType_maybe bndrs\n       -- We must use tcSplits here, because we want to see\n       -- the (IO t) in the corner of the type!\n       fe_arg_tys | isDyn     = tail fe_arg_tys'\n                  | otherwise = fe_arg_tys'\n\n       -- Look at the result type of the exported function, orig_res_ty\n       -- If it's IO t, return         (t, True)\n       -- If it's plain t, return      (t, False)\n       (res_ty, is_IO_res_ty) = case tcSplitIOType_maybe orig_res_ty of\n                                -- The function already returns IO t\n                                Just (_ioTyCon, res_ty) -> (res_ty, True)\n                                -- The function returns t\n                                Nothing                 -> (orig_res_ty, False)\n\n    dflags <- getDynFlags\n    return $\n      mkFExportCBits dflags ext_name\n                     (if isDyn then Nothing else Just fn_id)\n                     fe_arg_tys res_ty is_IO_res_ty cconv\n\n{-\n@foreign import \"wrapper\"@ (previously \"foreign export dynamic\") lets\nyou dress up Haskell IO actions of some fixed type behind an\nexternally callable interface (i.e., as a C function pointer). Useful\nfor callbacks and stuff.\n\n\\begin{verbatim}\ntype Fun = Bool -> Int -> IO Int\nforeign import \"wrapper\" f :: Fun -> IO (FunPtr Fun)\n\n-- Haskell-visible constructor, which is generated from the above:\n-- SUP: No check for NULL from createAdjustor anymore???\n\nf :: Fun -> IO (FunPtr Fun)\nf cback =\n   bindIO (newStablePtr cback)\n          (\\StablePtr sp# -> IO (\\s1# ->\n              case _ccall_ createAdjustor cconv sp# ``f_helper'' <arg info> s1# of\n                 (# s2#, a# #) -> (# s2#, A# a# #)))\n\nforeign import \"&f_helper\" f_helper :: FunPtr (StablePtr Fun -> Fun)\n\n-- and the helper in C: (approximately; see `mkFExportCBits` below)\n\nf_helper(StablePtr s, HsBool b, HsInt i)\n{\n        Capability *cap;\n        cap = rts_lock();\n        rts_evalIO(&cap,\n                   rts_apply(rts_apply(deRefStablePtr(s),\n                                       rts_mkBool(b)), rts_mkInt(i)));\n        rts_unlock(cap);\n}\n\\end{verbatim}\n-}\n\ndsFExportDynamic :: Id\n                 -> Coercion\n                 -> CCallConv\n                 -> DsM ([Binding], SDoc, SDoc)\ndsFExportDynamic id co0 cconv = do\n    mod <- getModule\n    dflags <- getDynFlags\n    let fe_nm = mkFastString $ zEncodeString\n            (moduleStableString mod ++ \"$\" ++ toCName dflags id)\n        -- Construct the label based on the passed id, don't use names\n        -- depending on Unique. See #13807 and Note [Unique Determinism].\n    cback <- newSysLocalDs arg_ty\n    newStablePtrId <- dsLookupGlobalId newStablePtrName\n    stable_ptr_tycon <- dsLookupTyCon stablePtrTyConName\n    let\n        stable_ptr_ty = mkTyConApp stable_ptr_tycon [arg_ty]\n        export_ty     = mkVisFunTy stable_ptr_ty arg_ty\n    bindIOId <- dsLookupGlobalId bindIOName\n    stbl_value <- newSysLocalDs stable_ptr_ty\n    (h_code, c_code, typestring, args_size) <- dsFExport id (mkRepReflCo export_ty) fe_nm cconv True\n    let\n         {-\n          The arguments to the external function which will\n          create a little bit of (template) code on the fly\n          for allowing the (stable pointed) Haskell closure\n          to be entered using an external calling convention\n          (stdcall, ccall).\n         -}\n        adj_args      = [ mkIntLitInt dflags (ccallConvToInt cconv)\n                        , Var stbl_value\n                        , Lit (LitLabel fe_nm mb_sz_args IsFunction)\n                        , Lit (mkLitString typestring)\n                        ]\n          -- name of external entry point providing these services.\n          -- (probably in the RTS.)\n        adjustor   = fsLit \"createAdjustor\"\n\n          -- Determine the number of bytes of arguments to the stub function,\n          -- so that we can attach the '@N' suffix to its label if it is a\n          -- stdcall on Windows.\n        mb_sz_args = case cconv of\n                        StdCallConv -> Just args_size\n                        _           -> Nothing\n\n    ccall_adj <- dsCCall adjustor adj_args PlayRisky (mkTyConApp io_tc [res_ty])\n        -- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback\n\n    let io_app = mkLams tvs                  $\n                 Lam cback                   $\n                 mkApps (Var bindIOId)\n                        [ Type stable_ptr_ty\n                        , Type res_ty\n                        , mkApps (Var newStablePtrId) [ Type arg_ty, Var cback ]\n                        , Lam stbl_value ccall_adj\n                        ]\n\n        fed = (id `setInlineActivation` NeverActive, Cast io_app co0)\n               -- Never inline the f.e.d. function, because the litlit\n               -- might not be in scope in other modules.\n\n    return ([fed], h_code, c_code)\n\n where\n  ty                       = pFst (coercionKind co0)\n  (tvs,sans_foralls)       = tcSplitForAllTys ty\n  ([arg_ty], fn_res_ty)    = tcSplitFunTys sans_foralls\n  Just (io_tc, res_ty)     = tcSplitIOType_maybe fn_res_ty\n        -- Must have an IO type; hence Just\n\n\ntoCName :: DynFlags -> Id -> String\ntoCName dflags i = showSDoc dflags (pprCode CStyle (ppr (idName i)))\n\n{-\n*\n\n\\subsection{Generating @foreign export@ stubs}\n\n*\n\nFor each @foreign export@ function, a C stub function is generated.\nThe C stub constructs the application of the exported Haskell function\nusing the hugs/ghc rts invocation API.\n-}\n\nmkFExportCBits :: DynFlags\n               -> FastString\n               -> Maybe Id      -- Just==static, Nothing==dynamic\n               -> [Type]\n               -> Type\n               -> Bool          -- True <=> returns an IO type\n               -> CCallConv\n               -> (SDoc,\n                   SDoc,\n                   String,      -- the argument reps\n                   Int          -- total size of arguments\n                  )\nmkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc\n = (header_bits, c_bits, type_string,\n    sum [ widthInBytes (typeWidth rep) | (_,_,_,rep) <- aug_arg_info] -- all the args\n         -- NB. the calculation here isn't strictly speaking correct.\n         -- We have a primitive Haskell type (eg. Int#, Double#), and\n         -- we want to know the size, when passed on the C stack, of\n         -- the associated C type (eg. HsInt, HsDouble).  We don't have\n         -- this information to hand, but we know what GHC's conventions\n         -- are for passing around the primitive Haskell types, so we\n         -- use that instead.  I hope the two coincide --SDM\n    )\n where\n  -- list the arguments to the C function\n  arg_info :: [(SDoc,           -- arg name\n                SDoc,           -- C type\n                Type,           -- Haskell type\n                CmmType)]       -- the CmmType\n  arg_info  = [ let stg_type = showStgType ty in\n                (arg_cname n stg_type,\n                 stg_type,\n                 ty,\n                 typeCmmType dflags (getPrimTyOf ty))\n              | (ty,n) <- zip arg_htys [1::Int ..] ]\n\n  arg_cname n stg_ty\n        | libffi    = char '*' <> parens (stg_ty <> char '*') <>\n                      text \"args\" <> brackets (int (n-1))\n        | otherwise = text ('a':show n)\n\n  -- generate a libffi-style stub if this is a \"wrapper\" and libffi is enabled\n  libffi = cLibFFI && isNothing maybe_target\n\n  type_string\n      -- libffi needs to know the result type too:\n      | libffi    = primTyDescChar dflags res_hty : arg_type_string\n      | otherwise = arg_type_string\n\n  arg_type_string = [primTyDescChar dflags ty | (_,_,ty,_) <- arg_info]\n                -- just the real args\n\n  -- add some auxiliary args; the stable ptr in the wrapper case, and\n  -- a slot for the dummy return address in the wrapper + ccall case\n  aug_arg_info\n    | isNothing maybe_target = stable_ptr_arg : insertRetAddr dflags cc arg_info\n    | otherwise              = arg_info\n\n  stable_ptr_arg =\n        (text \"the_stableptr\", text \"StgStablePtr\", undefined,\n         typeCmmType dflags (mkStablePtrPrimTy alphaTy))\n\n  -- stuff to do with the return type of the C function\n  res_hty_is_unit = res_hty `eqType` unitTy     -- Look through any newtypes\n\n  cResType | res_hty_is_unit = text \"void\"\n           | otherwise       = showStgType res_hty\n\n  -- when the return type is integral and word-sized or smaller, it\n  -- must be assigned as type ffi_arg (#3516).  To see what type\n  -- libffi is expecting here, take a look in its own testsuite, e.g.\n  -- libffi/testsuite/libffi.call/cls_align_ulonglong.c\n  ffi_cResType\n     | is_ffi_arg_type = text \"ffi_arg\"\n     | otherwise       = cResType\n     where\n       res_ty_key = getUnique (getName (typeTyCon res_hty))\n       is_ffi_arg_type = res_ty_key `notElem`\n              [floatTyConKey, doubleTyConKey,\n               int64TyConKey, word64TyConKey]\n\n  -- Now we can cook up the prototype for the exported function.\n  pprCconv = ccallConvAttribute cc\n\n  header_bits = text \"extern\" <+> fun_proto <> semi\n\n  fun_args\n    | null aug_arg_info = text \"void\"\n    | otherwise         = hsep $ punctuate comma\n                               $ map (\\(nm,ty,_,_) -> ty <+> nm) aug_arg_info\n\n  fun_proto\n    | libffi\n      = text \"void\" <+> ftext c_nm <>\n          parens (text \"void *cif STG_UNUSED, void* resp, void** args, void* the_stableptr\")\n    | otherwise\n      = cResType <+> pprCconv <+> ftext c_nm <> parens fun_args\n\n  -- the target which will form the root of what we ask rts_evalIO to run\n  the_cfun\n     = case maybe_target of\n          Nothing    -> text \"(StgClosure*)deRefStablePtr(the_stableptr)\"\n          Just hs_fn -> char '&' <> ppr hs_fn <> text \"_closure\"\n\n  cap = text \"cap\" <> comma\n\n  -- the expression we give to rts_evalIO\n  expr_to_run\n     = foldl' appArg the_cfun arg_info -- NOT aug_arg_info\n       where\n          appArg acc (arg_cname, _, arg_hty, _)\n             = text \"rts_apply\"\n               <> parens (cap <> acc <> comma <> mkHObj arg_hty <> parens (cap <> arg_cname))\n\n  -- various other bits for inside the fn\n  declareResult = text \"HaskellObj ret;\"\n  declareCResult | res_hty_is_unit = empty\n                 | otherwise       = cResType <+> text \"cret;\"\n\n  assignCResult | res_hty_is_unit = empty\n                | otherwise       =\n                        text \"cret=\" <> unpackHObj res_hty <> parens (text \"ret\") <> semi\n\n  -- an extern decl for the fn being called\n  extern_decl\n     = case maybe_target of\n          Nothing -> empty\n          Just hs_fn -> text \"extern StgClosure \" <> ppr hs_fn <> text \"_closure\" <> semi\n\n\n  -- finally, the whole darn thing\n  c_bits =\n    space $$\n    extern_decl $$\n    fun_proto  $$\n    vcat\n     [ lbrace\n     ,   text \"Capability *cap;\"\n     ,   declareResult\n     ,   declareCResult\n     ,   text \"cap = rts_lock();\"\n          -- create the application + perform it.\n     ,   text \"rts_evalIO\" <> parens (\n                char '&' <> cap <>\n                text \"rts_apply\" <> parens (\n                    cap <>\n                    text \"(HaskellObj)\"\n                 <> ptext (if is_IO_res_ty\n                                then (sLit \"runIO_closure\")\n                                else (sLit \"runNonIO_closure\"))\n                 <> comma\n                 <> expr_to_run\n                ) <+> comma\n               <> text \"&ret\"\n             ) <> semi\n     ,   text \"rts_checkSchedStatus\" <> parens (doubleQuotes (ftext c_nm)\n                                                <> comma <> text \"cap\") <> semi\n     ,   assignCResult\n     ,   text \"rts_unlock(cap);\"\n     ,   ppUnless res_hty_is_unit $\n         if libffi\n                  then char '*' <> parens (ffi_cResType <> char '*') <>\n                       text \"resp = cret;\"\n                  else text \"return cret;\"\n     , rbrace\n     ]\n\n\nforeignExportInitialiser :: Id -> SDoc\nforeignExportInitialiser hs_fn =\n   -- Initialise foreign exports by registering a stable pointer from an\n   -- __attribute__((constructor)) function.\n   -- The alternative is to do this from stginit functions generated in\n   -- codeGen/CodeGen.hs; however, stginit functions have a negative impact\n   -- on binary sizes and link times because the static linker will think that\n   -- all modules that are imported directly or indirectly are actually used by\n   -- the program.\n   -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL)\n   vcat\n    [ text \"static void stginit_export_\" <> ppr hs_fn\n         <> text \"() __attribute__((constructor));\"\n    , text \"static void stginit_export_\" <> ppr hs_fn <> text \"()\"\n    , braces (text \"foreignExportStablePtr\"\n       <> parens (text \"(StgPtr) &\" <> ppr hs_fn <> text \"_closure\")\n       <> semi)\n    ]\n\n\nmkHObj :: Type -> SDoc\nmkHObj t = text \"rts_mk\" <> text (showFFIType t)\n\nunpackHObj :: Type -> SDoc\nunpackHObj t = text \"rts_get\" <> text (showFFIType t)\n\nshowStgType :: Type -> SDoc\nshowStgType t = text \"Hs\" <> text (showFFIType t)\n\nshowFFIType :: Type -> String\nshowFFIType t = getOccString (getName (typeTyCon t))\n\ntoCType :: Type -> (Maybe Header, SDoc)\ntoCType = f False\n    where f voidOK t\n           -- First, if we have (Ptr t) of (FunPtr t), then we need to\n           -- convert t to a C type and put a * after it. If we don't\n           -- know a type for t, then \"void\" is fine, though.\n           | Just (ptr, [t']) <- splitTyConApp_maybe t\n           , tyConName ptr `elem` [ptrTyConName, funPtrTyConName]\n              = case f True t' of\n                (mh, cType') ->\n                    (mh, cType' <> char '*')\n           -- Otherwise, if we have a type constructor application, then\n           -- see if there is a C type associated with that constructor.\n           -- Note that we aren't looking through type synonyms or\n           -- anything, as it may be the synonym that is annotated.\n           | Just tycon <- tyConAppTyConPicky_maybe t\n           , Just (CType _ mHeader (_,cType)) <- tyConCType_maybe tycon\n              = (mHeader, ftext cType)\n           -- If we don't know a C type for this type, then try looking\n           -- through one layer of type synonym etc.\n           | Just t' <- coreView t\n              = f voidOK t'\n           -- This may be an 'UnliftedFFITypes'-style ByteArray# argument\n           -- (which is marshalled like a Ptr)\n           | Just byteArrayPrimTyCon        == tyConAppTyConPicky_maybe t\n              = (Nothing, text \"const void*\")\n           | Just mutableByteArrayPrimTyCon == tyConAppTyConPicky_maybe t\n              = (Nothing, text \"void*\")\n           -- Otherwise we don't know the C type. If we are allowing\n           -- void then return that; otherwise something has gone wrong.\n           | voidOK = (Nothing, text \"void\")\n           | otherwise\n              = pprPanic \"toCType\" (ppr t)\n\ntypeTyCon :: Type -> TyCon\ntypeTyCon ty\n  | Just (tc, _) <- tcSplitTyConApp_maybe (unwrapType ty)\n  = tc\n  | otherwise\n  = pprPanic \"DsForeign.typeTyCon\" (ppr ty)\n\ninsertRetAddr :: DynFlags -> CCallConv\n              -> [(SDoc, SDoc, Type, CmmType)]\n              -> [(SDoc, SDoc, Type, CmmType)]\ninsertRetAddr dflags CCallConv args\n    = case platformArch platform of\n      ArchX86_64\n       | platformOS platform == OSMinGW32 ->\n          -- On other Windows x86_64 we insert the return address\n          -- after the 4th argument, because this is the point\n          -- at which we need to flush a register argument to the stack\n          -- (See rts/Adjustor.c for details).\n          let go :: Int -> [(SDoc, SDoc, Type, CmmType)]\n                        -> [(SDoc, SDoc, Type, CmmType)]\n              go 4 args = ret_addr_arg dflags : args\n              go n (arg:args) = arg : go (n+1) args\n              go _ [] = []\n          in go 0 args\n       | otherwise ->\n          -- On other x86_64 platforms we insert the return address\n          -- after the 6th integer argument, because this is the point\n          -- at which we need to flush a register argument to the stack\n          -- (See rts/Adjustor.c for details).\n          let go :: Int -> [(SDoc, SDoc, Type, CmmType)]\n                        -> [(SDoc, SDoc, Type, CmmType)]\n              go 6 args = ret_addr_arg dflags : args\n              go n (arg@(_,_,_,rep):args)\n               | cmmEqType_ignoring_ptrhood rep b64 = arg : go (n+1) args\n               | otherwise  = arg : go n     args\n              go _ [] = []\n          in go 0 args\n      _ ->\n          ret_addr_arg dflags : args\n    where platform = targetPlatform dflags\ninsertRetAddr _ _ args = args\n\nret_addr_arg :: DynFlags -> (SDoc, SDoc, Type, CmmType)\nret_addr_arg dflags = (text \"original_return_addr\", text \"void*\", undefined,\n                       typeCmmType dflags addrPrimTy)\n\n-- This function returns the primitive type associated with the boxed\n-- type argument to a foreign export (eg. Int ==> Int#).\ngetPrimTyOf :: Type -> UnaryType\ngetPrimTyOf ty\n  | isBoolTy rep_ty = intPrimTy\n  -- Except for Bool, the types we are interested in have a single constructor\n  -- with a single primitive-typed argument (see TcType.legalFEArgTyCon).\n  | otherwise =\n  case splitDataProductType_maybe rep_ty of\n     Just (_, _, data_con, [prim_ty]) ->\n        ASSERT(dataConSourceArity data_con == 1)\n        ASSERT2(isUnliftedType prim_ty, ppr prim_ty)\n        prim_ty\n     _other -> pprPanic \"DsForeign.getPrimTyOf\" (ppr ty)\n  where\n        rep_ty = unwrapType ty\n\n-- represent a primitive type as a Char, for building a string that\n-- described the foreign function type.  The types are size-dependent,\n-- e.g. 'W' is a signed 32-bit integer.\nprimTyDescChar :: DynFlags -> Type -> Char\nprimTyDescChar dflags ty\n | ty `eqType` unitTy = 'v'\n | otherwise\n = case typePrimRep1 (getPrimTyOf ty) of\n     IntRep      -> signed_word\n     WordRep     -> unsigned_word\n     Int64Rep    -> 'L'\n     Word64Rep   -> 'l'\n     AddrRep     -> 'p'\n     FloatRep    -> 'f'\n     DoubleRep   -> 'd'\n     _           -> pprPanic \"primTyDescChar\" (ppr ty)\n  where\n    (signed_word, unsigned_word)\n       | wORD_SIZE dflags == 4  = ('W','w')\n       | wORD_SIZE dflags == 8  = ('L','l')\n       | otherwise              = panic \"primTyDescChar\"\n", "num_lines": 821}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nMatching guarded right-hand-sides (GRHSs)\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule DsGRHSs ( dsGuarded, dsGRHSs, dsGRHS, isTrueLHsExpr ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} DsExpr  ( dsLExpr, dsLocalBinds )\nimport {-# SOURCE #-} Match   ( matchSinglePatVar )\n\nimport HsSyn\nimport MkCore\nimport CoreSyn\nimport CoreUtils (bindNonRec)\n\nimport Check (genCaseTmCs2)\nimport DsMonad\nimport DsUtils\nimport Type   ( Type )\nimport Name\nimport Util\nimport SrcLoc\nimport Outputable\n\n{-\n@dsGuarded@ is used for pattern bindings.\nIt desugars:\n\\begin{verbatim}\n        | g1 -> e1\n        ...\n        | gn -> en\n        where binds\n\\end{verbatim}\nproducing an expression with a runtime error in the corner if\nnecessary.  The type argument gives the type of the @ei@.\n-}\n\ndsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> DsM CoreExpr\ndsGuarded grhss rhs_ty = do\n    match_result <- dsGRHSs PatBindRhs grhss rhs_ty\n    error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty\n    extractMatchResult match_result error_expr\n\n-- In contrast, @dsGRHSs@ produces a @MatchResult@.\n\ndsGRHSs :: HsMatchContext Name\n        -> GRHSs GhcTc (LHsExpr GhcTc)          -- Guarded RHSs\n        -> Type                                 -- Type of RHS\n        -> DsM MatchResult\ndsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty\n  = ASSERT( notNull grhss )\n    do { match_results <- mapM (dsGRHS hs_ctx rhs_ty) grhss\n       ; let match_result1 = foldr1 combineMatchResults match_results\n             match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1\n                             -- NB: nested dsLet inside matchResult\n       ; return match_result2 }\ndsGRHSs _ (XGRHSs _) _ = panic \"dsGRHSs\"\n\ndsGRHS :: HsMatchContext Name -> Type -> LGRHS GhcTc (LHsExpr GhcTc)\n       -> DsM MatchResult\ndsGRHS hs_ctx rhs_ty (dL->L _ (GRHS _ guards rhs))\n  = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty\ndsGRHS _ _ (dL->L _ (XGRHS _)) = panic \"dsGRHS\"\ndsGRHS _ _ _ = panic \"dsGRHS: Impossible Match\" -- due to #15884\n\n{-\n************************************************************************\n*                                                                      *\n*  matchGuard : make a MatchResult from a guarded RHS                  *\n*                                                                      *\n************************************************************************\n-}\n\nmatchGuards :: [GuardStmt GhcTc]     -- Guard\n            -> HsStmtContext Name    -- Context\n            -> LHsExpr GhcTc         -- RHS\n            -> Type                  -- Type of RHS of guard\n            -> DsM MatchResult\n\n-- See comments with HsExpr.Stmt re what a BodyStmt means\n-- Here we must be in a guard context (not do-expression, nor list-comp)\n\nmatchGuards [] _ rhs _\n  = do  { core_rhs <- dsLExpr rhs\n        ; return (cantFailMatchResult core_rhs) }\n\n        -- BodyStmts must be guards\n        -- Turn an \"otherwise\" guard is a no-op.  This ensures that\n        -- you don't get a \"non-exhaustive eqns\" message when the guards\n        -- finish in \"otherwise\".\n        -- NB:  The success of this clause depends on the typechecker not\n        --      wrapping the 'otherwise' in empty HsTyApp or HsWrap constructors\n        --      If it does, you'll get bogus overlap warnings\nmatchGuards (BodyStmt _ e _ _ : stmts) ctx rhs rhs_ty\n  | Just addTicks <- isTrueLHsExpr e = do\n    match_result <- matchGuards stmts ctx rhs rhs_ty\n    return (adjustMatchResultDs addTicks match_result)\nmatchGuards (BodyStmt _ expr _ _ : stmts) ctx rhs rhs_ty = do\n    match_result <- matchGuards stmts ctx rhs rhs_ty\n    pred_expr <- dsLExpr expr\n    return (mkGuardedMatchResult pred_expr match_result)\n\nmatchGuards (LetStmt _ binds : stmts) ctx rhs rhs_ty = do\n    match_result <- matchGuards stmts ctx rhs rhs_ty\n    return (adjustMatchResultDs (dsLocalBinds binds) match_result)\n        -- NB the dsLet occurs inside the match_result\n        -- Reason: dsLet takes the body expression as its argument\n        --         so we can't desugar the bindings without the\n        --         body expression in hand\n\nmatchGuards (BindStmt _ pat bind_rhs _ _ : stmts) ctx rhs rhs_ty = do\n    let upat = unLoc pat\n        dicts = collectEvVarsPat upat\n    match_var <- selectMatchVar upat\n    tm_cs <- genCaseTmCs2 (Just bind_rhs) [upat] [match_var]\n    match_result <- addDictsDs dicts $\n                    addTmCsDs tm_cs  $\n                      -- See Note [Type and Term Equality Propagation] in Check\n                    matchGuards stmts ctx rhs rhs_ty\n    core_rhs <- dsLExpr bind_rhs\n    match_result' <- matchSinglePatVar match_var (StmtCtxt ctx) pat rhs_ty\n                                       match_result\n    pure $ adjustMatchResult (bindNonRec match_var core_rhs) match_result'\n\nmatchGuards (LastStmt  {} : _) _ _ _ = panic \"matchGuards LastStmt\"\nmatchGuards (ParStmt   {} : _) _ _ _ = panic \"matchGuards ParStmt\"\nmatchGuards (TransStmt {} : _) _ _ _ = panic \"matchGuards TransStmt\"\nmatchGuards (RecStmt   {} : _) _ _ _ = panic \"matchGuards RecStmt\"\nmatchGuards (ApplicativeStmt {} : _) _ _ _ =\n  panic \"matchGuards ApplicativeLastStmt\"\nmatchGuards (XStmtLR {} : _) _ _ _ =\n  panic \"matchGuards XStmtLR\"\n\n{-\nShould {\\em fail} if @e@ returns @D@\n\\begin{verbatim}\nf x | p <- e', let C y# = e, f y# = r1\n    | otherwise          = r2\n\\end{verbatim}\n-}\n", "num_lines": 151}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nDesugaring list comprehensions, monad comprehensions and array comprehensions\n-}\n\n{-# LANGUAGE CPP, NamedFieldPuns #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule DsListComp ( dsListComp, dsMonadComp ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds, dsSyntaxExpr )\n\nimport HsSyn\nimport TcHsSyn\nimport CoreSyn\nimport MkCore\n\nimport DsMonad          -- the monadery used in the desugarer\nimport DsUtils\n\nimport DynFlags\nimport CoreUtils\nimport Id\nimport Type\nimport TysWiredIn\nimport Match\nimport PrelNames\nimport SrcLoc\nimport Outputable\nimport TcType\nimport ListSetOps( getNth )\nimport Util\n\n{-\nList comprehensions may be desugared in one of two ways: ``ordinary''\n(as you would expect if you read SLPJ's book) and ``with foldr/build\nturned on'' (if you read Gill {\\em et al.}'s paper on the subject).\n\nThere will be at least one ``qualifier'' in the input.\n-}\n\ndsListComp :: [ExprLStmt GhcTc]\n           -> Type              -- Type of entire list\n           -> DsM CoreExpr\ndsListComp lquals res_ty = do\n    dflags <- getDynFlags\n    let quals = map unLoc lquals\n        elt_ty = case tcTyConAppArgs res_ty of\n                   [elt_ty] -> elt_ty\n                   _ -> pprPanic \"dsListComp\" (ppr res_ty $$ ppr lquals)\n\n    if not (gopt Opt_EnableRewriteRules dflags) || gopt Opt_IgnoreInterfacePragmas dflags\n       -- Either rules are switched off, or we are ignoring what there are;\n       -- Either way foldr/build won't happen, so use the more efficient\n       -- Wadler-style desugaring\n       || isParallelComp quals\n       -- Foldr-style desugaring can't handle parallel list comprehensions\n        then deListComp quals (mkNilExpr elt_ty)\n        else mkBuildExpr elt_ty (\\(c, _) (n, _) -> dfListComp c n quals)\n             -- Foldr/build should be enabled, so desugar\n             -- into foldrs and builds\n\n  where\n    -- We must test for ParStmt anywhere, not just at the head, because an extension\n    -- to list comprehensions would be to add brackets to specify the associativity\n    -- of qualifier lists. This is really easy to do by adding extra ParStmts into the\n    -- mix of possibly a single element in length, so we do this to leave the possibility open\n    isParallelComp = any isParallelStmt\n\n    isParallelStmt (ParStmt {}) = True\n    isParallelStmt _            = False\n\n\n-- This function lets you desugar a inner list comprehension and a list of the binders\n-- of that comprehension that we need in the outer comprehension into such an expression\n-- and the type of the elements that it outputs (tuples of binders)\ndsInnerListComp :: (ParStmtBlock GhcTc GhcTc) -> DsM (CoreExpr, Type)\ndsInnerListComp (ParStmtBlock _ stmts bndrs _)\n  = do { let bndrs_tuple_type = mkBigCoreVarTupTy bndrs\n             list_ty          = mkListTy bndrs_tuple_type\n\n             -- really use original bndrs below!\n       ; expr <- dsListComp (stmts ++ [noLoc $ mkLastStmt (mkBigLHsVarTupId bndrs)]) list_ty\n\n       ; return (expr, bndrs_tuple_type) }\ndsInnerListComp (XParStmtBlock{}) = panic \"dsInnerListComp\"\n\n-- This function factors out commonality between the desugaring strategies for GroupStmt.\n-- Given such a statement it gives you back an expression representing how to compute the transformed\n-- list and the tuple that you need to bind from that list in order to proceed with your desugaring\ndsTransStmt :: ExprStmt GhcTc -> DsM (CoreExpr, LPat GhcTc)\ndsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderMap\n                       , trS_by = by, trS_using = using }) = do\n    let (from_bndrs, to_bndrs) = unzip binderMap\n\n    let from_bndrs_tys  = map idType from_bndrs\n        to_bndrs_tys    = map idType to_bndrs\n\n        to_bndrs_tup_ty = mkBigCoreTupTy to_bndrs_tys\n\n    -- Desugar an inner comprehension which outputs a list of tuples of the \"from\" binders\n    (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock noExt stmts\n                                                        from_bndrs noSyntaxExpr)\n\n    -- Work out what arguments should be supplied to that expression: i.e. is an extraction\n    -- function required? If so, create that desugared function and add to arguments\n    usingExpr' <- dsLExpr using\n    usingArgs' <- case by of\n                    Nothing   -> return [expr']\n                    Just by_e -> do { by_e' <- dsLExpr by_e\n                                    ; lam' <- matchTuple from_bndrs by_e'\n                                    ; return [lam', expr'] }\n\n    -- Create an unzip function for the appropriate arity and element types and find \"map\"\n    unzip_stuff' <- mkUnzipBind form from_bndrs_tys\n    map_id <- dsLookupGlobalId mapName\n\n    -- Generate the expressions to build the grouped list\n    let -- First we apply the grouping function to the inner list\n        inner_list_expr' = mkApps usingExpr' usingArgs'\n        -- Then we map our \"unzip\" across it to turn the lists of tuples into tuples of lists\n        -- We make sure we instantiate the type variable \"a\" to be a list of \"from\" tuples and\n        -- the \"b\" to be a tuple of \"to\" lists!\n        -- Then finally we bind the unzip function around that expression\n        bound_unzipped_inner_list_expr'\n          = case unzip_stuff' of\n              Nothing -> inner_list_expr'\n              Just (unzip_fn', unzip_rhs') ->\n                Let (Rec [(unzip_fn', unzip_rhs')]) $\n                mkApps (Var map_id) $\n                [ Type (mkListTy from_tup_ty)\n                , Type to_bndrs_tup_ty\n                , Var unzip_fn'\n                , inner_list_expr' ]\n\n    dsNoLevPoly (tcFunResultTyN (length usingArgs') (exprType usingExpr'))\n      (text \"In the result of a\" <+> quotes (text \"using\") <+> text \"function:\" <+> ppr using)\n\n    -- Build a pattern that ensures the consumer binds into the NEW binders,\n    -- which hold lists rather than single values\n    let pat = mkBigLHsVarPatTupId to_bndrs  -- NB: no '!\n    return (bound_unzipped_inner_list_expr', pat)\n\ndsTransStmt _ = panic \"dsTransStmt: Not given a TransStmt\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DsListComp-ordinary]{Ordinary desugaring of list comprehensions}\n*                                                                      *\n************************************************************************\n\nJust as in Phil's chapter~7 in SLPJ, using the rules for\noptimally-compiled list comprehensions.  This is what Kevin followed\nas well, and I quite happily do the same.  The TQ translation scheme\ntransforms a list of qualifiers (either boolean expressions or\ngenerators) into a single expression which implements the list\ncomprehension.  Because we are generating 2nd-order polymorphic\nlambda-calculus, calls to NIL and CONS must be applied to a type\nargument, as well as their usual value arguments.\n\\begin{verbatim}\nTE << [ e | qs ] >>  =  TQ << [ e | qs ] ++ Nil (typeOf e) >>\n\n(Rule C)\nTQ << [ e | ] ++ L >> = Cons (typeOf e) TE <<e>> TE <<L>>\n\n(Rule B)\nTQ << [ e | b , qs ] ++ L >> =\n    if TE << b >> then TQ << [ e | qs ] ++ L >> else TE << L >>\n\n(Rule A')\nTQ << [ e | p <- L1, qs ]  ++  L2 >> =\n  letrec\n    h = \\ u1 ->\n          case u1 of\n            []        ->  TE << L2 >>\n            (u2 : u3) ->\n                  (( \\ TE << p >> -> ( TQ << [e | qs]  ++  (h u3) >> )) u2)\n                    [] (h u3)\n  in\n    h ( TE << L1 >> )\n\n\"h\", \"u1\", \"u2\", and \"u3\" are new variables.\n\\end{verbatim}\n\n@deListComp@ is the TQ translation scheme.  Roughly speaking, @dsExpr@\nis the TE translation scheme.  Note that we carry around the @L@ list\nalready desugared.  @dsListComp@ does the top TE rule mentioned above.\n\nTo the above, we add an additional rule to deal with parallel list\ncomprehensions.  The translation goes roughly as follows:\n     [ e | p1 <- e11, let v1 = e12, p2 <- e13\n         | q1 <- e21, let v2 = e22, q2 <- e23]\n     =>\n     [ e | ((x1, .., xn), (y1, ..., ym)) <-\n               zip [(x1,..,xn) | p1 <- e11, let v1 = e12, p2 <- e13]\n                   [(y1,..,ym) | q1 <- e21, let v2 = e22, q2 <- e23]]\nwhere (x1, .., xn) are the variables bound in p1, v1, p2\n      (y1, .., ym) are the variables bound in q1, v2, q2\n\nIn the translation below, the ParStmt branch translates each parallel branch\ninto a sub-comprehension, and desugars each independently.  The resulting lists\nare fed to a zip function, we create a binding for all the variables bound in all\nthe comprehensions, and then we hand things off the desugarer for bindings.\nThe zip function is generated here a) because it's small, and b) because then we\ndon't have to deal with arbitrary limits on the number of zip functions in the\nprelude, nor which library the zip function came from.\nThe introduced tuples are Boxed, but only because I couldn't get it to work\nwith the Unboxed variety.\n-}\n\ndeListComp :: [ExprStmt GhcTc] -> CoreExpr -> DsM CoreExpr\n\ndeListComp [] _ = panic \"deListComp\"\n\ndeListComp (LastStmt _ body _ _ : quals) list\n  =     -- Figure 7.4, SLPJ, p 135, rule C above\n    ASSERT( null quals )\n    do { core_body <- dsLExpr body\n       ; return (mkConsExpr (exprType core_body) core_body list) }\n\n        -- Non-last: must be a guard\ndeListComp (BodyStmt _ guard _ _ : quals) list = do  -- rule B above\n    core_guard <- dsLExpr guard\n    core_rest <- deListComp quals list\n    return (mkIfThenElse core_guard core_rest list)\n\n-- [e | let B, qs] = let B in [e | qs]\ndeListComp (LetStmt _ binds : quals) list = do\n    core_rest <- deListComp quals list\n    dsLocalBinds binds core_rest\n\ndeListComp (stmt@(TransStmt {}) : quals) list = do\n    (inner_list_expr, pat) <- dsTransStmt stmt\n    deBindComp pat inner_list_expr quals list\n\ndeListComp (BindStmt _ pat list1 _ _ : quals) core_list2 = do -- rule A' above\n    core_list1 <- dsLExprNoLP list1\n    deBindComp pat core_list1 quals core_list2\n\ndeListComp (ParStmt _ stmtss_w_bndrs _ _ : quals) list\n  = do { exps_and_qual_tys <- mapM dsInnerListComp stmtss_w_bndrs\n       ; let (exps, qual_tys) = unzip exps_and_qual_tys\n\n       ; (zip_fn, zip_rhs) <- mkZipBind qual_tys\n\n        -- Deal with [e | pat <- zip l1 .. ln] in example above\n       ; deBindComp pat (Let (Rec [(zip_fn, zip_rhs)]) (mkApps (Var zip_fn) exps))\n                    quals list }\n  where\n        bndrs_s = [bs | ParStmtBlock _ _ bs _ <- stmtss_w_bndrs]\n\n        -- pat is the pattern ((x1,..,xn), (y1,..,ym)) in the example above\n        pat  = mkBigLHsPatTupId pats\n        pats = map mkBigLHsVarPatTupId bndrs_s\n\ndeListComp (RecStmt {} : _) _ = panic \"deListComp RecStmt\"\n\ndeListComp (ApplicativeStmt {} : _) _ =\n  panic \"deListComp ApplicativeStmt\"\n\ndeListComp (XStmtLR {} : _) _ =\n  panic \"deListComp XStmtLR\"\n\ndeBindComp :: OutPat GhcTc\n           -> CoreExpr\n           -> [ExprStmt GhcTc]\n           -> CoreExpr\n           -> DsM (Expr Id)\ndeBindComp pat core_list1 quals core_list2 = do\n    let u3_ty@u1_ty = exprType core_list1       -- two names, same thing\n\n        -- u1_ty is a [alpha] type, and u2_ty = alpha\n    let u2_ty = hsLPatType pat\n\n    let res_ty = exprType core_list2\n        h_ty   = u1_ty `mkVisFunTy` res_ty\n\n       -- no levity polymorphism here, as list comprehensions don't work\n       -- with RebindableSyntax. NB: These are *not* monad comps.\n    [h, u1, u2, u3] <- newSysLocalsDs [h_ty, u1_ty, u2_ty, u3_ty]\n\n    -- the \"fail\" value ...\n    let\n        core_fail   = App (Var h) (Var u3)\n        letrec_body = App (Var h) core_list1\n\n    rest_expr <- deListComp quals core_fail\n    core_match <- matchSimply (Var u2) (StmtCtxt ListComp) pat rest_expr core_fail\n\n    let\n        rhs = Lam u1 $\n              Case (Var u1) u1 res_ty\n                   [(DataAlt nilDataCon,  [],       core_list2),\n                    (DataAlt consDataCon, [u2, u3], core_match)]\n                        -- Increasing order of tag\n\n    return (Let (Rec [(h, rhs)]) letrec_body)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DsListComp-foldr-build]{Foldr/Build desugaring of list comprehensions}\n*                                                                      *\n************************************************************************\n\n@dfListComp@ are the rules used with foldr/build turned on:\n\n\\begin{verbatim}\nTE[ e | ]            c n = c e n\nTE[ e | b , q ]      c n = if b then TE[ e | q ] c n else n\nTE[ e | p <- l , q ] c n = let\n                                f = \\ x b -> case x of\n                                                  p -> TE[ e | q ] c b\n                                                  _ -> b\n                           in\n                           foldr f n l\n\\end{verbatim}\n-}\n\ndfListComp :: Id -> Id            -- 'c' and 'n'\n           -> [ExprStmt GhcTc]    -- the rest of the qual's\n           -> DsM CoreExpr\n\ndfListComp _ _ [] = panic \"dfListComp\"\n\ndfListComp c_id n_id (LastStmt _ body _ _ : quals)\n  = ASSERT( null quals )\n    do { core_body <- dsLExprNoLP body\n       ; return (mkApps (Var c_id) [core_body, Var n_id]) }\n\n        -- Non-last: must be a guard\ndfListComp c_id n_id (BodyStmt _ guard _ _  : quals) = do\n    core_guard <- dsLExpr guard\n    core_rest <- dfListComp c_id n_id quals\n    return (mkIfThenElse core_guard core_rest (Var n_id))\n\ndfListComp c_id n_id (LetStmt _ binds : quals) = do\n    -- new in 1.3, local bindings\n    core_rest <- dfListComp c_id n_id quals\n    dsLocalBinds binds core_rest\n\ndfListComp c_id n_id (stmt@(TransStmt {}) : quals) = do\n    (inner_list_expr, pat) <- dsTransStmt stmt\n    -- Anyway, we bind the newly grouped list via the generic binding function\n    dfBindComp c_id n_id (pat, inner_list_expr) quals\n\ndfListComp c_id n_id (BindStmt _ pat list1 _ _ : quals) = do\n    -- evaluate the two lists\n    core_list1 <- dsLExpr list1\n\n    -- Do the rest of the work in the generic binding builder\n    dfBindComp c_id n_id (pat, core_list1) quals\n\ndfListComp _ _ (ParStmt {} : _) = panic \"dfListComp ParStmt\"\ndfListComp _ _ (RecStmt {} : _) = panic \"dfListComp RecStmt\"\ndfListComp _ _ (ApplicativeStmt {} : _) =\n  panic \"dfListComp ApplicativeStmt\"\ndfListComp _ _ (XStmtLR {} : _) =\n  panic \"dfListComp XStmtLR\"\n\ndfBindComp :: Id -> Id             -- 'c' and 'n'\n           -> (LPat GhcTc, CoreExpr)\n           -> [ExprStmt GhcTc]     -- the rest of the qual's\n           -> DsM CoreExpr\ndfBindComp c_id n_id (pat, core_list1) quals = do\n    -- find the required type\n    let x_ty   = hsLPatType pat\n    let b_ty   = idType n_id\n\n    -- create some new local id's\n    b <- newSysLocalDs b_ty\n    x <- newSysLocalDs x_ty\n\n    -- build rest of the comprehesion\n    core_rest <- dfListComp c_id b quals\n\n    -- build the pattern match\n    core_expr <- matchSimply (Var x) (StmtCtxt ListComp)\n                pat core_rest (Var b)\n\n    -- now build the outermost foldr, and return\n    mkFoldrExpr x_ty b_ty (mkLams [x, b] core_expr) (Var n_id) core_list1\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DsFunGeneration]{Generation of zip/unzip functions for use in desugaring}\n*                                                                      *\n************************************************************************\n-}\n\nmkZipBind :: [Type] -> DsM (Id, CoreExpr)\n-- mkZipBind [t1, t2]\n-- = (zip, \\as1:[t1] as2:[t2]\n--         -> case as1 of\n--              [] -> []\n--              (a1:as'1) -> case as2 of\n--                              [] -> []\n--                              (a2:as'2) -> (a1, a2) : zip as'1 as'2)]\n\nmkZipBind elt_tys = do\n    ass  <- mapM newSysLocalDs  elt_list_tys\n    as'  <- mapM newSysLocalDs  elt_tys\n    as's <- mapM newSysLocalDs  elt_list_tys\n\n    zip_fn <- newSysLocalDs zip_fn_ty\n\n    let inner_rhs = mkConsExpr elt_tuple_ty\n                        (mkBigCoreVarTup as')\n                        (mkVarApps (Var zip_fn) as's)\n        zip_body  = foldr mk_case inner_rhs (zip3 ass as' as's)\n\n    return (zip_fn, mkLams ass zip_body)\n  where\n    elt_list_tys      = map mkListTy elt_tys\n    elt_tuple_ty      = mkBigCoreTupTy elt_tys\n    elt_tuple_list_ty = mkListTy elt_tuple_ty\n\n    zip_fn_ty         = mkVisFunTys elt_list_tys elt_tuple_list_ty\n\n    mk_case (as, a', as') rest\n          = Case (Var as) as elt_tuple_list_ty\n                  [(DataAlt nilDataCon,  [],        mkNilExpr elt_tuple_ty),\n                   (DataAlt consDataCon, [a', as'], rest)]\n                        -- Increasing order of tag\n\n\nmkUnzipBind :: TransForm -> [Type] -> DsM (Maybe (Id, CoreExpr))\n-- mkUnzipBind [t1, t2]\n-- = (unzip, \\ys :: [(t1, t2)] -> foldr (\\ax :: (t1, t2) axs :: ([t1], [t2])\n--     -> case ax of\n--      (x1, x2) -> case axs of\n--                (xs1, xs2) -> (x1 : xs1, x2 : xs2))\n--      ([], [])\n--      ys)\n--\n-- We use foldr here in all cases, even if rules are turned off, because we may as well!\nmkUnzipBind ThenForm _\n = return Nothing    -- No unzipping for ThenForm\nmkUnzipBind _ elt_tys\n  = do { ax  <- newSysLocalDs elt_tuple_ty\n       ; axs <- newSysLocalDs elt_list_tuple_ty\n       ; ys  <- newSysLocalDs elt_tuple_list_ty\n       ; xs  <- mapM newSysLocalDs elt_tys\n       ; xss <- mapM newSysLocalDs elt_list_tys\n\n       ; unzip_fn <- newSysLocalDs unzip_fn_ty\n\n       ; [us1, us2] <- sequence [newUniqueSupply, newUniqueSupply]\n\n       ; let nil_tuple = mkBigCoreTup (map mkNilExpr elt_tys)\n             concat_expressions = map mkConcatExpression (zip3 elt_tys (map Var xs) (map Var xss))\n             tupled_concat_expression = mkBigCoreTup concat_expressions\n\n             folder_body_inner_case = mkTupleCase us1 xss tupled_concat_expression axs (Var axs)\n             folder_body_outer_case = mkTupleCase us2 xs folder_body_inner_case ax (Var ax)\n             folder_body = mkLams [ax, axs] folder_body_outer_case\n\n       ; unzip_body <- mkFoldrExpr elt_tuple_ty elt_list_tuple_ty folder_body nil_tuple (Var ys)\n       ; return (Just (unzip_fn, mkLams [ys] unzip_body)) }\n  where\n    elt_tuple_ty       = mkBigCoreTupTy elt_tys\n    elt_tuple_list_ty  = mkListTy elt_tuple_ty\n    elt_list_tys       = map mkListTy elt_tys\n    elt_list_tuple_ty  = mkBigCoreTupTy elt_list_tys\n\n    unzip_fn_ty        = elt_tuple_list_ty `mkVisFunTy` elt_list_tuple_ty\n\n    mkConcatExpression (list_element_ty, head, tail) = mkConsExpr list_element_ty head tail\n\n-- Translation for monad comprehensions\n\n-- Entry point for monad comprehension desugaring\ndsMonadComp :: [ExprLStmt GhcTc] -> DsM CoreExpr\ndsMonadComp stmts = dsMcStmts stmts\n\ndsMcStmts :: [ExprLStmt GhcTc] -> DsM CoreExpr\ndsMcStmts []                          = panic \"dsMcStmts\"\ndsMcStmts ((dL->L loc stmt) : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts)\n\n---------------\ndsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> DsM CoreExpr\n\ndsMcStmt (LastStmt _ body _ ret_op) stmts\n  = ASSERT( null stmts )\n    do { body' <- dsLExpr body\n       ; dsSyntaxExpr ret_op [body'] }\n\n--   [ .. | let binds, stmts ]\ndsMcStmt (LetStmt _ binds) stmts\n  = do { rest <- dsMcStmts stmts\n       ; dsLocalBinds binds rest }\n\n--   [ .. | a <- m, stmts ]\ndsMcStmt (BindStmt bind_ty pat rhs bind_op fail_op) stmts\n  = do { rhs' <- dsLExpr rhs\n       ; dsMcBindStmt pat rhs' bind_op fail_op bind_ty stmts }\n\n-- Apply `guard` to the `exp` expression\n--\n--   [ .. | exp, stmts ]\n--\ndsMcStmt (BodyStmt _ exp then_exp guard_exp) stmts\n  = do { exp'       <- dsLExpr exp\n       ; rest       <- dsMcStmts stmts\n       ; guard_exp' <- dsSyntaxExpr guard_exp [exp']\n       ; dsSyntaxExpr then_exp [guard_exp', rest] }\n\n-- Group statements desugar like this:\n--\n--   [| (q, then group by e using f); rest |]\n--   --->  f {qt} (\\qv -> e) [| q; return qv |] >>= \\ n_tup ->\n--         case unzip n_tup of qv' -> [| rest |]\n--\n-- where   variables (v1:t1, ..., vk:tk) are bound by q\n--         qv = (v1, ..., vk)\n--         qt = (t1, ..., tk)\n--         (>>=) :: m2 a -> (a -> m3 b) -> m3 b\n--         f :: forall a. (a -> t) -> m1 a -> m2 (n a)\n--         n_tup :: n qt\n--         unzip :: n qt -> (n t1, ..., n tk)    (needs Functor n)\n\ndsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs\n                    , trS_by = by, trS_using = using\n                    , trS_ret = return_op, trS_bind = bind_op\n                    , trS_ext = n_tup_ty'  -- n (a,b,c)\n                    , trS_fmap = fmap_op, trS_form = form }) stmts_rest\n  = do { let (from_bndrs, to_bndrs) = unzip bndrs\n\n       ; let from_bndr_tys = map idType from_bndrs     -- Types ty\n\n\n       -- Desugar an inner comprehension which outputs a list of tuples of the \"from\" binders\n       ; expr' <- dsInnerMonadComp stmts from_bndrs return_op\n\n       -- Work out what arguments should be supplied to that expression: i.e. is an extraction\n       -- function required? If so, create that desugared function and add to arguments\n       ; usingExpr' <- dsLExpr using\n       ; usingArgs' <- case by of\n                         Nothing   -> return [expr']\n                         Just by_e -> do { by_e' <- dsLExpr by_e\n                                         ; lam' <- matchTuple from_bndrs by_e'\n                                         ; return [lam', expr'] }\n\n       -- Generate the expressions to build the grouped list\n       -- Build a pattern that ensures the consumer binds into the NEW binders,\n       -- which hold monads rather than single values\n       ; let tup_n_ty' = mkBigCoreVarTupTy to_bndrs\n\n       ; body        <- dsMcStmts stmts_rest\n       ; n_tup_var'  <- newSysLocalDsNoLP n_tup_ty'\n       ; tup_n_var'  <- newSysLocalDs tup_n_ty'\n       ; tup_n_expr' <- mkMcUnzipM form fmap_op n_tup_var' from_bndr_tys\n       ; us          <- newUniqueSupply\n       ; let rhs'  = mkApps usingExpr' usingArgs'\n             body' = mkTupleCase us to_bndrs body tup_n_var' tup_n_expr'\n\n       ; dsSyntaxExpr bind_op [rhs', Lam n_tup_var' body'] }\n\n-- Parallel statements. Use `Control.Monad.Zip.mzip` to zip parallel\n-- statements, for example:\n--\n--   [ body | qs1 | qs2 | qs3 ]\n--     ->  [ body | (bndrs1, (bndrs2, bndrs3))\n--                     <- [bndrs1 | qs1] `mzip` ([bndrs2 | qs2] `mzip` [bndrs3 | qs3]) ]\n--\n-- where `mzip` has type\n--   mzip :: forall a b. m a -> m b -> m (a,b)\n-- NB: we need a polymorphic mzip because we call it several times\n\ndsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest\n = do  { exps_w_tys  <- mapM ds_inner blocks   -- Pairs (exp :: m ty, ty)\n       ; mzip_op'    <- dsExpr mzip_op\n\n       ; let -- The pattern variables\n             pats = [ mkBigLHsVarPatTupId bs | ParStmtBlock _ _ bs _ <- blocks]\n             -- Pattern with tuples of variables\n             -- [v1,v2,v3]  =>  (v1, (v2, v3))\n             pat = foldr1 (\\p1 p2 -> mkLHsPatTup [p1, p2]) pats\n             (rhs, _) = foldr1 (\\(e1,t1) (e2,t2) ->\n                                 (mkApps mzip_op' [Type t1, Type t2, e1, e2],\n                                  mkBoxedTupleTy [t1,t2]))\n                               exps_w_tys\n\n       ; dsMcBindStmt pat rhs bind_op noSyntaxExpr bind_ty stmts_rest }\n  where\n    ds_inner (ParStmtBlock _ stmts bndrs return_op)\n       = do { exp <- dsInnerMonadComp stmts bndrs return_op\n            ; return (exp, mkBigCoreVarTupTy bndrs) }\n    ds_inner (XParStmtBlock{}) = panic \"dsMcStmt\"\n\ndsMcStmt stmt _ = pprPanic \"dsMcStmt: unexpected stmt\" (ppr stmt)\n\n\nmatchTuple :: [Id] -> CoreExpr -> DsM CoreExpr\n-- (matchTuple [a,b,c] body)\n--       returns the Core term\n--  \\x. case x of (a,b,c) -> body\nmatchTuple ids body\n  = do { us <- newUniqueSupply\n       ; tup_id <- newSysLocalDs (mkBigCoreVarTupTy ids)\n       ; return (Lam tup_id $ mkTupleCase us ids body tup_id (Var tup_id)) }\n\n-- general `rhs' >>= \\pat -> stmts` desugaring where `rhs'` is already a\n-- desugared `CoreExpr`\ndsMcBindStmt :: LPat GhcTc\n             -> CoreExpr        -- ^ the desugared rhs of the bind statement\n             -> SyntaxExpr GhcTc\n             -> SyntaxExpr GhcTc\n             -> Type            -- ^ S in (>>=) :: Q -> (R -> S) -> T\n             -> [ExprLStmt GhcTc]\n             -> DsM CoreExpr\ndsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts\n  = do  { body     <- dsMcStmts stmts\n        ; var      <- selectSimpleMatchVarL pat\n        ; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat\n                                  res1_ty (cantFailMatchResult body)\n        ; match_code <- handle_failure pat match fail_op\n        ; dsSyntaxExpr bind_op [rhs', Lam var match_code] }\n\n  where\n    -- In a monad comprehension expression, pattern-match failure just calls\n    -- the monadic `fail` rather than throwing an exception\n    handle_failure pat match fail_op\n      | matchCanFail match\n        = do { dflags <- getDynFlags\n             ; fail_msg <- mkStringExpr (mk_fail_msg dflags pat)\n             ; fail_expr <- dsSyntaxExpr fail_op [fail_msg]\n             ; extractMatchResult match fail_expr }\n      | otherwise\n        = extractMatchResult match (error \"It can't fail\")\n\n    mk_fail_msg :: HasSrcSpan e => DynFlags -> e -> String\n    mk_fail_msg dflags pat\n        = \"Pattern match failure in monad comprehension at \" ++\n          showPpr dflags (getLoc pat)\n\n-- Desugar nested monad comprehensions, for example in `then..` constructs\n--    dsInnerMonadComp quals [a,b,c] ret_op\n-- returns the desugaring of\n--       [ (a,b,c) | quals ]\n\ndsInnerMonadComp :: [ExprLStmt GhcTc]\n                 -> [Id]               -- Return a tuple of these variables\n                 -> SyntaxExpr GhcTc   -- The monomorphic \"return\" operator\n                 -> DsM CoreExpr\ndsInnerMonadComp stmts bndrs ret_op\n  = dsMcStmts (stmts ++\n                 [noLoc (LastStmt noExt (mkBigLHsVarTupId bndrs) False ret_op)])\n\n\n-- The `unzip` function for `GroupStmt` in a monad comprehensions\n--\n--   unzip :: m (a,b,..) -> (m a,m b,..)\n--   unzip m_tuple = ( liftM selN1 m_tuple\n--                   , liftM selN2 m_tuple\n--                   , .. )\n--\n--   mkMcUnzipM fmap ys [t1, t2]\n--     = ( fmap (selN1 :: (t1, t2) -> t1) ys\n--       , fmap (selN2 :: (t1, t2) -> t2) ys )\n\nmkMcUnzipM :: TransForm\n           -> HsExpr GhcTcId    -- fmap\n           -> Id                -- Of type n (a,b,c)\n           -> [Type]            -- [a,b,c]   (not levity-polymorphic)\n           -> DsM CoreExpr      -- Of type (n a, n b, n c)\nmkMcUnzipM ThenForm _ ys _\n  = return (Var ys) -- No unzipping to do\n\nmkMcUnzipM _ fmap_op ys elt_tys\n  = do { fmap_op' <- dsExpr fmap_op\n       ; xs       <- mapM newSysLocalDs elt_tys\n       ; let tup_ty = mkBigCoreTupTy elt_tys\n       ; tup_xs   <- newSysLocalDs tup_ty\n\n       ; let mk_elt i = mkApps fmap_op'  -- fmap :: forall a b. (a -> b) -> n a -> n b\n                           [ Type tup_ty, Type (getNth elt_tys i)\n                           , mk_sel i, Var ys]\n\n             mk_sel n = Lam tup_xs $\n                        mkTupleSelector xs (getNth xs n) tup_xs (Var tup_xs)\n\n       ; return (mkBigCoreTup (map mk_elt [0..length elt_tys - 1])) }\n", "num_lines": 694}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ViewPatterns #-}\n\n-----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2006\n--\n-- The purpose of this module is to transform an HsExpr into a CoreExpr which\n-- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the\n-- input HsExpr. We do this in the DsM monad, which supplies access to\n-- CoreExpr's of the \"smart constructors\" of the Meta.Exp datatype.\n--\n-- It also defines a bunch of knownKeyNames, in the same way as is done\n-- in prelude/PrelNames.  It's much more convenient to do it here, because\n-- otherwise we have to recompile PrelNames whenever we add a Name, which is\n-- a Royal Pain (triggers other recompilation).\n-----------------------------------------------------------------------------\n\nmodule DsMeta( dsBracket ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   DsExpr ( dsExpr )\n\nimport MatchLit\nimport DsMonad\n\nimport qualified Language.Haskell.TH as TH\n\nimport HsSyn\nimport PrelNames\n-- To avoid clashes with DsMeta.varName we must make a local alias for\n-- OccName.varName we do this by removing varName from the import of\n-- OccName above, making a qualified instance of OccName and using\n-- OccNameAlias.varName where varName ws previously used in this file.\nimport qualified OccName( isDataOcc, isVarOcc, isTcOcc )\n\nimport Module\nimport Id\nimport Name hiding( isVarOcc, isTcOcc, varName, tcName )\nimport THNames\nimport NameEnv\nimport NameSet\nimport TcType\nimport TyCon\nimport TysWiredIn\nimport CoreSyn\nimport MkCore\nimport CoreUtils\nimport SrcLoc\nimport Unique\nimport BasicTypes\nimport Outputable\nimport Bag\nimport DynFlags\nimport FastString\nimport ForeignCall\nimport Util\nimport Maybes\nimport MonadUtils\n\nimport Data.ByteString ( unpack )\nimport Control.Monad\nimport Data.List\n\n-----------------------------------------------------------------------------\ndsBracket :: HsBracket GhcRn -> [PendingTcSplice] -> DsM CoreExpr\n-- Returns a CoreExpr of type TH.ExpQ\n-- The quoted thing is parameterised over Name, even though it has\n-- been type checked.  We don't want all those type decorations!\n\ndsBracket brack splices\n  = dsExtendMetaEnv new_bit (do_brack brack)\n  where\n    new_bit = mkNameEnv [(n, DsSplice (unLoc e))\n                        | PendingTcSplice n e <- splices]\n\n    do_brack (VarBr _ _ n) = do { MkC e1  <- lookupOcc n ; return e1 }\n    do_brack (ExpBr _ e)   = do { MkC e1  <- repLE e     ; return e1 }\n    do_brack (PatBr _ p)   = do { MkC p1  <- repTopP p   ; return p1 }\n    do_brack (TypBr _ t)   = do { MkC t1  <- repLTy t    ; return t1 }\n    do_brack (DecBrG _ gp) = do { MkC ds1 <- repTopDs gp ; return ds1 }\n    do_brack (DecBrL {})   = panic \"dsBracket: unexpected DecBrL\"\n    do_brack (TExpBr _ e)  = do { MkC e1  <- repLE e     ; return e1 }\n    do_brack (XBracket {}) = panic \"dsBracket: unexpected XBracket\"\n\n{- -------------- Examples --------------------\n\n  [| \\x -> x |]\n====>\n  gensym (unpackString \"x\"#) `bindQ` \\ x1::String ->\n  lam (pvar x1) (var x1)\n\n\n  [| \\x -> $(f [| x |]) |]\n====>\n  gensym (unpackString \"x\"#) `bindQ` \\ x1::String ->\n  lam (pvar x1) (f (var x1))\n-}\n\n\n-------------------------------------------------------\n--                      Declarations\n-------------------------------------------------------\n\nrepTopP :: LPat GhcRn -> DsM (Core TH.PatQ)\nrepTopP pat = do { ss <- mkGenSyms (collectPatBinders pat)\n                 ; pat' <- addBinds ss (repLP pat)\n                 ; wrapGenSyms ss pat' }\n\nrepTopDs :: HsGroup GhcRn -> DsM (Core (TH.Q [TH.Dec]))\nrepTopDs group@(HsGroup { hs_valds   = valds\n                        , hs_splcds  = splcds\n                        , hs_tyclds  = tyclds\n                        , hs_derivds = derivds\n                        , hs_fixds   = fixds\n                        , hs_defds   = defds\n                        , hs_fords   = fords\n                        , hs_warnds  = warnds\n                        , hs_annds   = annds\n                        , hs_ruleds  = ruleds\n                        , hs_docs    = docs })\n = do { let { bndrs  = hsScopedTvBinders valds\n                       ++ hsGroupBinders group\n                       ++ hsPatSynSelectors valds\n            ; instds = tyclds >>= group_instds } ;\n        ss <- mkGenSyms bndrs ;\n\n        -- Bind all the names mainly to avoid repeated use of explicit strings.\n        -- Thus we get\n        --      do { t :: String <- genSym \"T\" ;\n        --           return (Data t [] ...more t's... }\n        -- The other important reason is that the output must mention\n        -- only \"T\", not \"Foo:T\" where Foo is the current module\n\n        decls <- addBinds ss (\n                  do { val_ds   <- rep_val_binds valds\n                     ; _        <- mapM no_splice splcds\n                     ; tycl_ds  <- mapM repTyClD (tyClGroupTyClDecls tyclds)\n                     ; role_ds  <- mapM repRoleD (concatMap group_roles tyclds)\n                     ; inst_ds  <- mapM repInstD instds\n                     ; deriv_ds <- mapM repStandaloneDerivD derivds\n                     ; fix_ds   <- mapM repFixD fixds\n                     ; _        <- mapM no_default_decl defds\n                     ; for_ds   <- mapM repForD fords\n                     ; _        <- mapM no_warn (concatMap (wd_warnings . unLoc)\n                                                           warnds)\n                     ; ann_ds   <- mapM repAnnD annds\n                     ; rule_ds  <- mapM repRuleD (concatMap (rds_rules . unLoc)\n                                                            ruleds)\n                     ; _        <- mapM no_doc docs\n\n                        -- more needed\n                     ;  return (de_loc $ sort_by_loc $\n                                val_ds ++ catMaybes tycl_ds ++ role_ds\n                                       ++ (concat fix_ds)\n                                       ++ inst_ds ++ rule_ds ++ for_ds\n                                       ++ ann_ds ++ deriv_ds) }) ;\n\n        decl_ty <- lookupType decQTyConName ;\n        let { core_list = coreList' decl_ty decls } ;\n\n        dec_ty <- lookupType decTyConName ;\n        q_decs  <- repSequenceQ dec_ty core_list ;\n\n        wrapGenSyms ss q_decs\n      }\n  where\n    no_splice (dL->L loc _)\n      = notHandledL loc \"Splices within declaration brackets\" empty\n    no_default_decl (dL->L loc decl)\n      = notHandledL loc \"Default declarations\" (ppr decl)\n    no_warn (dL->L loc (Warning _ thing _))\n      = notHandledL loc \"WARNING and DEPRECATION pragmas\" $\n                    text \"Pragma for declaration of\" <+> ppr thing\n    no_warn _ = panic \"repTopDs\"\n    no_doc (dL->L loc _)\n      = notHandledL loc \"Haddock documentation\" empty\nrepTopDs (XHsGroup _) = panic \"repTopDs\"\n\nhsScopedTvBinders :: HsValBinds GhcRn -> [Name]\n-- See Note [Scoped type variables in bindings]\nhsScopedTvBinders binds\n  = concatMap get_scoped_tvs sigs\n  where\n    sigs = case binds of\n             ValBinds           _ _ sigs  -> sigs\n             XValBindsLR (NValBinds _ sigs) -> sigs\n\nget_scoped_tvs :: LSig GhcRn -> [Name]\nget_scoped_tvs (dL->L _ signature)\n  | TypeSig _ _ sig <- signature\n  = get_scoped_tvs_from_sig (hswc_body sig)\n  | ClassOpSig _ _ _ sig <- signature\n  = get_scoped_tvs_from_sig sig\n  | PatSynSig _ _ sig <- signature\n  = get_scoped_tvs_from_sig sig\n  | otherwise\n  = []\n  where\n    get_scoped_tvs_from_sig sig\n      -- Both implicit and explicit quantified variables\n      -- We need the implicit ones for   f :: forall (a::k). blah\n      --    here 'k' scopes too\n      | HsIB { hsib_ext = implicit_vars\n             , hsib_body = hs_ty } <- sig\n      , (explicit_vars, _) <- splitLHsForAllTy hs_ty\n      = implicit_vars ++ hsLTyVarNames explicit_vars\n    get_scoped_tvs_from_sig (XHsImplicitBndrs _)\n      = panic \"get_scoped_tvs_from_sig\"\n\n{- Notes\n\nNote [Scoped type variables in bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   f :: forall a. a -> a\n   f x = x::a\nHere the 'forall a' brings 'a' into scope over the binding group.\nTo achieve this we\n\n  a) Gensym a binding for 'a' at the same time as we do one for 'f'\n     collecting the relevant binders with hsScopedTvBinders\n\n  b) When processing the 'forall', don't gensym\n\nThe relevant places are signposted with references to this Note\n\nNote [Scoped type variables in class and instance declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nScoped type variables may occur in default methods and default\nsignatures. We need to bring the type variables in 'foralls'\ninto the scope of the method bindings.\n\nConsider\n   class Foo a where\n     foo :: forall (b :: k). a -> Proxy b -> Proxy b\n     foo _ x = (x :: Proxy b)\n\nWe want to ensure that the 'b' in the type signature and the default\nimplementation are the same, so we do the following:\n\n  a) Before desugaring the signature and binding of 'foo', use\n     get_scoped_tvs to collect type variables in 'forall' and\n     create symbols for them.\n  b) Use 'addBinds' to bring these symbols into the scope of the type\n     signatures and bindings.\n  c) Use these symbols to generate Core for the class/instance declaration.\n\nNote that when desugaring the signatures, we lookup the type variables\nfrom the scope rather than recreate symbols for them. See more details\nin \"rep_ty_sig\" and in Trac#14885.\n\nNote [Binders and occurrences]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we desugar [d| data T = MkT |]\nwe want to get\n        Data \"T\" [] [Con \"MkT\" []] []\nand *not*\n        Data \"Foo:T\" [] [Con \"Foo:MkT\" []] []\nThat is, the new data decl should fit into whatever new module it is\nasked to fit in.   We do *not* clone, though; no need for this:\n        Data \"T79\" ....\n\nBut if we see this:\n        data T = MkT\n        foo = reifyDecl T\n\nthen we must desugar to\n        foo = Data \"Foo:T\" [] [Con \"Foo:MkT\" []] []\n\nSo in repTopDs we bring the binders into scope with mkGenSyms and addBinds.\nAnd we use lookupOcc, rather than lookupBinder\nin repTyClD and repC.\n\nNote [Don't quantify implicit type variables in quotes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf you're not careful, it's suprisingly easy to take this quoted declaration:\n\n  [d| idProxy :: forall proxy (b :: k). proxy b -> proxy b\n      idProxy x = x\n    |]\n\nand have Template Haskell turn it into this:\n\n  idProxy :: forall k proxy (b :: k). proxy b -> proxy b\n  idProxy x = x\n\nNotice that we explicitly quantified the variable `k`! The latter declaration\nisn't what the user wrote in the first place.\n\nUsually, the culprit behind these bugs is taking implicitly quantified type\nvariables (often from the hsib_vars field of HsImplicitBinders) and putting\nthem into a `ForallT` or `ForallC`. Doing so caused #13018 and #13123.\n-}\n\n-- represent associated family instances\n--\nrepTyClD :: LTyClDecl GhcRn -> DsM (Maybe (SrcSpan, Core TH.DecQ))\n\nrepTyClD (dL->L loc (FamDecl { tcdFam = fam })) = liftM Just $\n                                                  repFamilyDecl (L loc fam)\n\nrepTyClD (dL->L loc (SynDecl { tcdLName = tc, tcdTyVars = tvs, tcdRhs = rhs }))\n  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]\n       ; dec <- addTyClTyVarBinds tvs $ \\bndrs ->\n                repSynDecl tc1 bndrs rhs\n       ; return (Just (loc, dec)) }\n\nrepTyClD (dL->L loc (DataDecl { tcdLName = tc\n                              , tcdTyVars = tvs\n                              , tcdDataDefn = defn }))\n  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]\n       ; dec <- addTyClTyVarBinds tvs $ \\bndrs ->\n                repDataDefn tc1 (Left bndrs) defn\n       ; return (Just (loc, dec)) }\n\nrepTyClD (dL->L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,\n                             tcdTyVars = tvs, tcdFDs = fds,\n                             tcdSigs = sigs, tcdMeths = meth_binds,\n                             tcdATs = ats, tcdATDefs = atds }))\n  = do { cls1 <- lookupLOcc cls         -- See note [Binders and occurrences]\n       ; dec  <- addTyVarBinds tvs $ \\bndrs ->\n           do { cxt1   <- repLContext cxt\n          -- See Note [Scoped type variables in class and instance declarations]\n              ; (ss, sigs_binds) <- rep_sigs_binds sigs meth_binds\n              ; fds1   <- repLFunDeps fds\n              ; ats1   <- repFamilyDecls ats\n              ; atds1  <- repAssocTyFamDefaults atds\n              ; decls1 <- coreList decQTyConName (ats1 ++ atds1 ++ sigs_binds)\n              ; decls2 <- repClass cxt1 cls1 bndrs fds1 decls1\n              ; wrapGenSyms ss decls2 }\n       ; return $ Just (loc, dec)\n       }\n\nrepTyClD _ = panic \"repTyClD\"\n\n-------------------------\nrepRoleD :: LRoleAnnotDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)\nrepRoleD (dL->L loc (RoleAnnotDecl _ tycon roles))\n  = do { tycon1 <- lookupLOcc tycon\n       ; roles1 <- mapM repRole roles\n       ; roles2 <- coreList roleTyConName roles1\n       ; dec <- repRoleAnnotD tycon1 roles2\n       ; return (loc, dec) }\nrepRoleD _ = panic \"repRoleD\"\n\n-------------------------\nrepDataDefn :: Core TH.Name\n            -> Either (Core [TH.TyVarBndrQ])\n                        -- the repTyClD case\n                      (Core (Maybe [TH.TyVarBndrQ]), Core TH.TypeQ)\n                        -- the repDataFamInstD case\n            -> HsDataDefn GhcRn\n            -> DsM (Core TH.DecQ)\nrepDataDefn tc opts\n          (HsDataDefn { dd_ND = new_or_data, dd_ctxt = cxt, dd_kindSig = ksig\n                      , dd_cons = cons, dd_derivs = mb_derivs })\n  = do { cxt1     <- repLContext cxt\n       ; derivs1  <- repDerivs mb_derivs\n       ; case (new_or_data, cons) of\n           (NewType, [con])  -> do { con'  <- repC con\n                                   ; ksig' <- repMaybeLTy ksig\n                                   ; repNewtype cxt1 tc opts ksig' con'\n                                                derivs1 }\n           (NewType, _) -> failWithDs (text \"Multiple constructors for newtype:\"\n                                       <+> pprQuotedList\n                                       (getConNames $ unLoc $ head cons))\n           (DataType, _) -> do { ksig' <- repMaybeLTy ksig\n                               ; consL <- mapM repC cons\n                               ; cons1 <- coreList conQTyConName consL\n                               ; repData cxt1 tc opts ksig' cons1\n                                         derivs1 }\n       }\nrepDataDefn _ _ (XHsDataDefn _) = panic \"repDataDefn\"\n\nrepSynDecl :: Core TH.Name -> Core [TH.TyVarBndrQ]\n           -> LHsType GhcRn\n           -> DsM (Core TH.DecQ)\nrepSynDecl tc bndrs ty\n  = do { ty1 <- repLTy ty\n       ; repTySyn tc bndrs ty1 }\n\nrepFamilyDecl :: LFamilyDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)\nrepFamilyDecl decl@(dL->L loc (FamilyDecl { fdInfo      = info\n                                          , fdLName     = tc\n                                          , fdTyVars    = tvs\n                                          , fdResultSig = dL->L _ resultSig\n                                          , fdInjectivityAnn = injectivity }))\n  = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]\n       ; let mkHsQTvs :: [LHsTyVarBndr GhcRn] -> LHsQTyVars GhcRn\n             mkHsQTvs tvs = HsQTvs { hsq_ext = HsQTvsRn\n                                                { hsq_implicit = []\n                                                , hsq_dependent = emptyNameSet }\n                                   , hsq_explicit = tvs }\n             resTyVar = case resultSig of\n                     TyVarSig _ bndr -> mkHsQTvs [bndr]\n                     _               -> mkHsQTvs []\n       ; dec <- addTyClTyVarBinds tvs $ \\bndrs ->\n                addTyClTyVarBinds resTyVar $ \\_ ->\n           case info of\n             ClosedTypeFamily Nothing ->\n                 notHandled \"abstract closed type family\" (ppr decl)\n             ClosedTypeFamily (Just eqns) ->\n               do { eqns1  <- mapM (repTyFamEqn . unLoc) eqns\n                  ; eqns2  <- coreList tySynEqnQTyConName eqns1\n                  ; result <- repFamilyResultSig resultSig\n                  ; inj    <- repInjectivityAnn injectivity\n                  ; repClosedFamilyD tc1 bndrs result inj eqns2 }\n             OpenTypeFamily ->\n               do { result <- repFamilyResultSig resultSig\n                  ; inj    <- repInjectivityAnn injectivity\n                  ; repOpenFamilyD tc1 bndrs result inj }\n             DataFamily ->\n               do { kind <- repFamilyResultSigToMaybeKind resultSig\n                  ; repDataFamilyD tc1 bndrs kind }\n       ; return (loc, dec)\n       }\nrepFamilyDecl _ = panic \"repFamilyDecl\"\n\n-- | Represent result signature of a type family\nrepFamilyResultSig :: FamilyResultSig GhcRn -> DsM (Core TH.FamilyResultSigQ)\nrepFamilyResultSig (NoSig _)         = repNoSig\nrepFamilyResultSig (KindSig _ ki)    = do { ki' <- repLTy ki\n                                          ; repKindSig ki' }\nrepFamilyResultSig (TyVarSig _ bndr) = do { bndr' <- repTyVarBndr bndr\n                                          ; repTyVarSig bndr' }\nrepFamilyResultSig (XFamilyResultSig _) = panic \"repFamilyResultSig\"\n\n-- | Represent result signature using a Maybe Kind. Used with data families,\n-- where the result signature can be either missing or a kind but never a named\n-- result variable.\nrepFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn\n                              -> DsM (Core (Maybe TH.KindQ))\nrepFamilyResultSigToMaybeKind (NoSig _) =\n    do { coreNothing kindQTyConName }\nrepFamilyResultSigToMaybeKind (KindSig _ ki) =\n    do { ki' <- repLTy ki\n       ; coreJust kindQTyConName ki' }\nrepFamilyResultSigToMaybeKind _ = panic \"repFamilyResultSigToMaybeKind\"\n\n-- | Represent injectivity annotation of a type family\nrepInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)\n                  -> DsM (Core (Maybe TH.InjectivityAnn))\nrepInjectivityAnn Nothing =\n    do { coreNothing injAnnTyConName }\nrepInjectivityAnn (Just (dL->L _ (InjectivityAnn lhs rhs))) =\n    do { lhs'   <- lookupBinder (unLoc lhs)\n       ; rhs1   <- mapM (lookupBinder . unLoc) rhs\n       ; rhs2   <- coreList nameTyConName rhs1\n       ; injAnn <- rep2 injectivityAnnName [unC lhs', unC rhs2]\n       ; coreJust injAnnTyConName injAnn }\n\nrepFamilyDecls :: [LFamilyDecl GhcRn] -> DsM [Core TH.DecQ]\nrepFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds)\n\nrepAssocTyFamDefaults :: [LTyFamDefltEqn GhcRn] -> DsM [Core TH.DecQ]\nrepAssocTyFamDefaults = mapM rep_deflt\n  where\n     -- very like repTyFamEqn, but different in the details\n    rep_deflt :: LTyFamDefltEqn GhcRn -> DsM (Core TH.DecQ)\n    rep_deflt (dL->L _ (FamEqn { feqn_tycon = tc\n                               , feqn_bndrs = bndrs\n                               , feqn_pats  = tys\n                               , feqn_fixity = fixity\n                               , feqn_rhs   = rhs }))\n      = addTyClTyVarBinds tys $ \\ _ ->\n        do { tc1  <- lookupLOcc tc\n           ; no_bndrs <- ASSERT( isNothing bndrs )\n                         coreNothingList tyVarBndrQTyConName\n           ; tys1 <- repLTys (hsLTyVarBndrsToTypes tys)\n           ; lhs <- case fixity of\n                      Prefix -> do { head_ty <- repNamedTyCon tc1\n                                   ; repTapps head_ty tys1 }\n                      Infix -> do { (t1:t2:args) <- checkTys tys1\n                                  ; head_ty <- repTInfix t1 tc1 t2\n                                  ; repTapps head_ty args }\n           ; rhs1 <- repLTy rhs\n           ; eqn1 <- repTySynEqn no_bndrs lhs rhs1\n           ; repTySynInst eqn1 }\n    rep_deflt _ = panic \"repAssocTyFamDefaults\"\n\n    checkTys :: [Core TH.TypeQ] -> DsM [Core TH.TypeQ]\n    checkTys tys@(_:_:_) = return tys\n    checkTys _ = panic \"repAssocTyFamDefaults:checkTys\"\n\n-------------------------\n-- represent fundeps\n--\nrepLFunDeps :: [LHsFunDep GhcRn] -> DsM (Core [TH.FunDep])\nrepLFunDeps fds = repList funDepTyConName repLFunDep fds\n\nrepLFunDep :: LHsFunDep GhcRn -> DsM (Core TH.FunDep)\nrepLFunDep (dL->L _ (xs, ys))\n   = do xs' <- repList nameTyConName (lookupBinder . unLoc) xs\n        ys' <- repList nameTyConName (lookupBinder . unLoc) ys\n        repFunDep xs' ys'\n\n-- Represent instance declarations\n--\nrepInstD :: LInstDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)\nrepInstD (dL->L loc (TyFamInstD { tfid_inst = fi_decl }))\n  = do { dec <- repTyFamInstD fi_decl\n       ; return (loc, dec) }\nrepInstD (dL->L loc (DataFamInstD { dfid_inst = fi_decl }))\n  = do { dec <- repDataFamInstD fi_decl\n       ; return (loc, dec) }\nrepInstD (dL->L loc (ClsInstD { cid_inst = cls_decl }))\n  = do { dec <- repClsInstD cls_decl\n       ; return (loc, dec) }\nrepInstD _ = panic \"repInstD\"\n\nrepClsInstD :: ClsInstDecl GhcRn -> DsM (Core TH.DecQ)\nrepClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds\n                         , cid_sigs = sigs, cid_tyfam_insts = ats\n                         , cid_datafam_insts = adts\n                         , cid_overlap_mode = overlap\n                         })\n  = addSimpleTyVarBinds tvs $\n            -- We must bring the type variables into scope, so their\n            -- occurrences don't fail, even though the binders don't\n            -- appear in the resulting data structure\n            --\n            -- But we do NOT bring the binders of 'binds' into scope\n            -- because they are properly regarded as occurrences\n            -- For example, the method names should be bound to\n            -- the selector Ids, not to fresh names (Trac #5410)\n            --\n            do { cxt1     <- repLContext cxt\n               ; inst_ty1 <- repLTy inst_ty\n          -- See Note [Scoped type variables in class and instance declarations]\n               ; (ss, sigs_binds) <- rep_sigs_binds sigs binds\n               ; ats1   <- mapM (repTyFamInstD . unLoc) ats\n               ; adts1  <- mapM (repDataFamInstD . unLoc) adts\n               ; decls1 <- coreList decQTyConName (ats1 ++ adts1 ++ sigs_binds)\n               ; rOver  <- repOverlap (fmap unLoc overlap)\n               ; decls2 <- repInst rOver cxt1 inst_ty1 decls1\n               ; wrapGenSyms ss decls2 }\n where\n   (tvs, cxt, inst_ty) = splitLHsInstDeclTy ty\nrepClsInstD (XClsInstDecl _) = panic \"repClsInstD\"\n\nrepStandaloneDerivD :: LDerivDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)\nrepStandaloneDerivD (dL->L loc (DerivDecl { deriv_strategy = strat\n                                          , deriv_type     = ty }))\n  = do { dec <- addSimpleTyVarBinds tvs $\n                do { cxt'     <- repLContext cxt\n                   ; strat'   <- repDerivStrategy strat\n                   ; inst_ty' <- repLTy inst_ty\n                   ; repDeriv strat' cxt' inst_ty' }\n       ; return (loc, dec) }\n  where\n    (tvs, cxt, inst_ty) = splitLHsInstDeclTy (dropWildCards ty)\nrepStandaloneDerivD _ = panic \"repStandaloneDerivD\"\n\nrepTyFamInstD :: TyFamInstDecl GhcRn -> DsM (Core TH.DecQ)\nrepTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })\n  = do { eqn1 <- repTyFamEqn eqn\n       ; repTySynInst eqn1 }\n\nrepTyFamEqn :: TyFamInstEqn GhcRn -> DsM (Core TH.TySynEqnQ)\nrepTyFamEqn (HsIB { hsib_ext = var_names\n                  , hsib_body = FamEqn { feqn_tycon = tc_name\n                                       , feqn_bndrs = mb_bndrs\n                                       , feqn_pats = tys\n                                       , feqn_fixity = fixity\n                                       , feqn_rhs  = rhs }})\n  = do { tc <- lookupLOcc tc_name     -- See note [Binders and occurrences]\n       ; let hs_tvs = HsQTvs { hsq_ext = HsQTvsRn\n                               { hsq_implicit = var_names\n                               , hsq_dependent = emptyNameSet }   -- Yuk\n                             , hsq_explicit = fromMaybe [] mb_bndrs }\n       ; addTyClTyVarBinds hs_tvs $ \\ _ ->\n         do { mb_bndrs1 <- repMaybeList tyVarBndrQTyConName\n                                        repTyVarBndr\n                                        mb_bndrs\n            ; tys1 <- case fixity of\n                        Prefix -> repTyArgs (repNamedTyCon tc) tys\n                        Infix  -> do { (HsValArg t1: HsValArg t2: args) <- checkTys tys\n                                     ; t1' <- repLTy t1\n                                     ; t2'  <- repLTy t2\n                                     ; repTyArgs (repTInfix t1' tc t2') args }\n            ; rhs1 <- repLTy rhs\n            ; repTySynEqn mb_bndrs1 tys1 rhs1 } }\n     where checkTys :: [LHsTypeArg GhcRn] -> DsM [LHsTypeArg GhcRn]\n           checkTys tys@(HsValArg _:HsValArg _:_) = return tys\n           checkTys _ = panic \"repTyFamEqn:checkTys\"\nrepTyFamEqn (XHsImplicitBndrs _) = panic \"repTyFamEqn\"\nrepTyFamEqn (HsIB _ (XFamEqn _)) = panic \"repTyFamEqn\"\n\nrepTyArgs :: DsM (Core TH.TypeQ) -> [LHsTypeArg GhcRn] -> DsM (Core TH.TypeQ)\nrepTyArgs f [] = f\nrepTyArgs f (HsValArg ty : as) = do { f' <- f\n                                    ; ty' <- repLTy ty\n                                    ; repTyArgs (repTapp f' ty') as }\nrepTyArgs f (HsTypeArg _ ki : as) = do { f' <- f\n                                       ; ki' <- repLTy ki\n                                       ; repTyArgs (repTappKind f' ki') as }\nrepTyArgs f (HsArgPar _ : as) = repTyArgs f as\n\nrepDataFamInstD :: DataFamInstDecl GhcRn -> DsM (Core TH.DecQ)\nrepDataFamInstD (DataFamInstDecl { dfid_eqn =\n                  (HsIB { hsib_ext = var_names\n                        , hsib_body = FamEqn { feqn_tycon = tc_name\n                                             , feqn_bndrs = mb_bndrs\n                                             , feqn_pats  = tys\n                                             , feqn_fixity = fixity\n                                             , feqn_rhs   = defn }})})\n  = do { tc <- lookupLOcc tc_name         -- See note [Binders and occurrences]\n       ; let hs_tvs = HsQTvs { hsq_ext = HsQTvsRn\n                                 { hsq_implicit = var_names\n                                 , hsq_dependent = emptyNameSet }   -- Yuk\n                             , hsq_explicit = fromMaybe [] mb_bndrs }\n       ; addTyClTyVarBinds hs_tvs $ \\ _ ->\n         do { mb_bndrs1 <- repMaybeList tyVarBndrQTyConName\n                                        repTyVarBndr\n                                        mb_bndrs\n            ; tys1 <- case fixity of\n                        Prefix -> repTyArgs (repNamedTyCon tc) tys\n                        Infix  -> do { (HsValArg t1: HsValArg t2: args) <- checkTys tys\n                                     ; t1' <- repLTy t1\n                                     ; t2'  <- repLTy t2\n                                     ; repTyArgs (repTInfix t1' tc t2') args }\n            ; repDataDefn tc (Right (mb_bndrs1, tys1)) defn } }\n\n      where checkTys :: [LHsTypeArg GhcRn] -> DsM [LHsTypeArg GhcRn]\n            checkTys tys@(HsValArg _: HsValArg _: _) = return tys\n            checkTys _ = panic \"repDataFamInstD:checkTys\"\n\nrepDataFamInstD (DataFamInstDecl (XHsImplicitBndrs _))\n  = panic \"repDataFamInstD\"\nrepDataFamInstD (DataFamInstDecl (HsIB _ (XFamEqn _)))\n  = panic \"repDataFamInstD\"\n\nrepForD :: Located (ForeignDecl GhcRn) -> DsM (SrcSpan, Core TH.DecQ)\nrepForD (dL->L loc (ForeignImport { fd_name = name, fd_sig_ty = typ\n                                  , fd_fi = CImport (dL->L _ cc)\n                                                    (dL->L _ s) mch cis _ }))\n = do MkC name' <- lookupLOcc name\n      MkC typ' <- repHsSigType typ\n      MkC cc' <- repCCallConv cc\n      MkC s' <- repSafety s\n      cis' <- conv_cimportspec cis\n      MkC str <- coreStringLit (static ++ chStr ++ cis')\n      dec <- rep2 forImpDName [cc', s', str, name', typ']\n      return (loc, dec)\n where\n    conv_cimportspec (CLabel cls)\n      = notHandled \"Foreign label\" (doubleQuotes (ppr cls))\n    conv_cimportspec (CFunction DynamicTarget) = return \"dynamic\"\n    conv_cimportspec (CFunction (StaticTarget _ fs _ True))\n                            = return (unpackFS fs)\n    conv_cimportspec (CFunction (StaticTarget _ _  _ False))\n                            = panic \"conv_cimportspec: values not supported yet\"\n    conv_cimportspec CWrapper = return \"wrapper\"\n    -- these calling conventions do not support headers and the static keyword\n    raw_cconv = cc == PrimCallConv || cc == JavaScriptCallConv\n    static = case cis of\n                 CFunction (StaticTarget _ _ _ _) | not raw_cconv -> \"static \"\n                 _ -> \"\"\n    chStr = case mch of\n            Just (Header _ h) | not raw_cconv -> unpackFS h ++ \" \"\n            _ -> \"\"\nrepForD decl = notHandled \"Foreign declaration\" (ppr decl)\n\nrepCCallConv :: CCallConv -> DsM (Core TH.Callconv)\nrepCCallConv CCallConv          = rep2 cCallName []\nrepCCallConv StdCallConv        = rep2 stdCallName []\nrepCCallConv CApiConv           = rep2 cApiCallName []\nrepCCallConv PrimCallConv       = rep2 primCallName []\nrepCCallConv JavaScriptCallConv = rep2 javaScriptCallName []\n\nrepSafety :: Safety -> DsM (Core TH.Safety)\nrepSafety PlayRisky = rep2 unsafeName []\nrepSafety PlayInterruptible = rep2 interruptibleName []\nrepSafety PlaySafe = rep2 safeName []\n\nrepFixD :: LFixitySig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]\nrepFixD (dL->L loc (FixitySig _ names (Fixity _ prec dir)))\n  = do { MkC prec' <- coreIntLit prec\n       ; let rep_fn = case dir of\n                        InfixL -> infixLDName\n                        InfixR -> infixRDName\n                        InfixN -> infixNDName\n       ; let do_one name\n              = do { MkC name' <- lookupLOcc name\n                   ; dec <- rep2 rep_fn [prec', name']\n                   ; return (loc,dec) }\n       ; mapM do_one names }\nrepFixD _ = panic \"repFixD\"\n\nrepRuleD :: LRuleDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)\nrepRuleD (dL->L loc (HsRule { rd_name = n\n                            , rd_act = act\n                            , rd_tyvs = ty_bndrs\n                            , rd_tmvs = tm_bndrs\n                            , rd_lhs = lhs\n                            , rd_rhs = rhs }))\n  = do { rule <- addHsTyVarBinds (fromMaybe [] ty_bndrs) $ \\ ex_bndrs ->\n         do { let tm_bndr_names = concatMap ruleBndrNames tm_bndrs\n            ; ss <- mkGenSyms tm_bndr_names\n            ; rule <- addBinds ss $\n                      do { ty_bndrs' <- case ty_bndrs of\n                             Nothing -> coreNothingList tyVarBndrQTyConName\n                             Just _  -> coreJustList tyVarBndrQTyConName\n                                          ex_bndrs\n                         ; tm_bndrs' <- repList ruleBndrQTyConName\n                                                repRuleBndr\n                                                tm_bndrs\n                         ; n'   <- coreStringLit $ unpackFS $ snd $ unLoc n\n                         ; act' <- repPhases act\n                         ; lhs' <- repLE lhs\n                         ; rhs' <- repLE rhs\n                         ; repPragRule n' ty_bndrs' tm_bndrs' lhs' rhs' act' }\n           ; wrapGenSyms ss rule  }\n       ; return (loc, rule) }\nrepRuleD _ = panic \"repRuleD\"\n\nruleBndrNames :: LRuleBndr GhcRn -> [Name]\nruleBndrNames (dL->L _ (RuleBndr _ n))      = [unLoc n]\nruleBndrNames (dL->L _ (RuleBndrSig _ n sig))\n  | HsWC { hswc_body = HsIB { hsib_ext = vars }} <- sig\n  = unLoc n : vars\nruleBndrNames (dL->L _ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs _))))\n  = panic \"ruleBndrNames\"\nruleBndrNames (dL->L _ (RuleBndrSig _ _ (XHsWildCardBndrs _)))\n  = panic \"ruleBndrNames\"\nruleBndrNames (dL->L _ (XRuleBndr _)) = panic \"ruleBndrNames\"\nruleBndrNames _ = panic \"ruleBndrNames: Impossible Match\" -- due to #15884\n\nrepRuleBndr :: LRuleBndr GhcRn -> DsM (Core TH.RuleBndrQ)\nrepRuleBndr (dL->L _ (RuleBndr _ n))\n  = do { MkC n' <- lookupLBinder n\n       ; rep2 ruleVarName [n'] }\nrepRuleBndr (dL->L _ (RuleBndrSig _ n sig))\n  = do { MkC n'  <- lookupLBinder n\n       ; MkC ty' <- repLTy (hsSigWcType sig)\n       ; rep2 typedRuleVarName [n', ty'] }\nrepRuleBndr _ = panic \"repRuleBndr\"\n\nrepAnnD :: LAnnDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)\nrepAnnD (dL->L loc (HsAnnotation _ _ ann_prov (dL->L _ exp)))\n  = do { target <- repAnnProv ann_prov\n       ; exp'   <- repE exp\n       ; dec    <- repPragAnn target exp'\n       ; return (loc, dec) }\nrepAnnD _ = panic \"repAnnD\"\n\nrepAnnProv :: AnnProvenance Name -> DsM (Core TH.AnnTarget)\nrepAnnProv (ValueAnnProvenance (dL->L _ n))\n  = do { MkC n' <- globalVar n  -- ANNs are allowed only at top-level\n       ; rep2 valueAnnotationName [ n' ] }\nrepAnnProv (TypeAnnProvenance (dL->L _ n))\n  = do { MkC n' <- globalVar n\n       ; rep2 typeAnnotationName [ n' ] }\nrepAnnProv ModuleAnnProvenance\n  = rep2 moduleAnnotationName []\n\n-------------------------------------------------------\n--                      Constructors\n-------------------------------------------------------\n\nrepC :: LConDecl GhcRn -> DsM (Core TH.ConQ)\nrepC (dL->L _ (ConDeclH98 { con_name   = con\n                          , con_forall = (dL->L _ False)\n                          , con_mb_cxt = Nothing\n                          , con_args   = args }))\n  = repDataCon con args\n\nrepC (dL->L _ (ConDeclH98 { con_name = con\n                          , con_forall = (dL->L _ is_existential)\n                          , con_ex_tvs = con_tvs\n                          , con_mb_cxt = mcxt\n                          , con_args = args }))\n  = do { addHsTyVarBinds con_tvs $ \\ ex_bndrs ->\n         do { c'    <- repDataCon con args\n            ; ctxt' <- repMbContext mcxt\n            ; if not is_existential && isNothing mcxt\n              then return c'\n              else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c'])\n            }\n       }\n\nrepC (dL->L _ (ConDeclGADT { con_names  = cons\n                           , con_qvars  = qtvs\n                           , con_mb_cxt = mcxt\n                           , con_args   = args\n                           , con_res_ty = res_ty }))\n  | isEmptyLHsQTvs qtvs  -- No implicit or explicit variables\n  , Nothing <- mcxt      -- No context\n                         -- ==> no need for a forall\n  = repGadtDataCons cons args res_ty\n\n  | otherwise\n  = addTyVarBinds qtvs $ \\ ex_bndrs ->\n             -- See Note [Don't quantify implicit type variables in quotes]\n    do { c'    <- repGadtDataCons cons args res_ty\n       ; ctxt' <- repMbContext mcxt\n       ; if null (hsQTvExplicit qtvs) && isNothing mcxt\n         then return c'\n         else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c']) }\n\nrepC _ = panic \"repC\"\n\n\nrepMbContext :: Maybe (LHsContext GhcRn) -> DsM (Core TH.CxtQ)\nrepMbContext Nothing          = repContext []\nrepMbContext (Just (dL->L _ cxt)) = repContext cxt\n\nrepSrcUnpackedness :: SrcUnpackedness -> DsM (Core TH.SourceUnpackednessQ)\nrepSrcUnpackedness SrcUnpack   = rep2 sourceUnpackName         []\nrepSrcUnpackedness SrcNoUnpack = rep2 sourceNoUnpackName       []\nrepSrcUnpackedness NoSrcUnpack = rep2 noSourceUnpackednessName []\n\nrepSrcStrictness :: SrcStrictness -> DsM (Core TH.SourceStrictnessQ)\nrepSrcStrictness SrcLazy     = rep2 sourceLazyName         []\nrepSrcStrictness SrcStrict   = rep2 sourceStrictName       []\nrepSrcStrictness NoSrcStrict = rep2 noSourceStrictnessName []\n\nrepBangTy :: LBangType GhcRn -> DsM (Core (TH.BangTypeQ))\nrepBangTy ty = do\n  MkC u <- repSrcUnpackedness su'\n  MkC s <- repSrcStrictness ss'\n  MkC b <- rep2 bangName [u, s]\n  MkC t <- repLTy ty'\n  rep2 bangTypeName [b, t]\n  where\n    (su', ss', ty') = case unLoc ty of\n            HsBangTy _ (HsSrcBang _ su ss) ty -> (su, ss, ty)\n            _ -> (NoSrcUnpack, NoSrcStrict, ty)\n\n-------------------------------------------------------\n--                      Deriving clauses\n-------------------------------------------------------\n\nrepDerivs :: HsDeriving GhcRn -> DsM (Core [TH.DerivClauseQ])\nrepDerivs (dL->L _ clauses)\n  = repList derivClauseQTyConName repDerivClause clauses\n\nrepDerivClause :: LHsDerivingClause GhcRn\n               -> DsM (Core TH.DerivClauseQ)\nrepDerivClause (dL->L _ (HsDerivingClause\n                          { deriv_clause_strategy = dcs\n                          , deriv_clause_tys      = (dL->L _ dct) }))\n  = do MkC dcs' <- repDerivStrategy dcs\n       MkC dct' <- repList typeQTyConName (rep_deriv_ty . hsSigType) dct\n       rep2 derivClauseName [dcs',dct']\n  where\n    rep_deriv_ty :: LHsType GhcRn -> DsM (Core TH.TypeQ)\n    rep_deriv_ty ty = repLTy ty\nrepDerivClause _ = panic \"repDerivClause\"\n\nrep_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn\n               -> DsM ([GenSymBind], [Core TH.DecQ])\n-- Represent signatures and methods in class/instance declarations.\n-- See Note [Scoped type variables in class and instance declarations]\n--\n-- Why not use 'repBinds': we have already created symbols for methods in\n-- 'repTopDs' via 'hsGroupBinders'. However in 'repBinds', we recreate\n-- these fun_id via 'collectHsValBinders decs', which would lead to the\n-- instance declarations failing in TH.\nrep_sigs_binds sigs binds\n  = do { let tvs = concatMap get_scoped_tvs sigs\n       ; ss <- mkGenSyms tvs\n       ; sigs1 <- addBinds ss $ rep_sigs sigs\n       ; binds1 <- addBinds ss $ rep_binds binds\n       ; return (ss, de_loc (sort_by_loc (sigs1 ++ binds1))) }\n\n-------------------------------------------------------\n--   Signatures in a class decl, or a group of bindings\n-------------------------------------------------------\n\nrep_sigs :: [LSig GhcRn] -> DsM [(SrcSpan, Core TH.DecQ)]\n        -- We silently ignore ones we don't recognise\nrep_sigs = concatMapM rep_sig\n\nrep_sig :: LSig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]\nrep_sig (dL->L loc (TypeSig _ nms ty))\n  = mapM (rep_wc_ty_sig sigDName loc ty) nms\nrep_sig (dL->L loc (PatSynSig _ nms ty))\n  = mapM (rep_patsyn_ty_sig loc ty) nms\nrep_sig (dL->L loc (ClassOpSig _ is_deflt nms ty))\n  | is_deflt     = mapM (rep_ty_sig defaultSigDName loc ty) nms\n  | otherwise    = mapM (rep_ty_sig sigDName loc ty) nms\nrep_sig d@(dL->L _ (IdSig {}))           = pprPanic \"rep_sig IdSig\" (ppr d)\nrep_sig (dL->L _   (FixSig {}))          = return [] -- fixity sigs at top level\nrep_sig (dL->L loc (InlineSig _ nm ispec))= rep_inline nm ispec loc\nrep_sig (dL->L loc (SpecSig _ nm tys ispec))\n  = concatMapM (\\t -> rep_specialise nm t ispec loc) tys\nrep_sig (dL->L loc (SpecInstSig _ _ ty))  = rep_specialiseInst ty loc\nrep_sig (dL->L _   (MinimalSig {}))       = notHandled \"MINIMAL pragmas\" empty\nrep_sig (dL->L _   (SCCFunSig {}))        = notHandled \"SCC pragmas\" empty\nrep_sig (dL->L loc (CompleteMatchSig _ _st cls mty))\n  = rep_complete_sig cls mty loc\nrep_sig _ = panic \"rep_sig\"\n\nrep_ty_sig :: Name -> SrcSpan -> LHsSigType GhcRn -> Located Name\n           -> DsM (SrcSpan, Core TH.DecQ)\n-- Don't create the implicit and explicit variables when desugaring signatures,\n-- see Note [Scoped type variables in class and instance declarations].\n-- and Note [Don't quantify implicit type variables in quotes]\nrep_ty_sig mk_sig loc sig_ty nm\n  | HsIB { hsib_body = hs_ty } <- sig_ty\n  , (explicit_tvs, ctxt, ty) <- splitLHsSigmaTy hs_ty\n  = do { nm1 <- lookupLOcc nm\n       ; let rep_in_scope_tv tv = do { name <- lookupBinder (hsLTyVarName tv)\n                                     ; repTyVarBndrWithKind tv name }\n       ; th_explicit_tvs <- repList tyVarBndrQTyConName rep_in_scope_tv\n                                    explicit_tvs\n\n         -- NB: Don't pass any implicit type variables to repList above\n         -- See Note [Don't quantify implicit type variables in quotes]\n\n       ; th_ctxt <- repLContext ctxt\n       ; th_ty   <- repLTy ty\n       ; ty1     <- if null explicit_tvs && null (unLoc ctxt)\n                       then return th_ty\n                       else repTForall th_explicit_tvs th_ctxt th_ty\n       ; sig     <- repProto mk_sig nm1 ty1\n       ; return (loc, sig) }\nrep_ty_sig _ _ (XHsImplicitBndrs _) _ = panic \"rep_ty_sig\"\n\nrep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name\n                  -> DsM (SrcSpan, Core TH.DecQ)\n-- represents a pattern synonym type signature;\n-- see Note [Pattern synonym type signatures and Template Haskell] in Convert\n--\n-- Don't create the implicit and explicit variables when desugaring signatures,\n-- see Note [Scoped type variables in class and instance declarations]\n-- and Note [Don't quantify implicit type variables in quotes]\nrep_patsyn_ty_sig loc sig_ty nm\n  | HsIB { hsib_body = hs_ty } <- sig_ty\n  , (univs, reqs, exis, provs, ty) <- splitLHsPatSynTy hs_ty\n  = do { nm1 <- lookupLOcc nm\n       ; let rep_in_scope_tv tv = do { name <- lookupBinder (hsLTyVarName tv)\n                                     ; repTyVarBndrWithKind tv name }\n       ; th_univs <- repList tyVarBndrQTyConName rep_in_scope_tv univs\n       ; th_exis  <- repList tyVarBndrQTyConName rep_in_scope_tv exis\n\n         -- NB: Don't pass any implicit type variables to repList above\n         -- See Note [Don't quantify implicit type variables in quotes]\n\n       ; th_reqs  <- repLContext reqs\n       ; th_provs <- repLContext provs\n       ; th_ty    <- repLTy ty\n       ; ty1      <- repTForall th_univs th_reqs =<<\n                       repTForall th_exis th_provs th_ty\n       ; sig      <- repProto patSynSigDName nm1 ty1\n       ; return (loc, sig) }\nrep_patsyn_ty_sig _ (XHsImplicitBndrs _) _ = panic \"rep_patsyn_ty_sig\"\n\nrep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name\n              -> DsM (SrcSpan, Core TH.DecQ)\nrep_wc_ty_sig mk_sig loc sig_ty nm\n  = rep_ty_sig mk_sig loc (hswc_body sig_ty) nm\n\nrep_inline :: Located Name\n           -> InlinePragma      -- Never defaultInlinePragma\n           -> SrcSpan\n           -> DsM [(SrcSpan, Core TH.DecQ)]\nrep_inline nm ispec loc\n  = do { nm1    <- lookupLOcc nm\n       ; inline <- repInline $ inl_inline ispec\n       ; rm     <- repRuleMatch $ inl_rule ispec\n       ; phases <- repPhases $ inl_act ispec\n       ; pragma <- repPragInl nm1 inline rm phases\n       ; return [(loc, pragma)]\n       }\n\nrep_specialise :: Located Name -> LHsSigType GhcRn -> InlinePragma\n               -> SrcSpan\n               -> DsM [(SrcSpan, Core TH.DecQ)]\nrep_specialise nm ty ispec loc\n  = do { nm1 <- lookupLOcc nm\n       ; ty1 <- repHsSigType ty\n       ; phases <- repPhases $ inl_act ispec\n       ; let inline = inl_inline ispec\n       ; pragma <- if noUserInlineSpec inline\n                   then -- SPECIALISE\n                     repPragSpec nm1 ty1 phases\n                   else -- SPECIALISE INLINE\n                     do { inline1 <- repInline inline\n                        ; repPragSpecInl nm1 ty1 inline1 phases }\n       ; return [(loc, pragma)]\n       }\n\nrep_specialiseInst :: LHsSigType GhcRn -> SrcSpan\n                   -> DsM [(SrcSpan, Core TH.DecQ)]\nrep_specialiseInst ty loc\n  = do { ty1    <- repHsSigType ty\n       ; pragma <- repPragSpecInst ty1\n       ; return [(loc, pragma)] }\n\nrepInline :: InlineSpec -> DsM (Core TH.Inline)\nrepInline NoInline  = dataCon noInlineDataConName\nrepInline Inline    = dataCon inlineDataConName\nrepInline Inlinable = dataCon inlinableDataConName\nrepInline spec      = notHandled \"repInline\" (ppr spec)\n\nrepRuleMatch :: RuleMatchInfo -> DsM (Core TH.RuleMatch)\nrepRuleMatch ConLike = dataCon conLikeDataConName\nrepRuleMatch FunLike = dataCon funLikeDataConName\n\nrepPhases :: Activation -> DsM (Core TH.Phases)\nrepPhases (ActiveBefore _ i) = do { MkC arg <- coreIntLit i\n                                  ; dataCon' beforePhaseDataConName [arg] }\nrepPhases (ActiveAfter _ i)  = do { MkC arg <- coreIntLit i\n                                  ; dataCon' fromPhaseDataConName [arg] }\nrepPhases _                  = dataCon allPhasesDataConName\n\nrep_complete_sig :: Located [Located Name]\n                 -> Maybe (Located Name)\n                 -> SrcSpan\n                 -> DsM [(SrcSpan, Core TH.DecQ)]\nrep_complete_sig (dL->L _ cls) mty loc\n  = do { mty' <- repMaybe nameTyConName lookupLOcc mty\n       ; cls' <- repList nameTyConName lookupLOcc cls\n       ; sig <- repPragComplete cls' mty'\n       ; return [(loc, sig)] }\n\n-------------------------------------------------------\n--                      Types\n-------------------------------------------------------\n\naddSimpleTyVarBinds :: [Name]                -- the binders to be added\n                    -> DsM (Core (TH.Q a))   -- action in the ext env\n                    -> DsM (Core (TH.Q a))\naddSimpleTyVarBinds names thing_inside\n  = do { fresh_names <- mkGenSyms names\n       ; term <- addBinds fresh_names thing_inside\n       ; wrapGenSyms fresh_names term }\n\naddHsTyVarBinds :: [LHsTyVarBndr GhcRn]  -- the binders to be added\n                -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))  -- action in the ext env\n                -> DsM (Core (TH.Q a))\naddHsTyVarBinds exp_tvs thing_inside\n  = do { fresh_exp_names <- mkGenSyms (hsLTyVarNames exp_tvs)\n       ; term <- addBinds fresh_exp_names $\n                 do { kbs <- repList tyVarBndrQTyConName mk_tv_bndr\n                                     (exp_tvs `zip` fresh_exp_names)\n                    ; thing_inside kbs }\n       ; wrapGenSyms fresh_exp_names term }\n  where\n    mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)\n\naddTyVarBinds :: LHsQTyVars GhcRn                    -- the binders to be added\n              -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))  -- action in the ext env\n              -> DsM (Core (TH.Q a))\n-- gensym a list of type variables and enter them into the meta environment;\n-- the computations passed as the second argument is executed in that extended\n-- meta environment and gets the *new* names on Core-level as an argument\naddTyVarBinds (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = imp_tvs}\n                      , hsq_explicit = exp_tvs })\n              thing_inside\n  = addSimpleTyVarBinds imp_tvs $\n    addHsTyVarBinds exp_tvs $\n    thing_inside\naddTyVarBinds (XLHsQTyVars _) _ = panic \"addTyVarBinds\"\n\naddTyClTyVarBinds :: LHsQTyVars GhcRn\n                  -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))\n                  -> DsM (Core (TH.Q a))\n\n-- Used for data/newtype declarations, and family instances,\n-- so that the nested type variables work right\n--    instance C (T a) where\n--      type W (T a) = blah\n-- The 'a' in the type instance is the one bound by the instance decl\naddTyClTyVarBinds tvs m\n  = do { let tv_names = hsAllLTyVarNames tvs\n       ; env <- dsGetMetaEnv\n       ; freshNames <- mkGenSyms (filterOut (`elemNameEnv` env) tv_names)\n            -- Make fresh names for the ones that are not already in scope\n            -- This makes things work for family declarations\n\n       ; term <- addBinds freshNames $\n                 do { kbs <- repList tyVarBndrQTyConName mk_tv_bndr\n                                     (hsQTvExplicit tvs)\n                    ; m kbs }\n\n       ; wrapGenSyms freshNames term }\n  where\n    mk_tv_bndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndrQ)\n    mk_tv_bndr tv = do { v <- lookupBinder (hsLTyVarName tv)\n                       ; repTyVarBndrWithKind tv v }\n\n-- Produce kinded binder constructors from the Haskell tyvar binders\n--\nrepTyVarBndrWithKind :: LHsTyVarBndr GhcRn\n                     -> Core TH.Name -> DsM (Core TH.TyVarBndrQ)\nrepTyVarBndrWithKind (dL->L _ (UserTyVar _ _)) nm\n  = repPlainTV nm\nrepTyVarBndrWithKind (dL->L _ (KindedTyVar _ _ ki)) nm\n  = repLTy ki >>= repKindedTV nm\nrepTyVarBndrWithKind _ _ = panic \"repTyVarBndrWithKind\"\n\n-- | Represent a type variable binder\nrepTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndrQ)\nrepTyVarBndr (dL->L _ (UserTyVar _ (dL->L _ nm)) )\n  = do { nm' <- lookupBinder nm\n       ; repPlainTV nm' }\nrepTyVarBndr (dL->L _ (KindedTyVar _ (dL->L _ nm) ki))\n  = do { nm' <- lookupBinder nm\n       ; ki' <- repLTy ki\n       ; repKindedTV nm' ki' }\nrepTyVarBndr _ = panic \"repTyVarBndr\"\n\n-- represent a type context\n--\nrepLContext :: LHsContext GhcRn -> DsM (Core TH.CxtQ)\nrepLContext ctxt = repContext (unLoc ctxt)\n\nrepContext :: HsContext GhcRn -> DsM (Core TH.CxtQ)\nrepContext ctxt = do preds <- repList typeQTyConName repLTy ctxt\n                     repCtxt preds\n\nrepHsSigType :: LHsSigType GhcRn -> DsM (Core TH.TypeQ)\nrepHsSigType (HsIB { hsib_ext = implicit_tvs\n                   , hsib_body = body })\n  | (explicit_tvs, ctxt, ty) <- splitLHsSigmaTy body\n  = addSimpleTyVarBinds implicit_tvs $\n      -- See Note [Don't quantify implicit type variables in quotes]\n    addHsTyVarBinds explicit_tvs $ \\ th_explicit_tvs ->\n    do { th_ctxt <- repLContext ctxt\n       ; th_ty   <- repLTy ty\n       ; if null explicit_tvs && null (unLoc ctxt)\n         then return th_ty\n         else repTForall th_explicit_tvs th_ctxt th_ty }\nrepHsSigType (XHsImplicitBndrs _) = panic \"repHsSigType\"\n\nrepHsSigWcType :: LHsSigWcType GhcRn -> DsM (Core TH.TypeQ)\nrepHsSigWcType (HsWC { hswc_body = sig1 })\n  = repHsSigType sig1\nrepHsSigWcType (XHsWildCardBndrs _) = panic \"repHsSigWcType\"\n\n-- yield the representation of a list of types\nrepLTys :: [LHsType GhcRn] -> DsM [Core TH.TypeQ]\nrepLTys tys = mapM repLTy tys\n\n-- represent a type\nrepLTy :: LHsType GhcRn -> DsM (Core TH.TypeQ)\nrepLTy ty = repTy (unLoc ty)\n\nrepForall :: ForallVisFlag -> HsType GhcRn -> DsM (Core TH.TypeQ)\n-- Arg of repForall is always HsForAllTy or HsQualTy\nrepForall fvf ty\n | (tvs, ctxt, tau) <- splitLHsSigmaTy (noLoc ty)\n = addHsTyVarBinds tvs $ \\bndrs ->\n   do { ctxt1  <- repLContext ctxt\n      ; ty1    <- repLTy tau\n      ; case fvf of\n          ForallVis   -> repTForallVis bndrs ty1    -- forall a      -> {...}\n          ForallInvis -> repTForall bndrs ctxt1 ty1 -- forall a. C a => {...}\n      }\n\nrepTy :: HsType GhcRn -> DsM (Core TH.TypeQ)\nrepTy ty@(HsForAllTy {hst_fvf = fvf}) = repForall fvf         ty\nrepTy ty@(HsQualTy {})                = repForall ForallInvis ty\n\nrepTy (HsTyVar _ _ (dL->L _ n))\n  | isLiftedTypeKindTyConName n       = repTStar\n  | n `hasKey` constraintKindTyConKey = repTConstraint\n  | n `hasKey` funTyConKey            = repArrowTyCon\n  | isTvOcc occ   = do tv1 <- lookupOcc n\n                       repTvar tv1\n  | isDataOcc occ = do tc1 <- lookupOcc n\n                       repPromotedDataCon tc1\n  | n == eqTyConName = repTequality\n  | otherwise     = do tc1 <- lookupOcc n\n                       repNamedTyCon tc1\n  where\n    occ = nameOccName n\n\nrepTy (HsAppTy _ f a)       = do\n                                f1 <- repLTy f\n                                a1 <- repLTy a\n                                repTapp f1 a1\nrepTy (HsAppKindTy _ ty ki) = do\n                                ty1 <- repLTy ty\n                                ki1 <- repLTy ki\n                                repTappKind ty1 ki1\nrepTy (HsFunTy _ f a)       = do\n                                f1   <- repLTy f\n                                a1   <- repLTy a\n                                tcon <- repArrowTyCon\n                                repTapps tcon [f1, a1]\nrepTy (HsListTy _ t)        = do\n                                t1   <- repLTy t\n                                tcon <- repListTyCon\n                                repTapp tcon t1\nrepTy (HsTupleTy _ HsUnboxedTuple tys) = do\n                                tys1 <- repLTys tys\n                                tcon <- repUnboxedTupleTyCon (length tys)\n                                repTapps tcon tys1\nrepTy (HsTupleTy _ _ tys)   = do tys1 <- repLTys tys\n                                 tcon <- repTupleTyCon (length tys)\n                                 repTapps tcon tys1\nrepTy (HsSumTy _ tys)       = do tys1 <- repLTys tys\n                                 tcon <- repUnboxedSumTyCon (length tys)\n                                 repTapps tcon tys1\nrepTy (HsOpTy _ ty1 n ty2)  = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)\n                                   `nlHsAppTy` ty2)\nrepTy (HsParTy _ t)         = repLTy t\nrepTy (HsStarTy _ _) =  repTStar\nrepTy (HsKindSig _ t k)     = do\n                                t1 <- repLTy t\n                                k1 <- repLTy k\n                                repTSig t1 k1\nrepTy (HsSpliceTy _ splice)      = repSplice splice\nrepTy (HsExplicitListTy _ _ tys) = do\n                                    tys1 <- repLTys tys\n                                    repTPromotedList tys1\nrepTy (HsExplicitTupleTy _ tys) = do\n                                    tys1 <- repLTys tys\n                                    tcon <- repPromotedTupleTyCon (length tys)\n                                    repTapps tcon tys1\nrepTy (HsTyLit _ lit) = do\n                          lit' <- repTyLit lit\n                          repTLit lit'\nrepTy (HsWildCardTy _) = repTWildCard\nrepTy (HsIParamTy _ n t) = do\n                             n' <- rep_implicit_param_name (unLoc n)\n                             t' <- repLTy t\n                             repTImplicitParam n' t'\n\nrepTy ty                      = notHandled \"Exotic form of type\" (ppr ty)\n\nrepTyLit :: HsTyLit -> DsM (Core TH.TyLitQ)\nrepTyLit (HsNumTy _ i) = do iExpr <- mkIntegerExpr i\n                            rep2 numTyLitName [iExpr]\nrepTyLit (HsStrTy _ s) = do { s' <- mkStringExprFS s\n                            ; rep2 strTyLitName [s']\n                            }\n\n-- | Represent a type wrapped in a Maybe\nrepMaybeLTy :: Maybe (LHsKind GhcRn)\n            -> DsM (Core (Maybe TH.TypeQ))\nrepMaybeLTy = repMaybe kindQTyConName repLTy\n\nrepRole :: Located (Maybe Role) -> DsM (Core TH.Role)\nrepRole (dL->L _ (Just Nominal))          = rep2 nominalRName []\nrepRole (dL->L _ (Just Representational)) = rep2 representationalRName []\nrepRole (dL->L _ (Just Phantom))          = rep2 phantomRName []\nrepRole (dL->L _ Nothing)                 = rep2 inferRName []\nrepRole _ = panic \"repRole: Impossible Match\" -- due to #15884\n\n-----------------------------------------------------------------------------\n--              Splices\n-----------------------------------------------------------------------------\n\nrepSplice :: HsSplice GhcRn -> DsM (Core a)\n-- See Note [How brackets and nested splices are handled] in TcSplice\n-- We return a CoreExpr of any old type; the context should know\nrepSplice (HsTypedSplice   _ _ n _) = rep_splice n\nrepSplice (HsUntypedSplice _ _ n _) = rep_splice n\nrepSplice (HsQuasiQuote _ n _ _ _)  = rep_splice n\nrepSplice e@(HsSpliced {})          = pprPanic \"repSplice\" (ppr e)\nrepSplice e@(HsSplicedT {})         = pprPanic \"repSpliceT\" (ppr e)\nrepSplice e@(XSplice {})            = pprPanic \"repSplice\" (ppr e)\n\nrep_splice :: Name -> DsM (Core a)\nrep_splice splice_name\n = do { mb_val <- dsLookupMetaEnv splice_name\n       ; case mb_val of\n           Just (DsSplice e) -> do { e' <- dsExpr e\n                                   ; return (MkC e') }\n           _ -> pprPanic \"HsSplice\" (ppr splice_name) }\n                        -- Should not happen; statically checked\n\n-----------------------------------------------------------------------------\n--              Expressions\n-----------------------------------------------------------------------------\n\nrepLEs :: [LHsExpr GhcRn] -> DsM (Core [TH.ExpQ])\nrepLEs es = repList expQTyConName repLE es\n\n-- FIXME: some of these panics should be converted into proper error messages\n--        unless we can make sure that constructs, which are plainly not\n--        supported in TH already lead to error messages at an earlier stage\nrepLE :: LHsExpr GhcRn -> DsM (Core TH.ExpQ)\nrepLE (dL->L loc e) = putSrcSpanDs loc (repE e)\n\nrepE :: HsExpr GhcRn -> DsM (Core TH.ExpQ)\nrepE (HsVar _ (dL->L _ x)) =\n  do { mb_val <- dsLookupMetaEnv x\n     ; case mb_val of\n        Nothing            -> do { str <- globalVar x\n                                 ; repVarOrCon x str }\n        Just (DsBound y)   -> repVarOrCon x (coreVar y)\n        Just (DsSplice e)  -> do { e' <- dsExpr e\n                                 ; return (MkC e') } }\nrepE (HsIPVar _ n) = rep_implicit_param_name n >>= repImplicitParamVar\nrepE (HsOverLabel _ _ s) = repOverLabel s\n\nrepE e@(HsRecFld _ f) = case f of\n  Unambiguous x _ -> repE (HsVar noExt (noLoc x))\n  Ambiguous{}     -> notHandled \"Ambiguous record selectors\" (ppr e)\n  XAmbiguousFieldOcc{} -> notHandled \"XAmbiguous record selectors\" (ppr e)\n\n        -- Remember, we're desugaring renamer output here, so\n        -- HsOverlit can definitely occur\nrepE (HsOverLit _ l) = do { a <- repOverloadedLiteral l; repLit a }\nrepE (HsLit _ l)     = do { a <- repLiteral l;           repLit a }\nrepE (HsLam _ (MG { mg_alts = (dL->L _ [m]) })) = repLambda m\nrepE (HsLamCase _ (MG { mg_alts = (dL->L _ ms) }))\n                   = do { ms' <- mapM repMatchTup ms\n                        ; core_ms <- coreList matchQTyConName ms'\n                        ; repLamCase core_ms }\nrepE (HsApp _ x y)   = do {a <- repLE x; b <- repLE y; repApp a b}\nrepE (HsAppType _ e t) = do { a <- repLE e\n                            ; s <- repLTy (hswc_body t)\n                            ; repAppType a s }\n\nrepE (OpApp _ e1 op e2) =\n  do { arg1 <- repLE e1;\n       arg2 <- repLE e2;\n       the_op <- repLE op ;\n       repInfixApp arg1 the_op arg2 }\nrepE (NegApp _ x _)      = do\n                              a         <- repLE x\n                              negateVar <- lookupOcc negateName >>= repVar\n                              negateVar `repApp` a\nrepE (HsPar _ x)            = repLE x\nrepE (SectionL _ x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b }\nrepE (SectionR _ x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b }\nrepE (HsCase _ e (MG { mg_alts = (dL->L _ ms) }))\n                          = do { arg <- repLE e\n                               ; ms2 <- mapM repMatchTup ms\n                               ; core_ms2 <- coreList matchQTyConName ms2\n                               ; repCaseE arg core_ms2 }\nrepE (HsIf _ _ x y z)       = do\n                              a <- repLE x\n                              b <- repLE y\n                              c <- repLE z\n                              repCond a b c\nrepE (HsMultiIf _ alts)\n  = do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts\n       ; expr' <- repMultiIf (nonEmptyCoreList alts')\n       ; wrapGenSyms (concat binds) expr' }\nrepE (HsLet _ (dL->L _ bs) e)       = do { (ss,ds) <- repBinds bs\n                                     ; e2 <- addBinds ss (repLE e)\n                                     ; z <- repLetE ds e2\n                                     ; wrapGenSyms ss z }\n\n-- FIXME: I haven't got the types here right yet\nrepE e@(HsDo _ ctxt (dL->L _ sts))\n | case ctxt of { DoExpr -> True; GhciStmtCtxt -> True; _ -> False }\n = do { (ss,zs) <- repLSts sts;\n        e'      <- repDoE (nonEmptyCoreList zs);\n        wrapGenSyms ss e' }\n\n | ListComp <- ctxt\n = do { (ss,zs) <- repLSts sts;\n        e'      <- repComp (nonEmptyCoreList zs);\n        wrapGenSyms ss e' }\n\n | MDoExpr <- ctxt\n = do { (ss,zs) <- repLSts sts;\n        e'      <- repMDoE (nonEmptyCoreList zs);\n        wrapGenSyms ss e' }\n\n  | otherwise\n  = notHandled \"monad comprehension and [: :]\" (ppr e)\n\nrepE (ExplicitList _ _ es) = do { xs <- repLEs es; repListExp xs }\nrepE e@(ExplicitTuple _ es boxed)\n  | not (all tupArgPresent es) = notHandled \"Tuple sections\" (ppr e)\n  | isBoxed boxed = do { xs <- repLEs [e | (dL->L _ (Present _ e)) <- es]\n                       ; repTup xs }\n  | otherwise     = do { xs <- repLEs [e | (dL->L _ (Present _ e)) <- es]\n                       ; repUnboxedTup xs }\n\nrepE (ExplicitSum _ alt arity e)\n = do { e1 <- repLE e\n      ; repUnboxedSum e1 alt arity }\n\nrepE (RecordCon { rcon_con_name = c, rcon_flds = flds })\n = do { x <- lookupLOcc c;\n        fs <- repFields flds;\n        repRecCon x fs }\nrepE (RecordUpd { rupd_expr = e, rupd_flds = flds })\n = do { x <- repLE e;\n        fs <- repUpdFields flds;\n        repRecUpd x fs }\n\nrepE (ExprWithTySig _ e ty)\n  = do { e1 <- repLE e\n       ; t1 <- repHsSigWcType ty\n       ; repSigExp e1 t1 }\n\nrepE (ArithSeq _ _ aseq) =\n  case aseq of\n    From e              -> do { ds1 <- repLE e; repFrom ds1 }\n    FromThen e1 e2      -> do\n                             ds1 <- repLE e1\n                             ds2 <- repLE e2\n                             repFromThen ds1 ds2\n    FromTo   e1 e2      -> do\n                             ds1 <- repLE e1\n                             ds2 <- repLE e2\n                             repFromTo ds1 ds2\n    FromThenTo e1 e2 e3 -> do\n                             ds1 <- repLE e1\n                             ds2 <- repLE e2\n                             ds3 <- repLE e3\n                             repFromThenTo ds1 ds2 ds3\n\nrepE (HsSpliceE _ splice)  = repSplice splice\nrepE (HsStatic _ e)        = repLE e >>= rep2 staticEName . (:[]) . unC\nrepE (HsUnboundVar _ uv)   = do\n                               occ   <- occNameLit (unboundVarOcc uv)\n                               sname <- repNameS occ\n                               repUnboundVar sname\n\nrepE e@(HsCoreAnn {})      = notHandled \"Core annotations\" (ppr e)\nrepE e@(HsSCC {})          = notHandled \"Cost centres\" (ppr e)\nrepE e@(HsTickPragma {})   = notHandled \"Tick Pragma\" (ppr e)\nrepE e                     = notHandled \"Expression form\" (ppr e)\n\n-----------------------------------------------------------------------------\n-- Building representations of auxillary structures like Match, Clause, Stmt,\n\nrepMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.MatchQ)\nrepMatchTup (dL->L _ (Match { m_pats = [p]\n                            , m_grhss = GRHSs _ guards (dL->L _ wheres) })) =\n  do { ss1 <- mkGenSyms (collectPatBinders p)\n     ; addBinds ss1 $ do {\n     ; p1 <- repLP p\n     ; (ss2,ds) <- repBinds wheres\n     ; addBinds ss2 $ do {\n     ; gs    <- repGuards guards\n     ; match <- repMatch p1 gs ds\n     ; wrapGenSyms (ss1++ss2) match }}}\nrepMatchTup _ = panic \"repMatchTup: case alt with more than one arg\"\n\nrepClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ClauseQ)\nrepClauseTup (dL->L _ (Match { m_pats = ps\n                             , m_grhss = GRHSs _ guards (dL->L _ wheres) })) =\n  do { ss1 <- mkGenSyms (collectPatsBinders ps)\n     ; addBinds ss1 $ do {\n       ps1 <- repLPs ps\n     ; (ss2,ds) <- repBinds wheres\n     ; addBinds ss2 $ do {\n       gs <- repGuards guards\n     ; clause <- repClause ps1 gs ds\n     ; wrapGenSyms (ss1++ss2) clause }}}\nrepClauseTup (dL->L _ (Match _ _ _ (XGRHSs _))) = panic \"repClauseTup\"\nrepClauseTup _ = panic \"repClauseTup\"\n\nrepGuards ::  [LGRHS GhcRn (LHsExpr GhcRn)] ->  DsM (Core TH.BodyQ)\nrepGuards [dL->L _ (GRHS _ [] e)]\n  = do {a <- repLE e; repNormal a }\nrepGuards other\n  = do { zs <- mapM repLGRHS other\n       ; let (xs, ys) = unzip zs\n       ; gd <- repGuarded (nonEmptyCoreList ys)\n       ; wrapGenSyms (concat xs) gd }\n\nrepLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)\n         -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))\nrepLGRHS (dL->L _ (GRHS _ [dL->L _ (BodyStmt _ e1 _ _)] e2))\n  = do { guarded <- repLNormalGE e1 e2\n       ; return ([], guarded) }\nrepLGRHS (dL->L _ (GRHS _ ss rhs))\n  = do { (gs, ss') <- repLSts ss\n       ; rhs' <- addBinds gs $ repLE rhs\n       ; guarded <- repPatGE (nonEmptyCoreList ss') rhs'\n       ; return (gs, guarded) }\nrepLGRHS _ = panic \"repLGRHS\"\n\nrepFields :: HsRecordBinds GhcRn -> DsM (Core [TH.Q TH.FieldExp])\nrepFields (HsRecFields { rec_flds = flds })\n  = repList fieldExpQTyConName rep_fld flds\n  where\n    rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)\n            -> DsM (Core (TH.Q TH.FieldExp))\n    rep_fld (dL->L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld)\n                               ; e  <- repLE (hsRecFieldArg fld)\n                               ; repFieldExp fn e }\n\nrepUpdFields :: [LHsRecUpdField GhcRn] -> DsM (Core [TH.Q TH.FieldExp])\nrepUpdFields = repList fieldExpQTyConName rep_fld\n  where\n    rep_fld :: LHsRecUpdField GhcRn -> DsM (Core (TH.Q TH.FieldExp))\n    rep_fld (dL->L l fld) = case unLoc (hsRecFieldLbl fld) of\n      Unambiguous sel_name _ -> do { fn <- lookupLOcc (cL l sel_name)\n                                   ; e  <- repLE (hsRecFieldArg fld)\n                                   ; repFieldExp fn e }\n      _                      -> notHandled \"Ambiguous record updates\" (ppr fld)\n\n\n\n-----------------------------------------------------------------------------\n-- Representing Stmt's is tricky, especially if bound variables\n-- shadow each other. Consider:  [| do { x <- f 1; x <- f x; g x } |]\n-- First gensym new names for every variable in any of the patterns.\n-- both static (x'1 and x'2), and dynamic ((gensym \"x\") and (gensym \"y\"))\n-- if variables didn't shaddow, the static gensym wouldn't be necessary\n-- and we could reuse the original names (x and x).\n--\n-- do { x'1 <- gensym \"x\"\n--    ; x'2 <- gensym \"x\"\n--    ; doE [ BindSt (pvar x'1) [| f 1 |]\n--          , BindSt (pvar x'2) [| f x |]\n--          , NoBindSt [| g x |]\n--          ]\n--    }\n\n-- The strategy is to translate a whole list of do-bindings by building a\n-- bigger environment, and a bigger set of meta bindings\n-- (like:  x'1 <- gensym \"x\" ) and then combining these with the translations\n-- of the expressions within the Do\n\n-----------------------------------------------------------------------------\n-- The helper function repSts computes the translation of each sub expression\n-- and a bunch of prefix bindings denoting the dynamic renaming.\n\nrepLSts :: [LStmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])\nrepLSts stmts = repSts (map unLoc stmts)\n\nrepSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])\nrepSts (BindStmt _ p e _ _ : ss) =\n   do { e2 <- repLE e\n      ; ss1 <- mkGenSyms (collectPatBinders p)\n      ; addBinds ss1 $ do {\n      ; p1 <- repLP p;\n      ; (ss2,zs) <- repSts ss\n      ; z <- repBindSt p1 e2\n      ; return (ss1++ss2, z : zs) }}\nrepSts (LetStmt _ (dL->L _ bs) : ss) =\n   do { (ss1,ds) <- repBinds bs\n      ; z <- repLetSt ds\n      ; (ss2,zs) <- addBinds ss1 (repSts ss)\n      ; return (ss1++ss2, z : zs) }\nrepSts (BodyStmt _ e _ _ : ss) =\n   do { e2 <- repLE e\n      ; z <- repNoBindSt e2\n      ; (ss2,zs) <- repSts ss\n      ; return (ss2, z : zs) }\nrepSts (ParStmt _ stmt_blocks _ _ : ss) =\n   do { (ss_s, stmt_blocks1) <- mapAndUnzipM rep_stmt_block stmt_blocks\n      ; let stmt_blocks2 = nonEmptyCoreList stmt_blocks1\n            ss1 = concat ss_s\n      ; z <- repParSt stmt_blocks2\n      ; (ss2, zs) <- addBinds ss1 (repSts ss)\n      ; return (ss1++ss2, z : zs) }\n   where\n     rep_stmt_block :: ParStmtBlock GhcRn GhcRn\n                    -> DsM ([GenSymBind], Core [TH.StmtQ])\n     rep_stmt_block (ParStmtBlock _ stmts _ _) =\n       do { (ss1, zs) <- repSts (map unLoc stmts)\n          ; zs1 <- coreList stmtQTyConName zs\n          ; return (ss1, zs1) }\n     rep_stmt_block (XParStmtBlock{}) = panic \"repSts\"\nrepSts [LastStmt _ e _ _]\n  = do { e2 <- repLE e\n       ; z <- repNoBindSt e2\n       ; return ([], [z]) }\nrepSts (stmt@RecStmt{} : ss)\n  = do { let binders = collectLStmtsBinders (recS_stmts stmt)\n       ; ss1 <- mkGenSyms binders\n       -- Bring all of binders in the recursive group into scope for the\n       -- whole group.\n       ; (ss1_other,rss) <- addBinds ss1 $ repSts (map unLoc (recS_stmts stmt))\n       ; MASSERT(sort ss1 == sort ss1_other)\n       ; z <- repRecSt (nonEmptyCoreList rss)\n       ; (ss2,zs) <- addBinds ss1 (repSts ss)\n       ; return (ss1++ss2, z : zs) }\nrepSts []    = return ([],[])\nrepSts other = notHandled \"Exotic statement\" (ppr other)\n\n\n-----------------------------------------------------------\n--                      Bindings\n-----------------------------------------------------------\n\nrepBinds :: HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [TH.DecQ])\nrepBinds (EmptyLocalBinds _)\n  = do  { core_list <- coreList decQTyConName []\n        ; return ([], core_list) }\n\nrepBinds (HsIPBinds _ (IPBinds _ decs))\n = do   { ips <- mapM rep_implicit_param_bind decs\n        ; core_list <- coreList decQTyConName\n                                (de_loc (sort_by_loc ips))\n        ; return ([], core_list)\n        }\n\nrepBinds b@(HsIPBinds _ XHsIPBinds {})\n = notHandled \"Implicit parameter binds extension\" (ppr b)\n\nrepBinds (HsValBinds _ decs)\n = do   { let { bndrs = hsScopedTvBinders decs ++ collectHsValBinders decs }\n                -- No need to worry about detailed scopes within\n                -- the binding group, because we are talking Names\n                -- here, so we can safely treat it as a mutually\n                -- recursive group\n                -- For hsScopedTvBinders see Note [Scoped type variables in bindings]\n        ; ss        <- mkGenSyms bndrs\n        ; prs       <- addBinds ss (rep_val_binds decs)\n        ; core_list <- coreList decQTyConName\n                                (de_loc (sort_by_loc prs))\n        ; return (ss, core_list) }\nrepBinds b@(XHsLocalBindsLR {}) = notHandled \"Local binds extensions\" (ppr b)\n\nrep_implicit_param_bind :: LIPBind GhcRn -> DsM (SrcSpan, Core TH.DecQ)\nrep_implicit_param_bind (dL->L loc (IPBind _ ename (dL->L _ rhs)))\n = do { name <- case ename of\n                    Left (dL->L _ n) -> rep_implicit_param_name n\n                    Right _ ->\n                        panic \"rep_implicit_param_bind: post typechecking\"\n      ; rhs' <- repE rhs\n      ; ipb <- repImplicitParamBind name rhs'\n      ; return (loc, ipb) }\nrep_implicit_param_bind (dL->L _ b@(XIPBind _))\n = notHandled \"Implicit parameter bind extension\" (ppr b)\nrep_implicit_param_bind _ = panic \"rep_implicit_param_bind: Impossible Match\"\n                            -- due to #15884\n\nrep_implicit_param_name :: HsIPName -> DsM (Core String)\nrep_implicit_param_name (HsIPName name) = coreStringLit (unpackFS name)\n\nrep_val_binds :: HsValBinds GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]\n-- Assumes: all the binders of the binding are already in the meta-env\nrep_val_binds (XValBindsLR (NValBinds binds sigs))\n = do { core1 <- rep_binds (unionManyBags (map snd binds))\n      ; core2 <- rep_sigs sigs\n      ; return (core1 ++ core2) }\nrep_val_binds (ValBinds _ _ _)\n = panic \"rep_val_binds: ValBinds\"\n\nrep_binds :: LHsBinds GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]\nrep_binds = mapM rep_bind . bagToList\n\nrep_bind :: LHsBind GhcRn -> DsM (SrcSpan, Core TH.DecQ)\n-- Assumes: all the binders of the binding are already in the meta-env\n\n-- Note GHC treats declarations of a variable (not a pattern)\n-- e.g.  x = g 5 as a Fun MonoBinds. This is indicated by a single match\n-- with an empty list of patterns\nrep_bind (dL->L loc (FunBind\n                 { fun_id = fn,\n                   fun_matches = MG { mg_alts\n                           = (dL->L _ [dL->L _ (Match\n                                       { m_pats = []\n                                       , m_grhss = GRHSs _ guards\n                                                     (dL->L _ wheres) }\n                                      )]) } }))\n = do { (ss,wherecore) <- repBinds wheres\n        ; guardcore <- addBinds ss (repGuards guards)\n        ; fn'  <- lookupLBinder fn\n        ; p    <- repPvar fn'\n        ; ans  <- repVal p guardcore wherecore\n        ; ans' <- wrapGenSyms ss ans\n        ; return (loc, ans') }\n\nrep_bind (dL->L loc (FunBind { fun_id = fn\n                             , fun_matches = MG { mg_alts = (dL->L _ ms) } }))\n =   do { ms1 <- mapM repClauseTup ms\n        ; fn' <- lookupLBinder fn\n        ; ans <- repFun fn' (nonEmptyCoreList ms1)\n        ; return (loc, ans) }\n\nrep_bind (dL->L _ (FunBind { fun_matches = XMatchGroup _ })) = panic \"rep_bind\"\n\nrep_bind (dL->L loc (PatBind { pat_lhs = pat\n                             , pat_rhs = GRHSs _ guards (dL->L _ wheres) }))\n =   do { patcore <- repLP pat\n        ; (ss,wherecore) <- repBinds wheres\n        ; guardcore <- addBinds ss (repGuards guards)\n        ; ans  <- repVal patcore guardcore wherecore\n        ; ans' <- wrapGenSyms ss ans\n        ; return (loc, ans') }\nrep_bind (dL->L _ (PatBind _ _ (XGRHSs _) _)) = panic \"rep_bind\"\n\nrep_bind (dL->L _ (VarBind { var_id = v, var_rhs = e}))\n =   do { v' <- lookupBinder v\n        ; e2 <- repLE e\n        ; x <- repNormal e2\n        ; patcore <- repPvar v'\n        ; empty_decls <- coreList decQTyConName []\n        ; ans <- repVal patcore x empty_decls\n        ; return (srcLocSpan (getSrcLoc v), ans) }\n\nrep_bind (dL->L _ (AbsBinds {}))  = panic \"rep_bind: AbsBinds\"\nrep_bind (dL->L loc (PatSynBind _ (PSB { psb_id   = syn\n                                       , psb_args = args\n                                       , psb_def  = pat\n                                       , psb_dir  = dir })))\n  = do { syn'      <- lookupLBinder syn\n       ; dir'      <- repPatSynDir dir\n       ; ss        <- mkGenArgSyms args\n       ; patSynD'  <- addBinds ss (\n         do { args'  <- repPatSynArgs args\n            ; pat'   <- repLP pat\n            ; repPatSynD syn' args' dir' pat' })\n       ; patSynD'' <- wrapGenArgSyms args ss patSynD'\n       ; return (loc, patSynD'') }\n  where\n    mkGenArgSyms :: HsPatSynDetails (Located Name) -> DsM [GenSymBind]\n    -- for Record Pattern Synonyms we want to conflate the selector\n    -- and the pattern-only names in order to provide a nicer TH\n    -- API. Whereas inside GHC, record pattern synonym selectors and\n    -- their pattern-only bound right hand sides have different names,\n    -- we want to treat them the same in TH. This is the reason why we\n    -- need an adjusted mkGenArgSyms in the `RecCon` case below.\n    mkGenArgSyms (PrefixCon args)     = mkGenSyms (map unLoc args)\n    mkGenArgSyms (InfixCon arg1 arg2) = mkGenSyms [unLoc arg1, unLoc arg2]\n    mkGenArgSyms (RecCon fields)\n      = do { let pats = map (unLoc . recordPatSynPatVar) fields\n                 sels = map (unLoc . recordPatSynSelectorId) fields\n           ; ss <- mkGenSyms sels\n           ; return $ replaceNames (zip sels pats) ss }\n\n    replaceNames selsPats genSyms\n      = [ (pat, id) | (sel, id) <- genSyms, (sel', pat) <- selsPats\n                    , sel == sel' ]\n\n    wrapGenArgSyms :: HsPatSynDetails (Located Name)\n                   -> [GenSymBind] -> Core TH.DecQ -> DsM (Core TH.DecQ)\n    wrapGenArgSyms (RecCon _) _  dec = return dec\n    wrapGenArgSyms _          ss dec = wrapGenSyms ss dec\n\nrep_bind (dL->L _ (PatSynBind _ (XPatSynBind _)))\n  = panic \"rep_bind: XPatSynBind\"\nrep_bind (dL->L _ (XHsBindsLR {}))  = panic \"rep_bind: XHsBindsLR\"\nrep_bind _                          = panic \"rep_bind: Impossible match!\"\n                                      -- due to #15884\n\nrepPatSynD :: Core TH.Name\n           -> Core TH.PatSynArgsQ\n           -> Core TH.PatSynDirQ\n           -> Core TH.PatQ\n           -> DsM (Core TH.DecQ)\nrepPatSynD (MkC syn) (MkC args) (MkC dir) (MkC pat)\n  = rep2 patSynDName [syn, args, dir, pat]\n\nrepPatSynArgs :: HsPatSynDetails (Located Name) -> DsM (Core TH.PatSynArgsQ)\nrepPatSynArgs (PrefixCon args)\n  = do { args' <- repList nameTyConName lookupLOcc args\n       ; repPrefixPatSynArgs args' }\nrepPatSynArgs (InfixCon arg1 arg2)\n  = do { arg1' <- lookupLOcc arg1\n       ; arg2' <- lookupLOcc arg2\n       ; repInfixPatSynArgs arg1' arg2' }\nrepPatSynArgs (RecCon fields)\n  = do { sels' <- repList nameTyConName lookupLOcc sels\n       ; repRecordPatSynArgs sels' }\n  where sels = map recordPatSynSelectorId fields\n\nrepPrefixPatSynArgs :: Core [TH.Name] -> DsM (Core TH.PatSynArgsQ)\nrepPrefixPatSynArgs (MkC nms) = rep2 prefixPatSynName [nms]\n\nrepInfixPatSynArgs :: Core TH.Name -> Core TH.Name -> DsM (Core TH.PatSynArgsQ)\nrepInfixPatSynArgs (MkC nm1) (MkC nm2) = rep2 infixPatSynName [nm1, nm2]\n\nrepRecordPatSynArgs :: Core [TH.Name]\n                    -> DsM (Core TH.PatSynArgsQ)\nrepRecordPatSynArgs (MkC sels) = rep2 recordPatSynName [sels]\n\nrepPatSynDir :: HsPatSynDir GhcRn -> DsM (Core TH.PatSynDirQ)\nrepPatSynDir Unidirectional        = rep2 unidirPatSynName []\nrepPatSynDir ImplicitBidirectional = rep2 implBidirPatSynName []\nrepPatSynDir (ExplicitBidirectional (MG { mg_alts = (dL->L _ clauses) }))\n  = do { clauses' <- mapM repClauseTup clauses\n       ; repExplBidirPatSynDir (nonEmptyCoreList clauses') }\nrepPatSynDir (ExplicitBidirectional (XMatchGroup _)) = panic \"repPatSynDir\"\n\nrepExplBidirPatSynDir :: Core [TH.ClauseQ] -> DsM (Core TH.PatSynDirQ)\nrepExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]\n\n\n-----------------------------------------------------------------------------\n-- Since everything in a Bind is mutually recursive we need rename all\n-- all the variables simultaneously. For example:\n-- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to\n-- do { f'1 <- gensym \"f\"\n--    ; g'2 <- gensym \"g\"\n--    ; [ do { x'3 <- gensym \"x\"; fun f'1 [pvar x'3] [| x + g2 |]},\n--        do { x'4 <- gensym \"x\"; fun g'2 [pvar x'4] [| f 1 + 2 |]}\n--      ]}\n-- This requires collecting the bindings (f'1 <- gensym \"f\"), and the\n-- environment ( f |-> f'1 ) from each binding, and then unioning them\n-- together. As we do this we collect GenSymBinds's which represent the renamed\n-- variables bound by the Bindings. In order not to lose track of these\n-- representations we build a shadow datatype MB with the same structure as\n-- MonoBinds, but which has slots for the representations\n\n\n-----------------------------------------------------------------------------\n-- GHC allows a more general form of lambda abstraction than specified\n-- by Haskell 98. In particular it allows guarded lambda's like :\n-- (\\  x | even x -> 0 | odd x -> 1) at the moment we can't represent this in\n-- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like\n-- (\\ p1 .. pn -> exp) by causing an error.\n\nrepLambda :: LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ExpQ)\nrepLambda (dL->L _ (Match { m_pats = ps\n                          , m_grhss = GRHSs _ [dL->L _ (GRHS _ [] e)]\n                                              (dL->L _ (EmptyLocalBinds _)) } ))\n = do { let bndrs = collectPatsBinders ps ;\n      ; ss  <- mkGenSyms bndrs\n      ; lam <- addBinds ss (\n                do { xs <- repLPs ps; body <- repLE e; repLam xs body })\n      ; wrapGenSyms ss lam }\n\nrepLambda (dL->L _ m) = notHandled \"Guarded labmdas\" (pprMatch m)\n\n\n-----------------------------------------------------------------------------\n--                      Patterns\n-- repP deals with patterns.  It assumes that we have already\n-- walked over the pattern(s) once to collect the binders, and\n-- have extended the environment.  So every pattern-bound\n-- variable should already appear in the environment.\n\n-- Process a list of patterns\nrepLPs :: [LPat GhcRn] -> DsM (Core [TH.PatQ])\nrepLPs ps = repList patQTyConName repLP ps\n\nrepLP :: LPat GhcRn -> DsM (Core TH.PatQ)\nrepLP p = repP (unLoc p)\n\nrepP :: Pat GhcRn -> DsM (Core TH.PatQ)\nrepP (WildPat _)        = repPwild\nrepP (LitPat _ l)       = do { l2 <- repLiteral l; repPlit l2 }\nrepP (VarPat _ x)       = do { x' <- lookupBinder (unLoc x); repPvar x' }\nrepP (LazyPat _ p)      = do { p1 <- repLP p; repPtilde p1 }\nrepP (BangPat _ p)      = do { p1 <- repLP p; repPbang p1 }\nrepP (AsPat _ x p)      = do { x' <- lookupLBinder x; p1 <- repLP p\n                             ; repPaspat x' p1 }\nrepP (ParPat _ p)       = repLP p\nrepP (ListPat Nothing ps)  = do { qs <- repLPs ps; repPlist qs }\nrepP (ListPat (Just e) ps) = do { p <- repP (ListPat Nothing ps)\n                                ; e' <- repE (syn_expr e)\n                                ; repPview e' p}\nrepP (TuplePat _ ps boxed)\n  | isBoxed boxed       = do { qs <- repLPs ps; repPtup qs }\n  | otherwise           = do { qs <- repLPs ps; repPunboxedTup qs }\nrepP (SumPat _ p alt arity) = do { p1 <- repLP p\n                                 ; repPunboxedSum p1 alt arity }\nrepP (ConPatIn dc details)\n = do { con_str <- lookupLOcc dc\n      ; case details of\n         PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }\n         RecCon rec   -> do { fps <- repList fieldPatQTyConName rep_fld (rec_flds rec)\n                            ; repPrec con_str fps }\n         InfixCon p1 p2 -> do { p1' <- repLP p1;\n                                p2' <- repLP p2;\n                                repPinfix p1' con_str p2' }\n   }\n where\n   rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> DsM (Core (TH.Name,TH.PatQ))\n   rep_fld (dL->L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld)\n                              ; MkC p <- repLP (hsRecFieldArg fld)\n                              ; rep2 fieldPatName [v,p] }\n\nrepP (NPat _ (dL->L _ l) Nothing _) = do { a <- repOverloadedLiteral l\n                                         ; repPlit a }\nrepP (ViewPat _ e p) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }\nrepP p@(NPat _ _ (Just _) _) = notHandled \"Negative overloaded patterns\" (ppr p)\nrepP (SigPat _ p t) = do { p' <- repLP p\n                         ; t' <- repLTy (hsSigWcType t)\n                         ; repPsig p' t' }\nrepP (SplicePat _ splice) = repSplice splice\n\nrepP other = notHandled \"Exotic pattern\" (ppr other)\n\n----------------------------------------------------------\n-- Declaration ordering helpers\n\nsort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]\nsort_by_loc xs = sortBy comp xs\n    where comp x y = compare (fst x) (fst y)\n\nde_loc :: [(a, b)] -> [b]\nde_loc = map snd\n\n----------------------------------------------------------\n--      The meta-environment\n\n-- A name/identifier association for fresh names of locally bound entities\ntype GenSymBind = (Name, Id)    -- Gensym the string and bind it to the Id\n                                -- I.e.         (x, x_id) means\n                                --      let x_id = gensym \"x\" in ...\n\n-- Generate a fresh name for a locally bound entity\n\nmkGenSyms :: [Name] -> DsM [GenSymBind]\n-- We can use the existing name.  For example:\n--      [| \\x_77 -> x_77 + x_77 |]\n-- desugars to\n--      do { x_77 <- genSym \"x\"; .... }\n-- We use the same x_77 in the desugared program, but with the type Bndr\n-- instead of Int\n--\n-- We do make it an Internal name, though (hence localiseName)\n--\n-- Nevertheless, it's monadic because we have to generate nameTy\nmkGenSyms ns = do { var_ty <- lookupType nameTyConName\n                  ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }\n\n\naddBinds :: [GenSymBind] -> DsM a -> DsM a\n-- Add a list of fresh names for locally bound entities to the\n-- meta environment (which is part of the state carried around\n-- by the desugarer monad)\naddBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,DsBound id) | (n,id) <- bs]) m\n\n-- Look up a locally bound name\n--\nlookupLBinder :: Located Name -> DsM (Core TH.Name)\nlookupLBinder n = lookupBinder (unLoc n)\n\nlookupBinder :: Name -> DsM (Core TH.Name)\nlookupBinder = lookupOcc\n  -- Binders are brought into scope before the pattern or what-not is\n  -- desugared.  Moreover, in instance declaration the binder of a method\n  -- will be the selector Id and hence a global; so we need the\n  -- globalVar case of lookupOcc\n\n-- Look up a name that is either locally bound or a global name\n--\n--  * If it is a global name, generate the \"original name\" representation (ie,\n--   the <module>:<name> form) for the associated entity\n--\nlookupLOcc :: Located Name -> DsM (Core TH.Name)\n-- Lookup an occurrence; it can't be a splice.\n-- Use the in-scope bindings if they exist\nlookupLOcc n = lookupOcc (unLoc n)\n\nlookupOcc :: Name -> DsM (Core TH.Name)\nlookupOcc n\n  = do {  mb_val <- dsLookupMetaEnv n ;\n          case mb_val of\n                Nothing           -> globalVar n\n                Just (DsBound x)  -> return (coreVar x)\n                Just (DsSplice _) -> pprPanic \"repE:lookupOcc\" (ppr n)\n    }\n\nglobalVar :: Name -> DsM (Core TH.Name)\n-- Not bound by the meta-env\n-- Could be top-level; or could be local\n--      f x = $(g [| x |])\n-- Here the x will be local\nglobalVar name\n  | isExternalName name\n  = do  { MkC mod <- coreStringLit name_mod\n        ; MkC pkg <- coreStringLit name_pkg\n        ; MkC occ <- nameLit name\n        ; rep2 mk_varg [pkg,mod,occ] }\n  | otherwise\n  = do  { MkC occ <- nameLit name\n        ; MkC uni <- coreIntLit (getKey (getUnique name))\n        ; rep2 mkNameLName [occ,uni] }\n  where\n      mod = ASSERT( isExternalName name) nameModule name\n      name_mod = moduleNameString (moduleName mod)\n      name_pkg = unitIdString (moduleUnitId mod)\n      name_occ = nameOccName name\n      mk_varg | OccName.isDataOcc name_occ = mkNameG_dName\n              | OccName.isVarOcc  name_occ = mkNameG_vName\n              | OccName.isTcOcc   name_occ = mkNameG_tcName\n              | otherwise                  = pprPanic \"DsMeta.globalVar\" (ppr name)\n\nlookupType :: Name      -- Name of type constructor (e.g. TH.ExpQ)\n           -> DsM Type  -- The type\nlookupType tc_name = do { tc <- dsLookupTyCon tc_name ;\n                          return (mkTyConApp tc []) }\n\nwrapGenSyms :: [GenSymBind]\n            -> Core (TH.Q a) -> DsM (Core (TH.Q a))\n-- wrapGenSyms [(nm1,id1), (nm2,id2)] y\n--      --> bindQ (gensym nm1) (\\ id1 ->\n--          bindQ (gensym nm2 (\\ id2 ->\n--          y))\n\nwrapGenSyms binds body@(MkC b)\n  = do  { var_ty <- lookupType nameTyConName\n        ; go var_ty binds }\n  where\n    [elt_ty] = tcTyConAppArgs (exprType b)\n        -- b :: Q a, so we can get the type 'a' by looking at the\n        -- argument type. NB: this relies on Q being a data/newtype,\n        -- not a type synonym\n\n    go _ [] = return body\n    go var_ty ((name,id) : binds)\n      = do { MkC body'  <- go var_ty binds\n           ; lit_str    <- nameLit name\n           ; gensym_app <- repGensym lit_str\n           ; repBindQ var_ty elt_ty\n                      gensym_app (MkC (Lam id body')) }\n\nnameLit :: Name -> DsM (Core String)\nnameLit n = coreStringLit (occNameString (nameOccName n))\n\noccNameLit :: OccName -> DsM (Core String)\noccNameLit name = coreStringLit (occNameString name)\n\n\n-- %*********************************************************************\n-- %*                                                                   *\n--              Constructing code\n-- %*                                                                   *\n-- %*********************************************************************\n\n-----------------------------------------------------------------------------\n-- PHANTOM TYPES for consistency. In order to make sure we do this correct\n-- we invent a new datatype which uses phantom types.\n\nnewtype Core a = MkC CoreExpr\nunC :: Core a -> CoreExpr\nunC (MkC x) = x\n\nrep2 :: Name -> [ CoreExpr ] -> DsM (Core a)\nrep2 n xs = do { id <- dsLookupGlobalId n\n               ; return (MkC (foldl' App (Var id) xs)) }\n\ndataCon' :: Name -> [CoreExpr] -> DsM (Core a)\ndataCon' n args = do { id <- dsLookupDataCon n\n                     ; return $ MkC $ mkCoreConApps id args }\n\ndataCon :: Name -> DsM (Core a)\ndataCon n = dataCon' n []\n\n\n-- %*********************************************************************\n-- %*                                                                   *\n--              The 'smart constructors'\n-- %*                                                                   *\n-- %*********************************************************************\n\n--------------- Patterns -----------------\nrepPlit   :: Core TH.Lit -> DsM (Core TH.PatQ)\nrepPlit (MkC l) = rep2 litPName [l]\n\nrepPvar :: Core TH.Name -> DsM (Core TH.PatQ)\nrepPvar (MkC s) = rep2 varPName [s]\n\nrepPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)\nrepPtup (MkC ps) = rep2 tupPName [ps]\n\nrepPunboxedTup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)\nrepPunboxedTup (MkC ps) = rep2 unboxedTupPName [ps]\n\nrepPunboxedSum :: Core TH.PatQ -> TH.SumAlt -> TH.SumArity -> DsM (Core TH.PatQ)\n-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here\nrepPunboxedSum (MkC p) alt arity\n = do { dflags <- getDynFlags\n      ; rep2 unboxedSumPName [ p\n                             , mkIntExprInt dflags alt\n                             , mkIntExprInt dflags arity ] }\n\nrepPcon   :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)\nrepPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]\n\nrepPrec   :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)\nrepPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]\n\nrepPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)\nrepPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]\n\nrepPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)\nrepPtilde (MkC p) = rep2 tildePName [p]\n\nrepPbang :: Core TH.PatQ -> DsM (Core TH.PatQ)\nrepPbang (MkC p) = rep2 bangPName [p]\n\nrepPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)\nrepPaspat (MkC s) (MkC p) = rep2 asPName [s, p]\n\nrepPwild  :: DsM (Core TH.PatQ)\nrepPwild = rep2 wildPName []\n\nrepPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)\nrepPlist (MkC ps) = rep2 listPName [ps]\n\nrepPview :: Core TH.ExpQ -> Core TH.PatQ -> DsM (Core TH.PatQ)\nrepPview (MkC e) (MkC p) = rep2 viewPName [e,p]\n\nrepPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)\nrepPsig (MkC p) (MkC t) = rep2 sigPName [p, t]\n\n--------------- Expressions -----------------\nrepVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)\nrepVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str\n                   | otherwise                  = repVar str\n\nrepVar :: Core TH.Name -> DsM (Core TH.ExpQ)\nrepVar (MkC s) = rep2 varEName [s]\n\nrepCon :: Core TH.Name -> DsM (Core TH.ExpQ)\nrepCon (MkC s) = rep2 conEName [s]\n\nrepLit :: Core TH.Lit -> DsM (Core TH.ExpQ)\nrepLit (MkC c) = rep2 litEName [c]\n\nrepApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepApp (MkC x) (MkC y) = rep2 appEName [x,y]\n\nrepAppType :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)\nrepAppType (MkC x) (MkC y) = rep2 appTypeEName [x,y]\n\nrepLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]\n\nrepLamCase :: Core [TH.MatchQ] -> DsM (Core TH.ExpQ)\nrepLamCase (MkC ms) = rep2 lamCaseEName [ms]\n\nrepTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)\nrepTup (MkC es) = rep2 tupEName [es]\n\nrepUnboxedTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)\nrepUnboxedTup (MkC es) = rep2 unboxedTupEName [es]\n\nrepUnboxedSum :: Core TH.ExpQ -> TH.SumAlt -> TH.SumArity -> DsM (Core TH.ExpQ)\n-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here\nrepUnboxedSum (MkC e) alt arity\n = do { dflags <- getDynFlags\n      ; rep2 unboxedSumEName [ e\n                             , mkIntExprInt dflags alt\n                             , mkIntExprInt dflags arity ] }\n\nrepCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]\n\nrepMultiIf :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.ExpQ)\nrepMultiIf (MkC alts) = rep2 multiIfEName [alts]\n\nrepLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]\n\nrepCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)\nrepCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]\n\nrepDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)\nrepDoE (MkC ss) = rep2 doEName [ss]\n\nrepMDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)\nrepMDoE (MkC ss) = rep2 mdoEName [ss]\n\nrepComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)\nrepComp (MkC ss) = rep2 compEName [ss]\n\nrepListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)\nrepListExp (MkC es) = rep2 listEName [es]\n\nrepSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)\nrepSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]\n\nrepRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)\nrepRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]\n\nrepRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)\nrepRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]\n\nrepFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))\nrepFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]\n\nrepInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]\n\nrepSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]\n\nrepSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]\n\nrepImplicitParamVar :: Core String -> DsM (Core TH.ExpQ)\nrepImplicitParamVar (MkC x) = rep2 implicitParamVarEName [x]\n\n------------ Right hand sides (guarded expressions) ----\nrepGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)\nrepGuarded (MkC pairs) = rep2 guardedBName [pairs]\n\nrepNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)\nrepNormal (MkC e) = rep2 normalBName [e]\n\n------------ Guards ----\nrepLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn\n             -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))\nrepLNormalGE g e = do g' <- repLE g\n                      e' <- repLE e\n                      repNormalGE g' e'\n\nrepNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))\nrepNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]\n\nrepPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))\nrepPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]\n\n------------- Stmts -------------------\nrepBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)\nrepBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]\n\nrepLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)\nrepLetSt (MkC ds) = rep2 letSName [ds]\n\nrepNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)\nrepNoBindSt (MkC e) = rep2 noBindSName [e]\n\nrepParSt :: Core [[TH.StmtQ]] -> DsM (Core TH.StmtQ)\nrepParSt (MkC sss) = rep2 parSName [sss]\n\nrepRecSt :: Core [TH.StmtQ] -> DsM (Core TH.StmtQ)\nrepRecSt (MkC ss) = rep2 recSName [ss]\n\n-------------- Range (Arithmetic sequences) -----------\nrepFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepFrom (MkC x) = rep2 fromEName [x]\n\nrepFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]\n\nrepFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]\n\nrepFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)\nrepFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]\n\n------------ Match and Clause Tuples -----------\nrepMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)\nrepMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]\n\nrepClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)\nrepClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]\n\n-------------- Dec -----------------------------\nrepVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)\nrepVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]\n\nrepFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)\nrepFun (MkC nm) (MkC b) = rep2 funDName [nm, b]\n\nrepData :: Core TH.CxtQ -> Core TH.Name\n        -> Either (Core [TH.TyVarBndrQ])\n                  (Core (Maybe [TH.TyVarBndrQ]), Core TH.TypeQ)\n        -> Core (Maybe TH.KindQ) -> Core [TH.ConQ] -> Core [TH.DerivClauseQ]\n        -> DsM (Core TH.DecQ)\nrepData (MkC cxt) (MkC nm) (Left (MkC tvs)) (MkC ksig) (MkC cons) (MkC derivs)\n  = rep2 dataDName [cxt, nm, tvs, ksig, cons, derivs]\nrepData (MkC cxt) (MkC _) (Right (MkC mb_bndrs, MkC ty)) (MkC ksig) (MkC cons)\n        (MkC derivs)\n  = rep2 dataInstDName [cxt, mb_bndrs, ty, ksig, cons, derivs]\n\nrepNewtype :: Core TH.CxtQ -> Core TH.Name\n           -> Either (Core [TH.TyVarBndrQ])\n                     (Core (Maybe [TH.TyVarBndrQ]), Core TH.TypeQ)\n           -> Core (Maybe TH.KindQ) -> Core TH.ConQ -> Core [TH.DerivClauseQ]\n           -> DsM (Core TH.DecQ)\nrepNewtype (MkC cxt) (MkC nm) (Left (MkC tvs)) (MkC ksig) (MkC con)\n           (MkC derivs)\n  = rep2 newtypeDName [cxt, nm, tvs, ksig, con, derivs]\nrepNewtype (MkC cxt) (MkC _) (Right (MkC mb_bndrs, MkC ty)) (MkC ksig) (MkC con)\n           (MkC derivs)\n  = rep2 newtypeInstDName [cxt, mb_bndrs, ty, ksig, con, derivs]\n\nrepTySyn :: Core TH.Name -> Core [TH.TyVarBndrQ]\n         -> Core TH.TypeQ -> DsM (Core TH.DecQ)\nrepTySyn (MkC nm) (MkC tvs) (MkC rhs)\n  = rep2 tySynDName [nm, tvs, rhs]\n\nrepInst :: Core (Maybe TH.Overlap) ->\n           Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)\nrepInst (MkC o) (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceWithOverlapDName\n                                                              [o, cxt, ty, ds]\n\nrepDerivStrategy :: Maybe (LDerivStrategy GhcRn)\n                 -> DsM (Core (Maybe TH.DerivStrategyQ))\nrepDerivStrategy mds =\n  case mds of\n    Nothing -> nothing\n    Just ds ->\n      case unLoc ds of\n        StockStrategy    -> just =<< repStockStrategy\n        AnyclassStrategy -> just =<< repAnyclassStrategy\n        NewtypeStrategy  -> just =<< repNewtypeStrategy\n        ViaStrategy ty   -> do ty' <- repLTy (hsSigType ty)\n                               via_strat <- repViaStrategy ty'\n                               just via_strat\n  where\n  nothing = coreNothing derivStrategyQTyConName\n  just    = coreJust    derivStrategyQTyConName\n\nrepStockStrategy :: DsM (Core TH.DerivStrategyQ)\nrepStockStrategy = rep2 stockStrategyName []\n\nrepAnyclassStrategy :: DsM (Core TH.DerivStrategyQ)\nrepAnyclassStrategy = rep2 anyclassStrategyName []\n\nrepNewtypeStrategy :: DsM (Core TH.DerivStrategyQ)\nrepNewtypeStrategy = rep2 newtypeStrategyName []\n\nrepViaStrategy :: Core TH.TypeQ -> DsM (Core TH.DerivStrategyQ)\nrepViaStrategy (MkC t) = rep2 viaStrategyName [t]\n\nrepOverlap :: Maybe OverlapMode -> DsM (Core (Maybe TH.Overlap))\nrepOverlap mb =\n  case mb of\n    Nothing -> nothing\n    Just o ->\n      case o of\n        NoOverlap _    -> nothing\n        Overlappable _ -> just =<< dataCon overlappableDataConName\n        Overlapping _  -> just =<< dataCon overlappingDataConName\n        Overlaps _     -> just =<< dataCon overlapsDataConName\n        Incoherent _   -> just =<< dataCon incoherentDataConName\n  where\n  nothing = coreNothing overlapTyConName\n  just    = coreJust overlapTyConName\n\n\nrepClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndrQ]\n         -> Core [TH.FunDep] -> Core [TH.DecQ]\n         -> DsM (Core TH.DecQ)\nrepClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)\n  = rep2 classDName [cxt, cls, tvs, fds, ds]\n\nrepDeriv :: Core (Maybe TH.DerivStrategyQ)\n         -> Core TH.CxtQ -> Core TH.TypeQ\n         -> DsM (Core TH.DecQ)\nrepDeriv (MkC ds) (MkC cxt) (MkC ty)\n  = rep2 standaloneDerivWithStrategyDName [ds, cxt, ty]\n\nrepPragInl :: Core TH.Name -> Core TH.Inline -> Core TH.RuleMatch\n           -> Core TH.Phases -> DsM (Core TH.DecQ)\nrepPragInl (MkC nm) (MkC inline) (MkC rm) (MkC phases)\n  = rep2 pragInlDName [nm, inline, rm, phases]\n\nrepPragSpec :: Core TH.Name -> Core TH.TypeQ -> Core TH.Phases\n            -> DsM (Core TH.DecQ)\nrepPragSpec (MkC nm) (MkC ty) (MkC phases)\n  = rep2 pragSpecDName [nm, ty, phases]\n\nrepPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.Inline\n               -> Core TH.Phases -> DsM (Core TH.DecQ)\nrepPragSpecInl (MkC nm) (MkC ty) (MkC inline) (MkC phases)\n  = rep2 pragSpecInlDName [nm, ty, inline, phases]\n\nrepPragSpecInst :: Core TH.TypeQ -> DsM (Core TH.DecQ)\nrepPragSpecInst (MkC ty) = rep2 pragSpecInstDName [ty]\n\nrepPragComplete :: Core [TH.Name] -> Core (Maybe TH.Name) -> DsM (Core TH.DecQ)\nrepPragComplete (MkC cls) (MkC mty) = rep2 pragCompleteDName [cls, mty]\n\nrepPragRule :: Core String -> Core (Maybe [TH.TyVarBndrQ])\n            -> Core [TH.RuleBndrQ] -> Core TH.ExpQ -> Core TH.ExpQ\n            -> Core TH.Phases -> DsM (Core TH.DecQ)\nrepPragRule (MkC nm) (MkC ty_bndrs) (MkC tm_bndrs) (MkC lhs) (MkC rhs) (MkC phases)\n  = rep2 pragRuleDName [nm, ty_bndrs, tm_bndrs, lhs, rhs, phases]\n\nrepPragAnn :: Core TH.AnnTarget -> Core TH.ExpQ -> DsM (Core TH.DecQ)\nrepPragAnn (MkC targ) (MkC e) = rep2 pragAnnDName [targ, e]\n\nrepTySynInst :: Core TH.TySynEqnQ -> DsM (Core TH.DecQ)\nrepTySynInst (MkC eqn)\n    = rep2 tySynInstDName [eqn]\n\nrepDataFamilyD :: Core TH.Name -> Core [TH.TyVarBndrQ]\n               -> Core (Maybe TH.KindQ) -> DsM (Core TH.DecQ)\nrepDataFamilyD (MkC nm) (MkC tvs) (MkC kind)\n    = rep2 dataFamilyDName [nm, tvs, kind]\n\nrepOpenFamilyD :: Core TH.Name\n               -> Core [TH.TyVarBndrQ]\n               -> Core TH.FamilyResultSigQ\n               -> Core (Maybe TH.InjectivityAnn)\n               -> DsM (Core TH.DecQ)\nrepOpenFamilyD (MkC nm) (MkC tvs) (MkC result) (MkC inj)\n    = rep2 openTypeFamilyDName [nm, tvs, result, inj]\n\nrepClosedFamilyD :: Core TH.Name\n                 -> Core [TH.TyVarBndrQ]\n                 -> Core TH.FamilyResultSigQ\n                 -> Core (Maybe TH.InjectivityAnn)\n                 -> Core [TH.TySynEqnQ]\n                 -> DsM (Core TH.DecQ)\nrepClosedFamilyD (MkC nm) (MkC tvs) (MkC res) (MkC inj) (MkC eqns)\n    = rep2 closedTypeFamilyDName [nm, tvs, res, inj, eqns]\n\nrepTySynEqn :: Core (Maybe [TH.TyVarBndrQ]) ->\n               Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TySynEqnQ)\nrepTySynEqn (MkC mb_bndrs) (MkC lhs) (MkC rhs)\n  = rep2 tySynEqnName [mb_bndrs, lhs, rhs]\n\nrepRoleAnnotD :: Core TH.Name -> Core [TH.Role] -> DsM (Core TH.DecQ)\nrepRoleAnnotD (MkC n) (MkC roles) = rep2 roleAnnotDName [n, roles]\n\nrepFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)\nrepFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]\n\nrepProto :: Name -> Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)\nrepProto mk_sig (MkC s) (MkC ty) = rep2 mk_sig [s, ty]\n\nrepImplicitParamBind :: Core String -> Core TH.ExpQ -> DsM (Core TH.DecQ)\nrepImplicitParamBind (MkC n) (MkC e) = rep2 implicitParamBindDName [n, e]\n\nrepCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)\nrepCtxt (MkC tys) = rep2 cxtName [tys]\n\nrepDataCon :: Located Name\n           -> HsConDeclDetails GhcRn\n           -> DsM (Core TH.ConQ)\nrepDataCon con details\n    = do con' <- lookupLOcc con -- See Note [Binders and occurrences]\n         repConstr details Nothing [con']\n\nrepGadtDataCons :: [Located Name]\n                -> HsConDeclDetails GhcRn\n                -> LHsType GhcRn\n                -> DsM (Core TH.ConQ)\nrepGadtDataCons cons details res_ty\n    = do cons' <- mapM lookupLOcc cons -- See Note [Binders and occurrences]\n         repConstr details (Just res_ty) cons'\n\n-- Invariant:\n--   * for plain H98 data constructors second argument is Nothing and third\n--     argument is a singleton list\n--   * for GADTs data constructors second argument is (Just return_type) and\n--     third argument is a non-empty list\nrepConstr :: HsConDeclDetails GhcRn\n          -> Maybe (LHsType GhcRn)\n          -> [Core TH.Name]\n          -> DsM (Core TH.ConQ)\nrepConstr (PrefixCon ps) Nothing [con]\n    = do arg_tys  <- repList bangTypeQTyConName repBangTy ps\n         rep2 normalCName [unC con, unC arg_tys]\n\nrepConstr (PrefixCon ps) (Just res_ty) cons\n    = do arg_tys     <- repList bangTypeQTyConName repBangTy ps\n         res_ty' <- repLTy res_ty\n         rep2 gadtCName [ unC (nonEmptyCoreList cons), unC arg_tys, unC res_ty']\n\nrepConstr (RecCon ips) resTy cons\n    = do args     <- concatMapM rep_ip (unLoc ips)\n         arg_vtys <- coreList varBangTypeQTyConName args\n         case resTy of\n           Nothing -> rep2 recCName [unC (head cons), unC arg_vtys]\n           Just res_ty -> do\n             res_ty' <- repLTy res_ty\n             rep2 recGadtCName [unC (nonEmptyCoreList cons), unC arg_vtys,\n                                unC res_ty']\n\n    where\n      rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip)\n\n      rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> DsM (Core a)\n      rep_one_ip t n = do { MkC v  <- lookupOcc (extFieldOcc $ unLoc n)\n                          ; MkC ty <- repBangTy  t\n                          ; rep2 varBangTypeName [v,ty] }\n\nrepConstr (InfixCon st1 st2) Nothing [con]\n    = do arg1 <- repBangTy st1\n         arg2 <- repBangTy st2\n         rep2 infixCName [unC arg1, unC con, unC arg2]\n\nrepConstr (InfixCon {}) (Just _) _ =\n    panic \"repConstr: infix GADT constructor should be in a PrefixCon\"\nrepConstr _ _ _ =\n    panic \"repConstr: invariant violated\"\n\n------------ Types -------------------\n\nrepTForall :: Core [TH.TyVarBndrQ] -> Core TH.CxtQ -> Core TH.TypeQ\n           -> DsM (Core TH.TypeQ)\nrepTForall (MkC tvars) (MkC ctxt) (MkC ty)\n    = rep2 forallTName [tvars, ctxt, ty]\n\nrepTForallVis :: Core [TH.TyVarBndrQ] -> Core TH.TypeQ\n              -> DsM (Core TH.TypeQ)\nrepTForallVis (MkC tvars) (MkC ty) = rep2 forallVisTName [tvars, ty]\n\nrepTvar :: Core TH.Name -> DsM (Core TH.TypeQ)\nrepTvar (MkC s) = rep2 varTName [s]\n\nrepTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)\nrepTapp (MkC t1) (MkC t2) = rep2 appTName [t1, t2]\n\nrepTappKind :: Core TH.TypeQ -> Core TH.KindQ -> DsM (Core TH.TypeQ)\nrepTappKind (MkC ty) (MkC ki) = rep2 appKindTName [ty,ki]\n\nrepTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)\nrepTapps f []     = return f\nrepTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }\n\nrepTSig :: Core TH.TypeQ -> Core TH.KindQ -> DsM (Core TH.TypeQ)\nrepTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki]\n\nrepTequality :: DsM (Core TH.TypeQ)\nrepTequality = rep2 equalityTName []\n\nrepTPromotedList :: [Core TH.TypeQ] -> DsM (Core TH.TypeQ)\nrepTPromotedList []     = repPromotedNilTyCon\nrepTPromotedList (t:ts) = do  { tcon <- repPromotedConsTyCon\n                              ; f <- repTapp tcon t\n                              ; t' <- repTPromotedList ts\n                              ; repTapp f t'\n                              }\n\nrepTLit :: Core TH.TyLitQ -> DsM (Core TH.TypeQ)\nrepTLit (MkC lit) = rep2 litTName [lit]\n\nrepTWildCard :: DsM (Core TH.TypeQ)\nrepTWildCard = rep2 wildCardTName []\n\nrepTImplicitParam :: Core String -> Core TH.TypeQ -> DsM (Core TH.TypeQ)\nrepTImplicitParam (MkC n) (MkC e) = rep2 implicitParamTName [n, e]\n\nrepTStar :: DsM (Core TH.TypeQ)\nrepTStar = rep2 starKName []\n\nrepTConstraint :: DsM (Core TH.TypeQ)\nrepTConstraint = rep2 constraintKName []\n\n--------- Type constructors --------------\n\nrepNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)\nrepNamedTyCon (MkC s) = rep2 conTName [s]\n\nrepTInfix :: Core TH.TypeQ -> Core TH.Name -> Core TH.TypeQ\n             -> DsM (Core TH.TypeQ)\nrepTInfix (MkC t1) (MkC name) (MkC t2) = rep2 infixTName [t1,name,t2]\n\nrepTupleTyCon :: Int -> DsM (Core TH.TypeQ)\n-- Note: not Core Int; it's easier to be direct here\nrepTupleTyCon i = do dflags <- getDynFlags\n                     rep2 tupleTName [mkIntExprInt dflags i]\n\nrepUnboxedTupleTyCon :: Int -> DsM (Core TH.TypeQ)\n-- Note: not Core Int; it's easier to be direct here\nrepUnboxedTupleTyCon i = do dflags <- getDynFlags\n                            rep2 unboxedTupleTName [mkIntExprInt dflags i]\n\nrepUnboxedSumTyCon :: TH.SumArity -> DsM (Core TH.TypeQ)\n-- Note: not Core TH.SumArity; it's easier to be direct here\nrepUnboxedSumTyCon arity = do dflags <- getDynFlags\n                              rep2 unboxedSumTName [mkIntExprInt dflags arity]\n\nrepArrowTyCon :: DsM (Core TH.TypeQ)\nrepArrowTyCon = rep2 arrowTName []\n\nrepListTyCon :: DsM (Core TH.TypeQ)\nrepListTyCon = rep2 listTName []\n\nrepPromotedDataCon :: Core TH.Name -> DsM (Core TH.TypeQ)\nrepPromotedDataCon (MkC s) = rep2 promotedTName [s]\n\nrepPromotedTupleTyCon :: Int -> DsM (Core TH.TypeQ)\nrepPromotedTupleTyCon i = do dflags <- getDynFlags\n                             rep2 promotedTupleTName [mkIntExprInt dflags i]\n\nrepPromotedNilTyCon :: DsM (Core TH.TypeQ)\nrepPromotedNilTyCon = rep2 promotedNilTName []\n\nrepPromotedConsTyCon :: DsM (Core TH.TypeQ)\nrepPromotedConsTyCon = rep2 promotedConsTName []\n\n------------ TyVarBndrs -------------------\n\nrepPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndrQ)\nrepPlainTV (MkC nm) = rep2 plainTVName [nm]\n\nrepKindedTV :: Core TH.Name -> Core TH.KindQ -> DsM (Core TH.TyVarBndrQ)\nrepKindedTV (MkC nm) (MkC ki) = rep2 kindedTVName [nm, ki]\n\n----------------------------------------------------------\n--       Type family result signature\n\nrepNoSig :: DsM (Core TH.FamilyResultSigQ)\nrepNoSig = rep2 noSigName []\n\nrepKindSig :: Core TH.KindQ -> DsM (Core TH.FamilyResultSigQ)\nrepKindSig (MkC ki) = rep2 kindSigName [ki]\n\nrepTyVarSig :: Core TH.TyVarBndrQ -> DsM (Core TH.FamilyResultSigQ)\nrepTyVarSig (MkC bndr) = rep2 tyVarSigName [bndr]\n\n----------------------------------------------------------\n--              Literals\n\nrepLiteral :: HsLit GhcRn -> DsM (Core TH.Lit)\nrepLiteral (HsStringPrim _ bs)\n  = do dflags   <- getDynFlags\n       word8_ty <- lookupType word8TyConName\n       let w8s = unpack bs\n           w8s_expr = map (\\w8 -> mkCoreConApps word8DataCon\n                                  [mkWordLit dflags (toInteger w8)]) w8s\n       rep2 stringPrimLName [mkListExpr word8_ty w8s_expr]\nrepLiteral lit\n  = do lit' <- case lit of\n                   HsIntPrim _ i    -> mk_integer i\n                   HsWordPrim _ w   -> mk_integer w\n                   HsInt _ i        -> mk_integer (il_value i)\n                   HsFloatPrim _ r  -> mk_rational r\n                   HsDoublePrim _ r -> mk_rational r\n                   HsCharPrim _ c   -> mk_char c\n                   _ -> return lit\n       lit_expr <- dsLit lit'\n       case mb_lit_name of\n          Just lit_name -> rep2 lit_name [lit_expr]\n          Nothing -> notHandled \"Exotic literal\" (ppr lit)\n  where\n    mb_lit_name = case lit of\n                 HsInteger _ _ _  -> Just integerLName\n                 HsInt _ _        -> Just integerLName\n                 HsIntPrim _ _    -> Just intPrimLName\n                 HsWordPrim _ _   -> Just wordPrimLName\n                 HsFloatPrim _ _  -> Just floatPrimLName\n                 HsDoublePrim _ _ -> Just doublePrimLName\n                 HsChar _ _       -> Just charLName\n                 HsCharPrim _ _   -> Just charPrimLName\n                 HsString _ _     -> Just stringLName\n                 HsRat _ _ _      -> Just rationalLName\n                 _                -> Nothing\n\nmk_integer :: Integer -> DsM (HsLit GhcRn)\nmk_integer  i = do integer_ty <- lookupType integerTyConName\n                   return $ HsInteger NoSourceText i integer_ty\n\nmk_rational :: FractionalLit -> DsM (HsLit GhcRn)\nmk_rational r = do rat_ty <- lookupType rationalTyConName\n                   return $ HsRat noExt r rat_ty\nmk_string :: FastString -> DsM (HsLit GhcRn)\nmk_string s = return $ HsString NoSourceText s\n\nmk_char :: Char -> DsM (HsLit GhcRn)\nmk_char c = return $ HsChar NoSourceText c\n\nrepOverloadedLiteral :: HsOverLit GhcRn -> DsM (Core TH.Lit)\nrepOverloadedLiteral (OverLit { ol_val = val})\n  = do { lit <- mk_lit val; repLiteral lit }\n        -- The type Rational will be in the environment, because\n        -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,\n        -- and rationalL is sucked in when any TH stuff is used\nrepOverloadedLiteral XOverLit{} = panic \"repOverloadedLiteral\"\n\nmk_lit :: OverLitVal -> DsM (HsLit GhcRn)\nmk_lit (HsIntegral i)     = mk_integer  (il_value i)\nmk_lit (HsFractional f)   = mk_rational f\nmk_lit (HsIsString _ s)   = mk_string   s\n\nrepNameS :: Core String -> DsM (Core TH.Name)\nrepNameS (MkC name) = rep2 mkNameSName [name]\n\n--------------- Miscellaneous -------------------\n\nrepGensym :: Core String -> DsM (Core (TH.Q TH.Name))\nrepGensym (MkC lit_str) = rep2 newNameName [lit_str]\n\nrepBindQ :: Type -> Type        -- a and b\n         -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))\nrepBindQ ty_a ty_b (MkC x) (MkC y)\n  = rep2 bindQName [Type ty_a, Type ty_b, x, y]\n\nrepSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))\nrepSequenceQ ty_a (MkC list)\n  = rep2 sequenceQName [Type ty_a, list]\n\nrepUnboundVar :: Core TH.Name -> DsM (Core TH.ExpQ)\nrepUnboundVar (MkC name) = rep2 unboundVarEName [name]\n\nrepOverLabel :: FastString -> DsM (Core TH.ExpQ)\nrepOverLabel fs = do\n                    (MkC s) <- coreStringLit $ unpackFS fs\n                    rep2 labelEName [s]\n\n\n------------ Lists -------------------\n-- turn a list of patterns into a single pattern matching a list\n\nrepList :: Name -> (a  -> DsM (Core b))\n                    -> [a] -> DsM (Core [b])\nrepList tc_name f args\n  = do { args1 <- mapM f args\n       ; coreList tc_name args1 }\n\ncoreList :: Name    -- Of the TyCon of the element type\n         -> [Core a] -> DsM (Core [a])\ncoreList tc_name es\n  = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }\n\ncoreList' :: Type       -- The element type\n          -> [Core a] -> Core [a]\ncoreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))\n\nnonEmptyCoreList :: [Core a] -> Core [a]\n  -- The list must be non-empty so we can get the element type\n  -- Otherwise use coreList\nnonEmptyCoreList []           = panic \"coreList: empty argument\"\nnonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))\n\ncoreStringLit :: String -> DsM (Core String)\ncoreStringLit s = do { z <- mkStringExpr s; return(MkC z) }\n\n------------------- Maybe ------------------\n\nrepMaybe :: Name -> (a -> DsM (Core b))\n                    -> Maybe a -> DsM (Core (Maybe b))\nrepMaybe tc_name _ Nothing   = coreNothing tc_name\nrepMaybe tc_name f (Just es) = coreJust tc_name =<< f es\n\n-- | Construct Core expression for Nothing of a given type name\ncoreNothing :: Name        -- ^ Name of the TyCon of the element type\n            -> DsM (Core (Maybe a))\ncoreNothing tc_name =\n    do { elt_ty <- lookupType tc_name; return (coreNothing' elt_ty) }\n\n-- | Construct Core expression for Nothing of a given type\ncoreNothing' :: Type       -- ^ The element type\n             -> Core (Maybe a)\ncoreNothing' elt_ty = MkC (mkNothingExpr elt_ty)\n\n-- | Store given Core expression in a Just of a given type name\ncoreJust :: Name        -- ^ Name of the TyCon of the element type\n         -> Core a -> DsM (Core (Maybe a))\ncoreJust tc_name es\n  = do { elt_ty <- lookupType tc_name; return (coreJust' elt_ty es) }\n\n-- | Store given Core expression in a Just of a given type\ncoreJust' :: Type       -- ^ The element type\n          -> Core a -> Core (Maybe a)\ncoreJust' elt_ty es = MkC (mkJustExpr elt_ty (unC es))\n\n------------------- Maybe Lists ------------------\n\nrepMaybeList :: Name -> (a -> DsM (Core b))\n                        -> Maybe [a] -> DsM (Core (Maybe [b]))\nrepMaybeList tc_name _ Nothing = coreNothingList tc_name\nrepMaybeList tc_name f (Just args)\n  = do { elt_ty <- lookupType tc_name\n       ; args1 <- mapM f args\n       ; return $ coreJust' (mkListTy elt_ty) (coreList' elt_ty args1) }\n\ncoreNothingList :: Name -> DsM (Core (Maybe [a]))\ncoreNothingList tc_name\n  = do { elt_ty <- lookupType tc_name\n       ; return $ coreNothing' (mkListTy elt_ty) }\n\ncoreJustList :: Name -> Core [a] -> DsM (Core (Maybe [a]))\ncoreJustList tc_name args\n  = do { elt_ty <- lookupType tc_name\n       ; return $ coreJust' (mkListTy elt_ty) args }\n\n------------ Literals & Variables -------------------\n\ncoreIntLit :: Int -> DsM (Core Int)\ncoreIntLit i = do dflags <- getDynFlags\n                  return (MkC (mkIntExprInt dflags i))\n\ncoreVar :: Id -> Core TH.Name   -- The Id has type Name\ncoreVar id = MkC (Var id)\n\n----------------- Failure -----------------------\nnotHandledL :: SrcSpan -> String -> SDoc -> DsM a\nnotHandledL loc what doc\n  | isGoodSrcSpan loc\n  = putSrcSpanDs loc $ notHandled what doc\n  | otherwise\n  = notHandled what doc\n\nnotHandled :: String -> SDoc -> DsM a\nnotHandled what doc = failWithDs msg\n  where\n    msg = hang (text what <+> text \"not (yet) handled by Template Haskell\")\n             2 doc\n", "num_lines": 2770}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\n@DsMonad@: monadery used in desugaring\n-}\n\n{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}  -- instance MonadThings is necessarily an orphan\n{-# LANGUAGE ViewPatterns #-}\n\nmodule DsMonad (\n        DsM, mapM, mapAndUnzipM,\n        initDs, initDsTc, initTcDsForSolver, initDsWithModGuts, fixDs,\n        foldlM, foldrM, whenGOptM, unsetGOptM, unsetWOptM, xoptM,\n        Applicative(..),(<$>),\n\n        duplicateLocalDs, newSysLocalDsNoLP, newSysLocalDs,\n        newSysLocalsDsNoLP, newSysLocalsDs, newUniqueId,\n        newFailLocalDs, newPredVarDs,\n        getSrcSpanDs, putSrcSpanDs,\n        mkPrintUnqualifiedDs,\n        newUnique,\n        UniqSupply, newUniqueSupply,\n        getGhcModeDs, dsGetFamInstEnvs,\n        dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,\n        dsLookupDataCon, dsLookupConLike,\n\n        DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv,\n\n        -- Getting and setting EvVars and term constraints in local environment\n        getDictsDs, addDictsDs, getTmCsDs, addTmCsDs,\n\n        -- Iterations for pm checking\n        incrCheckPmIterDs, resetPmIterDs, dsGetCompleteMatches,\n\n        -- Warnings and errors\n        DsWarning, warnDs, warnIfSetDs, errDs, errDsCoreExpr,\n        failWithDs, failDs, discardWarningsDs,\n        askNoErrsDs,\n\n        -- Data types\n        DsMatchContext(..),\n        EquationInfo(..), MatchResult(..), DsWrapper, idDsWrapper,\n        CanItFail(..), orFail,\n\n        -- Levity polymorphism\n        dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs,\n\n        -- Trace injection\n        pprRuntimeTrace\n    ) where\n\nimport GhcPrelude\n\nimport TcRnMonad\nimport FamInstEnv\nimport CoreSyn\nimport MkCore    ( unitExpr )\nimport CoreUtils ( exprType, isExprLevPoly )\nimport HsSyn\nimport TcIface\nimport TcMType ( checkForLevPolyX, formatLevPolyErr )\nimport PrelNames\nimport RdrName\nimport HscTypes\nimport Bag\nimport BasicTypes ( Origin )\nimport DataCon\nimport ConLike\nimport TyCon\nimport PmExpr\nimport Id\nimport Module\nimport Outputable\nimport SrcLoc\nimport Type\nimport UniqSupply\nimport Name\nimport NameEnv\nimport DynFlags\nimport ErrUtils\nimport FastString\nimport Var (EvVar)\nimport UniqFM ( lookupWithDefaultUFM )\nimport Literal ( mkLitString )\nimport CostCentreState\n\nimport Data.IORef\n\n{-\n************************************************************************\n*                                                                      *\n                Data types for the desugarer\n*                                                                      *\n************************************************************************\n-}\n\ndata DsMatchContext\n  = DsMatchContext (HsMatchContext Name) SrcSpan\n  deriving ()\n\ninstance Outputable DsMatchContext where\n  ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match\n\ndata EquationInfo\n  = EqnInfo { eqn_pats :: [Pat GhcTc]\n              -- ^ The patterns for an equation\n              --\n              -- NB: We have /already/ applied 'decideBangHood' to\n              -- these patterns.  See Note [decideBangHood] in \"DsUtils\"\n\n            , eqn_orig :: Origin\n              -- ^ Was this equation present in the user source?\n              --\n              -- This helps us avoid warnings on patterns that GHC elaborated.\n              --\n              -- For instance, the pattern @-1 :: Word@ gets desugared into\n              -- @W# -1## :: Word@, but we shouldn't warn about an overflowed\n              -- literal for /both/ of these cases.\n\n            , eqn_rhs  :: MatchResult\n              -- ^ What to do after match\n            }\n\ninstance Outputable EquationInfo where\n    ppr (EqnInfo pats _ _) = ppr pats\n\ntype DsWrapper = CoreExpr -> CoreExpr\nidDsWrapper :: DsWrapper\nidDsWrapper e = e\n\n-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult\n--      \\fail. wrap (case vs of { pats -> rhs fail })\n-- where vs are not bound by wrap\n\n\n-- A MatchResult is an expression with a hole in it\ndata MatchResult\n  = MatchResult\n        CanItFail       -- Tells whether the failure expression is used\n        (CoreExpr -> DsM CoreExpr)\n                        -- Takes a expression to plug in at the\n                        -- failure point(s). The expression should\n                        -- be duplicatable!\n\ndata CanItFail = CanFail | CantFail\n\norFail :: CanItFail -> CanItFail -> CanItFail\norFail CantFail CantFail = CantFail\norFail _        _        = CanFail\n\n{-\n************************************************************************\n*                                                                      *\n                Monad functions\n*                                                                      *\n************************************************************************\n-}\n\n-- Compatibility functions\nfixDs :: (a -> DsM a) -> DsM a\nfixDs    = fixM\n\ntype DsWarning = (SrcSpan, SDoc)\n        -- Not quite the same as a WarnMsg, we have an SDoc here\n        -- and we'll do the print_unqual stuff later on to turn it\n        -- into a Doc.\n\n-- | Run a 'DsM' action inside the 'TcM' monad.\ninitDsTc :: DsM a -> TcM a\ninitDsTc thing_inside\n  = do { tcg_env  <- getGblEnv\n       ; msg_var  <- getErrsVar\n       ; hsc_env  <- getTopEnv\n       ; envs     <- mkDsEnvsFromTcGbl hsc_env msg_var tcg_env\n       ; setEnvs envs thing_inside\n       }\n\n-- | Run a 'DsM' action inside the 'IO' monad.\ninitDs :: HscEnv -> TcGblEnv -> DsM a -> IO (Messages, Maybe a)\ninitDs hsc_env tcg_env thing_inside\n  = do { msg_var <- newIORef emptyMessages\n       ; envs <- mkDsEnvsFromTcGbl hsc_env msg_var tcg_env\n       ; runDs hsc_env envs thing_inside\n       }\n\n-- | Build a set of desugarer environments derived from a 'TcGblEnv'.\nmkDsEnvsFromTcGbl :: MonadIO m\n                  => HscEnv -> IORef Messages -> TcGblEnv\n                  -> m (DsGblEnv, DsLclEnv)\nmkDsEnvsFromTcGbl hsc_env msg_var tcg_env\n  = do { pm_iter_var <- liftIO $ newIORef 0\n       ; cc_st_var   <- liftIO $ newIORef newCostCentreState\n       ; let dflags   = hsc_dflags hsc_env\n             this_mod = tcg_mod tcg_env\n             type_env = tcg_type_env tcg_env\n             rdr_env  = tcg_rdr_env tcg_env\n             fam_inst_env = tcg_fam_inst_env tcg_env\n             complete_matches = hptCompleteSigs hsc_env\n                                ++ tcg_complete_matches tcg_env\n       ; return $ mkDsEnvs dflags this_mod rdr_env type_env fam_inst_env\n                           msg_var pm_iter_var cc_st_var complete_matches\n       }\n\nrunDs :: HscEnv -> (DsGblEnv, DsLclEnv) -> DsM a -> IO (Messages, Maybe a)\nrunDs hsc_env (ds_gbl, ds_lcl) thing_inside\n  = do { res    <- initTcRnIf 'd' hsc_env ds_gbl ds_lcl\n                              (tryM thing_inside)\n       ; msgs   <- readIORef (ds_msgs ds_gbl)\n       ; let final_res\n               | errorsFound dflags msgs = Nothing\n               | Right r <- res          = Just r\n               | otherwise               = panic \"initDs\"\n       ; return (msgs, final_res)\n       }\n  where dflags = hsc_dflags hsc_env\n\n-- | Run a 'DsM' action in the context of an existing 'ModGuts'\ninitDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages, Maybe a)\ninitDsWithModGuts hsc_env guts thing_inside\n  = do { pm_iter_var <- newIORef 0\n       ; cc_st_var   <- newIORef newCostCentreState\n       ; msg_var <- newIORef emptyMessages\n       ; let dflags   = hsc_dflags hsc_env\n             type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts)\n             rdr_env  = mg_rdr_env guts\n             fam_inst_env = mg_fam_inst_env guts\n             this_mod = mg_module guts\n             complete_matches = hptCompleteSigs hsc_env\n                                ++ mg_complete_sigs guts\n\n             bindsToIds (NonRec v _)   = [v]\n             bindsToIds (Rec    binds) = map fst binds\n             ids = concatMap bindsToIds (mg_binds guts)\n\n             envs  = mkDsEnvs dflags this_mod rdr_env type_env\n                              fam_inst_env msg_var pm_iter_var\n                              cc_st_var complete_matches\n       ; runDs hsc_env envs thing_inside\n       }\n\ninitTcDsForSolver :: TcM a -> DsM (Messages, Maybe a)\n-- Spin up a TcM context so that we can run the constraint solver\n-- Returns any error messages generated by the constraint solver\n-- and (Just res) if no error happened; Nothing if an error happened\n--\n-- Simon says: I'm not very happy about this.  We spin up a complete TcM monad\n--             only to immediately refine it to a TcS monad.\n-- Better perhaps to make TcS into its own monad, rather than building on TcS\n-- But that may in turn interact with plugins\n\ninitTcDsForSolver thing_inside\n  = do { (gbl, lcl) <- getEnvs\n       ; hsc_env    <- getTopEnv\n\n       ; let DsGblEnv { ds_mod = mod\n                      , ds_fam_inst_env = fam_inst_env } = gbl\n\n             DsLclEnv { dsl_loc = loc }                  = lcl\n\n       ; liftIO $ initTc hsc_env HsSrcFile False mod loc $\n         updGblEnv (\\tc_gbl -> tc_gbl { tcg_fam_inst_env = fam_inst_env }) $\n         thing_inside }\n\nmkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv\n         -> IORef Messages -> IORef Int -> IORef CostCentreState\n         -> [CompleteMatch] -> (DsGblEnv, DsLclEnv)\nmkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var pmvar cc_st_var\n         complete_matches\n  = let if_genv = IfGblEnv { if_doc       = text \"mkDsEnvs\",\n                             if_rec_types = Just (mod, return type_env) }\n        if_lenv = mkIfLclEnv mod (text \"GHC error in desugarer lookup in\" <+> ppr mod)\n                             False -- not boot!\n        real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1)\n        completeMatchMap = mkCompleteMatchMap complete_matches\n        gbl_env = DsGblEnv { ds_mod     = mod\n                           , ds_fam_inst_env = fam_inst_env\n                           , ds_if_env  = (if_genv, if_lenv)\n                           , ds_unqual  = mkPrintUnqualified dflags rdr_env\n                           , ds_msgs    = msg_var\n                           , ds_complete_matches = completeMatchMap\n                           , ds_cc_st   = cc_st_var\n                           }\n        lcl_env = DsLclEnv { dsl_meta    = emptyNameEnv\n                           , dsl_loc     = real_span\n                           , dsl_dicts   = emptyBag\n                           , dsl_tm_cs   = emptyBag\n                           , dsl_pm_iter = pmvar\n                           }\n    in (gbl_env, lcl_env)\n\n\n{-\n************************************************************************\n*                                                                      *\n                Operations in the monad\n*                                                                      *\n************************************************************************\n\nAnd all this mysterious stuff is so we can occasionally reach out and\ngrab one or more names.  @newLocalDs@ isn't exported---exported\nfunctions are defined with it.  The difference in name-strings makes\nit easier to read debugging output.\n\nNote [Levity polymorphism checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAccording to the \"Levity Polymorphism\" paper (PLDI '17), levity\npolymorphism is forbidden in precisely two places: in the type of a bound\nterm-level argument and in the type of an argument to a function. The paper\nexplains it more fully, but briefly: expressions in these contexts need to be\nstored in registers, and it's hard (read, impossible) to store something\nthat's levity polymorphic.\n\nWe cannot check for bad levity polymorphism conveniently in the type checker,\nbecause we can't tell, a priori, which levity metavariables will be solved.\nAt one point, I (Richard) thought we could check in the zonker, but it's hard\nto know where precisely are the abstracted variables and the arguments. So\nwe check in the desugarer, the only place where we can see the Core code and\nstill report respectable syntax to the user. This covers the vast majority\nof cases; see calls to DsMonad.dsNoLevPoly and friends.\n\nLevity polymorphism is also prohibited in the types of binders, and the\ndesugarer checks for this in GHC-generated Ids. (The zonker handles\nthe user-writted ids in zonkIdBndr.) This is done in newSysLocalDsNoLP.\nThe newSysLocalDs variant is used in the vast majority of cases where\nthe binder is obviously not levity polymorphic, omitting the check.\nIt would be nice to ASSERT that there is no levity polymorphism here,\nbut we can't, because of the fixM in DsArrows. It's all OK, though:\nCore Lint will catch an error here.\n\nHowever, the desugarer is the wrong place for certain checks. In particular,\nthe desugarer can't report a sensible error message if an HsWrapper is malformed.\nAfter all, GHC itself produced the HsWrapper. So we store some message text\nin the appropriate HsWrappers (e.g. WpFun) that we can print out in the\ndesugarer.\n\nThere are a few more checks in places where Core is generated outside the\ndesugarer. For example, in datatype and class declarations, where levity\npolymorphism is checked for during validity checking. It would be nice to\nhave one central place for all this, but that doesn't seem possible while\nstill reporting nice error messages.\n\n-}\n\n-- Make a new Id with the same print name, but different type, and new unique\nnewUniqueId :: Id -> Type -> DsM Id\nnewUniqueId id = mk_local (occNameFS (nameOccName (idName id)))\n\nduplicateLocalDs :: Id -> DsM Id\nduplicateLocalDs old_local\n  = do  { uniq <- newUnique\n        ; return (setIdUnique old_local uniq) }\n\nnewPredVarDs :: PredType -> DsM Var\nnewPredVarDs pred\n = newSysLocalDs pred\n\nnewSysLocalDsNoLP, newSysLocalDs, newFailLocalDs :: Type -> DsM Id\nnewSysLocalDsNoLP  = mk_local (fsLit \"ds\")\n\n-- this variant should be used when the caller can be sure that the variable type\n-- is not levity-polymorphic. It is necessary when the type is knot-tied because\n-- of the fixM used in DsArrows. See Note [Levity polymorphism checking]\nnewSysLocalDs = mkSysLocalOrCoVarM (fsLit \"ds\")\nnewFailLocalDs = mkSysLocalOrCoVarM (fsLit \"fail\")\n  -- the fail variable is used only in a situation where we can tell that\n  -- levity-polymorphism is impossible.\n\nnewSysLocalsDsNoLP, newSysLocalsDs :: [Type] -> DsM [Id]\nnewSysLocalsDsNoLP = mapM newSysLocalDsNoLP\nnewSysLocalsDs = mapM newSysLocalDs\n\nmk_local :: FastString -> Type -> DsM Id\nmk_local fs ty = do { dsNoLevPoly ty (text \"When trying to create a variable of type:\" <+>\n                                      ppr ty)  -- could improve the msg with another\n                                               -- parameter indicating context\n                    ; mkSysLocalOrCoVarM fs ty }\n\n{-\nWe can also reach out and either set/grab location information from\nthe @SrcSpan@ being carried around.\n-}\n\ngetGhcModeDs :: DsM GhcMode\ngetGhcModeDs =  getDynFlags >>= return . ghcMode\n\n-- | Get in-scope type constraints (pm check)\ngetDictsDs :: DsM (Bag EvVar)\ngetDictsDs = do { env <- getLclEnv; return (dsl_dicts env) }\n\n-- | Add in-scope type constraints (pm check)\naddDictsDs :: Bag EvVar -> DsM a -> DsM a\naddDictsDs ev_vars\n  = updLclEnv (\\env -> env { dsl_dicts = unionBags ev_vars (dsl_dicts env) })\n\n-- | Get in-scope term constraints (pm check)\ngetTmCsDs :: DsM (Bag SimpleEq)\ngetTmCsDs = do { env <- getLclEnv; return (dsl_tm_cs env) }\n\n-- | Add in-scope term constraints (pm check)\naddTmCsDs :: Bag SimpleEq -> DsM a -> DsM a\naddTmCsDs tm_cs\n  = updLclEnv (\\env -> env { dsl_tm_cs = unionBags tm_cs (dsl_tm_cs env) })\n\n-- | Increase the counter for elapsed pattern match check iterations.\n-- If the current counter is already over the limit, fail\nincrCheckPmIterDs :: DsM Int\nincrCheckPmIterDs = do\n  env <- getLclEnv\n  cnt <- readTcRef (dsl_pm_iter env)\n  max_iters <- maxPmCheckIterations <$> getDynFlags\n  if cnt >= max_iters\n    then failM\n    else updTcRef (dsl_pm_iter env) (+1)\n  return cnt\n\n-- | Reset the counter for pattern match check iterations to zero\nresetPmIterDs :: DsM ()\nresetPmIterDs = do { env <- getLclEnv; writeTcRef (dsl_pm_iter env) 0 }\n\ngetSrcSpanDs :: DsM SrcSpan\ngetSrcSpanDs = do { env <- getLclEnv\n                  ; return (RealSrcSpan (dsl_loc env)) }\n\nputSrcSpanDs :: SrcSpan -> DsM a -> DsM a\nputSrcSpanDs (UnhelpfulSpan {}) thing_inside\n  = thing_inside\nputSrcSpanDs (RealSrcSpan real_span) thing_inside\n  = updLclEnv (\\ env -> env {dsl_loc = real_span}) thing_inside\n\n-- | Emit a warning for the current source location\n-- NB: Warns whether or not -Wxyz is set\nwarnDs :: WarnReason -> SDoc -> DsM ()\nwarnDs reason warn\n  = do { env <- getGblEnv\n       ; loc <- getSrcSpanDs\n       ; dflags <- getDynFlags\n       ; let msg = makeIntoWarning reason $\n                   mkWarnMsg dflags loc (ds_unqual env) warn\n       ; updMutVar (ds_msgs env) (\\ (w,e) -> (w `snocBag` msg, e)) }\n\n-- | Emit a warning only if the correct WarnReason is set in the DynFlags\nwarnIfSetDs :: WarningFlag -> SDoc -> DsM ()\nwarnIfSetDs flag warn\n  = whenWOptM flag $\n    warnDs (Reason flag) warn\n\nerrDs :: SDoc -> DsM ()\nerrDs err\n  = do  { env <- getGblEnv\n        ; loc <- getSrcSpanDs\n        ; dflags <- getDynFlags\n        ; let msg = mkErrMsg dflags loc (ds_unqual env) err\n        ; updMutVar (ds_msgs env) (\\ (w,e) -> (w, e `snocBag` msg)) }\n\n-- | Issue an error, but return the expression for (), so that we can continue\n-- reporting errors.\nerrDsCoreExpr :: SDoc -> DsM CoreExpr\nerrDsCoreExpr err\n  = do { errDs err\n       ; return unitExpr }\n\nfailWithDs :: SDoc -> DsM a\nfailWithDs err\n  = do  { errDs err\n        ; failM }\n\nfailDs :: DsM a\nfailDs = failM\n\n-- (askNoErrsDs m) runs m\n-- If m fails,\n--    then (askNoErrsDs m) fails\n-- If m succeeds with result r,\n--    then (askNoErrsDs m) succeeds with result (r, b),\n--         where b is True iff m generated no errors\n-- Regardless of success or failure,\n--   propagate any errors/warnings generated by m\n--\n-- c.f. TcRnMonad.askNoErrs\naskNoErrsDs :: DsM a -> DsM (a, Bool)\naskNoErrsDs thing_inside\n = do { errs_var <- newMutVar emptyMessages\n      ; env <- getGblEnv\n      ; mb_res <- tryM $  -- Be careful to catch exceptions\n                          -- so that we propagate errors correctly\n                          -- (Trac #13642)\n                  setGblEnv (env { ds_msgs = errs_var }) $\n                  thing_inside\n\n      -- Propagate errors\n      ; msgs@(warns, errs) <- readMutVar errs_var\n      ; updMutVar (ds_msgs env) (\\ (w,e) -> (w `unionBags` warns, e `unionBags` errs))\n\n      -- And return\n      ; case mb_res of\n           Left _    -> failM\n           Right res -> do { dflags <- getDynFlags\n                           ; let errs_found = errorsFound dflags msgs\n                           ; return (res, not errs_found) } }\n\nmkPrintUnqualifiedDs :: DsM PrintUnqualified\nmkPrintUnqualifiedDs = ds_unqual <$> getGblEnv\n\ninstance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where\n    lookupThing = dsLookupGlobal\n\ndsLookupGlobal :: Name -> DsM TyThing\n-- Very like TcEnv.tcLookupGlobal\ndsLookupGlobal name\n  = do  { env <- getGblEnv\n        ; setEnvs (ds_if_env env)\n                  (tcIfaceGlobal name) }\n\ndsLookupGlobalId :: Name -> DsM Id\ndsLookupGlobalId name\n  = tyThingId <$> dsLookupGlobal name\n\ndsLookupTyCon :: Name -> DsM TyCon\ndsLookupTyCon name\n  = tyThingTyCon <$> dsLookupGlobal name\n\ndsLookupDataCon :: Name -> DsM DataCon\ndsLookupDataCon name\n  = tyThingDataCon <$> dsLookupGlobal name\n\ndsLookupConLike :: Name -> DsM ConLike\ndsLookupConLike name\n  = tyThingConLike <$> dsLookupGlobal name\n\n\ndsGetFamInstEnvs :: DsM FamInstEnvs\n-- Gets both the external-package inst-env\n-- and the home-pkg inst env (includes module being compiled)\ndsGetFamInstEnvs\n  = do { eps <- getEps; env <- getGblEnv\n       ; return (eps_fam_inst_env eps, ds_fam_inst_env env) }\n\ndsGetMetaEnv :: DsM (NameEnv DsMetaVal)\ndsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) }\n\n-- | The @COMPLETE@ pragmas provided by the user for a given `TyCon`.\ndsGetCompleteMatches :: TyCon -> DsM [CompleteMatch]\ndsGetCompleteMatches tc = do\n  eps <- getEps\n  env <- getGblEnv\n  let lookup_completes ufm = lookupWithDefaultUFM ufm [] tc\n      eps_matches_list = lookup_completes $ eps_complete_matches eps\n      env_matches_list = lookup_completes $ ds_complete_matches env\n  return $ eps_matches_list ++ env_matches_list\n\ndsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)\ndsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (dsl_meta env) name) }\n\ndsExtendMetaEnv :: DsMetaEnv -> DsM a -> DsM a\ndsExtendMetaEnv menv thing_inside\n  = updLclEnv (\\env -> env { dsl_meta = dsl_meta env `plusNameEnv` menv }) thing_inside\n\ndiscardWarningsDs :: DsM a -> DsM a\n-- Ignore warnings inside the thing inside;\n-- used to ignore inaccessable cases etc. inside generated code\ndiscardWarningsDs thing_inside\n  = do  { env <- getGblEnv\n        ; old_msgs <- readTcRef (ds_msgs env)\n\n        ; result <- thing_inside\n\n        -- Revert messages to old_msgs\n        ; writeTcRef (ds_msgs env) old_msgs\n\n        ; return result }\n\n-- | Fail with an error message if the type is levity polymorphic.\ndsNoLevPoly :: Type -> SDoc -> DsM ()\n-- See Note [Levity polymorphism checking]\ndsNoLevPoly ty doc = checkForLevPolyX errDs doc ty\n\n-- | Check an expression for levity polymorphism, failing if it is\n-- levity polymorphic.\ndsNoLevPolyExpr :: CoreExpr -> SDoc -> DsM ()\n-- See Note [Levity polymorphism checking]\ndsNoLevPolyExpr e doc\n  | isExprLevPoly e = errDs (formatLevPolyErr (exprType e) $$ doc)\n  | otherwise       = return ()\n\n-- | Runs the thing_inside. If there are no errors, then returns the expr\n-- given. Otherwise, returns unitExpr. This is useful for doing a bunch\n-- of levity polymorphism checks and then avoiding making a core App.\n-- (If we make a core App on a levity polymorphic argument, detecting how\n-- to handle the let/app invariant might call isUnliftedType, which panics\n-- on a levity polymorphic type.)\n-- See #12709 for an example of why this machinery is necessary.\ndsWhenNoErrs :: DsM a -> (a -> CoreExpr) -> DsM CoreExpr\ndsWhenNoErrs thing_inside mk_expr\n  = do { (result, no_errs) <- askNoErrsDs thing_inside\n       ; return $ if no_errs\n                  then mk_expr result\n                  else unitExpr }\n\n-- | Inject a trace message into the compiled program. Whereas\n-- pprTrace prints out information *while compiling*, pprRuntimeTrace\n-- captures that information and causes it to be printed *at runtime*\n-- using Debug.Trace.trace.\n--\n--   pprRuntimeTrace hdr doc expr\n--\n-- will produce an expression that looks like\n--\n--   trace (hdr + doc) expr\n--\n-- When using this to debug a module that Debug.Trace depends on,\n-- it is necessary to import {-# SOURCE #-} Debug.Trace () in that\n-- module. We could avoid this inconvenience by wiring in Debug.Trace.trace,\n-- but that doesn't seem worth the effort and maintenance cost.\npprRuntimeTrace :: String   -- ^ header\n                -> SDoc     -- ^ information to output\n                -> CoreExpr -- ^ expression\n                -> DsM CoreExpr\npprRuntimeTrace str doc expr = do\n  traceId <- dsLookupGlobalId traceName\n  unpackCStringId <- dsLookupGlobalId unpackCStringName\n  dflags <- getDynFlags\n  let message :: CoreExpr\n      message = App (Var unpackCStringId) $\n                Lit $ mkLitString $ showSDoc dflags (hang (text str) 4 doc)\n  return $ mkApps (Var traceId) [Type (exprType expr), message, expr]\n", "num_lines": 629}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule DsUsage (\n    -- * Dependency/fingerprinting code (used by MkIface)\n    mkUsageInfo, mkUsedNames, mkDependencies\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport HscTypes\nimport TcRnTypes\nimport Name\nimport NameSet\nimport Module\nimport Outputable\nimport Util\nimport UniqSet\nimport UniqFM\nimport Fingerprint\nimport Maybes\nimport Packages\nimport Finder\n\nimport Control.Monad (filterM)\nimport Data.List\nimport Data.IORef\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport System.Directory\nimport System.FilePath\n\n{- Note [Module self-dependency]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nRnNames.calculateAvails asserts the invariant that a module must not occur in\nits own dep_orphs or dep_finsts. However, if we aren't careful this can occur\nin the presence of hs-boot files: Consider that we have two modules, A and B,\nboth with hs-boot files,\n\n    A.hs contains a SOURCE import of B B.hs-boot contains a SOURCE import of A\n    A.hs-boot declares an orphan instance A.hs defines the orphan instance\n\nIn this case, B's dep_orphs will contain A due to its SOURCE import of A.\nConsequently, A will contain itself in its imp_orphs due to its import of B.\nThis fact would end up being recorded in A's interface file. This would then\nbreak the invariant asserted by calculateAvails that a module does not itself in\nits dep_orphs. This was the cause of Trac #14128.\n\n-}\n\n-- | Extract information from the rename and typecheck phases to produce\n-- a dependencies information for the module being compiled.\n--\n-- The first argument is additional dependencies from plugins\nmkDependencies :: InstalledUnitId -> [Module] -> TcGblEnv -> IO Dependencies\nmkDependencies iuid pluginModules\n          (TcGblEnv{ tcg_mod = mod,\n                    tcg_imports = imports,\n                    tcg_th_used = th_var\n                  })\n = do\n      -- Template Haskell used?\n      let (dep_plgins, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]\n          plugin_dep_pkgs = filter (/= iuid) (map (toInstalledUnitId . moduleUnitId) ms)\n      th_used <- readIORef th_var\n      let dep_mods = modDepsElts (delFromUFM (imp_dep_mods imports)\n                                             (moduleName mod))\n                -- M.hi-boot can be in the imp_dep_mods, but we must remove\n                -- it before recording the modules on which this one depends!\n                -- (We want to retain M.hi-boot in imp_dep_mods so that\n                --  loadHiBootInterface can see if M's direct imports depend\n                --  on M.hi-boot, and hence that we should do the hi-boot consistency\n                --  check.)\n\n          dep_orphs = filter (/= mod) (imp_orphs imports)\n                -- We must also remove self-references from imp_orphs. See\n                -- Note [Module self-dependency]\n\n          raw_pkgs = foldr Set.insert (imp_dep_pkgs imports) plugin_dep_pkgs\n\n          pkgs | th_used   = Set.insert (toInstalledUnitId thUnitId) raw_pkgs\n               | otherwise = raw_pkgs\n\n          -- Set the packages required to be Safe according to Safe Haskell.\n          -- See Note [RnNames . Tracking Trust Transitively]\n          sorted_pkgs = sort (Set.toList pkgs)\n          trust_pkgs  = imp_trust_pkgs imports\n          dep_pkgs'   = map (\\x -> (x, x `Set.member` trust_pkgs)) sorted_pkgs\n\n      return Deps { dep_mods   = dep_mods,\n                    dep_pkgs   = dep_pkgs',\n                    dep_orphs  = dep_orphs,\n                    dep_plgins = dep_plgins,\n                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }\n                    -- sort to get into canonical order\n                    -- NB. remember to use lexicographic ordering\n\nmkUsedNames :: TcGblEnv -> NameSet\nmkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus\n\nmkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath]\n            -> [(Module, Fingerprint)] -> [ModIface] -> IO [Usage]\nmkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged\n  pluginModules\n  = do\n    eps <- hscEPS hsc_env\n    hashes <- mapM getFileHash dependent_files\n    plugin_usages <- mapM (mkPluginUsage hsc_env) pluginModules\n    let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod\n                                       dir_imp_mods used_names\n        usages = mod_usages ++ [ UsageFile { usg_file_path = f\n                                           , usg_file_hash = hash }\n                               | (f, hash) <- zip dependent_files hashes ]\n                            ++ [ UsageMergedRequirement\n                                    { usg_mod = mod,\n                                      usg_mod_hash = hash\n                                    }\n                               | (mod, hash) <- merged ]\n                            ++ concat plugin_usages\n    usages `seqList` return usages\n    -- seq the list of Usages returned: occasionally these\n    -- don't get evaluated for a while and we can end up hanging on to\n    -- the entire collection of Ifaces.\n\n{- Note [Plugin dependencies]\nModules for which plugins were used in the compilation process, should be\nrecompiled whenever one of those plugins changes. But how do we know if a\nplugin changed from the previous time a module was compiled?\n\nWe could try storing the fingerprints of the interface files of plugins in\nthe interface file of the module. And see if there are changes between\ncompilation runs. However, this is pretty much a non-option because interface\nfingerprints of plugin modules are fairly stable, unless you compile plugins\nwith optimisations turned on, and give basically all binders an INLINE pragma.\n\nSo instead:\n\n  * For plugins that were built locally: we store the filepath and hash of the\n    object files of the module with the `plugin` binder, and the object files of\n    modules that are dependencies of the plugin module and belong to the same\n    `UnitId` as the plugin\n  * For plugins in an external package: we store the filepath and hash of\n    the dynamic library containing the plugin module.\n\nDuring recompilation we then compare the hashes of those files again to see\nif anything has changed.\n\nOne issue with this approach is that object files are currently (GHC 8.6.1)\nnot created fully deterministicly, which could sometimes induce accidental\nrecompilation of a module for which plugins were used in the compile process.\n\nOne way to improve this is to either:\n\n  * Have deterministic object file creation\n  * Create and store implementation hashes, which would be based on the Core\n    of the module and the implementation hashes of its dependencies, and then\n    compare implementation hashes for recompilation. Creation of implementation\n    hashes is however potentially expensive.\n-}\nmkPluginUsage :: HscEnv -> ModIface -> IO [Usage]\nmkPluginUsage hsc_env pluginModule\n  = case lookupPluginModuleWithSuggestions dflags pNm Nothing of\n    LookupFound _ pkg -> do\n    -- The plugin is from an external package:\n    -- search for the library files containing the plugin.\n      let searchPaths = collectLibraryPaths dflags [pkg]\n          useDyn = WayDyn `elem` ways dflags\n          suffix = if useDyn then soExt platform else \"a\"\n          libLocs = [ searchPath </> \"lib\" ++ libLoc <.> suffix\n                    | searchPath <- searchPaths\n                    , libLoc     <- packageHsLibs dflags pkg\n                    ]\n          -- we also try to find plugin library files by adding WayDyn way,\n          -- if it isn't already present (see trac #15492)\n          paths =\n            if useDyn\n              then libLocs\n              else\n                let dflags'  = updateWays (addWay' WayDyn dflags)\n                    dlibLocs = [ searchPath </> mkHsSOName platform dlibLoc\n                               | searchPath <- searchPaths\n                               , dlibLoc    <- packageHsLibs dflags' pkg\n                               ]\n                in libLocs ++ dlibLocs\n      files <- filterM doesFileExist paths\n      case files of\n        [] ->\n          pprPanic\n             ( \"mkPluginUsage: missing plugin library, tried:\\n\"\n              ++ unlines paths\n             )\n             (ppr pNm)\n        _  -> mapM hashFile (nub files)\n    _ -> do\n      foundM <- findPluginModule hsc_env pNm\n      case foundM of\n      -- The plugin was built locally: look up the object file containing\n      -- the `plugin` binder, and all object files belong to modules that are\n      -- transitive dependencies of the plugin that belong to the same package.\n        Found ml _ -> do\n          pluginObject <- hashFile (ml_obj_file ml)\n          depObjects   <- catMaybes <$> mapM lookupObjectFile deps\n          return (nub (pluginObject : depObjects))\n        _ -> pprPanic \"mkPluginUsage: no object file found\" (ppr pNm)\n  where\n    dflags   = hsc_dflags hsc_env\n    platform = targetPlatform dflags\n    pNm      = moduleName (mi_module pluginModule)\n    pPkg     = moduleUnitId (mi_module pluginModule)\n    deps     = map fst (dep_mods (mi_deps pluginModule))\n\n    -- Lookup object file for a plugin dependency,\n    -- from the same package as the plugin.\n    lookupObjectFile nm = do\n      foundM <- findImportedModule hsc_env nm Nothing\n      case foundM of\n        Found ml m\n          | moduleUnitId m == pPkg -> Just <$> hashFile (ml_obj_file ml)\n          | otherwise              -> return Nothing\n        _ -> pprPanic \"mkPluginUsage: no object for dependency\"\n                      (ppr pNm <+> ppr nm)\n\n    hashFile f = do\n      fExist <- doesFileExist f\n      if fExist\n         then do\n            h <- getFileHash f\n            return (UsageFile f h)\n         else pprPanic \"mkPluginUsage: file not found\" (ppr pNm <+> text f)\n\nmk_mod_usage_info :: PackageIfaceTable\n              -> HscEnv\n              -> Module\n              -> ImportedMods\n              -> NameSet\n              -> [Usage]\nmk_mod_usage_info pit hsc_env this_mod direct_imports used_names\n  = mapMaybe mkUsage usage_mods\n  where\n    hpt = hsc_HPT hsc_env\n    dflags = hsc_dflags hsc_env\n    this_pkg = thisPackage dflags\n\n    used_mods    = moduleEnvKeys ent_map\n    dir_imp_mods = moduleEnvKeys direct_imports\n    all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods\n    usage_mods   = sortBy stableModuleCmp all_mods\n                        -- canonical order is imported, to avoid interface-file\n                        -- wobblage.\n\n    -- ent_map groups together all the things imported and used\n    -- from a particular module\n    ent_map :: ModuleEnv [OccName]\n    ent_map  = nonDetFoldUniqSet add_mv emptyModuleEnv used_names\n     -- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName\n     -- in ent_hashs\n     where\n      add_mv name mv_map\n        | isWiredInName name = mv_map  -- ignore wired-in names\n        | otherwise\n        = case nameModule_maybe name of\n             Nothing  -> ASSERT2( isSystemName name, ppr name ) mv_map\n                -- See Note [Internal used_names]\n\n             Just mod ->\n                -- See Note [Identity versus semantic module]\n                let mod' = if isHoleModule mod\n                            then mkModule this_pkg (moduleName mod)\n                            else mod\n                -- This lambda function is really just a\n                -- specialised (++); originally came about to\n                -- avoid quadratic behaviour (trac #2680)\n                in extendModuleEnvWith (\\_ xs -> occ:xs) mv_map mod' [occ]\n            where occ = nameOccName name\n\n    -- We want to create a Usage for a home module if\n    --  a) we used something from it; has something in used_names\n    --  b) we imported it, even if we used nothing from it\n    --     (need to recompile if its export list changes: export_fprint)\n    mkUsage :: Module -> Maybe Usage\n    mkUsage mod\n      | isNothing maybe_iface           -- We can't depend on it if we didn't\n                                        -- load its interface.\n      || mod == this_mod                -- We don't care about usages of\n                                        -- things in *this* module\n      = Nothing\n\n      | moduleUnitId mod /= this_pkg\n      = Just UsagePackageModule{ usg_mod      = mod,\n                                 usg_mod_hash = mod_hash,\n                                 usg_safe     = imp_safe }\n        -- for package modules, we record the module hash only\n\n      | (null used_occs\n          && isNothing export_hash\n          && not is_direct_import\n          && not finsts_mod)\n      = Nothing                 -- Record no usage info\n        -- for directly-imported modules, we always want to record a usage\n        -- on the orphan hash.  This is what triggers a recompilation if\n        -- an orphan is added or removed somewhere below us in the future.\n\n      | otherwise\n      = Just UsageHomeModule {\n                      usg_mod_name = moduleName mod,\n                      usg_mod_hash = mod_hash,\n                      usg_exports  = export_hash,\n                      usg_entities = Map.toList ent_hashs,\n                      usg_safe     = imp_safe }\n      where\n        maybe_iface  = lookupIfaceByModule dflags hpt pit mod\n                -- In one-shot mode, the interfaces for home-package\n                -- modules accumulate in the PIT not HPT.  Sigh.\n\n        Just iface   = maybe_iface\n        finsts_mod   = mi_finsts    iface\n        hash_env     = mi_hash_fn   iface\n        mod_hash     = mi_mod_hash  iface\n        export_hash | depend_on_exports = Just (mi_exp_hash iface)\n                    | otherwise         = Nothing\n\n        by_is_safe (ImportedByUser imv) = imv_is_safe imv\n        by_is_safe _ = False\n        (is_direct_import, imp_safe)\n            = case lookupModuleEnv direct_imports mod of\n                -- ezyang: I'm not sure if any is the correct\n                -- metric here. If safety was guaranteed to be uniform\n                -- across all imports, why did the old code only look\n                -- at the first import?\n                Just bys -> (True, any by_is_safe bys)\n                Nothing  -> (False, safeImplicitImpsReq dflags)\n                -- Nothing case is for references to entities which were\n                -- not directly imported (NB: the \"implicit\" Prelude import\n                -- counts as directly imported!  An entity is not directly\n                -- imported if, e.g., we got a reference to it from a\n                -- reexport of another module.)\n\n        used_occs = lookupModuleEnv ent_map mod `orElse` []\n\n        -- Making a Map here ensures that (a) we remove duplicates\n        -- when we have usages on several subordinates of a single parent,\n        -- and (b) that the usages emerge in a canonical order, which\n        -- is why we use Map rather than OccEnv: Map works\n        -- using Ord on the OccNames, which is a lexicographic ordering.\n        ent_hashs :: Map OccName Fingerprint\n        ent_hashs = Map.fromList (map lookup_occ used_occs)\n\n        lookup_occ occ =\n            case hash_env occ of\n                Nothing -> pprPanic \"mkUsage\" (ppr mod <+> ppr occ <+> ppr used_names)\n                Just r  -> r\n\n        depend_on_exports = is_direct_import\n        {- True\n              Even if we used 'import M ()', we have to register a\n              usage on the export list because we are sensitive to\n              changes in orphan instances/rules.\n           False\n              In GHC 6.8.x we always returned true, and in\n              fact it recorded a dependency on *all* the\n              modules underneath in the dependency tree.  This\n              happens to make orphans work right, but is too\n              expensive: it'll read too many interface files.\n              The 'isNothing maybe_iface' check above saved us\n              from generating many of these usages (at least in\n              one-shot mode), but that's even more bogus!\n        -}\n", "num_lines": 374}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nUtilities for desugaring\n\nThis module exports some utility functions of no great interest.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\n-- | Utility functions for constructing Core syntax, principally for desugaring\nmodule DsUtils (\n        EquationInfo(..),\n        firstPat, shiftEqns,\n\n        MatchResult(..), CanItFail(..), CaseAlt(..),\n        cantFailMatchResult, alwaysFailMatchResult,\n        extractMatchResult, combineMatchResults,\n        adjustMatchResult,  adjustMatchResultDs,\n        mkCoLetMatchResult, mkViewMatchResult, mkGuardedMatchResult,\n        matchCanFail, mkEvalMatchResult,\n        mkCoPrimCaseMatchResult, mkCoAlgCaseMatchResult, mkCoSynCaseMatchResult,\n        wrapBind, wrapBinds,\n\n        mkErrorAppDs, mkCoreAppDs, mkCoreAppsDs, mkCastDs,\n\n        seqVar,\n\n        -- LHs tuples\n        mkLHsVarPatTup, mkLHsPatTup, mkVanillaTuplePat,\n        mkBigLHsVarTupId, mkBigLHsTupId, mkBigLHsVarPatTupId, mkBigLHsPatTupId,\n\n        mkSelectorBinds,\n\n        selectSimpleMatchVarL, selectMatchVars, selectMatchVar,\n        mkOptTickBox, mkBinaryTickBox, decideBangHood, addBang,\n        isTrueLHsExpr\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} Match  ( matchSimply )\nimport {-# SOURCE #-} DsExpr ( dsLExpr )\n\nimport HsSyn\nimport TcHsSyn\nimport TcType( tcSplitTyConApp )\nimport CoreSyn\nimport DsMonad\n\nimport CoreUtils\nimport MkCore\nimport MkId\nimport Id\nimport Literal\nimport TyCon\nimport DataCon\nimport PatSyn\nimport Type\nimport Coercion\nimport TysPrim\nimport TysWiredIn\nimport BasicTypes\nimport ConLike\nimport UniqSet\nimport UniqSupply\nimport Module\nimport PrelNames\nimport Name( isInternalName )\nimport Outputable\nimport SrcLoc\nimport Util\nimport DynFlags\nimport FastString\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport TcEvidence\n\nimport Control.Monad    ( zipWithM )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{ Selecting match variables}\n*                                                                      *\n************************************************************************\n\nWe're about to match against some patterns.  We want to make some\n@Ids@ to use as match variables.  If a pattern has an @Id@ readily at\nhand, which should indeed be bound to the pattern as a whole, then use it;\notherwise, make one up.\n-}\n\nselectSimpleMatchVarL :: LPat GhcTc -> DsM Id\n-- Postcondition: the returned Id has an Internal Name\nselectSimpleMatchVarL pat = selectMatchVar (unLoc pat)\n\n-- (selectMatchVars ps tys) chooses variables of type tys\n-- to use for matching ps against.  If the pattern is a variable,\n-- we try to use that, to save inventing lots of fresh variables.\n--\n-- OLD, but interesting note:\n--    But even if it is a variable, its type might not match.  Consider\n--      data T a where\n--        T1 :: Int -> T Int\n--        T2 :: a   -> T a\n--\n--      f :: T a -> a -> Int\n--      f (T1 i) (x::Int) = x\n--      f (T2 i) (y::a)   = 0\n--    Then we must not choose (x::Int) as the matching variable!\n-- And nowadays we won't, because the (x::Int) will be wrapped in a CoPat\n\nselectMatchVars :: [Pat GhcTc] -> DsM [Id]\n-- Postcondition: the returned Ids have Internal Names\nselectMatchVars ps = mapM selectMatchVar ps\n\nselectMatchVar :: Pat GhcTc -> DsM Id\n-- Postcondition: the returned Id has an Internal Name\nselectMatchVar (BangPat _ pat) = selectMatchVar (unLoc pat)\nselectMatchVar (LazyPat _ pat) = selectMatchVar (unLoc pat)\nselectMatchVar (ParPat _ pat)  = selectMatchVar (unLoc pat)\nselectMatchVar (VarPat _ var)  = return (localiseId (unLoc var))\n                                  -- Note [Localise pattern binders]\nselectMatchVar (AsPat _ var _) = return (unLoc var)\nselectMatchVar other_pat       = newSysLocalDsNoLP (hsPatType other_pat)\n                                  -- OK, better make up one...\n\n{- Note [Localise pattern binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider     module M where\n               [Just a] = e\nAfter renaming it looks like\n             module M where\n               [Just M.a] = e\n\nWe don't generalise, since it's a pattern binding, monomorphic, etc,\nso after desugaring we may get something like\n             M.a = case e of (v:_) ->\n                   case v of Just M.a -> M.a\nNotice the \"M.a\" in the pattern; after all, it was in the original\npattern.  However, after optimisation those pattern binders can become\nlet-binders, and then end up floated to top level.  They have a\ndifferent *unique* by then (the simplifier is good about maintaining\nproper scoping), but it's BAD to have two top-level bindings with the\nExternal Name M.a, because that turns into two linker symbols for M.a.\nIt's quite rare for this to actually *happen* -- the only case I know\nof is tc003 compiled with the 'hpc' way -- but that only makes it\nall the more annoying.\n\nTo avoid this, we craftily call 'localiseId' in the desugarer, which\nsimply turns the External Name for the Id into an Internal one, but\ndoesn't change the unique.  So the desugarer produces this:\n             M.a{r8} = case e of (v:_) ->\n                       case v of Just a{r8} -> M.a{r8}\nThe unique is still 'r8', but the binding site in the pattern\nis now an Internal Name.  Now the simplifier's usual mechanisms\nwill propagate that Name to all the occurrence sites, as well as\nun-shadowing it, so we'll get\n             M.a{r8} = case e of (v:_) ->\n                       case v of Just a{s77} -> a{s77}\nIn fact, even CoreSubst.simplOptExpr will do this, and simpleOptExpr\nruns on the output of the desugarer, so all is well by the end of\nthe desugaring pass.\n\nSee also Note [MatchIds] in Match.hs\n\n************************************************************************\n*                                                                      *\n* type synonym EquationInfo and access functions for its pieces        *\n*                                                                      *\n************************************************************************\n\\subsection[EquationInfo-synonym]{@EquationInfo@: a useful synonym}\n\nThe ``equation info'' used by @match@ is relatively complicated and\nworthy of a type synonym and a few handy functions.\n-}\n\nfirstPat :: EquationInfo -> Pat GhcTc\nfirstPat eqn = ASSERT( notNull (eqn_pats eqn) ) head (eqn_pats eqn)\n\nshiftEqns :: [EquationInfo] -> [EquationInfo]\n-- Drop the first pattern in each equation\nshiftEqns eqns = [ eqn { eqn_pats = tail (eqn_pats eqn) } | eqn <- eqns ]\n\n-- Functions on MatchResults\n\nmatchCanFail :: MatchResult -> Bool\nmatchCanFail (MatchResult CanFail _)  = True\nmatchCanFail (MatchResult CantFail _) = False\n\nalwaysFailMatchResult :: MatchResult\nalwaysFailMatchResult = MatchResult CanFail (\\fail -> return fail)\n\ncantFailMatchResult :: CoreExpr -> MatchResult\ncantFailMatchResult expr = MatchResult CantFail (\\_ -> return expr)\n\nextractMatchResult :: MatchResult -> CoreExpr -> DsM CoreExpr\nextractMatchResult (MatchResult CantFail match_fn) _\n  = match_fn (error \"It can't fail!\")\n\nextractMatchResult (MatchResult CanFail match_fn) fail_expr = do\n    (fail_bind, if_it_fails) <- mkFailurePair fail_expr\n    body <- match_fn if_it_fails\n    return (mkCoreLet fail_bind body)\n\n\ncombineMatchResults :: MatchResult -> MatchResult -> MatchResult\ncombineMatchResults (MatchResult CanFail      body_fn1)\n                    (MatchResult can_it_fail2 body_fn2)\n  = MatchResult can_it_fail2 body_fn\n  where\n    body_fn fail = do body2 <- body_fn2 fail\n                      (fail_bind, duplicatable_expr) <- mkFailurePair body2\n                      body1 <- body_fn1 duplicatable_expr\n                      return (Let fail_bind body1)\n\ncombineMatchResults match_result1@(MatchResult CantFail _) _\n  = match_result1\n\nadjustMatchResult :: DsWrapper -> MatchResult -> MatchResult\nadjustMatchResult encl_fn (MatchResult can_it_fail body_fn)\n  = MatchResult can_it_fail (\\fail -> encl_fn <$> body_fn fail)\n\nadjustMatchResultDs :: (CoreExpr -> DsM CoreExpr) -> MatchResult -> MatchResult\nadjustMatchResultDs encl_fn (MatchResult can_it_fail body_fn)\n  = MatchResult can_it_fail (\\fail -> encl_fn =<< body_fn fail)\n\nwrapBinds :: [(Var,Var)] -> CoreExpr -> CoreExpr\nwrapBinds [] e = e\nwrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e)\n\nwrapBind :: Var -> Var -> CoreExpr -> CoreExpr\nwrapBind new old body   -- NB: this function must deal with term\n  | new==old    = body  -- variables, type variables or coercion variables\n  | otherwise   = Let (NonRec new (varToCoreExpr old)) body\n\nseqVar :: Var -> CoreExpr -> CoreExpr\nseqVar var body = Case (Var var) var (exprType body)\n                        [(DEFAULT, [], body)]\n\nmkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult\nmkCoLetMatchResult bind = adjustMatchResult (mkCoreLet bind)\n\n-- (mkViewMatchResult var' viewExpr mr) makes the expression\n-- let var' = viewExpr in mr\nmkViewMatchResult :: Id -> CoreExpr -> MatchResult -> MatchResult\nmkViewMatchResult var' viewExpr =\n    adjustMatchResult (mkCoreLet (NonRec var' viewExpr))\n\nmkEvalMatchResult :: Id -> Type -> MatchResult -> MatchResult\nmkEvalMatchResult var ty\n  = adjustMatchResult (\\e -> Case (Var var) var ty [(DEFAULT, [], e)])\n\nmkGuardedMatchResult :: CoreExpr -> MatchResult -> MatchResult\nmkGuardedMatchResult pred_expr (MatchResult _ body_fn)\n  = MatchResult CanFail (\\fail -> do body <- body_fn fail\n                                     return (mkIfThenElse pred_expr body fail))\n\nmkCoPrimCaseMatchResult :: Id                  -- Scrutinee\n                        -> Type                      -- Type of the case\n                        -> [(Literal, MatchResult)]  -- Alternatives\n                        -> MatchResult               -- Literals are all unlifted\nmkCoPrimCaseMatchResult var ty match_alts\n  = MatchResult CanFail mk_case\n  where\n    mk_case fail = do\n        alts <- mapM (mk_alt fail) sorted_alts\n        return (Case (Var var) var ty ((DEFAULT, [], fail) : alts))\n\n    sorted_alts = sortWith fst match_alts       -- Right order for a Case\n    mk_alt fail (lit, MatchResult _ body_fn)\n       = ASSERT( not (litIsLifted lit) )\n         do body <- body_fn fail\n            return (LitAlt lit, [], body)\n\ndata CaseAlt a = MkCaseAlt{ alt_pat :: a,\n                            alt_bndrs :: [Var],\n                            alt_wrapper :: HsWrapper,\n                            alt_result :: MatchResult }\n\nmkCoAlgCaseMatchResult\n  :: Id                 -- Scrutinee\n  -> Type               -- Type of exp\n  -> [CaseAlt DataCon]  -- Alternatives (bndrs *include* tyvars, dicts)\n  -> MatchResult\nmkCoAlgCaseMatchResult var ty match_alts\n  | isNewtype  -- Newtype case; use a let\n  = ASSERT( null (tail match_alts) && null (tail arg_ids1) )\n    mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1\n\n  | otherwise\n  = mkDataConCase var ty match_alts\n  where\n    isNewtype = isNewTyCon (dataConTyCon (alt_pat alt1))\n\n        -- [Interesting: because of GADTs, we can't rely on the type of\n        --  the scrutinised Id to be sufficiently refined to have a TyCon in it]\n\n    alt1@MkCaseAlt{ alt_bndrs = arg_ids1, alt_result = match_result1 }\n      = ASSERT( notNull match_alts ) head match_alts\n    -- Stuff for newtype\n    arg_id1       = ASSERT( notNull arg_ids1 ) head arg_ids1\n    var_ty        = idType var\n    (tc, ty_args) = tcSplitTyConApp var_ty      -- Don't look through newtypes\n                                                -- (not that splitTyConApp does, these days)\n    newtype_rhs = unwrapNewTypeBody tc ty_args (Var var)\n\nmkCoSynCaseMatchResult :: Id -> Type -> CaseAlt PatSyn -> MatchResult\nmkCoSynCaseMatchResult var ty alt = MatchResult CanFail $ mkPatSynCase var ty alt\n\nsort_alts :: [CaseAlt DataCon] -> [CaseAlt DataCon]\nsort_alts = sortWith (dataConTag . alt_pat)\n\nmkPatSynCase :: Id -> Type -> CaseAlt PatSyn -> CoreExpr -> DsM CoreExpr\nmkPatSynCase var ty alt fail = do\n    matcher <- dsLExpr $ mkLHsWrap wrapper $\n                         nlHsTyApp matcher [getRuntimeRep ty, ty]\n    let MatchResult _ mkCont = match_result\n    cont <- mkCoreLams bndrs <$> mkCont fail\n    return $ mkCoreAppsDs (text \"patsyn\" <+> ppr var) matcher [Var var, ensure_unstrict cont, Lam voidArgId fail]\n  where\n    MkCaseAlt{ alt_pat = psyn,\n               alt_bndrs = bndrs,\n               alt_wrapper = wrapper,\n               alt_result = match_result} = alt\n    (matcher, needs_void_lam) = patSynMatcher psyn\n\n    -- See Note [Matchers and builders for pattern synonyms] in PatSyns\n    -- on these extra Void# arguments\n    ensure_unstrict cont | needs_void_lam = Lam voidArgId cont\n                         | otherwise      = cont\n\nmkDataConCase :: Id -> Type -> [CaseAlt DataCon] -> MatchResult\nmkDataConCase _   _  []            = panic \"mkDataConCase: no alternatives\"\nmkDataConCase var ty alts@(alt1:_) = MatchResult fail_flag mk_case\n  where\n    con1          = alt_pat alt1\n    tycon         = dataConTyCon con1\n    data_cons     = tyConDataCons tycon\n    match_results = map alt_result alts\n\n    sorted_alts :: [CaseAlt DataCon]\n    sorted_alts  = sort_alts alts\n\n    var_ty       = idType var\n    (_, ty_args) = tcSplitTyConApp var_ty -- Don't look through newtypes\n                                          -- (not that splitTyConApp does, these days)\n\n    mk_case :: CoreExpr -> DsM CoreExpr\n    mk_case fail = do\n        alts <- mapM (mk_alt fail) sorted_alts\n        return $ mkWildCase (Var var) (idType var) ty (mk_default fail ++ alts)\n\n    mk_alt :: CoreExpr -> CaseAlt DataCon -> DsM CoreAlt\n    mk_alt fail MkCaseAlt{ alt_pat = con,\n                           alt_bndrs = args,\n                           alt_result = MatchResult _ body_fn }\n      = do { body <- body_fn fail\n           ; case dataConBoxer con of {\n                Nothing -> return (DataAlt con, args, body) ;\n                Just (DCB boxer) ->\n        do { us <- newUniqueSupply\n           ; let (rep_ids, binds) = initUs_ us (boxer ty_args args)\n           ; return (DataAlt con, rep_ids, mkLets binds body) } } }\n\n    mk_default :: CoreExpr -> [CoreAlt]\n    mk_default fail | exhaustive_case = []\n                    | otherwise       = [(DEFAULT, [], fail)]\n\n    fail_flag :: CanItFail\n    fail_flag | exhaustive_case\n              = foldr orFail CantFail [can_it_fail | MatchResult can_it_fail _ <- match_results]\n              | otherwise\n              = CanFail\n\n    mentioned_constructors = mkUniqSet $ map alt_pat alts\n    un_mentioned_constructors\n        = mkUniqSet data_cons `minusUniqSet` mentioned_constructors\n    exhaustive_case = isEmptyUniqSet un_mentioned_constructors\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Desugarer's versions of some Core functions}\n*                                                                      *\n************************************************************************\n-}\n\nmkErrorAppDs :: Id              -- The error function\n             -> Type            -- Type to which it should be applied\n             -> SDoc            -- The error message string to pass\n             -> DsM CoreExpr\n\nmkErrorAppDs err_id ty msg = do\n    src_loc <- getSrcSpanDs\n    dflags <- getDynFlags\n    let\n        full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])\n        core_msg = Lit (mkLitString full_msg)\n        -- mkLitString returns a result of type String#\n    return (mkApps (Var err_id) [Type (getRuntimeRep ty), Type ty, core_msg])\n\n{-\n'mkCoreAppDs' and 'mkCoreAppsDs' hand the special-case desugaring of 'seq'.\n\nNote [Desugaring seq (1)]  cf Trac #1031\n~~~~~~~~~~~~~~~~~~~~~~~~~\n   f x y = x `seq` (y `seq` (# x,y #))\n\nThe [CoreSyn let/app invariant] means that, other things being equal, because\nthe argument to the outer 'seq' has an unlifted type, we'll use call-by-value thus:\n\n   f x y = case (y `seq` (# x,y #)) of v -> x `seq` v\n\nBut that is bad for two reasons:\n  (a) we now evaluate y before x, and\n  (b) we can't bind v to an unboxed pair\n\nSeq is very, very special!  So we recognise it right here, and desugar to\n        case x of _ -> case y of _ -> (# x,y #)\n\nNote [Desugaring seq (2)]  cf Trac #2273\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   let chp = case b of { True -> fst x; False -> 0 }\n   in chp `seq` ...chp...\nHere the seq is designed to plug the space leak of retaining (snd x)\nfor too long.\n\nIf we rely on the ordinary inlining of seq, we'll get\n   let chp = case b of { True -> fst x; False -> 0 }\n   case chp of _ { I# -> ...chp... }\n\nBut since chp is cheap, and the case is an alluring contet, we'll\ninline chp into the case scrutinee.  Now there is only one use of chp,\nso we'll inline a second copy.  Alas, we've now ruined the purpose of\nthe seq, by re-introducing the space leak:\n    case (case b of {True -> fst x; False -> 0}) of\n      I# _ -> ...case b of {True -> fst x; False -> 0}...\n\nWe can try to avoid doing this by ensuring that the binder-swap in the\ncase happens, so we get his at an early stage:\n   case chp of chp2 { I# -> ...chp2... }\nBut this is fragile.  The real culprit is the source program.  Perhaps we\nshould have said explicitly\n   let !chp2 = chp in ...chp2...\n\nBut that's painful.  So the code here does a little hack to make seq\nmore robust: a saturated application of 'seq' is turned *directly* into\nthe case expression, thus:\n   x  `seq` e2 ==> case x of x -> e2    -- Note shadowing!\n   e1 `seq` e2 ==> case x of _ -> e2\n\nSo we desugar our example to:\n   let chp = case b of { True -> fst x; False -> 0 }\n   case chp of chp { I# -> ...chp... }\nAnd now all is well.\n\nThe reason it's a hack is because if you define mySeq=seq, the hack\nwon't work on mySeq.\n\nNote [Desugaring seq (3)] cf Trac #2409\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe isLocalId ensures that we don't turn\n        True `seq` e\ninto\n        case True of True { ... }\nwhich stupidly tries to bind the datacon 'True'.\n-}\n\n-- NB: Make sure the argument is not levity polymorphic\nmkCoreAppDs  :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr\nmkCoreAppDs _ (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2\n  | f `hasKey` seqIdKey            -- Note [Desugaring seq (1), (2)]\n  = Case arg1 case_bndr ty2 [(DEFAULT,[],arg2)]\n  where\n    case_bndr = case arg1 of\n                   Var v1 | isInternalName (idName v1)\n                          -> v1        -- Note [Desugaring seq (2) and (3)]\n                   _      -> mkWildValBinder ty1\n\nmkCoreAppDs s fun arg = mkCoreApp s fun arg  -- The rest is done in MkCore\n\n-- NB: No argument can be levity polymorphic\nmkCoreAppsDs :: SDoc -> CoreExpr -> [CoreExpr] -> CoreExpr\nmkCoreAppsDs s fun args = foldl' (mkCoreAppDs s) fun args\n\nmkCastDs :: CoreExpr -> Coercion -> CoreExpr\n-- We define a desugarer-specific version of CoreUtils.mkCast,\n-- because in the immediate output of the desugarer, we can have\n-- apparently-mis-matched coercions:  E.g.\n--     let a = b\n--     in (x :: a) |> (co :: b ~ Int)\n-- Lint know about type-bindings for let and does not complain\n-- So here we do not make the assertion checks that we make in\n-- CoreUtils.mkCast; and we do less peephole optimisation too\nmkCastDs e co | isReflCo co = e\n              | otherwise   = Cast e co\n\n{-\n************************************************************************\n*                                                                      *\n               Tuples and selector bindings\n*                                                                      *\n************************************************************************\n\nThis is used in various places to do with lazy patterns.\nFor each binder $b$ in the pattern, we create a binding:\n\\begin{verbatim}\n    b = case v of pat' -> b'\n\\end{verbatim}\nwhere @pat'@ is @pat@ with each binder @b@ cloned into @b'@.\n\nToDo: making these bindings should really depend on whether there's\nmuch work to be done per binding.  If the pattern is complex, it\nshould be de-mangled once, into a tuple (and then selected from).\nOtherwise the demangling can be in-line in the bindings (as here).\n\nBoring!  Boring!  One error message per binder.  The above ToDo is\neven more helpful.  Something very similar happens for pattern-bound\nexpressions.\n\nNote [mkSelectorBinds]\n~~~~~~~~~~~~~~~~~~~~~~\nmkSelectorBinds is used to desugar a pattern binding {p = e},\nin a binding group:\n  let { ...; p = e; ... } in body\nwhere p binds x,y (this list of binders can be empty).\nThere are two cases.\n\n------ Special case (A) -------\n  For a pattern that is just a variable,\n     let !x = e in body\n  ==>\n     let x = e in x `seq` body\n  So we return the binding, with 'x' as the variable to seq.\n\n------ Special case (B) -------\n  For a pattern that is essentially just a tuple:\n      * A product type, so cannot fail\n      * Only one level, so that\n          - generating multiple matches is fine\n          - seq'ing it evaluates the same as matching it\n  Then instead we generate\n       { v = e\n       ; x = case v of p -> x\n       ; y = case v of p -> y }\n  with 'v' as the variable to force\n\n------ General case (C) -------\n  In the general case we generate these bindings:\n       let { ...; p = e; ... } in body\n  ==>\n       let { t = case e of p -> (x,y)\n           ; x = case t of (x,y) -> x\n           ; y = case t of (x,y) -> y }\n       in t `seq` body\n\n  Note that we return 't' as the variable to force if the pattern\n  is strict (i.e. with -XStrict or an outermost-bang-pattern)\n\n  Note that (A) /includes/ the situation where\n\n   * The pattern binds exactly one variable\n        let !(Just (Just x) = e in body\n     ==>\n       let { t = case e of Just (Just v) -> Unit v\n           ; v = case t of Unit v -> v }\n       in t `seq` body\n    The 'Unit' is a one-tuple; see Note [One-tuples] in TysWiredIn\n    Note that forcing 't' makes the pattern match happen,\n    but does not force 'v'.\n\n  * The pattern binds no variables\n        let !(True,False) = e in body\n    ==>\n        let t = case e of (True,False) -> ()\n        in t `seq` body\n\n\n------ Examples ----------\n  *   !(_, (_, a)) = e\n    ==>\n      t = case e of (_, (_, a)) -> Unit a\n      a = case t of Unit a -> a\n\n    Note that\n     - Forcing 't' will force the pattern to match fully;\n       e.g. will diverge if (snd e) is bottom\n     - But 'a' itself is not forced; it is wrapped in a one-tuple\n       (see Note [One-tuples] in TysWiredIn)\n\n  *   !(Just x) = e\n    ==>\n      t = case e of Just x -> Unit x\n      x = case t of Unit x -> x\n\n    Again, forcing 't' will fail if 'e' yields Nothing.\n\nNote that even though this is rather general, the special cases\nwork out well:\n\n* One binder, not -XStrict:\n\n    let Just (Just v) = e in body\n  ==>\n    let t = case e of Just (Just v) -> Unit v\n        v = case t of Unit v -> v\n    in body\n  ==>\n    let v = case (case e of Just (Just v) -> Unit v) of\n              Unit v -> v\n    in body\n  ==>\n    let v = case e of Just (Just v) -> v\n    in body\n\n* Non-recursive, -XStrict\n     let p = e in body\n  ==>\n     let { t = case e of p -> (x,y)\n         ; x = case t of (x,y) -> x\n         ; y = case t of (x,y) -> x }\n     in t `seq` body\n  ==> {inline seq, float x,y bindings inwards}\n     let t = case e of p -> (x,y) in\n     case t of t' ->\n     let { x = case t' of (x,y) -> x\n         ; y = case t' of (x,y) -> x } in\n     body\n  ==> {inline t, do case of case}\n     case e of p ->\n     let t = (x,y) in\n     let { x = case t' of (x,y) -> x\n         ; y = case t' of (x,y) -> x } in\n     body\n  ==> {case-cancellation, drop dead code}\n     case e of p -> body\n\n* Special case (B) is there to avoid fruitlessly taking the tuple\n  apart and rebuilding it. For example, consider\n     { K x y = e }\n  where K is a product constructor.  Then general case (A) does:\n     { t = case e of K x y -> (x,y)\n     ; x = case t of (x,y) -> x\n     ; y = case t of (x,y) -> y }\n  In the lazy case we can't optimise out this fruitless taking apart\n  and rebuilding.  Instead (B) builds\n     { v = e\n     ; x = case v of K x y -> x\n     ; y = case v of K x y -> y }\n  which is better.\n-}\n\nmkSelectorBinds :: [[Tickish Id]] -- ^ ticks to add, possibly\n                -> LPat GhcTc     -- ^ The pattern\n                -> CoreExpr       -- ^ Expression to which the pattern is bound\n                -> DsM (Id,[(Id,CoreExpr)])\n                -- ^ Id the rhs is bound to, for desugaring strict\n                -- binds (see Note [Desugar Strict binds] in DsBinds)\n                -- and all the desugared binds\n\nmkSelectorBinds ticks pat val_expr\n  | (dL->L _ (VarPat _ (dL->L _ v))) <- pat'     -- Special case (A)\n  = return (v, [(v, val_expr)])\n\n  | is_flat_prod_lpat pat'           -- Special case (B)\n  = do { let pat_ty = hsLPatType pat'\n       ; val_var <- newSysLocalDsNoLP pat_ty\n\n       ; let mk_bind tick bndr_var\n               -- (mk_bind sv bv)  generates  bv = case sv of { pat -> bv }\n               -- Remember, 'pat' binds 'bv'\n               = do { rhs_expr <- matchSimply (Var val_var) PatBindRhs pat'\n                                       (Var bndr_var)\n                                       (Var bndr_var)  -- Neat hack\n                      -- Neat hack: since 'pat' can't fail, the\n                      -- \"fail-expr\" passed to matchSimply is not\n                      -- used. But it /is/ used for its type, and for\n                      -- that bndr_var is just the ticket.\n                    ; return (bndr_var, mkOptTickBox tick rhs_expr) }\n\n       ; binds <- zipWithM mk_bind ticks' binders\n       ; return ( val_var, (val_var, val_expr) : binds) }\n\n  | otherwise                          -- General case (C)\n  = do { tuple_var  <- newSysLocalDs tuple_ty\n       ; error_expr <- mkErrorAppDs pAT_ERROR_ID tuple_ty (ppr pat')\n       ; tuple_expr <- matchSimply val_expr PatBindRhs pat\n                                   local_tuple error_expr\n       ; let mk_tup_bind tick binder\n               = (binder, mkOptTickBox tick $\n                          mkTupleSelector1 local_binders binder\n                                           tuple_var (Var tuple_var))\n             tup_binds = zipWith mk_tup_bind ticks' binders\n       ; return (tuple_var, (tuple_var, tuple_expr) : tup_binds) }\n  where\n    pat' = strip_bangs pat\n           -- Strip the bangs before looking for case (A) or (B)\n           -- The incoming pattern may well have a bang on it\n\n    binders = collectPatBinders pat'\n    ticks'  = ticks ++ repeat []\n\n    local_binders = map localiseId binders      -- See Note [Localise pattern binders]\n    local_tuple   = mkBigCoreVarTup1 binders\n    tuple_ty      = exprType local_tuple\n\nstrip_bangs :: LPat (GhcPass p) -> LPat (GhcPass p)\n-- Remove outermost bangs and parens\nstrip_bangs (dL->L _ (ParPat _ p))  = strip_bangs p\nstrip_bangs (dL->L _ (BangPat _ p)) = strip_bangs p\nstrip_bangs lp                      = lp\n\nis_flat_prod_lpat :: LPat (GhcPass p) -> Bool\nis_flat_prod_lpat = is_flat_prod_pat . unLoc\n\nis_flat_prod_pat :: Pat (GhcPass p) -> Bool\nis_flat_prod_pat (ParPat _ p)          = is_flat_prod_lpat p\nis_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps\nis_flat_prod_pat (ConPatOut { pat_con  = (dL->L _ pcon)\n                            , pat_args = ps})\n  | RealDataCon con <- pcon\n  , isProductTyCon (dataConTyCon con)\n  = all is_triv_lpat (hsConPatArgs ps)\nis_flat_prod_pat _ = False\n\nis_triv_lpat :: LPat (GhcPass p) -> Bool\nis_triv_lpat = is_triv_pat . unLoc\n\nis_triv_pat :: Pat (GhcPass p) -> Bool\nis_triv_pat (VarPat {})  = True\nis_triv_pat (WildPat{})  = True\nis_triv_pat (ParPat _ p) = is_triv_lpat p\nis_triv_pat _            = False\n\n\n{- *********************************************************************\n*                                                                      *\n  Creating big tuples and their types for full Haskell expressions.\n  They work over *Ids*, and create tuples replete with their types,\n  which is whey they are not in HsUtils.\n*                                                                      *\n********************************************************************* -}\n\nmkLHsPatTup :: [LPat GhcTc] -> LPat GhcTc\nmkLHsPatTup []     = noLoc $ mkVanillaTuplePat [] Boxed\nmkLHsPatTup [lpat] = lpat\nmkLHsPatTup lpats  = cL (getLoc (head lpats)) $\n                     mkVanillaTuplePat lpats Boxed\n\nmkLHsVarPatTup :: [Id] -> LPat GhcTc\nmkLHsVarPatTup bs  = mkLHsPatTup (map nlVarPat bs)\n\nmkVanillaTuplePat :: [OutPat GhcTc] -> Boxity -> Pat GhcTc\n-- A vanilla tuple pattern simply gets its type from its sub-patterns\nmkVanillaTuplePat pats box = TuplePat (map hsLPatType pats) pats box\n\n-- The Big equivalents for the source tuple expressions\nmkBigLHsVarTupId :: [Id] -> LHsExpr GhcTc\nmkBigLHsVarTupId ids = mkBigLHsTupId (map nlHsVar ids)\n\nmkBigLHsTupId :: [LHsExpr GhcTc] -> LHsExpr GhcTc\nmkBigLHsTupId = mkChunkified mkLHsTupleExpr\n\n-- The Big equivalents for the source tuple patterns\nmkBigLHsVarPatTupId :: [Id] -> LPat GhcTc\nmkBigLHsVarPatTupId bs = mkBigLHsPatTupId (map nlVarPat bs)\n\nmkBigLHsPatTupId :: [LPat GhcTc] -> LPat GhcTc\nmkBigLHsPatTupId = mkChunkified mkLHsPatTup\n\n{-\n************************************************************************\n*                                                                      *\n        Code for pattern-matching and other failures\n*                                                                      *\n************************************************************************\n\nGenerally, we handle pattern matching failure like this: let-bind a\nfail-variable, and use that variable if the thing fails:\n\\begin{verbatim}\n        let fail.33 = error \"Help\"\n        in\n        case x of\n                p1 -> ...\n                p2 -> fail.33\n                p3 -> fail.33\n                p4 -> ...\n\\end{verbatim}\nThen\n\\begin{itemize}\n\\item\nIf the case can't fail, then there'll be no mention of @fail.33@, and the\nsimplifier will later discard it.\n\n\\item\nIf it can fail in only one way, then the simplifier will inline it.\n\n\\item\nOnly if it is used more than once will the let-binding remain.\n\\end{itemize}\n\nThere's a problem when the result of the case expression is of\nunboxed type.  Then the type of @fail.33@ is unboxed too, and\nthere is every chance that someone will change the let into a case:\n\\begin{verbatim}\n        case error \"Help\" of\n          fail.33 -> case ....\n\\end{verbatim}\n\nwhich is of course utterly wrong.  Rather than drop the condition that\nonly boxed types can be let-bound, we just turn the fail into a function\nfor the primitive case:\n\\begin{verbatim}\n        let fail.33 :: Void -> Int#\n            fail.33 = \\_ -> error \"Help\"\n        in\n        case x of\n                p1 -> ...\n                p2 -> fail.33 void\n                p3 -> fail.33 void\n                p4 -> ...\n\\end{verbatim}\n\nNow @fail.33@ is a function, so it can be let-bound.\n\nWe would *like* to use join points here; in fact, these \"fail variables\" are\nparadigmatic join points! Sadly, this breaks pattern synonyms, which desugar as\nCPS functions - i.e. they take \"join points\" as parameters. It's not impossible\nto imagine extending our type system to allow passing join points around (very\ncarefully), but we certainly don't support it now.\n\n99.99% of the time, the fail variables wind up as join points in short order\nanyway, and the Void# doesn't do much harm.\n-}\n\nmkFailurePair :: CoreExpr       -- Result type of the whole case expression\n              -> DsM (CoreBind, -- Binds the newly-created fail variable\n                                -- to \\ _ -> expression\n                      CoreExpr) -- Fail variable applied to realWorld#\n-- See Note [Failure thunks and CPR]\nmkFailurePair expr\n  = do { fail_fun_var <- newFailLocalDs (voidPrimTy `mkVisFunTy` ty)\n       ; fail_fun_arg <- newSysLocalDs voidPrimTy\n       ; let real_arg = setOneShotLambda fail_fun_arg\n       ; return (NonRec fail_fun_var (Lam real_arg expr),\n                 App (Var fail_fun_var) (Var voidPrimId)) }\n  where\n    ty = exprType expr\n\n{-\nNote [Failure thunks and CPR]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(This note predates join points as formal entities (hence the quotation marks).\nWe can't use actual join points here (see above); if we did, this would also\nsolve the CPR problem, since join points don't get CPR'd. See Note [Don't CPR\njoin points] in WorkWrap.)\n\nWhen we make a failure point we ensure that it\ndoes not look like a thunk. Example:\n\n   let fail = \\rw -> error \"urk\"\n   in case x of\n        [] -> fail realWorld#\n        (y:ys) -> case ys of\n                    [] -> fail realWorld#\n                    (z:zs) -> (y,z)\n\nReason: we know that a failure point is always a \"join point\" and is\nentered at most once.  Adding a dummy 'realWorld' token argument makes\nit clear that sharing is not an issue.  And that in turn makes it more\nCPR-friendly.  This matters a lot: if you don't get it right, you lose\nthe tail call property.  For example, see Trac #3403.\n\n\n************************************************************************\n*                                                                      *\n              Ticks\n*                                                                      *\n********************************************************************* -}\n\nmkOptTickBox :: [Tickish Id] -> CoreExpr -> CoreExpr\nmkOptTickBox = flip (foldr Tick)\n\nmkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr\nmkBinaryTickBox ixT ixF e = do\n       uq <- newUnique\n       this_mod <- getModule\n       let bndr1 = mkSysLocal (fsLit \"t1\") uq boolTy\n       let\n           falseBox = Tick (HpcTick this_mod ixF) (Var falseDataConId)\n           trueBox  = Tick (HpcTick this_mod ixT) (Var trueDataConId)\n       --\n       return $ Case e bndr1 boolTy\n                       [ (DataAlt falseDataCon, [], falseBox)\n                       , (DataAlt trueDataCon,  [], trueBox)\n                       ]\n\n\n\n-- *******************************************************************\n\n{- Note [decideBangHood]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWith -XStrict we may make /outermost/ patterns more strict.\nE.g.\n       let (Just x) = e in ...\n          ==>\n       let !(Just x) = e in ...\nand\n       f x = e\n          ==>\n       f !x = e\n\nThis adjustment is done by decideBangHood,\n\n  * Just before constructing an EqnInfo, in Match\n      (matchWrapper and matchSinglePat)\n\n  * When desugaring a pattern-binding in DsBinds.dsHsBind\n\nNote that it is /not/ done recursively.  See the -XStrict\nspec in the user manual.\n\nSpecifically:\n   ~pat    => pat    -- when -XStrict (even if pat = ~pat')\n   !pat    => !pat   -- always\n   pat     => !pat   -- when -XStrict\n   pat     => pat    -- otherwise\n-}\n\n\n-- | Use -XStrict to add a ! or remove a ~\n-- See Note [decideBangHood]\ndecideBangHood :: DynFlags\n               -> LPat GhcTc  -- ^ Original pattern\n               -> LPat GhcTc  -- Pattern with bang if necessary\ndecideBangHood dflags lpat\n  | not (xopt LangExt.Strict dflags)\n  = lpat\n  | otherwise   --  -XStrict\n  = go lpat\n  where\n    go lp@(dL->L l p)\n      = case p of\n           ParPat x p    -> cL l (ParPat x (go p))\n           LazyPat _ lp' -> lp'\n           BangPat _ _   -> lp\n           _             -> cL l (BangPat noExt lp)\n\n-- | Unconditionally make a 'Pat' strict.\naddBang :: LPat GhcTc -- ^ Original pattern\n        -> LPat GhcTc -- ^ Banged pattern\naddBang = go\n  where\n    go lp@(dL->L l p)\n      = case p of\n           ParPat x p    -> cL l (ParPat x (go p))\n           LazyPat _ lp' -> cL l (BangPat noExt lp')\n                                  -- Should we bring the extension value over?\n           BangPat _ _   -> lp\n           _             -> cL l (BangPat noExt lp)\n\nisTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)\n\n-- Returns Just {..} if we're sure that the expression is True\n-- I.e.   * 'True' datacon\n--        * 'otherwise' Id\n--        * Trivial wappings of these\n-- The arguments to Just are any HsTicks that we have found,\n-- because we still want to tick then, even it they are always evaluated.\nisTrueLHsExpr (dL->L _ (HsVar _ (dL->L _ v)))\n  |  v `hasKey` otherwiseIdKey\n     || v `hasKey` getUnique trueDataConId\n                                              = Just return\n        -- trueDataConId doesn't have the same unique as trueDataCon\nisTrueLHsExpr (dL->L _ (HsConLikeOut _ con))\n  | con `hasKey` getUnique trueDataCon = Just return\nisTrueLHsExpr (dL->L _ (HsTick _ tickish e))\n    | Just ticks <- isTrueLHsExpr e\n    = Just (\\x -> do wrapped <- ticks x\n                     return (Tick tickish wrapped))\n   -- This encodes that the result is constant True for Hpc tick purposes;\n   -- which is specifically what isTrueLHsExpr is trying to find out.\nisTrueLHsExpr (dL->L _ (HsBinTick _ ixT _ e))\n    | Just ticks <- isTrueLHsExpr e\n    = Just (\\x -> do e <- ticks x\n                     this_mod <- getModule\n                     return (Tick (HpcTick this_mod ixT) e))\n\nisTrueLHsExpr (dL->L _ (HsPar _ e))   = isTrueLHsExpr e\nisTrueLHsExpr _                       = Nothing\n", "num_lines": 1002}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Extract docs from the renamer output so they can be be serialized.\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule ExtractDocs (extractDocs) where\n\nimport GhcPrelude\nimport Bag\nimport HsBinds\nimport HsDoc\nimport HsDecls\nimport HsExtension\nimport HsTypes\nimport HsUtils\nimport Name\nimport NameSet\nimport SrcLoc\nimport TcRnTypes\n\nimport Control.Applicative\nimport Data.List\nimport Data.Map (Map)\nimport qualified Data.Map as M\nimport Data.Maybe\nimport Data.Semigroup\n\n-- | Extract docs from renamer output.\nextractDocs :: TcGblEnv\n            -> (Maybe HsDocString, DeclDocMap, ArgDocMap)\n            -- ^\n            -- 1. Module header\n            -- 2. Docs on top level declarations\n            -- 3. Docs on arguments\nextractDocs TcGblEnv { tcg_semantic_mod = mod\n                     , tcg_rn_decls = mb_rn_decls\n                     , tcg_insts = insts\n                     , tcg_fam_insts = fam_insts\n                     , tcg_doc_hdr = mb_doc_hdr\n                     } =\n    (unLoc <$> mb_doc_hdr, DeclDocMap doc_map, ArgDocMap arg_map)\n  where\n    (doc_map, arg_map) = maybe (M.empty, M.empty)\n                               (mkMaps local_insts)\n                               mb_decls_with_docs\n    mb_decls_with_docs = topDecls <$> mb_rn_decls\n    local_insts = filter (nameIsLocalOrFrom mod)\n                         $ map getName insts ++ map getName fam_insts\n\n-- | Create decl and arg doc-maps by looping through the declarations.\n-- For each declaration, find its names, its subordinates, and its doc strings.\nmkMaps :: [Name]\n       -> [(LHsDecl GhcRn, [HsDocString])]\n       -> (Map Name (HsDocString), Map Name (Map Int (HsDocString)))\nmkMaps instances decls =\n    ( f' (map (nubByName fst) decls')\n    , f  (filterMapping (not . M.null) args)\n    )\n  where\n    (decls', args) = unzip (map mappings decls)\n\n    f :: (Ord a, Semigroup b) => [[(a, b)]] -> Map a b\n    f = M.fromListWith (<>) . concat\n\n    f' :: Ord a => [[(a, HsDocString)]] -> Map a HsDocString\n    f' = M.fromListWith appendDocs . concat\n\n    filterMapping :: (b -> Bool) ->  [[(a, b)]] -> [[(a, b)]]\n    filterMapping p = map (filter (p . snd))\n\n    mappings :: (LHsDecl GhcRn, [HsDocString])\n             -> ( [(Name, HsDocString)]\n                , [(Name, Map Int (HsDocString))]\n                )\n    mappings (L l decl, docStrs) =\n           (dm, am)\n      where\n        doc = concatDocs docStrs\n        args = declTypeDocs decl\n\n        subs :: [(Name, [(HsDocString)], Map Int (HsDocString))]\n        subs = subordinates instanceMap decl\n\n        (subDocs, subArgs) =\n          unzip (map (\\(_, strs, m) -> (concatDocs strs, m)) subs)\n\n        ns = names l decl\n        subNs = [ n | (n, _, _) <- subs ]\n        dm = [(n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs]\n        am = [(n, args) | n <- ns] ++ zip subNs subArgs\n\n    instanceMap :: Map SrcSpan Name\n    instanceMap = M.fromList [(getSrcSpan n, n) | n <- instances]\n\n    names :: SrcSpan -> HsDecl GhcRn -> [Name]\n    names l (InstD _ d) = maybeToList (M.lookup loc instanceMap) -- See\n                                                                 -- Note [1].\n      where loc = case d of\n              TyFamInstD _ _ -> l -- The CoAx's loc is the whole line, but only\n                                  -- for TFs\n              _ -> getInstLoc d\n    names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See Note [1].\n    names _ decl = getMainDeclBinder decl\n\n{-\nNote [1]:\n---------\nWe relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried\ninside them. That should work for normal user-written instances (from\nlooking at GHC sources). We can assume that commented instances are\nuser-written. This lets us relate Names (from ClsInsts) to comments\n(associated with InstDecls and DerivDecls).\n-}\n\ngetMainDeclBinder :: HsDecl (GhcPass p) -> [IdP (GhcPass p)]\ngetMainDeclBinder (TyClD _ d) = [tcdName d]\ngetMainDeclBinder (ValD _ d) =\n  case collectHsBindBinders d of\n    []       -> []\n    (name:_) -> [name]\ngetMainDeclBinder (SigD _ d) = sigNameNoLoc d\ngetMainDeclBinder (ForD _ (ForeignImport _ name _ _)) = [unLoc name]\ngetMainDeclBinder (ForD _ (ForeignExport _ _ _ _)) = []\ngetMainDeclBinder _ = []\n\nsigNameNoLoc :: Sig pass -> [IdP pass]\nsigNameNoLoc (TypeSig    _   ns _)         = map unLoc ns\nsigNameNoLoc (ClassOpSig _ _ ns _)         = map unLoc ns\nsigNameNoLoc (PatSynSig  _   ns _)         = map unLoc ns\nsigNameNoLoc (SpecSig    _   n _ _)        = [unLoc n]\nsigNameNoLoc (InlineSig  _   n _)          = [unLoc n]\nsigNameNoLoc (FixSig _ (FixitySig _ ns _)) = map unLoc ns\nsigNameNoLoc _                             = []\n\n-- Extract the source location where an instance is defined. This is used\n-- to correlate InstDecls with their Instance/CoAxiom Names, via the\n-- instanceMap.\ngetInstLoc :: InstDecl name -> SrcSpan\ngetInstLoc = \\case\n  ClsInstD _ (ClsInstDecl { cid_poly_ty = ty }) -> getLoc (hsSigType ty)\n  DataFamInstD _ (DataFamInstDecl\n    { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = (dL->L l _) }}}) -> l\n  TyFamInstD _ (TyFamInstDecl\n    -- Since CoAxioms' Names refer to the whole line for type family instances\n    -- in particular, we need to dig a bit deeper to pull out the entire\n    -- equation. This does not happen for data family instances, for some\n    -- reason.\n    { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = (dL->L l _) }}}) -> l\n  ClsInstD _ (XClsInstDecl _) -> error \"getInstLoc\"\n  DataFamInstD _ (DataFamInstDecl (HsIB _ (XFamEqn _))) -> error \"getInstLoc\"\n  TyFamInstD _ (TyFamInstDecl (HsIB _ (XFamEqn _))) -> error \"getInstLoc\"\n  XInstDecl _ -> error \"getInstLoc\"\n  DataFamInstD _ (DataFamInstDecl (XHsImplicitBndrs _)) -> error \"getInstLoc\"\n  TyFamInstD _ (TyFamInstDecl (XHsImplicitBndrs _)) -> error \"getInstLoc\"\n\n-- | Get all subordinate declarations inside a declaration, and their docs.\n-- A subordinate declaration is something like the associate type or data\n-- family of a type class.\nsubordinates :: Map SrcSpan Name\n             -> HsDecl GhcRn\n             -> [(Name, [(HsDocString)], Map Int (HsDocString))]\nsubordinates instMap decl = case decl of\n  InstD _ (ClsInstD _ d) -> do\n    DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n      FamEqn { feqn_tycon = (dL->L l _)\n             , feqn_rhs   = defn }}} <- unLoc <$> cid_datafam_insts d\n    [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs defn\n\n  InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body = d })))\n    -> dataSubs (feqn_rhs d)\n  TyClD _ d | isClassDecl d -> classSubs d\n            | isDataDecl  d -> dataSubs (tcdDataDefn d)\n  _ -> []\n  where\n    classSubs dd = [ (name, doc, declTypeDocs d)\n                   | (dL->L _ d, doc) <- classDecls dd\n                   , name <- getMainDeclBinder d, not (isValD d)\n                   ]\n    dataSubs :: HsDataDefn GhcRn\n             -> [(Name, [HsDocString], Map Int (HsDocString))]\n    dataSubs dd = constrs ++ fields ++ derivs\n      where\n        cons = map unLoc $ (dd_cons dd)\n        constrs = [ ( unLoc cname\n                    , maybeToList $ fmap unLoc $ con_doc c\n                    , conArgDocs c)\n                  | c <- cons, cname <- getConNames c ]\n        fields  = [ (extFieldOcc n, maybeToList $ fmap unLoc doc, M.empty)\n                  | RecCon flds <- map getConArgs cons\n                  , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds)\n                  , (dL->L _ n) <- ns ]\n        derivs  = [ (instName, [unLoc doc], M.empty)\n                  | HsIB { hsib_body = (dL->L l (HsDocTy _ _ doc)) }\n                      <- concatMap (unLoc . deriv_clause_tys . unLoc) $\n                           unLoc $ dd_derivs dd\n                  , Just instName <- [M.lookup l instMap] ]\n\n-- | Extract constructor argument docs from inside constructor decls.\nconArgDocs :: ConDecl GhcRn -> Map Int (HsDocString)\nconArgDocs con = case getConArgs con of\n                   PrefixCon args -> go 0 (map unLoc args ++ ret)\n                   InfixCon arg1 arg2 -> go 0 ([unLoc arg1, unLoc arg2] ++ ret)\n                   RecCon _ -> go 1 ret\n  where\n    go n (HsDocTy _ _ (dL->L _ ds) : tys) = M.insert n ds $ go (n+1) tys\n    go n (_ : tys) = go (n+1) tys\n    go _ [] = M.empty\n\n    ret = case con of\n            ConDeclGADT { con_res_ty = res_ty } -> [ unLoc res_ty ]\n            _ -> []\n\nisValD :: HsDecl a -> Bool\nisValD (ValD _ _) = True\nisValD _ = False\n\n-- | All the sub declarations of a class (that we handle), ordered by\n-- source location, with documentation attached if it exists.\nclassDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]\nclassDecls class_ = filterDecls . collectDocs . sortByLoc $ decls\n  where\n    decls = docs ++ defs ++ sigs ++ ats\n    docs  = mkDecls tcdDocs (DocD noExt) class_\n    defs  = mkDecls (bagToList . tcdMeths) (ValD noExt) class_\n    sigs  = mkDecls tcdSigs (SigD noExt) class_\n    ats   = mkDecls tcdATs (TyClD noExt . FamDecl noExt) class_\n\n-- | Extract function argument docs from inside top-level decls.\ndeclTypeDocs :: HsDecl GhcRn -> Map Int (HsDocString)\ndeclTypeDocs = \\case\n  SigD  _ (TypeSig _ _ ty)          -> typeDocs (unLoc (hsSigWcType ty))\n  SigD  _ (ClassOpSig _ _ _ ty)     -> typeDocs (unLoc (hsSigType ty))\n  SigD  _ (PatSynSig _ _ ty)        -> typeDocs (unLoc (hsSigType ty))\n  ForD  _ (ForeignImport _ _ ty _)  -> typeDocs (unLoc (hsSigType ty))\n  TyClD _ (SynDecl { tcdRhs = ty }) -> typeDocs (unLoc ty)\n  _                                 -> M.empty\n\nnubByName :: (a -> Name) -> [a] -> [a]\nnubByName f ns = go emptyNameSet ns\n  where\n    go _ [] = []\n    go s (x:xs)\n      | y `elemNameSet` s = go s xs\n      | otherwise         = let s' = extendNameSet s y\n                            in x : go s' xs\n      where\n        y = f x\n\n-- | Extract function argument docs from inside types.\ntypeDocs :: HsType GhcRn -> Map Int (HsDocString)\ntypeDocs = go 0\n  where\n    go n (HsForAllTy { hst_body = ty }) = go n (unLoc ty)\n    go n (HsQualTy   { hst_body = ty }) = go n (unLoc ty)\n    go n (HsFunTy _ (dL->L _\n                      (HsDocTy _ _ (dL->L _ x))) (dL->L _ ty)) =\n       M.insert n x $ go (n+1) ty\n    go n (HsFunTy _ _ ty) = go (n+1) (unLoc ty)\n    go n (HsDocTy _ _ (dL->L _ doc)) = M.singleton n doc\n    go _ _ = M.empty\n\n-- | The top-level declarations of a module that we care about,\n-- ordered by source location, with documentation attached if it exists.\ntopDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])]\ntopDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup\n\n-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.\nungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]\nungroup group_ =\n  mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExt)  group_ ++\n  mkDecls hs_derivds             (DerivD noExt) group_ ++\n  mkDecls hs_defds               (DefD noExt)   group_ ++\n  mkDecls hs_fords               (ForD noExt)   group_ ++\n  mkDecls hs_docs                (DocD noExt)   group_ ++\n  mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExt)  group_ ++\n  mkDecls (typesigs . hs_valds)  (SigD noExt)   group_ ++\n  mkDecls (valbinds . hs_valds)  (ValD noExt)   group_\n  where\n    typesigs (XValBindsLR (NValBinds _ sigs)) = filter (isUserSig . unLoc) sigs\n    typesigs _ = error \"expected ValBindsOut\"\n\n    valbinds (XValBindsLR (NValBinds binds _)) =\n      concatMap bagToList . snd . unzip $ binds\n    valbinds _ = error \"expected ValBindsOut\"\n\n-- | Sort by source location\nsortByLoc :: [Located a] -> [Located a]\nsortByLoc = sortOn getLoc\n\n-- | Collect docs and attach them to the right declarations.\n--\n-- A declaration may have multiple doc strings attached to it.\ncollectDocs :: [LHsDecl pass] -> [(LHsDecl pass, [HsDocString])]\n-- ^ This is an example.\ncollectDocs = go Nothing []\n  where\n    go Nothing _ [] = []\n    go (Just prev) docs [] = finished prev docs []\n    go prev docs ((dL->L _ (DocD _ (DocCommentNext str))) : ds)\n      | Nothing <- prev = go Nothing (str:docs) ds\n      | Just decl <- prev = finished decl docs (go Nothing [str] ds)\n    go prev docs ((dL->L _ (DocD _ (DocCommentPrev str))) : ds) =\n      go prev (str:docs) ds\n    go Nothing docs (d:ds) = go (Just d) docs ds\n    go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)\n\n    finished decl docs rest = (decl, reverse docs) : rest\n\n-- | Filter out declarations that we don't handle in Haddock\nfilterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]\nfilterDecls = filter (isHandled . unLoc . fst)\n  where\n    isHandled (ForD _ (ForeignImport {})) = True\n    isHandled (TyClD {})  = True\n    isHandled (InstD {})  = True\n    isHandled (DerivD {}) = True\n    isHandled (SigD _ d)  = isUserSig d\n    isHandled (ValD {})   = True\n    -- we keep doc declarations to be able to get at named docs\n    isHandled (DocD {})   = True\n    isHandled _ = False\n\n\n-- | Go through all class declarations and filter their sub-declarations\nfilterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]\nfilterClasses decls = [ if isClassD d then (cL loc (filterClass d), doc) else x\n                      | x@(dL->L loc d, doc) <- decls ]\n  where\n    filterClass (TyClD x c) =\n      TyClD x $ c { tcdSigs =\n        filter (liftA2 (||) (isUserSig . unLoc) isMinimalLSig) (tcdSigs c) }\n    filterClass _ = error \"expected TyClD\"\n\n-- | Was this signature given by the user?\nisUserSig :: Sig name -> Bool\nisUserSig TypeSig {}    = True\nisUserSig ClassOpSig {} = True\nisUserSig PatSynSig {}  = True\nisUserSig _             = False\n\nisClassD :: HsDecl a -> Bool\nisClassD (TyClD _ d) = isClassDecl d\nisClassD _ = False\n\n-- | Take a field of declarations from a data structure and create HsDecls\n-- using the given constructor\nmkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]\nmkDecls field con struct = [ cL loc (con decl)\n                           | (dL->L loc decl) <- field struct ]\n", "num_lines": 351}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nThe @match@ function\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule Match ( match, matchEquations, matchWrapper, matchSimply\n             , matchSinglePat, matchSinglePatVar ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-#SOURCE#-} DsExpr (dsLExpr, dsSyntaxExpr)\n\nimport BasicTypes ( Origin(..) )\nimport DynFlags\nimport HsSyn\nimport TcHsSyn\nimport TcEvidence\nimport TcRnMonad\nimport Check\nimport CoreSyn\nimport Literal\nimport CoreUtils\nimport MkCore\nimport DsMonad\nimport DsBinds\nimport DsGRHSs\nimport DsUtils\nimport Id\nimport ConLike\nimport DataCon\nimport PatSyn\nimport MatchCon\nimport MatchLit\nimport Type\nimport Coercion ( eqCoercion )\nimport TyCon( isNewTyCon )\nimport TysWiredIn\nimport SrcLoc\nimport Maybes\nimport Util\nimport Name\nimport Outputable\nimport BasicTypes ( isGenerated, il_value, fl_value )\nimport FastString\nimport Unique\nimport UniqDFM\n\nimport Control.Monad( when, unless )\nimport Data.List ( groupBy )\nimport qualified Data.Map as Map\n\n{-\n************************************************************************\n*                                                                      *\n                The main matching function\n*                                                                      *\n************************************************************************\n\nThe function @match@ is basically the same as in the Wadler chapter\nfrom \"The Implementation of Functional Programming Languages\",\nexcept it is monadised, to carry around the name supply, info about\nannotations, etc.\n\nNotes on @match@'s arguments, assuming $m$ equations and $n$ patterns:\n\\begin{enumerate}\n\\item\nA list of $n$ variable names, those variables presumably bound to the\n$n$ expressions being matched against the $n$ patterns.  Using the\nlist of $n$ expressions as the first argument showed no benefit and\nsome inelegance.\n\n\\item\nThe second argument, a list giving the ``equation info'' for each of\nthe $m$ equations:\n\\begin{itemize}\n\\item\nthe $n$ patterns for that equation, and\n\\item\na list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on\nthe front'' of the matching code, as in:\n\\begin{verbatim}\nlet <binds>\nin  <matching-code>\n\\end{verbatim}\n\\item\nand finally: (ToDo: fill in)\n\nThe right way to think about the ``after-match function'' is that it\nis an embryonic @CoreExpr@ with a ``hole'' at the end for the\nfinal ``else expression''.\n\\end{itemize}\n\nThere is a data type, @EquationInfo@, defined in module @DsMonad@.\n\nAn experiment with re-ordering this information about equations (in\nparticular, having the patterns available in column-major order)\nshowed no benefit.\n\n\\item\nA default expression---what to evaluate if the overall pattern-match\nfails.  This expression will (almost?) always be\na measly expression @Var@, unless we know it will only be used once\n(as we do in @glue_success_exprs@).\n\nLeaving out this third argument to @match@ (and slamming in lots of\n@Var \"fail\"@s) is a positively {\\em bad} idea, because it makes it\nimpossible to share the default expressions.  (Also, it stands no\nchance of working in our post-upheaval world of @Locals@.)\n\\end{enumerate}\n\nNote: @match@ is often called via @matchWrapper@ (end of this module),\na function that does much of the house-keeping that goes with a call\nto @match@.\n\nIt is also worth mentioning the {\\em typical} way a block of equations\nis desugared with @match@.  At each stage, it is the first column of\npatterns that is examined.  The steps carried out are roughly:\n\\begin{enumerate}\n\\item\nTidy the patterns in column~1 with @tidyEqnInfo@ (this may add\nbindings to the second component of the equation-info):\n\\item\nNow {\\em unmix} the equations into {\\em blocks} [w\\/ local function\n@match_groups@], in which the equations in a block all have the same\n match group.\n(see ``the mixture rule'' in SLPJ).\n\\item\nCall the right match variant on each block of equations; it will do the\nappropriate thing for each kind of column-1 pattern.\n\\end{enumerate}\n\nWe are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)\nthan the Wadler-chapter code for @match@ (p.~93, first @match@ clause).\nAnd gluing the ``success expressions'' together isn't quite so pretty.\n\nThis  @match@ uses @tidyEqnInfo@\nto get `as'- and `twiddle'-patterns out of the way (tidying), before\napplying ``the mixture rule'' (SLPJ, p.~88) [which really {\\em\nun}mixes the equations], producing a list of equation-info\nblocks, each block having as its first column patterns compatible with each other.\n\nNote [Match Ids]\n~~~~~~~~~~~~~~~~\nMost of the matching functions take an Id or [Id] as argument.  This Id\nis the scrutinee(s) of the match. The desugared expression may\nsometimes use that Id in a local binding or as a case binder.  So it\nshould not have an External name; Lint rejects non-top-level binders\nwith External names (Trac #13043).\n\nSee also Note [Localise pattern binders] in DsUtils\n-}\n\ntype MatchId = Id   -- See Note [Match Ids]\n\nmatch :: [MatchId]        -- ^ Variables rep\\'ing the exprs we\\'re matching with\n                          -- ^ See Note [Match Ids]\n      -> Type             -- ^ Type of the case expression\n      -> [EquationInfo]   -- ^ Info about patterns, etc. (type synonym below)\n      -> DsM MatchResult  -- ^ Desugared result!\n\nmatch [] ty eqns\n  = ASSERT2( not (null eqns), ppr ty )\n    return (foldr1 combineMatchResults match_results)\n  where\n    match_results = [ ASSERT( null (eqn_pats eqn) )\n                      eqn_rhs eqn\n                    | eqn <- eqns ]\n\nmatch vars@(v:_) ty eqns    -- Eqns *can* be empty\n  = ASSERT2( all (isInternalName . idName) vars, ppr vars )\n    do  { dflags <- getDynFlags\n                -- Tidy the first pattern, generating\n                -- auxiliary bindings if necessary\n        ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns\n\n                -- Group the equations and match each group in turn\n        ; let grouped = groupEquations dflags tidy_eqns\n\n         -- print the view patterns that are commoned up to help debug\n        ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped)\n\n        ; match_results <- match_groups grouped\n        ; return (adjustMatchResult (foldr (.) id aux_binds) $\n                  foldr1 combineMatchResults match_results) }\n  where\n    dropGroup :: [(PatGroup,EquationInfo)] -> [EquationInfo]\n    dropGroup = map snd\n\n    match_groups :: [[(PatGroup,EquationInfo)]] -> DsM [MatchResult]\n    -- Result list of [MatchResult] is always non-empty\n    match_groups [] = matchEmpty v ty\n    match_groups gs = mapM match_group gs\n\n    match_group :: [(PatGroup,EquationInfo)] -> DsM MatchResult\n    match_group [] = panic \"match_group\"\n    match_group eqns@((group,_) : _)\n        = case group of\n            PgCon {}  -> matchConFamily  vars ty (subGroupUniq [(c,e) | (PgCon c, e) <- eqns])\n            PgSyn {}  -> matchPatSyn     vars ty (dropGroup eqns)\n            PgLit {}  -> matchLiterals   vars ty (subGroupOrd [(l,e) | (PgLit l, e) <- eqns])\n            PgAny     -> matchVariables  vars ty (dropGroup eqns)\n            PgN {}    -> matchNPats      vars ty (dropGroup eqns)\n            PgOverS {}-> matchNPats      vars ty (dropGroup eqns)\n            PgNpK {}  -> matchNPlusKPats vars ty (dropGroup eqns)\n            PgBang    -> matchBangs      vars ty (dropGroup eqns)\n            PgCo {}   -> matchCoercion   vars ty (dropGroup eqns)\n            PgView {} -> matchView       vars ty (dropGroup eqns)\n            PgOverloadedList -> matchOverloadedList vars ty (dropGroup eqns)\n\n    -- FIXME: we should also warn about view patterns that should be\n    -- commoned up but are not\n\n    -- print some stuff to see what's getting grouped\n    -- use -dppr-debug to see the resolution of overloaded literals\n    debug eqns =\n        let gs = map (\\group -> foldr (\\ (p,_) -> \\acc ->\n                                           case p of PgView e _ -> e:acc\n                                                     _ -> acc) [] group) eqns\n            maybeWarn [] = return ()\n            maybeWarn l = warnDs NoReason (vcat l)\n        in\n          maybeWarn $ (map (\\g -> text \"Putting these view expressions into the same case:\" <+> (ppr g))\n                       (filter (not . null) gs))\n\nmatchEmpty :: MatchId -> Type -> DsM [MatchResult]\n-- See Note [Empty case expressions]\nmatchEmpty var res_ty\n  = return [MatchResult CanFail mk_seq]\n  where\n    mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty\n                                      [(DEFAULT, [], fail)]\n\nmatchVariables :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult\n-- Real true variables, just like in matchVar, SLPJ p 94\n-- No binding to do: they'll all be wildcards by now (done in tidy)\nmatchVariables (_:vars) ty eqns = match vars ty (shiftEqns eqns)\nmatchVariables [] _ _ = panic \"matchVariables\"\n\nmatchBangs :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult\nmatchBangs (var:vars) ty eqns\n  = do  { match_result <- match (var:vars) ty $\n                          map (decomposeFirstPat getBangPat) eqns\n        ; return (mkEvalMatchResult var ty match_result) }\nmatchBangs [] _ _ = panic \"matchBangs\"\n\nmatchCoercion :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult\n-- Apply the coercion to the match variable and then match that\nmatchCoercion (var:vars) ty (eqns@(eqn1:_))\n  = do  { let CoPat _ co pat _ = firstPat eqn1\n        ; let pat_ty' = hsPatType pat\n        ; var' <- newUniqueId var pat_ty'\n        ; match_result <- match (var':vars) ty $\n                          map (decomposeFirstPat getCoPat) eqns\n        ; core_wrap <- dsHsWrapper co\n        ; let bind = NonRec var' (core_wrap (Var var))\n        ; return (mkCoLetMatchResult bind match_result) }\nmatchCoercion _ _ _ = panic \"matchCoercion\"\n\nmatchView :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult\n-- Apply the view function to the match variable and then match that\nmatchView (var:vars) ty (eqns@(eqn1:_))\n  = do  { -- we could pass in the expr from the PgView,\n         -- but this needs to extract the pat anyway\n         -- to figure out the type of the fresh variable\n         let ViewPat _ viewExpr (dL->L _ pat) = firstPat eqn1\n         -- do the rest of the compilation\n        ; let pat_ty' = hsPatType pat\n        ; var' <- newUniqueId var pat_ty'\n        ; match_result <- match (var':vars) ty $\n                          map (decomposeFirstPat getViewPat) eqns\n         -- compile the view expressions\n        ; viewExpr' <- dsLExpr viewExpr\n        ; return (mkViewMatchResult var'\n                    (mkCoreAppDs (text \"matchView\") viewExpr' (Var var))\n                    match_result) }\nmatchView _ _ _ = panic \"matchView\"\n\nmatchOverloadedList :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult\nmatchOverloadedList (var:vars) ty (eqns@(eqn1:_))\n-- Since overloaded list patterns are treated as view patterns,\n-- the code is roughly the same as for matchView\n  = do { let ListPat (ListPatTc elt_ty (Just (_,e))) _ = firstPat eqn1\n       ; var' <- newUniqueId var (mkListTy elt_ty)  -- we construct the overall type by hand\n       ; match_result <- match (var':vars) ty $\n                            map (decomposeFirstPat getOLPat) eqns -- getOLPat builds the pattern inside as a non-overloaded version of the overloaded list pattern\n       ; e' <- dsSyntaxExpr e [Var var]\n       ; return (mkViewMatchResult var' e' match_result) }\nmatchOverloadedList _ _ _ = panic \"matchOverloadedList\"\n\n-- decompose the first pattern and leave the rest alone\ndecomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo\ndecomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))\n        = eqn { eqn_pats = extractpat pat : pats}\ndecomposeFirstPat _ _ = panic \"decomposeFirstPat\"\n\ngetCoPat, getBangPat, getViewPat, getOLPat :: Pat GhcTc -> Pat GhcTc\ngetCoPat (CoPat _ _ pat _)   = pat\ngetCoPat _                   = panic \"getCoPat\"\ngetBangPat (BangPat _ pat  ) = unLoc pat\ngetBangPat _                 = panic \"getBangPat\"\ngetViewPat (ViewPat _ _ pat) = unLoc pat\ngetViewPat _                 = panic \"getViewPat\"\ngetOLPat (ListPat (ListPatTc ty (Just _)) pats)\n        = ListPat (ListPatTc ty Nothing)  pats\ngetOLPat _                   = panic \"getOLPat\"\n\n{-\nNote [Empty case alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe list of EquationInfo can be empty, arising from\n    case x of {}   or    \\case {}\nIn that situation we desugar to\n    case x of { _ -> error \"pattern match failure\" }\nThe *desugarer* isn't certain whether there really should be no\nalternatives, so it adds a default case, as it always does.  A later\npass may remove it if it's inaccessible.  (See also Note [Empty case\nalternatives] in CoreSyn.)\n\nWe do *not* desugar simply to\n   error \"empty case\"\nor some such, because 'x' might be bound to (error \"hello\"), in which\ncase we want to see that \"hello\" exception, not (error \"empty case\").\nSee also Note [Case elimination: lifted case] in Simplify.\n\n\n************************************************************************\n*                                                                      *\n                Tidying patterns\n*                                                                      *\n************************************************************************\n\nTidy up the leftmost pattern in an @EquationInfo@, given the variable @v@\nwhich will be scrutinised.\n\nThis makes desugaring the pattern match simpler by transforming some of\nthe patterns to simpler forms. (Tuples to Constructor Patterns)\n\nAmong other things in the resulting Pattern:\n* Variables and irrefutable(lazy) patterns are replaced by Wildcards\n* As patterns are replaced by the patterns they wrap.\n\nThe bindings created by the above patterns are put into the returned wrapper\ninstead.\n\nThis means a definition of the form:\n  f x = rhs\nwhen called with v get's desugared to the equivalent of:\n  let x = v\n  in\n  f _ = rhs\n\nThe same principle holds for as patterns (@) and\nirrefutable/lazy patterns (~).\nIn the case of irrefutable patterns the irrefutable pattern is pushed into\nthe binding.\n\nPattern Constructors which only represent syntactic sugar are converted into\ntheir desugared representation.\nThis usually means converting them to Constructor patterns but for some\ndepends on enabled extensions. (Eg OverloadedLists)\n\nGHC also tries to convert overloaded Literals into regular ones.\n\nThe result of this tidying is that the column of patterns will include\nonly these which can be assigned a PatternGroup (see patGroup).\n\n-}\n\ntidyEqnInfo :: Id -> EquationInfo\n            -> DsM (DsWrapper, EquationInfo)\n        -- DsM'd because of internal call to dsLHsBinds\n        --      and mkSelectorBinds.\n        -- \"tidy1\" does the interesting stuff, looking at\n        -- one pattern and fiddling the list of bindings.\n        --\n        -- POST CONDITION: head pattern in the EqnInfo is\n        --      one of these for which patGroup is defined.\n\ntidyEqnInfo _ (EqnInfo { eqn_pats = [] })\n  = panic \"tidyEqnInfo\"\n\ntidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig })\n  = do { (wrap, pat') <- tidy1 v orig pat\n       ; return (wrap, eqn { eqn_pats = do pat' : pats }) }\n\ntidy1 :: Id                  -- The Id being scrutinised\n      -> Origin              -- Was this a pattern the user wrote?\n      -> Pat GhcTc           -- The pattern against which it is to be matched\n      -> DsM (DsWrapper,     -- Extra bindings to do before the match\n              Pat GhcTc)     -- Equivalent pattern\n\n-------------------------------------------------------\n--      (pat', mr') = tidy1 v pat mr\n-- tidies the *outer level only* of pat, giving pat'\n-- It eliminates many pattern forms (as-patterns, variable patterns,\n-- list patterns, etc) and returns any created bindings in the wrapper.\n\ntidy1 v o (ParPat _ pat)      = tidy1 v o (unLoc pat)\ntidy1 v o (SigPat _ pat _)    = tidy1 v o (unLoc pat)\ntidy1 _ _ (WildPat ty)        = return (idDsWrapper, WildPat ty)\ntidy1 v o (BangPat _ (dL->L l p)) = tidy_bang_pat v o l p\n\n        -- case v of { x -> mr[] }\n        -- = case v of { _ -> let x=v in mr[] }\ntidy1 v _ (VarPat _ (dL->L _ var))\n  = return (wrapBind var v, WildPat (idType var))\n\n        -- case v of { x@p -> mr[] }\n        -- = case v of { p -> let x=v in mr[] }\ntidy1 v o (AsPat _ (dL->L _ var) pat)\n  = do  { (wrap, pat') <- tidy1 v o (unLoc pat)\n        ; return (wrapBind var v . wrap, pat') }\n\n{- now, here we handle lazy patterns:\n    tidy1 v ~p bs = (v, v1 = case v of p -> v1 :\n                        v2 = case v of p -> v2 : ... : bs )\n\n    where the v_i's are the binders in the pattern.\n\n    ToDo: in \"v_i = ... -> v_i\", are the v_i's really the same thing?\n\n    The case expr for v_i is just: match [v] [(p, [], \\ x -> Var v_i)] any_expr\n-}\n\ntidy1 v _ (LazyPat _ pat)\n    -- This is a convenient place to check for unlifted types under a lazy pattern.\n    -- Doing this check during type-checking is unsatisfactory because we may\n    -- not fully know the zonked types yet. We sure do here.\n  = do  { let unlifted_bndrs = filter (isUnliftedType . idType) (collectPatBinders pat)\n        ; unless (null unlifted_bndrs) $\n          putSrcSpanDs (getLoc pat) $\n          errDs (hang (text \"A lazy (~) pattern cannot bind variables of unlifted type.\" $$\n                       text \"Unlifted variables:\")\n                    2 (vcat (map (\\id -> ppr id <+> dcolon <+> ppr (idType id))\n                                 unlifted_bndrs)))\n\n        ; (_,sel_prs) <- mkSelectorBinds [] pat (Var v)\n        ; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]\n        ; return (mkCoreLets sel_binds, WildPat (idType v)) }\n\ntidy1 _ _ (ListPat (ListPatTc ty Nothing) pats )\n  = return (idDsWrapper, unLoc list_ConPat)\n  where\n    list_ConPat = foldr (\\ x y -> mkPrefixConPat consDataCon [x, y] [ty])\n                        (mkNilPat ty)\n                        pats\n\ntidy1 _ _ (TuplePat tys pats boxity)\n  = return (idDsWrapper, unLoc tuple_ConPat)\n  where\n    arity = length pats\n    tuple_ConPat = mkPrefixConPat (tupleDataCon boxity arity) pats tys\n\ntidy1 _ _ (SumPat tys pat alt arity)\n  = return (idDsWrapper, unLoc sum_ConPat)\n  where\n    sum_ConPat = mkPrefixConPat (sumDataCon alt arity) [pat] tys\n\n-- LitPats: we *might* be able to replace these w/ a simpler form\ntidy1 _ o (LitPat _ lit)\n  = do { unless (isGenerated o) $\n           warnAboutOverflowedLit lit\n       ; return (idDsWrapper, tidyLitPat lit) }\n\n-- NPats: we *might* be able to replace these w/ a simpler form\ntidy1 _ o (NPat ty (dL->L _ lit@OverLit { ol_val = v }) mb_neg eq)\n  = do { unless (isGenerated o) $\n           let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v }\n                    | otherwise = lit\n           in warnAboutOverflowedOverLit lit'\n       ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) }\n\n-- NPlusKPat: we may want to warn about the literals\ntidy1 _ o n@(NPlusKPat _ _ (dL->L _ lit1) lit2 _ _)\n  = do { unless (isGenerated o) $ do\n           warnAboutOverflowedOverLit lit1\n           warnAboutOverflowedOverLit lit2\n       ; return (idDsWrapper, n) }\n\n-- Everything else goes through unchanged...\ntidy1 _ _ non_interesting_pat\n  = return (idDsWrapper, non_interesting_pat)\n\n--------------------\ntidy_bang_pat :: Id -> Origin -> SrcSpan -> Pat GhcTc\n              -> DsM (DsWrapper, Pat GhcTc)\n\n-- Discard par/sig under a bang\ntidy_bang_pat v o _ (ParPat _ (dL->L l p)) = tidy_bang_pat v o l p\ntidy_bang_pat v o _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v o l p\n\n-- Push the bang-pattern inwards, in the hope that\n-- it may disappear next time\ntidy_bang_pat v o l (AsPat x v' p)\n  = tidy1 v o (AsPat x v' (cL l (BangPat noExt p)))\ntidy_bang_pat v o l (CoPat x w p t)\n  = tidy1 v o (CoPat x w (BangPat noExt (cL l p)) t)\n\n-- Discard bang around strict pattern\ntidy_bang_pat v o _ p@(LitPat {})    = tidy1 v o p\ntidy_bang_pat v o _ p@(ListPat {})   = tidy1 v o p\ntidy_bang_pat v o _ p@(TuplePat {})  = tidy1 v o p\ntidy_bang_pat v o _ p@(SumPat {})    = tidy1 v o p\n\n-- Data/newtype constructors\ntidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))\n                                 , pat_args = args\n                                 , pat_arg_tys = arg_tys })\n  -- Newtypes: push bang inwards (Trac #9844)\n  =\n    if isNewTyCon (dataConTyCon dc)\n      then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l ty args })\n      else tidy1 v o p  -- Data types: discard the bang\n    where\n      (ty:_) = dataConInstArgTys dc arg_tys\n\n-------------------\n-- Default case, leave the bang there:\n--    VarPat,\n--    LazyPat,\n--    WildPat,\n--    ViewPat,\n--    pattern synonyms (ConPatOut with PatSynCon)\n--    NPat,\n--    NPlusKPat\n--\n-- For LazyPat, remember that it's semantically like a VarPat\n--  i.e.  !(~p) is not like ~p, or p!  (Trac #8952)\n--\n-- NB: SigPatIn, ConPatIn should not happen\n\ntidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExt (cL l p))\n\n-------------------\npush_bang_into_newtype_arg :: SrcSpan\n                           -> Type -- The type of the argument we are pushing\n                                   -- onto\n                           -> HsConPatDetails GhcTc -> HsConPatDetails GhcTc\n-- See Note [Bang patterns and newtypes]\n-- We are transforming   !(N p)   into   (N !p)\npush_bang_into_newtype_arg l _ty (PrefixCon (arg:args))\n  = ASSERT( null args)\n    PrefixCon [cL l (BangPat noExt arg)]\npush_bang_into_newtype_arg l _ty (RecCon rf)\n  | HsRecFields { rec_flds = (dL->L lf fld) : flds } <- rf\n  , HsRecField { hsRecFieldArg = arg } <- fld\n  = ASSERT( null flds)\n    RecCon (rf { rec_flds = [cL lf (fld { hsRecFieldArg\n                                           = cL l (BangPat noExt arg) })] })\npush_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})\n  | HsRecFields { rec_flds = [] } <- rf\n  = PrefixCon [cL l (BangPat noExt (noLoc (WildPat ty)))]\npush_bang_into_newtype_arg _ _ cd\n  = pprPanic \"push_bang_into_newtype_arg\" (pprConArgs cd)\n\n{-\nNote [Bang patterns and newtypes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor the pattern  !(Just pat)  we can discard the bang, because\nthe pattern is strict anyway. But for !(N pat), where\n  newtype NT = N Int\nwe definitely can't discard the bang.  Trac #9844.\n\nSo what we do is to push the bang inwards, in the hope that it will\nget discarded there.  So we transform\n   !(N pat)   into    (N !pat)\n\nBut what if there is nothing to push the bang onto? In at least one instance\na user has written !(N {}) which we translate into (N !_). See #13215\n\n\n\\noindent\n{\\bf Previous @matchTwiddled@ stuff:}\n\nNow we get to the only interesting part; note: there are choices for\ntranslation [from Simon's notes]; translation~1:\n\\begin{verbatim}\ndeTwiddle [s,t] e\n\\end{verbatim}\nreturns\n\\begin{verbatim}\n[ w = e,\n  s = case w of [s,t] -> s\n  t = case w of [s,t] -> t\n]\n\\end{verbatim}\n\nHere \\tr{w} is a fresh variable, and the \\tr{w}-binding prevents multiple\nevaluation of \\tr{e}.  An alternative translation (No.~2):\n\\begin{verbatim}\n[ w = case e of [s,t] -> (s,t)\n  s = case w of (s,t) -> s\n  t = case w of (s,t) -> t\n]\n\\end{verbatim}\n\n************************************************************************\n*                                                                      *\n\\subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}\n*                                                                      *\n************************************************************************\n\nWe might be able to optimise unmixing when confronted by\nonly-one-constructor-possible, of which tuples are the most notable\nexamples.  Consider:\n\\begin{verbatim}\nf (a,b,c) ... = ...\nf d ... (e:f) = ...\nf (g,h,i) ... = ...\nf j ...       = ...\n\\end{verbatim}\nThis definition would normally be unmixed into four equation blocks,\none per equation.  But it could be unmixed into just one equation\nblock, because if the one equation matches (on the first column),\nthe others certainly will.\n\nYou have to be careful, though; the example\n\\begin{verbatim}\nf j ...       = ...\n-------------------\nf (a,b,c) ... = ...\nf d ... (e:f) = ...\nf (g,h,i) ... = ...\n\\end{verbatim}\n{\\em must} be broken into two blocks at the line shown; otherwise, you\nare forcing unnecessary evaluation.  In any case, the top-left pattern\nalways gives the cue.  You could then unmix blocks into groups of...\n\\begin{description}\n\\item[all variables:]\nAs it is now.\n\\item[constructors or variables (mixed):]\nNeed to make sure the right names get bound for the variable patterns.\n\\item[literals or variables (mixed):]\nPresumably just a variant on the constructor case (as it is now).\n\\end{description}\n\n************************************************************************\n*                                                                      *\n*  matchWrapper: a convenient way to call @match@                      *\n*                                                                      *\n************************************************************************\n\\subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}\n\nCalls to @match@ often involve similar (non-trivial) work; that work\nis collected here, in @matchWrapper@.  This function takes as\narguments:\n\\begin{itemize}\n\\item\nTypechecked @Matches@ (of a function definition, or a case or lambda\nexpression)---the main input;\n\\item\nAn error message to be inserted into any (runtime) pattern-matching\nfailure messages.\n\\end{itemize}\n\nAs results, @matchWrapper@ produces:\n\\begin{itemize}\n\\item\nA list of variables (@Locals@) that the caller must ``promise'' to\nbind to appropriate values; and\n\\item\na @CoreExpr@, the desugared output (main result).\n\\end{itemize}\n\nThe main actions of @matchWrapper@ include:\n\\begin{enumerate}\n\\item\nFlatten the @[TypecheckedMatch]@ into a suitable list of\n@EquationInfo@s.\n\\item\nCreate as many new variables as there are patterns in a pattern-list\n(in any one of the @EquationInfo@s).\n\\item\nCreate a suitable ``if it fails'' expression---a call to @error@ using\nthe error-string input; the {\\em type} of this fail value can be found\nby examining one of the RHS expressions in one of the @EquationInfo@s.\n\\item\nCall @match@ with all of this information!\n\\end{enumerate}\n-}\n\nmatchWrapper\n  :: HsMatchContext Name               -- ^ For shadowing warning messages\n  -> Maybe (LHsExpr GhcTc)             -- ^ Scrutinee, if we check a case expr\n  -> MatchGroup GhcTc (LHsExpr GhcTc)  -- ^ Matches being desugared\n  -> DsM ([Id], CoreExpr)              -- ^ Results (usually passed to 'match')\n\n{-\n There is one small problem with the Lambda Patterns, when somebody\n writes something similar to:\n\\begin{verbatim}\n    (\\ (x:xs) -> ...)\n\\end{verbatim}\n he/she don't want a warning about incomplete patterns, that is done with\n the flag @opt_WarnSimplePatterns@.\n This problem also appears in the:\n\\begin{itemize}\n\\item @do@ patterns, but if the @do@ can fail\n      it creates another equation if the match can fail\n      (see @DsExpr.doDo@ function)\n\\item @let@ patterns, are treated by @matchSimply@\n   List Comprension Patterns, are treated by @matchSimply@ also\n\\end{itemize}\n\nWe can't call @matchSimply@ with Lambda patterns,\ndue to the fact that lambda patterns can have more than\none pattern, and match simply only accepts one pattern.\n\nJJQC 30-Nov-1997\n-}\n\nmatchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches)\n                             , mg_ext = MatchGroupTc arg_tys rhs_ty\n                             , mg_origin = origin })\n  = do  { dflags <- getDynFlags\n        ; locn   <- getSrcSpanDs\n\n        ; new_vars    <- case matches of\n                           []    -> mapM newSysLocalDsNoLP arg_tys\n                           (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m))\n\n        ; eqns_info   <- mapM (mk_eqn_info new_vars) matches\n\n        -- pattern match check warnings\n        ; unless (isGenerated origin) $\n          when (isAnyPmCheckEnabled dflags (DsMatchContext ctxt locn)) $\n          addTmCsDs (genCaseTmCs1 mb_scr new_vars) $\n              -- See Note [Type and Term Equality Propagation]\n          checkMatches dflags (DsMatchContext ctxt locn) new_vars matches\n\n        ; result_expr <- handleWarnings $\n                         matchEquations ctxt new_vars eqns_info rhs_ty\n        ; return (new_vars, result_expr) }\n  where\n    mk_eqn_info vars (dL->L _ (Match { m_pats = pats, m_grhss = grhss }))\n      = do { dflags <- getDynFlags\n           ; let upats = map (unLoc . decideBangHood dflags) pats\n                 dicts = collectEvVarsPats upats\n           ; tm_cs <- genCaseTmCs2 mb_scr upats vars\n           ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]\n                             addTmCsDs tm_cs  $ -- See Note [Type and Term Equality Propagation]\n                             dsGRHSs ctxt grhss rhs_ty\n           ; return (EqnInfo { eqn_pats = upats\n                             , eqn_orig = FromSource\n                             , eqn_rhs = match_result }) }\n    mk_eqn_info _ (dL->L _ (XMatch _)) = panic \"matchWrapper\"\n    mk_eqn_info _ _  = panic \"mk_eqn_info: Impossible Match\" -- due to #15884\n\n    handleWarnings = if isGenerated origin\n                     then discardWarningsDs\n                     else id\nmatchWrapper _ _ (XMatchGroup _) = panic \"matchWrapper\"\n\nmatchEquations  :: HsMatchContext Name\n                -> [MatchId] -> [EquationInfo] -> Type\n                -> DsM CoreExpr\nmatchEquations ctxt vars eqns_info rhs_ty\n  = do  { let error_doc = matchContextErrString ctxt\n\n        ; match_result <- match vars rhs_ty eqns_info\n\n        ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc\n        ; extractMatchResult match_result fail_expr }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}\n*                                                                      *\n************************************************************************\n\n@mkSimpleMatch@ is a wrapper for @match@ which deals with the\nsituation where we want to match a single expression against a single\npattern. It returns an expression.\n-}\n\nmatchSimply :: CoreExpr                 -- ^ Scrutinee\n            -> HsMatchContext Name      -- ^ Match kind\n            -> LPat GhcTc               -- ^ Pattern it should match\n            -> CoreExpr                 -- ^ Return this if it matches\n            -> CoreExpr                 -- ^ Return this if it doesn't\n            -> DsM CoreExpr\n-- Do not warn about incomplete patterns; see matchSinglePat comments\nmatchSimply scrut hs_ctx pat result_expr fail_expr = do\n    let\n      match_result = cantFailMatchResult result_expr\n      rhs_ty       = exprType fail_expr\n        -- Use exprType of fail_expr, because won't refine in the case of failure!\n    match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result\n    extractMatchResult match_result' fail_expr\n\nmatchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc\n               -> Type -> MatchResult -> DsM MatchResult\n-- matchSinglePat ensures that the scrutinee is a variable\n-- and then calls matchSinglePatVar\n--\n-- matchSinglePat does not warn about incomplete patterns\n-- Used for things like [ e | pat <- stuff ], where\n-- incomplete patterns are just fine\n\nmatchSinglePat (Var var) ctx pat ty match_result\n  | not (isExternalName (idName var))\n  = matchSinglePatVar var ctx pat ty match_result\n\nmatchSinglePat scrut hs_ctx pat ty match_result\n  = do { var           <- selectSimpleMatchVarL pat\n       ; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result\n       ; return (adjustMatchResult (bindNonRec var scrut) match_result') }\n\nmatchSinglePatVar :: Id   -- See Note [Match Ids]\n                  -> HsMatchContext Name -> LPat GhcTc\n                  -> Type -> MatchResult -> DsM MatchResult\nmatchSinglePatVar var ctx pat ty match_result\n  = ASSERT2( isInternalName (idName var), ppr var )\n    do { dflags <- getDynFlags\n       ; locn   <- getSrcSpanDs\n\n                    -- Pattern match check warnings\n       ; checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat)\n\n       ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)]\n                                , eqn_orig = FromSource\n                                , eqn_rhs  = match_result }\n       ; match [var] ty [eqn_info] }\n\n\n{-\n************************************************************************\n*                                                                      *\n                Pattern classification\n*                                                                      *\n************************************************************************\n-}\n\ndata PatGroup\n  = PgAny               -- Immediate match: variables, wildcards,\n                        --                  lazy patterns\n  | PgCon DataCon       -- Constructor patterns (incl list, tuple)\n  | PgSyn PatSyn [Type] -- See Note [Pattern synonym groups]\n  | PgLit Literal       -- Literal patterns\n  | PgN   Rational      -- Overloaded numeric literals;\n                        -- see Note [Don't use Literal for PgN]\n  | PgOverS FastString  -- Overloaded string literals\n  | PgNpK Integer       -- n+k patterns\n  | PgBang              -- Bang patterns\n  | PgCo Type           -- Coercion patterns; the type is the type\n                        --      of the pattern *inside*\n  | PgView (LHsExpr GhcTc) -- view pattern (e -> p):\n                        -- the LHsExpr is the expression e\n           Type         -- the Type is the type of p (equivalently, the result type of e)\n  | PgOverloadedList\n\n{- Note [Don't use Literal for PgN]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPreviously we had, as PatGroup constructors\n\n  | ...\n  | PgN   Literal       -- Overloaded literals\n  | PgNpK Literal       -- n+k patterns\n  | ...\n\nBut Literal is really supposed to represent an *unboxed* literal, like Int#.\nWe were sticking the literal from, say, an overloaded numeric literal pattern\ninto a LitInt constructor. This didn't really make sense; and we now have\nthe invariant that value in a LitInt must be in the range of the target\nmachine's Int# type, and an overloaded literal could meaningfully be larger.\n\nSolution: For pattern grouping purposes, just store the literal directly in\nthe PgN constructor as a Rational if numeric, and add a PgOverStr constructor\nfor overloaded strings.\n-}\n\ngroupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]]\n-- If the result is of form [g1, g2, g3],\n-- (a) all the (pg,eq) pairs in g1 have the same pg\n-- (b) none of the gi are empty\n-- The ordering of equations is unchanged\ngroupEquations dflags eqns\n  = groupBy same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]\n  where\n    same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool\n    (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2\n\nsubGroup :: (m -> [[EquationInfo]]) -- Map.elems\n         -> m -- Map.empty\n         -> (a -> m -> Maybe [EquationInfo]) -- Map.lookup\n         -> (a -> [EquationInfo] -> m -> m) -- Map.insert\n         -> [(a, EquationInfo)] -> [[EquationInfo]]\n-- Input is a particular group.  The result sub-groups the\n-- equations by with particular constructor, literal etc they match.\n-- Each sub-list in the result has the same PatGroup\n-- See Note [Take care with pattern order]\n-- Parameterized by map operations to allow different implementations\n-- and constraints, eg. types without Ord instance.\nsubGroup elems empty lookup insert group\n    = map reverse $ elems $ foldl' accumulate empty group\n  where\n    accumulate pg_map (pg, eqn)\n      = case lookup pg pg_map of\n          Just eqns -> insert pg (eqn:eqns) pg_map\n          Nothing   -> insert pg [eqn]      pg_map\n    -- pg_map :: Map a [EquationInfo]\n    -- Equations seen so far in reverse order of appearance\n\nsubGroupOrd :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]\nsubGroupOrd = subGroup Map.elems Map.empty Map.lookup Map.insert\n\nsubGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [[EquationInfo]]\nsubGroupUniq =\n  subGroup eltsUDFM emptyUDFM (flip lookupUDFM) (\\k v m -> addToUDFM m k v)\n\n{- Note [Pattern synonym groups]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we see\n  f (P a) = e1\n  f (P b) = e2\n    ...\nwhere P is a pattern synonym, can we put (P a -> e1) and (P b -> e2) in the\nsame group?  We can if P is a constructor, but /not/ if P is a pattern synonym.\nConsider (Trac #11224)\n   -- readMaybe :: Read a => String -> Maybe a\n   pattern PRead :: Read a => () => a -> String\n   pattern PRead a <- (readMaybe -> Just a)\n\n   f (PRead (x::Int))  = e1\n   f (PRead (y::Bool)) = e2\nThis is all fine: we match the string by trying to read an Int; if that\nfails we try to read a Bool. But clearly we can't combine the two into a single\nmatch.\n\nConclusion: we can combine when we invoke PRead /at the same type/.  Hence\nin PgSyn we record the instantiaing types, and use them in sameGroup.\n\nNote [Take care with pattern order]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the subGroup function we must be very careful about pattern re-ordering,\nConsider the patterns [ (True, Nothing), (False, x), (True, y) ]\nThen in bringing together the patterns for True, we must not\nswap the Nothing and y!\n-}\n\nsameGroup :: PatGroup -> PatGroup -> Bool\n-- Same group means that a single case expression\n-- or test will suffice to match both, *and* the order\n-- of testing within the group is insignificant.\nsameGroup PgAny         PgAny         = True\nsameGroup PgBang        PgBang        = True\nsameGroup (PgCon _)     (PgCon _)     = True    -- One case expression\nsameGroup (PgSyn p1 t1) (PgSyn p2 t2) = p1==p2 && eqTypes t1 t2\n                                                -- eqTypes: See Note [Pattern synonym groups]\nsameGroup (PgLit _)     (PgLit _)     = True    -- One case expression\nsameGroup (PgN l1)      (PgN l2)      = l1==l2  -- Order is significant\nsameGroup (PgOverS s1)  (PgOverS s2)  = s1==s2\nsameGroup (PgNpK l1)    (PgNpK l2)    = l1==l2  -- See Note [Grouping overloaded literal patterns]\nsameGroup (PgCo t1)     (PgCo t2)     = t1 `eqType` t2\n        -- CoPats are in the same goup only if the type of the\n        -- enclosed pattern is the same. The patterns outside the CoPat\n        -- always have the same type, so this boils down to saying that\n        -- the two coercions are identical.\nsameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2)\n       -- ViewPats are in the same group iff the expressions\n       -- are \"equal\"---conservatively, we use syntactic equality\nsameGroup _          _          = False\n\n-- An approximation of syntactic equality used for determining when view\n-- exprs are in the same group.\n-- This function can always safely return false;\n-- but doing so will result in the application of the view function being repeated.\n--\n-- Currently: compare applications of literals and variables\n--            and anything else that we can do without involving other\n--            HsSyn types in the recursion\n--\n-- NB we can't assume that the two view expressions have the same type.  Consider\n--   f (e1 -> True) = ...\n--   f (e2 -> \"hi\") = ...\nviewLExprEq :: (LHsExpr GhcTc,Type) -> (LHsExpr GhcTc,Type) -> Bool\nviewLExprEq (e1,_) (e2,_) = lexp e1 e2\n  where\n    lexp :: LHsExpr GhcTc -> LHsExpr GhcTc -> Bool\n    lexp e e' = exp (unLoc e) (unLoc e')\n\n    ---------\n    exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool\n    -- real comparison is on HsExpr's\n    -- strip parens\n    exp (HsPar _ (dL->L _ e)) e'   = exp e e'\n    exp e (HsPar _ (dL->L _ e'))   = exp e e'\n    -- because the expressions do not necessarily have the same type,\n    -- we have to compare the wrappers\n    exp (HsWrap _ h e) (HsWrap _ h' e') = wrap h h' && exp e e'\n    exp (HsVar _ i) (HsVar _ i') =  i == i'\n    exp (HsConLikeOut _ c) (HsConLikeOut _ c') = c == c'\n    -- the instance for IPName derives using the id, so this works if the\n    -- above does\n    exp (HsIPVar _ i) (HsIPVar _ i') = i == i'\n    exp (HsOverLabel _ l x) (HsOverLabel _ l' x') = l == l' && x == x'\n    exp (HsOverLit _ l) (HsOverLit _ l') =\n        -- Overloaded lits are equal if they have the same type\n        -- and the data is the same.\n        -- this is coarser than comparing the SyntaxExpr's in l and l',\n        -- which resolve the overloading (e.g., fromInteger 1),\n        -- because these expressions get written as a bunch of different variables\n        -- (presumably to improve sharing)\n        eqType (overLitType l) (overLitType l') && l == l'\n    exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2'\n    -- the fixities have been straightened out by now, so it's safe\n    -- to ignore them?\n    exp (OpApp _ l o ri) (OpApp _ l' o' ri') =\n        lexp l l' && lexp o o' && lexp ri ri'\n    exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n'\n    exp (SectionL _ e1 e2) (SectionL _ e1' e2') =\n        lexp e1 e1' && lexp e2 e2'\n    exp (SectionR _ e1 e2) (SectionR _ e1' e2') =\n        lexp e1 e1' && lexp e2 e2'\n    exp (ExplicitTuple _ es1 _) (ExplicitTuple _ es2 _) =\n        eq_list tup_arg es1 es2\n    exp (ExplicitSum _ _ _ e) (ExplicitSum _ _ _ e') = lexp e e'\n    exp (HsIf _ _ e e1 e2) (HsIf _ _ e' e1' e2') =\n        lexp e e' && lexp e1 e1' && lexp e2 e2'\n\n    -- Enhancement: could implement equality for more expressions\n    --   if it seems useful\n    -- But no need for HsLit, ExplicitList, ExplicitTuple,\n    -- because they cannot be functions\n    exp _ _  = False\n\n    ---------\n    syn_exp :: SyntaxExpr GhcTc -> SyntaxExpr GhcTc -> Bool\n    syn_exp (SyntaxExpr { syn_expr      = expr1\n                        , syn_arg_wraps = arg_wraps1\n                        , syn_res_wrap  = res_wrap1 })\n            (SyntaxExpr { syn_expr      = expr2\n                        , syn_arg_wraps = arg_wraps2\n                        , syn_res_wrap  = res_wrap2 })\n      = exp expr1 expr2 &&\n        and (zipWithEqual \"viewLExprEq\" wrap arg_wraps1 arg_wraps2) &&\n        wrap res_wrap1 res_wrap2\n\n    ---------\n    tup_arg (dL->L _ (Present _ e1)) (dL->L _ (Present _ e2)) = lexp e1 e2\n    tup_arg (dL->L _ (Missing t1))   (dL->L _ (Missing t2))   = eqType t1 t2\n    tup_arg _ _ = False\n\n    ---------\n    wrap :: HsWrapper -> HsWrapper -> Bool\n    -- Conservative, in that it demands that wrappers be\n    -- syntactically identical and doesn't look under binders\n    --\n    -- Coarser notions of equality are possible\n    -- (e.g., reassociating compositions,\n    --        equating different ways of writing a coercion)\n    wrap WpHole WpHole = True\n    wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'\n    wrap (WpFun w1 w2 _ _) (WpFun w1' w2' _ _) = wrap w1 w1' && wrap w2 w2'\n    wrap (WpCast co)       (WpCast co')        = co `eqCoercion` co'\n    wrap (WpEvApp et1)     (WpEvApp et2)       = et1 `ev_term` et2\n    wrap (WpTyApp t)       (WpTyApp t')        = eqType t t'\n    -- Enhancement: could implement equality for more wrappers\n    --   if it seems useful (lams and lets)\n    wrap _ _ = False\n\n    ---------\n    ev_term :: EvTerm -> EvTerm -> Bool\n    ev_term (EvExpr (Var a)) (EvExpr  (Var b)) = a==b\n    ev_term (EvExpr (Coercion a)) (EvExpr (Coercion b)) = a `eqCoercion` b\n    ev_term _ _ = False\n\n    ---------\n    eq_list :: (a->a->Bool) -> [a] -> [a] -> Bool\n    eq_list _  []     []     = True\n    eq_list _  []     (_:_)  = False\n    eq_list _  (_:_)  []     = False\n    eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys\n\npatGroup :: DynFlags -> Pat GhcTc -> PatGroup\npatGroup _ (ConPatOut { pat_con = (dL->L _ con)\n                      , pat_arg_tys = tys })\n | RealDataCon dcon <- con              = PgCon dcon\n | PatSynCon psyn <- con                = PgSyn psyn tys\npatGroup _ (WildPat {})                 = PgAny\npatGroup _ (BangPat {})                 = PgBang\npatGroup _ (NPat _ (dL->L _ (OverLit {ol_val=oval})) mb_neg _) =\n  case (oval, isJust mb_neg) of\n   (HsIntegral   i, False) -> PgN (fromInteger (il_value i))\n   (HsIntegral   i, True ) -> PgN (-fromInteger (il_value i))\n   (HsFractional r, False) -> PgN (fl_value r)\n   (HsFractional r, True ) -> PgN (-fl_value r)\n   (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)\n                          PgOverS s\npatGroup _ (NPlusKPat _ _ (dL->L _ (OverLit {ol_val=oval})) _ _ _) =\n  case oval of\n   HsIntegral i -> PgNpK (il_value i)\n   _ -> pprPanic \"patGroup NPlusKPat\" (ppr oval)\npatGroup _ (CoPat _ _ p _)              = PgCo  (hsPatType p)\n                                                    -- Type of innelexp pattern\npatGroup _ (ViewPat _ expr p)           = PgView expr (hsPatType (unLoc p))\npatGroup _ (ListPat (ListPatTc _ (Just _)) _) = PgOverloadedList\npatGroup dflags (LitPat _ lit)          = PgLit (hsLitKey dflags lit)\npatGroup _ pat                          = pprPanic \"patGroup\" (ppr pat)\n\n{-\nNote [Grouping overloaded literal patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWATCH OUT!  Consider\n\n        f (n+1) = ...\n        f (n+2) = ...\n        f (n+1) = ...\n\nWe can't group the first and third together, because the second may match\nthe same thing as the first.  Same goes for *overloaded* literal patterns\n        f 1 True = ...\n        f 2 False = ...\n        f 1 False = ...\nIf the first arg matches '1' but the second does not match 'True', we\ncannot jump to the third equation!  Because the same argument might\nmatch '2'!\nHence we don't regard 1 and 2, or (n+1) and (n+2), as part of the same group.\n-}\n", "num_lines": 1130}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nPattern-matching constructors\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule MatchCon ( matchConFamily, matchPatSyn ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} Match     ( match )\n\nimport HsSyn\nimport DsBinds\nimport ConLike\nimport BasicTypes ( Origin(..) )\nimport TcType\nimport DsMonad\nimport DsUtils\nimport MkCore   ( mkCoreLets )\nimport Util\nimport Id\nimport NameEnv\nimport FieldLabel ( flSelector )\nimport SrcLoc\nimport Outputable\nimport Control.Monad(liftM)\nimport Data.List (groupBy)\n\n{-\nWe are confronted with the first column of patterns in a set of\nequations, all beginning with constructors from one ``family'' (e.g.,\n@[]@ and @:@ make up the @List@ ``family'').  We want to generate the\nalternatives for a @Case@ expression.  There are several choices:\n\\begin{enumerate}\n\\item\nGenerate an alternative for every constructor in the family, whether\nthey are used in this set of equations or not; this is what the Wadler\nchapter does.\n\\begin{description}\n\\item[Advantages:]\n(a)~Simple.  (b)~It may also be that large sparsely-used constructor\nfamilies are mainly handled by the code for literals.\n\\item[Disadvantages:]\n(a)~Not practical for large sparsely-used constructor families, e.g.,\nthe ASCII character set.  (b)~Have to look up a list of what\nconstructors make up the whole family.\n\\end{description}\n\n\\item\nGenerate an alternative for each constructor used, then add a default\nalternative in case some constructors in the family weren't used.\n\\begin{description}\n\\item[Advantages:]\n(a)~Alternatives aren't generated for unused constructors.  (b)~The\nSTG is quite happy with defaults.  (c)~No lookup in an environment needed.\n\\item[Disadvantages:]\n(a)~A spurious default alternative may be generated.\n\\end{description}\n\n\\item\n``Do it right:'' generate an alternative for each constructor used,\nand add a default alternative if all constructors in the family\nweren't used.\n\\begin{description}\n\\item[Advantages:]\n(a)~You will get cases with only one alternative (and no default),\nwhich should be amenable to optimisation.  Tuples are a common example.\n\\item[Disadvantages:]\n(b)~Have to look up constructor families in TDE (as above).\n\\end{description}\n\\end{enumerate}\n\nWe are implementing the ``do-it-right'' option for now.  The arguments\nto @matchConFamily@ are the same as to @match@; the extra @Int@\nreturned is the number of constructors in the family.\n\nThe function @matchConFamily@ is concerned with this\nhave-we-used-all-the-constructors? question; the local function\n@match_cons_used@ does all the real work.\n-}\n\nmatchConFamily :: [Id]\n               -> Type\n               -> [[EquationInfo]]\n               -> DsM MatchResult\n-- Each group of eqns is for a single constructor\nmatchConFamily (var:vars) ty groups\n  = do alts <- mapM (fmap toRealAlt . matchOneConLike vars ty) groups\n       return (mkCoAlgCaseMatchResult var ty alts)\n  where\n    toRealAlt alt = case alt_pat alt of\n        RealDataCon dcon -> alt{ alt_pat = dcon }\n        _ -> panic \"matchConFamily: not RealDataCon\"\nmatchConFamily [] _ _ = panic \"matchConFamily []\"\n\nmatchPatSyn :: [Id]\n            -> Type\n            -> [EquationInfo]\n            -> DsM MatchResult\nmatchPatSyn (var:vars) ty eqns\n  = do alt <- fmap toSynAlt $ matchOneConLike vars ty eqns\n       return (mkCoSynCaseMatchResult var ty alt)\n  where\n    toSynAlt alt = case alt_pat alt of\n        PatSynCon psyn -> alt{ alt_pat = psyn }\n        _ -> panic \"matchPatSyn: not PatSynCon\"\nmatchPatSyn _ _ _ = panic \"matchPatSyn []\"\n\ntype ConArgPats = HsConDetails (LPat GhcTc) (HsRecFields GhcTc (LPat GhcTc))\n\nmatchOneConLike :: [Id]\n                -> Type\n                -> [EquationInfo]\n                -> DsM (CaseAlt ConLike)\nmatchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor\n  = do  { let inst_tys = ASSERT( all tcIsTcTyVar ex_tvs )\n                           -- ex_tvs can only be tyvars as data types in source\n                           -- Haskell cannot mention covar yet (Aug 2018).\n                         ASSERT( tvs1 `equalLength` ex_tvs )\n                         arg_tys ++ mkTyVarTys tvs1\n\n              val_arg_tys = conLikeInstOrigArgTys con1 inst_tys\n        -- dataConInstOrigArgTys takes the univ and existential tyvars\n        -- and returns the types of the *value* args, which is what we want\n\n              match_group :: [Id]\n                          -> [(ConArgPats, EquationInfo)] -> DsM MatchResult\n              -- All members of the group have compatible ConArgPats\n              match_group arg_vars arg_eqn_prs\n                = ASSERT( notNull arg_eqn_prs )\n                  do { (wraps, eqns') <- liftM unzip (mapM shift arg_eqn_prs)\n                     ; let group_arg_vars = select_arg_vars arg_vars arg_eqn_prs\n                     ; match_result <- match (group_arg_vars ++ vars) ty eqns'\n                     ; return (adjustMatchResult (foldr1 (.) wraps) match_result) }\n\n              shift (_, eqn@(EqnInfo { eqn_pats = ConPatOut{ pat_tvs = tvs, pat_dicts = ds,\n                                                             pat_binds = bind, pat_args = args\n                                                  } : pats }))\n                = do ds_bind <- dsTcEvBinds bind\n                     return ( wrapBinds (tvs `zip` tvs1)\n                            . wrapBinds (ds  `zip` dicts1)\n                            . mkCoreLets ds_bind\n                            , eqn { eqn_orig = Generated\n                                  , eqn_pats = conArgPats val_arg_tys args ++ pats }\n                            )\n              shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic \"matchOneCon/shift\" (ppr ps)\n\n        ; arg_vars <- selectConMatchVars val_arg_tys args1\n                -- Use the first equation as a source of\n                -- suggestions for the new variables\n\n        -- Divide into sub-groups; see Note [Record patterns]\n        ; let groups :: [[(ConArgPats, EquationInfo)]]\n              groups = groupBy compatible_pats [ (pat_args (firstPat eqn), eqn)\n                                               | eqn <- eqn1:eqns ]\n\n        ; match_results <- mapM (match_group arg_vars) groups\n\n        ; return $ MkCaseAlt{ alt_pat = con1,\n                              alt_bndrs = tvs1 ++ dicts1 ++ arg_vars,\n                              alt_wrapper = wrapper1,\n                              alt_result = foldr1 combineMatchResults match_results } }\n  where\n    ConPatOut { pat_con = (dL->L _ con1)\n              , pat_arg_tys = arg_tys, pat_wrap = wrapper1,\n                pat_tvs = tvs1, pat_dicts = dicts1, pat_args = args1 }\n              = firstPat eqn1\n    fields1 = map flSelector (conLikeFieldLabels con1)\n\n    ex_tvs = conLikeExTyCoVars con1\n\n    -- Choose the right arg_vars in the right order for this group\n    -- Note [Record patterns]\n    select_arg_vars :: [Id] -> [(ConArgPats, EquationInfo)] -> [Id]\n    select_arg_vars arg_vars ((arg_pats, _) : _)\n      | RecCon flds <- arg_pats\n      , let rpats = rec_flds flds\n      , not (null rpats)     -- Treated specially; cf conArgPats\n      = ASSERT2( fields1 `equalLength` arg_vars,\n                 ppr con1 $$ ppr fields1 $$ ppr arg_vars )\n        map lookup_fld rpats\n      | otherwise\n      = arg_vars\n      where\n        fld_var_env = mkNameEnv $ zipEqual \"get_arg_vars\" fields1 arg_vars\n        lookup_fld (dL->L _ rpat) = lookupNameEnv_NF fld_var_env\n                                            (idName (unLoc (hsRecFieldId rpat)))\n    select_arg_vars _ [] = panic \"matchOneCon/select_arg_vars []\"\nmatchOneConLike _ _ [] = panic \"matchOneCon []\"\n\n-----------------\ncompatible_pats :: (ConArgPats,a) -> (ConArgPats,a) -> Bool\n-- Two constructors have compatible argument patterns if the number\n-- and order of sub-matches is the same in both cases\ncompatible_pats (RecCon flds1, _) (RecCon flds2, _) = same_fields flds1 flds2\ncompatible_pats (RecCon flds1, _) _                 = null (rec_flds flds1)\ncompatible_pats _                 (RecCon flds2, _) = null (rec_flds flds2)\ncompatible_pats _                 _                 = True -- Prefix or infix con\n\nsame_fields :: HsRecFields GhcTc (LPat GhcTc) -> HsRecFields GhcTc (LPat GhcTc)\n            -> Bool\nsame_fields flds1 flds2\n  = all2 (\\(dL->L _ f1) (dL->L _ f2)\n                          -> unLoc (hsRecFieldId f1) == unLoc (hsRecFieldId f2))\n         (rec_flds flds1) (rec_flds flds2)\n\n\n-----------------\nselectConMatchVars :: [Type] -> ConArgPats -> DsM [Id]\nselectConMatchVars arg_tys (RecCon {})      = newSysLocalsDsNoLP arg_tys\nselectConMatchVars _       (PrefixCon ps)   = selectMatchVars (map unLoc ps)\nselectConMatchVars _       (InfixCon p1 p2) = selectMatchVars [unLoc p1, unLoc p2]\n\nconArgPats :: [Type]      -- Instantiated argument types\n                          -- Used only to fill in the types of WildPats, which\n                          -- are probably never looked at anyway\n           -> ConArgPats\n           -> [Pat GhcTc]\nconArgPats _arg_tys (PrefixCon ps)   = map unLoc ps\nconArgPats _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2]\nconArgPats  arg_tys (RecCon (HsRecFields { rec_flds = rpats }))\n  | null rpats = map WildPat arg_tys\n        -- Important special case for C {}, which can be used for a\n        -- datacon that isn't declared to have fields at all\n  | otherwise  = map (unLoc . hsRecFieldArg . unLoc) rpats\n\n{-\nNote [Record patterns]\n~~~~~~~~~~~~~~~~~~~~~~\nConsider\n         data T = T { x,y,z :: Bool }\n\n         f (T { y=True, x=False }) = ...\n\nWe must match the patterns IN THE ORDER GIVEN, thus for the first\none we match y=True before x=False.  See Trac #246; or imagine\nmatching against (T { y=False, x=undefined }): should fail without\ntouching the undefined.\n\nNow consider:\n\n         f (T { y=True, x=False }) = ...\n         f (T { x=True, y= False}) = ...\n\nIn the first we must test y first; in the second we must test x\nfirst.  So we must divide even the equations for a single constructor\nT into sub-goups, based on whether they match the same field in the\nsame order.  That's what the (groupBy compatible_pats) grouping.\n\nAll non-record patterns are \"compatible\" in this sense, because the\npositional patterns (T a b) and (a `T` b) all match the arguments\nin order.  Also T {} is special because it's equivalent to (T _ _).\nHence the (null rpats) checks here and there.\n\n\nNote [Existentials in shift_con_pat]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n        data T = forall a. Ord a => T a (a->Int)\n\n        f (T x f) True  = ...expr1...\n        f (T y g) False = ...expr2..\n\nWhen we put in the tyvars etc we get\n\n        f (T a (d::Ord a) (x::a) (f::a->Int)) True =  ...expr1...\n        f (T b (e::Ord b) (y::a) (g::a->Int)) True =  ...expr2...\n\nAfter desugaring etc we'll get a single case:\n\n        f = \\t::T b::Bool ->\n            case t of\n               T a (d::Ord a) (x::a) (f::a->Int)) ->\n            case b of\n                True  -> ...expr1...\n                False -> ...expr2...\n\n*** We have to substitute [a/b, d/e] in expr2! **\nHence\n                False -> ....((/\\b\\(e:Ord b).expr2) a d)....\n\nOriginally I tried to use\n        (\\b -> let e = d in expr2) a\nto do this substitution.  While this is \"correct\" in a way, it fails\nLint, because e::Ord b but d::Ord a.\n\n-}\n", "num_lines": 297}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nPattern-matching literal patterns\n-}\n\n{-# LANGUAGE CPP, ScopedTypeVariables #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule MatchLit ( dsLit, dsOverLit, hsLitKey\n                , tidyLitPat, tidyNPat\n                , matchLiterals, matchNPlusKPats, matchNPats\n                , warnAboutIdentities\n                , warnAboutOverflowedOverLit, warnAboutOverflowedLit\n                , warnAboutEmptyEnumerations\n                ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} Match  ( match )\nimport {-# SOURCE #-} DsExpr ( dsExpr, dsSyntaxExpr )\n\nimport DsMonad\nimport DsUtils\n\nimport HsSyn\n\nimport Id\nimport CoreSyn\nimport MkCore\nimport TyCon\nimport DataCon\nimport TcHsSyn ( shortCutLit )\nimport TcType\nimport Name\nimport Type\nimport PrelNames\nimport TysWiredIn\nimport TysPrim\nimport Literal\nimport SrcLoc\nimport Data.Ratio\nimport Outputable\nimport BasicTypes\nimport DynFlags\nimport Util\nimport FastString\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Data.Int\nimport Data.Word\nimport Data.Proxy\n\n{-\n************************************************************************\n*                                                                      *\n                Desugaring literals\n        [used to be in DsExpr, but DsMeta needs it,\n         and it's nice to avoid a loop]\n*                                                                      *\n************************************************************************\n\nWe give int/float literals type @Integer@ and @Rational@, respectively.\nThe typechecker will (presumably) have put \\tr{from{Integer,Rational}s}\naround them.\n\nToDo: put in range checks for when converting ``@i@''\n(or should that be in the typechecker?)\n\nFor numeric literals, we try to detect there use at a standard type\n(@Int@, @Float@, etc.) are directly put in the right constructor.\n[NB: down with the @App@ conversion.]\n\nSee also below where we look for @DictApps@ for \\tr{plusInt}, etc.\n-}\n\ndsLit :: HsLit GhcRn -> DsM CoreExpr\ndsLit l = do\n  dflags <- getDynFlags\n  case l of\n    HsStringPrim _ s -> return (Lit (LitString s))\n    HsCharPrim   _ c -> return (Lit (LitChar c))\n    HsIntPrim    _ i -> return (Lit (mkLitIntWrap dflags i))\n    HsWordPrim   _ w -> return (Lit (mkLitWordWrap dflags w))\n    HsInt64Prim  _ i -> return (Lit (mkLitInt64Wrap dflags i))\n    HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap dflags w))\n    HsFloatPrim  _ f -> return (Lit (LitFloat (fl_value f)))\n    HsDoublePrim _ d -> return (Lit (LitDouble (fl_value d)))\n    HsChar _ c       -> return (mkCharExpr c)\n    HsString _ str   -> mkStringExprFS str\n    HsInteger _ i _  -> mkIntegerExpr i\n    HsInt _ i        -> return (mkIntExpr dflags (il_value i))\n    XLit x           -> pprPanic \"dsLit\" (ppr x)\n    HsRat _ (FL _ _ val) ty -> do\n      num   <- mkIntegerExpr (numerator val)\n      denom <- mkIntegerExpr (denominator val)\n      return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])\n      where\n        (ratio_data_con, integer_ty)\n            = case tcSplitTyConApp ty of\n                    (tycon, [i_ty]) -> ASSERT(isIntegerTy i_ty && tycon `hasKey` ratioTyConKey)\n                                       (head (tyConDataCons tycon), i_ty)\n                    x -> pprPanic \"dsLit\" (ppr x)\n\ndsOverLit :: HsOverLit GhcTc -> DsM CoreExpr\n-- ^ Post-typechecker, the 'HsExpr' field of an 'OverLit' contains\n-- (an expression for) the literal value itself.\ndsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty\n                   , ol_witness = witness }) = do\n  dflags <- getDynFlags\n  case shortCutLit dflags val ty of\n    Just expr | not rebindable -> dsExpr expr        -- Note [Literal short cut]\n    _                          -> dsExpr witness\ndsOverLit XOverLit{} = panic \"dsOverLit\"\n{-\nNote [Literal short cut]\n~~~~~~~~~~~~~~~~~~~~~~~~\nThe type checker tries to do this short-cutting as early as possible, but\nbecause of unification etc, more information is available to the desugarer.\nAnd where it's possible to generate the correct literal right away, it's\nmuch better to do so.\n\n\n************************************************************************\n*                                                                      *\n                 Warnings about overflowed literals\n*                                                                      *\n************************************************************************\n\nWarn about functions like toInteger, fromIntegral, that convert\nbetween one type and another when the to- and from- types are the\nsame.  Then it's probably (albeit not definitely) the identity\n-}\n\nwarnAboutIdentities :: DynFlags -> CoreExpr -> Type -> DsM ()\nwarnAboutIdentities dflags (Var conv_fn) type_of_conv\n  | wopt Opt_WarnIdentities dflags\n  , idName conv_fn `elem` conversionNames\n  , Just (arg_ty, res_ty) <- splitFunTy_maybe type_of_conv\n  , arg_ty `eqType` res_ty  -- So we are converting  ty -> ty\n  = warnDs (Reason Opt_WarnIdentities)\n           (vcat [ text \"Call of\" <+> ppr conv_fn <+> dcolon <+> ppr type_of_conv\n                 , nest 2 $ text \"can probably be omitted\"\n           ])\nwarnAboutIdentities _ _ _ = return ()\n\nconversionNames :: [Name]\nconversionNames\n  = [ toIntegerName, toRationalName\n    , fromIntegralName, realToFracName ]\n -- We can't easily add fromIntegerName, fromRationalName,\n -- because they are generated by literals\n\n\n-- | Emit warnings on overloaded integral literals which overflow the bounds\n-- implied by their type.\nwarnAboutOverflowedOverLit :: HsOverLit GhcTc -> DsM ()\nwarnAboutOverflowedOverLit hsOverLit = do\n  dflags <- getDynFlags\n  warnAboutOverflowedLiterals dflags (getIntegralLit hsOverLit)\n\n-- | Emit warnings on integral literals which overflow the boudns implied by\n-- their type.\nwarnAboutOverflowedLit :: HsLit GhcTc -> DsM ()\nwarnAboutOverflowedLit hsLit = do\n  dflags <- getDynFlags\n  warnAboutOverflowedLiterals dflags (getSimpleIntegralLit hsLit)\n\n-- | Emit warnings on integral literals which overflow the bounds implied by\n-- their type.\nwarnAboutOverflowedLiterals\n  :: DynFlags\n  -> Maybe (Integer, Name)  -- ^ the literal value and name of its tycon\n  -> DsM ()\nwarnAboutOverflowedLiterals dflags lit\n | wopt Opt_WarnOverflowedLiterals dflags\n , Just (i, tc) <- lit\n =  if      tc == intTyConName     then check i tc (Proxy :: Proxy Int)\n\n    -- These only show up via the 'HsOverLit' route\n    else if tc == int8TyConName    then check i tc (Proxy :: Proxy Int8)\n    else if tc == int16TyConName   then check i tc (Proxy :: Proxy Int16)\n    else if tc == int32TyConName   then check i tc (Proxy :: Proxy Int32)\n    else if tc == int64TyConName   then check i tc (Proxy :: Proxy Int64)\n    else if tc == wordTyConName    then check i tc (Proxy :: Proxy Word)\n    else if tc == word8TyConName   then check i tc (Proxy :: Proxy Word8)\n    else if tc == word16TyConName  then check i tc (Proxy :: Proxy Word16)\n    else if tc == word32TyConName  then check i tc (Proxy :: Proxy Word32)\n    else if tc == word64TyConName  then check i tc (Proxy :: Proxy Word64)\n    else if tc == naturalTyConName then checkPositive i tc\n\n    -- These only show up via the 'HsLit' route\n    else if tc == intPrimTyConName    then check i tc (Proxy :: Proxy Int)\n    else if tc == int8PrimTyConName   then check i tc (Proxy :: Proxy Int8)\n    else if tc == int32PrimTyConName  then check i tc (Proxy :: Proxy Int32)\n    else if tc == int64PrimTyConName  then check i tc (Proxy :: Proxy Int64)\n    else if tc == wordPrimTyConName   then check i tc (Proxy :: Proxy Word)\n    else if tc == word8PrimTyConName  then check i tc (Proxy :: Proxy Word8)\n    else if tc == word32PrimTyConName then check i tc (Proxy :: Proxy Word32)\n    else if tc == word64PrimTyConName then check i tc (Proxy :: Proxy Word64)\n\n    else return ()\n\n  | otherwise = return ()\n  where\n\n    checkPositive :: Integer -> Name -> DsM ()\n    checkPositive i tc\n      = when (i < 0) $ do\n        warnDs (Reason Opt_WarnOverflowedLiterals)\n               (vcat [ text \"Literal\" <+> integer i\n                       <+> text \"is negative but\" <+> ppr tc\n                       <+> ptext (sLit \"only supports positive numbers\")\n                     ])\n\n    check :: forall a. (Bounded a, Integral a) => Integer -> Name -> Proxy a -> DsM ()\n    check i tc _proxy\n      = when (i < minB || i > maxB) $ do\n        warnDs (Reason Opt_WarnOverflowedLiterals)\n               (vcat [ text \"Literal\" <+> integer i\n                       <+> text \"is out of the\" <+> ppr tc <+> ptext (sLit \"range\")\n                       <+> integer minB <> text \"..\" <> integer maxB\n                     , sug ])\n      where\n        minB = toInteger (minBound :: a)\n        maxB = toInteger (maxBound :: a)\n        sug | minB == -i   -- Note [Suggest NegativeLiterals]\n            , i > 0\n            , not (xopt LangExt.NegativeLiterals dflags)\n            = text \"If you are trying to write a large negative literal, use NegativeLiterals\"\n            | otherwise = Outputable.empty\n\n{-\nNote [Suggest NegativeLiterals]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf you write\n  x :: Int8\n  x = -128\nit'll parse as (negate 128), and overflow.  In this case, suggest NegativeLiterals.\nWe get an erroneous suggestion for\n  x = 128\nbut perhaps that does not matter too much.\n-}\n\nwarnAboutEmptyEnumerations :: DynFlags -> LHsExpr GhcTc -> Maybe (LHsExpr GhcTc)\n                           -> LHsExpr GhcTc -> DsM ()\n-- ^ Warns about @[2,3 .. 1]@ which returns the empty list.\n-- Only works for integral types, not floating point.\nwarnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr\n  | wopt Opt_WarnEmptyEnumerations dflags\n  , Just (from,tc) <- getLHsIntegralLit fromExpr\n  , Just mThn      <- traverse getLHsIntegralLit mThnExpr\n  , Just (to,_)    <- getLHsIntegralLit toExpr\n  , let check :: forall a. (Enum a, Num a) => Proxy a -> DsM ()\n        check _proxy\n          = when (null enumeration) $\n            warnDs (Reason Opt_WarnEmptyEnumerations) (text \"Enumeration is empty\")\n          where\n            enumeration :: [a]\n            enumeration = case mThn of\n                            Nothing      -> [fromInteger from                    .. fromInteger to]\n                            Just (thn,_) -> [fromInteger from, fromInteger thn   .. fromInteger to]\n\n  = if      tc == intTyConName    then check (Proxy :: Proxy Int)\n    else if tc == int8TyConName   then check (Proxy :: Proxy Int8)\n    else if tc == int16TyConName  then check (Proxy :: Proxy Int16)\n    else if tc == int32TyConName  then check (Proxy :: Proxy Int32)\n    else if tc == int64TyConName  then check (Proxy :: Proxy Int64)\n    else if tc == wordTyConName   then check (Proxy :: Proxy Word)\n    else if tc == word8TyConName  then check (Proxy :: Proxy Word8)\n    else if tc == word16TyConName then check (Proxy :: Proxy Word16)\n    else if tc == word32TyConName then check (Proxy :: Proxy Word32)\n    else if tc == word64TyConName then check (Proxy :: Proxy Word64)\n    else if tc == integerTyConName then check (Proxy :: Proxy Integer)\n    else if tc == naturalTyConName then check (Proxy :: Proxy Integer)\n      -- We use 'Integer' because otherwise a negative 'Natural' literal\n      -- could cause a compile time crash (instead of a runtime one).\n      -- See the T10930b test case for an example of where this matters.\n    else return ()\n\n  | otherwise = return ()\n\ngetLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name)\n-- ^ See if the expression is an 'Integral' literal.\n-- Remember to look through automatically-added tick-boxes! (Trac #8384)\ngetLHsIntegralLit (dL->L _ (HsPar _ e))            = getLHsIntegralLit e\ngetLHsIntegralLit (dL->L _ (HsTick _ _ e))         = getLHsIntegralLit e\ngetLHsIntegralLit (dL->L _ (HsBinTick _ _ _ e))    = getLHsIntegralLit e\ngetLHsIntegralLit (dL->L _ (HsOverLit _ over_lit)) = getIntegralLit over_lit\ngetLHsIntegralLit (dL->L _ (HsLit _ lit))          = getSimpleIntegralLit lit\ngetLHsIntegralLit _ = Nothing\n\n-- | If 'Integral', extract the value and type name of the overloaded literal.\ngetIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Name)\ngetIntegralLit (OverLit { ol_val = HsIntegral i, ol_ext = OverLitTc _ ty })\n  | Just tc <- tyConAppTyCon_maybe ty\n  = Just (il_value i, tyConName tc)\ngetIntegralLit _ = Nothing\n\n-- | If 'Integral', extract the value and type name of the non-overloaded\n-- literal.\ngetSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Name)\ngetSimpleIntegralLit (HsInt _ IL{ il_value = i }) = Just (i, intTyConName)\ngetSimpleIntegralLit (HsIntPrim _ i) = Just (i, intPrimTyConName)\ngetSimpleIntegralLit (HsWordPrim _ i) = Just (i, wordPrimTyConName)\ngetSimpleIntegralLit (HsInt64Prim _ i) = Just (i, int64PrimTyConName)\ngetSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTyConName)\ngetSimpleIntegralLit (HsInteger _ i ty)\n  | Just tc <- tyConAppTyCon_maybe ty\n  = Just (i, tyConName tc)\ngetSimpleIntegralLit _ = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n        Tidying lit pats\n*                                                                      *\n************************************************************************\n-}\n\ntidyLitPat :: HsLit GhcTc -> Pat GhcTc\n-- Result has only the following HsLits:\n--      HsIntPrim, HsWordPrim, HsCharPrim, HsFloatPrim\n--      HsDoublePrim, HsStringPrim, HsString\n--  * HsInteger, HsRat, HsInt can't show up in LitPats\n--  * We get rid of HsChar right here\ntidyLitPat (HsChar src c) = unLoc (mkCharLitPat src c)\ntidyLitPat (HsString src s)\n  | lengthFS s <= 1     -- Short string literals only\n  = unLoc $ foldr (\\c pat -> mkPrefixConPat consDataCon\n                                             [mkCharLitPat src c, pat] [charTy])\n                  (mkNilPat charTy) (unpackFS s)\n        -- The stringTy is the type of the whole pattern, not\n        -- the type to instantiate (:) or [] with!\ntidyLitPat lit = LitPat noExt lit\n\n----------------\ntidyNPat :: HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc\n         -> Type\n         -> Pat GhcTc\ntidyNPat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty\n        -- False: Take short cuts only if the literal is not using rebindable syntax\n        --\n        -- Once that is settled, look for cases where the type of the\n        -- entire overloaded literal matches the type of the underlying literal,\n        -- and in that case take the short cut\n        -- NB: Watch out for weird cases like Trac #3382\n        --        f :: Int -> Int\n        --        f \"blah\" = 4\n        --     which might be ok if we have 'instance IsString Int'\n        --\n  | not type_change, isIntTy ty,    Just int_lit <- mb_int_lit\n                 = mk_con_pat intDataCon    (HsIntPrim    NoSourceText int_lit)\n  | not type_change, isWordTy ty,   Just int_lit <- mb_int_lit\n                 = mk_con_pat wordDataCon   (HsWordPrim   NoSourceText int_lit)\n  | not type_change, isStringTy ty, Just str_lit <- mb_str_lit\n                 = tidyLitPat (HsString NoSourceText str_lit)\n     -- NB: do /not/ convert Float or Double literals to F# 3.8 or D# 5.3\n     -- If we do convert to the constructor form, we'll generate a case\n     -- expression on a Float# or Double# and that's not allowed in Core; see\n     -- Trac #9238 and Note [Rules for floating-point comparisons] in PrelRules\n  where\n    -- Sometimes (like in test case\n    -- overloadedlists/should_run/overloadedlistsrun04), the SyntaxExprs include\n    -- type-changing wrappers (for example, from Id Int to Int, for the identity\n    -- type family Id). In these cases, we can't do the short-cut.\n    type_change = not (outer_ty `eqType` ty)\n\n    mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc\n    mk_con_pat con lit\n      = unLoc (mkPrefixConPat con [noLoc $ LitPat noExt lit] [])\n\n    mb_int_lit :: Maybe Integer\n    mb_int_lit = case (mb_neg, val) of\n                   (Nothing, HsIntegral i) -> Just (il_value i)\n                   (Just _,  HsIntegral i) -> Just (-(il_value i))\n                   _ -> Nothing\n\n    mb_str_lit :: Maybe FastString\n    mb_str_lit = case (mb_neg, val) of\n                   (Nothing, HsIsString _ s) -> Just s\n                   _ -> Nothing\n\ntidyNPat over_lit mb_neg eq outer_ty\n  = NPat outer_ty (noLoc over_lit) mb_neg eq\n\n{-\n************************************************************************\n*                                                                      *\n                Pattern matching on LitPat\n*                                                                      *\n************************************************************************\n-}\n\nmatchLiterals :: [Id]\n              -> Type                   -- Type of the whole case expression\n              -> [[EquationInfo]]       -- All PgLits\n              -> DsM MatchResult\n\nmatchLiterals (var:vars) ty sub_groups\n  = ASSERT( notNull sub_groups && all notNull sub_groups )\n    do  {       -- Deal with each group\n        ; alts <- mapM match_group sub_groups\n\n                -- Combine results.  For everything except String\n                -- we can use a case expression; for String we need\n                -- a chain of if-then-else\n        ; if isStringTy (idType var) then\n            do  { eq_str <- dsLookupGlobalId eqStringName\n                ; mrs <- mapM (wrap_str_guard eq_str) alts\n                ; return (foldr1 combineMatchResults mrs) }\n          else\n            return (mkCoPrimCaseMatchResult var ty alts)\n        }\n  where\n    match_group :: [EquationInfo] -> DsM (Literal, MatchResult)\n    match_group eqns\n        = do { dflags <- getDynFlags\n             ; let LitPat _ hs_lit = firstPat (head eqns)\n             ; match_result <- match vars ty (shiftEqns eqns)\n             ; return (hsLitKey dflags hs_lit, match_result) }\n\n    wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult\n        -- Equality check for string literals\n    wrap_str_guard eq_str (LitString s, mr)\n        = do { -- We now have to convert back to FastString. Perhaps there\n               -- should be separate LitBytes and LitString constructors?\n               let s'  = mkFastStringByteString s\n             ; lit    <- mkStringExprFS s'\n             ; let pred = mkApps (Var eq_str) [Var var, lit]\n             ; return (mkGuardedMatchResult pred mr) }\n    wrap_str_guard _ (l, _) = pprPanic \"matchLiterals/wrap_str_guard\" (ppr l)\n\nmatchLiterals [] _ _ = panic \"matchLiterals []\"\n\n---------------------------\nhsLitKey :: DynFlags -> HsLit GhcTc -> Literal\n-- Get the Core literal corresponding to a HsLit.\n-- It only works for primitive types and strings;\n-- others have been removed by tidy\n-- For HsString, it produces a LitString, which really represents an _unboxed_\n-- string literal; and we deal with it in matchLiterals above. Otherwise, it\n-- produces a primitive Literal of type matching the original HsLit.\n-- In the case of the fixed-width numeric types, we need to wrap here\n-- because Literal has an invariant that the literal is in range, while\n-- HsLit does not.\nhsLitKey dflags (HsIntPrim    _ i) = mkLitIntWrap  dflags i\nhsLitKey dflags (HsWordPrim   _ w) = mkLitWordWrap dflags w\nhsLitKey dflags (HsInt64Prim  _ i) = mkLitInt64Wrap  dflags i\nhsLitKey dflags (HsWord64Prim _ w) = mkLitWord64Wrap dflags w\nhsLitKey _      (HsCharPrim   _ c) = mkLitChar            c\nhsLitKey _      (HsFloatPrim  _ f) = mkLitFloat           (fl_value f)\nhsLitKey _      (HsDoublePrim _ d) = mkLitDouble          (fl_value d)\nhsLitKey _      (HsString _ s)     = LitString (bytesFS s)\nhsLitKey _      l                  = pprPanic \"hsLitKey\" (ppr l)\n\n{-\n************************************************************************\n*                                                                      *\n                Pattern matching on NPat\n*                                                                      *\n************************************************************************\n-}\n\nmatchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult\nmatchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal\n  = do  { let NPat _ (dL->L _ lit) mb_neg eq_chk = firstPat eqn1\n        ; lit_expr <- dsOverLit lit\n        ; neg_lit <- case mb_neg of\n                            Nothing  -> return lit_expr\n                            Just neg -> dsSyntaxExpr neg [lit_expr]\n        ; pred_expr <- dsSyntaxExpr eq_chk [Var var, neg_lit]\n        ; match_result <- match vars ty (shiftEqns (eqn1:eqns))\n        ; return (mkGuardedMatchResult pred_expr match_result) }\nmatchNPats vars _ eqns = pprPanic \"matchOneNPat\" (ppr (vars, eqns))\n\n{-\n************************************************************************\n*                                                                      *\n                Pattern matching on n+k patterns\n*                                                                      *\n************************************************************************\n\nFor an n+k pattern, we use the various magic expressions we've been given.\nWe generate:\n\\begin{verbatim}\n    if ge var lit then\n        let n = sub var lit\n        in  <expr-for-a-successful-match>\n    else\n        <try-next-pattern-or-whatever>\n\\end{verbatim}\n-}\n\nmatchNPlusKPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult\n-- All NPlusKPats, for the *same* literal k\nmatchNPlusKPats (var:vars) ty (eqn1:eqns)\n  = do  { let NPlusKPat _ (dL->L _ n1) (dL->L _ lit1) lit2 ge minus\n                = firstPat eqn1\n        ; lit1_expr   <- dsOverLit lit1\n        ; lit2_expr   <- dsOverLit lit2\n        ; pred_expr   <- dsSyntaxExpr ge    [Var var, lit1_expr]\n        ; minusk_expr <- dsSyntaxExpr minus [Var var, lit2_expr]\n        ; let (wraps, eqns') = mapAndUnzip (shift n1) (eqn1:eqns)\n        ; match_result <- match vars ty eqns'\n        ; return  (mkGuardedMatchResult pred_expr               $\n                   mkCoLetMatchResult (NonRec n1 minusk_expr)   $\n                   adjustMatchResult (foldr1 (.) wraps)         $\n                   match_result) }\n  where\n    shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (dL->L _ n) _ _ _ _ : pats })\n        = (wrapBind n n1, eqn { eqn_pats = pats })\n        -- The wrapBind is a no-op for the first equation\n    shift _ e = pprPanic \"matchNPlusKPats/shift\" (ppr e)\n\nmatchNPlusKPats vars _ eqns = pprPanic \"matchNPlusKPats\" (ppr (vars, eqns))\n", "num_lines": 522}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nAuthor: George Karachalias <george.karachalias@cs.kuleuven.be>\n\nHaskell expressions (as used by the pattern matching checker) and utilities.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule PmExpr (\n        PmExpr(..), PmLit(..), SimpleEq, ComplexEq, toComplex, eqPmLit,\n        truePmExpr, falsePmExpr, isTruePmExpr, isFalsePmExpr, isNotPmExprOther,\n        lhsExprToPmExpr, hsExprToPmExpr, substComplexEq, filterComplex,\n        pprPmExprWithParens, runPmPprM\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BasicTypes (SourceText)\nimport FastString (FastString, unpackFS)\nimport HsSyn\nimport Id\nimport Name\nimport NameSet\nimport DataCon\nimport ConLike\nimport TcType (isStringTy)\nimport TysWiredIn\nimport Outputable\nimport Util\nimport SrcLoc\n\nimport Data.Maybe (mapMaybe)\nimport Data.List (groupBy, sortBy, nubBy)\nimport Control.Monad.Trans.State.Lazy\n\n{-\n%************************************************************************\n%*                                                                      *\n                         Lifted Expressions\n%*                                                                      *\n%************************************************************************\n-}\n\n{- Note [PmExprOther in PmExpr]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSince there is no plan to extend the (currently pretty naive) term oracle in\nthe near future, instead of playing with the verbose (HsExpr Id), we lift it to\nPmExpr. All expressions the term oracle does not handle are wrapped by the\nconstructor PmExprOther. Note that we do not perform substitution in\nPmExprOther. Because of this, we do not even print PmExprOther, since they may\nrefer to variables that are otherwise substituted away.\n-}\n\n-- ----------------------------------------------------------------------------\n-- ** Types\n\n-- | Lifted expressions for pattern match checking.\ndata PmExpr = PmExprVar   Name\n            | PmExprCon   ConLike [PmExpr]\n            | PmExprLit   PmLit\n            | PmExprEq    PmExpr PmExpr  -- Syntactic equality\n            | PmExprOther (HsExpr GhcTc)  -- Note [PmExprOther in PmExpr]\n\n\nmkPmExprData :: DataCon -> [PmExpr] -> PmExpr\nmkPmExprData dc args = PmExprCon (RealDataCon dc) args\n\n-- | Literals (simple and overloaded ones) for pattern match checking.\ndata PmLit = PmSLit (HsLit GhcTc)                               -- simple\n           | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded\n\n-- | Equality between literals for pattern match checking.\neqPmLit :: PmLit -> PmLit -> Bool\neqPmLit (PmSLit    l1) (PmSLit    l2) = l1 == l2\neqPmLit (PmOLit b1 l1) (PmOLit b2 l2) = b1 == b2 && l1 == l2\n  -- See Note [Undecidable Equality for Overloaded Literals]\neqPmLit _              _              = False\n\n{- Note [Undecidable Equality for Overloaded Literals]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEquality on overloaded literals is undecidable in the general case. Consider\nthe following example:\n\n  instance Num Bool where\n    ...\n    fromInteger 0 = False -- C-like representation of booleans\n    fromInteger _ = True\n\n    f :: Bool -> ()\n    f 1 = ()        -- Clause A\n    f 2 = ()        -- Clause B\n\nClause B is redundant but to detect this, we should be able to solve the\nconstraint: False ~ (fromInteger 2 ~ fromInteger 1) which means that we\nhave to look through function `fromInteger`, whose implementation could\nbe anything. This poses difficulties for:\n\n1. The expressive power of the check.\n   We cannot expect a reasonable implementation of pattern matching to detect\n   that fromInteger 2 ~ fromInteger 1 is True, unless we unfold function\n   fromInteger. This puts termination at risk and is undecidable in the\n   general case.\n\n2. Performance.\n   Having an unresolved constraint False ~ (fromInteger 2 ~ fromInteger 1)\n   lying around could become expensive really fast. Ticket #11161 illustrates\n   how heavy use of overloaded literals can generate plenty of those\n   constraints, effectively undermining the term oracle's performance.\n\n3. Error nessages/Warnings.\n   What should our message for `f` above be? A reasonable approach would be\n   to issue:\n\n     Pattern matches are (potentially) redundant:\n       f 2 = ...    under the assumption that 1 == 2\n\n   but seems to complex and confusing for the user.\n\nWe choose to treat overloaded literals that look different as different. The\nimpact of this is the following:\n\n  * Redundancy checking is rather conservative, since it cannot see that clause\n    B above is redundant.\n\n  * We have instant equality check for overloaded literals (we do not rely on\n    the term oracle which is rather expensive, both in terms of performance and\n    memory). This significantly improves the performance of functions `covered`\n    `uncovered` and `divergent` in deSugar/Check.hs and effectively addresses\n    #11161.\n\n  * The warnings issued are simpler.\n\n  * We do not play on the safe side, strictly speaking. The assumption that\n    1 /= 2 makes the redundancy check more conservative but at the same time\n    makes its dual (exhaustiveness check) unsafe. This we can live with, mainly\n    for two reasons:\n    1. At the moment we do not use the results of the check during compilation\n       where this would be a disaster (could result in runtime errors even if\n       our function was deemed exhaustive).\n    2. Pattern matcing on literals can never be considered exhaustive unless we\n       have a catch-all clause. Hence, this assumption affects mainly the\n       appearance of the warnings and is, in practice safe.\n-}\n\nnubPmLit :: [PmLit] -> [PmLit]\nnubPmLit = nubBy eqPmLit\n\n-- | Term equalities\ntype SimpleEq  = (Id, PmExpr) -- We always use this orientation\ntype ComplexEq = (PmExpr, PmExpr)\n\n-- | Lift a `SimpleEq` to a `ComplexEq`\ntoComplex :: SimpleEq -> ComplexEq\ntoComplex (x,e) = (PmExprVar (idName x), e)\n\n-- | Expression `True'\ntruePmExpr :: PmExpr\ntruePmExpr = mkPmExprData trueDataCon []\n\n-- | Expression `False'\nfalsePmExpr :: PmExpr\nfalsePmExpr = mkPmExprData falseDataCon []\n\n-- ----------------------------------------------------------------------------\n-- ** Predicates on PmExpr\n\n-- | Check if an expression is lifted or not\nisNotPmExprOther :: PmExpr -> Bool\nisNotPmExprOther (PmExprOther _) = False\nisNotPmExprOther _expr           = True\n\n-- | Check whether a literal is negated\nisNegatedPmLit :: PmLit -> Bool\nisNegatedPmLit (PmOLit b _) = b\nisNegatedPmLit _other_lit   = False\n\n-- | Check whether a PmExpr is syntactically equal to term `True'.\nisTruePmExpr :: PmExpr -> Bool\nisTruePmExpr (PmExprCon c []) = c == RealDataCon trueDataCon\nisTruePmExpr _other_expr      = False\n\n-- | Check whether a PmExpr is syntactically equal to term `False'.\nisFalsePmExpr :: PmExpr -> Bool\nisFalsePmExpr (PmExprCon c []) = c == RealDataCon falseDataCon\nisFalsePmExpr _other_expr      = False\n\n-- | Check whether a PmExpr is syntactically e\nisNilPmExpr :: PmExpr -> Bool\nisNilPmExpr (PmExprCon c _) = c == RealDataCon nilDataCon\nisNilPmExpr _other_expr     = False\n\n-- | Check whether a PmExpr is syntactically equal to (x == y).\n-- Since (==) is overloaded and can have an arbitrary implementation, we use\n-- the PmExprEq constructor to represent only equalities with non-overloaded\n-- literals where it coincides with a syntactic equality check.\nisPmExprEq :: PmExpr -> Maybe (PmExpr, PmExpr)\nisPmExprEq (PmExprEq e1 e2) = Just (e1,e2)\nisPmExprEq _other_expr      = Nothing\n\n-- | Check if a DataCon is (:).\nisConsDataCon :: DataCon -> Bool\nisConsDataCon con = consDataCon == con\n\n-- ----------------------------------------------------------------------------\n-- ** Substitution in PmExpr\n\n-- | We return a boolean along with the expression. Hence, if substitution was\n-- a no-op, we know that the expression still cannot progress.\nsubstPmExpr :: Name -> PmExpr -> PmExpr -> (PmExpr, Bool)\nsubstPmExpr x e1 e =\n  case e of\n    PmExprVar z | x == z    -> (e1, True)\n                | otherwise -> (e, False)\n    PmExprCon c ps -> let (ps', bs) = mapAndUnzip (substPmExpr x e1) ps\n                      in  (PmExprCon c ps', or bs)\n    PmExprEq ex ey -> let (ex', bx) = substPmExpr x e1 ex\n                          (ey', by) = substPmExpr x e1 ey\n                      in  (PmExprEq ex' ey', bx || by)\n    _other_expr    -> (e, False) -- The rest are terminals (We silently ignore\n                                 -- Other). See Note [PmExprOther in PmExpr]\n\n-- | Substitute in a complex equality. We return (Left eq) if the substitution\n-- affected the equality or (Right eq) if nothing happened.\nsubstComplexEq :: Name -> PmExpr -> ComplexEq -> Either ComplexEq ComplexEq\nsubstComplexEq x e (ex, ey)\n  | bx || by  = Left  (ex', ey')\n  | otherwise = Right (ex', ey')\n  where\n    (ex', bx) = substPmExpr x e ex\n    (ey', by) = substPmExpr x e ey\n\n-- -----------------------------------------------------------------------\n-- ** Lift source expressions (HsExpr Id) to PmExpr\n\nlhsExprToPmExpr :: LHsExpr GhcTc -> PmExpr\nlhsExprToPmExpr (dL->L _ e) = hsExprToPmExpr e\n\nhsExprToPmExpr :: HsExpr GhcTc -> PmExpr\n\nhsExprToPmExpr (HsVar        _ x) = PmExprVar (idName (unLoc x))\nhsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c)\n\n-- Desugar literal strings as a list of characters. For other literal values,\n-- keep it as it is.\n-- See `translatePat` in Check.hs (the `NPat` and `LitPat` case), and\n-- Note [Translate Overloaded Literal for Exhaustiveness Checking].\nhsExprToPmExpr (HsOverLit _ olit)\n  | OverLit (OverLitTc False ty) (HsIsString src s) _ <- olit, isStringTy ty\n  = stringExprToList src s\n  | otherwise = PmExprLit (PmOLit False olit)\nhsExprToPmExpr (HsLit     _ lit)\n  | HsString src s <- lit\n  = stringExprToList src s\n  | otherwise = PmExprLit (PmSLit lit)\n\nhsExprToPmExpr e@(NegApp _ (dL->L _ neg_expr) _)\n  | PmExprLit (PmOLit False olit) <- hsExprToPmExpr neg_expr\n    -- NB: DON'T simply @(NegApp (NegApp olit))@ as @x@. when extension\n    -- @RebindableSyntax@ enabled, (-(-x)) may not equals to x.\n  = PmExprLit (PmOLit True olit)\n  | otherwise = PmExprOther e\n\nhsExprToPmExpr (HsPar _ (dL->L _ e)) = hsExprToPmExpr e\n\nhsExprToPmExpr e@(ExplicitTuple _ ps boxity)\n  | all tupArgPresent ps = mkPmExprData tuple_con tuple_args\n  | otherwise            = PmExprOther e\n  where\n    tuple_con  = tupleDataCon boxity (length ps)\n    tuple_args = [ lhsExprToPmExpr e | (dL->L _ (Present _ e)) <- ps ]\n\nhsExprToPmExpr e@(ExplicitList _  mb_ol elems)\n  | Nothing <- mb_ol = foldr cons nil (map lhsExprToPmExpr elems)\n  | otherwise        = PmExprOther e {- overloaded list: No PmExprApp -}\n  where\n    cons x xs = mkPmExprData consDataCon [x,xs]\n    nil       = mkPmExprData nilDataCon  []\n\n-- we want this but we would have to make everything monadic :/\n-- ./compiler/deSugar/DsMonad.hs:397:dsLookupDataCon :: Name -> DsM DataCon\n--\n-- hsExprToPmExpr (RecordCon   c _ binds) = do\n--   con  <- dsLookupDataCon (unLoc c)\n--   args <- mapM lhsExprToPmExpr (hsRecFieldsArgs binds)\n--   return (PmExprCon con args)\nhsExprToPmExpr e@(RecordCon {}) = PmExprOther e\n\nhsExprToPmExpr (HsTick           _ _ e) = lhsExprToPmExpr e\nhsExprToPmExpr (HsBinTick      _ _ _ e) = lhsExprToPmExpr e\nhsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e\nhsExprToPmExpr (HsSCC          _ _ _ e) = lhsExprToPmExpr e\nhsExprToPmExpr (HsCoreAnn      _ _ _ e) = lhsExprToPmExpr e\nhsExprToPmExpr (ExprWithTySig    _ e _) = lhsExprToPmExpr e\nhsExprToPmExpr (HsWrap           _ _ e) =  hsExprToPmExpr e\nhsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle\n\nstringExprToList :: SourceText -> FastString -> PmExpr\nstringExprToList src s = foldr cons nil (map charToPmExpr (unpackFS s))\n  where\n    cons x xs      = mkPmExprData consDataCon [x,xs]\n    nil            = mkPmExprData nilDataCon  []\n    charToPmExpr c = PmExprLit (PmSLit (HsChar src c))\n\n{-\n%************************************************************************\n%*                                                                      *\n                            Pretty printing\n%*                                                                      *\n%************************************************************************\n-}\n\n{- 1. Literals\n~~~~~~~~~~~~~~\nStarting with a function definition like:\n\n    f :: Int -> Bool\n    f 5 = True\n    f 6 = True\n\nThe uncovered set looks like:\n    { var |> False == (var == 5), False == (var == 6) }\n\nYet, we would like to print this nicely as follows:\n   x , where x not one of {5,6}\n\nFunction `filterComplex' takes the set of residual constraints and packs\ntogether the negative constraints that refer to the same variable so we can do\njust this. Since these variables will be shown to the programmer, we also give\nthem better names (t1, t2, ..), hence the SDoc in PmNegLitCt.\n\n2. Residual Constraints\n~~~~~~~~~~~~~~~~~~~~~~~\nUnhandled constraints that refer to HsExpr are typically ignored by the solver\n(it does not even substitute in HsExpr so they are even printed as wildcards).\nAdditionally, the oracle returns a substitution if it succeeds so we apply this\nsubstitution to the vectors before printing them out (see function `pprOne' in\nCheck.hs) to be more precice.\n-}\n\n-- -----------------------------------------------------------------------------\n-- ** Transform residual constraints in appropriate form for pretty printing\n\ntype PmNegLitCt = (Name, (SDoc, [PmLit]))\n\nfilterComplex :: [ComplexEq] -> [PmNegLitCt]\nfilterComplex = zipWith rename nameList . map mkGroup\n              . groupBy name . sortBy order . mapMaybe isNegLitCs\n  where\n    order x y = compare (fst x) (fst y)\n    name  x y = fst x == fst y\n    mkGroup l = (fst (head l), nubPmLit $ map snd l)\n    rename new (old, lits) = (old, (new, lits))\n\n    isNegLitCs (e1,e2)\n      | isFalsePmExpr e1, Just (x,y) <- isPmExprEq e2 = isNegLitCs' x y\n      | isFalsePmExpr e2, Just (x,y) <- isPmExprEq e1 = isNegLitCs' x y\n      | otherwise = Nothing\n\n    isNegLitCs' (PmExprVar x) (PmExprLit l) = Just (x, l)\n    isNegLitCs' (PmExprLit l) (PmExprVar x) = Just (x, l)\n    isNegLitCs' _ _             = Nothing\n\n    -- Try nice names p,q,r,s,t before using the (ugly) t_i\n    nameList :: [SDoc]\n    nameList = map text [\"p\",\"q\",\"r\",\"s\",\"t\"] ++\n                 [ text ('t':show u) | u <- [(0 :: Int)..] ]\n\n-- ----------------------------------------------------------------------------\n\nrunPmPprM :: PmPprM a -> [PmNegLitCt] -> (a, [(SDoc,[PmLit])])\nrunPmPprM m lit_env = (result, mapMaybe is_used lit_env)\n  where\n    (result, (_lit_env, used)) = runState m (lit_env, emptyNameSet)\n\n    is_used (x,(name, lits))\n      | elemNameSet x used = Just (name, lits)\n      | otherwise         = Nothing\n\ntype PmPprM a = State ([PmNegLitCt], NameSet) a\n-- (the first part of the state is read only. make it a reader?)\n\naddUsed :: Name -> PmPprM ()\naddUsed x = modify (\\(negated, used) -> (negated, extendNameSet used x))\n\ncheckNegation :: Name -> PmPprM (Maybe SDoc) -- the clean name if it is negated\ncheckNegation x = do\n  negated <- gets fst\n  return $ case lookup x negated of\n    Just (new, _) -> Just new\n    Nothing       -> Nothing\n\n-- | Pretty print a pmexpr, but remember to prettify the names of the variables\n-- that refer to neg-literals. The ones that cannot be shown are printed as\n-- underscores.\npprPmExpr :: PmExpr -> PmPprM SDoc\npprPmExpr (PmExprVar x) = do\n  mb_name <- checkNegation x\n  case mb_name of\n    Just name -> addUsed x >> return name\n    Nothing   -> return underscore\n\npprPmExpr (PmExprCon con args) = pprPmExprCon con args\npprPmExpr (PmExprLit l)        = return (ppr l)\npprPmExpr (PmExprEq _ _)       = return underscore -- don't show\npprPmExpr (PmExprOther _)      = return underscore -- don't show\n\nneedsParens :: PmExpr -> Bool\nneedsParens (PmExprVar   {}) = False\nneedsParens (PmExprLit    l) = isNegatedPmLit l\nneedsParens (PmExprEq    {}) = False -- will become a wildcard\nneedsParens (PmExprOther {}) = False -- will become a wildcard\nneedsParens (PmExprCon (RealDataCon c) es)\n  | isTupleDataCon c\n  || isConsDataCon c || null es = False\n  | otherwise                   = True\nneedsParens (PmExprCon (PatSynCon _) es) = not (null es)\n\npprPmExprWithParens :: PmExpr -> PmPprM SDoc\npprPmExprWithParens expr\n  | needsParens expr = parens <$> pprPmExpr expr\n  | otherwise        =            pprPmExpr expr\n\npprPmExprCon :: ConLike -> [PmExpr] -> PmPprM SDoc\npprPmExprCon (RealDataCon con) args\n  | isTupleDataCon con = mkTuple <$> mapM pprPmExpr args\n  | isConsDataCon con  = pretty_list\n  where\n    mkTuple :: [SDoc] -> SDoc\n    mkTuple = parens     . fsep . punctuate comma\n\n    -- lazily, to be used in the list case only\n    pretty_list :: PmPprM SDoc\n    pretty_list = case isNilPmExpr (last list) of\n      True  -> brackets . fsep . punctuate comma <$> mapM pprPmExpr (init list)\n      False -> parens   . hcat . punctuate colon <$> mapM pprPmExpr list\n\n    list = list_elements args\n\n    list_elements [x,y]\n      | PmExprCon c es <- y,  RealDataCon nilDataCon == c\n          = ASSERT(null es) [x,y]\n      | PmExprCon c es <- y, RealDataCon consDataCon == c\n          = x : list_elements es\n      | otherwise = [x,y]\n    list_elements list  = pprPanic \"list_elements:\" (ppr list)\npprPmExprCon cl args\n  | conLikeIsInfix cl = case args of\n      [x, y] -> do x' <- pprPmExprWithParens x\n                   y' <- pprPmExprWithParens y\n                   return (x' <+> ppr cl <+> y')\n      -- can it be infix but have more than two arguments?\n      list   -> pprPanic \"pprPmExprCon:\" (ppr list)\n  | null args = return (ppr cl)\n  | otherwise = do args' <- mapM pprPmExprWithParens args\n                   return (fsep (ppr cl : args'))\n\ninstance Outputable PmLit where\n  ppr (PmSLit     l) = pmPprHsLit l\n  ppr (PmOLit neg l) = (if neg then char '-' else empty) <> ppr l\n\n-- not really useful for pmexprs per se\ninstance Outputable PmExpr where\n  ppr e = fst $ runPmPprM (pprPmExpr e) []\n", "num_lines": 467}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nAuthor: George Karachalias <george.karachalias@cs.kuleuven.be>\n\nThe term equality oracle. The main export of the module is function `tmOracle'.\n-}\n\n{-# LANGUAGE CPP, MultiWayIf #-}\n\nmodule TmOracle (\n\n        -- re-exported from PmExpr\n        PmExpr(..), PmLit(..), SimpleEq, ComplexEq, PmVarEnv, falsePmExpr,\n        eqPmLit, filterComplex, isNotPmExprOther, runPmPprM, lhsExprToPmExpr,\n        hsExprToPmExpr, pprPmExprWithParens,\n\n        -- the term oracle\n        tmOracle, TmState, initialTmState, solveOneEq, extendSubst, canDiverge,\n\n        -- misc.\n        toComplex, exprDeepLookup, pmLitType, flattenPmVarEnv\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport PmExpr\n\nimport Id\nimport Name\nimport Type\nimport HsLit\nimport TcHsSyn\nimport MonadUtils\nimport Util\n\nimport NameEnv\n\n{-\n%************************************************************************\n%*                                                                      *\n                      The term equality oracle\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | The type of substitutions.\ntype PmVarEnv = NameEnv PmExpr\n\n-- | The environment of the oracle contains\n--     1. A Bool (are there any constraints we cannot handle? (PmExprOther)).\n--     2. A substitution we extend with every step and return as a result.\ntype TmOracleEnv = (Bool, PmVarEnv)\n\n-- | Check whether a constraint (x ~ BOT) can succeed,\n-- given the resulting state of the term oracle.\ncanDiverge :: Name -> TmState -> Bool\ncanDiverge x (standby, (_unhandled, env))\n  -- If the variable seems not evaluated, there is a possibility for\n  -- constraint x ~ BOT to be satisfiable.\n  | PmExprVar y <- varDeepLookup env x -- seems not forced\n  -- If it is involved (directly or indirectly) in any equality in the\n  -- worklist, we can assume that it is already indirectly evaluated,\n  -- as a side-effect of equality checking. If not, then we can assume\n  -- that the constraint is satisfiable.\n  = not $ any (isForcedByEq x) standby || any (isForcedByEq y) standby\n  -- Variable x is already in WHNF so the constraint is non-satisfiable\n  | otherwise = False\n\n  where\n    isForcedByEq :: Name -> ComplexEq -> Bool\n    isForcedByEq y (e1, e2) = varIn y e1 || varIn y e2\n\n-- | Check whether a variable is in the free variables of an expression\nvarIn :: Name -> PmExpr -> Bool\nvarIn x e = case e of\n  PmExprVar y    -> x == y\n  PmExprCon _ es -> any (x `varIn`) es\n  PmExprLit _    -> False\n  PmExprEq e1 e2 -> (x `varIn` e1) || (x `varIn` e2)\n  PmExprOther _  -> False\n\n-- | Flatten the DAG (Could be improved in terms of performance.).\nflattenPmVarEnv :: PmVarEnv -> PmVarEnv\nflattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env\n\n-- | The state of the term oracle (includes complex constraints that cannot\n-- progress unless we get more information).\ntype TmState = ([ComplexEq], TmOracleEnv)\n\n-- | Initial state of the oracle.\ninitialTmState :: TmState\ninitialTmState = ([], (False, emptyNameEnv))\n\n-- | Solve a complex equality (top-level).\nsolveOneEq :: TmState -> ComplexEq -> Maybe TmState\nsolveOneEq solver_env@(_,(_,env)) complex\n  = solveComplexEq solver_env -- do the actual *merging* with existing state\n  $ simplifyComplexEq               -- simplify as much as you can\n  $ applySubstComplexEq env complex -- replace everything we already know\n\n-- | Solve a complex equality.\n-- Nothing => definitely unsatisfiable\n-- Just tms => I have added the complex equality and added\n--             it to the tmstate; the result may or may not be\n--             satisfiable\nsolveComplexEq :: TmState -> ComplexEq -> Maybe TmState\nsolveComplexEq solver_state@(standby, (unhandled, env)) eq@(e1, e2) = case eq of\n  -- We cannot do a thing about these cases\n  (PmExprOther _,_)            -> Just (standby, (True, env))\n  (_,PmExprOther _)            -> Just (standby, (True, env))\n\n  (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of\n    -- See Note [Undecidable Equality for Overloaded Literals]\n    True  -> Just solver_state\n    False -> Nothing\n\n  (PmExprCon c1 ts1, PmExprCon c2 ts2)\n    | c1 == c2  -> foldlM solveComplexEq solver_state (zip ts1 ts2)\n    | otherwise -> Nothing\n  (PmExprCon _ [], PmExprEq t1 t2)\n    | isTruePmExpr e1  -> solveComplexEq solver_state (t1, t2)\n    | isFalsePmExpr e1 -> Just (eq:standby, (unhandled, env))\n  (PmExprEq t1 t2, PmExprCon _ [])\n    | isTruePmExpr e2   -> solveComplexEq solver_state (t1, t2)\n    | isFalsePmExpr e2  -> Just (eq:standby, (unhandled, env))\n\n  (PmExprVar x, PmExprVar y)\n    | x == y    -> Just solver_state\n    | otherwise -> extendSubstAndSolve x e2 solver_state\n\n  (PmExprVar x, _) -> extendSubstAndSolve x e2 solver_state\n  (_, PmExprVar x) -> extendSubstAndSolve x e1 solver_state\n\n  (PmExprEq _ _, PmExprEq _ _) -> Just (eq:standby, (unhandled, env))\n\n  _ -> Just (standby, (True, env)) -- I HATE CATCH-ALLS\n\n-- | Extend the substitution and solve the (possibly updated) constraints.\nextendSubstAndSolve :: Name -> PmExpr -> TmState -> Maybe TmState\nextendSubstAndSolve x e (standby, (unhandled, env))\n  = foldlM solveComplexEq new_incr_state (map simplifyComplexEq changed)\n  where\n    -- Apply the substitution to the worklist and partition them to the ones\n    -- that had some progress and the rest. Then, recurse over the ones that\n    -- had some progress. Careful about performance:\n    -- See Note [Representation of Term Equalities] in deSugar/Check.hs\n    (changed, unchanged) = partitionWith (substComplexEq x e) standby\n    new_incr_state       = (unchanged, (unhandled, extendNameEnv env x e))\n\n-- | When we know that a variable is fresh, we do not actually have to\n-- check whether anything changes, we know that nothing does. Hence,\n-- `extendSubst` simply extends the substitution, unlike what\n-- `extendSubstAndSolve` does.\nextendSubst :: Id -> PmExpr -> TmState -> TmState\nextendSubst y e (standby, (unhandled, env))\n  | isNotPmExprOther simpl_e\n  = (standby, (unhandled, extendNameEnv env x simpl_e))\n  | otherwise = (standby, (True, env))\n  where\n    x = idName y\n    simpl_e = fst $ simplifyPmExpr $ exprDeepLookup env e\n\n-- | Simplify a complex equality.\nsimplifyComplexEq :: ComplexEq -> ComplexEq\nsimplifyComplexEq (e1, e2) = (fst $ simplifyPmExpr e1, fst $ simplifyPmExpr e2)\n\n-- | Simplify an expression. The boolean indicates if there has been any\n-- simplification or if the operation was a no-op.\nsimplifyPmExpr :: PmExpr -> (PmExpr, Bool)\n-- See Note [Deep equalities]\nsimplifyPmExpr e = case e of\n  PmExprCon c ts -> case mapAndUnzip simplifyPmExpr ts of\n                      (ts', bs) -> (PmExprCon c ts', or bs)\n  PmExprEq t1 t2 -> simplifyEqExpr t1 t2\n  _other_expr    -> (e, False) -- the others are terminals\n\n-- | Simplify an equality expression. The equality is given in parts.\nsimplifyEqExpr :: PmExpr -> PmExpr -> (PmExpr, Bool)\n-- See Note [Deep equalities]\nsimplifyEqExpr e1 e2 = case (e1, e2) of\n  -- Varables\n  (PmExprVar x, PmExprVar y)\n    | x == y -> (truePmExpr, True)\n\n  -- Literals\n  (PmExprLit l1, PmExprLit l2) -> case eqPmLit l1 l2 of\n    -- See Note [Undecidable Equality for Overloaded Literals]\n    True  -> (truePmExpr,  True)\n    False -> (falsePmExpr, True)\n\n  -- Can potentially be simplified\n  (PmExprEq {}, _) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of\n    ((e1', True ), (e2', _    )) -> simplifyEqExpr e1' e2'\n    ((e1', _    ), (e2', True )) -> simplifyEqExpr e1' e2'\n    ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress\n  (_, PmExprEq {}) -> case (simplifyPmExpr e1, simplifyPmExpr e2) of\n    ((e1', True ), (e2', _    )) -> simplifyEqExpr e1' e2'\n    ((e1', _    ), (e2', True )) -> simplifyEqExpr e1' e2'\n    ((e1', False), (e2', False)) -> (PmExprEq e1' e2', False) -- cannot progress\n\n  -- Constructors\n  (PmExprCon c1 ts1, PmExprCon c2 ts2)\n    | c1 == c2 ->\n        let (ts1', bs1) = mapAndUnzip simplifyPmExpr ts1\n            (ts2', bs2) = mapAndUnzip simplifyPmExpr ts2\n            (tss, _bss) = zipWithAndUnzip simplifyEqExpr ts1' ts2'\n            worst_case  = PmExprEq (PmExprCon c1 ts1') (PmExprCon c2 ts2')\n        in  if | not (or bs1 || or bs2) -> (worst_case, False) -- no progress\n               | all isTruePmExpr  tss  -> (truePmExpr, True)\n               | any isFalsePmExpr tss  -> (falsePmExpr, True)\n               | otherwise              -> (worst_case, False)\n    | otherwise -> (falsePmExpr, True)\n\n  -- We cannot do anything about the rest..\n  _other_equality -> (original, False)\n\n  where\n    original = PmExprEq e1 e2 -- reconstruct equality\n\n-- | Apply an (un-flattened) substitution to a simple equality.\napplySubstComplexEq :: PmVarEnv -> ComplexEq -> ComplexEq\napplySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2)\n\n-- | Apply an (un-flattened) substitution to a variable.\nvarDeepLookup :: PmVarEnv -> Name -> PmExpr\nvarDeepLookup env x\n  | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper\n  | otherwise                  = PmExprVar x          -- terminal\n{-# INLINE varDeepLookup #-}\n\n-- | Apply an (un-flattened) substitution to an expression.\nexprDeepLookup :: PmVarEnv -> PmExpr -> PmExpr\nexprDeepLookup env (PmExprVar x)    = varDeepLookup env x\nexprDeepLookup env (PmExprCon c es) = PmExprCon c (map (exprDeepLookup env) es)\nexprDeepLookup env (PmExprEq e1 e2) = PmExprEq (exprDeepLookup env e1)\n                                               (exprDeepLookup env e2)\nexprDeepLookup _   other_expr       = other_expr -- PmExprLit, PmExprOther\n\n-- | External interface to the term oracle.\ntmOracle :: TmState -> [ComplexEq] -> Maybe TmState\ntmOracle tm_state eqs = foldlM solveOneEq tm_state eqs\n\n-- | Type of a PmLit\npmLitType :: PmLit -> Type -- should be in PmExpr but gives cyclic imports :(\npmLitType (PmSLit   lit) = hsLitType   lit\npmLitType (PmOLit _ lit) = overLitType lit\n\n{- Note [Deep equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSolving nested equalities is the most difficult part. The general strategy\nis the following:\n\n  * Equalities of the form (True ~ (e1 ~ e2)) are transformed to just\n    (e1 ~ e2) and then treated recursively.\n\n  * Equalities of the form (False ~ (e1 ~ e2)) cannot be analyzed unless\n    we know more about the inner equality (e1 ~ e2). That's exactly what\n    `simplifyEqExpr' tries to do: It takes e1 and e2 and either returns\n    truePmExpr, falsePmExpr or (e1' ~ e2') in case it is uncertain. Note\n    that it is not e but rather e', since it may perform some\n    simplifications deeper.\n-}\n", "num_lines": 264}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash, RecordWildCards #-}\n{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- | ByteCodeLink: Bytecode assembler and linker\nmodule ByteCodeAsm (\n        assembleBCOs, assembleOneBCO,\n\n        bcoFreeNames,\n        SizedSeq, sizeSS, ssElts,\n        iNTERP_STACK_CHECK_THRESH\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport ByteCodeInstr\nimport ByteCodeItbls\nimport ByteCodeTypes\nimport GHCi.RemoteTypes\nimport GHCi\n\nimport HscTypes\nimport Name\nimport NameSet\nimport Literal\nimport TyCon\nimport FastString\nimport StgCmmLayout     ( ArgRep(..) )\nimport SMRep\nimport DynFlags\nimport Outputable\nimport Platform\nimport Util\nimport Unique\nimport UniqDSet\n\n-- From iserv\nimport SizedSeq\n\nimport Control.Monad\nimport Control.Monad.ST ( runST )\nimport Control.Monad.Trans.Class\nimport Control.Monad.Trans.State.Strict\n\nimport Data.Array.MArray\n\nimport qualified Data.Array.Unboxed as Array\nimport Data.Array.Base  ( UArray(..) )\n\nimport Data.Array.Unsafe( castSTUArray )\n\nimport Foreign\nimport Data.Char        ( ord )\nimport Data.List\nimport Data.Map (Map)\nimport Data.Maybe (fromMaybe)\nimport qualified Data.Map as Map\n\n-- -----------------------------------------------------------------------------\n-- Unlinked BCOs\n\n-- CompiledByteCode represents the result of byte-code\n-- compiling a bunch of functions and data types\n\n-- | Finds external references.  Remember to remove the names\n-- defined by this group of BCOs themselves\nbcoFreeNames :: UnlinkedBCO -> UniqDSet Name\nbcoFreeNames bco\n  = bco_refs bco `uniqDSetMinusUniqSet` mkNameSet [unlinkedBCOName bco]\n  where\n    bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)\n        = unionManyUniqDSets (\n             mkUniqDSet [ n | BCOPtrName n <- ssElts ptrs ] :\n             mkUniqDSet [ n | BCONPtrItbl n <- ssElts nonptrs ] :\n             map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]\n          )\n\n-- -----------------------------------------------------------------------------\n-- The bytecode assembler\n\n-- The object format for bytecodes is: 16 bits for the opcode, and 16\n-- for each field -- so the code can be considered a sequence of\n-- 16-bit ints.  Each field denotes either a stack offset or number of\n-- items on the stack (eg SLIDE), and index into the pointer table (eg\n-- PUSH_G), an index into the literal table (eg PUSH_I/D/L), or a\n-- bytecode address in this BCO.\n\n-- Top level assembler fn.\nassembleBCOs\n  :: HscEnv -> [ProtoBCO Name] -> [TyCon] -> [RemotePtr ()]\n  -> Maybe ModBreaks\n  -> IO CompiledByteCode\nassembleBCOs hsc_env proto_bcos tycons top_strs modbreaks = do\n  itblenv <- mkITbls hsc_env tycons\n  bcos    <- mapM (assembleBCO (hsc_dflags hsc_env)) proto_bcos\n  (bcos',ptrs) <- mallocStrings hsc_env bcos\n  return CompiledByteCode\n    { bc_bcos = bcos'\n    , bc_itbls =  itblenv\n    , bc_ffis = concat (map protoBCOFFIs proto_bcos)\n    , bc_strs = top_strs ++ ptrs\n    , bc_breaks = modbreaks\n    }\n\n-- Find all the literal strings and malloc them together.  We want to\n-- do this because:\n--\n--  a) It should be done when we compile the module, not each time we relink it\n--  b) For -fexternal-interpreter It's more efficient to malloc the strings\n--     as a single batch message, especially when compiling in parallel.\n--\nmallocStrings :: HscEnv -> [UnlinkedBCO] -> IO ([UnlinkedBCO], [RemotePtr ()])\nmallocStrings hsc_env ulbcos = do\n  let bytestrings = reverse (execState (mapM_ collect ulbcos) [])\n  ptrs <- iservCmd hsc_env (MallocStrings bytestrings)\n  return (evalState (mapM splice ulbcos) ptrs, ptrs)\n where\n  splice bco@UnlinkedBCO{..} = do\n    lits <- mapM spliceLit unlinkedBCOLits\n    ptrs <- mapM splicePtr unlinkedBCOPtrs\n    return bco { unlinkedBCOLits = lits, unlinkedBCOPtrs = ptrs }\n\n  spliceLit (BCONPtrStr _) = do\n    rptrs <- get\n    case rptrs of\n      (RemotePtr p : rest) -> do\n        put rest\n        return (BCONPtrWord (fromIntegral p))\n      _ -> panic \"mallocStrings:spliceLit\"\n  spliceLit other = return other\n\n  splicePtr (BCOPtrBCO bco) = BCOPtrBCO <$> splice bco\n  splicePtr other = return other\n\n  collect UnlinkedBCO{..} = do\n    mapM_ collectLit unlinkedBCOLits\n    mapM_ collectPtr unlinkedBCOPtrs\n\n  collectLit (BCONPtrStr bs) = do\n    strs <- get\n    put (bs:strs)\n  collectLit _ = return ()\n\n  collectPtr (BCOPtrBCO bco) = collect bco\n  collectPtr _ = return ()\n\n\nassembleOneBCO :: HscEnv -> ProtoBCO Name -> IO UnlinkedBCO\nassembleOneBCO hsc_env pbco = do\n  ubco <- assembleBCO (hsc_dflags hsc_env) pbco\n  ([ubco'], _ptrs) <- mallocStrings hsc_env [ubco]\n  return ubco'\n\nassembleBCO :: DynFlags -> ProtoBCO Name -> IO UnlinkedBCO\nassembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = do\n  -- pass 1: collect up the offsets of the local labels.\n  let asm = mapM_ (assembleI dflags) instrs\n\n      initial_offset = 0\n\n      -- Jump instructions are variable-sized, there are long and short variants\n      -- depending on the magnitude of the offset.  However, we can't tell what\n      -- size instructions we will need until we have calculated the offsets of\n      -- the labels, which depends on the size of the instructions...  So we\n      -- first create the label environment assuming that all jumps are short,\n      -- and if the final size is indeed small enough for short jumps, we are\n      -- done.  Otherwise, we repeat the calculation, and we force all jumps in\n      -- this BCO to be long.\n      (n_insns0, lbl_map0) = inspectAsm dflags False initial_offset asm\n      ((n_insns, lbl_map), long_jumps)\n        | isLarge n_insns0 = (inspectAsm dflags True initial_offset asm, True)\n        | otherwise = ((n_insns0, lbl_map0), False)\n\n      env :: Word16 -> Word\n      env lbl = fromMaybe\n        (pprPanic \"assembleBCO.findLabel\" (ppr lbl))\n        (Map.lookup lbl lbl_map)\n\n  -- pass 2: run assembler and generate instructions, literals and pointers\n  let initial_state = (emptySS, emptySS, emptySS)\n  (final_insns, final_lits, final_ptrs) <- flip execStateT initial_state $ runAsm dflags long_jumps env asm\n\n  -- precomputed size should be equal to final size\n  ASSERT(n_insns == sizeSS final_insns) return ()\n\n  let asm_insns = ssElts final_insns\n      insns_arr = Array.listArray (0, fromIntegral n_insns - 1) asm_insns\n      bitmap_arr = mkBitmapArray bsize bitmap\n      ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr final_lits final_ptrs\n\n  -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive\n  -- objects, since they might get run too early.  Disable this until\n  -- we figure out what to do.\n  -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))\n\n  return ul_bco\n\nmkBitmapArray :: Word16 -> [StgWord] -> UArray Int Word64\n-- Here the return type must be an array of Words, not StgWords,\n-- because the underlying ByteArray# will end up as a component\n-- of a BCO object.\nmkBitmapArray bsize bitmap\n  = Array.listArray (0, length bitmap) $\n      fromIntegral bsize : map (fromInteger . fromStgWord) bitmap\n\n-- instrs nonptrs ptrs\ntype AsmState = (SizedSeq Word16,\n                 SizedSeq BCONPtr,\n                 SizedSeq BCOPtr)\n\ndata Operand\n  = Op Word\n  | SmallOp Word16\n  | LabelOp Word16\n-- (unused)  | LargeOp Word\n\ndata Assembler a\n  = AllocPtr (IO BCOPtr) (Word -> Assembler a)\n  | AllocLit [BCONPtr] (Word -> Assembler a)\n  | AllocLabel Word16 (Assembler a)\n  | Emit Word16 [Operand] (Assembler a)\n  | NullAsm a\n\ninstance Functor Assembler where\n    fmap = liftM\n\ninstance Applicative Assembler where\n    pure = NullAsm\n    (<*>) = ap\n\ninstance Monad Assembler where\n  NullAsm x >>= f = f x\n  AllocPtr p k >>= f = AllocPtr p (k >=> f)\n  AllocLit l k >>= f = AllocLit l (k >=> f)\n  AllocLabel lbl k >>= f = AllocLabel lbl (k >>= f)\n  Emit w ops k >>= f = Emit w ops (k >>= f)\n\nioptr :: IO BCOPtr -> Assembler Word\nioptr p = AllocPtr p return\n\nptr :: BCOPtr -> Assembler Word\nptr = ioptr . return\n\nlit :: [BCONPtr] -> Assembler Word\nlit l = AllocLit l return\n\nlabel :: Word16 -> Assembler ()\nlabel w = AllocLabel w (return ())\n\nemit :: Word16 -> [Operand] -> Assembler ()\nemit w ops = Emit w ops (return ())\n\ntype LabelEnv = Word16 -> Word\n\nlargeOp :: Bool -> Operand -> Bool\nlargeOp long_jumps op = case op of\n   SmallOp _ -> False\n   Op w      -> isLarge w\n   LabelOp _ -> long_jumps\n-- LargeOp _ -> True\n\nrunAsm :: DynFlags -> Bool -> LabelEnv -> Assembler a -> StateT AsmState IO a\nrunAsm dflags long_jumps e = go\n  where\n    go (NullAsm x) = return x\n    go (AllocPtr p_io k) = do\n      p <- lift p_io\n      w <- state $ \\(st_i0,st_l0,st_p0) ->\n        let st_p1 = addToSS st_p0 p\n        in (sizeSS st_p0, (st_i0,st_l0,st_p1))\n      go $ k w\n    go (AllocLit lits k) = do\n      w <- state $ \\(st_i0,st_l0,st_p0) ->\n        let st_l1 = addListToSS st_l0 lits\n        in (sizeSS st_l0, (st_i0,st_l1,st_p0))\n      go $ k w\n    go (AllocLabel _ k) = go k\n    go (Emit w ops k) = do\n      let largeOps = any (largeOp long_jumps) ops\n          opcode\n            | largeOps = largeArgInstr w\n            | otherwise = w\n          words = concatMap expand ops\n          expand (SmallOp w) = [w]\n          expand (LabelOp w) = expand (Op (e w))\n          expand (Op w) = if largeOps then largeArg dflags w else [fromIntegral w]\n--        expand (LargeOp w) = largeArg dflags w\n      state $ \\(st_i0,st_l0,st_p0) ->\n        let st_i1 = addListToSS st_i0 (opcode : words)\n        in ((), (st_i1,st_l0,st_p0))\n      go k\n\ntype LabelEnvMap = Map Word16 Word\n\ndata InspectState = InspectState\n  { instrCount :: !Word\n  , ptrCount :: !Word\n  , litCount :: !Word\n  , lblEnv :: LabelEnvMap\n  }\n\ninspectAsm :: DynFlags -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)\ninspectAsm dflags long_jumps initial_offset\n  = go (InspectState initial_offset 0 0 Map.empty)\n  where\n    go s (NullAsm _) = (instrCount s, lblEnv s)\n    go s (AllocPtr _ k) = go (s { ptrCount = n + 1 }) (k n)\n      where n = ptrCount s\n    go s (AllocLit ls k) = go (s { litCount = n + genericLength ls }) (k n)\n      where n = litCount s\n    go s (AllocLabel lbl k) = go s' k\n      where s' = s { lblEnv = Map.insert lbl (instrCount s) (lblEnv s) }\n    go s (Emit _ ops k) = go s' k\n      where\n        s' = s { instrCount = instrCount s + size }\n        size = sum (map count ops) + 1\n        largeOps = any (largeOp long_jumps) ops\n        count (SmallOp _) = 1\n        count (LabelOp _) = count (Op 0)\n        count (Op _) = if largeOps then largeArg16s dflags else 1\n--      count (LargeOp _) = largeArg16s dflags\n\n-- Bring in all the bci_ bytecode constants.\n#include \"rts/Bytecodes.h\"\n\nlargeArgInstr :: Word16 -> Word16\nlargeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci\n\nlargeArg :: DynFlags -> Word -> [Word16]\nlargeArg dflags w\n | wORD_SIZE_IN_BITS dflags == 64\n           = [fromIntegral (w `shiftR` 48),\n              fromIntegral (w `shiftR` 32),\n              fromIntegral (w `shiftR` 16),\n              fromIntegral w]\n | wORD_SIZE_IN_BITS dflags == 32\n           = [fromIntegral (w `shiftR` 16),\n              fromIntegral w]\n | otherwise = error \"wORD_SIZE_IN_BITS not 32 or 64?\"\n\nlargeArg16s :: DynFlags -> Word\nlargeArg16s dflags | wORD_SIZE_IN_BITS dflags == 64 = 4\n                   | otherwise                      = 2\n\nassembleI :: DynFlags\n          -> BCInstr\n          -> Assembler ()\nassembleI dflags i = case i of\n  STKCHECK n               -> emit bci_STKCHECK [Op n]\n  PUSH_L o1                -> emit bci_PUSH_L [SmallOp o1]\n  PUSH_LL o1 o2            -> emit bci_PUSH_LL [SmallOp o1, SmallOp o2]\n  PUSH_LLL o1 o2 o3        -> emit bci_PUSH_LLL [SmallOp o1, SmallOp o2, SmallOp o3]\n  PUSH8 o1                 -> emit bci_PUSH8 [SmallOp o1]\n  PUSH16 o1                -> emit bci_PUSH16 [SmallOp o1]\n  PUSH32 o1                -> emit bci_PUSH32 [SmallOp o1]\n  PUSH8_W o1               -> emit bci_PUSH8_W [SmallOp o1]\n  PUSH16_W o1              -> emit bci_PUSH16_W [SmallOp o1]\n  PUSH32_W o1              -> emit bci_PUSH32_W [SmallOp o1]\n  PUSH_G nm                -> do p <- ptr (BCOPtrName nm)\n                                 emit bci_PUSH_G [Op p]\n  PUSH_PRIMOP op           -> do p <- ptr (BCOPtrPrimOp op)\n                                 emit bci_PUSH_G [Op p]\n  PUSH_BCO proto           -> do let ul_bco = assembleBCO dflags proto\n                                 p <- ioptr (liftM BCOPtrBCO ul_bco)\n                                 emit bci_PUSH_G [Op p]\n  PUSH_ALTS proto          -> do let ul_bco = assembleBCO dflags proto\n                                 p <- ioptr (liftM BCOPtrBCO ul_bco)\n                                 emit bci_PUSH_ALTS [Op p]\n  PUSH_ALTS_UNLIFTED proto pk\n                           -> do let ul_bco = assembleBCO dflags proto\n                                 p <- ioptr (liftM BCOPtrBCO ul_bco)\n                                 emit (push_alts pk) [Op p]\n  PUSH_PAD8                -> emit bci_PUSH_PAD8 []\n  PUSH_PAD16               -> emit bci_PUSH_PAD16 []\n  PUSH_PAD32               -> emit bci_PUSH_PAD32 []\n  PUSH_UBX8 lit            -> do np <- literal lit\n                                 emit bci_PUSH_UBX8 [Op np]\n  PUSH_UBX16 lit           -> do np <- literal lit\n                                 emit bci_PUSH_UBX16 [Op np]\n  PUSH_UBX32 lit           -> do np <- literal lit\n                                 emit bci_PUSH_UBX32 [Op np]\n  PUSH_UBX lit nws         -> do np <- literal lit\n                                 emit bci_PUSH_UBX [Op np, SmallOp nws]\n\n  PUSH_APPLY_N             -> emit bci_PUSH_APPLY_N []\n  PUSH_APPLY_V             -> emit bci_PUSH_APPLY_V []\n  PUSH_APPLY_F             -> emit bci_PUSH_APPLY_F []\n  PUSH_APPLY_D             -> emit bci_PUSH_APPLY_D []\n  PUSH_APPLY_L             -> emit bci_PUSH_APPLY_L []\n  PUSH_APPLY_P             -> emit bci_PUSH_APPLY_P []\n  PUSH_APPLY_PP            -> emit bci_PUSH_APPLY_PP []\n  PUSH_APPLY_PPP           -> emit bci_PUSH_APPLY_PPP []\n  PUSH_APPLY_PPPP          -> emit bci_PUSH_APPLY_PPPP []\n  PUSH_APPLY_PPPPP         -> emit bci_PUSH_APPLY_PPPPP []\n  PUSH_APPLY_PPPPPP        -> emit bci_PUSH_APPLY_PPPPPP []\n\n  SLIDE     n by           -> emit bci_SLIDE [SmallOp n, SmallOp by]\n  ALLOC_AP  n              -> emit bci_ALLOC_AP [SmallOp n]\n  ALLOC_AP_NOUPD n         -> emit bci_ALLOC_AP_NOUPD [SmallOp n]\n  ALLOC_PAP arity n        -> emit bci_ALLOC_PAP [SmallOp arity, SmallOp n]\n  MKAP      off sz         -> emit bci_MKAP [SmallOp off, SmallOp sz]\n  MKPAP     off sz         -> emit bci_MKPAP [SmallOp off, SmallOp sz]\n  UNPACK    n              -> emit bci_UNPACK [SmallOp n]\n  PACK      dcon sz        -> do itbl_no <- lit [BCONPtrItbl (getName dcon)]\n                                 emit bci_PACK [Op itbl_no, SmallOp sz]\n  LABEL     lbl            -> label lbl\n  TESTLT_I  i l            -> do np <- int i\n                                 emit bci_TESTLT_I [Op np, LabelOp l]\n  TESTEQ_I  i l            -> do np <- int i\n                                 emit bci_TESTEQ_I [Op np, LabelOp l]\n  TESTLT_W  w l            -> do np <- word w\n                                 emit bci_TESTLT_W [Op np, LabelOp l]\n  TESTEQ_W  w l            -> do np <- word w\n                                 emit bci_TESTEQ_W [Op np, LabelOp l]\n  TESTLT_F  f l            -> do np <- float f\n                                 emit bci_TESTLT_F [Op np, LabelOp l]\n  TESTEQ_F  f l            -> do np <- float f\n                                 emit bci_TESTEQ_F [Op np, LabelOp l]\n  TESTLT_D  d l            -> do np <- double d\n                                 emit bci_TESTLT_D [Op np, LabelOp l]\n  TESTEQ_D  d l            -> do np <- double d\n                                 emit bci_TESTEQ_D [Op np, LabelOp l]\n  TESTLT_P  i l            -> emit bci_TESTLT_P [SmallOp i, LabelOp l]\n  TESTEQ_P  i l            -> emit bci_TESTEQ_P [SmallOp i, LabelOp l]\n  CASEFAIL                 -> emit bci_CASEFAIL []\n  SWIZZLE   stkoff n       -> emit bci_SWIZZLE [SmallOp stkoff, SmallOp n]\n  JMP       l              -> emit bci_JMP [LabelOp l]\n  ENTER                    -> emit bci_ENTER []\n  RETURN                   -> emit bci_RETURN []\n  RETURN_UBX rep           -> emit (return_ubx rep) []\n  CCALL off m_addr i       -> do np <- addr m_addr\n                                 emit bci_CCALL [SmallOp off, Op np, SmallOp i]\n  BRK_FUN index uniq cc    -> do p1 <- ptr BCOPtrBreakArray\n                                 q <- int (getKey uniq)\n                                 np <- addr cc\n                                 emit bci_BRK_FUN [Op p1, SmallOp index,\n                                                   Op q, Op np]\n\n  where\n    literal (LitLabel fs (Just sz) _)\n     | platformOS (targetPlatform dflags) == OSMinGW32\n         = litlabel (appendFS fs (mkFastString ('@':show sz)))\n     -- On Windows, stdcall labels have a suffix indicating the no. of\n     -- arg words, e.g. foo@8.  testcase: ffi012(ghci)\n    literal (LitLabel fs _ _) = litlabel fs\n    literal LitNullAddr       = int 0\n    literal (LitFloat r)      = float (fromRational r)\n    literal (LitDouble r)     = double (fromRational r)\n    literal (LitChar c)       = int (ord c)\n    literal (LitString bs)    = lit [BCONPtrStr bs]\n       -- LitString requires a zero-terminator when emitted\n    literal (LitNumber nt i _) = case nt of\n      LitNumInt     -> int (fromIntegral i)\n      LitNumWord    -> int (fromIntegral i)\n      LitNumInt64   -> int64 (fromIntegral i)\n      LitNumWord64  -> int64 (fromIntegral i)\n      LitNumInteger -> panic \"ByteCodeAsm.literal: LitNumInteger\"\n      LitNumNatural -> panic \"ByteCodeAsm.literal: LitNumNatural\"\n    -- We can lower 'LitRubbish' to an arbitrary constant, but @NULL@ is most\n    -- likely to elicit a crash (rather than corrupt memory) in case absence\n    -- analysis messed up.\n    literal LitRubbish         = int 0\n\n    litlabel fs = lit [BCONPtrLbl fs]\n    addr (RemotePtr a) = words [fromIntegral a]\n    float = words . mkLitF\n    double = words . mkLitD dflags\n    int = words . mkLitI\n    int64 = words . mkLitI64 dflags\n    words ws = lit (map BCONPtrWord ws)\n    word w = words [w]\n\nisLarge :: Word -> Bool\nisLarge n = n > 65535\n\npush_alts :: ArgRep -> Word16\npush_alts V   = bci_PUSH_ALTS_V\npush_alts P   = bci_PUSH_ALTS_P\npush_alts N   = bci_PUSH_ALTS_N\npush_alts L   = bci_PUSH_ALTS_L\npush_alts F   = bci_PUSH_ALTS_F\npush_alts D   = bci_PUSH_ALTS_D\npush_alts V16 = error \"push_alts: vector\"\npush_alts V32 = error \"push_alts: vector\"\npush_alts V64 = error \"push_alts: vector\"\n\nreturn_ubx :: ArgRep -> Word16\nreturn_ubx V   = bci_RETURN_V\nreturn_ubx P   = bci_RETURN_P\nreturn_ubx N   = bci_RETURN_N\nreturn_ubx L   = bci_RETURN_L\nreturn_ubx F   = bci_RETURN_F\nreturn_ubx D   = bci_RETURN_D\nreturn_ubx V16 = error \"return_ubx: vector\"\nreturn_ubx V32 = error \"return_ubx: vector\"\nreturn_ubx V64 = error \"return_ubx: vector\"\n\n-- Make lists of host-sized words for literals, so that when the\n-- words are placed in memory at increasing addresses, the\n-- bit pattern is correct for the host's word size and endianness.\nmkLitI   ::             Int    -> [Word]\nmkLitF   ::             Float  -> [Word]\nmkLitD   :: DynFlags -> Double -> [Word]\nmkLitI64 :: DynFlags -> Int64  -> [Word]\n\nmkLitF f\n   = runST (do\n        arr <- newArray_ ((0::Int),0)\n        writeArray arr 0 f\n        f_arr <- castSTUArray arr\n        w0 <- readArray f_arr 0\n        return [w0 :: Word]\n     )\n\nmkLitD dflags d\n   | wORD_SIZE dflags == 4\n   = runST (do\n        arr <- newArray_ ((0::Int),1)\n        writeArray arr 0 d\n        d_arr <- castSTUArray arr\n        w0 <- readArray d_arr 0\n        w1 <- readArray d_arr 1\n        return [w0 :: Word, w1]\n     )\n   | wORD_SIZE dflags == 8\n   = runST (do\n        arr <- newArray_ ((0::Int),0)\n        writeArray arr 0 d\n        d_arr <- castSTUArray arr\n        w0 <- readArray d_arr 0\n        return [w0 :: Word]\n     )\n   | otherwise\n   = panic \"mkLitD: Bad wORD_SIZE\"\n\nmkLitI64 dflags ii\n   | wORD_SIZE dflags == 4\n   = runST (do\n        arr <- newArray_ ((0::Int),1)\n        writeArray arr 0 ii\n        d_arr <- castSTUArray arr\n        w0 <- readArray d_arr 0\n        w1 <- readArray d_arr 1\n        return [w0 :: Word,w1]\n     )\n   | wORD_SIZE dflags == 8\n   = runST (do\n        arr <- newArray_ ((0::Int),0)\n        writeArray arr 0 ii\n        d_arr <- castSTUArray arr\n        w0 <- readArray d_arr 0\n        return [w0 :: Word]\n     )\n   | otherwise\n   = panic \"mkLitI64: Bad wORD_SIZE\"\n\nmkLitI i = [fromIntegral i :: Word]\n\niNTERP_STACK_CHECK_THRESH :: Int\niNTERP_STACK_CHECK_THRESH = INTERP_STACK_CHECK_THRESH\n", "num_lines": 565}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash, RecordWildCards, BangPatterns #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# OPTIONS_GHC -fprof-auto-top #-}\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- | ByteCodeGen: Generate bytecode from Core\nmodule ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport ByteCodeInstr\nimport ByteCodeAsm\nimport ByteCodeTypes\n\nimport GHCi\nimport GHCi.FFI\nimport GHCi.RemoteTypes\nimport BasicTypes\nimport DynFlags\nimport Outputable\nimport Platform\nimport Name\nimport MkId\nimport Id\nimport ForeignCall\nimport HscTypes\nimport CoreUtils\nimport CoreSyn\nimport PprCore\nimport Literal\nimport PrimOp\nimport CoreFVs\nimport Type\nimport RepType\nimport Kind            ( isLiftedTypeKind )\nimport DataCon\nimport TyCon\nimport Util\nimport VarSet\nimport TysPrim\nimport ErrUtils\nimport Unique\nimport FastString\nimport Panic\nimport StgCmmClosure    ( NonVoid(..), fromNonVoid, nonVoidIds )\nimport StgCmmLayout\nimport SMRep hiding (WordOff, ByteOff, wordsToBytes)\nimport Bitmap\nimport OrdList\nimport Maybes\nimport VarEnv\n\nimport Data.List\nimport Foreign\nimport Control.Monad\nimport Data.Char\n\nimport UniqSupply\nimport Module\nimport Control.Arrow ( second )\n\nimport Control.Exception\nimport Data.Array\nimport Data.ByteString (ByteString)\nimport Data.Map (Map)\nimport Data.IntMap (IntMap)\nimport qualified Data.Map as Map\nimport qualified Data.IntMap as IntMap\nimport qualified FiniteMap as Map\nimport Data.Ord\nimport GHC.Stack.CCS\nimport Data.Either ( partitionEithers )\n\n-- -----------------------------------------------------------------------------\n-- Generating byte code for a complete module\n\nbyteCodeGen :: HscEnv\n            -> Module\n            -> CoreProgram\n            -> [TyCon]\n            -> Maybe ModBreaks\n            -> IO CompiledByteCode\nbyteCodeGen hsc_env this_mod binds tycs mb_modBreaks\n   = withTiming (pure dflags)\n                (text \"ByteCodeGen\"<+>brackets (ppr this_mod))\n                (const ()) $ do\n        -- Split top-level binds into strings and others.\n        -- See Note [generating code for top-level string literal bindings].\n        let (strings, flatBinds) = partitionEithers $ do\n                (bndr, rhs) <- flattenBinds binds\n                return $ case exprIsTickedString_maybe rhs of\n                    Just str -> Left (bndr, str)\n                    _ -> Right (bndr, simpleFreeVars rhs)\n        stringPtrs <- allocateTopStrings hsc_env strings\n\n        us <- mkSplitUniqSupply 'y'\n        (BcM_State{..}, proto_bcos) <-\n           runBc hsc_env us this_mod mb_modBreaks (mkVarEnv stringPtrs) $\n             mapM schemeTopBind flatBinds\n\n        when (notNull ffis)\n             (panic \"ByteCodeGen.byteCodeGen: missing final emitBc?\")\n\n        dumpIfSet_dyn dflags Opt_D_dump_BCOs\n           \"Proto-BCOs\" (vcat (intersperse (char ' ') (map ppr proto_bcos)))\n\n        cbc <- assembleBCOs hsc_env proto_bcos tycs (map snd stringPtrs)\n          (case modBreaks of\n             Nothing -> Nothing\n             Just mb -> Just mb{ modBreaks_breakInfo = breakInfo })\n\n        -- Squash space leaks in the CompiledByteCode.  This is really\n        -- important, because when loading a set of modules into GHCi\n        -- we don't touch the CompiledByteCode until the end when we\n        -- do linking.  Forcing out the thunks here reduces space\n        -- usage by more than 50% when loading a large number of\n        -- modules.\n        evaluate (seqCompiledByteCode cbc)\n\n        return cbc\n\n  where dflags = hsc_dflags hsc_env\n\nallocateTopStrings\n  :: HscEnv\n  -> [(Id, ByteString)]\n  -> IO [(Var, RemotePtr ())]\nallocateTopStrings hsc_env topStrings = do\n  let !(bndrs, strings) = unzip topStrings\n  ptrs <- iservCmd hsc_env $ MallocStrings strings\n  return $ zip bndrs ptrs\n\n{-\nNote [generating code for top-level string literal bindings]\n\nHere is a summary on how the byte code generator deals with top-level string\nliterals:\n\n1. Top-level string literal bindings are separated from the rest of the module.\n\n2. The strings are allocated via iservCmd, in allocateTopStrings\n\n3. The mapping from binders to allocated strings (topStrings) are maintained in\n   BcM and used when generating code for variable references.\n-}\n\n-- -----------------------------------------------------------------------------\n-- Generating byte code for an expression\n\n-- Returns: the root BCO for this expression\ncoreExprToBCOs :: HscEnv\n               -> Module\n               -> CoreExpr\n               -> IO UnlinkedBCO\ncoreExprToBCOs hsc_env this_mod expr\n = withTiming (pure dflags)\n              (text \"ByteCodeGen\"<+>brackets (ppr this_mod))\n              (const ()) $ do\n      -- create a totally bogus name for the top-level BCO; this\n      -- should be harmless, since it's never used for anything\n      let invented_name  = mkSystemVarName (mkPseudoUniqueE 0) (fsLit \"ExprTopLevel\")\n          invented_id    = Id.mkLocalId invented_name (panic \"invented_id's type\")\n\n      -- the uniques are needed to generate fresh variables when we introduce new\n      -- let bindings for ticked expressions\n      us <- mkSplitUniqSupply 'y'\n      (BcM_State _dflags _us _this_mod _final_ctr mallocd _ _ _, proto_bco)\n         <- runBc hsc_env us this_mod Nothing emptyVarEnv $\n              schemeTopBind (invented_id, simpleFreeVars expr)\n\n      when (notNull mallocd)\n           (panic \"ByteCodeGen.coreExprToBCOs: missing final emitBc?\")\n\n      dumpIfSet_dyn dflags Opt_D_dump_BCOs \"Proto-BCOs\" (ppr proto_bco)\n\n      assembleOneBCO hsc_env proto_bco\n  where dflags = hsc_dflags hsc_env\n\n-- The regular freeVars function gives more information than is useful to\n-- us here. simpleFreeVars does the impedance matching.\nsimpleFreeVars :: CoreExpr -> AnnExpr Id DVarSet\nsimpleFreeVars = go . freeVars\n  where\n    go :: AnnExpr Id FVAnn -> AnnExpr Id DVarSet\n    go (ann, e) = (freeVarsOfAnn ann, go' e)\n\n    go' :: AnnExpr' Id FVAnn -> AnnExpr' Id DVarSet\n    go' (AnnVar id)                  = AnnVar id\n    go' (AnnLit lit)                 = AnnLit lit\n    go' (AnnLam bndr body)           = AnnLam bndr (go body)\n    go' (AnnApp fun arg)             = AnnApp (go fun) (go arg)\n    go' (AnnCase scrut bndr ty alts) = AnnCase (go scrut) bndr ty (map go_alt alts)\n    go' (AnnLet bind body)           = AnnLet (go_bind bind) (go body)\n    go' (AnnCast expr (ann, co))     = AnnCast (go expr) (freeVarsOfAnn ann, co)\n    go' (AnnTick tick body)          = AnnTick tick (go body)\n    go' (AnnType ty)                 = AnnType ty\n    go' (AnnCoercion co)             = AnnCoercion co\n\n    go_alt (con, args, expr) = (con, args, go expr)\n\n    go_bind (AnnNonRec bndr rhs) = AnnNonRec bndr (go rhs)\n    go_bind (AnnRec pairs)       = AnnRec (map (second go) pairs)\n\n-- -----------------------------------------------------------------------------\n-- Compilation schema for the bytecode generator\n\ntype BCInstrList = OrdList BCInstr\n\nnewtype ByteOff = ByteOff Int\n    deriving (Enum, Eq, Integral, Num, Ord, Real)\n\nnewtype WordOff = WordOff Int\n    deriving (Enum, Eq, Integral, Num, Ord, Real)\n\nwordsToBytes :: DynFlags -> WordOff -> ByteOff\nwordsToBytes dflags = fromIntegral . (* wORD_SIZE dflags) . fromIntegral\n\n-- Used when we know we have a whole number of words\nbytesToWords :: DynFlags -> ByteOff -> WordOff\nbytesToWords dflags (ByteOff bytes) =\n    let (q, r) = bytes `quotRem` (wORD_SIZE dflags)\n    in if r == 0\n           then fromIntegral q\n           else panic $ \"ByteCodeGen.bytesToWords: bytes=\" ++ show bytes\n\nwordSize :: DynFlags -> ByteOff\nwordSize dflags = ByteOff (wORD_SIZE dflags)\n\ntype Sequel = ByteOff -- back off to this depth before ENTER\n\ntype StackDepth = ByteOff\n\n-- | Maps Ids to their stack depth. This allows us to avoid having to mess with\n-- it after each push/pop.\ntype BCEnv = Map Id StackDepth -- To find vars on the stack\n\n{-\nppBCEnv :: BCEnv -> SDoc\nppBCEnv p\n   = text \"begin-env\"\n     $$ nest 4 (vcat (map pp_one (sortBy cmp_snd (Map.toList p))))\n     $$ text \"end-env\"\n     where\n        pp_one (var, offset) = int offset <> colon <+> ppr var <+> ppr (bcIdArgRep var)\n        cmp_snd x y = compare (snd x) (snd y)\n-}\n\n-- Create a BCO and do a spot of peephole optimisation on the insns\n-- at the same time.\nmkProtoBCO\n   :: DynFlags\n   -> name\n   -> BCInstrList\n   -> Either  [AnnAlt Id DVarSet] (AnnExpr Id DVarSet)\n   -> Int\n   -> Word16\n   -> [StgWord]\n   -> Bool      -- True <=> is a return point, rather than a function\n   -> [FFIInfo]\n   -> ProtoBCO name\nmkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis\n   = ProtoBCO {\n        protoBCOName = nm,\n        protoBCOInstrs = maybe_with_stack_check,\n        protoBCOBitmap = bitmap,\n        protoBCOBitmapSize = bitmap_size,\n        protoBCOArity = arity,\n        protoBCOExpr = origin,\n        protoBCOFFIs = ffis\n      }\n     where\n        -- Overestimate the stack usage (in words) of this BCO,\n        -- and if >= iNTERP_STACK_CHECK_THRESH, add an explicit\n        -- stack check.  (The interpreter always does a stack check\n        -- for iNTERP_STACK_CHECK_THRESH words at the start of each\n        -- BCO anyway, so we only need to add an explicit one in the\n        -- (hopefully rare) cases when the (overestimated) stack use\n        -- exceeds iNTERP_STACK_CHECK_THRESH.\n        maybe_with_stack_check\n           | is_ret && stack_usage < fromIntegral (aP_STACK_SPLIM dflags) = peep_d\n                -- don't do stack checks at return points,\n                -- everything is aggregated up to the top BCO\n                -- (which must be a function).\n                -- That is, unless the stack usage is >= AP_STACK_SPLIM,\n                -- see bug #1466.\n           | stack_usage >= fromIntegral iNTERP_STACK_CHECK_THRESH\n           = STKCHECK stack_usage : peep_d\n           | otherwise\n           = peep_d     -- the supposedly common case\n\n        -- We assume that this sum doesn't wrap\n        stack_usage = sum (map bciStackUse peep_d)\n\n        -- Merge local pushes\n        peep_d = peep (fromOL instrs_ordlist)\n\n        peep (PUSH_L off1 : PUSH_L off2 : PUSH_L off3 : rest)\n           = PUSH_LLL off1 (off2-1) (off3-2) : peep rest\n        peep (PUSH_L off1 : PUSH_L off2 : rest)\n           = PUSH_LL off1 (off2-1) : peep rest\n        peep (i:rest)\n           = i : peep rest\n        peep []\n           = []\n\nargBits :: DynFlags -> [ArgRep] -> [Bool]\nargBits _      [] = []\nargBits dflags (rep : args)\n  | isFollowableArg rep  = False : argBits dflags args\n  | otherwise = take (argRepSizeW dflags rep) (repeat True) ++ argBits dflags args\n\n-- -----------------------------------------------------------------------------\n-- schemeTopBind\n\n-- Compile code for the right-hand side of a top-level binding\n\nschemeTopBind :: (Id, AnnExpr Id DVarSet) -> BcM (ProtoBCO Name)\nschemeTopBind (id, rhs)\n  | Just data_con <- isDataConWorkId_maybe id,\n    isNullaryRepDataCon data_con = do\n    dflags <- getDynFlags\n        -- Special case for the worker of a nullary data con.\n        -- It'll look like this:        Nil = /\\a -> Nil a\n        -- If we feed it into schemeR, we'll get\n        --      Nil = Nil\n        -- because mkConAppCode treats nullary constructor applications\n        -- by just re-using the single top-level definition.  So\n        -- for the worker itself, we must allocate it directly.\n    -- ioToBc (putStrLn $ \"top level BCO\")\n    emitBc (mkProtoBCO dflags (getName id) (toOL [PACK data_con 0, ENTER])\n                       (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})\n\n  | otherwise\n  = schemeR [{- No free variables -}] (id, rhs)\n\n\n-- -----------------------------------------------------------------------------\n-- schemeR\n\n-- Compile code for a right-hand side, to give a BCO that,\n-- when executed with the free variables and arguments on top of the stack,\n-- will return with a pointer to the result on top of the stack, after\n-- removing the free variables and arguments.\n--\n-- Park the resulting BCO in the monad.  Also requires the\n-- variable to which this value was bound, so as to give the\n-- resulting BCO a name.\n\nschemeR :: [Id]                 -- Free vars of the RHS, ordered as they\n                                -- will appear in the thunk.  Empty for\n                                -- top-level things, which have no free vars.\n        -> (Id, AnnExpr Id DVarSet)\n        -> BcM (ProtoBCO Name)\nschemeR fvs (nm, rhs)\n{-\n   | trace (showSDoc (\n              (char ' '\n               $$ (ppr.filter (not.isTyVar).dVarSetElems.fst) rhs\n               $$ pprCoreExpr (deAnnotate rhs)\n               $$ char ' '\n              ))) False\n   = undefined\n   | otherwise\n-}\n   = schemeR_wrk fvs nm rhs (collect rhs)\n\ncollect :: AnnExpr Id DVarSet -> ([Var], AnnExpr' Id DVarSet)\ncollect (_, e) = go [] e\n  where\n    go xs e | Just e' <- bcView e = go xs e'\n    go xs (AnnLam x (_,e))\n      | typePrimRep (idType x) `lengthExceeds` 1\n      = multiValException\n      | otherwise\n      = go (x:xs) e\n    go xs not_lambda = (reverse xs, not_lambda)\n\nschemeR_wrk\n    :: [Id]\n    -> Id\n    -> AnnExpr Id DVarSet\n    -> ([Var], AnnExpr' Var DVarSet)\n    -> BcM (ProtoBCO Name)\nschemeR_wrk fvs nm original_body (args, body)\n   = do\n     dflags <- getDynFlags\n     let\n         all_args  = reverse args ++ fvs\n         arity     = length all_args\n         -- all_args are the args in reverse order.  We're compiling a function\n         -- \\fv1..fvn x1..xn -> e\n         -- i.e. the fvs come first\n\n         -- Stack arguments always take a whole number of words, we never pack\n         -- them unlike constructor fields.\n         szsb_args = map (wordsToBytes dflags . idSizeW dflags) all_args\n         sum_szsb_args  = sum szsb_args\n         p_init    = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args))\n\n         -- make the arg bitmap\n         bits = argBits dflags (reverse (map bcIdArgRep all_args))\n         bitmap_size = genericLength bits\n         bitmap = mkBitmap dflags bits\n     body_code <- schemeER_wrk sum_szsb_args p_init body\n\n     emitBc (mkProtoBCO dflags (getName nm) body_code (Right original_body)\n                 arity bitmap_size bitmap False{-not alts-})\n\n-- introduce break instructions for ticked expressions\nschemeER_wrk :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList\nschemeER_wrk d p rhs\n  | AnnTick (Breakpoint tick_no fvs) (_annot, newRhs) <- rhs\n  = do  code <- schemeE d 0 p newRhs\n        cc_arr <- getCCArray\n        this_mod <- moduleName <$> getCurrentModule\n        dflags <- getDynFlags\n        let idOffSets = getVarOffSets dflags d p fvs\n        let breakInfo = CgBreakInfo\n                        { cgb_vars = idOffSets\n                        , cgb_resty = exprType (deAnnotate' newRhs)\n                        }\n        newBreakInfo tick_no breakInfo\n        dflags <- getDynFlags\n        let cc | interpreterProfiled dflags = cc_arr ! tick_no\n               | otherwise = toRemotePtr nullPtr\n        let breakInstr = BRK_FUN (fromIntegral tick_no) (getUnique this_mod) cc\n        return $ breakInstr `consOL` code\n   | otherwise = schemeE d 0 p rhs\n\ngetVarOffSets :: DynFlags -> StackDepth -> BCEnv -> [Id] -> [(Id, Word16)]\ngetVarOffSets dflags depth env = catMaybes . map getOffSet\n  where\n    getOffSet id = case lookupBCEnv_maybe id env of\n        Nothing     -> Nothing\n        Just offset ->\n            -- michalt: I'm not entirely sure why we need the stack\n            -- adjustment by 2 here. I initially thought that there's\n            -- something off with getIdValFromApStack (the only user of this\n            -- value), but it looks ok to me. My current hypothesis is that\n            -- this \"adjustment\" is needed due to stack manipulation for\n            -- BRK_FUN in Interpreter.c In any case, this is used only when\n            -- we trigger a breakpoint.\n            let !var_depth_ws =\n                    trunc16W $ bytesToWords dflags (depth - offset) + 2\n            in Just (id, var_depth_ws)\n\ntruncIntegral16 :: Integral a => a -> Word16\ntruncIntegral16 w\n    | w > fromIntegral (maxBound :: Word16)\n    = panic \"stack depth overflow\"\n    | otherwise\n    = fromIntegral w\n\ntrunc16B :: ByteOff -> Word16\ntrunc16B = truncIntegral16\n\ntrunc16W :: WordOff -> Word16\ntrunc16W = truncIntegral16\n\nfvsToEnv :: BCEnv -> DVarSet -> [Id]\n-- Takes the free variables of a right-hand side, and\n-- delivers an ordered list of the local variables that will\n-- be captured in the thunk for the RHS\n-- The BCEnv argument tells which variables are in the local\n-- environment: these are the ones that should be captured\n--\n-- The code that constructs the thunk, and the code that executes\n-- it, have to agree about this layout\nfvsToEnv p fvs = [v | v <- dVarSetElems fvs,\n                      isId v,           -- Could be a type variable\n                      v `Map.member` p]\n\n-- -----------------------------------------------------------------------------\n-- schemeE\n\nreturnUnboxedAtom\n    :: StackDepth\n    -> Sequel\n    -> BCEnv\n    -> AnnExpr' Id DVarSet\n    -> ArgRep\n    -> BcM BCInstrList\n-- Returning an unlifted value.\n-- Heave it on the stack, SLIDE, and RETURN.\nreturnUnboxedAtom d s p e e_rep = do\n    dflags <- getDynFlags\n    (push, szb) <- pushAtom d p e\n    return (push                                 -- value onto stack\n           `appOL`  mkSlideB dflags szb (d - s)  -- clear to sequel\n           `snocOL` RETURN_UBX e_rep)            -- go\n\n-- Compile code to apply the given expression to the remaining args\n-- on the stack, returning a HNF.\nschemeE\n    :: StackDepth -> Sequel -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList\nschemeE d s p e\n   | Just e' <- bcView e\n   = schemeE d s p e'\n\n-- Delegate tail-calls to schemeT.\nschemeE d s p e@(AnnApp _ _) = schemeT d s p e\n\nschemeE d s p e@(AnnLit lit)     = returnUnboxedAtom d s p e (typeArgRep (literalType lit))\nschemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e V\n\nschemeE d s p e@(AnnVar v)\n    | isUnliftedType (idType v) = returnUnboxedAtom d s p e (bcIdArgRep v)\n    | otherwise                 = schemeT d s p e\n\nschemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body))\n   | (AnnVar v, args_r_to_l) <- splitApp rhs,\n     Just data_con <- isDataConWorkId_maybe v,\n     dataConRepArity data_con == length args_r_to_l\n   = do -- Special case for a non-recursive let whose RHS is a\n        -- saturated constructor application.\n        -- Just allocate the constructor and carry on\n        alloc_code <- mkConAppCode d s p data_con args_r_to_l\n        dflags <- getDynFlags\n        let !d2 = d + wordSize dflags\n        body_code <- schemeE d2 s (Map.insert x d2 p) body\n        return (alloc_code `appOL` body_code)\n\n-- General case for let.  Generates correct, if inefficient, code in\n-- all situations.\nschemeE d s p (AnnLet binds (_,body)) = do\n     dflags <- getDynFlags\n     let (xs,rhss) = case binds of AnnNonRec x rhs  -> ([x],[rhs])\n                                   AnnRec xs_n_rhss -> unzip xs_n_rhss\n         n_binds = genericLength xs\n\n         fvss  = map (fvsToEnv p' . fst) rhss\n\n         -- Sizes of free vars\n         size_w = trunc16W . idSizeW dflags\n         sizes = map (\\rhs_fvs -> sum (map size_w rhs_fvs)) fvss\n\n         -- the arity of each rhs\n         arities = map (genericLength . fst . collect) rhss\n\n         -- This p', d' defn is safe because all the items being pushed\n         -- are ptrs, so all have size 1 word.  d' and p' reflect the stack\n         -- after the closures have been allocated in the heap (but not\n         -- filled in), and pointers to them parked on the stack.\n         offsets = mkStackOffsets d (genericReplicate n_binds (wordSize dflags))\n         p' = Map.insertList (zipE xs offsets) p\n         d' = d + wordsToBytes dflags n_binds\n         zipE = zipEqual \"schemeE\"\n\n         -- ToDo: don't build thunks for things with no free variables\n         build_thunk\n             :: StackDepth\n             -> [Id]\n             -> Word16\n             -> ProtoBCO Name\n             -> Word16\n             -> Word16\n             -> BcM BCInstrList\n         build_thunk _ [] size bco off arity\n            = return (PUSH_BCO bco `consOL` unitOL (mkap (off+size) size))\n           where\n                mkap | arity == 0 = MKAP\n                     | otherwise  = MKPAP\n         build_thunk dd (fv:fvs) size bco off arity = do\n              (push_code, pushed_szb) <- pushAtom dd p' (AnnVar fv)\n              more_push_code <-\n                  build_thunk (dd + pushed_szb) fvs size bco off arity\n              return (push_code `appOL` more_push_code)\n\n         alloc_code = toOL (zipWith mkAlloc sizes arities)\n           where mkAlloc sz 0\n                    | is_tick     = ALLOC_AP_NOUPD sz\n                    | otherwise   = ALLOC_AP sz\n                 mkAlloc sz arity = ALLOC_PAP arity sz\n\n         is_tick = case binds of\n                     AnnNonRec id _ -> occNameFS (getOccName id) == tickFS\n                     _other -> False\n\n         compile_bind d' fvs x rhs size arity off = do\n                bco <- schemeR fvs (x,rhs)\n                build_thunk d' fvs size bco off arity\n\n         compile_binds =\n            [ compile_bind d' fvs x rhs size arity (trunc16W n)\n            | (fvs, x, rhs, size, arity, n) <-\n                zip6 fvss xs rhss sizes arities [n_binds, n_binds-1 .. 1]\n            ]\n     body_code <- schemeE d' s p' body\n     thunk_codes <- sequence compile_binds\n     return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code)\n\n-- Introduce a let binding for a ticked case expression. This rule\n-- *should* only fire when the expression was not already let-bound\n-- (the code gen for let bindings should take care of that).  Todo: we\n-- call exprFreeVars on a deAnnotated expression, this may not be the\n-- best way to calculate the free vars but it seemed like the least\n-- intrusive thing to do\nschemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs)\n   | isLiftedTypeKind (typeKind ty)\n   = do   id <- newId ty\n          -- Todo: is emptyVarSet correct on the next line?\n          let letExp = AnnLet (AnnNonRec id (fvs, exp)) (emptyDVarSet, AnnVar id)\n          schemeE d s p letExp\n\n   | otherwise\n   = do   -- If the result type is not definitely lifted, then we must generate\n          --   let f = \\s . tick<n> e\n          --   in  f realWorld#\n          -- When we stop at the breakpoint, _result will have an unlifted\n          -- type and hence won't be bound in the environment, but the\n          -- breakpoint will otherwise work fine.\n          --\n          -- NB (Trac #12007) this /also/ applies for if (ty :: TYPE r), where\n          --    r :: RuntimeRep is a variable. This can happen in the\n          --    continuations for a pattern-synonym matcher\n          --    match = /\\(r::RuntimeRep) /\\(a::TYPE r).\n          --            \\(k :: Int -> a) \\(v::T).\n          --            case v of MkV n -> k n\n          -- Here (k n) :: a :: Type r, so we don't know if it's lifted\n          -- or not; but that should be fine provided we add that void arg.\n\n          id <- newId (mkVisFunTy realWorldStatePrimTy ty)\n          st <- newId realWorldStatePrimTy\n          let letExp = AnnLet (AnnNonRec id (fvs, AnnLam st (emptyDVarSet, exp)))\n                              (emptyDVarSet, (AnnApp (emptyDVarSet, AnnVar id)\n                                                    (emptyDVarSet, AnnVar realWorldPrimId)))\n          schemeE d s p letExp\n\n   where\n     exp' = deAnnotate' exp\n     fvs  = exprFreeVarsDSet exp'\n     ty   = exprType exp'\n\n-- ignore other kinds of tick\nschemeE d s p (AnnTick _ (_, rhs)) = schemeE d s p rhs\n\nschemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut\n        -- no alts: scrut is guaranteed to diverge\n\nschemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)])\n   | isUnboxedTupleCon dc -- handles pairs with one void argument (e.g. state token)\n        -- Convert\n        --      case .... of x { (# V'd-thing, a #) -> ... }\n        -- to\n        --      case .... of a { DEFAULT -> ... }\n        -- because the return convention for both are identical.\n        --\n        -- Note that it does not matter losing the void-rep thing from the\n        -- envt (it won't be bound now) because we never look such things up.\n   , Just res <- case (typePrimRep (idType bind1), typePrimRep (idType bind2)) of\n                   ([], [_])\n                     -> Just $ doCase d s p scrut bind2 [(DEFAULT, [], rhs)] (Just bndr)\n                   ([_], [])\n                     -> Just $ doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr)\n                   _ -> Nothing\n   = res\n\nschemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)])\n   | isUnboxedTupleCon dc\n   , typePrimRep (idType bndr) `lengthAtMost` 1 -- handles unit tuples\n   = doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr)\n\nschemeE d s p (AnnCase scrut bndr _ alt@[(DEFAULT, [], _)])\n   | isUnboxedTupleType (idType bndr)\n   , Just ty <- case typePrimRep (idType bndr) of\n       [_]  -> Just (unwrapType (idType bndr))\n       []   -> Just voidPrimTy\n       _    -> Nothing\n       -- handles any pattern with a single non-void binder; in particular I/O\n       -- monad returns (# RealWorld#, a #)\n   = doCase d s p scrut (bndr `setIdType` ty) alt (Just bndr)\n\nschemeE d s p (AnnCase scrut bndr _ alts)\n   = doCase d s p scrut bndr alts Nothing{-not an unboxed tuple-}\n\nschemeE _ _ _ expr\n   = pprPanic \"ByteCodeGen.schemeE: unhandled case\"\n               (pprCoreExpr (deAnnotate' expr))\n\n{-\n   Ticked Expressions\n   ------------------\n\n  The idea is that the \"breakpoint<n,fvs> E\" is really just an annotation on\n  the code. When we find such a thing, we pull out the useful information,\n  and then compile the code as if it was just the expression E.\n\n-}\n\n-- Compile code to do a tail call.  Specifically, push the fn,\n-- slide the on-stack app back down to the sequel depth,\n-- and enter.  Four cases:\n--\n-- 0.  (Nasty hack).\n--     An application \"GHC.Prim.tagToEnum# <type> unboxed-int\".\n--     The int will be on the stack.  Generate a code sequence\n--     to convert it to the relevant constructor, SLIDE and ENTER.\n--\n-- 1.  The fn denotes a ccall.  Defer to generateCCall.\n--\n-- 2.  (Another nasty hack).  Spot (# a::V, b #) and treat\n--     it simply as  b  -- since the representations are identical\n--     (the V takes up zero stack space).  Also, spot\n--     (# b #) and treat it as  b.\n--\n-- 3.  Application of a constructor, by defn saturated.\n--     Split the args into ptrs and non-ptrs, and push the nonptrs,\n--     then the ptrs, and then do PACK and RETURN.\n--\n-- 4.  Otherwise, it must be a function call.  Push the args\n--     right to left, SLIDE and ENTER.\n\nschemeT :: StackDepth   -- Stack depth\n        -> Sequel       -- Sequel depth\n        -> BCEnv        -- stack env\n        -> AnnExpr' Id DVarSet\n        -> BcM BCInstrList\n\nschemeT d s p app\n\n   -- Case 0\n   | Just (arg, constr_names) <- maybe_is_tagToEnum_call app\n   = implement_tagToId d s p arg constr_names\n\n   -- Case 1\n   | Just (CCall ccall_spec) <- isFCallId_maybe fn\n   = if isSupportedCConv ccall_spec\n      then generateCCall d s p ccall_spec fn args_r_to_l\n      else unsupportedCConvException\n\n\n   -- Case 2: Constructor application\n   | Just con <- maybe_saturated_dcon\n   , isUnboxedTupleCon con\n   = case args_r_to_l of\n        [arg1,arg2] | isVAtom arg1 ->\n                  unboxedTupleReturn d s p arg2\n        [arg1,arg2] | isVAtom arg2 ->\n                  unboxedTupleReturn d s p arg1\n        _other -> multiValException\n\n   -- Case 3: Ordinary data constructor\n   | Just con <- maybe_saturated_dcon\n   = do alloc_con <- mkConAppCode d s p con args_r_to_l\n        dflags <- getDynFlags\n        return (alloc_con         `appOL`\n                mkSlideW 1 (bytesToWords dflags $ d - s) `snocOL`\n                ENTER)\n\n   -- Case 4: Tail call of function\n   | otherwise\n   = doTailCall d s p fn args_r_to_l\n\n   where\n        -- Extract the args (R->L) and fn\n        -- The function will necessarily be a variable,\n        -- because we are compiling a tail call\n      (AnnVar fn, args_r_to_l) = splitApp app\n\n      -- Only consider this to be a constructor application iff it is\n      -- saturated.  Otherwise, we'll call the constructor wrapper.\n      n_args = length args_r_to_l\n      maybe_saturated_dcon\n        = case isDataConWorkId_maybe fn of\n                Just con | dataConRepArity con == n_args -> Just con\n                _ -> Nothing\n\n-- -----------------------------------------------------------------------------\n-- Generate code to build a constructor application,\n-- leaving it on top of the stack\n\nmkConAppCode\n    :: StackDepth\n    -> Sequel\n    -> BCEnv\n    -> DataCon                  -- The data constructor\n    -> [AnnExpr' Id DVarSet]    -- Args, in *reverse* order\n    -> BcM BCInstrList\nmkConAppCode _ _ _ con []       -- Nullary constructor\n  = ASSERT( isNullaryRepDataCon con )\n    return (unitOL (PUSH_G (getName (dataConWorkId con))))\n        -- Instead of doing a PACK, which would allocate a fresh\n        -- copy of this constructor, use the single shared version.\n\nmkConAppCode orig_d _ p con args_r_to_l =\n    ASSERT( args_r_to_l `lengthIs` dataConRepArity con ) app_code\n  where\n    app_code = do\n        dflags <- getDynFlags\n\n        -- The args are initially in reverse order, but mkVirtHeapOffsets\n        -- expects them to be left-to-right.\n        let non_voids =\n                [ NonVoid (prim_rep, arg)\n                | arg <- reverse args_r_to_l\n                , let prim_rep = atomPrimRep arg\n                , not (isVoidRep prim_rep)\n                ]\n            (_, _, args_offsets) =\n                mkVirtHeapOffsetsWithPadding dflags StdHeader non_voids\n\n            do_pushery !d (arg : args) = do\n                (push, arg_bytes) <- case arg of\n                    (Padding l _) -> return $! pushPadding l\n                    (FieldOff a _) -> pushConstrAtom d p (fromNonVoid a)\n                more_push_code <- do_pushery (d + arg_bytes) args\n                return (push `appOL` more_push_code)\n            do_pushery !d [] = do\n                let !n_arg_words = trunc16W $ bytesToWords dflags (d - orig_d)\n                return (unitOL (PACK con n_arg_words))\n\n        -- Push on the stack in the reverse order.\n        do_pushery orig_d (reverse args_offsets)\n\n\n-- -----------------------------------------------------------------------------\n-- Returning an unboxed tuple with one non-void component (the only\n-- case we can handle).\n--\n-- Remember, we don't want to *evaluate* the component that is being\n-- returned, even if it is a pointed type.  We always just return.\n\nunboxedTupleReturn\n    :: StackDepth -> Sequel -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList\nunboxedTupleReturn d s p arg = returnUnboxedAtom d s p arg (atomRep arg)\n\n-- -----------------------------------------------------------------------------\n-- Generate code for a tail-call\n\ndoTailCall\n    :: StackDepth\n    -> Sequel\n    -> BCEnv\n    -> Id\n    -> [AnnExpr' Id DVarSet]\n    -> BcM BCInstrList\ndoTailCall init_d s p fn args = do_pushes init_d args (map atomRep args)\n  where\n  do_pushes !d [] reps = do\n        ASSERT( null reps ) return ()\n        (push_fn, sz) <- pushAtom d p (AnnVar fn)\n        dflags <- getDynFlags\n        ASSERT( sz == wordSize dflags ) return ()\n        let slide = mkSlideB dflags (d - init_d + wordSize dflags) (init_d - s)\n        return (push_fn `appOL` (slide `appOL` unitOL ENTER))\n  do_pushes !d args reps = do\n      let (push_apply, n, rest_of_reps) = findPushSeq reps\n          (these_args, rest_of_args) = splitAt n args\n      (next_d, push_code) <- push_seq d these_args\n      dflags <- getDynFlags\n      instrs <- do_pushes (next_d + wordSize dflags) rest_of_args rest_of_reps\n      --                          ^^^ for the PUSH_APPLY_ instruction\n      return (push_code `appOL` (push_apply `consOL` instrs))\n\n  push_seq d [] = return (d, nilOL)\n  push_seq d (arg:args) = do\n    (push_code, sz) <- pushAtom d p arg\n    (final_d, more_push_code) <- push_seq (d + sz) args\n    return (final_d, push_code `appOL` more_push_code)\n\n-- v. similar to CgStackery.findMatch, ToDo: merge\nfindPushSeq :: [ArgRep] -> (BCInstr, Int, [ArgRep])\nfindPushSeq (P: P: P: P: P: P: rest)\n  = (PUSH_APPLY_PPPPPP, 6, rest)\nfindPushSeq (P: P: P: P: P: rest)\n  = (PUSH_APPLY_PPPPP, 5, rest)\nfindPushSeq (P: P: P: P: rest)\n  = (PUSH_APPLY_PPPP, 4, rest)\nfindPushSeq (P: P: P: rest)\n  = (PUSH_APPLY_PPP, 3, rest)\nfindPushSeq (P: P: rest)\n  = (PUSH_APPLY_PP, 2, rest)\nfindPushSeq (P: rest)\n  = (PUSH_APPLY_P, 1, rest)\nfindPushSeq (V: rest)\n  = (PUSH_APPLY_V, 1, rest)\nfindPushSeq (N: rest)\n  = (PUSH_APPLY_N, 1, rest)\nfindPushSeq (F: rest)\n  = (PUSH_APPLY_F, 1, rest)\nfindPushSeq (D: rest)\n  = (PUSH_APPLY_D, 1, rest)\nfindPushSeq (L: rest)\n  = (PUSH_APPLY_L, 1, rest)\nfindPushSeq _\n  = panic \"ByteCodeGen.findPushSeq\"\n\n-- -----------------------------------------------------------------------------\n-- Case expressions\n\ndoCase\n    :: StackDepth\n    -> Sequel\n    -> BCEnv\n    -> AnnExpr Id DVarSet\n    -> Id\n    -> [AnnAlt Id DVarSet]\n    -> Maybe Id  -- Just x <=> is an unboxed tuple case with scrut binder,\n                 -- don't enter the result\n    -> BcM BCInstrList\ndoCase d s p (_,scrut) bndr alts is_unboxed_tuple\n  | typePrimRep (idType bndr) `lengthExceeds` 1\n  = multiValException\n  | otherwise\n  = do\n     dflags <- getDynFlags\n     let\n        profiling\n          | gopt Opt_ExternalInterpreter dflags = gopt Opt_SccProfilingOn dflags\n          | otherwise = rtsIsProfiled\n\n        -- Top of stack is the return itbl, as usual.\n        -- underneath it is the pointer to the alt_code BCO.\n        -- When an alt is entered, it assumes the returned value is\n        -- on top of the itbl.\n        ret_frame_size_b :: StackDepth\n        ret_frame_size_b = 2 * wordSize dflags\n\n        -- The extra frame we push to save/restor the CCCS when profiling\n        save_ccs_size_b | profiling = 2 * wordSize dflags\n                        | otherwise = 0\n\n        -- An unlifted value gets an extra info table pushed on top\n        -- when it is returned.\n        unlifted_itbl_size_b :: StackDepth\n        unlifted_itbl_size_b | isAlgCase = 0\n                            | otherwise = wordSize dflags\n\n        -- depth of stack after the return value has been pushed\n        d_bndr =\n            d + ret_frame_size_b + wordsToBytes dflags (idSizeW dflags bndr)\n\n        -- depth of stack after the extra info table for an unboxed return\n        -- has been pushed, if any.  This is the stack depth at the\n        -- continuation.\n        d_alts = d_bndr + unlifted_itbl_size_b\n\n        -- Env in which to compile the alts, not including\n        -- any vars bound by the alts themselves\n        p_alts0 = Map.insert bndr d_bndr p\n\n        p_alts = case is_unboxed_tuple of\n                   Just ubx_bndr -> Map.insert ubx_bndr d_bndr p_alts0\n                   Nothing       -> p_alts0\n\n        bndr_ty = idType bndr\n        isAlgCase = not (isUnliftedType bndr_ty) && isNothing is_unboxed_tuple\n\n        -- given an alt, return a discr and code for it.\n        codeAlt (DEFAULT, _, (_,rhs))\n           = do rhs_code <- schemeE d_alts s p_alts rhs\n                return (NoDiscr, rhs_code)\n\n        codeAlt alt@(_, bndrs, (_,rhs))\n           -- primitive or nullary constructor alt: no need to UNPACK\n           | null real_bndrs = do\n                rhs_code <- schemeE d_alts s p_alts rhs\n                return (my_discr alt, rhs_code)\n           -- If an alt attempts to match on an unboxed tuple or sum, we must\n           -- bail out, as the bytecode compiler can't handle them.\n           -- (See Trac #14608.)\n           | any (\\bndr -> typePrimRep (idType bndr) `lengthExceeds` 1) bndrs\n           = multiValException\n           -- algebraic alt with some binders\n           | otherwise =\n             let (tot_wds, _ptrs_wds, args_offsets) =\n                     mkVirtHeapOffsets dflags NoHeader\n                         [ NonVoid (bcIdPrimRep id, id)\n                         | NonVoid id <- nonVoidIds real_bndrs\n                         ]\n                 size = WordOff tot_wds\n\n                 stack_bot = d_alts + wordsToBytes dflags size\n\n                 -- convert offsets from Sp into offsets into the virtual stack\n                 p' = Map.insertList\n                        [ (arg, stack_bot - ByteOff offset)\n                        | (NonVoid arg, offset) <- args_offsets ]\n                        p_alts\n             in do\n             MASSERT(isAlgCase)\n             rhs_code <- schemeE stack_bot s p' rhs\n             return (my_discr alt,\n                     unitOL (UNPACK (trunc16W size)) `appOL` rhs_code)\n           where\n             real_bndrs = filterOut isTyVar bndrs\n\n        my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-}\n        my_discr (DataAlt dc, _, _)\n           | isUnboxedTupleCon dc || isUnboxedSumCon dc\n           = multiValException\n           | otherwise\n           = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG))\n        my_discr (LitAlt l, _, _)\n           = case l of LitNumber LitNumInt i  _  -> DiscrI (fromInteger i)\n                       LitNumber LitNumWord w _  -> DiscrW (fromInteger w)\n                       LitFloat r   -> DiscrF (fromRational r)\n                       LitDouble r  -> DiscrD (fromRational r)\n                       LitChar i    -> DiscrI (ord i)\n                       _ -> pprPanic \"schemeE(AnnCase).my_discr\" (ppr l)\n\n        maybe_ncons\n           | not isAlgCase = Nothing\n           | otherwise\n           = case [dc | (DataAlt dc, _, _) <- alts] of\n                []     -> Nothing\n                (dc:_) -> Just (tyConFamilySize (dataConTyCon dc))\n\n        -- the bitmap is relative to stack depth d, i.e. before the\n        -- BCO, info table and return value are pushed on.\n        -- This bit of code is v. similar to buildLivenessMask in CgBindery,\n        -- except that here we build the bitmap from the known bindings of\n        -- things that are pointers, whereas in CgBindery the code builds the\n        -- bitmap from the free slots and unboxed bindings.\n        -- (ToDo: merge?)\n        --\n        -- NOTE [7/12/2006] bug #1013, testcase ghci/should_run/ghci002.\n        -- The bitmap must cover the portion of the stack up to the sequel only.\n        -- Previously we were building a bitmap for the whole depth (d), but we\n        -- really want a bitmap up to depth (d-s).  This affects compilation of\n        -- case-of-case expressions, which is the only time we can be compiling a\n        -- case expression with s /= 0.\n        bitmap_size = trunc16W $ bytesToWords dflags (d - s)\n        bitmap_size' :: Int\n        bitmap_size' = fromIntegral bitmap_size\n        bitmap = intsToReverseBitmap dflags bitmap_size'{-size-}\n                        (sort (filter (< bitmap_size') rel_slots))\n          where\n          binds = Map.toList p\n          -- NB: unboxed tuple cases bind the scrut binder to the same offset\n          -- as one of the alt binders, so we have to remove any duplicates here:\n          rel_slots = nub $ map fromIntegral $ concat (map spread binds)\n          spread (id, offset) | isFollowableArg (bcIdArgRep id) = [ rel_offset ]\n                              | otherwise                      = []\n                where rel_offset = trunc16W $ bytesToWords dflags (d - offset)\n\n     alt_stuff <- mapM codeAlt alts\n     alt_final <- mkMultiBranch maybe_ncons alt_stuff\n\n     let\n         alt_bco_name = getName bndr\n         alt_bco = mkProtoBCO dflags alt_bco_name alt_final (Left alts)\n                       0{-no arity-} bitmap_size bitmap True{-is alts-}\n--     trace (\"case: bndr = \" ++ showSDocDebug (ppr bndr) ++ \"\\ndepth = \" ++ show d ++ \"\\nenv = \\n\" ++ showSDocDebug (ppBCEnv p) ++\n--            \"\\n      bitmap = \" ++ show bitmap) $ do\n\n     scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b)\n                           (d + ret_frame_size_b + save_ccs_size_b)\n                           p scrut\n     alt_bco' <- emitBc alt_bco\n     let push_alts\n            | isAlgCase = PUSH_ALTS alt_bco'\n            | otherwise = PUSH_ALTS_UNLIFTED alt_bco' (typeArgRep bndr_ty)\n     return (push_alts `consOL` scrut_code)\n\n\n-- -----------------------------------------------------------------------------\n-- Deal with a CCall.\n\n-- Taggedly push the args onto the stack R->L,\n-- deferencing ForeignObj#s and adjusting addrs to point to\n-- payloads in Ptr/Byte arrays.  Then, generate the marshalling\n-- (machine) code for the ccall, and create bytecodes to call that and\n-- then return in the right way.\n\ngenerateCCall\n    :: StackDepth\n    -> Sequel\n    -> BCEnv\n    -> CCallSpec               -- where to call\n    -> Id                      -- of target, for type info\n    -> [AnnExpr' Id DVarSet]   -- args (atoms)\n    -> BcM BCInstrList\ngenerateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l\n = do\n     dflags <- getDynFlags\n\n     let\n         -- useful constants\n         addr_size_b :: ByteOff\n         addr_size_b = wordSize dflags\n\n         -- Get the args on the stack, with tags and suitably\n         -- dereferenced for the CCall.  For each arg, return the\n         -- depth to the first word of the bits for that arg, and the\n         -- ArgRep of what was actually pushed.\n\n         pargs\n             :: ByteOff -> [AnnExpr' Id DVarSet] -> BcM [(BCInstrList, PrimRep)]\n         pargs _ [] = return []\n         pargs d (a:az)\n            = let arg_ty = unwrapType (exprType (deAnnotate' a))\n\n              in case tyConAppTyCon_maybe arg_ty of\n                    -- Don't push the FO; instead push the Addr# it\n                    -- contains.\n                    Just t\n                     | t == arrayPrimTyCon || t == mutableArrayPrimTyCon\n                       -> do rest <- pargs (d + addr_size_b) az\n                             code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize dflags)) d p a\n                             return ((code,AddrRep):rest)\n\n                     | t == smallArrayPrimTyCon || t == smallMutableArrayPrimTyCon\n                       -> do rest <- pargs (d + addr_size_b) az\n                             code <- parg_ArrayishRep (fromIntegral (smallArrPtrsHdrSize dflags)) d p a\n                             return ((code,AddrRep):rest)\n\n                     | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon\n                       -> do rest <- pargs (d + addr_size_b) az\n                             code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize dflags)) d p a\n                             return ((code,AddrRep):rest)\n\n                    -- Default case: push taggedly, but otherwise intact.\n                    _\n                       -> do (code_a, sz_a) <- pushAtom d p a\n                             rest <- pargs (d + sz_a) az\n                             return ((code_a, atomPrimRep a) : rest)\n\n         -- Do magic for Ptr/Byte arrays.  Push a ptr to the array on\n         -- the stack but then advance it over the headers, so as to\n         -- point to the payload.\n         parg_ArrayishRep\n             :: Word16\n             -> StackDepth\n             -> BCEnv\n             -> AnnExpr' Id DVarSet\n             -> BcM BCInstrList\n         parg_ArrayishRep hdrSize d p a\n            = do (push_fo, _) <- pushAtom d p a\n                 -- The ptr points at the header.  Advance it over the\n                 -- header and then pretend this is an Addr#.\n                 return (push_fo `snocOL` SWIZZLE 0 hdrSize)\n\n     code_n_reps <- pargs d0 args_r_to_l\n     let\n         (pushs_arg, a_reps_pushed_r_to_l) = unzip code_n_reps\n         a_reps_sizeW = sum (map (repSizeWords dflags) a_reps_pushed_r_to_l)\n\n         push_args    = concatOL pushs_arg\n         !d_after_args = d0 + wordsToBytes dflags a_reps_sizeW\n         a_reps_pushed_RAW\n            | null a_reps_pushed_r_to_l || head a_reps_pushed_r_to_l /= VoidRep\n            = panic \"ByteCodeGen.generateCCall: missing or invalid World token?\"\n            | otherwise\n            = reverse (tail a_reps_pushed_r_to_l)\n\n         -- Now: a_reps_pushed_RAW are the reps which are actually on the stack.\n         -- push_args is the code to do that.\n         -- d_after_args is the stack depth once the args are on.\n\n         -- Get the result rep.\n         (returns_void, r_rep)\n            = case maybe_getCCallReturnRep (idType fn) of\n                 Nothing -> (True,  VoidRep)\n                 Just rr -> (False, rr)\n         {-\n         Because the Haskell stack grows down, the a_reps refer to\n         lowest to highest addresses in that order.  The args for the call\n         are on the stack.  Now push an unboxed Addr# indicating\n         the C function to call.  Then push a dummy placeholder for the\n         result.  Finally, emit a CCALL insn with an offset pointing to the\n         Addr# just pushed, and a literal field holding the mallocville\n         address of the piece of marshalling code we generate.\n         So, just prior to the CCALL insn, the stack looks like this\n         (growing down, as usual):\n\n            <arg_n>\n            ...\n            <arg_1>\n            Addr# address_of_C_fn\n            <placeholder-for-result#> (must be an unboxed type)\n\n         The interpreter then calls the marshall code mentioned\n         in the CCALL insn, passing it (& <placeholder-for-result#>),\n         that is, the addr of the topmost word in the stack.\n         When this returns, the placeholder will have been\n         filled in.  The placeholder is slid down to the sequel\n         depth, and we RETURN.\n\n         This arrangement makes it simple to do f-i-dynamic since the Addr#\n         value is the first arg anyway.\n\n         The marshalling code is generated specifically for this\n         call site, and so knows exactly the (Haskell) stack\n         offsets of the args, fn address and placeholder.  It\n         copies the args to the C stack, calls the stacked addr,\n         and parks the result back in the placeholder.  The interpreter\n         calls it as a normal C call, assuming it has a signature\n            void marshall_code ( StgWord* ptr_to_top_of_stack )\n         -}\n         -- resolve static address\n         maybe_static_target :: Maybe Literal\n         maybe_static_target =\n             case target of\n                 DynamicTarget -> Nothing\n                 StaticTarget _ _ _ False ->\n                   panic \"generateCCall: unexpected FFI value import\"\n                 StaticTarget _ target _ True ->\n                   Just (LitLabel target mb_size IsFunction)\n                   where\n                      mb_size\n                          | OSMinGW32 <- platformOS (targetPlatform dflags)\n                          , StdCallConv <- cconv\n                          = Just (fromIntegral a_reps_sizeW * wORD_SIZE dflags)\n                          | otherwise\n                          = Nothing\n\n     let\n         is_static = isJust maybe_static_target\n\n         -- Get the arg reps, zapping the leading Addr# in the dynamic case\n         a_reps --  | trace (showSDoc (ppr a_reps_pushed_RAW)) False = error \"???\"\n                | is_static = a_reps_pushed_RAW\n                | otherwise = if null a_reps_pushed_RAW\n                              then panic \"ByteCodeGen.generateCCall: dyn with no args\"\n                              else tail a_reps_pushed_RAW\n\n         -- push the Addr#\n         (push_Addr, d_after_Addr)\n            | Just machlabel <- maybe_static_target\n            = (toOL [PUSH_UBX machlabel 1], d_after_args + addr_size_b)\n            | otherwise -- is already on the stack\n            = (nilOL, d_after_args)\n\n         -- Push the return placeholder.  For a call returning nothing,\n         -- this is a V (tag).\n         r_sizeW   = repSizeWords dflags r_rep\n         d_after_r = d_after_Addr + wordsToBytes dflags r_sizeW\n         push_r =\n             if returns_void\n                then nilOL\n                else unitOL (PUSH_UBX (mkDummyLiteral dflags r_rep) (trunc16W r_sizeW))\n\n         -- generate the marshalling code we're going to call\n\n         -- Offset of the next stack frame down the stack.  The CCALL\n         -- instruction needs to describe the chunk of stack containing\n         -- the ccall args to the GC, so it needs to know how large it\n         -- is.  See comment in Interpreter.c with the CCALL instruction.\n         stk_offset   = trunc16W $ bytesToWords dflags (d_after_r - s)\n\n         conv = case cconv of\n           CCallConv -> FFICCall\n           StdCallConv -> FFIStdCall\n           _ -> panic \"ByteCodeGen: unexpected calling convention\"\n\n     -- the only difference in libffi mode is that we prepare a cif\n     -- describing the call type by calling libffi, and we attach the\n     -- address of this to the CCALL instruction.\n\n\n     let ffires = primRepToFFIType dflags r_rep\n         ffiargs = map (primRepToFFIType dflags) a_reps\n     hsc_env <- getHscEnv\n     token <- ioToBc $ iservCmd hsc_env (PrepFFI conv ffiargs ffires)\n     recordFFIBc token\n\n     let\n         -- do the call\n         do_call      = unitOL (CCALL stk_offset token flags)\n           where flags = case safety of\n                           PlaySafe          -> 0x0\n                           PlayInterruptible -> 0x1\n                           PlayRisky         -> 0x2\n\n         -- slide and return\n         d_after_r_min_s = bytesToWords dflags (d_after_r - s)\n         wrapup       = mkSlideW (trunc16W r_sizeW) (d_after_r_min_s - r_sizeW)\n                        `snocOL` RETURN_UBX (toArgRep r_rep)\n         --trace (show (arg1_offW, args_offW  ,  (map argRepSizeW a_reps) )) $\n     return (\n         push_args `appOL`\n         push_Addr `appOL` push_r `appOL` do_call `appOL` wrapup\n         )\n\nprimRepToFFIType :: DynFlags -> PrimRep -> FFIType\nprimRepToFFIType dflags r\n  = case r of\n     VoidRep     -> FFIVoid\n     IntRep      -> signed_word\n     WordRep     -> unsigned_word\n     Int64Rep    -> FFISInt64\n     Word64Rep   -> FFIUInt64\n     AddrRep     -> FFIPointer\n     FloatRep    -> FFIFloat\n     DoubleRep   -> FFIDouble\n     _           -> panic \"primRepToFFIType\"\n  where\n    (signed_word, unsigned_word)\n       | wORD_SIZE dflags == 4  = (FFISInt32, FFIUInt32)\n       | wORD_SIZE dflags == 8  = (FFISInt64, FFIUInt64)\n       | otherwise              = panic \"primTyDescChar\"\n\n-- Make a dummy literal, to be used as a placeholder for FFI return\n-- values on the stack.\nmkDummyLiteral :: DynFlags -> PrimRep -> Literal\nmkDummyLiteral dflags pr\n   = case pr of\n        IntRep    -> mkLitInt dflags 0\n        WordRep   -> mkLitWord dflags 0\n        Int64Rep  -> mkLitInt64 0\n        Word64Rep -> mkLitWord64 0\n        AddrRep   -> LitNullAddr\n        DoubleRep -> LitDouble 0\n        FloatRep  -> LitFloat 0\n        _         -> pprPanic \"mkDummyLiteral\" (ppr pr)\n\n\n-- Convert (eg)\n--     GHC.Prim.Char# -> GHC.Prim.State# GHC.Prim.RealWorld\n--                   -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)\n--\n-- to  Just IntRep\n-- and check that an unboxed pair is returned wherein the first arg is V'd.\n--\n-- Alternatively, for call-targets returning nothing, convert\n--\n--     GHC.Prim.Char# -> GHC.Prim.State# GHC.Prim.RealWorld\n--                   -> (# GHC.Prim.State# GHC.Prim.RealWorld #)\n--\n-- to  Nothing\n\nmaybe_getCCallReturnRep :: Type -> Maybe PrimRep\nmaybe_getCCallReturnRep fn_ty\n   = let\n       (_a_tys, r_ty) = splitFunTys (dropForAlls fn_ty)\n       r_reps = typePrimRepArgs r_ty\n\n       blargh :: a -- Used at more than one type\n       blargh = pprPanic \"maybe_getCCallReturn: can't handle:\"\n                         (pprType fn_ty)\n     in\n       case r_reps of\n         []            -> panic \"empty typePrimRepArgs\"\n         [VoidRep]     -> Nothing\n         [rep]\n           | isGcPtrRep rep -> blargh\n           | otherwise      -> Just rep\n\n                 -- if it was, it would be impossible to create a\n                 -- valid return value placeholder on the stack\n         _             -> blargh\n\nmaybe_is_tagToEnum_call :: AnnExpr' Id DVarSet -> Maybe (AnnExpr' Id DVarSet, [Name])\n-- Detect and extract relevant info for the tagToEnum kludge.\nmaybe_is_tagToEnum_call app\n  | AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType t)) arg <- app\n  , Just TagToEnumOp <- isPrimOpId_maybe v\n  = Just (snd arg, extract_constr_Names t)\n  | otherwise\n  = Nothing\n  where\n    extract_constr_Names ty\n           | rep_ty <- unwrapType ty\n           , Just tyc <- tyConAppTyCon_maybe rep_ty\n           , isDataTyCon tyc\n           = map (getName . dataConWorkId) (tyConDataCons tyc)\n           -- NOTE: use the worker name, not the source name of\n           -- the DataCon.  See DataCon.hs for details.\n           | otherwise\n           = pprPanic \"maybe_is_tagToEnum_call.extract_constr_Ids\" (ppr ty)\n\n{- -----------------------------------------------------------------------------\nNote [Implementing tagToEnum#]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(implement_tagToId arg names) compiles code which takes an argument\n'arg', (call it i), and enters the i'th closure in the supplied list\nas a consequence.  The [Name] is a list of the constructors of this\n(enumeration) type.\n\nThe code we generate is this:\n                push arg\n                push bogus-word\n\n                TESTEQ_I 0 L1\n                  PUSH_G <lbl for first data con>\n                  JMP L_Exit\n\n        L1:     TESTEQ_I 1 L2\n                  PUSH_G <lbl for second data con>\n                  JMP L_Exit\n        ...etc...\n        Ln:     TESTEQ_I n L_fail\n                  PUSH_G <lbl for last data con>\n                  JMP L_Exit\n\n        L_fail: CASEFAIL\n\n        L_exit: SLIDE 1 n\n                ENTER\n\nThe 'bogus-word' push is because TESTEQ_I expects the top of the stack\nto have an info-table, and the next word to have the value to be\ntested.  This is very weird, but it's the way it is right now.  See\nInterpreter.c.  We don't acutally need an info-table here; we just\nneed to have the argument to be one-from-top on the stack, hence pushing\na 1-word null. See Trac #8383.\n-}\n\n\nimplement_tagToId\n    :: StackDepth\n    -> Sequel\n    -> BCEnv\n    -> AnnExpr' Id DVarSet\n    -> [Name]\n    -> BcM BCInstrList\n-- See Note [Implementing tagToEnum#]\nimplement_tagToId d s p arg names\n  = ASSERT( notNull names )\n    do (push_arg, arg_bytes) <- pushAtom d p arg\n       labels <- getLabelsBc (genericLength names)\n       label_fail <- getLabelBc\n       label_exit <- getLabelBc\n       dflags <- getDynFlags\n       let infos = zip4 labels (tail labels ++ [label_fail])\n                               [0 ..] names\n           steps = map (mkStep label_exit) infos\n           slide_ws = bytesToWords dflags (d - s + arg_bytes)\n\n       return (push_arg\n               `appOL` unitOL (PUSH_UBX LitNullAddr 1)\n                   -- Push bogus word (see Note [Implementing tagToEnum#])\n               `appOL` concatOL steps\n               `appOL` toOL [ LABEL label_fail, CASEFAIL,\n                              LABEL label_exit ]\n               `appOL` mkSlideW 1 (slide_ws + 1)\n                   -- \"+1\" to account for bogus word\n                   --      (see Note [Implementing tagToEnum#])\n               `appOL` unitOL ENTER)\n  where\n        mkStep l_exit (my_label, next_label, n, name_for_n)\n           = toOL [LABEL my_label,\n                   TESTEQ_I n next_label,\n                   PUSH_G name_for_n,\n                   JMP l_exit]\n\n\n-- -----------------------------------------------------------------------------\n-- pushAtom\n\n-- Push an atom onto the stack, returning suitable code & number of\n-- stack words used.\n--\n-- The env p must map each variable to the highest- numbered stack\n-- slot for it.  For example, if the stack has depth 4 and we\n-- tagged-ly push (v :: Int#) on it, the value will be in stack[4],\n-- the tag in stack[5], the stack will have depth 6, and p must map v\n-- to 5 and not to 4.  Stack locations are numbered from zero, so a\n-- depth 6 stack has valid words 0 .. 5.\n\npushAtom\n    :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM (BCInstrList, ByteOff)\npushAtom d p e\n   | Just e' <- bcView e\n   = pushAtom d p e'\n\npushAtom _ _ (AnnCoercion {})   -- Coercions are zero-width things,\n   = return (nilOL, 0)          -- treated just like a variable V\n\n-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs\n-- and Note [Bottoming expressions] in coreSyn/CoreUtils.hs:\n-- The scrutinee of an empty case evaluates to bottom\npushAtom d p (AnnCase (_, a) _ _ []) -- trac #12128\n   = pushAtom d p a\n\npushAtom d p (AnnVar var)\n   | [] <- typePrimRep (idType var)\n   = return (nilOL, 0)\n\n   | isFCallId var\n   = pprPanic \"pushAtom: shouldn't get an FCallId here\" (ppr var)\n\n   | Just primop <- isPrimOpId_maybe var\n   = do\n       dflags <-getDynFlags\n       return (unitOL (PUSH_PRIMOP primop), wordSize dflags)\n\n   | Just d_v <- lookupBCEnv_maybe var p  -- var is a local variable\n   = do dflags <- getDynFlags\n\n        let !szb = idSizeCon dflags var\n            with_instr instr = do\n                let !off_b = trunc16B $ d - d_v\n                return (unitOL (instr off_b), wordSize dflags)\n\n        case szb of\n            1 -> with_instr PUSH8_W\n            2 -> with_instr PUSH16_W\n            4 -> with_instr PUSH32_W\n            _ -> do\n                let !szw = bytesToWords dflags szb\n                    !off_w = trunc16W $ bytesToWords dflags (d - d_v) + szw - 1\n                return (toOL (genericReplicate szw (PUSH_L off_w)), szb)\n        -- d - d_v           offset from TOS to the first slot of the object\n        --\n        -- d - d_v + sz - 1  offset from the TOS of the last slot of the object\n        --\n        -- Having found the last slot, we proceed to copy the right number of\n        -- slots on to the top of the stack.\n\n   | otherwise  -- var must be a global variable\n   = do topStrings <- getTopStrings\n        dflags <- getDynFlags\n        case lookupVarEnv topStrings var of\n            Just ptr -> pushAtom d p $ AnnLit $ mkLitWord dflags $\n              fromIntegral $ ptrToWordPtr $ fromRemotePtr ptr\n            Nothing -> do\n                let sz = idSizeCon dflags var\n                MASSERT( sz == wordSize dflags )\n                return (unitOL (PUSH_G (getName var)), sz)\n\n\npushAtom _ _ (AnnLit lit) = do\n     dflags <- getDynFlags\n     let code rep\n             = let size_words = WordOff (argRepSizeW dflags rep)\n               in  return (unitOL (PUSH_UBX lit (trunc16W size_words)),\n                           wordsToBytes dflags size_words)\n\n     case lit of\n        LitLabel _ _ _   -> code N\n        LitFloat _       -> code F\n        LitDouble _      -> code D\n        LitChar _        -> code N\n        LitNullAddr      -> code N\n        LitString _      -> code N\n        LitRubbish       -> code N\n        LitNumber nt _ _ -> case nt of\n          LitNumInt     -> code N\n          LitNumWord    -> code N\n          LitNumInt64   -> code L\n          LitNumWord64  -> code L\n          -- No LitInteger's or LitNatural's should be left by the time this is\n          -- called. CorePrep should have converted them all to a real core\n          -- representation.\n          LitNumInteger -> panic \"pushAtom: LitInteger\"\n          LitNumNatural -> panic \"pushAtom: LitNatural\"\n\npushAtom _ _ expr\n   = pprPanic \"ByteCodeGen.pushAtom\"\n              (pprCoreExpr (deAnnotate' expr))\n\n\n-- | Push an atom for constructor (i.e., PACK instruction) onto the stack.\n-- This is slightly different to @pushAtom@ due to the fact that we allow\n-- packing constructor fields. See also @mkConAppCode@ and @pushPadding@.\npushConstrAtom\n    :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM (BCInstrList, ByteOff)\n\npushConstrAtom _ _ (AnnLit lit@(LitFloat _)) =\n    return (unitOL (PUSH_UBX32 lit), 4)\n\npushConstrAtom d p (AnnVar v)\n    | Just d_v <- lookupBCEnv_maybe v p = do  -- v is a local variable\n        dflags <- getDynFlags\n        let !szb = idSizeCon dflags v\n            done instr = do\n                let !off = trunc16B $ d - d_v\n                return (unitOL (instr off), szb)\n        case szb of\n            1 -> done PUSH8\n            2 -> done PUSH16\n            4 -> done PUSH32\n            _ -> pushAtom d p (AnnVar v)\n\npushConstrAtom d p expr = pushAtom d p expr\n\npushPadding :: Int -> (BCInstrList, ByteOff)\npushPadding !n = go n (nilOL, 0)\n  where\n    go n acc@(!instrs, !off) = case n of\n        0 -> acc\n        1 -> (instrs `mappend` unitOL PUSH_PAD8, off + 1)\n        2 -> (instrs `mappend` unitOL PUSH_PAD16, off + 2)\n        3 -> go 1 (go 2 acc)\n        4 -> (instrs `mappend` unitOL PUSH_PAD32, off + 4)\n        _ -> go (n - 4) (go 4 acc)\n\n-- -----------------------------------------------------------------------------\n-- Given a bunch of alts code and their discrs, do the donkey work\n-- of making a multiway branch using a switch tree.\n-- What a load of hassle!\n\nmkMultiBranch :: Maybe Int      -- # datacons in tycon, if alg alt\n                                -- a hint; generates better code\n                                -- Nothing is always safe\n              -> [(Discr, BCInstrList)]\n              -> BcM BCInstrList\nmkMultiBranch maybe_ncons raw_ways = do\n     lbl_default <- getLabelBc\n\n     let\n         mkTree :: [(Discr, BCInstrList)] -> Discr -> Discr -> BcM BCInstrList\n         mkTree [] _range_lo _range_hi = return (unitOL (JMP lbl_default))\n             -- shouldn't happen?\n\n         mkTree [val] range_lo range_hi\n            | range_lo == range_hi\n            = return (snd val)\n            | null defaults -- Note [CASEFAIL]\n            = do lbl <- getLabelBc\n                 return (testEQ (fst val) lbl\n                            `consOL` (snd val\n                            `appOL`  (LABEL lbl `consOL` unitOL CASEFAIL)))\n            | otherwise\n            = return (testEQ (fst val) lbl_default `consOL` snd val)\n\n            -- Note [CASEFAIL] It may be that this case has no default\n            -- branch, but the alternatives are not exhaustive - this\n            -- happens for GADT cases for example, where the types\n            -- prove that certain branches are impossible.  We could\n            -- just assume that the other cases won't occur, but if\n            -- this assumption was wrong (because of a bug in GHC)\n            -- then the result would be a segfault.  So instead we\n            -- emit an explicit test and a CASEFAIL instruction that\n            -- causes the interpreter to barf() if it is ever\n            -- executed.\n\n         mkTree vals range_lo range_hi\n            = let n = length vals `div` 2\n                  vals_lo = take n vals\n                  vals_hi = drop n vals\n                  v_mid = fst (head vals_hi)\n              in do\n              label_geq <- getLabelBc\n              code_lo <- mkTree vals_lo range_lo (dec v_mid)\n              code_hi <- mkTree vals_hi v_mid range_hi\n              return (testLT v_mid label_geq\n                      `consOL` (code_lo\n                      `appOL`   unitOL (LABEL label_geq)\n                      `appOL`   code_hi))\n\n         the_default\n            = case defaults of\n                []         -> nilOL\n                [(_, def)] -> LABEL lbl_default `consOL` def\n                _          -> panic \"mkMultiBranch/the_default\"\n     instrs <- mkTree notd_ways init_lo init_hi\n     return (instrs `appOL` the_default)\n  where\n         (defaults, not_defaults) = partition (isNoDiscr.fst) raw_ways\n         notd_ways = sortBy (comparing fst) not_defaults\n\n         testLT (DiscrI i) fail_label = TESTLT_I i fail_label\n         testLT (DiscrW i) fail_label = TESTLT_W i fail_label\n         testLT (DiscrF i) fail_label = TESTLT_F i fail_label\n         testLT (DiscrD i) fail_label = TESTLT_D i fail_label\n         testLT (DiscrP i) fail_label = TESTLT_P i fail_label\n         testLT NoDiscr    _          = panic \"mkMultiBranch NoDiscr\"\n\n         testEQ (DiscrI i) fail_label = TESTEQ_I i fail_label\n         testEQ (DiscrW i) fail_label = TESTEQ_W i fail_label\n         testEQ (DiscrF i) fail_label = TESTEQ_F i fail_label\n         testEQ (DiscrD i) fail_label = TESTEQ_D i fail_label\n         testEQ (DiscrP i) fail_label = TESTEQ_P i fail_label\n         testEQ NoDiscr    _          = panic \"mkMultiBranch NoDiscr\"\n\n         -- None of these will be needed if there are no non-default alts\n         (init_lo, init_hi)\n            | null notd_ways\n            = panic \"mkMultiBranch: awesome foursome\"\n            | otherwise\n            = case fst (head notd_ways) of\n                DiscrI _ -> ( DiscrI minBound,  DiscrI maxBound )\n                DiscrW _ -> ( DiscrW minBound,  DiscrW maxBound )\n                DiscrF _ -> ( DiscrF minF,      DiscrF maxF )\n                DiscrD _ -> ( DiscrD minD,      DiscrD maxD )\n                DiscrP _ -> ( DiscrP algMinBound, DiscrP algMaxBound )\n                NoDiscr -> panic \"mkMultiBranch NoDiscr\"\n\n         (algMinBound, algMaxBound)\n            = case maybe_ncons of\n                 -- XXX What happens when n == 0?\n                 Just n  -> (0, fromIntegral n - 1)\n                 Nothing -> (minBound, maxBound)\n\n         isNoDiscr NoDiscr = True\n         isNoDiscr _       = False\n\n         dec (DiscrI i) = DiscrI (i-1)\n         dec (DiscrW w) = DiscrW (w-1)\n         dec (DiscrP i) = DiscrP (i-1)\n         dec other      = other         -- not really right, but if you\n                -- do cases on floating values, you'll get what you deserve\n\n         -- same snotty comment applies to the following\n         minF, maxF :: Float\n         minD, maxD :: Double\n         minF = -1.0e37\n         maxF =  1.0e37\n         minD = -1.0e308\n         maxD =  1.0e308\n\n\n-- -----------------------------------------------------------------------------\n-- Supporting junk for the compilation schemes\n\n-- Describes case alts\ndata Discr\n   = DiscrI Int\n   | DiscrW Word\n   | DiscrF Float\n   | DiscrD Double\n   | DiscrP Word16\n   | NoDiscr\n    deriving (Eq, Ord)\n\ninstance Outputable Discr where\n   ppr (DiscrI i) = int i\n   ppr (DiscrW w) = text (show w)\n   ppr (DiscrF f) = text (show f)\n   ppr (DiscrD d) = text (show d)\n   ppr (DiscrP i) = ppr i\n   ppr NoDiscr    = text \"DEF\"\n\n\nlookupBCEnv_maybe :: Id -> BCEnv -> Maybe ByteOff\nlookupBCEnv_maybe = Map.lookup\n\nidSizeW :: DynFlags -> Id -> WordOff\nidSizeW dflags = WordOff . argRepSizeW dflags . bcIdArgRep\n\nidSizeCon :: DynFlags -> Id -> ByteOff\nidSizeCon dflags = ByteOff . primRepSizeB dflags . bcIdPrimRep\n\nbcIdArgRep :: Id -> ArgRep\nbcIdArgRep = toArgRep . bcIdPrimRep\n\nbcIdPrimRep :: Id -> PrimRep\nbcIdPrimRep id\n  | [rep] <- typePrimRepArgs (idType id)\n  = rep\n  | otherwise\n  = pprPanic \"bcIdPrimRep\" (ppr id <+> dcolon <+> ppr (idType id))\n\nrepSizeWords :: DynFlags -> PrimRep -> WordOff\nrepSizeWords dflags rep = WordOff $ argRepSizeW dflags (toArgRep rep)\n\nisFollowableArg :: ArgRep -> Bool\nisFollowableArg P = True\nisFollowableArg _ = False\n\nisVoidArg :: ArgRep -> Bool\nisVoidArg V = True\nisVoidArg _ = False\n\n-- See bug #1257\nmultiValException :: a\nmultiValException = throwGhcException (ProgramError\n  (\"Error: bytecode compiler can't handle unboxed tuples and sums.\\n\"++\n   \"  Possibly due to foreign import/export decls in source.\\n\"++\n   \"  Workaround: use -fobject-code, or compile this module to .o separately.\"))\n\n-- | Indicate if the calling convention is supported\nisSupportedCConv :: CCallSpec -> Bool\nisSupportedCConv (CCallSpec _ cconv _) = case cconv of\n   CCallConv            -> True     -- we explicitly pattern match on every\n   StdCallConv          -> True     -- convention to ensure that a warning\n   PrimCallConv         -> False    -- is triggered when a new one is added\n   JavaScriptCallConv   -> False\n   CApiConv             -> False\n\n-- See bug #10462\nunsupportedCConvException :: a\nunsupportedCConvException = throwGhcException (ProgramError\n  (\"Error: bytecode compiler can't handle some foreign calling conventions\\n\"++\n   \"  Workaround: use -fobject-code, or compile this module to .o separately.\"))\n\nmkSlideB :: DynFlags -> ByteOff -> ByteOff -> OrdList BCInstr\nmkSlideB dflags !nb !db = mkSlideW n d\n  where\n    !n = trunc16W $ bytesToWords dflags nb\n    !d = bytesToWords dflags db\n\nmkSlideW :: Word16 -> WordOff -> OrdList BCInstr\nmkSlideW !n !ws\n    | ws > fromIntegral limit\n    -- If the amount to slide doesn't fit in a Word16, generate multiple slide\n    -- instructions\n    = SLIDE n limit `consOL` mkSlideW n (ws - fromIntegral limit)\n    | ws == 0\n    = nilOL\n    | otherwise\n    = unitOL (SLIDE n $ fromIntegral ws)\n  where\n    limit :: Word16\n    limit = maxBound\n\nsplitApp :: AnnExpr' Var ann -> (AnnExpr' Var ann, [AnnExpr' Var ann])\n        -- The arguments are returned in *right-to-left* order\nsplitApp e | Just e' <- bcView e = splitApp e'\nsplitApp (AnnApp (_,f) (_,a))    = case splitApp f of\n                                      (f', as) -> (f', a:as)\nsplitApp e                       = (e, [])\n\n\nbcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann)\n-- The \"bytecode view\" of a term discards\n--  a) type abstractions\n--  b) type applications\n--  c) casts\n--  d) ticks (but not breakpoints)\n-- Type lambdas *can* occur in random expressions,\n-- whereas value lambdas cannot; that is why they are nuked here\nbcView (AnnCast (_,e) _)             = Just e\nbcView (AnnLam v (_,e)) | isTyVar v  = Just e\nbcView (AnnApp (_,e) (_, AnnType _)) = Just e\nbcView (AnnTick Breakpoint{} _)      = Nothing\nbcView (AnnTick _other_tick (_,e))   = Just e\nbcView _                             = Nothing\n\nisVAtom :: AnnExpr' Var ann -> Bool\nisVAtom e | Just e' <- bcView e = isVAtom e'\nisVAtom (AnnVar v)              = isVoidArg (bcIdArgRep v)\nisVAtom (AnnCoercion {})        = True\nisVAtom _                     = False\n\natomPrimRep :: AnnExpr' Id ann -> PrimRep\natomPrimRep e | Just e' <- bcView e = atomPrimRep e'\natomPrimRep (AnnVar v)              = bcIdPrimRep v\natomPrimRep (AnnLit l)              = typePrimRep1 (literalType l)\n\n-- Trac #12128:\n-- A case expression can be an atom because empty cases evaluate to bottom.\n-- See Note [Empty case alternatives] in coreSyn/CoreSyn.hs\natomPrimRep (AnnCase _ _ ty _)      = ASSERT(typePrimRep ty == [LiftedRep]) LiftedRep\natomPrimRep (AnnCoercion {})        = VoidRep\natomPrimRep other = pprPanic \"atomPrimRep\" (ppr (deAnnotate' other))\n\natomRep :: AnnExpr' Id ann -> ArgRep\natomRep e = toArgRep (atomPrimRep e)\n\n-- | Let szsw be the sizes in bytes of some items pushed onto the stack, which\n-- has initial depth @original_depth@.  Return the values which the stack\n-- environment should map these items to.\nmkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff]\nmkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb)\n\ntypeArgRep :: Type -> ArgRep\ntypeArgRep = toArgRep . typePrimRep1\n\n-- -----------------------------------------------------------------------------\n-- The bytecode generator's monad\n\ndata BcM_State\n   = BcM_State\n        { bcm_hsc_env :: HscEnv\n        , uniqSupply  :: UniqSupply      -- for generating fresh variable names\n        , thisModule  :: Module          -- current module (for breakpoints)\n        , nextlabel   :: Word16          -- for generating local labels\n        , ffis        :: [FFIInfo]       -- ffi info blocks, to free later\n                                         -- Should be free()d when it is GCd\n        , modBreaks   :: Maybe ModBreaks -- info about breakpoints\n        , breakInfo   :: IntMap CgBreakInfo\n        , topStrings  :: IdEnv (RemotePtr ()) -- top-level string literals\n          -- See Note [generating code for top-level string literal bindings].\n        }\n\nnewtype BcM r = BcM (BcM_State -> IO (BcM_State, r))\n\nioToBc :: IO a -> BcM a\nioToBc io = BcM $ \\st -> do\n  x <- io\n  return (st, x)\n\nrunBc :: HscEnv -> UniqSupply -> Module -> Maybe ModBreaks\n      -> IdEnv (RemotePtr ())\n      -> BcM r\n      -> IO (BcM_State, r)\nrunBc hsc_env us this_mod modBreaks topStrings (BcM m)\n   = m (BcM_State hsc_env us this_mod 0 [] modBreaks IntMap.empty topStrings)\n\nthenBc :: BcM a -> (a -> BcM b) -> BcM b\nthenBc (BcM expr) cont = BcM $ \\st0 -> do\n  (st1, q) <- expr st0\n  let BcM k = cont q\n  (st2, r) <- k st1\n  return (st2, r)\n\nthenBc_ :: BcM a -> BcM b -> BcM b\nthenBc_ (BcM expr) (BcM cont) = BcM $ \\st0 -> do\n  (st1, _) <- expr st0\n  (st2, r) <- cont st1\n  return (st2, r)\n\nreturnBc :: a -> BcM a\nreturnBc result = BcM $ \\st -> (return (st, result))\n\ninstance Functor BcM where\n    fmap = liftM\n\ninstance Applicative BcM where\n    pure = returnBc\n    (<*>) = ap\n    (*>) = thenBc_\n\ninstance Monad BcM where\n  (>>=) = thenBc\n  (>>)  = (*>)\n\ninstance HasDynFlags BcM where\n    getDynFlags = BcM $ \\st -> return (st, hsc_dflags (bcm_hsc_env st))\n\ngetHscEnv :: BcM HscEnv\ngetHscEnv = BcM $ \\st -> return (st, bcm_hsc_env st)\n\nemitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name)\nemitBc bco\n  = BcM $ \\st -> return (st{ffis=[]}, bco (ffis st))\n\nrecordFFIBc :: RemotePtr C_ffi_cif -> BcM ()\nrecordFFIBc a\n  = BcM $ \\st -> return (st{ffis = FFIInfo a : ffis st}, ())\n\ngetLabelBc :: BcM Word16\ngetLabelBc\n  = BcM $ \\st -> do let nl = nextlabel st\n                    when (nl == maxBound) $\n                        panic \"getLabelBc: Ran out of labels\"\n                    return (st{nextlabel = nl + 1}, nl)\n\ngetLabelsBc :: Word16 -> BcM [Word16]\ngetLabelsBc n\n  = BcM $ \\st -> let ctr = nextlabel st\n                 in return (st{nextlabel = ctr+n}, [ctr .. ctr+n-1])\n\ngetCCArray :: BcM (Array BreakIndex (RemotePtr CostCentre))\ngetCCArray = BcM $ \\st ->\n  let breaks = expectJust \"ByteCodeGen.getCCArray\" $ modBreaks st in\n  return (st, modBreaks_ccs breaks)\n\n\nnewBreakInfo :: BreakIndex -> CgBreakInfo -> BcM ()\nnewBreakInfo ix info = BcM $ \\st ->\n  return (st{breakInfo = IntMap.insert ix info (breakInfo st)}, ())\n\nnewUnique :: BcM Unique\nnewUnique = BcM $\n   \\st -> case takeUniqFromSupply (uniqSupply st) of\n             (uniq, us) -> let newState = st { uniqSupply = us }\n                           in  return (newState, uniq)\n\ngetCurrentModule :: BcM Module\ngetCurrentModule = BcM $ \\st -> return (st, thisModule st)\n\ngetTopStrings :: BcM (IdEnv (RemotePtr ()))\ngetTopStrings = BcM $ \\st -> return (st, topStrings st)\n\nnewId :: Type -> BcM Id\nnewId ty = do\n    uniq <- newUnique\n    return $ mkSysLocal tickFS uniq ty\n\ntickFS :: FastString\ntickFS = fsLit \"ticked\"\n", "num_lines": 1961}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- | ByteCodeInstrs: Bytecode instruction definitions\nmodule ByteCodeInstr (\n        BCInstr(..), ProtoBCO(..), bciStackUse,\n  ) where\n\n#include \"HsVersions.h\"\n#include \"../includes/MachDeps.h\"\n\nimport GhcPrelude\n\nimport ByteCodeTypes\nimport GHCi.RemoteTypes\nimport GHCi.FFI (C_ffi_cif)\nimport StgCmmLayout     ( ArgRep(..) )\nimport PprCore\nimport Outputable\nimport FastString\nimport Name\nimport Unique\nimport Id\nimport CoreSyn\nimport Literal\nimport DataCon\nimport VarSet\nimport PrimOp\nimport SMRep\n\nimport Data.Word\nimport GHC.Stack.CCS (CostCentre)\n\n-- ----------------------------------------------------------------------------\n-- Bytecode instructions\n\ndata ProtoBCO a\n   = ProtoBCO {\n        protoBCOName       :: a,          -- name, in some sense\n        protoBCOInstrs     :: [BCInstr],  -- instrs\n        -- arity and GC info\n        protoBCOBitmap     :: [StgWord],\n        protoBCOBitmapSize :: Word16,\n        protoBCOArity      :: Int,\n        -- what the BCO came from\n        protoBCOExpr       :: Either  [AnnAlt Id DVarSet] (AnnExpr Id DVarSet),\n        -- malloc'd pointers\n        protoBCOFFIs       :: [FFIInfo]\n   }\n\ntype LocalLabel = Word16\n\ndata BCInstr\n   -- Messing with the stack\n   = STKCHECK  Word\n\n   -- Push locals (existing bits of the stack)\n   | PUSH_L    !Word16{-offset-}\n   | PUSH_LL   !Word16 !Word16{-2 offsets-}\n   | PUSH_LLL  !Word16 !Word16 !Word16{-3 offsets-}\n\n   -- Push the specified local as a 8, 16, 32 bit value onto the stack. (i.e.,\n   -- the stack will grow by 8, 16 or 32 bits)\n   | PUSH8  !Word16\n   | PUSH16 !Word16\n   | PUSH32 !Word16\n\n   -- Push the specifiec local as a 8, 16, 32 bit value onto the stack, but the\n   -- value will take the whole word on the stack (i.e., the stack will gorw by\n   -- a word)\n   -- This is useful when extracting a packed constructor field for further use.\n   -- Currently we expect all values on the stack to take full words, except for\n   -- the ones used for PACK (i.e., actually constracting new data types, in\n   -- which case we use PUSH{8,16,32})\n   | PUSH8_W  !Word16\n   | PUSH16_W !Word16\n   | PUSH32_W !Word16\n\n   -- Push a ptr  (these all map to PUSH_G really)\n   | PUSH_G       Name\n   | PUSH_PRIMOP  PrimOp\n   | PUSH_BCO     (ProtoBCO Name)\n\n   -- Push an alt continuation\n   | PUSH_ALTS          (ProtoBCO Name)\n   | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep\n\n   -- Pushing 8, 16 and 32 bits of padding (for constructors).\n   | PUSH_PAD8\n   | PUSH_PAD16\n   | PUSH_PAD32\n\n   -- Pushing literals\n   | PUSH_UBX8  Literal\n   | PUSH_UBX16 Literal\n   | PUSH_UBX32 Literal\n   | PUSH_UBX   Literal Word16\n        -- push this int/float/double/addr, on the stack. Word16\n        -- is # of words to copy from literal pool.  Eitherness reflects\n        -- the difficulty of dealing with MachAddr here, mostly due to\n        -- the excessive (and unnecessary) restrictions imposed by the\n        -- designers of the new Foreign library.  In particular it is\n        -- quite impossible to convert an Addr to any other integral\n        -- type, and it appears impossible to get hold of the bits of\n        -- an addr, even though we need to assemble BCOs.\n\n   -- various kinds of application\n   | PUSH_APPLY_N\n   | PUSH_APPLY_V\n   | PUSH_APPLY_F\n   | PUSH_APPLY_D\n   | PUSH_APPLY_L\n   | PUSH_APPLY_P\n   | PUSH_APPLY_PP\n   | PUSH_APPLY_PPP\n   | PUSH_APPLY_PPPP\n   | PUSH_APPLY_PPPPP\n   | PUSH_APPLY_PPPPPP\n\n   | SLIDE     Word16{-this many-} Word16{-down by this much-}\n\n   -- To do with the heap\n   | ALLOC_AP  !Word16 -- make an AP with this many payload words\n   | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words\n   | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words\n   | MKAP      !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-}\n   | MKPAP     !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-}\n   | UNPACK    !Word16 -- unpack N words from t.o.s Constr\n   | PACK      DataCon !Word16\n                        -- after assembly, the DataCon is an index into the\n                        -- itbl array\n   -- For doing case trees\n   | LABEL     LocalLabel\n   | TESTLT_I  Int    LocalLabel\n   | TESTEQ_I  Int    LocalLabel\n   | TESTLT_W  Word   LocalLabel\n   | TESTEQ_W  Word   LocalLabel\n   | TESTLT_F  Float  LocalLabel\n   | TESTEQ_F  Float  LocalLabel\n   | TESTLT_D  Double LocalLabel\n   | TESTEQ_D  Double LocalLabel\n\n   -- The Word16 value is a constructor number and therefore\n   -- stored in the insn stream rather than as an offset into\n   -- the literal pool.\n   | TESTLT_P  Word16 LocalLabel\n   | TESTEQ_P  Word16 LocalLabel\n\n   | CASEFAIL\n   | JMP              LocalLabel\n\n   -- For doing calls to C (via glue code generated by libffi)\n   | CCALL            Word16    -- stack frame size\n                      (RemotePtr C_ffi_cif) -- addr of the glue code\n                      Word16    -- flags.\n                                --\n                                -- 0x1: call is interruptible\n                                -- 0x2: call is unsafe\n                                --\n                                -- (XXX: inefficient, but I don't know\n                                -- what the alignment constraints are.)\n\n   -- For doing magic ByteArray passing to foreign calls\n   | SWIZZLE          Word16 -- to the ptr N words down the stack,\n                      Word16 -- add M (interpreted as a signed 16-bit entity)\n\n   -- To Infinity And Beyond\n   | ENTER\n   | RETURN             -- return a lifted value\n   | RETURN_UBX ArgRep -- return an unlifted value, here's its rep\n\n   -- Breakpoints\n   | BRK_FUN          Word16 Unique (RemotePtr CostCentre)\n\n-- -----------------------------------------------------------------------------\n-- Printing bytecode instructions\n\ninstance Outputable a => Outputable (ProtoBCO a) where\n   ppr (ProtoBCO name instrs bitmap bsize arity origin ffis)\n      = (text \"ProtoBCO\" <+> ppr name <> char '#' <> int arity\n                <+> text (show ffis) <> colon)\n        $$ nest 3 (case origin of\n                      Left alts -> vcat (zipWith (<+>) (char '{' : repeat (char ';'))\n                                                       (map (pprCoreAltShort.deAnnAlt) alts)) <+> char '}'\n                      Right rhs -> pprCoreExprShort (deAnnotate rhs))\n        $$ nest 3 (text \"bitmap: \" <+> text (show bsize) <+> ppr bitmap)\n        $$ nest 3 (vcat (map ppr instrs))\n\n-- Print enough of the Core expression to enable the reader to find\n-- the expression in the -ddump-prep output.  That is, we need to\n-- include at least a binder.\n\npprCoreExprShort :: CoreExpr -> SDoc\npprCoreExprShort expr@(Lam _ _)\n  = let\n        (bndrs, _) = collectBinders expr\n    in\n    char '\\\\' <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow <+> text \"...\"\n\npprCoreExprShort (Case _expr var _ty _alts)\n = text \"case of\" <+> ppr var\n\npprCoreExprShort (Let (NonRec x _) _) = text \"let\" <+> ppr x <+> ptext (sLit (\"= ... in ...\"))\npprCoreExprShort (Let (Rec bs) _) = text \"let {\" <+> ppr (fst (head bs)) <+> ptext (sLit (\"= ...; ... } in ...\"))\n\npprCoreExprShort (Tick t e) = ppr t <+> pprCoreExprShort e\npprCoreExprShort (Cast e _) = pprCoreExprShort e <+> text \"`cast` T\"\n\npprCoreExprShort e = pprCoreExpr e\n\npprCoreAltShort :: CoreAlt -> SDoc\npprCoreAltShort (con, args, expr) = ppr con <+> sep (map ppr args) <+> text \"->\" <+> pprCoreExprShort expr\n\ninstance Outputable BCInstr where\n   ppr (STKCHECK n)          = text \"STKCHECK\" <+> ppr n\n   ppr (PUSH_L offset)       = text \"PUSH_L  \" <+> ppr offset\n   ppr (PUSH_LL o1 o2)       = text \"PUSH_LL \" <+> ppr o1 <+> ppr o2\n   ppr (PUSH_LLL o1 o2 o3)   = text \"PUSH_LLL\" <+> ppr o1 <+> ppr o2 <+> ppr o3\n   ppr (PUSH8  offset)       = text \"PUSH8  \" <+> ppr offset\n   ppr (PUSH16 offset)       = text \"PUSH16  \" <+> ppr offset\n   ppr (PUSH32 offset)       = text \"PUSH32  \" <+> ppr offset\n   ppr (PUSH8_W  offset)     = text \"PUSH8_W  \" <+> ppr offset\n   ppr (PUSH16_W offset)     = text \"PUSH16_W  \" <+> ppr offset\n   ppr (PUSH32_W offset)     = text \"PUSH32_W  \" <+> ppr offset\n   ppr (PUSH_G nm)           = text \"PUSH_G  \" <+> ppr nm\n   ppr (PUSH_PRIMOP op)      = text \"PUSH_G  \" <+> text \"GHC.PrimopWrappers.\"\n                                               <> ppr op\n   ppr (PUSH_BCO bco)        = hang (text \"PUSH_BCO\") 2 (ppr bco)\n   ppr (PUSH_ALTS bco)       = hang (text \"PUSH_ALTS\") 2 (ppr bco)\n   ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text \"PUSH_ALTS_UNLIFTED\" <+> ppr pk) 2 (ppr bco)\n\n   ppr PUSH_PAD8             = text \"PUSH_PAD8\"\n   ppr PUSH_PAD16            = text \"PUSH_PAD16\"\n   ppr PUSH_PAD32            = text \"PUSH_PAD32\"\n\n   ppr (PUSH_UBX8  lit)      = text \"PUSH_UBX8\" <+> ppr lit\n   ppr (PUSH_UBX16 lit)      = text \"PUSH_UBX16\" <+> ppr lit\n   ppr (PUSH_UBX32 lit)      = text \"PUSH_UBX32\" <+> ppr lit\n   ppr (PUSH_UBX lit nw)     = text \"PUSH_UBX\" <+> parens (ppr nw) <+> ppr lit\n   ppr PUSH_APPLY_N          = text \"PUSH_APPLY_N\"\n   ppr PUSH_APPLY_V          = text \"PUSH_APPLY_V\"\n   ppr PUSH_APPLY_F          = text \"PUSH_APPLY_F\"\n   ppr PUSH_APPLY_D          = text \"PUSH_APPLY_D\"\n   ppr PUSH_APPLY_L          = text \"PUSH_APPLY_L\"\n   ppr PUSH_APPLY_P          = text \"PUSH_APPLY_P\"\n   ppr PUSH_APPLY_PP         = text \"PUSH_APPLY_PP\"\n   ppr PUSH_APPLY_PPP        = text \"PUSH_APPLY_PPP\"\n   ppr PUSH_APPLY_PPPP       = text \"PUSH_APPLY_PPPP\"\n   ppr PUSH_APPLY_PPPPP      = text \"PUSH_APPLY_PPPPP\"\n   ppr PUSH_APPLY_PPPPPP     = text \"PUSH_APPLY_PPPPPP\"\n\n   ppr (SLIDE n d)           = text \"SLIDE   \" <+> ppr n <+> ppr d\n   ppr (ALLOC_AP sz)         = text \"ALLOC_AP   \" <+> ppr sz\n   ppr (ALLOC_AP_NOUPD sz)   = text \"ALLOC_AP_NOUPD   \" <+> ppr sz\n   ppr (ALLOC_PAP arity sz)  = text \"ALLOC_PAP   \" <+> ppr arity <+> ppr sz\n   ppr (MKAP offset sz)      = text \"MKAP    \" <+> ppr sz <+> text \"words,\"\n                                               <+> ppr offset <+> text \"stkoff\"\n   ppr (MKPAP offset sz)     = text \"MKPAP   \" <+> ppr sz <+> text \"words,\"\n                                               <+> ppr offset <+> text \"stkoff\"\n   ppr (UNPACK sz)           = text \"UNPACK  \" <+> ppr sz\n   ppr (PACK dcon sz)        = text \"PACK    \" <+> ppr dcon <+> ppr sz\n   ppr (LABEL     lab)       = text \"__\"       <> ppr lab <> colon\n   ppr (TESTLT_I  i lab)     = text \"TESTLT_I\" <+> int i <+> text \"__\" <> ppr lab\n   ppr (TESTEQ_I  i lab)     = text \"TESTEQ_I\" <+> int i <+> text \"__\" <> ppr lab\n   ppr (TESTLT_W  i lab)     = text \"TESTLT_W\" <+> int (fromIntegral i) <+> text \"__\" <> ppr lab\n   ppr (TESTEQ_W  i lab)     = text \"TESTEQ_W\" <+> int (fromIntegral i) <+> text \"__\" <> ppr lab\n   ppr (TESTLT_F  f lab)     = text \"TESTLT_F\" <+> float f <+> text \"__\" <> ppr lab\n   ppr (TESTEQ_F  f lab)     = text \"TESTEQ_F\" <+> float f <+> text \"__\" <> ppr lab\n   ppr (TESTLT_D  d lab)     = text \"TESTLT_D\" <+> double d <+> text \"__\" <> ppr lab\n   ppr (TESTEQ_D  d lab)     = text \"TESTEQ_D\" <+> double d <+> text \"__\" <> ppr lab\n   ppr (TESTLT_P  i lab)     = text \"TESTLT_P\" <+> ppr i <+> text \"__\" <> ppr lab\n   ppr (TESTEQ_P  i lab)     = text \"TESTEQ_P\" <+> ppr i <+> text \"__\" <> ppr lab\n   ppr CASEFAIL              = text \"CASEFAIL\"\n   ppr (JMP lab)             = text \"JMP\"      <+> ppr lab\n   ppr (CCALL off marshall_addr flags) = text \"CCALL   \" <+> ppr off\n                                                <+> text \"marshall code at\"\n                                               <+> text (show marshall_addr)\n                                               <+> (case flags of\n                                                      0x1 -> text \"(interruptible)\"\n                                                      0x2 -> text \"(unsafe)\"\n                                                      _   -> empty)\n   ppr (SWIZZLE stkoff n)    = text \"SWIZZLE \" <+> text \"stkoff\" <+> ppr stkoff\n                                               <+> text \"by\" <+> ppr n\n   ppr ENTER                 = text \"ENTER\"\n   ppr RETURN                = text \"RETURN\"\n   ppr (RETURN_UBX pk)       = text \"RETURN_UBX  \" <+> ppr pk\n   ppr (BRK_FUN index uniq _cc) = text \"BRK_FUN\" <+> ppr index <+> ppr uniq <+> text \"<cc>\"\n\n-- -----------------------------------------------------------------------------\n-- The stack use, in words, of each bytecode insn.  These _must_ be\n-- correct, or overestimates of reality, to be safe.\n\n-- NOTE: we aggregate the stack use from case alternatives too, so that\n-- we can do a single stack check at the beginning of a function only.\n\n-- This could all be made more accurate by keeping track of a proper\n-- stack high water mark, but it doesn't seem worth the hassle.\n\nprotoBCOStackUse :: ProtoBCO a -> Word\nprotoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))\n\nbciStackUse :: BCInstr -> Word\nbciStackUse STKCHECK{}            = 0\nbciStackUse PUSH_L{}              = 1\nbciStackUse PUSH_LL{}             = 2\nbciStackUse PUSH_LLL{}            = 3\nbciStackUse PUSH8{}               = 1  -- overapproximation\nbciStackUse PUSH16{}              = 1  -- overapproximation\nbciStackUse PUSH32{}              = 1  -- overapproximation on 64bit arch\nbciStackUse PUSH8_W{}             = 1  -- takes exactly 1 word\nbciStackUse PUSH16_W{}            = 1  -- takes exactly 1 word\nbciStackUse PUSH32_W{}            = 1  -- takes exactly 1 word\nbciStackUse PUSH_G{}              = 1\nbciStackUse PUSH_PRIMOP{}         = 1\nbciStackUse PUSH_BCO{}            = 1\nbciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco\nbciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco\nbciStackUse (PUSH_PAD8)           = 1  -- overapproximation\nbciStackUse (PUSH_PAD16)          = 1  -- overapproximation\nbciStackUse (PUSH_PAD32)          = 1  -- overapproximation on 64bit arch\nbciStackUse (PUSH_UBX8 _)         = 1  -- overapproximation\nbciStackUse (PUSH_UBX16 _)        = 1  -- overapproximation\nbciStackUse (PUSH_UBX32 _)        = 1  -- overapproximation on 64bit arch\nbciStackUse (PUSH_UBX _ nw)       = fromIntegral nw\nbciStackUse PUSH_APPLY_N{}        = 1\nbciStackUse PUSH_APPLY_V{}        = 1\nbciStackUse PUSH_APPLY_F{}        = 1\nbciStackUse PUSH_APPLY_D{}        = 1\nbciStackUse PUSH_APPLY_L{}        = 1\nbciStackUse PUSH_APPLY_P{}        = 1\nbciStackUse PUSH_APPLY_PP{}       = 1\nbciStackUse PUSH_APPLY_PPP{}      = 1\nbciStackUse PUSH_APPLY_PPPP{}     = 1\nbciStackUse PUSH_APPLY_PPPPP{}    = 1\nbciStackUse PUSH_APPLY_PPPPPP{}   = 1\nbciStackUse ALLOC_AP{}            = 1\nbciStackUse ALLOC_AP_NOUPD{}      = 1\nbciStackUse ALLOC_PAP{}           = 1\nbciStackUse (UNPACK sz)           = fromIntegral sz\nbciStackUse LABEL{}               = 0\nbciStackUse TESTLT_I{}            = 0\nbciStackUse TESTEQ_I{}            = 0\nbciStackUse TESTLT_W{}            = 0\nbciStackUse TESTEQ_W{}            = 0\nbciStackUse TESTLT_F{}            = 0\nbciStackUse TESTEQ_F{}            = 0\nbciStackUse TESTLT_D{}            = 0\nbciStackUse TESTEQ_D{}            = 0\nbciStackUse TESTLT_P{}            = 0\nbciStackUse TESTEQ_P{}            = 0\nbciStackUse CASEFAIL{}            = 0\nbciStackUse JMP{}                 = 0\nbciStackUse ENTER{}               = 0\nbciStackUse RETURN{}              = 0\nbciStackUse RETURN_UBX{}          = 1\nbciStackUse CCALL{}               = 0\nbciStackUse SWIZZLE{}             = 0\nbciStackUse BRK_FUN{}             = 0\n\n-- These insns actually reduce stack use, but we need the high-tide level,\n-- so can't use this info.  Not that it matters much.\nbciStackUse SLIDE{}               = 0\nbciStackUse MKAP{}                = 0\nbciStackUse MKPAP{}               = 0\nbciStackUse PACK{}                = 1 -- worst case is PACK 0 words\n", "num_lines": 369}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- | ByteCodeItbls: Generate infotables for interpreter-made bytecodes\nmodule ByteCodeItbls ( mkITbls ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport ByteCodeTypes\nimport GHCi\nimport DynFlags\nimport HscTypes\nimport Name             ( Name, getName )\nimport NameEnv\nimport DataCon          ( DataCon, dataConRepArgTys, dataConIdentity )\nimport TyCon            ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )\nimport RepType\nimport StgCmmLayout     ( mkVirtConstrSizes )\nimport StgCmmClosure    ( tagForCon, NonVoid (..) )\nimport Util\nimport Panic\n\n{-\n  Manufacturing of info tables for DataCons\n-}\n\n-- Make info tables for the data decls in this module\nmkITbls :: HscEnv -> [TyCon] -> IO ItblEnv\nmkITbls hsc_env tcs =\n  foldr plusNameEnv emptyNameEnv <$>\n    mapM (mkITbl hsc_env) (filter isDataTyCon tcs)\n where\n  mkITbl :: HscEnv -> TyCon -> IO ItblEnv\n  mkITbl hsc_env tc\n    | dcs `lengthIs` n -- paranoia; this is an assertion.\n    = make_constr_itbls hsc_env dcs\n       where\n          dcs = tyConDataCons tc\n          n   = tyConFamilySize tc\n  mkITbl _ _ = panic \"mkITbl\"\n\nmkItblEnv :: [(Name,ItblPtr)] -> ItblEnv\nmkItblEnv pairs = mkNameEnv [(n, (n,p)) | (n,p) <- pairs]\n\n-- Assumes constructors are numbered from zero, not one\nmake_constr_itbls :: HscEnv -> [DataCon] -> IO ItblEnv\nmake_constr_itbls hsc_env cons =\n  mkItblEnv <$> mapM (uncurry mk_itbl) (zip cons [0..])\n where\n  dflags = hsc_dflags hsc_env\n\n  mk_itbl :: DataCon -> Int -> IO (Name,ItblPtr)\n  mk_itbl dcon conNo = do\n     let rep_args = [ NonVoid prim_rep\n                    | arg <- dataConRepArgTys dcon\n                    , prim_rep <- typePrimRep arg ]\n\n         (tot_wds, ptr_wds) =\n             mkVirtConstrSizes dflags rep_args\n\n         ptrs'  = ptr_wds\n         nptrs' = tot_wds - ptr_wds\n         nptrs_really\n            | ptrs' + nptrs' >= mIN_PAYLOAD_SIZE dflags = nptrs'\n            | otherwise = mIN_PAYLOAD_SIZE dflags - ptrs'\n\n         descr = dataConIdentity dcon\n\n     r <- iservCmd hsc_env (MkConInfoTable ptrs' nptrs_really\n                              conNo (tagForCon dflags dcon) descr)\n     return (getName dcon, ItblPtr r)\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- | ByteCodeLink: Bytecode assembler and linker\nmodule ByteCodeLink (\n        ClosureEnv, emptyClosureEnv, extendClosureEnv,\n        linkBCO, lookupStaticPtr,\n        lookupIE,\n        nameToCLabel, linkFail\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport GHCi.RemoteTypes\nimport GHCi.ResolvedBCO\nimport GHCi.BreakArray\nimport SizedSeq\n\nimport GHCi\nimport ByteCodeTypes\nimport HscTypes\nimport Name\nimport NameEnv\nimport PrimOp\nimport Module\nimport FastString\nimport Panic\nimport Outputable\nimport Util\n\n-- Standard libraries\nimport Data.Array.Unboxed\nimport Foreign.Ptr\nimport GHC.Exts\n\n{-\n  Linking interpretables into something we can run\n-}\n\ntype ClosureEnv = NameEnv (Name, ForeignHValue)\n\nemptyClosureEnv :: ClosureEnv\nemptyClosureEnv = emptyNameEnv\n\nextendClosureEnv :: ClosureEnv -> [(Name,ForeignHValue)] -> ClosureEnv\nextendClosureEnv cl_env pairs\n  = extendNameEnvList cl_env [ (n, (n,v)) | (n,v) <- pairs]\n\n{-\n  Linking interpretables into something we can run\n-}\n\nlinkBCO\n  :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray\n  -> UnlinkedBCO\n  -> IO ResolvedBCO\nlinkBCO hsc_env ie ce bco_ix breakarray\n           (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do\n  -- fromIntegral Word -> Word64 should be a no op if Word is Word64\n  -- otherwise it will result in a cast to longlong on 32bit systems.\n  lits <- mapM (fmap fromIntegral . lookupLiteral hsc_env ie) (ssElts lits0)\n  ptrs <- mapM (resolvePtr hsc_env ie ce bco_ix breakarray) (ssElts ptrs0)\n  return (ResolvedBCO isLittleEndian arity insns bitmap\n              (listArray (0, fromIntegral (sizeSS lits0)-1) lits)\n              (addListToSS emptySS ptrs))\n\nlookupLiteral :: HscEnv -> ItblEnv -> BCONPtr -> IO Word\nlookupLiteral _ _ (BCONPtrWord lit) = return lit\nlookupLiteral hsc_env _ (BCONPtrLbl  sym) = do\n  Ptr a# <- lookupStaticPtr hsc_env sym\n  return (W# (int2Word# (addr2Int# a#)))\nlookupLiteral hsc_env ie (BCONPtrItbl nm)  = do\n  Ptr a# <- lookupIE hsc_env ie nm\n  return (W# (int2Word# (addr2Int# a#)))\nlookupLiteral _ _ (BCONPtrStr _) =\n  -- should be eliminated during assembleBCOs\n  panic \"lookupLiteral: BCONPtrStr\"\n\nlookupStaticPtr :: HscEnv -> FastString -> IO (Ptr ())\nlookupStaticPtr hsc_env addr_of_label_string = do\n  m <- lookupSymbol hsc_env addr_of_label_string\n  case m of\n    Just ptr -> return ptr\n    Nothing  -> linkFail \"ByteCodeLink: can't find label\"\n                  (unpackFS addr_of_label_string)\n\nlookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr ())\nlookupIE hsc_env ie con_nm =\n  case lookupNameEnv ie con_nm of\n    Just (_, ItblPtr a) -> return (fromRemotePtr (castRemotePtr a))\n    Nothing -> do -- try looking up in the object files.\n       let sym_to_find1 = nameToCLabel con_nm \"con_info\"\n       m <- lookupSymbol hsc_env sym_to_find1\n       case m of\n          Just addr -> return addr\n          Nothing\n             -> do -- perhaps a nullary constructor?\n                   let sym_to_find2 = nameToCLabel con_nm \"static_info\"\n                   n <- lookupSymbol hsc_env sym_to_find2\n                   case n of\n                      Just addr -> return addr\n                      Nothing   -> linkFail \"ByteCodeLink.lookupIE\"\n                                      (unpackFS sym_to_find1 ++ \" or \" ++\n                                       unpackFS sym_to_find2)\n\nlookupPrimOp :: HscEnv -> PrimOp -> IO (RemotePtr ())\nlookupPrimOp hsc_env primop = do\n  let sym_to_find = primopToCLabel primop \"closure\"\n  m <- lookupSymbol hsc_env (mkFastString sym_to_find)\n  case m of\n    Just p -> return (toRemotePtr p)\n    Nothing -> linkFail \"ByteCodeLink.lookupCE(primop)\" sym_to_find\n\nresolvePtr\n  :: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray\n  -> BCOPtr\n  -> IO ResolvedBCOPtr\nresolvePtr hsc_env _ie ce bco_ix _ (BCOPtrName nm)\n  | Just ix <- lookupNameEnv bco_ix nm =\n    return (ResolvedBCORef ix) -- ref to another BCO in this group\n  | Just (_, rhv) <- lookupNameEnv ce nm =\n    return (ResolvedBCOPtr (unsafeForeignRefToRemoteRef rhv))\n  | otherwise =\n    ASSERT2(isExternalName nm, ppr nm)\n    do let sym_to_find = nameToCLabel nm \"closure\"\n       m <- lookupSymbol hsc_env sym_to_find\n       case m of\n         Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p))\n         Nothing -> linkFail \"ByteCodeLink.lookupCE\" (unpackFS sym_to_find)\nresolvePtr hsc_env _ _ _ _ (BCOPtrPrimOp op) =\n  ResolvedBCOStaticPtr <$> lookupPrimOp hsc_env op\nresolvePtr hsc_env ie ce bco_ix breakarray (BCOPtrBCO bco) =\n  ResolvedBCOPtrBCO <$> linkBCO hsc_env ie ce bco_ix breakarray bco\nresolvePtr _ _ _ _ breakarray BCOPtrBreakArray =\n  return (ResolvedBCOPtrBreakArray breakarray)\n\nlinkFail :: String -> String -> IO a\nlinkFail who what\n   = throwGhcExceptionIO (ProgramError $\n        unlines [ \"\",who\n                , \"During interactive linking, GHCi couldn't find the following symbol:\"\n                , ' ' : ' ' : what\n                , \"This may be due to you not asking GHCi to load extra object files,\"\n                , \"archives or DLLs needed by your current session.  Restart GHCi, specifying\"\n                , \"the missing library using the -L/path/to/object/dir and -lmissinglibname\"\n                , \"flags, or simply by naming the relevant files on the GHCi command line.\"\n                , \"Alternatively, this link failure might indicate a bug in GHCi.\"\n                , \"If you suspect the latter, please send a bug report to:\"\n                , \"  glasgow-haskell-bugs@haskell.org\"\n                ])\n\n\nnameToCLabel :: Name -> String -> FastString\nnameToCLabel n suffix = mkFastString label\n  where\n    encodeZ = zString . zEncodeFS\n    (Module pkgKey modName) = ASSERT( isExternalName n ) nameModule n\n    packagePart = encodeZ (unitIdFS pkgKey)\n    modulePart  = encodeZ (moduleNameFS modName)\n    occPart     = encodeZ (occNameFS (nameOccName n))\n\n    label = concat\n        [ if pkgKey == mainUnitId then \"\" else packagePart ++ \"_\"\n        , modulePart\n        , '_':occPart\n        , '_':suffix\n        ]\n\n\nprimopToCLabel :: PrimOp -> String -> String\nprimopToCLabel primop suffix = concat\n    [ \"ghczmprim_GHCziPrimopWrappers_\"\n    , zString (zEncodeFS (occNameFS (primOpOcc primop)))\n    , '_':suffix\n    ]\n", "num_lines": 186}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- | Bytecode assembler types\nmodule ByteCodeTypes\n  ( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..)\n  , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)\n  , ItblEnv, ItblPtr(..)\n  , CgBreakInfo(..)\n  , ModBreaks (..), BreakIndex, emptyModBreaks\n  , CCostCentre\n  ) where\n\nimport GhcPrelude\n\nimport FastString\nimport Id\nimport Name\nimport NameEnv\nimport Outputable\nimport PrimOp\nimport SizedSeq\nimport Type\nimport SrcLoc\nimport GHCi.BreakArray\nimport GHCi.RemoteTypes\nimport GHCi.FFI\nimport Control.DeepSeq\n\nimport Foreign\nimport Data.Array\nimport Data.Array.Base  ( UArray(..) )\nimport Data.ByteString (ByteString)\nimport Data.IntMap (IntMap)\nimport qualified Data.IntMap as IntMap\nimport GHC.Exts.Heap\nimport GHC.Stack.CCS\n\n-- -----------------------------------------------------------------------------\n-- Compiled Byte Code\n\ndata CompiledByteCode = CompiledByteCode\n  { bc_bcos   :: [UnlinkedBCO]  -- Bunch of interpretable bindings\n  , bc_itbls  :: ItblEnv        -- A mapping from DataCons to their itbls\n  , bc_ffis   :: [FFIInfo]      -- ffi blocks we allocated\n  , bc_strs   :: [RemotePtr ()] -- malloc'd strings\n  , bc_breaks :: Maybe ModBreaks -- breakpoint info (Nothing if we're not\n                                 -- creating breakpoints, for some reason)\n  }\n                -- ToDo: we're not tracking strings that we malloc'd\nnewtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)\n  deriving (Show, NFData)\n\ninstance Outputable CompiledByteCode where\n  ppr CompiledByteCode{..} = ppr bc_bcos\n\n-- Not a real NFData instance, because ModBreaks contains some things\n-- we can't rnf\nseqCompiledByteCode :: CompiledByteCode -> ()\nseqCompiledByteCode CompiledByteCode{..} =\n  rnf bc_bcos `seq`\n  rnf (nameEnvElts bc_itbls) `seq`\n  rnf bc_ffis `seq`\n  rnf bc_strs `seq`\n  rnf (fmap seqModBreaks bc_breaks)\n\ntype ItblEnv = NameEnv (Name, ItblPtr)\n        -- We need the Name in the range so we know which\n        -- elements to filter out when unloading a module\n\nnewtype ItblPtr = ItblPtr (RemotePtr StgInfoTable)\n  deriving (Show, NFData)\n\ndata UnlinkedBCO\n   = UnlinkedBCO {\n        unlinkedBCOName   :: !Name,\n        unlinkedBCOArity  :: {-# UNPACK #-} !Int,\n        unlinkedBCOInstrs :: !(UArray Int Word16),      -- insns\n        unlinkedBCOBitmap :: !(UArray Int Word64),      -- bitmap\n        unlinkedBCOLits   :: !(SizedSeq BCONPtr),       -- non-ptrs\n        unlinkedBCOPtrs   :: !(SizedSeq BCOPtr)         -- ptrs\n   }\n\ninstance NFData UnlinkedBCO where\n  rnf UnlinkedBCO{..} =\n    rnf unlinkedBCOLits `seq`\n    rnf unlinkedBCOPtrs\n\ndata BCOPtr\n  = BCOPtrName   !Name\n  | BCOPtrPrimOp !PrimOp\n  | BCOPtrBCO    !UnlinkedBCO\n  | BCOPtrBreakArray  -- a pointer to this module's BreakArray\n\ninstance NFData BCOPtr where\n  rnf (BCOPtrBCO bco) = rnf bco\n  rnf x = x `seq` ()\n\ndata BCONPtr\n  = BCONPtrWord  {-# UNPACK #-} !Word\n  | BCONPtrLbl   !FastString\n  | BCONPtrItbl  !Name\n  | BCONPtrStr   !ByteString\n\ninstance NFData BCONPtr where\n  rnf x = x `seq` ()\n\n-- | Information about a breakpoint that we know at code-generation time\ndata CgBreakInfo\n   = CgBreakInfo\n   { cgb_vars   :: [(Id,Word16)]\n   , cgb_resty  :: Type\n   }\n\n-- Not a real NFData instance because we can't rnf Id or Type\nseqCgBreakInfo :: CgBreakInfo -> ()\nseqCgBreakInfo CgBreakInfo{..} =\n  rnf (map snd cgb_vars) `seq`\n  seqType cgb_resty\n\ninstance Outputable UnlinkedBCO where\n   ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)\n      = sep [text \"BCO\", ppr nm, text \"with\",\n             ppr (sizeSS lits), text \"lits\",\n             ppr (sizeSS ptrs), text \"ptrs\" ]\n\ninstance Outputable CgBreakInfo where\n   ppr info = text \"CgBreakInfo\" <+>\n              parens (ppr (cgb_vars info) <+>\n                      ppr (cgb_resty info))\n\n-- -----------------------------------------------------------------------------\n-- Breakpoints\n\n-- | Breakpoint index\ntype BreakIndex = Int\n\n-- | C CostCentre type\ndata CCostCentre\n\n-- | All the information about the breakpoints for a module\ndata ModBreaks\n   = ModBreaks\n   { modBreaks_flags :: ForeignRef BreakArray\n        -- ^ The array of flags, one per breakpoint,\n        -- indicating which breakpoints are enabled.\n   , modBreaks_locs :: !(Array BreakIndex SrcSpan)\n        -- ^ An array giving the source span of each breakpoint.\n   , modBreaks_vars :: !(Array BreakIndex [OccName])\n        -- ^ An array giving the names of the free variables at each breakpoint.\n   , modBreaks_decls :: !(Array BreakIndex [String])\n        -- ^ An array giving the names of the declarations enclosing each breakpoint.\n   , modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))\n        -- ^ Array pointing to cost centre for each breakpoint\n   , modBreaks_breakInfo :: IntMap CgBreakInfo\n        -- ^ info about each breakpoint from the bytecode generator\n   }\n\nseqModBreaks :: ModBreaks -> ()\nseqModBreaks ModBreaks{..} =\n  rnf modBreaks_flags `seq`\n  rnf modBreaks_locs `seq`\n  rnf modBreaks_vars `seq`\n  rnf modBreaks_decls `seq`\n  rnf modBreaks_ccs `seq`\n  rnf (fmap seqCgBreakInfo modBreaks_breakInfo)\n\n-- | Construct an empty ModBreaks\nemptyModBreaks :: ModBreaks\nemptyModBreaks = ModBreaks\n   { modBreaks_flags = error \"ModBreaks.modBreaks_array not initialised\"\n         -- ToDo: can we avoid this?\n   , modBreaks_locs  = array (0,-1) []\n   , modBreaks_vars  = array (0,-1) []\n   , modBreaks_decls = array (0,-1) []\n   , modBreaks_ccs = array (0,-1) []\n   , modBreaks_breakInfo = IntMap.empty\n   }\n", "num_lines": 181}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-----------------------------------------------------------------------------\n--\n-- GHCi Interactive debugging commands\n--\n-- Pepe Iborra (supported by Google SoC) 2006\n--\n-- ToDo: lots of violation of layering here.  This module should\n-- decide whether it is above the GHC API (import GHC and nothing\n-- else) or below it.\n--\n-----------------------------------------------------------------------------\n\nmodule Debugger (pprintClosureCommand, showTerm, pprTypeAndContents) where\n\nimport GhcPrelude\n\nimport Linker\nimport RtClosureInspect\n\nimport GHCi\nimport GHCi.RemoteTypes\nimport GhcMonad\nimport HscTypes\nimport Id\nimport IfaceSyn ( showToHeader )\nimport IfaceEnv( newInteractiveBinder )\nimport Name\nimport Var hiding ( varName )\nimport VarSet\nimport UniqSet\nimport Type\nimport GHC\nimport Outputable\nimport PprTyThing\nimport ErrUtils\nimport MonadUtils\nimport DynFlags\nimport Exception\n\nimport Control.Monad\nimport Data.List\nimport Data.Maybe\nimport Data.IORef\n\n-------------------------------------\n-- | The :print & friends commands\n-------------------------------------\npprintClosureCommand :: GhcMonad m => Bool -> Bool -> String -> m ()\npprintClosureCommand bindThings force str = do\n  tythings <- (catMaybes . concat) `liftM`\n                 mapM (\\w -> GHC.parseName w >>=\n                                mapM GHC.lookupName)\n                      (words str)\n  let ids = [id | AnId id <- tythings]\n\n  -- Obtain the terms and the recovered type information\n  (subst, terms) <- mapAccumLM go emptyTCvSubst ids\n\n  -- Apply the substitutions obtained after recovering the types\n  modifySession $ \\hsc_env ->\n    hsc_env{hsc_IC = substInteractiveContext (hsc_IC hsc_env) subst}\n\n  -- Finally, print the Terms\n  unqual  <- GHC.getPrintUnqual\n  docterms <- mapM showTerm terms\n  dflags <- getDynFlags\n  liftIO $ (printOutputForUser dflags unqual . vcat)\n           (zipWith (\\id docterm -> ppr id <+> char '=' <+> docterm)\n                    ids\n                    docterms)\n where\n   -- Do the obtainTerm--bindSuspensions-computeSubstitution dance\n   go :: GhcMonad m => TCvSubst -> Id -> m (TCvSubst, Term)\n   go subst id = do\n       let id' = id `setIdType` substTy subst (idType id)\n       term_    <- GHC.obtainTermFromId maxBound force id'\n       term     <- tidyTermTyVars term_\n       term'    <- if bindThings &&\n                      (not (isUnliftedType (termType term)))\n                     then bindSuspensions term\n                     else return term\n     -- Before leaving, we compare the type obtained to see if it's more specific\n     --  Then, we extract a substitution,\n     --  mapping the old tyvars to the reconstructed types.\n       let reconstructed_type = termType term\n       hsc_env <- getSession\n       case (improveRTTIType hsc_env (idType id) (reconstructed_type)) of\n         Nothing     -> return (subst, term')\n         Just subst' -> do { dflags <- GHC.getSessionDynFlags\n                           ; liftIO $\n                               dumpIfSet_dyn dflags Opt_D_dump_rtti \"RTTI\"\n                                 (fsep $ [text \"RTTI Improvement for\", ppr id,\n                                  text \"is the substitution:\" , ppr subst'])\n                           ; return (subst `unionTCvSubst` subst', term')}\n\n   tidyTermTyVars :: GhcMonad m => Term -> m Term\n   tidyTermTyVars t =\n     withSession $ \\hsc_env -> do\n     let env_tvs      = tyThingsTyCoVars $ ic_tythings $ hsc_IC hsc_env\n         my_tvs       = termTyCoVars t\n         tvs          = env_tvs `minusVarSet` my_tvs\n         tyvarOccName = nameOccName . tyVarName\n         tidyEnv      = (initTidyOccEnv (map tyvarOccName (nonDetEltsUniqSet tvs))\n           -- It's OK to use nonDetEltsUniqSet here because initTidyOccEnv\n           -- forgets the ordering immediately by creating an env\n                        , getUniqSet $ env_tvs `intersectVarSet` my_tvs)\n     return $ mapTermType (snd . tidyOpenType tidyEnv) t\n\n-- | Give names, and bind in the interactive environment, to all the suspensions\n--   included (inductively) in a term\nbindSuspensions :: GhcMonad m => Term -> m Term\nbindSuspensions t = do\n      hsc_env <- getSession\n      inScope <- GHC.getBindings\n      let ictxt        = hsc_IC hsc_env\n          prefix       = \"_t\"\n          alreadyUsedNames = map (occNameString . nameOccName . getName) inScope\n          availNames   = map ((prefix++) . show) [(1::Int)..] \\\\ alreadyUsedNames\n      availNames_var  <- liftIO $ newIORef availNames\n      (t', stuff)     <- liftIO $ foldTerm (nameSuspensionsAndGetInfos hsc_env availNames_var) t\n      let (names, tys, fhvs) = unzip3 stuff\n      let ids = [ mkVanillaGlobal name ty\n                | (name,ty) <- zip names tys]\n          new_ic = extendInteractiveContextWithIds ictxt ids\n      liftIO $ extendLinkEnv (zip names fhvs)\n      setSession hsc_env {hsc_IC = new_ic }\n      return t'\n     where\n\n--    Processing suspensions. Give names and recopilate info\n        nameSuspensionsAndGetInfos :: HscEnv -> IORef [String]\n                                   -> TermFold (IO (Term, [(Name,Type,ForeignHValue)]))\n        nameSuspensionsAndGetInfos hsc_env freeNames = TermFold\n                      {\n                        fSuspension = doSuspension hsc_env freeNames\n                      , fTerm = \\ty dc v tt -> do\n                                    tt' <- sequence tt\n                                    let (terms,names) = unzip tt'\n                                    return (Term ty dc v terms, concat names)\n                      , fPrim    = \\ty n ->return (Prim ty n,[])\n                      , fNewtypeWrap  =\n                                \\ty dc t -> do\n                                    (term, names) <- t\n                                    return (NewtypeWrap ty dc term, names)\n                      , fRefWrap = \\ty t -> do\n                                    (term, names) <- t\n                                    return (RefWrap ty term, names)\n                      }\n        doSuspension hsc_env freeNames ct ty hval _name = do\n          name <- atomicModifyIORef' freeNames (\\x->(tail x, head x))\n          n <- newGrimName hsc_env name\n          return (Suspension ct ty hval (Just n), [(n,ty,hval)])\n\n\n--  A custom Term printer to enable the use of Show instances\nshowTerm :: GhcMonad m => Term -> m SDoc\nshowTerm term = do\n    dflags       <- GHC.getSessionDynFlags\n    if gopt Opt_PrintEvldWithShow dflags\n       then cPprTerm (liftM2 (++) (\\_y->[cPprShowable]) cPprTermBase) term\n       else cPprTerm cPprTermBase term\n where\n  cPprShowable prec t@Term{ty=ty, val=fhv} =\n    if not (isFullyEvaluatedTerm t)\n     then return Nothing\n     else do\n        hsc_env <- getSession\n        dflags  <- GHC.getSessionDynFlags\n        do\n           (new_env, bname) <- bindToFreshName hsc_env ty \"showme\"\n           setSession new_env\n                      -- XXX: this tries to disable logging of errors\n                      -- does this still do what it is intended to do\n                      -- with the changed error handling and logging?\n           let noop_log _ _ _ _ _ _ = return ()\n               expr = \"Prelude.return (Prelude.show \" ++\n                         showPpr dflags bname ++\n                      \") :: Prelude.IO Prelude.String\"\n           _ <- GHC.setSessionDynFlags dflags{log_action=noop_log}\n           txt_ <- withExtendedLinkEnv [(bname, fhv)]\n                                       (GHC.compileExprRemote expr)\n           let myprec = 10 -- application precedence. TODO Infix constructors\n           txt <- liftIO $ evalString hsc_env txt_\n           if not (null txt) then\n             return $ Just $ cparen (prec >= myprec && needsParens txt)\n                                    (text txt)\n            else return Nothing\n         `gfinally` do\n           setSession hsc_env\n           GHC.setSessionDynFlags dflags\n  cPprShowable prec NewtypeWrap{ty=new_ty,wrapped_term=t} =\n      cPprShowable prec t{ty=new_ty}\n  cPprShowable _ _ = return Nothing\n\n  needsParens ('\"':_) = False   -- some simple heuristics to see whether parens\n                                -- are redundant in an arbitrary Show output\n  needsParens ('(':_) = False\n  needsParens txt = ' ' `elem` txt\n\n\n  bindToFreshName hsc_env ty userName = do\n    name <- newGrimName hsc_env userName\n    let id       = mkVanillaGlobal name ty\n        new_ic   = extendInteractiveContextWithIds (hsc_IC hsc_env) [id]\n    return (hsc_env {hsc_IC = new_ic }, name)\n\n--    Create new uniques and give them sequentially numbered names\nnewGrimName :: MonadIO m => HscEnv -> String -> m Name\nnewGrimName hsc_env userName\n  = liftIO (newInteractiveBinder hsc_env occ noSrcSpan)\n  where\n    occ = mkOccName varName userName\n\npprTypeAndContents :: GhcMonad m => Id -> m SDoc\npprTypeAndContents id = do\n  dflags  <- GHC.getSessionDynFlags\n  let pcontents = gopt Opt_PrintBindContents dflags\n      pprdId    = (pprTyThing showToHeader . AnId) id\n  if pcontents\n    then do\n      let depthBound = 100\n      -- If the value is an exception, make sure we catch it and\n      -- show the exception, rather than propagating the exception out.\n      e_term <- gtry $ GHC.obtainTermFromId depthBound False id\n      docs_term <- case e_term of\n                      Right term -> showTerm term\n                      Left  exn  -> return (text \"*** Exception:\" <+>\n                                            text (show (exn :: SomeException)))\n      return $ pprdId <+> equals <+> docs_term\n    else return pprdId\n", "num_lines": 233}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns, CPP #-}\n\n--\n-- | Interacting with the interpreter, whether it is running on an\n-- external process or in the current process.\n--\nmodule GHCi\n  ( -- * High-level interface to the interpreter\n    evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)\n  , resumeStmt\n  , abandonStmt\n  , evalIO\n  , evalString\n  , evalStringToIOString\n  , mallocData\n  , createBCOs\n  , addSptEntry\n  , mkCostCentres\n  , costCentreStackInfo\n  , newBreakArray\n  , enableBreakpoint\n  , breakpointStatus\n  , getBreakpointVar\n  , getClosure\n  , seqHValue\n\n  -- * The object-code linker\n  , initObjLinker\n  , lookupSymbol\n  , lookupClosure\n  , loadDLL\n  , loadArchive\n  , loadObj\n  , unloadObj\n  , addLibrarySearchPath\n  , removeLibrarySearchPath\n  , resolveObjs\n  , findSystemLibrary\n\n  -- * Lower-level API using messages\n  , iservCmd, Message(..), withIServ, stopIServ\n  , iservCall, readIServ, writeIServ\n  , purgeLookupSymbolCache\n  , freeHValueRefs\n  , mkFinalizedHValue\n  , wormhole, wormholeRef\n  , mkEvalOpts\n  , fromEvalResult\n  ) where\n\nimport GhcPrelude\n\nimport GHCi.Message\n#if defined(GHCI)\nimport GHCi.Run\n#endif\nimport GHCi.RemoteTypes\nimport GHCi.ResolvedBCO\nimport GHCi.BreakArray (BreakArray)\nimport Fingerprint\nimport HscTypes\nimport UniqFM\nimport Panic\nimport DynFlags\nimport ErrUtils\nimport Outputable\nimport Exception\nimport BasicTypes\nimport FastString\nimport Util\nimport Hooks\n\nimport Control.Concurrent\nimport Control.Monad\nimport Control.Monad.IO.Class\nimport Data.Binary\nimport Data.Binary.Put\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString.Lazy as LB\nimport Data.IORef\nimport Foreign hiding (void)\nimport GHC.Exts.Heap\nimport GHC.Stack.CCS (CostCentre,CostCentreStack)\nimport System.Exit\nimport Data.Maybe\nimport GHC.IO.Handle.Types (Handle)\n#if defined(mingw32_HOST_OS)\nimport Foreign.C\nimport GHC.IO.Handle.FD (fdToHandle)\n#else\nimport System.Posix as Posix\n#endif\nimport System.Directory\nimport System.Process\nimport GHC.Conc (getNumProcessors, pseq, par)\n\n{- Note [Remote GHCi]\n\nWhen the flag -fexternal-interpreter is given to GHC, interpreted code\nis run in a separate process called iserv, and we communicate with the\nexternal process over a pipe using Binary-encoded messages.\n\nMotivation\n~~~~~~~~~~\n\nWhen the interpreted code is running in a separate process, it can\nuse a different \"way\", e.g. profiled or dynamic.  This means\n\n- compiling Template Haskell code with -prof does not require\n  building the code without -prof first\n\n- when GHC itself is profiled, it can interpret unprofiled code,\n  and the same applies to dynamic linking.\n\n- An unprofiled GHCi can load and run profiled code, which means it\n  can use the stack-trace functionality provided by profiling without\n  taking the performance hit on the compiler that profiling would\n  entail.\n\nFor other reasons see RemoteGHCi on the wiki.\n\nImplementation Overview\n~~~~~~~~~~~~~~~~~~~~~~~\n\nThe main pieces are:\n\n- libraries/ghci, containing:\n  - types for talking about remote values (GHCi.RemoteTypes)\n  - the message protocol (GHCi.Message),\n  - implementation of the messages (GHCi.Run)\n  - implementation of Template Haskell (GHCi.TH)\n  - a few other things needed to run interpreted code\n\n- top-level iserv directory, containing the codefor the external\n  server.  This is a fairly simple wrapper, most of the functionality\n  is provided by modules in libraries/ghci.\n\n- This module (GHCi) which provides the interface to the server used\n  by the rest of GHC.\n\nGHC works with and without -fexternal-interpreter.  With the flag, all\ninterpreted code is run by the iserv binary.  Without the flag,\ninterpreted code is run in the same process as GHC.\n\nThings that do not work with -fexternal-interpreter\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\ndynCompileExpr cannot work, because we have no way to run code of an\nunknown type in the remote process.  This API fails with an error\nmessage if it is used with -fexternal-interpreter.\n\nOther Notes on Remote GHCi\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n  * This wiki page has an implementation overview:\n    https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/ExternalInterpreter\n  * Note [External GHCi pointers] in compiler/ghci/GHCi.hs\n  * Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs\n-}\n\n#if !defined(GHCI)\nneedExtInt :: IO a\nneedExtInt = throwIO\n  (InstallationError \"this operation requires -fexternal-interpreter\")\n#endif\n\n-- | Run a command in the interpreter's context.  With\n-- @-fexternal-interpreter@, the command is serialized and sent to an\n-- external iserv process, and the response is deserialized (hence the\n-- @Binary@ constraint).  With @-fno-external-interpreter@ we execute\n-- the command directly here.\niservCmd :: Binary a => HscEnv -> Message a -> IO a\niservCmd hsc_env@HscEnv{..} msg\n | gopt Opt_ExternalInterpreter hsc_dflags =\n     withIServ hsc_env $ \\iserv ->\n       uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]\n         iservCall iserv msg\n | otherwise = -- Just run it directly\n#if defined(GHCI)\n   run msg\n#else\n   needExtInt\n#endif\n\n-- Note [uninterruptibleMask_ and iservCmd]\n--\n-- If we receive an async exception, such as ^C, while communicating\n-- with the iserv process then we will be out-of-sync and not be able\n-- to recoever.  Thus we use uninterruptibleMask_ during\n-- communication.  A ^C will be delivered to the iserv process (because\n-- signals get sent to the whole process group) which will interrupt\n-- the running computation and return an EvalException result.\n\n-- | Grab a lock on the 'IServ' and do something with it.\n-- Overloaded because this is used from TcM as well as IO.\nwithIServ\n  :: (MonadIO m, ExceptionMonad m)\n  => HscEnv -> (IServ -> m a) -> m a\nwithIServ HscEnv{..} action =\n  gmask $ \\restore -> do\n    m <- liftIO $ takeMVar hsc_iserv\n      -- start the iserv process if we haven't done so yet\n    iserv <- maybe (liftIO $ startIServ hsc_dflags) return m\n               `gonException` (liftIO $ putMVar hsc_iserv Nothing)\n      -- free any ForeignHValues that have been garbage collected.\n    let iserv' = iserv{ iservPendingFrees = [] }\n    a <- (do\n      liftIO $ when (not (null (iservPendingFrees iserv))) $\n        iservCall iserv (FreeHValueRefs (iservPendingFrees iserv))\n        -- run the inner action\n      restore $ action iserv)\n          `gonException` (liftIO $ putMVar hsc_iserv (Just iserv'))\n    liftIO $ putMVar hsc_iserv (Just iserv')\n    return a\n\n\n-- -----------------------------------------------------------------------------\n-- Wrappers around messages\n\n-- | Execute an action of type @IO [a]@, returning 'ForeignHValue's for\n-- each of the results.\nevalStmt\n  :: HscEnv -> Bool -> EvalExpr ForeignHValue\n  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])\nevalStmt hsc_env step foreign_expr = do\n  let dflags = hsc_dflags hsc_env\n  status <- withExpr foreign_expr $ \\expr ->\n    iservCmd hsc_env (EvalStmt (mkEvalOpts dflags step) expr)\n  handleEvalStatus hsc_env status\n where\n  withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a\n  withExpr (EvalThis fhv) cont =\n    withForeignRef fhv $ \\hvref -> cont (EvalThis hvref)\n  withExpr (EvalApp fl fr) cont =\n    withExpr fl $ \\fl' ->\n    withExpr fr $ \\fr' ->\n    cont (EvalApp fl' fr')\n\nresumeStmt\n  :: HscEnv -> Bool -> ForeignRef (ResumeContext [HValueRef])\n  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])\nresumeStmt hsc_env step resume_ctxt = do\n  let dflags = hsc_dflags hsc_env\n  status <- withForeignRef resume_ctxt $ \\rhv ->\n    iservCmd hsc_env (ResumeStmt (mkEvalOpts dflags step) rhv)\n  handleEvalStatus hsc_env status\n\nabandonStmt :: HscEnv -> ForeignRef (ResumeContext [HValueRef]) -> IO ()\nabandonStmt hsc_env resume_ctxt = do\n  withForeignRef resume_ctxt $ \\rhv ->\n    iservCmd hsc_env (AbandonStmt rhv)\n\nhandleEvalStatus\n  :: HscEnv -> EvalStatus [HValueRef]\n  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])\nhandleEvalStatus hsc_env status =\n  case status of\n    EvalBreak a b c d e f -> return (EvalBreak a b c d e f)\n    EvalComplete alloc res ->\n      EvalComplete alloc <$> addFinalizer res\n where\n  addFinalizer (EvalException e) = return (EvalException e)\n  addFinalizer (EvalSuccess rs) = do\n    EvalSuccess <$> mapM (mkFinalizedHValue hsc_env) rs\n\n-- | Execute an action of type @IO ()@\nevalIO :: HscEnv -> ForeignHValue -> IO ()\nevalIO hsc_env fhv = do\n  liftIO $ withForeignRef fhv $ \\fhv ->\n    iservCmd hsc_env (EvalIO fhv) >>= fromEvalResult\n\n-- | Execute an action of type @IO String@\nevalString :: HscEnv -> ForeignHValue -> IO String\nevalString hsc_env fhv = do\n  liftIO $ withForeignRef fhv $ \\fhv ->\n    iservCmd hsc_env (EvalString fhv) >>= fromEvalResult\n\n-- | Execute an action of type @String -> IO String@\nevalStringToIOString :: HscEnv -> ForeignHValue -> String -> IO String\nevalStringToIOString hsc_env fhv str = do\n  liftIO $ withForeignRef fhv $ \\fhv ->\n    iservCmd hsc_env (EvalStringToString fhv str) >>= fromEvalResult\n\n\n-- | Allocate and store the given bytes in memory, returning a pointer\n-- to the memory in the remote process.\nmallocData :: HscEnv -> ByteString -> IO (RemotePtr ())\nmallocData hsc_env bs = iservCmd hsc_env (MallocData bs)\n\nmkCostCentres\n  :: HscEnv -> String -> [(String,String)] -> IO [RemotePtr CostCentre]\nmkCostCentres hsc_env mod ccs =\n  iservCmd hsc_env (MkCostCentres mod ccs)\n\n-- | Create a set of BCOs that may be mutually recursive.\ncreateBCOs :: HscEnv -> [ResolvedBCO] -> IO [HValueRef]\ncreateBCOs hsc_env rbcos = do\n  n_jobs <- case parMakeCount (hsc_dflags hsc_env) of\n              Nothing -> liftIO getNumProcessors\n              Just n  -> return n\n  -- Serializing ResolvedBCO is expensive, so if we're in parallel mode\n  -- (-j<n>) parallelise the serialization.\n  if (n_jobs == 1)\n    then\n      iservCmd hsc_env (CreateBCOs [runPut (put rbcos)])\n\n    else do\n      old_caps <- getNumCapabilities\n      if old_caps == n_jobs\n         then void $ evaluate puts\n         else bracket_ (setNumCapabilities n_jobs)\n                       (setNumCapabilities old_caps)\n                       (void $ evaluate puts)\n      iservCmd hsc_env (CreateBCOs puts)\n where\n  puts = parMap doChunk (chunkList 100 rbcos)\n\n  -- make sure we force the whole lazy ByteString\n  doChunk c = pseq (LB.length bs) bs\n    where bs = runPut (put c)\n\n  -- We don't have the parallel package, so roll our own simple parMap\n  parMap _ [] = []\n  parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs))\n    where fx = f x; fxs = parMap f xs\n\naddSptEntry :: HscEnv -> Fingerprint -> ForeignHValue -> IO ()\naddSptEntry hsc_env fpr ref =\n  withForeignRef ref $ \\val ->\n    iservCmd hsc_env (AddSptEntry fpr val)\n\ncostCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String]\ncostCentreStackInfo hsc_env ccs =\n  iservCmd hsc_env (CostCentreStackInfo ccs)\n\nnewBreakArray :: HscEnv -> Int -> IO (ForeignRef BreakArray)\nnewBreakArray hsc_env size = do\n  breakArray <- iservCmd hsc_env (NewBreakArray size)\n  mkFinalizedHValue hsc_env breakArray\n\nenableBreakpoint :: HscEnv -> ForeignRef BreakArray -> Int -> Bool -> IO ()\nenableBreakpoint hsc_env ref ix b = do\n  withForeignRef ref $ \\breakarray ->\n    iservCmd hsc_env (EnableBreakpoint breakarray ix b)\n\nbreakpointStatus :: HscEnv -> ForeignRef BreakArray -> Int -> IO Bool\nbreakpointStatus hsc_env ref ix = do\n  withForeignRef ref $ \\breakarray ->\n    iservCmd hsc_env (BreakpointStatus breakarray ix)\n\ngetBreakpointVar :: HscEnv -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)\ngetBreakpointVar hsc_env ref ix =\n  withForeignRef ref $ \\apStack -> do\n    mb <- iservCmd hsc_env (GetBreakpointVar apStack ix)\n    mapM (mkFinalizedHValue hsc_env) mb\n\ngetClosure :: HscEnv -> ForeignHValue -> IO (GenClosure ForeignHValue)\ngetClosure hsc_env ref =\n  withForeignRef ref $ \\hval -> do\n    mb <- iservCmd hsc_env (GetClosure hval)\n    mapM (mkFinalizedHValue hsc_env) mb\n\nseqHValue :: HscEnv -> ForeignHValue -> IO ()\nseqHValue hsc_env ref =\n  withForeignRef ref $ \\hval ->\n    iservCmd hsc_env (Seq hval) >>= fromEvalResult\n\n-- -----------------------------------------------------------------------------\n-- Interface to the object-code linker\n\ninitObjLinker :: HscEnv -> IO ()\ninitObjLinker hsc_env = iservCmd hsc_env InitLinker\n\nlookupSymbol :: HscEnv -> FastString -> IO (Maybe (Ptr ()))\nlookupSymbol hsc_env@HscEnv{..} str\n | gopt Opt_ExternalInterpreter hsc_dflags =\n     -- Profiling of GHCi showed a lot of time and allocation spent\n     -- making cross-process LookupSymbol calls, so I added a GHC-side\n     -- cache which sped things up quite a lot.  We have to be careful\n     -- to purge this cache when unloading code though.\n     withIServ hsc_env $ \\iserv@IServ{..} -> do\n       cache <- readIORef iservLookupSymbolCache\n       case lookupUFM cache str of\n         Just p -> return (Just p)\n         Nothing -> do\n           m <- uninterruptibleMask_ $\n                    iservCall iserv (LookupSymbol (unpackFS str))\n           case m of\n             Nothing -> return Nothing\n             Just r -> do\n               let p = fromRemotePtr r\n               writeIORef iservLookupSymbolCache $! addToUFM cache str p\n               return (Just p)\n | otherwise =\n#if defined(GHCI)\n   fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))\n#else\n   needExtInt\n#endif\n\nlookupClosure :: HscEnv -> String -> IO (Maybe HValueRef)\nlookupClosure hsc_env str =\n  iservCmd hsc_env (LookupClosure str)\n\npurgeLookupSymbolCache :: HscEnv -> IO ()\npurgeLookupSymbolCache hsc_env@HscEnv{..} =\n when (gopt Opt_ExternalInterpreter hsc_dflags) $\n   withIServ hsc_env $ \\IServ{..} ->\n     writeIORef iservLookupSymbolCache emptyUFM\n\n\n-- | loadDLL loads a dynamic library using the OS's native linker\n-- (i.e. dlopen() on Unix, LoadLibrary() on Windows).  It takes either\n-- an absolute pathname to the file, or a relative filename\n-- (e.g. \"libfoo.so\" or \"foo.dll\").  In the latter case, loadDLL\n-- searches the standard locations for the appropriate library.\n--\n-- Returns:\n--\n-- Nothing      => success\n-- Just err_msg => failure\nloadDLL :: HscEnv -> String -> IO (Maybe String)\nloadDLL hsc_env str = iservCmd hsc_env (LoadDLL str)\n\nloadArchive :: HscEnv -> String -> IO ()\nloadArchive hsc_env path = do\n  path' <- canonicalizePath path -- Note [loadObj and relative paths]\n  iservCmd hsc_env (LoadArchive path')\n\nloadObj :: HscEnv -> String -> IO ()\nloadObj hsc_env path = do\n  path' <- canonicalizePath path -- Note [loadObj and relative paths]\n  iservCmd hsc_env (LoadObj path')\n\nunloadObj :: HscEnv -> String -> IO ()\nunloadObj hsc_env path = do\n  path' <- canonicalizePath path -- Note [loadObj and relative paths]\n  iservCmd hsc_env (UnloadObj path')\n\n-- Note [loadObj and relative paths]\n-- the iserv process might have a different current directory from the\n-- GHC process, so we must make paths absolute before sending them\n-- over.\n\naddLibrarySearchPath :: HscEnv -> String -> IO (Ptr ())\naddLibrarySearchPath hsc_env str =\n  fromRemotePtr <$> iservCmd hsc_env (AddLibrarySearchPath str)\n\nremoveLibrarySearchPath :: HscEnv -> Ptr () -> IO Bool\nremoveLibrarySearchPath hsc_env p =\n  iservCmd hsc_env (RemoveLibrarySearchPath (toRemotePtr p))\n\nresolveObjs :: HscEnv -> IO SuccessFlag\nresolveObjs hsc_env = successIf <$> iservCmd hsc_env ResolveObjs\n\nfindSystemLibrary :: HscEnv -> String -> IO (Maybe String)\nfindSystemLibrary hsc_env str = iservCmd hsc_env (FindSystemLibrary str)\n\n\n-- -----------------------------------------------------------------------------\n-- Raw calls and messages\n\n-- | Send a 'Message' and receive the response from the iserv process\niservCall :: Binary a => IServ -> Message a -> IO a\niservCall iserv@IServ{..} msg =\n  remoteCall iservPipe msg\n    `catch` \\(e :: SomeException) -> handleIServFailure iserv e\n\n-- | Read a value from the iserv process\nreadIServ :: IServ -> Get a -> IO a\nreadIServ iserv@IServ{..} get =\n  readPipe iservPipe get\n    `catch` \\(e :: SomeException) -> handleIServFailure iserv e\n\n-- | Send a value to the iserv process\nwriteIServ :: IServ -> Put -> IO ()\nwriteIServ iserv@IServ{..} put =\n  writePipe iservPipe put\n    `catch` \\(e :: SomeException) -> handleIServFailure iserv e\n\nhandleIServFailure :: IServ -> SomeException -> IO a\nhandleIServFailure IServ{..} e = do\n  ex <- getProcessExitCode iservProcess\n  case ex of\n    Just (ExitFailure n) ->\n      throw (InstallationError (\"ghc-iserv terminated (\" ++ show n ++ \")\"))\n    _ -> do\n      terminateProcess iservProcess\n      _ <- waitForProcess iservProcess\n      throw e\n\n-- -----------------------------------------------------------------------------\n-- Starting and stopping the iserv process\n\nstartIServ :: DynFlags -> IO IServ\nstartIServ dflags = do\n  let flavour\n        | WayProf `elem` ways dflags = \"-prof\"\n        | WayDyn `elem` ways dflags = \"-dyn\"\n        | otherwise = \"\"\n      prog = pgm_i dflags ++ flavour\n      opts = getOpts dflags opt_i\n  debugTraceMsg dflags 3 $ text \"Starting \" <> text prog\n  let createProc = lookupHook createIservProcessHook\n                              (\\cp -> do { (_,_,_,ph) <- createProcess cp\n                                         ; return ph })\n                              dflags\n  (ph, rh, wh) <- runWithPipes createProc prog opts\n  lo_ref <- newIORef Nothing\n  cache_ref <- newIORef emptyUFM\n  return $ IServ\n    { iservPipe = Pipe { pipeRead = rh\n                       , pipeWrite = wh\n                       , pipeLeftovers = lo_ref }\n    , iservProcess = ph\n    , iservLookupSymbolCache = cache_ref\n    , iservPendingFrees = []\n    }\n\nstopIServ :: HscEnv -> IO ()\nstopIServ HscEnv{..} =\n  gmask $ \\_restore -> do\n    m <- takeMVar hsc_iserv\n    maybe (return ()) stop m\n    putMVar hsc_iserv Nothing\n where\n  stop iserv = do\n    ex <- getProcessExitCode (iservProcess iserv)\n    if isJust ex\n       then return ()\n       else iservCall iserv Shutdown\n\nrunWithPipes :: (CreateProcess -> IO ProcessHandle)\n             -> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)\n#if defined(mingw32_HOST_OS)\nforeign import ccall \"io.h _close\"\n   c__close :: CInt -> IO CInt\n\nforeign import ccall unsafe \"io.h _get_osfhandle\"\n   _get_osfhandle :: CInt -> IO CInt\n\nrunWithPipes createProc prog opts = do\n    (rfd1, wfd1) <- createPipeFd -- we read on rfd1\n    (rfd2, wfd2) <- createPipeFd -- we write on wfd2\n    wh_client    <- _get_osfhandle wfd1\n    rh_client    <- _get_osfhandle rfd2\n    let args = show wh_client : show rh_client : opts\n    ph <- createProc (proc prog args)\n    rh <- mkHandle rfd1\n    wh <- mkHandle wfd2\n    return (ph, rh, wh)\n      where mkHandle :: CInt -> IO Handle\n            mkHandle fd = (fdToHandle fd) `onException` (c__close fd)\n\n#else\nrunWithPipes createProc prog opts = do\n    (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1\n    (rfd2, wfd2) <- Posix.createPipe -- we write on wfd2\n    setFdOption rfd1 CloseOnExec True\n    setFdOption wfd2 CloseOnExec True\n    let args = show wfd1 : show rfd2 : opts\n    ph <- createProc (proc prog args)\n    closeFd wfd1\n    closeFd rfd2\n    rh <- fdToHandle rfd1\n    wh <- fdToHandle wfd2\n    return (ph, rh, wh)\n#endif\n\n-- -----------------------------------------------------------------------------\n{- Note [External GHCi pointers]\n\nWe have the following ways to reference things in GHCi:\n\nHValue\n------\n\nHValue is a direct reference to a value in the local heap.  Obviously\nwe cannot use this to refer to things in the external process.\n\n\nRemoteRef\n---------\n\nRemoteRef is a StablePtr to a heap-resident value.  When\n-fexternal-interpreter is used, this value resides in the external\nprocess's heap.  RemoteRefs are mostly used to send pointers in\nmessages between GHC and iserv.\n\nA RemoteRef must be explicitly freed when no longer required, using\nfreeHValueRefs, or by attaching a finalizer with mkForeignHValue.\n\nTo get from a RemoteRef to an HValue you can use 'wormholeRef', which\nfails with an error message if -fexternal-interpreter is in use.\n\nForeignRef\n----------\n\nA ForeignRef is a RemoteRef with a finalizer that will free the\n'RemoteRef' when it is garbage collected.  We mostly use ForeignHValue\non the GHC side.\n\nThe finalizer adds the RemoteRef to the iservPendingFrees list in the\nIServ record.  The next call to iservCmd will free any RemoteRefs in\nthe list.  It was done this way rather than calling iservCmd directly,\nbecause I didn't want to have arbitrary threads calling iservCmd.  In\nprinciple it would probably be ok, but it seems less hairy this way.\n-}\n\n-- | Creates a 'ForeignRef' that will automatically release the\n-- 'RemoteRef' when it is no longer referenced.\nmkFinalizedHValue :: HscEnv -> RemoteRef a -> IO (ForeignRef a)\nmkFinalizedHValue HscEnv{..} rref = mkForeignRef rref free\n where\n  !external = gopt Opt_ExternalInterpreter hsc_dflags\n  hvref = toHValueRef rref\n\n  free :: IO ()\n  free\n    | not external = freeRemoteRef hvref\n    | otherwise =\n      modifyMVar_ hsc_iserv $ \\mb_iserv ->\n        case mb_iserv of\n          Nothing -> return Nothing -- already shut down\n          Just iserv@IServ{..} ->\n            return (Just iserv{iservPendingFrees = hvref : iservPendingFrees})\n\nfreeHValueRefs :: HscEnv -> [HValueRef] -> IO ()\nfreeHValueRefs _ [] = return ()\nfreeHValueRefs hsc_env refs = iservCmd hsc_env (FreeHValueRefs refs)\n\n-- | Convert a 'ForeignRef' to the value it references directly.  This\n-- only works when the interpreter is running in the same process as\n-- the compiler, so it fails when @-fexternal-interpreter@ is on.\nwormhole :: DynFlags -> ForeignRef a -> IO a\nwormhole dflags r = wormholeRef dflags (unsafeForeignRefToRemoteRef r)\n\n-- | Convert an 'RemoteRef' to the value it references directly.  This\n-- only works when the interpreter is running in the same process as\n-- the compiler, so it fails when @-fexternal-interpreter@ is on.\nwormholeRef :: DynFlags -> RemoteRef a -> IO a\nwormholeRef dflags _r\n  | gopt Opt_ExternalInterpreter dflags\n  = throwIO (InstallationError\n      \"this operation requires -fno-external-interpreter\")\n#if defined(GHCI)\n  | otherwise\n  = localRef _r\n#else\n  | otherwise\n  = throwIO (InstallationError\n      \"can't wormhole a value in a stage1 compiler\")\n#endif\n\n-- -----------------------------------------------------------------------------\n-- Misc utils\n\nmkEvalOpts :: DynFlags -> Bool -> EvalOpts\nmkEvalOpts dflags step =\n  EvalOpts\n    { useSandboxThread = gopt Opt_GhciSandbox dflags\n    , singleStep = step\n    , breakOnException = gopt Opt_BreakOnException dflags\n    , breakOnError = gopt Opt_BreakOnError dflags }\n\nfromEvalResult :: EvalResult a -> IO a\nfromEvalResult (EvalException e) = throwIO (fromSerializableException e)\nfromEvalResult (EvalSuccess a) = return a\n", "num_lines": 668}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-}\n{-# LANGUAGE BangPatterns #-}\n{-# OPTIONS_GHC -fno-cse #-}\n-- -fno-cse is needed for GLOBAL_VAR's to behave properly\n\n--\n--  (c) The University of Glasgow 2002-2006\n--\n-- | The dynamic linker for GHCi.\n--\n-- This module deals with the top-level issues of dynamic linking,\n-- calling the object-code linker and the byte-code linker where\n-- necessary.\nmodule Linker ( getHValue, showLinkerState,\n                linkExpr, linkDecls, unload, withExtendedLinkEnv,\n                extendLinkEnv, deleteFromLinkEnv,\n                extendLoadedPkgs,\n                linkPackages,initDynLinker,linkModule,\n                linkCmdLineLibs\n        ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport GHCi\nimport GHCi.RemoteTypes\nimport LoadIface\nimport ByteCodeLink\nimport ByteCodeAsm\nimport ByteCodeTypes\nimport TcRnMonad\nimport Packages\nimport DriverPhases\nimport Finder\nimport HscTypes\nimport Name\nimport NameEnv\nimport Module\nimport ListSetOps\nimport DynFlags\nimport BasicTypes\nimport Outputable\nimport Panic\nimport Util\nimport ErrUtils\nimport SrcLoc\nimport qualified Maybes\nimport UniqDSet\nimport FastString\nimport Platform\nimport SysTools\nimport FileCleanup\n\n-- Standard libraries\nimport Control.Monad\n\nimport Data.Char (isSpace)\nimport Data.IORef\nimport Data.List\nimport Data.Maybe\nimport Control.Concurrent.MVar\n\nimport System.FilePath\nimport System.Directory\nimport System.IO.Unsafe\nimport System.Environment (lookupEnv)\n\n#if defined(mingw32_HOST_OS)\nimport System.Win32.Info (getSystemDirectory)\n#endif\n\nimport Exception\n\n-- needed for 2nd stage\n#if STAGE >= 2\nimport Foreign (Ptr)\n#endif\n\n{- **********************************************************************\n\n                        The Linker's state\n\n  ********************************************************************* -}\n\n{-\nThe persistent linker state *must* match the actual state of the\nC dynamic linker at all times, so we keep it in a private global variable.\n\nThe global IORef used for PersistentLinkerState actually contains another MVar,\nwhich in turn contains a Maybe PersistentLinkerState. The MVar serves to ensure\nmutual exclusion between multiple loaded copies of the GHC library. The Maybe\nmay be Nothing to indicate that the linker has not yet been initialised.\n\nThe PersistentLinkerState maps Names to actual closures (for\ninterpreted code only), for use during linking.\n-}\n#if STAGE < 2\nGLOBAL_VAR_M( v_PersistentLinkerState\n            , newMVar Nothing\n            , MVar (Maybe PersistentLinkerState))\n#else\nSHARED_GLOBAL_VAR_M( v_PersistentLinkerState\n                   , getOrSetLibHSghcPersistentLinkerState\n                   , \"getOrSetLibHSghcPersistentLinkerState\"\n                   , newMVar Nothing\n                   , MVar (Maybe PersistentLinkerState))\n#endif\n\nuninitialised :: a\nuninitialised = panic \"Dynamic linker not initialised\"\n\nmodifyPLS_ :: (PersistentLinkerState -> IO PersistentLinkerState) -> IO ()\nmodifyPLS_ f = readIORef v_PersistentLinkerState\n  >>= flip modifyMVar_ (fmap pure . f . fromMaybe uninitialised)\n\nmodifyPLS :: (PersistentLinkerState -> IO (PersistentLinkerState, a)) -> IO a\nmodifyPLS f = readIORef v_PersistentLinkerState\n  >>= flip modifyMVar (fmapFst pure . f . fromMaybe uninitialised)\n  where fmapFst f = fmap (\\(x, y) -> (f x, y))\n\nreadPLS :: IO PersistentLinkerState\nreadPLS = readIORef v_PersistentLinkerState\n  >>= fmap (fromMaybe uninitialised) . readMVar\n\nmodifyMbPLS_\n  :: (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO ()\nmodifyMbPLS_ f = readIORef v_PersistentLinkerState >>= flip modifyMVar_ f\n\ndata PersistentLinkerState\n   = PersistentLinkerState {\n\n        -- Current global mapping from Names to their true values\n        closure_env :: ClosureEnv,\n\n        -- The current global mapping from RdrNames of DataCons to\n        -- info table addresses.\n        -- When a new Unlinked is linked into the running image, or an existing\n        -- module in the image is replaced, the itbl_env must be updated\n        -- appropriately.\n        itbl_env    :: !ItblEnv,\n\n        -- The currently loaded interpreted modules (home package)\n        bcos_loaded :: ![Linkable],\n\n        -- And the currently-loaded compiled modules (home package)\n        objs_loaded :: ![Linkable],\n\n        -- The currently-loaded packages; always object code\n        -- Held, as usual, in dependency order; though I am not sure if\n        -- that is really important\n        pkgs_loaded :: ![LinkerUnitId],\n\n        -- we need to remember the name of previous temporary DLL/.so\n        -- libraries so we can link them (see #10322)\n        temp_sos :: ![(FilePath, String)] }\n\n\nemptyPLS :: DynFlags -> PersistentLinkerState\nemptyPLS _ = PersistentLinkerState {\n                        closure_env = emptyNameEnv,\n                        itbl_env    = emptyNameEnv,\n                        pkgs_loaded = init_pkgs,\n                        bcos_loaded = [],\n                        objs_loaded = [],\n                        temp_sos = [] }\n\n  -- Packages that don't need loading, because the compiler\n  -- shares them with the interpreted program.\n  --\n  -- The linker's symbol table is populated with RTS symbols using an\n  -- explicit list.  See rts/Linker.c for details.\n  where init_pkgs = map toInstalledUnitId [rtsUnitId]\n\n\nextendLoadedPkgs :: [InstalledUnitId] -> IO ()\nextendLoadedPkgs pkgs =\n  modifyPLS_ $ \\s ->\n      return s{ pkgs_loaded = pkgs ++ pkgs_loaded s }\n\nextendLinkEnv :: [(Name,ForeignHValue)] -> IO ()\nextendLinkEnv new_bindings =\n  modifyPLS_ $ \\pls@PersistentLinkerState{..} -> do\n    let new_ce = extendClosureEnv closure_env new_bindings\n    return $! pls{ closure_env = new_ce }\n    -- strictness is important for not retaining old copies of the pls\n\ndeleteFromLinkEnv :: [Name] -> IO ()\ndeleteFromLinkEnv to_remove =\n  modifyPLS_ $ \\pls -> do\n    let ce = closure_env pls\n    let new_ce = delListFromNameEnv ce to_remove\n    return pls{ closure_env = new_ce }\n\n-- | Get the 'HValue' associated with the given name.\n--\n-- May cause loading the module that contains the name.\n--\n-- Throws a 'ProgramError' if loading fails or the name cannot be found.\ngetHValue :: HscEnv -> Name -> IO ForeignHValue\ngetHValue hsc_env name = do\n  initDynLinker hsc_env\n  pls <- modifyPLS $ \\pls -> do\n           if (isExternalName name) then do\n             (pls', ok) <- linkDependencies hsc_env pls noSrcSpan\n                              [nameModule name]\n             if (failed ok) then throwGhcExceptionIO (ProgramError \"\")\n                            else return (pls', pls')\n            else\n             return (pls, pls)\n  case lookupNameEnv (closure_env pls) name of\n    Just (_,aa) -> return aa\n    Nothing\n        -> ASSERT2(isExternalName name, ppr name)\n           do let sym_to_find = nameToCLabel name \"closure\"\n              m <- lookupClosure hsc_env (unpackFS sym_to_find)\n              case m of\n                Just hvref -> mkFinalizedHValue hsc_env hvref\n                Nothing -> linkFail \"ByteCodeLink.lookupCE\"\n                             (unpackFS sym_to_find)\n\nlinkDependencies :: HscEnv -> PersistentLinkerState\n                 -> SrcSpan -> [Module]\n                 -> IO (PersistentLinkerState, SuccessFlag)\nlinkDependencies hsc_env pls span needed_mods = do\n--   initDynLinker (hsc_dflags hsc_env)\n   let hpt = hsc_HPT hsc_env\n       dflags = hsc_dflags hsc_env\n   -- The interpreter and dynamic linker can only handle object code built\n   -- the \"normal\" way, i.e. no non-std ways like profiling or ticky-ticky.\n   -- So here we check the build tag: if we're building a non-standard way\n   -- then we need to find & link object files built the \"normal\" way.\n   maybe_normal_osuf <- checkNonStdWay dflags span\n\n   -- Find what packages and linkables are required\n   (lnks, pkgs) <- getLinkDeps hsc_env hpt pls\n                               maybe_normal_osuf span needed_mods\n\n   -- Link the packages and modules required\n   pls1 <- linkPackages' hsc_env pkgs pls\n   linkModules hsc_env pls1 lnks\n\n\n-- | Temporarily extend the linker state.\n\nwithExtendedLinkEnv :: (ExceptionMonad m) =>\n                       [(Name,ForeignHValue)] -> m a -> m a\nwithExtendedLinkEnv new_env action\n    = gbracket (liftIO $ extendLinkEnv new_env)\n               (\\_ -> reset_old_env)\n               (\\_ -> action)\n    where\n        -- Remember that the linker state might be side-effected\n        -- during the execution of the IO action, and we don't want to\n        -- lose those changes (we might have linked a new module or\n        -- package), so the reset action only removes the names we\n        -- added earlier.\n          reset_old_env = liftIO $ do\n            modifyPLS_ $ \\pls ->\n                let cur = closure_env pls\n                    new = delListFromNameEnv cur (map fst new_env)\n                in return pls{ closure_env = new }\n\n\n-- | Display the persistent linker state.\nshowLinkerState :: DynFlags -> IO ()\nshowLinkerState dflags\n  = do pls <- readPLS\n       putLogMsg dflags NoReason SevDump noSrcSpan\n          (defaultDumpStyle dflags)\n                 (vcat [text \"----- Linker state -----\",\n                        text \"Pkgs:\" <+> ppr (pkgs_loaded pls),\n                        text \"Objs:\" <+> ppr (objs_loaded pls),\n                        text \"BCOs:\" <+> ppr (bcos_loaded pls)])\n\n\n{- **********************************************************************\n\n                        Initialisation\n\n  ********************************************************************* -}\n\n-- | Initialise the dynamic linker.  This entails\n--\n--  a) Calling the C initialisation procedure,\n--\n--  b) Loading any packages specified on the command line,\n--\n--  c) Loading any packages specified on the command line, now held in the\n--     @-l@ options in @v_Opt_l@,\n--\n--  d) Loading any @.o\\/.dll@ files specified on the command line, now held\n--     in @ldInputs@,\n--\n--  e) Loading any MacOS frameworks.\n--\n-- NOTE: This function is idempotent; if called more than once, it does\n-- nothing.  This is useful in Template Haskell, where we call it before\n-- trying to link.\n--\ninitDynLinker :: HscEnv -> IO ()\ninitDynLinker hsc_env =\n  modifyMbPLS_ $ \\pls -> do\n    case pls of\n      Just  _ -> return pls\n      Nothing -> Just <$> reallyInitDynLinker hsc_env\n\nreallyInitDynLinker :: HscEnv -> IO PersistentLinkerState\nreallyInitDynLinker hsc_env = do\n  -- Initialise the linker state\n  let dflags = hsc_dflags hsc_env\n      pls0 = emptyPLS dflags\n\n  -- (a) initialise the C dynamic linker\n  initObjLinker hsc_env\n\n  -- (b) Load packages from the command-line (Note [preload packages])\n  pls <- linkPackages' hsc_env (preloadPackages (pkgState dflags)) pls0\n\n  -- steps (c), (d) and (e)\n  linkCmdLineLibs' hsc_env pls\n\n\nlinkCmdLineLibs :: HscEnv -> IO ()\nlinkCmdLineLibs hsc_env = do\n  initDynLinker hsc_env\n  modifyPLS_ $ \\pls -> do\n    linkCmdLineLibs' hsc_env pls\n\nlinkCmdLineLibs' :: HscEnv -> PersistentLinkerState -> IO PersistentLinkerState\nlinkCmdLineLibs' hsc_env pls =\n  do\n      let dflags@(DynFlags { ldInputs = cmdline_ld_inputs\n                           , libraryPaths = lib_paths_base})\n            = hsc_dflags hsc_env\n\n      -- (c) Link libraries from the command-line\n      let minus_ls_1 = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]\n\n      -- On Windows we want to add libpthread by default just as GCC would.\n      -- However because we don't know the actual name of pthread's dll we\n      -- need to defer this to the locateLib call so we can't initialize it\n      -- inside of the rts. Instead we do it here to be able to find the\n      -- import library for pthreads. See Trac #13210.\n      let platform = targetPlatform dflags\n          os       = platformOS platform\n          minus_ls = case os of\n                       OSMinGW32 -> \"pthread\" : minus_ls_1\n                       _         -> minus_ls_1\n      -- See Note [Fork/Exec Windows]\n      gcc_paths <- getGCCPaths dflags os\n\n      lib_paths_env <- addEnvPaths \"LIBRARY_PATH\" lib_paths_base\n\n      maybePutStrLn dflags \"Search directories (user):\"\n      maybePutStr dflags (unlines $ map (\"  \"++) lib_paths_env)\n      maybePutStrLn dflags \"Search directories (gcc):\"\n      maybePutStr dflags (unlines $ map (\"  \"++) gcc_paths)\n\n      libspecs\n        <- mapM (locateLib hsc_env False lib_paths_env gcc_paths) minus_ls\n\n      -- (d) Link .o files from the command-line\n      classified_ld_inputs <- mapM (classifyLdInput dflags)\n                                [ f | FileOption _ f <- cmdline_ld_inputs ]\n\n      -- (e) Link any MacOS frameworks\n      let platform = targetPlatform dflags\n      let (framework_paths, frameworks) =\n            if platformUsesFrameworks platform\n             then (frameworkPaths dflags, cmdlineFrameworks dflags)\n              else ([],[])\n\n      -- Finally do (c),(d),(e)\n      let cmdline_lib_specs = catMaybes classified_ld_inputs\n                           ++ libspecs\n                           ++ map Framework frameworks\n      if null cmdline_lib_specs then return pls\n                                else do\n\n      -- Add directories to library search paths, this only has an effect\n      -- on Windows. On Unix OSes this function is a NOP.\n      let all_paths = let paths = takeDirectory (fst $ sPgm_c $ settings dflags)\n                                : framework_paths\n                               ++ lib_paths_base\n                               ++ [ takeDirectory dll | DLLPath dll <- libspecs ]\n                      in nub $ map normalise paths\n      let lib_paths = nub $ lib_paths_base ++ gcc_paths\n      all_paths_env <- addEnvPaths \"LD_LIBRARY_PATH\" all_paths\n      pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env\n\n      pls1 <- foldM (preloadLib hsc_env lib_paths framework_paths) pls\n                    cmdline_lib_specs\n      maybePutStr dflags \"final link ... \"\n      ok <- resolveObjs hsc_env\n\n      -- DLLs are loaded, reset the search paths\n      mapM_ (removeLibrarySearchPath hsc_env) $ reverse pathCache\n\n      if succeeded ok then maybePutStrLn dflags \"done\"\n      else throwGhcExceptionIO (ProgramError \"linking extra libraries/objects failed\")\n\n      return pls1\n\n{- Note [preload packages]\n\nWhy do we need to preload packages from the command line?  This is an\nexplanation copied from #2437:\n\nI tried to implement the suggestion from #3560, thinking it would be\neasy, but there are two reasons we link in packages eagerly when they\nare mentioned on the command line:\n\n  * So that you can link in extra object files or libraries that\n    depend on the packages. e.g. ghc -package foo -lbar where bar is a\n    C library that depends on something in foo. So we could link in\n    foo eagerly if and only if there are extra C libs or objects to\n    link in, but....\n\n  * Haskell code can depend on a C function exported by a package, and\n    the normal dependency tracking that TH uses can't know about these\n    dependencies. The test ghcilink004 relies on this, for example.\n\nI conclude that we need two -package flags: one that says \"this is a\npackage I want to make available\", and one that says \"this is a\npackage I want to link in eagerly\". Would that be too complicated for\nusers?\n-}\n\nclassifyLdInput :: DynFlags -> FilePath -> IO (Maybe LibrarySpec)\nclassifyLdInput dflags f\n  | isObjectFilename platform f = return (Just (Object f))\n  | isDynLibFilename platform f = return (Just (DLLPath f))\n  | otherwise          = do\n        putLogMsg dflags NoReason SevInfo noSrcSpan\n            (defaultUserStyle dflags)\n            (text (\"Warning: ignoring unrecognised input `\" ++ f ++ \"'\"))\n        return Nothing\n    where platform = targetPlatform dflags\n\npreloadLib\n  :: HscEnv -> [String] -> [String] -> PersistentLinkerState\n  -> LibrarySpec -> IO PersistentLinkerState\npreloadLib hsc_env lib_paths framework_paths pls lib_spec = do\n  maybePutStr dflags (\"Loading object \" ++ showLS lib_spec ++ \" ... \")\n  case lib_spec of\n    Object static_ish -> do\n      (b, pls1) <- preload_static lib_paths static_ish\n      maybePutStrLn dflags (if b  then \"done\" else \"not found\")\n      return pls1\n\n    Archive static_ish -> do\n      b <- preload_static_archive lib_paths static_ish\n      maybePutStrLn dflags (if b  then \"done\" else \"not found\")\n      return pls\n\n    DLL dll_unadorned -> do\n      maybe_errstr <- loadDLL hsc_env (mkSOName platform dll_unadorned)\n      case maybe_errstr of\n         Nothing -> maybePutStrLn dflags \"done\"\n         Just mm | platformOS platform /= OSDarwin ->\n           preloadFailed mm lib_paths lib_spec\n         Just mm | otherwise -> do\n           -- As a backup, on Darwin, try to also load a .so file\n           -- since (apparently) some things install that way - see\n           -- ticket #8770.\n           let libfile = (\"lib\" ++ dll_unadorned) <.> \"so\"\n           err2 <- loadDLL hsc_env libfile\n           case err2 of\n             Nothing -> maybePutStrLn dflags \"done\"\n             Just _  -> preloadFailed mm lib_paths lib_spec\n      return pls\n\n    DLLPath dll_path -> do\n      do maybe_errstr <- loadDLL hsc_env dll_path\n         case maybe_errstr of\n            Nothing -> maybePutStrLn dflags \"done\"\n            Just mm -> preloadFailed mm lib_paths lib_spec\n         return pls\n\n    Framework framework ->\n      if platformUsesFrameworks (targetPlatform dflags)\n      then do maybe_errstr <- loadFramework hsc_env framework_paths framework\n              case maybe_errstr of\n                 Nothing -> maybePutStrLn dflags \"done\"\n                 Just mm -> preloadFailed mm framework_paths lib_spec\n              return pls\n      else panic \"preloadLib Framework\"\n\n  where\n    dflags = hsc_dflags hsc_env\n\n    platform = targetPlatform dflags\n\n    preloadFailed :: String -> [String] -> LibrarySpec -> IO ()\n    preloadFailed sys_errmsg paths spec\n       = do maybePutStr dflags \"failed.\\n\"\n            throwGhcExceptionIO $\n              CmdLineError (\n                    \"user specified .o/.so/.DLL could not be loaded (\"\n                    ++ sys_errmsg ++ \")\\nWhilst trying to load:  \"\n                    ++ showLS spec ++ \"\\nAdditional directories searched:\"\n                    ++ (if null paths then \" (none)\" else\n                        intercalate \"\\n\" (map (\"   \"++) paths)))\n\n    -- Not interested in the paths in the static case.\n    preload_static _paths name\n       = do b <- doesFileExist name\n            if not b then return (False, pls)\n                     else if dynamicGhc\n                             then  do pls1 <- dynLoadObjs hsc_env pls [name]\n                                      return (True, pls1)\n                             else  do loadObj hsc_env name\n                                      return (True, pls)\n\n    preload_static_archive _paths name\n       = do b <- doesFileExist name\n            if not b then return False\n                     else do if dynamicGhc\n                                 then throwGhcExceptionIO $\n                                      CmdLineError dynamic_msg\n                                 else loadArchive hsc_env name\n                             return True\n      where\n        dynamic_msg = unlines\n          [ \"User-specified static library could not be loaded (\"\n            ++ name ++ \")\"\n          , \"Loading static libraries is not supported in this configuration.\"\n          , \"Try using a dynamic library instead.\"\n          ]\n\n\n{- **********************************************************************\n\n                        Link a byte-code expression\n\n  ********************************************************************* -}\n\n-- | Link a single expression, /including/ first linking packages and\n-- modules that this expression depends on.\n--\n-- Raises an IO exception ('ProgramError') if it can't find a compiled\n-- version of the dependents to link.\n--\nlinkExpr :: HscEnv -> SrcSpan -> UnlinkedBCO -> IO ForeignHValue\nlinkExpr hsc_env span root_ul_bco\n  = do {\n     -- Initialise the linker (if it's not been done already)\n   ; initDynLinker hsc_env\n\n     -- Take lock for the actual work.\n   ; modifyPLS $ \\pls0 -> do {\n\n     -- Link the packages and modules required\n   ; (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods\n   ; if failed ok then\n        throwGhcExceptionIO (ProgramError \"\")\n     else do {\n\n     -- Link the expression itself\n     let ie = itbl_env pls\n         ce = closure_env pls\n\n     -- Link the necessary packages and linkables\n\n   ; let nobreakarray = error \"no break array\"\n         bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)]\n   ; resolved <- linkBCO hsc_env ie ce bco_ix nobreakarray root_ul_bco\n   ; [root_hvref] <- createBCOs hsc_env [resolved]\n   ; fhv <- mkFinalizedHValue hsc_env root_hvref\n   ; return (pls, fhv)\n   }}}\n   where\n     free_names = uniqDSetToList (bcoFreeNames root_ul_bco)\n\n     needed_mods :: [Module]\n     needed_mods = [ nameModule n | n <- free_names,\n                     isExternalName n,      -- Names from other modules\n                     not (isWiredInName n)  -- Exclude wired-in names\n                   ]                        -- (see note below)\n        -- Exclude wired-in names because we may not have read\n        -- their interface files, so getLinkDeps will fail\n        -- All wired-in names are in the base package, which we link\n        -- by default, so we can safely ignore them here.\n\ndieWith :: DynFlags -> SrcSpan -> MsgDoc -> IO a\ndieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))\n\n\ncheckNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe FilePath)\ncheckNonStdWay dflags srcspan\n  | gopt Opt_ExternalInterpreter dflags = return Nothing\n    -- with -fexternal-interpreter we load the .o files, whatever way\n    -- they were built.  If they were built for a non-std way, then\n    -- we will use the appropriate variant of the iserv binary to load them.\n\n  | interpWays == haskellWays = return Nothing\n    -- Only if we are compiling with the same ways as GHC is built\n    -- with, can we dynamically load those object files. (see #3604)\n\n  | objectSuf dflags == normalObjectSuffix && not (null haskellWays)\n  = failNonStd dflags srcspan\n\n  | otherwise = return (Just (interpTag ++ \"o\"))\n  where\n    haskellWays = filter (not . wayRTSOnly) (ways dflags)\n    interpTag = case mkBuildTag interpWays of\n                  \"\" -> \"\"\n                  tag -> tag ++ \"_\"\n\nnormalObjectSuffix :: String\nnormalObjectSuffix = phaseInputExt StopLn\n\nfailNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath)\nfailNonStd dflags srcspan = dieWith dflags srcspan $\n  text \"Cannot load\" <+> compWay <+>\n     text \"objects when GHC is built\" <+> ghciWay $$\n  text \"To fix this, either:\" $$\n  text \"  (1) Use -fexternal-interpreter, or\" $$\n  text \"  (2) Build the program twice: once\" <+>\n                       ghciWay <> text \", and then\" $$\n  text \"      with\" <+> compWay <+>\n     text \"using -osuf to set a different object file suffix.\"\n    where compWay\n            | WayDyn `elem` ways dflags = text \"-dynamic\"\n            | WayProf `elem` ways dflags = text \"-prof\"\n            | otherwise = text \"normal\"\n          ghciWay\n            | dynamicGhc = text \"with -dynamic\"\n            | rtsIsProfiled = text \"with -prof\"\n            | otherwise = text \"the normal way\"\n\ngetLinkDeps :: HscEnv -> HomePackageTable\n            -> PersistentLinkerState\n            -> Maybe FilePath                   -- replace object suffices?\n            -> SrcSpan                          -- for error messages\n            -> [Module]                         -- If you need these\n            -> IO ([Linkable], [InstalledUnitId])     -- ... then link these first\n-- Fails with an IO exception if it can't find enough files\n\ngetLinkDeps hsc_env hpt pls replace_osuf span mods\n-- Find all the packages and linkables that a set of modules depends on\n = do {\n        -- 1.  Find the dependent home-pkg-modules/packages from each iface\n        -- (omitting modules from the interactive package, which is already linked)\n      ; (mods_s, pkgs_s) <- follow_deps (filterOut isInteractiveModule mods)\n                                        emptyUniqDSet emptyUniqDSet;\n\n      ; let {\n        -- 2.  Exclude ones already linked\n        --      Main reason: avoid findModule calls in get_linkable\n            mods_needed = mods_s `minusList` linked_mods     ;\n            pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;\n\n            linked_mods = map (moduleName.linkableModule)\n                                (objs_loaded pls ++ bcos_loaded pls)  }\n\n        -- 3.  For each dependent module, find its linkable\n        --     This will either be in the HPT or (in the case of one-shot\n        --     compilation) we may need to use maybe_getFileLinkable\n      ; let { osuf = objectSuf dflags }\n      ; lnks_needed <- mapM (get_linkable osuf) mods_needed\n\n      ; return (lnks_needed, pkgs_needed) }\n  where\n    dflags = hsc_dflags hsc_env\n    this_pkg = thisPackage dflags\n\n        -- The ModIface contains the transitive closure of the module dependencies\n        -- within the current package, *except* for boot modules: if we encounter\n        -- a boot module, we have to find its real interface and discover the\n        -- dependencies of that.  Hence we need to traverse the dependency\n        -- tree recursively.  See bug #936, testcase ghci/prog007.\n    follow_deps :: [Module]             -- modules to follow\n                -> UniqDSet ModuleName         -- accum. module dependencies\n                -> UniqDSet InstalledUnitId          -- accum. package dependencies\n                -> IO ([ModuleName], [InstalledUnitId]) -- result\n    follow_deps []     acc_mods acc_pkgs\n        = return (uniqDSetToList acc_mods, uniqDSetToList acc_pkgs)\n    follow_deps (mod:mods) acc_mods acc_pkgs\n        = do\n          mb_iface <- initIfaceCheck (text \"getLinkDeps\") hsc_env $\n                        loadInterface msg mod (ImportByUser False)\n          iface <- case mb_iface of\n                    Maybes.Failed err      -> throwGhcExceptionIO (ProgramError (showSDoc dflags err))\n                    Maybes.Succeeded iface -> return iface\n\n          when (mi_boot iface) $ link_boot_mod_error mod\n\n          let\n            pkg = moduleUnitId mod\n            deps  = mi_deps iface\n\n            pkg_deps = dep_pkgs deps\n            (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps)\n                    where is_boot (m,True)  = Left m\n                          is_boot (m,False) = Right m\n\n            boot_deps' = filter (not . (`elementOfUniqDSet` acc_mods)) boot_deps\n            acc_mods'  = addListToUniqDSet acc_mods (moduleName mod : mod_deps)\n            acc_pkgs'  = addListToUniqDSet acc_pkgs $ map fst pkg_deps\n          --\n          if pkg /= this_pkg\n             then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toInstalledUnitId pkg))\n             else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods)\n                              acc_mods' acc_pkgs'\n        where\n            msg = text \"need to link module\" <+> ppr mod <+>\n                  text \"due to use of Template Haskell\"\n\n\n    link_boot_mod_error mod =\n        throwGhcExceptionIO (ProgramError (showSDoc dflags (\n            text \"module\" <+> ppr mod <+>\n            text \"cannot be linked; it is only available as a boot module\")))\n\n    no_obj :: Outputable a => a -> IO b\n    no_obj mod = dieWith dflags span $\n                     text \"cannot find object file for module \" <>\n                        quotes (ppr mod) $$\n                     while_linking_expr\n\n    while_linking_expr = text \"while linking an interpreted expression\"\n\n        -- This one is a build-system bug\n\n    get_linkable osuf mod_name      -- A home-package module\n        | Just mod_info <- lookupHpt hpt mod_name\n        = adjust_linkable (Maybes.expectJust \"getLinkDeps\" (hm_linkable mod_info))\n        | otherwise\n        = do    -- It's not in the HPT because we are in one shot mode,\n                -- so use the Finder to get a ModLocation...\n             mb_stuff <- findHomeModule hsc_env mod_name\n             case mb_stuff of\n                  Found loc mod -> found loc mod\n                  _ -> no_obj mod_name\n        where\n            found loc mod = do {\n                -- ...and then find the linkable for it\n               mb_lnk <- findObjectLinkableMaybe mod loc ;\n               case mb_lnk of {\n                  Nothing  -> no_obj mod ;\n                  Just lnk -> adjust_linkable lnk\n              }}\n\n            adjust_linkable lnk\n                | Just new_osuf <- replace_osuf = do\n                        new_uls <- mapM (adjust_ul new_osuf)\n                                        (linkableUnlinked lnk)\n                        return lnk{ linkableUnlinked=new_uls }\n                | otherwise =\n                        return lnk\n\n            adjust_ul new_osuf (DotO file) = do\n                MASSERT(osuf `isSuffixOf` file)\n                let file_base = fromJust (stripExtension osuf file)\n                    new_file = file_base <.> new_osuf\n                ok <- doesFileExist new_file\n                if (not ok)\n                   then dieWith dflags span $\n                          text \"cannot find object file \"\n                                <> quotes (text new_file) $$ while_linking_expr\n                   else return (DotO new_file)\n            adjust_ul _ (DotA fp) = panic (\"adjust_ul DotA \" ++ show fp)\n            adjust_ul _ (DotDLL fp) = panic (\"adjust_ul DotDLL \" ++ show fp)\n            adjust_ul _ l@(BCOs {}) = return l\n\n\n\n{- **********************************************************************\n\n              Loading a Decls statement\n\n  ********************************************************************* -}\n\nlinkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO ()\nlinkDecls hsc_env span cbc@CompiledByteCode{..} = do\n    -- Initialise the linker (if it's not been done already)\n    initDynLinker hsc_env\n\n    -- Take lock for the actual work.\n    modifyPLS $ \\pls0 -> do\n\n    -- Link the packages and modules required\n    (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods\n    if failed ok\n      then throwGhcExceptionIO (ProgramError \"\")\n      else do\n\n    -- Link the expression itself\n    let ie = plusNameEnv (itbl_env pls) bc_itbls\n        ce = closure_env pls\n\n    -- Link the necessary packages and linkables\n    new_bindings <- linkSomeBCOs hsc_env ie ce [cbc]\n    nms_fhvs <- makeForeignNamedHValueRefs hsc_env new_bindings\n    let pls2 = pls { closure_env = extendClosureEnv ce nms_fhvs\n                   , itbl_env    = ie }\n    return (pls2, ())\n  where\n    free_names = uniqDSetToList $\n      foldr (unionUniqDSets . bcoFreeNames) emptyUniqDSet bc_bcos\n\n    needed_mods :: [Module]\n    needed_mods = [ nameModule n | n <- free_names,\n                    isExternalName n,       -- Names from other modules\n                    not (isWiredInName n)   -- Exclude wired-in names\n                  ]                         -- (see note below)\n    -- Exclude wired-in names because we may not have read\n    -- their interface files, so getLinkDeps will fail\n    -- All wired-in names are in the base package, which we link\n    -- by default, so we can safely ignore them here.\n\n{- **********************************************************************\n\n              Loading a single module\n\n  ********************************************************************* -}\n\nlinkModule :: HscEnv -> Module -> IO ()\nlinkModule hsc_env mod = do\n  initDynLinker hsc_env\n  modifyPLS_ $ \\pls -> do\n    (pls', ok) <- linkDependencies hsc_env pls noSrcSpan [mod]\n    if (failed ok) then throwGhcExceptionIO (ProgramError \"could not link module\")\n      else return pls'\n\n{- **********************************************************************\n\n                Link some linkables\n        The linkables may consist of a mixture of\n        byte-code modules and object modules\n\n  ********************************************************************* -}\n\nlinkModules :: HscEnv -> PersistentLinkerState -> [Linkable]\n            -> IO (PersistentLinkerState, SuccessFlag)\nlinkModules hsc_env pls linkables\n  = mask_ $ do  -- don't want to be interrupted by ^C in here\n\n        let (objs, bcos) = partition isObjectLinkable\n                              (concatMap partitionLinkable linkables)\n\n                -- Load objects first; they can't depend on BCOs\n        (pls1, ok_flag) <- dynLinkObjs hsc_env pls objs\n\n        if failed ok_flag then\n                return (pls1, Failed)\n          else do\n                pls2 <- dynLinkBCOs hsc_env pls1 bcos\n                return (pls2, Succeeded)\n\n\n-- HACK to support f-x-dynamic in the interpreter; no other purpose\npartitionLinkable :: Linkable -> [Linkable]\npartitionLinkable li\n   = let li_uls = linkableUnlinked li\n         li_uls_obj = filter isObject li_uls\n         li_uls_bco = filter isInterpretable li_uls\n     in\n         case (li_uls_obj, li_uls_bco) of\n            (_:_, _:_) -> [li {linkableUnlinked=li_uls_obj},\n                           li {linkableUnlinked=li_uls_bco}]\n            _ -> [li]\n\nfindModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable\nfindModuleLinkable_maybe lis mod\n   = case [LM time nm us | LM time nm us <- lis, nm == mod] of\n        []   -> Nothing\n        [li] -> Just li\n        _    -> pprPanic \"findModuleLinkable\" (ppr mod)\n\nlinkableInSet :: Linkable -> [Linkable] -> Bool\nlinkableInSet l objs_loaded =\n  case findModuleLinkable_maybe objs_loaded (linkableModule l) of\n        Nothing -> False\n        Just m  -> linkableTime l == linkableTime m\n\n\n{- **********************************************************************\n\n                The object-code linker\n\n  ********************************************************************* -}\n\ndynLinkObjs :: HscEnv -> PersistentLinkerState -> [Linkable]\n            -> IO (PersistentLinkerState, SuccessFlag)\ndynLinkObjs hsc_env pls objs = do\n        -- Load the object files and link them\n        let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs\n            pls1                     = pls { objs_loaded = objs_loaded' }\n            unlinkeds                = concatMap linkableUnlinked new_objs\n            wanted_objs              = map nameOfObject unlinkeds\n\n        if interpreterDynamic (hsc_dflags hsc_env)\n            then do pls2 <- dynLoadObjs hsc_env pls1 wanted_objs\n                    return (pls2, Succeeded)\n            else do mapM_ (loadObj hsc_env) wanted_objs\n\n                    -- Link them all together\n                    ok <- resolveObjs hsc_env\n\n                    -- If resolving failed, unload all our\n                    -- object modules and carry on\n                    if succeeded ok then do\n                            return (pls1, Succeeded)\n                      else do\n                            pls2 <- unload_wkr hsc_env [] pls1\n                            return (pls2, Failed)\n\n\ndynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath]\n            -> IO PersistentLinkerState\ndynLoadObjs _       pls []   = return pls\ndynLoadObjs hsc_env pls objs = do\n    let dflags = hsc_dflags hsc_env\n    let platform = targetPlatform dflags\n    let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ]\n    let minus_big_ls = [ lib | Option ('-':'L':lib) <- ldInputs dflags ]\n    (soFile, libPath , libName) <-\n      newTempLibName dflags TFL_CurrentModule (soExt platform)\n    let\n        dflags2 = dflags {\n                      -- We don't want the original ldInputs in\n                      -- (they're already linked in), but we do want\n                      -- to link against previous dynLoadObjs\n                      -- libraries if there were any, so that the linker\n                      -- can resolve dependencies when it loads this\n                      -- library.\n                      ldInputs =\n                           concatMap (\\l -> [ Option (\"-l\" ++ l) ])\n                                     (nub $ snd <$> temp_sos pls)\n                        ++ concatMap (\\lp -> [ Option (\"-L\" ++ lp)\n                                                    , Option \"-Xlinker\"\n                                                    , Option \"-rpath\"\n                                                    , Option \"-Xlinker\"\n                                                    , Option lp ])\n                                     (nub $ fst <$> temp_sos pls)\n                        ++ concatMap\n                             (\\lp ->\n                                 [ Option (\"-L\" ++ lp)\n                                 , Option \"-Xlinker\"\n                                 , Option \"-rpath\"\n                                 , Option \"-Xlinker\"\n                                 , Option lp\n                                 ])\n                             minus_big_ls\n                        -- See Note [-Xlinker -rpath vs -Wl,-rpath]\n                        ++ map (\\l -> Option (\"-l\" ++ l)) minus_ls,\n                      -- Add -l options and -L options from dflags.\n                      --\n                      -- When running TH for a non-dynamic way, we still\n                      -- need to make -l flags to link against the dynamic\n                      -- libraries, so we need to add WayDyn to ways.\n                      --\n                      -- Even if we're e.g. profiling, we still want\n                      -- the vanilla dynamic libraries, so we set the\n                      -- ways / build tag to be just WayDyn.\n                      ways = [WayDyn],\n                      buildTag = mkBuildTag [WayDyn],\n                      outputFile = Just soFile\n                  }\n    -- link all \"loaded packages\" so symbols in those can be resolved\n    -- Note: We are loading packages with local scope, so to see the\n    -- symbols in this link we must link all loaded packages again.\n    linkDynLib dflags2 objs (pkgs_loaded pls)\n\n    -- if we got this far, extend the lifetime of the library file\n    changeTempFilesLifetime dflags TFL_GhcSession [soFile]\n    m <- loadDLL hsc_env soFile\n    case m of\n        Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls }\n        Just err -> panic (\"Loading temp shared object failed: \" ++ err)\n\nrmDupLinkables :: [Linkable]    -- Already loaded\n               -> [Linkable]    -- New linkables\n               -> ([Linkable],  -- New loaded set (including new ones)\n                   [Linkable])  -- New linkables (excluding dups)\nrmDupLinkables already ls\n  = go already [] ls\n  where\n    go already extras [] = (already, extras)\n    go already extras (l:ls)\n        | linkableInSet l already = go already     extras     ls\n        | otherwise               = go (l:already) (l:extras) ls\n\n{- **********************************************************************\n\n                The byte-code linker\n\n  ********************************************************************* -}\n\n\ndynLinkBCOs :: HscEnv -> PersistentLinkerState -> [Linkable]\n            -> IO PersistentLinkerState\ndynLinkBCOs hsc_env pls bcos = do\n\n        let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos\n            pls1                     = pls { bcos_loaded = bcos_loaded' }\n            unlinkeds :: [Unlinked]\n            unlinkeds                = concatMap linkableUnlinked new_bcos\n\n            cbcs :: [CompiledByteCode]\n            cbcs      = map byteCodeOfObject unlinkeds\n\n\n            ies        = map bc_itbls cbcs\n            gce       = closure_env pls\n            final_ie  = foldr plusNameEnv (itbl_env pls) ies\n\n        names_and_refs <- linkSomeBCOs hsc_env final_ie gce cbcs\n\n        -- We only want to add the external ones to the ClosureEnv\n        let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs\n\n        -- Immediately release any HValueRefs we're not going to add\n        freeHValueRefs hsc_env (map snd to_drop)\n        -- Wrap finalizers on the ones we want to keep\n        new_binds <- makeForeignNamedHValueRefs hsc_env to_add\n\n        return pls1 { closure_env = extendClosureEnv gce new_binds,\n                      itbl_env    = final_ie }\n\n-- Link a bunch of BCOs and return references to their values\nlinkSomeBCOs :: HscEnv\n             -> ItblEnv\n             -> ClosureEnv\n             -> [CompiledByteCode]\n             -> IO [(Name,HValueRef)]\n                        -- The returned HValueRefs are associated 1-1 with\n                        -- the incoming unlinked BCOs.  Each gives the\n                        -- value of the corresponding unlinked BCO\n\nlinkSomeBCOs hsc_env ie ce mods = foldr fun do_link mods []\n where\n  fun CompiledByteCode{..} inner accum =\n    case bc_breaks of\n      Nothing -> inner ((panic \"linkSomeBCOs: no break array\", bc_bcos) : accum)\n      Just mb -> withForeignRef (modBreaks_flags mb) $ \\breakarray ->\n                   inner ((breakarray, bc_bcos) : accum)\n\n  do_link [] = return []\n  do_link mods = do\n    let flat = [ (breakarray, bco) | (breakarray, bcos) <- mods, bco <- bcos ]\n        names = map (unlinkedBCOName . snd) flat\n        bco_ix = mkNameEnv (zip names [0..])\n    resolved <- sequence [ linkBCO hsc_env ie ce bco_ix breakarray bco\n                         | (breakarray, bco) <- flat ]\n    hvrefs <- createBCOs hsc_env resolved\n    return (zip names hvrefs)\n\n-- | Useful to apply to the result of 'linkSomeBCOs'\nmakeForeignNamedHValueRefs\n  :: HscEnv -> [(Name,HValueRef)] -> IO [(Name,ForeignHValue)]\nmakeForeignNamedHValueRefs hsc_env bindings =\n  mapM (\\(n, hvref) -> (n,) <$> mkFinalizedHValue hsc_env hvref) bindings\n\n{- **********************************************************************\n\n                Unload some object modules\n\n  ********************************************************************* -}\n\n-- ---------------------------------------------------------------------------\n-- | Unloading old objects ready for a new compilation sweep.\n--\n-- The compilation manager provides us with a list of linkables that it\n-- considers \\\"stable\\\", i.e. won't be recompiled this time around.  For\n-- each of the modules current linked in memory,\n--\n--   * if the linkable is stable (and it's the same one -- the user may have\n--     recompiled the module on the side), we keep it,\n--\n--   * otherwise, we unload it.\n--\n--   * we also implicitly unload all temporary bindings at this point.\n--\nunload :: HscEnv\n       -> [Linkable] -- ^ The linkables to *keep*.\n       -> IO ()\nunload hsc_env linkables\n  = mask_ $ do -- mask, so we're safe from Ctrl-C in here\n\n        -- Initialise the linker (if it's not been done already)\n        initDynLinker hsc_env\n\n        new_pls\n            <- modifyPLS $ \\pls -> do\n                 pls1 <- unload_wkr hsc_env linkables pls\n                 return (pls1, pls1)\n\n        let dflags = hsc_dflags hsc_env\n        debugTraceMsg dflags 3 $\n          text \"unload: retaining objs\" <+> ppr (objs_loaded new_pls)\n        debugTraceMsg dflags 3 $\n          text \"unload: retaining bcos\" <+> ppr (bcos_loaded new_pls)\n        return ()\n\nunload_wkr :: HscEnv\n           -> [Linkable]                -- stable linkables\n           -> PersistentLinkerState\n           -> IO PersistentLinkerState\n-- Does the core unload business\n-- (the wrapper blocks exceptions and deals with the PLS get and put)\n\nunload_wkr hsc_env keep_linkables pls@PersistentLinkerState{..}  = do\n  -- NB. careful strictness here to avoid keeping the old PLS when\n  -- we're unloading some code.  -fghci-leak-check with the tests in\n  -- testsuite/ghci can detect space leaks here.\n\n  let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable keep_linkables\n\n      discard keep l = not (linkableInSet l keep)\n\n      (objs_to_unload, remaining_objs_loaded) =\n         partition (discard objs_to_keep) objs_loaded\n      (bcos_to_unload, remaining_bcos_loaded) =\n         partition (discard bcos_to_keep) bcos_loaded\n\n  mapM_ unloadObjs objs_to_unload\n  mapM_ unloadObjs bcos_to_unload\n\n  -- If we unloaded any object files at all, we need to purge the cache\n  -- of lookupSymbol results.\n  when (not (null (objs_to_unload ++\n                   filter (not . null . linkableObjs) bcos_to_unload))) $\n    purgeLookupSymbolCache hsc_env\n\n  let !bcos_retained = mkModuleSet $ map linkableModule remaining_bcos_loaded\n\n      -- Note that we want to remove all *local*\n      -- (i.e. non-isExternal) names too (these are the\n      -- temporary bindings from the command line).\n      keep_name (n,_) = isExternalName n &&\n                        nameModule n `elemModuleSet` bcos_retained\n\n      itbl_env'     = filterNameEnv keep_name itbl_env\n      closure_env'  = filterNameEnv keep_name closure_env\n\n      !new_pls = pls { itbl_env = itbl_env',\n                       closure_env = closure_env',\n                       bcos_loaded = remaining_bcos_loaded,\n                       objs_loaded = remaining_objs_loaded }\n\n  return new_pls\n  where\n    unloadObjs :: Linkable -> IO ()\n    unloadObjs lnk\n      | dynamicGhc = return ()\n        -- We don't do any cleanup when linking objects with the\n        -- dynamic linker.  Doing so introduces extra complexity for\n        -- not much benefit.\n      | otherwise\n      = mapM_ (unloadObj hsc_env) [f | DotO f <- linkableUnlinked lnk]\n                -- The components of a BCO linkable may contain\n                -- dot-o files.  Which is very confusing.\n                --\n                -- But the BCO parts can be unlinked just by\n                -- letting go of them (plus of course depopulating\n                -- the symbol table which is done in the main body)\n\n{- **********************************************************************\n\n                Loading packages\n\n  ********************************************************************* -}\n\ndata LibrarySpec\n   = Object FilePath    -- Full path name of a .o file, including trailing .o\n                        -- For dynamic objects only, try to find the object\n                        -- file in all the directories specified in\n                        -- v_Library_paths before giving up.\n\n   | Archive FilePath   -- Full path name of a .a file, including trailing .a\n\n   | DLL String         -- \"Unadorned\" name of a .DLL/.so\n                        --  e.g.    On unix     \"qt\"  denotes \"libqt.so\"\n                        --          On Windows  \"burble\"  denotes \"burble.DLL\" or \"libburble.dll\"\n                        --  loadDLL is platform-specific and adds the lib/.so/.DLL\n                        --  suffixes platform-dependently\n\n   | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library\n                        -- (ends with .dll or .so).\n\n   | Framework String   -- Only used for darwin, but does no harm\n\n-- If this package is already part of the GHCi binary, we'll already\n-- have the right DLLs for this package loaded, so don't try to\n-- load them again.\n--\n-- But on Win32 we must load them 'again'; doing so is a harmless no-op\n-- as far as the loader is concerned, but it does initialise the list\n-- of DLL handles that rts/Linker.c maintains, and that in turn is\n-- used by lookupSymbol.  So we must call addDLL for each library\n-- just to get the DLL handle into the list.\npartOfGHCi :: [PackageName]\npartOfGHCi\n | isWindowsHost || isDarwinHost = []\n | otherwise = map (PackageName . mkFastString)\n                   [\"base\", \"template-haskell\", \"editline\"]\n\nshowLS :: LibrarySpec -> String\nshowLS (Object nm)    = \"(static) \" ++ nm\nshowLS (Archive nm)   = \"(static archive) \" ++ nm\nshowLS (DLL nm)       = \"(dynamic) \" ++ nm\nshowLS (DLLPath nm)   = \"(dynamic) \" ++ nm\nshowLS (Framework nm) = \"(framework) \" ++ nm\n\n-- TODO: Make this type more precise\ntype LinkerUnitId = InstalledUnitId\n\n-- | Link exactly the specified packages, and their dependents (unless of\n-- course they are already linked).  The dependents are linked\n-- automatically, and it doesn't matter what order you specify the input\n-- packages.\n--\nlinkPackages :: HscEnv -> [LinkerUnitId] -> IO ()\n-- NOTE: in fact, since each module tracks all the packages it depends on,\n--       we don't really need to use the package-config dependencies.\n--\n-- However we do need the package-config stuff (to find aux libs etc),\n-- and following them lets us load libraries in the right order, which\n-- perhaps makes the error message a bit more localised if we get a link\n-- failure.  So the dependency walking code is still here.\n\nlinkPackages hsc_env new_pkgs = do\n  -- It's probably not safe to try to load packages concurrently, so we take\n  -- a lock.\n  initDynLinker hsc_env\n  modifyPLS_ $ \\pls -> do\n    linkPackages' hsc_env new_pkgs pls\n\nlinkPackages' :: HscEnv -> [LinkerUnitId] -> PersistentLinkerState\n             -> IO PersistentLinkerState\nlinkPackages' hsc_env new_pks pls = do\n    pkgs' <- link (pkgs_loaded pls) new_pks\n    return $! pls { pkgs_loaded = pkgs' }\n  where\n     dflags = hsc_dflags hsc_env\n\n     link :: [LinkerUnitId] -> [LinkerUnitId] -> IO [LinkerUnitId]\n     link pkgs new_pkgs =\n         foldM link_one pkgs new_pkgs\n\n     link_one pkgs new_pkg\n        | new_pkg `elem` pkgs   -- Already linked\n        = return pkgs\n\n        | Just pkg_cfg <- lookupInstalledPackage dflags new_pkg\n        = do {  -- Link dependents first\n               pkgs' <- link pkgs (depends pkg_cfg)\n                -- Now link the package itself\n             ; linkPackage hsc_env pkg_cfg\n             ; return (new_pkg : pkgs') }\n\n        | otherwise\n        = throwGhcExceptionIO (CmdLineError (\"unknown package: \" ++ unpackFS (installedUnitIdFS new_pkg)))\n\n\nlinkPackage :: HscEnv -> PackageConfig -> IO ()\nlinkPackage hsc_env pkg\n   = do\n        let dflags    = hsc_dflags hsc_env\n            platform  = targetPlatform dflags\n            is_dyn = interpreterDynamic dflags\n            dirs | is_dyn    = Packages.libraryDynDirs pkg\n                 | otherwise = Packages.libraryDirs pkg\n\n        let hs_libs   =  Packages.hsLibraries pkg\n            -- The FFI GHCi import lib isn't needed as\n            -- compiler/ghci/Linker.hs + rts/Linker.c link the\n            -- interpreted references to FFI to the compiled FFI.\n            -- We therefore filter it out so that we don't get\n            -- duplicate symbol errors.\n            hs_libs'  =  filter (\"HSffi\" /=) hs_libs\n\n        -- Because of slight differences between the GHC dynamic linker and\n        -- the native system linker some packages have to link with a\n        -- different list of libraries when using GHCi. Examples include: libs\n        -- that are actually gnu ld scripts, and the possibility that the .a\n        -- libs do not exactly match the .so/.dll equivalents. So if the\n        -- package file provides an \"extra-ghci-libraries\" field then we use\n        -- that instead of the \"extra-libraries\" field.\n            extra_libs =\n                      (if null (Packages.extraGHCiLibraries pkg)\n                            then Packages.extraLibraries pkg\n                            else Packages.extraGHCiLibraries pkg)\n                      ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]\n        -- See Note [Fork/Exec Windows]\n        gcc_paths <- getGCCPaths dflags (platformOS platform)\n        dirs_env <- addEnvPaths \"LIBRARY_PATH\" dirs\n\n        hs_classifieds\n           <- mapM (locateLib hsc_env True  dirs_env gcc_paths) hs_libs'\n        extra_classifieds\n           <- mapM (locateLib hsc_env False dirs_env gcc_paths) extra_libs\n        let classifieds = hs_classifieds ++ extra_classifieds\n\n        -- Complication: all the .so's must be loaded before any of the .o's.\n        let known_dlls = [ dll  | DLLPath dll    <- classifieds ]\n            dlls       = [ dll  | DLL dll        <- classifieds ]\n            objs       = [ obj  | Object obj     <- classifieds ]\n            archs      = [ arch | Archive arch   <- classifieds ]\n\n        -- Add directories to library search paths\n        let dll_paths  = map takeDirectory known_dlls\n            all_paths  = nub $ map normalise $ dll_paths ++ dirs\n        all_paths_env <- addEnvPaths \"LD_LIBRARY_PATH\" all_paths\n        pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env\n\n        maybePutStr dflags\n            (\"Loading package \" ++ sourcePackageIdString pkg ++ \" ... \")\n\n        -- See comments with partOfGHCi\n        when (packageName pkg `notElem` partOfGHCi) $ do\n            loadFrameworks hsc_env platform pkg\n            -- See Note [Crash early load_dyn and locateLib]\n            -- Crash early if can't load any of `known_dlls`\n            mapM_ (load_dyn hsc_env True) known_dlls\n            -- For remaining `dlls` crash early only when there is surely\n            -- no package's DLL around ... (not is_dyn)\n            mapM_ (load_dyn hsc_env (not is_dyn) . mkSOName platform) dlls\n\n        -- After loading all the DLLs, we can load the static objects.\n        -- Ordering isn't important here, because we do one final link\n        -- step to resolve everything.\n        mapM_ (loadObj hsc_env) objs\n        mapM_ (loadArchive hsc_env) archs\n\n        maybePutStr dflags \"linking ... \"\n        ok <- resolveObjs hsc_env\n\n        -- DLLs are loaded, reset the search paths\n        -- Import libraries will be loaded via loadArchive so only\n        -- reset the DLL search path after all archives are loaded\n        -- as well.\n        mapM_ (removeLibrarySearchPath hsc_env) $ reverse pathCache\n\n        if succeeded ok\n           then maybePutStrLn dflags \"done.\"\n           else let errmsg = \"unable to load package `\"\n                             ++ sourcePackageIdString pkg ++ \"'\"\n                 in throwGhcExceptionIO (InstallationError errmsg)\n\n{-\nNote [Crash early load_dyn and locateLib]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf a package is \"normal\" (exposes it's code from more than zero Haskell\nmodules, unlike e.g. that in ghcilink004) and is built \"dyn\" way, then\nit has it's code compiled and linked into the DLL, which GHCi linker picks\nwhen loading the package's code (see the big comment in the beginning of\n`locateLib`).\n\nWhen loading DLLs, GHCi linker simply calls the system's `dlopen` or\n`LoadLibrary` APIs. This is quite different from the case when GHCi linker\nloads an object file or static library. When loading an object file or static\nlibrary GHCi linker parses them and resolves all symbols \"manually\".\nThese object file or static library may reference some external symbols\ndefined in some external DLLs. And GHCi should know which these\nexternal DLLs are.\n\nBut when GHCi loads a DLL, it's the *system* linker who manages all\nthe necessary dependencies, and it is able to load this DLL not having\nany extra info. Thus we don't *have to* crash in this case even if we\nare unable to load any supposed dependencies explicitly.\n\nSuppose during GHCi session a client of the package wants to\n`foreign import` a symbol which isn't exposed by the package DLL, but\nis exposed by such an external (dependency) DLL.\nIf the DLL isn't *explicitly* loaded because `load_dyn` failed to do\nthis, then the client code eventually crashes because the GHCi linker\nisn't able to locate this symbol (GHCi linker maintains a list of\nexplicitly loaded DLLs it looks into when trying to find a symbol).\n\nThis is why we still should try to load all the dependency DLLs\neven though we know that the system linker loads them implicitly when\nloading the package DLL.\n\nWhy we still keep the `crash_early` opportunity then not allowing such\na permissive behaviour for any DLLs? Well, we, perhaps, improve a user\nexperience in some cases slightly.\n\nBut if it happens there exist other corner cases where our current\nusage of `crash_early` flag is overly restrictive, we may lift the\nrestriction very easily.\n-}\n\n-- we have already searched the filesystem; the strings passed to load_dyn\n-- can be passed directly to loadDLL.  They are either fully-qualified\n-- (\"/usr/lib/libfoo.so\"), or unqualified (\"libfoo.so\").  In the latter case,\n-- loadDLL is going to search the system paths to find the library.\nload_dyn :: HscEnv -> Bool -> FilePath -> IO ()\nload_dyn hsc_env crash_early dll = do\n  r <- loadDLL hsc_env dll\n  case r of\n    Nothing  -> return ()\n    Just err ->\n      if crash_early\n        then cmdLineErrorIO err\n        else let dflags = hsc_dflags hsc_env in\n          when (wopt Opt_WarnMissedExtraSharedLib dflags)\n            $ putLogMsg dflags\n                (Reason Opt_WarnMissedExtraSharedLib) SevWarning\n                  noSrcSpan (defaultUserStyle dflags)(note err)\n  where\n    note err = vcat $ map text\n      [ err\n      , \"It's OK if you don't want to use symbols from it directly.\"\n      , \"(the package DLL is loaded by the system linker\"\n      , \" which manages dependencies by itself).\" ]\n\nloadFrameworks :: HscEnv -> Platform -> PackageConfig -> IO ()\nloadFrameworks hsc_env platform pkg\n    = when (platformUsesFrameworks platform) $ mapM_ load frameworks\n  where\n    fw_dirs    = Packages.frameworkDirs pkg\n    frameworks = Packages.frameworks pkg\n\n    load fw = do  r <- loadFramework hsc_env fw_dirs fw\n                  case r of\n                    Nothing  -> return ()\n                    Just err -> cmdLineErrorIO (\"can't load framework: \"\n                                                ++ fw ++ \" (\" ++ err ++ \")\" )\n\n-- Try to find an object file for a given library in the given paths.\n-- If it isn't present, we assume that addDLL in the RTS can find it,\n-- which generally means that it should be a dynamic library in the\n-- standard system search path.\n-- For GHCi we tend to prefer dynamic libraries over static ones as\n-- they are easier to load and manage, have less overhead.\nlocateLib :: HscEnv -> Bool -> [FilePath] -> [FilePath] -> String\n          -> IO LibrarySpec\nlocateLib hsc_env is_hs lib_dirs gcc_dirs lib\n  | not is_hs\n    -- For non-Haskell libraries (e.g. gmp, iconv):\n    --   first look in library-dirs for a dynamic library (on User paths only)\n    --   (libfoo.so)\n    --   then  try looking for import libraries on Windows (on User paths only)\n    --   (.dll.a, .lib)\n    --   first look in library-dirs for a dynamic library (on GCC paths only)\n    --   (libfoo.so)\n    --   then  check for system dynamic libraries (e.g. kernel32.dll on windows)\n    --   then  try looking for import libraries on Windows (on GCC paths only)\n    --   (.dll.a, .lib)\n    --   then  look in library-dirs for a static library (libfoo.a)\n    --   then look in library-dirs and inplace GCC for a dynamic library (libfoo.so)\n    --   then  try looking for import libraries on Windows (.dll.a, .lib)\n    --   then  look in library-dirs and inplace GCC for a static library (libfoo.a)\n    --   then  try \"gcc --print-file-name\" to search gcc's search path\n    --       for a dynamic library (#5289)\n    --   otherwise, assume loadDLL can find it\n    --\n    --   The logic is a bit complicated, but the rationale behind it is that\n    --   loading a shared library for us is O(1) while loading an archive is\n    --   O(n). Loading an import library is also O(n) so in general we prefer\n    --   shared libraries because they are simpler and faster.\n    --\n  = findDll   user `orElse`\n    tryImpLib user `orElse`\n    findDll   gcc  `orElse`\n    findSysDll     `orElse`\n    tryImpLib gcc  `orElse`\n    findArchive    `orElse`\n    tryGcc         `orElse`\n    assumeDll\n\n  | loading_dynamic_hs_libs -- search for .so libraries first.\n  = findHSDll     `orElse`\n    findDynObject `orElse`\n    assumeDll\n\n  | otherwise\n    -- use HSfoo.{o,p_o} if it exists, otherwise fallback to libHSfoo{,_p}.a\n  = findObject  `orElse`\n    findArchive `orElse`\n    assumeDll\n\n   where\n     dflags = hsc_dflags hsc_env\n     dirs   = lib_dirs ++ gcc_dirs\n     gcc    = False\n     user   = True\n\n     obj_file\n       | is_hs && loading_profiled_hs_libs = lib <.> \"p_o\"\n       | otherwise = lib <.> \"o\"\n     dyn_obj_file = lib <.> \"dyn_o\"\n     arch_files = [ \"lib\" ++ lib ++ lib_tag <.> \"a\"\n                  , lib <.> \"a\" -- native code has no lib_tag\n                  , \"lib\" ++ lib, lib\n                  ]\n     lib_tag = if is_hs && loading_profiled_hs_libs then \"_p\" else \"\"\n\n     loading_profiled_hs_libs = interpreterProfiled dflags\n     loading_dynamic_hs_libs  = interpreterDynamic dflags\n\n     import_libs  = [ lib <.> \"lib\"           , \"lib\" ++ lib <.> \"lib\"\n                    , \"lib\" ++ lib <.> \"dll.a\", lib <.> \"dll.a\"\n                    ]\n\n     hs_dyn_lib_name = lib ++ '-':programName dflags ++ projectVersion dflags\n     hs_dyn_lib_file = mkHsSOName platform hs_dyn_lib_name\n\n     so_name     = mkSOName platform lib\n     lib_so_name = \"lib\" ++ so_name\n     dyn_lib_file = case (arch, os) of\n                             (ArchX86_64, OSSolaris2) -> \"64\" </> so_name\n                             _ -> so_name\n\n     findObject    = liftM (fmap Object)  $ findFile dirs obj_file\n     findDynObject = liftM (fmap Object)  $ findFile dirs dyn_obj_file\n     findArchive   = let local name = liftM (fmap Archive) $ findFile dirs name\n                     in  apply (map local arch_files)\n     findHSDll     = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file\n     findDll    re = let dirs' = if re == user then lib_dirs else gcc_dirs\n                     in liftM (fmap DLLPath) $ findFile dirs' dyn_lib_file\n     findSysDll    = fmap (fmap $ DLL . dropExtension . takeFileName) $\n                        findSystemLibrary hsc_env so_name\n     tryGcc        = let search   = searchForLibUsingGcc dflags\n                         dllpath  = liftM (fmap DLLPath)\n                         short    = dllpath $ search so_name lib_dirs\n                         full     = dllpath $ search lib_so_name lib_dirs\n                         gcc name = liftM (fmap Archive) $ search name lib_dirs\n                         files    = import_libs ++ arch_files\n                     in apply $ short : full : map gcc files\n     tryImpLib re = case os of\n                       OSMinGW32 ->\n                        let dirs' = if re == user then lib_dirs else gcc_dirs\n                            implib name = liftM (fmap Archive) $\n                                            findFile dirs' name\n                        in apply (map implib import_libs)\n                       _         -> return Nothing\n\n     assumeDll   = return (DLL lib)\n     infixr `orElse`\n     f `orElse` g = f >>= maybe g return\n\n     apply []     = return Nothing\n     apply (x:xs) = do x' <- x\n                       if isJust x'\n                          then return x'\n                          else apply xs\n\n     platform = targetPlatform dflags\n     arch = platformArch platform\n     os = platformOS platform\n\nsearchForLibUsingGcc :: DynFlags -> String -> [FilePath] -> IO (Maybe FilePath)\nsearchForLibUsingGcc dflags so dirs = do\n   -- GCC does not seem to extend the library search path (using -L) when using\n   -- --print-file-name. So instead pass it a new base location.\n   str <- askLd dflags (map (FileOption \"-B\") dirs\n                          ++ [Option \"--print-file-name\", Option so])\n   let file = case lines str of\n                []  -> \"\"\n                l:_ -> l\n   if (file == so)\n      then return Nothing\n      else do b <- doesFileExist file -- file could be a folder (see #16063)\n              return (if b then Just file else Nothing)\n\n-- | Retrieve the list of search directory GCC and the System use to find\n--   libraries and components. See Note [Fork/Exec Windows].\ngetGCCPaths :: DynFlags -> OS -> IO [FilePath]\ngetGCCPaths dflags os\n  = case os of\n      OSMinGW32 ->\n        do gcc_dirs <- getGccSearchDirectory dflags \"libraries\"\n           sys_dirs <- getSystemDirectories\n           return $ nub $ gcc_dirs ++ sys_dirs\n      _         -> return []\n\n-- | Cache for the GCC search directories as this can't easily change\n--   during an invocation of GHC. (Maybe with some env. variable but we'll)\n--   deal with that highly unlikely scenario then.\n{-# NOINLINE gccSearchDirCache #-}\ngccSearchDirCache :: IORef [(String, [String])]\ngccSearchDirCache = unsafePerformIO $ newIORef []\n\n-- Note [Fork/Exec Windows]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~\n-- fork/exec is expensive on Windows, for each time we ask GCC for a library we\n-- have to eat the cost of af least 3 of these: gcc -> real_gcc -> cc1.\n-- So instead get a list of location that GCC would search and use findDirs\n-- which hopefully is written in an optimized mannor to take advantage of\n-- caching. At the very least we remove the overhead of the fork/exec and waits\n-- which dominate a large percentage of startup time on Windows.\ngetGccSearchDirectory :: DynFlags -> String -> IO [FilePath]\ngetGccSearchDirectory dflags key = do\n    cache <- readIORef gccSearchDirCache\n    case lookup key cache of\n      Just x  -> return x\n      Nothing -> do\n        str <- askLd dflags [Option \"--print-search-dirs\"]\n        let line = dropWhile isSpace str\n            name = key ++ \": =\"\n        if null line\n          then return []\n          else do let val = split $ find name line\n                  dirs <- filterM doesDirectoryExist val\n                  modifyIORef' gccSearchDirCache ((key, dirs):)\n                  return val\n      where split :: FilePath -> [FilePath]\n            split r = case break (==';') r of\n                        (s, []    ) -> [s]\n                        (s, (_:xs)) -> s : split xs\n\n            find :: String -> String -> String\n            find r x = let lst = lines x\n                           val = filter (r `isPrefixOf`) lst\n                       in if null val\n                             then []\n                             else case break (=='=') (head val) of\n                                     (_ , [])    -> []\n                                     (_, (_:xs)) -> xs\n\n-- | Get a list of system search directories, this to alleviate pressure on\n-- the findSysDll function.\ngetSystemDirectories :: IO [FilePath]\n#if defined(mingw32_HOST_OS)\ngetSystemDirectories = fmap (:[]) getSystemDirectory\n#else\ngetSystemDirectories = return []\n#endif\n\n-- | Merge the given list of paths with those in the environment variable\n--   given. If the variable does not exist then just return the identity.\naddEnvPaths :: String -> [String] -> IO [String]\naddEnvPaths name list\n  = do -- According to POSIX (chapter 8.3) a zero-length prefix means current\n       -- working directory. Replace empty strings in the env variable with\n       -- `working_dir` (see also #14695).\n       working_dir <- getCurrentDirectory\n       values <- lookupEnv name\n       case values of\n         Nothing  -> return list\n         Just arr -> return $ list ++ splitEnv working_dir arr\n    where\n      splitEnv :: FilePath -> String -> [String]\n      splitEnv working_dir value =\n        case break (== envListSep) value of\n          (x, []    ) ->\n            [if null x then working_dir else x]\n          (x, (_:xs)) ->\n            (if null x then working_dir else x) : splitEnv working_dir xs\n#if defined(mingw32_HOST_OS)\n      envListSep = ';'\n#else\n      envListSep = ':'\n#endif\n\n-- ----------------------------------------------------------------------------\n-- Loading a dynamic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)\n\n-- Darwin / MacOS X only: load a framework\n-- a framework is a dynamic library packaged inside a directory of the same\n-- name. They are searched for in different paths than normal libraries.\nloadFramework :: HscEnv -> [FilePath] -> FilePath -> IO (Maybe String)\nloadFramework hsc_env extraPaths rootname\n   = do { either_dir <- tryIO getHomeDirectory\n        ; let homeFrameworkPath = case either_dir of\n                                  Left _ -> []\n                                  Right dir -> [dir </> \"Library/Frameworks\"]\n              ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths\n        ; mb_fwk <- findFile ps fwk_file\n        ; case mb_fwk of\n            Just fwk_path -> loadDLL hsc_env fwk_path\n            Nothing       -> return (Just \"not found\") }\n                -- Tried all our known library paths, but dlopen()\n                -- has no built-in paths for frameworks: give up\n   where\n     fwk_file = rootname <.> \"framework\" </> rootname\n        -- sorry for the hardcoded paths, I hope they won't change anytime soon:\n     defaultFrameworkPaths = [\"/Library/Frameworks\", \"/System/Library/Frameworks\"]\n\n{- **********************************************************************\n\n                Helper functions\n\n  ********************************************************************* -}\n\nmaybePutStr :: DynFlags -> String -> IO ()\nmaybePutStr dflags s\n    = when (verbosity dflags > 1) $\n          putLogMsg dflags\n              NoReason\n              SevInteractive\n              noSrcSpan\n              (defaultUserStyle dflags)\n              (text s)\n\nmaybePutStrLn :: DynFlags -> String -> IO ()\nmaybePutStrLn dflags s = maybePutStr dflags (s ++ \"\\n\")\n", "num_lines": 1694}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-}\n\n-----------------------------------------------------------------------------\n--\n-- GHC Interactive support for inspecting arbitrary closures at runtime\n--\n-- Pepe Iborra (supported by Google SoC) 2006\n--\n-----------------------------------------------------------------------------\nmodule RtClosureInspect(\n     -- * Entry points and types\n     cvObtainTerm,\n     cvReconstructType,\n     improveRTTIType,\n     Term(..),\n\n     -- * Utils\n     isFullyEvaluatedTerm,\n     termType, mapTermType, termTyCoVars,\n     foldTerm, TermFold(..),\n     cPprTerm, cPprTermBase,\n\n     constrClosToName -- exported to use in test T4891\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport GHCi\nimport GHCi.RemoteTypes\nimport HscTypes\n\nimport DataCon\nimport Type\nimport RepType\nimport qualified Unify as U\nimport Var\nimport TcRnMonad\nimport TcType\nimport TcMType\nimport TcHsSyn ( zonkTcTypeToTypeX, mkEmptyZonkEnv, ZonkFlexi( RuntimeUnkFlexi ) )\nimport TcUnify\nimport TcEnv\n\nimport TyCon\nimport Name\nimport OccName\nimport Module\nimport IfaceEnv\nimport Util\nimport VarSet\nimport BasicTypes       ( Boxity(..) )\nimport TysPrim\nimport PrelNames\nimport TysWiredIn\nimport DynFlags\nimport Outputable as Ppr\nimport GHC.Char\nimport GHC.Exts.Heap\nimport SMRep ( roundUpTo )\n\nimport Control.Monad\nimport Data.Maybe\nimport Data.List\n#if defined(INTEGER_GMP)\nimport GHC.Exts\nimport Data.Array.Base\nimport GHC.Integer.GMP.Internals\n#elif defined(INTEGER_SIMPLE)\nimport GHC.Exts\nimport GHC.Integer.Simple.Internals\n#endif\nimport qualified Data.Sequence as Seq\nimport Data.Sequence (viewl, ViewL(..))\nimport Foreign\nimport System.IO.Unsafe\n\n\n---------------------------------------------\n-- * A representation of semi evaluated Terms\n---------------------------------------------\n\ndata Term = Term { ty        :: RttiType\n                 , dc        :: Either String DataCon\n                               -- Carries a text representation if the datacon is\n                               -- not exported by the .hi file, which is the case\n                               -- for private constructors in -O0 compiled libraries\n                 , val       :: ForeignHValue\n                 , subTerms  :: [Term] }\n\n          | Prim { ty        :: RttiType\n                 , valRaw    :: [Word] }\n\n          | Suspension { ctype    :: ClosureType\n                       , ty       :: RttiType\n                       , val      :: ForeignHValue\n                       , bound_to :: Maybe Name   -- Useful for printing\n                       }\n          | NewtypeWrap{       -- At runtime there are no newtypes, and hence no\n                               -- newtype constructors. A NewtypeWrap is just a\n                               -- made-up tag saying \"heads up, there used to be\n                               -- a newtype constructor here\".\n                         ty           :: RttiType\n                       , dc           :: Either String DataCon\n                       , wrapped_term :: Term }\n          | RefWrap    {       -- The contents of a reference\n                         ty           :: RttiType\n                       , wrapped_term :: Term }\n\ntermType :: Term -> RttiType\ntermType t = ty t\n\nisFullyEvaluatedTerm :: Term -> Bool\nisFullyEvaluatedTerm Term {subTerms=tt} = all isFullyEvaluatedTerm tt\nisFullyEvaluatedTerm Prim {}            = True\nisFullyEvaluatedTerm NewtypeWrap{wrapped_term=t} = isFullyEvaluatedTerm t\nisFullyEvaluatedTerm RefWrap{wrapped_term=t}     = isFullyEvaluatedTerm t\nisFullyEvaluatedTerm _                  = False\n\ninstance Outputable (Term) where\n ppr t | Just doc <- cPprTerm cPprTermBase t = doc\n       | otherwise = panic \"Outputable Term instance\"\n\n----------------------------------------\n-- Runtime Closure information functions\n----------------------------------------\n\nisThunk :: GenClosure a -> Bool\nisThunk ThunkClosure{} = True\nisThunk APClosure{} = True\nisThunk APStackClosure{} = True\nisThunk _             = False\n\n-- Lookup the name in a constructor closure\nconstrClosToName :: HscEnv -> GenClosure a -> IO (Either String Name)\nconstrClosToName hsc_env ConstrClosure{pkg=pkg,modl=mod,name=occ} = do\n   let occName = mkOccName OccName.dataName occ\n       modName = mkModule (stringToUnitId pkg) (mkModuleName mod)\n   Right `fmap` lookupOrigIO hsc_env modName occName\nconstrClosToName _hsc_env clos =\n   return (Left (\"conClosToName: Expected ConstrClosure, got \" ++ show (fmap (const ()) clos)))\n\n-----------------------------------\n-- * Traversals for Terms\n-----------------------------------\ntype TermProcessor a b = RttiType -> Either String DataCon -> ForeignHValue -> [a] -> b\n\ndata TermFold a = TermFold { fTerm        :: TermProcessor a a\n                           , fPrim        :: RttiType -> [Word] -> a\n                           , fSuspension  :: ClosureType -> RttiType -> ForeignHValue\n                                            -> Maybe Name -> a\n                           , fNewtypeWrap :: RttiType -> Either String DataCon\n                                            -> a -> a\n                           , fRefWrap     :: RttiType -> a -> a\n                           }\n\n\ndata TermFoldM m a =\n                   TermFoldM {fTermM        :: TermProcessor a (m a)\n                            , fPrimM        :: RttiType -> [Word] -> m a\n                            , fSuspensionM  :: ClosureType -> RttiType -> ForeignHValue\n                                             -> Maybe Name -> m a\n                            , fNewtypeWrapM :: RttiType -> Either String DataCon\n                                            -> a -> m a\n                            , fRefWrapM     :: RttiType -> a -> m a\n                           }\n\nfoldTerm :: TermFold a -> Term -> a\nfoldTerm tf (Term ty dc v tt) = fTerm tf ty dc v (map (foldTerm tf) tt)\nfoldTerm tf (Prim ty    v   ) = fPrim tf ty v\nfoldTerm tf (Suspension ct ty v b) = fSuspension tf ct ty v b\nfoldTerm tf (NewtypeWrap ty dc t)  = fNewtypeWrap tf ty dc (foldTerm tf t)\nfoldTerm tf (RefWrap ty t)         = fRefWrap tf ty (foldTerm tf t)\n\n\nfoldTermM :: Monad m => TermFoldM m a -> Term -> m a\nfoldTermM tf (Term ty dc v tt) = mapM (foldTermM tf) tt >>= fTermM tf ty dc v\nfoldTermM tf (Prim ty    v   ) = fPrimM tf ty v\nfoldTermM tf (Suspension ct ty v b) = fSuspensionM tf ct ty v b\nfoldTermM tf (NewtypeWrap ty dc t)  = foldTermM tf t >>=  fNewtypeWrapM tf ty dc\nfoldTermM tf (RefWrap ty t)         = foldTermM tf t >>= fRefWrapM tf ty\n\nidTermFold :: TermFold Term\nidTermFold = TermFold {\n              fTerm = Term,\n              fPrim = Prim,\n              fSuspension  = Suspension,\n              fNewtypeWrap = NewtypeWrap,\n              fRefWrap = RefWrap\n                      }\n\nmapTermType :: (RttiType -> Type) -> Term -> Term\nmapTermType f = foldTerm idTermFold {\n          fTerm       = \\ty dc hval tt -> Term (f ty) dc hval tt,\n          fSuspension = \\ct ty hval n ->\n                          Suspension ct (f ty) hval n,\n          fNewtypeWrap= \\ty dc t -> NewtypeWrap (f ty) dc t,\n          fRefWrap    = \\ty t -> RefWrap (f ty) t}\n\nmapTermTypeM :: Monad m =>  (RttiType -> m Type) -> Term -> m Term\nmapTermTypeM f = foldTermM TermFoldM {\n          fTermM       = \\ty dc hval tt -> f ty >>= \\ty' -> return $ Term ty'  dc hval tt,\n          fPrimM       = (return.) . Prim,\n          fSuspensionM = \\ct ty hval n ->\n                          f ty >>= \\ty' -> return $ Suspension ct ty' hval n,\n          fNewtypeWrapM= \\ty dc t -> f ty >>= \\ty' -> return $ NewtypeWrap ty' dc t,\n          fRefWrapM    = \\ty t -> f ty >>= \\ty' -> return $ RefWrap ty' t}\n\ntermTyCoVars :: Term -> TyCoVarSet\ntermTyCoVars = foldTerm TermFold {\n            fTerm       = \\ty _ _ tt   ->\n                          tyCoVarsOfType ty `unionVarSet` concatVarEnv tt,\n            fSuspension = \\_ ty _ _ -> tyCoVarsOfType ty,\n            fPrim       = \\ _ _ -> emptyVarSet,\n            fNewtypeWrap= \\ty _ t -> tyCoVarsOfType ty `unionVarSet` t,\n            fRefWrap    = \\ty t -> tyCoVarsOfType ty `unionVarSet` t}\n    where concatVarEnv = foldr unionVarSet emptyVarSet\n\n----------------------------------\n-- Pretty printing of terms\n----------------------------------\n\ntype Precedence        = Int\ntype TermPrinterM m    = Precedence -> Term -> m SDoc\n\napp_prec,cons_prec, max_prec ::Int\nmax_prec  = 10\napp_prec  = max_prec\ncons_prec = 5 -- TODO Extract this info from GHC itself\n\npprTermM, ppr_termM, pprNewtypeWrap :: Monad m => TermPrinterM m -> TermPrinterM m\npprTermM y p t = pprDeeper `liftM` ppr_termM y p t\n\nppr_termM y p Term{dc=Left dc_tag, subTerms=tt} = do\n  tt_docs <- mapM (y app_prec) tt\n  return $ cparen (not (null tt) && p >= app_prec)\n                  (text dc_tag <+> pprDeeperList fsep tt_docs)\n\nppr_termM y p Term{dc=Right dc, subTerms=tt}\n{-  | dataConIsInfix dc, (t1:t2:tt') <- tt  --TODO fixity\n  = parens (ppr_term1 True t1 <+> ppr dc <+> ppr_term1 True ppr t2)\n    <+> hsep (map (ppr_term1 True) tt)\n-} -- TODO Printing infix constructors properly\n  = do { tt_docs' <- mapM (y app_prec) tt\n       ; return $ ifPprDebug (show_tm tt_docs')\n                             (show_tm (dropList (dataConTheta dc) tt_docs'))\n                  -- Don't show the dictionary arguments to\n                  -- constructors unless -dppr-debug is on\n       }\n  where\n    show_tm tt_docs\n      | null tt_docs = ppr dc\n      | otherwise    = cparen (p >= app_prec) $\n                       sep [ppr dc, nest 2 (pprDeeperList fsep tt_docs)]\n\nppr_termM y p t@NewtypeWrap{} = pprNewtypeWrap y p t\nppr_termM y p RefWrap{wrapped_term=t}  = do\n  contents <- y app_prec t\n  return$ cparen (p >= app_prec) (text \"GHC.Prim.MutVar#\" <+> contents)\n  -- The constructor name is wired in here ^^^ for the sake of simplicity.\n  -- I don't think mutvars are going to change in a near future.\n  -- In any case this is solely a presentation matter: MutVar# is\n  -- a datatype with no constructors, implemented by the RTS\n  -- (hence there is no way to obtain a datacon and print it).\nppr_termM _ _ t = ppr_termM1 t\n\n\nppr_termM1 :: Monad m => Term -> m SDoc\nppr_termM1 Prim{valRaw=words, ty=ty} =\n    return $ repPrim (tyConAppTyCon ty) words\nppr_termM1 Suspension{ty=ty, bound_to=Nothing} =\n    return (char '_' <+> whenPprDebug (text \"::\" <> ppr ty))\nppr_termM1 Suspension{ty=ty, bound_to=Just n}\n--  | Just _ <- splitFunTy_maybe ty = return$ ptext (sLit(\"<function>\")\n  | otherwise = return$ parens$ ppr n <> text \"::\" <> ppr ty\nppr_termM1 Term{}        = panic \"ppr_termM1 - Term\"\nppr_termM1 RefWrap{}     = panic \"ppr_termM1 - RefWrap\"\nppr_termM1 NewtypeWrap{} = panic \"ppr_termM1 - NewtypeWrap\"\n\npprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t}\n  | Just (tc,_) <- tcSplitTyConApp_maybe ty\n  , ASSERT(isNewTyCon tc) True\n  , Just new_dc <- tyConSingleDataCon_maybe tc = do\n             real_term <- y max_prec t\n             return $ cparen (p >= app_prec) (ppr new_dc <+> real_term)\npprNewtypeWrap _ _ _ = panic \"pprNewtypeWrap\"\n\n-------------------------------------------------------\n-- Custom Term Pretty Printers\n-------------------------------------------------------\n\n-- We can want to customize the representation of a\n--  term depending on its type.\n-- However, note that custom printers have to work with\n--  type representations, instead of directly with types.\n-- We cannot use type classes here, unless we employ some\n--  typerep trickery (e.g. Weirich's RepLib tricks),\n--  which I didn't. Therefore, this code replicates a lot\n--  of what type classes provide for free.\n\ntype CustomTermPrinter m = TermPrinterM m\n                         -> [Precedence -> Term -> (m (Maybe SDoc))]\n\n-- | Takes a list of custom printers with a explicit recursion knot and a term,\n-- and returns the output of the first successful printer, or the default printer\ncPprTerm :: Monad m => CustomTermPrinter m -> Term -> m SDoc\ncPprTerm printers_ = go 0 where\n  printers = printers_ go\n  go prec t = do\n    let default_ = Just `liftM` pprTermM go prec t\n        mb_customDocs = [pp prec t | pp <- printers] ++ [default_]\n    mdoc <- firstJustM mb_customDocs\n    case mdoc of\n      Nothing -> panic \"cPprTerm\"\n      Just doc -> return $ cparen (prec>app_prec+1) doc\n\n  firstJustM (mb:mbs) = mb >>= maybe (firstJustM mbs) (return . Just)\n  firstJustM [] = return Nothing\n\n-- Default set of custom printers. Note that the recursion knot is explicit\ncPprTermBase :: forall m. Monad m => CustomTermPrinter m\ncPprTermBase y =\n  [ ifTerm (isTupleTy.ty) (\\_p -> liftM (parens . hcat . punctuate comma)\n                                      . mapM (y (-1))\n                                      . subTerms)\n  , ifTerm (\\t -> isTyCon listTyCon (ty t) && subTerms t `lengthIs` 2)\n           ppr_list\n  , ifTerm' (isTyCon intTyCon    . ty) ppr_int\n  , ifTerm' (isTyCon charTyCon   . ty) ppr_char\n  , ifTerm' (isTyCon floatTyCon  . ty) ppr_float\n  , ifTerm' (isTyCon doubleTyCon . ty) ppr_double\n  , ifTerm' (isIntegerTy         . ty) ppr_integer\n  ]\n where\n   ifTerm :: (Term -> Bool)\n          -> (Precedence -> Term -> m SDoc)\n          -> Precedence -> Term -> m (Maybe SDoc)\n   ifTerm pred f = ifTerm' pred (\\prec t -> Just <$> f prec t)\n\n   ifTerm' :: (Term -> Bool)\n          -> (Precedence -> Term -> m (Maybe SDoc))\n          -> Precedence -> Term -> m (Maybe SDoc)\n   ifTerm' pred f prec t@Term{}\n       | pred t    = f prec t\n   ifTerm' _ _ _ _  = return Nothing\n\n   isTupleTy ty    = fromMaybe False $ do\n     (tc,_) <- tcSplitTyConApp_maybe ty\n     return (isBoxedTupleTyCon tc)\n\n   isTyCon a_tc ty = fromMaybe False $ do\n     (tc,_) <- tcSplitTyConApp_maybe ty\n     return (a_tc == tc)\n\n   isIntegerTy ty = fromMaybe False $ do\n     (tc,_) <- tcSplitTyConApp_maybe ty\n     return (tyConName tc == integerTyConName)\n\n   ppr_int, ppr_char, ppr_float, ppr_double\n      :: Precedence -> Term -> m (Maybe SDoc)\n   ppr_int _ Term{subTerms=[Prim{valRaw=[w]}]} =\n      return (Just (Ppr.int (fromIntegral w)))\n   ppr_int _ _ = return Nothing\n\n   ppr_char _ Term{subTerms=[Prim{valRaw=[w]}]} =\n      return (Just (Ppr.pprHsChar (chr (fromIntegral w))))\n   ppr_char _ _ = return Nothing\n\n   ppr_float   _ Term{subTerms=[Prim{valRaw=[w]}]} = do\n      let f = unsafeDupablePerformIO $\n                alloca $ \\p -> poke p w >> peek (castPtr p)\n      return (Just (Ppr.float f))\n   ppr_float _ _ = return Nothing\n\n   ppr_double  _ Term{subTerms=[Prim{valRaw=[w]}]} = do\n      let f = unsafeDupablePerformIO $\n                alloca $ \\p -> poke p w >> peek (castPtr p)\n      return (Just (Ppr.double f))\n   -- let's assume that if we get two words, we're on a 32-bit\n   -- machine. There's no good way to get a DynFlags to check the word\n   -- size here.\n   ppr_double  _ Term{subTerms=[Prim{valRaw=[w1,w2]}]} = do\n      let f = unsafeDupablePerformIO $\n                alloca $ \\p -> do\n                  poke p (fromIntegral w1 :: Word32)\n                  poke (p `plusPtr` 4) (fromIntegral w2 :: Word32)\n                  peek (castPtr p)\n      return (Just (Ppr.double f))\n   ppr_double _ _ = return Nothing\n\n   ppr_integer :: Precedence -> Term -> m (Maybe SDoc)\n#if defined(INTEGER_GMP)\n   -- Reconstructing Integers is a bit of a pain. This depends deeply\n   -- on the integer-gmp representation, so it'll break if that\n   -- changes (but there are several tests in\n   -- tests/ghci.debugger/scripts that will tell us if this is wrong).\n   --\n   --   data Integer\n   --     = S# Int#\n   --     | Jp# {-# UNPACK #-} !BigNat\n   --     | Jn# {-# UNPACK #-} !BigNat\n   --\n   --   data BigNat = BN# ByteArray#\n   --\n   ppr_integer _ Term{subTerms=[Prim{valRaw=[W# w]}]} =\n      return (Just (Ppr.integer (S# (word2Int# w))))\n   ppr_integer _ Term{dc=Right con,\n                      subTerms=[Term{subTerms=[Prim{valRaw=ws}]}]} = do\n      -- We don't need to worry about sizes that are not an integral\n      -- number of words, because luckily GMP uses arrays of words\n      -- (see GMP_LIMB_SHIFT).\n      let\n        !(UArray _ _ _ arr#) = listArray (0,length ws-1) ws\n        constr\n          | \"Jp#\" <- getOccString (dataConName con) = Jp#\n          | otherwise = Jn#\n      return (Just (Ppr.integer (constr (BN# arr#))))\n#elif defined(INTEGER_SIMPLE)\n   -- As with the GMP case, this depends deeply on the integer-simple\n   -- representation.\n   --\n   -- @\n   -- data Integer = Positive !Digits | Negative !Digits | Naught\n   --\n   -- data Digits = Some !Word# !Digits\n   --             | None\n   -- @\n   --\n   -- NB: the above has some type synonyms expanded out for the sake of brevity\n   ppr_integer _ Term{subTerms=[]} =\n      return (Just (Ppr.integer Naught))\n   ppr_integer _ Term{dc=Right con, subTerms=[digitTerm]}\n        | Just digits <- get_digits digitTerm\n        = return (Just (Ppr.integer (constr digits)))\n      where\n        get_digits :: Term -> Maybe Digits\n        get_digits Term{subTerms=[]} = Just None\n        get_digits Term{subTerms=[Prim{valRaw=[W# w]},t]}\n          = Some w <$> get_digits t\n        get_digits _ = Nothing\n\n        constr\n          | \"Positive\" <- getOccString (dataConName con) = Positive\n          | otherwise = Negative\n#endif\n   ppr_integer _ _ = return Nothing\n\n   --Note pprinting of list terms is not lazy\n   ppr_list :: Precedence -> Term -> m SDoc\n   ppr_list p (Term{subTerms=[h,t]}) = do\n       let elems      = h : getListTerms t\n           isConsLast = not (termType (last elems) `eqType` termType h)\n           is_string  = all (isCharTy . ty) elems\n           chars = [ chr (fromIntegral w)\n                   | Term{subTerms=[Prim{valRaw=[w]}]} <- elems ]\n\n       print_elems <- mapM (y cons_prec) elems\n       if is_string\n        then return (Ppr.doubleQuotes (Ppr.text chars))\n        else if isConsLast\n        then return $ cparen (p >= cons_prec)\n                    $ pprDeeperList fsep\n                    $ punctuate (space<>colon) print_elems\n        else return $ brackets\n                    $ pprDeeperList fcat\n                    $ punctuate comma print_elems\n\n        where getListTerms Term{subTerms=[h,t]} = h : getListTerms t\n              getListTerms Term{subTerms=[]}    = []\n              getListTerms t@Suspension{}       = [t]\n              getListTerms t = pprPanic \"getListTerms\" (ppr t)\n   ppr_list _ _ = panic \"doList\"\n\n\nrepPrim :: TyCon -> [Word] -> SDoc\nrepPrim t = rep where\n   rep x\n    -- Char# uses native machine words, whereas Char's Storable instance uses\n    -- Int32, so we have to read it as an Int.\n    | t == charPrimTyCon             = text $ show (chr (build x :: Int))\n    | t == intPrimTyCon              = text $ show (build x :: Int)\n    | t == wordPrimTyCon             = text $ show (build x :: Word)\n    | t == floatPrimTyCon            = text $ show (build x :: Float)\n    | t == doublePrimTyCon           = text $ show (build x :: Double)\n    | t == int32PrimTyCon            = text $ show (build x :: Int32)\n    | t == word32PrimTyCon           = text $ show (build x :: Word32)\n    | t == int64PrimTyCon            = text $ show (build x :: Int64)\n    | t == word64PrimTyCon           = text $ show (build x :: Word64)\n    | t == addrPrimTyCon             = text $ show (nullPtr `plusPtr` build x)\n    | t == stablePtrPrimTyCon        = text \"<stablePtr>\"\n    | t == stableNamePrimTyCon       = text \"<stableName>\"\n    | t == statePrimTyCon            = text \"<statethread>\"\n    | t == proxyPrimTyCon            = text \"<proxy>\"\n    | t == realWorldTyCon            = text \"<realworld>\"\n    | t == threadIdPrimTyCon         = text \"<ThreadId>\"\n    | t == weakPrimTyCon             = text \"<Weak>\"\n    | t == arrayPrimTyCon            = text \"<array>\"\n    | t == smallArrayPrimTyCon       = text \"<smallArray>\"\n    | t == byteArrayPrimTyCon        = text \"<bytearray>\"\n    | t == mutableArrayPrimTyCon     = text \"<mutableArray>\"\n    | t == smallMutableArrayPrimTyCon = text \"<smallMutableArray>\"\n    | t == mutableByteArrayPrimTyCon = text \"<mutableByteArray>\"\n    | t == mutVarPrimTyCon           = text \"<mutVar>\"\n    | t == mVarPrimTyCon             = text \"<mVar>\"\n    | t == tVarPrimTyCon             = text \"<tVar>\"\n    | otherwise                      = char '<' <> ppr t <> char '>'\n    where build ww = unsafePerformIO $ withArray ww (peek . castPtr)\n--   This ^^^ relies on the representation of Haskell heap values being\n--   the same as in a C array.\n\n-----------------------------------\n-- Type Reconstruction\n-----------------------------------\n{-\nType Reconstruction is type inference done on heap closures.\nThe algorithm walks the heap generating a set of equations, which\nare solved with syntactic unification.\nA type reconstruction equation looks like:\n\n  <datacon reptype>  =  <actual heap contents>\n\nThe full equation set is generated by traversing all the subterms, starting\nfrom a given term.\n\nThe only difficult part is that newtypes are only found in the lhs of equations.\nRight hand sides are missing them. We can either (a) drop them from the lhs, or\n(b) reconstruct them in the rhs when possible.\n\nThe function congruenceNewtypes takes a shot at (b)\n-}\n\n\n-- A (non-mutable) tau type containing\n-- existentially quantified tyvars.\n--    (since GHC type language currently does not support\n--     existentials, we leave these variables unquantified)\ntype RttiType = Type\n\n-- An incomplete type as stored in GHCi:\n--  no polymorphism: no quantifiers & all tyvars are skolem.\ntype GhciType = Type\n\n\n-- The Type Reconstruction monad\n--------------------------------\ntype TR a = TcM a\n\nrunTR :: HscEnv -> TR a -> IO a\nrunTR hsc_env thing = do\n  mb_val <- runTR_maybe hsc_env thing\n  case mb_val of\n    Nothing -> error \"unable to :print the term\"\n    Just x  -> return x\n\nrunTR_maybe :: HscEnv -> TR a -> IO (Maybe a)\nrunTR_maybe hsc_env thing_inside\n  = do { (_errs, res) <- initTcInteractive hsc_env thing_inside\n       ; return res }\n\n-- | Term Reconstruction trace\ntraceTR :: SDoc -> TR ()\ntraceTR = liftTcM . traceOptTcRn Opt_D_dump_rtti\n\n\n-- Semantically different to recoverM in TcRnMonad\n-- recoverM retains the errors in the first action,\n--  whereas recoverTc here does not\nrecoverTR :: TR a -> TR a -> TR a\nrecoverTR = tryTcDiscardingErrs\n\ntrIO :: IO a -> TR a\ntrIO = liftTcM . liftIO\n\nliftTcM :: TcM a -> TR a\nliftTcM = id\n\nnewVar :: Kind -> TR TcType\nnewVar = liftTcM . newFlexiTyVarTy\n\nnewOpenVar :: TR TcType\nnewOpenVar = liftTcM newOpenFlexiTyVarTy\n\ninstTyVars :: [TyVar] -> TR (TCvSubst, [TcTyVar])\n-- Instantiate fresh mutable type variables from some TyVars\n-- This function preserves the print-name, which helps error messages\ninstTyVars tvs\n  = liftTcM $ fst <$> captureConstraints (newMetaTyVars tvs)\n\ntype RttiInstantiation = [(TcTyVar, TyVar)]\n   -- Associates the typechecker-world meta type variables\n   -- (which are mutable and may be refined), to their\n   -- debugger-world RuntimeUnk counterparts.\n   -- If the TcTyVar has not been refined by the runtime type\n   -- elaboration, then we want to turn it back into the\n   -- original RuntimeUnk\n\n-- | Returns the instantiated type scheme ty', and the\n--   mapping from new (instantiated) -to- old (skolem) type variables\ninstScheme :: QuantifiedType -> TR (TcType, RttiInstantiation)\ninstScheme (tvs, ty)\n  = do { (subst, tvs') <- instTyVars tvs\n       ; let rtti_inst = [(tv',tv) | (tv',tv) <- tvs' `zip` tvs]\n       ; return (substTy subst ty, rtti_inst) }\n\napplyRevSubst :: RttiInstantiation -> TR ()\n-- Apply the *reverse* substitution in-place to any un-filled-in\n-- meta tyvars.  This recovers the original debugger-world variable\n-- unless it has been refined by new information from the heap\napplyRevSubst pairs = liftTcM (mapM_ do_pair pairs)\n  where\n    do_pair (tc_tv, rtti_tv)\n      = do { tc_ty <- zonkTcTyVar tc_tv\n           ; case tcGetTyVar_maybe tc_ty of\n               Just tv | isMetaTyVar tv -> writeMetaTyVar tv (mkTyVarTy rtti_tv)\n               _                        -> return () }\n\n-- Adds a constraint of the form t1 == t2\n-- t1 is expected to come from walking the heap\n-- t2 is expected to come from a datacon signature\n-- Before unification, congruenceNewtypes needs to\n-- do its magic.\naddConstraint :: TcType -> TcType -> TR ()\naddConstraint actual expected = do\n    traceTR (text \"add constraint:\" <+> fsep [ppr actual, equals, ppr expected])\n    recoverTR (traceTR $ fsep [text \"Failed to unify\", ppr actual,\n                                    text \"with\", ppr expected]) $\n      discardResult $\n      captureConstraints $\n      do { (ty1, ty2) <- congruenceNewtypes actual expected\n         ; unifyType Nothing ty1 ty2 }\n     -- TOMDO: what about the coercion?\n     -- we should consider family instances\n\n\n-- | Term reconstruction\n--\n-- Given a pointer to a heap object (`HValue`) and its type, build a `Term`\n-- representation of the object. Subterms (objects in the payload) are also\n-- built up to the given `max_depth`. After `max_depth` any subterms will appear\n-- as `Suspension`s. Any thunks found while traversing the object will be forced\n-- based on `force` parameter.\n--\n-- Types of terms will be refined based on constructors we find during term\n-- reconstruction. See `cvReconstructType` for an overview of how type\n-- reconstruction works.\n--\ncvObtainTerm\n    :: HscEnv\n    -> Int      -- ^ How many times to recurse for subterms\n    -> Bool     -- ^ Force thunks\n    -> RttiType -- ^ Type of the object to reconstruct\n    -> ForeignHValue   -- ^ Object to reconstruct\n    -> IO Term\ncvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do\n  -- we quantify existential tyvars as universal,\n  -- as this is needed to be able to manipulate\n  -- them properly\n   let quant_old_ty@(old_tvs, old_tau) = quantifyType old_ty\n       sigma_old_ty = mkInvForAllTys old_tvs old_tau\n   traceTR (text \"Term reconstruction started with initial type \" <> ppr old_ty)\n   term <-\n     if null old_tvs\n      then do\n        term  <- go max_depth sigma_old_ty sigma_old_ty hval\n        term' <- zonkTerm term\n        return $ fixFunDictionaries $ expandNewtypes term'\n      else do\n              (old_ty', rev_subst) <- instScheme quant_old_ty\n              my_ty <- newOpenVar\n              when (check1 quant_old_ty) (traceTR (text \"check1 passed\") >>\n                                          addConstraint my_ty old_ty')\n              term  <- go max_depth my_ty sigma_old_ty hval\n              new_ty <- zonkTcType (termType term)\n              if isMonomorphic new_ty || check2 (quantifyType new_ty) quant_old_ty\n                 then do\n                      traceTR (text \"check2 passed\")\n                      addConstraint new_ty old_ty'\n                      applyRevSubst rev_subst\n                      zterm' <- zonkTerm term\n                      return ((fixFunDictionaries . expandNewtypes) zterm')\n                 else do\n                      traceTR (text \"check2 failed\" <+> parens\n                                       (ppr term <+> text \"::\" <+> ppr new_ty))\n                      -- we have unsound types. Replace constructor types in\n                      -- subterms with tyvars\n                      zterm' <- mapTermTypeM\n                                 (\\ty -> case tcSplitTyConApp_maybe ty of\n                                           Just (tc, _:_) | tc /= funTyCon\n                                               -> newOpenVar\n                                           _   -> return ty)\n                                 term\n                      zonkTerm zterm'\n   traceTR (text \"Term reconstruction completed.\" $$\n            text \"Term obtained: \" <> ppr term $$\n            text \"Type obtained: \" <> ppr (termType term))\n   return term\n    where\n  go :: Int -> Type -> Type -> ForeignHValue -> TcM Term\n   -- I believe that my_ty should not have any enclosing\n   -- foralls, nor any free RuntimeUnk skolems;\n   -- that is partly what the quantifyType stuff achieved\n   --\n   -- [SPJ May 11] I don't understand the difference between my_ty and old_ty\n\n  go 0 my_ty _old_ty a = do\n    traceTR (text \"Gave up reconstructing a term after\" <>\n                  int max_depth <> text \" steps\")\n    clos <- trIO $ GHCi.getClosure hsc_env a\n    return (Suspension (tipe (info clos)) my_ty a Nothing)\n  go !max_depth my_ty old_ty a = do\n    let monomorphic = not(isTyVarTy my_ty)\n    -- This ^^^ is a convention. The ancestor tests for\n    -- monomorphism and passes a type instead of a tv\n    clos <- trIO $ GHCi.getClosure hsc_env a\n    case clos of\n-- Thunks we may want to force\n      t | isThunk t && force -> do\n         traceTR (text \"Forcing a \" <> text (show (fmap (const ()) t)))\n         liftIO $ GHCi.seqHValue hsc_env a\n         go (pred max_depth) my_ty old_ty a\n-- Blackholes are indirections iff the payload is not TSO or BLOCKING_QUEUE. If\n-- the indirection is a TSO or BLOCKING_QUEUE, we return the BLACKHOLE itself as\n-- the suspension so that entering it in GHCi will enter the BLACKHOLE instead\n-- of entering the TSO or BLOCKING_QUEUE (which leads to runtime panic).\n      BlackholeClosure{indirectee=ind} -> do\n         traceTR (text \"Following a BLACKHOLE\")\n         ind_clos <- trIO (GHCi.getClosure hsc_env ind)\n         let return_bh_value = return (Suspension BLACKHOLE my_ty a Nothing)\n         case ind_clos of\n           -- TSO and BLOCKING_QUEUE cases\n           BlockingQueueClosure{} -> return_bh_value\n           OtherClosure info _ _\n             | tipe info == TSO -> return_bh_value\n           UnsupportedClosure info\n             | tipe info == TSO -> return_bh_value\n           -- Otherwise follow the indirectee\n           -- (NOTE: This code will break if we support TSO in ghc-heap one day)\n           _ -> go max_depth my_ty old_ty ind\n-- We always follow indirections\n      IndClosure{indirectee=ind} -> do\n         traceTR (text \"Following an indirection\" )\n         go max_depth my_ty old_ty ind\n-- We also follow references\n      MutVarClosure{var=contents}\n         | Just (tycon,[world,contents_ty]) <- tcSplitTyConApp_maybe old_ty\n             -> do\n                  -- Deal with the MutVar# primitive\n                  -- It does not have a constructor at all,\n                  -- so we simulate the following one\n                  -- MutVar# :: contents_ty -> MutVar# s contents_ty\n         traceTR (text \"Following a MutVar\")\n         contents_tv <- newVar liftedTypeKind\n         MASSERT(isUnliftedType my_ty)\n         (mutvar_ty,_) <- instScheme $ quantifyType $ mkVisFunTy\n                            contents_ty (mkTyConApp tycon [world,contents_ty])\n         addConstraint (mkVisFunTy contents_tv my_ty) mutvar_ty\n         x <- go (pred max_depth) contents_tv contents_ty contents\n         return (RefWrap my_ty x)\n\n -- The interesting case\n      ConstrClosure{ptrArgs=pArgs,dataArgs=dArgs} -> do\n        traceTR (text \"entering a constructor \" <> ppr dArgs <+>\n                      if monomorphic\n                        then parens (text \"already monomorphic: \" <> ppr my_ty)\n                        else Ppr.empty)\n        Right dcname <- liftIO $ constrClosToName hsc_env clos\n        (_,mb_dc)    <- tryTc (tcLookupDataCon dcname)\n        case mb_dc of\n          Nothing -> do -- This can happen for private constructors compiled -O0\n                        -- where the .hi descriptor does not export them\n                        -- In such case, we return a best approximation:\n                        --  ignore the unpointed args, and recover the pointeds\n                        -- This preserves laziness, and should be safe.\n                       traceTR (text \"Not constructor\" <+> ppr dcname)\n                       let dflags = hsc_dflags hsc_env\n                           tag = showPpr dflags dcname\n                       vars     <- replicateM (length pArgs)\n                                              (newVar liftedTypeKind)\n                       subTerms <- sequence $ zipWith (\\x tv ->\n                           go (pred max_depth) tv tv x) pArgs vars\n                       return (Term my_ty (Left ('<' : tag ++ \">\")) a subTerms)\n          Just dc -> do\n            traceTR (text \"Is constructor\" <+> (ppr dc $$ ppr my_ty))\n            subTtypes <- getDataConArgTys dc my_ty\n            subTerms <- extractSubTerms (\\ty -> go (pred max_depth) ty ty) clos subTtypes\n            return (Term my_ty (Right dc) a subTerms)\n\n      -- This is to support printing of Integers. It's not a general\n      -- mechanism by any means; in particular we lose the size in\n      -- bytes of the array.\n      ArrWordsClosure{bytes=b, arrWords=ws} -> do\n         traceTR (text \"ByteArray# closure, size \" <> ppr b)\n         return (Term my_ty (Left \"ByteArray#\") a [Prim my_ty ws])\n\n-- The otherwise case: can be a Thunk,AP,PAP,etc.\n      _ -> do\n         traceTR (text \"Unknown closure:\" <+>\n                  text (show (fmap (const ()) clos)))\n         return (Suspension (tipe (info clos)) my_ty a Nothing)\n\n  -- insert NewtypeWraps around newtypes\n  expandNewtypes = foldTerm idTermFold { fTerm = worker } where\n   worker ty dc hval tt\n     | Just (tc, args) <- tcSplitTyConApp_maybe ty\n     , isNewTyCon tc\n     , wrapped_type    <- newTyConInstRhs tc args\n     , Just dc'        <- tyConSingleDataCon_maybe tc\n     , t'              <- worker wrapped_type dc hval tt\n     = NewtypeWrap ty (Right dc') t'\n     | otherwise = Term ty dc hval tt\n\n\n   -- Avoid returning types where predicates have been expanded to dictionaries.\n  fixFunDictionaries = foldTerm idTermFold {fSuspension = worker} where\n      worker ct ty hval n | isFunTy ty = Suspension ct (dictsView ty) hval n\n                          | otherwise  = Suspension ct ty hval n\n\nextractSubTerms :: (Type -> ForeignHValue -> TcM Term)\n                -> GenClosure ForeignHValue -> [Type] -> TcM [Term]\nextractSubTerms recurse clos = liftM thdOf3 . go 0 0\n  where\n    array = dataArgs clos\n\n    go ptr_i arr_i [] = return (ptr_i, arr_i, [])\n    go ptr_i arr_i (ty:tys)\n      | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty\n      , isUnboxedTupleTyCon tc\n                -- See Note [Unboxed tuple RuntimeRep vars] in TyCon\n      = do (ptr_i, arr_i, terms0) <-\n               go ptr_i arr_i (dropRuntimeRepArgs elem_tys)\n           (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys\n           return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)\n      | otherwise\n      = case typePrimRepArgs ty of\n          [rep_ty] ->  do\n            (ptr_i, arr_i, term0)  <- go_rep ptr_i arr_i ty rep_ty\n            (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys\n            return (ptr_i, arr_i, term0 : terms1)\n          rep_tys -> do\n           (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys\n           (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys\n           return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)\n\n    go_unary_types ptr_i arr_i [] = return (ptr_i, arr_i, [])\n    go_unary_types ptr_i arr_i (rep_ty:rep_tys) = do\n      tv <- newVar liftedTypeKind\n      (ptr_i, arr_i, term0)  <- go_rep ptr_i arr_i tv rep_ty\n      (ptr_i, arr_i, terms1) <- go_unary_types ptr_i arr_i rep_tys\n      return (ptr_i, arr_i, term0 : terms1)\n\n    go_rep ptr_i arr_i ty rep\n      | isGcPtrRep rep = do\n          t <- recurse ty $ (ptrArgs clos)!!ptr_i\n          return (ptr_i + 1, arr_i, t)\n      | otherwise = do\n          -- This is a bit involved since we allow packing multiple fields\n          -- within a single word. See also\n          -- StgCmmLayout.mkVirtHeapOffsetsWithPadding\n          dflags <- getDynFlags\n          let word_size = wORD_SIZE dflags\n              big_endian = wORDS_BIGENDIAN dflags\n              size_b = primRepSizeB dflags rep\n              -- Align the start offset (eg, 2-byte value should be 2-byte\n              -- aligned). But not more than to a word. The offset calculation\n              -- should be the same with the offset calculation in\n              -- StgCmmLayout.mkVirtHeapOffsetsWithPadding.\n              !aligned_idx = roundUpTo arr_i (min word_size size_b)\n              !new_arr_i = aligned_idx + size_b\n              ws | size_b < word_size =\n                     [index size_b aligned_idx word_size big_endian]\n                 | otherwise =\n                     let (q, r) = size_b `quotRem` word_size\n                     in ASSERT( r == 0 )\n                        [ array!!i\n                        | o <- [0.. q - 1]\n                        , let i = (aligned_idx `quot` word_size) + o\n                        ]\n          return (ptr_i, new_arr_i, Prim ty ws)\n\n    unboxedTupleTerm ty terms\n      = Term ty (Right (tupleDataCon Unboxed (length terms)))\n                (error \"unboxedTupleTerm: no HValue for unboxed tuple\") terms\n\n    -- Extract a sub-word sized field from a word\n    index item_size_b index_b word_size big_endian =\n        (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes\n      where\n        mask :: Word\n        mask = case item_size_b of\n            1 -> 0xFF\n            2 -> 0xFFFF\n            4 -> 0xFFFFFFFF\n            _ -> panic (\"Weird byte-index: \" ++ show index_b)\n        (q,r) = index_b `quotRem` word_size\n        word = array!!q\n        moveBytes = if big_endian\n                    then word_size - (r + item_size_b) * 8\n                    else r * 8\n\n\n-- | Fast, breadth-first Type reconstruction\n--\n-- Given a heap object (`HValue`) and its (possibly polymorphic) type (usually\n-- obtained in GHCi), try to reconstruct a more monomorphic type of the object.\n-- This is used for improving type information in debugger. For example, if we\n-- have a polymorphic function:\n--\n--     sumNumList :: Num a => [a] -> a\n--     sumNumList [] = 0\n--     sumNumList (x : xs) = x + sumList xs\n--\n-- and add a breakpoint to it:\n--\n--     ghci> break sumNumList\n--     ghci> sumNumList ([0 .. 9] :: [Int])\n--\n-- ghci shows us more precise types than just `a`s:\n--\n--     Stopped in Main.sumNumList, debugger.hs:3:23-39\n--     _result :: Int = _\n--     x :: Int = 0\n--     xs :: [Int] = _\n--\ncvReconstructType\n    :: HscEnv\n    -> Int       -- ^ How many times to recurse for subterms\n    -> GhciType  -- ^ Type to refine\n    -> ForeignHValue  -- ^ Refine the type using this value\n    -> IO (Maybe Type)\ncvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do\n   traceTR (text \"RTTI started with initial type \" <> ppr old_ty)\n   let sigma_old_ty@(old_tvs, _) = quantifyType old_ty\n   new_ty <-\n       if null old_tvs\n        then return old_ty\n        else do\n          (old_ty', rev_subst) <- instScheme sigma_old_ty\n          my_ty <- newOpenVar\n          when (check1 sigma_old_ty) (traceTR (text \"check1 passed\") >>\n                                      addConstraint my_ty old_ty')\n          search (isMonomorphic `fmap` zonkTcType my_ty)\n                 (\\(ty,a) -> go ty a)\n                 (Seq.singleton (my_ty, hval))\n                 max_depth\n          new_ty <- zonkTcType my_ty\n          if isMonomorphic new_ty || check2 (quantifyType new_ty) sigma_old_ty\n            then do\n                 traceTR (text \"check2 passed\" <+> ppr old_ty $$ ppr new_ty)\n                 addConstraint my_ty old_ty'\n                 applyRevSubst rev_subst\n                 zonkRttiType new_ty\n            else traceTR (text \"check2 failed\" <+> parens (ppr new_ty)) >>\n                 return old_ty\n   traceTR (text \"RTTI completed. Type obtained:\" <+> ppr new_ty)\n   return new_ty\n    where\n--  search :: m Bool -> ([a] -> [a] -> [a]) -> [a] -> m ()\n  search _ _ _ 0 = traceTR (text \"Failed to reconstruct a type after \" <>\n                                int max_depth <> text \" steps\")\n  search stop expand l d =\n    case viewl l of\n      EmptyL  -> return ()\n      x :< xx -> unlessM stop $ do\n                  new <- expand x\n                  search stop expand (xx `mappend` Seq.fromList new) $! (pred d)\n\n   -- returns unification tasks,since we are going to want a breadth-first search\n  go :: Type -> ForeignHValue -> TR [(Type, ForeignHValue)]\n  go my_ty a = do\n    traceTR (text \"go\" <+> ppr my_ty)\n    clos <- trIO $ GHCi.getClosure hsc_env a\n    case clos of\n      BlackholeClosure{indirectee=ind} -> go my_ty ind\n      IndClosure{indirectee=ind} -> go my_ty ind\n      MutVarClosure{var=contents} -> do\n         tv'   <- newVar liftedTypeKind\n         world <- newVar liftedTypeKind\n         addConstraint my_ty (mkTyConApp mutVarPrimTyCon [world,tv'])\n         return [(tv', contents)]\n      ConstrClosure{ptrArgs=pArgs} -> do\n        Right dcname <- liftIO $ constrClosToName hsc_env clos\n        traceTR (text \"Constr1\" <+> ppr dcname)\n        (_,mb_dc) <- tryTc (tcLookupDataCon dcname)\n        case mb_dc of\n          Nothing-> do\n            forM pArgs $ \\x -> do\n              tv <- newVar liftedTypeKind\n              return (tv, x)\n\n          Just dc -> do\n            arg_tys <- getDataConArgTys dc my_ty\n            (_, itys) <- findPtrTyss 0 arg_tys\n            traceTR (text \"Constr2\" <+> ppr dcname <+> ppr arg_tys)\n            return $ zipWith (\\(_,ty) x -> (ty, x)) itys pArgs\n      _ -> return []\n\nfindPtrTys :: Int  -- Current pointer index\n           -> Type -- Type\n           -> TR (Int, [(Int, Type)])\nfindPtrTys i ty\n  | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty\n  , isUnboxedTupleTyCon tc\n  = findPtrTyss i elem_tys\n\n  | otherwise\n  = case typePrimRep ty of\n      [rep] | isGcPtrRep rep -> return (i + 1, [(i, ty)])\n            | otherwise      -> return (i,     [])\n      prim_reps              ->\n        foldM (\\(i, extras) prim_rep ->\n                if isGcPtrRep prim_rep\n                  then newVar liftedTypeKind >>= \\tv -> return (i + 1, extras ++ [(i, tv)])\n                  else return (i, extras))\n              (i, []) prim_reps\n\nfindPtrTyss :: Int\n            -> [Type]\n            -> TR (Int, [(Int, Type)])\nfindPtrTyss i tys = foldM step (i, []) tys\n  where step (i, discovered) elem_ty = do\n          (i, extras) <- findPtrTys i elem_ty\n          return (i, discovered ++ extras)\n\n\n-- Compute the difference between a base type and the type found by RTTI\n-- improveType <base_type> <rtti_type>\n-- The types can contain skolem type variables, which need to be treated as normal vars.\n-- In particular, we want them to unify with things.\nimproveRTTIType :: HscEnv -> RttiType -> RttiType -> Maybe TCvSubst\nimproveRTTIType _ base_ty new_ty = U.tcUnifyTyKi base_ty new_ty\n\ngetDataConArgTys :: DataCon -> Type -> TR [Type]\n-- Given the result type ty of a constructor application (D a b c :: ty)\n-- return the types of the arguments.  This is RTTI-land, so 'ty' might\n-- not be fully known.  Moreover, the arg types might involve existentials;\n-- if so, make up fresh RTTI type variables for them\n--\n-- I believe that con_app_ty should not have any enclosing foralls\ngetDataConArgTys dc con_app_ty\n  = do { let rep_con_app_ty = unwrapType con_app_ty\n       ; traceTR (text \"getDataConArgTys 1\" <+> (ppr con_app_ty $$ ppr rep_con_app_ty\n                   $$ ppr (tcSplitTyConApp_maybe rep_con_app_ty)))\n       ; ASSERT( all isTyVar ex_tvs ) return ()\n                 -- ex_tvs can only be tyvars as data types in source\n                 -- Haskell cannot mention covar yet (Aug 2018)\n       ; (subst, _) <- instTyVars (univ_tvs ++ ex_tvs)\n       ; addConstraint rep_con_app_ty (substTy subst (dataConOrigResTy dc))\n              -- See Note [Constructor arg types]\n       ; let con_arg_tys = substTys subst (dataConRepArgTys dc)\n       ; traceTR (text \"getDataConArgTys 2\" <+> (ppr rep_con_app_ty $$ ppr con_arg_tys $$ ppr subst))\n       ; return con_arg_tys }\n  where\n    univ_tvs = dataConUnivTyVars dc\n    ex_tvs   = dataConExTyCoVars dc\n\n{- Note [Constructor arg types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider a GADT (cf Trac #7386)\n   data family D a b\n   data instance D [a] a where\n     MkT :: a -> D [a] (Maybe a)\n     ...\n\nIn getDataConArgTys\n* con_app_ty is the known type (from outside) of the constructor application,\n  say D [Int] Int\n\n* The data constructor MkT has a (representation) dataConTyCon = DList,\n  say where\n    data DList a where\n      MkT :: a -> DList a (Maybe a)\n      ...\n\nSo the dataConTyCon of the data constructor, DList, differs from\nthe \"outside\" type, D. So we can't straightforwardly decompose the\n\"outside\" type, and we end up in the \"_\" branch of the case.\n\nThen we match the dataConOrigResTy of the data constructor against the\noutside type, hoping to get a substitution that tells how to instantiate\nthe *representation* type constructor.   This looks a bit delicate to\nme, but it seems to work.\n-}\n\n-- Soundness checks\n--------------------\n{-\nThis is not formalized anywhere, so hold to your seats!\nRTTI in the presence of newtypes can be a tricky and unsound business.\n\nExample:\n~~~~~~~~~\nSuppose we are doing RTTI for a partially evaluated\nclosure t, the real type of which is t :: MkT Int, for\n\n   newtype MkT a = MkT [Maybe a]\n\nThe table below shows the results of RTTI and the improvement\ncalculated for different combinations of evaluatedness and :type t.\nRegard the two first columns as input and the next two as output.\n\n  # |     t     |  :type t  | rtti(t)  | improv.    | result\n    ------------------------------------------------------------\n  1 |     _     |    t b    |    a     | none       | OK\n  2 |     _     |   MkT b   |    a     | none       | OK\n  3 |     _     |   t Int   |    a     | none       | OK\n\n  If t is not evaluated at *all*, we are safe.\n\n  4 |  (_ : _)  |    t b    |   [a]    | t = []     | UNSOUND\n  5 |  (_ : _)  |   MkT b   |  MkT a   | none       | OK (compensating for the missing newtype)\n  6 |  (_ : _)  |   t Int   |  [Int]   | t = []     | UNSOUND\n\n  If a is a minimal whnf, we run into trouble. Note that\n  row 5 above does newtype enrichment on the ty_rtty parameter.\n\n  7 | (Just _:_)|    t b    |[Maybe a] | t = [],    | UNSOUND\n    |                       |          | b = Maybe a|\n\n  8 | (Just _:_)|   MkT b   |  MkT a   |  none      | OK\n  9 | (Just _:_)|   t Int   |   FAIL   |  none      | OK\n\n  And if t is any more evaluated than whnf, we are still in trouble.\n  Because constraints are solved in top-down order, when we reach the\n  Maybe subterm what we got is already unsound. This explains why the\n  row 9 fails to complete.\n\n  10 | (Just _:_)|  t Int  | [Maybe a]   |  FAIL    | OK\n  11 | (Just 1:_)|  t Int  | [Maybe Int] |  FAIL    | OK\n\n  We can undo the failure in row 9 by leaving out the constraint\n  coming from the type signature of t (i.e., the 2nd column).\n  Note that this type information is still used\n  to calculate the improvement. But we fail\n  when trying to calculate the improvement, as there is no unifier for\n  t Int = [Maybe a] or t Int = [Maybe Int].\n\n\n  Another set of examples with t :: [MkT (Maybe Int)]  \\equiv  [[Maybe (Maybe Int)]]\n\n  # |     t     |    :type t    |  rtti(t)    | improvement | result\n    ---------------------------------------------------------------------\n  1 |(Just _:_) | [t (Maybe a)] | [[Maybe b]] | t = []      |\n    |           |               |             | b = Maybe a |\n\nThe checks:\n~~~~~~~~~~~\nConsider a function obtainType that takes a value and a type and produces\nthe Term representation and a substitution (the improvement).\nAssume an auxiliar rtti' function which does the actual job if recovering\nthe type, but which may produce a false type.\n\nIn pseudocode:\n\n  rtti' :: a -> IO Type  -- Does not use the static type information\n\n  obtainType :: a -> Type -> IO (Maybe (Term, Improvement))\n  obtainType v old_ty = do\n       rtti_ty <- rtti' v\n       if monomorphic rtti_ty || (check rtti_ty old_ty)\n        then ...\n         else return Nothing\n  where check rtti_ty old_ty = check1 rtti_ty &&\n                              check2 rtti_ty old_ty\n\n  check1 :: Type -> Bool\n  check2 :: Type -> Type -> Bool\n\nNow, if rtti' returns a monomorphic type, we are safe.\nIf that is not the case, then we consider two conditions.\n\n\n1. To prevent the class of unsoundness displayed by\n   rows 4 and 7 in the example: no higher kind tyvars\n   accepted.\n\n  check1 (t a)   = NO\n  check1 (t Int) = NO\n  check1 ([] a)  = YES\n\n2. To prevent the class of unsoundness shown by row 6,\n   the rtti type should be structurally more\n   defined than the old type we are comparing it to.\n  check2 :: NewType -> OldType -> Bool\n  check2 a  _        = True\n  check2 [a] a       = True\n  check2 [a] (t Int) = False\n  check2 [a] (t a)   = False  -- By check1 we never reach this equation\n  check2 [Int] a     = True\n  check2 [Int] (t Int) = True\n  check2 [Maybe a]   (t Int) = False\n  check2 [Maybe Int] (t Int) = True\n  check2 (Maybe [a])   (m [Int]) = False\n  check2 (Maybe [Int]) (m [Int]) = True\n\n-}\n\ncheck1 :: QuantifiedType -> Bool\ncheck1 (tvs, _) = not $ any isHigherKind (map tyVarKind tvs)\n where\n   isHigherKind = not . null . fst . splitPiTys\n\ncheck2 :: QuantifiedType -> QuantifiedType -> Bool\ncheck2 (_, rtti_ty) (_, old_ty)\n  | Just (_, rttis) <- tcSplitTyConApp_maybe rtti_ty\n  = case () of\n      _ | Just (_,olds) <- tcSplitTyConApp_maybe old_ty\n        -> and$ zipWith check2 (map quantifyType rttis) (map quantifyType olds)\n      _ | Just _ <- splitAppTy_maybe old_ty\n        -> isMonomorphicOnNonPhantomArgs rtti_ty\n      _ -> True\n  | otherwise = True\n\n-- Dealing with newtypes\n--------------------------\n{-\n congruenceNewtypes does a parallel fold over two Type values,\n compensating for missing newtypes on both sides.\n This is necessary because newtypes are not present\n in runtime, but sometimes there is evidence available.\n   Evidence can come from DataCon signatures or\n from compile-time type inference.\n What we are doing here is an approximation\n of unification modulo a set of equations derived\n from newtype definitions. These equations should be the\n same as the equality coercions generated for newtypes\n in System Fc. The idea is to perform a sort of rewriting,\n taking those equations as rules, before launching unification.\n\n The caller must ensure the following.\n The 1st type (lhs) comes from the heap structure of ptrs,nptrs.\n The 2nd type (rhs) comes from a DataCon type signature.\n Rewriting (i.e. adding/removing a newtype wrapper) can happen\n in both types, but in the rhs it is restricted to the result type.\n\n   Note that it is very tricky to make this 'rewriting'\n work with the unification implemented by TcM, where\n substitutions are operationally inlined. The order in which\n constraints are unified is vital as we cannot modify\n anything that has been touched by a previous unification step.\nTherefore, congruenceNewtypes is sound only if the types\nrecovered by the RTTI mechanism are unified Top-Down.\n-}\ncongruenceNewtypes ::  TcType -> TcType -> TR (TcType,TcType)\ncongruenceNewtypes lhs rhs = go lhs rhs >>= \\rhs' -> return (lhs,rhs')\n where\n   go l r\n -- TyVar lhs inductive case\n    | Just tv <- getTyVar_maybe l\n    , isTcTyVar tv\n    , isMetaTyVar tv\n    = recoverTR (return r) $ do\n         Indirect ty_v <- readMetaTyVar tv\n         traceTR $ fsep [text \"(congruence) Following indirect tyvar:\",\n                          ppr tv, equals, ppr ty_v]\n         go ty_v r\n-- FunTy inductive case\n    | Just (l1,l2) <- splitFunTy_maybe l\n    , Just (r1,r2) <- splitFunTy_maybe r\n    = do r2' <- go l2 r2\n         r1' <- go l1 r1\n         return (mkVisFunTy r1' r2')\n-- TyconApp Inductive case; this is the interesting bit.\n    | Just (tycon_l, _) <- tcSplitTyConApp_maybe lhs\n    , Just (tycon_r, _) <- tcSplitTyConApp_maybe rhs\n    , tycon_l /= tycon_r\n    = upgrade tycon_l r\n\n    | otherwise = return r\n\n    where upgrade :: TyCon -> Type -> TR Type\n          upgrade new_tycon ty\n            | not (isNewTyCon new_tycon) = do\n              traceTR (text \"(Upgrade) Not matching newtype evidence: \" <>\n                       ppr new_tycon <> text \" for \" <> ppr ty)\n              return ty\n            | otherwise = do\n               traceTR (text \"(Upgrade) upgraded \" <> ppr ty <>\n                        text \" in presence of newtype evidence \" <> ppr new_tycon)\n               (_, vars) <- instTyVars (tyConTyVars new_tycon)\n               let ty' = mkTyConApp new_tycon (mkTyVarTys vars)\n                   rep_ty = unwrapType ty'\n               _ <- liftTcM (unifyType Nothing ty rep_ty)\n        -- assumes that reptype doesn't ^^^^ touch tyconApp args\n               return ty'\n\n\nzonkTerm :: Term -> TcM Term\nzonkTerm = foldTermM (TermFoldM\n             { fTermM = \\ty dc v tt -> zonkRttiType ty    >>= \\ty' ->\n                                       return (Term ty' dc v tt)\n             , fSuspensionM  = \\ct ty v b -> zonkRttiType ty >>= \\ty ->\n                                             return (Suspension ct ty v b)\n             , fNewtypeWrapM = \\ty dc t -> zonkRttiType ty >>= \\ty' ->\n                                           return$ NewtypeWrap ty' dc t\n             , fRefWrapM     = \\ty t -> return RefWrap  `ap`\n                                        zonkRttiType ty `ap` return t\n             , fPrimM        = (return.) . Prim })\n\nzonkRttiType :: TcType -> TcM Type\n-- Zonk the type, replacing any unbound Meta tyvars\n-- by RuntimeUnk skolems, safely out of Meta-tyvar-land\nzonkRttiType ty= do { ze <- mkEmptyZonkEnv RuntimeUnkFlexi\n                    ; zonkTcTypeToTypeX ze ty }\n\n--------------------------------------------------------------------------------\n-- Restore Class predicates out of a representation type\ndictsView :: Type -> Type\ndictsView ty = ty\n\n\n-- Use only for RTTI types\nisMonomorphic :: RttiType -> Bool\nisMonomorphic ty = noExistentials && noUniversals\n where (tvs, _, ty')  = tcSplitSigmaTy ty\n       noExistentials = noFreeVarsOfType ty'\n       noUniversals   = null tvs\n\n-- Use only for RTTI types\nisMonomorphicOnNonPhantomArgs :: RttiType -> Bool\nisMonomorphicOnNonPhantomArgs ty\n  | Just (tc, all_args) <- tcSplitTyConApp_maybe (unwrapType ty)\n  , phantom_vars  <- tyConPhantomTyVars tc\n  , concrete_args <- [ arg | (tyv,arg) <- tyConTyVars tc `zip` all_args\n                           , tyv `notElem` phantom_vars]\n  = all isMonomorphicOnNonPhantomArgs concrete_args\n  | Just (ty1, ty2) <- splitFunTy_maybe ty\n  = all isMonomorphicOnNonPhantomArgs [ty1,ty2]\n  | otherwise = isMonomorphic ty\n\ntyConPhantomTyVars :: TyCon -> [TyVar]\ntyConPhantomTyVars tc\n  | isAlgTyCon tc\n  , Just dcs <- tyConDataCons_maybe tc\n  , dc_vars  <- concatMap dataConUnivTyVars dcs\n  = tyConTyVars tc \\\\ dc_vars\ntyConPhantomTyVars _ = []\n\ntype QuantifiedType = ([TyVar], Type)\n   -- Make the free type variables explicit\n   -- The returned Type should have no top-level foralls (I believe)\n\nquantifyType :: Type -> QuantifiedType\n-- Generalize the type: find all free and forall'd tyvars\n-- and return them, together with the type inside, which\n-- should not be a forall type.\n--\n-- Thus (quantifyType (forall a. a->[b]))\n-- returns ([a,b], a -> [b])\n\nquantifyType ty = ( filter isTyVar $\n                    tyCoVarsOfTypeWellScoped rho\n                  , rho)\n  where\n    (_tvs, rho) = tcSplitForAllTys ty\n", "num_lines": 1356}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE DeriveDataTypeable #-}\nmodule HieAst ( mkHieFile ) where\n\nimport GhcPrelude\n\nimport Avail                      ( Avails )\nimport Bag                        ( Bag, bagToList )\nimport BasicTypes\nimport BooleanFormula\nimport Class                      ( FunDep )\nimport CoreUtils                  ( exprType )\nimport ConLike                    ( conLikeName )\nimport Config                     ( cProjectVersion )\nimport Desugar                    ( deSugarExpr )\nimport FieldLabel\nimport HsSyn\nimport HscTypes\nimport Module                     ( ModuleName, ml_hs_file )\nimport MonadUtils                 ( concatMapM, liftIO )\nimport Name                       ( Name, nameSrcSpan, setNameLoc )\nimport NameEnv                    ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )\nimport SrcLoc\nimport TcHsSyn                    ( hsLitType, hsPatType )\nimport Type                       ( mkVisFunTys, Type )\nimport TysWiredIn                 ( mkListTy, mkSumTy )\nimport Var                        ( Id, Var, setVarName, varName, varType )\nimport TcRnTypes\nimport MkIface                    ( mkIfaceExports )\n\nimport HieTypes\nimport HieUtils\n\nimport qualified Data.Array as A\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Char8 as BSC\nimport qualified Data.Map as M\nimport qualified Data.Set as S\nimport Data.Data                  ( Data, Typeable )\nimport Data.List                  ( foldl1' )\nimport Data.Maybe                 ( listToMaybe )\nimport Control.Monad.Trans.Reader\nimport Control.Monad.Trans.Class  ( lift )\n\n-- These synonyms match those defined in main/GHC.hs\ntype RenamedSource     = ( HsGroup GhcRn, [LImportDecl GhcRn]\n                         , Maybe [(LIE GhcRn, Avails)]\n                         , Maybe LHsDocString )\ntype TypecheckedSource = LHsBinds GhcTc\n\n\n{- Note [Name Remapping]\nThe Typechecker introduces new names for mono names in AbsBinds.\nWe don't care about the distinction between mono and poly bindings,\nso we replace all occurrences of the mono name with the poly name.\n-}\nnewtype HieState = HieState\n  { name_remapping :: NameEnv Id\n  }\n\ninitState :: HieState\ninitState = HieState emptyNameEnv\n\nclass ModifyState a where -- See Note [Name Remapping]\n  addSubstitution :: a -> a -> HieState -> HieState\n\ninstance ModifyState Name where\n  addSubstitution _ _ hs = hs\n\ninstance ModifyState Id where\n  addSubstitution mono poly hs =\n    hs{name_remapping = extendNameEnv (name_remapping hs) (varName mono) poly}\n\nmodifyState :: ModifyState (IdP p) => [ABExport p] -> HieState -> HieState\nmodifyState = foldr go id\n  where\n    go ABE{abe_poly=poly,abe_mono=mono} f = addSubstitution mono poly . f\n    go _ f = f\n\ntype HieM = ReaderT HieState Hsc\n\n-- | Construct an 'HieFile' from the outputs of the typechecker.\nmkHieFile :: ModSummary\n          -> TcGblEnv\n          -> RenamedSource -> Hsc HieFile\nmkHieFile ms ts rs = do\n  let tc_binds = tcg_binds ts\n  (asts', arr) <- getCompressedAsts tc_binds rs\n  let Just src_file = ml_hs_file $ ms_location ms\n  src <- liftIO $ BS.readFile src_file\n  return $ HieFile\n      { hie_version = curHieVersion\n      , hie_ghc_version = BSC.pack cProjectVersion\n      , hie_hs_file = src_file\n      , hie_module = ms_mod ms\n      , hie_types = arr\n      , hie_asts = asts'\n      -- mkIfaceExports sorts the AvailInfos for stability\n      , hie_exports = mkIfaceExports (tcg_exports ts)\n      , hie_hs_src = src\n      }\n\ngetCompressedAsts :: TypecheckedSource -> RenamedSource\n  -> Hsc (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)\ngetCompressedAsts ts rs = do\n  asts <- enrichHie ts rs\n  return $ compressTypes asts\n\nenrichHie :: TypecheckedSource -> RenamedSource -> Hsc (HieASTs Type)\nenrichHie ts (hsGrp, imports, exports, _) = flip runReaderT initState $ do\n    tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts\n    rasts <- processGrp hsGrp\n    imps <- toHie $ filter (not . ideclImplicit . unLoc) imports\n    exps <- toHie $ fmap (map $ IEC Export . fst) exports\n    let spanFile children = case children of\n          [] -> mkRealSrcSpan (mkRealSrcLoc \"\" 1 1) (mkRealSrcLoc \"\" 1 1)\n          _ -> mkRealSrcSpan (realSrcSpanStart $ nodeSpan $ head children)\n                             (realSrcSpanEnd   $ nodeSpan $ last children)\n\n        modulify xs =\n          Node (simpleNodeInfo \"Module\" \"Module\") (spanFile xs) xs\n\n        asts = HieASTs\n          $ resolveTyVarScopes\n          $ M.map (modulify . mergeSortAsts)\n          $ M.fromListWith (++)\n          $ map (\\x -> (srcSpanFile (nodeSpan x),[x])) flat_asts\n\n        flat_asts = concat\n          [ tasts\n          , rasts\n          , imps\n          , exps\n          ]\n    return asts\n  where\n    processGrp grp = concatM\n      [ toHie $ fmap (RS ModuleScope ) hs_valds grp\n      , toHie $ hs_splcds grp\n      , toHie $ hs_tyclds grp\n      , toHie $ hs_derivds grp\n      , toHie $ hs_fixds grp\n      , toHie $ hs_defds grp\n      , toHie $ hs_fords grp\n      , toHie $ hs_warnds grp\n      , toHie $ hs_annds grp\n      , toHie $ hs_ruleds grp\n      ]\n\ngetRealSpan :: SrcSpan -> Maybe Span\ngetRealSpan (RealSrcSpan sp) = Just sp\ngetRealSpan _ = Nothing\n\ngrhss_span :: GRHSs p body -> SrcSpan\ngrhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (getLoc bs) (map getLoc xs)\ngrhss_span (XGRHSs _) = error \"XGRHS has no span\"\n\nbindingsOnly :: [Context Name] -> [HieAST a]\nbindingsOnly [] = []\nbindingsOnly (C c n : xs) = case nameSrcSpan n of\n  RealSrcSpan span -> Node nodeinfo span [] : bindingsOnly xs\n    where nodeinfo = NodeInfo S.empty [] (M.singleton (Right n) info)\n          info = mempty{identInfo = S.singleton c}\n  _ -> bindingsOnly xs\n\nconcatM :: Monad m => [m [a]] -> m [a]\nconcatM xs = concat <$> sequence xs\n\n{- Note [Capturing Scopes and other non local information]\ntoHie is a local tranformation, but scopes of bindings cannot be known locally,\nhence we have to push the relevant info down into the binding nodes.\nWe use the following types (*Context and *Scoped) to wrap things and\ncarry the required info\n(Maybe Span) always carries the span of the entire binding, including rhs\n-}\ndata Context a = C ContextInfo a -- Used for names and bindings\n\ndata RContext a = RC RecFieldContext a\ndata RFContext a = RFC RecFieldContext (Maybe Span) a\n-- ^ context for record fields\n\ndata IEContext a = IEC IEType a\n-- ^ context for imports/exports\n\ndata BindContext a = BC BindType Scope a\n-- ^ context for imports/exports\n\ndata PatSynFieldContext a = PSC (Maybe Span) a\n-- ^ context for pattern synonym fields.\n\ndata SigContext a = SC SigInfo a\n-- ^ context for type signatures\n\ndata SigInfo = SI SigType (Maybe Span)\n\ndata SigType = BindSig | ClassSig | InstSig\n\ndata RScoped a = RS Scope a\n-- ^ Scope spans over everything to the right of a, (mostly) not\n-- including a itself\n-- (Includes a in a few special cases like recursive do bindings) or\n-- let/where bindings\n\n-- | Pattern scope\ndata PScoped a = PS (Maybe Span)\n                    Scope       -- ^ use site of the pattern\n                    Scope       -- ^ pattern to the right of a, not including a\n                    a\n  deriving (Typeable, Data) -- Pattern Scope\n\n{- Note [TyVar Scopes]\nDue to -XScopedTypeVariables, type variables can be in scope quite far from\ntheir original binding. We resolve the scope of these type variables\nin a separate pass\n-}\ndata TScoped a = TS TyVarScope a -- TyVarScope\n\ndata TVScoped a = TVS TyVarScope Scope a -- TyVarScope\n-- ^ First scope remains constant\n-- Second scope is used to build up the scope of a tyvar over\n-- things to its right, ala RScoped\n\n-- | Each element scopes over the elements to the right\nlistScopes :: Scope -> [Located a] -> [RScoped (Located a)]\nlistScopes _ [] = []\nlistScopes rhsScope [pat] = [RS rhsScope pat]\nlistScopes rhsScope (pat : pats) = RS sc pat : pats'\n  where\n    pats'@((RS scope p):_) = listScopes rhsScope pats\n    sc = combineScopes scope $ mkScope $ getLoc p\n\n-- | 'listScopes' specialised to 'PScoped' things\npatScopes\n  :: Maybe Span\n  -> Scope\n  -> Scope\n  -> [LPat (GhcPass p)]\n  -> [PScoped (LPat (GhcPass p))]\npatScopes rsp useScope patScope xs =\n  map (\\(RS sc a) -> PS rsp useScope sc (unLoc a)) $\n    listScopes patScope (map dL xs)\n\n-- | 'listScopes' specialised to 'TVScoped' things\ntvScopes\n  :: TyVarScope\n  -> Scope\n  -> [LHsTyVarBndr a]\n  -> [TVScoped (LHsTyVarBndr a)]\ntvScopes tvScope rhsScope xs =\n  map (\\(RS sc a)-> TVS tvScope sc a) $ listScopes rhsScope xs\n\n{- Note [Scoping Rules for SigPat]\nExplicitly quantified variables in pattern type signatures are not\nbrought into scope in the rhs, but implicitly quantified variables\nare (HsWC and HsIB).\nThis is unlike other signatures, where explicitly quantified variables\nare brought into the RHS Scope\nFor example\nfoo :: forall a. ...;\nfoo = ... -- a is in scope here\n\nbar (x :: forall a. a -> a) = ... -- a is not in scope here\n--   ^ a is in scope here (pattern body)\n\nbax (x :: a) = ... -- a is in scope here\nBecause of HsWC and HsIB pass on their scope to their children\nwe must wrap the LHsType in pattern signatures in a\nShielded explictly, so that the HsWC/HsIB scope is not passed\non the the LHsType\n-}\n\ndata Shielded a = SH Scope a -- Ignores its TScope, uses its own scope instead\n\ntype family ProtectedSig a where\n  ProtectedSig GhcRn = HsWildCardBndrs GhcRn (HsImplicitBndrs\n                                                GhcRn\n                                                (Shielded (LHsType GhcRn)))\n  ProtectedSig GhcTc = NoExt\n\nclass ProtectSig a where\n  protectSig :: Scope -> LHsSigWcType (NoGhcTc a) -> ProtectedSig a\n\ninstance (HasLoc a) => HasLoc (Shielded a) where\n  loc (SH _ a) = loc a\n\ninstance (ToHie (TScoped a)) => ToHie (TScoped (Shielded a)) where\n  toHie (TS _ (SH sc a)) = toHie (TS (ResolvedScopes [sc]) a)\n\ninstance ProtectSig GhcTc where\n  protectSig _ _ = NoExt\n\ninstance ProtectSig GhcRn where\n  protectSig sc (HsWC a (HsIB b sig)) =\n    HsWC a (HsIB b (SH sc sig))\n  protectSig _ _ = error \"protectSig not given HsWC (HsIB)\"\n\nclass HasLoc a where\n  -- ^ defined so that HsImplicitBndrs and HsWildCardBndrs can\n  -- know what their implicit bindings are scoping over\n  loc :: a -> SrcSpan\n\ninstance HasLoc thing => HasLoc (TScoped thing) where\n  loc (TS _ a) = loc a\n\ninstance HasLoc thing => HasLoc (PScoped thing) where\n  loc (PS _ _ _ a) = loc a\n\ninstance HasLoc (LHsQTyVars GhcRn) where\n  loc (HsQTvs _ vs) = loc vs\n  loc _ = noSrcSpan\n\ninstance HasLoc thing => HasLoc (HsImplicitBndrs a thing) where\n  loc (HsIB _ a) = loc a\n  loc _ = noSrcSpan\n\ninstance HasLoc thing => HasLoc (HsWildCardBndrs a thing) where\n  loc (HsWC _ a) = loc a\n  loc _ = noSrcSpan\n\ninstance HasLoc (Located a) where\n  loc (L l _) = l\n\ninstance HasLoc a => HasLoc [a] where\n  loc [] = noSrcSpan\n  loc xs = foldl1' combineSrcSpans $ map loc xs\n\ninstance (HasLoc a, HasLoc b) => HasLoc (FamEqn s a b) where\n  loc (FamEqn _ a Nothing b _ c) = foldl1' combineSrcSpans [loc a, loc b, loc c]\n  loc (FamEqn _ a (Just tvs) b _ c) = foldl1' combineSrcSpans\n                                              [loc a, loc tvs, loc b, loc c]\n  loc _ = noSrcSpan\ninstance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where\n  loc (HsValArg tm) = loc tm\n  loc (HsTypeArg _ ty) = loc ty\n  loc (HsArgPar sp)  = sp\n\ninstance HasLoc (HsDataDefn GhcRn) where\n  loc def@(HsDataDefn{}) = loc $ dd_cons def\n    -- Only used for data family instances, so we only need rhs\n    -- Most probably the rest will be unhelpful anyway\n  loc _ = noSrcSpan\n\ninstance HasLoc (Pat (GhcPass a)) where\n  loc (dL -> L l _) = l\n\n-- | The main worker class\nclass ToHie a where\n  toHie :: a -> HieM [HieAST Type]\n\n-- | Used to collect type info\nclass Data a => HasType a where\n  getTypeNode :: a -> HieM [HieAST Type]\n\ninstance (ToHie a) => ToHie [a] where\n  toHie = concatMapM toHie\n\ninstance (ToHie a) => ToHie (Bag a) where\n  toHie = toHie . bagToList\n\ninstance (ToHie a) => ToHie (Maybe a) where\n  toHie = maybe (pure []) toHie\n\ninstance ToHie (Context (Located NoExt)) where\n  toHie _ = pure []\n\ninstance ToHie (TScoped NoExt) where\n  toHie _ = pure []\n\ninstance ToHie (IEContext (Located ModuleName)) where\n  toHie (IEC c (L (RealSrcSpan span) mname)) =\n      pure $ [Node (NodeInfo S.empty [] idents) span []]\n    where details = mempty{identInfo = S.singleton (IEThing c)}\n          idents = M.singleton (Left mname) details\n  toHie _ = pure []\n\ninstance ToHie (Context (Located Var)) where\n  toHie c = case c of\n      C context (L (RealSrcSpan span) name')\n        -> do\n        m <- asks name_remapping\n        let name = case lookupNameEnv m (varName name') of\n              Just var -> var\n              Nothing-> name'\n        pure\n          [Node\n            (NodeInfo S.empty [] $\n              M.singleton (Right $ varName name)\n                          (IdentifierDetails (Just $ varType name')\n                                             (S.singleton context)))\n            span\n            []]\n      _ -> pure []\n\ninstance ToHie (Context (Located Name)) where\n  toHie c = case c of\n      C context (L (RealSrcSpan span) name') -> do\n        m <- asks name_remapping\n        let name = case lookupNameEnv m name' of\n              Just var -> varName var\n              Nothing -> name'\n        pure\n          [Node\n            (NodeInfo S.empty [] $\n              M.singleton (Right name)\n                          (IdentifierDetails Nothing\n                                             (S.singleton context)))\n            span\n            []]\n      _ -> pure []\n\n-- | Dummy instances - never called\ninstance ToHie (TScoped (LHsSigWcType GhcTc)) where\n  toHie _ = pure []\ninstance ToHie (TScoped (LHsWcType GhcTc)) where\n  toHie _ = pure []\ninstance ToHie (SigContext (LSig GhcTc)) where\n  toHie _ = pure []\ninstance ToHie (TScoped Type) where\n  toHie _ = pure []\n\ninstance HasType (LHsBind GhcRn) where\n  getTypeNode (L spn bind) = makeNode bind spn\n\ninstance HasType (LHsBind GhcTc) where\n  getTypeNode (L spn bind) = case bind of\n      FunBind{fun_id = name} -> makeTypeNode bind spn (varType $ unLoc name)\n      _ -> makeNode bind spn\n\ninstance HasType (LPat GhcRn) where\n  getTypeNode (dL -> L spn pat) = makeNode pat spn\n\ninstance HasType (LPat GhcTc) where\n  getTypeNode (dL -> L spn opat) = makeTypeNode opat spn (hsPatType opat)\n\ninstance HasType (LHsExpr GhcRn) where\n  getTypeNode (L spn e) = makeNode e spn\n\n-- | This instance tries to construct 'HieAST' nodes which include the type of\n-- the expression. It is not yet possible to do this efficiently for all\n-- expression forms, so we skip filling in the type for those inputs.\n--\n-- 'HsApp', for example, doesn't have any type information available directly on\n-- the node. Our next recourse would be to desugar it into a 'CoreExpr' then\n-- query the type of that. Yet both the desugaring call and the type query both\n-- involve recursive calls to the function and argument! This is particularly\n-- problematic when you realize that the HIE traversal will eventually visit\n-- those nodes too and ask for their types again.\n--\n-- Since the above is quite costly, we just skip cases where computing the\n-- expression's type is going to be expensive.\n--\n-- See #16233\ninstance HasType (LHsExpr GhcTc) where\n  getTypeNode e@(L spn e') = lift $\n    -- Some expression forms have their type immediately available\n    let tyOpt = case e' of\n          HsLit _ l -> Just (hsLitType l)\n          HsOverLit _ o -> Just (overLitType o)\n\n          HsLam     _ (MG { mg_ext = groupTy }) -> Just (matchGroupType groupTy)\n          HsLamCase _ (MG { mg_ext = groupTy }) -> Just (matchGroupType groupTy)\n          HsCase _  _ (MG { mg_ext = groupTy }) -> Just (mg_res_ty groupTy)\n\n          ExplicitList  ty _ _   -> Just (mkListTy ty)\n          ExplicitSum   ty _ _ _ -> Just (mkSumTy ty)\n          HsDo          ty _ _   -> Just ty\n          HsMultiIf     ty _     -> Just ty\n\n          _ -> Nothing\n\n    in\n    case tyOpt of\n      _ | skipDesugaring e' -> fallback\n        | otherwise -> do\n            hs_env <- Hsc $ \\e w -> return (e,w)\n            (_,mbe) <- liftIO $ deSugarExpr hs_env e\n            maybe fallback (makeTypeNode e' spn . exprType) mbe\n    where\n      fallback = makeNode e' spn\n\n      matchGroupType :: MatchGroupTc -> Type\n      matchGroupType (MatchGroupTc args res) = mkVisFunTys args res\n\n      -- | Skip desugaring of these expressions for performance reasons.\n      --\n      -- See impact on Haddock output (esp. missing type annotations or links)\n      -- before marking more things here as 'False'. See impact on Haddock\n      -- performance before marking more things as 'True'.\n      skipDesugaring :: HsExpr a -> Bool\n      skipDesugaring e = case e of\n        HsVar{}        -> False\n        HsUnboundVar{} -> False\n        HsConLikeOut{} -> False\n        HsRecFld{}     -> False\n        HsOverLabel{}  -> False\n        HsIPVar{}      -> False\n        HsWrap{}       -> False\n        _              -> True\n\ninstance ( ToHie (Context (Located (IdP a)))\n         , ToHie (MatchGroup a (LHsExpr a))\n         , ToHie (PScoped (LPat a))\n         , ToHie (GRHSs a (LHsExpr a))\n         , ToHie (LHsExpr a)\n         , ToHie (Located (PatSynBind a a))\n         , HasType (LHsBind a)\n         , ModifyState (IdP a)\n         , Data (HsBind a)\n         ) => ToHie (BindContext (LHsBind a)) where\n  toHie (BC context scope b@(L span bind)) =\n    concatM $ getTypeNode b : case bind of\n      FunBind{fun_id = name, fun_matches = matches} ->\n        [ toHie $ C (ValBind context scope $ getRealSpan span) name\n        , toHie matches\n        ]\n      PatBind{pat_lhs = lhs, pat_rhs = rhs} ->\n        [ toHie $ PS (getRealSpan span) scope NoScope lhs\n        , toHie rhs\n        ]\n      VarBind{var_rhs = expr} ->\n        [ toHie expr\n        ]\n      AbsBinds{abs_exports = xs, abs_binds = binds} ->\n        [ local (modifyState xs) $ -- Note [Name Remapping]\n            toHie $ fmap (BC context scope) binds\n        ]\n      PatSynBind _ psb ->\n        [ toHie $ L span psb -- PatSynBinds only occur at the top level\n        ]\n      XHsBindsLR _ -> []\n\ninstance ( ToHie (LMatch a body)\n         ) => ToHie (MatchGroup a body) where\n  toHie mg = concatM $ case mg of\n    MG{ mg_alts = (L span alts) , mg_origin = FromSource } ->\n      [ pure $ locOnly span\n      , toHie alts\n      ]\n    MG{} -> []\n    XMatchGroup _ -> []\n\ninstance ( ToHie (Context (Located (IdP a)))\n         , ToHie (PScoped (LPat a))\n         , ToHie (HsPatSynDir a)\n         ) => ToHie (Located (PatSynBind a a)) where\n    toHie (L sp psb) = concatM $ case psb of\n      PSB{psb_id=var, psb_args=dets, psb_def=pat, psb_dir=dir} ->\n        [ toHie $ C (Decl PatSynDec $ getRealSpan sp) var\n        , toHie $ toBind dets\n        , toHie $ PS Nothing lhsScope NoScope pat\n        , toHie dir\n        ]\n        where\n          lhsScope = combineScopes varScope detScope\n          varScope = mkLScope var\n          detScope = case dets of\n            (PrefixCon args) -> foldr combineScopes NoScope $ map mkLScope args\n            (InfixCon a b) -> combineScopes (mkLScope a) (mkLScope b)\n            (RecCon r) -> foldr go NoScope r\n          go (RecordPatSynField a b) c = combineScopes c\n            $ combineScopes (mkLScope a) (mkLScope b)\n          detSpan = case detScope of\n            LocalScope a -> Just a\n            _ -> Nothing\n          toBind (PrefixCon args) = PrefixCon $ map (C Use) args\n          toBind (InfixCon a b) = InfixCon (C Use a) (C Use b)\n          toBind (RecCon r) = RecCon $ map (PSC detSpan) r\n      XPatSynBind _ -> []\n\ninstance ( ToHie (MatchGroup a (LHsExpr a))\n         ) => ToHie (HsPatSynDir a) where\n  toHie dir = case dir of\n    ExplicitBidirectional mg -> toHie mg\n    _ -> pure []\n\ninstance ( a ~ GhcPass p\n         , ToHie body\n         , ToHie (HsMatchContext (NameOrRdrName (IdP a)))\n         , ToHie (PScoped (LPat a))\n         , ToHie (GRHSs a body)\n         , Data (Match a body)\n         ) => ToHie (LMatch (GhcPass p) body) where\n  toHie (L span m ) = concatM $ makeNode m span : case m of\n    Match{m_ctxt=mctx, m_pats = pats, m_grhss =  grhss } ->\n      [ toHie mctx\n      , let rhsScope = mkScope $ grhss_span grhss\n          in toHie $ patScopes Nothing rhsScope NoScope pats\n      , toHie grhss\n      ]\n    XMatch _ -> []\n\ninstance ( ToHie (Context (Located a))\n         ) => ToHie (HsMatchContext a) where\n  toHie (FunRhs{mc_fun=name}) = toHie $ C MatchBind name\n  toHie (StmtCtxt a) = toHie a\n  toHie _ = pure []\n\ninstance ( ToHie (HsMatchContext a)\n         ) => ToHie (HsStmtContext a) where\n  toHie (PatGuard a) = toHie a\n  toHie (ParStmtCtxt a) = toHie a\n  toHie (TransStmtCtxt a) = toHie a\n  toHie _ = pure []\n\ninstance ( a ~ GhcPass p\n         , ToHie (Context (Located (IdP a)))\n         , ToHie (RContext (HsRecFields a (PScoped (LPat a))))\n         , ToHie (LHsExpr a)\n         , ToHie (TScoped (LHsSigWcType a))\n         , ProtectSig a\n         , ToHie (TScoped (ProtectedSig a))\n         , HasType (LPat a)\n         , Data (HsSplice a)\n         ) => ToHie (PScoped (LPat (GhcPass p))) where\n  toHie (PS rsp scope pscope lpat@(dL -> L ospan opat)) =\n    concatM $ getTypeNode lpat : case opat of\n      WildPat _ ->\n        []\n      VarPat _ lname ->\n        [ toHie $ C (PatternBind scope pscope rsp) lname\n        ]\n      LazyPat _ p ->\n        [ toHie $ PS rsp scope pscope p\n        ]\n      AsPat _ lname pat ->\n        [ toHie $ C (PatternBind scope\n                                 (combineScopes (mkLScope (dL pat)) pscope)\n                                 rsp)\n                    lname\n        , toHie $ PS rsp scope pscope pat\n        ]\n      ParPat _ pat ->\n        [ toHie $ PS rsp scope pscope pat\n        ]\n      BangPat _ pat ->\n        [ toHie $ PS rsp scope pscope pat\n        ]\n      ListPat _ pats ->\n        [ toHie $ patScopes rsp scope pscope pats\n        ]\n      TuplePat _ pats _ ->\n        [ toHie $ patScopes rsp scope pscope pats\n        ]\n      SumPat _ pat _ _ ->\n        [ toHie $ PS rsp scope pscope pat\n        ]\n      ConPatIn c dets ->\n        [ toHie $ C Use c\n        , toHie $ contextify dets\n        ]\n      ConPatOut {pat_con = con, pat_args = dets}->\n        [ toHie $ C Use $ fmap conLikeName con\n        , toHie $ contextify dets\n        ]\n      ViewPat _ expr pat ->\n        [ toHie expr\n        , toHie $ PS rsp scope pscope pat\n        ]\n      SplicePat _ sp ->\n        [ toHie $ L ospan sp\n        ]\n      LitPat _ _ ->\n        []\n      NPat _ _ _ _ ->\n        []\n      NPlusKPat _ n _ _ _ _ ->\n        [ toHie $ C (PatternBind scope pscope rsp) n\n        ]\n      SigPat _ pat sig ->\n        [ toHie $ PS rsp scope pscope pat\n        , let cscope = mkLScope (dL pat) in\n            toHie $ TS (ResolvedScopes [cscope, scope, pscope])\n                       (protectSig @a cscope sig)\n              -- See Note [Scoping Rules for SigPat]\n        ]\n      CoPat _ _ _ _ ->\n        []\n      XPat _ -> []\n    where\n      contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args\n      contextify (InfixCon a b) = InfixCon a' b'\n        where [a', b'] = patScopes rsp scope pscope [a,b]\n      contextify (RecCon r) = RecCon $ RC RecFieldMatch $ contextify_rec r\n      contextify_rec (HsRecFields fds a) = HsRecFields (map go scoped_fds) a\n        where\n          go (RS fscope (L spn (HsRecField lbl pat pun))) =\n            L spn $ HsRecField lbl (PS rsp scope fscope pat) pun\n          scoped_fds = listScopes pscope fds\n\ninstance ( ToHie body\n         , ToHie (LGRHS a body)\n         , ToHie (RScoped (LHsLocalBinds a))\n         ) => ToHie (GRHSs a body) where\n  toHie grhs = concatM $ case grhs of\n    GRHSs _ grhss binds ->\n     [ toHie grhss\n     , toHie $ RS (mkScope $ grhss_span grhs) binds\n     ]\n    XGRHSs _ -> []\n\ninstance ( ToHie (Located body)\n         , ToHie (RScoped (GuardLStmt a))\n         , Data (GRHS a (Located body))\n         ) => ToHie (LGRHS a (Located body)) where\n  toHie (L span g) = concatM $ makeNode g span : case g of\n    GRHS _ guards body ->\n      [ toHie $ listScopes (mkLScope body) guards\n      , toHie body\n      ]\n    XGRHS _ -> []\n\ninstance ( a ~ GhcPass p\n         , ToHie (Context (Located (IdP a)))\n         , HasType (LHsExpr a)\n         , ToHie (PScoped (LPat a))\n         , ToHie (MatchGroup a (LHsExpr a))\n         , ToHie (LGRHS a (LHsExpr a))\n         , ToHie (RContext (HsRecordBinds a))\n         , ToHie (RFContext (Located (AmbiguousFieldOcc a)))\n         , ToHie (ArithSeqInfo a)\n         , ToHie (LHsCmdTop a)\n         , ToHie (RScoped (GuardLStmt a))\n         , ToHie (RScoped (LHsLocalBinds a))\n         , ToHie (TScoped (LHsWcType (NoGhcTc a)))\n         , ToHie (TScoped (LHsSigWcType (NoGhcTc a)))\n         , Data (HsExpr a)\n         , Data (HsSplice a)\n         , Data (HsTupArg a)\n         , Data (AmbiguousFieldOcc a)\n         ) => ToHie (LHsExpr (GhcPass p)) where\n  toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of\n      HsVar _ (L _ var) ->\n        [ toHie $ C Use (L mspan var)\n             -- Patch up var location since typechecker removes it\n        ]\n      HsUnboundVar _ _ ->\n        []\n      HsConLikeOut _ con ->\n        [ toHie $ C Use $ L mspan $ conLikeName con\n        ]\n      HsRecFld _ fld ->\n        [ toHie $ RFC RecFieldOcc Nothing (L mspan fld)\n        ]\n      HsOverLabel _ _ _ -> []\n      HsIPVar _ _ -> []\n      HsOverLit _ _ -> []\n      HsLit _ _ -> []\n      HsLam _ mg ->\n        [ toHie mg\n        ]\n      HsLamCase _ mg ->\n        [ toHie mg\n        ]\n      HsApp _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      HsAppType _ expr sig ->\n        [ toHie expr\n        , toHie $ TS (ResolvedScopes []) sig\n        ]\n      OpApp _ a b c ->\n        [ toHie a\n        , toHie b\n        , toHie c\n        ]\n      NegApp _ a _ ->\n        [ toHie a\n        ]\n      HsPar _ a ->\n        [ toHie a\n        ]\n      SectionL _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      SectionR _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      ExplicitTuple _ args _ ->\n        [ toHie args\n        ]\n      ExplicitSum _ _ _ expr ->\n        [ toHie expr\n        ]\n      HsCase _ expr matches ->\n        [ toHie expr\n        , toHie matches\n        ]\n      HsIf _ _ a b c ->\n        [ toHie a\n        , toHie b\n        , toHie c\n        ]\n      HsMultiIf _ grhss ->\n        [ toHie grhss\n        ]\n      HsLet _ binds expr ->\n        [ toHie $ RS (mkLScope expr) binds\n        , toHie expr\n        ]\n      HsDo _ _ (L ispan stmts) ->\n        [ pure $ locOnly ispan\n        , toHie $ listScopes NoScope stmts\n        ]\n      ExplicitList _ _ exprs ->\n        [ toHie exprs\n        ]\n      RecordCon {rcon_con_name = name, rcon_flds = binds}->\n        [ toHie $ C Use name\n        , toHie $ RC RecFieldAssign $ binds\n        ]\n      RecordUpd {rupd_expr = expr, rupd_flds = upds}->\n        [ toHie expr\n        , toHie $ map (RC RecFieldAssign) upds\n        ]\n      ExprWithTySig _ expr sig ->\n        [ toHie expr\n        , toHie $ TS (ResolvedScopes [mkLScope expr]) sig\n        ]\n      ArithSeq _ _ info ->\n        [ toHie info\n        ]\n      HsSCC _ _ _ expr ->\n        [ toHie expr\n        ]\n      HsCoreAnn _ _ _ expr ->\n        [ toHie expr\n        ]\n      HsProc _ pat cmdtop ->\n        [ toHie $ PS Nothing (mkLScope cmdtop) NoScope pat\n        , toHie cmdtop\n        ]\n      HsStatic _ expr ->\n        [ toHie expr\n        ]\n      HsTick _ _ expr ->\n        [ toHie expr\n        ]\n      HsBinTick _ _ _ expr ->\n        [ toHie expr\n        ]\n      HsTickPragma _ _ _ _ expr ->\n        [ toHie expr\n        ]\n      HsWrap _ _ a ->\n        [ toHie $ L mspan a\n        ]\n      HsBracket _ b ->\n        [ toHie b\n        ]\n      HsRnBracketOut _ b p ->\n        [ toHie b\n        , toHie p\n        ]\n      HsTcBracketOut _ b p ->\n        [ toHie b\n        , toHie p\n        ]\n      HsSpliceE _ x ->\n        [ toHie $ L mspan x\n        ]\n      EWildPat _ -> []\n      EAsPat _ a b ->\n        [ toHie $ C Use a\n        , toHie b\n        ]\n      EViewPat _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      ELazyPat _ a ->\n        [ toHie a\n        ]\n      XExpr _ -> []\n\ninstance ( a ~ GhcPass p\n         , ToHie (LHsExpr a)\n         , Data (HsTupArg a)\n         ) => ToHie (LHsTupArg (GhcPass p)) where\n  toHie (L span arg) = concatM $ makeNode arg span : case arg of\n    Present _ expr ->\n      [ toHie expr\n      ]\n    Missing _ -> []\n    XTupArg _ -> []\n\ninstance ( a ~ GhcPass p\n         , ToHie (PScoped (LPat a))\n         , ToHie (LHsExpr a)\n         , ToHie (SigContext (LSig a))\n         , ToHie (RScoped (LHsLocalBinds a))\n         , ToHie (RScoped (ApplicativeArg a))\n         , ToHie (Located body)\n         , Data (StmtLR a a (Located body))\n         , Data (StmtLR a a (Located (HsExpr a)))\n         ) => ToHie (RScoped (LStmt (GhcPass p) (Located body))) where\n  toHie (RS scope (L span stmt)) = concatM $ makeNode stmt span : case stmt of\n      LastStmt _ body _ _ ->\n        [ toHie body\n        ]\n      BindStmt _ pat body _ _ ->\n        [ toHie $ PS (getRealSpan $ getLoc body) scope NoScope pat\n        , toHie body\n        ]\n      ApplicativeStmt _ stmts _ ->\n        [ concatMapM (toHie . RS scope . snd) stmts\n        ]\n      BodyStmt _ body _ _ ->\n        [ toHie body\n        ]\n      LetStmt _ binds ->\n        [ toHie $ RS scope binds\n        ]\n      ParStmt _ parstmts _ _ ->\n        [ concatMapM (\\(ParStmtBlock _ stmts _ _) ->\n                          toHie $ listScopes NoScope stmts)\n                     parstmts\n        ]\n      TransStmt {trS_stmts = stmts, trS_using = using, trS_by = by} ->\n        [ toHie $ listScopes scope stmts\n        , toHie using\n        , toHie by\n        ]\n      RecStmt {recS_stmts = stmts} ->\n        [ toHie $ map (RS $ combineScopes scope (mkScope span)) stmts\n        ]\n      XStmtLR _ -> []\n\ninstance ( ToHie (LHsExpr a)\n         , ToHie (PScoped (LPat a))\n         , ToHie (BindContext (LHsBind a))\n         , ToHie (SigContext (LSig a))\n         , ToHie (RScoped (HsValBindsLR a a))\n         , Data (HsLocalBinds a)\n         ) => ToHie (RScoped (LHsLocalBinds a)) where\n  toHie (RS scope (L sp binds)) = concatM $ makeNode binds sp : case binds of\n      EmptyLocalBinds _ -> []\n      HsIPBinds _ _ -> []\n      HsValBinds _ valBinds ->\n        [ toHie $ RS (combineScopes scope $ mkScope sp)\n                      valBinds\n        ]\n      XHsLocalBindsLR _ -> []\n\ninstance ( ToHie (BindContext (LHsBind a))\n         , ToHie (SigContext (LSig a))\n         , ToHie (RScoped (XXValBindsLR a a))\n         ) => ToHie (RScoped (HsValBindsLR a a)) where\n  toHie (RS sc v) = concatM $ case v of\n    ValBinds _ binds sigs ->\n      [ toHie $ fmap (BC RegularBind sc) binds\n      , toHie $ fmap (SC (SI BindSig Nothing)) sigs\n      ]\n    XValBindsLR x -> [ toHie $ RS sc x ]\n\ninstance ToHie (RScoped (NHsValBindsLR GhcTc)) where\n  toHie (RS sc (NValBinds binds sigs)) = concatM $\n    [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds)\n    , toHie $ fmap (SC (SI BindSig Nothing)) sigs\n    ]\ninstance ToHie (RScoped (NHsValBindsLR GhcRn)) where\n  toHie (RS sc (NValBinds binds sigs)) = concatM $\n    [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds)\n    , toHie $ fmap (SC (SI BindSig Nothing)) sigs\n    ]\n\ninstance ( ToHie (RContext (LHsRecField a arg))\n         ) => ToHie (RContext (HsRecFields a arg)) where\n  toHie (RC c (HsRecFields fields _)) = toHie $ map (RC c) fields\n\ninstance ( ToHie (RFContext (Located label))\n         , ToHie arg\n         , HasLoc arg\n         , Data label\n         , Data arg\n         ) => ToHie (RContext (LHsRecField' label arg)) where\n  toHie (RC c (L span recfld)) = concatM $ makeNode recfld span : case recfld of\n    HsRecField label expr _ ->\n      [ toHie $ RFC c (getRealSpan $ loc expr) label\n      , toHie expr\n      ]\n\nremoveDefSrcSpan :: Name -> Name\nremoveDefSrcSpan n = setNameLoc n noSrcSpan\n\ninstance ToHie (RFContext (LFieldOcc GhcRn)) where\n  toHie (RFC c rhs (L nspan f)) = concatM $ case f of\n    FieldOcc name _ ->\n      [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name)\n      ]\n    XFieldOcc _ -> []\n\ninstance ToHie (RFContext (LFieldOcc GhcTc)) where\n  toHie (RFC c rhs (L nspan f)) = concatM $ case f of\n    FieldOcc var _ ->\n      let var' = setVarName var (removeDefSrcSpan $ varName var)\n      in [ toHie $ C (RecField c rhs) (L nspan var')\n         ]\n    XFieldOcc _ -> []\n\ninstance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where\n  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of\n    Unambiguous name _ ->\n      [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name\n      ]\n    Ambiguous _name _ ->\n      [ ]\n    XAmbiguousFieldOcc _ -> []\n\ninstance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where\n  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of\n    Unambiguous var _ ->\n      let var' = setVarName var (removeDefSrcSpan $ varName var)\n      in [ toHie $ C (RecField c rhs) (L nspan var')\n         ]\n    Ambiguous var _ ->\n      let var' = setVarName var (removeDefSrcSpan $ varName var)\n      in [ toHie $ C (RecField c rhs) (L nspan var')\n         ]\n    XAmbiguousFieldOcc _ -> []\n\ninstance ( a ~ GhcPass p\n         , ToHie (PScoped (LPat a))\n         , ToHie (BindContext (LHsBind a))\n         , ToHie (LHsExpr a)\n         , ToHie (SigContext (LSig a))\n         , ToHie (RScoped (HsValBindsLR a a))\n         , Data (StmtLR a a (Located (HsExpr a)))\n         , Data (HsLocalBinds a)\n         ) => ToHie (RScoped (ApplicativeArg (GhcPass p))) where\n  toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM\n    [ toHie $ PS Nothing sc NoScope pat\n    , toHie expr\n    ]\n  toHie (RS sc (ApplicativeArgMany _ stmts _ pat)) = concatM\n    [ toHie $ listScopes NoScope stmts\n    , toHie $ PS Nothing sc NoScope pat\n    ]\n  toHie (RS _ (XApplicativeArg _)) = pure []\n\ninstance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where\n  toHie (PrefixCon args) = toHie args\n  toHie (RecCon rec) = toHie rec\n  toHie (InfixCon a b) = concatM [ toHie a, toHie b]\n\ninstance ( ToHie (LHsCmd a)\n         , Data  (HsCmdTop a)\n         ) => ToHie (LHsCmdTop a) where\n  toHie (L span top) = concatM $ makeNode top span : case top of\n    HsCmdTop _ cmd ->\n      [ toHie cmd\n      ]\n    XCmdTop _ -> []\n\ninstance ( a ~ GhcPass p\n         , ToHie (PScoped (LPat a))\n         , ToHie (BindContext (LHsBind a))\n         , ToHie (LHsExpr a)\n         , ToHie (MatchGroup a (LHsCmd a))\n         , ToHie (SigContext (LSig a))\n         , ToHie (RScoped (HsValBindsLR a a))\n         , Data (HsCmd a)\n         , Data (HsCmdTop a)\n         , Data (StmtLR a a (Located (HsCmd a)))\n         , Data (HsLocalBinds a)\n         , Data (StmtLR a a (Located (HsExpr a)))\n         ) => ToHie (LHsCmd (GhcPass p)) where\n  toHie (L span cmd) = concatM $ makeNode cmd span : case cmd of\n      HsCmdArrApp _ a b _ _ ->\n        [ toHie a\n        , toHie b\n        ]\n      HsCmdArrForm _ a _ _ cmdtops ->\n        [ toHie a\n        , toHie cmdtops\n        ]\n      HsCmdApp _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      HsCmdLam _ mg ->\n        [ toHie mg\n        ]\n      HsCmdPar _ a ->\n        [ toHie a\n        ]\n      HsCmdCase _ expr alts ->\n        [ toHie expr\n        , toHie alts\n        ]\n      HsCmdIf _ _ a b c ->\n        [ toHie a\n        , toHie b\n        , toHie c\n        ]\n      HsCmdLet _ binds cmd' ->\n        [ toHie $ RS (mkLScope cmd') binds\n        , toHie cmd'\n        ]\n      HsCmdDo _ (L ispan stmts) ->\n        [ pure $ locOnly ispan\n        , toHie $ listScopes NoScope stmts\n        ]\n      HsCmdWrap _ _ _ -> []\n      XCmd _ -> []\n\ninstance ToHie (TyClGroup GhcRn) where\n  toHie (TyClGroup _ classes roles instances) = concatM\n    [ toHie classes\n    , toHie roles\n    , toHie instances\n    ]\n  toHie (XTyClGroup _) = pure []\n\ninstance ToHie (LTyClDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      FamDecl {tcdFam = fdecl} ->\n        [ toHie (L span fdecl)\n        ]\n      SynDecl {tcdLName = name, tcdTyVars = vars, tcdRhs = typ} ->\n        [ toHie $ C (Decl SynDec $ getRealSpan span) name\n        , toHie $ TS (ResolvedScopes [mkScope $ getLoc typ]) vars\n        , toHie typ\n        ]\n      DataDecl {tcdLName = name, tcdTyVars = vars, tcdDataDefn = defn} ->\n        [ toHie $ C (Decl DataDec $ getRealSpan span) name\n        , toHie $ TS (ResolvedScopes [quant_scope, rhs_scope]) vars\n        , toHie defn\n        ]\n        where\n          quant_scope = mkLScope $ dd_ctxt defn\n          rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc\n          sig_sc = maybe NoScope mkLScope $ dd_kindSig defn\n          con_sc = foldr combineScopes NoScope $ map mkLScope $ dd_cons defn\n          deriv_sc = mkLScope $ dd_derivs defn\n      ClassDecl { tcdCtxt = context\n                , tcdLName = name\n                , tcdTyVars = vars\n                , tcdFDs = deps\n                , tcdSigs = sigs\n                , tcdMeths = meths\n                , tcdATs = typs\n                , tcdATDefs = deftyps\n                } ->\n        [ toHie $ C (Decl ClassDec $ getRealSpan span) name\n        , toHie context\n        , toHie $ TS (ResolvedScopes [context_scope, rhs_scope]) vars\n        , toHie deps\n        , toHie $ map (SC $ SI ClassSig $ getRealSpan span) sigs\n        , toHie $ fmap (BC InstanceBind ModuleScope) meths\n        , toHie typs\n        , concatMapM (pure . locOnly . getLoc) deftyps\n        , toHie $ map (go . unLoc) deftyps\n        ]\n        where\n          context_scope = mkLScope context\n          rhs_scope = foldl1' combineScopes $ map mkScope\n            [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps]\n\n          go :: TyFamDefltEqn GhcRn\n             -> FamEqn GhcRn (TScoped (LHsQTyVars GhcRn)) (LHsType GhcRn)\n          go (FamEqn a var bndrs pat b rhs) =\n             FamEqn a var bndrs (TS (ResolvedScopes [mkLScope rhs]) pat) b rhs\n          go (XFamEqn NoExt) = XFamEqn NoExt\n      XTyClDecl _ -> []\n\ninstance ToHie (LFamilyDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      FamilyDecl _ info name vars _ sig inj ->\n        [ toHie $ C (Decl FamDec $ getRealSpan span) name\n        , toHie $ TS (ResolvedScopes [rhsSpan]) vars\n        , toHie info\n        , toHie $ RS injSpan sig\n        , toHie inj\n        ]\n        where\n          rhsSpan = sigSpan `combineScopes` injSpan\n          sigSpan = mkScope $ getLoc sig\n          injSpan = maybe NoScope (mkScope . getLoc) inj\n      XFamilyDecl _ -> []\n\ninstance ToHie (FamilyInfo GhcRn) where\n  toHie (ClosedTypeFamily (Just eqns)) = concatM $\n    [ concatMapM (pure . locOnly . getLoc) eqns\n    , toHie $ map go eqns\n    ]\n    where\n      go (L l ib) = TS (ResolvedScopes [mkScope l]) ib\n  toHie _ = pure []\n\ninstance ToHie (RScoped (LFamilyResultSig GhcRn)) where\n  toHie (RS sc (L span sig)) = concatM $ makeNode sig span : case sig of\n      NoSig _ ->\n        []\n      KindSig _ k ->\n        [ toHie k\n        ]\n      TyVarSig _ bndr ->\n        [ toHie $ TVS (ResolvedScopes [sc]) NoScope bndr\n        ]\n      XFamilyResultSig _ -> []\n\ninstance ToHie (Located (FunDep (Located Name))) where\n  toHie (L span fd@(lhs, rhs)) = concatM $\n    [ makeNode fd span\n    , toHie $ map (C Use) lhs\n    , toHie $ map (C Use) rhs\n    ]\n\ninstance (ToHie pats, ToHie rhs, HasLoc pats, HasLoc rhs)\n    => ToHie (TScoped (FamEqn GhcRn pats rhs)) where\n  toHie (TS _ f) = toHie f\n\ninstance ( ToHie pats\n         , ToHie rhs\n         , HasLoc pats\n         , HasLoc rhs\n         ) => ToHie (FamEqn GhcRn pats rhs) where\n  toHie fe@(FamEqn _ var tybndrs pats _ rhs) = concatM $\n    [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var\n    , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs\n    , toHie pats\n    , toHie rhs\n    ]\n    where scope = combineScopes patsScope rhsScope\n          patsScope = mkScope (loc pats)\n          rhsScope = mkScope (loc rhs)\n  toHie (XFamEqn _) = pure []\n\ninstance ToHie (LInjectivityAnn GhcRn) where\n  toHie (L span ann) = concatM $ makeNode ann span : case ann of\n      InjectivityAnn lhs rhs ->\n        [ toHie $ C Use lhs\n        , toHie $ map (C Use) rhs\n        ]\n\ninstance ToHie (HsDataDefn GhcRn) where\n  toHie (HsDataDefn _ _ ctx _ mkind cons derivs) = concatM\n    [ toHie ctx\n    , toHie mkind\n    , toHie cons\n    , toHie derivs\n    ]\n  toHie (XHsDataDefn _) = pure []\n\ninstance ToHie (HsDeriving GhcRn) where\n  toHie (L span clauses) = concatM\n    [ pure $ locOnly span\n    , toHie clauses\n    ]\n\ninstance ToHie (LHsDerivingClause GhcRn) where\n  toHie (L span cl) = concatM $ makeNode cl span : case cl of\n      HsDerivingClause _ strat (L ispan tys) ->\n        [ toHie strat\n        , pure $ locOnly ispan\n        , toHie $ map (TS (ResolvedScopes [])) tys\n        ]\n      XHsDerivingClause _ -> []\n\ninstance ToHie (Located (DerivStrategy GhcRn)) where\n  toHie (L span strat) = concatM $ makeNode strat span : case strat of\n      StockStrategy -> []\n      AnyclassStrategy -> []\n      NewtypeStrategy -> []\n      ViaStrategy s -> [ toHie $ TS (ResolvedScopes []) s ]\n\ninstance ToHie (Located OverlapMode) where\n  toHie (L span _) = pure $ locOnly span\n\ninstance ToHie (LConDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      ConDeclGADT { con_names = names, con_qvars = qvars\n                  , con_mb_cxt = ctx, con_args = args, con_res_ty = typ } ->\n        [ toHie $ map (C (Decl ConDec $ getRealSpan span)) names\n        , toHie $ TS (ResolvedScopes [ctxScope, rhsScope]) qvars\n        , toHie ctx\n        , toHie args\n        , toHie typ\n        ]\n        where\n          rhsScope = combineScopes argsScope tyScope\n          ctxScope = maybe NoScope mkLScope ctx\n          argsScope = condecl_scope args\n          tyScope = mkLScope typ\n      ConDeclH98 { con_name = name, con_ex_tvs = qvars\n                 , con_mb_cxt = ctx, con_args = dets } ->\n        [ toHie $ C (Decl ConDec $ getRealSpan span) name\n        , toHie $ tvScopes (ResolvedScopes []) rhsScope qvars\n        , toHie ctx\n        , toHie dets\n        ]\n        where\n          rhsScope = combineScopes ctxScope argsScope\n          ctxScope = maybe NoScope mkLScope ctx\n          argsScope = condecl_scope dets\n      XConDecl _ -> []\n    where condecl_scope args = case args of\n            PrefixCon xs -> foldr combineScopes NoScope $ map mkLScope xs\n            InfixCon a b -> combineScopes (mkLScope a) (mkLScope b)\n            RecCon x -> mkLScope x\n\ninstance ToHie (Located [LConDeclField GhcRn]) where\n  toHie (L span decls) = concatM $\n    [ pure $ locOnly span\n    , toHie decls\n    ]\n\ninstance ( HasLoc thing\n         , ToHie (TScoped thing)\n         ) => ToHie (TScoped (HsImplicitBndrs GhcRn thing)) where\n  toHie (TS sc (HsIB ibrn a)) = concatM $\n      [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) ibrn\n      , toHie $ TS sc a\n      ]\n    where span = loc a\n  toHie (TS _ (XHsImplicitBndrs _)) = pure []\n\ninstance ( HasLoc thing\n         , ToHie (TScoped thing)\n         ) => ToHie (TScoped (HsWildCardBndrs GhcRn thing)) where\n  toHie (TS sc (HsWC names a)) = concatM $\n      [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names\n      , toHie $ TS sc a\n      ]\n    where span = loc a\n  toHie (TS _ (XHsWildCardBndrs _)) = pure []\n\ninstance ToHie (SigContext (LSig GhcRn)) where\n  toHie (SC (SI styp msp) (L sp sig)) = concatM $ makeNode sig sp : case sig of\n      TypeSig _ names typ ->\n        [ toHie $ map (C TyDecl) names\n        , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ\n        ]\n      PatSynSig _ names typ ->\n        [ toHie $ map (C TyDecl) names\n        , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ\n        ]\n      ClassOpSig _ _ names typ ->\n        [ case styp of\n            ClassSig -> toHie $ map (C $ ClassTyDecl $ getRealSpan sp) names\n            _  -> toHie $ map (C $ TyDecl) names\n        , toHie $ TS (UnresolvedScope (map unLoc names) msp) typ\n        ]\n      IdSig _ _ -> []\n      FixSig _ fsig ->\n        [ toHie $ L sp fsig\n        ]\n      InlineSig _ name _ ->\n        [ toHie $ (C Use) name\n        ]\n      SpecSig _ name typs _ ->\n        [ toHie $ (C Use) name\n        , toHie $ map (TS (ResolvedScopes [])) typs\n        ]\n      SpecInstSig _ _ typ ->\n        [ toHie $ TS (ResolvedScopes []) typ\n        ]\n      MinimalSig _ _ form ->\n        [ toHie form\n        ]\n      SCCFunSig _ _ name mtxt ->\n        [ toHie $ (C Use) name\n        , pure $ maybe [] (locOnly . getLoc) mtxt\n        ]\n      CompleteMatchSig _ _ (L ispan names) typ ->\n        [ pure $ locOnly ispan\n        , toHie $ map (C Use) names\n        , toHie $ fmap (C Use) typ\n        ]\n      XSig _ -> []\n\ninstance ToHie (LHsType GhcRn) where\n  toHie x = toHie $ TS (ResolvedScopes []) x\n\ninstance ToHie (TScoped (LHsType GhcRn)) where\n  toHie (TS tsc (L span t)) = concatM $ makeNode t span : case t of\n      HsForAllTy _ _ bndrs body ->\n        [ toHie $ tvScopes tsc (mkScope $ getLoc body) bndrs\n        , toHie body\n        ]\n      HsQualTy _ ctx body ->\n        [ toHie ctx\n        , toHie body\n        ]\n      HsTyVar _ _ var ->\n        [ toHie $ C Use var\n        ]\n      HsAppTy _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      HsAppKindTy _ ty ki ->\n        [ toHie ty\n        , toHie $ TS (ResolvedScopes []) ki\n        ]\n      HsFunTy _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      HsListTy _ a ->\n        [ toHie a\n        ]\n      HsTupleTy _ _ tys ->\n        [ toHie tys\n        ]\n      HsSumTy _ tys ->\n        [ toHie tys\n        ]\n      HsOpTy _ a op b ->\n        [ toHie a\n        , toHie $ C Use op\n        , toHie b\n        ]\n      HsParTy _ a ->\n        [ toHie a\n        ]\n      HsIParamTy _ ip ty ->\n        [ toHie ip\n        , toHie ty\n        ]\n      HsKindSig _ a b ->\n        [ toHie a\n        , toHie b\n        ]\n      HsSpliceTy _ a ->\n        [ toHie $ L span a\n        ]\n      HsDocTy _ a _ ->\n        [ toHie a\n        ]\n      HsBangTy _ _ ty ->\n        [ toHie ty\n        ]\n      HsRecTy _ fields ->\n        [ toHie fields\n        ]\n      HsExplicitListTy _ _ tys ->\n        [ toHie tys\n        ]\n      HsExplicitTupleTy _ tys ->\n        [ toHie tys\n        ]\n      HsTyLit _ _ -> []\n      HsWildCardTy _ -> []\n      HsStarTy _ _ -> []\n      XHsType _ -> []\n\ninstance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where\n  toHie (HsValArg tm) = toHie tm\n  toHie (HsTypeArg _ ty) = toHie ty\n  toHie (HsArgPar sp) = pure $ locOnly sp\n\ninstance ToHie (TVScoped (LHsTyVarBndr GhcRn)) where\n  toHie (TVS tsc sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of\n      UserTyVar _ var ->\n        [ toHie $ C (TyVarBind sc tsc) var\n        ]\n      KindedTyVar _ var kind ->\n        [ toHie $ C (TyVarBind sc tsc) var\n        , toHie kind\n        ]\n      XTyVarBndr _ -> []\n\ninstance ToHie (TScoped (LHsQTyVars GhcRn)) where\n  toHie (TS sc (HsQTvs (HsQTvsRn implicits _) vars)) = concatM $\n    [ pure $ bindingsOnly bindings\n    , toHie $ tvScopes sc NoScope vars\n    ]\n    where\n      varLoc = loc vars\n      bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits\n  toHie (TS _ (XLHsQTyVars _)) = pure []\n\ninstance ToHie (LHsContext GhcRn) where\n  toHie (L span tys) = concatM $\n      [ pure $ locOnly span\n      , toHie tys\n      ]\n\ninstance ToHie (LConDeclField GhcRn) where\n  toHie (L span field) = concatM $ makeNode field span : case field of\n      ConDeclField _ fields typ _ ->\n        [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields\n        , toHie typ\n        ]\n      XConDeclField _ -> []\n\ninstance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where\n  toHie (From expr) = toHie expr\n  toHie (FromThen a b) = concatM $\n    [ toHie a\n    , toHie b\n    ]\n  toHie (FromTo a b) = concatM $\n    [ toHie a\n    , toHie b\n    ]\n  toHie (FromThenTo a b c) = concatM $\n    [ toHie a\n    , toHie b\n    , toHie c\n    ]\n\ninstance ToHie (LSpliceDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      SpliceDecl _ splice _ ->\n        [ toHie splice\n        ]\n      XSpliceDecl _ -> []\n\ninstance ToHie (HsBracket a) where\n  toHie _ = pure []\n\ninstance ToHie PendingRnSplice where\n  toHie _ = pure []\n\ninstance ToHie PendingTcSplice where\n  toHie _ = pure []\n\ninstance ToHie (LBooleanFormula (Located Name)) where\n  toHie (L span form) = concatM $ makeNode form span : case form of\n      Var a ->\n        [ toHie $ C Use a\n        ]\n      And forms ->\n        [ toHie forms\n        ]\n      Or forms ->\n        [ toHie forms\n        ]\n      Parens f ->\n        [ toHie f\n        ]\n\ninstance ToHie (Located HsIPName) where\n  toHie (L span e) = makeNode e span\n\ninstance ( ToHie (LHsExpr a)\n         , Data (HsSplice a)\n         ) => ToHie (Located (HsSplice a)) where\n  toHie (L span sp) = concatM $ makeNode sp span : case sp of\n      HsTypedSplice _ _ _ expr ->\n        [ toHie expr\n        ]\n      HsUntypedSplice _ _ _ expr ->\n        [ toHie expr\n        ]\n      HsQuasiQuote _ _ _ ispan _ ->\n        [ pure $ locOnly ispan\n        ]\n      HsSpliced _ _ _ ->\n        []\n      HsSplicedT _ ->\n        []\n      XSplice _ -> []\n\ninstance ToHie (LRoleAnnotDecl GhcRn) where\n  toHie (L span annot) = concatM $ makeNode annot span : case annot of\n      RoleAnnotDecl _ var roles ->\n        [ toHie $ C Use var\n        , concatMapM (pure . locOnly . getLoc) roles\n        ]\n      XRoleAnnotDecl _ -> []\n\ninstance ToHie (LInstDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      ClsInstD _ d ->\n        [ toHie $ L span d\n        ]\n      DataFamInstD _ d ->\n        [ toHie $ L span d\n        ]\n      TyFamInstD _ d ->\n        [ toHie $ L span d\n        ]\n      XInstDecl _ -> []\n\ninstance ToHie (LClsInstDecl GhcRn) where\n  toHie (L span decl) = concatM\n    [ toHie $ TS (ResolvedScopes [mkScope span]) $ cid_poly_ty decl\n    , toHie $ fmap (BC InstanceBind ModuleScope) $ cid_binds decl\n    , toHie $ map (SC $ SI InstSig $ getRealSpan span) $ cid_sigs decl\n    , pure $ concatMap (locOnly . getLoc) $ cid_tyfam_insts decl\n    , toHie $ cid_tyfam_insts decl\n    , pure $ concatMap (locOnly . getLoc) $ cid_datafam_insts decl\n    , toHie $ cid_datafam_insts decl\n    , toHie $ cid_overlap_mode decl\n    ]\n\ninstance ToHie (LDataFamInstDecl GhcRn) where\n  toHie (L sp (DataFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d\n\ninstance ToHie (LTyFamInstDecl GhcRn) where\n  toHie (L sp (TyFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d\n\ninstance ToHie (Context a)\n         => ToHie (PatSynFieldContext (RecordPatSynField a)) where\n  toHie (PSC sp (RecordPatSynField a b)) = concatM $\n    [ toHie $ C (RecField RecFieldDecl sp) a\n    , toHie $ C Use b\n    ]\n\ninstance ToHie (LDerivDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      DerivDecl _ typ strat overlap ->\n        [ toHie $ TS (ResolvedScopes []) typ\n        , toHie strat\n        , toHie overlap\n        ]\n      XDerivDecl _ -> []\n\ninstance ToHie (LFixitySig GhcRn) where\n  toHie (L span sig) = concatM $ makeNode sig span : case sig of\n      FixitySig _ vars _ ->\n        [ toHie $ map (C Use) vars\n        ]\n      XFixitySig _ -> []\n\ninstance ToHie (LDefaultDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      DefaultDecl _ typs ->\n        [ toHie typs\n        ]\n      XDefaultDecl _ -> []\n\ninstance ToHie (LForeignDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      ForeignImport {fd_name = name, fd_sig_ty = sig, fd_fi = fi} ->\n        [ toHie $ C (ValBind RegularBind ModuleScope $ getRealSpan span) name\n        , toHie $ TS (ResolvedScopes []) sig\n        , toHie fi\n        ]\n      ForeignExport {fd_name = name, fd_sig_ty = sig, fd_fe = fe} ->\n        [ toHie $ C Use name\n        , toHie $ TS (ResolvedScopes []) sig\n        , toHie fe\n        ]\n      XForeignDecl _ -> []\n\ninstance ToHie ForeignImport where\n  toHie (CImport (L a _) (L b _) _ _ (L c _)) = pure $ concat $\n    [ locOnly a\n    , locOnly b\n    , locOnly c\n    ]\n\ninstance ToHie ForeignExport where\n  toHie (CExport (L a _) (L b _)) = pure $ concat $\n    [ locOnly a\n    , locOnly b\n    ]\n\ninstance ToHie (LWarnDecls GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      Warnings _ _ warnings ->\n        [ toHie warnings\n        ]\n      XWarnDecls _ -> []\n\ninstance ToHie (LWarnDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      Warning _ vars _ ->\n        [ toHie $ map (C Use) vars\n        ]\n      XWarnDecl _ -> []\n\ninstance ToHie (LAnnDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      HsAnnotation _ _ prov expr ->\n        [ toHie prov\n        , toHie expr\n        ]\n      XAnnDecl _ -> []\n\ninstance ToHie (Context (Located a)) => ToHie (AnnProvenance a) where\n  toHie (ValueAnnProvenance a) = toHie $ C Use a\n  toHie (TypeAnnProvenance a) = toHie $ C Use a\n  toHie ModuleAnnProvenance = pure []\n\ninstance ToHie (LRuleDecls GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      HsRules _ _ rules ->\n        [ toHie rules\n        ]\n      XRuleDecls _ -> []\n\ninstance ToHie (LRuleDecl GhcRn) where\n  toHie (L _ (XRuleDecl _)) = pure []\n  toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM\n        [ makeNode r span\n        , pure $ locOnly $ getLoc rname\n        , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs\n        , toHie $ map (RS $ mkScope span) bndrs\n        , toHie exprA\n        , toHie exprB\n        ]\n    where scope = bndrs_sc `combineScopes` exprA_sc `combineScopes` exprB_sc\n          bndrs_sc = maybe NoScope mkLScope (listToMaybe bndrs)\n          exprA_sc = mkLScope exprA\n          exprB_sc = mkLScope exprB\n\ninstance ToHie (RScoped (LRuleBndr GhcRn)) where\n  toHie (RS sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of\n      RuleBndr _ var ->\n        [ toHie $ C (ValBind RegularBind sc Nothing) var\n        ]\n      RuleBndrSig _ var typ ->\n        [ toHie $ C (ValBind RegularBind sc Nothing) var\n        , toHie $ TS (ResolvedScopes [sc]) typ\n        ]\n      XRuleBndr _ -> []\n\ninstance ToHie (LImportDecl GhcRn) where\n  toHie (L span decl) = concatM $ makeNode decl span : case decl of\n      ImportDecl { ideclName = name, ideclAs = as, ideclHiding = hidden } ->\n        [ toHie $ IEC Import name\n        , toHie $ fmap (IEC ImportAs) as\n        , maybe (pure []) goIE hidden\n        ]\n      XImportDecl _ -> []\n    where\n      goIE (hiding, (L sp liens)) = concatM $\n        [ pure $ locOnly sp\n        , toHie $ map (IEC c) liens\n        ]\n        where\n         c = if hiding then ImportHiding else Import\n\ninstance ToHie (IEContext (LIE GhcRn)) where\n  toHie (IEC c (L span ie)) = concatM $ makeNode ie span : case ie of\n      IEVar _ n ->\n        [ toHie $ IEC c n\n        ]\n      IEThingAbs _ n ->\n        [ toHie $ IEC c n\n        ]\n      IEThingAll _ n ->\n        [ toHie $ IEC c n\n        ]\n      IEThingWith _ n _ ns flds ->\n        [ toHie $ IEC c n\n        , toHie $ map (IEC c) ns\n        , toHie $ map (IEC c) flds\n        ]\n      IEModuleContents _ n ->\n        [ toHie $ IEC c n\n        ]\n      IEGroup _ _ _ -> []\n      IEDoc _ _ -> []\n      IEDocNamed _ _ -> []\n      XIE _ -> []\n\ninstance ToHie (IEContext (LIEWrappedName Name)) where\n  toHie (IEC c (L span iewn)) = concatM $ makeNode iewn span : case iewn of\n      IEName n ->\n        [ toHie $ C (IEThing c) n\n        ]\n      IEPattern p ->\n        [ toHie $ C (IEThing c) p\n        ]\n      IEType n ->\n        [ toHie $ C (IEThing c) n\n        ]\n\ninstance ToHie (IEContext (Located (FieldLbl Name))) where\n  toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of\n      FieldLabel _ _ n ->\n        [ toHie $ C (IEThing c) $ L span n\n        ]\n", "num_lines": 1782}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule HieBin ( readHieFile, writeHieFile, HieName(..), toHieName ) where\n\nimport GhcPrelude\n\nimport Binary\nimport BinIface                   ( getDictFastString )\nimport FastMutInt\nimport FastString                 ( FastString )\nimport Module                     ( Module )\nimport Name\nimport NameCache\nimport Outputable\nimport PrelInfo\nimport SrcLoc\nimport UniqSupply                 ( takeUniqFromSupply )\nimport Unique\nimport UniqFM\n\nimport qualified Data.Array as A\nimport Data.IORef\nimport Data.List                  ( mapAccumR )\nimport Data.Word                  ( Word32 )\nimport Control.Monad              ( replicateM )\nimport System.Directory           ( createDirectoryIfMissing )\nimport System.FilePath            ( takeDirectory )\n\n-- | `Name`'s get converted into `HieName`'s before being written into @.hie@\n-- files. See 'toHieName' and 'fromHieName' for logic on how to convert between\n-- these two types.\ndata HieName\n  = ExternalName !Module !OccName !SrcSpan\n  | LocalName !OccName !SrcSpan\n  | KnownKeyName !Unique\n  deriving (Eq)\n\ninstance Ord HieName where\n  compare (ExternalName a b c) (ExternalName d e f) = compare (a,b,c) (d,e,f)\n  compare (LocalName a b) (LocalName c d) = compare (a,b) (c,d)\n  compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b\n    -- Not actually non determinstic as it is a KnownKey\n  compare ExternalName{} _ = LT\n  compare LocalName{} ExternalName{} = GT\n  compare LocalName{} _ = LT\n  compare KnownKeyName{} _ = GT\n\ninstance Outputable HieName where\n  ppr (ExternalName m n sp) = text \"ExternalName\" <+> ppr m <+> ppr n <+> ppr sp\n  ppr (LocalName n sp) = text \"LocalName\" <+> ppr n <+> ppr sp\n  ppr (KnownKeyName u) = text \"KnownKeyName\" <+> ppr u\n\n\ndata HieSymbolTable = HieSymbolTable\n  { hie_symtab_next :: !FastMutInt\n  , hie_symtab_map  :: !(IORef (UniqFM (Int, HieName)))\n  }\n\ndata HieDictionary = HieDictionary\n  { hie_dict_next :: !FastMutInt -- The next index to use\n  , hie_dict_map  :: !(IORef (UniqFM (Int,FastString))) -- indexed by FastString\n  }\n\ninitBinMemSize :: Int\ninitBinMemSize = 1024*1024\n\nwriteHieFile :: Binary a => FilePath -> a -> IO ()\nwriteHieFile hie_file_path hiefile = do\n  bh0 <- openBinMem initBinMemSize\n\n  -- remember where the dictionary pointer will go\n  dict_p_p <- tellBin bh0\n  put_ bh0 dict_p_p\n\n  -- remember where the symbol table pointer will go\n  symtab_p_p <- tellBin bh0\n  put_ bh0 symtab_p_p\n\n  -- Make some intial state\n  symtab_next <- newFastMutInt\n  writeFastMutInt symtab_next 0\n  symtab_map <- newIORef emptyUFM\n  let hie_symtab = HieSymbolTable {\n                      hie_symtab_next = symtab_next,\n                      hie_symtab_map  = symtab_map }\n  dict_next_ref <- newFastMutInt\n  writeFastMutInt dict_next_ref 0\n  dict_map_ref <- newIORef emptyUFM\n  let hie_dict = HieDictionary {\n                      hie_dict_next = dict_next_ref,\n                      hie_dict_map  = dict_map_ref }\n\n  -- put the main thing\n  let bh = setUserData bh0 $ newWriteState (putName hie_symtab)\n                                           (putName hie_symtab)\n                                           (putFastString hie_dict)\n  put_ bh hiefile\n\n  -- write the symtab pointer at the front of the file\n  symtab_p <- tellBin bh\n  putAt bh symtab_p_p symtab_p\n  seekBin bh symtab_p\n\n  -- write the symbol table itself\n  symtab_next' <- readFastMutInt symtab_next\n  symtab_map'  <- readIORef symtab_map\n  putSymbolTable bh symtab_next' symtab_map'\n\n  -- write the dictionary pointer at the fornt of the file\n  dict_p <- tellBin bh\n  putAt bh dict_p_p dict_p\n  seekBin bh dict_p\n\n  -- write the dictionary itself\n  dict_next <- readFastMutInt dict_next_ref\n  dict_map  <- readIORef dict_map_ref\n  putDictionary bh dict_next dict_map\n\n  -- and send the result to the file\n  createDirectoryIfMissing True (takeDirectory hie_file_path)\n  writeBinMem bh hie_file_path\n  return ()\n\nreadHieFile :: Binary a => NameCache -> FilePath -> IO (a, NameCache)\nreadHieFile nc file = do\n  bh0 <- readBinMem file\n\n  dict  <- get_dictionary bh0\n\n  -- read the symbol table so we are capable of reading the actual data\n  (bh1, nc') <- do\n      let bh1 = setUserData bh0 $ newReadState (error \"getSymtabName\")\n                                               (getDictFastString dict)\n      (nc', symtab) <- get_symbol_table bh1\n      let bh1' = setUserData bh1\n               $ newReadState (getSymTabName symtab)\n                              (getDictFastString dict)\n      return (bh1', nc')\n\n  -- load the actual data\n  hiefile <- get bh1\n  return (hiefile, nc')\n  where\n    get_dictionary bin_handle = do\n      dict_p <- get bin_handle\n      data_p <- tellBin bin_handle\n      seekBin bin_handle dict_p\n      dict <- getDictionary bin_handle\n      seekBin bin_handle data_p\n      return dict\n\n    get_symbol_table bh1 = do\n      symtab_p <- get bh1\n      data_p'  <- tellBin bh1\n      seekBin bh1 symtab_p\n      (nc', symtab) <- getSymbolTable bh1 nc\n      seekBin bh1 data_p'\n      return (nc', symtab)\n\nputFastString :: HieDictionary -> BinHandle -> FastString -> IO ()\nputFastString HieDictionary { hie_dict_next = j_r,\n                              hie_dict_map  = out_r}  bh f\n  = do\n    out <- readIORef out_r\n    let unique = getUnique f\n    case lookupUFM out unique of\n        Just (j, _)  -> put_ bh (fromIntegral j :: Word32)\n        Nothing -> do\n           j <- readFastMutInt j_r\n           put_ bh (fromIntegral j :: Word32)\n           writeFastMutInt j_r (j + 1)\n           writeIORef out_r $! addToUFM out unique (j, f)\n\nputSymbolTable :: BinHandle -> Int -> UniqFM (Int,HieName) -> IO ()\nputSymbolTable bh next_off symtab = do\n  put_ bh next_off\n  let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab))\n  mapM_ (putHieName bh) names\n\ngetSymbolTable :: BinHandle -> NameCache -> IO (NameCache, SymbolTable)\ngetSymbolTable bh namecache = do\n  sz <- get bh\n  od_names <- replicateM sz (getHieName bh)\n  let arr = A.listArray (0,sz-1) names\n      (namecache', names) = mapAccumR fromHieName namecache od_names\n  return (namecache', arr)\n\ngetSymTabName :: SymbolTable -> BinHandle -> IO Name\ngetSymTabName st bh = do\n  i :: Word32 <- get bh\n  return $ st A.! (fromIntegral i)\n\nputName :: HieSymbolTable -> BinHandle -> Name -> IO ()\nputName (HieSymbolTable next ref) bh name = do\n  symmap <- readIORef ref\n  case lookupUFM symmap name of\n    Just (off, ExternalName mod occ (UnhelpfulSpan _))\n      | isGoodSrcSpan (nameSrcSpan name) -> do\n      let hieName = ExternalName mod occ (nameSrcSpan name)\n      writeIORef ref $! addToUFM symmap name (off, hieName)\n      put_ bh (fromIntegral off :: Word32)\n    Just (off, LocalName _occ span)\n      | notLocal (toHieName name) || nameSrcSpan name /= span -> do\n      writeIORef ref $! addToUFM symmap name (off, toHieName name)\n      put_ bh (fromIntegral off :: Word32)\n    Just (off, _) -> put_ bh (fromIntegral off :: Word32)\n    Nothing -> do\n        off <- readFastMutInt next\n        writeFastMutInt next (off+1)\n        writeIORef ref $! addToUFM symmap name (off, toHieName name)\n        put_ bh (fromIntegral off :: Word32)\n\n  where\n    notLocal :: HieName -> Bool\n    notLocal LocalName{} = False\n    notLocal _ = True\n\n\n-- ** Converting to and from `HieName`'s\n\ntoHieName :: Name -> HieName\ntoHieName name\n  | isKnownKeyName name = KnownKeyName (nameUnique name)\n  | isExternalName name = ExternalName (nameModule name)\n                                       (nameOccName name)\n                                       (nameSrcSpan name)\n  | otherwise = LocalName (nameOccName name) (nameSrcSpan name)\n\nfromHieName :: NameCache -> HieName -> (NameCache, Name)\nfromHieName nc (ExternalName mod occ span) =\n    let cache = nsNames nc\n    in case lookupOrigNameCache cache mod occ of\n         Just name -> (nc, name)\n         Nothing ->\n           let (uniq, us) = takeUniqFromSupply (nsUniqs nc)\n               name       = mkExternalName uniq mod occ span\n               new_cache  = extendNameCache cache mod occ name\n           in ( nc{ nsUniqs = us, nsNames = new_cache }, name )\nfromHieName nc (LocalName occ span) =\n    let (uniq, us) = takeUniqFromSupply (nsUniqs nc)\n        name       = mkInternalName uniq occ span\n    in ( nc{ nsUniqs = us }, name )\nfromHieName nc (KnownKeyName u) = case lookupKnownKeyName u of\n    Nothing -> pprPanic \"fromHieName:unknown known-key unique\"\n                        (ppr (unpkUnique u))\n    Just n -> (nc, n)\n\n-- ** Reading and writing `HieName`'s\n\nputHieName :: BinHandle -> HieName -> IO ()\nputHieName bh (ExternalName mod occ span) = do\n  putByte bh 0\n  put_ bh (mod, occ, span)\nputHieName bh (LocalName occName span) = do\n  putByte bh 1\n  put_ bh (occName, span)\nputHieName bh (KnownKeyName uniq) = do\n  putByte bh 2\n  put_ bh $ unpkUnique uniq\n\ngetHieName :: BinHandle -> IO HieName\ngetHieName bh = do\n  t <- getByte bh\n  case t of\n    0 -> do\n      (modu, occ, span) <- get bh\n      return $ ExternalName modu occ span\n    1 -> do\n      (occ, span) <- get bh\n      return $ LocalName occ span\n    2 -> do\n      (c,i) <- get bh\n      return $ KnownKeyName $ mkUnique c i\n    _ -> panic \"HieBin.getHieName: invalid tag\"\n", "num_lines": 274}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE FlexibleContexts #-}\nmodule HieDebug where\n\nimport GhcPrelude\n\nimport SrcLoc\nimport Module\nimport FastString\nimport Outputable\n\nimport HieTypes\nimport HieBin\nimport HieUtils\n\nimport qualified Data.Map as M\nimport qualified Data.Set as S\nimport Data.Function    ( on )\nimport Data.List        ( sortOn )\nimport Data.Foldable    ( toList )\n\nppHies :: Outputable a => (HieASTs a) -> SDoc\nppHies (HieASTs asts) = M.foldrWithKey go \"\" asts\n  where\n    go k a rest = vcat $\n      [ \"File: \" <> ppr k\n      , ppHie a\n      , rest\n      ]\n\nppHie :: Outputable a => HieAST a -> SDoc\nppHie = go 0\n  where\n    go n (Node inf sp children) = hang header n rest\n      where\n        rest = vcat $ map (go (n+2)) children\n        header = hsep\n          [ \"Node\"\n          , ppr sp\n          , ppInfo inf\n          ]\n\nppInfo :: Outputable a => NodeInfo a -> SDoc\nppInfo ni = hsep\n  [ ppr $ toList $ nodeAnnotations ni\n  , ppr $ nodeType ni\n  , ppr $ M.toList $ nodeIdentifiers ni\n  ]\n\ntype Diff a = a -> a -> [SDoc]\n\ndiffFile :: Diff HieFile\ndiffFile = diffAsts eqDiff `on` (getAsts . hie_asts)\n\ndiffAsts :: (Outputable a, Eq a) => Diff a -> Diff (M.Map FastString (HieAST a))\ndiffAsts f = diffList (diffAst f) `on` M.elems\n\ndiffAst :: (Outputable a, Eq a) => Diff a -> Diff (HieAST a)\ndiffAst diffType (Node info1 span1 xs1) (Node info2 span2 xs2) =\n    infoDiff ++ spanDiff ++ diffList (diffAst diffType) xs1 xs2\n  where\n    spanDiff\n      | span1 /= span2 = [hsep [\"Spans\", ppr span1, \"and\", ppr span2, \"differ\"]]\n      | otherwise = []\n    infoDiff\n      = (diffList eqDiff `on` (S.toAscList . nodeAnnotations)) info1 info2\n     ++ (diffList diffType `on` nodeType) info1 info2\n     ++ (diffIdents `on` nodeIdentifiers) info1 info2\n    diffIdents a b = (diffList diffIdent `on` normalizeIdents) a b\n    diffIdent (a,b) (c,d) = diffName a c\n                         ++ eqDiff b d\n    diffName (Right a) (Right b) = case (a,b) of\n      (ExternalName m o _, ExternalName m' o' _) -> eqDiff (m,o) (m',o')\n      (LocalName o _, ExternalName _ o' _) -> eqDiff o o'\n      _ -> eqDiff a b\n    diffName a b = eqDiff a b\n\ntype DiffIdent = Either ModuleName HieName\n\nnormalizeIdents :: NodeIdentifiers a -> [(DiffIdent,IdentifierDetails a)]\nnormalizeIdents = sortOn fst . map (first toHieName) . M.toList\n  where\n    first f (a,b) = (fmap f a, b)\n\ndiffList :: Diff a -> Diff [a]\ndiffList f xs ys\n  | length xs == length ys = concat $ zipWith f xs ys\n  | otherwise = [\"length of lists doesn't match\"]\n\neqDiff :: (Outputable a, Eq a) => Diff a\neqDiff a b\n  | a == b = []\n  | otherwise = [hsep [ppr a, \"and\", ppr b, \"do not match\"]]\n\nvalidAst :: HieAST a -> Either SDoc ()\nvalidAst (Node _ span children) = do\n  checkContainment children\n  checkSorted children\n  mapM_ validAst children\n  where\n    checkSorted [] = return ()\n    checkSorted [_] = return ()\n    checkSorted (x:y:xs)\n      | nodeSpan x `leftOf` nodeSpan y = checkSorted (y:xs)\n      | otherwise = Left $ hsep\n          [ ppr $ nodeSpan x\n          , \"is not to the left of\"\n          , ppr $ nodeSpan y\n          ]\n    checkContainment [] = return ()\n    checkContainment (x:xs)\n      | span `containsSpan` (nodeSpan x) = checkContainment xs\n      | otherwise = Left $ hsep\n          [ ppr $ span\n          , \"does not contain\"\n          , ppr $ nodeSpan x\n          ]\n\n-- | Look for any identifiers which occur outside of their supposed scopes.\n-- Returns a list of error messages.\nvalidateScopes :: M.Map FastString (HieAST a) -> [SDoc]\nvalidateScopes asts = M.foldrWithKey (\\k a b -> valid k a ++ b) [] refMap\n  where\n    refMap = generateReferencesMap asts\n    valid (Left _) _ = []\n    valid (Right n) refs = concatMap inScope refs\n      where\n        mapRef = foldMap getScopeFromContext . identInfo . snd\n        scopes = case foldMap mapRef refs of\n          Just xs -> xs\n          Nothing -> []\n        inScope (sp, dets)\n          |  definedInAsts asts n\n          && any isOccurrence (identInfo dets)\n            = case scopes of\n              [] -> []\n              _ -> if any (`scopeContainsSpan` sp) scopes\n                   then []\n                   else return $ hsep $\n                     [ \"Name\", ppr n, \"at position\", ppr sp\n                     , \"doesn't occur in calculated scope\", ppr scopes]\n          | otherwise = []\n", "num_lines": 144}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule HieTypes where\n\nimport GhcPrelude\n\nimport Binary\nimport FastString                 ( FastString )\nimport IfaceType\nimport Module                     ( ModuleName, Module )\nimport Name                       ( Name )\nimport Outputable hiding ( (<>) )\nimport SrcLoc                     ( RealSrcSpan )\nimport Avail\n\nimport qualified Data.Array as A\nimport qualified Data.Map as M\nimport qualified Data.Set as S\nimport Data.ByteString            ( ByteString )\nimport Data.Data                  ( Typeable, Data )\nimport Data.Semigroup             ( Semigroup(..) )\nimport Data.Word                  ( Word8 )\nimport Control.Applicative        ( (<|>) )\n\ntype Span = RealSrcSpan\n\n-- | Current version of @.hie@ files\ncurHieVersion :: Word8\ncurHieVersion = 0\n\n{- |\nGHC builds up a wealth of information about Haskell source as it compiles it.\n@.hie@ files are a way of persisting some of this information to disk so that\nexternal tools that need to work with haskell source don't need to parse,\ntypecheck, and rename all over again. These files contain:\n\n  * a simplified AST\n\n       * nodes are annotated with source positions and types\n       * identifiers are annotated with scope information\n\n  * the raw bytes of the initial Haskell source\n\nBesides saving compilation cycles, @.hie@ files also offer a more stable\ninterface than the GHC API.\n-}\ndata HieFile = HieFile\n    { hie_version :: Word8\n    -- ^ version of the HIE format\n\n    , hie_ghc_version :: ByteString\n    -- ^ Version of GHC that produced this file\n\n    , hie_hs_file :: FilePath\n    -- ^ Initial Haskell source file path\n\n    , hie_module :: Module\n    -- ^ The module this HIE file is for\n\n    , hie_types :: A.Array TypeIndex HieTypeFlat\n    -- ^ Types referenced in the 'hie_asts'.\n    --\n    -- See Note [Efficient serialization of redundant type info]\n\n    , hie_asts :: HieASTs TypeIndex\n    -- ^ Type-annotated abstract syntax trees\n\n    , hie_exports :: [AvailInfo]\n    -- ^ The names that this module exports\n\n    , hie_hs_src :: ByteString\n    -- ^ Raw bytes of the initial Haskell source\n    }\n\ninstance Binary HieFile where\n  put_ bh hf = do\n    put_ bh $ hie_version hf\n    put_ bh $ hie_ghc_version hf\n    put_ bh $ hie_hs_file hf\n    put_ bh $ hie_module hf\n    put_ bh $ hie_types hf\n    put_ bh $ hie_asts hf\n    put_ bh $ hie_exports hf\n    put_ bh $ hie_hs_src hf\n\n  get bh = HieFile\n    <$> get bh\n    <*> get bh\n    <*> get bh\n    <*> get bh\n    <*> get bh\n    <*> get bh\n    <*> get bh\n    <*> get bh\n\n\n{-\nNote [Efficient serialization of redundant type info]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe type information in .hie files is highly repetitive and redundant. For\nexample, consider the expression\n\n    const True 'a'\n\nThere is a lot of shared structure between the types of subterms:\n\n  * const True 'a' ::                 Bool\n  * const True     ::         Char -> Bool\n  * const          :: Bool -> Char -> Bool\n\nSince all 3 of these types need to be stored in the .hie file, it is worth\nmaking an effort to deduplicate this shared structure. The trick is to define\na new data type that is a flattened version of 'Type':\n\n    data HieType a = HAppTy a a  -- data Type = AppTy Type Type\n                   | HFunTy a a  --           | FunTy Type Type\n                   | ...\n\n    type TypeIndex = Int\n\nTypes in the final AST are stored in an 'A.Array TypeIndex (HieType TypeIndex)',\nwhere the 'TypeIndex's in the 'HieType' are references to other elements of the\narray. Types recovered from GHC are deduplicated and stored in this compressed\nform with sharing of subtrees.\n-}\n\ntype TypeIndex = Int\n\n-- | A flattened version of 'Type'.\n--\n-- See Note [Efficient serialization of redundant type info]\ndata HieType a\n  = HTyVarTy Name\n  | HAppTy a (HieArgs a)\n  | HTyConApp IfaceTyCon (HieArgs a)\n  | HForAllTy ((Name, a),ArgFlag) a\n  | HFunTy  a a\n  | HQualTy a a           -- ^ type with constraint: @t1 => t2@ (see 'IfaceDFunTy')\n  | HLitTy IfaceTyLit\n  | HCastTy a\n  | HCoercionTy\n    deriving (Functor, Foldable, Traversable, Eq)\n\ntype HieTypeFlat = HieType TypeIndex\n\n-- | Roughly isomorphic to the original core 'Type'.\nnewtype HieTypeFix = Roll (HieType (HieTypeFix))\n\ninstance Binary (HieType TypeIndex) where\n  put_ bh (HTyVarTy n) = do\n    putByte bh 0\n    put_ bh n\n  put_ bh (HAppTy a b) = do\n    putByte bh 1\n    put_ bh a\n    put_ bh b\n  put_ bh (HTyConApp n xs) = do\n    putByte bh 2\n    put_ bh n\n    put_ bh xs\n  put_ bh (HForAllTy bndr a) = do\n    putByte bh 3\n    put_ bh bndr\n    put_ bh a\n  put_ bh (HFunTy a b) = do\n    putByte bh 4\n    put_ bh a\n    put_ bh b\n  put_ bh (HQualTy a b) = do\n    putByte bh 5\n    put_ bh a\n    put_ bh b\n  put_ bh (HLitTy l) = do\n    putByte bh 6\n    put_ bh l\n  put_ bh (HCastTy a) = do\n    putByte bh 7\n    put_ bh a\n  put_ bh (HCoercionTy) = putByte bh 8\n\n  get bh = do\n    (t :: Word8) <- get bh\n    case t of\n      0 -> HTyVarTy <$> get bh\n      1 -> HAppTy <$> get bh <*> get bh\n      2 -> HTyConApp <$> get bh <*> get bh\n      3 -> HForAllTy <$> get bh <*> get bh\n      4 -> HFunTy <$> get bh <*> get bh\n      5 -> HQualTy <$> get bh <*> get bh\n      6 -> HLitTy <$> get bh\n      7 -> HCastTy <$> get bh\n      8 -> return HCoercionTy\n      _ -> panic \"Binary (HieArgs Int): invalid tag\"\n\n\n-- | A list of type arguments along with their respective visibilities (ie. is\n-- this an argument that would return 'True' for 'isVisibleArgFlag'?).\nnewtype HieArgs a = HieArgs [(Bool,a)]\n  deriving (Functor, Foldable, Traversable, Eq)\n\ninstance Binary (HieArgs TypeIndex) where\n  put_ bh (HieArgs xs) = put_ bh xs\n  get bh = HieArgs <$> get bh\n\n-- | Mapping from filepaths (represented using 'FastString') to the\n-- corresponding AST\nnewtype HieASTs a = HieASTs { getAsts :: (M.Map FastString (HieAST a)) }\n  deriving (Functor, Foldable, Traversable)\n\ninstance Binary (HieASTs TypeIndex) where\n  put_ bh asts = put_ bh $ M.toAscList $ getAsts asts\n  get bh = HieASTs <$> fmap M.fromDistinctAscList (get bh)\n\n\ndata HieAST a =\n  Node\n    { nodeInfo :: NodeInfo a\n    , nodeSpan :: Span\n    , nodeChildren :: [HieAST a]\n    } deriving (Functor, Foldable, Traversable)\n\ninstance Binary (HieAST TypeIndex) where\n  put_ bh ast = do\n    put_ bh $ nodeInfo ast\n    put_ bh $ nodeSpan ast\n    put_ bh $ nodeChildren ast\n\n  get bh = Node\n    <$> get bh\n    <*> get bh\n    <*> get bh\n\n\n-- | The information stored in one AST node.\n--\n-- The type parameter exists to provide flexibility in representation of types\n-- (see Note [Efficient serialization of redundant type info]).\ndata NodeInfo a = NodeInfo\n    { nodeAnnotations :: S.Set (FastString,FastString)\n    -- ^ (name of the AST node constructor, name of the AST node Type)\n\n    , nodeType :: [a]\n    -- ^ The Haskell types of this node, if any.\n\n    , nodeIdentifiers :: NodeIdentifiers a\n    -- ^ All the identifiers and their details\n    } deriving (Functor, Foldable, Traversable)\n\ninstance Binary (NodeInfo TypeIndex) where\n  put_ bh ni = do\n    put_ bh $ S.toAscList $ nodeAnnotations ni\n    put_ bh $ nodeType ni\n    put_ bh $ M.toList $ nodeIdentifiers ni\n  get bh = NodeInfo\n    <$> fmap (S.fromDistinctAscList) (get bh)\n    <*> get bh\n    <*> fmap (M.fromList) (get bh)\n\ntype Identifier = Either ModuleName Name\n\ntype NodeIdentifiers a = M.Map Identifier (IdentifierDetails a)\n\n-- | Information associated with every identifier\n--\n-- We need to include types with identifiers because sometimes multiple\n-- identifiers occur in the same span(Overloaded Record Fields and so on)\ndata IdentifierDetails a = IdentifierDetails\n  { identType :: Maybe a\n  , identInfo :: S.Set ContextInfo\n  } deriving (Eq, Functor, Foldable, Traversable)\n\ninstance Outputable a => Outputable (IdentifierDetails a) where\n  ppr x = text \"IdentifierDetails\" <+> ppr (identType x) <+> ppr (identInfo x)\n\ninstance Semigroup (IdentifierDetails a) where\n  d1 <> d2 = IdentifierDetails (identType d1 <|> identType d2)\n                               (S.union (identInfo d1) (identInfo d2))\n\ninstance Monoid (IdentifierDetails a) where\n  mempty = IdentifierDetails Nothing S.empty\n\ninstance Binary (IdentifierDetails TypeIndex) where\n  put_ bh dets = do\n    put_ bh $ identType dets\n    put_ bh $ S.toAscList $ identInfo dets\n  get bh =  IdentifierDetails\n    <$> get bh\n    <*> fmap (S.fromDistinctAscList) (get bh)\n\n\n-- | Different contexts under which identifiers exist\ndata ContextInfo\n  = Use                -- ^ regular variable\n  | MatchBind\n  | IEThing IEType     -- ^ import/export\n  | TyDecl\n\n  -- | Value binding\n  | ValBind\n      BindType     -- ^ whether or not the binding is in an instance\n      Scope        -- ^ scope over which the value is bound\n      (Maybe Span) -- ^ span of entire binding\n\n  -- | Pattern binding\n  --\n  -- This case is tricky because the bound identifier can be used in two\n  -- distinct scopes. Consider the following example (with @-XViewPatterns@)\n  --\n  -- @\n  -- do (b, a, (a -> True)) <- bar\n  --    foo a\n  -- @\n  --\n  -- The identifier @a@ has two scopes: in the view pattern @(a -> True)@ and\n  -- in the rest of the @do@-block in @foo a@.\n  | PatternBind\n      Scope        -- ^ scope /in the pattern/ (the variable bound can be used\n                   -- further in the pattern)\n      Scope        -- ^ rest of the scope outside the pattern\n      (Maybe Span) -- ^ span of entire binding\n\n  | ClassTyDecl (Maybe Span)\n\n  -- | Declaration\n  | Decl\n      DeclType     -- ^ type of declaration\n      (Maybe Span) -- ^ span of entire binding\n\n  -- | Type variable\n  | TyVarBind Scope TyVarScope\n\n  -- | Record field\n  | RecField RecFieldContext (Maybe Span)\n    deriving (Eq, Ord, Show)\n\ninstance Outputable ContextInfo where\n  ppr = text . show\n\ninstance Binary ContextInfo where\n  put_ bh Use = putByte bh 0\n  put_ bh (IEThing t) = do\n    putByte bh 1\n    put_ bh t\n  put_ bh TyDecl = putByte bh 2\n  put_ bh (ValBind bt sc msp) = do\n    putByte bh 3\n    put_ bh bt\n    put_ bh sc\n    put_ bh msp\n  put_ bh (PatternBind a b c) = do\n    putByte bh 4\n    put_ bh a\n    put_ bh b\n    put_ bh c\n  put_ bh (ClassTyDecl sp) = do\n    putByte bh 5\n    put_ bh sp\n  put_ bh (Decl a b) = do\n    putByte bh 6\n    put_ bh a\n    put_ bh b\n  put_ bh (TyVarBind a b) = do\n    putByte bh 7\n    put_ bh a\n    put_ bh b\n  put_ bh (RecField a b) = do\n    putByte bh 8\n    put_ bh a\n    put_ bh b\n  put_ bh MatchBind = putByte bh 9\n\n  get bh = do\n    (t :: Word8) <- get bh\n    case t of\n      0 -> return Use\n      1 -> IEThing <$> get bh\n      2 -> return TyDecl\n      3 -> ValBind <$> get bh <*> get bh <*> get bh\n      4 -> PatternBind <$> get bh <*> get bh <*> get bh\n      5 -> ClassTyDecl <$> get bh\n      6 -> Decl <$> get bh <*> get bh\n      7 -> TyVarBind <$> get bh <*> get bh\n      8 -> RecField <$> get bh <*> get bh\n      9 -> return MatchBind\n      _ -> panic \"Binary ContextInfo: invalid tag\"\n\n\n-- | Types of imports and exports\ndata IEType\n  = Import\n  | ImportAs\n  | ImportHiding\n  | Export\n    deriving (Eq, Enum, Ord, Show)\n\ninstance Binary IEType where\n  put_ bh b = putByte bh (fromIntegral (fromEnum b))\n  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))\n\n\ndata RecFieldContext\n  = RecFieldDecl\n  | RecFieldAssign\n  | RecFieldMatch\n  | RecFieldOcc\n    deriving (Eq, Enum, Ord, Show)\n\ninstance Binary RecFieldContext where\n  put_ bh b = putByte bh (fromIntegral (fromEnum b))\n  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))\n\n\ndata BindType\n  = RegularBind\n  | InstanceBind\n    deriving (Eq, Ord, Show, Enum)\n\ninstance Binary BindType where\n  put_ bh b = putByte bh (fromIntegral (fromEnum b))\n  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))\n\n\ndata DeclType\n  = FamDec     -- ^ type or data family\n  | SynDec     -- ^ type synonym\n  | DataDec    -- ^ data declaration\n  | ConDec     -- ^ constructor declaration\n  | PatSynDec  -- ^ pattern synonym\n  | ClassDec   -- ^ class declaration\n  | InstDec    -- ^ instance declaration\n    deriving (Eq, Ord, Show, Enum)\n\ninstance Binary DeclType where\n  put_ bh b = putByte bh (fromIntegral (fromEnum b))\n  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))\n\n\ndata Scope\n  = NoScope\n  | LocalScope Span\n  | ModuleScope\n    deriving (Eq, Ord, Show, Typeable, Data)\n\ninstance Outputable Scope where\n  ppr NoScope = text \"NoScope\"\n  ppr (LocalScope sp) = text \"LocalScope\" <+> ppr sp\n  ppr ModuleScope = text \"ModuleScope\"\n\ninstance Binary Scope where\n  put_ bh NoScope = putByte bh 0\n  put_ bh (LocalScope span) = do\n    putByte bh 1\n    put_ bh span\n  put_ bh ModuleScope = putByte bh 2\n\n  get bh = do\n    (t :: Word8) <- get bh\n    case t of\n      0 -> return NoScope\n      1 -> LocalScope <$> get bh\n      2 -> return ModuleScope\n      _ -> panic \"Binary Scope: invalid tag\"\n\n\n-- | Scope of a type variable.\n--\n-- This warrants a data type apart from 'Scope' because of complexities\n-- introduced by features like @-XScopedTypeVariables@ and @-XInstanceSigs@. For\n-- example, consider:\n--\n-- @\n-- foo, bar, baz :: forall a. a -> a\n-- @\n--\n-- Here @a@ is in scope in all the definitions of @foo@, @bar@, and @baz@, so we\n-- need a list of scopes to keep track of this. Furthermore, this list cannot be\n-- computed until we resolve the binding sites of @foo@, @bar@, and @baz@.\n--\n-- Consequently, @a@ starts with an @'UnresolvedScope' [foo, bar, baz] Nothing@\n-- which later gets resolved into a 'ResolvedScopes'.\ndata TyVarScope\n  = ResolvedScopes [Scope]\n\n  -- | Unresolved scopes should never show up in the final @.hie@ file\n  | UnresolvedScope\n        [Name]        -- ^ names of the definitions over which the scope spans\n        (Maybe Span)  -- ^ the location of the instance/class declaration for\n                      -- the case where the type variable is declared in a\n                      -- method type signature\n    deriving (Eq, Ord)\n\ninstance Show TyVarScope where\n  show (ResolvedScopes sc) = show sc\n  show _ = error \"UnresolvedScope\"\n\ninstance Binary TyVarScope where\n  put_ bh (ResolvedScopes xs) = do\n    putByte bh 0\n    put_ bh xs\n  put_ bh (UnresolvedScope ns span) = do\n    putByte bh 1\n    put_ bh ns\n    put_ bh span\n\n  get bh = do\n    (t :: Word8) <- get bh\n    case t of\n      0 -> ResolvedScopes <$> get bh\n      1 -> UnresolvedScope <$> get bh <*> get bh\n      _ -> panic \"Binary TyVarScope: invalid tag\"\n", "num_lines": 515}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule HieUtils where\n\nimport GhcPrelude\n\nimport CoreMap\nimport DynFlags                   ( DynFlags )\nimport FastString                 ( FastString, mkFastString )\nimport IfaceType\nimport Name hiding (varName)\nimport Outputable                 ( renderWithStyle, ppr, defaultUserStyle )\nimport SrcLoc\nimport ToIface\nimport TyCon\nimport TyCoRep\nimport Type\nimport Var\nimport VarEnv\n\nimport HieTypes\n\nimport qualified Data.Map as M\nimport qualified Data.Set as S\nimport qualified Data.IntMap.Strict as IM\nimport qualified Data.Array as A\nimport Data.Data                  ( typeOf, typeRepTyCon, Data(toConstr) )\nimport Data.Maybe                 ( maybeToList )\nimport Data.Monoid\nimport Data.Traversable           ( for )\nimport Control.Monad.Trans.State.Strict hiding (get)\n\n\ngenerateReferencesMap\n  :: Foldable f\n  => f (HieAST a)\n  -> M.Map Identifier [(Span, IdentifierDetails a)]\ngenerateReferencesMap = foldr (\\ast m -> M.unionWith (++) (go ast) m) M.empty\n  where\n    go ast = M.unionsWith (++) (this : map go (nodeChildren ast))\n      where\n        this = fmap (pure . (nodeSpan ast,)) $ nodeIdentifiers $ nodeInfo ast\n\nrenderHieType :: DynFlags -> HieTypeFix -> String\nrenderHieType df ht = renderWithStyle df (ppr $ hieTypeToIface ht) sty\n  where sty = defaultUserStyle df\n\nresolveVisibility :: Type -> [Type] -> [(Bool,Type)]\nresolveVisibility kind ty_args\n  = go (mkEmptyTCvSubst in_scope) kind ty_args\n  where\n    in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)\n\n    go _   _                   []     = []\n    go env ty                  ts\n      | Just ty' <- coreView ty\n      = go env ty' ts\n    go env (ForAllTy (Bndr tv vis) res) (t:ts)\n      | isVisibleArgFlag vis = (True , t) : ts'\n      | otherwise            = (False, t) : ts'\n      where\n        ts' = go (extendTvSubst env tv t) res ts\n\n    go env (FunTy { ft_res = res }) (t:ts) -- No type-class args in tycon apps\n      = (True,t) : (go env res ts)\n\n    go env (TyVarTy tv) ts\n      | Just ki <- lookupTyVar env tv = go env ki ts\n    go env kind (t:ts) = (True, t) : (go env kind ts) -- Ill-kinded\n\nfoldType :: (HieType a -> a) -> HieTypeFix -> a\nfoldType f (Roll t) = f $ fmap (foldType f) t\n\nhieTypeToIface :: HieTypeFix -> IfaceType\nhieTypeToIface = foldType go\n  where\n    go (HTyVarTy n) = IfaceTyVar $ occNameFS $ getOccName n\n    go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b)\n    go (HLitTy l) = IfaceLitTy l\n    go (HForAllTy ((n,k),af) t) = let b = (occNameFS $ getOccName n, k)\n                                  in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t\n    go (HFunTy a b)     = IfaceFunTy VisArg   a    b\n    go (HQualTy pred b) = IfaceFunTy InvisArg pred b\n    go (HCastTy a) = a\n    go HCoercionTy = IfaceTyVar \"<coercion type>\"\n    go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs)\n\n    -- This isn't fully faithful - we can't produce the 'Inferred' case\n    hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs\n    hieToIfaceArgs (HieArgs xs) = go' xs\n      where\n        go' [] = IA_Nil\n        go' ((True ,x):xs) = IA_Arg x Required $ go' xs\n        go' ((False,x):xs) = IA_Arg x Specified $ go' xs\n\ndata HieTypeState\n  = HTS\n    { tyMap      :: !(TypeMap TypeIndex)\n    , htyTable   :: !(IM.IntMap HieTypeFlat)\n    , freshIndex :: !TypeIndex\n    }\n\ninitialHTS :: HieTypeState\ninitialHTS = HTS emptyTypeMap IM.empty 0\n\nfreshTypeIndex :: State HieTypeState TypeIndex\nfreshTypeIndex = do\n  index <- gets freshIndex\n  modify' $ \\hts -> hts { freshIndex = index+1 }\n  return index\n\ncompressTypes\n  :: HieASTs Type\n  -> (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)\ncompressTypes asts = (a, arr)\n  where\n    (a, (HTS _ m i)) = flip runState initialHTS $\n      for asts $ \\typ -> do\n        i <- getTypeIndex typ\n        return i\n    arr = A.array (0,i-1) (IM.toList m)\n\nrecoverFullType :: TypeIndex -> A.Array TypeIndex HieTypeFlat -> HieTypeFix\nrecoverFullType i m = go i\n  where\n    go i = Roll $ fmap go (m A.! i)\n\ngetTypeIndex :: Type -> State HieTypeState TypeIndex\ngetTypeIndex t\n  | otherwise = do\n      tm <- gets tyMap\n      case lookupTypeMap tm t of\n        Just i -> return i\n        Nothing -> do\n          ht <- go t\n          extendHTS t ht\n  where\n    extendHTS t ht = do\n      i <- freshTypeIndex\n      modify' $ \\(HTS tm tt fi) ->\n        HTS (extendTypeMap tm t i) (IM.insert i ht tt) fi\n      return i\n\n    go (TyVarTy v) = return $ HTyVarTy $ varName v\n    go ty@(AppTy _ _) = do\n      let (head,args) = splitAppTys ty\n          visArgs = HieArgs $ resolveVisibility (typeKind head) args\n      ai <- getTypeIndex head\n      argsi <- mapM getTypeIndex visArgs\n      return $ HAppTy ai argsi\n    go (TyConApp f xs) = do\n      let visArgs = HieArgs $ resolveVisibility (tyConKind f) xs\n      is <- mapM getTypeIndex visArgs\n      return $ HTyConApp (toIfaceTyCon f) is\n    go (ForAllTy (Bndr v a) t) = do\n      k <- getTypeIndex (varType v)\n      i <- getTypeIndex t\n      return $ HForAllTy ((varName v,k),a) i\n    go (FunTy { ft_af = af, ft_arg = a, ft_res = b }) = do\n      ai <- getTypeIndex a\n      bi <- getTypeIndex b\n      return $ case af of\n                 InvisArg -> HQualTy ai bi\n                 VisArg   -> HFunTy ai bi\n    go (LitTy a) = return $ HLitTy $ toIfaceTyLit a\n    go (CastTy t _) = do\n      i <- getTypeIndex t\n      return $ HCastTy i\n    go (CoercionTy _) = return HCoercionTy\n\nresolveTyVarScopes :: M.Map FastString (HieAST a) -> M.Map FastString (HieAST a)\nresolveTyVarScopes asts = M.map go asts\n  where\n    go ast = resolveTyVarScopeLocal ast asts\n\nresolveTyVarScopeLocal :: HieAST a -> M.Map FastString (HieAST a) -> HieAST a\nresolveTyVarScopeLocal ast asts = go ast\n  where\n    resolveNameScope dets = dets{identInfo =\n      S.map resolveScope (identInfo dets)}\n    resolveScope (TyVarBind sc (UnresolvedScope names Nothing)) =\n      TyVarBind sc $ ResolvedScopes\n        [ LocalScope binding\n        | name <- names\n        , Just binding <- [getNameBinding name asts]\n        ]\n    resolveScope (TyVarBind sc (UnresolvedScope names (Just sp))) =\n      TyVarBind sc $ ResolvedScopes\n        [ LocalScope binding\n        | name <- names\n        , Just binding <- [getNameBindingInClass name sp asts]\n        ]\n    resolveScope scope = scope\n    go (Node info span children) = Node info' span $ map go children\n      where\n        info' = info { nodeIdentifiers = idents }\n        idents = M.map resolveNameScope $ nodeIdentifiers info\n\ngetNameBinding :: Name -> M.Map FastString (HieAST a) -> Maybe Span\ngetNameBinding n asts = do\n  (_,msp) <- getNameScopeAndBinding n asts\n  msp\n\ngetNameScope :: Name -> M.Map FastString (HieAST a) -> Maybe [Scope]\ngetNameScope n asts = do\n  (scopes,_) <- getNameScopeAndBinding n asts\n  return scopes\n\ngetNameBindingInClass\n  :: Name\n  -> Span\n  -> M.Map FastString (HieAST a)\n  -> Maybe Span\ngetNameBindingInClass n sp asts = do\n  ast <- M.lookup (srcSpanFile sp) asts\n  getFirst $ foldMap First $ do\n    child <- flattenAst ast\n    dets <- maybeToList\n      $ M.lookup (Right n) $ nodeIdentifiers $ nodeInfo child\n    let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)\n    return (getFirst binding)\n\ngetNameScopeAndBinding\n  :: Name\n  -> M.Map FastString (HieAST a)\n  -> Maybe ([Scope], Maybe Span)\ngetNameScopeAndBinding n asts = case nameSrcSpan n of\n  RealSrcSpan sp -> do -- @Maybe\n    ast <- M.lookup (srcSpanFile sp) asts\n    defNode <- selectLargestContainedBy sp ast\n    getFirst $ foldMap First $ do -- @[]\n      node <- flattenAst defNode\n      dets <- maybeToList\n        $ M.lookup (Right n) $ nodeIdentifiers $ nodeInfo node\n      scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets)\n      let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)\n      return $ Just (scopes, getFirst binding)\n  _ -> Nothing\n\ngetScopeFromContext :: ContextInfo -> Maybe [Scope]\ngetScopeFromContext (ValBind _ sc _) = Just [sc]\ngetScopeFromContext (PatternBind a b _) = Just [a, b]\ngetScopeFromContext (ClassTyDecl _) = Just [ModuleScope]\ngetScopeFromContext (Decl _ _) = Just [ModuleScope]\ngetScopeFromContext (TyVarBind a (ResolvedScopes xs)) = Just $ a:xs\ngetScopeFromContext (TyVarBind a _) = Just [a]\ngetScopeFromContext _ = Nothing\n\ngetBindSiteFromContext :: ContextInfo -> Maybe Span\ngetBindSiteFromContext (ValBind _ _ sp) = sp\ngetBindSiteFromContext (PatternBind _ _ sp) = sp\ngetBindSiteFromContext _ = Nothing\n\nflattenAst :: HieAST a -> [HieAST a]\nflattenAst n =\n  n : concatMap flattenAst (nodeChildren n)\n\nsmallestContainingSatisfying\n  :: Span\n  -> (HieAST a -> Bool)\n  -> HieAST a\n  -> Maybe (HieAST a)\nsmallestContainingSatisfying sp cond node\n  | nodeSpan node `containsSpan` sp = getFirst $ mconcat\n      [ foldMap (First . smallestContainingSatisfying sp cond) $\n          nodeChildren node\n      , First $ if cond node then Just node else Nothing\n      ]\n  | sp `containsSpan` nodeSpan node = Nothing\n  | otherwise = Nothing\n\nselectLargestContainedBy :: Span -> HieAST a -> Maybe (HieAST a)\nselectLargestContainedBy sp node\n  | sp `containsSpan` nodeSpan node = Just node\n  | nodeSpan node `containsSpan` sp =\n      getFirst $ foldMap (First . selectLargestContainedBy sp) $\n        nodeChildren node\n  | otherwise = Nothing\n\nselectSmallestContaining :: Span -> HieAST a -> Maybe (HieAST a)\nselectSmallestContaining sp node\n  | nodeSpan node `containsSpan` sp = getFirst $ mconcat\n      [ foldMap (First . selectSmallestContaining sp) $ nodeChildren node\n      , First (Just node)\n      ]\n  | sp `containsSpan` nodeSpan node = Nothing\n  | otherwise = Nothing\n\ndefinedInAsts :: M.Map FastString (HieAST a) -> Name -> Bool\ndefinedInAsts asts n = case nameSrcSpan n of\n  RealSrcSpan sp -> srcSpanFile sp `elem` M.keys asts\n  _ -> False\n\nisOccurrence :: ContextInfo -> Bool\nisOccurrence Use = True\nisOccurrence _ = False\n\nscopeContainsSpan :: Scope -> Span -> Bool\nscopeContainsSpan NoScope _ = False\nscopeContainsSpan ModuleScope _ = True\nscopeContainsSpan (LocalScope a) b = a `containsSpan` b\n\n-- | One must contain the other. Leaf nodes cannot contain anything\ncombineAst :: HieAST Type -> HieAST Type -> HieAST Type\ncombineAst a@(Node aInf aSpn xs) b@(Node bInf bSpn ys)\n  | aSpn == bSpn = Node (aInf `combineNodeInfo` bInf) aSpn (mergeAsts xs ys)\n  | aSpn `containsSpan` bSpn = combineAst b a\ncombineAst a (Node xs span children) = Node xs span (insertAst a children)\n\n-- | Insert an AST in a sorted list of disjoint Asts\ninsertAst :: HieAST Type -> [HieAST Type] -> [HieAST Type]\ninsertAst x = mergeAsts [x]\n\n-- | Merge two nodes together.\n--\n-- Precondition and postcondition: elements in 'nodeType' are ordered.\ncombineNodeInfo :: NodeInfo Type -> NodeInfo Type -> NodeInfo Type\n(NodeInfo as ai ad) `combineNodeInfo` (NodeInfo bs bi bd) =\n  NodeInfo (S.union as bs) (mergeSorted ai bi) (M.unionWith (<>) ad bd)\n  where\n    mergeSorted :: [Type] -> [Type] -> [Type]\n    mergeSorted la@(a:as) lb@(b:bs) = case nonDetCmpType a b of\n                                        LT -> a : mergeSorted as lb\n                                        EQ -> a : mergeSorted as bs\n                                        GT -> b : mergeSorted la bs\n    mergeSorted as [] = as\n    mergeSorted [] bs = bs\n\n\n{- | Merge two sorted, disjoint lists of ASTs, combining when necessary.\n\nIn the absence of position-altering pragmas (ex: @# line \"file.hs\" 3@),\ndifferent nodes in an AST tree should either have disjoint spans (in\nwhich case you can say for sure which one comes first) or one span\nshould be completely contained in the other (in which case the contained\nspan corresponds to some child node).\n\nHowever, since Haskell does have position-altering pragmas it /is/\npossible for spans to be overlapping. Here is an example of a source file\nin which @foozball@ and @quuuuuux@ have overlapping spans:\n\n@\nmodule Baz where\n\n# line 3 \"Baz.hs\"\nfoozball :: Int\nfoozball = 0\n\n# line 3 \"Baz.hs\"\nbar, quuuuuux :: Int\nbar = 1\nquuuuuux = 2\n@\n\nIn these cases, we just do our best to produce sensible `HieAST`'s. The blame\nshould be laid at the feet of whoever wrote the line pragmas in the first place\n(usually the C preprocessor...).\n-}\nmergeAsts :: [HieAST Type] -> [HieAST Type] -> [HieAST Type]\nmergeAsts xs [] = xs\nmergeAsts [] ys = ys\nmergeAsts xs@(a:as) ys@(b:bs)\n  | span_a `containsSpan`   span_b = mergeAsts (combineAst a b : as) bs\n  | span_b `containsSpan`   span_a = mergeAsts as (combineAst a b : bs)\n  | span_a `rightOf`        span_b = b : mergeAsts xs bs\n  | span_a `leftOf`         span_b = a : mergeAsts as ys\n\n  -- These cases are to work around ASTs that are not fully disjoint\n  | span_a `startsRightOf`  span_b = b : mergeAsts as ys\n  | otherwise                      = a : mergeAsts as ys\n  where\n    span_a = nodeSpan a\n    span_b = nodeSpan b\n\nrightOf :: Span -> Span -> Bool\nrightOf s1 s2\n  = (srcSpanStartLine s1, srcSpanStartCol s1)\n       >= (srcSpanEndLine s2, srcSpanEndCol s2)\n    && (srcSpanFile s1 == srcSpanFile s2)\n\nleftOf :: Span -> Span -> Bool\nleftOf s1 s2\n  = (srcSpanEndLine s1, srcSpanEndCol s1)\n       <= (srcSpanStartLine s2, srcSpanStartCol s2)\n    && (srcSpanFile s1 == srcSpanFile s2)\n\nstartsRightOf :: Span -> Span -> Bool\nstartsRightOf s1 s2\n  = (srcSpanStartLine s1, srcSpanStartCol s1)\n       >= (srcSpanStartLine s2, srcSpanStartCol s2)\n\n-- | combines and sorts ASTs using a merge sort\nmergeSortAsts :: [HieAST Type] -> [HieAST Type]\nmergeSortAsts = go . map pure\n  where\n    go [] = []\n    go [xs] = xs\n    go xss = go (mergePairs xss)\n    mergePairs [] = []\n    mergePairs [xs] = [xs]\n    mergePairs (xs:ys:xss) = mergeAsts xs ys : mergePairs xss\n\nsimpleNodeInfo :: FastString -> FastString -> NodeInfo a\nsimpleNodeInfo cons typ = NodeInfo (S.singleton (cons, typ)) [] M.empty\n\nlocOnly :: SrcSpan -> [HieAST a]\nlocOnly (RealSrcSpan span) =\n  [Node e span []]\n    where e = NodeInfo S.empty [] M.empty\nlocOnly _ = []\n\nmkScope :: SrcSpan -> Scope\nmkScope (RealSrcSpan sp) = LocalScope sp\nmkScope _ = NoScope\n\nmkLScope :: Located a -> Scope\nmkLScope = mkScope . getLoc\n\ncombineScopes :: Scope -> Scope -> Scope\ncombineScopes ModuleScope _ = ModuleScope\ncombineScopes _ ModuleScope = ModuleScope\ncombineScopes NoScope x = x\ncombineScopes x NoScope = x\ncombineScopes (LocalScope a) (LocalScope b) =\n  mkScope $ combineSrcSpans (RealSrcSpan a) (RealSrcSpan b)\n\n{-# INLINEABLE makeNode #-}\nmakeNode\n  :: (Applicative m, Data a)\n  => a                       -- ^ helps fill in 'nodeAnnotations' (with 'Data')\n  -> SrcSpan                 -- ^ return an empty list if this is unhelpful\n  -> m [HieAST b]\nmakeNode x spn = pure $ case spn of\n  RealSrcSpan span -> [Node (simpleNodeInfo cons typ) span []]\n  _ -> []\n  where\n    cons = mkFastString . show . toConstr $ x\n    typ = mkFastString . show . typeRepTyCon . typeOf $ x\n\n{-# INLINEABLE makeTypeNode #-}\nmakeTypeNode\n  :: (Applicative m, Data a)\n  => a                       -- ^ helps fill in 'nodeAnnotations' (with 'Data')\n  -> SrcSpan                 -- ^ return an empty list if this is unhelpful\n  -> Type                    -- ^ type to associate with the node\n  -> m [HieAST Type]\nmakeTypeNode x spn etyp = pure $ case spn of\n  RealSrcSpan span ->\n    [Node (NodeInfo (S.singleton (cons,typ)) [etyp] M.empty) span []]\n  _ -> []\n  where\n    cons = mkFastString . show . toConstr $ x\n    typ = mkFastString . show . typeRepTyCon . typeOf $ x\n", "num_lines": 456}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nThis module converts Template Haskell syntax into HsSyn\n-}\n\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule Convert( convertToHsExpr, convertToPat, convertToHsDecls,\n                convertToHsType,\n                thRdrNameGuesses ) where\n\nimport GhcPrelude\n\nimport HsSyn as Hs\nimport PrelNames\nimport RdrName\nimport qualified Name\nimport Module\nimport RdrHsSyn\nimport OccName\nimport SrcLoc\nimport Type\nimport qualified Coercion ( Role(..) )\nimport TysWiredIn\nimport BasicTypes as Hs\nimport ForeignCall\nimport Unique\nimport ErrUtils\nimport Bag\nimport Lexeme\nimport Util\nimport FastString\nimport Outputable\nimport MonadUtils ( foldrM )\n\nimport qualified Data.ByteString as BS\nimport Control.Monad( unless, liftM, ap )\n\nimport Data.Maybe( catMaybes, isNothing )\nimport Language.Haskell.TH as TH hiding (sigP)\nimport Language.Haskell.TH.Syntax as TH\n\n-------------------------------------------------------------------\n--              The external interface\n\nconvertToHsDecls :: SrcSpan -> [TH.Dec] -> Either MsgDoc [LHsDecl GhcPs]\nconvertToHsDecls loc ds = initCvt loc (fmap catMaybes (mapM cvt_dec ds))\n  where\n    cvt_dec d = wrapMsg \"declaration\" d (cvtDec d)\n\nconvertToHsExpr :: SrcSpan -> TH.Exp -> Either MsgDoc (LHsExpr GhcPs)\nconvertToHsExpr loc e\n  = initCvt loc $ wrapMsg \"expression\" e $ cvtl e\n\nconvertToPat :: SrcSpan -> TH.Pat -> Either MsgDoc (LPat GhcPs)\nconvertToPat loc p\n  = initCvt loc $ wrapMsg \"pattern\" p $ cvtPat p\n\nconvertToHsType :: SrcSpan -> TH.Type -> Either MsgDoc (LHsType GhcPs)\nconvertToHsType loc t\n  = initCvt loc $ wrapMsg \"type\" t $ cvtType t\n\n-------------------------------------------------------------------\nnewtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either MsgDoc (SrcSpan, a) }\n        -- Push down the source location;\n        -- Can fail, with a single error message\n\n-- NB: If the conversion succeeds with (Right x), there should\n--     be no exception values hiding in x\n-- Reason: so a (head []) in TH code doesn't subsequently\n--         make GHC crash when it tries to walk the generated tree\n\n-- Use the loc everywhere, for lack of anything better\n-- In particular, we want it on binding locations, so that variables bound in\n-- the spliced-in declarations get a location that at least relates to the splice point\n\ninstance Functor CvtM where\n    fmap = liftM\n\ninstance Applicative CvtM where\n    pure x = CvtM $ \\loc -> Right (loc,x)\n    (<*>) = ap\n\ninstance Monad CvtM where\n  (CvtM m) >>= k = CvtM $ \\loc -> case m loc of\n                                  Left err -> Left err\n                                  Right (loc',v) -> unCvtM (k v) loc'\n\ninitCvt :: SrcSpan -> CvtM a -> Either MsgDoc a\ninitCvt loc (CvtM m) = fmap snd (m loc)\n\nforce :: a -> CvtM ()\nforce a = a `seq` return ()\n\nfailWith :: MsgDoc -> CvtM a\nfailWith m = CvtM (\\_ -> Left m)\n\ngetL :: CvtM SrcSpan\ngetL = CvtM (\\loc -> Right (loc,loc))\n\nsetL :: SrcSpan -> CvtM ()\nsetL loc = CvtM (\\_ -> Right (loc, ()))\n\nreturnL :: HasSrcSpan a => SrcSpanLess a -> CvtM a\nreturnL x = CvtM (\\loc -> Right (loc, cL loc x))\n\nreturnJustL :: HasSrcSpan a => SrcSpanLess a -> CvtM (Maybe a)\nreturnJustL = fmap Just . returnL\n\nwrapParL :: HasSrcSpan a =>\n            (a -> SrcSpanLess a) -> SrcSpanLess a -> CvtM (SrcSpanLess  a)\nwrapParL add_par x = CvtM (\\loc -> Right (loc, add_par (cL loc x)))\n\nwrapMsg :: (Show a, TH.Ppr a) => String -> a -> CvtM b -> CvtM b\n-- E.g  wrapMsg \"declaration\" dec thing\nwrapMsg what item (CvtM m)\n  = CvtM (\\loc -> case m loc of\n                     Left err -> Left (err $$ getPprStyle msg)\n                     Right v  -> Right v)\n  where\n        -- Show the item in pretty syntax normally,\n        -- but with all its constructors if you say -dppr-debug\n    msg sty = hang (text \"When splicing a TH\" <+> text what <> colon)\n                 2 (if debugStyle sty\n                    then text (show item)\n                    else text (pprint item))\n\nwrapL :: HasSrcSpan a => CvtM (SrcSpanLess a) -> CvtM a\nwrapL (CvtM m) = CvtM (\\loc -> case m loc of\n                               Left err -> Left err\n                               Right (loc',v) -> Right (loc',cL loc v))\n\n-------------------------------------------------------------------\ncvtDecs :: [TH.Dec] -> CvtM [LHsDecl GhcPs]\ncvtDecs = fmap catMaybes . mapM cvtDec\n\ncvtDec :: TH.Dec -> CvtM (Maybe (LHsDecl GhcPs))\ncvtDec (TH.ValD pat body ds)\n  | TH.VarP s <- pat\n  = do  { s' <- vNameL s\n        ; cl' <- cvtClause (mkPrefixFunRhs s') (Clause [] body ds)\n        ; returnJustL $ Hs.ValD noExt $ mkFunBind s' [cl'] }\n\n  | otherwise\n  = do  { pat' <- cvtPat pat\n        ; body' <- cvtGuard body\n        ; ds' <- cvtLocalDecs (text \"a where clause\") ds\n        ; returnJustL $ Hs.ValD noExt $\n          PatBind { pat_lhs = pat'\n                  , pat_rhs = GRHSs noExt body' (noLoc ds')\n                  , pat_ext = noExt\n                  , pat_ticks = ([],[]) } }\n\ncvtDec (TH.FunD nm cls)\n  | null cls\n  = failWith (text \"Function binding for\"\n                 <+> quotes (text (TH.pprint nm))\n                 <+> text \"has no equations\")\n  | otherwise\n  = do  { nm' <- vNameL nm\n        ; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls\n        ; returnJustL $ Hs.ValD noExt $ mkFunBind nm' cls' }\n\ncvtDec (TH.SigD nm typ)\n  = do  { nm' <- vNameL nm\n        ; ty' <- cvtType typ\n        ; returnJustL $ Hs.SigD noExt\n                                    (TypeSig noExt [nm'] (mkLHsSigWcType ty')) }\n\ncvtDec (TH.InfixD fx nm)\n  -- Fixity signatures are allowed for variables, constructors, and types\n  -- the renamer automatically looks for types during renaming, even when\n  -- the RdrName says it's a variable or a constructor. So, just assume\n  -- it's a variable or constructor and proceed.\n  = do { nm' <- vcNameL nm\n       ; returnJustL (Hs.SigD noExt (FixSig noExt\n                                      (FixitySig noExt [nm'] (cvtFixity fx)))) }\n\ncvtDec (PragmaD prag)\n  = cvtPragmaD prag\n\ncvtDec (TySynD tc tvs rhs)\n  = do  { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs\n        ; rhs' <- cvtType rhs\n        ; returnJustL $ TyClD noExt $\n          SynDecl { tcdSExt = noExt, tcdLName = tc', tcdTyVars = tvs'\n                  , tcdFixity = Prefix\n                  , tcdRhs = rhs' } }\n\ncvtDec (DataD ctxt tc tvs ksig constrs derivs)\n  = do  { let isGadtCon (GadtC    _ _ _) = True\n              isGadtCon (RecGadtC _ _ _) = True\n              isGadtCon (ForallC  _ _ c) = isGadtCon c\n              isGadtCon _                = False\n              isGadtDecl  = all isGadtCon constrs\n              isH98Decl   = all (not . isGadtCon) constrs\n        ; unless (isGadtDecl || isH98Decl)\n                 (failWith (text \"Cannot mix GADT constructors with Haskell 98\"\n                        <+> text \"constructors\"))\n        ; unless (isNothing ksig || isGadtDecl)\n                 (failWith (text \"Kind signatures are only allowed on GADTs\"))\n        ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs\n        ; ksig' <- cvtKind `traverse` ksig\n        ; cons' <- mapM cvtConstr constrs\n        ; derivs' <- cvtDerivs derivs\n        ; let defn = HsDataDefn { dd_ext = noExt\n                                , dd_ND = DataType, dd_cType = Nothing\n                                , dd_ctxt = ctxt'\n                                , dd_kindSig = ksig'\n                                , dd_cons = cons', dd_derivs = derivs' }\n        ; returnJustL $ TyClD noExt (DataDecl\n                                        { tcdDExt = noExt\n                                        , tcdLName = tc', tcdTyVars = tvs'\n                                        , tcdFixity = Prefix\n                                        , tcdDataDefn = defn }) }\n\ncvtDec (NewtypeD ctxt tc tvs ksig constr derivs)\n  = do  { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs\n        ; ksig' <- cvtKind `traverse` ksig\n        ; con' <- cvtConstr constr\n        ; derivs' <- cvtDerivs derivs\n        ; let defn = HsDataDefn { dd_ext = noExt\n                                , dd_ND = NewType, dd_cType = Nothing\n                                , dd_ctxt = ctxt'\n                                , dd_kindSig = ksig'\n                                , dd_cons = [con']\n                                , dd_derivs = derivs' }\n        ; returnJustL $ TyClD noExt (DataDecl\n                                    { tcdDExt = noExt\n                                    , tcdLName = tc', tcdTyVars = tvs'\n                                    , tcdFixity = Prefix\n                                    , tcdDataDefn = defn }) }\n\ncvtDec (ClassD ctxt cl tvs fds decs)\n  = do  { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs\n        ; fds'  <- mapM cvt_fundep fds\n        ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs (text \"a class declaration\") decs\n        ; unless (null adts')\n            (failWith $ (text \"Default data instance declarations\"\n                     <+> text \"are not allowed:\")\n                   $$ (Outputable.ppr adts'))\n        ; at_defs <- mapM cvt_at_def ats'\n        ; returnJustL $ TyClD noExt $\n          ClassDecl { tcdCExt = noExt\n                    , tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs'\n                    , tcdFixity = Prefix\n                    , tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs'\n                    , tcdMeths = binds'\n                    , tcdATs = fams', tcdATDefs = at_defs, tcdDocs = [] }\n                              -- no docs in TH ^^\n        }\n  where\n    cvt_at_def :: LTyFamInstDecl GhcPs -> CvtM (LTyFamDefltEqn GhcPs)\n    -- Very similar to what happens in RdrHsSyn.mkClassDecl\n    cvt_at_def decl = case RdrHsSyn.mkATDefault decl of\n                        Right (def, _) -> return def\n                        Left (_, msg) -> failWith msg\n\ncvtDec (InstanceD o ctxt ty decs)\n  = do  { let doc = text \"an instance declaration\"\n        ; (binds', sigs', fams', ats', adts') <- cvt_ci_decs doc decs\n        ; unless (null fams') (failWith (mkBadDecMsg doc fams'))\n        ; ctxt' <- cvtContext ctxt\n        ; (dL->L loc ty') <- cvtType ty\n        ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty'\n        ; returnJustL $ InstD noExt $ ClsInstD noExt $\n          ClsInstDecl { cid_ext = noExt, cid_poly_ty = mkLHsSigType inst_ty'\n                      , cid_binds = binds'\n                      , cid_sigs = Hs.mkClassOpSigs sigs'\n                      , cid_tyfam_insts = ats', cid_datafam_insts = adts'\n                      , cid_overlap_mode = fmap (cL loc . overlap) o } }\n  where\n  overlap pragma =\n    case pragma of\n      TH.Overlaps      -> Hs.Overlaps     (SourceText \"OVERLAPS\")\n      TH.Overlappable  -> Hs.Overlappable (SourceText \"OVERLAPPABLE\")\n      TH.Overlapping   -> Hs.Overlapping  (SourceText \"OVERLAPPING\")\n      TH.Incoherent    -> Hs.Incoherent   (SourceText \"INCOHERENT\")\n\n\n\n\ncvtDec (ForeignD ford)\n  = do { ford' <- cvtForD ford\n       ; returnJustL $ ForD noExt ford' }\n\ncvtDec (DataFamilyD tc tvs kind)\n  = do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs\n       ; result <- cvtMaybeKindToFamilyResultSig kind\n       ; returnJustL $ TyClD noExt $ FamDecl noExt $\n         FamilyDecl noExt DataFamily tc' tvs' Prefix result Nothing }\n\ncvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)\n  = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys\n       ; ksig' <- cvtKind `traverse` ksig\n       ; cons' <- mapM cvtConstr constrs\n       ; derivs' <- cvtDerivs derivs\n       ; let defn = HsDataDefn { dd_ext = noExt\n                               , dd_ND = DataType, dd_cType = Nothing\n                               , dd_ctxt = ctxt'\n                               , dd_kindSig = ksig'\n                               , dd_cons = cons', dd_derivs = derivs' }\n\n       ; returnJustL $ InstD noExt $ DataFamInstD\n           { dfid_ext = noExt\n           , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $\n                           FamEqn { feqn_ext = noExt\n                                  , feqn_tycon = tc'\n                                  , feqn_bndrs = bndrs'\n                                  , feqn_pats = typats'\n                                  , feqn_rhs = defn\n                                  , feqn_fixity = Prefix } }}}\n\ncvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)\n  = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys\n       ; ksig' <- cvtKind `traverse` ksig\n       ; con' <- cvtConstr constr\n       ; derivs' <- cvtDerivs derivs\n       ; let defn = HsDataDefn { dd_ext = noExt\n                               , dd_ND = NewType, dd_cType = Nothing\n                               , dd_ctxt = ctxt'\n                               , dd_kindSig = ksig'\n                               , dd_cons = [con'], dd_derivs = derivs' }\n       ; returnJustL $ InstD noExt $ DataFamInstD\n           { dfid_ext = noExt\n           , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $\n                           FamEqn { feqn_ext = noExt\n                                  , feqn_tycon = tc'\n                                  , feqn_bndrs = bndrs'\n                                  , feqn_pats = typats'\n                                  , feqn_rhs = defn\n                                  , feqn_fixity = Prefix } }}}\n\ncvtDec (TySynInstD eqn)\n  = do  { (dL->L _ eqn') <- cvtTySynEqn eqn\n        ; returnJustL $ InstD noExt $ TyFamInstD\n            { tfid_ext = noExt\n            , tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } }\n\ncvtDec (OpenTypeFamilyD head)\n  = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head\n       ; returnJustL $ TyClD noExt $ FamDecl noExt $\n         FamilyDecl noExt OpenTypeFamily tc' tyvars' Prefix result' injectivity'\n       }\n\ncvtDec (ClosedTypeFamilyD head eqns)\n  = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head\n       ; eqns' <- mapM cvtTySynEqn eqns\n       ; returnJustL $ TyClD noExt $ FamDecl noExt $\n         FamilyDecl noExt (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix\n                           result' injectivity' }\n\ncvtDec (TH.RoleAnnotD tc roles)\n  = do { tc' <- tconNameL tc\n       ; let roles' = map (noLoc . cvtRole) roles\n       ; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') }\n\ncvtDec (TH.StandaloneDerivD ds cxt ty)\n  = do { cxt' <- cvtContext cxt\n       ; ds'  <- traverse cvtDerivStrategy ds\n       ; (dL->L loc ty') <- cvtType ty\n       ; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty'\n       ; returnJustL $ DerivD noExt $\n         DerivDecl { deriv_ext =noExt\n                   , deriv_strategy = ds'\n                   , deriv_type = mkLHsSigWcType inst_ty'\n                   , deriv_overlap_mode = Nothing } }\n\ncvtDec (TH.DefaultSigD nm typ)\n  = do { nm' <- vNameL nm\n       ; ty' <- cvtType typ\n       ; returnJustL $ Hs.SigD noExt\n                     $ ClassOpSig noExt True [nm'] (mkLHsSigType ty')}\n\ncvtDec (TH.PatSynD nm args dir pat)\n  = do { nm'   <- cNameL nm\n       ; args' <- cvtArgs args\n       ; dir'  <- cvtDir nm' dir\n       ; pat'  <- cvtPat pat\n       ; returnJustL $ Hs.ValD noExt $ PatSynBind noExt $\n           PSB noExt nm' args' pat' dir' }\n  where\n    cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameL args\n    cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameL a1 <*> vNameL a2\n    cvtArgs (TH.RecordPatSyn sels)\n      = do { sels' <- mapM vNameL sels\n           ; vars' <- mapM (vNameL . mkNameS . nameBase) sels\n           ; return $ Hs.RecCon $ zipWith RecordPatSynField sels' vars' }\n\n    cvtDir _ Unidir          = return Unidirectional\n    cvtDir _ ImplBidir       = return ImplicitBidirectional\n    cvtDir n (ExplBidir cls) =\n      do { ms <- mapM (cvtClause (mkPrefixFunRhs n)) cls\n         ; return $ ExplicitBidirectional $ mkMatchGroup FromSource ms }\n\ncvtDec (TH.PatSynSigD nm ty)\n  = do { nm' <- cNameL nm\n       ; ty' <- cvtPatSynSigTy ty\n       ; returnJustL $ Hs.SigD noExt $ PatSynSig noExt [nm'] (mkLHsSigType ty')}\n\n-- Implicit parameter bindings are handled in cvtLocalDecs and\n-- cvtImplicitParamBind. They are not allowed in any other scope, so\n-- reaching this case indicates an error.\ncvtDec (TH.ImplicitParamBindD _ _)\n  = failWith (text \"Implicit parameter binding only allowed in let or where\")\n\n----------------\ncvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs)\ncvtTySynEqn (TySynEqn mb_bndrs lhs rhs)\n  = do { mb_bndrs' <- traverse (mapM cvt_tv) mb_bndrs\n       ; (head_ty, args) <- split_ty_app lhs\n       ; case head_ty of\n           ConT nm -> do { nm' <- tconNameL nm\n                         ; rhs' <- cvtType rhs\n                         ; let args' = map wrap_tyarg args\n                         ; returnL $ mkHsImplicitBndrs\n                            $ FamEqn { feqn_ext    = noExt\n                                     , feqn_tycon  = nm'\n                                     , feqn_bndrs  = mb_bndrs'\n                                     , feqn_pats   = args'\n                                     , feqn_fixity = Prefix\n                                     , feqn_rhs    = rhs' } }\n           InfixT t1 nm t2 -> do { nm' <- tconNameL nm\n                                 ; args' <- mapM cvtType [t1,t2]\n                                 ; rhs' <- cvtType rhs\n                                 ; returnL $ mkHsImplicitBndrs\n                                      $ FamEqn { feqn_ext    = noExt\n                                               , feqn_tycon  = nm'\n                                               , feqn_bndrs  = mb_bndrs'\n                                               , feqn_pats   =\n                                                (map HsValArg args') ++ args\n                                               , feqn_fixity = Hs.Infix\n                                               , feqn_rhs    = rhs' } }\n           _ -> failWith $ text \"Invalid type family instance LHS:\"\n                          <+> text (show lhs)\n        }\n\n----------------\ncvt_ci_decs :: MsgDoc -> [TH.Dec]\n            -> CvtM (LHsBinds GhcPs,\n                     [LSig GhcPs],\n                     [LFamilyDecl GhcPs],\n                     [LTyFamInstDecl GhcPs],\n                     [LDataFamInstDecl GhcPs])\n-- Convert the declarations inside a class or instance decl\n-- ie signatures, bindings, and associated types\ncvt_ci_decs doc decs\n  = do  { decs' <- cvtDecs decs\n        ; let (ats', bind_sig_decs') = partitionWith is_tyfam_inst decs'\n        ; let (adts', no_ats')       = partitionWith is_datafam_inst bind_sig_decs'\n        ; let (sigs', prob_binds')   = partitionWith is_sig no_ats'\n        ; let (binds', prob_fams')   = partitionWith is_bind prob_binds'\n        ; let (fams', bads)          = partitionWith is_fam_decl prob_fams'\n        ; unless (null bads) (failWith (mkBadDecMsg doc bads))\n          --We use FromSource as the origin of the bind\n          -- because the TH declaration is user-written\n        ; return (listToBag binds', sigs', fams', ats', adts') }\n\n----------------\ncvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr]\n             -> CvtM ( LHsContext GhcPs\n                     , Located RdrName\n                     , LHsQTyVars GhcPs)\ncvt_tycl_hdr cxt tc tvs\n  = do { cxt' <- cvtContext cxt\n       ; tc'  <- tconNameL tc\n       ; tvs' <- cvtTvs tvs\n       ; return (cxt', tc', tvs')\n       }\n\ncvt_datainst_hdr :: TH.Cxt -> Maybe [TH.TyVarBndr] -> TH.Type\n               -> CvtM ( LHsContext GhcPs\n                       , Located RdrName\n                       , Maybe [LHsTyVarBndr GhcPs]\n                       , HsTyPats GhcPs)\ncvt_datainst_hdr cxt bndrs tys\n  = do { cxt' <- cvtContext cxt\n       ; bndrs' <- traverse (mapM cvt_tv) bndrs\n       ; (head_ty, args) <- split_ty_app tys\n       ; case head_ty of\n          ConT nm -> do { nm' <- tconNameL nm\n                        ; let args' = map wrap_tyarg args\n                        ; return (cxt', nm', bndrs', args') }\n          InfixT t1 nm t2 -> do { nm' <- tconNameL nm\n                                ; args' <- mapM cvtType [t1,t2]\n                                ; return (cxt', nm', bndrs',\n                                         ((map HsValArg args') ++ args)) }\n          _ -> failWith $ text \"Invalid type instance header:\"\n                          <+> text (show tys) }\n\n----------------\ncvt_tyfam_head :: TypeFamilyHead\n               -> CvtM ( Located RdrName\n                       , LHsQTyVars GhcPs\n                       , Hs.LFamilyResultSig GhcPs\n                       , Maybe (Hs.LInjectivityAnn GhcPs))\n\ncvt_tyfam_head (TypeFamilyHead tc tyvars result injectivity)\n  = do {(_, tc', tyvars') <- cvt_tycl_hdr [] tc tyvars\n       ; result' <- cvtFamilyResultSig result\n       ; injectivity' <- traverse cvtInjectivityAnnotation injectivity\n       ; return (tc', tyvars', result', injectivity') }\n\n-------------------------------------------------------------------\n--              Partitioning declarations\n-------------------------------------------------------------------\n\nis_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)\nis_fam_decl (dL->L loc (TyClD _ (FamDecl { tcdFam = d }))) = Left (cL loc d)\nis_fam_decl decl = Right decl\n\nis_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)\nis_tyfam_inst (dL->L loc (Hs.InstD _ (TyFamInstD { tfid_inst = d })))\n  = Left (cL loc d)\nis_tyfam_inst decl\n  = Right decl\n\nis_datafam_inst :: LHsDecl GhcPs\n                -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)\nis_datafam_inst (dL->L loc (Hs.InstD  _ (DataFamInstD { dfid_inst = d })))\n  = Left (cL loc d)\nis_datafam_inst decl\n  = Right decl\n\nis_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)\nis_sig (dL->L loc (Hs.SigD _ sig)) = Left (cL loc sig)\nis_sig decl                        = Right decl\n\nis_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)\nis_bind (dL->L loc (Hs.ValD _ bind)) = Left (cL loc bind)\nis_bind decl                         = Right decl\n\nis_ip_bind :: TH.Dec -> Either (String, TH.Exp) TH.Dec\nis_ip_bind (TH.ImplicitParamBindD n e) = Left (n, e)\nis_ip_bind decl             = Right decl\n\nmkBadDecMsg :: Outputable a => MsgDoc -> [a] -> MsgDoc\nmkBadDecMsg doc bads\n  = sep [ text \"Illegal declaration(s) in\" <+> doc <> colon\n        , nest 2 (vcat (map Outputable.ppr bads)) ]\n\n---------------------------------------------------\n--      Data types\n---------------------------------------------------\n\ncvtConstr :: TH.Con -> CvtM (LConDecl GhcPs)\n\ncvtConstr (NormalC c strtys)\n  = do  { c'   <- cNameL c\n        ; tys' <- mapM cvt_arg strtys\n        ; returnL $ mkConDeclH98 c' Nothing Nothing (PrefixCon tys') }\n\ncvtConstr (RecC c varstrtys)\n  = do  { c'    <- cNameL c\n        ; args' <- mapM cvt_id_arg varstrtys\n        ; returnL $ mkConDeclH98 c' Nothing Nothing\n                                   (RecCon (noLoc args')) }\n\ncvtConstr (InfixC st1 c st2)\n  = do  { c'   <- cNameL c\n        ; st1' <- cvt_arg st1\n        ; st2' <- cvt_arg st2\n        ; returnL $ mkConDeclH98 c' Nothing Nothing (InfixCon st1' st2') }\n\ncvtConstr (ForallC tvs ctxt con)\n  = do  { tvs'      <- cvtTvs tvs\n        ; ctxt'     <- cvtContext ctxt\n        ; (dL->L _ con')  <- cvtConstr con\n        ; returnL $ add_forall tvs' ctxt' con' }\n  where\n    add_cxt lcxt         Nothing           = Just lcxt\n    add_cxt (dL->L loc cxt1) (Just (dL->L _ cxt2))\n      = Just (cL loc (cxt1 ++ cxt2))\n\n    add_forall tvs' cxt' con@(ConDeclGADT { con_qvars = qvars, con_mb_cxt = cxt })\n      = con { con_forall = noLoc $ not (null all_tvs)\n            , con_qvars  = mkHsQTvs all_tvs\n            , con_mb_cxt = add_cxt cxt' cxt }\n      where\n        all_tvs = hsQTvExplicit tvs' ++ hsQTvExplicit qvars\n\n    add_forall tvs' cxt' con@(ConDeclH98 { con_ex_tvs = ex_tvs, con_mb_cxt = cxt })\n      = con { con_forall = noLoc $ not (null all_tvs)\n            , con_ex_tvs = all_tvs\n            , con_mb_cxt = add_cxt cxt' cxt }\n      where\n        all_tvs = hsQTvExplicit tvs' ++ ex_tvs\n\n    add_forall _ _ (XConDecl _) = panic \"cvtConstr\"\n\ncvtConstr (GadtC c strtys ty)\n  = do  { c'      <- mapM cNameL c\n        ; args    <- mapM cvt_arg strtys\n        ; (dL->L _ ty') <- cvtType ty\n        ; c_ty    <- mk_arr_apps args ty'\n        ; returnL $ fst $ mkGadtDecl c' c_ty}\n\ncvtConstr (RecGadtC c varstrtys ty)\n  = do  { c'       <- mapM cNameL c\n        ; ty'      <- cvtType ty\n        ; rec_flds <- mapM cvt_id_arg varstrtys\n        ; let rec_ty = noLoc (HsFunTy noExt\n                                           (noLoc $ HsRecTy noExt rec_flds) ty')\n        ; returnL $ fst $ mkGadtDecl c' rec_ty }\n\ncvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness\ncvtSrcUnpackedness NoSourceUnpackedness = NoSrcUnpack\ncvtSrcUnpackedness SourceNoUnpack       = SrcNoUnpack\ncvtSrcUnpackedness SourceUnpack         = SrcUnpack\n\ncvtSrcStrictness :: TH.SourceStrictness -> SrcStrictness\ncvtSrcStrictness NoSourceStrictness = NoSrcStrict\ncvtSrcStrictness SourceLazy         = SrcLazy\ncvtSrcStrictness SourceStrict       = SrcStrict\n\ncvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType GhcPs)\ncvt_arg (Bang su ss, ty)\n  = do { ty'' <- cvtType ty\n       ; let ty' = parenthesizeHsType appPrec ty''\n             su' = cvtSrcUnpackedness su\n             ss' = cvtSrcStrictness ss\n       ; returnL $ HsBangTy noExt (HsSrcBang NoSourceText su' ss') ty' }\n\ncvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)\ncvt_id_arg (i, str, ty)\n  = do  { (dL->L li i') <- vNameL i\n        ; ty' <- cvt_arg (str,ty)\n        ; return $ noLoc (ConDeclField\n                          { cd_fld_ext = noExt\n                          , cd_fld_names\n                              = [cL li $ FieldOcc noExt (cL li i')]\n                          , cd_fld_type =  ty'\n                          , cd_fld_doc = Nothing}) }\n\ncvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving GhcPs)\ncvtDerivs cs = do { cs' <- mapM cvtDerivClause cs\n                  ; returnL cs' }\n\ncvt_fundep :: FunDep -> CvtM (LHsFunDep GhcPs)\ncvt_fundep (FunDep xs ys) = do { xs' <- mapM tNameL xs\n                               ; ys' <- mapM tNameL ys\n                               ; returnL (xs', ys') }\n\n\n------------------------------------------\n--      Foreign declarations\n------------------------------------------\n\ncvtForD :: Foreign -> CvtM (ForeignDecl GhcPs)\ncvtForD (ImportF callconv safety from nm ty)\n  -- the prim and javascript calling conventions do not support headers\n  -- and are inserted verbatim, analogous to mkImport in RdrHsSyn\n  | callconv == TH.Prim || callconv == TH.JavaScript\n  = mk_imp (CImport (noLoc (cvt_conv callconv)) (noLoc safety') Nothing\n                    (CFunction (StaticTarget (SourceText from)\n                                             (mkFastString from) Nothing\n                                             True))\n                    (noLoc $ quotedSourceText from))\n  | Just impspec <- parseCImport (noLoc (cvt_conv callconv)) (noLoc safety')\n                                 (mkFastString (TH.nameBase nm))\n                                 from (noLoc $ quotedSourceText from)\n  = mk_imp impspec\n  | otherwise\n  = failWith $ text (show from) <+> text \"is not a valid ccall impent\"\n  where\n    mk_imp impspec\n      = do { nm' <- vNameL nm\n           ; ty' <- cvtType ty\n           ; return (ForeignImport { fd_i_ext = noExt\n                                   , fd_name = nm'\n                                   , fd_sig_ty = mkLHsSigType ty'\n                                   , fd_fi = impspec })\n           }\n    safety' = case safety of\n                     Unsafe     -> PlayRisky\n                     Safe       -> PlaySafe\n                     Interruptible -> PlayInterruptible\n\ncvtForD (ExportF callconv as nm ty)\n  = do  { nm' <- vNameL nm\n        ; ty' <- cvtType ty\n        ; let e = CExport (noLoc (CExportStatic (SourceText as)\n                                                (mkFastString as)\n                                                (cvt_conv callconv)))\n                                                (noLoc (SourceText as))\n        ; return $ ForeignExport { fd_e_ext = noExt\n                                 , fd_name = nm'\n                                 , fd_sig_ty = mkLHsSigType ty'\n                                 , fd_fe = e } }\n\ncvt_conv :: TH.Callconv -> CCallConv\ncvt_conv TH.CCall      = CCallConv\ncvt_conv TH.StdCall    = StdCallConv\ncvt_conv TH.CApi       = CApiConv\ncvt_conv TH.Prim       = PrimCallConv\ncvt_conv TH.JavaScript = JavaScriptCallConv\n\n------------------------------------------\n--              Pragmas\n------------------------------------------\n\ncvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl GhcPs))\ncvtPragmaD (InlineP nm inline rm phases)\n  = do { nm' <- vNameL nm\n       ; let dflt = dfltActivation inline\n       ; let src TH.NoInline  = \"{-# NOINLINE\"\n             src TH.Inline    = \"{-# INLINE\"\n             src TH.Inlinable = \"{-# INLINABLE\"\n       ; let ip   = InlinePragma { inl_src    = SourceText $ src inline\n                                 , inl_inline = cvtInline inline\n                                 , inl_rule   = cvtRuleMatch rm\n                                 , inl_act    = cvtPhases phases dflt\n                                 , inl_sat    = Nothing }\n       ; returnJustL $ Hs.SigD noExt $ InlineSig noExt nm' ip }\n\ncvtPragmaD (SpecialiseP nm ty inline phases)\n  = do { nm' <- vNameL nm\n       ; ty' <- cvtType ty\n       ; let src TH.NoInline  = \"{-# SPECIALISE NOINLINE\"\n             src TH.Inline    = \"{-# SPECIALISE INLINE\"\n             src TH.Inlinable = \"{-# SPECIALISE INLINE\"\n       ; let (inline', dflt,srcText) = case inline of\n               Just inline1 -> (cvtInline inline1, dfltActivation inline1,\n                                src inline1)\n               Nothing      -> (NoUserInline,   AlwaysActive,\n                                \"{-# SPECIALISE\")\n       ; let ip = InlinePragma { inl_src    = SourceText srcText\n                               , inl_inline = inline'\n                               , inl_rule   = Hs.FunLike\n                               , inl_act    = cvtPhases phases dflt\n                               , inl_sat    = Nothing }\n       ; returnJustL $ Hs.SigD noExt $ SpecSig noExt nm' [mkLHsSigType ty'] ip }\n\ncvtPragmaD (SpecialiseInstP ty)\n  = do { ty' <- cvtType ty\n       ; returnJustL $ Hs.SigD noExt $\n         SpecInstSig noExt (SourceText \"{-# SPECIALISE\") (mkLHsSigType ty') }\n\ncvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)\n  = do { let nm' = mkFastString nm\n       ; let act = cvtPhases phases AlwaysActive\n       ; ty_bndrs' <- traverse (mapM cvt_tv) ty_bndrs\n       ; tm_bndrs' <- mapM cvtRuleBndr tm_bndrs\n       ; lhs'   <- cvtl lhs\n       ; rhs'   <- cvtl rhs\n       ; returnJustL $ Hs.RuleD noExt\n            $ HsRules { rds_ext = noExt\n                      , rds_src = SourceText \"{-# RULES\"\n                      , rds_rules = [noLoc $\n                          HsRule { rd_ext  = noExt\n                                 , rd_name = (noLoc (quotedSourceText nm,nm'))\n                                 , rd_act  = act\n                                 , rd_tyvs = ty_bndrs'\n                                 , rd_tmvs = tm_bndrs'\n                                 , rd_lhs  = lhs'\n                                 , rd_rhs  = rhs' }] }\n\n          }\n\ncvtPragmaD (AnnP target exp)\n  = do { exp' <- cvtl exp\n       ; target' <- case target of\n         ModuleAnnotation  -> return ModuleAnnProvenance\n         TypeAnnotation n  -> do\n           n' <- tconName n\n           return (TypeAnnProvenance  (noLoc n'))\n         ValueAnnotation n -> do\n           n' <- vcName n\n           return (ValueAnnProvenance (noLoc n'))\n       ; returnJustL $ Hs.AnnD noExt\n                     $ HsAnnotation noExt (SourceText \"{-# ANN\") target' exp'\n       }\n\ncvtPragmaD (LineP line file)\n  = do { setL (srcLocSpan (mkSrcLoc (fsLit file) line 1))\n       ; return Nothing\n       }\ncvtPragmaD (CompleteP cls mty)\n  = do { cls' <- noLoc <$> mapM cNameL cls\n       ; mty'  <- traverse tconNameL mty\n       ; returnJustL $ Hs.SigD noExt\n                   $ CompleteMatchSig noExt NoSourceText cls' mty' }\n\ndfltActivation :: TH.Inline -> Activation\ndfltActivation TH.NoInline = NeverActive\ndfltActivation _           = AlwaysActive\n\ncvtInline :: TH.Inline -> Hs.InlineSpec\ncvtInline TH.NoInline  = Hs.NoInline\ncvtInline TH.Inline    = Hs.Inline\ncvtInline TH.Inlinable = Hs.Inlinable\n\ncvtRuleMatch :: TH.RuleMatch -> RuleMatchInfo\ncvtRuleMatch TH.ConLike = Hs.ConLike\ncvtRuleMatch TH.FunLike = Hs.FunLike\n\ncvtPhases :: TH.Phases -> Activation -> Activation\ncvtPhases AllPhases       dflt = dflt\ncvtPhases (FromPhase i)   _    = ActiveAfter NoSourceText i\ncvtPhases (BeforePhase i) _    = ActiveBefore NoSourceText i\n\ncvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)\ncvtRuleBndr (RuleVar n)\n  = do { n' <- vNameL n\n       ; return $ noLoc $ Hs.RuleBndr noExt n' }\ncvtRuleBndr (TypedRuleVar n ty)\n  = do { n'  <- vNameL n\n       ; ty' <- cvtType ty\n       ; return $ noLoc $ Hs.RuleBndrSig noExt n' $ mkLHsSigWcType ty' }\n\n---------------------------------------------------\n--              Declarations\n---------------------------------------------------\n\ncvtLocalDecs :: MsgDoc -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs)\ncvtLocalDecs doc ds\n  = case partitionWith is_ip_bind ds of\n      ([], []) -> return (EmptyLocalBinds noExt)\n      ([], _) -> do\n        ds' <- cvtDecs ds\n        let (binds, prob_sigs) = partitionWith is_bind ds'\n        let (sigs, bads) = partitionWith is_sig prob_sigs\n        unless (null bads) (failWith (mkBadDecMsg doc bads))\n        return (HsValBinds noExt (ValBinds noExt (listToBag binds) sigs))\n      (ip_binds, []) -> do\n        binds <- mapM (uncurry cvtImplicitParamBind) ip_binds\n        return (HsIPBinds noExt (IPBinds noExt binds))\n      ((_:_), (_:_)) ->\n        failWith (text \"Implicit parameters mixed with other bindings\")\n\ncvtClause :: HsMatchContext RdrName\n          -> TH.Clause -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))\ncvtClause ctxt (Clause ps body wheres)\n  = do  { ps' <- cvtPats ps\n        ; let pps = map (parenthesizePat appPrec) ps'\n        ; g'  <- cvtGuard body\n        ; ds' <- cvtLocalDecs (text \"a where clause\") wheres\n        ; returnL $ Hs.Match noExt ctxt pps (GRHSs noExt g' (noLoc ds')) }\n\ncvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs)\ncvtImplicitParamBind n e = do\n    n' <- wrapL (ipName n)\n    e' <- cvtl e\n    returnL (IPBind noExt (Left n') e')\n\n-------------------------------------------------------------------\n--              Expressions\n-------------------------------------------------------------------\n\ncvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)\ncvtl e = wrapL (cvt e)\n  where\n    cvt (VarE s)        = do { s' <- vName s; return $ HsVar noExt (noLoc s') }\n    cvt (ConE s)        = do { s' <- cName s; return $ HsVar noExt (noLoc s') }\n    cvt (LitE l)\n      | overloadedLit l = go cvtOverLit (HsOverLit noExt)\n                             (hsOverLitNeedsParens appPrec)\n      | otherwise       = go cvtLit (HsLit noExt)\n                             (hsLitNeedsParens appPrec)\n      where\n        go :: (Lit -> CvtM (l GhcPs))\n           -> (l GhcPs -> HsExpr GhcPs)\n           -> (l GhcPs -> Bool)\n           -> CvtM (HsExpr GhcPs)\n        go cvt_lit mk_expr is_compound_lit = do\n          l' <- cvt_lit l\n          let e' = mk_expr l'\n          return $ if is_compound_lit l' then HsPar noExt (noLoc e') else e'\n    cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y\n                                   ; return $ HsApp noExt (mkLHsPar x')\n                                                          (mkLHsPar y')}\n    cvt (AppE x y)            = do { x' <- cvtl x; y' <- cvtl y\n                                   ; return $ HsApp noExt (mkLHsPar x')\n                                                          (mkLHsPar y')}\n    cvt (AppTypeE e t) = do { e' <- cvtl e\n                            ; t' <- cvtType t\n                            ; let tp = parenthesizeHsType appPrec t'\n                            ; return $ HsAppType noExt e'\n                                     $ mkHsWildCardBndrs tp }\n    cvt (LamE [] e)    = cvt e -- Degenerate case. We convert the body as its\n                               -- own expression to avoid pretty-printing\n                               -- oddities that can result from zero-argument\n                               -- lambda expressions. See #13856.\n    cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e\n                            ; let pats = map (parenthesizePat appPrec) ps'\n                            ; return $ HsLam noExt (mkMatchGroup FromSource\n                                             [mkSimpleMatch LambdaExpr\n                                             pats e'])}\n    cvt (LamCaseE ms)  = do { ms' <- mapM (cvtMatch CaseAlt) ms\n                            ; return $ HsLamCase noExt\n                                                   (mkMatchGroup FromSource ms')\n                            }\n    cvt (TupE [e])     = do { e' <- cvtl e; return $ HsPar noExt e' }\n                                 -- Note [Dropping constructors]\n                                 -- Singleton tuples treated like nothing (just parens)\n    cvt (TupE es)      = do { es' <- mapM cvtl es\n                            ; return $ ExplicitTuple noExt\n                                             (map (noLoc . (Present noExt)) es')\n                                                                         Boxed }\n    cvt (UnboxedTupE es)      = do { es' <- mapM cvtl es\n                                   ; return $ ExplicitTuple noExt\n                                           (map (noLoc . (Present noExt)) es')\n                                                                       Unboxed }\n    cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e\n                                       ; unboxedSumChecks alt arity\n                                       ; return $ ExplicitSum noExt\n                                                                   alt arity e'}\n    cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;\n                            ; return $ HsIf noExt (Just noSyntaxExpr) x' y' z' }\n    cvt (MultiIfE alts)\n      | null alts      = failWith (text \"Multi-way if-expression with no alternatives\")\n      | otherwise      = do { alts' <- mapM cvtpair alts\n                            ; return $ HsMultiIf noExt alts' }\n    cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (text \"a let expression\") ds\n                            ; e' <- cvtl e; return $ HsLet noExt (noLoc ds') e'}\n    cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms\n                            ; return $ HsCase noExt e'\n                                                 (mkMatchGroup FromSource ms') }\n    cvt (DoE ss)       = cvtHsDo DoExpr ss\n    cvt (MDoE ss)      = cvtHsDo MDoExpr ss\n    cvt (CompE ss)     = cvtHsDo ListComp ss\n    cvt (ArithSeqE dd) = do { dd' <- cvtDD dd\n                            ; return $ ArithSeq noExt Nothing dd' }\n    cvt (ListE xs)\n      | Just s <- allCharLs xs       = do { l' <- cvtLit (StringL s)\n                                          ; return (HsLit noExt l') }\n             -- Note [Converting strings]\n      | otherwise       = do { xs' <- mapM cvtl xs\n                             ; return $ ExplicitList noExt Nothing xs'\n                             }\n\n    -- Infix expressions\n    cvt (InfixE (Just x) s (Just y)) =\n      do { x' <- cvtl x\n         ; s' <- cvtl s\n         ; y' <- cvtl y\n         ; let px = parenthesizeHsExpr opPrec x'\n               py = parenthesizeHsExpr opPrec y'\n         ; wrapParL (HsPar noExt)\n           $ OpApp noExt px s' py }\n           -- Parenthesise both arguments and result,\n           -- to ensure this operator application does\n           -- does not get re-associated\n           -- See Note [Operator association]\n    cvt (InfixE Nothing  s (Just y)) = do { s' <- cvtl s; y' <- cvtl y\n                                          ; wrapParL (HsPar noExt) $\n                                                          SectionR noExt s' y' }\n                                            -- See Note [Sections in HsSyn] in HsExpr\n    cvt (InfixE (Just x) s Nothing ) = do { x' <- cvtl x; s' <- cvtl s\n                                          ; wrapParL (HsPar noExt) $\n                                                          SectionL noExt x' s' }\n\n    cvt (InfixE Nothing  s Nothing ) = do { s' <- cvtl s\n                                          ; return $ HsPar noExt s' }\n                                       -- Can I indicate this is an infix thing?\n                                       -- Note [Dropping constructors]\n\n    cvt (UInfixE x s y)  = do { x' <- cvtl x\n                              ; let x'' = case unLoc x' of\n                                            OpApp {} -> x'\n                                            _ -> mkLHsPar x'\n                              ; cvtOpApp x'' s y } --  Note [Converting UInfix]\n\n    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar noExt e' }\n    cvt (SigE e t)       = do { e' <- cvtl e; t' <- cvtType t\n                              ; let pe = parenthesizeHsExpr sigPrec e'\n                              ; return $ ExprWithTySig noExt pe (mkLHsSigWcType t') }\n    cvt (RecConE c flds) = do { c' <- cNameL c\n                              ; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds\n                              ; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }\n    cvt (RecUpdE e flds) = do { e' <- cvtl e\n                              ; flds'\n                                  <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))\n                                           flds\n                              ; return $ mkRdrRecordUpd e' flds' }\n    cvt (StaticE e)      = fmap (HsStatic noExt) $ cvtl e\n    cvt (UnboundVarE s)  = do -- Use of 'vcName' here instead of 'vName' is\n                              -- important, because UnboundVarE may contain\n                              -- constructor names - see #14627.\n                              { s' <- vcName s\n                              ; return $ HsVar noExt (noLoc s') }\n    cvt (LabelE s)       = do { return $ HsOverLabel noExt Nothing (fsLit s) }\n    cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExt n' }\n\n{- Note [Dropping constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we drop constructors from the input (for instance, when we encounter @TupE [e]@)\nwe must insert parentheses around the argument. Otherwise, @UInfix@ constructors in @e@\ncould meet @UInfix@ constructors containing the @TupE [e]@. For example:\n\n  UInfixE x * (TupE [UInfixE y + z])\n\nIf we drop the singleton tuple but don't insert parentheses, the @UInfixE@s would meet\nand the above expression would be reassociated to\n\n  OpApp (OpApp x * y) + z\n\nwhich we don't want.\n-}\n\ncvtFld :: (RdrName -> t) -> (TH.Name, TH.Exp)\n       -> CvtM (LHsRecField' t (LHsExpr GhcPs))\ncvtFld f (v,e)\n  = do  { v' <- vNameL v; e' <- cvtl e\n        ; return (noLoc $ HsRecField { hsRecFieldLbl = fmap f v'\n                                     , hsRecFieldArg = e'\n                                     , hsRecPun      = False}) }\n\ncvtDD :: Range -> CvtM (ArithSeqInfo GhcPs)\ncvtDD (FromR x)           = do { x' <- cvtl x; return $ From x' }\ncvtDD (FromThenR x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ FromThen x' y' }\ncvtDD (FromToR x y)       = do { x' <- cvtl x; y' <- cvtl y; return $ FromTo x' y' }\ncvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; return $ FromThenTo x' y' z' }\n\n{- Note [Operator assocation]\nWe must be quite careful about adding parens:\n  * Infix (UInfix ...) op arg      Needs parens round the first arg\n  * Infix (Infix ...) op arg       Needs parens round the first arg\n  * UInfix (UInfix ...) op arg     No parens for first arg\n  * UInfix (Infix ...) op arg      Needs parens round first arg\n\n\nNote [Converting UInfix]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWhen converting @UInfixE@, @UInfixP@, and @UInfixT@ values, we want to readjust\nthe trees to reflect the fixities of the underlying operators:\n\n  UInfixE x * (UInfixE y + z) ---> (x * y) + z\n\nThis is done by the renamer (see @mkOppAppRn@, @mkConOppPatRn@, and\n@mkHsOpTyRn@ in RnTypes), which expects that the input will be completely\nright-biased for types and left-biased for everything else. So we left-bias the\ntrees of @UInfixP@ and @UInfixE@ and right-bias the trees of @UInfixT@.\n\nSample input:\n\n  UInfixE\n   (UInfixE x op1 y)\n   op2\n   (UInfixE z op3 w)\n\nSample output:\n\n  OpApp\n    (OpApp\n      (OpApp x op1 y)\n      op2\n      z)\n    op3\n    w\n\nThe functions @cvtOpApp@, @cvtOpAppP@, and @cvtOpAppT@ are responsible for this\nbiasing.\n-}\n\n{- | @cvtOpApp x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.\nThe produced tree of infix expressions will be left-biased, provided @x@ is.\n\nWe can see that @cvtOpApp@ is correct as follows. The inductive hypothesis\nis that @cvtOpApp x op y@ is left-biased, provided @x@ is. It is clear that\nthis holds for both branches (of @cvtOpApp@), provided we assume it holds for\nthe recursive calls to @cvtOpApp@.\n\nWhen we call @cvtOpApp@ from @cvtl@, the first argument will always be left-biased\nsince we have already run @cvtl@ on it.\n-}\ncvtOpApp :: LHsExpr GhcPs -> TH.Exp -> TH.Exp -> CvtM (HsExpr GhcPs)\ncvtOpApp x op1 (UInfixE y op2 z)\n  = do { l <- wrapL $ cvtOpApp x op1 y\n       ; cvtOpApp l op2 z }\ncvtOpApp x op y\n  = do { op' <- cvtl op\n       ; y' <- cvtl y\n       ; return (OpApp noExt x op' y') }\n\n-------------------------------------\n--      Do notation and statements\n-------------------------------------\n\ncvtHsDo :: HsStmtContext Name.Name -> [TH.Stmt] -> CvtM (HsExpr GhcPs)\ncvtHsDo do_or_lc stmts\n  | null stmts = failWith (text \"Empty stmt list in do-block\")\n  | otherwise\n  = do  { stmts' <- cvtStmts stmts\n        ; let Just (stmts'', last') = snocView stmts'\n\n        ; last'' <- case last' of\n                    (dL->L loc (BodyStmt _ body _ _))\n                      -> return (cL loc (mkLastStmt body))\n                    _ -> failWith (bad_last last')\n\n        ; return $ HsDo noExt do_or_lc (noLoc (stmts'' ++ [last''])) }\n  where\n    bad_last stmt = vcat [ text \"Illegal last statement of\" <+> pprAStmtContext do_or_lc <> colon\n                         , nest 2 $ Outputable.ppr stmt\n                         , text \"(It should be an expression.)\" ]\n\ncvtStmts :: [TH.Stmt] -> CvtM [Hs.LStmt GhcPs (LHsExpr GhcPs)]\ncvtStmts = mapM cvtStmt\n\ncvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))\ncvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkBodyStmt e' }\ncvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }\ncvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (text \"a let binding\") ds\n                            ; returnL $ LetStmt noExt (noLoc ds') }\ncvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss\n                            ; returnL $ ParStmt noExt dss' noExpr noSyntaxExpr }\n  where\n    cvt_one ds = do { ds' <- cvtStmts ds\n                    ; return (ParStmtBlock noExt ds' undefined noSyntaxExpr) }\ncvtStmt (TH.RecS ss) = do { ss' <- mapM cvtStmt ss; returnL (mkRecStmt ss') }\n\ncvtMatch :: HsMatchContext RdrName\n         -> TH.Match -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))\ncvtMatch ctxt (TH.Match p body decs)\n  = do  { p' <- cvtPat p\n        ; let lp = case p' of\n                     (dL->L loc SigPat{}) -> cL loc (ParPat NoExt p') -- #14875\n                     _                    -> p'\n        ; g' <- cvtGuard body\n        ; decs' <- cvtLocalDecs (text \"a where clause\") decs\n        ; returnL $ Hs.Match noExt ctxt [lp] (GRHSs noExt g' (noLoc decs')) }\n\ncvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]\ncvtGuard (GuardedB pairs) = mapM cvtpair pairs\ncvtGuard (NormalB e)      = do { e' <- cvtl e\n                               ; g' <- returnL $ GRHS noExt [] e'; return [g'] }\n\ncvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))\ncvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs\n                              ; g' <- returnL $ mkBodyStmt ge'\n                              ; returnL $ GRHS noExt [g'] rhs' }\ncvtpair (PatG gs,rhs)    = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs\n                              ; returnL $ GRHS noExt gs' rhs' }\n\ncvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)\ncvtOverLit (IntegerL i)\n  = do { force i; return $ mkHsIntegral   (mkIntegralLit i) }\ncvtOverLit (RationalL r)\n  = do { force r; return $ mkHsFractional (mkFractionalLit r) }\ncvtOverLit (StringL s)\n  = do { let { s' = mkFastString s }\n       ; force s'\n       ; return $ mkHsIsString (quotedSourceText s) s'\n       }\ncvtOverLit _ = panic \"Convert.cvtOverLit: Unexpected overloaded literal\"\n-- An Integer is like an (overloaded) '3' in a Haskell source program\n-- Similarly 3.5 for fractionals\n\n{- Note [Converting strings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we get (ListE [CharL 'x', CharL 'y']) we'd like to convert to\na string literal for \"xy\".  Of course, we might hope to get\n(LitE (StringL \"xy\")), but not always, and allCharLs fails quickly\nif it isn't a literal string\n-}\n\nallCharLs :: [TH.Exp] -> Maybe String\n-- Note [Converting strings]\n-- NB: only fire up this setup for a non-empty list, else\n--     there's a danger of returning \"\" for [] :: [Int]!\nallCharLs xs\n  = case xs of\n      LitE (CharL c) : ys -> go [c] ys\n      _                   -> Nothing\n  where\n    go cs []                    = Just (reverse cs)\n    go cs (LitE (CharL c) : ys) = go (c:cs) ys\n    go _  _                     = Nothing\n\ncvtLit :: Lit -> CvtM (HsLit GhcPs)\ncvtLit (IntPrimL i)    = do { force i; return $ HsIntPrim NoSourceText i }\ncvtLit (WordPrimL w)   = do { force w; return $ HsWordPrim NoSourceText w }\ncvtLit (FloatPrimL f)\n  = do { force f; return $ HsFloatPrim noExt (mkFractionalLit f) }\ncvtLit (DoublePrimL f)\n  = do { force f; return $ HsDoublePrim noExt (mkFractionalLit f) }\ncvtLit (CharL c)       = do { force c; return $ HsChar NoSourceText c }\ncvtLit (CharPrimL c)   = do { force c; return $ HsCharPrim NoSourceText c }\ncvtLit (StringL s)     = do { let { s' = mkFastString s }\n                            ; force s'\n                            ; return $ HsString (quotedSourceText s) s' }\ncvtLit (StringPrimL s) = do { let { s' = BS.pack s }\n                            ; force s'\n                            ; return $ HsStringPrim NoSourceText s' }\ncvtLit _ = panic \"Convert.cvtLit: Unexpected literal\"\n        -- cvtLit should not be called on IntegerL, RationalL\n        -- That precondition is established right here in\n        -- Convert.hs, hence panic\n\nquotedSourceText :: String -> SourceText\nquotedSourceText s = SourceText $ \"\\\"\" ++ s ++ \"\\\"\"\n\ncvtPats :: [TH.Pat] -> CvtM [Hs.LPat GhcPs]\ncvtPats pats = mapM cvtPat pats\n\ncvtPat :: TH.Pat -> CvtM (Hs.LPat GhcPs)\ncvtPat pat = wrapL (cvtp pat)\n\ncvtp :: TH.Pat -> CvtM (Hs.Pat GhcPs)\ncvtp (TH.LitP l)\n  | overloadedLit l    = do { l' <- cvtOverLit l\n                            ; return (mkNPat (noLoc l') Nothing) }\n                                  -- Not right for negative patterns;\n                                  -- need to think about that!\n  | otherwise          = do { l' <- cvtLit l; return $ Hs.LitPat noExt l' }\ncvtp (TH.VarP s)       = do { s' <- vName s\n                            ; return $ Hs.VarPat noExt (noLoc s') }\ncvtp (TupP [p])        = do { p' <- cvtPat p; return $ ParPat noExt p' }\n                                         -- Note [Dropping constructors]\ncvtp (TupP ps)         = do { ps' <- cvtPats ps\n                            ; return $ TuplePat noExt ps' Boxed }\ncvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps\n                            ; return $ TuplePat noExt ps' Unboxed }\ncvtp (UnboxedSumP p alt arity)\n                       = do { p' <- cvtPat p\n                            ; unboxedSumChecks alt arity\n                            ; return $ SumPat noExt p' alt arity }\ncvtp (ConP s ps)       = do { s' <- cNameL s; ps' <- cvtPats ps\n                            ; let pps = map (parenthesizePat appPrec) ps'\n                            ; return $ ConPatIn s' (PrefixCon pps) }\ncvtp (InfixP p1 s p2)  = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2\n                            ; wrapParL (ParPat noExt) $\n                              ConPatIn s' $\n                              InfixCon (parenthesizePat opPrec p1')\n                                       (parenthesizePat opPrec p2') }\n                            -- See Note [Operator association]\ncvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix]\ncvtp (ParensP p)       = do { p' <- cvtPat p;\n                            ; case unLoc p' of  -- may be wrapped ConPatIn\n                                ParPat {} -> return $ unLoc p'\n                                _         -> return $ ParPat noExt p' }\ncvtp (TildeP p)        = do { p' <- cvtPat p; return $ LazyPat noExt p' }\ncvtp (BangP p)         = do { p' <- cvtPat p; return $ BangPat noExt p' }\ncvtp (TH.AsP s p)      = do { s' <- vNameL s; p' <- cvtPat p\n                            ; return $ AsPat noExt s' p' }\ncvtp TH.WildP          = return $ WildPat noExt\ncvtp (RecP c fs)       = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs\n                            ; return $ ConPatIn c'\n                                     $ Hs.RecCon (HsRecFields fs' Nothing) }\ncvtp (ListP ps)        = do { ps' <- cvtPats ps\n                            ; return\n                                   $ ListPat noExt ps'}\ncvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t\n                            ; return $ SigPat noExt p' (mkLHsSigWcType t') }\ncvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p\n                            ; return $ ViewPat noExt e' p'}\n\ncvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))\ncvtPatFld (s,p)\n  = do  { (dL->L ls s') <- vNameL s\n        ; p' <- cvtPat p\n        ; return (noLoc $ HsRecField { hsRecFieldLbl\n                                         = cL ls $ mkFieldOcc (cL ls s')\n                                     , hsRecFieldArg = p'\n                                     , hsRecPun      = False}) }\n\n{- | @cvtOpAppP x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.\nThe produced tree of infix patterns will be left-biased, provided @x@ is.\n\nSee the @cvtOpApp@ documentation for how this function works.\n-}\ncvtOpAppP :: Hs.LPat GhcPs -> TH.Name -> TH.Pat -> CvtM (Hs.Pat GhcPs)\ncvtOpAppP x op1 (UInfixP y op2 z)\n  = do { l <- wrapL $ cvtOpAppP x op1 y\n       ; cvtOpAppP l op2 z }\ncvtOpAppP x op y\n  = do { op' <- cNameL op\n       ; y' <- cvtPat y\n       ; return (ConPatIn op' (InfixCon x y')) }\n\n-----------------------------------------------------------\n--      Types and type variables\n\ncvtTvs :: [TH.TyVarBndr] -> CvtM (LHsQTyVars GhcPs)\ncvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') }\n\ncvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr GhcPs)\ncvt_tv (TH.PlainTV nm)\n  = do { nm' <- tNameL nm\n       ; returnL $ UserTyVar noExt nm' }\ncvt_tv (TH.KindedTV nm ki)\n  = do { nm' <- tNameL nm\n       ; ki' <- cvtKind ki\n       ; returnL $ KindedTyVar noExt nm' ki' }\n\ncvtRole :: TH.Role -> Maybe Coercion.Role\ncvtRole TH.NominalR          = Just Coercion.Nominal\ncvtRole TH.RepresentationalR = Just Coercion.Representational\ncvtRole TH.PhantomR          = Just Coercion.Phantom\ncvtRole TH.InferR            = Nothing\n\ncvtContext :: TH.Cxt -> CvtM (LHsContext GhcPs)\ncvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }\n\ncvtPred :: TH.Pred -> CvtM (LHsType GhcPs)\ncvtPred = cvtType\n\ncvtDerivClause :: TH.DerivClause\n               -> CvtM (LHsDerivingClause GhcPs)\ncvtDerivClause (TH.DerivClause ds ctxt)\n  = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext ctxt\n       ; ds'   <- traverse cvtDerivStrategy ds\n       ; returnL $ HsDerivingClause noExt ds' ctxt' }\n\ncvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs)\ncvtDerivStrategy TH.StockStrategy    = returnL Hs.StockStrategy\ncvtDerivStrategy TH.AnyclassStrategy = returnL Hs.AnyclassStrategy\ncvtDerivStrategy TH.NewtypeStrategy  = returnL Hs.NewtypeStrategy\ncvtDerivStrategy (TH.ViaStrategy ty) = do\n  ty' <- cvtType ty\n  returnL $ Hs.ViaStrategy (mkLHsSigType ty')\n\ncvtType :: TH.Type -> CvtM (LHsType GhcPs)\ncvtType = cvtTypeKind \"type\"\n\ncvtTypeKind :: String -> TH.Type -> CvtM (LHsType GhcPs)\ncvtTypeKind ty_str ty\n  = do { (head_ty, tys') <- split_ty_app ty\n       ; let m_normals = mapM extract_normal tys'\n                                where extract_normal (HsValArg ty) = Just ty\n                                      extract_normal _ = Nothing\n\n       ; case head_ty of\n           TupleT n\n            | Just normals <- m_normals\n            , normals `lengthIs` n         -- Saturated\n               -> if n==1 then return (head normals) -- Singleton tuples treated\n                                                     -- like nothing (ie just parens)\n                          else returnL (HsTupleTy noExt\n                                        HsBoxedOrConstraintTuple normals)\n            | n == 1\n               -> failWith (ptext (sLit (\"Illegal 1-tuple \" ++ ty_str ++ \" constructor\")))\n            | otherwise\n            -> mk_apps\n               (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n))))\n               tys'\n           UnboxedTupleT n\n             | Just normals <- m_normals\n             , normals `lengthIs` n               -- Saturated\n             -> returnL (HsTupleTy noExt HsUnboxedTuple normals)\n             | otherwise\n             -> mk_apps\n                (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n))))\n                tys'\n           UnboxedSumT n\n             | n < 2\n            -> failWith $\n                   vcat [ text \"Illegal sum arity:\" <+> text (show n)\n                        , nest 2 $\n                            text \"Sums must have an arity of at least 2\" ]\n             | Just normals <- m_normals\n             , normals `lengthIs` n -- Saturated\n             -> returnL (HsSumTy noExt normals)\n             | otherwise\n             -> mk_apps\n                (HsTyVar noExt NotPromoted (noLoc (getRdrName (sumTyCon n))))\n                tys'\n           ArrowT\n             | Just normals <- m_normals\n             , [x',y'] <- normals -> do\n                 x'' <- case unLoc x' of\n                          HsFunTy{}    -> returnL (HsParTy noExt x')\n                          HsForAllTy{} -> returnL (HsParTy noExt x') -- #14646\n                          HsQualTy{}   -> returnL (HsParTy noExt x') -- #15324\n                          _            -> return $\n                                          parenthesizeHsType sigPrec x'\n                 let y'' = parenthesizeHsType sigPrec y'\n                 returnL (HsFunTy noExt x'' y'')\n             | otherwise\n             -> mk_apps\n                (HsTyVar noExt NotPromoted (noLoc (getRdrName funTyCon)))\n                tys'\n           ListT\n             | Just normals <- m_normals\n             , [x'] <- normals -> do\n                returnL (HsListTy noExt x')\n             | otherwise\n             -> mk_apps\n                (HsTyVar noExt NotPromoted (noLoc (getRdrName listTyCon)))\n                tys'\n\n           VarT nm -> do { nm' <- tNameL nm\n                         ; mk_apps (HsTyVar noExt NotPromoted nm') tys' }\n           ConT nm -> do { nm' <- tconName nm\n                         ; -- ConT can contain both data constructor (i.e.,\n                           -- promoted) names and other (i.e, unpromoted)\n                           -- names, as opposed to PromotedT, which can only\n                           -- contain data constructor names. See #15572.\n                           let prom = if isRdrDataCon nm'\n                                      then IsPromoted\n                                      else NotPromoted\n                         ; mk_apps (HsTyVar noExt prom (noLoc nm')) tys'}\n\n           ForallT tvs cxt ty\n             | null tys'\n             -> do { tvs' <- cvtTvs tvs\n                   ; cxt' <- cvtContext cxt\n                   ; let pcxt = parenthesizeHsContext funPrec cxt'\n                   ; ty'  <- cvtType ty\n                   ; loc <- getL\n                   ; let hs_ty  = mkHsForAllTy tvs loc ForallInvis tvs' rho_ty\n                         rho_ty = mkHsQualTy cxt loc pcxt ty'\n\n                   ; return hs_ty }\n\n           ForallVisT tvs ty\n             | null tys'\n             -> do { tvs' <- cvtTvs tvs\n                   ; ty'  <- cvtType ty\n                   ; loc  <- getL\n                   ; pure $ mkHsForAllTy tvs loc ForallVis tvs' ty' }\n\n           SigT ty ki\n             -> do { ty' <- cvtType ty\n                   ; ki' <- cvtKind ki\n                   ; mk_apps (HsKindSig noExt ty' ki') tys'\n                   }\n\n           LitT lit\n             -> mk_apps (HsTyLit noExt (cvtTyLit lit)) tys'\n\n           WildCardT\n             -> mk_apps mkAnonWildCardTy tys'\n\n           InfixT t1 s t2\n             -> do { s'  <- tconName s\n                   ; t1' <- cvtType t1\n                   ; t2' <- cvtType t2\n                   ; mk_apps\n                      (HsTyVar noExt NotPromoted (noLoc s'))\n                      ([HsValArg t1', HsValArg t2'] ++ tys')\n                   }\n\n           UInfixT t1 s t2\n             -> do { t2' <- cvtType t2\n                   ; t <- cvtOpAppT t1 s t2'\n                   ; mk_apps (unLoc t) tys'\n                   } -- Note [Converting UInfix]\n\n           ParensT t\n             -> do { t' <- cvtType t\n                   ; mk_apps (HsParTy noExt t') tys'\n                   }\n\n           PromotedT nm -> do { nm' <- cName nm\n                              ; mk_apps (HsTyVar noExt IsPromoted (noLoc nm'))\n                                        tys' }\n                 -- Promoted data constructor; hence cName\n\n           PromotedTupleT n\n              | n == 1\n              -> failWith (ptext (sLit (\"Illegal promoted 1-tuple \" ++ ty_str)))\n              | Just normals <- m_normals\n              , normals `lengthIs` n   -- Saturated\n              -> returnL (HsExplicitTupleTy noExt normals)\n              | otherwise\n              -> mk_apps\n                 (HsTyVar noExt IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n))))\n                 tys'\n\n           PromotedNilT\n             -> mk_apps (HsExplicitListTy noExt IsPromoted []) tys'\n\n           PromotedConsT  -- See Note [Representing concrete syntax in types]\n                          -- in Language.Haskell.TH.Syntax\n              | Just normals <- m_normals\n              , [ty1, dL->L _ (HsExplicitListTy _ ip tys2)] <- normals\n              -> do\n                  returnL (HsExplicitListTy noExt ip (ty1:tys2))\n              | otherwise\n              -> mk_apps\n                 (HsTyVar noExt IsPromoted (noLoc (getRdrName consDataCon)))\n                 tys'\n\n           StarT\n             -> mk_apps\n                (HsTyVar noExt NotPromoted (noLoc (getRdrName liftedTypeKindTyCon)))\n                tys'\n\n           ConstraintT\n             -> mk_apps\n                (HsTyVar noExt NotPromoted (noLoc (getRdrName constraintKindTyCon)))\n                tys'\n\n           EqualityT\n             | Just normals <- m_normals\n             , [x',y'] <- normals ->\n                   let px = parenthesizeHsType opPrec x'\n                       py = parenthesizeHsType opPrec y'\n                   in returnL (HsOpTy noExt px (noLoc eqTyCon_RDR) py)\n               -- The long-term goal is to remove the above case entirely and\n               -- subsume it under the case for InfixT. See #15815, comment:6,\n               -- for more details.\n\n             | otherwise ->\n                   mk_apps (HsTyVar noExt NotPromoted\n                            (noLoc eqTyCon_RDR)) tys'\n           ImplicitParamT n t\n             -> do { n' <- wrapL $ ipName n\n                   ; t' <- cvtType t\n                   ; returnL (HsIParamTy noExt n' t')\n                   }\n\n           _ -> failWith (ptext (sLit (\"Malformed \" ++ ty_str)) <+> text (show ty))\n    }\n\n-- | Constructs an application of a type to arguments passed in a list.\nmk_apps :: HsType GhcPs -> [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)\nmk_apps head_ty type_args = do\n  head_ty' <- returnL head_ty\n  -- We must parenthesize the function type in case of an explicit\n  -- signature. For instance, in `(Maybe :: Type -> Type) Int`, there\n  -- _must_ be parentheses around `Maybe :: Type -> Type`.\n  let phead_ty :: LHsType GhcPs\n      phead_ty = parenthesizeHsType sigPrec head_ty'\n\n      go :: [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)\n      go [] = pure head_ty'\n      go (arg:args) =\n        case arg of\n          HsValArg ty  -> do p_ty <- add_parens ty\n                             mk_apps (HsAppTy noExt phead_ty p_ty) args\n          HsTypeArg l ki -> do p_ki <- add_parens ki\n                               mk_apps (HsAppKindTy l phead_ty p_ki) args\n          HsArgPar _   -> mk_apps (HsParTy noExt phead_ty) args\n\n  go type_args\n   where\n    -- See Note [Adding parens for splices]\n    add_parens lt@(dL->L _ t)\n      | hsTypeNeedsParens appPrec t = returnL (HsParTy noExt lt)\n      | otherwise                   = return lt\n\nwrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs\nwrap_tyarg (HsValArg ty)    = HsValArg  $ parenthesizeHsType appPrec ty\nwrap_tyarg (HsTypeArg l ki) = HsTypeArg l $ parenthesizeHsType appPrec ki\nwrap_tyarg ta@(HsArgPar {}) = ta -- Already parenthesized\n\n-- ---------------------------------------------------------------------\n-- Note [Adding parens for splices]\n{-\nThe hsSyn representation of parsed source explicitly contains all the original\nparens, as written in the source.\n\nWhen a Template Haskell (TH) splice is evaluated, the original splice is first\nrenamed and type checked and then finally converted to core in DsMeta. This core\nis then run in the TH engine, and the result comes back as a TH AST.\n\nIn the process, all parens are stripped out, as they are not needed.\n\nThis Convert module then converts the TH AST back to hsSyn AST.\n\nIn order to pretty-print this hsSyn AST, parens need to be adde back at certain\npoints so that the code is readable with its original meaning.\n\nSo scattered through Convert.hs are various points where parens are added.\n\nSee (among other closed issued) https://ghc.haskell.org/trac/ghc/ticket/14289\n-}\n-- ---------------------------------------------------------------------\n\n-- | Constructs an arrow type with a specified return type\nmk_arr_apps :: [LHsType GhcPs] -> HsType GhcPs -> CvtM (LHsType GhcPs)\nmk_arr_apps tys return_ty = foldrM go return_ty tys >>= returnL\n    where go :: LHsType GhcPs -> HsType GhcPs -> CvtM (HsType GhcPs)\n          go arg ret_ty = do { ret_ty_l <- returnL ret_ty\n                             ; return (HsFunTy noExt arg ret_ty_l) }\n\nsplit_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])\nsplit_ty_app ty = go ty []\n  where\n    go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg a':as') }\n    go (AppKindT ty ki) as' = do { ki' <- cvtKind ki\n                                 ; go ty (HsTypeArg noSrcSpan ki':as') }\n    go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') }\n    go f as           = return (f,as)\n\ncvtTyLit :: TH.TyLit -> HsTyLit\ncvtTyLit (TH.NumTyLit i) = HsNumTy NoSourceText i\ncvtTyLit (TH.StrTyLit s) = HsStrTy NoSourceText (fsLit s)\n\n{- | @cvtOpAppT x op y@ converts @op@ and @y@ and produces the operator\napplication @x `op` y@. The produced tree of infix types will be right-biased,\nprovided @y@ is.\n\nSee the @cvtOpApp@ documentation for how this function works.\n-}\ncvtOpAppT :: TH.Type -> TH.Name -> LHsType GhcPs -> CvtM (LHsType GhcPs)\ncvtOpAppT (UInfixT x op2 y) op1 z\n  = do { l <- cvtOpAppT y op1 z\n       ; cvtOpAppT x op2 l }\ncvtOpAppT x op y\n  = do { op' <- tconNameL op\n       ; x' <- cvtType x\n       ; returnL (mkHsOpTy x' op' y) }\n\ncvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)\ncvtKind = cvtTypeKind \"kind\"\n\n-- | Convert Maybe Kind to a type family result signature. Used with data\n-- families where naming of the result is not possible (thus only kind or no\n-- signature is possible).\ncvtMaybeKindToFamilyResultSig :: Maybe TH.Kind\n                              -> CvtM (LFamilyResultSig GhcPs)\ncvtMaybeKindToFamilyResultSig Nothing   = returnL (Hs.NoSig noExt)\ncvtMaybeKindToFamilyResultSig (Just ki) = do { ki' <- cvtKind ki\n                                             ; returnL (Hs.KindSig noExt ki') }\n\n-- | Convert type family result signature. Used with both open and closed type\n-- families.\ncvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)\ncvtFamilyResultSig TH.NoSig           = returnL (Hs.NoSig noExt)\ncvtFamilyResultSig (TH.KindSig ki)    = do { ki' <- cvtKind ki\n                                           ; returnL (Hs.KindSig noExt  ki') }\ncvtFamilyResultSig (TH.TyVarSig bndr) = do { tv <- cvt_tv bndr\n                                           ; returnL (Hs.TyVarSig noExt tv) }\n\n-- | Convert injectivity annotation of a type family.\ncvtInjectivityAnnotation :: TH.InjectivityAnn\n                         -> CvtM (Hs.LInjectivityAnn GhcPs)\ncvtInjectivityAnnotation (TH.InjectivityAnn annLHS annRHS)\n  = do { annLHS' <- tNameL annLHS\n       ; annRHS' <- mapM tNameL annRHS\n       ; returnL (Hs.InjectivityAnn annLHS' annRHS') }\n\ncvtPatSynSigTy :: TH.Type -> CvtM (LHsType GhcPs)\n-- pattern synonym types are of peculiar shapes, which is why we treat\n-- them separately from regular types;\n-- see Note [Pattern synonym type signatures and Template Haskell]\ncvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))\n  | null exis, null provs = cvtType (ForallT univs reqs ty)\n  | null univs, null reqs = do { l   <- getL\n                               ; ty' <- cvtType (ForallT exis provs ty)\n                               ; return $ cL l (HsQualTy { hst_ctxt = cL l []\n                                                         , hst_xqual = noExt\n                                                         , hst_body = ty' }) }\n  | null reqs             = do { l      <- getL\n                               ; univs' <- hsQTvExplicit <$> cvtTvs univs\n                               ; ty'    <- cvtType (ForallT exis provs ty)\n                               ; let forTy = HsForAllTy\n                                              { hst_fvf = ForallInvis\n                                              , hst_bndrs = univs'\n                                              , hst_xforall = noExt\n                                              , hst_body = cL l cxtTy }\n                                     cxtTy = HsQualTy { hst_ctxt = cL l []\n                                                      , hst_xqual = noExt\n                                                      , hst_body = ty' }\n                               ; return $ cL l forTy }\n  | otherwise             = cvtType (ForallT univs reqs (ForallT exis provs ty))\ncvtPatSynSigTy ty         = cvtType ty\n\n-----------------------------------------------------------\ncvtFixity :: TH.Fixity -> Hs.Fixity\ncvtFixity (TH.Fixity prec dir) = Hs.Fixity NoSourceText prec (cvt_dir dir)\n   where\n     cvt_dir TH.InfixL = Hs.InfixL\n     cvt_dir TH.InfixR = Hs.InfixR\n     cvt_dir TH.InfixN = Hs.InfixN\n\n-----------------------------------------------------------\n\n\n-----------------------------------------------------------\n-- some useful things\n\noverloadedLit :: Lit -> Bool\n-- True for literals that Haskell treats as overloaded\noverloadedLit (IntegerL  _) = True\noverloadedLit (RationalL _) = True\noverloadedLit _             = False\n\n-- Checks that are performed when converting unboxed sum expressions and\n-- patterns alike.\nunboxedSumChecks :: TH.SumAlt -> TH.SumArity -> CvtM ()\nunboxedSumChecks alt arity\n    | alt > arity\n    = failWith $ text \"Sum alternative\"    <+> text (show alt)\n             <+> text \"exceeds its arity,\" <+> text (show arity)\n    | alt <= 0\n    = failWith $ vcat [ text \"Illegal sum alternative:\" <+> text (show alt)\n                      , nest 2 $ text \"Sum alternatives must start from 1\" ]\n    | arity < 2\n    = failWith $ vcat [ text \"Illegal sum arity:\" <+> text (show arity)\n                      , nest 2 $ text \"Sums must have an arity of at least 2\" ]\n    | otherwise\n    = return ()\n\n-- | If passed an empty list of 'TH.TyVarBndr's, this simply returns the\n-- third argument (an 'LHsType'). Otherwise, return an 'HsForAllTy'\n-- using the provided 'LHsQTyVars' and 'LHsType'.\nmkHsForAllTy :: [TH.TyVarBndr]\n             -- ^ The original Template Haskell type variable binders\n             -> SrcSpan\n             -- ^ The location of the returned 'LHsType' if it needs an\n             --   explicit forall\n             -> ForallVisFlag\n             -- ^ Whether this is @forall@ is visible (e.g., @forall a ->@)\n             --   or invisible (e.g., @forall a.@)\n             -> LHsQTyVars GhcPs\n             -- ^ The converted type variable binders\n             -> LHsType GhcPs\n             -- ^ The converted rho type\n             -> LHsType GhcPs\n             -- ^ The complete type, quantified with a forall if necessary\nmkHsForAllTy tvs loc fvf tvs' rho_ty\n  | null tvs  = rho_ty\n  | otherwise = cL loc $ HsForAllTy { hst_fvf = fvf\n                                    , hst_bndrs = hsQTvExplicit tvs'\n                                    , hst_xforall = noExt\n                                    , hst_body = rho_ty }\n\n-- | If passed an empty 'TH.Cxt', this simply returns the third argument\n-- (an 'LHsType'). Otherwise, return an 'HsQualTy' using the provided\n-- 'LHsContext' and 'LHsType'.\n\n-- It's important that we don't build an HsQualTy if the context is empty,\n-- as the pretty-printer for HsType _always_ prints contexts, even if\n-- they're empty. See Trac #13183.\nmkHsQualTy :: TH.Cxt\n           -- ^ The original Template Haskell context\n           -> SrcSpan\n           -- ^ The location of the returned 'LHsType' if it needs an\n           --   explicit context\n           -> LHsContext GhcPs\n           -- ^ The converted context\n           -> LHsType GhcPs\n           -- ^ The converted tau type\n           -> LHsType GhcPs\n           -- ^ The complete type, qualified with a context if necessary\nmkHsQualTy ctxt loc ctxt' ty\n  | null ctxt = ty\n  | otherwise = cL loc $ HsQualTy { hst_xqual = noExt\n                                  , hst_ctxt  = ctxt'\n                                  , hst_body  = ty }\n\n--------------------------------------------------------------------\n--      Turning Name back into RdrName\n--------------------------------------------------------------------\n\n-- variable names\nvNameL, cNameL, vcNameL, tNameL, tconNameL :: TH.Name -> CvtM (Located RdrName)\nvName,  cName,  vcName,  tName,  tconName  :: TH.Name -> CvtM RdrName\n\n-- Variable names\nvNameL n = wrapL (vName n)\nvName n = cvtName OccName.varName n\n\n-- Constructor function names; this is Haskell source, hence srcDataName\ncNameL n = wrapL (cName n)\ncName n = cvtName OccName.dataName n\n\n-- Variable *or* constructor names; check by looking at the first char\nvcNameL n = wrapL (vcName n)\nvcName n = if isVarName n then vName n else cName n\n\n-- Type variable names\ntNameL n = wrapL (tName n)\ntName n = cvtName OccName.tvName n\n\n-- Type Constructor names\ntconNameL n = wrapL (tconName n)\ntconName n = cvtName OccName.tcClsName n\n\nipName :: String -> CvtM HsIPName\nipName n\n  = do { unless (okVarOcc n) (failWith (badOcc OccName.varName n))\n       ; return (HsIPName (fsLit n)) }\n\ncvtName :: OccName.NameSpace -> TH.Name -> CvtM RdrName\ncvtName ctxt_ns (TH.Name occ flavour)\n  | not (okOcc ctxt_ns occ_str) = failWith (badOcc ctxt_ns occ_str)\n  | otherwise\n  = do { loc <- getL\n       ; let rdr_name = thRdrName loc ctxt_ns occ_str flavour\n       ; force rdr_name\n       ; return rdr_name }\n  where\n    occ_str = TH.occString occ\n\nokOcc :: OccName.NameSpace -> String -> Bool\nokOcc ns str\n  | OccName.isVarNameSpace ns     = okVarOcc str\n  | OccName.isDataConNameSpace ns = okConOcc str\n  | otherwise                     = okTcOcc  str\n\n-- Determine the name space of a name in a type\n--\nisVarName :: TH.Name -> Bool\nisVarName (TH.Name occ _)\n  = case TH.occString occ of\n      \"\"    -> False\n      (c:_) -> startsVarId c || startsVarSym c\n\nbadOcc :: OccName.NameSpace -> String -> SDoc\nbadOcc ctxt_ns occ\n  = text \"Illegal\" <+> pprNameSpace ctxt_ns\n        <+> text \"name:\" <+> quotes (text occ)\n\nthRdrName :: SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName\n-- This turns a TH Name into a RdrName; used for both binders and occurrences\n-- See Note [Binders in Template Haskell]\n-- The passed-in name space tells what the context is expecting;\n--      use it unless the TH name knows what name-space it comes\n--      from, in which case use the latter\n--\n-- We pass in a SrcSpan (gotten from the monad) because this function\n-- is used for *binders* and if we make an Exact Name we want it\n-- to have a binding site inside it.  (cf Trac #5434)\n--\n-- ToDo: we may generate silly RdrNames, by passing a name space\n--       that doesn't match the string, like VarName \":+\",\n--       which will give confusing error messages later\n--\n-- The strict applications ensure that any buried exceptions get forced\nthRdrName loc ctxt_ns th_occ th_name\n  = case th_name of\n     TH.NameG th_ns pkg mod -> thOrigRdrName th_occ th_ns pkg mod\n     TH.NameQ mod  -> (mkRdrQual  $! mk_mod mod) $! occ\n     TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq uniq) $! occ) loc)\n     TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq uniq) $! occ) loc)\n     TH.NameS | Just name <- isBuiltInOcc_maybe occ -> nameRdrName $! name\n              | otherwise                           -> mkRdrUnqual $! occ\n              -- We check for built-in syntax here, because the TH\n              -- user might have written a (NameS \"(,,)\"), for example\n  where\n    occ :: OccName.OccName\n    occ = mk_occ ctxt_ns th_occ\n\n-- Return an unqualified exact RdrName if we're dealing with built-in syntax.\n-- See Trac #13776.\nthOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName\nthOrigRdrName occ th_ns pkg mod =\n  let occ' = mk_occ (mk_ghc_ns th_ns) occ\n  in case isBuiltInOcc_maybe occ' of\n       Just name -> nameRdrName name\n       Nothing   -> (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! occ'\n\nthRdrNameGuesses :: TH.Name -> [RdrName]\nthRdrNameGuesses (TH.Name occ flavour)\n  -- This special case for NameG ensures that we don't generate duplicates in the output list\n  | TH.NameG th_ns pkg mod <- flavour = [ thOrigRdrName occ_str th_ns pkg mod]\n  | otherwise                         = [ thRdrName noSrcSpan gns occ_str flavour\n                                        | gns <- guessed_nss]\n  where\n    -- guessed_ns are the name spaces guessed from looking at the TH name\n    guessed_nss\n      | isLexCon (mkFastString occ_str) = [OccName.tcName,  OccName.dataName]\n      | otherwise                       = [OccName.varName, OccName.tvName]\n    occ_str = TH.occString occ\n\n-- The packing and unpacking is rather turgid :-(\nmk_occ :: OccName.NameSpace -> String -> OccName.OccName\nmk_occ ns occ = OccName.mkOccName ns occ\n\nmk_ghc_ns :: TH.NameSpace -> OccName.NameSpace\nmk_ghc_ns TH.DataName  = OccName.dataName\nmk_ghc_ns TH.TcClsName = OccName.tcClsName\nmk_ghc_ns TH.VarName   = OccName.varName\n\nmk_mod :: TH.ModName -> ModuleName\nmk_mod mod = mkModuleName (TH.modString mod)\n\nmk_pkg :: TH.PkgName -> UnitId\nmk_pkg pkg = stringToUnitId (TH.pkgString pkg)\n\nmk_uniq :: Int -> Unique\nmk_uniq u = mkUniqueGrimily u\n\n{-\nNote [Binders in Template Haskell]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this TH term construction:\n  do { x1 <- TH.newName \"x\"   -- newName :: String -> Q TH.Name\n     ; x2 <- TH.newName \"x\"   -- Builds a NameU\n     ; x3 <- TH.newName \"x\"\n\n     ; let x = mkName \"x\"     -- mkName :: String -> TH.Name\n                              -- Builds a NameS\n\n     ; return (LamE (..pattern [x1,x2]..) $\n               LamE (VarPat x3) $\n               ..tuple (x1,x2,x3,x)) }\n\nIt represents the term   \\[x1,x2]. \\x3. (x1,x2,x3,x)\n\na) We don't want to complain about \"x\" being bound twice in\n   the pattern [x1,x2]\nb) We don't want x3 to shadow the x1,x2\nc) We *do* want 'x' (dynamically bound with mkName) to bind\n   to the innermost binding of \"x\", namely x3.\nd) When pretty printing, we want to print a unique with x1,x2\n   etc, else they'll all print as \"x\" which isn't very helpful\n\nWhen we convert all this to HsSyn, the TH.Names are converted with\nthRdrName.  To achieve (b) we want the binders to be Exact RdrNames.\nAchieving (a) is a bit awkward, because\n   - We must check for duplicate and shadowed names on Names,\n     not RdrNames, *after* renaming.\n     See Note [Collect binders only after renaming] in HsUtils\n\n   - But to achieve (a) we must distinguish between the Exact\n     RdrNames arising from TH and the Unqual RdrNames that would\n     come from a user writing \\[x,x] -> blah\n\nSo in Convert.thRdrName we translate\n   TH Name                          RdrName\n   --------------------------------------------------------\n   NameU (arising from newName) --> Exact (Name{ System })\n   NameS (arising from mkName)  --> Unqual\n\nNotice that the NameUs generate *System* Names.  Then, when\nfiguring out shadowing and duplicates, we can filter out\nSystem Names.\n\nThis use of System Names fits with other uses of System Names, eg for\ntemporary variables \"a\". Since there are lots of things called \"a\" we\nusually want to print the name with the unique, and that is indeed\nthe way System Names are printed.\n\nThere's a small complication of course; see Note [Looking up Exact\nRdrNames] in RnEnv.\n-}\n\n{-\nNote [Pattern synonym type signatures and Template Haskell]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIn general, the type signature of a pattern synonym\n\n  pattern P x1 x2 .. xn = <some-pattern>\n\nis of the form\n\n   forall univs. reqs => forall exis. provs => t1 -> t2 -> ... -> tn -> t\n\nwith the following parts:\n\n   1) the (possibly empty lists of) universally quantified type\n      variables `univs` and required constraints `reqs` on them.\n   2) the (possibly empty lists of) existentially quantified type\n      variables `exis` and the provided constraints `provs` on them.\n   3) the types `t1`, `t2`, .., `tn` of the pattern synonym's arguments x1,\n      x2, .., xn, respectively\n   4) the type `t` of <some-pattern>, mentioning only universals from `univs`.\n\nDue to the two forall quantifiers and constraint contexts (either of\nwhich might be empty), pattern synonym type signatures are treated\nspecially in `deSugar/DsMeta.hs`, `hsSyn/Convert.hs`, and\n`typecheck/TcSplice.hs`:\n\n   (a) When desugaring a pattern synonym from HsSyn to TH.Dec in\n       `deSugar/DsMeta.hs`, we represent its *full* type signature in TH, i.e.:\n\n           ForallT univs reqs (ForallT exis provs ty)\n              (where ty is the AST representation of t1 -> t2 -> ... -> tn -> t)\n\n   (b) When converting pattern synonyms from TH.Dec to HsSyn in\n       `hsSyn/Convert.hs`, we convert their TH type signatures back to an\n       appropriate Haskell pattern synonym type of the form\n\n         forall univs. reqs => forall exis. provs => t1 -> t2 -> ... -> tn -> t\n\n       where initial empty `univs` type variables or an empty `reqs`\n       constraint context are represented *explicitly* as `() =>`.\n\n   (c) When reifying a pattern synonym in `typecheck/TcSplice.hs`, we always\n       return its *full* type, i.e.:\n\n           ForallT univs reqs (ForallT exis provs ty)\n              (where ty is the AST representation of t1 -> t2 -> ... -> tn -> t)\n\nThe key point is to always represent a pattern synonym's *full* type\nin cases (a) and (c) to make it clear which of the two forall\nquantifiers and/or constraint contexts are specified, and which are\nnot. See GHC's user's guide on pattern synonyms for more information\nabout pattern synonym type signatures.\n\n-}\n", "num_lines": 1986}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[HsBinds]{Abstract syntax: top-level bindings and signatures}\n\nDatatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule HsBinds where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,\n                               MatchGroup, pprFunBind,\n                               GRHSs, pprPatBind )\nimport {-# SOURCE #-} HsPat  ( LPat )\n\nimport HsExtension\nimport HsTypes\nimport PprCore ()\nimport CoreSyn\nimport TcEvidence\nimport Type\nimport NameSet\nimport BasicTypes\nimport Outputable\nimport SrcLoc\nimport Var\nimport Bag\nimport FastString\nimport BooleanFormula (LBooleanFormula)\nimport DynFlags\n\nimport Data.Data hiding ( Fixity )\nimport Data.List hiding ( foldr )\nimport Data.Ord\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Bindings: @BindGroup@}\n*                                                                      *\n************************************************************************\n\nGlobal bindings (where clauses)\n-}\n\n-- During renaming, we need bindings where the left-hand sides\n-- have been renamed but the right-hand sides have not.\n-- the ...LR datatypes are parametrized by two id types,\n-- one for the left and one for the right.\n-- Other than during renaming, these will be the same.\n\n-- | Haskell Local Bindings\ntype HsLocalBinds id = HsLocalBindsLR id id\n\n-- | Located Haskell local bindings\ntype LHsLocalBinds id = Located (HsLocalBinds id)\n\n-- | Haskell Local Bindings with separate Left and Right identifier types\n--\n-- Bindings in a 'let' expression\n-- or a 'where' clause\ndata HsLocalBindsLR idL idR\n  = HsValBinds\n        (XHsValBinds idL idR)\n        (HsValBindsLR idL idR)\n      -- ^ Haskell Value Bindings\n\n         -- There should be no pattern synonyms in the HsValBindsLR\n         -- These are *local* (not top level) bindings\n         -- The parser accepts them, however, leaving the\n         -- renamer to report them\n\n  | HsIPBinds\n        (XHsIPBinds idL idR)\n        (HsIPBinds idR)\n      -- ^ Haskell Implicit Parameter Bindings\n\n  | EmptyLocalBinds (XEmptyLocalBinds idL idR)\n      -- ^ Empty Local Bindings\n\n  | XHsLocalBindsLR\n        (XXHsLocalBindsLR idL idR)\n\ntype instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt\n\ntype LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)\n\n\n-- | Haskell Value Bindings\ntype HsValBinds id = HsValBindsLR id id\n\n-- | Haskell Value bindings with separate Left and Right identifier types\n-- (not implicit parameters)\n-- Used for both top level and nested bindings\n-- May contain pattern synonym bindings\ndata HsValBindsLR idL idR\n  = -- | Value Bindings In\n    --\n    -- Before renaming RHS; idR is always RdrName\n    -- Not dependency analysed\n    -- Recursive by default\n    ValBinds\n        (XValBinds idL idR)\n        (LHsBindsLR idL idR) [LSig idR]\n\n    -- | Value Bindings Out\n    --\n    -- After renaming RHS; idR can be Name or Id Dependency analysed,\n    -- later bindings in the list may depend on earlier ones.\n  | XValBindsLR\n      (XXValBindsLR idL idR)\n\n-- ---------------------------------------------------------------------\n-- Deal with ValBindsOut\n\n-- TODO: make this the only type for ValBinds\ndata NHsValBindsLR idL\n  = NValBinds\n      [(RecFlag, LHsBinds idL)]\n      [LSig GhcRn]\n\ntype instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XXValBindsLR (GhcPass pL) (GhcPass pR)\n            = NHsValBindsLR (GhcPass pL)\n\n-- ---------------------------------------------------------------------\n\n-- | Located Haskell Binding\ntype LHsBind  id = LHsBindLR  id id\n\n-- | Located Haskell Bindings\ntype LHsBinds id = LHsBindsLR id id\n\n-- | Haskell Binding\ntype HsBind   id = HsBindLR   id id\n\n-- | Located Haskell Bindings with separate Left and Right identifier types\ntype LHsBindsLR idL idR = Bag (LHsBindLR idL idR)\n\n-- | Located Haskell Binding with separate Left and Right identifier types\ntype LHsBindLR  idL idR = Located (HsBindLR idL idR)\n\n{- Note [FunBind vs PatBind]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~\nThe distinction between FunBind and PatBind is a bit subtle. FunBind covers\npatterns which resemble function bindings and simple variable bindings.\n\n    f x = e\n    f !x = e\n    f = e\n    !x = e          -- FunRhs has SrcStrict\n    x `f` y = e     -- FunRhs has Infix\n\nThe actual patterns and RHSs of a FunBind are encoding in fun_matches.\nThe m_ctxt field of each Match in fun_matches will be FunRhs and carries\ntwo bits of information about the match,\n\n  * The mc_fixity field on each Match describes the fixity of the\n    function binder in that match.  E.g. this is legal:\n         f True False  = e1\n         True `f` True = e2\n\n  * The mc_strictness field is used /only/ for nullary FunBinds: ones\n    with one Match, which has no pats. For these, it describes whether\n    the match is decorated with a bang (e.g. `!x = e`).\n\nBy contrast, PatBind represents data constructor patterns, as well as a few\nother interesting cases. Namely,\n\n    Just x = e\n    (x) = e\n    x :: Ty = e\n-}\n\n-- | Haskell Binding with separate Left and Right id's\ndata HsBindLR idL idR\n  = -- | Function-like Binding\n    --\n    -- FunBind is used for both functions     @f x = e@\n    -- and variables                          @f = \\x -> e@\n    -- and strict variables                   @!x = x + 1@\n    --\n    -- Reason 1: Special case for type inference: see 'TcBinds.tcMonoBinds'.\n    --\n    -- Reason 2: Instance decls can only have FunBinds, which is convenient.\n    --           If you change this, you'll need to change e.g. rnMethodBinds\n    --\n    -- But note that the form                 @f :: a->a = ...@\n    -- parses as a pattern binding, just like\n    --                                        @(f :: a -> a) = ... @\n    --\n    -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their\n    -- 'MatchContext'. See Note [FunBind vs PatBind] for\n    -- details about the relationship between FunBind and PatBind.\n    --\n    --  'ApiAnnotation.AnnKeywordId's\n    --\n    --  - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches\n    --\n    --  - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',\n    --    'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n    FunBind {\n\n        fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains\n                                --  the locally-bound\n                                -- free variables of this defn.\n                                -- See Note [Bind free vars]\n\n        fun_id :: Located (IdP idL), -- Note [fun_id in Match] in HsExpr\n\n        fun_matches :: MatchGroup idR (LHsExpr idR),  -- ^ The payload\n\n        fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of\n                                -- the Id.  Example:\n                                --\n                                -- @\n                                --      f :: Int -> forall a. a -> a\n                                --      f x y = y\n                                -- @\n                                --\n                                -- Then the MatchGroup will have type (Int -> a' -> a')\n                                -- (with a free type variable a').  The coercion will take\n                                -- a CoreExpr of this type and convert it to a CoreExpr of\n                                -- type         Int -> forall a'. a' -> a'\n                                -- Notice that the coercion captures the free a'.\n\n        fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any\n    }\n\n  -- | Pattern Binding\n  --\n  -- The pattern is never a simple variable;\n  -- That case is done by FunBind.\n  -- See Note [FunBind vs PatBind] for details about the\n  -- relationship between FunBind and PatBind.\n\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',\n  --       'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',\n  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | PatBind {\n        pat_ext    :: XPatBind idL idR, -- ^ See Note [Bind free vars]\n        pat_lhs    :: LPat idL,\n        pat_rhs    :: GRHSs idR (LHsExpr idR),\n        pat_ticks  :: ([Tickish Id], [[Tickish Id]])\n               -- ^ Ticks to put on the rhs, if any, and ticks to put on\n               -- the bound variables.\n    }\n\n  -- | Variable Binding\n  --\n  -- Dictionary binding and suchlike.\n  -- All VarBinds are introduced by the type checker\n  | VarBind {\n        var_ext    :: XVarBind idL idR,\n        var_id     :: IdP idL,\n        var_rhs    :: LHsExpr idR,   -- ^ Located only for consistency\n        var_inline :: Bool           -- ^ True <=> inline this binding regardless\n                                     -- (used for implication constraints only)\n    }\n\n  -- | Abstraction Bindings\n  | AbsBinds {                      -- Binds abstraction; TRANSLATION\n        abs_ext     :: XAbsBinds idL idR,\n        abs_tvs     :: [TyVar],\n        abs_ev_vars :: [EvVar],  -- ^ Includes equality constraints\n\n       -- | AbsBinds only gets used when idL = idR after renaming,\n       -- but these need to be idL's for the collect... code in HsUtil\n       -- to have the right type\n        abs_exports :: [ABExport idL],\n\n        -- | Evidence bindings\n        -- Why a list? See TcInstDcls\n        -- Note [Typechecking plan for instance declarations]\n        abs_ev_binds :: [TcEvBinds],\n\n        -- | Typechecked user bindings\n        abs_binds    :: LHsBinds idL,\n\n        abs_sig :: Bool  -- See Note [The abs_sig field of AbsBinds]\n    }\n\n  -- | Patterns Synonym Binding\n  | PatSynBind\n        (XPatSynBind idL idR)\n        (PatSynBind idL idR)\n        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',\n        --          'ApiAnnotation.AnnLarrow','ApiAnnotation.AnnEqual',\n        --          'ApiAnnotation.AnnWhere'\n        --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | XHsBindsLR (XXHsBindsLR idL idR)\n\ndata NPatBindTc = NPatBindTc {\n     pat_fvs :: NameSet, -- ^ Free variables\n     pat_rhs_ty :: Type  -- ^ Type of the GRHSs\n     } deriving Data\n\ntype instance XFunBind    (GhcPass pL) GhcPs = NoExt\ntype instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables\ntype instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables\n\ntype instance XPatBind    GhcPs (GhcPass pR) = NoExt\ntype instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables\ntype instance XPatBind    GhcTc (GhcPass pR) = NPatBindTc\n\ntype instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt\n\n\n        -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]\n        --\n        -- Creates bindings for (polymorphic, overloaded) poly_f\n        -- in terms of monomorphic, non-overloaded mono_f\n        --\n        -- Invariants:\n        --      1. 'binds' binds mono_f\n        --      2. ftvs is a subset of tvs\n        --      3. ftvs includes all tyvars free in ds\n        --\n        -- See Note [AbsBinds]\n\n-- | Abtraction Bindings Export\ndata ABExport p\n  = ABE { abe_ext       :: XABE p\n        , abe_poly      :: IdP p -- ^ Any INLINE pragma is attached to this Id\n        , abe_mono      :: IdP p\n        , abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]\n             -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly\n        , abe_prags     :: TcSpecPrags  -- ^ SPECIALISE pragmas\n        }\n   | XABExport (XXABExport p)\n\ntype instance XABE       (GhcPass p) = NoExt\ntype instance XXABExport (GhcPass p) = NoExt\n\n\n-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',\n--             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'\n--             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,\n--             'ApiAnnotation.AnnClose' @'}'@,\n\n-- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Pattern Synonym binding\ndata PatSynBind idL idR\n  = PSB { psb_ext  :: XPSB idL idR,            -- ^ Post renaming, FVs.\n                                               -- See Note [Bind free vars]\n          psb_id   :: Located (IdP idL),       -- ^ Name of the pattern synonym\n          psb_args :: HsPatSynDetails (Located (IdP idR)),\n                                               -- ^ Formal parameter names\n          psb_def  :: LPat idR,                -- ^ Right-hand side\n          psb_dir  :: HsPatSynDir idR          -- ^ Directionality\n     }\n   | XPatSynBind (XXPatSynBind idL idR)\n\ntype instance XPSB         (GhcPass idL) GhcPs = NoExt\ntype instance XPSB         (GhcPass idL) GhcRn = NameSet\ntype instance XPSB         (GhcPass idL) GhcTc = NameSet\n\ntype instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt\n\n{-\nNote [AbsBinds]\n~~~~~~~~~~~~~~~\nThe AbsBinds constructor is used in the output of the type checker, to\nrecord *typechecked* and *generalised* bindings.  Specifically\n\n         AbsBinds { abs_tvs      = tvs\n                  , abs_ev_vars  = [d1,d2]\n                  , abs_exports  = [ABE { abe_poly = fp, abe_mono = fm\n                                        , abe_wrap = fwrap }\n                                    ABE { slly for g } ]\n                  , abs_ev_binds = DBINDS\n                  , abs_binds    = BIND[fm,gm] }\n\nwhere 'BIND' binds the monomorphic Ids 'fm' and 'gm', means\n\n        fp = fwrap [/\\ tvs. \\d1 d2. letrec { DBINDS        ]\n                   [                       ; BIND[fm,gm] } ]\n                   [                 in fm                 ]\n\n        gp = ...same again, with gm instead of fm\n\nThe 'fwrap' is an impedence-matcher that typically does nothing; see\nNote [ABExport wrapper].\n\nThis is a pretty bad translation, because it duplicates all the bindings.\nSo the desugarer tries to do a better job:\n\n        fp = /\\ [a,b] -> \\ [d1,d2] -> case tp [a,b] [d1,d2] of\n                                        (fm,gm) -> fm\n        ..ditto for gp..\n\n        tp = /\\ [a,b] -> \\ [d1,d2] -> letrec { DBINDS; BIND }\n                                      in (fm,gm)\n\nIn general:\n\n  * abs_tvs are the type variables over which the binding group is\n    generalised\n  * abs_ev_var are the evidence variables (usually dictionaries)\n    over which the binding group is generalised\n  * abs_binds are the monomorphic bindings\n  * abs_ex_binds are the evidence bindings that wrap the abs_binds\n  * abs_exports connects the monomorphic Ids bound by abs_binds\n    with the polymorphic Ids bound by the AbsBinds itself.\n\nFor example, consider a module M, with this top-level binding, where\nthere is no type signature for M.reverse,\n    M.reverse []     = []\n    M.reverse (x:xs) = M.reverse xs ++ [x]\n\nIn Hindley-Milner, a recursive binding is typechecked with the\n*recursive* uses being *monomorphic*.  So after typechecking *and*\ndesugaring we will get something like this\n\n    M.reverse :: forall a. [a] -> [a]\n      = /\\a. letrec\n                reverse :: [a] -> [a] = \\xs -> case xs of\n                                                []     -> []\n                                                (x:xs) -> reverse xs ++ [x]\n             in reverse\n\nNotice that 'M.reverse' is polymorphic as expected, but there is a local\ndefinition for plain 'reverse' which is *monomorphic*.  The type variable\n'a' scopes over the entire letrec.\n\nThat's after desugaring.  What about after type checking but before\ndesugaring?  That's where AbsBinds comes in.  It looks like this:\n\n   AbsBinds { abs_tvs     = [a]\n            , abs_ev_vars = []\n            , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],\n                                 , abe_mono = reverse :: [a] -> [a]}]\n            , abs_ev_binds = {}\n            , abs_binds = { reverse :: [a] -> [a]\n                               = \\xs -> case xs of\n                                            []     -> []\n                                            (x:xs) -> reverse xs ++ [x] } }\n\nHere,\n\n  * abs_tvs says what type variables are abstracted over the binding\n    group, just 'a' in this case.\n  * abs_binds is the *monomorphic* bindings of the group\n  * abs_exports describes how to get the polymorphic Id 'M.reverse'\n    from the monomorphic one 'reverse'\n\nNotice that the *original* function (the polymorphic one you thought\nyou were defining) appears in the abe_poly field of the\nabs_exports. The bindings in abs_binds are for fresh, local, Ids with\na *monomorphic* Id.\n\nIf there is a group of mutually recursive (see Note [Polymorphic\nrecursion]) functions without type signatures, we get one AbsBinds\nwith the monomorphic versions of the bindings in abs_binds, and one\nelement of abe_exports for each variable bound in the mutually\nrecursive group.  This is true even for pattern bindings.  Example:\n        (f,g) = (\\x -> x, f)\nAfter type checking we get\n   AbsBinds { abs_tvs     = [a]\n            , abs_exports = [ ABE { abe_poly = M.f :: forall a. a -> a\n                                  , abe_mono = f :: a -> a }\n                            , ABE { abe_poly = M.g :: forall a. a -> a\n                                  , abe_mono = g :: a -> a }]\n            , abs_binds = { (f,g) = (\\x -> x, f) }\n\nNote [Polymorphic recursion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   Rec { f x = ...(g ef)...\n\n       ; g :: forall a. [a] -> [a]\n       ; g y = ...(f eg)...  }\n\nThese bindings /are/ mutually recursive (f calls g, and g calls f).\nBut we can use the type signature for g to break the recursion,\nlike this:\n\n  1. Add g :: forall a. [a] -> [a] to the type environment\n\n  2. Typecheck the definition of f, all by itself,\n     including generalising it to find its most general\n     type, say f :: forall b. b -> b -> [b]\n\n  3. Extend the type environment with that type for f\n\n  4. Typecheck the definition of g, all by itself,\n     checking that it has the type claimed by its signature\n\nSteps 2 and 4 each generate a separate AbsBinds, so we end\nup with\n   Rec { AbsBinds { ...for f ... }\n       ; AbsBinds { ...for g ... } }\n\nThis approach allows both f and to call each other\npolymorphically, even though only g has a signature.\n\nWe get an AbsBinds that encompasses multiple source-program\nbindings only when\n * Each binding in the group has at least one binder that\n   lacks a user type signature\n * The group forms a strongly connected component\n\n\nNote [The abs_sig field of AbsBinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe abs_sig field supports a couple of special cases for bindings.\nConsider\n\n  x :: Num a => (# a, a #)\n  x = (# 3, 4 #)\n\nThe general desugaring for AbsBinds would give\n\n  x = /\\a. \\ ($dNum :: Num a) ->\n      letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in\n      xm\n\nBut that has an illegal let-binding for an unboxed tuple.  In this\ncase we'd prefer to generate the (more direct)\n\n  x = /\\ a. \\ ($dNum :: Num a) ->\n     (# fromInteger $dNum 3, fromInteger $dNum 4 #)\n\nA similar thing happens with representation-polymorphic defns\n(Trac #11405):\n\n  undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a\n  undef = error \"undef\"\n\nAgain, the vanilla desugaring gives a local let-binding for a\nrepresentation-polymorphic (undefm :: a), which is illegal.  But\nagain we can desugar without a let:\n\n  undef = /\\ a. \\ (d:HasCallStack) -> error a d \"undef\"\n\nThe abs_sig field supports this direct desugaring, with no local\nlet-bining.  When abs_sig = True\n\n * the abs_binds is single FunBind\n\n * the abs_exports is a singleton\n\n * we have a complete type sig for binder\n   and hence the abs_binds is non-recursive\n   (it binds the mono_id but refers to the poly_id\n\nThese properties are exploited in DsBinds.dsAbsBinds to\ngenerate code without a let-binding.\n\nNote [ABExport wrapper]\n~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   (f,g) = (\\x.x, \\y.y)\nThis ultimately desugars to something like this:\n   tup :: forall a b. (a->a, b->b)\n   tup = /\\a b. (\\x:a.x, \\y:b.y)\n   f :: forall a. a -> a\n   f = /\\a. case tup a Any of\n               (fm::a->a,gm:Any->Any) -> fm\n   ...similarly for g...\n\nThe abe_wrap field deals with impedance-matching between\n    (/\\a b. case tup a b of { (f,g) -> f })\nand the thing we really want, which may have fewer type\nvariables.  The action happens in TcBinds.mkExport.\n\nNote [Bind free vars]\n~~~~~~~~~~~~~~~~~~~~~\nThe bind_fvs field of FunBind and PatBind records the free variables\nof the definition.  It is used for the following purposes\n\na) Dependency analysis prior to type checking\n    (see TcBinds.tc_group)\n\nb) Deciding whether we can do generalisation of the binding\n    (see TcBinds.decideGeneralisationPlan)\n\nc) Deciding whether the binding can be used in static forms\n    (see TcExpr.checkClosedInStaticForm for the HsStatic case and\n     TcBinds.isClosedBndrGroup).\n\nSpecifically,\n\n  * bind_fvs includes all free vars that are defined in this module\n    (including top-level things and lexically scoped type variables)\n\n  * bind_fvs excludes imported vars; this is just to keep the set smaller\n\n  * Before renaming, and after typechecking, the field is unused;\n    it's just an error thunk\n-}\n\ninstance (idL ~ GhcPass pl, idR ~ GhcPass pr,\n          OutputableBndrId idL, OutputableBndrId idR)\n        => Outputable (HsLocalBindsLR idL idR) where\n  ppr (HsValBinds _ bs)   = ppr bs\n  ppr (HsIPBinds _ bs)    = ppr bs\n  ppr (EmptyLocalBinds _) = empty\n  ppr (XHsLocalBindsLR x) = ppr x\n\ninstance (idL ~ GhcPass pl, idR ~ GhcPass pr,\n          OutputableBndrId idL, OutputableBndrId idR)\n        => Outputable (HsValBindsLR idL idR) where\n  ppr (ValBinds _ binds sigs)\n   = pprDeclList (pprLHsBindsForUser binds sigs)\n\n  ppr (XValBindsLR (NValBinds sccs sigs))\n    = getPprStyle $ \\ sty ->\n      if debugStyle sty then    -- Print with sccs showing\n        vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)\n     else\n        pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)\n   where\n     ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds\n     pp_rec Recursive    = text \"rec\"\n     pp_rec NonRecursive = text \"nonrec\"\n\npprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))\n            => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc\npprLHsBinds binds\n  | isEmptyLHsBinds binds = empty\n  | otherwise = pprDeclList (map ppr (bagToList binds))\n\npprLHsBindsForUser :: (OutputableBndrId (GhcPass idL),\n                       OutputableBndrId (GhcPass idR),\n                       OutputableBndrId (GhcPass id2))\n     => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]\n--  pprLHsBindsForUser is different to pprLHsBinds because\n--  a) No braces: 'let' and 'where' include a list of HsBindGroups\n--     and we don't want several groups of bindings each\n--     with braces around\n--  b) Sort by location before printing\n--  c) Include signatures\npprLHsBindsForUser binds sigs\n  = map snd (sort_by_loc decls)\n  where\n\n    decls :: [(SrcSpan, SDoc)]\n    decls = [(loc, ppr sig)  | L loc sig <- sigs] ++\n            [(loc, ppr bind) | L loc bind <- bagToList binds]\n\n    sort_by_loc decls = sortBy (comparing fst) decls\n\npprDeclList :: [SDoc] -> SDoc   -- Braces with a space\n-- Print a bunch of declarations\n-- One could choose  { d1; d2; ... }, using 'sep'\n-- or      d1\n--         d2\n--         ..\n--    using vcat\n-- At the moment we chose the latter\n-- Also we do the 'pprDeeperList' thing.\npprDeclList ds = pprDeeperList vcat ds\n\n------------\nemptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)\nemptyLocalBinds = EmptyLocalBinds noExt\n\n-- AZ:These functions do not seem to be used at all?\nisEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool\nisEmptyLocalBindsTc (HsValBinds _ ds)   = isEmptyValBinds ds\nisEmptyLocalBindsTc (HsIPBinds _ ds)    = isEmptyIPBindsTc ds\nisEmptyLocalBindsTc (EmptyLocalBinds _) = True\nisEmptyLocalBindsTc (XHsLocalBindsLR _) = True\n\nisEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool\nisEmptyLocalBindsPR (HsValBinds _ ds)   = isEmptyValBinds ds\nisEmptyLocalBindsPR (HsIPBinds _ ds)    = isEmptyIPBindsPR ds\nisEmptyLocalBindsPR (EmptyLocalBinds _) = True\nisEmptyLocalBindsPR (XHsLocalBindsLR _) = True\n\neqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool\neqEmptyLocalBinds (EmptyLocalBinds _) = True\neqEmptyLocalBinds _                   = False\n\nisEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool\nisEmptyValBinds (ValBinds _ ds sigs)  = isEmptyLHsBinds ds && null sigs\nisEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs\n\nemptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)\nemptyValBindsIn  = ValBinds noExt emptyBag []\nemptyValBindsOut = XValBindsLR (NValBinds [] [])\n\nemptyLHsBinds :: LHsBindsLR idL idR\nemptyLHsBinds = emptyBag\n\nisEmptyLHsBinds :: LHsBindsLR idL idR -> Bool\nisEmptyLHsBinds = isEmptyBag\n\n------------\nplusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)\n               -> HsValBinds(GhcPass a)\nplusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)\n  = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2)\nplusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))\n               (XValBindsLR (NValBinds ds2 sigs2))\n  = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))\nplusHsValBinds _ _\n  = panic \"HsBinds.plusHsValBinds\"\n\ninstance (idL ~ GhcPass pl, idR ~ GhcPass pr,\n          OutputableBndrId idL, OutputableBndrId idR)\n         => Outputable (HsBindLR idL idR) where\n    ppr mbind = ppr_monobind mbind\n\nppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))\n             => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc\n\nppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })\n  = pprPatBind pat grhss\nppr_monobind (VarBind { var_id = var, var_rhs = rhs })\n  = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]\nppr_monobind (FunBind { fun_id = fun,\n                        fun_co_fn = wrap,\n                        fun_matches = matches,\n                        fun_tick = ticks })\n  = pprTicks empty (if null ticks then empty\n                    else text \"-- ticks = \" <> ppr ticks)\n    $$  whenPprDebug (pprBndr LetBind (unLoc fun))\n    $$  pprFunBind  matches\n    $$  whenPprDebug (ppr wrap)\nppr_monobind (PatSynBind _ psb) = ppr psb\nppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars\n                       , abs_exports = exports, abs_binds = val_binds\n                       , abs_ev_binds = ev_binds })\n  = sdocWithDynFlags $ \\ dflags ->\n    if gopt Opt_PrintTypecheckerElaboration dflags then\n      -- Show extra information (bug number: #10662)\n      hang (text \"AbsBinds\" <+> brackets (interpp'SP tyvars)\n                                    <+> brackets (interpp'SP dictvars))\n         2 $ braces $ vcat\n      [ text \"Exports:\" <+>\n          brackets (sep (punctuate comma (map ppr exports)))\n      , text \"Exported types:\" <+>\n          vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]\n      , text \"Binds:\" <+> pprLHsBinds val_binds\n      , text \"Evidence:\" <+> ppr ev_binds ]\n    else\n      pprLHsBinds val_binds\nppr_monobind (XHsBindsLR x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where\n  ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })\n    = vcat [ ppr gbl <+> text \"<=\" <+> ppr lcl\n           , nest 2 (pprTcSpecPrags prags)\n           , nest 2 (text \"wrap:\" <+> ppr wrap)]\n  ppr (XABExport x) = ppr x\n\ninstance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR,\n         Outputable (XXPatSynBind idL idR))\n          => Outputable (PatSynBind idL idR) where\n  ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,\n            psb_dir = dir })\n      = ppr_lhs <+> ppr_rhs\n    where\n      ppr_lhs = text \"pattern\" <+> ppr_details\n      ppr_simple syntax = syntax <+> ppr pat\n\n      ppr_details = case details of\n          InfixCon v1 v2 -> hsep [ppr v1, pprInfixOcc psyn, ppr v2]\n          PrefixCon vs   -> hsep (pprPrefixOcc psyn : map ppr vs)\n          RecCon vs      -> pprPrefixOcc psyn\n                            <> braces (sep (punctuate comma (map ppr vs)))\n\n      ppr_rhs = case dir of\n          Unidirectional           -> ppr_simple (text \"<-\")\n          ImplicitBidirectional    -> ppr_simple equals\n          ExplicitBidirectional mg -> ppr_simple (text \"<-\") <+> ptext (sLit \"where\") $$\n                                      (nest 2 $ pprFunBind mg)\n  ppr (XPatSynBind x) = ppr x\n\npprTicks :: SDoc -> SDoc -> SDoc\n-- Print stuff about ticks only when -dppr-debug is on, to avoid\n-- them appearing in error messages (from the desugarer); see Trac # 3263\n-- Also print ticks in dumpStyle, so that -ddump-hpc actually does\n-- something useful.\npprTicks pp_no_debug pp_when_debug\n  = getPprStyle (\\ sty -> if debugStyle sty || dumpStyle sty\n                             then pp_when_debug\n                             else pp_no_debug)\n\n{-\n************************************************************************\n*                                                                      *\n                Implicit parameter bindings\n*                                                                      *\n************************************************************************\n-}\n\n-- | Haskell Implicit Parameter Bindings\ndata HsIPBinds id\n  = IPBinds\n        (XIPBinds id)\n        [LIPBind id]\n        -- TcEvBinds       -- Only in typechecker output; binds\n        --                 -- uses of the implicit parameters\n  | XHsIPBinds (XXHsIPBinds id)\n\ntype instance XIPBinds       GhcPs = NoExt\ntype instance XIPBinds       GhcRn = NoExt\ntype instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the\n                                               -- implicit parameters\n\n\ntype instance XXHsIPBinds    (GhcPass p) = NoExt\n\nisEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool\nisEmptyIPBindsPR (IPBinds _ is) = null is\nisEmptyIPBindsPR (XHsIPBinds _) = True\n\nisEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool\nisEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds\nisEmptyIPBindsTc (XHsIPBinds _) = True\n\n-- | Located Implicit Parameter Binding\ntype LIPBind id = Located (IPBind id)\n-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a\n--   list\n\n-- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Implicit parameter bindings.\n--\n-- These bindings start off as (Left \"x\") in the parser and stay\n-- that way until after type-checking when they are replaced with\n-- (Right d), where \"d\" is the name of the dictionary holding the\n-- evidence for the implicit parameter.\n--\n-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata IPBind id\n  = IPBind\n        (XCIPBind id)\n        (Either (Located HsIPName) (IdP id))\n        (LHsExpr id)\n  | XIPBind (XXIPBind id)\n\ntype instance XCIPBind    (GhcPass p) = NoExt\ntype instance XXIPBind    (GhcPass p) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (HsIPBinds p) where\n  ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs)\n                        $$ whenPprDebug (ppr ds)\n  ppr (XHsIPBinds x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where\n  ppr (IPBind _ lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)\n    where name = case lr of\n                   Left (L _ ip) -> pprBndr LetBind ip\n                   Right     id  -> pprBndr LetBind id\n  ppr (XIPBind x) = ppr x\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{@Sig@: type signatures and value-modifying user pragmas}\n*                                                                      *\n************************************************************************\n\nIt is convenient to lump ``value-modifying'' user-pragmas (e.g.,\n``specialise this function to these four types...'') in with type\nsignatures.  Then all the machinery to move them into place, etc.,\nserves for both.\n-}\n\n-- | Located Signature\ntype LSig pass = Located (Sig pass)\n\n-- | Signatures and pragmas\ndata Sig pass\n  =   -- | An ordinary type signature\n      --\n      -- > f :: Num a => a -> a\n      --\n      -- After renaming, this list of Names contains the named\n      -- wildcards brought into scope by this signature. For a signature\n      -- @_ -> _a -> Bool@, the renamer will leave the unnamed wildcard @_@\n      -- untouched, and the named wildcard @_a@ is then replaced with\n      -- fresh meta vars in the type. Their names are stored in the type\n      -- signature that brought them into scope, in this third field to be\n      -- more specific.\n      --\n      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',\n      --          'ApiAnnotation.AnnComma'\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n    TypeSig\n       (XTypeSig pass)\n       [Located (IdP pass)]  -- LHS of the signature; e.g.  f,g,h :: blah\n       (LHsSigWcType pass)   -- RHS of the signature; can have wildcards\n\n      -- | A pattern synonym type signature\n      --\n      -- > pattern Single :: () => (Show a) => a -> [a]\n      --\n      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',\n      --           'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'\n      --           'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n  | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)\n      -- P :: forall a b. Req => Prov => ty\n\n      -- | A signature for a class method\n      --   False: ordinary class-method signature\n      --   True:  generic-default class method signature\n      -- e.g.   class C a where\n      --          op :: a -> a                   -- Ordinary\n      --          default op :: Eq a => a -> a   -- Generic default\n      -- No wildcards allowed here\n      --\n      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',\n      --           'ApiAnnotation.AnnDcolon'\n  | ClassOpSig (XClassOpSig pass) Bool [Located (IdP pass)] (LHsSigType pass)\n\n        -- | A type signature in generated code, notably the code\n        -- generated for record selectors.  We simply record\n        -- the desired Id itself, replete with its name, type\n        -- and IdDetails.  Otherwise it's just like a type\n        -- signature: there should be an accompanying binding\n  | IdSig (XIdSig pass) Id\n\n        -- | An ordinary fixity declaration\n        --\n        -- >     infixl 8 ***\n        --\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',\n        --           'ApiAnnotation.AnnVal'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | FixSig (XFixSig pass) (FixitySig pass)\n\n        -- | An inline pragma\n        --\n        -- > {#- INLINE f #-}\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' :\n        --       'ApiAnnotation.AnnOpen' @'{-\\# INLINE'@ and @'['@,\n        --       'ApiAnnotation.AnnClose','ApiAnnotation.AnnOpen',\n        --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde',\n        --       'ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | InlineSig   (XInlineSig pass)\n                (Located (IdP pass)) -- Function name\n                InlinePragma         -- Never defaultInlinePragma\n\n        -- | A specialisation pragma\n        --\n        -- > {-# SPECIALISE f :: Int -> Int #-}\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n        --      'ApiAnnotation.AnnOpen' @'{-\\# SPECIALISE'@ and @'['@,\n        --      'ApiAnnotation.AnnTilde',\n        --      'ApiAnnotation.AnnVal',\n        --      'ApiAnnotation.AnnClose' @']'@ and @'\\#-}'@,\n        --      'ApiAnnotation.AnnDcolon'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | SpecSig     (XSpecSig pass)\n                (Located (IdP pass)) -- Specialise a function or datatype  ...\n                [LHsSigType pass]  -- ... to these types\n                InlinePragma       -- The pragma on SPECIALISE_INLINE form.\n                                   -- If it's just defaultInlinePragma, then we said\n                                   --    SPECIALISE, not SPECIALISE_INLINE\n\n        -- | A specialisation pragma for instance declarations only\n        --\n        -- > {-# SPECIALISE instance Eq [Int] #-}\n        --\n        -- (Class tys); should be a specialisation of the\n        -- current instance declaration\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n        --      'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)\n                  -- Note [Pragma source text] in BasicTypes\n\n        -- | A minimal complete definition pragma\n        --\n        -- > {-# MINIMAL a | (b, c | (d | e)) #-}\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n        --      'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma',\n        --      'ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | MinimalSig (XMinimalSig pass)\n               SourceText (LBooleanFormula (Located (IdP pass)))\n               -- Note [Pragma source text] in BasicTypes\n\n        -- | A \"set cost centre\" pragma for declarations\n        --\n        -- > {-# SCC funName #-}\n        --\n        -- or\n        --\n        -- > {-# SCC funName \"cost_centre_name\" #-}\n\n  | SCCFunSig  (XSCCFunSig pass)\n               SourceText      -- Note [Pragma source text] in BasicTypes\n               (Located (IdP pass))  -- Function name\n               (Maybe (Located StringLiteral))\n       -- | A complete match pragma\n       --\n       -- > {-# COMPLETE C, D [:: T] #-}\n       --\n       -- Used to inform the pattern match checker about additional\n       -- complete matchings which, for example, arise from pattern\n       -- synonym definitions.\n  | CompleteMatchSig (XCompleteMatchSig pass)\n                     SourceText\n                     (Located [Located (IdP pass)])\n                     (Maybe (Located (IdP pass)))\n  | XSig (XXSig pass)\n\ntype instance XTypeSig          (GhcPass p) = NoExt\ntype instance XPatSynSig        (GhcPass p) = NoExt\ntype instance XClassOpSig       (GhcPass p) = NoExt\ntype instance XIdSig            (GhcPass p) = NoExt\ntype instance XFixSig           (GhcPass p) = NoExt\ntype instance XInlineSig        (GhcPass p) = NoExt\ntype instance XSpecSig          (GhcPass p) = NoExt\ntype instance XSpecInstSig      (GhcPass p) = NoExt\ntype instance XMinimalSig       (GhcPass p) = NoExt\ntype instance XSCCFunSig        (GhcPass p) = NoExt\ntype instance XCompleteMatchSig (GhcPass p) = NoExt\ntype instance XXSig             (GhcPass p) = NoExt\n\n-- | Located Fixity Signature\ntype LFixitySig pass = Located (FixitySig pass)\n\n-- | Fixity Signature\ndata FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity\n                    | XFixitySig (XXFixitySig pass)\n\ntype instance XFixitySig  (GhcPass p) = NoExt\ntype instance XXFixitySig (GhcPass p) = NoExt\n\n-- | Type checker Specialisation Pragmas\n--\n-- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer\ndata TcSpecPrags\n  = IsDefaultMethod     -- ^ Super-specialised: a default method should\n                        -- be macro-expanded at every call site\n  | SpecPrags [LTcSpecPrag]\n  deriving Data\n\n-- | Located Type checker Specification Pragmas\ntype LTcSpecPrag = Located TcSpecPrag\n\n-- | Type checker Specification Pragma\ndata TcSpecPrag\n  = SpecPrag\n        Id\n        HsWrapper\n        InlinePragma\n  -- ^ The Id to be specialised, a wrapper that specialises the\n  -- polymorphic function, and inlining spec for the specialised function\n  deriving Data\n\nnoSpecPrags :: TcSpecPrags\nnoSpecPrags = SpecPrags []\n\nhasSpecPrags :: TcSpecPrags -> Bool\nhasSpecPrags (SpecPrags ps) = not (null ps)\nhasSpecPrags IsDefaultMethod = False\n\nisDefaultMethod :: TcSpecPrags -> Bool\nisDefaultMethod IsDefaultMethod = True\nisDefaultMethod (SpecPrags {})  = False\n\n\nisFixityLSig :: LSig name -> Bool\nisFixityLSig (L _ (FixSig {})) = True\nisFixityLSig _                 = False\n\nisTypeLSig :: LSig name -> Bool  -- Type signatures\nisTypeLSig (L _(TypeSig {}))    = True\nisTypeLSig (L _(ClassOpSig {})) = True\nisTypeLSig (L _(IdSig {}))      = True\nisTypeLSig _                    = False\n\nisSpecLSig :: LSig name -> Bool\nisSpecLSig (L _(SpecSig {})) = True\nisSpecLSig _                 = False\n\nisSpecInstLSig :: LSig name -> Bool\nisSpecInstLSig (L _ (SpecInstSig {})) = True\nisSpecInstLSig _                      = False\n\nisPragLSig :: LSig name -> Bool\n-- Identifies pragmas\nisPragLSig (L _ (SpecSig {}))   = True\nisPragLSig (L _ (InlineSig {})) = True\nisPragLSig (L _ (SCCFunSig {})) = True\nisPragLSig (L _ (CompleteMatchSig {})) = True\nisPragLSig _                    = False\n\nisInlineLSig :: LSig name -> Bool\n-- Identifies inline pragmas\nisInlineLSig (L _ (InlineSig {})) = True\nisInlineLSig _                    = False\n\nisMinimalLSig :: LSig name -> Bool\nisMinimalLSig (L _ (MinimalSig {})) = True\nisMinimalLSig _                     = False\n\nisSCCFunSig :: LSig name -> Bool\nisSCCFunSig (L _ (SCCFunSig {})) = True\nisSCCFunSig _                    = False\n\nisCompleteMatchSig :: LSig name -> Bool\nisCompleteMatchSig (L _ (CompleteMatchSig {} )) = True\nisCompleteMatchSig _                            = False\n\nhsSigDoc :: Sig name -> SDoc\nhsSigDoc (TypeSig {})           = text \"type signature\"\nhsSigDoc (PatSynSig {})         = text \"pattern synonym signature\"\nhsSigDoc (ClassOpSig _ is_deflt _ _)\n | is_deflt                     = text \"default type signature\"\n | otherwise                    = text \"class method signature\"\nhsSigDoc (IdSig {})             = text \"id signature\"\nhsSigDoc (SpecSig {})           = text \"SPECIALISE pragma\"\nhsSigDoc (InlineSig _ _ prag)   = ppr (inlinePragmaSpec prag) <+> text \"pragma\"\nhsSigDoc (SpecInstSig {})       = text \"SPECIALISE instance pragma\"\nhsSigDoc (FixSig {})            = text \"fixity declaration\"\nhsSigDoc (MinimalSig {})        = text \"MINIMAL pragma\"\nhsSigDoc (SCCFunSig {})         = text \"SCC pragma\"\nhsSigDoc (CompleteMatchSig {})  = text \"COMPLETE pragma\"\nhsSigDoc (XSig {})              = text \"XSIG TTG extension\"\n\n{-\nCheck if signatures overlap; this is used when checking for duplicate\nsignatures. Since some of the signatures contain a list of names, testing for\nequality is not enough -- we have to check if they overlap.\n-}\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Sig p) where\n    ppr sig = ppr_sig sig\n\nppr_sig :: (OutputableBndrId (GhcPass p)) => Sig (GhcPass p) -> SDoc\nppr_sig (TypeSig _ vars ty)  = pprVarSig (map unLoc vars) (ppr ty)\nppr_sig (ClassOpSig _ is_deflt vars ty)\n  | is_deflt                 = text \"default\" <+> pprVarSig (map unLoc vars) (ppr ty)\n  | otherwise                = pprVarSig (map unLoc vars) (ppr ty)\nppr_sig (IdSig _ id)         = pprVarSig [id] (ppr (varType id))\nppr_sig (FixSig _ fix_sig)   = ppr fix_sig\nppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))\n  = pragSrcBrackets (inl_src inl) pragmaSrc (pprSpec (unLoc var)\n                                             (interpp'SP ty) inl)\n    where\n      pragmaSrc = case spec of\n        NoUserInline -> \"{-# SPECIALISE\"\n        _            -> \"{-# SPECIALISE_INLINE\"\nppr_sig (InlineSig _ var inl)\n  = pragSrcBrackets (inl_src inl) \"{-# INLINE\"  (pprInline inl\n                                   <+> pprPrefixOcc (unLoc var))\nppr_sig (SpecInstSig _ src ty)\n  = pragSrcBrackets src \"{-# SPECIALISE\" (text \"instance\" <+> ppr ty)\nppr_sig (MinimalSig _ src bf)\n  = pragSrcBrackets src \"{-# MINIMAL\" (pprMinimalSig bf)\nppr_sig (PatSynSig _ names sig_ty)\n  = text \"pattern\" <+> pprVarSig (map unLoc names) (ppr sig_ty)\nppr_sig (SCCFunSig _ src fn mlabel)\n  = pragSrcBrackets src \"{-# SCC\" (ppr fn <+> maybe empty ppr mlabel )\nppr_sig (CompleteMatchSig _ src cs mty)\n  = pragSrcBrackets src \"{-# COMPLETE\"\n      ((hsep (punctuate comma (map ppr (unLoc cs))))\n        <+> opt_sig)\n  where\n    opt_sig = maybe empty ((\\t -> dcolon <+> ppr t) . unLoc) mty\nppr_sig (XSig x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (FixitySig p) where\n  ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]\n    where\n      pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)\n  ppr (XFixitySig x) = ppr x\n\npragBrackets :: SDoc -> SDoc\npragBrackets doc = text \"{-#\" <+> doc <+> text \"#-}\"\n\n-- | Using SourceText in case the pragma was spelled differently or used mixed\n-- case\npragSrcBrackets :: SourceText -> String -> SDoc -> SDoc\npragSrcBrackets (SourceText src) _   doc = text src <+> doc <+> text \"#-}\"\npragSrcBrackets NoSourceText     alt doc = text alt <+> doc <+> text \"#-}\"\n\npprVarSig :: (OutputableBndr id) => [id] -> SDoc -> SDoc\npprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty]\n  where\n    pprvars = hsep $ punctuate comma (map pprPrefixOcc vars)\n\npprSpec :: (OutputableBndr id) => id -> SDoc -> InlinePragma -> SDoc\npprSpec var pp_ty inl = pp_inl <+> pprVarSig [var] pp_ty\n  where\n    pp_inl | isDefaultInlinePragma inl = empty\n           | otherwise = pprInline inl\n\npprTcSpecPrags :: TcSpecPrags -> SDoc\npprTcSpecPrags IsDefaultMethod = text \"<default method>\"\npprTcSpecPrags (SpecPrags ps)  = vcat (map (ppr . unLoc) ps)\n\ninstance Outputable TcSpecPrag where\n  ppr (SpecPrag var _ inl)\n    = text \"SPECIALIZE\" <+> pprSpec var (text \"<type>\") inl\n\npprMinimalSig :: (OutputableBndr name)\n              => LBooleanFormula (Located name) -> SDoc\npprMinimalSig (L _ bf) = ppr (fmap unLoc bf)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[PatSynBind]{A pattern synonym definition}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Haskell Pattern Synonym Details\ntype HsPatSynDetails arg = HsConDetails arg [RecordPatSynField arg]\n\n-- See Note [Record PatSyn Fields]\n-- | Record Pattern Synonym Field\ndata RecordPatSynField a\n  = RecordPatSynField {\n      recordPatSynSelectorId :: a  -- Selector name visible in rest of the file\n      , recordPatSynPatVar :: a\n      -- Filled in by renamer, the name used internally\n      -- by the pattern\n      } deriving Data\n\n\n\n{-\nNote [Record PatSyn Fields]\n\nConsider the following two pattern synonyms.\n\npattern P x y = ([x,True], [y,'v'])\npattern Q{ x, y } =([x,True], [y,'v'])\n\nIn P, we just have two local binders, x and y.\n\nIn Q, we have local binders but also top-level record selectors\nx :: ([Bool], [Char]) -> Bool and similarly for y.\n\nIt would make sense to support record-like syntax\n\npattern Q{ x=x1, y=y1 } = ([x1,True], [y1,'v'])\n\nwhen we have a different name for the local and top-level binder\nthe distinction between the two names clear\n\n-}\ninstance Functor RecordPatSynField where\n    fmap f (RecordPatSynField { recordPatSynSelectorId = visible\n                              , recordPatSynPatVar = hidden })\n      = RecordPatSynField { recordPatSynSelectorId = f visible\n                          , recordPatSynPatVar = f hidden }\n\ninstance Outputable a => Outputable (RecordPatSynField a) where\n    ppr (RecordPatSynField { recordPatSynSelectorId = v }) = ppr v\n\ninstance Foldable RecordPatSynField  where\n    foldMap f (RecordPatSynField { recordPatSynSelectorId = visible\n                                 , recordPatSynPatVar = hidden })\n      = f visible `mappend` f hidden\n\ninstance Traversable RecordPatSynField where\n    traverse f (RecordPatSynField { recordPatSynSelectorId =visible\n                                  , recordPatSynPatVar = hidden })\n      = (\\ sel_id pat_var -> RecordPatSynField { recordPatSynSelectorId = sel_id\n                                               , recordPatSynPatVar = pat_var })\n          <$> f visible <*> f hidden\n\n\n-- | Haskell Pattern Synonym Direction\ndata HsPatSynDir id\n  = Unidirectional\n  | ImplicitBidirectional\n  | ExplicitBidirectional (MatchGroup id (LHsExpr id))\n", "num_lines": 1317}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,\n             DeriveTraversable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- | Abstract syntax of global declarations.\n--\n-- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,\n-- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.\nmodule HsDecls (\n  -- * Toplevel declarations\n  HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,\n  HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,\n\n  -- ** Class or type declarations\n  TyClDecl(..), LTyClDecl, DataDeclRn(..),\n  TyClGroup(..), mkTyClGroup, emptyTyClGroup,\n  tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,\n  isClassDecl, isDataDecl, isSynDecl, tcdName,\n  isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,\n  isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,\n  tyFamInstDeclName, tyFamInstDeclLName,\n  countTyClDecls, pprTyClDeclFlavour,\n  tyClDeclLName, tyClDeclTyVars,\n  hsDeclHasCusk, famDeclHasCusk,\n  FamilyDecl(..), LFamilyDecl,\n\n  -- ** Instance declarations\n  InstDecl(..), LInstDecl, FamilyInfo(..),\n  TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,\n  DataFamInstDecl(..), LDataFamInstDecl,\n  pprDataFamInstFlavour, pprHsFamInstLHS,\n  FamInstEqn, LFamInstEqn, FamEqn(..),\n  TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,\n  HsTyPats,\n  LClsInstDecl, ClsInstDecl(..),\n\n  -- ** Standalone deriving declarations\n  DerivDecl(..), LDerivDecl,\n  -- ** Deriving strategies\n  DerivStrategy(..), LDerivStrategy, derivStrategyName,\n  -- ** @RULE@ declarations\n  LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),\n  RuleBndr(..),LRuleBndr,\n  collectRuleBndrSigTys,\n  flattenRuleDecls, pprFullRuleName,\n  -- ** @default@ declarations\n  DefaultDecl(..), LDefaultDecl,\n  -- ** Template haskell declaration splice\n  SpliceExplicitFlag(..),\n  SpliceDecl(..), LSpliceDecl,\n  -- ** Foreign function interface declarations\n  ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),\n  CImportSpec(..),\n  -- ** Data-constructor declarations\n  ConDecl(..), LConDecl,\n  HsConDeclDetails, hsConDeclArgTys, hsConDeclTheta,\n  getConNames, getConArgs,\n  -- ** Document comments\n  DocDecl(..), LDocDecl, docDeclDoc,\n  -- ** Deprecations\n  WarnDecl(..),  LWarnDecl,\n  WarnDecls(..), LWarnDecls,\n  -- ** Annotations\n  AnnDecl(..), LAnnDecl,\n  AnnProvenance(..), annProvenanceName_maybe,\n  -- ** Role annotations\n  RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,\n  -- ** Injective type families\n  FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,\n  resultVariableName,\n\n  -- * Grouping\n  HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls\n\n    ) where\n\n-- friends:\nimport GhcPrelude\n\nimport {-# SOURCE #-}   HsExpr( HsExpr, HsSplice, pprExpr,\n                                pprSpliceDecl )\n        -- Because Expr imports Decls via HsBracket\n\nimport HsBinds\nimport HsTypes\nimport HsDoc\nimport TyCon\nimport BasicTypes\nimport Coercion\nimport ForeignCall\nimport HsExtension\nimport NameSet\n\n-- others:\nimport Class\nimport Outputable\nimport Util\nimport SrcLoc\nimport Type\n\nimport Bag\nimport Maybes\nimport Data.Data        hiding (TyCon,Fixity, Infix)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[HsDecl]{Declarations}\n*                                                                      *\n************************************************************************\n-}\n\ntype LHsDecl p = Located (HsDecl p)\n        -- ^ When in a list this may have\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'\n        --\n\n-- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | A Haskell Declaration\ndata HsDecl p\n  = TyClD      (XTyClD p)      (TyClDecl p)      -- ^ Type or Class Declaration\n  | InstD      (XInstD p)      (InstDecl  p)     -- ^ Instance declaration\n  | DerivD     (XDerivD p)     (DerivDecl p)     -- ^ Deriving declaration\n  | ValD       (XValD p)       (HsBind p)        -- ^ Value declaration\n  | SigD       (XSigD p)       (Sig p)           -- ^ Signature declaration\n  | DefD       (XDefD p)       (DefaultDecl p)   -- ^ 'default' declaration\n  | ForD       (XForD p)       (ForeignDecl p)   -- ^ Foreign declaration\n  | WarningD   (XWarningD p)   (WarnDecls p)     -- ^ Warning declaration\n  | AnnD       (XAnnD p)       (AnnDecl p)       -- ^ Annotation declaration\n  | RuleD      (XRuleD p)      (RuleDecls p)     -- ^ Rule declaration\n  | SpliceD    (XSpliceD p)    (SpliceDecl p)    -- ^ Splice declaration\n                                                 -- (Includes quasi-quotes)\n  | DocD       (XDocD p)       (DocDecl)  -- ^ Documentation comment declaration\n  | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration\n  | XHsDecl    (XXHsDecl p)\n\ntype instance XTyClD      (GhcPass _) = NoExt\ntype instance XInstD      (GhcPass _) = NoExt\ntype instance XDerivD     (GhcPass _) = NoExt\ntype instance XValD       (GhcPass _) = NoExt\ntype instance XSigD       (GhcPass _) = NoExt\ntype instance XDefD       (GhcPass _) = NoExt\ntype instance XForD       (GhcPass _) = NoExt\ntype instance XWarningD   (GhcPass _) = NoExt\ntype instance XAnnD       (GhcPass _) = NoExt\ntype instance XRuleD      (GhcPass _) = NoExt\ntype instance XSpliceD    (GhcPass _) = NoExt\ntype instance XDocD       (GhcPass _) = NoExt\ntype instance XRoleAnnotD (GhcPass _) = NoExt\ntype instance XXHsDecl    (GhcPass _) = NoExt\n\n-- NB: all top-level fixity decls are contained EITHER\n-- EITHER SigDs\n-- OR     in the ClassDecls in TyClDs\n--\n-- The former covers\n--      a) data constructors\n--      b) class methods (but they can be also done in the\n--              signatures of class decls)\n--      c) imported functions (that have an IfacSig)\n--      d) top level decls\n--\n-- The latter is for class methods only\n\n-- | Haskell Group\n--\n-- A 'HsDecl' is categorised into a 'HsGroup' before being\n-- fed to the renamer.\ndata HsGroup p\n  = HsGroup {\n        hs_ext    :: XCHsGroup p,\n        hs_valds  :: HsValBinds p,\n        hs_splcds :: [LSpliceDecl p],\n\n        hs_tyclds :: [TyClGroup p],\n                -- A list of mutually-recursive groups;\n                -- This includes `InstDecl`s as well;\n                -- Parser generates a singleton list;\n                -- renamer does dependency analysis\n\n        hs_derivds :: [LDerivDecl p],\n\n        hs_fixds  :: [LFixitySig p],\n                -- Snaffled out of both top-level fixity signatures,\n                -- and those in class declarations\n\n        hs_defds  :: [LDefaultDecl p],\n        hs_fords  :: [LForeignDecl p],\n        hs_warnds :: [LWarnDecls p],\n        hs_annds  :: [LAnnDecl p],\n        hs_ruleds :: [LRuleDecls p],\n\n        hs_docs   :: [LDocDecl]\n    }\n  | XHsGroup (XXHsGroup p)\n\ntype instance XCHsGroup (GhcPass _) = NoExt\ntype instance XXHsGroup (GhcPass _) = NoExt\n\n\nemptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)\nemptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }\nemptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }\n\nhsGroupInstDecls :: HsGroup id -> [LInstDecl id]\nhsGroupInstDecls = (=<<) group_instds . hs_tyclds\n\nemptyGroup = HsGroup { hs_ext = noExt,\n                       hs_tyclds = [],\n                       hs_derivds = [],\n                       hs_fixds = [], hs_defds = [], hs_annds = [],\n                       hs_fords = [], hs_warnds = [], hs_ruleds = [],\n                       hs_valds = error \"emptyGroup hs_valds: Can't happen\",\n                       hs_splcds = [],\n                       hs_docs = [] }\n\nappendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)\n             -> HsGroup (GhcPass p)\nappendGroups\n    HsGroup {\n        hs_valds  = val_groups1,\n        hs_splcds = spliceds1,\n        hs_tyclds = tyclds1,\n        hs_derivds = derivds1,\n        hs_fixds  = fixds1,\n        hs_defds  = defds1,\n        hs_annds  = annds1,\n        hs_fords  = fords1,\n        hs_warnds = warnds1,\n        hs_ruleds = rulds1,\n        hs_docs   = docs1 }\n    HsGroup {\n        hs_valds  = val_groups2,\n        hs_splcds = spliceds2,\n        hs_tyclds = tyclds2,\n        hs_derivds = derivds2,\n        hs_fixds  = fixds2,\n        hs_defds  = defds2,\n        hs_annds  = annds2,\n        hs_fords  = fords2,\n        hs_warnds = warnds2,\n        hs_ruleds = rulds2,\n        hs_docs   = docs2 }\n  =\n    HsGroup {\n        hs_ext    = noExt,\n        hs_valds  = val_groups1 `plusHsValBinds` val_groups2,\n        hs_splcds = spliceds1 ++ spliceds2,\n        hs_tyclds = tyclds1 ++ tyclds2,\n        hs_derivds = derivds1 ++ derivds2,\n        hs_fixds  = fixds1 ++ fixds2,\n        hs_annds  = annds1 ++ annds2,\n        hs_defds  = defds1 ++ defds2,\n        hs_fords  = fords1 ++ fords2,\n        hs_warnds = warnds1 ++ warnds2,\n        hs_ruleds = rulds1 ++ rulds2,\n        hs_docs   = docs1  ++ docs2 }\nappendGroups _ _ = panic \"appendGroups\"\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where\n    ppr (TyClD _ dcl)             = ppr dcl\n    ppr (ValD _ binds)            = ppr binds\n    ppr (DefD _ def)              = ppr def\n    ppr (InstD _ inst)            = ppr inst\n    ppr (DerivD _ deriv)          = ppr deriv\n    ppr (ForD _ fd)               = ppr fd\n    ppr (SigD _ sd)               = ppr sd\n    ppr (RuleD _ rd)              = ppr rd\n    ppr (WarningD _ wd)           = ppr wd\n    ppr (AnnD _ ad)               = ppr ad\n    ppr (SpliceD _ dd)            = ppr dd\n    ppr (DocD _ doc)              = ppr doc\n    ppr (RoleAnnotD _ ra)         = ppr ra\n    ppr (XHsDecl x)               = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where\n    ppr (HsGroup { hs_valds  = val_decls,\n                   hs_tyclds = tycl_decls,\n                   hs_derivds = deriv_decls,\n                   hs_fixds  = fix_decls,\n                   hs_warnds = deprec_decls,\n                   hs_annds  = ann_decls,\n                   hs_fords  = foreign_decls,\n                   hs_defds  = default_decls,\n                   hs_ruleds = rule_decls })\n        = vcat_mb empty\n            [ppr_ds fix_decls, ppr_ds default_decls,\n             ppr_ds deprec_decls, ppr_ds ann_decls,\n             ppr_ds rule_decls,\n             if isEmptyValBinds val_decls\n                then Nothing\n                else Just (ppr val_decls),\n             ppr_ds (tyClGroupTyClDecls tycl_decls),\n             ppr_ds (tyClGroupInstDecls tycl_decls),\n             ppr_ds deriv_decls,\n             ppr_ds foreign_decls]\n        where\n          ppr_ds :: Outputable a => [a] -> Maybe SDoc\n          ppr_ds [] = Nothing\n          ppr_ds ds = Just (vcat (map ppr ds))\n\n          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc\n          -- Concatenate vertically with white-space between non-blanks\n          vcat_mb _    []             = empty\n          vcat_mb gap (Nothing : ds) = vcat_mb gap ds\n          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds\n    ppr (XHsGroup x) = ppr x\n\n-- | Located Splice Declaration\ntype LSpliceDecl pass = Located (SpliceDecl pass)\n\n-- | Splice Declaration\ndata SpliceDecl p\n  = SpliceDecl                  -- Top level splice\n        (XSpliceDecl p)\n        (Located (HsSplice p))\n        SpliceExplicitFlag\n  | XSpliceDecl (XXSpliceDecl p)\n\ntype instance XSpliceDecl      (GhcPass _) = NoExt\ntype instance XXSpliceDecl     (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (SpliceDecl p) where\n   ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f\n   ppr (XSpliceDecl x) = ppr x\n\n{-\n************************************************************************\n*                                                                      *\n            Type and class declarations\n*                                                                      *\n************************************************************************\n\nNote [The Naming story]\n~~~~~~~~~~~~~~~~~~~~~~~\nHere is the story about the implicit names that go with type, class,\nand instance decls.  It's a bit tricky, so pay attention!\n\n\"Implicit\" (or \"system\") binders\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  Each data type decl defines\n        a worker name for each constructor\n        to-T and from-T convertors\n  Each class decl defines\n        a tycon for the class\n        a data constructor for that tycon\n        the worker for that constructor\n        a selector for each superclass\n\nAll have occurrence names that are derived uniquely from their parent\ndeclaration.\n\nNone of these get separate definitions in an interface file; they are\nfully defined by the data or class decl.  But they may *occur* in\ninterface files, of course.  Any such occurrence must haul in the\nrelevant type or class decl.\n\nPlan of attack:\n - Ensure they \"point to\" the parent data/class decl\n   when loading that decl from an interface file\n   (See RnHiFiles.getSysBinders)\n\n - When typechecking the decl, we build the implicit TyCons and Ids.\n   When doing so we look them up in the name cache (RnEnv.lookupSysName),\n   to ensure correct module and provenance is set\n\nThese are the two places that we have to conjure up the magic derived\nnames.  (The actual magic is in OccName.mkWorkerOcc, etc.)\n\nDefault methods\n~~~~~~~~~~~~~~~\n - Occurrence name is derived uniquely from the method name\n   E.g. $dmmax\n\n - If there is a default method name at all, it's recorded in\n   the ClassOpSig (in HsBinds), in the DefMethInfo field.\n   (DefMethInfo is defined in Class.hs)\n\nSource-code class decls and interface-code class decls are treated subtly\ndifferently, which has given me a great deal of confusion over the years.\nHere's the deal.  (We distinguish the two cases because source-code decls\nhave (Just binds) in the tcdMeths field, whereas interface decls have Nothing.\n\nIn *source-code* class declarations:\n\n - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName\n   This is done by RdrHsSyn.mkClassOpSigDM\n\n - The renamer renames it to a Name\n\n - During typechecking, we generate a binding for each $dm for\n   which there's a programmer-supplied default method:\n        class Foo a where\n          op1 :: <type>\n          op2 :: <type>\n          op1 = ...\n   We generate a binding for $dmop1 but not for $dmop2.\n   The Class for Foo has a Nothing for op2 and\n                         a Just ($dm_op1, VanillaDM) for op1.\n   The Name for $dmop2 is simply discarded.\n\nIn *interface-file* class declarations:\n  - When parsing, we see if there's an explicit programmer-supplied default method\n    because there's an '=' sign to indicate it:\n        class Foo a where\n          op1 = :: <type>       -- NB the '='\n          op2   :: <type>\n    We use this info to generate a DefMeth with a suitable RdrName for op1,\n    and a NoDefMeth for op2\n  - The interface file has a separate definition for $dmop1, with unfolding etc.\n  - The renamer renames it to a Name.\n  - The renamer treats $dmop1 as a free variable of the declaration, so that\n    the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)\n    This doesn't happen for source code class decls, because they *bind* the default method.\n\nDictionary functions\n~~~~~~~~~~~~~~~~~~~~\nEach instance declaration gives rise to one dictionary function binding.\n\nThe type checker makes up new source-code instance declarations\n(e.g. from 'deriving' or generic default methods --- see\nTcInstDcls.tcInstDecls1).  So we can't generate the names for\ndictionary functions in advance (we don't know how many we need).\n\nOn the other hand for interface-file instance declarations, the decl\nspecifies the name of the dictionary function, and it has a binding elsewhere\nin the interface file:\n        instance {Eq Int} = dEqInt\n        dEqInt :: {Eq Int} <pragma info>\n\nSo again we treat source code and interface file code slightly differently.\n\nSource code:\n  - Source code instance decls have a Nothing in the (Maybe name) field\n    (see data InstDecl below)\n\n  - The typechecker makes up a Local name for the dict fun for any source-code\n    instance decl, whether it comes from a source-code instance decl, or whether\n    the instance decl is derived from some other construct (e.g. 'deriving').\n\n  - The occurrence name it chooses is derived from the instance decl (just for\n    documentation really) --- e.g. dNumInt.  Two dict funs may share a common\n    occurrence name, but will have different uniques.  E.g.\n        instance Foo [Int]  where ...\n        instance Foo [Bool] where ...\n    These might both be dFooList\n\n  - The CoreTidy phase externalises the name, and ensures the occurrence name is\n    unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.\n\n  - We can take this relaxed approach (changing the occurrence name later)\n    because dict fun Ids are not captured in a TyCon or Class (unlike default\n    methods, say).  Instead, they are kept separately in the InstEnv.  This\n    makes it easy to adjust them after compiling a module.  (Once we've finished\n    compiling that module, they don't change any more.)\n\n\nInterface file code:\n  - The instance decl gives the dict fun name, so the InstDecl has a (Just name)\n    in the (Maybe name) field.\n\n  - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we\n    suck in the dfun binding\n-}\n\n-- | Located Declaration of a Type or Class\ntype LTyClDecl pass = Located (TyClDecl pass)\n\n-- | A type or class declaration.\ndata TyClDecl pass\n  = -- | @type/data family T :: *->*@\n    --\n    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',\n    --             'ApiAnnotation.AnnData',\n    --             'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',\n    --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',\n    --             'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',\n    --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',\n    --             'ApiAnnotation.AnnVbar'\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n    FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }\n\n  | -- | @type@ declaration\n    --\n    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',\n    --             'ApiAnnotation.AnnEqual',\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n    SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs\n            , tcdLName  :: Located (IdP pass)     -- ^ Type constructor\n            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an\n                                                  -- associated type these\n                                                  -- include outer binders\n            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration\n            , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration\n\n  | -- | @data@ declaration\n    --\n    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',\n    --              'ApiAnnotation.AnnFamily',\n    --              'ApiAnnotation.AnnNewType',\n    --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'\n    --              'ApiAnnotation.AnnWhere',\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n    DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs\n             , tcdLName    :: Located (IdP pass)   -- ^ Type constructor\n             , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables\n                              -- See Note [TyVar binders for associated declarations]\n             , tcdFixity   :: LexicalFixity        -- ^ Fixity used in the declaration\n             , tcdDataDefn :: HsDataDefn pass }\n\n  | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs\n                tcdCtxt    :: LHsContext pass,         -- ^ Context...\n                tcdLName   :: Located (IdP pass),      -- ^ Name of the class\n                tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables\n                tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration\n                tcdFDs     :: [LHsFunDep pass],         -- ^ Functional deps\n                tcdSigs    :: [LSig pass],              -- ^ Methods' signatures\n                tcdMeths   :: LHsBinds pass,            -- ^ Default methods\n                tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;\n                tcdATDefs  :: [LTyFamDefltEqn pass],    -- ^ Associated type defaults\n                tcdDocs    :: [LDocDecl]                -- ^ Haddock docs\n    }\n        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',\n        --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',\n        --           'ApiAnnotation.AnnClose'\n        --   - The tcdFDs will have 'ApiAnnotation.AnnVbar',\n        --                          'ApiAnnotation.AnnComma'\n        --                          'ApiAnnotation.AnnRarrow'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | XTyClDecl (XXTyClDecl pass)\n\ntype LHsFunDep pass = Located (FunDep (Located (IdP pass)))\n\ndata DataDeclRn = DataDeclRn\n             { tcdDataCusk :: Bool    -- ^ does this have a CUSK?\n             , tcdFVs      :: NameSet }\n  deriving Data\n\n{- Note [TyVar binders for associated decls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor an /associated/ data, newtype, or type-family decl, the LHsQTyVars\n/includes/ outer binders.  For example\n    class T a where\n       data D a c\n       type F a b :: *\n       type F a b = a -> a\nHere the data decl for 'D', and type-family decl for 'F', both include 'a'\nin their LHsQTyVars (tcdTyVars and fdTyVars resp).\n\nDitto any implicit binders in the hsq_implicit field of the LHSQTyVars.\n\nThe idea is that the associated type is really a top-level decl in its\nown right.  However we are careful to use the same name 'a', so that\nwe can match things up.\n\nc.f. Note [Associated type tyvar names] in Class.hs\n     Note [Family instance declaration binders]\n-}\n\ntype instance XFamDecl      (GhcPass _) = NoExt\n\ntype instance XSynDecl      GhcPs = NoExt\ntype instance XSynDecl      GhcRn = NameSet -- FVs\ntype instance XSynDecl      GhcTc = NameSet -- FVs\n\ntype instance XDataDecl     GhcPs = NoExt\ntype instance XDataDecl     GhcRn = DataDeclRn\ntype instance XDataDecl     GhcTc = DataDeclRn\n\ntype instance XClassDecl    GhcPs = NoExt\ntype instance XClassDecl    GhcRn = NameSet -- FVs\ntype instance XClassDecl    GhcTc = NameSet -- FVs\n\ntype instance XXTyClDecl    (GhcPass _) = NoExt\n\n-- Simple classifiers for TyClDecl\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n-- | @True@ <=> argument is a @data@\\/@newtype@\n-- declaration.\nisDataDecl :: TyClDecl pass -> Bool\nisDataDecl (DataDecl {}) = True\nisDataDecl _other        = False\n\n-- | type or type instance declaration\nisSynDecl :: TyClDecl pass -> Bool\nisSynDecl (SynDecl {})   = True\nisSynDecl _other        = False\n\n-- | type class\nisClassDecl :: TyClDecl pass -> Bool\nisClassDecl (ClassDecl {}) = True\nisClassDecl _              = False\n\n-- | type/data family declaration\nisFamilyDecl :: TyClDecl pass -> Bool\nisFamilyDecl (FamDecl {})  = True\nisFamilyDecl _other        = False\n\n-- | type family declaration\nisTypeFamilyDecl :: TyClDecl pass -> Bool\nisTypeFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = info })) = case info of\n  OpenTypeFamily      -> True\n  ClosedTypeFamily {} -> True\n  _                   -> False\nisTypeFamilyDecl _ = False\n\n-- | open type family info\nisOpenTypeFamilyInfo :: FamilyInfo pass -> Bool\nisOpenTypeFamilyInfo OpenTypeFamily = True\nisOpenTypeFamilyInfo _              = False\n\n-- | closed type family info\nisClosedTypeFamilyInfo :: FamilyInfo pass -> Bool\nisClosedTypeFamilyInfo (ClosedTypeFamily {}) = True\nisClosedTypeFamilyInfo _                     = False\n\n-- | data family declaration\nisDataFamilyDecl :: TyClDecl pass -> Bool\nisDataFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = DataFamily })) = True\nisDataFamilyDecl _other      = False\n\n-- Dealing with names\n\ntyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)\ntyFamInstDeclName = unLoc . tyFamInstDeclLName\n\ntyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)\ntyFamInstDeclLName (TyFamInstDecl { tfid_eqn =\n                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })\n  = ln\ntyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))\n  = panic \"tyFamInstDeclLName\"\ntyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))\n  = panic \"tyFamInstDeclLName\"\n\ntyClDeclLName :: TyClDecl pass -> Located (IdP pass)\ntyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln\ntyClDeclLName decl = tcdLName decl\n\ntcdName :: TyClDecl pass -> (IdP pass)\ntcdName = unLoc . tyClDeclLName\n\ntyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass\ntyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs\ntyClDeclTyVars d = tcdTyVars d\n\ncountTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)\n        -- class, synonym decls, data, newtype, family decls\ncountTyClDecls decls\n = (count isClassDecl    decls,\n    count isSynDecl      decls,  -- excluding...\n    count isDataTy       decls,  -- ...family...\n    count isNewTy        decls,  -- ...instances\n    count isFamilyDecl   decls)\n where\n   isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True\n   isDataTy _                                                       = False\n\n   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True\n   isNewTy _                                                      = False\n\n-- | Does this declaration have a complete, user-supplied kind signature?\n-- See Note [CUSKs: complete user-supplied kind signatures]\nhsDeclHasCusk :: TyClDecl GhcRn -> Bool\nhsDeclHasCusk (FamDecl { tcdFam = fam_decl })\n  = famDeclHasCusk False fam_decl\n    -- False: this is not: an associated type of a class with no cusk\nhsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })\n  -- NB: Keep this synchronized with 'getInitialKind'\n  = hsTvbAllKinded tyvars && rhs_annotated rhs\n  where\n    rhs_annotated (L _ ty) = case ty of\n      HsParTy _ lty  -> rhs_annotated lty\n      HsKindSig {}   -> True\n      _              -> False\nhsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk\nhsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars\nhsDeclHasCusk (XTyClDecl _) = panic \"hsDeclHasCusk\"\n\n-- Pretty-printing TyClDecl\n-- ~~~~~~~~~~~~~~~~~~~~~~~~\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where\n\n    ppr (FamDecl { tcdFam = decl }) = ppr decl\n    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity\n                 , tcdRhs = rhs })\n      = hang (text \"type\" <+>\n              pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+> equals)\n          4 (ppr rhs)\n\n    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity\n                  , tcdDataDefn = defn })\n      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn\n\n    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,\n                    tcdFixity = fixity,\n                    tcdFDs  = fds,\n                    tcdSigs = sigs, tcdMeths = methods,\n                    tcdATs = ats, tcdATDefs = at_defs})\n      | null sigs && isEmptyBag methods && null ats && null at_defs -- No \"where\" part\n      = top_matter\n\n      | otherwise       -- Laid out\n      = vcat [ top_matter <+> text \"where\"\n             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++\n                                     map ppr_fam_deflt_eqn at_defs ++\n                                     pprLHsBindsForUser methods sigs) ]\n      where\n        top_matter = text \"class\"\n                    <+> pp_vanilla_decl_head lclas tyvars fixity context\n                    <+> pprFundeps (map unLoc fds)\n\n    ppr (XTyClDecl x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (TyClGroup p) where\n  ppr (TyClGroup { group_tyclds = tyclds\n                 , group_roles = roles\n                 , group_instds = instds\n                 }\n      )\n    = ppr tyclds $$\n      ppr roles $$\n      ppr instds\n  ppr (XTyClGroup x) = ppr x\n\npp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))\n   => Located (IdP (GhcPass p))\n   -> LHsQTyVars (GhcPass p)\n   -> LexicalFixity\n   -> LHsContext (GhcPass p)\n   -> SDoc\npp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context\n = hsep [pprLHsContext context, pp_tyvars tyvars]\n  where\n    pp_tyvars (varl:varsr)\n      | fixity == Infix && length varsr > 1\n         = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)\n                , (ppr.unLoc) (head varsr), char ')'\n                , hsep (map (ppr.unLoc) (tail varsr))]\n      | fixity == Infix\n         = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)\n         , hsep (map (ppr.unLoc) varsr)]\n      | otherwise = hsep [ pprPrefixOcc (unLoc thing)\n                  , hsep (map (ppr.unLoc) (varl:varsr))]\n    pp_tyvars [] = pprPrefixOcc (unLoc thing)\npp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x\n\npprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc\npprTyClDeclFlavour (ClassDecl {})   = text \"class\"\npprTyClDeclFlavour (SynDecl {})     = text \"type\"\npprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})\n  = pprFlavour info <+> text \"family\"\npprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})\n  = ppr x\npprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })\n  = ppr nd\npprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })\n  = ppr x\npprTyClDeclFlavour (XTyClDecl x) = ppr x\n\n\n{- Note [CUSKs: complete user-supplied kind signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe kind-check declarations differently if they have a complete, user-supplied\nkind signature (CUSK). This is because we can safely generalise a CUSKed\ndeclaration before checking all of the others, supporting polymorphic recursion.\nSee ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy\nand #9200 for lots of discussion of how we got here.\n\nPRINCIPLE:\n  a type declaration has a CUSK iff we could produce a separate kind signature\n  for it, just like a type signature for a function,\n  looking only at the header of the declaration.\n\nExamples:\n  * data T1 (a :: *->*) (b :: *) = ....\n    -- Has CUSK; equivalant to   T1 :: (*->*) -> * -> *\n\n * data T2 a b = ...\n   -- No CUSK; we do not want to guess T2 :: * -> * -> *\n   -- because the full decl might be   data T a b = MkT (a b)\n\n  * data T3 (a :: k -> *) (b :: *) = ...\n    -- CUSK; equivalent to   T3 :: (k -> *) -> * -> *\n    -- We lexically generalise over k to get\n    --    T3 :: forall k. (k -> *) -> * -> *\n    -- The generalisation is here is purely lexical, just like\n    --    f3 :: a -> a\n    -- means\n    --    f3 :: forall a. a -> a\n\n  * data T4 (a :: j k) = ...\n     -- CUSK; equivalent to   T4 :: j k -> *\n     -- which we lexically generalise to  T4 :: forall j k. j k -> *\n     -- and then, if PolyKinds is on, we further generalise to\n     --   T4 :: forall kk (j :: kk -> *) (k :: kk). j k -> *\n     -- Again this is exactly like what happens as the term level\n     -- when you write\n     --    f4 :: forall a b. a b -> Int\n\nNOTE THAT\n  * A CUSK does /not/ mean that everything about the kind signature is\n    fully specified by the user.  Look at T4 and f4: we had do do kind\n    inference to figure out the kind-quantification.  But in both cases\n    (T4 and f4) that inference is done looking /only/ at the header of T4\n    (or signature for f4), not at the definition thereof.\n\n  * The CUSK completely fixes the kind of the type constructor, forever.\n\n  * The precise rules, for each declaration form, for whethher a declaration\n    has a CUSK are given in the user manual section \"Complete user-supplied\n    kind signatures and polymorphic recursion\".  BUt they simply implement\n    PRINCIPLE above.\n\n  * Open type families are interesting:\n      type family T5 a b :: *\n    There simply /is/ no accompanying declaration, so that info is all\n    we'll ever get.  So we it has a CUSK by definition, and we default\n    any un-fixed kind variables to *.\n\n  * Associated types are a bit tricker:\n      class C6 a where\n         type family T6 a b :: *\n         op :: a Int -> Int\n    Here C6 does not have a CUSK (in fact we ultimately discover that\n    a :: * -> *).  And hence neither does T6, the associated family,\n    because we can't fix its kind until we have settled C6.  Another\n    way to say it: unlike a top-level, we /may/ discover more about\n    a's kind from C6's definition.\n\n  * A data definition with a top-level :: must explicitly bind all\n    kind variables to the right of the ::. See test\n    dependent/should_compile/KindLevels, which requires this\n    case. (Naturally, any kind variable mentioned before the :: should\n    not be bound after it.)\n\n    This last point is much more debatable than the others; see\n    Trac #15142 comment:22\n-}\n\n\n{- *********************************************************************\n*                                                                      *\n                         TyClGroup\n        Strongly connected components of\n      type, class, instance, and role declarations\n*                                                                      *\n********************************************************************* -}\n\n{- Note [TyClGroups and dependency analysis]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA TyClGroup represents a strongly connected components of type/class/instance\ndecls, together with the role annotations for the type/class declarations.\n\nThe hs_tyclds :: [TyClGroup] field of a HsGroup is a dependency-order\nsequence of strongly-connected components.\n\nInvariants\n * The type and class declarations, group_tyclds, may depend on each\n   other, or earlier TyClGroups, but not on later ones\n\n * The role annotations, group_roles, are role-annotations for some or\n   all of the types and classes in group_tyclds (only).\n\n * The instance declarations, group_instds, may (and usually will)\n   depend on group_tyclds, or on earlier TyClGroups, but not on later\n   ones.\n\nSee Note [Dependency analsis of type, class, and instance decls]\nin RnSource for more info.\n-}\n\n-- | Type or Class Group\ndata TyClGroup pass  -- See Note [TyClGroups and dependency analysis]\n  = TyClGroup { group_ext    :: XCTyClGroup pass\n              , group_tyclds :: [LTyClDecl pass]\n              , group_roles  :: [LRoleAnnotDecl pass]\n              , group_instds :: [LInstDecl pass] }\n  | XTyClGroup (XXTyClGroup pass)\n\ntype instance XCTyClGroup (GhcPass _) = NoExt\ntype instance XXTyClGroup (GhcPass _) = NoExt\n\n\nemptyTyClGroup :: TyClGroup (GhcPass p)\nemptyTyClGroup = TyClGroup noExt [] [] []\n\ntyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]\ntyClGroupTyClDecls = concatMap group_tyclds\n\ntyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]\ntyClGroupInstDecls = concatMap group_instds\n\ntyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]\ntyClGroupRoleDecls = concatMap group_roles\n\nmkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]\n            -> TyClGroup (GhcPass p)\nmkTyClGroup decls instds = TyClGroup\n  { group_ext = noExt\n  , group_tyclds = decls\n  , group_roles = []\n  , group_instds = instds\n  }\n\n\n\n{- *********************************************************************\n*                                                                      *\n               Data and type family declarations\n*                                                                      *\n********************************************************************* -}\n\n{- Note [FamilyResultSig]\n~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThis data type represents the return signature of a type family.  Possible\nvalues are:\n\n * NoSig - the user supplied no return signature:\n      type family Id a where ...\n\n * KindSig - the user supplied the return kind:\n      type family Id a :: * where ...\n\n * TyVarSig - user named the result with a type variable and possibly\n   provided a kind signature for that variable:\n      type family Id a = r where ...\n      type family Id a = (r :: *) where ...\n\n   Naming result of a type family is required if we want to provide\n   injectivity annotation for a type family:\n      type family Id a = r | r -> a where ...\n\nSee also: Note [Injectivity annotation]\n\nNote [Injectivity annotation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA user can declare a type family to be injective:\n\n   type family Id a = r | r -> a where ...\n\n * The part after the \"|\" is called \"injectivity annotation\".\n * \"r -> a\" part is called \"injectivity condition\"; at the moment terms\n   \"injectivity annotation\" and \"injectivity condition\" are synonymous\n   because we only allow a single injectivity condition.\n * \"r\" is the \"LHS of injectivity condition\". LHS can only contain the\n   variable naming the result of a type family.\n\n * \"a\" is the \"RHS of injectivity condition\". RHS contains space-separated\n   type and kind variables representing the arguments of a type\n   family. Variables can be omitted if a type family is not injective in\n   these arguments. Example:\n         type family Foo a b c = d | d -> a c where ...\n\nNote that:\n (a) naming of type family result is required to provide injectivity\n     annotation\n (b) for associated types if the result was named then injectivity annotation\n     is mandatory. Otherwise result type variable is indistinguishable from\n     associated type default.\n\nIt is possible that in the future this syntax will be extended to support\nmore complicated injectivity annotations. For example we could declare that\nif we know the result of Plus and one of its arguments we can determine the\nother argument:\n\n   type family Plus a b = (r :: Nat) | r a -> b, r b -> a where ...\n\nHere injectivity annotation would consist of two comma-separated injectivity\nconditions.\n\nSee also Note [Injective type families] in TyCon\n-}\n\n-- | Located type Family Result Signature\ntype LFamilyResultSig pass = Located (FamilyResultSig pass)\n\n-- | type Family Result Signature\ndata FamilyResultSig pass = -- see Note [FamilyResultSig]\n    NoSig (XNoSig pass)\n  -- ^ - 'ApiAnnotation.AnnKeywordId' :\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | KindSig  (XCKindSig pass) (LHsKind pass)\n  -- ^ - 'ApiAnnotation.AnnKeywordId' :\n  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',\n  --             'ApiAnnotation.AnnCloseP'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)\n  -- ^ - 'ApiAnnotation.AnnKeywordId' :\n  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',\n  --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'\n  | XFamilyResultSig (XXFamilyResultSig pass)\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n\ntype instance XNoSig            (GhcPass _) = NoExt\ntype instance XCKindSig         (GhcPass _) = NoExt\ntype instance XTyVarSig         (GhcPass _) = NoExt\ntype instance XXFamilyResultSig (GhcPass _) = NoExt\n\n\n-- | Located type Family Declaration\ntype LFamilyDecl pass = Located (FamilyDecl pass)\n\n-- | type Family Declaration\ndata FamilyDecl pass = FamilyDecl\n  { fdExt            :: XCFamilyDecl pass\n  , fdInfo           :: FamilyInfo pass              -- type/data, closed/open\n  , fdLName          :: Located (IdP pass)           -- type constructor\n  , fdTyVars         :: LHsQTyVars pass              -- type variables\n                       -- See Note [TyVar binders for associated declarations]\n  , fdFixity         :: LexicalFixity                -- Fixity used in the declaration\n  , fdResultSig      :: LFamilyResultSig pass        -- result signature\n  , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann\n  }\n  | XFamilyDecl (XXFamilyDecl pass)\n  -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',\n  --             'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',\n  --             'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',\n  --             'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnCloseP',\n  --             'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',\n  --             'ApiAnnotation.AnnVbar'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n\ntype instance XCFamilyDecl    (GhcPass _) = NoExt\ntype instance XXFamilyDecl    (GhcPass _) = NoExt\n\n\n-- | Located Injectivity Annotation\ntype LInjectivityAnn pass = Located (InjectivityAnn pass)\n\n-- | If the user supplied an injectivity annotation it is represented using\n-- InjectivityAnn. At the moment this is a single injectivity condition - see\n-- Note [Injectivity annotation]. `Located name` stores the LHS of injectivity\n-- condition. `[Located name]` stores the RHS of injectivity condition. Example:\n--\n--   type family Foo a b c = r | r -> a c where ...\n--\n-- This will be represented as \"InjectivityAnn `r` [`a`, `c`]\"\ndata InjectivityAnn pass\n  = InjectivityAnn (Located (IdP pass)) [Located (IdP pass)]\n  -- ^ - 'ApiAnnotation.AnnKeywordId' :\n  --             'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n\ndata FamilyInfo pass\n  = DataFamily\n  | OpenTypeFamily\n     -- | 'Nothing' if we're in an hs-boot file and the user\n     -- said \"type family Foo x where ..\"\n  | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])\n\n-- | Does this family declaration have a complete, user-supplied kind signature?\n-- See Note [CUSKs: complete user-supplied kind signatures]\nfamDeclHasCusk :: Bool -- ^ True <=> this is an associated type family,\n                       --            and the parent class has /no/ CUSK\n               -> FamilyDecl pass\n               -> Bool\nfamDeclHasCusk assoc_with_no_cusk\n               (FamilyDecl { fdInfo      = fam_info\n                           , fdTyVars    = tyvars\n                           , fdResultSig = L _ resultSig })\n  = case fam_info of\n      ClosedTypeFamily {} -> hsTvbAllKinded tyvars\n                          && hasReturnKindSignature resultSig\n      _ -> not assoc_with_no_cusk\n            -- Un-associated open type/data families have CUSKs\n            -- Associated type families have CUSKs iff the parent class does\n\nfamDeclHasCusk _ (XFamilyDecl {}) = panic \"famDeclHasCusk\"\n\n-- | Does this family declaration have user-supplied return kind signature?\nhasReturnKindSignature :: FamilyResultSig a -> Bool\nhasReturnKindSignature (NoSig _)                        = False\nhasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False\nhasReturnKindSignature _                                = True\n\n-- | Maybe return name of the result type variable\nresultVariableName :: FamilyResultSig a -> Maybe (IdP a)\nresultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig\nresultVariableName _                = Nothing\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (FamilyDecl p) where\n  ppr = pprFamilyDecl TopLevel\n\npprFamilyDecl :: (OutputableBndrId (GhcPass p))\n              => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc\npprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon\n                                    , fdTyVars = tyvars\n                                    , fdFixity = fixity\n                                    , fdResultSig = L _ result\n                                    , fdInjectivityAnn = mb_inj })\n  = vcat [ pprFlavour info <+> pp_top_level <+>\n           pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+>\n           pp_kind <+> pp_inj <+> pp_where\n         , nest 2 $ pp_eqns ]\n  where\n    pp_top_level = case top_level of\n                     TopLevel    -> text \"family\"\n                     NotTopLevel -> empty\n\n    pp_kind = case result of\n                NoSig    _         -> empty\n                KindSig  _ kind    -> dcolon <+> ppr kind\n                TyVarSig _ tv_bndr -> text \"=\" <+> ppr tv_bndr\n                XFamilyResultSig x -> ppr x\n    pp_inj = case mb_inj of\n               Just (L _ (InjectivityAnn lhs rhs)) ->\n                 hsep [ vbar, ppr lhs, text \"->\", hsep (map ppr rhs) ]\n               Nothing -> empty\n    (pp_where, pp_eqns) = case info of\n      ClosedTypeFamily mb_eqns ->\n        ( text \"where\"\n        , case mb_eqns of\n            Nothing   -> text \"..\"\n            Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )\n      _ -> (empty, empty)\npprFamilyDecl _ (XFamilyDecl x) = ppr x\n\npprFlavour :: FamilyInfo pass -> SDoc\npprFlavour DataFamily            = text \"data\"\npprFlavour OpenTypeFamily        = text \"type\"\npprFlavour (ClosedTypeFamily {}) = text \"type\"\n\ninstance Outputable (FamilyInfo pass) where\n  ppr info = pprFlavour info <+> text \"family\"\n\n\n\n{- *********************************************************************\n*                                                                      *\n               Data types and data constructors\n*                                                                      *\n********************************************************************* -}\n\n-- | Haskell Data type Definition\ndata HsDataDefn pass   -- The payload of a data type defn\n                       -- Used *both* for vanilla data declarations,\n                       --       *and* for data family instances\n  = -- | Declares a data type or newtype, giving its constructors\n    -- @\n    --  data/newtype T a = <constrs>\n    --  data/newtype instance T [a] = <constrs>\n    -- @\n    HsDataDefn { dd_ext    :: XCHsDataDefn pass,\n                 dd_ND     :: NewOrData,\n                 dd_ctxt   :: LHsContext pass,           -- ^ Context\n                 dd_cType  :: Maybe (Located CType),\n                 dd_kindSig:: Maybe (LHsKind pass),\n                     -- ^ Optional kind signature.\n                     --\n                     -- @(Just k)@ for a GADT-style @data@,\n                     -- or @data instance@ decl, with explicit kind sig\n                     --\n                     -- Always @Nothing@ for H98-syntax decls\n\n                 dd_cons   :: [LConDecl pass],\n                     -- ^ Data constructors\n                     --\n                     -- For @data T a = T1 | T2 a@\n                     --   the 'LConDecl's all have 'ConDeclH98'.\n                     -- For @data T a where { T1 :: T a }@\n                     --   the 'LConDecls' all have 'ConDeclGADT'.\n\n                 dd_derivs :: HsDeriving pass  -- ^ Optional 'deriving' claues\n\n             -- For details on above see note [Api annotations] in ApiAnnotation\n   }\n  | XHsDataDefn (XXHsDataDefn pass)\n\ntype instance XCHsDataDefn    (GhcPass _) = NoExt\ntype instance XXHsDataDefn    (GhcPass _) = NoExt\n\n-- | Haskell Deriving clause\ntype HsDeriving pass = Located [LHsDerivingClause pass]\n  -- ^ The optional @deriving@ clauses of a data declaration. \"Clauses\" is\n  -- plural because one can specify multiple deriving clauses using the\n  -- @-XDerivingStrategies@ language extension.\n  --\n  -- The list of 'LHsDerivingClause's corresponds to exactly what the user\n  -- requested to derive, in order. If no deriving clauses were specified,\n  -- the list is empty.\n\ntype LHsDerivingClause pass = Located (HsDerivingClause pass)\n\n-- | A single @deriving@ clause of a data declaration.\n--\n--  - 'ApiAnnotation.AnnKeywordId' :\n--       'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',\n--       'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',\n--       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'\ndata HsDerivingClause pass\n  -- See Note [Deriving strategies] in TcDeriv\n  = HsDerivingClause\n    { deriv_clause_ext :: XCHsDerivingClause pass\n    , deriv_clause_strategy :: Maybe (LDerivStrategy pass)\n      -- ^ The user-specified strategy (if any) to use when deriving\n      -- 'deriv_clause_tys'.\n    , deriv_clause_tys :: Located [LHsSigType pass]\n      -- ^ The types to derive.\n      --\n      -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,\n      -- we can mention type variables that aren't bound by the datatype, e.g.\n      --\n      -- > data T b = ... deriving (C [a])\n      --\n      -- should produce a derived instance for @C [a] (T b)@.\n    }\n  | XHsDerivingClause (XXHsDerivingClause pass)\n\ntype instance XCHsDerivingClause    (GhcPass _) = NoExt\ntype instance XXHsDerivingClause    (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (HsDerivingClause p) where\n  ppr (HsDerivingClause { deriv_clause_strategy = dcs\n                        , deriv_clause_tys      = L _ dct })\n    = hsep [ text \"deriving\"\n           , pp_strat_before\n           , pp_dct dct\n           , pp_strat_after ]\n      where\n        -- This complexity is to distinguish between\n        --    deriving Show\n        --    deriving (Show)\n        pp_dct [HsIB { hsib_body = ty }]\n                 = ppr (parenthesizeHsType appPrec ty)\n        pp_dct _ = parens (interpp'SP dct)\n\n        -- @via@ is unique in that in comes /after/ the class being derived,\n        -- so we must special-case it.\n        (pp_strat_before, pp_strat_after) =\n          case dcs of\n            Just (L _ via@ViaStrategy{}) -> (empty, ppr via)\n            _                            -> (ppDerivStrategy dcs, empty)\n  ppr (XHsDerivingClause x) = ppr x\n\ndata NewOrData\n  = NewType                     -- ^ @newtype Blah ...@\n  | DataType                    -- ^ @data Blah ...@\n  deriving( Eq, Data )                -- Needed because Demand derives Eq\n\n-- | Convert a 'NewOrData' to a 'TyConFlavour'\nnewOrDataToFlavour :: NewOrData -> TyConFlavour\nnewOrDataToFlavour NewType  = NewtypeFlavour\nnewOrDataToFlavour DataType = DataTypeFlavour\n\n-- | Located data Constructor Declaration\ntype LConDecl pass = Located (ConDecl pass)\n      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when\n      --   in a GADT constructor list\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n\n-- |\n--\n-- @\n-- data T b = forall a. Eq a => MkT a b\n--   MkT :: forall b a. Eq a => MkT a b\n--\n-- data T b where\n--      MkT1 :: Int -> T Int\n--\n-- data T = Int `MkT` Int\n--        | MkT2\n--\n-- data T a where\n--      Int `MkT` Int :: T Int\n-- @\n--\n-- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',\n--            'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnCLose',\n--            'ApiAnnotation.AnnEqual','ApiAnnotation.AnnVbar',\n--            'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow',\n--            'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot'\n\n-- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | data Constructor Declaration\ndata ConDecl pass\n  = ConDeclGADT\n      { con_g_ext   :: XConDeclGADT pass\n      , con_names   :: [Located (IdP pass)]\n\n      -- The next four fields describe the type after the '::'\n      -- See Note [GADT abstract syntax]\n      -- The following field is Located to anchor API Annotations,\n      -- AnnForall and AnnDot.\n      , con_forall  :: Located Bool      -- ^ True <=> explicit forall\n                                         --   False => hsq_explicit is empty\n      , con_qvars   :: LHsQTyVars pass\n                       -- Whether or not there is an /explicit/ forall, we still\n                       -- need to capture the implicitly-bound type/kind variables\n\n      , con_mb_cxt  :: Maybe (LHsContext pass) -- ^ User-written context (if any)\n      , con_args    :: HsConDeclDetails pass   -- ^ Arguments; never InfixCon\n      , con_res_ty  :: LHsType pass            -- ^ Result type\n\n      , con_doc     :: Maybe LHsDocString\n          -- ^ A possible Haddock comment.\n      }\n\n  | ConDeclH98\n      { con_ext     :: XConDeclH98 pass\n      , con_name    :: Located (IdP pass)\n\n      , con_forall  :: Located Bool\n                              -- ^ True <=> explicit user-written forall\n                              --     e.g. data T a = forall b. MkT b (b->a)\n                              --     con_ex_tvs = {b}\n                              -- False => con_ex_tvs is empty\n      , con_ex_tvs :: [LHsTyVarBndr pass]      -- ^ Existentials only\n      , con_mb_cxt :: Maybe (LHsContext pass)  -- ^ User-written context (if any)\n      , con_args   :: HsConDeclDetails pass    -- ^ Arguments; can be InfixCon\n\n      , con_doc       :: Maybe LHsDocString\n          -- ^ A possible Haddock comment.\n      }\n  | XConDecl (XXConDecl pass)\n\ntype instance XConDeclGADT (GhcPass _) = NoExt\ntype instance XConDeclH98  (GhcPass _) = NoExt\ntype instance XXConDecl    (GhcPass _) = NoExt\n\n{- Note [GADT abstract syntax]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere's a wrinkle in ConDeclGADT\n\n* For record syntax, it's all uniform.  Given:\n      data T a where\n        K :: forall a. Ord a => { x :: [a], ... } -> T a\n    we make the a ConDeclGADT for K with\n       con_qvars  = {a}\n       con_mb_cxt = Just [Ord a]\n       con_args   = RecCon <the record fields>\n       con_res_ty = T a\n\n  We need the RecCon before the reanmer, so we can find the record field\n  binders in HsUtils.hsConDeclsBinders.\n\n* However for a GADT constr declaration which is not a record, it can\n  be hard parse until we know operator fixities. Consider for example\n     C :: a :*: b -> a :*: b -> a :+: b\n  Initially this type will parse as\n      a :*: (b -> (a :*: (b -> (a :+: b))))\n  so it's hard to split up the arguments until we've done the precedence\n  resolution (in the renamer).\n\n  So:  - In the parser (RdrHsSyn.mkGadtDecl), we put the whole constr\n         type into the res_ty for a ConDeclGADT for now, and use\n         PrefixCon []\n            con_args   = PrefixCon []\n            con_res_ty = a :*: (b -> (a :*: (b -> (a :+: b))))\n\n       - In the renamer (RnSource.rnConDecl), we unravel it afer\n         operator fixities are sorted. So we generate. So we end\n         up with\n            con_args   = PrefixCon [ a :*: b, a :*: b ]\n            con_res_ty = a :+: b\n-}\n\n-- | Haskell data Constructor Declaration Details\ntype HsConDeclDetails pass\n   = HsConDetails (LBangType pass) (Located [LConDeclField pass])\n\ngetConNames :: ConDecl pass -> [Located (IdP pass)]\ngetConNames ConDeclH98  {con_name  = name}  = [name]\ngetConNames ConDeclGADT {con_names = names} = names\ngetConNames XConDecl {} = panic \"getConNames\"\n\ngetConArgs :: ConDecl pass -> HsConDeclDetails pass\ngetConArgs d = con_args d\n\nhsConDeclArgTys :: HsConDeclDetails pass -> [LBangType pass]\nhsConDeclArgTys (PrefixCon tys)    = tys\nhsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]\nhsConDeclArgTys (RecCon flds)      = map (cd_fld_type . unLoc) (unLoc flds)\n\nhsConDeclTheta :: Maybe (LHsContext pass) -> [LHsType pass]\nhsConDeclTheta Nothing            = []\nhsConDeclTheta (Just (L _ theta)) = theta\n\npp_data_defn :: (OutputableBndrId (GhcPass p))\n                  => (LHsContext (GhcPass p) -> SDoc)   -- Printing the header\n                  -> HsDataDefn (GhcPass p)\n                  -> SDoc\npp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context\n                                , dd_cType = mb_ct\n                                , dd_kindSig = mb_sig\n                                , dd_cons = condecls, dd_derivs = derivings })\n  | null condecls\n  = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig\n    <+> pp_derivings derivings\n\n  | otherwise\n  = hang (ppr new_or_data <+> pp_ct  <+> pp_hdr context <+> pp_sig)\n       2 (pp_condecls condecls $$ pp_derivings derivings)\n  where\n    pp_ct = case mb_ct of\n               Nothing   -> empty\n               Just ct -> ppr ct\n    pp_sig = case mb_sig of\n               Nothing   -> empty\n               Just kind -> dcolon <+> ppr kind\n    pp_derivings (L _ ds) = vcat (map ppr ds)\npp_data_defn _ (XHsDataDefn x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (HsDataDefn p) where\n   ppr d = pp_data_defn (\\_ -> text \"Naked HsDataDefn\") d\n\ninstance Outputable NewOrData where\n  ppr NewType  = text \"newtype\"\n  ppr DataType = text \"data\"\n\npp_condecls :: (OutputableBndrId (GhcPass p)) => [LConDecl (GhcPass p)] -> SDoc\npp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax\n  = hang (text \"where\") 2 (vcat (map ppr cs))\npp_condecls cs                    -- In H98 syntax\n  = equals <+> sep (punctuate (text \" |\") (map ppr cs))\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDecl p) where\n    ppr = pprConDecl\n\npprConDecl :: (OutputableBndrId (GhcPass p)) => ConDecl (GhcPass p) -> SDoc\npprConDecl (ConDeclH98 { con_name = L _ con\n                       , con_ex_tvs = ex_tvs\n                       , con_mb_cxt = mcxt\n                       , con_args = args\n                       , con_doc = doc })\n  = sep [ppr_mbDoc doc, pprHsForAll ForallInvis ex_tvs cxt, ppr_details args]\n  where\n    ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2]\n    ppr_details (PrefixCon tys)  = hsep (pprPrefixOcc con\n                                   : map (pprHsType . unLoc) tys)\n    ppr_details (RecCon fields)  = pprPrefixOcc con\n                                 <+> pprConDeclFields (unLoc fields)\n    cxt = fromMaybe noLHsContext mcxt\n\npprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars\n                        , con_mb_cxt = mcxt, con_args = args\n                        , con_res_ty = res_ty, con_doc = doc })\n  = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon\n    <+> (sep [pprHsForAll ForallInvis (hsq_explicit qvars) cxt,\n              ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])\n  where\n    get_args (PrefixCon args) = map ppr args\n    get_args (RecCon fields)  = [pprConDeclFields (unLoc fields)]\n    get_args (InfixCon {})    = pprPanic \"pprConDecl:GADT\" (ppr cons)\n\n    cxt = fromMaybe noLHsContext mcxt\n\n    ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)\n    ppr_arrow_chain []     = empty\n\npprConDecl (XConDecl x) = ppr x\n\nppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc\nppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)\n\n{-\n************************************************************************\n*                                                                      *\n                Instance declarations\n*                                                                      *\n************************************************************************\n\nNote [Type family instance declarations in HsSyn]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe data type FamEqn represents one equation of a type family instance.\nAside from the pass, it is also parameterised over two fields:\nfeqn_pats and feqn_rhs.\n\nfeqn_pats is either LHsTypes (for ordinary data/type family instances) or\nLHsQTyVars (for associated type family default instances). In particular:\n\n * An ordinary type family instance declaration looks like this in source Haskell\n      type instance T [a] Int = a -> a\n   (or something similar for a closed family)\n   It is represented by a FamInstEqn, with a *type* (LHsType) in the feqn_pats\n   field.\n\n * On the other hand, the *default instance* of an associated type looks like\n   this in source Haskell\n      class C a where\n        type T a b\n        type T a b = a -> b   -- The default instance\n   It is represented by a TyFamDefltEqn, with *type variables* (LHsQTyVars) in\n   the feqn_pats field.\n\nfeqn_rhs is either an HsDataDefn (for data family instances) or an LHsType\n(for type family instances).\n-}\n\n----------------- Type synonym family instances -------------\n\n-- | Located Type Family Instance Equation\ntype LTyFamInstEqn pass = Located (TyFamInstEqn pass)\n  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'\n  --   when in a list\n\n-- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Located Type Family Default Equation\ntype LTyFamDefltEqn pass = Located (TyFamDefltEqn pass)\n\n-- | Haskell Type Patterns\ntype HsTyPats pass = [LHsTypeArg pass]\n\n{- Note [Family instance declaration binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor ordinary data/type family instances, the feqn_pats field of FamEqn stores\nthe LHS type (and kind) patterns. Any type (and kind) variables contained\nin these type patterns are bound in the hsib_vars field of the HsImplicitBndrs\nin FamInstEqn depending on whether or not an explicit forall is present. In\nthe case of an explicit forall, the hsib_vars only includes kind variables not\nbound in the forall. Otherwise, all type (and kind) variables are bound in\nthe hsib_vars. In the latter case, note that in particular\n\n* The hsib_vars *includes* any anonymous wildcards.  For example\n     type instance F a _ = a\n  The hsib_vars will be {a, _}.  Remember that each separate wildcard\n  '_' gets its own unique.  In this context wildcards behave just like\n  an ordinary type variable, only anonymous.\n\n* The hsib_vars *includes* type variables that are already in scope\n\n   Eg   class C s t where\n          type F t p :: *\n        instance C w (a,b) where\n          type F (a,b) x = x->a\n   The hsib_vars of the F decl are {a,b,x}, even though the F decl\n   is nested inside the 'instance' decl.\n\n   However after the renamer, the uniques will match up:\n        instance C w7 (a8,b9) where\n          type F (a8,b9) x10 = x10->a8\n   so that we can compare the type pattern in the 'instance' decl and\n   in the associated 'type' decl\n\nFor associated type family default instances (TyFamDefltEqn), instead of using\ntype patterns with binders in a surrounding HsImplicitBndrs, we use raw type\nvariables (LHsQTyVars) in the feqn_pats field of FamEqn.\n\nc.f. Note [TyVar binders for associated declarations]\n-}\n\n-- | Type Family Instance Equation\ntype TyFamInstEqn pass = FamInstEqn pass (LHsType pass)\n\n-- | Type Family Default Equation\ntype TyFamDefltEqn pass = FamEqn pass (LHsQTyVars pass) (LHsType pass)\n  -- See Note [Type family instance declarations in HsSyn]\n\n-- | Located Type Family Instance Declaration\ntype LTyFamInstDecl pass = Located (TyFamInstDecl pass)\n\n-- | Type Family Instance Declaration\nnewtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }\n    -- ^\n    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',\n    --           'ApiAnnotation.AnnInstance',\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n----------------- Data family instances -------------\n\n-- | Located Data Family Instance Declaration\ntype LDataFamInstDecl pass = Located (DataFamInstDecl pass)\n\n-- | Data Family Instance Declaration\nnewtype DataFamInstDecl pass\n  = DataFamInstDecl { dfid_eqn :: FamInstEqn pass (HsDataDefn pass) }\n    -- ^\n    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',\n    --           'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',\n    --           'ApiAnnotation.AnnDcolon'\n    --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',\n    --           'ApiAnnotation.AnnClose'\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n----------------- Family instances (common types) -------------\n\n-- | Located Family Instance Equation\ntype LFamInstEqn pass rhs = Located (FamInstEqn pass rhs)\n\n-- | Family Instance Equation\ntype FamInstEqn pass rhs\n  = HsImplicitBndrs pass (FamEqn pass (HsTyPats pass) rhs)\n            -- ^ Here, the @pats@ are type patterns (with kind and type bndrs).\n            -- See Note [Family instance declaration binders]\n\n-- | Family Equation\n--\n-- One equation in a type family instance declaration, data family instance\n-- declaration, or type family default.\n-- See Note [Type family instance declarations in HsSyn]\n-- See Note [Family instance declaration binders]\ndata FamEqn pass pats rhs\n  = FamEqn\n       { feqn_ext    :: XCFamEqn pass pats rhs\n       , feqn_tycon  :: Located (IdP pass)\n       , feqn_bndrs  :: Maybe [LHsTyVarBndr pass] -- ^ Optional quantified type vars\n       , feqn_pats   :: pats\n       , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration\n       , feqn_rhs    :: rhs\n       }\n    -- ^\n    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'\n  | XFamEqn (XXFamEqn pass pats rhs)\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\ntype instance XCFamEqn    (GhcPass _) p r = NoExt\ntype instance XXFamEqn    (GhcPass _) p r = NoExt\n\n----------------- Class instances -------------\n\n-- | Located Class Instance Declaration\ntype LClsInstDecl pass = Located (ClsInstDecl pass)\n\n-- | Class Instance Declaration\ndata ClsInstDecl pass\n  = ClsInstDecl\n      { cid_ext     :: XCClsInstDecl pass\n      , cid_poly_ty :: LHsSigType pass    -- Context => Class Instance-type\n                                          -- Using a polytype means that the renamer conveniently\n                                          -- figures out the quantified type variables for us.\n      , cid_binds         :: LHsBinds pass       -- Class methods\n      , cid_sigs          :: [LSig pass]         -- User-supplied pragmatic info\n      , cid_tyfam_insts   :: [LTyFamInstDecl pass]   -- Type family instances\n      , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances\n      , cid_overlap_mode  :: Maybe (Located OverlapMode)\n         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n         --                                    'ApiAnnotation.AnnClose',\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n      }\n    -- ^\n    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance',\n    --           'ApiAnnotation.AnnWhere',\n    --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n  | XClsInstDecl (XXClsInstDecl pass)\n\ntype instance XCClsInstDecl    (GhcPass _) = NoExt\ntype instance XXClsInstDecl    (GhcPass _) = NoExt\n\n----------------- Instances of all kinds -------------\n\n-- | Located Instance Declaration\ntype LInstDecl pass = Located (InstDecl pass)\n\n-- | Instance Declaration\ndata InstDecl pass  -- Both class and family instances\n  = ClsInstD\n      { cid_d_ext :: XClsInstD pass\n      , cid_inst  :: ClsInstDecl pass }\n  | DataFamInstD              -- data family instance\n      { dfid_ext  :: XDataFamInstD pass\n      , dfid_inst :: DataFamInstDecl pass }\n  | TyFamInstD              -- type family instance\n      { tfid_ext  :: XTyFamInstD pass\n      , tfid_inst :: TyFamInstDecl pass }\n  | XInstDecl (XXInstDecl pass)\n\ntype instance XClsInstD     (GhcPass _) = NoExt\ntype instance XDataFamInstD (GhcPass _) = NoExt\ntype instance XTyFamInstD   (GhcPass _) = NoExt\ntype instance XXInstDecl    (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (TyFamInstDecl p) where\n  ppr = pprTyFamInstDecl TopLevel\n\npprTyFamInstDecl :: (OutputableBndrId (GhcPass p))\n                 => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc\npprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })\n   = text \"type\" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn\n\nppr_instance_keyword :: TopLevelFlag -> SDoc\nppr_instance_keyword TopLevel    = text \"instance\"\nppr_instance_keyword NotTopLevel = empty\n\nppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))\n                 => TyFamInstEqn (GhcPass p) -> SDoc\nppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon  = L _ tycon\n                                            , feqn_bndrs  = bndrs\n                                            , feqn_pats   = pats\n                                            , feqn_fixity = fixity\n                                            , feqn_rhs    = rhs }})\n    = pprHsFamInstLHS tycon bndrs pats fixity noLHsContext <+> equals <+> ppr rhs\nppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x\nppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x\n\nppr_fam_deflt_eqn :: (OutputableBndrId (GhcPass p))\n                  => LTyFamDefltEqn (GhcPass p) -> SDoc\nppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon  = tycon\n                               , feqn_pats   = tvs\n                               , feqn_fixity = fixity\n                               , feqn_rhs    = rhs }))\n    = text \"type\" <+> pp_vanilla_decl_head tycon tvs fixity noLHsContext\n                  <+> equals <+> ppr rhs\nppr_fam_deflt_eqn (L _ (XFamEqn x)) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (DataFamInstDecl p) where\n  ppr = pprDataFamInstDecl TopLevel\n\npprDataFamInstDecl :: (OutputableBndrId (GhcPass p))\n                   => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc\npprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n                             FamEqn { feqn_tycon  = L _ tycon\n                                    , feqn_bndrs  = bndrs\n                                    , feqn_pats   = pats\n                                    , feqn_fixity = fixity\n                                    , feqn_rhs    = defn }}})\n  = pp_data_defn pp_hdr defn\n  where\n    pp_hdr ctxt = ppr_instance_keyword top_lvl\n              <+> pprHsFamInstLHS tycon bndrs pats fixity ctxt\n                  -- pp_data_defn pretty-prints the kind sig. See #14817.\n\npprDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn x)))\n  = ppr x\npprDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs x))\n  = ppr x\n\npprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc\npprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n                        FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})\n  = ppr nd\npprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n                        FamEqn { feqn_rhs = XHsDataDefn x}}})\n  = ppr x\npprDataFamInstFlavour (DataFamInstDecl (HsIB _ (XFamEqn x)))\n  = ppr x\npprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x))\n  = ppr x\n\npprHsFamInstLHS :: (OutputableBndrId (GhcPass p))\n   => IdP (GhcPass p)\n   -> Maybe [LHsTyVarBndr (GhcPass p)]\n   -> HsTyPats (GhcPass p)\n   -> LexicalFixity\n   -> LHsContext (GhcPass p)\n   -> SDoc\npprHsFamInstLHS thing bndrs typats fixity mb_ctxt\n   = hsep [ pprHsExplicitForAll ForallInvis bndrs\n          , pprLHsContext mb_ctxt\n          , pp_pats typats ]\n   where\n     pp_pats (patl:patr:pats)\n       | Infix <- fixity\n       = let pp_op_app = hsep [ ppr patl, pprInfixOcc thing, ppr patr ] in\n         case pats of\n           [] -> pp_op_app\n           _  -> hsep (parens pp_op_app : map ppr pats)\n\n     pp_pats pats = hsep [ pprPrefixOcc thing\n                         , hsep (map ppr pats)]\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (ClsInstDecl p) where\n    ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds\n                     , cid_sigs = sigs, cid_tyfam_insts = ats\n                     , cid_overlap_mode = mbOverlap\n                     , cid_datafam_insts = adts })\n      | null sigs, null ats, null adts, isEmptyBag binds  -- No \"where\" part\n      = top_matter\n\n      | otherwise       -- Laid out\n      = vcat [ top_matter <+> text \"where\"\n             , nest 2 $ pprDeclList $\n               map (pprTyFamInstDecl NotTopLevel . unLoc)   ats ++\n               map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++\n               pprLHsBindsForUser binds sigs ]\n      where\n        top_matter = text \"instance\" <+> ppOverlapPragma mbOverlap\n                                             <+> ppr inst_ty\n    ppr (XClsInstDecl x) = ppr x\n\nppDerivStrategy :: (p ~ GhcPass pass, OutputableBndrId p)\n                => Maybe (LDerivStrategy p) -> SDoc\nppDerivStrategy mb =\n  case mb of\n    Nothing       -> empty\n    Just (L _ ds) -> ppr ds\n\nppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc\nppOverlapPragma mb =\n  case mb of\n    Nothing           -> empty\n    Just (L _ (NoOverlap s))    -> maybe_stext s \"{-# NO_OVERLAP #-}\"\n    Just (L _ (Overlappable s)) -> maybe_stext s \"{-# OVERLAPPABLE #-}\"\n    Just (L _ (Overlapping s))  -> maybe_stext s \"{-# OVERLAPPING #-}\"\n    Just (L _ (Overlaps s))     -> maybe_stext s \"{-# OVERLAPS #-}\"\n    Just (L _ (Incoherent s))   -> maybe_stext s \"{-# INCOHERENT #-}\"\n  where\n    maybe_stext NoSourceText     alt = text alt\n    maybe_stext (SourceText src) _   = text src <+> text \"#-}\"\n\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where\n    ppr (ClsInstD     { cid_inst  = decl }) = ppr decl\n    ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl\n    ppr (DataFamInstD { dfid_inst = decl }) = ppr decl\n    ppr (XInstDecl x) = ppr x\n\n-- Extract the declarations of associated data types from an instance\n\ninstDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]\ninstDeclDataFamInsts inst_decls\n  = concatMap do_one inst_decls\n  where\n    do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } }))\n      = map unLoc fam_insts\n    do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]\n    do_one (L _ (TyFamInstD {}))                              = []\n    do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic \"instDeclDataFamInsts\"\n    do_one (L _ (XInstDecl _))                 = panic \"instDeclDataFamInsts\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DerivDecl]{A stand-alone instance deriving declaration}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located stand-alone 'deriving instance' declaration\ntype LDerivDecl pass = Located (DerivDecl pass)\n\n-- | Stand-alone 'deriving instance' declaration\ndata DerivDecl pass = DerivDecl\n        { deriv_ext          :: XCDerivDecl pass\n        , deriv_type         :: LHsSigWcType pass\n          -- ^ The instance type to derive.\n          --\n          -- It uses an 'LHsSigWcType' because the context is allowed to be a\n          -- single wildcard:\n          --\n          -- > deriving instance _ => Eq (Foo a)\n          --\n          -- Which signifies that the context should be inferred.\n\n          -- See Note [Inferring the instance context] in TcDerivInfer.\n\n        , deriv_strategy     :: Maybe (LDerivStrategy pass)\n        , deriv_overlap_mode :: Maybe (Located OverlapMode)\n         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',\n         --        'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',\n         --        'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',\n         --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n        }\n  | XDerivDecl (XXDerivDecl pass)\n\ntype instance XCDerivDecl    (GhcPass _) = NoExt\ntype instance XXDerivDecl    (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (DerivDecl p) where\n    ppr (DerivDecl { deriv_type = ty\n                   , deriv_strategy = ds\n                   , deriv_overlap_mode = o })\n        = hsep [ text \"deriving\"\n               , ppDerivStrategy ds\n               , text \"instance\"\n               , ppOverlapPragma o\n               , ppr ty ]\n    ppr (XDerivDecl x) = ppr x\n\n{-\n************************************************************************\n*                                                                      *\n                Deriving strategies\n*                                                                      *\n************************************************************************\n-}\n\n-- | A 'Located' 'DerivStrategy'.\ntype LDerivStrategy pass = Located (DerivStrategy pass)\n\n-- | Which technique the user explicitly requested when deriving an instance.\ndata DerivStrategy pass\n  -- See Note [Deriving strategies] in TcDeriv\n  = StockStrategy    -- ^ GHC's \\\"standard\\\" strategy, which is to implement a\n                     --   custom instance for the data type. This only works\n                     --   for certain types that GHC knows about (e.g., 'Eq',\n                     --   'Show', 'Functor' when @-XDeriveFunctor@ is enabled,\n                     --   etc.)\n  | AnyclassStrategy -- ^ @-XDeriveAnyClass@\n  | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@\n  | ViaStrategy (XViaStrategy pass)\n                     -- ^ @-XDerivingVia@\n\ntype instance XViaStrategy GhcPs = LHsSigType GhcPs\ntype instance XViaStrategy GhcRn = LHsSigType GhcRn\ntype instance XViaStrategy GhcTc = Type\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n        => Outputable (DerivStrategy p) where\n    ppr StockStrategy    = text \"stock\"\n    ppr AnyclassStrategy = text \"anyclass\"\n    ppr NewtypeStrategy  = text \"newtype\"\n    ppr (ViaStrategy ty) = text \"via\" <+> ppr ty\n\n-- | A short description of a @DerivStrategy'@.\nderivStrategyName :: DerivStrategy a -> SDoc\nderivStrategyName = text . go\n  where\n    go StockStrategy    = \"stock\"\n    go AnyclassStrategy = \"anyclass\"\n    go NewtypeStrategy  = \"newtype\"\n    go (ViaStrategy {}) = \"via\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DefaultDecl]{A @default@ declaration}\n*                                                                      *\n************************************************************************\n\nThere can only be one default declaration per module, but it is hard\nfor the parser to check that; we pass them all through in the abstract\nsyntax, and that restriction must be checked in the front end.\n-}\n\n-- | Located Default Declaration\ntype LDefaultDecl pass = Located (DefaultDecl pass)\n\n-- | Default Declaration\ndata DefaultDecl pass\n  = DefaultDecl (XCDefaultDecl pass) [LHsType pass]\n        -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',\n        --          'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | XDefaultDecl (XXDefaultDecl pass)\n\ntype instance XCDefaultDecl    (GhcPass _) = NoExt\ntype instance XXDefaultDecl    (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (DefaultDecl p) where\n    ppr (DefaultDecl _ tys)\n      = text \"default\" <+> parens (interpp'SP tys)\n    ppr (XDefaultDecl x) = ppr x\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Foreign function interface declaration}\n*                                                                      *\n************************************************************************\n-}\n\n-- foreign declarations are distinguished as to whether they define or use a\n-- Haskell name\n--\n--  * the Boolean value indicates whether the pre-standard deprecated syntax\n--   has been used\n\n-- | Located Foreign Declaration\ntype LForeignDecl pass = Located (ForeignDecl pass)\n\n-- | Foreign Declaration\ndata ForeignDecl pass\n  = ForeignImport\n      { fd_i_ext  :: XForeignImport pass   -- Post typechecker, rep_ty ~ sig_ty\n      , fd_name   :: Located (IdP pass)    -- defines this name\n      , fd_sig_ty :: LHsSigType pass       -- sig_ty\n      , fd_fi     :: ForeignImport }\n\n  | ForeignExport\n      { fd_e_ext  :: XForeignExport pass   -- Post typechecker, rep_ty ~ sig_ty\n      , fd_name   :: Located (IdP pass)    -- uses this name\n      , fd_sig_ty :: LHsSigType pass       -- sig_ty\n      , fd_fe     :: ForeignExport }\n        -- ^\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',\n        --           'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport',\n        --           'ApiAnnotation.AnnDcolon'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | XForeignDecl (XXForeignDecl pass)\n\n{-\n    In both ForeignImport and ForeignExport:\n        sig_ty is the type given in the Haskell code\n        rep_ty is the representation for this type, i.e. with newtypes\n               coerced away and type functions evaluated.\n    Thus if the declaration is valid, then rep_ty will only use types\n    such as Int and IO that we know how to make foreign calls with.\n-}\n\ntype instance XForeignImport   GhcPs = NoExt\ntype instance XForeignImport   GhcRn = NoExt\ntype instance XForeignImport   GhcTc = Coercion\n\ntype instance XForeignExport   GhcPs = NoExt\ntype instance XForeignExport   GhcRn = NoExt\ntype instance XForeignExport   GhcTc = Coercion\n\ntype instance XXForeignDecl    (GhcPass _) = NoExt\n\n-- Specification Of an imported external entity in dependence on the calling\n-- convention\n--\ndata ForeignImport = -- import of a C entity\n                     --\n                     --  * the two strings specifying a header file or library\n                     --   may be empty, which indicates the absence of a\n                     --   header or object specification (both are not used\n                     --   in the case of `CWrapper' and when `CFunction'\n                     --   has a dynamic target)\n                     --\n                     --  * the calling convention is irrelevant for code\n                     --   generation in the case of `CLabel', but is needed\n                     --   for pretty printing\n                     --\n                     --  * `Safety' is irrelevant for `CLabel' and `CWrapper'\n                     --\n                     CImport  (Located CCallConv) -- ccall or stdcall\n                              (Located Safety)  -- interruptible, safe or unsafe\n                              (Maybe Header)       -- name of C header\n                              CImportSpec          -- details of the C entity\n                              (Located SourceText) -- original source text for\n                                                   -- the C entity\n  deriving Data\n\n-- details of an external C entity\n--\ndata CImportSpec = CLabel    CLabelString     -- import address of a C label\n                 | CFunction CCallTarget      -- static or dynamic function\n                 | CWrapper                   -- wrapper to expose closures\n                                              -- (former f.e.d.)\n  deriving Data\n\n-- specification of an externally exported entity in dependence on the calling\n-- convention\n--\ndata ForeignExport = CExport  (Located CExportSpec) -- contains the calling\n                                                    -- convention\n                              (Located SourceText)  -- original source text for\n                                                    -- the C entity\n  deriving Data\n\n-- pretty printing of foreign declarations\n--\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (ForeignDecl p) where\n  ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })\n    = hang (text \"foreign import\" <+> ppr fimport <+> ppr n)\n         2 (dcolon <+> ppr ty)\n  ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =\n    hang (text \"foreign export\" <+> ppr fexport <+> ppr n)\n       2 (dcolon <+> ppr ty)\n  ppr (XForeignDecl x) = ppr x\n\ninstance Outputable ForeignImport where\n  ppr (CImport  cconv safety mHeader spec (L _ srcText)) =\n    ppr cconv <+> ppr safety\n      <+> pprWithSourceText srcText (pprCEntity spec \"\")\n    where\n      pp_hdr = case mHeader of\n               Nothing -> empty\n               Just (Header _ header) -> ftext header\n\n      pprCEntity (CLabel lbl) _ =\n        doubleQuotes $ text \"static\" <+> pp_hdr <+> char '&' <> ppr lbl\n      pprCEntity (CFunction (StaticTarget st _lbl _ isFun)) src =\n        if dqNeeded then doubleQuotes ce else empty\n          where\n            dqNeeded = (take 6 src == \"static\")\n                    || isJust mHeader\n                    || not isFun\n                    || st /= NoSourceText\n            ce =\n                  -- We may need to drop leading spaces first\n                  (if take 6 src == \"static\" then text \"static\" else empty)\n              <+> pp_hdr\n              <+> (if isFun then empty else text \"value\")\n              <+> (pprWithSourceText st empty)\n      pprCEntity (CFunction DynamicTarget) _ =\n        doubleQuotes $ text \"dynamic\"\n      pprCEntity CWrapper _ = doubleQuotes $ text \"wrapper\"\n\ninstance Outputable ForeignExport where\n  ppr (CExport  (L _ (CExportStatic _ lbl cconv)) _) =\n    ppr cconv <+> char '\"' <> ppr lbl <> char '\"'\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Transformation rules}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located Rule Declarations\ntype LRuleDecls pass = Located (RuleDecls pass)\n\n  -- Note [Pragma source text] in BasicTypes\n-- | Rule Declarations\ndata RuleDecls pass = HsRules { rds_ext   :: XCRuleDecls pass\n                              , rds_src   :: SourceText\n                              , rds_rules :: [LRuleDecl pass] }\n  | XRuleDecls (XXRuleDecls pass)\n\ntype instance XCRuleDecls    (GhcPass _) = NoExt\ntype instance XXRuleDecls    (GhcPass _) = NoExt\n\n-- | Located Rule Declaration\ntype LRuleDecl pass = Located (RuleDecl pass)\n\n-- | Rule Declaration\ndata RuleDecl pass\n  = HsRule -- Source rule\n       { rd_ext  :: XHsRule pass\n           -- ^ After renamer, free-vars from the LHS and RHS\n       , rd_name :: Located (SourceText,RuleName)\n           -- ^ Note [Pragma source text] in BasicTypes\n       , rd_act  :: Activation\n       , rd_tyvs :: Maybe [LHsTyVarBndr (NoGhcTc pass)]\n           -- ^ Forall'd type vars\n       , rd_tmvs :: [LRuleBndr pass]\n           -- ^ Forall'd term vars, before typechecking; after typechecking\n           --    this includes all forall'd vars\n       , rd_lhs  :: Located (HsExpr pass)\n       , rd_rhs  :: Located (HsExpr pass)\n       }\n    -- ^\n    --  - 'ApiAnnotation.AnnKeywordId' :\n    --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',\n    --           'ApiAnnotation.AnnVal',\n    --           'ApiAnnotation.AnnClose',\n    --           'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',\n    --           'ApiAnnotation.AnnEqual',\n  | XRuleDecl (XXRuleDecl pass)\n\ndata HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS\n  deriving Data\n\ntype instance XHsRule       GhcPs = NoExt\ntype instance XHsRule       GhcRn = HsRuleRn\ntype instance XHsRule       GhcTc = HsRuleRn\n\ntype instance XXRuleDecl    (GhcPass _) = NoExt\n\nflattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]\nflattenRuleDecls decls = concatMap (rds_rules . unLoc) decls\n\n-- | Located Rule Binder\ntype LRuleBndr pass = Located (RuleBndr pass)\n\n-- | Rule Binder\ndata RuleBndr pass\n  = RuleBndr (XCRuleBndr pass)  (Located (IdP pass))\n  | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass)\n  | XRuleBndr (XXRuleBndr pass)\n        -- ^\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n        --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n\ntype instance XCRuleBndr    (GhcPass _) = NoExt\ntype instance XRuleBndrSig  (GhcPass _) = NoExt\ntype instance XXRuleBndr    (GhcPass _) = NoExt\n\ncollectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]\ncollectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]\n\npprFullRuleName :: Located (SourceText, RuleName) -> SDoc\npprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecls p) where\n  ppr (HsRules { rds_src = st\n               , rds_rules = rules })\n    = pprWithSourceText st (text \"{-# RULES\")\n          <+> vcat (punctuate semi (map ppr rules)) <+> text \"#-}\"\n  ppr (XRuleDecls x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where\n  ppr (HsRule { rd_name = name\n              , rd_act  = act\n              , rd_tyvs = tys\n              , rd_tmvs = tms\n              , rd_lhs  = lhs\n              , rd_rhs  = rhs })\n        = sep [pprFullRuleName name <+> ppr act,\n               nest 4 (pp_forall_ty tys <+> pp_forall_tm tys\n                                        <+> pprExpr (unLoc lhs)),\n               nest 6 (equals <+> pprExpr (unLoc rhs)) ]\n        where\n          pp_forall_ty Nothing     = empty\n          pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot\n          pp_forall_tm Nothing | null tms = empty\n          pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot\n  ppr (XRuleDecl x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where\n   ppr (RuleBndr _ name) = ppr name\n   ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)\n   ppr (XRuleBndr x) = ppr x\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DocDecl]{Document comments}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located Documentation comment Declaration\ntype LDocDecl = Located (DocDecl)\n\n-- | Documentation comment Declaration\ndata DocDecl\n  = DocCommentNext HsDocString\n  | DocCommentPrev HsDocString\n  | DocCommentNamed String HsDocString\n  | DocGroup Int HsDocString\n  deriving Data\n\n-- Okay, I need to reconstruct the document comments, but for now:\ninstance Outputable DocDecl where\n  ppr _ = text \"<document comment>\"\n\ndocDeclDoc :: DocDecl -> HsDocString\ndocDeclDoc (DocCommentNext d) = d\ndocDeclDoc (DocCommentPrev d) = d\ndocDeclDoc (DocCommentNamed _ d) = d\ndocDeclDoc (DocGroup _ d) = d\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[DeprecDecl]{Deprecations}\n*                                                                      *\n************************************************************************\n\nWe use exported entities for things to deprecate.\n-}\n\n-- | Located Warning Declarations\ntype LWarnDecls pass = Located (WarnDecls pass)\n\n -- Note [Pragma source text] in BasicTypes\n-- | Warning pragma Declarations\ndata WarnDecls pass = Warnings { wd_ext      :: XWarnings pass\n                               , wd_src      :: SourceText\n                               , wd_warnings :: [LWarnDecl pass]\n                               }\n  | XWarnDecls (XXWarnDecls pass)\n\ntype instance XWarnings      (GhcPass _) = NoExt\ntype instance XXWarnDecls    (GhcPass _) = NoExt\n\n-- | Located Warning pragma Declaration\ntype LWarnDecl pass = Located (WarnDecl pass)\n\n-- | Warning pragma Declaration\ndata WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt\n                   | XWarnDecl (XXWarnDecl pass)\n\ntype instance XWarning      (GhcPass _) = NoExt\ntype instance XXWarnDecl    (GhcPass _) = NoExt\n\n\ninstance (p ~ GhcPass pass,OutputableBndr (IdP p))\n        => Outputable (WarnDecls p) where\n    ppr (Warnings _ (SourceText src) decls)\n      = text src <+> vcat (punctuate comma (map ppr decls)) <+> text \"#-}\"\n    ppr (Warnings _ NoSourceText _decls) = panic \"WarnDecls\"\n    ppr (XWarnDecls x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndr (IdP p))\n       => Outputable (WarnDecl p) where\n    ppr (Warning _ thing txt)\n      = hsep ( punctuate comma (map ppr thing))\n              <+> ppr txt\n    ppr (XWarnDecl x) = ppr x\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[AnnDecl]{Annotations}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located Annotation Declaration\ntype LAnnDecl pass = Located (AnnDecl pass)\n\n-- | Annotation Declaration\ndata AnnDecl pass = HsAnnotation\n                      (XHsAnnotation pass)\n                      SourceText -- Note [Pragma source text] in BasicTypes\n                      (AnnProvenance (IdP pass)) (Located (HsExpr pass))\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n      --           'ApiAnnotation.AnnType'\n      --           'ApiAnnotation.AnnModule'\n      --           'ApiAnnotation.AnnClose'\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n  | XAnnDecl (XXAnnDecl pass)\n\ntype instance XHsAnnotation (GhcPass _) = NoExt\ntype instance XXAnnDecl     (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where\n    ppr (HsAnnotation _ _ provenance expr)\n      = hsep [text \"{-#\", pprAnnProvenance provenance, pprExpr (unLoc expr), text \"#-}\"]\n    ppr (XAnnDecl x) = ppr x\n\n-- | Annotation Provenance\ndata AnnProvenance name = ValueAnnProvenance (Located name)\n                        | TypeAnnProvenance (Located name)\n                        | ModuleAnnProvenance\nderiving instance Functor     AnnProvenance\nderiving instance Foldable    AnnProvenance\nderiving instance Traversable AnnProvenance\nderiving instance (Data pass) => Data (AnnProvenance pass)\n\nannProvenanceName_maybe :: AnnProvenance name -> Maybe name\nannProvenanceName_maybe (ValueAnnProvenance (L _ name)) = Just name\nannProvenanceName_maybe (TypeAnnProvenance (L _ name))  = Just name\nannProvenanceName_maybe ModuleAnnProvenance       = Nothing\n\npprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc\npprAnnProvenance ModuleAnnProvenance       = text \"ANN module\"\npprAnnProvenance (ValueAnnProvenance (L _ name))\n  = text \"ANN\" <+> ppr name\npprAnnProvenance (TypeAnnProvenance (L _ name))\n  = text \"ANN type\" <+> ppr name\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[RoleAnnot]{Role annotations}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located Role Annotation Declaration\ntype LRoleAnnotDecl pass = Located (RoleAnnotDecl pass)\n\n-- See #8185 for more info about why role annotations are\n-- top-level declarations\n-- | Role Annotation Declaration\ndata RoleAnnotDecl pass\n  = RoleAnnotDecl (XCRoleAnnotDecl pass)\n                  (Located (IdP pass))   -- type constructor\n                  [Located (Maybe Role)] -- optional annotations\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',\n      --           'ApiAnnotation.AnnRole'\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n  | XRoleAnnotDecl (XXRoleAnnotDecl pass)\n\ntype instance XCRoleAnnotDecl (GhcPass _) = NoExt\ntype instance XXRoleAnnotDecl (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndr (IdP p))\n       => Outputable (RoleAnnotDecl p) where\n  ppr (RoleAnnotDecl _ ltycon roles)\n    = text \"type role\" <+> pprPrefixOcc (unLoc ltycon) <+>\n      hsep (map (pp_role . unLoc) roles)\n    where\n      pp_role Nothing  = underscore\n      pp_role (Just r) = ppr r\n  ppr (XRoleAnnotDecl x) = ppr x\n\nroleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)\nroleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name\nroleAnnotDeclName (XRoleAnnotDecl _) = panic \"roleAnnotDeclName\"\n", "num_lines": 2413}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule HsDoc\n  ( HsDocString\n  , LHsDocString\n  , mkHsDocString\n  , mkHsDocStringUtf8ByteString\n  , unpackHDS\n  , hsDocStringToByteString\n  , ppr_mbDoc\n\n  , appendDocs\n  , concatDocs\n\n  , DeclDocMap(..)\n  , emptyDeclDocMap\n\n  , ArgDocMap(..)\n  , emptyArgDocMap\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Binary\nimport Encoding\nimport FastFunctions\nimport Name\nimport Outputable\nimport SrcLoc\n\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Char8 as C8\nimport qualified Data.ByteString.Internal as BS\nimport Data.Data\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport Data.Maybe\nimport Foreign\n\n-- | Haskell Documentation String\n--\n-- Internally this is a UTF8-Encoded 'ByteString'.\nnewtype HsDocString = HsDocString ByteString\n  -- There are at least two plausible Semigroup instances for this type:\n  --\n  -- 1. Simple string concatenation.\n  -- 2. Concatenation as documentation paragraphs with newlines in between.\n  --\n  -- To avoid confusion, we pass on defining an instance at all.\n  deriving (Eq, Show, Data)\n\n-- | Located Haskell Documentation String\ntype LHsDocString = Located HsDocString\n\ninstance Binary HsDocString where\n  put_ bh (HsDocString bs) = put_ bh bs\n  get bh = HsDocString <$> get bh\n\ninstance Outputable HsDocString where\n  ppr = doubleQuotes . text . unpackHDS\n\nmkHsDocString :: String -> HsDocString\nmkHsDocString s =\n  inlinePerformIO $ do\n    let len = utf8EncodedLength s\n    buf <- mallocForeignPtrBytes len\n    withForeignPtr buf $ \\ptr -> do\n      utf8EncodeString ptr s\n      pure (HsDocString (BS.fromForeignPtr buf 0 len))\n\n-- | Create a 'HsDocString' from a UTF8-encoded 'ByteString'.\nmkHsDocStringUtf8ByteString :: ByteString -> HsDocString\nmkHsDocStringUtf8ByteString = HsDocString\n\nunpackHDS :: HsDocString -> String\nunpackHDS = utf8DecodeByteString . hsDocStringToByteString\n\n-- | Return the contents of a 'HsDocString' as a UTF8-encoded 'ByteString'.\nhsDocStringToByteString :: HsDocString -> ByteString\nhsDocStringToByteString (HsDocString bs) = bs\n\nppr_mbDoc :: Maybe LHsDocString -> SDoc\nppr_mbDoc (Just doc) = ppr doc\nppr_mbDoc Nothing    = empty\n\n-- | Join two docstrings.\n--\n-- Non-empty docstrings are joined with two newlines in between,\n-- resulting in separate paragraphs.\nappendDocs :: HsDocString -> HsDocString -> HsDocString\nappendDocs x y =\n  fromMaybe\n    (HsDocString BS.empty)\n    (concatDocs [x, y])\n\n-- | Concat docstrings with two newlines in between.\n--\n-- Empty docstrings are skipped.\n--\n-- If all inputs are empty, 'Nothing' is returned.\nconcatDocs :: [HsDocString] -> Maybe HsDocString\nconcatDocs xs =\n    if BS.null b\n      then Nothing\n      else Just (HsDocString b)\n  where\n    b = BS.intercalate (C8.pack \"\\n\\n\")\n      . filter (not . BS.null)\n      . map hsDocStringToByteString\n      $ xs\n\n-- | Docs for declarations: functions, data types, instances, methods etc.\nnewtype DeclDocMap = DeclDocMap (Map Name HsDocString)\n\ninstance Binary DeclDocMap where\n  put_ bh (DeclDocMap m) = put_ bh (Map.toList m)\n  -- We can't rely on a deterministic ordering of the `Name`s here.\n  -- See the comments on `Name`'s `Ord` instance for context.\n  get bh = DeclDocMap . Map.fromList <$> get bh\n\ninstance Outputable DeclDocMap where\n  ppr (DeclDocMap m) = vcat (map pprPair (Map.toAscList m))\n    where\n      pprPair (name, doc) = ppr name Outputable.<> colon $$ nest 2 (ppr doc)\n\nemptyDeclDocMap :: DeclDocMap\nemptyDeclDocMap = DeclDocMap Map.empty\n\n-- | Docs for arguments. E.g. function arguments, method arguments.\nnewtype ArgDocMap = ArgDocMap (Map Name (Map Int HsDocString))\n\ninstance Binary ArgDocMap where\n  put_ bh (ArgDocMap m) = put_ bh (Map.toList (Map.toAscList <$> m))\n  -- We can't rely on a deterministic ordering of the `Name`s here.\n  -- See the comments on `Name`'s `Ord` instance for context.\n  get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromList <$> get bh\n\ninstance Outputable ArgDocMap where\n  ppr (ArgDocMap m) = vcat (map pprPair (Map.toAscList m))\n    where\n      pprPair (name, int_map) =\n        ppr name Outputable.<> colon $$ nest 2 (pprIntMap int_map)\n      pprIntMap im = vcat (map pprIPair (Map.toAscList im))\n      pprIPair (i, doc) = ppr i Outputable.<> colon $$ nest 2 (ppr doc)\n\nemptyArgDocMap :: ArgDocMap\nemptyArgDocMap = ArgDocMap Map.empty\n", "num_lines": 153}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n-- | Contains a debug function to dump parts of the hsSyn AST. It uses a syb\n-- traversal which falls back to displaying based on the constructor name, so\n-- can be used to dump anything having a @Data.Data@ instance.\n\nmodule HsDumpAst (\n        -- * Dumping ASTs\n        showAstData,\n        BlankSrcSpan(..),\n    ) where\n\nimport GhcPrelude\n\nimport Data.Data hiding (Fixity)\nimport Bag\nimport BasicTypes\nimport FastString\nimport NameSet\nimport Name\nimport DataCon\nimport SrcLoc\nimport HsSyn\nimport OccName hiding (occName)\nimport Var\nimport Module\nimport Outputable\n\nimport qualified Data.ByteString as B\n\ndata BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan\n                  deriving (Eq,Show)\n\n-- | Show a GHC syntax tree. This parameterised because it is also used for\n-- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked\n-- out, to avoid comparing locations, only structure\nshowAstData :: Data a => BlankSrcSpan -> a -> SDoc\nshowAstData b a0 = blankLine $$ showAstData' a0\n  where\n    showAstData' :: Data a => a -> SDoc\n    showAstData' =\n      generic\n              `ext1Q` list\n              `extQ` string `extQ` fastString `extQ` srcSpan\n              `extQ` lit `extQ` litr `extQ` litt\n              `extQ` bytestring\n              `extQ` name `extQ` occName `extQ` moduleName `extQ` var\n              `extQ` dataCon\n              `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet\n              `extQ` fixity\n              `ext2Q` located\n\n      where generic :: Data a => a -> SDoc\n            generic t = parens $ text (showConstr (toConstr t))\n                                  $$ vcat (gmapQ showAstData' t)\n\n            string :: String -> SDoc\n            string     = text . normalize_newlines . show\n\n            fastString :: FastString -> SDoc\n            fastString s = braces $\n                            text \"FastString: \"\n                         <> text (normalize_newlines . show $ s)\n\n            bytestring :: B.ByteString -> SDoc\n            bytestring = text . normalize_newlines . show\n\n            list []    = brackets empty\n            list [x]   = brackets (showAstData' x)\n            list (x1 : x2 : xs) =  (text \"[\" <> showAstData' x1)\n                                $$ go x2 xs\n              where\n                go y [] = text \",\" <> showAstData' y <> text \"]\"\n                go y1 (y2 : ys) = (text \",\" <> showAstData' y1) $$ go y2 ys\n\n            -- Eliminate word-size dependence\n            lit :: HsLit GhcPs -> SDoc\n            lit (HsWordPrim   s x) = numericLit \"HsWord{64}Prim\" x s\n            lit (HsWord64Prim s x) = numericLit \"HsWord{64}Prim\" x s\n            lit (HsIntPrim    s x) = numericLit \"HsInt{64}Prim\"  x s\n            lit (HsInt64Prim  s x) = numericLit \"HsInt{64}Prim\"  x s\n            lit l                  = generic l\n\n            litr :: HsLit GhcRn -> SDoc\n            litr (HsWordPrim   s x) = numericLit \"HsWord{64}Prim\" x s\n            litr (HsWord64Prim s x) = numericLit \"HsWord{64}Prim\" x s\n            litr (HsIntPrim    s x) = numericLit \"HsInt{64}Prim\"  x s\n            litr (HsInt64Prim  s x) = numericLit \"HsInt{64}Prim\"  x s\n            litr l                  = generic l\n\n            litt :: HsLit GhcTc -> SDoc\n            litt (HsWordPrim   s x) = numericLit \"HsWord{64}Prim\" x s\n            litt (HsWord64Prim s x) = numericLit \"HsWord{64}Prim\" x s\n            litt (HsIntPrim    s x) = numericLit \"HsInt{64}Prim\"  x s\n            litt (HsInt64Prim  s x) = numericLit \"HsInt{64}Prim\"  x s\n            litt l                  = generic l\n\n            numericLit :: String -> Integer -> SourceText -> SDoc\n            numericLit tag x s = braces $ hsep [ text tag\n                                               , generic x\n                                               , generic s ]\n\n            name :: Name -> SDoc\n            name nm    = braces $ text \"Name: \" <> ppr nm\n\n            occName n  =  braces $\n                          text \"OccName: \"\n                       <> text (OccName.occNameString n)\n\n            moduleName :: ModuleName -> SDoc\n            moduleName m = braces $ text \"ModuleName: \" <> ppr m\n\n            srcSpan :: SrcSpan -> SDoc\n            srcSpan ss = case b of\n             BlankSrcSpan -> text \"{ ss }\"\n             NoBlankSrcSpan -> braces $ char ' ' <>\n                             (hang (ppr ss) 1\n                                   -- TODO: show annotations here\n                                   (text \"\"))\n\n            var  :: Var -> SDoc\n            var v      = braces $ text \"Var: \" <> ppr v\n\n            dataCon :: DataCon -> SDoc\n            dataCon c  = braces $ text \"DataCon: \" <> ppr c\n\n            bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc\n            bagRdrName bg =  braces $\n                             text \"Bag(Located (HsBind GhcPs)):\"\n                          $$ (list . bagToList $ bg)\n\n            bagName   :: Bag (Located (HsBind GhcRn)) -> SDoc\n            bagName bg  =  braces $\n                           text \"Bag(Located (HsBind Name)):\"\n                        $$ (list . bagToList $ bg)\n\n            bagVar    :: Bag (Located (HsBind GhcTc)) -> SDoc\n            bagVar bg  =  braces $\n                          text \"Bag(Located (HsBind Var)):\"\n                       $$ (list . bagToList $ bg)\n\n            nameSet ns =  braces $\n                          text \"NameSet:\"\n                       $$ (list . nameSetElemsStable $ ns)\n\n            fixity :: Fixity -> SDoc\n            fixity fx =  braces $\n                         text \"Fixity: \"\n                      <> ppr fx\n\n            located :: (Data b,Data loc) => GenLocated loc b -> SDoc\n            located (L ss a) = parens $\n                   case cast ss of\n                        Just (s :: SrcSpan) ->\n                          srcSpan s\n                        Nothing -> text \"nnnnnnnn\"\n                      $$ showAstData' a\n\nnormalize_newlines :: String -> String\nnormalize_newlines ('\\\\':'r':'\\\\':'n':xs) = '\\\\':'n':normalize_newlines xs\nnormalize_newlines (x:xs)                 = x:normalize_newlines xs\nnormalize_newlines []                     = []\n\n{-\n************************************************************************\n*                                                                      *\n* Copied from syb\n*                                                                      *\n************************************************************************\n-}\n\n\n-- | The type constructor for queries\nnewtype Q q x = Q { unQ :: x -> q }\n\n-- | Extend a generic query by a type-specific case\nextQ :: ( Typeable a\n        , Typeable b\n        )\n     => (a -> q)\n     -> (b -> q)\n     -> a\n     -> q\nextQ f g a = maybe (f a) g (cast a)\n\n-- | Type extension of queries for type constructors\next1Q :: (Data d, Typeable t)\n      => (d -> q)\n      -> (forall e. Data e => t e -> q)\n      -> d -> q\next1Q def ext = unQ ((Q def) `ext1` (Q ext))\n\n\n-- | Type extension of queries for type constructors\next2Q :: (Data d, Typeable t)\n      => (d -> q)\n      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)\n      -> d -> q\next2Q def ext = unQ ((Q def) `ext2` (Q ext))\n\n-- | Flexible type extension\next1 :: (Data a, Typeable t)\n     => c a\n     -> (forall d. Data d => c (t d))\n     -> c a\next1 def ext = maybe def id (dataCast1 ext)\n\n\n\n-- | Flexible type extension\next2 :: (Data a, Typeable t)\n     => c a\n     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))\n     -> c a\next2 def ext = maybe def id (dataCast2 ext)\n", "num_lines": 221}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- | Abstract Haskell syntax for expressions.\nmodule HsExpr where\n\n#include \"HsVersions.h\"\n\n-- friends:\nimport GhcPrelude\n\nimport HsDecls\nimport HsPat\nimport HsLit\nimport PlaceHolder ( NameOrRdrName )\nimport HsExtension\nimport HsTypes\nimport HsBinds\n\n-- others:\nimport TcEvidence\nimport CoreSyn\nimport DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )\nimport Name\nimport NameSet\nimport RdrName  ( GlobalRdrEnv )\nimport BasicTypes\nimport ConLike\nimport SrcLoc\nimport Util\nimport Outputable\nimport FastString\nimport Type\nimport TcType (TcType)\nimport {-# SOURCE #-} TcRnTypes (TcLclEnv)\n\n-- libraries:\nimport Data.Data hiding (Fixity(..))\nimport qualified Data.Data as Data (Fixity(..))\nimport Data.Maybe (isNothing)\n\nimport GHCi.RemoteTypes ( ForeignRef )\nimport qualified Language.Haskell.TH as TH (Q)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Expressions proper}\n*                                                                      *\n************************************************************************\n-}\n\n-- * Expressions proper\n\n-- | Located Haskell Expression\ntype LHsExpr p = Located (HsExpr p)\n  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when\n  --   in a list\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n\n-------------------------\n-- | Post-Type checking Expression\n--\n-- PostTcExpr is an evidence expression attached to the syntax tree by the\n-- type checker (c.f. postTcType).\ntype PostTcExpr  = HsExpr GhcTc\n\n-- | Post-Type checking Table\n--\n-- We use a PostTcTable where there are a bunch of pieces of evidence, more\n-- than is convenient to keep individually.\ntype PostTcTable = [(Name, PostTcExpr)]\n\n-------------------------\n-- | Syntax Expression\n--\n-- SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,\n-- by the renamer.  It's used for rebindable syntax.\n--\n-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for\n--      @(>>=)@, and then instantiated by the type checker with its type args\n--      etc\n--\n-- This should desugar to\n--\n-- > syn_res_wrap $ syn_expr (syn_arg_wraps[0] arg0)\n-- >                         (syn_arg_wraps[1] arg1) ...\n--\n-- where the actual arguments come from elsewhere in the AST.\n-- This could be defined using @GhcPass p@ and such, but it's\n-- harder to get it all to work out that way. ('noSyntaxExpr' is hard to\n-- write, for example.)\ndata SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p\n                               , syn_arg_wraps :: [HsWrapper]\n                               , syn_res_wrap  :: HsWrapper }\n\n-- | This is used for rebindable-syntax pieces that are too polymorphic\n-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)\nnoExpr :: HsExpr (GhcPass p)\nnoExpr = HsLit noExt (HsString (SourceText  \"noExpr\") (fsLit \"noExpr\"))\n\nnoSyntaxExpr :: SyntaxExpr (GhcPass p)\n                              -- Before renaming, and sometimes after,\n                              -- (if the syntax slot makes no sense)\nnoSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExt (HsString NoSourceText\n                                                        (fsLit \"noSyntaxExpr\"))\n                          , syn_arg_wraps = []\n                          , syn_res_wrap  = WpHole }\n\n-- | Make a 'SyntaxExpr (HsExpr _)', missing its HsWrappers.\nmkSyntaxExpr :: HsExpr (GhcPass p) -> SyntaxExpr (GhcPass p)\nmkSyntaxExpr expr = SyntaxExpr { syn_expr      = expr\n                               , syn_arg_wraps = []\n                               , syn_res_wrap  = WpHole }\n\n-- | Make a 'SyntaxExpr Name' (the \"rn\" is because this is used in the\n-- renamer), missing its HsWrappers.\nmkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn\nmkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExt $ noLoc name\n  -- don't care about filling in syn_arg_wraps because we're clearly\n  -- not past the typechecker\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (SyntaxExpr p) where\n  ppr (SyntaxExpr { syn_expr      = expr\n                  , syn_arg_wraps = arg_wraps\n                  , syn_res_wrap  = res_wrap })\n    = sdocWithDynFlags $ \\ dflags ->\n      getPprStyle $ \\s ->\n      if debugStyle s || gopt Opt_PrintExplicitCoercions dflags\n      then ppr expr <> braces (pprWithCommas ppr arg_wraps)\n                    <> braces (ppr res_wrap)\n      else ppr expr\n\n-- | Command Syntax Table (for Arrow syntax)\ntype CmdSyntaxTable p = [(Name, HsExpr p)]\n-- See Note [CmdSyntaxTable]\n\n{-\nNote [CmdSyntaxtable]\n~~~~~~~~~~~~~~~~~~~~~\nUsed only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps\ntrack of the methods needed for a Cmd.\n\n* Before the renamer, this list is an empty list\n\n* After the renamer, it takes the form @[(std_name, HsVar actual_name)]@\n  For example, for the 'arr' method\n   * normal case:            (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr)\n   * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22)\n             where @arr_22@ is whatever 'arr' is in scope\n\n* After the type checker, it takes the form [(std_name, <expression>)]\n  where <expression> is the evidence for the method.  This evidence is\n  instantiated with the class, but is still polymorphic in everything\n  else.  For example, in the case of 'arr', the evidence has type\n         forall b c. (b->c) -> a b c\n  where 'a' is the ambient type of the arrow.  This polymorphism is\n  important because the desugarer uses the same evidence at multiple\n  different types.\n\nThis is Less Cool than what we normally do for rebindable syntax, which is to\nmake fully-instantiated piece of evidence at every use site.  The Cmd way\nis Less Cool because\n  * The renamer has to predict which methods are needed.\n    See the tedious RnExpr.methodNamesCmd.\n\n  * The desugarer has to know the polymorphic type of the instantiated\n    method. This is checked by Inst.tcSyntaxName, but is less flexible\n    than the rest of rebindable syntax, where the type is less\n    pre-ordained.  (And this flexibility is useful; for example we can\n    typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)\n-}\n\n-- | An unbound variable; used for treating\n-- out-of-scope variables as expression holes\n--\n-- Either \"x\", \"y\"     Plain OutOfScope\n-- or     \"_\", \"_x\"    A TrueExprHole\n--\n-- Both forms indicate an out-of-scope variable,  but the latter\n-- indicates that the user /expects/ it to be out of scope, and\n-- just wants GHC to report its type\ndata UnboundVar\n  = OutOfScope OccName GlobalRdrEnv  -- ^ An (unqualified) out-of-scope\n                                     -- variable, together with the GlobalRdrEnv\n                                     -- with respect to which it is unbound\n\n                                     -- See Note [OutOfScope and GlobalRdrEnv]\n\n  | TrueExprHole OccName             -- ^ A \"true\" expression hole (_ or _x)\n\n  deriving Data\n\ninstance Outputable UnboundVar where\n    ppr (OutOfScope occ _) = text \"OutOfScope\" <> parens (ppr occ)\n    ppr (TrueExprHole occ) = text \"ExprHole\"   <> parens (ppr occ)\n\nunboundVarOcc :: UnboundVar -> OccName\nunboundVarOcc (OutOfScope occ _) = occ\nunboundVarOcc (TrueExprHole occ) = occ\n\n{-\nNote [OutOfScope and GlobalRdrEnv]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTo understand why we bundle a GlobalRdrEnv with an out-of-scope variable,\nconsider the following module:\n\n    module A where\n\n    foo :: ()\n    foo = bar\n\n    bat :: [Double]\n    bat = [1.2, 3.4]\n\n    $(return [])\n\n    bar = ()\n    bad = False\n\nWhen A is compiled, the renamer determines that `bar` is not in scope in the\ndeclaration of `foo` (since `bar` is declared in the following inter-splice\ngroup).  Once it has finished typechecking the entire module, the typechecker\nthen generates the associated error message, which specifies both the type of\n`bar` and a list of possible in-scope alternatives:\n\n    A.hs:6:7: error:\n        \u00e2\u20ac\u00a2 Variable not in scope: bar :: ()\n        \u00e2\u20ac\u00a2 \u00e2\u20ac\u02dcbar\u00e2\u20ac\u2122 (line 13) is not in scope before the splice on line 11\n          Perhaps you meant \u00e2\u20ac\u02dcbat\u00e2\u20ac\u2122 (line 9)\n\nWhen it calls RnEnv.unknownNameSuggestions to identify these alternatives, the\ntypechecker must provide a GlobalRdrEnv.  If it provided the current one, which\ncontains top-level declarations for the entire module, the error message would\nincorrectly suggest the out-of-scope `bar` and `bad` as possible alternatives\nfor `bar` (see Trac #11680).  Instead, the typechecker must use the same\nGlobalRdrEnv the renamer used when it determined that `bar` is out-of-scope.\n\nTo obtain this GlobalRdrEnv, can the typechecker simply use the out-of-scope\n`bar`'s location to either reconstruct it (from the current GlobalRdrEnv) or to\nlook it up in some global store?  Unfortunately, no.  The problem is that\nlocation information is not always sufficient for this task.  This is most\napparent when dealing with the TH function addTopDecls, which adds its\ndeclarations to the FOLLOWING inter-splice group.  Consider these declarations:\n\n    ex9 = cat               -- cat is NOT in scope here\n\n    $(do -------------------------------------------------------------\n        ds <- [d| f = cab   -- cat and cap are both in scope here\n                  cat = ()\n                |]\n        addTopDecls ds\n        [d| g = cab         -- only cap is in scope here\n            cap = True\n          |])\n\n    ex10 = cat              -- cat is NOT in scope here\n\n    $(return []) -----------------------------------------------------\n\n    ex11 = cat              -- cat is in scope\n\nHere, both occurrences of `cab` are out-of-scope, and so the typechecker needs\nthe GlobalRdrEnvs which were used when they were renamed.  These GlobalRdrEnvs\nare different (`cat` is present only in the GlobalRdrEnv for f's `cab'), but the\nlocations of the two `cab`s are the same (they are both created in the same\nsplice).  Thus, we must include some additional information with each `cab` to\nallow the typechecker to obtain the correct GlobalRdrEnv.  Clearly, the simplest\ninformation to use is the GlobalRdrEnv itself.\n-}\n\n-- | A Haskell expression.\ndata HsExpr p\n  = HsVar     (XVar p)\n              (Located (IdP p)) -- ^ Variable\n\n                             -- See Note [Located RdrNames]\n\n  | HsUnboundVar (XUnboundVar p)\n                 UnboundVar  -- ^ Unbound variable; also used for \"holes\"\n                             --   (_ or _x).\n                             -- Turned from HsVar to HsUnboundVar by the\n                             --   renamer, when it finds an out-of-scope\n                             --   variable or hole.\n                             -- Turned into HsVar by type checker, to support\n                             --   deferred type errors.\n\n  | HsConLikeOut (XConLikeOut p)\n                 ConLike     -- ^ After typechecker only; must be different\n                             -- HsVar for pretty printing\n\n  | HsRecFld  (XRecFld p)\n              (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector\n                                    -- Not in use after typechecking\n\n  | HsOverLabel (XOverLabel p)\n                (Maybe (IdP p)) FastString\n     -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)\n     --   @Just id@ means @RebindableSyntax@ is in use, and gives the id of the\n     --   in-scope 'fromLabel'.\n     --   NB: Not in use after typechecking\n\n  | HsIPVar   (XIPVar p)\n              HsIPName   -- ^ Implicit parameter (not in use after typechecking)\n  | HsOverLit (XOverLitE p)\n              (HsOverLit p)  -- ^ Overloaded literals\n\n  | HsLit     (XLitE p)\n              (HsLit p)      -- ^ Simple (non-overloaded) literals\n\n  | HsLam     (XLam p)\n              (MatchGroup p (LHsExpr p))\n                       -- ^ Lambda abstraction. Currently always a single match\n       --\n       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',\n       --       'ApiAnnotation.AnnRarrow',\n\n       -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case\n       --\n       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',\n       --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',\n       --           'ApiAnnotation.AnnClose'\n\n       -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application\n\n  | HsAppType (XAppTypeE p) (LHsExpr p) (LHsWcType (NoGhcTc p))  -- ^ Visible type application\n       --\n       -- Explicit type argument; e.g  f @Int x y\n       -- NB: Has wildcards, but no implicit quantification\n       --\n       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',\n\n  -- | Operator applications:\n  -- NB Bracketed ops such as (+) come out as Vars.\n\n  -- NB We need an expr for the operator in an OpApp/Section since\n  -- the typechecker may need to apply the operator to a few types.\n\n  | OpApp       (XOpApp p)\n                (LHsExpr p)       -- left operand\n                (LHsExpr p)       -- operator\n                (LHsExpr p)       -- right operand\n\n  -- | Negation operator. Contains the negated expression and the name\n  -- of 'negate'\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | NegApp      (XNegApp p)\n                (LHsExpr p)\n                (SyntaxExpr p)\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,\n  --             'ApiAnnotation.AnnClose' @')'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsPar       (XPar p)\n                (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]\n\n  | SectionL    (XSectionL p)\n                (LHsExpr p)    -- operand; see Note [Sections in HsSyn]\n                (LHsExpr p)    -- operator\n  | SectionR    (XSectionR p)\n                (LHsExpr p)    -- operator; see Note [Sections in HsSyn]\n                (LHsExpr p)    -- operand\n\n  -- | Used for explicit tuples and sections thereof\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n  --         'ApiAnnotation.AnnClose'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | ExplicitTuple\n        (XExplicitTuple p)\n        [LHsTupArg p]\n        Boxity\n\n  -- | Used for unboxed sum types\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,\n  --          'ApiAnnotation.AnnVbar', 'ApiAnnotation.AnnClose' @'#)'@,\n  --\n  --  There will be multiple 'ApiAnnotation.AnnVbar', (1 - alternative) before\n  --  the expression, (arity - alternative) after it\n  | ExplicitSum\n          (XExplicitSum p)\n          ConTag --  Alternative (one-based)\n          Arity  --  Sum arity\n          (LHsExpr p)\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',\n  --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,\n  --       'ApiAnnotation.AnnClose' @'}'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsCase      (XCase p)\n                (LHsExpr p)\n                (MatchGroup p (LHsExpr p))\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',\n  --       'ApiAnnotation.AnnSemi',\n  --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',\n  --       'ApiAnnotation.AnnElse',\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsIf        (XIf p)\n                (Maybe (SyntaxExpr p)) -- cond function\n                                        -- Nothing => use the built-in 'if'\n                                        -- See Note [Rebindable if]\n                (LHsExpr p)    --  predicate\n                (LHsExpr p)    --  then part\n                (LHsExpr p)    --  else part\n\n  -- | Multi-way if\n  --\n  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'\n  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]\n\n  -- | let(rec)\n  --\n  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',\n  --       'ApiAnnotation.AnnOpen' @'{'@,\n  --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsLet       (XLet p)\n                (LHsLocalBinds p)\n                (LHsExpr  p)\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',\n  --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',\n  --             'ApiAnnotation.AnnVbar',\n  --             'ApiAnnotation.AnnClose'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsDo        (XDo p)                  -- Type of the whole expression\n                (HsStmtContext Name)     -- The parameterisation is unimportant\n                                         -- because in this context we never use\n                                         -- the PatGuard or ParStmt variant\n                (Located [ExprLStmt p]) -- \"do\":one or more stmts\n\n  -- | Syntactic list: [a,b,c,...]\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,\n  --              'ApiAnnotation.AnnClose' @']'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | ExplicitList\n                (XExplicitList p)  -- Gives type of components of list\n                (Maybe (SyntaxExpr p))\n                                   -- For OverloadedLists, the fromListN witness\n                [LHsExpr p]\n\n  -- | Record construction\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,\n  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | RecordCon\n      { rcon_ext      :: XRecordCon p\n      , rcon_con_name :: Located (IdP p)    -- The constructor name;\n                                            --  not used after type checking\n      , rcon_flds     :: HsRecordBinds p }  -- The fields\n\n  -- | Record update\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,\n  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | RecordUpd\n      { rupd_ext  :: XRecordUpd p\n      , rupd_expr :: LHsExpr p\n      , rupd_flds :: [LHsRecUpdField p]\n      }\n  -- For a type family, the arg types are of the *instance* tycon,\n  -- not the family tycon\n\n  -- | Expression with an explicit type signature. @e :: type@\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | ExprWithTySig\n                (XExprWithTySig p)\n\n                (LHsExpr p)\n                (LHsSigWcType (NoGhcTc p))\n\n  -- | Arithmetic sequence\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,\n  --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',\n  --              'ApiAnnotation.AnnClose' @']'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | ArithSeq\n                (XArithSeq p)\n                (Maybe (SyntaxExpr p))\n                                  -- For OverloadedLists, the fromList witness\n                (ArithSeqInfo p)\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsSCC       (XSCC p)\n                SourceText            -- Note [Pragma source text] in BasicTypes\n                StringLiteral         -- \"set cost centre\" SCC pragma\n                (LHsExpr p)           -- expr whose cost is to be measured\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\\# CORE'@,\n  --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\\#-}'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsCoreAnn   (XCoreAnn p)\n                SourceText            -- Note [Pragma source text] in BasicTypes\n                StringLiteral         -- hdaume: core annotation\n                (LHsExpr p)\n\n  -----------------------------------------------------------\n  -- MetaHaskell Extensions\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n  --         'ApiAnnotation.AnnOpenE','ApiAnnotation.AnnOpenEQ',\n  --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsBracket    (XBracket p) (HsBracket p)\n\n    -- See Note [Pending Splices]\n  | HsRnBracketOut\n      (XRnBracketOut p)\n      (HsBracket GhcRn)    -- Output of the renamer is the *original* renamed\n                           -- expression, plus\n      [PendingRnSplice]    -- _renamed_ splices to be type checked\n\n  | HsTcBracketOut\n      (XTcBracketOut p)\n      (HsBracket GhcRn)    -- Output of the type checker is the *original*\n                           -- renamed expression, plus\n      [PendingTcSplice]    -- _typechecked_ splices to be\n                           -- pasted back in by the desugarer\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n  --         'ApiAnnotation.AnnClose'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsSpliceE  (XSpliceE p) (HsSplice p)\n\n  -----------------------------------------------------------\n  -- Arrow notation extension\n\n  -- | @proc@ notation for Arrows\n  --\n  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',\n  --          'ApiAnnotation.AnnRarrow'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsProc      (XProc p)\n                (LPat p)               -- arrow abstraction, proc\n                (LHsCmdTop p)          -- body of the abstraction\n                                       -- always has an empty stack\n\n  ---------------------------------------\n  -- static pointers extension\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsStatic (XStatic p) -- Free variables of the body\n             (LHsExpr p)        -- Body\n\n  ---------------------------------------\n  -- Haskell program coverage (Hpc) Support\n\n  | HsTick\n     (XTick p)\n     (Tickish (IdP p))\n     (LHsExpr p)                       -- sub-expression\n\n  | HsBinTick\n     (XBinTick p)\n     Int                                -- module-local tick number for True\n     Int                                -- module-local tick number for False\n     (LHsExpr p)                        -- sub-expression\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n  --       'ApiAnnotation.AnnOpen' @'{-\\# GENERATED'@,\n  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal',\n  --       'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal',\n  --       'ApiAnnotation.AnnMinus',\n  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnColon',\n  --       'ApiAnnotation.AnnVal',\n  --       'ApiAnnotation.AnnClose' @'\\#-}'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsTickPragma                      -- A pragma introduced tick\n     (XTickPragma p)\n     SourceText                       -- Note [Pragma source text] in BasicTypes\n     (StringLiteral,(Int,Int),(Int,Int))\n                                      -- external span for this tick\n     ((SourceText,SourceText),(SourceText,SourceText))\n        -- Source text for the four integers used in the span.\n        -- See note [Pragma source text] in BasicTypes\n     (LHsExpr p)\n\n  ---------------------------------------\n  -- These constructors only appear temporarily in the parser.\n  -- The renamer translates them into the Right Thing.\n\n  | EWildPat (XEWildPat p)        -- wildcard\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | EAsPat      (XEAsPat p)\n                (Located (IdP p)) -- as pattern\n                (LHsExpr p)\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | EViewPat    (XEViewPat p)\n                (LHsExpr p) -- view pattern\n                (LHsExpr p)\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | ELazyPat    (XELazyPat p) (LHsExpr p) -- ~ pattern\n\n\n  ---------------------------------------\n  -- Finally, HsWrap appears only in typechecker output\n  -- The contained Expr is *NOT* itself an HsWrap.\n  -- See Note [Detecting forced eta expansion] in DsExpr. This invariant\n  -- is maintained by HsUtils.mkHsWrap.\n\n  |  HsWrap     (XWrap p)\n                HsWrapper    -- TRANSLATION\n                (HsExpr p)\n\n  | XExpr       (XXExpr p) -- Note [Trees that Grow] extension constructor\n\n\n-- | Extra data fields for a 'RecordCon', added by the type checker\ndata RecordConTc = RecordConTc\n      { rcon_con_like :: ConLike      -- The data constructor or pattern synonym\n      , rcon_con_expr :: PostTcExpr   -- Instantiated constructor function\n      }\n\n-- | Extra data fields for a 'RecordUpd', added by the type checker\ndata RecordUpdTc = RecordUpdTc\n      { rupd_cons :: [ConLike]\n                -- Filled in by the type checker to the\n                -- _non-empty_ list of DataCons that have\n                -- all the upd'd fields\n\n      , rupd_in_tys  :: [Type] -- Argument types of *input* record type\n      , rupd_out_tys :: [Type] --             and  *output* record type\n                               -- The original type can be reconstructed\n                               -- with conLikeResTy\n      , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]\n      } deriving Data\n\n-- ---------------------------------------------------------------------\n\ntype instance XVar           (GhcPass _) = NoExt\ntype instance XUnboundVar    (GhcPass _) = NoExt\ntype instance XConLikeOut    (GhcPass _) = NoExt\ntype instance XRecFld        (GhcPass _) = NoExt\ntype instance XOverLabel     (GhcPass _) = NoExt\ntype instance XIPVar         (GhcPass _) = NoExt\ntype instance XOverLitE      (GhcPass _) = NoExt\ntype instance XLitE          (GhcPass _) = NoExt\ntype instance XLam           (GhcPass _) = NoExt\ntype instance XLamCase       (GhcPass _) = NoExt\ntype instance XApp           (GhcPass _) = NoExt\n\ntype instance XAppTypeE      (GhcPass _) = NoExt\n\ntype instance XOpApp         GhcPs = NoExt\ntype instance XOpApp         GhcRn = Fixity\ntype instance XOpApp         GhcTc = Fixity\n\ntype instance XNegApp        (GhcPass _) = NoExt\ntype instance XPar           (GhcPass _) = NoExt\ntype instance XSectionL      (GhcPass _) = NoExt\ntype instance XSectionR      (GhcPass _) = NoExt\ntype instance XExplicitTuple (GhcPass _) = NoExt\n\ntype instance XExplicitSum   GhcPs = NoExt\ntype instance XExplicitSum   GhcRn = NoExt\ntype instance XExplicitSum   GhcTc = [Type]\n\ntype instance XCase          (GhcPass _) = NoExt\ntype instance XIf            (GhcPass _) = NoExt\n\ntype instance XMultiIf       GhcPs = NoExt\ntype instance XMultiIf       GhcRn = NoExt\ntype instance XMultiIf       GhcTc = Type\n\ntype instance XLet           (GhcPass _) = NoExt\n\ntype instance XDo            GhcPs = NoExt\ntype instance XDo            GhcRn = NoExt\ntype instance XDo            GhcTc = Type\n\ntype instance XExplicitList  GhcPs = NoExt\ntype instance XExplicitList  GhcRn = NoExt\ntype instance XExplicitList  GhcTc = Type\n\ntype instance XRecordCon     GhcPs = NoExt\ntype instance XRecordCon     GhcRn = NoExt\ntype instance XRecordCon     GhcTc = RecordConTc\n\ntype instance XRecordUpd     GhcPs = NoExt\ntype instance XRecordUpd     GhcRn = NoExt\ntype instance XRecordUpd     GhcTc = RecordUpdTc\n\ntype instance XExprWithTySig (GhcPass _) = NoExt\n\ntype instance XArithSeq      GhcPs = NoExt\ntype instance XArithSeq      GhcRn = NoExt\ntype instance XArithSeq      GhcTc = PostTcExpr\n\ntype instance XSCC           (GhcPass _) = NoExt\ntype instance XCoreAnn       (GhcPass _) = NoExt\ntype instance XBracket       (GhcPass _) = NoExt\n\ntype instance XRnBracketOut  (GhcPass _) = NoExt\ntype instance XTcBracketOut  (GhcPass _) = NoExt\n\ntype instance XSpliceE       (GhcPass _) = NoExt\ntype instance XProc          (GhcPass _) = NoExt\n\ntype instance XStatic        GhcPs = NoExt\ntype instance XStatic        GhcRn = NameSet\ntype instance XStatic        GhcTc = NameSet\n\ntype instance XArrApp        GhcPs = NoExt\ntype instance XArrApp        GhcRn = NoExt\ntype instance XArrApp        GhcTc = Type\n\ntype instance XArrForm       (GhcPass _) = NoExt\ntype instance XTick          (GhcPass _) = NoExt\ntype instance XBinTick       (GhcPass _) = NoExt\ntype instance XTickPragma    (GhcPass _) = NoExt\ntype instance XEWildPat      (GhcPass _) = NoExt\ntype instance XEAsPat        (GhcPass _) = NoExt\ntype instance XEViewPat      (GhcPass _) = NoExt\ntype instance XELazyPat      (GhcPass _) = NoExt\ntype instance XWrap          (GhcPass _) = NoExt\ntype instance XXExpr         (GhcPass _) = NoExt\n\n-- ---------------------------------------------------------------------\n\n-- | Located Haskell Tuple Argument\n--\n-- 'HsTupArg' is used for tuple sections\n-- @(,a,)@ is represented by\n-- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@\n-- Which in turn stands for @(\\x:ty1 \\y:ty2. (x,a,y))@\ntype LHsTupArg id = Located (HsTupArg id)\n-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'\n\n-- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Haskell Tuple Argument\ndata HsTupArg id\n  = Present (XPresent id) (LHsExpr id)     -- ^ The argument\n  | Missing (XMissing id)    -- ^ The argument is missing, but this is its type\n  | XTupArg (XXTupArg id)    -- ^ Note [Trees that Grow] extension point\n\ntype instance XPresent         (GhcPass _) = NoExt\n\ntype instance XMissing         GhcPs = NoExt\ntype instance XMissing         GhcRn = NoExt\ntype instance XMissing         GhcTc = Type\n\ntype instance XXTupArg         (GhcPass _) = NoExt\n\ntupArgPresent :: LHsTupArg id -> Bool\ntupArgPresent (L _ (Present {})) = True\ntupArgPresent (L _ (Missing {})) = False\ntupArgPresent (L _ (XTupArg {})) = False\n\n{-\nNote [Parens in HsSyn]\n~~~~~~~~~~~~~~~~~~~~~~\nHsPar (and ParPat in patterns, HsParTy in types) is used as follows\n\n  * HsPar is required; the pretty printer does not add parens.\n\n  * HsPars are respected when rearranging operator fixities.\n    So   a * (b + c)  means what it says (where the parens are an HsPar)\n\n  * For ParPat and HsParTy the pretty printer does add parens but this should be\n    a no-op for ParsedSource, based on the pretty printer round trip feature\n    introduced in\n    https://phabricator.haskell.org/rGHC499e43824bda967546ebf95ee33ec1f84a114a7c\n\n  * ParPat and HsParTy are pretty printed as '( .. )' regardless of whether or\n    not they are strictly necessary. This should be addressed when #13238 is\n    completed, to be treated the same as HsPar.\n\n\nNote [Sections in HsSyn]\n~~~~~~~~~~~~~~~~~~~~~~~~\nSections should always appear wrapped in an HsPar, thus\n         HsPar (SectionR ...)\nThe parser parses sections in a wider variety of situations\n(See Note [Parsing sections]), but the renamer checks for those\nparens.  This invariant makes pretty-printing easier; we don't need\na special case for adding the parens round sections.\n\nNote [Rebindable if]\n~~~~~~~~~~~~~~~~~~~~\nThe rebindable syntax for 'if' is a bit special, because when\nrebindable syntax is *off* we do not want to treat\n   (if c then t else e)\nas if it was an application (ifThenElse c t e).  Why not?\nBecause we allow an 'if' to return *unboxed* results, thus\n  if blah then 3# else 4#\nwhereas that would not be possible using a all to a polymorphic function\n(because you can't call a polymorphic function at an unboxed type).\n\nSo we use Nothing to mean \"use the old built-in typing rule\".\n\nNote [Record Update HsWrapper]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere is a wrapper in RecordUpd which is used for the *required*\nconstraints for pattern synonyms. This wrapper is created in the\ntypechecking and is then directly used in the desugaring without\nmodification.\n\nFor example, if we have the record pattern synonym P,\n  pattern P :: (Show a) => a -> Maybe a\n  pattern P{x} = Just x\n\n  foo = (Just True) { x = False }\nthen `foo` desugars to something like\n  foo = case Just True of\n          P x -> P False\nhence we need to provide the correct dictionaries to P's matcher on\nthe RHS so that we can build the expression.\n\nNote [Located RdrNames]\n~~~~~~~~~~~~~~~~~~~~~~~\nA number of syntax elements have seemingly redundant locations attached to them.\nThis is deliberate, to allow transformations making use of the API Annotations\nto easily correlate a Located Name in the RenamedSource with a Located RdrName\nin the ParsedSource.\n\nThere are unfortunately enough differences between the ParsedSource and the\nRenamedSource that the API Annotations cannot be used directly with\nRenamedSource, so this allows a simple mapping to be used based on the location.\n-}\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) where\n    ppr expr = pprExpr expr\n\n-----------------------\n-- pprExpr, pprLExpr, pprBinds call pprDeeper;\n-- the underscore versions do not\npprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc\npprLExpr (L _ e) = pprExpr e\n\npprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc\npprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e\n          | otherwise                           = pprDeeper (ppr_expr e)\n\nisQuietHsExpr :: HsExpr id -> Bool\n-- Parentheses do display something, but it gives little info and\n-- if we go deeper when we go inside them then we get ugly things\n-- like (...)\nisQuietHsExpr (HsPar {})        = True\n-- applications don't display anything themselves\nisQuietHsExpr (HsApp {})        = True\nisQuietHsExpr (HsAppType {})    = True\nisQuietHsExpr (OpApp {})        = True\nisQuietHsExpr _ = False\n\npprBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))\n         => HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc\npprBinds b = pprDeeper (ppr b)\n\n-----------------------\nppr_lexpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc\nppr_lexpr e = ppr_expr (unLoc e)\n\nppr_expr :: forall p. (OutputableBndrId (GhcPass p))\n         => HsExpr (GhcPass p) -> SDoc\nppr_expr (HsVar _ (L _ v))  = pprPrefixOcc v\nppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)\nppr_expr (HsConLikeOut _ c) = pprPrefixOcc c\nppr_expr (HsIPVar _ v)      = ppr v\nppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l\nppr_expr (HsLit _ lit)      = ppr lit\nppr_expr (HsOverLit _ lit)  = ppr lit\nppr_expr (HsPar _ e)        = parens (ppr_lexpr e)\n\nppr_expr (HsCoreAnn _ stc (StringLiteral sta s) e)\n  = vcat [pprWithSourceText stc (text \"{-# CORE\")\n          <+> pprWithSourceText sta (doubleQuotes $ ftext s) <+> text \"#-}\"\n         , ppr_lexpr e]\n\nppr_expr e@(HsApp {})        = ppr_apps e []\nppr_expr e@(HsAppType {})    = ppr_apps e []\n\nppr_expr (OpApp _ e1 op e2)\n  | Just pp_op <- should_print_infix (unLoc op)\n  = pp_infixly pp_op\n  | otherwise\n  = pp_prefixly\n\n  where\n    should_print_infix (HsVar _ (L _ v)) = Just (pprInfixOcc v)\n    should_print_infix (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))\n    should_print_infix (HsRecFld _ f)    = Just (pprInfixOcc f)\n    should_print_infix (HsUnboundVar _ h@TrueExprHole{})\n                                       = Just (pprInfixOcc (unboundVarOcc h))\n    should_print_infix (EWildPat _)    = Just (text \"`_`\")\n    should_print_infix (HsWrap _ _ e)  = should_print_infix e\n    should_print_infix _               = Nothing\n\n    pp_e1 = pprDebugParendExpr opPrec e1   -- In debug mode, add parens\n    pp_e2 = pprDebugParendExpr opPrec e2   -- to make precedence clear\n\n    pp_prefixly\n      = hang (ppr op) 2 (sep [pp_e1, pp_e2])\n\n    pp_infixly pp_op\n      = hang pp_e1 2 (sep [pp_op, nest 2 pp_e2])\n\nppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e\n\nppr_expr (SectionL _ expr op)\n  = case unLoc op of\n      HsVar _ (L _ v)  -> pp_infixly v\n      HsConLikeOut _ c -> pp_infixly (conLikeName c)\n      HsUnboundVar _ h@TrueExprHole{}\n                       -> pp_infixly (unboundVarOcc h)\n      _                -> pp_prefixly\n  where\n    pp_expr = pprDebugParendExpr opPrec expr\n\n    pp_prefixly = hang (hsep [text \" \\\\ x_ ->\", ppr op])\n                       4 (hsep [pp_expr, text \"x_ )\"])\n\n    pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc\n    pp_infixly v = (sep [pp_expr, pprInfixOcc v])\n\nppr_expr (SectionR _ op expr)\n  = case unLoc op of\n      HsVar _ (L _ v)  -> pp_infixly v\n      HsConLikeOut _ c -> pp_infixly (conLikeName c)\n      HsUnboundVar _ h@TrueExprHole{}\n                       -> pp_infixly (unboundVarOcc h)\n      _                -> pp_prefixly\n  where\n    pp_expr = pprDebugParendExpr opPrec expr\n\n    pp_prefixly = hang (hsep [text \"( \\\\ x_ ->\", ppr op, text \"x_\"])\n                       4 (pp_expr <> rparen)\n\n    pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc\n    pp_infixly v = sep [pprInfixOcc v, pp_expr]\n\nppr_expr (ExplicitTuple _ exprs boxity)\n  = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))\n  where\n    ppr_tup_args []               = []\n    ppr_tup_args (Present _ e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es\n    ppr_tup_args (Missing _   : es) = punc es : ppr_tup_args es\n    ppr_tup_args (XTupArg x   : es) = (ppr x <> punc es) : ppr_tup_args es\n\n    punc (Present {} : _) = comma <> space\n    punc (Missing {} : _) = comma\n    punc (XTupArg {} : _) = comma <> space\n    punc []               = empty\n\nppr_expr (ExplicitSum _ alt arity expr)\n  = text \"(#\" <+> ppr_bars (alt - 1) <+> ppr expr <+> ppr_bars (arity - alt) <+> text \"#)\"\n  where\n    ppr_bars n = hsep (replicate n (char '|'))\n\nppr_expr (HsLam _ matches)\n  = pprMatches matches\n\nppr_expr (HsLamCase _ matches)\n  = sep [ sep [text \"\\\\case\"],\n          nest 2 (pprMatches matches) ]\n\nppr_expr (HsCase _ expr matches@(MG { mg_alts = L _ [_] }))\n  = sep [ sep [text \"case\", nest 4 (ppr expr), ptext (sLit \"of {\")],\n          nest 2 (pprMatches matches) <+> char '}']\nppr_expr (HsCase _ expr matches)\n  = sep [ sep [text \"case\", nest 4 (ppr expr), ptext (sLit \"of\")],\n          nest 2 (pprMatches matches) ]\n\nppr_expr (HsIf _ _ e1 e2 e3)\n  = sep [hsep [text \"if\", nest 2 (ppr e1), ptext (sLit \"then\")],\n         nest 4 (ppr e2),\n         text \"else\",\n         nest 4 (ppr e3)]\n\nppr_expr (HsMultiIf _ alts)\n  = hang (text \"if\") 3  (vcat (map ppr_alt alts))\n  where ppr_alt (L _ (GRHS _ guards expr)) =\n          hang vbar 2 (ppr_one one_alt)\n          where\n            ppr_one [] = panic \"ppr_exp HsMultiIf\"\n            ppr_one (h:t) = hang h 2 (sep t)\n            one_alt = [ interpp'SP guards\n                      , text \"->\" <+> pprDeeper (ppr expr) ]\n        ppr_alt (L _ (XGRHS x)) = ppr x\n\n-- special case: let ... in let ...\nppr_expr (HsLet _ (L _ binds) expr@(L _ (HsLet _ _ _)))\n  = sep [hang (text \"let\") 2 (hsep [pprBinds binds, ptext (sLit \"in\")]),\n         ppr_lexpr expr]\n\nppr_expr (HsLet _ (L _ binds) expr)\n  = sep [hang (text \"let\") 2 (pprBinds binds),\n         hang (text \"in\")  2 (ppr expr)]\n\nppr_expr (HsDo _ do_or_list_comp (L _ stmts)) = pprDo do_or_list_comp stmts\n\nppr_expr (ExplicitList _ _ exprs)\n  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))\n\nppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })\n  = hang (ppr con_id) 2 (ppr rbinds)\n\nppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })\n  = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))\n\nppr_expr (ExprWithTySig _ expr sig)\n  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)\n         4 (ppr sig)\n\nppr_expr (ArithSeq _ _ info) = brackets (ppr info)\n\nppr_expr (EWildPat _)     = char '_'\nppr_expr (ELazyPat _ e)   = char '~' <> ppr e\nppr_expr (EAsPat _ (L _ v) e) = pprPrefixOcc v <> char '@' <> ppr e\nppr_expr (EViewPat _ p e) = ppr p <+> text \"->\" <+> ppr e\n\nppr_expr (HsSCC _ st (StringLiteral stl lbl) expr)\n  = sep [ pprWithSourceText st (text \"{-# SCC\")\n         -- no doublequotes if stl empty, for the case where the SCC was written\n         -- without quotes.\n          <+> pprWithSourceText stl (ftext lbl) <+> text \"#-}\",\n          ppr expr ]\n\nppr_expr (HsWrap _ co_fn e)\n  = pprHsWrapper co_fn (\\parens -> if parens then pprExpr e\n                                             else pprExpr e)\n\nppr_expr (HsSpliceE _ s)         = pprSplice s\nppr_expr (HsBracket _ b)         = pprHsBracket b\nppr_expr (HsRnBracketOut _ e []) = ppr e\nppr_expr (HsRnBracketOut _ e ps) = ppr e $$ text \"pending(rn)\" <+> ppr ps\nppr_expr (HsTcBracketOut _ e []) = ppr e\nppr_expr (HsTcBracketOut _ e ps) = ppr e $$ text \"pending(tc)\" <+> ppr ps\n\nppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))\n  = hsep [text \"proc\", ppr pat, ptext (sLit \"->\"), ppr cmd]\nppr_expr (HsProc _ pat (L _ (XCmdTop x)))\n  = hsep [text \"proc\", ppr pat, ptext (sLit \"->\"), ppr x]\n\nppr_expr (HsStatic _ e)\n  = hsep [text \"static\", ppr e]\n\nppr_expr (HsTick _ tickish exp)\n  = pprTicks (ppr exp) $\n    ppr tickish <+> ppr_lexpr exp\nppr_expr (HsBinTick _ tickIdTrue tickIdFalse exp)\n  = pprTicks (ppr exp) $\n    hcat [text \"bintick<\",\n          ppr tickIdTrue,\n          text \",\",\n          ppr tickIdFalse,\n          text \">(\",\n          ppr exp, text \")\"]\nppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)\n  = pprTicks (ppr exp) $\n    hcat [text \"tickpragma<\",\n          pprExternalSrcLoc externalSrcLoc,\n          text \">(\",\n          ppr exp,\n          text \")\"]\n\nppr_expr (HsRecFld _ f) = ppr f\nppr_expr (XExpr x) = ppr x\n\nppr_apps :: (OutputableBndrId (GhcPass p))\n         => HsExpr (GhcPass p)\n         -> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]\n         -> SDoc\nppr_apps (HsApp _ (L _ fun) arg)        args\n  = ppr_apps fun (Left arg : args)\nppr_apps (HsAppType _ (L _ fun) arg)    args\n  = ppr_apps fun (Right arg : args)\nppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))\n  where\n    pp (Left arg)                             = ppr arg\n    -- pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))\n    --   = char '@' <> pprHsType arg\n    pp (Right arg)\n      = char '@' <> ppr arg\n\npprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc\npprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))\n  = ppr (src,(n1,n2),(n3,n4))\n\n{-\nHsSyn records exactly where the user put parens, with HsPar.\nSo generally speaking we print without adding any parens.\nHowever, some code is internally generated, and in some places\nparens are absolutely required; so for these places we use\npprParendLExpr (but don't print double parens of course).\n\nFor operator applications we don't add parens, because the operator\nfixities should do the job, except in debug mode (-dppr-debug) so we\ncan see the structure of the parse tree.\n-}\n\npprDebugParendExpr :: (OutputableBndrId (GhcPass p))\n                   => PprPrec -> LHsExpr (GhcPass p) -> SDoc\npprDebugParendExpr p expr\n  = getPprStyle (\\sty ->\n    if debugStyle sty then pprParendLExpr p expr\n                      else pprLExpr      expr)\n\npprParendLExpr :: (OutputableBndrId (GhcPass p))\n               => PprPrec -> LHsExpr (GhcPass p) -> SDoc\npprParendLExpr p (L _ e) = pprParendExpr p e\n\npprParendExpr :: (OutputableBndrId (GhcPass p))\n              => PprPrec -> HsExpr (GhcPass p) -> SDoc\npprParendExpr p expr\n  | hsExprNeedsParens p expr = parens (pprExpr expr)\n  | otherwise                = pprExpr expr\n        -- Using pprLExpr makes sure that we go 'deeper'\n        -- I think that is usually (always?) right\n\n-- | @'hsExprNeedsParens' p e@ returns 'True' if the expression @e@ needs\n-- parentheses under precedence @p@.\nhsExprNeedsParens :: PprPrec -> HsExpr p -> Bool\nhsExprNeedsParens p = go\n  where\n    go (HsVar{})                      = False\n    go (HsUnboundVar{})               = False\n    go (HsConLikeOut{})               = False\n    go (HsIPVar{})                    = False\n    go (HsOverLabel{})                = False\n    go (HsLit _ l)                    = hsLitNeedsParens p l\n    go (HsOverLit _ ol)               = hsOverLitNeedsParens p ol\n    go (HsPar{})                      = False\n    go (HsCoreAnn _ _ _ (L _ e))      = go e\n    go (HsApp{})                      = p >= appPrec\n    go (HsAppType {})                 = p >= appPrec\n    go (OpApp{})                      = p >= opPrec\n    go (NegApp{})                     = p > topPrec\n    go (SectionL{})                   = True\n    go (SectionR{})                   = True\n    go (ExplicitTuple{})              = False\n    go (ExplicitSum{})                = False\n    go (HsLam{})                      = p > topPrec\n    go (HsLamCase{})                  = p > topPrec\n    go (HsCase{})                     = p > topPrec\n    go (HsIf{})                       = p > topPrec\n    go (HsMultiIf{})                  = p > topPrec\n    go (HsLet{})                      = p > topPrec\n    go (HsDo _ sc _)\n      | isComprehensionContext sc     = False\n      | otherwise                     = p > topPrec\n    go (ExplicitList{})               = False\n    go (RecordUpd{})                  = False\n    go (ExprWithTySig{})              = p >= sigPrec\n    go (ArithSeq{})                   = False\n    go (EWildPat{})                   = False\n    go (ELazyPat{})                   = False\n    go (EAsPat{})                     = False\n    go (EViewPat{})                   = True\n    go (HsSCC{})                      = p >= appPrec\n    go (HsWrap _ _ e)                 = go e\n    go (HsSpliceE{})                  = False\n    go (HsBracket{})                  = False\n    go (HsRnBracketOut{})             = False\n    go (HsTcBracketOut{})             = False\n    go (HsProc{})                     = p > topPrec\n    go (HsStatic{})                   = p >= appPrec\n    go (HsTick _ _ (L _ e))           = go e\n    go (HsBinTick _ _ _ (L _ e))      = go e\n    go (HsTickPragma _ _ _ _ (L _ e)) = go e\n    go (RecordCon{})                  = False\n    go (HsRecFld{})                   = False\n    go (XExpr{})                      = True\n\n-- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true,\n-- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.\nparenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)\nparenthesizeHsExpr p le@(L loc e)\n  | hsExprNeedsParens p e = L loc (HsPar NoExt le)\n  | otherwise             = le\n\nisAtomicHsExpr :: HsExpr id -> Bool\n-- True of a single token\nisAtomicHsExpr (HsVar {})        = True\nisAtomicHsExpr (HsConLikeOut {}) = True\nisAtomicHsExpr (HsLit {})        = True\nisAtomicHsExpr (HsOverLit {})    = True\nisAtomicHsExpr (HsIPVar {})      = True\nisAtomicHsExpr (HsOverLabel {})  = True\nisAtomicHsExpr (HsUnboundVar {}) = True\nisAtomicHsExpr (HsWrap _ _ e)    = isAtomicHsExpr e\nisAtomicHsExpr (HsPar _ e)       = isAtomicHsExpr (unLoc e)\nisAtomicHsExpr (HsRecFld{})      = True\nisAtomicHsExpr _                 = False\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Commands (in arrow abstractions)}\n*                                                                      *\n************************************************************************\n\nWe re-use HsExpr to represent these.\n-}\n\n-- | Located Haskell Command (for arrow syntax)\ntype LHsCmd id = Located (HsCmd id)\n\n-- | Haskell Command (e.g. a \"statement\" in an Arrow proc block)\ndata HsCmd id\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',\n  --          'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',\n  --          'ApiAnnotation.AnnRarrowtail'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  = HsCmdArrApp          -- Arrow tail, or arrow application (f -< arg)\n        (XCmdArrApp id)  -- type of the arrow expressions f,\n                         -- of the form a t t', where arg :: t\n        (LHsExpr id)     -- arrow expression, f\n        (LHsExpr id)     -- input expression, arg\n        HsArrAppType     -- higher-order (-<<) or first-order (-<)\n        Bool             -- True => right-to-left (f -< arg)\n                         -- False => left-to-right (arg >- f)\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,\n  --         'ApiAnnotation.AnnCloseB' @'|)'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | HsCmdArrForm         -- Command formation,  (| e cmd1 .. cmdn |)\n        (XCmdArrForm id)\n        (LHsExpr id)     -- The operator.\n                         -- After type-checking, a type abstraction to be\n                         -- applied to the type of the local environment tuple\n        LexicalFixity    -- Whether the operator appeared prefix or infix when\n                         -- parsed.\n        (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that\n                         -- were converted from OpApp's by the renamer\n        [LHsCmdTop id]   -- argument commands\n\n  | HsCmdApp    (XCmdApp id)\n                (LHsCmd id)\n                (LHsExpr id)\n\n  | HsCmdLam    (XCmdLam id)\n                (MatchGroup id (LHsCmd id))     -- kappa\n       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',\n       --       'ApiAnnotation.AnnRarrow',\n\n       -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsCmdPar    (XCmdPar id)\n                (LHsCmd id)                     -- parenthesised command\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,\n    --             'ApiAnnotation.AnnClose' @')'@\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsCmdCase   (XCmdCase id)\n                (LHsExpr id)\n                (MatchGroup id (LHsCmd id))     -- bodies are HsCmd's\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',\n    --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,\n    --       'ApiAnnotation.AnnClose' @'}'@\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsCmdIf     (XCmdIf id)\n                (Maybe (SyntaxExpr id))         -- cond function\n                (LHsExpr id)                    -- predicate\n                (LHsCmd id)                     -- then part\n                (LHsCmd id)                     -- else part\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',\n    --       'ApiAnnotation.AnnSemi',\n    --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',\n    --       'ApiAnnotation.AnnElse',\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsCmdLet    (XCmdLet id)\n                (LHsLocalBinds id)      -- let(rec)\n                (LHsCmd  id)\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',\n    --       'ApiAnnotation.AnnOpen' @'{'@,\n    --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsCmdDo     (XCmdDo id)                     -- Type of the whole expression\n                (Located [CmdLStmt id])\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',\n    --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',\n    --             'ApiAnnotation.AnnVbar',\n    --             'ApiAnnotation.AnnClose'\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsCmdWrap   (XCmdWrap id)\n                HsWrapper\n                (HsCmd id)     -- If   cmd :: arg1 --> res\n                               --      wrap :: arg1 \"->\" arg2\n                               -- Then (HsCmdWrap wrap cmd) :: arg2 --> res\n  | XCmd        (XXCmd id)     -- Note [Trees that Grow] extension point\n\ntype instance XCmdArrApp  GhcPs = NoExt\ntype instance XCmdArrApp  GhcRn = NoExt\ntype instance XCmdArrApp  GhcTc = Type\n\ntype instance XCmdArrForm (GhcPass _) = NoExt\ntype instance XCmdApp     (GhcPass _) = NoExt\ntype instance XCmdLam     (GhcPass _) = NoExt\ntype instance XCmdPar     (GhcPass _) = NoExt\ntype instance XCmdCase    (GhcPass _) = NoExt\ntype instance XCmdIf      (GhcPass _) = NoExt\ntype instance XCmdLet     (GhcPass _) = NoExt\n\ntype instance XCmdDo      GhcPs = NoExt\ntype instance XCmdDo      GhcRn = NoExt\ntype instance XCmdDo      GhcTc = Type\n\ntype instance XCmdWrap    (GhcPass _) = NoExt\ntype instance XXCmd       (GhcPass _) = NoExt\n\n-- | Haskell Array Application Type\ndata HsArrAppType = HsHigherOrderApp | HsFirstOrderApp\n  deriving Data\n\n\n{- | Top-level command, introducing a new arrow.\nThis may occur inside a proc (where the stack is empty) or as an\nargument of a command-forming operator.\n-}\n\n-- | Located Haskell Top-level Command\ntype LHsCmdTop p = Located (HsCmdTop p)\n\n-- | Haskell Top-level Command\ndata HsCmdTop p\n  = HsCmdTop (XCmdTop p)\n             (LHsCmd p)\n  | XCmdTop (XXCmdTop p)        -- Note [Trees that Grow] extension point\n\ndata CmdTopTc\n  = CmdTopTc Type    -- Nested tuple of inputs on the command's stack\n             Type    -- return type of the command\n             (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]\n\ntype instance XCmdTop  GhcPs = NoExt\ntype instance XCmdTop  GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]\ntype instance XCmdTop  GhcTc = CmdTopTc\n\ntype instance XXCmdTop (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where\n    ppr cmd = pprCmd cmd\n\n-----------------------\n-- pprCmd and pprLCmd call pprDeeper;\n-- the underscore versions do not\npprLCmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc\npprLCmd (L _ c) = pprCmd c\n\npprCmd :: (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc\npprCmd c | isQuietHsCmd c =            ppr_cmd c\n         | otherwise      = pprDeeper (ppr_cmd c)\n\nisQuietHsCmd :: HsCmd id -> Bool\n-- Parentheses do display something, but it gives little info and\n-- if we go deeper when we go inside them then we get ugly things\n-- like (...)\nisQuietHsCmd (HsCmdPar {}) = True\n-- applications don't display anything themselves\nisQuietHsCmd (HsCmdApp {}) = True\nisQuietHsCmd _ = False\n\n-----------------------\nppr_lcmd :: (OutputableBndrId (GhcPass p)) => LHsCmd (GhcPass p) -> SDoc\nppr_lcmd c = ppr_cmd (unLoc c)\n\nppr_cmd :: forall p. (OutputableBndrId (GhcPass p)) => HsCmd (GhcPass p) -> SDoc\nppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)\n\nppr_cmd (HsCmdApp _ c e)\n  = let (fun, args) = collect_args c [e] in\n    hang (ppr_lcmd fun) 2 (sep (map ppr args))\n  where\n    collect_args (L _ (HsCmdApp _ fun arg)) args = collect_args fun (arg:args)\n    collect_args fun args = (fun, args)\n\nppr_cmd (HsCmdLam _ matches)\n  = pprMatches matches\n\nppr_cmd (HsCmdCase _ expr matches)\n  = sep [ sep [text \"case\", nest 4 (ppr expr), ptext (sLit \"of\")],\n          nest 2 (pprMatches matches) ]\n\nppr_cmd (HsCmdIf _ _ e ct ce)\n  = sep [hsep [text \"if\", nest 2 (ppr e), ptext (sLit \"then\")],\n         nest 4 (ppr ct),\n         text \"else\",\n         nest 4 (ppr ce)]\n\n-- special case: let ... in let ...\nppr_cmd (HsCmdLet _ (L _ binds) cmd@(L _ (HsCmdLet {})))\n  = sep [hang (text \"let\") 2 (hsep [pprBinds binds, ptext (sLit \"in\")]),\n         ppr_lcmd cmd]\n\nppr_cmd (HsCmdLet _ (L _ binds) cmd)\n  = sep [hang (text \"let\") 2 (pprBinds binds),\n         hang (text \"in\")  2 (ppr cmd)]\n\nppr_cmd (HsCmdDo _ (L _ stmts))  = pprDo ArrowExpr stmts\n\nppr_cmd (HsCmdWrap _ w cmd)\n  = pprHsWrapper w (\\_ -> parens (ppr_cmd cmd))\nppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp True)\n  = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]\nppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp False)\n  = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]\nppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp True)\n  = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]\nppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp False)\n  = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]\n\nppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) _ (Just _) [arg1, arg2])\n  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v\n                                         , pprCmdArg (unLoc arg2)])\nppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) Infix _    [arg1, arg2])\n  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v\n                                         , pprCmdArg (unLoc arg2)])\nppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) _ (Just _) [arg1, arg2])\n  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)\n                                         , pprCmdArg (unLoc arg2)])\nppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) Infix _    [arg1, arg2])\n  = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)\n                                         , pprCmdArg (unLoc arg2)])\nppr_cmd (HsCmdArrForm _ op _ _ args)\n  = hang (text \"(|\" <+> ppr_lexpr op)\n         4 (sep (map (pprCmdArg.unLoc) args) <+> text \"|)\")\nppr_cmd (XCmd x) = ppr x\n\npprCmdArg :: (OutputableBndrId (GhcPass p)) => HsCmdTop (GhcPass p) -> SDoc\npprCmdArg (HsCmdTop _ cmd)\n  = ppr_lcmd cmd\npprCmdArg (XCmdTop x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmdTop p) where\n    ppr = pprCmdArg\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Record binds}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Haskell Record Bindings\ntype HsRecordBinds p = HsRecFields p (LHsExpr p)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}\n*                                                                      *\n************************************************************************\n\n@Match@es are sets of pattern bindings and right hand sides for\nfunctions, patterns or case branches. For example, if a function @g@\nis defined as:\n\\begin{verbatim}\ng (x,y) = y\ng ((x:ys),y) = y+1,\n\\end{verbatim}\nthen \\tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.\n\nIt is always the case that each element of an @[Match]@ list has the\nsame number of @pats@s inside it.  This corresponds to saying that\na function defined by pattern matching must have the same number of\npatterns in each equation.\n-}\n\ndata MatchGroup p body\n  = MG { mg_ext     :: XMG p body -- Posr typechecker, types of args and result\n       , mg_alts    :: Located [LMatch p body]  -- The alternatives\n       , mg_origin  :: Origin }\n     -- The type is the type of the entire group\n     --      t1 -> ... -> tn -> tr\n     -- where there are n patterns\n  | XMatchGroup (XXMatchGroup p body)\n\ndata MatchGroupTc\n  = MatchGroupTc\n       { mg_arg_tys :: [Type]  -- Types of the arguments, t1..tn\n       , mg_res_ty  :: Type    -- Type of the result, tr\n       } deriving Data\n\ntype instance XMG         GhcPs b = NoExt\ntype instance XMG         GhcRn b = NoExt\ntype instance XMG         GhcTc b = MatchGroupTc\n\ntype instance XXMatchGroup (GhcPass _) b = NoExt\n\n-- | Located Match\ntype LMatch id body = Located (Match id body)\n-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a\n--   list\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata Match p body\n  = Match {\n        m_ext :: XCMatch p body,\n        m_ctxt :: HsMatchContext (NameOrRdrName (IdP p)),\n          -- See note [m_ctxt in Match]\n        m_pats :: [LPat p], -- The patterns\n        m_grhss :: (GRHSs p body)\n  }\n  | XMatch (XXMatch p body)\n\ntype instance XCMatch (GhcPass _) b = NoExt\ntype instance XXMatch (GhcPass _) b = NoExt\n\ninstance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)\n            => Outputable (Match idR body) where\n  ppr = pprMatch\n\n{-\nNote [m_ctxt in Match]\n~~~~~~~~~~~~~~~~~~~~~~\n\nA Match can occur in a number of contexts, such as a FunBind, HsCase, HsLam and\nso on.\n\nIn order to simplify tooling processing and pretty print output, the provenance\nis captured in an HsMatchContext.\n\nThis is particularly important for the API Annotations for a multi-equation\nFunBind.\n\nThe parser initially creates a FunBind with a single Match in it for\nevery function definition it sees.\n\nThese are then grouped together by getMonoBind into a single FunBind,\nwhere all the Matches are combined.\n\nIn the process, all the original FunBind fun_id's bar one are\ndiscarded, including the locations.\n\nThis causes a problem for source to source conversions via API\nAnnotations, so the original fun_ids and infix flags are preserved in\nthe Match, when it originates from a FunBind.\n\nExample infix function definition requiring individual API Annotations\n\n    (&&&  ) [] [] =  []\n    xs    &&&   [] =  xs\n    (  &&&  ) [] ys =  ys\n\n\n\n-}\n\n\nisInfixMatch :: Match id body -> Bool\nisInfixMatch match = case m_ctxt match of\n  FunRhs {mc_fixity = Infix} -> True\n  _                          -> False\n\nisEmptyMatchGroup :: MatchGroup id body -> Bool\nisEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms\nisEmptyMatchGroup (XMatchGroup{}) = panic \"isEmptyMatchGroup\"\n\n-- | Is there only one RHS in this list of matches?\nisSingletonMatchGroup :: [LMatch id body] -> Bool\nisSingletonMatchGroup matches\n  | [L _ match] <- matches\n  , Match { m_grhss = GRHSs { grhssGRHSs = [_] } } <- match\n  = True\n  | otherwise\n  = False\n\nmatchGroupArity :: MatchGroup id body -> Arity\n-- Precondition: MatchGroup is non-empty\n-- This is called before type checking, when mg_arg_tys is not set\nmatchGroupArity (MG { mg_alts = alts })\n  | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)\n  | otherwise        = panic \"matchGroupArity\"\nmatchGroupArity (XMatchGroup{}) = panic \"matchGroupArity\"\n\nhsLMatchPats :: LMatch id body -> [LPat id]\nhsLMatchPats (L _ (Match { m_pats = pats })) = pats\nhsLMatchPats (L _ (XMatch _)) = panic \"hsLMatchPats\"\n\n-- | Guarded Right-Hand Sides\n--\n-- GRHSs are used both for pattern bindings and for Matches\n--\n--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',\n--        'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',\n--        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'\n--        'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata GRHSs p body\n  = GRHSs {\n      grhssExt :: XCGRHSs p body,\n      grhssGRHSs :: [LGRHS p body],      -- ^ Guarded RHSs\n      grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause\n    }\n  | XGRHSs (XXGRHSs p body)\n\ntype instance XCGRHSs (GhcPass _) b = NoExt\ntype instance XXGRHSs (GhcPass _) b = NoExt\n\n-- | Located Guarded Right-Hand Side\ntype LGRHS id body = Located (GRHS id body)\n\n-- | Guarded Right Hand Side.\ndata GRHS p body = GRHS (XCGRHS p body)\n                        [GuardLStmt p] -- Guards\n                        body           -- Right hand side\n                  | XGRHS (XXGRHS p body)\n\ntype instance XCGRHS (GhcPass _) b = NoExt\ntype instance XXGRHS (GhcPass _) b = NoExt\n\n-- We know the list must have at least one @Match@ in it.\n\npprMatches :: (OutputableBndrId (GhcPass idR), Outputable body)\n           => MatchGroup (GhcPass idR) body -> SDoc\npprMatches MG { mg_alts = matches }\n    = vcat (map pprMatch (map unLoc (unLoc matches)))\n      -- Don't print the type; it's only a place-holder before typechecking\npprMatches (XMatchGroup x) = ppr x\n\n-- Exported to HsBinds, which can't see the defn of HsMatchContext\npprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)\n           => MatchGroup (GhcPass idR) body -> SDoc\npprFunBind matches = pprMatches matches\n\n-- Exported to HsBinds, which can't see the defn of HsMatchContext\npprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),\n                                   OutputableBndrId (GhcPass p),\n                                   Outputable body)\n           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc\npprPatBind pat (grhss)\n = sep [ppr pat,\n       nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP (GhcPass p))) grhss)]\n\npprMatch :: (OutputableBndrId (GhcPass idR), Outputable body)\n         => Match (GhcPass idR) body -> SDoc\npprMatch match\n  = sep [ sep (herald : map (nest 2 . pprParendLPat appPrec) other_pats)\n        , nest 2 (pprGRHSs ctxt (m_grhss match)) ]\n  where\n    ctxt = m_ctxt match\n    (herald, other_pats)\n        = case ctxt of\n            FunRhs {mc_fun=L _ fun, mc_fixity=fixity, mc_strictness=strictness}\n                | strictness == SrcStrict -> ASSERT(null $ m_pats match)\n                                             (char '!'<>pprPrefixOcc fun, m_pats match)\n                        -- a strict variable binding\n                | fixity == Prefix -> (pprPrefixOcc fun, m_pats match)\n                        -- f x y z = e\n                        -- Not pprBndr; the AbsBinds will\n                        -- have printed the signature\n\n                | null pats2 -> (pp_infix, [])\n                        -- x &&& y = e\n\n                | otherwise -> (parens pp_infix, pats2)\n                        -- (x &&& y) z = e\n                where\n                  pp_infix = pprParendLPat opPrec pat1\n                         <+> pprInfixOcc fun\n                         <+> pprParendLPat opPrec pat2\n\n            LambdaExpr -> (char '\\\\', m_pats match)\n\n            _  -> if null (m_pats match)\n                     then (empty, [])\n                     else ASSERT2( null pats1, ppr ctxt $$ ppr pat1 $$ ppr pats1 )\n                          (ppr pat1, [])        -- No parens around the single pat\n\n    (pat1:pats1) = m_pats match\n    (pat2:pats2) = pats1\n\npprGRHSs :: (OutputableBndrId (GhcPass idR), Outputable body)\n         => HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc\npprGRHSs ctxt (GRHSs _ grhss (L _ binds))\n  = vcat (map (pprGRHS ctxt . unLoc) grhss)\n  -- Print the \"where\" even if the contents of the binds is empty. Only\n  -- EmptyLocalBinds means no \"where\" keyword\n $$ ppUnless (eqEmptyLocalBinds binds)\n      (text \"where\" $$ nest 4 (pprBinds binds))\npprGRHSs _ (XGRHSs x) = ppr x\n\npprGRHS :: (OutputableBndrId (GhcPass idR), Outputable body)\n        => HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc\npprGRHS ctxt (GRHS _ [] body)\n =  pp_rhs ctxt body\n\npprGRHS ctxt (GRHS _ guards body)\n = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body]\n\npprGRHS _ (XGRHS x) = ppr x\n\npp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc\npp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Do stmts and list comprehensions}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located @do@ block Statement\ntype LStmt id body = Located (StmtLR id id body)\n\n-- | Located Statement with separate Left and Right id's\ntype LStmtLR idL idR body = Located (StmtLR idL idR body)\n\n-- | @do@ block Statement\ntype Stmt id body = StmtLR id id body\n\n-- | Command Located Statement\ntype CmdLStmt   id = LStmt id (LHsCmd  id)\n\n-- | Command Statement\ntype CmdStmt    id = Stmt  id (LHsCmd  id)\n\n-- | Expression Located Statement\ntype ExprLStmt  id = LStmt id (LHsExpr id)\n\n-- | Expression Statement\ntype ExprStmt   id = Stmt  id (LHsExpr id)\n\n-- | Guard Located Statement\ntype GuardLStmt id = LStmt id (LHsExpr id)\n\n-- | Guard Statement\ntype GuardStmt  id = Stmt  id (LHsExpr id)\n\n-- | Ghci Located Statement\ntype GhciLStmt  id = LStmt id (LHsExpr id)\n\n-- | Ghci Statement\ntype GhciStmt   id = Stmt  id (LHsExpr id)\n\n-- The SyntaxExprs in here are used *only* for do-notation and monad\n-- comprehensions, which have rebindable syntax. Otherwise they are unused.\n-- | API Annotations when in qualifier lists or guards\n--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',\n--         'ApiAnnotation.AnnComma','ApiAnnotation.AnnThen',\n--         'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',\n--         'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata StmtLR idL idR body -- body should always be (LHs**** idR)\n  = LastStmt  -- Always the last Stmt in ListComp, MonadComp,\n              -- and (after the renamer, see RnExpr.checkLastStmt) DoExpr, MDoExpr\n              -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff\n          (XLastStmt idL idR body)\n          body\n          Bool               -- True <=> return was stripped by ApplicativeDo\n          (SyntaxExpr idR)   -- The return operator\n            -- The return operator is used only for MonadComp\n            -- For ListComp we use the baked-in 'return'\n            -- For DoExpr, MDoExpr, we don't apply a 'return' at all\n            -- See Note [Monad Comprehensions]\n            -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | BindStmt (XBindStmt idL idR body) -- Post typechecking,\n                                -- result type of the function passed to bind;\n                                -- that is, S in (>>=) :: Q -> (R -> S) -> T\n             (LPat idL)\n             body\n             (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts]\n             (SyntaxExpr idR) -- The fail operator\n             -- The fail operator is noSyntaxExpr\n             -- if the pattern match can't fail\n\n  -- | 'ApplicativeStmt' represents an applicative expression built with\n  -- '<$>' and '<*>'.  It is generated by the renamer, and is desugared into the\n  -- appropriate applicative expression by the desugarer, but it is intended\n  -- to be invisible in error messages.\n  --\n  -- For full details, see Note [ApplicativeDo] in RnExpr\n  --\n  | ApplicativeStmt\n             (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body\n             [ ( SyntaxExpr idR\n               , ApplicativeArg idL) ]\n                      -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]\n             (Maybe (SyntaxExpr idR))  -- 'join', if necessary\n\n  | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type\n                                      -- of the RHS (used for arrows)\n             body              -- See Note [BodyStmt]\n             (SyntaxExpr idR)  -- The (>>) operator\n             (SyntaxExpr idR)  -- The `guard` operator; used only in MonadComp\n                               -- See notes [Monad Comprehensions]\n\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'\n  --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | LetStmt  (XLetStmt idL idR body) (LHsLocalBindsLR idL idR)\n\n  -- ParStmts only occur in a list/monad comprehension\n  | ParStmt  (XParStmt idL idR body)    -- Post typecheck,\n                                        -- S in (>>=) :: Q -> (R -> S) -> T\n             [ParStmtBlock idL idR]\n             (HsExpr idR)               -- Polymorphic `mzip` for monad comprehensions\n             (SyntaxExpr idR)           -- The `>>=` operator\n                                        -- See notes [Monad Comprehensions]\n            -- After renaming, the ids are the binders\n            -- bound by the stmts and used after themp\n\n  | TransStmt {\n      trS_ext   :: XTransStmt idL idR body, -- Post typecheck,\n                                            -- R in (>>=) :: Q -> (R -> S) -> T\n      trS_form  :: TransForm,\n      trS_stmts :: [ExprLStmt idL],   -- Stmts to the *left* of the 'group'\n                                      -- which generates the tuples to be grouped\n\n      trS_bndrs :: [(IdP idR, IdP idR)], -- See Note [TransStmt binder map]\n\n      trS_using :: LHsExpr idR,\n      trS_by :: Maybe (LHsExpr idR),  -- \"by e\" (optional)\n        -- Invariant: if trS_form = GroupBy, then grp_by = Just e\n\n      trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for\n                                      -- the inner monad comprehensions\n      trS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator\n      trS_fmap :: HsExpr idR          -- The polymorphic 'fmap' function for desugaring\n                                      -- Only for 'group' forms\n                                      -- Just a simple HsExpr, because it's\n                                      -- too polymorphic for tcSyntaxOp\n    }                                 -- See Note [Monad Comprehensions]\n\n  -- Recursive statement (see Note [How RecStmt works] below)\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | RecStmt\n     { recS_ext :: XRecStmt idL idR body\n     , recS_stmts :: [LStmtLR idL idR body]\n\n        -- The next two fields are only valid after renaming\n     , recS_later_ids :: [IdP idR]\n                         -- The ids are a subset of the variables bound by the\n                         -- stmts that are used in stmts that follow the RecStmt\n\n     , recS_rec_ids :: [IdP idR]\n                         -- Ditto, but these variables are the \"recursive\" ones,\n                         -- that are used before they are bound in the stmts of\n                         -- the RecStmt.\n        -- An Id can be in both groups\n        -- Both sets of Ids are (now) treated monomorphically\n        -- See Note [How RecStmt works] for why they are separate\n\n        -- Rebindable syntax\n     , recS_bind_fn :: SyntaxExpr idR -- The bind function\n     , recS_ret_fn  :: SyntaxExpr idR -- The return function\n     , recS_mfix_fn :: SyntaxExpr idR -- The mfix function\n      }\n  | XStmtLR (XXStmtLR idL idR body)\n\n-- Extra fields available post typechecking for RecStmt.\ndata RecStmtTc =\n  RecStmtTc\n     { recS_bind_ty :: Type       -- S in (>>=) :: Q -> (R -> S) -> T\n     , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)\n     , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1\n                                  -- with recS_later_ids and recS_rec_ids,\n                                  -- and are the expressions that should be\n                                  -- returned by the recursion.\n                                  -- They may not quite be the Ids themselves,\n                                  -- because the Id may be *polymorphic*, but\n                                  -- the returned thing has to be *monomorphic*,\n                                  -- so they may be type applications\n\n      , recS_ret_ty :: Type        -- The type of\n                                   -- do { stmts; return (a,b,c) }\n                                   -- With rebindable syntax the type might not\n                                   -- be quite as simple as (m (tya, tyb, tyc)).\n      }\n\n\ntype instance XLastStmt        (GhcPass _) (GhcPass _) b = NoExt\n\ntype instance XBindStmt        (GhcPass _) GhcPs b = NoExt\ntype instance XBindStmt        (GhcPass _) GhcRn b = NoExt\ntype instance XBindStmt        (GhcPass _) GhcTc b = Type\n\ntype instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt\ntype instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt\ntype instance XApplicativeStmt (GhcPass _) GhcTc b = Type\n\ntype instance XBodyStmt        (GhcPass _) GhcPs b = NoExt\ntype instance XBodyStmt        (GhcPass _) GhcRn b = NoExt\ntype instance XBodyStmt        (GhcPass _) GhcTc b = Type\n\ntype instance XLetStmt         (GhcPass _) (GhcPass _) b = NoExt\n\ntype instance XParStmt         (GhcPass _) GhcPs b = NoExt\ntype instance XParStmt         (GhcPass _) GhcRn b = NoExt\ntype instance XParStmt         (GhcPass _) GhcTc b = Type\n\ntype instance XTransStmt       (GhcPass _) GhcPs b = NoExt\ntype instance XTransStmt       (GhcPass _) GhcRn b = NoExt\ntype instance XTransStmt       (GhcPass _) GhcTc b = Type\n\ntype instance XRecStmt         (GhcPass _) GhcPs b = NoExt\ntype instance XRecStmt         (GhcPass _) GhcRn b = NoExt\ntype instance XRecStmt         (GhcPass _) GhcTc b = RecStmtTc\n\ntype instance XXStmtLR         (GhcPass _) (GhcPass _) b = NoExt\n\ndata TransForm   -- The 'f' below is the 'using' function, 'e' is the by function\n  = ThenForm     -- then f               or    then f by e             (depending on trS_by)\n  | GroupForm    -- then group using f   or    then group by e using f (depending on trS_by)\n  deriving Data\n\n-- | Parenthesised Statement Block\ndata ParStmtBlock idL idR\n  = ParStmtBlock\n        (XParStmtBlock idL idR)\n        [ExprLStmt idL]\n        [IdP idR]          -- The variables to be returned\n        (SyntaxExpr idR)   -- The return operator\n  | XParStmtBlock (XXParStmtBlock idL idR)\n\ntype instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = NoExt\ntype instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt\n\n-- | Applicative Argument\ndata ApplicativeArg idL\n  = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)\n      (XApplicativeArgOne idL)\n      (LPat idL)           -- WildPat if it was a BodyStmt (see below)\n      (LHsExpr idL)\n      Bool                 -- True <=> was a BodyStmt\n                           -- False <=> was a BindStmt\n                           -- See Note [Applicative BodyStmt]\n\n  | ApplicativeArgMany     -- do { stmts; return vars }\n      (XApplicativeArgMany idL)\n      [ExprLStmt idL]      -- stmts\n      (HsExpr idL)         -- return (v1,..,vn), or just (v1,..,vn)\n      (LPat idL)           -- (v1,...,vn)\n  | XApplicativeArg (XXApplicativeArg idL)\n\ntype instance XApplicativeArgOne  (GhcPass _) = NoExt\ntype instance XApplicativeArgMany (GhcPass _) = NoExt\ntype instance XXApplicativeArg    (GhcPass _) = NoExt\n\n{-\nNote [The type of bind in Stmts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSome Stmts, notably BindStmt, keep the (>>=) bind operator.\nWe do NOT assume that it has type\n    (>>=) :: m a -> (a -> m b) -> m b\nIn some cases (see Trac #303, #1537) it might have a more\nexotic type, such as\n    (>>=) :: m i j a -> (a -> m j k b) -> m i k b\nSo we must be careful not to make assumptions about the type.\nIn particular, the monad may not be uniform throughout.\n\nNote [TransStmt binder map]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe [(idR,idR)] in a TransStmt behaves as follows:\n\n  * Before renaming: []\n\n  * After renaming:\n          [ (x27,x27), ..., (z35,z35) ]\n    These are the variables\n       bound by the stmts to the left of the 'group'\n       and used either in the 'by' clause,\n                or     in the stmts following the 'group'\n    Each item is a pair of identical variables.\n\n  * After typechecking:\n          [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]\n    Each pair has the same unique, but different *types*.\n\nNote [BodyStmt]\n~~~~~~~~~~~~~~~\nBodyStmts are a bit tricky, because what they mean\ndepends on the context.  Consider the following contexts:\n\n        A do expression of type (m res_ty)\n        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        * BodyStmt E any_ty:   do { ....; E; ... }\n                E :: m any_ty\n          Translation: E >> ...\n\n        A list comprehensions of type [elt_ty]\n        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        * BodyStmt E Bool:   [ .. | .... E ]\n                        [ .. | ..., E, ... ]\n                        [ .. | .... | ..., E | ... ]\n                E :: Bool\n          Translation: if E then fail else ...\n\n        A guard list, guarding a RHS of type rhs_ty\n        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        * BodyStmt E BooParStmtBlockl:   f x | ..., E, ... = ...rhs...\n                E :: Bool\n          Translation: if E then fail else ...\n\n        A monad comprehension of type (m res_ty)\n        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        * BodyStmt E Bool:   [ .. | .... E ]\n                E :: Bool\n          Translation: guard E >> ...\n\nArray comprehensions are handled like list comprehensions.\n\nNote [How RecStmt works]\n~~~~~~~~~~~~~~~~~~~~~~~~\nExample:\n   HsDo [ BindStmt x ex\n\n        , RecStmt { recS_rec_ids   = [a, c]\n                  , recS_stmts     = [ BindStmt b (return (a,c))\n                                     , LetStmt a = ...b...\n                                     , BindStmt c ec ]\n                  , recS_later_ids = [a, b]\n\n        , return (a b) ]\n\nHere, the RecStmt binds a,b,c; but\n  - Only a,b are used in the stmts *following* the RecStmt,\n  - Only a,c are used in the stmts *inside* the RecStmt\n        *before* their bindings\n\nWhy do we need *both* rec_ids and later_ids?  For monads they could be\ncombined into a single set of variables, but not for arrows.  That\nfollows from the types of the respective feedback operators:\n\n        mfix :: MonadFix m => (a -> m a) -> m a\n        loop :: ArrowLoop a => a (b,d) (c,d) -> a b c\n\n* For mfix, the 'a' covers the union of the later_ids and the rec_ids\n* For 'loop', 'c' is the later_ids and 'd' is the rec_ids\n\nNote [Typing a RecStmt]\n~~~~~~~~~~~~~~~~~~~~~~~\nA (RecStmt stmts) types as if you had written\n\n  (v1,..,vn, _, ..., _) <- mfix (\\~(_, ..., _, r1, ..., rm) ->\n                                 do { stmts\n                                    ; return (v1,..vn, r1, ..., rm) })\n\nwhere v1..vn are the later_ids\n      r1..rm are the rec_ids\n\nNote [Monad Comprehensions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMonad comprehensions require separate functions like 'return' and\n'>>=' for desugaring. These functions are stored in the statements\nused in monad comprehensions. For example, the 'return' of the 'LastStmt'\nexpression is used to lift the body of the monad comprehension:\n\n  [ body | stmts ]\n   =>\n  stmts >>= \\bndrs -> return body\n\nIn transform and grouping statements ('then ..' and 'then group ..') the\n'return' function is required for nested monad comprehensions, for example:\n\n  [ body | stmts, then f, rest ]\n   =>\n  f [ env | stmts ] >>= \\bndrs -> [ body | rest ]\n\nBodyStmts require the 'Control.Monad.guard' function for boolean\nexpressions:\n\n  [ body | exp, stmts ]\n   =>\n  guard exp >> [ body | stmts ]\n\nParallel statements require the 'Control.Monad.Zip.mzip' function:\n\n  [ body | stmts1 | stmts2 | .. ]\n   =>\n  mzip stmts1 (mzip stmts2 (..)) >>= \\(bndrs1, (bndrs2, ..)) -> return body\n\nIn any other context than 'MonadComp', the fields for most of these\n'SyntaxExpr's stay bottom.\n\n\nNote [Applicative BodyStmt]\n\n(#12143) For the purposes of ApplicativeDo, we treat any BodyStmt\nas if it was a BindStmt with a wildcard pattern.  For example,\n\n  do\n    x <- A\n    B\n    return x\n\nis transformed as if it were\n\n  do\n    x <- A\n    _ <- B\n    return x\n\nso it transforms to\n\n  (\\(x,_) -> x) <$> A <*> B\n\nBut we have to remember when we treat a BodyStmt like a BindStmt,\nbecause in error messages we want to emit the original syntax the user\nwrote, not our internal representation.  So ApplicativeArgOne has a\nBool flag that is True when the original statement was a BodyStmt, so\nthat we can pretty-print it correctly.\n-}\n\ninstance (Outputable (StmtLR idL idL (LHsExpr idL)),\n          Outputable (XXParStmtBlock idL idR))\n        => Outputable (ParStmtBlock idL idR) where\n  ppr (ParStmtBlock _ stmts _ _) = interpp'SP stmts\n  ppr (XParStmtBlock x)          = ppr x\n\ninstance (idL ~ GhcPass pl,idR ~ GhcPass pr,\n          OutputableBndrId idL, OutputableBndrId idR,\n          Outputable body)\n         => Outputable (StmtLR idL idR body) where\n    ppr stmt = pprStmt stmt\n\npprStmt :: forall idL idR body . (OutputableBndrId (GhcPass idL),\n                                  OutputableBndrId (GhcPass idR),\n                                  Outputable body)\n        => (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc\npprStmt (LastStmt _ expr ret_stripped _)\n  = whenPprDebug (text \"[last]\") <+>\n       (if ret_stripped then text \"return\" else empty) <+>\n       ppr expr\npprStmt (BindStmt _ pat expr _ _) = hsep [ppr pat, larrow, ppr expr]\npprStmt (LetStmt _ (L _ binds))   = hsep [text \"let\", pprBinds binds]\npprStmt (BodyStmt _ expr _ _)     = ppr expr\npprStmt (ParStmt _ stmtss _ _)   = sep (punctuate (text \" | \") (map ppr stmtss))\n\npprStmt (TransStmt { trS_stmts = stmts, trS_by = by\n                   , trS_using = using, trS_form = form })\n  = sep $ punctuate comma (map ppr stmts ++ [pprTransStmt by using form])\n\npprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids\n                 , recS_later_ids = later_ids })\n  = text \"rec\" <+>\n    vcat [ ppr_do_stmts segment\n         , whenPprDebug (vcat [ text \"rec_ids=\" <> ppr rec_ids\n                            , text \"later_ids=\" <> ppr later_ids])]\n\npprStmt (ApplicativeStmt _ args mb_join)\n  = getPprStyle $ \\style ->\n      if userStyle style\n         then pp_for_user\n         else pp_debug\n  where\n  -- make all the Applicative stuff invisible in error messages by\n  -- flattening the whole ApplicativeStmt nest back to a sequence\n  -- of statements.\n   pp_for_user = vcat $ concatMap flattenArg args\n\n   -- ppr directly rather than transforming here, because we need to\n   -- inject a \"return\" which is hard when we're polymorphic in the id\n   -- type.\n   flattenStmt :: ExprLStmt (GhcPass idL) -> [SDoc]\n   flattenStmt (L _ (ApplicativeStmt _ args _)) = concatMap flattenArg args\n   flattenStmt stmt = [ppr stmt]\n\n   flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc]\n   flattenArg (_, ApplicativeArgOne _ pat expr isBody)\n     | isBody =  -- See Note [Applicative BodyStmt]\n     [ppr (BodyStmt (panic \"pprStmt\") expr noSyntaxExpr noSyntaxExpr\n             :: ExprStmt (GhcPass idL))]\n     | otherwise =\n     [ppr (BindStmt (panic \"pprStmt\") pat expr noSyntaxExpr noSyntaxExpr\n             :: ExprStmt (GhcPass idL))]\n   flattenArg (_, ApplicativeArgMany _ stmts _ _) =\n     concatMap flattenStmt stmts\n   flattenArg (_, XApplicativeArg _) = panic \"flattenArg\"\n\n   pp_debug =\n     let\n         ap_expr = sep (punctuate (text \" |\") (map pp_arg args))\n     in\n       if isNothing mb_join\n          then ap_expr\n          else text \"join\" <+> parens ap_expr\n\n   pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc\n   pp_arg (_, ApplicativeArgOne _ pat expr isBody)\n     | isBody =  -- See Note [Applicative BodyStmt]\n     ppr (BodyStmt (panic \"pprStmt\") expr noSyntaxExpr noSyntaxExpr\n            :: ExprStmt (GhcPass idL))\n     | otherwise =\n     ppr (BindStmt (panic \"pprStmt\") pat expr noSyntaxExpr noSyntaxExpr\n            :: ExprStmt (GhcPass idL))\n   pp_arg (_, ApplicativeArgMany _ stmts return pat) =\n     ppr pat <+>\n     text \"<-\" <+>\n     ppr (HsDo (panic \"pprStmt\") DoExpr (noLoc\n               (stmts ++\n                   [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)])))\n   pp_arg (_, XApplicativeArg x) = ppr x\n\npprStmt (XStmtLR x) = ppr x\n\npprTransformStmt :: (OutputableBndrId (GhcPass p))\n                 => [IdP (GhcPass p)] -> LHsExpr (GhcPass p)\n                 -> Maybe (LHsExpr (GhcPass p)) -> SDoc\npprTransformStmt bndrs using by\n  = sep [ text \"then\" <+> whenPprDebug (braces (ppr bndrs))\n        , nest 2 (ppr using)\n        , nest 2 (pprBy by)]\n\npprTransStmt :: Outputable body => Maybe body -> body -> TransForm -> SDoc\npprTransStmt by using ThenForm\n  = sep [ text \"then\", nest 2 (ppr using), nest 2 (pprBy by)]\npprTransStmt by using GroupForm\n  = sep [ text \"then group\", nest 2 (pprBy by), nest 2 (ptext (sLit \"using\") <+> ppr using)]\n\npprBy :: Outputable body => Maybe body -> SDoc\npprBy Nothing  = empty\npprBy (Just e) = text \"by\" <+> ppr e\n\npprDo :: (OutputableBndrId (GhcPass p), Outputable body)\n      => HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc\npprDo DoExpr        stmts = text \"do\"  <+> ppr_do_stmts stmts\npprDo GhciStmtCtxt  stmts = text \"do\"  <+> ppr_do_stmts stmts\npprDo ArrowExpr     stmts = text \"do\"  <+> ppr_do_stmts stmts\npprDo MDoExpr       stmts = text \"mdo\" <+> ppr_do_stmts stmts\npprDo ListComp      stmts = brackets    $ pprComp stmts\npprDo MonadComp     stmts = brackets    $ pprComp stmts\npprDo _             _     = panic \"pprDo\" -- PatGuard, ParStmtCxt\n\nppr_do_stmts :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR),\n                 Outputable body)\n             => [LStmtLR (GhcPass idL) (GhcPass idR) body] -> SDoc\n-- Print a bunch of do stmts\nppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)\n\npprComp :: (OutputableBndrId (GhcPass p), Outputable body)\n        => [LStmt (GhcPass p) body] -> SDoc\npprComp quals     -- Prints:  body | qual1, ..., qualn\n  | Just (initStmts, L _ (LastStmt _ body _ _)) <- snocView quals\n  = if null initStmts\n       -- If there are no statements in a list comprehension besides the last\n       -- one, we simply treat it like a normal list. This does arise\n       -- occasionally in code that GHC generates, e.g., in implementations of\n       -- 'range' for derived 'Ix' instances for product datatypes with exactly\n       -- one constructor (e.g., see Trac #12583).\n       then ppr body\n       else hang (ppr body <+> vbar) 2 (pprQuals initStmts)\n  | otherwise\n  = pprPanic \"pprComp\" (pprQuals quals)\n\npprQuals :: (OutputableBndrId (GhcPass p), Outputable body)\n         => [LStmt (GhcPass p) body] -> SDoc\n-- Show list comprehension qualifiers separated by commas\npprQuals quals = interpp'SP quals\n\n{-\n************************************************************************\n*                                                                      *\n                Template Haskell quotation brackets\n*                                                                      *\n************************************************************************\n-}\n\n-- | Haskell Splice\ndata HsSplice id\n   = HsTypedSplice       --  $$z  or $$(f 4)\n        (XTypedSplice id)\n        SpliceDecoration -- Whether $$( ) variant found, for pretty printing\n        (IdP id)         -- A unique name to identify this splice point\n        (LHsExpr id)     -- See Note [Pending Splices]\n\n   | HsUntypedSplice     --  $z  or $(f 4)\n        (XUntypedSplice id)\n        SpliceDecoration -- Whether $( ) variant found, for pretty printing\n        (IdP id)         -- A unique name to identify this splice point\n        (LHsExpr id)     -- See Note [Pending Splices]\n\n   | HsQuasiQuote        -- See Note [Quasi-quote overview] in TcSplice\n        (XQuasiQuote id)\n        (IdP id)         -- Splice point\n        (IdP id)         -- Quoter\n        SrcSpan          -- The span of the enclosed string\n        FastString       -- The enclosed string\n\n   -- AZ:TODO: use XSplice instead of HsSpliced\n   | HsSpliced  -- See Note [Delaying modFinalizers in untyped splices] in\n                -- RnSplice.\n                -- This is the result of splicing a splice. It is produced by\n                -- the renamer and consumed by the typechecker. It lives only\n                -- between the two.\n        (XSpliced id)\n        ThModFinalizers     -- TH finalizers produced by the splice.\n        (HsSplicedThing id) -- The result of splicing\n   | HsSplicedT\n      DelayedSplice\n   | XSplice (XXSplice id)  -- Note [Trees that Grow] extension point\n\ntype instance XTypedSplice   (GhcPass _) = NoExt\ntype instance XUntypedSplice (GhcPass _) = NoExt\ntype instance XQuasiQuote    (GhcPass _) = NoExt\ntype instance XSpliced       (GhcPass _) = NoExt\ntype instance XXSplice       (GhcPass _) = NoExt\n\n-- | A splice can appear with various decorations wrapped around it. This data\n-- type captures explicitly how it was originally written, for use in the pretty\n-- printer.\ndata SpliceDecoration\n  = HasParens -- ^ $( splice ) or $$( splice )\n  | HasDollar -- ^ $splice or $$splice\n  | NoParens  -- ^ bare splice\n  deriving (Data, Eq, Show)\n\ninstance Outputable SpliceDecoration where\n  ppr x = text $ show x\n\n\nisTypedSplice :: HsSplice id -> Bool\nisTypedSplice (HsTypedSplice {}) = True\nisTypedSplice _                  = False   -- Quasi-quotes are untyped splices\n\n-- | Finalizers produced by a splice with\n-- 'Language.Haskell.TH.Syntax.addModFinalizer'\n--\n-- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how\n-- this is used.\n--\nnewtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())]\n\n-- A Data instance which ignores the argument of 'ThModFinalizers'.\ninstance Data ThModFinalizers where\n  gunfold _ z _ = z $ ThModFinalizers []\n  toConstr  a   = mkConstr (dataTypeOf a) \"ThModFinalizers\" [] Data.Prefix\n  dataTypeOf a  = mkDataType \"HsExpr.ThModFinalizers\" [toConstr a]\n\n-- See Note [Running typed splices in the zonker]\n-- These are the arguments that are passed to `TcSplice.runTopSplice`\ndata DelayedSplice =\n  DelayedSplice\n    TcLclEnv          -- The local environment to run the splice in\n    (LHsExpr GhcRn)   -- The original renamed expression\n    TcType            -- The result type of running the splice, unzonked\n    (LHsExpr GhcTcId) -- The typechecked expression to run and splice in the result\n\n-- A Data instance which ignores the argument of 'DelayedSplice'.\ninstance Data DelayedSplice where\n  gunfold _ _ _ = panic \"DelayedSplice\"\n  toConstr  a   = mkConstr (dataTypeOf a) \"DelayedSplice\" [] Data.Prefix\n  dataTypeOf a  = mkDataType \"HsExpr.DelayedSplice\" [toConstr a]\n\n-- | Haskell Spliced Thing\n--\n-- Values that can result from running a splice.\ndata HsSplicedThing id\n    = HsSplicedExpr (HsExpr id) -- ^ Haskell Spliced Expression\n    | HsSplicedTy   (HsType id) -- ^ Haskell Spliced Type\n    | HsSplicedPat  (Pat id)    -- ^ Haskell Spliced Pattern\n\n\n-- See Note [Pending Splices]\ntype SplicePointName = Name\n\n-- | Pending Renamer Splice\ndata PendingRnSplice\n  = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn)\n\ndata UntypedSpliceFlavour\n  = UntypedExpSplice\n  | UntypedPatSplice\n  | UntypedTypeSplice\n  | UntypedDeclSplice\n  deriving Data\n\n-- | Pending Type-checker Splice\ndata PendingTcSplice\n  = PendingTcSplice SplicePointName (LHsExpr GhcTc)\n\n{-\nNote [Pending Splices]\n~~~~~~~~~~~~~~~~~~~~~~\nWhen we rename an untyped bracket, we name and lift out all the nested\nsplices, so that when the typechecker hits the bracket, it can\ntypecheck those nested splices without having to walk over the untyped\nbracket code.  So for example\n    [| f $(g x) |]\nlooks like\n\n    HsBracket (HsApp (HsVar \"f\") (HsSpliceE _ (g x)))\n\nwhich the renamer rewrites to\n\n    HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))\n                   [PendingRnSplice UntypedExpSplice sn (g x)]\n\n* The 'sn' is the Name of the splice point, the SplicePointName\n\n* The PendingRnExpSplice gives the splice that splice-point name maps to;\n  and the typechecker can now conveniently find these sub-expressions\n\n* The other copy of the splice, in the second argument of HsSpliceE\n                                in the renamed first arg of HsRnBracketOut\n  is used only for pretty printing\n\nThere are four varieties of pending splices generated by the renamer,\ndistinguished by their UntypedSpliceFlavour\n\n * Pending expression splices (UntypedExpSplice), e.g.,\n       [|$(f x) + 2|]\n\n   UntypedExpSplice is also used for\n     * quasi-quotes, where the pending expression expands to\n          $(quoter \"...blah...\")\n       (see RnSplice.makePending, HsQuasiQuote case)\n\n     * cross-stage lifting, where the pending expression expands to\n          $(lift x)\n       (see RnSplice.checkCrossStageLifting)\n\n * Pending pattern splices (UntypedPatSplice), e.g.,\n       [| \\$(f x) -> x |]\n\n * Pending type splices (UntypedTypeSplice), e.g.,\n       [| f :: $(g x) |]\n\n * Pending declaration (UntypedDeclSplice), e.g.,\n       [| let $(f x) in ... |]\n\nThere is a fifth variety of pending splice, which is generated by the type\nchecker:\n\n  * Pending *typed* expression splices, (PendingTcSplice), e.g.,\n        [||1 + $$(f 2)||]\n\nIt would be possible to eliminate HsRnBracketOut and use HsBracketOut for the\noutput of the renamer. However, when pretty printing the output of the renamer,\ne.g., in a type error message, we *do not* want to print out the pending\nsplices. In contrast, when pretty printing the output of the type checker, we\n*do* want to print the pending splices. So splitting them up seems to make\nsense, although I hate to add another constructor to HsExpr.\n-}\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (HsSplicedThing p) where\n  ppr (HsSplicedExpr e) = ppr_expr e\n  ppr (HsSplicedTy   t) = ppr t\n  ppr (HsSplicedPat  p) = ppr p\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsSplice p) where\n  ppr s = pprSplice s\n\npprPendingSplice :: (OutputableBndrId (GhcPass p))\n                 => SplicePointName -> LHsExpr (GhcPass p) -> SDoc\npprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)\n\npprSpliceDecl ::  (OutputableBndrId (GhcPass p))\n          => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc\npprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e\npprSpliceDecl e ExplicitSplice   = text \"$(\" <> ppr_splice_decl e <> text \")\"\npprSpliceDecl e ImplicitSplice   = ppr_splice_decl e\n\nppr_splice_decl :: (OutputableBndrId (GhcPass p))\n                => HsSplice (GhcPass p) -> SDoc\nppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty\nppr_splice_decl e = pprSplice e\n\npprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc\npprSplice (HsTypedSplice _ HasParens  n e)\n  = ppr_splice (text \"$$(\") n e (text \")\")\npprSplice (HsTypedSplice _ HasDollar n e)\n  = ppr_splice (text \"$$\") n e empty\npprSplice (HsTypedSplice _ NoParens n e)\n  = ppr_splice empty n e empty\npprSplice (HsUntypedSplice _ HasParens  n e)\n  = ppr_splice (text \"$(\") n e (text \")\")\npprSplice (HsUntypedSplice _ HasDollar n e)\n  = ppr_splice (text \"$\")  n e empty\npprSplice (HsUntypedSplice _ NoParens n e)\n  = ppr_splice empty  n e empty\npprSplice (HsQuasiQuote _ n q _ s)      = ppr_quasi n q s\npprSplice (HsSpliced _ _ thing)         = ppr thing\npprSplice (HsSplicedT {})               = text \"Unevaluated typed splice\"\npprSplice (XSplice x)                   = ppr x\n\nppr_quasi :: OutputableBndr p => p -> p -> FastString -> SDoc\nppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <>\n                           char '[' <> ppr quoter <> vbar <>\n                           ppr quote <> text \"|]\"\n\nppr_splice :: (OutputableBndrId (GhcPass p))\n           => SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc\nppr_splice herald n e trail\n    = herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail\n\n-- | Haskell Bracket\ndata HsBracket p\n  = ExpBr  (XExpBr p)   (LHsExpr p)    -- [|  expr  |]\n  | PatBr  (XPatBr p)   (LPat p)      -- [p| pat   |]\n  | DecBrL (XDecBrL p)  [LHsDecl p]   -- [d| decls |]; result of parser\n  | DecBrG (XDecBrG p)  (HsGroup p)   -- [d| decls |]; result of renamer\n  | TypBr  (XTypBr p)   (LHsType p)   -- [t| type  |]\n  | VarBr  (XVarBr p)   Bool (IdP p)  -- True: 'x, False: ''T\n                                -- (The Bool flag is used only in pprHsBracket)\n  | TExpBr (XTExpBr p) (LHsExpr p)    -- [||  expr  ||]\n  | XBracket (XXBracket p)            -- Note [Trees that Grow] extension point\n\ntype instance XExpBr      (GhcPass _) = NoExt\ntype instance XPatBr      (GhcPass _) = NoExt\ntype instance XDecBrL     (GhcPass _) = NoExt\ntype instance XDecBrG     (GhcPass _) = NoExt\ntype instance XTypBr      (GhcPass _) = NoExt\ntype instance XVarBr      (GhcPass _) = NoExt\ntype instance XTExpBr     (GhcPass _) = NoExt\ntype instance XXBracket   (GhcPass _) = NoExt\n\nisTypedBracket :: HsBracket id -> Bool\nisTypedBracket (TExpBr {}) = True\nisTypedBracket _           = False\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n          => Outputable (HsBracket p) where\n  ppr = pprHsBracket\n\n\npprHsBracket :: (OutputableBndrId (GhcPass p)) => HsBracket (GhcPass p) -> SDoc\npprHsBracket (ExpBr _ e)   = thBrackets empty (ppr e)\npprHsBracket (PatBr _ p)   = thBrackets (char 'p') (ppr p)\npprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)\npprHsBracket (DecBrL _ ds) = thBrackets (char 'd') (vcat (map ppr ds))\npprHsBracket (TypBr _ t)   = thBrackets (char 't') (ppr t)\npprHsBracket (VarBr _ True n)\n  = char '\\'' <> pprPrefixOcc n\npprHsBracket (VarBr _ False n)\n  = text \"''\" <> pprPrefixOcc n\npprHsBracket (TExpBr _ e)  = thTyBrackets (ppr e)\npprHsBracket (XBracket e)  = ppr e\n\nthBrackets :: SDoc -> SDoc -> SDoc\nthBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>\n                             pp_body <+> text \"|]\"\n\nthTyBrackets :: SDoc -> SDoc\nthTyBrackets pp_body = text \"[||\" <+> pp_body <+> ptext (sLit \"||]\")\n\ninstance Outputable PendingRnSplice where\n  ppr (PendingRnSplice _ n e) = pprPendingSplice n e\n\ninstance Outputable PendingTcSplice where\n  ppr (PendingTcSplice n e) = pprPendingSplice n e\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Enumerations and list comprehensions}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Arithmetic Sequence Information\ndata ArithSeqInfo id\n  = From            (LHsExpr id)\n  | FromThen        (LHsExpr id)\n                    (LHsExpr id)\n  | FromTo          (LHsExpr id)\n                    (LHsExpr id)\n  | FromThenTo      (LHsExpr id)\n                    (LHsExpr id)\n                    (LHsExpr id)\n-- AZ: Sould ArithSeqInfo have a TTG extension?\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n         => Outputable (ArithSeqInfo p) where\n    ppr (From e1)             = hcat [ppr e1, pp_dotdot]\n    ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]\n    ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]\n    ppr (FromThenTo e1 e2 e3)\n      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]\n\npp_dotdot :: SDoc\npp_dotdot = text \" .. \"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{HsMatchCtxt}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Haskell Match Context\n--\n-- Context of a pattern match. This is more subtle than it would seem. See Note\n-- [Varieties of pattern matches].\ndata HsMatchContext id -- Not an extensible tag\n  = FunRhs { mc_fun        :: Located id    -- ^ function binder of @f@\n           , mc_fixity     :: LexicalFixity -- ^ fixing of @f@\n           , mc_strictness :: SrcStrictness -- ^ was @f@ banged?\n                                            -- See Note [FunBind vs PatBind]\n           }\n                                -- ^A pattern matching on an argument of a\n                                -- function binding\n  | LambdaExpr                  -- ^Patterns of a lambda\n  | CaseAlt                     -- ^Patterns and guards on a case alternative\n  | IfAlt                       -- ^Guards of a multi-way if alternative\n  | ProcExpr                    -- ^Patterns of a proc\n  | PatBindRhs                  -- ^A pattern binding  eg [y] <- e = e\n  | PatBindGuards               -- ^Guards of pattern bindings, e.g.,\n                                --    (Just b) | Just _ <- x = e\n                                --             | otherwise   = e'\n\n  | RecUpd                      -- ^Record update [used only in DsExpr to\n                                --    tell matchWrapper what sort of\n                                --    runtime error message to generate]\n\n  | StmtCtxt (HsStmtContext id) -- ^Pattern of a do-stmt, list comprehension,\n                                -- pattern guard, etc\n\n  | ThPatSplice            -- ^A Template Haskell pattern splice\n  | ThPatQuote             -- ^A Template Haskell pattern quotation [p| (a,b) |]\n  | PatSyn                 -- ^A pattern synonym declaration\n  deriving Functor\nderiving instance (Data id) => Data (HsMatchContext id)\n\ninstance OutputableBndr id => Outputable (HsMatchContext id) where\n  ppr m@(FunRhs{})          = text \"FunRhs\" <+> ppr (mc_fun m) <+> ppr (mc_fixity m)\n  ppr LambdaExpr            = text \"LambdaExpr\"\n  ppr CaseAlt               = text \"CaseAlt\"\n  ppr IfAlt                 = text \"IfAlt\"\n  ppr ProcExpr              = text \"ProcExpr\"\n  ppr PatBindRhs            = text \"PatBindRhs\"\n  ppr PatBindGuards         = text \"PatBindGuards\"\n  ppr RecUpd                = text \"RecUpd\"\n  ppr (StmtCtxt _)          = text \"StmtCtxt _\"\n  ppr ThPatSplice           = text \"ThPatSplice\"\n  ppr ThPatQuote            = text \"ThPatQuote\"\n  ppr PatSyn                = text \"PatSyn\"\n\nisPatSynCtxt :: HsMatchContext id -> Bool\nisPatSynCtxt ctxt =\n  case ctxt of\n    PatSyn -> True\n    _      -> False\n\n-- | Haskell Statement Context. It expects to be parameterised with one of\n-- 'RdrName', 'Name' or 'Id'\ndata HsStmtContext id\n  = ListComp\n  | MonadComp\n\n  | DoExpr                           -- ^do { ... }\n  | MDoExpr                          -- ^mdo { ... }  ie recursive do-expression\n  | ArrowExpr                        -- ^do-notation in an arrow-command context\n\n  | GhciStmtCtxt                     -- ^A command-line Stmt in GHCi pat <- rhs\n  | PatGuard (HsMatchContext id)     -- ^Pattern guard for specified thing\n  | ParStmtCtxt (HsStmtContext id)   -- ^A branch of a parallel stmt\n  | TransStmtCtxt (HsStmtContext id) -- ^A branch of a transform stmt\n  deriving Functor\nderiving instance (Data id) => Data (HsStmtContext id)\n\nisComprehensionContext :: HsStmtContext id -> Bool\n-- Uses comprehension syntax [ e | quals ]\nisComprehensionContext ListComp          = True\nisComprehensionContext MonadComp         = True\nisComprehensionContext (ParStmtCtxt c)   = isComprehensionContext c\nisComprehensionContext (TransStmtCtxt c) = isComprehensionContext c\nisComprehensionContext _ = False\n\n-- | Should pattern match failure in a 'HsStmtContext' be desugared using\n-- 'MonadFail'?\nisMonadFailStmtContext :: HsStmtContext id -> Bool\nisMonadFailStmtContext MonadComp            = True\nisMonadFailStmtContext DoExpr               = True\nisMonadFailStmtContext MDoExpr              = True\nisMonadFailStmtContext GhciStmtCtxt         = True\nisMonadFailStmtContext (ParStmtCtxt ctxt)   = isMonadFailStmtContext ctxt\nisMonadFailStmtContext (TransStmtCtxt ctxt) = isMonadFailStmtContext ctxt\nisMonadFailStmtContext _ = False -- ListComp, PatGuard, ArrowExpr\n\nisMonadCompContext :: HsStmtContext id -> Bool\nisMonadCompContext MonadComp = True\nisMonadCompContext _         = False\n\nmatchSeparator :: HsMatchContext id -> SDoc\nmatchSeparator (FunRhs {})   = text \"=\"\nmatchSeparator CaseAlt       = text \"->\"\nmatchSeparator IfAlt         = text \"->\"\nmatchSeparator LambdaExpr    = text \"->\"\nmatchSeparator ProcExpr      = text \"->\"\nmatchSeparator PatBindRhs    = text \"=\"\nmatchSeparator PatBindGuards = text \"=\"\nmatchSeparator (StmtCtxt _)  = text \"<-\"\nmatchSeparator RecUpd        = text \"=\" -- This can be printed by the pattern\n                                       -- match checker trace\nmatchSeparator ThPatSplice  = panic \"unused\"\nmatchSeparator ThPatQuote   = panic \"unused\"\nmatchSeparator PatSyn       = panic \"unused\"\n\npprMatchContext :: (Outputable (NameOrRdrName id),Outputable id)\n                => HsMatchContext id -> SDoc\npprMatchContext ctxt\n  | want_an ctxt = text \"an\" <+> pprMatchContextNoun ctxt\n  | otherwise    = text \"a\"  <+> pprMatchContextNoun ctxt\n  where\n    want_an (FunRhs {}) = True  -- Use \"an\" in front\n    want_an ProcExpr    = True\n    want_an _           = False\n\npprMatchContextNoun :: (Outputable (NameOrRdrName id),Outputable id)\n                    => HsMatchContext id -> SDoc\npprMatchContextNoun (FunRhs {mc_fun=L _ fun})\n                                    = text \"equation for\"\n                                      <+> quotes (ppr fun)\npprMatchContextNoun CaseAlt         = text \"case alternative\"\npprMatchContextNoun IfAlt           = text \"multi-way if alternative\"\npprMatchContextNoun RecUpd          = text \"record-update construct\"\npprMatchContextNoun ThPatSplice     = text \"Template Haskell pattern splice\"\npprMatchContextNoun ThPatQuote      = text \"Template Haskell pattern quotation\"\npprMatchContextNoun PatBindRhs      = text \"pattern binding\"\npprMatchContextNoun PatBindGuards   = text \"pattern binding guards\"\npprMatchContextNoun LambdaExpr      = text \"lambda abstraction\"\npprMatchContextNoun ProcExpr        = text \"arrow abstraction\"\npprMatchContextNoun (StmtCtxt ctxt) = text \"pattern binding in\"\n                                      $$ pprAStmtContext ctxt\npprMatchContextNoun PatSyn          = text \"pattern synonym declaration\"\n\n-----------------\npprAStmtContext, pprStmtContext :: (Outputable id,\n                                    Outputable (NameOrRdrName id))\n                                => HsStmtContext id -> SDoc\npprAStmtContext ctxt = article <+> pprStmtContext ctxt\n  where\n    pp_an = text \"an\"\n    pp_a  = text \"a\"\n    article = case ctxt of\n                  MDoExpr       -> pp_an\n                  GhciStmtCtxt  -> pp_an\n                  _             -> pp_a\n\n\n-----------------\npprStmtContext GhciStmtCtxt    = text \"interactive GHCi command\"\npprStmtContext DoExpr          = text \"'do' block\"\npprStmtContext MDoExpr         = text \"'mdo' block\"\npprStmtContext ArrowExpr       = text \"'do' block in an arrow command\"\npprStmtContext ListComp        = text \"list comprehension\"\npprStmtContext MonadComp       = text \"monad comprehension\"\npprStmtContext (PatGuard ctxt) = text \"pattern guard for\" $$ pprMatchContext ctxt\n\n-- Drop the inner contexts when reporting errors, else we get\n--     Unexpected transform statement\n--     in a transformed branch of\n--          transformed branch of\n--          transformed branch of monad comprehension\npprStmtContext (ParStmtCtxt c) =\n  ifPprDebug (sep [text \"parallel branch of\", pprAStmtContext c])\n             (pprStmtContext c)\npprStmtContext (TransStmtCtxt c) =\n  ifPprDebug (sep [text \"transformed branch of\", pprAStmtContext c])\n             (pprStmtContext c)\n\ninstance (Outputable p, Outputable (NameOrRdrName p))\n      => Outputable (HsStmtContext p) where\n    ppr = pprStmtContext\n\n-- Used to generate the string for a *runtime* error message\nmatchContextErrString :: Outputable id\n                      => HsMatchContext id -> SDoc\nmatchContextErrString (FunRhs{mc_fun=L _ fun})   = text \"function\" <+> ppr fun\nmatchContextErrString CaseAlt                    = text \"case\"\nmatchContextErrString IfAlt                      = text \"multi-way if\"\nmatchContextErrString PatBindRhs                 = text \"pattern binding\"\nmatchContextErrString PatBindGuards              = text \"pattern binding guards\"\nmatchContextErrString RecUpd                     = text \"record update\"\nmatchContextErrString LambdaExpr                 = text \"lambda\"\nmatchContextErrString ProcExpr                   = text \"proc\"\nmatchContextErrString ThPatSplice                = panic \"matchContextErrString\"  -- Not used at runtime\nmatchContextErrString ThPatQuote                 = panic \"matchContextErrString\"  -- Not used at runtime\nmatchContextErrString PatSyn                     = panic \"matchContextErrString\"  -- Not used at runtime\nmatchContextErrString (StmtCtxt (ParStmtCtxt c))   = matchContextErrString (StmtCtxt c)\nmatchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)\nmatchContextErrString (StmtCtxt (PatGuard _))      = text \"pattern guard\"\nmatchContextErrString (StmtCtxt GhciStmtCtxt)      = text \"interactive GHCi command\"\nmatchContextErrString (StmtCtxt DoExpr)            = text \"'do' block\"\nmatchContextErrString (StmtCtxt ArrowExpr)         = text \"'do' block\"\nmatchContextErrString (StmtCtxt MDoExpr)           = text \"'mdo' block\"\nmatchContextErrString (StmtCtxt ListComp)          = text \"list comprehension\"\nmatchContextErrString (StmtCtxt MonadComp)         = text \"monad comprehension\"\n\npprMatchInCtxt :: (OutputableBndrId (GhcPass idR),\n                   -- TODO:AZ these constraints do not make sense\n                 Outputable (NameOrRdrName (NameOrRdrName (IdP (GhcPass idR)))),\n                 Outputable body)\n               => Match (GhcPass idR) body -> SDoc\npprMatchInCtxt match  = hang (text \"In\" <+> pprMatchContext (m_ctxt match)\n                                        <> colon)\n                             4 (pprMatch match)\n\npprStmtInCtxt :: (OutputableBndrId (GhcPass idL),\n                  OutputableBndrId (GhcPass idR),\n                  Outputable body)\n              => HsStmtContext (IdP (GhcPass idL))\n              -> StmtLR (GhcPass idL) (GhcPass idR) body\n              -> SDoc\npprStmtInCtxt ctxt (LastStmt _ e _ _)\n  | isComprehensionContext ctxt      -- For [ e | .. ], do not mutter about \"stmts\"\n  = hang (text \"In the expression:\") 2 (ppr e)\n\npprStmtInCtxt ctxt stmt\n  = hang (text \"In a stmt of\" <+> pprAStmtContext ctxt <> colon)\n       2 (ppr_stmt stmt)\n  where\n    -- For Group and Transform Stmts, don't print the nested stmts!\n    ppr_stmt (TransStmt { trS_by = by, trS_using = using\n                        , trS_form = form }) = pprTransStmt by using form\n    ppr_stmt stmt = pprStmt stmt\n", "num_lines": 2879}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n\nmodule HsExtension where\n\n-- This module captures the type families to precisely identify the extension\n-- points for HsSyn\n\nimport GhcPrelude\n\nimport Data.Data hiding ( Fixity )\nimport PlaceHolder\nimport Name\nimport RdrName\nimport Var\nimport Outputable\nimport SrcLoc (Located)\n\nimport Data.Kind\n\n{-\nNote [Trees that grow]\n~~~~~~~~~~~~~~~~~~~~~~\n\nSee https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow\n\nThe hsSyn AST is reused across multiple compiler passes. We also have the\nTemplate Haskell AST, and the haskell-src-exts one (outside of GHC)\n\nSupporting multiple passes means the AST has various warts on it to cope with\nthe specifics for the phases, such as the 'ValBindsOut', 'ConPatOut',\n'SigPatOut' etc.\n\nThe growable AST will allow each of these variants to be captured explicitly,\nsuch that they only exist in the given compiler pass AST, as selected by the\ntype parameter to the AST.\n\nIn addition it will allow tool writers to define their own extensions to capture\nadditional information for the tool, in a natural way.\n\nA further goal is to provide a means to harmonise the Template Haskell and\nhaskell-src-exts ASTs as well.\n\n-}\n\n-- | used as place holder in TTG values\ndata NoExt = NoExt\n  deriving (Data,Eq,Ord)\n\ninstance Outputable NoExt where\n  ppr _ = text \"NoExt\"\n\n-- | Used when constructing a term with an unused extension point.\nnoExt :: NoExt\nnoExt = NoExt\n\n-- | Used as a data type index for the hsSyn AST\ndata GhcPass (c :: Pass)\nderiving instance Eq (GhcPass c)\nderiving instance Typeable c => Data (GhcPass c)\n\ndata Pass = Parsed | Renamed | Typechecked\n         deriving (Data)\n\n-- Type synonyms as a shorthand for tagging\ntype GhcPs   = GhcPass 'Parsed      -- Old 'RdrName' type param\ntype GhcRn   = GhcPass 'Renamed     -- Old 'Name' type param\ntype GhcTc   = GhcPass 'Typechecked -- Old 'Id' type para,\ntype GhcTcId = GhcTc                -- Old 'TcId' type param\n\n-- | Maps the \"normal\" id type for a given pass\ntype family IdP p\ntype instance IdP GhcPs = RdrName\ntype instance IdP GhcRn = Name\ntype instance IdP GhcTc = Id\n\ntype LIdP p = Located (IdP p)\n\n-- | Marks that a field uses the GhcRn variant even when the pass\n-- parameter is GhcTc. Useful for storing HsTypes in HsExprs, say, because\n-- HsType GhcTc should never occur.\ntype family NoGhcTc (p :: Type) where\n    -- this way, GHC can figure out that the result is a GhcPass\n  NoGhcTc (GhcPass pass) = GhcPass (NoGhcTcPass pass)\n  NoGhcTc other          = other\n\ntype family NoGhcTcPass (p :: Pass) :: Pass where\n  NoGhcTcPass 'Typechecked = 'Renamed\n  NoGhcTcPass other        = other\n\n-- =====================================================================\n-- Type families for the HsBinds extension points\n\n-- HsLocalBindsLR type families\ntype family XHsValBinds      x x'\ntype family XHsIPBinds       x x'\ntype family XEmptyLocalBinds x x'\ntype family XXHsLocalBindsLR x x'\n\ntype ForallXHsLocalBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =\n       ( c (XHsValBinds      x x')\n       , c (XHsIPBinds       x x')\n       , c (XEmptyLocalBinds x x')\n       , c (XXHsLocalBindsLR x x')\n       )\n\n-- ValBindsLR type families\ntype family XValBinds    x x'\ntype family XXValBindsLR x x'\n\ntype ForallXValBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =\n       ( c (XValBinds    x x')\n       , c (XXValBindsLR x x')\n       )\n\n\n-- HsBindsLR type families\ntype family XFunBind    x x'\ntype family XPatBind    x x'\ntype family XVarBind    x x'\ntype family XAbsBinds   x x'\ntype family XPatSynBind x x'\ntype family XXHsBindsLR x x'\n\ntype ForallXHsBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =\n       ( c (XFunBind    x x')\n       , c (XPatBind    x x')\n       , c (XVarBind    x x')\n       , c (XAbsBinds   x x')\n       , c (XPatSynBind x x')\n       , c (XXHsBindsLR x x')\n       )\n\n-- ABExport type families\ntype family XABE x\ntype family XXABExport x\n\ntype ForallXABExport (c :: * -> Constraint) (x :: *) =\n       ( c (XABE       x)\n       , c (XXABExport x)\n       )\n\n-- PatSynBind type families\ntype family XPSB x x'\ntype family XXPatSynBind x x'\n\ntype ForallXPatSynBind  (c :: * -> Constraint) (x :: *) (x' :: *) =\n       ( c (XPSB         x x')\n       , c (XXPatSynBind x x')\n       )\n\n-- HsIPBinds type families\ntype family XIPBinds    x\ntype family XXHsIPBinds x\n\ntype ForallXHsIPBinds (c :: * -> Constraint) (x :: *) =\n       ( c (XIPBinds    x)\n       , c (XXHsIPBinds x)\n       )\n\n-- IPBind type families\ntype family XCIPBind x\ntype family XXIPBind x\n\ntype ForallXIPBind (c :: * -> Constraint) (x :: *) =\n       ( c (XCIPBind x)\n       , c (XXIPBind x)\n       )\n\n-- Sig type families\ntype family XTypeSig          x\ntype family XPatSynSig        x\ntype family XClassOpSig       x\ntype family XIdSig            x\ntype family XFixSig           x\ntype family XInlineSig        x\ntype family XSpecSig          x\ntype family XSpecInstSig      x\ntype family XMinimalSig       x\ntype family XSCCFunSig        x\ntype family XCompleteMatchSig x\ntype family XXSig             x\n\ntype ForallXSig (c :: * -> Constraint) (x :: *) =\n       ( c (XTypeSig          x)\n       , c (XPatSynSig        x)\n       , c (XClassOpSig       x)\n       , c (XIdSig            x)\n       , c (XFixSig           x)\n       , c (XInlineSig        x)\n       , c (XSpecSig          x)\n       , c (XSpecInstSig      x)\n       , c (XMinimalSig       x)\n       , c (XSCCFunSig        x)\n       , c (XCompleteMatchSig x)\n       , c (XXSig             x)\n       )\n\n-- FixitySig type families\ntype family XFixitySig          x\ntype family XXFixitySig         x\n\ntype ForallXFixitySig (c :: * -> Constraint) (x :: *) =\n       ( c (XFixitySig         x)\n       , c (XXFixitySig        x)\n       )\n\n-- =====================================================================\n-- Type families for the HsDecls extension points\n\n-- HsDecl type families\ntype family XTyClD       x\ntype family XInstD       x\ntype family XDerivD      x\ntype family XValD        x\ntype family XSigD        x\ntype family XDefD        x\ntype family XForD        x\ntype family XWarningD    x\ntype family XAnnD        x\ntype family XRuleD       x\ntype family XSpliceD     x\ntype family XDocD        x\ntype family XRoleAnnotD  x\ntype family XXHsDecl     x\n\ntype ForallXHsDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XTyClD       x)\n       , c (XInstD       x)\n       , c (XDerivD      x)\n       , c (XValD        x)\n       , c (XSigD        x)\n       , c (XDefD        x)\n       , c (XForD        x)\n       , c (XWarningD    x)\n       , c (XAnnD        x)\n       , c (XRuleD       x)\n       , c (XSpliceD     x)\n       , c (XDocD        x)\n       , c (XRoleAnnotD  x)\n       , c (XXHsDecl    x)\n       )\n\n-- -------------------------------------\n-- HsGroup type families\ntype family XCHsGroup      x\ntype family XXHsGroup      x\n\ntype ForallXHsGroup (c :: * -> Constraint) (x :: *) =\n       ( c (XCHsGroup       x)\n       , c (XXHsGroup       x)\n       )\n\n-- -------------------------------------\n-- SpliceDecl type families\ntype family XSpliceDecl       x\ntype family XXSpliceDecl      x\n\ntype ForallXSpliceDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XSpliceDecl        x)\n       , c (XXSpliceDecl       x)\n       )\n\n-- -------------------------------------\n-- TyClDecl type families\ntype family XFamDecl       x\ntype family XSynDecl       x\ntype family XDataDecl      x\ntype family XClassDecl     x\ntype family XXTyClDecl     x\n\ntype ForallXTyClDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XFamDecl       x)\n       , c (XSynDecl       x)\n       , c (XDataDecl      x)\n       , c (XClassDecl     x)\n       , c (XXTyClDecl     x)\n       )\n\n-- -------------------------------------\n-- TyClGroup type families\ntype family XCTyClGroup      x\ntype family XXTyClGroup      x\n\ntype ForallXTyClGroup (c :: * -> Constraint) (x :: *) =\n       ( c (XCTyClGroup       x)\n       , c (XXTyClGroup       x)\n       )\n\n-- -------------------------------------\n-- FamilyResultSig type families\ntype family XNoSig            x\ntype family XCKindSig         x -- Clashes with XKindSig above\ntype family XTyVarSig         x\ntype family XXFamilyResultSig x\n\ntype ForallXFamilyResultSig (c :: * -> Constraint) (x :: *) =\n       ( c (XNoSig            x)\n       , c (XCKindSig         x)\n       , c (XTyVarSig         x)\n       , c (XXFamilyResultSig x)\n       )\n\n-- -------------------------------------\n-- FamilyDecl type families\ntype family XCFamilyDecl      x\ntype family XXFamilyDecl      x\n\ntype ForallXFamilyDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XCFamilyDecl       x)\n       , c (XXFamilyDecl       x)\n       )\n\n-- -------------------------------------\n-- HsDataDefn type families\ntype family XCHsDataDefn      x\ntype family XXHsDataDefn      x\n\ntype ForallXHsDataDefn (c :: * -> Constraint) (x :: *) =\n       ( c (XCHsDataDefn       x)\n       , c (XXHsDataDefn       x)\n       )\n\n-- -------------------------------------\n-- HsDerivingClause type families\ntype family XCHsDerivingClause      x\ntype family XXHsDerivingClause      x\n\ntype ForallXHsDerivingClause (c :: * -> Constraint) (x :: *) =\n       ( c (XCHsDerivingClause       x)\n       , c (XXHsDerivingClause       x)\n       )\n\n-- -------------------------------------\n-- ConDecl type families\ntype family XConDeclGADT   x\ntype family XConDeclH98    x\ntype family XXConDecl      x\n\ntype ForallXConDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XConDeclGADT    x)\n       , c (XConDeclH98     x)\n       , c (XXConDecl       x)\n       )\n\n-- -------------------------------------\n-- FamEqn type families\ntype family XCFamEqn      x p r\ntype family XXFamEqn      x p r\n\ntype ForallXFamEqn (c :: * -> Constraint) (x :: *) (p :: *) (r :: *) =\n       ( c (XCFamEqn       x p r)\n       , c (XXFamEqn       x p r)\n       )\n\n-- -------------------------------------\n-- ClsInstDecl type families\ntype family XCClsInstDecl      x\ntype family XXClsInstDecl      x\n\ntype ForallXClsInstDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XCClsInstDecl       x)\n       , c (XXClsInstDecl       x)\n       )\n\n-- -------------------------------------\n-- ClsInstDecl type families\ntype family XClsInstD      x\ntype family XDataFamInstD  x\ntype family XTyFamInstD    x\ntype family XXInstDecl     x\n\ntype ForallXInstDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XClsInstD       x)\n       , c (XDataFamInstD   x)\n       , c (XTyFamInstD     x)\n       , c (XXInstDecl      x)\n       )\n\n-- -------------------------------------\n-- DerivDecl type families\ntype family XCDerivDecl      x\ntype family XXDerivDecl      x\n\ntype ForallXDerivDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XCDerivDecl       x)\n       , c (XXDerivDecl       x)\n       )\n\n-- -------------------------------------\n-- DerivStrategy type family\ntype family XViaStrategy x\n\n-- -------------------------------------\n-- DefaultDecl type families\ntype family XCDefaultDecl      x\ntype family XXDefaultDecl      x\n\ntype ForallXDefaultDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XCDefaultDecl       x)\n       , c (XXDefaultDecl       x)\n       )\n\n-- -------------------------------------\n-- DefaultDecl type families\ntype family XForeignImport     x\ntype family XForeignExport     x\ntype family XXForeignDecl      x\n\ntype ForallXForeignDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XForeignImport      x)\n       , c (XForeignExport      x)\n       , c (XXForeignDecl       x)\n       )\n\n-- -------------------------------------\n-- RuleDecls type families\ntype family XCRuleDecls      x\ntype family XXRuleDecls      x\n\ntype ForallXRuleDecls (c :: * -> Constraint) (x :: *) =\n       ( c (XCRuleDecls       x)\n       , c (XXRuleDecls       x)\n       )\n\n\n-- -------------------------------------\n-- RuleDecl type families\ntype family XHsRule          x\ntype family XXRuleDecl       x\n\ntype ForallXRuleDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XHsRule           x)\n       , c (XXRuleDecl        x)\n       )\n\n-- -------------------------------------\n-- RuleBndr type families\ntype family XCRuleBndr      x\ntype family XRuleBndrSig    x\ntype family XXRuleBndr      x\n\ntype ForallXRuleBndr (c :: * -> Constraint) (x :: *) =\n       ( c (XCRuleBndr       x)\n       , c (XRuleBndrSig     x)\n       , c (XXRuleBndr       x)\n       )\n\n-- -------------------------------------\n-- WarnDecls type families\ntype family XWarnings        x\ntype family XXWarnDecls      x\n\ntype ForallXWarnDecls (c :: * -> Constraint) (x :: *) =\n       ( c (XWarnings        x)\n       , c (XXWarnDecls      x)\n       )\n\n-- -------------------------------------\n-- AnnDecl type families\ntype family XWarning        x\ntype family XXWarnDecl      x\n\ntype ForallXWarnDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XWarning        x)\n       , c (XXWarnDecl      x)\n       )\n\n-- -------------------------------------\n-- AnnDecl type families\ntype family XHsAnnotation  x\ntype family XXAnnDecl      x\n\ntype ForallXAnnDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XHsAnnotation  x)\n       , c (XXAnnDecl      x)\n       )\n\n-- -------------------------------------\n-- RoleAnnotDecl type families\ntype family XCRoleAnnotDecl  x\ntype family XXRoleAnnotDecl  x\n\ntype ForallXRoleAnnotDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XCRoleAnnotDecl  x)\n       , c (XXRoleAnnotDecl  x)\n       )\n\n-- =====================================================================\n-- Type families for the HsExpr extension points\n\ntype family XVar            x\ntype family XUnboundVar     x\ntype family XConLikeOut     x\ntype family XRecFld         x\ntype family XOverLabel      x\ntype family XIPVar          x\ntype family XOverLitE       x\ntype family XLitE           x\ntype family XLam            x\ntype family XLamCase        x\ntype family XApp            x\ntype family XAppTypeE       x\ntype family XOpApp          x\ntype family XNegApp         x\ntype family XPar            x\ntype family XSectionL       x\ntype family XSectionR       x\ntype family XExplicitTuple  x\ntype family XExplicitSum    x\ntype family XCase           x\ntype family XIf             x\ntype family XMultiIf        x\ntype family XLet            x\ntype family XDo             x\ntype family XExplicitList   x\ntype family XRecordCon      x\ntype family XRecordUpd      x\ntype family XExprWithTySig  x\ntype family XArithSeq       x\ntype family XSCC            x\ntype family XCoreAnn        x\ntype family XBracket        x\ntype family XRnBracketOut   x\ntype family XTcBracketOut   x\ntype family XSpliceE        x\ntype family XProc           x\ntype family XStatic         x\ntype family XArrApp         x\ntype family XArrForm        x\ntype family XTick           x\ntype family XBinTick        x\ntype family XTickPragma     x\ntype family XEWildPat       x\ntype family XEAsPat         x\ntype family XEViewPat       x\ntype family XELazyPat       x\ntype family XWrap           x\ntype family XXExpr          x\n\ntype ForallXExpr (c :: * -> Constraint) (x :: *) =\n       ( c (XVar            x)\n       , c (XUnboundVar     x)\n       , c (XConLikeOut     x)\n       , c (XRecFld         x)\n       , c (XOverLabel      x)\n       , c (XIPVar          x)\n       , c (XOverLitE       x)\n       , c (XLitE           x)\n       , c (XLam            x)\n       , c (XLamCase        x)\n       , c (XApp            x)\n       , c (XAppTypeE       x)\n       , c (XOpApp          x)\n       , c (XNegApp         x)\n       , c (XPar            x)\n       , c (XSectionL       x)\n       , c (XSectionR       x)\n       , c (XExplicitTuple  x)\n       , c (XExplicitSum    x)\n       , c (XCase           x)\n       , c (XIf             x)\n       , c (XMultiIf        x)\n       , c (XLet            x)\n       , c (XDo             x)\n       , c (XExplicitList   x)\n       , c (XRecordCon      x)\n       , c (XRecordUpd      x)\n       , c (XExprWithTySig  x)\n       , c (XArithSeq       x)\n       , c (XSCC            x)\n       , c (XCoreAnn        x)\n       , c (XBracket        x)\n       , c (XRnBracketOut   x)\n       , c (XTcBracketOut   x)\n       , c (XSpliceE        x)\n       , c (XProc           x)\n       , c (XStatic         x)\n       , c (XArrApp         x)\n       , c (XArrForm        x)\n       , c (XTick           x)\n       , c (XBinTick        x)\n       , c (XTickPragma     x)\n       , c (XEWildPat       x)\n       , c (XEAsPat         x)\n       , c (XEViewPat       x)\n       , c (XELazyPat       x)\n       , c (XWrap           x)\n       , c (XXExpr          x)\n       )\n-- ---------------------------------------------------------------------\n\ntype family XUnambiguous        x\ntype family XAmbiguous          x\ntype family XXAmbiguousFieldOcc x\n\ntype ForallXAmbiguousFieldOcc (c :: * -> Constraint) (x :: *) =\n       ( c (XUnambiguous        x)\n       , c (XAmbiguous          x)\n       , c (XXAmbiguousFieldOcc x)\n       )\n\n-- ----------------------------------------------------------------------\n\ntype family XPresent  x\ntype family XMissing  x\ntype family XXTupArg  x\n\ntype ForallXTupArg (c :: * -> Constraint) (x :: *) =\n       ( c (XPresent x)\n       , c (XMissing x)\n       , c (XXTupArg x)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XTypedSplice   x\ntype family XUntypedSplice x\ntype family XQuasiQuote    x\ntype family XSpliced       x\ntype family XXSplice       x\n\ntype ForallXSplice (c :: * -> Constraint) (x :: *) =\n       ( c (XTypedSplice   x)\n       , c (XUntypedSplice x)\n       , c (XQuasiQuote    x)\n       , c (XSpliced       x)\n       , c (XXSplice       x)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XExpBr      x\ntype family XPatBr      x\ntype family XDecBrL     x\ntype family XDecBrG     x\ntype family XTypBr      x\ntype family XVarBr      x\ntype family XTExpBr     x\ntype family XXBracket   x\n\ntype ForallXBracket (c :: * -> Constraint) (x :: *) =\n       ( c (XExpBr      x)\n       , c (XPatBr      x)\n       , c (XDecBrL     x)\n       , c (XDecBrG     x)\n       , c (XTypBr      x)\n       , c (XVarBr      x)\n       , c (XTExpBr     x)\n       , c (XXBracket   x)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XCmdTop  x\ntype family XXCmdTop x\n\ntype ForallXCmdTop (c :: * -> Constraint) (x :: *) =\n       ( c (XCmdTop  x)\n       , c (XXCmdTop x)\n       )\n\n-- -------------------------------------\n\ntype family XMG           x b\ntype family XXMatchGroup  x b\n\ntype ForallXMatchGroup (c :: * -> Constraint) (x :: *) (b :: *) =\n       ( c (XMG          x b)\n       , c (XXMatchGroup x b)\n       )\n\n-- -------------------------------------\n\ntype family XCMatch  x b\ntype family XXMatch  x b\n\ntype ForallXMatch (c :: * -> Constraint) (x :: *) (b :: *) =\n       ( c (XCMatch  x b)\n       , c (XXMatch  x b)\n       )\n\n-- -------------------------------------\n\ntype family XCGRHSs  x b\ntype family XXGRHSs  x b\n\ntype ForallXGRHSs (c :: * -> Constraint) (x :: *) (b :: *) =\n       ( c (XCGRHSs  x b)\n       , c (XXGRHSs  x b)\n       )\n\n-- -------------------------------------\n\ntype family XCGRHS  x b\ntype family XXGRHS  x b\n\ntype ForallXGRHS (c :: * -> Constraint) (x :: *) (b :: *) =\n       ( c (XCGRHS  x b)\n       , c (XXGRHS  x b)\n       )\n\n-- -------------------------------------\n\ntype family XLastStmt        x x' b\ntype family XBindStmt        x x' b\ntype family XApplicativeStmt x x' b\ntype family XBodyStmt        x x' b\ntype family XLetStmt         x x' b\ntype family XParStmt         x x' b\ntype family XTransStmt       x x' b\ntype family XRecStmt         x x' b\ntype family XXStmtLR         x x' b\n\ntype ForallXStmtLR (c :: * -> Constraint) (x :: *)  (x' :: *) (b :: *) =\n       ( c (XLastStmt         x x' b)\n       , c (XBindStmt         x x' b)\n       , c (XApplicativeStmt  x x' b)\n       , c (XBodyStmt         x x' b)\n       , c (XLetStmt          x x' b)\n       , c (XParStmt          x x' b)\n       , c (XTransStmt        x x' b)\n       , c (XRecStmt          x x' b)\n       , c (XXStmtLR          x x' b)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XCmdArrApp  x\ntype family XCmdArrForm x\ntype family XCmdApp     x\ntype family XCmdLam     x\ntype family XCmdPar     x\ntype family XCmdCase    x\ntype family XCmdIf      x\ntype family XCmdLet     x\ntype family XCmdDo      x\ntype family XCmdWrap    x\ntype family XXCmd       x\n\ntype ForallXCmd (c :: * -> Constraint) (x :: *) =\n       ( c (XCmdArrApp  x)\n       , c (XCmdArrForm x)\n       , c (XCmdApp     x)\n       , c (XCmdLam     x)\n       , c (XCmdPar     x)\n       , c (XCmdCase    x)\n       , c (XCmdIf      x)\n       , c (XCmdLet     x)\n       , c (XCmdDo      x)\n       , c (XCmdWrap    x)\n       , c (XXCmd       x)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XParStmtBlock  x x'\ntype family XXParStmtBlock x x'\n\ntype ForallXParStmtBlock (c :: * -> Constraint) (x :: *) (x' :: *) =\n       ( c (XParStmtBlock  x x')\n       , c (XXParStmtBlock x x')\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XApplicativeArgOne   x\ntype family XApplicativeArgMany  x\ntype family XXApplicativeArg     x\n\ntype ForallXApplicativeArg (c :: * -> Constraint) (x :: *) =\n       ( c (XApplicativeArgOne   x)\n       , c (XApplicativeArgMany  x)\n       , c (XXApplicativeArg     x)\n       )\n\n-- =====================================================================\n-- Type families for the HsImpExp extension points\n\n-- TODO\n\n-- =====================================================================\n-- Type families for the HsLit extension points\n\n-- We define a type family for each extension point. This is based on prepending\n-- 'X' to the constructor name, for ease of reference.\ntype family XHsChar x\ntype family XHsCharPrim x\ntype family XHsString x\ntype family XHsStringPrim x\ntype family XHsInt x\ntype family XHsIntPrim x\ntype family XHsWordPrim x\ntype family XHsInt64Prim x\ntype family XHsWord64Prim x\ntype family XHsInteger x\ntype family XHsRat x\ntype family XHsFloatPrim x\ntype family XHsDoublePrim x\ntype family XXLit x\n\n-- | Helper to apply a constraint to all extension points. It has one\n-- entry per extension point type family.\ntype ForallXHsLit (c :: * -> Constraint) (x :: *) =\n  ( c (XHsChar       x)\n  , c (XHsCharPrim   x)\n  , c (XHsDoublePrim x)\n  , c (XHsFloatPrim  x)\n  , c (XHsInt        x)\n  , c (XHsInt64Prim  x)\n  , c (XHsIntPrim    x)\n  , c (XHsInteger    x)\n  , c (XHsRat        x)\n  , c (XHsString     x)\n  , c (XHsStringPrim x)\n  , c (XHsWord64Prim x)\n  , c (XHsWordPrim   x)\n  , c (XXLit         x)\n  )\n\ntype family XOverLit  x\ntype family XXOverLit x\n\ntype ForallXOverLit (c :: * -> Constraint) (x :: *) =\n       ( c (XOverLit  x)\n       , c (XXOverLit x)\n       )\n\n-- =====================================================================\n-- Type families for the HsPat extension points\n\ntype family XWildPat   x\ntype family XVarPat    x\ntype family XLazyPat   x\ntype family XAsPat     x\ntype family XParPat    x\ntype family XBangPat   x\ntype family XListPat   x\ntype family XTuplePat  x\ntype family XSumPat    x\ntype family XConPat    x\ntype family XViewPat   x\ntype family XSplicePat x\ntype family XLitPat    x\ntype family XNPat      x\ntype family XNPlusKPat x\ntype family XSigPat    x\ntype family XCoPat     x\ntype family XXPat      x\n\n\ntype ForallXPat (c :: * -> Constraint) (x :: *) =\n       ( c (XWildPat   x)\n       , c (XVarPat    x)\n       , c (XLazyPat   x)\n       , c (XAsPat     x)\n       , c (XParPat    x)\n       , c (XBangPat   x)\n       , c (XListPat   x)\n       , c (XTuplePat  x)\n       , c (XSumPat    x)\n       , c (XViewPat   x)\n       , c (XSplicePat x)\n       , c (XLitPat    x)\n       , c (XNPat      x)\n       , c (XNPlusKPat x)\n       , c (XSigPat    x)\n       , c (XCoPat     x)\n       , c (XXPat      x)\n       )\n\n-- =====================================================================\n-- Type families for the HsTypes type families\n\ntype family XHsQTvs       x\ntype family XXLHsQTyVars  x\n\ntype ForallXLHsQTyVars (c :: * -> Constraint) (x :: *) =\n       ( c (XHsQTvs       x)\n       , c (XXLHsQTyVars  x)\n       )\n\n-- -------------------------------------\n\ntype family XHsIB              x b\ntype family XXHsImplicitBndrs  x b\n\ntype ForallXHsImplicitBndrs (c :: * -> Constraint) (x :: *) (b :: *) =\n       ( c (XHsIB              x b)\n       , c (XXHsImplicitBndrs  x b)\n       )\n\n-- -------------------------------------\n\ntype family XHsWC              x b\ntype family XXHsWildCardBndrs  x b\n\ntype ForallXHsWildCardBndrs(c :: * -> Constraint) (x :: *) (b :: *) =\n       ( c (XHsWC              x b)\n       , c (XXHsWildCardBndrs  x b)\n       )\n\n-- -------------------------------------\n\ntype family XForAllTy        x\ntype family XQualTy          x\ntype family XTyVar           x\ntype family XAppTy           x\ntype family XAppKindTy       x\ntype family XFunTy           x\ntype family XListTy          x\ntype family XTupleTy         x\ntype family XSumTy           x\ntype family XOpTy            x\ntype family XParTy           x\ntype family XIParamTy        x\ntype family XStarTy          x\ntype family XKindSig         x\ntype family XSpliceTy        x\ntype family XDocTy           x\ntype family XBangTy          x\ntype family XRecTy           x\ntype family XExplicitListTy  x\ntype family XExplicitTupleTy x\ntype family XTyLit           x\ntype family XWildCardTy      x\ntype family XXType           x\n\n-- | Helper to apply a constraint to all extension points. It has one\n-- entry per extension point type family.\ntype ForallXType (c :: * -> Constraint) (x :: *) =\n       ( c (XForAllTy        x)\n       , c (XQualTy          x)\n       , c (XTyVar           x)\n       , c (XAppTy           x)\n       , c (XAppKindTy       x)\n       , c (XFunTy           x)\n       , c (XListTy          x)\n       , c (XTupleTy         x)\n       , c (XSumTy           x)\n       , c (XOpTy            x)\n       , c (XParTy           x)\n       , c (XIParamTy        x)\n       , c (XStarTy          x)\n       , c (XKindSig         x)\n       , c (XSpliceTy        x)\n       , c (XDocTy           x)\n       , c (XBangTy          x)\n       , c (XRecTy           x)\n       , c (XExplicitListTy  x)\n       , c (XExplicitTupleTy x)\n       , c (XTyLit           x)\n       , c (XWildCardTy      x)\n       , c (XXType           x)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XUserTyVar   x\ntype family XKindedTyVar x\ntype family XXTyVarBndr  x\n\ntype ForallXTyVarBndr (c :: * -> Constraint) (x :: *) =\n       ( c (XUserTyVar      x)\n       , c (XKindedTyVar    x)\n       , c (XXTyVarBndr     x)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XConDeclField  x\ntype family XXConDeclField x\n\ntype ForallXConDeclField (c :: * -> Constraint) (x :: *) =\n       ( c (XConDeclField  x)\n       , c (XXConDeclField x)\n       )\n\n-- ---------------------------------------------------------------------\n\ntype family XCFieldOcc x\ntype family XXFieldOcc x\n\ntype ForallXFieldOcc (c :: * -> Constraint) (x :: *) =\n       ( c (XCFieldOcc x)\n       , c (XXFieldOcc x)\n       )\n\n\n-- =====================================================================\n-- Type families for the HsImpExp type families\n\ntype family XCImportDecl       x\ntype family XXImportDecl       x\n\ntype ForallXImportDecl (c :: * -> Constraint) (x :: *) =\n       ( c (XCImportDecl x)\n       , c (XXImportDecl x)\n       )\n\n-- -------------------------------------\n\ntype family XIEVar             x\ntype family XIEThingAbs        x\ntype family XIEThingAll        x\ntype family XIEThingWith       x\ntype family XIEModuleContents  x\ntype family XIEGroup           x\ntype family XIEDoc             x\ntype family XIEDocNamed        x\ntype family XXIE               x\n\ntype ForallXIE (c :: * -> Constraint) (x :: *) =\n       ( c (XIEVar x)\n       , c (XIEThingAbs        x)\n       , c (XIEThingAll        x)\n       , c (XIEThingWith       x)\n       , c (XIEModuleContents  x)\n       , c (XIEGroup           x)\n       , c (XIEDoc             x)\n       , c (XIEDocNamed        x)\n       , c (XXIE               x)\n       )\n\n-- -------------------------------------\n\n\n-- =====================================================================\n-- End of Type family definitions\n-- =====================================================================\n\n-- ----------------------------------------------------------------------\n-- | Conversion of annotations from one type index to another. This is required\n-- where the AST is converted from one pass to another, and the extension values\n-- need to be brought along if possible. So for example a 'SourceText' is\n-- converted via 'id', but needs a type signature to keep the type checker\n-- happy.\nclass Convertable a b  | a -> b where\n  convert :: a -> b\n\ninstance Convertable a a where\n  convert = id\n\n-- | A constraint capturing all the extension points that can be converted via\n-- @instance Convertable a a@\ntype ConvertIdX a b =\n  (XHsDoublePrim a ~ XHsDoublePrim b,\n   XHsFloatPrim a ~ XHsFloatPrim b,\n   XHsRat a ~ XHsRat b,\n   XHsInteger a ~ XHsInteger b,\n   XHsWord64Prim a ~ XHsWord64Prim b,\n   XHsInt64Prim a ~ XHsInt64Prim b,\n   XHsWordPrim a ~ XHsWordPrim b,\n   XHsIntPrim a ~ XHsIntPrim b,\n   XHsInt a ~ XHsInt b,\n   XHsStringPrim a ~ XHsStringPrim b,\n   XHsString a ~ XHsString b,\n   XHsCharPrim a ~ XHsCharPrim b,\n   XHsChar a ~ XHsChar b,\n   XXLit a ~ XXLit b)\n\n-- ----------------------------------------------------------------------\n\n-- Note [OutputableX]\n-- ~~~~~~~~~~~~~~~~~~\n--\n-- is required because the type family resolution\n-- process cannot determine that all cases are handled for a `GhcPass p`\n-- case where the cases are listed separately.\n--\n-- So\n--\n--   type instance XXHsIPBinds    (GhcPass p) = NoExt\n--\n-- will correctly deduce Outputable for (GhcPass p), but\n--\n--   type instance XIPBinds       GhcPs = NoExt\n--   type instance XIPBinds       GhcRn = NoExt\n--   type instance XIPBinds       GhcTc = TcEvBinds\n--\n-- will not.\n\n\n-- | Provide a summary constraint that gives all am Outputable constraint to\n-- extension points needing one\ntype OutputableX p = -- See Note [OutputableX]\n  ( Outputable (XIPBinds    p)\n  , Outputable (XViaStrategy p)\n  , Outputable (XViaStrategy GhcRn)\n  )\n-- TODO: Should OutputableX be included in OutputableBndrId?\n\n-- ----------------------------------------------------------------------\n\n-- |Constraint type to bundle up the requirement for 'OutputableBndr' on both\n-- the @id@ and the 'NameOrRdrName' type for it\ntype OutputableBndrId id =\n  ( OutputableBndr (NameOrRdrName (IdP id))\n  , OutputableBndr (IdP id)\n  , OutputableBndr (NameOrRdrName (IdP (NoGhcTc id)))\n  , OutputableBndr (IdP (NoGhcTc id))\n  , NoGhcTc id ~ NoGhcTc (NoGhcTc id)\n  , OutputableX id\n  , OutputableX (NoGhcTc id)\n  )\n", "num_lines": 1116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nHsImpExp: Abstract syntax: imports, exports, interfaces\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n\nmodule HsImpExp where\n\nimport GhcPrelude\n\nimport Module           ( ModuleName )\nimport HsDoc            ( HsDocString )\nimport OccName          ( HasOccName(..), isTcOcc, isSymOcc )\nimport BasicTypes       ( SourceText(..), StringLiteral(..), pprWithSourceText )\nimport FieldLabel       ( FieldLbl(..) )\n\nimport Outputable\nimport FastString\nimport SrcLoc\nimport HsExtension\n\nimport Data.Data\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Import and export declaration lists}\n*                                                                      *\n************************************************************************\n\nOne per \\tr{import} declaration in a module.\n-}\n\n-- | Located Import Declaration\ntype LImportDecl pass = Located (ImportDecl pass)\n        -- ^ When in a list this may have\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Import Declaration\n--\n-- A single Haskell @import@ declaration.\ndata ImportDecl pass\n  = ImportDecl {\n      ideclExt       :: XCImportDecl pass,\n      ideclSourceSrc :: SourceText,\n                                 -- Note [Pragma source text] in BasicTypes\n      ideclName      :: Located ModuleName, -- ^ Module name.\n      ideclPkgQual   :: Maybe StringLiteral,  -- ^ Package qualifier.\n      ideclSource    :: Bool,          -- ^ True <=> {-\\# SOURCE \\#-} import\n      ideclSafe      :: Bool,          -- ^ True => safe import\n      ideclQualified :: Bool,          -- ^ True => qualified\n      ideclImplicit  :: Bool,          -- ^ True => implicit import (of Prelude)\n      ideclAs        :: Maybe (Located ModuleName),  -- ^ as Module\n      ideclHiding    :: Maybe (Bool, Located [LIE pass])\n                                       -- ^ (True => hiding, names)\n    }\n  | XImportDecl (XXImportDecl pass)\n     -- ^\n     --  'ApiAnnotation.AnnKeywordId's\n     --\n     --  - 'ApiAnnotation.AnnImport'\n     --\n     --  - 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnClose' for ideclSource\n     --\n     --  - 'ApiAnnotation.AnnSafe','ApiAnnotation.AnnQualified',\n     --    'ApiAnnotation.AnnPackageName','ApiAnnotation.AnnAs',\n     --    'ApiAnnotation.AnnVal'\n     --\n     --  - 'ApiAnnotation.AnnHiding','ApiAnnotation.AnnOpen',\n     --    'ApiAnnotation.AnnClose' attached\n     --     to location in ideclHiding\n\n     -- For details on above see note [Api annotations] in ApiAnnotation\n\ntype instance XCImportDecl  (GhcPass _) = NoExt\ntype instance XXImportDecl  (GhcPass _) = NoExt\n\nsimpleImportDecl :: ModuleName -> ImportDecl (GhcPass p)\nsimpleImportDecl mn = ImportDecl {\n      ideclExt       = noExt,\n      ideclSourceSrc = NoSourceText,\n      ideclName      = noLoc mn,\n      ideclPkgQual   = Nothing,\n      ideclSource    = False,\n      ideclSafe      = False,\n      ideclImplicit  = False,\n      ideclQualified = False,\n      ideclAs        = Nothing,\n      ideclHiding    = Nothing\n    }\n\ninstance (p ~ GhcPass pass,OutputableBndrId p)\n       => Outputable (ImportDecl p) where\n    ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'\n                    , ideclPkgQual = pkg\n                    , ideclSource = from, ideclSafe = safe\n                    , ideclQualified = qual, ideclImplicit = implicit\n                    , ideclAs = as, ideclHiding = spec })\n      = hang (hsep [text \"import\", ppr_imp from, pp_implicit implicit, pp_safe safe,\n                    pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])\n             4 (pp_spec spec)\n      where\n        pp_implicit False = empty\n        pp_implicit True = ptext (sLit (\"(implicit)\"))\n\n        pp_pkg Nothing                    = empty\n        pp_pkg (Just (StringLiteral st p))\n          = pprWithSourceText st (doubleQuotes (ftext p))\n\n        pp_qual False   = empty\n        pp_qual True    = text \"qualified\"\n\n        pp_safe False   = empty\n        pp_safe True    = text \"safe\"\n\n        pp_as Nothing   = empty\n        pp_as (Just a)  = text \"as\" <+> ppr a\n\n        ppr_imp True  = case mSrcText of\n                          NoSourceText   -> text \"{-# SOURCE #-}\"\n                          SourceText src -> text src <+> text \"#-}\"\n        ppr_imp False = empty\n\n        pp_spec Nothing             = empty\n        pp_spec (Just (False, (L _ ies))) = ppr_ies ies\n        pp_spec (Just (True, (L _ ies))) = text \"hiding\" <+> ppr_ies ies\n\n        ppr_ies []  = text \"()\"\n        ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'\n    ppr (XImportDecl x) = ppr x\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Imported and exported entities}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A name in an import or export specification which may have adornments. Used\n-- primarily for accurate pretty printing of ParsedSource, and API Annotation\n-- placement.\ndata IEWrappedName name\n  = IEName    (Located name)  -- ^ no extra\n  | IEPattern (Located name)  -- ^ pattern X\n  | IEType    (Located name)  -- ^ type (:+:)\n  deriving (Eq,Data)\n\n-- | Located name with possible adornment\n-- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',\n--         'ApiAnnotation.AnnPattern'\ntype LIEWrappedName name = Located (IEWrappedName name)\n-- For details on above see note [Api annotations] in ApiAnnotation\n\n\n-- | Located Import or Export\ntype LIE pass = Located (IE pass)\n        -- ^ When in a list this may have\n        --\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Imported or exported entity.\ndata IE pass\n  = IEVar       (XIEVar pass) (LIEWrappedName (IdP pass))\n        -- ^ Imported or Exported Variable\n\n  | IEThingAbs  (XIEThingAbs pass) (LIEWrappedName (IdP pass))\n        -- ^ Imported or exported Thing with Absent list\n        --\n        -- The thing is a Class/Type (can't tell)\n        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',\n        --             'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n        -- See Note [Located RdrNames] in HsExpr\n  | IEThingAll  (XIEThingAll pass) (LIEWrappedName (IdP pass))\n        -- ^ Imported or exported Thing with All imported or exported\n        --\n        -- The thing is a Class/Type and the All refers to methods/constructors\n        --\n        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',\n        --       'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose',\n        --                                 'ApiAnnotation.AnnType'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n        -- See Note [Located RdrNames] in HsExpr\n\n  | IEThingWith (XIEThingWith pass)\n                (LIEWrappedName (IdP pass))\n                IEWildcard\n                [LIEWrappedName (IdP pass)]\n                [Located (FieldLbl (IdP pass))]\n        -- ^ Imported or exported Thing With given imported or exported\n        --\n        -- The thing is a Class/Type and the imported or exported things are\n        -- methods/constructors and record fields; see Note [IEThingWith]\n        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',\n        --                                   'ApiAnnotation.AnnClose',\n        --                                   'ApiAnnotation.AnnComma',\n        --                                   'ApiAnnotation.AnnType'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | IEModuleContents  (XIEModuleContents pass) (Located ModuleName)\n        -- ^ Imported or exported module contents\n        --\n        -- (Export Only)\n        --\n        -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n  | IEGroup             (XIEGroup pass) Int HsDocString -- ^ Doc section heading\n  | IEDoc               (XIEDoc pass) HsDocString       -- ^ Some documentation\n  | IEDocNamed          (XIEDocNamed pass) String    -- ^ Reference to named doc\n  | XIE (XXIE pass)\n\ntype instance XIEVar             (GhcPass _) = NoExt\ntype instance XIEThingAbs        (GhcPass _) = NoExt\ntype instance XIEThingAll        (GhcPass _) = NoExt\ntype instance XIEThingWith       (GhcPass _) = NoExt\ntype instance XIEModuleContents  (GhcPass _) = NoExt\ntype instance XIEGroup           (GhcPass _) = NoExt\ntype instance XIEDoc             (GhcPass _) = NoExt\ntype instance XIEDocNamed        (GhcPass _) = NoExt\ntype instance XXIE               (GhcPass _) = NoExt\n\n-- | Imported or Exported Wildcard\ndata IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)\n\n{-\nNote [IEThingWith]\n~~~~~~~~~~~~~~~~~~\n\nA definition like\n\n    module M ( T(MkT, x) ) where\n      data T = MkT { x :: Int }\n\ngives rise to\n\n    IEThingWith T [MkT] [FieldLabel \"x\" False x)]           (without DuplicateRecordFields)\n    IEThingWith T [MkT] [FieldLabel \"x\" True $sel:x:MkT)]   (with    DuplicateRecordFields)\n\nSee Note [Representing fields in AvailInfo] in Avail for more details.\n-}\n\nieName :: IE pass -> IdP pass\nieName (IEVar _ (L _ n))              = ieWrappedName n\nieName (IEThingAbs  _ (L _ n))        = ieWrappedName n\nieName (IEThingWith _ (L _ n) _ _ _)  = ieWrappedName n\nieName (IEThingAll  _ (L _ n))        = ieWrappedName n\nieName _ = panic \"ieName failed pattern match!\"\n\nieNames :: IE pass -> [IdP pass]\nieNames (IEVar       _ (L _ n)   )     = [ieWrappedName n]\nieNames (IEThingAbs  _ (L _ n)   )     = [ieWrappedName n]\nieNames (IEThingAll  _ (L _ n)   )     = [ieWrappedName n]\nieNames (IEThingWith _ (L _ n) _ ns _) = ieWrappedName n\n                                       : map (ieWrappedName . unLoc) ns\nieNames (IEModuleContents {})     = []\nieNames (IEGroup          {})     = []\nieNames (IEDoc            {})     = []\nieNames (IEDocNamed       {})     = []\nieNames (XIE {}) = panic \"ieNames\"\n\nieWrappedName :: IEWrappedName name -> name\nieWrappedName (IEName    (L _ n)) = n\nieWrappedName (IEPattern (L _ n)) = n\nieWrappedName (IEType    (L _ n)) = n\n\nlieWrappedName :: LIEWrappedName name -> name\nlieWrappedName (L _ n) = ieWrappedName n\n\nieLWrappedName :: LIEWrappedName name -> Located name\nieLWrappedName (L l n) = L l (ieWrappedName n)\n\nreplaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2\nreplaceWrappedName (IEName    (L l _)) n = IEName    (L l n)\nreplaceWrappedName (IEPattern (L l _)) n = IEPattern (L l n)\nreplaceWrappedName (IEType    (L l _)) n = IEType    (L l n)\n\nreplaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2\nreplaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')\n\ninstance (p ~ GhcPass pass,OutputableBndrId p) => Outputable (IE p) where\n    ppr (IEVar       _     var) = ppr (unLoc var)\n    ppr (IEThingAbs  _   thing) = ppr (unLoc thing)\n    ppr (IEThingAll  _   thing) = hcat [ppr (unLoc thing), text \"(..)\"]\n    ppr (IEThingWith _ thing wc withs flds)\n        = ppr (unLoc thing) <> parens (fsep (punctuate comma\n                                              (ppWiths ++\n                                              map (ppr . flLabel . unLoc) flds)))\n      where\n        ppWiths =\n          case wc of\n              NoIEWildcard ->\n                map (ppr . unLoc) withs\n              IEWildcard pos ->\n                let (bs, as) = splitAt pos (map (ppr . unLoc) withs)\n                in bs ++ [text \"..\"] ++ as\n    ppr (IEModuleContents _ mod')\n        = text \"module\" <+> ppr mod'\n    ppr (IEGroup _ n _)           = text (\"<IEGroup: \" ++ show n ++ \">\")\n    ppr (IEDoc _ doc)             = ppr doc\n    ppr (IEDocNamed _ string)     = text (\"<IEDocNamed: \" ++ string ++ \">\")\n    ppr (XIE x) = ppr x\n\ninstance (HasOccName name) => HasOccName (IEWrappedName name) where\n  occName w = occName (ieWrappedName w)\n\ninstance (OutputableBndr name) => OutputableBndr (IEWrappedName name) where\n  pprBndr bs   w = pprBndr bs   (ieWrappedName w)\n  pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)\n  pprInfixOcc  w = pprInfixOcc  (ieWrappedName w)\n\ninstance (OutputableBndr name) => Outputable (IEWrappedName name) where\n  ppr (IEName    n) = pprPrefixOcc (unLoc n)\n  ppr (IEPattern n) = text \"pattern\" <+> pprPrefixOcc (unLoc n)\n  ppr (IEType    n) = text \"type\"    <+> pprPrefixOcc (unLoc n)\n\npprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc\npprImpExp name = type_pref <+> pprPrefixOcc name\n    where\n    occ = occName name\n    type_pref | isTcOcc occ && isSymOcc occ = text \"type\"\n              | otherwise                   = empty\n", "num_lines": 340}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule HsInstances where\n\n-- This module defines the Data instances for the hsSyn AST.\n\n-- It happens here to avoid massive constraint types on the AST with concomitant\n-- slow GHC bootstrap times.\n\n-- UndecidableInstances ?\n\nimport Data.Data hiding ( Fixity )\n\nimport GhcPrelude\nimport HsExtension\nimport HsBinds\nimport HsDecls\nimport HsExpr\nimport HsLit\nimport HsTypes\nimport HsPat\nimport HsImpExp\n\n-- ---------------------------------------------------------------------\n-- Data derivations from HsSyn -----------------------------------------\n\n-- ---------------------------------------------------------------------\n-- Data derivations from HsBinds ---------------------------------------\n\n-- deriving instance (DataIdLR pL pR) => Data (HsLocalBindsLR pL pR)\nderiving instance Data (HsLocalBindsLR GhcPs GhcPs)\nderiving instance Data (HsLocalBindsLR GhcPs GhcRn)\nderiving instance Data (HsLocalBindsLR GhcRn GhcRn)\nderiving instance Data (HsLocalBindsLR GhcTc GhcTc)\n\n-- deriving instance (DataIdLR pL pR) => Data (HsValBindsLR pL pR)\nderiving instance Data (HsValBindsLR GhcPs GhcPs)\nderiving instance Data (HsValBindsLR GhcPs GhcRn)\nderiving instance Data (HsValBindsLR GhcRn GhcRn)\nderiving instance Data (HsValBindsLR GhcTc GhcTc)\n\n-- deriving instance (DataIdLR pL pL) => Data (NHsValBindsLR pL)\nderiving instance Data (NHsValBindsLR GhcPs)\nderiving instance Data (NHsValBindsLR GhcRn)\nderiving instance Data (NHsValBindsLR GhcTc)\n\n-- deriving instance (DataIdLR pL pR) => Data (HsBindLR pL pR)\nderiving instance Data (HsBindLR GhcPs GhcPs)\nderiving instance Data (HsBindLR GhcPs GhcRn)\nderiving instance Data (HsBindLR GhcRn GhcRn)\nderiving instance Data (HsBindLR GhcTc GhcTc)\n\n-- deriving instance (DataId p)       => Data (ABExport p)\nderiving instance Data (ABExport GhcPs)\nderiving instance Data (ABExport GhcRn)\nderiving instance Data (ABExport GhcTc)\n\n-- deriving instance (DataIdLR pL pR) => Data (PatSynBind pL pR)\nderiving instance Data (PatSynBind GhcPs GhcPs)\nderiving instance Data (PatSynBind GhcPs GhcRn)\nderiving instance Data (PatSynBind GhcRn GhcRn)\nderiving instance Data (PatSynBind GhcTc GhcTc)\n\n-- deriving instance (DataIdLR p p)   => Data (HsIPBinds p)\nderiving instance Data (HsIPBinds GhcPs)\nderiving instance Data (HsIPBinds GhcRn)\nderiving instance Data (HsIPBinds GhcTc)\n\n-- deriving instance (DataIdLR p p)   => Data (IPBind p)\nderiving instance Data (IPBind GhcPs)\nderiving instance Data (IPBind GhcRn)\nderiving instance Data (IPBind GhcTc)\n\n-- deriving instance (DataIdLR p p)   => Data (Sig p)\nderiving instance Data (Sig GhcPs)\nderiving instance Data (Sig GhcRn)\nderiving instance Data (Sig GhcTc)\n\n-- deriving instance (DataId p)       => Data (FixitySig p)\nderiving instance Data (FixitySig GhcPs)\nderiving instance Data (FixitySig GhcRn)\nderiving instance Data (FixitySig GhcTc)\n\n-- deriving instance (DataIdLR p p)   => Data (HsPatSynDir p)\nderiving instance Data (HsPatSynDir GhcPs)\nderiving instance Data (HsPatSynDir GhcRn)\nderiving instance Data (HsPatSynDir GhcTc)\n\n-- ---------------------------------------------------------------------\n-- Data derivations from HsDecls ---------------------------------------\n\n-- deriving instance (DataIdLR p p) => Data (HsDecl p)\nderiving instance Data (HsDecl GhcPs)\nderiving instance Data (HsDecl GhcRn)\nderiving instance Data (HsDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsGroup p)\nderiving instance Data (HsGroup GhcPs)\nderiving instance Data (HsGroup GhcRn)\nderiving instance Data (HsGroup GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (SpliceDecl p)\nderiving instance Data (SpliceDecl GhcPs)\nderiving instance Data (SpliceDecl GhcRn)\nderiving instance Data (SpliceDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (TyClDecl p)\nderiving instance Data (TyClDecl GhcPs)\nderiving instance Data (TyClDecl GhcRn)\nderiving instance Data (TyClDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (TyClGroup p)\nderiving instance Data (TyClGroup GhcPs)\nderiving instance Data (TyClGroup GhcRn)\nderiving instance Data (TyClGroup GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (FamilyResultSig p)\nderiving instance Data (FamilyResultSig GhcPs)\nderiving instance Data (FamilyResultSig GhcRn)\nderiving instance Data (FamilyResultSig GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (FamilyDecl p)\nderiving instance Data (FamilyDecl GhcPs)\nderiving instance Data (FamilyDecl GhcRn)\nderiving instance Data (FamilyDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (InjectivityAnn p)\nderiving instance Data (InjectivityAnn GhcPs)\nderiving instance Data (InjectivityAnn GhcRn)\nderiving instance Data (InjectivityAnn GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (FamilyInfo p)\nderiving instance Data (FamilyInfo GhcPs)\nderiving instance Data (FamilyInfo GhcRn)\nderiving instance Data (FamilyInfo GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsDataDefn p)\nderiving instance Data (HsDataDefn GhcPs)\nderiving instance Data (HsDataDefn GhcRn)\nderiving instance Data (HsDataDefn GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsDerivingClause p)\nderiving instance Data (HsDerivingClause GhcPs)\nderiving instance Data (HsDerivingClause GhcRn)\nderiving instance Data (HsDerivingClause GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (ConDecl p)\nderiving instance Data (ConDecl GhcPs)\nderiving instance Data (ConDecl GhcRn)\nderiving instance Data (ConDecl GhcTc)\n\n-- deriving instance DataIdLR p p   => Data (TyFamInstDecl p)\nderiving instance Data (TyFamInstDecl GhcPs)\nderiving instance Data (TyFamInstDecl GhcRn)\nderiving instance Data (TyFamInstDecl GhcTc)\n\n-- deriving instance DataIdLR p p   => Data (DataFamInstDecl p)\nderiving instance Data (DataFamInstDecl GhcPs)\nderiving instance Data (DataFamInstDecl GhcRn)\nderiving instance Data (DataFamInstDecl GhcTc)\n\n-- deriving instance (DataIdLR p p,Data pats,Data rhs)=>Data (FamEqn p pats rhs)\nderiving instance (Data pats,Data rhs) => Data (FamEqn GhcPs pats rhs)\nderiving instance (Data pats,Data rhs) => Data (FamEqn GhcRn pats rhs)\nderiving instance (Data pats,Data rhs) => Data (FamEqn GhcTc pats rhs)\n\n-- deriving instance (DataIdLR p p) => Data (ClsInstDecl p)\nderiving instance Data (ClsInstDecl GhcPs)\nderiving instance Data (ClsInstDecl GhcRn)\nderiving instance Data (ClsInstDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (InstDecl p)\nderiving instance Data (InstDecl GhcPs)\nderiving instance Data (InstDecl GhcRn)\nderiving instance Data (InstDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (DerivDecl p)\nderiving instance Data (DerivDecl GhcPs)\nderiving instance Data (DerivDecl GhcRn)\nderiving instance Data (DerivDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (DerivStrategy p)\nderiving instance Data (DerivStrategy GhcPs)\nderiving instance Data (DerivStrategy GhcRn)\nderiving instance Data (DerivStrategy GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (DefaultDecl p)\nderiving instance Data (DefaultDecl GhcPs)\nderiving instance Data (DefaultDecl GhcRn)\nderiving instance Data (DefaultDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (ForeignDecl p)\nderiving instance Data (ForeignDecl GhcPs)\nderiving instance Data (ForeignDecl GhcRn)\nderiving instance Data (ForeignDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (RuleDecls p)\nderiving instance Data (RuleDecls GhcPs)\nderiving instance Data (RuleDecls GhcRn)\nderiving instance Data (RuleDecls GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (RuleDecl p)\nderiving instance Data (RuleDecl GhcPs)\nderiving instance Data (RuleDecl GhcRn)\nderiving instance Data (RuleDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (RuleBndr p)\nderiving instance Data (RuleBndr GhcPs)\nderiving instance Data (RuleBndr GhcRn)\nderiving instance Data (RuleBndr GhcTc)\n\n-- deriving instance (DataId p)     => Data (WarnDecls p)\nderiving instance Data (WarnDecls GhcPs)\nderiving instance Data (WarnDecls GhcRn)\nderiving instance Data (WarnDecls GhcTc)\n\n-- deriving instance (DataId p)     => Data (WarnDecl p)\nderiving instance Data (WarnDecl GhcPs)\nderiving instance Data (WarnDecl GhcRn)\nderiving instance Data (WarnDecl GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (AnnDecl p)\nderiving instance Data (AnnDecl GhcPs)\nderiving instance Data (AnnDecl GhcRn)\nderiving instance Data (AnnDecl GhcTc)\n\n-- deriving instance (DataId p)     => Data (RoleAnnotDecl p)\nderiving instance Data (RoleAnnotDecl GhcPs)\nderiving instance Data (RoleAnnotDecl GhcRn)\nderiving instance Data (RoleAnnotDecl GhcTc)\n\n-- ---------------------------------------------------------------------\n-- Data derivations from HsExpr ----------------------------------------\n\n-- deriving instance (DataIdLR p p) => Data (SyntaxExpr p)\nderiving instance Data (SyntaxExpr GhcPs)\nderiving instance Data (SyntaxExpr GhcRn)\nderiving instance Data (SyntaxExpr GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsExpr p)\nderiving instance Data (HsExpr GhcPs)\nderiving instance Data (HsExpr GhcRn)\nderiving instance Data (HsExpr GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsTupArg p)\nderiving instance Data (HsTupArg GhcPs)\nderiving instance Data (HsTupArg GhcRn)\nderiving instance Data (HsTupArg GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsCmd p)\nderiving instance Data (HsCmd GhcPs)\nderiving instance Data (HsCmd GhcRn)\nderiving instance Data (HsCmd GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsCmdTop p)\nderiving instance Data (HsCmdTop GhcPs)\nderiving instance Data (HsCmdTop GhcRn)\nderiving instance Data (HsCmdTop GhcTc)\n\n-- deriving instance (DataIdLR p p,Data body) => Data (MatchGroup p body)\nderiving instance (Data body) => Data (MatchGroup GhcPs body)\nderiving instance (Data body) => Data (MatchGroup GhcRn body)\nderiving instance (Data body) => Data (MatchGroup GhcTc body)\n\n-- deriving instance (DataIdLR p p,Data body) => Data (Match      p body)\nderiving instance (Data body) => Data (Match      GhcPs body)\nderiving instance (Data body) => Data (Match      GhcRn body)\nderiving instance (Data body) => Data (Match      GhcTc body)\n\n-- deriving instance (DataIdLR p p,Data body) => Data (GRHSs      p body)\nderiving instance (Data body) => Data (GRHSs     GhcPs body)\nderiving instance (Data body) => Data (GRHSs     GhcRn body)\nderiving instance (Data body) => Data (GRHSs     GhcTc body)\n\n-- deriving instance (DataIdLR p p,Data body) => Data (GRHS       p body)\nderiving instance (Data body) => Data (GRHS     GhcPs body)\nderiving instance (Data body) => Data (GRHS     GhcRn body)\nderiving instance (Data body) => Data (GRHS     GhcTc body)\n\n-- deriving instance (DataIdLR p p,Data body) => Data (StmtLR   p p body)\nderiving instance (Data body) => Data (StmtLR   GhcPs GhcPs body)\nderiving instance (Data body) => Data (StmtLR   GhcPs GhcRn body)\nderiving instance (Data body) => Data (StmtLR   GhcRn GhcRn body)\nderiving instance (Data body) => Data (StmtLR   GhcTc GhcTc body)\n\nderiving instance Data RecStmtTc\n\n-- deriving instance (DataIdLR p p) => Data (ParStmtBlock p p)\nderiving instance Data (ParStmtBlock GhcPs GhcPs)\nderiving instance Data (ParStmtBlock GhcPs GhcRn)\nderiving instance Data (ParStmtBlock GhcRn GhcRn)\nderiving instance Data (ParStmtBlock GhcTc GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (ApplicativeArg p)\nderiving instance Data (ApplicativeArg GhcPs)\nderiving instance Data (ApplicativeArg GhcRn)\nderiving instance Data (ApplicativeArg GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsSplice p)\nderiving instance Data (HsSplice GhcPs)\nderiving instance Data (HsSplice GhcRn)\nderiving instance Data (HsSplice GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsSplicedThing p)\nderiving instance Data (HsSplicedThing GhcPs)\nderiving instance Data (HsSplicedThing GhcRn)\nderiving instance Data (HsSplicedThing GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsBracket p)\nderiving instance Data (HsBracket GhcPs)\nderiving instance Data (HsBracket GhcRn)\nderiving instance Data (HsBracket GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (ArithSeqInfo p)\nderiving instance Data (ArithSeqInfo GhcPs)\nderiving instance Data (ArithSeqInfo GhcRn)\nderiving instance Data (ArithSeqInfo GhcTc)\n\nderiving instance                   Data RecordConTc\nderiving instance                   Data CmdTopTc\nderiving instance                   Data PendingRnSplice\nderiving instance                   Data PendingTcSplice\n\n-- ---------------------------------------------------------------------\n-- Data derivations from HsLit ----------------------------------------\n\n-- deriving instance (DataId p) => Data (HsLit p)\nderiving instance Data (HsLit GhcPs)\nderiving instance Data (HsLit GhcRn)\nderiving instance Data (HsLit GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsOverLit p)\nderiving instance Data (HsOverLit GhcPs)\nderiving instance Data (HsOverLit GhcRn)\nderiving instance Data (HsOverLit GhcTc)\n\n-- ---------------------------------------------------------------------\n-- Data derivations from HsPat -----------------------------------------\n\n-- deriving instance (DataIdLR p p) => Data (Pat p)\nderiving instance Data (Pat GhcPs)\nderiving instance Data (Pat GhcRn)\nderiving instance Data (Pat GhcTc)\n\nderiving instance Data ListPatTc\n\n-- deriving instance (DataIdLR p p, Data body) => Data (HsRecFields p body)\nderiving instance (Data body) => Data (HsRecFields GhcPs body)\nderiving instance (Data body) => Data (HsRecFields GhcRn body)\nderiving instance (Data body) => Data (HsRecFields GhcTc body)\n\n-- ---------------------------------------------------------------------\n-- Data derivations from HsTypes ---------------------------------------\n\n-- deriving instance (DataIdLR p p) => Data (LHsQTyVars p)\nderiving instance Data (LHsQTyVars GhcPs)\nderiving instance Data (LHsQTyVars GhcRn)\nderiving instance Data (LHsQTyVars GhcTc)\n\n-- deriving instance (DataIdLR p p, Data thing) =>Data (HsImplicitBndrs p thing)\nderiving instance (Data thing) => Data (HsImplicitBndrs GhcPs thing)\nderiving instance (Data thing) => Data (HsImplicitBndrs GhcRn thing)\nderiving instance (Data thing) => Data (HsImplicitBndrs GhcTc thing)\n\n-- deriving instance (DataIdLR p p, Data thing) =>Data (HsWildCardBndrs p thing)\nderiving instance (Data thing) => Data (HsWildCardBndrs GhcPs thing)\nderiving instance (Data thing) => Data (HsWildCardBndrs GhcRn thing)\nderiving instance (Data thing) => Data (HsWildCardBndrs GhcTc thing)\n\n-- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p)\nderiving instance Data (HsTyVarBndr GhcPs)\nderiving instance Data (HsTyVarBndr GhcRn)\nderiving instance Data (HsTyVarBndr GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (HsType p)\nderiving instance Data (HsType GhcPs)\nderiving instance Data (HsType GhcRn)\nderiving instance Data (HsType GhcTc)\n\nderiving instance Data (LHsTypeArg GhcPs)\nderiving instance Data (LHsTypeArg GhcRn)\nderiving instance Data (LHsTypeArg GhcTc)\n\n-- deriving instance (DataIdLR p p) => Data (ConDeclField p)\nderiving instance Data (ConDeclField GhcPs)\nderiving instance Data (ConDeclField GhcRn)\nderiving instance Data (ConDeclField GhcTc)\n\n-- deriving instance (DataId p)     => Data (FieldOcc p)\nderiving instance Data (FieldOcc GhcPs)\nderiving instance Data (FieldOcc GhcRn)\nderiving instance Data (FieldOcc GhcTc)\n\n-- deriving instance DataId p       => Data (AmbiguousFieldOcc p)\nderiving instance Data (AmbiguousFieldOcc GhcPs)\nderiving instance Data (AmbiguousFieldOcc GhcRn)\nderiving instance Data (AmbiguousFieldOcc GhcTc)\n\n\n-- deriving instance (DataId name) => Data (ImportDecl name)\nderiving instance Data (ImportDecl GhcPs)\nderiving instance Data (ImportDecl GhcRn)\nderiving instance Data (ImportDecl GhcTc)\n\n-- deriving instance (DataId name)             => Data (IE name)\nderiving instance Data (IE GhcPs)\nderiving instance Data (IE GhcRn)\nderiving instance Data (IE GhcTc)\n\n-- deriving instance (Eq name, Eq (IdP name)) => Eq (IE name)\nderiving instance Eq (IE GhcPs)\nderiving instance Eq (IE GhcRn)\nderiving instance Eq (IE GhcTc)\n\n-- ---------------------------------------------------------------------\n", "num_lines": 421}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[HsLit]{Abstract syntax: source-language literals}\n-}\n\n{-# LANGUAGE CPP, DeriveDataTypeable #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule HsLit where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} HsExpr( HsExpr, pprExpr )\nimport BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,\n                    negateFractionalLit,SourceText(..),pprWithSourceText )\nimport Type\nimport Outputable\nimport FastString\nimport HsExtension\n\nimport Data.ByteString (ByteString)\nimport Data.Data hiding ( Fixity )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[HsLit]{Literals}\n*                                                                      *\n************************************************************************\n-}\n\n-- Note [Literal source text] in BasicTypes for SourceText fields in\n-- the following\n-- Note [Trees that grow] in HsExtension for the Xxxxx fields in the following\n-- | Haskell Literal\ndata HsLit x\n  = HsChar (XHsChar x) {- SourceText -} Char\n      -- ^ Character\n  | HsCharPrim (XHsCharPrim x) {- SourceText -} Char\n      -- ^ Unboxed character\n  | HsString (XHsString x) {- SourceText -} FastString\n      -- ^ String\n  | HsStringPrim (XHsStringPrim x) {- SourceText -} ByteString\n      -- ^ Packed bytes\n  | HsInt (XHsInt x)  IntegralLit\n      -- ^ Genuinely an Int; arises from\n      -- @TcGenDeriv@, and from TRANSLATION\n  | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer\n      -- ^ literal @Int#@\n  | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer\n      -- ^ literal @Word#@\n  | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer\n      -- ^ literal @Int64#@\n  | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer\n      -- ^ literal @Word64#@\n  | HsInteger (XHsInteger x) {- SourceText -} Integer Type\n      -- ^ Genuinely an integer; arises only\n      -- from TRANSLATION (overloaded\n      -- literals are done with HsOverLit)\n  | HsRat (XHsRat x)  FractionalLit Type\n      -- ^ Genuinely a rational; arises only from\n      -- TRANSLATION (overloaded literals are\n      -- done with HsOverLit)\n  | HsFloatPrim (XHsFloatPrim x)   FractionalLit\n      -- ^ Unboxed Float\n  | HsDoublePrim (XHsDoublePrim x) FractionalLit\n      -- ^ Unboxed Double\n\n  | XLit (XXLit x)\n\ntype instance XHsChar       (GhcPass _) = SourceText\ntype instance XHsCharPrim   (GhcPass _) = SourceText\ntype instance XHsString     (GhcPass _) = SourceText\ntype instance XHsStringPrim (GhcPass _) = SourceText\ntype instance XHsInt        (GhcPass _) = NoExt\ntype instance XHsIntPrim    (GhcPass _) = SourceText\ntype instance XHsWordPrim   (GhcPass _) = SourceText\ntype instance XHsInt64Prim  (GhcPass _) = SourceText\ntype instance XHsWord64Prim (GhcPass _) = SourceText\ntype instance XHsInteger    (GhcPass _) = SourceText\ntype instance XHsRat        (GhcPass _) = NoExt\ntype instance XHsFloatPrim  (GhcPass _) = NoExt\ntype instance XHsDoublePrim (GhcPass _) = NoExt\ntype instance XXLit         (GhcPass _) = NoExt\n\ninstance Eq (HsLit x) where\n  (HsChar _ x1)       == (HsChar _ x2)       = x1==x2\n  (HsCharPrim _ x1)   == (HsCharPrim _ x2)   = x1==x2\n  (HsString _ x1)     == (HsString _ x2)     = x1==x2\n  (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2\n  (HsInt _ x1)        == (HsInt _ x2)        = x1==x2\n  (HsIntPrim _ x1)    == (HsIntPrim _ x2)    = x1==x2\n  (HsWordPrim _ x1)   == (HsWordPrim _ x2)   = x1==x2\n  (HsInt64Prim _ x1)  == (HsInt64Prim _ x2)  = x1==x2\n  (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2\n  (HsInteger _ x1 _)  == (HsInteger _ x2 _)  = x1==x2\n  (HsRat _ x1 _)      == (HsRat _ x2 _)      = x1==x2\n  (HsFloatPrim _ x1)  == (HsFloatPrim _ x2)  = x1==x2\n  (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2\n  _                   == _                   = False\n\n-- | Haskell Overloaded Literal\ndata HsOverLit p\n  = OverLit {\n      ol_ext :: (XOverLit p),\n      ol_val :: OverLitVal,\n      ol_witness :: HsExpr p}         -- Note [Overloaded literal witnesses]\n\n  | XOverLit\n      (XXOverLit p)\n\ndata OverLitTc\n  = OverLitTc {\n        ol_rebindable :: Bool, -- Note [ol_rebindable]\n        ol_type :: Type }\n  deriving Data\n\ntype instance XOverLit GhcPs = NoExt\ntype instance XOverLit GhcRn = Bool            -- Note [ol_rebindable]\ntype instance XOverLit GhcTc = OverLitTc\n\ntype instance XXOverLit (GhcPass _) = NoExt\n\n-- Note [Literal source text] in BasicTypes for SourceText fields in\n-- the following\n-- | Overloaded Literal Value\ndata OverLitVal\n  = HsIntegral   !IntegralLit            -- ^ Integer-looking literals;\n  | HsFractional !FractionalLit          -- ^ Frac-looking literals\n  | HsIsString   !SourceText !FastString -- ^ String-looking literals\n  deriving Data\n\nnegateOverLitVal :: OverLitVal -> OverLitVal\nnegateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)\nnegateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)\nnegateOverLitVal _ = panic \"negateOverLitVal: argument is not a number\"\n\noverLitType :: HsOverLit GhcTc -> Type\noverLitType (OverLit (OverLitTc _ ty) _ _) = ty\noverLitType XOverLit{} = panic \"overLitType\"\n\n-- | Convert a literal from one index type to another, updating the annotations\n-- according to the relevant 'Convertable' instance\nconvertLit :: (ConvertIdX a b) => HsLit a -> HsLit b\nconvertLit (HsChar a x)       = (HsChar (convert a) x)\nconvertLit (HsCharPrim a x)   = (HsCharPrim (convert a) x)\nconvertLit (HsString a x)     = (HsString (convert a) x)\nconvertLit (HsStringPrim a x) = (HsStringPrim (convert a) x)\nconvertLit (HsInt a x)        = (HsInt (convert a) x)\nconvertLit (HsIntPrim a x)    = (HsIntPrim (convert a) x)\nconvertLit (HsWordPrim a x)   = (HsWordPrim (convert a) x)\nconvertLit (HsInt64Prim a x)  = (HsInt64Prim (convert a) x)\nconvertLit (HsWord64Prim a x) = (HsWord64Prim (convert a) x)\nconvertLit (HsInteger a x b)  = (HsInteger (convert a) x b)\nconvertLit (HsRat a x b)      = (HsRat (convert a) x b)\nconvertLit (HsFloatPrim a x)  = (HsFloatPrim (convert a) x)\nconvertLit (HsDoublePrim a x) = (HsDoublePrim (convert a) x)\nconvertLit (XLit a)           = (XLit (convert a))\n\n{-\nNote [ol_rebindable]\n~~~~~~~~~~~~~~~~~~~~\nThe ol_rebindable field is True if this literal is actually\nusing rebindable syntax.  Specifically:\n\n  False iff ol_witness is the standard one\n  True  iff ol_witness is non-standard\n\nEquivalently it's True if\n  a) RebindableSyntax is on\n  b) the witness for fromInteger/fromRational/fromString\n     that happens to be in scope isn't the standard one\n\nNote [Overloaded literal witnesses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n*Before* type checking, the HsExpr in an HsOverLit is the\nname of the coercion function, 'fromInteger' or 'fromRational'.\n*After* type checking, it is a witness for the literal, such as\n        (fromInteger 3) or lit_78\nThis witness should replace the literal.\n\nThis dual role is unusual, because we're replacing 'fromInteger' with\na call to fromInteger.  Reason: it allows commoning up of the fromInteger\ncalls, which wouldn't be possible if the desugarer made the application.\n\nThe PostTcType in each branch records the type the overload literal is\nfound to have.\n-}\n\n-- Comparison operations are needed when grouping literals\n-- for compiling pattern-matching (module MatchLit)\ninstance (Eq (XXOverLit p)) => Eq (HsOverLit p) where\n  (OverLit _ val1 _) == (OverLit _ val2 _) = val1 == val2\n  (XOverLit  val1)   == (XOverLit  val2)   = val1 == val2\n  _ == _ = panic \"Eq HsOverLit\"\n\ninstance Eq OverLitVal where\n  (HsIntegral   i1)   == (HsIntegral   i2)   = i1 == i2\n  (HsFractional f1)   == (HsFractional f2)   = f1 == f2\n  (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2\n  _                   == _                   = False\n\ninstance (Ord (XXOverLit p)) => Ord (HsOverLit p) where\n  compare (OverLit _ val1 _) (OverLit _ val2 _) = val1 `compare` val2\n  compare (XOverLit  val1)   (XOverLit  val2)   = val1 `compare` val2\n  compare _ _ = panic \"Ord HsOverLit\"\n\ninstance Ord OverLitVal where\n  compare (HsIntegral i1)     (HsIntegral i2)     = i1 `compare` i2\n  compare (HsIntegral _)      (HsFractional _)    = LT\n  compare (HsIntegral _)      (HsIsString _ _)    = LT\n  compare (HsFractional f1)   (HsFractional f2)   = f1 `compare` f2\n  compare (HsFractional _)    (HsIntegral   _)    = GT\n  compare (HsFractional _)    (HsIsString _ _)    = LT\n  compare (HsIsString _ s1)   (HsIsString _ s2)   = s1 `compare` s2\n  compare (HsIsString _ _)    (HsIntegral   _)    = GT\n  compare (HsIsString _ _)    (HsFractional _)    = GT\n\n-- Instance specific to GhcPs, need the SourceText\ninstance p ~ GhcPass pass => Outputable (HsLit p) where\n    ppr (HsChar st c)       = pprWithSourceText st (pprHsChar c)\n    ppr (HsCharPrim st c)   = pp_st_suffix st primCharSuffix (pprPrimChar c)\n    ppr (HsString st s)     = pprWithSourceText st (pprHsString s)\n    ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)\n    ppr (HsInt _ i)\n      = pprWithSourceText (il_text i) (integer (il_value i))\n    ppr (HsInteger st i _)  = pprWithSourceText st (integer i)\n    ppr (HsRat _ f _)       = ppr f\n    ppr (HsFloatPrim _ f)   = ppr f <> primFloatSuffix\n    ppr (HsDoublePrim _ d)  = ppr d <> primDoubleSuffix\n    ppr (HsIntPrim st i)    = pprWithSourceText st (pprPrimInt i)\n    ppr (HsWordPrim st w)   = pprWithSourceText st (pprPrimWord w)\n    ppr (HsInt64Prim st i)  = pp_st_suffix st primInt64Suffix  (pprPrimInt64 i)\n    ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)\n    ppr (XLit x) = ppr x\n\npp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc\npp_st_suffix NoSourceText         _ doc = doc\npp_st_suffix (SourceText st) suffix _   = text st <> suffix\n\n-- in debug mode, print the expression that it's resolved to, too\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (HsOverLit p) where\n  ppr (OverLit {ol_val=val, ol_witness=witness})\n        = ppr val <+> (whenPprDebug (parens (pprExpr witness)))\n  ppr (XOverLit x) = ppr x\n\ninstance Outputable OverLitVal where\n  ppr (HsIntegral i)     = pprWithSourceText (il_text i) (integer (il_value i))\n  ppr (HsFractional f)   = ppr f\n  ppr (HsIsString st s)  = pprWithSourceText st (pprHsString s)\n\n-- | pmPprHsLit pretty prints literals and is used when pretty printing pattern\n-- match warnings. All are printed the same (i.e., without hashes if they are\n-- primitive and not wrapped in constructors if they are boxed). This happens\n-- mainly for too reasons:\n--  * We do not want to expose their internal representation\n--  * The warnings become too messy\npmPprHsLit :: HsLit (GhcPass x) -> SDoc\npmPprHsLit (HsChar _ c)       = pprHsChar c\npmPprHsLit (HsCharPrim _ c)   = pprHsChar c\npmPprHsLit (HsString st s)    = pprWithSourceText st (pprHsString s)\npmPprHsLit (HsStringPrim _ s) = pprHsBytes s\npmPprHsLit (HsInt _ i)        = integer (il_value i)\npmPprHsLit (HsIntPrim _ i)    = integer i\npmPprHsLit (HsWordPrim _ w)   = integer w\npmPprHsLit (HsInt64Prim _ i)  = integer i\npmPprHsLit (HsWord64Prim _ w) = integer w\npmPprHsLit (HsInteger _ i _)  = integer i\npmPprHsLit (HsRat _ f _)      = ppr f\npmPprHsLit (HsFloatPrim _ f)  = ppr f\npmPprHsLit (HsDoublePrim _ d) = ppr d\npmPprHsLit (XLit x)           = ppr x\n\n-- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs\n-- to be parenthesized under precedence @p@.\nhsLitNeedsParens :: PprPrec -> HsLit x -> Bool\nhsLitNeedsParens p = go\n  where\n    go (HsChar {})        = False\n    go (HsCharPrim {})    = False\n    go (HsString {})      = False\n    go (HsStringPrim {})  = False\n    go (HsInt _ x)        = p > topPrec && il_neg x\n    go (HsIntPrim _ x)    = p > topPrec && x < 0\n    go (HsWordPrim {})    = False\n    go (HsInt64Prim _ x)  = p > topPrec && x < 0\n    go (HsWord64Prim {})  = False\n    go (HsInteger _ x _)  = p > topPrec && x < 0\n    go (HsRat _ x _)      = p > topPrec && fl_neg x\n    go (HsFloatPrim _ x)  = p > topPrec && fl_neg x\n    go (HsDoublePrim _ x) = p > topPrec && fl_neg x\n    go (XLit _)           = False\n\n-- | @'hsOverLitNeedsParens' p ol@ returns 'True' if an overloaded literal\n-- @ol@ needs to be parenthesized under precedence @p@.\nhsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool\nhsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv\n  where\n    go :: OverLitVal -> Bool\n    go (HsIntegral x)   = p > topPrec && il_neg x\n    go (HsFractional x) = p > topPrec && fl_neg x\n    go (HsIsString {})  = False\nhsOverLitNeedsParens _ (XOverLit { }) = False\n", "num_lines": 315}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[PatSyntax]{Abstract Haskell syntax---patterns}\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE DeriveFoldable #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns      #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule HsPat (\n        Pat(..), InPat, OutPat, LPat,\n        ListPatTc(..),\n\n        HsConPatDetails, hsConPatArgs,\n        HsRecFields(..), HsRecField'(..), LHsRecField',\n        HsRecField, LHsRecField,\n        HsRecUpdField, LHsRecUpdField,\n        hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,\n        hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,\n\n        mkPrefixConPat, mkCharLitPat, mkNilPat,\n\n        looksLazyPatBind,\n        isBangedLPat,\n        patNeedsParens, parenthesizePat,\n        isIrrefutableHsPat,\n\n        collectEvVarsPat, collectEvVarsPats,\n\n        pprParendLPat, pprConArgs\n    ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)\n\n-- friends:\nimport HsBinds\nimport HsLit\nimport HsExtension\nimport HsTypes\nimport TcEvidence\nimport BasicTypes\n-- others:\nimport PprCore          ( {- instance OutputableBndr TyVar -} )\nimport TysWiredIn\nimport Var\nimport RdrName ( RdrName )\nimport ConLike\nimport DataCon\nimport TyCon\nimport Outputable\nimport Type\nimport SrcLoc\nimport Bag -- collect ev vars from pats\nimport DynFlags( gopt, GeneralFlag(..) )\nimport Maybes\n-- libraries:\nimport Data.Data hiding (TyCon,Fixity)\n\ntype InPat p  = LPat p        -- No 'Out' constructors\ntype OutPat p = LPat p        -- No 'In' constructors\n\ntype LPat p = Pat p\n\n-- | Pattern\n--\n-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata Pat p\n  =     ------------ Simple patterns ---------------\n    WildPat     (XWildPat p)        -- ^ Wildcard Pattern\n        -- The sole reason for a type on a WildPat is to\n        -- support hsPatType :: Pat Id -> Type\n\n       -- AZ:TODO above comment needs to be updated\n  | VarPat      (XVarPat p)\n                (Located (IdP p))  -- ^ Variable Pattern\n\n                             -- See Note [Located RdrNames] in HsExpr\n  | LazyPat     (XLazyPat p)\n                (LPat p)                -- ^ Lazy Pattern\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | AsPat       (XAsPat p)\n                (Located (IdP p)) (LPat p)    -- ^ As pattern\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | ParPat      (XParPat p)\n                (LPat p)                -- ^ Parenthesised pattern\n                                        -- See Note [Parens in HsSyn] in HsExpr\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,\n    --                                    'ApiAnnotation.AnnClose' @')'@\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n  | BangPat     (XBangPat p)\n                (LPat p)                -- ^ Bang pattern\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n        ------------ Lists, tuples, arrays ---------------\n  | ListPat     (XListPat p)\n                [LPat p]\n                   -- For OverloadedLists a Just (ty,fn) gives\n                   -- overall type of the pattern, and the toList\n-- function to convert the scrutinee to a list value\n\n    -- ^ Syntactic List\n    --\n    -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,\n    --                                    'ApiAnnotation.AnnClose' @']'@\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | TuplePat    (XTuplePat p)\n                  -- after typechecking, holds the types of the tuple components\n                [LPat p]         -- Tuple sub-patterns\n                Boxity           -- UnitPat is TuplePat []\n        -- You might think that the post typechecking Type was redundant,\n        -- because we can get the pattern type by getting the types of the\n        -- sub-patterns.\n        -- But it's essential\n        --      data T a where\n        --        T1 :: Int -> T Int\n        --      f :: (T a, a) -> Int\n        --      f (T1 x, z) = z\n        -- When desugaring, we must generate\n        --      f = /\\a. \\v::a.  case v of (t::T a, w::a) ->\n        --                       case t of (T1 (x::Int)) ->\n        -- Note the (w::a), NOT (w::Int), because we have not yet\n        -- refined 'a' to Int.  So we must know that the second component\n        -- of the tuple is of type 'a' not Int.  See selectMatchVar\n        -- (June 14: I'm not sure this comment is right; the sub-patterns\n        --           will be wrapped in CoPats, no?)\n    -- ^ Tuple sub-patterns\n    --\n    -- - 'ApiAnnotation.AnnKeywordId' :\n    --            'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,\n    --            'ApiAnnotation.AnnClose' @')'@ or  @'#)'@\n\n  | SumPat      (XSumPat p)        -- PlaceHolder before typechecker, filled in\n                                   -- afterwards with the types of the\n                                   -- alternative\n                (LPat p)           -- Sum sub-pattern\n                ConTag             -- Alternative (one-based)\n                Arity              -- Arity (INVARIANT: \u00e2\u2030\u00a5 2)\n    -- ^ Anonymous sum pattern\n    --\n    -- - 'ApiAnnotation.AnnKeywordId' :\n    --            'ApiAnnotation.AnnOpen' @'(#'@,\n    --            'ApiAnnotation.AnnClose' @'#)'@\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n        ------------ Constructor patterns ---------------\n  | ConPatIn    (Located (IdP p))\n                (HsConPatDetails p)\n    -- ^ Constructor Pattern In\n\n  | ConPatOut {\n        pat_con     :: Located ConLike,\n        pat_arg_tys :: [Type],          -- The universal arg types, 1-1 with the universal\n                                        -- tyvars of the constructor/pattern synonym\n                                        --   Use (conLikeResTy pat_con pat_arg_tys) to get\n                                        --   the type of the pattern\n\n        pat_tvs   :: [TyVar],           -- Existentially bound type variables\n                                        -- in correctly-scoped order e.g. [k:*, x:k]\n        pat_dicts :: [EvVar],           -- Ditto *coercion variables* and *dictionaries*\n                                        -- One reason for putting coercion variable here, I think,\n                                        --      is to ensure their kinds are zonked\n\n        pat_binds :: TcEvBinds,         -- Bindings involving those dictionaries\n        pat_args  :: HsConPatDetails p,\n        pat_wrap  :: HsWrapper          -- Extra wrapper to pass to the matcher\n                                        -- Only relevant for pattern-synonyms;\n                                        --   ignored for data cons\n    }\n    -- ^ Constructor Pattern Out\n\n        ------------ View patterns ---------------\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | ViewPat       (XViewPat p)     -- The overall type of the pattern\n                                   -- (= the argument type of the view function)\n                                   -- for hsPatType.\n                  (LHsExpr p)\n                  (LPat p)\n    -- ^ View Pattern\n\n        ------------ Pattern splices ---------------\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@\n  --        'ApiAnnotation.AnnClose' @')'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | SplicePat       (XSplicePat p)\n                    (HsSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)\n\n        ------------ Literal and n+k patterns ---------------\n  | LitPat          (XLitPat p)\n                    (HsLit p)           -- ^ Literal Pattern\n                                        -- Used for *non-overloaded* literal patterns:\n                                        -- Int#, Char#, Int, Char, String, etc.\n\n  | NPat                -- Natural Pattern\n                        -- Used for all overloaded literals,\n                        -- including overloaded strings with -XOverloadedStrings\n                    (XNPat p)            -- Overall type of pattern. Might be\n                                         -- different than the literal's type\n                                         -- if (==) or negate changes the type\n                    (Located (HsOverLit p))     -- ALWAYS positive\n                    (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for\n                                           -- negative patterns, Nothing\n                                           -- otherwise\n                    (SyntaxExpr p)       -- Equality checker, of type t->t->Bool\n\n  -- ^ Natural Pattern\n  --\n  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern\n                    (Located (IdP p))        -- n+k pattern\n                    (Located (HsOverLit p))  -- It'll always be an HsIntegral\n                    (HsOverLit p)       -- See Note [NPlusK patterns] in TcPat\n                     -- NB: This could be (PostTc ...), but that induced a\n                     -- a new hs-boot file. Not worth it.\n\n                    (SyntaxExpr p)   -- (>=) function, of type t1->t2->Bool\n                    (SyntaxExpr p)   -- Name of '-' (see RnEnv.lookupSyntaxName)\n  -- ^ n+k pattern\n\n        ------------ Pattern type signatures ---------------\n  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'\n\n  -- For details on above see note [Api annotations] in ApiAnnotation\n  | SigPat          (XSigPat p)             -- After typechecker: Type\n                    (LPat p)                -- Pattern with a type signature\n                    (LHsSigWcType (NoGhcTc p)) --  Signature can bind both\n                                               --  kind and type vars\n\n    -- ^ Pattern with a type signature\n\n        ------------ Pattern coercions (translation only) ---------------\n  | CoPat       (XCoPat p)\n                HsWrapper           -- Coercion Pattern\n                                    -- If co :: t1 ~ t2, p :: t2,\n                                    -- then (CoPat co p) :: t1\n                (Pat p)             -- Why not LPat?  Ans: existing locn will do\n                Type                -- Type of whole pattern, t1\n        -- During desugaring a (CoPat co pat) turns into a cast with 'co' on\n        -- the scrutinee, followed by a match on 'pat'\n    -- ^ Coercion Pattern\n\n  -- | Trees that Grow extension point for new constructors\n  | XPat\n      (XXPat p)\n\n-- ---------------------------------------------------------------------\n\ndata ListPatTc\n  = ListPatTc\n      Type                             -- The type of the elements\n      (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax\n\ntype instance XWildPat GhcPs = NoExt\ntype instance XWildPat GhcRn = NoExt\ntype instance XWildPat GhcTc = Type\n\ntype instance XVarPat  (GhcPass _) = NoExt\ntype instance XLazyPat (GhcPass _) = NoExt\ntype instance XAsPat   (GhcPass _) = NoExt\ntype instance XParPat  (GhcPass _) = NoExt\ntype instance XBangPat (GhcPass _) = NoExt\n\n-- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap\n-- compiler, as it triggers https://ghc.haskell.org/trac/ghc/ticket/14396 for\n-- `SyntaxExpr`\ntype instance XListPat GhcPs = NoExt\ntype instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)\ntype instance XListPat GhcTc = ListPatTc\n\ntype instance XTuplePat GhcPs = NoExt\ntype instance XTuplePat GhcRn = NoExt\ntype instance XTuplePat GhcTc = [Type]\n\ntype instance XSumPat GhcPs = NoExt\ntype instance XSumPat GhcRn = NoExt\ntype instance XSumPat GhcTc = [Type]\n\ntype instance XViewPat GhcPs = NoExt\ntype instance XViewPat GhcRn = NoExt\ntype instance XViewPat GhcTc = Type\n\ntype instance XSplicePat (GhcPass _) = NoExt\ntype instance XLitPat    (GhcPass _) = NoExt\n\ntype instance XNPat GhcPs = NoExt\ntype instance XNPat GhcRn = NoExt\ntype instance XNPat GhcTc = Type\n\ntype instance XNPlusKPat GhcPs = NoExt\ntype instance XNPlusKPat GhcRn = NoExt\ntype instance XNPlusKPat GhcTc = Type\n\ntype instance XSigPat GhcPs = NoExt\ntype instance XSigPat GhcRn = NoExt\ntype instance XSigPat GhcTc = Type\n\ntype instance XCoPat  (GhcPass _) = NoExt\ntype instance XXPat   (GhcPass p) = Located (Pat (GhcPass p))\n\n\n{-\n************************************************************************\n*                                                                      *\n*              HasSrcSpan Instance\n*                                                                      *\n************************************************************************\n-}\n\ntype instance SrcSpanLess (LPat (GhcPass p)) = Pat (GhcPass p)\ninstance HasSrcSpan (LPat (GhcPass p)) where\n  -- NB: The following chooses the behaviour of the outer location\n  --     wrapper replacing the inner ones.\n  composeSrcSpan (L sp p) =  if sp == noSrcSpan\n                             then p\n                             else XPat (L sp (stripSrcSpanPat p))\n\n  -- NB: The following only returns the top-level location, if any.\n  decomposeSrcSpan (XPat (L sp p)) = L sp (stripSrcSpanPat p)\n  decomposeSrcSpan p               = L noSrcSpan p\n\nstripSrcSpanPat :: LPat (GhcPass p) -> Pat (GhcPass p)\nstripSrcSpanPat (XPat (L _  p)) = stripSrcSpanPat p\nstripSrcSpanPat p               = p\n\n\n\n-- ---------------------------------------------------------------------\n\n\n-- | Haskell Constructor Pattern Details\ntype HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))\n\nhsConPatArgs :: HsConPatDetails p -> [LPat p]\nhsConPatArgs (PrefixCon ps)   = ps\nhsConPatArgs (RecCon fs)      = map (hsRecFieldArg . unLoc) (rec_flds fs)\nhsConPatArgs (InfixCon p1 p2) = [p1,p2]\n\n-- | Haskell Record Fields\n--\n-- HsRecFields is used only for patterns and expressions (not data type\n-- declarations)\ndata HsRecFields p arg         -- A bunch of record fields\n                                --      { x = 3, y = True }\n        -- Used for both expressions and patterns\n  = HsRecFields { rec_flds   :: [LHsRecField p arg],\n                  rec_dotdot :: Maybe (Located Int) }  -- Note [DotDot fields]\n  deriving (Functor, Foldable, Traversable)\n\n\n-- Note [DotDot fields]\n-- ~~~~~~~~~~~~~~~~~~~~\n-- The rec_dotdot field means this:\n--   Nothing => the normal case\n--   Just n  => the group uses \"..\" notation,\n--\n-- In the latter case:\n--\n--   *before* renamer: rec_flds are exactly the n user-written fields\n--\n--   *after* renamer:  rec_flds includes *all* fields, with\n--                     the first 'n' being the user-written ones\n--                     and the remainder being 'filled in' implicitly\n\n-- | Located Haskell Record Field\ntype LHsRecField' p arg = Located (HsRecField' p arg)\n\n-- | Located Haskell Record Field\ntype LHsRecField  p arg = Located (HsRecField  p arg)\n\n-- | Located Haskell Record Update Field\ntype LHsRecUpdField p   = Located (HsRecUpdField p)\n\n-- | Haskell Record Field\ntype HsRecField    p arg = HsRecField' (FieldOcc p) arg\n\n-- | Haskell Record Update Field\ntype HsRecUpdField p     = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)\n\n-- | Haskell Record Field\n--\n-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',\n--\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata HsRecField' id arg = HsRecField {\n        hsRecFieldLbl :: Located id,\n        hsRecFieldArg :: arg,           -- ^ Filled in by renamer when punning\n        hsRecPun      :: Bool           -- ^ Note [Punning]\n  } deriving (Data, Functor, Foldable, Traversable)\n\n\n-- Note [Punning]\n-- ~~~~~~~~~~~~~~\n-- If you write T { x, y = v+1 }, the HsRecFields will be\n--      HsRecField x x True ...\n--      HsRecField y (v+1) False ...\n-- That is, for \"punned\" field x is expanded (in the renamer)\n-- to x=x; but with a punning flag so we can detect it later\n-- (e.g. when pretty printing)\n--\n-- If the original field was qualified, we un-qualify it, thus\n--    T { A.x } means T { A.x = x }\n\n\n-- Note [HsRecField and HsRecUpdField]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n-- A HsRecField (used for record construction and pattern matching)\n-- contains an unambiguous occurrence of a field (i.e. a FieldOcc).\n-- We can't just store the Name, because thanks to\n-- DuplicateRecordFields this may not correspond to the label the user\n-- wrote.\n--\n-- A HsRecUpdField (used for record update) contains a potentially\n-- ambiguous occurrence of a field (an AmbiguousFieldOcc).  The\n-- renamer will fill in the selector function if it can, but if the\n-- selector is ambiguous the renamer will defer to the typechecker.\n-- After the typechecker, a unique selector will have been determined.\n--\n-- The renamer produces an Unambiguous result if it can, rather than\n-- just doing the lookup in the typechecker, so that completely\n-- unambiguous updates can be represented by 'DsMeta.repUpdFields'.\n--\n-- For example, suppose we have:\n--\n--     data S = MkS { x :: Int }\n--     data T = MkT { x :: Int }\n--\n--     f z = (z { x = 3 }) :: S\n--\n-- The parsed HsRecUpdField corresponding to the record update will have:\n--\n--     hsRecFieldLbl = Unambiguous \"x\" NoExt :: AmbiguousFieldOcc RdrName\n--\n-- After the renamer, this will become:\n--\n--     hsRecFieldLbl = Ambiguous   \"x\" NoExt :: AmbiguousFieldOcc Name\n--\n-- (note that the Unambiguous constructor is not type-correct here).\n-- The typechecker will determine the particular selector:\n--\n--     hsRecFieldLbl = Unambiguous \"x\" $sel:x:MkS  :: AmbiguousFieldOcc Id\n--\n-- See also Note [Disambiguating record fields] in TcExpr.\n\nhsRecFields :: HsRecFields p arg -> [XCFieldOcc p]\nhsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)\n\n-- Probably won't typecheck at once, things have changed :/\nhsRecFieldsArgs :: HsRecFields p arg -> [arg]\nhsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds)\n\nhsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass)\nhsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl\n\nhsRecFieldId :: HsRecField GhcTc arg -> Located Id\nhsRecFieldId = hsRecFieldSel\n\nhsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName\nhsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl\n\nhsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id\nhsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc\n\nhsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc\nhsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl\n\n\n{-\n************************************************************************\n*                                                                      *\n*              Printing patterns\n*                                                                      *\n************************************************************************\n-}\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p) where\n    ppr = pprPat\n\npprPatBndr :: OutputableBndr name => name -> SDoc\npprPatBndr var                  -- Print with type info if -dppr-debug is on\n  = getPprStyle $ \\ sty ->\n    if debugStyle sty then\n        parens (pprBndr LambdaBind var)         -- Could pass the site to pprPat\n                                                -- but is it worth it?\n    else\n        pprPrefixOcc var\n\npprParendLPat :: (OutputableBndrId (GhcPass p))\n              => PprPrec -> LPat (GhcPass p) -> SDoc\npprParendLPat p = pprParendPat p . unLoc\n\npprParendPat :: (OutputableBndrId (GhcPass p))\n             => PprPrec -> Pat (GhcPass p) -> SDoc\npprParendPat p pat = sdocWithDynFlags $ \\ dflags ->\n                     if need_parens dflags pat\n                     then parens (pprPat pat)\n                     else  pprPat pat\n  where\n    need_parens dflags pat\n      | CoPat {} <- pat = gopt Opt_PrintTypecheckerElaboration dflags\n      | otherwise       = patNeedsParens p pat\n      -- For a CoPat we need parens if we are going to show it, which\n      -- we do if -fprint-typechecker-elaboration is on (c.f. pprHsWrapper)\n      -- But otherwise the CoPat is discarded, so it\n      -- is the pattern inside that matters.  Sigh.\n\npprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc\npprPat (VarPat _ lvar)          = pprPatBndr (unLoc lvar)\npprPat (WildPat _)              = char '_'\npprPat (LazyPat _ pat)          = char '~' <> pprParendLPat appPrec pat\npprPat (BangPat _ pat)          = char '!' <> pprParendLPat appPrec pat\npprPat (AsPat _ name pat)       = hcat [pprPrefixOcc (unLoc name), char '@',\n                                        pprParendLPat appPrec pat]\npprPat (ViewPat _ expr pat)     = hcat [pprLExpr expr, text \" -> \", ppr pat]\npprPat (ParPat _ pat)           = parens (ppr pat)\npprPat (LitPat _ s)             = ppr s\npprPat (NPat _ l Nothing  _)    = ppr l\npprPat (NPat _ l (Just _) _)    = char '-' <> ppr l\npprPat (NPlusKPat _ n k _ _ _)  = hcat [ppr n, char '+', ppr k]\npprPat (SplicePat _ splice)     = pprSplice splice\npprPat (CoPat _ co pat _)       = pprHsWrapper co $ \\parens\n                                            -> if parens\n                                                 then pprParendPat appPrec pat\n                                                 else pprPat pat\npprPat (SigPat _ pat ty)        = ppr pat <+> dcolon <+> ppr ty\npprPat (ListPat _ pats)         = brackets (interpp'SP pats)\npprPat (TuplePat _ pats bx)     = tupleParens (boxityTupleSort bx)\n                                              (pprWithCommas ppr pats)\npprPat (SumPat _ pat alt arity) = sumParens (pprAlternative ppr pat alt arity)\npprPat (ConPatIn con details)   = pprUserCon (unLoc con) details\npprPat (ConPatOut { pat_con = con\n                  , pat_tvs = tvs\n                  , pat_dicts = dicts\n                  , pat_binds = binds\n                  , pat_args = details })\n  = sdocWithDynFlags $ \\dflags ->\n       -- Tiresome; in TcBinds.tcRhs we print out a\n       -- typechecked Pat in an error message,\n       -- and we want to make sure it prints nicely\n    if gopt Opt_PrintTypecheckerElaboration dflags then\n        ppr con\n          <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))\n                         , ppr binds])\n          <+> pprConArgs details\n    else pprUserCon (unLoc con) details\npprPat (XPat x)               = ppr x\n\n\npprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p))\n           => con -> HsConPatDetails (GhcPass p) -> SDoc\npprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2\npprUserCon c details          = pprPrefixOcc c <+> pprConArgs details\n\npprConArgs :: (OutputableBndrId (GhcPass p))\n           => HsConPatDetails (GhcPass p) -> SDoc\npprConArgs (PrefixCon pats) = sep (map (pprParendLPat appPrec) pats)\npprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1\n                                  , pprParendLPat appPrec p2 ]\npprConArgs (RecCon rpats)   = ppr rpats\n\ninstance (Outputable arg)\n      => Outputable (HsRecFields p arg) where\n  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })\n        = braces (fsep (punctuate comma (map ppr flds)))\n  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just (unLoc -> n) })\n        = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))\n        where\n          dotdot = text \"..\" <+> whenPprDebug (ppr (drop n flds))\n\ninstance (Outputable p, Outputable arg)\n      => Outputable (HsRecField' p arg) where\n  ppr (HsRecField { hsRecFieldLbl = f, hsRecFieldArg = arg,\n                    hsRecPun = pun })\n    = ppr f <+> (ppUnless pun $ equals <+> ppr arg)\n\n\n{-\n************************************************************************\n*                                                                      *\n*              Building patterns\n*                                                                      *\n************************************************************************\n-}\n\nmkPrefixConPat :: DataCon ->\n                  [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p)\n-- Make a vanilla Prefix constructor pattern\nmkPrefixConPat dc pats tys\n  = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc)\n                      , pat_tvs = []\n                      , pat_dicts = []\n                      , pat_binds = emptyTcEvBinds\n                      , pat_args = PrefixCon pats\n                      , pat_arg_tys = tys\n                      , pat_wrap = idHsWrapper }\n\nmkNilPat :: Type -> OutPat (GhcPass p)\nmkNilPat ty = mkPrefixConPat nilDataCon [] [ty]\n\nmkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)\nmkCharLitPat src c = mkPrefixConPat charDataCon\n                          [noLoc $ LitPat NoExt (HsCharPrim src c)] []\n\n{-\n************************************************************************\n*                                                                      *\n* Predicates for checking things about pattern-lists in EquationInfo   *\n*                                                                      *\n************************************************************************\n\n\\subsection[Pat-list-predicates]{Look for interesting things in patterns}\n\nUnlike in the Wadler chapter, where patterns are either ``variables''\nor ``constructors,'' here we distinguish between:\n\\begin{description}\n\\item[unfailable:]\nPatterns that cannot fail to match: variables, wildcards, and lazy\npatterns.\n\nThese are the irrefutable patterns; the two other categories\nare refutable patterns.\n\n\\item[constructor:]\nA non-literal constructor pattern (see next category).\n\n\\item[literal patterns:]\nAt least the numeric ones may be overloaded.\n\\end{description}\n\nA pattern is in {\\em exactly one} of the above three categories; `as'\npatterns are treated specially, of course.\n\nThe 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.\n-}\n\nisBangedLPat :: LPat (GhcPass p) -> Bool\nisBangedLPat = isBangedPat . unLoc\n\nisBangedPat :: Pat (GhcPass p) -> Bool\nisBangedPat (ParPat _ p) = isBangedLPat p\nisBangedPat (BangPat {}) = True\nisBangedPat _            = False\n\nlooksLazyPatBind :: HsBind (GhcPass p) -> Bool\n-- Returns True of anything *except*\n--     a StrictHsBind (as above) or\n--     a VarPat\n-- In particular, returns True of a pattern binding with a compound pattern, like (I# x)\n-- Looks through AbsBinds\nlooksLazyPatBind (PatBind { pat_lhs = p })\n  = looksLazyLPat p\nlooksLazyPatBind (AbsBinds { abs_binds = binds })\n  = anyBag (looksLazyPatBind . unLoc) binds\nlooksLazyPatBind _\n  = False\n\nlooksLazyLPat :: LPat (GhcPass p) -> Bool\nlooksLazyLPat = looksLazyPat . unLoc\n\nlooksLazyPat :: Pat (GhcPass p) -> Bool\nlooksLazyPat (ParPat _ p)  = looksLazyLPat p\nlooksLazyPat (AsPat _ _ p) = looksLazyLPat p\nlooksLazyPat (BangPat {})  = False\nlooksLazyPat (VarPat {})   = False\nlooksLazyPat (WildPat {})  = False\nlooksLazyPat _             = True\n\nisIrrefutableHsPat :: (OutputableBndrId (GhcPass p)) => LPat (GhcPass p) -> Bool\n-- (isIrrefutableHsPat p) is true if matching against p cannot fail,\n-- in the sense of falling through to the next pattern.\n--      (NB: this is not quite the same as the (silly) defn\n--      in 3.17.2 of the Haskell 98 report.)\n--\n-- WARNING: isIrrefutableHsPat returns False if it's in doubt.\n-- Specifically on a ConPatIn, which is what it sees for a\n-- (LPat Name) in the renamer, it doesn't know the size of the\n-- constructor family, so it returns False.  Result: only\n-- tuple patterns are considered irrefuable at the renamer stage.\n--\n-- But if it returns True, the pattern is definitely irrefutable\nisIrrefutableHsPat\n  = goL\n  where\n    goL = go . unLoc\n\n    go (WildPat {})        = True\n    go (VarPat {})         = True\n    go (LazyPat {})        = True\n    go (BangPat _ pat)     = goL pat\n    go (CoPat _ _ pat _)   = go  pat\n    go (ParPat _ pat)      = goL pat\n    go (AsPat _ _ pat)     = goL pat\n    go (ViewPat _ _ pat)   = goL pat\n    go (SigPat _ pat _)    = goL pat\n    go (TuplePat _ pats _) = all goL pats\n    go (SumPat {})         = False\n                    -- See Note [Unboxed sum patterns aren't irrefutable]\n    go (ListPat {})        = False\n\n    go (ConPatIn {})       = False     -- Conservative\n    go (ConPatOut\n        { pat_con  = (dL->L _ (RealDataCon con))\n        , pat_args = details })\n                           =\n      isJust (tyConSingleDataCon_maybe (dataConTyCon con))\n      -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because\n      -- the latter is false of existentials. See Trac #4439\n      && all goL (hsConPatArgs details)\n    go (ConPatOut\n        { pat_con = (dL->L _ (PatSynCon _pat)) })\n                           = False -- Conservative\n    go (ConPatOut{})       = panic \"ConPatOut:Impossible Match\" -- due to #15884\n    go (LitPat {})         = False\n    go (NPat {})           = False\n    go (NPlusKPat {})      = False\n\n    -- We conservatively assume that no TH splices are irrefutable\n    -- since we cannot know until the splice is evaluated.\n    go (SplicePat {})      = False\n\n    go (XPat {})           = False\n\n{- Note [Unboxed sum patterns aren't irrefutable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nUnlike unboxed tuples, unboxed sums are *not* irrefutable when used as\npatterns. A simple example that demonstrates this is from #14228:\n\n  pattern Just' x = (# x | #)\n  pattern Nothing' = (# | () #)\n\n  foo x = case x of\n    Nothing' -> putStrLn \"nothing\"\n    Just'    -> putStrLn \"just\"\n\nIn foo, the pattern Nothing' (that is, (# x | #)) is certainly not irrefutable,\nas does not match an unboxed sum value of the same arity\u00e2\u20ac\u201dnamely, (# | y #)\n(covered by Just'). In fact, no unboxed sum pattern is irrefutable, since the\nminimum unboxed sum arity is 2.\n\nFailing to mark unboxed sum patterns as non-irrefutable would cause the Just'\ncase in foo to be unreachable, as GHC would mistakenly believe that Nothing'\nis the only thing that could possibly be matched!\n-}\n\n-- | @'patNeedsParens' p pat@ returns 'True' if the pattern @pat@ needs\n-- parentheses under precedence @p@.\npatNeedsParens :: PprPrec -> Pat p -> Bool\npatNeedsParens p = go\n  where\n    go (NPlusKPat {})    = p > opPrec\n    go (SplicePat {})    = False\n    go (ConPatIn _ ds)   = conPatNeedsParens p ds\n    go cp@(ConPatOut {}) = conPatNeedsParens p (pat_args cp)\n    go (SigPat {})       = p >= sigPrec\n    go (ViewPat {})      = True\n    go (CoPat _ _ p _)   = go p\n    go (WildPat {})      = False\n    go (VarPat {})       = False\n    go (LazyPat {})      = False\n    go (BangPat {})      = False\n    go (ParPat {})       = False\n    go (AsPat {})        = False\n    go (TuplePat {})     = False\n    go (SumPat {})       = False\n    go (ListPat {})      = False\n    go (LitPat _ l)      = hsLitNeedsParens p l\n    go (NPat _ lol _ _)  = hsOverLitNeedsParens p (unLoc lol)\n    go (XPat {})         = True -- conservative default\n\n-- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@\n-- needs parentheses under precedence @p@.\nconPatNeedsParens :: PprPrec -> HsConDetails a b -> Bool\nconPatNeedsParens p = go\n  where\n    go (PrefixCon args) = p >= appPrec && not (null args)\n    go (InfixCon {})    = p >= opPrec\n    go (RecCon {})      = False\n\n-- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and\n-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.\nparenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)\nparenthesizePat p lpat@(dL->L loc pat)\n  | patNeedsParens p pat = cL loc (ParPat NoExt lpat)\n  | otherwise            = lpat\n\n{-\n% Collect all EvVars from all constructor patterns\n-}\n\n-- May need to add more cases\ncollectEvVarsPats :: [Pat GhcTc] -> Bag EvVar\ncollectEvVarsPats = unionManyBags . map collectEvVarsPat\n\ncollectEvVarsLPat :: LPat GhcTc -> Bag EvVar\ncollectEvVarsLPat = collectEvVarsPat . unLoc\n\ncollectEvVarsPat :: Pat GhcTc -> Bag EvVar\ncollectEvVarsPat pat =\n  case pat of\n    LazyPat _ p      -> collectEvVarsLPat p\n    AsPat _ _ p      -> collectEvVarsLPat p\n    ParPat  _ p      -> collectEvVarsLPat p\n    BangPat _ p      -> collectEvVarsLPat p\n    ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps\n    TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps\n    SumPat _ p _ _   -> collectEvVarsLPat p\n    ConPatOut {pat_dicts = dicts, pat_args  = args}\n                     -> unionBags (listToBag dicts)\n                                   $ unionManyBags\n                                   $ map collectEvVarsLPat\n                                   $ hsConPatArgs args\n    SigPat  _ p _    -> collectEvVarsLPat p\n    CoPat _ _ p _    -> collectEvVarsPat  p\n    ConPatIn _  _    -> panic \"foldMapPatBag: ConPatIn\"\n    _other_pat       -> emptyBag\n", "num_lines": 847}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section{Haskell abstract syntax definition}\n\nThis module glues together the pieces of the Haskell abstract syntax,\nwhich is declared in the various \\tr{Hs*} modules.  This module,\ntherefore, is almost nothing but re-exporting.\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-} -- For deriving instance Data\n\nmodule HsSyn (\n        module HsBinds,\n        module HsDecls,\n        module HsExpr,\n        module HsImpExp,\n        module HsLit,\n        module HsPat,\n        module HsTypes,\n        module HsUtils,\n        module HsDoc,\n        module PlaceHolder,\n        module HsExtension,\n        Fixity,\n\n        HsModule(..),\n) where\n\n-- friends:\nimport GhcPrelude\n\nimport HsDecls\nimport HsBinds\nimport HsExpr\nimport HsImpExp\nimport HsLit\nimport PlaceHolder\nimport HsExtension\nimport HsPat\nimport HsTypes\nimport BasicTypes       ( Fixity, WarningTxt )\nimport HsUtils\nimport HsDoc\nimport HsInstances ()\n\n-- others:\nimport Outputable\nimport SrcLoc\nimport Module           ( ModuleName )\n\n-- libraries:\nimport Data.Data hiding ( Fixity )\n\n-- | Haskell Module\n--\n-- All we actually declare here is the top-level structure for a module.\ndata HsModule pass\n  = HsModule {\n      hsmodName :: Maybe (Located ModuleName),\n        -- ^ @Nothing@: \\\"module X where\\\" is omitted (in which case the next\n        --     field is Nothing too)\n      hsmodExports :: Maybe (Located [LIE pass]),\n        -- ^ Export list\n        --\n        --  - @Nothing@: export list omitted, so export everything\n        --\n        --  - @Just []@: export /nothing/\n        --\n        --  - @Just [...]@: as you would expect...\n        --\n        --\n        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'\n        --                                   ,'ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n      hsmodImports :: [LImportDecl pass],\n        -- ^ We snaffle interesting stuff out of the imported interfaces early\n        -- on, adding that info to TyDecls/etc; so this list is often empty,\n        -- downstream.\n      hsmodDecls :: [LHsDecl pass],\n        -- ^ Type, class, value, and interface signature decls\n      hsmodDeprecMessage :: Maybe (Located WarningTxt),\n        -- ^ reason\\/explanation for warning/deprecation of this module\n        --\n        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'\n        --                                   ,'ApiAnnotation.AnnClose'\n        --\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n      hsmodHaddockModHeader :: Maybe LHsDocString\n        -- ^ Haddock module info and description, unparsed\n        --\n        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'\n        --                                   ,'ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n   }\n     -- ^ 'ApiAnnotation.AnnKeywordId's\n     --\n     --  - 'ApiAnnotation.AnnModule','ApiAnnotation.AnnWhere'\n     --\n     --  - 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnSemi',\n     --    'ApiAnnotation.AnnClose' for explicit braces and semi around\n     --    hsmodImports,hsmodDecls if this style is used.\n\n     -- For details on above see note [Api annotations] in ApiAnnotation\n-- deriving instance (DataIdLR name name) => Data (HsModule name)\nderiving instance Data (HsModule GhcPs)\nderiving instance Data (HsModule GhcRn)\nderiving instance Data (HsModule GhcTc)\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsModule p) where\n\n    ppr (HsModule Nothing _ imports decls _ mbDoc)\n      = pp_mb mbDoc $$ pp_nonnull imports\n                    $$ pp_nonnull decls\n\n    ppr (HsModule (Just name) exports imports decls deprec mbDoc)\n      = vcat [\n            pp_mb mbDoc,\n            case exports of\n              Nothing -> pp_header (text \"where\")\n              Just es -> vcat [\n                           pp_header lparen,\n                           nest 8 (fsep (punctuate comma (map ppr (unLoc es)))),\n                           nest 4 (text \") where\")\n                          ],\n            pp_nonnull imports,\n            pp_nonnull decls\n          ]\n      where\n        pp_header rest = case deprec of\n           Nothing -> pp_modname <+> rest\n           Just d -> vcat [ pp_modname, ppr d, rest ]\n\n        pp_modname = text \"module\" <+> ppr name\n\npp_mb :: Outputable t => Maybe t -> SDoc\npp_mb (Just x) = ppr x\npp_mb Nothing  = empty\n\npp_nonnull :: Outputable t => [t] -> SDoc\npp_nonnull [] = empty\npp_nonnull xs = vcat (map ppr xs)\n", "num_lines": 154}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nHsTypes: Abstract syntax: user-defined types\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule HsTypes (\n        HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind,\n        HsTyVarBndr(..), LHsTyVarBndr, ForallVisFlag(..),\n        LHsQTyVars(..), HsQTvsRn(..),\n        HsImplicitBndrs(..),\n        HsWildCardBndrs(..),\n        LHsSigType, LHsSigWcType, LHsWcType,\n        HsTupleSort(..),\n        HsContext, LHsContext, noLHsContext,\n        HsTyLit(..),\n        HsIPName(..), hsIPNameFS,\n        HsArg(..), numVisibleArgs,\n        LHsTypeArg,\n\n        LBangType, BangType,\n        HsSrcBang(..), HsImplBang(..),\n        SrcStrictness(..), SrcUnpackedness(..),\n        getBangType, getBangStrictness,\n\n        ConDeclField(..), LConDeclField, pprConDeclFields,\n\n        HsConDetails(..),\n\n        FieldOcc(..), LFieldOcc, mkFieldOcc,\n        AmbiguousFieldOcc(..), mkAmbiguousFieldOcc,\n        rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,\n        unambiguousFieldOcc, ambiguousFieldOcc,\n\n        mkAnonWildCardTy, pprAnonWildCard,\n\n        mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,\n        mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,\n        mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isEmptyLHsQTvs,\n        isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy,\n        hsScopedTvs, hsWcScopedTvs, dropWildCards,\n        hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,\n        hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames,\n        splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,\n        splitLHsPatSynTy,\n        splitLHsForAllTy, splitLHsForAllTyInvis,\n        splitLHsQualTy, splitLHsSigmaTy, splitLHsSigmaTyInvis,\n        splitHsFunType, hsTyGetAppHead_maybe,\n        mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,\n        ignoreParens, hsSigType, hsSigWcType,\n        hsLTyVarBndrToType, hsLTyVarBndrsToTypes,\n\n        -- Printing\n        pprHsType, pprHsForAll, pprHsForAllExtra, pprHsExplicitForAll,\n        pprLHsContext,\n        hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext\n    ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )\n\nimport HsExtension\nimport HsLit () -- for instances\n\nimport Id ( Id )\nimport Name( Name )\nimport RdrName ( RdrName )\nimport NameSet ( NameSet, emptyNameSet )\nimport DataCon( HsSrcBang(..), HsImplBang(..),\n                SrcStrictness(..), SrcUnpackedness(..) )\nimport TysPrim( funTyConName )\nimport Type\nimport HsDoc\nimport BasicTypes\nimport SrcLoc\nimport Outputable\nimport FastString\nimport Maybes( isJust )\nimport Util ( count )\n\nimport Data.Data hiding ( Fixity, Prefix, Infix )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Bang annotations}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located Bang Type\ntype LBangType pass = Located (BangType pass)\n\n-- | Bang Type\ntype BangType pass  = HsType pass       -- Bangs are in the HsType data type\n\ngetBangType :: LHsType a -> LHsType a\ngetBangType (L _ (HsBangTy _ _ ty)) = ty\ngetBangType ty                      = ty\n\ngetBangStrictness :: LHsType a -> HsSrcBang\ngetBangStrictness (L _ (HsBangTy _ s _)) = s\ngetBangStrictness _ = (HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Data types}\n*                                                                      *\n************************************************************************\n\nThis is the syntax for types as seen in type signatures.\n\nNote [HsBSig binder lists]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider a binder (or pattern) decorated with a type or kind,\n   \\ (x :: a -> a). blah\n   forall (a :: k -> *) (b :: k). blah\nThen we use a LHsBndrSig on the binder, so that the\nrenamer can decorate it with the variables bound\nby the pattern ('a' in the first example, 'k' in the second),\nassuming that neither of them is in scope already\nSee also Note [Kind and type-variable binders] in RnTypes\n\nNote [HsType binders]\n~~~~~~~~~~~~~~~~~~~~~\nThe system for recording type and kind-variable binders in HsTypes\nis a bit complicated.  Here's how it works.\n\n* In a HsType,\n     HsForAllTy   represents an /explicit, user-written/ 'forall'\n                   e.g.   forall a b.   {...} or\n                          forall a b -> {...}\n     HsQualTy     represents an /explicit, user-written/ context\n                   e.g.   (Eq a, Show a) => ...\n                  The context can be empty if that's what the user wrote\n  These constructors represent what the user wrote, no more\n  and no less.\n\n* The ForallVisFlag field of HsForAllTy represents whether a forall is\n  invisible (e.g., forall a b. {...}, with a dot) or visible\n  (e.g., forall a b -> {...}, with an arrow).\n\n* HsTyVarBndr describes a quantified type variable written by the\n  user.  For example\n     f :: forall a (b :: *).  blah\n  here 'a' and '(b::*)' are each a HsTyVarBndr.  A HsForAllTy has\n  a list of LHsTyVarBndrs.\n\n* HsImplicitBndrs is a wrapper that gives the implicitly-quantified\n  kind and type variables of the wrapped thing.  It is filled in by\n  the renamer. For example, if the user writes\n     f :: a -> a\n  the HsImplicitBinders binds the 'a' (not a HsForAllTy!).\n  NB: this implicit quantification is purely lexical: we bind any\n      type or kind variables that are not in scope. The type checker\n      may subsequently quantify over further kind variables.\n\n* HsWildCardBndrs is a wrapper that binds the wildcard variables\n  of the wrapped thing.  It is filled in by the renamer\n     f :: _a -> _\n  The enclosing HsWildCardBndrs binds the wildcards _a and _.\n\n* The explicit presence of these wrappers specifies, in the HsSyn,\n  exactly where implicit quantification is allowed, and where\n  wildcards are allowed.\n\n* LHsQTyVars is used in data/class declarations, where the user gives\n  explicit *type* variable bindings, but we need to implicitly bind\n  *kind* variables.  For example\n      class C (a :: k -> *) where ...\n  The 'k' is implicitly bound in the hsq_tvs field of LHsQTyVars\n\nNote [The wildcard story for types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTypes can have wildcards in them, to support partial type signatures,\nlike       f :: Int -> (_ , _a) -> _a\n\nA wildcard in a type can be\n\n  * An anonymous wildcard,\n        written '_'\n    In HsType this is represented by HsWildCardTy.\n    The renamer leaves it untouched, and it is later given fresh meta tyvars in\n    the typechecker.\n\n  * A named wildcard,\n        written '_a', '_foo', etc\n    In HsType this is represented by (HsTyVar \"_a\")\n    i.e. a perfectly ordinary type variable that happens\n         to start with an underscore\n\nNote carefully:\n\n* When NamedWildCards is off, type variables that start with an\n  underscore really /are/ ordinary type variables.  And indeed, even\n  when NamedWildCards is on you can bind _a explicitly as an ordinary\n  type variable:\n        data T _a _b = MkT _b _a\n  Or even:\n        f :: forall _a. _a -> _b\n  Here _a is an ordinary forall'd binder, but (With NamedWildCards)\n  _b is a named wildcard.  (See the comments in Trac #10982)\n\n* Named wildcards are bound by the HsWildCardBndrs construct, which wraps\n  types that are allowed to have wildcards. Unnamed wildcards however are left\n  unchanged until typechecking, where we give them fresh wild tyavrs and\n  determine whether or not to emit hole constraints on each wildcard\n  (we don't if it's a visible type/kind argument or a type family pattern).\n  See related notes Note [Wildcards in visible kind application]\n  and Note [Wildcards in visible type application] in TcHsType.hs\n\n* After type checking is done, we report what types the wildcards\n  got unified with.\n\nNote [Ordering of implicit variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSince the advent of -XTypeApplications, GHC makes promises about the ordering\nof implicit variable quantification. Specifically, we offer that implicitly\nquantified variables (such as those in const :: a -> b -> a, without a `forall`)\nwill occur in left-to-right order of first occurrence. Here are a few examples:\n\n  const :: a -> b -> a       -- forall a b. ...\n  f :: Eq a => b -> a -> a   -- forall a b. ...  contexts are included\n\n  type a <-< b = b -> a\n  g :: a <-< b               -- forall a b. ...  type synonyms matter\n\n  class Functor f where\n    fmap :: (a -> b) -> f a -> f b   -- forall f a b. ...\n    -- The f is quantified by the class, so only a and b are considered in fmap\n\nThis simple story is complicated by the possibility of dependency: all variables\nmust come after any variables mentioned in their kinds.\n\n  typeRep :: Typeable a => TypeRep (a :: k)   -- forall k a. ...\n\nThe k comes first because a depends on k, even though the k appears later than\nthe a in the code. Thus, GHC does a *stable topological sort* on the variables.\nBy \"stable\", we mean that any two variables who do not depend on each other\npreserve their existing left-to-right ordering.\n\nImplicitly bound variables are collected by the extract- family of functions\n(extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.) in RnTypes.\nThese functions thus promise to keep left-to-right ordering.\nLook for pointers to this note to see the places where the action happens.\n\nNote that we also maintain this ordering in kind signatures. Even though\nthere's no visible kind application (yet), having implicit variables be\nquantified in left-to-right order in kind signatures is nice since:\n\n* It's consistent with the treatment for type signatures.\n* It can affect how types are displayed with -fprint-explicit-kinds (see\n  #15568 for an example), which is a situation where knowing the order in\n  which implicit variables are quantified can be useful.\n* In the event that visible kind application is implemented, the order in\n  which we would expect implicit variables to be ordered in kinds will have\n  already been established.\n-}\n\n-- | Located Haskell Context\ntype LHsContext pass = Located (HsContext pass)\n      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit'\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\nnoLHsContext :: LHsContext pass\n-- Use this when there is no context in the original program\n-- It would really be more kosher to use a Maybe, to distinguish\n--     class () => C a where ...\n-- from\n--     class C a where ...\nnoLHsContext = noLoc []\n\n-- | Haskell Context\ntype HsContext pass = [LHsType pass]\n\n-- | Located Haskell Type\ntype LHsType pass = Located (HsType pass)\n      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when\n      --   in a list\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Haskell Kind\ntype HsKind pass = HsType pass\n\n-- | Located Haskell Kind\ntype LHsKind pass = Located (HsKind pass)\n      -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n--------------------------------------------------\n--             LHsQTyVars\n--  The explicitly-quantified binders in a data/type declaration\n\n-- | Located Haskell Type Variable Binder\ntype LHsTyVarBndr pass = Located (HsTyVarBndr pass)\n                         -- See Note [HsType binders]\n\n-- | Located Haskell Quantified Type Variables\ndata LHsQTyVars pass   -- See Note [HsType binders]\n  = HsQTvs { hsq_ext :: XHsQTvs pass\n\n           , hsq_explicit :: [LHsTyVarBndr pass]\n                -- Explicit variables, written by the user\n                -- See Note [HsForAllTy tyvar binders]\n    }\n  | XLHsQTyVars (XXLHsQTyVars pass)\n\ndata HsQTvsRn\n  = HsQTvsRn\n           { hsq_implicit :: [Name]\n                -- Implicit (dependent) variables\n\n           , hsq_dependent :: NameSet\n               -- Which members of hsq_explicit are dependent; that is,\n               -- mentioned in the kind of a later hsq_explicit,\n               -- or mentioned in a kind in the scope of this HsQTvs\n               -- See Note [Dependent LHsQTyVars] in TcHsType\n           } deriving Data\n\ntype instance XHsQTvs       GhcPs = NoExt\ntype instance XHsQTvs       GhcRn = HsQTvsRn\ntype instance XHsQTvs       GhcTc = HsQTvsRn\n\ntype instance XXLHsQTyVars  (GhcPass _) = NoExt\n\nmkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs\nmkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs }\n\nhsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]\nhsQTvExplicit = hsq_explicit\n\nemptyLHsQTvs :: LHsQTyVars GhcRn\nemptyLHsQTvs = HsQTvs (HsQTvsRn [] emptyNameSet) []\n\nisEmptyLHsQTvs :: LHsQTyVars GhcRn -> Bool\nisEmptyLHsQTvs (HsQTvs (HsQTvsRn [] _) []) = True\nisEmptyLHsQTvs _                = False\n\n------------------------------------------------\n--            HsImplicitBndrs\n-- Used to quantify the implicit binders of a type\n--    * Implicit binders of a type signature (LHsSigType/LHsSigWcType)\n--    * Patterns in a type/data family instance (HsTyPats)\n\n-- | Haskell Implicit Binders\ndata HsImplicitBndrs pass thing   -- See Note [HsType binders]\n  = HsIB { hsib_ext  :: XHsIB pass thing -- after renamer: [Name]\n                                         -- Implicitly-bound kind & type vars\n                                         -- Order is important; see\n                                         -- Note [Ordering of implicit variables]\n                                         -- in RnTypes\n\n         , hsib_body :: thing            -- Main payload (type or list of types)\n    }\n  | XHsImplicitBndrs (XXHsImplicitBndrs pass thing)\n\ntype instance XHsIB              GhcPs _ = NoExt\ntype instance XHsIB              GhcRn _ = [Name]\ntype instance XHsIB              GhcTc _ = [Name]\n\ntype instance XXHsImplicitBndrs  (GhcPass _) _ = NoExt\n\n-- | Haskell Wildcard Binders\ndata HsWildCardBndrs pass thing\n    -- See Note [HsType binders]\n    -- See Note [The wildcard story for types]\n  = HsWC { hswc_ext :: XHsWC pass thing\n                -- after the renamer\n                -- Wild cards, only named\n                -- See Note [Wildcards in visible kind application]\n\n         , hswc_body :: thing\n                -- Main payload (type or list of types)\n                -- If there is an extra-constraints wildcard,\n                -- it's still there in the hsc_body.\n    }\n  | XHsWildCardBndrs (XXHsWildCardBndrs pass thing)\n\ntype instance XHsWC              GhcPs b = NoExt\ntype instance XHsWC              GhcRn b = [Name]\ntype instance XHsWC              GhcTc b = [Name]\n\ntype instance XXHsWildCardBndrs  (GhcPass _) b = NoExt\n\n-- | Located Haskell Signature Type\ntype LHsSigType   pass = HsImplicitBndrs pass (LHsType pass)    -- Implicit only\n\n-- | Located Haskell Wildcard Type\ntype LHsWcType    pass = HsWildCardBndrs pass (LHsType pass)    -- Wildcard only\n\n-- | Located Haskell Signature Wildcard Type\ntype LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both\n\n-- See Note [Representing type signatures]\n\nhsImplicitBody :: HsImplicitBndrs pass thing -> thing\nhsImplicitBody (HsIB { hsib_body = body }) = body\nhsImplicitBody (XHsImplicitBndrs _) = panic \"hsImplicitBody\"\n\nhsSigType :: LHsSigType pass -> LHsType pass\nhsSigType = hsImplicitBody\n\nhsSigWcType :: LHsSigWcType pass -> LHsType pass\nhsSigWcType sig_ty = hsib_body (hswc_body sig_ty)\n\ndropWildCards :: LHsSigWcType pass -> LHsSigType pass\n-- Drop the wildcard part of a LHsSigWcType\ndropWildCards sig_ty = hswc_body sig_ty\n\n{- Note [Representing type signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHsSigType is used to represent an explicit user type signature\nsuch as   f :: a -> a\n     or   g (x :: a -> a) = x\n\nA HsSigType is just a HsImplicitBndrs wrapping a LHsType.\n * The HsImplicitBndrs binds the /implicitly/ quantified tyvars\n * The LHsType binds the /explicitly/ quantified tyvars\n\nE.g. For a signature like\n   f :: forall (a::k). blah\nwe get\n   HsIB { hsib_vars = [k]\n        , hsib_body = HsForAllTy { hst_bndrs = [(a::*)]\n                                 , hst_body = blah }\nThe implicit kind variable 'k' is bound by the HsIB;\nthe explicitly forall'd tyvar 'a' is bound by the HsForAllTy\n-}\n\nmkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing\nmkHsImplicitBndrs x = HsIB { hsib_ext  = noExt\n                           , hsib_body = x }\n\nmkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing\nmkHsWildCardBndrs x = HsWC { hswc_body = x\n                           , hswc_ext  = noExt }\n\n-- Add empty binders.  This is a bit suspicious; what if\n-- the wrapped thing had free type variables?\nmkEmptyImplicitBndrs :: thing -> HsImplicitBndrs GhcRn thing\nmkEmptyImplicitBndrs x = HsIB { hsib_ext = []\n                              , hsib_body = x }\n\nmkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing\nmkEmptyWildCardBndrs x = HsWC { hswc_body = x\n                              , hswc_ext  = [] }\n\n\n--------------------------------------------------\n-- | These names are used early on to store the names of implicit\n-- parameters.  They completely disappear after type-checking.\nnewtype HsIPName = HsIPName FastString\n  deriving( Eq, Data )\n\nhsIPNameFS :: HsIPName -> FastString\nhsIPNameFS (HsIPName n) = n\n\ninstance Outputable HsIPName where\n    ppr (HsIPName n) = char '?' <> ftext n -- Ordinary implicit parameters\n\ninstance OutputableBndr HsIPName where\n    pprBndr _ n   = ppr n         -- Simple for now\n    pprInfixOcc  n = ppr n\n    pprPrefixOcc n = ppr n\n\n--------------------------------------------------\n\n-- | Haskell Type Variable Binder\ndata HsTyVarBndr pass\n  = UserTyVar        -- no explicit kinding\n         (XUserTyVar pass)\n         (Located (IdP pass))\n        -- See Note [Located RdrNames] in HsExpr\n  | KindedTyVar\n         (XKindedTyVar pass)\n         (Located (IdP pass))\n         (LHsKind pass)  -- The user-supplied kind signature\n        -- ^\n        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n        --          'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose'\n\n        -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | XTyVarBndr\n      (XXTyVarBndr pass)\n\ntype instance XUserTyVar    (GhcPass _) = NoExt\ntype instance XKindedTyVar  (GhcPass _) = NoExt\ntype instance XXTyVarBndr   (GhcPass _) = NoExt\n\n-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?\nisHsKindedTyVar :: HsTyVarBndr pass -> Bool\nisHsKindedTyVar (UserTyVar {})   = False\nisHsKindedTyVar (KindedTyVar {}) = True\nisHsKindedTyVar (XTyVarBndr{})   = panic \"isHsKindedTyVar\"\n\n-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?\nhsTvbAllKinded :: LHsQTyVars pass -> Bool\nhsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit\n\n-- | Haskell Type\ndata HsType pass\n  = HsForAllTy   -- See Note [HsType binders]\n      { hst_xforall :: XForAllTy pass\n      , hst_fvf     :: ForallVisFlag -- Is this `forall a -> {...}` or\n                                     --         `forall a. {...}`?\n      , hst_bndrs   :: [LHsTyVarBndr pass]\n                                       -- Explicit, user-supplied 'forall a b c'\n      , hst_body    :: LHsType pass      -- body type\n      }\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',\n      --         'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsQualTy   -- See Note [HsType binders]\n      { hst_xqual :: XQualTy pass\n      , hst_ctxt  :: LHsContext pass       -- Context C => blah\n      , hst_body  :: LHsType pass }\n\n  | HsTyVar  (XTyVar pass)\n              PromotionFlag    -- Whether explicitly promoted,\n                               -- for the pretty printer\n             (Located (IdP pass))\n                  -- Type variable, type constructor, or data constructor\n                  -- see Note [Promotions (HsTyVar)]\n                  -- See Note [Located RdrNames] in HsExpr\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsAppTy             (XAppTy pass)\n                        (LHsType pass)\n                        (LHsType pass)\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsAppKindTy         (XAppKindTy pass) -- type level type app\n                        (LHsType pass)\n                        (LHsKind pass)\n\n  | HsFunTy             (XFunTy pass)\n                        (LHsType pass)   -- function type\n                        (LHsType pass)\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsListTy            (XListTy pass)\n                        (LHsType pass)  -- Element type\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,\n      --         'ApiAnnotation.AnnClose' @']'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsTupleTy           (XTupleTy pass)\n                        HsTupleSort\n                        [LHsType pass]  -- Element types (length gives arity)\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@,\n    --         'ApiAnnotation.AnnClose' @')' or '#)'@\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsSumTy             (XSumTy pass)\n                        [LHsType pass]  -- Element types (length gives arity)\n    -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,\n    --         'ApiAnnotation.AnnClose' '#)'@\n\n    -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsOpTy              (XOpTy pass)\n                        (LHsType pass) (Located (IdP pass)) (LHsType pass)\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsParTy             (XParTy pass)\n                        (LHsType pass)   -- See Note [Parens in HsSyn] in HsExpr\n        -- Parenthesis preserved for the precedence re-arrangement in RnTypes\n        -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,\n      --         'ApiAnnotation.AnnClose' @')'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsIParamTy          (XIParamTy pass)\n                        (Located HsIPName) -- (?x :: ty)\n                        (LHsType pass)   -- Implicit parameters as they occur in\n                                         -- contexts\n      -- ^\n      -- > (?x :: ty)\n      --\n      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsStarTy            (XStarTy pass)\n                        Bool             -- Is this the Unicode variant?\n                                         -- Note [HsStarTy]\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n  | HsKindSig           (XKindSig pass)\n                        (LHsType pass)  -- (ty :: kind)\n                        (LHsKind pass)  -- A type with a kind signature\n      -- ^\n      -- > (ty :: kind)\n      --\n      -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,\n      --         'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @')'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsSpliceTy          (XSpliceTy pass)\n                        (HsSplice pass)   -- Includes quasi-quotes\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,\n      --         'ApiAnnotation.AnnClose' @')'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsDocTy             (XDocTy pass)\n                        (LHsType pass) LHsDocString -- A documented type\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsBangTy    (XBangTy pass)\n                HsSrcBang (LHsType pass)   -- Bang-style type annotations\n      -- ^ - 'ApiAnnotation.AnnKeywordId' :\n      --         'ApiAnnotation.AnnOpen' @'{-\\# UNPACK' or '{-\\# NOUNPACK'@,\n      --         'ApiAnnotation.AnnClose' @'#-}'@\n      --         'ApiAnnotation.AnnBang' @\\'!\\'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsRecTy     (XRecTy pass)\n                [LConDeclField pass]    -- Only in data type declarations\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,\n      --         'ApiAnnotation.AnnClose' @'}'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  -- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed*\n  --                                -- Core Type through HsSyn.\n  --     -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsExplicitListTy       -- A promoted explicit list\n        (XExplicitListTy pass)\n        PromotionFlag      -- whether explcitly promoted, for pretty printer\n        [LHsType pass]\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @\"'[\"@,\n      --         'ApiAnnotation.AnnClose' @']'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsExplicitTupleTy      -- A promoted explicit tuple\n        (XExplicitTupleTy pass)\n        [LHsType pass]\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @\"'(\"@,\n      --         'ApiAnnotation.AnnClose' @')'@\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsTyLit (XTyLit pass) HsTyLit      -- A promoted numeric literal.\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  | HsWildCardTy (XWildCardTy pass)  -- A type wildcard\n      -- See Note [The wildcard story for types]\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n  -- For adding new constructors via Trees that Grow\n  | XHsType\n      (XXType pass)\n\ndata NewHsTypeX\n  = NHsCoreTy Type -- An escape hatch for tunnelling a *closed*\n                   -- Core Type through HsSyn.\n    deriving Data\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : None\n\ninstance Outputable NewHsTypeX where\n  ppr (NHsCoreTy ty) = ppr ty\n\ntype instance XForAllTy        (GhcPass _) = NoExt\ntype instance XQualTy          (GhcPass _) = NoExt\ntype instance XTyVar           (GhcPass _) = NoExt\ntype instance XAppTy           (GhcPass _) = NoExt\ntype instance XFunTy           (GhcPass _) = NoExt\ntype instance XListTy          (GhcPass _) = NoExt\ntype instance XTupleTy         (GhcPass _) = NoExt\ntype instance XSumTy           (GhcPass _) = NoExt\ntype instance XOpTy            (GhcPass _) = NoExt\ntype instance XParTy           (GhcPass _) = NoExt\ntype instance XIParamTy        (GhcPass _) = NoExt\ntype instance XStarTy          (GhcPass _) = NoExt\ntype instance XKindSig         (GhcPass _) = NoExt\n\ntype instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives\n\ntype instance XSpliceTy        GhcPs = NoExt\ntype instance XSpliceTy        GhcRn = NoExt\ntype instance XSpliceTy        GhcTc = Kind\n\ntype instance XDocTy           (GhcPass _) = NoExt\ntype instance XBangTy          (GhcPass _) = NoExt\ntype instance XRecTy           (GhcPass _) = NoExt\n\ntype instance XExplicitListTy  GhcPs = NoExt\ntype instance XExplicitListTy  GhcRn = NoExt\ntype instance XExplicitListTy  GhcTc = Kind\n\ntype instance XExplicitTupleTy GhcPs = NoExt\ntype instance XExplicitTupleTy GhcRn = NoExt\ntype instance XExplicitTupleTy GhcTc = [Kind]\n\ntype instance XTyLit           (GhcPass _) = NoExt\n\ntype instance XWildCardTy      (GhcPass _) = NoExt\n\ntype instance XXType         (GhcPass _) = NewHsTypeX\n\n\n-- Note [Literal source text] in BasicTypes for SourceText fields in\n-- the following\n-- | Haskell Type Literal\ndata HsTyLit\n  = HsNumTy SourceText Integer\n  | HsStrTy SourceText FastString\n    deriving Data\n\n\n{-\nNote [HsForAllTy tyvar binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAfter parsing:\n  * Implicit => empty\n    Explicit => the variables the user wrote\n\nAfter renaming\n  * Implicit => the *type* variables free in the type\n    Explicit => the variables the user wrote (renamed)\n\nQualified currently behaves exactly as Implicit,\nbut it is deprecated to use it for implicit quantification.\nIn this case, GHC 7.10 gives a warning; see\nNote [Context quantification] in RnTypes, and Trac #4426.\nIn GHC 8.0, Qualified will no longer bind variables\nand this will become an error.\n\nThe kind variables bound in the hsq_implicit field come both\n  a) from the kind signatures on the kind vars (eg k1)\n  b) from the scope of the forall (eg k2)\nExample:   f :: forall (a::k1) b. T a (b::k2)\n\n\nNote [Unit tuples]\n~~~~~~~~~~~~~~~~~~\nConsider the type\n    type instance F Int = ()\nWe want to parse that \"()\"\n    as HsTupleTy HsBoxedOrConstraintTuple [],\nNOT as HsTyVar unitTyCon\n\nWhy? Because F might have kind (* -> Constraint), so we when parsing we\ndon't know if that tuple is going to be a constraint tuple or an ordinary\nunit tuple.  The HsTupleSort flag is specifically designed to deal with\nthat, but it has to work for unit tuples too.\n\nNote [Promotions (HsTyVar)]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHsTyVar: A name in a type or kind.\n  Here are the allowed namespaces for the name.\n    In a type:\n      Var: not allowed\n      Data: promoted data constructor\n      Tv: type variable\n      TcCls before renamer: type constructor, class constructor, or promoted data constructor\n      TcCls after renamer: type constructor or class constructor\n    In a kind:\n      Var, Data: not allowed\n      Tv: kind variable\n      TcCls: kind constructor or promoted type constructor\n\n  The 'Promoted' field in an HsTyVar captures whether the type was promoted in\n  the source code by prefixing an apostrophe.\n\nNote [HsStarTy]\n~~~~~~~~~~~~~~~\nWhen the StarIsType extension is enabled, we want to treat '*' and its Unicode\nvariant identically to 'Data.Kind.Type'. Unfortunately, doing so in the parser\nwould mean that when we pretty-print it back, we don't know whether the user\nwrote '*' or 'Type', and lose the parse/ppr roundtrip property.\n\nAs a workaround, we parse '*' as HsStarTy (if it stands for 'Data.Kind.Type')\nand then desugar it to 'Data.Kind.Type' in the typechecker (see tc_hs_type).\nWhen '*' is a regular type operator (StarIsType is disabled), HsStarTy is not\ninvolved.\n\n\nNote [Promoted lists and tuples]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNotice the difference between\n   HsListTy    HsExplicitListTy\n   HsTupleTy   HsExplicitListTupleTy\n\nE.g.    f :: [Int]                      HsListTy\n\n        g3  :: T '[]                   All these use\n        g2  :: T '[True]                  HsExplicitListTy\n        g1  :: T '[True,False]\n        g1a :: T [True,False]             (can omit ' where unambiguous)\n\n  kind of T :: [Bool] -> *        This kind uses HsListTy!\n\nE.g.    h :: (Int,Bool)                 HsTupleTy; f is a pair\n        k :: S '(True,False)            HsExplicitTypleTy; S is indexed by\n                                           a type-level pair of booleans\n        kind of S :: (Bool,Bool) -> *   This kind uses HsExplicitTupleTy\n\nNote [Distinguishing tuple kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nApart from promotion, tuples can have one of three different kinds:\n\n        x :: (Int, Bool)                -- Regular boxed tuples\n        f :: Int# -> (# Int#, Int# #)   -- Unboxed tuples\n        g :: (Eq a, Ord a) => a         -- Constraint tuples\n\nFor convenience, internally we use a single constructor for all of these,\nnamely HsTupleTy, but keep track of the tuple kind (in the first argument to\nHsTupleTy, a HsTupleSort). We can tell if a tuple is unboxed while parsing,\nbecause of the #. However, with -XConstraintKinds we can only distinguish\nbetween constraint and boxed tuples during type checking, in general. Hence the\nfour constructors of HsTupleSort:\n\n        HsUnboxedTuple                  -> Produced by the parser\n        HsBoxedTuple                    -> Certainly a boxed tuple\n        HsConstraintTuple               -> Certainly a constraint tuple\n        HsBoxedOrConstraintTuple        -> Could be a boxed or a constraint\n                                        tuple. Produced by the parser only,\n                                        disappears after type checking\n-}\n\n-- | Haskell Tuple Sort\ndata HsTupleSort = HsUnboxedTuple\n                 | HsBoxedTuple\n                 | HsConstraintTuple\n                 | HsBoxedOrConstraintTuple\n                 deriving Data\n\n-- | Located Constructor Declaration Field\ntype LConDeclField pass = Located (ConDeclField pass)\n      -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when\n      --   in a list\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n\n-- | Constructor Declaration Field\ndata ConDeclField pass  -- Record fields have Haddoc docs on them\n  = ConDeclField { cd_fld_ext  :: XConDeclField pass,\n                   cd_fld_names :: [LFieldOcc pass],\n                                   -- ^ See Note [ConDeclField passs]\n                   cd_fld_type :: LBangType pass,\n                   cd_fld_doc  :: Maybe LHsDocString }\n      -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'\n\n      -- For details on above see note [Api annotations] in ApiAnnotation\n  | XConDeclField (XXConDeclField pass)\n\ntype instance XConDeclField  (GhcPass _) = NoExt\ntype instance XXConDeclField (GhcPass _) = NoExt\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (ConDeclField p) where\n  ppr (ConDeclField _ fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty\n  ppr (XConDeclField x) = ppr x\n\n-- HsConDetails is used for patterns/expressions *and* for data type\n-- declarations\n-- | Haskell Constructor Details\ndata HsConDetails arg rec\n  = PrefixCon [arg]             -- C p1 p2 p3\n  | RecCon    rec               -- C { x = p1, y = p2 }\n  | InfixCon  arg arg           -- p1 `C` p2\n  deriving Data\n\ninstance (Outputable arg, Outputable rec)\n         => Outputable (HsConDetails arg rec) where\n  ppr (PrefixCon args) = text \"PrefixCon\" <+> ppr args\n  ppr (RecCon rec)     = text \"RecCon:\" <+> ppr rec\n  ppr (InfixCon l r)   = text \"InfixCon:\" <+> ppr [l, r]\n\n{-\nNote [ConDeclField passs]\n~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA ConDeclField contains a list of field occurrences: these always\ninclude the field label as the user wrote it.  After the renamer, it\nwill additionally contain the identity of the selector function in the\nsecond component.\n\nDue to DuplicateRecordFields, the OccName of the selector function\nmay have been mangled, which is why we keep the original field label\nseparately.  For example, when DuplicateRecordFields is enabled\n\n    data T = MkT { x :: Int }\n\ngives\n\n    ConDeclField { cd_fld_names = [L _ (FieldOcc \"x\" $sel:x:MkT)], ... }.\n-}\n\n-----------------------\n-- A valid type must have a for-all at the top of the type, or of the fn arg\n-- types\n\n---------------------\nhsWcScopedTvs :: LHsSigWcType GhcRn -> [Name]\n-- Get the lexically-scoped type variables of a HsSigType\n--  - the explicitly-given forall'd type variables\n--  - the implicitly-bound kind variables\n--  - the named wildcars; see Note [Scoping of named wildcards]\n-- because they scope in the same way\nhsWcScopedTvs sig_ty\n  | HsWC { hswc_ext = nwcs, hswc_body = sig_ty1 }  <- sig_ty\n  , HsIB { hsib_ext = vars\n         , hsib_body = sig_ty2 } <- sig_ty1\n  = case sig_ty2 of\n      L _ (HsForAllTy { hst_bndrs = tvs }) -> vars ++ nwcs ++\n                                              hsLTyVarNames tvs\n               -- include kind variables only if the type is headed by forall\n               -- (this is consistent with GHC 7 behaviour)\n      _                                    -> nwcs\nhsWcScopedTvs (HsWC _ (XHsImplicitBndrs _)) = panic \"hsWcScopedTvs\"\nhsWcScopedTvs (XHsWildCardBndrs _) = panic \"hsWcScopedTvs\"\n\nhsScopedTvs :: LHsSigType GhcRn -> [Name]\n-- Same as hsWcScopedTvs, but for a LHsSigType\nhsScopedTvs sig_ty\n  | HsIB { hsib_ext = vars\n         , hsib_body = sig_ty2 } <- sig_ty\n  , L _ (HsForAllTy { hst_bndrs = tvs }) <- sig_ty2\n  = vars ++ hsLTyVarNames tvs\n  | otherwise\n  = []\n\n{- Note [Scoping of named wildcards]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  f :: _a -> _a\n  f x = let g :: _a -> _a\n            g = ...\n        in ...\n\nCurrently, for better or worse, the \"_a\" variables are all the same. So\nalthough there is no explicit forall, the \"_a\" scopes over the definition.\nI don't know if this is a good idea, but there it is.\n-}\n\n---------------------\nhsTyVarName :: HsTyVarBndr pass -> IdP pass\nhsTyVarName (UserTyVar _ (L _ n))     = n\nhsTyVarName (KindedTyVar _ (L _ n) _) = n\nhsTyVarName (XTyVarBndr{}) = panic \"hsTyVarName\"\n\nhsLTyVarName :: LHsTyVarBndr pass -> IdP pass\nhsLTyVarName = hsTyVarName . unLoc\n\nhsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass]\nhsLTyVarNames = map hsLTyVarName\n\nhsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass]\n-- Explicit variables only\nhsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)\n\nhsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]\n-- All variables\nhsAllLTyVarNames (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kvs }\n                         , hsq_explicit = tvs })\n  = kvs ++ hsLTyVarNames tvs\nhsAllLTyVarNames (XLHsQTyVars _) = panic \"hsAllLTyVarNames\"\n\nhsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)\nhsLTyVarLocName = onHasSrcSpan hsTyVarName\n\nhsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)]\nhsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)\n\n-- | Convert a LHsTyVarBndr to an equivalent LHsType.\nhsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p)\nhsLTyVarBndrToType = onHasSrcSpan cvt\n  where cvt (UserTyVar _ n) = HsTyVar noExt NotPromoted n\n        cvt (KindedTyVar _ (L name_loc n) kind)\n          = HsKindSig noExt\n                   (L name_loc (HsTyVar noExt NotPromoted (L name_loc n))) kind\n        cvt (XTyVarBndr{}) = panic \"hsLTyVarBndrToType\"\n\n-- | Convert a LHsTyVarBndrs to a list of types.\n-- Works on *type* variable only, no kind vars.\nhsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]\nhsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs\nhsLTyVarBndrsToTypes (XLHsQTyVars _) = panic \"hsLTyVarBndrsToTypes\"\n\n---------------------\nignoreParens :: LHsType pass -> LHsType pass\nignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty\nignoreParens ty                   = ty\n\nisLHsForAllTy :: LHsType p -> Bool\nisLHsForAllTy (L _ (HsForAllTy {})) = True\nisLHsForAllTy _                     = False\n\n{-\n************************************************************************\n*                                                                      *\n                Building types\n*                                                                      *\n************************************************************************\n-}\n\nmkAnonWildCardTy :: HsType GhcPs\nmkAnonWildCardTy = HsWildCardTy noExt\n\nmkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p))\n         -> LHsType (GhcPass p) -> HsType (GhcPass p)\nmkHsOpTy ty1 op ty2 = HsOpTy noExt ty1 op ty2\n\nmkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)\nmkHsAppTy t1 t2\n  = addCLoc t1 t2 (HsAppTy noExt t1 (parenthesizeHsType appPrec t2))\n\nmkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]\n           -> LHsType (GhcPass p)\nmkHsAppTys = foldl' mkHsAppTy\n\nmkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)\n              -> LHsType (GhcPass p)\nmkHsAppKindTy ext ty k\n  = addCLoc ty k (HsAppKindTy ext ty k)\n\n{-\n************************************************************************\n*                                                                      *\n                Decomposing HsTypes\n*                                                                      *\n************************************************************************\n-}\n\n---------------------------------\n-- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)\n-- Breaks up any parens in the result type:\n--      splitHsFunType (a -> (b -> c)) = ([a,b], c)\n-- Also deals with (->) t1 t2; that is why it only works on LHsType Name\n--   (see Trac #9096)\nsplitHsFunType :: LHsType GhcRn -> ([LHsType GhcRn], LHsType GhcRn)\nsplitHsFunType (L _ (HsParTy _ ty))\n  = splitHsFunType ty\n\nsplitHsFunType (L _ (HsFunTy _ x y))\n  | (args, res) <- splitHsFunType y\n  = (x:args, res)\n{- This is not so correct, because it won't work with visible kind app, in case\n  someone wants to write '(->) @k1 @k2 t1 t2'. Fixing this would require changing\n  ConDeclGADT abstract syntax -}\nsplitHsFunType orig_ty@(L _ (HsAppTy _ t1 t2))\n  = go t1 [t2]\n  where  -- Look for (->) t1 t2, possibly with parenthesisation\n    go (L _ (HsTyVar _ _ (L _ fn))) tys | fn == funTyConName\n                                 , [t1,t2] <- tys\n                                 , (args, res) <- splitHsFunType t2\n                                 = (t1:args, res)\n    go (L _ (HsAppTy _ t1 t2)) tys = go t1 (t2:tys)\n    go (L _ (HsParTy _ ty))    tys = go ty tys\n    go _                       _   = ([], orig_ty)  -- Failure to match\n\nsplitHsFunType other = ([], other)\n\n-- retrieve the name of the \"head\" of a nested type application\n-- somewhat like splitHsAppTys, but a little more thorough\n-- used to examine the result of a GADT-like datacon, so it doesn't handle\n-- *all* cases (like lists, tuples, (~), etc.)\nhsTyGetAppHead_maybe :: LHsType (GhcPass p)\n                     -> Maybe (Located (IdP (GhcPass p)))\nhsTyGetAppHead_maybe = go\n  where\n    go (L _ (HsTyVar _ _ ln))          = Just ln\n    go (L _ (HsAppTy _ l _))           = go l\n    go (L _ (HsAppKindTy _ t _))       = go t\n    go (L _ (HsOpTy _ _ (L loc n) _))  = Just (L loc n)\n    go (L _ (HsParTy _ t))             = go t\n    go (L _ (HsKindSig _ t _))         = go t\n    go _                               = Nothing\n\n------------------------------------------------------------\n-- Arguments in an expression/type after splitting\ndata HsArg tm ty\n  = HsValArg tm   -- Argument is an ordinary expression     (f arg)\n  | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty)\n                         -- SrcSpan is location of the `@`\n  | HsArgPar SrcSpan -- See Note [HsArgPar]\n\nnumVisibleArgs :: [HsArg tm ty] -> Arity\nnumVisibleArgs = count is_vis\n  where is_vis (HsValArg _) = True\n        is_vis _            = False\n\n-- type level equivalent\ntype LHsTypeArg p = HsArg (LHsType p) (LHsKind p)\n\ninstance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where\n  ppr (HsValArg tm)    = ppr tm\n  ppr (HsTypeArg _ ty) = char '@' <> ppr ty\n  ppr (HsArgPar sp)    = text \"HsArgPar\"  <+> ppr sp\n{-\nNote [HsArgPar]\nA HsArgPar indicates that everything to the left of this in the argument list is\nenclosed in parentheses together with the function itself. It is necessary so\nthat we can recreate the parenthesis structure in the original source after\ntypechecking the arguments.\n\nThe SrcSpan is the span of the original HsPar\n\n((f arg1) arg2 arg3) results in an input argument list of\n[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2]\n\n-}\n\n--------------------------------\n\n-- | Decompose a pattern synonym type signature into its constituent parts.\n--\n-- Note that this function looks through parentheses, so it will work on types\n-- such as @(forall a. <...>)@. The downside to this is that it is not\n-- generally possible to take the returned types and reconstruct the original\n-- type (parentheses and all) from them.\nsplitLHsPatSynTy :: LHsType pass\n                 -> ( [LHsTyVarBndr pass]    -- universals\n                    , LHsContext pass        -- required constraints\n                    , [LHsTyVarBndr pass]    -- existentials\n                    , LHsContext pass        -- provided constraints\n                    , LHsType pass)          -- body type\nsplitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)\n  where\n    (univs, ty1) = splitLHsForAllTyInvis ty\n    (reqs,  ty2) = splitLHsQualTy ty1\n    (exis,  ty3) = splitLHsForAllTyInvis ty2\n    (provs, ty4) = splitLHsQualTy ty3\n\n-- | Decompose a sigma type (of the form @forall <tvs>. context => body@)\n-- into its constituent parts.\n--\n-- Note that this function looks through parentheses, so it will work on types\n-- such as @(forall a. <...>)@. The downside to this is that it is not\n-- generally possible to take the returned types and reconstruct the original\n-- type (parentheses and all) from them.\nsplitLHsSigmaTy :: LHsType pass\n                -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)\nsplitLHsSigmaTy ty\n  | (tvs, ty1)  <- splitLHsForAllTy ty\n  , (ctxt, ty2) <- splitLHsQualTy ty1\n  = (tvs, ctxt, ty2)\n\n-- | Like 'splitLHsSigmaTy', but only splits type variable binders that were\n-- quantified invisibly (e.g., @forall a.@, with a dot).\n--\n-- This function is used to split apart certain types, such as instance\n-- declaration types, which disallow visible @forall@s. For instance, if GHC\n-- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that\n-- declaration would mistakenly be accepted!\n--\n-- Note that this function looks through parentheses, so it will work on types\n-- such as @(forall a. <...>)@. The downside to this is that it is not\n-- generally possible to take the returned types and reconstruct the original\n-- type (parentheses and all) from them.\nsplitLHsSigmaTyInvis :: LHsType pass\n                     -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)\nsplitLHsSigmaTyInvis ty\n  | (tvs,  ty1) <- splitLHsForAllTyInvis ty\n  , (ctxt, ty2) <- splitLHsQualTy ty1\n  = (tvs, ctxt, ty2)\n\n-- | Decompose a type of the form @forall <tvs>. body@) into its constituent\n-- parts.\n--\n-- Note that this function looks through parentheses, so it will work on types\n-- such as @(forall a. <...>)@. The downside to this is that it is not\n-- generally possible to take the returned types and reconstruct the original\n-- type (parentheses and all) from them.\nsplitLHsForAllTy :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)\nsplitLHsForAllTy (L _ (HsParTy _ ty)) = splitLHsForAllTy ty\nsplitLHsForAllTy (L _ (HsForAllTy { hst_bndrs = tvs, hst_body = body })) = (tvs, body)\nsplitLHsForAllTy body              = ([], body)\n\n-- | Like 'splitLHsForAllTy', but only splits type variable binders that\n-- were quantified invisibly (e.g., @forall a.@, with a dot).\n--\n-- This function is used to split apart certain types, such as instance\n-- declaration types, which disallow visible @forall@s. For instance, if GHC\n-- split apart the @forall@ in @instance forall a -> Show (Blah a)@, then that\n-- declaration would mistakenly be accepted!\n--\n-- Note that this function looks through parentheses, so it will work on types\n-- such as @(forall a. <...>)@. The downside to this is that it is not\n-- generally possible to take the returned types and reconstruct the original\n-- type (parentheses and all) from them.\nsplitLHsForAllTyInvis :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)\nsplitLHsForAllTyInvis lty@(L _ ty) =\n  case ty of\n    HsParTy _ ty' -> splitLHsForAllTyInvis ty'\n    HsForAllTy { hst_fvf = fvf', hst_bndrs = tvs', hst_body = body' }\n      |  fvf' == ForallInvis\n      -> (tvs', body')\n    _ -> ([], lty)\n\n-- | Decompose a type of the form @context => body@ into its constituent parts.\n--\n-- Note that this function looks through parentheses, so it will work on types\n-- such as @(context => <...>)@. The downside to this is that it is not\n-- generally possible to take the returned types and reconstruct the original\n-- type (parentheses and all) from them.\nsplitLHsQualTy :: LHsType pass -> (LHsContext pass, LHsType pass)\nsplitLHsQualTy (L _ (HsParTy _ ty)) = splitLHsQualTy ty\nsplitLHsQualTy (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body })) = (ctxt,     body)\nsplitLHsQualTy body              = (noLHsContext, body)\n\n-- | Decompose a type class instance type (of the form\n-- @forall <tvs>. context => instance_head@) into its constituent parts.\n--\n-- Note that this function looks through parentheses, so it will work on types\n-- such as @(forall <tvs>. <...>)@. The downside to this is that it is not\n-- generally possible to take the returned types and reconstruct the original\n-- type (parentheses and all) from them.\nsplitLHsInstDeclTy :: LHsSigType GhcRn\n                   -> ([Name], LHsContext GhcRn, LHsType GhcRn)\n-- Split up an instance decl type, returning the pieces\nsplitLHsInstDeclTy (HsIB { hsib_ext = itkvs\n                         , hsib_body = inst_ty })\n  | (tvs, cxt, body_ty) <- splitLHsSigmaTyInvis inst_ty\n  = (itkvs ++ hsLTyVarNames tvs, cxt, body_ty)\n         -- Return implicitly bound type and kind vars\n         -- For an instance decl, all of them are in scope\nsplitLHsInstDeclTy (XHsImplicitBndrs _) = panic \"splitLHsInstDeclTy\"\n\ngetLHsInstDeclHead :: LHsSigType pass -> LHsType pass\ngetLHsInstDeclHead inst_ty\n  | (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty)\n  = body_ty\n\ngetLHsInstDeclClass_maybe :: LHsSigType (GhcPass p)\n                          -> Maybe (Located (IdP (GhcPass p)))\n-- Works on (HsSigType RdrName)\ngetLHsInstDeclClass_maybe inst_ty\n  = do { let head_ty = getLHsInstDeclHead inst_ty\n       ; cls <- hsTyGetAppHead_maybe head_ty\n       ; return cls }\n\n{-\n************************************************************************\n*                                                                      *\n                FieldOcc\n*                                                                      *\n************************************************************************\n-}\n\n-- | Located Field Occurrence\ntype LFieldOcc pass = Located (FieldOcc pass)\n\n-- | Field Occurrence\n--\n-- Represents an *occurrence* of an unambiguous field.  We store\n-- both the 'RdrName' the user originally wrote, and after the\n-- renamer, the selector function.\ndata FieldOcc pass = FieldOcc { extFieldOcc     :: XCFieldOcc pass\n                              , rdrNameFieldOcc :: Located RdrName\n                                 -- ^ See Note [Located RdrNames] in HsExpr\n                              }\n\n  | XFieldOcc\n      (XXFieldOcc pass)\nderiving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq  (FieldOcc p)\nderiving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p)\n\ntype instance XCFieldOcc GhcPs = NoExt\ntype instance XCFieldOcc GhcRn = Name\ntype instance XCFieldOcc GhcTc = Id\n\ntype instance XXFieldOcc (GhcPass _) = NoExt\n\ninstance Outputable (FieldOcc pass) where\n  ppr = ppr . rdrNameFieldOcc\n\nmkFieldOcc :: Located RdrName -> FieldOcc GhcPs\nmkFieldOcc rdr = FieldOcc noExt rdr\n\n\n-- | Ambiguous Field Occurrence\n--\n-- Represents an *occurrence* of a field that is potentially\n-- ambiguous after the renamer, with the ambiguity resolved by the\n-- typechecker.  We always store the 'RdrName' that the user\n-- originally wrote, and store the selector function after the renamer\n-- (for unambiguous occurrences) or the typechecker (for ambiguous\n-- occurrences).\n--\n-- See Note [HsRecField and HsRecUpdField] in HsPat and\n-- Note [Disambiguating record fields] in TcExpr.\n-- See Note [Located RdrNames] in HsExpr\ndata AmbiguousFieldOcc pass\n  = Unambiguous (XUnambiguous pass) (Located RdrName)\n  | Ambiguous   (XAmbiguous pass)   (Located RdrName)\n  | XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass)\n\ntype instance XUnambiguous GhcPs = NoExt\ntype instance XUnambiguous GhcRn = Name\ntype instance XUnambiguous GhcTc = Id\n\ntype instance XAmbiguous GhcPs = NoExt\ntype instance XAmbiguous GhcRn = NoExt\ntype instance XAmbiguous GhcTc = Id\n\ntype instance XXAmbiguousFieldOcc (GhcPass _) = NoExt\n\ninstance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where\n  ppr = ppr . rdrNameAmbiguousFieldOcc\n\ninstance p ~ GhcPass pass => OutputableBndr (AmbiguousFieldOcc p) where\n  pprInfixOcc  = pprInfixOcc . rdrNameAmbiguousFieldOcc\n  pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc\n\nmkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs\nmkAmbiguousFieldOcc rdr = Unambiguous noExt rdr\n\nrdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName\nrdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr\nrdrNameAmbiguousFieldOcc (Ambiguous   _ (L _ rdr)) = rdr\nrdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc _)\n  = panic \"rdrNameAmbiguousFieldOcc\"\n\nselectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id\nselectorAmbiguousFieldOcc (Unambiguous sel _) = sel\nselectorAmbiguousFieldOcc (Ambiguous   sel _) = sel\nselectorAmbiguousFieldOcc (XAmbiguousFieldOcc _)\n  = panic \"selectorAmbiguousFieldOcc\"\n\nunambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc\nunambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel\nunambiguousFieldOcc (Ambiguous   rdr sel) = FieldOcc rdr sel\nunambiguousFieldOcc (XAmbiguousFieldOcc _) = panic \"unambiguousFieldOcc\"\n\nambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc\nambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr\nambiguousFieldOcc (XFieldOcc _) = panic \"ambiguousFieldOcc\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Pretty printing}\n*                                                                      *\n************************************************************************\n-}\n\ninstance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsType p) where\n    ppr ty = pprHsType ty\n\ninstance Outputable HsTyLit where\n    ppr = ppr_tylit\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (LHsQTyVars p) where\n    ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs\n    ppr (XLHsQTyVars x) = ppr x\n\ninstance (p ~ GhcPass pass, OutputableBndrId p)\n       => Outputable (HsTyVarBndr p) where\n    ppr (UserTyVar _ n)     = ppr n\n    ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]\n    ppr (XTyVarBndr n)      = ppr n\n\ninstance (p ~ GhcPass pass,Outputable thing)\n       => Outputable (HsImplicitBndrs p thing) where\n    ppr (HsIB { hsib_body = ty }) = ppr ty\n    ppr (XHsImplicitBndrs x) = ppr x\n\ninstance (p ~ GhcPass pass,Outputable thing)\n       => Outputable (HsWildCardBndrs p thing) where\n    ppr (HsWC { hswc_body = ty }) = ppr ty\n    ppr (XHsWildCardBndrs x) = ppr x\n\npprAnonWildCard :: SDoc\npprAnonWildCard = char '_'\n\n-- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@\n-- only when @-dppr-debug@ is enabled.\npprHsForAll :: (OutputableBndrId (GhcPass p))\n            => ForallVisFlag -> [LHsTyVarBndr (GhcPass p)]\n            -> LHsContext (GhcPass p) -> SDoc\npprHsForAll = pprHsForAllExtra Nothing\n\n-- | Version of 'pprHsForAll' that can also print an extra-constraints\n-- wildcard, e.g. @_ => a -> Bool@ or @(Show a, _) => a -> String@. This\n-- underscore will be printed when the 'Maybe SrcSpan' argument is a 'Just'\n-- containing the location of the extra-constraints wildcard. A special\n-- function for this is needed, as the extra-constraints wildcard is removed\n-- from the actual context and type, and stored in a separate field, thus just\n-- printing the type will not print the extra-constraints wildcard.\npprHsForAllExtra :: (OutputableBndrId (GhcPass p))\n                 => Maybe SrcSpan -> ForallVisFlag\n                 -> [LHsTyVarBndr (GhcPass p)]\n                 -> LHsContext (GhcPass p) -> SDoc\npprHsForAllExtra extra fvf qtvs cxt\n  = pp_forall <+> pprLHsContextExtra (isJust extra) cxt\n  where\n    pp_forall | null qtvs = whenPprDebug (forAllLit <> separator)\n              | otherwise = forAllLit <+> interppSP qtvs <> separator\n\n    separator = ppr_forall_separator fvf\n\n-- | Version of 'pprHsForAll' or 'pprHsForAllExtra' that will always print\n-- @forall.@ when passed @Just []@. Prints nothing if passed 'Nothing'\npprHsExplicitForAll :: (OutputableBndrId (GhcPass p))\n                    => ForallVisFlag\n                    -> Maybe [LHsTyVarBndr (GhcPass p)] -> SDoc\npprHsExplicitForAll fvf (Just qtvs) = forAllLit <+> interppSP qtvs\n                                                 <> ppr_forall_separator fvf\npprHsExplicitForAll _   Nothing     = empty\n\n-- | Prints an arrow for visible @forall@s (e.g., @forall a ->@) and a dot for\n-- invisible @forall@s (e.g., @forall a.@).\nppr_forall_separator :: ForallVisFlag -> SDoc\nppr_forall_separator ForallVis   = space <> arrow\nppr_forall_separator ForallInvis = dot\n\npprLHsContext :: (OutputableBndrId (GhcPass p))\n              => LHsContext (GhcPass p) -> SDoc\npprLHsContext lctxt\n  | null (unLoc lctxt) = empty\n  | otherwise          = pprLHsContextAlways lctxt\n\n-- For use in a HsQualTy, which always gets printed if it exists.\npprLHsContextAlways :: (OutputableBndrId (GhcPass p))\n                    => LHsContext (GhcPass p) -> SDoc\npprLHsContextAlways (L _ ctxt)\n  = case ctxt of\n      []       -> parens empty             <+> darrow\n      [L _ ty] -> ppr_mono_ty ty           <+> darrow\n      _        -> parens (interpp'SP ctxt) <+> darrow\n\n-- True <=> print an extra-constraints wildcard, e.g. @(Show a, _) =>@\npprLHsContextExtra :: (OutputableBndrId (GhcPass p))\n                   => Bool -> LHsContext (GhcPass p) -> SDoc\npprLHsContextExtra show_extra lctxt@(L _ ctxt)\n  | not show_extra = pprLHsContext lctxt\n  | null ctxt      = char '_' <+> darrow\n  | otherwise      = parens (sep (punctuate comma ctxt')) <+> darrow\n  where\n    ctxt' = map ppr ctxt ++ [char '_']\n\npprConDeclFields :: (OutputableBndrId (GhcPass p))\n                 => [LConDeclField (GhcPass p)] -> SDoc\npprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))\n  where\n    ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty,\n                                 cd_fld_doc = doc }))\n        = ppr_names ns <+> dcolon <+> ppr ty <+> ppr_mbDoc doc\n    ppr_fld (L _ (XConDeclField x)) = ppr x\n    ppr_names [n] = ppr n\n    ppr_names ns = sep (punctuate comma (map ppr ns))\n\n{-\nNote [Printing KindedTyVars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTrac #3830 reminded me that we should really only print the kind\nsignature on a KindedTyVar if the kind signature was put there by the\nprogrammer.  During kind inference GHC now adds a PostTcKind to UserTyVars,\nrather than converting to KindedTyVars as before.\n\n(As it happens, the message in #3830 comes out a different way now,\nand the problem doesn't show up; but having the flag on a KindedTyVar\nseems like the Right Thing anyway.)\n-}\n\n-- Printing works more-or-less as for Types\n\npprHsType :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc\npprHsType ty = ppr_mono_ty ty\n\nppr_mono_lty :: (OutputableBndrId (GhcPass p)) => LHsType (GhcPass p) -> SDoc\nppr_mono_lty ty = ppr_mono_ty (unLoc ty)\n\nppr_mono_ty :: (OutputableBndrId (GhcPass p)) => HsType (GhcPass p) -> SDoc\nppr_mono_ty (HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs, hst_body = ty })\n  = sep [pprHsForAll fvf tvs noLHsContext, ppr_mono_lty ty]\n\nppr_mono_ty (HsQualTy { hst_ctxt = ctxt, hst_body = ty })\n  = sep [pprLHsContextAlways ctxt, ppr_mono_lty ty]\n\nppr_mono_ty (HsBangTy _ b ty)   = ppr b <> ppr_mono_lty ty\nppr_mono_ty (HsRecTy _ flds)      = pprConDeclFields flds\nppr_mono_ty (HsTyVar _ prom (L _ name))\n  | isPromoted prom = quote (pprPrefixOcc name)\n  | otherwise       = pprPrefixOcc name\nppr_mono_ty (HsFunTy _ ty1 ty2)   = ppr_fun_ty ty1 ty2\nppr_mono_ty (HsTupleTy _ con tys) = tupleParens std_con (pprWithCommas ppr tys)\n  where std_con = case con of\n                    HsUnboxedTuple -> UnboxedTuple\n                    _              -> BoxedTuple\nppr_mono_ty (HsSumTy _ tys)\n  = tupleParens UnboxedTuple (pprWithBars ppr tys)\nppr_mono_ty (HsKindSig _ ty kind)\n  = ppr_mono_lty ty <+> dcolon <+> ppr kind\nppr_mono_ty (HsListTy _ ty)       = brackets (ppr_mono_lty ty)\nppr_mono_ty (HsIParamTy _ n ty)   = (ppr n <+> dcolon <+> ppr_mono_lty ty)\nppr_mono_ty (HsSpliceTy _ s)      = pprSplice s\nppr_mono_ty (HsExplicitListTy _ prom tys)\n  | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys)\n  | otherwise       = brackets (interpp'SP tys)\nppr_mono_ty (HsExplicitTupleTy _ tys)\n  = quote $ parens (maybeAddSpace tys $ interpp'SP tys)\nppr_mono_ty (HsTyLit _ t)       = ppr_tylit t\nppr_mono_ty (HsWildCardTy {})   = char '_'\n\nppr_mono_ty (HsStarTy _ isUni)  = char (if isUni then '\u00e2\u02dc\u2026' else '*')\n\nppr_mono_ty (HsAppTy _ fun_ty arg_ty)\n  = hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]\nppr_mono_ty (HsAppKindTy _ ty k)\n  = ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k\nppr_mono_ty (HsOpTy _ ty1 (L _ op) ty2)\n  = sep [ ppr_mono_lty ty1\n        , sep [pprInfixOcc op, ppr_mono_lty ty2 ] ]\n\nppr_mono_ty (HsParTy _ ty)\n  = parens (ppr_mono_lty ty)\n  -- Put the parens in where the user did\n  -- But we still use the precedence stuff to add parens because\n  --    toHsType doesn't put in any HsParTys, so we may still need them\n\nppr_mono_ty (HsDocTy _ ty doc)\n  -- AZ: Should we add parens?  Should we introduce \"-- ^\"?\n  = ppr_mono_lty ty <+> ppr (unLoc doc)\n  -- we pretty print Haddock comments on types as if they were\n  -- postfix operators\n\nppr_mono_ty (XHsType t) = ppr t\n\n--------------------------\nppr_fun_ty :: (OutputableBndrId (GhcPass p))\n           => LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc\nppr_fun_ty ty1 ty2\n  = let p1 = ppr_mono_lty ty1\n        p2 = ppr_mono_lty ty2\n    in\n    sep [p1, arrow <+> p2]\n\n--------------------------\nppr_tylit :: HsTyLit -> SDoc\nppr_tylit (HsNumTy _ i) = integer i\nppr_tylit (HsStrTy _ s) = text (show s)\n\n\n-- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses\n-- under precedence @p@.\nhsTypeNeedsParens :: PprPrec -> HsType pass -> Bool\nhsTypeNeedsParens p = go\n  where\n    go (HsForAllTy{})        = p >= funPrec\n    go (HsQualTy{})          = p >= funPrec\n    go (HsBangTy{})          = p > topPrec\n    go (HsRecTy{})           = False\n    go (HsTyVar{})           = False\n    go (HsFunTy{})           = p >= funPrec\n    go (HsTupleTy{})         = False\n    go (HsSumTy{})           = False\n    go (HsKindSig{})         = p >= sigPrec\n    go (HsListTy{})          = False\n    go (HsIParamTy{})        = p > topPrec\n    go (HsSpliceTy{})        = False\n    go (HsExplicitListTy{})  = False\n    go (HsExplicitTupleTy{}) = False\n    go (HsTyLit{})           = False\n    go (HsWildCardTy{})      = False\n    go (HsStarTy{})          = False\n    go (HsAppTy{})           = p >= appPrec\n    go (HsAppKindTy{})       = p >= appPrec\n    go (HsOpTy{})            = p >= opPrec\n    go (HsParTy{})           = False\n    go (HsDocTy _ (L _ t) _) = go t\n    go (XHsType{})           = False\n\nmaybeAddSpace :: [LHsType pass] -> SDoc -> SDoc\n-- See Note [Printing promoted type constructors]\n-- in IfaceType.  This code implements the same\n-- logic for printing HsType\nmaybeAddSpace tys doc\n  | (ty : _) <- tys\n  , lhsTypeHasLeadingPromotionQuote ty = space <> doc\n  | otherwise                          = doc\n\nlhsTypeHasLeadingPromotionQuote :: LHsType pass -> Bool\nlhsTypeHasLeadingPromotionQuote ty\n  = goL ty\n  where\n    goL (L _ ty) = go ty\n\n    go (HsForAllTy{})        = False\n    go (HsQualTy{ hst_ctxt = ctxt, hst_body = body})\n      | L _ (c:_) <- ctxt    = goL c\n      | otherwise            = goL body\n    go (HsBangTy{})          = False\n    go (HsRecTy{})           = False\n    go (HsTyVar _ p _)       = isPromoted p\n    go (HsFunTy _ arg _)     = goL arg\n    go (HsListTy{})          = False\n    go (HsTupleTy{})         = False\n    go (HsSumTy{})           = False\n    go (HsOpTy _ t1 _ _)     = goL t1\n    go (HsKindSig _ t _)     = goL t\n    go (HsIParamTy{})        = False\n    go (HsSpliceTy{})        = False\n    go (HsExplicitListTy _ p _) = isPromoted p\n    go (HsExplicitTupleTy{}) = True\n    go (HsTyLit{})           = False\n    go (HsWildCardTy{})      = False\n    go (HsStarTy{})          = False\n    go (HsAppTy _ t _)       = goL t\n    go (HsAppKindTy _ t _)   = goL t\n    go (HsParTy{})           = False\n    go (HsDocTy _ t _)       = goL t\n    go (XHsType{})           = False\n\n-- | @'parenthesizeHsType' p ty@ checks if @'hsTypeNeedsParens' p ty@ is\n-- true, and if so, surrounds @ty@ with an 'HsParTy'. Otherwise, it simply\n-- returns @ty@.\nparenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)\nparenthesizeHsType p lty@(L loc ty)\n  | hsTypeNeedsParens p ty = L loc (HsParTy NoExt lty)\n  | otherwise              = lty\n\n-- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint\n-- @c@ such that @'hsTypeNeedsParens' p c@ is true, and if so, surrounds @c@\n-- with an 'HsParTy' to form a parenthesized @ctxt@. Otherwise, it simply\n-- returns @ctxt@ unchanged.\nparenthesizeHsContext :: PprPrec\n                      -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)\nparenthesizeHsContext p lctxt@(L loc ctxt) =\n  case ctxt of\n    [c] -> L loc [parenthesizeHsType p c]\n    _   -> lctxt -- Other contexts are already \"parenthesized\" by virtue of\n                 -- being tuples.\n", "num_lines": 1672}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow, 1992-2006\n\n\nHere we collect a variety of helper functions that construct or\nanalyse HsSyn.  All these functions deal with generic HsSyn; functions\nwhich deal with the instantiated versions are located elsewhere:\n\n   Parameterised by          Module\n   ----------------          -------------\n   GhcPs/RdrName             parser/RdrHsSyn\n   GhcRn/Name                rename/RnHsSyn\n   GhcTc/Id                  typecheck/TcHsSyn\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule HsUtils(\n  -- Terms\n  mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypes, mkHsCaseAlt,\n  mkSimpleMatch, unguardedGRHSs, unguardedRHS,\n  mkMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf,\n  mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo,\n  mkHsDictLet, mkHsLams,\n  mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo,\n  mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap,\n  mkHsCmdIf,\n\n  nlHsTyApp, nlHsTyApps, nlHsVar, nlHsDataCon,\n  nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps,\n  nlHsIntLit, nlHsVarApps,\n  nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,\n  mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,\n  typeToLHsType,\n\n  -- * Constructing general big tuples\n  -- $big_tuples\n  mkChunkified, chunkify,\n\n  -- Bindings\n  mkFunBind, mkVarBind, mkHsVarBind, mk_easy_FunBind, mkTopFunBind,\n  mkPatSynBind,\n  isInfixFunBind,\n\n  -- Literals\n  mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString, mkHsStringPrimLit,\n\n  -- Patterns\n  mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConVarPatName, nlConPat,\n  nlConPatName, nlInfixConPat, nlNullaryConPat, nlWildConPat, nlWildPat,\n  nlWildPatName, nlTuplePat, mkParPat, nlParPat,\n  mkBigLHsVarTup, mkBigLHsTup, mkBigLHsVarPatTup, mkBigLHsPatTup,\n\n  -- Types\n  mkHsAppTy, mkHsAppKindTy, userHsTyVarBndrs, userHsLTyVarBndrs,\n  mkLHsSigType, mkLHsSigWcType, mkClassOpSigs, mkHsSigEnv,\n  nlHsAppTy, nlHsAppKindTy, nlHsTyVar, nlHsFunTy, nlHsParTy, nlHsTyConApp,\n\n  -- Stmts\n  mkTransformStmt, mkTransformByStmt, mkBodyStmt, mkBindStmt, mkTcBindStmt,\n  mkLastStmt,\n  emptyTransStmt, mkGroupUsingStmt, mkGroupByUsingStmt,\n  emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,\n  unitRecStmtTc,\n\n  -- Template Haskell\n  mkUntypedSplice, mkTypedSplice,\n  mkHsQuasiQuote, unqualQuasiQuote,\n\n  -- Collecting binders\n  isUnliftedHsBind, isBangedHsBind,\n\n  collectLocalBinders, collectHsValBinders, collectHsBindListBinders,\n  collectHsIdBinders,\n  collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,\n  collectPatBinders, collectPatsBinders,\n  collectLStmtsBinders, collectStmtsBinders,\n  collectLStmtBinders, collectStmtBinders,\n\n  hsLTyClDeclBinders, hsTyClForeignBinders,\n  hsPatSynSelectors, getPatSynBinds,\n  hsForeignDeclsBinders, hsGroupBinders, hsDataFamInstBinders,\n\n  -- Collecting implicit binders\n  lStmtsImplicits, hsValBindsImplicits, lPatImplicits\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsDecls\nimport HsBinds\nimport HsExpr\nimport HsPat\nimport HsTypes\nimport HsLit\nimport PlaceHolder\nimport HsExtension\n\nimport TcEvidence\nimport RdrName\nimport Var\nimport TyCoRep\nimport Type   ( tyConArgFlags )\nimport TysWiredIn ( unitTy )\nimport TcType\nimport DataCon\nimport ConLike\nimport Id\nimport Name\nimport NameSet hiding ( unitFV )\nimport NameEnv\nimport BasicTypes\nimport SrcLoc\nimport FastString\nimport Util\nimport Bag\nimport Outputable\nimport Constants\n\nimport Data.Either\nimport Data.Function\nimport Data.List\n\n{-\n************************************************************************\n*                                                                      *\n        Some useful helpers for constructing syntax\n*                                                                      *\n************************************************************************\n\nThese functions attempt to construct a not-completely-useless SrcSpan\nfrom their components, compared with the nl* functions below which\njust attach noSrcSpan to everything.\n-}\n\nmkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\nmkHsPar e = cL (getLoc e) (HsPar noExt e)\n\nmkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))\n              -> [LPat (GhcPass p)] -> Located (body (GhcPass p))\n              -> LMatch (GhcPass p) (Located (body (GhcPass p)))\nmkSimpleMatch ctxt pats rhs\n  = cL loc $\n    Match { m_ext = noExt, m_ctxt = ctxt, m_pats = pats\n          , m_grhss = unguardedGRHSs rhs }\n  where\n    loc = case pats of\n                []      -> getLoc rhs\n                (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)\n\nunguardedGRHSs :: Located (body (GhcPass p))\n               -> GRHSs (GhcPass p) (Located (body (GhcPass p)))\nunguardedGRHSs rhs@(dL->L loc _)\n  = GRHSs noExt (unguardedRHS loc rhs) (noLoc emptyLocalBinds)\n\nunguardedRHS :: SrcSpan -> Located (body (GhcPass p))\n             -> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]\nunguardedRHS loc rhs = [cL loc (GRHS noExt [] rhs)]\n\nmkMatchGroup :: (XMG name (Located (body name)) ~ NoExt)\n             => Origin -> [LMatch name (Located (body name))]\n             -> MatchGroup name (Located (body name))\nmkMatchGroup origin matches = MG { mg_ext = noExt\n                                 , mg_alts = mkLocatedList matches\n                                 , mg_origin = origin }\n\nmkLocatedList ::  [Located a] -> Located [Located a]\nmkLocatedList [] = noLoc []\nmkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms\n\nmkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\nmkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)\n\nmkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn)\n            => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)\nmkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct)\n  where\n    t_body    = hswc_body t\n    paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }\n\nmkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn\nmkHsAppTypes = foldl' mkHsAppType\n\nmkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExt) =>\n  [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)\nmkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExt matches))\n  where\n    matches = mkMatchGroup Generated\n                           [mkSimpleMatch LambdaExpr pats' body]\n    pats' = map (parenthesizePat appPrec) pats\n\nmkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc\nmkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars\n                                       <.> mkWpLams dicts) expr\n\n-- |A simple case alternative with a single pattern, no binds, no guards;\n-- pre-typechecking\nmkHsCaseAlt :: LPat (GhcPass p) -> (Located (body (GhcPass p)))\n            -> LMatch (GhcPass p) (Located (body (GhcPass p)))\nmkHsCaseAlt pat expr\n  = mkSimpleMatch CaseAlt [pat] expr\n\nnlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)\nnlHsTyApp fun_id tys\n  = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id)))\n\nnlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]\n           -> LHsExpr (GhcPass id)\nnlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs\n\n--------- Adding parens ---------\nmkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\n-- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them\n-- So   'f x'  becomes '(f x)', but '3' stays as '3'\nmkLHsPar le@(dL->L loc e)\n  | hsExprNeedsParens appPrec e = cL loc (HsPar noExt le)\n  | otherwise                   = le\n\nmkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)\nmkParPat lp@(dL->L loc p)\n  | patNeedsParens appPrec p = cL loc (ParPat noExt lp)\n  | otherwise                = lp\n\nnlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)\nnlParPat p = noLoc (ParPat noExt p)\n\n-------------------------------\n-- These are the bits of syntax that contain rebindable names\n-- See RnEnv.lookupSyntaxName\n\nmkHsIntegral   :: IntegralLit -> HsOverLit GhcPs\nmkHsFractional :: FractionalLit -> HsOverLit GhcPs\nmkHsIsString   :: SourceText -> FastString -> HsOverLit GhcPs\nmkHsDo         :: HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs\nmkHsComp       :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs\n               -> HsExpr GhcPs\n\nmkNPat      :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs)\n            -> Pat GhcPs\nmkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs\n\nmkLastStmt :: Located (bodyR (GhcPass idR))\n           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))\nmkBodyStmt :: Located (bodyR GhcPs)\n           -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))\nmkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)\n                         (Located (bodyR (GhcPass idR))) ~ NoExt)\n           => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))\n           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))\nmkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)\n             -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))\n\nemptyRecStmt     :: StmtLR (GhcPass idL) GhcPs bodyR\nemptyRecStmtName :: StmtLR GhcRn GhcRn bodyR\nemptyRecStmtId   :: StmtLR GhcTc GhcTc bodyR\nmkRecStmt        :: [LStmtLR (GhcPass idL) GhcPs bodyR]\n                 -> StmtLR (GhcPass idL) GhcPs bodyR\n\n\nmkHsIntegral     i  = OverLit noExt (HsIntegral       i) noExpr\nmkHsFractional   f  = OverLit noExt (HsFractional     f) noExpr\nmkHsIsString src s  = OverLit noExt (HsIsString   src s) noExpr\n\nmkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts)\nmkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])\n  where\n    last_stmt = cL (getLoc expr) $ mkLastStmt expr\n\nmkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)\n       -> HsExpr (GhcPass p)\nmkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b\n\nmkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)\n       -> HsCmd (GhcPass p)\nmkHsCmdIf c a b = HsCmdIf noExt (Just noSyntaxExpr) c a b\n\nmkNPat lit neg     = NPat noExt lit neg noSyntaxExpr\nmkNPlusKPat id lit\n  = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr\n\nmkTransformStmt    :: [ExprLStmt GhcPs] -> LHsExpr GhcPs\n                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)\nmkTransformByStmt  :: [ExprLStmt GhcPs] -> LHsExpr GhcPs\n                   -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)\nmkGroupUsingStmt   :: [ExprLStmt GhcPs] -> LHsExpr GhcPs\n                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)\nmkGroupByUsingStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs\n                   -> LHsExpr GhcPs\n                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)\n\nemptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)\nemptyTransStmt = TransStmt { trS_ext = noExt\n                           , trS_form = panic \"emptyTransStmt: form\"\n                           , trS_stmts = [], trS_bndrs = []\n                           , trS_by = Nothing, trS_using = noLoc noExpr\n                           , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr\n                           , trS_fmap = noExpr }\nmkTransformStmt    ss u   = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u }\nmkTransformByStmt  ss u b = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u, trS_by = Just b }\nmkGroupUsingStmt   ss u   = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u }\nmkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b }\n\nmkLastStmt body = LastStmt noExt body False noSyntaxExpr\nmkBodyStmt body\n  = BodyStmt noExt body noSyntaxExpr noSyntaxExpr\nmkBindStmt pat body\n  = BindStmt noExt pat body noSyntaxExpr noSyntaxExpr\nmkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr\n  -- don't use placeHolderTypeTc above, because that panics during zonking\n\nemptyRecStmt' :: forall idL idR body.\n                 XRecStmt (GhcPass idL) (GhcPass idR) body\n              -> StmtLR (GhcPass idL) (GhcPass idR) body\nemptyRecStmt' tyVal =\n   RecStmt\n     { recS_stmts = [], recS_later_ids = []\n     , recS_rec_ids = []\n     , recS_ret_fn = noSyntaxExpr\n     , recS_mfix_fn = noSyntaxExpr\n     , recS_bind_fn = noSyntaxExpr\n     , recS_ext = tyVal }\n\nunitRecStmtTc :: RecStmtTc\nunitRecStmtTc = RecStmtTc { recS_bind_ty = unitTy\n                          , recS_later_rets = []\n                          , recS_rec_rets = []\n                          , recS_ret_ty = unitTy }\n\nemptyRecStmt     = emptyRecStmt' noExt\nemptyRecStmtName = emptyRecStmt' noExt\nemptyRecStmtId   = emptyRecStmt' unitRecStmtTc\n                                        -- a panic might trigger during zonking\nmkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }\n\n-------------------------------\n--- A useful function for building @OpApps@.  The operator is always a\n-- variable, and we don't know the fixity yet.\nmkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs\nmkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2\n\nunqualSplice :: RdrName\nunqualSplice = mkRdrUnqual (mkVarOccFS (fsLit \"splice\"))\n\nmkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs\nmkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e\n\nmkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs\nmkTypedSplice hasParen e = HsTypedSplice noExt hasParen unqualSplice e\n\nmkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs\nmkHsQuasiQuote quoter span quote\n  = HsQuasiQuote noExt unqualSplice quoter span quote\n\nunqualQuasiQuote :: RdrName\nunqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit \"quasiquote\"))\n                -- A name (uniquified later) to\n                -- identify the quasi-quote\n\nmkHsString :: String -> HsLit (GhcPass p)\nmkHsString s = HsString NoSourceText (mkFastString s)\n\nmkHsStringPrimLit :: FastString -> HsLit (GhcPass p)\nmkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs)\n\n-------------\nuserHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))]\n                  -> [LHsTyVarBndr (GhcPass p)]\n-- Caller sets location\nuserHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt v) | v <- bndrs ]\n\nuserHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)]\n-- Caller sets location\nuserHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v))\n                             | v <- bndrs ]\n\n\n{-\n************************************************************************\n*                                                                      *\n        Constructing syntax with no location info\n*                                                                      *\n************************************************************************\n-}\n\nnlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)\nnlHsVar n = noLoc (HsVar noExt (noLoc n))\n\n-- NB: Only for LHsExpr **Id**\nnlHsDataCon :: DataCon -> LHsExpr GhcTc\nnlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con))\n\nnlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)\nnlHsLit n = noLoc (HsLit noExt n)\n\nnlHsIntLit :: Integer -> LHsExpr (GhcPass p)\nnlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n)))\n\nnlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)\nnlVarPat n = noLoc (VarPat noExt (noLoc n))\n\nnlLitPat :: HsLit GhcPs -> LPat GhcPs\nnlLitPat l = noLoc (LitPat noExt l)\n\nnlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\nnlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x))\n\nnlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]\n               -> LHsExpr (GhcPass id)\nnlHsSyntaxApps (SyntaxExpr { syn_expr      = fun\n                           , syn_arg_wraps = arg_wraps\n                           , syn_res_wrap  = res_wrap }) args\n  | [] <- arg_wraps   -- in the noSyntaxExpr case\n  = ASSERT( isIdHsWrapper res_wrap )\n    foldl' nlHsApp (noLoc fun) args\n\n  | otherwise\n  = mkLHsWrap res_wrap (foldl' nlHsApp (noLoc fun) (zipWithEqual \"nlHsSyntaxApps\"\n                                                     mkLHsWrap arg_wraps args))\n\nnlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)\nnlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs\n\nnlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)\nnlHsVarApps f xs = noLoc (foldl' mk (HsVar noExt (noLoc f))\n                                               (map ((HsVar noExt) . noLoc) xs))\n                 where\n                   mk f a = HsApp noExt (noLoc f) (noLoc a)\n\nnlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs\nnlConVarPat con vars = nlConPat con (map nlVarPat vars)\n\nnlConVarPatName :: Name -> [Name] -> LPat GhcRn\nnlConVarPatName con vars = nlConPatName con (map nlVarPat vars)\n\nnlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs\nnlInfixConPat con l r = noLoc (ConPatIn (noLoc con)\n                              (InfixCon (parenthesizePat opPrec l)\n                                        (parenthesizePat opPrec r)))\n\nnlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs\nnlConPat con pats =\n  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))\n\nnlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn\nnlConPatName con pats =\n  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))\n\nnlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)\nnlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))\n\nnlWildConPat :: DataCon -> LPat GhcPs\nnlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))\n                         (PrefixCon (nOfThem (dataConSourceArity con)\n                                             nlWildPat)))\n\nnlWildPat :: LPat GhcPs\nnlWildPat  = noLoc (WildPat noExt )  -- Pre-typechecking\n\nnlWildPatName :: LPat GhcRn\nnlWildPatName  = noLoc (WildPat noExt )  -- Pre-typechecking\n\nnlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]\n       -> LHsExpr GhcPs\nnlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts)\n\nnlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs\nnlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)\n\nnlHsLam  :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs\nnlHsPar  :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\nnlHsIf   :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\n         -> LHsExpr (GhcPass id)\nnlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]\n         -> LHsExpr GhcPs\nnlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs\n\nnlHsLam match          = noLoc (HsLam noExt (mkMatchGroup Generated [match]))\nnlHsPar e              = noLoc (HsPar noExt e)\n\n-- Note [Rebindable nlHsIf]\n-- nlHsIf should generate if-expressions which are NOT subject to\n-- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)\nnlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false)\n\nnlHsCase expr matches\n  = noLoc (HsCase noExt expr (mkMatchGroup Generated matches))\nnlList exprs          = noLoc (ExplicitList noExt Nothing exprs)\n\nnlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)\nnlHsTyVar :: IdP (GhcPass p)                            -> LHsType (GhcPass p)\nnlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)\nnlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)\n\nnlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t))\nnlHsTyVar x   = noLoc (HsTyVar noExt NotPromoted (noLoc x))\nnlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) b)\nnlHsParTy t   = noLoc (HsParTy noExt t)\n\nnlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)\nnlHsTyConApp tycon tys  = foldl' nlHsAppTy (nlHsTyVar tycon) tys\n\nnlHsAppKindTy ::\n  LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)\nnlHsAppKindTy f k\n  = noLoc (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k))\n\n{-\nTuples.  All these functions are *pre-typechecker* because they lack\ntypes on the tuple.\n-}\n\nmkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)\n-- Makes a pre-typechecker boxed tuple, deals with 1 case\nmkLHsTupleExpr [e] = e\nmkLHsTupleExpr es\n  = noLoc $ ExplicitTuple noExt (map (noLoc . (Present noExt)) es) Boxed\n\nmkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)\nmkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)\n\nnlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs\nnlTuplePat pats box = noLoc (TuplePat noExt pats box)\n\nmissingTupArg :: HsTupArg GhcPs\nmissingTupArg = Missing noExt\n\nmkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn\nmkLHsPatTup []     = noLoc $ TuplePat noExt [] Boxed\nmkLHsPatTup [lpat] = lpat\nmkLHsPatTup lpats  = cL (getLoc (head lpats)) $ TuplePat noExt lpats Boxed\n\n-- The Big equivalents for the source tuple expressions\nmkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)\nmkBigLHsVarTup ids = mkBigLHsTup (map nlHsVar ids)\n\nmkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)\nmkBigLHsTup = mkChunkified mkLHsTupleExpr\n\n-- The Big equivalents for the source tuple patterns\nmkBigLHsVarPatTup :: [IdP GhcRn] -> LPat GhcRn\nmkBigLHsVarPatTup bs = mkBigLHsPatTup (map nlVarPat bs)\n\nmkBigLHsPatTup :: [LPat GhcRn] -> LPat GhcRn\nmkBigLHsPatTup = mkChunkified mkLHsPatTup\n\n-- $big_tuples\n-- #big_tuples#\n--\n-- GHCs built in tuples can only go up to 'mAX_TUPLE_SIZE' in arity, but\n-- we might concievably want to build such a massive tuple as part of the\n-- output of a desugaring stage (notably that for list comprehensions).\n--\n-- We call tuples above this size \\\"big tuples\\\", and emulate them by\n-- creating and pattern matching on >nested< tuples that are expressible\n-- by GHC.\n--\n-- Nesting policy: it's better to have a 2-tuple of 10-tuples (3 objects)\n-- than a 10-tuple of 2-tuples (11 objects), so we want the leaves of any\n-- construction to be big.\n--\n-- If you just use the 'mkBigCoreTup', 'mkBigCoreVarTupTy', 'mkTupleSelector'\n-- and 'mkTupleCase' functions to do all your work with tuples you should be\n-- fine, and not have to worry about the arity limitation at all.\n\n-- | Lifts a \\\"small\\\" constructor into a \\\"big\\\" constructor by recursive decompositon\nmkChunkified :: ([a] -> a)      -- ^ \\\"Small\\\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'\n             -> [a]             -- ^ Possible \\\"big\\\" list of things to construct from\n             -> a               -- ^ Constructed thing made possible by recursive decomposition\nmkChunkified small_tuple as = mk_big_tuple (chunkify as)\n  where\n        -- Each sub-list is short enough to fit in a tuple\n    mk_big_tuple [as] = small_tuple as\n    mk_big_tuple as_s = mk_big_tuple (chunkify (map small_tuple as_s))\n\nchunkify :: [a] -> [[a]]\n-- ^ Split a list into lists that are small enough to have a corresponding\n-- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE'\n-- But there may be more than 'mAX_TUPLE_SIZE' sub-lists\nchunkify xs\n  | n_xs <= mAX_TUPLE_SIZE = [xs]\n  | otherwise              = split xs\n  where\n    n_xs     = length xs\n    split [] = []\n    split xs = take mAX_TUPLE_SIZE xs : split (drop mAX_TUPLE_SIZE xs)\n\n{-\n************************************************************************\n*                                                                      *\n        LHsSigType and LHsSigWcType\n*                                                                      *\n********************************************************************* -}\n\nmkLHsSigType :: LHsType GhcPs -> LHsSigType GhcPs\nmkLHsSigType ty = mkHsImplicitBndrs ty\n\nmkLHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs\nmkLHsSigWcType ty = mkHsWildCardBndrs (mkHsImplicitBndrs ty)\n\nmkHsSigEnv :: forall a. (LSig GhcRn -> Maybe ([Located Name], a))\n                     -> [LSig GhcRn]\n                     -> NameEnv a\nmkHsSigEnv get_info sigs\n  = mkNameEnv          (mk_pairs ordinary_sigs)\n   `extendNameEnvList` (mk_pairs gen_dm_sigs)\n   -- The subtlety is this: in a class decl with a\n   -- default-method signature as well as a method signature\n   -- we want the latter to win (Trac #12533)\n   --    class C x where\n   --       op :: forall a . x a -> x a\n   --       default op :: forall b . x b -> x b\n   --       op x = ...(e :: b -> b)...\n   -- The scoped type variables of the 'default op', namely 'b',\n   -- scope over the code for op.   The 'forall a' does not!\n   -- This applies both in the renamer and typechecker, both\n   -- of which use this function\n  where\n    (gen_dm_sigs, ordinary_sigs) = partition is_gen_dm_sig sigs\n    is_gen_dm_sig (dL->L _ (ClassOpSig _ True _ _)) = True\n    is_gen_dm_sig _                                 = False\n\n    mk_pairs :: [LSig GhcRn] -> [(Name, a)]\n    mk_pairs sigs = [ (n,a) | Just (ns,a) <- map get_info sigs\n                            , (dL->L _ n) <- ns ]\n\nmkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]\n-- Convert TypeSig to ClassOpSig\n-- The former is what is parsed, but the latter is\n-- what we need in class/instance declarations\nmkClassOpSigs sigs\n  = map fiddle sigs\n  where\n    fiddle (dL->L loc (TypeSig _ nms ty))\n      = cL loc (ClassOpSig noExt False nms (dropWildCards ty))\n    fiddle sig = sig\n\ntypeToLHsType :: Type -> LHsType GhcPs\n-- ^ Converting a Type to an HsType RdrName\n-- This is needed to implement GeneralizedNewtypeDeriving.\n--\n-- Note that we use 'getRdrName' extensively, which\n-- generates Exact RdrNames rather than strings.\ntypeToLHsType ty\n  = go ty\n  where\n    go :: Type -> LHsType GhcPs\n    go ty@(FunTy { ft_af = af, ft_arg = arg, ft_res = res })\n      = case af of\n          VisArg   -> nlHsFunTy (go arg) (go res)\n          InvisArg | (theta, tau) <- tcSplitPhiTy ty\n                   -> noLoc (HsQualTy { hst_ctxt = noLoc (map go theta)\n                                      , hst_xqual = noExt\n                                      , hst_body = go tau })\n\n    go ty@(ForAllTy (Bndr _ argf) _)\n      | (tvs, tau) <- tcSplitForAllTysSameVis argf ty\n      = noLoc (HsForAllTy { hst_fvf = argToForallVisFlag argf\n                          , hst_bndrs = map go_tv tvs\n                          , hst_xforall = noExt\n                          , hst_body = go tau })\n    go (TyVarTy tv)         = nlHsTyVar (getRdrName tv)\n    go (AppTy t1 t2)        = nlHsAppTy (go t1) (go t2)\n    go (LitTy (NumTyLit n))\n      = noLoc $ HsTyLit NoExt (HsNumTy NoSourceText n)\n    go (LitTy (StrTyLit s))\n      = noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s)\n    go ty@(TyConApp tc args)\n      | tyConAppNeedsKindSig True tc (length args)\n        -- We must produce an explicit kind signature here to make certain\n        -- programs kind-check. See Note [Kind signatures in typeToLHsType].\n      = nlHsParTy $ noLoc $ HsKindSig NoExt lhs_ty (go (tcTypeKind ty))\n      | otherwise = lhs_ty\n       where\n        arg_flags :: [ArgFlag]\n        arg_flags = tyConArgFlags tc args\n\n        lhs_ty :: LHsType GhcPs\n        lhs_ty = foldl' (\\f (arg, flag) ->\n                          let arg' = go arg in\n                          case flag of\n                            Inferred  -> f\n                            Specified -> f `nlHsAppKindTy` arg'\n                            Required  -> f `nlHsAppTy`     arg')\n                        (nlHsTyVar (getRdrName tc))\n                        (zip args arg_flags)\n    go (CastTy ty _)        = go ty\n    go (CoercionTy co)      = pprPanic \"toLHsSigWcType\" (ppr co)\n\n         -- Source-language types have _invisible_ kind arguments,\n         -- so we must remove them here (Trac #8563)\n\n    go_tv :: TyVar -> LHsTyVarBndr GhcPs\n    go_tv tv = noLoc $ KindedTyVar noExt (noLoc (getRdrName tv))\n                                   (go (tyVarKind tv))\n\n{-\nNote [Kind signatures in typeToLHsType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are types that typeToLHsType can produce which require explicit kind\nsignatures in order to kind-check. Here is an example from Trac #14579:\n\n  -- type P :: forall {k} {t :: k}. Proxy t\n  type P = 'Proxy\n\n  -- type Wat :: forall a. Proxy a -> *\n  newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)\n    deriving Eq\n\n  -- type Wat2 :: forall {a}. Proxy a -> *\n  type Wat2 = Wat\n\n  -- type Glurp :: * -> *\n  newtype Glurp a = MkGlurp (Wat2 (P :: Proxy a))\n    deriving Eq\n\nThe derived Eq instance for Glurp (without any kind signatures) would be:\n\n  instance Eq a => Eq (Glurp a) where\n    (==) = coerce @(Wat2 P  -> Wat2 P  -> Bool)\n                  @(Glurp a -> Glurp a -> Bool)\n                  (==) :: Glurp a -> Glurp a -> Bool\n\n(Where the visible type applications use types produced by typeToLHsType.)\n\nThe type P (in Wat2 P) has an underspecified kind, so we must ensure that\ntypeToLHsType ascribes it with its kind: Wat2 (P :: Proxy a). To accomplish\nthis, whenever we see an application of a tycon to some arguments, we use\nthe tyConAppNeedsKindSig function to determine if it requires an explicit kind\nsignature to resolve some ambiguity. (See Note\nNote [When does a tycon application need an explicit kind signature?] for a\nmore detailed explanation of how this works.)\n\nNote that we pass True to tyConAppNeedsKindSig since we are generated code with\nvisible kind applications, so even specified arguments count towards injective\npositions in the kind of the tycon.\n-}\n\n{- *********************************************************************\n*                                                                      *\n    --------- HsWrappers: type args, dict args, casts ---------\n*                                                                      *\n********************************************************************* -}\n\nmkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\nmkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e)\n\n-- Avoid (HsWrap co (HsWrap co' _)).\n-- See Note [Detecting forced eta expansion] in DsExpr\nmkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)\nmkHsWrap co_fn e | isIdHsWrapper co_fn = e\nmkHsWrap co_fn (HsWrap _ co_fn' e)     = mkHsWrap (co_fn <.> co_fn') e\nmkHsWrap co_fn e                       = HsWrap noExt co_fn e\n\nmkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b\n           -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)\nmkHsWrapCo co e = mkHsWrap (mkWpCastN co) e\n\nmkHsWrapCoR :: TcCoercionR   -- A Representational coercion  a ~R b\n            -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)\nmkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e\n\nmkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)\nmkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e)\n\nmkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)\nmkHsCmdWrap w cmd | isIdHsWrapper w = cmd\n                  | otherwise       = HsCmdWrap noExt w cmd\n\nmkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)\nmkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c)\n\nmkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)\nmkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p\n                       | otherwise           = CoPat noExt co_fn p ty\n\nmkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)\nmkHsWrapPatCo co pat ty | isTcReflCo co = pat\n                        | otherwise    = CoPat noExt (mkWpCastN co) pat ty\n\nmkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc\nmkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr\n\n{-\nl\n************************************************************************\n*                                                                      *\n                Bindings; with a location at the top\n*                                                                      *\n************************************************************************\n-}\n\nmkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]\n          -> HsBind GhcPs\n-- Not infix, with place holders for coercion and free vars\nmkFunBind fn ms = FunBind { fun_id = fn\n                          , fun_matches = mkMatchGroup Generated ms\n                          , fun_co_fn = idHsWrapper\n                          , fun_ext = noExt\n                          , fun_tick = [] }\n\nmkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]\n             -> HsBind GhcRn\n-- In Name-land, with empty bind_fvs\nmkTopFunBind origin fn ms = FunBind { fun_id = fn\n                                    , fun_matches = mkMatchGroup origin ms\n                                    , fun_co_fn = idHsWrapper\n                                    , fun_ext  = emptyNameSet -- NB: closed\n                                                              --     binding\n                                    , fun_tick = [] }\n\nmkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs\nmkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs\n\nmkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)\nmkVarBind var rhs = cL (getLoc rhs) $\n                    VarBind { var_ext = noExt,\n                              var_id = var, var_rhs = rhs, var_inline = False }\n\nmkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)\n             -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs\nmkPatSynBind name details lpat dir = PatSynBind noExt psb\n  where\n    psb = PSB{ psb_ext = noExt\n             , psb_id = name\n             , psb_args = details\n             , psb_def = lpat\n             , psb_dir = dir }\n\n-- |If any of the matches in the 'FunBind' are infix, the 'FunBind' is\n-- considered infix.\nisInfixFunBind :: HsBindLR id1 id2 -> Bool\nisInfixFunBind (FunBind _ _ (MG _ matches _) _ _)\n  = any (isInfixMatch . unLoc) (unLoc matches)\nisInfixFunBind _ = False\n\n\n------------\nmk_easy_FunBind :: SrcSpan -> RdrName -> [LPat GhcPs]\n                -> LHsExpr GhcPs -> LHsBind GhcPs\nmk_easy_FunBind loc fun pats expr\n  = cL loc $ mkFunBind (cL loc fun)\n              [mkMatch (mkPrefixFunRhs (cL loc fun)) pats expr\n                       (noLoc emptyLocalBinds)]\n\n-- | Make a prefix, non-strict function 'HsMatchContext'\nmkPrefixFunRhs :: Located id -> HsMatchContext id\nmkPrefixFunRhs n = FunRhs { mc_fun = n\n                          , mc_fixity = Prefix\n                          , mc_strictness = NoSrcStrict }\n\n------------\nmkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))\n        -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p)\n        -> Located (HsLocalBinds (GhcPass p))\n        -> LMatch (GhcPass p) (LHsExpr (GhcPass p))\nmkMatch ctxt pats expr lbinds\n  = noLoc (Match { m_ext   = noExt\n                 , m_ctxt  = ctxt\n                 , m_pats  = map paren pats\n                 , m_grhss = GRHSs noExt (unguardedRHS noSrcSpan expr) lbinds })\n  where\n    paren lp@(dL->L l p)\n      | patNeedsParens appPrec p = cL l (ParPat noExt lp)\n      | otherwise                = lp\n\n{-\n************************************************************************\n*                                                                      *\n        Collecting binders\n*                                                                      *\n************************************************************************\n\nGet all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.\n\n...\nwhere\n  (x, y) = ...\n  f i j  = ...\n  [a, b] = ...\n\nit should return [x, y, f, a, b] (remember, order important).\n\nNote [Collect binders only after renaming]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThese functions should only be used on HsSyn *after* the renamer,\nto return a [Name] or [Id].  Before renaming the record punning\nand wild-card mechanism makes it hard to know what is bound.\nSo these functions should not be applied to (HsSyn RdrName)\n\nNote [Unlifted id check in isUnliftedHsBind]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe function isUnliftedHsBind is used to complain if we make a top-level\nbinding for a variable of unlifted type.\n\nSuch a binding is illegal if the top-level binding would be unlifted;\nbut also if the local letrec generated by desugaring AbsBinds would be.\nE.g.\n      f :: Num a => (# a, a #)\n      g :: Num a => a -> a\n      f = ...g...\n      g = ...g...\n\nThe top-level bindings for f,g are not unlifted (because of the Num a =>),\nbut the local, recursive, monomorphic bindings are:\n\n      t = /\\a \\(d:Num a).\n         letrec fm :: (# a, a #) = ...g...\n                gm :: a -> a = ...f...\n         in (fm, gm)\n\nHere the binding for 'fm' is illegal.  So generally we check the abe_mono types.\n\nBUT we have a special case when abs_sig is true;\n  see HsBinds Note [The abs_sig field of AbsBinds]\n-}\n\n----------------- Bindings --------------------------\n\n-- | Should we treat this as an unlifted bind? This will be true for any\n-- bind that binds an unlifted variable, but we must be careful around\n-- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage\n-- information, see Note [Strict binds check] is DsBinds.\nisUnliftedHsBind :: HsBind GhcTc -> Bool  -- works only over typechecked binds\nisUnliftedHsBind bind\n  | AbsBinds { abs_exports = exports, abs_sig = has_sig } <- bind\n  = if has_sig\n    then any (is_unlifted_id . abe_poly) exports\n    else any (is_unlifted_id . abe_mono) exports\n    -- If has_sig is True we wil never generate a binding for abe_mono,\n    -- so we don't need to worry about it being unlifted. The abe_poly\n    -- binding might not be: e.g. forall a. Num a => (# a, a #)\n\n  | otherwise\n  = any is_unlifted_id (collectHsBindBinders bind)\n  where\n    is_unlifted_id id = isUnliftedType (idType id)\n\n-- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?\nisBangedHsBind :: HsBind GhcTc -> Bool\nisBangedHsBind (AbsBinds { abs_binds = binds })\n  = anyBag (isBangedHsBind . unLoc) binds\nisBangedHsBind (FunBind {fun_matches = matches})\n  | [dL->L _ match] <- unLoc $ mg_alts matches\n  , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match\n  = True\nisBangedHsBind (PatBind {pat_lhs = pat})\n  = isBangedLPat pat\nisBangedHsBind _\n  = False\n\ncollectLocalBinders :: HsLocalBindsLR (GhcPass idL) (GhcPass idR)\n                    -> [IdP (GhcPass idL)]\ncollectLocalBinders (HsValBinds _ binds) = collectHsIdBinders binds\n                                         -- No pattern synonyms here\ncollectLocalBinders (HsIPBinds {})      = []\ncollectLocalBinders (EmptyLocalBinds _) = []\ncollectLocalBinders (XHsLocalBindsLR _) = []\n\ncollectHsIdBinders, collectHsValBinders\n  :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]\n-- Collect Id binders only, or Ids + pattern synonyms, respectively\ncollectHsIdBinders  = collect_hs_val_binders True\ncollectHsValBinders = collect_hs_val_binders False\n\ncollectHsBindBinders :: (SrcSpanLess (LPat p) ~ Pat p, HasSrcSpan (LPat p))=>\n                        HsBindLR p idR -> [IdP p]\n-- Collect both Ids and pattern-synonym binders\ncollectHsBindBinders b = collect_bind False b []\n\ncollectHsBindsBinders :: LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]\ncollectHsBindsBinders binds = collect_binds False binds []\n\ncollectHsBindListBinders :: [LHsBindLR (GhcPass p) idR] -> [IdP (GhcPass p)]\n-- Same as collectHsBindsBinders, but works over a list of bindings\ncollectHsBindListBinders = foldr (collect_bind False . unLoc) []\n\ncollect_hs_val_binders :: Bool -> HsValBindsLR (GhcPass idL) (GhcPass idR)\n                       -> [IdP (GhcPass idL)]\ncollect_hs_val_binders ps (ValBinds _ binds _) = collect_binds ps binds []\ncollect_hs_val_binders ps (XValBindsLR (NValBinds binds _))\n  = collect_out_binds ps binds\n\ncollect_out_binds :: Bool -> [(RecFlag, LHsBinds (GhcPass p))] ->\n                     [IdP (GhcPass p)]\ncollect_out_binds ps = foldr (collect_binds ps . snd) []\n\ncollect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->\n                 [IdP (GhcPass p)] -> [IdP (GhcPass p)]\n-- Collect Ids, or Ids + pattern synonyms, depending on boolean flag\ncollect_binds ps binds acc = foldrBag (collect_bind ps . unLoc) acc binds\n\ncollect_bind :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>\n                Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]\ncollect_bind _ (PatBind { pat_lhs = p })           acc = collect_lpat p acc\ncollect_bind _ (FunBind { fun_id = (dL->L _ f) })  acc = f : acc\ncollect_bind _ (VarBind { var_id = f })            acc = f : acc\ncollect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++ acc\n        -- I don't think we want the binders from the abe_binds\n\n        -- binding (hence see AbsBinds) is in zonking in TcHsSyn\ncollect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = (dL->L _ ps) })) acc\n  | omitPatSyn                  = acc\n  | otherwise                   = ps : acc\ncollect_bind _ (PatSynBind _ (XPatSynBind _)) acc = acc\ncollect_bind _ (XHsBindsLR _) acc = acc\n\ncollectMethodBinders :: LHsBindsLR idL idR -> [Located (IdP idL)]\n-- Used exclusively for the bindings of an instance decl which are all FunBinds\ncollectMethodBinders binds = foldrBag (get . unLoc) [] binds\n  where\n    get (FunBind { fun_id = f }) fs = f : fs\n    get _                        fs = fs\n       -- Someone else complains about non-FunBinds\n\n----------------- Statements --------------------------\ncollectLStmtsBinders :: [LStmtLR (GhcPass idL) (GhcPass idR) body]\n                     -> [IdP (GhcPass idL)]\ncollectLStmtsBinders = concatMap collectLStmtBinders\n\ncollectStmtsBinders :: [StmtLR (GhcPass idL) (GhcPass idR) body]\n                    -> [IdP (GhcPass idL)]\ncollectStmtsBinders = concatMap collectStmtBinders\n\ncollectLStmtBinders :: LStmtLR (GhcPass idL) (GhcPass idR) body\n                    -> [IdP (GhcPass idL)]\ncollectLStmtBinders = collectStmtBinders . unLoc\n\ncollectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body\n                   -> [IdP (GhcPass idL)]\n  -- Id Binders for a Stmt... [but what about pattern-sig type vars]?\ncollectStmtBinders (BindStmt _ pat _ _ _)  = collectPatBinders pat\ncollectStmtBinders (LetStmt _  binds)      = collectLocalBinders (unLoc binds)\ncollectStmtBinders (BodyStmt {})           = []\ncollectStmtBinders (LastStmt {})           = []\ncollectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders\n                                    $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]\ncollectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts\ncollectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss\ncollectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args\n where\n  collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat\n  collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat\n  collectArgBinders _ = []\ncollectStmtBinders XStmtLR{} = panic \"collectStmtBinders\"\n\n\n----------------- Patterns --------------------------\ncollectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]\ncollectPatBinders pat = collect_lpat pat []\n\ncollectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]\ncollectPatsBinders pats = foldr collect_lpat [] pats\n\n-------------\ncollect_lpat :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>\n                 LPat p -> [IdP p] -> [IdP p]\ncollect_lpat p bndrs\n  = go (unLoc p)\n  where\n    go (VarPat _ var)             = unLoc var : bndrs\n    go (WildPat _)                = bndrs\n    go (LazyPat _ pat)            = collect_lpat pat bndrs\n    go (BangPat _ pat)            = collect_lpat pat bndrs\n    go (AsPat _ a pat)            = unLoc a : collect_lpat pat bndrs\n    go (ViewPat _ _ pat)          = collect_lpat pat bndrs\n    go (ParPat _ pat)             = collect_lpat pat bndrs\n\n    go (ListPat _ pats)           = foldr collect_lpat bndrs pats\n    go (TuplePat _ pats _)        = foldr collect_lpat bndrs pats\n    go (SumPat _ pat _ _)         = collect_lpat pat bndrs\n\n    go (ConPatIn _ ps)            = foldr collect_lpat bndrs (hsConPatArgs ps)\n    go (ConPatOut {pat_args=ps})  = foldr collect_lpat bndrs (hsConPatArgs ps)\n        -- See Note [Dictionary binders in ConPatOut]\n    go (LitPat _ _)               = bndrs\n    go (NPat {})                  = bndrs\n    go (NPlusKPat _ n _ _ _ _)    = unLoc n : bndrs\n\n    go (SigPat _ pat _)           = collect_lpat pat bndrs\n\n    go (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))\n                                  = go pat\n    go (SplicePat _ _)            = bndrs\n    go (CoPat _ _ pat _)          = go pat\n    go (XPat {})                  = bndrs\n\n{-\nNote [Dictionary binders in ConPatOut] See also same Note in DsArrows\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDo *not* gather (a) dictionary and (b) dictionary bindings as binders\nof a ConPatOut pattern.  For most calls it doesn't matter, because\nit's pre-typechecker and there are no ConPatOuts.  But it does matter\nmore in the desugarer; for example, DsUtils.mkSelectorBinds uses\ncollectPatBinders.  In a lazy pattern, for example f ~(C x y) = ...,\nwe want to generate bindings for x,y but not for dictionaries bound by\nC.  (The type checker ensures they would not be used.)\n\nDesugaring of arrow case expressions needs these bindings (see DsArrows\nand arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its\nown pat-binder-collector:\n\nHere's the problem.  Consider\n\ndata T a where\n   C :: Num a => a -> Int -> T a\n\nf ~(C (n+1) m) = (n,m)\n\nHere, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),\nand *also* uses that dictionary to match the (n+1) pattern.  Yet, the\nvariables bound by the lazy pattern are n,m, *not* the dictionary d.\nSo in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.\n-}\n\nhsGroupBinders :: HsGroup GhcRn -> [Name]\nhsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,\n                          hs_fords = foreign_decls })\n  =  collectHsValBinders val_decls\n  ++ hsTyClForeignBinders tycl_decls foreign_decls\nhsGroupBinders (XHsGroup {}) = panic \"hsGroupBinders\"\n\nhsTyClForeignBinders :: [TyClGroup GhcRn]\n                     -> [LForeignDecl GhcRn]\n                     -> [Name]\n-- We need to look at instance declarations too,\n-- because their associated types may bind data constructors\nhsTyClForeignBinders tycl_decls foreign_decls\n  =    map unLoc (hsForeignDeclsBinders foreign_decls)\n    ++ getSelectorNames\n         (foldMap (foldMap hsLTyClDeclBinders . group_tyclds) tycl_decls\n         `mappend`\n         foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls)\n  where\n    getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name]\n    getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs\n\n-------------------\nhsLTyClDeclBinders :: Located (TyClDecl pass)\n                   -> ([Located (IdP pass)], [LFieldOcc pass])\n-- ^ Returns all the /binding/ names of the decl.  The first one is\n-- guaranteed to be the name of the decl. The first component\n-- represents all binding names except record fields; the second\n-- represents field occurrences. For record fields mentioned in\n-- multiple constructors, the SrcLoc will be from the first occurrence.\n--\n-- Each returned (Located name) has a SrcSpan for the /whole/ declaration.\n-- See Note [SrcSpan for binders]\n\nhsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl\n                                            { fdLName = (dL->L _ name) } }))\n  = ([cL loc name], [])\nhsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl _ }))\n  = panic \"hsLTyClDeclBinders\"\nhsLTyClDeclBinders (dL->L loc (SynDecl\n                               { tcdLName = (dL->L _ name) }))\n  = ([cL loc name], [])\nhsLTyClDeclBinders (dL->L loc (ClassDecl\n                               { tcdLName = (dL->L _ cls_name)\n                               , tcdSigs  = sigs\n                               , tcdATs   = ats }))\n  = (cL loc cls_name :\n     [ cL fam_loc fam_name | (dL->L fam_loc (FamilyDecl\n                                        { fdLName = L _ fam_name })) <- ats ]\n     ++\n     [ cL mem_loc mem_name | (dL->L mem_loc (ClassOpSig _ False ns _)) <- sigs\n                           , (dL->L _ mem_name) <- ns ]\n    , [])\nhsLTyClDeclBinders (dL->L loc (DataDecl    { tcdLName = (dL->L _ name)\n                                           , tcdDataDefn = defn }))\n  = (\\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn\nhsLTyClDeclBinders (dL->L _ (XTyClDecl _)) = panic \"hsLTyClDeclBinders\"\nhsLTyClDeclBinders _ = panic \"hsLTyClDeclBinders: Impossible Match\"\n                             -- due to #15884\n\n\n-------------------\nhsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]\n-- See Note [SrcSpan for binders]\nhsForeignDeclsBinders foreign_decls\n  = [ cL decl_loc n\n    | (dL->L decl_loc (ForeignImport { fd_name = (dL->L _ n) }))\n        <- foreign_decls]\n\n\n-------------------\nhsPatSynSelectors :: HsValBinds (GhcPass p) -> [IdP (GhcPass p)]\n-- Collects record pattern-synonym selectors only; the pattern synonym\n-- names are collected by collectHsValBinders.\nhsPatSynSelectors (ValBinds _ _ _) = panic \"hsPatSynSelectors\"\nhsPatSynSelectors (XValBindsLR (NValBinds binds _))\n  = foldrBag addPatSynSelector [] . unionManyBags $ map snd binds\n\naddPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]\naddPatSynSelector bind sels\n  | PatSynBind _ (PSB { psb_args = RecCon as }) <- unLoc bind\n  = map (unLoc . recordPatSynSelectorId) as ++ sels\n  | otherwise = sels\n\ngetPatSynBinds :: [(RecFlag, LHsBinds id)] -> [PatSynBind id id]\ngetPatSynBinds binds\n  = [ psb | (_, lbinds) <- binds\n          , (dL->L _ (PatSynBind _ psb)) <- bagToList lbinds ]\n\n-------------------\nhsLInstDeclBinders :: LInstDecl (GhcPass p)\n                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])\nhsLInstDeclBinders (dL->L _ (ClsInstD\n                             { cid_inst = ClsInstDecl\n                                          { cid_datafam_insts = dfis }}))\n  = foldMap (hsDataFamInstBinders . unLoc) dfis\nhsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi }))\n  = hsDataFamInstBinders fi\nhsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty\nhsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl {})))\n  = panic \"hsLInstDeclBinders\"\nhsLInstDeclBinders (dL->L _ (XInstDecl _))\n  = panic \"hsLInstDeclBinders\"\nhsLInstDeclBinders _ = panic \"hsLInstDeclBinders: Impossible Match\"\n                             -- due to #15884\n\n-------------------\n-- the SrcLoc returned are for the whole declarations, not just the names\nhsDataFamInstBinders :: DataFamInstDecl pass\n                     -> ([Located (IdP pass)], [LFieldOcc pass])\nhsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n                       FamEqn { feqn_rhs = defn }}})\n  = hsDataDefnBinders defn\n  -- There can't be repeated symbols because only data instances have binders\nhsDataFamInstBinders (DataFamInstDecl\n                                    { dfid_eqn = HsIB { hsib_body = XFamEqn _}})\n  = panic \"hsDataFamInstBinders\"\nhsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _))\n  = panic \"hsDataFamInstBinders\"\n\n-------------------\n-- the SrcLoc returned are for the whole declarations, not just the names\nhsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])\nhsDataDefnBinders (HsDataDefn { dd_cons = cons })\n  = hsConDeclsBinders cons\n  -- See Note [Binders in family instances]\nhsDataDefnBinders (XHsDataDefn _) = panic \"hsDataDefnBinders\"\n\n-------------------\ntype Seen pass = [LFieldOcc pass] -> [LFieldOcc pass]\n                 -- Filters out ones that have already been seen\n\nhsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])\n   -- See hsLTyClDeclBinders for what this does\n   -- The function is boringly complicated because of the records\n   -- And since we only have equality, we have to be a little careful\nhsConDeclsBinders cons\n  = go id cons\n  where\n    go :: Seen pass -> [LConDecl pass]\n       -> ([Located (IdP pass)], [LFieldOcc pass])\n    go _ [] = ([], [])\n    go remSeen (r:rs)\n      -- Don't re-mangle the location of field names, because we don't\n      -- have a record of the full location of the field declaration anyway\n      = let loc = getLoc r\n        in case unLoc r of\n           -- remove only the first occurrence of any seen field in order to\n           -- avoid circumventing detection of duplicate fields (#9156)\n           ConDeclGADT { con_names = names, con_args = args }\n             -> (map (cL loc . unLoc) names ++ ns, flds ++ fs)\n             where\n                (remSeen', flds) = get_flds remSeen args\n                (ns, fs) = go remSeen' rs\n\n           ConDeclH98 { con_name = name, con_args = args }\n             -> ([cL loc (unLoc name)] ++ ns, flds ++ fs)\n             where\n                (remSeen', flds) = get_flds remSeen args\n                (ns, fs) = go remSeen' rs\n\n           XConDecl _ -> panic \"hsConDeclsBinders\"\n\n    get_flds :: Seen pass -> HsConDeclDetails pass\n             -> (Seen pass, [LFieldOcc pass])\n    get_flds remSeen (RecCon flds)\n       = (remSeen', fld_names)\n       where\n          fld_names = remSeen (concatMap (cd_fld_names . unLoc) (unLoc flds))\n          remSeen' = foldr (.) remSeen\n                               [deleteBy ((==) `on` unLoc . rdrNameFieldOcc . unLoc) v\n                               | v <- fld_names]\n    get_flds remSeen _\n       = (remSeen, [])\n\n{-\n\nNote [SrcSpan for binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen extracting the (Located RdrNme) for a binder, at least for the\nmain name (the TyCon of a type declaration etc), we want to give it\nthe @SrcSpan@ of the whole /declaration/, not just the name itself\n(which is how it appears in the syntax tree).  This SrcSpan (for the\nentire declaration) is used as the SrcSpan for the Name that is\nfinally produced, and hence for error messages.  (See Trac #8607.)\n\nNote [Binders in family instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a type or data family instance declaration, the type\nconstructor is an *occurrence* not a binding site\n    type instance T Int = Int -> Int   -- No binders\n    data instance S Bool = S1 | S2     -- Binders are S1,S2\n\n\n************************************************************************\n*                                                                      *\n        Collecting binders the user did not write\n*                                                                      *\n************************************************************************\n\nThe job of this family of functions is to run through binding sites and find the set of all Names\nthat were defined \"implicitly\", without being explicitly written by the user.\n\nThe main purpose is to find names introduced by record wildcards so that we can avoid\nwarning the user when they don't use those names (#4404)\n\nSince the addition of -Wunused-record-wildcards, this function returns a pair\nof [(SrcSpan, [Name])]. Each element of the list is one set of implicit\nbinders, the first component of the tuple is the document describes the possible\nfix to the problem (by removing the ..).\n\nThis means there is some unfortunate coupling between this function and where it\nis used but it's only used for one specific purpose in one place so it seemed\neasier.\n-}\n\nlStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]\n                -> [(SrcSpan, [Name])]\nlStmtsImplicits = hs_lstmts\n  where\n    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]\n              -> [(SrcSpan, [Name])]\n    hs_lstmts = concatMap (hs_stmt . unLoc)\n\n    hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))\n            -> [(SrcSpan, [Name])]\n    hs_stmt (BindStmt _ pat _ _ _) = lPatImplicits pat\n    hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args\n      where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat\n            do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts\n            do_arg (_, XApplicativeArg _) = panic \"lStmtsImplicits\"\n    hs_stmt (LetStmt _ binds)     = hs_local_binds (unLoc binds)\n    hs_stmt (BodyStmt {})         = []\n    hs_stmt (LastStmt {})         = []\n    hs_stmt (ParStmt _ xs _ _)    = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs\n                                                , s <- ss]\n    hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts\n    hs_stmt (RecStmt { recS_stmts = ss })     = hs_lstmts ss\n    hs_stmt (XStmtLR {})          = panic \"lStmtsImplicits\"\n\n    hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds\n    hs_local_binds (HsIPBinds {})           = []\n    hs_local_binds (EmptyLocalBinds _)      = []\n    hs_local_binds (XHsLocalBindsLR _)      = []\n\nhsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> [(SrcSpan, [Name])]\nhsValBindsImplicits (XValBindsLR (NValBinds binds _))\n  = concatMap (lhsBindsImplicits . snd) binds\nhsValBindsImplicits (ValBinds _ binds _)\n  = lhsBindsImplicits binds\n\nlhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]\nlhsBindsImplicits = foldBag (++) (lhs_bind . unLoc) []\n  where\n    lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat\n    lhs_bind _ = []\n\nlPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]\nlPatImplicits = hs_lpat\n  where\n    hs_lpat lpat = hs_pat (unLoc lpat)\n\n    hs_lpats = foldr (\\pat rest -> hs_lpat pat ++ rest) []\n\n    hs_pat (LazyPat _ pat)      = hs_lpat pat\n    hs_pat (BangPat _ pat)      = hs_lpat pat\n    hs_pat (AsPat _ _ pat)      = hs_lpat pat\n    hs_pat (ViewPat _ _ pat)    = hs_lpat pat\n    hs_pat (ParPat _ pat)       = hs_lpat pat\n    hs_pat (ListPat _ pats)     = hs_lpats pats\n    hs_pat (TuplePat _ pats _)  = hs_lpats pats\n\n    hs_pat (SigPat _ pat _)     = hs_lpat pat\n    hs_pat (CoPat _ _ pat _)    = hs_pat pat\n\n    hs_pat (ConPatIn n ps)           = details n ps\n    hs_pat (ConPatOut {pat_con=con, pat_args=ps}) = details (fmap conLikeName con) ps\n\n    hs_pat _ = []\n\n    details :: Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]\n    details _ (PrefixCon ps)   = hs_lpats ps\n    details n (RecCon fs)      =\n      [(err_loc, collectPatsBinders implicit_pats) | Just{} <- [rec_dotdot fs] ]\n        ++ hs_lpats explicit_pats\n\n      where implicit_pats = map (hsRecFieldArg . unLoc) implicit\n            explicit_pats = map (hsRecFieldArg . unLoc) explicit\n\n\n            (explicit, implicit) = partitionEithers [if pat_explicit then Left fld else Right fld\n                                                    | (i, fld) <- [0..] `zip` rec_flds fs\n                                                    ,  let  pat_explicit =\n                                                              maybe True ((i<) . unLoc)\n                                                                         (rec_dotdot fs)]\n            err_loc = maybe (getLoc n) getLoc (rec_dotdot fs)\n\n    details _ (InfixCon p1 p2) = hs_lpat p1 ++ hs_lpat p2\n", "num_lines": 1419}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\nmodule PlaceHolder where\n\nimport Name\nimport NameSet\nimport RdrName\nimport Var\n\n\n\n{-\n%************************************************************************\n%*                                                                      *\n\\subsection{Annotating the syntax}\n%*                                                                      *\n%************************************************************************\n-}\n\n-- NB: These are intentionally open, allowing API consumers (like Haddock)\n-- to declare new instances\n\nplaceHolderNamesTc :: NameSet\nplaceHolderNamesTc = emptyNameSet\n\n{-\nTODO:AZ: remove this, and check if we still need all the UndecidableInstances\n\nNote [Pass sensitive types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSince the same AST types are re-used through parsing,renaming and type\nchecking there are naturally some places in the AST that do not have\nany meaningful value prior to the pass they are assigned a value.\n\nHistorically these have been filled in with place holder values of the form\n\n  panic \"error message\"\n\nThis has meant the AST is difficult to traverse using standard generic\nprogramming techniques. The problem is addressed by introducing\npass-specific data types, implemented as a pair of open type families,\none for PostTc and one for PostRn. These are then explicitly populated\nwith a PlaceHolder value when they do not yet have meaning.\n\nIn terms of actual usage, we have the following\n\n  PostTc id Kind\n  PostTc id Type\n\n  PostRn id Fixity\n  PostRn id NameSet\n\nTcId and Var are synonyms for Id\n\nUnfortunately the type checker termination checking conditions fail for the\nDataId constraint type based on this, so even though it is safe the\nUndecidableInstances pragma is required where this is used.\n-}\n\n\n-- |Follow the @id@, but never beyond Name. This is used in a 'HsMatchContext',\n-- for printing messages related to a 'Match'\ntype family NameOrRdrName id where\n  NameOrRdrName Id      = Name\n  NameOrRdrName Name    = Name\n  NameOrRdrName RdrName = RdrName\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- | Computing fingerprints of values serializeable with GHC's \"Binary\" module.\nmodule BinFingerprint\n  ( -- * Computing fingerprints\n    fingerprintBinMem\n  , computeFingerprint\n  , putNameLiterally\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Fingerprint\nimport Binary\nimport Name\nimport Panic\nimport Util\n\nfingerprintBinMem :: BinHandle -> IO Fingerprint\nfingerprintBinMem bh = withBinBuffer bh f\n  where\n    f bs =\n        -- we need to take care that we force the result here\n        -- lest a reference to the ByteString may leak out of\n        -- withBinBuffer.\n        let fp = fingerprintByteString bs\n        in fp `seq` return fp\n\ncomputeFingerprint :: (Binary a)\n                   => (BinHandle -> Name -> IO ())\n                   -> a\n                   -> IO Fingerprint\ncomputeFingerprint put_nonbinding_name a = do\n    bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block\n    put_ bh a\n    fp <- fingerprintBinMem bh\n    return fp\n  where\n    set_user_data bh =\n      setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS\n\n-- | Used when we want to fingerprint a structure without depending on the\n-- fingerprints of external Names that it refers to.\nputNameLiterally :: BinHandle -> Name -> IO ()\nputNameLiterally bh name = ASSERT( isExternalName name ) do\n    put_ bh $! nameModule name\n    put_ bh $! nameOccName name\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BinaryLiterals, CPP, ScopedTypeVariables, BangPatterns #-}\n\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n{-# OPTIONS_GHC -O2 #-}\n-- We always optimise this, otherwise performance of a non-optimised\n-- compiler is severely affected\n\n-- | Binary interface file support.\nmodule BinIface (\n        writeBinIface,\n        readBinIface,\n        getSymtabName,\n        getDictFastString,\n        CheckHiWay(..),\n        TraceBinIFaceReading(..),\n        getWithUserData,\n        putWithUserData\n\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnMonad\nimport PrelInfo   ( isKnownKeyName, lookupKnownKeyName )\nimport IfaceEnv\nimport HscTypes\nimport Module\nimport Name\nimport DynFlags\nimport UniqFM\nimport UniqSupply\nimport Panic\nimport Binary\nimport SrcLoc\nimport ErrUtils\nimport FastMutInt\nimport Unique\nimport Outputable\nimport NameCache\nimport Platform\nimport FastString\nimport Constants\nimport Util\n\nimport Data.Array\nimport Data.Array.ST\nimport Data.Array.Unsafe\nimport Data.Bits\nimport Data.Char\nimport Data.Word\nimport Data.IORef\nimport Data.Foldable\nimport Control.Monad\nimport Control.Monad.ST\nimport Control.Monad.Trans.Class\nimport qualified Control.Monad.Trans.State.Strict as State\n\n-- ---------------------------------------------------------------------------\n-- Reading and writing binary interface files\n--\n\ndata CheckHiWay = CheckHiWay | IgnoreHiWay\n    deriving Eq\n\ndata TraceBinIFaceReading = TraceBinIFaceReading | QuietBinIFaceReading\n    deriving Eq\n\n-- | Read an interface file\nreadBinIface :: CheckHiWay -> TraceBinIFaceReading -> FilePath\n             -> TcRnIf a b ModIface\nreadBinIface checkHiWay traceBinIFaceReading hi_path = do\n    ncu <- mkNameCacheUpdater\n    dflags <- getDynFlags\n    liftIO $ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu\n\nreadBinIface_ :: DynFlags -> CheckHiWay -> TraceBinIFaceReading -> FilePath\n              -> NameCacheUpdater\n              -> IO ModIface\nreadBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do\n    let printer :: SDoc -> IO ()\n        printer = case traceBinIFaceReading of\n                      TraceBinIFaceReading -> \\sd ->\n                          putLogMsg dflags\n                                    NoReason\n                                    SevOutput\n                                    noSrcSpan\n                                    (defaultDumpStyle dflags)\n                                    sd\n                      QuietBinIFaceReading -> \\_ -> return ()\n        wantedGot :: Outputable a => String -> a -> a -> IO ()\n        wantedGot what wanted got =\n            printer (text what <> text \": \" <>\n                     vcat [text \"Wanted \" <> ppr wanted <> text \",\",\n                           text \"got    \" <> ppr got])\n\n        errorOnMismatch :: (Eq a, Show a) => String -> a -> a -> IO ()\n        errorOnMismatch what wanted got =\n            -- This will be caught by readIface which will emit an error\n            -- msg containing the iface module name.\n            when (wanted /= got) $ throwGhcExceptionIO $ ProgramError\n                         (what ++ \" (wanted \" ++ show wanted\n                               ++ \", got \"    ++ show got ++ \")\")\n    bh <- Binary.readBinMem hi_path\n\n    -- Read the magic number to check that this really is a GHC .hi file\n    -- (This magic number does not change when we change\n    --  GHC interface file format)\n    magic <- get bh\n    wantedGot \"Magic\" (binaryInterfaceMagic dflags) magic\n    errorOnMismatch \"magic number mismatch: old/corrupt interface file?\"\n        (binaryInterfaceMagic dflags) magic\n\n    -- Note [dummy iface field]\n    -- read a dummy 32/64 bit value.  This field used to hold the\n    -- dictionary pointer in old interface file formats, but now\n    -- the dictionary pointer is after the version (where it\n    -- should be).  Also, the serialisation of value of type \"Bin\n    -- a\" used to depend on the word size of the machine, now they\n    -- are always 32 bits.\n    if wORD_SIZE dflags == 4\n        then do _ <- Binary.get bh :: IO Word32; return ()\n        else do _ <- Binary.get bh :: IO Word64; return ()\n\n    -- Check the interface file version and ways.\n    check_ver  <- get bh\n    let our_ver = show hiVersion\n    wantedGot \"Version\" our_ver check_ver\n    errorOnMismatch \"mismatched interface file versions\" our_ver check_ver\n\n    check_way <- get bh\n    let way_descr = getWayDescr dflags\n    wantedGot \"Way\" way_descr check_way\n    when (checkHiWay == CheckHiWay) $\n        errorOnMismatch \"mismatched interface file ways\" way_descr check_way\n    getWithUserData ncu bh\n\n\n-- | This performs a get action after reading the dictionary and symbol\n-- table. It is necessary to run this before trying to deserialise any\n-- Names or FastStrings.\ngetWithUserData :: Binary a => NameCacheUpdater -> BinHandle -> IO a\ngetWithUserData ncu bh = do\n    -- Read the dictionary\n    -- The next word in the file is a pointer to where the dictionary is\n    -- (probably at the end of the file)\n    dict_p <- Binary.get bh\n    data_p <- tellBin bh          -- Remember where we are now\n    seekBin bh dict_p\n    dict   <- getDictionary bh\n    seekBin bh data_p             -- Back to where we were before\n\n    -- Initialise the user-data field of bh\n    bh <- do\n        bh <- return $ setUserData bh $ newReadState (error \"getSymtabName\")\n                                                     (getDictFastString dict)\n        symtab_p <- Binary.get bh     -- Get the symtab ptr\n        data_p <- tellBin bh          -- Remember where we are now\n        seekBin bh symtab_p\n        symtab <- getSymbolTable bh ncu\n        seekBin bh data_p             -- Back to where we were before\n\n        -- It is only now that we know how to get a Name\n        return $ setUserData bh $ newReadState (getSymtabName ncu dict symtab)\n                                               (getDictFastString dict)\n\n    -- Read the interface file\n    get bh\n\n-- | Write an interface file\nwriteBinIface :: DynFlags -> FilePath -> ModIface -> IO ()\nwriteBinIface dflags hi_path mod_iface = do\n    bh <- openBinMem initBinMemSize\n    put_ bh (binaryInterfaceMagic dflags)\n\n   -- dummy 32/64-bit field before the version/way for\n   -- compatibility with older interface file formats.\n   -- See Note [dummy iface field] above.\n    if wORD_SIZE dflags == 4\n        then Binary.put_ bh (0 :: Word32)\n        else Binary.put_ bh (0 :: Word64)\n\n    -- The version and way descriptor go next\n    put_ bh (show hiVersion)\n    let way_descr = getWayDescr dflags\n    put_  bh way_descr\n\n\n    putWithUserData (debugTraceMsg dflags 3) bh mod_iface\n    -- And send the result to the file\n    writeBinMem bh hi_path\n\n-- | Put a piece of data with an initialised `UserData` field. This\n-- is necessary if you want to serialise Names or FastStrings.\n-- It also writes a symbol table and the dictionary.\n-- This segment should be read using `getWithUserData`.\nputWithUserData :: Binary a => (SDoc -> IO ()) -> BinHandle -> a -> IO ()\nputWithUserData log_action bh payload = do\n    -- Remember where the dictionary pointer will go\n    dict_p_p <- tellBin bh\n    -- Placeholder for ptr to dictionary\n    put_ bh dict_p_p\n\n    -- Remember where the symbol table pointer will go\n    symtab_p_p <- tellBin bh\n    put_ bh symtab_p_p\n    -- Make some initial state\n    symtab_next <- newFastMutInt\n    writeFastMutInt symtab_next 0\n    symtab_map <- newIORef emptyUFM\n    let bin_symtab = BinSymbolTable {\n                         bin_symtab_next = symtab_next,\n                         bin_symtab_map  = symtab_map }\n    dict_next_ref <- newFastMutInt\n    writeFastMutInt dict_next_ref 0\n    dict_map_ref <- newIORef emptyUFM\n    let bin_dict = BinDictionary {\n                       bin_dict_next = dict_next_ref,\n                       bin_dict_map  = dict_map_ref }\n\n    -- Put the main thing,\n    bh <- return $ setUserData bh $ newWriteState (putName bin_dict bin_symtab)\n                                                  (putName bin_dict bin_symtab)\n                                                  (putFastString bin_dict)\n    put_ bh payload\n\n    -- Write the symtab pointer at the front of the file\n    symtab_p <- tellBin bh        -- This is where the symtab will start\n    putAt bh symtab_p_p symtab_p  -- Fill in the placeholder\n    seekBin bh symtab_p           -- Seek back to the end of the file\n\n    -- Write the symbol table itself\n    symtab_next <- readFastMutInt symtab_next\n    symtab_map  <- readIORef symtab_map\n    putSymbolTable bh symtab_next symtab_map\n    log_action (text \"writeBinIface:\" <+> int symtab_next\n                                <+> text \"Names\")\n\n    -- NB. write the dictionary after the symbol table, because\n    -- writing the symbol table may create more dictionary entries.\n\n    -- Write the dictionary pointer at the front of the file\n    dict_p <- tellBin bh          -- This is where the dictionary will start\n    putAt bh dict_p_p dict_p      -- Fill in the placeholder\n    seekBin bh dict_p             -- Seek back to the end of the file\n\n    -- Write the dictionary itself\n    dict_next <- readFastMutInt dict_next_ref\n    dict_map  <- readIORef dict_map_ref\n    putDictionary bh dict_next dict_map\n    log_action (text \"writeBinIface:\" <+> int dict_next\n                                <+> text \"dict entries\")\n\n\n\n-- | Initial ram buffer to allocate for writing interface files\ninitBinMemSize :: Int\ninitBinMemSize = 1024 * 1024\n\nbinaryInterfaceMagic :: DynFlags -> Word32\nbinaryInterfaceMagic dflags\n | target32Bit (targetPlatform dflags) = 0x1face\n | otherwise                           = 0x1face64\n\n\n-- -----------------------------------------------------------------------------\n-- The symbol table\n--\n\nputSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()\nputSymbolTable bh next_off symtab = do\n    put_ bh next_off\n    let names = elems (array (0,next_off-1) (nonDetEltsUFM symtab))\n      -- It's OK to use nonDetEltsUFM here because the elements have\n      -- indices that array uses to create order\n    mapM_ (\\n -> serialiseName bh n symtab) names\n\ngetSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable\ngetSymbolTable bh ncu = do\n    sz <- get bh\n    od_names <- sequence (replicate sz (get bh))\n    updateNameCache ncu $ \\namecache ->\n        runST $ flip State.evalStateT namecache $ do\n            mut_arr <- lift $ newSTArray_ (0, sz-1)\n            for_ (zip [0..] od_names) $ \\(i, odn) -> do\n                (nc, !n) <- State.gets $ \\nc -> fromOnDiskName nc odn\n                lift $ writeArray mut_arr i n\n                State.put nc\n            arr <- lift $ unsafeFreeze mut_arr\n            namecache' <- State.get\n            return (namecache', arr)\n  where\n    -- This binding is required because the type of newArray_ cannot be inferred\n    newSTArray_ :: forall s. (Int, Int) -> ST s (STArray s Int Name)\n    newSTArray_ = newArray_\n\ntype OnDiskName = (UnitId, ModuleName, OccName)\n\nfromOnDiskName :: NameCache -> OnDiskName -> (NameCache, Name)\nfromOnDiskName nc (pid, mod_name, occ) =\n    let mod   = mkModule pid mod_name\n        cache = nsNames nc\n    in case lookupOrigNameCache cache  mod occ of\n           Just name -> (nc, name)\n           Nothing   ->\n               let (uniq, us) = takeUniqFromSupply (nsUniqs nc)\n                   name       = mkExternalName uniq mod occ noSrcSpan\n                   new_cache  = extendNameCache cache mod occ name\n               in ( nc{ nsUniqs = us, nsNames = new_cache }, name )\n\nserialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()\nserialiseName bh name _ = do\n    let mod = ASSERT2( isExternalName name, ppr name ) nameModule name\n    put_ bh (moduleUnitId mod, moduleName mod, nameOccName name)\n\n\n-- Note [Symbol table representation of names]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- An occurrence of a name in an interface file is serialized as a single 32-bit\n-- word. The format of this word is:\n--  00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx\n--   A normal name. x is an index into the symbol table\n--  10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy\n--   A known-key name. x is the Unique's Char, y is the int part. We assume that\n--   all known-key uniques fit in this space. This is asserted by\n--   PrelInfo.knownKeyNamesOkay.\n--\n-- During serialization we check for known-key things using isKnownKeyName.\n-- During deserialization we use lookupKnownKeyName to get from the unique back\n-- to its corresponding Name.\n\n\n-- See Note [Symbol table representation of names]\nputName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO ()\nputName _dict BinSymbolTable{\n               bin_symtab_map = symtab_map_ref,\n               bin_symtab_next = symtab_next }\n        bh name\n  | isKnownKeyName name\n  , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits\n  = -- ASSERT(u < 2^(22 :: Int))\n    put_ bh (0x80000000\n             .|. (fromIntegral (ord c) `shiftL` 22)\n             .|. (fromIntegral u :: Word32))\n\n  | otherwise\n  = do symtab_map <- readIORef symtab_map_ref\n       case lookupUFM symtab_map name of\n         Just (off,_) -> put_ bh (fromIntegral off :: Word32)\n         Nothing -> do\n            off <- readFastMutInt symtab_next\n            -- MASSERT(off < 2^(30 :: Int))\n            writeFastMutInt symtab_next (off+1)\n            writeIORef symtab_map_ref\n                $! addToUFM symtab_map name (off,name)\n            put_ bh (fromIntegral off :: Word32)\n\n-- See Note [Symbol table representation of names]\ngetSymtabName :: NameCacheUpdater\n              -> Dictionary -> SymbolTable\n              -> BinHandle -> IO Name\ngetSymtabName _ncu _dict symtab bh = do\n    i :: Word32 <- get bh\n    case i .&. 0xC0000000 of\n      0x00000000 -> return $! symtab ! fromIntegral i\n\n      0x80000000 ->\n        let\n          tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22))\n          ix  = fromIntegral i .&. 0x003FFFFF\n          u   = mkUnique tag ix\n        in\n          return $! case lookupKnownKeyName u of\n                      Nothing -> pprPanic \"getSymtabName:unknown known-key unique\"\n                                          (ppr i $$ ppr (unpkUnique u))\n                      Just n  -> n\n\n      _ -> pprPanic \"getSymtabName:unknown name tag\" (ppr i)\n\ndata BinSymbolTable = BinSymbolTable {\n        bin_symtab_next :: !FastMutInt, -- The next index to use\n        bin_symtab_map  :: !(IORef (UniqFM (Int,Name)))\n                                -- indexed by Name\n  }\n\nputFastString :: BinDictionary -> BinHandle -> FastString -> IO ()\nputFastString dict bh fs = allocateFastString dict fs >>= put_ bh\n\nallocateFastString :: BinDictionary -> FastString -> IO Word32\nallocateFastString BinDictionary { bin_dict_next = j_r,\n                                   bin_dict_map  = out_r} f = do\n    out <- readIORef out_r\n    let uniq = getUnique f\n    case lookupUFM out uniq of\n        Just (j, _)  -> return (fromIntegral j :: Word32)\n        Nothing -> do\n           j <- readFastMutInt j_r\n           writeFastMutInt j_r (j + 1)\n           writeIORef out_r $! addToUFM out uniq (j, f)\n           return (fromIntegral j :: Word32)\n\ngetDictFastString :: Dictionary -> BinHandle -> IO FastString\ngetDictFastString dict bh = do\n    j <- get bh\n    return $! (dict ! fromIntegral (j :: Word32))\n\ndata BinDictionary = BinDictionary {\n        bin_dict_next :: !FastMutInt, -- The next index to use\n        bin_dict_map  :: !(IORef (UniqFM (Int,FastString)))\n                                -- indexed by FastString\n  }\n\ngetWayDescr :: DynFlags -> String\ngetWayDescr dflags\n  | platformUnregisterised (targetPlatform dflags) = 'u':tag\n  | otherwise                                      =     tag\n  where tag = buildTag dflags\n        -- if this is an unregisterised build, make sure our interfaces\n        -- can't be used by a registerised build.\n", "num_lines": 425}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule BuildTyCl (\n        buildDataCon,\n        buildPatSyn,\n        TcMethInfo, MethInfo, buildClass,\n        mkNewTyConRhs,\n        newImplicitBinder, newTyConRepName\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport IfaceEnv\nimport FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )\nimport TysWiredIn( isCTupleTyConName )\nimport TysPrim ( voidPrimTy )\nimport DataCon\nimport PatSyn\nimport Var\nimport VarSet\nimport BasicTypes\nimport Name\nimport NameEnv\nimport MkId\nimport Class\nimport TyCon\nimport Type\nimport Id\nimport TcType\n\nimport SrcLoc( SrcSpan, noSrcSpan )\nimport DynFlags\nimport TcRnMonad\nimport UniqSupply\nimport Util\nimport Outputable\n\n\nmkNewTyConRhs :: Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs\n-- ^ Monadic because it makes a Name for the coercion TyCon\n--   We pass the Name of the parent TyCon, as well as the TyCon itself,\n--   because the latter is part of a knot, whereas the former is not.\nmkNewTyConRhs tycon_name tycon con\n  = do  { co_tycon_name <- newImplicitBinder tycon_name mkNewTyCoOcc\n        ; let nt_ax = mkNewTypeCoAxiom co_tycon_name tycon etad_tvs etad_roles etad_rhs\n        ; traceIf (text \"mkNewTyConRhs\" <+> ppr nt_ax)\n        ; return (NewTyCon { data_con    = con,\n                             nt_rhs      = rhs_ty,\n                             nt_etad_rhs = (etad_tvs, etad_rhs),\n                             nt_co       = nt_ax } ) }\n                             -- Coreview looks through newtypes with a Nothing\n                             -- for nt_co, or uses explicit coercions otherwise\n  where\n    tvs    = tyConTyVars tycon\n    roles  = tyConRoles tycon\n    con_arg_ty = case dataConRepArgTys con of\n                   [arg_ty] -> arg_ty\n                   tys -> pprPanic \"mkNewTyConRhs\" (ppr con <+> ppr tys)\n    rhs_ty = substTyWith (dataConUnivTyVars con)\n                         (mkTyVarTys tvs) con_arg_ty\n        -- Instantiate the newtype's RHS with the\n        -- type variables from the tycon\n        -- NB: a newtype DataCon has a type that must look like\n        --        forall tvs.  <arg-ty> -> T tvs\n        -- Note that we *can't* use dataConInstOrigArgTys here because\n        -- the newtype arising from   class Foo a => Bar a where {}\n        -- has a single argument (Foo a) that is a *type class*, so\n        -- dataConInstOrigArgTys returns [].\n\n    etad_tvs   :: [TyVar]  -- Matched lazily, so that mkNewTypeCo can\n    etad_roles :: [Role]   -- return a TyCon without pulling on rhs_ty\n    etad_rhs   :: Type     -- See Note [Tricky iface loop] in LoadIface\n    (etad_tvs, etad_roles, etad_rhs) = eta_reduce (reverse tvs) (reverse roles) rhs_ty\n\n    eta_reduce :: [TyVar]       -- Reversed\n               -> [Role]        -- also reversed\n               -> Type          -- Rhs type\n               -> ([TyVar], [Role], Type)  -- Eta-reduced version\n                                           -- (tyvars in normal order)\n    eta_reduce (a:as) (_:rs) ty | Just (fun, arg) <- splitAppTy_maybe ty,\n                                  Just tv <- getTyVar_maybe arg,\n                                  tv == a,\n                                  not (a `elemVarSet` tyCoVarsOfType fun)\n                                = eta_reduce as rs fun\n    eta_reduce tvs rs ty = (reverse tvs, reverse rs, ty)\n\n------------------------------------------------------\nbuildDataCon :: FamInstEnvs\n            -> Name\n            -> Bool                     -- Declared infix\n            -> TyConRepName\n            -> [HsSrcBang]\n            -> Maybe [HsImplBang]\n                -- See Note [Bangs on imported data constructors] in MkId\n           -> [FieldLabel]             -- Field labels\n           -> [TyVar]                  -- Universals\n           -> [TyCoVar]                -- Existentials\n           -> [TyVarBinder]            -- User-written 'TyVarBinder's\n           -> [EqSpec]                 -- Equality spec\n           -> KnotTied ThetaType       -- Does not include the \"stupid theta\"\n                                       -- or the GADT equalities\n           -> [KnotTied Type]          -- Arguments\n           -> KnotTied Type            -- Result types\n           -> KnotTied TyCon           -- Rep tycon\n           -> NameEnv ConTag           -- Maps the Name of each DataCon to its\n                                       -- ConTag\n           -> TcRnIf m n DataCon\n-- A wrapper for DataCon.mkDataCon that\n--   a) makes the worker Id\n--   b) makes the wrapper Id if necessary, including\n--      allocating its unique (hence monadic)\nbuildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs\n             field_lbls univ_tvs ex_tvs user_tvbs eq_spec ctxt arg_tys res_ty\n             rep_tycon tag_map\n  = do  { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc\n        ; work_name <- newImplicitBinder src_name mkDataConWorkerOcc\n        -- This last one takes the name of the data constructor in the source\n        -- code, which (for Haskell source anyway) will be in the DataName name\n        -- space, and puts it into the VarName name space\n\n        ; traceIf (text \"buildDataCon 1\" <+> ppr src_name)\n        ; us <- newUniqueSupply\n        ; dflags <- getDynFlags\n        ; let stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs\n              tag = lookupNameEnv_NF tag_map src_name\n              -- See Note [Constructor tag allocation], fixes #14657\n              data_con = mkDataCon src_name declared_infix prom_info\n                                   src_bangs field_lbls\n                                   univ_tvs ex_tvs user_tvbs eq_spec ctxt\n                                   arg_tys res_ty NoRRI rep_tycon tag\n                                   stupid_ctxt dc_wrk dc_rep\n              dc_wrk = mkDataConWorkId work_name data_con\n              dc_rep = initUs_ us (mkDataConRep dflags fam_envs wrap_name\n                                                impl_bangs data_con)\n\n        ; traceIf (text \"buildDataCon 2\" <+> ppr src_name)\n        ; return data_con }\n\n\n-- The stupid context for a data constructor should be limited to\n-- the type variables mentioned in the arg_tys\n-- ToDo: Or functionally dependent on?\n--       This whole stupid theta thing is, well, stupid.\nmkDataConStupidTheta :: TyCon -> [Type] -> [TyVar] -> [PredType]\nmkDataConStupidTheta tycon arg_tys univ_tvs\n  | null stupid_theta = []      -- The common case\n  | otherwise         = filter in_arg_tys stupid_theta\n  where\n    tc_subst     = zipTvSubst (tyConTyVars tycon)\n                              (mkTyVarTys univ_tvs)\n    stupid_theta = substTheta tc_subst (tyConStupidTheta tycon)\n        -- Start by instantiating the master copy of the\n        -- stupid theta, taken from the TyCon\n\n    arg_tyvars      = tyCoVarsOfTypes arg_tys\n    in_arg_tys pred = not $ isEmptyVarSet $\n                      tyCoVarsOfType pred `intersectVarSet` arg_tyvars\n\n\n------------------------------------------------------\nbuildPatSyn :: Name -> Bool\n            -> (Id,Bool) -> Maybe (Id, Bool)\n            -> ([TyVarBinder], ThetaType) -- ^ Univ and req\n            -> ([TyVarBinder], ThetaType) -- ^ Ex and prov\n            -> [Type]               -- ^ Argument types\n            -> Type                 -- ^ Result type\n            -> [FieldLabel]         -- ^ Field labels for\n                                    --   a record pattern synonym\n            -> PatSyn\nbuildPatSyn src_name declared_infix matcher@(matcher_id,_) builder\n            (univ_tvs, req_theta) (ex_tvs, prov_theta) arg_tys\n            pat_ty field_labels\n  = -- The assertion checks that the matcher is\n    -- compatible with the pattern synonym\n    ASSERT2((and [ univ_tvs `equalLength` univ_tvs1\n                 , ex_tvs `equalLength` ex_tvs1\n                 , pat_ty `eqType` substTy subst pat_ty1\n                 , prov_theta `eqTypes` substTys subst prov_theta1\n                 , req_theta `eqTypes` substTys subst req_theta1\n                 , compareArgTys arg_tys (substTys subst arg_tys1)\n                 ])\n            , (vcat [ ppr univ_tvs <+> twiddle <+> ppr univ_tvs1\n                    , ppr ex_tvs <+> twiddle <+> ppr ex_tvs1\n                    , ppr pat_ty <+> twiddle <+> ppr pat_ty1\n                    , ppr prov_theta <+> twiddle <+> ppr prov_theta1\n                    , ppr req_theta <+> twiddle <+> ppr req_theta1\n                    , ppr arg_tys <+> twiddle <+> ppr arg_tys1]))\n    mkPatSyn src_name declared_infix\n             (univ_tvs, req_theta) (ex_tvs, prov_theta)\n             arg_tys pat_ty\n             matcher builder field_labels\n  where\n    ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id\n    ([pat_ty1, cont_sigma, _], _)      = tcSplitFunTys tau\n    (ex_tvs1, prov_theta1, cont_tau)   = tcSplitSigmaTy cont_sigma\n    (arg_tys1, _) = (tcSplitFunTys cont_tau)\n    twiddle = char '~'\n    subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)\n                       (mkTyVarTys (binderVars (univ_tvs ++ ex_tvs)))\n\n    -- For a nullary pattern synonym we add a single void argument to the\n    -- matcher to preserve laziness in the case of unlifted types.\n    -- See #12746\n    compareArgTys :: [Type] -> [Type] -> Bool\n    compareArgTys [] [x] = x `eqType` voidPrimTy\n    compareArgTys arg_tys matcher_arg_tys = arg_tys `eqTypes` matcher_arg_tys\n\n\n------------------------------------------------------\ntype TcMethInfo = MethInfo  -- this variant needs zonking\ntype MethInfo       -- A temporary intermediate, to communicate\n                    -- between tcClassSigs and buildClass.\n  = ( Name   -- Name of the class op\n    , Type   -- Type of the class op\n    , Maybe (DefMethSpec (SrcSpan, Type)))\n         -- Nothing                    => no default method\n         --\n         -- Just VanillaDM             => There is an ordinary\n         --                               polymorphic default method\n         --\n         -- Just (GenericDM (loc, ty)) => There is a generic default metho\n         --                               Here is its type, and the location\n         --                               of the type signature\n         --    We need that location /only/ to attach it to the\n         --    generic default method's Name; and we need /that/\n         --    only to give the right location of an ambiguity error\n         --    for the generic default method, spat out by checkValidClass\n\nbuildClass :: Name  -- Name of the class/tycon (they have the same Name)\n           -> [TyConBinder]                -- Of the tycon\n           -> [Role]\n           -> [FunDep TyVar]               -- Functional dependencies\n           -- Super classes, associated types, method info, minimal complete def.\n           -- This is Nothing if the class is abstract.\n           -> Maybe (KnotTied ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)\n           -> TcRnIf m n Class\n\nbuildClass tycon_name binders roles fds Nothing\n  = fixM  $ \\ rec_clas ->       -- Only name generation inside loop\n    do  { traceIf (text \"buildClass\")\n\n        ; tc_rep_name  <- newTyConRepName tycon_name\n        ; let univ_tvs = binderVars binders\n              tycon = mkClassTyCon tycon_name binders roles\n                                   AbstractTyCon rec_clas tc_rep_name\n              result = mkAbstractClass tycon_name univ_tvs fds tycon\n        ; traceIf (text \"buildClass\" <+> ppr tycon)\n        ; return result }\n\nbuildClass tycon_name binders roles fds\n           (Just (sc_theta, at_items, sig_stuff, mindef))\n  = fixM  $ \\ rec_clas ->       -- Only name generation inside loop\n    do  { traceIf (text \"buildClass\")\n\n        ; datacon_name <- newImplicitBinder tycon_name mkClassDataConOcc\n        ; tc_rep_name  <- newTyConRepName tycon_name\n\n        ; op_items <- mapM (mk_op_item rec_clas) sig_stuff\n                        -- Build the selector id and default method id\n\n              -- Make selectors for the superclasses\n        ; sc_sel_names <- mapM  (newImplicitBinder tycon_name . mkSuperDictSelOcc)\n                                (takeList sc_theta [fIRST_TAG..])\n        ; let sc_sel_ids = [ mkDictSelId sc_name rec_clas\n                           | sc_name <- sc_sel_names]\n              -- We number off the Dict superclass selectors, 1, 2, 3 etc so that we\n              -- can construct names for the selectors. Thus\n              --      class (C a, C b) => D a b where ...\n              -- gives superclass selectors\n              --      D_sc1, D_sc2\n              -- (We used to call them D_C, but now we can have two different\n              --  superclasses both called C!)\n\n        ; let use_newtype = isSingleton arg_tys\n                -- Use a newtype if the data constructor\n                --   (a) has exactly one value field\n                --       i.e. exactly one operation or superclass taken together\n                --   (b) that value is of lifted type (which they always are, because\n                --       we box equality superclasses)\n                -- See note [Class newtypes and equality predicates]\n\n                -- We treat the dictionary superclasses as ordinary arguments.\n                -- That means that in the case of\n                --     class C a => D a\n                -- we don't get a newtype with no arguments!\n              args       = sc_sel_names ++ op_names\n              op_tys     = [ty | (_,ty,_) <- sig_stuff]\n              op_names   = [op | (op,_,_) <- sig_stuff]\n              arg_tys    = sc_theta ++ op_tys\n              rec_tycon  = classTyCon rec_clas\n              univ_bndrs = tyConTyVarBinders binders\n              univ_tvs   = binderVars univ_bndrs\n\n        ; rep_nm   <- newTyConRepName datacon_name\n        ; dict_con <- buildDataCon (panic \"buildClass: FamInstEnvs\")\n                                   datacon_name\n                                   False        -- Not declared infix\n                                   rep_nm\n                                   (map (const no_bang) args)\n                                   (Just (map (const HsLazy) args))\n                                   [{- No fields -}]\n                                   univ_tvs\n                                   [{- no existentials -}]\n                                   univ_bndrs\n                                   [{- No GADT equalities -}]\n                                   [{- No theta -}]\n                                   arg_tys\n                                   (mkTyConApp rec_tycon (mkTyVarTys univ_tvs))\n                                   rec_tycon\n                                   (mkTyConTagMap rec_tycon)\n\n        ; rhs <- case () of\n                  _ | use_newtype\n                    -> mkNewTyConRhs tycon_name rec_tycon dict_con\n                    | isCTupleTyConName tycon_name\n                    -> return (TupleTyCon { data_con = dict_con\n                                          , tup_sort = ConstraintTuple })\n                    | otherwise\n                    -> return (mkDataTyConRhs [dict_con])\n\n        ; let { tycon = mkClassTyCon tycon_name binders roles\n                                     rhs rec_clas tc_rep_name\n                -- A class can be recursive, and in the case of newtypes\n                -- this matters.  For example\n                --      class C a where { op :: C b => a -> b -> Int }\n                -- Because C has only one operation, it is represented by\n                -- a newtype, and it should be a *recursive* newtype.\n                -- [If we don't make it a recursive newtype, we'll expand the\n                -- newtype like a synonym, but that will lead to an infinite\n                -- type]\n\n              ; result = mkClass tycon_name univ_tvs fds\n                                 sc_theta sc_sel_ids at_items\n                                 op_items mindef tycon\n              }\n        ; traceIf (text \"buildClass\" <+> ppr tycon)\n        ; return result }\n  where\n    no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict\n\n    mk_op_item :: Class -> TcMethInfo -> TcRnIf n m ClassOpItem\n    mk_op_item rec_clas (op_name, _, dm_spec)\n      = do { dm_info <- mk_dm_info op_name dm_spec\n           ; return (mkDictSelId op_name rec_clas, dm_info) }\n\n    mk_dm_info :: Name -> Maybe (DefMethSpec (SrcSpan, Type))\n               -> TcRnIf n m (Maybe (Name, DefMethSpec Type))\n    mk_dm_info _ Nothing\n      = return Nothing\n    mk_dm_info op_name (Just VanillaDM)\n      = do { dm_name <- newImplicitBinder op_name mkDefaultMethodOcc\n           ; return (Just (dm_name, VanillaDM)) }\n    mk_dm_info op_name (Just (GenericDM (loc, dm_ty)))\n      = do { dm_name <- newImplicitBinderLoc op_name mkDefaultMethodOcc loc\n           ; return (Just (dm_name, GenericDM dm_ty)) }\n\n{-\nNote [Class newtypes and equality predicates]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n        class (a ~ F b) => C a b where\n          op :: a -> b\n\nWe cannot represent this by a newtype, even though it's not\nexistential, because there are two value fields (the equality\npredicate and op. See Trac #2238\n\nMoreover,\n          class (a ~ F b) => C a b where {}\nHere we can't use a newtype either, even though there is only\none field, because equality predicates are unboxed, and classes\nare boxed.\n-}\n\nnewImplicitBinder :: Name                       -- Base name\n                  -> (OccName -> OccName)       -- Occurrence name modifier\n                  -> TcRnIf m n Name            -- Implicit name\n-- Called in BuildTyCl to allocate the implicit binders of type/class decls\n-- For source type/class decls, this is the first occurrence\n-- For iface ones, the LoadIface has already allocated a suitable name in the cache\nnewImplicitBinder base_name mk_sys_occ\n  = newImplicitBinderLoc base_name mk_sys_occ (nameSrcSpan base_name)\n\nnewImplicitBinderLoc :: Name                       -- Base name\n                     -> (OccName -> OccName)       -- Occurrence name modifier\n                     -> SrcSpan\n                     -> TcRnIf m n Name            -- Implicit name\n-- Just the same, but lets you specify the SrcSpan\nnewImplicitBinderLoc base_name mk_sys_occ loc\n  | Just mod <- nameModule_maybe base_name\n  = newGlobalBinder mod occ loc\n  | otherwise           -- When typechecking a [d| decl bracket |],\n                        -- TH generates types, classes etc with Internal names,\n                        -- so we follow suit for the implicit binders\n  = do  { uniq <- newUnique\n        ; return (mkInternalName uniq occ loc) }\n  where\n    occ = mk_sys_occ (nameOccName base_name)\n\n-- | Make the 'TyConRepName' for this 'TyCon'\nnewTyConRepName :: Name -> TcRnIf gbl lcl TyConRepName\nnewTyConRepName tc_name\n  | Just mod <- nameModule_maybe tc_name\n  , (mod, occ) <- tyConRepModOcc mod (nameOccName tc_name)\n  = newGlobalBinder mod occ noSrcSpan\n  | otherwise\n  = newImplicitBinder tc_name mkTyConRepOcc\n", "num_lines": 415}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\n-- | This module manages storing the various GHC option flags in a modules\n-- interface file as part of the recompilation checking infrastructure.\nmodule FlagChecker (\n        fingerprintDynFlags\n      , fingerprintOptFlags\n      , fingerprintHpcFlags\n    ) where\n\nimport GhcPrelude\n\nimport Binary\nimport BinIface ()\nimport DynFlags\nimport HscTypes\nimport Module\nimport Name\nimport Fingerprint\nimport BinFingerprint\n-- import Outputable\n\nimport qualified EnumSet\nimport System.FilePath (normalise)\n\n-- | Produce a fingerprint of a @DynFlags@ value. We only base\n-- the finger print on important fields in @DynFlags@ so that\n-- the recompilation checker can use this fingerprint.\n--\n-- NB: The 'Module' parameter is the 'Module' recorded by the\n-- *interface* file, not the actual 'Module' according to our\n-- 'DynFlags'.\nfingerprintDynFlags :: DynFlags -> Module\n                    -> (BinHandle -> Name -> IO ())\n                    -> IO Fingerprint\n\nfingerprintDynFlags dflags@DynFlags{..} this_mod nameio =\n    let mainis   = if mainModIs == this_mod then Just mainFunIs else Nothing\n                      -- see #5878\n        -- pkgopts  = (thisPackage dflags, sort $ packageFlags dflags)\n        safeHs   = setSafeMode safeHaskell\n        -- oflags   = sort $ filter filterOFlags $ flags dflags\n\n        -- *all* the extension flags and the language\n        lang = (fmap fromEnum language,\n                map fromEnum $ EnumSet.toList extensionFlags)\n\n        -- -I, -D and -U flags affect CPP\n        cpp = ( map normalise $ flattenIncludes includePaths\n            -- normalise: eliminate spurious differences due to \"./foo\" vs \"foo\"\n              , picPOpts dflags\n              , opt_P_signature dflags)\n            -- See Note [Repeated -optP hashing]\n\n        -- Note [path flags and recompilation]\n        paths = [ hcSuf ]\n\n        -- -fprof-auto etc.\n        prof = if gopt Opt_SccProfilingOn dflags then fromEnum profAuto else 0\n\n        flags = (mainis, safeHs, lang, cpp, paths, prof)\n\n    in -- pprTrace \"flags\" (ppr flags) $\n       computeFingerprint nameio flags\n\n-- Fingerprint the optimisation info. We keep this separate from the rest of\n-- the flags because GHCi users (especially) may wish to ignore changes in\n-- optimisation level or optimisation flags so as to use as many pre-existing\n-- object files as they can.\n-- See Note [Ignoring some flag changes]\nfingerprintOptFlags :: DynFlags\n                      -> (BinHandle -> Name -> IO ())\n                      -> IO Fingerprint\nfingerprintOptFlags DynFlags{..} nameio =\n      let\n        -- See https://ghc.haskell.org/trac/ghc/ticket/10923\n        -- We used to fingerprint the optimisation level, but as Joachim\n        -- Breitner pointed out in comment 9 on that ticket, it's better\n        -- to ignore that and just look at the individual optimisation flags.\n        opt_flags = map fromEnum $ filter (`EnumSet.member` optimisationFlags)\n                                          (EnumSet.toList generalFlags)\n\n      in computeFingerprint nameio opt_flags\n\n-- Fingerprint the HPC info. We keep this separate from the rest of\n-- the flags because GHCi users (especially) may wish to use an object\n-- file compiled for HPC when not actually using HPC.\n-- See Note [Ignoring some flag changes]\nfingerprintHpcFlags :: DynFlags\n                      -> (BinHandle -> Name -> IO ())\n                      -> IO Fingerprint\nfingerprintHpcFlags dflags@DynFlags{..} nameio =\n      let\n        -- -fhpc, see https://ghc.haskell.org/trac/ghc/ticket/11798\n        -- hpcDir is output-only, so we should recompile if it changes\n        hpc = if gopt Opt_Hpc dflags then Just hpcDir else Nothing\n\n      in computeFingerprint nameio hpc\n\n\n{- Note [path flags and recompilation]\n\nThere are several flags that we deliberately omit from the\nrecompilation check; here we explain why.\n\n-osuf, -odir, -hisuf, -hidir\n  If GHC decides that it does not need to recompile, then\n  it must have found an up-to-date .hi file and .o file.\n  There is no point recording these flags - the user must\n  have passed the correct ones.  Indeed, the user may\n  have compiled the source file in one-shot mode using\n  -o to specify the .o file, and then loaded it in GHCi\n  using -odir.\n\n-stubdir\n  We omit this one because it is automatically set by -outputdir, and\n  we don't want changes in -outputdir to automatically trigger\n  recompilation.  This could be wrong, but only in very rare cases.\n\n-i (importPaths)\n  For the same reason as -osuf etc. above: if GHC decides not to\n  recompile, then it must have already checked all the .hi files on\n  which the current module depends, so it must have found them\n  successfully.  It is occasionally useful to be able to cd to a\n  different directory and use -i flags to enable GHC to find the .hi\n  files; we don't want this to force recompilation.\n\nThe only path-related flag left is -hcsuf.\n-}\n\n{- Note [Ignoring some flag changes]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nNormally, --make tries to reuse only compilation products that are\nthe same as those that would have been produced compiling from\nscratch. Sometimes, however, users would like to be more aggressive\nabout recompilation avoidance. This is particularly likely when\ndeveloping using GHCi (see #13604). Currently, we allow users to\nignore optimisation changes using -fignore-optim-changes, and to\nignore HPC option changes using -fignore-hpc-changes. If there's a\ndemand for it, we could also allow changes to -fprof-auto-* flags\n(although we can't allow -prof flags to differ). The key thing about\nthese options is that we can still successfully link a library or\nexecutable when some of its components differ in these ways.\n\nThe way we accomplish this is to leave the optimization and HPC\noptions out of the flag hash, hashing them separately.\n-}\n\n{- Note [Repeated -optP hashing]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe invoke fingerprintDynFlags for each compiled module to include\nthe hash of relevant DynFlags in the resulting interface file.\n-optP (preprocessor) flags are part of that hash.\n-optP flags can come from multiple places:\n\n  1. -optP flags directly passed on command line.\n  2. -optP flags implied by other flags. Eg. -DPROFILING implied by -prof.\n  3. -optP flags added with {-# OPTIONS -optP-D__F__ #-} in a file.\n\nWhen compiling many modules at once with many -optP command line arguments\nthe work of hashing -optP flags would be repeated. This can get expensive\nand as noted on #14697 it can take 7% of time and 14% of allocations on\na real codebase.\n\nThe obvious solution is to cache the hash of -optP flags per GHC invocation.\nHowever, one has to be careful there, as the flags that were added in 3. way\nhave to be accounted for.\n\nThe current strategy is as follows:\n\n  1. Lazily compute the hash of sOpt_p in sOpt_P_fingerprint whenever sOpt_p\n     is modified. This serves dual purpose. It ensures correctness for when\n     we add per file -optP flags and lets us save work for when we don't.\n  2. When computing the fingerprint in fingerprintDynFlags use the cached\n     value *and* fingerprint the additional implied (see 2. above) -optP flags.\n     This is relatively cheap and saves the headache of fingerprinting all\n     the -optP flags and tracking all the places that could invalidate the\n     cache.\n-}\n", "num_lines": 182}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2002-2006\n\n{-# LANGUAGE CPP, RankNTypes, BangPatterns #-}\n\nmodule IfaceEnv (\n        newGlobalBinder, newInteractiveBinder,\n        externaliseName,\n        lookupIfaceTop,\n        lookupOrig, lookupOrigIO, lookupOrigNameCache, extendNameCache,\n        newIfaceName, newIfaceNames,\n        extendIfaceIdEnv, extendIfaceTyVarEnv,\n        tcIfaceLclId, tcIfaceTyVar, lookupIfaceVar,\n        lookupIfaceTyVar, extendIfaceEnvs,\n        setNameModule,\n\n        ifaceExportNames,\n\n        -- Name-cache stuff\n        allocateGlobalBinder, updNameCacheTc,\n        mkNameCacheUpdater, NameCacheUpdater(..),\n   ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnMonad\nimport HscTypes\nimport Type\nimport Var\nimport Name\nimport Avail\nimport Module\nimport FastString\nimport FastStringEnv\nimport IfaceType\nimport NameCache\nimport UniqSupply\nimport SrcLoc\n\nimport Outputable\nimport Data.List     ( partition )\n\n{-\n*********************************************************\n*                                                      *\n        Allocating new Names in the Name Cache\n*                                                      *\n*********************************************************\n\nSee Also: Note [The Name Cache] in NameCache\n-}\n\nnewGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name\n-- Used for source code and interface files, to make the\n-- Name for a thing, given its Module and OccName\n-- See Note [The Name Cache]\n--\n-- The cache may already already have a binding for this thing,\n-- because we may have seen an occurrence before, but now is the\n-- moment when we know its Module and SrcLoc in their full glory\n\nnewGlobalBinder mod occ loc\n  = do { name <- updNameCacheTc mod occ $ \\name_cache ->\n                 allocateGlobalBinder name_cache mod occ loc\n       ; traceIf (text \"newGlobalBinder\" <+>\n                  (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))\n       ; return name }\n\nnewInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name\n-- Works in the IO monad, and gets the Module\n-- from the interactive context\nnewInteractiveBinder hsc_env occ loc\n = do { let mod = icInteractiveModule (hsc_IC hsc_env)\n       ; updNameCacheIO hsc_env mod occ $ \\name_cache ->\n         allocateGlobalBinder name_cache mod occ loc }\n\nallocateGlobalBinder\n  :: NameCache\n  -> Module -> OccName -> SrcSpan\n  -> (NameCache, Name)\n-- See Note [The Name Cache]\nallocateGlobalBinder name_supply mod occ loc\n  = case lookupOrigNameCache (nsNames name_supply) mod occ of\n        -- A hit in the cache!  We are at the binding site of the name.\n        -- This is the moment when we know the SrcLoc\n        -- of the Name, so we set this field in the Name we return.\n        --\n        -- Then (bogus) multiple bindings of the same Name\n        -- get different SrcLocs can can be reported as such.\n        --\n        -- Possible other reason: it might be in the cache because we\n        --      encountered an occurrence before the binding site for an\n        --      implicitly-imported Name.  Perhaps the current SrcLoc is\n        --      better... but not really: it'll still just say 'imported'\n        --\n        -- IMPORTANT: Don't mess with wired-in names.\n        --            Their wired-in-ness is in their NameSort\n        --            and their Module is correct.\n\n        Just name | isWiredInName name\n                  -> (name_supply, name)\n                  | otherwise\n                  -> (new_name_supply, name')\n                  where\n                    uniq            = nameUnique name\n                    name'           = mkExternalName uniq mod occ loc\n                                      -- name' is like name, but with the right SrcSpan\n                    new_cache       = extendNameCache (nsNames name_supply) mod occ name'\n                    new_name_supply = name_supply {nsNames = new_cache}\n\n        -- Miss in the cache!\n        -- Build a completely new Name, and put it in the cache\n        _ -> (new_name_supply, name)\n                  where\n                    (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)\n                    name            = mkExternalName uniq mod occ loc\n                    new_cache       = extendNameCache (nsNames name_supply) mod occ name\n                    new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}\n\nifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]\nifaceExportNames exports = return exports\n\n-- | A function that atomically updates the name cache given a modifier\n-- function.  The second result of the modifier function will be the result\n-- of the IO action.\nnewtype NameCacheUpdater\n      = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }\n\nmkNameCacheUpdater :: TcRnIf a b NameCacheUpdater\nmkNameCacheUpdater = do { hsc_env <- getTopEnv\n                        ; let !ncRef = hsc_NC hsc_env\n                        ; return (NCU (updNameCache ncRef)) }\n\nupdNameCacheTc :: Module -> OccName -> (NameCache -> (NameCache, c))\n               -> TcRnIf a b c\nupdNameCacheTc mod occ upd_fn = do {\n    hsc_env <- getTopEnv\n  ; liftIO $ updNameCacheIO hsc_env mod occ upd_fn }\n\n\nupdNameCacheIO ::  HscEnv -> Module -> OccName\n               -> (NameCache -> (NameCache, c))\n               -> IO c\nupdNameCacheIO hsc_env mod occ upd_fn = do {\n\n    -- First ensure that mod and occ are evaluated\n    -- If not, chaos can ensue:\n    --      we read the name-cache\n    --      then pull on mod (say)\n    --      which does some stuff that modifies the name cache\n    -- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)\n\n    mod `seq` occ `seq` return ()\n  ; updNameCache (hsc_NC hsc_env) upd_fn }\n\n\n{-\n************************************************************************\n*                                                                      *\n                Name cache access\n*                                                                      *\n************************************************************************\n-}\n\n-- | Look up the 'Name' for a given 'Module' and 'OccName'.\n-- Consider alternatively using 'lookupIfaceTop' if you're in the 'IfL' monad\n-- and 'Module' is simply that of the 'ModIface' you are typechecking.\nlookupOrig :: Module -> OccName -> TcRnIf a b Name\nlookupOrig mod occ\n  = do  { traceIf (text \"lookup_orig\" <+> ppr mod <+> ppr occ)\n\n        ; updNameCacheTc mod occ $ lookupNameCache mod occ }\n\nlookupOrigIO :: HscEnv -> Module -> OccName -> IO Name\nlookupOrigIO hsc_env mod occ\n  = updNameCacheIO hsc_env mod occ $ lookupNameCache mod occ\n\nlookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)\n-- Lookup up the (Module,OccName) in the NameCache\n-- If you find it, return it; if not, allocate a fresh original name and extend\n-- the NameCache.\n-- Reason: this may the first occurrence of (say) Foo.bar we have encountered.\n-- If we need to explore its value we will load Foo.hi; but meanwhile all we\n-- need is a Name for it.\nlookupNameCache mod occ name_cache =\n  case lookupOrigNameCache (nsNames name_cache) mod occ of {\n    Just name -> (name_cache, name);\n    Nothing   ->\n        case takeUniqFromSupply (nsUniqs name_cache) of {\n          (uniq, us) ->\n              let\n                name      = mkExternalName uniq mod occ noSrcSpan\n                new_cache = extendNameCache (nsNames name_cache) mod occ name\n              in (name_cache{ nsUniqs = us, nsNames = new_cache }, name) }}\n\nexternaliseName :: Module -> Name -> TcRnIf m n Name\n-- Take an Internal Name and make it an External one,\n-- with the same unique\nexternaliseName mod name\n  = do { let occ = nameOccName name\n             loc = nameSrcSpan name\n             uniq = nameUnique name\n       ; occ `seq` return ()  -- c.f. seq in newGlobalBinder\n       ; updNameCacheTc mod occ $ \\ ns ->\n         let name' = mkExternalName uniq mod occ loc\n             ns'   = ns { nsNames = extendNameCache (nsNames ns) mod occ name' }\n         in (ns', name') }\n\n-- | Set the 'Module' of a 'Name'.\nsetNameModule :: Maybe Module -> Name -> TcRnIf m n Name\nsetNameModule Nothing n = return n\nsetNameModule (Just m) n =\n    newGlobalBinder m (nameOccName n) (nameSrcSpan n)\n\n{-\n************************************************************************\n*                                                                      *\n                Type variables and local Ids\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceLclId :: FastString -> IfL Id\ntcIfaceLclId occ\n  = do  { lcl <- getLclEnv\n        ; case (lookupFsEnv (if_id_env lcl) occ) of\n            Just ty_var -> return ty_var\n            Nothing     -> failIfM (text \"Iface id out of scope: \" <+> ppr occ)\n        }\n\nextendIfaceIdEnv :: [Id] -> IfL a -> IfL a\nextendIfaceIdEnv ids thing_inside\n  = do  { env <- getLclEnv\n        ; let { id_env' = extendFsEnvList (if_id_env env) pairs\n              ; pairs   = [(occNameFS (getOccName id), id) | id <- ids] }\n        ; setLclEnv (env { if_id_env = id_env' }) thing_inside }\n\n\ntcIfaceTyVar :: FastString -> IfL TyVar\ntcIfaceTyVar occ\n  = do  { lcl <- getLclEnv\n        ; case (lookupFsEnv (if_tv_env lcl) occ) of\n            Just ty_var -> return ty_var\n            Nothing     -> failIfM (text \"Iface type variable out of scope: \" <+> ppr occ)\n        }\n\nlookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe TyVar)\nlookupIfaceTyVar (occ, _)\n  = do  { lcl <- getLclEnv\n        ; return (lookupFsEnv (if_tv_env lcl) occ) }\n\nlookupIfaceVar :: IfaceBndr -> IfL (Maybe TyCoVar)\nlookupIfaceVar (IfaceIdBndr (occ, _))\n  = do  { lcl <- getLclEnv\n        ; return (lookupFsEnv (if_id_env lcl) occ) }\nlookupIfaceVar (IfaceTvBndr (occ, _))\n  = do  { lcl <- getLclEnv\n        ; return (lookupFsEnv (if_tv_env lcl) occ) }\n\nextendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a\nextendIfaceTyVarEnv tyvars thing_inside\n  = do  { env <- getLclEnv\n        ; let { tv_env' = extendFsEnvList (if_tv_env env) pairs\n              ; pairs   = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }\n        ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }\n\nextendIfaceEnvs :: [TyCoVar] -> IfL a -> IfL a\nextendIfaceEnvs tcvs thing_inside\n  = extendIfaceTyVarEnv tvs $\n    extendIfaceIdEnv    cvs $\n    thing_inside\n  where\n    (tvs, cvs) = partition isTyVar tcvs\n\n{-\n************************************************************************\n*                                                                      *\n                Getting from RdrNames to Names\n*                                                                      *\n************************************************************************\n-}\n\n-- | Look up a top-level name from the current Iface module\nlookupIfaceTop :: OccName -> IfL Name\nlookupIfaceTop occ\n  = do  { env <- getLclEnv; lookupOrig (if_mod env) occ }\n\nnewIfaceName :: OccName -> IfL Name\nnewIfaceName occ\n  = do  { uniq <- newUnique\n        ; return $! mkInternalName uniq occ noSrcSpan }\n\nnewIfaceNames :: [OccName] -> IfL [Name]\nnewIfaceNames occs\n  = do  { uniqs <- newUniqueSupply\n        ; return [ mkInternalName uniq occ noSrcSpan\n                 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }\n", "num_lines": 299}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule IfaceSyn (\n        module IfaceType,\n\n        IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),\n        IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,\n        IfaceExpr(..), IfaceAlt, IfaceLetBndr(..), IfaceJoinInfo(..),\n        IfaceBinding(..), IfaceConAlt(..),\n        IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),\n        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,\n        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),\n        IfaceClassBody(..),\n        IfaceBang(..),\n        IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),\n        IfaceAxBranch(..),\n        IfaceTyConParent(..),\n        IfaceCompleteMatch(..),\n\n        -- * Binding names\n        IfaceTopBndr,\n        putIfaceTopBndr, getIfaceTopBndr,\n\n        -- Misc\n        ifaceDeclImplicitBndrs, visibleIfConDecls,\n        ifaceDeclFingerprints,\n\n        -- Free Names\n        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,\n\n        -- Pretty printing\n        pprIfaceExpr,\n        pprIfaceDecl,\n        AltPpr(..), ShowSub(..), ShowHowMuch(..), showToIface, showToHeader\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport IfaceType\nimport BinFingerprint\nimport CoreSyn( IsOrphan, isOrphan )\nimport PprCore()            -- Printing DFunArgs\nimport Demand\nimport Class\nimport FieldLabel\nimport NameSet\nimport CoAxiom ( BranchIndex )\nimport Name\nimport CostCentre\nimport Literal\nimport ForeignCall\nimport Annotations( AnnPayload, AnnTarget )\nimport BasicTypes\nimport Outputable\nimport Module\nimport SrcLoc\nimport Fingerprint\nimport Binary\nimport BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )\nimport Var( VarBndr(..), binderVar )\nimport TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )\nimport Util( dropList, filterByList )\nimport DataCon (SrcStrictness(..), SrcUnpackedness(..))\nimport Lexeme (isLexSym)\n\nimport Control.Monad\nimport System.IO.Unsafe\n\ninfixl 3 &&&\n\n{-\n************************************************************************\n*                                                                      *\n                    Declarations\n*                                                                      *\n************************************************************************\n-}\n\n-- | A binding top-level 'Name' in an interface file (e.g. the name of an\n-- 'IfaceDecl').\ntype IfaceTopBndr = Name\n  -- It's convenient to have a Name in the IfaceSyn, although in each\n  -- case the namespace is implied by the context. However, having an\n  -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints\n  -- very convenient. Moreover, having the key of the binder means that\n  -- we can encode known-key things cleverly in the symbol table. See Note\n  -- [Symbol table representation of Names]\n  --\n  -- We don't serialise the namespace onto the disk though; rather we\n  -- drop it when serialising and add it back in when deserialising.\n\ngetIfaceTopBndr :: BinHandle -> IO IfaceTopBndr\ngetIfaceTopBndr bh = get bh\n\nputIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()\nputIfaceTopBndr bh name =\n    case getUserData bh of\n      UserData{ ud_put_binding_name = put_binding_name } ->\n          --pprTrace \"putIfaceTopBndr\" (ppr name) $\n          put_binding_name bh name\n\ndata IfaceDecl\n  = IfaceId { ifName      :: IfaceTopBndr,\n              ifType      :: IfaceType,\n              ifIdDetails :: IfaceIdDetails,\n              ifIdInfo    :: IfaceIdInfo }\n\n  | IfaceData { ifName       :: IfaceTopBndr,   -- Type constructor\n                ifBinders    :: [IfaceTyConBinder],\n                ifResKind    :: IfaceType,      -- Result kind of type constructor\n                ifCType      :: Maybe CType,    -- C type for CAPI FFI\n                ifRoles      :: [Role],         -- Roles\n                ifCtxt       :: IfaceContext,   -- The \"stupid theta\"\n                ifCons       :: IfaceConDecls,  -- Includes new/data/data family info\n                ifGadtSyntax :: Bool,           -- True <=> declared using\n                                                -- GADT syntax\n                ifParent     :: IfaceTyConParent -- The axiom, for a newtype,\n                                                 -- or data/newtype family instance\n    }\n\n  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor\n                   ifRoles   :: [Role],            -- Roles\n                   ifBinders :: [IfaceTyConBinder],\n                   ifResKind :: IfaceKind,         -- Kind of the *result*\n                   ifSynRhs  :: IfaceType }\n\n  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor\n                   ifResVar  :: Maybe IfLclName,   -- Result variable name, used\n                                                   -- only for pretty-printing\n                                                   -- with --show-iface\n                   ifBinders :: [IfaceTyConBinder],\n                   ifResKind :: IfaceKind,         -- Kind of the *tycon*\n                   ifFamFlav :: IfaceFamTyConFlav,\n                   ifFamInj  :: Injectivity }      -- injectivity information\n\n  | IfaceClass { ifName    :: IfaceTopBndr,             -- Name of the class TyCon\n                 ifRoles   :: [Role],                   -- Roles\n                 ifBinders :: [IfaceTyConBinder],\n                 ifFDs     :: [FunDep IfLclName],       -- Functional dependencies\n                 ifBody    :: IfaceClassBody            -- Methods, superclasses, ATs\n    }\n\n  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name\n                 ifTyCon      :: IfaceTyCon,     -- LHS TyCon\n                 ifRole       :: Role,           -- Role of axiom\n                 ifAxBranches :: [IfaceAxBranch] -- Branches\n    }\n\n  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym\n                  ifPatIsInfix    :: Bool,\n                  ifPatMatcher    :: (IfExtName, Bool),\n                  ifPatBuilder    :: Maybe (IfExtName, Bool),\n                  -- Everything below is redundant,\n                  -- but needed to implement pprIfaceDecl\n                  ifPatUnivBndrs  :: [IfaceForAllBndr],\n                  ifPatExBndrs    :: [IfaceForAllBndr],\n                  ifPatProvCtxt   :: IfaceContext,\n                  ifPatReqCtxt    :: IfaceContext,\n                  ifPatArgs       :: [IfaceType],\n                  ifPatTy         :: IfaceType,\n                  ifFieldLabels   :: [FieldLabel] }\n\n-- See also 'ClassBody'\ndata IfaceClassBody\n  -- Abstract classes don't specify their body; they only occur in @hs-boot@ and\n  -- @hsig@ files.\n  = IfAbstractClass\n  | IfConcreteClass {\n     ifClassCtxt :: IfaceContext,             -- Super classes\n     ifATs       :: [IfaceAT],                -- Associated type families\n     ifSigs      :: [IfaceClassOp],           -- Method signatures\n     ifMinDef    :: BooleanFormula IfLclName  -- Minimal complete definition\n    }\n\ndata IfaceTyConParent\n  = IfNoParent\n  | IfDataInstance\n       IfExtName     -- Axiom name\n       IfaceTyCon    -- Family TyCon (pretty-printing only, not used in TcIface)\n                     -- see Note [Pretty printing via IfaceSyn] in PprTyThing\n       IfaceAppArgs  -- Arguments of the family TyCon\n\ndata IfaceFamTyConFlav\n  = IfaceDataFamilyTyCon                      -- Data family\n  | IfaceOpenSynFamilyTyCon\n  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))\n    -- ^ Name of associated axiom and branches for pretty printing purposes,\n    -- or 'Nothing' for an empty closed family without an axiom\n    -- See Note [Pretty printing via IfaceSyn] in PprTyThing\n  | IfaceAbstractClosedSynFamilyTyCon\n  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only\n\ndata IfaceClassOp\n  = IfaceClassOp IfaceTopBndr\n                 IfaceType                         -- Class op type\n                 (Maybe (DefMethSpec IfaceType))   -- Default method\n                 -- The types of both the class op itself,\n                 -- and the default method, are *not* quantified\n                 -- over the class variables\n\ndata IfaceAT = IfaceAT  -- See Class.ClassATItem\n                  IfaceDecl          -- The associated type declaration\n                  (Maybe IfaceType)  -- Default associated type instance, if any\n\n\n-- This is just like CoAxBranch\ndata IfaceAxBranch = IfaceAxBranch { ifaxbTyVars    :: [IfaceTvBndr]\n                                   , ifaxbEtaTyVars :: [IfaceTvBndr]\n                                   , ifaxbCoVars    :: [IfaceIdBndr]\n                                   , ifaxbLHS       :: IfaceAppArgs\n                                   , ifaxbRoles     :: [Role]\n                                   , ifaxbRHS       :: IfaceType\n                                   , ifaxbIncomps   :: [BranchIndex] }\n                                     -- See Note [Storing compatibility] in CoAxiom\n\ndata IfaceConDecls\n  = IfAbstractTyCon     -- c.f TyCon.AbstractTyCon\n  | IfDataTyCon [IfaceConDecl] -- Data type decls\n  | IfNewTyCon  IfaceConDecl   -- Newtype decls\n\n-- For IfDataTyCon and IfNewTyCon we store:\n--  * the data constructor(s);\n-- The field labels are stored individually in the IfaceConDecl\n-- (there is some redundancy here, because a field label may occur\n-- in multiple IfaceConDecls and represent the same field label)\n\ndata IfaceConDecl\n  = IfCon {\n        ifConName    :: IfaceTopBndr,                -- Constructor name\n        ifConWrapper :: Bool,                   -- True <=> has a wrapper\n        ifConInfix   :: Bool,                   -- True <=> declared infix\n\n        -- The universal type variables are precisely those\n        -- of the type constructor of this data constructor\n        -- This is *easy* to guarantee when creating the IfCon\n        -- but it's not so easy for the original TyCon/DataCon\n        -- So this guarantee holds for IfaceConDecl, but *not* for DataCon\n\n        ifConExTCvs   :: [IfaceBndr],  -- Existential ty/covars\n        ifConUserTvBinders :: [IfaceForAllBndr],\n          -- The tyvars, in the order the user wrote them\n          -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the\n          --            set of tyvars (*not* covars) of ifConExTCvs, unioned\n          --            with the set of ifBinders (from the parent IfaceDecl)\n          --            whose tyvars do not appear in ifConEqSpec\n          -- See Note [DataCon user type variable binders] in DataCon\n        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints\n        ifConCtxt    :: IfaceContext,       -- Non-stupid context\n        ifConArgTys  :: [IfaceType],        -- Arg types\n        ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)\n        ifConStricts :: [IfaceBang],\n          -- Empty (meaning all lazy),\n          -- or 1-1 corresp with arg tys\n          -- See Note [Bangs on imported data constructors] in MkId\n        ifConSrcStricts :: [IfaceSrcBang] } -- empty meaning no src stricts\n\ntype IfaceEqSpec = [(IfLclName,IfaceType)]\n\n-- | This corresponds to an HsImplBang; that is, the final\n-- implementation decision about the data constructor arg\ndata IfaceBang\n  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion\n\n-- | This corresponds to HsSrcBang\ndata IfaceSrcBang\n  = IfSrcBang SrcUnpackedness SrcStrictness\n\ndata IfaceClsInst\n  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with\n                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst\n                   ifDFun     :: IfExtName,                -- The dfun\n                   ifOFlag    :: OverlapFlag,              -- Overlap flag\n                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv\n        -- There's always a separate IfaceDecl for the DFun, which gives\n        -- its IdInfo with its full type and version number.\n        -- The instance declarations taken together have a version number,\n        -- and we don't want that to wobble gratuitously\n        -- If this instance decl is *used*, we'll record a usage on the dfun;\n        -- and if the head does not change it won't be used if it wasn't before\n\n-- The ifFamInstTys field of IfaceFamInst contains a list of the rough\n-- match types\ndata IfaceFamInst\n  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name\n                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above\n                 , ifFamInstAxiom    :: IfExtName            -- The axiom\n                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst\n                 }\n\ndata IfaceRule\n  = IfaceRule {\n        ifRuleName   :: RuleName,\n        ifActivation :: Activation,\n        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars\n        ifRuleHead   :: IfExtName,      -- Head of lhs\n        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS\n        ifRuleRhs    :: IfaceExpr,\n        ifRuleAuto   :: Bool,\n        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst\n    }\n\ndata IfaceAnnotation\n  = IfaceAnnotation {\n        ifAnnotatedTarget :: IfaceAnnTarget,\n        ifAnnotatedValue  :: AnnPayload\n  }\n\ntype IfaceAnnTarget = AnnTarget OccName\n\ndata IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName\n\ninstance Outputable IfaceCompleteMatch where\n  ppr (IfaceCompleteMatch cls ty) = text \"COMPLETE\" <> colon <+> ppr cls\n                                                    <+> dcolon <+> ppr ty\n\n\n\n\n-- Here's a tricky case:\n--   * Compile with -O module A, and B which imports A.f\n--   * Change function f in A, and recompile without -O\n--   * When we read in old A.hi we read in its IdInfo (as a thunk)\n--      (In earlier GHCs we used to drop IdInfo immediately on reading,\n--       but we do not do that now.  Instead it's discarded when the\n--       ModIface is read into the various decl pools.)\n--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)\n--      and so gives a new version.\n\ndata IfaceIdInfo\n  = NoInfo                      -- When writing interface file without -O\n  | HasInfo [IfaceInfoItem]     -- Has info, and here it is\n\ndata IfaceInfoItem\n  = HsArity         Arity\n  | HsStrictness    StrictSig\n  | HsInline        InlinePragma\n  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true\n                    IfaceUnfolding   -- See Note [Expose recursive functions]\n  | HsNoCafRefs\n  | HsLevity                         -- Present <=> never levity polymorphic\n\n-- NB: Specialisations and rules come in separately and are\n-- only later attached to the Id.  Partial reason: some are orphans.\n\ndata IfaceUnfolding\n  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding\n                                -- Possibly could eliminate the Bool here, the information\n                                -- is also in the InlinePragma.\n\n  | IfCompulsory IfaceExpr      -- Only used for default methods, in fact\n\n  | IfInlineRule Arity          -- INLINE pragmas\n                 Bool           -- OK to inline even if *un*-saturated\n                 Bool           -- OK to inline even if context is boring\n                 IfaceExpr\n\n  | IfDFunUnfold [IfaceBndr] [IfaceExpr]\n\n\n-- We only serialise the IdDetails of top-level Ids, and even then\n-- we only need a very limited selection.  Notably, none of the\n-- implicit ones are needed here, because they are not put it\n-- interface files\n\ndata IfaceIdDetails\n  = IfVanillaId\n  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool\n  | IfDFunId\n\n{-\nNote [Versioning of instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]\n\n\n************************************************************************\n*                                                                      *\n                Functions over declarations\n*                                                                      *\n************************************************************************\n-}\n\nvisibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]\nvisibleIfConDecls IfAbstractTyCon  = []\nvisibleIfConDecls (IfDataTyCon cs) = cs\nvisibleIfConDecls (IfNewTyCon c)   = [c]\n\nifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]\n--  *Excludes* the 'main' name, but *includes* the implicitly-bound names\n-- Deeply revolting, because it has to predict what gets bound,\n-- especially the question of whether there's a wrapper for a datacon\n-- See Note [Implicit TyThings] in HscTypes\n\n-- N.B. the set of names returned here *must* match the set of\n-- TyThings returned by HscTypes.implicitTyThings, in the sense that\n-- TyThing.getOccName should define a bijection between the two lists.\n-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])\n-- The order of the list does not matter.\n\nifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })\n  = case cons of\n      IfAbstractTyCon -> []\n      IfNewTyCon  cd  -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd\n      IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds\n\nifaceDeclImplicitBndrs (IfaceClass { ifBody = IfAbstractClass })\n  = []\n\nifaceDeclImplicitBndrs (IfaceClass { ifName = cls_tc_name\n                                   , ifBody = IfConcreteClass {\n                                        ifClassCtxt = sc_ctxt,\n                                        ifSigs      = sigs,\n                                        ifATs       = ats\n                                     }})\n  = --   (possibly) newtype coercion\n    co_occs ++\n    --    data constructor (DataCon namespace)\n    --    data worker (Id namespace)\n    --    no wrapper (class dictionaries never have a wrapper)\n    [dc_occ, dcww_occ] ++\n    -- associated types\n    [occName (ifName at) | IfaceAT at _ <- ats ] ++\n    -- superclass selectors\n    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++\n    -- operation selectors\n    [occName op | IfaceClassOp op  _ _ <- sigs]\n  where\n    cls_tc_occ = occName cls_tc_name\n    n_ctxt = length sc_ctxt\n    n_sigs = length sigs\n    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]\n            | otherwise  = []\n    dcww_occ = mkDataConWorkerOcc dc_occ\n    dc_occ = mkClassDataConOcc cls_tc_occ\n    is_newtype = n_sigs + n_ctxt == 1 -- Sigh (keep this synced with buildClass)\n\nifaceDeclImplicitBndrs _ = []\n\nifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]\nifaceConDeclImplicitBndrs (IfCon {\n        ifConWrapper = has_wrapper, ifConName = con_name })\n  = [occName con_name, work_occ] ++ wrap_occs\n  where\n    con_occ = occName con_name\n    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace\n    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace\n              | otherwise   = []\n\n-- -----------------------------------------------------------------------------\n-- The fingerprints of an IfaceDecl\n\n       -- We better give each name bound by the declaration a\n       -- different fingerprint!  So we calculate the fingerprint of\n       -- each binder by combining the fingerprint of the whole\n       -- declaration with the name of the binder. (#5614, #7215)\nifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)]\nifaceDeclFingerprints hash decl\n  = (getOccName decl, hash) :\n    [ (occ, computeFingerprint' (hash,occ))\n    | occ <- ifaceDeclImplicitBndrs decl ]\n  where\n     computeFingerprint' =\n       unsafeDupablePerformIO\n        . computeFingerprint (panic \"ifaceDeclFingerprints\")\n\n{-\n************************************************************************\n*                                                                      *\n                Expressions\n*                                                                      *\n************************************************************************\n-}\n\ndata IfaceExpr\n  = IfaceLcl    IfLclName\n  | IfaceExt    IfExtName\n  | IfaceType   IfaceType\n  | IfaceCo     IfaceCoercion\n  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted\n  | IfaceLam    IfaceLamBndr IfaceExpr\n  | IfaceApp    IfaceExpr IfaceExpr\n  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]\n  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]\n  | IfaceLet    IfaceBinding  IfaceExpr\n  | IfaceCast   IfaceExpr IfaceCoercion\n  | IfaceLit    Literal\n  | IfaceFCall  ForeignCall IfaceType\n  | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E\n\ndata IfaceTickish\n  = IfaceHpcTick Module Int                -- from HpcTick x\n  | IfaceSCC     CostCentre Bool Bool      -- from ProfNote\n  | IfaceSource  RealSrcSpan String        -- from SourceNote\n  -- no breakpoints: we never export these into interface files\n\ntype IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)\n        -- Note: IfLclName, not IfaceBndr (and same with the case binder)\n        -- We reconstruct the kind/type of the thing from the context\n        -- thus saving bulk in interface files\n\ndata IfaceConAlt = IfaceDefault\n                 | IfaceDataAlt IfExtName\n                 | IfaceLitAlt Literal\n\ndata IfaceBinding\n  = IfaceNonRec IfaceLetBndr IfaceExpr\n  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]\n\n-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too\n-- It's used for *non-top-level* let/rec binders\n-- See Note [IdInfo on nested let-bindings]\ndata IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo\n\ndata IfaceJoinInfo = IfaceNotJoinPoint\n                   | IfaceJoinPoint JoinArity\n\n{-\nNote [Empty case alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn IfaceSyn an IfaceCase does not record the types of the alternatives,\nunlike CorSyn Case.  But we need this type if the alternatives are empty.\nHence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.\n\nNote [Expose recursive functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor supercompilation we want to put *all* unfoldings in the interface\nfile, even for functions that are recursive (or big).  So we need to\nknow when an unfolding belongs to a loop-breaker so that we can refrain\nfrom inlining it (except during supercompilation).\n\nNote [IdInfo on nested let-bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOccasionally we want to preserve IdInfo on nested let bindings. The one\nthat came up was a NOINLINE pragma on a let-binding inside an INLINE\nfunction.  The user (Duncan Coutts) really wanted the NOINLINE control\nto cross the separate compilation boundary.\n\nIn general we retain all info that is left by CoreTidy.tidyLetBndr, since\nthat is what is seen by importing module with --make\n\n\n************************************************************************\n*                                                                      *\n              Printing IfaceDecl\n*                                                                      *\n************************************************************************\n-}\n\npprAxBranch :: SDoc -> IfaceAxBranch -> SDoc\n-- The TyCon might be local (just an OccName), or this might\n-- be a branch for an imported TyCon, so it would be an ExtName\n-- So it's easier to take an SDoc here\n--\n-- This function is used\n--    to print interface files,\n--    in debug messages\n--    in :info F for GHCi, which goes via toConToIfaceDecl on the family tycon\n-- For user error messages we use Coercion.pprCoAxiom and friends\npprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs\n                                 , ifaxbCoVars = _cvs\n                                 , ifaxbLHS = pat_tys\n                                 , ifaxbRHS = rhs\n                                 , ifaxbIncomps = incomps })\n  = WARN( not (null _cvs), pp_tc $$ ppr _cvs )\n    hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))\n    $+$\n    nest 2 maybe_incomps\n  where\n    -- See Note [Printing foralls in type family instances] in IfaceType\n    ppr_binders = pprUserIfaceForAll $ map (mkIfaceForAllTvBndr Specified) tvs\n    pp_lhs = hang pp_tc 2 (pprParendIfaceAppArgs pat_tys)\n    maybe_incomps = ppUnless (null incomps) $ parens $\n                    text \"incompatible indices:\" <+> ppr incomps\n\ninstance Outputable IfaceAnnotation where\n  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value\n\ninstance NamedThing IfaceClassOp where\n  getName (IfaceClassOp n _ _) = n\n\ninstance HasOccName IfaceClassOp where\n  occName = getOccName\n\ninstance NamedThing IfaceConDecl where\n  getName = ifConName\n\ninstance HasOccName IfaceConDecl where\n  occName = getOccName\n\ninstance NamedThing IfaceDecl where\n  getName = ifName\n\ninstance HasOccName IfaceDecl where\n  occName = getOccName\n\ninstance Outputable IfaceDecl where\n  ppr = pprIfaceDecl showToIface\n\n{-\nNote [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe minimal complete definition should only be included if a complete\nclass definition is shown. Since the minimal complete definition is\nanonymous we can't reuse the same mechanism that is used for the\nfiltering of method signatures. Instead we just check if anything at all is\nfiltered and hide it in that case.\n-}\n\ndata ShowSub\n  = ShowSub\n      { ss_how_much :: ShowHowMuch\n      , ss_forall :: ShowForAllFlag }\n\n-- See Note [Printing IfaceDecl binders]\n-- The alternative pretty printer referred to in the note.\nnewtype AltPpr = AltPpr (Maybe (OccName -> SDoc))\n\ndata ShowHowMuch\n  = ShowHeader AltPpr -- ^Header information only, not rhs\n  | ShowSome [OccName] AltPpr\n  -- ^ Show only some sub-components. Specifically,\n  --\n  -- [@[]@] Print all sub-components.\n  -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@;\n  -- elide other sub-components to @...@\n  -- May 14: the list is max 1 element long at the moment\n  | ShowIface\n  -- ^Everything including GHC-internal information (used in --show-iface)\n\n{-\nNote [Printing IfaceDecl binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe binders in an IfaceDecl are just OccNames, so we don't know what module they\ncome from.  But when we pretty-print a TyThing by converting to an IfaceDecl\n(see PprTyThing), the TyThing may come from some other module so we really need\nthe module qualifier.  We solve this by passing in a pretty-printer for the\nbinders.\n\nWhen printing an interface file (--show-iface), we want to print\neverything unqualified, so we can just print the OccName directly.\n-}\n\ninstance Outputable ShowHowMuch where\n  ppr (ShowHeader _)    = text \"ShowHeader\"\n  ppr ShowIface         = text \"ShowIface\"\n  ppr (ShowSome occs _) = text \"ShowSome\" <+> ppr occs\n\nshowToHeader :: ShowSub\nshowToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing\n                       , ss_forall = ShowForAllWhen }\n\nshowToIface :: ShowSub\nshowToIface = ShowSub { ss_how_much = ShowIface\n                      , ss_forall = ShowForAllWhen }\n\nppShowIface :: ShowSub -> SDoc -> SDoc\nppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc\nppShowIface _                                     _   = Outputable.empty\n\n-- show if all sub-components or the complete interface is shown\nppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]\nppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc\nppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc\nppShowAllSubs _                                         _   = Outputable.empty\n\nppShowRhs :: ShowSub -> SDoc -> SDoc\nppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty\nppShowRhs _                                        doc = doc\n\nshowSub :: HasOccName n => ShowSub -> n -> Bool\nshowSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False\nshowSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing\nshowSub (ShowSub { ss_how_much = _ })              _     = True\n\nppr_trim :: [Maybe SDoc] -> [SDoc]\n-- Collapse a group of Nothings to a single \"...\"\nppr_trim xs\n  = snd (foldr go (False, []) xs)\n  where\n    go (Just doc) (_,     so_far) = (False, doc : so_far)\n    go Nothing    (True,  so_far) = (True, so_far)\n    go Nothing    (False, so_far) = (True, text \"...\" : so_far)\n\nisIfaceDataInstance :: IfaceTyConParent -> Bool\nisIfaceDataInstance IfNoParent = False\nisIfaceDataInstance _          = True\n\npprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc\npprClassRoles ss clas binders roles =\n    pprRoles (== Nominal)\n             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))\n             binders\n             roles\n\npprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc\n-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi\n--     See Note [Pretty-printing TyThings] in PprTyThing\npprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,\n                             ifCtxt = context, ifResKind = kind,\n                             ifRoles = roles, ifCons = condecls,\n                             ifParent = parent,\n                             ifGadtSyntax = gadt,\n                             ifBinders = binders })\n\n  | gadt      = vcat [ pp_roles\n                     , pp_nd <+> pp_lhs <+> pp_kind <+> pp_where\n                     , nest 2 (vcat pp_cons)\n                     , nest 2 $ ppShowIface ss pp_extra ]\n  | otherwise = vcat [ pp_roles\n                     , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)\n                     , nest 2 $ ppShowIface ss pp_extra ]\n  where\n    is_data_instance = isIfaceDataInstance parent\n    -- See Note [Printing foralls in type family instances] in IfaceType\n    pp_data_inst_forall :: SDoc\n    pp_data_inst_forall = pprUserIfaceForAll forall_bndrs\n\n    forall_bndrs :: [IfaceForAllBndr]\n    forall_bndrs = [Bndr (binderVar tc_bndr) Specified | tc_bndr <- binders]\n\n    cons       = visibleIfConDecls condecls\n    pp_where   = ppWhen (gadt && not (null cons)) $ text \"where\"\n    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]\n    pp_kind\n      | isIfaceLiftedTypeKind kind = empty\n      | otherwise = dcolon <+> ppr kind\n\n    pp_lhs = case parent of\n               IfNoParent -> pprIfaceDeclHead context ss tycon binders Nothing\n               IfDataInstance{}\n                          -> text \"instance\" <+> pp_data_inst_forall\n                                             <+> pprIfaceTyConParent parent\n\n    pp_roles\n      | is_data_instance = empty\n      | otherwise        = pprRoles (== Representational)\n                                    (pprPrefixIfDeclBndr\n                                        (ss_how_much ss)\n                                        (occName tycon))\n                                    binders roles\n            -- Don't display roles for data family instances (yet)\n            -- See discussion on Trac #8672.\n\n    add_bars []     = Outputable.empty\n    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)\n\n    ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)\n\n    show_con dc\n      | ok_con dc = Just $ pprIfaceConDecl ss gadt tycon binders parent dc\n      | otherwise = Nothing\n\n    pp_nd = case condecls of\n              IfAbstractTyCon{} -> text \"data\"\n              IfDataTyCon{}     -> text \"data\"\n              IfNewTyCon{}      -> text \"newtype\"\n\n    pp_extra = vcat [pprCType ctype]\n\npprIfaceDecl ss (IfaceClass { ifName  = clas\n                            , ifRoles = roles\n                            , ifFDs    = fds\n                            , ifBinders = binders\n                            , ifBody = IfAbstractClass })\n  = vcat [ pprClassRoles ss clas binders roles\n         , text \"class\" <+> pprIfaceDeclHead [] ss clas binders Nothing\n                                <+> pprFundeps fds ]\n\npprIfaceDecl ss (IfaceClass { ifName  = clas\n                            , ifRoles = roles\n                            , ifFDs    = fds\n                            , ifBinders = binders\n                            , ifBody = IfConcreteClass {\n                                ifATs = ats,\n                                ifSigs = sigs,\n                                ifClassCtxt = context,\n                                ifMinDef = minDef\n                              }})\n  = vcat [ pprClassRoles ss clas binders roles\n         , text \"class\" <+> pprIfaceDeclHead context ss clas binders Nothing\n                                <+> pprFundeps fds <+> pp_where\n         , nest 2 (vcat [ vcat asocs, vcat dsigs\n                        , ppShowAllSubs ss (pprMinDef minDef)])]\n    where\n      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text \"where\")\n\n      asocs = ppr_trim $ map maybeShowAssoc ats\n      dsigs = ppr_trim $ map maybeShowSig sigs\n\n      maybeShowAssoc :: IfaceAT -> Maybe SDoc\n      maybeShowAssoc asc@(IfaceAT d _)\n        | showSub ss d = Just $ pprIfaceAT ss asc\n        | otherwise    = Nothing\n\n      maybeShowSig :: IfaceClassOp -> Maybe SDoc\n      maybeShowSig sg\n        | showSub ss sg = Just $  pprIfaceClassOp ss sg\n        | otherwise     = Nothing\n\n      pprMinDef :: BooleanFormula IfLclName -> SDoc\n      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions\n        text \"{-# MINIMAL\" <+>\n        pprBooleanFormula\n          (\\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>\n        text \"#-}\"\n\npprIfaceDecl ss (IfaceSynonym { ifName    = tc\n                              , ifBinders = binders\n                              , ifSynRhs  = mono_ty\n                              , ifResKind = res_kind})\n  = hang (text \"type\" <+> pprIfaceDeclHead [] ss tc binders Nothing <+> equals)\n       2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau\n              , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ])\n  where\n    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty\n\npprIfaceDecl ss (IfaceFamily { ifName = tycon\n                             , ifFamFlav = rhs, ifBinders = binders\n                             , ifResKind = res_kind\n                             , ifResVar = res_var, ifFamInj = inj })\n  | IfaceDataFamilyTyCon <- rhs\n  = text \"data family\" <+> pprIfaceDeclHead [] ss tycon binders Nothing\n\n  | otherwise\n  = hang (text \"type family\"\n            <+> pprIfaceDeclHead [] ss tycon binders (Just res_kind)\n            <+> ppShowRhs ss (pp_where rhs))\n       2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))\n    $$\n    nest 2 (ppShowRhs ss (pp_branches rhs))\n  where\n    pp_where (IfaceClosedSynFamilyTyCon {}) = text \"where\"\n    pp_where _                              = empty\n\n    pp_inj Nothing    _   = empty\n    pp_inj (Just res) inj\n       | Injective injectivity <- inj = hsep [ equals, ppr res\n                                             , pp_inj_cond res injectivity]\n       | otherwise = hsep [ equals, ppr res ]\n\n    pp_inj_cond res inj = case filterByList inj binders of\n       []  -> empty\n       tvs -> hsep [vbar, ppr res, text \"->\", interppSP (map ifTyConBinderName tvs)]\n\n    pp_rhs IfaceDataFamilyTyCon\n      = ppShowIface ss (text \"data\")\n    pp_rhs IfaceOpenSynFamilyTyCon\n      = ppShowIface ss (text \"open\")\n    pp_rhs IfaceAbstractClosedSynFamilyTyCon\n      = ppShowIface ss (text \"closed, abstract\")\n    pp_rhs (IfaceClosedSynFamilyTyCon {})\n      = empty  -- see pp_branches\n    pp_rhs IfaceBuiltInSynFamTyCon\n      = ppShowIface ss (text \"built-in\")\n\n    pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))\n      = vcat (map (pprAxBranch\n                     (pprPrefixIfDeclBndr\n                       (ss_how_much ss)\n                       (occName tycon))\n                  ) brs)\n        $$ ppShowIface ss (text \"axiom\" <+> ppr ax)\n    pp_branches _ = Outputable.empty\n\npprIfaceDecl _ (IfacePatSyn { ifName = name,\n                              ifPatUnivBndrs = univ_bndrs, ifPatExBndrs = ex_bndrs,\n                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,\n                              ifPatArgs = arg_tys,\n                              ifPatTy = pat_ty} )\n  = sdocWithDynFlags mk_msg\n  where\n    mk_msg dflags\n      = hang (text \"pattern\" <+> pprPrefixOcc name)\n           2 (dcolon <+> sep [univ_msg\n                             , pprIfaceContextArr req_ctxt\n                             , ppWhen insert_empty_ctxt $ parens empty <+> darrow\n                             , ex_msg\n                             , pprIfaceContextArr prov_ctxt\n                             , pprIfaceType $ foldr (IfaceFunTy VisArg) pat_ty arg_tys ])\n      where\n        univ_msg = pprUserIfaceForAll univ_bndrs\n        ex_msg   = pprUserIfaceForAll ex_bndrs\n\n        insert_empty_ctxt = null req_ctxt\n            && not (null prov_ctxt && isEmpty dflags ex_msg)\n\npprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,\n                              ifIdDetails = details, ifIdInfo = info })\n  = vcat [ hang (pprPrefixIfDeclBndr (ss_how_much ss) (occName var) <+> dcolon)\n              2 (pprIfaceSigmaType (ss_forall ss) ty)\n         , ppShowIface ss (ppr details)\n         , ppShowIface ss (ppr info) ]\n\npprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon\n                           , ifAxBranches = branches })\n  = hang (text \"axiom\" <+> ppr name <+> dcolon)\n       2 (vcat $ map (pprAxBranch (ppr tycon)) branches)\n\npprCType :: Maybe CType -> SDoc\npprCType Nothing      = Outputable.empty\npprCType (Just cType) = text \"C type:\" <+> ppr cType\n\n-- if, for each role, suppress_if role is True, then suppress the role\n-- output\npprRoles :: (Role -> Bool) -> SDoc -> [IfaceTyConBinder]\n         -> [Role] -> SDoc\npprRoles suppress_if tyCon bndrs roles\n  = sdocWithDynFlags $ \\dflags ->\n      let froles = suppressIfaceInvisibles dflags bndrs roles\n      in ppUnless (all suppress_if froles || null froles) $\n         text \"type role\" <+> tyCon <+> hsep (map ppr froles)\n\npprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc\npprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name\n  = pprInfixVar (isSymOcc name) (ppr_bndr name)\npprInfixIfDeclBndr _ name\n  = pprInfixVar (isSymOcc name) (ppr name)\n\npprPrefixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc\npprPrefixIfDeclBndr (ShowHeader (AltPpr (Just ppr_bndr))) name\n  = parenSymOcc name (ppr_bndr name)\npprPrefixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name\n  = parenSymOcc name (ppr_bndr name)\npprPrefixIfDeclBndr _ name\n  = parenSymOcc name (ppr name)\n\ninstance Outputable IfaceClassOp where\n   ppr = pprIfaceClassOp showToIface\n\npprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc\npprIfaceClassOp ss (IfaceClassOp n ty dm)\n  = pp_sig n ty $$ generic_dm\n  where\n   generic_dm | Just (GenericDM dm_ty) <- dm\n              =  text \"default\" <+> pp_sig n dm_ty\n              | otherwise\n              = empty\n   pp_sig n ty\n     = pprPrefixIfDeclBndr (ss_how_much ss) (occName n)\n     <+> dcolon\n     <+> pprIfaceSigmaType ShowForAllWhen ty\n\ninstance Outputable IfaceAT where\n   ppr = pprIfaceAT showToIface\n\npprIfaceAT :: ShowSub -> IfaceAT -> SDoc\npprIfaceAT ss (IfaceAT d mb_def)\n  = vcat [ pprIfaceDecl ss d\n         , case mb_def of\n              Nothing  -> Outputable.empty\n              Just rhs -> nest 2 $\n                          text \"Default:\" <+> ppr rhs ]\n\ninstance Outputable IfaceTyConParent where\n  ppr p = pprIfaceTyConParent p\n\npprIfaceTyConParent :: IfaceTyConParent -> SDoc\npprIfaceTyConParent IfNoParent\n  = Outputable.empty\npprIfaceTyConParent (IfDataInstance _ tc tys)\n  = pprIfaceTypeApp topPrec tc tys\n\npprIfaceDeclHead :: IfaceContext -> ShowSub -> Name\n                 -> [IfaceTyConBinder]   -- of the tycon, for invisible-suppression\n                 -> Maybe IfaceKind\n                 -> SDoc\npprIfaceDeclHead context ss tc_occ bndrs m_res_kind\n  = sdocWithDynFlags $ \\ dflags ->\n    sep [ pprIfaceContextArr context\n        , pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ)\n          <+> pprIfaceTyConBinders (suppressIfaceInvisibles dflags bndrs bndrs)\n        , maybe empty (\\res_kind -> dcolon <+> pprIfaceType res_kind) m_res_kind ]\n\npprIfaceConDecl :: ShowSub -> Bool\n                -> IfaceTopBndr\n                -> [IfaceTyConBinder]\n                -> IfaceTyConParent\n                -> IfaceConDecl -> SDoc\npprIfaceConDecl ss gadt_style tycon tc_binders parent\n        (IfCon { ifConName = name, ifConInfix = is_infix,\n                 ifConUserTvBinders = user_tvbs,\n                 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,\n                 ifConStricts = stricts, ifConFields = fields })\n  | gadt_style = pp_prefix_con <+> dcolon <+> ppr_gadt_ty\n  | otherwise  = ppr_ex_quant pp_h98_con\n  where\n    pp_h98_con\n      | not (null fields) = pp_prefix_con <+> pp_field_args\n      | is_infix\n      , [ty1, ty2] <- pp_args\n      = sep [ ty1\n            , pprInfixIfDeclBndr how_much (occName name)\n            , ty2]\n      | otherwise = pp_prefix_con <+> sep pp_args\n\n    how_much = ss_how_much ss\n    tys_w_strs :: [(IfaceBang, IfaceType)]\n    tys_w_strs = zip stricts arg_tys\n    pp_prefix_con = pprPrefixIfDeclBndr how_much (occName name)\n\n    -- If we're pretty-printing a H98-style declaration with existential\n    -- quantification, then user_tvbs will always consist of the universal\n    -- tyvar binders followed by the existential tyvar binders. So to recover\n    -- the visibilities of the existential tyvar binders, we can simply drop\n    -- the universal tyvar binders from user_tvbs.\n    ex_tvbs = dropList tc_binders user_tvbs\n    ppr_ex_quant = pprIfaceForAllPartMust ex_tvbs ctxt\n    pp_gadt_res_ty = mk_user_con_res_ty eq_spec\n    ppr_gadt_ty = pprIfaceForAllPart user_tvbs ctxt pp_tau\n\n        -- A bit gruesome this, but we can't form the full con_tau, and ppr it,\n        -- because we don't have a Name for the tycon, only an OccName\n    pp_tau | null fields\n           = case pp_args ++ [pp_gadt_res_ty] of\n                (t:ts) -> fsep (t : map (arrow <+>) ts)\n                []     -> panic \"pp_con_taus\"\n           | otherwise\n           = sep [pp_field_args, arrow <+> pp_gadt_res_ty]\n\n    ppr_bang IfNoBang = whenPprDebug $ char '_'\n    ppr_bang IfStrict = char '!'\n    ppr_bang IfUnpack = text \"{-# UNPACK #-}\"\n    ppr_bang (IfUnpackCo co) = text \"! {-# UNPACK #-}\" <>\n                               pprParendIfaceCoercion co\n\n    pprFieldArgTy, pprArgTy :: (IfaceBang, IfaceType) -> SDoc\n    -- If using record syntax, the only reason one would need to parenthesize\n    -- a compound field type is if it's preceded by a bang pattern.\n    pprFieldArgTy (bang, ty) = ppr_arg_ty (bang_prec bang) bang ty\n    -- If not using record syntax, a compound field type might need to be\n    -- parenthesize if one of the following holds:\n    --\n    -- 1. We're using Haskell98 syntax.\n    -- 2. The field type is preceded with a bang pattern.\n    pprArgTy (bang, ty) = ppr_arg_ty (max gadt_prec (bang_prec bang)) bang ty\n\n    ppr_arg_ty :: PprPrec -> IfaceBang -> IfaceType -> SDoc\n    ppr_arg_ty prec bang ty = ppr_bang bang <> pprPrecIfaceType prec ty\n\n    -- If we're displaying the fields GADT-style, e.g.,\n    --\n    --   data Foo a where\n    --     MkFoo :: Maybe a -> Foo\n    --\n    -- Then there is no inherent need to parenthesize compound fields like\n    -- `Maybe a` (bang patterns notwithstanding). If we're displaying the\n    -- fields Haskell98-style, e.g.,\n    --\n    --   data Foo a = MkFoo (Maybe a)\n    --\n    -- Then we *must* parenthesize compound fields like (Maybe a).\n    gadt_prec :: PprPrec\n    gadt_prec\n      | gadt_style = topPrec\n      | otherwise  = appPrec\n\n    -- The presence of bang patterns or UNPACK annotations requires\n    -- surrounding the type with parentheses, if needed (#13699)\n    bang_prec :: IfaceBang -> PprPrec\n    bang_prec IfNoBang     = topPrec\n    bang_prec IfStrict     = appPrec\n    bang_prec IfUnpack     = appPrec\n    bang_prec IfUnpackCo{} = appPrec\n\n    pp_args :: [SDoc] -- No records, e.g., `  Maybe a  ->  Int -> ...` or\n                      --                   `!(Maybe a) -> !Int -> ...`\n    pp_args = map pprArgTy tys_w_strs\n\n    pp_field_args :: SDoc -- Records, e.g., { x ::   Maybe a,  y ::  Int } or\n                          --                { x :: !(Maybe a), y :: !Int }\n    pp_field_args = braces $ sep $ punctuate comma $ ppr_trim $\n                    zipWith maybe_show_label fields tys_w_strs\n\n    maybe_show_label :: FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc\n    maybe_show_label lbl bty\n      | showSub ss sel = Just (pprPrefixIfDeclBndr how_much occ\n                                <+> dcolon <+> pprFieldArgTy bty)\n      | otherwise      = Nothing\n      where\n        sel = flSelector lbl\n        occ = mkVarOccFS (flLabel lbl)\n\n    mk_user_con_res_ty :: IfaceEqSpec -> SDoc\n    -- See Note [Result type of a data family GADT]\n    mk_user_con_res_ty eq_spec\n      | IfDataInstance _ tc tys <- parent\n      = pprIfaceType (IfaceTyConApp tc (substIfaceAppArgs gadt_subst tys))\n      | otherwise\n      = ppr_tc_app gadt_subst\n      where\n        gadt_subst = mkIfaceTySubst eq_spec\n\n    -- When pretty-printing a GADT return type, we:\n    --\n    -- 1. Take the data tycon binders, extract their variable names and\n    --    visibilities, and construct suitable arguments from them. (This is\n    --    the role of mk_tc_app_args.)\n    -- 2. Apply the GADT substitution constructed from the eq_spec.\n    --    (See Note [Result type of a data family GADT].)\n    -- 3. Pretty-print the data type constructor applied to its arguments.\n    --    This process will omit any invisible arguments, such as coercion\n    --    variables, if necessary. (See Note\n    --    [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.)\n    ppr_tc_app gadt_subst =\n      pprPrefixIfDeclBndr how_much (occName tycon)\n      <+> pprIfaceAppArgs\n            (substIfaceAppArgs gadt_subst (mk_tc_app_args tc_binders))\n\n    mk_tc_app_args :: [IfaceTyConBinder] -> IfaceAppArgs\n    mk_tc_app_args [] = IA_Nil\n    mk_tc_app_args (Bndr bndr vis:tc_bndrs) =\n      IA_Arg (IfaceTyVar (ifaceBndrName bndr)) (tyConBndrVisArgFlag vis)\n             (mk_tc_app_args tc_bndrs)\n\ninstance Outputable IfaceRule where\n  ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,\n                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,\n                   ifRuleOrph = orph })\n    = sep [ hsep [ pprRuleName name\n                 , if isOrphan orph then text \"[orphan]\" else Outputable.empty\n                 , ppr act\n                 , pp_foralls ]\n          , nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),\n                        text \"=\" <+> ppr rhs]) ]\n    where\n      pp_foralls = ppUnless (null bndrs) $ forAllLit <+> pprIfaceBndrs bndrs <> dot\n\ninstance Outputable IfaceClsInst where\n  ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag\n                    , ifInstCls = cls, ifInstTys = mb_tcs\n                    , ifInstOrph = orph })\n    = hang (text \"instance\" <+> ppr flag\n              <+> (if isOrphan orph then text \"[orphan]\" else Outputable.empty)\n              <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))\n         2 (equals <+> ppr dfun_id)\n\ninstance Outputable IfaceFamInst where\n  ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs\n                    , ifFamInstAxiom = tycon_ax, ifFamInstOrph = orph })\n    = hang (text \"family instance\"\n              <+> (if isOrphan orph then text \"[orphan]\" else Outputable.empty)\n              <+> ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)\n         2 (equals <+> ppr tycon_ax)\n\nppr_rough :: Maybe IfaceTyCon -> SDoc\nppr_rough Nothing   = dot\nppr_rough (Just tc) = ppr tc\n\n{-\nNote [Result type of a data family GADT]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   data family T a\n   data instance T (p,q) where\n      T1 :: T (Int, Maybe c)\n      T2 :: T (Bool, q)\n\nThe IfaceDecl actually looks like\n\n   data TPr p q where\n      T1 :: forall p q. forall c. (p~Int,q~Maybe c) => TPr p q\n      T2 :: forall p q. (p~Bool) => TPr p q\n\nTo reconstruct the result types for T1 and T2 that we\nwant to pretty print, we substitute the eq-spec\n[p->Int, q->Maybe c] in the arg pattern (p,q) to give\n   T (Int, Maybe c)\nRemember that in IfaceSyn, the TyCon and DataCon share the same\nuniversal type variables.\n\n----------------------------- Printing IfaceExpr ------------------------------------\n-}\n\ninstance Outputable IfaceExpr where\n    ppr e = pprIfaceExpr noParens e\n\nnoParens :: SDoc -> SDoc\nnoParens pp = pp\n\npprParendIfaceExpr :: IfaceExpr -> SDoc\npprParendIfaceExpr = pprIfaceExpr parens\n\n-- | Pretty Print an IfaceExpre\n--\n-- The first argument should be a function that adds parens in context that need\n-- an atomic value (e.g. function args)\npprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc\n\npprIfaceExpr _       (IfaceLcl v)       = ppr v\npprIfaceExpr _       (IfaceExt v)       = ppr v\npprIfaceExpr _       (IfaceLit l)       = ppr l\npprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)\npprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty\npprIfaceExpr _       (IfaceCo co)       = text \"@~\" <+> pprParendIfaceCoercion co\n\npprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])\npprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (pprWithCommas ppr as)\n\npprIfaceExpr add_par i@(IfaceLam _ _)\n  = add_par (sep [char '\\\\' <+> sep (map pprIfaceLamBndr bndrs) <+> arrow,\n                  pprIfaceExpr noParens body])\n  where\n    (bndrs,body) = collect [] i\n    collect bs (IfaceLam b e) = collect (b:bs) e\n    collect bs e              = (reverse bs, e)\n\npprIfaceExpr add_par (IfaceECase scrut ty)\n  = add_par (sep [ text \"case\" <+> pprIfaceExpr noParens scrut\n                 , text \"ret_ty\" <+> pprParendIfaceType ty\n                 , text \"of {}\" ])\n\npprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])\n  = add_par (sep [text \"case\"\n                        <+> pprIfaceExpr noParens scrut <+> text \"of\"\n                        <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,\n                  pprIfaceExpr noParens rhs <+> char '}'])\n\npprIfaceExpr add_par (IfaceCase scrut bndr alts)\n  = add_par (sep [text \"case\"\n                        <+> pprIfaceExpr noParens scrut <+> text \"of\"\n                        <+> ppr bndr <+> char '{',\n                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])\n\npprIfaceExpr _       (IfaceCast expr co)\n  = sep [pprParendIfaceExpr expr,\n         nest 2 (text \"`cast`\"),\n         pprParendIfaceCoercion co]\n\npprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)\n  = add_par (sep [text \"let {\",\n                  nest 2 (ppr_bind (b, rhs)),\n                  text \"} in\",\n                  pprIfaceExpr noParens body])\n\npprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)\n  = add_par (sep [text \"letrec {\",\n                  nest 2 (sep (map ppr_bind pairs)),\n                  text \"} in\",\n                  pprIfaceExpr noParens body])\n\npprIfaceExpr add_par (IfaceTick tickish e)\n  = add_par (pprIfaceTickish tickish <+> pprIfaceExpr noParens e)\n\nppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc\nppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,\n                         arrow <+> pprIfaceExpr noParens rhs]\n\nppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc\nppr_con_bs con bs = ppr con <+> hsep (map ppr bs)\n\nppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc\nppr_bind (IfLetBndr b ty info ji, rhs)\n  = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr ji <+> ppr info),\n         equals <+> pprIfaceExpr noParens rhs]\n\n------------------\npprIfaceTickish :: IfaceTickish -> SDoc\npprIfaceTickish (IfaceHpcTick m ix)\n  = braces (text \"tick\" <+> ppr m <+> ppr ix)\npprIfaceTickish (IfaceSCC cc tick scope)\n  = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)\npprIfaceTickish (IfaceSource src _names)\n  = braces (pprUserRealSpan True src)\n\n------------------\npprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc\npprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $\n                                          nest 2 (pprParendIfaceExpr arg) : args\npprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)\n\n------------------\ninstance Outputable IfaceConAlt where\n    ppr IfaceDefault      = text \"DEFAULT\"\n    ppr (IfaceLitAlt l)   = ppr l\n    ppr (IfaceDataAlt d)  = ppr d\n\n------------------\ninstance Outputable IfaceIdDetails where\n  ppr IfVanillaId       = Outputable.empty\n  ppr (IfRecSelId tc b) = text \"RecSel\" <+> ppr tc\n                          <+> if b\n                                then text \"<naughty>\"\n                                else Outputable.empty\n  ppr IfDFunId          = text \"DFunId\"\n\ninstance Outputable IfaceIdInfo where\n  ppr NoInfo       = Outputable.empty\n  ppr (HasInfo is) = text \"{-\" <+> pprWithCommas ppr is\n                     <+> text \"-}\"\n\ninstance Outputable IfaceInfoItem where\n  ppr (HsUnfold lb unf)     = text \"Unfolding\"\n                              <> ppWhen lb (text \"(loop-breaker)\")\n                              <> colon <+> ppr unf\n  ppr (HsInline prag)       = text \"Inline:\" <+> ppr prag\n  ppr (HsArity arity)       = text \"Arity:\" <+> int arity\n  ppr (HsStrictness str) = text \"Strictness:\" <+> pprIfaceStrictSig str\n  ppr HsNoCafRefs           = text \"HasNoCafRefs\"\n  ppr HsLevity              = text \"Never levity-polymorphic\"\n\ninstance Outputable IfaceJoinInfo where\n  ppr IfaceNotJoinPoint   = empty\n  ppr (IfaceJoinPoint ar) = angleBrackets (text \"join\" <+> ppr ar)\n\ninstance Outputable IfaceUnfolding where\n  ppr (IfCompulsory e)     = text \"<compulsory>\" <+> parens (ppr e)\n  ppr (IfCoreUnfold s e)   = (if s\n                                then text \"<stable>\"\n                                else Outputable.empty)\n                              <+> parens (ppr e)\n  ppr (IfInlineRule a uok bok e) = sep [text \"InlineRule\"\n                                            <+> ppr (a,uok,bok),\n                                        pprParendIfaceExpr e]\n  ppr (IfDFunUnfold bs es) = hang (text \"DFun:\" <+> sep (map ppr bs) <> dot)\n                                2 (sep (map pprParendIfaceExpr es))\n\n{-\n************************************************************************\n*                                                                      *\n              Finding the Names in IfaceSyn\n*                                                                      *\n************************************************************************\n\nThis is used for dependency analysis in MkIface, so that we\nfingerprint a declaration before the things that depend on it.  It\nis specific to interface-file fingerprinting in the sense that we\ndon't collect *all* Names: for example, the DFun of an instance is\nrecorded textually rather than by its fingerprint when\nfingerprinting the instance, so DFuns are not dependencies.\n-}\n\nfreeNamesIfDecl :: IfaceDecl -> NameSet\nfreeNamesIfDecl (IfaceId { ifType = t, ifIdDetails = d, ifIdInfo = i})\n  = freeNamesIfType t &&&\n    freeNamesIfIdInfo i &&&\n    freeNamesIfIdDetails d\n\nfreeNamesIfDecl (IfaceData { ifBinders = bndrs, ifResKind = res_k\n                           , ifParent = p, ifCtxt = ctxt, ifCons = cons })\n  = freeNamesIfVarBndrs bndrs &&&\n    freeNamesIfType res_k &&&\n    freeNamesIfaceTyConParent p &&&\n    freeNamesIfContext ctxt &&&\n    freeNamesIfConDecls cons\n\nfreeNamesIfDecl (IfaceSynonym { ifBinders = bndrs, ifResKind = res_k\n                              , ifSynRhs = rhs })\n  = freeNamesIfVarBndrs bndrs &&&\n    freeNamesIfKind res_k &&&\n    freeNamesIfType rhs\n\nfreeNamesIfDecl (IfaceFamily { ifBinders = bndrs, ifResKind = res_k\n                             , ifFamFlav = flav })\n  = freeNamesIfVarBndrs bndrs &&&\n    freeNamesIfKind res_k &&&\n    freeNamesIfFamFlav flav\n\nfreeNamesIfDecl (IfaceClass{ ifBinders = bndrs, ifBody = cls_body })\n  = freeNamesIfVarBndrs bndrs &&&\n    freeNamesIfClassBody cls_body\n\nfreeNamesIfDecl (IfaceAxiom { ifTyCon = tc, ifAxBranches = branches })\n  = freeNamesIfTc tc &&&\n    fnList freeNamesIfAxBranch branches\n\nfreeNamesIfDecl (IfacePatSyn { ifPatMatcher = (matcher, _)\n                             , ifPatBuilder = mb_builder\n                             , ifPatUnivBndrs = univ_bndrs\n                             , ifPatExBndrs = ex_bndrs\n                             , ifPatProvCtxt = prov_ctxt\n                             , ifPatReqCtxt = req_ctxt\n                             , ifPatArgs = args\n                             , ifPatTy = pat_ty\n                             , ifFieldLabels = lbls })\n  = unitNameSet matcher &&&\n    maybe emptyNameSet (unitNameSet . fst) mb_builder &&&\n    freeNamesIfVarBndrs univ_bndrs &&&\n    freeNamesIfVarBndrs ex_bndrs &&&\n    freeNamesIfContext prov_ctxt &&&\n    freeNamesIfContext req_ctxt &&&\n    fnList freeNamesIfType args &&&\n    freeNamesIfType pat_ty &&&\n    mkNameSet (map flSelector lbls)\n\nfreeNamesIfClassBody :: IfaceClassBody -> NameSet\nfreeNamesIfClassBody IfAbstractClass\n  = emptyNameSet\nfreeNamesIfClassBody (IfConcreteClass{ ifClassCtxt = ctxt, ifATs = ats, ifSigs = sigs })\n  = freeNamesIfContext ctxt  &&&\n    fnList freeNamesIfAT ats &&&\n    fnList freeNamesIfClsSig sigs\n\nfreeNamesIfAxBranch :: IfaceAxBranch -> NameSet\nfreeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars   = tyvars\n                                   , ifaxbCoVars   = covars\n                                   , ifaxbLHS      = lhs\n                                   , ifaxbRHS      = rhs })\n  = fnList freeNamesIfTvBndr tyvars &&&\n    fnList freeNamesIfIdBndr covars &&&\n    freeNamesIfAppArgs lhs &&&\n    freeNamesIfType rhs\n\nfreeNamesIfIdDetails :: IfaceIdDetails -> NameSet\nfreeNamesIfIdDetails (IfRecSelId tc _) =\n  either freeNamesIfTc freeNamesIfDecl tc\nfreeNamesIfIdDetails _                 = emptyNameSet\n\n-- All other changes are handled via the version info on the tycon\nfreeNamesIfFamFlav :: IfaceFamTyConFlav -> NameSet\nfreeNamesIfFamFlav IfaceOpenSynFamilyTyCon             = emptyNameSet\nfreeNamesIfFamFlav IfaceDataFamilyTyCon                = emptyNameSet\nfreeNamesIfFamFlav (IfaceClosedSynFamilyTyCon (Just (ax, br)))\n  = unitNameSet ax &&& fnList freeNamesIfAxBranch br\nfreeNamesIfFamFlav (IfaceClosedSynFamilyTyCon Nothing) = emptyNameSet\nfreeNamesIfFamFlav IfaceAbstractClosedSynFamilyTyCon   = emptyNameSet\nfreeNamesIfFamFlav IfaceBuiltInSynFamTyCon             = emptyNameSet\n\nfreeNamesIfContext :: IfaceContext -> NameSet\nfreeNamesIfContext = fnList freeNamesIfType\n\nfreeNamesIfAT :: IfaceAT -> NameSet\nfreeNamesIfAT (IfaceAT decl mb_def)\n  = freeNamesIfDecl decl &&&\n    case mb_def of\n      Nothing  -> emptyNameSet\n      Just rhs -> freeNamesIfType rhs\n\nfreeNamesIfClsSig :: IfaceClassOp -> NameSet\nfreeNamesIfClsSig (IfaceClassOp _n ty dm) = freeNamesIfType ty &&& freeNamesDM dm\n\nfreeNamesDM :: Maybe (DefMethSpec IfaceType) -> NameSet\nfreeNamesDM (Just (GenericDM ty)) = freeNamesIfType ty\nfreeNamesDM _                     = emptyNameSet\n\nfreeNamesIfConDecls :: IfaceConDecls -> NameSet\nfreeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c\nfreeNamesIfConDecls (IfNewTyCon  c) = freeNamesIfConDecl c\nfreeNamesIfConDecls _                   = emptyNameSet\n\nfreeNamesIfConDecl :: IfaceConDecl -> NameSet\nfreeNamesIfConDecl (IfCon { ifConExTCvs  = ex_tvs, ifConCtxt = ctxt\n                          , ifConArgTys  = arg_tys\n                          , ifConFields  = flds\n                          , ifConEqSpec  = eq_spec\n                          , ifConStricts = bangs })\n  = fnList freeNamesIfBndr ex_tvs &&&\n    freeNamesIfContext ctxt &&&\n    fnList freeNamesIfType arg_tys &&&\n    mkNameSet (map flSelector flds) &&&\n    fnList freeNamesIfType (map snd eq_spec) &&& -- equality constraints\n    fnList freeNamesIfBang bangs\n\nfreeNamesIfBang :: IfaceBang -> NameSet\nfreeNamesIfBang (IfUnpackCo co) = freeNamesIfCoercion co\nfreeNamesIfBang _               = emptyNameSet\n\nfreeNamesIfKind :: IfaceType -> NameSet\nfreeNamesIfKind = freeNamesIfType\n\nfreeNamesIfAppArgs :: IfaceAppArgs -> NameSet\nfreeNamesIfAppArgs (IA_Arg t _ ts) = freeNamesIfType t &&& freeNamesIfAppArgs ts\nfreeNamesIfAppArgs IA_Nil          = emptyNameSet\n\nfreeNamesIfType :: IfaceType -> NameSet\nfreeNamesIfType (IfaceFreeTyVar _)    = emptyNameSet\nfreeNamesIfType (IfaceTyVar _)        = emptyNameSet\nfreeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfAppArgs t\nfreeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& freeNamesIfAppArgs ts\nfreeNamesIfType (IfaceTupleTy _ _ ts) = freeNamesIfAppArgs ts\nfreeNamesIfType (IfaceLitTy _)        = emptyNameSet\nfreeNamesIfType (IfaceForAllTy tv t)  = freeNamesIfVarBndr tv &&& freeNamesIfType t\nfreeNamesIfType (IfaceFunTy _ s t)    = freeNamesIfType s &&& freeNamesIfType t\nfreeNamesIfType (IfaceCastTy t c)     = freeNamesIfType t &&& freeNamesIfCoercion c\nfreeNamesIfType (IfaceCoercionTy c)   = freeNamesIfCoercion c\n\nfreeNamesIfMCoercion :: IfaceMCoercion -> NameSet\nfreeNamesIfMCoercion IfaceMRefl    = emptyNameSet\nfreeNamesIfMCoercion (IfaceMCo co) = freeNamesIfCoercion co\n\nfreeNamesIfCoercion :: IfaceCoercion -> NameSet\nfreeNamesIfCoercion (IfaceReflCo t) = freeNamesIfType t\nfreeNamesIfCoercion (IfaceGReflCo _ t mco)\n  = freeNamesIfType t &&& freeNamesIfMCoercion mco\nfreeNamesIfCoercion (IfaceFunCo _ c1 c2)\n  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2\nfreeNamesIfCoercion (IfaceTyConAppCo _ tc cos)\n  = freeNamesIfTc tc &&& fnList freeNamesIfCoercion cos\nfreeNamesIfCoercion (IfaceAppCo c1 c2)\n  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2\nfreeNamesIfCoercion (IfaceForAllCo _ kind_co co)\n  = freeNamesIfCoercion kind_co &&& freeNamesIfCoercion co\nfreeNamesIfCoercion (IfaceFreeCoVar _) = emptyNameSet\nfreeNamesIfCoercion (IfaceCoVarCo _)   = emptyNameSet\nfreeNamesIfCoercion (IfaceHoleCo _)    = emptyNameSet\nfreeNamesIfCoercion (IfaceAxiomInstCo ax _ cos)\n  = unitNameSet ax &&& fnList freeNamesIfCoercion cos\nfreeNamesIfCoercion (IfaceUnivCo p _ t1 t2)\n  = freeNamesIfProv p &&& freeNamesIfType t1 &&& freeNamesIfType t2\nfreeNamesIfCoercion (IfaceSymCo c)\n  = freeNamesIfCoercion c\nfreeNamesIfCoercion (IfaceTransCo c1 c2)\n  = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2\nfreeNamesIfCoercion (IfaceNthCo _ co)\n  = freeNamesIfCoercion co\nfreeNamesIfCoercion (IfaceLRCo _ co)\n  = freeNamesIfCoercion co\nfreeNamesIfCoercion (IfaceInstCo co co2)\n  = freeNamesIfCoercion co &&& freeNamesIfCoercion co2\nfreeNamesIfCoercion (IfaceKindCo c)\n  = freeNamesIfCoercion c\nfreeNamesIfCoercion (IfaceSubCo co)\n  = freeNamesIfCoercion co\nfreeNamesIfCoercion (IfaceAxiomRuleCo _ax cos)\n  -- the axiom is just a string, so we don't count it as a name.\n  = fnList freeNamesIfCoercion cos\n\nfreeNamesIfProv :: IfaceUnivCoProv -> NameSet\nfreeNamesIfProv IfaceUnsafeCoerceProv    = emptyNameSet\nfreeNamesIfProv (IfacePhantomProv co)    = freeNamesIfCoercion co\nfreeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co\nfreeNamesIfProv (IfacePluginProv _)      = emptyNameSet\n\nfreeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet\nfreeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr\n\nfreeNamesIfVarBndrs :: [VarBndr IfaceBndr vis] -> NameSet\nfreeNamesIfVarBndrs = fnList freeNamesIfVarBndr\n\nfreeNamesIfBndr :: IfaceBndr -> NameSet\nfreeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b\nfreeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b\n\nfreeNamesIfBndrs :: [IfaceBndr] -> NameSet\nfreeNamesIfBndrs = fnList freeNamesIfBndr\n\nfreeNamesIfLetBndr :: IfaceLetBndr -> NameSet\n-- Remember IfaceLetBndr is used only for *nested* bindings\n-- The IdInfo can contain an unfolding (in the case of\n-- local INLINE pragmas), so look there too\nfreeNamesIfLetBndr (IfLetBndr _name ty info _ji) = freeNamesIfType ty\n                                                 &&& freeNamesIfIdInfo info\n\nfreeNamesIfTvBndr :: IfaceTvBndr -> NameSet\nfreeNamesIfTvBndr (_fs,k) = freeNamesIfKind k\n    -- kinds can have Names inside, because of promotion\n\nfreeNamesIfIdBndr :: IfaceIdBndr -> NameSet\nfreeNamesIfIdBndr (_fs,k) = freeNamesIfKind k\n\nfreeNamesIfIdInfo :: IfaceIdInfo -> NameSet\nfreeNamesIfIdInfo NoInfo      = emptyNameSet\nfreeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i\n\nfreeNamesItem :: IfaceInfoItem -> NameSet\nfreeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u\nfreeNamesItem _              = emptyNameSet\n\nfreeNamesIfUnfold :: IfaceUnfolding -> NameSet\nfreeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e\nfreeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e\nfreeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e\nfreeNamesIfUnfold (IfDFunUnfold bs es)   = freeNamesIfBndrs bs &&& fnList freeNamesIfExpr es\n\nfreeNamesIfExpr :: IfaceExpr -> NameSet\nfreeNamesIfExpr (IfaceExt v)          = unitNameSet v\nfreeNamesIfExpr (IfaceFCall _ ty)     = freeNamesIfType ty\nfreeNamesIfExpr (IfaceType ty)        = freeNamesIfType ty\nfreeNamesIfExpr (IfaceCo co)          = freeNamesIfCoercion co\nfreeNamesIfExpr (IfaceTuple _ as)     = fnList freeNamesIfExpr as\nfreeNamesIfExpr (IfaceLam (b,_) body) = freeNamesIfBndr b &&& freeNamesIfExpr body\nfreeNamesIfExpr (IfaceApp f a)        = freeNamesIfExpr f &&& freeNamesIfExpr a\nfreeNamesIfExpr (IfaceCast e co)      = freeNamesIfExpr e &&& freeNamesIfCoercion co\nfreeNamesIfExpr (IfaceTick _ e)       = freeNamesIfExpr e\nfreeNamesIfExpr (IfaceECase e ty)     = freeNamesIfExpr e &&& freeNamesIfType ty\nfreeNamesIfExpr (IfaceCase s _ alts)\n  = freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts\n  where\n    fn_alt (_con,_bs,r) = freeNamesIfExpr r\n\n    -- Depend on the data constructors.  Just one will do!\n    -- Note [Tracking data constructors]\n    fn_cons []                            = emptyNameSet\n    fn_cons ((IfaceDefault    ,_,_) : xs) = fn_cons xs\n    fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con\n    fn_cons (_                      : _ ) = emptyNameSet\n\nfreeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)\n  = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body\n\nfreeNamesIfExpr (IfaceLet (IfaceRec as) x)\n  = fnList fn_pair as &&& freeNamesIfExpr x\n  where\n    fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs\n\nfreeNamesIfExpr _ = emptyNameSet\n\nfreeNamesIfTc :: IfaceTyCon -> NameSet\nfreeNamesIfTc tc = unitNameSet (ifaceTyConName tc)\n-- ToDo: shouldn't we include IfaceIntTc & co.?\n\nfreeNamesIfRule :: IfaceRule -> NameSet\nfreeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f\n                           , ifRuleArgs = es, ifRuleRhs = rhs })\n  = unitNameSet f &&&\n    fnList freeNamesIfBndr bs &&&\n    fnList freeNamesIfExpr es &&&\n    freeNamesIfExpr rhs\n\nfreeNamesIfFamInst :: IfaceFamInst -> NameSet\nfreeNamesIfFamInst (IfaceFamInst { ifFamInstFam = famName\n                                 , ifFamInstAxiom = axName })\n  = unitNameSet famName &&&\n    unitNameSet axName\n\nfreeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet\nfreeNamesIfaceTyConParent IfNoParent = emptyNameSet\nfreeNamesIfaceTyConParent (IfDataInstance ax tc tys)\n  = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys\n\n-- helpers\n(&&&) :: NameSet -> NameSet -> NameSet\n(&&&) = unionNameSet\n\nfnList :: (a -> NameSet) -> [a] -> NameSet\nfnList f = foldr (&&&) emptyNameSet . map f\n\n{-\nNote [Tracking data constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a case expression\n   case e of { C a -> ...; ... }\nYou might think that we don't need to include the datacon C\nin the free names, because its type will probably show up in\nthe free names of 'e'.  But in rare circumstances this may\nnot happen.   Here's the one that bit me:\n\n   module DynFlags where\n     import {-# SOURCE #-} Packages( PackageState )\n     data DynFlags = DF ... PackageState ...\n\n   module Packages where\n     import DynFlags\n     data PackageState = PS ...\n     lookupModule (df :: DynFlags)\n        = case df of\n              DF ...p... -> case p of\n                               PS ... -> ...\n\nNow, lookupModule depends on DynFlags, but the transitive dependency\non the *locally-defined* type PackageState is not visible. We need\nto take account of the use of the data constructor PS in the pattern match.\n\n\n************************************************************************\n*                                                                      *\n                Binary instances\n*                                                                      *\n************************************************************************\n\nNote that there is a bit of subtlety here when we encode names. While\nIfaceTopBndrs is really just a synonym for Name, we need to take care to\nencode them with {get,put}IfaceTopBndr. The difference becomes important when\nwe go to fingerprint an IfaceDecl. See Note [Fingerprinting IfaceDecls] for\ndetails.\n\n-}\n\ninstance Binary IfaceDecl where\n    put_ bh (IfaceId name ty details idinfo) = do\n        putByte bh 0\n        putIfaceTopBndr bh name\n        lazyPut bh (ty, details, idinfo)\n        -- See Note [Lazy deserialization of IfaceId]\n\n    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do\n        putByte bh 2\n        putIfaceTopBndr bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n        put_ bh a6\n        put_ bh a7\n        put_ bh a8\n        put_ bh a9\n\n    put_ bh (IfaceSynonym a1 a2 a3 a4 a5) = do\n        putByte bh 3\n        putIfaceTopBndr bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n\n    put_ bh (IfaceFamily a1 a2 a3 a4 a5 a6) = do\n        putByte bh 4\n        putIfaceTopBndr bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n        put_ bh a6\n\n    -- NB: Written in a funny way to avoid an interface change\n    put_ bh (IfaceClass {\n                ifName    = a2,\n                ifRoles   = a3,\n                ifBinders = a4,\n                ifFDs     = a5,\n                ifBody = IfConcreteClass {\n                    ifClassCtxt = a1,\n                    ifATs  = a6,\n                    ifSigs = a7,\n                    ifMinDef  = a8\n                }}) = do\n        putByte bh 5\n        put_ bh a1\n        putIfaceTopBndr bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n        put_ bh a6\n        put_ bh a7\n        put_ bh a8\n\n    put_ bh (IfaceAxiom a1 a2 a3 a4) = do\n        putByte bh 6\n        putIfaceTopBndr bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n\n    put_ bh (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do\n        putByte bh 7\n        putIfaceTopBndr bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n        put_ bh a6\n        put_ bh a7\n        put_ bh a8\n        put_ bh a9\n        put_ bh a10\n        put_ bh a11\n\n    put_ bh (IfaceClass {\n                ifName    = a1,\n                ifRoles   = a2,\n                ifBinders = a3,\n                ifFDs     = a4,\n                ifBody = IfAbstractClass }) = do\n        putByte bh 8\n        putIfaceTopBndr bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> do name    <- get bh\n                    ~(ty, details, idinfo) <- lazyGet bh\n                    -- See Note [Lazy deserialization of IfaceId]\n                    return (IfaceId name ty details idinfo)\n            1 -> error \"Binary.get(TyClDecl): ForeignType\"\n            2 -> do a1  <- getIfaceTopBndr bh\n                    a2  <- get bh\n                    a3  <- get bh\n                    a4  <- get bh\n                    a5  <- get bh\n                    a6  <- get bh\n                    a7  <- get bh\n                    a8  <- get bh\n                    a9  <- get bh\n                    return (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9)\n            3 -> do a1 <- getIfaceTopBndr bh\n                    a2 <- get bh\n                    a3 <- get bh\n                    a4 <- get bh\n                    a5 <- get bh\n                    return (IfaceSynonym a1 a2 a3 a4 a5)\n            4 -> do a1 <- getIfaceTopBndr bh\n                    a2 <- get bh\n                    a3 <- get bh\n                    a4 <- get bh\n                    a5 <- get bh\n                    a6 <- get bh\n                    return (IfaceFamily a1 a2 a3 a4 a5 a6)\n            5 -> do a1 <- get bh\n                    a2 <- getIfaceTopBndr bh\n                    a3 <- get bh\n                    a4 <- get bh\n                    a5 <- get bh\n                    a6 <- get bh\n                    a7 <- get bh\n                    a8 <- get bh\n                    return (IfaceClass {\n                        ifName    = a2,\n                        ifRoles   = a3,\n                        ifBinders = a4,\n                        ifFDs     = a5,\n                        ifBody = IfConcreteClass {\n                            ifClassCtxt = a1,\n                            ifATs  = a6,\n                            ifSigs = a7,\n                            ifMinDef  = a8\n                        }})\n            6 -> do a1 <- getIfaceTopBndr bh\n                    a2 <- get bh\n                    a3 <- get bh\n                    a4 <- get bh\n                    return (IfaceAxiom a1 a2 a3 a4)\n            7 -> do a1 <- getIfaceTopBndr bh\n                    a2 <- get bh\n                    a3 <- get bh\n                    a4 <- get bh\n                    a5 <- get bh\n                    a6 <- get bh\n                    a7 <- get bh\n                    a8 <- get bh\n                    a9 <- get bh\n                    a10 <- get bh\n                    a11 <- get bh\n                    return (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)\n            8 -> do a1 <- getIfaceTopBndr bh\n                    a2 <- get bh\n                    a3 <- get bh\n                    a4 <- get bh\n                    return (IfaceClass {\n                        ifName    = a1,\n                        ifRoles   = a2,\n                        ifBinders = a3,\n                        ifFDs     = a4,\n                        ifBody = IfAbstractClass })\n            _ -> panic (unwords [\"Unknown IfaceDecl tag:\", show h])\n\n{- Note [Lazy deserialization of IfaceId]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe use of lazyPut and lazyGet in the IfaceId Binary instance is\npurely for performance reasons, to avoid deserializing details about\nidentifiers that will never be used. It's not involved in tying the\nknot in the type checker. It saved ~1% of the total build time of GHC.\n\nWhen we read an interface file, we extend the PTE, a mapping of Names\nto TyThings, with the declarations we have read. The extension of the\nPTE is strict in the Names, but not in the TyThings themselves.\nLoadIface.loadDecl calculates the list of (Name, TyThing) bindings to\nadd to the PTE. For an IfaceId, there's just one binding to add; and\nthe ty, details, and idinfo fields of an IfaceId are used only in the\nTyThing. So by reading those fields lazily we may be able to save the\nwork of ever having to deserialize them (into IfaceType, etc.).\n\nFor IfaceData and IfaceClass, loadDecl creates extra implicit bindings\n(the constructors and field selectors of the data declaration, or the\nmethods of the class), whose Names depend on more than just the Name\nof the type constructor or class itself. So deserializing them lazily\nwould be more involved. Similar comments apply to the other\nconstructors of IfaceDecl with the additional point that they probably\nrepresent a small proportion of all declarations.\n-}\n\ninstance Binary IfaceFamTyConFlav where\n    put_ bh IfaceDataFamilyTyCon              = putByte bh 0\n    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 1\n    put_ bh (IfaceClosedSynFamilyTyCon mb)    = putByte bh 2 >> put_ bh mb\n    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 3\n    put_ _ IfaceBuiltInSynFamTyCon\n        = pprPanic \"Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only\" Outputable.empty\n\n    get bh = do { h <- getByte bh\n                ; case h of\n                    0 -> return IfaceDataFamilyTyCon\n                    1 -> return IfaceOpenSynFamilyTyCon\n                    2 -> do { mb <- get bh\n                            ; return (IfaceClosedSynFamilyTyCon mb) }\n                    3 -> return IfaceAbstractClosedSynFamilyTyCon\n                    _ -> pprPanic \"Binary.get(IfaceFamTyConFlav): Invalid tag\"\n                                  (ppr (fromIntegral h :: Int)) }\n\ninstance Binary IfaceClassOp where\n    put_ bh (IfaceClassOp n ty def) = do\n        putIfaceTopBndr bh n\n        put_ bh ty\n        put_ bh def\n    get bh = do\n        n   <- getIfaceTopBndr bh\n        ty  <- get bh\n        def <- get bh\n        return (IfaceClassOp n ty def)\n\ninstance Binary IfaceAT where\n    put_ bh (IfaceAT dec defs) = do\n        put_ bh dec\n        put_ bh defs\n    get bh = do\n        dec  <- get bh\n        defs <- get bh\n        return (IfaceAT dec defs)\n\ninstance Binary IfaceAxBranch where\n    put_ bh (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7) = do\n        put_ bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n        put_ bh a6\n        put_ bh a7\n    get bh = do\n        a1 <- get bh\n        a2 <- get bh\n        a3 <- get bh\n        a4 <- get bh\n        a5 <- get bh\n        a6 <- get bh\n        a7 <- get bh\n        return (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7)\n\ninstance Binary IfaceConDecls where\n    put_ bh IfAbstractTyCon  = putByte bh 0\n    put_ bh (IfDataTyCon cs) = putByte bh 1 >> put_ bh cs\n    put_ bh (IfNewTyCon c)   = putByte bh 2 >> put_ bh c\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return IfAbstractTyCon\n            1 -> liftM IfDataTyCon (get bh)\n            2 -> liftM IfNewTyCon (get bh)\n            _ -> error \"Binary(IfaceConDecls).get: Invalid IfaceConDecls\"\n\ninstance Binary IfaceConDecl where\n    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do\n        putIfaceTopBndr bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n        put_ bh a6\n        put_ bh a7\n        put_ bh a8\n        put_ bh (length a9)\n        mapM_ (put_ bh) a9\n        put_ bh a10\n        put_ bh a11\n    get bh = do\n        a1 <- getIfaceTopBndr bh\n        a2 <- get bh\n        a3 <- get bh\n        a4 <- get bh\n        a5 <- get bh\n        a6 <- get bh\n        a7 <- get bh\n        a8 <- get bh\n        n_fields <- get bh\n        a9 <- replicateM n_fields (get bh)\n        a10 <- get bh\n        a11 <- get bh\n        return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)\n\ninstance Binary IfaceBang where\n    put_ bh IfNoBang        = putByte bh 0\n    put_ bh IfStrict        = putByte bh 1\n    put_ bh IfUnpack        = putByte bh 2\n    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co\n\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return IfNoBang\n              1 -> do return IfStrict\n              2 -> do return IfUnpack\n              _ -> do { a <- get bh; return (IfUnpackCo a) }\n\ninstance Binary IfaceSrcBang where\n    put_ bh (IfSrcBang a1 a2) =\n      do put_ bh a1\n         put_ bh a2\n\n    get bh =\n      do a1 <- get bh\n         a2 <- get bh\n         return (IfSrcBang a1 a2)\n\ninstance Binary IfaceClsInst where\n    put_ bh (IfaceClsInst cls tys dfun flag orph) = do\n        put_ bh cls\n        put_ bh tys\n        put_ bh dfun\n        put_ bh flag\n        put_ bh orph\n    get bh = do\n        cls  <- get bh\n        tys  <- get bh\n        dfun <- get bh\n        flag <- get bh\n        orph <- get bh\n        return (IfaceClsInst cls tys dfun flag orph)\n\ninstance Binary IfaceFamInst where\n    put_ bh (IfaceFamInst fam tys name orph) = do\n        put_ bh fam\n        put_ bh tys\n        put_ bh name\n        put_ bh orph\n    get bh = do\n        fam      <- get bh\n        tys      <- get bh\n        name     <- get bh\n        orph     <- get bh\n        return (IfaceFamInst fam tys name orph)\n\ninstance Binary IfaceRule where\n    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do\n        put_ bh a1\n        put_ bh a2\n        put_ bh a3\n        put_ bh a4\n        put_ bh a5\n        put_ bh a6\n        put_ bh a7\n        put_ bh a8\n    get bh = do\n        a1 <- get bh\n        a2 <- get bh\n        a3 <- get bh\n        a4 <- get bh\n        a5 <- get bh\n        a6 <- get bh\n        a7 <- get bh\n        a8 <- get bh\n        return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)\n\ninstance Binary IfaceAnnotation where\n    put_ bh (IfaceAnnotation a1 a2) = do\n        put_ bh a1\n        put_ bh a2\n    get bh = do\n        a1 <- get bh\n        a2 <- get bh\n        return (IfaceAnnotation a1 a2)\n\ninstance Binary IfaceIdDetails where\n    put_ bh IfVanillaId      = putByte bh 0\n    put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b\n    put_ bh IfDFunId         = putByte bh 2\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return IfVanillaId\n            1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }\n            _ -> return IfDFunId\n\ninstance Binary IfaceIdInfo where\n    put_ bh NoInfo      = putByte bh 0\n    put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut\n\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return NoInfo\n            _ -> liftM HasInfo $ lazyGet bh    -- NB lazyGet\n\ninstance Binary IfaceInfoItem where\n    put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa\n    put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab\n    put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad\n    put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad\n    put_ bh HsNoCafRefs           = putByte bh 4\n    put_ bh HsLevity              = putByte bh 5\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> liftM HsArity $ get bh\n            1 -> liftM HsStrictness $ get bh\n            2 -> do lb <- get bh\n                    ad <- get bh\n                    return (HsUnfold lb ad)\n            3 -> liftM HsInline $ get bh\n            4 -> return HsNoCafRefs\n            _ -> return HsLevity\n\ninstance Binary IfaceUnfolding where\n    put_ bh (IfCoreUnfold s e) = do\n        putByte bh 0\n        put_ bh s\n        put_ bh e\n    put_ bh (IfInlineRule a b c d) = do\n        putByte bh 1\n        put_ bh a\n        put_ bh b\n        put_ bh c\n        put_ bh d\n    put_ bh (IfDFunUnfold as bs) = do\n        putByte bh 2\n        put_ bh as\n        put_ bh bs\n    put_ bh (IfCompulsory e) = do\n        putByte bh 3\n        put_ bh e\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> do s <- get bh\n                    e <- get bh\n                    return (IfCoreUnfold s e)\n            1 -> do a <- get bh\n                    b <- get bh\n                    c <- get bh\n                    d <- get bh\n                    return (IfInlineRule a b c d)\n            2 -> do as <- get bh\n                    bs <- get bh\n                    return (IfDFunUnfold as bs)\n            _ -> do e <- get bh\n                    return (IfCompulsory e)\n\n\ninstance Binary IfaceExpr where\n    put_ bh (IfaceLcl aa) = do\n        putByte bh 0\n        put_ bh aa\n    put_ bh (IfaceType ab) = do\n        putByte bh 1\n        put_ bh ab\n    put_ bh (IfaceCo ab) = do\n        putByte bh 2\n        put_ bh ab\n    put_ bh (IfaceTuple ac ad) = do\n        putByte bh 3\n        put_ bh ac\n        put_ bh ad\n    put_ bh (IfaceLam (ae, os) af) = do\n        putByte bh 4\n        put_ bh ae\n        put_ bh os\n        put_ bh af\n    put_ bh (IfaceApp ag ah) = do\n        putByte bh 5\n        put_ bh ag\n        put_ bh ah\n    put_ bh (IfaceCase ai aj ak) = do\n        putByte bh 6\n        put_ bh ai\n        put_ bh aj\n        put_ bh ak\n    put_ bh (IfaceLet al am) = do\n        putByte bh 7\n        put_ bh al\n        put_ bh am\n    put_ bh (IfaceTick an ao) = do\n        putByte bh 8\n        put_ bh an\n        put_ bh ao\n    put_ bh (IfaceLit ap) = do\n        putByte bh 9\n        put_ bh ap\n    put_ bh (IfaceFCall as at) = do\n        putByte bh 10\n        put_ bh as\n        put_ bh at\n    put_ bh (IfaceExt aa) = do\n        putByte bh 11\n        put_ bh aa\n    put_ bh (IfaceCast ie ico) = do\n        putByte bh 12\n        put_ bh ie\n        put_ bh ico\n    put_ bh (IfaceECase a b) = do\n        putByte bh 13\n        put_ bh a\n        put_ bh b\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> do aa <- get bh\n                    return (IfaceLcl aa)\n            1 -> do ab <- get bh\n                    return (IfaceType ab)\n            2 -> do ab <- get bh\n                    return (IfaceCo ab)\n            3 -> do ac <- get bh\n                    ad <- get bh\n                    return (IfaceTuple ac ad)\n            4 -> do ae <- get bh\n                    os <- get bh\n                    af <- get bh\n                    return (IfaceLam (ae, os) af)\n            5 -> do ag <- get bh\n                    ah <- get bh\n                    return (IfaceApp ag ah)\n            6 -> do ai <- get bh\n                    aj <- get bh\n                    ak <- get bh\n                    return (IfaceCase ai aj ak)\n            7 -> do al <- get bh\n                    am <- get bh\n                    return (IfaceLet al am)\n            8 -> do an <- get bh\n                    ao <- get bh\n                    return (IfaceTick an ao)\n            9 -> do ap <- get bh\n                    return (IfaceLit ap)\n            10 -> do as <- get bh\n                     at <- get bh\n                     return (IfaceFCall as at)\n            11 -> do aa <- get bh\n                     return (IfaceExt aa)\n            12 -> do ie <- get bh\n                     ico <- get bh\n                     return (IfaceCast ie ico)\n            13 -> do a <- get bh\n                     b <- get bh\n                     return (IfaceECase a b)\n            _ -> panic (\"get IfaceExpr \" ++ show h)\n\ninstance Binary IfaceTickish where\n    put_ bh (IfaceHpcTick m ix) = do\n        putByte bh 0\n        put_ bh m\n        put_ bh ix\n    put_ bh (IfaceSCC cc tick push) = do\n        putByte bh 1\n        put_ bh cc\n        put_ bh tick\n        put_ bh push\n    put_ bh (IfaceSource src name) = do\n        putByte bh 2\n        put_ bh (srcSpanFile src)\n        put_ bh (srcSpanStartLine src)\n        put_ bh (srcSpanStartCol src)\n        put_ bh (srcSpanEndLine src)\n        put_ bh (srcSpanEndCol src)\n        put_ bh name\n\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> do m <- get bh\n                    ix <- get bh\n                    return (IfaceHpcTick m ix)\n            1 -> do cc <- get bh\n                    tick <- get bh\n                    push <- get bh\n                    return (IfaceSCC cc tick push)\n            2 -> do file <- get bh\n                    sl <- get bh\n                    sc <- get bh\n                    el <- get bh\n                    ec <- get bh\n                    let start = mkRealSrcLoc file sl sc\n                        end = mkRealSrcLoc file el ec\n                    name <- get bh\n                    return (IfaceSource (mkRealSrcSpan start end) name)\n            _ -> panic (\"get IfaceTickish \" ++ show h)\n\ninstance Binary IfaceConAlt where\n    put_ bh IfaceDefault      = putByte bh 0\n    put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa\n    put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return IfaceDefault\n            1 -> liftM IfaceDataAlt $ get bh\n            _ -> liftM IfaceLitAlt  $ get bh\n\ninstance Binary IfaceBinding where\n    put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab\n    put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }\n            _ -> do { ac <- get bh; return (IfaceRec ac) }\n\ninstance Binary IfaceLetBndr where\n    put_ bh (IfLetBndr a b c d) = do\n            put_ bh a\n            put_ bh b\n            put_ bh c\n            put_ bh d\n    get bh = do a <- get bh\n                b <- get bh\n                c <- get bh\n                d <- get bh\n                return (IfLetBndr a b c d)\n\ninstance Binary IfaceJoinInfo where\n    put_ bh IfaceNotJoinPoint = putByte bh 0\n    put_ bh (IfaceJoinPoint ar) = do\n        putByte bh 1\n        put_ bh ar\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return IfaceNotJoinPoint\n            _ -> liftM IfaceJoinPoint $ get bh\n\ninstance Binary IfaceTyConParent where\n    put_ bh IfNoParent = putByte bh 0\n    put_ bh (IfDataInstance ax pr ty) = do\n        putByte bh 1\n        put_ bh ax\n        put_ bh pr\n        put_ bh ty\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return IfNoParent\n            _ -> do\n                ax <- get bh\n                pr <- get bh\n                ty <- get bh\n                return $ IfDataInstance ax pr ty\n\ninstance Binary IfaceCompleteMatch where\n  put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts\n  get bh = IfaceCompleteMatch <$> get bh <*> get bh\n", "num_lines": 2326}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\nThis module defines interface types and binders\n-}\n\n{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE TupleSections #-}\n    -- FlexibleInstances for Binary (DefMethSpec IfaceType)\n\nmodule IfaceType (\n        IfExtName, IfLclName,\n\n        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),\n        IfaceMCoercion(..),\n        IfaceUnivCoProv(..),\n        IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..),\n        IfaceTyLit(..), IfaceAppArgs(..),\n        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,\n        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,\n        IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..),\n        ForallVisFlag(..), ShowForAllFlag(..),\n        mkIfaceForAllTvBndr,\n\n        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,\n        ifTyConBinderVar, ifTyConBinderName,\n\n        -- Equality testing\n        isIfaceLiftedTypeKind,\n\n        -- Conversion from IfaceAppArgs to IfaceTypes/ArgFlags\n        appArgsIfaceTypes, appArgsIfaceTypesArgFlags,\n\n        -- Printing\n        pprIfaceType, pprParendIfaceType, pprPrecIfaceType,\n        pprIfaceContext, pprIfaceContextArr,\n        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,\n        pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,\n        pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,\n        pprIfaceSigmaType, pprIfaceTyLit,\n        pprIfaceCoercion, pprParendIfaceCoercion,\n        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,\n        pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,\n\n        suppressIfaceInvisibles,\n        stripIfaceInvisVars,\n        stripInvisArgs,\n\n        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon\n                                 , liftedRepDataConTyCon )\nimport {-# SOURCE #-} TyCoRep    ( isRuntimeRepTy )\n\nimport DynFlags\nimport TyCon hiding ( pprPromotionQuote )\nimport CoAxiom\nimport Var\nimport PrelNames\nimport Name\nimport BasicTypes\nimport Binary\nimport Outputable\nimport FastString\nimport FastStringEnv\nimport Util\n\nimport Data.Maybe( isJust )\nimport qualified Data.Semigroup as Semi\n\n{-\n************************************************************************\n*                                                                      *\n                Local (nested) binders\n*                                                                      *\n************************************************************************\n-}\n\ntype IfLclName = FastString     -- A local name in iface syntax\n\ntype IfExtName = Name   -- An External or WiredIn Name can appear in IfaceSyn\n                        -- (However Internal or System Names never should)\n\ndata IfaceBndr          -- Local (non-top-level) binders\n  = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr\n  | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr\n\ntype IfaceIdBndr  = (IfLclName, IfaceType)\ntype IfaceTvBndr  = (IfLclName, IfaceKind)\n\nifaceTvBndrName :: IfaceTvBndr -> IfLclName\nifaceTvBndrName (n,_) = n\n\nifaceIdBndrName :: IfaceIdBndr -> IfLclName\nifaceIdBndrName (n,_) = n\n\nifaceBndrName :: IfaceBndr -> IfLclName\nifaceBndrName (IfaceTvBndr bndr) = ifaceTvBndrName bndr\nifaceBndrName (IfaceIdBndr bndr) = ifaceIdBndrName bndr\n\ntype IfaceLamBndr = (IfaceBndr, IfaceOneShot)\n\ndata IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy\n  = IfaceNoOneShot   -- and Note [The oneShot function] in MkId\n  | IfaceOneShot\n\n\n{-\n%************************************************************************\n%*                                                                      *\n                IfaceType\n%*                                                                      *\n%************************************************************************\n-}\n\n-------------------------------\ntype IfaceKind     = IfaceType\n\n-- | A kind of universal type, used for types and kinds.\n--\n-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'\n-- before being printed. See Note [Pretty printing via IfaceSyn] in PprTyThing\ndata IfaceType\n  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]\n  | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon\n  | IfaceLitTy     IfaceTyLit\n  | IfaceAppTy     IfaceType IfaceAppArgs\n                             -- See Note [Suppressing invisible arguments] for\n                             -- an explanation of why the second field isn't\n                             -- IfaceType, analogous to AppTy.\n  | IfaceFunTy     AnonArgFlag IfaceType IfaceType\n  | IfaceForAllTy  IfaceForAllBndr IfaceType\n  | IfaceTyConApp  IfaceTyCon IfaceAppArgs  -- Not necessarily saturated\n                                            -- Includes newtypes, synonyms, tuples\n  | IfaceCastTy     IfaceType IfaceCoercion\n  | IfaceCoercionTy IfaceCoercion\n\n  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)\n       TupleSort                  -- What sort of tuple?\n       PromotionFlag                 -- A bit like IfaceTyCon\n       IfaceAppArgs               -- arity = length args\n          -- For promoted data cons, the kind args are omitted\n\ntype IfacePredType = IfaceType\ntype IfaceContext = [IfacePredType]\n\ndata IfaceTyLit\n  = IfaceNumTyLit Integer\n  | IfaceStrTyLit FastString\n  deriving (Eq)\n\ntype IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis\ntype IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag\n\n-- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'.\nmkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr\nmkIfaceForAllTvBndr vis var = Bndr (IfaceTvBndr var) vis\n\n-- | Stores the arguments in a type application as a list.\n-- See @Note [Suppressing invisible arguments]@.\ndata IfaceAppArgs\n  = IA_Nil\n  | IA_Arg IfaceType    -- The type argument\n\n           ArgFlag      -- The argument's visibility. We store this here so\n                        -- that we can:\n                        --\n                        -- 1. Avoid pretty-printing invisible (i.e., specified\n                        --    or inferred) arguments when\n                        --    -fprint-explicit-kinds isn't enabled, or\n                        -- 2. When -fprint-explicit-kinds *is*, enabled, print\n                        --    specified arguments in @(...) and inferred\n                        --    arguments in @{...}.\n\n           IfaceAppArgs -- The rest of the arguments\n\ninstance Semi.Semigroup IfaceAppArgs where\n  IA_Nil <> xs              = xs\n  IA_Arg ty argf rest <> xs = IA_Arg ty argf (rest Semi.<> xs)\n\ninstance Monoid IfaceAppArgs where\n  mempty = IA_Nil\n  mappend = (Semi.<>)\n\n-- Encodes type constructors, kind constructors,\n-- coercion constructors, the lot.\n-- We have to tag them in order to pretty print them\n-- properly.\ndata IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName\n                             , ifaceTyConInfo :: IfaceTyConInfo }\n    deriving (Eq)\n\n-- | The various types of TyCons which have special, built-in syntax.\ndata IfaceTyConSort = IfaceNormalTyCon          -- ^ a regular tycon\n\n                    | IfaceTupleTyCon !Arity !TupleSort\n                      -- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@.\n                      -- The arity is the tuple width, not the tycon arity\n                      -- (which is twice the width in the case of unboxed\n                      -- tuples).\n\n                    | IfaceSumTyCon !Arity\n                      -- ^ e.g. @(a | b | c)@\n\n                    | IfaceEqualityTyCon\n                      -- ^ A heterogeneous equality TyCon\n                      --   (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)\n                      -- that is actually being applied to two types\n                      -- of the same kind.  This affects pretty-printing\n                      -- only: see Note [Equality predicates in IfaceType]\n                    deriving (Eq)\n\n{- Note [Free tyvars in IfaceType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNowadays (since Nov 16, 2016) we pretty-print a Type by converting to\nan IfaceType and pretty printing that.  This eliminates a lot of\npretty-print duplication, and it matches what we do with pretty-\nprinting TyThings. See Note [Pretty printing via IfaceSyn] in PprTyThing.\n\nIt works fine for closed types, but when printing debug traces (e.g.\nwhen using -ddump-tc-trace) we print a lot of /open/ types.  These\ntypes are full of TcTyVars, and it's absolutely crucial to print them\nin their full glory, with their unique, TcTyVarDetails etc.\n\nSo we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.\nNote that:\n\n* We never expect to serialise an IfaceFreeTyVar into an interface file, nor\n  to deserialise one.  IfaceFreeTyVar is used only in the \"convert to IfaceType\n  and then pretty-print\" pipeline.\n\nWe do the same for covars, naturally.\n\nNote [Equality predicates in IfaceType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC has several varieties of type equality (see Note [The equality types story]\nin TysPrim for details).  In an effort to avoid confusing users, we suppress\nthe differences during pretty printing unless certain flags are enabled.\nHere is how each equality predicate* is printed in homogeneous and\nheterogeneous contexts, depending on which combination of the\n-fprint-explicit-kinds and -fprint-equality-relations flags is used:\n\n--------------------------------------------------------------------------------------------\n|         Predicate             |        Neither flag        |    -fprint-explicit-kinds   |\n|-------------------------------|----------------------------|-----------------------------|\n| a ~ b         (homogeneous)   |        a ~ b               | (a :: Type) ~  (b :: Type)  |\n| a ~~ b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |\n| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |\n| a ~# b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |\n| a ~# b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |\n| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |\n| a ~R# b,      homogeneously   |        Coercible a b       | Coercible @Type a b         |\n| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |\n|-------------------------------|----------------------------|-----------------------------|\n|         Predicate             | -fprint-equality-relations |          Both flags         |\n|-------------------------------|----------------------------|-----------------------------|\n| a ~ b         (homogeneous)   |        a ~  b              | (a :: Type) ~  (b :: Type)  |\n| a ~~ b,       homogeneously   |        a ~~ b              | (a :: Type) ~~ (b :: Type)  |\n| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |\n| a ~# b,       homogeneously   |        a ~# b              | (a :: Type) ~# (b :: Type)  |\n| a ~# b,       heterogeneously |        a ~# c              | (a :: Type) ~# (c :: k)     |\n| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |\n| a ~R# b,      homogeneously   |        a ~R# b             | (a :: Type) ~R# (b :: Type) |\n| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |\n--------------------------------------------------------------------------------------------\n\n(* There is no heterogeneous, representational, lifted equality counterpart\nto (~~). There could be, but there seems to be no use for it.)\n\nThis table adheres to the following rules:\n\nA. With -fprint-equality-relations, print the true equality relation.\nB. Without -fprint-equality-relations:\n     i. If the equality is representational and homogeneous, use Coercible.\n    ii. Otherwise, if the equality is representational, use ~R#.\n   iii. If the equality is nominal and homogeneous, use ~.\n    iv. Otherwise, if the equality is nominal, use ~~.\nC. With -fprint-explicit-kinds, print kinds on both sides of an infix operator,\n   as above; or print the kind with Coercible.\nD. Without -fprint-explicit-kinds, don't print kinds.\n\nA hetero-kinded equality is used homogeneously when it is applied to two\nidentical kinds. Unfortunately, determining this from an IfaceType isn't\npossible since we can't see through type synonyms. Consequently, we need to\nrecord whether this particular application is homogeneous in IfaceTyConSort\nfor the purposes of pretty-printing.\n\nSee Note [The equality types story] in TysPrim.\n-}\n\ndata IfaceTyConInfo   -- Used to guide pretty-printing\n                      -- and to disambiguate D from 'D (they share a name)\n  = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag\n                   , ifaceTyConSort       :: IfaceTyConSort }\n    deriving (Eq)\n\ndata IfaceMCoercion\n  = IfaceMRefl\n  | IfaceMCo IfaceCoercion\n\ndata IfaceCoercion\n  = IfaceReflCo       IfaceType\n  | IfaceGReflCo      Role IfaceType (IfaceMCoercion)\n  | IfaceFunCo        Role IfaceCoercion IfaceCoercion\n  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]\n  | IfaceAppCo        IfaceCoercion IfaceCoercion\n  | IfaceForAllCo     IfaceBndr IfaceCoercion IfaceCoercion\n  | IfaceCoVarCo      IfLclName\n  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]\n  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]\n       -- There are only a fixed number of CoAxiomRules, so it suffices\n       -- to use an IfaceLclName to distinguish them.\n       -- See Note [Adding built-in type families] in TcTypeNats\n  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType\n  | IfaceSymCo        IfaceCoercion\n  | IfaceTransCo      IfaceCoercion IfaceCoercion\n  | IfaceNthCo        Int IfaceCoercion\n  | IfaceLRCo         LeftOrRight IfaceCoercion\n  | IfaceInstCo       IfaceCoercion IfaceCoercion\n  | IfaceKindCo       IfaceCoercion\n  | IfaceSubCo        IfaceCoercion\n  | IfaceFreeCoVar    CoVar    -- See Note [Free tyvars in IfaceType]\n  | IfaceHoleCo       CoVar    -- ^ See Note [Holes in IfaceCoercion]\n\ndata IfaceUnivCoProv\n  = IfaceUnsafeCoerceProv\n  | IfacePhantomProv IfaceCoercion\n  | IfaceProofIrrelProv IfaceCoercion\n  | IfacePluginProv String\n\n{- Note [Holes in IfaceCoercion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen typechecking fails the typechecker will produce a HoleCo to stand\nin place of the unproven assertion. While we generally don't want to\nlet these unproven assertions leak into interface files, we still need\nto be able to pretty-print them as we use IfaceType's pretty-printer\nto render Types. For this reason IfaceCoercion has a IfaceHoleCo\nconstructor; however, we fails when asked to serialize to a\nIfaceHoleCo to ensure that they don't end up in an interface file.\n\n\n%************************************************************************\n%*                                                                      *\n                Functions over IFaceTypes\n*                                                                      *\n************************************************************************\n-}\n\nifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool\nifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key\n\nisIfaceLiftedTypeKind :: IfaceKind -> Bool\nisIfaceLiftedTypeKind (IfaceTyConApp tc IA_Nil)\n  = isLiftedTypeKindTyConName (ifaceTyConName tc)\nisIfaceLiftedTypeKind (IfaceTyConApp tc\n                       (IA_Arg (IfaceTyConApp ptr_rep_lifted IA_Nil)\n                               Required IA_Nil))\n  =  tc `ifaceTyConHasKey` tYPETyConKey\n  && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey\nisIfaceLiftedTypeKind _ = False\n\nsplitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)\n-- Mainly for printing purposes\n--\n-- Here we split nested IfaceSigmaTy properly.\n--\n-- @\n-- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b)\n-- @\n--\n-- If you called @splitIfaceSigmaTy@ on this type:\n--\n-- @\n-- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b))\n-- @\nsplitIfaceSigmaTy ty\n  = case (bndrs, theta) of\n      ([], []) -> (bndrs, theta, tau)\n      _        -> let (bndrs', theta', tau') = splitIfaceSigmaTy tau\n                   in (bndrs ++ bndrs', theta ++ theta', tau')\n  where\n    (bndrs, rho)   = split_foralls ty\n    (theta, tau)   = split_rho rho\n\n    split_foralls (IfaceForAllTy bndr ty)\n        = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }\n    split_foralls rho = ([], rho)\n\n    split_rho (IfaceFunTy InvisArg ty1 ty2)\n        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }\n    split_rho tau = ([], tau)\n\nsuppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]\nsuppressIfaceInvisibles dflags tys xs\n  | gopt Opt_PrintExplicitKinds dflags = xs\n  | otherwise = suppress tys xs\n    where\n      suppress _       []      = []\n      suppress []      a       = a\n      suppress (k:ks) (x:xs)\n        | isInvisibleTyConBinder k =     suppress ks xs\n        | otherwise                = x : suppress ks xs\n\nstripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]\nstripIfaceInvisVars dflags tyvars\n  | gopt Opt_PrintExplicitKinds dflags = tyvars\n  | otherwise = filterOut isInvisibleTyConBinder tyvars\n\n-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.\nifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr\nifForAllBndrVar = binderVar\n\n-- | Extract the variable name from an 'IfaceForAllBndr'.\nifForAllBndrName :: IfaceForAllBndr -> IfLclName\nifForAllBndrName fab = ifaceBndrName (ifForAllBndrVar fab)\n\n-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.\nifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr\nifTyConBinderVar = binderVar\n\n-- | Extract the variable name from an 'IfaceTyConBinder'.\nifTyConBinderName :: IfaceTyConBinder -> IfLclName\nifTyConBinderName tcb = ifaceBndrName (ifTyConBinderVar tcb)\n\nifTypeIsVarFree :: IfaceType -> Bool\n-- Returns True if the type definitely has no variables at all\n-- Just used to control pretty printing\nifTypeIsVarFree ty = go ty\n  where\n    go (IfaceTyVar {})         = False\n    go (IfaceFreeTyVar {})     = False\n    go (IfaceAppTy fun args)   = go fun && go_args args\n    go (IfaceFunTy _ arg res)  = go arg && go res\n    go (IfaceForAllTy {})      = False\n    go (IfaceTyConApp _ args)  = go_args args\n    go (IfaceTupleTy _ _ args) = go_args args\n    go (IfaceLitTy _)          = True\n    go (IfaceCastTy {})        = False -- Safe\n    go (IfaceCoercionTy {})    = False -- Safe\n\n    go_args IA_Nil = True\n    go_args (IA_Arg arg _ args) = go arg && go_args args\n\n{- Note [Substitution on IfaceType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSubstitutions on IfaceType are done only during pretty-printing to\nconstruct the result type of a GADT, and does not deal with binders\n(eg IfaceForAll), so it doesn't need fancy capture stuff.  -}\n\ntype IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]\n\nmkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst\n-- See Note [Substitution on IfaceType]\nmkIfaceTySubst eq_spec = mkFsEnv eq_spec\n\ninDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool\n-- See Note [Substitution on IfaceType]\ninDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs)\n\nsubstIfaceType :: IfaceTySubst -> IfaceType -> IfaceType\n-- See Note [Substitution on IfaceType]\nsubstIfaceType env ty\n  = go ty\n  where\n    go (IfaceFreeTyVar tv)    = IfaceFreeTyVar tv\n    go (IfaceTyVar tv)        = substIfaceTyVar env tv\n    go (IfaceAppTy  t ts)     = IfaceAppTy  (go t) (substIfaceAppArgs env ts)\n    go (IfaceFunTy af t1 t2)  = IfaceFunTy af (go t1) (go t2)\n    go ty@(IfaceLitTy {})     = ty\n    go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceAppArgs env tys)\n    go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceAppArgs env tys)\n    go (IfaceForAllTy {})     = pprPanic \"substIfaceType\" (ppr ty)\n    go (IfaceCastTy ty co)    = IfaceCastTy (go ty) (go_co co)\n    go (IfaceCoercionTy co)   = IfaceCoercionTy (go_co co)\n\n    go_mco IfaceMRefl    = IfaceMRefl\n    go_mco (IfaceMCo co) = IfaceMCo $ go_co co\n\n    go_co (IfaceReflCo ty)           = IfaceReflCo (go ty)\n    go_co (IfaceGReflCo r ty mco)    = IfaceGReflCo r (go ty) (go_mco mco)\n    go_co (IfaceFunCo r c1 c2)       = IfaceFunCo r (go_co c1) (go_co c2)\n    go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos)\n    go_co (IfaceAppCo c1 c2)         = IfaceAppCo (go_co c1) (go_co c2)\n    go_co (IfaceForAllCo {})         = pprPanic \"substIfaceCoercion\" (ppr ty)\n    go_co (IfaceFreeCoVar cv)        = IfaceFreeCoVar cv\n    go_co (IfaceCoVarCo cv)          = IfaceCoVarCo cv\n    go_co (IfaceHoleCo cv)           = IfaceHoleCo cv\n    go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)\n    go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)\n    go_co (IfaceSymCo co)            = IfaceSymCo (go_co co)\n    go_co (IfaceTransCo co1 co2)     = IfaceTransCo (go_co co1) (go_co co2)\n    go_co (IfaceNthCo n co)          = IfaceNthCo n (go_co co)\n    go_co (IfaceLRCo lr co)          = IfaceLRCo lr (go_co co)\n    go_co (IfaceInstCo c1 c2)        = IfaceInstCo (go_co c1) (go_co c2)\n    go_co (IfaceKindCo co)           = IfaceKindCo (go_co co)\n    go_co (IfaceSubCo co)            = IfaceSubCo (go_co co)\n    go_co (IfaceAxiomRuleCo n cos)   = IfaceAxiomRuleCo n (go_cos cos)\n\n    go_cos = map go_co\n\n    go_prov IfaceUnsafeCoerceProv    = IfaceUnsafeCoerceProv\n    go_prov (IfacePhantomProv co)    = IfacePhantomProv (go_co co)\n    go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)\n    go_prov (IfacePluginProv str)    = IfacePluginProv str\n\nsubstIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs\nsubstIfaceAppArgs env args\n  = go args\n  where\n    go IA_Nil              = IA_Nil\n    go (IA_Arg ty arg tys) = IA_Arg (substIfaceType env ty) arg (go tys)\n\nsubstIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType\nsubstIfaceTyVar env tv\n  | Just ty <- lookupFsEnv env tv = ty\n  | otherwise                     = IfaceTyVar tv\n\n\n{-\n************************************************************************\n*                                                                      *\n                Functions over IfaceAppArgs\n*                                                                      *\n************************************************************************\n-}\n\nstripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs\nstripInvisArgs dflags tys\n  | gopt Opt_PrintExplicitKinds dflags = tys\n  | otherwise = suppress_invis tys\n    where\n      suppress_invis c\n        = case c of\n            IA_Nil -> IA_Nil\n            IA_Arg t argf ts\n              |  isVisibleArgFlag argf\n              -> IA_Arg t argf $ suppress_invis ts\n              -- Keep recursing through the remainder of the arguments, as it's\n              -- possible that there are remaining invisible ones.\n              -- See the \"In type declarations\" section of Note [VarBndrs,\n              -- TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.\n              |  otherwise\n              -> suppress_invis ts\n\nappArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]\nappArgsIfaceTypes IA_Nil = []\nappArgsIfaceTypes (IA_Arg t _ ts) = t : appArgsIfaceTypes ts\n\nappArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]\nappArgsIfaceTypesArgFlags IA_Nil = []\nappArgsIfaceTypesArgFlags (IA_Arg t a ts)\n                                 = (t, a) : appArgsIfaceTypesArgFlags ts\n\nifaceVisAppArgsLength :: IfaceAppArgs -> Int\nifaceVisAppArgsLength = go 0\n  where\n    go !n IA_Nil = n\n    go n  (IA_Arg _ argf rest)\n      | isVisibleArgFlag argf = go (n+1) rest\n      | otherwise             = go n rest\n\n{-\nNote [Suppressing invisible arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe use the IfaceAppArgs data type to specify which of the arguments to a type\nshould be displayed when pretty-printing, under the control of\n-fprint-explicit-kinds.\nSee also Type.filterOutInvisibleTypes.\nFor example, given\n\n    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism\n    'Just :: forall k. k -> 'Maybe k   -- Promoted\n\nwe want\n\n    T * Tree Int    prints as    T Tree Int\n    'Just *         prints as    Just *\n\nFor type constructors (IfaceTyConApp), IfaceAppArgs is a quite natural fit,\nsince the corresponding Core constructor:\n\n    data Type\n      = ...\n      | TyConApp TyCon [Type]\n\nAlready puts all of its arguments into a list. So when converting a Type to an\nIfaceType (see toIfaceAppArgsX in ToIface), we simply use the kind of the TyCon\n(which is cached) to guide the process of converting the argument Types into an\nIfaceAppArgs list.\n\nWe also want this behavior for IfaceAppTy, since given:\n\n    data Proxy (a :: k)\n    f :: forall (t :: forall a. a -> Type). Proxy Type (t Bool True)\n\nWe want to print the return type as `Proxy (t True)` without the use of\n-fprint-explicit-kinds (#15330). Accomplishing this is trickier than in the\ntycon case, because the corresponding Core constructor for IfaceAppTy:\n\n    data Type\n      = ...\n      | AppTy Type Type\n\nOnly stores one argument at a time. Therefore, when converting an AppTy to an\nIfaceAppTy (in toIfaceTypeX in ToIface), we:\n\n1. Flatten the chain of AppTys down as much as possible\n2. Use typeKind to determine the function Type's kind\n3. Use this kind to guide the process of converting the argument Types into an\n   IfaceAppArgs list.\n\nBy flattening the arguments like this, we obtain two benefits:\n\n(a) We can reuse the same machinery to pretty-print IfaceTyConApp arguments as\n    we do IfaceTyApp arguments, which means that we only need to implement the\n    logic to filter out invisible arguments once.\n(b) Unlike for tycons, finding the kind of a type in general (through typeKind)\n    is not a constant-time operation, so by flattening the arguments first, we\n    decrease the number of times we have to call typeKind.\n\nNote [Pretty-printing invisible arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNote [Suppressing invisible arguments] is all about how to avoid printing\ninvisible arguments when the -fprint-explicit-kinds flag is disables. Well,\nwhat about when it's enabled? Then we can and should print invisible kind\narguments, and this Note explains how we do it.\n\nAs two running examples, consider the following code:\n\n  {-# LANGUAGE PolyKinds #-}\n  data T1 a\n  data T2 (a :: k)\n\nWhen displaying these types (with -fprint-explicit-kinds on), we could just\ndo the following:\n\n  T1 k a\n  T2 k a\n\nThat certainly gets the job done. But it lacks a crucial piece of information:\nis the `k` argument inferred or specified? To communicate this, we use visible\nkind application syntax to distinguish the two cases:\n\n  T1 @{k} a\n  T2 @k   a\n\nHere, @{k} indicates that `k` is an inferred argument, and @k indicates that\n`k` is a specified argument. (See\nNote [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep for\na lengthier explanation on what \"inferred\" and \"specified\" mean.)\n\n************************************************************************\n*                                                                      *\n                Pretty-printing\n*                                                                      *\n************************************************************************\n-}\n\nif_print_coercions :: SDoc  -- ^ if printing coercions\n                   -> SDoc  -- ^ otherwise\n                   -> SDoc\nif_print_coercions yes no\n  = sdocWithDynFlags $ \\dflags ->\n    getPprStyle $ \\style ->\n    if gopt Opt_PrintExplicitCoercions dflags\n         || dumpStyle style || debugStyle style\n    then yes\n    else no\n\npprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc\npprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2\n  = maybeParen ctxt_prec opPrec $\n    sep [pp_ty1, pp_tc <+> pp_ty2]\n\npprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc\npprIfacePrefixApp ctxt_prec pp_fun pp_tys\n  | null pp_tys = pp_fun\n  | otherwise   = maybeParen ctxt_prec appPrec $\n                  hang pp_fun 2 (sep pp_tys)\n\n-- ----------------------------- Printing binders ------------------------------------\n\ninstance Outputable IfaceBndr where\n    ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr\n    ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr\n\npprIfaceBndrs :: [IfaceBndr] -> SDoc\npprIfaceBndrs bs = sep (map ppr bs)\n\npprIfaceLamBndr :: IfaceLamBndr -> SDoc\npprIfaceLamBndr (b, IfaceNoOneShot) = ppr b\npprIfaceLamBndr (b, IfaceOneShot)   = ppr b <> text \"[OneShot]\"\n\npprIfaceIdBndr :: IfaceIdBndr -> SDoc\npprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)\n\npprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc\npprIfaceTvBndr use_parens (tv, ki)\n  | isIfaceLiftedTypeKind ki = ppr tv\n  | otherwise                = maybe_parens (ppr tv <+> dcolon <+> ppr ki)\n  where\n    maybe_parens | use_parens = parens\n                 | otherwise  = id\n\npprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc\npprIfaceTyConBinders = sep . map go\n  where\n    go :: IfaceTyConBinder -> SDoc\n    go (Bndr (IfaceIdBndr bndr) _) = pprIfaceIdBndr bndr\n    go (Bndr (IfaceTvBndr bndr) vis) =\n      -- See Note [Pretty-printing invisible arguments]\n      case vis of\n        AnonTCB  VisArg    -> ppr_bndr True\n        AnonTCB  InvisArg  -> ppr_bndr True  -- Rare; just promoted GADT data constructors\n                                             -- Should we print them differently?\n        NamedTCB Required  -> ppr_bndr True\n        NamedTCB Specified -> char '@' <> ppr_bndr True\n        NamedTCB Inferred  -> char '@' <> braces (ppr_bndr False)\n      where\n        ppr_bndr use_parens = pprIfaceTvBndr use_parens bndr\n\ninstance Binary IfaceBndr where\n    put_ bh (IfaceIdBndr aa) = do\n            putByte bh 0\n            put_ bh aa\n    put_ bh (IfaceTvBndr ab) = do\n            putByte bh 1\n            put_ bh ab\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do aa <- get bh\n                      return (IfaceIdBndr aa)\n              _ -> do ab <- get bh\n                      return (IfaceTvBndr ab)\n\ninstance Binary IfaceOneShot where\n    put_ bh IfaceNoOneShot = do\n            putByte bh 0\n    put_ bh IfaceOneShot = do\n            putByte bh 1\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return IfaceNoOneShot\n              _ -> do return IfaceOneShot\n\n-- ----------------------------- Printing IfaceType ------------------------------------\n\n---------------------------------\ninstance Outputable IfaceType where\n  ppr ty = pprIfaceType ty\n\npprIfaceType, pprParendIfaceType :: IfaceType -> SDoc\npprIfaceType       = pprPrecIfaceType topPrec\npprParendIfaceType = pprPrecIfaceType appPrec\n\npprPrecIfaceType :: PprPrec -> IfaceType -> SDoc\n-- We still need `eliminateRuntimeRep`, since the `pprPrecIfaceType` maybe\n-- called from other places, besides `:type` and `:info`.\npprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty\n\nppr_sigma :: PprPrec -> IfaceType -> SDoc\nppr_sigma ctxt_prec ty\n  = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty)\n\nppr_ty :: PprPrec -> IfaceType -> SDoc\nppr_ty ctxt_prec ty@(IfaceForAllTy {})        = ppr_sigma ctxt_prec ty\nppr_ty ctxt_prec ty@(IfaceFunTy InvisArg _ _) = ppr_sigma ctxt_prec ty\n\nppr_ty _         (IfaceFreeTyVar tyvar) = ppr tyvar  -- This is the main reason for IfaceFreeTyVar!\nppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [TcTyVars in IfaceType]\nppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys\nppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys\nppr_ty _         (IfaceLitTy n)         = pprIfaceTyLit n\n        -- Function types\nppr_ty ctxt_prec (IfaceFunTy _ ty1 ty2)  -- Should be VisArg\n  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.\n    maybeParen ctxt_prec funPrec $\n    sep [ppr_ty funPrec ty1, sep (ppr_fun_tail ty2)]\n  where\n    ppr_fun_tail (IfaceFunTy VisArg ty1 ty2)\n      = (arrow <+> ppr_ty funPrec ty1) : ppr_fun_tail ty2\n    ppr_fun_tail other_ty\n      = [arrow <+> pprIfaceType other_ty]\n\nppr_ty ctxt_prec (IfaceAppTy t ts)\n  = if_print_coercions\n      ppr_app_ty\n      ppr_app_ty_no_casts\n  where\n    ppr_app_ty =\n        sdocWithDynFlags $ \\dflags ->\n        pprIfacePrefixApp ctxt_prec\n                          (ppr_ty funPrec t)\n                          (map (ppr_app_arg appPrec) (tys_wo_kinds dflags))\n\n    tys_wo_kinds dflags = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags ts\n\n    -- Strip any casts from the head of the application\n    ppr_app_ty_no_casts =\n        case t of\n          IfaceCastTy head _ -> ppr_ty ctxt_prec (mk_app_tys head ts)\n          _                  -> ppr_app_ty\n\n    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType\n    mk_app_tys (IfaceTyConApp tc tys1) tys2 =\n        IfaceTyConApp tc (tys1 `mappend` tys2)\n    mk_app_tys t1 tys2 = IfaceAppTy t1 tys2\n\nppr_ty ctxt_prec (IfaceCastTy ty co)\n  = if_print_coercions\n      (parens (ppr_ty topPrec ty <+> text \"|>\" <+> ppr co))\n      (ppr_ty ctxt_prec ty)\n\nppr_ty ctxt_prec (IfaceCoercionTy co)\n  = if_print_coercions\n      (ppr_co ctxt_prec co)\n      (text \"<>\")\n\n{- Note [Defaulting RuntimeRep variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRuntimeRep variables are considered by many (most?) users to be little\nmore than syntactic noise. When the notion was introduced there was a\nsignficant and understandable push-back from those with pedagogy in\nmind, which argued that RuntimeRep variables would throw a wrench into\nnearly any teach approach since they appear in even the lowly ($)\nfunction's type,\n\n    ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b\n\nwhich is significantly less readable than its non RuntimeRep-polymorphic type of\n\n    ($) :: (a -> b) -> a -> b\n\nMoreover, unboxed types don't appear all that often in run-of-the-mill\nHaskell programs, so it makes little sense to make all users pay this\nsyntactic overhead.\n\nFor this reason it was decided that we would hide RuntimeRep variables\nfor now (see #11549). We do this by defaulting all type variables of\nkind RuntimeRep to LiftedRep. This is done in a pass right before\npretty-printing (defaultRuntimeRepVars, controlled by\n-fprint-explicit-runtime-reps)\n\nThis applies to /quantified/ variables like 'w' above.  What about\nvariables that are /free/ in the type being printed, which certainly\nhappens in error messages.  Suppose (Trac #16074) we are reporting a\nmismatch between two skolems\n          (a :: RuntimeRep) ~ (b :: RuntimeRep)\nWe certainly don't want to say \"Can't match LiftedRep ~ LiftedRep\"!\n\nBut if we are printing the type\n    (forall (a :: Type r). blah\nwe do want to turn that (free) r into LiftedRep, so it prints as\n    (forall a. blah)\n\nConclusion: keep track of whether we we are in the kind of a\nbinder; ohly if so, convert free RuntimeRep variables to LiftedRep.\n-}\n\n-- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.\n--\n-- @\n-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).\n--        (a -> b) -> a -> b\n-- @\n--\n-- turns in to,\n--\n-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @\n--\n-- We do this to prevent RuntimeRep variables from incurring a significant\n-- syntactic overhead in otherwise simple type signatures (e.g. ($)). See\n-- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.\n--\ndefaultRuntimeRepVars :: IfaceType -> IfaceType\ndefaultRuntimeRepVars ty = go False emptyFsEnv ty\n  where\n    go :: Bool              -- True <=> Inside the kind of a binder\n       -> FastStringEnv ()  -- Set of enclosing forall-ed RuntimeRep variables\n       -> IfaceType         --  (replace them with LiftedRep)\n       -> IfaceType\n    go ink subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty)\n     | isRuntimeRep var_kind\n      , isInvisibleArgFlag argf -- Don't default *visible* quantification\n                                -- or we get the mess in #13963\n      = let subs' = extendFsEnv subs var ()\n            -- Record that we should replace it with LiftedRep,\n            -- and recurse, discarding the forall\n        in go ink subs' ty\n\n    go ink subs (IfaceForAllTy bndr ty)\n      = IfaceForAllTy (go_ifacebndr subs bndr) (go ink subs ty)\n\n    go _ subs ty@(IfaceTyVar tv)\n      | tv `elemFsEnv` subs\n      = IfaceTyConApp liftedRep IA_Nil\n      | otherwise\n      = ty\n\n    go in_kind _ ty@(IfaceFreeTyVar tv)\n      -- See Note [Defaulting RuntimeRep variables], about free vars\n      | in_kind && TyCoRep.isRuntimeRepTy (tyVarKind tv)\n      = IfaceTyConApp liftedRep IA_Nil\n      | otherwise\n      = ty\n\n    go ink subs (IfaceTyConApp tc tc_args)\n      = IfaceTyConApp tc (go_args ink subs tc_args)\n\n    go ink subs (IfaceTupleTy sort is_prom tc_args)\n      = IfaceTupleTy sort is_prom (go_args ink subs tc_args)\n\n    go ink subs (IfaceFunTy af arg res)\n      = IfaceFunTy af (go ink subs arg) (go ink subs res)\n\n    go ink subs (IfaceAppTy t ts)\n      = IfaceAppTy (go ink subs t) (go_args ink subs ts)\n\n    go ink subs (IfaceCastTy x co)\n      = IfaceCastTy (go ink subs x) co\n\n    go _ _ ty@(IfaceLitTy {}) = ty\n    go _ _ ty@(IfaceCoercionTy {}) = ty\n\n    go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr\n    go_ifacebndr subs (Bndr (IfaceIdBndr (n, t)) argf)\n      = Bndr (IfaceIdBndr (n, go True subs t)) argf\n    go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf)\n      = Bndr (IfaceTvBndr (n, go True subs t)) argf\n\n    go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs\n    go_args _ _ IA_Nil = IA_Nil\n    go_args ink subs (IA_Arg ty argf args)\n      = IA_Arg (go ink subs ty) argf (go_args ink subs args)\n\n    liftedRep :: IfaceTyCon\n    liftedRep = IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)\n      where dc_name = getName liftedRepDataConTyCon\n\n    isRuntimeRep :: IfaceType -> Bool\n    isRuntimeRep (IfaceTyConApp tc _) =\n        tc `ifaceTyConHasKey` runtimeRepTyConKey\n    isRuntimeRep _ = False\n\neliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc\neliminateRuntimeRep f ty\n  = sdocWithDynFlags $ \\dflags ->\n    getPprStyle      $ \\sty    ->\n    if userStyle sty && not (gopt Opt_PrintExplicitRuntimeReps dflags)\n      then f (defaultRuntimeRepVars ty)\n      else f ty\n\ninstance Outputable IfaceAppArgs where\n  ppr tca = pprIfaceAppArgs tca\n\npprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc\npprIfaceAppArgs  = ppr_app_args topPrec\npprParendIfaceAppArgs = ppr_app_args appPrec\n\nppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc\nppr_app_args ctx_prec = go\n  where\n    go :: IfaceAppArgs -> SDoc\n    go IA_Nil             = empty\n    go (IA_Arg t argf ts) = ppr_app_arg ctx_prec (t, argf) <+> go ts\n\n-- See Note [Pretty-printing invisible arguments]\nppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc\nppr_app_arg ctx_prec (t, argf) =\n  sdocWithDynFlags $ \\dflags ->\n  let print_kinds = gopt Opt_PrintExplicitKinds dflags\n  in case argf of\n       Required  -> ppr_ty ctx_prec t\n       Specified |  print_kinds\n                 -> char '@' <> ppr_ty appPrec t\n       Inferred  |  print_kinds\n                 -> char '@' <> braces (ppr_ty topPrec t)\n       _         -> empty\n\n-------------------\npprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc\npprIfaceForAllPart tvs ctxt sdoc\n  = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc\n\n-- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.\npprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc\npprIfaceForAllPartMust tvs ctxt sdoc\n  = ppr_iface_forall_part ShowForAllMust tvs ctxt sdoc\n\npprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc\npprIfaceForAllCoPart tvs sdoc\n  = sep [ pprIfaceForAllCo tvs, sdoc ]\n\nppr_iface_forall_part :: ShowForAllFlag\n                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc\nppr_iface_forall_part show_forall tvs ctxt sdoc\n  = sep [ case show_forall of\n            ShowForAllMust -> pprIfaceForAll tvs\n            ShowForAllWhen -> pprUserIfaceForAll tvs\n        , pprIfaceContextArr ctxt\n        , sdoc]\n\n-- | Render the \"forall ... .\" or \"forall ... ->\" bit of a type.\npprIfaceForAll :: [IfaceForAllBndr] -> SDoc\npprIfaceForAll [] = empty\npprIfaceForAll bndrs@(Bndr _ vis : _)\n  = sep [ add_separator (forAllLit <+> fsep docs)\n        , pprIfaceForAll bndrs' ]\n  where\n    (bndrs', docs) = ppr_itv_bndrs bndrs vis\n\n    add_separator stuff = case vis of\n                            Required -> stuff <+> arrow\n                            _inv     -> stuff <>  dot\n\n\n-- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.\n-- Returns both the list of not-yet-rendered binders and the doc.\n-- No anonymous binders here!\nppr_itv_bndrs :: [IfaceForAllBndr]\n             -> ArgFlag  -- ^ visibility of the first binder in the list\n             -> ([IfaceForAllBndr], [SDoc])\nppr_itv_bndrs all_bndrs@(bndr@(Bndr _ vis) : bndrs) vis1\n  | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in\n                         (bndrs', pprIfaceForAllBndr bndr : doc)\n  | otherwise   = (all_bndrs, [])\nppr_itv_bndrs [] _ = ([], [])\n\npprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc\npprIfaceForAllCo []  = empty\npprIfaceForAllCo tvs = text \"forall\" <+> pprIfaceForAllCoBndrs tvs <> dot\n\npprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc\npprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs\n\npprIfaceForAllBndr :: IfaceForAllBndr -> SDoc\npprIfaceForAllBndr (Bndr (IfaceTvBndr tv) Inferred)\n  = sdocWithDynFlags $ \\dflags ->\n                          if gopt Opt_PrintExplicitForalls dflags\n                          then braces $ pprIfaceTvBndr False tv\n                          else pprIfaceTvBndr True tv\npprIfaceForAllBndr (Bndr (IfaceTvBndr tv) _)  = pprIfaceTvBndr True tv\npprIfaceForAllBndr (Bndr (IfaceIdBndr idv) _) = pprIfaceIdBndr idv\n\npprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc\npprIfaceForAllCoBndr (tv, kind_co)\n  = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)\n\n-- | Show forall flag\n--\n-- Unconditionally show the forall quantifier with ('ShowForAllMust')\n-- or when ('ShowForAllWhen') the names used are free in the binder\n-- or when compiling with -fprint-explicit-foralls.\ndata ShowForAllFlag = ShowForAllMust | ShowForAllWhen\n\npprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc\npprIfaceSigmaType show_forall ty\n  = eliminateRuntimeRep ppr_fn ty\n  where\n    ppr_fn iface_ty =\n      let (tvs, theta, tau) = splitIfaceSigmaTy iface_ty\n       in ppr_iface_forall_part show_forall tvs theta (ppr tau)\n\npprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc\npprUserIfaceForAll tvs\n   = sdocWithDynFlags $ \\dflags ->\n     -- See Note [When to print foralls]\n     ppWhen (any tv_has_kind_var tvs\n             || any tv_is_required tvs\n             || gopt Opt_PrintExplicitForalls dflags) $\n     pprIfaceForAll tvs\n   where\n     tv_has_kind_var (Bndr (IfaceTvBndr (_,kind)) _)\n       = not (ifTypeIsVarFree kind)\n     tv_has_kind_var _ = False\n\n     tv_is_required = isVisibleArgFlag . binderArgFlag\n\n{-\nNote [When to print foralls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe opt to explicitly pretty-print `forall`s if any of the following\ncriteria are met:\n\n1. -fprint-explicit-foralls is on.\n\n2. A bound type variable has a polymorphic kind. E.g.,\n\n     forall k (a::k). Proxy a -> Proxy a\n\n   Since a's kind mentions a variable k, we print the foralls.\n\n3. A bound type variable is a visible argument (#14238).\n   Suppose we are printing the kind of:\n\n     T :: forall k -> k -> Type\n\n   The \"forall k ->\" notation means that this kind argument is required.\n   That is, it must be supplied at uses of T. E.g.,\n\n     f :: T (Type->Type)  Monad -> Int\n\n   So we print an explicit \"T :: forall k -> k -> Type\",\n   because omitting it and printing \"T :: k -> Type\" would be\n   utterly misleading.\n\n   See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]\n   in TyCoRep.\n\nN.B. Until now (Aug 2018) we didn't check anything for coercion variables.\n\nNote [Printing foralls in type family instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe use the same criteria as in Note [When to print foralls] to determine\nwhether a type family instance should be pretty-printed with an explicit\n`forall`. Example:\n\n  type family Foo (a :: k) :: k where\n    Foo Maybe       = []\n    Foo (a :: Type) = Int\n    Foo a           = a\n\nWithout -fprint-explicit-foralls enabled, this will be pretty-printed as:\n\ntype family Foo (a :: k) :: k where\n  Foo Maybe = []\n  Foo a = Int\n  forall k (a :: k). Foo a = a\n\nNote that only the third equation has an explicit forall, since it has a type\nvariable with a non-Type kind. (If -fprint-explicit-foralls were enabled, then\nthe second equation would be preceded with `forall a.`.)\n\nThere is one tricky point in the implementation: what visibility\ndo we give the type variables in a type family instance? Type family instances\nonly store type *variables*, not type variable *binders*, and only the latter\nhas visibility information. We opt to default the visibility of each of these\ntype variables to Specified because users can't ever instantiate these\nvariables manually, so the choice of visibility is only relevant to\npretty-printing. (This is why the `k` in `forall k (a :: k). ...` above is\nprinted the way it is, even though it wasn't written explicitly in the\noriginal source code.)\n\nWe adopt the same strategy for data family instances. Example:\n\n  data family DF (a :: k)\n  data instance DF '[a, b] = DFList\n\nThat data family instance is pretty-printed as:\n\n  data instance forall j (a :: j) (b :: j). DF '[a, b] = DFList\n\nThis is despite that the representation tycon for this data instance (call it\n$DF:List) actually has different visibilities for its binders.\nHowever, the visibilities of these binders are utterly irrelevant to the\nprogrammer, who cares only about the specificity of variables in `DF`'s type,\nnot $DF:List's type. Therefore, we opt to pretty-print all variables in data\nfamily instances as Specified.\n\nNote [Printing promoted type constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this GHCi session (Trac #14343)\n    > _ :: Proxy '[ 'True ]\n    error:\n      Found hole: _ :: Proxy '['True]\n\nThis would be bad, because the '[' looks like a character literal.\nSolution: in type-level lists and tuples, add a leading space\nif the first type is itself promoted.  See pprSpaceIfPromotedTyCon.\n-}\n\n\n-------------------\n\n-- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'.\n-- See Note [Printing promoted type constructors]\npprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc\npprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _)\n  = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of\n      IsPromoted -> (space <>)\n      _ -> id\npprSpaceIfPromotedTyCon _\n  = id\n\n-- See equivalent function in TyCoRep.hs\npprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc\n-- Given a type-level list (t1 ': t2), see if we can print\n-- it in list notation [t1, ...].\n-- Precondition: Opt_PrintExplicitKinds is off\npprIfaceTyList ctxt_prec ty1 ty2\n  = case gather ty2 of\n      (arg_tys, Nothing)\n        -> char '\\'' <> brackets (pprSpaceIfPromotedTyCon ty1 (fsep\n                        (punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys)))))\n      (arg_tys, Just tl)\n        -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1)\n           2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]])\n  where\n    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)\n     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]\n     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl\n    gather (IfaceTyConApp tc tys)\n      | tc `ifaceTyConHasKey` consDataConKey\n      , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys\n      , isInvisibleArgFlag argf\n      , (args, tl) <- gather ty2\n      = (ty1:args, tl)\n      | tc `ifaceTyConHasKey` nilDataConKey\n      = ([], Nothing)\n    gather ty = ([], Just ty)\n\npprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc\npprIfaceTypeApp prec tc args = pprTyTcApp prec tc args\n\npprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc\npprTyTcApp ctxt_prec tc tys =\n    sdocWithDynFlags $ \\dflags ->\n    getPprStyle $ \\style ->\n    pprTyTcApp' ctxt_prec tc tys dflags style\n\npprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs\n            -> DynFlags -> PprStyle -> SDoc\npprTyTcApp' ctxt_prec tc tys dflags style\n  | ifaceTyConName tc `hasKey` ipClassKey\n  , IA_Arg (IfaceLitTy (IfaceStrTyLit n))\n           Required (IA_Arg ty Required IA_Nil) <- tys\n  = maybeParen ctxt_prec funPrec\n    $ char '?' <> ftext n <> text \"::\" <> ppr_ty topPrec ty\n\n  | IfaceTupleTyCon arity sort <- ifaceTyConSort info\n  , not (debugStyle style)\n  , arity == ifaceVisAppArgsLength tys\n  = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys\n\n  | IfaceSumTyCon arity <- ifaceTyConSort info\n  = pprSum arity (ifaceTyConIsPromoted info) tys\n\n  | tc `ifaceTyConHasKey` consDataConKey\n  , not (gopt Opt_PrintExplicitKinds dflags)\n  , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys\n  , isInvisibleArgFlag argf\n  = pprIfaceTyList ctxt_prec ty1 ty2\n\n  | tc `ifaceTyConHasKey` tYPETyConKey\n  , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys\n  , rep `ifaceTyConHasKey` liftedRepDataConKey\n  = kindType\n\n  | otherwise\n  = getPprDebug $ \\dbg ->\n    if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey\n         -- Suppress detail unles you _really_ want to see\n         -> text \"(TypeError ...)\"\n\n       | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys)\n         -> doc\n\n       | otherwise\n         -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc tys_wo_kinds\n  where\n    info = ifaceTyConInfo tc\n    tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags tys\n\n-- | Pretty-print a type-level equality.\n-- Returns (Just doc) if the argument is a /saturated/ application\n-- of   eqTyCon          (~)\n--      eqPrimTyCon      (~#)\n--      eqReprPrimTyCon  (~R#)\n--      heqTyCon         (~~)\n--\n-- See Note [Equality predicates in IfaceType]\n-- and Note [The equality types story] in TysPrim\nppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc\nppr_equality ctxt_prec tc args\n  | hetero_eq_tc\n  , [k1, k2, t1, t2] <- args\n  = Just $ print_equality (k1, k2, t1, t2)\n\n  | hom_eq_tc\n  , [k, t1, t2] <- args\n  = Just $ print_equality (k, k, t1, t2)\n\n  | otherwise\n  = Nothing\n  where\n    homogeneous = tc_name `hasKey` eqTyConKey -- (~)\n               || hetero_tc_used_homogeneously\n      where\n        hetero_tc_used_homogeneously\n          = case ifaceTyConSort $ ifaceTyConInfo tc of\n                          IfaceEqualityTyCon -> True\n                          _other             -> False\n             -- True <=> a heterogeneous equality whose arguments\n             --          are (in this case) of the same kind\n\n    tc_name = ifaceTyConName tc\n    pp = ppr_ty\n    hom_eq_tc = tc_name `hasKey` eqTyConKey            -- (~)\n    hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey     -- (~#)\n                || tc_name `hasKey` eqReprPrimTyConKey -- (~R#)\n                || tc_name `hasKey` heqTyConKey        -- (~~)\n    nominal_eq_tc = tc_name `hasKey` heqTyConKey       -- (~~)\n                 || tc_name `hasKey` eqPrimTyConKey    -- (~#)\n    print_equality args =\n        sdocWithDynFlags $ \\dflags ->\n        getPprStyle      $ \\style  ->\n        print_equality' args style dflags\n\n    print_equality' (ki1, ki2, ty1, ty2) style dflags\n      | -- If -fprint-equality-relations is on, just print the original TyCon\n        print_eqs\n      = ppr_infix_eq (ppr tc)\n\n      | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2)\n        --                 or unlifted equality      (ty1 ~# ty2)\n        nominal_eq_tc, homogeneous\n      = ppr_infix_eq (text \"~\")\n\n      | -- Heterogeneous use of unlifted equality (ty1 ~# ty2)\n        not homogeneous\n      = ppr_infix_eq (ppr heqTyCon)\n\n      | -- Homogeneous use of representational unlifted equality (ty1 ~R# ty2)\n        tc_name `hasKey` eqReprPrimTyConKey, homogeneous\n      = let ki | print_kinds = [pp appPrec ki1]\n               | otherwise   = []\n        in pprIfacePrefixApp ctxt_prec (ppr coercibleTyCon)\n                            (ki ++ [pp appPrec ty1, pp appPrec ty2])\n\n        -- The other cases work as you'd expect\n      | otherwise\n      = ppr_infix_eq (ppr tc)\n      where\n        ppr_infix_eq :: SDoc -> SDoc\n        ppr_infix_eq eq_op = pprIfaceInfixApp ctxt_prec eq_op\n                               (pp_ty_ki ty1 ki1) (pp_ty_ki ty2 ki2)\n          where\n            pp_ty_ki ty ki\n              | print_kinds\n              = parens (pp topPrec ty <+> dcolon <+> pp opPrec ki)\n              | otherwise\n              = pp opPrec ty\n\n        print_kinds = gopt Opt_PrintExplicitKinds dflags\n        print_eqs   = gopt Opt_PrintEqualityRelations dflags ||\n                      dumpStyle style || debugStyle style\n\n\npprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc\npprIfaceCoTcApp ctxt_prec tc tys =\n  ppr_iface_tc_app (\\prec (co, _) -> ppr_co prec co) ctxt_prec tc\n    (map (, Required) tys)\n    -- We are trying to re-use ppr_iface_tc_app here, which requires its\n    -- arguments to be accompanied by visibilities. But visibility is\n    -- irrelevant when printing coercions, so just default everything to\n    -- Required.\n\n-- | Pretty-prints an application of a type constructor to some arguments\n-- (whose visibilities are known). This is polymorphic (over @a@) since we use\n-- this function to pretty-print two different things:\n--\n-- 1. Types (from `pprTyTcApp'`)\n--\n-- 2. Coercions (from 'pprIfaceCoTcApp')\nppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)\n                 -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc\nppr_iface_tc_app pp _ tc [ty]\n  | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)\n\nppr_iface_tc_app pp ctxt_prec tc tys\n  | tc `ifaceTyConHasKey` liftedTypeKindTyConKey\n  = kindType\n\n  | not (isSymOcc (nameOccName (ifaceTyConName tc)))\n  = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)\n\n  | [ ty1@(_, Required)\n    , ty2@(_, Required) ] <- tys\n      -- Infix, two visible arguments (we know nothing of precedence though).\n      -- Don't apply this special case if one of the arguments is invisible,\n      -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).\n  = pprIfaceInfixApp ctxt_prec (ppr tc)\n                     (pp opPrec ty1) (pp opPrec ty2)\n\n  | otherwise\n  = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)\n\npprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc\npprSum _arity is_promoted args\n  =   -- drop the RuntimeRep vars.\n      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon\n    let tys   = appArgsIfaceTypes args\n        args' = drop (length tys `div` 2) tys\n    in pprPromotionQuoteI is_promoted\n       <> sumParens (pprWithBars (ppr_ty topPrec) args')\n\npprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc\npprTuple ctxt_prec ConstraintTuple NotPromoted IA_Nil\n  = maybeParen ctxt_prec appPrec $\n    text \"() :: Constraint\"\n\n-- All promoted constructors have kind arguments\npprTuple _ sort IsPromoted args\n  = let tys = appArgsIfaceTypes args\n        args' = drop (length tys `div` 2) tys\n        spaceIfPromoted = case args' of\n          arg0:_ -> pprSpaceIfPromotedTyCon arg0\n          _ -> id\n    in pprPromotionQuoteI IsPromoted <>\n       tupleParens sort (spaceIfPromoted (pprWithCommas pprIfaceType args'))\n\npprTuple _ sort promoted args\n  =   -- drop the RuntimeRep vars.\n      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon\n    let tys   = appArgsIfaceTypes args\n        args' = case sort of\n                  UnboxedTuple -> drop (length tys `div` 2) tys\n                  _            -> tys\n    in\n    pprPromotionQuoteI promoted <>\n    tupleParens sort (pprWithCommas pprIfaceType args')\n\npprIfaceTyLit :: IfaceTyLit -> SDoc\npprIfaceTyLit (IfaceNumTyLit n) = integer n\npprIfaceTyLit (IfaceStrTyLit n) = text (show n)\n\npprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc\npprIfaceCoercion = ppr_co topPrec\npprParendIfaceCoercion = ppr_co appPrec\n\nppr_co :: PprPrec -> IfaceCoercion -> SDoc\nppr_co _         (IfaceReflCo ty) = angleBrackets (ppr ty) <> ppr_role Nominal\nppr_co _         (IfaceGReflCo r ty IfaceMRefl)\n  = angleBrackets (ppr ty) <> ppr_role r\nppr_co ctxt_prec (IfaceGReflCo r ty (IfaceMCo co))\n  = ppr_special_co ctxt_prec\n    (text \"GRefl\" <+> ppr r <+> pprParendIfaceType ty) [co]\nppr_co ctxt_prec (IfaceFunCo r co1 co2)\n  = maybeParen ctxt_prec funPrec $\n    sep (ppr_co funPrec co1 : ppr_fun_tail co2)\n  where\n    ppr_fun_tail (IfaceFunCo r co1 co2)\n      = (arrow <> ppr_role r <+> ppr_co funPrec co1) : ppr_fun_tail co2\n    ppr_fun_tail other_co\n      = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]\n\nppr_co _         (IfaceTyConAppCo r tc cos)\n  = parens (pprIfaceCoTcApp topPrec tc cos) <> ppr_role r\nppr_co ctxt_prec (IfaceAppCo co1 co2)\n  = maybeParen ctxt_prec appPrec $\n    ppr_co funPrec co1 <+> pprParendIfaceCoercion co2\nppr_co ctxt_prec co@(IfaceForAllCo {})\n  = maybeParen ctxt_prec funPrec $\n    pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co)\n  where\n    (tvs, inner_co) = split_co co\n\n    split_co (IfaceForAllCo (IfaceTvBndr (name, _)) kind_co co')\n      = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')\n    split_co (IfaceForAllCo (IfaceIdBndr (name, _)) kind_co co')\n      = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')\n    split_co co' = ([], co')\n\n-- Why these three? See Note [TcTyVars in IfaceType]\nppr_co _ (IfaceFreeCoVar covar) = ppr covar\nppr_co _ (IfaceCoVarCo covar)   = ppr covar\nppr_co _ (IfaceHoleCo covar)    = braces (ppr covar)\n\nppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)\n  = maybeParen ctxt_prec appPrec $\n    text \"UnsafeCo\" <+> ppr r <+>\n    pprParendIfaceType ty1 <+> pprParendIfaceType ty2\n\nppr_co _ (IfaceUnivCo prov role ty1 ty2)\n  = text \"Univ\" <> (parens $\n      sep [ ppr role <+> pprIfaceUnivCoProv prov\n          , dcolon <+>  ppr ty1 <> comma <+> ppr ty2 ])\n\nppr_co ctxt_prec (IfaceInstCo co ty)\n  = maybeParen ctxt_prec appPrec $\n    text \"Inst\" <+> pprParendIfaceCoercion co\n                        <+> pprParendIfaceCoercion ty\n\nppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)\n  = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos)\n\nppr_co ctxt_prec (IfaceAxiomInstCo n i cos)\n  = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos\nppr_co ctxt_prec (IfaceSymCo co)\n  = ppr_special_co ctxt_prec (text \"Sym\") [co]\nppr_co ctxt_prec (IfaceTransCo co1 co2)\n  = maybeParen ctxt_prec opPrec $\n    ppr_co opPrec co1 <+> semi <+> ppr_co opPrec co2\nppr_co ctxt_prec (IfaceNthCo d co)\n  = ppr_special_co ctxt_prec (text \"Nth:\" <> int d) [co]\nppr_co ctxt_prec (IfaceLRCo lr co)\n  = ppr_special_co ctxt_prec (ppr lr) [co]\nppr_co ctxt_prec (IfaceSubCo co)\n  = ppr_special_co ctxt_prec (text \"Sub\") [co]\nppr_co ctxt_prec (IfaceKindCo co)\n  = ppr_special_co ctxt_prec (text \"Kind\") [co]\n\nppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc\nppr_special_co ctxt_prec doc cos\n  = maybeParen ctxt_prec appPrec\n               (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])\n\nppr_role :: Role -> SDoc\nppr_role r = underscore <> pp_role\n  where pp_role = case r of\n                    Nominal          -> char 'N'\n                    Representational -> char 'R'\n                    Phantom          -> char 'P'\n\n------------------\npprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc\npprIfaceUnivCoProv IfaceUnsafeCoerceProv\n  = text \"unsafe\"\npprIfaceUnivCoProv (IfacePhantomProv co)\n  = text \"phantom\" <+> pprParendIfaceCoercion co\npprIfaceUnivCoProv (IfaceProofIrrelProv co)\n  = text \"irrel\" <+> pprParendIfaceCoercion co\npprIfaceUnivCoProv (IfacePluginProv s)\n  = text \"plugin\" <+> doubleQuotes (text s)\n\n-------------------\ninstance Outputable IfaceTyCon where\n  ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)\n\npprPromotionQuote :: IfaceTyCon -> SDoc\npprPromotionQuote tc =\n    pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc\n\npprPromotionQuoteI  :: PromotionFlag -> SDoc\npprPromotionQuoteI NotPromoted = empty\npprPromotionQuoteI IsPromoted    = char '\\''\n\ninstance Outputable IfaceCoercion where\n  ppr = pprIfaceCoercion\n\ninstance Binary IfaceTyCon where\n   put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i\n\n   get bh = do n <- get bh\n               i <- get bh\n               return (IfaceTyCon n i)\n\ninstance Binary IfaceTyConSort where\n   put_ bh IfaceNormalTyCon             = putByte bh 0\n   put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort\n   put_ bh (IfaceSumTyCon arity)        = putByte bh 2 >> put_ bh arity\n   put_ bh IfaceEqualityTyCon           = putByte bh 3\n\n   get bh = do\n       n <- getByte bh\n       case n of\n         0 -> return IfaceNormalTyCon\n         1 -> IfaceTupleTyCon <$> get bh <*> get bh\n         2 -> IfaceSumTyCon <$> get bh\n         _ -> return IfaceEqualityTyCon\n\ninstance Binary IfaceTyConInfo where\n   put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s\n\n   get bh = IfaceTyConInfo <$> get bh <*> get bh\n\ninstance Outputable IfaceTyLit where\n  ppr = pprIfaceTyLit\n\ninstance Binary IfaceTyLit where\n  put_ bh (IfaceNumTyLit n)  = putByte bh 1 >> put_ bh n\n  put_ bh (IfaceStrTyLit n)  = putByte bh 2 >> put_ bh n\n\n  get bh =\n    do tag <- getByte bh\n       case tag of\n         1 -> do { n <- get bh\n                 ; return (IfaceNumTyLit n) }\n         2 -> do { n <- get bh\n                 ; return (IfaceStrTyLit n) }\n         _ -> panic (\"get IfaceTyLit \" ++ show tag)\n\ninstance Binary IfaceAppArgs where\n  put_ bh tk =\n    case tk of\n      IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts\n      IA_Nil        -> putByte bh 1\n\n  get bh =\n    do c <- getByte bh\n       case c of\n         0 -> do\n           t  <- get bh\n           a  <- get bh\n           ts <- get bh\n           return $! IA_Arg t a ts\n         1 -> return IA_Nil\n         _ -> panic (\"get IfaceAppArgs \" ++ show c)\n\n-------------------\n\n-- Some notes about printing contexts\n--\n-- In the event that we are printing a singleton context (e.g. @Eq a@) we can\n-- omit parentheses. However, we must take care to set the precedence correctly\n-- to opPrec, since something like @a :~: b@ must be parenthesized (see\n-- #9658).\n--\n-- When printing a larger context we use 'fsep' instead of 'sep' so that\n-- the context doesn't get displayed as a giant column. Rather than,\n--  instance (Eq a,\n--            Eq b,\n--            Eq c,\n--            Eq d,\n--            Eq e,\n--            Eq f,\n--            Eq g,\n--            Eq h,\n--            Eq i,\n--            Eq j,\n--            Eq k,\n--            Eq l) =>\n--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)\n--\n-- we want\n--\n--  instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,\n--            Eq j, Eq k, Eq l) =>\n--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)\n\n\n\n-- | Prints \"(C a, D b) =>\", including the arrow.\n-- Used when we want to print a context in a type, so we\n-- use 'funPrec' to decide whether to parenthesise a singleton\n-- predicate; e.g.   Num a => a -> a\npprIfaceContextArr :: [IfacePredType] -> SDoc\npprIfaceContextArr []     = empty\npprIfaceContextArr [pred] = ppr_ty funPrec pred <+> darrow\npprIfaceContextArr preds  = ppr_parend_preds preds <+> darrow\n\n-- | Prints a context or @()@ if empty\n-- You give it the context precedence\npprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc\npprIfaceContext _    []     = text \"()\"\npprIfaceContext prec [pred] = ppr_ty prec pred\npprIfaceContext _    preds  = ppr_parend_preds preds\n\nppr_parend_preds :: [IfacePredType] -> SDoc\nppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds)))\n\ninstance Binary IfaceType where\n    put_ _ (IfaceFreeTyVar tv)\n       = pprPanic \"Can't serialise IfaceFreeTyVar\" (ppr tv)\n\n    put_ bh (IfaceForAllTy aa ab) = do\n            putByte bh 0\n            put_ bh aa\n            put_ bh ab\n    put_ bh (IfaceTyVar ad) = do\n            putByte bh 1\n            put_ bh ad\n    put_ bh (IfaceAppTy ae af) = do\n            putByte bh 2\n            put_ bh ae\n            put_ bh af\n    put_ bh (IfaceFunTy af ag ah) = do\n            putByte bh 3\n            put_ bh af\n            put_ bh ag\n            put_ bh ah\n    put_ bh (IfaceTyConApp tc tys)\n      = do { putByte bh 5; put_ bh tc; put_ bh tys }\n    put_ bh (IfaceCastTy a b)\n      = do { putByte bh 6; put_ bh a; put_ bh b }\n    put_ bh (IfaceCoercionTy a)\n      = do { putByte bh 7; put_ bh a }\n    put_ bh (IfaceTupleTy s i tys)\n      = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }\n    put_ bh (IfaceLitTy n)\n      = do { putByte bh 9; put_ bh n }\n\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do aa <- get bh\n                      ab <- get bh\n                      return (IfaceForAllTy aa ab)\n              1 -> do ad <- get bh\n                      return (IfaceTyVar ad)\n              2 -> do ae <- get bh\n                      af <- get bh\n                      return (IfaceAppTy ae af)\n              3 -> do af <- get bh\n                      ag <- get bh\n                      ah <- get bh\n                      return (IfaceFunTy af ag ah)\n              5 -> do { tc <- get bh; tys <- get bh\n                      ; return (IfaceTyConApp tc tys) }\n              6 -> do { a <- get bh; b <- get bh\n                      ; return (IfaceCastTy a b) }\n              7 -> do { a <- get bh\n                      ; return (IfaceCoercionTy a) }\n\n              8 -> do { s <- get bh; i <- get bh; tys <- get bh\n                      ; return (IfaceTupleTy s i tys) }\n              _  -> do n <- get bh\n                       return (IfaceLitTy n)\n\ninstance Binary IfaceMCoercion where\n  put_ bh IfaceMRefl = do\n          putByte bh 1\n  put_ bh (IfaceMCo co) = do\n          putByte bh 2\n          put_ bh co\n\n  get bh = do\n    tag <- getByte bh\n    case tag of\n         1 -> return IfaceMRefl\n         2 -> do a <- get bh\n                 return $ IfaceMCo a\n         _ -> panic (\"get IfaceMCoercion \" ++ show tag)\n\ninstance Binary IfaceCoercion where\n  put_ bh (IfaceReflCo a) = do\n          putByte bh 1\n          put_ bh a\n  put_ bh (IfaceGReflCo a b c) = do\n          putByte bh 2\n          put_ bh a\n          put_ bh b\n          put_ bh c\n  put_ bh (IfaceFunCo a b c) = do\n          putByte bh 3\n          put_ bh a\n          put_ bh b\n          put_ bh c\n  put_ bh (IfaceTyConAppCo a b c) = do\n          putByte bh 4\n          put_ bh a\n          put_ bh b\n          put_ bh c\n  put_ bh (IfaceAppCo a b) = do\n          putByte bh 5\n          put_ bh a\n          put_ bh b\n  put_ bh (IfaceForAllCo a b c) = do\n          putByte bh 6\n          put_ bh a\n          put_ bh b\n          put_ bh c\n  put_ bh (IfaceCoVarCo a) = do\n          putByte bh 7\n          put_ bh a\n  put_ bh (IfaceAxiomInstCo a b c) = do\n          putByte bh 8\n          put_ bh a\n          put_ bh b\n          put_ bh c\n  put_ bh (IfaceUnivCo a b c d) = do\n          putByte bh 9\n          put_ bh a\n          put_ bh b\n          put_ bh c\n          put_ bh d\n  put_ bh (IfaceSymCo a) = do\n          putByte bh 10\n          put_ bh a\n  put_ bh (IfaceTransCo a b) = do\n          putByte bh 11\n          put_ bh a\n          put_ bh b\n  put_ bh (IfaceNthCo a b) = do\n          putByte bh 12\n          put_ bh a\n          put_ bh b\n  put_ bh (IfaceLRCo a b) = do\n          putByte bh 13\n          put_ bh a\n          put_ bh b\n  put_ bh (IfaceInstCo a b) = do\n          putByte bh 14\n          put_ bh a\n          put_ bh b\n  put_ bh (IfaceKindCo a) = do\n          putByte bh 15\n          put_ bh a\n  put_ bh (IfaceSubCo a) = do\n          putByte bh 16\n          put_ bh a\n  put_ bh (IfaceAxiomRuleCo a b) = do\n          putByte bh 17\n          put_ bh a\n          put_ bh b\n  put_ _ (IfaceFreeCoVar cv)\n       = pprPanic \"Can't serialise IfaceFreeCoVar\" (ppr cv)\n  put_ _  (IfaceHoleCo cv)\n       = pprPanic \"Can't serialise IfaceHoleCo\" (ppr cv)\n          -- See Note [Holes in IfaceCoercion]\n\n  get bh = do\n      tag <- getByte bh\n      case tag of\n           1 -> do a <- get bh\n                   return $ IfaceReflCo a\n           2 -> do a <- get bh\n                   b <- get bh\n                   c <- get bh\n                   return $ IfaceGReflCo a b c\n           3 -> do a <- get bh\n                   b <- get bh\n                   c <- get bh\n                   return $ IfaceFunCo a b c\n           4 -> do a <- get bh\n                   b <- get bh\n                   c <- get bh\n                   return $ IfaceTyConAppCo a b c\n           5 -> do a <- get bh\n                   b <- get bh\n                   return $ IfaceAppCo a b\n           6 -> do a <- get bh\n                   b <- get bh\n                   c <- get bh\n                   return $ IfaceForAllCo a b c\n           7 -> do a <- get bh\n                   return $ IfaceCoVarCo a\n           8 -> do a <- get bh\n                   b <- get bh\n                   c <- get bh\n                   return $ IfaceAxiomInstCo a b c\n           9 -> do a <- get bh\n                   b <- get bh\n                   c <- get bh\n                   d <- get bh\n                   return $ IfaceUnivCo a b c d\n           10-> do a <- get bh\n                   return $ IfaceSymCo a\n           11-> do a <- get bh\n                   b <- get bh\n                   return $ IfaceTransCo a b\n           12-> do a <- get bh\n                   b <- get bh\n                   return $ IfaceNthCo a b\n           13-> do a <- get bh\n                   b <- get bh\n                   return $ IfaceLRCo a b\n           14-> do a <- get bh\n                   b <- get bh\n                   return $ IfaceInstCo a b\n           15-> do a <- get bh\n                   return $ IfaceKindCo a\n           16-> do a <- get bh\n                   return $ IfaceSubCo a\n           17-> do a <- get bh\n                   b <- get bh\n                   return $ IfaceAxiomRuleCo a b\n           _ -> panic (\"get IfaceCoercion \" ++ show tag)\n\ninstance Binary IfaceUnivCoProv where\n  put_ bh IfaceUnsafeCoerceProv = putByte bh 1\n  put_ bh (IfacePhantomProv a) = do\n          putByte bh 2\n          put_ bh a\n  put_ bh (IfaceProofIrrelProv a) = do\n          putByte bh 3\n          put_ bh a\n  put_ bh (IfacePluginProv a) = do\n          putByte bh 4\n          put_ bh a\n\n  get bh = do\n      tag <- getByte bh\n      case tag of\n           1 -> return $ IfaceUnsafeCoerceProv\n           2 -> do a <- get bh\n                   return $ IfacePhantomProv a\n           3 -> do a <- get bh\n                   return $ IfaceProofIrrelProv a\n           4 -> do a <- get bh\n                   return $ IfacePluginProv a\n           _ -> panic (\"get IfaceUnivCoProv \" ++ show tag)\n\n\ninstance Binary (DefMethSpec IfaceType) where\n    put_ bh VanillaDM     = putByte bh 0\n    put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> return VanillaDM\n              _ -> do { t <- get bh; return (GenericDM t) }\n", "num_lines": 1903}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nLoading interface files\n-}\n\n{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule LoadIface (\n        -- Importing one thing\n        tcLookupImported_maybe, importDecl,\n        checkWiredInTyCon, ifCheckWiredInThing,\n\n        -- RnM/TcM functions\n        loadModuleInterface, loadModuleInterfaces,\n        loadSrcInterface, loadSrcInterface_maybe,\n        loadInterfaceForName, loadInterfaceForNameMaybe, loadInterfaceForModule,\n\n        -- IfM functions\n        loadInterface,\n        loadSysInterface, loadUserInterface, loadPluginInterface,\n        findAndReadIface, readIface,    -- Used when reading the module's old interface\n        loadDecls,      -- Should move to TcIface and be renamed\n        initExternalPackageState,\n        moduleFreeHolesPrecise,\n        needWiredInHomeIface, loadWiredInHomeIface,\n\n        pprModIfaceSimple,\n        ifaceStats, pprModIface, showIface\n   ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,\n                                 tcIfaceFamInst,\n                                 tcIfaceAnnotations, tcIfaceCompleteSigs )\n\nimport DynFlags\nimport IfaceSyn\nimport IfaceEnv\nimport HscTypes\n\nimport BasicTypes hiding (SuccessFlag(..))\nimport TcRnMonad\n\nimport Constants\nimport PrelNames\nimport PrelInfo\nimport PrimOp   ( allThePrimOps, primOpFixity, primOpOcc )\nimport MkId     ( seqId )\nimport TysPrim  ( funTyConName )\nimport Rules\nimport TyCon\nimport Annotations\nimport InstEnv\nimport FamInstEnv\nimport Name\nimport NameEnv\nimport Avail\nimport Module\nimport Maybes\nimport ErrUtils\nimport Finder\nimport UniqFM\nimport SrcLoc\nimport Outputable\nimport BinIface\nimport Panic\nimport Util\nimport FastString\nimport Fingerprint\nimport Hooks\nimport FieldLabel\nimport RnModIface\nimport UniqDSet\nimport Plugins\n\nimport Control.Monad\nimport Control.Exception\nimport Data.IORef\nimport System.FilePath\n\n{-\n************************************************************************\n*                                                                      *\n*      tcImportDecl is the key function for \"faulting in\"              *\n*      imported things\n*                                                                      *\n************************************************************************\n\nThe main idea is this.  We are chugging along type-checking source code, and\nfind a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find\nit in the EPS type envt.  So it\n        1 loads GHC.Base.hi\n        2 gets the decl for GHC.Base.map\n        3 typechecks it via tcIfaceDecl\n        4 and adds it to the type env in the EPS\n\nNote that DURING STEP 4, we may find that map's type mentions a type\nconstructor that also\n\nNotice that for imported things we read the current version from the EPS\nmutable variable.  This is important in situations like\n        ...$(e1)...$(e2)...\nwhere the code that e1 expands to might import some defns that\nalso turn out to be needed by the code that e2 expands to.\n-}\n\ntcLookupImported_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing)\n-- Returns (Failed err) if we can't find the interface file for the thing\ntcLookupImported_maybe name\n  = do  { hsc_env <- getTopEnv\n        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)\n        ; case mb_thing of\n            Just thing -> return (Succeeded thing)\n            Nothing    -> tcImportDecl_maybe name }\n\ntcImportDecl_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing)\n-- Entry point for *source-code* uses of importDecl\ntcImportDecl_maybe name\n  | Just thing <- wiredInNameTyThing_maybe name\n  = do  { when (needWiredInHomeIface thing)\n               (initIfaceTcRn (loadWiredInHomeIface name))\n                -- See Note [Loading instances for wired-in things]\n        ; return (Succeeded thing) }\n  | otherwise\n  = initIfaceTcRn (importDecl name)\n\nimportDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing)\n-- Get the TyThing for this Name from an interface file\n-- It's not a wired-in thing -- the caller caught that\nimportDecl name\n  = ASSERT( not (isWiredInName name) )\n    do  { traceIf nd_doc\n\n        -- Load the interface, which should populate the PTE\n        ; mb_iface <- ASSERT2( isExternalName name, ppr name )\n                      loadInterface nd_doc (nameModule name) ImportBySystem\n        ; case mb_iface of {\n                Failed err_msg  -> return (Failed err_msg) ;\n                Succeeded _ -> do\n\n        -- Now look it up again; this time we should find it\n        { eps <- getEps\n        ; case lookupTypeEnv (eps_PTE eps) name of\n            Just thing -> return $ Succeeded thing\n            Nothing    -> let doc = whenPprDebug (found_things_msg eps $$ empty)\n                                    $$ not_found_msg\n                          in return $ Failed doc\n    }}}\n  where\n    nd_doc = text \"Need decl for\" <+> ppr name\n    not_found_msg = hang (text \"Can't find interface-file declaration for\" <+>\n                                pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)\n                       2 (vcat [text \"Probable cause: bug in .hi-boot file, or inconsistent .hi file\",\n                                text \"Use -ddump-if-trace to get an idea of which file caused the error\"])\n    found_things_msg eps =\n        hang (text \"Found the following declarations in\" <+> ppr (nameModule name) <> colon)\n           2 (vcat (map ppr $ filter is_interesting $ nameEnvElts $ eps_PTE eps))\n      where\n        is_interesting thing = nameModule name == nameModule (getName thing)\n\n\n{-\n************************************************************************\n*                                                                      *\n           Checks for wired-in things\n*                                                                      *\n************************************************************************\n\nNote [Loading instances for wired-in things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need to make sure that we have at least *read* the interface files\nfor any module with an instance decl or RULE that we might want.\n\n* If the instance decl is an orphan, we have a whole separate mechanism\n  (loadOrphanModules)\n\n* If the instance decl is not an orphan, then the act of looking at the\n  TyCon or Class will force in the defining module for the\n  TyCon/Class, and hence the instance decl\n\n* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;\n  but we must make sure we read its interface in case it has instances or\n  rules.  That is what LoadIface.loadWiredInHomeIface does.  It's called\n  from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}\n\n* HOWEVER, only do this for TyCons.  There are no wired-in Classes.  There\n  are some wired-in Ids, but we don't want to load their interfaces. For\n  example, Control.Exception.Base.recSelError is wired in, but that module\n  is compiled late in the base library, and we don't want to force it to\n  load before it's been compiled!\n\nAll of this is done by the type checker. The renamer plays no role.\n(It used to, but no longer.)\n-}\n\ncheckWiredInTyCon :: TyCon -> TcM ()\n-- Ensure that the home module of the TyCon (and hence its instances)\n-- are loaded. See Note [Loading instances for wired-in things]\n-- It might not be a wired-in tycon (see the calls in TcUnify),\n-- in which case this is a no-op.\ncheckWiredInTyCon tc\n  | not (isWiredInName tc_name)\n  = return ()\n  | otherwise\n  = do  { mod <- getModule\n        ; traceIf (text \"checkWiredInTyCon\" <+> ppr tc_name $$ ppr mod)\n        ; ASSERT( isExternalName tc_name )\n          when (mod /= nameModule tc_name)\n               (initIfaceTcRn (loadWiredInHomeIface tc_name))\n                -- Don't look for (non-existent) Float.hi when\n                -- compiling Float.hs, which mentions Float of course\n                -- A bit yukky to call initIfaceTcRn here\n        }\n  where\n    tc_name = tyConName tc\n\nifCheckWiredInThing :: TyThing -> IfL ()\n-- Even though we are in an interface file, we want to make\n-- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)\n-- Ditto want to ensure that RULES are loaded too\n-- See Note [Loading instances for wired-in things]\nifCheckWiredInThing thing\n  = do  { mod <- getIfModule\n                -- Check whether we are typechecking the interface for this\n                -- very module.  E.g when compiling the base library in --make mode\n                -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in\n                -- the HPT, so without the test we'll demand-load it into the PIT!\n                -- C.f. the same test in checkWiredInTyCon above\n        ; let name = getName thing\n        ; ASSERT2( isExternalName name, ppr name )\n          when (needWiredInHomeIface thing && mod /= nameModule name)\n               (loadWiredInHomeIface name) }\n\nneedWiredInHomeIface :: TyThing -> Bool\n-- Only for TyCons; see Note [Loading instances for wired-in things]\nneedWiredInHomeIface (ATyCon {}) = True\nneedWiredInHomeIface _           = False\n\n\n{-\n************************************************************************\n*                                                                      *\n        loadSrcInterface, loadOrphanModules, loadInterfaceForName\n\n                These three are called from TcM-land\n*                                                                      *\n************************************************************************\n-}\n\n-- | Load the interface corresponding to an @import@ directive in\n-- source code.  On a failure, fail in the monad with an error message.\nloadSrcInterface :: SDoc\n                 -> ModuleName\n                 -> IsBootInterface     -- {-# SOURCE #-} ?\n                 -> Maybe FastString    -- \"package\", if any\n                 -> RnM ModIface\n\nloadSrcInterface doc mod want_boot maybe_pkg\n  = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg\n       ; case res of\n           Failed err      -> failWithTc err\n           Succeeded iface -> return iface }\n\n-- | Like 'loadSrcInterface', but returns a 'MaybeErr'.\nloadSrcInterface_maybe :: SDoc\n                       -> ModuleName\n                       -> IsBootInterface     -- {-# SOURCE #-} ?\n                       -> Maybe FastString    -- \"package\", if any\n                       -> RnM (MaybeErr MsgDoc ModIface)\n\nloadSrcInterface_maybe doc mod want_boot maybe_pkg\n  -- We must first find which Module this import refers to.  This involves\n  -- calling the Finder, which as a side effect will search the filesystem\n  -- and create a ModLocation.  If successful, loadIface will read the\n  -- interface; it will call the Finder again, but the ModLocation will be\n  -- cached from the first search.\n  = do { hsc_env <- getTopEnv\n       ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg\n       ; case res of\n           Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)\n           -- TODO: Make sure this error message is good\n           err         -> return (Failed (cannotFindModule (hsc_dflags hsc_env) mod err)) }\n\n-- | Load interface directly for a fully qualified 'Module'.  (This is a fairly\n-- rare operation, but in particular it is used to load orphan modules\n-- in order to pull their instances into the global package table and to\n-- handle some operations in GHCi).\nloadModuleInterface :: SDoc -> Module -> TcM ModIface\nloadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod)\n\n-- | Load interfaces for a collection of modules.\nloadModuleInterfaces :: SDoc -> [Module] -> TcM ()\nloadModuleInterfaces doc mods\n  | null mods = return ()\n  | otherwise = initIfaceTcRn (mapM_ load mods)\n  where\n    load mod = loadSysInterface (doc <+> parens (ppr mod)) mod\n\n-- | Loads the interface for a given Name.\n-- Should only be called for an imported name;\n-- otherwise loadSysInterface may not find the interface\nloadInterfaceForName :: SDoc -> Name -> TcRn ModIface\nloadInterfaceForName doc name\n  = do { when debugIsOn $  -- Check pre-condition\n         do { this_mod <- getModule\n            ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc ) }\n      ; ASSERT2( isExternalName name, ppr name )\n        initIfaceTcRn $ loadSysInterface doc (nameModule name) }\n\n-- | Only loads the interface for external non-local names.\nloadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface)\nloadInterfaceForNameMaybe doc name\n  = do { this_mod <- getModule\n       ; if nameIsLocalOrFrom this_mod name || not (isExternalName name)\n         then return Nothing\n         else Just <$> (initIfaceTcRn $ loadSysInterface doc (nameModule name))\n       }\n\n-- | Loads the interface for a given Module.\nloadInterfaceForModule :: SDoc -> Module -> TcRn ModIface\nloadInterfaceForModule doc m\n  = do\n    -- Should not be called with this module\n    when debugIsOn $ do\n      this_mod <- getModule\n      MASSERT2( this_mod /= m, ppr m <+> parens doc )\n    initIfaceTcRn $ loadSysInterface doc m\n\n{-\n*********************************************************\n*                                                      *\n                loadInterface\n\n        The main function to load an interface\n        for an imported module, and put it in\n        the External Package State\n*                                                      *\n*********************************************************\n-}\n\n-- | An 'IfM' function to load the home interface for a wired-in thing,\n-- so that we're sure that we see its instance declarations and rules\n-- See Note [Loading instances for wired-in things]\nloadWiredInHomeIface :: Name -> IfM lcl ()\nloadWiredInHomeIface name\n  = ASSERT( isWiredInName name )\n    do _ <- loadSysInterface doc (nameModule name); return ()\n  where\n    doc = text \"Need home interface for wired-in thing\" <+> ppr name\n\n------------------\n-- | Loads a system interface and throws an exception if it fails\nloadSysInterface :: SDoc -> Module -> IfM lcl ModIface\nloadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem\n\n------------------\n-- | Loads a user interface and throws an exception if it fails. The first parameter indicates\n-- whether we should import the boot variant of the module\nloadUserInterface :: Bool -> SDoc -> Module -> IfM lcl ModIface\nloadUserInterface is_boot doc mod_name\n  = loadInterfaceWithException doc mod_name (ImportByUser is_boot)\n\nloadPluginInterface :: SDoc -> Module -> IfM lcl ModIface\nloadPluginInterface doc mod_name\n  = loadInterfaceWithException doc mod_name ImportByPlugin\n\n------------------\n-- | A wrapper for 'loadInterface' that throws an exception if it fails\nloadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface\nloadInterfaceWithException doc mod_name where_from\n  = withException (loadInterface doc mod_name where_from)\n\n------------------\nloadInterface :: SDoc -> Module -> WhereFrom\n              -> IfM lcl (MaybeErr MsgDoc ModIface)\n\n-- loadInterface looks in both the HPT and PIT for the required interface\n-- If not found, it loads it, and puts it in the PIT (always).\n\n-- If it can't find a suitable interface file, we\n--      a) modify the PackageIfaceTable to have an empty entry\n--              (to avoid repeated complaints)\n--      b) return (Left message)\n--\n-- It's not necessarily an error for there not to be an interface\n-- file -- perhaps the module has changed, and that interface\n-- is no longer used\n\nloadInterface doc_str mod from\n  | isHoleModule mod\n  -- Hole modules get special treatment\n  = do dflags <- getDynFlags\n       -- Redo search for our local hole module\n       loadInterface doc_str (mkModule (thisPackage dflags) (moduleName mod)) from\n  | otherwise\n  = do  {       -- Read the state\n          (eps,hpt) <- getEpsAndHpt\n        ; gbl_env <- getGblEnv\n\n        ; traceIf (text \"Considering whether to load\" <+> ppr mod <+> ppr from)\n\n                -- Check whether we have the interface already\n        ; dflags <- getDynFlags\n        ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {\n            Just iface\n                -> return (Succeeded iface) ;   -- Already loaded\n                        -- The (src_imp == mi_boot iface) test checks that the already-loaded\n                        -- interface isn't a boot iface.  This can conceivably happen,\n                        -- if an earlier import had a before we got to real imports.   I think.\n            _ -> do {\n\n        -- READ THE MODULE IN\n        ; read_result <- case (wantHiBootFile dflags eps mod from) of\n                           Failed err             -> return (Failed err)\n                           Succeeded hi_boot_file -> computeInterface doc_str hi_boot_file mod\n        ; case read_result of {\n            Failed err -> do\n                { let fake_iface = emptyModIface mod\n\n                ; updateEps_ $ \\eps ->\n                        eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }\n                        -- Not found, so add an empty iface to\n                        -- the EPS map so that we don't look again\n\n                ; return (Failed err) } ;\n\n        -- Found and parsed!\n        -- We used to have a sanity check here that looked for:\n        --  * System importing ..\n        --  * a home package module ..\n        --  * that we know nothing about (mb_dep == Nothing)!\n        --\n        -- But this is no longer valid because thNameToGhcName allows users to\n        -- cause the system to load arbitrary interfaces (by supplying an appropriate\n        -- Template Haskell original-name).\n            Succeeded (iface, loc) ->\n        let\n            loc_doc = text loc\n        in\n        initIfaceLcl (mi_semantic_module iface) loc_doc (mi_boot iface) $ do\n\n        dontLeakTheHPT $ do\n\n        --      Load the new ModIface into the External Package State\n        -- Even home-package interfaces loaded by loadInterface\n        --      (which only happens in OneShot mode; in Batch/Interactive\n        --      mode, home-package modules are loaded one by one into the HPT)\n        -- are put in the EPS.\n        --\n        -- The main thing is to add the ModIface to the PIT, but\n        -- we also take the\n        --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules,\n        -- out of the ModIface and put them into the big EPS pools\n\n        -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined\n        ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).\n        --     If we do loadExport first the wrong info gets into the cache (unless we\n        --      explicitly tag each export which seems a bit of a bore)\n\n        ; ignore_prags      <- goptM Opt_IgnoreInterfacePragmas\n        ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)\n        ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)\n        ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)\n        ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)\n        ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)\n        ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)\n\n        ; let { final_iface = iface {\n                                mi_decls     = panic \"No mi_decls in PIT\",\n                                mi_insts     = panic \"No mi_insts in PIT\",\n                                mi_fam_insts = panic \"No mi_fam_insts in PIT\",\n                                mi_rules     = panic \"No mi_rules in PIT\",\n                                mi_anns      = panic \"No mi_anns in PIT\"\n                              }\n               }\n\n        ; let bad_boot = mi_boot iface && fmap fst (if_rec_types gbl_env) == Just mod\n                            -- Warn warn against an EPS-updating import\n                            -- of one's own boot file! (one-shot only)\n                            -- See Note [Loading your own hi-boot file]\n                            -- in MkIface.\n\n        ; WARN( bad_boot, ppr mod )\n          updateEps_  $ \\ eps ->\n           if elemModuleEnv mod (eps_PIT eps) || is_external_sig dflags iface\n                then eps\n           else if bad_boot\n                -- See Note [Loading your own hi-boot file]\n                then eps { eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls }\n           else\n                eps {\n                  eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,\n                  eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,\n                  eps_rule_base    = extendRuleBaseList (eps_rule_base eps)\n                                                        new_eps_rules,\n                  eps_complete_matches\n                                   = extendCompleteMatchMap\n                                         (eps_complete_matches eps)\n                                         new_eps_complete_sigs,\n                  eps_inst_env     = extendInstEnvList (eps_inst_env eps)\n                                                       new_eps_insts,\n                  eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)\n                                                          new_eps_fam_insts,\n                  eps_ann_env      = extendAnnEnvList (eps_ann_env eps)\n                                                      new_eps_anns,\n                  eps_mod_fam_inst_env\n                                   = let\n                                       fam_inst_env =\n                                         extendFamInstEnvList emptyFamInstEnv\n                                                              new_eps_fam_insts\n                                     in\n                                     extendModuleEnv (eps_mod_fam_inst_env eps)\n                                                     mod\n                                                     fam_inst_env,\n                  eps_stats        = addEpsInStats (eps_stats eps)\n                                                   (length new_eps_decls)\n                                                   (length new_eps_insts)\n                                                   (length new_eps_rules) }\n\n        ; -- invoke plugins\n          res <- withPlugins dflags interfaceLoadAction final_iface\n        ; return (Succeeded res)\n    }}}}\n\n{- Note [Loading your own hi-boot file]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGenerally speaking, when compiling module M, we should not\nload M.hi boot into the EPS.  After all, we are very shortly\ngoing to have full information about M.  Moreover, see\nNote [Do not update EPS with your own hi-boot] in MkIface.\n\nBut there is a HORRIBLE HACK here.\n\n* At the end of tcRnImports, we call checkFamInstConsistency to\n  check consistency of imported type-family instances\n  See Note [The type family instance consistency story] in FamInst\n\n* Alas, those instances may refer to data types defined in M,\n  if there is a M.hs-boot.\n\n* And that means we end up loading M.hi-boot, because those\n  data types are not yet in the type environment.\n\nBut in this wierd case, /all/ we need is the types. We don't need\ninstances, rules etc.  And if we put the instances in the EPS\nwe get \"duplicate instance\" warnings when we compile the \"real\"\ninstance in M itself.  Hence the strange business of just updateing\nthe eps_PTE.\n\nThis really happens in practice.  The module HsExpr.hs gets\n\"duplicate instance\" errors if this hack is not present.\n\nThis is a mess.\n\n\nNote [HPT space leak] (#15111)\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn IfL, we defer some work until it is demanded using forkM, such\nas building TyThings from IfaceDecls. These thunks are stored in\nthe ExternalPackageState, and they might never be poked.  If we're\nnot careful, these thunks will capture the state of the loaded\nprogram when we read an interface file, and retain all that data\nfor ever.\n\nTherefore, when loading a package interface file , we use a \"clean\"\nversion of the HscEnv with all the data about the currently loaded\nprogram stripped out. Most of the fields can be panics because\nwe'll never read them, but hsc_HPT needs to be empty because this\ninterface will cause other interfaces to be loaded recursively, and\nwhen looking up those interfaces we use the HPT in loadInterface.\nWe know that none of the interfaces below here can refer to\nhome-package modules however, so it's safe for the HPT to be empty.\n-}\n\ndontLeakTheHPT :: IfL a -> IfL a\ndontLeakTheHPT thing_inside = do\n  let\n    cleanTopEnv HscEnv{..} =\n       let\n         -- wrinkle: when we're typechecking in --backpack mode, the\n         -- instantiation of a signature might reside in the HPT, so\n         -- this case breaks the assumption that EPS interfaces only\n         -- refer to other EPS interfaces. We can detect when we're in\n         -- typechecking-only mode by using hscTarget==HscNothing, and\n         -- in that case we don't empty the HPT.  (admittedly this is\n         -- a bit of a hack, better suggestions welcome). A number of\n         -- tests in testsuite/tests/backpack break without this\n         -- tweak.\n         !hpt | hscTarget hsc_dflags == HscNothing = hsc_HPT\n              | otherwise = emptyHomePackageTable\n       in\n       HscEnv {  hsc_targets      = panic \"cleanTopEnv: hsc_targets\"\n              ,  hsc_mod_graph    = panic \"cleanTopEnv: hsc_mod_graph\"\n              ,  hsc_IC           = panic \"cleanTopEnv: hsc_IC\"\n              ,  hsc_HPT          = hpt\n              , .. }\n\n  updTopEnv cleanTopEnv $ do\n  !_ <- getTopEnv        -- force the updTopEnv\n  thing_inside\n\n\n-- | Returns @True@ if a 'ModIface' comes from an external package.\n-- In this case, we should NOT load it into the EPS; the entities\n-- should instead come from the local merged signature interface.\nis_external_sig :: DynFlags -> ModIface -> Bool\nis_external_sig dflags iface =\n    -- It's a signature iface...\n    mi_semantic_module iface /= mi_module iface &&\n    -- and it's not from the local package\n    moduleUnitId (mi_module iface) /= thisPackage dflags\n\n-- | This is an improved version of 'findAndReadIface' which can also\n-- handle the case when a user requests @p[A=<B>]:M@ but we only\n-- have an interface for @p[A=<A>]:M@ (the indefinite interface.\n-- If we are not trying to build code, we load the interface we have,\n-- *instantiating it* according to how the holes are specified.\n-- (Of course, if we're actually building code, this is a hard error.)\n--\n-- In the presence of holes, 'computeInterface' has an important invariant:\n-- to load module M, its set of transitively reachable requirements must\n-- have an up-to-date local hi file for that requirement.  Note that if\n-- we are loading the interface of a requirement, this does not\n-- apply to the requirement itself; e.g., @p[A=<A>]:A@ does not require\n-- A.hi to be up-to-date (and indeed, we MUST NOT attempt to read A.hi, unless\n-- we are actually typechecking p.)\ncomputeInterface ::\n       SDoc -> IsBootInterface -> Module\n    -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))\ncomputeInterface doc_str hi_boot_file mod0 = do\n    MASSERT( not (isHoleModule mod0) )\n    dflags <- getDynFlags\n    case splitModuleInsts mod0 of\n        (imod, Just indef) | not (unitIdIsDefinite (thisPackage dflags)) -> do\n            r <- findAndReadIface doc_str imod mod0 hi_boot_file\n            case r of\n                Succeeded (iface0, path) -> do\n                    hsc_env <- getTopEnv\n                    r <- liftIO $\n                        rnModIface hsc_env (indefUnitIdInsts (indefModuleUnitId indef))\n                                   Nothing iface0\n                    case r of\n                        Right x -> return (Succeeded (x, path))\n                        Left errs -> liftIO . throwIO . mkSrcErr $ errs\n                Failed err -> return (Failed err)\n        (mod, _) ->\n            findAndReadIface doc_str mod mod0 hi_boot_file\n\n-- | Compute the signatures which must be compiled in order to\n-- load the interface for a 'Module'.  The output of this function\n-- is always a subset of 'moduleFreeHoles'; it is more precise\n-- because in signature @p[A=<A>,B=<B>]:B@, although the free holes\n-- are A and B, B might not depend on A at all!\n--\n-- If this is invoked on a signature, this does NOT include the\n-- signature itself; e.g. precise free module holes of\n-- @p[A=<A>,B=<B>]:B@ never includes B.\nmoduleFreeHolesPrecise\n    :: SDoc -> Module\n    -> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))\nmoduleFreeHolesPrecise doc_str mod\n | moduleIsDefinite mod = return (Succeeded emptyUniqDSet)\n | otherwise =\n   case splitModuleInsts mod of\n    (imod, Just indef) -> do\n        let insts = indefUnitIdInsts (indefModuleUnitId indef)\n        traceIf (text \"Considering whether to load\" <+> ppr mod <+>\n                 text \"to compute precise free module holes\")\n        (eps, hpt) <- getEpsAndHpt\n        dflags <- getDynFlags\n        case tryEpsAndHpt dflags eps hpt `firstJust` tryDepsCache eps imod insts of\n            Just r -> return (Succeeded r)\n            Nothing -> readAndCache imod insts\n    (_, Nothing) -> return (Succeeded emptyUniqDSet)\n  where\n    tryEpsAndHpt dflags eps hpt =\n        fmap mi_free_holes (lookupIfaceByModule dflags hpt (eps_PIT eps) mod)\n    tryDepsCache eps imod insts =\n        case lookupInstalledModuleEnv (eps_free_holes eps) imod of\n            Just ifhs  -> Just (renameFreeHoles ifhs insts)\n            _otherwise -> Nothing\n    readAndCache imod insts = do\n        mb_iface <- findAndReadIface (text \"moduleFreeHolesPrecise\" <+> doc_str) imod mod False\n        case mb_iface of\n            Succeeded (iface, _) -> do\n                let ifhs = mi_free_holes iface\n                -- Cache it\n                updateEps_ (\\eps ->\n                    eps { eps_free_holes = extendInstalledModuleEnv (eps_free_holes eps) imod ifhs })\n                return (Succeeded (renameFreeHoles ifhs insts))\n            Failed err -> return (Failed err)\n\nwantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom\n               -> MaybeErr MsgDoc IsBootInterface\n-- Figure out whether we want Foo.hi or Foo.hi-boot\nwantHiBootFile dflags eps mod from\n  = case from of\n       ImportByUser usr_boot\n          | usr_boot && not this_package\n          -> Failed (badSourceImport mod)\n          | otherwise -> Succeeded usr_boot\n\n       ImportByPlugin\n          -> Succeeded False\n\n       ImportBySystem\n          | not this_package   -- If the module to be imported is not from this package\n          -> Succeeded False   -- don't look it up in eps_is_boot, because that is keyed\n                               -- on the ModuleName of *home-package* modules only.\n                               -- We never import boot modules from other packages!\n\n          | otherwise\n          -> case lookupUFM (eps_is_boot eps) (moduleName mod) of\n                Just (_, is_boot) -> Succeeded is_boot\n                Nothing           -> Succeeded False\n                     -- The boot-ness of the requested interface,\n                     -- based on the dependencies in directly-imported modules\n  where\n    this_package = thisPackage dflags == moduleUnitId mod\n\nbadSourceImport :: Module -> SDoc\nbadSourceImport mod\n  = hang (text \"You cannot {-# SOURCE #-} import a module from another package\")\n       2 (text \"but\" <+> quotes (ppr mod) <+> ptext (sLit \"is from package\")\n          <+> quotes (ppr (moduleUnitId mod)))\n\n-----------------------------------------------------\n--      Loading type/class/value decls\n-- We pass the full Module name here, replete with\n-- its package info, so that we can build a Name for\n-- each binder with the right package info in it\n-- All subsequent lookups, including crucially lookups during typechecking\n-- the declaration itself, will find the fully-glorious Name\n--\n-- We handle ATs specially.  They are not main declarations, but also not\n-- implicit things (in particular, adding them to `implicitTyThings' would mess\n-- things up in the renaming/type checking of source programs).\n-----------------------------------------------------\n\naddDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv\naddDeclsToPTE pte things = extendNameEnvList pte things\n\nloadDecls :: Bool\n          -> [(Fingerprint, IfaceDecl)]\n          -> IfL [(Name,TyThing)]\nloadDecls ignore_prags ver_decls\n   = do { thingss <- mapM (loadDecl ignore_prags) ver_decls\n        ; return (concat thingss)\n        }\n\nloadDecl :: Bool                    -- Don't load pragmas into the decl pool\n          -> (Fingerprint, IfaceDecl)\n          -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the\n                                    -- TyThings are forkM'd thunks\nloadDecl ignore_prags (_version, decl)\n  = do  {       -- Populate the name cache with final versions of all\n                -- the names associated with the decl\n          let main_name = ifName decl\n\n        -- Typecheck the thing, lazily\n        -- NB. Firstly, the laziness is there in case we never need the\n        -- declaration (in one-shot mode), and secondly it is there so that\n        -- we don't look up the occurrence of a name before calling mk_new_bndr\n        -- on the binder.  This is important because we must get the right name\n        -- which includes its nameParent.\n\n        ; thing <- forkM doc $ do { bumpDeclStats main_name\n                                  ; tcIfaceDecl ignore_prags decl }\n\n        -- Populate the type environment with the implicitTyThings too.\n        --\n        -- Note [Tricky iface loop]\n        -- ~~~~~~~~~~~~~~~~~~~~~~~~\n        -- Summary: The delicate point here is that 'mini-env' must be\n        -- buildable from 'thing' without demanding any of the things\n        -- 'forkM'd by tcIfaceDecl.\n        --\n        -- In more detail: Consider the example\n        --      data T a = MkT { x :: T a }\n        -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]\n        -- (plus their workers, wrappers, coercions etc etc)\n        --\n        -- We want to return an environment\n        --      [ \"MkT\" -> <datacon MkT>, \"x\" -> <selector x>, ... ]\n        -- (where the \"MkT\" is the *Name* associated with MkT, etc.)\n        --\n        -- We do this by mapping the implicit_names to the associated\n        -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and\n        -- implicitTyThings, we can use getOccName on the implicit\n        -- TyThings to make this association: each Name's OccName should\n        -- be the OccName of exactly one implicitTyThing.  So the key is\n        -- to define a \"mini-env\"\n        --\n        -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]\n        -- where the 'MkT' here is the *OccName* associated with MkT.\n        --\n        -- However, there is a subtlety: due to how type checking needs\n        -- to be staged, we can't poke on the forkM'd thunks inside the\n        -- implicitTyThings while building this mini-env.\n        -- If we poke these thunks too early, two problems could happen:\n        --    (1) When processing mutually recursive modules across\n        --        hs-boot boundaries, poking too early will do the\n        --        type-checking before the recursive knot has been tied,\n        --        so things will be type-checked in the wrong\n        --        environment, and necessary variables won't be in\n        --        scope.\n        --\n        --    (2) Looking up one OccName in the mini_env will cause\n        --        others to be looked up, which might cause that\n        --        original one to be looked up again, and hence loop.\n        --\n        -- The code below works because of the following invariant:\n        -- getOccName on a TyThing does not force the suspended type\n        -- checks in order to extract the name. For example, we don't\n        -- poke on the \"T a\" type of <selector x> on the way to\n        -- extracting <selector x>'s OccName. Of course, there is no\n        -- reason in principle why getting the OccName should force the\n        -- thunks, but this means we need to be careful in\n        -- implicitTyThings and its helper functions.\n        --\n        -- All a bit too finely-balanced for my liking.\n\n        -- This mini-env and lookup function mediates between the\n        --'Name's n and the map from 'OccName's to the implicit TyThings\n        ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]\n              lookup n = case lookupOccEnv mini_env (getOccName n) of\n                           Just thing -> thing\n                           Nothing    ->\n                             pprPanic \"loadDecl\" (ppr main_name <+> ppr n $$ ppr (decl))\n\n        ; implicit_names <- mapM lookupIfaceTop (ifaceDeclImplicitBndrs decl)\n\n--         ; traceIf (text \"Loading decl for \" <> ppr main_name $$ ppr implicit_names)\n        ; return $ (main_name, thing) :\n                      -- uses the invariant that implicit_names and\n                      -- implicitTyThings are bijective\n                      [(n, lookup n) | n <- implicit_names]\n        }\n  where\n    doc = text \"Declaration for\" <+> ppr (ifName decl)\n\nbumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used\nbumpDeclStats name\n  = do  { traceIf (text \"Loading decl for\" <+> ppr name)\n        ; updateEps_ (\\eps -> let stats = eps_stats eps\n                              in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })\n        }\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Reading an interface file}\n*                                                      *\n*********************************************************\n\nNote [Home module load error]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the sought-for interface is in the current package (as determined\nby -package-name flag) then it jolly well should already be in the HPT\nbecause we process home-package modules in dependency order.  (Except\nin one-shot mode; see notes with hsc_HPT decl in HscTypes).\n\nIt is possible (though hard) to get this error through user behaviour.\n  * Suppose package P (modules P1, P2) depends on package Q (modules Q1,\n    Q2, with Q2 importing Q1)\n  * We compile both packages.\n  * Now we edit package Q so that it somehow depends on P\n  * Now recompile Q with --make (without recompiling P).\n  * Then Q1 imports, say, P1, which in turn depends on Q2. So Q2\n    is a home-package module which is not yet in the HPT!  Disaster.\n\nThis actually happened with P=base, Q=ghc-prim, via the AMP warnings.\nSee Trac #8320.\n-}\n\nfindAndReadIface :: SDoc\n                 -- The unique identifier of the on-disk module we're\n                 -- looking for\n                 -> InstalledModule\n                 -- The *actual* module we're looking for.  We use\n                 -- this to check the consistency of the requirements\n                 -- of the module we read out.\n                 -> Module\n                 -> IsBootInterface     -- True  <=> Look for a .hi-boot file\n                                        -- False <=> Look for .hi file\n                 -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))\n        -- Nothing <=> file not found, or unreadable, or illegible\n        -- Just x  <=> successfully found and parsed\n\n        -- It *doesn't* add an error to the monad, because\n        -- sometimes it's ok to fail... see notes with loadInterface\nfindAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file\n  = do traceIf (sep [hsep [text \"Reading\",\n                           if hi_boot_file\n                             then text \"[boot]\"\n                             else Outputable.empty,\n                           text \"interface for\",\n                           ppr mod <> semi],\n                     nest 4 (text \"reason:\" <+> doc_str)])\n\n       -- Check for GHC.Prim, and return its static interface\n       -- TODO: make this check a function\n       if mod `installedModuleEq` gHC_PRIM\n           then do\n               iface <- getHooked ghcPrimIfaceHook ghcPrimIface\n               return (Succeeded (iface,\n                                   \"<built in interface for GHC.Prim>\"))\n           else do\n               dflags <- getDynFlags\n               -- Look for the file\n               hsc_env <- getTopEnv\n               mb_found <- liftIO (findExactModule hsc_env mod)\n               case mb_found of\n                   InstalledFound loc mod -> do\n                       -- Found file, so read it\n                       let file_path = addBootSuffix_maybe hi_boot_file\n                                                           (ml_hi_file loc)\n\n                       -- See Note [Home module load error]\n                       if installedModuleUnitId mod `installedUnitIdEq` thisPackage dflags &&\n                          not (isOneShot (ghcMode dflags))\n                           then return (Failed (homeModError mod loc))\n                           else do r <- read_file file_path\n                                   checkBuildDynamicToo r\n                                   return r\n                   err -> do\n                       traceIf (text \"...not found\")\n                       dflags <- getDynFlags\n                       return (Failed (cannotFindInterface dflags\n                                           (installedModuleName mod) err))\n    where read_file file_path = do\n              traceIf (text \"readIFace\" <+> text file_path)\n              -- Figure out what is recorded in mi_module.  If this is\n              -- a fully definite interface, it'll match exactly, but\n              -- if it's indefinite, the inside will be uninstantiated!\n              dflags <- getDynFlags\n              let wanted_mod =\n                    case splitModuleInsts wanted_mod_with_insts of\n                        (_, Nothing) -> wanted_mod_with_insts\n                        (_, Just indef_mod) ->\n                          indefModuleToModule dflags\n                            (generalizeIndefModule indef_mod)\n              read_result <- readIface wanted_mod file_path\n              case read_result of\n                Failed err -> return (Failed (badIfaceFile file_path err))\n                Succeeded iface -> return (Succeeded (iface, file_path))\n                            -- Don't forget to fill in the package name...\n          checkBuildDynamicToo (Succeeded (iface, filePath)) = do\n              dflags <- getDynFlags\n              -- Indefinite interfaces are ALWAYS non-dynamic, and\n              -- that's OK.\n              let is_definite_iface = moduleIsDefinite (mi_module iface)\n              when is_definite_iface $\n                whenGeneratingDynamicToo dflags $ withDoDynamicToo $ do\n                  let ref = canGenerateDynamicToo dflags\n                      dynFilePath = addBootSuffix_maybe hi_boot_file\n                                  $ replaceExtension filePath (dynHiSuf dflags)\n                  r <- read_file dynFilePath\n                  case r of\n                      Succeeded (dynIface, _)\n                       | mi_mod_hash iface == mi_mod_hash dynIface ->\n                          return ()\n                       | otherwise ->\n                          do traceIf (text \"Dynamic hash doesn't match\")\n                             liftIO $ writeIORef ref False\n                      Failed err ->\n                          do traceIf (text \"Failed to load dynamic interface file:\" $$ err)\n                             liftIO $ writeIORef ref False\n          checkBuildDynamicToo _ = return ()\n\n-- @readIface@ tries just the one file.\n\nreadIface :: Module -> FilePath\n          -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)\n        -- Failed err    <=> file not found, or unreadable, or illegible\n        -- Succeeded iface <=> successfully found and parsed\n\nreadIface wanted_mod file_path\n  = do  { res <- tryMostM $\n                 readBinIface CheckHiWay QuietBinIFaceReading file_path\n        ; dflags <- getDynFlags\n        ; case res of\n            Right iface\n                -- NB: This check is NOT just a sanity check, it is\n                -- critical for correctness of recompilation checking\n                -- (it lets us tell when -this-unit-id has changed.)\n                | wanted_mod == actual_mod\n                                -> return (Succeeded iface)\n                | otherwise     -> return (Failed err)\n                where\n                  actual_mod = mi_module iface\n                  err = hiModuleNameMismatchWarn dflags wanted_mod actual_mod\n\n            Left exn    -> return (Failed (text (showException exn)))\n    }\n\n{-\n*********************************************************\n*                                                       *\n        Wired-in interface for GHC.Prim\n*                                                       *\n*********************************************************\n-}\n\ninitExternalPackageState :: ExternalPackageState\ninitExternalPackageState\n  = EPS {\n      eps_is_boot          = emptyUFM,\n      eps_PIT              = emptyPackageIfaceTable,\n      eps_free_holes       = emptyInstalledModuleEnv,\n      eps_PTE              = emptyTypeEnv,\n      eps_inst_env         = emptyInstEnv,\n      eps_fam_inst_env     = emptyFamInstEnv,\n      eps_rule_base        = mkRuleBase builtinRules,\n        -- Initialise the EPS rule pool with the built-in rules\n      eps_mod_fam_inst_env\n                           = emptyModuleEnv,\n      eps_complete_matches = emptyUFM,\n      eps_ann_env          = emptyAnnEnv,\n      eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0\n                           , n_insts_in = 0, n_insts_out = 0\n                           , n_rules_in = length builtinRules, n_rules_out = 0 }\n    }\n\n{-\n*********************************************************\n*                                                       *\n        Wired-in interface for GHC.Prim\n*                                                       *\n*********************************************************\n-}\n\nghcPrimIface :: ModIface\nghcPrimIface\n  = (emptyModIface gHC_PRIM) {\n        mi_exports  = ghcPrimExports,\n        mi_decls    = [],\n        mi_fixities = fixities,\n        mi_fix_fn  = mkIfaceFixCache fixities\n    }\n  where\n    -- The fixities listed here for @`seq`@ or @->@ should match\n    -- those in primops.txt.pp (from which Haddock docs are generated).\n    fixities = (getOccName seqId, Fixity NoSourceText 0 InfixR)\n             : (occName funTyConName, funTyFixity)  -- trac #10145\n             : mapMaybe mkFixity allThePrimOps\n    mkFixity op = (,) (primOpOcc op) <$> primOpFixity op\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Statistics}\n*                                                      *\n*********************************************************\n-}\n\nifaceStats :: ExternalPackageState -> SDoc\nifaceStats eps\n  = hcat [text \"Renamer stats: \", msg]\n  where\n    stats = eps_stats eps\n    msg = vcat\n        [int (n_ifaces_in stats) <+> text \"interfaces read\",\n         hsep [ int (n_decls_out stats), text \"type/class/variable imported, out of\",\n                int (n_decls_in stats), text \"read\"],\n         hsep [ int (n_insts_out stats), text \"instance decls imported, out of\",\n                int (n_insts_in stats), text \"read\"],\n         hsep [ int (n_rules_out stats), text \"rule decls imported, out of\",\n                int (n_rules_in stats), text \"read\"]\n        ]\n\n{-\n************************************************************************\n*                                                                      *\n                Printing interfaces\n*                                                                      *\n************************************************************************\n\nNote [Name qualification with --show-iface]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIn order to disambiguate between identifiers from different modules, we qualify\nall names that don't originate in the current module. In order to keep visual\nnoise as low as possible, we keep local names unqualified.\n\nFor some background on this choice see trac #15269.\n-}\n\n-- | Read binary interface, and print it out\nshowIface :: HscEnv -> FilePath -> IO ()\nshowIface hsc_env filename = do\n   -- skip the hi way check; we don't want to worry about profiled vs.\n   -- non-profiled interfaces, for example.\n   iface <- initTcRnIf 's' hsc_env () () $\n       readBinIface IgnoreHiWay TraceBinIFaceReading filename\n   let dflags = hsc_dflags hsc_env\n       -- See Note [Name qualification with --show-iface]\n       qualifyImportedNames mod _\n           | mod == mi_module iface = NameUnqual\n           | otherwise              = NameNotInScope1\n       print_unqual = QueryQualify qualifyImportedNames\n                                   neverQualifyModules\n                                   neverQualifyPackages\n   putLogMsg dflags NoReason SevDump noSrcSpan\n      (mkDumpStyle dflags print_unqual) (pprModIface iface)\n\n-- Show a ModIface but don't display details; suitable for ModIfaces stored in\n-- the EPT.\npprModIfaceSimple :: ModIface -> SDoc\npprModIfaceSimple iface = ppr (mi_module iface) $$ pprDeps (mi_deps iface) $$ nest 2 (vcat (map pprExport (mi_exports iface)))\n\npprModIface :: ModIface -> SDoc\n-- Show a ModIface\npprModIface iface\n = vcat [ text \"interface\"\n                <+> ppr (mi_module iface) <+> pp_hsc_src (mi_hsc_src iface)\n                <+> (if mi_orphan iface then text \"[orphan module]\" else Outputable.empty)\n                <+> (if mi_finsts iface then text \"[family instance module]\" else Outputable.empty)\n                <+> (if mi_hpc    iface then text \"[hpc]\" else Outputable.empty)\n                <+> integer hiVersion\n        , nest 2 (text \"interface hash:\" <+> ppr (mi_iface_hash iface))\n        , nest 2 (text \"ABI hash:\" <+> ppr (mi_mod_hash iface))\n        , nest 2 (text \"export-list hash:\" <+> ppr (mi_exp_hash iface))\n        , nest 2 (text \"orphan hash:\" <+> ppr (mi_orphan_hash iface))\n        , nest 2 (text \"flag hash:\" <+> ppr (mi_flag_hash iface))\n        , nest 2 (text \"opt_hash:\" <+> ppr (mi_opt_hash iface))\n        , nest 2 (text \"hpc_hash:\" <+> ppr (mi_hpc_hash iface))\n        , nest 2 (text \"plugin_hash:\" <+> ppr (mi_plugin_hash iface))\n        , nest 2 (text \"sig of:\" <+> ppr (mi_sig_of iface))\n        , nest 2 (text \"used TH splices:\" <+> ppr (mi_used_th iface))\n        , nest 2 (text \"where\")\n        , text \"exports:\"\n        , nest 2 (vcat (map pprExport (mi_exports iface)))\n        , pprDeps (mi_deps iface)\n        , vcat (map pprUsage (mi_usages iface))\n        , vcat (map pprIfaceAnnotation (mi_anns iface))\n        , pprFixities (mi_fixities iface)\n        , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]\n        , vcat (map ppr (mi_insts iface))\n        , vcat (map ppr (mi_fam_insts iface))\n        , vcat (map ppr (mi_rules iface))\n        , ppr (mi_warns iface)\n        , pprTrustInfo (mi_trust iface)\n        , pprTrustPkg (mi_trust_pkg iface)\n        , vcat (map ppr (mi_complete_sigs iface))\n        , text \"module header:\" $$ nest 2 (ppr (mi_doc_hdr iface))\n        , text \"declaration docs:\" $$ nest 2 (ppr (mi_decl_docs iface))\n        , text \"arg docs:\" $$ nest 2 (ppr (mi_arg_docs iface))\n        ]\n  where\n    pp_hsc_src HsBootFile = text \"[boot]\"\n    pp_hsc_src HsigFile = text \"[hsig]\"\n    pp_hsc_src HsSrcFile = Outputable.empty\n\n{-\nWhen printing export lists, we print like this:\n        Avail   f               f\n        AvailTC C [C, x, y]     C(x,y)\n        AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C\n-}\n\npprExport :: IfaceExport -> SDoc\npprExport (Avail n)         = ppr n\npprExport (AvailTC _ [] []) = Outputable.empty\npprExport (AvailTC n ns0 fs)\n  = case ns0 of\n      (n':ns) | n==n' -> ppr n <> pp_export ns fs\n      _               -> ppr n <> vbar <> pp_export ns0 fs\n  where\n    pp_export []    [] = Outputable.empty\n    pp_export names fs = braces (hsep (map ppr names ++ map (ppr . flLabel) fs))\n\npprUsage :: Usage -> SDoc\npprUsage usage@UsagePackageModule{}\n  = pprUsageImport usage usg_mod\npprUsage usage@UsageHomeModule{}\n  = pprUsageImport usage usg_mod_name $$\n    nest 2 (\n        maybe Outputable.empty (\\v -> text \"exports: \" <> ppr v) (usg_exports usage) $$\n        vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]\n        )\npprUsage usage@UsageFile{}\n  = hsep [text \"addDependentFile\",\n          doubleQuotes (text (usg_file_path usage)),\n          ppr (usg_file_hash usage)]\npprUsage usage@UsageMergedRequirement{}\n  = hsep [text \"merged\", ppr (usg_mod usage), ppr (usg_mod_hash usage)]\n\npprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc\npprUsageImport usage usg_mod'\n  = hsep [text \"import\", safe, ppr (usg_mod' usage),\n                       ppr (usg_mod_hash usage)]\n    where\n        safe | usg_safe usage = text \"safe\"\n             | otherwise      = text \" -/ \"\n\npprDeps :: Dependencies -> SDoc\npprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,\n                dep_finsts = finsts })\n  = vcat [text \"module dependencies:\" <+> fsep (map ppr_mod mods),\n          text \"package dependencies:\" <+> fsep (map ppr_pkg pkgs),\n          text \"orphans:\" <+> fsep (map ppr orphs),\n          text \"family instance modules:\" <+> fsep (map ppr finsts)\n        ]\n  where\n    ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot\n    ppr_pkg (pkg,trust_req)  = ppr pkg <>\n                               (if trust_req then text \"*\" else Outputable.empty)\n    ppr_boot True  = text \"[boot]\"\n    ppr_boot False = Outputable.empty\n\npprFixities :: [(OccName, Fixity)] -> SDoc\npprFixities []    = Outputable.empty\npprFixities fixes = text \"fixities\" <+> pprWithCommas pprFix fixes\n                  where\n                    pprFix (occ,fix) = ppr fix <+> ppr occ\n\npprTrustInfo :: IfaceTrustInfo -> SDoc\npprTrustInfo trust = text \"trusted:\" <+> ppr trust\n\npprTrustPkg :: Bool -> SDoc\npprTrustPkg tpkg = text \"require own pkg trusted:\" <+> ppr tpkg\n\ninstance Outputable Warnings where\n    ppr = pprWarns\n\npprWarns :: Warnings -> SDoc\npprWarns NoWarnings         = Outputable.empty\npprWarns (WarnAll txt)  = text \"Warn all\" <+> ppr txt\npprWarns (WarnSome prs) = text \"Warnings\"\n                        <+> vcat (map pprWarning prs)\n    where pprWarning (name, txt) = ppr name <+> ppr txt\n\npprIfaceAnnotation :: IfaceAnnotation -> SDoc\npprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized })\n  = ppr target <+> text \"annotated by\" <+> ppr serialized\n\n{-\n*********************************************************\n*                                                       *\n\\subsection{Errors}\n*                                                       *\n*********************************************************\n-}\n\nbadIfaceFile :: String -> SDoc -> SDoc\nbadIfaceFile file err\n  = vcat [text \"Bad interface file:\" <+> text file,\n          nest 4 err]\n\nhiModuleNameMismatchWarn :: DynFlags -> Module -> Module -> MsgDoc\nhiModuleNameMismatchWarn dflags requested_mod read_mod\n | moduleUnitId requested_mod == moduleUnitId read_mod =\n    sep [text \"Interface file contains module\" <+> quotes (ppr read_mod) <> comma,\n         text \"but we were expecting module\" <+> quotes (ppr requested_mod),\n         sep [text \"Probable cause: the source code which generated interface file\",\n             text \"has an incompatible module name\"\n            ]\n        ]\n | otherwise =\n  -- ToDo: This will fail to have enough qualification when the package IDs\n  -- are the same\n  withPprStyle (mkUserStyle dflags alwaysQualify AllTheWay) $\n    -- we want the Modules below to be qualified with package names,\n    -- so reset the PrintUnqualified setting.\n    hsep [ text \"Something is amiss; requested module \"\n         , ppr requested_mod\n         , text \"differs from name found in the interface file\"\n         , ppr read_mod\n         , parens (text \"if these names look the same, try again with -dppr-debug\")\n         ]\n\nhomeModError :: InstalledModule -> ModLocation -> SDoc\n-- See Note [Home module load error]\nhomeModError mod location\n  = text \"attempting to use module \" <> quotes (ppr mod)\n    <> (case ml_hs_file location of\n           Just file -> space <> parens (text file)\n           Nothing   -> Outputable.empty)\n    <+> text \"which is not loaded\"\n", "num_lines": 1287}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006-2008\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n-}\n\n{-# LANGUAGE CPP, NondecreasingIndentation #-}\n{-# LANGUAGE MultiWayIf #-}\n\n-- | Module for constructing @ModIface@ values (interface files),\n-- writing them to disk and comparing two versions to see if\n-- recompilation is required.\nmodule MkIface (\n        mkIface,        -- Build a ModIface from a ModGuts,\n                        -- including computing version information\n\n        mkIfaceTc,\n\n        writeIfaceFile, -- Write the interface file\n\n        checkOldIface,  -- See if recompilation is required, by\n                        -- comparing version information\n        RecompileRequired(..), recompileRequired,\n        mkIfaceExports,\n\n        coAxiomToIfaceDecl,\n        tyThingToIfaceDecl -- Converting things to their Iface equivalents\n ) where\n\n{-\n  -----------------------------------------------\n          Recompilation checking\n  -----------------------------------------------\n\nA complete description of how recompilation checking works can be\nfound in the wiki commentary:\n\n http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance\n\nPlease read the above page for a top-down description of how this all\nworks.  Notes below cover specific issues related to the implementation.\n\nBasic idea:\n\n  * In the mi_usages information in an interface, we record the\n    fingerprint of each free variable of the module\n\n  * In mkIface, we compute the fingerprint of each exported thing A.f.\n    For each external thing that A.f refers to, we include the fingerprint\n    of the external reference when computing the fingerprint of A.f.  So\n    if anything that A.f depends on changes, then A.f's fingerprint will\n    change.\n    Also record any dependent files added with\n      * addDependentFile\n      * #include\n      * -optP-include\n\n  * In checkOldIface we compare the mi_usages for the module with\n    the actual fingerprint for all each thing recorded in mi_usages\n-}\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport IfaceSyn\nimport BinFingerprint\nimport LoadIface\nimport ToIface\nimport FlagChecker\n\nimport DsUsage ( mkUsageInfo, mkUsedNames, mkDependencies )\nimport Id\nimport Annotations\nimport CoreSyn\nimport Class\nimport TyCon\nimport CoAxiom\nimport ConLike\nimport DataCon\nimport Type\nimport TcType\nimport InstEnv\nimport FamInstEnv\nimport TcRnMonad\nimport HsSyn\nimport HscTypes\nimport Finder\nimport DynFlags\nimport VarEnv\nimport Var\nimport Name\nimport Avail\nimport RdrName\nimport NameEnv\nimport NameSet\nimport Module\nimport BinIface\nimport ErrUtils\nimport Digraph\nimport SrcLoc\nimport Outputable\nimport BasicTypes       hiding ( SuccessFlag(..) )\nimport Unique\nimport Util             hiding ( eqListBy )\nimport FastString\nimport Maybes\nimport Binary\nimport Fingerprint\nimport Exception\nimport UniqSet\nimport Packages\nimport ExtractDocs\n\nimport Control.Monad\nimport Data.Function\nimport Data.List\nimport qualified Data.Map as Map\nimport Data.Ord\nimport Data.IORef\nimport System.Directory\nimport System.FilePath\nimport Plugins ( PluginRecompile(..), PluginWithArgs(..), LoadedPlugin(..),\n                 pluginRecompile', plugins )\n\n--Qualified import so we can define a Semigroup instance\n-- but it doesn't clash with Outputable.<>\nimport qualified Data.Semigroup\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Completing an interface}\n*                                                                      *\n************************************************************************\n-}\n\nmkIface :: HscEnv\n        -> Maybe Fingerprint    -- The old fingerprint, if we have it\n        -> ModDetails           -- The trimmed, tidied interface\n        -> ModGuts              -- Usages, deprecations, etc\n        -> IO (ModIface, -- The new one\n               Bool)     -- True <=> there was an old Iface, and the\n                         --          new one is identical, so no need\n                         --          to write it\n\nmkIface hsc_env maybe_old_fingerprint mod_details\n         ModGuts{     mg_module       = this_mod,\n                      mg_hsc_src      = hsc_src,\n                      mg_usages       = usages,\n                      mg_used_th      = used_th,\n                      mg_deps         = deps,\n                      mg_rdr_env      = rdr_env,\n                      mg_fix_env      = fix_env,\n                      mg_warns        = warns,\n                      mg_hpc_info     = hpc_info,\n                      mg_safe_haskell = safe_mode,\n                      mg_trust_pkg    = self_trust,\n                      mg_doc_hdr      = doc_hdr,\n                      mg_decl_docs    = decl_docs,\n                      mg_arg_docs     = arg_docs\n                    }\n        = mkIface_ hsc_env maybe_old_fingerprint\n                   this_mod hsc_src used_th deps rdr_env fix_env\n                   warns hpc_info self_trust\n                   safe_mode usages\n                   doc_hdr decl_docs arg_docs\n                   mod_details\n\n-- | make an interface from the results of typechecking only.  Useful\n-- for non-optimising compilation, or where we aren't generating any\n-- object code at all ('HscNothing').\nmkIfaceTc :: HscEnv\n          -> Maybe Fingerprint  -- The old fingerprint, if we have it\n          -> SafeHaskellMode    -- The safe haskell mode\n          -> ModDetails         -- gotten from mkBootModDetails, probably\n          -> TcGblEnv           -- Usages, deprecations, etc\n          -> IO (ModIface, Bool)\nmkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details\n  tc_result@TcGblEnv{ tcg_mod = this_mod,\n                      tcg_src = hsc_src,\n                      tcg_imports = imports,\n                      tcg_rdr_env = rdr_env,\n                      tcg_fix_env = fix_env,\n                      tcg_merged = merged,\n                      tcg_warns = warns,\n                      tcg_hpc = other_hpc_info,\n                      tcg_th_splice_used = tc_splice_used,\n                      tcg_dependent_files = dependent_files\n                    }\n  = do\n          let used_names = mkUsedNames tc_result\n          let pluginModules =\n                map lpModule (cachedPlugins (hsc_dflags hsc_env))\n          deps <- mkDependencies\n                    (thisInstalledUnitId (hsc_dflags hsc_env))\n                    (map mi_module pluginModules) tc_result\n          let hpc_info = emptyHpcInfo other_hpc_info\n          used_th <- readIORef tc_splice_used\n          dep_files <- (readIORef dependent_files)\n          -- Do NOT use semantic module here; this_mod in mkUsageInfo\n          -- is used solely to decide if we should record a dependency\n          -- or not.  When we instantiate a signature, the semantic\n          -- module is something we want to record dependencies for,\n          -- but if you pass that in here, we'll decide it's the local\n          -- module and does not need to be recorded as a dependency.\n          -- See Note [Identity versus semantic module]\n          usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names\n                      dep_files merged pluginModules\n\n          let (doc_hdr', doc_map, arg_map) = extractDocs tc_result\n\n          mkIface_ hsc_env maybe_old_fingerprint\n                   this_mod hsc_src\n                   used_th deps rdr_env\n                   fix_env warns hpc_info\n                   (imp_trust_own_pkg imports) safe_mode usages\n                   doc_hdr' doc_map arg_map\n                   mod_details\n\n\n\nmkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource\n         -> Bool -> Dependencies -> GlobalRdrEnv\n         -> NameEnv FixItem -> Warnings -> HpcInfo\n         -> Bool\n         -> SafeHaskellMode\n         -> [Usage]\n         -> Maybe HsDocString\n         -> DeclDocMap\n         -> ArgDocMap\n         -> ModDetails\n         -> IO (ModIface, Bool)\nmkIface_ hsc_env maybe_old_fingerprint\n         this_mod hsc_src used_th deps rdr_env fix_env src_warns\n         hpc_info pkg_trust_req safe_mode usages\n         doc_hdr decl_docs arg_docs\n         ModDetails{  md_insts     = insts,\n                      md_fam_insts = fam_insts,\n                      md_rules     = rules,\n                      md_anns      = anns,\n                      md_types     = type_env,\n                      md_exports   = exports,\n                      md_complete_sigs = complete_sigs }\n-- NB:  notice that mkIface does not look at the bindings\n--      only at the TypeEnv.  The previous Tidy phase has\n--      put exactly the info into the TypeEnv that we want\n--      to expose in the interface\n\n  = do\n    let semantic_mod = canonicalizeHomeModule (hsc_dflags hsc_env) (moduleName this_mod)\n        entities = typeEnvElts type_env\n        decls  = [ tyThingToIfaceDecl entity\n                 | entity <- entities,\n                   let name = getName entity,\n                   not (isImplicitTyThing entity),\n                      -- No implicit Ids and class tycons in the interface file\n                   not (isWiredInName name),\n                      -- Nor wired-in things; the compiler knows about them anyhow\n                   nameIsLocalOrFrom semantic_mod name  ]\n                      -- Sigh: see Note [Root-main Id] in TcRnDriver\n                      -- NB: ABSOLUTELY need to check against semantic_mod,\n                      -- because all of the names in an hsig p[H=<H>]:H\n                      -- are going to be for <H>, not the former id!\n                      -- See Note [Identity versus semantic module]\n\n        fixities    = sortBy (comparing fst)\n          [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]\n          -- The order of fixities returned from nameEnvElts is not\n          -- deterministic, so we sort by OccName to canonicalize it.\n          -- See Note [Deterministic UniqFM] in UniqDFM for more details.\n        warns       = src_warns\n        iface_rules = map coreRuleToIfaceRule rules\n        iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts\n        iface_fam_insts = map famInstToIfaceFamInst fam_insts\n        trust_info  = setSafeMode safe_mode\n        annotations = map mkIfaceAnnotation anns\n        icomplete_sigs = map mkIfaceCompleteSig complete_sigs\n\n        intermediate_iface = ModIface {\n              mi_module      = this_mod,\n              -- Need to record this because it depends on the -instantiated-with flag\n              -- which could change\n              mi_sig_of      = if semantic_mod == this_mod\n                                then Nothing\n                                else Just semantic_mod,\n              mi_hsc_src     = hsc_src,\n              mi_deps        = deps,\n              mi_usages      = usages,\n              mi_exports     = mkIfaceExports exports,\n\n              -- Sort these lexicographically, so that\n              -- the result is stable across compilations\n              mi_insts       = sortBy cmp_inst     iface_insts,\n              mi_fam_insts   = sortBy cmp_fam_inst iface_fam_insts,\n              mi_rules       = sortBy cmp_rule     iface_rules,\n\n              mi_fixities    = fixities,\n              mi_warns       = warns,\n              mi_anns        = annotations,\n              mi_globals     = maybeGlobalRdrEnv rdr_env,\n\n              -- Left out deliberately: filled in by addFingerprints\n              mi_iface_hash  = fingerprint0,\n              mi_mod_hash    = fingerprint0,\n              mi_flag_hash   = fingerprint0,\n              mi_opt_hash    = fingerprint0,\n              mi_hpc_hash    = fingerprint0,\n              mi_exp_hash    = fingerprint0,\n              mi_plugin_hash = fingerprint0,\n              mi_used_th     = used_th,\n              mi_orphan_hash = fingerprint0,\n              mi_orphan      = False, -- Always set by addFingerprints, but\n                                      -- it's a strict field, so we can't omit it.\n              mi_finsts      = False, -- Ditto\n              mi_decls       = deliberatelyOmitted \"decls\",\n              mi_hash_fn     = deliberatelyOmitted \"hash_fn\",\n              mi_hpc         = isHpcUsed hpc_info,\n              mi_trust       = trust_info,\n              mi_trust_pkg   = pkg_trust_req,\n\n              -- And build the cached values\n              mi_warn_fn     = mkIfaceWarnCache warns,\n              mi_fix_fn      = mkIfaceFixCache fixities,\n              mi_complete_sigs = icomplete_sigs,\n              mi_doc_hdr     = doc_hdr,\n              mi_decl_docs   = decl_docs,\n              mi_arg_docs    = arg_docs }\n\n    (new_iface, no_change_at_all)\n          <- {-# SCC \"versioninfo\" #-}\n                   addFingerprints hsc_env maybe_old_fingerprint\n                                   intermediate_iface decls\n\n    -- Debug printing\n    dumpIfSet_dyn dflags Opt_D_dump_hi \"FINAL INTERFACE\"\n                  (pprModIface new_iface)\n\n    -- bug #1617: on reload we weren't updating the PrintUnqualified\n    -- correctly.  This stems from the fact that the interface had\n    -- not changed, so addFingerprints returns the old ModIface\n    -- with the old GlobalRdrEnv (mi_globals).\n    let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }\n\n    return (final_iface, no_change_at_all)\n  where\n     cmp_rule     = comparing ifRuleName\n     -- Compare these lexicographically by OccName, *not* by unique,\n     -- because the latter is not stable across compilations:\n     cmp_inst     = comparing (nameOccName . ifDFun)\n     cmp_fam_inst = comparing (nameOccName . ifFamInstTcName)\n\n     dflags = hsc_dflags hsc_env\n\n     -- We only fill in mi_globals if the module was compiled to byte\n     -- code.  Otherwise, the compiler may not have retained all the\n     -- top-level bindings and they won't be in the TypeEnv (see\n     -- Desugar.addExportFlagsAndRules).  The mi_globals field is used\n     -- by GHCi to decide whether the module has its full top-level\n     -- scope available. (#5534)\n     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv\n     maybeGlobalRdrEnv rdr_env\n         | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env\n         | otherwise                                   = Nothing\n\n     deliberatelyOmitted :: String -> a\n     deliberatelyOmitted x = panic (\"Deliberately omitted: \" ++ x)\n\n     ifFamInstTcName = ifFamInstFam\n\n-----------------------------\nwriteIfaceFile :: DynFlags -> FilePath -> ModIface -> IO ()\nwriteIfaceFile dflags hi_file_path new_iface\n    = do createDirectoryIfMissing True (takeDirectory hi_file_path)\n         writeBinIface dflags hi_file_path new_iface\n\n\n-- -----------------------------------------------------------------------------\n-- Look up parents and versions of Names\n\n-- This is like a global version of the mi_hash_fn field in each ModIface.\n-- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get\n-- the parent and version info.\n\nmkHashFun\n        :: HscEnv                       -- needed to look up versions\n        -> ExternalPackageState         -- ditto\n        -> (Name -> IO Fingerprint)\nmkHashFun hsc_env eps name\n  | isHoleModule orig_mod\n  = lookup (mkModule (thisPackage dflags) (moduleName orig_mod))\n  | otherwise\n  = lookup orig_mod\n  where\n      dflags = hsc_dflags hsc_env\n      hpt = hsc_HPT hsc_env\n      pit = eps_PIT eps\n      occ = nameOccName name\n      orig_mod = nameModule name\n      lookup mod = do\n        MASSERT2( isExternalName name, ppr name )\n        iface <- case lookupIfaceByModule dflags hpt pit mod of\n                  Just iface -> return iface\n                  Nothing -> do\n                      -- This can occur when we're writing out ifaces for\n                      -- requirements; we didn't do any /real/ typechecking\n                      -- so there's no guarantee everything is loaded.\n                      -- Kind of a heinous hack.\n                      iface <- initIfaceLoad hsc_env . withException\n                            $ loadInterface (text \"lookupVers2\") mod ImportBySystem\n                      return iface\n        return $ snd (mi_hash_fn iface occ `orElse`\n                  pprPanic \"lookupVers1\" (ppr mod <+> ppr occ))\n\n-- ---------------------------------------------------------------------------\n-- Compute fingerprints for the interface\n\n{-\nNote [Fingerprinting IfaceDecls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe general idea here is that we first examine the 'IfaceDecl's and determine\nthe recursive groups of them. We then walk these groups in dependency order,\nserializing each contained 'IfaceDecl' to a \"Binary\" buffer which we then\nhash using MD5 to produce a fingerprint for the group.\n\nHowever, the serialization that we use is a bit funny: we override the @putName@\noperation with our own which serializes the hash of a 'Name' instead of the\n'Name' itself. This ensures that the fingerprint of a decl changes if anything\nin its transitive closure changes. This trick is why we must be careful about\ntraversing in dependency order: we need to ensure that we have hashes for\neverything referenced by the decl which we are fingerprinting.\n\nMoreover, we need to be careful to distinguish between serialization of binding\nNames (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls\nfield of a IfaceClsInst): only in the non-binding case should we include the\nfingerprint; in the binding case we shouldn't since it is merely the name of the\nthing that we are currently fingerprinting.\n-}\n\n-- | Add fingerprints for top-level declarations to a 'ModIface'.\n--\n-- See Note [Fingerprinting IfaceDecls]\naddFingerprints\n        :: HscEnv\n        -> Maybe Fingerprint -- the old fingerprint, if any\n        -> ModIface          -- The new interface (lacking decls)\n        -> [IfaceDecl]       -- The new decls\n        -> IO (ModIface,     -- Updated interface\n               Bool)         -- True <=> no changes at all;\n                             -- no need to write Iface\n\naddFingerprints hsc_env mb_old_fingerprint iface0 new_decls\n = do\n   eps <- hscEPS hsc_env\n   let\n        -- The ABI of a declaration represents everything that is made\n        -- visible about the declaration that a client can depend on.\n        -- see IfaceDeclABI below.\n       declABI :: IfaceDecl -> IfaceDeclABI\n       -- TODO: I'm not sure if this should be semantic_mod or this_mod.\n       -- See also Note [Identity versus semantic module]\n       declABI decl = (this_mod, decl, extras)\n        where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts\n                                  non_orph_fis top_lvl_name_env decl\n\n       -- This is used for looking up the Name of a default method\n       -- from its OccName. See Note [default method Name]\n       top_lvl_name_env =\n         mkOccEnv [ (nameOccName nm, nm)\n                  | IfaceId { ifName = nm } <- new_decls ]\n\n       -- Dependency edges between declarations in the current module.\n       -- This is computed by finding the free external names of each\n       -- declaration, including IfaceDeclExtras (things that a\n       -- declaration implicitly depends on).\n       edges :: [ Node Unique IfaceDeclABI ]\n       edges = [ DigraphNode abi (getUnique (getOccName decl)) out\n               | decl <- new_decls\n               , let abi = declABI decl\n               , let out = localOccs $ freeNamesDeclABI abi\n               ]\n\n       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n\n       localOccs =\n         map (getUnique . getParent . getOccName)\n                        -- NB: names always use semantic module, so\n                        -- filtering must be on the semantic module!\n                        -- See Note [Identity versus semantic module]\n                        . filter ((== semantic_mod) . name_module)\n                        . nonDetEltsUniqSet\n                   -- It's OK to use nonDetEltsUFM as localOccs is only\n                   -- used to construct the edges and\n                   -- stronglyConnCompFromEdgedVertices is deterministic\n                   -- even with non-deterministic order of edges as\n                   -- explained in Note [Deterministic SCC] in Digraph.\n          where getParent :: OccName -> OccName\n                getParent occ = lookupOccEnv parent_map occ `orElse` occ\n\n        -- maps OccNames to their parents in the current module.\n        -- e.g. a reference to a constructor must be turned into a reference\n        -- to the TyCon for the purposes of calculating dependencies.\n       parent_map :: OccEnv OccName\n       parent_map = foldl' extend emptyOccEnv new_decls\n          where extend env d =\n                  extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]\n                  where n = getOccName d\n\n        -- Strongly-connected groups of declarations, in dependency order\n       groups :: [SCC IfaceDeclABI]\n       groups = stronglyConnCompFromEdgedVerticesUniq edges\n\n       global_hash_fn = mkHashFun hsc_env eps\n\n        -- How to output Names when generating the data to fingerprint.\n        -- Here we want to output the fingerprint for each top-level\n        -- Name, whether it comes from the current module or another\n        -- module.  In this way, the fingerprint for a declaration will\n        -- change if the fingerprint for anything it refers to (transitively)\n        -- changes.\n       mk_put_name :: OccEnv (OccName,Fingerprint)\n                   -> BinHandle -> Name -> IO  ()\n       mk_put_name local_env bh name\n          | isWiredInName name  =  putNameLiterally bh name\n           -- wired-in names don't have fingerprints\n          | otherwise\n          = ASSERT2( isExternalName name, ppr name )\n            let hash | nameModule name /= semantic_mod =  global_hash_fn name\n                     -- Get it from the REAL interface!!\n                     -- This will trigger when we compile an hsig file\n                     -- and we know a backing impl for it.\n                     -- See Note [Identity versus semantic module]\n                     | semantic_mod /= this_mod\n                     , not (isHoleModule semantic_mod) = global_hash_fn name\n                     | otherwise = return (snd (lookupOccEnv local_env (getOccName name)\n                           `orElse` pprPanic \"urk! lookup local fingerprint\"\n                                       (ppr name $$ ppr local_env)))\n                -- This panic indicates that we got the dependency\n                -- analysis wrong, because we needed a fingerprint for\n                -- an entity that wasn't in the environment.  To debug\n                -- it, turn the panic into a trace, uncomment the\n                -- pprTraces below, run the compile again, and inspect\n                -- the output and the generated .hi file with\n                -- --show-iface.\n            in hash >>= put_ bh\n\n        -- take a strongly-connected group of declarations and compute\n        -- its fingerprint.\n\n       fingerprint_group :: (OccEnv (OccName,Fingerprint),\n                             [(Fingerprint,IfaceDecl)])\n                         -> SCC IfaceDeclABI\n                         -> IO (OccEnv (OccName,Fingerprint),\n                                [(Fingerprint,IfaceDecl)])\n\n       fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)\n          = do let hash_fn = mk_put_name local_env\n                   decl = abiDecl abi\n               --pprTrace \"fingerprinting\" (ppr (ifName decl) ) $ do\n               hash <- computeFingerprint hash_fn abi\n               env' <- extend_hash_env local_env (hash,decl)\n               return (env', (hash,decl) : decls_w_hashes)\n\n       fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)\n          = do let decls = map abiDecl abis\n               local_env1 <- foldM extend_hash_env local_env\n                                   (zip (repeat fingerprint0) decls)\n               let hash_fn = mk_put_name local_env1\n               -- pprTrace \"fingerprinting\" (ppr (map ifName decls) ) $ do\n               let stable_abis = sortBy cmp_abiNames abis\n                -- put the cycle in a canonical order\n               hash <- computeFingerprint hash_fn stable_abis\n               let pairs = zip (repeat hash) decls\n               local_env2 <- foldM extend_hash_env local_env pairs\n               return (local_env2, pairs ++ decls_w_hashes)\n\n       -- we have fingerprinted the whole declaration, but we now need\n       -- to assign fingerprints to all the OccNames that it binds, to\n       -- use when referencing those OccNames in later declarations.\n       --\n       extend_hash_env :: OccEnv (OccName,Fingerprint)\n                       -> (Fingerprint,IfaceDecl)\n                       -> IO (OccEnv (OccName,Fingerprint))\n       extend_hash_env env0 (hash,d) = do\n          return (foldr (\\(b,fp) env -> extendOccEnv env b (b,fp)) env0\n                 (ifaceDeclFingerprints hash d))\n\n   --\n   (local_env, decls_w_hashes) <-\n       foldM fingerprint_group (emptyOccEnv, []) groups\n\n   -- when calculating fingerprints, we always need to use canonical\n   -- ordering for lists of things.  In particular, the mi_deps has various\n   -- lists of modules and suchlike, so put these all in canonical order:\n   let sorted_deps = sortDependencies (mi_deps iface0)\n\n   -- The export hash of a module depends on the orphan hashes of the\n   -- orphan modules below us in the dependency tree.  This is the way\n   -- that changes in orphans get propagated all the way up the\n   -- dependency tree.\n   --\n   -- Note [A bad dep_orphs optimization]\n   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n   -- In a previous version of this code, we filtered out orphan modules which\n   -- were not from the home package, justifying it by saying that \"we'd\n   -- pick up the ABI hashes of the external module instead\".  This is wrong.\n   -- Suppose that we have:\n   --\n   --       module External where\n   --           instance Show (a -> b)\n   --\n   --       module Home1 where\n   --           import External\n   --\n   --       module Home2 where\n   --           import Home1\n   --\n   -- The export hash of Home1 needs to reflect the orphan instances of\n   -- External. It's true that Home1 will get rebuilt if the orphans\n   -- of External, but we also need to make sure Home2 gets rebuilt\n   -- as well.  See #12733 for more details.\n   let orph_mods\n        = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]\n        $ dep_orphs sorted_deps\n   dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods\n\n   -- Note [Do not update EPS with your own hi-boot]\n   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n   -- (See also Trac #10182).  When your hs-boot file includes an orphan\n   -- instance declaration, you may find that the dep_orphs of a module you\n   -- import contains reference to yourself.  DO NOT actually load this module\n   -- or add it to the orphan hashes: you're going to provide the orphan\n   -- instances yourself, no need to consult hs-boot; if you do load the\n   -- interface into EPS, you will see a duplicate orphan instance.\n\n   orphan_hash <- computeFingerprint (mk_put_name local_env)\n                                     (map ifDFun orph_insts, orph_rules, orph_fis)\n\n   -- the export list hash doesn't depend on the fingerprints of\n   -- the Names it mentions, only the Names themselves, hence putNameLiterally.\n   export_hash <- computeFingerprint putNameLiterally\n                      (mi_exports iface0,\n                       orphan_hash,\n                       dep_orphan_hashes,\n                       dep_pkgs (mi_deps iface0),\n                       -- See Note [Export hash depends on non-orphan family instances]\n                       dep_finsts (mi_deps iface0),\n                        -- dep_pkgs: see \"Package Version Changes\" on\n                        -- wiki/Commentary/Compiler/RecompilationAvoidance\n                       mi_trust iface0)\n                        -- Make sure change of Safe Haskell mode causes recomp.\n\n   -- Note [Export hash depends on non-orphan family instances]\n   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n   --\n   -- Suppose we have:\n   --\n   --   module A where\n   --       type instance F Int = Bool\n   --\n   --   module B where\n   --       import A\n   --\n   --   module C where\n   --       import B\n   --\n   -- The family instance consistency check for C depends on the dep_finsts of\n   -- B.  If we rename module A to A2, when the dep_finsts of B changes, we need\n   -- to make sure that C gets rebuilt. Effectively, the dep_finsts are part of\n   -- the exports of B, because C always considers them when checking\n   -- consistency.\n   --\n   -- A full discussion is in #12723.\n   --\n   -- We do NOT need to hash dep_orphs, because this is implied by\n   -- dep_orphan_hashes, and we do not need to hash ordinary class instances,\n   -- because there is no eager consistency check as there is with type families\n   -- (also we didn't store it anywhere!)\n   --\n\n   -- put the declarations in a canonical order, sorted by OccName\n   let sorted_decls = Map.elems $ Map.fromList $\n                          [(getOccName d, e) | e@(_, d) <- decls_w_hashes]\n\n   -- the flag hash depends on:\n   --   - (some of) dflags\n   -- it returns two hashes, one that shouldn't change\n   -- the abi hash and one that should\n   flag_hash <- fingerprintDynFlags dflags this_mod putNameLiterally\n\n   opt_hash <- fingerprintOptFlags dflags putNameLiterally\n\n   hpc_hash <- fingerprintHpcFlags dflags putNameLiterally\n\n   plugin_hash <- fingerprintPlugins hsc_env\n\n   -- the ABI hash depends on:\n   --   - decls\n   --   - export list\n   --   - orphans\n   --   - deprecations\n   --   - flag abi hash\n   mod_hash <- computeFingerprint putNameLiterally\n                      (map fst sorted_decls,\n                       export_hash,  -- includes orphan_hash\n                       mi_warns iface0)\n\n   -- The interface hash depends on:\n   --   - the ABI hash, plus\n   --   - the module level annotations,\n   --   - usages\n   --   - deps (home and external packages, dependent files)\n   --   - hpc\n   iface_hash <- computeFingerprint putNameLiterally\n                      (mod_hash,\n                       ann_fn (mkVarOcc \"module\"),  -- See mkIfaceAnnCache\n                       mi_usages iface0,\n                       sorted_deps,\n                       mi_hpc iface0)\n\n   let\n    no_change_at_all = Just iface_hash == mb_old_fingerprint\n\n    final_iface = iface0 {\n                mi_mod_hash    = mod_hash,\n                mi_iface_hash  = iface_hash,\n                mi_exp_hash    = export_hash,\n                mi_orphan_hash = orphan_hash,\n                mi_flag_hash   = flag_hash,\n                mi_opt_hash    = opt_hash,\n                mi_hpc_hash    = hpc_hash,\n                mi_plugin_hash = plugin_hash,\n                mi_orphan      = not (   all ifRuleAuto orph_rules\n                                           -- See Note [Orphans and auto-generated rules]\n                                      && null orph_insts\n                                      && null orph_fis),\n                mi_finsts      = not . null $ mi_fam_insts iface0,\n                mi_decls       = sorted_decls,\n                mi_hash_fn     = lookupOccEnv local_env }\n   --\n   return (final_iface, no_change_at_all)\n\n  where\n    this_mod = mi_module iface0\n    semantic_mod = mi_semantic_module iface0\n    dflags = hsc_dflags hsc_env\n    (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph    (mi_insts iface0)\n    (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph    (mi_rules iface0)\n    (non_orph_fis,   orph_fis)   = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)\n    fix_fn = mi_fix_fn iface0\n    ann_fn = mkIfaceAnnCache (mi_anns iface0)\n\n-- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules\n-- (in particular, the orphan modules which are transitively imported by the\n-- current module).\n--\n-- Q: Why do we need the hash at all, doesn't the list of transitively\n-- imported orphan modules suffice?\n--\n-- A: If one of our transitive imports adds a new orphan instance, our\n-- export hash must change so that modules which import us rebuild.  If we just\n-- hashed the [Module], the hash would not change even when a new instance was\n-- added to a module that already had an orphan instance.\n--\n-- Q: Why don't we just hash the orphan hashes of our direct dependencies?\n-- Why the full transitive closure?\n--\n-- A: Suppose we have these modules:\n--\n--      module A where\n--          instance Show (a -> b) where\n--      module B where\n--          import A -- **\n--      module C where\n--          import A\n--          import B\n--\n-- Whether or not we add or remove the import to A in B affects the\n-- orphan hash of B.  But it shouldn't really affect the orphan hash\n-- of C.  If we hashed only direct dependencies, there would be no\n-- way to tell that the net effect was a wash, and we'd be forced\n-- to recompile C and everything else.\ngetOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]\ngetOrphanHashes hsc_env mods = do\n  eps <- hscEPS hsc_env\n  let\n    hpt        = hsc_HPT hsc_env\n    pit        = eps_PIT eps\n    dflags     = hsc_dflags hsc_env\n    get_orph_hash mod =\n          case lookupIfaceByModule dflags hpt pit mod of\n            Just iface -> return (mi_orphan_hash iface)\n            Nothing    -> do -- similar to 'mkHashFun'\n                iface <- initIfaceLoad hsc_env . withException\n                            $ loadInterface (text \"getOrphanHashes\") mod ImportBySystem\n                return (mi_orphan_hash iface)\n\n  --\n  mapM get_orph_hash mods\n\n\nsortDependencies :: Dependencies -> Dependencies\nsortDependencies d\n = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),\n          dep_pkgs   = sortBy (compare `on` fst) (dep_pkgs d),\n          dep_orphs  = sortBy stableModuleCmp (dep_orphs d),\n          dep_finsts = sortBy stableModuleCmp (dep_finsts d),\n          dep_plgins = sortBy (compare `on` moduleNameFS) (dep_plgins d) }\n\n-- | Creates cached lookup for the 'mi_anns' field of ModIface\n-- Hackily, we use \"module\" as the OccName for any module-level annotations\nmkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]\nmkIfaceAnnCache anns\n  = \\n -> lookupOccEnv env n `orElse` []\n  where\n    pair (IfaceAnnotation target value) =\n      (case target of\n          NamedTarget occn -> occn\n          ModuleTarget _   -> mkVarOcc \"module\"\n      , [value])\n    -- flipping (++), so the first argument is always short\n    env = mkOccEnv_C (flip (++)) (map pair anns)\n\n{-\n************************************************************************\n*                                                                      *\n          The ABI of an IfaceDecl\n*                                                                      *\n************************************************************************\n\nNote [The ABI of an IfaceDecl]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe ABI of a declaration consists of:\n\n   (a) the full name of the identifier (inc. module and package,\n       because these are used to construct the symbol name by which\n       the identifier is known externally).\n\n   (b) the declaration itself, as exposed to clients.  That is, the\n       definition of an Id is included in the fingerprint only if\n       it is made available as an unfolding in the interface.\n\n   (c) the fixity of the identifier (if it exists)\n   (d) for Ids: rules\n   (e) for classes: instances, fixity & rules for methods\n   (f) for datatypes: instances, fixity & rules for constrs\n\nItems (c)-(f) are not stored in the IfaceDecl, but instead appear\nelsewhere in the interface file.  But they are *fingerprinted* with\nthe declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,\nand fingerprinting that as part of the declaration.\n-}\n\ntype IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)\n\ndata IfaceDeclExtras\n  = IfaceIdExtras IfaceIdExtras\n\n  | IfaceDataExtras\n       (Maybe Fixity)           -- Fixity of the tycon itself (if it exists)\n       [IfaceInstABI]           -- Local class and family instances of this tycon\n                                -- See Note [Orphans] in InstEnv\n       [AnnPayload]             -- Annotations of the type itself\n       [IfaceIdExtras]          -- For each constructor: fixity, RULES and annotations\n\n  | IfaceClassExtras\n       (Maybe Fixity)           -- Fixity of the class itself (if it exists)\n       [IfaceInstABI]           -- Local instances of this class *or*\n                                --   of its associated data types\n                                -- See Note [Orphans] in InstEnv\n       [AnnPayload]             -- Annotations of the type itself\n       [IfaceIdExtras]          -- For each class method: fixity, RULES and annotations\n       [IfExtName]              -- Default methods. If a module\n                                -- mentions a class, then it can\n                                -- instantiate the class and thereby\n                                -- use the default methods, so we must\n                                -- include these in the fingerprint of\n                                -- a class.\n\n  | IfaceSynonymExtras (Maybe Fixity) [AnnPayload]\n\n  | IfaceFamilyExtras   (Maybe Fixity) [IfaceInstABI] [AnnPayload]\n\n  | IfaceOtherDeclExtras\n\ndata IfaceIdExtras\n  = IdExtras\n       (Maybe Fixity)           -- Fixity of the Id (if it exists)\n       [IfaceRule]              -- Rules for the Id\n       [AnnPayload]             -- Annotations for the Id\n\n-- When hashing a class or family instance, we hash only the\n-- DFunId or CoAxiom, because that depends on all the\n-- information about the instance.\n--\ntype IfaceInstABI = IfExtName   -- Name of DFunId or CoAxiom that is evidence for the instance\n\nabiDecl :: IfaceDeclABI -> IfaceDecl\nabiDecl (_, decl, _) = decl\n\ncmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering\ncmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare`\n                         getOccName (abiDecl abi2)\n\nfreeNamesDeclABI :: IfaceDeclABI -> NameSet\nfreeNamesDeclABI (_mod, decl, extras) =\n  freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras\n\nfreeNamesDeclExtras :: IfaceDeclExtras -> NameSet\nfreeNamesDeclExtras (IfaceIdExtras id_extras)\n  = freeNamesIdExtras id_extras\nfreeNamesDeclExtras (IfaceDataExtras  _ insts _ subs)\n  = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)\nfreeNamesDeclExtras (IfaceClassExtras _ insts _ subs defms)\n  = unionNameSets $\n      mkNameSet insts : mkNameSet defms : map freeNamesIdExtras subs\nfreeNamesDeclExtras (IfaceSynonymExtras _ _)\n  = emptyNameSet\nfreeNamesDeclExtras (IfaceFamilyExtras _ insts _)\n  = mkNameSet insts\nfreeNamesDeclExtras IfaceOtherDeclExtras\n  = emptyNameSet\n\nfreeNamesIdExtras :: IfaceIdExtras -> NameSet\nfreeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules)\n\ninstance Outputable IfaceDeclExtras where\n  ppr IfaceOtherDeclExtras       = Outputable.empty\n  ppr (IfaceIdExtras  extras)    = ppr_id_extras extras\n  ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns]\n  ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]\n  ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,\n                                                ppr_id_extras_s stuff]\n  ppr (IfaceClassExtras fix insts anns stuff defms) =\n    vcat [ppr fix, ppr_insts insts, ppr anns,\n          ppr_id_extras_s stuff, ppr defms]\n\nppr_insts :: [IfaceInstABI] -> SDoc\nppr_insts _ = text \"<insts>\"\n\nppr_id_extras_s :: [IfaceIdExtras] -> SDoc\nppr_id_extras_s stuff = vcat (map ppr_id_extras stuff)\n\nppr_id_extras :: IfaceIdExtras -> SDoc\nppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns)\n\n-- This instance is used only to compute fingerprints\ninstance Binary IfaceDeclExtras where\n  get _bh = panic \"no get for IfaceDeclExtras\"\n  put_ bh (IfaceIdExtras extras) = do\n   putByte bh 1; put_ bh extras\n  put_ bh (IfaceDataExtras fix insts anns cons) = do\n   putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons\n  put_ bh (IfaceClassExtras fix insts anns methods defms) = do\n   putByte bh 3\n   put_ bh fix\n   put_ bh insts\n   put_ bh anns\n   put_ bh methods\n   put_ bh defms\n  put_ bh (IfaceSynonymExtras fix anns) = do\n   putByte bh 4; put_ bh fix; put_ bh anns\n  put_ bh (IfaceFamilyExtras fix finsts anns) = do\n   putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns\n  put_ bh IfaceOtherDeclExtras = putByte bh 6\n\ninstance Binary IfaceIdExtras where\n  get _bh = panic \"no get for IfaceIdExtras\"\n  put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }\n\ndeclExtras :: (OccName -> Maybe Fixity)\n           -> (OccName -> [AnnPayload])\n           -> OccEnv [IfaceRule]\n           -> OccEnv [IfaceClsInst]\n           -> OccEnv [IfaceFamInst]\n           -> OccEnv IfExtName          -- lookup default method names\n           -> IfaceDecl\n           -> IfaceDeclExtras\n\ndeclExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl\n  = case decl of\n      IfaceId{} -> IfaceIdExtras (id_extras n)\n      IfaceData{ifCons=cons} ->\n                     IfaceDataExtras (fix_fn n)\n                        (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++\n                         map ifDFun         (lookupOccEnvL inst_env n))\n                        (ann_fn n)\n                        (map (id_extras . occName . ifConName) (visibleIfConDecls cons))\n      IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} ->\n                     IfaceClassExtras (fix_fn n) insts (ann_fn n) meths defms\n          where\n            insts = (map ifDFun $ (concatMap at_extras ats)\n                                    ++ lookupOccEnvL inst_env n)\n                           -- Include instances of the associated types\n                           -- as well as instances of the class (Trac #5147)\n            meths = [id_extras (getOccName op) | IfaceClassOp op _ _ <- sigs]\n            -- Names of all the default methods (see Note [default method Name])\n            defms = [ dmName\n                    | IfaceClassOp bndr _ (Just _) <- sigs\n                    , let dmOcc = mkDefaultMethodOcc (nameOccName bndr)\n                    , Just dmName <- [lookupOccEnv dm_env dmOcc] ]\n      IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n)\n                                           (ann_fn n)\n      IfaceFamily{} -> IfaceFamilyExtras (fix_fn n)\n                        (map ifFamInstAxiom (lookupOccEnvL fi_env n))\n                        (ann_fn n)\n      _other -> IfaceOtherDeclExtras\n  where\n        n = getOccName decl\n        id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn occ)\n        at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (getOccName decl)\n\n\n{- Note [default method Name] (see also #15970)\n\nThe Names for the default methods aren't available in the IfaceSyn.\n\n* We originally start with a DefMethInfo from the class, contain a\n  Name for the default method\n\n* We turn that into IfaceSyn as a DefMethSpec which lacks a Name\n  entirely. Why? Because the Name can be derived from the method name\n  (in TcIface), so doesn't need to be serialised into the interface\n  file.\n\nBut now we have to get the Name back, because the class declaration's\nfingerprint needs to depend on it (this was the bug in #15970).  This\nis done in a slightly convoluted way:\n\n* Then, in addFingerprints we build a map that maps OccNames to Names\n\n* We pass that map to declExtras which laboriously looks up in the map\n  (using the derived occurrence name) to recover the Name we have just\n  thrown away.\n-}\n\nlookupOccEnvL :: OccEnv [v] -> OccName -> [v]\nlookupOccEnvL env k = lookupOccEnv env k `orElse` []\n\n{-\n-- for testing: use the md5sum command to generate fingerprints and\n-- compare the results against our built-in version.\n  fp' <- oldMD5 dflags bh\n  if fp /= fp' then pprPanic \"computeFingerprint\" (ppr fp <+> ppr fp')\n               else return fp\n\noldMD5 dflags bh = do\n  tmp <- newTempName dflags CurrentModule \"bin\"\n  writeBinMem bh tmp\n  tmp2 <- newTempName dflags CurrentModule \"md5\"\n  let cmd = \"md5sum \" ++ tmp ++ \" >\" ++ tmp2\n  r <- system cmd\n  case r of\n    ExitFailure _ -> throwGhcExceptionIO (PhaseFailed cmd r)\n    ExitSuccess -> do\n        hash_str <- readFile tmp2\n        return $! readHexFingerprint hash_str\n-}\n\n----------------------\n-- mkOrphMap partitions instance decls or rules into\n--      (a) an OccEnv for ones that are not orphans,\n--          mapping the local OccName to a list of its decls\n--      (b) a list of orphan decls\nmkOrphMap :: (decl -> IsOrphan) -- Extract orphan status from decl\n          -> [decl]             -- Sorted into canonical order\n          -> (OccEnv [decl],    -- Non-orphan decls associated with their key;\n                                --      each sublist in canonical order\n              [decl])           -- Orphan decls; in canonical order\nmkOrphMap get_key decls\n  = foldl' go (emptyOccEnv, []) decls\n  where\n    go (non_orphs, orphs) d\n        | NotOrphan occ <- get_key d\n        = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)\n        | otherwise = (non_orphs, d:orphs)\n\n{-\n************************************************************************\n*                                                                      *\n       COMPLETE Pragmas\n*                                                                      *\n************************************************************************\n-}\n\nmkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch\nmkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc\n\n\n{-\n************************************************************************\n*                                                                      *\n       Keeping track of what we've slurped, and fingerprints\n*                                                                      *\n************************************************************************\n-}\n\n\nmkIfaceAnnotation :: Annotation -> IfaceAnnotation\nmkIfaceAnnotation (Annotation { ann_target = target, ann_value = payload })\n  = IfaceAnnotation {\n        ifAnnotatedTarget = fmap nameOccName target,\n        ifAnnotatedValue = payload\n    }\n\nmkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical\nmkIfaceExports exports\n  = sortBy stableAvailCmp (map sort_subs exports)\n  where\n    sort_subs :: AvailInfo -> AvailInfo\n    sort_subs (Avail n) = Avail n\n    sort_subs (AvailTC n [] fs) = AvailTC n [] (sort_flds fs)\n    sort_subs (AvailTC n (m:ms) fs)\n       | n==m      = AvailTC n (m:sortBy stableNameCmp ms) (sort_flds fs)\n       | otherwise = AvailTC n (sortBy stableNameCmp (m:ms)) (sort_flds fs)\n       -- Maintain the AvailTC Invariant\n\n    sort_flds = sortBy (stableNameCmp `on` flSelector)\n\n{-\nNote [Original module]\n~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n        module X where { data family T }\n        module Y( T(..) ) where { import X; data instance T Int = MkT Int }\nThe exported Avail from Y will look like\n        X.T{X.T, Y.MkT}\nThat is, in Y,\n  - only MkT is brought into scope by the data instance;\n  - but the parent (used for grouping and naming in T(..) exports) is X.T\n  - and in this case we export X.T too\n\nIn the result of MkIfaceExports, the names are grouped by defining module,\nso we may need to split up a single Avail into multiple ones.\n\nNote [Internal used_names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nMost of the used_names are External Names, but we can have Internal\nNames too: see Note [Binders in Template Haskell] in Convert, and\nTrac #5362 for an example.  Such Names are always\n  - Such Names are always for locally-defined things, for which we\n    don't gather usage info, so we can just ignore them in ent_map\n  - They are always System Names, hence the assert, just as a double check.\n\n\n************************************************************************\n*                                                                      *\n        Load the old interface file for this module (unless\n        we have it already), and check whether it is up to date\n*                                                                      *\n************************************************************************\n-}\n\ndata RecompileRequired\n  = UpToDate\n       -- ^ everything is up to date, recompilation is not required\n  | MustCompile\n       -- ^ The .hs file has been touched, or the .o/.hi file does not exist\n  | RecompBecause String\n       -- ^ The .o/.hi files are up to date, but something else has changed\n       -- to force recompilation; the String says what (one-line summary)\n   deriving Eq\n\ninstance Semigroup RecompileRequired where\n  UpToDate <> r = r\n  mc <> _       = mc\n\ninstance Monoid RecompileRequired where\n  mempty = UpToDate\n\nrecompileRequired :: RecompileRequired -> Bool\nrecompileRequired UpToDate = False\nrecompileRequired _ = True\n\n\n\n-- | Top level function to check if the version of an old interface file\n-- is equivalent to the current source file the user asked us to compile.\n-- If the same, we can avoid recompilation. We return a tuple where the\n-- first element is a bool saying if we should recompile the object file\n-- and the second is maybe the interface file, where Nothng means to\n-- rebuild the interface file not use the exisitng one.\ncheckOldIface\n  :: HscEnv\n  -> ModSummary\n  -> SourceModified\n  -> Maybe ModIface         -- Old interface from compilation manager, if any\n  -> IO (RecompileRequired, Maybe ModIface)\n\ncheckOldIface hsc_env mod_summary source_modified maybe_iface\n  = do  let dflags = hsc_dflags hsc_env\n        showPass dflags $\n            \"Checking old interface for \" ++\n              (showPpr dflags $ ms_mod mod_summary) ++\n              \" (use -ddump-hi-diffs for more details)\"\n        initIfaceCheck (text \"checkOldIface\") hsc_env $\n            check_old_iface hsc_env mod_summary source_modified maybe_iface\n\ncheck_old_iface\n  :: HscEnv\n  -> ModSummary\n  -> SourceModified\n  -> Maybe ModIface\n  -> IfG (RecompileRequired, Maybe ModIface)\n\ncheck_old_iface hsc_env mod_summary src_modified maybe_iface\n  = let dflags = hsc_dflags hsc_env\n        getIface =\n            case maybe_iface of\n                Just _  -> do\n                    traceIf (text \"We already have the old interface for\" <+>\n                      ppr (ms_mod mod_summary))\n                    return maybe_iface\n                Nothing -> loadIface\n\n        loadIface = do\n             let iface_path = msHiFilePath mod_summary\n             read_result <- readIface (ms_mod mod_summary) iface_path\n             case read_result of\n                 Failed err -> do\n                     traceIf (text \"FYI: cannot read old interface file:\" $$ nest 4 err)\n                     traceHiDiffs (text \"Old interface file was invalid:\" $$ nest 4 err)\n                     return Nothing\n                 Succeeded iface -> do\n                     traceIf (text \"Read the interface file\" <+> text iface_path)\n                     return $ Just iface\n\n        src_changed\n            | gopt Opt_ForceRecomp (hsc_dflags hsc_env) = True\n            | SourceModified <- src_modified = True\n            | otherwise = False\n    in do\n        when src_changed $\n            traceHiDiffs (nest 4 $ text \"Source file changed or recompilation check turned off\")\n\n        case src_changed of\n            -- If the source has changed and we're in interactive mode,\n            -- avoid reading an interface; just return the one we might\n            -- have been supplied with.\n            True | not (isObjectTarget $ hscTarget dflags) ->\n                return (MustCompile, maybe_iface)\n\n            -- Try and read the old interface for the current module\n            -- from the .hi file left from the last time we compiled it\n            True -> do\n                maybe_iface' <- getIface\n                return (MustCompile, maybe_iface')\n\n            False -> do\n                maybe_iface' <- getIface\n                case maybe_iface' of\n                    -- We can't retrieve the iface\n                    Nothing    -> return (MustCompile, Nothing)\n\n                    -- We have got the old iface; check its versions\n                    -- even in the SourceUnmodifiedAndStable case we\n                    -- should check versions because some packages\n                    -- might have changed or gone away.\n                    Just iface -> checkVersions hsc_env mod_summary iface\n\n-- | Check if a module is still the same 'version'.\n--\n-- This function is called in the recompilation checker after we have\n-- determined that the module M being checked hasn't had any changes\n-- to its source file since we last compiled M. So at this point in general\n-- two things may have changed that mean we should recompile M:\n--   * The interface export by a dependency of M has changed.\n--   * The compiler flags specified this time for M have changed\n--     in a manner that is significant for recompilation.\n-- We return not just if we should recompile the object file but also\n-- if we should rebuild the interface file.\ncheckVersions :: HscEnv\n              -> ModSummary\n              -> ModIface       -- Old interface\n              -> IfG (RecompileRequired, Maybe ModIface)\ncheckVersions hsc_env mod_summary iface\n  = do { traceHiDiffs (text \"Considering whether compilation is required for\" <+>\n                        ppr (mi_module iface) <> colon)\n\n       -- readIface will have verified that the InstalledUnitId matches,\n       -- but we ALSO must make sure the instantiation matches up.  See\n       -- test case bkpcabal04!\n       ; if moduleUnitId (mi_module iface) /= thisPackage (hsc_dflags hsc_env)\n            then return (RecompBecause \"-this-unit-id changed\", Nothing) else do {\n       ; recomp <- checkFlagHash hsc_env iface\n       ; if recompileRequired recomp then return (recomp, Nothing) else do {\n       ; recomp <- checkOptimHash hsc_env iface\n       ; if recompileRequired recomp then return (recomp, Nothing) else do {\n       ; recomp <- checkHpcHash hsc_env iface\n       ; if recompileRequired recomp then return (recomp, Nothing) else do {\n       ; recomp <- checkMergedSignatures mod_summary iface\n       ; if recompileRequired recomp then return (recomp, Nothing) else do {\n       ; recomp <- checkHsig mod_summary iface\n       ; if recompileRequired recomp then return (recomp, Nothing) else do {\n       ; recomp <- checkHie mod_summary\n       ; if recompileRequired recomp then return (recomp, Nothing) else do {\n       ; recomp <- checkDependencies hsc_env mod_summary iface\n       ; if recompileRequired recomp then return (recomp, Just iface) else do {\n       ; recomp <- checkPlugins hsc_env iface\n       ; if recompileRequired recomp then return (recomp, Nothing) else do {\n\n\n       -- Source code unchanged and no errors yet... carry on\n       --\n       -- First put the dependent-module info, read from the old\n       -- interface, into the envt, so that when we look for\n       -- interfaces we look for the right one (.hi or .hi-boot)\n       --\n       -- It's just temporary because either the usage check will succeed\n       -- (in which case we are done with this module) or it'll fail (in which\n       -- case we'll compile the module from scratch anyhow).\n       --\n       -- We do this regardless of compilation mode, although in --make mode\n       -- all the dependent modules should be in the HPT already, so it's\n       -- quite redundant\n       ; updateEps_ $ \\eps  -> eps { eps_is_boot = mod_deps }\n       ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]\n       ; return (recomp, Just iface)\n    }}}}}}}}}}\n  where\n    this_pkg = thisPackage (hsc_dflags hsc_env)\n    -- This is a bit of a hack really\n    mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)\n    mod_deps = mkModDeps (dep_mods (mi_deps iface))\n\n-- | Check if any plugins are requesting recompilation\ncheckPlugins :: HscEnv -> ModIface -> IfG RecompileRequired\ncheckPlugins hsc iface = liftIO $ do\n  new_fingerprint <- fingerprintPlugins hsc\n  let old_fingerprint = mi_plugin_hash iface\n  pr <- mconcat <$> mapM pluginRecompile' (plugins (hsc_dflags hsc))\n  return $\n    pluginRecompileToRecompileRequired old_fingerprint new_fingerprint pr\n\nfingerprintPlugins :: HscEnv -> IO Fingerprint\nfingerprintPlugins hsc_env = do\n  fingerprintPlugins' $ plugins (hsc_dflags hsc_env)\n\nfingerprintPlugins' :: [PluginWithArgs] -> IO Fingerprint\nfingerprintPlugins' plugins = do\n  res <- mconcat <$> mapM pluginRecompile' plugins\n  return $ case res of\n      NoForceRecompile ->  fingerprintString \"NoForceRecompile\"\n      ForceRecompile   -> fingerprintString \"ForceRecompile\"\n      -- is the chance of collision worth worrying about?\n      -- An alternative is to fingerprintFingerprints [fingerprintString\n      -- \"maybeRecompile\", fp]\n      (MaybeRecompile fp) -> fp\n\n\npluginRecompileToRecompileRequired\n    :: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired\npluginRecompileToRecompileRequired old_fp new_fp pr\n  | old_fp == new_fp =\n    case pr of\n      NoForceRecompile  -> UpToDate\n\n      -- we already checked the fingerprint above so a mismatch is not possible\n      -- here, remember that: `fingerprint (MaybeRecomp x) == x`.\n      MaybeRecompile _  -> UpToDate\n\n      -- when we have an impure plugin in the stack we have to unconditionally\n      -- recompile since it might integrate all sorts of crazy IO results into\n      -- its compilation output.\n      ForceRecompile    -> RecompBecause \"Impure plugin forced recompilation\"\n\n  | old_fp `elem` magic_fingerprints ||\n    new_fp `elem` magic_fingerprints\n    -- The fingerprints do not match either the old or new one is a magic\n    -- fingerprint. This happens when non-pure plugins are added for the first\n    -- time or when we go from one recompilation strategy to another: (force ->\n    -- no-force, maybe-recomp -> no-force, no-force -> maybe-recomp etc.)\n    --\n    -- For example when we go from from ForceRecomp to NoForceRecomp\n    -- recompilation is triggered since the old impure plugins could have\n    -- changed the build output which is now back to normal.\n    = RecompBecause \"Plugins changed\"\n\n  | otherwise =\n    let reason = \"Plugin fingerprint changed\" in\n    case pr of\n      -- even though a plugin is forcing recompilation the fingerprint changed\n      -- which would cause recompilation anyways so we report the fingerprint\n      -- change instead.\n      ForceRecompile   -> RecompBecause reason\n\n      _                -> RecompBecause reason\n\n where\n   magic_fingerprints =\n       [ fingerprintString \"NoForceRecompile\"\n       , fingerprintString \"ForceRecompile\"\n       ]\n\n\n-- | Check if an hsig file needs recompilation because its\n-- implementing module has changed.\ncheckHsig :: ModSummary -> ModIface -> IfG RecompileRequired\ncheckHsig mod_summary iface = do\n    dflags <- getDynFlags\n    let outer_mod = ms_mod mod_summary\n        inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod)\n    MASSERT( moduleUnitId outer_mod == thisPackage dflags )\n    case inner_mod == mi_semantic_module iface of\n        True -> up_to_date (text \"implementing module unchanged\")\n        False -> return (RecompBecause \"implementing module changed\")\n\n-- | Check if @.hie@ file is out of date or missing.\ncheckHie :: ModSummary -> IfG RecompileRequired\ncheckHie mod_summary = do\n    dflags <- getDynFlags\n    let hie_date_opt = ms_hie_date mod_summary\n        hs_date = ms_hs_date mod_summary\n    pure $ case gopt Opt_WriteHie dflags of\n               False -> UpToDate\n               True -> case hie_date_opt of\n                           Nothing -> RecompBecause \"HIE file is missing\"\n                           Just hie_date\n                               | hie_date < hs_date\n                               -> RecompBecause \"HIE file is out of date\"\n                               | otherwise\n                               -> UpToDate\n\n-- | Check the flags haven't changed\ncheckFlagHash :: HscEnv -> ModIface -> IfG RecompileRequired\ncheckFlagHash hsc_env iface = do\n    let old_hash = mi_flag_hash iface\n    new_hash <- liftIO $ fingerprintDynFlags (hsc_dflags hsc_env)\n                                             (mi_module iface)\n                                             putNameLiterally\n    case old_hash == new_hash of\n        True  -> up_to_date (text \"Module flags unchanged\")\n        False -> out_of_date_hash \"flags changed\"\n                     (text \"  Module flags have changed\")\n                     old_hash new_hash\n\n-- | Check the optimisation flags haven't changed\ncheckOptimHash :: HscEnv -> ModIface -> IfG RecompileRequired\ncheckOptimHash hsc_env iface = do\n    let old_hash = mi_opt_hash iface\n    new_hash <- liftIO $ fingerprintOptFlags (hsc_dflags hsc_env)\n                                               putNameLiterally\n    if | old_hash == new_hash\n         -> up_to_date (text \"Optimisation flags unchanged\")\n       | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env)\n         -> up_to_date (text \"Optimisation flags changed; ignoring\")\n       | otherwise\n         -> out_of_date_hash \"Optimisation flags changed\"\n                     (text \"  Optimisation flags have changed\")\n                     old_hash new_hash\n\n-- | Check the HPC flags haven't changed\ncheckHpcHash :: HscEnv -> ModIface -> IfG RecompileRequired\ncheckHpcHash hsc_env iface = do\n    let old_hash = mi_hpc_hash iface\n    new_hash <- liftIO $ fingerprintHpcFlags (hsc_dflags hsc_env)\n                                               putNameLiterally\n    if | old_hash == new_hash\n         -> up_to_date (text \"HPC flags unchanged\")\n       | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env)\n         -> up_to_date (text \"HPC flags changed; ignoring\")\n       | otherwise\n         -> out_of_date_hash \"HPC flags changed\"\n                     (text \"  HPC flags have changed\")\n                     old_hash new_hash\n\n-- Check that the set of signatures we are merging in match.\n-- If the -unit-id flags change, this can change too.\ncheckMergedSignatures :: ModSummary -> ModIface -> IfG RecompileRequired\ncheckMergedSignatures mod_summary iface = do\n    dflags <- getDynFlags\n    let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ]\n        new_merged = case Map.lookup (ms_mod_name mod_summary)\n                                     (requirementContext (pkgState dflags)) of\n                        Nothing -> []\n                        Just r -> sort $ map (indefModuleToModule dflags) r\n    if old_merged == new_merged\n        then up_to_date (text \"signatures to merge in unchanged\" $$ ppr new_merged)\n        else return (RecompBecause \"signatures to merge in changed\")\n\n-- If the direct imports of this module are resolved to targets that\n-- are not among the dependencies of the previous interface file,\n-- then we definitely need to recompile.  This catches cases like\n--   - an exposed package has been upgraded\n--   - we are compiling with different package flags\n--   - a home module that was shadowing a package module has been removed\n--   - a new home module has been added that shadows a package module\n-- See bug #1372.\n--\n-- Returns (RecompBecause <textual reason>) if recompilation is required.\ncheckDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired\ncheckDependencies hsc_env summary iface\n = checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))\n  where\n   prev_dep_mods = dep_mods (mi_deps iface)\n   prev_dep_plgn = dep_plgins (mi_deps iface)\n   prev_dep_pkgs = dep_pkgs (mi_deps iface)\n\n   this_pkg = thisPackage (hsc_dflags hsc_env)\n\n   dep_missing (mb_pkg, L _ mod) = do\n     find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)\n     let reason = moduleNameString mod ++ \" changed\"\n     case find_res of\n        Found _ mod\n          | pkg == this_pkg\n           -> if moduleName mod `notElem` map fst prev_dep_mods ++ prev_dep_plgn\n                 then do traceHiDiffs $\n                           text \"imported module \" <> quotes (ppr mod) <>\n                           text \" not among previous dependencies\"\n                         return (RecompBecause reason)\n                 else\n                         return UpToDate\n          | otherwise\n           -> if toInstalledUnitId pkg `notElem` (map fst prev_dep_pkgs)\n                 then do traceHiDiffs $\n                           text \"imported module \" <> quotes (ppr mod) <>\n                           text \" is from package \" <> quotes (ppr pkg) <>\n                           text \", which is not among previous dependencies\"\n                         return (RecompBecause reason)\n                 else\n                         return UpToDate\n           where pkg = moduleUnitId mod\n        _otherwise  -> return (RecompBecause reason)\n\nneedInterface :: Module -> (ModIface -> IfG RecompileRequired)\n              -> IfG RecompileRequired\nneedInterface mod continue\n  = do  -- Load the imported interface if possible\n    let doc_str = sep [text \"need version info for\", ppr mod]\n    traceHiDiffs (text \"Checking usages for module\" <+> ppr mod)\n\n    mb_iface <- loadInterface doc_str mod ImportBySystem\n        -- Load the interface, but don't complain on failure;\n        -- Instead, get an Either back which we can test\n\n    case mb_iface of\n      Failed _ -> do\n        traceHiDiffs (sep [text \"Couldn't load interface for module\",\n                           ppr mod])\n        return MustCompile\n                  -- Couldn't find or parse a module mentioned in the\n                  -- old interface file.  Don't complain: it might\n                  -- just be that the current module doesn't need that\n                  -- import and it's been deleted\n      Succeeded iface -> continue iface\n\n-- | Given the usage information extracted from the old\n-- M.hi file for the module being compiled, figure out\n-- whether M needs to be recompiled.\ncheckModUsage :: UnitId -> Usage -> IfG RecompileRequired\ncheckModUsage _this_pkg UsagePackageModule{\n                                usg_mod = mod,\n                                usg_mod_hash = old_mod_hash }\n  = needInterface mod $ \\iface -> do\n    let reason = moduleNameString (moduleName mod) ++ \" changed\"\n    checkModuleFingerprint reason old_mod_hash (mi_mod_hash iface)\n        -- We only track the ABI hash of package modules, rather than\n        -- individual entity usages, so if the ABI hash changes we must\n        -- recompile.  This is safe but may entail more recompilation when\n        -- a dependent package has changed.\n\ncheckModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash }\n  = needInterface mod $ \\iface -> do\n    let reason = moduleNameString (moduleName mod) ++ \" changed (raw)\"\n    checkModuleFingerprint reason old_mod_hash (mi_mod_hash iface)\n\ncheckModUsage this_pkg UsageHomeModule{\n                                usg_mod_name = mod_name,\n                                usg_mod_hash = old_mod_hash,\n                                usg_exports = maybe_old_export_hash,\n                                usg_entities = old_decl_hash }\n  = do\n    let mod = mkModule this_pkg mod_name\n    needInterface mod $ \\iface -> do\n\n    let\n        new_mod_hash    = mi_mod_hash    iface\n        new_decl_hash   = mi_hash_fn     iface\n        new_export_hash = mi_exp_hash    iface\n\n        reason = moduleNameString mod_name ++ \" changed\"\n\n        -- CHECK MODULE\n    recompile <- checkModuleFingerprint reason old_mod_hash new_mod_hash\n    if not (recompileRequired recompile)\n      then return UpToDate\n      else do\n\n        -- CHECK EXPORT LIST\n        checkMaybeHash reason maybe_old_export_hash new_export_hash\n            (text \"  Export list changed\") $ do\n\n        -- CHECK ITEMS ONE BY ONE\n        recompile <- checkList [ checkEntityUsage reason new_decl_hash u\n                               | u <- old_decl_hash]\n        if recompileRequired recompile\n          then return recompile     -- This one failed, so just bail out now\n          else up_to_date (text \"  Great!  The bits I use are up to date\")\n\n\ncheckModUsage _this_pkg UsageFile{ usg_file_path = file,\n                                   usg_file_hash = old_hash } =\n  liftIO $\n    handleIO handle $ do\n      new_hash <- getFileHash file\n      if (old_hash /= new_hash)\n         then return recomp\n         else return UpToDate\n where\n   recomp = RecompBecause (file ++ \" changed\")\n   handle =\n#if defined(DEBUG)\n       \\e -> pprTrace \"UsageFile\" (text (show e)) $ return recomp\n#else\n       \\_ -> return recomp -- if we can't find the file, just recompile, don't fail\n#endif\n\n------------------------\ncheckModuleFingerprint :: String -> Fingerprint -> Fingerprint\n                       -> IfG RecompileRequired\ncheckModuleFingerprint reason old_mod_hash new_mod_hash\n  | new_mod_hash == old_mod_hash\n  = up_to_date (text \"Module fingerprint unchanged\")\n\n  | otherwise\n  = out_of_date_hash reason (text \"  Module fingerprint has changed\")\n                     old_mod_hash new_mod_hash\n\n------------------------\ncheckMaybeHash :: String -> Maybe Fingerprint -> Fingerprint -> SDoc\n               -> IfG RecompileRequired -> IfG RecompileRequired\ncheckMaybeHash reason maybe_old_hash new_hash doc continue\n  | Just hash <- maybe_old_hash, hash /= new_hash\n  = out_of_date_hash reason doc hash new_hash\n  | otherwise\n  = continue\n\n------------------------\ncheckEntityUsage :: String\n                 -> (OccName -> Maybe (OccName, Fingerprint))\n                 -> (OccName, Fingerprint)\n                 -> IfG RecompileRequired\ncheckEntityUsage reason new_hash (name,old_hash)\n  = case new_hash name of\n\n        Nothing       ->        -- We used it before, but it ain't there now\n                          out_of_date reason (sep [text \"No longer exported:\", ppr name])\n\n        Just (_, new_hash)      -- It's there, but is it up to date?\n          | new_hash == old_hash -> do traceHiDiffs (text \"  Up to date\" <+> ppr name <+> parens (ppr new_hash))\n                                       return UpToDate\n          | otherwise            -> out_of_date_hash reason (text \"  Out of date:\" <+> ppr name)\n                                                     old_hash new_hash\n\nup_to_date :: SDoc -> IfG RecompileRequired\nup_to_date  msg = traceHiDiffs msg >> return UpToDate\n\nout_of_date :: String -> SDoc -> IfG RecompileRequired\nout_of_date reason msg = traceHiDiffs msg >> return (RecompBecause reason)\n\nout_of_date_hash :: String -> SDoc -> Fingerprint -> Fingerprint -> IfG RecompileRequired\nout_of_date_hash reason msg old_hash new_hash\n  = out_of_date reason (hsep [msg, ppr old_hash, text \"->\", ppr new_hash])\n\n----------------------\ncheckList :: [IfG RecompileRequired] -> IfG RecompileRequired\n-- This helper is used in two places\ncheckList []             = return UpToDate\ncheckList (check:checks) = do recompile <- check\n                              if recompileRequired recompile\n                                then return recompile\n                                else checkList checks\n\n{-\n************************************************************************\n*                                                                      *\n                Converting things to their Iface equivalents\n*                                                                      *\n************************************************************************\n-}\n\ntyThingToIfaceDecl :: TyThing -> IfaceDecl\ntyThingToIfaceDecl (AnId id)      = idToIfaceDecl id\ntyThingToIfaceDecl (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)\ntyThingToIfaceDecl (ACoAxiom ax)  = coAxiomToIfaceDecl ax\ntyThingToIfaceDecl (AConLike cl)  = case cl of\n    RealDataCon dc -> dataConToIfaceDecl dc -- for ppr purposes only\n    PatSynCon ps   -> patSynToIfaceDecl ps\n\n--------------------------\nidToIfaceDecl :: Id -> IfaceDecl\n-- The Id is already tidied, so that locally-bound names\n-- (lambdas, for-alls) already have non-clashing OccNames\n-- We can't tidy it here, locally, because it may have\n-- free variables in its type or IdInfo\nidToIfaceDecl id\n  = IfaceId { ifName      = getName id,\n              ifType      = toIfaceType (idType id),\n              ifIdDetails = toIfaceIdDetails (idDetails id),\n              ifIdInfo    = toIfaceIdInfo (idInfo id) }\n\n--------------------------\ndataConToIfaceDecl :: DataCon -> IfaceDecl\ndataConToIfaceDecl dataCon\n  = IfaceId { ifName      = getName dataCon,\n              ifType      = toIfaceType (dataConUserType dataCon),\n              ifIdDetails = IfVanillaId,\n              ifIdInfo    = NoInfo }\n\n--------------------------\ncoAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl\n-- We *do* tidy Axioms, because they are not (and cannot\n-- conveniently be) built in tidy form\ncoAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches\n                               , co_ax_role = role })\n = IfaceAxiom { ifName       = getName ax\n              , ifTyCon      = toIfaceTyCon tycon\n              , ifRole       = role\n              , ifAxBranches = map (coAxBranchToIfaceBranch tycon\n                                     (map coAxBranchLHS branch_list))\n                                   branch_list }\n where\n   branch_list = fromBranches branches\n\n-- 2nd parameter is the list of branch LHSs, for conversion from incompatible branches\n-- to incompatible indices\n-- See Note [Storing compatibility] in CoAxiom\ncoAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch\ncoAxBranchToIfaceBranch tc lhs_s\n                        branch@(CoAxBranch { cab_incomps = incomps })\n  = (coAxBranchToIfaceBranch' tc branch) { ifaxbIncomps = iface_incomps }\n  where\n    iface_incomps = map (expectJust \"iface_incomps\"\n                        . (flip findIndex lhs_s\n                          . eqTypes)\n                        . coAxBranchLHS) incomps\n\n-- use this one for standalone branches without incompatibles\ncoAxBranchToIfaceBranch' :: TyCon -> CoAxBranch -> IfaceAxBranch\ncoAxBranchToIfaceBranch' tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs\n                                        , cab_eta_tvs = eta_tvs\n                                        , cab_lhs = lhs\n                                        , cab_roles = roles, cab_rhs = rhs })\n  = IfaceAxBranch { ifaxbTyVars    = toIfaceTvBndrs tvs\n                  , ifaxbCoVars    = map toIfaceIdBndr cvs\n                  , ifaxbEtaTyVars = toIfaceTvBndrs eta_tvs\n                  , ifaxbLHS       = toIfaceTcArgs tc lhs\n                  , ifaxbRoles     = roles\n                  , ifaxbRHS       = toIfaceType rhs\n                  , ifaxbIncomps   = [] }\n\n-----------------\ntyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)\n-- We *do* tidy TyCons, because they are not (and cannot\n-- conveniently be) built in tidy form\n-- The returned TidyEnv is the one after tidying the tyConTyVars\ntyConToIfaceDecl env tycon\n  | Just clas <- tyConClass_maybe tycon\n  = classToIfaceDecl env clas\n\n  | Just syn_rhs <- synTyConRhs_maybe tycon\n  = ( tc_env1\n    , IfaceSynonym { ifName    = getName tycon,\n                     ifRoles   = tyConRoles tycon,\n                     ifSynRhs  = if_syn_type syn_rhs,\n                     ifBinders = if_binders,\n                     ifResKind = if_res_kind\n                   })\n\n  | Just fam_flav <- famTyConFlav_maybe tycon\n  = ( tc_env1\n    , IfaceFamily { ifName    = getName tycon,\n                    ifResVar  = if_res_var,\n                    ifFamFlav = to_if_fam_flav fam_flav,\n                    ifBinders = if_binders,\n                    ifResKind = if_res_kind,\n                    ifFamInj  = tyConInjectivityInfo tycon\n                  })\n\n  | isAlgTyCon tycon\n  = ( tc_env1\n    , IfaceData { ifName    = getName tycon,\n                  ifBinders = if_binders,\n                  ifResKind = if_res_kind,\n                  ifCType   = tyConCType tycon,\n                  ifRoles   = tyConRoles tycon,\n                  ifCtxt    = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),\n                  ifCons    = ifaceConDecls (algTyConRhs tycon),\n                  ifGadtSyntax = isGadtSyntaxTyCon tycon,\n                  ifParent  = parent })\n\n  | otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon\n  -- We only convert these TyCons to IfaceTyCons when we are\n  -- just about to pretty-print them, not because we are going\n  -- to put them into interface files\n  = ( env\n    , IfaceData { ifName       = getName tycon,\n                  ifBinders    = if_binders,\n                  ifResKind    = if_res_kind,\n                  ifCType      = Nothing,\n                  ifRoles      = tyConRoles tycon,\n                  ifCtxt       = [],\n                  ifCons       = IfDataTyCon [],\n                  ifGadtSyntax = False,\n                  ifParent     = IfNoParent })\n  where\n    -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`\n    -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause\n    -- an error.\n    (tc_env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)\n    tc_tyvars      = binderVars tc_binders\n    if_binders     = toIfaceTyCoVarBinders tc_binders\n                     -- No tidying of the binders; they are already tidy\n    if_res_kind    = tidyToIfaceType tc_env1 (tyConResKind tycon)\n    if_syn_type ty = tidyToIfaceType tc_env1 ty\n    if_res_var     = getOccFS `fmap` tyConFamilyResVar_maybe tycon\n\n    parent = case tyConFamInstSig_maybe tycon of\n               Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)\n                                                   (toIfaceTyCon tc)\n                                                   (tidyToIfaceTcArgs tc_env1 tc ty)\n               Nothing           -> IfNoParent\n\n    to_if_fam_flav OpenSynFamilyTyCon             = IfaceOpenSynFamilyTyCon\n    to_if_fam_flav AbstractClosedSynFamilyTyCon   = IfaceAbstractClosedSynFamilyTyCon\n    to_if_fam_flav (DataFamilyTyCon {})           = IfaceDataFamilyTyCon\n    to_if_fam_flav (BuiltInSynFamTyCon {})        = IfaceBuiltInSynFamTyCon\n    to_if_fam_flav (ClosedSynFamilyTyCon Nothing) = IfaceClosedSynFamilyTyCon Nothing\n    to_if_fam_flav (ClosedSynFamilyTyCon (Just ax))\n      = IfaceClosedSynFamilyTyCon (Just (axn, ibr))\n      where defs = fromBranches $ coAxiomBranches ax\n            ibr  = map (coAxBranchToIfaceBranch' tycon) defs\n            axn  = coAxiomName ax\n\n    ifaceConDecls (NewTyCon { data_con = con })    = IfNewTyCon  (ifaceConDecl con)\n    ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)\n    ifaceConDecls (TupleTyCon { data_con = con })  = IfDataTyCon [ifaceConDecl con]\n    ifaceConDecls (SumTyCon { data_cons = cons })  = IfDataTyCon (map ifaceConDecl cons)\n    ifaceConDecls AbstractTyCon                    = IfAbstractTyCon\n        -- The AbstractTyCon case happens when a TyCon has been trimmed\n        -- during tidying.\n        -- Furthermore, tyThingToIfaceDecl is also used in TcRnDriver\n        -- for GHCi, when browsing a module, in which case the\n        -- AbstractTyCon and TupleTyCon cases are perfectly sensible.\n        -- (Tuple declarations are not serialised into interface files.)\n\n    ifaceConDecl data_con\n        = IfCon   { ifConName    = dataConName data_con,\n                    ifConInfix   = dataConIsInfix data_con,\n                    ifConWrapper = isJust (dataConWrapId_maybe data_con),\n                    ifConExTCvs  = map toIfaceBndr ex_tvs',\n                    ifConUserTvBinders = map toIfaceForAllBndr user_bndrs',\n                    ifConEqSpec  = map (to_eq_spec . eqSpecPair) eq_spec,\n                    ifConCtxt    = tidyToIfaceContext con_env2 theta,\n                    ifConArgTys  = map (tidyToIfaceType con_env2) arg_tys,\n                    ifConFields  = dataConFieldLabels data_con,\n                    ifConStricts = map (toIfaceBang con_env2)\n                                       (dataConImplBangs data_con),\n                    ifConSrcStricts = map toIfaceSrcBang\n                                          (dataConSrcBangs data_con)}\n        where\n          (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _)\n            = dataConFullSig data_con\n          user_bndrs = dataConUserTyVarBinders data_con\n\n          -- Tidy the univ_tvs of the data constructor to be identical\n          -- to the tyConTyVars of the type constructor.  This means\n          -- (a) we don't need to redundantly put them into the interface file\n          -- (b) when pretty-printing an Iface data declaration in H98-style syntax,\n          --     we know that the type variables will line up\n          -- The latter (b) is important because we pretty-print type constructors\n          -- by converting to IfaceSyn and pretty-printing that\n          con_env1 = (fst tc_env1, mkVarEnv (zipEqual \"ifaceConDecl\" univ_tvs tc_tyvars))\n                     -- A bit grimy, perhaps, but it's simple!\n\n          (con_env2, ex_tvs') = tidyVarBndrs con_env1 ex_tvs\n          user_bndrs' = map (tidyUserTyCoVarBinder con_env2) user_bndrs\n          to_eq_spec (tv,ty) = (tidyTyVar con_env2 tv, tidyToIfaceType con_env2 ty)\n\n          -- By this point, we have tidied every universal and existential\n          -- tyvar. Because of the dcUserTyCoVarBinders invariant\n          -- (see Note [DataCon user type variable binders]), *every*\n          -- user-written tyvar must be contained in the substitution that\n          -- tidying produced. Therefore, tidying the user-written tyvars is a\n          -- simple matter of looking up each variable in the substitution,\n          -- which tidyTyCoVarOcc accomplishes.\n          tidyUserTyCoVarBinder :: TidyEnv -> TyCoVarBinder -> TyCoVarBinder\n          tidyUserTyCoVarBinder env (Bndr tv vis) =\n            Bndr (tidyTyCoVarOcc env tv) vis\n\nclassToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)\nclassToIfaceDecl env clas\n  = ( env1\n    , IfaceClass { ifName   = getName tycon,\n                   ifRoles  = tyConRoles (classTyCon clas),\n                   ifBinders = toIfaceTyCoVarBinders tc_binders,\n                   ifBody   = body,\n                   ifFDs    = map toIfaceFD clas_fds })\n  where\n    (_, clas_fds, sc_theta, _, clas_ats, op_stuff)\n      = classExtraBigSig clas\n    tycon = classTyCon clas\n\n    body | isAbstractTyCon tycon = IfAbstractClass\n         | otherwise\n         = IfConcreteClass {\n                ifClassCtxt   = tidyToIfaceContext env1 sc_theta,\n                ifATs    = map toIfaceAT clas_ats,\n                ifSigs   = map toIfaceClassOp op_stuff,\n                ifMinDef = fmap getOccFS (classMinimalDef clas)\n            }\n\n    (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)\n\n    toIfaceAT :: ClassATItem -> IfaceAT\n    toIfaceAT (ATI tc def)\n      = IfaceAT if_decl (fmap (tidyToIfaceType env2 . fst) def)\n      where\n        (env2, if_decl) = tyConToIfaceDecl env1 tc\n\n    toIfaceClassOp (sel_id, def_meth)\n        = ASSERT( sel_tyvars == binderVars tc_binders )\n          IfaceClassOp (getName sel_id)\n                       (tidyToIfaceType env1 op_ty)\n                       (fmap toDmSpec def_meth)\n        where\n                -- Be careful when splitting the type, because of things\n                -- like         class Foo a where\n                --                op :: (?x :: String) => a -> a\n                -- and          class Baz a where\n                --                op :: (Ord a) => a -> a\n          (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)\n          op_ty                = funResultTy rho_ty\n\n    toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType\n    toDmSpec (_, VanillaDM)       = VanillaDM\n    toDmSpec (_, GenericDM dm_ty) = GenericDM (tidyToIfaceType env1 dm_ty)\n\n    toIfaceFD (tvs1, tvs2) = (map (tidyTyVar env1) tvs1\n                             ,map (tidyTyVar env1) tvs2)\n\n--------------------------\n\ntidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)\n-- If the type variable \"binder\" is in scope, don't re-bind it\n-- In a class decl, for example, the ATD binders mention\n-- (amd must mention) the class tyvars\ntidyTyConBinder env@(_, subst) tvb@(Bndr tv vis)\n = case lookupVarEnv subst tv of\n     Just tv' -> (env,  Bndr tv' vis)\n     Nothing  -> tidyTyCoVarBinder env tvb\n\ntidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])\ntidyTyConBinders = mapAccumL tidyTyConBinder\n\ntidyTyVar :: TidyEnv -> TyVar -> FastString\ntidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)\n\n--------------------------\ninstanceToIfaceInst :: ClsInst -> IfaceClsInst\ninstanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag\n                             , is_cls_nm = cls_name, is_cls = cls\n                             , is_tcs = mb_tcs\n                             , is_orphan = orph })\n  = ASSERT( cls_name == className cls )\n    IfaceClsInst { ifDFun    = dfun_name,\n                ifOFlag   = oflag,\n                ifInstCls = cls_name,\n                ifInstTys = map do_rough mb_tcs,\n                ifInstOrph = orph }\n  where\n    do_rough Nothing  = Nothing\n    do_rough (Just n) = Just (toIfaceTyCon_name n)\n\n    dfun_name = idName dfun_id\n\n\n--------------------------\nfamInstToIfaceFamInst :: FamInst -> IfaceFamInst\nfamInstToIfaceFamInst (FamInst { fi_axiom    = axiom,\n                                 fi_fam      = fam,\n                                 fi_tcs      = roughs })\n  = IfaceFamInst { ifFamInstAxiom    = coAxiomName axiom\n                 , ifFamInstFam      = fam\n                 , ifFamInstTys      = map do_rough roughs\n                 , ifFamInstOrph     = orph }\n  where\n    do_rough Nothing  = Nothing\n    do_rough (Just n) = Just (toIfaceTyCon_name n)\n\n    fam_decl = tyConName $ coAxiomTyCon axiom\n    mod = ASSERT( isExternalName (coAxiomName axiom) )\n          nameModule (coAxiomName axiom)\n    is_local name = nameIsLocalOrFrom mod name\n\n    lhs_names = filterNameSet is_local (orphNamesOfCoCon axiom)\n\n    orph | is_local fam_decl\n         = NotOrphan (nameOccName fam_decl)\n         | otherwise\n         = chooseOrphanAnchor lhs_names\n\n--------------------------\ncoreRuleToIfaceRule :: CoreRule -> IfaceRule\ncoreRuleToIfaceRule (BuiltinRule { ru_fn = fn})\n  = pprTrace \"toHsRule: builtin\" (ppr fn) $\n    bogusIfaceRule fn\n\ncoreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,\n                            ru_act = act, ru_bndrs = bndrs,\n                            ru_args = args, ru_rhs = rhs,\n                            ru_orphan = orph, ru_auto = auto })\n  = IfaceRule { ifRuleName  = name, ifActivation = act,\n                ifRuleBndrs = map toIfaceBndr bndrs,\n                ifRuleHead  = fn,\n                ifRuleArgs  = map do_arg args,\n                ifRuleRhs   = toIfaceExpr rhs,\n                ifRuleAuto  = auto,\n                ifRuleOrph  = orph }\n  where\n        -- For type args we must remove synonyms from the outermost\n        -- level.  Reason: so that when we read it back in we'll\n        -- construct the same ru_rough field as we have right now;\n        -- see tcIfaceRule\n    do_arg (Type ty)     = IfaceType (toIfaceType (deNoteType ty))\n    do_arg (Coercion co) = IfaceCo   (toIfaceCoercion co)\n    do_arg arg           = toIfaceExpr arg\n\nbogusIfaceRule :: Name -> IfaceRule\nbogusIfaceRule id_name\n  = IfaceRule { ifRuleName = fsLit \"bogus\", ifActivation = NeverActive,\n        ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],\n        ifRuleRhs = IfaceExt id_name, ifRuleOrph = IsOrphan,\n        ifRuleAuto = True }\n", "num_lines": 2035}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nType checking of type signatures in interface files\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE NondecreasingIndentation #-}\n\nmodule TcIface (\n        tcLookupImported_maybe,\n        importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,\n        typecheckIfacesForMerging,\n        typecheckIfaceForInstantiate,\n        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,\n        tcIfaceAnnotations, tcIfaceCompleteSigs,\n        tcIfaceExpr,    -- Desired by HERMIT (Trac #7683)\n        tcIfaceGlobal\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcTypeNats(typeNatCoAxiomRules)\nimport IfaceSyn\nimport LoadIface\nimport IfaceEnv\nimport BuildTyCl\nimport TcRnMonad\nimport TcType\nimport Type\nimport Coercion\nimport CoAxiom\nimport TyCoRep    -- needs to build types & coercions in a knot\nimport HscTypes\nimport Annotations\nimport InstEnv\nimport FamInstEnv\nimport CoreSyn\nimport CoreUtils\nimport CoreUnfold\nimport CoreLint\nimport MkCore\nimport Id\nimport MkId\nimport IdInfo\nimport Class\nimport TyCon\nimport ConLike\nimport DataCon\nimport PrelNames\nimport TysWiredIn\nimport Literal\nimport Var\nimport VarSet\nimport Name\nimport NameEnv\nimport NameSet\nimport OccurAnal        ( occurAnalyseExpr )\nimport Demand\nimport Module\nimport UniqFM\nimport UniqSupply\nimport Outputable\nimport Maybes\nimport SrcLoc\nimport DynFlags\nimport Util\nimport FastString\nimport BasicTypes hiding ( SuccessFlag(..) )\nimport ListSetOps\nimport GHC.Fingerprint\nimport qualified BooleanFormula as BF\n\nimport Control.Monad\nimport qualified Data.Map as Map\n\n{-\nThis module takes\n\n        IfaceDecl -> TyThing\n        IfaceType -> Type\n        etc\n\nAn IfaceDecl is populated with RdrNames, and these are not renamed to\nNames before typechecking, because there should be no scope errors etc.\n\n        -- For (b) consider: f = \\$(...h....)\n        -- where h is imported, and calls f via an hi-boot file.\n        -- This is bad!  But it is not seen as a staging error, because h\n        -- is indeed imported.  We don't want the type-checker to black-hole\n        -- when simplifying and compiling the splice!\n        --\n        -- Simple solution: discard any unfolding that mentions a variable\n        -- bound in this module (and hence not yet processed).\n        -- The discarding happens when forkM finds a type error.\n\n\n************************************************************************\n*                                                                      *\n                Type-checking a complete interface\n*                                                                      *\n************************************************************************\n\nSuppose we discover we don't need to recompile.  Then we must type\ncheck the old interface file.  This is a bit different to the\nincremental type checking we do as we suck in interface files.  Instead\nwe do things similarly as when we are typechecking source decls: we\nbring into scope the type envt for the interface all at once, using a\nknot.  Remember, the decls aren't necessarily in dependency order --\nand even if they were, the type decls might be mutually recursive.\n\nNote [Knot-tying typecheckIface]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we are typechecking an interface A.hi, and we come across\na Name for another entity defined in A.hi.  How do we get the\n'TyCon', in this case?  There are three cases:\n\n    1) tcHiBootIface in TcIface: We're typechecking an hi-boot file in\n    preparation of checking if the hs file we're building\n    is compatible.  In this case, we want all of the internal\n    TyCons to MATCH the ones that we just constructed during\n    typechecking: the knot is thus tied through if_rec_types.\n\n    2) retypecheckLoop in GhcMake: We are retypechecking a\n    mutually recursive cluster of hi files, in order to ensure\n    that all of the references refer to each other correctly.\n    In this case, the knot is tied through the HPT passed in,\n    which contains all of the interfaces we are in the process\n    of typechecking.\n\n    3) genModDetails in HscMain: We are typechecking an\n    old interface to generate the ModDetails.  In this case,\n    we do the same thing as (2) and pass in an HPT with\n    the HomeModInfo being generated to tie knots.\n\nThe upshot is that the CLIENT of this function is responsible\nfor making sure that the knot is tied correctly.  If you don't,\nthen you'll get a message saying that we couldn't load the\ndeclaration you wanted.\n\nBTW, in one-shot mode we never call typecheckIface; instead,\nloadInterface handles type-checking interface.  In that case,\nknots are tied through the EPS.  No problem!\n-}\n\n-- Clients of this function be careful, see Note [Knot-tying typecheckIface]\ntypecheckIface :: ModIface      -- Get the decls from here\n               -> IfG ModDetails\ntypecheckIface iface\n  = initIfaceLcl (mi_semantic_module iface) (text \"typecheckIface\") (mi_boot iface) $ do\n        {       -- Get the right set of decls and rules.  If we are compiling without -O\n                -- we discard pragmas before typechecking, so that we don't \"see\"\n                -- information that we shouldn't.  From a versioning point of view\n                -- It's not actually *wrong* to do so, but in fact GHCi is unable\n                -- to handle unboxed tuples, so it must not see unfoldings.\n          ignore_prags <- goptM Opt_IgnoreInterfacePragmas\n\n                -- Typecheck the decls.  This is done lazily, so that the knot-tying\n                -- within this single module works out right.  It's the callers\n                -- job to make sure the knot is tied.\n        ; names_w_things <- loadDecls ignore_prags (mi_decls iface)\n        ; let type_env = mkNameEnv names_w_things\n\n                -- Now do those rules, instances and annotations\n        ; insts     <- mapM tcIfaceInst (mi_insts iface)\n        ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)\n        ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)\n        ; anns      <- tcIfaceAnnotations (mi_anns iface)\n\n                -- Exports\n        ; exports <- ifaceExportNames (mi_exports iface)\n\n                -- Complete Sigs\n        ; complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)\n\n                -- Finished\n        ; traceIf (vcat [text \"Finished typechecking interface for\" <+> ppr (mi_module iface),\n                         -- Careful! If we tug on the TyThing thunks too early\n                         -- we'll infinite loop with hs-boot.  See #10083 for\n                         -- an example where this would cause non-termination.\n                         text \"Type envt:\" <+> ppr (map fst names_w_things)])\n        ; return $ ModDetails { md_types     = type_env\n                              , md_insts     = insts\n                              , md_fam_insts = fam_insts\n                              , md_rules     = rules\n                              , md_anns      = anns\n                              , md_exports   = exports\n                              , md_complete_sigs = complete_sigs\n                              }\n    }\n\n{-\n************************************************************************\n*                                                                      *\n                Typechecking for merging\n*                                                                      *\n************************************************************************\n-}\n\n-- | Returns true if an 'IfaceDecl' is for @data T@ (an abstract data type)\nisAbstractIfaceDecl :: IfaceDecl -> Bool\nisAbstractIfaceDecl IfaceData{ ifCons = IfAbstractTyCon } = True\nisAbstractIfaceDecl IfaceClass{ ifBody = IfAbstractClass } = True\nisAbstractIfaceDecl IfaceFamily{ ifFamFlav = IfaceAbstractClosedSynFamilyTyCon } = True\nisAbstractIfaceDecl _ = False\n\nifMaybeRoles :: IfaceDecl -> Maybe [Role]\nifMaybeRoles IfaceData    { ifRoles = rs } = Just rs\nifMaybeRoles IfaceSynonym { ifRoles = rs } = Just rs\nifMaybeRoles IfaceClass   { ifRoles = rs } = Just rs\nifMaybeRoles _ = Nothing\n\n-- | Merge two 'IfaceDecl's together, preferring a non-abstract one.  If\n-- both are non-abstract we pick one arbitrarily (and check for consistency\n-- later.)\nmergeIfaceDecl :: IfaceDecl -> IfaceDecl -> IfaceDecl\nmergeIfaceDecl d1 d2\n    | isAbstractIfaceDecl d1 = d2 `withRolesFrom` d1\n    | isAbstractIfaceDecl d2 = d1 `withRolesFrom` d2\n    | IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops1, ifMinDef = bf1 } } <- d1\n    , IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops2, ifMinDef = bf2 } } <- d2\n    = let ops = nameEnvElts $\n                  plusNameEnv_C mergeIfaceClassOp\n                    (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])\n                    (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])\n      in d1 { ifBody = (ifBody d1) {\n                ifSigs  = ops,\n                ifMinDef = BF.mkOr [noLoc bf1, noLoc bf2]\n                }\n            } `withRolesFrom` d2\n    -- It doesn't matter; we'll check for consistency later when\n    -- we merge, see 'mergeSignatures'\n    | otherwise              = d1 `withRolesFrom` d2\n\n-- Note [Role merging]\n-- ~~~~~~~~~~~~~~~~~~~\n-- First, why might it be necessary to do a non-trivial role\n-- merge?  It may rescue a merge that might otherwise fail:\n--\n--      signature A where\n--          type role T nominal representational\n--          data T a b\n--\n--      signature A where\n--          type role T representational nominal\n--          data T a b\n--\n-- A module that defines T as representational in both arguments\n-- would successfully fill both signatures, so it would be better\n-- if we merged the roles of these types in some nontrivial\n-- way.\n--\n-- However, we have to be very careful about how we go about\n-- doing this, because role subtyping is *conditional* on\n-- the supertype being NOT representationally injective, e.g.,\n-- if we have instead:\n--\n--      signature A where\n--          type role T nominal representational\n--          data T a b = T a b\n--\n--      signature A where\n--          type role T representational nominal\n--          data T a b = T a b\n--\n-- Should we merge the definitions of T so that the roles are R/R (or N/N)?\n-- Absolutely not: neither resulting type is a subtype of the original\n-- types (see Note [Role subtyping]), because data is not representationally\n-- injective.\n--\n-- Thus, merging only occurs when BOTH TyCons in question are\n-- representationally injective.  If they're not, no merge.\n\nwithRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl\nd1 `withRolesFrom` d2\n    | Just roles1 <- ifMaybeRoles d1\n    , Just roles2 <- ifMaybeRoles d2\n    , not (isRepInjectiveIfaceDecl d1 || isRepInjectiveIfaceDecl d2)\n    = d1 { ifRoles = mergeRoles roles1 roles2 }\n    | otherwise = d1\n  where\n    mergeRoles roles1 roles2 = zipWith max roles1 roles2\n\nisRepInjectiveIfaceDecl :: IfaceDecl -> Bool\nisRepInjectiveIfaceDecl IfaceData{ ifCons = IfDataTyCon _ } = True\nisRepInjectiveIfaceDecl IfaceFamily{ ifFamFlav = IfaceDataFamilyTyCon } = True\nisRepInjectiveIfaceDecl _ = False\n\nmergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp\nmergeIfaceClassOp op1@(IfaceClassOp _ _ (Just _)) _ = op1\nmergeIfaceClassOp _ op2 = op2\n\n-- | Merge two 'OccEnv's of 'IfaceDecl's by 'OccName'.\nmergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl\nmergeIfaceDecls = plusOccEnv_C mergeIfaceDecl\n\n-- | This is a very interesting function.  Like typecheckIface, we want\n-- to type check an interface file into a ModDetails.  However, the use-case\n-- for these ModDetails is different: we want to compare all of the\n-- ModDetails to ensure they define compatible declarations, and then\n-- merge them together.  So in particular, we have to take a different\n-- strategy for knot-tying: we first speculatively merge the declarations\n-- to get the \"base\" truth for what we believe the types will be\n-- (this is \"type computation.\")  Then we read everything in relative\n-- to this truth and check for compatibility.\n--\n-- During the merge process, we may need to nondeterministically\n-- pick a particular declaration to use, if multiple signatures define\n-- the declaration ('mergeIfaceDecl').  If, for all choices, there\n-- are no type synonym cycles in the resulting merged graph, then\n-- we can show that our choice cannot matter. Consider the\n-- set of entities which the declarations depend on: by assumption\n-- of acyclicity, we can assume that these have already been shown to be equal\n-- to each other (otherwise merging will fail).  Then it must\n-- be the case that all candidate declarations here are type-equal\n-- (the choice doesn't matter) or there is an inequality (in which\n-- case merging will fail.)\n--\n-- Unfortunately, the choice can matter if there is a cycle.  Consider the\n-- following merge:\n--\n--      signature H where { type A = C;  type B = A; data C      }\n--      signature H where { type A = (); data B;     type C = B  }\n--\n-- If we pick @type A = C@ as our representative, there will be\n-- a cycle and merging will fail. But if we pick @type A = ()@ as\n-- our representative, no cycle occurs, and we instead conclude\n-- that all of the types are unit.  So it seems that we either\n-- (a) need a stronger acyclicity check which considers *all*\n-- possible choices from a merge, or (b) we must find a selection\n-- of declarations which is acyclic, and show that this is always\n-- the \"best\" choice we could have made (ezyang conjectures this\n-- is the case but does not have a proof).  For now this is\n-- not implemented.\n--\n-- It's worth noting that at the moment, a data constructor and a\n-- type synonym are never compatible.  Consider:\n--\n--      signature H where { type Int=C;         type B = Int; data C = Int}\n--      signature H where { export Prelude.Int; data B;       type C = B; }\n--\n-- This will be rejected, because the reexported Int in the second\n-- signature (a proper data type) is never considered equal to a\n-- type synonym.  Perhaps this should be relaxed, where a type synonym\n-- in a signature is considered implemented by a data type declaration\n-- which matches the reference of the type synonym.\ntypecheckIfacesForMerging :: Module -> [ModIface] -> IORef TypeEnv -> IfM lcl (TypeEnv, [ModDetails])\ntypecheckIfacesForMerging mod ifaces tc_env_var =\n  -- cannot be boot (False)\n  initIfaceLcl mod (text \"typecheckIfacesForMerging\") False $ do\n    ignore_prags <- goptM Opt_IgnoreInterfacePragmas\n    -- Build the initial environment\n    -- NB: Don't include dfuns here, because we don't want to\n    -- serialize them out.  See Note [rnIfaceNeverExported] in RnModIface\n    -- NB: But coercions are OK, because they will have the right OccName.\n    let mk_decl_env decls\n            = mkOccEnv [ (getOccName decl, decl)\n                       | decl <- decls\n                       , case decl of\n                            IfaceId { ifIdDetails = IfDFunId } -> False -- exclude DFuns\n                            _ -> True ]\n        decl_envs = map (mk_decl_env . map snd . mi_decls) ifaces\n                        :: [OccEnv IfaceDecl]\n        decl_env = foldl' mergeIfaceDecls emptyOccEnv decl_envs\n                        ::  OccEnv IfaceDecl\n    -- TODO: change loadDecls to accept w/o Fingerprint\n    names_w_things <- loadDecls ignore_prags (map (\\x -> (fingerprint0, x))\n                                                  (occEnvElts decl_env))\n    let global_type_env = mkNameEnv names_w_things\n    writeMutVar tc_env_var global_type_env\n\n    -- OK, now typecheck each ModIface using this environment\n    details <- forM ifaces $ \\iface -> do\n        -- See Note [Resolving never-exported Names in TcIface]\n        type_env <- fixM $ \\type_env -> do\n            setImplicitEnvM type_env $ do\n                decls <- loadDecls ignore_prags (mi_decls iface)\n                return (mkNameEnv decls)\n        -- But note that we use this type_env to typecheck references to DFun\n        -- in 'IfaceInst'\n        setImplicitEnvM type_env $ do\n        insts     <- mapM tcIfaceInst (mi_insts iface)\n        fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)\n        rules     <- tcIfaceRules ignore_prags (mi_rules iface)\n        anns      <- tcIfaceAnnotations (mi_anns iface)\n        exports   <- ifaceExportNames (mi_exports iface)\n        complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)\n        return $ ModDetails { md_types     = type_env\n                            , md_insts     = insts\n                            , md_fam_insts = fam_insts\n                            , md_rules     = rules\n                            , md_anns      = anns\n                            , md_exports   = exports\n                            , md_complete_sigs = complete_sigs\n                            }\n    return (global_type_env, details)\n\n-- | Typecheck a signature 'ModIface' under the assumption that we have\n-- instantiated it under some implementation (recorded in 'mi_semantic_module')\n-- and want to check if the implementation fills the signature.\n--\n-- This needs to operate slightly differently than 'typecheckIface'\n-- because (1) we have a 'NameShape', from the exports of the\n-- implementing module, which we will use to give our top-level\n-- declarations the correct 'Name's even when the implementor\n-- provided them with a reexport, and (2) we have to deal with\n-- DFun silliness (see Note [rnIfaceNeverExported])\ntypecheckIfaceForInstantiate :: NameShape -> ModIface -> IfM lcl ModDetails\ntypecheckIfaceForInstantiate nsubst iface =\n  initIfaceLclWithSubst (mi_semantic_module iface)\n                        (text \"typecheckIfaceForInstantiate\")\n                        (mi_boot iface) nsubst $ do\n    ignore_prags <- goptM Opt_IgnoreInterfacePragmas\n    -- See Note [Resolving never-exported Names in TcIface]\n    type_env <- fixM $ \\type_env -> do\n        setImplicitEnvM type_env $ do\n            decls     <- loadDecls ignore_prags (mi_decls iface)\n            return (mkNameEnv decls)\n    -- See Note [rnIfaceNeverExported]\n    setImplicitEnvM type_env $ do\n    insts     <- mapM tcIfaceInst (mi_insts iface)\n    fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)\n    rules     <- tcIfaceRules ignore_prags (mi_rules iface)\n    anns      <- tcIfaceAnnotations (mi_anns iface)\n    exports   <- ifaceExportNames (mi_exports iface)\n    complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)\n    return $ ModDetails { md_types     = type_env\n                        , md_insts     = insts\n                        , md_fam_insts = fam_insts\n                        , md_rules     = rules\n                        , md_anns      = anns\n                        , md_exports   = exports\n                        , md_complete_sigs = complete_sigs\n                        }\n\n-- Note [Resolving never-exported Names in TcIface]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- For the high-level overview, see\n-- Note [Handling never-exported TyThings under Backpack]\n--\n-- As described in 'typecheckIfacesForMerging', the splendid innovation\n-- of signature merging is to rewrite all Names in each of the signatures\n-- we are merging together to a pre-merged structure; this is the key\n-- ingredient that lets us solve some problems when merging type\n-- synonyms.\n--\n-- However, when a 'Name' refers to a NON-exported entity, as is the\n-- case with the DFun of a ClsInst, or a CoAxiom of a type family,\n-- this strategy causes problems: if we pick one and rewrite all\n-- references to a shared 'Name', we will accidentally fail to check\n-- if the DFun or CoAxioms are compatible, as they will never be\n-- checked--only exported entities are checked for compatibility,\n-- and a non-exported TyThing is checked WHEN we are checking the\n-- ClsInst or type family for compatibility in checkBootDeclM.\n-- By virtue of the fact that everything's been pointed to the merged\n-- declaration, you'll never notice there's a difference even if there\n-- is one.\n--\n-- Fortunately, there are only a few places in the interface declarations\n-- where this can occur, so we replace those calls with 'tcIfaceImplicit',\n-- which will consult a local TypeEnv that records any never-exported\n-- TyThings which we should wire up with.\n--\n-- Note that we actually knot-tie this local TypeEnv (the 'fixM'), because a\n-- type family can refer to a coercion axiom, all of which are done in one go\n-- when we typecheck 'mi_decls'.  An alternate strategy would be to typecheck\n-- coercions first before type families, but that seemed more fragile.\n--\n\n{-\n************************************************************************\n*                                                                      *\n                Type and class declarations\n*                                                                      *\n************************************************************************\n-}\n\ntcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo\n-- Load the hi-boot iface for the module being compiled,\n-- if it indeed exists in the transitive closure of imports\n-- Return the ModDetails; Nothing if no hi-boot iface\ntcHiBootIface hsc_src mod\n  | HsBootFile <- hsc_src            -- Already compiling a hs-boot file\n  = return NoSelfBoot\n  | otherwise\n  = do  { traceIf (text \"loadHiBootInterface\" <+> ppr mod)\n\n        ; mode <- getGhcMode\n        ; if not (isOneShot mode)\n                -- In --make and interactive mode, if this module has an hs-boot file\n                -- we'll have compiled it already, and it'll be in the HPT\n                --\n                -- We check wheher the interface is a *boot* interface.\n                -- It can happen (when using GHC from Visual Studio) that we\n                -- compile a module in TypecheckOnly mode, with a stable,\n                -- fully-populated HPT.  In that case the boot interface isn't there\n                -- (it's been replaced by the mother module) so we can't check it.\n                -- And that's fine, because if M's ModInfo is in the HPT, then\n                -- it's been compiled once, and we don't need to check the boot iface\n          then do { hpt <- getHpt\n                 ; case lookupHpt hpt (moduleName mod) of\n                      Just info | mi_boot (hm_iface info)\n                                -> mkSelfBootInfo (hm_iface info) (hm_details info)\n                      _ -> return NoSelfBoot }\n          else do\n\n        -- OK, so we're in one-shot mode.\n        -- Re #9245, we always check if there is an hi-boot interface\n        -- to check consistency against, rather than just when we notice\n        -- that an hi-boot is necessary due to a circular import.\n        { read_result <- findAndReadIface\n                                need (fst (splitModuleInsts mod)) mod\n                                True    -- Hi-boot file\n\n        ; case read_result of {\n            Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface\n                                           ; mkSelfBootInfo iface tc_iface } ;\n            Failed err               ->\n\n        -- There was no hi-boot file. But if there is circularity in\n        -- the module graph, there really should have been one.\n        -- Since we've read all the direct imports by now,\n        -- eps_is_boot will record if any of our imports mention the\n        -- current module, which either means a module loop (not\n        -- a SOURCE import) or that our hi-boot file has mysteriously\n        -- disappeared.\n    do  { eps <- getEps\n        ; case lookupUFM (eps_is_boot eps) (moduleName mod) of\n            Nothing -> return NoSelfBoot -- The typical case\n\n            Just (_, False) -> failWithTc moduleLoop\n                -- Someone below us imported us!\n                -- This is a loop with no hi-boot in the way\n\n            Just (_mod, True) -> failWithTc (elaborate err)\n                -- The hi-boot file has mysteriously disappeared.\n    }}}}\n  where\n    need = text \"Need the hi-boot interface for\" <+> ppr mod\n                 <+> text \"to compare against the Real Thing\"\n\n    moduleLoop = text \"Circular imports: module\" <+> quotes (ppr mod)\n                     <+> text \"depends on itself\"\n\n    elaborate err = hang (text \"Could not find hi-boot interface for\" <+>\n                          quotes (ppr mod) <> colon) 4 err\n\n\nmkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo\nmkSelfBootInfo iface mds\n  = do -- NB: This is computed DIRECTLY from the ModIface rather\n       -- than from the ModDetails, so that we can query 'sb_tcs'\n       -- WITHOUT forcing the contents of the interface.\n       let tcs = map ifName\n                 . filter isIfaceTyCon\n                 . map snd\n                 $ mi_decls iface\n       return $ SelfBoot { sb_mds = mds\n                         , sb_tcs = mkNameSet tcs }\n  where\n    -- | Retuerns @True@ if, when you call 'tcIfaceDecl' on\n    -- this 'IfaceDecl', an ATyCon would be returned.\n    -- NB: This code assumes that a TyCon cannot be implicit.\n    isIfaceTyCon IfaceId{}      = False\n    isIfaceTyCon IfaceData{}    = True\n    isIfaceTyCon IfaceSynonym{} = True\n    isIfaceTyCon IfaceFamily{}  = True\n    isIfaceTyCon IfaceClass{}   = True\n    isIfaceTyCon IfaceAxiom{}   = False\n    isIfaceTyCon IfacePatSyn{}  = False\n\n{-\n************************************************************************\n*                                                                      *\n                Type and class declarations\n*                                                                      *\n************************************************************************\n\nWhen typechecking a data type decl, we *lazily* (via forkM) typecheck\nthe constructor argument types.  This is in the hope that we may never\npoke on those argument types, and hence may never need to load the\ninterface files for types mentioned in the arg types.\n\nE.g.\n        data Foo.S = MkS Baz.T\nMaybe we can get away without even loading the interface for Baz!\n\nThis is not just a performance thing.  Suppose we have\n        data Foo.S = MkS Baz.T\n        data Baz.T = MkT Foo.S\n(in different interface files, of course).\nNow, first we load and typecheck Foo.S, and add it to the type envt.\nIf we do explore MkS's argument, we'll load and typecheck Baz.T.\nIf we explore MkT's argument we'll find Foo.S already in the envt.\n\nIf we typechecked constructor args eagerly, when loading Foo.S we'd try to\ntypecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...\nwhich isn't done yet.\n\nAll very cunning. However, there is a rather subtle gotcha which bit\nme when developing this stuff.  When we typecheck the decl for S, we\nextend the type envt with S, MkS, and all its implicit Ids.  Suppose\n(a bug, but it happened) that the list of implicit Ids depended in\nturn on the constructor arg types.  Then the following sequence of\nevents takes place:\n        * we build a thunk <t> for the constructor arg tys\n        * we build a thunk for the extended type environment (depends on <t>)\n        * we write the extended type envt into the global EPS mutvar\n\nNow we look something up in the type envt\n        * that pulls on <t>\n        * which reads the global type envt out of the global EPS mutvar\n        * but that depends in turn on <t>\n\nIt's subtle, because, it'd work fine if we typechecked the constructor args\neagerly -- they don't need the extended type envt.  They just get the extended\ntype envt by accident, because they look at it later.\n\nWhat this means is that the implicitTyThings MUST NOT DEPEND on any of\nthe forkM stuff.\n-}\n\ntcIfaceDecl :: Bool     -- ^ True <=> discard IdInfo on IfaceId bindings\n            -> IfaceDecl\n            -> IfL TyThing\ntcIfaceDecl = tc_iface_decl Nothing\n\ntc_iface_decl :: Maybe Class  -- ^ For associated type/data family declarations\n              -> Bool         -- ^ True <=> discard IdInfo on IfaceId bindings\n              -> IfaceDecl\n              -> IfL TyThing\ntc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type,\n                                       ifIdDetails = details, ifIdInfo = info})\n  = do  { ty <- tcIfaceType iface_type\n        ; details <- tcIdDetails ty details\n        ; info <- tcIdInfo ignore_prags TopLevel name ty info\n        ; return (AnId (mkGlobalId details name ty info)) }\n\ntc_iface_decl _ _ (IfaceData {ifName = tc_name,\n                          ifCType = cType,\n                          ifBinders = binders,\n                          ifResKind = res_kind,\n                          ifRoles = roles,\n                          ifCtxt = ctxt, ifGadtSyntax = gadt_syn,\n                          ifCons = rdr_cons,\n                          ifParent = mb_parent })\n  = bindIfaceTyConBinders_AT binders $ \\ binders' -> do\n    { res_kind' <- tcIfaceType res_kind\n\n    ; tycon <- fixM $ \\ tycon -> do\n            { stupid_theta <- tcIfaceCtxt ctxt\n            ; parent' <- tc_parent tc_name mb_parent\n            ; cons <- tcIfaceDataCons tc_name tycon binders' rdr_cons\n            ; return (mkAlgTyCon tc_name binders' res_kind'\n                                 roles cType stupid_theta\n                                 cons parent' gadt_syn) }\n    ; traceIf (text \"tcIfaceDecl4\" <+> ppr tycon)\n    ; return (ATyCon tycon) }\n  where\n    tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav\n    tc_parent tc_name IfNoParent\n      = do { tc_rep_name <- newTyConRepName tc_name\n           ; return (VanillaAlgTyCon tc_rep_name) }\n    tc_parent _ (IfDataInstance ax_name _ arg_tys)\n      = do { ax <- tcIfaceCoAxiom ax_name\n           ; let fam_tc  = coAxiomTyCon ax\n                 ax_unbr = toUnbranchedAxiom ax\n           ; lhs_tys <- tcIfaceAppArgs arg_tys\n           ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }\n\ntc_iface_decl _ _ (IfaceSynonym {ifName = tc_name,\n                                      ifRoles = roles,\n                                      ifSynRhs = rhs_ty,\n                                      ifBinders = binders,\n                                      ifResKind = res_kind })\n   = bindIfaceTyConBinders_AT binders $ \\ binders' -> do\n     { res_kind' <- tcIfaceType res_kind     -- Note [Synonym kind loop]\n     ; rhs      <- forkM (mk_doc tc_name) $\n                   tcIfaceType rhs_ty\n     ; let tycon = buildSynTyCon tc_name binders' res_kind' roles rhs\n     ; return (ATyCon tycon) }\n   where\n     mk_doc n = text \"Type synonym\" <+> ppr n\n\ntc_iface_decl parent _ (IfaceFamily {ifName = tc_name,\n                                     ifFamFlav = fam_flav,\n                                     ifBinders = binders,\n                                     ifResKind = res_kind,\n                                     ifResVar = res, ifFamInj = inj })\n   = bindIfaceTyConBinders_AT binders $ \\ binders' -> do\n     { res_kind' <- tcIfaceType res_kind    -- Note [Synonym kind loop]\n     ; rhs      <- forkM (mk_doc tc_name) $\n                   tc_fam_flav tc_name fam_flav\n     ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res\n     ; let tycon = mkFamilyTyCon tc_name binders' res_kind' res_name rhs parent inj\n     ; return (ATyCon tycon) }\n   where\n     mk_doc n = text \"Type synonym\" <+> ppr n\n\n     tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav\n     tc_fam_flav tc_name IfaceDataFamilyTyCon\n       = do { tc_rep_name <- newTyConRepName tc_name\n            ; return (DataFamilyTyCon tc_rep_name) }\n     tc_fam_flav _ IfaceOpenSynFamilyTyCon= return OpenSynFamilyTyCon\n     tc_fam_flav _ (IfaceClosedSynFamilyTyCon mb_ax_name_branches)\n       = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches\n            ; return (ClosedSynFamilyTyCon ax) }\n     tc_fam_flav _ IfaceAbstractClosedSynFamilyTyCon\n         = return AbstractClosedSynFamilyTyCon\n     tc_fam_flav _ IfaceBuiltInSynFamTyCon\n         = pprPanic \"tc_iface_decl\"\n                    (text \"IfaceBuiltInSynFamTyCon in interface file\")\n\ntc_iface_decl _parent _ignore_prags\n            (IfaceClass {ifName = tc_name,\n                         ifRoles = roles,\n                         ifBinders = binders,\n                         ifFDs = rdr_fds,\n                         ifBody = IfAbstractClass})\n  = bindIfaceTyConBinders binders $ \\ binders' -> do\n    { fds  <- mapM tc_fd rdr_fds\n    ; cls  <- buildClass tc_name binders' roles fds Nothing\n    ; return (ATyCon (classTyCon cls)) }\n\ntc_iface_decl _parent ignore_prags\n            (IfaceClass {ifName = tc_name,\n                         ifRoles = roles,\n                         ifBinders = binders,\n                         ifFDs = rdr_fds,\n                         ifBody = IfConcreteClass {\n                             ifClassCtxt = rdr_ctxt,\n                             ifATs = rdr_ats, ifSigs = rdr_sigs,\n                             ifMinDef = mindef_occ\n                         }})\n  = bindIfaceTyConBinders binders $ \\ binders' -> do\n    { traceIf (text \"tc-iface-class1\" <+> ppr tc_name)\n    ; ctxt <- mapM tc_sc rdr_ctxt\n    ; traceIf (text \"tc-iface-class2\" <+> ppr tc_name)\n    ; sigs <- mapM tc_sig rdr_sigs\n    ; fds  <- mapM tc_fd rdr_fds\n    ; traceIf (text \"tc-iface-class3\" <+> ppr tc_name)\n    ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ\n    ; cls  <- fixM $ \\ cls -> do\n              { ats  <- mapM (tc_at cls) rdr_ats\n              ; traceIf (text \"tc-iface-class4\" <+> ppr tc_name)\n              ; buildClass tc_name binders' roles fds (Just (ctxt, ats, sigs, mindef)) }\n    ; return (ATyCon (classTyCon cls)) }\n  where\n   tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)\n        -- The *length* of the superclasses is used by buildClass, and hence must\n        -- not be inside the thunk.  But the *content* maybe recursive and hence\n        -- must be lazy (via forkM).  Example:\n        --     class C (T a) => D a where\n        --       data T a\n        -- Here the associated type T is knot-tied with the class, and\n        -- so we must not pull on T too eagerly.  See Trac #5970\n\n   tc_sig :: IfaceClassOp -> IfL TcMethInfo\n   tc_sig (IfaceClassOp op_name rdr_ty dm)\n     = do { let doc = mk_op_doc op_name rdr_ty\n          ; op_ty <- forkM (doc <+> text \"ty\") $ tcIfaceType rdr_ty\n                -- Must be done lazily for just the same reason as the\n                -- type of a data con; to avoid sucking in types that\n                -- it mentions unless it's necessary to do so\n          ; dm'   <- tc_dm doc dm\n          ; return (op_name, op_ty, dm') }\n\n   tc_dm :: SDoc\n         -> Maybe (DefMethSpec IfaceType)\n         -> IfL (Maybe (DefMethSpec (SrcSpan, Type)))\n   tc_dm _   Nothing               = return Nothing\n   tc_dm _   (Just VanillaDM)      = return (Just VanillaDM)\n   tc_dm doc (Just (GenericDM ty))\n        = do { -- Must be done lazily to avoid sucking in types\n             ; ty' <- forkM (doc <+> text \"dm\") $ tcIfaceType ty\n             ; return (Just (GenericDM (noSrcSpan, ty'))) }\n\n   tc_at cls (IfaceAT tc_decl if_def)\n     = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl\n          mb_def <- case if_def of\n                      Nothing  -> return Nothing\n                      Just def -> forkM (mk_at_doc tc)                 $\n                                  extendIfaceTyVarEnv (tyConTyVars tc) $\n                                  do { tc_def <- tcIfaceType def\n                                     ; return (Just (tc_def, noSrcSpan)) }\n                  -- Must be done lazily in case the RHS of the defaults mention\n                  -- the type constructor being defined here\n                  -- e.g.   type AT a; type AT b = AT [b]   Trac #8002\n          return (ATI tc mb_def)\n\n   mk_sc_doc pred = text \"Superclass\" <+> ppr pred\n   mk_at_doc tc = text \"Associated type\" <+> ppr tc\n   mk_op_doc op_name op_ty = text \"Class op\" <+> sep [ppr op_name, ppr op_ty]\n\ntc_iface_decl _ _ (IfaceAxiom { ifName = tc_name, ifTyCon = tc\n                              , ifAxBranches = branches, ifRole = role })\n  = do { tc_tycon    <- tcIfaceTyCon tc\n       -- Must be done lazily, because axioms are forced when checking\n       -- for family instance consistency, and the RHS may mention\n       -- a hs-boot declared type constructor that is going to be\n       -- defined by this module.\n       -- e.g. type instance F Int = ToBeDefined\n       -- See Trac #13803\n       ; tc_branches <- forkM (text \"Axiom branches\" <+> ppr tc_name)\n                      $ tc_ax_branches branches\n       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name\n                             , co_ax_name     = tc_name\n                             , co_ax_tc       = tc_tycon\n                             , co_ax_role     = role\n                             , co_ax_branches = manyBranches tc_branches\n                             , co_ax_implicit = False }\n       ; return (ACoAxiom axiom) }\n\ntc_iface_decl _ _ (IfacePatSyn{ ifName = name\n                              , ifPatMatcher = if_matcher\n                              , ifPatBuilder = if_builder\n                              , ifPatIsInfix = is_infix\n                              , ifPatUnivBndrs = univ_bndrs\n                              , ifPatExBndrs = ex_bndrs\n                              , ifPatProvCtxt = prov_ctxt\n                              , ifPatReqCtxt = req_ctxt\n                              , ifPatArgs = args\n                              , ifPatTy = pat_ty\n                              , ifFieldLabels = field_labels })\n  = do { traceIf (text \"tc_iface_decl\" <+> ppr name)\n       ; matcher <- tc_pr if_matcher\n       ; builder <- fmapMaybeM tc_pr if_builder\n       ; bindIfaceForAllBndrs univ_bndrs $ \\univ_tvs -> do\n       { bindIfaceForAllBndrs ex_bndrs $ \\ex_tvs -> do\n       { patsyn <- forkM (mk_doc name) $\n             do { prov_theta <- tcIfaceCtxt prov_ctxt\n                ; req_theta  <- tcIfaceCtxt req_ctxt\n                ; pat_ty     <- tcIfaceType pat_ty\n                ; arg_tys    <- mapM tcIfaceType args\n                ; return $ buildPatSyn name is_infix matcher builder\n                                       (univ_tvs, req_theta)\n                                       (ex_tvs, prov_theta)\n                                       arg_tys pat_ty field_labels }\n       ; return $ AConLike . PatSynCon $ patsyn }}}\n  where\n     mk_doc n = text \"Pattern synonym\" <+> ppr n\n     tc_pr :: (IfExtName, Bool) -> IfL (Id, Bool)\n     tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm)\n                        ; return (id, b) }\n\ntc_fd :: FunDep IfLclName -> IfL (FunDep TyVar)\ntc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1\n                        ; tvs2' <- mapM tcIfaceTyVar tvs2\n                        ; return (tvs1', tvs2') }\n\ntc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]\ntc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches\n\ntc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]\ntc_ax_branch prev_branches\n             (IfaceAxBranch { ifaxbTyVars = tv_bndrs\n                            , ifaxbEtaTyVars = eta_tv_bndrs\n                            , ifaxbCoVars = cv_bndrs\n                            , ifaxbLHS = lhs, ifaxbRHS = rhs\n                            , ifaxbRoles = roles, ifaxbIncomps = incomps })\n  = bindIfaceTyConBinders_AT\n      (map (\\b -> Bndr (IfaceTvBndr b) (NamedTCB Inferred)) tv_bndrs) $ \\ tvs ->\n         -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom\n    bindIfaceIds cv_bndrs $ \\ cvs -> do\n    { tc_lhs   <- tcIfaceAppArgs lhs\n    ; tc_rhs   <- tcIfaceType rhs\n    ; eta_tvs  <- bindIfaceTyVars eta_tv_bndrs return\n    ; this_mod <- getIfModule\n    ; let loc = mkGeneralSrcSpan (fsLit \"module \" `appendFS`\n                                  moduleNameFS (moduleName this_mod))\n          br = CoAxBranch { cab_loc     = loc\n                          , cab_tvs     = binderVars tvs\n                          , cab_eta_tvs = eta_tvs\n                          , cab_cvs     = cvs\n                          , cab_lhs     = tc_lhs\n                          , cab_roles   = roles\n                          , cab_rhs     = tc_rhs\n                          , cab_incomps = map (prev_branches `getNth`) incomps }\n    ; return (prev_branches ++ [br]) }\n\ntcIfaceDataCons :: Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs\ntcIfaceDataCons tycon_name tycon tc_tybinders if_cons\n  = case if_cons of\n        IfAbstractTyCon  -> return AbstractTyCon\n        IfDataTyCon cons -> do  { data_cons  <- mapM tc_con_decl cons\n                                ; return (mkDataTyConRhs data_cons) }\n        IfNewTyCon  con  -> do  { data_con  <- tc_con_decl con\n                                ; mkNewTyConRhs tycon_name tycon data_con }\n  where\n    univ_tvs :: [TyVar]\n    univ_tvs = binderVars (tyConTyVarBinders tc_tybinders)\n\n    tag_map :: NameEnv ConTag\n    tag_map = mkTyConTagMap tycon\n\n    tc_con_decl (IfCon { ifConInfix = is_infix,\n                         ifConExTCvs = ex_bndrs,\n                         ifConUserTvBinders = user_bndrs,\n                         ifConName = dc_name,\n                         ifConCtxt = ctxt, ifConEqSpec = spec,\n                         ifConArgTys = args, ifConFields = lbl_names,\n                         ifConStricts = if_stricts,\n                         ifConSrcStricts = if_src_stricts})\n     = -- Universally-quantified tyvars are shared with\n       -- parent TyCon, and are already in scope\n       bindIfaceBndrs ex_bndrs    $ \\ ex_tvs -> do\n        { traceIf (text \"Start interface-file tc_con_decl\" <+> ppr dc_name)\n\n          -- By this point, we have bound every universal and existential\n          -- tyvar. Because of the dcUserTyVarBinders invariant\n          -- (see Note [DataCon user type variable binders]), *every* tyvar in\n          -- ifConUserTvBinders has a matching counterpart somewhere in the\n          -- bound universals/existentials. As a result, calling tcIfaceTyVar\n          -- below is always guaranteed to succeed.\n        ; user_tv_bndrs <- mapM (\\(Bndr bd vis) ->\n                                   case bd of\n                                     IfaceIdBndr (name, _) ->\n                                       Bndr <$> tcIfaceLclId name <*> pure vis\n                                     IfaceTvBndr (name, _) ->\n                                       Bndr <$> tcIfaceTyVar name <*> pure vis)\n                                user_bndrs\n\n        -- Read the context and argument types, but lazily for two reasons\n        -- (a) to avoid looking tugging on a recursive use of\n        --     the type itself, which is knot-tied\n        -- (b) to avoid faulting in the component types unless\n        --     they are really needed\n        ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc dc_name) $\n             do { eq_spec <- tcIfaceEqSpec spec\n                ; theta   <- tcIfaceCtxt ctxt\n                -- This fixes #13710.  The enclosing lazy thunk gets\n                -- forced when typechecking record wildcard pattern\n                -- matching (it's not completely clear why this\n                -- tuple is needed), which causes trouble if one of\n                -- the argument types was recursively defined.\n                -- See also Note [Tying the knot]\n                ; arg_tys <- forkM (mk_doc dc_name <+> text \"arg_tys\")\n                           $ mapM tcIfaceType args\n                ; stricts <- mapM tc_strict if_stricts\n                        -- The IfBang field can mention\n                        -- the type itself; hence inside forkM\n                ; return (eq_spec, theta, arg_tys, stricts) }\n\n        -- Remember, tycon is the representation tycon\n        ; let orig_res_ty = mkFamilyTyConApp tycon\n                              (substTyCoVars (mkTvSubstPrs (map eqSpecPair eq_spec))\n                                             (binderVars tc_tybinders))\n\n        ; prom_rep_name <- newTyConRepName dc_name\n\n        ; con <- buildDataCon (pprPanic \"tcIfaceDataCons: FamInstEnvs\" (ppr dc_name))\n                       dc_name is_infix prom_rep_name\n                       (map src_strict if_src_stricts)\n                       (Just stricts)\n                       -- Pass the HsImplBangs (i.e. final\n                       -- decisions) to buildDataCon; it'll use\n                       -- these to guide the construction of a\n                       -- worker.\n                       -- See Note [Bangs on imported data constructors] in MkId\n                       lbl_names\n                       univ_tvs ex_tvs user_tv_bndrs\n                       eq_spec theta\n                       arg_tys orig_res_ty tycon tag_map\n        ; traceIf (text \"Done interface-file tc_con_decl\" <+> ppr dc_name)\n        ; return con }\n    mk_doc con_name = text \"Constructor\" <+> ppr con_name\n\n    tc_strict :: IfaceBang -> IfL HsImplBang\n    tc_strict IfNoBang = return (HsLazy)\n    tc_strict IfStrict = return (HsStrict)\n    tc_strict IfUnpack = return (HsUnpack Nothing)\n    tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co\n                                      ; return (HsUnpack (Just co)) }\n\n    src_strict :: IfaceSrcBang -> HsSrcBang\n    src_strict (IfSrcBang unpk bang) = HsSrcBang NoSourceText unpk bang\n\ntcIfaceEqSpec :: IfaceEqSpec -> IfL [EqSpec]\ntcIfaceEqSpec spec\n  = mapM do_item spec\n  where\n    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ\n                              ; ty <- tcIfaceType if_ty\n                              ; return (mkEqSpec tv ty) }\n\n{-\nNote [Synonym kind loop]\n~~~~~~~~~~~~~~~~~~~~~~~~\nNotice that we eagerly grab the *kind* from the interface file, but\nbuild a forkM thunk for the *rhs* (and family stuff).  To see why,\nconsider this (Trac #2412)\n\nM.hs:       module M where { import X; data T = MkT S }\nX.hs:       module X where { import {-# SOURCE #-} M; type S = T }\nM.hs-boot:  module M where { data T }\n\nWhen kind-checking M.hs we need S's kind.  But we do not want to\nfind S's kind from (typeKind S-rhs), because we don't want to look at\nS-rhs yet!  Since S is imported from X.hi, S gets just one chance to\nbe defined, and we must not do that until we've finished with M.T.\n\nSolution: record S's kind in the interface file; now we can safely\nlook at it.\n\n************************************************************************\n*                                                                      *\n                Instances\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceInst :: IfaceClsInst -> IfL ClsInst\ntcIfaceInst (IfaceClsInst { ifDFun = dfun_name, ifOFlag = oflag\n                          , ifInstCls = cls, ifInstTys = mb_tcs\n                          , ifInstOrph = orph })\n  = do { dfun <- forkM (text \"Dict fun\" <+> ppr dfun_name) $\n                    fmap tyThingId (tcIfaceImplicit dfun_name)\n       ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs\n       ; return (mkImportedInstance cls mb_tcs' dfun_name dfun oflag orph) }\n\ntcIfaceFamInst :: IfaceFamInst -> IfL FamInst\ntcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs\n                             , ifFamInstAxiom = axiom_name } )\n    = do { axiom' <- forkM (text \"Axiom\" <+> ppr axiom_name) $\n                     tcIfaceCoAxiom axiom_name\n             -- will panic if branched, but that's OK\n         ; let axiom'' = toUnbranchedAxiom axiom'\n               mb_tcs' = map (fmap ifaceTyConName) mb_tcs\n         ; return (mkImportedFamInst fam mb_tcs' axiom'') }\n\n{-\n************************************************************************\n*                                                                      *\n                Rules\n*                                                                      *\n************************************************************************\n\nWe move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars\nare in the type environment.  However, remember that typechecking a Rule may\n(as a side effect) augment the type envt, and so we may need to iterate the process.\n-}\n\ntcIfaceRules :: Bool            -- True <=> ignore rules\n             -> [IfaceRule]\n             -> IfL [CoreRule]\ntcIfaceRules ignore_prags if_rules\n  | ignore_prags = return []\n  | otherwise    = mapM tcIfaceRule if_rules\n\ntcIfaceRule :: IfaceRule -> IfL CoreRule\ntcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,\n                        ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,\n                        ifRuleAuto = auto, ifRuleOrph = orph })\n  = do  { ~(bndrs', args', rhs') <-\n                -- Typecheck the payload lazily, in the hope it'll never be looked at\n                forkM (text \"Rule\" <+> pprRuleName name) $\n                bindIfaceBndrs bndrs                      $ \\ bndrs' ->\n                do { args' <- mapM tcIfaceExpr args\n                   ; rhs'  <- tcIfaceExpr rhs\n                   ; return (bndrs', args', rhs') }\n        ; let mb_tcs = map ifTopFreeName args\n        ; this_mod <- getIfModule\n        ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act,\n                          ru_bndrs = bndrs', ru_args = args',\n                          ru_rhs = occurAnalyseExpr rhs',\n                          ru_rough = mb_tcs,\n                          ru_origin = this_mod,\n                          ru_orphan = orph,\n                          ru_auto = auto,\n                          ru_local = False }) } -- An imported RULE is never for a local Id\n                                                -- or, even if it is (module loop, perhaps)\n                                                -- we'll just leave it in the non-local set\n  where\n        -- This function *must* mirror exactly what Rules.roughTopNames does\n        -- We could have stored the ru_rough field in the iface file\n        -- but that would be redundant, I think.\n        -- The only wrinkle is that we must not be deceived by\n        -- type synonyms at the top of a type arg.  Since\n        -- we can't tell at this point, we are careful not\n        -- to write them out in coreRuleToIfaceRule\n    ifTopFreeName :: IfaceExpr -> Maybe Name\n    ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)\n    ifTopFreeName (IfaceType (IfaceTupleTy s _ ts)) = Just (tupleTyConName s (length (appArgsIfaceTypes ts)))\n    ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f\n    ifTopFreeName (IfaceExt n)                      = Just n\n    ifTopFreeName _                                 = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n                Annotations\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]\ntcIfaceAnnotations = mapM tcIfaceAnnotation\n\ntcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation\ntcIfaceAnnotation (IfaceAnnotation target serialized) = do\n    target' <- tcIfaceAnnTarget target\n    return $ Annotation {\n        ann_target = target',\n        ann_value = serialized\n    }\n\ntcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)\ntcIfaceAnnTarget (NamedTarget occ) = do\n    name <- lookupIfaceTop occ\n    return $ NamedTarget name\ntcIfaceAnnTarget (ModuleTarget mod) = do\n    return $ ModuleTarget mod\n\n{-\n************************************************************************\n*                                                                      *\n                Complete Match Pragmas\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch]\ntcIfaceCompleteSigs = mapM tcIfaceCompleteSig\n\ntcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch\ntcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t)\n\n{-\n************************************************************************\n*                                                                      *\n                        Types\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceType :: IfaceType -> IfL Type\ntcIfaceType = go\n  where\n    go (IfaceTyVar n)          = TyVarTy <$> tcIfaceTyVar n\n    go (IfaceFreeTyVar n)      = pprPanic \"tcIfaceType:IfaceFreeTyVar\" (ppr n)\n    go (IfaceLitTy l)          = LitTy <$> tcIfaceTyLit l\n    go (IfaceFunTy flag t1 t2) = FunTy flag <$> go t1 <*> go t2\n    go (IfaceTupleTy s i tks)  = tcIfaceTupleTy s i tks\n    go (IfaceAppTy t ts)\n      = do { t'  <- go t\n           ; ts' <- traverse go (appArgsIfaceTypes ts)\n           ; pure (foldl' AppTy t' ts') }\n    go (IfaceTyConApp tc tks)\n      = do { tc' <- tcIfaceTyCon tc\n           ; tks' <- mapM go (appArgsIfaceTypes tks)\n           ; return (mkTyConApp tc' tks') }\n    go (IfaceForAllTy bndr t)\n      = bindIfaceForAllBndr bndr $ \\ tv' vis ->\n        ForAllTy (Bndr tv' vis) <$> go t\n    go (IfaceCastTy ty co)   = CastTy <$> go ty <*> tcIfaceCo co\n    go (IfaceCoercionTy co)  = CoercionTy <$> tcIfaceCo co\n\ntcIfaceTupleTy :: TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type\ntcIfaceTupleTy sort is_promoted args\n = do { args' <- tcIfaceAppArgs args\n      ; let arity = length args'\n      ; base_tc <- tcTupleTyCon True sort arity\n      ; case is_promoted of\n          NotPromoted\n            -> return (mkTyConApp base_tc args')\n\n          IsPromoted\n            -> do { let tc        = promoteDataCon (tyConSingleDataCon base_tc)\n                        kind_args = map typeKind args'\n                  ; return (mkTyConApp tc (kind_args ++ args')) } }\n\n-- See Note [Unboxed tuple RuntimeRep vars] in TyCon\ntcTupleTyCon :: Bool    -- True <=> typechecking a *type* (vs. an expr)\n             -> TupleSort\n             -> Arity   -- the number of args. *not* the tuple arity.\n             -> IfL TyCon\ntcTupleTyCon in_type sort arity\n  = case sort of\n      ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity)\n                            ; return (tyThingTyCon thing) }\n      BoxedTuple   -> return (tupleTyCon Boxed   arity)\n      UnboxedTuple -> return (tupleTyCon Unboxed arity')\n        where arity' | in_type   = arity `div` 2\n                     | otherwise = arity\n                      -- in expressions, we only have term args\n\ntcIfaceAppArgs :: IfaceAppArgs -> IfL [Type]\ntcIfaceAppArgs = mapM tcIfaceType . appArgsIfaceTypes\n\n-----------------------------------------\ntcIfaceCtxt :: IfaceContext -> IfL ThetaType\ntcIfaceCtxt sts = mapM tcIfaceType sts\n\n-----------------------------------------\ntcIfaceTyLit :: IfaceTyLit -> IfL TyLit\ntcIfaceTyLit (IfaceNumTyLit n) = return (NumTyLit n)\ntcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n)\n\n{-\n%************************************************************************\n%*                                                                      *\n                        Coercions\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceCo :: IfaceCoercion -> IfL Coercion\ntcIfaceCo = go\n  where\n    go_mco IfaceMRefl    = pure MRefl\n    go_mco (IfaceMCo co) = MCo <$> (go co)\n\n    go (IfaceReflCo t)           = Refl <$> tcIfaceType t\n    go (IfaceGReflCo r t mco)    = GRefl r <$> tcIfaceType t <*> go_mco mco\n    go (IfaceFunCo r c1 c2)      = mkFunCo r <$> go c1 <*> go c2\n    go (IfaceTyConAppCo r tc cs)\n      = TyConAppCo r <$> tcIfaceTyCon tc <*> mapM go cs\n    go (IfaceAppCo c1 c2)        = AppCo <$> go c1 <*> go c2\n    go (IfaceForAllCo tv k c)  = do { k' <- go k\n                                      ; bindIfaceBndr tv $ \\ tv' ->\n                                        ForAllCo tv' k' <$> go c }\n    go (IfaceCoVarCo n)          = CoVarCo <$> go_var n\n    go (IfaceAxiomInstCo n i cs) = AxiomInstCo <$> tcIfaceCoAxiom n <*> pure i <*> mapM go cs\n    go (IfaceUnivCo p r t1 t2)   = UnivCo <$> tcIfaceUnivCoProv p <*> pure r\n                                          <*> tcIfaceType t1 <*> tcIfaceType t2\n    go (IfaceSymCo c)            = SymCo    <$> go c\n    go (IfaceTransCo c1 c2)      = TransCo  <$> go c1\n                                            <*> go c2\n    go (IfaceInstCo c1 t2)       = InstCo   <$> go c1\n                                            <*> go t2\n    go (IfaceNthCo d c)          = do { c' <- go c\n                                      ; return $ mkNthCo (nthCoRole d c') d c' }\n    go (IfaceLRCo lr c)          = LRCo lr  <$> go c\n    go (IfaceKindCo c)           = KindCo   <$> go c\n    go (IfaceSubCo c)            = SubCo    <$> go c\n    go (IfaceAxiomRuleCo ax cos) = AxiomRuleCo <$> tcIfaceCoAxiomRule ax\n                                               <*> mapM go cos\n    go (IfaceFreeCoVar c)        = pprPanic \"tcIfaceCo:IfaceFreeCoVar\" (ppr c)\n    go (IfaceHoleCo c)           = pprPanic \"tcIfaceCo:IfaceHoleCo\"    (ppr c)\n\n    go_var :: FastString -> IfL CoVar\n    go_var = tcIfaceLclId\n\ntcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance\ntcIfaceUnivCoProv IfaceUnsafeCoerceProv     = return UnsafeCoerceProv\ntcIfaceUnivCoProv (IfacePhantomProv kco)    = PhantomProv <$> tcIfaceCo kco\ntcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco\ntcIfaceUnivCoProv (IfacePluginProv str)     = return $ PluginProv str\n\n{-\n************************************************************************\n*                                                                      *\n                        Core\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceExpr :: IfaceExpr -> IfL CoreExpr\ntcIfaceExpr (IfaceType ty)\n  = Type <$> tcIfaceType ty\n\ntcIfaceExpr (IfaceCo co)\n  = Coercion <$> tcIfaceCo co\n\ntcIfaceExpr (IfaceCast expr co)\n  = Cast <$> tcIfaceExpr expr <*> tcIfaceCo co\n\ntcIfaceExpr (IfaceLcl name)\n  = Var <$> tcIfaceLclId name\n\ntcIfaceExpr (IfaceExt gbl)\n  = Var <$> tcIfaceExtId gbl\n\ntcIfaceExpr (IfaceLit lit)\n  = do lit' <- tcIfaceLit lit\n       return (Lit lit')\n\ntcIfaceExpr (IfaceFCall cc ty) = do\n    ty' <- tcIfaceType ty\n    u <- newUnique\n    dflags <- getDynFlags\n    return (Var (mkFCallId dflags u cc ty'))\n\ntcIfaceExpr (IfaceTuple sort args)\n  = do { args' <- mapM tcIfaceExpr args\n       ; tc <- tcTupleTyCon False sort arity\n       ; let con_tys = map exprType args'\n             some_con_args = map Type con_tys ++ args'\n             con_args = case sort of\n               UnboxedTuple -> map (Type . getRuntimeRep) con_tys ++ some_con_args\n               _            -> some_con_args\n                        -- Put the missing type arguments back in\n             con_id   = dataConWorkId (tyConSingleDataCon tc)\n       ; return (mkApps (Var con_id) con_args) }\n  where\n    arity = length args\n\ntcIfaceExpr (IfaceLam (bndr, os) body)\n  = bindIfaceBndr bndr $ \\bndr' ->\n    Lam (tcIfaceOneShot os bndr') <$> tcIfaceExpr body\n  where\n    tcIfaceOneShot IfaceOneShot b = setOneShotLambda b\n    tcIfaceOneShot _            b = b\n\ntcIfaceExpr (IfaceApp fun arg)\n  = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg\n\ntcIfaceExpr (IfaceECase scrut ty)\n  = do { scrut' <- tcIfaceExpr scrut\n       ; ty' <- tcIfaceType ty\n       ; return (castBottomExpr scrut' ty') }\n\ntcIfaceExpr (IfaceCase scrut case_bndr alts)  = do\n    scrut' <- tcIfaceExpr scrut\n    case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)\n    let\n        scrut_ty   = exprType scrut'\n        case_bndr' = mkLocalIdOrCoVar case_bndr_name scrut_ty\n        tc_app     = splitTyConApp scrut_ty\n                -- NB: Won't always succeed (polymorphic case)\n                --     but won't be demanded in those cases\n                -- NB: not tcSplitTyConApp; we are looking at Core here\n                --     look through non-rec newtypes to find the tycon that\n                --     corresponds to the datacon in this case alternative\n\n    extendIfaceIdEnv [case_bndr'] $ do\n     alts' <- mapM (tcIfaceAlt scrut' tc_app) alts\n     return (Case scrut' case_bndr' (coreAltsType alts') alts')\n\ntcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body)\n  = do  { name    <- newIfaceName (mkVarOccFS fs)\n        ; ty'     <- tcIfaceType ty\n        ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}\n                              NotTopLevel name ty' info\n        ; let id = mkLocalIdOrCoVarWithInfo name ty' id_info\n                     `asJoinId_maybe` tcJoinInfo ji\n        ; rhs' <- tcIfaceExpr rhs\n        ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)\n        ; return (Let (NonRec id rhs') body') }\n\ntcIfaceExpr (IfaceLet (IfaceRec pairs) body)\n  = do { ids <- mapM tc_rec_bndr (map fst pairs)\n       ; extendIfaceIdEnv ids $ do\n       { pairs' <- zipWithM tc_pair pairs ids\n       ; body' <- tcIfaceExpr body\n       ; return (Let (Rec pairs') body') } }\n where\n   tc_rec_bndr (IfLetBndr fs ty _ ji)\n     = do { name <- newIfaceName (mkVarOccFS fs)\n          ; ty'  <- tcIfaceType ty\n          ; return (mkLocalIdOrCoVar name ty' `asJoinId_maybe` tcJoinInfo ji) }\n   tc_pair (IfLetBndr _ _ info _, rhs) id\n     = do { rhs' <- tcIfaceExpr rhs\n          ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}\n                                NotTopLevel (idName id) (idType id) info\n          ; return (setIdInfo id id_info, rhs') }\n\ntcIfaceExpr (IfaceTick tickish expr) = do\n    expr' <- tcIfaceExpr expr\n    -- If debug flag is not set: Ignore source notes\n    dbgLvl <- fmap debugLevel getDynFlags\n    case tickish of\n      IfaceSource{} | dbgLvl > 0\n                    -> return expr'\n      _otherwise    -> do\n        tickish' <- tcIfaceTickish tickish\n        return (Tick tickish' expr')\n\n-------------------------\ntcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id)\ntcIfaceTickish (IfaceHpcTick modl ix)   = return (HpcTick modl ix)\ntcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)\ntcIfaceTickish (IfaceSource src name)   = return (SourceNote src name)\n\n-------------------------\ntcIfaceLit :: Literal -> IfL Literal\n-- Integer literals deserialise to (LitInteger i <error thunk>)\n-- so tcIfaceLit just fills in the type.\n-- See Note [Integer literals] in Literal\ntcIfaceLit (LitNumber LitNumInteger i _)\n  = do t <- tcIfaceTyConByName integerTyConName\n       return (mkLitInteger i (mkTyConTy t))\n-- Natural literals deserialise to (LitNatural i <error thunk>)\n-- so tcIfaceLit just fills in the type.\n-- See Note [Natural literals] in Literal\ntcIfaceLit (LitNumber LitNumNatural i _)\n  = do t <- tcIfaceTyConByName naturalTyConName\n       return (mkLitNatural i (mkTyConTy t))\ntcIfaceLit lit = return lit\n\n-------------------------\ntcIfaceAlt :: CoreExpr -> (TyCon, [Type])\n           -> (IfaceConAlt, [FastString], IfaceExpr)\n           -> IfL (AltCon, [TyVar], CoreExpr)\ntcIfaceAlt _ _ (IfaceDefault, names, rhs)\n  = ASSERT( null names ) do\n    rhs' <- tcIfaceExpr rhs\n    return (DEFAULT, [], rhs')\n\ntcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)\n  = ASSERT( null names ) do\n    lit' <- tcIfaceLit lit\n    rhs' <- tcIfaceExpr rhs\n    return (LitAlt lit', [], rhs')\n\n-- A case alternative is made quite a bit more complicated\n-- by the fact that we omit type annotations because we can\n-- work them out.  True enough, but its not that easy!\ntcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)\n  = do  { con <- tcIfaceDataCon data_occ\n        ; when (debugIsOn && not (con `elem` tyConDataCons tycon))\n               (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))\n        ; tcIfaceDataAlt con inst_tys arg_strs rhs }\n\ntcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr\n               -> IfL (AltCon, [TyVar], CoreExpr)\ntcIfaceDataAlt con inst_tys arg_strs rhs\n  = do  { us <- newUniqueSupply\n        ; let uniqs = uniqsFromSupply us\n        ; let (ex_tvs, arg_ids)\n                      = dataConRepFSInstPat arg_strs uniqs con inst_tys\n\n        ; rhs' <- extendIfaceEnvs  ex_tvs       $\n                  extendIfaceIdEnv arg_ids      $\n                  tcIfaceExpr rhs\n        ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }\n\n{-\n************************************************************************\n*                                                                      *\n                IdInfo\n*                                                                      *\n************************************************************************\n-}\n\ntcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails\ntcIdDetails _  IfVanillaId = return VanillaId\ntcIdDetails ty IfDFunId\n  = return (DFunId (isNewTyCon (classTyCon cls)))\n  where\n    (_, _, cls, _) = tcSplitDFunTy ty\n\ntcIdDetails _ (IfRecSelId tc naughty)\n  = do { tc' <- either (fmap RecSelData . tcIfaceTyCon)\n                       (fmap (RecSelPatSyn . tyThingPatSyn) . tcIfaceDecl False)\n                       tc\n       ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }\n  where\n    tyThingPatSyn (AConLike (PatSynCon ps)) = ps\n    tyThingPatSyn _ = panic \"tcIdDetails: expecting patsyn\"\n\ntcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo\ntcIdInfo ignore_prags toplvl name ty info = do\n    lcl_env <- getLclEnv\n    -- Set the CgInfo to something sensible but uninformative before\n    -- we start; default assumption is that it has CAFs\n    let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding\n                  | otherwise       = vanillaIdInfo\n    if ignore_prags\n        then return init_info\n        else case info of\n                NoInfo -> return init_info\n                HasInfo info -> foldlM tcPrag init_info info\n  where\n    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo\n    tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)\n    tcPrag info (HsArity arity)    = return (info `setArityInfo` arity)\n    tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` str)\n    tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)\n    tcPrag info HsLevity           = return (info `setNeverLevPoly` ty)\n\n        -- The next two are lazy, so they don't transitively suck stuff in\n    tcPrag info (HsUnfold lb if_unf)\n      = do { unf <- tcUnfolding toplvl name ty info if_unf\n           ; let info1 | lb        = info `setOccInfo` strongLoopBreaker\n                       | otherwise = info\n           ; return (info1 `setUnfoldingInfo` unf) }\n\ntcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity\ntcJoinInfo (IfaceJoinPoint ar) = Just ar\ntcJoinInfo IfaceNotJoinPoint   = Nothing\n\ntcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding\ntcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr)\n  = do  { dflags <- getDynFlags\n        ; mb_expr <- tcPragExpr toplvl name if_expr\n        ; let unf_src | stable    = InlineStable\n                      | otherwise = InlineRhs\n        ; return $ case mb_expr of\n            Nothing -> NoUnfolding\n            Just expr -> mkUnfolding dflags unf_src\n                           True {- Top level -}\n                           (isBottomingSig strict_sig)\n                           expr\n        }\n  where\n     -- Strictness should occur before unfolding!\n    strict_sig = strictnessInfo info\ntcUnfolding toplvl name _ _ (IfCompulsory if_expr)\n  = do  { mb_expr <- tcPragExpr toplvl name if_expr\n        ; return (case mb_expr of\n                    Nothing   -> NoUnfolding\n                    Just expr -> mkCompulsoryUnfolding expr) }\n\ntcUnfolding toplvl name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)\n  = do  { mb_expr <- tcPragExpr toplvl name if_expr\n        ; return (case mb_expr of\n                    Nothing   -> NoUnfolding\n                    Just expr -> mkCoreUnfolding InlineStable True expr guidance )}\n  where\n    guidance = UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }\n\ntcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops)\n  = bindIfaceBndrs bs $ \\ bs' ->\n    do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops\n       ; return (case mb_ops1 of\n                    Nothing   -> noUnfolding\n                    Just ops1 -> mkDFunUnfolding bs' (classDataCon cls) ops1) }\n  where\n    doc = text \"Class ops for dfun\" <+> ppr name\n    (_, _, cls, _) = tcSplitDFunTy dfun_ty\n\n{-\nFor unfoldings we try to do the job lazily, so that we never type check\nan unfolding that isn't going to be looked at.\n-}\n\ntcPragExpr :: TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)\ntcPragExpr toplvl name expr\n  = forkM_maybe doc $ do\n    core_expr' <- tcIfaceExpr expr\n\n    -- Check for type consistency in the unfolding\n    -- See Note [Linting Unfoldings from Interfaces]\n    when (isTopLevel toplvl) $ whenGOptM Opt_DoCoreLinting $ do\n        in_scope <- get_in_scope\n        dflags   <- getDynFlags\n        case lintUnfolding dflags noSrcLoc in_scope core_expr' of\n          Nothing       -> return ()\n          Just fail_msg -> do { mod <- getIfModule\n                              ; pprPanic \"Iface Lint failure\"\n                                  (vcat [ text \"In interface for\" <+> ppr mod\n                                        , hang doc 2 fail_msg\n                                        , ppr name <+> equals <+> ppr core_expr'\n                                        , text \"Iface expr =\" <+> ppr expr ]) }\n    return core_expr'\n  where\n    doc = text \"Unfolding of\" <+> ppr name\n\n    get_in_scope :: IfL VarSet -- Totally disgusting; but just for linting\n    get_in_scope\n        = do { (gbl_env, lcl_env) <- getEnvs\n             ; rec_ids <- case if_rec_types gbl_env of\n                            Nothing -> return []\n                            Just (_, get_env) -> do\n                               { type_env <- setLclEnv () get_env\n                               ; return (typeEnvIds type_env) }\n             ; return (bindingsVars (if_tv_env lcl_env) `unionVarSet`\n                       bindingsVars (if_id_env lcl_env) `unionVarSet`\n                       mkVarSet rec_ids) }\n\n    bindingsVars :: FastStringEnv Var -> VarSet\n    bindingsVars ufm = mkVarSet $ nonDetEltsUFM ufm\n      -- It's OK to use nonDetEltsUFM here because we immediately forget\n      -- the ordering by creating a set\n\n{-\n************************************************************************\n*                                                                      *\n                Getting from Names to TyThings\n*                                                                      *\n************************************************************************\n-}\n\ntcIfaceGlobal :: Name -> IfL TyThing\ntcIfaceGlobal name\n  | Just thing <- wiredInNameTyThing_maybe name\n        -- Wired-in things include TyCons, DataCons, and Ids\n        -- Even though we are in an interface file, we want to make\n        -- sure the instances and RULES of this thing (particularly TyCon) are loaded\n        -- Imagine: f :: Double -> Double\n  = do { ifCheckWiredInThing thing; return thing }\n\n  | otherwise\n  = do  { env <- getGblEnv\n        ; case if_rec_types env of {    -- Note [Tying the knot]\n            Just (mod, get_type_env)\n                | nameIsLocalOrFrom mod name\n                -> do           -- It's defined in the module being compiled\n                { type_env <- setLclEnv () get_type_env         -- yuk\n                ; case lookupNameEnv type_env name of\n                    Just thing -> return thing\n                    -- See Note [Knot-tying fallback on boot]\n                    Nothing   -> via_external\n                }\n\n          ; _ -> via_external }}\n  where\n    via_external =  do\n        { hsc_env <- getTopEnv\n        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)\n        ; case mb_thing of {\n            Just thing -> return thing ;\n            Nothing    -> do\n\n        { mb_thing <- importDecl name   -- It's imported; go get it\n        ; case mb_thing of\n            Failed err      -> failIfM err\n            Succeeded thing -> return thing\n        }}}\n\n-- Note [Tying the knot]\n-- ~~~~~~~~~~~~~~~~~~~~~\n-- The if_rec_types field is used when we are compiling M.hs, which indirectly\n-- imports Foo.hi, which mentions M.T Then we look up M.T in M's type\n-- environment, which is splatted into if_rec_types after we've built M's type\n-- envt.\n--\n-- This is a dark and complicated part of GHC type checking, with a lot\n-- of moving parts.  Interested readers should also look at:\n--\n--      * Note [Knot-tying typecheckIface]\n--      * Note [DFun knot-tying]\n--      * Note [hsc_type_env_var hack]\n--      * Note [Knot-tying fallback on boot]\n--\n-- There is also a wiki page on the subject, see:\n--\n--      https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TyingTheKnot\n\n-- Note [Knot-tying fallback on boot]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Suppose that you are typechecking A.hs, which transitively imports,\n-- via B.hs, A.hs-boot. When we poke on B.hs and discover that it\n-- has a reference to a type T from A, what TyThing should we wire\n-- it up with? Clearly, if we have already typechecked T and\n-- added it into the type environment, we should go ahead and use that\n-- type. But what if we haven't typechecked it yet?\n--\n-- For the longest time, GHC adopted the policy that this was\n-- *an error condition*; that you MUST NEVER poke on B.hs's reference\n-- to a T defined in A.hs until A.hs has gotten around to kind-checking\n-- T and adding it to the env. However, actually ensuring this is the\n-- case has proven to be a bug farm, because it's really difficult to\n-- actually ensure this never happens. The problem was especially poignant\n-- with type family consistency checks, which eagerly happen before any\n-- typechecking takes place.\n--\n-- Today, we take a different strategy: if we ever try to access\n-- an entity from A which doesn't exist, we just fall back on the\n-- definition of A from the hs-boot file. This is complicated in\n-- its own way: it means that you may end up with a mix of A.hs and\n-- A.hs-boot TyThings during the course of typechecking.  We don't\n-- think (and have not observed) any cases where this would cause\n-- problems, but the hypothetical situation one might worry about\n-- is something along these lines in Core:\n--\n--    case x of\n--        A -> e1\n--        B -> e2\n--\n-- If, when typechecking this, we find x :: T, and the T we are hooked\n-- up with is the abstract one from the hs-boot file, rather than the\n-- one defined in this module with constructors A and B.  But it's hard\n-- to see how this could happen, especially because the reference to\n-- the constructor (A and B) means that GHC will always typecheck\n-- this expression *after* typechecking T.\n\ntcIfaceTyConByName :: IfExtName -> IfL TyCon\ntcIfaceTyConByName name\n  = do { thing <- tcIfaceGlobal name\n       ; return (tyThingTyCon thing) }\n\ntcIfaceTyCon :: IfaceTyCon -> IfL TyCon\ntcIfaceTyCon (IfaceTyCon name info)\n  = do { thing <- tcIfaceGlobal name\n       ; return $ case ifaceTyConIsPromoted info of\n           NotPromoted -> tyThingTyCon thing\n           IsPromoted    -> promoteDataCon $ tyThingDataCon thing }\n\ntcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)\ntcIfaceCoAxiom name = do { thing <- tcIfaceImplicit name\n                         ; return (tyThingCoAxiom thing) }\n\n\ntcIfaceCoAxiomRule :: IfLclName -> IfL CoAxiomRule\n-- Unlike CoAxioms, which arise form user 'type instance' declarations,\n-- there are a fixed set of CoAxiomRules,\n-- currently enumerated in typeNatCoAxiomRules\ntcIfaceCoAxiomRule n\n  = case Map.lookup n typeNatCoAxiomRules of\n        Just ax -> return ax\n        _  -> pprPanic \"tcIfaceCoAxiomRule\" (ppr n)\n\ntcIfaceDataCon :: Name -> IfL DataCon\ntcIfaceDataCon name = do { thing <- tcIfaceGlobal name\n                         ; case thing of\n                                AConLike (RealDataCon dc) -> return dc\n                                _       -> pprPanic \"tcIfaceExtDC\" (ppr name$$ ppr thing) }\n\ntcIfaceExtId :: Name -> IfL Id\ntcIfaceExtId name = do { thing <- tcIfaceGlobal name\n                       ; case thing of\n                          AnId id -> return id\n                          _       -> pprPanic \"tcIfaceExtId\" (ppr name$$ ppr thing) }\n\n-- See Note [Resolving never-exported Names in TcIface]\ntcIfaceImplicit :: Name -> IfL TyThing\ntcIfaceImplicit n = do\n    lcl_env <- getLclEnv\n    case if_implicits_env lcl_env of\n        Nothing -> tcIfaceGlobal n\n        Just tenv ->\n            case lookupTypeEnv tenv n of\n                Nothing -> pprPanic \"tcIfaceInst\" (ppr n $$ ppr tenv)\n                Just tything -> return tything\n\n{-\n************************************************************************\n*                                                                      *\n                Bindings\n*                                                                      *\n************************************************************************\n-}\n\nbindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a\nbindIfaceId (fs, ty) thing_inside\n  = do  { name <- newIfaceName (mkVarOccFS fs)\n        ; ty' <- tcIfaceType ty\n        ; let id = mkLocalIdOrCoVar name ty'\n        ; extendIfaceIdEnv [id] (thing_inside id) }\n\nbindIfaceIds :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a\nbindIfaceIds [] thing_inside = thing_inside []\nbindIfaceIds (b:bs) thing_inside\n  = bindIfaceId b   $ \\b'  ->\n    bindIfaceIds bs $ \\bs' ->\n    thing_inside (b':bs')\n\nbindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a\nbindIfaceBndr (IfaceIdBndr bndr) thing_inside\n  = bindIfaceId bndr thing_inside\nbindIfaceBndr (IfaceTvBndr bndr) thing_inside\n  = bindIfaceTyVar bndr thing_inside\n\nbindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a\nbindIfaceBndrs []     thing_inside = thing_inside []\nbindIfaceBndrs (b:bs) thing_inside\n  = bindIfaceBndr b     $ \\ b' ->\n    bindIfaceBndrs bs   $ \\ bs' ->\n    thing_inside (b':bs')\n\n-----------------------\nbindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a\nbindIfaceForAllBndrs [] thing_inside = thing_inside []\nbindIfaceForAllBndrs (bndr:bndrs) thing_inside\n  = bindIfaceForAllBndr bndr $ \\tv vis ->\n    bindIfaceForAllBndrs bndrs $ \\bndrs' ->\n    thing_inside (mkTyCoVarBinder vis tv : bndrs')\n\nbindIfaceForAllBndr :: IfaceForAllBndr -> (TyCoVar -> ArgFlag -> IfL a) -> IfL a\nbindIfaceForAllBndr (Bndr (IfaceTvBndr tv) vis) thing_inside\n  = bindIfaceTyVar tv $ \\tv' -> thing_inside tv' vis\nbindIfaceForAllBndr (Bndr (IfaceIdBndr tv) vis) thing_inside\n  = bindIfaceId tv $ \\tv' -> thing_inside tv' vis\n\nbindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a\nbindIfaceTyVar (occ,kind) thing_inside\n  = do  { name <- newIfaceName (mkTyVarOccFS occ)\n        ; tyvar <- mk_iface_tyvar name kind\n        ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }\n\nbindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a\nbindIfaceTyVars [] thing_inside = thing_inside []\nbindIfaceTyVars (bndr:bndrs) thing_inside\n  = bindIfaceTyVar bndr   $ \\tv  ->\n    bindIfaceTyVars bndrs $ \\tvs ->\n    thing_inside (tv : tvs)\n\nmk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar\nmk_iface_tyvar name ifKind\n   = do { kind <- tcIfaceType ifKind\n        ; return (Var.mkTyVar name kind) }\n\nbindIfaceTyConBinders :: [IfaceTyConBinder]\n                      -> ([TyConBinder] -> IfL a) -> IfL a\nbindIfaceTyConBinders [] thing_inside = thing_inside []\nbindIfaceTyConBinders (b:bs) thing_inside\n  = bindIfaceTyConBinderX bindIfaceBndr b $ \\ b'  ->\n    bindIfaceTyConBinders bs              $ \\ bs' ->\n    thing_inside (b':bs')\n\nbindIfaceTyConBinders_AT :: [IfaceTyConBinder]\n                         -> ([TyConBinder] -> IfL a) -> IfL a\n-- Used for type variable in nested associated data/type declarations\n-- where some of the type variables are already in scope\n--    class C a where { data T a b }\n-- Here 'a' is in scope when we look at the 'data T'\nbindIfaceTyConBinders_AT [] thing_inside\n  = thing_inside []\nbindIfaceTyConBinders_AT (b : bs) thing_inside\n  = bindIfaceTyConBinderX bind_tv b  $ \\b'  ->\n    bindIfaceTyConBinders_AT      bs $ \\bs' ->\n    thing_inside (b':bs')\n  where\n    bind_tv tv thing\n      = do { mb_tv <- lookupIfaceVar tv\n           ; case mb_tv of\n               Just b' -> thing b'\n               Nothing -> bindIfaceBndr tv thing }\n\nbindIfaceTyConBinderX :: (IfaceBndr -> (TyCoVar -> IfL a) -> IfL a)\n                      -> IfaceTyConBinder\n                      -> (TyConBinder -> IfL a) -> IfL a\nbindIfaceTyConBinderX bind_tv (Bndr tv vis) thing_inside\n  = bind_tv tv $ \\tv' ->\n    thing_inside (Bndr tv' vis)\n", "num_lines": 1822}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- | Functions for converting Core things to interface file things.\nmodule ToIface\n    ( -- * Binders\n      toIfaceTvBndr\n    , toIfaceTvBndrs\n    , toIfaceIdBndr\n    , toIfaceBndr\n    , toIfaceForAllBndr\n    , toIfaceTyCoVarBinders\n    , toIfaceTyVar\n      -- * Types\n    , toIfaceType, toIfaceTypeX\n    , toIfaceKind\n    , toIfaceTcArgs\n    , toIfaceTyCon\n    , toIfaceTyCon_name\n    , toIfaceTyLit\n      -- * Tidying types\n    , tidyToIfaceType\n    , tidyToIfaceContext\n    , tidyToIfaceTcArgs\n      -- * Coercions\n    , toIfaceCoercion, toIfaceCoercionX\n      -- * Pattern synonyms\n    , patSynToIfaceDecl\n      -- * Expressions\n    , toIfaceExpr\n    , toIfaceBang\n    , toIfaceSrcBang\n    , toIfaceLetBndr\n    , toIfaceIdDetails\n    , toIfaceIdInfo\n    , toIfUnfolding\n    , toIfaceOneShot\n    , toIfaceTickish\n    , toIfaceBind\n    , toIfaceAlt\n    , toIfaceCon\n    , toIfaceApp\n    , toIfaceVar\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport IfaceSyn\nimport DataCon\nimport Id\nimport IdInfo\nimport CoreSyn\nimport TyCon hiding ( pprPromotionQuote )\nimport CoAxiom\nimport TysPrim ( eqPrimTyCon, eqReprPrimTyCon )\nimport TysWiredIn ( heqTyCon )\nimport MkId ( noinlineIdName )\nimport PrelNames\nimport Name\nimport BasicTypes\nimport Type\nimport PatSyn\nimport Outputable\nimport FastString\nimport Util\nimport Var\nimport VarEnv\nimport VarSet\nimport TyCoRep\nimport Demand ( isTopSig )\n\nimport Data.Maybe ( catMaybes )\n\n----------------\ntoIfaceTvBndr :: TyVar -> IfaceTvBndr\ntoIfaceTvBndr = toIfaceTvBndrX emptyVarSet\n\ntoIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr\ntoIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar)\n                          , toIfaceTypeX fr (tyVarKind tyvar)\n                          )\n\ntoIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]\ntoIfaceTvBndrs = map toIfaceTvBndr\n\ntoIfaceIdBndr :: Id -> IfaceIdBndr\ntoIfaceIdBndr = toIfaceIdBndrX emptyVarSet\n\ntoIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr\ntoIfaceIdBndrX fr covar = ( occNameFS (getOccName covar)\n                          , toIfaceTypeX fr (varType covar)\n                          )\n\ntoIfaceBndr :: Var -> IfaceBndr\ntoIfaceBndr var\n  | isId var  = IfaceIdBndr (toIfaceIdBndr var)\n  | otherwise = IfaceTvBndr (toIfaceTvBndr var)\n\ntoIfaceBndrX :: VarSet -> Var -> IfaceBndr\ntoIfaceBndrX fr var\n  | isId var  = IfaceIdBndr (toIfaceIdBndrX fr var)\n  | otherwise = IfaceTvBndr (toIfaceTvBndrX fr var)\n\ntoIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis\ntoIfaceTyCoVarBinder (Bndr tv vis) = Bndr (toIfaceBndr tv) vis\n\ntoIfaceTyCoVarBinders :: [VarBndr Var vis] -> [VarBndr IfaceBndr vis]\ntoIfaceTyCoVarBinders = map toIfaceTyCoVarBinder\n\n{-\n************************************************************************\n*                                                                      *\n        Conversion from Type to IfaceType\n*                                                                      *\n************************************************************************\n-}\n\ntoIfaceKind :: Type -> IfaceType\ntoIfaceKind = toIfaceType\n\n---------------------\ntoIfaceType :: Type -> IfaceType\ntoIfaceType = toIfaceTypeX emptyVarSet\n\ntoIfaceTypeX :: VarSet -> Type -> IfaceType\n-- (toIfaceTypeX free ty)\n--    translates the tyvars in 'free' as IfaceFreeTyVars\n--\n-- Synonyms are retained in the interface type\ntoIfaceTypeX fr (TyVarTy tv)   -- See Note [TcTyVars in IfaceType] in IfaceType\n  | tv `elemVarSet` fr         = IfaceFreeTyVar tv\n  | otherwise                  = IfaceTyVar (toIfaceTyVar tv)\ntoIfaceTypeX fr ty@(AppTy {})  =\n  -- Flatten as many argument AppTys as possible, then turn them into an\n  -- IfaceAppArgs list.\n  -- See Note [Suppressing invisible arguments] in IfaceType.\n  let (head, args) = splitAppTys ty\n  in IfaceAppTy (toIfaceTypeX fr head) (toIfaceAppTyArgsX fr head args)\ntoIfaceTypeX _  (LitTy n)      = IfaceLitTy (toIfaceTyLit n)\ntoIfaceTypeX fr (ForAllTy b t) = IfaceForAllTy (toIfaceForAllBndrX fr b)\n                                               (toIfaceTypeX (fr `delVarSet` binderVar b) t)\ntoIfaceTypeX fr (FunTy { ft_arg = t1, ft_res = t2, ft_af = af })\n  = IfaceFunTy af (toIfaceTypeX fr t1) (toIfaceTypeX fr t2)\ntoIfaceTypeX fr (CastTy ty co)  = IfaceCastTy (toIfaceTypeX fr ty) (toIfaceCoercionX fr co)\ntoIfaceTypeX fr (CoercionTy co) = IfaceCoercionTy (toIfaceCoercionX fr co)\n\ntoIfaceTypeX fr (TyConApp tc tys)\n    -- tuples\n  | Just sort <- tyConTuple_maybe tc\n  , n_tys == arity\n  = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys)\n\n  | Just dc <- isPromotedDataCon_maybe tc\n  , isTupleDataCon dc\n  , n_tys == 2*arity\n  = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys))\n\n  | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ]\n  , (k1:k2:_) <- tys\n  = let info = IfaceTyConInfo NotPromoted sort\n        sort | k1 `eqType` k2 = IfaceEqualityTyCon\n             | otherwise      = IfaceNormalTyCon\n    in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys)\n\n    -- other applications\n  | otherwise\n  = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgsX fr tc tys)\n  where\n    arity = tyConArity tc\n    n_tys = length tys\n\ntoIfaceTyVar :: TyVar -> FastString\ntoIfaceTyVar = occNameFS . getOccName\n\ntoIfaceCoVar :: CoVar -> FastString\ntoIfaceCoVar = occNameFS . getOccName\n\ntoIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr\ntoIfaceForAllBndr = toIfaceForAllBndrX emptyVarSet\n\ntoIfaceForAllBndrX :: VarSet -> TyCoVarBinder -> IfaceForAllBndr\ntoIfaceForAllBndrX fr (Bndr v vis) = Bndr (toIfaceBndrX fr v) vis\n\n----------------\ntoIfaceTyCon :: TyCon -> IfaceTyCon\ntoIfaceTyCon tc\n  = IfaceTyCon tc_name info\n  where\n    tc_name = tyConName tc\n    info    = IfaceTyConInfo promoted sort\n    promoted | isPromotedDataCon tc = IsPromoted\n             | otherwise            = NotPromoted\n\n    tupleSort :: TyCon -> Maybe IfaceTyConSort\n    tupleSort tc' =\n        case tyConTuple_maybe tc' of\n          Just UnboxedTuple -> let arity = tyConArity tc' `div` 2\n                               in Just $ IfaceTupleTyCon arity UnboxedTuple\n          Just sort         -> let arity = tyConArity tc'\n                               in Just $ IfaceTupleTyCon arity sort\n          Nothing           -> Nothing\n\n    sort\n      | Just tsort <- tupleSort tc           = tsort\n\n      | Just dcon <- isPromotedDataCon_maybe tc\n      , let tc' = dataConTyCon dcon\n      , Just tsort <- tupleSort tc'          = tsort\n\n      | isUnboxedSumTyCon tc\n      , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons)\n\n      | otherwise                            = IfaceNormalTyCon\n\n\ntoIfaceTyCon_name :: Name -> IfaceTyCon\ntoIfaceTyCon_name n = IfaceTyCon n info\n  where info = IfaceTyConInfo NotPromoted IfaceNormalTyCon\n  -- Used for the \"rough-match\" tycon stuff,\n  -- where pretty-printing is not an issue\n\ntoIfaceTyLit :: TyLit -> IfaceTyLit\ntoIfaceTyLit (NumTyLit x) = IfaceNumTyLit x\ntoIfaceTyLit (StrTyLit x) = IfaceStrTyLit x\n\n----------------\ntoIfaceCoercion :: Coercion -> IfaceCoercion\ntoIfaceCoercion = toIfaceCoercionX emptyVarSet\n\ntoIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion\n-- (toIfaceCoercionX free ty)\n--    translates the tyvars in 'free' as IfaceFreeTyVars\ntoIfaceCoercionX fr co\n  = go co\n  where\n    go_mco MRefl     = IfaceMRefl\n    go_mco (MCo co)  = IfaceMCo $ go co\n\n    go (Refl ty)            = IfaceReflCo (toIfaceTypeX fr ty)\n    go (GRefl r ty mco)     = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco)\n    go (CoVarCo cv)\n      -- See [TcTyVars in IfaceType] in IfaceType\n      | cv `elemVarSet` fr  = IfaceFreeCoVar cv\n      | otherwise           = IfaceCoVarCo (toIfaceCoVar cv)\n    go (HoleCo h)           = IfaceHoleCo  (coHoleCoVar h)\n\n    go (AppCo co1 co2)      = IfaceAppCo  (go co1) (go co2)\n    go (SymCo co)           = IfaceSymCo (go co)\n    go (TransCo co1 co2)    = IfaceTransCo (go co1) (go co2)\n    go (NthCo _r d co)      = IfaceNthCo d (go co)\n    go (LRCo lr co)         = IfaceLRCo lr (go co)\n    go (InstCo co arg)      = IfaceInstCo (go co) (go arg)\n    go (KindCo c)           = IfaceKindCo (go c)\n    go (SubCo co)           = IfaceSubCo (go co)\n    go (AxiomRuleCo co cs)  = IfaceAxiomRuleCo (coaxrName co) (map go cs)\n    go (AxiomInstCo c i cs) = IfaceAxiomInstCo (coAxiomName c) i (map go cs)\n    go (UnivCo p r t1 t2)   = IfaceUnivCo (go_prov p) r\n                                          (toIfaceTypeX fr t1)\n                                          (toIfaceTypeX fr t2)\n    go (TyConAppCo r tc cos)\n      | tc `hasKey` funTyConKey\n      , [_,_,_,_] <- cos         = pprPanic \"toIfaceCoercion\" (ppr co)\n      | otherwise                = IfaceTyConAppCo r (toIfaceTyCon tc) (map go cos)\n    go (FunCo r co1 co2)   = IfaceFunCo r (go co1) (go co2)\n\n    go (ForAllCo tv k co) = IfaceForAllCo (toIfaceBndr tv)\n                                          (toIfaceCoercionX fr' k)\n                                          (toIfaceCoercionX fr' co)\n                          where\n                            fr' = fr `delVarSet` tv\n\n    go_prov :: UnivCoProvenance -> IfaceUnivCoProv\n    go_prov UnsafeCoerceProv    = IfaceUnsafeCoerceProv\n    go_prov (PhantomProv co)    = IfacePhantomProv (go co)\n    go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co)\n    go_prov (PluginProv str)    = IfacePluginProv str\n\ntoIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs\ntoIfaceTcArgs = toIfaceTcArgsX emptyVarSet\n\ntoIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs\ntoIfaceTcArgsX fr tc ty_args = toIfaceAppArgsX fr (tyConKind tc) ty_args\n\ntoIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs\ntoIfaceAppTyArgsX fr ty ty_args = toIfaceAppArgsX fr (typeKind ty) ty_args\n\ntoIfaceAppArgsX :: VarSet -> Kind -> [Type] -> IfaceAppArgs\n-- See Note [Suppressing invisible arguments] in IfaceType\n-- We produce a result list of args describing visibility\n-- The awkward case is\n--    T :: forall k. * -> k\n-- And consider\n--    T (forall j. blah) * blib\n-- Is 'blib' visible?  It depends on the visibility flag on j,\n-- so we have to substitute for k.  Annoying!\ntoIfaceAppArgsX fr kind ty_args\n  = go (mkEmptyTCvSubst in_scope) kind ty_args\n  where\n    in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)\n\n    go _   _                   []     = IA_Nil\n    go env ty                  ts\n      | Just ty' <- coreView ty\n      = go env ty' ts\n    go env (ForAllTy (Bndr tv vis) res) (t:ts)\n      = IA_Arg t' vis ts'\n      where\n        t'  = toIfaceTypeX fr t\n        ts' = go (extendTCvSubst env tv t) res ts\n\n    go env (FunTy { ft_res = res }) (t:ts) -- No type-class args in tycon apps\n      = IA_Arg (toIfaceTypeX fr t) Required (go env res ts)\n\n    go env ty ts@(t1:ts1)\n      | not (isEmptyTCvSubst env)\n      = go (zapTCvSubst env) (substTy env ty) ts\n        -- See Note [Care with kind instantiation] in Type.hs\n\n      | otherwise\n      = -- There's a kind error in the type we are trying to print\n        -- e.g. kind = k, ty_args = [Int]\n        -- This is probably a compiler bug, so we print a trace and\n        -- carry on as if it were FunTy.  Without the test for\n        -- isEmptyTCvSubst we'd get an infinite loop (Trac #15473)\n        WARN( True, ppr kind $$ ppr ty_args )\n        IA_Arg (toIfaceTypeX fr t1) Required (go env ty ts1)\n\ntidyToIfaceType :: TidyEnv -> Type -> IfaceType\ntidyToIfaceType env ty = toIfaceType (tidyType env ty)\n\ntidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs\ntidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)\n\ntidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext\ntidyToIfaceContext env theta = map (tidyToIfaceType env) theta\n\n{-\n************************************************************************\n*                                                                      *\n        Conversion of pattern synonyms\n*                                                                      *\n************************************************************************\n-}\n\npatSynToIfaceDecl :: PatSyn -> IfaceDecl\npatSynToIfaceDecl ps\n  = IfacePatSyn { ifName          = getName $ ps\n                , ifPatMatcher    = to_if_pr (patSynMatcher ps)\n                , ifPatBuilder    = fmap to_if_pr (patSynBuilder ps)\n                , ifPatIsInfix    = patSynIsInfix ps\n                , ifPatUnivBndrs  = map toIfaceForAllBndr univ_bndrs'\n                , ifPatExBndrs    = map toIfaceForAllBndr ex_bndrs'\n                , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta\n                , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta\n                , ifPatArgs       = map (tidyToIfaceType env2) args\n                , ifPatTy         = tidyToIfaceType env2 rhs_ty\n                , ifFieldLabels   = (patSynFieldLabels ps)\n                }\n  where\n    (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps\n    univ_bndrs = patSynUnivTyVarBinders ps\n    ex_bndrs   = patSynExTyVarBinders ps\n    (env1, univ_bndrs') = tidyTyCoVarBinders emptyTidyEnv univ_bndrs\n    (env2, ex_bndrs')   = tidyTyCoVarBinders env1 ex_bndrs\n    to_if_pr (id, needs_dummy) = (idName id, needs_dummy)\n\n{-\n************************************************************************\n*                                                                      *\n        Conversion of other things\n*                                                                      *\n************************************************************************\n-}\n\ntoIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang\ntoIfaceBang _    HsLazy              = IfNoBang\ntoIfaceBang _   (HsUnpack Nothing)   = IfUnpack\ntoIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))\ntoIfaceBang _   HsStrict             = IfStrict\n\ntoIfaceSrcBang :: HsSrcBang -> IfaceSrcBang\ntoIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang\n\ntoIfaceLetBndr :: Id -> IfaceLetBndr\ntoIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))\n                               (toIfaceType (idType id))\n                               (toIfaceIdInfo (idInfo id))\n                               (toIfaceJoinInfo (isJoinId_maybe id))\n  -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr\n  -- has left on the Id.  See Note [IdInfo on nested let-bindings] in IfaceSyn\n\ntoIfaceIdDetails :: IdDetails -> IfaceIdDetails\ntoIfaceIdDetails VanillaId                      = IfVanillaId\ntoIfaceIdDetails (DFunId {})                    = IfDFunId\ntoIfaceIdDetails (RecSelId { sel_naughty = n\n                           , sel_tycon = tc })  =\n  let iface = case tc of\n                RecSelData ty_con -> Left (toIfaceTyCon ty_con)\n                RecSelPatSyn pat_syn -> Right (patSynToIfaceDecl pat_syn)\n  in IfRecSelId iface n\n\n  -- The remaining cases are all \"implicit Ids\" which don't\n  -- appear in interface files at all\ntoIfaceIdDetails other = pprTrace \"toIfaceIdDetails\" (ppr other)\n                         IfVanillaId   -- Unexpected; the other\n\ntoIfaceIdInfo :: IdInfo -> IfaceIdInfo\ntoIfaceIdInfo id_info\n  = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,\n                    inline_hsinfo,  unfold_hsinfo, levity_hsinfo] of\n       []    -> NoInfo\n       infos -> HasInfo infos\n               -- NB: strictness and arity must appear in the list before unfolding\n               -- See TcIface.tcUnfolding\n  where\n    ------------  Arity  --------------\n    arity_info = arityInfo id_info\n    arity_hsinfo | arity_info == 0 = Nothing\n                 | otherwise       = Just (HsArity arity_info)\n\n    ------------ Caf Info --------------\n    caf_info   = cafInfo id_info\n    caf_hsinfo = case caf_info of\n                   NoCafRefs -> Just HsNoCafRefs\n                   _other    -> Nothing\n\n    ------------  Strictness  --------------\n        -- No point in explicitly exporting TopSig\n    sig_info = strictnessInfo id_info\n    strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)\n                  | otherwise               = Nothing\n\n    ------------  Unfolding  --------------\n    unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)\n    loop_breaker  = isStrongLoopBreaker (occInfo id_info)\n\n    ------------  Inline prag  --------------\n    inline_prag = inlinePragInfo id_info\n    inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing\n                  | otherwise = Just (HsInline inline_prag)\n\n    ------------  Levity polymorphism  ----------\n    levity_hsinfo | isNeverLevPolyIdInfo id_info = Just HsLevity\n                  | otherwise                    = Nothing\n\ntoIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo\ntoIfaceJoinInfo (Just ar) = IfaceJoinPoint ar\ntoIfaceJoinInfo Nothing   = IfaceNotJoinPoint\n\n--------------------------\ntoIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem\ntoIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs\n                                , uf_src = src\n                                , uf_guidance = guidance })\n  = Just $ HsUnfold lb $\n    case src of\n        InlineStable\n          -> case guidance of\n               UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok =  boring_ok }\n                      -> IfInlineRule arity unsat_ok boring_ok if_rhs\n               _other -> IfCoreUnfold True if_rhs\n        InlineCompulsory -> IfCompulsory if_rhs\n        InlineRhs        -> IfCoreUnfold False if_rhs\n        -- Yes, even if guidance is UnfNever, expose the unfolding\n        -- If we didn't want to expose the unfolding, TidyPgm would\n        -- have stuck in NoUnfolding.  For supercompilation we want\n        -- to see that unfolding!\n  where\n    if_rhs = toIfaceExpr rhs\n\ntoIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })\n  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))\n      -- No need to serialise the data constructor;\n      -- we can recover it from the type of the dfun\n\ntoIfUnfolding _ (OtherCon {}) = Nothing\n  -- The binding site of an Id doesn't have OtherCon, except perhaps\n  -- where we have called zapUnfolding; and that evald'ness info is\n  -- not needed by importing modules\n\ntoIfUnfolding _ BootUnfolding = Nothing\n  -- Can't happen; we only have BootUnfolding for imported binders\n\ntoIfUnfolding _ NoUnfolding = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n        Conversion of expressions\n*                                                                      *\n************************************************************************\n-}\n\ntoIfaceExpr :: CoreExpr -> IfaceExpr\ntoIfaceExpr (Var v)         = toIfaceVar v\ntoIfaceExpr (Lit l)         = IfaceLit l\ntoIfaceExpr (Type ty)       = IfaceType (toIfaceType ty)\ntoIfaceExpr (Coercion co)   = IfaceCo   (toIfaceCoercion co)\ntoIfaceExpr (Lam x b)       = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b)\ntoIfaceExpr (App f a)       = toIfaceApp f [a]\ntoIfaceExpr (Case s x ty as)\n  | null as                 = IfaceECase (toIfaceExpr s) (toIfaceType ty)\n  | otherwise               = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)\ntoIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e)\ntoIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)\ntoIfaceExpr (Tick t e)\n  | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e)\n  | otherwise                   = toIfaceExpr e\n\ntoIfaceOneShot :: Id -> IfaceOneShot\ntoIfaceOneShot id | isId id\n                  , OneShotLam <- oneShotInfo (idInfo id)\n                  = IfaceOneShot\n                  | otherwise\n                  = IfaceNoOneShot\n\n---------------------\ntoIfaceTickish :: Tickish Id -> Maybe IfaceTickish\ntoIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)\ntoIfaceTickish (HpcTick modl ix)       = Just (IfaceHpcTick modl ix)\ntoIfaceTickish (SourceNote src names)  = Just (IfaceSource src names)\ntoIfaceTickish (Breakpoint {})         = Nothing\n   -- Ignore breakpoints, since they are relevant only to GHCi, and\n   -- should not be serialised (Trac #8333)\n\n---------------------\ntoIfaceBind :: Bind Id -> IfaceBinding\ntoIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)\ntoIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]\n\n---------------------\ntoIfaceAlt :: (AltCon, [Var], CoreExpr)\n           -> (IfaceConAlt, [FastString], IfaceExpr)\ntoIfaceAlt (c,bs,r) = (toIfaceCon c, map getOccFS bs, toIfaceExpr r)\n\n---------------------\ntoIfaceCon :: AltCon -> IfaceConAlt\ntoIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)\ntoIfaceCon (LitAlt l)   = IfaceLitAlt l\ntoIfaceCon DEFAULT      = IfaceDefault\n\n---------------------\ntoIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr\ntoIfaceApp (App f a) as = toIfaceApp f (a:as)\ntoIfaceApp (Var v) as\n  = case isDataConWorkId_maybe v of\n        -- We convert the *worker* for tuples into IfaceTuples\n        Just dc |  saturated\n                ,  Just tup_sort <- tyConTuple_maybe tc\n                -> IfaceTuple tup_sort tup_args\n          where\n            val_args  = dropWhile isTypeArg as\n            saturated = val_args `lengthIs` idArity v\n            tup_args  = map toIfaceExpr val_args\n            tc        = dataConTyCon dc\n\n        _ -> mkIfaceApps (toIfaceVar v) as\n\ntoIfaceApp e as = mkIfaceApps (toIfaceExpr e) as\n\nmkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr\nmkIfaceApps f as = foldl' (\\f a -> IfaceApp f (toIfaceExpr a)) f as\n\n---------------------\ntoIfaceVar :: Id -> IfaceExpr\ntoIfaceVar v\n    | isBootUnfolding (idUnfolding v)\n    = -- See Note [Inlining and hs-boot files]\n      IfaceApp (IfaceApp (IfaceExt noinlineIdName)\n                         (IfaceType (toIfaceType (idType v))))\n               (IfaceExt name) -- don't use mkIfaceApps, or infinite loop\n\n    | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))\n                                      -- Foreign calls have special syntax\n\n    | isExternalName name             = IfaceExt name\n    | otherwise                       = IfaceLcl (getOccFS name)\n  where name = idName v\n\n\n{- Note [Inlining and hs-boot files]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this example (Trac #10083, #12789):\n\n    ---------- RSR.hs-boot ------------\n    module RSR where\n      data RSR\n      eqRSR :: RSR -> RSR -> Bool\n\n    ---------- SR.hs ------------\n    module SR where\n      import {-# SOURCE #-} RSR\n      data SR = MkSR RSR\n      eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2\n\n    ---------- RSR.hs ------------\n    module RSR where\n      import SR\n      data RSR = MkRSR SR -- deriving( Eq )\n      eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)\n      foo x y = not (eqRSR x y)\n\nWhen compiling RSR we get this code\n\n    RSR.eqRSR :: RSR -> RSR -> Bool\n    RSR.eqRSR = \\ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->\n                case ds1 of _ { RSR.MkRSR s1 ->\n                case ds2 of _ { RSR.MkRSR s2 ->\n                SR.eqSR s1 s2 }}\n\n    RSR.foo :: RSR -> RSR -> Bool\n    RSR.foo = \\ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)\n\nNow, when optimising foo:\n    Inline eqRSR (small, non-rec)\n    Inline eqSR  (small, non-rec)\nbut the result of inlining eqSR from SR is another call to eqRSR, so\neverything repeats.  Neither eqSR nor eqRSR are (apparently) loop\nbreakers.\n\nSolution: in the unfolding of eqSR in SR.hi, replace `eqRSR` in SR\nwith `noinline eqRSR`, so that eqRSR doesn't get inlined.  This means\nthat when GHC inlines `eqSR`, it will not also inline `eqRSR`, exactly\nas would have been the case if `foo` had been defined in SR.hs (and\nmarked as a loop-breaker).\n\nBut how do we arrange for this to happen?  There are two ingredients:\n\n    1. When we serialize out unfoldings to IfaceExprs (toIfaceVar),\n    for every variable reference we see if we are referring to an\n    'Id' that came from an hs-boot file.  If so, we add a `noinline`\n    to the reference.\n\n    2. But how do we know if a reference came from an hs-boot file\n    or not?  We could record this directly in the 'IdInfo', but\n    actually we deduce this by looking at the unfolding: 'Id's\n    that come from boot files are given a special unfolding\n    (upon typechecking) 'BootUnfolding' which say that there is\n    no unfolding, and the reason is because the 'Id' came from\n    a boot file.\n\nHere is a solution that doesn't work: when compiling RSR,\nadd a NOINLINE pragma to every function exported by the boot-file\nfor RSR (if it exists).  Doing so makes the bootstrapped GHC itself\nslower by 8% overall (on Trac #9872a-d, and T1969: the reason\nis that these NOINLINE'd functions now can't be profitably inlined\noutside of the hs-boot loop.\n\n-}\n", "num_lines": 651}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- ----------------------------------------------------------------------------\n-- | This module supplies bindings to generate Llvm IR from Haskell\n-- (<http://www.llvm.org/docs/LangRef.html>).\n--\n-- Note: this module is developed in a demand driven way. It is no complete\n-- LLVM binding library in Haskell, but enough to generate code for GHC.\n--\n-- This code is derived from code taken from the Essential Haskell Compiler\n-- (EHC) project (<http://www.cs.uu.nl/wiki/Ehc/WebHome>).\n--\n\nmodule Llvm (\n\n        -- * Modules, Functions and Blocks\n        LlvmModule(..),\n\n        LlvmFunction(..), LlvmFunctionDecl(..),\n        LlvmFunctions, LlvmFunctionDecls,\n        LlvmStatement(..), LlvmExpression(..),\n        LlvmBlocks, LlvmBlock(..), LlvmBlockId,\n        LlvmParamAttr(..), LlvmParameter,\n\n        -- * Atomic operations\n        LlvmAtomicOp(..),\n\n        -- * Fence synchronization\n        LlvmSyncOrdering(..),\n\n        -- * Call Handling\n        LlvmCallConvention(..), LlvmCallType(..), LlvmParameterListType(..),\n        LlvmLinkageType(..), LlvmFuncAttr(..),\n\n        -- * Operations and Comparisons\n        LlvmCmpOp(..), LlvmMachOp(..), LlvmCastOp(..),\n\n        -- * Variables and Type System\n        LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..),\n        LlvmAlias, LMGlobal(..), LMString, LMSection, LMAlign,\n        LMConst(..),\n\n        -- ** Some basic types\n        i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,\n\n        -- ** Metadata types\n        MetaExpr(..), MetaAnnot(..), MetaDecl(..), MetaId(..),\n\n        -- ** Operations on the type system.\n        isGlobal, getLitType, getVarType,\n        getLink, getStatType, pVarLift, pVarLower,\n        pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits,\n\n        -- * Pretty Printing\n        ppLit, ppName, ppPlainName,\n        ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals,\n        ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions,\n        ppLlvmFunction, ppLlvmAlias, ppLlvmAliases, ppLlvmMetas, ppLlvmMeta,\n\n    ) where\n\nimport Llvm.AbsSyn\nimport Llvm.MetaData\nimport Llvm.PpLlvm\nimport Llvm.Types\n\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, TypeFamilies, ViewPatterns #-}\n\n-- -----------------------------------------------------------------------------\n-- | This is the top-level module in the LLVM code generator.\n--\nmodule LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Llvm\nimport LlvmCodeGen.Base\nimport LlvmCodeGen.CodeGen\nimport LlvmCodeGen.Data\nimport LlvmCodeGen.Ppr\nimport LlvmCodeGen.Regs\nimport LlvmMangler\n\nimport BlockId\nimport CgUtils ( fixStgRegisters )\nimport Cmm\nimport CmmUtils\nimport Hoopl.Block\nimport Hoopl.Collections\nimport PprCmm\n\nimport BufWrite\nimport DynFlags\nimport ErrUtils\nimport FastString\nimport Outputable\nimport UniqSupply\nimport SysTools ( figureLlvmVersion )\nimport qualified Stream\n\nimport Control.Monad ( when )\nimport Data.Maybe ( fromMaybe, catMaybes )\nimport System.IO\n\n-- -----------------------------------------------------------------------------\n-- | Top-level of the LLVM Code generator\n--\nllvmCodeGen :: DynFlags -> Handle -> UniqSupply\n               -> Stream.Stream IO RawCmmGroup ()\n               -> IO ()\nllvmCodeGen dflags h us cmm_stream\n  = withTiming (pure dflags) (text \"LLVM CodeGen\") (const ()) $ do\n       bufh <- newBufHandle h\n\n       -- Pass header\n       showPass dflags \"LLVM CodeGen\"\n\n       -- get llvm version, cache for later use\n       ver <- (fromMaybe supportedLlvmVersion) `fmap` figureLlvmVersion dflags\n\n       -- warn if unsupported\n       debugTraceMsg dflags 2\n            (text \"Using LLVM version:\" <+> text (show ver))\n       let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags\n       when (ver /= supportedLlvmVersion && doWarn) $\n           putMsg dflags (text \"You are using an unsupported version of LLVM!\"\n                            $+$ text (\"Currently only \" ++\n                                      llvmVersionStr supportedLlvmVersion ++\n                                      \" is supported.\")\n                            $+$ text \"We will try though...\")\n\n       -- run code generation\n       runLlvm dflags ver bufh us $\n         llvmCodeGen' (liftStream cmm_stream)\n\n       bFlush bufh\n\nllvmCodeGen' :: Stream.Stream LlvmM RawCmmGroup () -> LlvmM ()\nllvmCodeGen' cmm_stream\n  = do  -- Preamble\n        renderLlvm header\n        ghcInternalFunctions\n        cmmMetaLlvmPrelude\n\n        -- Procedures\n        let llvmStream = Stream.mapM llvmGroupLlvmGens cmm_stream\n        _ <- Stream.collect llvmStream\n\n        -- Declare aliases for forward references\n        renderLlvm . pprLlvmData =<< generateExternDecls\n\n        -- Postamble\n        cmmUsedLlvmGens\n  where\n    header :: SDoc\n    header = sdocWithDynFlags $ \\dflags ->\n      let target = LLVM_TARGET\n          layout = case lookup target (llvmTargets dflags) of\n            Just (LlvmTarget dl _ _) -> dl\n            Nothing -> error $ \"Failed to lookup the datalayout for \" ++ target ++ \"; available targets: \" ++ show (map fst $ llvmTargets dflags)\n      in     text (\"target datalayout = \\\"\" ++ layout ++ \"\\\"\")\n         $+$ text (\"target triple = \\\"\" ++ target ++ \"\\\"\")\n\nllvmGroupLlvmGens :: RawCmmGroup -> LlvmM ()\nllvmGroupLlvmGens cmm = do\n\n        -- Insert functions into map, collect data\n        let split (CmmData s d' )     = return $ Just (s, d')\n            split (CmmProc h l live g) = do\n              -- Set function type\n              let l' = case mapLookup (g_entry g) h of\n                         Nothing                   -> l\n                         Just (Statics info_lbl _) -> info_lbl\n              lml <- strCLabel_llvm l'\n              funInsert lml =<< llvmFunTy live\n              return Nothing\n        cdata <- fmap catMaybes $ mapM split cmm\n\n        {-# SCC \"llvm_datas_gen\" #-}\n          cmmDataLlvmGens cdata\n        {-# SCC \"llvm_procs_gen\" #-}\n          mapM_ cmmLlvmGen cmm\n\n-- -----------------------------------------------------------------------------\n-- | Do LLVM code generation on all these Cmms data sections.\n--\ncmmDataLlvmGens :: [(Section,CmmStatics)] -> LlvmM ()\n\ncmmDataLlvmGens statics\n  = do lmdatas <- mapM genLlvmData statics\n\n       let (concat -> gs, tss) = unzip lmdatas\n\n       let regGlobal (LMGlobal (LMGlobalVar l ty _ _ _ _) _)\n                        = funInsert l ty\n           regGlobal _  = pure ()\n       mapM_ regGlobal gs\n       gss' <- mapM aliasify $ gs\n\n       renderLlvm $ pprLlvmData (concat gss', concat tss)\n\n-- | LLVM can't handle entry blocks which loop back to themselves (could be\n-- seen as an LLVM bug) so we rearrange the code to keep the original entry\n-- label which branches to a newly generated second label that branches back\n-- to itself. See: Trac #11649\nfixBottom :: RawCmmDecl -> LlvmM RawCmmDecl\nfixBottom cp@(CmmProc hdr entry_lbl live g) =\n    maybe (pure cp) fix_block $ mapLookup (g_entry g) blk_map\n  where\n    blk_map = toBlockMap g\n\n    fix_block :: CmmBlock -> LlvmM RawCmmDecl\n    fix_block blk\n        | (CmmEntry e_lbl tickscp, middle, CmmBranch b_lbl) <- blockSplit blk\n        , isEmptyBlock middle\n        , e_lbl == b_lbl = do\n            new_lbl <- mkBlockId <$> getUniqueM\n\n            let fst_blk =\n                    BlockCC (CmmEntry e_lbl tickscp) BNil (CmmBranch new_lbl)\n                snd_blk =\n                    BlockCC (CmmEntry new_lbl tickscp) BNil (CmmBranch new_lbl)\n\n            pure . CmmProc hdr entry_lbl live . ofBlockMap (g_entry g)\n                $ mapFromList [(e_lbl, fst_blk), (new_lbl, snd_blk)]\n\n    fix_block _ = pure cp\n\nfixBottom rcd = pure rcd\n\n-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.\ncmmLlvmGen ::RawCmmDecl -> LlvmM ()\ncmmLlvmGen cmm@CmmProc{} = do\n\n    -- rewrite assignments to global regs\n    dflags <- getDynFlag id\n    fixed_cmm <- fixBottom $\n                    {-# SCC \"llvm_fix_regs\" #-}\n                    fixStgRegisters dflags cmm\n\n    dumpIfSetLlvm Opt_D_dump_opt_cmm \"Optimised Cmm\" (pprCmmGroup [fixed_cmm])\n\n    -- generate llvm code from cmm\n    llvmBC <- withClearVars $ genLlvmProc fixed_cmm\n\n    -- pretty print\n    (docs, ivars) <- fmap unzip $ mapM pprLlvmCmmDecl llvmBC\n\n    -- Output, note down used variables\n    renderLlvm (vcat docs)\n    mapM_ markUsedVar $ concat ivars\n\ncmmLlvmGen _ = return ()\n\n-- -----------------------------------------------------------------------------\n-- | Generate meta data nodes\n--\n\ncmmMetaLlvmPrelude :: LlvmM ()\ncmmMetaLlvmPrelude = do\n  metas <- flip mapM stgTBAA $ \\(uniq, name, parent) -> do\n    -- Generate / lookup meta data IDs\n    tbaaId <- getMetaUniqueId\n    setUniqMeta uniq tbaaId\n    parentId <- maybe (return Nothing) getUniqMeta parent\n    -- Build definition\n    return $ MetaUnnamed tbaaId $ MetaStruct $\n          case parentId of\n              Just p  -> [ MetaStr name, MetaNode p ]\n              -- As of LLVM 4.0, a node without parents should be rendered as\n              -- just a name on its own. Previously `null` was accepted as the\n              -- name.\n              Nothing -> [ MetaStr name ]\n  renderLlvm $ ppLlvmMetas metas\n\n-- -----------------------------------------------------------------------------\n-- | Marks variables as used where necessary\n--\n\ncmmUsedLlvmGens :: LlvmM ()\ncmmUsedLlvmGens = do\n\n  -- LLVM would discard variables that are internal and not obviously\n  -- used if we didn't provide these hints. This will generate a\n  -- definition of the form\n  --\n  --   @llvm.used = appending global [42 x i8*] [i8* bitcast <var> to i8*, ...]\n  --\n  -- Which is the LLVM way of protecting them against getting removed.\n  ivars <- getUsedVars\n  let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr\n      ty     = (LMArray (length ivars) i8Ptr)\n      usedArray = LMStaticArray (map cast ivars) ty\n      sectName  = Just $ fsLit \"llvm.metadata\"\n      lmUsedVar = LMGlobalVar (fsLit \"llvm.used\") ty Appending sectName Nothing Constant\n      lmUsed    = LMGlobal lmUsedVar (Just usedArray)\n  if null ivars\n     then return ()\n     else renderLlvm $ pprLlvmData ([lmUsed], [])\n", "num_lines": 236}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- -----------------------------------------------------------------------------\n-- | GHC LLVM Mangler\n--\n-- This script processes the assembly produced by LLVM, rewriting all symbols\n-- of type @function to @object. This keeps them from going through the PLT,\n-- which would be bad due to tables-next-to-code. On x86_64,\n-- it also rewrites AVX instructions that require alignment to their\n-- unaligned counterparts, since the stack is only 16-byte aligned but these\n-- instructions require 32-byte alignment.\n--\n\nmodule LlvmMangler ( llvmFixupAsm ) where\n\nimport GhcPrelude\n\nimport DynFlags ( DynFlags, targetPlatform )\nimport Platform ( platformArch, Arch(..) )\nimport ErrUtils ( withTiming )\nimport Outputable ( text )\n\nimport Control.Exception\nimport qualified Data.ByteString.Char8 as B\nimport System.IO\n\n-- | Read in assembly file and process\nllvmFixupAsm :: DynFlags -> FilePath -> FilePath -> IO ()\nllvmFixupAsm dflags f1 f2 = {-# SCC \"llvm_mangler\" #-}\n    withTiming (pure dflags) (text \"LLVM Mangler\") id $\n    withBinaryFile f1 ReadMode $ \\r -> withBinaryFile f2 WriteMode $ \\w -> do\n        go r w\n        hClose r\n        hClose w\n        return ()\n  where\n    go :: Handle -> Handle -> IO ()\n    go r w = do\n      e_l <- try $ B.hGetLine r ::IO (Either IOError B.ByteString)\n      let writeline a = B.hPutStrLn w (rewriteLine dflags rewrites a) >> go r w\n      case e_l of\n        Right l -> writeline l\n        Left _  -> return ()\n\n-- | These are the rewrites that the mangler will perform\nrewrites :: [Rewrite]\nrewrites = [rewriteSymType, rewriteAVX]\n\ntype Rewrite = DynFlags -> B.ByteString -> Maybe B.ByteString\n\n-- | Rewrite a line of assembly source with the given rewrites,\n-- taking the first rewrite that applies.\nrewriteLine :: DynFlags -> [Rewrite] -> B.ByteString -> B.ByteString\nrewriteLine dflags rewrites l\n  -- We disable .subsections_via_symbols on darwin and ios, as the llvm code\n  -- gen uses prefix data for the info table.  This however does not prevent\n  -- llvm from generating .subsections_via_symbols, which in turn with\n  -- -dead_strip, strips the info tables, and therefore breaks ghc.\n  | isSubsectionsViaSymbols l =\n    (B.pack \"## no .subsection_via_symbols for ghc. We need our info tables!\")\n  | otherwise =\n    case firstJust $ map (\\rewrite -> rewrite dflags rest) rewrites of\n      Nothing        -> l\n      Just rewritten -> B.concat $ [symbol, B.pack \"\\t\", rewritten]\n  where\n    isSubsectionsViaSymbols = B.isPrefixOf (B.pack \".subsections_via_symbols\")\n\n    (symbol, rest) = splitLine l\n\n    firstJust :: [Maybe a] -> Maybe a\n    firstJust (Just x:_) = Just x\n    firstJust []         = Nothing\n    firstJust (_:rest)   = firstJust rest\n\n-- | This rewrites @.type@ annotations of function symbols to @%object@.\n-- This is done as the linker can relocate @%functions@ through the\n-- Procedure Linking Table (PLT). This is bad since we expect that the\n-- info table will appear directly before the symbol's location. In the\n-- case that the PLT is used, this will be not an info table but instead\n-- some random PLT garbage.\nrewriteSymType :: Rewrite\nrewriteSymType _ l\n  | isType l  = Just $ rewrite '@' $ rewrite '%' l\n  | otherwise = Nothing\n  where\n    isType = B.isPrefixOf (B.pack \".type\")\n\n    rewrite :: Char -> B.ByteString -> B.ByteString\n    rewrite prefix = replaceOnce funcType objType\n      where\n        funcType = prefix `B.cons` B.pack \"function\"\n        objType  = prefix `B.cons` B.pack \"object\"\n\n-- | This rewrites aligned AVX instructions to their unaligned counterparts on\n-- x86-64. This is necessary because the stack is not adequately aligned for\n-- aligned AVX spills, so LLVM would emit code that adjusts the stack pointer\n-- and disable tail call optimization. Both would be catastrophic here so GHC\n-- tells LLVM that the stack is 32-byte aligned (even though it isn't) and then\n-- rewrites the instructions in the mangler.\nrewriteAVX :: Rewrite\nrewriteAVX dflags s\n  | not isX86_64 = Nothing\n  | isVmovdqa s  = Just $ replaceOnce (B.pack \"vmovdqa\") (B.pack \"vmovdqu\") s\n  | isVmovap s   = Just $ replaceOnce (B.pack \"vmovap\") (B.pack \"vmovup\") s\n  | otherwise    = Nothing\n  where\n    isX86_64 = platformArch (targetPlatform dflags) == ArchX86_64\n    isVmovdqa = B.isPrefixOf (B.pack \"vmovdqa\")\n    isVmovap = B.isPrefixOf (B.pack \"vmovap\")\n\n-- | @replaceOnce match replace bs@ replaces the first occurrence of the\n-- substring @match@ in @bs@ with @replace@.\nreplaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString\nreplaceOnce matchBS replaceOnceBS = loop\n  where\n    loop :: B.ByteString -> B.ByteString\n    loop cts =\n        case B.breakSubstring matchBS cts of\n          (hd,tl) | B.null tl -> hd\n                  | otherwise -> hd `B.append` replaceOnceBS `B.append`\n                                 B.drop (B.length matchBS) tl\n\n-- | This function splits a line of assembly code into the label and the\n-- rest of the code.\nsplitLine :: B.ByteString -> (B.ByteString, B.ByteString)\nsplitLine l = (symbol, B.dropWhile isSpace rest)\n  where\n    isSpace ' ' = True\n    isSpace '\\t' = True\n    isSpace _ = False\n    (symbol, rest) = B.span (not . isSpace) l\n", "num_lines": 130}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--------------------------------------------------------------------------------\n-- | The LLVM abstract syntax.\n--\n\nmodule Llvm.AbsSyn where\n\nimport GhcPrelude\n\nimport Llvm.MetaData\nimport Llvm.Types\n\nimport Unique\n\n-- | Block labels\ntype LlvmBlockId = Unique\n\n-- | A block of LLVM code.\ndata LlvmBlock = LlvmBlock {\n    -- | The code label for this block\n    blockLabel :: LlvmBlockId,\n\n    -- | A list of LlvmStatement's representing the code for this block.\n    -- This list must end with a control flow statement.\n    blockStmts :: [LlvmStatement]\n  }\n\ntype LlvmBlocks = [LlvmBlock]\n\n-- | An LLVM Module. This is a top level container in LLVM.\ndata LlvmModule = LlvmModule  {\n    -- | Comments to include at the start of the module.\n    modComments  :: [LMString],\n\n    -- | LLVM Alias type definitions.\n    modAliases   :: [LlvmAlias],\n\n    -- | LLVM meta data.\n    modMeta      :: [MetaDecl],\n\n    -- | Global variables to include in the module.\n    modGlobals   :: [LMGlobal],\n\n    -- | LLVM Functions used in this module but defined in other modules.\n    modFwdDecls  :: LlvmFunctionDecls,\n\n    -- | LLVM Functions defined in this module.\n    modFuncs     :: LlvmFunctions\n  }\n\n-- | An LLVM Function\ndata LlvmFunction = LlvmFunction {\n    -- | The signature of this declared function.\n    funcDecl      :: LlvmFunctionDecl,\n\n    -- | The functions arguments\n    funcArgs      :: [LMString],\n\n    -- | The function attributes.\n    funcAttrs     :: [LlvmFuncAttr],\n\n    -- | The section to put the function into,\n    funcSect      :: LMSection,\n\n    -- | Prefix data\n    funcPrefix    :: Maybe LlvmStatic,\n\n    -- | The body of the functions.\n    funcBody      :: LlvmBlocks\n  }\n\ntype LlvmFunctions = [LlvmFunction]\n\ntype SingleThreaded = Bool\n\n-- | LLVM ordering types for synchronization purposes. (Introduced in LLVM\n-- 3.0). Please see the LLVM documentation for a better description.\ndata LlvmSyncOrdering\n  -- | Some partial order of operations exists.\n  = SyncUnord\n  -- | A single total order for operations at a single address exists.\n  | SyncMonotonic\n  -- | Acquire synchronization operation.\n  | SyncAcquire\n  -- | Release synchronization operation.\n  | SyncRelease\n  -- | Acquire + Release synchronization operation.\n  | SyncAcqRel\n  -- | Full sequential Consistency operation.\n  | SyncSeqCst\n  deriving (Show, Eq)\n\n-- | LLVM atomic operations. Please see the @atomicrmw@ instruction in\n-- the LLVM documentation for a complete description.\ndata LlvmAtomicOp\n  = LAO_Xchg\n  | LAO_Add\n  | LAO_Sub\n  | LAO_And\n  | LAO_Nand\n  | LAO_Or\n  | LAO_Xor\n  | LAO_Max\n  | LAO_Min\n  | LAO_Umax\n  | LAO_Umin\n  deriving (Show, Eq)\n\n-- | Llvm Statements\ndata LlvmStatement\n  {- |\n    Assign an expression to a variable:\n      * dest:   Variable to assign to\n      * source: Source expression\n  -}\n  = Assignment LlvmVar LlvmExpression\n\n  {- |\n    Memory fence operation\n  -}\n  | Fence Bool LlvmSyncOrdering\n\n  {- |\n    Always branch to the target label\n  -}\n  | Branch LlvmVar\n\n  {- |\n    Branch to label targetTrue if cond is true otherwise to label targetFalse\n      * cond:        condition that will be tested, must be of type i1\n      * targetTrue:  label to branch to if cond is true\n      * targetFalse: label to branch to if cond is false\n  -}\n  | BranchIf LlvmVar LlvmVar LlvmVar\n\n  {- |\n    Comment\n    Plain comment.\n  -}\n  | Comment [LMString]\n\n  {- |\n    Set a label on this position.\n      * name: Identifier of this label, unique for this module\n  -}\n  | MkLabel LlvmBlockId\n\n  {- |\n    Store variable value in pointer ptr. If value is of type t then ptr must\n    be of type t*.\n      * value: Variable/Constant to store.\n      * ptr:   Location to store the value in\n  -}\n  | Store LlvmVar LlvmVar\n\n  {- |\n    Multiway branch\n      * scrutinee: Variable or constant which must be of integer type that is\n                   determines which arm is chosen.\n      * def:       The default label if there is no match in target.\n      * target:    A list of (value,label) where the value is an integer\n                   constant and label the corresponding label to jump to if the\n                   scrutinee matches the value.\n  -}\n  | Switch LlvmVar LlvmVar [(LlvmVar, LlvmVar)]\n\n  {- |\n    Return a result.\n      * result: The variable or constant to return\n  -}\n  | Return (Maybe LlvmVar)\n\n  {- |\n    An instruction for the optimizer that the code following is not reachable\n  -}\n  | Unreachable\n\n  {- |\n    Raise an expression to a statement (if don't want result or want to use\n    Llvm unnamed values.\n  -}\n  | Expr LlvmExpression\n\n  {- |\n    A nop LLVM statement. Useful as its often more efficient to use this\n    then to wrap LLvmStatement in a Just or [].\n  -}\n  | Nop\n\n  {- |\n    A LLVM statement with metadata attached to it.\n  -}\n  | MetaStmt [MetaAnnot] LlvmStatement\n\n  deriving (Eq)\n\n\n-- | Llvm Expressions\ndata LlvmExpression\n  {- |\n    Allocate amount * sizeof(tp) bytes on the stack\n      * tp:     LlvmType to reserve room for\n      * amount: The nr of tp's which must be allocated\n  -}\n  = Alloca LlvmType Int\n\n  {- |\n    Perform the machine operator op on the operands left and right\n      * op:    operator\n      * left:  left operand\n      * right: right operand\n  -}\n  | LlvmOp LlvmMachOp LlvmVar LlvmVar\n\n  {- |\n    Perform a compare operation on the operands left and right\n      * op:    operator\n      * left:  left operand\n      * right: right operand\n  -}\n  | Compare LlvmCmpOp LlvmVar LlvmVar\n\n  {- |\n    Extract a scalar element from a vector\n      * val: The vector\n      * idx: The index of the scalar within the vector\n  -}\n  | Extract LlvmVar LlvmVar\n\n  {- |\n    Extract a scalar element from a structure\n      * val: The structure\n      * idx: The index of the scalar within the structure\n    Corresponds to \"extractvalue\" instruction.\n  -}\n  | ExtractV LlvmVar Int\n\n  {- |\n    Insert a scalar element into a vector\n      * val:   The source vector\n      * elt:   The scalar to insert\n      * index: The index at which to insert the scalar\n  -}\n  | Insert LlvmVar LlvmVar LlvmVar\n\n  {- |\n    Allocate amount * sizeof(tp) bytes on the heap\n      * tp:     LlvmType to reserve room for\n      * amount: The nr of tp's which must be allocated\n  -}\n  | Malloc LlvmType Int\n\n  {- |\n    Load the value at location ptr\n  -}\n  | Load LlvmVar\n\n  {- |\n    Atomic load of the value at location ptr\n  -}\n  | ALoad LlvmSyncOrdering SingleThreaded LlvmVar\n\n  {- |\n    Navigate in a structure, selecting elements\n      * inbound: Is the pointer inbounds? (computed pointer doesn't overflow)\n      * ptr:     Location of the structure\n      * indexes: A list of indexes to select the correct value.\n  -}\n  | GetElemPtr Bool LlvmVar [LlvmVar]\n\n  {- |\n    Cast the variable from to the to type. This is an abstraction of three\n    cast operators in Llvm, inttoptr, ptrtoint and bitcast.\n       * cast: Cast type\n       * from: Variable to cast\n       * to:   type to cast to\n  -}\n  | Cast LlvmCastOp LlvmVar LlvmType\n\n  {- |\n    Atomic read-modify-write operation\n       * op:       Atomic operation\n       * addr:     Address to modify\n       * operand:  Operand to operation\n       * ordering: Ordering requirement\n  -}\n  | AtomicRMW LlvmAtomicOp LlvmVar LlvmVar LlvmSyncOrdering\n\n  {- |\n    Compare-and-exchange operation\n       * addr:     Address to modify\n       * old:      Expected value\n       * new:      New value\n       * suc_ord:  Ordering required in success case\n       * fail_ord: Ordering required in failure case, can be no stronger than\n                   suc_ord\n\n    Result is an @i1@, true if store was successful.\n  -}\n  | CmpXChg LlvmVar LlvmVar LlvmVar LlvmSyncOrdering LlvmSyncOrdering\n\n  {- |\n    Call a function. The result is the value of the expression.\n      * tailJumps: CallType to signal if the function should be tail called\n      * fnptrval:  An LLVM value containing a pointer to a function to be\n                   invoked. Can be indirect. Should be LMFunction type.\n      * args:      Concrete arguments for the parameters\n      * attrs:     A list of function attributes for the call. Only NoReturn,\n                   NoUnwind, ReadOnly and ReadNone are valid here.\n  -}\n  | Call LlvmCallType LlvmVar [LlvmVar] [LlvmFuncAttr]\n\n  {- |\n    Call a function as above but potentially taking metadata as arguments.\n      * tailJumps: CallType to signal if the function should be tail called\n      * fnptrval:  An LLVM value containing a pointer to a function to be\n                   invoked. Can be indirect. Should be LMFunction type.\n      * args:      Arguments that may include metadata.\n      * attrs:     A list of function attributes for the call. Only NoReturn,\n                   NoUnwind, ReadOnly and ReadNone are valid here.\n  -}\n  | CallM LlvmCallType LlvmVar [MetaExpr] [LlvmFuncAttr]\n\n  {- |\n    Merge variables from different basic blocks which are predecessors of this\n    basic block in a new variable of type tp.\n      * tp:         type of the merged variable, must match the types of the\n                    predecessor variables.\n      * predecessors: A list of variables and the basic block that they originate\n                      from.\n  -}\n  | Phi LlvmType [(LlvmVar,LlvmVar)]\n\n  {- |\n    Inline assembly expression. Syntax is very similar to the style used by GCC.\n      * assembly:    Actual inline assembly code.\n      * constraints: Operand constraints.\n      * return ty:   Return type of function.\n      * vars:        Any variables involved in the assembly code.\n      * sideeffect:  Does the expression have side effects not visible from the\n                     constraints list.\n      * alignstack:  Should the stack be conservatively aligned before this\n                     expression is executed.\n  -}\n  | Asm LMString LMString LlvmType [LlvmVar] Bool Bool\n\n  {- |\n    A LLVM expression with metadata attached to it.\n  -}\n  | MExpr [MetaAnnot] LlvmExpression\n\n  deriving (Eq)\n\n", "num_lines": 353}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule Llvm.MetaData where\n\nimport GhcPrelude\n\nimport Llvm.Types\nimport Outputable\n\n-- The LLVM Metadata System.\n--\n-- The LLVM metadata feature is poorly documented but roughly follows the\n-- following design:\n-- * Metadata can be constructed in a few different ways (See below).\n-- * After which it can either be attached to LLVM statements to pass along\n-- extra information to the optimizer and code generator OR specifically named\n-- metadata has an affect on the whole module (i.e., linking behaviour).\n--\n--\n-- # Constructing metadata\n-- Metadata comes largely in three forms:\n--\n-- * Metadata expressions -- these are the raw metadata values that encode\n--   information. They consist of metadata strings, metadata nodes, regular\n--   LLVM values (both literals and references to global variables) and\n--   metadata expressions (i.e., recursive data type). Some examples:\n--     !{ !\"hello\", !0, i32 0 }\n--     !{ !1, !{ i32 0 } }\n--\n-- * Metadata nodes -- global metadata variables that attach a metadata\n--   expression to a number. For example:\n--     !0 = !{ [<metadata expressions>] !}\n--\n-- * Named metadata -- global metadata variables that attach a metadata nodes\n--   to a name. Used ONLY to communicated module level information to LLVM\n--   through a meaningful name. For example:\n--     !llvm.module.linkage = !{ !0, !1 }\n--\n--\n-- # Using Metadata\n-- Using metadata depends on the form it is in:\n--\n-- * Attach to instructions -- metadata can be attached to LLVM instructions\n--   using a specific reference as follows:\n--     %l = load i32* @glob, !nontemporal !10\n--     %m = load i32* @glob, !nontemporal !{ i32 0, !{ i32 0 } }\n--   Only metadata nodes or expressions can be attached, named metadata cannot.\n--   Refer to LLVM documentation for which instructions take metadata and its\n--   meaning.\n--\n-- * As arguments -- llvm functions can take metadata as arguments, for\n--   example:\n--     call void @llvm.dbg.value(metadata !{ i32 0 }, i64 0, metadata !1)\n--   As with instructions, only metadata nodes or expressions can be attached.\n--\n-- * As a named metadata -- Here the metadata is simply declared in global\n--   scope using a specific name to communicate module level information to LLVM.\n--   For example:\n--     !llvm.module.linkage = !{ !0, !1 }\n--\n\n-- | A reference to an un-named metadata node.\nnewtype MetaId = MetaId Int\n               deriving (Eq, Ord, Enum)\n\ninstance Outputable MetaId where\n    ppr (MetaId n) = char '!' <> int n\n\n-- | LLVM metadata expressions\ndata MetaExpr = MetaStr !LMString\n              | MetaNode !MetaId\n              | MetaVar !LlvmVar\n              | MetaStruct [MetaExpr]\n              deriving (Eq)\n\ninstance Outputable MetaExpr where\n  ppr (MetaVar (LMLitVar (LMNullLit _))) = text \"null\"\n  ppr (MetaStr    s ) = char '!' <> doubleQuotes (ftext s)\n  ppr (MetaNode   n ) = ppr n\n  ppr (MetaVar    v ) = ppr v\n  ppr (MetaStruct es) = char '!' <> braces (ppCommaJoin es)\n\n-- | Associates some metadata with a specific label for attaching to an\n-- instruction.\ndata MetaAnnot = MetaAnnot LMString MetaExpr\n               deriving (Eq)\n\n-- | Metadata declarations. Metadata can only be declared in global scope.\ndata MetaDecl\n    -- | Named metadata. Only used for communicating module information to\n    -- LLVM. ('!name = !{ [!<n>] }' form).\n    = MetaNamed !LMString [MetaId]\n    -- | Metadata node declaration.\n    -- ('!0 = metadata !{ <metadata expression> }' form).\n    | MetaUnnamed !MetaId !MetaExpr\n", "num_lines": 96}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n--------------------------------------------------------------------------------\n-- | Pretty print LLVM IR Code.\n--\n\nmodule Llvm.PpLlvm (\n\n    -- * Top level LLVM objects.\n    ppLlvmModule,\n    ppLlvmComments,\n    ppLlvmComment,\n    ppLlvmGlobals,\n    ppLlvmGlobal,\n    ppLlvmAliases,\n    ppLlvmAlias,\n    ppLlvmMetas,\n    ppLlvmMeta,\n    ppLlvmFunctionDecls,\n    ppLlvmFunctionDecl,\n    ppLlvmFunctions,\n    ppLlvmFunction,\n\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Llvm.AbsSyn\nimport Llvm.MetaData\nimport Llvm.Types\n\nimport Data.List ( intersperse )\nimport Outputable\nimport Unique\nimport FastString ( sLit )\n\n--------------------------------------------------------------------------------\n-- * Top Level Print functions\n--------------------------------------------------------------------------------\n\n-- | Print out a whole LLVM module.\nppLlvmModule :: LlvmModule -> SDoc\nppLlvmModule (LlvmModule comments aliases meta globals decls funcs)\n  = ppLlvmComments comments $+$ newLine\n    $+$ ppLlvmAliases aliases $+$ newLine\n    $+$ ppLlvmMetas meta $+$ newLine\n    $+$ ppLlvmGlobals globals $+$ newLine\n    $+$ ppLlvmFunctionDecls decls $+$ newLine\n    $+$ ppLlvmFunctions funcs\n\n-- | Print out a multi-line comment, can be inside a function or on its own\nppLlvmComments :: [LMString] -> SDoc\nppLlvmComments comments = vcat $ map ppLlvmComment comments\n\n-- | Print out a comment, can be inside a function or on its own\nppLlvmComment :: LMString -> SDoc\nppLlvmComment com = semi <+> ftext com\n\n\n-- | Print out a list of global mutable variable definitions\nppLlvmGlobals :: [LMGlobal] -> SDoc\nppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls\n\n-- | Print out a global mutable variable definition\nppLlvmGlobal :: LMGlobal -> SDoc\nppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =\n    let sect = case x of\n            Just x' -> text \", section\" <+> doubleQuotes (ftext x')\n            Nothing -> empty\n\n        align = case a of\n            Just a' -> text \", align\" <+> int a'\n            Nothing -> empty\n\n        rhs = case dat of\n            Just stat -> pprSpecialStatic stat\n            Nothing   -> ppr (pLower $ getVarType var)\n\n        -- Position of linkage is different for aliases.\n        const = case c of\n          Global   -> \"global\"\n          Constant -> \"constant\"\n          Alias    -> \"alias\"\n\n    in ppAssignment var $ ppr link <+> text const <+> rhs <> sect <> align\n       $+$ newLine\n\nppLlvmGlobal (LMGlobal var val) = sdocWithDynFlags $ \\dflags ->\n  error $ \"Non Global var ppr as global! \"\n          ++ showSDoc dflags (ppr var) ++ \" \" ++ showSDoc dflags (ppr val)\n\n\n-- | Print out a list of LLVM type aliases.\nppLlvmAliases :: [LlvmAlias] -> SDoc\nppLlvmAliases tys = vcat $ map ppLlvmAlias tys\n\n-- | Print out an LLVM type alias.\nppLlvmAlias :: LlvmAlias -> SDoc\nppLlvmAlias (name, ty)\n  = char '%' <> ftext name <+> equals <+> text \"type\" <+> ppr ty\n\n\n-- | Print out a list of LLVM metadata.\nppLlvmMetas :: [MetaDecl] -> SDoc\nppLlvmMetas metas = vcat $ map ppLlvmMeta metas\n\n-- | Print out an LLVM metadata definition.\nppLlvmMeta :: MetaDecl -> SDoc\nppLlvmMeta (MetaUnnamed n m)\n  = ppr n <+> equals <+> ppr m\n\nppLlvmMeta (MetaNamed n m)\n  = exclamation <> ftext n <+> equals <+> exclamation <> braces nodes\n  where\n    nodes = hcat $ intersperse comma $ map ppr m\n\n\n-- | Print out a list of function definitions.\nppLlvmFunctions :: LlvmFunctions -> SDoc\nppLlvmFunctions funcs = vcat $ map ppLlvmFunction funcs\n\n-- | Print out a function definition.\nppLlvmFunction :: LlvmFunction -> SDoc\nppLlvmFunction fun =\n    let attrDoc = ppSpaceJoin (funcAttrs fun)\n        secDoc = case funcSect fun of\n                      Just s' -> text \"section\" <+> (doubleQuotes $ ftext s')\n                      Nothing -> empty\n        prefixDoc = case funcPrefix fun of\n                        Just v  -> text \"prefix\" <+> ppr v\n                        Nothing -> empty\n    in text \"define\" <+> ppLlvmFunctionHeader (funcDecl fun) (funcArgs fun)\n        <+> attrDoc <+> secDoc <+> prefixDoc\n        $+$ lbrace\n        $+$ ppLlvmBlocks (funcBody fun)\n        $+$ rbrace\n        $+$ newLine\n        $+$ newLine\n\n-- | Print out a function definition header.\nppLlvmFunctionHeader :: LlvmFunctionDecl -> [LMString] -> SDoc\nppLlvmFunctionHeader (LlvmFunctionDecl n l c r varg p a) args\n  = let varg' = case varg of\n                      VarArgs | null p    -> sLit \"...\"\n                              | otherwise -> sLit \", ...\"\n                      _otherwise          -> sLit \"\"\n        align = case a of\n                     Just a' -> text \" align \" <> ppr a'\n                     Nothing -> empty\n        args' = map (\\((ty,p),n) -> ppr ty <+> ppSpaceJoin p <+> char '%'\n                                    <> ftext n)\n                    (zip p args)\n    in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <> lparen <>\n        (hsep $ punctuate comma args') <> ptext varg' <> rparen <> align\n\n-- | Print out a list of function declaration.\nppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc\nppLlvmFunctionDecls decs = vcat $ map ppLlvmFunctionDecl decs\n\n-- | Print out a function declaration.\n-- Declarations define the function type but don't define the actual body of\n-- the function.\nppLlvmFunctionDecl :: LlvmFunctionDecl -> SDoc\nppLlvmFunctionDecl (LlvmFunctionDecl n l c r varg p a)\n  = let varg' = case varg of\n                      VarArgs | null p    -> sLit \"...\"\n                              | otherwise -> sLit \", ...\"\n                      _otherwise          -> sLit \"\"\n        align = case a of\n                     Just a' -> text \" align\" <+> ppr a'\n                     Nothing -> empty\n        args = hcat $ intersperse (comma <> space) $\n                  map (\\(t,a) -> ppr t <+> ppSpaceJoin a) p\n    in text \"declare\" <+> ppr l <+> ppr c <+> ppr r <+> char '@' <>\n        ftext n <> lparen <> args <> ptext varg' <> rparen <> align $+$ newLine\n\n\n-- | Print out a list of LLVM blocks.\nppLlvmBlocks :: LlvmBlocks -> SDoc\nppLlvmBlocks blocks = vcat $ map ppLlvmBlock blocks\n\n-- | Print out an LLVM block.\n-- It must be part of a function definition.\nppLlvmBlock :: LlvmBlock -> SDoc\nppLlvmBlock (LlvmBlock blockId stmts) =\n  let isLabel (MkLabel _) = True\n      isLabel _           = False\n      (block, rest)       = break isLabel stmts\n      ppRest = case rest of\n        MkLabel id:xs -> ppLlvmBlock (LlvmBlock id xs)\n        _             -> empty\n  in ppLlvmBlockLabel blockId\n           $+$ (vcat $ map ppLlvmStatement block)\n           $+$ newLine\n           $+$ ppRest\n\n-- | Print out an LLVM block label.\nppLlvmBlockLabel :: LlvmBlockId -> SDoc\nppLlvmBlockLabel id = pprUniqueAlways id <> colon\n\n\n-- | Print out an LLVM statement.\nppLlvmStatement :: LlvmStatement -> SDoc\nppLlvmStatement stmt =\n  let ind = (text \"  \" <>)\n  in case stmt of\n        Assignment  dst expr      -> ind $ ppAssignment dst (ppLlvmExpression expr)\n        Fence       st ord        -> ind $ ppFence st ord\n        Branch      target        -> ind $ ppBranch target\n        BranchIf    cond ifT ifF  -> ind $ ppBranchIf cond ifT ifF\n        Comment     comments      -> ind $ ppLlvmComments comments\n        MkLabel     label         -> ppLlvmBlockLabel label\n        Store       value ptr     -> ind $ ppStore value ptr\n        Switch      scrut def tgs -> ind $ ppSwitch scrut def tgs\n        Return      result        -> ind $ ppReturn result\n        Expr        expr          -> ind $ ppLlvmExpression expr\n        Unreachable               -> ind $ text \"unreachable\"\n        Nop                       -> empty\n        MetaStmt    meta s        -> ppMetaStatement meta s\n\n\n-- | Print out an LLVM expression.\nppLlvmExpression :: LlvmExpression -> SDoc\nppLlvmExpression expr\n  = case expr of\n        Alloca     tp amount        -> ppAlloca tp amount\n        LlvmOp     op left right    -> ppMachOp op left right\n        Call       tp fp args attrs -> ppCall tp fp (map MetaVar args) attrs\n        CallM      tp fp args attrs -> ppCall tp fp args attrs\n        Cast       op from to       -> ppCast op from to\n        Compare    op left right    -> ppCmpOp op left right\n        Extract    vec idx          -> ppExtract vec idx\n        ExtractV   struct idx       -> ppExtractV struct idx\n        Insert     vec elt idx      -> ppInsert vec elt idx\n        GetElemPtr inb ptr indexes  -> ppGetElementPtr inb ptr indexes\n        Load       ptr              -> ppLoad ptr\n        ALoad      ord st ptr       -> ppALoad ord st ptr\n        Malloc     tp amount        -> ppMalloc tp amount\n        AtomicRMW  aop tgt src ordering -> ppAtomicRMW aop tgt src ordering\n        CmpXChg    addr old new s_ord f_ord -> ppCmpXChg addr old new s_ord f_ord\n        Phi        tp predecessors  -> ppPhi tp predecessors\n        Asm        asm c ty v se sk -> ppAsm asm c ty v se sk\n        MExpr      meta expr        -> ppMetaExpr meta expr\n\n\n--------------------------------------------------------------------------------\n-- * Individual print functions\n--------------------------------------------------------------------------------\n\n-- | Should always be a function pointer. So a global var of function type\n-- (since globals are always pointers) or a local var of pointer function type.\nppCall :: LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc\nppCall ct fptr args attrs = case fptr of\n                           --\n    -- if local var function pointer, unwrap\n    LMLocalVar _ (LMPointer (LMFunction d)) -> ppCall' d\n\n    -- should be function type otherwise\n    LMGlobalVar _ (LMFunction d) _ _ _ _    -> ppCall' d\n\n    -- not pointer or function, so error\n    _other -> error $ \"ppCall called with non LMFunction type!\\nMust be \"\n                ++ \" called with either global var of function type or \"\n                ++ \"local var of pointer function type.\"\n\n    where\n        ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =\n            let tc = if ct == TailCall then text \"tail \" else empty\n                ppValues = hsep $ punctuate comma $ map ppCallMetaExpr args\n                ppArgTy  = (ppCommaJoin $ map fst params) <>\n                           (case argTy of\n                               VarArgs   -> text \", ...\"\n                               FixedArgs -> empty)\n                fnty = space <> lparen <> ppArgTy <> rparen\n                attrDoc = ppSpaceJoin attrs\n            in  tc <> text \"call\" <+> ppr cc <+> ppr ret\n                    <> fnty <+> ppName fptr <> lparen <+> ppValues\n                    <+> rparen <+> attrDoc\n\n        -- Metadata needs to be marked as having the `metadata` type when used\n        -- in a call argument\n        ppCallMetaExpr (MetaVar v) = ppr v\n        ppCallMetaExpr v           = text \"metadata\" <+> ppr v\n\nppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc\nppMachOp op left right =\n  (ppr op) <+> (ppr (getVarType left)) <+> ppName left\n        <> comma <+> ppName right\n\n\nppCmpOp :: LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc\nppCmpOp op left right =\n  let cmpOp\n        | isInt (getVarType left) && isInt (getVarType right) = text \"icmp\"\n        | isFloat (getVarType left) && isFloat (getVarType right) = text \"fcmp\"\n        | otherwise = text \"icmp\" -- Just continue as its much easier to debug\n        {-\n        | otherwise = error (\"can't compare different types, left = \"\n                ++ (show $ getVarType left) ++ \", right = \"\n                ++ (show $ getVarType right))\n        -}\n  in cmpOp <+> ppr op <+> ppr (getVarType left)\n        <+> ppName left <> comma <+> ppName right\n\n\nppAssignment :: LlvmVar -> SDoc -> SDoc\nppAssignment var expr = ppName var <+> equals <+> expr\n\nppFence :: Bool -> LlvmSyncOrdering -> SDoc\nppFence st ord =\n  let singleThread = case st of True  -> text \"singlethread\"\n                                False -> empty\n  in text \"fence\" <+> singleThread <+> ppSyncOrdering ord\n\nppSyncOrdering :: LlvmSyncOrdering -> SDoc\nppSyncOrdering SyncUnord     = text \"unordered\"\nppSyncOrdering SyncMonotonic = text \"monotonic\"\nppSyncOrdering SyncAcquire   = text \"acquire\"\nppSyncOrdering SyncRelease   = text \"release\"\nppSyncOrdering SyncAcqRel    = text \"acq_rel\"\nppSyncOrdering SyncSeqCst    = text \"seq_cst\"\n\nppAtomicOp :: LlvmAtomicOp -> SDoc\nppAtomicOp LAO_Xchg = text \"xchg\"\nppAtomicOp LAO_Add  = text \"add\"\nppAtomicOp LAO_Sub  = text \"sub\"\nppAtomicOp LAO_And  = text \"and\"\nppAtomicOp LAO_Nand = text \"nand\"\nppAtomicOp LAO_Or   = text \"or\"\nppAtomicOp LAO_Xor  = text \"xor\"\nppAtomicOp LAO_Max  = text \"max\"\nppAtomicOp LAO_Min  = text \"min\"\nppAtomicOp LAO_Umax = text \"umax\"\nppAtomicOp LAO_Umin = text \"umin\"\n\nppAtomicRMW :: LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc\nppAtomicRMW aop tgt src ordering =\n  text \"atomicrmw\" <+> ppAtomicOp aop <+> ppr tgt <> comma\n  <+> ppr src <+> ppSyncOrdering ordering\n\nppCmpXChg :: LlvmVar -> LlvmVar -> LlvmVar\n          -> LlvmSyncOrdering -> LlvmSyncOrdering -> SDoc\nppCmpXChg addr old new s_ord f_ord =\n  text \"cmpxchg\" <+> ppr addr <> comma <+> ppr old <> comma <+> ppr new\n  <+> ppSyncOrdering s_ord <+> ppSyncOrdering f_ord\n\n-- XXX: On x86, vector types need to be 16-byte aligned for aligned access, but\n-- we have no way of guaranteeing that this is true with GHC (we would need to\n-- modify the layout of the stack and closures, change the storage manager,\n-- etc.). So, we blindly tell LLVM that *any* vector store or load could be\n-- unaligned. In the future we may be able to guarantee that certain vector\n-- access patterns are aligned, in which case we will need a more granular way\n-- of specifying alignment.\n\nppLoad :: LlvmVar -> SDoc\nppLoad var = text \"load\" <+> ppr derefType <> comma <+> ppr var <> align\n  where\n    derefType = pLower $ getVarType var\n    align | isVector . pLower . getVarType $ var = text \", align 1\"\n          | otherwise = empty\n\nppALoad :: LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc\nppALoad ord st var = sdocWithDynFlags $ \\dflags ->\n  let alignment = (llvmWidthInBits dflags $ getVarType var) `quot` 8\n      align     = text \", align\" <+> ppr alignment\n      sThreaded | st        = text \" singlethread\"\n                | otherwise = empty\n      derefType = pLower $ getVarType var\n  in text \"load atomic\" <+> ppr derefType <> comma <+> ppr var <> sThreaded\n            <+> ppSyncOrdering ord <> align\n\nppStore :: LlvmVar -> LlvmVar -> SDoc\nppStore val dst\n    | isVecPtrVar dst = text \"store\" <+> ppr val <> comma <+> ppr dst <>\n                        comma <+> text \"align 1\"\n    | otherwise       = text \"store\" <+> ppr val <> comma <+> ppr dst\n  where\n    isVecPtrVar :: LlvmVar -> Bool\n    isVecPtrVar = isVector . pLower . getVarType\n\n\nppCast :: LlvmCastOp -> LlvmVar -> LlvmType -> SDoc\nppCast op from to\n    =   ppr op\n    <+> ppr (getVarType from) <+> ppName from\n    <+> text \"to\"\n    <+> ppr to\n\n\nppMalloc :: LlvmType -> Int -> SDoc\nppMalloc tp amount =\n  let amount' = LMLitVar $ LMIntLit (toInteger amount) i32\n  in text \"malloc\" <+> ppr tp <> comma <+> ppr amount'\n\n\nppAlloca :: LlvmType -> Int -> SDoc\nppAlloca tp amount =\n  let amount' = LMLitVar $ LMIntLit (toInteger amount) i32\n  in text \"alloca\" <+> ppr tp <> comma <+> ppr amount'\n\n\nppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc\nppGetElementPtr inb ptr idx =\n  let indexes = comma <+> ppCommaJoin idx\n      inbound = if inb then text \"inbounds\" else empty\n      derefType = pLower $ getVarType ptr\n  in text \"getelementptr\" <+> inbound <+> ppr derefType <> comma <+> ppr ptr\n                            <> indexes\n\n\nppReturn :: Maybe LlvmVar -> SDoc\nppReturn (Just var) = text \"ret\" <+> ppr var\nppReturn Nothing    = text \"ret\" <+> ppr LMVoid\n\n\nppBranch :: LlvmVar -> SDoc\nppBranch var = text \"br\" <+> ppr var\n\n\nppBranchIf :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc\nppBranchIf cond trueT falseT\n  = text \"br\" <+> ppr cond <> comma <+> ppr trueT <> comma <+> ppr falseT\n\n\nppPhi :: LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc\nppPhi tp preds =\n  let ppPreds (val, label) = brackets $ ppName val <> comma <+> ppName label\n  in text \"phi\" <+> ppr tp <+> hsep (punctuate comma $ map ppPreds preds)\n\n\nppSwitch :: LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc\nppSwitch scrut dflt targets =\n  let ppTarget  (val, lab) = ppr val <> comma <+> ppr lab\n      ppTargets  xs        = brackets $ vcat (map ppTarget xs)\n  in text \"switch\" <+> ppr scrut <> comma <+> ppr dflt\n        <+> ppTargets targets\n\n\nppAsm :: LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc\nppAsm asm constraints rty vars sideeffect alignstack =\n  let asm'  = doubleQuotes $ ftext asm\n      cons  = doubleQuotes $ ftext constraints\n      rty'  = ppr rty\n      vars' = lparen <+> ppCommaJoin vars <+> rparen\n      side  = if sideeffect then text \"sideeffect\" else empty\n      align = if alignstack then text \"alignstack\" else empty\n  in text \"call\" <+> rty' <+> text \"asm\" <+> side <+> align <+> asm' <> comma\n        <+> cons <> vars'\n\nppExtract :: LlvmVar -> LlvmVar -> SDoc\nppExtract vec idx =\n    text \"extractelement\"\n    <+> ppr (getVarType vec) <+> ppName vec <> comma\n    <+> ppr idx\n\nppExtractV :: LlvmVar -> Int -> SDoc\nppExtractV struct idx =\n    text \"extractvalue\"\n    <+> ppr (getVarType struct) <+> ppName struct <> comma\n    <+> ppr idx\n\nppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc\nppInsert vec elt idx =\n    text \"insertelement\"\n    <+> ppr (getVarType vec) <+> ppName vec <> comma\n    <+> ppr (getVarType elt) <+> ppName elt <> comma\n    <+> ppr idx\n\n\nppMetaStatement :: [MetaAnnot] -> LlvmStatement -> SDoc\nppMetaStatement meta stmt = ppLlvmStatement stmt <> ppMetaAnnots meta\n\nppMetaExpr :: [MetaAnnot] -> LlvmExpression -> SDoc\nppMetaExpr meta expr = ppLlvmExpression expr <> ppMetaAnnots meta\n\nppMetaAnnots :: [MetaAnnot] -> SDoc\nppMetaAnnots meta = hcat $ map ppMeta meta\n  where\n    ppMeta (MetaAnnot name e)\n        = comma <+> exclamation <> ftext name <+>\n          case e of\n            MetaNode n    -> ppr n\n            MetaStruct ms -> exclamation <> braces (ppCommaJoin ms)\n            other         -> exclamation <> braces (ppr other) -- possible?\n\n\n--------------------------------------------------------------------------------\n-- * Misc functions\n--------------------------------------------------------------------------------\n\n-- | Blank line.\nnewLine :: SDoc\nnewLine = empty\n\n-- | Exclamation point.\nexclamation :: SDoc\nexclamation = char '!'\n", "num_lines": 500}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}\n\n--------------------------------------------------------------------------------\n-- | The LLVM Type System.\n--\n\nmodule Llvm.Types where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Data.Char\nimport Data.Int\nimport Numeric\n\nimport DynFlags\nimport FastString\nimport Outputable\nimport Unique\n\n-- from NCG\nimport PprBase\n\nimport GHC.Float\n\n-- -----------------------------------------------------------------------------\n-- * LLVM Basic Types and Variables\n--\n\n-- | A global mutable variable. Maybe defined or external\ndata LMGlobal = LMGlobal {\n  getGlobalVar :: LlvmVar,          -- ^ Returns the variable of the 'LMGlobal'\n  getGlobalValue :: Maybe LlvmStatic -- ^ Return the value of the 'LMGlobal'\n  }\n\n-- | A String in LLVM\ntype LMString = FastString\n\n-- | A type alias\ntype LlvmAlias = (LMString, LlvmType)\n\n-- | Llvm Types\ndata LlvmType\n  = LMInt Int             -- ^ An integer with a given width in bits.\n  | LMFloat               -- ^ 32 bit floating point\n  | LMDouble              -- ^ 64 bit floating point\n  | LMFloat80             -- ^ 80 bit (x86 only) floating point\n  | LMFloat128            -- ^ 128 bit floating point\n  | LMPointer LlvmType    -- ^ A pointer to a 'LlvmType'\n  | LMArray Int LlvmType  -- ^ An array of 'LlvmType'\n  | LMVector Int LlvmType -- ^ A vector of 'LlvmType'\n  | LMLabel               -- ^ A 'LlvmVar' can represent a label (address)\n  | LMVoid                -- ^ Void type\n  | LMStruct [LlvmType]   -- ^ Packed structure type\n  | LMStructU [LlvmType]  -- ^ Unpacked structure type\n  | LMAlias LlvmAlias     -- ^ A type alias\n  | LMMetadata            -- ^ LLVM Metadata\n\n  -- | Function type, used to create pointers to functions\n  | LMFunction LlvmFunctionDecl\n  deriving (Eq)\n\ninstance Outputable LlvmType where\n  ppr (LMInt size     ) = char 'i' <> ppr size\n  ppr (LMFloat        ) = text \"float\"\n  ppr (LMDouble       ) = text \"double\"\n  ppr (LMFloat80      ) = text \"x86_fp80\"\n  ppr (LMFloat128     ) = text \"fp128\"\n  ppr (LMPointer x    ) = ppr x <> char '*'\n  ppr (LMArray nr tp  ) = char '[' <> ppr nr <> text \" x \" <> ppr tp <> char ']'\n  ppr (LMVector nr tp ) = char '<' <> ppr nr <> text \" x \" <> ppr tp <> char '>'\n  ppr (LMLabel        ) = text \"label\"\n  ppr (LMVoid         ) = text \"void\"\n  ppr (LMStruct tys   ) = text \"<{\" <> ppCommaJoin tys <> text \"}>\"\n  ppr (LMStructU tys  ) = text \"{\" <> ppCommaJoin tys <> text \"}\"\n  ppr (LMMetadata     ) = text \"metadata\"\n\n  ppr (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))\n    = ppr r <+> lparen <> ppParams varg p <> rparen\n\n  ppr (LMAlias (s,_)) = char '%' <> ftext s\n\nppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc\nppParams varg p\n  = let varg' = case varg of\n          VarArgs | null args -> sLit \"...\"\n                  | otherwise -> sLit \", ...\"\n          _otherwise          -> sLit \"\"\n        -- by default we don't print param attributes\n        args = map fst p\n    in ppCommaJoin args <> ptext varg'\n\n-- | An LLVM section definition. If Nothing then let LLVM decide the section\ntype LMSection = Maybe LMString\ntype LMAlign = Maybe Int\n\ndata LMConst = Global      -- ^ Mutable global variable\n             | Constant    -- ^ Constant global variable\n             | Alias       -- ^ Alias of another variable\n             deriving (Eq)\n\n-- | LLVM Variables\ndata LlvmVar\n  -- | Variables with a global scope.\n  = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign LMConst\n  -- | Variables local to a function or parameters.\n  | LMLocalVar Unique LlvmType\n  -- | Named local variables. Sometimes we need to be able to explicitly name\n  -- variables (e.g for function arguments).\n  | LMNLocalVar LMString LlvmType\n  -- | A constant variable\n  | LMLitVar LlvmLit\n  deriving (Eq)\n\ninstance Outputable LlvmVar where\n  ppr (LMLitVar x)  = ppr x\n  ppr (x         )  = ppr (getVarType x) <+> ppName x\n\n\n-- | Llvm Literal Data.\n--\n-- These can be used inline in expressions.\ndata LlvmLit\n  -- | Refers to an integer constant (i64 42).\n  = LMIntLit Integer LlvmType\n  -- | Floating point literal\n  | LMFloatLit Double LlvmType\n  -- | Literal NULL, only applicable to pointer types\n  | LMNullLit LlvmType\n  -- | Vector literal\n  | LMVectorLit [LlvmLit]\n  -- | Undefined value, random bit pattern. Useful for optimisations.\n  | LMUndefLit LlvmType\n  deriving (Eq)\n\ninstance Outputable LlvmLit where\n  ppr l@(LMVectorLit {}) = ppLit l\n  ppr l                  = ppr (getLitType l) <+> ppLit l\n\n\n-- | Llvm Static Data.\n--\n-- These represent the possible global level variables and constants.\ndata LlvmStatic\n  = LMComment LMString                  -- ^ A comment in a static section\n  | LMStaticLit LlvmLit                 -- ^ A static variant of a literal value\n  | LMUninitType LlvmType               -- ^ For uninitialised data\n  | LMStaticStr LMString LlvmType       -- ^ Defines a static 'LMString'\n  | LMStaticArray [LlvmStatic] LlvmType -- ^ A static array\n  | LMStaticStruc [LlvmStatic] LlvmType -- ^ A static structure type\n  | LMStaticPointer LlvmVar             -- ^ A pointer to other data\n\n  -- static expressions, could split out but leave\n  -- for moment for ease of use. Not many of them.\n\n  | LMTrunc LlvmStatic LlvmType        -- ^ Truncate\n  | LMBitc LlvmStatic LlvmType         -- ^ Pointer to Pointer conversion\n  | LMPtoI LlvmStatic LlvmType         -- ^ Pointer to Integer conversion\n  | LMAdd LlvmStatic LlvmStatic        -- ^ Constant addition operation\n  | LMSub LlvmStatic LlvmStatic        -- ^ Constant subtraction operation\n\ninstance Outputable LlvmStatic where\n  ppr (LMComment       s) = text \"; \" <> ftext s\n  ppr (LMStaticLit   l  ) = ppr l\n  ppr (LMUninitType    t) = ppr t <> text \" undef\"\n  ppr (LMStaticStr   s t) = ppr t <> text \" c\\\"\" <> ftext s <> text \"\\\\00\\\"\"\n  ppr (LMStaticArray d t) = ppr t <> text \" [\" <> ppCommaJoin d <> char ']'\n  ppr (LMStaticStruc d t) = ppr t <> text \"<{\" <> ppCommaJoin d <> text \"}>\"\n  ppr (LMStaticPointer v) = ppr v\n  ppr (LMTrunc v t)\n      = ppr t <> text \" trunc (\" <> ppr v <> text \" to \" <> ppr t <> char ')'\n  ppr (LMBitc v t)\n      = ppr t <> text \" bitcast (\" <> ppr v <> text \" to \" <> ppr t <> char ')'\n  ppr (LMPtoI v t)\n      = ppr t <> text \" ptrtoint (\" <> ppr v <> text \" to \" <> ppr t <> char ')'\n\n  ppr (LMAdd s1 s2)\n      = pprStaticArith s1 s2 (sLit \"add\") (sLit \"fadd\") \"LMAdd\"\n  ppr (LMSub s1 s2)\n      = pprStaticArith s1 s2 (sLit \"sub\") (sLit \"fsub\") \"LMSub\"\n\n\npprSpecialStatic :: LlvmStatic -> SDoc\npprSpecialStatic (LMBitc v t) =\n    ppr (pLower t) <> text \", bitcast (\" <> ppr v <> text \" to \" <> ppr t\n        <> char ')'\npprSpecialStatic stat = ppr stat\n\n\npprStaticArith :: LlvmStatic -> LlvmStatic -> PtrString -> PtrString\n                  -> String -> SDoc\npprStaticArith s1 s2 int_op float_op op_name =\n  let ty1 = getStatType s1\n      op  = if isFloat ty1 then float_op else int_op\n  in if ty1 == getStatType s2\n     then ppr ty1 <+> ptext op <+> lparen <> ppr s1 <> comma <> ppr s2 <> rparen\n     else sdocWithDynFlags $ \\dflags ->\n            error $ op_name ++ \" with different types! s1: \"\n                    ++ showSDoc dflags (ppr s1) ++ \", s2: \" ++ showSDoc dflags (ppr s2)\n\n-- -----------------------------------------------------------------------------\n-- ** Operations on LLVM Basic Types and Variables\n--\n\n-- | Return the variable name or value of the 'LlvmVar'\n-- in Llvm IR textual representation (e.g. @\\@x@, @%y@ or @42@).\nppName :: LlvmVar -> SDoc\nppName v@(LMGlobalVar {}) = char '@' <> ppPlainName v\nppName v@(LMLocalVar  {}) = char '%' <> ppPlainName v\nppName v@(LMNLocalVar {}) = char '%' <> ppPlainName v\nppName v@(LMLitVar    {}) =             ppPlainName v\n\n-- | Return the variable name or value of the 'LlvmVar'\n-- in a plain textual representation (e.g. @x@, @y@ or @42@).\nppPlainName :: LlvmVar -> SDoc\nppPlainName (LMGlobalVar x _ _ _ _ _) = ftext x\nppPlainName (LMLocalVar  x LMLabel  ) = text (show x)\nppPlainName (LMLocalVar  x _        ) = text ('l' : show x)\nppPlainName (LMNLocalVar x _        ) = ftext x\nppPlainName (LMLitVar    x          ) = ppLit x\n\n-- | Print a literal value. No type.\nppLit :: LlvmLit -> SDoc\nppLit (LMIntLit i (LMInt 32))  = ppr (fromInteger i :: Int32)\nppLit (LMIntLit i (LMInt 64))  = ppr (fromInteger i :: Int64)\nppLit (LMIntLit   i _       )  = ppr ((fromInteger i)::Int)\nppLit (LMFloatLit r LMFloat )  = ppFloat $ narrowFp r\nppLit (LMFloatLit r LMDouble)  = ppDouble r\nppLit f@(LMFloatLit _ _)       = sdocWithDynFlags (\\dflags ->\n                                   error $ \"Can't print this float literal!\" ++ showSDoc dflags (ppr f))\nppLit (LMVectorLit ls  )       = char '<' <+> ppCommaJoin ls <+> char '>'\nppLit (LMNullLit _     )       = text \"null\"\n-- Trac 11487 was an issue where we passed undef for some arguments\n-- that were actually live. By chance the registers holding those\n-- arguments usually happened to have the right values anyways, but\n-- that was not guaranteed. To find such bugs reliably, we set the\n-- flag below when validating, which replaces undef literals (at\n-- common types) with values that are likely to cause a crash or test\n-- failure.\nppLit (LMUndefLit t    )       = sdocWithDynFlags f\n  where f dflags\n          | gopt Opt_LlvmFillUndefWithGarbage dflags,\n            Just lit <- garbageLit t   = ppLit lit\n          | otherwise                  = text \"undef\"\n\ngarbageLit :: LlvmType -> Maybe LlvmLit\ngarbageLit t@(LMInt w)     = Just (LMIntLit (0xbbbbbbbbbbbbbbb0 `mod` (2^w)) t)\n  -- Use a value that looks like an untagged pointer, so we are more\n  -- likely to try to enter it\ngarbageLit t\n  | isFloat t              = Just (LMFloatLit 12345678.9 t)\ngarbageLit t@(LMPointer _) = Just (LMNullLit t)\n  -- Using null isn't totally ideal, since some functions may check for null.\n  -- But producing another value is inconvenient since it needs a cast,\n  -- and the knowledge for how to format casts is in PpLlvm.\ngarbageLit _               = Nothing\n  -- More cases could be added, but this should do for now.\n\n-- | Return the 'LlvmType' of the 'LlvmVar'\ngetVarType :: LlvmVar -> LlvmType\ngetVarType (LMGlobalVar _ y _ _ _ _) = y\ngetVarType (LMLocalVar  _ y        ) = y\ngetVarType (LMNLocalVar _ y        ) = y\ngetVarType (LMLitVar    l          ) = getLitType l\n\n-- | Return the 'LlvmType' of a 'LlvmLit'\ngetLitType :: LlvmLit -> LlvmType\ngetLitType (LMIntLit   _ t) = t\ngetLitType (LMFloatLit _ t) = t\ngetLitType (LMVectorLit [])  = panic \"getLitType\"\ngetLitType (LMVectorLit ls)  = LMVector (length ls) (getLitType (head ls))\ngetLitType (LMNullLit    t) = t\ngetLitType (LMUndefLit   t) = t\n\n-- | Return the 'LlvmType' of the 'LlvmStatic'\ngetStatType :: LlvmStatic -> LlvmType\ngetStatType (LMStaticLit   l  ) = getLitType l\ngetStatType (LMUninitType    t) = t\ngetStatType (LMStaticStr   _ t) = t\ngetStatType (LMStaticArray _ t) = t\ngetStatType (LMStaticStruc _ t) = t\ngetStatType (LMStaticPointer v) = getVarType v\ngetStatType (LMTrunc       _ t) = t\ngetStatType (LMBitc        _ t) = t\ngetStatType (LMPtoI        _ t) = t\ngetStatType (LMAdd         t _) = getStatType t\ngetStatType (LMSub         t _) = getStatType t\ngetStatType (LMComment       _) = error \"Can't call getStatType on LMComment!\"\n\n-- | Return the 'LlvmLinkageType' for a 'LlvmVar'\ngetLink :: LlvmVar -> LlvmLinkageType\ngetLink (LMGlobalVar _ _ l _ _ _) = l\ngetLink _                         = Internal\n\n-- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid'\n-- cannot be lifted.\npLift :: LlvmType -> LlvmType\npLift LMLabel    = error \"Labels are unliftable\"\npLift LMVoid     = error \"Voids are unliftable\"\npLift LMMetadata = error \"Metadatas are unliftable\"\npLift x          = LMPointer x\n\n-- | Lift a variable to 'LMPointer' type.\npVarLift :: LlvmVar -> LlvmVar\npVarLift (LMGlobalVar s t l x a c) = LMGlobalVar s (pLift t) l x a c\npVarLift (LMLocalVar  s t        ) = LMLocalVar  s (pLift t)\npVarLift (LMNLocalVar s t        ) = LMNLocalVar s (pLift t)\npVarLift (LMLitVar    _          ) = error $ \"Can't lower a literal type!\"\n\n-- | Remove the pointer indirection of the supplied type. Only 'LMPointer'\n-- constructors can be lowered.\npLower :: LlvmType -> LlvmType\npLower (LMPointer x) = x\npLower x  = pprPanic \"llvmGen(pLower)\"\n            $ ppr x <+> text \" is a unlowerable type, need a pointer\"\n\n-- | Lower a variable of 'LMPointer' type.\npVarLower :: LlvmVar -> LlvmVar\npVarLower (LMGlobalVar s t l x a c) = LMGlobalVar s (pLower t) l x a c\npVarLower (LMLocalVar  s t        ) = LMLocalVar  s (pLower t)\npVarLower (LMNLocalVar s t        ) = LMNLocalVar s (pLower t)\npVarLower (LMLitVar    _          ) = error $ \"Can't lower a literal type!\"\n\n-- | Test if the given 'LlvmType' is an integer\nisInt :: LlvmType -> Bool\nisInt (LMInt _) = True\nisInt _         = False\n\n-- | Test if the given 'LlvmType' is a floating point type\nisFloat :: LlvmType -> Bool\nisFloat LMFloat    = True\nisFloat LMDouble   = True\nisFloat LMFloat80  = True\nisFloat LMFloat128 = True\nisFloat _          = False\n\n-- | Test if the given 'LlvmType' is an 'LMPointer' construct\nisPointer :: LlvmType -> Bool\nisPointer (LMPointer _) = True\nisPointer _             = False\n\n-- | Test if the given 'LlvmType' is an 'LMVector' construct\nisVector :: LlvmType -> Bool\nisVector (LMVector {}) = True\nisVector _             = False\n\n-- | Test if a 'LlvmVar' is global.\nisGlobal :: LlvmVar -> Bool\nisGlobal (LMGlobalVar _ _ _ _ _ _) = True\nisGlobal _                         = False\n\n-- | Width in bits of an 'LlvmType', returns 0 if not applicable\nllvmWidthInBits :: DynFlags -> LlvmType -> Int\nllvmWidthInBits _      (LMInt n)       = n\nllvmWidthInBits _      (LMFloat)       = 32\nllvmWidthInBits _      (LMDouble)      = 64\nllvmWidthInBits _      (LMFloat80)     = 80\nllvmWidthInBits _      (LMFloat128)    = 128\n-- Could return either a pointer width here or the width of what\n-- it points to. We will go with the former for now.\n-- PMW: At least judging by the way LLVM outputs constants, pointers\n--      should use the former, but arrays the latter.\nllvmWidthInBits dflags (LMPointer _)   = llvmWidthInBits dflags (llvmWord dflags)\nllvmWidthInBits dflags (LMArray n t)   = n * llvmWidthInBits dflags t\nllvmWidthInBits dflags (LMVector n ty) = n * llvmWidthInBits dflags ty\nllvmWidthInBits _      LMLabel         = 0\nllvmWidthInBits _      LMVoid          = 0\nllvmWidthInBits dflags (LMStruct tys)  = sum $ map (llvmWidthInBits dflags) tys\nllvmWidthInBits _      (LMStructU _)   =\n    -- It's not trivial to calculate the bit width of the unpacked structs,\n    -- since they will be aligned depending on the specified datalayout (\n    -- http://llvm.org/docs/LangRef.html#data-layout ). One way we could support\n    -- this could be to make the LlvmCodeGen.Ppr.moduleLayout be a data type\n    -- that exposes the alignment information. However, currently the only place\n    -- we use unpacked structs is LLVM intrinsics that return them (e.g.,\n    -- llvm.sadd.with.overflow.*), so we don't actually need to compute their\n    -- bit width.\n    panic \"llvmWidthInBits: not implemented for LMStructU\"\nllvmWidthInBits _      (LMFunction  _) = 0\nllvmWidthInBits dflags (LMAlias (_,t)) = llvmWidthInBits dflags t\nllvmWidthInBits _      LMMetadata      = panic \"llvmWidthInBits: Meta-data has no runtime representation!\"\n\n\n-- -----------------------------------------------------------------------------\n-- ** Shortcut for Common Types\n--\n\ni128, i64, i32, i16, i8, i1, i8Ptr :: LlvmType\ni128  = LMInt 128\ni64   = LMInt  64\ni32   = LMInt  32\ni16   = LMInt  16\ni8    = LMInt   8\ni1    = LMInt   1\ni8Ptr = pLift i8\n\n-- | The target architectures word size\nllvmWord, llvmWordPtr :: DynFlags -> LlvmType\nllvmWord    dflags = LMInt (wORD_SIZE dflags * 8)\nllvmWordPtr dflags = pLift (llvmWord dflags)\n\n-- -----------------------------------------------------------------------------\n-- * LLVM Function Types\n--\n\n-- | An LLVM Function\ndata LlvmFunctionDecl = LlvmFunctionDecl {\n        -- | Unique identifier of the function\n        decName       :: LMString,\n        -- | LinkageType of the function\n        funcLinkage   :: LlvmLinkageType,\n        -- | The calling convention of the function\n        funcCc        :: LlvmCallConvention,\n        -- | Type of the returned value\n        decReturnType :: LlvmType,\n        -- | Indicates if this function uses varargs\n        decVarargs    :: LlvmParameterListType,\n        -- | Parameter types and attributes\n        decParams     :: [LlvmParameter],\n        -- | Function align value, must be power of 2\n        funcAlign     :: LMAlign\n  }\n  deriving (Eq)\n\ninstance Outputable LlvmFunctionDecl where\n  ppr (LlvmFunctionDecl n l c r varg p a)\n    = let align = case a of\n                       Just a' -> text \" align \" <> ppr a'\n                       Nothing -> empty\n      in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <>\n             lparen <> ppParams varg p <> rparen <> align\n\ntype LlvmFunctionDecls = [LlvmFunctionDecl]\n\ntype LlvmParameter = (LlvmType, [LlvmParamAttr])\n\n-- | LLVM Parameter Attributes.\n--\n-- Parameter attributes are used to communicate additional information about\n-- the result or parameters of a function\ndata LlvmParamAttr\n  -- | This indicates to the code generator that the parameter or return value\n  -- should be zero-extended to a 32-bit value by the caller (for a parameter)\n  -- or the callee (for a return value).\n  = ZeroExt\n  -- | This indicates to the code generator that the parameter or return value\n  -- should be sign-extended to a 32-bit value by the caller (for a parameter)\n  -- or the callee (for a return value).\n  | SignExt\n  -- | This indicates that this parameter or return value should be treated in\n  -- a special target-dependent fashion during while emitting code for a\n  -- function call or return (usually, by putting it in a register as opposed\n  -- to memory).\n  | InReg\n  -- | This indicates that the pointer parameter should really be passed by\n  -- value to the function.\n  | ByVal\n  -- | This indicates that the pointer parameter specifies the address of a\n  -- structure that is the return value of the function in the source program.\n  | SRet\n  -- | This indicates that the pointer does not alias any global or any other\n  -- parameter.\n  | NoAlias\n  -- | This indicates that the callee does not make any copies of the pointer\n  -- that outlive the callee itself\n  | NoCapture\n  -- | This indicates that the pointer parameter can be excised using the\n  -- trampoline intrinsics.\n  | Nest\n  deriving (Eq)\n\ninstance Outputable LlvmParamAttr where\n  ppr ZeroExt   = text \"zeroext\"\n  ppr SignExt   = text \"signext\"\n  ppr InReg     = text \"inreg\"\n  ppr ByVal     = text \"byval\"\n  ppr SRet      = text \"sret\"\n  ppr NoAlias   = text \"noalias\"\n  ppr NoCapture = text \"nocapture\"\n  ppr Nest      = text \"nest\"\n\n-- | Llvm Function Attributes.\n--\n-- Function attributes are set to communicate additional information about a\n-- function. Function attributes are considered to be part of the function,\n-- not of the function type, so functions with different parameter attributes\n-- can have the same function type. Functions can have multiple attributes.\n--\n-- Descriptions taken from <http://llvm.org/docs/LangRef.html#fnattrs>\ndata LlvmFuncAttr\n  -- | This attribute indicates that the inliner should attempt to inline this\n  -- function into callers whenever possible, ignoring any active inlining\n  -- size threshold for this caller.\n  = AlwaysInline\n  -- | This attribute indicates that the source code contained a hint that\n  -- inlining this function is desirable (such as the \\\"inline\\\" keyword in\n  -- C/C++). It is just a hint; it imposes no requirements on the inliner.\n  | InlineHint\n  -- | This attribute indicates that the inliner should never inline this\n  -- function in any situation. This attribute may not be used together\n  -- with the alwaysinline attribute.\n  | NoInline\n  -- | This attribute suggests that optimization passes and code generator\n  -- passes make choices that keep the code size of this function low, and\n  -- otherwise do optimizations specifically to reduce code size.\n  | OptSize\n  -- | This function attribute indicates that the function never returns\n  -- normally. This produces undefined behavior at runtime if the function\n  -- ever does dynamically return.\n  | NoReturn\n  -- | This function attribute indicates that the function never returns with\n  -- an unwind or exceptional control flow. If the function does unwind, its\n  -- runtime behavior is undefined.\n  | NoUnwind\n  -- | This attribute indicates that the function computes its result (or\n  -- decides to unwind an exception) based strictly on its arguments, without\n  -- dereferencing any pointer arguments or otherwise accessing any mutable\n  -- state (e.g. memory, control registers, etc) visible to caller functions.\n  -- It does not write through any pointer arguments (including byval\n  -- arguments) and never changes any state visible to callers. This means\n  -- that it cannot unwind exceptions by calling the C++ exception throwing\n  -- methods, but could use the unwind instruction.\n  | ReadNone\n  -- | This attribute indicates that the function does not write through any\n  -- pointer arguments (including byval arguments) or otherwise modify any\n  -- state (e.g. memory, control registers, etc) visible to caller functions.\n  -- It may dereference pointer arguments and read state that may be set in\n  -- the caller. A readonly function always returns the same value (or unwinds\n  -- an exception identically) when called with the same set of arguments and\n  -- global state. It cannot unwind an exception by calling the C++ exception\n  -- throwing methods, but may use the unwind instruction.\n  | ReadOnly\n  -- | This attribute indicates that the function should emit a stack smashing\n  -- protector. It is in the form of a \\\"canary\\\"\u00e2\u20ac\u201da random value placed on the\n  -- stack before the local variables that's checked upon return from the\n  -- function to see if it has been overwritten. A heuristic is used to\n  -- determine if a function needs stack protectors or not.\n  --\n  -- If a function that has an ssp attribute is inlined into a function that\n  -- doesn't have an ssp attribute, then the resulting function will have an\n  -- ssp attribute.\n  | Ssp\n  -- | This attribute indicates that the function should always emit a stack\n  -- smashing protector. This overrides the ssp function attribute.\n  --\n  -- If a function that has an sspreq attribute is inlined into a function\n  -- that doesn't have an sspreq attribute or which has an ssp attribute,\n  -- then the resulting function will have an sspreq attribute.\n  | SspReq\n  -- | This attribute indicates that the code generator should not use a red\n  -- zone, even if the target-specific ABI normally permits it.\n  | NoRedZone\n  -- | This attributes disables implicit floating point instructions.\n  | NoImplicitFloat\n  -- | This attribute disables prologue / epilogue emission for the function.\n  -- This can have very system-specific consequences.\n  | Naked\n  deriving (Eq)\n\ninstance Outputable LlvmFuncAttr where\n  ppr AlwaysInline       = text \"alwaysinline\"\n  ppr InlineHint         = text \"inlinehint\"\n  ppr NoInline           = text \"noinline\"\n  ppr OptSize            = text \"optsize\"\n  ppr NoReturn           = text \"noreturn\"\n  ppr NoUnwind           = text \"nounwind\"\n  ppr ReadNone           = text \"readnon\"\n  ppr ReadOnly           = text \"readonly\"\n  ppr Ssp                = text \"ssp\"\n  ppr SspReq             = text \"ssqreq\"\n  ppr NoRedZone          = text \"noredzone\"\n  ppr NoImplicitFloat    = text \"noimplicitfloat\"\n  ppr Naked              = text \"naked\"\n\n\n-- | Different types to call a function.\ndata LlvmCallType\n  -- | Normal call, allocate a new stack frame.\n  = StdCall\n  -- | Tail call, perform the call in the current stack frame.\n  | TailCall\n  deriving (Eq,Show)\n\n-- | Different calling conventions a function can use.\ndata LlvmCallConvention\n  -- | The C calling convention.\n  -- This calling convention (the default if no other calling convention is\n  -- specified) matches the target C calling conventions. This calling\n  -- convention supports varargs function calls and tolerates some mismatch in\n  -- the declared prototype and implemented declaration of the function (as\n  -- does normal C).\n  = CC_Ccc\n  -- | This calling convention attempts to make calls as fast as possible\n  -- (e.g. by passing things in registers). This calling convention allows\n  -- the target to use whatever tricks it wants to produce fast code for the\n  -- target, without having to conform to an externally specified ABI\n  -- (Application Binary Interface). Implementations of this convention should\n  -- allow arbitrary tail call optimization to be supported. This calling\n  -- convention does not support varargs and requires the prototype of al\n  -- callees to exactly match the prototype of the function definition.\n  | CC_Fastcc\n  -- | This calling convention attempts to make code in the caller as efficient\n  -- as possible under the assumption that the call is not commonly executed.\n  -- As such, these calls often preserve all registers so that the call does\n  -- not break any live ranges in the caller side. This calling convention\n  -- does not support varargs and requires the prototype of all callees to\n  -- exactly match the prototype of the function definition.\n  | CC_Coldcc\n  -- | The GHC-specific 'registerised' calling convention.\n  | CC_Ghc\n  -- | Any calling convention may be specified by number, allowing\n  -- target-specific calling conventions to be used. Target specific calling\n  -- conventions start at 64.\n  | CC_Ncc Int\n  -- | X86 Specific 'StdCall' convention. LLVM includes a specific alias for it\n  -- rather than just using CC_Ncc.\n  | CC_X86_Stdcc\n  deriving (Eq)\n\ninstance Outputable LlvmCallConvention where\n  ppr CC_Ccc       = text \"ccc\"\n  ppr CC_Fastcc    = text \"fastcc\"\n  ppr CC_Coldcc    = text \"coldcc\"\n  ppr CC_Ghc       = text \"ghccc\"\n  ppr (CC_Ncc i)   = text \"cc \" <> ppr i\n  ppr CC_X86_Stdcc = text \"x86_stdcallcc\"\n\n\n-- | Functions can have a fixed amount of parameters, or a variable amount.\ndata LlvmParameterListType\n  -- Fixed amount of arguments.\n  = FixedArgs\n  -- Variable amount of arguments.\n  | VarArgs\n  deriving (Eq,Show)\n\n\n-- | Linkage type of a symbol.\n--\n-- The description of the constructors is copied from the Llvm Assembly Language\n-- Reference Manual <http://www.llvm.org/docs/LangRef.html#linkage>, because\n-- they correspond to the Llvm linkage types.\ndata LlvmLinkageType\n  -- | Global values with internal linkage are only directly accessible by\n  -- objects in the current module. In particular, linking code into a module\n  -- with an internal global value may cause the internal to be renamed as\n  -- necessary to avoid collisions. Because the symbol is internal to the\n  -- module, all references can be updated. This corresponds to the notion\n  -- of the @static@ keyword in C.\n  = Internal\n  -- | Globals with @linkonce@ linkage are merged with other globals of the\n  -- same name when linkage occurs. This is typically used to implement\n  -- inline functions, templates, or other code which must be generated\n  -- in each translation unit that uses it. Unreferenced linkonce globals are\n  -- allowed to be discarded.\n  | LinkOnce\n  -- | @weak@ linkage is exactly the same as linkonce linkage, except that\n  -- unreferenced weak globals may not be discarded. This is used for globals\n  -- that may be emitted in multiple translation units, but that are not\n  -- guaranteed to be emitted into every translation unit that uses them. One\n  -- example of this are common globals in C, such as @int X;@ at global\n  -- scope.\n  | Weak\n  -- | @appending@ linkage may only be applied to global variables of pointer\n  -- to array type. When two global variables with appending linkage are\n  -- linked together, the two global arrays are appended together. This is\n  -- the Llvm, typesafe, equivalent of having the system linker append\n  -- together @sections@ with identical names when .o files are linked.\n  | Appending\n  -- | The semantics of this linkage follow the ELF model: the symbol is weak\n  -- until linked, if not linked, the symbol becomes null instead of being an\n  -- undefined reference.\n  | ExternWeak\n  -- | The symbol participates in linkage and can be used to resolve external\n  --  symbol references.\n  | ExternallyVisible\n  -- | Alias for 'ExternallyVisible' but with explicit textual form in LLVM\n  --  assembly.\n  | External\n  -- | Symbol is private to the module and should not appear in the symbol table\n  | Private\n  deriving (Eq)\n\ninstance Outputable LlvmLinkageType where\n  ppr Internal          = text \"internal\"\n  ppr LinkOnce          = text \"linkonce\"\n  ppr Weak              = text \"weak\"\n  ppr Appending         = text \"appending\"\n  ppr ExternWeak        = text \"extern_weak\"\n  -- ExternallyVisible does not have a textual representation, it is\n  -- the linkage type a function resolves to if no other is specified\n  -- in Llvm.\n  ppr ExternallyVisible = empty\n  ppr External          = text \"external\"\n  ppr Private           = text \"private\"\n\n-- -----------------------------------------------------------------------------\n-- * LLVM Operations\n--\n\n-- | Llvm binary operators machine operations.\ndata LlvmMachOp\n  = LM_MO_Add  -- ^ add two integer, floating point or vector values.\n  | LM_MO_Sub  -- ^ subtract two ...\n  | LM_MO_Mul  -- ^ multiply ..\n  | LM_MO_UDiv -- ^ unsigned integer or vector division.\n  | LM_MO_SDiv -- ^ signed integer ..\n  | LM_MO_URem -- ^ unsigned integer or vector remainder (mod)\n  | LM_MO_SRem -- ^ signed ...\n\n  | LM_MO_FAdd -- ^ add two floating point or vector values.\n  | LM_MO_FSub -- ^ subtract two ...\n  | LM_MO_FMul -- ^ multiply ...\n  | LM_MO_FDiv -- ^ divide ...\n  | LM_MO_FRem -- ^ remainder ...\n\n  -- | Left shift\n  | LM_MO_Shl\n  -- | Logical shift right\n  -- Shift right, filling with zero\n  | LM_MO_LShr\n  -- | Arithmetic shift right\n  -- The most significant bits of the result will be equal to the sign bit of\n  -- the left operand.\n  | LM_MO_AShr\n\n  | LM_MO_And -- ^ AND bitwise logical operation.\n  | LM_MO_Or  -- ^ OR bitwise logical operation.\n  | LM_MO_Xor -- ^ XOR bitwise logical operation.\n  deriving (Eq)\n\ninstance Outputable LlvmMachOp where\n  ppr LM_MO_Add  = text \"add\"\n  ppr LM_MO_Sub  = text \"sub\"\n  ppr LM_MO_Mul  = text \"mul\"\n  ppr LM_MO_UDiv = text \"udiv\"\n  ppr LM_MO_SDiv = text \"sdiv\"\n  ppr LM_MO_URem = text \"urem\"\n  ppr LM_MO_SRem = text \"srem\"\n  ppr LM_MO_FAdd = text \"fadd\"\n  ppr LM_MO_FSub = text \"fsub\"\n  ppr LM_MO_FMul = text \"fmul\"\n  ppr LM_MO_FDiv = text \"fdiv\"\n  ppr LM_MO_FRem = text \"frem\"\n  ppr LM_MO_Shl  = text \"shl\"\n  ppr LM_MO_LShr = text \"lshr\"\n  ppr LM_MO_AShr = text \"ashr\"\n  ppr LM_MO_And  = text \"and\"\n  ppr LM_MO_Or   = text \"or\"\n  ppr LM_MO_Xor  = text \"xor\"\n\n\n-- | Llvm compare operations.\ndata LlvmCmpOp\n  = LM_CMP_Eq  -- ^ Equal (Signed and Unsigned)\n  | LM_CMP_Ne  -- ^ Not equal (Signed and Unsigned)\n  | LM_CMP_Ugt -- ^ Unsigned greater than\n  | LM_CMP_Uge -- ^ Unsigned greater than or equal\n  | LM_CMP_Ult -- ^ Unsigned less than\n  | LM_CMP_Ule -- ^ Unsigned less than or equal\n  | LM_CMP_Sgt -- ^ Signed greater than\n  | LM_CMP_Sge -- ^ Signed greater than or equal\n  | LM_CMP_Slt -- ^ Signed less than\n  | LM_CMP_Sle -- ^ Signed less than or equal\n\n  -- Float comparisons. GHC uses a mix of ordered and unordered float\n  -- comparisons.\n  | LM_CMP_Feq -- ^ Float equal\n  | LM_CMP_Fne -- ^ Float not equal\n  | LM_CMP_Fgt -- ^ Float greater than\n  | LM_CMP_Fge -- ^ Float greater than or equal\n  | LM_CMP_Flt -- ^ Float less than\n  | LM_CMP_Fle -- ^ Float less than or equal\n  deriving (Eq)\n\ninstance Outputable LlvmCmpOp where\n  ppr LM_CMP_Eq  = text \"eq\"\n  ppr LM_CMP_Ne  = text \"ne\"\n  ppr LM_CMP_Ugt = text \"ugt\"\n  ppr LM_CMP_Uge = text \"uge\"\n  ppr LM_CMP_Ult = text \"ult\"\n  ppr LM_CMP_Ule = text \"ule\"\n  ppr LM_CMP_Sgt = text \"sgt\"\n  ppr LM_CMP_Sge = text \"sge\"\n  ppr LM_CMP_Slt = text \"slt\"\n  ppr LM_CMP_Sle = text \"sle\"\n  ppr LM_CMP_Feq = text \"oeq\"\n  ppr LM_CMP_Fne = text \"une\"\n  ppr LM_CMP_Fgt = text \"ogt\"\n  ppr LM_CMP_Fge = text \"oge\"\n  ppr LM_CMP_Flt = text \"olt\"\n  ppr LM_CMP_Fle = text \"ole\"\n\n\n-- | Llvm cast operations.\ndata LlvmCastOp\n  = LM_Trunc    -- ^ Integer truncate\n  | LM_Zext     -- ^ Integer extend (zero fill)\n  | LM_Sext     -- ^ Integer extend (sign fill)\n  | LM_Fptrunc  -- ^ Float truncate\n  | LM_Fpext    -- ^ Float extend\n  | LM_Fptoui   -- ^ Float to unsigned Integer\n  | LM_Fptosi   -- ^ Float to signed Integer\n  | LM_Uitofp   -- ^ Unsigned Integer to Float\n  | LM_Sitofp   -- ^ Signed Int to Float\n  | LM_Ptrtoint -- ^ Pointer to Integer\n  | LM_Inttoptr -- ^ Integer to Pointer\n  | LM_Bitcast  -- ^ Cast between types where no bit manipulation is needed\n  deriving (Eq)\n\ninstance Outputable LlvmCastOp where\n  ppr LM_Trunc    = text \"trunc\"\n  ppr LM_Zext     = text \"zext\"\n  ppr LM_Sext     = text \"sext\"\n  ppr LM_Fptrunc  = text \"fptrunc\"\n  ppr LM_Fpext    = text \"fpext\"\n  ppr LM_Fptoui   = text \"fptoui\"\n  ppr LM_Fptosi   = text \"fptosi\"\n  ppr LM_Uitofp   = text \"uitofp\"\n  ppr LM_Sitofp   = text \"sitofp\"\n  ppr LM_Ptrtoint = text \"ptrtoint\"\n  ppr LM_Inttoptr = text \"inttoptr\"\n  ppr LM_Bitcast  = text \"bitcast\"\n\n\n-- -----------------------------------------------------------------------------\n-- * Floating point conversion\n--\n\n-- | Convert a Haskell Double to an LLVM hex encoded floating point form. In\n-- Llvm float literals can be printed in a big-endian hexadecimal format,\n-- regardless of underlying architecture.\n--\n-- See Note [LLVM Float Types].\nppDouble :: Double -> SDoc\nppDouble d\n  = let bs     = doubleToBytes d\n        hex d' = case showHex d' \"\" of\n                     []    -> error \"dToStr: too few hex digits for float\"\n                     [x]   -> ['0',x]\n                     [x,y] -> [x,y]\n                     _     -> error \"dToStr: too many hex digits for float\"\n\n        str  = map toUpper $ concat $ fixEndian $ map hex bs\n    in  text \"0x\" <> text str\n\n-- Note [LLVM Float Types]\n-- ~~~~~~~~~~~~~~~~~~~~~~~\n-- We use 'ppDouble' for both printing Float and Double floating point types. This is\n-- as LLVM expects all floating point constants (single & double) to be in IEEE\n-- 754 Double precision format. However, for single precision numbers (Float)\n-- they should be *representable* in IEEE 754 Single precision format. So the\n-- easiest way to do this is to narrow and widen again.\n-- (i.e., Double -> Float -> Double). We must be careful doing this that GHC\n-- doesn't optimize that away.\n\n-- Note [narrowFp & widenFp]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~\n-- NOTE: we use float2Double & co directly as GHC likes to optimize away\n-- successive calls of 'realToFrac', defeating the narrowing. (Bug #7600).\n-- 'realToFrac' has inconsistent behaviour with optimisation as well that can\n-- also cause issues, these methods don't.\n\nnarrowFp :: Double -> Float\n{-# NOINLINE narrowFp #-}\nnarrowFp = double2Float\n\nwidenFp :: Float -> Double\n{-# NOINLINE widenFp #-}\nwidenFp = float2Double\n\nppFloat :: Float -> SDoc\nppFloat = ppDouble . widenFp\n\n-- | Reverse or leave byte data alone to fix endianness on this target.\nfixEndian :: [a] -> [a]\n#if defined(WORDS_BIGENDIAN)\nfixEndian = id\n#else\nfixEndian = reverse\n#endif\n\n\n--------------------------------------------------------------------------------\n-- * Misc functions\n--------------------------------------------------------------------------------\n\nppCommaJoin :: (Outputable a) => [a] -> SDoc\nppCommaJoin strs = hsep $ punctuate comma (map ppr strs)\n\nppSpaceJoin :: (Outputable a) => [a] -> SDoc\nppSpaceJoin strs = hsep (map ppr strs)\n", "num_lines": 894}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- ----------------------------------------------------------------------------\n-- | Base LLVM Code Generation module\n--\n-- Contains functions useful through out the code generator.\n--\n\nmodule LlvmCodeGen.Base (\n\n        LlvmCmmDecl, LlvmBasicBlock,\n        LiveGlobalRegs,\n        LlvmUnresData, LlvmData, UnresLabel, UnresStatic,\n\n        LlvmVersion, supportedLlvmVersion, llvmVersionStr,\n\n        LlvmM,\n        runLlvm, liftStream, withClearVars, varLookup, varInsert,\n        markStackReg, checkStackReg,\n        funLookup, funInsert, getLlvmVer, getDynFlags, getDynFlag, getLlvmPlatform,\n        dumpIfSetLlvm, renderLlvm, markUsedVar, getUsedVars,\n        ghcInternalFunctions,\n\n        getMetaUniqueId,\n        setUniqMeta, getUniqMeta,\n\n        cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,\n        llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,\n        llvmPtrBits, tysToParams, llvmFunSection,\n\n        strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,\n        getGlobalPtr, generateExternDecls,\n\n        aliasify,\n    ) where\n\n#include \"HsVersions.h\"\n#include \"ghcautoconf.h\"\n\nimport GhcPrelude\n\nimport Llvm\nimport LlvmCodeGen.Regs\n\nimport CLabel\nimport CodeGen.Platform ( activeStgRegs )\nimport DynFlags\nimport FastString\nimport Cmm              hiding ( succ )\nimport Outputable as Outp\nimport Platform\nimport UniqFM\nimport Unique\nimport BufWrite   ( BufHandle )\nimport UniqSet\nimport UniqSupply\nimport ErrUtils\nimport qualified Stream\n\nimport Control.Monad (ap)\n\n-- ----------------------------------------------------------------------------\n-- * Some Data Types\n--\n\ntype LlvmCmmDecl = GenCmmDecl [LlvmData] (Maybe CmmStatics) (ListGraph LlvmStatement)\ntype LlvmBasicBlock = GenBasicBlock LlvmStatement\n\n-- | Global registers live on proc entry\ntype LiveGlobalRegs = [GlobalReg]\n\n-- | Unresolved code.\n-- Of the form: (data label, data type, unresolved data)\ntype LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic])\n\n-- | Top level LLVM Data (globals and type aliases)\ntype LlvmData = ([LMGlobal], [LlvmType])\n\n-- | An unresolved Label.\n--\n-- Labels are unresolved when we haven't yet determined if they are defined in\n-- the module we are currently compiling, or an external one.\ntype UnresLabel  = CmmLit\ntype UnresStatic = Either UnresLabel LlvmStatic\n\n-- ----------------------------------------------------------------------------\n-- * Type translations\n--\n\n-- | Translate a basic CmmType to an LlvmType.\ncmmToLlvmType :: CmmType -> LlvmType\ncmmToLlvmType ty | isVecType ty   = LMVector (vecLength ty) (cmmToLlvmType (vecElemType ty))\n                 | isFloatType ty = widthToLlvmFloat $ typeWidth ty\n                 | otherwise      = widthToLlvmInt   $ typeWidth ty\n\n-- | Translate a Cmm Float Width to a LlvmType.\nwidthToLlvmFloat :: Width -> LlvmType\nwidthToLlvmFloat W32  = LMFloat\nwidthToLlvmFloat W64  = LMDouble\nwidthToLlvmFloat W80  = LMFloat80\nwidthToLlvmFloat W128 = LMFloat128\nwidthToLlvmFloat w    = panic $ \"widthToLlvmFloat: Bad float size: \" ++ show w\n\n-- | Translate a Cmm Bit Width to a LlvmType.\nwidthToLlvmInt :: Width -> LlvmType\nwidthToLlvmInt w = LMInt $ widthInBits w\n\n-- | GHC Call Convention for LLVM\nllvmGhcCC :: DynFlags -> LlvmCallConvention\nllvmGhcCC dflags\n | platformUnregisterised (targetPlatform dflags) = CC_Ccc\n | otherwise                                      = CC_Ghc\n\n-- | Llvm Function type for Cmm function\nllvmFunTy :: LiveGlobalRegs -> LlvmM LlvmType\nllvmFunTy live = return . LMFunction =<< llvmFunSig' live (fsLit \"a\") ExternallyVisible\n\n-- | Llvm Function signature\nllvmFunSig :: LiveGlobalRegs ->  CLabel -> LlvmLinkageType -> LlvmM LlvmFunctionDecl\nllvmFunSig live lbl link = do\n  lbl' <- strCLabel_llvm lbl\n  llvmFunSig' live lbl' link\n\nllvmFunSig' :: LiveGlobalRegs -> LMString -> LlvmLinkageType -> LlvmM LlvmFunctionDecl\nllvmFunSig' live lbl link\n  = do let toParams x | isPointer x = (x, [NoAlias, NoCapture])\n                      | otherwise   = (x, [])\n       dflags <- getDynFlags\n       return $ LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs\n                                 (map (toParams . getVarType) (llvmFunArgs dflags live))\n                                 (llvmFunAlign dflags)\n\n-- | Alignment to use for functions\nllvmFunAlign :: DynFlags -> LMAlign\nllvmFunAlign dflags = Just (wORD_SIZE dflags)\n\n-- | Alignment to use for into tables\nllvmInfAlign :: DynFlags -> LMAlign\nllvmInfAlign dflags = Just (wORD_SIZE dflags)\n\n-- | Section to use for a function\nllvmFunSection :: DynFlags -> LMString -> LMSection\nllvmFunSection dflags lbl\n    | gopt Opt_SplitSections dflags = Just (concatFS [fsLit \".text.\", lbl])\n    | otherwise                     = Nothing\n\n-- | A Function's arguments\nllvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]\nllvmFunArgs dflags live =\n    map (lmGlobalRegArg dflags) (filter isPassed (activeStgRegs platform))\n    where platform = targetPlatform dflags\n          isLive r = not (isSSE r) || r `elem` alwaysLive || r `elem` live\n          isPassed r = not (isSSE r) || isLive r\n          isSSE (FloatReg _)  = True\n          isSSE (DoubleReg _) = True\n          isSSE (XmmReg _)    = True\n          isSSE (YmmReg _)    = True\n          isSSE (ZmmReg _)    = True\n          isSSE _             = False\n\n-- | Llvm standard fun attributes\nllvmStdFunAttrs :: [LlvmFuncAttr]\nllvmStdFunAttrs = [NoUnwind]\n\n-- | Convert a list of types to a list of function parameters\n-- (each with no parameter attributes)\ntysToParams :: [LlvmType] -> [LlvmParameter]\ntysToParams = map (\\ty -> (ty, []))\n\n-- | Pointer width\nllvmPtrBits :: DynFlags -> Int\nllvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags\n\n-- ----------------------------------------------------------------------------\n-- * Llvm Version\n--\n\n-- | LLVM Version Number\ntype LlvmVersion = (Int, Int)\n\n-- | The LLVM Version that is currently supported.\nsupportedLlvmVersion :: LlvmVersion\nsupportedLlvmVersion = sUPPORTED_LLVM_VERSION\n\nllvmVersionStr :: LlvmVersion -> String\nllvmVersionStr (major, minor) = show major ++ \".\" ++ show minor\n\n-- ----------------------------------------------------------------------------\n-- * Environment Handling\n--\n\ndata LlvmEnv = LlvmEnv\n  { envVersion :: LlvmVersion      -- ^ LLVM version\n  , envDynFlags :: DynFlags        -- ^ Dynamic flags\n  , envOutput :: BufHandle         -- ^ Output buffer\n  , envUniq :: UniqSupply          -- ^ Supply of unique values\n  , envFreshMeta :: MetaId         -- ^ Supply of fresh metadata IDs\n  , envUniqMeta :: UniqFM MetaId   -- ^ Global metadata nodes\n  , envFunMap :: LlvmEnvMap        -- ^ Global functions so far, with type\n  , envAliases :: UniqSet LMString -- ^ Globals that we had to alias, see [Llvm Forward References]\n  , envUsedVars :: [LlvmVar]       -- ^ Pointers to be added to llvm.used (see @cmmUsedLlvmGens@)\n\n    -- the following get cleared for every function (see @withClearVars@)\n  , envVarMap :: LlvmEnvMap        -- ^ Local variables so far, with type\n  , envStackRegs :: [GlobalReg]    -- ^ Non-constant registers (alloca'd in the function prelude)\n  }\n\ntype LlvmEnvMap = UniqFM LlvmType\n\n-- | The Llvm monad. Wraps @LlvmEnv@ state as well as the @IO@ monad\nnewtype LlvmM a = LlvmM { runLlvmM :: LlvmEnv -> IO (a, LlvmEnv) }\n\ninstance Functor LlvmM where\n    fmap f m = LlvmM $ \\env -> do (x, env') <- runLlvmM m env\n                                  return (f x, env')\n\ninstance Applicative LlvmM where\n    pure x = LlvmM $ \\env -> return (x, env)\n    (<*>) = ap\n\ninstance Monad LlvmM where\n    m >>= f  = LlvmM $ \\env -> do (x, env') <- runLlvmM m env\n                                  runLlvmM (f x) env'\n\ninstance HasDynFlags LlvmM where\n    getDynFlags = LlvmM $ \\env -> return (envDynFlags env, env)\n\ninstance MonadUnique LlvmM where\n    getUniqueSupplyM = do\n        us <- getEnv envUniq\n        let (us1, us2) = splitUniqSupply us\n        modifyEnv (\\s -> s { envUniq = us2 })\n        return us1\n\n    getUniqueM = do\n        us <- getEnv envUniq\n        let (u,us') = takeUniqFromSupply us\n        modifyEnv (\\s -> s { envUniq = us' })\n        return u\n\n-- | Lifting of IO actions. Not exported, as we want to encapsulate IO.\nliftIO :: IO a -> LlvmM a\nliftIO m = LlvmM $ \\env -> do x <- m\n                              return (x, env)\n\n-- | Get initial Llvm environment.\nrunLlvm :: DynFlags -> LlvmVersion -> BufHandle -> UniqSupply -> LlvmM () -> IO ()\nrunLlvm dflags ver out us m = do\n    _ <- runLlvmM m env\n    return ()\n  where env = LlvmEnv { envFunMap = emptyUFM\n                      , envVarMap = emptyUFM\n                      , envStackRegs = []\n                      , envUsedVars = []\n                      , envAliases = emptyUniqSet\n                      , envVersion = ver\n                      , envDynFlags = dflags\n                      , envOutput = out\n                      , envUniq = us\n                      , envFreshMeta = MetaId 0\n                      , envUniqMeta = emptyUFM\n                      }\n\n-- | Get environment (internal)\ngetEnv :: (LlvmEnv -> a) -> LlvmM a\ngetEnv f = LlvmM (\\env -> return (f env, env))\n\n-- | Modify environment (internal)\nmodifyEnv :: (LlvmEnv -> LlvmEnv) -> LlvmM ()\nmodifyEnv f = LlvmM (\\env -> return ((), f env))\n\n-- | Lift a stream into the LlvmM monad\nliftStream :: Stream.Stream IO a x -> Stream.Stream LlvmM a x\nliftStream s = Stream.Stream $ do\n  r <- liftIO $ Stream.runStream s\n  case r of\n    Left b        -> return (Left b)\n    Right (a, r2) -> return (Right (a, liftStream r2))\n\n-- | Clear variables from the environment for a subcomputation\nwithClearVars :: LlvmM a -> LlvmM a\nwithClearVars m = LlvmM $ \\env -> do\n    (x, env') <- runLlvmM m env { envVarMap = emptyUFM, envStackRegs = [] }\n    return (x, env' { envVarMap = emptyUFM, envStackRegs = [] })\n\n-- | Insert variables or functions into the environment.\nvarInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmM ()\nvarInsert s t = modifyEnv $ \\env -> env { envVarMap = addToUFM (envVarMap env) s t }\nfunInsert s t = modifyEnv $ \\env -> env { envFunMap = addToUFM (envFunMap env) s t }\n\n-- | Lookup variables or functions in the environment.\nvarLookup, funLookup :: Uniquable key => key -> LlvmM (Maybe LlvmType)\nvarLookup s = getEnv (flip lookupUFM s . envVarMap)\nfunLookup s = getEnv (flip lookupUFM s . envFunMap)\n\n-- | Set a register as allocated on the stack\nmarkStackReg :: GlobalReg -> LlvmM ()\nmarkStackReg r = modifyEnv $ \\env -> env { envStackRegs = r : envStackRegs env }\n\n-- | Check whether a register is allocated on the stack\ncheckStackReg :: GlobalReg -> LlvmM Bool\ncheckStackReg r = getEnv ((elem r) . envStackRegs)\n\n-- | Allocate a new global unnamed metadata identifier\ngetMetaUniqueId :: LlvmM MetaId\ngetMetaUniqueId = LlvmM $ \\env ->\n    return (envFreshMeta env, env { envFreshMeta = succ $ envFreshMeta env })\n\n-- | Get the LLVM version we are generating code for\ngetLlvmVer :: LlvmM LlvmVersion\ngetLlvmVer = getEnv envVersion\n\n-- | Get the platform we are generating code for\ngetDynFlag :: (DynFlags -> a) -> LlvmM a\ngetDynFlag f = getEnv (f . envDynFlags)\n\n-- | Get the platform we are generating code for\ngetLlvmPlatform :: LlvmM Platform\ngetLlvmPlatform = getDynFlag targetPlatform\n\n-- | Dumps the document if the corresponding flag has been set by the user\ndumpIfSetLlvm :: DumpFlag -> String -> Outp.SDoc -> LlvmM ()\ndumpIfSetLlvm flag hdr doc = do\n  dflags <- getDynFlags\n  liftIO $ dumpIfSet_dyn dflags flag hdr doc\n\n-- | Prints the given contents to the output handle\nrenderLlvm :: Outp.SDoc -> LlvmM ()\nrenderLlvm sdoc = do\n\n    -- Write to output\n    dflags <- getDynFlags\n    out <- getEnv envOutput\n    liftIO $ Outp.bufLeftRenderSDoc dflags out\n               (Outp.mkCodeStyle Outp.CStyle) sdoc\n\n    -- Dump, if requested\n    dumpIfSetLlvm Opt_D_dump_llvm \"LLVM Code\" sdoc\n    return ()\n\n-- | Marks a variable as \"used\"\nmarkUsedVar :: LlvmVar -> LlvmM ()\nmarkUsedVar v = modifyEnv $ \\env -> env { envUsedVars = v : envUsedVars env }\n\n-- | Return all variables marked as \"used\" so far\ngetUsedVars :: LlvmM [LlvmVar]\ngetUsedVars = getEnv envUsedVars\n\n-- | Saves that at some point we didn't know the type of the label and\n-- generated a reference to a type variable instead\nsaveAlias :: LMString -> LlvmM ()\nsaveAlias lbl = modifyEnv $ \\env -> env { envAliases = addOneToUniqSet (envAliases env) lbl }\n\n-- | Sets metadata node for a given unique\nsetUniqMeta :: Unique -> MetaId -> LlvmM ()\nsetUniqMeta f m = modifyEnv $ \\env -> env { envUniqMeta = addToUFM (envUniqMeta env) f m }\n\n-- | Gets metadata node for given unique\ngetUniqMeta :: Unique -> LlvmM (Maybe MetaId)\ngetUniqMeta s = getEnv (flip lookupUFM s . envUniqMeta)\n\n-- ----------------------------------------------------------------------------\n-- * Internal functions\n--\n\n-- | Here we pre-initialise some functions that are used internally by GHC\n-- so as to make sure they have the most general type in the case that\n-- user code also uses these functions but with a different type than GHC\n-- internally. (Main offender is treating return type as 'void' instead of\n-- 'void *'). Fixes trac #5486.\nghcInternalFunctions :: LlvmM ()\nghcInternalFunctions = do\n    dflags <- getDynFlags\n    mk \"memcpy\" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags]\n    mk \"memmove\" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags]\n    mk \"memset\" i8Ptr [i8Ptr, llvmWord dflags, llvmWord dflags]\n    mk \"newSpark\" (llvmWord dflags) [i8Ptr, i8Ptr]\n  where\n    mk n ret args = do\n      let n' = fsLit n `appendFS` fsLit \"$def\"\n          decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret\n                                 FixedArgs (tysToParams args) Nothing\n      renderLlvm $ ppLlvmFunctionDecl decl\n      funInsert n' (LMFunction decl)\n\n-- ----------------------------------------------------------------------------\n-- * Label handling\n--\n\n-- | Pretty print a 'CLabel'.\nstrCLabel_llvm :: CLabel -> LlvmM LMString\nstrCLabel_llvm lbl = do\n    platform <- getLlvmPlatform\n    dflags <- getDynFlags\n    let sdoc = pprCLabel platform lbl\n        str = Outp.renderWithStyle dflags sdoc (Outp.mkCodeStyle Outp.CStyle)\n    return (fsLit str)\n\nstrDisplayName_llvm :: CLabel -> LlvmM LMString\nstrDisplayName_llvm lbl = do\n    platform <- getLlvmPlatform\n    dflags <- getDynFlags\n    let sdoc = pprCLabel platform lbl\n        depth = Outp.PartWay 1\n        style = Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth\n        str = Outp.renderWithStyle dflags sdoc style\n    return (fsLit (dropInfoSuffix str))\n\ndropInfoSuffix :: String -> String\ndropInfoSuffix = go\n  where go \"_info\"        = []\n        go \"_static_info\" = []\n        go \"_con_info\"    = []\n        go (x:xs)         = x:go xs\n        go []             = []\n\nstrProcedureName_llvm :: CLabel -> LlvmM LMString\nstrProcedureName_llvm lbl = do\n    platform <- getLlvmPlatform\n    dflags <- getDynFlags\n    let sdoc = pprCLabel platform lbl\n        depth = Outp.PartWay 1\n        style = Outp.mkUserStyle dflags Outp.neverQualify depth\n        str = Outp.renderWithStyle dflags sdoc style\n    return (fsLit str)\n\n-- ----------------------------------------------------------------------------\n-- * Global variables / forward references\n--\n\n-- | Create/get a pointer to a global value. Might return an alias if\n-- the value in question hasn't been defined yet. We especially make\n-- no guarantees on the type of the returned pointer.\ngetGlobalPtr :: LMString -> LlvmM LlvmVar\ngetGlobalPtr llvmLbl = do\n  m_ty <- funLookup llvmLbl\n  let mkGlbVar lbl ty = LMGlobalVar lbl (LMPointer ty) Private Nothing Nothing\n  case m_ty of\n    -- Directly reference if we have seen it already\n    Just ty -> return $ mkGlbVar (llvmLbl `appendFS` fsLit \"$def\") ty Global\n    -- Otherwise use a forward alias of it\n    Nothing -> do\n      saveAlias llvmLbl\n      return $ mkGlbVar llvmLbl i8 Alias\n\n-- | Generate definitions for aliases forward-referenced by @getGlobalPtr@.\n--\n-- Must be called at a point where we are sure that no new global definitions\n-- will be generated anymore!\ngenerateExternDecls :: LlvmM ([LMGlobal], [LlvmType])\ngenerateExternDecls = do\n  delayed <- fmap nonDetEltsUniqSet $ getEnv envAliases\n  -- This is non-deterministic but we do not\n  -- currently support deterministic code-generation.\n  -- See Note [Unique Determinism and code generation]\n  defss <- flip mapM delayed $ \\lbl -> do\n    m_ty <- funLookup lbl\n    case m_ty of\n      -- If we have a definition we've already emitted the proper aliases\n      -- when the symbol itself was emitted by @aliasify@\n      Just _ -> return []\n\n      -- If we don't have a definition this is an external symbol and we\n      -- need to emit a declaration\n      Nothing ->\n        let var = LMGlobalVar lbl i8Ptr External Nothing Nothing Global\n        in return [LMGlobal var Nothing]\n\n  -- Reset forward list\n  modifyEnv $ \\env -> env { envAliases = emptyUniqSet }\n  return (concat defss, [])\n\n-- | Here we take a global variable definition, rename it with a\n-- @$def@ suffix, and generate the appropriate alias.\naliasify :: LMGlobal -> LlvmM [LMGlobal]\naliasify (LMGlobal var val) = do\n    let LMGlobalVar lbl ty link sect align const = var\n\n        defLbl = lbl `appendFS` fsLit \"$def\"\n        defVar = LMGlobalVar defLbl ty Internal sect align const\n\n        defPtrVar = LMGlobalVar defLbl (LMPointer ty) link Nothing Nothing const\n        aliasVar = LMGlobalVar lbl i8Ptr link Nothing Nothing Alias\n        aliasVal = LMBitc (LMStaticPointer defPtrVar) i8Ptr\n\n    -- we need to mark the $def symbols as used so LLVM doesn't forget which\n    -- section they need to go in. This will vanish once we switch away from\n    -- mangling sections for TNTC.\n    markUsedVar defVar\n\n    return [ LMGlobal defVar val\n           , LMGlobal aliasVar (Just aliasVal)\n           ]\n\n-- Note [Llvm Forward References]\n--\n-- The issue here is that LLVM insists on being strongly typed at\n-- every corner, so the first time we mention something, we have to\n-- settle what type we assign to it. That makes things awkward, as Cmm\n-- will often reference things before their definition, and we have no\n-- idea what (LLVM) type it is going to be before that point.\n--\n-- Our work-around is to define \"aliases\" of a standard type (i8 *) in\n-- these kind of situations, which we later tell LLVM to be either\n-- references to their actual local definitions (involving a cast) or\n-- an external reference. This obviously only works for pointers.\n--\n-- In particular when we encounter a reference to a symbol in a chunk of\n-- C-- there are three possible scenarios,\n--\n--   1. We have already seen a definition for the referenced symbol. This\n--      means we already know its type.\n--\n--   2. We have not yet seen a definition but we will find one later in this\n--      compilation unit. Since we want to be a good consumer of the\n--      C-- streamed to us from upstream, we don't know the type of the\n--      symbol at the time when we must emit the reference.\n--\n--   3. We have not yet seen a definition nor will we find one in this\n--      compilation unit. In this case the reference refers to an\n--      external symbol for which we do not know the type.\n--\n-- Let's consider case (2) for a moment: say we see a reference to\n-- the symbol @fooBar@ for which we have not seen a definition. As we\n-- do not know the symbol's type, we assume it is of type @i8*@ and emit\n-- the appropriate casts in @getSymbolPtr@. Later on, when we\n-- encounter the definition of @fooBar@ we emit it but with a modified\n-- name, @fooBar$def@ (which we'll call the definition symbol), to\n-- since we have already had to assume that the symbol @fooBar@\n-- is of type @i8*@. We then emit @fooBar@ itself as an alias\n-- of @fooBar$def@ with appropriate casts. This all happens in\n-- @aliasify@.\n--\n-- Case (3) is quite similar to (2): References are emitted assuming\n-- the referenced symbol is of type @i8*@. When we arrive at the end of\n-- the compilation unit and realize that the symbol is external, we emit\n-- an LLVM @external global@ declaration for the symbol @fooBar@\n-- (handled in @generateExternDecls@). This takes advantage of the\n-- fact that the aliases produced by @aliasify@ for exported symbols\n-- have external linkage and can therefore be used as normal symbols.\n--\n-- Historical note: As of release 3.5 LLVM does not allow aliases to\n-- refer to declarations. This the reason why aliases are produced at the\n-- point of definition instead of the point of usage, as was previously\n-- done. See #9142 for details.\n--\n-- Finally, case (1) is trival. As we already have a definition for\n-- and therefore know the type of the referenced symbol, we can do\n-- away with casting the alias to the desired type in @getSymbolPtr@\n-- and instead just emit a reference to the definition symbol directly.\n-- This is the @Just@ case in @getSymbolPtr@.\n", "num_lines": 552}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GADTs #-}\n{-# OPTIONS_GHC -fno-warn-type-defaults #-}\n-- ----------------------------------------------------------------------------\n-- | Handle conversion of CmmProc to LLVM code.\n--\nmodule LlvmCodeGen.CodeGen ( genLlvmProc ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Llvm\nimport LlvmCodeGen.Base\nimport LlvmCodeGen.Regs\n\nimport BlockId\nimport CodeGen.Platform ( activeStgRegs, callerSaves )\nimport CLabel\nimport Cmm\nimport PprCmm\nimport CmmUtils\nimport CmmSwitch\nimport Hoopl.Block\nimport Hoopl.Graph\nimport Hoopl.Collections\n\nimport DynFlags\nimport FastString\nimport ForeignCall\nimport Outputable hiding (panic, pprPanic)\nimport qualified Outputable\nimport Platform\nimport OrdList\nimport UniqSupply\nimport Unique\nimport Util\n\nimport Control.Monad.Trans.Class\nimport Control.Monad.Trans.Writer\n\nimport qualified Data.Semigroup as Semigroup\nimport Data.List ( nub )\nimport Data.Maybe ( catMaybes )\n\ntype Atomic = Bool\ntype LlvmStatements = OrdList LlvmStatement\n\ndata Signage = Signed | Unsigned deriving (Eq, Show)\n\n-- -----------------------------------------------------------------------------\n-- | Top-level of the LLVM proc Code generator\n--\ngenLlvmProc :: RawCmmDecl -> LlvmM [LlvmCmmDecl]\ngenLlvmProc (CmmProc infos lbl live graph) = do\n    let blocks = toBlockListEntryFirstFalseFallthrough graph\n    (lmblocks, lmdata) <- basicBlocksCodeGen live blocks\n    let info = mapLookup (g_entry graph) infos\n        proc = CmmProc info lbl live (ListGraph lmblocks)\n    return (proc:lmdata)\n\ngenLlvmProc _ = panic \"genLlvmProc: case that shouldn't reach here!\"\n\n-- -----------------------------------------------------------------------------\n-- * Block code generation\n--\n\n-- | Generate code for a list of blocks that make up a complete\n-- procedure. The first block in the list is expected to be the entry\n-- point and will get the prologue.\nbasicBlocksCodeGen :: LiveGlobalRegs -> [CmmBlock]\n                      -> LlvmM ([LlvmBasicBlock], [LlvmCmmDecl])\nbasicBlocksCodeGen _    []                     = panic \"no entry block!\"\nbasicBlocksCodeGen live (entryBlock:cmmBlocks)\n  = do (prologue, prologueTops) <- funPrologue live (entryBlock:cmmBlocks)\n\n       -- Generate code\n       (BasicBlock bid entry, entryTops) <- basicBlockCodeGen entryBlock\n       (blocks, topss) <- fmap unzip $ mapM basicBlockCodeGen cmmBlocks\n\n       -- Compose\n       let entryBlock = BasicBlock bid (fromOL prologue ++ entry)\n       return (entryBlock : blocks, prologueTops ++ entryTops ++ concat topss)\n\n\n-- | Generate code for one block\nbasicBlockCodeGen :: CmmBlock -> LlvmM ( LlvmBasicBlock, [LlvmCmmDecl] )\nbasicBlockCodeGen block\n  = do let (_, nodes, tail)  = blockSplit block\n           id = entryLabel block\n       (mid_instrs, top) <- stmtsToInstrs $ blockToList nodes\n       (tail_instrs, top')  <- stmtToInstrs tail\n       let instrs = fromOL (mid_instrs `appOL` tail_instrs)\n       return (BasicBlock id instrs, top' ++ top)\n\n-- -----------------------------------------------------------------------------\n-- * CmmNode code generation\n--\n\n-- A statement conversion return data.\n--   * LlvmStatements: The compiled LLVM statements.\n--   * LlvmCmmDecl: Any global data needed.\ntype StmtData = (LlvmStatements, [LlvmCmmDecl])\n\n\n-- | Convert a list of CmmNode's to LlvmStatement's\nstmtsToInstrs :: [CmmNode e x] -> LlvmM StmtData\nstmtsToInstrs stmts\n   = do (instrss, topss) <- fmap unzip $ mapM stmtToInstrs stmts\n        return (concatOL instrss, concat topss)\n\n\n-- | Convert a CmmStmt to a list of LlvmStatement's\nstmtToInstrs :: CmmNode e x -> LlvmM StmtData\nstmtToInstrs stmt = case stmt of\n\n    CmmComment _         -> return (nilOL, []) -- nuke comments\n    CmmTick    _         -> return (nilOL, [])\n    CmmUnwind  {}        -> return (nilOL, [])\n\n    CmmAssign reg src    -> genAssign reg src\n    CmmStore addr src    -> genStore addr src\n\n    CmmBranch id         -> genBranch id\n    CmmCondBranch arg true false likely\n                         -> genCondBranch arg true false likely\n    CmmSwitch arg ids    -> genSwitch arg ids\n\n    -- Foreign Call\n    CmmUnsafeForeignCall target res args\n        -> genCall target res args\n\n    -- Tail call\n    CmmCall { cml_target = arg,\n              cml_args_regs = live } -> genJump arg live\n\n    _ -> panic \"Llvm.CodeGen.stmtToInstrs\"\n\n-- | Wrapper function to declare an instrinct function by function type\ngetInstrinct2 :: LMString -> LlvmType -> LlvmM ExprData\ngetInstrinct2 fname fty@(LMFunction funSig) = do\n\n    let fv   = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing Constant\n\n    fn <- funLookup fname\n    tops <- case fn of\n      Just _  ->\n        return []\n      Nothing -> do\n        funInsert fname fty\n        un <- getUniqueM\n        let lbl = mkAsmTempLabel un\n        return [CmmData (Section Data lbl) [([],[fty])]]\n\n    return (fv, nilOL, tops)\n\ngetInstrinct2 _ _ = error \"getInstrinct2: Non-function type!\"\n\n-- | Declares an instrinct function by return and parameter types\ngetInstrinct :: LMString -> LlvmType -> [LlvmType] -> LlvmM ExprData\ngetInstrinct fname retTy parTys =\n    let funSig = LlvmFunctionDecl fname ExternallyVisible CC_Ccc retTy\n                    FixedArgs (tysToParams parTys) Nothing\n        fty = LMFunction funSig\n    in getInstrinct2 fname fty\n\n-- | Memory barrier instruction for LLVM >= 3.0\nbarrier :: LlvmM StmtData\nbarrier = do\n    let s = Fence False SyncSeqCst\n    return (unitOL s, [])\n\n-- | Foreign Calls\ngenCall :: ForeignTarget -> [CmmFormal] -> [CmmActual]\n              -> LlvmM StmtData\n\n-- Write barrier needs to be handled specially as it is implemented as an LLVM\n-- intrinsic function.\ngenCall (PrimTarget MO_WriteBarrier) _ _ = do\n    platform <- getLlvmPlatform\n    if platformArch platform `elem` [ArchX86, ArchX86_64, ArchSPARC]\n       then return (nilOL, [])\n       else barrier\n\ngenCall (PrimTarget MO_Touch) _ _\n = return (nilOL, [])\n\ngenCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do\n    dstV <- getCmmRegW (CmmLocal dst)\n    let ty = cmmToLlvmType $ localRegType dst\n        width = widthToLlvmFloat w\n    castV <- lift $ mkLocalVar ty\n    ve <- exprToVarW e\n    statement $ Assignment castV $ Cast LM_Uitofp ve width\n    statement $ Store castV dstV\n\ngenCall (PrimTarget (MO_UF_Conv _)) [_] args =\n    panic $ \"genCall: Too many arguments to MO_UF_Conv. \" ++\n    \"Can only handle 1, given\" ++ show (length args) ++ \".\"\n\n-- Handle prefetching data\ngenCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args\n  | 0 <= localityInt && localityInt <= 3 = runStmtsDecls $ do\n    let argTy = [i8Ptr, i32, i32, i32]\n        funTy = \\name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible\n                             CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing\n\n    let (_, arg_hints) = foreignTargetHints t\n    let args_hints' = zip args arg_hints\n    argVars <- arg_varsW args_hints' ([], nilOL, [])\n    fptr    <- liftExprData $ getFunPtr funTy t\n    argVars' <- castVarsW Signed $ zip argVars argTy\n\n    doTrashStmts\n    let argSuffix = [mkIntLit i32 0, mkIntLit i32 localityInt, mkIntLit i32 1]\n    statement $ Expr $ Call StdCall fptr (argVars' ++ argSuffix) []\n  | otherwise = panic $ \"prefetch locality level integer must be between 0 and 3, given: \" ++ (show localityInt)\n\n-- Handle PopCnt, Clz, Ctz, and BSwap that need to only convert arg\n-- and return types\ngenCall t@(PrimTarget (MO_PopCnt w)) dsts args =\n    genCallSimpleCast w t dsts args\n\ngenCall t@(PrimTarget (MO_Pdep w)) dsts args =\n    genCallSimpleCast2 w t dsts args\ngenCall t@(PrimTarget (MO_Pext w)) dsts args =\n    genCallSimpleCast2 w t dsts args\ngenCall t@(PrimTarget (MO_Clz w)) dsts args =\n    genCallSimpleCast w t dsts args\ngenCall t@(PrimTarget (MO_Ctz w)) dsts args =\n    genCallSimpleCast w t dsts args\ngenCall t@(PrimTarget (MO_BSwap w)) dsts args =\n    genCallSimpleCast w t dsts args\n\ngenCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do\n    addrVar <- exprToVarW addr\n    nVar <- exprToVarW n\n    let targetTy = widthToLlvmInt width\n        ptrExpr = Cast LM_Inttoptr addrVar (pLift targetTy)\n    ptrVar <- doExprW (pLift targetTy) ptrExpr\n    dstVar <- getCmmRegW (CmmLocal dst)\n    let op = case amop of\n               AMO_Add  -> LAO_Add\n               AMO_Sub  -> LAO_Sub\n               AMO_And  -> LAO_And\n               AMO_Nand -> LAO_Nand\n               AMO_Or   -> LAO_Or\n               AMO_Xor  -> LAO_Xor\n    retVar <- doExprW targetTy $ AtomicRMW op ptrVar nVar SyncSeqCst\n    statement $ Store retVar dstVar\n\ngenCall (PrimTarget (MO_AtomicRead _)) [dst] [addr] = runStmtsDecls $ do\n    dstV <- getCmmRegW (CmmLocal dst)\n    v1 <- genLoadW True addr (localRegType dst)\n    statement $ Store v1 dstV\n\ngenCall (PrimTarget (MO_Cmpxchg _width))\n        [dst] [addr, old, new] = runStmtsDecls $ do\n    addrVar <- exprToVarW addr\n    oldVar <- exprToVarW old\n    newVar <- exprToVarW new\n    let targetTy = getVarType oldVar\n        ptrExpr = Cast LM_Inttoptr addrVar (pLift targetTy)\n    ptrVar <- doExprW (pLift targetTy) ptrExpr\n    dstVar <- getCmmRegW (CmmLocal dst)\n    retVar <- doExprW (LMStructU [targetTy,i1])\n              $ CmpXChg ptrVar oldVar newVar SyncSeqCst SyncSeqCst\n    retVar' <- doExprW targetTy $ ExtractV retVar 0\n    statement $ Store retVar' dstVar\n\ngenCall (PrimTarget (MO_AtomicWrite _width)) [] [addr, val] = runStmtsDecls $ do\n    addrVar <- exprToVarW addr\n    valVar <- exprToVarW val\n    let ptrTy = pLift $ getVarType valVar\n        ptrExpr = Cast LM_Inttoptr addrVar ptrTy\n    ptrVar <- doExprW ptrTy ptrExpr\n    statement $ Expr $ AtomicRMW LAO_Xchg ptrVar valVar SyncSeqCst\n\n-- Handle memcpy function specifically since llvm's intrinsic version takes\n-- some extra parameters.\ngenCall t@(PrimTarget op) [] args\n | Just align <- machOpMemcpyishAlign op = runStmtsDecls $ do\n    dflags <- getDynFlags\n    let isVolTy = [i1]\n        isVolVal = [mkIntLit i1 0]\n        argTy | MO_Memset _ <- op = [i8Ptr, i8,    llvmWord dflags, i32] ++ isVolTy\n              | otherwise         = [i8Ptr, i8Ptr, llvmWord dflags, i32] ++ isVolTy\n        funTy = \\name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible\n                             CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing\n\n    let (_, arg_hints) = foreignTargetHints t\n    let args_hints = zip args arg_hints\n    argVars       <- arg_varsW args_hints ([], nilOL, [])\n    fptr          <- getFunPtrW funTy t\n    argVars' <- castVarsW Signed $ zip argVars argTy\n\n    doTrashStmts\n    let alignVal = mkIntLit i32 align\n        arguments = argVars' ++ (alignVal:isVolVal)\n    statement $ Expr $ Call StdCall fptr arguments []\n\n-- We handle MO_U_Mul2 by simply using a 'mul' instruction, but with operands\n-- twice the width (we first zero-extend them), e.g., on 64-bit arch we will\n-- generate 'mul' on 128-bit operands. Then we only need some plumbing to\n-- extract the two 64-bit values out of 128-bit result.\ngenCall (PrimTarget (MO_U_Mul2 w)) [dstH, dstL] [lhs, rhs] = runStmtsDecls $ do\n    let width = widthToLlvmInt w\n        bitWidth = widthInBits w\n        width2x = LMInt (bitWidth * 2)\n    -- First zero-extend the operands ('mul' instruction requires the operands\n    -- and the result to be of the same type). Note that we don't use 'castVars'\n    -- because it tries to do LM_Sext.\n    lhsVar <- exprToVarW lhs\n    rhsVar <- exprToVarW rhs\n    lhsExt <- doExprW width2x $ Cast LM_Zext lhsVar width2x\n    rhsExt <- doExprW width2x $ Cast LM_Zext rhsVar width2x\n    -- Do the actual multiplication (note that the result is also 2x width).\n    retV <- doExprW width2x $ LlvmOp LM_MO_Mul lhsExt rhsExt\n    -- Extract the lower bits of the result into retL.\n    retL <- doExprW width $ Cast LM_Trunc retV width\n    -- Now we right-shift the higher bits by width.\n    let widthLlvmLit = LMLitVar $ LMIntLit (fromIntegral bitWidth) width\n    retShifted <- doExprW width2x $ LlvmOp LM_MO_LShr retV widthLlvmLit\n    -- And extract them into retH.\n    retH <- doExprW width $ Cast LM_Trunc retShifted width\n    dstRegL <- getCmmRegW (CmmLocal dstL)\n    dstRegH <- getCmmRegW (CmmLocal dstH)\n    statement $ Store retL dstRegL\n    statement $ Store retH dstRegH\n\n-- MO_U_QuotRem2 is another case we handle by widening the registers to double\n-- the width and use normal LLVM instructions (similarly to the MO_U_Mul2). The\n-- main difference here is that we need to combine two words into one register\n-- and then use both 'udiv' and 'urem' instructions to compute the result.\ngenCall (PrimTarget (MO_U_QuotRem2 w))\n        [dstQ, dstR] [lhsH, lhsL, rhs] = runStmtsDecls $ do\n    let width = widthToLlvmInt w\n        bitWidth = widthInBits w\n        width2x = LMInt (bitWidth * 2)\n    -- First zero-extend all parameters to double width.\n    let zeroExtend expr = do\n            var <- exprToVarW expr\n            doExprW width2x $ Cast LM_Zext var width2x\n    lhsExtH <- zeroExtend lhsH\n    lhsExtL <- zeroExtend lhsL\n    rhsExt <- zeroExtend rhs\n    -- Now we combine the first two parameters (that represent the high and low\n    -- bits of the value). So first left-shift the high bits to their position\n    -- and then bit-or them with the low bits.\n    let widthLlvmLit = LMLitVar $ LMIntLit (fromIntegral bitWidth) width\n    lhsExtHShifted <- doExprW width2x $ LlvmOp LM_MO_Shl lhsExtH widthLlvmLit\n    lhsExt <- doExprW width2x $ LlvmOp LM_MO_Or lhsExtHShifted lhsExtL\n    -- Finally, we can call 'udiv' and 'urem' to compute the results.\n    retExtDiv <- doExprW width2x $ LlvmOp LM_MO_UDiv lhsExt rhsExt\n    retExtRem <- doExprW width2x $ LlvmOp LM_MO_URem lhsExt rhsExt\n    -- And since everything is in 2x width, we need to truncate the results and\n    -- then return them.\n    let narrow var = doExprW width $ Cast LM_Trunc var width\n    retDiv <- narrow retExtDiv\n    retRem <- narrow retExtRem\n    dstRegQ <- lift $ getCmmReg (CmmLocal dstQ)\n    dstRegR <- lift $ getCmmReg (CmmLocal dstR)\n    statement $ Store retDiv dstRegQ\n    statement $ Store retRem dstRegR\n\n-- Handle the MO_{Add,Sub}IntC separately. LLVM versions return a record from\n-- which we need to extract the actual values.\ngenCall t@(PrimTarget (MO_AddIntC w)) [dstV, dstO] [lhs, rhs] =\n    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]\ngenCall t@(PrimTarget (MO_SubIntC w)) [dstV, dstO] [lhs, rhs] =\n    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]\n\n-- Similar to MO_{Add,Sub}IntC, but MO_Add2 expects the first element of the\n-- return tuple to be the overflow bit and the second element to contain the\n-- actual result of the addition. So we still use genCallWithOverflow but swap\n-- the return registers.\ngenCall t@(PrimTarget (MO_Add2 w)) [dstO, dstV] [lhs, rhs] =\n    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]\n\ngenCall t@(PrimTarget (MO_AddWordC w)) [dstV, dstO] [lhs, rhs] =\n    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]\n\ngenCall t@(PrimTarget (MO_SubWordC w)) [dstV, dstO] [lhs, rhs] =\n    genCallWithOverflow t w [dstV, dstO] [lhs, rhs]\n\n-- Handle all other foreign calls and prim ops.\ngenCall target res args = runStmtsDecls $ do\n    dflags <- getDynFlags\n\n    -- parameter types\n    let arg_type (_, AddrHint) = i8Ptr\n        -- cast pointers to i8*. Llvm equivalent of void*\n        arg_type (expr, _) = cmmToLlvmType $ cmmExprType dflags expr\n\n    -- ret type\n    let ret_type [] = LMVoid\n        ret_type [(_, AddrHint)] = i8Ptr\n        ret_type [(reg, _)]      = cmmToLlvmType $ localRegType reg\n        ret_type t = panic $ \"genCall: Too many return values! Can only handle\"\n                        ++ \" 0 or 1, given \" ++ show (length t) ++ \".\"\n\n    -- extract Cmm call convention, and translate to LLVM call convention\n    platform <- lift $ getLlvmPlatform\n    let lmconv = case target of\n            ForeignTarget _ (ForeignConvention conv _ _ _) ->\n              case conv of\n                 StdCallConv  -> case platformArch platform of\n                                 ArchX86    -> CC_X86_Stdcc\n                                 ArchX86_64 -> CC_X86_Stdcc\n                                 _          -> CC_Ccc\n                 CCallConv    -> CC_Ccc\n                 CApiConv     -> CC_Ccc\n                 PrimCallConv -> panic \"LlvmCodeGen.CodeGen.genCall: PrimCallConv\"\n                 JavaScriptCallConv -> panic \"LlvmCodeGen.CodeGen.genCall: JavaScriptCallConv\"\n\n            PrimTarget   _ -> CC_Ccc\n\n    {-\n        CC_Ccc of the possibilities here are a worry with the use of a custom\n        calling convention for passing STG args. In practice the more\n        dangerous combinations (e.g StdCall + llvmGhcCC) don't occur.\n\n        The native code generator only handles StdCall and CCallConv.\n    -}\n\n    -- call attributes\n    let fnAttrs | never_returns = NoReturn : llvmStdFunAttrs\n                | otherwise     = llvmStdFunAttrs\n\n        never_returns = case target of\n             ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns) -> True\n             _ -> False\n\n    -- fun type\n    let (res_hints, arg_hints) = foreignTargetHints target\n    let args_hints = zip args arg_hints\n    let ress_hints = zip res  res_hints\n    let ccTy  = StdCall -- tail calls should be done through CmmJump\n    let retTy = ret_type ress_hints\n    let argTy = tysToParams $ map arg_type args_hints\n    let funTy = \\name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible\n                             lmconv retTy FixedArgs argTy (llvmFunAlign dflags)\n\n\n    argVars <- arg_varsW args_hints ([], nilOL, [])\n    fptr    <- getFunPtrW funTy target\n\n    let doReturn | ccTy == TailCall  = statement $ Return Nothing\n                 | never_returns     = statement $ Unreachable\n                 | otherwise         = return ()\n\n    doTrashStmts\n\n    -- make the actual call\n    case retTy of\n        LMVoid -> do\n            statement $ Expr $ Call ccTy fptr argVars fnAttrs\n\n        _ -> do\n            v1 <- doExprW retTy $ Call ccTy fptr argVars fnAttrs\n            -- get the return register\n            let ret_reg [reg] = reg\n                ret_reg t = panic $ \"genCall: Bad number of registers! Can only handle\"\n                                ++ \" 1, given \" ++ show (length t) ++ \".\"\n            let creg = ret_reg res\n            vreg <- getCmmRegW (CmmLocal creg)\n            if retTy == pLower (getVarType vreg)\n                then do\n                    statement $ Store v1 vreg\n                    doReturn\n                else do\n                    let ty = pLower $ getVarType vreg\n                    let op = case ty of\n                            vt | isPointer vt -> LM_Bitcast\n                               | isInt     vt -> LM_Ptrtoint\n                               | otherwise    ->\n                                   panic $ \"genCall: CmmReg bad match for\"\n                                        ++ \" returned type!\"\n\n                    v2 <- doExprW ty $ Cast op v1 ty\n                    statement $ Store v2 vreg\n                    doReturn\n\n-- | Generate a call to an LLVM intrinsic that performs arithmetic operation\n-- with overflow bit (i.e., returns a struct containing the actual result of the\n-- operation and an overflow bit). This function will also extract the overflow\n-- bit and zero-extend it (all the corresponding Cmm PrimOps represent the\n-- overflow \"bit\" as a usual Int# or Word#).\ngenCallWithOverflow\n  :: ForeignTarget -> Width -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData\ngenCallWithOverflow t@(PrimTarget op) w [dstV, dstO] [lhs, rhs] = do\n    -- So far this was only tested for the following four CallishMachOps.\n    let valid = op `elem`   [ MO_Add2 w\n                            , MO_AddIntC w\n                            , MO_SubIntC w\n                            , MO_AddWordC w\n                            , MO_SubWordC w\n                            ]\n    MASSERT(valid)\n    let width = widthToLlvmInt w\n    -- This will do most of the work of generating the call to the intrinsic and\n    -- extracting the values from the struct.\n    (value, overflowBit, (stmts, top)) <-\n      genCallExtract t w (lhs, rhs) (width, i1)\n    -- value is i<width>, but overflowBit is i1, so we need to cast (Cmm expects\n    -- both to be i<width>)\n    (overflow, zext) <- doExpr width $ Cast LM_Zext overflowBit width\n    dstRegV <- getCmmReg (CmmLocal dstV)\n    dstRegO <- getCmmReg (CmmLocal dstO)\n    let storeV = Store value dstRegV\n        storeO = Store overflow dstRegO\n    return (stmts `snocOL` zext `snocOL` storeV `snocOL` storeO, top)\ngenCallWithOverflow _ _ _ _ =\n    panic \"genCallExtract: wrong ForeignTarget or number of arguments\"\n\n-- | A helper function for genCallWithOverflow that handles generating the call\n-- to the LLVM intrinsic and extracting the result from the struct to LlvmVars.\ngenCallExtract\n    :: ForeignTarget           -- ^ PrimOp\n    -> Width                   -- ^ Width of the operands.\n    -> (CmmActual, CmmActual)  -- ^ Actual arguments.\n    -> (LlvmType, LlvmType)    -- ^ LLVM types of the returned struct.\n    -> LlvmM (LlvmVar, LlvmVar, StmtData)\ngenCallExtract target@(PrimTarget op) w (argA, argB) (llvmTypeA, llvmTypeB) = do\n    let width = widthToLlvmInt w\n        argTy = [width, width]\n        retTy = LMStructU [llvmTypeA, llvmTypeB]\n\n    -- Process the arguments.\n    let args_hints = zip [argA, argB] (snd $ foreignTargetHints target)\n    (argsV1, args1, top1) <- arg_vars args_hints ([], nilOL, [])\n    (argsV2, args2) <- castVars Signed $ zip argsV1 argTy\n\n    -- Get the function and make the call.\n    fname <- cmmPrimOpFunctions op\n    (fptr, _, top2) <- getInstrinct fname retTy argTy\n    -- We use StdCall for primops. See also the last case of genCall.\n    (retV, call) <- doExpr retTy $ Call StdCall fptr argsV2 []\n\n    -- This will result in a two element struct, we need to use \"extractvalue\"\n    -- to get them out of it.\n    (res1, ext1) <- doExpr llvmTypeA (ExtractV retV 0)\n    (res2, ext2) <- doExpr llvmTypeB (ExtractV retV 1)\n\n    let stmts = args1 `appOL` args2 `snocOL` call `snocOL` ext1 `snocOL` ext2\n        tops = top1 ++ top2\n    return (res1, res2, (stmts, tops))\n\ngenCallExtract _ _ _ _ =\n    panic \"genCallExtract: unsupported ForeignTarget\"\n\n-- Handle simple function call that only need simple type casting, of the form:\n--   truncate arg >>= \\a -> call(a) >>= zext\n--\n-- since GHC only really has i32 and i64 types and things like Word8 are backed\n-- by an i32 and just present a logical i8 range. So we must handle conversions\n-- from i32 to i8 explicitly as LLVM is strict about types.\ngenCallSimpleCast :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]\n              -> LlvmM StmtData\ngenCallSimpleCast w t@(PrimTarget op) [dst] args = do\n    let width = widthToLlvmInt w\n        dstTy = cmmToLlvmType $ localRegType dst\n\n    fname                       <- cmmPrimOpFunctions op\n    (fptr, _, top3)             <- getInstrinct fname width [width]\n\n    dstV                        <- getCmmReg (CmmLocal dst)\n\n    let (_, arg_hints) = foreignTargetHints t\n    let args_hints = zip args arg_hints\n    (argsV, stmts2, top2)       <- arg_vars args_hints ([], nilOL, [])\n    (argsV', stmts4)            <- castVars Signed $ zip argsV [width]\n    (retV, s1)                  <- doExpr width $ Call StdCall fptr argsV' []\n    (retVs', stmts5)            <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]\n    let retV'                    = singletonPanic \"genCallSimpleCast\" retVs'\n    let s2                       = Store retV' dstV\n\n    let stmts = stmts2 `appOL` stmts4 `snocOL`\n                s1 `appOL` stmts5 `snocOL` s2\n    return (stmts, top2 ++ top3)\ngenCallSimpleCast _ _ dsts _ =\n    panic (\"genCallSimpleCast: \" ++ show (length dsts) ++ \" dsts\")\n\n-- Handle simple function call that only need simple type casting, of the form:\n--   truncate arg >>= \\a -> call(a) >>= zext\n--\n-- since GHC only really has i32 and i64 types and things like Word8 are backed\n-- by an i32 and just present a logical i8 range. So we must handle conversions\n-- from i32 to i8 explicitly as LLVM is strict about types.\ngenCallSimpleCast2 :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]\n              -> LlvmM StmtData\ngenCallSimpleCast2 w t@(PrimTarget op) [dst] args = do\n    let width = widthToLlvmInt w\n        dstTy = cmmToLlvmType $ localRegType dst\n\n    fname                       <- cmmPrimOpFunctions op\n    (fptr, _, top3)             <- getInstrinct fname width (const width <$> args)\n\n    dstV                        <- getCmmReg (CmmLocal dst)\n\n    let (_, arg_hints) = foreignTargetHints t\n    let args_hints = zip args arg_hints\n    (argsV, stmts2, top2)       <- arg_vars args_hints ([], nilOL, [])\n    (argsV', stmts4)            <- castVars Signed $ zip argsV (const width <$> argsV)\n    (retV, s1)                  <- doExpr width $ Call StdCall fptr argsV' []\n    (retVs', stmts5)             <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]\n    let retV'                    = singletonPanic \"genCallSimpleCast2\" retVs'\n    let s2                       = Store retV' dstV\n\n    let stmts = stmts2 `appOL` stmts4 `snocOL`\n                s1 `appOL` stmts5 `snocOL` s2\n    return (stmts, top2 ++ top3)\ngenCallSimpleCast2 _ _ dsts _ =\n    panic (\"genCallSimpleCast2: \" ++ show (length dsts) ++ \" dsts\")\n\n-- | Create a function pointer from a target.\ngetFunPtrW :: (LMString -> LlvmType) -> ForeignTarget\n           -> WriterT LlvmAccum LlvmM LlvmVar\ngetFunPtrW funTy targ = liftExprData $ getFunPtr funTy targ\n\n-- | Create a function pointer from a target.\ngetFunPtr :: (LMString -> LlvmType) -> ForeignTarget\n          -> LlvmM ExprData\ngetFunPtr funTy targ = case targ of\n    ForeignTarget (CmmLit (CmmLabel lbl)) _ -> do\n        name <- strCLabel_llvm lbl\n        getHsFunc' name (funTy name)\n\n    ForeignTarget expr _ -> do\n        (v1, stmts, top) <- exprToVar expr\n        dflags <- getDynFlags\n        let fty = funTy $ fsLit \"dynamic\"\n            cast = case getVarType v1 of\n                ty | isPointer ty -> LM_Bitcast\n                ty | isInt ty     -> LM_Inttoptr\n\n                ty -> panic $ \"genCall: Expr is of bad type for function\"\n                              ++ \" call! (\" ++ showSDoc dflags (ppr ty) ++ \")\"\n\n        (v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)\n        return (v2, stmts `snocOL` s1, top)\n\n    PrimTarget mop -> do\n        name <- cmmPrimOpFunctions mop\n        let fty = funTy name\n        getInstrinct2 name fty\n\n-- | Conversion of call arguments.\narg_varsW :: [(CmmActual, ForeignHint)]\n          -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])\n          -> WriterT LlvmAccum LlvmM [LlvmVar]\narg_varsW xs ys = do\n    (vars, stmts, decls) <- lift $ arg_vars xs ys\n    tell $ LlvmAccum stmts decls\n    return vars\n\n-- | Conversion of call arguments.\narg_vars :: [(CmmActual, ForeignHint)]\n         -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl])\n         -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl])\n\narg_vars [] (vars, stmts, tops)\n  = return (vars, stmts, tops)\n\narg_vars ((e, AddrHint):rest) (vars, stmts, tops)\n  = do (v1, stmts', top') <- exprToVar e\n       dflags <- getDynFlags\n       let op = case getVarType v1 of\n               ty | isPointer ty -> LM_Bitcast\n               ty | isInt ty     -> LM_Inttoptr\n\n               a  -> panic $ \"genCall: Can't cast llvmType to i8*! (\"\n                           ++ showSDoc dflags (ppr a) ++ \")\"\n\n       (v2, s1) <- doExpr i8Ptr $ Cast op v1 i8Ptr\n       arg_vars rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1,\n                               tops ++ top')\n\narg_vars ((e, _):rest) (vars, stmts, tops)\n  = do (v1, stmts', top') <- exprToVar e\n       arg_vars rest (vars ++ [v1], stmts `appOL` stmts', tops ++ top')\n\n\n-- | Cast a collection of LLVM variables to specific types.\ncastVarsW :: Signage\n          -> [(LlvmVar, LlvmType)]\n          -> WriterT LlvmAccum LlvmM [LlvmVar]\ncastVarsW signage vars = do\n    (vars, stmts) <- lift $ castVars signage vars\n    tell $ LlvmAccum stmts mempty\n    return vars\n\n-- | Cast a collection of LLVM variables to specific types.\ncastVars :: Signage -> [(LlvmVar, LlvmType)]\n         -> LlvmM ([LlvmVar], LlvmStatements)\ncastVars signage vars = do\n                done <- mapM (uncurry (castVar signage)) vars\n                let (vars', stmts) = unzip done\n                return (vars', toOL stmts)\n\n-- | Cast an LLVM variable to a specific type, panicing if it can't be done.\ncastVar :: Signage -> LlvmVar -> LlvmType -> LlvmM (LlvmVar, LlvmStatement)\ncastVar signage v t | getVarType v == t\n            = return (v, Nop)\n\n            | otherwise\n            = do dflags <- getDynFlags\n                 let op = case (getVarType v, t) of\n                      (LMInt n, LMInt m)\n                          -> if n < m then extend else LM_Trunc\n                      (vt, _) | isFloat vt && isFloat t\n                          -> if llvmWidthInBits dflags vt < llvmWidthInBits dflags t\n                                then LM_Fpext else LM_Fptrunc\n                      (vt, _) | isInt vt && isFloat t       -> LM_Sitofp\n                      (vt, _) | isFloat vt && isInt t       -> LM_Fptosi\n                      (vt, _) | isInt vt && isPointer t     -> LM_Inttoptr\n                      (vt, _) | isPointer vt && isInt t     -> LM_Ptrtoint\n                      (vt, _) | isPointer vt && isPointer t -> LM_Bitcast\n                      (vt, _) | isVector vt && isVector t   -> LM_Bitcast\n\n                      (vt, _) -> panic $ \"castVars: Can't cast this type (\"\n                                  ++ showSDoc dflags (ppr vt) ++ \") to (\" ++ showSDoc dflags (ppr t) ++ \")\"\n                 doExpr t $ Cast op v t\n    where extend = case signage of\n            Signed      -> LM_Sext\n            Unsigned    -> LM_Zext\n\n\ncmmPrimOpRetValSignage :: CallishMachOp -> Signage\ncmmPrimOpRetValSignage mop = case mop of\n    MO_Pdep _   -> Unsigned\n    MO_Pext _   -> Unsigned\n    _           -> Signed\n\n-- | Decide what C function to use to implement a CallishMachOp\ncmmPrimOpFunctions :: CallishMachOp -> LlvmM LMString\ncmmPrimOpFunctions mop = do\n\n  dflags <- getDynFlags\n  let intrinTy1 = \"p0i8.p0i8.\" ++ showSDoc dflags (ppr $ llvmWord dflags)\n      intrinTy2 = \"p0i8.\" ++ showSDoc dflags (ppr $ llvmWord dflags)\n      unsupported = panic (\"cmmPrimOpFunctions: \" ++ show mop\n                        ++ \" not supported here\")\n\n  return $ case mop of\n    MO_F32_Exp    -> fsLit \"expf\"\n    MO_F32_Log    -> fsLit \"logf\"\n    MO_F32_Sqrt   -> fsLit \"llvm.sqrt.f32\"\n    MO_F32_Fabs   -> fsLit \"llvm.fabs.f32\"\n    MO_F32_Pwr    -> fsLit \"llvm.pow.f32\"\n\n    MO_F32_Sin    -> fsLit \"llvm.sin.f32\"\n    MO_F32_Cos    -> fsLit \"llvm.cos.f32\"\n    MO_F32_Tan    -> fsLit \"tanf\"\n\n    MO_F32_Asin   -> fsLit \"asinf\"\n    MO_F32_Acos   -> fsLit \"acosf\"\n    MO_F32_Atan   -> fsLit \"atanf\"\n\n    MO_F32_Sinh   -> fsLit \"sinhf\"\n    MO_F32_Cosh   -> fsLit \"coshf\"\n    MO_F32_Tanh   -> fsLit \"tanhf\"\n\n    MO_F32_Asinh  -> fsLit \"asinhf\"\n    MO_F32_Acosh  -> fsLit \"acoshf\"\n    MO_F32_Atanh  -> fsLit \"atanhf\"\n\n    MO_F64_Exp    -> fsLit \"exp\"\n    MO_F64_Log    -> fsLit \"log\"\n    MO_F64_Sqrt   -> fsLit \"llvm.sqrt.f64\"\n    MO_F64_Fabs   -> fsLit \"llvm.fabs.f64\"\n    MO_F64_Pwr    -> fsLit \"llvm.pow.f64\"\n\n    MO_F64_Sin    -> fsLit \"llvm.sin.f64\"\n    MO_F64_Cos    -> fsLit \"llvm.cos.f64\"\n    MO_F64_Tan    -> fsLit \"tan\"\n\n    MO_F64_Asin   -> fsLit \"asin\"\n    MO_F64_Acos   -> fsLit \"acos\"\n    MO_F64_Atan   -> fsLit \"atan\"\n\n    MO_F64_Sinh   -> fsLit \"sinh\"\n    MO_F64_Cosh   -> fsLit \"cosh\"\n    MO_F64_Tanh   -> fsLit \"tanh\"\n\n    MO_F64_Asinh  -> fsLit \"asinh\"\n    MO_F64_Acosh  -> fsLit \"acosh\"\n    MO_F64_Atanh  -> fsLit \"atanh\"\n\n    MO_Memcpy _   -> fsLit $ \"llvm.memcpy.\"  ++ intrinTy1\n    MO_Memmove _  -> fsLit $ \"llvm.memmove.\" ++ intrinTy1\n    MO_Memset _   -> fsLit $ \"llvm.memset.\"  ++ intrinTy2\n    MO_Memcmp _   -> fsLit $ \"memcmp\"\n\n    (MO_PopCnt w) -> fsLit $ \"llvm.ctpop.\"  ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n    (MO_BSwap w)  -> fsLit $ \"llvm.bswap.\"  ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n    (MO_Clz w)    -> fsLit $ \"llvm.ctlz.\"   ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n    (MO_Ctz w)    -> fsLit $ \"llvm.cttz.\"   ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n\n    (MO_Pdep w)   ->  let w' = showSDoc dflags (ppr $ widthInBits w)\n                      in  if isBmi2Enabled dflags\n                            then fsLit $ \"llvm.x86.bmi.pdep.\"   ++ w'\n                            else fsLit $ \"hs_pdep\"              ++ w'\n    (MO_Pext w)   ->  let w' = showSDoc dflags (ppr $ widthInBits w)\n                      in  if isBmi2Enabled dflags\n                            then fsLit $ \"llvm.x86.bmi.pext.\"   ++ w'\n                            else fsLit $ \"hs_pext\"              ++ w'\n\n    (MO_Prefetch_Data _ )-> fsLit \"llvm.prefetch\"\n\n    MO_AddIntC w    -> fsLit $ \"llvm.sadd.with.overflow.\"\n                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n    MO_SubIntC w    -> fsLit $ \"llvm.ssub.with.overflow.\"\n                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n    MO_Add2 w       -> fsLit $ \"llvm.uadd.with.overflow.\"\n                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n    MO_AddWordC w   -> fsLit $ \"llvm.uadd.with.overflow.\"\n                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n    MO_SubWordC w   -> fsLit $ \"llvm.usub.with.overflow.\"\n                             ++ showSDoc dflags (ppr $ widthToLlvmInt w)\n\n    MO_S_QuotRem {}  -> unsupported\n    MO_U_QuotRem {}  -> unsupported\n    MO_U_QuotRem2 {} -> unsupported\n    -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the\n    -- appropriate case of genCall.\n    MO_U_Mul2 {}     -> unsupported\n    MO_WriteBarrier  -> unsupported\n    MO_Touch         -> unsupported\n    MO_UF_Conv _     -> unsupported\n\n    MO_AtomicRead _  -> unsupported\n    MO_AtomicRMW _ _ -> unsupported\n    MO_AtomicWrite _ -> unsupported\n    MO_Cmpxchg _     -> unsupported\n\n-- | Tail function calls\ngenJump :: CmmExpr -> [GlobalReg] -> LlvmM StmtData\n\n-- Call to known function\ngenJump (CmmLit (CmmLabel lbl)) live = do\n    (vf, stmts, top) <- getHsFunc live lbl\n    (stgRegs, stgStmts) <- funEpilogue live\n    let s1  = Expr $ Call TailCall vf stgRegs llvmStdFunAttrs\n    let s2  = Return Nothing\n    return (stmts `appOL` stgStmts `snocOL` s1 `snocOL` s2, top)\n\n\n-- Call to unknown function / address\ngenJump expr live = do\n    fty <- llvmFunTy live\n    (vf, stmts, top) <- exprToVar expr\n    dflags <- getDynFlags\n\n    let cast = case getVarType vf of\n         ty | isPointer ty -> LM_Bitcast\n         ty | isInt ty     -> LM_Inttoptr\n\n         ty -> panic $ \"genJump: Expr is of bad type for function call! (\"\n                     ++ showSDoc dflags (ppr ty) ++ \")\"\n\n    (v1, s1) <- doExpr (pLift fty) $ Cast cast vf (pLift fty)\n    (stgRegs, stgStmts) <- funEpilogue live\n    let s2 = Expr $ Call TailCall v1 stgRegs llvmStdFunAttrs\n    let s3 = Return Nothing\n    return (stmts `snocOL` s1 `appOL` stgStmts `snocOL` s2 `snocOL` s3,\n            top)\n\n\n-- | CmmAssign operation\n--\n-- We use stack allocated variables for CmmReg. The optimiser will replace\n-- these with registers when possible.\ngenAssign :: CmmReg -> CmmExpr -> LlvmM StmtData\ngenAssign reg val = do\n    vreg <- getCmmReg reg\n    (vval, stmts2, top2) <- exprToVar val\n    let stmts = stmts2\n\n    let ty = (pLower . getVarType) vreg\n    dflags <- getDynFlags\n    case ty of\n      -- Some registers are pointer types, so need to cast value to pointer\n      LMPointer _ | getVarType vval == llvmWord dflags -> do\n          (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty\n          let s2 = Store v vreg\n          return (stmts `snocOL` s1 `snocOL` s2, top2)\n\n      LMVector _ _ -> do\n          (v, s1) <- doExpr ty $ Cast LM_Bitcast vval ty\n          let s2 = Store v vreg\n          return (stmts `snocOL` s1 `snocOL` s2, top2)\n\n      _ -> do\n          let s1 = Store vval vreg\n          return (stmts `snocOL` s1, top2)\n\n\n-- | CmmStore operation\ngenStore :: CmmExpr -> CmmExpr -> LlvmM StmtData\n\n-- First we try to detect a few common cases and produce better code for\n-- these then the default case. We are mostly trying to detect Cmm code\n-- like I32[Sp + n] and use 'getelementptr' operations instead of the\n-- generic case that uses casts and pointer arithmetic\ngenStore addr@(CmmReg (CmmGlobal r)) val\n    = genStore_fast addr r 0 val\n\ngenStore addr@(CmmRegOff (CmmGlobal r) n) val\n    = genStore_fast addr r n val\n\ngenStore addr@(CmmMachOp (MO_Add _) [\n                            (CmmReg (CmmGlobal r)),\n                            (CmmLit (CmmInt n _))])\n                val\n    = genStore_fast addr r (fromInteger n) val\n\ngenStore addr@(CmmMachOp (MO_Sub _) [\n                            (CmmReg (CmmGlobal r)),\n                            (CmmLit (CmmInt n _))])\n                val\n    = genStore_fast addr r (negate $ fromInteger n) val\n\n-- generic case\ngenStore addr val\n    = getTBAAMeta topN >>= genStore_slow addr val\n\n-- | CmmStore operation\n-- This is a special case for storing to a global register pointer\n-- offset such as I32[Sp+8].\ngenStore_fast :: CmmExpr -> GlobalReg -> Int -> CmmExpr\n              -> LlvmM StmtData\ngenStore_fast addr r n val\n  = do dflags <- getDynFlags\n       (gv, grt, s1) <- getCmmRegVal (CmmGlobal r)\n       meta          <- getTBAARegMeta r\n       let (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)\n       case isPointer grt && rem == 0 of\n            True -> do\n                (vval,  stmts, top) <- exprToVar val\n                (ptr, s2) <- doExpr grt $ GetElemPtr True gv [toI32 ix]\n                -- We might need a different pointer type, so check\n                case pLower grt == getVarType vval of\n                     -- were fine\n                     True  -> do\n                         let s3 = MetaStmt meta $ Store vval ptr\n                         return (stmts `appOL` s1 `snocOL` s2\n                                 `snocOL` s3, top)\n\n                     -- cast to pointer type needed\n                     False -> do\n                         let ty = (pLift . getVarType) vval\n                         (ptr', s3) <- doExpr ty $ Cast LM_Bitcast ptr ty\n                         let s4 = MetaStmt meta $ Store vval ptr'\n                         return (stmts `appOL` s1 `snocOL` s2\n                                 `snocOL` s3 `snocOL` s4, top)\n\n            -- If its a bit type then we use the slow method since\n            -- we can't avoid casting anyway.\n            False -> genStore_slow addr val meta\n\n\n-- | CmmStore operation\n-- Generic case. Uses casts and pointer arithmetic if needed.\ngenStore_slow :: CmmExpr -> CmmExpr -> [MetaAnnot] -> LlvmM StmtData\ngenStore_slow addr val meta = do\n    (vaddr, stmts1, top1) <- exprToVar addr\n    (vval,  stmts2, top2) <- exprToVar val\n\n    let stmts = stmts1 `appOL` stmts2\n    dflags <- getDynFlags\n    case getVarType vaddr of\n        -- sometimes we need to cast an int to a pointer before storing\n        LMPointer ty@(LMPointer _) | getVarType vval == llvmWord dflags -> do\n            (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty\n            let s2 = MetaStmt meta $ Store v vaddr\n            return (stmts `snocOL` s1 `snocOL` s2, top1 ++ top2)\n\n        LMPointer _ -> do\n            let s1 = MetaStmt meta $ Store vval vaddr\n            return (stmts `snocOL` s1, top1 ++ top2)\n\n        i@(LMInt _) | i == llvmWord dflags -> do\n            let vty = pLift $ getVarType vval\n            (vptr, s1) <- doExpr vty $ Cast LM_Inttoptr vaddr vty\n            let s2 = MetaStmt meta $ Store vval vptr\n            return (stmts `snocOL` s1 `snocOL` s2, top1 ++ top2)\n\n        other ->\n            pprPanic \"genStore: ptr not right type!\"\n                    (PprCmm.pprExpr addr <+> text (\n                        \"Size of Ptr: \" ++ show (llvmPtrBits dflags) ++\n                        \", Size of var: \" ++ show (llvmWidthInBits dflags other) ++\n                        \", Var: \" ++ showSDoc dflags (ppr vaddr)))\n\n\n-- | Unconditional branch\ngenBranch :: BlockId -> LlvmM StmtData\ngenBranch id =\n    let label = blockIdToLlvm id\n    in return (unitOL $ Branch label, [])\n\n\n-- | Conditional branch\ngenCondBranch :: CmmExpr -> BlockId -> BlockId -> Maybe Bool -> LlvmM StmtData\ngenCondBranch cond idT idF likely = do\n    let labelT = blockIdToLlvm idT\n    let labelF = blockIdToLlvm idF\n    -- See Note [Literals and branch conditions].\n    (vc, stmts1, top1) <- exprToVarOpt i1Option cond\n    if getVarType vc == i1\n        then do\n            (vc', (stmts2, top2)) <- case likely of\n              Just b -> genExpectLit (if b then 1 else 0) i1  vc\n              _      -> pure (vc, (nilOL, []))\n            let s1 = BranchIf vc' labelT labelF\n            return (stmts1 `appOL` stmts2 `snocOL` s1, top1 ++ top2)\n        else do\n            dflags <- getDynFlags\n            panic $ \"genCondBranch: Cond expr not bool! (\" ++ showSDoc dflags (ppr vc) ++ \")\"\n\n\n-- | Generate call to llvm.expect.x intrinsic. Assigning result to a new var.\ngenExpectLit :: Integer -> LlvmType -> LlvmVar -> LlvmM (LlvmVar, StmtData)\ngenExpectLit expLit expTy var = do\n  dflags <- getDynFlags\n\n  let\n    lit = LMLitVar $ LMIntLit expLit expTy\n\n    llvmExpectName\n      | isInt expTy = fsLit $ \"llvm.expect.\" ++ showSDoc dflags (ppr expTy)\n      | otherwise   = panic $ \"genExpectedLit: Type not an int!\"\n\n  (llvmExpect, stmts, top) <-\n    getInstrinct llvmExpectName expTy [expTy, expTy]\n  (var', call) <- doExpr expTy $ Call StdCall llvmExpect [var, lit] []\n  return (var', (stmts `snocOL` call, top))\n\n{- Note [Literals and branch conditions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIt is important that whenever we generate branch conditions for\nliterals like '1', they are properly narrowed to an LLVM expression of\ntype 'i1' (for bools.) Otherwise, nobody is happy. So when we convert\na CmmExpr to an LLVM expression for a branch conditional, exprToVarOpt\nmust be certain to return a properly narrowed type. genLit is\nresponsible for this, in the case of literal integers.\n\nOften, we won't see direct statements like:\n\n    if(1) {\n      ...\n    } else {\n      ...\n    }\n\nat this point in the pipeline, because the Glorious Code Generator\nwill do trivial branch elimination in the sinking pass (among others,)\nwhich will eliminate the expression entirely.\n\nHowever, it's certainly possible and reasonable for this to occur in\nhand-written C-- code. Consider something like:\n\n    #if !defined(SOME_CONDITIONAL)\n    #define CHECK_THING(x) 1\n    #else\n    #define CHECK_THING(x) some_operation((x))\n    #endif\n\n    f() {\n\n      if (CHECK_THING(xyz)) {\n        ...\n      } else {\n        ...\n      }\n\n    }\n\nIn such an instance, CHECK_THING might result in an *expression* in\none case, and a *literal* in the other, depending on what in\nparticular was #define'd. So we must be sure to properly narrow the\nliteral in this case to i1 as it won't be eliminated beforehand.\n\nFor a real example of this, see ./rts/StgStdThunks.cmm\n\n-}\n\n\n\n-- | Switch branch\ngenSwitch :: CmmExpr -> SwitchTargets -> LlvmM StmtData\ngenSwitch cond ids = do\n    (vc, stmts, top) <- exprToVar cond\n    let ty = getVarType vc\n\n    let labels = [ (mkIntLit ty ix, blockIdToLlvm b)\n                 | (ix, b) <- switchTargetsCases ids ]\n    -- out of range is undefined, so let's just branch to first label\n    let defLbl | Just l <- switchTargetsDefault ids = blockIdToLlvm l\n               | otherwise                          = snd (head labels)\n\n    let s1 = Switch vc defLbl labels\n    return $ (stmts `snocOL` s1, top)\n\n\n-- -----------------------------------------------------------------------------\n-- * CmmExpr code generation\n--\n\n-- | An expression conversion return data:\n--   * LlvmVar: The var holding the result of the expression\n--   * LlvmStatements: Any statements needed to evaluate the expression\n--   * LlvmCmmDecl: Any global data needed for this expression\ntype ExprData = (LlvmVar, LlvmStatements, [LlvmCmmDecl])\n\n-- | Values which can be passed to 'exprToVar' to configure its\n-- behaviour in certain circumstances.\n--\n-- Currently just used for determining if a comparison should return\n-- a boolean (i1) or a word. See Note [Literals and branch conditions].\nnewtype EOption = EOption { i1Expected :: Bool }\n-- XXX: EOption is an ugly and inefficient solution to this problem.\n\n-- | i1 type expected (condition scrutinee).\ni1Option :: EOption\ni1Option = EOption True\n\n-- | Word type expected (usual).\nwordOption :: EOption\nwordOption = EOption False\n\n-- | Convert a CmmExpr to a list of LlvmStatements with the result of the\n-- expression being stored in the returned LlvmVar.\nexprToVar :: CmmExpr -> LlvmM ExprData\nexprToVar = exprToVarOpt wordOption\n\nexprToVarOpt :: EOption -> CmmExpr -> LlvmM ExprData\nexprToVarOpt opt e = case e of\n\n    CmmLit lit\n        -> genLit opt lit\n\n    CmmLoad e' ty\n        -> genLoad False e' ty\n\n    -- Cmmreg in expression is the value, so must load. If you want actual\n    -- reg pointer, call getCmmReg directly.\n    CmmReg r -> do\n        (v1, ty, s1) <- getCmmRegVal r\n        case isPointer ty of\n             True  -> do\n                 -- Cmm wants the value, so pointer types must be cast to ints\n                 dflags <- getDynFlags\n                 (v2, s2) <- doExpr (llvmWord dflags) $ Cast LM_Ptrtoint v1 (llvmWord dflags)\n                 return (v2, s1 `snocOL` s2, [])\n\n             False -> return (v1, s1, [])\n\n    CmmMachOp op exprs\n        -> genMachOp opt op exprs\n\n    CmmRegOff r i\n        -> do dflags <- getDynFlags\n              exprToVar $ expandCmmReg dflags (r, i)\n\n    CmmStackSlot _ _\n        -> panic \"exprToVar: CmmStackSlot not supported!\"\n\n\n-- | Handle CmmMachOp expressions\ngenMachOp :: EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData\n\n-- Unary Machop\ngenMachOp _ op [x] = case op of\n\n    MO_Not w ->\n        let all1 = mkIntLit (widthToLlvmInt w) (-1)\n        in negate (widthToLlvmInt w) all1 LM_MO_Xor\n\n    MO_S_Neg w ->\n        let all0 = mkIntLit (widthToLlvmInt w) 0\n        in negate (widthToLlvmInt w) all0 LM_MO_Sub\n\n    MO_F_Neg w ->\n        let all0 = LMLitVar $ LMFloatLit (-0) (widthToLlvmFloat w)\n        in negate (widthToLlvmFloat w) all0 LM_MO_FSub\n\n    MO_SF_Conv _ w -> fiConv (widthToLlvmFloat w) LM_Sitofp\n    MO_FS_Conv _ w -> fiConv (widthToLlvmInt w) LM_Fptosi\n\n    MO_SS_Conv from to\n        -> sameConv from (widthToLlvmInt to) LM_Trunc LM_Sext\n\n    MO_UU_Conv from to\n        -> sameConv from (widthToLlvmInt to) LM_Trunc LM_Zext\n\n    MO_XX_Conv from to\n        -> sameConv from (widthToLlvmInt to) LM_Trunc LM_Zext\n\n    MO_FF_Conv from to\n        -> sameConv from (widthToLlvmFloat to) LM_Fptrunc LM_Fpext\n\n    MO_VS_Neg len w ->\n        let ty    = widthToLlvmInt w\n            vecty = LMVector len ty\n            all0  = LMIntLit (-0) ty\n            all0s = LMLitVar $ LMVectorLit (replicate len all0)\n        in negateVec vecty all0s LM_MO_Sub\n\n    MO_VF_Neg len w ->\n        let ty    = widthToLlvmFloat w\n            vecty = LMVector len ty\n            all0  = LMFloatLit (-0) ty\n            all0s = LMLitVar $ LMVectorLit (replicate len all0)\n        in negateVec vecty all0s LM_MO_FSub\n\n    MO_AlignmentCheck _ _ -> panic \"-falignment-sanitisation is not supported by -fllvm\"\n\n    -- Handle unsupported cases explicitly so we get a warning\n    -- of missing case when new MachOps added\n    MO_Add _          -> panicOp\n    MO_Mul _          -> panicOp\n    MO_Sub _          -> panicOp\n    MO_S_MulMayOflo _ -> panicOp\n    MO_S_Quot _       -> panicOp\n    MO_S_Rem _        -> panicOp\n    MO_U_MulMayOflo _ -> panicOp\n    MO_U_Quot _       -> panicOp\n    MO_U_Rem _        -> panicOp\n\n    MO_Eq  _          -> panicOp\n    MO_Ne  _          -> panicOp\n    MO_S_Ge _         -> panicOp\n    MO_S_Gt _         -> panicOp\n    MO_S_Le _         -> panicOp\n    MO_S_Lt _         -> panicOp\n    MO_U_Ge _         -> panicOp\n    MO_U_Gt _         -> panicOp\n    MO_U_Le _         -> panicOp\n    MO_U_Lt _         -> panicOp\n\n    MO_F_Add        _ -> panicOp\n    MO_F_Sub        _ -> panicOp\n    MO_F_Mul        _ -> panicOp\n    MO_F_Quot       _ -> panicOp\n    MO_F_Eq         _ -> panicOp\n    MO_F_Ne         _ -> panicOp\n    MO_F_Ge         _ -> panicOp\n    MO_F_Gt         _ -> panicOp\n    MO_F_Le         _ -> panicOp\n    MO_F_Lt         _ -> panicOp\n\n    MO_And          _ -> panicOp\n    MO_Or           _ -> panicOp\n    MO_Xor          _ -> panicOp\n    MO_Shl          _ -> panicOp\n    MO_U_Shr        _ -> panicOp\n    MO_S_Shr        _ -> panicOp\n\n    MO_V_Insert   _ _ -> panicOp\n    MO_V_Extract  _ _ -> panicOp\n\n    MO_V_Add      _ _ -> panicOp\n    MO_V_Sub      _ _ -> panicOp\n    MO_V_Mul      _ _ -> panicOp\n\n    MO_VS_Quot    _ _ -> panicOp\n    MO_VS_Rem     _ _ -> panicOp\n\n    MO_VU_Quot    _ _ -> panicOp\n    MO_VU_Rem     _ _ -> panicOp\n\n    MO_VF_Insert  _ _ -> panicOp\n    MO_VF_Extract _ _ -> panicOp\n\n    MO_VF_Add     _ _ -> panicOp\n    MO_VF_Sub     _ _ -> panicOp\n    MO_VF_Mul     _ _ -> panicOp\n    MO_VF_Quot    _ _ -> panicOp\n\n    where\n        negate ty v2 negOp = do\n            (vx, stmts, top) <- exprToVar x\n            (v1, s1) <- doExpr ty $ LlvmOp negOp v2 vx\n            return (v1, stmts `snocOL` s1, top)\n\n        negateVec ty v2 negOp = do\n            (vx, stmts1, top) <- exprToVar x\n            (vxs', stmts2) <- castVars Signed [(vx, ty)]\n            let vx' = singletonPanic \"genMachOp: negateVec\" vxs'\n            (v1, s1) <- doExpr ty $ LlvmOp negOp v2 vx'\n            return (v1, stmts1 `appOL` stmts2 `snocOL` s1, top)\n\n        fiConv ty convOp = do\n            (vx, stmts, top) <- exprToVar x\n            (v1, s1) <- doExpr ty $ Cast convOp vx ty\n            return (v1, stmts `snocOL` s1, top)\n\n        sameConv from ty reduce expand = do\n            x'@(vx, stmts, top) <- exprToVar x\n            let sameConv' op = do\n                    (v1, s1) <- doExpr ty $ Cast op vx ty\n                    return (v1, stmts `snocOL` s1, top)\n            dflags <- getDynFlags\n            let toWidth = llvmWidthInBits dflags ty\n            -- LLVM doesn't like trying to convert to same width, so\n            -- need to check for that as we do get Cmm code doing it.\n            case widthInBits from  of\n                 w | w < toWidth -> sameConv' expand\n                 w | w > toWidth -> sameConv' reduce\n                 _w              -> return x'\n\n        panicOp = panic $ \"LLVM.CodeGen.genMachOp: non unary op encountered\"\n                       ++ \"with one argument! (\" ++ show op ++ \")\"\n\n-- Handle GlobalRegs pointers\ngenMachOp opt o@(MO_Add _) e@[(CmmReg (CmmGlobal r)), (CmmLit (CmmInt n _))]\n    = genMachOp_fast opt o r (fromInteger n) e\n\ngenMachOp opt o@(MO_Sub _) e@[(CmmReg (CmmGlobal r)), (CmmLit (CmmInt n _))]\n    = genMachOp_fast opt o r (negate . fromInteger $ n) e\n\n-- Generic case\ngenMachOp opt op e = genMachOp_slow opt op e\n\n\n-- | Handle CmmMachOp expressions\n-- This is a specialised method that handles Global register manipulations like\n-- 'Sp - 16', using the getelementptr instruction.\ngenMachOp_fast :: EOption -> MachOp -> GlobalReg -> Int -> [CmmExpr]\n               -> LlvmM ExprData\ngenMachOp_fast opt op r n e\n  = do (gv, grt, s1) <- getCmmRegVal (CmmGlobal r)\n       dflags <- getDynFlags\n       let (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)\n       case isPointer grt && rem == 0 of\n            True -> do\n                (ptr, s2) <- doExpr grt $ GetElemPtr True gv [toI32 ix]\n                (var, s3) <- doExpr (llvmWord dflags) $ Cast LM_Ptrtoint ptr (llvmWord dflags)\n                return (var, s1 `snocOL` s2 `snocOL` s3, [])\n\n            False -> genMachOp_slow opt op e\n\n\n-- | Handle CmmMachOp expressions\n-- This handles all the cases not handle by the specialised genMachOp_fast.\ngenMachOp_slow :: EOption -> MachOp -> [CmmExpr] -> LlvmM ExprData\n\n-- Element extraction\ngenMachOp_slow _ (MO_V_Extract l w) [val, idx] = runExprData $ do\n    vval <- exprToVarW val\n    vidx <- exprToVarW idx\n    vval' <- singletonPanic \"genMachOp_slow\" <$>\n             castVarsW Signed [(vval, LMVector l ty)]\n    doExprW ty $ Extract vval' vidx\n  where\n    ty = widthToLlvmInt w\n\ngenMachOp_slow _ (MO_VF_Extract l w) [val, idx] = runExprData $ do\n    vval <- exprToVarW val\n    vidx <- exprToVarW idx\n    vval' <- singletonPanic \"genMachOp_slow\" <$>\n             castVarsW Signed [(vval, LMVector l ty)]\n    doExprW ty $ Extract vval' vidx\n  where\n    ty = widthToLlvmFloat w\n\n-- Element insertion\ngenMachOp_slow _ (MO_V_Insert l w) [val, elt, idx] = runExprData $ do\n    vval <- exprToVarW val\n    velt <- exprToVarW elt\n    vidx <- exprToVarW idx\n    vval' <- singletonPanic \"genMachOp_slow\" <$>\n             castVarsW Signed [(vval, ty)]\n    doExprW ty $ Insert vval' velt vidx\n  where\n    ty = LMVector l (widthToLlvmInt w)\n\ngenMachOp_slow _ (MO_VF_Insert l w) [val, elt, idx] = runExprData $ do\n    vval <- exprToVarW val\n    velt <- exprToVarW elt\n    vidx <- exprToVarW idx\n    vval' <- singletonPanic \"genMachOp_slow\" <$>\n             castVarsW Signed [(vval, ty)]\n    doExprW ty $ Insert vval' velt vidx\n  where\n    ty = LMVector l (widthToLlvmFloat w)\n\n-- Binary MachOp\ngenMachOp_slow opt op [x, y] = case op of\n\n    MO_Eq _   -> genBinComp opt LM_CMP_Eq\n    MO_Ne _   -> genBinComp opt LM_CMP_Ne\n\n    MO_S_Gt _ -> genBinComp opt LM_CMP_Sgt\n    MO_S_Ge _ -> genBinComp opt LM_CMP_Sge\n    MO_S_Lt _ -> genBinComp opt LM_CMP_Slt\n    MO_S_Le _ -> genBinComp opt LM_CMP_Sle\n\n    MO_U_Gt _ -> genBinComp opt LM_CMP_Ugt\n    MO_U_Ge _ -> genBinComp opt LM_CMP_Uge\n    MO_U_Lt _ -> genBinComp opt LM_CMP_Ult\n    MO_U_Le _ -> genBinComp opt LM_CMP_Ule\n\n    MO_Add _ -> genBinMach LM_MO_Add\n    MO_Sub _ -> genBinMach LM_MO_Sub\n    MO_Mul _ -> genBinMach LM_MO_Mul\n\n    MO_U_MulMayOflo _ -> panic \"genMachOp: MO_U_MulMayOflo unsupported!\"\n\n    MO_S_MulMayOflo w -> isSMulOK w x y\n\n    MO_S_Quot _ -> genBinMach LM_MO_SDiv\n    MO_S_Rem  _ -> genBinMach LM_MO_SRem\n\n    MO_U_Quot _ -> genBinMach LM_MO_UDiv\n    MO_U_Rem  _ -> genBinMach LM_MO_URem\n\n    MO_F_Eq _ -> genBinComp opt LM_CMP_Feq\n    MO_F_Ne _ -> genBinComp opt LM_CMP_Fne\n    MO_F_Gt _ -> genBinComp opt LM_CMP_Fgt\n    MO_F_Ge _ -> genBinComp opt LM_CMP_Fge\n    MO_F_Lt _ -> genBinComp opt LM_CMP_Flt\n    MO_F_Le _ -> genBinComp opt LM_CMP_Fle\n\n    MO_F_Add  _ -> genBinMach LM_MO_FAdd\n    MO_F_Sub  _ -> genBinMach LM_MO_FSub\n    MO_F_Mul  _ -> genBinMach LM_MO_FMul\n    MO_F_Quot _ -> genBinMach LM_MO_FDiv\n\n    MO_And _   -> genBinMach LM_MO_And\n    MO_Or  _   -> genBinMach LM_MO_Or\n    MO_Xor _   -> genBinMach LM_MO_Xor\n    MO_Shl _   -> genBinMach LM_MO_Shl\n    MO_U_Shr _ -> genBinMach LM_MO_LShr\n    MO_S_Shr _ -> genBinMach LM_MO_AShr\n\n    MO_V_Add l w   -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Add\n    MO_V_Sub l w   -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Sub\n    MO_V_Mul l w   -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Mul\n\n    MO_VS_Quot l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_SDiv\n    MO_VS_Rem  l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_SRem\n\n    MO_VU_Quot l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_UDiv\n    MO_VU_Rem  l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_URem\n\n    MO_VF_Add  l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FAdd\n    MO_VF_Sub  l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FSub\n    MO_VF_Mul  l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FMul\n    MO_VF_Quot l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FDiv\n\n    MO_Not _       -> panicOp\n    MO_S_Neg _     -> panicOp\n    MO_F_Neg _     -> panicOp\n\n    MO_SF_Conv _ _ -> panicOp\n    MO_FS_Conv _ _ -> panicOp\n    MO_SS_Conv _ _ -> panicOp\n    MO_UU_Conv _ _ -> panicOp\n    MO_XX_Conv _ _ -> panicOp\n    MO_FF_Conv _ _ -> panicOp\n\n    MO_V_Insert  {} -> panicOp\n    MO_V_Extract {} -> panicOp\n\n    MO_VS_Neg {} -> panicOp\n\n    MO_VF_Insert  {} -> panicOp\n    MO_VF_Extract {} -> panicOp\n\n    MO_VF_Neg {} -> panicOp\n\n    MO_AlignmentCheck {} -> panicOp\n\n    where\n        binLlvmOp ty binOp = runExprData $ do\n            vx <- exprToVarW x\n            vy <- exprToVarW y\n            if getVarType vx == getVarType vy\n                then do\n                    doExprW (ty vx) $ binOp vx vy\n\n                else do\n                    -- Error. Continue anyway so we can debug the generated ll file.\n                    dflags <- getDynFlags\n                    let style = mkCodeStyle CStyle\n                        toString doc = renderWithStyle dflags doc style\n                        cmmToStr = (lines . toString . PprCmm.pprExpr)\n                    statement $ Comment $ map fsLit $ cmmToStr x\n                    statement $ Comment $ map fsLit $ cmmToStr y\n                    doExprW (ty vx) $ binOp vx vy\n\n        binCastLlvmOp ty binOp = runExprData $ do\n            vx <- exprToVarW x\n            vy <- exprToVarW y\n            vxy' <- castVarsW Signed [(vx, ty), (vy, ty)]\n            case vxy' of\n              [vx',vy'] -> doExprW ty $ binOp vx' vy'\n              _         -> panic \"genMachOp_slow: binCastLlvmOp\"\n\n        -- | Need to use EOption here as Cmm expects word size results from\n        -- comparisons while LLVM return i1. Need to extend to llvmWord type\n        -- if expected. See Note [Literals and branch conditions].\n        genBinComp opt cmp = do\n            ed@(v1, stmts, top) <- binLlvmOp (\\_ -> i1) (Compare cmp)\n            dflags <- getDynFlags\n            if getVarType v1 == i1\n                then case i1Expected opt of\n                    True  -> return ed\n                    False -> do\n                        let w_ = llvmWord dflags\n                        (v2, s1) <- doExpr w_ $ Cast LM_Zext v1 w_\n                        return (v2, stmts `snocOL` s1, top)\n                else\n                    panic $ \"genBinComp: Compare returned type other then i1! \"\n                        ++ (showSDoc dflags $ ppr $ getVarType v1)\n\n        genBinMach op = binLlvmOp getVarType (LlvmOp op)\n\n        genCastBinMach ty op = binCastLlvmOp ty (LlvmOp op)\n\n        -- | Detect if overflow will occur in signed multiply of the two\n        -- CmmExpr's. This is the LLVM assembly equivalent of the NCG\n        -- implementation. Its much longer due to type information/safety.\n        -- This should actually compile to only about 3 asm instructions.\n        isSMulOK :: Width -> CmmExpr -> CmmExpr -> LlvmM ExprData\n        isSMulOK _ x y = runExprData $ do\n            vx <- exprToVarW x\n            vy <- exprToVarW y\n\n            dflags <- getDynFlags\n            let word  = getVarType vx\n            let word2 = LMInt $ 2 * (llvmWidthInBits dflags $ getVarType vx)\n            let shift = llvmWidthInBits dflags word\n            let shift1 = toIWord dflags (shift - 1)\n            let shift2 = toIWord dflags shift\n\n            if isInt word\n                then do\n                    x1     <- doExprW word2 $ Cast LM_Sext vx word2\n                    y1     <- doExprW word2 $ Cast LM_Sext vy word2\n                    r1     <- doExprW word2 $ LlvmOp LM_MO_Mul x1 y1\n                    rlow1  <- doExprW word $ Cast LM_Trunc r1 word\n                    rlow2  <- doExprW word $ LlvmOp LM_MO_AShr rlow1 shift1\n                    rhigh1 <- doExprW word2 $ LlvmOp LM_MO_AShr r1 shift2\n                    rhigh2 <- doExprW word $ Cast LM_Trunc rhigh1 word\n                    doExprW word $ LlvmOp LM_MO_Sub rlow2 rhigh2\n\n                else\n                    panic $ \"isSMulOK: Not bit type! (\" ++ showSDoc dflags (ppr word) ++ \")\"\n\n        panicOp = panic $ \"LLVM.CodeGen.genMachOp_slow: unary op encountered\"\n                       ++ \"with two arguments! (\" ++ show op ++ \")\"\n\n-- More than two expression, invalid!\ngenMachOp_slow _ _ _ = panic \"genMachOp: More than 2 expressions in MachOp!\"\n\n\n-- | Handle CmmLoad expression.\ngenLoad :: Atomic -> CmmExpr -> CmmType -> LlvmM ExprData\n\n-- First we try to detect a few common cases and produce better code for\n-- these then the default case. We are mostly trying to detect Cmm code\n-- like I32[Sp + n] and use 'getelementptr' operations instead of the\n-- generic case that uses casts and pointer arithmetic\ngenLoad atomic e@(CmmReg (CmmGlobal r)) ty\n    = genLoad_fast atomic e r 0 ty\n\ngenLoad atomic e@(CmmRegOff (CmmGlobal r) n) ty\n    = genLoad_fast atomic e r n ty\n\ngenLoad atomic e@(CmmMachOp (MO_Add _) [\n                            (CmmReg (CmmGlobal r)),\n                            (CmmLit (CmmInt n _))])\n                ty\n    = genLoad_fast atomic e r (fromInteger n) ty\n\ngenLoad atomic e@(CmmMachOp (MO_Sub _) [\n                            (CmmReg (CmmGlobal r)),\n                            (CmmLit (CmmInt n _))])\n                ty\n    = genLoad_fast atomic e r (negate $ fromInteger n) ty\n\n-- generic case\ngenLoad atomic e ty\n    = getTBAAMeta topN >>= genLoad_slow atomic e ty\n\n-- | Handle CmmLoad expression.\n-- This is a special case for loading from a global register pointer\n-- offset such as I32[Sp+8].\ngenLoad_fast :: Atomic -> CmmExpr -> GlobalReg -> Int -> CmmType\n             -> LlvmM ExprData\ngenLoad_fast atomic e r n ty = do\n    dflags <- getDynFlags\n    (gv, grt, s1) <- getCmmRegVal (CmmGlobal r)\n    meta          <- getTBAARegMeta r\n    let ty'      = cmmToLlvmType ty\n        (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)\n    case isPointer grt && rem == 0 of\n            True  -> do\n                (ptr, s2) <- doExpr grt $ GetElemPtr True gv [toI32 ix]\n                -- We might need a different pointer type, so check\n                case grt == ty' of\n                     -- were fine\n                     True -> do\n                         (var, s3) <- doExpr ty' (MExpr meta $ loadInstr ptr)\n                         return (var, s1 `snocOL` s2 `snocOL` s3,\n                                     [])\n\n                     -- cast to pointer type needed\n                     False -> do\n                         let pty = pLift ty'\n                         (ptr', s3) <- doExpr pty $ Cast LM_Bitcast ptr pty\n                         (var, s4) <- doExpr ty' (MExpr meta $ loadInstr ptr')\n                         return (var, s1 `snocOL` s2 `snocOL` s3\n                                    `snocOL` s4, [])\n\n            -- If its a bit type then we use the slow method since\n            -- we can't avoid casting anyway.\n            False -> genLoad_slow atomic  e ty meta\n  where\n    loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr\n                  | otherwise = Load ptr\n\n-- | Handle Cmm load expression.\n-- Generic case. Uses casts and pointer arithmetic if needed.\ngenLoad_slow :: Atomic -> CmmExpr -> CmmType -> [MetaAnnot] -> LlvmM ExprData\ngenLoad_slow atomic e ty meta = runExprData $ do\n    iptr <- exprToVarW e\n    dflags <- getDynFlags\n    case getVarType iptr of\n         LMPointer _ -> do\n                    doExprW (cmmToLlvmType ty) (MExpr meta $ loadInstr iptr)\n\n         i@(LMInt _) | i == llvmWord dflags -> do\n                    let pty = LMPointer $ cmmToLlvmType ty\n                    ptr <- doExprW pty $ Cast LM_Inttoptr iptr pty\n                    doExprW (cmmToLlvmType ty) (MExpr meta $ loadInstr ptr)\n\n         other -> do pprPanic \"exprToVar: CmmLoad expression is not right type!\"\n                        (PprCmm.pprExpr e <+> text (\n                            \"Size of Ptr: \" ++ show (llvmPtrBits dflags) ++\n                            \", Size of var: \" ++ show (llvmWidthInBits dflags other) ++\n                            \", Var: \" ++ showSDoc dflags (ppr iptr)))\n  where\n    loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr\n                  | otherwise = Load ptr\n\n\n-- | Handle CmmReg expression. This will return a pointer to the stack\n-- location of the register. Throws an error if it isn't allocated on\n-- the stack.\ngetCmmReg :: CmmReg -> LlvmM LlvmVar\ngetCmmReg (CmmLocal (LocalReg un _))\n  = do exists <- varLookup un\n       dflags <- getDynFlags\n       case exists of\n         Just ety -> return (LMLocalVar un $ pLift ety)\n         Nothing  -> panic $ \"getCmmReg: Cmm register \" ++ showSDoc dflags (ppr un) ++ \" was not allocated!\"\n           -- This should never happen, as every local variable should\n           -- have been assigned a value at some point, triggering\n           -- \"funPrologue\" to allocate it on the stack.\n\ngetCmmReg (CmmGlobal g)\n  = do onStack <- checkStackReg g\n       dflags <- getDynFlags\n       if onStack\n         then return (lmGlobalRegVar dflags g)\n         else panic $ \"getCmmReg: Cmm register \" ++ showSDoc dflags (ppr g) ++ \" not stack-allocated!\"\n\n-- | Return the value of a given register, as well as its type. Might\n-- need to be load from stack.\ngetCmmRegVal :: CmmReg -> LlvmM (LlvmVar, LlvmType, LlvmStatements)\ngetCmmRegVal reg =\n  case reg of\n    CmmGlobal g -> do\n      onStack <- checkStackReg g\n      dflags <- getDynFlags\n      if onStack then loadFromStack else do\n        let r = lmGlobalRegArg dflags g\n        return (r, getVarType r, nilOL)\n    _ -> loadFromStack\n where loadFromStack = do\n         ptr <- getCmmReg reg\n         let ty = pLower $ getVarType ptr\n         (v, s) <- doExpr ty (Load ptr)\n         return (v, ty, unitOL s)\n\n-- | Allocate a local CmmReg on the stack\nallocReg :: CmmReg -> (LlvmVar, LlvmStatements)\nallocReg (CmmLocal (LocalReg un ty))\n  = let ty' = cmmToLlvmType ty\n        var = LMLocalVar un (LMPointer ty')\n        alc = Alloca ty' 1\n    in (var, unitOL $ Assignment var alc)\n\nallocReg _ = panic $ \"allocReg: Global reg encountered! Global registers should\"\n                    ++ \" have been handled elsewhere!\"\n\n\n-- | Generate code for a literal\ngenLit :: EOption -> CmmLit -> LlvmM ExprData\ngenLit opt (CmmInt i w)\n  -- See Note [Literals and branch conditions].\n  = let width | i1Expected opt = i1\n              | otherwise      = LMInt (widthInBits w)\n        -- comm  = Comment [ fsLit $ \"EOption: \" ++ show opt\n        --                 , fsLit $ \"Width  : \" ++ show w\n        --                 , fsLit $ \"Width' : \" ++ show (widthInBits w)\n        --                 ]\n    in return (mkIntLit width i, nilOL, [])\n\ngenLit _ (CmmFloat r w)\n  = return (LMLitVar $ LMFloatLit (fromRational r) (widthToLlvmFloat w),\n              nilOL, [])\n\ngenLit opt (CmmVec ls)\n  = do llvmLits <- mapM toLlvmLit ls\n       return (LMLitVar $ LMVectorLit llvmLits, nilOL, [])\n  where\n    toLlvmLit :: CmmLit -> LlvmM LlvmLit\n    toLlvmLit lit = do\n        (llvmLitVar, _, _) <- genLit opt lit\n        case llvmLitVar of\n          LMLitVar llvmLit -> return llvmLit\n          _ -> panic \"genLit\"\n\ngenLit _ cmm@(CmmLabel l)\n  = do var <- getGlobalPtr =<< strCLabel_llvm l\n       dflags <- getDynFlags\n       let lmty = cmmToLlvmType $ cmmLitType dflags cmm\n       (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)\n       return (v1, unitOL s1, [])\n\ngenLit opt (CmmLabelOff label off) = do\n    dflags <- getDynFlags\n    (vlbl, stmts, stat) <- genLit opt (CmmLabel label)\n    let voff = toIWord dflags off\n    (v1, s1) <- doExpr (getVarType vlbl) $ LlvmOp LM_MO_Add vlbl voff\n    return (v1, stmts `snocOL` s1, stat)\n\ngenLit opt (CmmLabelDiffOff l1 l2 off w) = do\n    dflags <- getDynFlags\n    (vl1, stmts1, stat1) <- genLit opt (CmmLabel l1)\n    (vl2, stmts2, stat2) <- genLit opt (CmmLabel l2)\n    let voff = toIWord dflags off\n    let ty1 = getVarType vl1\n    let ty2 = getVarType vl2\n    if (isInt ty1) && (isInt ty2)\n       && (llvmWidthInBits dflags ty1 == llvmWidthInBits dflags ty2)\n       then do\n            (v1, s1) <- doExpr (getVarType vl1) $ LlvmOp LM_MO_Sub vl1 vl2\n            (v2, s2) <- doExpr (getVarType v1 ) $ LlvmOp LM_MO_Add v1 voff\n            let ty = widthToLlvmInt w\n            let stmts = stmts1 `appOL` stmts2 `snocOL` s1 `snocOL` s2\n            if w /= wordWidth dflags\n              then do\n                (v3, s3) <- doExpr ty $ Cast LM_Trunc v2 ty\n                return (v3, stmts `snocOL` s3, stat1 ++ stat2)\n              else\n                return (v2, stmts, stat1 ++ stat2)\n        else\n            panic \"genLit: CmmLabelDiffOff encountered with different label ty!\"\n\ngenLit opt (CmmBlock b)\n  = genLit opt (CmmLabel $ infoTblLbl b)\n\ngenLit _ CmmHighStackMark\n  = panic \"genStaticLit - CmmHighStackMark unsupported!\"\n\n\n-- -----------------------------------------------------------------------------\n-- * Misc\n--\n\n-- | Find CmmRegs that get assigned and allocate them on the stack\n--\n-- Any register that gets written needs to be allcoated on the\n-- stack. This avoids having to map a CmmReg to an equivalent SSA form\n-- and avoids having to deal with Phi node insertion.  This is also\n-- the approach recommended by LLVM developers.\n--\n-- On the other hand, this is unnecessarily verbose if the register in\n-- question is never written. Therefore we skip it where we can to\n-- save a few lines in the output and hopefully speed compilation up a\n-- bit.\nfunPrologue :: LiveGlobalRegs -> [CmmBlock] -> LlvmM StmtData\nfunPrologue live cmmBlocks = do\n\n  trash <- getTrashRegs\n  let getAssignedRegs :: CmmNode O O -> [CmmReg]\n      getAssignedRegs (CmmAssign reg _)  = [reg]\n      -- Calls will trash all registers. Unfortunately, this needs them to\n      -- be stack-allocated in the first place.\n      getAssignedRegs (CmmUnsafeForeignCall _ rs _) = map CmmGlobal trash ++ map CmmLocal rs\n      getAssignedRegs _                  = []\n      getRegsBlock (_, body, _)          = concatMap getAssignedRegs $ blockToList body\n      assignedRegs = nub $ concatMap (getRegsBlock . blockSplit) cmmBlocks\n      isLive r     = r `elem` alwaysLive || r `elem` live\n\n  dflags <- getDynFlags\n  stmtss <- flip mapM assignedRegs $ \\reg ->\n    case reg of\n      CmmLocal (LocalReg un _) -> do\n        let (newv, stmts) = allocReg reg\n        varInsert un (pLower $ getVarType newv)\n        return stmts\n      CmmGlobal r -> do\n        let reg   = lmGlobalRegVar dflags r\n            arg   = lmGlobalRegArg dflags r\n            ty    = (pLower . getVarType) reg\n            trash = LMLitVar $ LMUndefLit ty\n            rval  = if isLive r then arg else trash\n            alloc = Assignment reg $ Alloca (pLower $ getVarType reg) 1\n        markStackReg r\n        return $ toOL [alloc, Store rval reg]\n\n  return (concatOL stmtss, [])\n\n-- | Function epilogue. Load STG variables to use as argument for call.\n-- STG Liveness optimisation done here.\nfunEpilogue :: LiveGlobalRegs -> LlvmM ([LlvmVar], LlvmStatements)\nfunEpilogue live = do\n\n    -- Have information and liveness optimisation is enabled?\n    let liveRegs = alwaysLive ++ live\n        isSSE (FloatReg _)  = True\n        isSSE (DoubleReg _) = True\n        isSSE (XmmReg _)    = True\n        isSSE (YmmReg _)    = True\n        isSSE (ZmmReg _)    = True\n        isSSE _             = False\n\n    -- Set to value or \"undef\" depending on whether the register is\n    -- actually live\n    dflags <- getDynFlags\n    let loadExpr r = do\n          (v, _, s) <- getCmmRegVal (CmmGlobal r)\n          return (Just $ v, s)\n        loadUndef r = do\n          let ty = (pLower . getVarType $ lmGlobalRegVar dflags r)\n          return (Just $ LMLitVar $ LMUndefLit ty, nilOL)\n    platform <- getDynFlag targetPlatform\n    loads <- flip mapM (activeStgRegs platform) $ \\r -> case () of\n      _ | r `elem` liveRegs  -> loadExpr r\n        | not (isSSE r)      -> loadUndef r\n        | otherwise          -> return (Nothing, nilOL)\n\n    let (vars, stmts) = unzip loads\n    return (catMaybes vars, concatOL stmts)\n\n\n-- | A series of statements to trash all the STG registers.\n--\n-- In LLVM we pass the STG registers around everywhere in function calls.\n-- So this means LLVM considers them live across the entire function, when\n-- in reality they usually aren't. For Caller save registers across C calls\n-- the saving and restoring of them is done by the Cmm code generator,\n-- using Cmm local vars. So to stop LLVM saving them as well (and saving\n-- all of them since it thinks they're always live, we trash them just\n-- before the call by assigning the 'undef' value to them. The ones we\n-- need are restored from the Cmm local var and the ones we don't need\n-- are fine to be trashed.\ngetTrashStmts :: LlvmM LlvmStatements\ngetTrashStmts = do\n  regs <- getTrashRegs\n  stmts <- flip mapM regs $ \\ r -> do\n    reg <- getCmmReg (CmmGlobal r)\n    let ty = (pLower . getVarType) reg\n    return $ Store (LMLitVar $ LMUndefLit ty) reg\n  return $ toOL stmts\n\ngetTrashRegs :: LlvmM [GlobalReg]\ngetTrashRegs = do plat <- getLlvmPlatform\n                  return $ filter (callerSaves plat) (activeStgRegs plat)\n\n-- | Get a function pointer to the CLabel specified.\n--\n-- This is for Haskell functions, function type is assumed, so doesn't work\n-- with foreign functions.\ngetHsFunc :: LiveGlobalRegs -> CLabel -> LlvmM ExprData\ngetHsFunc live lbl\n  = do fty <- llvmFunTy live\n       name <- strCLabel_llvm lbl\n       getHsFunc' name fty\n\ngetHsFunc' :: LMString -> LlvmType -> LlvmM ExprData\ngetHsFunc' name fty\n  = do fun <- getGlobalPtr name\n       if getVarType fun == fty\n         then return (fun, nilOL, [])\n         else do (v1, s1) <- doExpr (pLift fty)\n                               $ Cast LM_Bitcast fun (pLift fty)\n                 return  (v1, unitOL s1, [])\n\n-- | Create a new local var\nmkLocalVar :: LlvmType -> LlvmM LlvmVar\nmkLocalVar ty = do\n    un <- getUniqueM\n    return $ LMLocalVar un ty\n\n\n-- | Execute an expression, assigning result to a var\ndoExpr :: LlvmType -> LlvmExpression -> LlvmM (LlvmVar, LlvmStatement)\ndoExpr ty expr = do\n    v <- mkLocalVar ty\n    return (v, Assignment v expr)\n\n\n-- | Expand CmmRegOff\nexpandCmmReg :: DynFlags -> (CmmReg, Int) -> CmmExpr\nexpandCmmReg dflags (reg, off)\n  = let width = typeWidth (cmmRegType dflags reg)\n        voff  = CmmLit $ CmmInt (fromIntegral off) width\n    in CmmMachOp (MO_Add width) [CmmReg reg, voff]\n\n\n-- | Convert a block id into a appropriate Llvm label\nblockIdToLlvm :: BlockId -> LlvmVar\nblockIdToLlvm bid = LMLocalVar (getUnique bid) LMLabel\n\n-- | Create Llvm int Literal\nmkIntLit :: Integral a => LlvmType -> a -> LlvmVar\nmkIntLit ty i = LMLitVar $ LMIntLit (toInteger i) ty\n\n-- | Convert int type to a LLvmVar of word or i32 size\ntoI32 :: Integral a => a -> LlvmVar\ntoI32 = mkIntLit i32\n\ntoIWord :: Integral a => DynFlags -> a -> LlvmVar\ntoIWord dflags = mkIntLit (llvmWord dflags)\n\n\n-- | Error functions\npanic :: String -> a\npanic s = Outputable.panic $ \"LlvmCodeGen.CodeGen.\" ++ s\n\npprPanic :: String -> SDoc -> a\npprPanic s d = Outputable.pprPanic (\"LlvmCodeGen.CodeGen.\" ++ s) d\n\n\n-- | Returns TBAA meta data by unique\ngetTBAAMeta :: Unique -> LlvmM [MetaAnnot]\ngetTBAAMeta u = do\n    mi <- getUniqMeta u\n    return [MetaAnnot tbaa (MetaNode i) | let Just i = mi]\n\n-- | Returns TBAA meta data for given register\ngetTBAARegMeta :: GlobalReg -> LlvmM [MetaAnnot]\ngetTBAARegMeta = getTBAAMeta . getTBAA\n\n\n-- | A more convenient way of accumulating LLVM statements and declarations.\ndata LlvmAccum = LlvmAccum LlvmStatements [LlvmCmmDecl]\n\ninstance Semigroup LlvmAccum where\n  LlvmAccum stmtsA declsA <> LlvmAccum stmtsB declsB =\n        LlvmAccum (stmtsA Semigroup.<> stmtsB) (declsA Semigroup.<> declsB)\n\ninstance Monoid LlvmAccum where\n    mempty = LlvmAccum nilOL []\n    mappend = (Semigroup.<>)\n\nliftExprData :: LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar\nliftExprData action = do\n    (var, stmts, decls) <- lift action\n    tell $ LlvmAccum stmts decls\n    return var\n\nstatement :: LlvmStatement -> WriterT LlvmAccum LlvmM ()\nstatement stmt = tell $ LlvmAccum (unitOL stmt) []\n\ndoExprW :: LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar\ndoExprW a b = do\n    (var, stmt) <- lift $ doExpr a b\n    statement stmt\n    return var\n\nexprToVarW :: CmmExpr -> WriterT LlvmAccum LlvmM LlvmVar\nexprToVarW = liftExprData . exprToVar\n\nrunExprData :: WriterT LlvmAccum LlvmM LlvmVar -> LlvmM ExprData\nrunExprData action = do\n    (var, LlvmAccum stmts decls) <- runWriterT action\n    return (var, stmts, decls)\n\nrunStmtsDecls :: WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl])\nrunStmtsDecls action = do\n    LlvmAccum stmts decls <- execWriterT action\n    return (stmts, decls)\n\ngetCmmRegW :: CmmReg -> WriterT LlvmAccum LlvmM LlvmVar\ngetCmmRegW = lift . getCmmReg\n\ngenLoadW :: Atomic -> CmmExpr -> CmmType -> WriterT LlvmAccum LlvmM LlvmVar\ngenLoadW atomic e ty = liftExprData $ genLoad atomic e ty\n\ndoTrashStmts :: WriterT LlvmAccum LlvmM ()\ndoTrashStmts = do\n    stmts <- lift getTrashStmts\n    tell $ LlvmAccum stmts mempty\n\n-- | Return element of single-element list; 'panic' if list is not a single-element list\nsingletonPanic :: String -> [a] -> a\nsingletonPanic _ [x] = x\nsingletonPanic s _ = panic s\n", "num_lines": 2009}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n-- ----------------------------------------------------------------------------\n-- | Handle conversion of CmmData to LLVM code.\n--\n\nmodule LlvmCodeGen.Data (\n        genLlvmData, genData\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Llvm\nimport LlvmCodeGen.Base\n\nimport BlockId\nimport CLabel\nimport Cmm\nimport DynFlags\nimport Platform\n\nimport FastString\nimport Outputable\nimport qualified Data.ByteString as BS\n\n-- ----------------------------------------------------------------------------\n-- * Constants\n--\n\n-- | The string appended to a variable name to create its structure type alias\nstructStr :: LMString\nstructStr = fsLit \"_struct\"\n\n-- ----------------------------------------------------------------------------\n-- * Top level\n--\n\n-- | Pass a CmmStatic section to an equivalent Llvm code.\ngenLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData\ngenLlvmData (sec, Statics lbl xs) = do\n    label <- strCLabel_llvm lbl\n    static <- mapM genData xs\n    lmsec <- llvmSection sec\n    let types   = map getStatType static\n\n        strucTy = LMStruct types\n        tyAlias = LMAlias ((label `appendFS` structStr), strucTy)\n\n        struct         = Just $ LMStaticStruc static tyAlias\n        link           = if (externallyVisibleCLabel lbl)\n                            then ExternallyVisible else Internal\n        align          = case sec of\n                            Section CString _ -> Just 1\n                            _                 -> Nothing\n        const          = if isSecConstant sec then Constant else Global\n        varDef         = LMGlobalVar label tyAlias link lmsec align const\n        globDef        = LMGlobal varDef struct\n\n    return ([globDef], [tyAlias])\n\n-- | Format the section type part of a Cmm Section\nllvmSectionType :: Platform -> SectionType -> FastString\nllvmSectionType p t = case t of\n    Text                    -> fsLit \".text\"\n    ReadOnlyData            -> case platformOS p of\n                                 OSMinGW32 -> fsLit \".rdata\"\n                                 _         -> fsLit \".rodata\"\n    RelocatableReadOnlyData -> case platformOS p of\n                                 OSMinGW32 -> fsLit \".rdata$rel.ro\"\n                                 _         -> fsLit \".data.rel.ro\"\n    ReadOnlyData16          -> case platformOS p of\n                                 OSMinGW32 -> fsLit \".rdata$cst16\"\n                                 _         -> fsLit \".rodata.cst16\"\n    Data                    -> fsLit \".data\"\n    UninitialisedData       -> fsLit \".bss\"\n    CString                 -> case platformOS p of\n                                 OSMinGW32 -> fsLit \".rdata$str\"\n                                 _         -> fsLit \".rodata.str\"\n    (OtherSection _)        -> panic \"llvmSectionType: unknown section type\"\n\n-- | Format a Cmm Section into a LLVM section name\nllvmSection :: Section -> LlvmM LMSection\nllvmSection (Section t suffix) = do\n  dflags <- getDynFlags\n  let splitSect = gopt Opt_SplitSections dflags\n      platform  = targetPlatform dflags\n  if not splitSect\n  then return Nothing\n  else do\n    lmsuffix <- strCLabel_llvm suffix\n    let result sep = Just (concatFS [llvmSectionType platform t\n                                    , fsLit sep, lmsuffix])\n    case platformOS platform of\n      OSMinGW32 -> return (result \"$\")\n      _         -> return (result \".\")\n\n-- ----------------------------------------------------------------------------\n-- * Generate static data\n--\n\n-- | Handle static data\ngenData :: CmmStatic -> LlvmM LlvmStatic\n\ngenData (CmmString str) = do\n    let v  = map (\\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8)\n                 (BS.unpack str)\n        ve = v ++ [LMStaticLit $ LMIntLit 0 i8]\n    return $ LMStaticArray ve (LMArray (length ve) i8)\n\ngenData (CmmUninitialised bytes)\n    = return $ LMUninitType (LMArray bytes i8)\n\ngenData (CmmStaticLit lit)\n    = genStaticLit lit\n\n-- | Generate Llvm code for a static literal.\n--\n-- Will either generate the code or leave it unresolved if it is a 'CLabel'\n-- which isn't yet known.\ngenStaticLit :: CmmLit -> LlvmM LlvmStatic\ngenStaticLit (CmmInt i w)\n    = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))\n\ngenStaticLit (CmmFloat r w)\n    = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))\n\ngenStaticLit (CmmVec ls)\n    = do sls <- mapM toLlvmLit ls\n         return $ LMStaticLit (LMVectorLit sls)\n  where\n    toLlvmLit :: CmmLit -> LlvmM LlvmLit\n    toLlvmLit lit = do\n      slit <- genStaticLit lit\n      case slit of\n        LMStaticLit llvmLit -> return llvmLit\n        _ -> panic \"genStaticLit\"\n\n-- Leave unresolved, will fix later\ngenStaticLit cmm@(CmmLabel l) = do\n    var <- getGlobalPtr =<< strCLabel_llvm l\n    dflags <- getDynFlags\n    let ptr = LMStaticPointer var\n        lmty = cmmToLlvmType $ cmmLitType dflags cmm\n    return $ LMPtoI ptr lmty\n\ngenStaticLit (CmmLabelOff label off) = do\n    dflags <- getDynFlags\n    var <- genStaticLit (CmmLabel label)\n    let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)\n    return $ LMAdd var offset\n\ngenStaticLit (CmmLabelDiffOff l1 l2 off w) = do\n    dflags <- getDynFlags\n    var1 <- genStaticLit (CmmLabel l1)\n    var2 <- genStaticLit (CmmLabel l2)\n    let var\n          | w == wordWidth dflags = LMSub var1 var2\n          | otherwise = LMTrunc (LMSub var1 var2) (widthToLlvmInt w)\n        offset = LMStaticLit $ LMIntLit (toInteger off) (LMInt $ widthInBits w)\n    return $ LMAdd var offset\n\ngenStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b\n\ngenStaticLit (CmmHighStackMark)\n    = panic \"genStaticLit: CmmHighStackMark unsupported!\"\n", "num_lines": 167}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- ----------------------------------------------------------------------------\n-- | Pretty print helpers for the LLVM Code generator.\n--\nmodule LlvmCodeGen.Ppr (\n        pprLlvmCmmDecl, pprLlvmData, infoSection\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Llvm\nimport LlvmCodeGen.Base\nimport LlvmCodeGen.Data\n\nimport CLabel\nimport Cmm\n\nimport FastString\nimport Outputable\nimport Unique\n\n-- ----------------------------------------------------------------------------\n-- * Top level\n--\n\n-- | Pretty print LLVM data code\npprLlvmData :: LlvmData -> SDoc\npprLlvmData (globals, types) =\n    let ppLlvmTys (LMAlias    a) = ppLlvmAlias a\n        ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f\n        ppLlvmTys _other         = empty\n\n        types'   = vcat $ map ppLlvmTys types\n        globals' = ppLlvmGlobals globals\n    in types' $+$ globals'\n\n\n-- | Pretty print LLVM code\npprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])\npprLlvmCmmDecl (CmmData _ lmdata)\n  = return (vcat $ map pprLlvmData lmdata, [])\n\npprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))\n  = do let lbl = case mb_info of\n                     Nothing                   -> entry_lbl\n                     Just (Statics info_lbl _) -> info_lbl\n           link = if externallyVisibleCLabel lbl\n                      then ExternallyVisible\n                      else Internal\n           lmblocks = map (\\(BasicBlock id stmts) ->\n                                LlvmBlock (getUnique id) stmts) blks\n\n       funDec <- llvmFunSig live lbl link\n       dflags <- getDynFlags\n       let buildArg = fsLit . showSDoc dflags . ppPlainName\n           funArgs = map buildArg (llvmFunArgs dflags live)\n           funSect = llvmFunSection dflags (decName funDec)\n\n       -- generate the info table\n       prefix <- case mb_info of\n                     Nothing -> return Nothing\n                     Just (Statics _ statics) -> do\n                       infoStatics <- mapM genData statics\n                       let infoTy = LMStruct $ map getStatType infoStatics\n                       return $ Just $ LMStaticStruc infoStatics infoTy\n\n\n       let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect\n                              prefix lmblocks\n           name = decName $ funcDecl fun\n           defName = name `appendFS` fsLit \"$def\"\n           funcDecl' = (funcDecl fun) { decName = defName }\n           fun' = fun { funcDecl = funcDecl' }\n           funTy = LMFunction funcDecl'\n           funVar = LMGlobalVar name\n                                (LMPointer funTy)\n                                link\n                                Nothing\n                                Nothing\n                                Alias\n           defVar = LMGlobalVar defName\n                                (LMPointer funTy)\n                                (funcLinkage funcDecl')\n                                (funcSect fun)\n                                (funcAlign funcDecl')\n                                Alias\n           alias = LMGlobal funVar\n                            (Just $ LMBitc (LMStaticPointer defVar)\n                                           i8Ptr)\n\n       return (ppLlvmGlobal alias $+$ ppLlvmFunction fun', [])\n\n\n-- | The section we are putting info tables and their entry code into, should\n-- be unique since we process the assembly pattern matching this.\ninfoSection :: String\ninfoSection = \"X98A__STRIP,__me\"\n", "num_lines": 101}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n--------------------------------------------------------------------------------\n-- | Deal with Cmm registers\n--\n\nmodule LlvmCodeGen.Regs (\n        lmGlobalRegArg, lmGlobalRegVar, alwaysLive,\n        stgTBAA, baseN, stackN, heapN, rxN, topN, tbaa, getTBAA\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Llvm\n\nimport CmmExpr\nimport DynFlags\nimport FastString\nimport Outputable ( panic )\nimport Unique\n\n-- | Get the LlvmVar function variable storing the real register\nlmGlobalRegVar :: DynFlags -> GlobalReg -> LlvmVar\nlmGlobalRegVar dflags = pVarLift . lmGlobalReg dflags \"_Var\"\n\n-- | Get the LlvmVar function argument storing the real register\nlmGlobalRegArg :: DynFlags -> GlobalReg -> LlvmVar\nlmGlobalRegArg dflags = lmGlobalReg dflags \"_Arg\"\n\n{- Need to make sure the names here can't conflict with the unique generated\n   names. Uniques generated names containing only base62 chars. So using say\n   the '_' char guarantees this.\n-}\nlmGlobalReg :: DynFlags -> String -> GlobalReg -> LlvmVar\nlmGlobalReg dflags suf reg\n  = case reg of\n        BaseReg        -> ptrGlobal $ \"Base\" ++ suf\n        Sp             -> ptrGlobal $ \"Sp\" ++ suf\n        Hp             -> ptrGlobal $ \"Hp\" ++ suf\n        VanillaReg 1 _ -> wordGlobal $ \"R1\" ++ suf\n        VanillaReg 2 _ -> wordGlobal $ \"R2\" ++ suf\n        VanillaReg 3 _ -> wordGlobal $ \"R3\" ++ suf\n        VanillaReg 4 _ -> wordGlobal $ \"R4\" ++ suf\n        VanillaReg 5 _ -> wordGlobal $ \"R5\" ++ suf\n        VanillaReg 6 _ -> wordGlobal $ \"R6\" ++ suf\n        VanillaReg 7 _ -> wordGlobal $ \"R7\" ++ suf\n        VanillaReg 8 _ -> wordGlobal $ \"R8\" ++ suf\n        SpLim          -> wordGlobal $ \"SpLim\" ++ suf\n        FloatReg 1     -> floatGlobal $\"F1\" ++ suf\n        FloatReg 2     -> floatGlobal $\"F2\" ++ suf\n        FloatReg 3     -> floatGlobal $\"F3\" ++ suf\n        FloatReg 4     -> floatGlobal $\"F4\" ++ suf\n        FloatReg 5     -> floatGlobal $\"F5\" ++ suf\n        FloatReg 6     -> floatGlobal $\"F6\" ++ suf\n        DoubleReg 1    -> doubleGlobal $ \"D1\" ++ suf\n        DoubleReg 2    -> doubleGlobal $ \"D2\" ++ suf\n        DoubleReg 3    -> doubleGlobal $ \"D3\" ++ suf\n        DoubleReg 4    -> doubleGlobal $ \"D4\" ++ suf\n        DoubleReg 5    -> doubleGlobal $ \"D5\" ++ suf\n        DoubleReg 6    -> doubleGlobal $ \"D6\" ++ suf\n        XmmReg 1       -> xmmGlobal $ \"XMM1\" ++ suf\n        XmmReg 2       -> xmmGlobal $ \"XMM2\" ++ suf\n        XmmReg 3       -> xmmGlobal $ \"XMM3\" ++ suf\n        XmmReg 4       -> xmmGlobal $ \"XMM4\" ++ suf\n        XmmReg 5       -> xmmGlobal $ \"XMM5\" ++ suf\n        XmmReg 6       -> xmmGlobal $ \"XMM6\" ++ suf\n        YmmReg 1       -> ymmGlobal $ \"YMM1\" ++ suf\n        YmmReg 2       -> ymmGlobal $ \"YMM2\" ++ suf\n        YmmReg 3       -> ymmGlobal $ \"YMM3\" ++ suf\n        YmmReg 4       -> ymmGlobal $ \"YMM4\" ++ suf\n        YmmReg 5       -> ymmGlobal $ \"YMM5\" ++ suf\n        YmmReg 6       -> ymmGlobal $ \"YMM6\" ++ suf\n        ZmmReg 1       -> zmmGlobal $ \"ZMM1\" ++ suf\n        ZmmReg 2       -> zmmGlobal $ \"ZMM2\" ++ suf\n        ZmmReg 3       -> zmmGlobal $ \"ZMM3\" ++ suf\n        ZmmReg 4       -> zmmGlobal $ \"ZMM4\" ++ suf\n        ZmmReg 5       -> zmmGlobal $ \"ZMM5\" ++ suf\n        ZmmReg 6       -> zmmGlobal $ \"ZMM6\" ++ suf\n        MachSp         -> wordGlobal $ \"MachSp\" ++ suf\n        _other         -> panic $ \"LlvmCodeGen.Reg: GlobalReg (\" ++ (show reg)\n                                ++ \") not supported!\"\n        -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc\n        -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg\n    where\n        wordGlobal   name = LMNLocalVar (fsLit name) (llvmWord dflags)\n        ptrGlobal    name = LMNLocalVar (fsLit name) (llvmWordPtr dflags)\n        floatGlobal  name = LMNLocalVar (fsLit name) LMFloat\n        doubleGlobal name = LMNLocalVar (fsLit name) LMDouble\n        xmmGlobal    name = LMNLocalVar (fsLit name) (LMVector 4 (LMInt 32))\n        ymmGlobal    name = LMNLocalVar (fsLit name) (LMVector 8 (LMInt 32))\n        zmmGlobal    name = LMNLocalVar (fsLit name) (LMVector 16 (LMInt 32))\n\n-- | A list of STG Registers that should always be considered alive\nalwaysLive :: [GlobalReg]\nalwaysLive = [BaseReg, Sp, Hp, SpLim, HpLim, node]\n\n-- | STG Type Based Alias Analysis hierarchy\nstgTBAA :: [(Unique, LMString, Maybe Unique)]\nstgTBAA\n  = [ (rootN,  fsLit \"root\",   Nothing)\n    , (topN,   fsLit \"top\",   Just rootN)\n    , (stackN, fsLit \"stack\", Just topN)\n    , (heapN,  fsLit \"heap\",  Just topN)\n    , (rxN,    fsLit \"rx\",    Just heapN)\n    , (baseN,  fsLit \"base\",  Just topN)\n    -- FIX: Not 100% sure if this hierarchy is complete.  I think the big thing\n    -- is Sp is never aliased, so might want to change the hierarchy to have Sp\n    -- on its own branch that is never aliased (e.g never use top as a TBAA\n    -- node).\n    ]\n\n-- | Id values\n-- The `rootN` node is the root (there can be more than one) of the TBAA\n-- hierarchy and as of LLVM 4.0 should *only* be referenced by other nodes. It\n-- should never occur in any LLVM instruction statement.\nrootN, topN, stackN, heapN, rxN, baseN :: Unique\nrootN  = getUnique (fsLit \"LlvmCodeGen.Regs.rootN\")\ntopN   = getUnique (fsLit \"LlvmCodeGen.Regs.topN\")\nstackN = getUnique (fsLit \"LlvmCodeGen.Regs.stackN\")\nheapN  = getUnique (fsLit \"LlvmCodeGen.Regs.heapN\")\nrxN    = getUnique (fsLit \"LlvmCodeGen.Regs.rxN\")\nbaseN  = getUnique (fsLit \"LlvmCodeGen.Regs.baseN\")\n\n-- | The TBAA metadata identifier\ntbaa :: LMString\ntbaa = fsLit \"tbaa\"\n\n-- | Get the correct TBAA metadata information for this register type\ngetTBAA :: GlobalReg -> Unique\ngetTBAA BaseReg          = baseN\ngetTBAA Sp               = stackN\ngetTBAA Hp               = heapN\ngetTBAA (VanillaReg _ _) = rxN\ngetTBAA _                = topN\n", "num_lines": 137}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- |\n-- Support for source code annotation feature of GHC. That is the ANN pragma.\n--\n-- (c) The University of Glasgow 2006\n-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n--\nmodule Annotations (\n        -- * Main Annotation data types\n        Annotation(..), AnnPayload,\n        AnnTarget(..), CoreAnnTarget,\n        getAnnTargetName_maybe,\n\n        -- * AnnEnv for collecting and querying Annotations\n        AnnEnv,\n        mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv,\n        findAnns, findAnnsByTypeRep,\n        deserializeAnns\n    ) where\n\nimport GhcPrelude\n\nimport Binary\nimport Module           ( Module )\nimport Name\nimport Outputable\nimport GHC.Serialized\nimport UniqFM\nimport Unique\n\nimport Control.Monad\nimport Data.Maybe\nimport Data.Typeable\nimport Data.Word        ( Word8 )\n\n\n-- | Represents an annotation after it has been sufficiently desugared from\n-- it's initial form of 'HsDecls.AnnDecl'\ndata Annotation = Annotation {\n        ann_target :: CoreAnnTarget,    -- ^ The target of the annotation\n        ann_value  :: AnnPayload\n    }\n\ntype AnnPayload = Serialized    -- ^ The \"payload\" of an annotation\n                                --   allows recovery of its value at a given type,\n                                --   and can be persisted to an interface file\n\n-- | An annotation target\ndata AnnTarget name\n  = NamedTarget name          -- ^ We are annotating something with a name:\n                              --      a type or identifier\n  | ModuleTarget Module       -- ^ We are annotating a particular module\n\n-- | The kind of annotation target found in the middle end of the compiler\ntype CoreAnnTarget = AnnTarget Name\n\ninstance Functor AnnTarget where\n    fmap f (NamedTarget nm) = NamedTarget (f nm)\n    fmap _ (ModuleTarget mod) = ModuleTarget mod\n\n-- | Get the 'name' of an annotation target if it exists.\ngetAnnTargetName_maybe :: AnnTarget name -> Maybe name\ngetAnnTargetName_maybe (NamedTarget nm) = Just nm\ngetAnnTargetName_maybe _                = Nothing\n\ninstance Uniquable name => Uniquable (AnnTarget name) where\n    getUnique (NamedTarget nm) = getUnique nm\n    getUnique (ModuleTarget mod) = deriveUnique (getUnique mod) 0\n    -- deriveUnique prevents OccName uniques clashing with NamedTarget\n\ninstance Outputable name => Outputable (AnnTarget name) where\n    ppr (NamedTarget nm) = text \"Named target\" <+> ppr nm\n    ppr (ModuleTarget mod) = text \"Module target\" <+> ppr mod\n\ninstance Binary name => Binary (AnnTarget name) where\n    put_ bh (NamedTarget a) = do\n        putByte bh 0\n        put_ bh a\n    put_ bh (ModuleTarget a) = do\n        putByte bh 1\n        put_ bh a\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> liftM NamedTarget  $ get bh\n            _ -> liftM ModuleTarget $ get bh\n\ninstance Outputable Annotation where\n    ppr ann = ppr (ann_target ann)\n\n-- | A collection of annotations\n-- Can't use a type synonym or we hit bug #2412 due to source import\nnewtype AnnEnv = MkAnnEnv (UniqFM [AnnPayload])\n\n-- | An empty annotation environment.\nemptyAnnEnv :: AnnEnv\nemptyAnnEnv = MkAnnEnv emptyUFM\n\n-- | Construct a new annotation environment that contains the list of\n-- annotations provided.\nmkAnnEnv :: [Annotation] -> AnnEnv\nmkAnnEnv = extendAnnEnvList emptyAnnEnv\n\n-- | Add the given annotation to the environment.\nextendAnnEnvList :: AnnEnv -> [Annotation] -> AnnEnv\nextendAnnEnvList (MkAnnEnv env) anns\n  = MkAnnEnv $ addListToUFM_C (++) env $\n    map (\\ann -> (getUnique (ann_target ann), [ann_value ann])) anns\n\n-- | Union two annotation environments.\nplusAnnEnv :: AnnEnv -> AnnEnv -> AnnEnv\nplusAnnEnv (MkAnnEnv env1) (MkAnnEnv env2) = MkAnnEnv $ plusUFM_C (++) env1 env2\n\n-- | Find the annotations attached to the given target as 'Typeable'\n--   values of your choice. If no deserializer is specified,\n--   only transient annotations will be returned.\nfindAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a]\nfindAnns deserialize (MkAnnEnv ann_env)\n  = (mapMaybe (fromSerialized deserialize))\n    . (lookupWithDefaultUFM ann_env [])\n\n-- | Find the annotations attached to the given target as 'Typeable'\n--   values of your choice. If no deserializer is specified,\n--   only transient annotations will be returned.\nfindAnnsByTypeRep :: AnnEnv -> CoreAnnTarget -> TypeRep -> [[Word8]]\nfindAnnsByTypeRep (MkAnnEnv ann_env) target tyrep\n  = [ ws | Serialized tyrep' ws <- lookupWithDefaultUFM ann_env [] target\n    , tyrep' == tyrep ]\n\n-- | Deserialize all annotations of a given type. This happens lazily, that is\n--   no deserialization will take place until the [a] is actually demanded and\n--   the [a] can also be empty (the UniqFM is not filtered).\ndeserializeAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> UniqFM [a]\ndeserializeAnns deserialize (MkAnnEnv ann_env)\n  = mapUFM (mapMaybe (fromSerialized deserialize)) ann_env\n", "num_lines": 135}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, CPP #-}\n{- Note: [The need for Ar.hs]\nBuilding `-staticlib` required the presence of libtool, and was a such\nrestricted to mach-o only. As libtool on macOS and gnu libtool are very\ndifferent, there was no simple portable way to support this.\n\nlibtool for static archives does essentially: concatinate the input archives,\nadd the input objects, and create a symbol index. Using `ar` for this task\nfails as even `ar` (bsd and gnu, llvm, ...) do not provide the same\nfeatures across platforms (e.g. index prefixed retrieval of objects with\nthe same name.)\n\nAs Archives are rather simple structurally, we can just build the archives\nwith Haskell directly and use ranlib on the final result to get the symbol\nindex. This should allow us to work around with the differences/abailability\nof libtool across differet platforms.\n-}\nmodule Ar\n  (ArchiveEntry(..)\n  ,Archive(..)\n  ,afilter\n\n  ,parseAr\n\n  ,loadAr\n  ,loadObj\n  ,writeBSDAr\n  ,writeGNUAr\n\n  ,isBSDSymdef\n  ,isGNUSymdef\n  )\n   where\n\nimport GhcPrelude\n\nimport Data.List (mapAccumL, isPrefixOf)\nimport Data.Monoid ((<>))\nimport Data.Binary.Get\nimport Data.Binary.Put\nimport Control.Monad\nimport Control.Applicative\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.Char8 as C\nimport qualified Data.ByteString.Lazy as L\n#if !defined(mingw32_HOST_OS)\nimport qualified System.Posix.Files as POSIX\n#endif\nimport System.FilePath (takeFileName)\n\ndata ArchiveEntry = ArchiveEntry\n    { filename :: String       -- ^ File name.\n    , filetime :: Int          -- ^ File modification time.\n    , fileown  :: Int          -- ^ File owner.\n    , filegrp  :: Int          -- ^ File group.\n    , filemode :: Int          -- ^ File mode.\n    , filesize :: Int          -- ^ File size.\n    , filedata :: B.ByteString -- ^ File bytes.\n    } deriving (Eq, Show)\n\nnewtype Archive = Archive [ArchiveEntry]\n        deriving (Eq, Show, Semigroup, Monoid)\n\nafilter :: (ArchiveEntry -> Bool) -> Archive -> Archive\nafilter f (Archive xs) = Archive (filter f xs)\n\nisBSDSymdef, isGNUSymdef :: ArchiveEntry -> Bool\nisBSDSymdef a = \"__.SYMDEF\" `isPrefixOf` (filename a)\nisGNUSymdef a = \"/\" == (filename a)\n\n-- | Archives have numeric values padded with '\\x20' to the right.\ngetPaddedInt :: B.ByteString -> Int\ngetPaddedInt = read . C.unpack . C.takeWhile (/= '\\x20')\n\nputPaddedInt :: Int -> Int -> Put\nputPaddedInt padding i = putPaddedString '\\x20' padding (show i)\n\nputPaddedString :: Char -> Int -> String -> Put\nputPaddedString pad padding s = putByteString . C.pack . take padding $ s `mappend` (repeat pad)\n\ngetBSDArchEntries :: Get [ArchiveEntry]\ngetBSDArchEntries = do\n    empty <- isEmpty\n    if empty then\n        return []\n     else do\n        name    <- getByteString 16\n        when ('/' `C.elem` name && C.take 3 name /= \"#1/\") $\n          fail \"Looks like GNU Archive\"\n        time    <- getPaddedInt <$> getByteString 12\n        own     <- getPaddedInt <$> getByteString 6\n        grp     <- getPaddedInt <$> getByteString 6\n        mode    <- getPaddedInt <$> getByteString 8\n        st_size <- getPaddedInt <$> getByteString 10\n        end     <- getByteString 2\n        when (end /= \"\\x60\\x0a\") $\n          fail (\"[BSD Archive] Invalid archive header end marker for name: \" ++\n                C.unpack name)\n        off1    <- liftM fromIntegral bytesRead :: Get Int\n        -- BSD stores extended filenames, by writing #1/<length> into the\n        -- name field, the first @length@ bytes then represent the file name\n        -- thus the payload size is filesize + file name length.\n        name    <- if C.unpack (C.take 3 name) == \"#1/\" then\n                        liftM (C.unpack . C.takeWhile (/= '\\0')) (getByteString $ read $ C.unpack $ C.drop 3 name)\n                    else\n                        return $ C.unpack $ C.takeWhile (/= ' ') name\n        off2    <- liftM fromIntegral bytesRead :: Get Int\n        file    <- getByteString (st_size - (off2 - off1))\n        -- data sections are two byte aligned (see Trac #15396)\n        when (odd st_size) $\n          void (getByteString 1)\n\n        rest    <- getBSDArchEntries\n        return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest\n\n-- | GNU Archives feature a special '//' entry that contains the\n-- extended names. Those are referred to as /<num>, where num is the\n-- offset into the '//' entry.\n-- In addition, filenames are terminated with '/' in the archive.\ngetGNUArchEntries :: Maybe ArchiveEntry -> Get [ArchiveEntry]\ngetGNUArchEntries extInfo = do\n  empty <- isEmpty\n  if empty\n    then return []\n    else\n    do\n      name    <- getByteString 16\n      time    <- getPaddedInt <$> getByteString 12\n      own     <- getPaddedInt <$> getByteString 6\n      grp     <- getPaddedInt <$> getByteString 6\n      mode    <- getPaddedInt <$> getByteString 8\n      st_size <- getPaddedInt <$> getByteString 10\n      end     <- getByteString 2\n      when (end /= \"\\x60\\x0a\") $\n        fail (\"[BSD Archive] Invalid archive header end marker for name: \" ++\n              C.unpack name)\n      file <- getByteString st_size\n      -- data sections are two byte aligned (see Trac #15396)\n      when (odd st_size) $\n        void (getByteString 1)\n      name <- return . C.unpack $\n        if C.unpack (C.take 1 name) == \"/\"\n        then case C.takeWhile (/= ' ') name of\n               name@\"/\"  -> name               -- symbol table\n               name@\"//\" -> name               -- extendedn file names table\n               name      -> getExtName extInfo (read . C.unpack $ C.drop 1 name)\n        else C.takeWhile (/= '/') name\n      case name of\n        \"/\"  -> getGNUArchEntries extInfo\n        \"//\" -> getGNUArchEntries (Just (ArchiveEntry name time own grp mode st_size file))\n        _    -> (ArchiveEntry name time own grp mode st_size file :) <$> getGNUArchEntries extInfo\n\n  where\n   getExtName :: Maybe ArchiveEntry -> Int -> B.ByteString\n   getExtName Nothing _ = error \"Invalid extended filename reference.\"\n   getExtName (Just info) offset = C.takeWhile (/= '/') . C.drop offset $ filedata info\n\n-- | put an Archive Entry. This assumes that the entries\n-- have been preprocessed to account for the extenden file name\n-- table section \"//\" e.g. for GNU Archives. Or that the names\n-- have been move into the payload for BSD Archives.\nputArchEntry :: ArchiveEntry -> PutM ()\nputArchEntry (ArchiveEntry name time own grp mode st_size file) = do\n  putPaddedString ' '  16 name\n  putPaddedInt         12 time\n  putPaddedInt          6 own\n  putPaddedInt          6 grp\n  putPaddedInt          8 mode\n  putPaddedInt         10 (st_size + pad)\n  putByteString           \"\\x60\\x0a\"\n  putByteString           file\n  when (pad == 1) $\n    putWord8              0x0a\n  where\n    pad         = st_size `mod` 2\n\ngetArchMagic :: Get ()\ngetArchMagic = do\n  magic <- liftM C.unpack $ getByteString 8\n  if magic /= \"!<arch>\\n\"\n    then fail $ \"Invalid magic number \" ++ show magic\n    else return ()\n\nputArchMagic :: Put\nputArchMagic = putByteString $ C.pack \"!<arch>\\n\"\n\ngetArch :: Get Archive\ngetArch = Archive <$> do\n  getArchMagic\n  getBSDArchEntries <|> getGNUArchEntries Nothing\n\nputBSDArch :: Archive -> PutM ()\nputBSDArch (Archive as) = do\n  putArchMagic\n  mapM_ putArchEntry (processEntries as)\n\n  where\n    padStr pad size str = take size $ str <> repeat pad\n    nameSize name = case length name `divMod` 4 of\n      (n, 0) -> 4 * n\n      (n, _) -> 4 * (n + 1)\n    needExt name = length name > 16 || ' ' `elem` name\n    processEntry :: ArchiveEntry -> ArchiveEntry\n    processEntry archive@(ArchiveEntry name _ _ _ _ st_size _)\n      | needExt name = archive { filename = \"#1/\" <> show sz\n                               , filedata = C.pack (padStr '\\0' sz name) <> filedata archive\n                               , filesize = st_size + sz }\n      | otherwise    = archive\n\n      where sz = nameSize name\n\n    processEntries = map processEntry\n\nputGNUArch :: Archive -> PutM ()\nputGNUArch (Archive as) = do\n  putArchMagic\n  mapM_ putArchEntry (processEntries as)\n\n  where\n    processEntry :: ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)\n    processEntry extInfo archive@(ArchiveEntry name _ _ _ _ _ _)\n      | length name > 15 = ( extInfo { filesize = filesize extInfo + length name + 2\n                                    ,  filedata = filedata extInfo <>  C.pack name <> \"/\\n\" }\n                           , archive { filename = \"/\" <> show (filesize extInfo) } )\n      | otherwise        = ( extInfo, archive { filename = name <> \"/\" } )\n\n    processEntries :: [ArchiveEntry] -> [ArchiveEntry]\n    processEntries =\n      uncurry (:) . mapAccumL processEntry (ArchiveEntry \"//\" 0 0 0 0 0 mempty)\n\nparseAr :: B.ByteString -> Archive\nparseAr = runGet getArch . L.fromChunks . pure\n\nwriteBSDAr, writeGNUAr :: FilePath -> Archive -> IO ()\nwriteBSDAr fp = L.writeFile fp . runPut . putBSDArch\nwriteGNUAr fp = L.writeFile fp . runPut . putGNUArch\n\nloadAr :: FilePath -> IO Archive\nloadAr fp = parseAr <$> B.readFile fp\n\nloadObj :: FilePath -> IO ArchiveEntry\nloadObj fp = do\n  payload <- B.readFile fp\n  (modt, own, grp, mode) <- fileInfo fp\n  return $ ArchiveEntry\n    (takeFileName fp) modt own grp mode\n    (B.length payload) payload\n\n-- | Take a filePath and return (mod time, own, grp, mode in decimal)\nfileInfo :: FilePath -> IO ( Int, Int, Int, Int) -- ^ mod time, own, grp, mode (in decimal)\n#if defined(mingw32_HOST_OS)\n-- on windows mod time, owner group and mode are zero.\nfileInfo _ = pure (0,0,0,0)\n#else\nfileInfo fp = go <$> POSIX.getFileStatus fp\n  where go status = ( fromEnum $ POSIX.modificationTime status\n                    , fromIntegral $ POSIX.fileOwner status\n                    , fromIntegral $ POSIX.fileGroup status\n                    , oct2dec . fromIntegral $ POSIX.fileMode status\n                    )\n\noct2dec :: Int -> Int\noct2dec = foldl' (\\a b -> a * 10 + b) 0 . reverse . dec 8\n  where dec _ 0 = []\n        dec b i = let (rest, last) = i `quotRem` b\n                  in last:dec b rest\n\n#endif\n", "num_lines": 269}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-------------------------------------------------------------------------------\n--\n-- | Command-line parser\n--\n-- This is an abstract command-line parser used by DynFlags.\n--\n-- (c) The University of Glasgow 2005\n--\n-------------------------------------------------------------------------------\n\nmodule CmdLineParser\n    (\n      processArgs, OptKind(..), GhcFlagMode(..),\n      CmdLineP(..), getCmdLineState, putCmdLineState,\n      Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,\n      errorsToGhcException,\n\n      Err(..), Warn(..), WarnReason(..),\n\n      EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM,\n      deprecate\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Util\nimport Outputable\nimport Panic\nimport Bag\nimport SrcLoc\nimport Json\n\nimport Data.Function\nimport Data.List\n\nimport Control.Monad (liftM, ap)\n\n--------------------------------------------------------\n--         The Flag and OptKind types\n--------------------------------------------------------\n\ndata Flag m = Flag\n    {   flagName    :: String,     -- Flag, without the leading \"-\"\n        flagOptKind :: OptKind m,  -- What to do if we see it\n        flagGhcMode :: GhcFlagMode    -- Which modes this flag affects\n    }\n\ndefFlag :: String -> OptKind m -> Flag m\ndefFlag name optKind = Flag name optKind AllModes\n\ndefGhcFlag :: String -> OptKind m -> Flag m\ndefGhcFlag name optKind = Flag name optKind OnlyGhc\n\ndefGhciFlag :: String -> OptKind m -> Flag m\ndefGhciFlag name optKind = Flag name optKind OnlyGhci\n\ndefHiddenFlag :: String -> OptKind m -> Flag m\ndefHiddenFlag name optKind = Flag name optKind HiddenFlag\n\n-- | GHC flag modes describing when a flag has an effect.\ndata GhcFlagMode\n    = OnlyGhc  -- ^ The flag only affects the non-interactive GHC\n    | OnlyGhci -- ^ The flag only affects the interactive GHC\n    | AllModes -- ^ The flag affects multiple ghc modes\n    | HiddenFlag -- ^ This flag should not be seen in cli completion\n\ndata OptKind m                             -- Suppose the flag is -f\n    = NoArg     (EwM m ())                 -- -f all by itself\n    | HasArg    (String -> EwM m ())       -- -farg or -f arg\n    | SepArg    (String -> EwM m ())       -- -f arg\n    | Prefix    (String -> EwM m ())       -- -farg\n    | OptPrefix (String -> EwM m ())       -- -f or -farg (i.e. the arg is optional)\n    | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn\n    | IntSuffix (Int -> EwM m ())          -- -f or -f=n; pass n to fn\n    | FloatSuffix (Float -> EwM m ())      -- -f or -f=n; pass n to fn\n    | PassFlag  (String -> EwM m ())       -- -f; pass \"-f\" fn\n    | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire \"-farg\" to fn\n\n\n--------------------------------------------------------\n--         The EwM monad\n--------------------------------------------------------\n\n-- | Used when filtering warnings: if a reason is given\n-- it can be filtered out when displaying.\ndata WarnReason\n  = NoReason\n  | ReasonDeprecatedFlag\n  | ReasonUnrecognisedFlag\n  deriving (Eq, Show)\n\ninstance Outputable WarnReason where\n  ppr = text . show\n\ninstance ToJson WarnReason where\n  json NoReason = JSNull\n  json reason   = JSString $ show reason\n\n-- | A command-line error message\nnewtype Err  = Err { errMsg :: Located String }\n\n-- | A command-line warning message and the reason it arose\ndata Warn = Warn\n  {   warnReason :: WarnReason,\n      warnMsg    :: Located String\n  }\n\ntype Errs  = Bag Err\ntype Warns = Bag Warn\n\n-- EwM (\"errors and warnings monad\") is a monad\n-- transformer for m that adds an (err, warn) state\nnewtype EwM m a = EwM { unEwM :: Located String -- Current parse arg\n                              -> Errs -> Warns\n                              -> m (Errs, Warns, a) }\n\ninstance Monad m => Functor (EwM m) where\n    fmap = liftM\n\ninstance Monad m => Applicative (EwM m) where\n    pure v = EwM (\\_ e w -> return (e, w, v))\n    (<*>) = ap\n\ninstance Monad m => Monad (EwM m) where\n    (EwM f) >>= k = EwM (\\l e w -> do (e', w', r) <- f l e w\n                                      unEwM (k r) l e' w')\n\nrunEwM :: EwM m a -> m (Errs, Warns, a)\nrunEwM action = unEwM action (panic \"processArgs: no arg yet\") emptyBag emptyBag\n\nsetArg :: Located String -> EwM m () -> EwM m ()\nsetArg l (EwM f) = EwM (\\_ es ws -> f l es ws)\n\naddErr :: Monad m => String -> EwM m ()\naddErr e = EwM (\\(L loc _) es ws -> return (es `snocBag` Err (L loc e), ws, ()))\n\naddWarn :: Monad m => String -> EwM m ()\naddWarn = addFlagWarn NoReason\n\naddFlagWarn :: Monad m => WarnReason -> String -> EwM m ()\naddFlagWarn reason msg = EwM $\n  (\\(L loc _) es ws -> return (es, ws `snocBag` Warn reason (L loc msg), ()))\n\ndeprecate :: Monad m => String -> EwM m ()\ndeprecate s = do\n    arg <- getArg\n    addFlagWarn ReasonDeprecatedFlag (arg ++ \" is deprecated: \" ++ s)\n\ngetArg :: Monad m => EwM m String\ngetArg = EwM (\\(L _ arg) es ws -> return (es, ws, arg))\n\ngetCurLoc :: Monad m => EwM m SrcSpan\ngetCurLoc = EwM (\\(L loc _) es ws -> return (es, ws, loc))\n\nliftEwM :: Monad m => m a -> EwM m a\nliftEwM action = EwM (\\_ es ws -> do { r <- action; return (es, ws, r) })\n\n\n--------------------------------------------------------\n-- A state monad for use in the command-line parser\n--------------------------------------------------------\n\n-- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)\nnewtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }\n\ninstance Functor (CmdLineP s) where\n    fmap = liftM\n\ninstance Applicative (CmdLineP s) where\n    pure a = CmdLineP $ \\s -> (a, s)\n    (<*>) = ap\n\ninstance Monad (CmdLineP s) where\n    m >>= k = CmdLineP $ \\s ->\n                  let (a, s') = runCmdLine m s\n                  in runCmdLine (k a) s'\n\n\ngetCmdLineState :: CmdLineP s s\ngetCmdLineState   = CmdLineP $ \\s -> (s,s)\nputCmdLineState :: s -> CmdLineP s ()\nputCmdLineState s = CmdLineP $ \\_ -> ((),s)\n\n\n--------------------------------------------------------\n--         Processing arguments\n--------------------------------------------------------\n\nprocessArgs :: Monad m\n            => [Flag m]               -- cmdline parser spec\n            -> [Located String]       -- args\n            -> m ( [Located String],  -- spare args\n                   [Err],  -- errors\n                   [Warn] ) -- warnings\nprocessArgs spec args = do\n    (errs, warns, spare) <- runEwM action\n    return (spare, bagToList errs, bagToList warns)\n  where\n    action = process args []\n\n    -- process :: [Located String] -> [Located String] -> EwM m [Located String]\n    process [] spare = return (reverse spare)\n\n    process (locArg@(L _ ('-' : arg)) : args) spare =\n        case findArg spec arg of\n            Just (rest, opt_kind) ->\n                case processOneArg opt_kind rest arg args of\n                    Left err ->\n                        let b = process args spare\n                        in (setArg locArg $ addErr err) >> b\n\n                    Right (action,rest) ->\n                        let b = process rest spare\n                        in (setArg locArg $ action) >> b\n\n            Nothing -> process args (locArg : spare)\n\n    process (arg : args) spare = process args (arg : spare)\n\n\nprocessOneArg :: OptKind m -> String -> String -> [Located String]\n              -> Either String (EwM m (), [Located String])\nprocessOneArg opt_kind rest arg args\n  = let dash_arg = '-' : arg\n        rest_no_eq = dropEq rest\n    in case opt_kind of\n        NoArg  a -> ASSERT(null rest) Right (a, args)\n\n        HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)\n                 | otherwise -> case args of\n                                    []               -> missingArgErr dash_arg\n                                    (L _ arg1:args1) -> Right (f arg1, args1)\n\n        -- See Trac #9776\n        SepArg f -> case args of\n                        []               -> missingArgErr dash_arg\n                        (L _ arg1:args1) -> Right (f arg1, args1)\n\n        -- See Trac #12625\n        Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args)\n                 | otherwise          -> missingArgErr  dash_arg\n\n        PassFlag f  | notNull rest -> unknownFlagErr dash_arg\n                    | otherwise    -> Right (f dash_arg, args)\n\n        OptIntSuffix f | null rest                     -> Right (f Nothing,  args)\n                       | Just n <- parseInt rest_no_eq -> Right (f (Just n), args)\n                       | otherwise -> Left (\"malformed integer argument in \" ++ dash_arg)\n\n        IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args)\n                    | otherwise -> Left (\"malformed integer argument in \" ++ dash_arg)\n\n        FloatSuffix f | Just n <- parseFloat rest_no_eq -> Right (f n, args)\n                      | otherwise -> Left (\"malformed float argument in \" ++ dash_arg)\n\n        OptPrefix f       -> Right (f rest_no_eq, args)\n        AnySuffix f       -> Right (f dash_arg, args)\n\nfindArg :: [Flag m] -> String -> Maybe (String, OptKind m)\nfindArg spec arg =\n    case sortBy (compare `on` (length . fst)) -- prefer longest matching flag\n           [ (removeSpaces rest, optKind)\n           | flag <- spec,\n             let optKind  = flagOptKind flag,\n             Just rest <- [stripPrefix (flagName flag) arg],\n             arg_ok optKind rest arg ]\n    of\n        []      -> Nothing\n        (one:_) -> Just one\n\narg_ok :: OptKind t -> [Char] -> String -> Bool\narg_ok (NoArg           _)  rest _   = null rest\narg_ok (HasArg          _)  _    _   = True\narg_ok (SepArg          _)  rest _   = null rest\narg_ok (Prefix          _)  _    _   = True -- Missing argument checked for in processOneArg t\n                                            -- to improve error message (Trac #12625)\narg_ok (OptIntSuffix    _)  _    _   = True\narg_ok (IntSuffix       _)  _    _   = True\narg_ok (FloatSuffix     _)  _    _   = True\narg_ok (OptPrefix       _)  _    _   = True\narg_ok (PassFlag        _)  rest _   = null rest\narg_ok (AnySuffix       _)  _    _   = True\n\n-- | Parse an Int\n--\n-- Looks for \"433\" or \"=342\", with no trailing gubbins\n--   * n or =n      => Just n\n--   * gibberish    => Nothing\nparseInt :: String -> Maybe Int\nparseInt s = case reads s of\n                 ((n,\"\"):_) -> Just n\n                 _          -> Nothing\n\nparseFloat :: String -> Maybe Float\nparseFloat s = case reads s of\n                   ((n,\"\"):_) -> Just n\n                   _          -> Nothing\n\n-- | Discards a leading equals sign\ndropEq :: String -> String\ndropEq ('=' : s) = s\ndropEq s         = s\n\nunknownFlagErr :: String -> Either String a\nunknownFlagErr f = Left (\"unrecognised flag: \" ++ f)\n\nmissingArgErr :: String -> Either String a\nmissingArgErr f = Left (\"missing argument for flag: \" ++ f)\n\n--------------------------------------------------------\n-- Utils\n--------------------------------------------------------\n\n\n-- See Note [Handling errors when parsing flags]\nerrorsToGhcException :: [(String,    -- Location\n                          String)]   -- Error\n                     -> GhcException\nerrorsToGhcException errs =\n    UsageError $ intercalate \"\\n\" $ [ l ++ \": \" ++ e | (l, e) <- errs ]\n\n{- Note [Handling errors when parsing commandline flags]\n\nParsing of static and mode flags happens before any session is started, i.e.,\nbefore the first call to 'GHC.withGhc'. Therefore, to report errors for\ninvalid usage of these two types of flags, we can not call any function that\nneeds DynFlags, as there are no DynFlags available yet (unsafeGlobalDynFlags\nis not set either). So we always print \"on the commandline\" as the location,\nwhich is true except for Api users, which is probably ok.\n\nWhen reporting errors for invalid usage of dynamic flags we /can/ make use of\nDynFlags, and we do so explicitly in DynFlags.parseDynamicFlagsFull.\n\nBefore, we called unsafeGlobalDynFlags when an invalid (combination of)\nflag(s) was given on the commandline, resulting in panics (#9963).\n-}\n", "num_lines": 341}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\\section{Code output phase}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule CodeOutput( codeOutput, outputForeignStubs ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport AsmCodeGen ( nativeCodeGen )\nimport LlvmCodeGen ( llvmCodeGen )\n\nimport UniqSupply       ( mkSplitUniqSupply )\n\nimport Finder           ( mkStubPaths )\nimport PprC             ( writeCs )\nimport CmmLint          ( cmmLint )\nimport Packages\nimport Cmm              ( RawCmmGroup )\nimport HscTypes\nimport DynFlags\nimport Config\nimport Stream           (Stream)\nimport qualified Stream\nimport FileCleanup\n\nimport ErrUtils\nimport Outputable\nimport Module\nimport SrcLoc\n\nimport Control.Exception\nimport System.Directory\nimport System.FilePath\nimport System.IO\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Steering}\n*                                                                      *\n************************************************************************\n-}\n\ncodeOutput :: DynFlags\n           -> Module\n           -> FilePath\n           -> ModLocation\n           -> ForeignStubs\n           -> [(ForeignSrcLang, FilePath)]\n           -- ^ additional files to be compiled with with the C compiler\n           -> [InstalledUnitId]\n           -> Stream IO RawCmmGroup ()                       -- Compiled C--\n           -> IO (FilePath,\n                  (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),\n                  [(ForeignSrcLang, FilePath)]{-foreign_fps-})\n\ncodeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps\n  cmm_stream\n  =\n    do  {\n        -- Lint each CmmGroup as it goes past\n        ; let linted_cmm_stream =\n                 if gopt Opt_DoCmmLinting dflags\n                    then Stream.mapM do_lint cmm_stream\n                    else cmm_stream\n\n              do_lint cmm = withTiming (pure dflags)\n                                       (text \"CmmLint\"<+>brackets (ppr this_mod))\n                                       (const ()) $ do\n                { case cmmLint dflags cmm of\n                        Just err -> do { log_action dflags\n                                                   dflags\n                                                   NoReason\n                                                   SevDump\n                                                   noSrcSpan\n                                                   (defaultDumpStyle dflags)\n                                                   err\n                                       ; ghcExit dflags 1\n                                       }\n                        Nothing  -> return ()\n                ; return cmm\n                }\n\n        ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs\n        ; case hscTarget dflags of {\n             HscAsm         -> outputAsm dflags this_mod location filenm\n                                         linted_cmm_stream;\n             HscC           -> outputC dflags filenm linted_cmm_stream pkg_deps;\n             HscLlvm        -> outputLlvm dflags filenm linted_cmm_stream;\n             HscInterpreted -> panic \"codeOutput: HscInterpreted\";\n             HscNothing     -> panic \"codeOutput: HscNothing\"\n          }\n        ; return (filenm, stubs_exist, foreign_fps)\n        }\n\ndoOutput :: String -> (Handle -> IO a) -> IO a\ndoOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{C}\n*                                                                      *\n************************************************************************\n-}\n\noutputC :: DynFlags\n        -> FilePath\n        -> Stream IO RawCmmGroup ()\n        -> [InstalledUnitId]\n        -> IO ()\n\noutputC dflags filenm cmm_stream packages\n  = do\n       -- ToDo: make the C backend consume the C-- incrementally, by\n       -- pushing the cmm_stream inside (c.f. nativeCodeGen)\n       rawcmms <- Stream.collect cmm_stream\n\n       -- figure out which header files to #include in the generated .hc file:\n       --\n       --   * extra_includes from packages\n       --   * -#include options from the cmdline and OPTIONS pragmas\n       --   * the _stub.h file, if there is one.\n       --\n       let rts = getPackageDetails dflags rtsUnitId\n\n       let cc_injects = unlines (map mk_include (includes rts))\n           mk_include h_file =\n            case h_file of\n               '\"':_{-\"-} -> \"#include \"++h_file\n               '<':_      -> \"#include \"++h_file\n               _          -> \"#include \\\"\"++h_file++\"\\\"\"\n\n       let pkg_names = map installedUnitIdString packages\n\n       doOutput filenm $ \\ h -> do\n          hPutStr h (\"/* GHC_PACKAGES \" ++ unwords pkg_names ++ \"\\n*/\\n\")\n          hPutStr h cc_injects\n          writeCs dflags h rawcmms\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Assembler}\n*                                                                      *\n************************************************************************\n-}\n\noutputAsm :: DynFlags -> Module -> ModLocation -> FilePath\n          -> Stream IO RawCmmGroup ()\n          -> IO ()\noutputAsm dflags this_mod location filenm cmm_stream\n | cGhcWithNativeCodeGen == \"YES\"\n  = do ncg_uniqs <- mkSplitUniqSupply 'n'\n\n       debugTraceMsg dflags 4 (text \"Outputing asm to\" <+> text filenm)\n\n       _ <- {-# SCC \"OutputAsm\" #-} doOutput filenm $\n           \\h -> {-# SCC \"NativeCodeGen\" #-}\n                 nativeCodeGen dflags this_mod location h ncg_uniqs cmm_stream\n       return ()\n\n | otherwise\n  = panic \"This compiler was built without a native code generator\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{LLVM}\n*                                                                      *\n************************************************************************\n-}\n\noutputLlvm :: DynFlags -> FilePath -> Stream IO RawCmmGroup () -> IO ()\noutputLlvm dflags filenm cmm_stream\n  = do ncg_uniqs <- mkSplitUniqSupply 'n'\n\n       {-# SCC \"llvm_output\" #-} doOutput filenm $\n           \\f -> {-# SCC \"llvm_CodeGen\" #-}\n                 llvmCodeGen dflags f ncg_uniqs cmm_stream\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Foreign import/export}\n*                                                                      *\n************************************************************************\n-}\n\noutputForeignStubs :: DynFlags -> Module -> ModLocation -> ForeignStubs\n                   -> IO (Bool,         -- Header file created\n                          Maybe FilePath) -- C file created\noutputForeignStubs dflags mod location stubs\n = do\n   let stub_h = mkStubPaths dflags (moduleName mod) location\n   stub_c <- newTempName dflags TFL_CurrentModule \"c\"\n\n   case stubs of\n     NoStubs ->\n        return (False, Nothing)\n\n     ForeignStubs h_code c_code -> do\n        let\n            stub_c_output_d = pprCode CStyle c_code\n            stub_c_output_w = showSDoc dflags stub_c_output_d\n\n            -- Header file protos for \"foreign export\"ed functions.\n            stub_h_output_d = pprCode CStyle h_code\n            stub_h_output_w = showSDoc dflags stub_h_output_d\n\n        createDirectoryIfMissing True (takeDirectory stub_h)\n\n        dumpIfSet_dyn dflags Opt_D_dump_foreign\n                      \"Foreign export header file\" stub_h_output_d\n\n        -- we need the #includes from the rts package for the stub files\n        let rts_includes =\n               let rts_pkg = getPackageDetails dflags rtsUnitId in\n               concatMap mk_include (includes rts_pkg)\n            mk_include i = \"#include \\\"\" ++ i ++ \"\\\"\\n\"\n\n            -- wrapper code mentions the ffi_arg type, which comes from ffi.h\n            ffi_includes | cLibFFI   = \"#include \\\"ffi.h\\\"\\n\"\n                         | otherwise = \"\"\n\n        stub_h_file_exists\n           <- outputForeignStubs_help stub_h stub_h_output_w\n                (\"#include \\\"HsFFI.h\\\"\\n\" ++ cplusplus_hdr) cplusplus_ftr\n\n        dumpIfSet_dyn dflags Opt_D_dump_foreign\n                      \"Foreign export stubs\" stub_c_output_d\n\n        stub_c_file_exists\n           <- outputForeignStubs_help stub_c stub_c_output_w\n                (\"#define IN_STG_CODE 0\\n\" ++\n                 \"#include \\\"Rts.h\\\"\\n\" ++\n                 rts_includes ++\n                 ffi_includes ++\n                 cplusplus_hdr)\n                 cplusplus_ftr\n           -- We're adding the default hc_header to the stub file, but this\n           -- isn't really HC code, so we need to define IN_STG_CODE==0 to\n           -- avoid the register variables etc. being enabled.\n\n        return (stub_h_file_exists, if stub_c_file_exists\n                                       then Just stub_c\n                                       else Nothing )\n where\n   cplusplus_hdr = \"#ifdef __cplusplus\\nextern \\\"C\\\" {\\n#endif\\n\"\n   cplusplus_ftr = \"#ifdef __cplusplus\\n}\\n#endif\\n\"\n\n\n-- Don't use doOutput for dumping the f. export stubs\n-- since it is more than likely that the stubs file will\n-- turn out to be empty, in which case no file should be created.\noutputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool\noutputForeignStubs_help _fname \"\"      _header _footer = return False\noutputForeignStubs_help fname doc_str header footer\n   = do writeFile fname (header ++ doc_str ++ '\\n':footer ++ \"\\n\")\n        return True\n\n", "num_lines": 268}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[Constants]{Info about this compilation}\n-}\n\nmodule Constants (module Constants) where\n\nimport GhcPrelude\n\nimport Config\n\nhiVersion :: Integer\nhiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer\n\n-- All pretty arbitrary:\n\nmAX_TUPLE_SIZE :: Int\nmAX_TUPLE_SIZE = 62 -- Should really match the number\n                    -- of decls in Data.Tuple\n\nmAX_CTUPLE_SIZE :: Int   -- Constraint tuples\nmAX_CTUPLE_SIZE = 62     -- Should match the number of decls in GHC.Classes\n\nmAX_SUM_SIZE :: Int\nmAX_SUM_SIZE = 62\n\n-- | Default maximum depth for both class instance search and type family\n-- reduction. See also Trac #5395.\nmAX_REDUCTION_DEPTH :: Int\nmAX_REDUCTION_DEPTH = 200\n\n-- | Default maximum constraint-solver iterations\n-- Typically there should be very few\nmAX_SOLVER_ITERATIONS :: Int\nmAX_SOLVER_ITERATIONS = 4\n\nwORD64_SIZE :: Int\nwORD64_SIZE = 8\n\n-- Size of float in bytes.\nfLOAT_SIZE :: Int\nfLOAT_SIZE = 4\n\ntARGET_MAX_CHAR :: Int\ntARGET_MAX_CHAR = 0x10ffff\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Makefile Dependency Generation\n--\n-- (c) The University of Glasgow 2005\n--\n-----------------------------------------------------------------------------\n\nmodule DriverMkDepend (\n        doMkDependHS\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport qualified GHC\nimport GhcMonad\nimport DynFlags\nimport Util\nimport HscTypes\nimport qualified SysTools\nimport Module\nimport Digraph          ( SCC(..) )\nimport Finder\nimport Outputable\nimport Panic\nimport SrcLoc\nimport Data.List\nimport FastString\nimport FileCleanup\n\nimport Exception\nimport ErrUtils\n\nimport System.Directory\nimport System.FilePath\nimport System.IO\nimport System.IO.Error  ( isEOFError )\nimport Control.Monad    ( when )\nimport Data.Maybe       ( isJust )\n\n-----------------------------------------------------------------\n--\n--              The main function\n--\n-----------------------------------------------------------------\n\ndoMkDependHS :: GhcMonad m => [FilePath] -> m ()\ndoMkDependHS srcs = do\n    -- Initialisation\n    dflags0 <- GHC.getSessionDynFlags\n\n    -- We kludge things a bit for dependency generation. Rather than\n    -- generating dependencies for each way separately, we generate\n    -- them once and then duplicate them for each way's osuf/hisuf.\n    -- We therefore do the initial dependency generation with an empty\n    -- way and .o/.hi extensions, regardless of any flags that might\n    -- be specified.\n    let dflags = dflags0 {\n                     ways = [],\n                     buildTag = mkBuildTag [],\n                     hiSuf = \"hi\",\n                     objectSuf = \"o\"\n                 }\n    _ <- GHC.setSessionDynFlags dflags\n\n    when (null (depSuffixes dflags)) $ liftIO $\n        throwGhcExceptionIO (ProgramError \"You must specify at least one -dep-suffix\")\n\n    files <- liftIO $ beginMkDependHS dflags\n\n    -- Do the downsweep to find all the modules\n    targets <- mapM (\\s -> GHC.guessTarget s Nothing) srcs\n    GHC.setTargets targets\n    let excl_mods = depExcludeMods dflags\n    module_graph <- GHC.depanal excl_mods True {- Allow dup roots -}\n\n    -- Sort into dependency order\n    -- There should be no cycles\n    let sorted = GHC.topSortModuleGraph False module_graph Nothing\n\n    -- Print out the dependencies if wanted\n    liftIO $ debugTraceMsg dflags 2 (text \"Module dependencies\" $$ ppr sorted)\n\n    -- Prcess them one by one, dumping results into makefile\n    -- and complaining about cycles\n    hsc_env <- getSession\n    root <- liftIO getCurrentDirectory\n    mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted\n\n    -- If -ddump-mod-cycles, show cycles in the module graph\n    liftIO $ dumpModCycles dflags module_graph\n\n    -- Tidy up\n    liftIO $ endMkDependHS dflags files\n\n    -- Unconditional exiting is a bad idea.  If an error occurs we'll get an\n    --exception; if that is not caught it's fine, but at least we have a\n    --chance to find out exactly what went wrong.  Uncomment the following\n    --line if you disagree.\n\n    --`GHC.ghcCatch` \\_ -> io $ exitWith (ExitFailure 1)\n\n-----------------------------------------------------------------\n--\n--              beginMkDependHs\n--      Create a temporary file,\n--      find the Makefile,\n--      slurp through it, etc\n--\n-----------------------------------------------------------------\n\ndata MkDepFiles\n  = MkDep { mkd_make_file :: FilePath,          -- Name of the makefile\n            mkd_make_hdl  :: Maybe Handle,      -- Handle for the open makefile\n            mkd_tmp_file  :: FilePath,          -- Name of the temporary file\n            mkd_tmp_hdl   :: Handle }           -- Handle of the open temporary file\n\nbeginMkDependHS :: DynFlags -> IO MkDepFiles\nbeginMkDependHS dflags = do\n        -- open a new temp file in which to stuff the dependency info\n        -- as we go along.\n  tmp_file <- newTempName dflags TFL_CurrentModule \"dep\"\n  tmp_hdl <- openFile tmp_file WriteMode\n\n        -- open the makefile\n  let makefile = depMakefile dflags\n  exists <- doesFileExist makefile\n  mb_make_hdl <-\n        if not exists\n        then return Nothing\n        else do\n           makefile_hdl <- openFile makefile ReadMode\n\n                -- slurp through until we get the magic start string,\n                -- copying the contents into dep_makefile\n           let slurp = do\n                l <- hGetLine makefile_hdl\n                if (l == depStartMarker)\n                        then return ()\n                        else do hPutStrLn tmp_hdl l; slurp\n\n                -- slurp through until we get the magic end marker,\n                -- throwing away the contents\n           let chuck = do\n                l <- hGetLine makefile_hdl\n                if (l == depEndMarker)\n                        then return ()\n                        else chuck\n\n           catchIO slurp\n                (\\e -> if isEOFError e then return () else ioError e)\n           catchIO chuck\n                (\\e -> if isEOFError e then return () else ioError e)\n\n           return (Just makefile_hdl)\n\n\n        -- write the magic marker into the tmp file\n  hPutStrLn tmp_hdl depStartMarker\n\n  return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,\n                  mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})\n\n\n-----------------------------------------------------------------\n--\n--              processDeps\n--\n-----------------------------------------------------------------\n\nprocessDeps :: DynFlags\n            -> HscEnv\n            -> [ModuleName]\n            -> FilePath\n            -> Handle           -- Write dependencies to here\n            -> SCC ModSummary\n            -> IO ()\n-- Write suitable dependencies to handle\n-- Always:\n--                      this.o : this.hs\n--\n-- If the dependency is on something other than a .hi file:\n--                      this.o this.p_o ... : dep\n-- otherwise\n--                      this.o ...   : dep.hi\n--                      this.p_o ... : dep.p_hi\n--                      ...\n-- (where .o is $osuf, and the other suffixes come from\n-- the cmdline -s options).\n--\n-- For {-# SOURCE #-} imports the \"hi\" will be \"hi-boot\".\n\nprocessDeps dflags _ _ _ _ (CyclicSCC nodes)\n  =     -- There shouldn't be any cycles; report them\n    throwGhcExceptionIO (ProgramError (showSDoc dflags $ GHC.cyclicModuleErr nodes))\n\nprocessDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node)\n  = do  { let extra_suffixes = depSuffixes dflags\n              include_pkg_deps = depIncludePkgDeps dflags\n              src_file  = msHsFilePath node\n              obj_file  = msObjFilePath node\n              obj_files = insertSuffixes obj_file extra_suffixes\n\n              do_imp loc is_boot pkg_qual imp_mod\n                = do { mb_hi <- findDependency hsc_env loc pkg_qual imp_mod\n                                               is_boot include_pkg_deps\n                     ; case mb_hi of {\n                           Nothing      -> return () ;\n                           Just hi_file -> do\n                     { let hi_files = insertSuffixes hi_file extra_suffixes\n                           write_dep (obj,hi) = writeDependency root hdl [obj] hi\n\n                        -- Add one dependency for each suffix;\n                        -- e.g.         A.o   : B.hi\n                        --              A.x_o : B.x_hi\n                     ; mapM_ write_dep (obj_files `zip` hi_files) }}}\n\n\n                -- Emit std dependency of the object(s) on the source file\n                -- Something like       A.o : A.hs\n        ; writeDependency root hdl obj_files src_file\n\n                -- Emit a dependency for each import\n\n        ; let do_imps is_boot idecls = sequence_\n                    [ do_imp loc is_boot mb_pkg mod\n                    | (mb_pkg, L loc mod) <- idecls,\n                      mod `notElem` excl_mods ]\n\n        ; do_imps True  (ms_srcimps node)\n        ; do_imps False (ms_imps node)\n        }\n\n\nfindDependency  :: HscEnv\n                -> SrcSpan\n                -> Maybe FastString     -- package qualifier, if any\n                -> ModuleName           -- Imported module\n                -> IsBootInterface      -- Source import\n                -> Bool                 -- Record dependency on package modules\n                -> IO (Maybe FilePath)  -- Interface file file\nfindDependency hsc_env srcloc pkg imp is_boot include_pkg_deps\n  = do  {       -- Find the module; this will be fast because\n                -- we've done it once during downsweep\n          r <- findImportedModule hsc_env imp pkg\n        ; case r of\n            Found loc _\n                -- Home package: just depend on the .hi or hi-boot file\n                | isJust (ml_hs_file loc) || include_pkg_deps\n                -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))\n\n                -- Not in this package: we don't need a dependency\n                | otherwise\n                -> return Nothing\n\n            fail ->\n                let dflags = hsc_dflags hsc_env\n                in throwOneError $ mkPlainErrMsg dflags srcloc $\n                        cannotFindModule dflags imp fail\n        }\n\n-----------------------------\nwriteDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()\n-- (writeDependency r h [t1,t2] dep) writes to handle h the dependency\n--      t1 t2 : dep\nwriteDependency root hdl targets dep\n  = do let -- We need to avoid making deps on\n           --     c:/foo/...\n           -- on cygwin as make gets confused by the :\n           -- Making relative deps avoids some instances of this.\n           dep' = makeRelative root dep\n           forOutput = escapeSpaces . reslash Forwards . normalise\n           output = unwords (map forOutput targets) ++ \" : \" ++ forOutput dep'\n       hPutStrLn hdl output\n\n-----------------------------\ninsertSuffixes\n        :: FilePath     -- Original filename;   e.g. \"foo.o\"\n        -> [String]     -- Suffix prefixes      e.g. [\"x_\", \"y_\"]\n        -> [FilePath]   -- Zapped filenames     e.g. [\"foo.x_o\", \"foo.y_o\"]\n        -- Note that that the extra bit gets inserted *before* the old suffix\n        -- We assume the old suffix contains no dots, so we know where to\n        -- split it\ninsertSuffixes file_name extras\n  = [ basename <.> (extra ++ suffix) | extra <- extras ]\n  where\n    (basename, suffix) = case splitExtension file_name of\n                         -- Drop the \".\" from the extension\n                         (b, s) -> (b, drop 1 s)\n\n\n-----------------------------------------------------------------\n--\n--              endMkDependHs\n--      Complete the makefile, close the tmp file etc\n--\n-----------------------------------------------------------------\n\nendMkDependHS :: DynFlags -> MkDepFiles -> IO ()\n\nendMkDependHS dflags\n   (MkDep { mkd_make_file = makefile, mkd_make_hdl =  makefile_hdl,\n            mkd_tmp_file  = tmp_file, mkd_tmp_hdl  =  tmp_hdl })\n  = do\n  -- write the magic marker into the tmp file\n  hPutStrLn tmp_hdl depEndMarker\n\n  case makefile_hdl of\n     Nothing  -> return ()\n     Just hdl -> do\n\n          -- slurp the rest of the original makefile and copy it into the output\n        let slurp = do\n                l <- hGetLine hdl\n                hPutStrLn tmp_hdl l\n                slurp\n\n        catchIO slurp\n                (\\e -> if isEOFError e then return () else ioError e)\n\n        hClose hdl\n\n  hClose tmp_hdl  -- make sure it's flushed\n\n        -- Create a backup of the original makefile\n  when (isJust makefile_hdl)\n       (SysTools.copy dflags (\"Backing up \" ++ makefile)\n          makefile (makefile++\".bak\"))\n\n        -- Copy the new makefile in place\n  SysTools.copy dflags \"Installing new makefile\" tmp_file makefile\n\n\n-----------------------------------------------------------------\n--              Module cycles\n-----------------------------------------------------------------\n\ndumpModCycles :: DynFlags -> ModuleGraph -> IO ()\ndumpModCycles dflags module_graph\n  | not (dopt Opt_D_dump_mod_cycles dflags)\n  = return ()\n\n  | null cycles\n  = putMsg dflags (text \"No module cycles\")\n\n  | otherwise\n  = putMsg dflags (hang (text \"Module cycles found:\") 2 pp_cycles)\n  where\n\n    cycles :: [[ModSummary]]\n    cycles =\n      [ c | CyclicSCC c <- GHC.topSortModuleGraph True module_graph Nothing ]\n\n    pp_cycles = vcat [ (text \"---------- Cycle\" <+> int n <+> ptext (sLit \"----------\"))\n                        $$ pprCycle c $$ blankLine\n                     | (n,c) <- [1..] `zip` cycles ]\n\npprCycle :: [ModSummary] -> SDoc\n-- Print a cycle, but show only the imports within the cycle\npprCycle summaries = pp_group (CyclicSCC summaries)\n  where\n    cycle_mods :: [ModuleName]  -- The modules in this cycle\n    cycle_mods = map (moduleName . ms_mod) summaries\n\n    pp_group (AcyclicSCC ms) = pp_ms ms\n    pp_group (CyclicSCC mss)\n        = ASSERT( not (null boot_only) )\n                -- The boot-only list must be non-empty, else there would\n                -- be an infinite chain of non-boot imoprts, and we've\n                -- already checked for that in processModDeps\n          pp_ms loop_breaker $$ vcat (map pp_group groups)\n        where\n          (boot_only, others) = partition is_boot_only mss\n          is_boot_only ms = not (any in_group (map snd (ms_imps ms)))\n          in_group (L _ m) = m `elem` group_mods\n          group_mods = map (moduleName . ms_mod) mss\n\n          loop_breaker = head boot_only\n          all_others   = tail boot_only ++ others\n          groups =\n            GHC.topSortModuleGraph True (mkModuleGraph all_others) Nothing\n\n    pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))\n                       <+> (pp_imps empty (map snd (ms_imps summary)) $$\n                            pp_imps (text \"{-# SOURCE #-}\") (map snd (ms_srcimps summary)))\n        where\n          mod_str = moduleNameString (moduleName (ms_mod summary))\n\n    pp_imps :: SDoc -> [Located ModuleName] -> SDoc\n    pp_imps _    [] = empty\n    pp_imps what lms\n        = case [m | L _ m <- lms, m `elem` cycle_mods] of\n            [] -> empty\n            ms -> what <+> text \"imports\" <+>\n                                pprWithCommas ppr ms\n\n-----------------------------------------------------------------\n--\n--              Flags\n--\n-----------------------------------------------------------------\n\ndepStartMarker, depEndMarker :: String\ndepStartMarker = \"# DO NOT DELETE: Beginning of Haskell dependencies\"\ndepEndMarker   = \"# DO NOT DELETE: End of Haskell dependencies\"\n\n", "num_lines": 411}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--  $Id: DriverPhases.hs,v 1.38 2005/05/17 11:01:59 simonmar Exp $\n--\n-- GHC Driver\n--\n-- (c) The University of Glasgow 2002\n--\n-----------------------------------------------------------------------------\n\nmodule DriverPhases (\n   HscSource(..), isHsBootOrSig, isHsigFile, hscSourceString,\n   Phase(..),\n   happensBefore, eqPhase, anyHsc, isStopLn,\n   startPhase,\n   phaseInputExt,\n\n   isHaskellishSuffix,\n   isHaskellSrcSuffix,\n   isBackpackishSuffix,\n   isObjectSuffix,\n   isCishSuffix,\n   isDynLibSuffix,\n   isHaskellUserSrcSuffix,\n   isHaskellSigSuffix,\n   isSourceSuffix,\n\n   isHaskellishTarget,\n\n   isHaskellishFilename,\n   isHaskellSrcFilename,\n   isHaskellSigFilename,\n   isObjectFilename,\n   isCishFilename,\n   isDynLibFilename,\n   isHaskellUserSrcFilename,\n   isSourceFilename\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} DynFlags\nimport Outputable\nimport Platform\nimport System.FilePath\nimport Binary\nimport Util\n\n-----------------------------------------------------------------------------\n-- Phases\n\n{-\n   Phase of the           | Suffix saying | Flag saying   | (suffix of)\n   compilation system     | ``start here''| ``stop after''| output file\n\n   literate pre-processor | .lhs          | -             | -\n   C pre-processor (opt.) | -             | -E            | -\n   Haskell compiler       | .hs           | -C, -S        | .hc, .s\n   C compiler (opt.)      | .hc or .c     | -S            | .s\n   assembler              | .s  or .S     | -c            | .o\n   linker                 | other         | -             | a.out\n-}\n\n-- Note [HscSource types]\n-- ~~~~~~~~~~~~~~~~~~~~~~\n-- There are three types of source file for Haskell code:\n--\n--      * HsSrcFile is an ordinary hs file which contains code,\n--\n--      * HsBootFile is an hs-boot file, which is used to break\n--        recursive module imports (there will always be an\n--        HsSrcFile associated with it), and\n--\n--      * HsigFile is an hsig file, which contains only type\n--        signatures and is used to specify signatures for\n--        modules.\n--\n-- Syntactically, hs-boot files and hsig files are quite similar: they\n-- only include type signatures and must be associated with an\n-- actual HsSrcFile.  isHsBootOrSig allows us to abstract over code\n-- which is indifferent to which.  However, there are some important\n-- differences, mostly owing to the fact that hsigs are proper\n-- modules (you `import Sig` directly) whereas HsBootFiles are\n-- temporary placeholders (you `import {-# SOURCE #-} Mod).\n-- When we finish compiling the true implementation of an hs-boot,\n-- we replace the HomeModInfo with the real HsSrcFile.  An HsigFile, on the\n-- other hand, is never replaced (in particular, we *cannot* use the\n-- HomeModInfo of the original HsSrcFile backing the signature, since it\n-- will export too many symbols.)\n--\n-- Additionally, while HsSrcFile is the only Haskell file\n-- which has *code*, we do generate .o files for HsigFile, because\n-- this is how the recompilation checker figures out if a file\n-- needs to be recompiled.  These are fake object files which\n-- should NOT be linked against.\n\ndata HscSource\n   = HsSrcFile | HsBootFile | HsigFile\n     deriving( Eq, Ord, Show )\n        -- Ord needed for the finite maps we build in CompManager\n\ninstance Binary HscSource where\n    put_ bh HsSrcFile = putByte bh 0\n    put_ bh HsBootFile = putByte bh 1\n    put_ bh HsigFile = putByte bh 2\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> return HsSrcFile\n            1 -> return HsBootFile\n            _ -> return HsigFile\n\nhscSourceString :: HscSource -> String\nhscSourceString HsSrcFile   = \"\"\nhscSourceString HsBootFile  = \"[boot]\"\nhscSourceString HsigFile    = \"[sig]\"\n\n-- See Note [isHsBootOrSig]\nisHsBootOrSig :: HscSource -> Bool\nisHsBootOrSig HsBootFile = True\nisHsBootOrSig HsigFile   = True\nisHsBootOrSig _          = False\n\nisHsigFile :: HscSource -> Bool\nisHsigFile HsigFile = True\nisHsigFile _        = False\n\ndata Phase\n        = Unlit HscSource\n        | Cpp   HscSource\n        | HsPp  HscSource\n        | Hsc   HscSource\n        | Ccxx          -- Compile C++\n        | Cc            -- Compile C\n        | Cobjc         -- Compile Objective-C\n        | Cobjcxx       -- Compile Objective-C++\n        | HCc           -- Haskellised C (as opposed to vanilla C) compilation\n        | As Bool       -- Assembler for regular assembly files (Bool: with-cpp)\n        | LlvmOpt       -- Run LLVM opt tool over llvm assembly\n        | LlvmLlc       -- LLVM bitcode to native assembly\n        | LlvmMangle    -- Fix up TNTC by processing assembly produced by LLVM\n        | CmmCpp        -- pre-process Cmm source\n        | Cmm           -- parse & compile Cmm code\n        | MergeForeign  -- merge in the foreign object files\n\n        -- The final phase is a pseudo-phase that tells the pipeline to stop.\n        -- There is no runPhase case for it.\n        | StopLn        -- Stop, but linking will follow, so generate .o file\n  deriving (Eq, Show)\n\ninstance Outputable Phase where\n    ppr p = text (show p)\n\nanyHsc :: Phase\nanyHsc = Hsc (panic \"anyHsc\")\n\nisStopLn :: Phase -> Bool\nisStopLn StopLn = True\nisStopLn _      = False\n\neqPhase :: Phase -> Phase -> Bool\n-- Equality of constructors, ignoring the HscSource field\n-- NB: the HscSource field can be 'bot'; see anyHsc above\neqPhase (Unlit _)   (Unlit _)  = True\neqPhase (Cpp   _)   (Cpp   _)  = True\neqPhase (HsPp  _)   (HsPp  _)  = True\neqPhase (Hsc   _)   (Hsc   _)  = True\neqPhase Cc          Cc         = True\neqPhase Cobjc       Cobjc      = True\neqPhase HCc         HCc        = True\neqPhase (As x)      (As y)     = x == y\neqPhase LlvmOpt     LlvmOpt    = True\neqPhase LlvmLlc     LlvmLlc    = True\neqPhase LlvmMangle  LlvmMangle = True\neqPhase CmmCpp      CmmCpp     = True\neqPhase Cmm         Cmm        = True\neqPhase MergeForeign MergeForeign  = True\neqPhase StopLn      StopLn     = True\neqPhase Ccxx        Ccxx       = True\neqPhase Cobjcxx     Cobjcxx    = True\neqPhase _           _          = False\n\n{- Note [Partial ordering on phases]\n\nWe want to know which phases will occur before which others. This is used for\nsanity checking, to ensure that the pipeline will stop at some point (see\nDriverPipeline.runPipeline).\n\nA < B iff A occurs before B in a normal compilation pipeline.\n\nThere is explicitly not a total ordering on phases, because in registerised\nbuilds, the phase `HsC` doesn't happen before nor after any other phase.\n\nAlthough we check that a normal user doesn't set the stop_phase to HsC through\nuse of -C with registerised builds (in Main.checkOptions), it is still\npossible for a ghc-api user to do so. So be careful when using the function\nhappensBefore, and don't think that `not (a <= b)` implies `b < a`.\n-}\nhappensBefore :: DynFlags -> Phase -> Phase -> Bool\nhappensBefore dflags p1 p2 = p1 `happensBefore'` p2\n    where StopLn `happensBefore'` _ = False\n          x      `happensBefore'` y = after_x `eqPhase` y\n                                   || after_x `happensBefore'` y\n              where after_x = nextPhase dflags x\n\nnextPhase :: DynFlags -> Phase -> Phase\nnextPhase dflags p\n    -- A conservative approximation to the next phase, used in happensBefore\n    = case p of\n      Unlit sf   -> Cpp  sf\n      Cpp   sf   -> HsPp sf\n      HsPp  sf   -> Hsc  sf\n      Hsc   _    -> maybeHCc\n      LlvmOpt    -> LlvmLlc\n      LlvmLlc    -> LlvmMangle\n      LlvmMangle -> As False\n      As _       -> MergeForeign\n      Ccxx       -> As False\n      Cc         -> As False\n      Cobjc      -> As False\n      Cobjcxx    -> As False\n      CmmCpp     -> Cmm\n      Cmm        -> maybeHCc\n      HCc        -> As False\n      MergeForeign -> StopLn\n      StopLn     -> panic \"nextPhase: nothing after StopLn\"\n    where maybeHCc = if platformUnregisterised (targetPlatform dflags)\n                     then HCc\n                     else As False\n\n-- the first compilation phase for a given file is determined\n-- by its suffix.\nstartPhase :: String -> Phase\nstartPhase \"lhs\"      = Unlit HsSrcFile\nstartPhase \"lhs-boot\" = Unlit HsBootFile\nstartPhase \"lhsig\"    = Unlit HsigFile\nstartPhase \"hs\"       = Cpp   HsSrcFile\nstartPhase \"hs-boot\"  = Cpp   HsBootFile\nstartPhase \"hsig\"     = Cpp   HsigFile\nstartPhase \"hscpp\"    = HsPp  HsSrcFile\nstartPhase \"hspp\"     = Hsc   HsSrcFile\nstartPhase \"hc\"       = HCc\nstartPhase \"c\"        = Cc\nstartPhase \"cpp\"      = Ccxx\nstartPhase \"C\"        = Cc\nstartPhase \"m\"        = Cobjc\nstartPhase \"M\"        = Cobjcxx\nstartPhase \"mm\"       = Cobjcxx\nstartPhase \"cc\"       = Ccxx\nstartPhase \"cxx\"      = Ccxx\nstartPhase \"s\"        = As False\nstartPhase \"S\"        = As True\nstartPhase \"ll\"       = LlvmOpt\nstartPhase \"bc\"       = LlvmLlc\nstartPhase \"lm_s\"     = LlvmMangle\nstartPhase \"o\"        = StopLn\nstartPhase \"cmm\"      = CmmCpp\nstartPhase \"cmmcpp\"   = Cmm\nstartPhase _          = StopLn     -- all unknown file types\n\n-- This is used to determine the extension for the output from the\n-- current phase (if it generates a new file).  The extension depends\n-- on the next phase in the pipeline.\nphaseInputExt :: Phase -> String\nphaseInputExt (Unlit HsSrcFile)   = \"lhs\"\nphaseInputExt (Unlit HsBootFile)  = \"lhs-boot\"\nphaseInputExt (Unlit HsigFile)    = \"lhsig\"\nphaseInputExt (Cpp   _)           = \"lpp\"       -- intermediate only\nphaseInputExt (HsPp  _)           = \"hscpp\"     -- intermediate only\nphaseInputExt (Hsc   _)           = \"hspp\"      -- intermediate only\n        -- NB: as things stand, phaseInputExt (Hsc x) must not evaluate x\n        --     because runPipeline uses the StopBefore phase to pick the\n        --     output filename.  That could be fixed, but watch out.\nphaseInputExt HCc                 = \"hc\"\nphaseInputExt Ccxx                = \"cpp\"\nphaseInputExt Cobjc               = \"m\"\nphaseInputExt Cobjcxx             = \"mm\"\nphaseInputExt Cc                  = \"c\"\nphaseInputExt (As True)           = \"S\"\nphaseInputExt (As False)          = \"s\"\nphaseInputExt LlvmOpt             = \"ll\"\nphaseInputExt LlvmLlc             = \"bc\"\nphaseInputExt LlvmMangle          = \"lm_s\"\nphaseInputExt CmmCpp              = \"cmmcpp\"\nphaseInputExt Cmm                 = \"cmm\"\nphaseInputExt MergeForeign        = \"o\"\nphaseInputExt StopLn              = \"o\"\n\nhaskellish_src_suffixes, backpackish_suffixes, haskellish_suffixes, cish_suffixes,\n    haskellish_user_src_suffixes, haskellish_sig_suffixes\n :: [String]\n-- When a file with an extension in the haskellish_src_suffixes group is\n-- loaded in --make mode, its imports will be loaded too.\nhaskellish_src_suffixes      = haskellish_user_src_suffixes ++\n                               [ \"hspp\", \"hscpp\" ]\nhaskellish_suffixes          = haskellish_src_suffixes ++\n                               [ \"hc\", \"cmm\", \"cmmcpp\" ]\ncish_suffixes                = [ \"c\", \"cpp\", \"C\", \"cc\", \"cxx\", \"s\", \"S\", \"ll\", \"bc\", \"lm_s\", \"m\", \"M\", \"mm\" ]\n\n-- Will not be deleted as temp files:\nhaskellish_user_src_suffixes =\n  haskellish_sig_suffixes ++ [ \"hs\", \"lhs\", \"hs-boot\", \"lhs-boot\" ]\nhaskellish_sig_suffixes      = [ \"hsig\", \"lhsig\" ]\nbackpackish_suffixes         = [ \"bkp\" ]\n\nobjish_suffixes :: Platform -> [String]\n-- Use the appropriate suffix for the system on which\n-- the GHC-compiled code will run\nobjish_suffixes platform = case platformOS platform of\n  OSMinGW32 -> [ \"o\", \"O\", \"obj\", \"OBJ\" ]\n  _         -> [ \"o\" ]\n\ndynlib_suffixes :: Platform -> [String]\ndynlib_suffixes platform = case platformOS platform of\n  OSMinGW32 -> [\"dll\", \"DLL\"]\n  OSDarwin  -> [\"dylib\", \"so\"]\n  _         -> [\"so\"]\n\nisHaskellishSuffix, isBackpackishSuffix, isHaskellSrcSuffix, isCishSuffix,\n    isHaskellUserSrcSuffix, isHaskellSigSuffix\n :: String -> Bool\nisHaskellishSuffix     s = s `elem` haskellish_suffixes\nisBackpackishSuffix    s = s `elem` backpackish_suffixes\nisHaskellSigSuffix     s = s `elem` haskellish_sig_suffixes\nisHaskellSrcSuffix     s = s `elem` haskellish_src_suffixes\nisCishSuffix           s = s `elem` cish_suffixes\nisHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes\n\nisObjectSuffix, isDynLibSuffix :: Platform -> String -> Bool\nisObjectSuffix platform s = s `elem` objish_suffixes platform\nisDynLibSuffix platform s = s `elem` dynlib_suffixes platform\n\nisSourceSuffix :: String -> Bool\nisSourceSuffix suff  = isHaskellishSuffix suff\n                    || isCishSuffix suff\n                    || isBackpackishSuffix suff\n\n-- | When we are given files (modified by -x arguments) we need\n-- to determine if they are Haskellish or not to figure out\n-- how we should try to compile it.  The rules are:\n--\n--      1. If no -x flag was specified, we check to see if\n--         the file looks like a module name, has no extension,\n--         or has a Haskell source extension.\n--\n--      2. If an -x flag was specified, we just make sure the\n--         specified suffix is a Haskell one.\nisHaskellishTarget :: (String, Maybe Phase) -> Bool\nisHaskellishTarget (f,Nothing) =\n  looksLikeModuleName f || isHaskellSrcFilename f || not (hasExtension f)\nisHaskellishTarget (_,Just phase) =\n  phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm\n                  , StopLn]\n\nisHaskellishFilename, isHaskellSrcFilename, isCishFilename,\n    isHaskellUserSrcFilename, isSourceFilename, isHaskellSigFilename\n :: FilePath -> Bool\n-- takeExtension return .foo, so we drop 1 to get rid of the .\nisHaskellishFilename     f = isHaskellishSuffix     (drop 1 $ takeExtension f)\nisHaskellSrcFilename     f = isHaskellSrcSuffix     (drop 1 $ takeExtension f)\nisCishFilename           f = isCishSuffix           (drop 1 $ takeExtension f)\nisHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)\nisSourceFilename         f = isSourceSuffix         (drop 1 $ takeExtension f)\nisHaskellSigFilename     f = isHaskellSigSuffix     (drop 1 $ takeExtension f)\n\nisObjectFilename, isDynLibFilename :: Platform -> FilePath -> Bool\nisObjectFilename platform f = isObjectSuffix platform (drop 1 $ takeExtension f)\nisDynLibFilename platform f = isDynLibSuffix platform (drop 1 $ takeExtension f)\n\n", "num_lines": 373}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns, MultiWayIf #-}\n{-# OPTIONS_GHC -fno-cse #-}\n-- -fno-cse is needed for GLOBAL_VAR's to behave properly\n\n-----------------------------------------------------------------------------\n--\n-- GHC Driver\n--\n-- (c) The University of Glasgow 2005\n--\n-----------------------------------------------------------------------------\n\nmodule DriverPipeline (\n        -- Run a series of compilation steps in a pipeline, for a\n        -- collection of source files.\n   oneShot, compileFile,\n\n        -- Interfaces for the batch-mode driver\n   linkBinary,\n\n        -- Interfaces for the compilation manager (interpreted/batch-mode)\n   preprocess,\n   compileOne, compileOne',\n   link,\n\n        -- Exports for hooks to override runPhase and link\n   PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),\n   phaseOutputFilename, getOutputFilename, getPipeState, getPipeEnv,\n   hscPostBackendPhase, getLocation, setModLocation, setDynFlags,\n   runPhase, exeFileName,\n   maybeCreateManifest,\n   linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport PipelineMonad\nimport Packages\nimport HeaderInfo\nimport DriverPhases\nimport SysTools\nimport SysTools.ExtraObj\nimport HscMain\nimport Finder\nimport HscTypes hiding ( Hsc )\nimport Outputable\nimport Module\nimport ErrUtils\nimport DynFlags\nimport Config\nimport Panic\nimport Util\nimport StringBuffer     ( hGetStringBuffer )\nimport BasicTypes       ( SuccessFlag(..) )\nimport Maybes           ( expectJust )\nimport SrcLoc\nimport LlvmCodeGen      ( llvmFixupAsm )\nimport MonadUtils\nimport Platform\nimport TcRnTypes\nimport Hooks\nimport qualified GHC.LanguageExtensions as LangExt\nimport FileCleanup\nimport Ar\n\nimport Exception\nimport System.Directory\nimport System.FilePath\nimport System.IO\nimport Control.Monad\nimport Data.List        ( isInfixOf, intercalate )\nimport Data.Maybe\nimport Data.Version\nimport Data.Either      ( partitionEithers )\n\nimport Data.Time        ( UTCTime )\n\n-- ---------------------------------------------------------------------------\n-- Pre-process\n\n-- | Just preprocess a file, put the result in a temp. file (used by the\n-- compilation manager during the summary phase).\n--\n-- We return the augmented DynFlags, because they contain the result\n-- of slurping in the OPTIONS pragmas\n\npreprocess :: HscEnv\n           -> (FilePath, Maybe Phase) -- ^ filename and starting phase\n           -> IO (DynFlags, FilePath)\npreprocess hsc_env (filename, mb_phase) =\n  ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)\n  runPipeline anyHsc hsc_env (filename, fmap RealPhase mb_phase)\n        Nothing\n        -- We keep the processed file for the whole session to save on\n        -- duplicated work in ghci.\n        (Temporary TFL_GhcSession)\n        Nothing{-no ModLocation-}\n        []{-no foreign objects-}\n\n-- ---------------------------------------------------------------------------\n\n-- | Compile\n--\n-- Compile a single module, under the control of the compilation manager.\n--\n-- This is the interface between the compilation manager and the\n-- compiler proper (hsc), where we deal with tedious details like\n-- reading the OPTIONS pragma from the source file, converting the\n-- C or assembly that GHC produces into an object file, and compiling\n-- FFI stub files.\n--\n-- NB.  No old interface can also mean that the source has changed.\n\ncompileOne :: HscEnv\n           -> ModSummary      -- ^ summary for module being compiled\n           -> Int             -- ^ module N ...\n           -> Int             -- ^ ... of M\n           -> Maybe ModIface  -- ^ old interface, if we have one\n           -> Maybe Linkable  -- ^ old linkable, if we have one\n           -> SourceModified\n           -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful\n\ncompileOne = compileOne' Nothing (Just batchMsg)\n\ncompileOne' :: Maybe TcGblEnv\n            -> Maybe Messager\n            -> HscEnv\n            -> ModSummary      -- ^ summary for module being compiled\n            -> Int             -- ^ module N ...\n            -> Int             -- ^ ... of M\n            -> Maybe ModIface  -- ^ old interface, if we have one\n            -> Maybe Linkable  -- ^ old linkable, if we have one\n            -> SourceModified\n            -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful\n\ncompileOne' m_tc_result mHscMessage\n            hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable\n            source_modified0\n = do\n\n   debugTraceMsg dflags1 2 (text \"compile: input file\" <+> text input_fnpp)\n\n   (status, hmi0) <- hscIncrementalCompile\n                        always_do_basic_recompilation_check\n                        m_tc_result mHscMessage\n                        hsc_env summary source_modified mb_old_iface (mod_index, nmods)\n\n   let flags = hsc_dflags hsc_env0\n     in do unless (gopt Opt_KeepHiFiles flags) $\n               addFilesToClean flags TFL_CurrentModule $\n                   [ml_hi_file $ ms_location summary]\n           unless (gopt Opt_KeepOFiles flags) $\n               addFilesToClean flags TFL_GhcSession $\n                   [ml_obj_file $ ms_location summary]\n\n   case (status, hsc_lang) of\n        (HscUpToDate, _) ->\n            -- TODO recomp014 triggers this assert. What's going on?!\n            -- ASSERT( isJust maybe_old_linkable || isNoLink (ghcLink dflags) )\n            return hmi0 { hm_linkable = maybe_old_linkable }\n        (HscNotGeneratingCode, HscNothing) ->\n            let mb_linkable = if isHsBootOrSig src_flavour\n                                then Nothing\n                                -- TODO: Questionable.\n                                else Just (LM (ms_hs_date summary) this_mod [])\n            in return hmi0 { hm_linkable = mb_linkable }\n        (HscNotGeneratingCode, _) -> panic \"compileOne HscNotGeneratingCode\"\n        (_, HscNothing) -> panic \"compileOne HscNothing\"\n        (HscUpdateBoot, HscInterpreted) -> do\n            return hmi0\n        (HscUpdateBoot, _) -> do\n            touchObjectFile dflags object_filename\n            return hmi0\n        (HscUpdateSig, HscInterpreted) ->\n            let linkable = LM (ms_hs_date summary) this_mod []\n            in return hmi0 { hm_linkable = Just linkable }\n        (HscUpdateSig, _) -> do\n            output_fn <- getOutputFilename next_phase\n                            (Temporary TFL_CurrentModule) basename dflags\n                            next_phase (Just location)\n\n            -- #10660: Use the pipeline instead of calling\n            -- compileEmptyStub directly, so -dynamic-too gets\n            -- handled properly\n            _ <- runPipeline StopLn hsc_env\n                              (output_fn,\n                               Just (HscOut src_flavour\n                                            mod_name HscUpdateSig))\n                              (Just basename)\n                              Persistent\n                              (Just location)\n                              []\n            o_time <- getModificationUTCTime object_filename\n            let linkable = LM o_time this_mod [DotO object_filename]\n            return hmi0 { hm_linkable = Just linkable }\n        (HscRecomp cgguts summary, HscInterpreted) -> do\n            (hasStub, comp_bc, spt_entries) <-\n                hscInteractive hsc_env cgguts summary\n\n            stub_o <- case hasStub of\n                      Nothing -> return []\n                      Just stub_c -> do\n                          stub_o <- compileStub hsc_env stub_c\n                          return [DotO stub_o]\n\n            let hs_unlinked = [BCOs comp_bc spt_entries]\n                unlinked_time = ms_hs_date summary\n              -- Why do we use the timestamp of the source file here,\n              -- rather than the current time?  This works better in\n              -- the case where the local clock is out of sync\n              -- with the filesystem's clock.  It's just as accurate:\n              -- if the source is modified, then the linkable will\n              -- be out of date.\n            let linkable = LM unlinked_time (ms_mod summary)\n                           (hs_unlinked ++ stub_o)\n            return hmi0 { hm_linkable = Just linkable }\n        (HscRecomp cgguts summary, _) -> do\n            output_fn <- getOutputFilename next_phase\n                            (Temporary TFL_CurrentModule)\n                            basename dflags next_phase (Just location)\n            -- We're in --make mode: finish the compilation pipeline.\n            _ <- runPipeline StopLn hsc_env\n                              (output_fn,\n                               Just (HscOut src_flavour mod_name (HscRecomp cgguts summary)))\n                              (Just basename)\n                              Persistent\n                              (Just location)\n                              []\n                  -- The object filename comes from the ModLocation\n            o_time <- getModificationUTCTime object_filename\n            let linkable = LM o_time this_mod [DotO object_filename]\n            return hmi0 { hm_linkable = Just linkable }\n\n where dflags0     = ms_hspp_opts summary\n\n       this_mod    = ms_mod summary\n       location    = ms_location summary\n       input_fn    = expectJust \"compile:hs\" (ml_hs_file location)\n       input_fnpp  = ms_hspp_file summary\n       mod_graph   = hsc_mod_graph hsc_env0\n       needsLinker = needsTemplateHaskellOrQQ mod_graph\n       isDynWay    = any (== WayDyn) (ways dflags0)\n       isProfWay   = any (== WayProf) (ways dflags0)\n       internalInterpreter = not (gopt Opt_ExternalInterpreter dflags0)\n\n       src_flavour = ms_hsc_src summary\n       mod_name = ms_mod_name summary\n       next_phase = hscPostBackendPhase src_flavour hsc_lang\n       object_filename = ml_obj_file location\n\n       -- #8180 - when using TemplateHaskell, switch on -dynamic-too so\n       -- the linker can correctly load the object files.  This isn't necessary\n       -- when using -fexternal-interpreter.\n       dflags1 = if dynamicGhc && internalInterpreter &&\n                    not isDynWay && not isProfWay && needsLinker\n                  then gopt_set dflags0 Opt_BuildDynamicToo\n                  else dflags0\n\n       basename = dropExtension input_fn\n\n       -- We add the directory in which the .hs files resides) to the import\n       -- path.  This is needed when we try to compile the .hc file later, if it\n       -- imports a _stub.h file that we created here.\n       current_dir = takeDirectory basename\n       old_paths   = includePaths dflags1\n       !prevailing_dflags = hsc_dflags hsc_env0\n       dflags =\n          dflags1 { includePaths = addQuoteInclude old_paths [current_dir]\n                  , log_action = log_action prevailing_dflags }\n                  -- use the prevailing log_action / log_finaliser,\n                  -- not the one cached in the summary.  This is so\n                  -- that we can change the log_action without having\n                  -- to re-summarize all the source files.\n       hsc_env     = hsc_env0 {hsc_dflags = dflags}\n\n       -- Figure out what lang we're generating\n       hsc_lang = hscTarget dflags\n\n       -- -fforce-recomp should also work with --make\n       force_recomp = gopt Opt_ForceRecomp dflags\n       source_modified\n         | force_recomp = SourceModified\n         | otherwise = source_modified0\n\n       always_do_basic_recompilation_check = case hsc_lang of\n                                             HscInterpreted -> True\n                                             _ -> False\n\n-----------------------------------------------------------------------------\n-- stub .h and .c files (for foreign export support), and cc files.\n\n-- The _stub.c file is derived from the haskell source file, possibly taking\n-- into account the -stubdir option.\n--\n-- The object file created by compiling the _stub.c file is put into a\n-- temporary file, which will be later combined with the main .o file\n-- (see the MergeForeigns phase).\n--\n-- Moreover, we also let the user emit arbitrary C/C++/ObjC/ObjC++ files\n-- from TH, that are then compiled and linked to the module. This is\n-- useful to implement facilities such as inline-c.\n\ncompileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath\ncompileForeign _ RawObject object_file = return object_file\ncompileForeign hsc_env lang stub_c = do\n        let phase = case lang of\n              LangC      -> Cc\n              LangCxx    -> Ccxx\n              LangObjc   -> Cobjc\n              LangObjcxx -> Cobjcxx\n              LangAsm    -> As True -- allow CPP\n              RawObject  -> panic \"compileForeign: should be unreachable\"\n        (_, stub_o) <- runPipeline StopLn hsc_env\n                       (stub_c, Just (RealPhase phase))\n                       Nothing (Temporary TFL_GhcSession)\n                       Nothing{-no ModLocation-}\n                       []\n        return stub_o\n\ncompileStub :: HscEnv -> FilePath -> IO FilePath\ncompileStub hsc_env stub_c = compileForeign hsc_env LangC stub_c\n\ncompileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()\ncompileEmptyStub dflags hsc_env basename location mod_name = do\n  -- To maintain the invariant that every Haskell file\n  -- compiles to object code, we make an empty (but\n  -- valid) stub object file for signatures.  However,\n  -- we make sure this object file has a unique symbol,\n  -- so that ranlib on OS X doesn't complain, see\n  -- http://ghc.haskell.org/trac/ghc/ticket/12673\n  -- and https://github.com/haskell/cabal/issues/2257\n  empty_stub <- newTempName dflags TFL_CurrentModule \"c\"\n  let src = text \"int\" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text \"= 0;\"\n  writeFile empty_stub (showSDoc dflags (pprCode CStyle src))\n  _ <- runPipeline StopLn hsc_env\n                  (empty_stub, Nothing)\n                  (Just basename)\n                  Persistent\n                  (Just location)\n                  []\n  return ()\n\n-- ---------------------------------------------------------------------------\n-- Link\n\nlink :: GhcLink                 -- interactive or batch\n     -> DynFlags                -- dynamic flags\n     -> Bool                    -- attempt linking in batch mode?\n     -> HomePackageTable        -- what to link\n     -> IO SuccessFlag\n\n-- For the moment, in the batch linker, we don't bother to tell doLink\n-- which packages to link -- it just tries all that are available.\n-- batch_attempt_linking should only be *looked at* in batch mode.  It\n-- should only be True if the upsweep was successful and someone\n-- exports main, i.e., we have good reason to believe that linking\n-- will succeed.\n\nlink ghcLink dflags\n  = lookupHook linkHook l dflags ghcLink dflags\n  where\n    l LinkInMemory _ _ _\n      = if cGhcWithInterpreter == \"YES\"\n        then -- Not Linking...(demand linker will do the job)\n             return Succeeded\n        else panicBadLink LinkInMemory\n\n    l NoLink _ _ _\n      = return Succeeded\n\n    l LinkBinary dflags batch_attempt_linking hpt\n      = link' dflags batch_attempt_linking hpt\n\n    l LinkStaticLib dflags batch_attempt_linking hpt\n      = link' dflags batch_attempt_linking hpt\n\n    l LinkDynLib dflags batch_attempt_linking hpt\n      = link' dflags batch_attempt_linking hpt\n\npanicBadLink :: GhcLink -> a\npanicBadLink other = panic (\"link: GHC not built to link this way: \" ++\n                            show other)\n\nlink' :: DynFlags                -- dynamic flags\n      -> Bool                    -- attempt linking in batch mode?\n      -> HomePackageTable        -- what to link\n      -> IO SuccessFlag\n\nlink' dflags batch_attempt_linking hpt\n   | batch_attempt_linking\n   = do\n        let\n            staticLink = case ghcLink dflags of\n                          LinkStaticLib -> True\n                          _ -> False\n\n            home_mod_infos = eltsHpt hpt\n\n            -- the packages we depend on\n            pkg_deps  = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos\n\n            -- the linkables to link\n            linkables = map (expectJust \"link\".hm_linkable) home_mod_infos\n\n        debugTraceMsg dflags 3 (text \"link: linkables are ...\" $$ vcat (map ppr linkables))\n\n        -- check for the -no-link flag\n        if isNoLink (ghcLink dflags)\n          then do debugTraceMsg dflags 3 (text \"link(batch): linking omitted (-c flag given).\")\n                  return Succeeded\n          else do\n\n        let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)\n            obj_files = concatMap getOfiles linkables\n\n            exe_file = exeFileName staticLink dflags\n\n        linking_needed <- linkingNeeded dflags staticLink linkables pkg_deps\n\n        if not (gopt Opt_ForceRecomp dflags) && not linking_needed\n           then do debugTraceMsg dflags 2 (text exe_file <+> text \"is up to date, linking not required.\")\n                   return Succeeded\n           else do\n\n        compilationProgressMsg dflags (\"Linking \" ++ exe_file ++ \" ...\")\n\n        -- Don't showPass in Batch mode; doLink will do that for us.\n        let link = case ghcLink dflags of\n                LinkBinary    -> linkBinary\n                LinkStaticLib -> linkStaticLib\n                LinkDynLib    -> linkDynLibCheck\n                other         -> panicBadLink other\n        link dflags obj_files pkg_deps\n\n        debugTraceMsg dflags 3 (text \"link: done\")\n\n        -- linkBinary only returns if it succeeds\n        return Succeeded\n\n   | otherwise\n   = do debugTraceMsg dflags 3 (text \"link(batch): upsweep (partially) failed OR\" $$\n                                text \"   Main.main not exported; not linking.\")\n        return Succeeded\n\n\nlinkingNeeded :: DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool\nlinkingNeeded dflags staticLink linkables pkg_deps = do\n        -- if the modification time on the executable is later than the\n        -- modification times on all of the objects and libraries, then omit\n        -- linking (unless the -fforce-recomp flag was given).\n  let exe_file = exeFileName staticLink dflags\n  e_exe_time <- tryIO $ getModificationUTCTime exe_file\n  case e_exe_time of\n    Left _  -> return True\n    Right t -> do\n        -- first check object files and extra_ld_inputs\n        let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]\n        e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs\n        let (errs,extra_times) = partitionEithers e_extra_times\n        let obj_times =  map linkableTime linkables ++ extra_times\n        if not (null errs) || any (t <) obj_times\n            then return True\n            else do\n\n        -- next, check libraries. XXX this only checks Haskell libraries,\n        -- not extra_libraries or -l things from the command line.\n        let pkg_hslibs  = [ (collectLibraryPaths dflags [c], lib)\n                          | Just c <- map (lookupInstalledPackage dflags) pkg_deps,\n                            lib <- packageHsLibs dflags c ]\n\n        pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs\n        if any isNothing pkg_libfiles then return True else do\n        e_lib_times <- mapM (tryIO . getModificationUTCTime)\n                          (catMaybes pkg_libfiles)\n        let (lib_errs,lib_times) = partitionEithers e_lib_times\n        if not (null lib_errs) || any (t <) lib_times\n           then return True\n           else checkLinkInfo dflags pkg_deps exe_file\n\nfindHSLib :: DynFlags -> [String] -> String -> IO (Maybe FilePath)\nfindHSLib dflags dirs lib = do\n  let batch_lib_file = if WayDyn `notElem` ways dflags\n                      then \"lib\" ++ lib <.> \"a\"\n                      else mkSOName (targetPlatform dflags) lib\n  found <- filterM doesFileExist (map (</> batch_lib_file) dirs)\n  case found of\n    [] -> return Nothing\n    (x:_) -> return (Just x)\n\n-- -----------------------------------------------------------------------------\n-- Compile files in one-shot mode.\n\noneShot :: HscEnv -> Phase -> [(String, Maybe Phase)] -> IO ()\noneShot hsc_env stop_phase srcs = do\n  o_files <- mapM (compileFile hsc_env stop_phase) srcs\n  doLink (hsc_dflags hsc_env) stop_phase o_files\n\ncompileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath\ncompileFile hsc_env stop_phase (src, mb_phase) = do\n   exists <- doesFileExist src\n   when (not exists) $\n        throwGhcExceptionIO (CmdLineError (\"does not exist: \" ++ src))\n\n   let\n        dflags    = hsc_dflags hsc_env\n        mb_o_file = outputFile dflags\n        ghc_link  = ghcLink dflags      -- Set by -c or -no-link\n\n        -- When linking, the -o argument refers to the linker's output.\n        -- otherwise, we use it as the name for the pipeline's output.\n        output\n         -- If we are doing -fno-code, then act as if the output is\n         -- 'Temporary'. This stops GHC trying to copy files to their\n         -- final location.\n         | HscNothing <- hscTarget dflags = Temporary TFL_CurrentModule\n         | StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent\n                -- -o foo applies to linker\n         | isJust mb_o_file = SpecificFile\n                -- -o foo applies to the file we are compiling now\n         | otherwise = Persistent\n\n   ( _, out_file) <- runPipeline stop_phase hsc_env\n                            (src, fmap RealPhase mb_phase) Nothing output\n                            Nothing{-no ModLocation-} []\n   return out_file\n\n\ndoLink :: DynFlags -> Phase -> [FilePath] -> IO ()\ndoLink dflags stop_phase o_files\n  | not (isStopLn stop_phase)\n  = return ()           -- We stopped before the linking phase\n\n  | otherwise\n  = case ghcLink dflags of\n        NoLink        -> return ()\n        LinkBinary    -> linkBinary         dflags o_files []\n        LinkStaticLib -> linkStaticLib      dflags o_files []\n        LinkDynLib    -> linkDynLibCheck    dflags o_files []\n        other         -> panicBadLink other\n\n\n-- ---------------------------------------------------------------------------\n\n-- | Run a compilation pipeline, consisting of multiple phases.\n--\n-- This is the interface to the compilation pipeline, which runs\n-- a series of compilation steps on a single source file, specifying\n-- at which stage to stop.\n--\n-- The DynFlags can be modified by phases in the pipeline (eg. by\n-- OPTIONS_GHC pragmas), and the changes affect later phases in the\n-- pipeline.\nrunPipeline\n  :: Phase                      -- ^ When to stop\n  -> HscEnv                     -- ^ Compilation environment\n  -> (FilePath,Maybe PhasePlus) -- ^ Input filename (and maybe -x suffix)\n  -> Maybe FilePath             -- ^ original basename (if different from ^^^)\n  -> PipelineOutput             -- ^ Output filename\n  -> Maybe ModLocation          -- ^ A ModLocation, if this is a Haskell module\n  -> [FilePath]                 -- ^ foreign objects\n  -> IO (DynFlags, FilePath)    -- ^ (final flags, output filename)\nrunPipeline stop_phase hsc_env0 (input_fn, mb_phase)\n             mb_basename output maybe_loc foreign_os\n\n    = do let\n             dflags0 = hsc_dflags hsc_env0\n\n             -- Decide where dump files should go based on the pipeline output\n             dflags = dflags0 { dumpPrefix = Just (basename ++ \".\") }\n             hsc_env = hsc_env0 {hsc_dflags = dflags}\n\n             (input_basename, suffix) = splitExtension input_fn\n             suffix' = drop 1 suffix -- strip off the .\n             basename | Just b <- mb_basename = b\n                      | otherwise             = input_basename\n\n             -- If we were given a -x flag, then use that phase to start from\n             start_phase = fromMaybe (RealPhase (startPhase suffix')) mb_phase\n\n             isHaskell (RealPhase (Unlit _)) = True\n             isHaskell (RealPhase (Cpp   _)) = True\n             isHaskell (RealPhase (HsPp  _)) = True\n             isHaskell (RealPhase (Hsc   _)) = True\n             isHaskell (HscOut {})           = True\n             isHaskell _                     = False\n\n             isHaskellishFile = isHaskell start_phase\n\n             env = PipeEnv{ stop_phase,\n                            src_filename = input_fn,\n                            src_basename = basename,\n                            src_suffix = suffix',\n                            output_spec = output }\n\n         when (isBackpackishSuffix suffix') $\n           throwGhcExceptionIO (UsageError\n                       (\"use --backpack to process \" ++ input_fn))\n\n         -- We want to catch cases of \"you can't get there from here\" before\n         -- we start the pipeline, because otherwise it will just run off the\n         -- end.\n         let happensBefore' = happensBefore dflags\n         case start_phase of\n             RealPhase start_phase' ->\n                 -- See Note [Partial ordering on phases]\n                 -- Not the same as: (stop_phase `happensBefore` start_phase')\n                 when (not (start_phase' `happensBefore'` stop_phase ||\n                            start_phase' `eqPhase` stop_phase)) $\n                       throwGhcExceptionIO (UsageError\n                                   (\"cannot compile this file to desired target: \"\n                                      ++ input_fn))\n             HscOut {} -> return ()\n\n         debugTraceMsg dflags 4 (text \"Running the pipeline\")\n         r <- runPipeline' start_phase hsc_env env input_fn\n                           maybe_loc foreign_os\n\n         -- If we are compiling a Haskell module, and doing\n         -- -dynamic-too, but couldn't do the -dynamic-too fast\n         -- path, then rerun the pipeline for the dyn way\n         let dflags = hsc_dflags hsc_env\n         -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)\n         when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $ do\n           when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do\n               debugTraceMsg dflags 4\n                   (text \"Running the pipeline again for -dynamic-too\")\n               let dflags' = dynamicTooMkDynamicDynFlags dflags\n               hsc_env' <- newHscEnv dflags'\n               _ <- runPipeline' start_phase hsc_env' env input_fn\n                                 maybe_loc foreign_os\n               return ()\n         return r\n\nrunPipeline'\n  :: PhasePlus                  -- ^ When to start\n  -> HscEnv                     -- ^ Compilation environment\n  -> PipeEnv\n  -> FilePath                   -- ^ Input filename\n  -> Maybe ModLocation          -- ^ A ModLocation, if this is a Haskell module\n  -> [FilePath]                 -- ^ foreign objects, if we have one\n  -> IO (DynFlags, FilePath)    -- ^ (final flags, output filename)\nrunPipeline' start_phase hsc_env env input_fn\n             maybe_loc foreign_os\n  = do\n  -- Execute the pipeline...\n  let state = PipeState{ hsc_env, maybe_loc, foreign_os = foreign_os }\n\n  evalP (pipeLoop start_phase input_fn) env state\n\n-- ---------------------------------------------------------------------------\n-- outer pipeline loop\n\n-- | pipeLoop runs phases until we reach the stop phase\npipeLoop :: PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)\npipeLoop phase input_fn = do\n  env <- getPipeEnv\n  dflags <- getDynFlags\n  -- See Note [Partial ordering on phases]\n  let happensBefore' = happensBefore dflags\n      stopPhase = stop_phase env\n  case phase of\n   RealPhase realPhase | realPhase `eqPhase` stopPhase            -- All done\n     -> -- Sometimes, a compilation phase doesn't actually generate any output\n        -- (eg. the CPP phase when -fcpp is not turned on).  If we end on this\n        -- stage, but we wanted to keep the output, then we have to explicitly\n        -- copy the file, remembering to prepend a {-# LINE #-} pragma so that\n        -- further compilation stages can tell what the original filename was.\n        case output_spec env of\n        Temporary _ ->\n            return (dflags, input_fn)\n        output ->\n            do pst <- getPipeState\n               final_fn <- liftIO $ getOutputFilename\n                                        stopPhase output (src_basename env)\n                                        dflags stopPhase (maybe_loc pst)\n               when (final_fn /= input_fn) $ do\n                  let msg = (\"Copying `\" ++ input_fn ++\"' to `\" ++ final_fn ++ \"'\")\n                      line_prag = Just (\"{-# LINE 1 \\\"\" ++ src_filename env ++ \"\\\" #-}\\n\")\n                  liftIO $ copyWithHeader dflags msg line_prag input_fn final_fn\n               return (dflags, final_fn)\n\n\n     | not (realPhase `happensBefore'` stopPhase)\n        -- Something has gone wrong.  We'll try to cover all the cases when\n        -- this could happen, so if we reach here it is a panic.\n        -- eg. it might happen if the -C flag is used on a source file that\n        -- has {-# OPTIONS -fasm #-}.\n     -> panic (\"pipeLoop: at phase \" ++ show realPhase ++\n           \" but I wanted to stop at phase \" ++ show stopPhase)\n\n   _\n     -> do liftIO $ debugTraceMsg dflags 4\n                                  (text \"Running phase\" <+> ppr phase)\n           (next_phase, output_fn) <- runHookedPhase phase input_fn dflags\n           r <- pipeLoop next_phase output_fn\n           case phase of\n               HscOut {} ->\n                   whenGeneratingDynamicToo dflags $ do\n                       setDynFlags $ dynamicTooMkDynamicDynFlags dflags\n                       -- TODO shouldn't ignore result:\n                       _ <- pipeLoop phase input_fn\n                       return ()\n               _ ->\n                   return ()\n           return r\n\nrunHookedPhase :: PhasePlus -> FilePath -> DynFlags\n               -> CompPipeline (PhasePlus, FilePath)\nrunHookedPhase pp input dflags =\n  lookupHook runPhaseHook runPhase dflags pp input dflags\n\n-- -----------------------------------------------------------------------------\n-- In each phase, we need to know into what filename to generate the\n-- output.  All the logic about which filenames we generate output\n-- into is embodied in the following function.\n\n-- | Computes the next output filename after we run @next_phase@.\n-- Like 'getOutputFilename', but it operates in the 'CompPipeline' monad\n-- (which specifies all of the ambient information.)\nphaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath\nphaseOutputFilename next_phase = do\n  PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv\n  PipeState{maybe_loc, hsc_env} <- getPipeState\n  let dflags = hsc_dflags hsc_env\n  liftIO $ getOutputFilename stop_phase output_spec\n                             src_basename dflags next_phase maybe_loc\n\n-- | Computes the next output filename for something in the compilation\n-- pipeline.  This is controlled by several variables:\n--\n--      1. 'Phase': the last phase to be run (e.g. 'stopPhase').  This\n--         is used to tell if we're in the last phase or not, because\n--         in that case flags like @-o@ may be important.\n--      2. 'PipelineOutput': is this intended to be a 'Temporary' or\n--         'Persistent' build output?  Temporary files just go in\n--         a fresh temporary name.\n--      3. 'String': what was the basename of the original input file?\n--      4. 'DynFlags': the obvious thing\n--      5. 'Phase': the phase we want to determine the output filename of.\n--      6. @Maybe ModLocation@: the 'ModLocation' of the module we're\n--         compiling; this can be used to override the default output\n--         of an object file.  (TODO: do we actually need this?)\ngetOutputFilename\n  :: Phase -> PipelineOutput -> String\n  -> DynFlags -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath\ngetOutputFilename stop_phase output basename dflags next_phase maybe_location\n | is_last_phase, Persistent   <- output = persistent_fn\n | is_last_phase, SpecificFile <- output = case outputFile dflags of\n                                           Just f -> return f\n                                           Nothing ->\n                                               panic \"SpecificFile: No filename\"\n | keep_this_output                      = persistent_fn\n | Temporary lifetime <- output          = newTempName dflags lifetime suffix\n | otherwise                             = newTempName dflags TFL_CurrentModule\n   suffix\n    where\n          hcsuf      = hcSuf dflags\n          odir       = objectDir dflags\n          osuf       = objectSuf dflags\n          keep_hc    = gopt Opt_KeepHcFiles dflags\n          keep_hscpp = gopt Opt_KeepHscppFiles dflags\n          keep_s     = gopt Opt_KeepSFiles dflags\n          keep_bc    = gopt Opt_KeepLlvmFiles dflags\n\n          myPhaseInputExt HCc       = hcsuf\n          myPhaseInputExt MergeForeign = osuf\n          myPhaseInputExt StopLn    = osuf\n          myPhaseInputExt other     = phaseInputExt other\n\n          is_last_phase = next_phase `eqPhase` stop_phase\n\n          -- sometimes, we keep output from intermediate stages\n          keep_this_output =\n               case next_phase of\n                       As _    | keep_s     -> True\n                       LlvmOpt | keep_bc    -> True\n                       HCc     | keep_hc    -> True\n                       HsPp _  | keep_hscpp -> True   -- See Trac #10869\n                       _other               -> False\n\n          suffix = myPhaseInputExt next_phase\n\n          -- persistent object files get put in odir\n          persistent_fn\n             | StopLn <- next_phase = return odir_persistent\n             | otherwise            = return persistent\n\n          persistent = basename <.> suffix\n\n          odir_persistent\n             | Just loc <- maybe_location = ml_obj_file loc\n             | Just d <- odir = d </> persistent\n             | otherwise      = persistent\n\n\n-- | The fast LLVM Pipeline skips the mangler and assembler,\n-- emitting object code directly from llc.\n--\n-- slow: opt -> llc -> .s -> mangler -> as -> .o\n-- fast: opt -> llc -> .o\n--\n-- hidden flag: -ffast-llvm\n--\n-- if keep-s-files is specified, we need to go through\n-- the slow pipeline (Kavon Farvardin requested this).\nfastLlvmPipeline :: DynFlags -> Bool\nfastLlvmPipeline dflags\n  = not (gopt Opt_KeepSFiles dflags) && gopt Opt_FastLlvm dflags\n\n-- | LLVM Options. These are flags to be passed to opt and llc, to ensure\n-- consistency we list them in pairs, so that they form groups.\nllvmOptions :: DynFlags\n            -> [(String, String)]  -- ^ pairs of (opt, llc) arguments\nllvmOptions dflags =\n       [(\"-enable-tbaa -tbaa\",  \"-enable-tbaa\") | gopt Opt_LlvmTBAA dflags ]\n    ++ [(\"-relocation-model=\" ++ rmodel\n        ,\"-relocation-model=\" ++ rmodel) | not (null rmodel)]\n    ++ [(\"-stack-alignment=\" ++ (show align)\n        ,\"-stack-alignment=\" ++ (show align)) | align > 0 ]\n    ++ [(\"\", \"-filetype=obj\") | fastLlvmPipeline dflags ]\n\n    -- Additional llc flags\n    ++ [(\"\", \"-mcpu=\" ++ mcpu)   | not (null mcpu)\n                                 , not (any (isInfixOf \"-mcpu\") (getOpts dflags opt_lc)) ]\n    ++ [(\"\", \"-mattr=\" ++ attrs) | not (null attrs) ]\n\n  where target = LLVM_TARGET\n        Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets dflags)\n\n        -- Relocation models\n        rmodel | gopt Opt_PIC dflags        = \"pic\"\n               | positionIndependent dflags = \"pic\"\n               | WayDyn `elem` ways dflags  = \"dynamic-no-pic\"\n               | otherwise                  = \"static\"\n\n        align :: Int\n        align = case platformArch (targetPlatform dflags) of\n                  ArchX86_64 | isAvxEnabled dflags -> 32\n                  _                                -> 0\n\n        attrs :: String\n        attrs = intercalate \",\" $ mattr\n              ++ [\"+sse42\"   | isSse4_2Enabled dflags   ]\n              ++ [\"+sse2\"    | isSse2Enabled dflags     ]\n              ++ [\"+sse\"     | isSseEnabled dflags      ]\n              ++ [\"+avx512f\" | isAvx512fEnabled dflags  ]\n              ++ [\"+avx2\"    | isAvx2Enabled dflags     ]\n              ++ [\"+avx\"     | isAvxEnabled dflags      ]\n              ++ [\"+avx512cd\"| isAvx512cdEnabled dflags ]\n              ++ [\"+avx512er\"| isAvx512erEnabled dflags ]\n              ++ [\"+avx512pf\"| isAvx512pfEnabled dflags ]\n              ++ [\"+bmi\"     | isBmiEnabled dflags      ]\n              ++ [\"+bmi2\"    | isBmi2Enabled dflags     ]\n\n-- -----------------------------------------------------------------------------\n-- | Each phase in the pipeline returns the next phase to execute, and the\n-- name of the file in which the output was placed.\n--\n-- We must do things dynamically this way, because we often don't know\n-- what the rest of the phases will be until part-way through the\n-- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning\n-- of a source file can change the latter stages of the pipeline from\n-- taking the LLVM route to using the native code generator.\n--\nrunPhase :: PhasePlus   -- ^ Run this phase\n         -> FilePath    -- ^ name of the input file\n         -> DynFlags    -- ^ for convenience, we pass the current dflags in\n         -> CompPipeline (PhasePlus,           -- next phase to run\n                          FilePath)            -- output filename\n\n        -- Invariant: the output filename always contains the output\n        -- Interesting case: Hsc when there is no recompilation to do\n        --                   Then the output filename is still a .o file\n\n\n-------------------------------------------------------------------------------\n-- Unlit phase\n\nrunPhase (RealPhase (Unlit sf)) input_fn dflags\n  = do\n       output_fn <- phaseOutputFilename (Cpp sf)\n\n       let flags = [ -- The -h option passes the file name for unlit to\n                     -- put in a #line directive\n                     SysTools.Option     \"-h\"\n                     -- See Note [Don't normalise input filenames].\n                   , SysTools.Option $ escape input_fn\n                   , SysTools.FileOption \"\" input_fn\n                   , SysTools.FileOption \"\" output_fn\n                   ]\n\n       liftIO $ SysTools.runUnlit dflags flags\n\n       return (RealPhase (Cpp sf), output_fn)\n  where\n       -- escape the characters \\, \", and ', but don't try to escape\n       -- Unicode or anything else (so we don't use Util.charToC\n       -- here).  If we get this wrong, then in\n       -- Coverage.isGoodTickSrcSpan where we check that the filename in\n       -- a SrcLoc is the same as the source filenaame, the two will\n       -- look bogusly different. See test:\n       -- libraries/hpc/tests/function/subdir/tough2.hs\n       escape ('\\\\':cs) = '\\\\':'\\\\': escape cs\n       escape ('\\\"':cs) = '\\\\':'\\\"': escape cs\n       escape ('\\'':cs) = '\\\\':'\\'': escape cs\n       escape (c:cs)    = c : escape cs\n       escape []        = []\n\n-------------------------------------------------------------------------------\n-- Cpp phase : (a) gets OPTIONS out of file\n--             (b) runs cpp if necessary\n\nrunPhase (RealPhase (Cpp sf)) input_fn dflags0\n  = do\n       src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn\n       (dflags1, unhandled_flags, warns)\n           <- liftIO $ parseDynamicFilePragma dflags0 src_opts\n       setDynFlags dflags1\n       liftIO $ checkProcessArgsResult dflags1 unhandled_flags\n\n       if not (xopt LangExt.Cpp dflags1) then do\n           -- we have to be careful to emit warnings only once.\n           unless (gopt Opt_Pp dflags1) $\n               liftIO $ handleFlagWarnings dflags1 warns\n\n           -- no need to preprocess CPP, just pass input file along\n           -- to the next phase of the pipeline.\n           return (RealPhase (HsPp sf), input_fn)\n        else do\n            output_fn <- phaseOutputFilename (HsPp sf)\n            liftIO $ doCpp dflags1 True{-raw-}\n                           input_fn output_fn\n            -- re-read the pragmas now that we've preprocessed the file\n            -- See #2464,#3457\n            src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn\n            (dflags2, unhandled_flags, warns)\n                <- liftIO $ parseDynamicFilePragma dflags0 src_opts\n            liftIO $ checkProcessArgsResult dflags2 unhandled_flags\n            unless (gopt Opt_Pp dflags2) $\n                liftIO $ handleFlagWarnings dflags2 warns\n            -- the HsPp pass below will emit warnings\n\n            setDynFlags dflags2\n\n            return (RealPhase (HsPp sf), output_fn)\n\n-------------------------------------------------------------------------------\n-- HsPp phase\n\nrunPhase (RealPhase (HsPp sf)) input_fn dflags\n  = do\n       if not (gopt Opt_Pp dflags) then\n           -- no need to preprocess, just pass input file along\n           -- to the next phase of the pipeline.\n          return (RealPhase (Hsc sf), input_fn)\n        else do\n            PipeEnv{src_basename, src_suffix} <- getPipeEnv\n            let orig_fn = src_basename <.> src_suffix\n            output_fn <- phaseOutputFilename (Hsc sf)\n            liftIO $ SysTools.runPp dflags\n                           ( [ SysTools.Option     orig_fn\n                             , SysTools.Option     input_fn\n                             , SysTools.FileOption \"\" output_fn\n                             ]\n                           )\n\n            -- re-read pragmas now that we've parsed the file (see #3674)\n            src_opts <- liftIO $ getOptionsFromFile dflags output_fn\n            (dflags1, unhandled_flags, warns)\n                <- liftIO $ parseDynamicFilePragma dflags src_opts\n            setDynFlags dflags1\n            liftIO $ checkProcessArgsResult dflags1 unhandled_flags\n            liftIO $ handleFlagWarnings dflags1 warns\n\n            return (RealPhase (Hsc sf), output_fn)\n\n-----------------------------------------------------------------------------\n-- Hsc phase\n\n-- Compilation of a single module, in \"legacy\" mode (_not_ under\n-- the direction of the compilation manager).\nrunPhase (RealPhase (Hsc src_flavour)) input_fn dflags0\n = do   -- normal Hsc mode, not mkdependHS\n\n        PipeEnv{ stop_phase=stop,\n                 src_basename=basename,\n                 src_suffix=suff } <- getPipeEnv\n\n  -- we add the current directory (i.e. the directory in which\n  -- the .hs files resides) to the include path, since this is\n  -- what gcc does, and it's probably what you want.\n        let current_dir = takeDirectory basename\n            new_includes = addQuoteInclude paths [current_dir]\n            paths = includePaths dflags0\n            dflags = dflags0 { includePaths = new_includes }\n\n        setDynFlags dflags\n\n  -- gather the imports and module name\n        (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do\n          do\n            buf <- hGetStringBuffer input_fn\n            (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)\n            return (Just buf, mod_name, imps, src_imps)\n\n  -- Take -o into account if present\n  -- Very like -ohi, but we must *only* do this if we aren't linking\n  -- (If we're linking then the -o applies to the linked thing, not to\n  -- the object file for one module.)\n  -- Note the nasty duplication with the same computation in compileFile above\n        location <- getLocation src_flavour mod_name\n\n        let o_file = ml_obj_file location -- The real object file\n            hi_file = ml_hi_file location\n            hie_file = ml_hie_file location\n            dest_file | writeInterfaceOnlyMode dflags\n                            = hi_file\n                      | otherwise\n                            = o_file\n\n  -- Figure out if the source has changed, for recompilation avoidance.\n  --\n  -- Setting source_unchanged to True means that M.o (or M.hie) seems\n  -- to be up to date wrt M.hs; so no need to recompile unless imports have\n  -- changed (which the compiler itself figures out).\n  -- Setting source_unchanged to False tells the compiler that M.o is out of\n  -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.\n        src_timestamp <- liftIO $ getModificationUTCTime (basename <.> suff)\n\n        source_unchanged <- liftIO $\n          if not (isStopLn stop)\n                -- SourceModified unconditionally if\n                --      (a) recompilation checker is off, or\n                --      (b) we aren't going all the way to .o file (e.g. ghc -S)\n             then return SourceModified\n                -- Otherwise look at file modification dates\n             else do dest_file_mod <- sourceModified dest_file src_timestamp\n                     hie_file_mod <- if gopt Opt_WriteHie dflags\n                                        then sourceModified hie_file\n                                                            src_timestamp\n                                        else pure False\n                     if dest_file_mod || hie_file_mod\n                        then return SourceModified\n                        else return SourceUnmodified\n\n        PipeState{hsc_env=hsc_env'} <- getPipeState\n\n  -- Tell the finder cache about this module\n        mod <- liftIO $ addHomeModuleToFinder hsc_env' mod_name location\n\n  -- Make the ModSummary to hand to hscMain\n        let\n            mod_summary = ModSummary {  ms_mod       = mod,\n                                        ms_hsc_src   = src_flavour,\n                                        ms_hspp_file = input_fn,\n                                        ms_hspp_opts = dflags,\n                                        ms_hspp_buf  = hspp_buf,\n                                        ms_location  = location,\n                                        ms_hs_date   = src_timestamp,\n                                        ms_obj_date  = Nothing,\n                                        ms_parsed_mod   = Nothing,\n                                        ms_iface_date   = Nothing,\n                                        ms_hie_date     = Nothing,\n                                        ms_textual_imps = imps,\n                                        ms_srcimps      = src_imps }\n\n  -- run the compiler!\n        let msg hsc_env _ what _ = oneShotMsg hsc_env what\n        (result, _) <- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'\n                            mod_summary source_unchanged Nothing (1,1)\n\n        return (HscOut src_flavour mod_name result,\n                panic \"HscOut doesn't have an input filename\")\n\nrunPhase (HscOut src_flavour mod_name result) _ dflags = do\n        location <- getLocation src_flavour mod_name\n        setModLocation location\n\n        let o_file = ml_obj_file location -- The real object file\n            hsc_lang = hscTarget dflags\n            next_phase = hscPostBackendPhase src_flavour hsc_lang\n\n        case result of\n            HscNotGeneratingCode ->\n                return (RealPhase StopLn,\n                        panic \"No output filename from Hsc when no-code\")\n            HscUpToDate ->\n                do liftIO $ touchObjectFile dflags o_file\n                   -- The .o file must have a later modification date\n                   -- than the source file (else we wouldn't get Nothing)\n                   -- but we touch it anyway, to keep 'make' happy (we think).\n                   return (RealPhase StopLn, o_file)\n            HscUpdateBoot ->\n                do -- In the case of hs-boot files, generate a dummy .o-boot\n                   -- stamp file for the benefit of Make\n                   liftIO $ touchObjectFile dflags o_file\n                   return (RealPhase StopLn, o_file)\n            HscUpdateSig ->\n                do -- We need to create a REAL but empty .o file\n                   -- because we are going to attempt to put it in a library\n                   PipeState{hsc_env=hsc_env'} <- getPipeState\n                   let input_fn = expectJust \"runPhase\" (ml_hs_file location)\n                       basename = dropExtension input_fn\n                   liftIO $ compileEmptyStub dflags hsc_env' basename location mod_name\n                   return (RealPhase StopLn, o_file)\n            HscRecomp cgguts mod_summary\n              -> do output_fn <- phaseOutputFilename next_phase\n\n                    PipeState{hsc_env=hsc_env'} <- getPipeState\n\n                    (outputFilename, mStub, foreign_files) <- liftIO $\n                      hscGenHardCode hsc_env' cgguts mod_summary output_fn\n                    stub_o <- liftIO (mapM (compileStub hsc_env') mStub)\n                    foreign_os <- liftIO $\n                      mapM (uncurry (compileForeign hsc_env')) foreign_files\n                    setForeignOs (maybe [] return stub_o ++ foreign_os)\n\n                    return (RealPhase next_phase, outputFilename)\n\n-----------------------------------------------------------------------------\n-- Cmm phase\n\nrunPhase (RealPhase CmmCpp) input_fn dflags\n  = do\n       output_fn <- phaseOutputFilename Cmm\n       liftIO $ doCpp dflags False{-not raw-}\n                      input_fn output_fn\n       return (RealPhase Cmm, output_fn)\n\nrunPhase (RealPhase Cmm) input_fn dflags\n  = do\n        let hsc_lang = hscTarget dflags\n\n        let next_phase = hscPostBackendPhase HsSrcFile hsc_lang\n\n        output_fn <- phaseOutputFilename next_phase\n\n        PipeState{hsc_env} <- getPipeState\n\n        liftIO $ hscCompileCmmFile hsc_env input_fn output_fn\n\n        return (RealPhase next_phase, output_fn)\n\n-----------------------------------------------------------------------------\n-- Cc phase\n\n-- we don't support preprocessing .c files (with -E) now.  Doing so introduces\n-- way too many hacks, and I can't say I've ever used it anyway.\n\nrunPhase (RealPhase cc_phase) input_fn dflags\n   | any (cc_phase `eqPhase`) [Cc, Ccxx, HCc, Cobjc, Cobjcxx]\n   = do\n        let platform = targetPlatform dflags\n            hcc = cc_phase `eqPhase` HCc\n\n        let cmdline_include_paths = includePaths dflags\n\n        -- HC files have the dependent packages stamped into them\n        pkgs <- if hcc then liftIO $ getHCFilePackages input_fn else return []\n\n        -- add package include paths even if we're just compiling .c\n        -- files; this is the Value Add(TM) that using ghc instead of\n        -- gcc gives you :)\n        pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs\n        let include_paths_global = foldr (\\ x xs -> (\"-I\" ++ x) : xs) []\n              (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)\n        let include_paths_quote = foldr (\\ x xs -> (\"-iquote\" ++ x) : xs) []\n              (includePathsQuote cmdline_include_paths)\n        let include_paths = include_paths_quote ++ include_paths_global\n\n        let gcc_extra_viac_flags = extraGccViaCFlags dflags\n        let pic_c_flags = picCCOpts dflags\n\n        let verbFlags = getVerbFlags dflags\n\n        -- cc-options are not passed when compiling .hc files.  Our\n        -- hc code doesn't not #include any header files anyway, so these\n        -- options aren't necessary.\n        pkg_extra_cc_opts <- liftIO $\n          if cc_phase `eqPhase` HCc\n             then return []\n             else getPackageExtraCcOpts dflags pkgs\n\n        framework_paths <-\n            if platformUsesFrameworks platform\n            then do pkgFrameworkPaths <- liftIO $ getPackageFrameworkPath dflags pkgs\n                    let cmdlineFrameworkPaths = frameworkPaths dflags\n                    return $ map (\"-F\"++)\n                                 (cmdlineFrameworkPaths ++ pkgFrameworkPaths)\n            else return []\n\n        let cc_opt | optLevel dflags >= 2 = [ \"-O2\" ]\n                   | optLevel dflags >= 1 = [ \"-O\" ]\n                   | otherwise            = []\n\n        -- Decide next phase\n        let next_phase = As False\n        output_fn <- phaseOutputFilename next_phase\n\n        let\n          more_hcc_opts =\n                -- on x86 the floating point regs have greater precision\n                -- than a double, which leads to unpredictable results.\n                -- By default, we turn this off with -ffloat-store unless\n                -- the user specified -fexcess-precision.\n                (if platformArch platform == ArchX86 &&\n                    not (gopt Opt_ExcessPrecision dflags)\n                        then [ \"-ffloat-store\" ]\n                        else []) ++\n\n                -- gcc's -fstrict-aliasing allows two accesses to memory\n                -- to be considered non-aliasing if they have different types.\n                -- This interacts badly with the C code we generate, which is\n                -- very weakly typed, being derived from C--.\n                [\"-fno-strict-aliasing\"]\n\n        ghcVersionH <- liftIO $ getGhcVersionPathName dflags\n\n        let gcc_lang_opt | cc_phase `eqPhase` Ccxx    = \"c++\"\n                         | cc_phase `eqPhase` Cobjc   = \"objective-c\"\n                         | cc_phase `eqPhase` Cobjcxx = \"objective-c++\"\n                         | otherwise                  = \"c\"\n        liftIO $ SysTools.runCc dflags (\n                -- force the C compiler to interpret this file as C when\n                -- compiling .hc files, by adding the -x c option.\n                -- Also useful for plain .c files, just in case GHC saw a\n                -- -x c option.\n                        [ SysTools.Option \"-x\", SysTools.Option gcc_lang_opt\n                        , SysTools.FileOption \"\" input_fn\n                        , SysTools.Option \"-o\"\n                        , SysTools.FileOption \"\" output_fn\n                        ]\n                       ++ map SysTools.Option (\n                          pic_c_flags\n\n                -- Stub files generated for foreign exports references the runIO_closure\n                -- and runNonIO_closure symbols, which are defined in the base package.\n                -- These symbols are imported into the stub.c file via RtsAPI.h, and the\n                -- way we do the import depends on whether we're currently compiling\n                -- the base package or not.\n                       ++ (if platformOS platform == OSMinGW32 &&\n                              thisPackage dflags == baseUnitId\n                                then [ \"-DCOMPILING_BASE_PACKAGE\" ]\n                                else [])\n\n        -- We only support SparcV9 and better because V8 lacks an atomic CAS\n        -- instruction. Note that the user can still override this\n        -- (e.g., -mcpu=ultrasparc) as GCC picks the \"best\" -mcpu flag\n        -- regardless of the ordering.\n        --\n        -- This is a temporary hack. See #2872, commit\n        -- 5bd3072ac30216a505151601884ac88bf404c9f2\n                       ++ (if platformArch platform == ArchSPARC\n                           then [\"-mcpu=v9\"]\n                           else [])\n\n                       -- GCC 4.6+ doesn't like -Wimplicit when compiling C++.\n                       ++ (if (cc_phase /= Ccxx && cc_phase /= Cobjcxx)\n                             then [\"-Wimplicit\"]\n                             else [])\n\n                       ++ (if hcc\n                             then gcc_extra_viac_flags ++ more_hcc_opts\n                             else [])\n                       ++ verbFlags\n                       ++ [ \"-S\" ]\n                       ++ cc_opt\n                       ++ [ \"-include\", ghcVersionH ]\n                       ++ framework_paths\n                       ++ include_paths\n                       ++ pkg_extra_cc_opts\n                       ))\n\n        return (RealPhase next_phase, output_fn)\n\n-----------------------------------------------------------------------------\n-- As, SpitAs phase : Assembler\n\n-- This is for calling the assembler on a regular assembly file\nrunPhase (RealPhase (As with_cpp)) input_fn dflags\n  = do\n        -- LLVM from version 3.0 onwards doesn't support the OS X system\n        -- assembler, so we use clang as the assembler instead. (#5636)\n        let whichAsProg | hscTarget dflags == HscLlvm &&\n                          platformOS (targetPlatform dflags) == OSDarwin\n                        = return SysTools.runClang\n                        | otherwise = return SysTools.runAs\n\n        as_prog <- whichAsProg\n        let cmdline_include_paths = includePaths dflags\n        let pic_c_flags = picCCOpts dflags\n\n        next_phase <- maybeMergeForeign\n        output_fn <- phaseOutputFilename next_phase\n\n        -- we create directories for the object file, because it\n        -- might be a hierarchical module.\n        liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)\n\n        ccInfo <- liftIO $ getCompilerInfo dflags\n        let global_includes = [ SysTools.Option (\"-I\" ++ p)\n                              | p <- includePathsGlobal cmdline_include_paths ]\n        let local_includes = [ SysTools.Option (\"-iquote\" ++ p)\n                             | p <- includePathsQuote cmdline_include_paths ]\n        let runAssembler inputFilename outputFilename\n                = liftIO $ as_prog dflags\n                       (local_includes ++ global_includes\n                       -- See Note [-fPIC for assembler]\n                       ++ map SysTools.Option pic_c_flags\n                       -- See Note [Produce big objects on Windows]\n                       ++ [ SysTools.Option \"-Wa,-mbig-obj\"\n                          | platformOS (targetPlatform dflags) == OSMinGW32\n                          , not $ target32Bit (targetPlatform dflags)\n                          ]\n\n        -- We only support SparcV9 and better because V8 lacks an atomic CAS\n        -- instruction so we have to make sure that the assembler accepts the\n        -- instruction set. Note that the user can still override this\n        -- (e.g., -mcpu=ultrasparc). GCC picks the \"best\" -mcpu flag\n        -- regardless of the ordering.\n        --\n        -- This is a temporary hack.\n                       ++ (if platformArch (targetPlatform dflags) == ArchSPARC\n                           then [SysTools.Option \"-mcpu=v9\"]\n                           else [])\n                       ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51]\n                            then [SysTools.Option \"-Qunused-arguments\"]\n                            else [])\n                       ++ [ SysTools.Option \"-x\"\n                          , if with_cpp\n                              then SysTools.Option \"assembler-with-cpp\"\n                              else SysTools.Option \"assembler\"\n                          , SysTools.Option \"-c\"\n                          , SysTools.FileOption \"\" inputFilename\n                          , SysTools.Option \"-o\"\n                          , SysTools.FileOption \"\" outputFilename\n                          ])\n\n        liftIO $ debugTraceMsg dflags 4 (text \"Running the assembler\")\n        runAssembler input_fn output_fn\n        return (RealPhase next_phase, output_fn)\n\n\n-----------------------------------------------------------------------------\n-- LlvmOpt phase\nrunPhase (RealPhase LlvmOpt) input_fn dflags\n  = do\n    output_fn <- phaseOutputFilename LlvmLlc\n\n    liftIO $ SysTools.runLlvmOpt dflags\n               (   optFlag\n                ++ defaultOptions ++\n                [ SysTools.FileOption \"\" input_fn\n                , SysTools.Option \"-o\"\n                , SysTools.FileOption \"\" output_fn]\n                )\n\n    return (RealPhase LlvmLlc, output_fn)\n  where\n        -- we always (unless -optlo specified) run Opt since we rely on it to\n        -- fix up some pretty big deficiencies in the code we generate\n        optIdx = max 0 $ min 2 $ optLevel dflags  -- ensure we're in [0,2]\n        llvmOpts = case lookup optIdx $ llvmPasses dflags of\n                    Just passes -> passes\n                    Nothing -> panic (\"runPhase LlvmOpt: llvm-passes file \"\n                                      ++ \"is missing passes for level \"\n                                      ++ show optIdx)\n\n        -- don't specify anything if user has specified commands. We do this\n        -- for opt but not llc since opt is very specifically for optimisation\n        -- passes only, so if the user is passing us extra options we assume\n        -- they know what they are doing and don't get in the way.\n        optFlag = if null (getOpts dflags opt_lo)\n                  then map SysTools.Option $ words llvmOpts\n                  else []\n\n        defaultOptions = map SysTools.Option . concat . fmap words . fst\n                       $ unzip (llvmOptions dflags)\n\n-----------------------------------------------------------------------------\n-- LlvmLlc phase\n\nrunPhase (RealPhase LlvmLlc) input_fn dflags\n  = do\n    next_phase <- if | fastLlvmPipeline dflags -> maybeMergeForeign\n                     -- hidden debugging flag '-dno-llvm-mangler' to skip mangling\n                     | gopt Opt_NoLlvmMangler dflags -> return (As False)\n                     | otherwise -> return LlvmMangle\n\n    output_fn <- phaseOutputFilename next_phase\n\n    liftIO $ SysTools.runLlvmLlc dflags\n                (  optFlag\n                ++ defaultOptions\n                ++ [ SysTools.FileOption \"\" input_fn\n                   , SysTools.Option \"-o\"\n                   , SysTools.FileOption \"\" output_fn\n                   ]\n                )\n\n    return (RealPhase next_phase, output_fn)\n  where\n    -- Note [Clamping of llc optimizations]\n    --\n    -- See #13724\n    --\n    -- we clamp the llc optimization between [1,2]. This is because passing -O0\n    -- to llc 3.9 or llc 4.0, the naive register allocator can fail with\n    --\n    --   Error while trying to spill R1 from class GPR: Cannot scavenge register\n    --   without an emergency spill slot!\n    --\n    -- Observed at least with target 'arm-unknown-linux-gnueabihf'.\n    --\n    --\n    -- With LLVM4, llc -O3 crashes when ghc-stage1 tries to compile\n    --   rts/HeapStackCheck.cmm\n    --\n    -- llc -O3 '-mtriple=arm-unknown-linux-gnueabihf' -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s\n    -- 0  llc                      0x0000000102ae63e8 llvm::sys::PrintStackTrace(llvm::raw_ostream&) + 40\n    -- 1  llc                      0x0000000102ae69a6 SignalHandler(int) + 358\n    -- 2  libsystem_platform.dylib 0x00007fffc23f4b3a _sigtramp + 26\n    -- 3  libsystem_c.dylib        0x00007fffc226498b __vfprintf + 17876\n    -- 4  llc                      0x00000001029d5123 llvm::SelectionDAGISel::LowerArguments(llvm::Function const&) + 5699\n    -- 5  llc                      0x0000000102a21a35 llvm::SelectionDAGISel::SelectAllBasicBlocks(llvm::Function const&) + 3381\n    -- 6  llc                      0x0000000102a202b1 llvm::SelectionDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 1457\n    -- 7  llc                      0x0000000101bdc474 (anonymous namespace)::ARMDAGToDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 20\n    -- 8  llc                      0x00000001025573a6 llvm::MachineFunctionPass::runOnFunction(llvm::Function&) + 134\n    -- 9  llc                      0x000000010274fb12 llvm::FPPassManager::runOnFunction(llvm::Function&) + 498\n    -- 10 llc                      0x000000010274fd23 llvm::FPPassManager::runOnModule(llvm::Module&) + 67\n    -- 11 llc                      0x00000001027501b8 llvm::legacy::PassManagerImpl::run(llvm::Module&) + 920\n    -- 12 llc                      0x000000010195f075 compileModule(char**, llvm::LLVMContext&) + 12133\n    -- 13 llc                      0x000000010195bf0b main + 491\n    -- 14 libdyld.dylib            0x00007fffc21e5235 start + 1\n    -- Stack dump:\n    -- 0.  Program arguments: llc -O3 -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s\n    -- 1.  Running pass 'Function Pass Manager' on module '/var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc'.\n    -- 2.  Running pass 'ARM Instruction Selection' on function '@\"stg_gc_f1$def\"'\n    --\n    -- Observed at least with -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa\n    --\n    llvmOpts = case optLevel dflags of\n      0 -> \"-O1\" -- required to get the non-naive reg allocator. Passing -regalloc=greedy is not sufficient.\n      1 -> \"-O1\"\n      _ -> \"-O2\"\n\n    optFlag = if null (getOpts dflags opt_lc)\n              then map SysTools.Option $ words llvmOpts\n              else []\n\n    defaultOptions = map SysTools.Option . concat . fmap words . snd\n                   $ unzip (llvmOptions dflags)\n\n\n-----------------------------------------------------------------------------\n-- LlvmMangle phase\n\nrunPhase (RealPhase LlvmMangle) input_fn dflags\n  = do\n      let next_phase = As False\n      output_fn <- phaseOutputFilename next_phase\n      liftIO $ llvmFixupAsm dflags input_fn output_fn\n      return (RealPhase next_phase, output_fn)\n\n-----------------------------------------------------------------------------\n-- merge in stub objects\n\nrunPhase (RealPhase MergeForeign) input_fn dflags\n = do\n     PipeState{foreign_os} <- getPipeState\n     output_fn <- phaseOutputFilename StopLn\n     liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)\n     if null foreign_os\n       then panic \"runPhase(MergeForeign): no foreign objects\"\n       else do\n         liftIO $ joinObjectFiles dflags (input_fn : foreign_os) output_fn\n         return (RealPhase StopLn, output_fn)\n\n-- warning suppression\nrunPhase (RealPhase other) _input_fn _dflags =\n   panic (\"runPhase: don't know how to run phase \" ++ show other)\n\nmaybeMergeForeign :: CompPipeline Phase\nmaybeMergeForeign\n = do\n     PipeState{foreign_os} <- getPipeState\n     if null foreign_os then return StopLn else return MergeForeign\n\ngetLocation :: HscSource -> ModuleName -> CompPipeline ModLocation\ngetLocation src_flavour mod_name = do\n    dflags <- getDynFlags\n\n    PipeEnv{ src_basename=basename,\n             src_suffix=suff } <- getPipeEnv\n    PipeState { maybe_loc=maybe_loc} <- getPipeState\n    case maybe_loc of\n        -- Build a ModLocation to pass to hscMain.\n        -- The source filename is rather irrelevant by now, but it's used\n        -- by hscMain for messages.  hscMain also needs\n        -- the .hi and .o filenames. If we already have a ModLocation\n        -- then simply update the extensions of the interface and object\n        -- files to match the DynFlags, otherwise use the logic in Finder.\n      Just l -> return $ l\n        { ml_hs_file = Just $ basename <.> suff\n        , ml_hi_file = ml_hi_file l -<.> hiSuf dflags\n        , ml_obj_file = ml_obj_file l -<.> objectSuf dflags\n        }\n      _ -> do\n        location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff\n\n        -- Boot-ify it if necessary\n        let location2\n              | HsBootFile <- src_flavour = addBootSuffixLocnOut location1\n              | otherwise                 = location1\n\n\n        -- Take -ohi into account if present\n        -- This can't be done in mkHomeModuleLocation because\n        -- it only applies to the module being compiles\n        let ohi = outputHi dflags\n            location3 | Just fn <- ohi = location2{ ml_hi_file = fn }\n                      | otherwise      = location2\n\n        -- Take -o into account if present\n        -- Very like -ohi, but we must *only* do this if we aren't linking\n        -- (If we're linking then the -o applies to the linked thing, not to\n        -- the object file for one module.)\n        -- Note the nasty duplication with the same computation in compileFile\n        -- above\n        let expl_o_file = outputFile dflags\n            location4 | Just ofile <- expl_o_file\n                      , isNoLink (ghcLink dflags)\n                      = location3 { ml_obj_file = ofile }\n                      | otherwise = location3\n        return location4\n\n-----------------------------------------------------------------------------\n-- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file\n\ngetHCFilePackages :: FilePath -> IO [InstalledUnitId]\ngetHCFilePackages filename =\n  Exception.bracket (openFile filename ReadMode) hClose $ \\h -> do\n    l <- hGetLine h\n    case l of\n      '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->\n          return (map stringToInstalledUnitId (words rest))\n      _other ->\n          return []\n\n-----------------------------------------------------------------------------\n-- Static linking, of .o files\n\n-- The list of packages passed to link is the list of packages on\n-- which this program depends, as discovered by the compilation\n-- manager.  It is combined with the list of packages that the user\n-- specifies on the command line with -package flags.\n--\n-- In one-shot linking mode, we can't discover the package\n-- dependencies (because we haven't actually done any compilation or\n-- read any interface files), so the user must explicitly specify all\n-- the packages.\n\n{-\nNote [-Xlinker -rpath vs -Wl,-rpath]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n-Wl takes a comma-separated list of options which in the case of\n-Wl,-rpath -Wl,some,path,with,commas parses the path with commas\nas separate options.\nBuck, the build system, produces paths with commas in them.\n\n-Xlinker doesn't have this disadvantage and as far as I can tell\nit is supported by both gcc and clang. Anecdotally nvcc supports\n-Xlinker, but not -Wl.\n-}\n\nlinkBinary :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()\nlinkBinary = linkBinary' False\n\nlinkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()\nlinkBinary' staticLink dflags o_files dep_packages = do\n    let platform = targetPlatform dflags\n        mySettings = settings dflags\n        verbFlags = getVerbFlags dflags\n        output_fn = exeFileName staticLink dflags\n\n    -- get the full list of packages to link with, by combining the\n    -- explicit packages with the auto packages and all of their\n    -- dependencies, and eliminating duplicates.\n\n    full_output_fn <- if isAbsolute output_fn\n                      then return output_fn\n                      else do d <- getCurrentDirectory\n                              return $ normalise (d </> output_fn)\n    pkg_lib_paths <- getPackageLibraryPath dflags dep_packages\n    let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths\n        get_pkg_lib_path_opts l\n         | osElfTarget (platformOS platform) &&\n           dynLibLoader dflags == SystemDependent &&\n           WayDyn `elem` ways dflags\n            = let libpath = if gopt Opt_RelativeDynlibPaths dflags\n                            then \"$ORIGIN\" </>\n                                 (l `makeRelativeTo` full_output_fn)\n                            else l\n                  -- See Note [-Xlinker -rpath vs -Wl,-rpath]\n                  rpath = if gopt Opt_RPath dflags\n                          then [\"-Xlinker\", \"-rpath\", \"-Xlinker\", libpath]\n                          else []\n                  -- Solaris 11's linker does not support -rpath-link option. It silently\n                  -- ignores it and then complains about next option which is -l<some\n                  -- dir> as being a directory and not expected object file, E.g\n                  -- ld: elf error: file\n                  -- /tmp/ghc-src/libraries/base/dist-install/build:\n                  -- elf_begin: I/O error: region read: Is a directory\n                  rpathlink = if (platformOS platform) == OSSolaris2\n                              then []\n                              else [\"-Xlinker\", \"-rpath-link\", \"-Xlinker\", l]\n              in [\"-L\" ++ l] ++ rpathlink ++ rpath\n         | osMachOTarget (platformOS platform) &&\n           dynLibLoader dflags == SystemDependent &&\n           WayDyn `elem` ways dflags &&\n           gopt Opt_RPath dflags\n            = let libpath = if gopt Opt_RelativeDynlibPaths dflags\n                            then \"@loader_path\" </>\n                                 (l `makeRelativeTo` full_output_fn)\n                            else l\n              in [\"-L\" ++ l] ++ [\"-Xlinker\", \"-rpath\", \"-Xlinker\", libpath]\n         | otherwise = [\"-L\" ++ l]\n\n    pkg_lib_path_opts <-\n      if gopt Opt_SingleLibFolder dflags\n      then do\n        libs <- getLibs dflags dep_packages\n        tmpDir <- newTempDir dflags\n        sequence_ [ copyFile lib (tmpDir </> basename)\n                  | (lib, basename) <- libs]\n        return [ \"-L\" ++ tmpDir ]\n      else pure pkg_lib_path_opts\n\n    let\n      dead_strip\n        | gopt Opt_WholeArchiveHsLibs dflags = []\n        | otherwise = if osSubsectionsViaSymbols (platformOS platform)\n                        then [\"-Wl,-dead_strip\"]\n                        else []\n    let lib_paths = libraryPaths dflags\n    let lib_path_opts = map (\"-L\"++) lib_paths\n\n    extraLinkObj <- mkExtraObjToLinkIntoBinary dflags\n    noteLinkObjs <- mkNoteObjsToLinkIntoBinary dflags dep_packages\n\n    let\n      (pre_hs_libs, post_hs_libs)\n        | gopt Opt_WholeArchiveHsLibs dflags\n        = if platformOS platform == OSDarwin\n            then ([\"-Wl,-all_load\"], [])\n              -- OS X does not have a flag to turn off -all_load\n            else ([\"-Wl,--whole-archive\"], [\"-Wl,--no-whole-archive\"])\n        | otherwise\n        = ([],[])\n\n    pkg_link_opts <- do\n        (package_hs_libs, extra_libs, other_flags) <- getPackageLinkOpts dflags dep_packages\n        return $ if staticLink\n            then package_hs_libs -- If building an executable really means making a static\n                                 -- library (e.g. iOS), then we only keep the -l options for\n                                 -- HS packages, because libtool doesn't accept other options.\n                                 -- In the case of iOS these need to be added by hand to the\n                                 -- final link in Xcode.\n            else other_flags ++ dead_strip\n                  ++ pre_hs_libs ++ package_hs_libs ++ post_hs_libs\n                  ++ extra_libs\n                 -- -Wl,-u,<sym> contained in other_flags\n                 -- needs to be put before -l<package>,\n                 -- otherwise Solaris linker fails linking\n                 -- a binary with unresolved symbols in RTS\n                 -- which are defined in base package\n                 -- the reason for this is a note in ld(1) about\n                 -- '-u' option: \"The placement of this option\n                 -- on the command line is significant.\n                 -- This option must be placed before the library\n                 -- that defines the symbol.\"\n\n    -- frameworks\n    pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages\n    let framework_opts = getFrameworkOpts dflags platform\n\n        -- probably _stub.o files\n    let extra_ld_inputs = ldInputs dflags\n\n    -- Here are some libs that need to be linked at the *end* of\n    -- the command line, because they contain symbols that are referred to\n    -- by the RTS.  We can't therefore use the ordinary way opts for these.\n    let debug_opts | WayDebug `elem` ways dflags = [\n#if defined(HAVE_LIBBFD)\n                        \"-lbfd\", \"-liberty\"\n#endif\n                         ]\n                   | otherwise                   = []\n\n        thread_opts | WayThreaded `elem` ways dflags = [\n#if NEED_PTHREAD_LIB\n                        \"-lpthread\"\n#endif\n                        ]\n                    | otherwise                      = []\n\n    rc_objs <- maybeCreateManifest dflags output_fn\n\n    let link = if staticLink\n                   then SysTools.runLibtool\n                   else SysTools.runLink\n    link dflags (\n                       map SysTools.Option verbFlags\n                      ++ [ SysTools.Option \"-o\"\n                         , SysTools.FileOption \"\" output_fn\n                         ]\n                      ++ libmLinkOpts\n                      ++ map SysTools.Option (\n                         []\n\n                      -- See Note [No PIE when linking]\n                      ++ picCCOpts dflags\n\n                      -- Permit the linker to auto link _symbol to _imp_symbol.\n                      -- This lets us link against DLLs without needing an \"import library\".\n                      ++ (if platformOS platform == OSMinGW32\n                          then [\"-Wl,--enable-auto-import\"]\n                          else [])\n\n                      -- '-no_compact_unwind'\n                      -- C++/Objective-C exceptions cannot use optimised\n                      -- stack unwinding code. The optimised form is the\n                      -- default in Xcode 4 on at least x86_64, and\n                      -- without this flag we're also seeing warnings\n                      -- like\n                      --     ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog\n                      -- on x86.\n                      ++ (if sLdSupportsCompactUnwind mySettings &&\n                             not staticLink &&\n                             (platformOS platform == OSDarwin) &&\n                             case platformArch platform of\n                               ArchX86 -> True\n                               ArchX86_64 -> True\n                               ArchARM {} -> True\n                               ArchARM64  -> True\n                               _ -> False\n                          then [\"-Wl,-no_compact_unwind\"]\n                          else [])\n\n                      -- '-Wl,-read_only_relocs,suppress'\n                      -- ld gives loads of warnings like:\n                      --     ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure\n                      -- when linking any program. We're not sure\n                      -- whether this is something we ought to fix, but\n                      -- for now this flags silences them.\n                      ++ (if platformOS   platform == OSDarwin &&\n                             platformArch platform == ArchX86 &&\n                             not staticLink\n                          then [\"-Wl,-read_only_relocs,suppress\"]\n                          else [])\n\n                      ++ (if sLdIsGnuLd mySettings &&\n                             not (gopt Opt_WholeArchiveHsLibs dflags)\n                          then [\"-Wl,--gc-sections\"]\n                          else [])\n\n                      ++ o_files\n                      ++ lib_path_opts)\n                      ++ extra_ld_inputs\n                      ++ map SysTools.Option (\n                         rc_objs\n                      ++ framework_opts\n                      ++ pkg_lib_path_opts\n                      ++ extraLinkObj:noteLinkObjs\n                      ++ pkg_link_opts\n                      ++ pkg_framework_opts\n                      ++ debug_opts\n                      ++ thread_opts\n                      ++ (if platformOS platform == OSDarwin\n                          then [ \"-Wl,-dead_strip_dylibs\" ]\n                          else [])\n                    ))\n\nexeFileName :: Bool -> DynFlags -> FilePath\nexeFileName staticLink dflags\n  | Just s <- outputFile dflags =\n      case platformOS (targetPlatform dflags) of\n          OSMinGW32 -> s <?.> \"exe\"\n          _         -> if staticLink\n                         then s <?.> \"a\"\n                         else s\n  | otherwise =\n      if platformOS (targetPlatform dflags) == OSMinGW32\n      then \"main.exe\"\n      else if staticLink\n           then \"liba.a\"\n           else \"a.out\"\n where s <?.> ext | null (takeExtension s) = s <.> ext\n                  | otherwise              = s\n\nmaybeCreateManifest\n   :: DynFlags\n   -> FilePath                          -- filename of executable\n   -> IO [FilePath]                     -- extra objects to embed, maybe\nmaybeCreateManifest dflags exe_filename\n | platformOS (targetPlatform dflags) == OSMinGW32 &&\n   gopt Opt_GenManifest dflags\n    = do let manifest_filename = exe_filename <.> \"manifest\"\n\n         writeFile manifest_filename $\n             \"<?xml version=\\\"1.0\\\" encoding=\\\"UTF-8\\\" standalone=\\\"yes\\\"?>\\n\"++\n             \"  <assembly xmlns=\\\"urn:schemas-microsoft-com:asm.v1\\\" manifestVersion=\\\"1.0\\\">\\n\"++\n             \"  <assemblyIdentity version=\\\"1.0.0.0\\\"\\n\"++\n             \"     processorArchitecture=\\\"X86\\\"\\n\"++\n             \"     name=\\\"\" ++ dropExtension exe_filename ++ \"\\\"\\n\"++\n             \"     type=\\\"win32\\\"/>\\n\\n\"++\n             \"  <trustInfo xmlns=\\\"urn:schemas-microsoft-com:asm.v3\\\">\\n\"++\n             \"    <security>\\n\"++\n             \"      <requestedPrivileges>\\n\"++\n             \"        <requestedExecutionLevel level=\\\"asInvoker\\\" uiAccess=\\\"false\\\"/>\\n\"++\n             \"        </requestedPrivileges>\\n\"++\n             \"       </security>\\n\"++\n             \"  </trustInfo>\\n\"++\n             \"</assembly>\\n\"\n\n         -- Windows will find the manifest file if it is named\n         -- foo.exe.manifest. However, for extra robustness, and so that\n         -- we can move the binary around, we can embed the manifest in\n         -- the binary itself using windres:\n         if not (gopt Opt_EmbedManifest dflags) then return [] else do\n\n         rc_filename <- newTempName dflags TFL_CurrentModule \"rc\"\n         rc_obj_filename <-\n           newTempName dflags TFL_GhcSession (objectSuf dflags)\n\n         writeFile rc_filename $\n             \"1 24 MOVEABLE PURE \" ++ show manifest_filename ++ \"\\n\"\n               -- magic numbers :-)\n               -- show is a bit hackish above, but we need to escape the\n               -- backslashes in the path.\n\n         runWindres dflags $ map SysTools.Option $\n               [\"--input=\"++rc_filename,\n                \"--output=\"++rc_obj_filename,\n                \"--output-format=coff\"]\n               -- no FileOptions here: windres doesn't like seeing\n               -- backslashes, apparently\n\n         removeFile manifest_filename\n\n         return [rc_obj_filename]\n | otherwise = return []\n\n\nlinkDynLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()\nlinkDynLibCheck dflags o_files dep_packages\n = do\n    when (haveRtsOptsFlags dflags) $ do\n      putLogMsg dflags NoReason SevInfo noSrcSpan\n          (defaultUserStyle dflags)\n          (text \"Warning: -rtsopts and -with-rtsopts have no effect with -shared.\" $$\n           text \"    Call hs_init_ghc() from your main() function to set these options.\")\n\n    linkDynLib dflags o_files dep_packages\n\n-- | Linking a static lib will not really link anything. It will merely produce\n-- a static archive of all dependent static libraries. The resulting library\n-- will still need to be linked with any remaining link flags.\nlinkStaticLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()\nlinkStaticLib dflags o_files dep_packages = do\n  let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]\n      modules = o_files ++ extra_ld_inputs\n      output_fn = exeFileName True dflags\n\n  full_output_fn <- if isAbsolute output_fn\n                    then return output_fn\n                    else do d <- getCurrentDirectory\n                            return $ normalise (d </> output_fn)\n  output_exists <- doesFileExist full_output_fn\n  (when output_exists) $ removeFile full_output_fn\n\n  pkg_cfgs <- getPreloadPackagesAnd dflags dep_packages\n  archives <- concat <$> mapM (collectArchives dflags) pkg_cfgs\n\n  ar <- foldl mappend\n        <$> (Archive <$> mapM loadObj modules)\n        <*> mapM loadAr archives\n\n  if sLdIsGnuLd (settings dflags)\n    then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar\n    else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar\n\n  -- run ranlib over the archive. write*Ar does *not* create the symbol index.\n  runRanlib dflags [SysTools.FileOption \"\" output_fn]\n\n-- -----------------------------------------------------------------------------\n-- Running CPP\n\ndoCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()\ndoCpp dflags raw input_fn output_fn = do\n    let hscpp_opts = picPOpts dflags\n    let cmdline_include_paths = includePaths dflags\n\n    pkg_include_dirs <- getPackageIncludePath dflags []\n    let include_paths_global = foldr (\\ x xs -> (\"-I\" ++ x) : xs) []\n          (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)\n    let include_paths_quote = foldr (\\ x xs -> (\"-iquote\" ++ x) : xs) []\n          (includePathsQuote cmdline_include_paths)\n    let include_paths = include_paths_quote ++ include_paths_global\n\n    let verbFlags = getVerbFlags dflags\n\n    let cpp_prog args | raw       = SysTools.runCpp dflags args\n                      | otherwise = SysTools.runCc dflags (SysTools.Option \"-E\" : args)\n\n    let target_defs =\n          [ \"-D\" ++ HOST_OS     ++ \"_BUILD_OS\",\n            \"-D\" ++ HOST_ARCH   ++ \"_BUILD_ARCH\",\n            \"-D\" ++ TARGET_OS   ++ \"_HOST_OS\",\n            \"-D\" ++ TARGET_ARCH ++ \"_HOST_ARCH\" ]\n        -- remember, in code we *compile*, the HOST is the same our TARGET,\n        -- and BUILD is the same as our HOST.\n\n    let sse_defs =\n          [ \"-D__SSE__\"      | isSseEnabled      dflags ] ++\n          [ \"-D__SSE2__\"     | isSse2Enabled     dflags ] ++\n          [ \"-D__SSE4_2__\"   | isSse4_2Enabled   dflags ]\n\n    let avx_defs =\n          [ \"-D__AVX__\"      | isAvxEnabled      dflags ] ++\n          [ \"-D__AVX2__\"     | isAvx2Enabled     dflags ] ++\n          [ \"-D__AVX512CD__\" | isAvx512cdEnabled dflags ] ++\n          [ \"-D__AVX512ER__\" | isAvx512erEnabled dflags ] ++\n          [ \"-D__AVX512F__\"  | isAvx512fEnabled  dflags ] ++\n          [ \"-D__AVX512PF__\" | isAvx512pfEnabled dflags ]\n\n    backend_defs <- getBackendDefs dflags\n\n    let th_defs = [ \"-D__GLASGOW_HASKELL_TH__\" ]\n    -- Default CPP defines in Haskell source\n    ghcVersionH <- getGhcVersionPathName dflags\n    let hsSourceCppOpts = [ \"-include\", ghcVersionH ]\n\n    -- MIN_VERSION macros\n    let uids = explicitPackages (pkgState dflags)\n        pkgs = catMaybes (map (lookupPackage dflags) uids)\n    mb_macro_include <-\n        if not (null pkgs) && gopt Opt_VersionMacros dflags\n            then do macro_stub <- newTempName dflags TFL_CurrentModule \"h\"\n                    writeFile macro_stub (generatePackageVersionMacros pkgs)\n                    -- Include version macros for every *exposed* package.\n                    -- Without -hide-all-packages and with a package database\n                    -- size of 1000 packages, it takes cpp an estimated 2\n                    -- milliseconds to process this file. See Trac #10970\n                    -- comment 8.\n                    return [SysTools.FileOption \"-include\" macro_stub]\n            else return []\n\n    cpp_prog       (   map SysTools.Option verbFlags\n                    ++ map SysTools.Option include_paths\n                    ++ map SysTools.Option hsSourceCppOpts\n                    ++ map SysTools.Option target_defs\n                    ++ map SysTools.Option backend_defs\n                    ++ map SysTools.Option th_defs\n                    ++ map SysTools.Option hscpp_opts\n                    ++ map SysTools.Option sse_defs\n                    ++ map SysTools.Option avx_defs\n                    ++ mb_macro_include\n        -- Set the language mode to assembler-with-cpp when preprocessing. This\n        -- alleviates some of the C99 macro rules relating to whitespace and the hash\n        -- operator, which we tend to abuse. Clang in particular is not very happy\n        -- about this.\n                    ++ [ SysTools.Option     \"-x\"\n                       , SysTools.Option     \"assembler-with-cpp\"\n                       , SysTools.Option     input_fn\n        -- We hackily use Option instead of FileOption here, so that the file\n        -- name is not back-slashed on Windows.  cpp is capable of\n        -- dealing with / in filenames, so it works fine.  Furthermore\n        -- if we put in backslashes, cpp outputs #line directives\n        -- with *double* backslashes.   And that in turn means that\n        -- our error messages get double backslashes in them.\n        -- In due course we should arrange that the lexer deals\n        -- with these \\\\ escapes properly.\n                       , SysTools.Option     \"-o\"\n                       , SysTools.FileOption \"\" output_fn\n                       ])\n\ngetBackendDefs :: DynFlags -> IO [String]\ngetBackendDefs dflags | hscTarget dflags == HscLlvm = do\n    llvmVer <- figureLlvmVersion dflags\n    return $ case llvmVer of\n               Just n -> [ \"-D__GLASGOW_HASKELL_LLVM__=\" ++ format n ]\n               _      -> []\n  where\n    format (major, minor)\n      | minor >= 100 = error \"getBackendDefs: Unsupported minor version\"\n      | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int\n\ngetBackendDefs _ =\n    return []\n\n-- ---------------------------------------------------------------------------\n-- Macros (cribbed from Cabal)\n\ngeneratePackageVersionMacros :: [PackageConfig] -> String\ngeneratePackageVersionMacros pkgs = concat\n  -- Do not add any C-style comments. See Trac #3389.\n  [ generateMacros \"\" pkgname version\n  | pkg <- pkgs\n  , let version = packageVersion pkg\n        pkgname = map fixchar (packageNameString pkg)\n  ]\n\nfixchar :: Char -> Char\nfixchar '-' = '_'\nfixchar c   = c\n\ngenerateMacros :: String -> String -> Version -> String\ngenerateMacros prefix name version =\n  concat\n  [\"#define \", prefix, \"VERSION_\",name,\" \",show (showVersion version),\"\\n\"\n  ,\"#define MIN_\", prefix, \"VERSION_\",name,\"(major1,major2,minor) (\\\\\\n\"\n  ,\"  (major1) <  \",major1,\" || \\\\\\n\"\n  ,\"  (major1) == \",major1,\" && (major2) <  \",major2,\" || \\\\\\n\"\n  ,\"  (major1) == \",major1,\" && (major2) == \",major2,\" && (minor) <= \",minor,\")\"\n  ,\"\\n\\n\"\n  ]\n  where\n    (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)\n\n-- ---------------------------------------------------------------------------\n-- join object files into a single relocatable object file, using ld -r\n\n{-\nNote [Produce big objects on Windows]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe Windows Portable Executable object format has a limit of 32k sections, which\nwe tend to blow through pretty easily. Thankfully, there is a \"big object\"\nextension, which raises this limit to 2^32. However, it must be explicitly\nenabled in the toolchain:\n\n * the assembler accepts the -mbig-obj flag, which causes it to produce a\n   bigobj-enabled COFF object.\n\n * the linker accepts the --oformat pe-bigobj-x86-64 flag. Despite what the name\n   suggests, this tells the linker to produce a bigobj-enabled COFF object, no a\n   PE executable.\n\nWe must enable bigobj output in a few places:\n\n * When merging object files (DriverPipeline.joinObjectFiles)\n\n * When assembling (DriverPipeline.runPhase (RealPhase As ...))\n\nUnfortunately the big object format is not supported on 32-bit targets so\nnone of this can be used in that case.\n-}\n\njoinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO ()\njoinObjectFiles dflags o_files output_fn = do\n  let mySettings = settings dflags\n      ldIsGnuLd = sLdIsGnuLd mySettings\n      osInfo = platformOS (targetPlatform dflags)\n      ld_r args cc = SysTools.runLink dflags ([\n                       SysTools.Option \"-nostdlib\",\n                       SysTools.Option \"-Wl,-r\"\n                     ]\n                        -- See Note [No PIE while linking] in DynFlags\n                     ++ (if sGccSupportsNoPie mySettings\n                          then [SysTools.Option \"-no-pie\"]\n                          else [])\n\n                     ++ (if any (cc ==) [Clang, AppleClang, AppleClang51]\n                          then []\n                          else [SysTools.Option \"-nodefaultlibs\"])\n                     ++ (if osInfo == OSFreeBSD\n                          then [SysTools.Option \"-L/usr/lib\"]\n                          else [])\n                        -- gcc on sparc sets -Wl,--relax implicitly, but\n                        -- -r and --relax are incompatible for ld, so\n                        -- disable --relax explicitly.\n                     ++ (if platformArch (targetPlatform dflags)\n                                `elem` [ArchSPARC, ArchSPARC64]\n                         && ldIsGnuLd\n                            then [SysTools.Option \"-Wl,-no-relax\"]\n                            else [])\n                        -- See Note [Produce big objects on Windows]\n                     ++ [ SysTools.Option \"-Wl,--oformat,pe-bigobj-x86-64\"\n                        | OSMinGW32 == osInfo\n                        , not $ target32Bit (targetPlatform dflags)\n                        ]\n                     ++ map SysTools.Option ld_build_id\n                     ++ [ SysTools.Option \"-o\",\n                          SysTools.FileOption \"\" output_fn ]\n                     ++ args)\n\n      -- suppress the generation of the .note.gnu.build-id section,\n      -- which we don't need and sometimes causes ld to emit a\n      -- warning:\n      ld_build_id | sLdSupportsBuildId mySettings = [\"-Wl,--build-id=none\"]\n                  | otherwise                     = []\n\n  ccInfo <- getCompilerInfo dflags\n  if ldIsGnuLd\n     then do\n          script <- newTempName dflags TFL_CurrentModule \"ldscript\"\n          cwd <- getCurrentDirectory\n          let o_files_abs = map (\\x -> \"\\\"\" ++ (cwd </> x) ++ \"\\\"\") o_files\n          writeFile script $ \"INPUT(\" ++ unwords o_files_abs ++ \")\"\n          ld_r [SysTools.FileOption \"\" script] ccInfo\n     else if sLdSupportsFilelist mySettings\n     then do\n          filelist <- newTempName dflags TFL_CurrentModule \"filelist\"\n          writeFile filelist $ unlines o_files\n          ld_r [SysTools.Option \"-Wl,-filelist\",\n                SysTools.FileOption \"-Wl,\" filelist] ccInfo\n     else do\n          ld_r (map (SysTools.FileOption \"\") o_files) ccInfo\n\n-- -----------------------------------------------------------------------------\n-- Misc.\n\nwriteInterfaceOnlyMode :: DynFlags -> Bool\nwriteInterfaceOnlyMode dflags =\n gopt Opt_WriteInterface dflags &&\n HscNothing == hscTarget dflags\n\n-- | Figure out if a source file was modified after an output file (or if we\n-- anyways need to consider the source file modified since the output is gone).\nsourceModified :: FilePath -- ^ destination file we are looking for\n               -> UTCTime  -- ^ last time of modification of source file\n               -> IO Bool  -- ^ do we need to regenerate the output?\nsourceModified dest_file src_timestamp = do\n  dest_file_exists <- doesFileExist dest_file\n  if not dest_file_exists\n    then return True       -- Need to recompile\n     else do t2 <- getModificationUTCTime dest_file\n             return (t2 <= src_timestamp)\n\n-- | What phase to run after one of the backend code generators has run\nhscPostBackendPhase :: HscSource -> HscTarget -> Phase\nhscPostBackendPhase HsBootFile _    =  StopLn\nhscPostBackendPhase HsigFile _      =  StopLn\nhscPostBackendPhase _ hsc_lang =\n  case hsc_lang of\n        HscC           -> HCc\n        HscAsm         -> As False\n        HscLlvm        -> LlvmOpt\n        HscNothing     -> StopLn\n        HscInterpreted -> StopLn\n\ntouchObjectFile :: DynFlags -> FilePath -> IO ()\ntouchObjectFile dflags path = do\n  createDirectoryIfMissing True $ takeDirectory path\n  SysTools.touch dflags \"Touching object file\" path\n\n-- | Find out path to @ghcversion.h@ file\ngetGhcVersionPathName :: DynFlags -> IO FilePath\ngetGhcVersionPathName dflags = do\n  candidates <- case ghcVersionFile dflags of\n    Just path -> return [path]\n    Nothing -> (map (</> \"ghcversion.h\")) <$>\n               (getPackageIncludePath dflags [toInstalledUnitId rtsUnitId])\n\n  found <- filterM doesFileExist candidates\n  case found of\n      []    -> throwGhcExceptionIO (InstallationError\n                                    (\"ghcversion.h missing; tried: \"\n                                      ++ intercalate \", \" candidates))\n      (x:_) -> return x\n\n-- Note [-fPIC for assembler]\n-- When compiling .c source file GHC's driver pipeline basically\n-- does the following two things:\n--   1. ${CC}              -S 'PIC_CFLAGS' source.c\n--   2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S\n--\n-- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler?\n-- Because on some architectures (at least sparc32) assembler also chooses\n-- the relocation type!\n-- Consider the following C module:\n--\n--     /* pic-sample.c */\n--     int v;\n--     void set_v (int n) { v = n; }\n--     int  get_v (void)  { return v; }\n--\n--     $ gcc -S -fPIC pic-sample.c\n--     $ gcc -c       pic-sample.s -o pic-sample.no-pic.o # incorrect binary\n--     $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o    # correct binary\n--\n--     $ objdump -r -d pic-sample.pic.o    > pic-sample.pic.o.od\n--     $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od\n--     $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od\n--\n-- Most of architectures won't show any difference in this test, but on sparc32\n-- the following assembly snippet:\n--\n--    sethi   %hi(_GLOBAL_OFFSET_TABLE_-8), %l7\n--\n-- generates two kinds or relocations, only 'R_SPARC_PC22' is correct:\n--\n--       3c:  2f 00 00 00     sethi  %hi(0), %l7\n--    -                       3c: R_SPARC_PC22        _GLOBAL_OFFSET_TABLE_-0x8\n--    +                       3c: R_SPARC_HI22        _GLOBAL_OFFSET_TABLE_-0x8\n\n{- Note [Don't normalise input filenames]\n\nSummary\n  We used to normalise input filenames when starting the unlit phase. This\n  broke hpc in `--make` mode with imported literate modules (#2991).\n\nIntroduction\n  1) --main\n  When compiling a module with --main, GHC scans its imports to find out which\n  other modules it needs to compile too. It turns out that there is a small\n  difference between saying `ghc --make A.hs`, when `A` imports `B`, and\n  specifying both modules on the command line with `ghc --make A.hs B.hs`. In\n  the former case, the filename for B is inferred to be './B.hs' instead of\n  'B.hs'.\n\n  2) unlit\n  When GHC compiles a literate haskell file, the source code first needs to go\n  through unlit, which turns it into normal Haskell source code. At the start\n  of the unlit phase, in `Driver.Pipeline.runPhase`, we call unlit with the\n  option `-h` and the name of the original file. We used to normalise this\n  filename using System.FilePath.normalise, which among other things removes\n  an initial './'. unlit then uses that filename in #line directives that it\n  inserts in the transformed source code.\n\n  3) SrcSpan\n  A SrcSpan represents a portion of a source code file. It has fields\n  linenumber, start column, end column, and also a reference to the file it\n  originated from. The SrcSpans for a literate haskell file refer to the\n  filename that was passed to unlit -h.\n\n  4) -fhpc\n  At some point during compilation with -fhpc, in the function\n  `deSugar.Coverage.isGoodTickSrcSpan`, we compare the filename that a\n  `SrcSpan` refers to with the name of the file we are currently compiling.\n  For some reason I don't yet understand, they can sometimes legitimally be\n  different, and then hpc ignores that SrcSpan.\n\nProblem\n  When running `ghc --make -fhpc A.hs`, where `A.hs` imports the literate\n  module `B.lhs`, `B` is inferred to be in the file `./B.lhs` (1). At the\n  start of the unlit phase, the name `./B.lhs` is normalised to `B.lhs` (2).\n  Therefore the SrcSpans of `B` refer to the file `B.lhs` (3), but we are\n  still compiling `./B.lhs`. Hpc thinks these two filenames are different (4),\n  doesn't include ticks for B, and we have unhappy customers (#2991).\n\nSolution\n  Do not normalise `input_fn` when starting the unlit phase.\n\nAlternative solution\n  Another option would be to not compare the two filenames on equality, but to\n  use System.FilePath.equalFilePath. That function first normalises its\n  arguments. The problem is that by the time we need to do the comparison, the\n  filenames have been turned into FastStrings, probably for performance\n  reasons, so System.FilePath.equalFilePath can not be used directly.\n\nArcheology\n  The call to `normalise` was added in a commit called \"Fix slash\n  direction on Windows with the new filePath code\" (c9b6b5e8). The problem\n  that commit was addressing has since been solved in a different manner, in a\n  commit called \"Fix the filename passed to unlit\" (1eedbc6b). So the\n  `normalise` is no longer necessary.\n-}\n", "num_lines": 2273}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash #-}\n\n-- | Dynamically lookup up values from modules and loading them.\nmodule DynamicLoading (\n        initializePlugins,\n#if defined(GHCI)\n        -- * Loading plugins\n        loadFrontendPlugin,\n\n        -- * Force loading information\n        forceLoadModuleInterfaces,\n        forceLoadNameModuleInterface,\n        forceLoadTyCon,\n\n        -- * Finding names\n        lookupRdrNameInModuleForPlugins,\n\n        -- * Loading values\n        getValueSafely,\n        getHValueSafely,\n        lessUnsafeCoerce\n#else\n        pluginError\n#endif\n    ) where\n\nimport GhcPrelude\nimport DynFlags\n\n#if defined(GHCI)\nimport Linker           ( linkModule, getHValue )\nimport GHCi             ( wormhole )\nimport SrcLoc           ( noSrcSpan )\nimport Finder           ( findPluginModule, cannotFindModule )\nimport TcRnMonad        ( initTcInteractive, initIfaceTcRn )\nimport LoadIface        ( loadPluginInterface )\nimport RdrName          ( RdrName, ImportSpec(..), ImpDeclSpec(..)\n                        , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName\n                        , gre_name, mkRdrQual )\nimport OccName          ( OccName, mkVarOcc )\nimport RnNames          ( gresFromAvails )\nimport Plugins\nimport PrelNames        ( pluginTyConName, frontendPluginTyConName )\n\nimport HscTypes\nimport GHCi.RemoteTypes ( HValue )\nimport Type             ( Type, eqType, mkTyConTy, pprTyThingCategory )\nimport TyCon            ( TyCon )\nimport Name             ( Name, nameModule_maybe )\nimport Id               ( idType )\nimport Module           ( Module, ModuleName )\nimport Panic\nimport FastString\nimport ErrUtils\nimport Outputable\nimport Exception\nimport Hooks\n\nimport Control.Monad     ( when, unless )\nimport Data.Maybe        ( mapMaybe )\nimport GHC.Exts          ( unsafeCoerce# )\n\n#else\n\nimport HscTypes         ( HscEnv )\nimport Module           ( ModuleName, moduleNameString )\nimport Panic\n\nimport Data.List        ( intercalate )\nimport Control.Monad    ( unless )\n\n#endif\n\n-- | Loads the plugins specified in the pluginModNames field of the dynamic\n-- flags. Should be called after command line arguments are parsed, but before\n-- actual compilation starts. Idempotent operation. Should be re-called if\n-- pluginModNames or pluginModNameOpts changes.\ninitializePlugins :: HscEnv -> DynFlags -> IO DynFlags\n#if !defined(GHCI)\ninitializePlugins _ df\n  = do let pluginMods = pluginModNames df\n       unless (null pluginMods) (pluginError pluginMods)\n       return df\n#else\ninitializePlugins hsc_env df\n  | map lpModuleName (cachedPlugins df)\n         == pluginModNames df -- plugins not changed\n     && all (\\p -> paArguments (lpPlugin p)\n                       == argumentsForPlugin p (pluginModNameOpts df))\n            (cachedPlugins df) -- arguments not changed\n  = return df -- no need to reload plugins\n  | otherwise\n  = do loadedPlugins <- loadPlugins (hsc_env { hsc_dflags = df })\n       return $ df { cachedPlugins = loadedPlugins }\n  where argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)\n#endif\n\n\n#if defined(GHCI)\n\nloadPlugins :: HscEnv -> IO [LoadedPlugin]\nloadPlugins hsc_env\n  = do { unless (null to_load) $\n           checkExternalInterpreter hsc_env\n       ; plugins <- mapM loadPlugin to_load\n       ; return $ zipWith attachOptions to_load plugins }\n  where\n    dflags  = hsc_dflags hsc_env\n    to_load = pluginModNames dflags\n\n    attachOptions mod_nm (plug, mod) =\n        LoadedPlugin (PluginWithArgs plug (reverse options)) mod\n      where\n        options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags\n                            , opt_mod_nm == mod_nm ]\n    loadPlugin = loadPlugin' (mkVarOcc \"plugin\") pluginTyConName hsc_env\n\n\nloadFrontendPlugin :: HscEnv -> ModuleName -> IO FrontendPlugin\nloadFrontendPlugin hsc_env mod_name = do\n    checkExternalInterpreter hsc_env\n    fst <$> loadPlugin' (mkVarOcc \"frontendPlugin\") frontendPluginTyConName\n                hsc_env mod_name\n\n-- #14335\ncheckExternalInterpreter :: HscEnv -> IO ()\ncheckExternalInterpreter hsc_env =\n    when (gopt Opt_ExternalInterpreter dflags) $\n      throwCmdLineError $ showSDoc dflags $\n        text \"Plugins require -fno-external-interpreter\"\n  where\n    dflags = hsc_dflags hsc_env\n\nloadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface)\nloadPlugin' occ_name plugin_name hsc_env mod_name\n  = do { let plugin_rdr_name = mkRdrQual mod_name occ_name\n             dflags = hsc_dflags hsc_env\n       ; mb_name <- lookupRdrNameInModuleForPlugins hsc_env mod_name\n                        plugin_rdr_name\n       ; case mb_name of {\n            Nothing ->\n                throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep\n                          [ text \"The module\", ppr mod_name\n                          , text \"did not export the plugin name\"\n                          , ppr plugin_rdr_name ]) ;\n            Just (name, mod_iface) ->\n\n     do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name\n        ; mb_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)\n        ; case mb_plugin of\n            Nothing ->\n                throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep\n                          [ text \"The value\", ppr name\n                          , text \"did not have the type\"\n                          , ppr pluginTyConName, text \"as required\"])\n            Just plugin -> return (plugin, mod_iface) } } }\n\n\n-- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used\n-- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.\nforceLoadModuleInterfaces :: HscEnv -> SDoc -> [Module] -> IO ()\nforceLoadModuleInterfaces hsc_env doc modules\n    = (initTcInteractive hsc_env $\n       initIfaceTcRn $\n       mapM_ (loadPluginInterface doc) modules)\n      >> return ()\n\n-- | Force the interface for the module containing the name to be loaded. The 'SDoc' parameter is used\n-- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.\nforceLoadNameModuleInterface :: HscEnv -> SDoc -> Name -> IO ()\nforceLoadNameModuleInterface hsc_env reason name = do\n    let name_modules = mapMaybe nameModule_maybe [name]\n    forceLoadModuleInterfaces hsc_env reason name_modules\n\n-- | Load the 'TyCon' associated with the given name, come hell or high water. Fails if:\n--\n-- * The interface could not be loaded\n-- * The name is not that of a 'TyCon'\n-- * The name did not exist in the loaded module\nforceLoadTyCon :: HscEnv -> Name -> IO TyCon\nforceLoadTyCon hsc_env con_name = do\n    forceLoadNameModuleInterface hsc_env (text \"contains a name used in an invocation of loadTyConTy\") con_name\n\n    mb_con_thing <- lookupTypeHscEnv hsc_env con_name\n    case mb_con_thing of\n        Nothing -> throwCmdLineErrorS dflags $ missingTyThingError con_name\n        Just (ATyCon tycon) -> return tycon\n        Just con_thing -> throwCmdLineErrorS dflags $ wrongTyThingError con_name con_thing\n  where dflags = hsc_dflags hsc_env\n\n-- | Loads the value corresponding to a 'Name' if that value has the given 'Type'. This only provides limited safety\n-- in that it is up to the user to ensure that that type corresponds to the type you try to use the return value at!\n--\n-- If the value found was not of the correct type, returns @Nothing@. Any other condition results in an exception:\n--\n-- * If we could not load the names module\n-- * If the thing being loaded is not a value\n-- * If the Name does not exist in the module\n-- * If the link failed\n\ngetValueSafely :: HscEnv -> Name -> Type -> IO (Maybe a)\ngetValueSafely hsc_env val_name expected_type = do\n  mb_hval <- lookupHook getValueSafelyHook getHValueSafely dflags hsc_env val_name expected_type\n  case mb_hval of\n    Nothing   -> return Nothing\n    Just hval -> do\n      value <- lessUnsafeCoerce dflags \"getValueSafely\" hval\n      return (Just value)\n  where\n    dflags = hsc_dflags hsc_env\n\ngetHValueSafely :: HscEnv -> Name -> Type -> IO (Maybe HValue)\ngetHValueSafely hsc_env val_name expected_type = do\n    forceLoadNameModuleInterface hsc_env (text \"contains a name used in an invocation of getHValueSafely\") val_name\n    -- Now look up the names for the value and type constructor in the type environment\n    mb_val_thing <- lookupTypeHscEnv hsc_env val_name\n    case mb_val_thing of\n        Nothing -> throwCmdLineErrorS dflags $ missingTyThingError val_name\n        Just (AnId id) -> do\n            -- Check the value type in the interface against the type recovered from the type constructor\n            -- before finally casting the value to the type we assume corresponds to that constructor\n            if expected_type `eqType` idType id\n             then do\n                -- Link in the module that contains the value, if it has such a module\n                case nameModule_maybe val_name of\n                    Just mod -> do linkModule hsc_env mod\n                                   return ()\n                    Nothing ->  return ()\n                -- Find the value that we just linked in and cast it given that we have proved it's type\n                hval <- getHValue hsc_env val_name >>= wormhole dflags\n                return (Just hval)\n             else return Nothing\n        Just val_thing -> throwCmdLineErrorS dflags $ wrongTyThingError val_name val_thing\n   where dflags = hsc_dflags hsc_env\n\n-- | Coerce a value as usual, but:\n--\n-- 1) Evaluate it immediately to get a segfault early if the coercion was wrong\n--\n-- 2) Wrap it in some debug messages at verbosity 3 or higher so we can see what happened\n--    if it /does/ segfault\nlessUnsafeCoerce :: DynFlags -> String -> a -> IO b\nlessUnsafeCoerce dflags context what = do\n    debugTraceMsg dflags 3 $ (text \"Coercing a value in\") <+> (text context) <>\n                             (text \"...\")\n    output <- evaluate (unsafeCoerce# what)\n    debugTraceMsg dflags 3 (text \"Successfully evaluated coercion\")\n    return output\n\n\n-- | Finds the 'Name' corresponding to the given 'RdrName' in the\n-- context of the 'ModuleName'. Returns @Nothing@ if no such 'Name'\n-- could be found. Any other condition results in an exception:\n--\n-- * If the module could not be found\n-- * If we could not determine the imports of the module\n--\n-- Can only be used for looking up names while loading plugins (and is\n-- *not* suitable for use within plugins).  The interface file is\n-- loaded very partially: just enough that it can be used, without its\n-- rules and instances affecting (and being linked from!) the module\n-- being compiled.  This was introduced by 57d6798.\n--\n-- Need the module as well to record information in the interface file\nlookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName\n                                -> IO (Maybe (Name, ModIface))\nlookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do\n    -- First find the package the module resides in by searching exposed packages and home modules\n    found_module <- findPluginModule hsc_env mod_name\n    case found_module of\n        Found _ mod -> do\n            -- Find the exports of the module\n            (_, mb_iface) <- initTcInteractive hsc_env $\n                             initIfaceTcRn $\n                             loadPluginInterface doc mod\n            case mb_iface of\n                Just iface -> do\n                    -- Try and find the required name in the exports\n                    let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name\n                                                , is_qual = False, is_dloc = noSrcSpan }\n                        imp_spec = ImpSpec decl_spec ImpAll\n                        env = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) (mi_exports iface))\n                    case lookupGRE_RdrName rdr_name env of\n                        [gre] -> return (Just (gre_name gre, iface))\n                        []    -> return Nothing\n                        _     -> panic \"lookupRdrNameInModule\"\n\n                Nothing -> throwCmdLineErrorS dflags $ hsep [text \"Could not determine the exports of the module\", ppr mod_name]\n        err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err\n  where\n    dflags = hsc_dflags hsc_env\n    doc = text \"contains a name used in an invocation of lookupRdrNameInModule\"\n\nwrongTyThingError :: Name -> TyThing -> SDoc\nwrongTyThingError name got_thing = hsep [text \"The name\", ppr name, ptext (sLit \"is not that of a value but rather a\"), pprTyThingCategory got_thing]\n\nmissingTyThingError :: Name -> SDoc\nmissingTyThingError name = hsep [text \"The name\", ppr name, ptext (sLit \"is not in the type environment: are you sure it exists?\")]\n\nthrowCmdLineErrorS :: DynFlags -> SDoc -> IO a\nthrowCmdLineErrorS dflags = throwCmdLineError . showSDoc dflags\n\nthrowCmdLineError :: String -> IO a\nthrowCmdLineError = throwGhcExceptionIO . CmdLineError\n\n#else\n\npluginError :: [ModuleName] -> a\npluginError modnames = throwGhcException (CmdLineError msg)\n  where\n    msg = \"not built for interactive use - can't load plugins (\"\n            -- module names are not z-encoded\n          ++ intercalate \", \" (map moduleNameString modnames)\n          ++ \")\"\n\n#endif\n", "num_lines": 317}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-------------------------------------------------------------------------------\n--\n-- | Dynamic flags\n--\n-- Most flags are dynamic flags, which means they can change from compilation\n-- to compilation using @OPTIONS_GHC@ pragmas, and in a multi-session GHC each\n-- session can be using different dynamic flags. Dynamic flags can also be set\n-- at the prompt in GHCi.\n--\n-- (c) The University of Glasgow 2005\n--\n-------------------------------------------------------------------------------\n\n{-# OPTIONS_GHC -fno-cse #-}\n-- -fno-cse is needed for GLOBAL_VAR's to behave properly\n\nmodule DynFlags (\n        -- * Dynamic flags and associated configuration types\n        DumpFlag(..),\n        GeneralFlag(..),\n        WarningFlag(..), WarnReason(..),\n        Language(..),\n        PlatformConstants(..),\n        FatalMessager, LogAction, FlushOut(..), FlushErr(..),\n        ProfAuto(..),\n        glasgowExtsFlags,\n        warningGroups, warningHierarchies,\n        hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion,\n        dopt, dopt_set, dopt_unset,\n        gopt, gopt_set, gopt_unset, setGeneralFlag', unSetGeneralFlag',\n        wopt, wopt_set, wopt_unset,\n        wopt_fatal, wopt_set_fatal, wopt_unset_fatal,\n        xopt, xopt_set, xopt_unset,\n        xopt_set_unlessExplSpec,\n        lang_set,\n        useUnicodeSyntax,\n        useStarIsType,\n        whenGeneratingDynamicToo, ifGeneratingDynamicToo,\n        whenCannotGenerateDynamicToo,\n        dynamicTooMkDynamicDynFlags,\n        DynFlags(..),\n        FlagSpec(..),\n        HasDynFlags(..), ContainsDynFlags(..),\n        RtsOptsEnabled(..),\n        HscTarget(..), isObjectTarget, defaultObjectTarget,\n        targetRetainsAllBindings,\n        GhcMode(..), isOneShot,\n        GhcLink(..), isNoLink,\n        PackageFlag(..), PackageArg(..), ModRenaming(..),\n        packageFlagsChanged,\n        IgnorePackageFlag(..), TrustFlag(..),\n        PackageDBFlag(..), PkgConfRef(..),\n        Option(..), showOpt,\n        DynLibLoader(..),\n        fFlags, fLangFlags, xFlags,\n        wWarningFlags,\n        dynFlagDependencies,\n        tablesNextToCode, mkTablesNextToCode,\n        makeDynFlagsConsistent,\n        shouldUseColor,\n        shouldUseHexWordLiterals,\n        positionIndependent,\n        optimisationFlags,\n\n        Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays,\n        wayGeneralFlags, wayUnsetGeneralFlags,\n\n        thisPackage, thisComponentId, thisUnitIdInsts,\n\n        -- ** Log output\n        putLogMsg,\n\n        -- ** Safe Haskell\n        SafeHaskellMode(..),\n        safeHaskellOn, safeHaskellModeEnabled,\n        safeImportsOn, safeLanguageOn, safeInferOn,\n        packageTrustOn,\n        safeDirectImpsReq, safeImplicitImpsReq,\n        unsafeFlags, unsafeFlagsForInfer,\n\n        -- ** LLVM Targets\n        LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig,\n\n        -- ** System tool settings and locations\n        Settings(..),\n        targetPlatform, programName, projectVersion,\n        ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,\n        versionedAppDir,\n        extraGccViaCFlags, systemPackageConfig,\n        pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T,\n        pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc,\n        pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_i,\n        opt_P_signature,\n        opt_windres, opt_lo, opt_lc, opt_lcc,\n\n        -- ** Manipulating DynFlags\n        addPluginModuleName,\n        defaultDynFlags,                -- Settings -> DynFlags\n        defaultWays,\n        interpWays,\n        interpreterProfiled, interpreterDynamic,\n        initDynFlags,                   -- DynFlags -> IO DynFlags\n        defaultFatalMessager,\n        defaultLogAction,\n        defaultLogActionHPrintDoc,\n        defaultLogActionHPutStrDoc,\n        defaultFlushOut,\n        defaultFlushErr,\n\n        getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]\n        getVerbFlags,\n        updOptLevel,\n        setTmpDir,\n        setUnitId,\n        interpretPackageEnv,\n        canonicalizeHomeModule,\n        canonicalizeModuleIfHome,\n\n        -- ** Parsing DynFlags\n        parseDynamicFlagsCmdLine,\n        parseDynamicFilePragma,\n        parseDynamicFlagsFull,\n\n        -- ** Available DynFlags\n        allNonDeprecatedFlags,\n        flagsAll,\n        flagsDynamic,\n        flagsPackage,\n        flagsForCompletion,\n\n        supportedLanguagesAndExtensions,\n        languageExtensions,\n\n        -- ** DynFlags C compiler options\n        picCCOpts, picPOpts,\n\n        -- * Compiler configuration suitable for display to the user\n        compilerInfo,\n\n        rtsIsProfiled,\n        dynamicGhc,\n\n#include \"GHCConstantsHaskellExports.hs\"\n        bLOCK_SIZE_W,\n        wORD_SIZE_IN_BITS,\n        tAG_MASK,\n        mAX_PTR_TAG,\n        tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,\n\n        unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,\n\n        -- * SSE and AVX\n        isSseEnabled,\n        isSse2Enabled,\n        isSse4_2Enabled,\n        isBmiEnabled,\n        isBmi2Enabled,\n        isAvxEnabled,\n        isAvx2Enabled,\n        isAvx512cdEnabled,\n        isAvx512erEnabled,\n        isAvx512fEnabled,\n        isAvx512pfEnabled,\n\n        -- * Linker/compiler information\n        LinkerInfo(..),\n        CompilerInfo(..),\n\n        -- * File cleanup\n        FilesToClean(..), emptyFilesToClean,\n\n        -- * Include specifications\n        IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,\n\n\n        -- * Make use of the Cmm CFG\n        CfgWeights(..), backendMaintainsCfg\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Platform\nimport PlatformConstants\nimport Module\nimport PackageConfig\nimport {-# SOURCE #-} Plugins\nimport {-# SOURCE #-} Hooks\nimport {-# SOURCE #-} PrelNames ( mAIN )\nimport {-# SOURCE #-} Packages (PackageState, emptyPackageState)\nimport DriverPhases     ( Phase(..), phaseInputExt )\nimport Config\nimport CmdLineParser hiding (WarnReason(..))\nimport qualified CmdLineParser as Cmd\nimport Constants\nimport Panic\nimport qualified PprColour as Col\nimport Util\nimport Maybes\nimport MonadUtils\nimport qualified Pretty\nimport SrcLoc\nimport BasicTypes       ( IntWithInf, treatZeroAsInf )\nimport FastString\nimport Fingerprint\nimport Outputable\nimport Foreign.C        ( CInt(..) )\nimport System.IO.Unsafe ( unsafeDupablePerformIO )\nimport {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn\n                               , getCaretDiagnostic )\nimport Json\nimport SysTools.Terminal ( stderrSupportsAnsiColors )\nimport SysTools.BaseDir ( expandToolDir, expandTopDir )\n\nimport System.IO.Unsafe ( unsafePerformIO )\nimport Data.IORef\nimport Control.Arrow ((&&&))\nimport Control.Monad\nimport Control.Monad.Trans.Class\nimport Control.Monad.Trans.Writer\nimport Control.Monad.Trans.Reader\nimport Control.Monad.Trans.Except\nimport Control.Exception (throwIO)\n\nimport Data.Ord\nimport Data.Bits\nimport Data.Char\nimport Data.Int\nimport Data.List\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport Data.Set (Set)\nimport qualified Data.Set as Set\nimport Data.Word\nimport System.FilePath\nimport System.Directory\nimport System.Environment (getEnv, lookupEnv)\nimport System.IO\nimport System.IO.Error\nimport Text.ParserCombinators.ReadP hiding (char)\nimport Text.ParserCombinators.ReadP as R\n\nimport EnumSet (EnumSet)\nimport qualified EnumSet\n\nimport GHC.Foreign (withCString, peekCString)\nimport qualified GHC.LanguageExtensions as LangExt\n\n#if defined(GHCI)\nimport Foreign (Ptr) -- needed for 2nd stage\n#endif\n\n-- Note [Updating flag description in the User's Guide]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- If you modify anything in this file please make sure that your changes are\n-- described in the User's Guide. Please update the flag description in the\n-- users guide (docs/users_guide) whenever you add or change a flag.\n\n-- Note [Supporting CLI completion]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- The command line interface completion (in for example bash) is an easy way\n-- for the developer to learn what flags are available from GHC.\n-- GHC helps by separating which flags are available when compiling with GHC,\n-- and which flags are available when using GHCi.\n-- A flag is assumed to either work in both these modes, or only in one of them.\n-- When adding or changing a flag, please consider for which mode the flag will\n-- have effect, and annotate it accordingly. For Flags use defFlag, defGhcFlag,\n-- defGhciFlag, and for FlagSpec use flagSpec or flagGhciSpec.\n\n-- Note [Adding a language extension]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- There are a few steps to adding (or removing) a language extension,\n--\n--  * Adding the extension to GHC.LanguageExtensions\n--\n--    The Extension type in libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs\n--    is the canonical list of language extensions known by GHC.\n--\n--  * Adding a flag to DynFlags.xFlags\n--\n--    This is fairly self-explanatory. The name should be concise, memorable,\n--    and consistent with any previous implementations of the similar idea in\n--    other Haskell compilers.\n--\n--  * Adding the flag to the documentation\n--\n--    This is the same as any other flag. See\n--    Note [Updating flag description in the User's Guide]\n--\n--  * Adding the flag to Cabal\n--\n--    The Cabal library has its own list of all language extensions supported\n--    by all major compilers. This is the list that user code being uploaded\n--    to Hackage is checked against to ensure language extension validity.\n--    Consequently, it is very important that this list remains up-to-date.\n--\n--    To this end, there is a testsuite test (testsuite/tests/driver/T4437.hs)\n--    whose job it is to ensure these GHC's extensions are consistent with\n--    Cabal.\n--\n--    The recommended workflow is,\n--\n--     1. Temporarily add your new language extension to the\n--        expectedGhcOnlyExtensions list in T4437 to ensure the test doesn't\n--        break while Cabal is updated.\n--\n--     2. After your GHC change is accepted, submit a Cabal pull request adding\n--        your new extension to Cabal's list (found in\n--        Cabal/Language/Haskell/Extension.hs).\n--\n--     3. After your Cabal change is accepted, let the GHC developers know so\n--        they can update the Cabal submodule and remove the extensions from\n--        expectedGhcOnlyExtensions.\n--\n--  * Adding the flag to the GHC Wiki\n--\n--    There is a change log tracking language extension additions and removals\n--    on the GHC wiki:  https://ghc.haskell.org/trac/ghc/wiki/LanguagePragmaHistory\n--\n--  See Trac #4437 and #8176.\n\n-- -----------------------------------------------------------------------------\n-- DynFlags\n\ndata DumpFlag\n-- See Note [Updating flag description in the User's Guide]\n\n   -- debugging flags\n   = Opt_D_dump_cmm\n   | Opt_D_dump_cmm_from_stg\n   | Opt_D_dump_cmm_raw\n   | Opt_D_dump_cmm_verbose\n   -- All of the cmm subflags (there are a lot!) automatically\n   -- enabled if you run -ddump-cmm-verbose\n   -- Each flag corresponds to exact stage of Cmm pipeline.\n   | Opt_D_dump_cmm_cfg\n   | Opt_D_dump_cmm_cbe\n   | Opt_D_dump_cmm_switch\n   | Opt_D_dump_cmm_proc\n   | Opt_D_dump_cmm_sp\n   | Opt_D_dump_cmm_sink\n   | Opt_D_dump_cmm_caf\n   | Opt_D_dump_cmm_procmap\n   | Opt_D_dump_cmm_split\n   | Opt_D_dump_cmm_info\n   | Opt_D_dump_cmm_cps\n   -- end cmm subflags\n   | Opt_D_dump_cfg_weights -- ^ Dump the cfg used for block layout.\n   | Opt_D_dump_asm\n   | Opt_D_dump_asm_native\n   | Opt_D_dump_asm_liveness\n   | Opt_D_dump_asm_regalloc\n   | Opt_D_dump_asm_regalloc_stages\n   | Opt_D_dump_asm_conflicts\n   | Opt_D_dump_asm_stats\n   | Opt_D_dump_asm_expanded\n   | Opt_D_dump_llvm\n   | Opt_D_dump_core_stats\n   | Opt_D_dump_deriv\n   | Opt_D_dump_ds\n   | Opt_D_dump_ds_preopt\n   | Opt_D_dump_foreign\n   | Opt_D_dump_inlinings\n   | Opt_D_dump_rule_firings\n   | Opt_D_dump_rule_rewrites\n   | Opt_D_dump_simpl_trace\n   | Opt_D_dump_occur_anal\n   | Opt_D_dump_parsed\n   | Opt_D_dump_parsed_ast\n   | Opt_D_dump_rn\n   | Opt_D_dump_rn_ast\n   | Opt_D_dump_shape\n   | Opt_D_dump_simpl\n   | Opt_D_dump_simpl_iterations\n   | Opt_D_dump_spec\n   | Opt_D_dump_prep\n   | Opt_D_dump_stg\n   | Opt_D_dump_call_arity\n   | Opt_D_dump_exitify\n   | Opt_D_dump_stranal\n   | Opt_D_dump_str_signatures\n   | Opt_D_dump_tc\n   | Opt_D_dump_tc_ast\n   | Opt_D_dump_types\n   | Opt_D_dump_rules\n   | Opt_D_dump_cse\n   | Opt_D_dump_worker_wrapper\n   | Opt_D_dump_rn_trace\n   | Opt_D_dump_rn_stats\n   | Opt_D_dump_opt_cmm\n   | Opt_D_dump_simpl_stats\n   | Opt_D_dump_cs_trace -- Constraint solver in type checker\n   | Opt_D_dump_tc_trace\n   | Opt_D_dump_ec_trace -- Pattern match exhaustiveness checker\n   | Opt_D_dump_if_trace\n   | Opt_D_dump_vt_trace\n   | Opt_D_dump_splices\n   | Opt_D_th_dec_file\n   | Opt_D_dump_BCOs\n   | Opt_D_dump_ticked\n   | Opt_D_dump_rtti\n   | Opt_D_source_stats\n   | Opt_D_verbose_stg2stg\n   | Opt_D_dump_hi\n   | Opt_D_dump_hi_diffs\n   | Opt_D_dump_mod_cycles\n   | Opt_D_dump_mod_map\n   | Opt_D_dump_timings\n   | Opt_D_dump_view_pattern_commoning\n   | Opt_D_verbose_core2core\n   | Opt_D_dump_debug\n   | Opt_D_dump_json\n   | Opt_D_ppr_debug\n   | Opt_D_no_debug_output\n   deriving (Eq, Show, Enum)\n\n\n-- | Enumerates the simple on-or-off dynamic flags\ndata GeneralFlag\n-- See Note [Updating flag description in the User's Guide]\n\n   = Opt_DumpToFile                     -- ^ Append dump output to files instead of stdout.\n   | Opt_D_faststring_stats\n   | Opt_D_dump_minimal_imports\n   | Opt_DoCoreLinting\n   | Opt_DoStgLinting\n   | Opt_DoCmmLinting\n   | Opt_DoAsmLinting\n   | Opt_DoAnnotationLinting\n   | Opt_NoLlvmMangler                 -- hidden flag\n   | Opt_FastLlvm                      -- hidden flag\n\n   | Opt_WarnIsError                    -- -Werror; makes warnings fatal\n   | Opt_ShowWarnGroups                 -- Show the group a warning belongs to\n   | Opt_HideSourcePaths                -- Hide module source/object paths\n\n   | Opt_PrintExplicitForalls\n   | Opt_PrintExplicitKinds\n   | Opt_PrintExplicitCoercions\n   | Opt_PrintExplicitRuntimeReps\n   | Opt_PrintEqualityRelations\n   | Opt_PrintUnicodeSyntax\n   | Opt_PrintExpandedSynonyms\n   | Opt_PrintPotentialInstances\n   | Opt_PrintTypecheckerElaboration\n\n   -- optimisation opts\n   | Opt_CallArity\n   | Opt_Exitification\n   | Opt_Strictness\n   | Opt_LateDmdAnal                    -- #6087\n   | Opt_KillAbsence\n   | Opt_KillOneShot\n   | Opt_FullLaziness\n   | Opt_FloatIn\n   | Opt_LateSpecialise\n   | Opt_Specialise\n   | Opt_SpecialiseAggressively\n   | Opt_CrossModuleSpecialise\n   | Opt_StaticArgumentTransformation\n   | Opt_CSE\n   | Opt_StgCSE\n   | Opt_StgLiftLams\n   | Opt_LiberateCase\n   | Opt_SpecConstr\n   | Opt_SpecConstrKeen\n   | Opt_DoLambdaEtaExpansion\n   | Opt_IgnoreAsserts\n   | Opt_DoEtaReduction\n   | Opt_CaseMerge\n   | Opt_CaseFolding                    -- Constant folding through case-expressions\n   | Opt_UnboxStrictFields\n   | Opt_UnboxSmallStrictFields\n   | Opt_DictsCheap\n   | Opt_EnableRewriteRules             -- Apply rewrite rules during simplification\n   | Opt_RegsGraph                      -- do graph coloring register allocation\n   | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation\n   | Opt_PedanticBottoms                -- Be picky about how we treat bottom\n   | Opt_LlvmTBAA                       -- Use LLVM TBAA infastructure for improving AA (hidden flag)\n   | Opt_LlvmFillUndefWithGarbage       -- Testing for undef bugs (hidden flag)\n   | Opt_IrrefutableTuples\n   | Opt_CmmSink\n   | Opt_CmmElimCommonBlocks\n   | Opt_AsmShortcutting\n   | Opt_OmitYields\n   | Opt_FunToThunk               -- allow WwLib.mkWorkerArgs to remove all value lambdas\n   | Opt_DictsStrict                     -- be strict in argument dictionaries\n   | Opt_DmdTxDictSel              -- use a special demand transformer for dictionary selectors\n   | Opt_Loopification                  -- See Note [Self-recursive tail calls]\n   | Opt_CfgBlocklayout             -- ^ Use the cfg based block layout algorithm.\n   | Opt_WeightlessBlocklayout         -- ^ Layout based on last instruction per block.\n   | Opt_CprAnal\n   | Opt_WorkerWrapper\n   | Opt_SolveConstantDicts\n   | Opt_AlignmentSanitisation\n   | Opt_CatchBottoms\n   | Opt_NumConstantFolding\n\n   -- PreInlining is on by default. The option is there just to see how\n   -- bad things get if you turn it off!\n   | Opt_SimplPreInlining\n\n   -- Interface files\n   | Opt_IgnoreInterfacePragmas\n   | Opt_OmitInterfacePragmas\n   | Opt_ExposeAllUnfoldings\n   | Opt_WriteInterface -- forces .hi files to be written even with -fno-code\n   | Opt_WriteHie -- generate .hie files\n\n   -- profiling opts\n   | Opt_AutoSccsOnIndividualCafs\n   | Opt_ProfCountEntries\n\n   -- misc opts\n   | Opt_Pp\n   | Opt_ForceRecomp\n   | Opt_IgnoreOptimChanges\n   | Opt_IgnoreHpcChanges\n   | Opt_ExcessPrecision\n   | Opt_EagerBlackHoling\n   | Opt_NoHsMain\n   | Opt_SplitSections\n   | Opt_StgStats\n   | Opt_HideAllPackages\n   | Opt_HideAllPluginPackages\n   | Opt_PrintBindResult\n   | Opt_Haddock\n   | Opt_HaddockOptions\n   | Opt_BreakOnException\n   | Opt_BreakOnError\n   | Opt_PrintEvldWithShow\n   | Opt_PrintBindContents\n   | Opt_GenManifest\n   | Opt_EmbedManifest\n   | Opt_SharedImplib\n   | Opt_BuildingCabalPackage\n   | Opt_IgnoreDotGhci\n   | Opt_GhciSandbox\n   | Opt_GhciHistory\n   | Opt_GhciLeakCheck\n   | Opt_ValidateHie\n   | Opt_LocalGhciHistory\n   | Opt_NoIt\n   | Opt_HelpfulErrors\n   | Opt_DeferTypeErrors\n   | Opt_DeferTypedHoles\n   | Opt_DeferOutOfScopeVariables\n   | Opt_PIC                         -- ^ @-fPIC@\n   | Opt_PIE                         -- ^ @-fPIE@\n   | Opt_PICExecutable               -- ^ @-pie@\n   | Opt_ExternalDynamicRefs\n   | Opt_SccProfilingOn\n   | Opt_Ticky\n   | Opt_Ticky_Allocd\n   | Opt_Ticky_LNE\n   | Opt_Ticky_Dyn_Thunk\n   | Opt_RPath\n   | Opt_RelativeDynlibPaths\n   | Opt_Hpc\n   | Opt_FlatCache\n   | Opt_ExternalInterpreter\n   | Opt_OptimalApplicativeDo\n   | Opt_VersionMacros\n   | Opt_WholeArchiveHsLibs\n   -- copy all libs into a single folder prior to linking binaries\n   -- this should elivate the excessive command line limit restrictions\n   -- on windows, by only requiring a single -L argument instead of\n   -- one for each dependency.  At the time of this writing, gcc\n   -- forwards all -L flags to the collect2 command without using a\n   -- response file and as such breaking apart.\n   | Opt_SingleLibFolder\n   | Opt_KeepCAFs\n\n   -- output style opts\n   | Opt_ErrorSpans -- Include full span info in error messages,\n                    -- instead of just the start position.\n   | Opt_DeferDiagnostics\n   | Opt_DiagnosticsShowCaret -- Show snippets of offending code\n   | Opt_PprCaseAsLet\n   | Opt_PprShowTicks\n   | Opt_ShowHoleConstraints\n    -- Options relating to the display of valid hole fits\n    -- when generating an error message for a typed hole\n    -- See Note [Valid hole fits include] in TcHoleErrors.hs\n   | Opt_ShowValidHoleFits\n   | Opt_SortValidHoleFits\n   | Opt_SortBySizeHoleFits\n   | Opt_SortBySubsumHoleFits\n   | Opt_AbstractRefHoleFits\n   | Opt_UnclutterValidHoleFits\n   | Opt_ShowTypeAppOfHoleFits\n   | Opt_ShowTypeAppVarsOfHoleFits\n   | Opt_ShowDocsOfHoleFits\n   | Opt_ShowTypeOfHoleFits\n   | Opt_ShowProvOfHoleFits\n   | Opt_ShowMatchesOfHoleFits\n\n   | Opt_ShowLoadedModules\n   | Opt_HexWordLiterals -- See Note [Print Hexadecimal Literals]\n\n   -- Suppress all coercions, them replacing with '...'\n   | Opt_SuppressCoercions\n   | Opt_SuppressVarKinds\n   -- Suppress module id prefixes on variables.\n   | Opt_SuppressModulePrefixes\n   -- Suppress type applications.\n   | Opt_SuppressTypeApplications\n   -- Suppress info such as arity and unfoldings on identifiers.\n   | Opt_SuppressIdInfo\n   -- Suppress separate type signatures in core, but leave types on\n   -- lambda bound vars\n   | Opt_SuppressUnfoldings\n   -- Suppress the details of even stable unfoldings\n   | Opt_SuppressTypeSignatures\n   -- Suppress unique ids on variables.\n   -- Except for uniques, as some simplifier phases introduce new\n   -- variables that have otherwise identical names.\n   | Opt_SuppressUniques\n   | Opt_SuppressStgExts\n   | Opt_SuppressTicks     -- Replaces Opt_PprShowTicks\n   | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps\n\n   -- temporary flags\n   | Opt_AutoLinkPackages\n   | Opt_ImplicitImportQualified\n\n   -- keeping stuff\n   | Opt_KeepHscppFiles\n   | Opt_KeepHiDiffs\n   | Opt_KeepHcFiles\n   | Opt_KeepSFiles\n   | Opt_KeepTmpFiles\n   | Opt_KeepRawTokenStream\n   | Opt_KeepLlvmFiles\n   | Opt_KeepHiFiles\n   | Opt_KeepOFiles\n\n   | Opt_BuildDynamicToo\n\n   -- safe haskell flags\n   | Opt_DistrustAllPackages\n   | Opt_PackageTrust\n   | Opt_PluginTrustworthy\n\n   | Opt_G_NoStateHack\n   | Opt_G_NoOptCoercion\n   deriving (Eq, Show, Enum)\n\n-- Check whether a flag should be considered an \"optimisation flag\"\n-- for purposes of recompilation avoidance (see\n-- Note [Ignoring some flag changes] in FlagChecker). Being listed here is\n-- not a guarantee that the flag has no other effect. We could, and\n-- perhaps should, separate out the flags that have some minor impact on\n-- program semantics and/or error behavior (e.g., assertions), but\n-- then we'd need to go to extra trouble (and an additional flag)\n-- to allow users to ignore the optimisation level even though that\n-- means ignoring some change.\noptimisationFlags :: EnumSet GeneralFlag\noptimisationFlags = EnumSet.fromList\n   [ Opt_CallArity\n   , Opt_Strictness\n   , Opt_LateDmdAnal\n   , Opt_KillAbsence\n   , Opt_KillOneShot\n   , Opt_FullLaziness\n   , Opt_FloatIn\n   , Opt_LateSpecialise\n   , Opt_Specialise\n   , Opt_SpecialiseAggressively\n   , Opt_CrossModuleSpecialise\n   , Opt_StaticArgumentTransformation\n   , Opt_CSE\n   , Opt_StgCSE\n   , Opt_StgLiftLams\n   , Opt_LiberateCase\n   , Opt_SpecConstr\n   , Opt_SpecConstrKeen\n   , Opt_DoLambdaEtaExpansion\n   , Opt_IgnoreAsserts\n   , Opt_DoEtaReduction\n   , Opt_CaseMerge\n   , Opt_CaseFolding\n   , Opt_UnboxStrictFields\n   , Opt_UnboxSmallStrictFields\n   , Opt_DictsCheap\n   , Opt_EnableRewriteRules\n   , Opt_RegsGraph\n   , Opt_RegsIterative\n   , Opt_PedanticBottoms\n   , Opt_LlvmTBAA\n   , Opt_LlvmFillUndefWithGarbage\n   , Opt_IrrefutableTuples\n   , Opt_CmmSink\n   , Opt_CmmElimCommonBlocks\n   , Opt_AsmShortcutting\n   , Opt_OmitYields\n   , Opt_FunToThunk\n   , Opt_DictsStrict\n   , Opt_DmdTxDictSel\n   , Opt_Loopification\n   , Opt_CfgBlocklayout\n   , Opt_WeightlessBlocklayout\n   , Opt_CprAnal\n   , Opt_WorkerWrapper\n   , Opt_SolveConstantDicts\n   , Opt_CatchBottoms\n   , Opt_IgnoreAsserts\n   ]\n\n-- | Used when outputting warnings: if a reason is given, it is\n-- displayed. If a warning isn't controlled by a flag, this is made\n-- explicit at the point of use.\ndata WarnReason\n  = NoReason\n  -- | Warning was enabled with the flag\n  | Reason !WarningFlag\n  -- | Warning was made an error because of -Werror or -Werror=WarningFlag\n  | ErrReason !(Maybe WarningFlag)\n  deriving Show\n\n-- | Used to differentiate the scope an include needs to apply to.\n-- We have to split the include paths to avoid accidentally forcing recursive\n-- includes since -I overrides the system search paths. See Trac #14312.\ndata IncludeSpecs\n  = IncludeSpecs { includePathsQuote  :: [String]\n                 , includePathsGlobal :: [String]\n                 }\n  deriving Show\n\n-- | Append to the list of includes a path that shall be included using `-I`\n-- when the C compiler is called. These paths override system search paths.\naddGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs\naddGlobalInclude spec paths  = let f = includePathsGlobal spec\n                               in spec { includePathsGlobal = f ++ paths }\n\n-- | Append to the list of includes a path that shall be included using\n-- `-iquote` when the C compiler is called. These paths only apply when quoted\n-- includes are used. e.g. #include \"foo.h\"\naddQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs\naddQuoteInclude spec paths  = let f = includePathsQuote spec\n                              in spec { includePathsQuote = f ++ paths }\n\n-- | Concatenate and flatten the list of global and quoted includes returning\n-- just a flat list of paths.\nflattenIncludes :: IncludeSpecs -> [String]\nflattenIncludes specs = includePathsQuote specs ++ includePathsGlobal specs\n\ninstance Outputable WarnReason where\n  ppr = text . show\n\ninstance ToJson WarnReason where\n  json NoReason = JSNull\n  json (Reason wf) = JSString (show wf)\n  json (ErrReason Nothing) = JSString \"Opt_WarnIsError\"\n  json (ErrReason (Just wf)) = JSString (show wf)\n\ndata WarningFlag =\n-- See Note [Updating flag description in the User's Guide]\n     Opt_WarnDuplicateExports\n   | Opt_WarnDuplicateConstraints\n   | Opt_WarnRedundantConstraints\n   | Opt_WarnHiShadows\n   | Opt_WarnImplicitPrelude\n   | Opt_WarnIncompletePatterns\n   | Opt_WarnIncompleteUniPatterns\n   | Opt_WarnIncompletePatternsRecUpd\n   | Opt_WarnOverflowedLiterals\n   | Opt_WarnEmptyEnumerations\n   | Opt_WarnMissingFields\n   | Opt_WarnMissingImportList\n   | Opt_WarnMissingMethods\n   | Opt_WarnMissingSignatures\n   | Opt_WarnMissingLocalSignatures\n   | Opt_WarnNameShadowing\n   | Opt_WarnOverlappingPatterns\n   | Opt_WarnTypeDefaults\n   | Opt_WarnMonomorphism\n   | Opt_WarnUnusedTopBinds\n   | Opt_WarnUnusedLocalBinds\n   | Opt_WarnUnusedPatternBinds\n   | Opt_WarnUnusedImports\n   | Opt_WarnUnusedMatches\n   | Opt_WarnUnusedTypePatterns\n   | Opt_WarnUnusedForalls\n   | Opt_WarnUnusedRecordWildcards\n   | Opt_WarnRedundantRecordWildcards\n   | Opt_WarnWarningsDeprecations\n   | Opt_WarnDeprecatedFlags\n   | Opt_WarnMissingMonadFailInstances -- since 8.0\n   | Opt_WarnSemigroup -- since 8.0\n   | Opt_WarnDodgyExports\n   | Opt_WarnDodgyImports\n   | Opt_WarnOrphans\n   | Opt_WarnAutoOrphans\n   | Opt_WarnIdentities\n   | Opt_WarnTabs\n   | Opt_WarnUnrecognisedPragmas\n   | Opt_WarnDodgyForeignImports\n   | Opt_WarnUnusedDoBind\n   | Opt_WarnWrongDoBind\n   | Opt_WarnAlternativeLayoutRuleTransitional\n   | Opt_WarnUnsafe\n   | Opt_WarnSafe\n   | Opt_WarnTrustworthySafe\n   | Opt_WarnMissedSpecs\n   | Opt_WarnAllMissedSpecs\n   | Opt_WarnUnsupportedCallingConventions\n   | Opt_WarnUnsupportedLlvmVersion\n   | Opt_WarnMissedExtraSharedLib\n   | Opt_WarnInlineRuleShadowing\n   | Opt_WarnTypedHoles\n   | Opt_WarnPartialTypeSignatures\n   | Opt_WarnMissingExportedSignatures\n   | Opt_WarnUntickedPromotedConstructors\n   | Opt_WarnDerivingTypeable\n   | Opt_WarnDeferredTypeErrors\n   | Opt_WarnDeferredOutOfScopeVariables\n   | Opt_WarnNonCanonicalMonadInstances   -- since 8.0\n   | Opt_WarnNonCanonicalMonadFailInstances -- since 8.0\n   | Opt_WarnNonCanonicalMonoidInstances  -- since 8.0\n   | Opt_WarnMissingPatternSynonymSignatures -- since 8.0\n   | Opt_WarnUnrecognisedWarningFlags     -- since 8.0\n   | Opt_WarnSimplifiableClassConstraints -- Since 8.2\n   | Opt_WarnCPPUndef                     -- Since 8.2\n   | Opt_WarnUnbangedStrictPatterns       -- Since 8.2\n   | Opt_WarnMissingHomeModules           -- Since 8.2\n   | Opt_WarnPartialFields                -- Since 8.4\n   | Opt_WarnMissingExportList\n   | Opt_WarnInaccessibleCode\n   | Opt_WarnStarIsType                   -- Since 8.6\n   | Opt_WarnStarBinder                   -- Since 8.6\n   | Opt_WarnImplicitKindVars             -- Since 8.6\n   | Opt_WarnSpaceAfterBang\n   | Opt_WarnMissingDerivingStrategies    -- Since 8.8\n   deriving (Eq, Show, Enum)\n\ndata Language = Haskell98 | Haskell2010\n   deriving (Eq, Enum, Show)\n\ninstance Outputable Language where\n    ppr = text . show\n\n-- | The various Safe Haskell modes\ndata SafeHaskellMode\n   = Sf_None\n   | Sf_Unsafe\n   | Sf_Trustworthy\n   | Sf_Safe\n   | Sf_Ignore\n   deriving (Eq)\n\ninstance Show SafeHaskellMode where\n    show Sf_None         = \"None\"\n    show Sf_Unsafe       = \"Unsafe\"\n    show Sf_Trustworthy  = \"Trustworthy\"\n    show Sf_Safe         = \"Safe\"\n    show Sf_Ignore       = \"Ignore\"\n\ninstance Outputable SafeHaskellMode where\n    ppr = text . show\n\n-- | Contains not only a collection of 'GeneralFlag's but also a plethora of\n-- information relating to the compilation of a single file or GHC session\ndata DynFlags = DynFlags {\n  ghcMode               :: GhcMode,\n  ghcLink               :: GhcLink,\n  hscTarget             :: HscTarget,\n  settings              :: Settings,\n  integerLibrary        :: IntegerLibrary,\n    -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden\n    --   by GHC-API users. See Note [The integer library] in PrelNames\n  llvmTargets           :: LlvmTargets,\n  llvmPasses            :: LlvmPasses,\n  verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]\n  optLevel              :: Int,         -- ^ Optimisation level\n  debugLevel            :: Int,         -- ^ How much debug information to produce\n  simplPhases           :: Int,         -- ^ Number of simplifier phases\n  maxSimplIterations    :: Int,         -- ^ Max simplifier iterations\n  maxPmCheckIterations  :: Int,         -- ^ Max no iterations for pm checking\n  ruleCheck             :: Maybe String,\n  inlineCheck           :: Maybe String, -- ^ A prefix to report inlining decisions about\n  strictnessBefore      :: [Int],       -- ^ Additional demand analysis\n\n  parMakeCount          :: Maybe Int,   -- ^ The number of modules to compile in parallel\n                                        --   in --make mode, where Nothing ==> compile as\n                                        --   many in parallel as there are CPUs.\n\n  enableTimeStats       :: Bool,        -- ^ Enable RTS timing statistics?\n  ghcHeapSize           :: Maybe Int,   -- ^ The heap size to set.\n\n  maxRelevantBinds      :: Maybe Int,   -- ^ Maximum number of bindings from the type envt\n                                        --   to show in type error messages\n  maxValidHoleFits      :: Maybe Int,   -- ^ Maximum number of hole fits to show\n                                        --   in typed hole error messages\n  maxRefHoleFits        :: Maybe Int,   -- ^ Maximum number of refinement hole\n                                        --   fits to show in typed hole error\n                                        --   messages\n  refLevelHoleFits      :: Maybe Int,   -- ^ Maximum level of refinement for\n                                        --   refinement hole fits in typed hole\n                                        --   error messages\n  maxUncoveredPatterns  :: Int,         -- ^ Maximum number of unmatched patterns to show\n                                        --   in non-exhaustiveness warnings\n  simplTickFactor       :: Int,         -- ^ Multiplier for simplifier ticks\n  specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr\n  specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function\n  specConstrRecursive   :: Int,         -- ^ Max number of specialisations for recursive types\n                                        --   Not optional; otherwise ForceSpecConstr can diverge.\n  binBlobThreshold      :: Word,        -- ^ Binary literals (e.g. strings) whose size is above\n                                        --   this threshold will be dumped in a binary file\n                                        --   by the assembler code generator (0 to disable)\n  liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase\n  floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda floating\n                                        --   See CoreMonad.FloatOutSwitches\n\n  liftLamsRecArgs       :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a\n                                        --   recursive function.\n  liftLamsNonRecArgs    :: Maybe Int,   -- ^ Maximum number of arguments after lambda lifting a\n                                        --   non-recursive function.\n  liftLamsKnown         :: Bool,        -- ^ Lambda lift even when this turns a known call\n                                        --   into an unknown call.\n\n  cmmProcAlignment      :: Maybe Int,   -- ^ Align Cmm functions at this boundary or use default.\n\n  historySize           :: Int,         -- ^ Simplification history size\n\n  importPaths           :: [FilePath],\n  mainModIs             :: Module,\n  mainFunIs             :: Maybe String,\n  reductionDepth        :: IntWithInf,   -- ^ Typechecker maximum stack depth\n  solverIterations      :: IntWithInf,   -- ^ Number of iterations in the constraints solver\n                                         --   Typically only 1 is needed\n\n  thisInstalledUnitId   :: InstalledUnitId,\n  thisComponentId_      :: Maybe ComponentId,\n  thisUnitIdInsts_      :: Maybe [(ModuleName, Module)],\n\n  -- ways\n  ways                  :: [Way],       -- ^ Way flags from the command line\n  buildTag              :: String,      -- ^ The global \\\"way\\\" (e.g. \\\"p\\\" for prof)\n\n  -- For object splitting\n  splitInfo             :: Maybe (String,Int),\n\n  -- paths etc.\n  objectDir             :: Maybe String,\n  dylibInstallName      :: Maybe String,\n  hiDir                 :: Maybe String,\n  hieDir                :: Maybe String,\n  stubDir               :: Maybe String,\n  dumpDir               :: Maybe String,\n\n  objectSuf             :: String,\n  hcSuf                 :: String,\n  hiSuf                 :: String,\n  hieSuf                :: String,\n\n  canGenerateDynamicToo :: IORef Bool,\n  dynObjectSuf          :: String,\n  dynHiSuf              :: String,\n\n  outputFile            :: Maybe String,\n  dynOutputFile         :: Maybe String,\n  outputHi              :: Maybe String,\n  dynLibLoader          :: DynLibLoader,\n\n  -- | This is set by 'DriverPipeline.runPipeline' based on where\n  --    its output is going.\n  dumpPrefix            :: Maybe FilePath,\n\n  -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.\n  --    Set by @-ddump-file-prefix@\n  dumpPrefixForce       :: Maybe FilePath,\n\n  ldInputs              :: [Option],\n\n  includePaths          :: IncludeSpecs,\n  libraryPaths          :: [String],\n  frameworkPaths        :: [String],    -- used on darwin only\n  cmdlineFrameworks     :: [String],    -- ditto\n\n  rtsOpts               :: Maybe String,\n  rtsOptsEnabled        :: RtsOptsEnabled,\n  rtsOptsSuggestions    :: Bool,\n\n  hpcDir                :: String,      -- ^ Path to store the .mix files\n\n  -- Plugins\n  pluginModNames        :: [ModuleName],\n  pluginModNameOpts     :: [(ModuleName,String)],\n  frontendPluginOpts    :: [String],\n    -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse*\n    -- order that they're specified on the command line.\n  cachedPlugins         :: [LoadedPlugin],\n    -- ^ plugins dynamically loaded after processing arguments. What will be\n    -- loaded here is directed by pluginModNames. Arguments are loaded from\n    -- pluginModNameOpts. The purpose of this field is to cache the plugins so\n    -- they don't have to be loaded each time they are needed.  See\n    -- 'DynamicLoading.initializePlugins'.\n  staticPlugins            :: [StaticPlugin],\n    -- ^ staic plugins which do not need dynamic loading. These plugins are\n    -- intended to be added by GHC API users directly to this list.\n    --\n    -- To add dynamically loaded plugins through the GHC API see\n    -- 'addPluginModuleName' instead.\n\n  -- GHC API hooks\n  hooks                 :: Hooks,\n\n  --  For ghc -M\n  depMakefile           :: FilePath,\n  depIncludePkgDeps     :: Bool,\n  depExcludeMods        :: [ModuleName],\n  depSuffixes           :: [String],\n\n  --  Package flags\n  packageDBFlags        :: [PackageDBFlag],\n        -- ^ The @-package-db@ flags given on the command line, In\n        -- *reverse* order that they're specified on the command line.\n        -- This is intended to be applied with the list of \"initial\"\n        -- package databases derived from @GHC_PACKAGE_PATH@; see\n        -- 'getPackageConfRefs'.\n\n  ignorePackageFlags    :: [IgnorePackageFlag],\n        -- ^ The @-ignore-package@ flags from the command line.\n        -- In *reverse* order that they're specified on the command line.\n  packageFlags          :: [PackageFlag],\n        -- ^ The @-package@ and @-hide-package@ flags from the command-line.\n        -- In *reverse* order that they're specified on the command line.\n  pluginPackageFlags    :: [PackageFlag],\n        -- ^ The @-plugin-package-id@ flags from command line.\n        -- In *reverse* order that they're specified on the command line.\n  trustFlags            :: [TrustFlag],\n        -- ^ The @-trust@ and @-distrust@ flags.\n        -- In *reverse* order that they're specified on the command line.\n  packageEnv            :: Maybe FilePath,\n        -- ^ Filepath to the package environment file (if overriding default)\n\n  -- Package state\n  -- NB. do not modify this field, it is calculated by\n  -- Packages.initPackages\n  pkgDatabase           :: Maybe [(FilePath, [PackageConfig])],\n  pkgState              :: PackageState,\n\n  -- Temporary files\n  -- These have to be IORefs, because the defaultCleanupHandler needs to\n  -- know what to clean when an exception happens\n  filesToClean          :: IORef FilesToClean,\n  dirsToClean           :: IORef (Map FilePath FilePath),\n  -- The next available suffix to uniquely name a temp file, updated atomically\n  nextTempSuffix        :: IORef Int,\n\n  -- Names of files which were generated from -ddump-to-file; used to\n  -- track which ones we need to truncate because it's our first run\n  -- through\n  generatedDumps        :: IORef (Set FilePath),\n\n  -- hsc dynamic flags\n  dumpFlags             :: EnumSet DumpFlag,\n  generalFlags          :: EnumSet GeneralFlag,\n  warningFlags          :: EnumSet WarningFlag,\n  fatalWarningFlags     :: EnumSet WarningFlag,\n  -- Don't change this without updating extensionFlags:\n  language              :: Maybe Language,\n  -- | Safe Haskell mode\n  safeHaskell           :: SafeHaskellMode,\n  safeInfer             :: Bool,\n  safeInferred          :: Bool,\n  -- We store the location of where some extension and flags were turned on so\n  -- we can produce accurate error messages when Safe Haskell fails due to\n  -- them.\n  thOnLoc               :: SrcSpan,\n  newDerivOnLoc         :: SrcSpan,\n  overlapInstLoc        :: SrcSpan,\n  incoherentOnLoc       :: SrcSpan,\n  pkgTrustOnLoc         :: SrcSpan,\n  warnSafeOnLoc         :: SrcSpan,\n  warnUnsafeOnLoc       :: SrcSpan,\n  trustworthyOnLoc      :: SrcSpan,\n  -- Don't change this without updating extensionFlags:\n  -- Here we collect the settings of the language extensions\n  -- from the command line, the ghci config file and\n  -- from interactive :set / :seti commands.\n  extensions            :: [OnOff LangExt.Extension],\n  -- extensionFlags should always be equal to\n  --     flattenExtensionFlags language extensions\n  -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used\n  -- by template-haskell\n  extensionFlags        :: EnumSet LangExt.Extension,\n\n  -- Unfolding control\n  -- See Note [Discounts and thresholds] in CoreUnfold\n  ufCreationThreshold   :: Int,\n  ufUseThreshold        :: Int,\n  ufFunAppDiscount      :: Int,\n  ufDictDiscount        :: Int,\n  ufKeenessFactor       :: Float,\n  ufDearOp              :: Int,\n  ufVeryAggressive      :: Bool,\n\n  maxWorkerArgs         :: Int,\n\n  ghciHistSize          :: Int,\n\n  -- | MsgDoc output action: use \"ErrUtils\" instead of this if you can\n  log_action            :: LogAction,\n  flushOut              :: FlushOut,\n  flushErr              :: FlushErr,\n\n  ghcVersionFile        :: Maybe FilePath,\n  haddockOptions        :: Maybe String,\n\n  -- | GHCi scripts specified by -ghci-script, in reverse order\n  ghciScripts           :: [String],\n\n  -- Output style options\n  pprUserLength         :: Int,\n  pprCols               :: Int,\n\n  useUnicode            :: Bool,\n  useColor              :: OverridingBool,\n  canUseColor           :: Bool,\n  colScheme             :: Col.Scheme,\n\n  -- | what kind of {-# SCC #-} to add automatically\n  profAuto              :: ProfAuto,\n\n  interactivePrint      :: Maybe String,\n\n  nextWrapperNum        :: IORef (ModuleEnv Int),\n\n  -- | Machine dependent flags (-m<blah> stuff)\n  sseVersion            :: Maybe SseVersion,\n  bmiVersion            :: Maybe BmiVersion,\n  avx                   :: Bool,\n  avx2                  :: Bool,\n  avx512cd              :: Bool, -- Enable AVX-512 Conflict Detection Instructions.\n  avx512er              :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions.\n  avx512f               :: Bool, -- Enable AVX-512 instructions.\n  avx512pf              :: Bool, -- Enable AVX-512 PreFetch Instructions.\n\n  -- | Run-time linker information (what options we need, etc.)\n  rtldInfo              :: IORef (Maybe LinkerInfo),\n\n  -- | Run-time compiler information\n  rtccInfo              :: IORef (Maybe CompilerInfo),\n\n  -- Constants used to control the amount of optimization done.\n\n  -- | Max size, in bytes, of inline array allocations.\n  maxInlineAllocSize    :: Int,\n\n  -- | Only inline memcpy if it generates no more than this many\n  -- pseudo (roughly: Cmm) instructions.\n  maxInlineMemcpyInsns  :: Int,\n\n  -- | Only inline memset if it generates no more than this many\n  -- pseudo (roughly: Cmm) instructions.\n  maxInlineMemsetInsns  :: Int,\n\n  -- | Reverse the order of error messages in GHC/GHCi\n  reverseErrors         :: Bool,\n\n  -- | Limit the maximum number of errors to show\n  maxErrors             :: Maybe Int,\n\n  -- | Unique supply configuration for testing build determinism\n  initialUnique         :: Int,\n  uniqueIncrement       :: Int,\n\n  -- | Temporary: CFG Edge weights for fast iterations\n  cfgWeightInfo         :: CfgWeights\n}\n\n-- | Edge weights to use when generating a CFG from CMM\ndata CfgWeights\n    = CFGWeights\n    { uncondWeight :: Int\n    , condBranchWeight :: Int\n    , switchWeight :: Int\n    , callWeight :: Int\n    , likelyCondWeight :: Int\n    , unlikelyCondWeight :: Int\n    , infoTablePenalty :: Int\n    , backEdgeBonus :: Int\n    }\n\ndefaultCfgWeights :: CfgWeights\ndefaultCfgWeights\n    = CFGWeights\n    { uncondWeight = 1000\n    , condBranchWeight = 800\n    , switchWeight = 1\n    , callWeight = -10\n    , likelyCondWeight = 900\n    , unlikelyCondWeight = 300\n    , infoTablePenalty = 300\n    , backEdgeBonus = 400\n    }\n\nparseCfgWeights :: String -> CfgWeights -> CfgWeights\nparseCfgWeights s oldWeights =\n        foldl' (\\cfg (n,v) -> update n v cfg) oldWeights assignments\n    where\n        assignments = map assignment $ settings s\n        update \"uncondWeight\" n w =\n            w {uncondWeight = n}\n        update \"condBranchWeight\" n w =\n            w {condBranchWeight = n}\n        update \"switchWeight\" n w =\n            w {switchWeight = n}\n        update \"callWeight\" n w =\n            w {callWeight = n}\n        update \"likelyCondWeight\" n w =\n            w {likelyCondWeight = n}\n        update \"unlikelyCondWeight\" n w =\n            w {unlikelyCondWeight = n}\n        update \"infoTablePenalty\" n w =\n            w {infoTablePenalty = n}\n        update \"backEdgeBonus\" n w =\n            w {backEdgeBonus = n}\n        update other _ _\n            = panic $ other ++\n                      \" is not a cfg weight parameter. \" ++\n                      exampleString\n        settings s\n            | (s1,rest) <- break (== ',') s\n            , null rest\n            = [s1]\n            | (s1,rest) <- break (== ',') s\n            = [s1] ++ settings (drop 1 rest)\n            | otherwise = panic $ \"Invalid cfg parameters.\" ++ exampleString\n        assignment as\n            | (name, _:val) <- break (== '=') as\n            = (name,read val)\n            | otherwise\n            = panic $ \"Invalid cfg parameters.\" ++ exampleString\n        exampleString = \"Example parameters: uncondWeight=1000,\" ++\n            \"condBranchWeight=800,switchWeight=0,callWeight=300\" ++\n            \",likelyCondWeight=900,unlikelyCondWeight=300\" ++\n            \",infoTablePenalty=300,backEdgeBonus=400\"\n\nbackendMaintainsCfg :: DynFlags -> Bool\nbackendMaintainsCfg dflags = case (platformArch $ targetPlatform dflags) of\n    -- ArchX86 -- Should work but not tested so disabled currently.\n    ArchX86_64 -> True\n    _otherwise -> False\n\nclass HasDynFlags m where\n    getDynFlags :: m DynFlags\n\n{- It would be desirable to have the more generalised\n\n  instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where\n      getDynFlags = lift getDynFlags\n\ninstance definition. However, that definition would overlap with the\n`HasDynFlags (GhcT m)` instance. Instead we define instances for a\ncouple of common Monad transformers explicitly. -}\n\ninstance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where\n    getDynFlags = lift getDynFlags\n\ninstance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where\n    getDynFlags = lift getDynFlags\n\ninstance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where\n    getDynFlags = lift getDynFlags\n\ninstance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where\n    getDynFlags = lift getDynFlags\n\nclass ContainsDynFlags t where\n    extractDynFlags :: t -> DynFlags\n\ndata ProfAuto\n  = NoProfAuto         -- ^ no SCC annotations added\n  | ProfAutoAll        -- ^ top-level and nested functions are annotated\n  | ProfAutoTop        -- ^ top-level functions annotated only\n  | ProfAutoExports    -- ^ exported functions annotated only\n  | ProfAutoCalls      -- ^ annotate call-sites\n  deriving (Eq,Enum)\n\ndata LlvmTarget = LlvmTarget\n  { lDataLayout :: String\n  , lCPU        :: String\n  , lAttributes :: [String]\n  }\n\ntype LlvmTargets = [(String, LlvmTarget)]\ntype LlvmPasses = [(Int, String)]\ntype LlvmConfig = (LlvmTargets, LlvmPasses)\n\ndata Settings = Settings {\n  sTargetPlatform        :: Platform,       -- Filled in by SysTools\n  sGhcUsagePath          :: FilePath,       -- ditto\n  sGhciUsagePath         :: FilePath,       -- ditto\n  sToolDir               :: Maybe FilePath, -- ditto\n  sTopDir                :: FilePath,       -- ditto\n  sTmpDir                :: String,      -- no trailing '/'\n  sProgramName           :: String,\n  sProjectVersion        :: String,\n  -- You shouldn't need to look things up in rawSettings directly.\n  -- They should have their own fields instead.\n  sRawSettings           :: [(String, String)],\n  sExtraGccViaCFlags     :: [String],\n  sSystemPackageConfig   :: FilePath,\n  sLdSupportsCompactUnwind :: Bool,\n  sLdSupportsBuildId       :: Bool,\n  sLdSupportsFilelist      :: Bool,\n  sLdIsGnuLd               :: Bool,\n  sGccSupportsNoPie        :: Bool,\n  -- commands for particular phases\n  sPgm_L                 :: String,\n  sPgm_P                 :: (String,[Option]),\n  sPgm_F                 :: String,\n  sPgm_c                 :: (String,[Option]),\n  sPgm_a                 :: (String,[Option]),\n  sPgm_l                 :: (String,[Option]),\n  sPgm_dll               :: (String,[Option]),\n  sPgm_T                 :: String,\n  sPgm_windres           :: String,\n  sPgm_libtool           :: String,\n  sPgm_ar                :: String,\n  sPgm_ranlib            :: String,\n  sPgm_lo                :: (String,[Option]), -- LLVM: opt llvm optimiser\n  sPgm_lc                :: (String,[Option]), -- LLVM: llc static compiler\n  sPgm_lcc               :: (String,[Option]), -- LLVM: c compiler\n  sPgm_i                 :: String,\n  -- options for particular phases\n  sOpt_L                 :: [String],\n  sOpt_P                 :: [String],\n  sOpt_P_fingerprint     :: Fingerprint, -- cached Fingerprint of sOpt_P\n                                         -- See Note [Repeated -optP hashing]\n  sOpt_F                 :: [String],\n  sOpt_c                 :: [String],\n  sOpt_a                 :: [String],\n  sOpt_l                 :: [String],\n  sOpt_windres           :: [String],\n  sOpt_lo                :: [String], -- LLVM: llvm optimiser\n  sOpt_lc                :: [String], -- LLVM: llc static compiler\n  sOpt_lcc               :: [String], -- LLVM: c compiler\n  sOpt_i                 :: [String], -- iserv options\n\n  sPlatformConstants     :: PlatformConstants\n }\n\ntargetPlatform :: DynFlags -> Platform\ntargetPlatform dflags = sTargetPlatform (settings dflags)\nprogramName :: DynFlags -> String\nprogramName dflags = sProgramName (settings dflags)\nprojectVersion :: DynFlags -> String\nprojectVersion dflags = sProjectVersion (settings dflags)\nghcUsagePath          :: DynFlags -> FilePath\nghcUsagePath dflags = sGhcUsagePath (settings dflags)\nghciUsagePath         :: DynFlags -> FilePath\nghciUsagePath dflags = sGhciUsagePath (settings dflags)\ntoolDir               :: DynFlags -> Maybe FilePath\ntoolDir dflags = sToolDir (settings dflags)\ntopDir                :: DynFlags -> FilePath\ntopDir dflags = sTopDir (settings dflags)\ntmpDir                :: DynFlags -> String\ntmpDir dflags = sTmpDir (settings dflags)\nrawSettings           :: DynFlags -> [(String, String)]\nrawSettings dflags = sRawSettings (settings dflags)\nextraGccViaCFlags     :: DynFlags -> [String]\nextraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags)\nsystemPackageConfig   :: DynFlags -> FilePath\nsystemPackageConfig dflags = sSystemPackageConfig (settings dflags)\npgm_L                 :: DynFlags -> String\npgm_L dflags = sPgm_L (settings dflags)\npgm_P                 :: DynFlags -> (String,[Option])\npgm_P dflags = sPgm_P (settings dflags)\npgm_F                 :: DynFlags -> String\npgm_F dflags = sPgm_F (settings dflags)\npgm_c                 :: DynFlags -> (String,[Option])\npgm_c dflags = sPgm_c (settings dflags)\npgm_a                 :: DynFlags -> (String,[Option])\npgm_a dflags = sPgm_a (settings dflags)\npgm_l                 :: DynFlags -> (String,[Option])\npgm_l dflags = sPgm_l (settings dflags)\npgm_dll               :: DynFlags -> (String,[Option])\npgm_dll dflags = sPgm_dll (settings dflags)\npgm_T                 :: DynFlags -> String\npgm_T dflags = sPgm_T (settings dflags)\npgm_windres           :: DynFlags -> String\npgm_windres dflags = sPgm_windres (settings dflags)\npgm_libtool           :: DynFlags -> String\npgm_libtool dflags = sPgm_libtool (settings dflags)\npgm_lcc               :: DynFlags -> (String,[Option])\npgm_lcc dflags = sPgm_lcc (settings dflags)\npgm_ar                :: DynFlags -> String\npgm_ar dflags = sPgm_ar (settings dflags)\npgm_ranlib            :: DynFlags -> String\npgm_ranlib dflags = sPgm_ranlib (settings dflags)\npgm_lo                :: DynFlags -> (String,[Option])\npgm_lo dflags = sPgm_lo (settings dflags)\npgm_lc                :: DynFlags -> (String,[Option])\npgm_lc dflags = sPgm_lc (settings dflags)\npgm_i                 :: DynFlags -> String\npgm_i dflags = sPgm_i (settings dflags)\nopt_L                 :: DynFlags -> [String]\nopt_L dflags = sOpt_L (settings dflags)\nopt_P                 :: DynFlags -> [String]\nopt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)\n            ++ sOpt_P (settings dflags)\n\n-- This function packages everything that's needed to fingerprint opt_P\n-- flags. See Note [Repeated -optP hashing].\nopt_P_signature       :: DynFlags -> ([String], Fingerprint)\nopt_P_signature dflags =\n  ( concatMap (wayOptP (targetPlatform dflags)) (ways dflags)\n  , sOpt_P_fingerprint (settings dflags))\n\nopt_F                 :: DynFlags -> [String]\nopt_F dflags = sOpt_F (settings dflags)\nopt_c                 :: DynFlags -> [String]\nopt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)\n            ++ sOpt_c (settings dflags)\nopt_a                 :: DynFlags -> [String]\nopt_a dflags = sOpt_a (settings dflags)\nopt_l                 :: DynFlags -> [String]\nopt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)\n            ++ sOpt_l (settings dflags)\nopt_windres           :: DynFlags -> [String]\nopt_windres dflags = sOpt_windres (settings dflags)\nopt_lcc                :: DynFlags -> [String]\nopt_lcc dflags = sOpt_lcc (settings dflags)\nopt_lo                :: DynFlags -> [String]\nopt_lo dflags = sOpt_lo (settings dflags)\nopt_lc                :: DynFlags -> [String]\nopt_lc dflags = sOpt_lc (settings dflags)\nopt_i                 :: DynFlags -> [String]\nopt_i dflags = sOpt_i (settings dflags)\n\n-- | The directory for this version of ghc in the user's app directory\n-- (typically something like @~/.ghc/x86_64-linux-7.6.3@)\n--\nversionedAppDir :: DynFlags -> MaybeT IO FilePath\nversionedAppDir dflags = do\n  -- Make sure we handle the case the HOME isn't set (see #11678)\n  appdir <- tryMaybeT $ getAppUserDataDirectory (programName dflags)\n  return $ appdir </> versionedFilePath dflags\n\n-- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when\n-- constructing platform-version-dependent files that need to co-exist.\n--\nversionedFilePath :: DynFlags -> FilePath\nversionedFilePath dflags =     TARGET_ARCH\n                        ++ '-':TARGET_OS\n                        ++ '-':projectVersion dflags\n  -- NB: This functionality is reimplemented in Cabal, so if you\n  -- change it, be sure to update Cabal.\n\n-- | The target code type of the compilation (if any).\n--\n-- Whenever you change the target, also make sure to set 'ghcLink' to\n-- something sensible.\n--\n-- 'HscNothing' can be used to avoid generating any output, however, note\n-- that:\n--\n--  * If a program uses Template Haskell the typechecker may need to run code\n--    from an imported module.  To facilitate this, code generation is enabled\n--    for modules imported by modules that use template haskell.\n--    See Note [-fno-code mode].\n--\ndata HscTarget\n  = HscC           -- ^ Generate C code.\n  | HscAsm         -- ^ Generate assembly using the native code generator.\n  | HscLlvm        -- ^ Generate assembly using the llvm code generator.\n  | HscInterpreted -- ^ Generate bytecode.  (Requires 'LinkInMemory')\n  | HscNothing     -- ^ Don't generate any code.  See notes above.\n  deriving (Eq, Show)\n\n-- | Will this target result in an object file on the disk?\nisObjectTarget :: HscTarget -> Bool\nisObjectTarget HscC     = True\nisObjectTarget HscAsm   = True\nisObjectTarget HscLlvm  = True\nisObjectTarget _        = False\n\n-- | Does this target retain *all* top-level bindings for a module,\n-- rather than just the exported bindings, in the TypeEnv and compiled\n-- code (if any)?  In interpreted mode we do this, so that GHCi can\n-- call functions inside a module.  In HscNothing mode we also do it,\n-- so that Haddock can get access to the GlobalRdrEnv for a module\n-- after typechecking it.\ntargetRetainsAllBindings :: HscTarget -> Bool\ntargetRetainsAllBindings HscInterpreted = True\ntargetRetainsAllBindings HscNothing     = True\ntargetRetainsAllBindings _              = False\n\n-- | The 'GhcMode' tells us whether we're doing multi-module\n-- compilation (controlled via the \"GHC\" API) or one-shot\n-- (single-module) compilation.  This makes a difference primarily to\n-- the \"Finder\": in one-shot mode we look for interface files for\n-- imported modules, but in multi-module mode we look for source files\n-- in order to check whether they need to be recompiled.\ndata GhcMode\n  = CompManager         -- ^ @\\-\\-make@, GHCi, etc.\n  | OneShot             -- ^ @ghc -c Foo.hs@\n  | MkDepend            -- ^ @ghc -M@, see \"Finder\" for why we need this\n  deriving Eq\n\ninstance Outputable GhcMode where\n  ppr CompManager = text \"CompManager\"\n  ppr OneShot     = text \"OneShot\"\n  ppr MkDepend    = text \"MkDepend\"\n\nisOneShot :: GhcMode -> Bool\nisOneShot OneShot = True\nisOneShot _other  = False\n\n-- | What to do in the link step, if there is one.\ndata GhcLink\n  = NoLink              -- ^ Don't link at all\n  | LinkBinary          -- ^ Link object code into a binary\n  | LinkInMemory        -- ^ Use the in-memory dynamic linker (works for both\n                        --   bytecode and object code).\n  | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)\n  | LinkStaticLib       -- ^ Link objects into a static lib\n  deriving (Eq, Show)\n\nisNoLink :: GhcLink -> Bool\nisNoLink NoLink = True\nisNoLink _      = False\n\n-- | We accept flags which make packages visible, but how they select\n-- the package varies; this data type reflects what selection criterion\n-- is used.\ndata PackageArg =\n      PackageArg String    -- ^ @-package@, by 'PackageName'\n    | UnitIdArg UnitId     -- ^ @-package-id@, by 'UnitId'\n  deriving (Eq, Show)\ninstance Outputable PackageArg where\n    ppr (PackageArg pn) = text \"package\" <+> text pn\n    ppr (UnitIdArg uid) = text \"unit\" <+> ppr uid\n\n-- | Represents the renaming that may be associated with an exposed\n-- package, e.g. the @rns@ part of @-package \"foo (rns)\"@.\n--\n-- Here are some example parsings of the package flags (where\n-- a string literal is punned to be a 'ModuleName':\n--\n--      * @-package foo@ is @ModRenaming True []@\n--      * @-package foo ()@ is @ModRenaming False []@\n--      * @-package foo (A)@ is @ModRenaming False [(\"A\", \"A\")]@\n--      * @-package foo (A as B)@ is @ModRenaming False [(\"A\", \"B\")]@\n--      * @-package foo with (A as B)@ is @ModRenaming True [(\"A\", \"B\")]@\ndata ModRenaming = ModRenaming {\n    modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?\n    modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope\n                                               --   under name @n@.\n  } deriving (Eq)\ninstance Outputable ModRenaming where\n    ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)\n\n-- | Flags for manipulating the set of non-broken packages.\nnewtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@\n  deriving (Eq)\n\n-- | Flags for manipulating package trust.\ndata TrustFlag\n  = TrustPackage    String -- ^ @-trust@\n  | DistrustPackage String -- ^ @-distrust@\n  deriving (Eq)\n\n-- | Flags for manipulating packages visibility.\ndata PackageFlag\n  = ExposePackage   String PackageArg ModRenaming -- ^ @-package@, @-package-id@\n  | HidePackage     String -- ^ @-hide-package@\n  deriving (Eq) -- NB: equality instance is used by packageFlagsChanged\n\ndata PackageDBFlag\n  = PackageDB PkgConfRef\n  | NoUserPackageDB\n  | NoGlobalPackageDB\n  | ClearPackageDBs\n  deriving (Eq)\n\npackageFlagsChanged :: DynFlags -> DynFlags -> Bool\npackageFlagsChanged idflags1 idflags0 =\n  packageFlags idflags1 /= packageFlags idflags0 ||\n  ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 ||\n  pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 ||\n  trustFlags idflags1 /= trustFlags idflags0 ||\n  packageDBFlags idflags1 /= packageDBFlags idflags0 ||\n  packageGFlags idflags1 /= packageGFlags idflags0\n where\n   packageGFlags dflags = map (`gopt` dflags)\n     [ Opt_HideAllPackages\n     , Opt_HideAllPluginPackages\n     , Opt_AutoLinkPackages ]\n\ninstance Outputable PackageFlag where\n    ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)\n    ppr (HidePackage str) = text \"-hide-package\" <+> text str\n\ndefaultHscTarget :: Platform -> HscTarget\ndefaultHscTarget = defaultObjectTarget\n\n-- | The 'HscTarget' value corresponding to the default way to create\n-- object files on the current platform.\ndefaultObjectTarget :: Platform -> HscTarget\ndefaultObjectTarget platform\n  | platformUnregisterised platform     =  HscC\n  | cGhcWithNativeCodeGen == \"YES\"      =  HscAsm\n  | otherwise                           =  HscLlvm\n\ntablesNextToCode :: DynFlags -> Bool\ntablesNextToCode dflags\n    = mkTablesNextToCode (platformUnregisterised (targetPlatform dflags))\n\n-- Determines whether we will be compiling\n-- info tables that reside just before the entry code, or with an\n-- indirection to the entry code.  See TABLES_NEXT_TO_CODE in\n-- includes/rts/storage/InfoTables.h.\nmkTablesNextToCode :: Bool -> Bool\nmkTablesNextToCode unregisterised\n    = not unregisterised && cGhcEnableTablesNextToCode == \"YES\"\n\ndata DynLibLoader\n  = Deployable\n  | SystemDependent\n  deriving Eq\n\ndata RtsOptsEnabled\n  = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly\n  | RtsOptsAll\n  deriving (Show)\n\nshouldUseColor :: DynFlags -> Bool\nshouldUseColor dflags = overrideWith (canUseColor dflags) (useColor dflags)\n\nshouldUseHexWordLiterals :: DynFlags -> Bool\nshouldUseHexWordLiterals dflags =\n  Opt_HexWordLiterals `EnumSet.member` generalFlags dflags\n\n-- | Are we building with @-fPIE@ or @-fPIC@ enabled?\npositionIndependent :: DynFlags -> Bool\npositionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags\n\n-----------------------------------------------------------------------------\n-- Ways\n\n-- The central concept of a \"way\" is that all objects in a given\n-- program must be compiled in the same \"way\".  Certain options change\n-- parameters of the virtual machine, eg. profiling adds an extra word\n-- to the object header, so profiling objects cannot be linked with\n-- non-profiling objects.\n\n-- After parsing the command-line options, we determine which \"way\" we\n-- are building - this might be a combination way, eg. profiling+threaded.\n\n-- We then find the \"build-tag\" associated with this way, and this\n-- becomes the suffix used to find .hi files and libraries used in\n-- this compilation.\n\ndata Way\n  = WayCustom String -- for GHC API clients building custom variants\n  | WayThreaded\n  | WayDebug\n  | WayProf\n  | WayEventLog\n  | WayDyn\n  deriving (Eq, Ord, Show)\n\nallowed_combination :: [Way] -> Bool\nallowed_combination way = and [ x `allowedWith` y\n                              | x <- way, y <- way, x < y ]\n  where\n        -- Note ordering in these tests: the left argument is\n        -- <= the right argument, according to the Ord instance\n        -- on Way above.\n\n        -- dyn is allowed with everything\n        _ `allowedWith` WayDyn                  = True\n        WayDyn `allowedWith` _                  = True\n\n        -- debug is allowed with everything\n        _ `allowedWith` WayDebug                = True\n        WayDebug `allowedWith` _                = True\n\n        (WayCustom {}) `allowedWith` _          = True\n        WayThreaded `allowedWith` WayProf       = True\n        WayThreaded `allowedWith` WayEventLog   = True\n        WayProf     `allowedWith` WayEventLog   = True\n        _ `allowedWith` _                       = False\n\nmkBuildTag :: [Way] -> String\nmkBuildTag ways = concat (intersperse \"_\" (map wayTag ways))\n\nwayTag :: Way -> String\nwayTag (WayCustom xs) = xs\nwayTag WayThreaded = \"thr\"\nwayTag WayDebug    = \"debug\"\nwayTag WayDyn      = \"dyn\"\nwayTag WayProf     = \"p\"\nwayTag WayEventLog = \"l\"\n\nwayRTSOnly :: Way -> Bool\nwayRTSOnly (WayCustom {}) = False\nwayRTSOnly WayThreaded = True\nwayRTSOnly WayDebug    = True\nwayRTSOnly WayDyn      = False\nwayRTSOnly WayProf     = False\nwayRTSOnly WayEventLog = True\n\nwayDesc :: Way -> String\nwayDesc (WayCustom xs) = xs\nwayDesc WayThreaded = \"Threaded\"\nwayDesc WayDebug    = \"Debug\"\nwayDesc WayDyn      = \"Dynamic\"\nwayDesc WayProf     = \"Profiling\"\nwayDesc WayEventLog = \"RTS Event Logging\"\n\n-- Turn these flags on when enabling this way\nwayGeneralFlags :: Platform -> Way -> [GeneralFlag]\nwayGeneralFlags _ (WayCustom {}) = []\nwayGeneralFlags _ WayThreaded = []\nwayGeneralFlags _ WayDebug    = []\nwayGeneralFlags _ WayDyn      = [Opt_PIC, Opt_ExternalDynamicRefs]\n    -- We could get away without adding -fPIC when compiling the\n    -- modules of a program that is to be linked with -dynamic; the\n    -- program itself does not need to be position-independent, only\n    -- the libraries need to be.  HOWEVER, GHCi links objects into a\n    -- .so before loading the .so using the system linker.  Since only\n    -- PIC objects can be linked into a .so, we have to compile even\n    -- modules of the main program with -fPIC when using -dynamic.\nwayGeneralFlags _ WayProf     = [Opt_SccProfilingOn]\nwayGeneralFlags _ WayEventLog = []\n\n-- Turn these flags off when enabling this way\nwayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]\nwayUnsetGeneralFlags _ (WayCustom {}) = []\nwayUnsetGeneralFlags _ WayThreaded = []\nwayUnsetGeneralFlags _ WayDebug    = []\nwayUnsetGeneralFlags _ WayDyn      = [-- There's no point splitting\n                                      -- when we're going to be dynamically\n                                      -- linking. Plus it breaks compilation\n                                      -- on OSX x86.\n                                      Opt_SplitSections]\nwayUnsetGeneralFlags _ WayProf     = []\nwayUnsetGeneralFlags _ WayEventLog = []\n\nwayOptc :: Platform -> Way -> [String]\nwayOptc _ (WayCustom {}) = []\nwayOptc platform WayThreaded = case platformOS platform of\n                               OSOpenBSD -> [\"-pthread\"]\n                               OSNetBSD  -> [\"-pthread\"]\n                               _         -> []\nwayOptc _ WayDebug      = []\nwayOptc _ WayDyn        = []\nwayOptc _ WayProf       = [\"-DPROFILING\"]\nwayOptc _ WayEventLog   = [\"-DTRACING\"]\n\nwayOptl :: Platform -> Way -> [String]\nwayOptl _ (WayCustom {}) = []\nwayOptl platform WayThreaded =\n        case platformOS platform of\n        OSFreeBSD  -> [\"-pthread\"]\n        OSOpenBSD  -> [\"-pthread\"]\n        OSNetBSD   -> [\"-pthread\"]\n        _          -> []\nwayOptl _ WayDebug      = []\nwayOptl _ WayDyn        = []\nwayOptl _ WayProf       = []\nwayOptl _ WayEventLog   = []\n\nwayOptP :: Platform -> Way -> [String]\nwayOptP _ (WayCustom {}) = []\nwayOptP _ WayThreaded = []\nwayOptP _ WayDebug    = []\nwayOptP _ WayDyn      = []\nwayOptP _ WayProf     = [\"-DPROFILING\"]\nwayOptP _ WayEventLog = [\"-DTRACING\"]\n\nwhenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m ()\nwhenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ())\n\nifGeneratingDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a\nifGeneratingDynamicToo dflags f g = generateDynamicTooConditional dflags f g g\n\nwhenCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m () -> m ()\nwhenCannotGenerateDynamicToo dflags f\n    = ifCannotGenerateDynamicToo dflags f (return ())\n\nifCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a\nifCannotGenerateDynamicToo dflags f g\n    = generateDynamicTooConditional dflags g f g\n\ngenerateDynamicTooConditional :: MonadIO m\n                              => DynFlags -> m a -> m a -> m a -> m a\ngenerateDynamicTooConditional dflags canGen cannotGen notTryingToGen\n    = if gopt Opt_BuildDynamicToo dflags\n      then do let ref = canGenerateDynamicToo dflags\n              b <- liftIO $ readIORef ref\n              if b then canGen else cannotGen\n      else notTryingToGen\n\ndynamicTooMkDynamicDynFlags :: DynFlags -> DynFlags\ndynamicTooMkDynamicDynFlags dflags0\n    = let dflags1 = addWay' WayDyn dflags0\n          dflags2 = dflags1 {\n                        outputFile = dynOutputFile dflags1,\n                        hiSuf = dynHiSuf dflags1,\n                        objectSuf = dynObjectSuf dflags1\n                    }\n          dflags3 = updateWays dflags2\n          dflags4 = gopt_unset dflags3 Opt_BuildDynamicToo\n      in dflags4\n\n-----------------------------------------------------------------------------\n\n-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value\ninitDynFlags :: DynFlags -> IO DynFlags\ninitDynFlags dflags = do\n let -- We can't build with dynamic-too on Windows, as labels before\n     -- the fork point are different depending on whether we are\n     -- building dynamically or not.\n     platformCanGenerateDynamicToo\n         = platformOS (targetPlatform dflags) /= OSMinGW32\n refCanGenerateDynamicToo <- newIORef platformCanGenerateDynamicToo\n refNextTempSuffix <- newIORef 0\n refFilesToClean <- newIORef emptyFilesToClean\n refDirsToClean <- newIORef Map.empty\n refGeneratedDumps <- newIORef Set.empty\n refRtldInfo <- newIORef Nothing\n refRtccInfo <- newIORef Nothing\n wrapperNum <- newIORef emptyModuleEnv\n canUseUnicode <- do let enc = localeEncoding\n                         str = \"\u00e2\u20ac\u02dc\u00e2\u20ac\u2122\"\n                     (withCString enc str $ \\cstr ->\n                          do str' <- peekCString enc cstr\n                             return (str == str'))\n                         `catchIOError` \\_ -> return False\n canUseColor <- stderrSupportsAnsiColors\n maybeGhcColorsEnv  <- lookupEnv \"GHC_COLORS\"\n maybeGhcColoursEnv <- lookupEnv \"GHC_COLOURS\"\n let adjustCols (Just env) = Col.parseScheme env\n     adjustCols Nothing    = id\n let (useColor', colScheme') =\n       (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv)\n       (useColor dflags, colScheme dflags)\n return dflags{\n        canGenerateDynamicToo = refCanGenerateDynamicToo,\n        nextTempSuffix = refNextTempSuffix,\n        filesToClean   = refFilesToClean,\n        dirsToClean    = refDirsToClean,\n        generatedDumps = refGeneratedDumps,\n        nextWrapperNum = wrapperNum,\n        useUnicode    = canUseUnicode,\n        useColor      = useColor',\n        canUseColor   = canUseColor,\n        colScheme     = colScheme',\n        rtldInfo      = refRtldInfo,\n        rtccInfo      = refRtccInfo\n        }\n\n-- | The normal 'DynFlags'. Note that they are not suitable for use in this form\n-- and must be fully initialized by 'GHC.runGhc' first.\ndefaultDynFlags :: Settings -> LlvmConfig -> DynFlags\ndefaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =\n-- See Note [Updating flag description in the User's Guide]\n     DynFlags {\n        ghcMode                 = CompManager,\n        ghcLink                 = LinkBinary,\n        hscTarget               = defaultHscTarget (sTargetPlatform mySettings),\n        integerLibrary          = cIntegerLibraryType,\n        verbosity               = 0,\n        optLevel                = 0,\n        debugLevel              = 0,\n        simplPhases             = 2,\n        maxSimplIterations      = 4,\n        maxPmCheckIterations    = 2000000,\n        ruleCheck               = Nothing,\n        inlineCheck             = Nothing,\n        binBlobThreshold        = 500000, -- 500K is a good default (see #16190)\n        maxRelevantBinds        = Just 6,\n        maxValidHoleFits   = Just 6,\n        maxRefHoleFits     = Just 6,\n        refLevelHoleFits   = Nothing,\n        maxUncoveredPatterns    = 4,\n        simplTickFactor         = 100,\n        specConstrThreshold     = Just 2000,\n        specConstrCount         = Just 3,\n        specConstrRecursive     = 3,\n        liberateCaseThreshold   = Just 2000,\n        floatLamArgs            = Just 0, -- Default: float only if no fvs\n        liftLamsRecArgs         = Just 5, -- Default: the number of available argument hardware registers on x86_64\n        liftLamsNonRecArgs      = Just 5, -- Default: the number of available argument hardware registers on x86_64\n        liftLamsKnown           = False,  -- Default: don't turn known calls into unknown ones\n        cmmProcAlignment        = Nothing,\n\n        historySize             = 20,\n        strictnessBefore        = [],\n\n        parMakeCount            = Just 1,\n\n        enableTimeStats         = False,\n        ghcHeapSize             = Nothing,\n\n        importPaths             = [\".\"],\n        mainModIs               = mAIN,\n        mainFunIs               = Nothing,\n        reductionDepth          = treatZeroAsInf mAX_REDUCTION_DEPTH,\n        solverIterations        = treatZeroAsInf mAX_SOLVER_ITERATIONS,\n\n        thisInstalledUnitId     = toInstalledUnitId mainUnitId,\n        thisUnitIdInsts_        = Nothing,\n        thisComponentId_        = Nothing,\n\n        objectDir               = Nothing,\n        dylibInstallName        = Nothing,\n        hiDir                   = Nothing,\n        hieDir                  = Nothing,\n        stubDir                 = Nothing,\n        dumpDir                 = Nothing,\n\n        objectSuf               = phaseInputExt StopLn,\n        hcSuf                   = phaseInputExt HCc,\n        hiSuf                   = \"hi\",\n        hieSuf                  = \"hie\",\n\n        canGenerateDynamicToo   = panic \"defaultDynFlags: No canGenerateDynamicToo\",\n        dynObjectSuf            = \"dyn_\" ++ phaseInputExt StopLn,\n        dynHiSuf                = \"dyn_hi\",\n\n        pluginModNames          = [],\n        pluginModNameOpts       = [],\n        frontendPluginOpts      = [],\n        cachedPlugins           = [],\n        staticPlugins           = [],\n        hooks                   = emptyHooks,\n\n        outputFile              = Nothing,\n        dynOutputFile           = Nothing,\n        outputHi                = Nothing,\n        dynLibLoader            = SystemDependent,\n        dumpPrefix              = Nothing,\n        dumpPrefixForce         = Nothing,\n        ldInputs                = [],\n        includePaths            = IncludeSpecs [] [],\n        libraryPaths            = [],\n        frameworkPaths          = [],\n        cmdlineFrameworks       = [],\n        rtsOpts                 = Nothing,\n        rtsOptsEnabled          = RtsOptsSafeOnly,\n        rtsOptsSuggestions      = True,\n\n        hpcDir                  = \".hpc\",\n\n        packageDBFlags          = [],\n        packageFlags            = [],\n        pluginPackageFlags      = [],\n        ignorePackageFlags      = [],\n        trustFlags              = [],\n        packageEnv              = Nothing,\n        pkgDatabase             = Nothing,\n        -- This gets filled in with GHC.setSessionDynFlags\n        pkgState                = emptyPackageState,\n        ways                    = defaultWays mySettings,\n        buildTag                = mkBuildTag (defaultWays mySettings),\n        splitInfo               = Nothing,\n        settings                = mySettings,\n        llvmTargets             = myLlvmTargets,\n        llvmPasses              = myLlvmPasses,\n\n        -- ghc -M values\n        depMakefile       = \"Makefile\",\n        depIncludePkgDeps = False,\n        depExcludeMods    = [],\n        depSuffixes       = [],\n        -- end of ghc -M values\n        nextTempSuffix = panic \"defaultDynFlags: No nextTempSuffix\",\n        filesToClean   = panic \"defaultDynFlags: No filesToClean\",\n        dirsToClean    = panic \"defaultDynFlags: No dirsToClean\",\n        generatedDumps = panic \"defaultDynFlags: No generatedDumps\",\n        ghcVersionFile = Nothing,\n        haddockOptions = Nothing,\n        dumpFlags = EnumSet.empty,\n        generalFlags = EnumSet.fromList (defaultFlags mySettings),\n        warningFlags = EnumSet.fromList standardWarnings,\n        fatalWarningFlags = EnumSet.empty,\n        ghciScripts = [],\n        language = Nothing,\n        safeHaskell = Sf_None,\n        safeInfer   = True,\n        safeInferred = True,\n        thOnLoc = noSrcSpan,\n        newDerivOnLoc = noSrcSpan,\n        overlapInstLoc = noSrcSpan,\n        incoherentOnLoc = noSrcSpan,\n        pkgTrustOnLoc = noSrcSpan,\n        warnSafeOnLoc = noSrcSpan,\n        warnUnsafeOnLoc = noSrcSpan,\n        trustworthyOnLoc = noSrcSpan,\n        extensions = [],\n        extensionFlags = flattenExtensionFlags Nothing [],\n\n        -- The ufCreationThreshold threshold must be reasonably high to\n        -- take account of possible discounts.\n        -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to inline\n        -- into Csg.calc (The unfolding for sqr never makes it into the\n        -- interface file.)\n        ufCreationThreshold = 750,\n        ufUseThreshold      = 60,\n        ufFunAppDiscount    = 60,\n        -- Be fairly keen to inline a function if that means\n        -- we'll be able to pick the right method from a dictionary\n        ufDictDiscount      = 30,\n        ufKeenessFactor     = 1.5,\n        ufDearOp            = 40,\n        ufVeryAggressive    = False,\n\n        maxWorkerArgs = 10,\n\n        ghciHistSize = 50, -- keep a log of length 50 by default\n\n        -- Logging\n\n        log_action = defaultLogAction,\n\n        flushOut = defaultFlushOut,\n        flushErr = defaultFlushErr,\n        pprUserLength = 5,\n        pprCols = 100,\n        useUnicode = False,\n        useColor = Auto,\n        canUseColor = False,\n        colScheme = Col.defaultScheme,\n        profAuto = NoProfAuto,\n        interactivePrint = Nothing,\n        nextWrapperNum = panic \"defaultDynFlags: No nextWrapperNum\",\n        sseVersion = Nothing,\n        bmiVersion = Nothing,\n        avx = False,\n        avx2 = False,\n        avx512cd = False,\n        avx512er = False,\n        avx512f = False,\n        avx512pf = False,\n        rtldInfo = panic \"defaultDynFlags: no rtldInfo\",\n        rtccInfo = panic \"defaultDynFlags: no rtccInfo\",\n\n        maxInlineAllocSize = 128,\n        maxInlineMemcpyInsns = 32,\n        maxInlineMemsetInsns = 32,\n\n        initialUnique = 0,\n        uniqueIncrement = 1,\n\n        reverseErrors = False,\n        maxErrors     = Nothing,\n        cfgWeightInfo = defaultCfgWeights\n      }\n\ndefaultWays :: Settings -> [Way]\ndefaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)\n                       then [WayDyn]\n                       else []\n\ninterpWays :: [Way]\ninterpWays\n  | dynamicGhc = [WayDyn]\n  | rtsIsProfiled = [WayProf]\n  | otherwise = []\n\ninterpreterProfiled :: DynFlags -> Bool\ninterpreterProfiled dflags\n  | gopt Opt_ExternalInterpreter dflags = gopt Opt_SccProfilingOn dflags\n  | otherwise = rtsIsProfiled\n\ninterpreterDynamic :: DynFlags -> Bool\ninterpreterDynamic dflags\n  | gopt Opt_ExternalInterpreter dflags = WayDyn `elem` ways dflags\n  | otherwise = dynamicGhc\n\n--------------------------------------------------------------------------\n--\n-- Note [JSON Error Messages]\n--\n-- When the user requests the compiler output to be dumped as json\n-- we used to collect them all in an IORef and then print them at the end.\n-- This doesn't work very well with GHCi. (See #14078) So instead we now\n-- use the simpler method of just outputting a JSON document inplace to\n-- stdout.\n--\n-- Before the compiler calls log_action, it has already turned the `ErrMsg`\n-- into a formatted message. This means that we lose some possible\n-- information to provide to the user but refactoring log_action is quite\n-- invasive as it is called in many places. So, for now I left it alone\n-- and we can refine its behaviour as users request different output.\n\ntype FatalMessager = String -> IO ()\n\ntype LogAction = DynFlags\n              -> WarnReason\n              -> Severity\n              -> SrcSpan\n              -> PprStyle\n              -> MsgDoc\n              -> IO ()\n\ndefaultFatalMessager :: FatalMessager\ndefaultFatalMessager = hPutStrLn stderr\n\n\n-- See Note [JSON Error Messages]\n--\njsonLogAction :: LogAction\njsonLogAction dflags reason severity srcSpan _style msg\n  = do\n    defaultLogActionHPutStrDoc dflags stdout (doc $$ text \"\")\n                               (mkCodeStyle CStyle)\n    where\n      doc = renderJSON $\n              JSObject [ ( \"span\", json srcSpan )\n                       , ( \"doc\" , JSString (showSDoc dflags msg) )\n                       , ( \"severity\", json severity )\n                       , ( \"reason\" ,   json reason )\n                       ]\n\n\ndefaultLogAction :: LogAction\ndefaultLogAction dflags reason severity srcSpan style msg\n    = case severity of\n      SevOutput      -> printOut msg style\n      SevDump        -> printOut (msg $$ blankLine) style\n      SevInteractive -> putStrSDoc msg style\n      SevInfo        -> printErrs msg style\n      SevFatal       -> printErrs msg style\n      SevWarning     -> printWarns\n      SevError       -> printWarns\n    where\n      printOut   = defaultLogActionHPrintDoc  dflags stdout\n      printErrs  = defaultLogActionHPrintDoc  dflags stderr\n      putStrSDoc = defaultLogActionHPutStrDoc dflags stdout\n      -- Pretty print the warning flag, if any (#10752)\n      message = mkLocMessageAnn flagMsg severity srcSpan msg\n\n      printWarns = do\n        hPutChar stderr '\\n'\n        caretDiagnostic <-\n            if gopt Opt_DiagnosticsShowCaret dflags\n            then getCaretDiagnostic severity srcSpan\n            else pure empty\n        printErrs (message $+$ caretDiagnostic)\n            (setStyleColoured True style)\n        -- careful (#2302): printErrs prints in UTF-8,\n        -- whereas converting to string first and using\n        -- hPutStr would just emit the low 8 bits of\n        -- each unicode char.\n\n      flagMsg =\n        case reason of\n          NoReason -> Nothing\n          Reason wflag -> do\n            spec <- flagSpecOf wflag\n            return (\"-W\" ++ flagSpecName spec ++ warnFlagGrp wflag)\n          ErrReason Nothing ->\n            return \"-Werror\"\n          ErrReason (Just wflag) -> do\n            spec <- flagSpecOf wflag\n            return $\n              \"-W\" ++ flagSpecName spec ++ warnFlagGrp wflag ++\n              \", -Werror=\" ++ flagSpecName spec\n\n      warnFlagGrp flag\n          | gopt Opt_ShowWarnGroups dflags =\n                case smallestGroups flag of\n                    [] -> \"\"\n                    groups -> \" (in \" ++ intercalate \", \" (map (\"-W\"++) groups) ++ \")\"\n          | otherwise = \"\"\n\n-- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.\ndefaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()\ndefaultLogActionHPrintDoc dflags h d sty\n = defaultLogActionHPutStrDoc dflags h (d $$ text \"\") sty\n\ndefaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()\ndefaultLogActionHPutStrDoc dflags h d sty\n  -- Don't add a newline at the end, so that successive\n  -- calls to this log-action can output all on the same line\n  = printSDoc Pretty.PageMode dflags h sty d\n\nnewtype FlushOut = FlushOut (IO ())\n\ndefaultFlushOut :: FlushOut\ndefaultFlushOut = FlushOut $ hFlush stdout\n\nnewtype FlushErr = FlushErr (IO ())\n\ndefaultFlushErr :: FlushErr\ndefaultFlushErr = FlushErr $ hFlush stderr\n\n{-\nNote [Verbosity levels]\n~~~~~~~~~~~~~~~~~~~~~~~\n    0   |   print errors & warnings only\n    1   |   minimal verbosity: print \"compiling M ... done.\" for each module.\n    2   |   equivalent to -dshow-passes\n    3   |   equivalent to existing \"ghc -v\"\n    4   |   \"ghc -v -ddump-most\"\n    5   |   \"ghc -v -ddump-all\"\n-}\n\ndata OnOff a = On a\n             | Off a\n  deriving (Eq, Show)\n\ninstance Outputable a => Outputable (OnOff a) where\n  ppr (On x)  = text \"On\" <+> ppr x\n  ppr (Off x) = text \"Off\" <+> ppr x\n\n-- OnOffs accumulate in reverse order, so we use foldr in order to\n-- process them in the right order\nflattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension\nflattenExtensionFlags ml = foldr f defaultExtensionFlags\n    where f (On f)  flags = EnumSet.insert f flags\n          f (Off f) flags = EnumSet.delete f flags\n          defaultExtensionFlags = EnumSet.fromList (languageExtensions ml)\n\nlanguageExtensions :: Maybe Language -> [LangExt.Extension]\n\nlanguageExtensions Nothing\n    -- Nothing => the default case\n    = LangExt.NondecreasingIndentation -- This has been on by default for some time\n    : delete LangExt.DatatypeContexts  -- The Haskell' committee decided to\n                                       -- remove datatype contexts from the\n                                       -- language:\n   -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html\n      (languageExtensions (Just Haskell2010))\n\n   -- NB: MonoPatBinds is no longer the default\n\nlanguageExtensions (Just Haskell98)\n    = [LangExt.ImplicitPrelude,\n       -- See Note [When is StarIsType enabled]\n       LangExt.StarIsType,\n       LangExt.MonadFailDesugaring,\n       LangExt.MonomorphismRestriction,\n       LangExt.NPlusKPatterns,\n       LangExt.DatatypeContexts,\n       LangExt.TraditionalRecordSyntax,\n       LangExt.NondecreasingIndentation\n           -- strictly speaking non-standard, but we always had this\n           -- on implicitly before the option was added in 7.1, and\n           -- turning it off breaks code, so we're keeping it on for\n           -- backwards compatibility.  Cabal uses -XHaskell98 by\n           -- default unless you specify another language.\n      ]\n\nlanguageExtensions (Just Haskell2010)\n    = [LangExt.ImplicitPrelude,\n       -- See Note [When is StarIsType enabled]\n       LangExt.StarIsType,\n       LangExt.MonadFailDesugaring,\n       LangExt.MonomorphismRestriction,\n       LangExt.DatatypeContexts,\n       LangExt.TraditionalRecordSyntax,\n       LangExt.EmptyDataDecls,\n       LangExt.ForeignFunctionInterface,\n       LangExt.PatternGuards,\n       LangExt.DoAndIfThenElse,\n       LangExt.RelaxedPolyRec]\n\nhasPprDebug :: DynFlags -> Bool\nhasPprDebug = dopt Opt_D_ppr_debug\n\nhasNoDebugOutput :: DynFlags -> Bool\nhasNoDebugOutput = dopt Opt_D_no_debug_output\n\nhasNoStateHack :: DynFlags -> Bool\nhasNoStateHack = gopt Opt_G_NoStateHack\n\nhasNoOptCoercion :: DynFlags -> Bool\nhasNoOptCoercion = gopt Opt_G_NoOptCoercion\n\n\n-- | Test whether a 'DumpFlag' is set\ndopt :: DumpFlag -> DynFlags -> Bool\ndopt f dflags = (f `EnumSet.member` dumpFlags dflags)\n             || (verbosity dflags >= 4 && enableIfVerbose f)\n    where enableIfVerbose Opt_D_dump_tc_trace               = False\n          enableIfVerbose Opt_D_dump_rn_trace               = False\n          enableIfVerbose Opt_D_dump_cs_trace               = False\n          enableIfVerbose Opt_D_dump_if_trace               = False\n          enableIfVerbose Opt_D_dump_vt_trace               = False\n          enableIfVerbose Opt_D_dump_tc                     = False\n          enableIfVerbose Opt_D_dump_rn                     = False\n          enableIfVerbose Opt_D_dump_shape                  = False\n          enableIfVerbose Opt_D_dump_rn_stats               = False\n          enableIfVerbose Opt_D_dump_hi_diffs               = False\n          enableIfVerbose Opt_D_verbose_core2core           = False\n          enableIfVerbose Opt_D_verbose_stg2stg             = False\n          enableIfVerbose Opt_D_dump_splices                = False\n          enableIfVerbose Opt_D_th_dec_file                 = False\n          enableIfVerbose Opt_D_dump_rule_firings           = False\n          enableIfVerbose Opt_D_dump_rule_rewrites          = False\n          enableIfVerbose Opt_D_dump_simpl_trace            = False\n          enableIfVerbose Opt_D_dump_rtti                   = False\n          enableIfVerbose Opt_D_dump_inlinings              = False\n          enableIfVerbose Opt_D_dump_core_stats             = False\n          enableIfVerbose Opt_D_dump_asm_stats              = False\n          enableIfVerbose Opt_D_dump_types                  = False\n          enableIfVerbose Opt_D_dump_simpl_iterations       = False\n          enableIfVerbose Opt_D_dump_ticked                 = False\n          enableIfVerbose Opt_D_dump_view_pattern_commoning = False\n          enableIfVerbose Opt_D_dump_mod_cycles             = False\n          enableIfVerbose Opt_D_dump_mod_map                = False\n          enableIfVerbose Opt_D_dump_ec_trace               = False\n          enableIfVerbose _                                 = True\n\n-- | Set a 'DumpFlag'\ndopt_set :: DynFlags -> DumpFlag -> DynFlags\ndopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }\n\n-- | Unset a 'DumpFlag'\ndopt_unset :: DynFlags -> DumpFlag -> DynFlags\ndopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) }\n\n-- | Test whether a 'GeneralFlag' is set\ngopt :: GeneralFlag -> DynFlags -> Bool\ngopt f dflags  = f `EnumSet.member` generalFlags dflags\n\n-- | Set a 'GeneralFlag'\ngopt_set :: DynFlags -> GeneralFlag -> DynFlags\ngopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }\n\n-- | Unset a 'GeneralFlag'\ngopt_unset :: DynFlags -> GeneralFlag -> DynFlags\ngopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }\n\n-- | Test whether a 'WarningFlag' is set\nwopt :: WarningFlag -> DynFlags -> Bool\nwopt f dflags  = f `EnumSet.member` warningFlags dflags\n\n-- | Set a 'WarningFlag'\nwopt_set :: DynFlags -> WarningFlag -> DynFlags\nwopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }\n\n-- | Unset a 'WarningFlag'\nwopt_unset :: DynFlags -> WarningFlag -> DynFlags\nwopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }\n\n-- | Test whether a 'WarningFlag' is set as fatal\nwopt_fatal :: WarningFlag -> DynFlags -> Bool\nwopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags\n\n-- | Mark a 'WarningFlag' as fatal (do not set the flag)\nwopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags\nwopt_set_fatal dfs f\n    = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }\n\n-- | Mark a 'WarningFlag' as not fatal\nwopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags\nwopt_unset_fatal dfs f\n    = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }\n\n-- | Test whether a 'LangExt.Extension' is set\nxopt :: LangExt.Extension -> DynFlags -> Bool\nxopt f dflags = f `EnumSet.member` extensionFlags dflags\n\n-- | Set a 'LangExt.Extension'\nxopt_set :: DynFlags -> LangExt.Extension -> DynFlags\nxopt_set dfs f\n    = let onoffs = On f : extensions dfs\n      in dfs { extensions = onoffs,\n               extensionFlags = flattenExtensionFlags (language dfs) onoffs }\n\n-- | Unset a 'LangExt.Extension'\nxopt_unset :: DynFlags -> LangExt.Extension -> DynFlags\nxopt_unset dfs f\n    = let onoffs = Off f : extensions dfs\n      in dfs { extensions = onoffs,\n               extensionFlags = flattenExtensionFlags (language dfs) onoffs }\n\n-- | Set or unset a 'LangExt.Extension', unless it has been explicitly\n--   set or unset before.\nxopt_set_unlessExplSpec\n        :: LangExt.Extension\n        -> (DynFlags -> LangExt.Extension -> DynFlags)\n        -> DynFlags -> DynFlags\nxopt_set_unlessExplSpec ext setUnset dflags =\n    let referedExts = stripOnOff <$> extensions dflags\n        stripOnOff (On x)  = x\n        stripOnOff (Off x) = x\n    in\n        if ext `elem` referedExts then dflags else setUnset dflags ext\n\nlang_set :: DynFlags -> Maybe Language -> DynFlags\nlang_set dflags lang =\n   dflags {\n            language = lang,\n            extensionFlags = flattenExtensionFlags lang (extensions dflags)\n          }\n\n-- | An internal helper to check whether to use unicode syntax for output.\n--\n-- Note: You should very likely be using 'Outputable.unicodeSyntax' instead\n-- of this function.\nuseUnicodeSyntax :: DynFlags -> Bool\nuseUnicodeSyntax = gopt Opt_PrintUnicodeSyntax\n\nuseStarIsType :: DynFlags -> Bool\nuseStarIsType = xopt LangExt.StarIsType\n\n-- | Set the Haskell language standard to use\nsetLanguage :: Language -> DynP ()\nsetLanguage l = upd (`lang_set` Just l)\n\n-- | Some modules have dependencies on others through the DynFlags rather than textual imports\ndynFlagDependencies :: DynFlags -> [ModuleName]\ndynFlagDependencies = pluginModNames\n\n-- | Is the -fpackage-trust mode on\npackageTrustOn :: DynFlags -> Bool\npackageTrustOn = gopt Opt_PackageTrust\n\n-- | Is Safe Haskell on in some way (including inference mode)\nsafeHaskellOn :: DynFlags -> Bool\nsafeHaskellOn dflags = safeHaskellModeEnabled dflags || safeInferOn dflags\n\nsafeHaskellModeEnabled :: DynFlags -> Bool\nsafeHaskellModeEnabled dflags = safeHaskell dflags `elem` [Sf_Unsafe, Sf_Trustworthy\n                                                   , Sf_Safe ]\n\n\n-- | Is the Safe Haskell safe language in use\nsafeLanguageOn :: DynFlags -> Bool\nsafeLanguageOn dflags = safeHaskell dflags == Sf_Safe\n\n-- | Is the Safe Haskell safe inference mode active\nsafeInferOn :: DynFlags -> Bool\nsafeInferOn = safeInfer\n\n-- | Test if Safe Imports are on in some form\nsafeImportsOn :: DynFlags -> Bool\nsafeImportsOn dflags = safeHaskell dflags == Sf_Unsafe ||\n                       safeHaskell dflags == Sf_Trustworthy ||\n                       safeHaskell dflags == Sf_Safe\n\n-- | Set a 'Safe Haskell' flag\nsetSafeHaskell :: SafeHaskellMode -> DynP ()\nsetSafeHaskell s = updM f\n    where f dfs = do\n              let sf = safeHaskell dfs\n              safeM <- combineSafeFlags sf s\n              case s of\n                Sf_Safe -> return $ dfs { safeHaskell = safeM, safeInfer = False }\n                -- leave safe inferrence on in Trustworthy mode so we can warn\n                -- if it could have been inferred safe.\n                Sf_Trustworthy -> do\n                  l <- getCurLoc\n                  return $ dfs { safeHaskell = safeM, trustworthyOnLoc = l }\n                -- leave safe inference on in Unsafe mode as well.\n                _ -> return $ dfs { safeHaskell = safeM }\n\n-- | Are all direct imports required to be safe for this Safe Haskell mode?\n-- Direct imports are when the code explicitly imports a module\nsafeDirectImpsReq :: DynFlags -> Bool\nsafeDirectImpsReq d = safeLanguageOn d\n\n-- | Are all implicit imports required to be safe for this Safe Haskell mode?\n-- Implicit imports are things in the prelude. e.g System.IO when print is used.\nsafeImplicitImpsReq :: DynFlags -> Bool\nsafeImplicitImpsReq d = safeLanguageOn d\n\n-- | Combine two Safe Haskell modes correctly. Used for dealing with multiple flags.\n-- This makes Safe Haskell very much a monoid but for now I prefer this as I don't\n-- want to export this functionality from the module but do want to export the\n-- type constructors.\ncombineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode\ncombineSafeFlags a b | a == Sf_None         = return b\n                     | b == Sf_None         = return a\n                     | a == Sf_Ignore || b == Sf_Ignore = return Sf_Ignore\n                     | a == b               = return a\n                     | otherwise            = addErr errm >> pure a\n    where errm = \"Incompatible Safe Haskell flags! (\"\n                    ++ show a ++ \", \" ++ show b ++ \")\"\n\n-- | A list of unsafe flags under Safe Haskell. Tuple elements are:\n--     * name of the flag\n--     * function to get srcspan that enabled the flag\n--     * function to test if the flag is on\n--     * function to turn the flag off\nunsafeFlags, unsafeFlagsForInfer\n  :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]\nunsafeFlags = [ (\"-XGeneralizedNewtypeDeriving\", newDerivOnLoc,\n                    xopt LangExt.GeneralizedNewtypeDeriving,\n                    flip xopt_unset LangExt.GeneralizedNewtypeDeriving)\n              , (\"-XTemplateHaskell\", thOnLoc,\n                    xopt LangExt.TemplateHaskell,\n                    flip xopt_unset LangExt.TemplateHaskell)\n              ]\nunsafeFlagsForInfer = unsafeFlags\n\n\n-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order\ngetOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from\n        -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors\n        -> [a]                  -- ^ Correctly ordered extracted options\ngetOpts dflags opts = reverse (opts dflags)\n        -- We add to the options from the front, so we need to reverse the list\n\n-- | Gets the verbosity flag for the current verbosity level. This is fed to\n-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included\ngetVerbFlags :: DynFlags -> [String]\ngetVerbFlags dflags\n  | verbosity dflags >= 4 = [\"-v\"]\n  | otherwise             = []\n\nsetObjectDir, setHiDir, setHieDir, setStubDir, setDumpDir, setOutputDir,\n         setDynObjectSuf, setDynHiSuf,\n         setDylibInstallName,\n         setObjectSuf, setHiSuf, setHieSuf, setHcSuf, parseDynLibLoaderMode,\n         setPgmP, addOptl, addOptc, addOptP,\n         addCmdlineFramework, addHaddockOpts, addGhciScript,\n         setInteractivePrint\n   :: String -> DynFlags -> DynFlags\nsetOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce\n   :: Maybe String -> DynFlags -> DynFlags\n\nsetObjectDir  f d = d { objectDir  = Just f}\nsetHiDir      f d = d { hiDir      = Just f}\nsetHieDir     f d = d { hieDir     = Just f}\nsetStubDir    f d = d { stubDir    = Just f\n                      , includePaths = addGlobalInclude (includePaths d) [f] }\n  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file\n  -- \\#included from the .hc file when compiling via C (i.e. unregisterised\n  -- builds).\nsetDumpDir    f d = d { dumpDir    = Just f}\nsetOutputDir  f = setObjectDir f\n                . setHieDir f\n                . setHiDir f\n                . setStubDir f\n                . setDumpDir f\nsetDylibInstallName  f d = d { dylibInstallName = Just f}\n\nsetObjectSuf    f d = d { objectSuf    = f}\nsetDynObjectSuf f d = d { dynObjectSuf = f}\nsetHiSuf        f d = d { hiSuf        = f}\nsetHieSuf       f d = d { hieSuf       = f}\nsetDynHiSuf     f d = d { dynHiSuf     = f}\nsetHcSuf        f d = d { hcSuf        = f}\n\nsetOutputFile f d = d { outputFile = f}\nsetDynOutputFile f d = d { dynOutputFile = f}\nsetOutputHi   f d = d { outputHi   = f}\n\nsetJsonLogAction :: DynFlags -> DynFlags\nsetJsonLogAction d = d { log_action = jsonLogAction }\n\nthisComponentId :: DynFlags -> ComponentId\nthisComponentId dflags =\n  case thisComponentId_ dflags of\n    Just cid -> cid\n    Nothing  ->\n      case thisUnitIdInsts_ dflags of\n        Just _  ->\n          throwGhcException $ CmdLineError (\"Use of -instantiated-with requires -this-component-id\")\n        Nothing -> ComponentId (unitIdFS (thisPackage dflags))\n\nthisUnitIdInsts :: DynFlags -> [(ModuleName, Module)]\nthisUnitIdInsts dflags =\n    case thisUnitIdInsts_ dflags of\n        Just insts -> insts\n        Nothing    -> []\n\nthisPackage :: DynFlags -> UnitId\nthisPackage dflags =\n    case thisUnitIdInsts_ dflags of\n        Nothing -> default_uid\n        Just insts\n          | all (\\(x,y) -> mkHoleModule x == y) insts\n          -> newUnitId (thisComponentId dflags) insts\n          | otherwise\n          -> default_uid\n  where\n    default_uid = DefiniteUnitId (DefUnitId (thisInstalledUnitId dflags))\n\nparseUnitIdInsts :: String -> [(ModuleName, Module)]\nparseUnitIdInsts str = case filter ((==\"\").snd) (readP_to_S parse str) of\n    [(r, \"\")] -> r\n    _ -> throwGhcException $ CmdLineError (\"Can't parse -instantiated-with: \" ++ str)\n  where parse = sepBy parseEntry (R.char ',')\n        parseEntry = do\n            n <- parseModuleName\n            _ <- R.char '='\n            m <- parseModuleId\n            return (n, m)\n\nsetUnitIdInsts :: String -> DynFlags -> DynFlags\nsetUnitIdInsts s d =\n    d { thisUnitIdInsts_ = Just (parseUnitIdInsts s) }\n\nsetComponentId :: String -> DynFlags -> DynFlags\nsetComponentId s d =\n    d { thisComponentId_ = Just (ComponentId (fsLit s)) }\n\naddPluginModuleName :: String -> DynFlags -> DynFlags\naddPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }\n\nclearPluginModuleNames :: DynFlags -> DynFlags\nclearPluginModuleNames d =\n    d { pluginModNames = []\n      , pluginModNameOpts = []\n      , cachedPlugins = [] }\n\naddPluginModuleNameOption :: String -> DynFlags -> DynFlags\naddPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }\n  where (m, rest) = break (== ':') optflag\n        option = case rest of\n          [] -> \"\" -- should probably signal an error\n          (_:plug_opt) -> plug_opt -- ignore the ':' from break\n\naddFrontendPluginOption :: String -> DynFlags -> DynFlags\naddFrontendPluginOption s d = d { frontendPluginOpts = s : frontendPluginOpts d }\n\nparseDynLibLoaderMode f d =\n case splitAt 8 f of\n   (\"deploy\", \"\")       -> d { dynLibLoader = Deployable }\n   (\"sysdep\", \"\")       -> d { dynLibLoader = SystemDependent }\n   _                    -> throwGhcException (CmdLineError (\"Unknown dynlib loader: \" ++ f))\n\nsetDumpPrefixForce f d = d { dumpPrefixForce = f}\n\n-- XXX HACK: Prelude> words \"'does not' work\" ===> [\"'does\",\"not'\",\"work\"]\n-- Config.hs should really use Option.\nsetPgmP   f = let (pgm:args) = words f in alterSettings (\\s -> s { sPgm_P   = (pgm, map Option args)})\naddOptl   f = alterSettings (\\s -> s { sOpt_l   = f : sOpt_l s})\naddOptc   f = alterSettings (\\s -> s { sOpt_c   = f : sOpt_c s})\naddOptP   f = alterSettings (\\s -> s { sOpt_P   = f : sOpt_P s\n                                     , sOpt_P_fingerprint = fingerprintStrings (f : sOpt_P s)\n                                     })\n                                     -- See Note [Repeated -optP hashing]\n  where\n  fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss\n\n\nsetDepMakefile :: FilePath -> DynFlags -> DynFlags\nsetDepMakefile f d = d { depMakefile = f }\n\nsetDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags\nsetDepIncludePkgDeps b d = d { depIncludePkgDeps = b }\n\naddDepExcludeMod :: String -> DynFlags -> DynFlags\naddDepExcludeMod m d\n    = d { depExcludeMods = mkModuleName m : depExcludeMods d }\n\naddDepSuffix :: FilePath -> DynFlags -> DynFlags\naddDepSuffix s d = d { depSuffixes = s : depSuffixes d }\n\naddCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d}\n\naddGhcVersionFile :: FilePath -> DynFlags -> DynFlags\naddGhcVersionFile f d = d { ghcVersionFile = Just f }\n\naddHaddockOpts f d = d { haddockOptions = Just f}\n\naddGhciScript f d = d { ghciScripts = f : ghciScripts d}\n\nsetInteractivePrint f d = d { interactivePrint = Just f}\n\n-- -----------------------------------------------------------------------------\n-- Command-line options\n\n-- | When invoking external tools as part of the compilation pipeline, we\n-- pass these a sequence of options on the command-line. Rather than\n-- just using a list of Strings, we use a type that allows us to distinguish\n-- between filepaths and 'other stuff'. The reason for this is that\n-- this type gives us a handle on transforming filenames, and filenames only,\n-- to whatever format they're expected to be on a particular platform.\ndata Option\n = FileOption -- an entry that _contains_ filename(s) / filepaths.\n              String  -- a non-filepath prefix that shouldn't be\n                      -- transformed (e.g., \"/out=\")\n              String  -- the filepath/filename portion\n | Option     String\n deriving ( Eq )\n\nshowOpt :: Option -> String\nshowOpt (FileOption pre f) = pre ++ f\nshowOpt (Option s)  = s\n\n-----------------------------------------------------------------------------\n-- Setting the optimisation level\n\nupdOptLevel :: Int -> DynFlags -> DynFlags\n-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level\nupdOptLevel n dfs\n  = dfs2{ optLevel = final_n }\n  where\n   final_n = max 0 (min 2 n)    -- Clamp to 0 <= n <= 2\n   dfs1 = foldr (flip gopt_unset) dfs  remove_gopts\n   dfs2 = foldr (flip gopt_set)   dfs1 extra_gopts\n\n   extra_gopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]\n   remove_gopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]\n\n{- **********************************************************************\n%*                                                                      *\n                DynFlags parser\n%*                                                                      *\n%********************************************************************* -}\n\n-- -----------------------------------------------------------------------------\n-- Parsing the dynamic flags.\n\n\n-- | Parse dynamic flags from a list of command line arguments.  Returns the\n-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.\n-- Throws a 'UsageError' if errors occurred during parsing (such as unknown\n-- flags or missing arguments).\nparseDynamicFlagsCmdLine :: MonadIO m => DynFlags -> [Located String]\n                         -> m (DynFlags, [Located String], [Warn])\n                            -- ^ Updated 'DynFlags', left-over arguments, and\n                            -- list of warnings.\nparseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True\n\n\n-- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags\n-- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-db).\n-- Used to parse flags set in a modules pragma.\nparseDynamicFilePragma :: MonadIO m => DynFlags -> [Located String]\n                       -> m (DynFlags, [Located String], [Warn])\n                          -- ^ Updated 'DynFlags', left-over arguments, and\n                          -- list of warnings.\nparseDynamicFilePragma = parseDynamicFlagsFull flagsDynamic False\n\n\n-- | Parses the dynamically set flags for GHC. This is the most general form of\n-- the dynamic flag parser that the other methods simply wrap. It allows\n-- saying which flags are valid flags and indicating if we are parsing\n-- arguments from the command line or from a file pragma.\nparseDynamicFlagsFull :: MonadIO m\n                  => [Flag (CmdLineP DynFlags)]    -- ^ valid flags to match against\n                  -> Bool                          -- ^ are the arguments from the command line?\n                  -> DynFlags                      -- ^ current dynamic flags\n                  -> [Located String]              -- ^ arguments to parse\n                  -> m (DynFlags, [Located String], [Warn])\nparseDynamicFlagsFull activeFlags cmdline dflags0 args = do\n  let ((leftover, errs, warns), dflags1)\n          = runCmdLine (processArgs activeFlags args) dflags0\n\n  -- See Note [Handling errors when parsing commandline flags]\n  unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $\n    map ((showPpr dflags0 . getLoc &&& unLoc) . errMsg) $ errs\n\n  -- check for disabled flags in safe haskell\n  let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1\n      dflags3 = updateWays dflags2\n      theWays = ways dflags3\n\n  unless (allowed_combination theWays) $ liftIO $\n      throwGhcExceptionIO (CmdLineError (\"combination not supported: \" ++\n                               intercalate \"/\" (map wayDesc theWays)))\n\n  let chooseOutput\n        | isJust (outputFile dflags3)          -- Only iff user specified -o ...\n        , not (isJust (dynOutputFile dflags3)) -- but not -dyno\n        = return $ dflags3 { dynOutputFile = Just $ dynOut (fromJust $ outputFile dflags3) }\n        | otherwise\n        = return dflags3\n        where\n          dynOut = flip addExtension (dynObjectSuf dflags3) . dropExtension\n  dflags4 <- ifGeneratingDynamicToo dflags3 chooseOutput (return dflags3)\n\n  let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4\n\n  -- Set timer stats & heap size\n  when (enableTimeStats dflags5) $ liftIO enableTimingStats\n  case (ghcHeapSize dflags5) of\n    Just x -> liftIO (setHeapSize x)\n    _      -> return ()\n\n  liftIO $ setUnsafeGlobalDynFlags dflags5\n\n  let warns' = map (Warn Cmd.NoReason) (consistency_warnings ++ sh_warns)\n\n  return (dflags5, leftover, warns' ++ warns)\n\n-- | Write an error or warning to the 'LogOutput'.\nputLogMsg :: DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle\n          -> MsgDoc -> IO ()\nputLogMsg dflags = log_action dflags dflags\n\nupdateWays :: DynFlags -> DynFlags\nupdateWays dflags\n    = let theWays = sort $ nub $ ways dflags\n      in dflags {\n             ways        = theWays,\n             buildTag    = mkBuildTag (filter (not . wayRTSOnly) theWays)\n         }\n\n-- | Check (and potentially disable) any extensions that aren't allowed\n-- in safe mode.\n--\n-- The bool is to indicate if we are parsing command line flags (false means\n-- file pragma). This allows us to generate better warnings.\nsafeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String])\nsafeFlagCheck _ dflags | safeLanguageOn dflags = (dflagsUnset, warns)\n  where\n    -- Handle illegal flags under safe language.\n    (dflagsUnset, warns) = foldl' check_method (dflags, []) unsafeFlags\n\n    check_method (df, warns) (str,loc,test,fix)\n        | test df   = (fix df, warns ++ safeFailure (loc df) str)\n        | otherwise = (df, warns)\n\n    safeFailure loc str\n       = [L loc $ str ++ \" is not allowed in Safe Haskell; ignoring \"\n           ++ str]\n\nsafeFlagCheck cmdl dflags =\n  case (safeInferOn dflags) of\n    True | safeFlags -> (dflags', warn)\n    True             -> (dflags' { safeInferred = False }, warn)\n    False            -> (dflags', warn)\n\n  where\n    -- dynflags and warn for when -fpackage-trust by itself with no safe\n    -- haskell flag\n    (dflags', warn)\n      | not (safeHaskellModeEnabled dflags) && not cmdl && packageTrustOn dflags\n      = (gopt_unset dflags Opt_PackageTrust, pkgWarnMsg)\n      | otherwise = (dflags, [])\n\n    pkgWarnMsg = [L (pkgTrustOnLoc dflags') $\n                    \"-fpackage-trust ignored;\" ++\n                    \" must be specified with a Safe Haskell flag\"]\n\n    -- Have we inferred Unsafe? See Note [HscMain . Safe Haskell Inference]\n    safeFlags = all (\\(_,_,t,_) -> not $ t dflags) unsafeFlagsForInfer\n\n\n{- **********************************************************************\n%*                                                                      *\n                DynFlags specifications\n%*                                                                      *\n%********************************************************************* -}\n\n-- | All dynamic flags option strings without the deprecated ones.\n-- These are the user facing strings for enabling and disabling options.\nallNonDeprecatedFlags :: [String]\nallNonDeprecatedFlags = allFlagsDeps False\n\n-- | All flags with possibility to filter deprecated ones\nallFlagsDeps :: Bool -> [String]\nallFlagsDeps keepDeprecated = [ '-':flagName flag\n                              | (deprecated, flag) <- flagsAllDeps\n                              , keepDeprecated || not (isDeprecated deprecated)]\n  where isDeprecated Deprecated = True\n        isDeprecated _ = False\n\n{-\n - Below we export user facing symbols for GHC dynamic flags for use with the\n - GHC API.\n -}\n\n-- All dynamic flags present in GHC.\nflagsAll :: [Flag (CmdLineP DynFlags)]\nflagsAll = map snd flagsAllDeps\n\n-- All dynamic flags present in GHC with deprecation information.\nflagsAllDeps :: [(Deprecation, Flag (CmdLineP DynFlags))]\nflagsAllDeps =  package_flags_deps ++ dynamic_flags_deps\n\n\n-- All dynamic flags, minus package flags, present in GHC.\nflagsDynamic :: [Flag (CmdLineP DynFlags)]\nflagsDynamic = map snd dynamic_flags_deps\n\n-- ALl package flags present in GHC.\nflagsPackage :: [Flag (CmdLineP DynFlags)]\nflagsPackage = map snd package_flags_deps\n\n----------------Helpers to make flags and keep deprecation information----------\n\ntype FlagMaker m = String -> OptKind m -> Flag m\ntype DynFlagMaker = FlagMaker (CmdLineP DynFlags)\ndata Deprecation = NotDeprecated | Deprecated deriving (Eq, Ord)\n\n-- Make a non-deprecated flag\nmake_ord_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags)\n              -> (Deprecation, Flag (CmdLineP DynFlags))\nmake_ord_flag fm name kind = (NotDeprecated, fm name kind)\n\n-- Make a deprecated flag\nmake_dep_flag :: DynFlagMaker -> String -> OptKind (CmdLineP DynFlags) -> String\n                 -> (Deprecation, Flag (CmdLineP DynFlags))\nmake_dep_flag fm name kind message = (Deprecated,\n                                      fm name $ add_dep_message kind message)\n\nadd_dep_message :: OptKind (CmdLineP DynFlags) -> String\n                -> OptKind (CmdLineP DynFlags)\nadd_dep_message (NoArg f) message = NoArg $ f >> deprecate message\nadd_dep_message (HasArg f) message = HasArg $ \\s -> f s >> deprecate message\nadd_dep_message (SepArg f) message = SepArg $ \\s -> f s >> deprecate message\nadd_dep_message (Prefix f) message = Prefix $ \\s -> f s >> deprecate message\nadd_dep_message (OptPrefix f) message =\n                                  OptPrefix $ \\s -> f s >> deprecate message\nadd_dep_message (OptIntSuffix f) message =\n                               OptIntSuffix $ \\oi -> f oi >> deprecate message\nadd_dep_message (IntSuffix f) message =\n                                  IntSuffix $ \\i -> f i >> deprecate message\nadd_dep_message (FloatSuffix f) message =\n                                FloatSuffix $ \\fl -> f fl >> deprecate message\nadd_dep_message (PassFlag f) message =\n                                   PassFlag $ \\s -> f s >> deprecate message\nadd_dep_message (AnySuffix f) message =\n                                  AnySuffix $ \\s -> f s >> deprecate message\n\n----------------------- The main flags themselves ------------------------------\n-- See Note [Updating flag description in the User's Guide]\n-- See Note [Supporting CLI completion]\ndynamic_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]\ndynamic_flags_deps = [\n    make_dep_flag defFlag \"n\" (NoArg $ return ())\n        \"The -n flag is deprecated and no longer has any effect\"\n  , make_ord_flag defFlag \"cpp\"      (NoArg (setExtensionFlag LangExt.Cpp))\n  , make_ord_flag defFlag \"F\"        (NoArg (setGeneralFlag Opt_Pp))\n  , (Deprecated, defFlag \"#include\"\n      (HasArg (\\_s ->\n         deprecate (\"-#include and INCLUDE pragmas are \" ++\n                    \"deprecated: They no longer have any effect\"))))\n  , make_ord_flag defFlag \"v\"        (OptIntSuffix setVerbosity)\n\n  , make_ord_flag defGhcFlag \"j\"     (OptIntSuffix\n        (\\n -> case n of\n                 Just n\n                     | n > 0     -> upd (\\d -> d { parMakeCount = Just n })\n                     | otherwise -> addErr \"Syntax: -j[n] where n > 0\"\n                 Nothing -> upd (\\d -> d { parMakeCount = Nothing })))\n                 -- When the number of parallel builds\n                 -- is omitted, it is the same\n                 -- as specifing that the number of\n                 -- parallel builds is equal to the\n                 -- result of getNumProcessors\n  , make_ord_flag defFlag \"instantiated-with\"   (sepArg setUnitIdInsts)\n  , make_ord_flag defFlag \"this-component-id\"   (sepArg setComponentId)\n\n    -- RTS options -------------------------------------------------------------\n  , make_ord_flag defFlag \"H\"           (HasArg (\\s -> upd (\\d ->\n          d { ghcHeapSize = Just $ fromIntegral (decodeSize s)})))\n\n  , make_ord_flag defFlag \"Rghc-timing\" (NoArg (upd (\\d ->\n                                               d { enableTimeStats = True })))\n\n    ------- ways ---------------------------------------------------------------\n  , make_ord_flag defGhcFlag \"prof\"           (NoArg (addWay WayProf))\n  , make_ord_flag defGhcFlag \"eventlog\"       (NoArg (addWay WayEventLog))\n  , make_dep_flag defGhcFlag \"smp\"\n      (NoArg $ addWay WayThreaded) \"Use -threaded instead\"\n  , make_ord_flag defGhcFlag \"debug\"          (NoArg (addWay WayDebug))\n  , make_ord_flag defGhcFlag \"threaded\"       (NoArg (addWay WayThreaded))\n\n  , make_ord_flag defGhcFlag \"ticky\"\n      (NoArg (setGeneralFlag Opt_Ticky >> addWay WayDebug))\n\n    -- -ticky enables ticky-ticky code generation, and also implies -debug which\n    -- is required to get the RTS ticky support.\n\n        ----- Linker --------------------------------------------------------\n  , make_ord_flag defGhcFlag \"static\"         (NoArg removeWayDyn)\n  , make_ord_flag defGhcFlag \"dynamic\"        (NoArg (addWay WayDyn))\n  , make_ord_flag defGhcFlag \"rdynamic\" $ noArg $\n#if defined(linux_HOST_OS)\n                              addOptl \"-rdynamic\"\n#elif defined (mingw32_HOST_OS)\n                              addOptl \"-Wl,--export-all-symbols\"\n#else\n    -- ignored for compat w/ gcc:\n                              id\n#endif\n  , make_ord_flag defGhcFlag \"relative-dynlib-paths\"\n      (NoArg (setGeneralFlag Opt_RelativeDynlibPaths))\n  , make_ord_flag defGhcFlag \"copy-libs-when-linking\"\n      (NoArg (setGeneralFlag Opt_SingleLibFolder))\n  , make_ord_flag defGhcFlag \"pie\"            (NoArg (setGeneralFlag Opt_PICExecutable))\n  , make_ord_flag defGhcFlag \"no-pie\"         (NoArg (unSetGeneralFlag Opt_PICExecutable))\n\n        ------- Specific phases  --------------------------------------------\n    -- need to appear before -pgmL to be parsed as LLVM flags.\n  , make_ord_flag defFlag \"pgmlo\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_lo  = (f,[])})))\n  , make_ord_flag defFlag \"pgmlc\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_lc  = (f,[])})))\n  , make_ord_flag defFlag \"pgmi\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_i  =  f})))\n  , make_ord_flag defFlag \"pgmL\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_L   = f})))\n  , make_ord_flag defFlag \"pgmP\"\n      (hasArg setPgmP)\n  , make_ord_flag defFlag \"pgmF\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_F   = f})))\n  , make_ord_flag defFlag \"pgmc\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_c   = (f,[]),\n                                              -- Don't pass -no-pie with -pgmc\n                                              -- (see Trac #15319)\n                                              sGccSupportsNoPie = False})))\n  , make_ord_flag defFlag \"pgms\"\n      (HasArg (\\_ -> addWarn \"Object splitting was removed in GHC 8.8\"))\n  , make_ord_flag defFlag \"pgma\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_a   = (f,[])})))\n  , make_ord_flag defFlag \"pgml\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_l   = (f,[])})))\n  , make_ord_flag defFlag \"pgmdll\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_dll = (f,[])})))\n  , make_ord_flag defFlag \"pgmwindres\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_windres = f})))\n  , make_ord_flag defFlag \"pgmlibtool\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_libtool = f})))\n  , make_ord_flag defFlag \"pgmar\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_ar = f})))\n  , make_ord_flag defFlag \"pgmranlib\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sPgm_ranlib = f})))\n\n\n    -- need to appear before -optl/-opta to be parsed as LLVM flags.\n  , make_ord_flag defFlag \"optlo\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sOpt_lo  = f : sOpt_lo s})))\n  , make_ord_flag defFlag \"optlc\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sOpt_lc  = f : sOpt_lc s})))\n  , make_ord_flag defFlag \"opti\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sOpt_i   = f : sOpt_i s})))\n  , make_ord_flag defFlag \"optL\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sOpt_L   = f : sOpt_L s})))\n  , make_ord_flag defFlag \"optP\"\n      (hasArg addOptP)\n  , make_ord_flag defFlag \"optF\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sOpt_F   = f : sOpt_F s})))\n  , make_ord_flag defFlag \"optc\"\n      (hasArg addOptc)\n  , make_ord_flag defFlag \"opta\"\n      (hasArg (\\f -> alterSettings (\\s -> s { sOpt_a   = f : sOpt_a s})))\n  , make_ord_flag defFlag \"optl\"\n      (hasArg addOptl)\n  , make_ord_flag defFlag \"optwindres\"\n      (hasArg (\\f ->\n        alterSettings (\\s -> s { sOpt_windres = f : sOpt_windres s})))\n\n  , make_ord_flag defGhcFlag \"split-objs\"\n      (NoArg $ addWarn \"ignoring -split-objs\")\n\n  , make_ord_flag defGhcFlag \"split-sections\"\n      (noArgM (\\dflags -> do\n        if platformHasSubsectionsViaSymbols (targetPlatform dflags)\n          then do addErr $\n                    \"-split-sections is not useful on this platform \" ++\n                    \"since it always uses subsections via symbols.\"\n                  return dflags\n          else return (gopt_set dflags Opt_SplitSections)))\n\n        -------- ghc -M -----------------------------------------------------\n  , make_ord_flag defGhcFlag \"dep-suffix\"              (hasArg addDepSuffix)\n  , make_ord_flag defGhcFlag \"dep-makefile\"            (hasArg setDepMakefile)\n  , make_ord_flag defGhcFlag \"include-pkg-deps\"\n        (noArg (setDepIncludePkgDeps True))\n  , make_ord_flag defGhcFlag \"exclude-module\"          (hasArg addDepExcludeMod)\n\n        -------- Linking ----------------------------------------------------\n  , make_ord_flag defGhcFlag \"no-link\"\n        (noArg (\\d -> d { ghcLink=NoLink }))\n  , make_ord_flag defGhcFlag \"shared\"\n        (noArg (\\d -> d { ghcLink=LinkDynLib }))\n  , make_ord_flag defGhcFlag \"staticlib\"\n        (noArg (\\d -> d { ghcLink=LinkStaticLib }))\n  , make_ord_flag defGhcFlag \"dynload\"            (hasArg parseDynLibLoaderMode)\n  , make_ord_flag defGhcFlag \"dylib-install-name\" (hasArg setDylibInstallName)\n\n        ------- Libraries ---------------------------------------------------\n  , make_ord_flag defFlag \"L\"   (Prefix addLibraryPath)\n  , make_ord_flag defFlag \"l\"   (hasArg (addLdInputs . Option . (\"-l\" ++)))\n\n        ------- Frameworks --------------------------------------------------\n        -- -framework-path should really be -F ...\n  , make_ord_flag defFlag \"framework-path\" (HasArg addFrameworkPath)\n  , make_ord_flag defFlag \"framework\"      (hasArg addCmdlineFramework)\n\n        ------- Output Redirection ------------------------------------------\n  , make_ord_flag defGhcFlag \"odir\"              (hasArg setObjectDir)\n  , make_ord_flag defGhcFlag \"o\"                 (sepArg (setOutputFile . Just))\n  , make_ord_flag defGhcFlag \"dyno\"\n        (sepArg (setDynOutputFile . Just))\n  , make_ord_flag defGhcFlag \"ohi\"\n        (hasArg (setOutputHi . Just ))\n  , make_ord_flag defGhcFlag \"osuf\"              (hasArg setObjectSuf)\n  , make_ord_flag defGhcFlag \"dynosuf\"           (hasArg setDynObjectSuf)\n  , make_ord_flag defGhcFlag \"hcsuf\"             (hasArg setHcSuf)\n  , make_ord_flag defGhcFlag \"hisuf\"             (hasArg setHiSuf)\n  , make_ord_flag defGhcFlag \"hiesuf\"            (hasArg setHieSuf)\n  , make_ord_flag defGhcFlag \"dynhisuf\"          (hasArg setDynHiSuf)\n  , make_ord_flag defGhcFlag \"hidir\"             (hasArg setHiDir)\n  , make_ord_flag defGhcFlag \"hiedir\"            (hasArg setHieDir)\n  , make_ord_flag defGhcFlag \"tmpdir\"            (hasArg setTmpDir)\n  , make_ord_flag defGhcFlag \"stubdir\"           (hasArg setStubDir)\n  , make_ord_flag defGhcFlag \"dumpdir\"           (hasArg setDumpDir)\n  , make_ord_flag defGhcFlag \"outputdir\"         (hasArg setOutputDir)\n  , make_ord_flag defGhcFlag \"ddump-file-prefix\"\n        (hasArg (setDumpPrefixForce . Just))\n\n  , make_ord_flag defGhcFlag \"dynamic-too\"\n        (NoArg (setGeneralFlag Opt_BuildDynamicToo))\n\n        ------- Keeping temporary files -------------------------------------\n     -- These can be singular (think ghc -c) or plural (think ghc --make)\n  , make_ord_flag defGhcFlag \"keep-hc-file\"\n        (NoArg (setGeneralFlag Opt_KeepHcFiles))\n  , make_ord_flag defGhcFlag \"keep-hc-files\"\n        (NoArg (setGeneralFlag Opt_KeepHcFiles))\n  , make_ord_flag defGhcFlag \"keep-hscpp-file\"\n        (NoArg (setGeneralFlag Opt_KeepHscppFiles))\n  , make_ord_flag defGhcFlag \"keep-hscpp-files\"\n        (NoArg (setGeneralFlag Opt_KeepHscppFiles))\n  , make_ord_flag defGhcFlag \"keep-s-file\"\n        (NoArg (setGeneralFlag Opt_KeepSFiles))\n  , make_ord_flag defGhcFlag \"keep-s-files\"\n        (NoArg (setGeneralFlag Opt_KeepSFiles))\n  , make_ord_flag defGhcFlag \"keep-llvm-file\"\n        (NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)\n  , make_ord_flag defGhcFlag \"keep-llvm-files\"\n        (NoArg $ setObjTarget HscLlvm >> setGeneralFlag Opt_KeepLlvmFiles)\n     -- This only makes sense as plural\n  , make_ord_flag defGhcFlag \"keep-tmp-files\"\n        (NoArg (setGeneralFlag Opt_KeepTmpFiles))\n  , make_ord_flag defGhcFlag \"keep-hi-file\"\n        (NoArg (setGeneralFlag Opt_KeepHiFiles))\n  , make_ord_flag defGhcFlag \"no-keep-hi-file\"\n        (NoArg (unSetGeneralFlag Opt_KeepHiFiles))\n  , make_ord_flag defGhcFlag \"keep-hi-files\"\n        (NoArg (setGeneralFlag Opt_KeepHiFiles))\n  , make_ord_flag defGhcFlag \"no-keep-hi-files\"\n        (NoArg (unSetGeneralFlag Opt_KeepHiFiles))\n  , make_ord_flag defGhcFlag \"keep-o-file\"\n        (NoArg (setGeneralFlag Opt_KeepOFiles))\n  , make_ord_flag defGhcFlag \"no-keep-o-file\"\n        (NoArg (unSetGeneralFlag Opt_KeepOFiles))\n  , make_ord_flag defGhcFlag \"keep-o-files\"\n        (NoArg (setGeneralFlag Opt_KeepOFiles))\n  , make_ord_flag defGhcFlag \"no-keep-o-files\"\n        (NoArg (unSetGeneralFlag Opt_KeepOFiles))\n\n        ------- Miscellaneous ----------------------------------------------\n  , make_ord_flag defGhcFlag \"no-auto-link-packages\"\n        (NoArg (unSetGeneralFlag Opt_AutoLinkPackages))\n  , make_ord_flag defGhcFlag \"no-hs-main\"\n        (NoArg (setGeneralFlag Opt_NoHsMain))\n  , make_ord_flag defGhcFlag \"fno-state-hack\"\n        (NoArg (setGeneralFlag Opt_G_NoStateHack))\n  , make_ord_flag defGhcFlag \"fno-opt-coercion\"\n        (NoArg (setGeneralFlag Opt_G_NoOptCoercion))\n  , make_ord_flag defGhcFlag \"with-rtsopts\"\n        (HasArg setRtsOpts)\n  , make_ord_flag defGhcFlag \"rtsopts\"\n        (NoArg (setRtsOptsEnabled RtsOptsAll))\n  , make_ord_flag defGhcFlag \"rtsopts=all\"\n        (NoArg (setRtsOptsEnabled RtsOptsAll))\n  , make_ord_flag defGhcFlag \"rtsopts=some\"\n        (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))\n  , make_ord_flag defGhcFlag \"rtsopts=none\"\n        (NoArg (setRtsOptsEnabled RtsOptsNone))\n  , make_ord_flag defGhcFlag \"rtsopts=ignore\"\n        (NoArg (setRtsOptsEnabled RtsOptsIgnore))\n  , make_ord_flag defGhcFlag \"rtsopts=ignoreAll\"\n        (NoArg (setRtsOptsEnabled RtsOptsIgnoreAll))\n  , make_ord_flag defGhcFlag \"no-rtsopts\"\n        (NoArg (setRtsOptsEnabled RtsOptsNone))\n  , make_ord_flag defGhcFlag \"no-rtsopts-suggestions\"\n      (noArg (\\d -> d {rtsOptsSuggestions = False}))\n  , make_ord_flag defGhcFlag \"dhex-word-literals\"\n        (NoArg (setGeneralFlag Opt_HexWordLiterals))\n\n  , make_ord_flag defGhcFlag \"ghcversion-file\"      (hasArg addGhcVersionFile)\n  , make_ord_flag defGhcFlag \"main-is\"              (SepArg setMainIs)\n  , make_ord_flag defGhcFlag \"haddock\"              (NoArg (setGeneralFlag Opt_Haddock))\n  , make_ord_flag defGhcFlag \"haddock-opts\"         (hasArg addHaddockOpts)\n  , make_ord_flag defGhcFlag \"hpcdir\"               (SepArg setOptHpcDir)\n  , make_ord_flag defGhciFlag \"ghci-script\"         (hasArg addGhciScript)\n  , make_ord_flag defGhciFlag \"interactive-print\"   (hasArg setInteractivePrint)\n  , make_ord_flag defGhcFlag \"ticky-allocd\"\n        (NoArg (setGeneralFlag Opt_Ticky_Allocd))\n  , make_ord_flag defGhcFlag \"ticky-LNE\"\n        (NoArg (setGeneralFlag Opt_Ticky_LNE))\n  , make_ord_flag defGhcFlag \"ticky-dyn-thunk\"\n        (NoArg (setGeneralFlag Opt_Ticky_Dyn_Thunk))\n        ------- recompilation checker --------------------------------------\n  , make_dep_flag defGhcFlag \"recomp\"\n        (NoArg $ unSetGeneralFlag Opt_ForceRecomp)\n             \"Use -fno-force-recomp instead\"\n  , make_dep_flag defGhcFlag \"no-recomp\"\n        (NoArg $ setGeneralFlag Opt_ForceRecomp) \"Use -fforce-recomp instead\"\n  , make_ord_flag defFlag \"fmax-errors\"\n      (intSuffix (\\n d -> d { maxErrors = Just (max 1 n) }))\n  , make_ord_flag defFlag \"fno-max-errors\"\n      (noArg (\\d -> d { maxErrors = Nothing }))\n  , make_ord_flag defFlag \"freverse-errors\"\n        (noArg (\\d -> d {reverseErrors = True} ))\n  , make_ord_flag defFlag \"fno-reverse-errors\"\n        (noArg (\\d -> d {reverseErrors = False} ))\n\n        ------ HsCpp opts ---------------------------------------------------\n  , make_ord_flag defFlag \"D\"              (AnySuffix (upd . addOptP))\n  , make_ord_flag defFlag \"U\"              (AnySuffix (upd . addOptP))\n\n        ------- Include/Import Paths ----------------------------------------\n  , make_ord_flag defFlag \"I\"              (Prefix    addIncludePath)\n  , make_ord_flag defFlag \"i\"              (OptPrefix addImportPath)\n\n        ------ Output style options -----------------------------------------\n  , make_ord_flag defFlag \"dppr-user-length\" (intSuffix (\\n d ->\n                                                       d { pprUserLength = n }))\n  , make_ord_flag defFlag \"dppr-cols\"        (intSuffix (\\n d ->\n                                                             d { pprCols = n }))\n  , make_ord_flag defFlag \"fdiagnostics-color=auto\"\n      (NoArg (upd (\\d -> d { useColor = Auto })))\n  , make_ord_flag defFlag \"fdiagnostics-color=always\"\n      (NoArg (upd (\\d -> d { useColor = Always })))\n  , make_ord_flag defFlag \"fdiagnostics-color=never\"\n      (NoArg (upd (\\d -> d { useColor = Never })))\n\n  -- Suppress all that is suppressable in core dumps.\n  -- Except for uniques, as some simplifier phases introduce new variables that\n  -- have otherwise identical names.\n  , make_ord_flag defGhcFlag \"dsuppress-all\"\n      (NoArg $ do setGeneralFlag Opt_SuppressCoercions\n                  setGeneralFlag Opt_SuppressVarKinds\n                  setGeneralFlag Opt_SuppressModulePrefixes\n                  setGeneralFlag Opt_SuppressTypeApplications\n                  setGeneralFlag Opt_SuppressIdInfo\n                  setGeneralFlag Opt_SuppressTicks\n                  setGeneralFlag Opt_SuppressStgExts\n                  setGeneralFlag Opt_SuppressTypeSignatures\n                  setGeneralFlag Opt_SuppressTimestamps)\n\n        ------ Debugging ----------------------------------------------------\n  , make_ord_flag defGhcFlag \"dstg-stats\"\n        (NoArg (setGeneralFlag Opt_StgStats))\n\n  , make_ord_flag defGhcFlag \"ddump-cmm\"\n        (setDumpFlag Opt_D_dump_cmm)\n  , make_ord_flag defGhcFlag \"ddump-cmm-from-stg\"\n        (setDumpFlag Opt_D_dump_cmm_from_stg)\n  , make_ord_flag defGhcFlag \"ddump-cmm-raw\"\n        (setDumpFlag Opt_D_dump_cmm_raw)\n  , make_ord_flag defGhcFlag \"ddump-cmm-verbose\"\n        (setDumpFlag Opt_D_dump_cmm_verbose)\n  , make_ord_flag defGhcFlag \"ddump-cmm-cfg\"\n        (setDumpFlag Opt_D_dump_cmm_cfg)\n  , make_ord_flag defGhcFlag \"ddump-cmm-cbe\"\n        (setDumpFlag Opt_D_dump_cmm_cbe)\n  , make_ord_flag defGhcFlag \"ddump-cmm-switch\"\n        (setDumpFlag Opt_D_dump_cmm_switch)\n  , make_ord_flag defGhcFlag \"ddump-cmm-proc\"\n        (setDumpFlag Opt_D_dump_cmm_proc)\n  , make_ord_flag defGhcFlag \"ddump-cmm-sp\"\n        (setDumpFlag Opt_D_dump_cmm_sp)\n  , make_ord_flag defGhcFlag \"ddump-cmm-sink\"\n        (setDumpFlag Opt_D_dump_cmm_sink)\n  , make_ord_flag defGhcFlag \"ddump-cmm-caf\"\n        (setDumpFlag Opt_D_dump_cmm_caf)\n  , make_ord_flag defGhcFlag \"ddump-cmm-procmap\"\n        (setDumpFlag Opt_D_dump_cmm_procmap)\n  , make_ord_flag defGhcFlag \"ddump-cmm-split\"\n        (setDumpFlag Opt_D_dump_cmm_split)\n  , make_ord_flag defGhcFlag \"ddump-cmm-info\"\n        (setDumpFlag Opt_D_dump_cmm_info)\n  , make_ord_flag defGhcFlag \"ddump-cmm-cps\"\n        (setDumpFlag Opt_D_dump_cmm_cps)\n  , make_ord_flag defGhcFlag \"ddump-cfg-weights\"\n        (setDumpFlag Opt_D_dump_cfg_weights)\n  , make_ord_flag defGhcFlag \"ddump-core-stats\"\n        (setDumpFlag Opt_D_dump_core_stats)\n  , make_ord_flag defGhcFlag \"ddump-asm\"\n        (setDumpFlag Opt_D_dump_asm)\n  , make_ord_flag defGhcFlag \"ddump-asm-native\"\n        (setDumpFlag Opt_D_dump_asm_native)\n  , make_ord_flag defGhcFlag \"ddump-asm-liveness\"\n        (setDumpFlag Opt_D_dump_asm_liveness)\n  , make_ord_flag defGhcFlag \"ddump-asm-regalloc\"\n        (setDumpFlag Opt_D_dump_asm_regalloc)\n  , make_ord_flag defGhcFlag \"ddump-asm-conflicts\"\n        (setDumpFlag Opt_D_dump_asm_conflicts)\n  , make_ord_flag defGhcFlag \"ddump-asm-regalloc-stages\"\n        (setDumpFlag Opt_D_dump_asm_regalloc_stages)\n  , make_ord_flag defGhcFlag \"ddump-asm-stats\"\n        (setDumpFlag Opt_D_dump_asm_stats)\n  , make_ord_flag defGhcFlag \"ddump-asm-expanded\"\n        (setDumpFlag Opt_D_dump_asm_expanded)\n  , make_ord_flag defGhcFlag \"ddump-llvm\"\n        (NoArg $ setObjTarget HscLlvm >> setDumpFlag' Opt_D_dump_llvm)\n  , make_ord_flag defGhcFlag \"ddump-deriv\"\n        (setDumpFlag Opt_D_dump_deriv)\n  , make_ord_flag defGhcFlag \"ddump-ds\"\n        (setDumpFlag Opt_D_dump_ds)\n  , make_ord_flag defGhcFlag \"ddump-ds-preopt\"\n        (setDumpFlag Opt_D_dump_ds_preopt)\n  , make_ord_flag defGhcFlag \"ddump-foreign\"\n        (setDumpFlag Opt_D_dump_foreign)\n  , make_ord_flag defGhcFlag \"ddump-inlinings\"\n        (setDumpFlag Opt_D_dump_inlinings)\n  , make_ord_flag defGhcFlag \"ddump-rule-firings\"\n        (setDumpFlag Opt_D_dump_rule_firings)\n  , make_ord_flag defGhcFlag \"ddump-rule-rewrites\"\n        (setDumpFlag Opt_D_dump_rule_rewrites)\n  , make_ord_flag defGhcFlag \"ddump-simpl-trace\"\n        (setDumpFlag Opt_D_dump_simpl_trace)\n  , make_ord_flag defGhcFlag \"ddump-occur-anal\"\n        (setDumpFlag Opt_D_dump_occur_anal)\n  , make_ord_flag defGhcFlag \"ddump-parsed\"\n        (setDumpFlag Opt_D_dump_parsed)\n  , make_ord_flag defGhcFlag \"ddump-parsed-ast\"\n        (setDumpFlag Opt_D_dump_parsed_ast)\n  , make_ord_flag defGhcFlag \"ddump-rn\"\n        (setDumpFlag Opt_D_dump_rn)\n  , make_ord_flag defGhcFlag \"ddump-rn-ast\"\n        (setDumpFlag Opt_D_dump_rn_ast)\n  , make_ord_flag defGhcFlag \"ddump-simpl\"\n        (setDumpFlag Opt_D_dump_simpl)\n  , make_ord_flag defGhcFlag \"ddump-simpl-iterations\"\n      (setDumpFlag Opt_D_dump_simpl_iterations)\n  , make_ord_flag defGhcFlag \"ddump-spec\"\n        (setDumpFlag Opt_D_dump_spec)\n  , make_ord_flag defGhcFlag \"ddump-prep\"\n        (setDumpFlag Opt_D_dump_prep)\n  , make_ord_flag defGhcFlag \"ddump-stg\"\n        (setDumpFlag Opt_D_dump_stg)\n  , make_ord_flag defGhcFlag \"ddump-call-arity\"\n        (setDumpFlag Opt_D_dump_call_arity)\n  , make_ord_flag defGhcFlag \"ddump-exitify\"\n        (setDumpFlag Opt_D_dump_exitify)\n  , make_ord_flag defGhcFlag \"ddump-stranal\"\n        (setDumpFlag Opt_D_dump_stranal)\n  , make_ord_flag defGhcFlag \"ddump-str-signatures\"\n        (setDumpFlag Opt_D_dump_str_signatures)\n  , make_ord_flag defGhcFlag \"ddump-tc\"\n        (setDumpFlag Opt_D_dump_tc)\n  , make_ord_flag defGhcFlag \"ddump-tc-ast\"\n        (setDumpFlag Opt_D_dump_tc_ast)\n  , make_ord_flag defGhcFlag \"ddump-types\"\n        (setDumpFlag Opt_D_dump_types)\n  , make_ord_flag defGhcFlag \"ddump-rules\"\n        (setDumpFlag Opt_D_dump_rules)\n  , make_ord_flag defGhcFlag \"ddump-cse\"\n        (setDumpFlag Opt_D_dump_cse)\n  , make_ord_flag defGhcFlag \"ddump-worker-wrapper\"\n        (setDumpFlag Opt_D_dump_worker_wrapper)\n  , make_ord_flag defGhcFlag \"ddump-rn-trace\"\n        (setDumpFlag Opt_D_dump_rn_trace)\n  , make_ord_flag defGhcFlag \"ddump-shape\"\n        (setDumpFlag Opt_D_dump_shape)\n  , make_ord_flag defGhcFlag \"ddump-if-trace\"\n        (setDumpFlag Opt_D_dump_if_trace)\n  , make_ord_flag defGhcFlag \"ddump-cs-trace\"\n        (setDumpFlag Opt_D_dump_cs_trace)\n  , make_ord_flag defGhcFlag \"ddump-tc-trace\"\n        (NoArg (do setDumpFlag' Opt_D_dump_tc_trace\n                   setDumpFlag' Opt_D_dump_cs_trace))\n  , make_ord_flag defGhcFlag \"ddump-ec-trace\"\n        (setDumpFlag Opt_D_dump_ec_trace)\n  , make_ord_flag defGhcFlag \"ddump-vt-trace\"\n        (setDumpFlag Opt_D_dump_vt_trace)\n  , make_ord_flag defGhcFlag \"ddump-splices\"\n        (setDumpFlag Opt_D_dump_splices)\n  , make_ord_flag defGhcFlag \"dth-dec-file\"\n        (setDumpFlag Opt_D_th_dec_file)\n\n  , make_ord_flag defGhcFlag \"ddump-rn-stats\"\n        (setDumpFlag Opt_D_dump_rn_stats)\n  , make_ord_flag defGhcFlag \"ddump-opt-cmm\"\n        (setDumpFlag Opt_D_dump_opt_cmm)\n  , make_ord_flag defGhcFlag \"ddump-simpl-stats\"\n        (setDumpFlag Opt_D_dump_simpl_stats)\n  , make_ord_flag defGhcFlag \"ddump-bcos\"\n        (setDumpFlag Opt_D_dump_BCOs)\n  , make_ord_flag defGhcFlag \"dsource-stats\"\n        (setDumpFlag Opt_D_source_stats)\n  , make_ord_flag defGhcFlag \"dverbose-core2core\"\n        (NoArg $ setVerbosity (Just 2) >> setVerboseCore2Core)\n  , make_ord_flag defGhcFlag \"dverbose-stg2stg\"\n        (setDumpFlag Opt_D_verbose_stg2stg)\n  , make_ord_flag defGhcFlag \"ddump-hi\"\n        (setDumpFlag Opt_D_dump_hi)\n  , make_ord_flag defGhcFlag \"ddump-minimal-imports\"\n        (NoArg (setGeneralFlag Opt_D_dump_minimal_imports))\n  , make_ord_flag defGhcFlag \"ddump-hpc\"\n        (setDumpFlag Opt_D_dump_ticked) -- back compat\n  , make_ord_flag defGhcFlag \"ddump-ticked\"\n        (setDumpFlag Opt_D_dump_ticked)\n  , make_ord_flag defGhcFlag \"ddump-mod-cycles\"\n        (setDumpFlag Opt_D_dump_mod_cycles)\n  , make_ord_flag defGhcFlag \"ddump-mod-map\"\n        (setDumpFlag Opt_D_dump_mod_map)\n  , make_ord_flag defGhcFlag \"ddump-timings\"\n        (setDumpFlag Opt_D_dump_timings)\n  , make_ord_flag defGhcFlag \"ddump-view-pattern-commoning\"\n        (setDumpFlag Opt_D_dump_view_pattern_commoning)\n  , make_ord_flag defGhcFlag \"ddump-to-file\"\n        (NoArg (setGeneralFlag Opt_DumpToFile))\n  , make_ord_flag defGhcFlag \"ddump-hi-diffs\"\n        (setDumpFlag Opt_D_dump_hi_diffs)\n  , make_ord_flag defGhcFlag \"ddump-rtti\"\n        (setDumpFlag Opt_D_dump_rtti)\n  , make_ord_flag defGhcFlag \"dcore-lint\"\n        (NoArg (setGeneralFlag Opt_DoCoreLinting))\n  , make_ord_flag defGhcFlag \"dstg-lint\"\n        (NoArg (setGeneralFlag Opt_DoStgLinting))\n  , make_ord_flag defGhcFlag \"dcmm-lint\"\n        (NoArg (setGeneralFlag Opt_DoCmmLinting))\n  , make_ord_flag defGhcFlag \"dasm-lint\"\n        (NoArg (setGeneralFlag Opt_DoAsmLinting))\n  , make_ord_flag defGhcFlag \"dannot-lint\"\n        (NoArg (setGeneralFlag Opt_DoAnnotationLinting))\n  , make_ord_flag defGhcFlag \"dshow-passes\"\n        (NoArg $ forceRecompile >> (setVerbosity $ Just 2))\n  , make_ord_flag defGhcFlag \"dfaststring-stats\"\n        (NoArg (setGeneralFlag Opt_D_faststring_stats))\n  , make_ord_flag defGhcFlag \"dno-llvm-mangler\"\n        (NoArg (setGeneralFlag Opt_NoLlvmMangler)) -- hidden flag\n  , make_ord_flag defGhcFlag \"fast-llvm\"\n        (NoArg (setGeneralFlag Opt_FastLlvm)) -- hidden flag\n  , make_ord_flag defGhcFlag \"ddump-debug\"\n        (setDumpFlag Opt_D_dump_debug)\n  , make_ord_flag defGhcFlag \"ddump-json\"\n        (noArg (flip dopt_set Opt_D_dump_json . setJsonLogAction ) )\n  , make_ord_flag defGhcFlag \"dppr-debug\"\n        (setDumpFlag Opt_D_ppr_debug)\n  , make_ord_flag defGhcFlag \"ddebug-output\"\n        (noArg (flip dopt_unset Opt_D_no_debug_output))\n  , make_ord_flag defGhcFlag \"dno-debug-output\"\n        (setDumpFlag Opt_D_no_debug_output)\n\n        ------ Machine dependent (-m<blah>) stuff ---------------------------\n\n  , make_ord_flag defGhcFlag \"msse\"         (noArg (\\d ->\n                                                  d { sseVersion = Just SSE1 }))\n  , make_ord_flag defGhcFlag \"msse2\"        (noArg (\\d ->\n                                                  d { sseVersion = Just SSE2 }))\n  , make_ord_flag defGhcFlag \"msse3\"        (noArg (\\d ->\n                                                  d { sseVersion = Just SSE3 }))\n  , make_ord_flag defGhcFlag \"msse4\"        (noArg (\\d ->\n                                                  d { sseVersion = Just SSE4 }))\n  , make_ord_flag defGhcFlag \"msse4.2\"      (noArg (\\d ->\n                                                 d { sseVersion = Just SSE42 }))\n  , make_ord_flag defGhcFlag \"mbmi\"         (noArg (\\d ->\n                                                 d { bmiVersion = Just BMI1 }))\n  , make_ord_flag defGhcFlag \"mbmi2\"        (noArg (\\d ->\n                                                 d { bmiVersion = Just BMI2 }))\n  , make_ord_flag defGhcFlag \"mavx\"         (noArg (\\d -> d { avx = True }))\n  , make_ord_flag defGhcFlag \"mavx2\"        (noArg (\\d -> d { avx2 = True }))\n  , make_ord_flag defGhcFlag \"mavx512cd\"    (noArg (\\d ->\n                                                         d { avx512cd = True }))\n  , make_ord_flag defGhcFlag \"mavx512er\"    (noArg (\\d ->\n                                                         d { avx512er = True }))\n  , make_ord_flag defGhcFlag \"mavx512f\"     (noArg (\\d -> d { avx512f = True }))\n  , make_ord_flag defGhcFlag \"mavx512pf\"    (noArg (\\d ->\n                                                         d { avx512pf = True }))\n\n     ------ Warning opts -------------------------------------------------\n  , make_ord_flag defFlag \"W\"       (NoArg (mapM_ setWarningFlag minusWOpts))\n  , make_ord_flag defFlag \"Werror\"\n               (NoArg (do { setGeneralFlag Opt_WarnIsError\n                          ; mapM_ setFatalWarningFlag minusWeverythingOpts   }))\n  , make_ord_flag defFlag \"Wwarn\"\n               (NoArg (do { unSetGeneralFlag Opt_WarnIsError\n                          ; mapM_ unSetFatalWarningFlag minusWeverythingOpts }))\n                          -- Opt_WarnIsError is still needed to pass -Werror\n                          -- to CPP; see runCpp in SysTools\n  , make_dep_flag defFlag \"Wnot\"    (NoArg (upd (\\d ->\n                                              d {warningFlags = EnumSet.empty})))\n                                             \"Use -w or -Wno-everything instead\"\n  , make_ord_flag defFlag \"w\"       (NoArg (upd (\\d ->\n                                              d {warningFlags = EnumSet.empty})))\n\n     -- New-style uniform warning sets\n     --\n     -- Note that -Weverything > -Wall > -Wextra > -Wdefault > -Wno-everything\n  , make_ord_flag defFlag \"Weverything\"    (NoArg (mapM_\n                                           setWarningFlag minusWeverythingOpts))\n  , make_ord_flag defFlag \"Wno-everything\"\n                           (NoArg (upd (\\d -> d {warningFlags = EnumSet.empty})))\n\n  , make_ord_flag defFlag \"Wall\"           (NoArg (mapM_\n                                                  setWarningFlag minusWallOpts))\n  , make_ord_flag defFlag \"Wno-all\"        (NoArg (mapM_\n                                                unSetWarningFlag minusWallOpts))\n\n  , make_ord_flag defFlag \"Wextra\"         (NoArg (mapM_\n                                                     setWarningFlag minusWOpts))\n  , make_ord_flag defFlag \"Wno-extra\"      (NoArg (mapM_\n                                                   unSetWarningFlag minusWOpts))\n\n  , make_ord_flag defFlag \"Wdefault\"       (NoArg (mapM_\n                                               setWarningFlag standardWarnings))\n  , make_ord_flag defFlag \"Wno-default\"    (NoArg (mapM_\n                                             unSetWarningFlag standardWarnings))\n\n  , make_ord_flag defFlag \"Wcompat\"        (NoArg (mapM_\n                                               setWarningFlag minusWcompatOpts))\n  , make_ord_flag defFlag \"Wno-compat\"     (NoArg (mapM_\n                                             unSetWarningFlag minusWcompatOpts))\n\n        ------ Plugin flags ------------------------------------------------\n  , make_ord_flag defGhcFlag \"fplugin-opt\" (hasArg addPluginModuleNameOption)\n  , make_ord_flag defGhcFlag \"fplugin-trustworthy\"\n      (NoArg (setGeneralFlag Opt_PluginTrustworthy))\n  , make_ord_flag defGhcFlag \"fplugin\"     (hasArg addPluginModuleName)\n  , make_ord_flag defGhcFlag \"fclear-plugins\" (noArg clearPluginModuleNames)\n  , make_ord_flag defGhcFlag \"ffrontend-opt\" (hasArg addFrontendPluginOption)\n\n        ------ Optimisation flags ------------------------------------------\n  , make_dep_flag defGhcFlag \"Onot\"   (noArgM $ setOptLevel 0 )\n                                                            \"Use -O0 instead\"\n  , make_ord_flag defGhcFlag \"O\"      (optIntSuffixM (\\mb_n ->\n                                                setOptLevel (mb_n `orElse` 1)))\n                -- If the number is missing, use 1\n\n  , make_ord_flag defFlag \"fbinary-blob-threshold\"\n      (intSuffix (\\n d -> d { binBlobThreshold = fromIntegral n }))\n\n  , make_ord_flag defFlag \"fmax-relevant-binds\"\n      (intSuffix (\\n d -> d { maxRelevantBinds = Just n }))\n  , make_ord_flag defFlag \"fno-max-relevant-binds\"\n      (noArg (\\d -> d { maxRelevantBinds = Nothing }))\n\n  , make_ord_flag defFlag \"fmax-valid-hole-fits\"\n      (intSuffix (\\n d -> d { maxValidHoleFits = Just n }))\n  , make_ord_flag defFlag \"fno-max-valid-hole-fits\"\n      (noArg (\\d -> d { maxValidHoleFits = Nothing }))\n  , make_ord_flag defFlag \"fmax-refinement-hole-fits\"\n      (intSuffix (\\n d -> d { maxRefHoleFits = Just n }))\n  , make_ord_flag defFlag \"fno-max-refinement-hole-fits\"\n      (noArg (\\d -> d { maxRefHoleFits = Nothing }))\n  , make_ord_flag defFlag \"frefinement-level-hole-fits\"\n      (intSuffix (\\n d -> d { refLevelHoleFits = Just n }))\n  , make_ord_flag defFlag \"fno-refinement-level-hole-fits\"\n      (noArg (\\d -> d { refLevelHoleFits = Nothing }))\n\n  , make_dep_flag defGhcFlag \"fllvm-pass-vectors-in-regs\"\n            (noArg id)\n            \"vectors registers are now passed in registers by default.\"\n  , make_ord_flag defFlag \"fmax-uncovered-patterns\"\n      (intSuffix (\\n d -> d { maxUncoveredPatterns = n }))\n  , make_ord_flag defFlag \"fsimplifier-phases\"\n      (intSuffix (\\n d -> d { simplPhases = n }))\n  , make_ord_flag defFlag \"fmax-simplifier-iterations\"\n      (intSuffix (\\n d -> d { maxSimplIterations = n }))\n  , make_ord_flag defFlag \"fmax-pmcheck-iterations\"\n      (intSuffix (\\n d -> d{ maxPmCheckIterations = n }))\n  , make_ord_flag defFlag \"fsimpl-tick-factor\"\n      (intSuffix (\\n d -> d { simplTickFactor = n }))\n  , make_ord_flag defFlag \"fspec-constr-threshold\"\n      (intSuffix (\\n d -> d { specConstrThreshold = Just n }))\n  , make_ord_flag defFlag \"fno-spec-constr-threshold\"\n      (noArg (\\d -> d { specConstrThreshold = Nothing }))\n  , make_ord_flag defFlag \"fspec-constr-count\"\n      (intSuffix (\\n d -> d { specConstrCount = Just n }))\n  , make_ord_flag defFlag \"fno-spec-constr-count\"\n      (noArg (\\d -> d { specConstrCount = Nothing }))\n  , make_ord_flag defFlag \"fspec-constr-recursive\"\n      (intSuffix (\\n d -> d { specConstrRecursive = n }))\n  , make_ord_flag defFlag \"fliberate-case-threshold\"\n      (intSuffix (\\n d -> d { liberateCaseThreshold = Just n }))\n  , make_ord_flag defFlag \"fno-liberate-case-threshold\"\n      (noArg (\\d -> d { liberateCaseThreshold = Nothing }))\n  , make_ord_flag defFlag \"drule-check\"\n      (sepArg (\\s d -> d { ruleCheck = Just s }))\n  , make_ord_flag defFlag \"dinline-check\"\n      (sepArg (\\s d -> d { inlineCheck = Just s }))\n  , make_ord_flag defFlag \"freduction-depth\"\n      (intSuffix (\\n d -> d { reductionDepth = treatZeroAsInf n }))\n  , make_ord_flag defFlag \"fconstraint-solver-iterations\"\n      (intSuffix (\\n d -> d { solverIterations = treatZeroAsInf n }))\n  , (Deprecated, defFlag \"fcontext-stack\"\n      (intSuffixM (\\n d ->\n       do { deprecate $ \"use -freduction-depth=\" ++ show n ++ \" instead\"\n          ; return $ d { reductionDepth = treatZeroAsInf n } })))\n  , (Deprecated, defFlag \"ftype-function-depth\"\n      (intSuffixM (\\n d ->\n       do { deprecate $ \"use -freduction-depth=\" ++ show n ++ \" instead\"\n          ; return $ d { reductionDepth = treatZeroAsInf n } })))\n  , make_ord_flag defFlag \"fstrictness-before\"\n      (intSuffix (\\n d -> d { strictnessBefore = n : strictnessBefore d }))\n  , make_ord_flag defFlag \"ffloat-lam-args\"\n      (intSuffix (\\n d -> d { floatLamArgs = Just n }))\n  , make_ord_flag defFlag \"ffloat-all-lams\"\n      (noArg (\\d -> d { floatLamArgs = Nothing }))\n  , make_ord_flag defFlag \"fstg-lift-lams-rec-args\"\n      (intSuffix (\\n d -> d { liftLamsRecArgs = Just n }))\n  , make_ord_flag defFlag \"fstg-lift-lams-rec-args-any\"\n      (noArg (\\d -> d { liftLamsRecArgs = Nothing }))\n  , make_ord_flag defFlag \"fstg-lift-lams-non-rec-args\"\n      (intSuffix (\\n d -> d { liftLamsRecArgs = Just n }))\n  , make_ord_flag defFlag \"fstg-lift-lams-non-rec-args-any\"\n      (noArg (\\d -> d { liftLamsRecArgs = Nothing }))\n  , make_ord_flag defFlag \"fstg-lift-lams-known\"\n      (noArg (\\d -> d { liftLamsKnown = True }))\n  , make_ord_flag defFlag \"fno-stg-lift-lams-known\"\n      (noArg (\\d -> d { liftLamsKnown = False }))\n  , make_ord_flag defFlag \"fproc-alignment\"\n      (intSuffix (\\n d -> d { cmmProcAlignment = Just n }))\n  , make_ord_flag defFlag \"fblock-layout-weights\"\n        (HasArg (\\s ->\n            upd (\\d -> d { cfgWeightInfo =\n                parseCfgWeights s (cfgWeightInfo d)})))\n  , make_ord_flag defFlag \"fhistory-size\"\n      (intSuffix (\\n d -> d { historySize = n }))\n  , make_ord_flag defFlag \"funfolding-creation-threshold\"\n      (intSuffix   (\\n d -> d {ufCreationThreshold = n}))\n  , make_ord_flag defFlag \"funfolding-use-threshold\"\n      (intSuffix   (\\n d -> d {ufUseThreshold = n}))\n  , make_ord_flag defFlag \"funfolding-fun-discount\"\n      (intSuffix   (\\n d -> d {ufFunAppDiscount = n}))\n  , make_ord_flag defFlag \"funfolding-dict-discount\"\n      (intSuffix   (\\n d -> d {ufDictDiscount = n}))\n  , make_ord_flag defFlag \"funfolding-keeness-factor\"\n      (floatSuffix (\\n d -> d {ufKeenessFactor = n}))\n  , make_ord_flag defFlag \"fmax-worker-args\"\n      (intSuffix (\\n d -> d {maxWorkerArgs = n}))\n  , make_ord_flag defGhciFlag \"fghci-hist-size\"\n      (intSuffix (\\n d -> d {ghciHistSize = n}))\n  , make_ord_flag defGhcFlag \"fmax-inline-alloc-size\"\n      (intSuffix (\\n d -> d { maxInlineAllocSize = n }))\n  , make_ord_flag defGhcFlag \"fmax-inline-memcpy-insns\"\n      (intSuffix (\\n d -> d { maxInlineMemcpyInsns = n }))\n  , make_ord_flag defGhcFlag \"fmax-inline-memset-insns\"\n      (intSuffix (\\n d -> d { maxInlineMemsetInsns = n }))\n  , make_ord_flag defGhcFlag \"dinitial-unique\"\n      (intSuffix (\\n d -> d { initialUnique = n }))\n  , make_ord_flag defGhcFlag \"dunique-increment\"\n      (intSuffix (\\n d -> d { uniqueIncrement = n }))\n\n        ------ Profiling ----------------------------------------------------\n\n        -- OLD profiling flags\n  , make_dep_flag defGhcFlag \"auto-all\"\n                    (noArg (\\d -> d { profAuto = ProfAutoAll } ))\n                    \"Use -fprof-auto instead\"\n  , make_dep_flag defGhcFlag \"no-auto-all\"\n                    (noArg (\\d -> d { profAuto = NoProfAuto } ))\n                    \"Use -fno-prof-auto instead\"\n  , make_dep_flag defGhcFlag \"auto\"\n                    (noArg (\\d -> d { profAuto = ProfAutoExports } ))\n                    \"Use -fprof-auto-exported instead\"\n  , make_dep_flag defGhcFlag \"no-auto\"\n            (noArg (\\d -> d { profAuto = NoProfAuto } ))\n                    \"Use -fno-prof-auto instead\"\n  , make_dep_flag defGhcFlag \"caf-all\"\n            (NoArg (setGeneralFlag Opt_AutoSccsOnIndividualCafs))\n                    \"Use -fprof-cafs instead\"\n  , make_dep_flag defGhcFlag \"no-caf-all\"\n            (NoArg (unSetGeneralFlag Opt_AutoSccsOnIndividualCafs))\n                    \"Use -fno-prof-cafs instead\"\n\n        -- NEW profiling flags\n  , make_ord_flag defGhcFlag \"fprof-auto\"\n      (noArg (\\d -> d { profAuto = ProfAutoAll } ))\n  , make_ord_flag defGhcFlag \"fprof-auto-top\"\n      (noArg (\\d -> d { profAuto = ProfAutoTop } ))\n  , make_ord_flag defGhcFlag \"fprof-auto-exported\"\n      (noArg (\\d -> d { profAuto = ProfAutoExports } ))\n  , make_ord_flag defGhcFlag \"fprof-auto-calls\"\n      (noArg (\\d -> d { profAuto = ProfAutoCalls } ))\n  , make_ord_flag defGhcFlag \"fno-prof-auto\"\n      (noArg (\\d -> d { profAuto = NoProfAuto } ))\n\n        ------ Compiler flags -----------------------------------------------\n\n  , make_ord_flag defGhcFlag \"fasm\"             (NoArg (setObjTarget HscAsm))\n  , make_ord_flag defGhcFlag \"fvia-c\"           (NoArg\n         (deprecate $ \"The -fvia-c flag does nothing; \" ++\n                      \"it will be removed in a future GHC release\"))\n  , make_ord_flag defGhcFlag \"fvia-C\"           (NoArg\n         (deprecate $ \"The -fvia-C flag does nothing; \" ++\n                      \"it will be removed in a future GHC release\"))\n  , make_ord_flag defGhcFlag \"fllvm\"            (NoArg (setObjTarget HscLlvm))\n\n  , make_ord_flag defFlag \"fno-code\"         (NoArg ((upd $ \\d ->\n                  d { ghcLink=NoLink }) >> setTarget HscNothing))\n  , make_ord_flag defFlag \"fbyte-code\"       (NoArg (setTarget HscInterpreted))\n  , make_ord_flag defFlag \"fobject-code\"     (NoArg (setTargetWithPlatform\n                                                             defaultHscTarget))\n  , make_dep_flag defFlag \"fglasgow-exts\"\n      (NoArg enableGlasgowExts) \"Use individual extensions instead\"\n  , make_dep_flag defFlag \"fno-glasgow-exts\"\n      (NoArg disableGlasgowExts) \"Use individual extensions instead\"\n  , make_ord_flag defFlag \"Wunused-binds\" (NoArg enableUnusedBinds)\n  , make_ord_flag defFlag \"Wno-unused-binds\" (NoArg disableUnusedBinds)\n  , make_ord_flag defHiddenFlag \"fwarn-unused-binds\" (NoArg enableUnusedBinds)\n  , make_ord_flag defHiddenFlag \"fno-warn-unused-binds\" (NoArg\n                                                            disableUnusedBinds)\n\n        ------ Safe Haskell flags -------------------------------------------\n  , make_ord_flag defFlag \"fpackage-trust\"   (NoArg setPackageTrust)\n  , make_ord_flag defFlag \"fno-safe-infer\"   (noArg (\\d ->\n                                                    d { safeInfer = False }))\n  , make_ord_flag defFlag \"fno-safe-haskell\" (NoArg (setSafeHaskell Sf_Ignore))\n  , make_ord_flag defGhcFlag \"fPIC\"          (NoArg (setGeneralFlag Opt_PIC))\n  , make_ord_flag defGhcFlag \"fno-PIC\"       (NoArg (unSetGeneralFlag Opt_PIC))\n  , make_ord_flag defGhcFlag \"fPIE\"          (NoArg (setGeneralFlag Opt_PIC))\n  , make_ord_flag defGhcFlag \"fno-PIE\"       (NoArg (unSetGeneralFlag Opt_PIC))\n\n         ------ Debugging flags ----------------------------------------------\n  , make_ord_flag defGhcFlag \"g\"             (OptIntSuffix setDebugLevel)\n ]\n ++ map (mkFlag turnOn  \"\"          setGeneralFlag    ) negatableFlagsDeps\n ++ map (mkFlag turnOff \"no-\"       unSetGeneralFlag  ) negatableFlagsDeps\n ++ map (mkFlag turnOn  \"d\"         setGeneralFlag    ) dFlagsDeps\n ++ map (mkFlag turnOff \"dno-\"      unSetGeneralFlag  ) dFlagsDeps\n ++ map (mkFlag turnOn  \"f\"         setGeneralFlag    ) fFlagsDeps\n ++ map (mkFlag turnOff \"fno-\"      unSetGeneralFlag  ) fFlagsDeps\n ++ map (mkFlag turnOn  \"W\"         setWarningFlag    ) wWarningFlagsDeps\n ++ map (mkFlag turnOff \"Wno-\"      unSetWarningFlag  ) wWarningFlagsDeps\n ++ map (mkFlag turnOn  \"Werror=\"   setWErrorFlag )     wWarningFlagsDeps\n ++ map (mkFlag turnOn  \"Wwarn=\"     unSetFatalWarningFlag )\n                                                        wWarningFlagsDeps\n ++ map (mkFlag turnOn  \"Wno-error=\" unSetFatalWarningFlag )\n                                                        wWarningFlagsDeps\n ++ map (mkFlag turnOn  \"fwarn-\"    setWarningFlag   . hideFlag)\n    wWarningFlagsDeps\n ++ map (mkFlag turnOff \"fno-warn-\" unSetWarningFlag . hideFlag)\n    wWarningFlagsDeps\n ++ [ (NotDeprecated, unrecognisedWarning \"W\"),\n      (Deprecated,    unrecognisedWarning \"fwarn-\"),\n      (Deprecated,    unrecognisedWarning \"fno-warn-\") ]\n ++ [ make_ord_flag defFlag \"Werror=compat\"\n        (NoArg (mapM_ setWErrorFlag minusWcompatOpts))\n    , make_ord_flag defFlag \"Wno-error=compat\"\n        (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts))\n    , make_ord_flag defFlag \"Wwarn=compat\"\n        (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts)) ]\n ++ map (mkFlag turnOn  \"f\"         setExtensionFlag  ) fLangFlagsDeps\n ++ map (mkFlag turnOff \"fno-\"      unSetExtensionFlag) fLangFlagsDeps\n ++ map (mkFlag turnOn  \"X\"         setExtensionFlag  ) xFlagsDeps\n ++ map (mkFlag turnOff \"XNo\"       unSetExtensionFlag) xFlagsDeps\n ++ map (mkFlag turnOn  \"X\"         setLanguage       ) languageFlagsDeps\n ++ map (mkFlag turnOn  \"X\"         setSafeHaskell    ) safeHaskellFlagsDeps\n ++ [ make_dep_flag defFlag \"XGenerics\"\n        (NoArg $ return ())\n                  (\"it does nothing; look into -XDefaultSignatures \" ++\n                   \"and -XDeriveGeneric for generic programming support.\")\n    , make_dep_flag defFlag \"XNoGenerics\"\n        (NoArg $ return ())\n               (\"it does nothing; look into -XDefaultSignatures and \" ++\n                  \"-XDeriveGeneric for generic programming support.\") ]\n\n-- | This is where we handle unrecognised warning flags. We only issue a warning\n-- if -Wunrecognised-warning-flags is set. See Trac #11429 for context.\nunrecognisedWarning :: String -> Flag (CmdLineP DynFlags)\nunrecognisedWarning prefix = defHiddenFlag prefix (Prefix action)\n  where\n    action :: String -> EwM (CmdLineP DynFlags) ()\n    action flag = do\n      f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState\n      when f $ addFlagWarn Cmd.ReasonUnrecognisedFlag $\n        \"unrecognised warning flag: -\" ++ prefix ++ flag\n\n-- See Note [Supporting CLI completion]\npackage_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))]\npackage_flags_deps = [\n        ------- Packages ----------------------------------------------------\n    make_ord_flag defFlag \"package-db\"\n      (HasArg (addPkgConfRef . PkgConfFile))\n  , make_ord_flag defFlag \"clear-package-db\"      (NoArg clearPkgConf)\n  , make_ord_flag defFlag \"no-global-package-db\"  (NoArg removeGlobalPkgConf)\n  , make_ord_flag defFlag \"no-user-package-db\"    (NoArg removeUserPkgConf)\n  , make_ord_flag defFlag \"global-package-db\"\n      (NoArg (addPkgConfRef GlobalPkgConf))\n  , make_ord_flag defFlag \"user-package-db\"\n      (NoArg (addPkgConfRef UserPkgConf))\n    -- backwards compat with GHC<=7.4 :\n  , make_dep_flag defFlag \"package-conf\"\n      (HasArg $ addPkgConfRef . PkgConfFile) \"Use -package-db instead\"\n  , make_dep_flag defFlag \"no-user-package-conf\"\n      (NoArg removeUserPkgConf)              \"Use -no-user-package-db instead\"\n  , make_ord_flag defGhcFlag \"package-name\"       (HasArg $ \\name -> do\n                                      upd (setUnitId name))\n                                      -- TODO: Since we JUST deprecated\n                                      -- -this-package-key, let's keep this\n                                      -- undeprecated for another cycle.\n                                      -- Deprecate this eventually.\n                                      -- deprecate \"Use -this-unit-id instead\")\n  , make_dep_flag defGhcFlag \"this-package-key\"   (HasArg $ upd . setUnitId)\n                                                  \"Use -this-unit-id instead\"\n  , make_ord_flag defGhcFlag \"this-unit-id\"       (hasArg setUnitId)\n  , make_ord_flag defFlag \"package\"               (HasArg exposePackage)\n  , make_ord_flag defFlag \"plugin-package-id\"     (HasArg exposePluginPackageId)\n  , make_ord_flag defFlag \"plugin-package\"        (HasArg exposePluginPackage)\n  , make_ord_flag defFlag \"package-id\"            (HasArg exposePackageId)\n  , make_ord_flag defFlag \"hide-package\"          (HasArg hidePackage)\n  , make_ord_flag defFlag \"hide-all-packages\"\n      (NoArg (setGeneralFlag Opt_HideAllPackages))\n  , make_ord_flag defFlag \"hide-all-plugin-packages\"\n      (NoArg (setGeneralFlag Opt_HideAllPluginPackages))\n  , make_ord_flag defFlag \"package-env\"           (HasArg setPackageEnv)\n  , make_ord_flag defFlag \"ignore-package\"        (HasArg ignorePackage)\n  , make_dep_flag defFlag \"syslib\" (HasArg exposePackage) \"Use -package instead\"\n  , make_ord_flag defFlag \"distrust-all-packages\"\n      (NoArg (setGeneralFlag Opt_DistrustAllPackages))\n  , make_ord_flag defFlag \"trust\"                 (HasArg trustPackage)\n  , make_ord_flag defFlag \"distrust\"              (HasArg distrustPackage)\n  ]\n  where\n    setPackageEnv env = upd $ \\s -> s { packageEnv = Just env }\n\n-- | Make a list of flags for shell completion.\n-- Filter all available flags into two groups, for interactive GHC vs all other.\nflagsForCompletion :: Bool -> [String]\nflagsForCompletion isInteractive\n    = [ '-':flagName flag\n      | flag <- flagsAll\n      , modeFilter (flagGhcMode flag)\n      ]\n    where\n      modeFilter AllModes = True\n      modeFilter OnlyGhci = isInteractive\n      modeFilter OnlyGhc = not isInteractive\n      modeFilter HiddenFlag = False\n\ntype TurnOnFlag = Bool   -- True  <=> we are turning the flag on\n                         -- False <=> we are turning the flag off\nturnOn  :: TurnOnFlag; turnOn  = True\nturnOff :: TurnOnFlag; turnOff = False\n\ndata FlagSpec flag\n   = FlagSpec\n       { flagSpecName :: String   -- ^ Flag in string form\n       , flagSpecFlag :: flag     -- ^ Flag in internal form\n       , flagSpecAction :: (TurnOnFlag -> DynP ())\n           -- ^ Extra action to run when the flag is found\n           -- Typically, emit a warning or error\n       , flagSpecGhcMode :: GhcFlagMode\n           -- ^ In which ghc mode the flag has effect\n       }\n\n-- | Define a new flag.\nflagSpec :: String -> flag -> (Deprecation, FlagSpec flag)\nflagSpec name flag = flagSpec' name flag nop\n\n-- | Define a new flag with an effect.\nflagSpec' :: String -> flag -> (TurnOnFlag -> DynP ())\n          -> (Deprecation, FlagSpec flag)\nflagSpec' name flag act = (NotDeprecated, FlagSpec name flag act AllModes)\n\n-- | Define a new deprecated flag with an effect.\ndepFlagSpecOp :: String -> flag -> (TurnOnFlag -> DynP ()) -> String\n            -> (Deprecation, FlagSpec flag)\ndepFlagSpecOp name flag act dep =\n    (Deprecated, snd (flagSpec' name flag (\\f -> act f >> deprecate dep)))\n\n-- | Define a new deprecated flag.\ndepFlagSpec :: String -> flag -> String\n            -> (Deprecation, FlagSpec flag)\ndepFlagSpec name flag dep = depFlagSpecOp name flag nop dep\n\n-- | Define a new deprecated flag with an effect where the deprecation message\n-- depends on the flag value\ndepFlagSpecOp' :: String\n             -> flag\n             -> (TurnOnFlag -> DynP ())\n             -> (TurnOnFlag -> String)\n             -> (Deprecation, FlagSpec flag)\ndepFlagSpecOp' name flag act dep =\n    (Deprecated, FlagSpec name flag (\\f -> act f >> (deprecate $ dep f))\n                                                                       AllModes)\n\n-- | Define a new deprecated flag where the deprecation message\n-- depends on the flag value\ndepFlagSpec' :: String\n             -> flag\n             -> (TurnOnFlag -> String)\n             -> (Deprecation, FlagSpec flag)\ndepFlagSpec' name flag dep = depFlagSpecOp' name flag nop dep\n\n\n-- | Define a new deprecated flag where the deprecation message\n-- is shown depending on the flag value\ndepFlagSpecCond :: String\n                -> flag\n                -> (TurnOnFlag -> Bool)\n                -> String\n                -> (Deprecation, FlagSpec flag)\ndepFlagSpecCond name flag cond dep =\n    (Deprecated, FlagSpec name flag (\\f -> when (cond f) $ deprecate dep)\n                                                                       AllModes)\n\n-- | Define a new flag for GHCi.\nflagGhciSpec :: String -> flag -> (Deprecation, FlagSpec flag)\nflagGhciSpec name flag = flagGhciSpec' name flag nop\n\n-- | Define a new flag for GHCi with an effect.\nflagGhciSpec' :: String -> flag -> (TurnOnFlag -> DynP ())\n              -> (Deprecation, FlagSpec flag)\nflagGhciSpec' name flag act = (NotDeprecated, FlagSpec name flag act OnlyGhci)\n\n-- | Define a new flag invisible to CLI completion.\nflagHiddenSpec :: String -> flag -> (Deprecation, FlagSpec flag)\nflagHiddenSpec name flag = flagHiddenSpec' name flag nop\n\n-- | Define a new flag invisible to CLI completion with an effect.\nflagHiddenSpec' :: String -> flag -> (TurnOnFlag -> DynP ())\n                -> (Deprecation, FlagSpec flag)\nflagHiddenSpec' name flag act = (NotDeprecated, FlagSpec name flag act\n                                                                     HiddenFlag)\n\n-- | Hide a 'FlagSpec' from being displayed in @--show-options@.\n--\n-- This is for example useful for flags that are obsolete, but should not\n-- (yet) be deprecated for compatibility reasons.\nhideFlag :: (Deprecation, FlagSpec a) -> (Deprecation, FlagSpec a)\nhideFlag (dep, fs) = (dep, fs { flagSpecGhcMode = HiddenFlag })\n\nmkFlag :: TurnOnFlag            -- ^ True <=> it should be turned on\n       -> String                -- ^ The flag prefix\n       -> (flag -> DynP ())     -- ^ What to do when the flag is found\n       -> (Deprecation, FlagSpec flag)  -- ^ Specification of\n                                        -- this particular flag\n       -> (Deprecation, Flag (CmdLineP DynFlags))\nmkFlag turn_on flagPrefix f (dep, (FlagSpec name flag extra_action mode))\n    = (dep,\n       Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on)) mode)\n\ndeprecatedForExtension :: String -> TurnOnFlag -> String\ndeprecatedForExtension lang turn_on\n    = \"use -X\" ++ flag ++\n      \" or pragma {-# LANGUAGE \" ++ flag ++ \" #-} instead\"\n    where\n      flag | turn_on   = lang\n           | otherwise = \"No\" ++ lang\n\nuseInstead :: String -> String -> TurnOnFlag -> String\nuseInstead prefix flag turn_on\n  = \"Use \" ++ prefix ++ no ++ flag ++ \" instead\"\n  where\n    no = if turn_on then \"\" else \"no-\"\n\nnop :: TurnOnFlag -> DynP ()\nnop _ = return ()\n\n-- | Find the 'FlagSpec' for a 'WarningFlag'.\nflagSpecOf :: WarningFlag -> Maybe (FlagSpec WarningFlag)\nflagSpecOf flag = listToMaybe $ filter check wWarningFlags\n  where\n    check fs = flagSpecFlag fs == flag\n\n-- | These @-W\\<blah\\>@ flags can all be reversed with @-Wno-\\<blah\\>@\nwWarningFlags :: [FlagSpec WarningFlag]\nwWarningFlags = map snd (sortBy (comparing fst) wWarningFlagsDeps)\n\nwWarningFlagsDeps :: [(Deprecation, FlagSpec WarningFlag)]\nwWarningFlagsDeps = [\n-- See Note [Updating flag description in the User's Guide]\n-- See Note [Supporting CLI completion]\n-- Please keep the list of flags below sorted alphabetically\n  flagSpec \"alternative-layout-rule-transitional\"\n                                      Opt_WarnAlternativeLayoutRuleTransitional,\n  depFlagSpec \"auto-orphans\"             Opt_WarnAutoOrphans\n    \"it has no effect\",\n  flagSpec \"cpp-undef\"                   Opt_WarnCPPUndef,\n  flagSpec \"unbanged-strict-patterns\"    Opt_WarnUnbangedStrictPatterns,\n  flagSpec \"deferred-type-errors\"        Opt_WarnDeferredTypeErrors,\n  flagSpec \"deferred-out-of-scope-variables\"\n                                         Opt_WarnDeferredOutOfScopeVariables,\n  flagSpec \"deprecations\"                Opt_WarnWarningsDeprecations,\n  flagSpec \"deprecated-flags\"            Opt_WarnDeprecatedFlags,\n  flagSpec \"deriving-typeable\"           Opt_WarnDerivingTypeable,\n  flagSpec \"dodgy-exports\"               Opt_WarnDodgyExports,\n  flagSpec \"dodgy-foreign-imports\"       Opt_WarnDodgyForeignImports,\n  flagSpec \"dodgy-imports\"               Opt_WarnDodgyImports,\n  flagSpec \"empty-enumerations\"          Opt_WarnEmptyEnumerations,\n  depFlagSpec \"duplicate-constraints\"    Opt_WarnDuplicateConstraints\n    \"it is subsumed by -Wredundant-constraints\",\n  flagSpec \"redundant-constraints\"       Opt_WarnRedundantConstraints,\n  flagSpec \"duplicate-exports\"           Opt_WarnDuplicateExports,\n  flagSpec \"hi-shadowing\"                Opt_WarnHiShadows,\n  flagSpec \"inaccessible-code\"           Opt_WarnInaccessibleCode,\n  flagSpec \"implicit-prelude\"            Opt_WarnImplicitPrelude,\n  depFlagSpec \"implicit-kind-vars\"       Opt_WarnImplicitKindVars\n    \"it is now an error\",\n  flagSpec \"incomplete-patterns\"         Opt_WarnIncompletePatterns,\n  flagSpec \"incomplete-record-updates\"   Opt_WarnIncompletePatternsRecUpd,\n  flagSpec \"incomplete-uni-patterns\"     Opt_WarnIncompleteUniPatterns,\n  flagSpec \"inline-rule-shadowing\"       Opt_WarnInlineRuleShadowing,\n  flagSpec \"identities\"                  Opt_WarnIdentities,\n  flagSpec \"missing-fields\"              Opt_WarnMissingFields,\n  flagSpec \"missing-import-lists\"        Opt_WarnMissingImportList,\n  flagSpec \"missing-export-lists\"        Opt_WarnMissingExportList,\n  depFlagSpec \"missing-local-sigs\"       Opt_WarnMissingLocalSignatures\n    \"it is replaced by -Wmissing-local-signatures\",\n  flagSpec \"missing-local-signatures\"    Opt_WarnMissingLocalSignatures,\n  flagSpec \"missing-methods\"             Opt_WarnMissingMethods,\n  flagSpec \"missing-monadfail-instances\" Opt_WarnMissingMonadFailInstances,\n  flagSpec \"semigroup\"                   Opt_WarnSemigroup,\n  flagSpec \"missing-signatures\"          Opt_WarnMissingSignatures,\n  depFlagSpec \"missing-exported-sigs\"    Opt_WarnMissingExportedSignatures\n    \"it is replaced by -Wmissing-exported-signatures\",\n  flagSpec \"missing-exported-signatures\" Opt_WarnMissingExportedSignatures,\n  flagSpec \"monomorphism-restriction\"    Opt_WarnMonomorphism,\n  flagSpec \"name-shadowing\"              Opt_WarnNameShadowing,\n  flagSpec \"noncanonical-monad-instances\"\n                                         Opt_WarnNonCanonicalMonadInstances,\n  flagSpec \"noncanonical-monadfail-instances\"\n                                         Opt_WarnNonCanonicalMonadFailInstances,\n  flagSpec \"noncanonical-monoid-instances\"\n                                         Opt_WarnNonCanonicalMonoidInstances,\n  flagSpec \"orphans\"                     Opt_WarnOrphans,\n  flagSpec \"overflowed-literals\"         Opt_WarnOverflowedLiterals,\n  flagSpec \"overlapping-patterns\"        Opt_WarnOverlappingPatterns,\n  flagSpec \"missed-specialisations\"      Opt_WarnMissedSpecs,\n  flagSpec \"missed-specializations\"      Opt_WarnMissedSpecs,\n  flagSpec \"all-missed-specialisations\"  Opt_WarnAllMissedSpecs,\n  flagSpec \"all-missed-specializations\"  Opt_WarnAllMissedSpecs,\n  flagSpec' \"safe\"                       Opt_WarnSafe setWarnSafe,\n  flagSpec \"trustworthy-safe\"            Opt_WarnTrustworthySafe,\n  flagSpec \"tabs\"                        Opt_WarnTabs,\n  flagSpec \"type-defaults\"               Opt_WarnTypeDefaults,\n  flagSpec \"typed-holes\"                 Opt_WarnTypedHoles,\n  flagSpec \"partial-type-signatures\"     Opt_WarnPartialTypeSignatures,\n  flagSpec \"unrecognised-pragmas\"        Opt_WarnUnrecognisedPragmas,\n  flagSpec' \"unsafe\"                     Opt_WarnUnsafe setWarnUnsafe,\n  flagSpec \"unsupported-calling-conventions\"\n                                         Opt_WarnUnsupportedCallingConventions,\n  flagSpec \"unsupported-llvm-version\"    Opt_WarnUnsupportedLlvmVersion,\n  flagSpec \"missed-extra-shared-lib\"     Opt_WarnMissedExtraSharedLib,\n  flagSpec \"unticked-promoted-constructors\"\n                                         Opt_WarnUntickedPromotedConstructors,\n  flagSpec \"unused-do-bind\"              Opt_WarnUnusedDoBind,\n  flagSpec \"unused-foralls\"              Opt_WarnUnusedForalls,\n  flagSpec \"unused-imports\"              Opt_WarnUnusedImports,\n  flagSpec \"unused-local-binds\"          Opt_WarnUnusedLocalBinds,\n  flagSpec \"unused-matches\"              Opt_WarnUnusedMatches,\n  flagSpec \"unused-pattern-binds\"        Opt_WarnUnusedPatternBinds,\n  flagSpec \"unused-top-binds\"            Opt_WarnUnusedTopBinds,\n  flagSpec \"unused-type-patterns\"        Opt_WarnUnusedTypePatterns,\n  flagSpec \"unused-record-wildcards\"     Opt_WarnUnusedRecordWildcards,\n  flagSpec \"redundant-record-wildcards\"  Opt_WarnRedundantRecordWildcards,\n  flagSpec \"warnings-deprecations\"       Opt_WarnWarningsDeprecations,\n  flagSpec \"wrong-do-bind\"               Opt_WarnWrongDoBind,\n  flagSpec \"missing-pattern-synonym-signatures\"\n                                    Opt_WarnMissingPatternSynonymSignatures,\n  flagSpec \"missing-deriving-strategies\" Opt_WarnMissingDerivingStrategies,\n  flagSpec \"simplifiable-class-constraints\" Opt_WarnSimplifiableClassConstraints,\n  flagSpec \"missing-home-modules\"        Opt_WarnMissingHomeModules,\n  flagSpec \"unrecognised-warning-flags\"  Opt_WarnUnrecognisedWarningFlags,\n  flagSpec \"star-binder\"                 Opt_WarnStarBinder,\n  flagSpec \"star-is-type\"                Opt_WarnStarIsType,\n  flagSpec \"missing-space-after-bang\"    Opt_WarnSpaceAfterBang,\n  flagSpec \"partial-fields\"              Opt_WarnPartialFields ]\n\n-- | These @-\\<blah\\>@ flags can all be reversed with @-no-\\<blah\\>@\nnegatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]\nnegatableFlagsDeps = [\n  flagGhciSpec \"ignore-dot-ghci\"         Opt_IgnoreDotGhci ]\n\n-- | These @-d\\<blah\\>@ flags can all be reversed with @-dno-\\<blah\\>@\ndFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]\ndFlagsDeps = [\n-- See Note [Updating flag description in the User's Guide]\n-- See Note [Supporting CLI completion]\n-- Please keep the list of flags below sorted alphabetically\n  flagSpec \"ppr-case-as-let\"            Opt_PprCaseAsLet,\n  depFlagSpec' \"ppr-ticks\"              Opt_PprShowTicks\n     (\\turn_on -> useInstead \"-d\" \"suppress-ticks\" (not turn_on)),\n  flagSpec \"suppress-ticks\"             Opt_SuppressTicks,\n  depFlagSpec' \"suppress-stg-free-vars\" Opt_SuppressStgExts\n     (useInstead \"-d\" \"suppress-stg-exts\"),\n  flagSpec \"suppress-stg-exts\"          Opt_SuppressStgExts,\n  flagSpec \"suppress-coercions\"         Opt_SuppressCoercions,\n  flagSpec \"suppress-idinfo\"            Opt_SuppressIdInfo,\n  flagSpec \"suppress-unfoldings\"        Opt_SuppressUnfoldings,\n  flagSpec \"suppress-module-prefixes\"   Opt_SuppressModulePrefixes,\n  flagSpec \"suppress-timestamps\"        Opt_SuppressTimestamps,\n  flagSpec \"suppress-type-applications\" Opt_SuppressTypeApplications,\n  flagSpec \"suppress-type-signatures\"   Opt_SuppressTypeSignatures,\n  flagSpec \"suppress-uniques\"           Opt_SuppressUniques,\n  flagSpec \"suppress-var-kinds\"         Opt_SuppressVarKinds\n  ]\n\n-- | These @-f\\<blah\\>@ flags can all be reversed with @-fno-\\<blah\\>@\nfFlags :: [FlagSpec GeneralFlag]\nfFlags = map snd fFlagsDeps\n\nfFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]\nfFlagsDeps = [\n-- See Note [Updating flag description in the User's Guide]\n-- See Note [Supporting CLI completion]\n-- Please keep the list of flags below sorted alphabetically\n  flagSpec \"asm-shortcutting\"                 Opt_AsmShortcutting,\n  flagGhciSpec \"break-on-error\"               Opt_BreakOnError,\n  flagGhciSpec \"break-on-exception\"           Opt_BreakOnException,\n  flagSpec \"building-cabal-package\"           Opt_BuildingCabalPackage,\n  flagSpec \"call-arity\"                       Opt_CallArity,\n  flagSpec \"exitification\"                    Opt_Exitification,\n  flagSpec \"case-merge\"                       Opt_CaseMerge,\n  flagSpec \"case-folding\"                     Opt_CaseFolding,\n  flagSpec \"cmm-elim-common-blocks\"           Opt_CmmElimCommonBlocks,\n  flagSpec \"cmm-sink\"                         Opt_CmmSink,\n  flagSpec \"cse\"                              Opt_CSE,\n  flagSpec \"stg-cse\"                          Opt_StgCSE,\n  flagSpec \"stg-lift-lams\"                    Opt_StgLiftLams,\n  flagSpec \"cpr-anal\"                         Opt_CprAnal,\n  flagSpec \"defer-diagnostics\"                Opt_DeferDiagnostics,\n  flagSpec \"defer-type-errors\"                Opt_DeferTypeErrors,\n  flagSpec \"defer-typed-holes\"                Opt_DeferTypedHoles,\n  flagSpec \"defer-out-of-scope-variables\"     Opt_DeferOutOfScopeVariables,\n  flagSpec \"diagnostics-show-caret\"           Opt_DiagnosticsShowCaret,\n  flagSpec \"dicts-cheap\"                      Opt_DictsCheap,\n  flagSpec \"dicts-strict\"                     Opt_DictsStrict,\n  flagSpec \"dmd-tx-dict-sel\"                  Opt_DmdTxDictSel,\n  flagSpec \"do-eta-reduction\"                 Opt_DoEtaReduction,\n  flagSpec \"do-lambda-eta-expansion\"          Opt_DoLambdaEtaExpansion,\n  flagSpec \"eager-blackholing\"                Opt_EagerBlackHoling,\n  flagSpec \"embed-manifest\"                   Opt_EmbedManifest,\n  flagSpec \"enable-rewrite-rules\"             Opt_EnableRewriteRules,\n  flagSpec \"error-spans\"                      Opt_ErrorSpans,\n  flagSpec \"excess-precision\"                 Opt_ExcessPrecision,\n  flagSpec \"expose-all-unfoldings\"            Opt_ExposeAllUnfoldings,\n  flagSpec \"external-dynamic-refs\"            Opt_ExternalDynamicRefs,\n  flagSpec \"external-interpreter\"             Opt_ExternalInterpreter,\n  flagSpec \"flat-cache\"                       Opt_FlatCache,\n  flagSpec \"float-in\"                         Opt_FloatIn,\n  flagSpec \"force-recomp\"                     Opt_ForceRecomp,\n  flagSpec \"ignore-optim-changes\"             Opt_IgnoreOptimChanges,\n  flagSpec \"ignore-hpc-changes\"               Opt_IgnoreHpcChanges,\n  flagSpec \"full-laziness\"                    Opt_FullLaziness,\n  flagSpec \"fun-to-thunk\"                     Opt_FunToThunk,\n  flagSpec \"gen-manifest\"                     Opt_GenManifest,\n  flagSpec \"ghci-history\"                     Opt_GhciHistory,\n  flagSpec \"ghci-leak-check\"                  Opt_GhciLeakCheck,\n  flagSpec \"validate-ide-info\"                Opt_ValidateHie,\n  flagGhciSpec \"local-ghci-history\"           Opt_LocalGhciHistory,\n  flagGhciSpec \"no-it\"                        Opt_NoIt,\n  flagSpec \"ghci-sandbox\"                     Opt_GhciSandbox,\n  flagSpec \"helpful-errors\"                   Opt_HelpfulErrors,\n  flagSpec \"hpc\"                              Opt_Hpc,\n  flagSpec \"ignore-asserts\"                   Opt_IgnoreAsserts,\n  flagSpec \"ignore-interface-pragmas\"         Opt_IgnoreInterfacePragmas,\n  flagGhciSpec \"implicit-import-qualified\"    Opt_ImplicitImportQualified,\n  flagSpec \"irrefutable-tuples\"               Opt_IrrefutableTuples,\n  flagSpec \"kill-absence\"                     Opt_KillAbsence,\n  flagSpec \"kill-one-shot\"                    Opt_KillOneShot,\n  flagSpec \"late-dmd-anal\"                    Opt_LateDmdAnal,\n  flagSpec \"late-specialise\"                  Opt_LateSpecialise,\n  flagSpec \"liberate-case\"                    Opt_LiberateCase,\n  flagHiddenSpec \"llvm-tbaa\"                  Opt_LlvmTBAA,\n  flagHiddenSpec \"llvm-fill-undef-with-garbage\" Opt_LlvmFillUndefWithGarbage,\n  flagSpec \"loopification\"                    Opt_Loopification,\n  flagSpec \"block-layout-cfg\"                 Opt_CfgBlocklayout,\n  flagSpec \"block-layout-weightless\"          Opt_WeightlessBlocklayout,\n  flagSpec \"omit-interface-pragmas\"           Opt_OmitInterfacePragmas,\n  flagSpec \"omit-yields\"                      Opt_OmitYields,\n  flagSpec \"optimal-applicative-do\"           Opt_OptimalApplicativeDo,\n  flagSpec \"pedantic-bottoms\"                 Opt_PedanticBottoms,\n  flagSpec \"pre-inlining\"                     Opt_SimplPreInlining,\n  flagGhciSpec \"print-bind-contents\"          Opt_PrintBindContents,\n  flagGhciSpec \"print-bind-result\"            Opt_PrintBindResult,\n  flagGhciSpec \"print-evld-with-show\"         Opt_PrintEvldWithShow,\n  flagSpec \"print-explicit-foralls\"           Opt_PrintExplicitForalls,\n  flagSpec \"print-explicit-kinds\"             Opt_PrintExplicitKinds,\n  flagSpec \"print-explicit-coercions\"         Opt_PrintExplicitCoercions,\n  flagSpec \"print-explicit-runtime-reps\"      Opt_PrintExplicitRuntimeReps,\n  flagSpec \"print-equality-relations\"         Opt_PrintEqualityRelations,\n  flagSpec \"print-unicode-syntax\"             Opt_PrintUnicodeSyntax,\n  flagSpec \"print-expanded-synonyms\"          Opt_PrintExpandedSynonyms,\n  flagSpec \"print-potential-instances\"        Opt_PrintPotentialInstances,\n  flagSpec \"print-typechecker-elaboration\"    Opt_PrintTypecheckerElaboration,\n  flagSpec \"prof-cafs\"                        Opt_AutoSccsOnIndividualCafs,\n  flagSpec \"prof-count-entries\"               Opt_ProfCountEntries,\n  flagSpec \"regs-graph\"                       Opt_RegsGraph,\n  flagSpec \"regs-iterative\"                   Opt_RegsIterative,\n  depFlagSpec' \"rewrite-rules\"                Opt_EnableRewriteRules\n   (useInstead \"-f\" \"enable-rewrite-rules\"),\n  flagSpec \"shared-implib\"                    Opt_SharedImplib,\n  flagSpec \"spec-constr\"                      Opt_SpecConstr,\n  flagSpec \"spec-constr-keen\"                 Opt_SpecConstrKeen,\n  flagSpec \"specialise\"                       Opt_Specialise,\n  flagSpec \"specialize\"                       Opt_Specialise,\n  flagSpec \"specialise-aggressively\"          Opt_SpecialiseAggressively,\n  flagSpec \"specialize-aggressively\"          Opt_SpecialiseAggressively,\n  flagSpec \"cross-module-specialise\"          Opt_CrossModuleSpecialise,\n  flagSpec \"cross-module-specialize\"          Opt_CrossModuleSpecialise,\n  flagSpec \"static-argument-transformation\"   Opt_StaticArgumentTransformation,\n  flagSpec \"strictness\"                       Opt_Strictness,\n  flagSpec \"use-rpaths\"                       Opt_RPath,\n  flagSpec \"write-interface\"                  Opt_WriteInterface,\n  flagSpec \"write-ide-info\"                   Opt_WriteHie,\n  flagSpec \"unbox-small-strict-fields\"        Opt_UnboxSmallStrictFields,\n  flagSpec \"unbox-strict-fields\"              Opt_UnboxStrictFields,\n  flagSpec \"version-macros\"                   Opt_VersionMacros,\n  flagSpec \"worker-wrapper\"                   Opt_WorkerWrapper,\n  flagSpec \"solve-constant-dicts\"             Opt_SolveConstantDicts,\n  flagSpec \"catch-bottoms\"                    Opt_CatchBottoms,\n  flagSpec \"alignment-sanitisation\"           Opt_AlignmentSanitisation,\n  flagSpec \"num-constant-folding\"             Opt_NumConstantFolding,\n  flagSpec \"show-warning-groups\"              Opt_ShowWarnGroups,\n  flagSpec \"hide-source-paths\"                Opt_HideSourcePaths,\n  flagSpec \"show-loaded-modules\"              Opt_ShowLoadedModules,\n  flagSpec \"whole-archive-hs-libs\"            Opt_WholeArchiveHsLibs,\n  flagSpec \"keep-cafs\"                        Opt_KeepCAFs\n  ]\n  ++ fHoleFlags\n\n-- | These @-f\\<blah\\>@ flags have to do with the typed-hole error message or\n-- the valid hole fits in that message. See Note [Valid hole fits include ...]\n-- in the TcHoleErrors module. These flags can all be reversed with\n-- @-fno-\\<blah\\>@\nfHoleFlags :: [(Deprecation, FlagSpec GeneralFlag)]\nfHoleFlags = [\n  flagSpec \"show-hole-constraints\"            Opt_ShowHoleConstraints,\n  depFlagSpec' \"show-valid-substitutions\"     Opt_ShowValidHoleFits\n   (useInstead \"-f\" \"show-valid-hole-fits\"),\n  flagSpec \"show-valid-hole-fits\"             Opt_ShowValidHoleFits,\n  -- Sorting settings\n  flagSpec \"sort-valid-hole-fits\"             Opt_SortValidHoleFits,\n  flagSpec \"sort-by-size-hole-fits\"           Opt_SortBySizeHoleFits,\n  flagSpec \"sort-by-subsumption-hole-fits\"    Opt_SortBySubsumHoleFits,\n  flagSpec \"abstract-refinement-hole-fits\"    Opt_AbstractRefHoleFits,\n  -- Output format settings\n  flagSpec \"show-hole-matches-of-hole-fits\"   Opt_ShowMatchesOfHoleFits,\n  flagSpec \"show-provenance-of-hole-fits\"     Opt_ShowProvOfHoleFits,\n  flagSpec \"show-type-of-hole-fits\"           Opt_ShowTypeOfHoleFits,\n  flagSpec \"show-type-app-of-hole-fits\"       Opt_ShowTypeAppOfHoleFits,\n  flagSpec \"show-type-app-vars-of-hole-fits\"  Opt_ShowTypeAppVarsOfHoleFits,\n  flagSpec \"show-docs-of-hole-fits\"           Opt_ShowDocsOfHoleFits,\n  flagSpec \"unclutter-valid-hole-fits\"        Opt_UnclutterValidHoleFits\n  ]\n\n-- | These @-f\\<blah\\>@ flags can all be reversed with @-fno-\\<blah\\>@\nfLangFlags :: [FlagSpec LangExt.Extension]\nfLangFlags = map snd fLangFlagsDeps\n\nfLangFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]\nfLangFlagsDeps = [\n-- See Note [Updating flag description in the User's Guide]\n-- See Note [Supporting CLI completion]\n  depFlagSpecOp' \"th\"                           LangExt.TemplateHaskell\n    checkTemplateHaskellOk\n    (deprecatedForExtension \"TemplateHaskell\"),\n  depFlagSpec' \"fi\"                             LangExt.ForeignFunctionInterface\n    (deprecatedForExtension \"ForeignFunctionInterface\"),\n  depFlagSpec' \"ffi\"                            LangExt.ForeignFunctionInterface\n    (deprecatedForExtension \"ForeignFunctionInterface\"),\n  depFlagSpec' \"arrows\"                         LangExt.Arrows\n    (deprecatedForExtension \"Arrows\"),\n  depFlagSpec' \"implicit-prelude\"               LangExt.ImplicitPrelude\n    (deprecatedForExtension \"ImplicitPrelude\"),\n  depFlagSpec' \"bang-patterns\"                  LangExt.BangPatterns\n    (deprecatedForExtension \"BangPatterns\"),\n  depFlagSpec' \"monomorphism-restriction\"       LangExt.MonomorphismRestriction\n    (deprecatedForExtension \"MonomorphismRestriction\"),\n  depFlagSpec' \"mono-pat-binds\"                 LangExt.MonoPatBinds\n    (deprecatedForExtension \"MonoPatBinds\"),\n  depFlagSpec' \"extended-default-rules\"         LangExt.ExtendedDefaultRules\n    (deprecatedForExtension \"ExtendedDefaultRules\"),\n  depFlagSpec' \"implicit-params\"                LangExt.ImplicitParams\n    (deprecatedForExtension \"ImplicitParams\"),\n  depFlagSpec' \"scoped-type-variables\"          LangExt.ScopedTypeVariables\n    (deprecatedForExtension \"ScopedTypeVariables\"),\n  depFlagSpec' \"allow-overlapping-instances\"    LangExt.OverlappingInstances\n    (deprecatedForExtension \"OverlappingInstances\"),\n  depFlagSpec' \"allow-undecidable-instances\"    LangExt.UndecidableInstances\n    (deprecatedForExtension \"UndecidableInstances\"),\n  depFlagSpec' \"allow-incoherent-instances\"     LangExt.IncoherentInstances\n    (deprecatedForExtension \"IncoherentInstances\")\n  ]\n\nsupportedLanguages :: [String]\nsupportedLanguages = map (flagSpecName . snd) languageFlagsDeps\n\nsupportedLanguageOverlays :: [String]\nsupportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps\n\nsupportedExtensions :: [String]\nsupportedExtensions = concatMap toFlagSpecNamePair xFlags\n  where\n    toFlagSpecNamePair flg\n#if !defined(GHCI)\n      -- IMPORTANT! Make sure that `ghc --supported-extensions` omits\n      -- \"TemplateHaskell\"/\"QuasiQuotes\" when it's known not to work out of the\n      -- box. See also GHC #11102 and #16331 for more details about\n      -- the rationale\n      | flagSpecFlag flg == LangExt.TemplateHaskell  = [noName]\n      | flagSpecFlag flg == LangExt.QuasiQuotes      = [noName]\n#endif\n      | otherwise = [name, noName]\n      where\n        noName = \"No\" ++ name\n        name = flagSpecName flg\n\nsupportedLanguagesAndExtensions :: [String]\nsupportedLanguagesAndExtensions =\n    supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions\n\n-- | These -X<blah> flags cannot be reversed with -XNo<blah>\nlanguageFlagsDeps :: [(Deprecation, FlagSpec Language)]\nlanguageFlagsDeps = [\n  flagSpec \"Haskell98\"   Haskell98,\n  flagSpec \"Haskell2010\" Haskell2010\n  ]\n\n-- | These -X<blah> flags cannot be reversed with -XNo<blah>\n-- They are used to place hard requirements on what GHC Haskell language\n-- features can be used.\nsafeHaskellFlagsDeps :: [(Deprecation, FlagSpec SafeHaskellMode)]\nsafeHaskellFlagsDeps = [mkF Sf_Unsafe, mkF Sf_Trustworthy, mkF Sf_Safe]\n    where mkF flag = flagSpec (show flag) flag\n\n-- | These -X<blah> flags can all be reversed with -XNo<blah>\nxFlags :: [FlagSpec LangExt.Extension]\nxFlags = map snd xFlagsDeps\n\nxFlagsDeps :: [(Deprecation, FlagSpec LangExt.Extension)]\nxFlagsDeps = [\n-- See Note [Updating flag description in the User's Guide]\n-- See Note [Supporting CLI completion]\n-- See Note [Adding a language extension]\n-- Please keep the list of flags below sorted alphabetically\n  flagSpec \"AllowAmbiguousTypes\"              LangExt.AllowAmbiguousTypes,\n  flagSpec \"AlternativeLayoutRule\"            LangExt.AlternativeLayoutRule,\n  flagSpec \"AlternativeLayoutRuleTransitional\"\n                                              LangExt.AlternativeLayoutRuleTransitional,\n  flagSpec \"Arrows\"                           LangExt.Arrows,\n  depFlagSpecCond \"AutoDeriveTypeable\"        LangExt.AutoDeriveTypeable\n    id\n         (\"Typeable instances are created automatically \" ++\n                     \"for all types since GHC 8.2.\"),\n  flagSpec \"BangPatterns\"                     LangExt.BangPatterns,\n  flagSpec \"BinaryLiterals\"                   LangExt.BinaryLiterals,\n  flagSpec \"CApiFFI\"                          LangExt.CApiFFI,\n  flagSpec \"CPP\"                              LangExt.Cpp,\n  flagSpec \"ConstrainedClassMethods\"          LangExt.ConstrainedClassMethods,\n  flagSpec \"ConstraintKinds\"                  LangExt.ConstraintKinds,\n  flagSpec \"DataKinds\"                        LangExt.DataKinds,\n  depFlagSpecCond \"DatatypeContexts\"          LangExt.DatatypeContexts\n    id\n         (\"It was widely considered a misfeature, \" ++\n                     \"and has been removed from the Haskell language.\"),\n  flagSpec \"DefaultSignatures\"                LangExt.DefaultSignatures,\n  flagSpec \"DeriveAnyClass\"                   LangExt.DeriveAnyClass,\n  flagSpec \"DeriveDataTypeable\"               LangExt.DeriveDataTypeable,\n  flagSpec \"DeriveFoldable\"                   LangExt.DeriveFoldable,\n  flagSpec \"DeriveFunctor\"                    LangExt.DeriveFunctor,\n  flagSpec \"DeriveGeneric\"                    LangExt.DeriveGeneric,\n  flagSpec \"DeriveLift\"                       LangExt.DeriveLift,\n  flagSpec \"DeriveTraversable\"                LangExt.DeriveTraversable,\n  flagSpec \"DerivingStrategies\"               LangExt.DerivingStrategies,\n  flagSpec \"DerivingVia\"                      LangExt.DerivingVia,\n  flagSpec \"DisambiguateRecordFields\"         LangExt.DisambiguateRecordFields,\n  flagSpec \"DoAndIfThenElse\"                  LangExt.DoAndIfThenElse,\n  flagSpec \"BlockArguments\"                   LangExt.BlockArguments,\n  depFlagSpec' \"DoRec\"                        LangExt.RecursiveDo\n    (deprecatedForExtension \"RecursiveDo\"),\n  flagSpec \"DuplicateRecordFields\"            LangExt.DuplicateRecordFields,\n  flagSpec \"EmptyCase\"                        LangExt.EmptyCase,\n  flagSpec \"EmptyDataDecls\"                   LangExt.EmptyDataDecls,\n  flagSpec \"EmptyDataDeriving\"                LangExt.EmptyDataDeriving,\n  flagSpec \"ExistentialQuantification\"        LangExt.ExistentialQuantification,\n  flagSpec \"ExplicitForAll\"                   LangExt.ExplicitForAll,\n  flagSpec \"ExplicitNamespaces\"               LangExt.ExplicitNamespaces,\n  flagSpec \"ExtendedDefaultRules\"             LangExt.ExtendedDefaultRules,\n  flagSpec \"FlexibleContexts\"                 LangExt.FlexibleContexts,\n  flagSpec \"FlexibleInstances\"                LangExt.FlexibleInstances,\n  flagSpec \"ForeignFunctionInterface\"         LangExt.ForeignFunctionInterface,\n  flagSpec \"FunctionalDependencies\"           LangExt.FunctionalDependencies,\n  flagSpec \"GADTSyntax\"                       LangExt.GADTSyntax,\n  flagSpec \"GADTs\"                            LangExt.GADTs,\n  flagSpec \"GHCForeignImportPrim\"             LangExt.GHCForeignImportPrim,\n  flagSpec' \"GeneralizedNewtypeDeriving\"      LangExt.GeneralizedNewtypeDeriving\n                                              setGenDeriving,\n  flagSpec' \"GeneralisedNewtypeDeriving\"      LangExt.GeneralizedNewtypeDeriving\n                                              setGenDeriving,\n  flagSpec \"ImplicitParams\"                   LangExt.ImplicitParams,\n  flagSpec \"ImplicitPrelude\"                  LangExt.ImplicitPrelude,\n  flagSpec \"ImpredicativeTypes\"               LangExt.ImpredicativeTypes,\n  flagSpec' \"IncoherentInstances\"             LangExt.IncoherentInstances\n                                              setIncoherentInsts,\n  flagSpec \"TypeFamilyDependencies\"           LangExt.TypeFamilyDependencies,\n  flagSpec \"InstanceSigs\"                     LangExt.InstanceSigs,\n  flagSpec \"ApplicativeDo\"                    LangExt.ApplicativeDo,\n  flagSpec \"InterruptibleFFI\"                 LangExt.InterruptibleFFI,\n  flagSpec \"JavaScriptFFI\"                    LangExt.JavaScriptFFI,\n  flagSpec \"KindSignatures\"                   LangExt.KindSignatures,\n  flagSpec \"LambdaCase\"                       LangExt.LambdaCase,\n  flagSpec \"LiberalTypeSynonyms\"              LangExt.LiberalTypeSynonyms,\n  flagSpec \"MagicHash\"                        LangExt.MagicHash,\n  flagSpec \"MonadComprehensions\"              LangExt.MonadComprehensions,\n  flagSpec \"MonadFailDesugaring\"              LangExt.MonadFailDesugaring,\n  flagSpec \"MonoLocalBinds\"                   LangExt.MonoLocalBinds,\n  depFlagSpecCond \"MonoPatBinds\"              LangExt.MonoPatBinds\n    id\n         \"Experimental feature now removed; has no effect\",\n  flagSpec \"MonomorphismRestriction\"          LangExt.MonomorphismRestriction,\n  flagSpec \"MultiParamTypeClasses\"            LangExt.MultiParamTypeClasses,\n  flagSpec \"MultiWayIf\"                       LangExt.MultiWayIf,\n  flagSpec \"NumericUnderscores\"               LangExt.NumericUnderscores,\n  flagSpec \"NPlusKPatterns\"                   LangExt.NPlusKPatterns,\n  flagSpec \"NamedFieldPuns\"                   LangExt.RecordPuns,\n  flagSpec \"NamedWildCards\"                   LangExt.NamedWildCards,\n  flagSpec \"NegativeLiterals\"                 LangExt.NegativeLiterals,\n  flagSpec \"HexFloatLiterals\"                 LangExt.HexFloatLiterals,\n  flagSpec \"NondecreasingIndentation\"         LangExt.NondecreasingIndentation,\n  depFlagSpec' \"NullaryTypeClasses\"           LangExt.NullaryTypeClasses\n    (deprecatedForExtension \"MultiParamTypeClasses\"),\n  flagSpec \"NumDecimals\"                      LangExt.NumDecimals,\n  depFlagSpecOp \"OverlappingInstances\"        LangExt.OverlappingInstances\n    setOverlappingInsts\n    \"instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS\",\n  flagSpec \"OverloadedLabels\"                 LangExt.OverloadedLabels,\n  flagSpec \"OverloadedLists\"                  LangExt.OverloadedLists,\n  flagSpec \"OverloadedStrings\"                LangExt.OverloadedStrings,\n  flagSpec \"PackageImports\"                   LangExt.PackageImports,\n  flagSpec \"ParallelArrays\"                   LangExt.ParallelArrays,\n  flagSpec \"ParallelListComp\"                 LangExt.ParallelListComp,\n  flagSpec \"PartialTypeSignatures\"            LangExt.PartialTypeSignatures,\n  flagSpec \"PatternGuards\"                    LangExt.PatternGuards,\n  depFlagSpec' \"PatternSignatures\"            LangExt.ScopedTypeVariables\n    (deprecatedForExtension \"ScopedTypeVariables\"),\n  flagSpec \"PatternSynonyms\"                  LangExt.PatternSynonyms,\n  flagSpec \"PolyKinds\"                        LangExt.PolyKinds,\n  flagSpec \"PolymorphicComponents\"            LangExt.RankNTypes,\n  flagSpec \"QuantifiedConstraints\"            LangExt.QuantifiedConstraints,\n  flagSpec \"PostfixOperators\"                 LangExt.PostfixOperators,\n  flagSpec \"QuasiQuotes\"                      LangExt.QuasiQuotes,\n  flagSpec \"Rank2Types\"                       LangExt.RankNTypes,\n  flagSpec \"RankNTypes\"                       LangExt.RankNTypes,\n  flagSpec \"RebindableSyntax\"                 LangExt.RebindableSyntax,\n  depFlagSpec' \"RecordPuns\"                   LangExt.RecordPuns\n    (deprecatedForExtension \"NamedFieldPuns\"),\n  flagSpec \"RecordWildCards\"                  LangExt.RecordWildCards,\n  flagSpec \"RecursiveDo\"                      LangExt.RecursiveDo,\n  flagSpec \"RelaxedLayout\"                    LangExt.RelaxedLayout,\n  depFlagSpecCond \"RelaxedPolyRec\"            LangExt.RelaxedPolyRec\n    not\n         \"You can't turn off RelaxedPolyRec any more\",\n  flagSpec \"RoleAnnotations\"                  LangExt.RoleAnnotations,\n  flagSpec \"ScopedTypeVariables\"              LangExt.ScopedTypeVariables,\n  flagSpec \"StandaloneDeriving\"               LangExt.StandaloneDeriving,\n  flagSpec \"StarIsType\"                       LangExt.StarIsType,\n  flagSpec \"StaticPointers\"                   LangExt.StaticPointers,\n  flagSpec \"Strict\"                           LangExt.Strict,\n  flagSpec \"StrictData\"                       LangExt.StrictData,\n  flagSpec' \"TemplateHaskell\"                 LangExt.TemplateHaskell\n                                              checkTemplateHaskellOk,\n  flagSpec \"TemplateHaskellQuotes\"            LangExt.TemplateHaskellQuotes,\n  flagSpec \"TraditionalRecordSyntax\"          LangExt.TraditionalRecordSyntax,\n  flagSpec \"TransformListComp\"                LangExt.TransformListComp,\n  flagSpec \"TupleSections\"                    LangExt.TupleSections,\n  flagSpec \"TypeApplications\"                 LangExt.TypeApplications,\n  flagSpec \"TypeInType\"                       LangExt.TypeInType,\n  flagSpec \"TypeFamilies\"                     LangExt.TypeFamilies,\n  flagSpec \"TypeOperators\"                    LangExt.TypeOperators,\n  flagSpec \"TypeSynonymInstances\"             LangExt.TypeSynonymInstances,\n  flagSpec \"UnboxedTuples\"                    LangExt.UnboxedTuples,\n  flagSpec \"UnboxedSums\"                      LangExt.UnboxedSums,\n  flagSpec \"UndecidableInstances\"             LangExt.UndecidableInstances,\n  flagSpec \"UndecidableSuperClasses\"          LangExt.UndecidableSuperClasses,\n  flagSpec \"UnicodeSyntax\"                    LangExt.UnicodeSyntax,\n  flagSpec \"UnliftedFFITypes\"                 LangExt.UnliftedFFITypes,\n  flagSpec \"ViewPatterns\"                     LangExt.ViewPatterns\n  ]\n\ndefaultFlags :: Settings -> [GeneralFlag]\ndefaultFlags settings\n-- See Note [Updating flag description in the User's Guide]\n  = [ Opt_AutoLinkPackages,\n      Opt_DiagnosticsShowCaret,\n      Opt_EmbedManifest,\n      Opt_FlatCache,\n      Opt_GenManifest,\n      Opt_GhciHistory,\n      Opt_GhciSandbox,\n      Opt_HelpfulErrors,\n      Opt_KeepHiFiles,\n      Opt_KeepOFiles,\n      Opt_OmitYields,\n      Opt_PrintBindContents,\n      Opt_ProfCountEntries,\n      Opt_RPath,\n      Opt_SharedImplib,\n      Opt_SimplPreInlining,\n      Opt_VersionMacros\n    ]\n\n    ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]\n             -- The default -O0 options\n\n    ++ default_PIC platform\n\n    ++ concatMap (wayGeneralFlags platform) (defaultWays settings)\n    ++ validHoleFitDefaults\n\n    where platform = sTargetPlatform settings\n\n-- | These are the default settings for the display and sorting of valid hole\n--  fits in typed-hole error messages. See Note [Valid hole fits include ...]\n -- in the TcHoleErrors module.\nvalidHoleFitDefaults :: [GeneralFlag]\nvalidHoleFitDefaults\n  =  [ Opt_ShowTypeAppOfHoleFits\n     , Opt_ShowTypeOfHoleFits\n     , Opt_ShowProvOfHoleFits\n     , Opt_ShowMatchesOfHoleFits\n     , Opt_ShowValidHoleFits\n     , Opt_SortValidHoleFits\n     , Opt_SortBySizeHoleFits\n     , Opt_ShowHoleConstraints ]\n\n\nvalidHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]\nvalidHoleFitsImpliedGFlags\n  = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)\n    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits)\n    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits)\n    , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)\n    , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ]\n\ndefault_PIC :: Platform -> [GeneralFlag]\ndefault_PIC platform =\n  case (platformOS platform, platformArch platform) of\n    (OSDarwin, ArchX86_64) -> [Opt_PIC]\n    (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in\n                                         -- OpenBSD since 5.3 release\n                                         -- (1 May 2013) we need to\n                                         -- always generate PIC. See\n                                         -- #10597 for more\n                                         -- information.\n    _                      -> []\n\n-- General flags that are switched on/off when other general flags are switched\n-- on\nimpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]\nimpliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)\n                ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables)\n                ,(Opt_Strictness, turnOn, Opt_WorkerWrapper)\n                ] ++ validHoleFitsImpliedGFlags\n\n-- General flags that are switched on/off when other general flags are switched\n-- off\nimpliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]\nimpliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)]\n\nimpliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)]\nimpliedXFlags\n-- See Note [Updating flag description in the User's Guide]\n  = [ (LangExt.RankNTypes,                turnOn, LangExt.ExplicitForAll)\n    , (LangExt.QuantifiedConstraints,     turnOn, LangExt.ExplicitForAll)\n    , (LangExt.ScopedTypeVariables,       turnOn, LangExt.ExplicitForAll)\n    , (LangExt.LiberalTypeSynonyms,       turnOn, LangExt.ExplicitForAll)\n    , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll)\n    , (LangExt.FlexibleInstances,         turnOn, LangExt.TypeSynonymInstances)\n    , (LangExt.FunctionalDependencies,    turnOn, LangExt.MultiParamTypeClasses)\n    , (LangExt.MultiParamTypeClasses,     turnOn, LangExt.ConstrainedClassMethods)  -- c.f. Trac #7854\n    , (LangExt.TypeFamilyDependencies,    turnOn, LangExt.TypeFamilies)\n\n    , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude)      -- NB: turn off!\n\n    , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)\n\n    , (LangExt.GADTs,            turnOn, LangExt.GADTSyntax)\n    , (LangExt.GADTs,            turnOn, LangExt.MonoLocalBinds)\n    , (LangExt.TypeFamilies,     turnOn, LangExt.MonoLocalBinds)\n\n    , (LangExt.TypeFamilies,     turnOn, LangExt.KindSignatures)  -- Type families use kind signatures\n    , (LangExt.PolyKinds,        turnOn, LangExt.KindSignatures)  -- Ditto polymorphic kinds\n\n    -- TypeInType is now just a synonym for a couple of other extensions.\n    , (LangExt.TypeInType,       turnOn, LangExt.DataKinds)\n    , (LangExt.TypeInType,       turnOn, LangExt.PolyKinds)\n    , (LangExt.TypeInType,       turnOn, LangExt.KindSignatures)\n\n    -- AutoDeriveTypeable is not very useful without DeriveDataTypeable\n    , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)\n\n    -- We turn this on so that we can export associated type\n    -- type synonyms in subordinates (e.g. MyClass(type AssocType))\n    , (LangExt.TypeFamilies,     turnOn, LangExt.ExplicitNamespaces)\n    , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces)\n\n    , (LangExt.ImpredicativeTypes,  turnOn, LangExt.RankNTypes)\n\n        -- Record wild-cards implies field disambiguation\n        -- Otherwise if you write (C {..}) you may well get\n        -- stuff like \" 'a' not in scope \", which is a bit silly\n        -- if the compiler has just filled in field 'a' of constructor 'C'\n    , (LangExt.RecordWildCards,     turnOn, LangExt.DisambiguateRecordFields)\n\n    , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp)\n\n    , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI)\n\n    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor)\n    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable)\n\n    -- Duplicate record fields require field disambiguation\n    , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields)\n\n    , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)\n    , (LangExt.Strict, turnOn, LangExt.StrictData)\n  ]\n\n-- Note [When is StarIsType enabled]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- The StarIsType extension determines whether to treat '*' as a regular type\n-- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType\n-- programs expect '*' to be synonymous with 'Type', so by default StarIsType is\n-- enabled.\n--\n-- Programs that use TypeOperators might expect to repurpose '*' for\n-- multiplication or another binary operation, but making TypeOperators imply\n-- NoStarIsType caused too much breakage on Hackage.\n--\n\n-- Note [Documenting optimisation flags]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- If you change the list of flags enabled for particular optimisation levels\n-- please remember to update the User's Guide. The relevant file is:\n--\n--   docs/users_guide/using-optimisation.rst\n--\n-- Make sure to note whether a flag is implied by -O0, -O or -O2.\n\noptLevelFlags :: [([Int], GeneralFlag)]\noptLevelFlags -- see Note [Documenting optimisation flags]\n  = [ ([0,1,2], Opt_DoLambdaEtaExpansion)\n    , ([0,1,2], Opt_DoEtaReduction)       -- See Note [Eta-reduction in -O0]\n    , ([0,1,2], Opt_DmdTxDictSel)\n    , ([0,1,2], Opt_LlvmTBAA)\n\n    , ([0],     Opt_IgnoreInterfacePragmas)\n    , ([0],     Opt_OmitInterfacePragmas)\n\n    , ([1,2],   Opt_CallArity)\n    , ([1,2],   Opt_Exitification)\n    , ([1,2],   Opt_CaseMerge)\n    , ([1,2],   Opt_CaseFolding)\n    , ([1,2],   Opt_CmmElimCommonBlocks)\n    , ([2],     Opt_AsmShortcutting)\n    , ([1,2],   Opt_CmmSink)\n    , ([1,2],   Opt_CSE)\n    , ([1,2],   Opt_StgCSE)\n    , ([2],     Opt_StgLiftLams)\n    , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]\n                                         --              in PrelRules\n    , ([1,2],   Opt_FloatIn)\n    , ([1,2],   Opt_FullLaziness)\n    , ([1,2],   Opt_IgnoreAsserts)\n    , ([1,2],   Opt_Loopification)\n    , ([1,2],   Opt_CfgBlocklayout)      -- Experimental\n\n    , ([1,2],   Opt_Specialise)\n    , ([1,2],   Opt_CrossModuleSpecialise)\n    , ([1,2],   Opt_Strictness)\n    , ([1,2],   Opt_UnboxSmallStrictFields)\n    , ([1,2],   Opt_CprAnal)\n    , ([1,2],   Opt_WorkerWrapper)\n    , ([1,2],   Opt_SolveConstantDicts)\n    , ([1,2],   Opt_NumConstantFolding)\n\n    , ([2],     Opt_LiberateCase)\n    , ([2],     Opt_SpecConstr)\n--  , ([2],     Opt_RegsGraph)\n--   RegsGraph suffers performance regression. See #7679\n--  , ([2],     Opt_StaticArgumentTransformation)\n--   Static Argument Transformation needs investigation. See #9374\n    ]\n\n{- Note [Eta-reduction in -O0]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTrac #11562 showed an example which tripped an ASSERT in CoreToStg; a\nfunction was marked as MayHaveCafRefs when in fact it obviously\ndidn't.  Reason was:\n * Eta reduction wasn't happening in the simplifier, but it was\n   happening in CorePrep, on\n        $fBla = MkDict (/\\a. K a)\n * Result: rhsIsStatic told TidyPgm that $fBla might have CAF refs\n   but the eta-reduced version (MkDict K) obviously doesn't\nSimple solution: just let the simplifier do eta-reduction even in -O0.\nAfter all, CorePrep does it unconditionally!  Not a big deal, but\nremoves an assertion failure. -}\n\n\n-- -----------------------------------------------------------------------------\n-- Standard sets of warning options\n\n-- Note [Documenting warning flags]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- If you change the list of warning enabled by default\n-- please remember to update the User's Guide. The relevant file is:\n--\n--  docs/users_guide/using-warnings.rst\n\n-- | Warning groups.\n--\n-- As all warnings are in the Weverything set, it is ignored when\n-- displaying to the user which group a warning is in.\nwarningGroups :: [(String, [WarningFlag])]\nwarningGroups =\n    [ (\"compat\",       minusWcompatOpts)\n    , (\"unused-binds\", unusedBindsFlags)\n    , (\"default\",      standardWarnings)\n    , (\"extra\",        minusWOpts)\n    , (\"all\",          minusWallOpts)\n    , (\"everything\",   minusWeverythingOpts)\n    ]\n\n-- | Warning group hierarchies, where there is an explicit inclusion\n-- relation.\n--\n-- Each inner list is a hierarchy of warning groups, ordered from\n-- smallest to largest, where each group is a superset of the one\n-- before it.\n--\n-- Separating this from 'warningGroups' allows for multiple\n-- hierarchies with no inherent relation to be defined.\n--\n-- The special-case Weverything group is not included.\nwarningHierarchies :: [[String]]\nwarningHierarchies = hierarchies ++ map (:[]) rest\n  where\n    hierarchies = [[\"default\", \"extra\", \"all\"]]\n    rest = filter (`notElem` \"everything\" : concat hierarchies) $\n           map fst warningGroups\n\n-- | Find the smallest group in every hierarchy which a warning\n-- belongs to, excluding Weverything.\nsmallestGroups :: WarningFlag -> [String]\nsmallestGroups flag = mapMaybe go warningHierarchies where\n    -- Because each hierarchy is arranged from smallest to largest,\n    -- the first group we find in a hierarchy which contains the flag\n    -- is the smallest.\n    go (group:rest) = fromMaybe (go rest) $ do\n        flags <- lookup group warningGroups\n        guard (flag `elem` flags)\n        pure (Just group)\n    go [] = Nothing\n\n-- | Warnings enabled unless specified otherwise\nstandardWarnings :: [WarningFlag]\nstandardWarnings -- see Note [Documenting warning flags]\n    = [ Opt_WarnOverlappingPatterns,\n        Opt_WarnWarningsDeprecations,\n        Opt_WarnDeprecatedFlags,\n        Opt_WarnDeferredTypeErrors,\n        Opt_WarnTypedHoles,\n        Opt_WarnDeferredOutOfScopeVariables,\n        Opt_WarnPartialTypeSignatures,\n        Opt_WarnUnrecognisedPragmas,\n        Opt_WarnDuplicateExports,\n        Opt_WarnOverflowedLiterals,\n        Opt_WarnEmptyEnumerations,\n        Opt_WarnMissingFields,\n        Opt_WarnMissingMethods,\n        Opt_WarnWrongDoBind,\n        Opt_WarnUnsupportedCallingConventions,\n        Opt_WarnDodgyForeignImports,\n        Opt_WarnInlineRuleShadowing,\n        Opt_WarnAlternativeLayoutRuleTransitional,\n        Opt_WarnUnsupportedLlvmVersion,\n        Opt_WarnMissedExtraSharedLib,\n        Opt_WarnTabs,\n        Opt_WarnUnrecognisedWarningFlags,\n        Opt_WarnSimplifiableClassConstraints,\n        Opt_WarnStarBinder,\n        Opt_WarnInaccessibleCode,\n        Opt_WarnSpaceAfterBang\n      ]\n\n-- | Things you get with -W\nminusWOpts :: [WarningFlag]\nminusWOpts\n    = standardWarnings ++\n      [ Opt_WarnUnusedTopBinds,\n        Opt_WarnUnusedLocalBinds,\n        Opt_WarnUnusedPatternBinds,\n        Opt_WarnUnusedMatches,\n        Opt_WarnUnusedForalls,\n        Opt_WarnUnusedImports,\n        Opt_WarnIncompletePatterns,\n        Opt_WarnDodgyExports,\n        Opt_WarnDodgyImports,\n        Opt_WarnUnbangedStrictPatterns\n      ]\n\n-- | Things you get with -Wall\nminusWallOpts :: [WarningFlag]\nminusWallOpts\n    = minusWOpts ++\n      [ Opt_WarnTypeDefaults,\n        Opt_WarnNameShadowing,\n        Opt_WarnMissingSignatures,\n        Opt_WarnHiShadows,\n        Opt_WarnOrphans,\n        Opt_WarnUnusedDoBind,\n        Opt_WarnTrustworthySafe,\n        Opt_WarnUntickedPromotedConstructors,\n        Opt_WarnMissingPatternSynonymSignatures,\n        Opt_WarnUnusedRecordWildcards,\n        Opt_WarnRedundantRecordWildcards\n      ]\n\n-- | Things you get with -Weverything, i.e. *all* known warnings flags\nminusWeverythingOpts :: [WarningFlag]\nminusWeverythingOpts = [ toEnum 0 .. ]\n\n-- | Things you get with -Wcompat.\n--\n-- This is intended to group together warnings that will be enabled by default\n-- at some point in the future, so that library authors eager to make their\n-- code future compatible to fix issues before they even generate warnings.\nminusWcompatOpts :: [WarningFlag]\nminusWcompatOpts\n    = [ Opt_WarnMissingMonadFailInstances\n      , Opt_WarnSemigroup\n      , Opt_WarnNonCanonicalMonoidInstances\n      , Opt_WarnStarIsType\n      ]\n\nenableUnusedBinds :: DynP ()\nenableUnusedBinds = mapM_ setWarningFlag unusedBindsFlags\n\ndisableUnusedBinds :: DynP ()\ndisableUnusedBinds = mapM_ unSetWarningFlag unusedBindsFlags\n\n-- Things you get with -Wunused-binds\nunusedBindsFlags :: [WarningFlag]\nunusedBindsFlags = [ Opt_WarnUnusedTopBinds\n                   , Opt_WarnUnusedLocalBinds\n                   , Opt_WarnUnusedPatternBinds\n                   ]\n\nenableGlasgowExts :: DynP ()\nenableGlasgowExts = do setGeneralFlag Opt_PrintExplicitForalls\n                       mapM_ setExtensionFlag glasgowExtsFlags\n\ndisableGlasgowExts :: DynP ()\ndisableGlasgowExts = do unSetGeneralFlag Opt_PrintExplicitForalls\n                        mapM_ unSetExtensionFlag glasgowExtsFlags\n\n-- Please keep what_glasgow_exts_does.rst up to date with this list\nglasgowExtsFlags :: [LangExt.Extension]\nglasgowExtsFlags = [\n             LangExt.ConstrainedClassMethods\n           , LangExt.DeriveDataTypeable\n           , LangExt.DeriveFoldable\n           , LangExt.DeriveFunctor\n           , LangExt.DeriveGeneric\n           , LangExt.DeriveTraversable\n           , LangExt.EmptyDataDecls\n           , LangExt.ExistentialQuantification\n           , LangExt.ExplicitNamespaces\n           , LangExt.FlexibleContexts\n           , LangExt.FlexibleInstances\n           , LangExt.ForeignFunctionInterface\n           , LangExt.FunctionalDependencies\n           , LangExt.GeneralizedNewtypeDeriving\n           , LangExt.ImplicitParams\n           , LangExt.KindSignatures\n           , LangExt.LiberalTypeSynonyms\n           , LangExt.MagicHash\n           , LangExt.MultiParamTypeClasses\n           , LangExt.ParallelListComp\n           , LangExt.PatternGuards\n           , LangExt.PostfixOperators\n           , LangExt.RankNTypes\n           , LangExt.RecursiveDo\n           , LangExt.ScopedTypeVariables\n           , LangExt.StandaloneDeriving\n           , LangExt.TypeOperators\n           , LangExt.TypeSynonymInstances\n           , LangExt.UnboxedTuples\n           , LangExt.UnicodeSyntax\n           , LangExt.UnliftedFFITypes ]\n\nforeign import ccall unsafe \"rts_isProfiled\" rtsIsProfiledIO :: IO CInt\n\n-- | Was the runtime system built with profiling enabled?\nrtsIsProfiled :: Bool\nrtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0\n\n-- Consult the RTS to find whether GHC itself has been built with\n-- dynamic linking.  This can't be statically known at compile-time,\n-- because we build both the static and dynamic versions together with\n-- -dynamic-too.\nforeign import ccall unsafe \"rts_isDynamic\" rtsIsDynamicIO :: IO CInt\n\ndynamicGhc :: Bool\ndynamicGhc = unsafeDupablePerformIO rtsIsDynamicIO /= 0\n\nsetWarnSafe :: Bool -> DynP ()\nsetWarnSafe True  = getCurLoc >>= \\l -> upd (\\d -> d { warnSafeOnLoc = l })\nsetWarnSafe False = return ()\n\nsetWarnUnsafe :: Bool -> DynP ()\nsetWarnUnsafe True  = getCurLoc >>= \\l -> upd (\\d -> d { warnUnsafeOnLoc = l })\nsetWarnUnsafe False = return ()\n\nsetPackageTrust :: DynP ()\nsetPackageTrust = do\n    setGeneralFlag Opt_PackageTrust\n    l <- getCurLoc\n    upd $ \\d -> d { pkgTrustOnLoc = l }\n\nsetGenDeriving :: TurnOnFlag -> DynP ()\nsetGenDeriving True  = getCurLoc >>= \\l -> upd (\\d -> d { newDerivOnLoc = l })\nsetGenDeriving False = return ()\n\nsetOverlappingInsts :: TurnOnFlag -> DynP ()\nsetOverlappingInsts False = return ()\nsetOverlappingInsts True = do\n  l <- getCurLoc\n  upd (\\d -> d { overlapInstLoc = l })\n\nsetIncoherentInsts :: TurnOnFlag -> DynP ()\nsetIncoherentInsts False = return ()\nsetIncoherentInsts True = do\n  l <- getCurLoc\n  upd (\\d -> d { incoherentOnLoc = l })\n\ncheckTemplateHaskellOk :: TurnOnFlag -> DynP ()\ncheckTemplateHaskellOk _turn_on\n  = getCurLoc >>= \\l -> upd (\\d -> d { thOnLoc = l })\n\n{- **********************************************************************\n%*                                                                      *\n                DynFlags constructors\n%*                                                                      *\n%********************************************************************* -}\n\ntype DynP = EwM (CmdLineP DynFlags)\n\nupd :: (DynFlags -> DynFlags) -> DynP ()\nupd f = liftEwM (do dflags <- getCmdLineState\n                    putCmdLineState $! f dflags)\n\nupdM :: (DynFlags -> DynP DynFlags) -> DynP ()\nupdM f = do dflags <- liftEwM getCmdLineState\n            dflags' <- f dflags\n            liftEwM $ putCmdLineState $! dflags'\n\n--------------- Constructor functions for OptKind -----------------\nnoArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)\nnoArg fn = NoArg (upd fn)\n\nnoArgM :: (DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)\nnoArgM fn = NoArg (updM fn)\n\nhasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)\nhasArg fn = HasArg (upd . fn)\n\nsepArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)\nsepArg fn = SepArg (upd . fn)\n\nintSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)\nintSuffix fn = IntSuffix (\\n -> upd (fn n))\n\nintSuffixM :: (Int -> DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)\nintSuffixM fn = IntSuffix (\\n -> updM (fn n))\n\nfloatSuffix :: (Float -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)\nfloatSuffix fn = FloatSuffix (\\n -> upd (fn n))\n\noptIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)\n              -> OptKind (CmdLineP DynFlags)\noptIntSuffixM fn = OptIntSuffix (\\mi -> updM (fn mi))\n\nsetDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)\nsetDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)\n\n--------------------------\naddWay :: Way -> DynP ()\naddWay w = upd (addWay' w)\n\naddWay' :: Way -> DynFlags -> DynFlags\naddWay' w dflags0 = let platform = targetPlatform dflags0\n                        dflags1 = dflags0 { ways = w : ways dflags0 }\n                        dflags2 = foldr setGeneralFlag' dflags1\n                                        (wayGeneralFlags platform w)\n                        dflags3 = foldr unSetGeneralFlag' dflags2\n                                        (wayUnsetGeneralFlags platform w)\n                    in dflags3\n\nremoveWayDyn :: DynP ()\nremoveWayDyn = upd (\\dfs -> dfs { ways = filter (WayDyn /=) (ways dfs) })\n\n--------------------------\nsetGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()\nsetGeneralFlag   f = upd (setGeneralFlag' f)\nunSetGeneralFlag f = upd (unSetGeneralFlag' f)\n\nsetGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags\nsetGeneralFlag' f dflags = foldr ($) (gopt_set dflags f) deps\n  where\n    deps = [ if turn_on then setGeneralFlag'   d\n                        else unSetGeneralFlag' d\n           | (f', turn_on, d) <- impliedGFlags, f' == f ]\n        -- When you set f, set the ones it implies\n        -- NB: use setGeneralFlag recursively, in case the implied flags\n        --     implies further flags\n\nunSetGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags\nunSetGeneralFlag' f dflags = foldr ($) (gopt_unset dflags f) deps\n  where\n    deps = [ if turn_on then setGeneralFlag' d\n                        else unSetGeneralFlag' d\n           | (f', turn_on, d) <- impliedOffGFlags, f' == f ]\n   -- In general, when you un-set f, we don't un-set the things it implies.\n   -- There are however some exceptions, e.g., -fno-strictness implies\n   -- -fno-worker-wrapper.\n   --\n   -- NB: use unSetGeneralFlag' recursively, in case the implied off flags\n   --     imply further flags.\n\n--------------------------\nsetWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()\nsetWarningFlag   f = upd (\\dfs -> wopt_set dfs f)\nunSetWarningFlag f = upd (\\dfs -> wopt_unset dfs f)\n\nsetFatalWarningFlag, unSetFatalWarningFlag :: WarningFlag -> DynP ()\nsetFatalWarningFlag   f = upd (\\dfs -> wopt_set_fatal dfs f)\nunSetFatalWarningFlag f = upd (\\dfs -> wopt_unset_fatal dfs f)\n\nsetWErrorFlag :: WarningFlag -> DynP ()\nsetWErrorFlag flag =\n  do { setWarningFlag flag\n     ; setFatalWarningFlag flag }\n\n--------------------------\nsetExtensionFlag, unSetExtensionFlag :: LangExt.Extension -> DynP ()\nsetExtensionFlag f = upd (setExtensionFlag' f)\nunSetExtensionFlag f = upd (unSetExtensionFlag' f)\n\nsetExtensionFlag', unSetExtensionFlag' :: LangExt.Extension -> DynFlags -> DynFlags\nsetExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps\n  where\n    deps = [ if turn_on then setExtensionFlag'   d\n                        else unSetExtensionFlag' d\n           | (f', turn_on, d) <- impliedXFlags, f' == f ]\n        -- When you set f, set the ones it implies\n        -- NB: use setExtensionFlag recursively, in case the implied flags\n        --     implies further flags\n\nunSetExtensionFlag' f dflags = xopt_unset dflags f\n   -- When you un-set f, however, we don't un-set the things it implies\n   --      (except for -fno-glasgow-exts, which is treated specially)\n\n--------------------------\nalterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags\nalterSettings f dflags = dflags { settings = f (settings dflags) }\n\n--------------------------\nsetDumpFlag' :: DumpFlag -> DynP ()\nsetDumpFlag' dump_flag\n  = do upd (\\dfs -> dopt_set dfs dump_flag)\n       when want_recomp forceRecompile\n    where -- Certain dumpy-things are really interested in what's going\n          -- on during recompilation checking, so in those cases we\n          -- don't want to turn it off.\n          want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,\n                                             Opt_D_dump_hi_diffs,\n                                             Opt_D_no_debug_output]\n\nforceRecompile :: DynP ()\n-- Whenver we -ddump, force recompilation (by switching off the\n-- recompilation checker), else you don't see the dump! However,\n-- don't switch it off in --make mode, else *everything* gets\n-- recompiled which probably isn't what you want\nforceRecompile = do dfs <- liftEwM getCmdLineState\n                    when (force_recomp dfs) (setGeneralFlag Opt_ForceRecomp)\n        where\n          force_recomp dfs = isOneShot (ghcMode dfs)\n\n\nsetVerboseCore2Core :: DynP ()\nsetVerboseCore2Core = setDumpFlag' Opt_D_verbose_core2core\n\nsetVerbosity :: Maybe Int -> DynP ()\nsetVerbosity mb_n = upd (\\dfs -> dfs{ verbosity = mb_n `orElse` 3 })\n\nsetDebugLevel :: Maybe Int -> DynP ()\nsetDebugLevel mb_n = upd (\\dfs -> dfs{ debugLevel = mb_n `orElse` 2 })\n\ndata PkgConfRef\n  = GlobalPkgConf\n  | UserPkgConf\n  | PkgConfFile FilePath\n  deriving Eq\n\naddPkgConfRef :: PkgConfRef -> DynP ()\naddPkgConfRef p = upd $ \\s ->\n  s { packageDBFlags = PackageDB p : packageDBFlags s }\n\nremoveUserPkgConf :: DynP ()\nremoveUserPkgConf = upd $ \\s ->\n  s { packageDBFlags = NoUserPackageDB : packageDBFlags s }\n\nremoveGlobalPkgConf :: DynP ()\nremoveGlobalPkgConf = upd $ \\s ->\n s { packageDBFlags = NoGlobalPackageDB : packageDBFlags s }\n\nclearPkgConf :: DynP ()\nclearPkgConf = upd $ \\s ->\n  s { packageDBFlags = ClearPackageDBs : packageDBFlags s }\n\nparsePackageFlag :: String                 -- the flag\n                 -> ReadP PackageArg       -- type of argument\n                 -> String                 -- string to parse\n                 -> PackageFlag\nparsePackageFlag flag arg_parse str\n = case filter ((==\"\").snd) (readP_to_S parse str) of\n    [(r, \"\")] -> r\n    _ -> throwGhcException $ CmdLineError (\"Can't parse package flag: \" ++ str)\n  where doc = flag ++ \" \" ++ str\n        parse = do\n            pkg_arg <- tok arg_parse\n            let mk_expose = ExposePackage doc pkg_arg\n            ( do _ <- tok $ string \"with\"\n                 fmap (mk_expose . ModRenaming True) parseRns\n             <++ fmap (mk_expose . ModRenaming False) parseRns\n             <++ return (mk_expose (ModRenaming True [])))\n        parseRns = do _ <- tok $ R.char '('\n                      rns <- tok $ sepBy parseItem (tok $ R.char ',')\n                      _ <- tok $ R.char ')'\n                      return rns\n        parseItem = do\n            orig <- tok $ parseModuleName\n            (do _ <- tok $ string \"as\"\n                new <- tok $ parseModuleName\n                return (orig, new)\n              +++\n             return (orig, orig))\n        tok m = m >>= \\x -> skipSpaces >> return x\n\nexposePackage, exposePackageId, hidePackage,\n        exposePluginPackage, exposePluginPackageId,\n        ignorePackage,\n        trustPackage, distrustPackage :: String -> DynP ()\nexposePackage p = upd (exposePackage' p)\nexposePackageId p =\n  upd (\\s -> s{ packageFlags =\n    parsePackageFlag \"-package-id\" parseUnitIdArg p : packageFlags s })\nexposePluginPackage p =\n  upd (\\s -> s{ pluginPackageFlags =\n    parsePackageFlag \"-plugin-package\" parsePackageArg p : pluginPackageFlags s })\nexposePluginPackageId p =\n  upd (\\s -> s{ pluginPackageFlags =\n    parsePackageFlag \"-plugin-package-id\" parseUnitIdArg p : pluginPackageFlags s })\nhidePackage p =\n  upd (\\s -> s{ packageFlags = HidePackage p : packageFlags s })\nignorePackage p =\n  upd (\\s -> s{ ignorePackageFlags = IgnorePackage p : ignorePackageFlags s })\n\ntrustPackage p = exposePackage p >> -- both trust and distrust also expose a package\n  upd (\\s -> s{ trustFlags = TrustPackage p : trustFlags s })\ndistrustPackage p = exposePackage p >>\n  upd (\\s -> s{ trustFlags = DistrustPackage p : trustFlags s })\n\nexposePackage' :: String -> DynFlags -> DynFlags\nexposePackage' p dflags\n    = dflags { packageFlags =\n            parsePackageFlag \"-package\" parsePackageArg p : packageFlags dflags }\n\nparsePackageArg :: ReadP PackageArg\nparsePackageArg =\n    fmap PackageArg (munch1 (\\c -> isAlphaNum c || c `elem` \":-_.\"))\n\nparseUnitIdArg :: ReadP PackageArg\nparseUnitIdArg =\n    fmap UnitIdArg parseUnitId\n\nsetUnitId :: String -> DynFlags -> DynFlags\nsetUnitId p d = d { thisInstalledUnitId = stringToInstalledUnitId p }\n\n-- | Given a 'ModuleName' of a signature in the home library, find\n-- out how it is instantiated.  E.g., the canonical form of\n-- A in @p[A=q[]:A]@ is @q[]:A@.\ncanonicalizeHomeModule :: DynFlags -> ModuleName -> Module\ncanonicalizeHomeModule dflags mod_name =\n    case lookup mod_name (thisUnitIdInsts dflags) of\n        Nothing  -> mkModule (thisPackage dflags) mod_name\n        Just mod -> mod\n\ncanonicalizeModuleIfHome :: DynFlags -> Module -> Module\ncanonicalizeModuleIfHome dflags mod\n    = if thisPackage dflags == moduleUnitId mod\n                      then canonicalizeHomeModule dflags (moduleName mod)\n                      else mod\n\n\n-- -----------------------------------------------------------------------------\n-- | Find the package environment (if one exists)\n--\n-- We interpret the package environment as a set of package flags; to be\n-- specific, if we find a package environment file like\n--\n-- > clear-package-db\n-- > global-package-db\n-- > package-db blah/package.conf.d\n-- > package-id id1\n-- > package-id id2\n--\n-- we interpret this as\n--\n-- > [ -hide-all-packages\n-- > , -clear-package-db\n-- > , -global-package-db\n-- > , -package-db blah/package.conf.d\n-- > , -package-id id1\n-- > , -package-id id2\n-- > ]\n--\n-- There's also an older syntax alias for package-id, which is just an\n-- unadorned package id\n--\n-- > id1\n-- > id2\n--\ninterpretPackageEnv :: DynFlags -> IO DynFlags\ninterpretPackageEnv dflags = do\n    mPkgEnv <- runMaybeT $ msum $ [\n                   getCmdLineArg >>= \\env -> msum [\n                       probeNullEnv env\n                     , probeEnvFile env\n                     , probeEnvName env\n                     , cmdLineError env\n                     ]\n                 , getEnvVar >>= \\env -> msum [\n                       probeNullEnv env\n                     , probeEnvFile env\n                     , probeEnvName env\n                     , envError     env\n                     ]\n                 , notIfHideAllPackages >> msum [\n                       findLocalEnvFile >>= probeEnvFile\n                     , probeEnvName defaultEnvName\n                     ]\n                 ]\n    case mPkgEnv of\n      Nothing ->\n        -- No environment found. Leave DynFlags unchanged.\n        return dflags\n      Just \"-\" -> do\n        -- Explicitly disabled environment file. Leave DynFlags unchanged.\n        return dflags\n      Just envfile -> do\n        content <- readFile envfile\n        putLogMsg dflags NoReason SevInfo noSrcSpan\n             (defaultUserStyle dflags)\n             (text (\"Loaded package environment from \" ++ envfile))\n        let setFlags :: DynP ()\n            setFlags = do\n              setGeneralFlag Opt_HideAllPackages\n              parseEnvFile envfile content\n\n            (_, dflags') = runCmdLine (runEwM setFlags) dflags\n\n        return dflags'\n  where\n    -- Loading environments (by name or by location)\n\n    namedEnvPath :: String -> MaybeT IO FilePath\n    namedEnvPath name = do\n     appdir <- versionedAppDir dflags\n     return $ appdir </> \"environments\" </> name\n\n    probeEnvName :: String -> MaybeT IO FilePath\n    probeEnvName name = probeEnvFile =<< namedEnvPath name\n\n    probeEnvFile :: FilePath -> MaybeT IO FilePath\n    probeEnvFile path = do\n      guard =<< liftMaybeT (doesFileExist path)\n      return path\n\n    probeNullEnv :: FilePath -> MaybeT IO FilePath\n    probeNullEnv \"-\" = return \"-\"\n    probeNullEnv _   = mzero\n\n    parseEnvFile :: FilePath -> String -> DynP ()\n    parseEnvFile envfile = mapM_ parseEntry . lines\n      where\n        parseEntry str = case words str of\n          (\"package-db\": _)     -> addPkgConfRef (PkgConfFile (envdir </> db))\n            -- relative package dbs are interpreted relative to the env file\n            where envdir = takeDirectory envfile\n                  db     = drop 11 str\n          [\"clear-package-db\"]  -> clearPkgConf\n          [\"global-package-db\"] -> addPkgConfRef GlobalPkgConf\n          [\"user-package-db\"]   -> addPkgConfRef UserPkgConf\n          [\"package-id\", pkgid] -> exposePackageId pkgid\n          (('-':'-':_):_)       -> return () -- comments\n          -- and the original syntax introduced in 7.10:\n          [pkgid]               -> exposePackageId pkgid\n          []                    -> return ()\n          _                     -> throwGhcException $ CmdLineError $\n                                        \"Can't parse environment file entry: \"\n                                     ++ envfile ++ \": \" ++ str\n\n    -- Various ways to define which environment to use\n\n    getCmdLineArg :: MaybeT IO String\n    getCmdLineArg = MaybeT $ return $ packageEnv dflags\n\n    getEnvVar :: MaybeT IO String\n    getEnvVar = do\n      mvar <- liftMaybeT $ try $ getEnv \"GHC_ENVIRONMENT\"\n      case mvar of\n        Right var -> return var\n        Left err  -> if isDoesNotExistError err then mzero\n                                                else liftMaybeT $ throwIO err\n\n    notIfHideAllPackages :: MaybeT IO ()\n    notIfHideAllPackages =\n      guard (not (gopt Opt_HideAllPackages dflags))\n\n    defaultEnvName :: String\n    defaultEnvName = \"default\"\n\n    -- e.g. .ghc.environment.x86_64-linux-7.6.3\n    localEnvFileName :: FilePath\n    localEnvFileName = \".ghc.environment\" <.> versionedFilePath dflags\n\n    -- Search for an env file, starting in the current dir and looking upwards.\n    -- Fail if we get to the users home dir or the filesystem root. That is,\n    -- we don't look for an env file in the user's home dir. The user-wide\n    -- env lives in ghc's versionedAppDir/environments/default\n    findLocalEnvFile :: MaybeT IO FilePath\n    findLocalEnvFile = do\n        curdir  <- liftMaybeT getCurrentDirectory\n        homedir <- tryMaybeT getHomeDirectory\n        let probe dir | isDrive dir || dir == homedir\n                      = mzero\n            probe dir = do\n              let file = dir </> localEnvFileName\n              exists <- liftMaybeT (doesFileExist file)\n              if exists\n                then return file\n                else probe (takeDirectory dir)\n        probe curdir\n\n    -- Error reporting\n\n    cmdLineError :: String -> MaybeT IO a\n    cmdLineError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $\n      \"Package environment \" ++ show env ++ \" not found\"\n\n    envError :: String -> MaybeT IO a\n    envError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $\n         \"Package environment \"\n      ++ show env\n      ++ \" (specified in GHC_ENVIRONMENT) not found\"\n\n\n-- If we're linking a binary, then only targets that produce object\n-- code are allowed (requests for other target types are ignored).\nsetTarget :: HscTarget -> DynP ()\nsetTarget l = setTargetWithPlatform (const l)\n\nsetTargetWithPlatform :: (Platform -> HscTarget) -> DynP ()\nsetTargetWithPlatform f = upd set\n  where\n   set dfs = let l = f (targetPlatform dfs)\n             in if ghcLink dfs /= LinkBinary || isObjectTarget l\n                then dfs{ hscTarget = l }\n                else dfs\n\n-- Changes the target only if we're compiling object code.  This is\n-- used by -fasm and -fllvm, which switch from one to the other, but\n-- not from bytecode to object-code.  The idea is that -fasm/-fllvm\n-- can be safely used in an OPTIONS_GHC pragma.\nsetObjTarget :: HscTarget -> DynP ()\nsetObjTarget l = updM set\n  where\n   set dflags\n     | isObjectTarget (hscTarget dflags)\n       = return $ dflags { hscTarget = l }\n     | otherwise = return dflags\n\nsetOptLevel :: Int -> DynFlags -> DynP DynFlags\nsetOptLevel n dflags = return (updOptLevel n dflags)\n\ncheckOptLevel :: Int -> DynFlags -> Either String DynFlags\ncheckOptLevel n dflags\n   | hscTarget dflags == HscInterpreted && n > 0\n     = Left \"-O conflicts with --interactive; -O ignored.\"\n   | otherwise\n     = Right dflags\n\nsetMainIs :: String -> DynP ()\nsetMainIs arg\n  | not (null main_fn) && isLower (head main_fn)\n     -- The arg looked like \"Foo.Bar.baz\"\n  = upd $ \\d -> d { mainFunIs = Just main_fn,\n                   mainModIs = mkModule mainUnitId (mkModuleName main_mod) }\n\n  | isUpper (head arg)  -- The arg looked like \"Foo\" or \"Foo.Bar\"\n  = upd $ \\d -> d { mainModIs = mkModule mainUnitId (mkModuleName arg) }\n\n  | otherwise                   -- The arg looked like \"baz\"\n  = upd $ \\d -> d { mainFunIs = Just arg }\n  where\n    (main_mod, main_fn) = splitLongestPrefix arg (== '.')\n\naddLdInputs :: Option -> DynFlags -> DynFlags\naddLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]}\n\n-----------------------------------------------------------------------------\n-- Paths & Libraries\n\naddImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()\n\n-- -i on its own deletes the import paths\naddImportPath \"\" = upd (\\s -> s{importPaths = []})\naddImportPath p  = upd (\\s -> s{importPaths = importPaths s ++ splitPathList p})\n\naddLibraryPath p =\n  upd (\\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})\n\naddIncludePath p =\n  upd (\\s -> s{includePaths =\n                  addGlobalInclude (includePaths s) (splitPathList p)})\n\naddFrameworkPath p =\n  upd (\\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})\n\n#if !defined(mingw32_TARGET_OS)\nsplit_marker :: Char\nsplit_marker = ':'   -- not configurable (ToDo)\n#endif\n\nsplitPathList :: String -> [String]\nsplitPathList s = filter notNull (splitUp s)\n                -- empty paths are ignored: there might be a trailing\n                -- ':' in the initial list, for example.  Empty paths can\n                -- cause confusion when they are translated into -I options\n                -- for passing to gcc.\n  where\n#if !defined(mingw32_TARGET_OS)\n    splitUp xs = split split_marker xs\n#else\n     -- Windows: 'hybrid' support for DOS-style paths in directory lists.\n     --\n     -- That is, if \"foo:bar:baz\" is used, this interpreted as\n     -- consisting of three entries, 'foo', 'bar', 'baz'.\n     -- However, with \"c:/foo:c:\\\\foo;x:/bar\", this is interpreted\n     -- as 3 elts, \"c:/foo\", \"c:\\\\foo\", \"x:/bar\"\n     --\n     -- Notice that no attempt is made to fully replace the 'standard'\n     -- split marker ':' with the Windows / DOS one, ';'. The reason being\n     -- that this will cause too much breakage for users & ':' will\n     -- work fine even with DOS paths, if you're not insisting on being silly.\n     -- So, use either.\n    splitUp []             = []\n    splitUp (x:':':div:xs) | div `elem` dir_markers\n                           = ((x:':':div:p): splitUp rs)\n                           where\n                              (p,rs) = findNextPath xs\n          -- we used to check for existence of the path here, but that\n          -- required the IO monad to be threaded through the command-line\n          -- parser which is quite inconvenient.  The\n    splitUp xs = cons p (splitUp rs)\n               where\n                 (p,rs) = findNextPath xs\n\n                 cons \"\" xs = xs\n                 cons x  xs = x:xs\n\n    -- will be called either when we've consumed nought or the\n    -- \"<Drive>:/\" part of a DOS path, so splitting is just a Q of\n    -- finding the next split marker.\n    findNextPath xs =\n        case break (`elem` split_markers) xs of\n           (p, _:ds) -> (p, ds)\n           (p, xs)   -> (p, xs)\n\n    split_markers :: [Char]\n    split_markers = [':', ';']\n\n    dir_markers :: [Char]\n    dir_markers = ['/', '\\\\']\n#endif\n\n-- -----------------------------------------------------------------------------\n-- tmpDir, where we store temporary files.\n\nsetTmpDir :: FilePath -> DynFlags -> DynFlags\nsetTmpDir dir = alterSettings (\\s -> s { sTmpDir = normalise dir })\n  -- we used to fix /cygdrive/c/.. on Windows, but this doesn't\n  -- seem necessary now --SDM 7/2/2008\n\n-----------------------------------------------------------------------------\n-- RTS opts\n\nsetRtsOpts :: String -> DynP ()\nsetRtsOpts arg  = upd $ \\ d -> d {rtsOpts = Just arg}\n\nsetRtsOptsEnabled :: RtsOptsEnabled -> DynP ()\nsetRtsOptsEnabled arg  = upd $ \\ d -> d {rtsOptsEnabled = arg}\n\n-----------------------------------------------------------------------------\n-- Hpc stuff\n\nsetOptHpcDir :: String -> DynP ()\nsetOptHpcDir arg  = upd $ \\ d -> d {hpcDir = arg}\n\n-----------------------------------------------------------------------------\n-- Via-C compilation stuff\n\n-- There are some options that we need to pass to gcc when compiling\n-- Haskell code via C, but are only supported by recent versions of\n-- gcc.  The configure script decides which of these options we need,\n-- and puts them in the \"settings\" file in $topdir. The advantage of\n-- having these in a separate file is that the file can be created at\n-- install-time depending on the available gcc version, and even\n-- re-generated later if gcc is upgraded.\n--\n-- The options below are not dependent on the version of gcc, only the\n-- platform.\n\npicCCOpts :: DynFlags -> [String]\npicCCOpts dflags = pieOpts ++ picOpts\n  where\n    picOpts =\n      case platformOS (targetPlatform dflags) of\n      OSDarwin\n          -- Apple prefers to do things the other way round.\n          -- PIC is on by default.\n          -- -mdynamic-no-pic:\n          --     Turn off PIC code generation.\n          -- -fno-common:\n          --     Don't generate \"common\" symbols - these are unwanted\n          --     in dynamic libraries.\n\n       | gopt Opt_PIC dflags -> [\"-fno-common\", \"-U__PIC__\", \"-D__PIC__\"]\n       | otherwise           -> [\"-mdynamic-no-pic\"]\n      OSMinGW32 -- no -fPIC for Windows\n       | gopt Opt_PIC dflags -> [\"-U__PIC__\", \"-D__PIC__\"]\n       | otherwise           -> []\n      _\n      -- we need -fPIC for C files when we are compiling with -dynamic,\n      -- otherwise things like stub.c files don't get compiled\n      -- correctly.  They need to reference data in the Haskell\n      -- objects, but can't without -fPIC.  See\n      -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode\n       | gopt Opt_PIC dflags || WayDyn `elem` ways dflags ->\n          [\"-fPIC\", \"-U__PIC__\", \"-D__PIC__\"]\n      -- gcc may be configured to have PIC on by default, let's be\n      -- explicit here, see Trac #15847\n       | otherwise -> [\"-fno-PIC\"]\n\n    pieOpts\n      | gopt Opt_PICExecutable dflags       = [\"-pie\"]\n        -- See Note [No PIE when linking]\n      | sGccSupportsNoPie (settings dflags) = [\"-no-pie\"]\n      | otherwise                           = []\n\n\n{-\nNote [No PIE while linking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by\ndefault in their gcc builds. This is incompatible with -r as it implies that we\nare producing an executable. Consequently, we must manually pass -no-pie to gcc\nwhen joining object files or linking dynamic libraries. Unless, of course, the\nuser has explicitly requested a PIE executable with -pie. See #12759.\n-}\n\npicPOpts :: DynFlags -> [String]\npicPOpts dflags\n | gopt Opt_PIC dflags = [\"-U__PIC__\", \"-D__PIC__\"]\n | otherwise           = []\n\n-- -----------------------------------------------------------------------------\n-- Compiler Info\n\ncompilerInfo :: DynFlags -> [(String, String)]\ncompilerInfo dflags\n    = -- We always make \"Project name\" be first to keep parsing in\n      -- other languages simple, i.e. when looking for other fields,\n      -- you don't have to worry whether there is a leading '[' or not\n      (\"Project name\",                 cProjectName)\n      -- Next come the settings, so anything else can be overridden\n      -- in the settings file (as \"lookup\" uses the first match for the\n      -- key)\n    : map (fmap $ expandDirectories (topDir dflags) (toolDir dflags))\n          (rawSettings dflags)\n   ++ [(\"Project version\",             projectVersion dflags),\n       (\"Project Git commit id\",       cProjectGitCommitId),\n       (\"Booter version\",              cBooterVersion),\n       (\"Stage\",                       cStage),\n       (\"Build platform\",              cBuildPlatformString),\n       (\"Host platform\",               cHostPlatformString),\n       (\"Target platform\",             cTargetPlatformString),\n       (\"Have interpreter\",            cGhcWithInterpreter),\n       (\"Object splitting supported\",  showBool False),\n       (\"Have native code generator\",  cGhcWithNativeCodeGen),\n       (\"Support SMP\",                 cGhcWithSMP),\n       (\"Tables next to code\",         cGhcEnableTablesNextToCode),\n       (\"RTS ways\",                    cGhcRTSWays),\n       (\"RTS expects libdw\",           showBool cGhcRtsWithLibdw),\n       -- Whether or not we support @-dynamic-too@\n       (\"Support dynamic-too\",         showBool $ not isWindows),\n       -- Whether or not we support the @-j@ flag with @--make@.\n       (\"Support parallel --make\",     \"YES\"),\n       -- Whether or not we support \"Foo from foo-0.1-XXX:Foo\" syntax in\n       -- installed package info.\n       (\"Support reexported-modules\",  \"YES\"),\n       -- Whether or not we support extended @-package foo (Foo)@ syntax.\n       (\"Support thinning and renaming package flags\", \"YES\"),\n       -- Whether or not we support Backpack.\n       (\"Support Backpack\", \"YES\"),\n       -- If true, we require that the 'id' field in installed package info\n       -- match what is passed to the @-this-unit-id@ flag for modules\n       -- built in it\n       (\"Requires unified installed package IDs\", \"YES\"),\n       -- Whether or not we support the @-this-package-key@ flag.  Prefer\n       -- \"Uses unit IDs\" over it.\n       (\"Uses package keys\",           \"YES\"),\n       -- Whether or not we support the @-this-unit-id@ flag\n       (\"Uses unit IDs\",               \"YES\"),\n       -- Whether or not GHC compiles libraries as dynamic by default\n       (\"Dynamic by default\",          showBool $ dYNAMIC_BY_DEFAULT dflags),\n       -- Whether or not GHC was compiled using -dynamic\n       (\"GHC Dynamic\",                 showBool dynamicGhc),\n       -- Whether or not GHC was compiled using -prof\n       (\"GHC Profiled\",                showBool rtsIsProfiled),\n       (\"Leading underscore\",          cLeadingUnderscore),\n       (\"Debug on\",                    show debugIsOn),\n       (\"LibDir\",                      topDir dflags),\n       -- The path of the global package database used by GHC\n       (\"Global Package DB\",           systemPackageConfig dflags)\n      ]\n  where\n    showBool True  = \"YES\"\n    showBool False = \"NO\"\n    isWindows = platformOS (targetPlatform dflags) == OSMinGW32\n    expandDirectories :: FilePath -> Maybe FilePath -> String -> String\n    expandDirectories topd mtoold = expandToolDir mtoold . expandTopDir topd\n\n-- Produced by deriveConstants\n#include \"GHCConstantsHaskellWrappers.hs\"\n\nbLOCK_SIZE_W :: DynFlags -> Int\nbLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE dflags\n\nwORD_SIZE_IN_BITS :: DynFlags -> Int\nwORD_SIZE_IN_BITS dflags = wORD_SIZE dflags * 8\n\ntAG_MASK :: DynFlags -> Int\ntAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1\n\nmAX_PTR_TAG :: DynFlags -> Int\nmAX_PTR_TAG = tAG_MASK\n\n-- Might be worth caching these in targetPlatform?\ntARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: DynFlags -> Integer\ntARGET_MIN_INT dflags\n    = case platformWordSize (targetPlatform dflags) of\n      4 -> toInteger (minBound :: Int32)\n      8 -> toInteger (minBound :: Int64)\n      w -> panic (\"tARGET_MIN_INT: Unknown platformWordSize: \" ++ show w)\ntARGET_MAX_INT dflags\n    = case platformWordSize (targetPlatform dflags) of\n      4 -> toInteger (maxBound :: Int32)\n      8 -> toInteger (maxBound :: Int64)\n      w -> panic (\"tARGET_MAX_INT: Unknown platformWordSize: \" ++ show w)\ntARGET_MAX_WORD dflags\n    = case platformWordSize (targetPlatform dflags) of\n      4 -> toInteger (maxBound :: Word32)\n      8 -> toInteger (maxBound :: Word64)\n      w -> panic (\"tARGET_MAX_WORD: Unknown platformWordSize: \" ++ show w)\n\n\n{- -----------------------------------------------------------------------------\nNote [DynFlags consistency]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThere are a number of number of DynFlags configurations which either\ndo not make sense or lead to unimplemented or buggy codepaths in the\ncompiler. makeDynFlagsConsistent is responsible for verifying the validity\nof a set of DynFlags, fixing any issues, and reporting them back to the\ncaller.\n\nGHCi and -O\n---------------\n\nWhen using optimization, the compiler can introduce several things\n(such as unboxed tuples) into the intermediate code, which GHCi later\nchokes on since the bytecode interpreter can't handle this (and while\nthis is arguably a bug these aren't handled, there are no plans to fix\nit.)\n\nWhile the driver pipeline always checks for this particular erroneous\ncombination when parsing flags, we also need to check when we update\nthe flags; this is because API clients may parse flags but update the\nDynFlags afterwords, before finally running code inside a session (see\nT10052 and #10052).\n-}\n\n-- | Resolve any internal inconsistencies in a set of 'DynFlags'.\n-- Returns the consistent 'DynFlags' as well as a list of warnings\n-- to report to the user.\nmakeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])\n-- Whenever makeDynFlagsConsistent does anything, it starts over, to\n-- ensure that a later change doesn't invalidate an earlier check.\n-- Be careful not to introduce potential loops!\nmakeDynFlagsConsistent dflags\n -- Disable -dynamic-too on Windows (#8228, #7134, #5987)\n | os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags\n    = let dflags' = gopt_unset dflags Opt_BuildDynamicToo\n          warn    = \"-dynamic-too is not supported on Windows\"\n      in loop dflags' warn\n | hscTarget dflags == HscC &&\n   not (platformUnregisterised (targetPlatform dflags))\n    = if cGhcWithNativeCodeGen == \"YES\"\n      then let dflags' = dflags { hscTarget = HscAsm }\n               warn = \"Compiler not unregisterised, so using native code generator rather than compiling via C\"\n           in loop dflags' warn\n      else let dflags' = dflags { hscTarget = HscLlvm }\n               warn = \"Compiler not unregisterised, so using LLVM rather than compiling via C\"\n           in loop dflags' warn\n | gopt Opt_Hpc dflags && hscTarget dflags == HscInterpreted\n    = let dflags' = gopt_unset dflags Opt_Hpc\n          warn = \"Hpc can't be used with byte-code interpreter. Ignoring -fhpc.\"\n      in loop dflags' warn\n | hscTarget dflags `elem` [HscAsm, HscLlvm] &&\n   platformUnregisterised (targetPlatform dflags)\n    = loop (dflags { hscTarget = HscC })\n           \"Compiler unregisterised, so compiling via C\"\n | hscTarget dflags == HscAsm &&\n   cGhcWithNativeCodeGen /= \"YES\"\n      = let dflags' = dflags { hscTarget = HscLlvm }\n            warn = \"No native code generator, so using LLVM\"\n        in loop dflags' warn\n | not (osElfTarget os) && gopt Opt_PIE dflags\n    = loop (gopt_unset dflags Opt_PIE)\n           \"Position-independent only supported on ELF platforms\"\n | os == OSDarwin &&\n   arch == ArchX86_64 &&\n   not (gopt Opt_PIC dflags)\n    = loop (gopt_set dflags Opt_PIC)\n           \"Enabling -fPIC as it is always on for this platform\"\n | Left err <- checkOptLevel (optLevel dflags) dflags\n    = loop (updOptLevel 0 dflags) err\n\n | LinkInMemory <- ghcLink dflags\n , not (gopt Opt_ExternalInterpreter dflags)\n , rtsIsProfiled\n , isObjectTarget (hscTarget dflags)\n , WayProf `notElem` ways dflags\n    = loop dflags{ways = WayProf : ways dflags}\n         \"Enabling -prof, because -fobject-code is enabled and GHCi is profiled\"\n\n | otherwise = (dflags, [])\n    where loc = mkGeneralSrcSpan (fsLit \"when making flags consistent\")\n          loop updated_dflags warning\n              = case makeDynFlagsConsistent updated_dflags of\n                (dflags', ws) -> (dflags', L loc warning : ws)\n          platform = targetPlatform dflags\n          arch = platformArch platform\n          os   = platformOS   platform\n\n\n--------------------------------------------------------------------------\n-- Do not use unsafeGlobalDynFlags!\n--\n-- unsafeGlobalDynFlags is a hack, necessary because we need to be able\n-- to show SDocs when tracing, but we don't always have DynFlags\n-- available.\n--\n-- Do not use it if you can help it. You may get the wrong value, or this\n-- panic!\n\n-- | This is the value that 'unsafeGlobalDynFlags' takes before it is\n-- initialized.\ndefaultGlobalDynFlags :: DynFlags\ndefaultGlobalDynFlags =\n    (defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 }\n  where\n    settings = panic \"v_unsafeGlobalDynFlags: settings not initialised\"\n    llvmTargets = panic \"v_unsafeGlobalDynFlags: llvmTargets not initialised\"\n    llvmPasses = panic \"v_unsafeGlobalDynFlags: llvmPasses not initialised\"\n\n#if STAGE < 2\nGLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)\n#else\nSHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags\n                 , getOrSetLibHSghcGlobalDynFlags\n                 , \"getOrSetLibHSghcGlobalDynFlags\"\n                 , defaultGlobalDynFlags\n                 , DynFlags )\n#endif\n\nunsafeGlobalDynFlags :: DynFlags\nunsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags\n\nsetUnsafeGlobalDynFlags :: DynFlags -> IO ()\nsetUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags\n\n-- -----------------------------------------------------------------------------\n-- SSE and AVX\n\n-- TODO: Instead of using a separate predicate (i.e. isSse2Enabled) to\n-- check if SSE is enabled, we might have x86-64 imply the -msse2\n-- flag.\n\ndata SseVersion = SSE1\n                | SSE2\n                | SSE3\n                | SSE4\n                | SSE42\n                deriving (Eq, Ord)\n\nisSseEnabled :: DynFlags -> Bool\nisSseEnabled dflags = case platformArch (targetPlatform dflags) of\n    ArchX86_64 -> True\n    ArchX86    -> sseVersion dflags >= Just SSE1\n    _          -> False\n\nisSse2Enabled :: DynFlags -> Bool\nisSse2Enabled dflags = case platformArch (targetPlatform dflags) of\n    ArchX86_64 -> -- SSE2 is fixed on for x86_64.  It would be\n                  -- possible to make it optional, but we'd need to\n                  -- fix at least the foreign call code where the\n                  -- calling convention specifies the use of xmm regs,\n                  -- and possibly other places.\n                  True\n    ArchX86    -> sseVersion dflags >= Just SSE2\n    _          -> False\n\nisSse4_2Enabled :: DynFlags -> Bool\nisSse4_2Enabled dflags = sseVersion dflags >= Just SSE42\n\nisAvxEnabled :: DynFlags -> Bool\nisAvxEnabled dflags = avx dflags || avx2 dflags || avx512f dflags\n\nisAvx2Enabled :: DynFlags -> Bool\nisAvx2Enabled dflags = avx2 dflags || avx512f dflags\n\nisAvx512cdEnabled :: DynFlags -> Bool\nisAvx512cdEnabled dflags = avx512cd dflags\n\nisAvx512erEnabled :: DynFlags -> Bool\nisAvx512erEnabled dflags = avx512er dflags\n\nisAvx512fEnabled :: DynFlags -> Bool\nisAvx512fEnabled dflags = avx512f dflags\n\nisAvx512pfEnabled :: DynFlags -> Bool\nisAvx512pfEnabled dflags = avx512pf dflags\n\n-- -----------------------------------------------------------------------------\n-- BMI2\n\ndata BmiVersion = BMI1\n                | BMI2\n                deriving (Eq, Ord)\n\nisBmiEnabled :: DynFlags -> Bool\nisBmiEnabled dflags = case platformArch (targetPlatform dflags) of\n    ArchX86_64 -> bmiVersion dflags >= Just BMI1\n    ArchX86    -> bmiVersion dflags >= Just BMI1\n    _          -> False\n\nisBmi2Enabled :: DynFlags -> Bool\nisBmi2Enabled dflags = case platformArch (targetPlatform dflags) of\n    ArchX86_64 -> bmiVersion dflags >= Just BMI2\n    ArchX86    -> bmiVersion dflags >= Just BMI2\n    _          -> False\n\n-- -----------------------------------------------------------------------------\n-- Linker/compiler information\n\n-- LinkerInfo contains any extra options needed by the system linker.\ndata LinkerInfo\n  = GnuLD    [Option]\n  | GnuGold  [Option]\n  | LlvmLLD  [Option]\n  | DarwinLD [Option]\n  | SolarisLD [Option]\n  | AixLD    [Option]\n  | UnknownLD\n  deriving Eq\n\n-- CompilerInfo tells us which C compiler we're using\ndata CompilerInfo\n   = GCC\n   | Clang\n   | AppleClang\n   | AppleClang51\n   | UnknownCC\n   deriving Eq\n\n-- -----------------------------------------------------------------------------\n-- RTS hooks\n\n-- Convert sizes like \"3.5M\" into integers\ndecodeSize :: String -> Integer\ndecodeSize str\n  | c == \"\"      = truncate n\n  | c == \"K\" || c == \"k\" = truncate (n * 1000)\n  | c == \"M\" || c == \"m\" = truncate (n * 1000 * 1000)\n  | c == \"G\" || c == \"g\" = truncate (n * 1000 * 1000 * 1000)\n  | otherwise            = throwGhcException (CmdLineError (\"can't decode size: \" ++ str))\n  where (m, c) = span pred str\n        n      = readRational m\n        pred c = isDigit c || c == '.'\n\nforeign import ccall unsafe \"setHeapSize\"       setHeapSize       :: Int -> IO ()\nforeign import ccall unsafe \"enableTimingStats\" enableTimingStats :: IO ()\n\n-- -----------------------------------------------------------------------------\n-- Types for managing temporary files.\n--\n-- these are here because FilesToClean is used in DynFlags\n\n-- | A collection of files that must be deleted before ghc exits.\n-- The current collection\n-- is stored in an IORef in DynFlags, 'filesToClean'.\ndata FilesToClean = FilesToClean {\n  ftcGhcSession :: !(Set FilePath),\n  -- ^ Files that will be deleted at the end of runGhc(T)\n  ftcCurrentModule :: !(Set FilePath)\n  -- ^ Files that will be deleted the next time\n  -- 'FileCleanup.cleanCurrentModuleTempFiles' is called, or otherwise at the\n  -- end of the session.\n  }\n\n-- | An empty FilesToClean\nemptyFilesToClean :: FilesToClean\nemptyFilesToClean = FilesToClean Set.empty Set.empty\n", "num_lines": 5940}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n-----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2015\n--\n-- ELF format tools\n--\n-----------------------------------------------------------------------------\n-}\n\nmodule Elf (\n    readElfSectionByName,\n    readElfNoteAsString,\n    makeElfNote\n  ) where\n\nimport GhcPrelude\n\nimport AsmUtils\nimport Exception\nimport DynFlags\nimport ErrUtils\nimport Maybes     (MaybeT(..),runMaybeT)\nimport Util       (charToC)\nimport Outputable (text,hcat,SDoc)\n\nimport Control.Monad (when)\nimport Data.Binary.Get\nimport Data.Word\nimport Data.Char (ord)\nimport Data.ByteString.Lazy (ByteString)\nimport qualified Data.ByteString.Lazy as LBS\nimport qualified Data.ByteString.Lazy.Char8 as B8\n\n{- Note [ELF specification]\n   ~~~~~~~~~~~~~~~~~~~~~~~~\n\n   ELF (Executable and Linking Format) is described in the System V Application\n   Binary Interface (or ABI). The latter is composed of two parts: a generic\n   part and a processor specific part. The generic ABI describes the parts of\n   the interface that remain constant across all hardware implementations of\n   System V.\n\n   The latest release of the specification of the generic ABI is the version\n   4.1 from March 18, 1997:\n\n     - http://www.sco.com/developers/devspecs/gabi41.pdf\n\n   Since 1997, snapshots of the draft for the \"next\" version are published:\n\n     - http://www.sco.com/developers/gabi/\n\n   Quoting the notice on the website: \"There is more than one instance of these\n   chapters to permit references to older instances to remain valid. All\n   modifications to these chapters are forward-compatible, so that correct use\n   of an older specification will not be invalidated by a newer instance.\n   Approximately on a yearly basis, a new instance will be saved, as it reaches\n   what appears to be a stable state.\"\n\n   Nevertheless we will see that since 1998 it is not true for Note sections.\n\n   Many ELF sections\n   -----------------\n\n   ELF-4.1: the normal section number fields in ELF are limited to 16 bits,\n   which runs out of bits when you try to cram in more sections than that. Two\n   fields are concerned: the one containing the number of the sections and the\n   one containing the index of the section that contains section's names. (The\n   same thing applies to the field containing the number of segments, but we\n   don't care about it here).\n\n   ELF-next: to solve this, theses fields in the ELF header have an escape\n   value (different for each case), and the actual section number is stashed\n   into unused fields in the first section header.\n\n   We support this extension as it is forward-compatible with ELF-4.1.\n   Moreover, GHC may generate objects with a lot of sections with the\n   \"function-sections\" feature (one section per function).\n\n   Note sections\n   -------------\n\n   Sections with type \"note\" (SHT_NOTE in the specification) are used to add\n   arbitrary data into an ELF file. An entry in a note section is composed of a\n   name, a type and a value.\n\n   ELF-4.1: \"The note information in sections and program header elements holds\n   any number of entries, each of which is an array of 4-byte words in the\n   format of the target processor.\" Each entry has the following format:\n         | namesz |   Word32: size of the name string (including the ending \\0)\n         | descsz |   Word32: size of the value\n         |  type  |   Word32: type of the note\n         |  name  |   Name string (with \\0 padding to ensure 4-byte alignment)\n         |  ...   |\n         |  desc  |   Value (with \\0 padding to ensure 4-byte alignment)\n         |  ...   |\n\n   ELF-next: \"The note information in sections and program header elements\n   holds a variable amount of entries. In 64-bit objects (files with\n   e_ident[EI_CLASS] equal to ELFCLASS64), each entry is an array of 8-byte\n   words in the format of the target processor. In 32-bit objects (files with\n   e_ident[EI_CLASS] equal to ELFCLASS32), each entry is an array of 4-byte\n   words in the format of the target processor.\" (from 1998-2015 snapshots)\n\n   This is not forward-compatible with ELF-4.1. In practice, for almost all\n   platforms namesz, descz and type fields are 4-byte words for both 32-bit and\n   64-bit objects (see elf.h and readelf source code).\n\n   The only exception in readelf source code is for IA_64 machines with OpenVMS\n   OS: \"This OS has so many departures from the ELF standard that we test it at\n   many places\" (comment for is_ia64_vms() in readelf.c). In this case, namesz,\n   descsz and type fields are 8-byte words and name and value fields are padded\n   to ensure 8-byte alignment.\n\n   We don't support this platform in the following code. Reading a note section\n   could be done easily (by testing Machine and OS fields in the ELF header).\n   Writing a note section, however, requires that we generate a different\n   assembly code for GAS depending on the target platform and this is a little\n   bit more involved.\n\n-}\n\n\n-- | ELF header\n--\n-- The ELF header indicates the native word size (32-bit or 64-bit) and the\n-- endianness of the target machine. We directly store getters for words of\n-- different sizes as it is more convenient to use. We also store the word size\n-- as it is useful to skip some uninteresting fields.\n--\n-- Other information such as the target machine and OS are left out as we don't\n-- use them yet. We could add them in the future if we ever need them.\ndata ElfHeader = ElfHeader\n   { gw16     :: Get Word16   -- ^ Get a Word16 with the correct endianness\n   , gw32     :: Get Word32   -- ^ Get a Word32 with the correct endianness\n   , gwN      :: Get Word64   -- ^ Get a Word with the correct word size\n                              --   and endianness\n   , wordSize :: Int          -- ^ Word size in bytes\n   }\n\n\n-- | Read the ELF header\nreadElfHeader :: DynFlags -> ByteString -> IO (Maybe ElfHeader)\nreadElfHeader dflags bs = runGetOrThrow getHeader bs `catchIO` \\_ -> do\n    debugTraceMsg dflags 3 $\n      text (\"Unable to read ELF header\")\n    return Nothing\n  where\n    getHeader = do\n      magic    <- getWord32be\n      ws       <- getWord8\n      endian   <- getWord8\n      version  <- getWord8\n      skip 9  -- skip OSABI, ABI version and padding\n      when (magic /= 0x7F454C46 || version /= 1) $ fail \"Invalid ELF header\"\n\n      case (ws, endian) of\n          -- ELF 32, little endian\n          (1,1) -> return . Just $ ElfHeader\n                           getWord16le\n                           getWord32le\n                           (fmap fromIntegral getWord32le) 4\n          -- ELF 32, big endian\n          (1,2) -> return . Just $ ElfHeader\n                           getWord16be\n                           getWord32be\n                           (fmap fromIntegral getWord32be) 4\n          -- ELF 64, little endian\n          (2,1) -> return . Just $ ElfHeader\n                           getWord16le\n                           getWord32le\n                           (fmap fromIntegral getWord64le) 8\n          -- ELF 64, big endian\n          (2,2) -> return . Just $ ElfHeader\n                           getWord16be\n                           getWord32be\n                           (fmap fromIntegral getWord64be) 8\n          _     -> fail \"Invalid ELF header\"\n\n\n------------------\n-- SECTIONS\n------------------\n\n\n-- | Description of the section table\ndata SectionTable = SectionTable\n  { sectionTableOffset :: Word64  -- ^ offset of the table describing sections\n  , sectionEntrySize   :: Word16  -- ^ size of an entry in the section table\n  , sectionEntryCount  :: Word64  -- ^ number of sections\n  , sectionNameIndex   :: Word32  -- ^ index of a special section which\n                                  --   contains section's names\n  }\n\n-- | Read the ELF section table\nreadElfSectionTable :: DynFlags\n                    -> ElfHeader\n                    -> ByteString\n                    -> IO (Maybe SectionTable)\n\nreadElfSectionTable dflags hdr bs = action `catchIO` \\_ -> do\n    debugTraceMsg dflags 3 $\n      text (\"Unable to read ELF section table\")\n    return Nothing\n  where\n    getSectionTable :: Get SectionTable\n    getSectionTable = do\n      skip (24 + 2*wordSize hdr) -- skip header and some other fields\n      secTableOffset <- gwN hdr\n      skip 10\n      entrySize      <- gw16 hdr\n      entryCount     <- gw16 hdr\n      secNameIndex   <- gw16 hdr\n      return (SectionTable secTableOffset entrySize\n                           (fromIntegral entryCount)\n                           (fromIntegral secNameIndex))\n\n    action = do\n      secTable <- runGetOrThrow getSectionTable bs\n      -- In some cases, the number of entries and the index of the section\n      -- containing section's names must be found in unused fields of the first\n      -- section entry (see Note [ELF specification])\n      let\n        offSize0 = fromIntegral $ sectionTableOffset secTable + 8\n                                  + 3 * fromIntegral (wordSize hdr)\n        offLink0 = fromIntegral $ offSize0 + fromIntegral (wordSize hdr)\n\n      entryCount'     <- if sectionEntryCount secTable /= 0\n                          then return (sectionEntryCount secTable)\n                          else runGetOrThrow (gwN hdr) (LBS.drop offSize0 bs)\n      entryNameIndex' <- if sectionNameIndex secTable /= 0xffff\n                          then return (sectionNameIndex secTable)\n                          else runGetOrThrow (gw32 hdr) (LBS.drop offLink0 bs)\n      return (Just $ secTable\n        { sectionEntryCount = entryCount'\n        , sectionNameIndex  = entryNameIndex'\n        })\n\n\n-- | A section\ndata Section = Section\n  { entryName :: ByteString   -- ^ Name of the section\n  , entryBS   :: ByteString   -- ^ Content of the section\n  }\n\n-- | Read a ELF section\nreadElfSectionByIndex :: DynFlags\n                      -> ElfHeader\n                      -> SectionTable\n                      -> Word64\n                      -> ByteString\n                      -> IO (Maybe Section)\n\nreadElfSectionByIndex dflags hdr secTable i bs = action `catchIO` \\_ -> do\n    debugTraceMsg dflags 3 $\n      text (\"Unable to read ELF section\")\n    return Nothing\n  where\n    -- read an entry from the section table\n    getEntry = do\n      nameIndex <- gw32 hdr\n      skip (4+2*wordSize hdr)\n      offset    <- fmap fromIntegral $ gwN hdr\n      size      <- fmap fromIntegral $ gwN hdr\n      let bs' = LBS.take size (LBS.drop offset bs)\n      return (nameIndex,bs')\n\n    -- read the entry with the given index in the section table\n    getEntryByIndex x = runGetOrThrow getEntry bs'\n      where\n        bs' = LBS.drop off bs\n        off = fromIntegral $ sectionTableOffset secTable +\n                             x * fromIntegral (sectionEntrySize secTable)\n\n    -- Get the name of a section\n    getEntryName nameIndex = do\n      let idx = fromIntegral (sectionNameIndex secTable)\n      (_,nameTable) <- getEntryByIndex idx\n      let bs' = LBS.drop nameIndex nameTable\n      runGetOrThrow getLazyByteStringNul bs'\n\n    action = do\n      (nameIndex,bs') <- getEntryByIndex (fromIntegral i)\n      name            <- getEntryName (fromIntegral nameIndex)\n      return (Just $ Section name bs')\n\n\n-- | Find a section from its name. Return the section contents.\n--\n-- We do not perform any check on the section type.\nfindSectionFromName :: DynFlags\n                    -> ElfHeader\n                    -> SectionTable\n                    -> String\n                    -> ByteString\n                    -> IO (Maybe ByteString)\nfindSectionFromName dflags hdr secTable name bs =\n    rec [0..sectionEntryCount secTable - 1]\n  where\n    -- convert the required section name into a ByteString to perform\n    -- ByteString comparison instead of String comparison\n    name' = B8.pack name\n\n    -- compare recursively each section name and return the contents of\n    -- the matching one, if any\n    rec []     = return Nothing\n    rec (x:xs) = do\n      me <- readElfSectionByIndex dflags hdr secTable x bs\n      case me of\n        Just e | entryName e == name' -> return (Just (entryBS e))\n        _                             -> rec xs\n\n\n-- | Given a section name, read its contents as a ByteString.\n--\n-- If the section isn't found or if there is any parsing error, we return\n-- Nothing\nreadElfSectionByName :: DynFlags\n                     -> ByteString\n                     -> String\n                     -> IO (Maybe LBS.ByteString)\n\nreadElfSectionByName dflags bs name = action `catchIO` \\_ -> do\n    debugTraceMsg dflags 3 $\n      text (\"Unable to read ELF section \\\"\" ++ name ++ \"\\\"\")\n    return Nothing\n  where\n    action = runMaybeT $ do\n      hdr      <- MaybeT $ readElfHeader dflags bs\n      secTable <- MaybeT $ readElfSectionTable dflags hdr bs\n      MaybeT $ findSectionFromName dflags hdr secTable name bs\n\n------------------\n-- NOTE SECTIONS\n------------------\n\n-- | read a Note as a ByteString\n--\n-- If you try to read a note from a section which does not support the Note\n-- format, the parsing is likely to fail and Nothing will be returned\nreadElfNoteBS :: DynFlags\n              -> ByteString\n              -> String\n              -> String\n              -> IO (Maybe LBS.ByteString)\n\nreadElfNoteBS dflags bs sectionName noteId = action `catchIO`  \\_ -> do\n    debugTraceMsg dflags 3 $\n         text (\"Unable to read ELF note \\\"\" ++ noteId ++\n               \"\\\" in section \\\"\" ++ sectionName ++ \"\\\"\")\n    return Nothing\n  where\n    -- align the getter on n bytes\n    align n = do\n      m <- bytesRead\n      if m `mod` n == 0\n        then return ()\n        else skip 1 >> align n\n\n    -- noteId as a bytestring\n    noteId' = B8.pack noteId\n\n    -- read notes recursively until the one with a valid identifier is found\n    findNote hdr = do\n      align 4\n      namesz <- gw32 hdr\n      descsz <- gw32 hdr\n      _      <- gw32 hdr -- we don't use the note type\n      name   <- if namesz == 0\n                  then return LBS.empty\n                  else getLazyByteStringNul\n      align 4\n      desc  <- if descsz == 0\n                  then return LBS.empty\n                  else getLazyByteString (fromIntegral descsz)\n      if name == noteId'\n        then return $ Just desc\n        else findNote hdr\n\n\n    action = runMaybeT $ do\n      hdr  <- MaybeT $ readElfHeader dflags bs\n      sec  <- MaybeT $ readElfSectionByName dflags bs sectionName\n      MaybeT $ runGetOrThrow (findNote hdr) sec\n\n-- | read a Note as a String\n--\n-- If you try to read a note from a section which does not support the Note\n-- format, the parsing is likely to fail and Nothing will be returned\nreadElfNoteAsString :: DynFlags\n                    -> FilePath\n                    -> String\n                    -> String\n                    -> IO (Maybe String)\n\nreadElfNoteAsString dflags path sectionName noteId = action `catchIO`  \\_ -> do\n    debugTraceMsg dflags 3 $\n         text (\"Unable to read ELF note \\\"\" ++ noteId ++\n               \"\\\" in section \\\"\" ++ sectionName ++ \"\\\"\")\n    return Nothing\n  where\n    action = do\n      bs   <- LBS.readFile path\n      note <- readElfNoteBS dflags bs sectionName noteId\n      return (fmap B8.unpack note)\n\n\n-- | Generate the GAS code to create a Note section\n--\n-- Header fields for notes are 32-bit long (see Note [ELF specification]).\n--\n-- It seems there is no easy way to force GNU AS to generate a 32-bit word in\n-- every case. Hence we use .int directive to create them: however \"The byte\n-- order and bit size of the number depends on what kind of target the assembly\n-- is for.\" (https://sourceware.org/binutils/docs/as/Int.html#Int)\n--\n-- If we add new target platforms, we need to check that the generated words\n-- are 32-bit long, otherwise we need to use platform specific directives to\n-- force 32-bit .int in asWord32.\nmakeElfNote :: String -> String -> Word32 -> String -> SDoc\nmakeElfNote sectionName noteName typ contents = hcat [\n    text \"\\t.section \",\n    text sectionName,\n    text \",\\\"\\\",\",\n    sectionType \"note\",\n    text \"\\n\",\n\n    -- note name length (+ 1 for ending \\0)\n    asWord32 (length noteName + 1),\n\n    -- note contents size\n    asWord32 (length contents),\n\n    -- note type\n    asWord32 typ,\n\n    -- note name (.asciz for \\0 ending string) + padding\n    text \"\\t.asciz \\\"\",\n    text noteName,\n    text \"\\\"\\n\",\n    text \"\\t.align 4\\n\",\n\n    -- note contents (.ascii to avoid ending \\0) + padding\n    text \"\\t.ascii \\\"\",\n    text (escape contents),\n    text \"\\\"\\n\",\n    text \"\\t.align 4\\n\"]\n  where\n    escape :: String -> String\n    escape = concatMap (charToC.fromIntegral.ord)\n\n    asWord32 :: Show a => a -> SDoc\n    asWord32 x = hcat [\n      text \"\\t.int \",\n      text (show x),\n      text \"\\n\"]\n\n\n------------------\n-- Helpers\n------------------\n\n-- | runGet in IO monad that throws an IOException on failure\nrunGetOrThrow :: Get a -> LBS.ByteString -> IO a\nrunGetOrThrow g bs = case runGetOrFail g bs of\n  Left _        -> fail \"Error while reading file\"\n  Right (_,_,a) -> return a\n", "num_lines": 468}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1994-1998\n\n\\section[ErrsUtils]{Utilities for error reporting}\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE RecordWildCards #-}\n\nmodule ErrUtils (\n        -- * Basic types\n        Validity(..), andValid, allValid, isValid, getInvalids, orValid,\n        Severity(..),\n\n        -- * Messages\n        ErrMsg, errMsgDoc, errMsgSeverity, errMsgReason,\n        ErrDoc, errDoc, errDocImportant, errDocContext, errDocSupplementary,\n        WarnMsg, MsgDoc,\n        Messages, ErrorMessages, WarningMessages,\n        unionMessages,\n        errMsgSpan, errMsgContext,\n        errorsFound, isEmptyMessages,\n        isWarnMsgFatal,\n        warningsToMessages,\n\n        -- ** Formatting\n        pprMessageBag, pprErrMsgBagWithLoc,\n        pprLocErrMsg, printBagOfErrors,\n        formatErrDoc,\n\n        -- ** Construction\n        emptyMessages, mkLocMessage, mkLocMessageAnn, makeIntoWarning,\n        mkErrMsg, mkPlainErrMsg, mkErrDoc, mkLongErrMsg, mkWarnMsg,\n        mkPlainWarnMsg,\n        mkLongWarnMsg,\n\n        -- * Utilities\n        doIfSet, doIfSet_dyn,\n        getCaretDiagnostic,\n\n        -- * Dump files\n        dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_printer,\n        mkDumpDoc, dumpSDoc, dumpSDocForUser,\n        dumpSDocWithStyle,\n\n        -- * Issuing messages during compilation\n        putMsg, printInfoForUser, printOutputForUser,\n        logInfo, logOutput,\n        errorMsg, warningMsg,\n        fatalErrorMsg, fatalErrorMsg'',\n        compilationProgressMsg,\n        showPass, withTiming,\n        debugTraceMsg,\n        ghcExit,\n        prettyPrintGhcErrors,\n        traceCmd\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Bag\nimport Exception\nimport Outputable\nimport Panic\nimport qualified PprColour as Col\nimport SrcLoc\nimport DynFlags\nimport FastString (unpackFS)\nimport StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)\nimport Json\n\nimport System.Directory\nimport System.Exit      ( ExitCode(..), exitWith )\nimport System.FilePath  ( takeDirectory, (</>) )\nimport Data.List\nimport qualified Data.Set as Set\nimport Data.IORef\nimport Data.Maybe       ( fromMaybe )\nimport Data.Ord\nimport Data.Time\nimport Control.Monad\nimport Control.Monad.IO.Class\nimport System.IO\nimport System.IO.Error  ( catchIOError )\nimport GHC.Conc         ( getAllocationCounter )\nimport System.CPUTime\n\n-------------------------\ntype MsgDoc  = SDoc\n\n-------------------------\ndata Validity\n  = IsValid            -- ^ Everything is fine\n  | NotValid MsgDoc    -- ^ A problem, and some indication of why\n\nisValid :: Validity -> Bool\nisValid IsValid       = True\nisValid (NotValid {}) = False\n\nandValid :: Validity -> Validity -> Validity\nandValid IsValid v = v\nandValid v _       = v\n\n-- | If they aren't all valid, return the first\nallValid :: [Validity] -> Validity\nallValid []       = IsValid\nallValid (v : vs) = v `andValid` allValid vs\n\ngetInvalids :: [Validity] -> [MsgDoc]\ngetInvalids vs = [d | NotValid d <- vs]\n\norValid :: Validity -> Validity -> Validity\norValid IsValid _ = IsValid\norValid _       v = v\n\n-- -----------------------------------------------------------------------------\n-- Basic error messages: just render a message with a source location.\n\ntype Messages        = (WarningMessages, ErrorMessages)\ntype WarningMessages = Bag WarnMsg\ntype ErrorMessages   = Bag ErrMsg\n\nunionMessages :: Messages -> Messages -> Messages\nunionMessages (warns1, errs1) (warns2, errs2) =\n  (warns1 `unionBags` warns2, errs1 `unionBags` errs2)\n\ndata ErrMsg = ErrMsg {\n        errMsgSpan        :: SrcSpan,\n        errMsgContext     :: PrintUnqualified,\n        errMsgDoc         :: ErrDoc,\n        -- | This has the same text as errDocImportant . errMsgDoc.\n        errMsgShortString :: String,\n        errMsgSeverity    :: Severity,\n        errMsgReason      :: WarnReason\n        }\n        -- The SrcSpan is used for sorting errors into line-number order\n\n\n-- | Categorise error msgs by their importance.  This is so each section can\n-- be rendered visually distinct.  See Note [Error report] for where these come\n-- from.\ndata ErrDoc = ErrDoc {\n        -- | Primary error msg.\n        errDocImportant     :: [MsgDoc],\n        -- | Context e.g. \\\"In the second argument of ...\\\".\n        errDocContext       :: [MsgDoc],\n        -- | Supplementary information, e.g. \\\"Relevant bindings include ...\\\".\n        errDocSupplementary :: [MsgDoc]\n        }\n\nerrDoc :: [MsgDoc] -> [MsgDoc] -> [MsgDoc] -> ErrDoc\nerrDoc = ErrDoc\n\ntype WarnMsg = ErrMsg\n\ndata Severity\n  = SevOutput\n  | SevFatal\n  | SevInteractive\n\n  | SevDump\n    -- ^ Log message intended for compiler developers\n    -- No file/line/column stuff\n\n  | SevInfo\n    -- ^ Log messages intended for end users.\n    -- No file/line/column stuff.\n\n  | SevWarning\n  | SevError\n    -- ^ SevWarning and SevError are used for warnings and errors\n    --   o The message has a file/line/column heading,\n    --     plus \"warning:\" or \"error:\",\n    --     added by mkLocMessags\n    --   o Output is intended for end users\n  deriving Show\n\n\ninstance ToJson Severity where\n  json s = JSString (show s)\n\n\ninstance Show ErrMsg where\n    show em = errMsgShortString em\n\npprMessageBag :: Bag MsgDoc -> SDoc\npprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs))\n\n-- | Make an unannotated error message with location info.\nmkLocMessage :: Severity -> SrcSpan -> MsgDoc -> MsgDoc\nmkLocMessage = mkLocMessageAnn Nothing\n\n-- | Make a possibly annotated error message with location info.\nmkLocMessageAnn\n  :: Maybe String                       -- ^ optional annotation\n  -> Severity                           -- ^ severity\n  -> SrcSpan                            -- ^ location\n  -> MsgDoc                             -- ^ message\n  -> MsgDoc\n  -- Always print the location, even if it is unhelpful.  Error messages\n  -- are supposed to be in a standard format, and one without a location\n  -- would look strange.  Better to say explicitly \"<no location info>\".\nmkLocMessageAnn ann severity locn msg\n    = sdocWithDynFlags $ \\dflags ->\n      let locn' = if gopt Opt_ErrorSpans dflags\n                  then ppr locn\n                  else ppr (srcSpanStart locn)\n\n          sevColour = getSeverityColour severity (colScheme dflags)\n\n          -- Add optional information\n          optAnn = case ann of\n            Nothing -> text \"\"\n            Just i  -> text \" [\" <> coloured sevColour (text i) <> text \"]\"\n\n          -- Add prefixes, like    Foo.hs:34: warning:\n          --                           <the warning message>\n          header = locn' <> colon <+>\n                   coloured sevColour sevText <> optAnn\n\n      in coloured (Col.sMessage (colScheme dflags))\n                  (hang (coloured (Col.sHeader (colScheme dflags)) header) 4\n                        msg)\n\n  where\n    sevText =\n      case severity of\n        SevWarning -> text \"warning:\"\n        SevError   -> text \"error:\"\n        SevFatal   -> text \"fatal:\"\n        _          -> empty\n\ngetSeverityColour :: Severity -> Col.Scheme -> Col.PprColour\ngetSeverityColour SevWarning = Col.sWarning\ngetSeverityColour SevError   = Col.sError\ngetSeverityColour SevFatal   = Col.sFatal\ngetSeverityColour _          = const mempty\n\ngetCaretDiagnostic :: Severity -> SrcSpan -> IO MsgDoc\ngetCaretDiagnostic _ (UnhelpfulSpan _) = pure empty\ngetCaretDiagnostic severity (RealSrcSpan span) = do\n  caretDiagnostic <$> getSrcLine (srcSpanFile span) row\n\n  where\n    getSrcLine fn i =\n      getLine i (unpackFS fn)\n        `catchIOError` \\_ ->\n          pure Nothing\n\n    getLine i fn = do\n      -- StringBuffer has advantages over readFile:\n      -- (a) no lazy IO, otherwise IO exceptions may occur in pure code\n      -- (b) always UTF-8, rather than some system-dependent encoding\n      --     (Haskell source code must be UTF-8 anyway)\n      content <- hGetStringBuffer fn\n      case atLine i content of\n        Just at_line -> pure $\n          case lines (fix <$> lexemeToString at_line (len at_line)) of\n            srcLine : _ -> Just srcLine\n            _           -> Nothing\n        _ -> pure Nothing\n\n    -- allow user to visibly see that their code is incorrectly encoded\n    -- (StringBuffer.nextChar uses \\0 to represent undecodable characters)\n    fix '\\0' = '\\xfffd'\n    fix c    = c\n\n    row = srcSpanStartLine span\n    rowStr = show row\n    multiline = row /= srcSpanEndLine span\n\n    caretDiagnostic Nothing = empty\n    caretDiagnostic (Just srcLineWithNewline) =\n      sdocWithDynFlags $ \\ dflags ->\n      let sevColour = getSeverityColour severity (colScheme dflags)\n          marginColour = Col.sMargin (colScheme dflags)\n      in\n      coloured marginColour (text marginSpace) <>\n      text (\"\\n\") <>\n      coloured marginColour (text marginRow) <>\n      text (\" \" ++ srcLinePre) <>\n      coloured sevColour (text srcLineSpan) <>\n      text (srcLinePost ++ \"\\n\") <>\n      coloured marginColour (text marginSpace) <>\n      coloured sevColour (text (\" \" ++ caretLine))\n\n      where\n\n        -- expand tabs in a device-independent manner #13664\n        expandTabs tabWidth i s =\n          case s of\n            \"\"        -> \"\"\n            '\\t' : cs -> replicate effectiveWidth ' ' ++\n                         expandTabs tabWidth (i + effectiveWidth) cs\n            c    : cs -> c : expandTabs tabWidth (i + 1) cs\n          where effectiveWidth = tabWidth - i `mod` tabWidth\n\n        srcLine = filter (/= '\\n') (expandTabs 8 0 srcLineWithNewline)\n\n        start = srcSpanStartCol span - 1\n        end | multiline = length srcLine\n            | otherwise = srcSpanEndCol span - 1\n        width = max 1 (end - start)\n\n        marginWidth = length rowStr\n        marginSpace = replicate marginWidth ' ' ++ \" |\"\n        marginRow   = rowStr ++ \" |\"\n\n        (srcLinePre,  srcLineRest) = splitAt start srcLine\n        (srcLineSpan, srcLinePost) = splitAt width srcLineRest\n\n        caretEllipsis | multiline = \"...\"\n                      | otherwise = \"\"\n        caretLine = replicate start ' ' ++ replicate width '^' ++ caretEllipsis\n\nmakeIntoWarning :: WarnReason -> ErrMsg -> ErrMsg\nmakeIntoWarning reason err = err\n    { errMsgSeverity = SevWarning\n    , errMsgReason = reason }\n\n-- -----------------------------------------------------------------------------\n-- Collecting up messages for later ordering and printing.\n\nmk_err_msg :: DynFlags -> Severity -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg\nmk_err_msg dflags sev locn print_unqual doc\n = ErrMsg { errMsgSpan = locn\n          , errMsgContext = print_unqual\n          , errMsgDoc = doc\n          , errMsgShortString = showSDoc dflags (vcat (errDocImportant doc))\n          , errMsgSeverity = sev\n          , errMsgReason = NoReason }\n\nmkErrDoc :: DynFlags -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg\nmkErrDoc dflags = mk_err_msg dflags SevError\n\nmkLongErrMsg, mkLongWarnMsg   :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc -> MsgDoc -> ErrMsg\n-- ^ A long (multi-line) error message\nmkErrMsg, mkWarnMsg           :: DynFlags -> SrcSpan -> PrintUnqualified -> MsgDoc            -> ErrMsg\n-- ^ A short (one-line) error message\nmkPlainErrMsg, mkPlainWarnMsg :: DynFlags -> SrcSpan ->                     MsgDoc            -> ErrMsg\n-- ^ Variant that doesn't care about qualified/unqualified names\n\nmkLongErrMsg   dflags locn unqual msg extra = mk_err_msg dflags SevError   locn unqual        (ErrDoc [msg] [] [extra])\nmkErrMsg       dflags locn unqual msg       = mk_err_msg dflags SevError   locn unqual        (ErrDoc [msg] [] [])\nmkPlainErrMsg  dflags locn        msg       = mk_err_msg dflags SevError   locn alwaysQualify (ErrDoc [msg] [] [])\nmkLongWarnMsg  dflags locn unqual msg extra = mk_err_msg dflags SevWarning locn unqual        (ErrDoc [msg] [] [extra])\nmkWarnMsg      dflags locn unqual msg       = mk_err_msg dflags SevWarning locn unqual        (ErrDoc [msg] [] [])\nmkPlainWarnMsg dflags locn        msg       = mk_err_msg dflags SevWarning locn alwaysQualify (ErrDoc [msg] [] [])\n\n----------------\nemptyMessages :: Messages\nemptyMessages = (emptyBag, emptyBag)\n\nisEmptyMessages :: Messages -> Bool\nisEmptyMessages (warns, errs) = isEmptyBag warns && isEmptyBag errs\n\nerrorsFound :: DynFlags -> Messages -> Bool\nerrorsFound _dflags (_warns, errs) = not (isEmptyBag errs)\n\nwarningsToMessages :: DynFlags -> WarningMessages -> Messages\nwarningsToMessages dflags =\n  partitionBagWith $ \\warn ->\n    case isWarnMsgFatal dflags warn of\n      Nothing -> Left warn\n      Just err_reason ->\n        Right warn{ errMsgSeverity = SevError\n                  , errMsgReason = ErrReason err_reason }\n\nprintBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()\nprintBagOfErrors dflags bag_of_errors\n  = sequence_ [ let style = mkErrStyle dflags unqual\n                in putLogMsg dflags reason sev s style (formatErrDoc dflags doc)\n              | ErrMsg { errMsgSpan      = s,\n                         errMsgDoc       = doc,\n                         errMsgSeverity  = sev,\n                         errMsgReason    = reason,\n                         errMsgContext   = unqual } <- sortMsgBag (Just dflags)\n                                                                  bag_of_errors ]\n\nformatErrDoc :: DynFlags -> ErrDoc -> SDoc\nformatErrDoc dflags (ErrDoc important context supplementary)\n  = case msgs of\n        [msg] -> vcat msg\n        _ -> vcat $ map starred msgs\n    where\n    msgs = filter (not . null) $ map (filter (not . Outputable.isEmpty dflags))\n        [important, context, supplementary]\n    starred = (bullet<+>) . vcat\n\npprErrMsgBagWithLoc :: Bag ErrMsg -> [SDoc]\npprErrMsgBagWithLoc bag = [ pprLocErrMsg item | item <- sortMsgBag Nothing bag ]\n\npprLocErrMsg :: ErrMsg -> SDoc\npprLocErrMsg (ErrMsg { errMsgSpan      = s\n                     , errMsgDoc       = doc\n                     , errMsgSeverity  = sev\n                     , errMsgContext   = unqual })\n  = sdocWithDynFlags $ \\dflags ->\n    withPprStyle (mkErrStyle dflags unqual) $\n    mkLocMessage sev s (formatErrDoc dflags doc)\n\nsortMsgBag :: Maybe DynFlags -> Bag ErrMsg -> [ErrMsg]\nsortMsgBag dflags = maybeLimit . sortBy (maybeFlip cmp) . bagToList\n  where maybeFlip :: (a -> a -> b) -> (a -> a -> b)\n        maybeFlip\n          | fromMaybe False (fmap reverseErrors dflags) = flip\n          | otherwise                                   = id\n        cmp = comparing errMsgSpan\n        maybeLimit = case join (fmap maxErrors dflags) of\n          Nothing        -> id\n          Just err_limit -> take err_limit\n\nghcExit :: DynFlags -> Int -> IO ()\nghcExit dflags val\n  | val == 0  = exitWith ExitSuccess\n  | otherwise = do errorMsg dflags (text \"\\nCompilation had errors\\n\\n\")\n                   exitWith (ExitFailure val)\n\ndoIfSet :: Bool -> IO () -> IO ()\ndoIfSet flag action | flag      = action\n                    | otherwise = return ()\n\ndoIfSet_dyn :: DynFlags -> GeneralFlag -> IO () -> IO()\ndoIfSet_dyn dflags flag action | gopt flag dflags = action\n                               | otherwise        = return ()\n\n-- -----------------------------------------------------------------------------\n-- Dumping\n\ndumpIfSet :: DynFlags -> Bool -> String -> SDoc -> IO ()\ndumpIfSet dflags flag hdr doc\n  | not flag   = return ()\n  | otherwise  = putLogMsg  dflags\n                            NoReason\n                            SevDump\n                            noSrcSpan\n                            (defaultDumpStyle dflags)\n                            (mkDumpDoc hdr doc)\n\n-- | a wrapper around 'dumpSDoc'.\n-- First check whether the dump flag is set\n-- Do nothing if it is unset\ndumpIfSet_dyn :: DynFlags -> DumpFlag -> String -> SDoc -> IO ()\ndumpIfSet_dyn dflags flag hdr doc\n  = when (dopt flag dflags) $ dumpSDoc dflags alwaysQualify flag hdr doc\n\n-- | a wrapper around 'dumpSDoc'.\n-- First check whether the dump flag is set\n-- Do nothing if it is unset\n--\n-- Unlike 'dumpIfSet_dyn',\n-- has a printer argument but no header argument\ndumpIfSet_dyn_printer :: PrintUnqualified\n                      -> DynFlags -> DumpFlag -> SDoc -> IO ()\ndumpIfSet_dyn_printer printer dflags flag doc\n  = when (dopt flag dflags) $ dumpSDoc dflags printer flag \"\" doc\n\nmkDumpDoc :: String -> SDoc -> SDoc\nmkDumpDoc hdr doc\n   = vcat [blankLine,\n           line <+> text hdr <+> line,\n           doc,\n           blankLine]\n     where\n        line = text (replicate 20 '=')\n\n-- | Run an action with the handle of a 'DumpFlag' if we are outputting to a\n-- file, otherwise 'Nothing'.\nwithDumpFileHandle :: DynFlags -> DumpFlag -> (Maybe Handle -> IO ()) -> IO ()\nwithDumpFileHandle dflags flag action = do\n    let mFile = chooseDumpFile dflags flag\n    case mFile of\n      Just fileName -> do\n        let gdref = generatedDumps dflags\n        gd <- readIORef gdref\n        let append = Set.member fileName gd\n            mode = if append then AppendMode else WriteMode\n        unless append $\n            writeIORef gdref (Set.insert fileName gd)\n        createDirectoryIfMissing True (takeDirectory fileName)\n        withFile fileName mode $ \\handle -> do\n            -- We do not want the dump file to be affected by\n            -- environment variables, but instead to always use\n            -- UTF8. See:\n            -- https://ghc.haskell.org/trac/ghc/ticket/10762\n            hSetEncoding handle utf8\n\n            action (Just handle)\n      Nothing -> action Nothing\n\n\ndumpSDoc, dumpSDocForUser\n  :: DynFlags -> PrintUnqualified -> DumpFlag -> String -> SDoc -> IO ()\n\n-- | A wrapper around 'dumpSDocWithStyle' which uses 'PprDump' style.\ndumpSDoc dflags print_unqual\n  = dumpSDocWithStyle dump_style dflags\n  where dump_style = mkDumpStyle dflags print_unqual\n\n-- | A wrapper around 'dumpSDocWithStyle' which uses 'PprUser' style.\ndumpSDocForUser dflags print_unqual\n  = dumpSDocWithStyle user_style dflags\n  where user_style = mkUserStyle dflags print_unqual AllTheWay\n\n-- | Write out a dump.\n-- If --dump-to-file is set then this goes to a file.\n-- otherwise emit to stdout.\n--\n-- When @hdr@ is empty, we print in a more compact format (no separators and\n-- blank lines)\n--\n-- The 'DumpFlag' is used only to choose the filename to use if @--dump-to-file@\n-- is used; it is not used to decide whether to dump the output\ndumpSDocWithStyle :: PprStyle -> DynFlags -> DumpFlag -> String -> SDoc -> IO ()\ndumpSDocWithStyle sty dflags flag hdr doc =\n    withDumpFileHandle dflags flag writeDump\n  where\n    -- write dump to file\n    writeDump (Just handle) = do\n        doc' <- if null hdr\n                then return doc\n                else do t <- getCurrentTime\n                        let timeStamp = if (gopt Opt_SuppressTimestamps dflags)\n                                          then empty\n                                          else text (show t)\n                        let d = timeStamp\n                                $$ blankLine\n                                $$ doc\n                        return $ mkDumpDoc hdr d\n        defaultLogActionHPrintDoc dflags handle doc' sty\n\n    -- write the dump to stdout\n    writeDump Nothing = do\n        let (doc', severity)\n              | null hdr  = (doc, SevOutput)\n              | otherwise = (mkDumpDoc hdr doc, SevDump)\n        putLogMsg dflags NoReason severity noSrcSpan sty doc'\n\n\n-- | Choose where to put a dump file based on DynFlags\n--\nchooseDumpFile :: DynFlags -> DumpFlag -> Maybe FilePath\nchooseDumpFile dflags flag\n\n        | gopt Opt_DumpToFile dflags || flag == Opt_D_th_dec_file\n        , Just prefix <- getPrefix\n        = Just $ setDir (prefix ++ (beautifyDumpName flag))\n\n        | otherwise\n        = Nothing\n\n        where getPrefix\n                 -- dump file location is being forced\n                 --      by the --ddump-file-prefix flag.\n               | Just prefix <- dumpPrefixForce dflags\n                  = Just prefix\n                 -- dump file location chosen by DriverPipeline.runPipeline\n               | Just prefix <- dumpPrefix dflags\n                  = Just prefix\n                 -- we haven't got a place to put a dump file.\n               | otherwise\n                  = Nothing\n              setDir f = case dumpDir dflags of\n                         Just d  -> d </> f\n                         Nothing ->       f\n\n-- | Build a nice file name from name of a 'DumpFlag' constructor\nbeautifyDumpName :: DumpFlag -> String\nbeautifyDumpName Opt_D_th_dec_file = \"th.hs\"\nbeautifyDumpName flag\n = let str = show flag\n       suff = case stripPrefix \"Opt_D_\" str of\n              Just x -> x\n              Nothing -> panic (\"Bad flag name: \" ++ str)\n       dash = map (\\c -> if c == '_' then '-' else c) suff\n   in dash\n\n\n-- -----------------------------------------------------------------------------\n-- Outputting messages from the compiler\n\n-- We want all messages to go through one place, so that we can\n-- redirect them if necessary.  For example, when GHC is used as a\n-- library we might want to catch all messages that GHC tries to\n-- output and do something else with them.\n\nifVerbose :: DynFlags -> Int -> IO () -> IO ()\nifVerbose dflags val act\n  | verbosity dflags >= val = act\n  | otherwise               = return ()\n\nerrorMsg :: DynFlags -> MsgDoc -> IO ()\nerrorMsg dflags msg\n   = putLogMsg dflags NoReason SevError noSrcSpan (defaultErrStyle dflags) msg\n\nwarningMsg :: DynFlags -> MsgDoc -> IO ()\nwarningMsg dflags msg\n   = putLogMsg dflags NoReason SevWarning noSrcSpan (defaultErrStyle dflags) msg\n\nfatalErrorMsg :: DynFlags -> MsgDoc -> IO ()\nfatalErrorMsg dflags msg =\n    putLogMsg dflags NoReason SevFatal noSrcSpan (defaultErrStyle dflags) msg\n\nfatalErrorMsg'' :: FatalMessager -> String -> IO ()\nfatalErrorMsg'' fm msg = fm msg\n\ncompilationProgressMsg :: DynFlags -> String -> IO ()\ncompilationProgressMsg dflags msg\n  = ifVerbose dflags 1 $\n    logOutput dflags (defaultUserStyle dflags) (text msg)\n\nshowPass :: DynFlags -> String -> IO ()\nshowPass dflags what\n  = ifVerbose dflags 2 $\n    logInfo dflags (defaultUserStyle dflags) (text \"***\" <+> text what <> colon)\n\n-- | Time a compilation phase.\n--\n-- When timings are enabled (e.g. with the @-v2@ flag), the allocations\n-- and CPU time used by the phase will be reported to stderr. Consider\n-- a typical usage: @withTiming getDynFlags (text \"simplify\") force pass@.\n-- When timings are enabled the following costs are included in the\n-- produced accounting,\n--\n--  - The cost of executing @pass@ to a result @r@ in WHNF\n--  - The cost of evaluating @force r@ to WHNF (e.g. @()@)\n--\n-- The choice of the @force@ function depends upon the amount of forcing\n-- desired; the goal here is to ensure that the cost of evaluating the result\n-- is, to the greatest extent possible, included in the accounting provided by\n-- 'withTiming'. Often the pass already sufficiently forces its result during\n-- construction; in this case @const ()@ is a reasonable choice.\n-- In other cases, it is necessary to evaluate the result to normal form, in\n-- which case something like @Control.DeepSeq.rnf@ is appropriate.\n--\n-- To avoid adversely affecting compiler performance when timings are not\n-- requested, the result is only forced when timings are enabled.\nwithTiming :: MonadIO m\n           => m DynFlags  -- ^ A means of getting a 'DynFlags' (often\n                          -- 'getDynFlags' will work here)\n           -> SDoc        -- ^ The name of the phase\n           -> (a -> ())   -- ^ A function to force the result\n                          -- (often either @const ()@ or 'rnf')\n           -> m a         -- ^ The body of the phase to be timed\n           -> m a\nwithTiming getDFlags what force_result action\n  = do dflags <- getDFlags\n       if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags\n          then do liftIO $ logInfo dflags (defaultUserStyle dflags)\n                         $ text \"***\" <+> what <> colon\n                  alloc0 <- liftIO getAllocationCounter\n                  start <- liftIO getCPUTime\n                  !r <- action\n                  () <- pure $ force_result r\n                  end <- liftIO getCPUTime\n                  alloc1 <- liftIO getAllocationCounter\n                  -- recall that allocation counter counts down\n                  let alloc = alloc0 - alloc1\n                      time = realToFrac (end - start) * 1e-9\n\n                  when (verbosity dflags >= 2)\n                      $ liftIO $ logInfo dflags (defaultUserStyle dflags)\n                          (text \"!!!\" <+> what <> colon <+> text \"finished in\"\n                           <+> doublePrec 2 time\n                           <+> text \"milliseconds\"\n                           <> comma\n                           <+> text \"allocated\"\n                           <+> doublePrec 3 (realToFrac alloc / 1024 / 1024)\n                           <+> text \"megabytes\")\n\n                  liftIO $ dumpIfSet_dyn dflags Opt_D_dump_timings \"\"\n                      $ text $ showSDocOneLine dflags\n                      $ hsep [ what <> colon\n                             , text \"alloc=\" <> ppr alloc\n                             , text \"time=\" <> doublePrec 3 time\n                             ]\n                  pure r\n           else action\n\ndebugTraceMsg :: DynFlags -> Int -> MsgDoc -> IO ()\ndebugTraceMsg dflags val msg = ifVerbose dflags val $\n                               logInfo dflags (defaultDumpStyle dflags) msg\nputMsg :: DynFlags -> MsgDoc -> IO ()\nputMsg dflags msg = logInfo dflags (defaultUserStyle dflags) msg\n\nprintInfoForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()\nprintInfoForUser dflags print_unqual msg\n  = logInfo dflags (mkUserStyle dflags print_unqual AllTheWay) msg\n\nprintOutputForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()\nprintOutputForUser dflags print_unqual msg\n  = logOutput dflags (mkUserStyle dflags print_unqual AllTheWay) msg\n\nlogInfo :: DynFlags -> PprStyle -> MsgDoc -> IO ()\nlogInfo dflags sty msg\n  = putLogMsg dflags NoReason SevInfo noSrcSpan sty msg\n\nlogOutput :: DynFlags -> PprStyle -> MsgDoc -> IO ()\n-- ^ Like 'logInfo' but with 'SevOutput' rather then 'SevInfo'\nlogOutput dflags sty msg\n  = putLogMsg dflags NoReason SevOutput noSrcSpan sty msg\n\nprettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a\nprettyPrintGhcErrors dflags\n    = ghandle $ \\e -> case e of\n                      PprPanic str doc ->\n                          pprDebugAndThen dflags panic (text str) doc\n                      PprSorry str doc ->\n                          pprDebugAndThen dflags sorry (text str) doc\n                      PprProgramError str doc ->\n                          pprDebugAndThen dflags pgmError (text str) doc\n                      _ ->\n                          liftIO $ throwIO e\n\n-- | Checks if given 'WarnMsg' is a fatal warning.\nisWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)\nisWarnMsgFatal dflags ErrMsg{errMsgReason = Reason wflag}\n  = if wopt_fatal wflag dflags\n      then Just (Just wflag)\n      else Nothing\nisWarnMsgFatal dflags _\n  = if gopt Opt_WarnIsError dflags\n      then Just Nothing\n      else Nothing\n\ntraceCmd :: DynFlags -> String -> String -> IO a -> IO a\n-- trace the command (at two levels of verbosity)\ntraceCmd dflags phase_name cmd_line action\n = do   { let verb = verbosity dflags\n        ; showPass dflags phase_name\n        ; debugTraceMsg dflags 3 (text cmd_line)\n        ; case flushErr dflags of\n              FlushErr io -> io\n\n           -- And run it!\n        ; action `catchIO` handle_exn verb\n        }\n  where\n    handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\\n')\n                              ; debugTraceMsg dflags 2\n                                (text \"Failed:\"\n                                 <+> text cmd_line\n                                 <+> text (show exn))\n                              ; throwGhcExceptionIO (ProgramError (show exn))}\n", "num_lines": 748}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule FileCleanup\n  ( TempFileLifetime(..)\n  , cleanTempDirs, cleanTempFiles, cleanCurrentModuleTempFiles\n  , addFilesToClean, changeTempFilesLifetime\n  , newTempName, newTempLibName, newTempDir\n  , withSystemTempDirectory, withTempDirectory\n  ) where\n\nimport GhcPrelude\n\nimport DynFlags\nimport ErrUtils\nimport Outputable\nimport Util\nimport Exception\nimport DriverPhases\n\nimport Control.Monad\nimport Data.List\nimport qualified Data.Set as Set\nimport qualified Data.Map as Map\nimport Data.IORef\nimport System.Directory\nimport System.FilePath\nimport System.IO.Error\n\n#if !defined(mingw32_HOST_OS)\nimport qualified System.Posix.Internals\n#endif\n\n-- | Used when a temp file is created. This determines which component Set of\n-- FilesToClean will get the temp file\ndata TempFileLifetime\n  = TFL_CurrentModule\n  -- ^ A file with lifetime TFL_CurrentModule will be cleaned up at the\n  -- end of upweep_mod\n  | TFL_GhcSession\n  -- ^ A file with lifetime TFL_GhcSession will be cleaned up at the end of\n  -- runGhc(T)\n  deriving (Show)\n\ncleanTempDirs :: DynFlags -> IO ()\ncleanTempDirs dflags\n   = unless (gopt Opt_KeepTmpFiles dflags)\n   $ mask_\n   $ do let ref = dirsToClean dflags\n        ds <- atomicModifyIORef' ref $ \\ds -> (Map.empty, ds)\n        removeTmpDirs dflags (Map.elems ds)\n\n-- | Delete all files in @filesToClean dflags@.\ncleanTempFiles :: DynFlags -> IO ()\ncleanTempFiles dflags\n   = unless (gopt Opt_KeepTmpFiles dflags)\n   $ mask_\n   $ do let ref = filesToClean dflags\n        to_delete <- atomicModifyIORef' ref $\n            \\FilesToClean\n                { ftcCurrentModule = cm_files\n                , ftcGhcSession = gs_files\n                } -> ( emptyFilesToClean\n                     , Set.toList cm_files ++ Set.toList gs_files)\n        removeTmpFiles dflags to_delete\n\n-- | Delete all files in @filesToClean dflags@. That have lifetime\n-- TFL_CurrentModule.\n-- If a file must be cleaned eventually, but must survive a\n-- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession.\ncleanCurrentModuleTempFiles :: DynFlags -> IO ()\ncleanCurrentModuleTempFiles dflags\n   = unless (gopt Opt_KeepTmpFiles dflags)\n   $ mask_\n   $ do let ref = filesToClean dflags\n        to_delete <- atomicModifyIORef' ref $\n            \\ftc@FilesToClean{ftcCurrentModule = cm_files} ->\n                (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files)\n        removeTmpFiles dflags to_delete\n\n-- | Ensure that new_files are cleaned on the next call of\n-- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime.\n-- If any of new_files are already tracked, they will have their lifetime\n-- updated.\naddFilesToClean :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()\naddFilesToClean dflags lifetime new_files = modifyIORef' (filesToClean dflags) $\n  \\FilesToClean\n    { ftcCurrentModule = cm_files\n    , ftcGhcSession = gs_files\n    } -> case lifetime of\n      TFL_CurrentModule -> FilesToClean\n        { ftcCurrentModule = cm_files `Set.union` new_files_set\n        , ftcGhcSession = gs_files `Set.difference` new_files_set\n        }\n      TFL_GhcSession -> FilesToClean\n        { ftcCurrentModule = cm_files `Set.difference` new_files_set\n        , ftcGhcSession = gs_files `Set.union` new_files_set\n        }\n  where\n    new_files_set = Set.fromList new_files\n\n-- | Update the lifetime of files already being tracked. If any files are\n-- not being tracked they will be discarded.\nchangeTempFilesLifetime :: DynFlags -> TempFileLifetime -> [FilePath] -> IO ()\nchangeTempFilesLifetime dflags lifetime files = do\n  FilesToClean\n    { ftcCurrentModule = cm_files\n    , ftcGhcSession = gs_files\n    } <- readIORef (filesToClean dflags)\n  let old_set = case lifetime of\n        TFL_CurrentModule -> gs_files\n        TFL_GhcSession -> cm_files\n      existing_files = [f | f <- files, f `Set.member` old_set]\n  addFilesToClean dflags lifetime existing_files\n\n-- Return a unique numeric temp file suffix\nnewTempSuffix :: DynFlags -> IO Int\nnewTempSuffix dflags =\n  atomicModifyIORef' (nextTempSuffix dflags) $ \\n -> (n+1,n)\n\n-- Find a temporary name that doesn't already exist.\nnewTempName :: DynFlags -> TempFileLifetime -> Suffix -> IO FilePath\nnewTempName dflags lifetime extn\n  = do d <- getTempDir dflags\n       findTempName (d </> \"ghc_\") -- See Note [Deterministic base name]\n  where\n    findTempName :: FilePath -> IO FilePath\n    findTempName prefix\n      = do n <- newTempSuffix dflags\n           let filename = prefix ++ show n <.> extn\n           b <- doesFileExist filename\n           if b then findTempName prefix\n                else do -- clean it up later\n                        addFilesToClean dflags lifetime [filename]\n                        return filename\n\nnewTempDir :: DynFlags -> IO FilePath\nnewTempDir dflags\n  = do d <- getTempDir dflags\n       findTempDir (d </> \"ghc_\")\n  where\n    findTempDir :: FilePath -> IO FilePath\n    findTempDir prefix\n      = do n <- newTempSuffix dflags\n           let filename = prefix ++ show n\n           b <- doesDirectoryExist filename\n           if b then findTempDir prefix\n                else do createDirectory filename\n                        -- see mkTempDir below; this is wrong: -> consIORef (dirsToClean dflags) filename\n                        return filename\n\nnewTempLibName :: DynFlags -> TempFileLifetime -> Suffix\n  -> IO (FilePath, FilePath, String)\nnewTempLibName dflags lifetime extn\n  = do d <- getTempDir dflags\n       findTempName d (\"ghc_\")\n  where\n    findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)\n    findTempName dir prefix\n      = do n <- newTempSuffix dflags -- See Note [Deterministic base name]\n           let libname = prefix ++ show n\n               filename = dir </> \"lib\" ++ libname <.> extn\n           b <- doesFileExist filename\n           if b then findTempName dir prefix\n                else do -- clean it up later\n                        addFilesToClean dflags lifetime [filename]\n                        return (filename, dir, libname)\n\n\n-- Return our temporary directory within tmp_dir, creating one if we\n-- don't have one yet.\ngetTempDir :: DynFlags -> IO FilePath\ngetTempDir dflags = do\n    mapping <- readIORef dir_ref\n    case Map.lookup tmp_dir mapping of\n        Nothing -> do\n            pid <- getProcessID\n            let prefix = tmp_dir </> \"ghc\" ++ show pid ++ \"_\"\n            mask_ $ mkTempDir prefix\n        Just dir -> return dir\n  where\n    tmp_dir = tmpDir dflags\n    dir_ref = dirsToClean dflags\n\n    mkTempDir :: FilePath -> IO FilePath\n    mkTempDir prefix = do\n        n <- newTempSuffix dflags\n        let our_dir = prefix ++ show n\n\n        -- 1. Speculatively create our new directory.\n        createDirectory our_dir\n\n        -- 2. Update the dirsToClean mapping unless an entry already exists\n        -- (i.e. unless another thread beat us to it).\n        their_dir <- atomicModifyIORef' dir_ref $ \\mapping ->\n            case Map.lookup tmp_dir mapping of\n                Just dir -> (mapping, Just dir)\n                Nothing  -> (Map.insert tmp_dir our_dir mapping, Nothing)\n\n        -- 3. If there was an existing entry, return it and delete the\n        -- directory we created.  Otherwise return the directory we created.\n        case their_dir of\n            Nothing  -> do\n                debugTraceMsg dflags 2 $\n                    text \"Created temporary directory:\" <+> text our_dir\n                return our_dir\n            Just dir -> do\n                removeDirectory our_dir\n                return dir\n      `catchIO` \\e -> if isAlreadyExistsError e\n                      then mkTempDir prefix else ioError e\n\n{- Note [Deterministic base name]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe filename of temporary files, especially the basename of C files, can end\nup in the output in some form, e.g. as part of linker debug information. In the\ninterest of bit-wise exactly reproducible compilation (#4012), the basename of\nthe temporary file no longer contains random information (it used to contain\nthe process id).\n\nThis is ok, as the temporary directory used contains the pid (see getTempDir).\n-}\nremoveTmpDirs :: DynFlags -> [FilePath] -> IO ()\nremoveTmpDirs dflags ds\n  = traceCmd dflags \"Deleting temp dirs\"\n             (\"Deleting: \" ++ unwords ds)\n             (mapM_ (removeWith dflags removeDirectory) ds)\n\nremoveTmpFiles :: DynFlags -> [FilePath] -> IO ()\nremoveTmpFiles dflags fs\n  = warnNon $\n    traceCmd dflags \"Deleting temp files\"\n             (\"Deleting: \" ++ unwords deletees)\n             (mapM_ (removeWith dflags removeFile) deletees)\n  where\n     -- Flat out refuse to delete files that are likely to be source input\n     -- files (is there a worse bug than having a compiler delete your source\n     -- files?)\n     --\n     -- Deleting source files is a sign of a bug elsewhere, so prominently flag\n     -- the condition.\n    warnNon act\n     | null non_deletees = act\n     | otherwise         = do\n        putMsg dflags (text \"WARNING - NOT deleting source files:\"\n                       <+> hsep (map text non_deletees))\n        act\n\n    (non_deletees, deletees) = partition isHaskellUserSrcFilename fs\n\nremoveWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()\nremoveWith dflags remover f = remover f `catchIO`\n  (\\e ->\n   let msg = if isDoesNotExistError e\n             then text \"Warning: deleting non-existent\" <+> text f\n             else text \"Warning: exception raised when deleting\"\n                                            <+> text f <> colon\n               $$ text (show e)\n   in debugTraceMsg dflags 2 msg\n  )\n\n#if defined(mingw32_HOST_OS)\n-- relies on Int == Int32 on Windows\nforeign import ccall unsafe \"_getpid\" getProcessID :: IO Int\n#else\ngetProcessID :: IO Int\ngetProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral\n#endif\n\n-- The following three functions are from the `temporary` package.\n\n-- | Create and use a temporary directory in the system standard temporary\n-- directory.\n--\n-- Behaves exactly the same as 'withTempDirectory', except that the parent\n-- temporary directory will be that returned by 'getTemporaryDirectory'.\nwithSystemTempDirectory :: String   -- ^ Directory name template. See 'openTempFile'.\n                        -> (FilePath -> IO a) -- ^ Callback that can use the directory\n                        -> IO a\nwithSystemTempDirectory template action =\n  getTemporaryDirectory >>= \\tmpDir -> withTempDirectory tmpDir template action\n\n\n-- | Create and use a temporary directory.\n--\n-- Creates a new temporary directory inside the given directory, making use\n-- of the template. The temp directory is deleted after use. For example:\n--\n-- > withTempDirectory \"src\" \"sdist.\" $ \\tmpDir -> do ...\n--\n-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.\n-- @src/sdist.342@.\nwithTempDirectory :: FilePath -- ^ Temp directory to create the directory in\n                  -> String   -- ^ Directory name template. See 'openTempFile'.\n                  -> (FilePath -> IO a) -- ^ Callback that can use the directory\n                  -> IO a\nwithTempDirectory targetDir template =\n  Exception.bracket\n    (createTempDirectory targetDir template)\n    (ignoringIOErrors . removeDirectoryRecursive)\n\nignoringIOErrors :: IO () -> IO ()\nignoringIOErrors ioe = ioe `catch` (\\e -> const (return ()) (e :: IOError))\n\n\ncreateTempDirectory :: FilePath -> String -> IO FilePath\ncreateTempDirectory dir template = do\n  pid <- getProcessID\n  findTempName pid\n  where findTempName x = do\n            let path = dir </> template ++ show x\n            createDirectory path\n            return path\n          `catchIO` \\e -> if isAlreadyExistsError e\n                          then findTempName (x+1) else ioError e\n", "num_lines": 315}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow, 2000-2006\n\n\\section[Finder]{Module Finder}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule Finder (\n    flushFinderCaches,\n    FindResult(..),\n    findImportedModule,\n    findPluginModule,\n    findExactModule,\n    findHomeModule,\n    findExposedPackageModule,\n    mkHomeModLocation,\n    mkHomeModLocation2,\n    mkHiOnlyModLocation,\n    mkHiPath,\n    mkObjPath,\n    addHomeModuleToFinder,\n    uncacheModule,\n    mkStubPaths,\n\n    findObjectLinkableMaybe,\n    findObjectLinkable,\n\n    cannotFindModule,\n    cannotFindInterface,\n\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Module\nimport HscTypes\nimport Packages\nimport FastString\nimport Util\nimport PrelNames        ( gHC_PRIM )\nimport DynFlags\nimport Outputable\nimport Maybes           ( expectJust )\n\nimport Data.IORef       ( IORef, readIORef, atomicModifyIORef' )\nimport System.Directory\nimport System.FilePath\nimport Control.Monad\nimport Data.Time\n\n\ntype FileExt = String   -- Filename extension\ntype BaseName = String  -- Basename of file\n\n-- -----------------------------------------------------------------------------\n-- The Finder\n\n-- The Finder provides a thin filesystem abstraction to the rest of\n-- the compiler.  For a given module, it can tell you where the\n-- source, interface, and object files for that module live.\n\n-- It does *not* know which particular package a module lives in.  Use\n-- Packages.lookupModuleInAllPackages for that.\n\n-- -----------------------------------------------------------------------------\n-- The finder's cache\n\n-- remove all the home modules from the cache; package modules are\n-- assumed to not move around during a session.\nflushFinderCaches :: HscEnv -> IO ()\nflushFinderCaches hsc_env =\n  atomicModifyIORef' fc_ref $ \\fm -> (filterInstalledModuleEnv is_ext fm, ())\n where\n        this_pkg = thisPackage (hsc_dflags hsc_env)\n        fc_ref = hsc_FC hsc_env\n        is_ext mod _ | not (installedModuleUnitId mod `installedUnitIdEq` this_pkg) = True\n                     | otherwise = False\n\naddToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()\naddToFinderCache ref key val =\n  atomicModifyIORef' ref $ \\c -> (extendInstalledModuleEnv c key val, ())\n\nremoveFromFinderCache :: IORef FinderCache -> InstalledModule -> IO ()\nremoveFromFinderCache ref key =\n  atomicModifyIORef' ref $ \\c -> (delInstalledModuleEnv c key, ())\n\nlookupFinderCache :: IORef FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)\nlookupFinderCache ref key = do\n   c <- readIORef ref\n   return $! lookupInstalledModuleEnv c key\n\n-- -----------------------------------------------------------------------------\n-- The three external entry points\n\n-- | Locate a module that was imported by the user.  We have the\n-- module's name, and possibly a package name.  Without a package\n-- name, this function will use the search path and the known exposed\n-- packages to find the module, if a package is specified then only\n-- that package is searched for the module.\n\nfindImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult\nfindImportedModule hsc_env mod_name mb_pkg =\n  case mb_pkg of\n        Nothing                        -> unqual_import\n        Just pkg | pkg == fsLit \"this\" -> home_import -- \"this\" is special\n                 | otherwise           -> pkg_import\n  where\n    home_import   = findHomeModule hsc_env mod_name\n\n    pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg\n\n    unqual_import = home_import\n                    `orIfNotFound`\n                    findExposedPackageModule hsc_env mod_name Nothing\n\n-- | Locate a plugin module requested by the user, for a compiler\n-- plugin.  This consults the same set of exposed packages as\n-- 'findImportedModule', unless @-hide-all-plugin-packages@ or\n-- @-plugin-package@ are specified.\nfindPluginModule :: HscEnv -> ModuleName -> IO FindResult\nfindPluginModule hsc_env mod_name =\n  findHomeModule hsc_env mod_name\n  `orIfNotFound`\n  findExposedPluginPackageModule hsc_env mod_name\n\n-- | Locate a specific 'Module'.  The purpose of this function is to\n-- create a 'ModLocation' for a given 'Module', that is to find out\n-- where the files associated with this module live.  It is used when\n-- reading the interface for a module mentioned by another interface,\n-- for example (a \"system import\").\n\nfindExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult\nfindExactModule hsc_env mod =\n    let dflags = hsc_dflags hsc_env\n    in if installedModuleUnitId mod `installedUnitIdEq` thisPackage dflags\n       then findInstalledHomeModule hsc_env (installedModuleName mod)\n       else findPackageModule hsc_env mod\n\n-- -----------------------------------------------------------------------------\n-- Helpers\n\n-- | Given a monadic actions @this@ and @or_this@, first execute\n-- @this@.  If the returned 'FindResult' is successful, return\n-- it; otherwise, execute @or_this@.  If both failed, this function\n-- also combines their failure messages in a reasonable way.\norIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult\norIfNotFound this or_this = do\n  res <- this\n  case res of\n    NotFound { fr_paths = paths1, fr_mods_hidden = mh1\n             , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }\n     -> do res2 <- or_this\n           case res2 of\n             NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2\n                      , fr_pkgs_hidden = ph2, fr_unusables = u2\n                      , fr_suggestions = s2 }\n              -> return (NotFound { fr_paths = paths1 ++ paths2\n                                  , fr_pkg = mb_pkg2 -- snd arg is the package search\n                                  , fr_mods_hidden = mh1 ++ mh2\n                                  , fr_pkgs_hidden = ph1 ++ ph2\n                                  , fr_unusables = u1 ++ u2\n                                  , fr_suggestions = s1  ++ s2 })\n             _other -> return res2\n    _other -> return res\n\n-- | Helper function for 'findHomeModule': this function wraps an IO action\n-- which would look up @mod_name@ in the file system (the home package),\n-- and first consults the 'hsc_FC' cache to see if the lookup has already\n-- been done.  Otherwise, do the lookup (with the IO action) and save\n-- the result in the finder cache and the module location cache (if it\n-- was successful.)\nhomeSearchCache :: HscEnv -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult\nhomeSearchCache hsc_env mod_name do_this = do\n  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name\n  modLocationCache hsc_env mod do_this\n\nfindExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString\n                         -> IO FindResult\nfindExposedPackageModule hsc_env mod_name mb_pkg\n  = findLookupResult hsc_env\n  $ lookupModuleWithSuggestions\n        (hsc_dflags hsc_env) mod_name mb_pkg\n\nfindExposedPluginPackageModule :: HscEnv -> ModuleName\n                               -> IO FindResult\nfindExposedPluginPackageModule hsc_env mod_name\n  = findLookupResult hsc_env\n  $ lookupPluginModuleWithSuggestions\n        (hsc_dflags hsc_env) mod_name Nothing\n\nfindLookupResult :: HscEnv -> LookupResult -> IO FindResult\nfindLookupResult hsc_env r = case r of\n     LookupFound m pkg_conf -> do\n       let im = fst (splitModuleInsts m)\n       r' <- findPackageModule_ hsc_env im pkg_conf\n       case r' of\n        -- TODO: ghc -M is unlikely to do the right thing\n        -- with just the location of the thing that was\n        -- instantiated; you probably also need all of the\n        -- implicit locations from the instances\n        InstalledFound loc   _ -> return (Found loc m)\n        InstalledNoPackage   _ -> return (NoPackage (moduleUnitId m))\n        InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnitId m)\n                                         , fr_pkgs_hidden = []\n                                         , fr_mods_hidden = []\n                                         , fr_unusables = []\n                                         , fr_suggestions = []})\n     LookupMultiple rs ->\n       return (FoundMultiple rs)\n     LookupHidden pkg_hiddens mod_hiddens ->\n       return (NotFound{ fr_paths = [], fr_pkg = Nothing\n                       , fr_pkgs_hidden = map (moduleUnitId.fst) pkg_hiddens\n                       , fr_mods_hidden = map (moduleUnitId.fst) mod_hiddens\n                       , fr_unusables = []\n                       , fr_suggestions = [] })\n     LookupUnusable unusable ->\n       let unusables' = map get_unusable unusable\n           get_unusable (m, ModUnusable r) = (moduleUnitId m, r)\n           get_unusable (_, r)             =\n             pprPanic \"findLookupResult: unexpected origin\" (ppr r)\n       in return (NotFound{ fr_paths = [], fr_pkg = Nothing\n                          , fr_pkgs_hidden = []\n                          , fr_mods_hidden = []\n                          , fr_unusables = unusables'\n                          , fr_suggestions = [] })\n     LookupNotFound suggest ->\n       return (NotFound{ fr_paths = [], fr_pkg = Nothing\n                       , fr_pkgs_hidden = []\n                       , fr_mods_hidden = []\n                       , fr_unusables = []\n                       , fr_suggestions = suggest })\n\nmodLocationCache :: HscEnv -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult\nmodLocationCache hsc_env mod do_this = do\n  m <- lookupFinderCache (hsc_FC hsc_env) mod\n  case m of\n    Just result -> return result\n    Nothing     -> do\n        result <- do_this\n        addToFinderCache (hsc_FC hsc_env) mod result\n        return result\n\nmkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule\nmkHomeInstalledModule dflags mod_name =\n  let iuid = fst (splitUnitIdInsts (thisPackage dflags))\n  in InstalledModule iuid mod_name\n\n-- This returns a module because it's more convenient for users\naddHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module\naddHomeModuleToFinder hsc_env mod_name loc = do\n  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name\n  addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)\n  return (mkModule (thisPackage (hsc_dflags hsc_env)) mod_name)\n\nuncacheModule :: HscEnv -> ModuleName -> IO ()\nuncacheModule hsc_env mod_name = do\n  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name\n  removeFromFinderCache (hsc_FC hsc_env) mod\n\n-- -----------------------------------------------------------------------------\n--      The internal workers\n\nfindHomeModule :: HscEnv -> ModuleName -> IO FindResult\nfindHomeModule hsc_env mod_name = do\n  r <- findInstalledHomeModule hsc_env mod_name\n  return $ case r of\n    InstalledFound loc _ -> Found loc (mkModule uid mod_name)\n    InstalledNoPackage _ -> NoPackage uid -- impossible\n    InstalledNotFound fps _ -> NotFound {\n        fr_paths = fps,\n        fr_pkg = Just uid,\n        fr_mods_hidden = [],\n        fr_pkgs_hidden = [],\n        fr_unusables = [],\n        fr_suggestions = []\n      }\n where\n  dflags = hsc_dflags hsc_env\n  uid = thisPackage dflags\n\n-- | Implements the search for a module name in the home package only.  Calling\n-- this function directly is usually *not* what you want; currently, it's used\n-- as a building block for the following operations:\n--\n--  1. When you do a normal package lookup, we first check if the module\n--  is available in the home module, before looking it up in the package\n--  database.\n--\n--  2. When you have a package qualified import with package name \"this\",\n--  we shortcut to the home module.\n--\n--  3. When we look up an exact 'Module', if the unit id associated with\n--  the module is the current home module do a look up in the home module.\n--\n--  4. Some special-case code in GHCi (ToDo: Figure out why that needs to\n--  call this.)\nfindInstalledHomeModule :: HscEnv -> ModuleName -> IO InstalledFindResult\nfindInstalledHomeModule hsc_env mod_name =\n   homeSearchCache hsc_env mod_name $\n   let\n     dflags = hsc_dflags hsc_env\n     home_path = importPaths dflags\n     hisuf = hiSuf dflags\n     mod = mkHomeInstalledModule dflags mod_name\n\n     source_exts =\n      [ (\"hs\",   mkHomeModLocationSearched dflags mod_name \"hs\")\n      , (\"lhs\",  mkHomeModLocationSearched dflags mod_name \"lhs\")\n      , (\"hsig\",  mkHomeModLocationSearched dflags mod_name \"hsig\")\n      , (\"lhsig\",  mkHomeModLocationSearched dflags mod_name \"lhsig\")\n      ]\n\n     hi_exts = [ (hisuf,                mkHiOnlyModLocation dflags hisuf)\n               , (addBootSuffix hisuf,  mkHiOnlyModLocation dflags hisuf)\n               ]\n\n        -- In compilation manager modes, we look for source files in the home\n        -- package because we can compile these automatically.  In one-shot\n        -- compilation mode we look for .hi and .hi-boot files only.\n     exts | isOneShot (ghcMode dflags) = hi_exts\n          | otherwise                  = source_exts\n   in\n\n  -- special case for GHC.Prim; we won't find it in the filesystem.\n  -- This is important only when compiling the base package (where GHC.Prim\n  -- is a home module).\n  if mod `installedModuleEq` gHC_PRIM\n        then return (InstalledFound (error \"GHC.Prim ModLocation\") mod)\n        else searchPathExts home_path mod exts\n\n\n-- | Search for a module in external packages only.\nfindPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult\nfindPackageModule hsc_env mod = do\n  let\n        dflags = hsc_dflags hsc_env\n        pkg_id = installedModuleUnitId mod\n  --\n  case lookupInstalledPackage dflags pkg_id of\n     Nothing -> return (InstalledNoPackage pkg_id)\n     Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf\n\n-- | Look up the interface file associated with module @mod@.  This function\n-- requires a few invariants to be upheld: (1) the 'Module' in question must\n-- be the module identifier of the *original* implementation of a module,\n-- not a reexport (this invariant is upheld by @Packages.hs@) and (2)\n-- the 'PackageConfig' must be consistent with the unit id in the 'Module'.\n-- The redundancy is to avoid an extra lookup in the package state\n-- for the appropriate config.\nfindPackageModule_ :: HscEnv -> InstalledModule -> PackageConfig -> IO InstalledFindResult\nfindPackageModule_ hsc_env mod pkg_conf =\n  ASSERT2( installedModuleUnitId mod == installedPackageConfigId pkg_conf, ppr (installedModuleUnitId mod) <+> ppr (installedPackageConfigId pkg_conf) )\n  modLocationCache hsc_env mod $\n\n  -- special case for GHC.Prim; we won't find it in the filesystem.\n  if mod `installedModuleEq` gHC_PRIM\n        then return (InstalledFound (error \"GHC.Prim ModLocation\") mod)\n        else\n\n  let\n     dflags = hsc_dflags hsc_env\n     tag = buildTag dflags\n\n           -- hi-suffix for packages depends on the build tag.\n     package_hisuf | null tag  = \"hi\"\n                   | otherwise = tag ++ \"_hi\"\n\n     mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf\n\n     import_dirs = importDirs pkg_conf\n      -- we never look for a .hi-boot file in an external package;\n      -- .hi-boot files only make sense for the home package.\n  in\n  case import_dirs of\n    [one] | MkDepend <- ghcMode dflags -> do\n          -- there's only one place that this .hi file can be, so\n          -- don't bother looking for it.\n          let basename = moduleNameSlashes (installedModuleName mod)\n          loc <- mk_hi_loc one basename\n          return (InstalledFound loc mod)\n    _otherwise ->\n          searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]\n\n-- -----------------------------------------------------------------------------\n-- General path searching\n\nsearchPathExts\n  :: [FilePath]         -- paths to search\n  -> InstalledModule             -- module name\n  -> [ (\n        FileExt,                                -- suffix\n        FilePath -> BaseName -> IO ModLocation  -- action\n       )\n     ]\n  -> IO InstalledFindResult\n\nsearchPathExts paths mod exts\n   = do result <- search to_search\n{-\n        hPutStrLn stderr (showSDoc $\n                vcat [text \"Search\" <+> ppr mod <+> sep (map (text. fst) exts)\n                    , nest 2 (vcat (map text paths))\n                    , case result of\n                        Succeeded (loc, p) -> text \"Found\" <+> ppr loc\n                        Failed fs          -> text \"not found\"])\n-}\n        return result\n\n  where\n    basename = moduleNameSlashes (installedModuleName mod)\n\n    to_search :: [(FilePath, IO ModLocation)]\n    to_search = [ (file, fn path basename)\n                | path <- paths,\n                  (ext,fn) <- exts,\n                  let base | path == \".\" = basename\n                           | otherwise   = path </> basename\n                      file = base <.> ext\n                ]\n\n    search [] = return (InstalledNotFound (map fst to_search) (Just (installedModuleUnitId mod)))\n\n    search ((file, mk_result) : rest) = do\n      b <- doesFileExist file\n      if b\n        then do { loc <- mk_result; return (InstalledFound loc mod) }\n        else search rest\n\nmkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt\n                          -> FilePath -> BaseName -> IO ModLocation\nmkHomeModLocationSearched dflags mod suff path basename = do\n   mkHomeModLocation2 dflags mod (path </> basename) suff\n\n-- -----------------------------------------------------------------------------\n-- Constructing a home module location\n\n-- This is where we construct the ModLocation for a module in the home\n-- package, for which we have a source file.  It is called from three\n-- places:\n--\n--  (a) Here in the finder, when we are searching for a module to import,\n--      using the search path (-i option).\n--\n--  (b) The compilation manager, when constructing the ModLocation for\n--      a \"root\" module (a source file named explicitly on the command line\n--      or in a :load command in GHCi).\n--\n--  (c) The driver in one-shot mode, when we need to construct a\n--      ModLocation for a source file named on the command-line.\n--\n-- Parameters are:\n--\n-- mod\n--      The name of the module\n--\n-- path\n--      (a): The search path component where the source file was found.\n--      (b) and (c): \".\"\n--\n-- src_basename\n--      (a): (moduleNameSlashes mod)\n--      (b) and (c): The filename of the source file, minus its extension\n--\n-- ext\n--      The filename extension of the source file (usually \"hs\" or \"lhs\").\n\nmkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation\nmkHomeModLocation dflags mod src_filename = do\n   let (basename,extension) = splitExtension src_filename\n   mkHomeModLocation2 dflags mod basename extension\n\nmkHomeModLocation2 :: DynFlags\n                   -> ModuleName\n                   -> FilePath  -- Of source module, without suffix\n                   -> String    -- Suffix\n                   -> IO ModLocation\nmkHomeModLocation2 dflags mod src_basename ext = do\n   let mod_basename = moduleNameSlashes mod\n\n       obj_fn = mkObjPath  dflags src_basename mod_basename\n       hi_fn  = mkHiPath   dflags src_basename mod_basename\n       hie_fn = mkHiePath  dflags src_basename mod_basename\n\n   return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),\n                        ml_hi_file   = hi_fn,\n                        ml_obj_file  = obj_fn,\n                        ml_hie_file  = hie_fn })\n\nmkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String\n                    -> IO ModLocation\nmkHiOnlyModLocation dflags hisuf path basename\n = do let full_basename = path </> basename\n          obj_fn = mkObjPath  dflags full_basename basename\n          hie_fn = mkHiePath  dflags full_basename basename\n      return ModLocation{    ml_hs_file   = Nothing,\n                             ml_hi_file   = full_basename <.> hisuf,\n                                -- Remove the .hi-boot suffix from\n                                -- hi_file, if it had one.  We always\n                                -- want the name of the real .hi file\n                                -- in the ml_hi_file field.\n                             ml_obj_file  = obj_fn,\n                             ml_hie_file  = hie_fn\n                  }\n\n-- | Constructs the filename of a .o file for a given source file.\n-- Does /not/ check whether the .o file exists\nmkObjPath\n  :: DynFlags\n  -> FilePath           -- the filename of the source file, minus the extension\n  -> String             -- the module name with dots replaced by slashes\n  -> FilePath\nmkObjPath dflags basename mod_basename = obj_basename <.> osuf\n  where\n                odir = objectDir dflags\n                osuf = objectSuf dflags\n\n                obj_basename | Just dir <- odir = dir </> mod_basename\n                             | otherwise        = basename\n\n\n-- | Constructs the filename of a .hi file for a given source file.\n-- Does /not/ check whether the .hi file exists\nmkHiPath\n  :: DynFlags\n  -> FilePath           -- the filename of the source file, minus the extension\n  -> String             -- the module name with dots replaced by slashes\n  -> FilePath\nmkHiPath dflags basename mod_basename = hi_basename <.> hisuf\n where\n                hidir = hiDir dflags\n                hisuf = hiSuf dflags\n\n                hi_basename | Just dir <- hidir = dir </> mod_basename\n                            | otherwise         = basename\n\n-- | Constructs the filename of a .hie file for a given source file.\n-- Does /not/ check whether the .hie file exists\nmkHiePath\n  :: DynFlags\n  -> FilePath           -- the filename of the source file, minus the extension\n  -> String             -- the module name with dots replaced by slashes\n  -> FilePath\nmkHiePath dflags basename mod_basename = hie_basename <.> hiesuf\n where\n                hiedir = hieDir dflags\n                hiesuf = hieSuf dflags\n\n                hie_basename | Just dir <- hiedir = dir </> mod_basename\n                             | otherwise          = basename\n\n\n\n-- -----------------------------------------------------------------------------\n-- Filenames of the stub files\n\n-- We don't have to store these in ModLocations, because they can be derived\n-- from other available information, and they're only rarely needed.\n\nmkStubPaths\n  :: DynFlags\n  -> ModuleName\n  -> ModLocation\n  -> FilePath\n\nmkStubPaths dflags mod location\n  = let\n        stubdir = stubDir dflags\n\n        mod_basename = moduleNameSlashes mod\n        src_basename = dropExtension $ expectJust \"mkStubPaths\"\n                                                  (ml_hs_file location)\n\n        stub_basename0\n            | Just dir <- stubdir = dir </> mod_basename\n            | otherwise           = src_basename\n\n        stub_basename = stub_basename0 ++ \"_stub\"\n     in\n        stub_basename <.> \"h\"\n\n-- -----------------------------------------------------------------------------\n-- findLinkable isn't related to the other stuff in here,\n-- but there's no other obvious place for it\n\nfindObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)\nfindObjectLinkableMaybe mod locn\n   = do let obj_fn = ml_obj_file locn\n        maybe_obj_time <- modificationTimeIfExists obj_fn\n        case maybe_obj_time of\n          Nothing -> return Nothing\n          Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)\n\n-- Make an object linkable when we know the object file exists, and we know\n-- its modification time.\nfindObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable\nfindObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])\n  -- We used to look for _stub.o files here, but that was a bug (#706)\n  -- Now GHC merges the stub.o into the main .o (#3687)\n\n-- -----------------------------------------------------------------------------\n-- Error messages\n\ncannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc\ncannotFindModule flags mod res =\n  cantFindErr (sLit cannotFindMsg)\n              (sLit \"Ambiguous module name\")\n              flags mod res\n  where\n    cannotFindMsg =\n      case res of\n        NotFound { fr_mods_hidden = hidden_mods\n                 , fr_pkgs_hidden = hidden_pkgs\n                 , fr_unusables = unusables }\n          | not (null hidden_mods && null hidden_pkgs && null unusables)\n          -> \"Could not load module\"\n        _ -> \"Could not find module\"\n\ncannotFindInterface  :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc\ncannotFindInterface = cantFindInstalledErr (sLit \"Failed to load interface for\")\n                                           (sLit \"Ambiguous interface for\")\n\ncantFindErr :: PtrString -> PtrString -> DynFlags -> ModuleName -> FindResult\n            -> SDoc\ncantFindErr _ multiple_found _ mod_name (FoundMultiple mods)\n  | Just pkgs <- unambiguousPackages\n  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (\n       sep [text \"it was found in multiple packages:\",\n                hsep (map ppr pkgs) ]\n    )\n  | otherwise\n  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (\n       vcat (map pprMod mods)\n    )\n  where\n    unambiguousPackages = foldl' unambiguousPackage (Just []) mods\n    unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)\n        = Just (moduleUnitId m : xs)\n    unambiguousPackage _ _ = Nothing\n\n    pprMod (m, o) = text \"it is bound as\" <+> ppr m <+>\n                                text \"by\" <+> pprOrigin m o\n    pprOrigin _ ModHidden = panic \"cantFindErr: bound by mod hidden\"\n    pprOrigin _ (ModUnusable _) = panic \"cantFindErr: bound by mod unusable\"\n    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (\n      if e == Just True\n          then [text \"package\" <+> ppr (moduleUnitId m)]\n          else [] ++\n      map ((text \"a reexport in package\" <+>)\n                .ppr.packageConfigId) res ++\n      if f then [text \"a package flag\"] else []\n      )\n\ncantFindErr cannot_find _ dflags mod_name find_result\n  = ptext cannot_find <+> quotes (ppr mod_name)\n    $$ more_info\n  where\n    more_info\n      = case find_result of\n            NoPackage pkg\n                -> text \"no unit id matching\" <+> quotes (ppr pkg) <+>\n                   text \"was found\"\n\n            NotFound { fr_paths = files, fr_pkg = mb_pkg\n                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens\n                     , fr_unusables = unusables, fr_suggestions = suggest }\n                | Just pkg <- mb_pkg, pkg /= thisPackage dflags\n                -> not_found_in_package pkg files\n\n                | not (null suggest)\n                -> pp_suggestions suggest $$ tried_these files dflags\n\n                | null files && null mod_hiddens &&\n                  null pkg_hiddens && null unusables\n                -> text \"It is not a module in the current program, or in any known package.\"\n\n                | otherwise\n                -> vcat (map pkg_hidden pkg_hiddens) $$\n                   vcat (map mod_hidden mod_hiddens) $$\n                   vcat (map unusable unusables) $$\n                   tried_these files dflags\n\n            _ -> panic \"cantFindErr\"\n\n    build_tag = buildTag dflags\n\n    not_found_in_package pkg files\n       | build_tag /= \"\"\n       = let\n            build = if build_tag == \"p\" then \"profiling\"\n                                        else \"\\\"\" ++ build_tag ++ \"\\\"\"\n         in\n         text \"Perhaps you haven't installed the \" <> text build <>\n         text \" libraries for package \" <> quotes (ppr pkg) <> char '?' $$\n         tried_these files dflags\n\n       | otherwise\n       = text \"There are files missing in the \" <> quotes (ppr pkg) <>\n         text \" package,\" $$\n         text \"try running 'ghc-pkg check'.\" $$\n         tried_these files dflags\n\n    pkg_hidden :: UnitId -> SDoc\n    pkg_hidden pkgid =\n        text \"It is a member of the hidden package\"\n        <+> quotes (ppr pkgid)\n        --FIXME: we don't really want to show the unit id here we should\n        -- show the source package id or installed package id if it's ambiguous\n        <> dot $$ pkg_hidden_hint pkgid\n    pkg_hidden_hint pkgid\n     | gopt Opt_BuildingCabalPackage dflags\n        = let pkg = expectJust \"pkg_hidden\" (lookupPackage dflags pkgid)\n           in text \"Perhaps you need to add\" <+>\n              quotes (ppr (packageName pkg)) <+>\n              text \"to the build-depends in your .cabal file.\"\n     | Just pkg <- lookupPackage dflags pkgid\n         = text \"You can run\" <+>\n           quotes (text \":set -package \" <> ppr (packageName pkg)) <+>\n           text \"to expose it.\" $$\n           text \"(Note: this unloads all the modules in the current scope.)\"\n     | otherwise = Outputable.empty\n\n    mod_hidden pkg =\n        text \"it is a hidden module in the package\" <+> quotes (ppr pkg)\n\n    unusable (pkg, reason)\n      = text \"It is a member of the package\"\n      <+> quotes (ppr pkg)\n      $$ pprReason (text \"which is\") reason\n\n    pp_suggestions :: [ModuleSuggestion] -> SDoc\n    pp_suggestions sugs\n      | null sugs = Outputable.empty\n      | otherwise = hang (text \"Perhaps you meant\")\n                       2 (vcat (map pp_sugg sugs))\n\n    -- NB: Prefer the *original* location, and then reexports, and then\n    -- package flags when making suggestions.  ToDo: if the original package\n    -- also has a reexport, prefer that one\n    pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o\n      where provenance ModHidden = Outputable.empty\n            provenance (ModUnusable _) = Outputable.empty\n            provenance (ModOrigin{ fromOrigPackage = e,\n                                   fromExposedReexport = res,\n                                   fromPackageFlag = f })\n              | Just True <- e\n                 = parens (text \"from\" <+> ppr (moduleUnitId mod))\n              | f && moduleName mod == m\n                 = parens (text \"from\" <+> ppr (moduleUnitId mod))\n              | (pkg:_) <- res\n                 = parens (text \"from\" <+> ppr (packageConfigId pkg)\n                    <> comma <+> text \"reexporting\" <+> ppr mod)\n              | f\n                 = parens (text \"defined via package flags to be\"\n                    <+> ppr mod)\n              | otherwise = Outputable.empty\n    pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o\n      where provenance ModHidden =  Outputable.empty\n            provenance (ModUnusable _) = Outputable.empty\n            provenance (ModOrigin{ fromOrigPackage = e,\n                                   fromHiddenReexport = rhs })\n              | Just False <- e\n                 = parens (text \"needs flag -package-key\"\n                    <+> ppr (moduleUnitId mod))\n              | (pkg:_) <- rhs\n                 = parens (text \"needs flag -package-id\"\n                    <+> ppr (packageConfigId pkg))\n              | otherwise = Outputable.empty\n\ncantFindInstalledErr :: PtrString -> PtrString -> DynFlags -> ModuleName\n                     -> InstalledFindResult -> SDoc\ncantFindInstalledErr cannot_find _ dflags mod_name find_result\n  = ptext cannot_find <+> quotes (ppr mod_name)\n    $$ more_info\n  where\n    more_info\n      = case find_result of\n            InstalledNoPackage pkg\n                -> text \"no unit id matching\" <+> quotes (ppr pkg) <+>\n                   text \"was found\" $$ looks_like_srcpkgid pkg\n\n            InstalledNotFound files mb_pkg\n                | Just pkg <- mb_pkg, not (pkg `installedUnitIdEq` thisPackage dflags)\n                -> not_found_in_package pkg files\n\n                | null files\n                -> text \"It is not a module in the current program, or in any known package.\"\n\n                | otherwise\n                -> tried_these files dflags\n\n            _ -> panic \"cantFindInstalledErr\"\n\n    build_tag = buildTag dflags\n\n    looks_like_srcpkgid :: InstalledUnitId -> SDoc\n    looks_like_srcpkgid pk\n     -- Unsafely coerce a unit id FastString into a source package ID\n     -- FastString and see if it means anything.\n     | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (installedUnitIdFS pk))\n     = parens (text \"This unit ID looks like the source package ID;\" $$\n       text \"the real unit ID is\" <+> quotes (ftext (installedUnitIdFS (unitId pkg))) $$\n       (if null pkgs then Outputable.empty\n        else text \"and\" <+> int (length pkgs) <+> text \"other candidates\"))\n     -- Todo: also check if it looks like a package name!\n     | otherwise = Outputable.empty\n\n    not_found_in_package pkg files\n       | build_tag /= \"\"\n       = let\n            build = if build_tag == \"p\" then \"profiling\"\n                                        else \"\\\"\" ++ build_tag ++ \"\\\"\"\n         in\n         text \"Perhaps you haven't installed the \" <> text build <>\n         text \" libraries for package \" <> quotes (ppr pkg) <> char '?' $$\n         tried_these files dflags\n\n       | otherwise\n       = text \"There are files missing in the \" <> quotes (ppr pkg) <>\n         text \" package,\" $$\n         text \"try running 'ghc-pkg check'.\" $$\n         tried_these files dflags\n\ntried_these :: [FilePath] -> DynFlags -> SDoc\ntried_these files dflags\n    | null files = Outputable.empty\n    | verbosity dflags < 3 =\n          text \"Use -v (or `:set -v` in ghci) \" <>\n              text \"to see a list of the files searched for.\"\n    | otherwise =\n          hang (text \"Locations searched:\") 2 $ vcat (map text files)\n", "num_lines": 834}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, NondecreasingIndentation, ScopedTypeVariables #-}\n{-# LANGUAGE TupleSections, NamedFieldPuns #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 2005-2012\n--\n-- The GHC API\n--\n-- -----------------------------------------------------------------------------\n\nmodule GHC (\n        -- * Initialisation\n        defaultErrorHandler,\n        defaultCleanupHandler,\n        prettyPrintGhcErrors,\n        withSignalHandlers,\n        withCleanupSession,\n\n        -- * GHC Monad\n        Ghc, GhcT, GhcMonad(..), HscEnv,\n        runGhc, runGhcT, initGhcMonad,\n        gcatch, gbracket, gfinally,\n        printException,\n        handleSourceError,\n        needsTemplateHaskellOrQQ,\n\n        -- * Flags and settings\n        DynFlags(..), GeneralFlag(..), Severity(..), HscTarget(..), gopt,\n        GhcMode(..), GhcLink(..), defaultObjectTarget,\n        parseDynamicFlags,\n        getSessionDynFlags, setSessionDynFlags,\n        getProgramDynFlags, setProgramDynFlags, setLogAction,\n        getInteractiveDynFlags, setInteractiveDynFlags,\n\n        -- * Targets\n        Target(..), TargetId(..), Phase,\n        setTargets,\n        getTargets,\n        addTarget,\n        removeTarget,\n        guessTarget,\n\n        -- * Loading\\/compiling the program\n        depanal,\n        load, LoadHowMuch(..), InteractiveImport(..),\n        SuccessFlag(..), succeeded, failed,\n        defaultWarnErrLogger, WarnErrLogger,\n        workingDirectoryChanged,\n        parseModule, typecheckModule, desugarModule, loadModule,\n        ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),\n        TypecheckedSource, ParsedSource, RenamedSource,   -- ditto\n        TypecheckedMod, ParsedMod,\n        moduleInfo, renamedSource, typecheckedSource,\n        parsedSource, coreModule,\n\n        -- ** Compiling to Core\n        CoreModule(..),\n        compileToCoreModule, compileToCoreSimplified,\n\n        -- * Inspecting the module structure of the program\n        ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,\n        mgLookupModule,\n        ModSummary(..), ms_mod_name, ModLocation(..),\n        getModSummary,\n        getModuleGraph,\n        isLoaded,\n        topSortModuleGraph,\n\n        -- * Inspecting modules\n        ModuleInfo,\n        getModuleInfo,\n        modInfoTyThings,\n        modInfoTopLevelScope,\n        modInfoExports,\n        modInfoExportsWithSelectors,\n        modInfoInstances,\n        modInfoIsExportedName,\n        modInfoLookupName,\n        modInfoIface,\n        modInfoSafe,\n        lookupGlobalName,\n        findGlobalAnns,\n        mkPrintUnqualifiedForModule,\n        ModIface(..),\n        SafeHaskellMode(..),\n\n        -- * Querying the environment\n        -- packageDbModules,\n\n        -- * Printing\n        PrintUnqualified, alwaysQualify,\n\n        -- * Interactive evaluation\n\n        -- ** Executing statements\n        execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..),\n        resumeExec,\n\n        -- ** Adding new declarations\n        runDecls, runDeclsWithLocation, runParsedDecls,\n\n        -- ** Get/set the current context\n        parseImportDecl,\n        setContext, getContext,\n        setGHCiMonad, getGHCiMonad,\n\n        -- ** Inspecting the current context\n        getBindings, getInsts, getPrintUnqual,\n        findModule, lookupModule,\n        isModuleTrusted, moduleTrustReqs,\n        getNamesInScope,\n        getRdrNamesInScope,\n        getGRE,\n        moduleIsInterpreted,\n        getInfo,\n        showModule,\n        moduleIsBootOrNotObjectLinkable,\n        getNameToInstancesIndex,\n\n        -- ** Inspecting types and kinds\n        exprType, TcRnExprMode(..),\n        typeKind,\n\n        -- ** Looking up a Name\n        parseName,\n        lookupName,\n\n        -- ** Compiling expressions\n        HValue, parseExpr, compileParsedExpr,\n        InteractiveEval.compileExpr, dynCompileExpr,\n        ForeignHValue,\n        compileExprRemote, compileParsedExprRemote,\n\n        -- ** Docs\n        getDocs, GetDocsFailure(..),\n\n        -- ** Other\n        runTcInteractive,   -- Desired by some clients (Trac #8878)\n        isStmt, hasImport, isImport, isDecl,\n\n        -- ** The debugger\n        SingleStep(..),\n        Resume(..),\n        History(historyBreakInfo, historyEnclosingDecls),\n        GHC.getHistorySpan, getHistoryModule,\n        abandon, abandonAll,\n        getResumeContext,\n        GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,\n        modInfoModBreaks,\n        ModBreaks(..), BreakIndex,\n        BreakInfo(breakInfo_number, breakInfo_module),\n        InteractiveEval.back,\n        InteractiveEval.forward,\n\n        -- * Abstract syntax elements\n\n        -- ** Packages\n        UnitId,\n\n        -- ** Modules\n        Module, mkModule, pprModule, moduleName, moduleUnitId,\n        ModuleName, mkModuleName, moduleNameString,\n\n        -- ** Names\n        Name,\n        isExternalName, nameModule, pprParenSymName, nameSrcSpan,\n        NamedThing(..),\n        RdrName(Qual,Unqual),\n\n        -- ** Identifiers\n        Id, idType,\n        isImplicitId, isDeadBinder,\n        isExportedId, isLocalId, isGlobalId,\n        isRecordSelector,\n        isPrimOpId, isFCallId, isClassOpId_maybe,\n        isDataConWorkId, idDataCon,\n        isBottomingId, isDictonaryId,\n        recordSelectorTyCon,\n\n        -- ** Type constructors\n        TyCon,\n        tyConTyVars, tyConDataCons, tyConArity,\n        isClassTyCon, isTypeSynonymTyCon, isTypeFamilyTyCon, isNewTyCon,\n        isPrimTyCon, isFunTyCon,\n        isFamilyTyCon, isOpenFamilyTyCon, isOpenTypeFamilyTyCon,\n        tyConClass_maybe,\n        synTyConRhs_maybe, synTyConDefn_maybe, tyConKind,\n\n        -- ** Type variables\n        TyVar,\n        alphaTyVars,\n\n        -- ** Data constructors\n        DataCon,\n        dataConSig, dataConType, dataConTyCon, dataConFieldLabels,\n        dataConIsInfix, isVanillaDataCon, dataConUserType,\n        dataConSrcBangs,\n        StrictnessMark(..), isMarkedStrict,\n\n        -- ** Classes\n        Class,\n        classMethods, classSCTheta, classTvsFds, classATs,\n        pprFundeps,\n\n        -- ** Instances\n        ClsInst,\n        instanceDFunId,\n        pprInstance, pprInstanceHdr,\n        pprFamInst,\n\n        FamInst,\n\n        -- ** Types and Kinds\n        Type, splitForAllTys, funResultTy,\n        pprParendType, pprTypeApp,\n        Kind,\n        PredType,\n        ThetaType, pprForAll, pprThetaArrowTy,\n\n        -- ** Entities\n        TyThing(..),\n\n        -- ** Syntax\n        module HsSyn, -- ToDo: remove extraneous bits\n\n        -- ** Fixities\n        FixityDirection(..),\n        defaultFixity, maxPrecedence,\n        negateFixity,\n        compareFixity,\n        LexicalFixity(..),\n\n        -- ** Source locations\n        SrcLoc(..), RealSrcLoc,\n        mkSrcLoc, noSrcLoc,\n        srcLocFile, srcLocLine, srcLocCol,\n        SrcSpan(..), RealSrcSpan,\n        mkSrcSpan, srcLocSpan, isGoodSrcSpan, noSrcSpan,\n        srcSpanStart, srcSpanEnd,\n        srcSpanFile,\n        srcSpanStartLine, srcSpanEndLine,\n        srcSpanStartCol, srcSpanEndCol,\n\n        -- ** Located\n        GenLocated(..), Located,\n\n        -- *** Constructing Located\n        noLoc, mkGeneralLocated,\n\n        -- *** Deconstructing Located\n        getLoc, unLoc,\n        getRealSrcSpan, unRealSrcSpan,\n\n        -- ** HasSrcSpan\n        HasSrcSpan(..), SrcSpanLess, dL, cL,\n\n        -- *** Combining and comparing Located values\n        eqLocated, cmpLocated, combineLocs, addCLoc,\n        leftmost_smallest, leftmost_largest, rightmost,\n        spans, isSubspanOf,\n\n        -- * Exceptions\n        GhcException(..), showGhcException,\n\n        -- * Token stream manipulations\n        Token,\n        getTokenStream, getRichTokenStream,\n        showRichTokenStream, addSourceToTokens,\n\n        -- * Pure interface to the parser\n        parser,\n\n        -- * API Annotations\n        ApiAnns,AnnKeywordId(..),AnnotationComment(..),\n        getAnnotation, getAndRemoveAnnotation,\n        getAnnotationComments, getAndRemoveAnnotationComments,\n        unicodeAnn,\n\n        -- * Miscellaneous\n        --sessionHscEnv,\n        cyclicModuleErr,\n  ) where\n\n{-\n ToDo:\n\n  * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.\n-}\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude hiding (init)\n\nimport ByteCodeTypes\nimport InteractiveEval\nimport InteractiveEvalTypes\nimport GHCi\nimport GHCi.RemoteTypes\n\nimport PprTyThing       ( pprFamInst )\nimport HscMain\nimport GhcMake\nimport DriverPipeline   ( compileOne' )\nimport GhcMonad\nimport TcRnMonad        ( finalSafeMode, fixSafeInstances, initIfaceTcRn )\nimport LoadIface        ( loadSysInterface )\nimport TcRnTypes\nimport Packages\nimport NameSet\nimport RdrName\nimport HsSyn\nimport Type     hiding( typeKind )\nimport TcType\nimport Id\nimport TysPrim          ( alphaTyVars )\nimport TyCon\nimport Class\nimport DataCon\nimport Name             hiding ( varName )\nimport Avail\nimport InstEnv\nimport FamInstEnv ( FamInst )\nimport SrcLoc\nimport CoreSyn\nimport TidyPgm\nimport DriverPhases     ( Phase(..), isHaskellSrcFilename )\nimport Finder\nimport HscTypes\nimport CmdLineParser\nimport DynFlags hiding (WarnReason(..))\nimport SysTools\nimport SysTools.BaseDir\nimport Annotations\nimport Module\nimport Panic\nimport Platform\nimport Bag              ( listToBag )\nimport ErrUtils\nimport MonadUtils\nimport Util\nimport StringBuffer\nimport Outputable\nimport BasicTypes\nimport Maybes           ( expectJust )\nimport FastString\nimport qualified Parser\nimport Lexer\nimport ApiAnnotation\nimport qualified GHC.LanguageExtensions as LangExt\nimport NameEnv\nimport CoreFVs          ( orphNamesOfFamInst )\nimport FamInstEnv       ( famInstEnvElts )\nimport TcRnDriver\nimport Inst\nimport FamInst\nimport FileCleanup\n\nimport Data.Foldable\nimport qualified Data.Map.Strict as Map\nimport Data.Set (Set)\nimport qualified Data.Sequence as Seq\nimport System.Directory ( doesFileExist )\nimport Data.Maybe\nimport Data.Time\nimport Data.Typeable    ( Typeable )\nimport Data.Word        ( Word8 )\nimport Control.Monad\nimport System.Exit      ( exitWith, ExitCode(..) )\nimport Exception\nimport Data.IORef\nimport System.FilePath\n\n\n-- %************************************************************************\n-- %*                                                                      *\n--             Initialisation: exception handlers\n-- %*                                                                      *\n-- %************************************************************************\n\n\n-- | Install some default exception handlers and run the inner computation.\n-- Unless you want to handle exceptions yourself, you should wrap this around\n-- the top level of your program.  The default handlers output the error\n-- message(s) to stderr and exit cleanly.\ndefaultErrorHandler :: (ExceptionMonad m)\n                    => FatalMessager -> FlushOut -> m a -> m a\ndefaultErrorHandler fm (FlushOut flushOut) inner =\n  -- top-level exception handler: any unrecognised exception is a compiler bug.\n  ghandle (\\exception -> liftIO $ do\n           flushOut\n           case fromException exception of\n                -- an IO exception probably isn't our fault, so don't panic\n                Just (ioe :: IOException) ->\n                  fatalErrorMsg'' fm (show ioe)\n                _ -> case fromException exception of\n                     Just UserInterrupt ->\n                         -- Important to let this one propagate out so our\n                         -- calling process knows we were interrupted by ^C\n                         liftIO $ throwIO UserInterrupt\n                     Just StackOverflow ->\n                         fatalErrorMsg'' fm \"stack overflow: use +RTS -K<size> to increase it\"\n                     _ -> case fromException exception of\n                          Just (ex :: ExitCode) -> liftIO $ throwIO ex\n                          _ ->\n                              fatalErrorMsg'' fm\n                                  (show (Panic (show exception)))\n           exitWith (ExitFailure 1)\n         ) $\n\n  -- error messages propagated as exceptions\n  handleGhcException\n            (\\ge -> liftIO $ do\n                flushOut\n                case ge of\n                     Signal _ -> exitWith (ExitFailure 1)\n                     _ -> do fatalErrorMsg'' fm (show ge)\n                             exitWith (ExitFailure 1)\n            ) $\n  inner\n\n-- | This function is no longer necessary, cleanup is now done by\n-- runGhc/runGhcT.\n{-# DEPRECATED defaultCleanupHandler \"Cleanup is now done by runGhc/runGhcT\" #-}\ndefaultCleanupHandler :: (ExceptionMonad m) => DynFlags -> m a -> m a\ndefaultCleanupHandler _ m = m\n where _warning_suppression = m `gonException` undefined\n\n\n-- %************************************************************************\n-- %*                                                                      *\n--             The Ghc Monad\n-- %*                                                                      *\n-- %************************************************************************\n\n-- | Run function for the 'Ghc' monad.\n--\n-- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call\n-- to this function will create a new session which should not be shared among\n-- several threads.\n--\n-- Any errors not handled inside the 'Ghc' action are propagated as IO\n-- exceptions.\n\nrunGhc :: Maybe FilePath  -- ^ See argument to 'initGhcMonad'.\n       -> Ghc a           -- ^ The action to perform.\n       -> IO a\nrunGhc mb_top_dir ghc = do\n  ref <- newIORef (panic \"empty session\")\n  let session = Session ref\n  flip unGhc session $ withSignalHandlers $ do -- catch ^C\n    initGhcMonad mb_top_dir\n    withCleanupSession ghc\n\n-- | Run function for 'GhcT' monad transformer.\n--\n-- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call\n-- to this function will create a new session which should not be shared among\n-- several threads.\n\nrunGhcT :: ExceptionMonad m =>\n           Maybe FilePath  -- ^ See argument to 'initGhcMonad'.\n        -> GhcT m a        -- ^ The action to perform.\n        -> m a\nrunGhcT mb_top_dir ghct = do\n  ref <- liftIO $ newIORef (panic \"empty session\")\n  let session = Session ref\n  flip unGhcT session $ withSignalHandlers $ do -- catch ^C\n    initGhcMonad mb_top_dir\n    withCleanupSession ghct\n\nwithCleanupSession :: GhcMonad m => m a -> m a\nwithCleanupSession ghc = ghc `gfinally` cleanup\n  where\n   cleanup = do\n      hsc_env <- getSession\n      let dflags = hsc_dflags hsc_env\n      liftIO $ do\n          cleanTempFiles dflags\n          cleanTempDirs dflags\n          stopIServ hsc_env -- shut down the IServ\n          --  exceptions will be blocked while we clean the temporary files,\n          -- so there shouldn't be any difficulty if we receive further\n          -- signals.\n\n-- | Initialise a GHC session.\n--\n-- If you implement a custom 'GhcMonad' you must call this function in the\n-- monad run function.  It will initialise the session variable and clear all\n-- warnings.\n--\n-- The first argument should point to the directory where GHC's library files\n-- reside.  More precisely, this should be the output of @ghc --print-libdir@\n-- of the version of GHC the module using this API is compiled with.  For\n-- portability, you should use the @ghc-paths@ package, available at\n-- <http://hackage.haskell.org/package/ghc-paths>.\n\ninitGhcMonad :: GhcMonad m => Maybe FilePath -> m ()\ninitGhcMonad mb_top_dir\n  = do { env <- liftIO $\n                do { top_dir <- findTopDir mb_top_dir\n                   ; mySettings <- initSysTools top_dir\n                   ; myLlvmConfig <- initLlvmConfig top_dir\n                   ; dflags <- initDynFlags (defaultDynFlags mySettings myLlvmConfig)\n                   ; checkBrokenTablesNextToCode dflags\n                   ; setUnsafeGlobalDynFlags dflags\n                      -- c.f. DynFlags.parseDynamicFlagsFull, which\n                      -- creates DynFlags and sets the UnsafeGlobalDynFlags\n                   ; newHscEnv dflags }\n       ; setSession env }\n\n-- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which\n-- breaks tables-next-to-code in dynamically linked modules. This\n-- check should be more selective but there is currently no released\n-- version where this bug is fixed.\n-- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and\n-- https://ghc.haskell.org/trac/ghc/ticket/4210#comment:29\ncheckBrokenTablesNextToCode :: MonadIO m => DynFlags -> m ()\ncheckBrokenTablesNextToCode dflags\n  = do { broken <- checkBrokenTablesNextToCode' dflags\n       ; when broken\n         $ do { _ <- liftIO $ throwIO $ mkApiErr dflags invalidLdErr\n              ; liftIO $ fail \"unsupported linker\"\n              }\n       }\n  where\n    invalidLdErr = text \"Tables-next-to-code not supported on ARM\" <+>\n                   text \"when using binutils ld (please see:\" <+>\n                   text \"https://sourceware.org/bugzilla/show_bug.cgi?id=16177)\"\n\ncheckBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool\ncheckBrokenTablesNextToCode' dflags\n  | not (isARM arch)              = return False\n  | WayDyn `notElem` ways dflags  = return False\n  | not (tablesNextToCode dflags) = return False\n  | otherwise                     = do\n    linkerInfo <- liftIO $ getLinkerInfo dflags\n    case linkerInfo of\n      GnuLD _  -> return True\n      _        -> return False\n  where platform = targetPlatform dflags\n        arch = platformArch platform\n\n\n-- %************************************************************************\n-- %*                                                                      *\n--             Flags & settings\n-- %*                                                                      *\n-- %************************************************************************\n\n-- $DynFlags\n--\n-- The GHC session maintains two sets of 'DynFlags':\n--\n--   * The \"interactive\" @DynFlags@, which are used for everything\n--     related to interactive evaluation, including 'runStmt',\n--     'runDecls', 'exprType', 'lookupName' and so on (everything\n--     under \\\"Interactive evaluation\\\" in this module).\n--\n--   * The \"program\" @DynFlags@, which are used when loading\n--     whole modules with 'load'\n--\n-- 'setInteractiveDynFlags', 'getInteractiveDynFlags' work with the\n-- interactive @DynFlags@.\n--\n-- 'setProgramDynFlags', 'getProgramDynFlags' work with the\n-- program @DynFlags@.\n--\n-- 'setSessionDynFlags' sets both @DynFlags@, and 'getSessionDynFlags'\n-- retrieves the program @DynFlags@ (for backwards compatibility).\n\n\n-- | Updates both the interactive and program DynFlags in a Session.\n-- This also reads the package database (unless it has already been\n-- read), and prepares the compilers knowledge about packages.  It can\n-- be called again to load new packages: just add new package flags to\n-- (packageFlags dflags).\n--\n-- Returns a list of new packages that may need to be linked in using\n-- the dynamic linker (see 'linkPackages') as a result of new package\n-- flags.  If you are not doing linking or doing static linking, you\n-- can ignore the list of packages returned.\n--\nsetSessionDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]\nsetSessionDynFlags dflags = do\n  dflags' <- checkNewDynFlags dflags\n  (dflags'', preload) <- liftIO $ initPackages dflags'\n  modifySession $ \\h -> h{ hsc_dflags = dflags''\n                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags'' } }\n  invalidateModSummaryCache\n  return preload\n\n-- | Sets the program 'DynFlags'.  Note: this invalidates the internal\n-- cached module graph, causing more work to be done the next time\n-- 'load' is called.\nsetProgramDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]\nsetProgramDynFlags dflags = setProgramDynFlags_ True dflags\n\n-- | Set the action taken when the compiler produces a message.  This\n-- can also be accomplished using 'setProgramDynFlags', but using\n-- 'setLogAction' avoids invalidating the cached module graph.\nsetLogAction :: GhcMonad m => LogAction -> m ()\nsetLogAction action = do\n  dflags' <- getProgramDynFlags\n  void $ setProgramDynFlags_ False $\n    dflags' { log_action = action }\n\nsetProgramDynFlags_ :: GhcMonad m => Bool -> DynFlags -> m [InstalledUnitId]\nsetProgramDynFlags_ invalidate_needed dflags = do\n  dflags' <- checkNewDynFlags dflags\n  dflags_prev <- getProgramDynFlags\n  (dflags'', preload) <-\n    if (packageFlagsChanged dflags_prev dflags')\n       then liftIO $ initPackages dflags'\n       else return (dflags', [])\n  modifySession $ \\h -> h{ hsc_dflags = dflags'' }\n  when invalidate_needed $ invalidateModSummaryCache\n  return preload\n\n\n-- When changing the DynFlags, we want the changes to apply to future\n-- loads, but without completely discarding the program.  But the\n-- DynFlags are cached in each ModSummary in the hsc_mod_graph, so\n-- after a change to DynFlags, the changes would apply to new modules\n-- but not existing modules; this seems undesirable.\n--\n-- Furthermore, the GHC API client might expect that changing\n-- log_action would affect future compilation messages, but for those\n-- modules we have cached ModSummaries for, we'll continue to use the\n-- old log_action.  This is definitely wrong (#7478).\n--\n-- Hence, we invalidate the ModSummary cache after changing the\n-- DynFlags.  We do this by tweaking the date on each ModSummary, so\n-- that the next downsweep will think that all the files have changed\n-- and preprocess them again.  This won't necessarily cause everything\n-- to be recompiled, because by the time we check whether we need to\n-- recopmile a module, we'll have re-summarised the module and have a\n-- correct ModSummary.\n--\ninvalidateModSummaryCache :: GhcMonad m => m ()\ninvalidateModSummaryCache =\n  modifySession $ \\h -> h { hsc_mod_graph = mapMG inval (hsc_mod_graph h) }\n where\n  inval ms = ms { ms_hs_date = addUTCTime (-1) (ms_hs_date ms) }\n\n-- | Returns the program 'DynFlags'.\ngetProgramDynFlags :: GhcMonad m => m DynFlags\ngetProgramDynFlags = getSessionDynFlags\n\n-- | Set the 'DynFlags' used to evaluate interactive expressions.\n-- Note: this cannot be used for changes to packages.  Use\n-- 'setSessionDynFlags', or 'setProgramDynFlags' and then copy the\n-- 'pkgState' into the interactive @DynFlags@.\nsetInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()\nsetInteractiveDynFlags dflags = do\n  dflags' <- checkNewDynFlags dflags\n  dflags'' <- checkNewInteractiveDynFlags dflags'\n  modifySession $ \\h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags'' }}\n\n-- | Get the 'DynFlags' used to evaluate interactive expressions.\ngetInteractiveDynFlags :: GhcMonad m => m DynFlags\ngetInteractiveDynFlags = withSession $ \\h -> return (ic_dflags (hsc_IC h))\n\n\nparseDynamicFlags :: MonadIO m =>\n                     DynFlags -> [Located String]\n                  -> m (DynFlags, [Located String], [Warn])\nparseDynamicFlags = parseDynamicFlagsCmdLine\n\n-- | Checks the set of new DynFlags for possibly erroneous option\n-- combinations when invoking 'setSessionDynFlags' and friends, and if\n-- found, returns a fixed copy (if possible).\ncheckNewDynFlags :: MonadIO m => DynFlags -> m DynFlags\ncheckNewDynFlags dflags = do\n  -- See Note [DynFlags consistency]\n  let (dflags', warnings) = makeDynFlagsConsistent dflags\n  liftIO $ handleFlagWarnings dflags (map (Warn NoReason) warnings)\n  return dflags'\n\ncheckNewInteractiveDynFlags :: MonadIO m => DynFlags -> m DynFlags\ncheckNewInteractiveDynFlags dflags0 = do\n  -- We currently don't support use of StaticPointers in expressions entered on\n  -- the REPL. See #12356.\n  dflags1 <-\n      if xopt LangExt.StaticPointers dflags0\n      then do liftIO $ printOrThrowWarnings dflags0 $ listToBag\n                [mkPlainWarnMsg dflags0 interactiveSrcSpan\n                 $ text \"StaticPointers is not supported in GHCi interactive expressions.\"]\n              return $ xopt_unset dflags0 LangExt.StaticPointers\n      else return dflags0\n  return dflags1\n\n\n-- %************************************************************************\n-- %*                                                                      *\n--             Setting, getting, and modifying the targets\n-- %*                                                                      *\n-- %************************************************************************\n\n-- ToDo: think about relative vs. absolute file paths. And what\n-- happens when the current directory changes.\n\n-- | Sets the targets for this session.  Each target may be a module name\n-- or a filename.  The targets correspond to the set of root modules for\n-- the program\\/library.  Unloading the current program is achieved by\n-- setting the current set of targets to be empty, followed by 'load'.\nsetTargets :: GhcMonad m => [Target] -> m ()\nsetTargets targets = modifySession (\\h -> h{ hsc_targets = targets })\n\n-- | Returns the current set of targets\ngetTargets :: GhcMonad m => m [Target]\ngetTargets = withSession (return . hsc_targets)\n\n-- | Add another target.\naddTarget :: GhcMonad m => Target -> m ()\naddTarget target\n  = modifySession (\\h -> h{ hsc_targets = target : hsc_targets h })\n\n-- | Remove a target\nremoveTarget :: GhcMonad m => TargetId -> m ()\nremoveTarget target_id\n  = modifySession (\\h -> h{ hsc_targets = filter (hsc_targets h) })\n  where\n   filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]\n\n-- | Attempts to guess what Target a string refers to.  This function\n-- implements the @--make@/GHCi command-line syntax for filenames:\n--\n--   - if the string looks like a Haskell source filename, then interpret it\n--     as such\n--\n--   - if adding a .hs or .lhs suffix yields the name of an existing file,\n--     then use that\n--\n--   - otherwise interpret the string as a module name\n--\nguessTarget :: GhcMonad m => String -> Maybe Phase -> m Target\nguessTarget str (Just phase)\n   = return (Target (TargetFile str (Just phase)) True Nothing)\nguessTarget str Nothing\n   | isHaskellSrcFilename file\n   = return (target (TargetFile file Nothing))\n   | otherwise\n   = do exists <- liftIO $ doesFileExist hs_file\n        if exists\n           then return (target (TargetFile hs_file Nothing))\n           else do\n        exists <- liftIO $ doesFileExist lhs_file\n        if exists\n           then return (target (TargetFile lhs_file Nothing))\n           else do\n        if looksLikeModuleName file\n           then return (target (TargetModule (mkModuleName file)))\n           else do\n        dflags <- getDynFlags\n        liftIO $ throwGhcExceptionIO\n                 (ProgramError (showSDoc dflags $\n                 text \"target\" <+> quotes (text file) <+>\n                 text \"is not a module name or a source file\"))\n     where\n         (file,obj_allowed)\n                | '*':rest <- str = (rest, False)\n                | otherwise       = (str,  True)\n\n         hs_file  = file <.> \"hs\"\n         lhs_file = file <.> \"lhs\"\n\n         target tid = Target tid obj_allowed Nothing\n\n\n-- | Inform GHC that the working directory has changed.  GHC will flush\n-- its cache of module locations, since it may no longer be valid.\n--\n-- Note: Before changing the working directory make sure all threads running\n-- in the same session have stopped.  If you change the working directory,\n-- you should also unload the current program (set targets to empty,\n-- followed by load).\nworkingDirectoryChanged :: GhcMonad m => m ()\nworkingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)\n\n\n-- %************************************************************************\n-- %*                                                                      *\n--             Running phases one at a time\n-- %*                                                                      *\n-- %************************************************************************\n\nclass ParsedMod m where\n  modSummary   :: m -> ModSummary\n  parsedSource :: m -> ParsedSource\n\nclass ParsedMod m => TypecheckedMod m where\n  renamedSource     :: m -> Maybe RenamedSource\n  typecheckedSource :: m -> TypecheckedSource\n  moduleInfo        :: m -> ModuleInfo\n  tm_internals      :: m -> (TcGblEnv, ModDetails)\n        -- ToDo: improvements that could be made here:\n        --  if the module succeeded renaming but not typechecking,\n        --  we can still get back the GlobalRdrEnv and exports, so\n        --  perhaps the ModuleInfo should be split up into separate\n        --  fields.\n\nclass TypecheckedMod m => DesugaredMod m where\n  coreModule :: m -> ModGuts\n\n-- | The result of successful parsing.\ndata ParsedModule =\n  ParsedModule { pm_mod_summary   :: ModSummary\n               , pm_parsed_source :: ParsedSource\n               , pm_extra_src_files :: [FilePath]\n               , pm_annotations :: ApiAnns }\n               -- See Note [Api annotations] in ApiAnnotation.hs\n\ninstance ParsedMod ParsedModule where\n  modSummary m    = pm_mod_summary m\n  parsedSource m = pm_parsed_source m\n\n-- | The result of successful typechecking.  It also contains the parser\n--   result.\ndata TypecheckedModule =\n  TypecheckedModule { tm_parsed_module       :: ParsedModule\n                    , tm_renamed_source      :: Maybe RenamedSource\n                    , tm_typechecked_source  :: TypecheckedSource\n                    , tm_checked_module_info :: ModuleInfo\n                    , tm_internals_          :: (TcGblEnv, ModDetails)\n                    }\n\ninstance ParsedMod TypecheckedModule where\n  modSummary m   = modSummary (tm_parsed_module m)\n  parsedSource m = parsedSource (tm_parsed_module m)\n\ninstance TypecheckedMod TypecheckedModule where\n  renamedSource m     = tm_renamed_source m\n  typecheckedSource m = tm_typechecked_source m\n  moduleInfo m        = tm_checked_module_info m\n  tm_internals m      = tm_internals_ m\n\n-- | The result of successful desugaring (i.e., translation to core).  Also\n--  contains all the information of a typechecked module.\ndata DesugaredModule =\n  DesugaredModule { dm_typechecked_module :: TypecheckedModule\n                  , dm_core_module        :: ModGuts\n             }\n\ninstance ParsedMod DesugaredModule where\n  modSummary m   = modSummary (dm_typechecked_module m)\n  parsedSource m = parsedSource (dm_typechecked_module m)\n\ninstance TypecheckedMod DesugaredModule where\n  renamedSource m     = renamedSource (dm_typechecked_module m)\n  typecheckedSource m = typecheckedSource (dm_typechecked_module m)\n  moduleInfo m        = moduleInfo (dm_typechecked_module m)\n  tm_internals m      = tm_internals_ (dm_typechecked_module m)\n\ninstance DesugaredMod DesugaredModule where\n  coreModule m = dm_core_module m\n\ntype ParsedSource      = Located (HsModule GhcPs)\ntype RenamedSource     = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],\n                          Maybe LHsDocString)\ntype TypecheckedSource = LHsBinds GhcTc\n\n-- NOTE:\n--   - things that aren't in the output of the typechecker right now:\n--     - the export list\n--     - the imports\n--     - type signatures\n--     - type/data/newtype declarations\n--     - class declarations\n--     - instances\n--   - extra things in the typechecker's output:\n--     - default methods are turned into top-level decls.\n--     - dictionary bindings\n\n-- | Return the 'ModSummary' of a module with the given name.\n--\n-- The module must be part of the module graph (see 'hsc_mod_graph' and\n-- 'ModuleGraph').  If this is not the case, this function will throw a\n-- 'GhcApiError'.\n--\n-- This function ignores boot modules and requires that there is only one\n-- non-boot module with the given name.\ngetModSummary :: GhcMonad m => ModuleName -> m ModSummary\ngetModSummary mod = do\n   mg <- liftM hsc_mod_graph getSession\n   let mods_by_name = [ ms | ms <- mgModSummaries mg\n                      , ms_mod_name ms == mod\n                      , not (isBootSummary ms) ]\n   case mods_by_name of\n     [] -> do dflags <- getDynFlags\n              liftIO $ throwIO $ mkApiErr dflags (text \"Module not part of module graph\")\n     [ms] -> return ms\n     multiple -> do dflags <- getDynFlags\n                    liftIO $ throwIO $ mkApiErr dflags (text \"getModSummary is ambiguous: \" <+> ppr multiple)\n\n-- | Parse a module.\n--\n-- Throws a 'SourceError' on parse error.\nparseModule :: GhcMonad m => ModSummary -> m ParsedModule\nparseModule ms = do\n   hsc_env <- getSession\n   let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }\n   hpm <- liftIO $ hscParse hsc_env_tmp ms\n   return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm)\n                           (hpm_annotations hpm))\n               -- See Note [Api annotations] in ApiAnnotation.hs\n\n-- | Typecheck and rename a parsed module.\n--\n-- Throws a 'SourceError' if either fails.\ntypecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule\ntypecheckModule pmod = do\n let ms = modSummary pmod\n hsc_env <- getSession\n let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }\n (tc_gbl_env, rn_info)\n       <- liftIO $ hscTypecheckRename hsc_env_tmp ms $\n                      HsParsedModule { hpm_module = parsedSource pmod,\n                                       hpm_src_files = pm_extra_src_files pmod,\n                                       hpm_annotations = pm_annotations pmod }\n details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env\n safe    <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env\n\n return $\n     TypecheckedModule {\n       tm_internals_          = (tc_gbl_env, details),\n       tm_parsed_module       = pmod,\n       tm_renamed_source      = rn_info,\n       tm_typechecked_source  = tcg_binds tc_gbl_env,\n       tm_checked_module_info =\n         ModuleInfo {\n           minf_type_env  = md_types details,\n           minf_exports   = md_exports details,\n           minf_rdr_env   = Just (tcg_rdr_env tc_gbl_env),\n           minf_instances = fixSafeInstances safe $ md_insts details,\n           minf_iface     = Nothing,\n           minf_safe      = safe,\n           minf_modBreaks = emptyModBreaks\n         }}\n\n-- | Desugar a typechecked module.\ndesugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule\ndesugarModule tcm = do\n let ms = modSummary tcm\n let (tcg, _) = tm_internals tcm\n hsc_env <- getSession\n let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }\n guts <- liftIO $ hscDesugar hsc_env_tmp ms tcg\n return $\n     DesugaredModule {\n       dm_typechecked_module = tcm,\n       dm_core_module        = guts\n     }\n\n-- | Load a module.  Input doesn't need to be desugared.\n--\n-- A module must be loaded before dependent modules can be typechecked.  This\n-- always includes generating a 'ModIface' and, depending on the\n-- 'DynFlags.hscTarget', may also include code generation.\n--\n-- This function will always cause recompilation and will always overwrite\n-- previous compilation results (potentially files on disk).\n--\nloadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod\nloadModule tcm = do\n   let ms = modSummary tcm\n   let mod = ms_mod_name ms\n   let loc = ms_location ms\n   let (tcg, _details) = tm_internals tcm\n\n   mb_linkable <- case ms_obj_date ms of\n                     Just t | t > ms_hs_date ms  -> do\n                         l <- liftIO $ findObjectLinkable (ms_mod ms)\n                                                  (ml_obj_file loc) t\n                         return (Just l)\n                     _otherwise -> return Nothing\n\n   let source_modified | isNothing mb_linkable = SourceModified\n                       | otherwise             = SourceUnmodified\n                       -- we can't determine stability here\n\n   -- compile doesn't change the session\n   hsc_env <- getSession\n   mod_info <- liftIO $ compileOne' (Just tcg) Nothing\n                                    hsc_env ms 1 1 Nothing mb_linkable\n                                    source_modified\n\n   modifySession $ \\e -> e{ hsc_HPT = addToHpt (hsc_HPT e) mod mod_info }\n   return tcm\n\n\n-- %************************************************************************\n-- %*                                                                      *\n--             Dealing with Core\n-- %*                                                                      *\n-- %************************************************************************\n\n-- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for\n-- the 'GHC.compileToCoreModule' interface.\ndata CoreModule\n  = CoreModule {\n      -- | Module name\n      cm_module   :: !Module,\n      -- | Type environment for types declared in this module\n      cm_types    :: !TypeEnv,\n      -- | Declarations\n      cm_binds    :: CoreProgram,\n      -- | Safe Haskell mode\n      cm_safe     :: SafeHaskellMode\n    }\n\ninstance Outputable CoreModule where\n   ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb,\n                    cm_safe = sf})\n    = text \"%module\" <+> ppr mn <+> parens (ppr sf) <+> ppr te\n      $$ vcat (map ppr cb)\n\n-- | This is the way to get access to the Core bindings corresponding\n-- to a module. 'compileToCore' parses, typechecks, and\n-- desugars the module, then returns the resulting Core module (consisting of\n-- the module name, type declarations, and function declarations) if\n-- successful.\ncompileToCoreModule :: GhcMonad m => FilePath -> m CoreModule\ncompileToCoreModule = compileCore False\n\n-- | Like compileToCoreModule, but invokes the simplifier, so\n-- as to return simplified and tidied Core.\ncompileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule\ncompileToCoreSimplified = compileCore True\n\ncompileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule\ncompileCore simplify fn = do\n   -- First, set the target to the desired filename\n   target <- guessTarget fn Nothing\n   addTarget target\n   _ <- load LoadAllTargets\n   -- Then find dependencies\n   modGraph <- depanal [] True\n   case find ((== fn) . msHsFilePath) (mgModSummaries modGraph) of\n     Just modSummary -> do\n       -- Now we have the module name;\n       -- parse, typecheck and desugar the module\n       (tcg, mod_guts) <- -- TODO: space leaky: call hsc* directly?\n         do tm <- typecheckModule =<< parseModule modSummary\n            let tcg = fst (tm_internals tm)\n            (,) tcg . coreModule <$> desugarModule tm\n       liftM (gutsToCoreModule (mg_safe_haskell mod_guts)) $\n         if simplify\n          then do\n             -- If simplify is true: simplify (hscSimplify), then tidy\n             -- (tidyProgram).\n             hsc_env <- getSession\n             simpl_guts <- liftIO $ do\n               plugins <- readIORef (tcg_th_coreplugins tcg)\n               hscSimplify hsc_env plugins mod_guts\n             tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts\n             return $ Left tidy_guts\n          else\n             return $ Right mod_guts\n\n     Nothing -> panic \"compileToCoreModule: target FilePath not found in\\\n                           module dependency graph\"\n  where -- two versions, based on whether we simplify (thus run tidyProgram,\n        -- which returns a (CgGuts, ModDetails) pair, or not (in which case\n        -- we just have a ModGuts.\n        gutsToCoreModule :: SafeHaskellMode\n                         -> Either (CgGuts, ModDetails) ModGuts\n                         -> CoreModule\n        gutsToCoreModule safe_mode (Left (cg, md)) = CoreModule {\n          cm_module = cg_module cg,\n          cm_types  = md_types md,\n          cm_binds  = cg_binds cg,\n          cm_safe   = safe_mode\n        }\n        gutsToCoreModule safe_mode (Right mg) = CoreModule {\n          cm_module  = mg_module mg,\n          cm_types   = typeEnvFromEntities (bindersOfBinds (mg_binds mg))\n                                           (mg_tcs mg)\n                                           (mg_fam_insts mg),\n          cm_binds   = mg_binds mg,\n          cm_safe    = safe_mode\n         }\n\n-- %************************************************************************\n-- %*                                                                      *\n--             Inspecting the session\n-- %*                                                                      *\n-- %************************************************************************\n\n-- | Get the module dependency graph.\ngetModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary\ngetModuleGraph = liftM hsc_mod_graph getSession\n\n-- | Return @True@ <==> module is loaded.\nisLoaded :: GhcMonad m => ModuleName -> m Bool\nisLoaded m = withSession $ \\hsc_env ->\n  return $! isJust (lookupHpt (hsc_HPT hsc_env) m)\n\n-- | Return the bindings for the current interactive session.\ngetBindings :: GhcMonad m => m [TyThing]\ngetBindings = withSession $ \\hsc_env ->\n    return $ icInScopeTTs $ hsc_IC hsc_env\n\n-- | Return the instances for the current interactive session.\ngetInsts :: GhcMonad m => m ([ClsInst], [FamInst])\ngetInsts = withSession $ \\hsc_env ->\n    return $ ic_instances (hsc_IC hsc_env)\n\ngetPrintUnqual :: GhcMonad m => m PrintUnqualified\ngetPrintUnqual = withSession $ \\hsc_env ->\n  return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))\n\n-- | Container for information about a 'Module'.\ndata ModuleInfo = ModuleInfo {\n        minf_type_env  :: TypeEnv,\n        minf_exports   :: [AvailInfo],\n        minf_rdr_env   :: Maybe GlobalRdrEnv,   -- Nothing for a compiled/package mod\n        minf_instances :: [ClsInst],\n        minf_iface     :: Maybe ModIface,\n        minf_safe      :: SafeHaskellMode,\n        minf_modBreaks :: ModBreaks\n  }\n        -- We don't want HomeModInfo here, because a ModuleInfo applies\n        -- to package modules too.\n\n-- | Request information about a loaded 'Module'\ngetModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X\ngetModuleInfo mdl = withSession $ \\hsc_env -> do\n  let mg = hsc_mod_graph hsc_env\n  if mgElemModule mg mdl\n        then liftIO $ getHomeModuleInfo hsc_env mdl\n        else do\n  {- if isHomeModule (hsc_dflags hsc_env) mdl\n        then return Nothing\n        else -} liftIO $ getPackageModuleInfo hsc_env mdl\n   -- ToDo: we don't understand what the following comment means.\n   --    (SDM, 19/7/2011)\n   -- getPackageModuleInfo will attempt to find the interface, so\n   -- we don't want to call it for a home module, just in case there\n   -- was a problem loading the module and the interface doesn't\n   -- exist... hence the isHomeModule test here.  (ToDo: reinstate)\n\ngetPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)\ngetPackageModuleInfo hsc_env mdl\n  = do  eps <- hscEPS hsc_env\n        iface <- hscGetModuleInterface hsc_env mdl\n        let\n            avails = mi_exports iface\n            pte    = eps_PTE eps\n            tys    = [ ty | name <- concatMap availNames avails,\n                            Just ty <- [lookupTypeEnv pte name] ]\n        --\n        return (Just (ModuleInfo {\n                        minf_type_env  = mkTypeEnv tys,\n                        minf_exports   = avails,\n                        minf_rdr_env   = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,\n                        minf_instances = error \"getModuleInfo: instances for package module unimplemented\",\n                        minf_iface     = Just iface,\n                        minf_safe      = getSafeMode $ mi_trust iface,\n                        minf_modBreaks = emptyModBreaks\n                }))\n\ngetHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)\ngetHomeModuleInfo hsc_env mdl =\n  case lookupHpt (hsc_HPT hsc_env) (moduleName mdl) of\n    Nothing  -> return Nothing\n    Just hmi -> do\n      let details = hm_details hmi\n          iface   = hm_iface hmi\n      return (Just (ModuleInfo {\n                        minf_type_env  = md_types details,\n                        minf_exports   = md_exports details,\n                        minf_rdr_env   = mi_globals $! hm_iface hmi,\n                        minf_instances = md_insts details,\n                        minf_iface     = Just iface,\n                        minf_safe      = getSafeMode $ mi_trust iface\n                       ,minf_modBreaks = getModBreaks hmi\n                        }))\n\n-- | The list of top-level entities defined in a module\nmodInfoTyThings :: ModuleInfo -> [TyThing]\nmodInfoTyThings minf = typeEnvElts (minf_type_env minf)\n\nmodInfoTopLevelScope :: ModuleInfo -> Maybe [Name]\nmodInfoTopLevelScope minf\n  = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)\n\nmodInfoExports :: ModuleInfo -> [Name]\nmodInfoExports minf = concatMap availNames $! minf_exports minf\n\nmodInfoExportsWithSelectors :: ModuleInfo -> [Name]\nmodInfoExportsWithSelectors minf = concatMap availNamesWithSelectors $! minf_exports minf\n\n-- | Returns the instances defined by the specified module.\n-- Warning: currently unimplemented for package modules.\nmodInfoInstances :: ModuleInfo -> [ClsInst]\nmodInfoInstances = minf_instances\n\nmodInfoIsExportedName :: ModuleInfo -> Name -> Bool\nmodInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf))\n\nmkPrintUnqualifiedForModule :: GhcMonad m =>\n                               ModuleInfo\n                            -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X\nmkPrintUnqualifiedForModule minf = withSession $ \\hsc_env -> do\n  return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))\n\nmodInfoLookupName :: GhcMonad m =>\n                     ModuleInfo -> Name\n                  -> m (Maybe TyThing) -- XXX: returns a Maybe X\nmodInfoLookupName minf name = withSession $ \\hsc_env -> do\n   case lookupTypeEnv (minf_type_env minf) name of\n     Just tyThing -> return (Just tyThing)\n     Nothing      -> do\n       eps <- liftIO $ readIORef (hsc_EPS hsc_env)\n       return $! lookupType (hsc_dflags hsc_env)\n                            (hsc_HPT hsc_env) (eps_PTE eps) name\n\nmodInfoIface :: ModuleInfo -> Maybe ModIface\nmodInfoIface = minf_iface\n\n-- | Retrieve module safe haskell mode\nmodInfoSafe :: ModuleInfo -> SafeHaskellMode\nmodInfoSafe = minf_safe\n\nmodInfoModBreaks :: ModuleInfo -> ModBreaks\nmodInfoModBreaks = minf_modBreaks\n\nisDictonaryId :: Id -> Bool\nisDictonaryId id\n  = case tcSplitSigmaTy (idType id) of {\n      (_tvs, _theta, tau) -> isDictTy tau }\n\n-- | Looks up a global name: that is, any top-level name in any\n-- visible module.  Unlike 'lookupName', lookupGlobalName does not use\n-- the interactive context, and therefore does not require a preceding\n-- 'setContext'.\nlookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)\nlookupGlobalName name = withSession $ \\hsc_env -> do\n   liftIO $ lookupTypeHscEnv hsc_env name\n\nfindGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]\nfindGlobalAnns deserialize target = withSession $ \\hsc_env -> do\n    ann_env <- liftIO $ prepareAnnotations hsc_env Nothing\n    return (findAnns deserialize ann_env target)\n\n-- | get the GlobalRdrEnv for a session\ngetGRE :: GhcMonad m => m GlobalRdrEnv\ngetGRE = withSession $ \\hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)\n\n-- | Retrieve all type and family instances in the environment, indexed\n-- by 'Name'. Each name's lists will contain every instance in which that name\n-- is mentioned in the instance head.\ngetNameToInstancesIndex :: GhcMonad m\n  => [Module]        -- ^ visible modules. An orphan instance will be returned\n                     -- if it is visible from at least one module in the list.\n  -> Maybe [Module]  -- ^ modules to load. If this is not specified, we load\n                     -- modules for everything that is in scope unqualified.\n  -> m (Messages, Maybe (NameEnv ([ClsInst], [FamInst])))\ngetNameToInstancesIndex visible_mods mods_to_load = do\n  hsc_env <- getSession\n  liftIO $ runTcInteractive hsc_env $\n    do { case mods_to_load of\n           Nothing -> loadUnqualIfaces hsc_env (hsc_IC hsc_env)\n           Just mods ->\n             let doc = text \"Need interface for reporting instances in scope\"\n             in initIfaceTcRn $ mapM_ (loadSysInterface doc) mods\n\n       ; InstEnvs {ie_global, ie_local} <- tcGetInstEnvs\n       ; let visible_mods' = mkModuleSet visible_mods\n       ; (pkg_fie, home_fie) <- tcGetFamInstEnvs\n       -- We use Data.Sequence.Seq because we are creating left associated\n       -- mappends.\n       -- cls_index and fam_index below are adapted from TcRnDriver.lookupInsts\n       ; let cls_index = Map.fromListWith mappend\n                 [ (n, Seq.singleton ispec)\n                 | ispec <- instEnvElts ie_local ++ instEnvElts ie_global\n                 , instIsVisible visible_mods' ispec\n                 , n <- nameSetElemsStable $ orphNamesOfClsInst ispec\n                 ]\n       ; let fam_index = Map.fromListWith mappend\n                 [ (n, Seq.singleton fispec)\n                 | fispec <- famInstEnvElts home_fie ++ famInstEnvElts pkg_fie\n                 , n <- nameSetElemsStable $ orphNamesOfFamInst fispec\n                 ]\n       ; return $ mkNameEnv $\n           [ (nm, (toList clss, toList fams))\n           | (nm, (clss, fams)) <- Map.toList $ Map.unionWith mappend\n               (fmap (,Seq.empty) cls_index)\n               (fmap (Seq.empty,) fam_index)\n           ] }\n\n-- -----------------------------------------------------------------------------\n\n{- ToDo: Move the primary logic here to compiler/main/Packages.hs\n-- | Return all /external/ modules available in the package database.\n-- Modules from the current session (i.e., from the 'HomePackageTable') are\n-- not included.  This includes module names which are reexported by packages.\npackageDbModules :: GhcMonad m =>\n                    Bool  -- ^ Only consider exposed packages.\n                 -> m [Module]\npackageDbModules only_exposed = do\n   dflags <- getSessionDynFlags\n   let pkgs = eltsUFM (pkgIdMap (pkgState dflags))\n   return $\n     [ mkModule pid modname\n     | p <- pkgs\n     , not only_exposed || exposed p\n     , let pid = packageConfigId p\n     , modname <- exposedModules p\n               ++ map exportName (reexportedModules p) ]\n               -}\n\n-- -----------------------------------------------------------------------------\n-- Misc exported utils\n\ndataConType :: DataCon -> Type\ndataConType dc = idType (dataConWrapId dc)\n\n-- | print a 'NamedThing', adding parentheses if the name is an operator.\npprParenSymName :: NamedThing a => a -> SDoc\npprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))\n\n-- ----------------------------------------------------------------------------\n\n\n-- ToDo:\n--   - Data and Typeable instances for HsSyn.\n\n-- ToDo: check for small transformations that happen to the syntax in\n-- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)\n\n-- ToDo: maybe use TH syntax instead of IfaceSyn?  There's already a way\n-- to get from TyCons, Ids etc. to TH syntax (reify).\n\n-- :browse will use either lm_toplev or inspect lm_interface, depending\n-- on whether the module is interpreted or not.\n\n\n-- Extract the filename, stringbuffer content and dynflags associed to a module\n--\n-- XXX: Explain pre-conditions\ngetModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)\ngetModuleSourceAndFlags mod = do\n  m <- getModSummary (moduleName mod)\n  case ml_hs_file $ ms_location m of\n    Nothing -> do dflags <- getDynFlags\n                  liftIO $ throwIO $ mkApiErr dflags (text \"No source available for module \" <+> ppr mod)\n    Just sourceFile -> do\n        source <- liftIO $ hGetStringBuffer sourceFile\n        return (sourceFile, source, ms_hspp_opts m)\n\n\n-- | Return module source as token stream, including comments.\n--\n-- The module must be in the module graph and its source must be available.\n-- Throws a 'HscTypes.SourceError' on parse error.\ngetTokenStream :: GhcMonad m => Module -> m [Located Token]\ngetTokenStream mod = do\n  (sourceFile, source, flags) <- getModuleSourceAndFlags mod\n  let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1\n  case lexTokenStream source startLoc flags of\n    POk _ ts  -> return ts\n    PFailed pst ->\n        do dflags <- getDynFlags\n           throwErrors (getErrorMessages pst dflags)\n\n-- | Give even more information on the source than 'getTokenStream'\n-- This function allows reconstructing the source completely with\n-- 'showRichTokenStream'.\ngetRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]\ngetRichTokenStream mod = do\n  (sourceFile, source, flags) <- getModuleSourceAndFlags mod\n  let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1\n  case lexTokenStream source startLoc flags of\n    POk _ ts -> return $ addSourceToTokens startLoc source ts\n    PFailed pst ->\n        do dflags <- getDynFlags\n           throwErrors (getErrorMessages pst dflags)\n\n-- | Given a source location and a StringBuffer corresponding to this\n-- location, return a rich token stream with the source associated to the\n-- tokens.\naddSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token]\n                  -> [(Located Token, String)]\naddSourceToTokens _ _ [] = []\naddSourceToTokens loc buf (t@(dL->L span _) : ts)\n    = case span of\n      UnhelpfulSpan _ -> (t,\"\") : addSourceToTokens loc buf ts\n      RealSrcSpan s   -> (t,str) : addSourceToTokens newLoc newBuf ts\n        where\n          (newLoc, newBuf, str) = go \"\" loc buf\n          start = realSrcSpanStart s\n          end = realSrcSpanEnd s\n          go acc loc buf | loc < start = go acc nLoc nBuf\n                         | start <= loc && loc < end = go (ch:acc) nLoc nBuf\n                         | otherwise = (loc, buf, reverse acc)\n              where (ch, nBuf) = nextChar buf\n                    nLoc = advanceSrcLoc loc ch\n\n\n-- | Take a rich token stream such as produced from 'getRichTokenStream' and\n-- return source code almost identical to the original code (except for\n-- insignificant whitespace.)\nshowRichTokenStream :: [(Located Token, String)] -> String\nshowRichTokenStream ts = go startLoc ts \"\"\n    where sourceFile = getFile $ map (getLoc . fst) ts\n          getFile [] = panic \"showRichTokenStream: No source file found\"\n          getFile (UnhelpfulSpan _ : xs) = getFile xs\n          getFile (RealSrcSpan s : _) = srcSpanFile s\n          startLoc = mkRealSrcLoc sourceFile 1 1\n          go _ [] = id\n          go loc ((dL->L span _, str):ts)\n              = case span of\n                UnhelpfulSpan _ -> go loc ts\n                RealSrcSpan s\n                 | locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++)\n                                       . (str ++)\n                                       . go tokEnd ts\n                 | otherwise -> ((replicate (tokLine - locLine) '\\n') ++)\n                               . ((replicate (tokCol - 1) ' ') ++)\n                              . (str ++)\n                              . go tokEnd ts\n                  where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)\n                        (tokLine, tokCol) = (srcSpanStartLine s, srcSpanStartCol s)\n                        tokEnd = realSrcSpanEnd s\n\n-- -----------------------------------------------------------------------------\n-- Interactive evaluation\n\n-- | Takes a 'ModuleName' and possibly a 'UnitId', and consults the\n-- filesystem and package database to find the corresponding 'Module',\n-- using the algorithm that is used for an @import@ declaration.\nfindModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module\nfindModule mod_name maybe_pkg = withSession $ \\hsc_env -> do\n  let\n    dflags   = hsc_dflags hsc_env\n    this_pkg = thisPackage dflags\n  --\n  case maybe_pkg of\n    Just pkg | fsToUnitId pkg /= this_pkg && pkg /= fsLit \"this\" -> liftIO $ do\n      res <- findImportedModule hsc_env mod_name maybe_pkg\n      case res of\n        Found _ m -> return m\n        err       -> throwOneError $ noModError dflags noSrcSpan mod_name err\n    _otherwise -> do\n      home <- lookupLoadedHomeModule mod_name\n      case home of\n        Just m  -> return m\n        Nothing -> liftIO $ do\n           res <- findImportedModule hsc_env mod_name maybe_pkg\n           case res of\n             Found loc m | moduleUnitId m /= this_pkg -> return m\n                         | otherwise -> modNotLoadedError dflags m loc\n             err -> throwOneError $ noModError dflags noSrcSpan mod_name err\n\nmodNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a\nmodNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $\n   text \"module is not loaded:\" <+>\n   quotes (ppr (moduleName m)) <+>\n   parens (text (expectJust \"modNotLoadedError\" (ml_hs_file loc)))\n\n-- | Like 'findModule', but differs slightly when the module refers to\n-- a source file, and the file has not been loaded via 'load'.  In\n-- this case, 'findModule' will throw an error (module not loaded),\n-- but 'lookupModule' will check to see whether the module can also be\n-- found in a package, and if so, that package 'Module' will be\n-- returned.  If not, the usual module-not-found error will be thrown.\n--\nlookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module\nlookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)\nlookupModule mod_name Nothing = withSession $ \\hsc_env -> do\n  home <- lookupLoadedHomeModule mod_name\n  case home of\n    Just m  -> return m\n    Nothing -> liftIO $ do\n      res <- findExposedPackageModule hsc_env mod_name Nothing\n      case res of\n        Found _ m -> return m\n        err       -> throwOneError $ noModError (hsc_dflags hsc_env) noSrcSpan mod_name err\n\nlookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)\nlookupLoadedHomeModule mod_name = withSession $ \\hsc_env ->\n  case lookupHpt (hsc_HPT hsc_env) mod_name of\n    Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))\n    _not_a_home_module -> return Nothing\n\n-- | Check that a module is safe to import (according to Safe Haskell).\n--\n-- We return True to indicate the import is safe and False otherwise\n-- although in the False case an error may be thrown first.\nisModuleTrusted :: GhcMonad m => Module -> m Bool\nisModuleTrusted m = withSession $ \\hsc_env ->\n    liftIO $ hscCheckSafe hsc_env m noSrcSpan\n\n-- | Return if a module is trusted and the pkgs it depends on to be trusted.\nmoduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set InstalledUnitId)\nmoduleTrustReqs m = withSession $ \\hsc_env ->\n    liftIO $ hscGetSafe hsc_env m noSrcSpan\n\n-- | Set the monad GHCi lifts user statements into.\n--\n-- Checks that a type (in string form) is an instance of the\n-- @GHC.GHCi.GHCiSandboxIO@ type class. Sets it to be the GHCi monad if it is,\n-- throws an error otherwise.\nsetGHCiMonad :: GhcMonad m => String -> m ()\nsetGHCiMonad name = withSession $ \\hsc_env -> do\n    ty <- liftIO $ hscIsGHCiMonad hsc_env name\n    modifySession $ \\s ->\n        let ic = (hsc_IC s) { ic_monad = ty }\n        in s { hsc_IC = ic }\n\n-- | Get the monad GHCi lifts user statements into.\ngetGHCiMonad :: GhcMonad m => m Name\ngetGHCiMonad = fmap (ic_monad . hsc_IC) getSession\n\ngetHistorySpan :: GhcMonad m => History -> m SrcSpan\ngetHistorySpan h = withSession $ \\hsc_env ->\n    return $ InteractiveEval.getHistorySpan hsc_env h\n\nobtainTermFromVal :: GhcMonad m => Int ->  Bool -> Type -> a -> m Term\nobtainTermFromVal bound force ty a = withSession $ \\hsc_env ->\n    liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a\n\nobtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term\nobtainTermFromId bound force id = withSession $ \\hsc_env ->\n    liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id\n\n\n-- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any\n-- entity known to GHC, including 'Name's defined using 'runStmt'.\nlookupName :: GhcMonad m => Name -> m (Maybe TyThing)\nlookupName name =\n     withSession $ \\hsc_env ->\n       liftIO $ hscTcRcLookupName hsc_env name\n\n-- -----------------------------------------------------------------------------\n-- Pure API\n\n-- | A pure interface to the module parser.\n--\nparser :: String         -- ^ Haskell module source text (full Unicode is supported)\n       -> DynFlags       -- ^ the flags\n       -> FilePath       -- ^ the filename (for source locations)\n       -> (WarningMessages, Either ErrorMessages (Located (HsModule GhcPs)))\n\nparser str dflags filename =\n   let\n       loc  = mkRealSrcLoc (mkFastString filename) 1 1\n       buf  = stringToStringBuffer str\n   in\n   case unP Parser.parseModule (mkPState dflags buf loc) of\n\n     PFailed pst ->\n         let (warns,errs) = getMessages pst dflags in\n         (warns, Left errs)\n\n     POk pst rdr_module ->\n         let (warns,_) = getMessages pst dflags in\n         (warns, Right rdr_module)\n", "num_lines": 1563}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-}\n{-# LANGUAGE NamedFieldPuns #-}\n\n-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 2011\n--\n-- This module implements multi-module compilation, and is used\n-- by --make and GHCi.\n--\n-- -----------------------------------------------------------------------------\nmodule GhcMake(\n        depanal,\n        load, load', LoadHowMuch(..),\n\n        topSortModuleGraph,\n\n        ms_home_srcimps, ms_home_imps,\n\n        IsBoot(..),\n        summariseModule,\n        hscSourceToIsBoot,\n        findExtraSigImports,\n        implicitRequirements,\n\n        noModError, cyclicModuleErr,\n        moduleGraphNodes, SummaryNode\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport qualified Linker         ( unload )\n\nimport DriverPhases\nimport DriverPipeline\nimport DynFlags\nimport ErrUtils\nimport Finder\nimport GhcMonad\nimport HeaderInfo\nimport HscTypes\nimport Module\nimport TcIface          ( typecheckIface )\nimport TcRnMonad        ( initIfaceCheck )\nimport HscMain\n\nimport Bag              ( listToBag )\nimport BasicTypes\nimport Digraph\nimport Exception        ( tryIO, gbracket, gfinally )\nimport FastString\nimport Maybes           ( expectJust )\nimport Name\nimport MonadUtils       ( allM, MonadIO )\nimport Outputable\nimport Panic\nimport SrcLoc\nimport StringBuffer\nimport UniqFM\nimport UniqDSet\nimport TcBackpack\nimport Packages\nimport UniqSet\nimport Util\nimport qualified GHC.LanguageExtensions as LangExt\nimport NameEnv\nimport FileCleanup\n\nimport Data.Either ( rights, partitionEithers )\nimport qualified Data.Map as Map\nimport Data.Map (Map)\nimport qualified Data.Set as Set\nimport qualified FiniteMap as Map ( insertListWith )\n\nimport Control.Concurrent ( forkIOWithUnmask, killThread )\nimport qualified GHC.Conc as CC\nimport Control.Concurrent.MVar\nimport Control.Concurrent.QSem\nimport Control.Exception\nimport Control.Monad\nimport Data.IORef\nimport Data.List\nimport qualified Data.List as List\nimport Data.Foldable (toList)\nimport Data.Maybe\nimport Data.Ord ( comparing )\nimport Data.Time\nimport System.Directory\nimport System.FilePath\nimport System.IO        ( fixIO )\nimport System.IO.Error  ( isDoesNotExistError )\n\nimport GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )\n\nlabel_self :: String -> IO ()\nlabel_self thread_name = do\n    self_tid <- CC.myThreadId\n    CC.labelThread self_tid thread_name\n\n-- -----------------------------------------------------------------------------\n-- Loading the program\n\n-- | Perform a dependency analysis starting from the current targets\n-- and update the session with the new module graph.\n--\n-- Dependency analysis entails parsing the @import@ directives and may\n-- therefore require running certain preprocessors.\n--\n-- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.\n-- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the\n-- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want\n-- changes to the 'DynFlags' to take effect you need to call this function\n-- again.\n--\ndepanal :: GhcMonad m =>\n           [ModuleName]  -- ^ excluded modules\n        -> Bool          -- ^ allow duplicate roots\n        -> m ModuleGraph\ndepanal excluded_mods allow_dup_roots = do\n  hsc_env <- getSession\n  let\n         dflags  = hsc_dflags hsc_env\n         targets = hsc_targets hsc_env\n         old_graph = hsc_mod_graph hsc_env\n\n  withTiming (pure dflags) (text \"Chasing dependencies\") (const ()) $ do\n    liftIO $ debugTraceMsg dflags 2 (hcat [\n              text \"Chasing modules from: \",\n              hcat (punctuate comma (map pprTarget targets))])\n\n    -- Home package modules may have been moved or deleted, and new\n    -- source files may have appeared in the home package that shadow\n    -- external package modules, so we have to discard the existing\n    -- cached finder data.\n    liftIO $ flushFinderCaches hsc_env\n\n    mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph)\n                                     excluded_mods allow_dup_roots\n    mod_summaries <- reportImportErrors mod_summariesE\n\n    let mod_graph = mkModuleGraph mod_summaries\n\n    warnMissingHomeModules hsc_env mod_graph\n\n    setSession hsc_env { hsc_mod_graph = mod_graph }\n    return mod_graph\n\n-- Note [Missing home modules]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Sometimes user doesn't want GHC to pick up modules, not explicitly listed\n-- in a command line. For example, cabal may want to enable this warning\n-- when building a library, so that GHC warns user about modules, not listed\n-- neither in `exposed-modules`, nor in `other-modules`.\n--\n-- Here \"home module\" means a module, that doesn't come from an other package.\n--\n-- For example, if GHC is invoked with modules \"A\" and \"B\" as targets,\n-- but \"A\" imports some other module \"C\", then GHC will issue a warning\n-- about module \"C\" not being listed in a command line.\n--\n-- The warning in enabled by `-Wmissing-home-modules`. See Trac #13129\nwarnMissingHomeModules :: GhcMonad m => HscEnv -> ModuleGraph -> m ()\nwarnMissingHomeModules hsc_env mod_graph =\n    when (wopt Opt_WarnMissingHomeModules dflags && not (null missing)) $\n        logWarnings (listToBag [warn])\n  where\n    dflags = hsc_dflags hsc_env\n    targets = map targetId (hsc_targets hsc_env)\n\n    is_known_module mod = any (is_my_target mod) targets\n\n    -- We need to be careful to handle the case where (possibly\n    -- path-qualified) filenames (aka 'TargetFile') rather than module\n    -- names are being passed on the GHC command-line.\n    --\n    -- For instance, `ghc --make src-exe/Main.hs` and\n    -- `ghc --make -isrc-exe Main` are supposed to be equivalent.\n    -- Note also that we can't always infer the associated module name\n    -- directly from the filename argument.  See Trac #13727.\n    is_my_target mod (TargetModule name)\n      = moduleName (ms_mod mod) == name\n    is_my_target mod (TargetFile target_file _)\n      | Just mod_file <- ml_hs_file (ms_location mod)\n      = target_file == mod_file ||\n           --  We can get a file target even if a module name was\n           --  originally specified in a command line because it can\n           --  be converted in guessTarget (by appending .hs/.lhs).\n           --  So let's convert it back and compare with module name\n           mkModuleName (fst $ splitExtension target_file)\n            == moduleName (ms_mod mod)\n    is_my_target _ _ = False\n\n    missing = map (moduleName . ms_mod) $\n      filter (not . is_known_module) (mgModSummaries mod_graph)\n\n    msg\n      | gopt Opt_BuildingCabalPackage dflags\n      = hang\n          (text \"These modules are needed for compilation but not listed in your .cabal file's other-modules: \")\n          4\n          (sep (map ppr missing))\n      | otherwise\n      =\n        hang\n          (text \"Modules are not listed in command line but needed for compilation: \")\n          4\n          (sep (map ppr missing))\n    warn = makeIntoWarning\n      (Reason Opt_WarnMissingHomeModules)\n      (mkPlainErrMsg dflags noSrcSpan msg)\n\n-- | Describes which modules of the module graph need to be loaded.\ndata LoadHowMuch\n   = LoadAllTargets\n     -- ^ Load all targets and its dependencies.\n   | LoadUpTo ModuleName\n     -- ^ Load only the given module and its dependencies.\n   | LoadDependenciesOf ModuleName\n     -- ^ Load only the dependencies of the given module, but not the module\n     -- itself.\n\n-- | Try to load the program.  See 'LoadHowMuch' for the different modes.\n--\n-- This function implements the core of GHC's @--make@ mode.  It preprocesses,\n-- compiles and loads the specified modules, avoiding re-compilation wherever\n-- possible.  Depending on the target (see 'DynFlags.hscTarget') compiling\n-- and loading may result in files being created on disk.\n--\n-- Calls the 'defaultWarnErrLogger' after each compiling each module, whether\n-- successful or not.\n--\n-- Throw a 'SourceError' if errors are encountered before the actual\n-- compilation starts (e.g., during dependency analysis).  All other errors\n-- are reported using the 'defaultWarnErrLogger'.\n--\nload :: GhcMonad m => LoadHowMuch -> m SuccessFlag\nload how_much = do\n    mod_graph <- depanal [] False\n    load' how_much (Just batchMsg) mod_graph\n\n-- | Generalized version of 'load' which also supports a custom\n-- 'Messager' (for reporting progress) and 'ModuleGraph' (generally\n-- produced by calling 'depanal'.\nload' :: GhcMonad m => LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag\nload' how_much mHscMessage mod_graph = do\n    modifySession $ \\hsc_env -> hsc_env { hsc_mod_graph = mod_graph }\n    guessOutputFile\n    hsc_env <- getSession\n\n    let hpt1   = hsc_HPT hsc_env\n    let dflags = hsc_dflags hsc_env\n\n    -- The \"bad\" boot modules are the ones for which we have\n    -- B.hs-boot in the module graph, but no B.hs\n    -- The downsweep should have ensured this does not happen\n    -- (see msDeps)\n    let all_home_mods =\n          mkUniqSet [ ms_mod_name s\n                    | s <- mgModSummaries mod_graph, not (isBootSummary s)]\n    -- TODO: Figure out what the correct form of this assert is. It's violated\n    -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot\n    -- files without corresponding hs files.\n    --  bad_boot_mods = [s        | s <- mod_graph, isBootSummary s,\n    --                              not (ms_mod_name s `elem` all_home_mods)]\n    -- ASSERT( null bad_boot_mods ) return ()\n\n    -- check that the module given in HowMuch actually exists, otherwise\n    -- topSortModuleGraph will bomb later.\n    let checkHowMuch (LoadUpTo m)           = checkMod m\n        checkHowMuch (LoadDependenciesOf m) = checkMod m\n        checkHowMuch _ = id\n\n        checkMod m and_then\n            | m `elementOfUniqSet` all_home_mods = and_then\n            | otherwise = do\n                    liftIO $ errorMsg dflags (text \"no such module:\" <+>\n                                     quotes (ppr m))\n                    return Failed\n\n    checkHowMuch how_much $ do\n\n    -- mg2_with_srcimps drops the hi-boot nodes, returning a\n    -- graph with cycles.  Among other things, it is used for\n    -- backing out partially complete cycles following a failed\n    -- upsweep, and for removing from hpt all the modules\n    -- not in strict downwards closure, during calls to compile.\n    let mg2_with_srcimps :: [SCC ModSummary]\n        mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing\n\n    -- If we can determine that any of the {-# SOURCE #-} imports\n    -- are definitely unnecessary, then emit a warning.\n    warnUnnecessarySourceImports mg2_with_srcimps\n\n    let\n        -- check the stability property for each module.\n        stable_mods@(stable_obj,stable_bco)\n            = checkStability hpt1 mg2_with_srcimps all_home_mods\n\n        -- prune bits of the HPT which are definitely redundant now,\n        -- to save space.\n        pruned_hpt = pruneHomePackageTable hpt1\n                            (flattenSCCs mg2_with_srcimps)\n                            stable_mods\n\n    _ <- liftIO $ evaluate pruned_hpt\n\n    -- before we unload anything, make sure we don't leave an old\n    -- interactive context around pointing to dead bindings.  Also,\n    -- write the pruned HPT to allow the old HPT to be GC'd.\n    setSession $ discardIC $ hsc_env { hsc_HPT = pruned_hpt }\n\n    liftIO $ debugTraceMsg dflags 2 (text \"Stable obj:\" <+> ppr stable_obj $$\n                            text \"Stable BCO:\" <+> ppr stable_bco)\n\n    -- Unload any modules which are going to be re-linked this time around.\n    let stable_linkables = [ linkable\n                           | m <- nonDetEltsUniqSet stable_obj ++\n                                  nonDetEltsUniqSet stable_bco,\n                             -- It's OK to use nonDetEltsUniqSet here\n                             -- because it only affects linking. Besides\n                             -- this list only serves as a poor man's set.\n                             Just hmi <- [lookupHpt pruned_hpt m],\n                             Just linkable <- [hm_linkable hmi] ]\n    liftIO $ unload hsc_env stable_linkables\n\n    -- We could at this point detect cycles which aren't broken by\n    -- a source-import, and complain immediately, but it seems better\n    -- to let upsweep_mods do this, so at least some useful work gets\n    -- done before the upsweep is abandoned.\n    --hPutStrLn stderr \"after tsort:\\n\"\n    --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))\n\n    -- Now do the upsweep, calling compile for each module in\n    -- turn.  Final result is version 3 of everything.\n\n    -- Topologically sort the module graph, this time including hi-boot\n    -- nodes, and possibly just including the portion of the graph\n    -- reachable from the module specified in the 2nd argument to load.\n    -- This graph should be cycle-free.\n    -- If we're restricting the upsweep to a portion of the graph, we\n    -- also want to retain everything that is still stable.\n    let full_mg :: [SCC ModSummary]\n        full_mg    = topSortModuleGraph False mod_graph Nothing\n\n        maybe_top_mod = case how_much of\n                            LoadUpTo m           -> Just m\n                            LoadDependenciesOf m -> Just m\n                            _                    -> Nothing\n\n        partial_mg0 :: [SCC ModSummary]\n        partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod\n\n        -- LoadDependenciesOf m: we want the upsweep to stop just\n        -- short of the specified module (unless the specified module\n        -- is stable).\n        partial_mg\n            | LoadDependenciesOf _mod <- how_much\n            = ASSERT( case last partial_mg0 of\n                        AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False )\n              List.init partial_mg0\n            | otherwise\n            = partial_mg0\n\n        stable_mg =\n            [ AcyclicSCC ms\n            | AcyclicSCC ms <- full_mg,\n              stable_mod_summary ms ]\n\n        stable_mod_summary ms =\n          ms_mod_name ms `elementOfUniqSet` stable_obj ||\n          ms_mod_name ms `elementOfUniqSet` stable_bco\n\n        -- the modules from partial_mg that are not also stable\n        -- NB. also keep cycles, we need to emit an error message later\n        unstable_mg = filter not_stable partial_mg\n          where not_stable (CyclicSCC _) = True\n                not_stable (AcyclicSCC ms)\n                   = not $ stable_mod_summary ms\n\n        -- Load all the stable modules first, before attempting to load\n        -- an unstable module (#7231).\n        mg = stable_mg ++ unstable_mg\n\n    -- clean up between compilations\n    let cleanup = cleanCurrentModuleTempFiles . hsc_dflags\n    liftIO $ debugTraceMsg dflags 2 (hang (text \"Ready for upsweep\")\n                               2 (ppr mg))\n\n    n_jobs <- case parMakeCount dflags of\n                    Nothing -> liftIO getNumProcessors\n                    Just n  -> return n\n    let upsweep_fn | n_jobs > 1 = parUpsweep n_jobs\n                   | otherwise  = upsweep\n\n    setSession hsc_env{ hsc_HPT = emptyHomePackageTable }\n    (upsweep_ok, modsUpswept) <- withDeferredDiagnostics $\n      upsweep_fn mHscMessage pruned_hpt stable_mods cleanup mg\n\n    -- Make modsDone be the summaries for each home module now\n    -- available; this should equal the domain of hpt3.\n    -- Get in in a roughly top .. bottom order (hence reverse).\n\n    let modsDone = reverse modsUpswept\n\n    -- Try and do linking in some form, depending on whether the\n    -- upsweep was completely or only partially successful.\n\n    if succeeded upsweep_ok\n\n     then\n       -- Easy; just relink it all.\n       do liftIO $ debugTraceMsg dflags 2 (text \"Upsweep completely successful.\")\n\n          -- Clean up after ourselves\n          hsc_env1 <- getSession\n          liftIO $ cleanCurrentModuleTempFiles dflags\n\n          -- Issue a warning for the confusing case where the user\n          -- said '-o foo' but we're not going to do any linking.\n          -- We attempt linking if either (a) one of the modules is\n          -- called Main, or (b) the user said -no-hs-main, indicating\n          -- that main() is going to come from somewhere else.\n          --\n          let ofile = outputFile dflags\n          let no_hs_main = gopt Opt_NoHsMain dflags\n          let\n            main_mod = mainModIs dflags\n            a_root_is_Main = mgElemModule mod_graph main_mod\n            do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib\n\n          -- link everything together\n          linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)\n\n          if ghcLink dflags == LinkBinary && isJust ofile && not do_linking\n             then do\n                liftIO $ errorMsg dflags $ text\n                   (\"output was redirected with -o, \" ++\n                    \"but no output will be generated\\n\" ++\n                    \"because there is no \" ++\n                    moduleNameString (moduleName main_mod) ++ \" module.\")\n                -- This should be an error, not a warning (#10895).\n                loadFinish Failed linkresult\n             else\n                loadFinish Succeeded linkresult\n\n     else\n       -- Tricky.  We need to back out the effects of compiling any\n       -- half-done cycles, both so as to clean up the top level envs\n       -- and to avoid telling the interactive linker to link them.\n       do liftIO $ debugTraceMsg dflags 2 (text \"Upsweep partially successful.\")\n\n          let modsDone_names\n                 = map ms_mod modsDone\n          let mods_to_zap_names\n                 = findPartiallyCompletedCycles modsDone_names\n                      mg2_with_srcimps\n          let (mods_to_clean, mods_to_keep) =\n                partition ((`Set.member` mods_to_zap_names).ms_mod) modsDone\n          hsc_env1 <- getSession\n          let hpt4 = hsc_HPT hsc_env1\n              -- We must change the lifetime to TFL_CurrentModule for any temp\n              -- file created for an element of mod_to_clean during the upsweep.\n              -- These include preprocessed files and object files for loaded\n              -- modules.\n              unneeded_temps = concat\n                [ms_hspp_file : object_files\n                | ModSummary{ms_mod, ms_hspp_file} <- mods_to_clean\n                , let object_files = maybe [] linkableObjs $\n                        lookupHpt hpt4 (moduleName ms_mod)\n                        >>= hm_linkable\n                ]\n          liftIO $\n            changeTempFilesLifetime dflags TFL_CurrentModule unneeded_temps\n          liftIO $ cleanCurrentModuleTempFiles dflags\n\n          let hpt5 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)\n                                          hpt4\n\n          -- Clean up after ourselves\n\n          -- there should be no Nothings where linkables should be, now\n          let just_linkables =\n                    isNoLink (ghcLink dflags)\n                 || allHpt (isJust.hm_linkable)\n                        (filterHpt ((== HsSrcFile).mi_hsc_src.hm_iface)\n                                hpt5)\n          ASSERT( just_linkables ) do\n\n          -- Link everything together\n          linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt5\n\n          modifySession $ \\hsc_env -> hsc_env{ hsc_HPT = hpt5 }\n          loadFinish Failed linkresult\n\n\n-- | Finish up after a load.\nloadFinish :: GhcMonad m => SuccessFlag -> SuccessFlag -> m SuccessFlag\n\n-- If the link failed, unload everything and return.\nloadFinish _all_ok Failed\n  = do hsc_env <- getSession\n       liftIO $ unload hsc_env []\n       modifySession discardProg\n       return Failed\n\n-- Empty the interactive context and set the module context to the topmost\n-- newly loaded module, or the Prelude if none were loaded.\nloadFinish all_ok Succeeded\n  = do modifySession discardIC\n       return all_ok\n\n\n-- | Forget the current program, but retain the persistent info in HscEnv\ndiscardProg :: HscEnv -> HscEnv\ndiscardProg hsc_env\n  = discardIC $ hsc_env { hsc_mod_graph = emptyMG\n                        , hsc_HPT = emptyHomePackageTable }\n\n-- | Discard the contents of the InteractiveContext, but keep the DynFlags.\n-- It will also keep ic_int_print and ic_monad if their names are from\n-- external packages.\ndiscardIC :: HscEnv -> HscEnv\ndiscardIC hsc_env\n  = hsc_env { hsc_IC = empty_ic { ic_int_print = new_ic_int_print\n                                , ic_monad = new_ic_monad } }\n  where\n  -- Force the new values for ic_int_print and ic_monad to avoid leaking old_ic\n  !new_ic_int_print = keep_external_name ic_int_print\n  !new_ic_monad = keep_external_name ic_monad\n  dflags = ic_dflags old_ic\n  old_ic = hsc_IC hsc_env\n  empty_ic = emptyInteractiveContext dflags\n  keep_external_name ic_name\n    | nameIsFromExternalPackage this_pkg old_name = old_name\n    | otherwise = ic_name empty_ic\n    where\n    this_pkg = thisPackage dflags\n    old_name = ic_name old_ic\n\n-- | If there is no -o option, guess the name of target executable\n-- by using top-level source file name as a base.\nguessOutputFile :: GhcMonad m => m ()\nguessOutputFile = modifySession $ \\env ->\n    let dflags = hsc_dflags env\n        -- Force mod_graph to avoid leaking env\n        !mod_graph = hsc_mod_graph env\n        mainModuleSrcPath :: Maybe String\n        mainModuleSrcPath = do\n            ms <- mgLookupModule mod_graph (mainModIs dflags)\n            ml_hs_file (ms_location ms)\n        name = fmap dropExtension mainModuleSrcPath\n\n        name_exe = do\n#if defined(mingw32_HOST_OS)\n          -- we must add the .exe extension unconditionally here, otherwise\n          -- when name has an extension of its own, the .exe extension will\n          -- not be added by DriverPipeline.exeFileName.  See #2248\n          name' <- fmap (<.> \"exe\") name\n#else\n          name' <- name\n#endif\n          mainModuleSrcPath' <- mainModuleSrcPath\n          -- #9930: don't clobber input files (unless they ask for it)\n          if name' == mainModuleSrcPath'\n            then throwGhcException . UsageError $\n                 \"default output name would overwrite the input file; \" ++\n                 \"must specify -o explicitly\"\n            else Just name'\n    in\n    case outputFile dflags of\n        Just _ -> env\n        Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }\n\n-- -----------------------------------------------------------------------------\n--\n-- | Prune the HomePackageTable\n--\n-- Before doing an upsweep, we can throw away:\n--\n--   - For non-stable modules:\n--      - all ModDetails, all linked code\n--   - all unlinked code that is out of date with respect to\n--     the source file\n--\n-- This is VERY IMPORTANT otherwise we'll end up requiring 2x the\n-- space at the end of the upsweep, because the topmost ModDetails of the\n-- old HPT holds on to the entire type environment from the previous\n-- compilation.\npruneHomePackageTable :: HomePackageTable\n                      -> [ModSummary]\n                      -> StableModules\n                      -> HomePackageTable\npruneHomePackageTable hpt summ (stable_obj, stable_bco)\n  = mapHpt prune hpt\n  where prune hmi\n          | is_stable modl = hmi'\n          | otherwise      = hmi'{ hm_details = emptyModDetails }\n          where\n           modl = moduleName (mi_module (hm_iface hmi))\n           hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms\n                = hmi{ hm_linkable = Nothing }\n                | otherwise\n                = hmi\n                where ms = expectJust \"prune\" (lookupUFM ms_map modl)\n\n        ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ]\n\n        is_stable m =\n          m `elementOfUniqSet` stable_obj ||\n          m `elementOfUniqSet` stable_bco\n\n-- -----------------------------------------------------------------------------\n--\n-- | Return (names of) all those in modsDone who are part of a cycle as defined\n-- by theGraph.\nfindPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> Set.Set Module\nfindPartiallyCompletedCycles modsDone theGraph\n   = Set.unions\n       [mods_in_this_cycle\n       | CyclicSCC vs <- theGraph  -- Acyclic? Not interesting.\n       , let names_in_this_cycle = Set.fromList (map ms_mod vs)\n             mods_in_this_cycle =\n                    Set.intersection (Set.fromList modsDone) names_in_this_cycle\n         -- If size mods_in_this_cycle == size names_in_this_cycle,\n         -- then this cycle has already been completed and we're not\n         -- interested.\n       , Set.size mods_in_this_cycle < Set.size names_in_this_cycle]\n\n\n-- ---------------------------------------------------------------------------\n--\n-- | Unloading\nunload :: HscEnv -> [Linkable] -> IO ()\nunload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'\n  = case ghcLink (hsc_dflags hsc_env) of\n        LinkInMemory -> Linker.unload hsc_env stable_linkables\n        _other -> return ()\n\n-- -----------------------------------------------------------------------------\n{- |\n\n  Stability tells us which modules definitely do not need to be recompiled.\n  There are two main reasons for having stability:\n\n   - avoid doing a complete upsweep of the module graph in GHCi when\n     modules near the bottom of the tree have not changed.\n\n   - to tell GHCi when it can load object code: we can only load object code\n     for a module when we also load object code fo  all of the imports of the\n     module.  So we need to know that we will definitely not be recompiling\n     any of these modules, and we can use the object code.\n\n  The stability check is as follows.  Both stableObject and\n  stableBCO are used during the upsweep phase later.\n\n@\n  stable m = stableObject m || stableBCO m\n\n  stableObject m =\n        all stableObject (imports m)\n        && old linkable does not exist, or is == on-disk .o\n        && date(on-disk .o) > date(.hs)\n\n  stableBCO m =\n        all stable (imports m)\n        && date(BCO) > date(.hs)\n@\n\n  These properties embody the following ideas:\n\n    - if a module is stable, then:\n\n        - if it has been compiled in a previous pass (present in HPT)\n          then it does not need to be compiled or re-linked.\n\n        - if it has not been compiled in a previous pass,\n          then we only need to read its .hi file from disk and\n          link it to produce a 'ModDetails'.\n\n    - if a modules is not stable, we will definitely be at least\n      re-linking, and possibly re-compiling it during the 'upsweep'.\n      All non-stable modules can (and should) therefore be unlinked\n      before the 'upsweep'.\n\n    - Note that objects are only considered stable if they only depend\n      on other objects.  We can't link object code against byte code.\n\n    - Note that even if an object is stable, we may end up recompiling\n      if the interface is out of date because an *external* interface\n      has changed.  The current code in GhcMake handles this case\n      fairly poorly, so be careful.\n-}\n\ntype StableModules =\n  ( UniqSet ModuleName  -- stableObject\n  , UniqSet ModuleName  -- stableBCO\n  )\n\n\ncheckStability\n        :: HomePackageTable   -- HPT from last compilation\n        -> [SCC ModSummary]   -- current module graph (cyclic)\n        -> UniqSet ModuleName -- all home modules\n        -> StableModules\n\ncheckStability hpt sccs all_home_mods =\n  foldl' checkSCC (emptyUniqSet, emptyUniqSet) sccs\n  where\n   checkSCC :: StableModules -> SCC ModSummary -> StableModules\n   checkSCC (stable_obj, stable_bco) scc0\n     | stableObjects = (addListToUniqSet stable_obj scc_mods, stable_bco)\n     | stableBCOs    = (stable_obj, addListToUniqSet stable_bco scc_mods)\n     | otherwise     = (stable_obj, stable_bco)\n     where\n        scc = flattenSCC scc0\n        scc_mods = map ms_mod_name scc\n        home_module m =\n          m `elementOfUniqSet` all_home_mods && m `notElem` scc_mods\n\n        scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))\n            -- all imports outside the current SCC, but in the home pkg\n\n        stable_obj_imps = map (`elementOfUniqSet` stable_obj) scc_allimps\n        stable_bco_imps = map (`elementOfUniqSet` stable_bco) scc_allimps\n\n        stableObjects =\n           and stable_obj_imps\n           && all object_ok scc\n\n        stableBCOs =\n           and (zipWith (||) stable_obj_imps stable_bco_imps)\n           && all bco_ok scc\n\n        object_ok ms\n          | gopt Opt_ForceRecomp (ms_hspp_opts ms) = False\n          | Just t <- ms_obj_date ms  =  t >= ms_hs_date ms\n                                         && same_as_prev t\n          | otherwise = False\n          where\n             same_as_prev t = case lookupHpt hpt (ms_mod_name ms) of\n                                Just hmi  | Just l <- hm_linkable hmi\n                                 -> isObjectLinkable l && t == linkableTime l\n                                _other  -> True\n                -- why '>=' rather than '>' above?  If the filesystem stores\n                -- times to the nearset second, we may occasionally find that\n                -- the object & source have the same modification time,\n                -- especially if the source was automatically generated\n                -- and compiled.  Using >= is slightly unsafe, but it matches\n                -- make's behaviour.\n                --\n                -- But see #5527, where someone ran into this and it caused\n                -- a problem.\n\n        bco_ok ms\n          | gopt Opt_ForceRecomp (ms_hspp_opts ms) = False\n          | otherwise = case lookupHpt hpt (ms_mod_name ms) of\n                Just hmi  | Just l <- hm_linkable hmi ->\n                        not (isObjectLinkable l) &&\n                        linkableTime l >= ms_hs_date ms\n                _other  -> False\n\n{- Parallel Upsweep\n -\n - The parallel upsweep attempts to concurrently compile the modules in the\n - compilation graph using multiple Haskell threads.\n -\n - The Algorithm\n -\n - A Haskell thread is spawned for each module in the module graph, waiting for\n - its direct dependencies to finish building before it itself begins to build.\n -\n - Each module is associated with an initially empty MVar that stores the\n - result of that particular module's compile. If the compile succeeded, then\n - the HscEnv (synchronized by an MVar) is updated with the fresh HMI of that\n - module, and the module's HMI is deleted from the old HPT (synchronized by an\n - IORef) to save space.\n -\n - Instead of immediately outputting messages to the standard handles, all\n - compilation output is deferred to a per-module TQueue. A QSem is used to\n - limit the number of workers that are compiling simultaneously.\n -\n - Meanwhile, the main thread sequentially loops over all the modules in the\n - module graph, outputting the messages stored in each module's TQueue.\n-}\n\n-- | Each module is given a unique 'LogQueue' to redirect compilation messages\n-- to. A 'Nothing' value contains the result of compilation, and denotes the\n-- end of the message queue.\ndata LogQueue = LogQueue !(IORef [Maybe (WarnReason, Severity, SrcSpan, PprStyle, MsgDoc)])\n                         !(MVar ())\n\n-- | The graph of modules to compile and their corresponding result 'MVar' and\n-- 'LogQueue'.\ntype CompilationGraph = [(ModSummary, MVar SuccessFlag, LogQueue)]\n\n-- | Build a 'CompilationGraph' out of a list of strongly-connected modules,\n-- also returning the first, if any, encountered module cycle.\nbuildCompGraph :: [SCC ModSummary] -> IO (CompilationGraph, Maybe [ModSummary])\nbuildCompGraph [] = return ([], Nothing)\nbuildCompGraph (scc:sccs) = case scc of\n    AcyclicSCC ms -> do\n        mvar <- newEmptyMVar\n        log_queue <- do\n            ref <- newIORef []\n            sem <- newEmptyMVar\n            return (LogQueue ref sem)\n        (rest,cycle) <- buildCompGraph sccs\n        return ((ms,mvar,log_queue):rest, cycle)\n    CyclicSCC mss -> return ([], Just mss)\n\n-- A Module and whether it is a boot module.\ntype BuildModule = (Module, IsBoot)\n\n-- | 'Bool' indicating if a module is a boot module or not.  We need to treat\n-- boot modules specially when building compilation graphs, since they break\n-- cycles.  Regular source files and signature files are treated equivalently.\ndata IsBoot = IsBoot | NotBoot\n    deriving (Ord, Eq, Show, Read)\n\n-- | Tests if an 'HscSource' is a boot file, primarily for constructing\n-- elements of 'BuildModule'.\nhscSourceToIsBoot :: HscSource -> IsBoot\nhscSourceToIsBoot HsBootFile = IsBoot\nhscSourceToIsBoot _ = NotBoot\n\nmkBuildModule :: ModSummary -> BuildModule\nmkBuildModule ms = (ms_mod ms, if isBootSummary ms then IsBoot else NotBoot)\n\n-- | The entry point to the parallel upsweep.\n--\n-- See also the simpler, sequential 'upsweep'.\nparUpsweep\n    :: GhcMonad m\n    => Int\n    -- ^ The number of workers we wish to run in parallel\n    -> Maybe Messager\n    -> HomePackageTable\n    -> StableModules\n    -> (HscEnv -> IO ())\n    -> [SCC ModSummary]\n    -> m (SuccessFlag,\n          [ModSummary])\nparUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do\n    hsc_env <- getSession\n    let dflags = hsc_dflags hsc_env\n\n    when (not (null (unitIdsToCheck dflags))) $\n      throwGhcException (ProgramError \"Backpack typechecking not supported with -j\")\n\n    -- The bits of shared state we'll be using:\n\n    -- The global HscEnv is updated with the module's HMI when a module\n    -- successfully compiles.\n    hsc_env_var <- liftIO $ newMVar hsc_env\n\n    -- The old HPT is used for recompilation checking in upsweep_mod. When a\n    -- module successfully gets compiled, its HMI is pruned from the old HPT.\n    old_hpt_var <- liftIO $ newIORef old_hpt\n\n    -- What we use to limit parallelism with.\n    par_sem <- liftIO $ newQSem n_jobs\n\n\n    let updNumCapabilities = liftIO $ do\n            n_capabilities <- getNumCapabilities\n            n_cpus <- getNumProcessors\n            -- Setting number of capabilities more than\n            -- CPU count usually leads to high userspace\n            -- lock contention. Trac #9221\n            let n_caps = min n_jobs n_cpus\n            unless (n_capabilities /= 1) $ setNumCapabilities n_caps\n            return n_capabilities\n    -- Reset the number of capabilities once the upsweep ends.\n    let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n\n\n    gbracket updNumCapabilities resetNumCapabilities $ \\_ -> do\n\n    -- Sync the global session with the latest HscEnv once the upsweep ends.\n    let finallySyncSession io = io `gfinally` do\n            hsc_env <- liftIO $ readMVar hsc_env_var\n            setSession hsc_env\n\n    finallySyncSession $ do\n\n    -- Build the compilation graph out of the list of SCCs. Module cycles are\n    -- handled at the very end, after some useful work gets done. Note that\n    -- this list is topologically sorted (by virtue of 'sccs' being sorted so).\n    (comp_graph,cycle) <- liftIO $ buildCompGraph sccs\n    let comp_graph_w_idx = zip comp_graph [1..]\n\n    -- The list of all loops in the compilation graph.\n    -- NB: For convenience, the last module of each loop (aka the module that\n    -- finishes the loop) is prepended to the beginning of the loop.\n    let graph = map fstOf3 (reverse comp_graph)\n        boot_modules = mkModuleSet [ms_mod ms | ms <- graph, isBootSummary ms]\n        comp_graph_loops = go graph boot_modules\n          where\n            remove ms bm\n              | isBootSummary ms = delModuleSet bm (ms_mod ms)\n              | otherwise = bm\n            go [] _ = []\n            go mg@(ms:mss) boot_modules\n              | Just loop <- getModLoop ms mg (`elemModuleSet` boot_modules)\n              = map mkBuildModule (ms:loop) : go mss (remove ms boot_modules)\n              | otherwise\n              = go mss (remove ms boot_modules)\n\n    -- Build a Map out of the compilation graph with which we can efficiently\n    -- look up the result MVar associated with a particular home module.\n    let home_mod_map :: Map BuildModule (MVar SuccessFlag, Int)\n        home_mod_map =\n            Map.fromList [ (mkBuildModule ms, (mvar, idx))\n                         | ((ms,mvar,_),idx) <- comp_graph_w_idx ]\n\n\n    liftIO $ label_self \"main --make thread\"\n    -- For each module in the module graph, spawn a worker thread that will\n    -- compile this module.\n    let { spawnWorkers = forM comp_graph_w_idx $ \\((mod,!mvar,!log_queue),!mod_idx) ->\n            forkIOWithUnmask $ \\unmask -> do\n                liftIO $ label_self $ unwords\n                    [ \"worker --make thread\"\n                    , \"for module\"\n                    , show (moduleNameString (ms_mod_name mod))\n                    , \"number\"\n                    , show mod_idx\n                    ]\n                -- Replace the default log_action with one that writes each\n                -- message to the module's log_queue. The main thread will\n                -- deal with synchronously printing these messages.\n                --\n                -- Use a local filesToClean var so that we can clean up\n                -- intermediate files in a timely fashion (as soon as\n                -- compilation for that module is finished) without having to\n                -- worry about accidentally deleting a simultaneous compile's\n                -- important files.\n                lcl_files_to_clean <- newIORef emptyFilesToClean\n                let lcl_dflags = dflags { log_action = parLogAction log_queue\n                                        , filesToClean = lcl_files_to_clean }\n\n                -- Unmask asynchronous exceptions and perform the thread-local\n                -- work to compile the module (see parUpsweep_one).\n                m_res <- try $ unmask $ prettyPrintGhcErrors lcl_dflags $\n                        parUpsweep_one mod home_mod_map comp_graph_loops\n                                       lcl_dflags mHscMessage cleanup\n                                       par_sem hsc_env_var old_hpt_var\n                                       stable_mods mod_idx (length sccs)\n\n                res <- case m_res of\n                    Right flag -> return flag\n                    Left exc -> do\n                        -- Don't print ThreadKilled exceptions: they are used\n                        -- to kill the worker thread in the event of a user\n                        -- interrupt, and the user doesn't have to be informed\n                        -- about that.\n                        when (fromException exc /= Just ThreadKilled)\n                             (errorMsg lcl_dflags (text (show exc)))\n                        return Failed\n\n                -- Populate the result MVar.\n                putMVar mvar res\n\n                -- Write the end marker to the message queue, telling the main\n                -- thread that it can stop waiting for messages from this\n                -- particular compile.\n                writeLogQueue log_queue Nothing\n\n                -- Add the remaining files that weren't cleaned up to the\n                -- global filesToClean ref, for cleanup later.\n                FilesToClean\n                  { ftcCurrentModule = cm_files\n                  , ftcGhcSession = gs_files\n                  } <- readIORef (filesToClean lcl_dflags)\n                addFilesToClean dflags TFL_CurrentModule $ Set.toList cm_files\n                addFilesToClean dflags TFL_GhcSession $ Set.toList gs_files\n\n        -- Kill all the workers, masking interrupts (since killThread is\n        -- interruptible). XXX: This is not ideal.\n        ; killWorkers = uninterruptibleMask_ . mapM_ killThread }\n\n\n    -- Spawn the workers, making sure to kill them later. Collect the results\n    -- of each compile.\n    results <- liftIO $ bracket spawnWorkers killWorkers $ \\_ ->\n        -- Loop over each module in the compilation graph in order, printing\n        -- each message from its log_queue.\n        forM comp_graph $ \\(mod,mvar,log_queue) -> do\n            printLogs dflags log_queue\n            result <- readMVar mvar\n            if succeeded result then return (Just mod) else return Nothing\n\n\n    -- Collect and return the ModSummaries of all the successful compiles.\n    -- NB: Reverse this list to maintain output parity with the sequential upsweep.\n    let ok_results = reverse (catMaybes results)\n\n    -- Handle any cycle in the original compilation graph and return the result\n    -- of the upsweep.\n    case cycle of\n        Just mss -> do\n            liftIO $ fatalErrorMsg dflags (cyclicModuleErr mss)\n            return (Failed,ok_results)\n        Nothing  -> do\n            let success_flag = successIf (all isJust results)\n            return (success_flag,ok_results)\n\n  where\n    writeLogQueue :: LogQueue -> Maybe (WarnReason,Severity,SrcSpan,PprStyle,MsgDoc) -> IO ()\n    writeLogQueue (LogQueue ref sem) msg = do\n        atomicModifyIORef' ref $ \\msgs -> (msg:msgs,())\n        _ <- tryPutMVar sem ()\n        return ()\n\n    -- The log_action callback that is used to synchronize messages from a\n    -- worker thread.\n    parLogAction :: LogQueue -> LogAction\n    parLogAction log_queue _dflags !reason !severity !srcSpan !style !msg = do\n        writeLogQueue log_queue (Just (reason,severity,srcSpan,style,msg))\n\n    -- Print each message from the log_queue using the log_action from the\n    -- session's DynFlags.\n    printLogs :: DynFlags -> LogQueue -> IO ()\n    printLogs !dflags (LogQueue ref sem) = read_msgs\n      where read_msgs = do\n                takeMVar sem\n                msgs <- atomicModifyIORef' ref $ \\xs -> ([], reverse xs)\n                print_loop msgs\n\n            print_loop [] = read_msgs\n            print_loop (x:xs) = case x of\n                Just (reason,severity,srcSpan,style,msg) -> do\n                    putLogMsg dflags reason severity srcSpan style msg\n                    print_loop xs\n                -- Exit the loop once we encounter the end marker.\n                Nothing -> return ()\n\n-- The interruptible subset of the worker threads' work.\nparUpsweep_one\n    :: ModSummary\n    -- ^ The module we wish to compile\n    -> Map BuildModule (MVar SuccessFlag, Int)\n    -- ^ The map of home modules and their result MVar\n    -> [[BuildModule]]\n    -- ^ The list of all module loops within the compilation graph.\n    -> DynFlags\n    -- ^ The thread-local DynFlags\n    -> Maybe Messager\n    -- ^ The messager\n    -> (HscEnv -> IO ())\n    -- ^ The callback for cleaning up intermediate files\n    -> QSem\n    -- ^ The semaphore for limiting the number of simultaneous compiles\n    -> MVar HscEnv\n    -- ^ The MVar that synchronizes updates to the global HscEnv\n    -> IORef HomePackageTable\n    -- ^ The old HPT\n    -> StableModules\n    -- ^ Sets of stable objects and BCOs\n    -> Int\n    -- ^ The index of this module\n    -> Int\n    -- ^ The total number of modules\n    -> IO SuccessFlag\n    -- ^ The result of this compile\nparUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup par_sem\n               hsc_env_var old_hpt_var stable_mods mod_index num_mods = do\n\n    let this_build_mod = mkBuildModule mod\n\n    let home_imps     = map unLoc $ ms_home_imps mod\n    let home_src_imps = map unLoc $ ms_home_srcimps mod\n\n    -- All the textual imports of this module.\n    let textual_deps = Set.fromList $ mapFst (mkModule (thisPackage lcl_dflags)) $\n                            zip home_imps     (repeat NotBoot) ++\n                            zip home_src_imps (repeat IsBoot)\n\n    -- Dealing with module loops\n    -- ~~~~~~~~~~~~~~~~~~~~~~~~~\n    --\n    -- Not only do we have to deal with explicit textual dependencies, we also\n    -- have to deal with implicit dependencies introduced by import cycles that\n    -- are broken by an hs-boot file. We have to ensure that:\n    --\n    -- 1. A module that breaks a loop must depend on all the modules in the\n    --    loop (transitively or otherwise). This is normally always fulfilled\n    --    by the module's textual dependencies except in degenerate loops,\n    --    e.g.:\n    --\n    --    A.hs imports B.hs-boot\n    --    B.hs doesn't import A.hs\n    --    C.hs imports A.hs, B.hs\n    --\n    --    In this scenario, getModLoop will detect the module loop [A,B] but\n    --    the loop finisher B doesn't depend on A. So we have to explicitly add\n    --    A in as a dependency of B when we are compiling B.\n    --\n    -- 2. A module that depends on a module in an external loop can't proceed\n    --    until the entire loop is re-typechecked.\n    --\n    -- These two invariants have to be maintained to correctly build a\n    -- compilation graph with one or more loops.\n\n\n    -- The loop that this module will finish. After this module successfully\n    -- compiles, this loop is going to get re-typechecked.\n    let finish_loop = listToMaybe\n            [ tail loop | loop <- comp_graph_loops\n                        , head loop == this_build_mod ]\n\n    -- If this module finishes a loop then it must depend on all the other\n    -- modules in that loop because the entire module loop is going to be\n    -- re-typechecked once this module gets compiled. These extra dependencies\n    -- are this module's \"internal\" loop dependencies, because this module is\n    -- inside the loop in question.\n    let int_loop_deps = Set.fromList $\n            case finish_loop of\n                Nothing   -> []\n                Just loop -> filter (/= this_build_mod) loop\n\n    -- If this module depends on a module within a loop then it must wait for\n    -- that loop to get re-typechecked, i.e. it must wait on the module that\n    -- finishes that loop. These extra dependencies are this module's\n    -- \"external\" loop dependencies, because this module is outside of the\n    -- loop(s) in question.\n    let ext_loop_deps = Set.fromList\n            [ head loop | loop <- comp_graph_loops\n                        , any (`Set.member` textual_deps) loop\n                        , this_build_mod `notElem` loop ]\n\n\n    let all_deps = foldl1 Set.union [textual_deps, int_loop_deps, ext_loop_deps]\n\n    -- All of the module's home-module dependencies.\n    let home_deps_with_idx =\n            [ home_dep | dep <- Set.toList all_deps\n                       , Just home_dep <- [Map.lookup dep home_mod_map] ]\n\n    -- Sort the list of dependencies in reverse-topological order. This way, by\n    -- the time we get woken up by the result of an earlier dependency,\n    -- subsequent dependencies are more likely to have finished. This step\n    -- effectively reduces the number of MVars that each thread blocks on.\n    let home_deps = map fst $ sortBy (flip (comparing snd)) home_deps_with_idx\n\n    -- Wait for the all the module's dependencies to finish building.\n    deps_ok <- allM (fmap succeeded . readMVar) home_deps\n\n    -- We can't build this module if any of its dependencies failed to build.\n    if not deps_ok\n      then return Failed\n      else do\n        -- Any hsc_env at this point is OK to use since we only really require\n        -- that the HPT contains the HMIs of our dependencies.\n        hsc_env <- readMVar hsc_env_var\n        old_hpt <- readIORef old_hpt_var\n\n        let logger err = printBagOfErrors lcl_dflags (srcErrorMessages err)\n\n        -- Limit the number of parallel compiles.\n        let withSem sem = bracket_ (waitQSem sem) (signalQSem sem)\n        mb_mod_info <- withSem par_sem $\n            handleSourceError (\\err -> do logger err; return Nothing) $ do\n                -- Have the ModSummary and HscEnv point to our local log_action\n                -- and filesToClean var.\n                let lcl_mod = localize_mod mod\n                let lcl_hsc_env = localize_hsc_env hsc_env\n\n                -- Re-typecheck the loop\n                -- This is necessary to make sure the knot is tied when\n                -- we close a recursive module loop, see bug #12035.\n                type_env_var <- liftIO $ newIORef emptyNameEnv\n                let lcl_hsc_env' = lcl_hsc_env { hsc_type_env_var =\n                                    Just (ms_mod lcl_mod, type_env_var) }\n                lcl_hsc_env'' <- case finish_loop of\n                    Nothing   -> return lcl_hsc_env'\n                    -- In the non-parallel case, the retypecheck prior to\n                    -- typechecking the loop closer includes all modules\n                    -- EXCEPT the loop closer.  However, our precomputed\n                    -- SCCs include the loop closer, so we have to filter\n                    -- it out.\n                    Just loop -> typecheckLoop lcl_dflags lcl_hsc_env' $\n                                 filter (/= moduleName (fst this_build_mod)) $\n                                 map (moduleName . fst) loop\n\n                -- Compile the module.\n                mod_info <- upsweep_mod lcl_hsc_env'' mHscMessage old_hpt stable_mods\n                                        lcl_mod mod_index num_mods\n                return (Just mod_info)\n\n        case mb_mod_info of\n            Nothing -> return Failed\n            Just mod_info -> do\n                let this_mod = ms_mod_name mod\n\n                -- Prune the old HPT unless this is an hs-boot module.\n                unless (isBootSummary mod) $\n                    atomicModifyIORef' old_hpt_var $ \\old_hpt ->\n                        (delFromHpt old_hpt this_mod, ())\n\n                -- Update and fetch the global HscEnv.\n                lcl_hsc_env' <- modifyMVar hsc_env_var $ \\hsc_env -> do\n                    let hsc_env' = hsc_env\n                                     { hsc_HPT = addToHpt (hsc_HPT hsc_env)\n                                                           this_mod mod_info }\n                    -- We've finished typechecking the module, now we must\n                    -- retypecheck the loop AGAIN to ensure unfoldings are\n                    -- updated.  This time, however, we include the loop\n                    -- closer!\n                    hsc_env'' <- case finish_loop of\n                        Nothing   -> return hsc_env'\n                        Just loop -> typecheckLoop lcl_dflags hsc_env' $\n                                     map (moduleName . fst) loop\n                    return (hsc_env'', localize_hsc_env hsc_env'')\n\n                -- Clean up any intermediate files.\n                cleanup lcl_hsc_env'\n                return Succeeded\n\n  where\n    localize_mod mod\n        = mod { ms_hspp_opts = (ms_hspp_opts mod)\n                 { log_action = log_action lcl_dflags\n                 , filesToClean = filesToClean lcl_dflags } }\n\n    localize_hsc_env hsc_env\n        = hsc_env { hsc_dflags = (hsc_dflags hsc_env)\n                     { log_action = log_action lcl_dflags\n                     , filesToClean = filesToClean lcl_dflags } }\n\n-- -----------------------------------------------------------------------------\n--\n-- | The upsweep\n--\n-- This is where we compile each module in the module graph, in a pass\n-- from the bottom to the top of the graph.\n--\n-- There better had not be any cyclic groups here -- we check for them.\nupsweep\n    :: GhcMonad m\n    => Maybe Messager\n    -> HomePackageTable            -- ^ HPT from last time round (pruned)\n    -> StableModules               -- ^ stable modules (see checkStability)\n    -> (HscEnv -> IO ())           -- ^ How to clean up unwanted tmp files\n    -> [SCC ModSummary]            -- ^ Mods to do (the worklist)\n    -> m (SuccessFlag,\n          [ModSummary])\n       -- ^ Returns:\n       --\n       --  1. A flag whether the complete upsweep was successful.\n       --  2. The 'HscEnv' in the monad has an updated HPT\n       --  3. A list of modules which succeeded loading.\n\nupsweep mHscMessage old_hpt stable_mods cleanup sccs = do\n   dflags <- getSessionDynFlags\n   (res, done) <- upsweep' old_hpt emptyMG sccs 1 (length sccs)\n                           (unitIdsToCheck dflags) done_holes\n   return (res, reverse $ mgModSummaries done)\n where\n  done_holes = emptyUniqSet\n\n  upsweep'\n    :: GhcMonad m\n    => HomePackageTable\n    -> ModuleGraph\n    -> [SCC ModSummary]\n    -> Int\n    -> Int\n    -> [UnitId]\n    -> UniqSet ModuleName\n    -> m (SuccessFlag, ModuleGraph)\n  upsweep' _old_hpt done\n     [] _ _ uids_to_check _\n   = do hsc_env <- getSession\n        liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnitId hsc_env) uids_to_check\n        return (Succeeded, done)\n\n  upsweep' _old_hpt done\n     (CyclicSCC ms:_) _ _ _ _\n   = do dflags <- getSessionDynFlags\n        liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms)\n        return (Failed, done)\n\n  upsweep' old_hpt done\n     (AcyclicSCC mod:mods) mod_index nmods uids_to_check done_holes\n   = do -- putStrLn (\"UPSWEEP_MOD: hpt = \" ++\n        --           show (map (moduleUserString.moduleName.mi_module.hm_iface)\n        --                     (moduleEnvElts (hsc_HPT hsc_env)))\n        let logger _mod = defaultWarnErrLogger\n\n        hsc_env <- getSession\n\n        -- TODO: Cache this, so that we don't repeatedly re-check\n        -- our imports when you run --make.\n        let (ready_uids, uids_to_check')\n                = partition (\\uid -> isEmptyUniqDSet\n                    (unitIdFreeHoles uid `uniqDSetMinusUniqSet` done_holes))\n                     uids_to_check\n            done_holes'\n                | ms_hsc_src mod == HsigFile\n                = addOneToUniqSet done_holes (ms_mod_name mod)\n                | otherwise = done_holes\n        liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnitId hsc_env) ready_uids\n\n        -- Remove unwanted tmp files between compilations\n        liftIO (cleanup hsc_env)\n\n        -- Get ready to tie the knot\n        type_env_var <- liftIO $ newIORef emptyNameEnv\n        let hsc_env1 = hsc_env { hsc_type_env_var =\n                                    Just (ms_mod mod, type_env_var) }\n        setSession hsc_env1\n\n        -- Lazily reload the HPT modules participating in the loop.\n        -- See Note [Tying the knot]--if we don't throw out the old HPT\n        -- and reinitalize the knot-tying process, anything that was forced\n        -- while we were previously typechecking won't get updated, this\n        -- was bug #12035.\n        hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done\n        setSession hsc_env2\n\n        mb_mod_info\n            <- handleSourceError\n                   (\\err -> do logger mod (Just err); return Nothing) $ do\n                 mod_info <- liftIO $ upsweep_mod hsc_env2 mHscMessage old_hpt stable_mods\n                                                  mod mod_index nmods\n                 logger mod Nothing -- log warnings\n                 return (Just mod_info)\n\n        case mb_mod_info of\n          Nothing -> return (Failed, done)\n          Just mod_info -> do\n                let this_mod = ms_mod_name mod\n\n                        -- Add new info to hsc_env\n                    hpt1     = addToHpt (hsc_HPT hsc_env2) this_mod mod_info\n                    hsc_env3 = hsc_env2 { hsc_HPT = hpt1, hsc_type_env_var = Nothing }\n\n                        -- Space-saving: delete the old HPT entry\n                        -- for mod BUT if mod is a hs-boot\n                        -- node, don't delete it.  For the\n                        -- interface, the HPT entry is probaby for the\n                        -- main Haskell source file.  Deleting it\n                        -- would force the real module to be recompiled\n                        -- every time.\n                    old_hpt1 | isBootSummary mod = old_hpt\n                             | otherwise = delFromHpt old_hpt this_mod\n\n                    done' = extendMG done mod\n\n                        -- fixup our HomePackageTable after we've finished compiling\n                        -- a mutually-recursive loop.  We have to do this again\n                        -- to make sure we have the final unfoldings, which may\n                        -- not have been computed accurately in the previous\n                        -- retypecheck.\n                hsc_env4 <- liftIO $ reTypecheckLoop hsc_env3 mod done'\n                setSession hsc_env4\n\n                        -- Add any necessary entries to the static pointer\n                        -- table. See Note [Grand plan for static forms] in\n                        -- StaticPtrTable.\n                when (hscTarget (hsc_dflags hsc_env4) == HscInterpreted) $\n                    liftIO $ hscAddSptEntries hsc_env4\n                                 [ spt\n                                 | Just linkable <- pure $ hm_linkable mod_info\n                                 , unlinked <- linkableUnlinked linkable\n                                 , BCOs _ spts <- pure unlinked\n                                 , spt <- spts\n                                 ]\n\n                upsweep' old_hpt1 done' mods (mod_index+1) nmods uids_to_check' done_holes'\n\nunitIdsToCheck :: DynFlags -> [UnitId]\nunitIdsToCheck dflags =\n  nubSort $ concatMap goUnitId (explicitPackages (pkgState dflags))\n where\n  goUnitId uid =\n    case splitUnitIdInsts uid of\n      (_, Just indef) ->\n        let insts = indefUnitIdInsts indef\n        in uid : concatMap (goUnitId . moduleUnitId . snd) insts\n      _ -> []\n\nmaybeGetIfaceDate :: DynFlags -> ModLocation -> IO (Maybe UTCTime)\nmaybeGetIfaceDate dflags location\n | writeInterfaceOnlyMode dflags\n    -- Minor optimization: it should be harmless to check the hi file location\n    -- always, but it's better to avoid hitting the filesystem if possible.\n    = modificationTimeIfExists (ml_hi_file location)\n | otherwise\n    = return Nothing\n\n-- | Compile a single module.  Always produce a Linkable for it if\n-- successful.  If no compilation happened, return the old Linkable.\nupsweep_mod :: HscEnv\n            -> Maybe Messager\n            -> HomePackageTable\n            -> StableModules\n            -> ModSummary\n            -> Int  -- index of module\n            -> Int  -- total number of modules\n            -> IO HomeModInfo\nupsweep_mod hsc_env mHscMessage old_hpt (stable_obj, stable_bco) summary mod_index nmods\n   =    let\n            this_mod_name = ms_mod_name summary\n            this_mod    = ms_mod summary\n            mb_obj_date = ms_obj_date summary\n            mb_if_date  = ms_iface_date summary\n            obj_fn      = ml_obj_file (ms_location summary)\n            hs_date     = ms_hs_date summary\n\n            is_stable_obj = this_mod_name `elementOfUniqSet` stable_obj\n            is_stable_bco = this_mod_name `elementOfUniqSet` stable_bco\n\n            old_hmi = lookupHpt old_hpt this_mod_name\n\n            -- We're using the dflags for this module now, obtained by\n            -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.\n            dflags = ms_hspp_opts summary\n            prevailing_target = hscTarget (hsc_dflags hsc_env)\n            local_target      = hscTarget dflags\n\n            -- If OPTIONS_GHC contains -fasm or -fllvm, be careful that\n            -- we don't do anything dodgy: these should only work to change\n            -- from -fllvm to -fasm and vice-versa, or away from -fno-code,\n            -- otherwise we could end up trying to link object code to byte\n            -- code.\n            target = if prevailing_target /= local_target\n                        && (not (isObjectTarget prevailing_target)\n                            || not (isObjectTarget local_target))\n                        && not (prevailing_target == HscNothing)\n                        then prevailing_target\n                        else local_target\n\n            -- store the corrected hscTarget into the summary\n            summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }\n\n            -- The old interface is ok if\n            --  a) we're compiling a source file, and the old HPT\n            --     entry is for a source file\n            --  b) we're compiling a hs-boot file\n            -- Case (b) allows an hs-boot file to get the interface of its\n            -- real source file on the second iteration of the compilation\n            -- manager, but that does no harm.  Otherwise the hs-boot file\n            -- will always be recompiled\n\n            mb_old_iface\n                = case old_hmi of\n                     Nothing                              -> Nothing\n                     Just hm_info | isBootSummary summary -> Just iface\n                                  | not (mi_boot iface)   -> Just iface\n                                  | otherwise             -> Nothing\n                                   where\n                                     iface = hm_iface hm_info\n\n            compile_it :: Maybe Linkable -> SourceModified -> IO HomeModInfo\n            compile_it  mb_linkable src_modified =\n                  compileOne' Nothing mHscMessage hsc_env summary' mod_index nmods\n                             mb_old_iface mb_linkable src_modified\n\n            compile_it_discard_iface :: Maybe Linkable -> SourceModified\n                                     -> IO HomeModInfo\n            compile_it_discard_iface mb_linkable  src_modified =\n                  compileOne' Nothing mHscMessage hsc_env summary' mod_index nmods\n                             Nothing mb_linkable src_modified\n\n            -- With the HscNothing target we create empty linkables to avoid\n            -- recompilation.  We have to detect these to recompile anyway if\n            -- the target changed since the last compile.\n            is_fake_linkable\n               | Just hmi <- old_hmi, Just l <- hm_linkable hmi =\n                  null (linkableUnlinked l)\n               | otherwise =\n                   -- we have no linkable, so it cannot be fake\n                   False\n\n            implies False _ = True\n            implies True x  = x\n\n        in\n        case () of\n         _\n                -- Regardless of whether we're generating object code or\n                -- byte code, we can always use an existing object file\n                -- if it is *stable* (see checkStability).\n          | is_stable_obj, Just hmi <- old_hmi -> do\n                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                           (text \"skipping stable obj mod:\" <+> ppr this_mod_name)\n                return hmi\n                -- object is stable, and we have an entry in the\n                -- old HPT: nothing to do\n\n          | is_stable_obj, isNothing old_hmi -> do\n                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                           (text \"compiling stable on-disk mod:\" <+> ppr this_mod_name)\n                linkable <- liftIO $ findObjectLinkable this_mod obj_fn\n                              (expectJust \"upsweep1\" mb_obj_date)\n                compile_it (Just linkable) SourceUnmodifiedAndStable\n                -- object is stable, but we need to load the interface\n                -- off disk to make a HMI.\n\n          | not (isObjectTarget target), is_stable_bco,\n            (target /= HscNothing) `implies` not is_fake_linkable ->\n                ASSERT(isJust old_hmi) -- must be in the old_hpt\n                let Just hmi = old_hmi in do\n                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                           (text \"skipping stable BCO mod:\" <+> ppr this_mod_name)\n                return hmi\n                -- BCO is stable: nothing to do\n\n          | not (isObjectTarget target),\n            Just hmi <- old_hmi,\n            Just l <- hm_linkable hmi,\n            not (isObjectLinkable l),\n            (target /= HscNothing) `implies` not is_fake_linkable,\n            linkableTime l >= ms_hs_date summary -> do\n                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                           (text \"compiling non-stable BCO mod:\" <+> ppr this_mod_name)\n                compile_it (Just l) SourceUnmodified\n                -- we have an old BCO that is up to date with respect\n                -- to the source: do a recompilation check as normal.\n\n          -- When generating object code, if there's an up-to-date\n          -- object file on the disk, then we can use it.\n          -- However, if the object file is new (compared to any\n          -- linkable we had from a previous compilation), then we\n          -- must discard any in-memory interface, because this\n          -- means the user has compiled the source file\n          -- separately and generated a new interface, that we must\n          -- read from the disk.\n          --\n          | isObjectTarget target,\n            Just obj_date <- mb_obj_date,\n            obj_date >= hs_date -> do\n                case old_hmi of\n                  Just hmi\n                    | Just l <- hm_linkable hmi,\n                      isObjectLinkable l && linkableTime l == obj_date -> do\n                          liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                                     (text \"compiling mod with new on-disk obj:\" <+> ppr this_mod_name)\n                          compile_it (Just l) SourceUnmodified\n                  _otherwise -> do\n                          liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                                     (text \"compiling mod with new on-disk obj2:\" <+> ppr this_mod_name)\n                          linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date\n                          compile_it_discard_iface (Just linkable) SourceUnmodified\n\n          -- See Note [Recompilation checking in -fno-code mode]\n          | writeInterfaceOnlyMode dflags,\n            Just if_date <- mb_if_date,\n            if_date >= hs_date -> do\n                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                           (text \"skipping tc'd mod:\" <+> ppr this_mod_name)\n                compile_it Nothing SourceUnmodified\n\n         _otherwise -> do\n                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5\n                           (text \"compiling mod:\" <+> ppr this_mod_name)\n                compile_it Nothing SourceModified\n\n\n{- Note [-fno-code mode]\n~~~~~~~~~~~~~~~~~~~~~~~~\nGHC offers the flag -fno-code for the purpose of parsing and typechecking a\nprogram without generating object files. This is intended to be used by tooling\nand IDEs to provide quick feedback on any parser or type errors as cheaply as\npossible.\n\nWhen GHC is invoked with -fno-code no object files or linked output will be\ngenerated. As many errors and warnings as possible will be generated, as if\n-fno-code had not been passed. The session DynFlags will have\nhscTarget == HscNothing.\n\n-fwrite-interface\n~~~~~~~~~~~~~~~~\nWhether interface files are generated in -fno-code mode is controlled by the\n-fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is\nnot also passed. Recompilation avoidance requires interface files, so passing\n-fno-code without -fwrite-interface should be avoided. If -fno-code were\nre-implemented today, -fwrite-interface would be discarded and it would be\nconsidered always on; this behaviour is as it is for backwards compatibility.\n\n================================================================\nIN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER\n================================================================\n\nTemplate Haskell\n~~~~~~~~~~~~~~~~\nA module using template haskell may invoke an imported function from inside a\nsplice. This will cause the type-checker to attempt to execute that code, which\nwould fail if no object files had been generated. See #8025. To rectify this,\nduring the downsweep we patch the DynFlags in the ModSummary of any home module\nthat is imported by a module that uses template haskell, to generate object\ncode.\n\nThe flavour of generated object code is chosen by defaultObjectTarget for the\ntarget platform. It would likely be faster to generate bytecode, but this is not\nsupported on all platforms(?Please Confirm?), and does not support the entirety\nof GHC haskell. See #1257.\n\nThe object files (and interface files if -fwrite-interface is disabled) produced\nfor template haskell are written to temporary files.\n\nNote that since template haskell can run arbitrary IO actions, -fno-code mode\nis no more secure than running without it.\n\nPotential TODOS:\n~~~~~\n* Remove -fwrite-interface and have interface files always written in -fno-code\n  mode\n* Both .o and .dyn_o files are generated for template haskell, but we only need\n  .dyn_o. Fix it.\n* In make mode, a message like\n  Compiling A (A.hs, /tmp/ghc_123.o)\n  is shown if downsweep enabled object code generation for A. Perhaps we should\n  show \"nothing\" or \"temporary object file\" instead. Note that one\n  can currently use -keep-tmp-files and inspect the generated file with the\n  current behaviour.\n* Offer a -no-codedir command line option, and write what were temporary\n  object files there. This would speed up recompilation.\n* Use existing object files (if they are up to date) instead of always\n  generating temporary ones.\n-}\n\n-- Note [Recompilation checking in -fno-code mode]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- If we are compiling with -fno-code -fwrite-interface, there won't\n-- be any object code that we can compare against, nor should there\n-- be: we're *just* generating interface files.  In this case, we\n-- want to check if the interface file is new, in lieu of the object\n-- file.  See also Trac #9243.\n\n-- Filter modules in the HPT\nretainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable\nretainInTopLevelEnvs keep_these hpt\n   = listToHpt   [ (mod, expectJust \"retain\" mb_mod_info)\n                 | mod <- keep_these\n                 , let mb_mod_info = lookupHpt hpt mod\n                 , isJust mb_mod_info ]\n\n-- ---------------------------------------------------------------------------\n-- Typecheck module loops\n{-\nSee bug #930.  This code fixes a long-standing bug in --make.  The\nproblem is that when compiling the modules *inside* a loop, a data\ntype that is only defined at the top of the loop looks opaque; but\nafter the loop is done, the structure of the data type becomes\napparent.\n\nThe difficulty is then that two different bits of code have\ndifferent notions of what the data type looks like.\n\nThe idea is that after we compile a module which also has an .hs-boot\nfile, we re-generate the ModDetails for each of the modules that\ndepends on the .hs-boot file, so that everyone points to the proper\nTyCons, Ids etc. defined by the real module, not the boot module.\nFortunately re-generating a ModDetails from a ModIface is easy: the\nfunction TcIface.typecheckIface does exactly that.\n\nPicking the modules to re-typecheck is slightly tricky.  Starting from\nthe module graph consisting of the modules that have already been\ncompiled, we reverse the edges (so they point from the imported module\nto the importing module), and depth-first-search from the .hs-boot\nnode.  This gives us all the modules that depend transitively on the\n.hs-boot module, and those are exactly the modules that we need to\nre-typecheck.\n\nFollowing this fix, GHC can compile itself with --make -O2.\n-}\n\nreTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv\nreTypecheckLoop hsc_env ms graph\n  | Just loop <- getModLoop ms mss appearsAsBoot\n  -- SOME hs-boot files should still\n  -- get used, just not the loop-closer.\n  , let non_boot = filter (\\l -> not (isBootSummary l &&\n                                 ms_mod l == ms_mod ms)) loop\n  = typecheckLoop (hsc_dflags hsc_env) hsc_env (map ms_mod_name non_boot)\n  | otherwise\n  = return hsc_env\n  where\n  mss = mgModSummaries graph\n  appearsAsBoot = (`elemModuleSet` mgBootModules graph)\n\n-- | Given a non-boot ModSummary @ms@ of a module, for which there exists a\n-- corresponding boot file in @graph@, return the set of modules which\n-- transitively depend on this boot file.  This function is slightly misnamed,\n-- but its name \"getModLoop\" alludes to the fact that, when getModLoop is called\n-- with a graph that does not contain @ms@ (non-parallel case) or is an\n-- SCC with hs-boot nodes dropped (parallel-case), the modules which\n-- depend on the hs-boot file are typically (but not always) the\n-- modules participating in the recursive module loop.  The returned\n-- list includes the hs-boot file.\n--\n-- Example:\n--      let g represent the module graph:\n--          C.hs\n--          A.hs-boot imports C.hs\n--          B.hs imports A.hs-boot\n--          A.hs imports B.hs\n--      genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs]\n--\n--      It would also be permissible to omit A.hs from the graph,\n--      in which case the result is [A.hs-boot, B.hs]\n--\n-- Example:\n--      A counter-example to the claim that modules returned\n--      by this function participate in the loop occurs here:\n--\n--      let g represent the module graph:\n--          C.hs\n--          A.hs-boot imports C.hs\n--          B.hs imports A.hs-boot\n--          A.hs imports B.hs\n--          D.hs imports A.hs-boot\n--      genModLoop A.hs g == Just [A.hs-boot, B.hs, A.hs, D.hs]\n--\n--      Arguably, D.hs should import A.hs, not A.hs-boot, but\n--      a dependency on the boot file is not illegal.\n--\ngetModLoop\n  :: ModSummary\n  -> [ModSummary]\n  -> (Module -> Bool) -- check if a module appears as a boot module in 'graph'\n  -> Maybe [ModSummary]\ngetModLoop ms graph appearsAsBoot\n  | not (isBootSummary ms)\n  , appearsAsBoot this_mod\n  , let mss = reachableBackwards (ms_mod_name ms) graph\n  = Just mss\n  | otherwise\n  = Nothing\n where\n  this_mod = ms_mod ms\n\n-- NB: sometimes mods has duplicates; this is harmless because\n-- any duplicates get clobbered in addListToHpt and never get forced.\ntypecheckLoop :: DynFlags -> HscEnv -> [ModuleName] -> IO HscEnv\ntypecheckLoop dflags hsc_env mods = do\n  debugTraceMsg dflags 2 $\n     text \"Re-typechecking loop: \" <> ppr mods\n  new_hpt <-\n    fixIO $ \\new_hpt -> do\n      let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }\n      mds <- initIfaceCheck (text \"typecheckLoop\") new_hsc_env $\n                mapM (typecheckIface . hm_iface) hmis\n      let new_hpt = addListToHpt old_hpt\n                        (zip mods [ hmi{ hm_details = details }\n                                  | (hmi,details) <- zip hmis mds ])\n      return new_hpt\n  return hsc_env{ hsc_HPT = new_hpt }\n  where\n    old_hpt = hsc_HPT hsc_env\n    hmis    = map (expectJust \"typecheckLoop\" . lookupHpt old_hpt) mods\n\nreachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]\nreachableBackwards mod summaries\n  = [ node_payload node | node <- reachableG (transposeG graph) root ]\n  where -- the rest just sets up the graph:\n        (graph, lookup_node) = moduleGraphNodes False summaries\n        root  = expectJust \"reachableBackwards\" (lookup_node HsBootFile mod)\n\n-- ---------------------------------------------------------------------------\n--\n-- | Topological sort of the module graph\ntopSortModuleGraph\n          :: Bool\n          -- ^ Drop hi-boot nodes? (see below)\n          -> ModuleGraph\n          -> Maybe ModuleName\n             -- ^ Root module name.  If @Nothing@, use the full graph.\n          -> [SCC ModSummary]\n-- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes\n-- The resulting list of strongly-connected-components is in topologically\n-- sorted order, starting with the module(s) at the bottom of the\n-- dependency graph (ie compile them first) and ending with the ones at\n-- the top.\n--\n-- Drop hi-boot nodes (first boolean arg)?\n--\n-- - @False@:   treat the hi-boot summaries as nodes of the graph,\n--              so the graph must be acyclic\n--\n-- - @True@:    eliminate the hi-boot nodes, and instead pretend\n--              the a source-import of Foo is an import of Foo\n--              The resulting graph has no hi-boot nodes, but can be cyclic\n\ntopSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod\n  = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph\n  where\n    summaries = mgModSummaries module_graph\n    -- stronglyConnCompG flips the original order, so if we reverse\n    -- the summaries we get a stable topological sort.\n    (graph, lookup_node) =\n      moduleGraphNodes drop_hs_boot_nodes (reverse summaries)\n\n    initial_graph = case mb_root_mod of\n        Nothing -> graph\n        Just root_mod ->\n            -- restrict the graph to just those modules reachable from\n            -- the specified module.  We do this by building a graph with\n            -- the full set of nodes, and determining the reachable set from\n            -- the specified node.\n            let root | Just node <- lookup_node HsSrcFile root_mod\n                     , graph `hasVertexG` node\n                     = node\n                     | otherwise\n                     = throwGhcException (ProgramError \"module does not exist\")\n            in graphFromEdgedVerticesUniq (seq root (reachableG graph root))\n\ntype SummaryNode = Node Int ModSummary\n\nsummaryNodeKey :: SummaryNode -> Int\nsummaryNodeKey = node_key\n\nsummaryNodeSummary :: SummaryNode -> ModSummary\nsummaryNodeSummary = node_payload\n\nmoduleGraphNodes :: Bool -> [ModSummary]\n  -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)\nmoduleGraphNodes drop_hs_boot_nodes summaries =\n  (graphFromEdgedVerticesUniq nodes, lookup_node)\n  where\n    numbered_summaries = zip summaries [1..]\n\n    lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode\n    lookup_node hs_src mod = Map.lookup (mod, hscSourceToIsBoot hs_src) node_map\n\n    lookup_key :: HscSource -> ModuleName -> Maybe Int\n    lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)\n\n    node_map :: NodeMap SummaryNode\n    node_map = Map.fromList [ ((moduleName (ms_mod s),\n                                hscSourceToIsBoot (ms_hsc_src s)), node)\n                            | node <- nodes\n                            , let s = summaryNodeSummary node ]\n\n    -- We use integers as the keys for the SCC algorithm\n    nodes :: [SummaryNode]\n    nodes = [ DigraphNode s key out_keys\n            | (s, key) <- numbered_summaries\n             -- Drop the hi-boot ones if told to do so\n            , not (isBootSummary s && drop_hs_boot_nodes)\n            , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++\n                             out_edge_keys HsSrcFile   (map unLoc (ms_home_imps s)) ++\n                             (-- see [boot-edges] below\n                              if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile\n                              then []\n                              else case lookup_key HsBootFile (ms_mod_name s) of\n                                    Nothing -> []\n                                    Just k  -> [k]) ]\n\n    -- [boot-edges] if this is a .hs and there is an equivalent\n    -- .hs-boot, add a link from the former to the latter.  This\n    -- has the effect of detecting bogus cases where the .hs-boot\n    -- depends on the .hs, by introducing a cycle.  Additionally,\n    -- it ensures that we will always process the .hs-boot before\n    -- the .hs, and so the HomePackageTable will always have the\n    -- most up to date information.\n\n    -- Drop hs-boot nodes by using HsSrcFile as the key\n    hs_boot_key | drop_hs_boot_nodes = HsSrcFile\n                | otherwise          = HsBootFile\n\n    out_edge_keys :: HscSource -> [ModuleName] -> [Int]\n    out_edge_keys hi_boot ms = mapMaybe (lookup_key hi_boot) ms\n        -- If we want keep_hi_boot_nodes, then we do lookup_key with\n        -- IsBoot; else NotBoot\n\n-- The nodes of the graph are keyed by (mod, is boot?) pairs\n-- NB: hsig files show up as *normal* nodes (not boot!), since they don't\n-- participate in cycles (for now)\ntype NodeKey   = (ModuleName, IsBoot)\ntype NodeMap a = Map.Map NodeKey a\n\nmsKey :: ModSummary -> NodeKey\nmsKey (ModSummary { ms_mod = mod, ms_hsc_src = boot })\n    = (moduleName mod, hscSourceToIsBoot boot)\n\nmkNodeMap :: [ModSummary] -> NodeMap ModSummary\nmkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries]\n\nnodeMapElts :: NodeMap a -> [a]\nnodeMapElts = Map.elems\n\n-- | If there are {-# SOURCE #-} imports between strongly connected\n-- components in the topological sort, then those imports can\n-- definitely be replaced by ordinary non-SOURCE imports: if SOURCE\n-- were necessary, then the edge would be part of a cycle.\nwarnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()\nwarnUnnecessarySourceImports sccs = do\n  dflags <- getDynFlags\n  when (wopt Opt_WarnUnusedImports dflags)\n    (logWarnings (listToBag (concatMap (check dflags . flattenSCC) sccs)))\n  where check dflags ms =\n           let mods_in_this_cycle = map ms_mod_name ms in\n           [ warn dflags i | m <- ms, i <- ms_home_srcimps m,\n                             unLoc i `notElem`  mods_in_this_cycle ]\n\n        warn :: DynFlags -> Located ModuleName -> WarnMsg\n        warn dflags (L loc mod) =\n           mkPlainErrMsg dflags loc\n                (text \"Warning: {-# SOURCE #-} unnecessary in import of \"\n                 <+> quotes (ppr mod))\n\n\nreportImportErrors :: MonadIO m => [Either ErrMsg b] -> m [b]\nreportImportErrors xs | null errs = return oks\n                      | otherwise = throwManyErrors errs\n  where (errs, oks) = partitionEithers xs\n\nthrowManyErrors :: MonadIO m => [ErrMsg] -> m ab\nthrowManyErrors errs = liftIO $ throwIO $ mkSrcErr $ listToBag errs\n\n\n-----------------------------------------------------------------------------\n--\n-- | Downsweep (dependency analysis)\n--\n-- Chase downwards from the specified root set, returning summaries\n-- for all home modules encountered.  Only follow source-import\n-- links.\n--\n-- We pass in the previous collection of summaries, which is used as a\n-- cache to avoid recalculating a module summary if the source is\n-- unchanged.\n--\n-- The returned list of [ModSummary] nodes has one node for each home-package\n-- module, plus one for any hs-boot files.  The imports of these nodes\n-- are all there, including the imports of non-home-package modules.\ndownsweep :: HscEnv\n          -> [ModSummary]       -- Old summaries\n          -> [ModuleName]       -- Ignore dependencies on these; treat\n                                -- them as if they were package modules\n          -> Bool               -- True <=> allow multiple targets to have\n                                --          the same module name; this is\n                                --          very useful for ghc -M\n          -> IO [Either ErrMsg ModSummary]\n                -- The elts of [ModSummary] all have distinct\n                -- (Modules, IsBoot) identifiers, unless the Bool is true\n                -- in which case there can be repeats\ndownsweep hsc_env old_summaries excl_mods allow_dup_roots\n   = do\n       rootSummaries <- mapM getRootSummary roots\n       rootSummariesOk <- reportImportErrors rootSummaries\n       let root_map = mkRootMap rootSummariesOk\n       checkDuplicates root_map\n       map0 <- loop (concatMap calcDeps rootSummariesOk) root_map\n       -- if we have been passed -fno-code, we enable code generation\n       -- for dependencies of modules that have -XTemplateHaskell,\n       -- otherwise those modules will fail to compile.\n       -- See Note [-fno-code mode] #8025\n       map1 <- if hscTarget dflags == HscNothing\n         then enableCodeGenForTH\n           (defaultObjectTarget (targetPlatform dflags))\n           map0\n         else return map0\n       return $ concat $ nodeMapElts map1\n     where\n        calcDeps = msDeps\n\n        dflags = hsc_dflags hsc_env\n        roots = hsc_targets hsc_env\n\n        old_summary_map :: NodeMap ModSummary\n        old_summary_map = mkNodeMap old_summaries\n\n        getRootSummary :: Target -> IO (Either ErrMsg ModSummary)\n        getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)\n           = do exists <- liftIO $ doesFileExist file\n                if exists\n                    then Right `fmap` summariseFile hsc_env old_summaries file mb_phase\n                                       obj_allowed maybe_buf\n                    else return $ Left $ mkPlainErrMsg dflags noSrcSpan $\n                           text \"can't find file:\" <+> text file\n        getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)\n           = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot\n                                           (L rootLoc modl) obj_allowed\n                                           maybe_buf excl_mods\n                case maybe_summary of\n                   Nothing -> return $ Left $ moduleNotFoundErr dflags modl\n                   Just s  -> return s\n\n        rootLoc = mkGeneralSrcSpan (fsLit \"<command line>\")\n\n        -- In a root module, the filename is allowed to diverge from the module\n        -- name, so we have to check that there aren't multiple root files\n        -- defining the same module (otherwise the duplicates will be silently\n        -- ignored, leading to confusing behaviour).\n        checkDuplicates :: NodeMap [Either ErrMsg ModSummary] -> IO ()\n        checkDuplicates root_map\n           | allow_dup_roots = return ()\n           | null dup_roots  = return ()\n           | otherwise       = liftIO $ multiRootsErr dflags (head dup_roots)\n           where\n             dup_roots :: [[ModSummary]]        -- Each at least of length 2\n             dup_roots = filterOut isSingleton $ map rights $ nodeMapElts root_map\n\n        loop :: [(Located ModuleName,IsBoot)]\n                        -- Work list: process these modules\n             -> NodeMap [Either ErrMsg ModSummary]\n                        -- Visited set; the range is a list because\n                        -- the roots can have the same module names\n                        -- if allow_dup_roots is True\n             -> IO (NodeMap [Either ErrMsg ModSummary])\n                        -- The result is the completed NodeMap\n        loop [] done = return done\n        loop ((wanted_mod, is_boot) : ss) done\n          | Just summs <- Map.lookup key done\n          = if isSingleton summs then\n                loop ss done\n            else\n                do { multiRootsErr dflags (rights summs); return Map.empty }\n          | otherwise\n          = do mb_s <- summariseModule hsc_env old_summary_map\n                                       is_boot wanted_mod True\n                                       Nothing excl_mods\n               case mb_s of\n                   Nothing -> loop ss done\n                   Just (Left e) -> loop ss (Map.insert key [Left e] done)\n                   Just (Right s)-> do\n                     new_map <-\n                       loop (calcDeps s) (Map.insert key [Right s] done)\n                     loop ss new_map\n          where\n            key = (unLoc wanted_mod, is_boot)\n\n-- | Update the every ModSummary that is depended on\n-- by a module that needs template haskell. We enable codegen to\n-- the specified target, disable optimization and change the .hi\n-- and .o file locations to be temporary files.\n-- See Note [-fno-code mode]\nenableCodeGenForTH :: HscTarget\n  -> NodeMap [Either ErrMsg ModSummary]\n  -> IO (NodeMap [Either ErrMsg ModSummary])\nenableCodeGenForTH target nodemap =\n  traverse (traverse (traverse enable_code_gen)) nodemap\n  where\n    enable_code_gen ms\n      | ModSummary\n        { ms_mod = ms_mod\n        , ms_location = ms_location\n        , ms_hsc_src = HsSrcFile\n        , ms_hspp_opts = dflags@DynFlags\n          {hscTarget = HscNothing}\n        } <- ms\n      -- Don't enable codegen for TH on indefinite packages; we\n      -- can't compile anything anyway! See #16219.\n      , not (isIndefinite dflags)\n      , ms_mod `Set.member` needs_codegen_set\n      = do\n        let new_temp_file suf dynsuf = do\n              tn <- newTempName dflags TFL_CurrentModule suf\n              let dyn_tn = tn -<.> dynsuf\n              addFilesToClean dflags TFL_GhcSession [dyn_tn]\n              return tn\n          -- We don't want to create .o or .hi files unless we have been asked\n          -- to by the user. But we need them, so we patch their locations in\n          -- the ModSummary with temporary files.\n          --\n        hi_file <-\n          if gopt Opt_WriteInterface dflags\n            then return $ ml_hi_file ms_location\n            else new_temp_file (hiSuf dflags) (dynHiSuf dflags)\n        o_temp_file <- new_temp_file (objectSuf dflags) (dynObjectSuf dflags)\n        return $\n          ms\n          { ms_location =\n              ms_location {ml_hi_file = hi_file, ml_obj_file = o_temp_file}\n          , ms_hspp_opts = updOptLevel 0 $ dflags {hscTarget = target}\n          }\n      | otherwise = return ms\n\n    needs_codegen_set = transitive_deps_set\n      [ ms\n      | mss <- Map.elems nodemap\n      , Right ms <- mss\n      , isTemplateHaskellOrQQNonBoot ms\n      ]\n\n    -- find the set of all transitive dependencies of a list of modules.\n    transitive_deps_set modSums = foldl' go Set.empty modSums\n      where\n        go marked_mods ms@ModSummary{ms_mod}\n          | ms_mod `Set.member` marked_mods = marked_mods\n          | otherwise =\n            let deps =\n                  [ dep_ms\n                  -- If a module imports a boot module, msDeps helpfully adds a\n                  -- dependency to that non-boot module in it's result. This\n                  -- means we don't have to think about boot modules here.\n                  | (L _ mn, NotBoot) <- msDeps ms\n                  , dep_ms <-\n                      toList (Map.lookup (mn, NotBoot) nodemap) >>= toList >>=\n                      toList\n                  ]\n                new_marked_mods = Set.insert ms_mod marked_mods\n            in foldl' go new_marked_mods deps\n\nmkRootMap :: [ModSummary] -> NodeMap [Either ErrMsg ModSummary]\nmkRootMap summaries = Map.insertListWith (flip (++))\n                                         [ (msKey s, [Right s]) | s <- summaries ]\n                                         Map.empty\n\n-- | Returns the dependencies of the ModSummary s.\n-- A wrinkle is that for a {-# SOURCE #-} import we return\n--      *both* the hs-boot file\n--      *and* the source file\n-- as \"dependencies\".  That ensures that the list of all relevant\n-- modules always contains B.hs if it contains B.hs-boot.\n-- Remember, this pass isn't doing the topological sort.  It's\n-- just gathering the list of all relevant ModSummaries\nmsDeps :: ModSummary -> [(Located ModuleName, IsBoot)]\nmsDeps s =\n    concat [ [(m,IsBoot), (m,NotBoot)] | m <- ms_home_srcimps s ]\n        ++ [ (m,NotBoot) | m <- ms_home_imps s ]\n\nhome_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]\nhome_imps imps = [ lmodname |  (mb_pkg, lmodname) <- imps,\n                                  isLocal mb_pkg ]\n  where isLocal Nothing = True\n        isLocal (Just pkg) | pkg == fsLit \"this\" = True -- \"this\" is special\n        isLocal _ = False\n\nms_home_allimps :: ModSummary -> [ModuleName]\nms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)\n\n-- | Like 'ms_home_imps', but for SOURCE imports.\nms_home_srcimps :: ModSummary -> [Located ModuleName]\nms_home_srcimps = home_imps . ms_srcimps\n\n-- | All of the (possibly) home module imports from a\n-- 'ModSummary'; that is to say, each of these module names\n-- could be a home import if an appropriately named file\n-- existed.  (This is in contrast to package qualified\n-- imports, which are guaranteed not to be home imports.)\nms_home_imps :: ModSummary -> [Located ModuleName]\nms_home_imps = home_imps . ms_imps\n\n-----------------------------------------------------------------------------\n-- Summarising modules\n\n-- We have two types of summarisation:\n--\n--    * Summarise a file.  This is used for the root module(s) passed to\n--      cmLoadModules.  The file is read, and used to determine the root\n--      module name.  The module name may differ from the filename.\n--\n--    * Summarise a module.  We are given a module name, and must provide\n--      a summary.  The finder is used to locate the file in which the module\n--      resides.\n\nsummariseFile\n        :: HscEnv\n        -> [ModSummary]                 -- old summaries\n        -> FilePath                     -- source file name\n        -> Maybe Phase                  -- start phase\n        -> Bool                         -- object code allowed?\n        -> Maybe (StringBuffer,UTCTime)\n        -> IO ModSummary\n\nsummariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf\n        -- we can use a cached summary if one is available and the\n        -- source file hasn't changed,  But we have to look up the summary\n        -- by source file, rather than module name as we do in summarise.\n   | Just old_summary <- findSummaryBySourceFile old_summaries file\n   = do\n        let location = ms_location old_summary\n            dflags = hsc_dflags hsc_env\n\n        src_timestamp <- get_src_timestamp\n                -- The file exists; we checked in getRootSummary above.\n                -- If it gets removed subsequently, then this\n                -- getModificationUTCTime may fail, but that's the right\n                -- behaviour.\n\n                -- return the cached summary if the source didn't change\n        if ms_hs_date old_summary == src_timestamp &&\n           not (gopt Opt_ForceRecomp (hsc_dflags hsc_env))\n           then do -- update the object-file timestamp\n                  obj_timestamp <-\n                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))\n                        || obj_allowed -- bug #1205\n                        then liftIO $ getObjTimestamp location NotBoot\n                        else return Nothing\n                  hi_timestamp <- maybeGetIfaceDate dflags location\n                  let hie_location = ml_hie_file location\n                  hie_timestamp <- modificationTimeIfExists hie_location\n\n                  -- We have to repopulate the Finder's cache because it\n                  -- was flushed before the downsweep.\n                  _ <- liftIO $ addHomeModuleToFinder hsc_env\n                    (moduleName (ms_mod old_summary)) (ms_location old_summary)\n\n                  return old_summary{ ms_obj_date = obj_timestamp\n                                    , ms_iface_date = hi_timestamp\n                                    , ms_hie_date = hie_timestamp }\n           else\n                new_summary src_timestamp\n\n   | otherwise\n   = do src_timestamp <- get_src_timestamp\n        new_summary src_timestamp\n  where\n    get_src_timestamp = case maybe_buf of\n                           Just (_,t) -> return t\n                           Nothing    -> liftIO $ getModificationUTCTime file\n                        -- getModificationUTCTime may fail\n\n    new_summary src_timestamp = do\n        let dflags = hsc_dflags hsc_env\n\n        let hsc_src = if isHaskellSigFilename file then HsigFile else HsSrcFile\n\n        (dflags', hspp_fn, buf)\n            <- preprocessFile hsc_env file mb_phase maybe_buf\n\n        (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file\n\n        -- Make a ModLocation for this file\n        location <- liftIO $ mkHomeModLocation dflags mod_name file\n\n        -- Tell the Finder cache where it is, so that subsequent calls\n        -- to findModule will find it, even if it's not on any search path\n        mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location\n\n        -- when the user asks to load a source file by name, we only\n        -- use an object file if -fobject-code is on.  See #1205.\n        obj_timestamp <-\n            if isObjectTarget (hscTarget (hsc_dflags hsc_env))\n               || obj_allowed -- bug #1205\n                then liftIO $ modificationTimeIfExists (ml_obj_file location)\n                else return Nothing\n\n        hi_timestamp <- maybeGetIfaceDate dflags location\n        hie_timestamp <- modificationTimeIfExists (ml_hie_file location)\n\n        extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name\n        required_by_imports <- implicitRequirements hsc_env the_imps\n\n        return (ModSummary { ms_mod = mod,\n                             ms_hsc_src = hsc_src,\n                             ms_location = location,\n                             ms_hspp_file = hspp_fn,\n                             ms_hspp_opts = dflags',\n                             ms_hspp_buf  = Just buf,\n                             ms_parsed_mod = Nothing,\n                             ms_srcimps = srcimps,\n                             ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,\n                             ms_hs_date = src_timestamp,\n                             ms_iface_date = hi_timestamp,\n                             ms_hie_date = hie_timestamp,\n                             ms_obj_date = obj_timestamp })\n\nfindSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary\nfindSummaryBySourceFile summaries file\n  = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],\n                                 expectJust \"findSummaryBySourceFile\" (ml_hs_file (ms_location ms)) == file ] of\n        [] -> Nothing\n        (x:_) -> Just x\n\n-- Summarise a module, and pick up source and timestamp.\nsummariseModule\n          :: HscEnv\n          -> NodeMap ModSummary -- Map of old summaries\n          -> IsBoot             -- IsBoot <=> a {-# SOURCE #-} import\n          -> Located ModuleName -- Imported module to be summarised\n          -> Bool               -- object code allowed?\n          -> Maybe (StringBuffer, UTCTime)\n          -> [ModuleName]               -- Modules to exclude\n          -> IO (Maybe (Either ErrMsg ModSummary))      -- Its new summary\n\nsummariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)\n                obj_allowed maybe_buf excl_mods\n  | wanted_mod `elem` excl_mods\n  = return Nothing\n\n  | Just old_summary <- Map.lookup (wanted_mod, is_boot) old_summary_map\n  = do          -- Find its new timestamp; all the\n                -- ModSummaries in the old map have valid ml_hs_files\n        let location = ms_location old_summary\n            src_fn = expectJust \"summariseModule\" (ml_hs_file location)\n\n                -- check the modification time on the source file, and\n                -- return the cached summary if it hasn't changed.  If the\n                -- file has disappeared, we need to call the Finder again.\n        case maybe_buf of\n           Just (_,t) -> check_timestamp old_summary location src_fn t\n           Nothing    -> do\n                m <- tryIO (getModificationUTCTime src_fn)\n                case m of\n                   Right t -> check_timestamp old_summary location src_fn t\n                   Left e | isDoesNotExistError e -> find_it\n                          | otherwise             -> ioError e\n\n  | otherwise  = find_it\n  where\n    dflags = hsc_dflags hsc_env\n\n    check_timestamp old_summary location src_fn src_timestamp\n        | ms_hs_date old_summary == src_timestamp &&\n          not (gopt Opt_ForceRecomp dflags) = do\n                -- update the object-file timestamp\n                obj_timestamp <-\n                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))\n                       || obj_allowed -- bug #1205\n                       then getObjTimestamp location is_boot\n                       else return Nothing\n                hi_timestamp <- maybeGetIfaceDate dflags location\n                hie_timestamp <- modificationTimeIfExists (ml_hie_file location)\n                return (Just (Right old_summary{ ms_obj_date = obj_timestamp\n                                               , ms_iface_date = hi_timestamp\n                                               , ms_hie_date = hie_timestamp }))\n        | otherwise =\n                -- source changed: re-summarise.\n                new_summary location (ms_mod old_summary) src_fn src_timestamp\n\n    find_it = do\n        found <- findImportedModule hsc_env wanted_mod Nothing\n        case found of\n             Found location mod\n                | isJust (ml_hs_file location) ->\n                        -- Home package\n                         just_found location mod\n\n             _ -> return Nothing\n                        -- Not found\n                        -- (If it is TRULY not found at all, we'll\n                        -- error when we actually try to compile)\n\n    just_found location mod = do\n                -- Adjust location to point to the hs-boot source file,\n                -- hi file, object file, when is_boot says so\n        let location' | IsBoot <- is_boot = addBootSuffixLocn location\n                      | otherwise         = location\n            src_fn = expectJust \"summarise2\" (ml_hs_file location')\n\n                -- Check that it exists\n                -- It might have been deleted since the Finder last found it\n        maybe_t <- modificationTimeIfExists src_fn\n        case maybe_t of\n          Nothing -> return $ Just $ Left $ noHsFileErr dflags loc src_fn\n          Just t  -> new_summary location' mod src_fn t\n\n\n    new_summary location mod src_fn src_timestamp\n      = do\n        -- Preprocess the source file and get its imports\n        -- The dflags' contains the OPTIONS pragmas\n        (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf\n        (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn\n\n        -- NB: Despite the fact that is_boot is a top-level parameter, we\n        -- don't actually know coming into this function what the HscSource\n        -- of the module in question is.  This is because we may be processing\n        -- this module because another module in the graph imported it: in this\n        -- case, we know if it's a boot or not because of the {-# SOURCE #-}\n        -- annotation, but we don't know if it's a signature or a regular\n        -- module until we actually look it up on the filesystem.\n        let hsc_src = case is_boot of\n                IsBoot -> HsBootFile\n                _ | isHaskellSigFilename src_fn -> HsigFile\n                  | otherwise -> HsSrcFile\n\n        when (mod_name /= wanted_mod) $\n                throwOneError $ mkPlainErrMsg dflags' mod_loc $\n                              text \"File name does not match module name:\"\n                              $$ text \"Saw:\" <+> quotes (ppr mod_name)\n                              $$ text \"Expected:\" <+> quotes (ppr wanted_mod)\n\n        when (hsc_src == HsigFile && isNothing (lookup mod_name (thisUnitIdInsts dflags))) $\n            let suggested_instantiated_with =\n                    hcat (punctuate comma $\n                        [ ppr k <> text \"=\" <> ppr v\n                        | (k,v) <- ((mod_name, mkHoleModule mod_name)\n                                : thisUnitIdInsts dflags)\n                        ])\n            in throwOneError $ mkPlainErrMsg dflags' mod_loc $\n                text \"Unexpected signature:\" <+> quotes (ppr mod_name)\n                $$ if gopt Opt_BuildingCabalPackage dflags\n                    then parens (text \"Try adding\" <+> quotes (ppr mod_name)\n                            <+> text \"to the\"\n                            <+> quotes (text \"signatures\")\n                            <+> text \"field in your Cabal file.\")\n                    else parens (text \"Try passing -instantiated-with=\\\"\" <>\n                                 suggested_instantiated_with <> text \"\\\"\" $$\n                                text \"replacing <\" <> ppr mod_name <> text \"> as necessary.\")\n\n                -- Find the object timestamp, and return the summary\n        obj_timestamp <-\n           if isObjectTarget (hscTarget (hsc_dflags hsc_env))\n              || obj_allowed -- bug #1205\n              then getObjTimestamp location is_boot\n              else return Nothing\n\n        hi_timestamp <- maybeGetIfaceDate dflags location\n        hie_timestamp <- modificationTimeIfExists (ml_hie_file location)\n\n        extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name\n        required_by_imports <- implicitRequirements hsc_env the_imps\n\n        return (Just (Right (ModSummary { ms_mod       = mod,\n                              ms_hsc_src   = hsc_src,\n                              ms_location  = location,\n                              ms_hspp_file = hspp_fn,\n                              ms_hspp_opts = dflags',\n                              ms_hspp_buf  = Just buf,\n                              ms_parsed_mod = Nothing,\n                              ms_srcimps      = srcimps,\n                              ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,\n                              ms_hs_date   = src_timestamp,\n                              ms_iface_date = hi_timestamp,\n                              ms_hie_date = hie_timestamp,\n                              ms_obj_date  = obj_timestamp })))\n\n\ngetObjTimestamp :: ModLocation -> IsBoot -> IO (Maybe UTCTime)\ngetObjTimestamp location is_boot\n  = if is_boot == IsBoot then return Nothing\n                         else modificationTimeIfExists (ml_obj_file location)\n\n\npreprocessFile :: HscEnv\n               -> FilePath\n               -> Maybe Phase -- ^ Starting phase\n               -> Maybe (StringBuffer,UTCTime)\n               -> IO (DynFlags, FilePath, StringBuffer)\npreprocessFile hsc_env src_fn mb_phase Nothing\n  = do\n        (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)\n        buf <- hGetStringBuffer hspp_fn\n        return (dflags', hspp_fn, buf)\n\npreprocessFile hsc_env src_fn mb_phase (Just (buf, _time))\n  = do\n        let dflags = hsc_dflags hsc_env\n        let local_opts = getOptions dflags buf src_fn\n\n        (dflags', leftovers, warns)\n            <- parseDynamicFilePragma dflags local_opts\n        checkProcessArgsResult dflags leftovers\n        handleFlagWarnings dflags' warns\n\n        let needs_preprocessing\n                | Just (Unlit _) <- mb_phase    = True\n                | Nothing <- mb_phase, Unlit _ <- startPhase src_fn  = True\n                  -- note: local_opts is only required if there's no Unlit phase\n                | xopt LangExt.Cpp dflags'      = True\n                | gopt Opt_Pp  dflags'          = True\n                | otherwise                     = False\n\n        when needs_preprocessing $\n           throwGhcExceptionIO (ProgramError \"buffer needs preprocesing; interactive check disabled\")\n\n        return (dflags', src_fn, buf)\n\n\n-----------------------------------------------------------------------------\n--                      Error messages\n-----------------------------------------------------------------------------\n\n-- Defer and group warning, error and fatal messages so they will not get lost\n-- in the regular output.\nwithDeferredDiagnostics :: GhcMonad m => m a -> m a\nwithDeferredDiagnostics f = do\n  dflags <- getDynFlags\n  if not $ gopt Opt_DeferDiagnostics dflags\n  then f\n  else do\n    warnings <- liftIO $ newIORef []\n    errors <- liftIO $ newIORef []\n    fatals <- liftIO $ newIORef []\n\n    let deferDiagnostics _dflags !reason !severity !srcSpan !style !msg = do\n          let action = putLogMsg dflags reason severity srcSpan style msg\n          case severity of\n            SevWarning -> atomicModifyIORef' warnings $ \\i -> (action: i, ())\n            SevError -> atomicModifyIORef' errors $ \\i -> (action: i, ())\n            SevFatal -> atomicModifyIORef' fatals $ \\i -> (action: i, ())\n            _ -> action\n\n        printDeferredDiagnostics = liftIO $\n          forM_ [warnings, errors, fatals] $ \\ref -> do\n            -- This IORef can leak when the dflags leaks, so let us always\n            -- reset the content.\n            actions <- atomicModifyIORef' ref $ \\i -> ([], i)\n            sequence_ $ reverse actions\n\n        setLogAction action = modifySession $ \\hsc_env ->\n          hsc_env{ hsc_dflags = (hsc_dflags hsc_env){ log_action = action } }\n\n    gbracket\n      (setLogAction deferDiagnostics)\n      (\\_ -> setLogAction (log_action dflags) >> printDeferredDiagnostics)\n      (\\_ -> f)\n\nnoModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> ErrMsg\n-- ToDo: we don't have a proper line number for this error\nnoModError dflags loc wanted_mod err\n  = mkPlainErrMsg dflags loc $ cannotFindModule dflags wanted_mod err\n\nnoHsFileErr :: DynFlags -> SrcSpan -> String -> ErrMsg\nnoHsFileErr dflags loc path\n  = mkPlainErrMsg dflags loc $ text \"Can't find\" <+> text path\n\nmoduleNotFoundErr :: DynFlags -> ModuleName -> ErrMsg\nmoduleNotFoundErr dflags mod\n  = mkPlainErrMsg dflags noSrcSpan $\n        text \"module\" <+> quotes (ppr mod) <+> text \"cannot be found locally\"\n\nmultiRootsErr :: DynFlags -> [ModSummary] -> IO ()\nmultiRootsErr _      [] = panic \"multiRootsErr\"\nmultiRootsErr dflags summs@(summ1:_)\n  = throwOneError $ mkPlainErrMsg dflags noSrcSpan $\n        text \"module\" <+> quotes (ppr mod) <+>\n        text \"is defined in multiple files:\" <+>\n        sep (map text files)\n  where\n    mod = ms_mod summ1\n    files = map (expectJust \"checkDup\" . ml_hs_file . ms_location) summs\n\ncyclicModuleErr :: [ModSummary] -> SDoc\n-- From a strongly connected component we find\n-- a single cycle to report\ncyclicModuleErr mss\n  = ASSERT( not (null mss) )\n    case findCycle graph of\n       Nothing   -> text \"Unexpected non-cycle\" <+> ppr mss\n       Just path -> vcat [ text \"Module imports form a cycle:\"\n                         , nest 2 (show_path path) ]\n  where\n    graph :: [Node NodeKey ModSummary]\n    graph = [ DigraphNode ms (msKey ms) (get_deps ms) | ms <- mss]\n\n    get_deps :: ModSummary -> [NodeKey]\n    get_deps ms = ([ (unLoc m, IsBoot)  | m <- ms_home_srcimps ms ] ++\n                   [ (unLoc m, NotBoot) | m <- ms_home_imps    ms ])\n\n    show_path []         = panic \"show_path\"\n    show_path [m]        = text \"module\" <+> ppr_ms m\n                           <+> text \"imports itself\"\n    show_path (m1:m2:ms) = vcat ( nest 7 (text \"module\" <+> ppr_ms m1)\n                                : nest 6 (text \"imports\" <+> ppr_ms m2)\n                                : go ms )\n       where\n         go []     = [text \"which imports\" <+> ppr_ms m1]\n         go (m:ms) = (text \"which imports\" <+> ppr_ms m) : go ms\n\n\n    ppr_ms :: ModSummary -> SDoc\n    ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>\n                (parens (text (msHsFilePath ms)))\n", "num_lines": 2554}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, RankNTypes #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 2010\n--\n-- The Session type and related functionality\n--\n-- -----------------------------------------------------------------------------\n\nmodule GhcMonad (\n        -- * 'Ghc' monad stuff\n        GhcMonad(..),\n        Ghc(..),\n        GhcT(..), liftGhcT,\n        reflectGhc, reifyGhc,\n        getSessionDynFlags,\n        liftIO,\n        Session(..), withSession, modifySession, withTempSession,\n\n        -- ** Warnings\n        logWarnings, printException,\n        WarnErrLogger, defaultWarnErrLogger\n  ) where\n\nimport GhcPrelude\n\nimport MonadUtils\nimport HscTypes\nimport DynFlags\nimport Exception\nimport ErrUtils\n\nimport Control.Monad\nimport Data.IORef\n\n-- -----------------------------------------------------------------------------\n-- | A monad that has all the features needed by GHC API calls.\n--\n-- In short, a GHC monad\n--\n--   - allows embedding of IO actions,\n--\n--   - can log warnings,\n--\n--   - allows handling of (extensible) exceptions, and\n--\n--   - maintains a current session.\n--\n-- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'\n-- before any call to the GHC API functions can occur.\n--\nclass (Functor m, MonadIO m, ExceptionMonad m, HasDynFlags m) => GhcMonad m where\n  getSession :: m HscEnv\n  setSession :: HscEnv -> m ()\n\n-- | Call the argument with the current session.\nwithSession :: GhcMonad m => (HscEnv -> m a) -> m a\nwithSession f = getSession >>= f\n\n-- | Grabs the DynFlags from the Session\ngetSessionDynFlags :: GhcMonad m => m DynFlags\ngetSessionDynFlags = withSession (return . hsc_dflags)\n\n-- | Set the current session to the result of applying the current session to\n-- the argument.\nmodifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()\nmodifySession f = do h <- getSession\n                     setSession $! f h\n\nwithSavedSession :: GhcMonad m => m a -> m a\nwithSavedSession m = do\n  saved_session <- getSession\n  m `gfinally` setSession saved_session\n\n-- | Call an action with a temporarily modified Session.\nwithTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a\nwithTempSession f m =\n  withSavedSession $ modifySession f >> m\n\n-- -----------------------------------------------------------------------------\n-- | A monad that allows logging of warnings.\n\nlogWarnings :: GhcMonad m => WarningMessages -> m ()\nlogWarnings warns = do\n  dflags <- getSessionDynFlags\n  liftIO $ printOrThrowWarnings dflags warns\n\n-- -----------------------------------------------------------------------------\n-- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,\n-- e.g., to maintain additional state consider wrapping this monad or using\n-- 'GhcT'.\nnewtype Ghc a = Ghc { unGhc :: Session -> IO a }\n\n-- | The Session is a handle to the complete state of a compilation\n-- session.  A compilation session consists of a set of modules\n-- constituting the current program or library, the context for\n-- interactive evaluation, and various caches.\ndata Session = Session !(IORef HscEnv)\n\ninstance Functor Ghc where\n  fmap f m = Ghc $ \\s -> f `fmap` unGhc m s\n\ninstance Applicative Ghc where\n  pure a = Ghc $ \\_ -> return a\n  g <*> m = do f <- g; a <- m; return (f a)\n\ninstance Monad Ghc where\n  m >>= g  = Ghc $ \\s -> do a <- unGhc m s; unGhc (g a) s\n\ninstance MonadIO Ghc where\n  liftIO ioA = Ghc $ \\_ -> ioA\n\ninstance MonadFix Ghc where\n  mfix f = Ghc $ \\s -> mfix (\\x -> unGhc (f x) s)\n\ninstance ExceptionMonad Ghc where\n  gcatch act handle =\n      Ghc $ \\s -> unGhc act s `gcatch` \\e -> unGhc (handle e) s\n  gmask f =\n      Ghc $ \\s -> gmask $ \\io_restore ->\n                             let\n                                g_restore (Ghc m) = Ghc $ \\s -> io_restore (m s)\n                             in\n                                unGhc (f g_restore) s\n\ninstance HasDynFlags Ghc where\n  getDynFlags = getSessionDynFlags\n\ninstance GhcMonad Ghc where\n  getSession = Ghc $ \\(Session r) -> readIORef r\n  setSession s' = Ghc $ \\(Session r) -> writeIORef r s'\n\n-- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.\n--\n-- You can use this to call functions returning an action in the 'Ghc' monad\n-- inside an 'IO' action.  This is needed for some (too restrictive) callback\n-- arguments of some library functions:\n--\n-- > libFunc :: String -> (Int -> IO a) -> IO a\n-- > ghcFunc :: Int -> Ghc a\n-- >\n-- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a\n-- > ghcFuncUsingLibFunc str =\n-- >   reifyGhc $ \\s ->\n-- >     libFunc $ \\i -> do\n-- >       reflectGhc (ghcFunc i) s\n--\nreflectGhc :: Ghc a -> Session -> IO a\nreflectGhc m = unGhc m\n\n-- > Dual to 'reflectGhc'.  See its documentation.\nreifyGhc :: (Session -> IO a) -> Ghc a\nreifyGhc act = Ghc $ act\n\n-- -----------------------------------------------------------------------------\n-- | A monad transformer to add GHC specific features to another monad.\n--\n-- Note that the wrapped monad must support IO and handling of exceptions.\nnewtype GhcT m a = GhcT { unGhcT :: Session -> m a }\n\nliftGhcT :: m a -> GhcT m a\nliftGhcT m = GhcT $ \\_ -> m\n\ninstance Functor m => Functor (GhcT m) where\n  fmap f m = GhcT $ \\s -> f `fmap` unGhcT m s\n\ninstance Applicative m => Applicative (GhcT m) where\n  pure x  = GhcT $ \\_ -> pure x\n  g <*> m = GhcT $ \\s -> unGhcT g s <*> unGhcT m s\n\ninstance Monad m => Monad (GhcT m) where\n  m >>= k  = GhcT $ \\s -> do a <- unGhcT m s; unGhcT (k a) s\n\ninstance MonadIO m => MonadIO (GhcT m) where\n  liftIO ioA = GhcT $ \\_ -> liftIO ioA\n\ninstance ExceptionMonad m => ExceptionMonad (GhcT m) where\n  gcatch act handle =\n      GhcT $ \\s -> unGhcT act s `gcatch` \\e -> unGhcT (handle e) s\n  gmask f =\n      GhcT $ \\s -> gmask $ \\io_restore ->\n                           let\n                              g_restore (GhcT m) = GhcT $ \\s -> io_restore (m s)\n                           in\n                              unGhcT (f g_restore) s\n\ninstance MonadIO m => HasDynFlags (GhcT m) where\n  getDynFlags = GhcT $ \\(Session r) -> liftM hsc_dflags (liftIO $ readIORef r)\n\ninstance ExceptionMonad m => GhcMonad (GhcT m) where\n  getSession = GhcT $ \\(Session r) -> liftIO $ readIORef r\n  setSession s' = GhcT $ \\(Session r) -> liftIO $ writeIORef r s'\n\n\n-- | Print the error message and all warnings.  Useful inside exception\n--   handlers.  Clears warnings after printing.\nprintException :: GhcMonad m => SourceError -> m ()\nprintException err = do\n  dflags <- getSessionDynFlags\n  liftIO $ printBagOfErrors dflags (srcErrorMessages err)\n\n-- | A function called to log warnings and errors.\ntype WarnErrLogger = forall m. GhcMonad m => Maybe SourceError -> m ()\n\ndefaultWarnErrLogger :: WarnErrLogger\ndefaultWarnErrLogger Nothing  = return ()\ndefaultWarnErrLogger (Just e) = printException e\n\n", "num_lines": 210}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-duplicate-exports -fno-warn-orphans #-}\n\n-- | This module is not used by GHC itself.  Rather, it exports all of\n-- the functions and types you are likely to need when writing a\n-- plugin for GHC. So authors of plugins can probably get away simply\n-- with saying \"import GhcPlugins\".\n--\n-- Particularly interesting modules for plugin writers include\n-- \"CoreSyn\" and \"CoreMonad\".\nmodule GhcPlugins(\n        module Plugins,\n        module RdrName, module OccName, module Name, module Var, module Id, module IdInfo,\n        module CoreMonad, module CoreSyn, module Literal, module DataCon,\n        module CoreUtils, module MkCore, module CoreFVs, module CoreSubst,\n        module Rules, module Annotations,\n        module DynFlags, module Packages,\n        module Module, module Type, module TyCon, module Coercion,\n        module TysWiredIn, module HscTypes, module BasicTypes,\n        module VarSet, module VarEnv, module NameSet, module NameEnv,\n        module UniqSet, module UniqFM, module FiniteMap,\n        module Util, module GHC.Serialized, module SrcLoc, module Outputable,\n        module UniqSupply, module Unique, module FastString,\n\n        -- * Getting 'Name's\n        thNameToGhcName\n    ) where\n\n-- Plugin stuff itself\nimport Plugins\n\n-- Variable naming\nimport RdrName\nimport OccName  hiding  ( varName {- conflicts with Var.varName -} )\nimport Name     hiding  ( varName {- reexport from OccName, conflicts with Var.varName -} )\nimport Var\nimport Id       hiding  ( lazySetIdInfo, setIdExported, setIdNotExported {- all three conflict with Var -} )\nimport IdInfo\n\n-- Core\nimport CoreMonad\nimport CoreSyn\nimport Literal\nimport DataCon\nimport CoreUtils\nimport MkCore\nimport CoreFVs\nimport CoreSubst hiding( substTyVarBndr, substCoVarBndr, extendCvSubst )\n       -- These names are also exported by Type\n\n-- Core \"extras\"\nimport Rules\nimport Annotations\n\n-- Pipeline-related stuff\nimport DynFlags\nimport Packages\n\n-- Important GHC types\nimport Module\nimport Type     hiding {- conflict with CoreSubst -}\n                ( substTy, extendTvSubst, extendTvSubstList, isInScope )\nimport Coercion hiding {- conflict with CoreSubst -}\n                ( substCo )\nimport TyCon\nimport TysWiredIn\nimport HscTypes\nimport BasicTypes hiding ( Version {- conflicts with Packages.Version -} )\n\n-- Collections and maps\nimport VarSet\nimport VarEnv\nimport NameSet\nimport NameEnv\nimport UniqSet\nimport UniqFM\n-- Conflicts with UniqFM:\n--import LazyUniqFM\nimport FiniteMap\n\n-- Common utilities\nimport Util\nimport GHC.Serialized\nimport SrcLoc\nimport Outputable\nimport UniqSupply\nimport Unique           ( Unique, Uniquable(..) )\nimport FastString\nimport Data.Maybe\n\nimport IfaceEnv         ( lookupOrigIO )\nimport GhcPrelude\nimport MonadUtils       ( mapMaybeM )\nimport Convert          ( thRdrNameGuesses )\nimport TcEnv            ( lookupGlobal )\n\nimport qualified Language.Haskell.TH as TH\n\n{- This instance is defined outside CoreMonad.hs so that\n   CoreMonad does not depend on TcEnv -}\ninstance MonadThings CoreM where\n    lookupThing name = do { hsc_env <- getHscEnv\n                          ; liftIO $ lookupGlobal hsc_env name }\n\n{-\n************************************************************************\n*                                                                      *\n               Template Haskell interoperability\n*                                                                      *\n************************************************************************\n-}\n\n-- | Attempt to convert a Template Haskell name to one that GHC can\n-- understand. Original TH names such as those you get when you use\n-- the @'foo@ syntax will be translated to their equivalent GHC name\n-- exactly. Qualified or unqualified TH names will be dynamically bound\n-- to names in the module being compiled, if possible. Exact TH names\n-- will be bound to the name they represent, exactly.\nthNameToGhcName :: TH.Name -> CoreM (Maybe Name)\nthNameToGhcName th_name\n  =  do { names <- mapMaybeM lookup (thRdrNameGuesses th_name)\n          -- Pick the first that works\n          -- E.g. reify (mkName \"A\") will pick the class A in preference\n          -- to the data constructor A\n        ; return (listToMaybe names) }\n  where\n    lookup rdr_name\n      | Just n <- isExact_maybe rdr_name   -- This happens in derived code\n      = return $ if isExternalName n then Just n else Nothing\n      | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name\n      = do { hsc_env <- getHscEnv\n           ; Just <$> liftIO (lookupOrigIO hsc_env rdr_mod rdr_occ) }\n      | otherwise = return Nothing\n", "num_lines": 133}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-----------------------------------------------------------------------------\n--\n-- | Parsing the top of a Haskell source file to get its module name,\n-- imports and options.\n--\n-- (c) Simon Marlow 2005\n-- (c) Lemmih 2006\n--\n-----------------------------------------------------------------------------\n\nmodule HeaderInfo ( getImports\n                  , mkPrelImports -- used by the renamer too\n                  , getOptionsFromFile, getOptions\n                  , optionsErrorMsgs,\n                    checkProcessArgsResult ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HscTypes\nimport Parser           ( parseHeader )\nimport Lexer\nimport FastString\nimport HsSyn\nimport Module\nimport PrelNames\nimport StringBuffer\nimport SrcLoc\nimport DynFlags\nimport ErrUtils\nimport Util\nimport Outputable\nimport Pretty           ()\nimport Maybes\nimport Bag              ( emptyBag, listToBag, unitBag )\nimport MonadUtils\nimport Exception\nimport BasicTypes\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport System.IO\nimport System.IO.Unsafe\nimport Data.List\n\n------------------------------------------------------------------------------\n\n-- | Parse the imports of a source file.\n--\n-- Throws a 'SourceError' if parsing fails.\ngetImports :: DynFlags\n           -> StringBuffer -- ^ Parse this.\n           -> FilePath     -- ^ Filename the buffer came from.  Used for\n                           --   reporting parse error locations.\n           -> FilePath     -- ^ The original source filename (used for locations\n                           --   in the function result)\n           -> IO ([(Maybe FastString, Located ModuleName)],\n                  [(Maybe FastString, Located ModuleName)],\n                  Located ModuleName)\n              -- ^ The source imports, normal imports, and the module name.\ngetImports dflags buf filename source_filename = do\n  let loc  = mkRealSrcLoc (mkFastString filename) 1 1\n  case unP parseHeader (mkPState dflags buf loc) of\n    PFailed pst -> do\n        -- assuming we're not logging warnings here as per below\n      throwErrors (getErrorMessages pst dflags)\n    POk pst rdr_module -> do\n      let _ms@(_warns, errs) = getMessages pst dflags\n      -- don't log warnings: they'll be reported when we parse the file\n      -- for real.  See #2500.\n          ms = (emptyBag, errs)\n      -- logWarnings warns\n      if errorsFound dflags ms\n        then throwIO $ mkSrcErr errs\n        else\n          let   hsmod = unLoc rdr_module\n                mb_mod = hsmodName hsmod\n                imps = hsmodImports hsmod\n                main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename)\n                                       1 1)\n                mod = mb_mod `orElse` cL main_loc mAIN_NAME\n                (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps\n\n               -- GHC.Prim doesn't exist physically, so don't go looking for it.\n                ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc\n                                        . ideclName . unLoc)\n                                       ord_idecls\n\n                implicit_prelude = xopt LangExt.ImplicitPrelude dflags\n                implicit_imports = mkPrelImports (unLoc mod) main_loc\n                                                 implicit_prelude imps\n                convImport (dL->L _ i) = (fmap sl_fs (ideclPkgQual i)\n                                         , ideclName i)\n              in\n              return (map convImport src_idecls,\n                      map convImport (implicit_imports ++ ordinary_imps),\n                      mod)\n\nmkPrelImports :: ModuleName\n              -> SrcSpan    -- Attribute the \"import Prelude\" to this location\n              -> Bool -> [LImportDecl GhcPs]\n              -> [LImportDecl GhcPs]\n-- Construct the implicit declaration \"import Prelude\" (or not)\n--\n-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();\n-- because the former doesn't even look at Prelude.hi for instance\n-- declarations, whereas the latter does.\nmkPrelImports this_mod loc implicit_prelude import_decls\n  | this_mod == pRELUDE_NAME\n   || explicit_prelude_import\n   || not implicit_prelude\n  = []\n  | otherwise = [preludeImportDecl]\n  where\n      explicit_prelude_import\n       = notNull [ () | (dL->L _ (ImportDecl { ideclName = mod\n                                        , ideclPkgQual = Nothing }))\n                          <- import_decls\n                      , unLoc mod == pRELUDE_NAME ]\n\n      preludeImportDecl :: LImportDecl GhcPs\n      preludeImportDecl\n        = cL loc $ ImportDecl { ideclExt       = noExt,\n                                ideclSourceSrc = NoSourceText,\n                                ideclName      = cL loc pRELUDE_NAME,\n                                ideclPkgQual   = Nothing,\n                                ideclSource    = False,\n                                ideclSafe      = False,  -- Not a safe import\n                                ideclQualified = False,\n                                ideclImplicit  = True,   -- Implicit!\n                                ideclAs        = Nothing,\n                                ideclHiding    = Nothing  }\n\n--------------------------------------------------------------\n-- Get options\n--------------------------------------------------------------\n\n-- | Parse OPTIONS and LANGUAGE pragmas of the source file.\n--\n-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)\ngetOptionsFromFile :: DynFlags\n                   -> FilePath            -- ^ Input file\n                   -> IO [Located String] -- ^ Parsed options, if any.\ngetOptionsFromFile dflags filename\n    = Exception.bracket\n              (openBinaryFile filename ReadMode)\n              (hClose)\n              (\\handle -> do\n                  opts <- fmap (getOptions' dflags)\n                               (lazyGetToks dflags' filename handle)\n                  seqList opts $ return opts)\n    where -- We don't need to get haddock doc tokens when we're just\n          -- getting the options from pragmas, and lazily lexing them\n          -- correctly is a little tricky: If there is \"\\n\" or \"\\n-\"\n          -- left at the end of a buffer then the haddock doc may\n          -- continue past the end of the buffer, despite the fact that\n          -- we already have an apparently-complete token.\n          -- We therefore just turn Opt_Haddock off when doing the lazy\n          -- lex.\n          dflags' = gopt_unset dflags Opt_Haddock\n\nblockSize :: Int\n-- blockSize = 17 -- for testing :-)\nblockSize = 1024\n\nlazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]\nlazyGetToks dflags filename handle = do\n  buf <- hGetStringBufferBlock handle blockSize\n  unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False blockSize\n where\n  loc  = mkRealSrcLoc (mkFastString filename) 1 1\n\n  lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]\n  lazyLexBuf handle state eof size = do\n    case unP (lexer False return) state of\n      POk state' t -> do\n        -- pprTrace \"lazyLexBuf\" (text (show (buffer state'))) (return ())\n        if atEnd (buffer state') && not eof\n           -- if this token reached the end of the buffer, and we haven't\n           -- necessarily read up to the end of the file, then the token might\n           -- be truncated, so read some more of the file and lex it again.\n           then getMore handle state size\n           else case unLoc t of\n                  ITeof  -> return [t]\n                  _other -> do rest <- lazyLexBuf handle state' eof size\n                               return (t : rest)\n      _ | not eof   -> getMore handle state size\n        | otherwise -> return [cL (RealSrcSpan (last_loc state)) ITeof]\n                         -- parser assumes an ITeof sentinel at the end\n\n  getMore :: Handle -> PState -> Int -> IO [Located Token]\n  getMore handle state size = do\n     -- pprTrace \"getMore\" (text (show (buffer state))) (return ())\n     let new_size = size * 2\n       -- double the buffer size each time we read a new block.  This\n       -- counteracts the quadratic slowdown we otherwise get for very\n       -- large module names (#5981)\n     nextbuf <- hGetStringBufferBlock handle new_size\n     if (len nextbuf == 0) then lazyLexBuf handle state True new_size else do\n       newbuf <- appendStringBuffers (buffer state) nextbuf\n       unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False new_size\n\n\ngetToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]\ngetToks dflags filename buf = lexAll (pragState dflags buf loc)\n where\n  loc  = mkRealSrcLoc (mkFastString filename) 1 1\n\n  lexAll state = case unP (lexer False return) state of\n                   POk _      t@(dL->L _ ITeof) -> [t]\n                   POk state' t -> t : lexAll state'\n                   _ -> [cL (RealSrcSpan (last_loc state)) ITeof]\n\n\n-- | Parse OPTIONS and LANGUAGE pragmas of the source file.\n--\n-- Throws a 'SourceError' if flag parsing fails (including unsupported flags.)\ngetOptions :: DynFlags\n           -> StringBuffer -- ^ Input Buffer\n           -> FilePath     -- ^ Source filename.  Used for location info.\n           -> [Located String] -- ^ Parsed options.\ngetOptions dflags buf filename\n    = getOptions' dflags (getToks dflags filename buf)\n\n-- The token parser is written manually because Happy can't\n-- return a partial result when it encounters a lexer error.\n-- We want to extract options before the buffer is passed through\n-- CPP, so we can't use the same trick as 'getImports'.\ngetOptions' :: DynFlags\n            -> [Located Token]      -- Input buffer\n            -> [Located String]     -- Options.\ngetOptions' dflags toks\n    = parseToks toks\n    where\n          parseToks (open:close:xs)\n              | IToptions_prag str <- unLoc open\n              , ITclose_prag       <- unLoc close\n              = case toArgs str of\n                  Left _err -> optionsParseError str dflags $   -- #15053\n                                 combineSrcSpans (getLoc open) (getLoc close)\n                  Right args -> map (cL (getLoc open)) args ++ parseToks xs\n          parseToks (open:close:xs)\n              | ITinclude_prag str <- unLoc open\n              , ITclose_prag       <- unLoc close\n              = map (cL (getLoc open)) [\"-#include\",removeSpaces str] ++\n                parseToks xs\n          parseToks (open:close:xs)\n              | ITdocOptions str <- unLoc open\n              , ITclose_prag     <- unLoc close\n              = map (cL (getLoc open)) [\"-haddock-opts\", removeSpaces str]\n                ++ parseToks xs\n          parseToks (open:xs)\n              | ITlanguage_prag <- unLoc open\n              = parseLanguage xs\n          parseToks (comment:xs) -- Skip over comments\n              | isComment (unLoc comment)\n              = parseToks xs\n          parseToks _ = []\n          parseLanguage ((dL->L loc (ITconid fs)):rest)\n              = checkExtension dflags (cL loc fs) :\n                case rest of\n                  (dL->L _loc ITcomma):more -> parseLanguage more\n                  (dL->L _loc ITclose_prag):more -> parseToks more\n                  (dL->L loc _):_ -> languagePragParseError dflags loc\n                  [] -> panic \"getOptions'.parseLanguage(1) went past eof token\"\n          parseLanguage (tok:_)\n              = languagePragParseError dflags (getLoc tok)\n          parseLanguage []\n              = panic \"getOptions'.parseLanguage(2) went past eof token\"\n\n          isComment :: Token -> Bool\n          isComment c =\n            case c of\n              (ITlineComment {})     -> True\n              (ITblockComment {})    -> True\n              (ITdocCommentNext {})  -> True\n              (ITdocCommentPrev {})  -> True\n              (ITdocCommentNamed {}) -> True\n              (ITdocSection {})      -> True\n              _                      -> False\n\n-----------------------------------------------------------------------------\n\n-- | Complain about non-dynamic flags in OPTIONS pragmas.\n--\n-- Throws a 'SourceError' if the input list is non-empty claiming that the\n-- input flags are unknown.\ncheckProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()\ncheckProcessArgsResult dflags flags\n  = when (notNull flags) $\n      liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags\n    where mkMsg (dL->L loc flag)\n              = mkPlainErrMsg dflags loc $\n                  (text \"unknown flag in  {-# OPTIONS_GHC #-} pragma:\" <+>\n                   text flag)\n\n-----------------------------------------------------------------------------\n\ncheckExtension :: DynFlags -> Located FastString -> Located String\ncheckExtension dflags (dL->L l ext)\n-- Checks if a given extension is valid, and if so returns\n-- its corresponding flag. Otherwise it throws an exception.\n =  let ext' = unpackFS ext in\n    if ext' `elem` supportedLanguagesAndExtensions\n    then cL l (\"-X\"++ext')\n    else unsupportedExtnError dflags l ext'\n\nlanguagePragParseError :: DynFlags -> SrcSpan -> a\nlanguagePragParseError dflags loc =\n    throwErr dflags loc $\n       vcat [ text \"Cannot parse LANGUAGE pragma\"\n            , text \"Expecting comma-separated list of language options,\"\n            , text \"each starting with a capital letter\"\n            , nest 2 (text \"E.g. {-# LANGUAGE TemplateHaskell, GADTs #-}\") ]\n\nunsupportedExtnError :: DynFlags -> SrcSpan -> String -> a\nunsupportedExtnError dflags loc unsup =\n    throwErr dflags loc $\n        text \"Unsupported extension: \" <> text unsup $$\n        if null suggestions then Outputable.empty else text \"Perhaps you meant\" <+> quotedListWithOr (map text suggestions)\n  where\n     suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions\n\n\noptionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages\noptionsErrorMsgs dflags unhandled_flags flags_lines _filename\n  = (emptyBag, listToBag (map mkMsg unhandled_flags_lines))\n  where unhandled_flags_lines :: [Located String]\n        unhandled_flags_lines = [ cL l f\n                                | f <- unhandled_flags\n                                , (dL->L l f') <- flags_lines\n                                , f == f' ]\n        mkMsg (dL->L flagSpan flag) =\n            ErrUtils.mkPlainErrMsg dflags flagSpan $\n                    text \"unknown flag in  {-# OPTIONS_GHC #-} pragma:\" <+> text flag\n\noptionsParseError :: String -> DynFlags -> SrcSpan -> a     -- #15053\noptionsParseError str dflags loc =\n  throwErr dflags loc $\n      vcat [ text \"Error while parsing OPTIONS_GHC pragma.\"\n           , text \"Expecting whitespace-separated list of GHC options.\"\n           , text \"  E.g. {-# OPTIONS_GHC -Wall -O2 #-}\"\n           , text (\"Input was: \" ++ show str) ]\n\nthrowErr :: DynFlags -> SrcSpan -> SDoc -> a                -- #15053\nthrowErr dflags loc doc =\n  throw $ mkSrcErr $ unitBag $ mkPlainErrMsg dflags loc doc\n", "num_lines": 353}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- \\section[Hooks]{Low level API hooks}\n\n-- NB: this module is SOURCE-imported by DynFlags, and should primarily\n--     refer to *types*, rather than *code*\n\n{-# LANGUAGE CPP #-}\nmodule Hooks ( Hooks\n             , emptyHooks\n             , lookupHook\n             , getHooked\n               -- the hooks:\n             , dsForeignsHook\n             , tcForeignImportsHook\n             , tcForeignExportsHook\n             , hscFrontendHook\n             , hscCompileCoreExprHook\n             , ghcPrimIfaceHook\n             , runPhaseHook\n             , runMetaHook\n             , linkHook\n             , runRnSpliceHook\n             , getValueSafelyHook\n             , createIservProcessHook\n             ) where\n\nimport GhcPrelude\n\nimport DynFlags\nimport PipelineMonad\nimport HscTypes\nimport HsDecls\nimport HsBinds\nimport HsExpr\nimport OrdList\nimport TcRnTypes\nimport Bag\nimport RdrName\nimport Name\nimport Id\nimport CoreSyn\nimport GHCi.RemoteTypes\nimport SrcLoc\nimport Type\nimport System.Process\nimport BasicTypes\nimport HsExtension\n\nimport Data.Maybe\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Hooks}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Hooks can be used by GHC API clients to replace parts of\n--   the compiler pipeline. If a hook is not installed, GHC\n--   uses the default built-in behaviour\n\nemptyHooks :: Hooks\nemptyHooks = Hooks\n  { dsForeignsHook         = Nothing\n  , tcForeignImportsHook   = Nothing\n  , tcForeignExportsHook   = Nothing\n  , hscFrontendHook        = Nothing\n  , hscCompileCoreExprHook = Nothing\n  , ghcPrimIfaceHook       = Nothing\n  , runPhaseHook           = Nothing\n  , runMetaHook            = Nothing\n  , linkHook               = Nothing\n  , runRnSpliceHook        = Nothing\n  , getValueSafelyHook     = Nothing\n  , createIservProcessHook = Nothing\n  }\n\ndata Hooks = Hooks\n  { dsForeignsHook         :: Maybe ([LForeignDecl GhcTc]\n                           -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))\n  , tcForeignImportsHook   :: Maybe ([LForeignDecl GhcRn]\n                          -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))\n  , tcForeignExportsHook   :: Maybe ([LForeignDecl GhcRn]\n            -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt))\n  , hscFrontendHook        :: Maybe (ModSummary -> Hsc FrontendResult)\n  , hscCompileCoreExprHook ::\n               Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)\n  , ghcPrimIfaceHook       :: Maybe ModIface\n  , runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags\n                                         -> CompPipeline (PhasePlus, FilePath))\n  , runMetaHook            :: Maybe (MetaHook TcM)\n  , linkHook               :: Maybe (GhcLink -> DynFlags -> Bool\n                                         -> HomePackageTable -> IO SuccessFlag)\n  , runRnSpliceHook        :: Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))\n  , getValueSafelyHook     :: Maybe (HscEnv -> Name -> Type\n                                                          -> IO (Maybe HValue))\n  , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)\n  }\n\ngetHooked :: (Functor f, HasDynFlags f) => (Hooks -> Maybe a) -> a -> f a\ngetHooked hook def = fmap (lookupHook hook def) getDynFlags\n\nlookupHook :: (Hooks -> Maybe a) -> a -> DynFlags -> a\nlookupHook hook def = fromMaybe def . hook . hooks\n", "num_lines": 105}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash, NondecreasingIndentation #-}\n{-# OPTIONS_GHC -fprof-auto-top #-}\n\n-------------------------------------------------------------------------------\n--\n-- | Main API for compiling plain Haskell source code.\n--\n-- This module implements compilation of a Haskell source. It is\n-- /not/ concerned with preprocessing of source files; this is handled\n-- in \"DriverPipeline\".\n--\n-- There are various entry points depending on what mode we're in:\n-- \"batch\" mode (@--make@), \"one-shot\" mode (@-c@, @-S@ etc.), and\n-- \"interactive\" mode (GHCi). There are also entry points for\n-- individual passes: parsing, typechecking/renaming, desugaring, and\n-- simplification.\n--\n-- All the functions here take an 'HscEnv' as a parameter, but none of\n-- them return a new one: 'HscEnv' is treated as an immutable value\n-- from here on in (although it has mutable components, for the\n-- caches).\n--\n-- We use the Hsc monad to deal with warning messages consistently:\n-- specifically, while executing within an Hsc monad, warnings are\n-- collected. When a Hsc monad returns to an IO monad, the\n-- warnings are printed, or compilation aborts if the @-Werror@\n-- flag is enabled.\n--\n-- (c) The GRASP/AQUA Project, Glasgow University, 1993-2000\n--\n-------------------------------------------------------------------------------\n\nmodule HscMain\n    (\n    -- * Making an HscEnv\n      newHscEnv\n\n    -- * Compiling complete source files\n    , Messager, batchMsg\n    , HscStatus (..)\n    , hscIncrementalCompile\n    , hscCompileCmmFile\n\n    , hscGenHardCode\n    , hscInteractive\n\n    -- * Running passes separately\n    , hscParse\n    , hscTypecheckRename\n    , hscDesugar\n    , makeSimpleDetails\n    , hscSimplify -- ToDo, shouldn't really export this\n\n    -- * Safe Haskell\n    , hscCheckSafe\n    , hscGetSafe\n\n    -- * Support for interactive evaluation\n    , hscParseIdentifier\n    , hscTcRcLookupName\n    , hscTcRnGetInfo\n    , hscIsGHCiMonad\n    , hscGetModuleInterface\n    , hscRnImportDecls\n    , hscTcRnLookupRdrName\n    , hscStmt, hscParseStmtWithLocation, hscStmtWithLocation, hscParsedStmt\n    , hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls\n    , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType\n    , hscParseExpr\n    , hscCompileCoreExpr\n    -- * Low-level exports for hooks\n    , hscCompileCoreExpr'\n      -- We want to make sure that we export enough to be able to redefine\n      -- hscFileFrontEnd in client code\n    , hscParse', hscSimplify', hscDesugar', tcRnModule'\n    , getHscEnv\n    , hscSimpleIface', hscNormalIface'\n    , oneShotMsg\n    , hscFileFrontEnd, genericHscFrontend, dumpIfaceStats\n    , ioMsgMaybe\n    , showModuleIndex\n    , hscAddSptEntries\n    ) where\n\nimport GhcPrelude\n\nimport Data.Data hiding (Fixity, TyCon)\nimport Data.Maybe       ( fromJust )\nimport Id\nimport GHCi             ( addSptEntry )\nimport GHCi.RemoteTypes ( ForeignHValue )\nimport ByteCodeGen      ( byteCodeGen, coreExprToBCOs )\nimport Linker\nimport CoreTidy         ( tidyExpr )\nimport Type             ( Type )\nimport {- Kind parts of -} Type         ( Kind )\nimport CoreLint         ( lintInteractiveExpr )\nimport VarEnv           ( emptyTidyEnv )\nimport Panic\nimport ConLike\nimport Control.Concurrent\n\nimport Module\nimport Packages\nimport RdrName\nimport HsSyn\nimport HsDumpAst\nimport CoreSyn\nimport StringBuffer\nimport Parser\nimport Lexer\nimport SrcLoc\nimport TcRnDriver\nimport TcIface          ( typecheckIface )\nimport TcRnMonad\nimport NameCache        ( initNameCache )\nimport LoadIface        ( ifaceStats, initExternalPackageState )\nimport PrelInfo\nimport MkIface\nimport Desugar\nimport SimplCore\nimport TidyPgm\nimport CorePrep\nimport CoreToStg        ( coreToStg )\nimport qualified StgCmm ( codeGen )\nimport StgSyn\nimport StgFVs           ( annTopBindingsFreeVars )\nimport CostCentre\nimport ProfInit\nimport TyCon\nimport Name\nimport SimplStg         ( stg2stg )\nimport Cmm\nimport CmmParse         ( parseCmmFile )\nimport CmmBuildInfoTables\nimport CmmPipeline\nimport CmmInfo\nimport CodeOutput\nimport InstEnv\nimport FamInstEnv\nimport Fingerprint      ( Fingerprint )\nimport Hooks\nimport TcEnv\nimport PrelNames\nimport Plugins\nimport DynamicLoading   ( initializePlugins )\n\nimport DynFlags\nimport ErrUtils\nimport Platform ( platformOS, osSubsectionsViaSymbols )\n\nimport Outputable\nimport NameEnv\nimport HscStats         ( ppSourceStats )\nimport HscTypes\nimport FastString\nimport UniqSupply\nimport Bag\nimport Exception\nimport qualified Stream\nimport Stream (Stream)\n\nimport Util\n\nimport Data.List\nimport Control.Monad\nimport Data.IORef\nimport System.FilePath as FilePath\nimport System.Directory\nimport System.IO (fixIO)\nimport qualified Data.Map as M\nimport qualified Data.Set as S\nimport Data.Set (Set)\n\nimport HieAst           ( mkHieFile )\nimport HieTypes         ( getAsts, hie_asts )\nimport HieBin           ( readHieFile, writeHieFile )\nimport HieDebug         ( diffFile, validateScopes )\n\n#include \"HsVersions.h\"\n\n\n{- **********************************************************************\n%*                                                                      *\n                Initialisation\n%*                                                                      *\n%********************************************************************* -}\n\nnewHscEnv :: DynFlags -> IO HscEnv\nnewHscEnv dflags = do\n    eps_var <- newIORef initExternalPackageState\n    us      <- mkSplitUniqSupply 'r'\n    nc_var  <- newIORef (initNameCache us knownKeyNames)\n    fc_var  <- newIORef emptyInstalledModuleEnv\n    iserv_mvar <- newMVar Nothing\n    return HscEnv {  hsc_dflags       = dflags\n                  ,  hsc_targets      = []\n                  ,  hsc_mod_graph    = emptyMG\n                  ,  hsc_IC           = emptyInteractiveContext dflags\n                  ,  hsc_HPT          = emptyHomePackageTable\n                  ,  hsc_EPS          = eps_var\n                  ,  hsc_NC           = nc_var\n                  ,  hsc_FC           = fc_var\n                  ,  hsc_type_env_var = Nothing\n                  , hsc_iserv        = iserv_mvar\n                  }\n\n-- -----------------------------------------------------------------------------\n\ngetWarnings :: Hsc WarningMessages\ngetWarnings = Hsc $ \\_ w -> return (w, w)\n\nclearWarnings :: Hsc ()\nclearWarnings = Hsc $ \\_ _ -> return ((), emptyBag)\n\nlogWarnings :: WarningMessages -> Hsc ()\nlogWarnings w = Hsc $ \\_ w0 -> return ((), w0 `unionBags` w)\n\ngetHscEnv :: Hsc HscEnv\ngetHscEnv = Hsc $ \\e w -> return (e, w)\n\nhandleWarnings :: Hsc ()\nhandleWarnings = do\n    dflags <- getDynFlags\n    w <- getWarnings\n    liftIO $ printOrThrowWarnings dflags w\n    clearWarnings\n\n-- | log warning in the monad, and if there are errors then\n-- throw a SourceError exception.\nlogWarningsReportErrors :: Messages -> Hsc ()\nlogWarningsReportErrors (warns,errs) = do\n    logWarnings warns\n    when (not $ isEmptyBag errs) $ throwErrors errs\n\n-- | Log warnings and throw errors, assuming the messages\n-- contain at least one error (e.g. coming from PFailed)\nhandleWarningsThrowErrors :: Messages -> Hsc a\nhandleWarningsThrowErrors (warns, errs) = do\n    logWarnings warns\n    dflags <- getDynFlags\n    (wWarns, wErrs) <- warningsToMessages dflags <$> getWarnings\n    liftIO $ printBagOfErrors dflags wWarns\n    throwErrors (unionBags errs wErrs)\n\n-- | Deal with errors and warnings returned by a compilation step\n--\n-- In order to reduce dependencies to other parts of the compiler, functions\n-- outside the \"main\" parts of GHC return warnings and errors as a parameter\n-- and signal success via by wrapping the result in a 'Maybe' type. This\n-- function logs the returned warnings and propagates errors as exceptions\n-- (of type 'SourceError').\n--\n-- This function assumes the following invariants:\n--\n--  1. If the second result indicates success (is of the form 'Just x'),\n--     there must be no error messages in the first result.\n--\n--  2. If there are no error messages, but the second result indicates failure\n--     there should be warnings in the first result. That is, if the action\n--     failed, it must have been due to the warnings (i.e., @-Werror@).\nioMsgMaybe :: IO (Messages, Maybe a) -> Hsc a\nioMsgMaybe ioA = do\n    ((warns,errs), mb_r) <- liftIO ioA\n    logWarnings warns\n    case mb_r of\n        Nothing -> throwErrors errs\n        Just r  -> ASSERT( isEmptyBag errs ) return r\n\n-- | like ioMsgMaybe, except that we ignore error messages and return\n-- 'Nothing' instead.\nioMsgMaybe' :: IO (Messages, Maybe a) -> Hsc (Maybe a)\nioMsgMaybe' ioA = do\n    ((warns,_errs), mb_r) <- liftIO $ ioA\n    logWarnings warns\n    return mb_r\n\n-- -----------------------------------------------------------------------------\n-- | Lookup things in the compiler's environment\n\nhscTcRnLookupRdrName :: HscEnv -> Located RdrName -> IO [Name]\nhscTcRnLookupRdrName hsc_env0 rdr_name\n  = runInteractiveHsc hsc_env0 $\n    do { hsc_env <- getHscEnv\n       ; ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name }\n\nhscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing)\nhscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do\n  hsc_env <- getHscEnv\n  ioMsgMaybe' $ tcRnLookupName hsc_env name\n      -- ignore errors: the only error we're likely to get is\n      -- \"name not found\", and the Maybe in the return type\n      -- is used to indicate that.\n\nhscTcRnGetInfo :: HscEnv -> Name\n               -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))\nhscTcRnGetInfo hsc_env0 name\n  = runInteractiveHsc hsc_env0 $\n    do { hsc_env <- getHscEnv\n       ; ioMsgMaybe' $ tcRnGetInfo hsc_env name }\n\nhscIsGHCiMonad :: HscEnv -> String -> IO Name\nhscIsGHCiMonad hsc_env name\n  = runHsc hsc_env $ ioMsgMaybe $ isGHCiMonad hsc_env name\n\nhscGetModuleInterface :: HscEnv -> Module -> IO ModIface\nhscGetModuleInterface hsc_env0 mod = runInteractiveHsc hsc_env0 $ do\n  hsc_env <- getHscEnv\n  ioMsgMaybe $ getModuleInterface hsc_env mod\n\n-- -----------------------------------------------------------------------------\n-- | Rename some import declarations\nhscRnImportDecls :: HscEnv -> [LImportDecl GhcPs] -> IO GlobalRdrEnv\nhscRnImportDecls hsc_env0 import_decls = runInteractiveHsc hsc_env0 $ do\n  hsc_env <- getHscEnv\n  ioMsgMaybe $ tcRnImportDecls hsc_env import_decls\n\n-- -----------------------------------------------------------------------------\n-- | parse a file, returning the abstract syntax\n\nhscParse :: HscEnv -> ModSummary -> IO HsParsedModule\nhscParse hsc_env mod_summary = runHsc hsc_env $ hscParse' mod_summary\n\n-- internal version, that doesn't fail due to -Werror\nhscParse' :: ModSummary -> Hsc HsParsedModule\nhscParse' mod_summary\n | Just r <- ms_parsed_mod mod_summary = return r\n | otherwise = {-# SCC \"Parser\" #-}\n    withTiming getDynFlags\n               (text \"Parser\"<+>brackets (ppr $ ms_mod mod_summary))\n               (const ()) $ do\n    dflags <- getDynFlags\n    let src_filename  = ms_hspp_file mod_summary\n        maybe_src_buf = ms_hspp_buf  mod_summary\n\n    --------------------------  Parser  ----------------\n    -- sometimes we already have the buffer in memory, perhaps\n    -- because we needed to parse the imports out of it, or get the\n    -- module name.\n    buf <- case maybe_src_buf of\n               Just b  -> return b\n               Nothing -> liftIO $ hGetStringBuffer src_filename\n\n    let loc = mkRealSrcLoc (mkFastString src_filename) 1 1\n    let parseMod | HsigFile == ms_hsc_src mod_summary\n                 = parseSignature\n                 | otherwise = parseModule\n\n    case unP parseMod (mkPState dflags buf loc) of\n        PFailed pst ->\n            handleWarningsThrowErrors (getMessages pst dflags)\n        POk pst rdr_module -> do\n            let (warns, errs) = getMessages pst dflags\n            logWarnings warns\n            liftIO $ dumpIfSet_dyn dflags Opt_D_dump_parsed \"Parser\" $\n                                   ppr rdr_module\n            liftIO $ dumpIfSet_dyn dflags Opt_D_dump_parsed_ast \"Parser AST\" $\n                                   showAstData NoBlankSrcSpan rdr_module\n            liftIO $ dumpIfSet_dyn dflags Opt_D_source_stats \"Source Statistics\" $\n                                   ppSourceStats False rdr_module\n            when (not $ isEmptyBag errs) $ throwErrors errs\n\n            -- To get the list of extra source files, we take the list\n            -- that the parser gave us,\n            --   - eliminate files beginning with '<'.  gcc likes to use\n            --     pseudo-filenames like \"<built-in>\" and \"<command-line>\"\n            --   - normalise them (eliminate differences between ./f and f)\n            --   - filter out the preprocessed source file\n            --   - filter out anything beginning with tmpdir\n            --   - remove duplicates\n            --   - filter out the .hs/.lhs source filename if we have one\n            --\n            let n_hspp  = FilePath.normalise src_filename\n                srcs0 = nub $ filter (not . (tmpDir dflags `isPrefixOf`))\n                            $ filter (not . (== n_hspp))\n                            $ map FilePath.normalise\n                            $ filter (not . isPrefixOf \"<\")\n                            $ map unpackFS\n                            $ srcfiles pst\n                srcs1 = case ml_hs_file (ms_location mod_summary) of\n                          Just f  -> filter (/= FilePath.normalise f) srcs0\n                          Nothing -> srcs0\n\n            -- sometimes we see source files from earlier\n            -- preprocessing stages that cannot be found, so just\n            -- filter them out:\n            srcs2 <- liftIO $ filterM doesFileExist srcs1\n\n            let res = HsParsedModule {\n                      hpm_module    = rdr_module,\n                      hpm_src_files = srcs2,\n                      hpm_annotations\n                              = (M.fromListWith (++) $ annotations pst,\n                                 M.fromList $ ((noSrcSpan,comment_q pst)\n                                                 :(annotations_comments pst)))\n                   }\n\n            -- apply parse transformation of plugins\n            let applyPluginAction p opts\n                  = parsedResultAction p opts mod_summary\n            withPlugins dflags applyPluginAction res\n\n\n-- -----------------------------------------------------------------------------\n-- | If the renamed source has been kept, extract it. Dump it if requested.\nextract_renamed_stuff :: ModSummary -> TcGblEnv -> Hsc RenamedStuff\nextract_renamed_stuff mod_summary tc_result = do\n    let rn_info = getRenamedStuff tc_result\n\n    dflags <- getDynFlags\n    liftIO $ dumpIfSet_dyn dflags Opt_D_dump_rn_ast \"Renamer\" $\n                           showAstData NoBlankSrcSpan rn_info\n\n    -- Create HIE files\n    when (gopt Opt_WriteHie dflags) $ do\n        -- I assume this fromJust is safe because `-fwrite-hie-file`\n        -- enables the option which keeps the renamed source.\n        hieFile <- mkHieFile mod_summary tc_result (fromJust rn_info)\n        let out_file = ml_hie_file $ ms_location mod_summary\n        liftIO $ writeHieFile out_file hieFile\n\n        -- Validate HIE files\n        when (gopt Opt_ValidateHie dflags) $ do\n            hs_env <- Hsc $ \\e w -> return (e, w)\n            liftIO $ do\n              -- Validate Scopes\n              case validateScopes $ getAsts $ hie_asts hieFile of\n                  [] -> putMsg dflags $ text \"Got valid scopes\"\n                  xs -> do\n                    putMsg dflags $ text \"Got invalid scopes\"\n                    mapM_ (putMsg dflags) xs\n              -- Roundtrip testing\n              nc <- readIORef $ hsc_NC hs_env\n              (file', _) <- readHieFile nc out_file\n              case diffFile hieFile file' of\n                [] ->\n                  putMsg dflags $ text \"Got no roundtrip errors\"\n                xs -> do\n                  putMsg dflags $ text \"Got roundtrip errors\"\n                  mapM_ (putMsg dflags) xs\n    return rn_info\n\n\n-- -----------------------------------------------------------------------------\n-- | Rename and typecheck a module, additionally returning the renamed syntax\nhscTypecheckRename :: HscEnv -> ModSummary -> HsParsedModule\n                   -> IO (TcGblEnv, RenamedStuff)\nhscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $ do\n    tc_result <- hsc_typecheck True mod_summary (Just rdr_module)\n    rn_info <- extract_renamed_stuff mod_summary tc_result\n    return (tc_result, rn_info)\n\n-- | Rename and typecheck a module, but don't return the renamed syntax\nhscTypecheck :: Bool -- ^ Keep renamed source?\n             -> ModSummary -> Maybe HsParsedModule\n             -> Hsc TcGblEnv\nhscTypecheck keep_rn mod_summary mb_rdr_module = do\n    tc_result <- hsc_typecheck keep_rn mod_summary mb_rdr_module\n    _ <- extract_renamed_stuff mod_summary tc_result\n    return tc_result\n\nhsc_typecheck :: Bool -- ^ Keep renamed source?\n              -> ModSummary -> Maybe HsParsedModule\n              -> Hsc TcGblEnv\nhsc_typecheck keep_rn mod_summary mb_rdr_module = do\n    hsc_env <- getHscEnv\n    let hsc_src = ms_hsc_src mod_summary\n        dflags = hsc_dflags hsc_env\n        outer_mod = ms_mod mod_summary\n        mod_name = moduleName outer_mod\n        outer_mod' = mkModule (thisPackage dflags) mod_name\n        inner_mod = canonicalizeHomeModule dflags mod_name\n        src_filename  = ms_hspp_file mod_summary\n        real_loc = realSrcLocSpan $ mkRealSrcLoc (mkFastString src_filename) 1 1\n        keep_rn' = gopt Opt_WriteHie dflags || keep_rn\n    MASSERT( moduleUnitId outer_mod == thisPackage dflags )\n    if hsc_src == HsigFile && not (isHoleModule inner_mod)\n        then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod' real_loc\n        else\n         do hpm <- case mb_rdr_module of\n                    Just hpm -> return hpm\n                    Nothing -> hscParse' mod_summary\n            tc_result0 <- tcRnModule' mod_summary keep_rn' hpm\n            if hsc_src == HsigFile\n                then do (iface, _, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 Nothing\n                        ioMsgMaybe $\n                            tcRnMergeSignatures hsc_env hpm tc_result0 iface\n                else return tc_result0\n\n-- wrapper around tcRnModule to handle safe haskell extras\ntcRnModule' :: ModSummary -> Bool -> HsParsedModule\n            -> Hsc TcGblEnv\ntcRnModule' sum save_rn_syntax mod = do\n    hsc_env <- getHscEnv\n    dflags   <- getDynFlags\n\n    tcg_res <- {-# SCC \"Typecheck-Rename\" #-}\n               ioMsgMaybe $\n                   tcRnModule hsc_env sum\n                     save_rn_syntax mod\n\n    -- See Note [Safe Haskell Overlapping Instances Implementation]\n    -- although this is used for more than just that failure case.\n    (tcSafeOK, whyUnsafe) <- liftIO $ readIORef (tcg_safeInfer tcg_res)\n    let allSafeOK = safeInferred dflags && tcSafeOK\n\n    -- end of the safe haskell line, how to respond to user?\n    res <- if not (safeHaskellOn dflags)\n                || (safeInferOn dflags && not allSafeOK)\n             -- if safe Haskell off or safe infer failed, mark unsafe\n             then markUnsafeInfer tcg_res whyUnsafe\n\n             -- module (could be) safe, throw warning if needed\n             else do\n                 tcg_res' <- hscCheckSafeImports tcg_res\n                 safe <- liftIO $ fst <$> readIORef (tcg_safeInfer tcg_res')\n                 when safe $ do\n                   case wopt Opt_WarnSafe dflags of\n                     True -> (logWarnings $ unitBag $\n                              makeIntoWarning (Reason Opt_WarnSafe) $\n                              mkPlainWarnMsg dflags (warnSafeOnLoc dflags) $\n                              errSafe tcg_res')\n                     False | safeHaskell dflags == Sf_Trustworthy &&\n                             wopt Opt_WarnTrustworthySafe dflags ->\n                             (logWarnings $ unitBag $\n                              makeIntoWarning (Reason Opt_WarnTrustworthySafe) $\n                              mkPlainWarnMsg dflags (trustworthyOnLoc dflags) $\n                              errTwthySafe tcg_res')\n                     False -> return ()\n                 return tcg_res'\n\n    -- apply plugins to the type checking result\n\n\n    return res\n  where\n    pprMod t  = ppr $ moduleName $ tcg_mod t\n    errSafe t = quotes (pprMod t) <+> text \"has been inferred as safe!\"\n    errTwthySafe t = quotes (pprMod t)\n      <+> text \"is marked as Trustworthy but has been inferred as safe!\"\n\n-- | Convert a typechecked module to Core\nhscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts\nhscDesugar hsc_env mod_summary tc_result =\n    runHsc hsc_env $ hscDesugar' (ms_location mod_summary) tc_result\n\nhscDesugar' :: ModLocation -> TcGblEnv -> Hsc ModGuts\nhscDesugar' mod_location tc_result = do\n    hsc_env <- getHscEnv\n    r <- ioMsgMaybe $\n      {-# SCC \"deSugar\" #-}\n      deSugar hsc_env mod_location tc_result\n\n    -- always check -Werror after desugaring, this is the last opportunity for\n    -- warnings to arise before the backend.\n    handleWarnings\n    return r\n\n-- | Make a 'ModDetails' from the results of typechecking. Used when\n-- typechecking only, as opposed to full compilation.\nmakeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails\nmakeSimpleDetails hsc_env tc_result = mkBootModDetailsTc hsc_env tc_result\n\n\n{- **********************************************************************\n%*                                                                      *\n                The main compiler pipeline\n%*                                                                      *\n%********************************************************************* -}\n\n{-\n                   --------------------------------\n                        The compilation proper\n                   --------------------------------\n\nIt's the task of the compilation proper to compile Haskell, hs-boot and core\nfiles to either byte-code, hard-code (C, asm, LLVM, etc.) or to nothing at all\n(the module is still parsed and type-checked. This feature is mostly used by\nIDE's and the likes). Compilation can happen in either 'one-shot', 'batch',\n'nothing', or 'interactive' mode. 'One-shot' mode targets hard-code, 'batch'\nmode targets hard-code, 'nothing' mode targets nothing and 'interactive' mode\ntargets byte-code.\n\nThe modes are kept separate because of their different types and meanings:\n\n * In 'one-shot' mode, we're only compiling a single file and can therefore\n discard the new ModIface and ModDetails. This is also the reason it only\n targets hard-code; compiling to byte-code or nothing doesn't make sense when\n we discard the result.\n\n * 'Batch' mode is like 'one-shot' except that we keep the resulting ModIface\n and ModDetails. 'Batch' mode doesn't target byte-code since that require us to\n return the newly compiled byte-code.\n\n * 'Nothing' mode has exactly the same type as 'batch' mode but they're still\n kept separate. This is because compiling to nothing is fairly special: We\n don't output any interface files, we don't run the simplifier and we don't\n generate any code.\n\n * 'Interactive' mode is similar to 'batch' mode except that we return the\n compiled byte-code together with the ModIface and ModDetails.\n\nTrying to compile a hs-boot file to byte-code will result in a run-time error.\nThis is the only thing that isn't caught by the type-system.\n-}\n\n\ntype Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO ()\n\n-- | This function runs GHC's frontend with recompilation\n-- avoidance. Specifically, it checks if recompilation is needed,\n-- and if it is, it parses and typechecks the input module.\n-- It does not write out the results of typechecking (See\n-- compileOne and hscIncrementalCompile).\nhscIncrementalFrontend :: Bool -- always do basic recompilation check?\n                       -> Maybe TcGblEnv\n                       -> Maybe Messager\n                       -> ModSummary\n                       -> SourceModified\n                       -> Maybe ModIface  -- Old interface, if available\n                       -> (Int,Int)       -- (i,n) = module i of n (for msgs)\n                       -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))\n\nhscIncrementalFrontend\n  always_do_basic_recompilation_check m_tc_result\n  mHscMessage mod_summary source_modified mb_old_iface mod_index\n    = do\n    hsc_env <- getHscEnv\n\n    let msg what = case mHscMessage of\n                   Just hscMessage -> hscMessage hsc_env mod_index what mod_summary\n                   Nothing -> return ()\n\n        skip iface = do\n            liftIO $ msg UpToDate\n            return $ Left iface\n\n        compile mb_old_hash reason = do\n            liftIO $ msg reason\n            result <- genericHscFrontend mod_summary\n            return $ Right (result, mb_old_hash)\n\n        stable = case source_modified of\n                     SourceUnmodifiedAndStable -> True\n                     _                         -> False\n\n    case m_tc_result of\n         Just tc_result\n          | not always_do_basic_recompilation_check ->\n             return $ Right (FrontendTypecheck tc_result, Nothing)\n         _ -> do\n            (recomp_reqd, mb_checked_iface)\n                <- {-# SCC \"checkOldIface\" #-}\n                   liftIO $ checkOldIface hsc_env mod_summary\n                                source_modified mb_old_iface\n            -- save the interface that comes back from checkOldIface.\n            -- In one-shot mode we don't have the old iface until this\n            -- point, when checkOldIface reads it from the disk.\n            let mb_old_hash = fmap mi_iface_hash mb_checked_iface\n\n            case mb_checked_iface of\n                Just iface | not (recompileRequired recomp_reqd) ->\n                    -- If the module used TH splices when it was last\n                    -- compiled, then the recompilation check is not\n                    -- accurate enough (#481) and we must ignore\n                    -- it.  However, if the module is stable (none of\n                    -- the modules it depends on, directly or\n                    -- indirectly, changed), then we *can* skip\n                    -- recompilation. This is why the SourceModified\n                    -- type contains SourceUnmodifiedAndStable, and\n                    -- it's pretty important: otherwise ghc --make\n                    -- would always recompile TH modules, even if\n                    -- nothing at all has changed. Stability is just\n                    -- the same check that make is doing for us in\n                    -- one-shot mode.\n                    case m_tc_result of\n                    Nothing\n                     | mi_used_th iface && not stable ->\n                        compile mb_old_hash (RecompBecause \"TH\")\n                    _ ->\n                        skip iface\n                _ ->\n                    case m_tc_result of\n                    Nothing -> compile mb_old_hash recomp_reqd\n                    Just tc_result ->\n                        return $ Right (FrontendTypecheck tc_result, mb_old_hash)\n\ngenericHscFrontend :: ModSummary -> Hsc FrontendResult\ngenericHscFrontend mod_summary =\n  getHooked hscFrontendHook genericHscFrontend' >>= ($ mod_summary)\n\ngenericHscFrontend' :: ModSummary -> Hsc FrontendResult\ngenericHscFrontend' mod_summary\n    = FrontendTypecheck `fmap` hscFileFrontEnd mod_summary\n\n--------------------------------------------------------------\n-- Compilers\n--------------------------------------------------------------\n\n-- Compile Haskell/boot in OneShot mode.\nhscIncrementalCompile :: Bool\n                      -> Maybe TcGblEnv\n                      -> Maybe Messager\n                      -> HscEnv\n                      -> ModSummary\n                      -> SourceModified\n                      -> Maybe ModIface\n                      -> (Int,Int)\n                      -- HomeModInfo does not contain linkable, since we haven't\n                      -- code-genned yet\n                      -> IO (HscStatus, HomeModInfo)\nhscIncrementalCompile always_do_basic_recompilation_check m_tc_result\n    mHscMessage hsc_env' mod_summary source_modified mb_old_iface mod_index\n  = do\n    dflags <- initializePlugins hsc_env' (hsc_dflags hsc_env')\n    let hsc_env'' = hsc_env' { hsc_dflags = dflags }\n\n    -- One-shot mode needs a knot-tying mutable variable for interface\n    -- files. See TcRnTypes.TcGblEnv.tcg_type_env_var.\n    -- See also Note [hsc_type_env_var hack]\n    type_env_var <- newIORef emptyNameEnv\n    let mod = ms_mod mod_summary\n        hsc_env | isOneShot (ghcMode (hsc_dflags hsc_env''))\n                = hsc_env'' { hsc_type_env_var = Just (mod, type_env_var) }\n                | otherwise\n                = hsc_env''\n\n    -- NB: enter Hsc monad here so that we don't bail out early with\n    -- -Werror on typechecker warnings; we also want to run the desugarer\n    -- to get those warnings too. (But we'll always exit at that point\n    -- because the desugarer runs ioMsgMaybe.)\n    runHsc hsc_env $ do\n    e <- hscIncrementalFrontend always_do_basic_recompilation_check m_tc_result mHscMessage\n            mod_summary source_modified mb_old_iface mod_index\n    case e of\n        -- We didn't need to do any typechecking; the old interface\n        -- file on disk was good enough.\n        Left iface -> do\n            -- Knot tying!  See Note [Knot-tying typecheckIface]\n            hmi <- liftIO . fixIO $ \\hmi' -> do\n                let hsc_env' =\n                        hsc_env {\n                            hsc_HPT = addToHpt (hsc_HPT hsc_env)\n                                        (ms_mod_name mod_summary) hmi'\n                        }\n                -- NB: This result is actually not that useful\n                -- in one-shot mode, since we're not going to do\n                -- any further typechecking.  It's much more useful\n                -- in make mode, since this HMI will go into the HPT.\n                details <- genModDetails hsc_env' iface\n                return HomeModInfo{\n                    hm_details = details,\n                    hm_iface = iface,\n                    hm_linkable = Nothing }\n            return (HscUpToDate, hmi)\n        -- We finished type checking.  (mb_old_hash is the hash of\n        -- the interface that existed on disk; it's possible we had\n        -- to retypecheck but the resulting interface is exactly\n        -- the same.)\n        Right (FrontendTypecheck tc_result, mb_old_hash) ->\n            finish mod_summary tc_result mb_old_hash\n\n-- Runs the post-typechecking frontend (desugar and simplify),\n-- and then generates and writes out the final interface. We want\n-- to write the interface AFTER simplification so we can get\n-- as up-to-date and good unfoldings and other info as possible\n-- in the interface file.\nfinish :: ModSummary\n       -> TcGblEnv\n       -> Maybe Fingerprint\n       -> Hsc (HscStatus, HomeModInfo)\nfinish summary tc_result mb_old_hash = do\n  hsc_env <- getHscEnv\n  let dflags = hsc_dflags hsc_env\n      target = hscTarget dflags\n      hsc_src = ms_hsc_src summary\n      should_desugar =\n        ms_mod summary /= gHC_PRIM && hsc_src == HsSrcFile\n      mk_simple_iface = do\n        let hsc_status =\n              case (target, hsc_src) of\n                (HscNothing, _) -> HscNotGeneratingCode\n                (_, HsBootFile) -> HscUpdateBoot\n                (_, HsigFile) -> HscUpdateSig\n                _ -> panic \"finish\"\n        (iface, no_change, details) <- liftIO $\n          hscSimpleIface hsc_env tc_result mb_old_hash\n        return (iface, no_change, details, hsc_status)\n  (iface, no_change, details, hsc_status) <-\n    -- we usually desugar even when we are not generating code, otherwise\n    -- we would miss errors thrown by the desugaring (see #10600). The only\n    -- exceptions are when the Module is Ghc.Prim or when\n    -- it is not a HsSrcFile Module.\n    if should_desugar\n      then do\n        desugared_guts0 <- hscDesugar' (ms_location summary) tc_result\n        if target == HscNothing\n          -- We are not generating code, so we can skip simplification\n          -- and generate a simple interface.\n          then mk_simple_iface\n          else do\n            plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result)\n            desugared_guts <- hscSimplify' plugins desugared_guts0\n            (iface, no_change, details, cgguts) <-\n              liftIO $ hscNormalIface hsc_env desugared_guts mb_old_hash\n            return (iface, no_change, details, HscRecomp cgguts summary)\n      else mk_simple_iface\n  liftIO $ hscMaybeWriteIface dflags iface no_change summary\n  return\n    ( hsc_status\n    , HomeModInfo\n      {hm_details = details, hm_iface = iface, hm_linkable = Nothing})\n\nhscMaybeWriteIface :: DynFlags -> ModIface -> Bool -> ModSummary -> IO ()\nhscMaybeWriteIface dflags iface no_change summary =\n    let force_write_interface = gopt Opt_WriteInterface dflags\n        write_interface = case hscTarget dflags of\n                            HscNothing      -> False\n                            HscInterpreted  -> False\n                            _               -> True\n    in when (write_interface || force_write_interface) $\n            hscWriteIface dflags iface no_change summary\n\n--------------------------------------------------------------\n-- NoRecomp handlers\n--------------------------------------------------------------\n\n-- NB: this must be knot-tied appropriately, see hscIncrementalCompile\ngenModDetails :: HscEnv -> ModIface -> IO ModDetails\ngenModDetails hsc_env old_iface\n  = do\n    new_details <- {-# SCC \"tcRnIface\" #-}\n                   initIfaceLoad hsc_env (typecheckIface old_iface)\n    dumpIfaceStats hsc_env\n    return new_details\n\n--------------------------------------------------------------\n-- Progress displayers.\n--------------------------------------------------------------\n\noneShotMsg :: HscEnv -> RecompileRequired -> IO ()\noneShotMsg hsc_env recomp =\n    case recomp of\n        UpToDate ->\n            compilationProgressMsg (hsc_dflags hsc_env) $\n                   \"compilation IS NOT required\"\n        _ ->\n            return ()\n\nbatchMsg :: Messager\nbatchMsg hsc_env mod_index recomp mod_summary =\n    case recomp of\n        MustCompile -> showMsg \"Compiling \" \"\"\n        UpToDate\n            | verbosity (hsc_dflags hsc_env) >= 2 -> showMsg \"Skipping  \" \"\"\n            | otherwise -> return ()\n        RecompBecause reason -> showMsg \"Compiling \" (\" [\" ++ reason ++ \"]\")\n    where\n        dflags = hsc_dflags hsc_env\n        showMsg msg reason =\n            compilationProgressMsg dflags $\n            (showModuleIndex mod_index ++\n            msg ++ showModMsg dflags (hscTarget dflags)\n                              (recompileRequired recomp) mod_summary)\n                ++ reason\n\n--------------------------------------------------------------\n-- FrontEnds\n--------------------------------------------------------------\n\n-- | Given a 'ModSummary', parses and typechecks it, returning the\n-- 'TcGblEnv' resulting from type-checking.\nhscFileFrontEnd :: ModSummary -> Hsc TcGblEnv\nhscFileFrontEnd mod_summary = hscTypecheck False mod_summary Nothing\n\n--------------------------------------------------------------\n-- Safe Haskell\n--------------------------------------------------------------\n\n-- Note [Safe Haskell Trust Check]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Safe Haskell checks that an import is trusted according to the following\n-- rules for an import of module M that resides in Package P:\n--\n--   * If M is recorded as Safe and all its trust dependencies are OK\n--     then M is considered safe.\n--   * If M is recorded as Trustworthy and P is considered trusted and\n--     all M's trust dependencies are OK then M is considered safe.\n--\n-- By trust dependencies we mean that the check is transitive. So if\n-- a module M that is Safe relies on a module N that is trustworthy,\n-- importing module M will first check (according to the second case)\n-- that N is trusted before checking M is trusted.\n--\n-- This is a minimal description, so please refer to the user guide\n-- for more details. The user guide is also considered the authoritative\n-- source in this matter, not the comments or code.\n\n\n-- Note [Safe Haskell Inference]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Safe Haskell does Safe inference on modules that don't have any specific\n-- safe haskell mode flag. The basic approach to this is:\n--   * When deciding if we need to do a Safe language check, treat\n--     an unmarked module as having -XSafe mode specified.\n--   * For checks, don't throw errors but return them to the caller.\n--   * Caller checks if there are errors:\n--     * For modules explicitly marked -XSafe, we throw the errors.\n--     * For unmarked modules (inference mode), we drop the errors\n--       and mark the module as being Unsafe.\n--\n-- It used to be that we only did safe inference on modules that had no Safe\n-- Haskell flags, but now we perform safe inference on all modules as we want\n-- to allow users to set the `-Wsafe`, `-Wunsafe` and\n-- `-Wtrustworthy-safe` flags on Trustworthy and Unsafe modules so that a\n-- user can ensure their assumptions are correct and see reasons for why a\n-- module is safe or unsafe.\n--\n-- This is tricky as we must be careful when we should throw an error compared\n-- to just warnings. For checking safe imports we manage it as two steps. First\n-- we check any imports that are required to be safe, then we check all other\n-- imports to see if we can infer them to be safe.\n\n\n-- | Check that the safe imports of the module being compiled are valid.\n-- If not we either issue a compilation error if the module is explicitly\n-- using Safe Haskell, or mark the module as unsafe if we're in safe\n-- inference mode.\nhscCheckSafeImports :: TcGblEnv -> Hsc TcGblEnv\nhscCheckSafeImports tcg_env = do\n    dflags   <- getDynFlags\n    tcg_env' <- checkSafeImports tcg_env\n    checkRULES dflags tcg_env'\n\n  where\n    checkRULES dflags tcg_env' = do\n      case safeLanguageOn dflags of\n          True -> do\n              -- XSafe: we nuke user written RULES\n              logWarnings $ warns dflags (tcg_rules tcg_env')\n              return tcg_env' { tcg_rules = [] }\n          False\n                -- SafeInferred: user defined RULES, so not safe\n              | safeInferOn dflags && not (null $ tcg_rules tcg_env')\n              -> markUnsafeInfer tcg_env' $ warns dflags (tcg_rules tcg_env')\n\n                -- Trustworthy OR SafeInferred: with no RULES\n              | otherwise\n              -> return tcg_env'\n\n    warns dflags rules = listToBag $ map (warnRules dflags) rules\n    warnRules dflags (L loc (HsRule { rd_name = n })) =\n        mkPlainWarnMsg dflags loc $\n            text \"Rule \\\"\" <> ftext (snd $ unLoc n) <> text \"\\\" ignored\" $+$\n            text \"User defined rules are disabled under Safe Haskell\"\n    warnRules _ (L _ (XRuleDecl _)) = panic \"hscCheckSafeImports\"\n\n-- | Validate that safe imported modules are actually safe.  For modules in the\n-- HomePackage (the package the module we are compiling in resides) this just\n-- involves checking its trust type is 'Safe' or 'Trustworthy'. For modules\n-- that reside in another package we also must check that the external package\n-- is trusted. See the Note [Safe Haskell Trust Check] above for more\n-- information.\n--\n-- The code for this is quite tricky as the whole algorithm is done in a few\n-- distinct phases in different parts of the code base. See\n-- RnNames.rnImportDecl for where package trust dependencies for a module are\n-- collected and unioned.  Specifically see the Note [RnNames . Tracking Trust\n-- Transitively] and the Note [RnNames . Trust Own Package].\ncheckSafeImports :: TcGblEnv -> Hsc TcGblEnv\ncheckSafeImports tcg_env\n    = do\n        dflags <- getDynFlags\n        imps <- mapM condense imports'\n        let (safeImps, regImps) = partition (\\(_,_,s) -> s) imps\n\n        -- We want to use the warning state specifically for detecting if safe\n        -- inference has failed, so store and clear any existing warnings.\n        oldErrs <- getWarnings\n        clearWarnings\n\n        -- Check safe imports are correct\n        safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps\n        safeErrs <- getWarnings\n        clearWarnings\n\n        -- Check non-safe imports are correct if inferring safety\n        -- See the Note [Safe Haskell Inference]\n        (infErrs, infPkgs) <- case (safeInferOn dflags) of\n          False -> return (emptyBag, S.empty)\n          True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps\n                     infErrs <- getWarnings\n                     clearWarnings\n                     return (infErrs, infPkgs)\n\n        -- restore old errors\n        logWarnings oldErrs\n\n        case (isEmptyBag safeErrs) of\n          -- Failed safe check\n          False -> liftIO . throwIO . mkSrcErr $ safeErrs\n\n          -- Passed safe check\n          True -> do\n            let infPassed = isEmptyBag infErrs\n            tcg_env' <- case (not infPassed) of\n              True  -> markUnsafeInfer tcg_env infErrs\n              False -> return tcg_env\n            when (packageTrustOn dflags) $ checkPkgTrust pkgReqs\n            let newTrust = pkgTrustReqs dflags safePkgs infPkgs infPassed\n            return tcg_env' { tcg_imports = impInfo `plusImportAvails` newTrust }\n\n  where\n    impInfo  = tcg_imports tcg_env     -- ImportAvails\n    imports  = imp_mods impInfo        -- ImportedMods\n    imports1 = moduleEnvToList imports -- (Module, [ImportedBy])\n    imports' = map (fmap importedByUser) imports1 -- (Module, [ImportedModsVal])\n    pkgReqs  = imp_trust_pkgs impInfo  -- [UnitId]\n\n    condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)\n    condense (_, [])   = panic \"HscMain.condense: Pattern match failure!\"\n    condense (m, x:xs) = do imv <- foldlM cond' x xs\n                            return (m, imv_span imv, imv_is_safe imv)\n\n    -- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)\n    cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal\n    cond' v1 v2\n        | imv_is_safe v1 /= imv_is_safe v2\n        = do\n            dflags <- getDynFlags\n            throwOneError $ mkPlainErrMsg dflags (imv_span v1)\n              (text \"Module\" <+> ppr (imv_name v1) <+>\n              (text $ \"is imported both as a safe and unsafe import!\"))\n        | otherwise\n        = return v1\n\n    -- easier interface to work with\n    checkSafe :: (Module, SrcSpan, a) -> Hsc (Maybe InstalledUnitId)\n    checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l\n\n    -- what pkg's to add to our trust requirements\n    pkgTrustReqs :: DynFlags -> Set InstalledUnitId -> Set InstalledUnitId ->\n          Bool -> ImportAvails\n    pkgTrustReqs dflags req inf infPassed | safeInferOn dflags\n                                  && not (safeHaskellModeEnabled dflags) && infPassed\n                                   = emptyImportAvails {\n                                       imp_trust_pkgs = req `S.union` inf\n                                   }\n    pkgTrustReqs dflags _   _ _ | safeHaskell dflags == Sf_Unsafe\n                         = emptyImportAvails\n    pkgTrustReqs _ req _ _ = emptyImportAvails { imp_trust_pkgs = req }\n\n-- | Check that a module is safe to import.\n--\n-- We return True to indicate the import is safe and False otherwise\n-- although in the False case an exception may be thrown first.\nhscCheckSafe :: HscEnv -> Module -> SrcSpan -> IO Bool\nhscCheckSafe hsc_env m l = runHsc hsc_env $ do\n    dflags <- getDynFlags\n    pkgs <- snd `fmap` hscCheckSafe' m l\n    when (packageTrustOn dflags) $ checkPkgTrust pkgs\n    errs <- getWarnings\n    return $ isEmptyBag errs\n\n-- | Return if a module is trusted and the pkgs it depends on to be trusted.\nhscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set InstalledUnitId)\nhscGetSafe hsc_env m l = runHsc hsc_env $ do\n    (self, pkgs) <- hscCheckSafe' m l\n    good         <- isEmptyBag `fmap` getWarnings\n    clearWarnings -- don't want them printed...\n    let pkgs' | Just p <- self = S.insert p pkgs\n              | otherwise      = pkgs\n    return (good, pkgs')\n\n-- | Is a module trusted? If not, throw or log errors depending on the type.\n-- Return (regardless of trusted or not) if the trust type requires the modules\n-- own package be trusted and a list of other packages required to be trusted\n-- (these later ones haven't been checked) but the own package trust has been.\nhscCheckSafe' :: Module -> SrcSpan\n  -> Hsc (Maybe InstalledUnitId, Set InstalledUnitId)\nhscCheckSafe' m l = do\n    dflags <- getDynFlags\n    (tw, pkgs) <- isModSafe m l\n    case tw of\n        False                     -> return (Nothing, pkgs)\n        True | isHomePkg dflags m -> return (Nothing, pkgs)\n             -- TODO: do we also have to check the trust of the instantiation?\n             -- Not necessary if that is reflected in dependencies\n             | otherwise   -> return (Just $ toInstalledUnitId (moduleUnitId m), pkgs)\n  where\n    isModSafe :: Module -> SrcSpan -> Hsc (Bool, Set InstalledUnitId)\n    isModSafe m l = do\n        dflags <- getDynFlags\n        iface <- lookup' m\n        case iface of\n            -- can't load iface to check trust!\n            Nothing -> throwOneError $ mkPlainErrMsg dflags l\n                         $ text \"Can't load the interface file for\" <+> ppr m\n                           <> text \", to check that it can be safely imported\"\n\n            -- got iface, check trust\n            Just iface' ->\n                let trust = getSafeMode $ mi_trust iface'\n                    trust_own_pkg = mi_trust_pkg iface'\n                    -- check module is trusted\n                    safeM = trust `elem` [Sf_Safe, Sf_Trustworthy]\n                    -- check package is trusted\n                    safeP = packageTrusted dflags trust trust_own_pkg m\n                    -- pkg trust reqs\n                    pkgRs = S.fromList . map fst $ filter snd $ dep_pkgs $ mi_deps iface'\n                    -- General errors we throw but Safe errors we log\n                    errs = case (safeM, safeP) of\n                        (True, True ) -> emptyBag\n                        (True, False) -> pkgTrustErr\n                        (False, _   ) -> modTrustErr\n                in do\n                    logWarnings errs\n                    return (trust == Sf_Trustworthy, pkgRs)\n\n                where\n                    pkgTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $\n                        sep [ ppr (moduleName m)\n                                <> text \": Can't be safely imported!\"\n                            , text \"The package (\" <> ppr (moduleUnitId m)\n                                <> text \") the module resides in isn't trusted.\"\n                            ]\n                    modTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $\n                        sep [ ppr (moduleName m)\n                                <> text \": Can't be safely imported!\"\n                            , text \"The module itself isn't safe.\" ]\n\n    -- | Check the package a module resides in is trusted. Safe compiled\n    -- modules are trusted without requiring that their package is trusted. For\n    -- trustworthy modules, modules in the home package are trusted but\n    -- otherwise we check the package trust flag.\n    packageTrusted :: DynFlags -> SafeHaskellMode -> Bool -> Module -> Bool\n    packageTrusted _ Sf_None      _ _ = False -- shouldn't hit these cases\n    packageTrusted _ Sf_Ignore    _ _ = False -- shouldn't hit these cases\n    packageTrusted _ Sf_Unsafe    _ _ = False -- prefer for completeness.\n    packageTrusted dflags _ _ _\n        | not (packageTrustOn dflags) = True\n    packageTrusted _ Sf_Safe  False _ = True\n    packageTrusted dflags _ _ m\n        | isHomePkg dflags m = True\n        | otherwise = trusted $ getPackageDetails dflags (moduleUnitId m)\n\n    lookup' :: Module -> Hsc (Maybe ModIface)\n    lookup' m = do\n        dflags <- getDynFlags\n        hsc_env <- getHscEnv\n        hsc_eps <- liftIO $ hscEPS hsc_env\n        let pkgIfaceT = eps_PIT hsc_eps\n            homePkgT  = hsc_HPT hsc_env\n            iface     = lookupIfaceByModule dflags homePkgT pkgIfaceT m\n        -- the 'lookupIfaceByModule' method will always fail when calling from GHCi\n        -- as the compiler hasn't filled in the various module tables\n        -- so we need to call 'getModuleInterface' to load from disk\n        iface' <- case iface of\n            Just _  -> return iface\n            Nothing -> snd `fmap` (liftIO $ getModuleInterface hsc_env m)\n        return iface'\n\n\n    isHomePkg :: DynFlags -> Module -> Bool\n    isHomePkg dflags m\n        | thisPackage dflags == moduleUnitId m = True\n        | otherwise                               = False\n\n-- | Check the list of packages are trusted.\ncheckPkgTrust :: Set InstalledUnitId -> Hsc ()\ncheckPkgTrust pkgs = do\n    dflags <- getDynFlags\n    let errors = S.foldr go [] pkgs\n        go pkg acc\n            | trusted $ getInstalledPackageDetails dflags pkg\n            = acc\n            | otherwise\n            = (:acc) $ mkErrMsg dflags noSrcSpan (pkgQual dflags)\n                     $ text \"The package (\" <> ppr pkg <> text \") is required\" <>\n                       text \" to be trusted but it isn't!\"\n    case errors of\n        [] -> return ()\n        _  -> (liftIO . throwIO . mkSrcErr . listToBag) errors\n\n-- | Set module to unsafe and (potentially) wipe trust information.\n--\n-- Make sure to call this method to set a module to inferred unsafe, it should\n-- be a central and single failure method. We only wipe the trust information\n-- when we aren't in a specific Safe Haskell mode.\n--\n-- While we only use this for recording that a module was inferred unsafe, we\n-- may call it on modules using Trustworthy or Unsafe flags so as to allow\n-- warning flags for safety to function correctly. See Note [Safe Haskell\n-- Inference].\nmarkUnsafeInfer :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv\nmarkUnsafeInfer tcg_env whyUnsafe = do\n    dflags <- getDynFlags\n\n    when (wopt Opt_WarnUnsafe dflags)\n         (logWarnings $ unitBag $ makeIntoWarning (Reason Opt_WarnUnsafe) $\n             mkPlainWarnMsg dflags (warnUnsafeOnLoc dflags) (whyUnsafe' dflags))\n\n    liftIO $ writeIORef (tcg_safeInfer tcg_env) (False, whyUnsafe)\n    -- NOTE: Only wipe trust when not in an explicitly safe haskell mode. Other\n    -- times inference may be on but we are in Trustworthy mode -- so we want\n    -- to record safe-inference failed but not wipe the trust dependencies.\n    case not (safeHaskellModeEnabled dflags) of\n      True  -> return $ tcg_env { tcg_imports = wiped_trust }\n      False -> return tcg_env\n\n  where\n    wiped_trust   = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty }\n    pprMod        = ppr $ moduleName $ tcg_mod tcg_env\n    whyUnsafe' df = vcat [ quotes pprMod <+> text \"has been inferred as unsafe!\"\n                         , text \"Reason:\"\n                         , nest 4 $ (vcat $ badFlags df) $+$\n                                    (vcat $ pprErrMsgBagWithLoc whyUnsafe) $+$\n                                    (vcat $ badInsts $ tcg_insts tcg_env)\n                         ]\n    badFlags df   = concat $ map (badFlag df) unsafeFlagsForInfer\n    badFlag df (str,loc,on,_)\n        | on df     = [mkLocMessage SevOutput (loc df) $\n                            text str <+> text \"is not allowed in Safe Haskell\"]\n        | otherwise = []\n    badInsts insts = concat $ map badInst insts\n\n    checkOverlap (NoOverlap _) = False\n    checkOverlap _             = True\n\n    badInst ins | checkOverlap (overlapMode (is_flag ins))\n                = [mkLocMessage SevOutput (nameSrcSpan $ getName $ is_dfun ins) $\n                      ppr (overlapMode $ is_flag ins) <+>\n                      text \"overlap mode isn't allowed in Safe Haskell\"]\n                | otherwise = []\n\n\n-- | Figure out the final correct safe haskell mode\nhscGetSafeMode :: TcGblEnv -> Hsc SafeHaskellMode\nhscGetSafeMode tcg_env = do\n    dflags  <- getDynFlags\n    liftIO $ finalSafeMode dflags tcg_env\n\n--------------------------------------------------------------\n-- Simplifiers\n--------------------------------------------------------------\n\nhscSimplify :: HscEnv -> [String] -> ModGuts -> IO ModGuts\nhscSimplify hsc_env plugins modguts =\n    runHsc hsc_env $ hscSimplify' plugins modguts\n\nhscSimplify' :: [String] -> ModGuts -> Hsc ModGuts\nhscSimplify' plugins ds_result = do\n    hsc_env <- getHscEnv\n    let hsc_env_with_plugins = hsc_env\n          { hsc_dflags = foldr addPluginModuleName (hsc_dflags hsc_env) plugins\n          }\n    {-# SCC \"Core2Core\" #-}\n      liftIO $ core2core hsc_env_with_plugins ds_result\n\n--------------------------------------------------------------\n-- Interface generators\n--------------------------------------------------------------\n\nhscSimpleIface :: HscEnv\n               -> TcGblEnv\n               -> Maybe Fingerprint\n               -> IO (ModIface, Bool, ModDetails)\nhscSimpleIface hsc_env tc_result mb_old_iface\n    = runHsc hsc_env $ hscSimpleIface' tc_result mb_old_iface\n\nhscSimpleIface' :: TcGblEnv\n                -> Maybe Fingerprint\n                -> Hsc (ModIface, Bool, ModDetails)\nhscSimpleIface' tc_result mb_old_iface = do\n    hsc_env   <- getHscEnv\n    details   <- liftIO $ mkBootModDetailsTc hsc_env tc_result\n    safe_mode <- hscGetSafeMode tc_result\n    (new_iface, no_change)\n        <- {-# SCC \"MkFinalIface\" #-}\n           liftIO $\n               mkIfaceTc hsc_env mb_old_iface safe_mode details tc_result\n    -- And the answer is ...\n    liftIO $ dumpIfaceStats hsc_env\n    return (new_iface, no_change, details)\n\nhscNormalIface :: HscEnv\n               -> ModGuts\n               -> Maybe Fingerprint\n               -> IO (ModIface, Bool, ModDetails, CgGuts)\nhscNormalIface hsc_env simpl_result mb_old_iface =\n    runHsc hsc_env $ hscNormalIface' simpl_result mb_old_iface\n\nhscNormalIface' :: ModGuts\n                -> Maybe Fingerprint\n                -> Hsc (ModIface, Bool, ModDetails, CgGuts)\nhscNormalIface' simpl_result mb_old_iface = do\n    hsc_env <- getHscEnv\n    (cg_guts, details) <- {-# SCC \"CoreTidy\" #-}\n                          liftIO $ tidyProgram hsc_env simpl_result\n\n    -- BUILD THE NEW ModIface and ModDetails\n    --  and emit external core if necessary\n    -- This has to happen *after* code gen so that the back-end\n    -- info has been set. Not yet clear if it matters waiting\n    -- until after code output\n    (new_iface, no_change)\n        <- {-# SCC \"MkFinalIface\" #-}\n           liftIO $\n               mkIface hsc_env mb_old_iface details simpl_result\n\n    liftIO $ dumpIfaceStats hsc_env\n\n    -- Return the prepared code.\n    return (new_iface, no_change, details, cg_guts)\n\n--------------------------------------------------------------\n-- BackEnd combinators\n--------------------------------------------------------------\n\nhscWriteIface :: DynFlags -> ModIface -> Bool -> ModSummary -> IO ()\nhscWriteIface dflags iface no_change mod_summary = do\n    let ifaceFile = ml_hi_file (ms_location mod_summary)\n    unless no_change $\n        {-# SCC \"writeIface\" #-}\n        writeIfaceFile dflags ifaceFile iface\n    whenGeneratingDynamicToo dflags $ do\n        -- TODO: We should do a no_change check for the dynamic\n        --       interface file too\n        -- TODO: Should handle the dynamic hi filename properly\n        let dynIfaceFile = replaceExtension ifaceFile (dynHiSuf dflags)\n            dynIfaceFile' = addBootSuffix_maybe (mi_boot iface) dynIfaceFile\n            dynDflags = dynamicTooMkDynamicDynFlags dflags\n        writeIfaceFile dynDflags dynIfaceFile' iface\n\n-- | Compile to hard-code.\nhscGenHardCode :: HscEnv -> CgGuts -> ModSummary -> FilePath\n               -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)])\n               -- ^ @Just f@ <=> _stub.c is f\nhscGenHardCode hsc_env cgguts mod_summary output_filename = do\n        let CgGuts{ -- This is the last use of the ModGuts in a compilation.\n                    -- From now on, we just use the bits we need.\n                    cg_module   = this_mod,\n                    cg_binds    = core_binds,\n                    cg_tycons   = tycons,\n                    cg_foreign  = foreign_stubs0,\n                    cg_foreign_files = foreign_files,\n                    cg_dep_pkgs = dependencies,\n                    cg_hpc_info = hpc_info } = cgguts\n            dflags = hsc_dflags hsc_env\n            location = ms_location mod_summary\n            data_tycons = filter isDataTyCon tycons\n            -- cg_tycons includes newtypes, for the benefit of External Core,\n            -- but we don't generate any code for newtypes\n\n        -------------------\n        -- PREPARE FOR CODE GENERATION\n        -- Do saturation and convert to A-normal form\n        (prepd_binds, local_ccs) <- {-# SCC \"CorePrep\" #-}\n                       corePrepPgm hsc_env this_mod location\n                                   core_binds data_tycons\n        -----------------  Convert to STG ------------------\n        (stg_binds, (caf_ccs, caf_cc_stacks))\n            <- {-# SCC \"CoreToStg\" #-}\n               myCoreToStg dflags this_mod prepd_binds\n\n        let cost_centre_info =\n              (S.toList local_ccs ++ caf_ccs, caf_cc_stacks)\n            prof_init = profilingInitCode this_mod cost_centre_info\n            foreign_stubs = foreign_stubs0 `appendStubC` prof_init\n\n        ------------------  Code generation ------------------\n\n        -- The back-end is streamed: each top-level function goes\n        -- from Stg all the way to asm before dealing with the next\n        -- top-level function, so showPass isn't very useful here.\n        -- Hence we have one showPass for the whole backend, the\n        -- next showPass after this will be \"Assembler\".\n        withTiming (pure dflags)\n                   (text \"CodeGen\"<+>brackets (ppr this_mod))\n                   (const ()) $ do\n            cmms <- {-# SCC \"StgCmm\" #-}\n                            doCodeGen hsc_env this_mod data_tycons\n                                cost_centre_info\n                                stg_binds hpc_info\n\n            ------------------  Code output -----------------------\n            rawcmms0 <- {-# SCC \"cmmToRawCmm\" #-}\n                      cmmToRawCmm dflags cmms\n\n            let dump a = do dumpIfSet_dyn dflags Opt_D_dump_cmm_raw \"Raw Cmm\"\n                              (ppr a)\n                            return a\n                rawcmms1 = Stream.mapM dump rawcmms0\n\n            (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps)\n                <- {-# SCC \"codeOutput\" #-}\n                  codeOutput dflags this_mod output_filename location\n                  foreign_stubs foreign_files dependencies rawcmms1\n            return (output_filename, stub_c_exists, foreign_fps)\n\n\nhscInteractive :: HscEnv\n               -> CgGuts\n               -> ModSummary\n               -> IO (Maybe FilePath, CompiledByteCode, [SptEntry])\nhscInteractive hsc_env cgguts mod_summary = do\n    let dflags = hsc_dflags hsc_env\n    let CgGuts{ -- This is the last use of the ModGuts in a compilation.\n                -- From now on, we just use the bits we need.\n               cg_module   = this_mod,\n               cg_binds    = core_binds,\n               cg_tycons   = tycons,\n               cg_foreign  = foreign_stubs,\n               cg_modBreaks = mod_breaks,\n               cg_spt_entries = spt_entries } = cgguts\n\n        location = ms_location mod_summary\n        data_tycons = filter isDataTyCon tycons\n        -- cg_tycons includes newtypes, for the benefit of External Core,\n        -- but we don't generate any code for newtypes\n\n    -------------------\n    -- PREPARE FOR CODE GENERATION\n    -- Do saturation and convert to A-normal form\n    (prepd_binds, _) <- {-# SCC \"CorePrep\" #-}\n                   corePrepPgm hsc_env this_mod location core_binds data_tycons\n    -----------------  Generate byte code ------------------\n    comp_bc <- byteCodeGen hsc_env this_mod prepd_binds data_tycons mod_breaks\n    ------------------ Create f-x-dynamic C-side stuff -----\n    (_istub_h_exists, istub_c_exists)\n        <- outputForeignStubs dflags this_mod location foreign_stubs\n    return (istub_c_exists, comp_bc, spt_entries)\n\n------------------------------\n\nhscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> IO ()\nhscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do\n    let dflags = hsc_dflags hsc_env\n    cmm <- ioMsgMaybe $ parseCmmFile dflags filename\n    liftIO $ do\n        dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose \"Parsed Cmm\" (ppr cmm)\n        let -- Make up a module name to give the NCG. We can't pass bottom here\n            -- lest we reproduce #11784.\n            mod_name = mkModuleName $ \"Cmm$\" ++ FilePath.takeFileName filename\n            cmm_mod = mkModule (thisPackage dflags) mod_name\n        (_, cmmgroup) <- cmmPipeline hsc_env (emptySRT cmm_mod) cmm\n        dumpIfSet_dyn dflags Opt_D_dump_cmm \"Output Cmm\" (ppr cmmgroup)\n        rawCmms <- cmmToRawCmm dflags (Stream.yield cmmgroup)\n        _ <- codeOutput dflags cmm_mod output_filename no_loc NoStubs [] []\n             rawCmms\n        return ()\n  where\n    no_loc = ModLocation{ ml_hs_file  = Just filename,\n                          ml_hi_file  = panic \"hscCompileCmmFile: no hi file\",\n                          ml_obj_file = panic \"hscCompileCmmFile: no obj file\",\n                          ml_hie_file = panic \"hscCompileCmmFile: no hie file\"}\n\n-------------------- Stuff for new code gen ---------------------\n\ndoCodeGen   :: HscEnv -> Module -> [TyCon]\n            -> CollectedCCs\n            -> [StgTopBinding]\n            -> HpcInfo\n            -> IO (Stream IO CmmGroup ())\n         -- Note we produce a 'Stream' of CmmGroups, so that the\n         -- backend can be run incrementally.  Otherwise it generates all\n         -- the C-- up front, which has a significant space cost.\ndoCodeGen hsc_env this_mod data_tycons\n              cost_centre_info stg_binds hpc_info = do\n    let dflags = hsc_dflags hsc_env\n\n    let stg_binds_w_fvs = annTopBindingsFreeVars stg_binds\n    let cmm_stream :: Stream IO CmmGroup ()\n        cmm_stream = {-# SCC \"StgCmm\" #-}\n            StgCmm.codeGen dflags this_mod data_tycons\n                           cost_centre_info stg_binds_w_fvs hpc_info\n\n        -- codegen consumes a stream of CmmGroup, and produces a new\n        -- stream of CmmGroup (not necessarily synchronised: one\n        -- CmmGroup on input may produce many CmmGroups on output due\n        -- to proc-point splitting).\n\n    let dump1 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm_from_stg\n                       \"Cmm produced by codegen\" (ppr a)\n                     return a\n\n        ppr_stream1 = Stream.mapM dump1 cmm_stream\n\n    -- We are building a single SRT for the entire module, so\n    -- we must thread it through all the procedures as we cps-convert them.\n    us <- mkSplitUniqSupply 'S'\n\n    -- When splitting, we generate one SRT per split chunk, otherwise\n    -- we generate one SRT for the whole module.\n    let\n     pipeline_stream\n      | gopt Opt_SplitSections dflags ||\n        osSubsectionsViaSymbols (platformOS (targetPlatform dflags))\n        = {-# SCC \"cmmPipeline\" #-}\n          let run_pipeline us cmmgroup = do\n                (_topSRT, cmmgroup) <-\n                  cmmPipeline hsc_env (emptySRT this_mod) cmmgroup\n                return (us, cmmgroup)\n\n          in do _ <- Stream.mapAccumL run_pipeline us ppr_stream1\n                return ()\n\n      | otherwise\n        = {-# SCC \"cmmPipeline\" #-}\n          let run_pipeline = cmmPipeline hsc_env\n          in void $ Stream.mapAccumL run_pipeline (emptySRT this_mod) ppr_stream1\n\n    let\n        dump2 a = do dumpIfSet_dyn dflags Opt_D_dump_cmm\n                        \"Output Cmm\" (ppr a)\n                     return a\n\n        ppr_stream2 = Stream.mapM dump2 pipeline_stream\n\n    return ppr_stream2\n\n\n\nmyCoreToStg :: DynFlags -> Module -> CoreProgram\n            -> IO ( [StgTopBinding] -- output program\n                  , CollectedCCs )  -- CAF cost centre info (declared and used)\nmyCoreToStg dflags this_mod prepd_binds = do\n    let (stg_binds, cost_centre_info)\n         = {-# SCC \"Core2Stg\" #-}\n           coreToStg dflags this_mod prepd_binds\n\n    stg_binds2\n        <- {-# SCC \"Stg2Stg\" #-}\n           stg2stg dflags this_mod stg_binds\n\n    return (stg_binds2, cost_centre_info)\n\n\n{- **********************************************************************\n%*                                                                      *\n\\subsection{Compiling a do-statement}\n%*                                                                      *\n%********************************************************************* -}\n\n{-\nWhen the UnlinkedBCOExpr is linked you get an HValue of type *IO [HValue]* When\nyou run it you get a list of HValues that should be the same length as the list\nof names; add them to the ClosureEnv.\n\nA naked expression returns a singleton Name [it]. The stmt is lifted into the\nIO monad as explained in Note [Interactively-bound Ids in GHCi] in HscTypes\n-}\n\n-- | Compile a stmt all the way to an HValue, but don't run it\n--\n-- We return Nothing to indicate an empty statement (or comment only), not a\n-- parse error.\nhscStmt :: HscEnv -> String -> IO (Maybe ([Id], ForeignHValue, FixityEnv))\nhscStmt hsc_env stmt = hscStmtWithLocation hsc_env stmt \"<interactive>\" 1\n\n-- | Compile a stmt all the way to an HValue, but don't run it\n--\n-- We return Nothing to indicate an empty statement (or comment only), not a\n-- parse error.\nhscStmtWithLocation :: HscEnv\n                    -> String -- ^ The statement\n                    -> String -- ^ The source\n                    -> Int    -- ^ Starting line\n                    -> IO ( Maybe ([Id]\n                          , ForeignHValue {- IO [HValue] -}\n                          , FixityEnv))\nhscStmtWithLocation hsc_env0 stmt source linenumber =\n  runInteractiveHsc hsc_env0 $ do\n    maybe_stmt <- hscParseStmtWithLocation source linenumber stmt\n    case maybe_stmt of\n      Nothing -> return Nothing\n\n      Just parsed_stmt -> do\n        hsc_env <- getHscEnv\n        liftIO $ hscParsedStmt hsc_env parsed_stmt\n\nhscParsedStmt :: HscEnv\n              -> GhciLStmt GhcPs  -- ^ The parsed statement\n              -> IO ( Maybe ([Id]\n                    , ForeignHValue {- IO [HValue] -}\n                    , FixityEnv))\nhscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do\n  -- Rename and typecheck it\n  (ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt hsc_env stmt\n\n  -- Desugar it\n  ds_expr <- ioMsgMaybe $ deSugarExpr hsc_env tc_expr\n  liftIO (lintInteractiveExpr \"desugar expression\" hsc_env ds_expr)\n  handleWarnings\n\n  -- Then code-gen, and link it\n  -- It's important NOT to have package 'interactive' as thisUnitId\n  -- for linking, else we try to link 'main' and can't find it.\n  -- Whereas the linker already knows to ignore 'interactive'\n  let src_span = srcLocSpan interactiveSrcLoc\n  hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr\n\n  return $ Just (ids, hval, fix_env)\n\n-- | Compile a decls\nhscDecls :: HscEnv\n         -> String -- ^ The statement\n         -> IO ([TyThing], InteractiveContext)\nhscDecls hsc_env str = hscDeclsWithLocation hsc_env str \"<interactive>\" 1\n\nhscParseDeclsWithLocation :: HscEnv -> String -> Int -> String -> IO [LHsDecl GhcPs]\nhscParseDeclsWithLocation hsc_env source line_num str = do\n    L _ (HsModule{ hsmodDecls = decls }) <-\n      runInteractiveHsc hsc_env $\n        hscParseThingWithLocation source line_num parseModule str\n    return decls\n\n-- | Compile a decls\nhscDeclsWithLocation :: HscEnv\n                     -> String -- ^ The statement\n                     -> String -- ^ The source\n                     -> Int    -- ^ Starting line\n                     -> IO ([TyThing], InteractiveContext)\nhscDeclsWithLocation hsc_env str source linenumber = do\n    L _ (HsModule{ hsmodDecls = decls }) <-\n      runInteractiveHsc hsc_env $\n        hscParseThingWithLocation source linenumber parseModule str\n    hscParsedDecls hsc_env decls\n\nhscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)\nhscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do\n    {- Rename and typecheck it -}\n    hsc_env <- getHscEnv\n    tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env decls\n\n    {- Grab the new instances -}\n    -- We grab the whole environment because of the overlapping that may have\n    -- been done. See the notes at the definition of InteractiveContext\n    -- (ic_instances) for more details.\n    let defaults = tcg_default tc_gblenv\n\n    {- Desugar it -}\n    -- We use a basically null location for iNTERACTIVE\n    let iNTERACTIVELoc = ModLocation{ ml_hs_file   = Nothing,\n                                      ml_hi_file   = panic \"hsDeclsWithLocation:ml_hi_file\",\n                                      ml_obj_file  = panic \"hsDeclsWithLocation:ml_obj_file\",\n                                      ml_hie_file  = panic \"hsDeclsWithLocation:ml_hie_file\" }\n    ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv\n\n    {- Simplify -}\n    simpl_mg <- liftIO $ do\n      plugins <- readIORef (tcg_th_coreplugins tc_gblenv)\n      hscSimplify hsc_env plugins ds_result\n\n    {- Tidy -}\n    (tidy_cg, mod_details) <- liftIO $ tidyProgram hsc_env simpl_mg\n\n    let !CgGuts{ cg_module    = this_mod,\n                 cg_binds     = core_binds,\n                 cg_tycons    = tycons,\n                 cg_modBreaks = mod_breaks } = tidy_cg\n\n        !ModDetails { md_insts     = cls_insts\n                    , md_fam_insts = fam_insts } = mod_details\n            -- Get the *tidied* cls_insts and fam_insts\n\n        data_tycons = filter isDataTyCon tycons\n\n    {- Prepare For Code Generation -}\n    -- Do saturation and convert to A-normal form\n    (prepd_binds, _) <- {-# SCC \"CorePrep\" #-}\n      liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons\n\n    {- Generate byte code -}\n    cbc <- liftIO $ byteCodeGen hsc_env this_mod\n                                prepd_binds data_tycons mod_breaks\n\n    let src_span = srcLocSpan interactiveSrcLoc\n    liftIO $ linkDecls hsc_env src_span cbc\n\n    {- Load static pointer table entries -}\n    liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg)\n\n    let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg)\n        patsyns = mg_patsyns simpl_mg\n\n        ext_ids = [ id | id <- bindersOfBinds core_binds\n                       , isExternalName (idName id)\n                       , not (isDFunId id || isImplicitId id) ]\n            -- We only need to keep around the external bindings\n            -- (as decided by TidyPgm), since those are the only ones\n            -- that might later be looked up by name.  But we can exclude\n            --    - DFunIds, which are in 'cls_insts' (see Note [ic_tythings] in HscTypes\n            --    - Implicit Ids, which are implicit in tcs\n            -- c.f. TcRnDriver.runTcInteractive, which reconstructs the TypeEnv\n\n        new_tythings = map AnId ext_ids ++ map ATyCon tcs ++ map (AConLike . PatSynCon) patsyns\n        ictxt        = hsc_IC hsc_env\n        -- See Note [Fixity declarations in GHCi]\n        fix_env      = tcg_fix_env tc_gblenv\n        new_ictxt    = extendInteractiveContext ictxt new_tythings cls_insts\n                                                fam_insts defaults fix_env\n    return (new_tythings, new_ictxt)\n\n-- | Load the given static-pointer table entries into the interpreter.\n-- See Note [Grand plan for static forms] in StaticPtrTable.\nhscAddSptEntries :: HscEnv -> [SptEntry] -> IO ()\nhscAddSptEntries hsc_env entries = do\n    let add_spt_entry :: SptEntry -> IO ()\n        add_spt_entry (SptEntry i fpr) = do\n            val <- getHValue hsc_env (idName i)\n            addSptEntry hsc_env fpr val\n    mapM_ add_spt_entry entries\n\n{-\n  Note [Fixity declarations in GHCi]\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n  To support fixity declarations on types defined within GHCi (as requested\n  in #10018) we record the fixity environment in InteractiveContext.\n  When we want to evaluate something TcRnDriver.runTcInteractive pulls out this\n  fixity environment and uses it to initialize the global typechecker environment.\n  After the typechecker has finished its business, an updated fixity environment\n  (reflecting whatever fixity declarations were present in the statements we\n  passed it) will be returned from hscParsedStmt. This is passed to\n  updateFixityEnv, which will stuff it back into InteractiveContext, to be\n  used in evaluating the next statement.\n\n-}\n\nhscImport :: HscEnv -> String -> IO (ImportDecl GhcPs)\nhscImport hsc_env str = runInteractiveHsc hsc_env $ do\n    (L _ (HsModule{hsmodImports=is})) <-\n       hscParseThing parseModule str\n    case is of\n        [L _ i] -> return i\n        _ -> liftIO $ throwOneError $\n                 mkPlainErrMsg (hsc_dflags hsc_env) noSrcSpan $\n                     text \"parse error in import declaration\"\n\n-- | Typecheck an expression (but don't run it)\nhscTcExpr :: HscEnv\n          -> TcRnExprMode\n          -> String -- ^ The expression\n          -> IO Type\nhscTcExpr hsc_env0 mode expr = runInteractiveHsc hsc_env0 $ do\n  hsc_env <- getHscEnv\n  parsed_expr <- hscParseExpr expr\n  ioMsgMaybe $ tcRnExpr hsc_env mode parsed_expr\n\n-- | Find the kind of a type, after generalisation\nhscKcType\n  :: HscEnv\n  -> Bool            -- ^ Normalise the type\n  -> String          -- ^ The type as a string\n  -> IO (Type, Kind) -- ^ Resulting type (possibly normalised) and kind\nhscKcType hsc_env0 normalise str = runInteractiveHsc hsc_env0 $ do\n    hsc_env <- getHscEnv\n    ty <- hscParseType str\n    ioMsgMaybe $ tcRnType hsc_env normalise ty\n\nhscParseExpr :: String -> Hsc (LHsExpr GhcPs)\nhscParseExpr expr = do\n  hsc_env <- getHscEnv\n  maybe_stmt <- hscParseStmt expr\n  case maybe_stmt of\n    Just (L _ (BodyStmt _ expr _ _)) -> return expr\n    _ -> throwOneError $ mkPlainErrMsg (hsc_dflags hsc_env) noSrcSpan\n      (text \"not an expression:\" <+> quotes (text expr))\n\nhscParseStmt :: String -> Hsc (Maybe (GhciLStmt GhcPs))\nhscParseStmt = hscParseThing parseStmt\n\nhscParseStmtWithLocation :: String -> Int -> String\n                         -> Hsc (Maybe (GhciLStmt GhcPs))\nhscParseStmtWithLocation source linenumber stmt =\n    hscParseThingWithLocation source linenumber parseStmt stmt\n\nhscParseType :: String -> Hsc (LHsType GhcPs)\nhscParseType = hscParseThing parseType\n\nhscParseIdentifier :: HscEnv -> String -> IO (Located RdrName)\nhscParseIdentifier hsc_env str =\n    runInteractiveHsc hsc_env $ hscParseThing parseIdentifier str\n\nhscParseThing :: (Outputable thing, Data thing)\n              => Lexer.P thing -> String -> Hsc thing\nhscParseThing = hscParseThingWithLocation \"<interactive>\" 1\n\nhscParseThingWithLocation :: (Outputable thing, Data thing) => String -> Int\n                          -> Lexer.P thing -> String -> Hsc thing\nhscParseThingWithLocation source linenumber parser str\n  = withTiming getDynFlags\n               (text \"Parser [source]\")\n               (const ()) $ {-# SCC \"Parser\" #-} do\n    dflags <- getDynFlags\n\n    let buf = stringToStringBuffer str\n        loc = mkRealSrcLoc (fsLit source) linenumber 1\n\n    case unP parser (mkPState dflags buf loc) of\n        PFailed pst -> do\n            handleWarningsThrowErrors (getMessages pst dflags)\n\n        POk pst thing -> do\n            logWarningsReportErrors (getMessages pst dflags)\n            liftIO $ dumpIfSet_dyn dflags Opt_D_dump_parsed \"Parser\" (ppr thing)\n            liftIO $ dumpIfSet_dyn dflags Opt_D_dump_parsed_ast \"Parser AST\" $\n                                   showAstData NoBlankSrcSpan thing\n            return thing\n\n\n{- **********************************************************************\n%*                                                                      *\n        Desugar, simplify, convert to bytecode, and link an expression\n%*                                                                      *\n%********************************************************************* -}\n\nhscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue\nhscCompileCoreExpr hsc_env =\n  lookupHook hscCompileCoreExprHook hscCompileCoreExpr' (hsc_dflags hsc_env) hsc_env\n\nhscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue\nhscCompileCoreExpr' hsc_env srcspan ds_expr\n    = do { let dflags = hsc_dflags hsc_env\n\n           {- Simplify it -}\n         ; simpl_expr <- simplifyExpr dflags ds_expr\n\n           {- Tidy it (temporary, until coreSat does cloning) -}\n         ; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr\n\n           {- Prepare for codegen -}\n         ; prepd_expr <- corePrepExpr dflags hsc_env tidy_expr\n\n           {- Lint if necessary -}\n         ; lintInteractiveExpr \"hscCompileExpr\" hsc_env prepd_expr\n\n           {- Convert to BCOs -}\n         ; bcos <- coreExprToBCOs hsc_env\n                     (icInteractiveModule (hsc_IC hsc_env)) prepd_expr\n\n           {- link it -}\n         ; hval <- linkExpr hsc_env srcspan bcos\n\n         ; return hval }\n\n\n{- **********************************************************************\n%*                                                                      *\n        Statistics on reading interfaces\n%*                                                                      *\n%********************************************************************* -}\n\ndumpIfaceStats :: HscEnv -> IO ()\ndumpIfaceStats hsc_env = do\n    eps <- readIORef (hsc_EPS hsc_env)\n    dumpIfSet dflags (dump_if_trace || dump_rn_stats)\n              \"Interface statistics\"\n              (ifaceStats eps)\n  where\n    dflags = hsc_dflags hsc_env\n    dump_rn_stats = dopt Opt_D_dump_rn_stats dflags\n    dump_if_trace = dopt Opt_D_dump_if_trace dflags\n\n\n{- **********************************************************************\n%*                                                                      *\n        Progress Messages: Module i of n\n%*                                                                      *\n%********************************************************************* -}\n\nshowModuleIndex :: (Int, Int) -> String\nshowModuleIndex (i,n) = \"[\" ++ padded ++ \" of \" ++ n_str ++ \"] \"\n  where\n    n_str = show n\n    i_str = show i\n    padded = replicate (length n_str - length i_str) ' ' ++ i_str\n", "num_lines": 1879}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- |\n-- Statistics for per-module compilations\n--\n-- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n--\n\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule HscStats ( ppSourceStats ) where\n\nimport GhcPrelude\n\nimport Bag\nimport HsSyn\nimport Outputable\nimport SrcLoc\nimport Util\n\nimport Data.Char\n\n-- | Source Statistics\nppSourceStats :: Bool -> Located (HsModule GhcPs) -> SDoc\nppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))\n  = (if short then hcat else vcat)\n        (map pp_val\n            [(\"ExportAll        \", export_all), -- 1 if no export list\n             (\"ExportDecls      \", export_ds),\n             (\"ExportModules    \", export_ms),\n             (\"Imports          \", imp_no),\n             (\"  ImpSafe        \", imp_safe),\n             (\"  ImpQual        \", imp_qual),\n             (\"  ImpAs          \", imp_as),\n             (\"  ImpAll         \", imp_all),\n             (\"  ImpPartial     \", imp_partial),\n             (\"  ImpHiding      \", imp_hiding),\n             (\"FixityDecls      \", fixity_sigs),\n             (\"DefaultDecls     \", default_ds),\n             (\"TypeDecls        \", type_ds),\n             (\"DataDecls        \", data_ds),\n             (\"NewTypeDecls     \", newt_ds),\n             (\"TypeFamilyDecls  \", type_fam_ds),\n             (\"DataConstrs      \", data_constrs),\n             (\"DataDerivings    \", data_derivs),\n             (\"ClassDecls       \", class_ds),\n             (\"ClassMethods     \", class_method_ds),\n             (\"DefaultMethods   \", default_method_ds),\n             (\"InstDecls        \", inst_ds),\n             (\"InstMethods      \", inst_method_ds),\n             (\"InstType         \", inst_type_ds),\n             (\"InstData         \", inst_data_ds),\n             (\"TypeSigs         \", bind_tys),\n             (\"ClassOpSigs      \", generic_sigs),\n             (\"ValBinds         \", val_bind_ds),\n             (\"FunBinds         \", fn_bind_ds),\n             (\"PatSynBinds      \", patsyn_ds),\n             (\"InlineMeths      \", method_inlines),\n             (\"InlineBinds      \", bind_inlines),\n             (\"SpecialisedMeths \", method_specs),\n             (\"SpecialisedBinds \", bind_specs)\n            ])\n  where\n    decls = map unLoc ldecls\n\n    pp_val (_, 0) = empty\n    pp_val (str, n)\n      | not short   = hcat [text str, int n]\n      | otherwise   = hcat [text (trim str), equals, int n, semi]\n\n    trim ls    = takeWhile (not.isSpace) (dropWhile isSpace ls)\n\n    (fixity_sigs, bind_tys, bind_specs, bind_inlines, generic_sigs)\n        = count_sigs [d | SigD _ d <- decls]\n                -- NB: this omits fixity decls on local bindings and\n                -- in class decls. ToDo\n\n    tycl_decls = [d | TyClD _ d <- decls]\n    (class_ds, type_ds, data_ds, newt_ds, type_fam_ds) =\n      countTyClDecls tycl_decls\n\n    inst_decls = [d | InstD _ d <- decls]\n    inst_ds    = length inst_decls\n    default_ds = count (\\ x -> case x of { DefD{} -> True; _ -> False}) decls\n    val_decls  = [d | ValD _ d <- decls]\n\n    real_exports = case exports of { Nothing -> []; Just (dL->L _ es) -> es }\n    n_exports    = length real_exports\n    export_ms    = count (\\ e -> case unLoc e of { IEModuleContents{} -> True\n                                                 ; _ -> False})\n                         real_exports\n    export_ds    = n_exports - export_ms\n    export_all   = case exports of { Nothing -> 1; _ -> 0 }\n\n    (val_bind_ds, fn_bind_ds, patsyn_ds)\n        = sum3 (map count_bind val_decls)\n\n    (imp_no, imp_safe, imp_qual, imp_as, imp_all, imp_partial, imp_hiding)\n        = sum7 (map import_info imports)\n    (data_constrs, data_derivs)\n        = sum2 (map data_info tycl_decls)\n    (class_method_ds, default_method_ds)\n        = sum2 (map class_info tycl_decls)\n    (inst_method_ds, method_specs, method_inlines, inst_type_ds, inst_data_ds)\n        = sum5 (map inst_info inst_decls)\n\n    count_bind (PatBind { pat_lhs = (dL->L _ (VarPat{})) }) = (1,0,0)\n    count_bind (PatBind {})                           = (0,1,0)\n    count_bind (FunBind {})                           = (0,1,0)\n    count_bind (PatSynBind {})                        = (0,0,1)\n    count_bind b = pprPanic \"count_bind: Unhandled binder\" (ppr b)\n\n    count_sigs sigs = sum5 (map sig_info sigs)\n\n    sig_info (FixSig {})     = (1,0,0,0,0)\n    sig_info (TypeSig {})    = (0,1,0,0,0)\n    sig_info (SpecSig {})    = (0,0,1,0,0)\n    sig_info (InlineSig {})  = (0,0,0,1,0)\n    sig_info (ClassOpSig {}) = (0,0,0,0,1)\n    sig_info _               = (0,0,0,0,0)\n\n    import_info (dL->L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual\n                                     , ideclAs = as, ideclHiding = spec }))\n        = add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec)\n    import_info (dL->L _ (XImportDecl _)) = panic \"import_info\"\n    import_info _ = panic \" import_info: Impossible Match\"\n                             -- due to #15884\n\n    safe_info = qual_info\n    qual_info False  = 0\n    qual_info True   = 1\n    as_info Nothing  = 0\n    as_info (Just _) = 1\n    spec_info Nothing           = (0,0,0,0,1,0,0)\n    spec_info (Just (False, _)) = (0,0,0,0,0,1,0)\n    spec_info (Just (True, _))  = (0,0,0,0,0,0,1)\n\n    data_info (DataDecl { tcdDataDefn = HsDataDefn\n                                          { dd_cons = cs\n                                          , dd_derivs = (dL->L _ derivs)}})\n        = ( length cs\n          , foldl' (\\s dc -> length (deriv_clause_tys $ unLoc dc) + s)\n                   0 derivs )\n    data_info _ = (0,0)\n\n    class_info decl@(ClassDecl {})\n        = (classops, addpr (sum3 (map count_bind methods)))\n      where\n        methods = map unLoc $ bagToList (tcdMeths decl)\n        (_, classops, _, _, _) = count_sigs (map unLoc (tcdSigs decl))\n    class_info _ = (0,0)\n\n    inst_info (TyFamInstD {}) = (0,0,0,1,0)\n    inst_info (DataFamInstD {}) = (0,0,0,0,1)\n    inst_info (ClsInstD { cid_inst = ClsInstDecl {cid_binds = inst_meths\n                                                 , cid_sigs = inst_sigs\n                                                 , cid_tyfam_insts = ats\n                                                 , cid_datafam_insts = adts } })\n        = case count_sigs (map unLoc inst_sigs) of\n            (_,_,ss,is,_) ->\n                  (addpr (sum3 (map count_bind methods)),\n                   ss, is, length ats, length adts)\n      where\n        methods = map unLoc $ bagToList inst_meths\n    inst_info (ClsInstD _ (XClsInstDecl _)) = panic \"inst_info\"\n    inst_info (XInstDecl _)                 = panic \"inst_info\"\n\n    -- TODO: use Sum monoid\n    addpr :: (Int,Int,Int) -> Int\n    sum2 :: [(Int, Int)] -> (Int, Int)\n    sum3 :: [(Int, Int, Int)] -> (Int, Int, Int)\n    sum5 :: [(Int, Int, Int, Int, Int)] -> (Int, Int, Int, Int, Int)\n    sum7 :: [(Int, Int, Int, Int, Int, Int, Int)] -> (Int, Int, Int, Int, Int, Int, Int)\n    add7 :: (Int, Int, Int, Int, Int, Int, Int) -> (Int, Int, Int, Int, Int, Int, Int)\n         -> (Int, Int, Int, Int, Int, Int, Int)\n\n    addpr (x,y,z) = x+y+z\n    sum2 = foldr add2 (0,0)\n      where\n        add2 (x1,x2) (y1,y2) = (x1+y1,x2+y2)\n    sum3 = foldr add3 (0,0,0)\n      where\n        add3 (x1,x2,x3) (y1,y2,y3) = (x1+y1,x2+y2,x3+y3)\n    sum5 = foldr add5 (0,0,0,0,0)\n      where\n        add5 (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5)\n    sum7 = foldr add7 (0,0,0,0,0,0,0)\n\n    add7 (x1,x2,x3,x4,x5,x6,x7) (y1,y2,y3,y4,y5,y6,y7) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5,x6+y6,x7+y7)\n", "num_lines": 190}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow, 2006\n\n\\section[HscTypes]{Types for the per-module compiler}\n-}\n\n{-# LANGUAGE CPP, ScopedTypeVariables #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ViewPatterns #-}\n\n-- | Types for the per-module compiler\nmodule HscTypes (\n        -- * compilation state\n        HscEnv(..), hscEPS,\n        FinderCache, FindResult(..), InstalledFindResult(..),\n        Target(..), TargetId(..), pprTarget, pprTargetId,\n        HscStatus(..),\n        IServ(..),\n\n        -- * ModuleGraph\n        ModuleGraph, emptyMG, mkModuleGraph, extendMG, mapMG,\n        mgModSummaries, mgElemModule, mgLookupModule,\n        needsTemplateHaskellOrQQ, mgBootModules,\n\n        -- * Hsc monad\n        Hsc(..), runHsc, mkInteractiveHscEnv, runInteractiveHsc,\n\n        -- * Information about modules\n        ModDetails(..), emptyModDetails,\n        ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,\n        ImportedMods, ImportedBy(..), importedByUser, ImportedModsVal(..), SptEntry(..),\n        ForeignSrcLang(..),\n\n        ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,\n        msHsFilePath, msHiFilePath, msObjFilePath,\n        SourceModified(..), isTemplateHaskellOrQQNonBoot,\n\n        -- * Information about the module being compiled\n        -- (re-exported from DriverPhases)\n        HscSource(..), isHsBootOrSig, isHsigFile, hscSourceString,\n\n\n        -- * State relating to modules in this package\n        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,\n        lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,\n        addToHpt, addListToHpt, lookupHptDirectly, listToHpt,\n        hptCompleteSigs,\n        hptInstances, hptRules, pprHPT,\n\n        -- * State relating to known packages\n        ExternalPackageState(..), EpsStats(..), addEpsInStats,\n        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,\n        lookupIfaceByModule, emptyModIface, lookupHptByModule,\n\n        PackageInstEnv, PackageFamInstEnv, PackageRuleBase,\n        PackageCompleteMatchMap,\n\n        mkSOName, mkHsSOName, soExt,\n\n        -- * Metaprogramming\n        MetaRequest(..),\n        MetaResult, -- data constructors not exported to ensure correct response type\n        metaRequestE, metaRequestP, metaRequestT, metaRequestD, metaRequestAW,\n        MetaHook,\n\n        -- * Annotations\n        prepareAnnotations,\n\n        -- * Interactive context\n        InteractiveContext(..), emptyInteractiveContext,\n        icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,\n        extendInteractiveContext, extendInteractiveContextWithIds,\n        substInteractiveContext,\n        setInteractivePrintName, icInteractiveModule,\n        InteractiveImport(..), setInteractivePackage,\n        mkPrintUnqualified, pprModulePrefix,\n        mkQualPackage, mkQualModule, pkgQual,\n\n        -- * Interfaces\n        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,\n        emptyIfaceWarnCache, mi_boot, mi_fix,\n        mi_semantic_module,\n        mi_free_holes,\n        renameFreeHoles,\n\n        -- * Fixity\n        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,\n\n        -- * TyThings and type environments\n        TyThing(..),  tyThingAvailInfo,\n        tyThingTyCon, tyThingDataCon, tyThingConLike,\n        tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyCoVars,\n        implicitTyThings, implicitTyConThings, implicitClassThings,\n        isImplicitTyThing,\n\n        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,\n        typeEnvFromEntities, mkTypeEnvWithImplicits,\n        extendTypeEnv, extendTypeEnvList,\n        extendTypeEnvWithIds, plusTypeEnv,\n        lookupTypeEnv,\n        typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,\n        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,\n\n        -- * MonadThings\n        MonadThings(..),\n\n        -- * Information on imports and exports\n        WhetherHasOrphans, IsBootInterface, Usage(..),\n        Dependencies(..), noDependencies,\n        updNameCache,\n        IfaceExport,\n\n        -- * Warnings\n        Warnings(..), WarningTxt(..), plusWarns,\n\n        -- * Linker stuff\n        Linkable(..), isObjectLinkable, linkableObjs,\n        Unlinked(..), CompiledByteCode,\n        isObject, nameOfObject, isInterpretable, byteCodeOfObject,\n\n        -- * Program coverage\n        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,\n\n        -- * Breakpoints\n        ModBreaks (..), emptyModBreaks,\n\n        -- * Safe Haskell information\n        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,\n        trustInfoToNum, numToTrustInfo, IsSafeImport,\n\n        -- * result of the parser\n        HsParsedModule(..),\n\n        -- * Compilation errors and warnings\n        SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,\n        throwOneError, throwErrors, handleSourceError,\n        handleFlagWarnings, printOrThrowWarnings,\n\n        -- * COMPLETE signature\n        CompleteMatch(..), CompleteMatchMap,\n        mkCompleteMatchMap, extendCompleteMatchMap\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport ByteCodeTypes\nimport InteractiveEvalTypes ( Resume )\nimport GHCi.Message         ( Pipe )\nimport GHCi.RemoteTypes\nimport GHC.ForeignSrcLang\n\nimport UniqFM\nimport HsSyn\nimport RdrName\nimport Avail\nimport Module\nimport InstEnv          ( InstEnv, ClsInst, identicalClsInstHead )\nimport FamInstEnv\nimport CoreSyn          ( CoreProgram, RuleBase, CoreRule )\nimport Name\nimport NameEnv\nimport VarSet\nimport Var\nimport Id\nimport IdInfo           ( IdDetails(..), RecSelParent(..))\nimport Type\n\nimport ApiAnnotation    ( ApiAnns )\nimport Annotations      ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )\nimport Class\nimport TyCon\nimport CoAxiom\nimport ConLike\nimport DataCon\nimport PatSyn\nimport PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )\nimport TysWiredIn\nimport Packages hiding  ( Version(..) )\nimport CmdLineParser\nimport DynFlags\nimport DriverPhases     ( Phase, HscSource(..), hscSourceString\n                        , isHsBootOrSig, isHsigFile )\nimport BasicTypes\nimport IfaceSyn\nimport Maybes\nimport Outputable\nimport SrcLoc\nimport Unique\nimport UniqDFM\nimport FastString\nimport StringBuffer     ( StringBuffer )\nimport Fingerprint\nimport MonadUtils\nimport Bag\nimport Binary\nimport ErrUtils\nimport NameCache\nimport Platform\nimport Util\nimport UniqDSet\nimport GHC.Serialized   ( Serialized )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Foreign\nimport Control.Monad    ( guard, liftM, ap )\nimport Data.IORef\nimport Data.Time\nimport Exception\nimport System.FilePath\nimport Control.Concurrent\nimport System.Process   ( ProcessHandle )\n\n-- -----------------------------------------------------------------------------\n-- Compilation state\n-- -----------------------------------------------------------------------------\n\n-- | Status of a compilation to hard-code\ndata HscStatus\n    = HscNotGeneratingCode\n    | HscUpToDate\n    | HscUpdateBoot\n    | HscUpdateSig\n    | HscRecomp CgGuts ModSummary\n\n-- -----------------------------------------------------------------------------\n-- The Hsc monad: Passing an environment and warning state\n\nnewtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages))\n\ninstance Functor Hsc where\n    fmap = liftM\n\ninstance Applicative Hsc where\n    pure a = Hsc $ \\_ w -> return (a, w)\n    (<*>) = ap\n\ninstance Monad Hsc where\n    Hsc m >>= k = Hsc $ \\e w -> do (a, w1) <- m e w\n                                   case k a of\n                                       Hsc k' -> k' e w1\n\ninstance MonadIO Hsc where\n    liftIO io = Hsc $ \\_ w -> do a <- io; return (a, w)\n\ninstance HasDynFlags Hsc where\n    getDynFlags = Hsc $ \\e w -> return (hsc_dflags e, w)\n\nrunHsc :: HscEnv -> Hsc a -> IO a\nrunHsc hsc_env (Hsc hsc) = do\n    (a, w) <- hsc hsc_env emptyBag\n    printOrThrowWarnings (hsc_dflags hsc_env) w\n    return a\n\nmkInteractiveHscEnv :: HscEnv -> HscEnv\nmkInteractiveHscEnv hsc_env = hsc_env{ hsc_dflags = interactive_dflags }\n  where\n    interactive_dflags = ic_dflags (hsc_IC hsc_env)\n\nrunInteractiveHsc :: HscEnv -> Hsc a -> IO a\n-- A variant of runHsc that switches in the DynFlags from the\n-- InteractiveContext before running the Hsc computation.\nrunInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)\n\n-- -----------------------------------------------------------------------------\n-- Source Errors\n\n-- When the compiler (HscMain) discovers errors, it throws an\n-- exception in the IO monad.\n\nmkSrcErr :: ErrorMessages -> SourceError\nmkSrcErr = SourceError\n\nsrcErrorMessages :: SourceError -> ErrorMessages\nsrcErrorMessages (SourceError msgs) = msgs\n\nmkApiErr :: DynFlags -> SDoc -> GhcApiError\nmkApiErr dflags msg = GhcApiError (showSDoc dflags msg)\n\nthrowErrors :: MonadIO io => ErrorMessages -> io a\nthrowErrors = liftIO . throwIO . mkSrcErr\n\nthrowOneError :: MonadIO io => ErrMsg -> io a\nthrowOneError = throwErrors . unitBag\n\n-- | A source error is an error that is caused by one or more errors in the\n-- source code.  A 'SourceError' is thrown by many functions in the\n-- compilation pipeline.  Inside GHC these errors are merely printed via\n-- 'log_action', but API clients may treat them differently, for example,\n-- insert them into a list box.  If you want the default behaviour, use the\n-- idiom:\n--\n-- > handleSourceError printExceptionAndWarnings $ do\n-- >   ... api calls that may fail ...\n--\n-- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.\n-- This list may be empty if the compiler failed due to @-Werror@\n-- ('Opt_WarnIsError').\n--\n-- See 'printExceptionAndWarnings' for more information on what to take care\n-- of when writing a custom error handler.\nnewtype SourceError = SourceError ErrorMessages\n\ninstance Show SourceError where\n  show (SourceError msgs) = unlines . map show . bagToList $ msgs\n\ninstance Exception SourceError\n\n-- | Perform the given action and call the exception handler if the action\n-- throws a 'SourceError'.  See 'SourceError' for more information.\nhandleSourceError :: (ExceptionMonad m) =>\n                     (SourceError -> m a) -- ^ exception handler\n                  -> m a -- ^ action to perform\n                  -> m a\nhandleSourceError handler act =\n  gcatch act (\\(e :: SourceError) -> handler e)\n\n-- | An error thrown if the GHC API is used in an incorrect fashion.\nnewtype GhcApiError = GhcApiError String\n\ninstance Show GhcApiError where\n  show (GhcApiError msg) = msg\n\ninstance Exception GhcApiError\n\n-- | Given a bag of warnings, turn them into an exception if\n-- -Werror is enabled, or print them out otherwise.\nprintOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()\nprintOrThrowWarnings dflags warns = do\n  let (make_error, warns') =\n        mapAccumBagL\n          (\\make_err warn ->\n            case isWarnMsgFatal dflags warn of\n              Nothing ->\n                (make_err, warn)\n              Just err_reason ->\n                (True, warn{ errMsgSeverity = SevError\n                           , errMsgReason = ErrReason err_reason\n                           }))\n          False warns\n  if make_error\n    then throwIO (mkSrcErr warns')\n    else printBagOfErrors dflags warns\n\nhandleFlagWarnings :: DynFlags -> [Warn] -> IO ()\nhandleFlagWarnings dflags warns = do\n  let warns' = filter (shouldPrintWarning dflags . warnReason)  warns\n\n      -- It would be nicer if warns :: [Located MsgDoc], but that\n      -- has circular import problems.\n      bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)\n                      | Warn _ (dL->L loc warn) <- warns' ]\n\n  printOrThrowWarnings dflags bag\n\n-- Given a warn reason, check to see if it's associated -W opt is enabled\nshouldPrintWarning :: DynFlags -> CmdLineParser.WarnReason -> Bool\nshouldPrintWarning dflags ReasonDeprecatedFlag\n  = wopt Opt_WarnDeprecatedFlags dflags\nshouldPrintWarning dflags ReasonUnrecognisedFlag\n  = wopt Opt_WarnUnrecognisedWarningFlags dflags\nshouldPrintWarning _ _\n  = True\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{HscEnv}\n*                                                                      *\n************************************************************************\n-}\n\n-- | HscEnv is like 'Session', except that some of the fields are immutable.\n-- An HscEnv is used to compile a single module from plain Haskell source\n-- code (after preprocessing) to either C, assembly or C--.  Things like\n-- the module graph don't change during a single compilation.\n--\n-- Historical note: \\\"hsc\\\" used to be the name of the compiler binary,\n-- when there was a separate driver and compiler.  To compile a single\n-- module, the driver would invoke hsc on the source code... so nowadays\n-- we think of hsc as the layer of the compiler that deals with compiling\n-- a single module.\ndata HscEnv\n  = HscEnv {\n        hsc_dflags :: DynFlags,\n                -- ^ The dynamic flag settings\n\n        hsc_targets :: [Target],\n                -- ^ The targets (or roots) of the current session\n\n        hsc_mod_graph :: ModuleGraph,\n                -- ^ The module graph of the current session\n\n        hsc_IC :: InteractiveContext,\n                -- ^ The context for evaluating interactive statements\n\n        hsc_HPT    :: HomePackageTable,\n                -- ^ The home package table describes already-compiled\n                -- home-package modules, /excluding/ the module we\n                -- are compiling right now.\n                -- (In one-shot mode the current module is the only\n                -- home-package module, so hsc_HPT is empty.  All other\n                -- modules count as \\\"external-package\\\" modules.\n                -- However, even in GHCi mode, hi-boot interfaces are\n                -- demand-loaded into the external-package table.)\n                --\n                -- 'hsc_HPT' is not mutable because we only demand-load\n                -- external packages; the home package is eagerly\n                -- loaded, module by module, by the compilation manager.\n                --\n                -- The HPT may contain modules compiled earlier by @--make@\n                -- but not actually below the current module in the dependency\n                -- graph.\n                --\n                -- (This changes a previous invariant: changed Jan 05.)\n\n        hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),\n                -- ^ Information about the currently loaded external packages.\n                -- This is mutable because packages will be demand-loaded during\n                -- a compilation run as required.\n\n        hsc_NC  :: {-# UNPACK #-} !(IORef NameCache),\n                -- ^ As with 'hsc_EPS', this is side-effected by compiling to\n                -- reflect sucking in interface files.  They cache the state of\n                -- external interface files, in effect.\n\n        hsc_FC   :: {-# UNPACK #-} !(IORef FinderCache),\n                -- ^ The cached result of performing finding in the file system\n\n        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)\n                -- ^ Used for one-shot compilation only, to initialise\n                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for\n                -- 'TcRnTypes.TcGblEnv'.  See also Note [hsc_type_env_var hack]\n\n        , hsc_iserv :: MVar (Maybe IServ)\n                -- ^ interactive server process.  Created the first\n                -- time it is needed.\n }\n\n-- Note [hsc_type_env_var hack]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- hsc_type_env_var is used to initialize tcg_type_env_var, and\n-- eventually it is the mutable variable that is queried from\n-- if_rec_types to get a TypeEnv.  So, clearly, it's something\n-- related to knot-tying (see Note [Tying the knot]).\n-- hsc_type_env_var is used in two places: initTcRn (where\n-- it initializes tcg_type_env_var) and initIfaceCheck\n-- (where it initializes if_rec_types).\n--\n-- But why do we need a way to feed a mutable variable in?  Why\n-- can't we just initialize tcg_type_env_var when we start\n-- typechecking?  The problem is we need to knot-tie the\n-- EPS, and we may start adding things to the EPS before type\n-- checking starts.\n--\n-- Here is a concrete example. Suppose we are running\n-- \"ghc -c A.hs\", and we have this file system state:\n--\n--  A.hs-boot   A.hi-boot **up to date**\n--  B.hs        B.hi      **up to date**\n--  A.hs        A.hi      **stale**\n--\n-- The first thing we do is run checkOldIface on A.hi.\n-- checkOldIface will call loadInterface on B.hi so it can\n-- get its hands on the fingerprints, to find out if A.hi\n-- needs recompilation.  But loadInterface also populates\n-- the EPS!  And so if compilation turns out to be necessary,\n-- as it is in this case, the thunks we put into the EPS for\n-- B.hi need to have the correct if_rec_types mutable variable\n-- to query.\n--\n-- If the mutable variable is only allocated WHEN we start\n-- typechecking, then that's too late: we can't get the\n-- information to the thunks.  So we need to pre-commit\n-- to a type variable in 'hscIncrementalCompile' BEFORE we\n-- check the old interface.\n--\n-- This is all a massive hack because arguably checkOldIface\n-- should not populate the EPS. But that's a refactor for\n-- another day.\n\n\ndata IServ = IServ\n  { iservPipe :: Pipe\n  , iservProcess :: ProcessHandle\n  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))\n  , iservPendingFrees :: [HValueRef]\n  }\n\n-- | Retrieve the ExternalPackageState cache.\nhscEPS :: HscEnv -> IO ExternalPackageState\nhscEPS hsc_env = readIORef (hsc_EPS hsc_env)\n\n-- | A compilation target.\n--\n-- A target may be supplied with the actual text of the\n-- module.  If so, use this instead of the file contents (this\n-- is for use in an IDE where the file hasn't been saved by\n-- the user yet).\ndata Target\n  = Target {\n      targetId           :: TargetId, -- ^ module or filename\n      targetAllowObjCode :: Bool,     -- ^ object code allowed?\n      targetContents     :: Maybe (StringBuffer,UTCTime)\n                                        -- ^ in-memory text buffer?\n    }\n\ndata TargetId\n  = TargetModule ModuleName\n        -- ^ A module name: search for the file\n  | TargetFile FilePath (Maybe Phase)\n        -- ^ A filename: preprocess & parse it to find the module name.\n        -- If specified, the Phase indicates how to compile this file\n        -- (which phase to start from).  Nothing indicates the starting phase\n        -- should be determined from the suffix of the filename.\n  deriving Eq\n\npprTarget :: Target -> SDoc\npprTarget (Target id obj _) =\n    (if obj then char '*' else empty) <> pprTargetId id\n\ninstance Outputable Target where\n    ppr = pprTarget\n\npprTargetId :: TargetId -> SDoc\npprTargetId (TargetModule m) = ppr m\npprTargetId (TargetFile f _) = text f\n\ninstance Outputable TargetId where\n    ppr = pprTargetId\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Package and Module Tables}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Helps us find information about modules in the home package\ntype HomePackageTable  = DModuleNameEnv HomeModInfo\n        -- Domain = modules in the home package that have been fully compiled\n        -- \"home\" unit id cached here for convenience\n\n-- | Helps us find information about modules in the imported packages\ntype PackageIfaceTable = ModuleEnv ModIface\n        -- Domain = modules in the imported packages\n\n-- | Constructs an empty HomePackageTable\nemptyHomePackageTable :: HomePackageTable\nemptyHomePackageTable  = emptyUDFM\n\n-- | Constructs an empty PackageIfaceTable\nemptyPackageIfaceTable :: PackageIfaceTable\nemptyPackageIfaceTable = emptyModuleEnv\n\npprHPT :: HomePackageTable -> SDoc\n-- A bit arbitrary for now\npprHPT hpt = pprUDFM hpt $ \\hms ->\n    vcat [ hang (ppr (mi_module (hm_iface hm)))\n              2 (ppr (md_types (hm_details hm)))\n         | hm <- hms ]\n\nlookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo\nlookupHpt = lookupUDFM\n\nlookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo\nlookupHptDirectly = lookupUDFM_Directly\n\neltsHpt :: HomePackageTable -> [HomeModInfo]\neltsHpt = eltsUDFM\n\nfilterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable\nfilterHpt = filterUDFM\n\nallHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool\nallHpt = allUDFM\n\nmapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable\nmapHpt = mapUDFM\n\ndelFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable\ndelFromHpt = delFromUDFM\n\naddToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable\naddToHpt = addToUDFM\n\naddListToHpt\n  :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable\naddListToHpt = addListToUDFM\n\nlistToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable\nlistToHpt = listToUDFM\n\nlookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo\n-- The HPT is indexed by ModuleName, not Module,\n-- we must check for a hit on the right Module\nlookupHptByModule hpt mod\n  = case lookupHpt hpt (moduleName mod) of\n      Just hm | mi_module (hm_iface hm) == mod -> Just hm\n      _otherwise                               -> Nothing\n\n-- | Information about modules in the package being compiled\ndata HomeModInfo\n  = HomeModInfo {\n      hm_iface    :: !ModIface,\n        -- ^ The basic loaded interface file: every loaded module has one of\n        -- these, even if it is imported from another package\n      hm_details  :: !ModDetails,\n        -- ^ Extra information that has been created from the 'ModIface' for\n        -- the module, typically during typechecking\n      hm_linkable :: !(Maybe Linkable)\n        -- ^ The actual artifact we would like to link to access things in\n        -- this module.\n        --\n        -- 'hm_linkable' might be Nothing:\n        --\n        --   1. If this is an .hs-boot module\n        --\n        --   2. Temporarily during compilation if we pruned away\n        --      the old linkable because it was out of date.\n        --\n        -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields\n        -- in the 'HomePackageTable' will be @Just@.\n        --\n        -- When re-linking a module ('HscMain.HscNoRecomp'), we construct the\n        -- 'HomeModInfo' by building a new 'ModDetails' from the old\n        -- 'ModIface' (only).\n    }\n\n-- | Find the 'ModIface' for a 'Module', searching in both the loaded home\n-- and external package module information\nlookupIfaceByModule\n        :: DynFlags\n        -> HomePackageTable\n        -> PackageIfaceTable\n        -> Module\n        -> Maybe ModIface\nlookupIfaceByModule _dflags hpt pit mod\n  = case lookupHptByModule hpt mod of\n       Just hm -> Just (hm_iface hm)\n       Nothing -> lookupModuleEnv pit mod\n\n-- If the module does come from the home package, why do we look in the PIT as well?\n-- (a) In OneShot mode, even home-package modules accumulate in the PIT\n-- (b) Even in Batch (--make) mode, there is *one* case where a home-package\n--     module is in the PIT, namely GHC.Prim when compiling the base package.\n-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package\n-- of its own, but it doesn't seem worth the bother.\n\nhptCompleteSigs :: HscEnv -> [CompleteMatch]\nhptCompleteSigs = hptAllThings  (md_complete_sigs . hm_details)\n\n-- | Find all the instance declarations (of classes and families) from\n-- the Home Package Table filtered by the provided predicate function.\n-- Used in @tcRnImports@, to select the instances that are in the\n-- transitive closure of imports from the currently compiled module.\nhptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])\nhptInstances hsc_env want_this_module\n  = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \\mod_info -> do\n                guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))\n                let details = hm_details mod_info\n                return (md_insts details, md_fam_insts details)\n    in (concat insts, concat famInsts)\n\n-- | Get rules from modules \"below\" this one (in the dependency sense)\nhptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]\nhptRules = hptSomeThingsBelowUs (md_rules . hm_details) False\n\n\n-- | Get annotations from modules \"below\" this one (in the dependency sense)\nhptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]\nhptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps\nhptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env\n\nhptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]\nhptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))\n\n-- | Get things from modules \"below\" this one (in the dependency sense)\n-- C.f Inst.hptInstances\nhptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]\nhptSomeThingsBelowUs extract include_hi_boot hsc_env deps\n  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []\n\n  | otherwise\n  = let hpt = hsc_HPT hsc_env\n    in\n    [ thing\n    |   -- Find each non-hi-boot module below me\n      (mod, is_boot_mod) <- deps\n    , include_hi_boot || not is_boot_mod\n\n        -- unsavoury: when compiling the base package with --make, we\n        -- sometimes try to look up RULES etc for GHC.Prim. GHC.Prim won't\n        -- be in the HPT, because we never compile it; it's in the EPT\n        -- instead. ToDo: clean up, and remove this slightly bogus filter:\n    , mod /= moduleName gHC_PRIM\n\n        -- Look it up in the HPT\n    , let things = case lookupHpt hpt mod of\n                    Just info -> extract info\n                    Nothing -> pprTrace \"WARNING in hptSomeThingsBelowUs\" msg []\n          msg = vcat [text \"missing module\" <+> ppr mod,\n                      text \"Probable cause: out-of-date interface files\"]\n                        -- This really shouldn't happen, but see Trac #962\n\n        -- And get its dfuns\n    , thing <- things ]\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Metaprogramming}\n*                                                                      *\n************************************************************************\n-}\n\n-- | The supported metaprogramming result types\ndata MetaRequest\n  = MetaE  (LHsExpr GhcPs   -> MetaResult)\n  | MetaP  (LPat GhcPs      -> MetaResult)\n  | MetaT  (LHsType GhcPs   -> MetaResult)\n  | MetaD  ([LHsDecl GhcPs] -> MetaResult)\n  | MetaAW (Serialized     -> MetaResult)\n\n-- | data constructors not exported to ensure correct result type\ndata MetaResult\n  = MetaResE  { unMetaResE  :: LHsExpr GhcPs   }\n  | MetaResP  { unMetaResP  :: LPat GhcPs      }\n  | MetaResT  { unMetaResT  :: LHsType GhcPs   }\n  | MetaResD  { unMetaResD  :: [LHsDecl GhcPs] }\n  | MetaResAW { unMetaResAW :: Serialized        }\n\ntype MetaHook f = MetaRequest -> LHsExpr GhcTc -> f MetaResult\n\nmetaRequestE :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsExpr GhcPs)\nmetaRequestE h = fmap unMetaResE . h (MetaE MetaResE)\n\nmetaRequestP :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LPat GhcPs)\nmetaRequestP h = fmap unMetaResP . h (MetaP MetaResP)\n\nmetaRequestT :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsType GhcPs)\nmetaRequestT h = fmap unMetaResT . h (MetaT MetaResT)\n\nmetaRequestD :: Functor f => MetaHook f -> LHsExpr GhcTc -> f [LHsDecl GhcPs]\nmetaRequestD h = fmap unMetaResD . h (MetaD MetaResD)\n\nmetaRequestAW :: Functor f => MetaHook f -> LHsExpr GhcTc -> f Serialized\nmetaRequestAW h = fmap unMetaResAW . h (MetaAW MetaResAW)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Dealing with Annotations}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Deal with gathering annotations in from all possible places\n--   and combining them into a single 'AnnEnv'\nprepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv\nprepareAnnotations hsc_env mb_guts = do\n    eps <- hscEPS hsc_env\n    let -- Extract annotations from the module being compiled if supplied one\n        mb_this_module_anns = fmap (mkAnnEnv . mg_anns) mb_guts\n        -- Extract dependencies of the module if we are supplied one,\n        -- otherwise load annotations from all home package table\n        -- entries regardless of dependency ordering.\n        home_pkg_anns  = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts\n        other_pkg_anns = eps_ann_env eps\n        ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,\n                                                         Just home_pkg_anns,\n                                                         Just other_pkg_anns]\n    return ann_env\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The Finder cache}\n*                                                                      *\n************************************************************************\n-}\n\n-- | The 'FinderCache' maps modules to the result of\n-- searching for that module. It records the results of searching for\n-- modules along the search path. On @:load@, we flush the entire\n-- contents of this cache.\n--\ntype FinderCache = InstalledModuleEnv InstalledFindResult\n\ndata InstalledFindResult\n  = InstalledFound ModLocation InstalledModule\n  | InstalledNoPackage InstalledUnitId\n  | InstalledNotFound [FilePath] (Maybe InstalledUnitId)\n\n-- | The result of searching for an imported module.\n--\n-- NB: FindResult manages both user source-import lookups\n-- (which can result in 'Module') as well as direct imports\n-- for interfaces (which always result in 'InstalledModule').\ndata FindResult\n  = Found ModLocation Module\n        -- ^ The module was found\n  | NoPackage UnitId\n        -- ^ The requested package was not found\n  | FoundMultiple [(Module, ModuleOrigin)]\n        -- ^ _Error_: both in multiple packages\n\n        -- | Not found\n  | NotFound\n      { fr_paths       :: [FilePath]       -- Places where I looked\n\n      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's\n                                           --           manifest, but couldn't find\n                                           --           the .hi file\n\n      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,\n                                           --   but the *module* is hidden\n\n      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,\n                                           --   but the *package* is hidden\n\n        -- Modules are in these packages, but it is unusable\n      , fr_unusables   :: [(UnitId, UnusablePackageReason)]\n\n      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules\n      }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Symbol tables and Module details}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A 'ModIface' plus a 'ModDetails' summarises everything we know\n-- about a compiled module.  The 'ModIface' is the stuff *before* linking,\n-- and can be written out to an interface file. The 'ModDetails is after\n-- linking and can be completely recovered from just the 'ModIface'.\n--\n-- When we read an interface file, we also construct a 'ModIface' from it,\n-- except that we explicitly make the 'mi_decls' and a few other fields empty;\n-- as when reading we consolidate the declarations etc. into a number of indexed\n-- maps and environments in the 'ExternalPackageState'.\ndata ModIface\n  = ModIface {\n        mi_module     :: !Module,             -- ^ Name of the module we are for\n        mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?\n        mi_iface_hash :: !Fingerprint,        -- ^ Hash of the whole interface\n        mi_mod_hash   :: !Fingerprint,        -- ^ Hash of the ABI only\n        mi_flag_hash  :: !Fingerprint,        -- ^ Hash of the important flags\n                                              -- used when compiling the module,\n                                              -- excluding optimisation flags\n        mi_opt_hash   :: !Fingerprint,        -- ^ Hash of optimisation flags\n        mi_hpc_hash   :: !Fingerprint,        -- ^ Hash of hpc flags\n        mi_plugin_hash :: !Fingerprint,       -- ^ Hash of plugins\n\n        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans\n        mi_finsts     :: !WhetherHasFamInst,\n                -- ^ Whether this module has family instances.\n                -- See Note [The type family instance consistency story].\n        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?\n\n        mi_deps     :: Dependencies,\n                -- ^ The dependencies of the module.  This is\n                -- consulted for directly-imported modules, but not\n                -- for anything else (hence lazy)\n\n        mi_usages   :: [Usage],\n                -- ^ Usages; kept sorted so that it's easy to decide\n                -- whether to write a new iface file (changing usages\n                -- doesn't affect the hash of this module)\n                -- NOT STRICT!  we read this field lazily from the interface file\n                -- It is *only* consulted by the recompilation checker\n\n        mi_exports  :: ![IfaceExport],\n                -- ^ Exports\n                -- Kept sorted by (mod,occ), to make version comparisons easier\n                -- Records the modules that are the declaration points for things\n                -- exported by this module, and the 'OccName's of those things\n\n        mi_exp_hash :: !Fingerprint,\n                -- ^ Hash of export list\n\n        mi_used_th  :: !Bool,\n                -- ^ Module required TH splices when it was compiled.\n                -- This disables recompilation avoidance (see #481).\n\n        mi_fixities :: [(OccName,Fixity)],\n                -- ^ Fixities\n                -- NOT STRICT!  we read this field lazily from the interface file\n\n        mi_warns    :: Warnings,\n                -- ^ Warnings\n                -- NOT STRICT!  we read this field lazily from the interface file\n\n        mi_anns     :: [IfaceAnnotation],\n                -- ^ Annotations\n                -- NOT STRICT!  we read this field lazily from the interface file\n\n\n        mi_decls    :: [(Fingerprint,IfaceDecl)],\n                -- ^ Type, class and variable declarations\n                -- The hash of an Id changes if its fixity or deprecations change\n                --      (as well as its type of course)\n                -- Ditto data constructors, class operations, except that\n                -- the hash of the parent class/tycon changes\n\n        mi_globals  :: !(Maybe GlobalRdrEnv),\n                -- ^ Binds all the things defined at the top level in\n                -- the /original source/ code for this module. which\n                -- is NOT the same as mi_exports, nor mi_decls (which\n                -- may contains declarations for things not actually\n                -- defined by the user).  Used for GHCi and for inspecting\n                -- the contents of modules via the GHC API only.\n                --\n                -- (We need the source file to figure out the\n                -- top-level environment, if we didn't compile this module\n                -- from source then this field contains @Nothing@).\n                --\n                -- Strictly speaking this field should live in the\n                -- 'HomeModInfo', but that leads to more plumbing.\n\n                -- Instance declarations and rules\n        mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance\n        mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances\n        mi_rules       :: [IfaceRule],     -- ^ Sorted rules\n        mi_orphan_hash :: !Fingerprint,    -- ^ Hash for orphan rules, class and family\n                                           -- instances combined\n\n                -- Cached environments for easy lookup\n                -- These are computed (lazily) from other fields\n                -- and are not put into the interface file\n        mi_warn_fn   :: OccName -> Maybe WarningTxt,\n                -- ^ Cached lookup for 'mi_warns'\n        mi_fix_fn    :: OccName -> Maybe Fixity,\n                -- ^ Cached lookup for 'mi_fixities'\n        mi_hash_fn   :: OccName -> Maybe (OccName, Fingerprint),\n                -- ^ Cached lookup for 'mi_decls'.\n                -- The @Nothing@ in 'mi_hash_fn' means that the thing\n                -- isn't in decls. It's useful to know that when\n                -- seeing if we are up to date wrt. the old interface.\n                -- The 'OccName' is the parent of the name, if it has one.\n\n        mi_hpc       :: !AnyHpcUsage,\n                -- ^ True if this program uses Hpc at any point in the program.\n\n        mi_trust     :: !IfaceTrustInfo,\n                -- ^ Safe Haskell Trust information for this module.\n\n        mi_trust_pkg :: !Bool,\n                -- ^ Do we require the package this module resides in be trusted\n                -- to trust this module? This is used for the situation where a\n                -- module is Safe (so doesn't require the package be trusted\n                -- itself) but imports some trustworthy modules from its own\n                -- package (which does require its own package be trusted).\n                -- See Note [RnNames . Trust Own Package]\n        mi_complete_sigs :: [IfaceCompleteMatch],\n\n        mi_doc_hdr :: Maybe HsDocString,\n                -- ^ Module header.\n\n        mi_decl_docs :: DeclDocMap,\n                -- ^ Docs on declarations.\n\n        mi_arg_docs :: ArgDocMap\n                -- ^ Docs on arguments.\n     }\n\n-- | Old-style accessor for whether or not the ModIface came from an hs-boot\n-- file.\nmi_boot :: ModIface -> Bool\nmi_boot iface = mi_hsc_src iface == HsBootFile\n\n-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be\n-- found, 'defaultFixity' is returned instead.\nmi_fix :: ModIface -> OccName -> Fixity\nmi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity\n\n-- | The semantic module for this interface; e.g., if it's a interface\n-- for a signature, if 'mi_module' is @p[A=<A>]:A@, 'mi_semantic_module'\n-- will be @<A>@.\nmi_semantic_module :: ModIface -> Module\nmi_semantic_module iface = case mi_sig_of iface of\n                            Nothing -> mi_module iface\n                            Just mod -> mod\n\n-- | The \"precise\" free holes, e.g., the signatures that this\n-- 'ModIface' depends on.\nmi_free_holes :: ModIface -> UniqDSet ModuleName\nmi_free_holes iface =\n  case splitModuleInsts (mi_module iface) of\n    (_, Just indef)\n        -- A mini-hack: we rely on the fact that 'renameFreeHoles'\n        -- drops things that aren't holes.\n        -> renameFreeHoles (mkUniqDSet cands) (indefUnitIdInsts (indefModuleUnitId indef))\n    _   -> emptyUniqDSet\n  where\n    cands = map fst (dep_mods (mi_deps iface))\n\n-- | Given a set of free holes, and a unit identifier, rename\n-- the free holes according to the instantiation of the unit\n-- identifier.  For example, if we have A and B free, and\n-- our unit identity is @p[A=<C>,B=impl:B]@, the renamed free\n-- holes are just C.\nrenameFreeHoles :: UniqDSet ModuleName -> [(ModuleName, Module)] -> UniqDSet ModuleName\nrenameFreeHoles fhs insts =\n    unionManyUniqDSets (map lookup_impl (uniqDSetToList fhs))\n  where\n    hmap = listToUFM insts\n    lookup_impl mod_name\n        | Just mod <- lookupUFM hmap mod_name = moduleFreeHoles mod\n        -- It wasn't actually a hole\n        | otherwise                           = emptyUniqDSet\n\ninstance Binary ModIface where\n   put_ bh (ModIface {\n                 mi_module    = mod,\n                 mi_sig_of    = sig_of,\n                 mi_hsc_src   = hsc_src,\n                 mi_iface_hash= iface_hash,\n                 mi_mod_hash  = mod_hash,\n                 mi_flag_hash = flag_hash,\n                 mi_opt_hash  = opt_hash,\n                 mi_hpc_hash  = hpc_hash,\n                 mi_plugin_hash = plugin_hash,\n                 mi_orphan    = orphan,\n                 mi_finsts    = hasFamInsts,\n                 mi_deps      = deps,\n                 mi_usages    = usages,\n                 mi_exports   = exports,\n                 mi_exp_hash  = exp_hash,\n                 mi_used_th   = used_th,\n                 mi_fixities  = fixities,\n                 mi_warns     = warns,\n                 mi_anns      = anns,\n                 mi_decls     = decls,\n                 mi_insts     = insts,\n                 mi_fam_insts = fam_insts,\n                 mi_rules     = rules,\n                 mi_orphan_hash = orphan_hash,\n                 mi_hpc       = hpc_info,\n                 mi_trust     = trust,\n                 mi_trust_pkg = trust_pkg,\n                 mi_complete_sigs = complete_sigs,\n                 mi_doc_hdr   = doc_hdr,\n                 mi_decl_docs = decl_docs,\n                 mi_arg_docs  = arg_docs }) = do\n        put_ bh mod\n        put_ bh sig_of\n        put_ bh hsc_src\n        put_ bh iface_hash\n        put_ bh mod_hash\n        put_ bh flag_hash\n        put_ bh opt_hash\n        put_ bh hpc_hash\n        put_ bh plugin_hash\n        put_ bh orphan\n        put_ bh hasFamInsts\n        lazyPut bh deps\n        lazyPut bh usages\n        put_ bh exports\n        put_ bh exp_hash\n        put_ bh used_th\n        put_ bh fixities\n        lazyPut bh warns\n        lazyPut bh anns\n        put_ bh decls\n        put_ bh insts\n        put_ bh fam_insts\n        lazyPut bh rules\n        put_ bh orphan_hash\n        put_ bh hpc_info\n        put_ bh trust\n        put_ bh trust_pkg\n        put_ bh complete_sigs\n        lazyPut bh doc_hdr\n        lazyPut bh decl_docs\n        lazyPut bh arg_docs\n\n   get bh = do\n        mod         <- get bh\n        sig_of      <- get bh\n        hsc_src     <- get bh\n        iface_hash  <- get bh\n        mod_hash    <- get bh\n        flag_hash   <- get bh\n        opt_hash    <- get bh\n        hpc_hash    <- get bh\n        plugin_hash <- get bh\n        orphan      <- get bh\n        hasFamInsts <- get bh\n        deps        <- lazyGet bh\n        usages      <- {-# SCC \"bin_usages\" #-} lazyGet bh\n        exports     <- {-# SCC \"bin_exports\" #-} get bh\n        exp_hash    <- get bh\n        used_th     <- get bh\n        fixities    <- {-# SCC \"bin_fixities\" #-} get bh\n        warns       <- {-# SCC \"bin_warns\" #-} lazyGet bh\n        anns        <- {-# SCC \"bin_anns\" #-} lazyGet bh\n        decls       <- {-# SCC \"bin_tycldecls\" #-} get bh\n        insts       <- {-# SCC \"bin_insts\" #-} get bh\n        fam_insts   <- {-# SCC \"bin_fam_insts\" #-} get bh\n        rules       <- {-# SCC \"bin_rules\" #-} lazyGet bh\n        orphan_hash <- get bh\n        hpc_info    <- get bh\n        trust       <- get bh\n        trust_pkg   <- get bh\n        complete_sigs <- get bh\n        doc_hdr     <- lazyGet bh\n        decl_docs   <- lazyGet bh\n        arg_docs    <- lazyGet bh\n        return (ModIface {\n                 mi_module      = mod,\n                 mi_sig_of      = sig_of,\n                 mi_hsc_src     = hsc_src,\n                 mi_iface_hash  = iface_hash,\n                 mi_mod_hash    = mod_hash,\n                 mi_flag_hash   = flag_hash,\n                 mi_opt_hash    = opt_hash,\n                 mi_hpc_hash    = hpc_hash,\n                 mi_plugin_hash = plugin_hash,\n                 mi_orphan      = orphan,\n                 mi_finsts      = hasFamInsts,\n                 mi_deps        = deps,\n                 mi_usages      = usages,\n                 mi_exports     = exports,\n                 mi_exp_hash    = exp_hash,\n                 mi_used_th     = used_th,\n                 mi_anns        = anns,\n                 mi_fixities    = fixities,\n                 mi_warns       = warns,\n                 mi_decls       = decls,\n                 mi_globals     = Nothing,\n                 mi_insts       = insts,\n                 mi_fam_insts   = fam_insts,\n                 mi_rules       = rules,\n                 mi_orphan_hash = orphan_hash,\n                 mi_hpc         = hpc_info,\n                 mi_trust       = trust,\n                 mi_trust_pkg   = trust_pkg,\n                        -- And build the cached values\n                 mi_warn_fn     = mkIfaceWarnCache warns,\n                 mi_fix_fn      = mkIfaceFixCache fixities,\n                 mi_hash_fn     = mkIfaceHashCache decls,\n                 mi_complete_sigs = complete_sigs,\n                 mi_doc_hdr     = doc_hdr,\n                 mi_decl_docs   = decl_docs,\n                 mi_arg_docs    = arg_docs })\n\n-- | The original names declared of a certain module that are exported\ntype IfaceExport = AvailInfo\n\n-- | Constructs an empty ModIface\nemptyModIface :: Module -> ModIface\nemptyModIface mod\n  = ModIface { mi_module      = mod,\n               mi_sig_of      = Nothing,\n               mi_iface_hash  = fingerprint0,\n               mi_mod_hash    = fingerprint0,\n               mi_flag_hash   = fingerprint0,\n               mi_opt_hash    = fingerprint0,\n               mi_hpc_hash    = fingerprint0,\n               mi_plugin_hash = fingerprint0,\n               mi_orphan      = False,\n               mi_finsts      = False,\n               mi_hsc_src     = HsSrcFile,\n               mi_deps        = noDependencies,\n               mi_usages      = [],\n               mi_exports     = [],\n               mi_exp_hash    = fingerprint0,\n               mi_used_th     = False,\n               mi_fixities    = [],\n               mi_warns       = NoWarnings,\n               mi_anns        = [],\n               mi_insts       = [],\n               mi_fam_insts   = [],\n               mi_rules       = [],\n               mi_decls       = [],\n               mi_globals     = Nothing,\n               mi_orphan_hash = fingerprint0,\n               mi_warn_fn     = emptyIfaceWarnCache,\n               mi_fix_fn      = emptyIfaceFixCache,\n               mi_hash_fn     = emptyIfaceHashCache,\n               mi_hpc         = False,\n               mi_trust       = noIfaceTrustInfo,\n               mi_trust_pkg   = False,\n               mi_complete_sigs = [],\n               mi_doc_hdr     = Nothing,\n               mi_decl_docs   = emptyDeclDocMap,\n               mi_arg_docs    = emptyArgDocMap }\n\n\n-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'\nmkIfaceHashCache :: [(Fingerprint,IfaceDecl)]\n                 -> (OccName -> Maybe (OccName, Fingerprint))\nmkIfaceHashCache pairs\n  = \\occ -> lookupOccEnv env occ\n  where\n    env = foldl' add_decl emptyOccEnv pairs\n    add_decl env0 (v,d) = foldl' add env0 (ifaceDeclFingerprints v d)\n      where\n        add env0 (occ,hash) = extendOccEnv env0 occ (occ,hash)\n\nemptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)\nemptyIfaceHashCache _occ = Nothing\n\n\n-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'\n-- for home modules only. Information relating to packages will be loaded into\n-- global environments in 'ExternalPackageState'.\ndata ModDetails\n  = ModDetails {\n        -- The next two fields are created by the typechecker\n        md_exports   :: [AvailInfo],\n        md_types     :: !TypeEnv,       -- ^ Local type environment for this particular module\n                                        -- Includes Ids, TyCons, PatSyns\n        md_insts     :: ![ClsInst],     -- ^ 'DFunId's for the instances in this module\n        md_fam_insts :: ![FamInst],\n        md_rules     :: ![CoreRule],    -- ^ Domain may include 'Id's from other modules\n        md_anns      :: ![Annotation],  -- ^ Annotations present in this module: currently\n                                        -- they only annotate things also declared in this module\n        md_complete_sigs :: [CompleteMatch]\n          -- ^ Complete match pragmas for this module\n     }\n\n-- | Constructs an empty ModDetails\nemptyModDetails :: ModDetails\nemptyModDetails\n  = ModDetails { md_types     = emptyTypeEnv,\n                 md_exports   = [],\n                 md_insts     = [],\n                 md_rules     = [],\n                 md_fam_insts = [],\n                 md_anns      = [],\n                 md_complete_sigs = [] }\n\n-- | Records the modules directly imported by a module for extracting e.g.\n-- usage information, and also to give better error message\ntype ImportedMods = ModuleEnv [ImportedBy]\n\n-- | If a module was \"imported\" by the user, we associate it with\n-- more detailed usage information 'ImportedModsVal'; a module\n-- imported by the system only gets used for usage information.\ndata ImportedBy\n    = ImportedByUser ImportedModsVal\n    | ImportedBySystem\n\nimportedByUser :: [ImportedBy] -> [ImportedModsVal]\nimportedByUser (ImportedByUser imv : bys) = imv : importedByUser bys\nimportedByUser (ImportedBySystem   : bys) =       importedByUser bys\nimportedByUser [] = []\n\ndata ImportedModsVal\n = ImportedModsVal {\n        imv_name :: ModuleName,          -- ^ The name the module is imported with\n        imv_span :: SrcSpan,             -- ^ the source span of the whole import\n        imv_is_safe :: IsSafeImport,     -- ^ whether this is a safe import\n        imv_is_hiding :: Bool,           -- ^ whether this is an \"hiding\" import\n        imv_all_exports :: !GlobalRdrEnv, -- ^ all the things the module could provide\n          -- NB. BangPattern here: otherwise this leaks. (#15111)\n        imv_qualified :: Bool            -- ^ whether this is a qualified import\n        }\n\n-- | A ModGuts is carried through the compiler, accumulating stuff as it goes\n-- There is only one ModGuts at any time, the one for the module\n-- being compiled right now.  Once it is compiled, a 'ModIface' and\n-- 'ModDetails' are extracted and the ModGuts is discarded.\ndata ModGuts\n  = ModGuts {\n        mg_module    :: !Module,         -- ^ Module being compiled\n        mg_hsc_src   :: HscSource,       -- ^ Whether it's an hs-boot module\n        mg_loc       :: SrcSpan,         -- ^ For error messages from inner passes\n        mg_exports   :: ![AvailInfo],    -- ^ What it exports\n        mg_deps      :: !Dependencies,   -- ^ What it depends on, directly or\n                                         -- otherwise\n        mg_usages    :: ![Usage],        -- ^ What was used?  Used for interfaces.\n\n        mg_used_th   :: !Bool,           -- ^ Did we run a TH splice?\n        mg_rdr_env   :: !GlobalRdrEnv,   -- ^ Top-level lexical environment\n\n        -- These fields all describe the things **declared in this module**\n        mg_fix_env   :: !FixityEnv,      -- ^ Fixities declared in this module.\n                                         -- Used for creating interface files.\n        mg_tcs       :: ![TyCon],        -- ^ TyCons declared in this module\n                                         -- (includes TyCons for classes)\n        mg_insts     :: ![ClsInst],      -- ^ Class instances declared in this module\n        mg_fam_insts :: ![FamInst],\n                                         -- ^ Family instances declared in this module\n        mg_patsyns   :: ![PatSyn],       -- ^ Pattern synonyms declared in this module\n        mg_rules     :: ![CoreRule],     -- ^ Before the core pipeline starts, contains\n                                         -- See Note [Overall plumbing for rules] in Rules.hs\n        mg_binds     :: !CoreProgram,    -- ^ Bindings for this module\n        mg_foreign   :: !ForeignStubs,   -- ^ Foreign exports declared in this module\n        mg_foreign_files :: ![(ForeignSrcLang, FilePath)],\n        -- ^ Files to be compiled with the C compiler\n        mg_warns     :: !Warnings,       -- ^ Warnings declared in the module\n        mg_anns      :: [Annotation],    -- ^ Annotations declared in this module\n        mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches\n        mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module\n        mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module\n\n                        -- The next two fields are unusual, because they give instance\n                        -- environments for *all* modules in the home package, including\n                        -- this module, rather than for *just* this module.\n                        -- Reason: when looking up an instance we don't want to have to\n                        --         look at each module in the home package in turn\n        mg_inst_env     :: InstEnv,             -- ^ Class instance environment for\n                                                -- /home-package/ modules (including this\n                                                -- one); c.f. 'tcg_inst_env'\n        mg_fam_inst_env :: FamInstEnv,          -- ^ Type-family instance environment for\n                                                -- /home-package/ modules (including this\n                                                -- one); c.f. 'tcg_fam_inst_env'\n\n        mg_safe_haskell :: SafeHaskellMode,     -- ^ Safe Haskell mode\n        mg_trust_pkg    :: Bool,                -- ^ Do we need to trust our\n                                                -- own package for Safe Haskell?\n                                                -- See Note [RnNames . Trust Own Package]\n\n        mg_doc_hdr       :: !(Maybe HsDocString), -- ^ Module header.\n        mg_decl_docs     :: !DeclDocMap,     -- ^ Docs on declarations.\n        mg_arg_docs      :: !ArgDocMap       -- ^ Docs on arguments.\n    }\n\n-- The ModGuts takes on several slightly different forms:\n--\n-- After simplification, the following fields change slightly:\n--      mg_rules        Orphan rules only (local ones now attached to binds)\n--      mg_binds        With rules attached\n\n---------------------------------------------------------\n-- The Tidy pass forks the information about this module:\n--      * one lot goes to interface file generation (ModIface)\n--        and later compilations (ModDetails)\n--      * the other lot goes to code generation (CgGuts)\n\n-- | A restricted form of 'ModGuts' for code generation purposes\ndata CgGuts\n  = CgGuts {\n        cg_module    :: !Module,\n                -- ^ Module being compiled\n\n        cg_tycons    :: [TyCon],\n                -- ^ Algebraic data types (including ones that started\n                -- life as classes); generate constructors and info\n                -- tables. Includes newtypes, just for the benefit of\n                -- External Core\n\n        cg_binds     :: CoreProgram,\n                -- ^ The tidied main bindings, including\n                -- previously-implicit bindings for record and class\n                -- selectors, and data constructor wrappers.  But *not*\n                -- data constructor workers; reason: we regard them\n                -- as part of the code-gen of tycons\n\n        cg_foreign   :: !ForeignStubs,   -- ^ Foreign export stubs\n        cg_foreign_files :: ![(ForeignSrcLang, FilePath)],\n        cg_dep_pkgs  :: ![InstalledUnitId], -- ^ Dependent packages, used to\n                                            -- generate #includes for C code gen\n        cg_hpc_info  :: !HpcInfo,           -- ^ Program coverage tick box information\n        cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints\n        cg_spt_entries :: [SptEntry]\n                -- ^ Static pointer table entries for static forms defined in\n                -- the module.\n                -- See Note [Grand plan for static forms] in StaticPtrTable\n    }\n\n-----------------------------------\n-- | Foreign export stubs\ndata ForeignStubs\n  = NoStubs\n      -- ^ We don't have any stubs\n  | ForeignStubs SDoc SDoc\n      -- ^ There are some stubs. Parameters:\n      --\n      --  1) Header file prototypes for\n      --     \"foreign exported\" functions\n      --\n      --  2) C stubs to use when calling\n      --     \"foreign exported\" functions\n\nappendStubC :: ForeignStubs -> SDoc -> ForeignStubs\nappendStubC NoStubs            c_code = ForeignStubs empty c_code\nappendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)\n\n-- | An entry to be inserted into a module's static pointer table.\n-- See Note [Grand plan for static forms] in StaticPtrTable.\ndata SptEntry = SptEntry Id Fingerprint\n\ninstance Outputable SptEntry where\n  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr\n\n{-\n************************************************************************\n*                                                                      *\n                The interactive context\n*                                                                      *\n************************************************************************\n\nNote [The interactive package]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nType, class, and value declarations at the command prompt are treated\nas if they were defined in modules\n   interactive:Ghci1\n   interactive:Ghci2\n   ...etc...\nwith each bunch of declarations using a new module, all sharing a\ncommon package 'interactive' (see Module.interactiveUnitId, and\nPrelNames.mkInteractiveModule).\n\nThis scheme deals well with shadowing.  For example:\n\n   ghci> data T = A\n   ghci> data T = B\n   ghci> :i A\n   data Ghci1.T = A  -- Defined at <interactive>:2:10\n\nHere we must display info about constructor A, but its type T has been\nshadowed by the second declaration.  But it has a respectable\nqualified name (Ghci1.T), and its source location says where it was\ndefined.\n\nSo the main invariant continues to hold, that in any session an\noriginal name M.T only refers to one unique thing.  (In a previous\niteration both the T's above were called :Interactive.T, albeit with\ndifferent uniques, which gave rise to all sorts of trouble.)\n\nThe details are a bit tricky though:\n\n * The field ic_mod_index counts which Ghci module we've got up to.\n   It is incremented when extending ic_tythings\n\n * ic_tythings contains only things from the 'interactive' package.\n\n * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go\n   in the Home Package Table (HPT).  When you say :load, that's when we\n   extend the HPT.\n\n * The 'thisPackage' field of DynFlags is *not* set to 'interactive'.\n   It stays as 'main' (or whatever -this-unit-id says), and is the\n   package to which :load'ed modules are added to.\n\n * So how do we arrange that declarations at the command prompt get to\n   be in the 'interactive' package?  Simply by setting the tcg_mod\n   field of the TcGblEnv to \"interactive:Ghci1\".  This is done by the\n   call to initTc in initTcInteractive, which in turn get the module\n   from it 'icInteractiveModule' field of the interactive context.\n\n   The 'thisPackage' field stays as 'main' (or whatever -this-unit-id says.\n\n * The main trickiness is that the type environment (tcg_type_env) and\n   fixity envt (tcg_fix_env), now contain entities from all the\n   interactive-package modules (Ghci1, Ghci2, ...) together, rather\n   than just a single module as is usually the case.  So you can't use\n   \"nameIsLocalOrFrom\" to decide whether to look in the TcGblEnv vs\n   the HPT/PTE.  This is a change, but not a problem provided you\n   know.\n\n* However, the tcg_binds, tcg_sigs, tcg_insts, tcg_fam_insts, etc fields\n  of the TcGblEnv, which collect \"things defined in this module\", all\n  refer to stuff define in a single GHCi command, *not* all the commands\n  so far.\n\n  In contrast, tcg_inst_env, tcg_fam_inst_env, have instances from\n  all GhciN modules, which makes sense -- they are all \"home package\"\n  modules.\n\n\nNote [Interactively-bound Ids in GHCi]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe Ids bound by previous Stmts in GHCi are currently\n        a) GlobalIds, with\n        b) An External Name, like Ghci4.foo\n           See Note [The interactive package] above\n        c) A tidied type\n\n (a) They must be GlobalIds (not LocalIds) otherwise when we come to\n     compile an expression using these ids later, the byte code\n     generator will consider the occurrences to be free rather than\n     global.\n\n (b) Having an External Name is important because of Note\n     [GlobalRdrEnv shadowing] in RdrName\n\n (c) Their types are tidied. This is important, because :info may ask\n     to look at them, and :info expects the things it looks up to have\n     tidy types\n\nWhere do interactively-bound Ids come from?\n\n  - GHCi REPL Stmts   e.g.\n         ghci> let foo x = x+1\n    These start with an Internal Name because a Stmt is a local\n    construct, so the renamer naturally builds an Internal name for\n    each of its binders.  Then in tcRnStmt they are externalised via\n    TcRnDriver.externaliseAndTidyId, so they get Names like Ghic4.foo.\n\n  - Ids bound by the debugger etc have Names constructed by\n    IfaceEnv.newInteractiveBinder; at the call sites it is followed by\n    mkVanillaGlobal or mkVanillaGlobalWithInfo.  So again, they are\n    all Global, External.\n\n  - TyCons, Classes, and Ids bound by other top-level declarations in\n    GHCi (eg foreign import, record selectors) also get External\n    Names, with Ghci9 (or 8, or 7, etc) as the module name.\n\n\nNote [ic_tythings]\n~~~~~~~~~~~~~~~~~~\nThe ic_tythings field contains\n  * The TyThings declared by the user at the command prompt\n    (eg Ids, TyCons, Classes)\n\n  * The user-visible Ids that arise from such things, which\n    *don't* come from 'implicitTyThings', notably:\n       - record selectors\n       - class ops\n    The implicitTyThings are readily obtained from the TyThings\n    but record selectors etc are not\n\nIt does *not* contain\n  * DFunIds (they can be gotten from ic_instances)\n  * CoAxioms (ditto)\n\nSee also Note [Interactively-bound Ids in GHCi]\n\nNote [Override identical instances in GHCi]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf you declare a new instance in GHCi that is identical to a previous one,\nwe simply override the previous one; we don't regard it as overlapping.\ne.g.    Prelude> data T = A | B\n        Prelude> instance Eq T where ...\n        Prelude> instance Eq T where ...   -- This one overrides\n\nIt's exactly the same for type-family instances.  See Trac #7102\n-}\n\n-- | Interactive context, recording information about the state of the\n-- context in which statements are executed in a GHCi session.\ndata InteractiveContext\n  = InteractiveContext {\n         ic_dflags     :: DynFlags,\n             -- ^ The 'DynFlags' used to evaluate interative expressions\n             -- and statements.\n\n         ic_mod_index :: Int,\n             -- ^ Each GHCi stmt or declaration brings some new things into\n             -- scope. We give them names like interactive:Ghci9.T,\n             -- where the ic_index is the '9'.  The ic_mod_index is\n             -- incremented whenever we add something to ic_tythings\n             -- See Note [The interactive package]\n\n         ic_imports :: [InteractiveImport],\n             -- ^ The GHCi top-level scope (ic_rn_gbl_env) is extended with\n             -- these imports\n             --\n             -- This field is only stored here so that the client\n             -- can retrieve it with GHC.getContext. GHC itself doesn't\n             -- use it, but does reset it to empty sometimes (such\n             -- as before a GHC.load). The context is set with GHC.setContext.\n\n         ic_tythings   :: [TyThing],\n             -- ^ TyThings defined by the user, in reverse order of\n             -- definition (ie most recent at the front)\n             -- See Note [ic_tythings]\n\n         ic_rn_gbl_env :: GlobalRdrEnv,\n             -- ^ The cached 'GlobalRdrEnv', built by\n             -- 'InteractiveEval.setContext' and updated regularly\n             -- It contains everything in scope at the command line,\n             -- including everything in ic_tythings\n\n         ic_instances  :: ([ClsInst], [FamInst]),\n             -- ^ All instances and family instances created during\n             -- this session.  These are grabbed en masse after each\n             -- update to be sure that proper overlapping is retained.\n             -- That is, rather than re-check the overlapping each\n             -- time we update the context, we just take the results\n             -- from the instance code that already does that.\n\n         ic_fix_env :: FixityEnv,\n            -- ^ Fixities declared in let statements\n\n         ic_default :: Maybe [Type],\n             -- ^ The current default types, set by a 'default' declaration\n\n          ic_resume :: [Resume],\n             -- ^ The stack of breakpoint contexts\n\n         ic_monad      :: Name,\n             -- ^ The monad that GHCi is executing in\n\n         ic_int_print  :: Name,\n             -- ^ The function that is used for printing results\n             -- of expressions in ghci and -e mode.\n\n         ic_cwd :: Maybe FilePath\n             -- virtual CWD of the program\n    }\n\ndata InteractiveImport\n  = IIDecl (ImportDecl GhcPs)\n      -- ^ Bring the exports of a particular module\n      -- (filtered by an import decl) into scope\n\n  | IIModule ModuleName\n      -- ^ Bring into scope the entire top-level envt of\n      -- of this module, including the things imported\n      -- into it.\n\n\n-- | Constructs an empty InteractiveContext.\nemptyInteractiveContext :: DynFlags -> InteractiveContext\nemptyInteractiveContext dflags\n  = InteractiveContext {\n       ic_dflags     = dflags,\n       ic_imports    = [],\n       ic_rn_gbl_env = emptyGlobalRdrEnv,\n       ic_mod_index  = 1,\n       ic_tythings   = [],\n       ic_instances  = ([],[]),\n       ic_fix_env    = emptyNameEnv,\n       ic_monad      = ioTyConName,  -- IO monad by default\n       ic_int_print  = printName,    -- System.IO.print by default\n       ic_default    = Nothing,\n       ic_resume     = [],\n       ic_cwd        = Nothing }\n\nicInteractiveModule :: InteractiveContext -> Module\nicInteractiveModule (InteractiveContext { ic_mod_index = index })\n  = mkInteractiveModule index\n\n-- | This function returns the list of visible TyThings (useful for\n-- e.g. showBindings)\nicInScopeTTs :: InteractiveContext -> [TyThing]\nicInScopeTTs = ic_tythings\n\n-- | Get the PrintUnqualified function based on the flags and this InteractiveContext\nicPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified\nicPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =\n    mkPrintUnqualified dflags grenv\n\n-- | extendInteractiveContext is called with new TyThings recently defined to update the\n-- InteractiveContext to include them.  Ids are easily removed when shadowed,\n-- but Classes and TyCons are not.  Some work could be done to determine\n-- whether they are entirely shadowed, but as you could still have references\n-- to them (e.g. instances for classes or values of the type for TyCons), it's\n-- not clear whether removing them is even the appropriate behavior.\nextendInteractiveContext :: InteractiveContext\n                         -> [TyThing]\n                         -> [ClsInst] -> [FamInst]\n                         -> Maybe [Type]\n                         -> FixityEnv\n                         -> InteractiveContext\nextendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env\n  = ictxt { ic_mod_index  = ic_mod_index ictxt + 1\n                            -- Always bump this; even instances should create\n                            -- a new mod_index (Trac #9426)\n          , ic_tythings   = new_tythings ++ old_tythings\n          , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings\n          , ic_instances  = ( new_cls_insts ++ old_cls_insts\n                            , new_fam_insts ++ fam_insts )\n                            -- we don't shadow old family instances (#7102),\n                            -- so don't need to remove them here\n          , ic_default    = defaults\n          , ic_fix_env    = fix_env  -- See Note [Fixity declarations in GHCi]\n          }\n  where\n    new_ids = [id | AnId id <- new_tythings]\n    old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)\n\n    -- Discard old instances that have been fully overridden\n    -- See Note [Override identical instances in GHCi]\n    (cls_insts, fam_insts) = ic_instances ictxt\n    old_cls_insts = filterOut (\\i -> any (identicalClsInstHead i) new_cls_insts) cls_insts\n\nextendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext\n-- Just a specialised version\nextendInteractiveContextWithIds ictxt new_ids\n  | null new_ids = ictxt\n  | otherwise    = ictxt { ic_mod_index  = ic_mod_index ictxt + 1\n                         , ic_tythings   = new_tythings ++ old_tythings\n                         , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings }\n  where\n    new_tythings = map AnId new_ids\n    old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)\n\nshadowed_by :: [Id] -> TyThing -> Bool\nshadowed_by ids = shadowed\n  where\n    shadowed id = getOccName id `elemOccSet` new_occs\n    new_occs = mkOccSet (map getOccName ids)\n\nsetInteractivePackage :: HscEnv -> HscEnv\n-- Set the 'thisPackage' DynFlag to 'interactive'\nsetInteractivePackage hsc_env\n   = hsc_env { hsc_dflags = (hsc_dflags hsc_env)\n                { thisInstalledUnitId = toInstalledUnitId interactiveUnitId } }\n\nsetInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext\nsetInteractivePrintName ic n = ic{ic_int_print = n}\n\n    -- ToDo: should not add Ids to the gbl env here\n\n-- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing\n-- later ones, and shadowing existing entries in the GlobalRdrEnv.\nicExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv\nicExtendGblRdrEnv env tythings\n  = foldr add env tythings  -- Foldr makes things in the front of\n                            -- the list shadow things at the back\n  where\n    -- One at a time, to ensure each shadows the previous ones\n    add thing env\n       | is_sub_bndr thing\n       = env\n       | otherwise\n       = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail)\n       where\n          env1  = shadowNames env (concatMap availNames avail)\n          avail = tyThingAvailInfo thing\n\n    -- Ugh! The new_tythings may include record selectors, since they\n    -- are not implicit-ids, and must appear in the TypeEnv.  But they\n    -- will also be brought into scope by the corresponding (ATyCon\n    -- tc).  And we want the latter, because that has the correct\n    -- parent (Trac #10520)\n    is_sub_bndr (AnId f) = case idDetails f of\n                             RecSelId {}  -> True\n                             ClassOpId {} -> True\n                             _            -> False\n    is_sub_bndr _ = False\n\nsubstInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext\nsubstInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst\n  | isEmptyTCvSubst subst = ictxt\n  | otherwise             = ictxt { ic_tythings = map subst_ty tts }\n  where\n    subst_ty (AnId id)\n      = AnId $ id `setIdType` substTyAddInScope subst (idType id)\n      -- Variables in the interactive context *can* mention free type variables\n      -- because of the runtime debugger. Otherwise you'd expect all\n      -- variables bound in the interactive context to be closed.\n    subst_ty tt\n      = tt\n\ninstance Outputable InteractiveImport where\n  ppr (IIModule m) = char '*' <> ppr m\n  ppr (IIDecl d)   = ppr d\n\n{-\n************************************************************************\n*                                                                      *\n        Building a PrintUnqualified\n*                                                                      *\n************************************************************************\n\nNote [Printing original names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDeciding how to print names is pretty tricky.  We are given a name\nP:M.T, where P is the package name, M is the defining module, and T is\nthe occurrence name, and we have to decide in which form to display\nthe name given a GlobalRdrEnv describing the current scope.\n\nIdeally we want to display the name in the form in which it is in\nscope.  However, the name might not be in scope at all, and that's\nwhere it gets tricky.  Here are the cases:\n\n 1. T uniquely maps to  P:M.T      --->  \"T\"      NameUnqual\n 2. There is an X for which X.T\n       uniquely maps to  P:M.T     --->  \"X.T\"    NameQual X\n 3. There is no binding for \"M.T\"  --->  \"M.T\"    NameNotInScope1\n 4. Otherwise                      --->  \"P:M.T\"  NameNotInScope2\n\n(3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at\nall. In these cases we still want to refer to the name as \"M.T\", *but*\n\"M.T\" might mean something else in the current scope (e.g. if there's\nan \"import X as M\"), so to avoid confusion we avoid using \"M.T\" if\nthere's already a binding for it.  Instead we write P:M.T.\n\nThere's one further subtlety: in case (3), what if there are two\nthings around, P1:M.T and P2:M.T?  Then we don't want to print both of\nthem as M.T!  However only one of the modules P1:M and P2:M can be\nexposed (say P2), so we use M.T for that, and P1:M.T for the other one.\nThis is handled by the qual_mod component of PrintUnqualified, inside\nthe (ppr mod) of case (3), in Name.pprModulePrefix\n\nNote [Printing unit ids]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the old days, original names were tied to PackageIds, which directly\ncorresponded to the entities that users wrote in Cabal files, and were perfectly\nsuitable for printing when we need to disambiguate packages.  However, with\nUnitId, the situation can be different: if the key is instantiated with\nsome holes, we should try to give the user some more useful information.\n-}\n\n-- | Creates some functions that work out the best ways to format\n-- names for the user according to a set of heuristics.\nmkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified\nmkPrintUnqualified dflags env = QueryQualify qual_name\n                                             (mkQualModule dflags)\n                                             (mkQualPackage dflags)\n  where\n  qual_name mod occ\n        | [gre] <- unqual_gres\n        , right_name gre\n        = NameUnqual   -- If there's a unique entity that's in scope\n                       -- unqualified with 'occ' AND that entity is\n                       -- the right one, then we can use the unqualified name\n\n        | [] <- unqual_gres\n        , any is_name forceUnqualNames\n        , not (isDerivedOccName occ)\n        = NameUnqual   -- Don't qualify names that come from modules\n                       -- that come with GHC, often appear in error messages,\n                       -- but aren't typically in scope. Doing this does not\n                       -- cause ambiguity, and it reduces the amount of\n                       -- qualification in error messages thus improving\n                       -- readability.\n                       --\n                       -- A motivating example is 'Constraint'. It's often not\n                       -- in scope, but printing GHC.Prim.Constraint seems\n                       -- overkill.\n\n        | [gre] <- qual_gres\n        = NameQual (greQualModName gre)\n\n        | null qual_gres\n        = if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)\n          then NameNotInScope1\n          else NameNotInScope2\n\n        | otherwise\n        = NameNotInScope1   -- Can happen if 'f' is bound twice in the module\n                            -- Eg  f = True; g = 0; f = False\n      where\n        is_name :: Name -> Bool\n        is_name name = ASSERT2( isExternalName name, ppr name )\n                       nameModule name == mod && nameOccName name == occ\n\n        forceUnqualNames :: [Name]\n        forceUnqualNames =\n          map tyConName [ constraintKindTyCon, heqTyCon, coercibleTyCon ]\n          ++ [ eqTyConName ]\n\n        right_name gre = nameModule_maybe (gre_name gre) == Just mod\n\n        unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env\n        qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)\n\n    -- we can mention a module P:M without the P: qualifier iff\n    -- \"import M\" would resolve unambiguously to P:M.  (if P is the\n    -- current package we can just assume it is unqualified).\n\n-- | Creates a function for formatting modules based on two heuristics:\n-- (1) if the module is the current module, don't qualify, and (2) if there\n-- is only one exposed package which exports this module, don't qualify.\nmkQualModule :: DynFlags -> QueryQualifyModule\nmkQualModule dflags mod\n     | moduleUnitId mod == thisPackage dflags = False\n\n     | [(_, pkgconfig)] <- lookup,\n       packageConfigId pkgconfig == moduleUnitId mod\n        -- this says: we are given a module P:M, is there just one exposed package\n        -- that exposes a module M, and is it package P?\n     = False\n\n     | otherwise = True\n     where lookup = lookupModuleInAllPackages dflags (moduleName mod)\n\n-- | Creates a function for formatting packages based on two heuristics:\n-- (1) don't qualify if the package in question is \"main\", and (2) only qualify\n-- with a unit id if the package ID would be ambiguous.\nmkQualPackage :: DynFlags -> QueryQualifyPackage\nmkQualPackage dflags pkg_key\n     | pkg_key == mainUnitId || pkg_key == interactiveUnitId\n        -- Skip the lookup if it's main, since it won't be in the package\n        -- database!\n     = False\n     | Just pkgid <- mb_pkgid\n     , searchPackageId dflags pkgid `lengthIs` 1\n        -- this says: we are given a package pkg-0.1@MMM, are there only one\n        -- exposed packages whose package ID is pkg-0.1?\n     = False\n     | otherwise\n     = True\n     where mb_pkgid = fmap sourcePackageId (lookupPackage dflags pkg_key)\n\n-- | A function which only qualifies package names if necessary; but\n-- qualifies all other identifiers.\npkgQual :: DynFlags -> PrintUnqualified\npkgQual dflags = alwaysQualify {\n        queryQualifyPackage = mkQualPackage dflags\n    }\n\n{-\n************************************************************************\n*                                                                      *\n                Implicit TyThings\n*                                                                      *\n************************************************************************\n\nNote [Implicit TyThings]\n~~~~~~~~~~~~~~~~~~~~~~~~\n  DEFINITION: An \"implicit\" TyThing is one that does not have its own\n  IfaceDecl in an interface file.  Instead, its binding in the type\n  environment is created as part of typechecking the IfaceDecl for\n  some other thing.\n\nExamples:\n  * All DataCons are implicit, because they are generated from the\n    IfaceDecl for the data/newtype.  Ditto class methods.\n\n  * Record selectors are *not* implicit, because they get their own\n    free-standing IfaceDecl.\n\n  * Associated data/type families are implicit because they are\n    included in the IfaceDecl of the parent class.  (NB: the\n    IfaceClass decl happens to use IfaceDecl recursively for the\n    associated types, but that's irrelevant here.)\n\n  * Dictionary function Ids are not implicit.\n\n  * Axioms for newtypes are implicit (same as above), but axioms\n    for data/type family instances are *not* implicit (like DFunIds).\n-}\n\n-- | Determine the 'TyThing's brought into scope by another 'TyThing'\n-- /other/ than itself. For example, Id's don't have any implicit TyThings\n-- as they just bring themselves into scope, but classes bring their\n-- dictionary datatype, type constructor and some selector functions into\n-- scope, just for a start!\n\n-- N.B. the set of TyThings returned here *must* match the set of\n-- names returned by LoadIface.ifaceDeclImplicitBndrs, in the sense that\n-- TyThing.getOccName should define a bijection between the two lists.\n-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])\n-- The order of the list does not matter.\nimplicitTyThings :: TyThing -> [TyThing]\nimplicitTyThings (AnId _)       = []\nimplicitTyThings (ACoAxiom _cc) = []\nimplicitTyThings (ATyCon tc)    = implicitTyConThings tc\nimplicitTyThings (AConLike cl)  = implicitConLikeThings cl\n\nimplicitConLikeThings :: ConLike -> [TyThing]\nimplicitConLikeThings (RealDataCon dc)\n  = dataConImplicitTyThings dc\n\nimplicitConLikeThings (PatSynCon {})\n  = []  -- Pattern synonyms have no implicit Ids; the wrapper and matcher\n        -- are not \"implicit\"; they are simply new top-level bindings,\n        -- and they have their own declaration in an interface file\n        -- Unless a record pat syn when there are implicit selectors\n        -- They are still not included here as `implicitConLikeThings` is\n        -- used by `tcTyClsDecls` whilst pattern synonyms are typed checked\n        -- by `tcTopValBinds`.\n\nimplicitClassThings :: Class -> [TyThing]\nimplicitClassThings cl\n  = -- Does not include default methods, because those Ids may have\n    --    their own pragmas, unfoldings etc, not derived from the Class object\n\n    -- associated types\n    --    No recursive call for the classATs, because they\n    --    are only the family decls; they have no implicit things\n    map ATyCon (classATs cl) ++\n\n    -- superclass and operation selectors\n    map AnId (classAllSelIds cl)\n\nimplicitTyConThings :: TyCon -> [TyThing]\nimplicitTyConThings tc\n  = class_stuff ++\n      -- fields (names of selectors)\n\n      -- (possibly) implicit newtype axioms\n      -- or type family axioms\n    implicitCoTyCon tc ++\n\n      -- for each data constructor in order,\n      --   the constructor, worker, and (possibly) wrapper\n    [ thing | dc    <- tyConDataCons tc\n            , thing <- AConLike (RealDataCon dc) : dataConImplicitTyThings dc ]\n      -- NB. record selectors are *not* implicit, they have fully-fledged\n      -- bindings that pass through the compilation pipeline as normal.\n  where\n    class_stuff = case tyConClass_maybe tc of\n        Nothing -> []\n        Just cl -> implicitClassThings cl\n\n-- For newtypes and closed type families (only) add the implicit coercion tycon\nimplicitCoTyCon :: TyCon -> [TyThing]\nimplicitCoTyCon tc\n  | Just co <- newTyConCo_maybe tc = [ACoAxiom $ toBranchedAxiom co]\n  | Just co <- isClosedSynFamilyTyConWithAxiom_maybe tc\n                                   = [ACoAxiom co]\n  | otherwise                      = []\n\n-- | Returns @True@ if there should be no interface-file declaration\n-- for this thing on its own: either it is built-in, or it is part\n-- of some other declaration, or it is generated implicitly by some\n-- other declaration.\nisImplicitTyThing :: TyThing -> Bool\nisImplicitTyThing (AConLike cl) = case cl of\n                                    RealDataCon {} -> True\n                                    PatSynCon {}   -> False\nisImplicitTyThing (AnId id)     = isImplicitId id\nisImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc\nisImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax\n\n-- | tyThingParent_maybe x returns (Just p)\n-- when pprTyThingInContext should print a declaration for p\n-- (albeit with some \"...\" in it) when asked to show x\n-- It returns the *immediate* parent.  So a datacon returns its tycon\n-- but the tycon could be the associated type of a class, so it in turn\n-- might have a parent.\ntyThingParent_maybe :: TyThing -> Maybe TyThing\ntyThingParent_maybe (AConLike cl) = case cl of\n    RealDataCon dc  -> Just (ATyCon (dataConTyCon dc))\n    PatSynCon{}     -> Nothing\ntyThingParent_maybe (ATyCon tc)   = case tyConAssoc_maybe tc of\n                                      Just tc -> Just (ATyCon tc)\n                                      Nothing -> Nothing\ntyThingParent_maybe (AnId id)     = case idDetails id of\n                                      RecSelId { sel_tycon = RecSelData tc } ->\n                                          Just (ATyCon tc)\n                                      ClassOpId cls               ->\n                                          Just (ATyCon (classTyCon cls))\n                                      _other                      -> Nothing\ntyThingParent_maybe _other = Nothing\n\ntyThingsTyCoVars :: [TyThing] -> TyCoVarSet\ntyThingsTyCoVars tts =\n    unionVarSets $ map ttToVarSet tts\n    where\n        ttToVarSet (AnId id)     = tyCoVarsOfType $ idType id\n        ttToVarSet (AConLike cl) = case cl of\n            RealDataCon dc  -> tyCoVarsOfType $ dataConRepType dc\n            PatSynCon{}     -> emptyVarSet\n        ttToVarSet (ATyCon tc)\n          = case tyConClass_maybe tc of\n              Just cls -> (mkVarSet . fst . classTvsFds) cls\n              Nothing  -> tyCoVarsOfType $ tyConKind tc\n        ttToVarSet (ACoAxiom _)  = emptyVarSet\n\n-- | The Names that a TyThing should bring into scope.  Used to build\n-- the GlobalRdrEnv for the InteractiveContext.\ntyThingAvailInfo :: TyThing -> [AvailInfo]\ntyThingAvailInfo (ATyCon t)\n   = case tyConClass_maybe t of\n        Just c  -> [AvailTC n (n : map getName (classMethods c)\n                                 ++ map getName (classATs c))\n                             [] ]\n             where n = getName c\n        Nothing -> [AvailTC n (n : map getName dcs) flds]\n             where n    = getName t\n                   dcs  = tyConDataCons t\n                   flds = tyConFieldLabels t\ntyThingAvailInfo (AConLike (PatSynCon p))\n  = map avail ((getName p) : map flSelector (patSynFieldLabels p))\ntyThingAvailInfo t\n   = [avail (getName t)]\n\n{-\n************************************************************************\n*                                                                      *\n                TypeEnv\n*                                                                      *\n************************************************************************\n-}\n\n-- | A map from 'Name's to 'TyThing's, constructed by typechecking\n-- local declarations or interface files\ntype TypeEnv = NameEnv TyThing\n\nemptyTypeEnv    :: TypeEnv\ntypeEnvElts     :: TypeEnv -> [TyThing]\ntypeEnvTyCons   :: TypeEnv -> [TyCon]\ntypeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]\ntypeEnvIds      :: TypeEnv -> [Id]\ntypeEnvPatSyns  :: TypeEnv -> [PatSyn]\ntypeEnvDataCons :: TypeEnv -> [DataCon]\ntypeEnvClasses  :: TypeEnv -> [Class]\nlookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing\n\nemptyTypeEnv        = emptyNameEnv\ntypeEnvElts     env = nameEnvElts env\ntypeEnvTyCons   env = [tc | ATyCon tc   <- typeEnvElts env]\ntypeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]\ntypeEnvIds      env = [id | AnId id     <- typeEnvElts env]\ntypeEnvPatSyns  env = [ps | AConLike (PatSynCon ps) <- typeEnvElts env]\ntypeEnvDataCons env = [dc | AConLike (RealDataCon dc) <- typeEnvElts env]\ntypeEnvClasses  env = [cl | tc <- typeEnvTyCons env,\n                            Just cl <- [tyConClass_maybe tc]]\n\nmkTypeEnv :: [TyThing] -> TypeEnv\nmkTypeEnv things = extendTypeEnvList emptyTypeEnv things\n\nmkTypeEnvWithImplicits :: [TyThing] -> TypeEnv\nmkTypeEnvWithImplicits things =\n  mkTypeEnv things\n    `plusNameEnv`\n  mkTypeEnv (concatMap implicitTyThings things)\n\ntypeEnvFromEntities :: [Id] -> [TyCon] -> [FamInst] -> TypeEnv\ntypeEnvFromEntities ids tcs famInsts =\n  mkTypeEnv (   map AnId ids\n             ++ map ATyCon all_tcs\n             ++ concatMap implicitTyConThings all_tcs\n             ++ map (ACoAxiom . toBranchedAxiom . famInstAxiom) famInsts\n            )\n where\n  all_tcs = tcs ++ famInstsRepTyCons famInsts\n\nlookupTypeEnv = lookupNameEnv\n\n-- Extend the type environment\nextendTypeEnv :: TypeEnv -> TyThing -> TypeEnv\nextendTypeEnv env thing = extendNameEnv env (getName thing) thing\n\nextendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv\nextendTypeEnvList env things = foldl' extendTypeEnv env things\n\nextendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv\nextendTypeEnvWithIds env ids\n  = extendNameEnvList env [(getName id, AnId id) | id <- ids]\n\nplusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv\nplusTypeEnv env1 env2 = plusNameEnv env1 env2\n\n-- | Find the 'TyThing' for the given 'Name' by using all the resources\n-- at our disposal: the compiled modules in the 'HomePackageTable' and the\n-- compiled modules in other packages that live in 'PackageTypeEnv'. Note\n-- that this does NOT look up the 'TyThing' in the module being compiled: you\n-- have to do that yourself, if desired\nlookupType :: DynFlags\n           -> HomePackageTable\n           -> PackageTypeEnv\n           -> Name\n           -> Maybe TyThing\n\nlookupType dflags hpt pte name\n  | isOneShot (ghcMode dflags)  -- in one-shot, we don't use the HPT\n  = lookupNameEnv pte name\n  | otherwise\n  = case lookupHptByModule hpt mod of\n       Just hm -> lookupNameEnv (md_types (hm_details hm)) name\n       Nothing -> lookupNameEnv pte name\n  where\n    mod = ASSERT2( isExternalName name, ppr name )\n          if isHoleName name\n            then mkModule (thisPackage dflags) (moduleName (nameModule name))\n            else nameModule name\n\n-- | As 'lookupType', but with a marginally easier-to-use interface\n-- if you have a 'HscEnv'\nlookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)\nlookupTypeHscEnv hsc_env name = do\n    eps <- readIORef (hsc_EPS hsc_env)\n    return $! lookupType dflags hpt (eps_PTE eps) name\n  where\n    dflags = hsc_dflags hsc_env\n    hpt = hsc_HPT hsc_env\n\n-- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise\ntyThingTyCon :: TyThing -> TyCon\ntyThingTyCon (ATyCon tc) = tc\ntyThingTyCon other       = pprPanic \"tyThingTyCon\" (ppr other)\n\n-- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise\ntyThingCoAxiom :: TyThing -> CoAxiom Branched\ntyThingCoAxiom (ACoAxiom ax) = ax\ntyThingCoAxiom other         = pprPanic \"tyThingCoAxiom\" (ppr other)\n\n-- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise\ntyThingDataCon :: TyThing -> DataCon\ntyThingDataCon (AConLike (RealDataCon dc)) = dc\ntyThingDataCon other                       = pprPanic \"tyThingDataCon\" (ppr other)\n\n-- | Get the 'ConLike' from a 'TyThing' if it is a data constructor thing.\n-- Panics otherwise\ntyThingConLike :: TyThing -> ConLike\ntyThingConLike (AConLike dc) = dc\ntyThingConLike other         = pprPanic \"tyThingConLike\" (ppr other)\n\n-- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise\ntyThingId :: TyThing -> Id\ntyThingId (AnId id)                   = id\ntyThingId (AConLike (RealDataCon dc)) = dataConWrapId dc\ntyThingId other                       = pprPanic \"tyThingId\" (ppr other)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{MonadThings and friends}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Class that abstracts out the common ability of the monads in GHC\n-- to lookup a 'TyThing' in the monadic environment by 'Name'. Provides\n-- a number of related convenience functions for accessing particular\n-- kinds of 'TyThing'\nclass Monad m => MonadThings m where\n        lookupThing :: Name -> m TyThing\n\n        lookupId :: Name -> m Id\n        lookupId = liftM tyThingId . lookupThing\n\n        lookupDataCon :: Name -> m DataCon\n        lookupDataCon = liftM tyThingDataCon . lookupThing\n\n        lookupTyCon :: Name -> m TyCon\n        lookupTyCon = liftM tyThingTyCon . lookupThing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Auxiliary types}\n*                                                                      *\n************************************************************************\n\nThese types are defined here because they are mentioned in ModDetails,\nbut they are mostly elaborated elsewhere\n-}\n\n------------------ Warnings -------------------------\n-- | Warning information for a module\ndata Warnings\n  = NoWarnings                          -- ^ Nothing deprecated\n  | WarnAll WarningTxt                  -- ^ Whole module deprecated\n  | WarnSome [(OccName,WarningTxt)]     -- ^ Some specific things deprecated\n\n     -- Only an OccName is needed because\n     --    (1) a deprecation always applies to a binding\n     --        defined in the module in which the deprecation appears.\n     --    (2) deprecations are only reported outside the defining module.\n     --        this is important because, otherwise, if we saw something like\n     --\n     --        {-# DEPRECATED f \"\" #-}\n     --        f = ...\n     --        h = f\n     --        g = let f = undefined in f\n     --\n     --        we'd need more information than an OccName to know to say something\n     --        about the use of f in h but not the use of the locally bound f in g\n     --\n     --        however, because we only report about deprecations from the outside,\n     --        and a module can only export one value called f,\n     --        an OccName suffices.\n     --\n     --        this is in contrast with fixity declarations, where we need to map\n     --        a Name to its fixity declaration.\n  deriving( Eq )\n\ninstance Binary Warnings where\n    put_ bh NoWarnings     = putByte bh 0\n    put_ bh (WarnAll t) = do\n            putByte bh 1\n            put_ bh t\n    put_ bh (WarnSome ts) = do\n            putByte bh 2\n            put_ bh ts\n\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> return NoWarnings\n              1 -> do aa <- get bh\n                      return (WarnAll aa)\n              _ -> do aa <- get bh\n                      return (WarnSome aa)\n\n-- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface'\nmkIfaceWarnCache :: Warnings -> OccName -> Maybe WarningTxt\nmkIfaceWarnCache NoWarnings  = \\_ -> Nothing\nmkIfaceWarnCache (WarnAll t) = \\_ -> Just t\nmkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs)\n\nemptyIfaceWarnCache :: OccName -> Maybe WarningTxt\nemptyIfaceWarnCache _ = Nothing\n\nplusWarns :: Warnings -> Warnings -> Warnings\nplusWarns d NoWarnings = d\nplusWarns NoWarnings d = d\nplusWarns _ (WarnAll t) = WarnAll t\nplusWarns (WarnAll t) _ = WarnAll t\nplusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)\n\n-- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'\nmkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Maybe Fixity\nmkIfaceFixCache pairs\n  = \\n -> lookupOccEnv env n\n  where\n   env = mkOccEnv pairs\n\nemptyIfaceFixCache :: OccName -> Maybe Fixity\nemptyIfaceFixCache _ = Nothing\n\n-- | Fixity environment mapping names to their fixities\ntype FixityEnv = NameEnv FixItem\n\n-- | Fixity information for an 'Name'. We keep the OccName in the range\n-- so that we can generate an interface from it\ndata FixItem = FixItem OccName Fixity\n\ninstance Outputable FixItem where\n  ppr (FixItem occ fix) = ppr fix <+> ppr occ\n\nemptyFixityEnv :: FixityEnv\nemptyFixityEnv = emptyNameEnv\n\nlookupFixity :: FixityEnv -> Name -> Fixity\nlookupFixity env n = case lookupNameEnv env n of\n                        Just (FixItem _ fix) -> fix\n                        Nothing         -> defaultFixity\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{WhatsImported}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Records whether a module has orphans. An \\\"orphan\\\" is one of:\n--\n-- * An instance declaration in a module other than the definition\n--   module for one of the type constructors or classes in the instance head\n--\n-- * A transformation rule in a module other than the one defining\n--   the function in the head of the rule\n--\ntype WhetherHasOrphans   = Bool\n\n-- | Does this module define family instances?\ntype WhetherHasFamInst = Bool\n\n-- | Did this module originate from a *-boot file?\ntype IsBootInterface = Bool\n\n-- | Dependency information about ALL modules and packages below this one\n-- in the import hierarchy.\n--\n-- Invariant: the dependencies of a module @M@ never includes @M@.\n--\n-- Invariant: none of the lists contain duplicates.\ndata Dependencies\n  = Deps { dep_mods   :: [(ModuleName, IsBootInterface)]\n                        -- ^ All home-package modules transitively below this one\n                        -- I.e. modules that this one imports, or that are in the\n                        --      dep_mods of those directly-imported modules\n\n         , dep_pkgs   :: [(InstalledUnitId, Bool)]\n                        -- ^ All packages transitively below this module\n                        -- I.e. packages to which this module's direct imports belong,\n                        --      or that are in the dep_pkgs of those modules\n                        -- The bool indicates if the package is required to be\n                        -- trusted when the module is imported as a safe import\n                        -- (Safe Haskell). See Note [RnNames . Tracking Trust Transitively]\n\n         , dep_orphs  :: [Module]\n                        -- ^ Transitive closure of orphan modules (whether\n                        -- home or external pkg).\n                        --\n                        -- (Possible optimization: don't include family\n                        -- instance orphans as they are anyway included in\n                        -- 'dep_finsts'.  But then be careful about code\n                        -- which relies on dep_orphs having the complete list!)\n                        -- This does NOT include us, unlike 'imp_orphs'.\n\n         , dep_finsts :: [Module]\n                        -- ^ Transitive closure of depended upon modules which\n                        -- contain family instances (whether home or external).\n                        -- This is used by 'checkFamInstConsistency'.  This\n                        -- does NOT include us, unlike 'imp_finsts'. See Note\n                        -- [The type family instance consistency story].\n\n         , dep_plgins :: [ModuleName]\n                        -- ^ All the plugins used while compiling this module.\n         }\n  deriving( Eq )\n        -- Equality used only for old/new comparison in MkIface.addFingerprints\n        -- See 'TcRnTypes.ImportAvails' for details on dependencies.\n\ninstance Binary Dependencies where\n    put_ bh deps = do put_ bh (dep_mods deps)\n                      put_ bh (dep_pkgs deps)\n                      put_ bh (dep_orphs deps)\n                      put_ bh (dep_finsts deps)\n                      put_ bh (dep_plgins deps)\n\n    get bh = do ms <- get bh\n                ps <- get bh\n                os <- get bh\n                fis <- get bh\n                pl <- get bh\n                return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,\n                               dep_finsts = fis, dep_plgins = pl })\n\nnoDependencies :: Dependencies\nnoDependencies = Deps [] [] [] [] []\n\n-- | Records modules for which changes may force recompilation of this module\n-- See wiki: http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance\n--\n-- This differs from Dependencies.  A module X may be in the dep_mods of this\n-- module (via an import chain) but if we don't use anything from X it won't\n-- appear in our Usage\ndata Usage\n  -- | Module from another package\n  = UsagePackageModule {\n        usg_mod      :: Module,\n           -- ^ External package module depended on\n        usg_mod_hash :: Fingerprint,\n            -- ^ Cached module fingerprint\n        usg_safe :: IsSafeImport\n            -- ^ Was this module imported as a safe import\n    }\n  -- | Module from the current package\n  | UsageHomeModule {\n        usg_mod_name :: ModuleName,\n            -- ^ Name of the module\n        usg_mod_hash :: Fingerprint,\n            -- ^ Cached module fingerprint\n        usg_entities :: [(OccName,Fingerprint)],\n            -- ^ Entities we depend on, sorted by occurrence name and fingerprinted.\n            -- NB: usages are for parent names only, e.g. type constructors\n            -- but not the associated data constructors.\n        usg_exports  :: Maybe Fingerprint,\n            -- ^ Fingerprint for the export list of this module,\n            -- if we directly imported it (and hence we depend on its export list)\n        usg_safe :: IsSafeImport\n            -- ^ Was this module imported as a safe import\n    }                                           -- ^ Module from the current package\n  -- | A file upon which the module depends, e.g. a CPP #include, or using TH's\n  -- 'addDependentFile'\n  | UsageFile {\n        usg_file_path  :: FilePath,\n        -- ^ External file dependency. From a CPP #include or TH\n        -- addDependentFile. Should be absolute.\n        usg_file_hash  :: Fingerprint\n        -- ^ 'Fingerprint' of the file contents.\n\n        -- Note: We don't consider things like modification timestamps\n        -- here, because there's no reason to recompile if the actual\n        -- contents don't change.  This previously lead to odd\n        -- recompilation behaviors; see #8114\n  }\n  -- | A requirement which was merged into this one.\n  | UsageMergedRequirement {\n        usg_mod :: Module,\n        usg_mod_hash :: Fingerprint\n  }\n    deriving( Eq )\n        -- The export list field is (Just v) if we depend on the export list:\n        --      i.e. we imported the module directly, whether or not we\n        --           enumerated the things we imported, or just imported\n        --           everything\n        -- We need to recompile if M's exports change, because\n        -- if the import was    import M,       we might now have a name clash\n        --                                      in the importing module.\n        -- if the import was    import M(x)     M might no longer export x\n        -- The only way we don't depend on the export list is if we have\n        --                      import M()\n        -- And of course, for modules that aren't imported directly we don't\n        -- depend on their export lists\n\ninstance Binary Usage where\n    put_ bh usg@UsagePackageModule{} = do\n        putByte bh 0\n        put_ bh (usg_mod usg)\n        put_ bh (usg_mod_hash usg)\n        put_ bh (usg_safe     usg)\n\n    put_ bh usg@UsageHomeModule{} = do\n        putByte bh 1\n        put_ bh (usg_mod_name usg)\n        put_ bh (usg_mod_hash usg)\n        put_ bh (usg_exports  usg)\n        put_ bh (usg_entities usg)\n        put_ bh (usg_safe     usg)\n\n    put_ bh usg@UsageFile{} = do\n        putByte bh 2\n        put_ bh (usg_file_path usg)\n        put_ bh (usg_file_hash usg)\n\n    put_ bh usg@UsageMergedRequirement{} = do\n        putByte bh 3\n        put_ bh (usg_mod      usg)\n        put_ bh (usg_mod_hash usg)\n\n    get bh = do\n        h <- getByte bh\n        case h of\n          0 -> do\n            nm    <- get bh\n            mod   <- get bh\n            safe  <- get bh\n            return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }\n          1 -> do\n            nm    <- get bh\n            mod   <- get bh\n            exps  <- get bh\n            ents  <- get bh\n            safe  <- get bh\n            return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,\n                     usg_exports = exps, usg_entities = ents, usg_safe = safe }\n          2 -> do\n            fp   <- get bh\n            hash <- get bh\n            return UsageFile { usg_file_path = fp, usg_file_hash = hash }\n          3 -> do\n            mod <- get bh\n            hash <- get bh\n            return UsageMergedRequirement { usg_mod = mod, usg_mod_hash = hash }\n          i -> error (\"Binary.get(Usage): \" ++ show i)\n\n{-\n************************************************************************\n*                                                                      *\n                The External Package State\n*                                                                      *\n************************************************************************\n-}\n\ntype PackageTypeEnv          = TypeEnv\ntype PackageRuleBase         = RuleBase\ntype PackageInstEnv          = InstEnv\ntype PackageFamInstEnv       = FamInstEnv\ntype PackageAnnEnv           = AnnEnv\ntype PackageCompleteMatchMap = CompleteMatchMap\n\n-- | Information about other packages that we have slurped in by reading\n-- their interface files\ndata ExternalPackageState\n  = EPS {\n        eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),\n                -- ^ In OneShot mode (only), home-package modules\n                -- accumulate in the external package state, and are\n                -- sucked in lazily.  For these home-pkg modules\n                -- (only) we need to record which are boot modules.\n                -- We set this field after loading all the\n                -- explicitly-imported interfaces, but before doing\n                -- anything else\n                --\n                -- The 'ModuleName' part is not necessary, but it's useful for\n                -- debug prints, and it's convenient because this field comes\n                -- direct from 'TcRnTypes.imp_dep_mods'\n\n        eps_PIT :: !PackageIfaceTable,\n                -- ^ The 'ModIface's for modules in external packages\n                -- whose interfaces we have opened.\n                -- The declarations in these interface files are held in the\n                -- 'eps_decls', 'eps_inst_env', 'eps_fam_inst_env' and 'eps_rules'\n                -- fields of this record, not in the 'mi_decls' fields of the\n                -- interface we have sucked in.\n                --\n                -- What /is/ in the PIT is:\n                --\n                -- * The Module\n                --\n                -- * Fingerprint info\n                --\n                -- * Its exports\n                --\n                -- * Fixities\n                --\n                -- * Deprecations and warnings\n\n        eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName),\n                -- ^ Cache for 'mi_free_holes'.  Ordinarily, we can rely on\n                -- the 'eps_PIT' for this information, EXCEPT that when\n                -- we do dependency analysis, we need to look at the\n                -- 'Dependencies' of our imports to determine what their\n                -- precise free holes are ('moduleFreeHolesPrecise').  We\n                -- don't want to repeatedly reread in the interface\n                -- for every import, so cache it here.  When the PIT\n                -- gets filled in we can drop these entries.\n\n        eps_PTE :: !PackageTypeEnv,\n                -- ^ Result of typechecking all the external package\n                -- interface files we have sucked in. The domain of\n                -- the mapping is external-package modules\n\n        eps_inst_env     :: !PackageInstEnv,   -- ^ The total 'InstEnv' accumulated\n                                               -- from all the external-package modules\n        eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated\n                                               -- from all the external-package modules\n        eps_rule_base    :: !PackageRuleBase,  -- ^ The total 'RuleEnv' accumulated\n                                               -- from all the external-package modules\n        eps_ann_env      :: !PackageAnnEnv,    -- ^ The total 'AnnEnv' accumulated\n                                               -- from all the external-package modules\n        eps_complete_matches :: !PackageCompleteMatchMap,\n                                  -- ^ The total 'CompleteMatchMap' accumulated\n                                  -- from all the external-package modules\n\n        eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external\n                                                         -- packages, keyed off the module that declared them\n\n        eps_stats :: !EpsStats                 -- ^ Stastics about what was loaded from external packages\n  }\n\n-- | Accumulated statistics about what we are putting into the 'ExternalPackageState'.\n-- \\\"In\\\" means stuff that is just /read/ from interface files,\n-- \\\"Out\\\" means actually sucked in and type-checked\ndata EpsStats = EpsStats { n_ifaces_in\n                         , n_decls_in, n_decls_out\n                         , n_rules_in, n_rules_out\n                         , n_insts_in, n_insts_out :: !Int }\n\naddEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats\n-- ^ Add stats for one newly-read interface\naddEpsInStats stats n_decls n_insts n_rules\n  = stats { n_ifaces_in = n_ifaces_in stats + 1\n          , n_decls_in  = n_decls_in stats + n_decls\n          , n_insts_in  = n_insts_in stats + n_insts\n          , n_rules_in  = n_rules_in stats + n_rules }\n\n{-\nNames in a NameCache are always stored as a Global, and have the SrcLoc\nof their binding locations.\n\nActually that's not quite right.  When we first encounter the original\nname, we might not be at its binding site (e.g. we are reading an\ninterface file); so we give it 'noSrcLoc' then.  Later, when we find\nits binding site, we fix it up.\n-}\n\nupdNameCache :: IORef NameCache\n             -> (NameCache -> (NameCache, c))  -- The updating function\n             -> IO c\nupdNameCache ncRef upd_fn\n  = atomicModifyIORef' ncRef upd_fn\n\nmkSOName :: Platform -> FilePath -> FilePath\nmkSOName platform root\n    = case platformOS platform of\n      OSMinGW32 ->           root  <.> soExt platform\n      _         -> (\"lib\" ++ root) <.> soExt platform\n\nmkHsSOName :: Platform -> FilePath -> FilePath\nmkHsSOName platform root = (\"lib\" ++ root) <.> soExt platform\n\nsoExt :: Platform -> FilePath\nsoExt platform\n    = case platformOS platform of\n      OSDarwin  -> \"dylib\"\n      OSMinGW32 -> \"dll\"\n      _         -> \"so\"\n\n{-\n************************************************************************\n*                                                                      *\n                The module graph and ModSummary type\n        A ModSummary is a node in the compilation manager's\n        dependency graph, and it's also passed to hscMain\n*                                                                      *\n************************************************************************\n-}\n\n-- | A ModuleGraph contains all the nodes from the home package (only).\n-- There will be a node for each source module, plus a node for each hi-boot\n-- module.\n--\n-- The graph is not necessarily stored in topologically-sorted order.  Use\n-- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this.\ndata ModuleGraph = ModuleGraph\n  { mg_mss :: [ModSummary]\n  , mg_non_boot :: ModuleEnv ModSummary\n    -- a map of all non-boot ModSummaries keyed by Modules\n  , mg_boot :: ModuleSet\n    -- a set of boot Modules\n  , mg_needs_th_or_qq :: !Bool\n    -- does any of the modules in mg_mss require TemplateHaskell or\n    -- QuasiQuotes?\n  }\n\n-- | Determines whether a set of modules requires Template Haskell or\n-- Quasi Quotes\n--\n-- Note that if the session's 'DynFlags' enabled Template Haskell when\n-- 'depanal' was called, then each module in the returned module graph will\n-- have Template Haskell enabled whether it is actually needed or not.\nneedsTemplateHaskellOrQQ :: ModuleGraph -> Bool\nneedsTemplateHaskellOrQQ mg = mg_needs_th_or_qq mg\n\n-- | Map a function 'f' over all the 'ModSummaries'.\n-- To preserve invariants 'f' can't change the isBoot status.\nmapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph\nmapMG f mg@ModuleGraph{..} = mg\n  { mg_mss = map f mg_mss\n  , mg_non_boot = mapModuleEnv f mg_non_boot\n  }\n\nmgBootModules :: ModuleGraph -> ModuleSet\nmgBootModules ModuleGraph{..} = mg_boot\n\nmgModSummaries :: ModuleGraph -> [ModSummary]\nmgModSummaries = mg_mss\n\nmgElemModule :: ModuleGraph -> Module -> Bool\nmgElemModule ModuleGraph{..} m = elemModuleEnv m mg_non_boot\n\n-- | Look up a ModSummary in the ModuleGraph\nmgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary\nmgLookupModule ModuleGraph{..} m = lookupModuleEnv mg_non_boot m\n\nemptyMG :: ModuleGraph\nemptyMG = ModuleGraph [] emptyModuleEnv emptyModuleSet False\n\nisTemplateHaskellOrQQNonBoot :: ModSummary -> Bool\nisTemplateHaskellOrQQNonBoot ms =\n  (xopt LangExt.TemplateHaskell (ms_hspp_opts ms)\n    || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) &&\n  not (isBootSummary ms)\n\n-- | Add a ModSummary to ModuleGraph. Assumes that the new ModSummary is\n-- not an element of the ModuleGraph.\nextendMG :: ModuleGraph -> ModSummary -> ModuleGraph\nextendMG ModuleGraph{..} ms = ModuleGraph\n  { mg_mss = ms:mg_mss\n  , mg_non_boot = if isBootSummary ms\n      then mg_non_boot\n      else extendModuleEnv mg_non_boot (ms_mod ms) ms\n  , mg_boot = if isBootSummary ms\n      then extendModuleSet mg_boot (ms_mod ms)\n      else mg_boot\n  , mg_needs_th_or_qq = mg_needs_th_or_qq || isTemplateHaskellOrQQNonBoot ms\n  }\n\nmkModuleGraph :: [ModSummary] -> ModuleGraph\nmkModuleGraph = foldr (flip extendMG) emptyMG\n\n-- | A single node in a 'ModuleGraph'. The nodes of the module graph\n-- are one of:\n--\n-- * A regular Haskell source module\n-- * A hi-boot source module\n--\ndata ModSummary\n   = ModSummary {\n        ms_mod          :: Module,\n          -- ^ Identity of the module\n        ms_hsc_src      :: HscSource,\n          -- ^ The module source either plain Haskell or hs-boot\n        ms_location     :: ModLocation,\n          -- ^ Location of the various files belonging to the module\n        ms_hs_date      :: UTCTime,\n          -- ^ Timestamp of source file\n        ms_obj_date     :: Maybe UTCTime,\n          -- ^ Timestamp of object, if we have one\n        ms_iface_date   :: Maybe UTCTime,\n          -- ^ Timestamp of hi file, if we *only* are typechecking (it is\n          -- 'Nothing' otherwise.\n          -- See Note [Recompilation checking in -fno-code mode] and #9243\n        ms_hie_date   :: Maybe UTCTime,\n          -- ^ Timestamp of hie file, if we have one\n        ms_srcimps      :: [(Maybe FastString, Located ModuleName)],\n          -- ^ Source imports of the module\n        ms_textual_imps :: [(Maybe FastString, Located ModuleName)],\n          -- ^ Non-source imports of the module from the module *text*\n        ms_parsed_mod   :: Maybe HsParsedModule,\n          -- ^ The parsed, nonrenamed source, if we have it.  This is also\n          -- used to support \"inline module syntax\" in Backpack files.\n        ms_hspp_file    :: FilePath,\n          -- ^ Filename of preprocessed source file\n        ms_hspp_opts    :: DynFlags,\n          -- ^ Cached flags from @OPTIONS@, @INCLUDE@ and @LANGUAGE@\n          -- pragmas in the modules source code\n        ms_hspp_buf     :: Maybe StringBuffer\n          -- ^ The actual preprocessed source, if we have it\n     }\n\nms_installed_mod :: ModSummary -> InstalledModule\nms_installed_mod = fst . splitModuleInsts . ms_mod\n\nms_mod_name :: ModSummary -> ModuleName\nms_mod_name = moduleName . ms_mod\n\nms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]\nms_imps ms =\n  ms_textual_imps ms ++\n  map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms))\n  where\n    mk_additional_import mod_nm = (Nothing, noLoc mod_nm)\n\n-- The ModLocation contains both the original source filename and the\n-- filename of the cleaned-up source file after all preprocessing has been\n-- done.  The point is that the summariser will have to cpp/unlit/whatever\n-- all files anyway, and there's no point in doing this twice -- just\n-- park the result in a temp file, put the name of it in the location,\n-- and let @compile@ read from that file on the way back up.\n\n-- The ModLocation is stable over successive up-sweeps in GHCi, wheres\n-- the ms_hs_date and imports can, of course, change\n\nmsHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath\nmsHsFilePath  ms = expectJust \"msHsFilePath\" (ml_hs_file  (ms_location ms))\nmsHiFilePath  ms = ml_hi_file  (ms_location ms)\nmsObjFilePath ms = ml_obj_file (ms_location ms)\n\n-- | Did this 'ModSummary' originate from a hs-boot file?\nisBootSummary :: ModSummary -> Bool\nisBootSummary ms = ms_hsc_src ms == HsBootFile\n\ninstance Outputable ModSummary where\n   ppr ms\n      = sep [text \"ModSummary {\",\n             nest 3 (sep [text \"ms_hs_date = \" <> text (show (ms_hs_date ms)),\n                          text \"ms_mod =\" <+> ppr (ms_mod ms)\n                                <> text (hscSourceString (ms_hsc_src ms)) <> comma,\n                          text \"ms_textual_imps =\" <+> ppr (ms_textual_imps ms),\n                          text \"ms_srcimps =\" <+> ppr (ms_srcimps ms)]),\n             char '}'\n            ]\n\nshowModMsg :: DynFlags -> HscTarget -> Bool -> ModSummary -> String\nshowModMsg dflags target recomp mod_summary = showSDoc dflags $\n   if gopt Opt_HideSourcePaths dflags\n      then text mod_str\n      else hsep\n         [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ')\n         , char '('\n         , text (op $ msHsFilePath mod_summary) <> char ','\n         , case target of\n              HscInterpreted | recomp -> text \"interpreted\"\n              HscNothing              -> text \"nothing\"\n              _                       -> text (op $ msObjFilePath mod_summary)\n         , char ')'\n         ]\n  where\n    op      = normalise\n    mod     = moduleName (ms_mod mod_summary)\n    mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Recompilation}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Indicates whether a given module's source has been modified since it\n-- was last compiled.\ndata SourceModified\n  = SourceModified\n       -- ^ the source has been modified\n  | SourceUnmodified\n       -- ^ the source has not been modified.  Compilation may or may\n       -- not be necessary, depending on whether any dependencies have\n       -- changed since we last compiled.\n  | SourceUnmodifiedAndStable\n       -- ^ the source has not been modified, and furthermore all of\n       -- its (transitive) dependencies are up to date; it definitely\n       -- does not need to be recompiled.  This is important for two\n       -- reasons: (a) we can omit the version check in checkOldIface,\n       -- and (b) if the module used TH splices we don't need to force\n       -- recompilation.\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Hpc Support}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Information about a modules use of Haskell Program Coverage\ndata HpcInfo\n  = HpcInfo\n     { hpcInfoTickCount :: Int\n     , hpcInfoHash      :: Int\n     }\n  | NoHpcInfo\n     { hpcUsed          :: AnyHpcUsage  -- ^ Is hpc used anywhere on the module \\*tree\\*?\n     }\n\n-- | This is used to signal if one of my imports used HPC instrumentation\n-- even if there is no module-local HPC usage\ntype AnyHpcUsage = Bool\n\nemptyHpcInfo :: AnyHpcUsage -> HpcInfo\nemptyHpcInfo = NoHpcInfo\n\n-- | Find out if HPC is used by this module or any of the modules\n-- it depends upon\nisHpcUsed :: HpcInfo -> AnyHpcUsage\nisHpcUsed (HpcInfo {})                   = True\nisHpcUsed (NoHpcInfo { hpcUsed = used }) = used\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Safe Haskell Support}\n*                                                                      *\n************************************************************************\n\nThis stuff here is related to supporting the Safe Haskell extension,\nprimarily about storing under what trust type a module has been compiled.\n-}\n\n-- | Is an import a safe import?\ntype IsSafeImport = Bool\n\n-- | Safe Haskell information for 'ModIface'\n-- Simply a wrapper around SafeHaskellMode to sepperate iface and flags\nnewtype IfaceTrustInfo = TrustInfo SafeHaskellMode\n\ngetSafeMode :: IfaceTrustInfo -> SafeHaskellMode\ngetSafeMode (TrustInfo x) = x\n\nsetSafeMode :: SafeHaskellMode -> IfaceTrustInfo\nsetSafeMode = TrustInfo\n\nnoIfaceTrustInfo :: IfaceTrustInfo\nnoIfaceTrustInfo = setSafeMode Sf_None\n\ntrustInfoToNum :: IfaceTrustInfo -> Word8\ntrustInfoToNum it\n  = case getSafeMode it of\n            Sf_None         -> 0\n            Sf_Unsafe       -> 1\n            Sf_Trustworthy  -> 2\n            Sf_Safe         -> 3\n            Sf_Ignore       -> 0\n\nnumToTrustInfo :: Word8 -> IfaceTrustInfo\nnumToTrustInfo 0 = setSafeMode Sf_None\nnumToTrustInfo 1 = setSafeMode Sf_Unsafe\nnumToTrustInfo 2 = setSafeMode Sf_Trustworthy\nnumToTrustInfo 3 = setSafeMode Sf_Safe\nnumToTrustInfo 4 = setSafeMode Sf_Safe -- retained for backwards compat, used\n                                       -- to be Sf_SafeInfered but we no longer\n                                       -- differentiate.\nnumToTrustInfo n = error $ \"numToTrustInfo: bad input number! (\" ++ show n ++ \")\"\n\ninstance Outputable IfaceTrustInfo where\n    ppr (TrustInfo Sf_None)          = text \"none\"\n    ppr (TrustInfo Sf_Ignore)        = text \"none\"\n    ppr (TrustInfo Sf_Unsafe)        = text \"unsafe\"\n    ppr (TrustInfo Sf_Trustworthy)   = text \"trustworthy\"\n    ppr (TrustInfo Sf_Safe)          = text \"safe\"\n\ninstance Binary IfaceTrustInfo where\n    put_ bh iftrust = putByte bh $ trustInfoToNum iftrust\n    get bh = getByte bh >>= (return . numToTrustInfo)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Parser result}\n*                                                                      *\n************************************************************************\n-}\n\ndata HsParsedModule = HsParsedModule {\n    hpm_module    :: Located (HsModule GhcPs),\n    hpm_src_files :: [FilePath],\n       -- ^ extra source files (e.g. from #includes).  The lexer collects\n       -- these from '# <file> <line>' pragmas, which the C preprocessor\n       -- leaves behind.  These files and their timestamps are stored in\n       -- the .hi file, so that we can force recompilation if any of\n       -- them change (#3589)\n    hpm_annotations :: ApiAnns\n    -- See note [Api annotations] in ApiAnnotation.hs\n  }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Linkable stuff}\n*                                                                      *\n************************************************************************\n\nThis stuff is in here, rather than (say) in Linker.hs, because the Linker.hs\nstuff is the *dynamic* linker, and isn't present in a stage-1 compiler\n-}\n\n-- | Information we can use to dynamically link modules into the compiler\ndata Linkable = LM {\n  linkableTime     :: UTCTime,          -- ^ Time at which this linkable was built\n                                        -- (i.e. when the bytecodes were produced,\n                                        --       or the mod date on the files)\n  linkableModule   :: Module,           -- ^ The linkable module itself\n  linkableUnlinked :: [Unlinked]\n    -- ^ Those files and chunks of code we have yet to link.\n    --\n    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.\n    -- If this list is empty, the Linkable represents a fake linkable, which\n    -- is generated in HscNothing mode to avoid recompiling modules.\n    --\n    -- ToDo: Do items get removed from this list when they get linked?\n }\n\nisObjectLinkable :: Linkable -> Bool\nisObjectLinkable l = not (null unlinked) && all isObject unlinked\n  where unlinked = linkableUnlinked l\n        -- A linkable with no Unlinked's is treated as a BCO.  We can\n        -- generate a linkable with no Unlinked's as a result of\n        -- compiling a module in HscNothing mode, and this choice\n        -- happens to work well with checkStability in module GHC.\n\nlinkableObjs :: Linkable -> [FilePath]\nlinkableObjs l = [ f | DotO f <- linkableUnlinked l ]\n\ninstance Outputable Linkable where\n   ppr (LM when_made mod unlinkeds)\n      = (text \"LinkableM\" <+> parens (text (show when_made)) <+> ppr mod)\n        $$ nest 3 (ppr unlinkeds)\n\n-------------------------------------------\n\n-- | Objects which have yet to be linked by the compiler\ndata Unlinked\n   = DotO FilePath      -- ^ An object file (.o)\n   | DotA FilePath      -- ^ Static archive file (.a)\n   | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)\n   | BCOs CompiledByteCode\n          [SptEntry]    -- ^ A byte-code object, lives only in memory. Also\n                        -- carries some static pointer table entries which\n                        -- should be loaded along with the BCOs.\n                        -- See Note [Grant plan for static forms] in\n                        -- StaticPtrTable.\n\ninstance Outputable Unlinked where\n   ppr (DotO path)   = text \"DotO\" <+> text path\n   ppr (DotA path)   = text \"DotA\" <+> text path\n   ppr (DotDLL path) = text \"DotDLL\" <+> text path\n   ppr (BCOs bcos spt) = text \"BCOs\" <+> ppr bcos <+> ppr spt\n\n-- | Is this an actual file on disk we can link in somehow?\nisObject :: Unlinked -> Bool\nisObject (DotO _)   = True\nisObject (DotA _)   = True\nisObject (DotDLL _) = True\nisObject _          = False\n\n-- | Is this a bytecode linkable with no file on disk?\nisInterpretable :: Unlinked -> Bool\nisInterpretable = not . isObject\n\n-- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object\nnameOfObject :: Unlinked -> FilePath\nnameOfObject (DotO fn)   = fn\nnameOfObject (DotA fn)   = fn\nnameOfObject (DotDLL fn) = fn\nnameOfObject other       = pprPanic \"nameOfObject\" (ppr other)\n\n-- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable\nbyteCodeOfObject :: Unlinked -> CompiledByteCode\nbyteCodeOfObject (BCOs bc _) = bc\nbyteCodeOfObject other       = pprPanic \"byteCodeOfObject\" (ppr other)\n\n\n-------------------------------------------\n\n-- | A list of conlikes which represents a complete pattern match.\n-- These arise from @COMPLETE@ signatures.\n\n-- See Note [Implementation of COMPLETE signatures]\ndata CompleteMatch = CompleteMatch {\n                            completeMatchConLikes :: [Name]\n                            -- ^ The ConLikes that form a covering family\n                            -- (e.g. Nothing, Just)\n                          , completeMatchTyCon :: Name\n                            -- ^ The TyCon that they cover (e.g. Maybe)\n                          }\n\ninstance Outputable CompleteMatch where\n  ppr (CompleteMatch cl ty) = text \"CompleteMatch:\" <+> ppr cl\n                                                    <+> dcolon <+> ppr ty\n\n-- | A map keyed by the 'completeMatchTyCon'.\n\n-- See Note [Implementation of COMPLETE signatures]\ntype CompleteMatchMap = UniqFM [CompleteMatch]\n\nmkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap\nmkCompleteMatchMap = extendCompleteMatchMap emptyUFM\n\nextendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch]\n                       -> CompleteMatchMap\nextendCompleteMatchMap = foldl' insertMatch\n  where\n    insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap\n    insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c]\n\n{-\nNote [Implementation of COMPLETE signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA COMPLETE signature represents a set of conlikes (i.e., constructors or\npattern synonyms) such that if they are all pattern-matched against in a\nfunction, it gives rise to a total function. An example is:\n\n  newtype Boolean = Boolean Int\n  pattern F, T :: Boolean\n  pattern F = Boolean 0\n  pattern T = Boolean 1\n  {-# COMPLETE F, T #-}\n\n  -- This is a total function\n  booleanToInt :: Boolean -> Int\n  booleanToInt F = 0\n  booleanToInt T = 1\n\nCOMPLETE sets are represented internally in GHC with the CompleteMatch data\ntype. For example, {-# COMPLETE F, T #-} would be represented as:\n\n  CompleteMatch { complateMatchConLikes = [F, T]\n                , completeMatchTyCon    = Boolean }\n\nNote that GHC was able to infer the completeMatchTyCon (Boolean), but for the\ncases in which it's ambiguous, you can also explicitly specify it in the source\nlanguage by writing this:\n\n  {-# COMPLETE F, T :: Boolean #-}\n\nFor efficiency purposes, GHC collects all of the CompleteMatches that it knows\nabout into a CompleteMatchMap, which is a map that is keyed by the\ncompleteMatchTyCon. In other words, you could have a multiple COMPLETE sets\nfor the same TyCon:\n\n  {-# COMPLETE F, T1 :: Boolean #-}\n  {-# COMPLETE F, T2 :: Boolean #-}\n\nAnd looking up the values in the CompleteMatchMap associated with Boolean\nwould give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean].\ndsGetCompleteMatches in DsMeta accomplishes this lookup.\n\nAlso see Note [Typechecking Complete Matches] in TcBinds for a more detailed\nexplanation for how GHC ensures that all the conlikes in a COMPLETE set are\nconsistent.\n-}\n", "num_lines": 3139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, UnboxedTuples,\n    RecordWildCards, BangPatterns #-}\n\n-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 2005-2007\n--\n-- Running statements interactively\n--\n-- -----------------------------------------------------------------------------\n\nmodule InteractiveEval (\n        Resume(..), History(..),\n        execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec,\n        runDecls, runDeclsWithLocation, runParsedDecls,\n        isStmt, hasImport, isImport, isDecl,\n        parseImportDecl, SingleStep(..),\n        abandon, abandonAll,\n        getResumeContext,\n        getHistorySpan,\n        getModBreaks,\n        getHistoryModule,\n        back, forward,\n        setContext, getContext,\n        availsToGlobalRdrEnv,\n        getNamesInScope,\n        getRdrNamesInScope,\n        moduleIsInterpreted,\n        getInfo,\n        exprType,\n        typeKind,\n        parseName,\n        getDocs,\n        GetDocsFailure(..),\n        showModule,\n        moduleIsBootOrNotObjectLinkable,\n        parseExpr, compileParsedExpr,\n        compileExpr, dynCompileExpr,\n        compileExprRemote, compileParsedExprRemote,\n        Term(..), obtainTermFromId, obtainTermFromVal, reconstructType\n        ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport InteractiveEvalTypes\n\nimport GHCi\nimport GHCi.Message\nimport GHCi.RemoteTypes\nimport GhcMonad\nimport HscMain\nimport HsSyn\nimport HscTypes\nimport InstEnv\nimport IfaceEnv   ( newInteractiveBinder )\nimport FamInstEnv ( FamInst )\nimport CoreFVs    ( orphNamesOfFamInst )\nimport TyCon\nimport Type             hiding( typeKind )\nimport RepType\nimport TcType\nimport Var\nimport Id\nimport Name             hiding ( varName )\nimport NameSet\nimport Avail\nimport RdrName\nimport VarEnv\nimport ByteCodeTypes\nimport Linker\nimport DynFlags\nimport Unique\nimport UniqSupply\nimport MonadUtils\nimport Module\nimport PrelNames  ( toDynName, pretendNameIsInScope )\nimport TysWiredIn ( isCTupleTyConName )\nimport Panic\nimport Maybes\nimport ErrUtils\nimport SrcLoc\nimport RtClosureInspect\nimport Outputable\nimport FastString\nimport Bag\nimport Util\nimport qualified Lexer (P (..), ParseResult(..), unP, mkPState)\nimport qualified Parser (parseStmt, parseModule, parseDeclaration, parseImport)\n\nimport System.Directory\nimport Data.Dynamic\nimport Data.Either\nimport qualified Data.IntMap as IntMap\nimport Data.List (find,intercalate)\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport StringBuffer (stringToStringBuffer)\nimport Control.Monad\nimport GHC.Exts\nimport Data.Array\nimport Exception\n\n-- -----------------------------------------------------------------------------\n-- running a statement interactively\n\ngetResumeContext :: GhcMonad m => m [Resume]\ngetResumeContext = withSession (return . ic_resume . hsc_IC)\n\nmkHistory :: HscEnv -> ForeignHValue -> BreakInfo -> History\nmkHistory hsc_env hval bi = History hval bi (findEnclosingDecls hsc_env bi)\n\ngetHistoryModule :: History -> Module\ngetHistoryModule = breakInfo_module . historyBreakInfo\n\ngetHistorySpan :: HscEnv -> History -> SrcSpan\ngetHistorySpan hsc_env History{..} =\n  let BreakInfo{..} = historyBreakInfo in\n  case lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module) of\n    Just hmi -> modBreaks_locs (getModBreaks hmi) ! breakInfo_number\n    _ -> panic \"getHistorySpan\"\n\ngetModBreaks :: HomeModInfo -> ModBreaks\ngetModBreaks hmi\n  | Just linkable <- hm_linkable hmi,\n    [BCOs cbc _] <- linkableUnlinked linkable\n  = fromMaybe emptyModBreaks (bc_breaks cbc)\n  | otherwise\n  = emptyModBreaks -- probably object code\n\n{- | Finds the enclosing top level function name -}\n-- ToDo: a better way to do this would be to keep hold of the decl_path computed\n-- by the coverage pass, which gives the list of lexically-enclosing bindings\n-- for each tick.\nfindEnclosingDecls :: HscEnv -> BreakInfo -> [String]\nfindEnclosingDecls hsc_env (BreakInfo modl ix) =\n   let hmi = expectJust \"findEnclosingDecls\" $\n             lookupHpt (hsc_HPT hsc_env) (moduleName modl)\n       mb = getModBreaks hmi\n   in modBreaks_decls mb ! ix\n\n-- | Update fixity environment in the current interactive context.\nupdateFixityEnv :: GhcMonad m => FixityEnv -> m ()\nupdateFixityEnv fix_env = do\n  hsc_env <- getSession\n  let ic = hsc_IC hsc_env\n  setSession $ hsc_env { hsc_IC = ic { ic_fix_env = fix_env } }\n\n-- -----------------------------------------------------------------------------\n-- execStmt\n\n-- | default ExecOptions\nexecOptions :: ExecOptions\nexecOptions = ExecOptions\n  { execSingleStep = RunToCompletion\n  , execSourceFile = \"<interactive>\"\n  , execLineNumber = 1\n  , execWrap = EvalThis -- just run the statement, don't wrap it in anything\n  }\n\n-- | Run a statement in the current interactive context.\nexecStmt\n  :: GhcMonad m\n  => String             -- ^ a statement (bind or expression)\n  -> ExecOptions\n  -> m ExecResult\nexecStmt input exec_opts@ExecOptions{..} = do\n    hsc_env <- getSession\n\n    mb_stmt <-\n      liftIO $\n      runInteractiveHsc hsc_env $\n      hscParseStmtWithLocation execSourceFile execLineNumber input\n\n    case mb_stmt of\n      -- empty statement / comment\n      Nothing -> return (ExecComplete (Right []) 0)\n      Just stmt -> execStmt' stmt input exec_opts\n\n-- | Like `execStmt`, but takes a parsed statement as argument. Useful when\n-- doing preprocessing on the AST before execution, e.g. in GHCi (see\n-- GHCi.UI.runStmt).\nexecStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult\nexecStmt' stmt stmt_text ExecOptions{..} = do\n    hsc_env <- getSession\n\n    -- Turn off -fwarn-unused-local-binds when running a statement, to hide\n    -- warnings about the implicit bindings we introduce.\n    -- (This is basically `mkInteractiveHscEnv hsc_env`, except we unset\n    -- -wwarn-unused-local-binds)\n    let ic       = hsc_IC hsc_env -- use the interactive dflags\n        idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds\n        hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } })\n\n    r <- liftIO $ hscParsedStmt hsc_env' stmt\n\n    case r of\n      Nothing ->\n        -- empty statement / comment\n        return (ExecComplete (Right []) 0)\n      Just (ids, hval, fix_env) -> do\n        updateFixityEnv fix_env\n\n        status <-\n          withVirtualCWD $\n            liftIO $\n              evalStmt hsc_env' (isStep execSingleStep) (execWrap hval)\n\n        let ic = hsc_IC hsc_env\n            bindings = (ic_tythings ic, ic_rn_gbl_env ic)\n\n            size = ghciHistSize idflags'\n\n        handleRunStatus execSingleStep stmt_text bindings ids\n                        status (emptyHistory size)\n\nrunDecls :: GhcMonad m => String -> m [Name]\nrunDecls = runDeclsWithLocation \"<interactive>\" 1\n\n-- | Run some declarations and return any user-visible names that were brought\n-- into scope.\nrunDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name]\nrunDeclsWithLocation source line_num input = do\n    hsc_env <- getSession\n    decls <- liftIO (hscParseDeclsWithLocation hsc_env source line_num input)\n    runParsedDecls decls\n\n-- | Like `runDeclsWithLocation`, but takes parsed declarations as argument.\n-- Useful when doing preprocessing on the AST before execution, e.g. in GHCi\n-- (see GHCi.UI.runStmt).\nrunParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [Name]\nrunParsedDecls decls = do\n    hsc_env <- getSession\n    (tyThings, ic) <- liftIO (hscParsedDecls hsc_env decls)\n\n    setSession $ hsc_env { hsc_IC = ic }\n    hsc_env <- getSession\n    hsc_env' <- liftIO $ rttiEnvironment hsc_env\n    setSession hsc_env'\n    return $ filter (not . isDerivedOccName . nameOccName)\n             -- For this filter, see Note [What to show to users]\n           $ map getName tyThings\n\n{- Note [What to show to users]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't want to display internally-generated bindings to users.\nThings like the coercion axiom for newtypes. These bindings all get\nOccNames that users can't write, to avoid the possibility of name\nclashes (in linker symbols).  That gives a convenient way to suppress\nthem. The relevant predicate is OccName.isDerivedOccName.\nSee Trac #11051 for more background and examples.\n-}\n\nwithVirtualCWD :: GhcMonad m => m a -> m a\nwithVirtualCWD m = do\n  hsc_env <- getSession\n\n    -- a virtual CWD is only necessary when we're running interpreted code in\n    -- the same process as the compiler.\n  if gopt Opt_ExternalInterpreter (hsc_dflags hsc_env) then m else do\n\n  let ic = hsc_IC hsc_env\n  let set_cwd = do\n        dir <- liftIO $ getCurrentDirectory\n        case ic_cwd ic of\n           Just dir -> liftIO $ setCurrentDirectory dir\n           Nothing  -> return ()\n        return dir\n\n      reset_cwd orig_dir = do\n        virt_dir <- liftIO $ getCurrentDirectory\n        hsc_env <- getSession\n        let old_IC = hsc_IC hsc_env\n        setSession hsc_env{  hsc_IC = old_IC{ ic_cwd = Just virt_dir } }\n        liftIO $ setCurrentDirectory orig_dir\n\n  gbracket set_cwd reset_cwd $ \\_ -> m\n\nparseImportDecl :: GhcMonad m => String -> m (ImportDecl GhcPs)\nparseImportDecl expr = withSession $ \\hsc_env -> liftIO $ hscImport hsc_env expr\n\nemptyHistory :: Int -> BoundedList History\nemptyHistory size = nilBL size\n\nhandleRunStatus :: GhcMonad m\n                => SingleStep -> String-> ([TyThing],GlobalRdrEnv) -> [Id]\n                -> EvalStatus_ [ForeignHValue] [HValueRef]\n                -> BoundedList History\n                -> m ExecResult\n\nhandleRunStatus step expr bindings final_ids status history\n  | RunAndLogSteps <- step = tracing\n  | otherwise              = not_tracing\n where\n  tracing\n    | EvalBreak is_exception apStack_ref ix mod_uniq resume_ctxt _ccs <- status\n    , not is_exception\n    = do\n       hsc_env <- getSession\n       let hmi = expectJust \"handleRunStatus\" $\n                   lookupHptDirectly (hsc_HPT hsc_env)\n                                     (mkUniqueGrimily mod_uniq)\n           modl = mi_module (hm_iface hmi)\n           breaks = getModBreaks hmi\n\n       b <- liftIO $\n              breakpointStatus hsc_env (modBreaks_flags breaks) ix\n       if b\n         then not_tracing\n           -- This breakpoint is explicitly enabled; we want to stop\n           -- instead of just logging it.\n         else do\n           apStack_fhv <- liftIO $ mkFinalizedHValue hsc_env apStack_ref\n           let bi = BreakInfo modl ix\n               !history' = mkHistory hsc_env apStack_fhv bi `consBL` history\n                 -- history is strict, otherwise our BoundedList is pointless.\n           fhv <- liftIO $ mkFinalizedHValue hsc_env resume_ctxt\n           status <- liftIO $ GHCi.resumeStmt hsc_env True fhv\n           handleRunStatus RunAndLogSteps expr bindings final_ids\n                           status history'\n    | otherwise\n    = not_tracing\n\n  not_tracing\n    -- Hit a breakpoint\n    | EvalBreak is_exception apStack_ref ix mod_uniq resume_ctxt ccs <- status\n    = do\n         hsc_env <- getSession\n         resume_ctxt_fhv <- liftIO $ mkFinalizedHValue hsc_env resume_ctxt\n         apStack_fhv <- liftIO $ mkFinalizedHValue hsc_env apStack_ref\n         let hmi = expectJust \"handleRunStatus\" $\n                     lookupHptDirectly (hsc_HPT hsc_env)\n                                       (mkUniqueGrimily mod_uniq)\n             modl = mi_module (hm_iface hmi)\n             bp | is_exception = Nothing\n                | otherwise = Just (BreakInfo modl ix)\n         (hsc_env1, names, span, decl) <- liftIO $\n           bindLocalsAtBreakpoint hsc_env apStack_fhv bp\n         let\n           resume = Resume\n             { resumeStmt = expr, resumeContext = resume_ctxt_fhv\n             , resumeBindings = bindings, resumeFinalIds = final_ids\n             , resumeApStack = apStack_fhv\n             , resumeBreakInfo = bp\n             , resumeSpan = span, resumeHistory = toListBL history\n             , resumeDecl = decl\n             , resumeCCS = ccs\n             , resumeHistoryIx = 0 }\n           hsc_env2 = pushResume hsc_env1 resume\n\n         setSession hsc_env2\n         return (ExecBreak names bp)\n\n    -- Completed successfully\n    | EvalComplete allocs (EvalSuccess hvals) <- status\n    = do hsc_env <- getSession\n         let final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids\n             final_names = map getName final_ids\n         liftIO $ Linker.extendLinkEnv (zip final_names hvals)\n         hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}\n         setSession hsc_env'\n         return (ExecComplete (Right final_names) allocs)\n\n    -- Completed with an exception\n    | EvalComplete alloc (EvalException e) <- status\n    = return (ExecComplete (Left (fromSerializableException e)) alloc)\n\n    | otherwise\n    = panic \"not_tracing\" -- actually exhaustive, but GHC can't tell\n\n\nresumeExec :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m ExecResult\nresumeExec canLogSpan step\n = do\n   hsc_env <- getSession\n   let ic = hsc_IC hsc_env\n       resume = ic_resume ic\n\n   case resume of\n     [] -> liftIO $\n           throwGhcExceptionIO (ProgramError \"not stopped at a breakpoint\")\n     (r:rs) -> do\n        -- unbind the temporary locals by restoring the TypeEnv from\n        -- before the breakpoint, and drop this Resume from the\n        -- InteractiveContext.\n        let (resume_tmp_te,resume_rdr_env) = resumeBindings r\n            ic' = ic { ic_tythings = resume_tmp_te,\n                       ic_rn_gbl_env = resume_rdr_env,\n                       ic_resume   = rs }\n        setSession hsc_env{ hsc_IC = ic' }\n\n        -- remove any bindings created since the breakpoint from the\n        -- linker's environment\n        let old_names = map getName resume_tmp_te\n            new_names = [ n | thing <- ic_tythings ic\n                            , let n = getName thing\n                            , not (n `elem` old_names) ]\n        liftIO $ Linker.deleteFromLinkEnv new_names\n\n        case r of\n          Resume { resumeStmt = expr, resumeContext = fhv\n                 , resumeBindings = bindings, resumeFinalIds = final_ids\n                 , resumeApStack = apStack, resumeBreakInfo = mb_brkpt\n                 , resumeSpan = span\n                 , resumeHistory = hist } -> do\n               withVirtualCWD $ do\n                status <- liftIO $ GHCi.resumeStmt hsc_env (isStep step) fhv\n                let prevHistoryLst = fromListBL 50 hist\n                    hist' = case mb_brkpt of\n                       Nothing -> prevHistoryLst\n                       Just bi\n                         | not $canLogSpan span -> prevHistoryLst\n                         | otherwise -> mkHistory hsc_env apStack bi `consBL`\n                                                        fromListBL 50 hist\n                handleRunStatus step expr bindings final_ids status hist'\n\nback :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String)\nback n = moveHist (+n)\n\nforward :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String)\nforward n = moveHist (subtract n)\n\nmoveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan, String)\nmoveHist fn = do\n  hsc_env <- getSession\n  case ic_resume (hsc_IC hsc_env) of\n     [] -> liftIO $\n           throwGhcExceptionIO (ProgramError \"not stopped at a breakpoint\")\n     (r:rs) -> do\n        let ix = resumeHistoryIx r\n            history = resumeHistory r\n            new_ix = fn ix\n        --\n        when (history `lengthLessThan` new_ix) $ liftIO $\n           throwGhcExceptionIO (ProgramError \"no more logged breakpoints\")\n        when (new_ix < 0) $ liftIO $\n           throwGhcExceptionIO (ProgramError \"already at the beginning of the history\")\n\n        let\n          update_ic apStack mb_info = do\n            (hsc_env1, names, span, decl) <-\n              liftIO $ bindLocalsAtBreakpoint hsc_env apStack mb_info\n            let ic = hsc_IC hsc_env1\n                r' = r { resumeHistoryIx = new_ix }\n                ic' = ic { ic_resume = r':rs }\n\n            setSession hsc_env1{ hsc_IC = ic' }\n\n            return (names, new_ix, span, decl)\n\n        -- careful: we want apStack to be the AP_STACK itself, not a thunk\n        -- around it, hence the cases are carefully constructed below to\n        -- make this the case.  ToDo: this is v. fragile, do something better.\n        if new_ix == 0\n           then case r of\n                   Resume { resumeApStack = apStack,\n                            resumeBreakInfo = mb_brkpt } ->\n                          update_ic apStack mb_brkpt\n           else case history !! (new_ix - 1) of\n                   History{..} ->\n                     update_ic historyApStack (Just historyBreakInfo)\n\n\n-- -----------------------------------------------------------------------------\n-- After stopping at a breakpoint, add free variables to the environment\n\nresult_fs :: FastString\nresult_fs = fsLit \"_result\"\n\nbindLocalsAtBreakpoint\n        :: HscEnv\n        -> ForeignHValue\n        -> Maybe BreakInfo\n        -> IO (HscEnv, [Name], SrcSpan, String)\n\n-- Nothing case: we stopped when an exception was raised, not at a\n-- breakpoint.  We have no location information or local variables to\n-- bind, all we can do is bind a local variable to the exception\n-- value.\nbindLocalsAtBreakpoint hsc_env apStack Nothing = do\n   let exn_occ = mkVarOccFS (fsLit \"_exception\")\n       span    = mkGeneralSrcSpan (fsLit \"<unknown>\")\n   exn_name <- newInteractiveBinder hsc_env exn_occ span\n\n   let e_fs    = fsLit \"e\"\n       e_name  = mkInternalName (getUnique e_fs) (mkTyVarOccFS e_fs) span\n       e_tyvar = mkRuntimeUnkTyVar e_name liftedTypeKind\n       exn_id  = Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar)\n\n       ictxt0 = hsc_IC hsc_env\n       ictxt1 = extendInteractiveContextWithIds ictxt0 [exn_id]\n   --\n   Linker.extendLinkEnv [(exn_name, apStack)]\n   return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span, \"<exception thrown>\")\n\n-- Just case: we stopped at a breakpoint, we have information about the location\n-- of the breakpoint and the free variables of the expression.\nbindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do\n   let\n       hmi       = expectJust \"bindLocalsAtBreakpoint\" $\n                     lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module)\n       breaks    = getModBreaks hmi\n       info      = expectJust \"bindLocalsAtBreakpoint2\" $\n                     IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)\n       vars      = cgb_vars info\n       result_ty = cgb_resty info\n       occs      = modBreaks_vars breaks ! breakInfo_number\n       span      = modBreaks_locs breaks ! breakInfo_number\n       decl      = intercalate \".\" $ modBreaks_decls breaks ! breakInfo_number\n\n           -- Filter out any unboxed ids;\n           -- we can't bind these at the prompt\n       pointers = filter (\\(id,_) -> isPointer id) vars\n       isPointer id | [rep] <- typePrimRep (idType id)\n                    , isGcPtrRep rep                   = True\n                    | otherwise                        = False\n\n       (ids, offsets) = unzip pointers\n\n       free_tvs = tyCoVarsOfTypesList (result_ty:map idType ids)\n\n   -- It might be that getIdValFromApStack fails, because the AP_STACK\n   -- has been accidentally evaluated, or something else has gone wrong.\n   -- So that we don't fall over in a heap when this happens, just don't\n   -- bind any free variables instead, and we emit a warning.\n   mb_hValues <-\n      mapM (getBreakpointVar hsc_env apStack_fhv . fromIntegral) offsets\n   when (any isNothing mb_hValues) $\n      debugTraceMsg (hsc_dflags hsc_env) 1 $\n          text \"Warning: _result has been evaluated, some bindings have been lost\"\n\n   us <- mkSplitUniqSupply 'I'   -- Dodgy; will give the same uniques every time\n   let tv_subst     = newTyVars us free_tvs\n       filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ]\n       (_,tidy_tys) = tidyOpenTypes emptyTidyEnv $\n                      map (substTy tv_subst . idType) filtered_ids\n\n   new_ids     <- zipWith3M mkNewId occs tidy_tys filtered_ids\n   result_name <- newInteractiveBinder hsc_env (mkVarOccFS result_fs) span\n\n   let result_id = Id.mkVanillaGlobal result_name\n                     (substTy tv_subst result_ty)\n       result_ok = isPointer result_id\n\n       final_ids | result_ok = result_id : new_ids\n                 | otherwise = new_ids\n       ictxt0 = hsc_IC hsc_env\n       ictxt1 = extendInteractiveContextWithIds ictxt0 final_ids\n       names  = map idName new_ids\n\n   let fhvs = catMaybes mb_hValues\n   Linker.extendLinkEnv (zip names fhvs)\n   when result_ok $ Linker.extendLinkEnv [(result_name, apStack_fhv)]\n   hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }\n   return (hsc_env1, if result_ok then result_name:names else names, span, decl)\n  where\n        -- We need a fresh Unique for each Id we bind, because the linker\n        -- state is single-threaded and otherwise we'd spam old bindings\n        -- whenever we stop at a breakpoint.  The InteractveContext is properly\n        -- saved/restored, but not the linker state.  See #1743, test break026.\n   mkNewId :: OccName -> Type -> Id -> IO Id\n   mkNewId occ ty old_id\n     = do { name <- newInteractiveBinder hsc_env occ (getSrcSpan old_id)\n          ; return (Id.mkVanillaGlobalWithInfo name ty (idInfo old_id)) }\n\n   newTyVars :: UniqSupply -> [TcTyVar] -> TCvSubst\n     -- Similarly, clone the type variables mentioned in the types\n     -- we have here, *and* make them all RuntimeUnk tyvars\n   newTyVars us tvs\n     = mkTvSubstPrs [ (tv, mkTyVarTy (mkRuntimeUnkTyVar name (tyVarKind tv)))\n                    | (tv, uniq) <- tvs `zip` uniqsFromSupply us\n                    , let name = setNameUnique (tyVarName tv) uniq ]\n\nrttiEnvironment :: HscEnv -> IO HscEnv\nrttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do\n   let tmp_ids = [id | AnId id <- ic_tythings ic]\n       incompletelyTypedIds =\n           [id | id <- tmp_ids\n               , not $ noSkolems id\n               , (occNameFS.nameOccName.idName) id /= result_fs]\n   hsc_env' <- foldM improveTypes hsc_env (map idName incompletelyTypedIds)\n   return hsc_env'\n    where\n     noSkolems = noFreeVarsOfType . idType\n     improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do\n      let tmp_ids = [id | AnId id <- ic_tythings ic]\n          Just id = find (\\i -> idName i == name) tmp_ids\n      if noSkolems id\n         then return hsc_env\n         else do\n           mb_new_ty <- reconstructType hsc_env 10 id\n           let old_ty = idType id\n           case mb_new_ty of\n             Nothing -> return hsc_env\n             Just new_ty -> do\n              case improveRTTIType hsc_env old_ty new_ty of\n               Nothing -> return $\n                        WARN(True, text (\":print failed to calculate the \"\n                                           ++ \"improvement for a type\")) hsc_env\n               Just subst -> do\n                 let dflags = hsc_dflags hsc_env\n                 dumpIfSet_dyn dflags Opt_D_dump_rtti \"RTTI\"\n                   (fsep [text \"RTTI Improvement for\", ppr id, equals,\n                          ppr subst])\n\n                 let ic' = substInteractiveContext ic subst\n                 return hsc_env{hsc_IC=ic'}\n\npushResume :: HscEnv -> Resume -> HscEnv\npushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }\n  where\n        ictxt0 = hsc_IC hsc_env\n        ictxt1 = ictxt0 { ic_resume = resume : ic_resume ictxt0 }\n\n-- -----------------------------------------------------------------------------\n-- Abandoning a resume context\n\nabandon :: GhcMonad m => m Bool\nabandon = do\n   hsc_env <- getSession\n   let ic = hsc_IC hsc_env\n       resume = ic_resume ic\n   case resume of\n      []    -> return False\n      r:rs  -> do\n         setSession hsc_env{ hsc_IC = ic { ic_resume = rs } }\n         liftIO $ abandonStmt hsc_env (resumeContext r)\n         return True\n\nabandonAll :: GhcMonad m => m Bool\nabandonAll = do\n   hsc_env <- getSession\n   let ic = hsc_IC hsc_env\n       resume = ic_resume ic\n   case resume of\n      []  -> return False\n      rs  -> do\n         setSession hsc_env{ hsc_IC = ic { ic_resume = [] } }\n         liftIO $ mapM_ (abandonStmt hsc_env. resumeContext) rs\n         return True\n\n-- -----------------------------------------------------------------------------\n-- Bounded list, optimised for repeated cons\n\ndata BoundedList a = BL\n                        {-# UNPACK #-} !Int  -- length\n                        {-# UNPACK #-} !Int  -- bound\n                        [a] -- left\n                        [a] -- right,  list is (left ++ reverse right)\n\nnilBL :: Int -> BoundedList a\nnilBL bound = BL 0 bound [] []\n\nconsBL :: a -> BoundedList a -> BoundedList a\nconsBL a (BL len bound left right)\n  | len < bound = BL (len+1) bound (a:left) right\n  | null right  = BL len     bound [a]      $! tail (reverse left)\n  | otherwise   = BL len     bound (a:left) $! tail right\n\ntoListBL :: BoundedList a -> [a]\ntoListBL (BL _ _ left right) = left ++ reverse right\n\nfromListBL :: Int -> [a] -> BoundedList a\nfromListBL bound l = BL (length l) bound l []\n\n-- lenBL (BL len _ _ _) = len\n\n-- -----------------------------------------------------------------------------\n-- | Set the interactive evaluation context.\n--\n-- (setContext imports) sets the ic_imports field (which in turn\n-- determines what is in scope at the prompt) to 'imports', and\n-- constructs the ic_rn_glb_env environment to reflect it.\n--\n-- We retain in scope all the things defined at the prompt, and kept\n-- in ic_tythings.  (Indeed, they shadow stuff from ic_imports.)\n\nsetContext :: GhcMonad m => [InteractiveImport] -> m ()\nsetContext imports\n  = do { hsc_env <- getSession\n       ; let dflags = hsc_dflags hsc_env\n       ; all_env_err <- liftIO $ findGlobalRdrEnv hsc_env imports\n       ; case all_env_err of\n           Left (mod, err) ->\n               liftIO $ throwGhcExceptionIO (formatError dflags mod err)\n           Right all_env -> do {\n       ; let old_ic         = hsc_IC hsc_env\n             !final_rdr_env = all_env `icExtendGblRdrEnv` ic_tythings old_ic\n       ; setSession\n         hsc_env{ hsc_IC = old_ic { ic_imports    = imports\n                                  , ic_rn_gbl_env = final_rdr_env }}}}\n  where\n    formatError dflags mod err = ProgramError . showSDoc dflags $\n      text \"Cannot add module\" <+> ppr mod <+>\n      text \"to context:\" <+> text err\n\nfindGlobalRdrEnv :: HscEnv -> [InteractiveImport]\n                 -> IO (Either (ModuleName, String) GlobalRdrEnv)\n-- Compute the GlobalRdrEnv for the interactive context\nfindGlobalRdrEnv hsc_env imports\n  = do { idecls_env <- hscRnImportDecls hsc_env idecls\n                    -- This call also loads any orphan modules\n       ; return $ case partitionEithers (map mkEnv imods) of\n           ([], imods_env) -> Right (foldr plusGlobalRdrEnv idecls_env imods_env)\n           (err : _, _)    -> Left err }\n  where\n    idecls :: [LImportDecl GhcPs]\n    idecls = [noLoc d | IIDecl d <- imports]\n\n    imods :: [ModuleName]\n    imods = [m | IIModule m <- imports]\n\n    mkEnv mod = case mkTopLevEnv (hsc_HPT hsc_env) mod of\n      Left err -> Left (mod, err)\n      Right env -> Right env\n\navailsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv\navailsToGlobalRdrEnv mod_name avails\n  = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails)\n  where\n      -- We're building a GlobalRdrEnv as if the user imported\n      -- all the specified modules into the global interactive module\n    imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}\n    decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name,\n                         is_qual = False,\n                         is_dloc = srcLocSpan interactiveSrcLoc }\n\nmkTopLevEnv :: HomePackageTable -> ModuleName -> Either String GlobalRdrEnv\nmkTopLevEnv hpt modl\n  = case lookupHpt hpt modl of\n      Nothing -> Left \"not a home module\"\n      Just details ->\n         case mi_globals (hm_iface details) of\n                Nothing  -> Left \"not interpreted\"\n                Just env -> Right env\n\n-- | Get the interactive evaluation context, consisting of a pair of the\n-- set of modules from which we take the full top-level scope, and the set\n-- of modules from which we take just the exports respectively.\ngetContext :: GhcMonad m => m [InteractiveImport]\ngetContext = withSession $ \\HscEnv{ hsc_IC=ic } ->\n             return (ic_imports ic)\n\n-- | Returns @True@ if the specified module is interpreted, and hence has\n-- its full top-level scope available.\nmoduleIsInterpreted :: GhcMonad m => Module -> m Bool\nmoduleIsInterpreted modl = withSession $ \\h ->\n if moduleUnitId modl /= thisPackage (hsc_dflags h)\n        then return False\n        else case lookupHpt (hsc_HPT h) (moduleName modl) of\n                Just details       -> return (isJust (mi_globals (hm_iface details)))\n                _not_a_home_module -> return False\n\n-- | Looks up an identifier in the current interactive context (for :info)\n-- Filter the instances by the ones whose tycons (or clases resp)\n-- are in scope (qualified or otherwise).  Otherwise we list a whole lot too many!\n-- The exact choice of which ones to show, and which to hide, is a judgement call.\n--      (see Trac #1581)\ngetInfo :: GhcMonad m => Bool -> Name\n        -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst], SDoc))\ngetInfo allInfo name\n  = withSession $ \\hsc_env ->\n    do mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env name\n       case mb_stuff of\n         Nothing -> return Nothing\n         Just (thing, fixity, cls_insts, fam_insts, docs) -> do\n           let rdr_env = ic_rn_gbl_env (hsc_IC hsc_env)\n\n           -- Filter the instances based on whether the constituent names of their\n           -- instance heads are all in scope.\n           let cls_insts' = filter (plausible rdr_env . orphNamesOfClsInst) cls_insts\n               fam_insts' = filter (plausible rdr_env . orphNamesOfFamInst) fam_insts\n           return (Just (thing, fixity, cls_insts', fam_insts', docs))\n  where\n    plausible rdr_env names\n          -- Dfun involving only names that are in ic_rn_glb_env\n        = allInfo\n       || nameSetAll ok names\n        where   -- A name is ok if it's in the rdr_env,\n                -- whether qualified or not\n          ok n | n == name              = True\n                       -- The one we looked for in the first place!\n               | pretendNameIsInScope n = True\n               | isBuiltInSyntax n      = True\n               | isCTupleTyConName n    = True\n               | isExternalName n       = isJust (lookupGRE_Name rdr_env n)\n               | otherwise              = True\n\n-- | Returns all names in scope in the current interactive context\ngetNamesInScope :: GhcMonad m => m [Name]\ngetNamesInScope = withSession $ \\hsc_env -> do\n  return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))\n\n-- | Returns all 'RdrName's in scope in the current interactive\n-- context, excluding any that are internally-generated.\ngetRdrNamesInScope :: GhcMonad m => m [RdrName]\ngetRdrNamesInScope = withSession $ \\hsc_env -> do\n  let\n      ic = hsc_IC hsc_env\n      gbl_rdrenv = ic_rn_gbl_env ic\n      gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv\n  -- Exclude internally generated names; see e.g. Trac #11328\n  return (filter (not . isDerivedOccName . rdrNameOcc) gbl_names)\n\n\n-- | Parses a string as an identifier, and returns the list of 'Name's that\n-- the identifier can refer to in the current interactive context.\nparseName :: GhcMonad m => String -> m [Name]\nparseName str = withSession $ \\hsc_env -> liftIO $\n   do { lrdr_name <- hscParseIdentifier hsc_env str\n      ; hscTcRnLookupRdrName hsc_env lrdr_name }\n\n-- | Returns @True@ if passed string is a statement.\nisStmt :: DynFlags -> String -> Bool\nisStmt dflags stmt =\n  case parseThing Parser.parseStmt dflags stmt of\n    Lexer.POk _ _ -> True\n    Lexer.PFailed _ -> False\n\n-- | Returns @True@ if passed string has an import declaration.\nhasImport :: DynFlags -> String -> Bool\nhasImport dflags stmt =\n  case parseThing Parser.parseModule dflags stmt of\n    Lexer.POk _ thing -> hasImports thing\n    Lexer.PFailed _ -> False\n  where\n    hasImports = not . null . hsmodImports . unLoc\n\n-- | Returns @True@ if passed string is an import declaration.\nisImport :: DynFlags -> String -> Bool\nisImport dflags stmt =\n  case parseThing Parser.parseImport dflags stmt of\n    Lexer.POk _ _ -> True\n    Lexer.PFailed _ -> False\n\n-- | Returns @True@ if passed string is a declaration but __/not a splice/__.\nisDecl :: DynFlags -> String -> Bool\nisDecl dflags stmt = do\n  case parseThing Parser.parseDeclaration dflags stmt of\n    Lexer.POk _ thing ->\n      case unLoc thing of\n        SpliceD _ _ -> False\n        _ -> True\n    Lexer.PFailed _ -> False\n\nparseThing :: Lexer.P thing -> DynFlags -> String -> Lexer.ParseResult thing\nparseThing parser dflags stmt = do\n  let buf = stringToStringBuffer stmt\n      loc = mkRealSrcLoc (fsLit \"<interactive>\") 1 1\n\n  Lexer.unP parser (Lexer.mkPState dflags buf loc)\n\ngetDocs :: GhcMonad m\n        => Name\n        -> m (Either GetDocsFailure (Maybe HsDocString, Map Int HsDocString))\n           -- TODO: What about docs for constructors etc.?\ngetDocs name =\n  withSession $ \\hsc_env -> do\n     case nameModule_maybe name of\n       Nothing -> pure (Left (NameHasNoModule name))\n       Just mod -> do\n         if isInteractiveModule mod\n           then pure (Left InteractiveName)\n           else do\n             ModIface { mi_doc_hdr = mb_doc_hdr\n                      , mi_decl_docs = DeclDocMap dmap\n                      , mi_arg_docs = ArgDocMap amap\n                      } <- liftIO $ hscGetModuleInterface hsc_env mod\n             if isNothing mb_doc_hdr && Map.null dmap && Map.null amap\n               then pure (Left (NoDocsInIface mod compiled))\n               else pure (Right ( Map.lookup name dmap\n                                , Map.findWithDefault Map.empty name amap))\n  where\n    compiled =\n      -- TODO: Find a more direct indicator.\n      case nameSrcLoc name of\n        RealSrcLoc {} -> False\n        UnhelpfulLoc {} -> True\n\n-- | Failure modes for 'getDocs'.\n\n-- TODO: Find a way to differentiate between modules loaded without '-haddock'\n-- and modules that contain no docs.\ndata GetDocsFailure\n\n    -- | 'nameModule_maybe' returned 'Nothing'.\n  = NameHasNoModule Name\n\n    -- | This is probably because the module was loaded without @-haddock@,\n    -- but it's also possible that the entire module contains no documentation.\n  | NoDocsInIface\n      Module\n      Bool -- ^ 'True': The module was compiled.\n           -- 'False': The module was :loaded.\n\n    -- | The 'Name' was defined interactively.\n  | InteractiveName\n\ninstance Outputable GetDocsFailure where\n  ppr (NameHasNoModule name) =\n    quotes (ppr name) <+> text \"has no module where we could look for docs.\"\n  ppr (NoDocsInIface mod compiled) = vcat\n    [ text \"Can't find any documentation for\" <+> ppr mod <> char '.'\n    , text \"This is probably because the module was\"\n        <+> text (if compiled then \"compiled\" else \"loaded\")\n        <+> text \"without '-haddock',\"\n    , text \"but it's also possible that the module contains no documentation.\"\n    , text \"\"\n    , if compiled\n        then text \"Try re-compiling with '-haddock'.\"\n        else text \"Try running ':set -haddock' and :load the file again.\"\n        -- TODO: Figure out why :reload doesn't load the docs and maybe fix it.\n    ]\n  ppr InteractiveName =\n    text \"Docs are unavailable for interactive declarations.\"\n\n-- -----------------------------------------------------------------------------\n-- Getting the type of an expression\n\n-- | Get the type of an expression\n-- Returns the type as described by 'TcRnExprMode'\nexprType :: GhcMonad m => TcRnExprMode -> String -> m Type\nexprType mode expr = withSession $ \\hsc_env -> do\n   ty <- liftIO $ hscTcExpr hsc_env mode expr\n   return $ tidyType emptyTidyEnv ty\n\n-- -----------------------------------------------------------------------------\n-- Getting the kind of a type\n\n-- | Get the kind of a  type\ntypeKind  :: GhcMonad m => Bool -> String -> m (Type, Kind)\ntypeKind normalise str = withSession $ \\hsc_env -> do\n   liftIO $ hscKcType hsc_env normalise str\n\n-----------------------------------------------------------------------------\n-- Compile an expression, run it, and deliver the result\n\n-- | Parse an expression, the parsed expression can be further processed and\n-- passed to compileParsedExpr.\nparseExpr :: GhcMonad m => String -> m (LHsExpr GhcPs)\nparseExpr expr = withSession $ \\hsc_env -> do\n  liftIO $ runInteractiveHsc hsc_env $ hscParseExpr expr\n\n-- | Compile an expression, run it, and deliver the resulting HValue.\ncompileExpr :: GhcMonad m => String -> m HValue\ncompileExpr expr = do\n  parsed_expr <- parseExpr expr\n  compileParsedExpr parsed_expr\n\n-- | Compile an expression, run it, and deliver the resulting HValue.\ncompileExprRemote :: GhcMonad m => String -> m ForeignHValue\ncompileExprRemote expr = do\n  parsed_expr <- parseExpr expr\n  compileParsedExprRemote parsed_expr\n\n-- | Compile a parsed expression (before renaming), run it, and deliver\n-- the resulting HValue.\ncompileParsedExprRemote :: GhcMonad m => LHsExpr GhcPs -> m ForeignHValue\ncompileParsedExprRemote expr@(L loc _) = withSession $ \\hsc_env -> do\n  -- > let _compileParsedExpr = expr\n  -- Create let stmt from expr to make hscParsedStmt happy.\n  -- We will ignore the returned [Id], namely [expr_id], and not really\n  -- create a new binding.\n  let expr_fs = fsLit \"_compileParsedExpr\"\n      expr_name = mkInternalName (getUnique expr_fs) (mkTyVarOccFS expr_fs) loc\n      let_stmt = L loc . LetStmt noExt . L loc . (HsValBinds noExt) $\n        ValBinds noExt\n                     (unitBag $ mkHsVarBind loc (getRdrName expr_name) expr) []\n\n  pstmt <- liftIO $ hscParsedStmt hsc_env let_stmt\n  let (hvals_io, fix_env) = case pstmt of\n        Just ([_id], hvals_io', fix_env') -> (hvals_io', fix_env')\n        _ -> panic \"compileParsedExprRemote\"\n\n  updateFixityEnv fix_env\n  status <- liftIO $ evalStmt hsc_env False (EvalThis hvals_io)\n  case status of\n    EvalComplete _ (EvalSuccess [hval]) -> return hval\n    EvalComplete _ (EvalException e) ->\n      liftIO $ throwIO (fromSerializableException e)\n    _ -> panic \"compileParsedExpr\"\n\ncompileParsedExpr :: GhcMonad m => LHsExpr GhcPs -> m HValue\ncompileParsedExpr expr = do\n   fhv <- compileParsedExprRemote expr\n   dflags <- getDynFlags\n   liftIO $ wormhole dflags fhv\n\n-- | Compile an expression, run it and return the result as a Dynamic.\ndynCompileExpr :: GhcMonad m => String -> m Dynamic\ndynCompileExpr expr = do\n  parsed_expr <- parseExpr expr\n  -- > Data.Dynamic.toDyn expr\n  let loc = getLoc parsed_expr\n      to_dyn_expr = mkHsApp (L loc . HsVar noExt . L loc $ getRdrName toDynName)\n                            parsed_expr\n  hval <- compileParsedExpr to_dyn_expr\n  return (unsafeCoerce# hval :: Dynamic)\n\n-----------------------------------------------------------------------------\n-- show a module and it's source/object filenames\n\nshowModule :: GhcMonad m => ModSummary -> m String\nshowModule mod_summary =\n    withSession $ \\hsc_env -> do\n        interpreted <- moduleIsBootOrNotObjectLinkable mod_summary\n        let dflags = hsc_dflags hsc_env\n        return (showModMsg dflags (hscTarget dflags) interpreted mod_summary)\n\nmoduleIsBootOrNotObjectLinkable :: GhcMonad m => ModSummary -> m Bool\nmoduleIsBootOrNotObjectLinkable mod_summary = withSession $ \\hsc_env ->\n  case lookupHpt (hsc_HPT hsc_env) (ms_mod_name mod_summary) of\n        Nothing       -> panic \"missing linkable\"\n        Just mod_info -> return $ case hm_linkable mod_info of\n          Nothing       -> True\n          Just linkable -> not (isObjectLinkable linkable)\n\n----------------------------------------------------------------------------\n-- RTTI primitives\n\nobtainTermFromVal :: HscEnv -> Int -> Bool -> Type -> a -> IO Term\nobtainTermFromVal hsc_env bound force ty x\n  | gopt Opt_ExternalInterpreter (hsc_dflags hsc_env)\n  = throwIO (InstallationError\n      \"this operation requires -fno-external-interpreter\")\n  | otherwise\n  = cvObtainTerm hsc_env bound force ty (unsafeCoerce# x)\n\nobtainTermFromId :: HscEnv -> Int -> Bool -> Id -> IO Term\nobtainTermFromId hsc_env bound force id =  do\n  hv <- Linker.getHValue hsc_env (varName id)\n  cvObtainTerm hsc_env bound force (idType id) hv\n\n-- Uses RTTI to reconstruct the type of an Id, making it less polymorphic\nreconstructType :: HscEnv -> Int -> Id -> IO (Maybe Type)\nreconstructType hsc_env bound id = do\n  hv <- Linker.getHValue hsc_env (varName id)\n  cvReconstructType hsc_env bound (idType id) hv\n\nmkRuntimeUnkTyVar :: Name -> Kind -> TyVar\nmkRuntimeUnkTyVar name kind = mkTcTyVar name kind RuntimeUnk\n", "num_lines": 1043}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 2005-2007\n--\n-- Running statements interactively\n--\n-- -----------------------------------------------------------------------------\n\nmodule InteractiveEvalTypes (\n        Resume(..), History(..), ExecResult(..),\n        SingleStep(..), isStep, ExecOptions(..),\n        BreakInfo(..)\n        ) where\n\nimport GhcPrelude\n\nimport GHCi.RemoteTypes\nimport GHCi.Message (EvalExpr, ResumeContext)\nimport Id\nimport Name\nimport Module\nimport RdrName\nimport Type\nimport SrcLoc\nimport Exception\n\nimport Data.Word\nimport GHC.Stack.CCS\n\ndata ExecOptions\n = ExecOptions\n     { execSingleStep :: SingleStep         -- ^ stepping mode\n     , execSourceFile :: String             -- ^ filename (for errors)\n     , execLineNumber :: Int                -- ^ line number (for errors)\n     , execWrap :: ForeignHValue -> EvalExpr ForeignHValue\n     }\n\ndata SingleStep\n   = RunToCompletion\n   | SingleStep\n   | RunAndLogSteps\n\nisStep :: SingleStep -> Bool\nisStep RunToCompletion = False\nisStep _ = True\n\ndata ExecResult\n  = ExecComplete\n       { execResult :: Either SomeException [Name]\n       , execAllocation :: Word64\n       }\n  | ExecBreak\n       { breakNames :: [Name]\n       , breakInfo :: Maybe BreakInfo\n       }\n\ndata BreakInfo = BreakInfo\n  { breakInfo_module :: Module\n  , breakInfo_number :: Int\n  }\n\ndata Resume = Resume\n       { resumeStmt      :: String       -- the original statement\n       , resumeContext   :: ForeignRef (ResumeContext [HValueRef])\n       , resumeBindings  :: ([TyThing], GlobalRdrEnv)\n       , resumeFinalIds  :: [Id]         -- [Id] to bind on completion\n       , resumeApStack   :: ForeignHValue -- The object from which we can get\n                                        -- value of the free variables.\n       , resumeBreakInfo :: Maybe BreakInfo\n                                        -- the breakpoint we stopped at\n                                        -- (module, index)\n                                        -- (Nothing <=> exception)\n       , resumeSpan      :: SrcSpan      -- just a copy of the SrcSpan\n                                        -- from the ModBreaks,\n                                        -- otherwise it's a pain to\n                                        -- fetch the ModDetails &\n                                        -- ModBreaks to get this.\n       , resumeDecl      :: String       -- ditto\n       , resumeCCS       :: RemotePtr CostCentreStack\n       , resumeHistory   :: [History]\n       , resumeHistoryIx :: Int           -- 0 <==> at the top of the history\n       }\n\ndata History\n   = History {\n        historyApStack   :: ForeignHValue,\n        historyBreakInfo :: BreakInfo,\n        historyEnclosingDecls :: [String]  -- declarations enclosing the breakpoint\n   }\n", "num_lines": 90}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, RecordWildCards, FlexibleInstances, MultiParamTypeClasses #-}\n\n-- |\n-- Package configuration information: essentially the interface to Cabal, with\n-- some utilities\n--\n-- (c) The University of Glasgow, 2004\n--\nmodule PackageConfig (\n        -- $package_naming\n\n        -- * UnitId\n        packageConfigId,\n        expandedPackageConfigId,\n        definitePackageConfigId,\n        installedPackageConfigId,\n\n        -- * The PackageConfig type: information about a package\n        PackageConfig,\n        InstalledPackageInfo(..),\n        ComponentId(..),\n        SourcePackageId(..),\n        PackageName(..),\n        Version(..),\n        defaultPackageConfig,\n        sourcePackageIdString,\n        packageNameString,\n        pprPackageConfig,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport GHC.PackageDb\nimport Data.Version\n\nimport FastString\nimport Outputable\nimport Module\nimport Unique\n\n-- -----------------------------------------------------------------------------\n-- Our PackageConfig type is the InstalledPackageInfo from ghc-boot,\n-- which is similar to a subset of the InstalledPackageInfo type from Cabal.\n\ntype PackageConfig = InstalledPackageInfo\n                       ComponentId\n                       SourcePackageId\n                       PackageName\n                       Module.InstalledUnitId\n                       Module.UnitId\n                       Module.ModuleName\n                       Module.Module\n\n-- TODO: there's no need for these to be FastString, as we don't need the uniq\n--       feature, but ghc doesn't currently have convenient support for any\n--       other compact string types, e.g. plain ByteString or Text.\n\nnewtype SourcePackageId    = SourcePackageId    FastString deriving (Eq, Ord)\nnewtype PackageName        = PackageName        FastString deriving (Eq, Ord)\n\ninstance BinaryStringRep SourcePackageId where\n  fromStringRep = SourcePackageId . mkFastStringByteString\n  toStringRep (SourcePackageId s) = bytesFS s\n\ninstance BinaryStringRep PackageName where\n  fromStringRep = PackageName . mkFastStringByteString\n  toStringRep (PackageName s) = bytesFS s\n\ninstance Uniquable SourcePackageId where\n  getUnique (SourcePackageId n) = getUnique n\n\ninstance Uniquable PackageName where\n  getUnique (PackageName n) = getUnique n\n\ninstance Outputable SourcePackageId where\n  ppr (SourcePackageId str) = ftext str\n\ninstance Outputable PackageName where\n  ppr (PackageName str) = ftext str\n\ndefaultPackageConfig :: PackageConfig\ndefaultPackageConfig = emptyInstalledPackageInfo\n\nsourcePackageIdString :: PackageConfig -> String\nsourcePackageIdString pkg = unpackFS str\n  where\n    SourcePackageId str = sourcePackageId pkg\n\npackageNameString :: PackageConfig -> String\npackageNameString pkg = unpackFS str\n  where\n    PackageName str = packageName pkg\n\npprPackageConfig :: PackageConfig -> SDoc\npprPackageConfig InstalledPackageInfo {..} =\n    vcat [\n      field \"name\"                 (ppr packageName),\n      field \"version\"              (text (showVersion packageVersion)),\n      field \"id\"                   (ppr unitId),\n      field \"exposed\"              (ppr exposed),\n      field \"exposed-modules\"      (ppr exposedModules),\n      field \"hidden-modules\"       (fsep (map ppr hiddenModules)),\n      field \"trusted\"              (ppr trusted),\n      field \"import-dirs\"          (fsep (map text importDirs)),\n      field \"library-dirs\"         (fsep (map text libraryDirs)),\n      field \"dynamic-library-dirs\" (fsep (map text libraryDynDirs)),\n      field \"hs-libraries\"         (fsep (map text hsLibraries)),\n      field \"extra-libraries\"      (fsep (map text extraLibraries)),\n      field \"extra-ghci-libraries\" (fsep (map text extraGHCiLibraries)),\n      field \"include-dirs\"         (fsep (map text includeDirs)),\n      field \"includes\"             (fsep (map text includes)),\n      field \"depends\"              (fsep (map ppr  depends)),\n      field \"cc-options\"           (fsep (map text ccOptions)),\n      field \"ld-options\"           (fsep (map text ldOptions)),\n      field \"framework-dirs\"       (fsep (map text frameworkDirs)),\n      field \"frameworks\"           (fsep (map text frameworks)),\n      field \"haddock-interfaces\"   (fsep (map text haddockInterfaces)),\n      field \"haddock-html\"         (fsep (map text haddockHTMLs))\n    ]\n  where\n    field name body = text name <> colon <+> nest 4 body\n\n-- -----------------------------------------------------------------------------\n-- UnitId (package names, versions and dep hash)\n\n-- $package_naming\n-- #package_naming#\n-- Mostly the compiler deals in terms of 'UnitId's, which are md5 hashes\n-- of a package ID, keys of its dependencies, and Cabal flags. You're expected\n-- to pass in the unit id in the @-this-unit-id@ flag. However, for\n-- wired-in packages like @base@ & @rts@, we don't necessarily know what the\n-- version is, so these are handled specially; see #wired_in_packages#.\n\n-- | Get the GHC 'UnitId' right out of a Cabalish 'PackageConfig'\ninstalledPackageConfigId :: PackageConfig -> InstalledUnitId\ninstalledPackageConfigId = unitId\n\npackageConfigId :: PackageConfig -> UnitId\npackageConfigId p =\n    if indefinite p\n        then newUnitId (componentId p) (instantiatedWith p)\n        else DefiniteUnitId (DefUnitId (unitId p))\n\nexpandedPackageConfigId :: PackageConfig -> UnitId\nexpandedPackageConfigId p =\n    newUnitId (componentId p) (instantiatedWith p)\n\ndefinitePackageConfigId :: PackageConfig -> Maybe DefUnitId\ndefinitePackageConfigId p =\n    case packageConfigId p of\n        DefiniteUnitId def_uid -> Just def_uid\n        _ -> Nothing\n", "num_lines": 155}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow, 2006\n\n{-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns, FlexibleContexts #-}\n\n-- | Package manipulation\nmodule Packages (\n        module PackageConfig,\n\n        -- * Reading the package config, and processing cmdline args\n        PackageState(preloadPackages, explicitPackages, moduleToPkgConfAll, requirementContext),\n        PackageConfigMap,\n        emptyPackageState,\n        initPackages,\n        readPackageConfigs,\n        getPackageConfRefs,\n        resolvePackageConfig,\n        readPackageConfig,\n        listPackageConfigMap,\n\n        -- * Querying the package config\n        lookupPackage,\n        lookupPackage',\n        lookupInstalledPackage,\n        lookupPackageName,\n        improveUnitId,\n        searchPackageId,\n        getPackageDetails,\n        getInstalledPackageDetails,\n        componentIdString,\n        displayInstalledUnitId,\n        listVisibleModuleNames,\n        lookupModuleInAllPackages,\n        lookupModuleWithSuggestions,\n        lookupPluginModuleWithSuggestions,\n        LookupResult(..),\n        ModuleSuggestion(..),\n        ModuleOrigin(..),\n        UnusablePackageReason(..),\n        pprReason,\n\n        -- * Inspecting the set of packages in scope\n        getPackageIncludePath,\n        getPackageLibraryPath,\n        getPackageLinkOpts,\n        getPackageExtraCcOpts,\n        getPackageFrameworkPath,\n        getPackageFrameworks,\n        getPackageConfigMap,\n        getPreloadPackagesAnd,\n\n        collectArchives,\n        collectIncludeDirs, collectLibraryPaths, collectLinkOpts,\n        packageHsLibs, getLibs,\n\n        -- * Utils\n        unwireUnitId,\n        pprFlag,\n        pprPackages,\n        pprPackagesSimple,\n        pprModuleMap,\n        isIndefinite,\n        isDllName\n    )\nwhere\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport GHC.PackageDb\nimport PackageConfig\nimport DynFlags\nimport Name             ( Name, nameModule_maybe )\nimport UniqFM\nimport UniqDFM\nimport UniqSet\nimport Module\nimport Util\nimport Panic\nimport Platform\nimport Outputable\nimport Maybes\n\nimport System.Environment ( getEnv )\nimport FastString\nimport ErrUtils         ( debugTraceMsg, MsgDoc, dumpIfSet_dyn )\nimport Exception\n\nimport System.Directory\nimport System.FilePath as FilePath\nimport qualified System.FilePath.Posix as FilePath.Posix\nimport Control.Monad\nimport Data.Graph (stronglyConnComp, SCC(..))\nimport Data.Char ( toUpper )\nimport Data.List as List\nimport Data.Map (Map)\nimport Data.Set (Set)\nimport Data.Monoid (First(..))\nimport qualified Data.Semigroup as Semigroup\nimport qualified Data.Map as Map\nimport qualified Data.Map.Strict as MapStrict\nimport qualified Data.Set as Set\nimport Data.Version\n\n-- ---------------------------------------------------------------------------\n-- The Package state\n\n-- | Package state is all stored in 'DynFlags', including the details of\n-- all packages, which packages are exposed, and which modules they\n-- provide.\n--\n-- The package state is computed by 'initPackages', and kept in DynFlags.\n-- It is influenced by various package flags:\n--\n--   * @-package <pkg>@ and @-package-id <pkg>@ cause @<pkg>@ to become exposed.\n--     If @-hide-all-packages@ was not specified, these commands also cause\n--      all other packages with the same name to become hidden.\n--\n--   * @-hide-package <pkg>@ causes @<pkg>@ to become hidden.\n--\n--   * (there are a few more flags, check below for their semantics)\n--\n-- The package state has the following properties.\n--\n--   * Let @exposedPackages@ be the set of packages thus exposed.\n--     Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of\n--     their dependencies.\n--\n--   * When searching for a module from a preload import declaration,\n--     only the exposed modules in @exposedPackages@ are valid.\n--\n--   * When searching for a module from an implicit import, all modules\n--     from @depExposedPackages@ are valid.\n--\n--   * When linking in a compilation manager mode, we link in packages the\n--     program depends on (the compiler knows this list by the\n--     time it gets to the link step).  Also, we link in all packages\n--     which were mentioned with preload @-package@ flags on the command-line,\n--     or are a transitive dependency of same, or are \\\"base\\\"\\/\\\"rts\\\".\n--     The reason for this is that we might need packages which don't\n--     contain any Haskell modules, and therefore won't be discovered\n--     by the normal mechanism of dependency tracking.\n\n-- Notes on DLLs\n-- ~~~~~~~~~~~~~\n-- When compiling module A, which imports module B, we need to\n-- know whether B will be in the same DLL as A.\n--      If it's in the same DLL, we refer to B_f_closure\n--      If it isn't, we refer to _imp__B_f_closure\n-- When compiling A, we record in B's Module value whether it's\n-- in a different DLL, by setting the DLL flag.\n\n-- | Given a module name, there may be multiple ways it came into scope,\n-- possibly simultaneously.  This data type tracks all the possible ways\n-- it could have come into scope.  Warning: don't use the record functions,\n-- they're partial!\ndata ModuleOrigin =\n    -- | Module is hidden, and thus never will be available for import.\n    -- (But maybe the user didn't realize), so we'll still keep track\n    -- of these modules.)\n    ModHidden\n    -- | Module is unavailable because the package is unusable.\n  | ModUnusable UnusablePackageReason\n    -- | Module is public, and could have come from some places.\n  | ModOrigin {\n        -- | @Just False@ means that this module is in\n        -- someone's @exported-modules@ list, but that package is hidden;\n        -- @Just True@ means that it is available; @Nothing@ means neither\n        -- applies.\n        fromOrigPackage :: Maybe Bool\n        -- | Is the module available from a reexport of an exposed package?\n        -- There could be multiple.\n      , fromExposedReexport :: [PackageConfig]\n        -- | Is the module available from a reexport of a hidden package?\n      , fromHiddenReexport :: [PackageConfig]\n        -- | Did the module export come from a package flag? (ToDo: track\n        -- more information.\n      , fromPackageFlag :: Bool\n      }\n\ninstance Outputable ModuleOrigin where\n    ppr ModHidden = text \"hidden module\"\n    ppr (ModUnusable _) = text \"unusable module\"\n    ppr (ModOrigin e res rhs f) = sep (punctuate comma (\n        (case e of\n            Nothing -> []\n            Just False -> [text \"hidden package\"]\n            Just True -> [text \"exposed package\"]) ++\n        (if null res\n            then []\n            else [text \"reexport by\" <+>\n                    sep (map (ppr . packageConfigId) res)]) ++\n        (if null rhs\n            then []\n            else [text \"hidden reexport by\" <+>\n                    sep (map (ppr . packageConfigId) res)]) ++\n        (if f then [text \"package flag\"] else [])\n        ))\n\n-- | Smart constructor for a module which is in @exposed-modules@.  Takes\n-- as an argument whether or not the defining package is exposed.\nfromExposedModules :: Bool -> ModuleOrigin\nfromExposedModules e = ModOrigin (Just e) [] [] False\n\n-- | Smart constructor for a module which is in @reexported-modules@.  Takes\n-- as an argument whether or not the reexporting package is expsed, and\n-- also its 'PackageConfig'.\nfromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin\nfromReexportedModules True pkg = ModOrigin Nothing [pkg] [] False\nfromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False\n\n-- | Smart constructor for a module which was bound by a package flag.\nfromFlag :: ModuleOrigin\nfromFlag = ModOrigin Nothing [] [] True\n\ninstance Semigroup ModuleOrigin where\n    ModOrigin e res rhs f <> ModOrigin e' res' rhs' f' =\n        ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f')\n      where g (Just b) (Just b')\n                | b == b'   = Just b\n                | otherwise = panic \"ModOrigin: package both exposed/hidden\"\n            g Nothing x = x\n            g x Nothing = x\n    _x <> _y = panic \"ModOrigin: hidden module redefined\"\n\ninstance Monoid ModuleOrigin where\n    mempty = ModOrigin Nothing [] [] False\n    mappend = (Semigroup.<>)\n\n-- | Is the name from the import actually visible? (i.e. does it cause\n-- ambiguity, or is it only relevant when we're making suggestions?)\noriginVisible :: ModuleOrigin -> Bool\noriginVisible ModHidden = False\noriginVisible (ModUnusable _) = False\noriginVisible (ModOrigin b res _ f) = b == Just True || not (null res) || f\n\n-- | Are there actually no providers for this module?  This will never occur\n-- except when we're filtering based on package imports.\noriginEmpty :: ModuleOrigin -> Bool\noriginEmpty (ModOrigin Nothing [] [] False) = True\noriginEmpty _ = False\n\n-- | 'UniqFM' map from 'InstalledUnitId'\ntype InstalledUnitIdMap = UniqDFM\n\n-- | 'UniqFM' map from 'UnitId' to 'PackageConfig', plus\n-- the transitive closure of preload packages.\ndata PackageConfigMap = PackageConfigMap {\n        unPackageConfigMap :: InstalledUnitIdMap PackageConfig,\n        -- | The set of transitively reachable packages according\n        -- to the explicitly provided command line arguments.\n        -- See Note [UnitId to InstalledUnitId improvement]\n        preloadClosure :: UniqSet InstalledUnitId\n    }\n\n-- | 'UniqFM' map from 'UnitId' to a 'UnitVisibility'.\ntype VisibilityMap = Map UnitId UnitVisibility\n\n-- | 'UnitVisibility' records the various aspects of visibility of a particular\n-- 'UnitId'.\ndata UnitVisibility = UnitVisibility\n    { uv_expose_all :: Bool\n      --  ^ Should all modules in exposed-modules should be dumped into scope?\n    , uv_renamings :: [(ModuleName, ModuleName)]\n      -- ^ Any custom renamings that should bring extra 'ModuleName's into\n      -- scope.\n    , uv_package_name :: First FastString\n      -- ^ The package name is associated with the 'UnitId'.  This is used\n      -- to implement legacy behavior where @-package foo-0.1@ implicitly\n      -- hides any packages named @foo@\n    , uv_requirements :: Map ModuleName (Set IndefModule)\n      -- ^ The signatures which are contributed to the requirements context\n      -- from this unit ID.\n    , uv_explicit :: Bool\n      -- ^ Whether or not this unit was explicitly brought into scope,\n      -- as opposed to implicitly via the 'exposed' fields in the\n      -- package database (when @-hide-all-packages@ is not passed.)\n    }\n\ninstance Outputable UnitVisibility where\n    ppr (UnitVisibility {\n        uv_expose_all = b,\n        uv_renamings = rns,\n        uv_package_name = First mb_pn,\n        uv_requirements = reqs,\n        uv_explicit = explicit\n    }) = ppr (b, rns, mb_pn, reqs, explicit)\n\ninstance Semigroup UnitVisibility where\n    uv1 <> uv2\n        = UnitVisibility\n          { uv_expose_all = uv_expose_all uv1 || uv_expose_all uv2\n          , uv_renamings = uv_renamings uv1 ++ uv_renamings uv2\n          , uv_package_name = mappend (uv_package_name uv1) (uv_package_name uv2)\n          , uv_requirements = Map.unionWith Set.union (uv_requirements uv1) (uv_requirements uv2)\n          , uv_explicit = uv_explicit uv1 || uv_explicit uv2\n          }\n\ninstance Monoid UnitVisibility where\n    mempty = UnitVisibility\n             { uv_expose_all = False\n             , uv_renamings = []\n             , uv_package_name = First Nothing\n             , uv_requirements = Map.empty\n             , uv_explicit = False\n             }\n    mappend = (Semigroup.<>)\n\ntype WiredUnitId = DefUnitId\ntype PreloadUnitId = InstalledUnitId\n\n-- | Map from 'ModuleName' to 'Module' to all the origins of the bindings\n-- in scope.  The 'PackageConf' is not cached, mostly for convenience reasons\n-- (since this is the slow path, we'll just look it up again).\ntype ModuleToPkgConfAll =\n    Map ModuleName (Map Module ModuleOrigin)\n\ndata PackageState = PackageState {\n  -- | A mapping of 'UnitId' to 'PackageConfig'.  This list is adjusted\n  -- so that only valid packages are here.  'PackageConfig' reflects\n  -- what was stored *on disk*, except for the 'trusted' flag, which\n  -- is adjusted at runtime.  (In particular, some packages in this map\n  -- may have the 'exposed' flag be 'False'.)\n  pkgIdMap              :: PackageConfigMap,\n\n  -- | A mapping of 'PackageName' to 'ComponentId'.  This is used when\n  -- users refer to packages in Backpack includes.\n  packageNameMap            :: Map PackageName ComponentId,\n\n  -- | A mapping from wired in names to the original names from the\n  -- package database.\n  unwireMap :: Map WiredUnitId WiredUnitId,\n\n  -- | The packages we're going to link in eagerly.  This list\n  -- should be in reverse dependency order; that is, a package\n  -- is always mentioned before the packages it depends on.\n  preloadPackages      :: [PreloadUnitId],\n\n  -- | Packages which we explicitly depend on (from a command line flag).\n  -- We'll use this to generate version macros.\n  explicitPackages      :: [UnitId],\n\n  -- | This is a full map from 'ModuleName' to all modules which may possibly\n  -- be providing it.  These providers may be hidden (but we'll still want\n  -- to report them in error messages), or it may be an ambiguous import.\n  moduleToPkgConfAll    :: !ModuleToPkgConfAll,\n\n  -- | A map, like 'moduleToPkgConfAll', but controlling plugin visibility.\n  pluginModuleToPkgConfAll    :: !ModuleToPkgConfAll,\n\n  -- | A map saying, for each requirement, what interfaces must be merged\n  -- together when we use them.  For example, if our dependencies\n  -- are @p[A=<A>]@ and @q[A=<A>,B=r[C=<A>]:B]@, then the interfaces\n  -- to merge for A are @p[A=<A>]:A@, @q[A=<A>,B=r[C=<A>]:B]:A@\n  -- and @r[C=<A>]:C@.\n  --\n  -- There's an entry in this map for each hole in our home library.\n  requirementContext :: Map ModuleName [IndefModule]\n  }\n\nemptyPackageState :: PackageState\nemptyPackageState = PackageState {\n    pkgIdMap = emptyPackageConfigMap,\n    packageNameMap = Map.empty,\n    unwireMap = Map.empty,\n    preloadPackages = [],\n    explicitPackages = [],\n    moduleToPkgConfAll = Map.empty,\n    pluginModuleToPkgConfAll = Map.empty,\n    requirementContext = Map.empty\n    }\n\ntype InstalledPackageIndex = Map InstalledUnitId PackageConfig\n\n-- | Empty package configuration map\nemptyPackageConfigMap :: PackageConfigMap\nemptyPackageConfigMap = PackageConfigMap emptyUDFM emptyUniqSet\n\n-- | Find the package we know about with the given unit id, if any\nlookupPackage :: DynFlags -> UnitId -> Maybe PackageConfig\nlookupPackage dflags = lookupPackage' (isIndefinite dflags) (pkgIdMap (pkgState dflags))\n\n-- | A more specialized interface, which takes a boolean specifying\n-- whether or not to look for on-the-fly renamed interfaces, and\n-- just a 'PackageConfigMap' rather than a 'DynFlags' (so it can\n-- be used while we're initializing 'DynFlags'\nlookupPackage' :: Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig\nlookupPackage' False (PackageConfigMap pkg_map _) uid = lookupUDFM pkg_map uid\nlookupPackage' True m@(PackageConfigMap pkg_map _) uid =\n    case splitUnitIdInsts uid of\n        (iuid, Just indef) ->\n            fmap (renamePackage m (indefUnitIdInsts indef))\n                 (lookupUDFM pkg_map iuid)\n        (_, Nothing) -> lookupUDFM pkg_map uid\n\n{-\n-- | Find the indefinite package for a given 'ComponentId'.\n-- The way this works is just by fiat'ing that every indefinite package's\n-- unit key is precisely its component ID; and that they share uniques.\nlookupComponentId :: DynFlags -> ComponentId -> Maybe PackageConfig\nlookupComponentId dflags (ComponentId cid_fs) = lookupUDFM pkg_map cid_fs\n  where\n    PackageConfigMap pkg_map = pkgIdMap (pkgState dflags)\n-}\n\n-- | Find the package we know about with the given package name (e.g. @foo@), if any\n-- (NB: there might be a locally defined unit name which overrides this)\nlookupPackageName :: DynFlags -> PackageName -> Maybe ComponentId\nlookupPackageName dflags n = Map.lookup n (packageNameMap (pkgState dflags))\n\n-- | Search for packages with a given package ID (e.g. \\\"foo-0.1\\\")\nsearchPackageId :: DynFlags -> SourcePackageId -> [PackageConfig]\nsearchPackageId dflags pid = filter ((pid ==) . sourcePackageId)\n                               (listPackageConfigMap dflags)\n\n-- | Extends the package configuration map with a list of package configs.\nextendPackageConfigMap\n   :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap\nextendPackageConfigMap (PackageConfigMap pkg_map closure) new_pkgs\n  = PackageConfigMap (foldl' add pkg_map new_pkgs) closure\n    -- We also add the expanded version of the packageConfigId, so that\n    -- 'improveUnitId' can find it.\n  where add pkg_map p = addToUDFM (addToUDFM pkg_map (expandedPackageConfigId p) p)\n                                  (installedPackageConfigId p) p\n\n-- | Looks up the package with the given id in the package state, panicing if it is\n-- not found\ngetPackageDetails :: DynFlags -> UnitId -> PackageConfig\ngetPackageDetails dflags pid =\n    expectJust \"getPackageDetails\" (lookupPackage dflags pid)\n\nlookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig\nlookupInstalledPackage dflags uid = lookupInstalledPackage' (pkgIdMap (pkgState dflags)) uid\n\nlookupInstalledPackage' :: PackageConfigMap -> InstalledUnitId -> Maybe PackageConfig\nlookupInstalledPackage' (PackageConfigMap db _) uid = lookupUDFM db uid\n\ngetInstalledPackageDetails :: DynFlags -> InstalledUnitId -> PackageConfig\ngetInstalledPackageDetails dflags uid =\n    expectJust \"getInstalledPackageDetails\" $\n        lookupInstalledPackage dflags uid\n\n-- | Get a list of entries from the package database.  NB: be careful with\n-- this function, although all packages in this map are \"visible\", this\n-- does not imply that the exposed-modules of the package are available\n-- (they may have been thinned or renamed).\nlistPackageConfigMap :: DynFlags -> [PackageConfig]\nlistPackageConfigMap dflags = eltsUDFM pkg_map\n  where\n    PackageConfigMap pkg_map _ = pkgIdMap (pkgState dflags)\n\n-- ----------------------------------------------------------------------------\n-- Loading the package db files and building up the package state\n\n-- | Call this after 'DynFlags.parseDynFlags'.  It reads the package\n-- database files, and sets up various internal tables of package\n-- information, according to the package-related flags on the\n-- command-line (@-package@, @-hide-package@ etc.)\n--\n-- Returns a list of packages to link in if we're doing dynamic linking.\n-- This list contains the packages that the user explicitly mentioned with\n-- @-package@ flags.\n--\n-- 'initPackages' can be called again subsequently after updating the\n-- 'packageFlags' field of the 'DynFlags', and it will update the\n-- 'pkgState' in 'DynFlags' and return a list of packages to\n-- link in.\ninitPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])\ninitPackages dflags0 = do\n  dflags <- interpretPackageEnv dflags0\n  pkg_db <-\n    case pkgDatabase dflags of\n        Nothing -> readPackageConfigs dflags\n        Just db -> return $ map (\\(p, pkgs)\n                                    -> (p, setBatchPackageFlags dflags pkgs)) db\n  (pkg_state, preload, insts)\n        <- mkPackageState dflags pkg_db []\n  return (dflags{ pkgDatabase = Just pkg_db,\n                  pkgState = pkg_state,\n                  thisUnitIdInsts_ = insts },\n          preload)\n\n-- -----------------------------------------------------------------------------\n-- Reading the package database(s)\n\nreadPackageConfigs :: DynFlags -> IO [(FilePath, [PackageConfig])]\nreadPackageConfigs dflags = do\n  conf_refs <- getPackageConfRefs dflags\n  confs     <- liftM catMaybes $ mapM (resolvePackageConfig dflags) conf_refs\n  mapM (readPackageConfig dflags) confs\n\n\ngetPackageConfRefs :: DynFlags -> IO [PkgConfRef]\ngetPackageConfRefs dflags = do\n  let system_conf_refs = [UserPkgConf, GlobalPkgConf]\n\n  e_pkg_path <- tryIO (getEnv $ map toUpper (programName dflags) ++ \"_PACKAGE_PATH\")\n  let base_conf_refs = case e_pkg_path of\n        Left _ -> system_conf_refs\n        Right path\n         | not (null path) && isSearchPathSeparator (last path)\n         -> map PkgConfFile (splitSearchPath (init path)) ++ system_conf_refs\n         | otherwise\n         -> map PkgConfFile (splitSearchPath path)\n\n  -- Apply the package DB-related flags from the command line to get the\n  -- final list of package DBs.\n  --\n  -- Notes on ordering:\n  --  * The list of flags is reversed (later ones first)\n  --  * We work with the package DB list in \"left shadows right\" order\n  --  * and finally reverse it at the end, to get \"right shadows left\"\n  --\n  return $ reverse (foldr doFlag base_conf_refs (packageDBFlags dflags))\n where\n  doFlag (PackageDB p) dbs = p : dbs\n  doFlag NoUserPackageDB dbs = filter isNotUser dbs\n  doFlag NoGlobalPackageDB dbs = filter isNotGlobal dbs\n  doFlag ClearPackageDBs _ = []\n\n  isNotUser UserPkgConf = False\n  isNotUser _ = True\n\n  isNotGlobal GlobalPkgConf = False\n  isNotGlobal _ = True\n\nresolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)\nresolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig dflags)\n-- NB: This logic is reimplemented in Cabal, so if you change it,\n-- make sure you update Cabal.  (Or, better yet, dump it in the\n-- compiler info so Cabal can use the info.)\nresolvePackageConfig dflags UserPkgConf = runMaybeT $ do\n  dir <- versionedAppDir dflags\n  let pkgconf = dir </> \"package.conf.d\"\n  exist <- tryMaybeT $ doesDirectoryExist pkgconf\n  if exist then return pkgconf else mzero\nresolvePackageConfig _ (PkgConfFile name) = return $ Just name\n\nreadPackageConfig :: DynFlags -> FilePath -> IO (FilePath, [PackageConfig])\nreadPackageConfig dflags conf_file = do\n  isdir <- doesDirectoryExist conf_file\n\n  proto_pkg_configs <-\n    if isdir\n       then readDirStylePackageConfig conf_file\n       else do\n            isfile <- doesFileExist conf_file\n            if isfile\n               then do\n                 mpkgs <- tryReadOldFileStylePackageConfig\n                 case mpkgs of\n                   Just pkgs -> return pkgs\n                   Nothing   -> throwGhcExceptionIO $ InstallationError $\n                      \"ghc no longer supports single-file style package \" ++\n                      \"databases (\" ++ conf_file ++\n                      \") use 'ghc-pkg init' to create the database with \" ++\n                      \"the correct format.\"\n               else throwGhcExceptionIO $ InstallationError $\n                      \"can't find a package database at \" ++ conf_file\n\n  let\n      top_dir = topDir dflags\n      pkgroot = takeDirectory conf_file\n      pkg_configs1 = map (mungePackageConfig top_dir pkgroot)\n                         proto_pkg_configs\n      pkg_configs2 = setBatchPackageFlags dflags pkg_configs1\n  --\n  return (conf_file, pkg_configs2)\n  where\n    readDirStylePackageConfig conf_dir = do\n      let filename = conf_dir </> \"package.cache\"\n      cache_exists <- doesFileExist filename\n      if cache_exists\n        then do\n          debugTraceMsg dflags 2 $ text \"Using binary package database:\"\n                                    <+> text filename\n          readPackageDbForGhc filename\n        else do\n          -- If there is no package.cache file, we check if the database is not\n          -- empty by inspecting if the directory contains any .conf file. If it\n          -- does, something is wrong and we fail. Otherwise we assume that the\n          -- database is empty.\n          debugTraceMsg dflags 2 $ text \"There is no package.cache in\"\n                               <+> text conf_dir\n                                <> text \", checking if the database is empty\"\n          db_empty <- all (not . isSuffixOf \".conf\")\n                   <$> getDirectoryContents conf_dir\n          if db_empty\n            then do\n              debugTraceMsg dflags 3 $ text \"There are no .conf files in\"\n                                   <+> text conf_dir <> text \", treating\"\n                                   <+> text \"package database as empty\"\n              return []\n            else do\n              throwGhcExceptionIO $ InstallationError $\n                \"there is no package.cache in \" ++ conf_dir ++\n                \" even though package database is not empty\"\n\n\n    -- Single-file style package dbs have been deprecated for some time, but\n    -- it turns out that Cabal was using them in one place. So this is a\n    -- workaround to allow older Cabal versions to use this newer ghc.\n    -- We check if the file db contains just \"[]\" and if so, we look for a new\n    -- dir-style db in conf_file.d/, ie in a dir next to the given file.\n    -- We cannot just replace the file with a new dir style since Cabal still\n    -- assumes it's a file and tries to overwrite with 'writeFile'.\n    -- ghc-pkg also cooperates with this workaround.\n    tryReadOldFileStylePackageConfig = do\n      content <- readFile conf_file `catchIO` \\_ -> return \"\"\n      if take 2 content == \"[]\"\n        then do\n          let conf_dir = conf_file <.> \"d\"\n          direxists <- doesDirectoryExist conf_dir\n          if direxists\n             then do debugTraceMsg dflags 2 (text \"Ignoring old file-style db and trying:\" <+> text conf_dir)\n                     liftM Just (readDirStylePackageConfig conf_dir)\n             else return (Just []) -- ghc-pkg will create it when it's updated\n        else return Nothing\n\nsetBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]\nsetBatchPackageFlags dflags pkgs = maybeDistrustAll pkgs\n  where\n    maybeDistrustAll pkgs'\n      | gopt Opt_DistrustAllPackages dflags = map distrust pkgs'\n      | otherwise                           = pkgs'\n\n    distrust pkg = pkg{ trusted = False }\n\nmungePackageConfig :: FilePath -> FilePath\n                   -> PackageConfig -> PackageConfig\nmungePackageConfig top_dir pkgroot =\n    mungeDynLibFields\n  . mungePackagePaths top_dir pkgroot\n\nmungeDynLibFields :: PackageConfig -> PackageConfig\nmungeDynLibFields pkg =\n    pkg {\n      libraryDynDirs     = libraryDynDirs pkg\n                `orIfNull` libraryDirs pkg\n    }\n  where\n    orIfNull [] flags = flags\n    orIfNull flags _  = flags\n\n-- TODO: This code is duplicated in utils/ghc-pkg/Main.hs\nmungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig\n-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec\n-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)\n-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.\n-- The \"pkgroot\" is the directory containing the package database.\n--\n-- Also perform a similar substitution for the older GHC-specific\n-- \"$topdir\" variable. The \"topdir\" is the location of the ghc\n-- installation (obtained from the -B option).\nmungePackagePaths top_dir pkgroot pkg =\n    pkg {\n      importDirs  = munge_paths (importDirs pkg),\n      includeDirs = munge_paths (includeDirs pkg),\n      libraryDirs = munge_paths (libraryDirs pkg),\n      libraryDynDirs = munge_paths (libraryDynDirs pkg),\n      frameworkDirs = munge_paths (frameworkDirs pkg),\n      haddockInterfaces = munge_paths (haddockInterfaces pkg),\n      haddockHTMLs = munge_urls (haddockHTMLs pkg)\n    }\n  where\n    munge_paths = map munge_path\n    munge_urls  = map munge_url\n\n    munge_path p\n      | Just p' <- stripVarPrefix \"${pkgroot}\" p = pkgroot ++ p'\n      | Just p' <- stripVarPrefix \"$topdir\"    p = top_dir ++ p'\n      | otherwise                                = p\n\n    munge_url p\n      | Just p' <- stripVarPrefix \"${pkgrooturl}\" p = toUrlPath pkgroot p'\n      | Just p' <- stripVarPrefix \"$httptopdir\"   p = toUrlPath top_dir p'\n      | otherwise                                   = p\n\n    toUrlPath r p = \"file:///\"\n                 -- URLs always use posix style '/' separators:\n                 ++ FilePath.Posix.joinPath\n                        (r : -- We need to drop a leading \"/\" or \"\\\\\"\n                             -- if there is one:\n                             dropWhile (all isPathSeparator)\n                                       (FilePath.splitDirectories p))\n\n    -- We could drop the separator here, and then use </> above. However,\n    -- by leaving it in and using ++ we keep the same path separator\n    -- rather than letting FilePath change it to use \\ as the separator\n    stripVarPrefix var path = case stripPrefix var path of\n                              Just [] -> Just []\n                              Just cs@(c : _) | isPathSeparator c -> Just cs\n                              _ -> Nothing\n\n\n-- -----------------------------------------------------------------------------\n-- Modify our copy of the package database based on trust flags,\n-- -trust and -distrust.\n\napplyTrustFlag\n   :: DynFlags\n   -> PackagePrecedenceIndex\n   -> UnusablePackages\n   -> [PackageConfig]\n   -> TrustFlag\n   -> IO [PackageConfig]\napplyTrustFlag dflags prec_map unusable pkgs flag =\n  case flag of\n    -- we trust all matching packages. Maybe should only trust first one?\n    -- and leave others the same or set them untrusted\n    TrustPackage str ->\n       case selectPackages prec_map (PackageArg str) pkgs unusable of\n         Left ps       -> trustFlagErr dflags flag ps\n         Right (ps,qs) -> return (map trust ps ++ qs)\n          where trust p = p {trusted=True}\n\n    DistrustPackage str ->\n       case selectPackages prec_map (PackageArg str) pkgs unusable of\n         Left ps       -> trustFlagErr dflags flag ps\n         Right (ps,qs) -> return (map distrust ps ++ qs)\n          where distrust p = p {trusted=False}\n\n-- | A little utility to tell if the 'thisPackage' is indefinite\n-- (if it is not, we should never use on-the-fly renaming.)\nisIndefinite :: DynFlags -> Bool\nisIndefinite dflags = not (unitIdIsDefinite (thisPackage dflags))\n\napplyPackageFlag\n   :: DynFlags\n   -> PackagePrecedenceIndex\n   -> PackageConfigMap\n   -> UnusablePackages\n   -> Bool -- if False, if you expose a package, it implicitly hides\n           -- any previously exposed packages with the same name\n   -> [PackageConfig]\n   -> VisibilityMap           -- Initially exposed\n   -> PackageFlag               -- flag to apply\n   -> IO VisibilityMap        -- Now exposed\n\napplyPackageFlag dflags prec_map pkg_db unusable no_hide_others pkgs vm flag =\n  case flag of\n    ExposePackage _ arg (ModRenaming b rns) ->\n       case findPackages prec_map pkg_db arg pkgs unusable of\n         Left ps         -> packageFlagErr dflags flag ps\n         Right (p:_) -> return vm'\n          where\n           n = fsPackageName p\n\n           -- If a user says @-unit-id p[A=<A>]@, this imposes\n           -- a requirement on us: whatever our signature A is,\n           -- it must fulfill all of p[A=<A>]:A's requirements.\n           -- This method is responsible for computing what our\n           -- inherited requirements are.\n           reqs | UnitIdArg orig_uid <- arg = collectHoles orig_uid\n                | otherwise                 = Map.empty\n\n           collectHoles uid = case splitUnitIdInsts uid of\n                (_, Just indef) ->\n                  let local = [ Map.singleton\n                                  (moduleName mod)\n                                  (Set.singleton $ IndefModule indef mod_name)\n                              | (mod_name, mod) <- indefUnitIdInsts indef\n                              , isHoleModule mod ]\n                      recurse = [ collectHoles (moduleUnitId mod)\n                                | (_, mod) <- indefUnitIdInsts indef ]\n                  in Map.unionsWith Set.union $ local ++ recurse\n                -- Other types of unit identities don't have holes\n                (_, Nothing) -> Map.empty\n\n\n           uv = UnitVisibility\n                { uv_expose_all = b\n                , uv_renamings = rns\n                , uv_package_name = First (Just n)\n                , uv_requirements = reqs\n                , uv_explicit = True\n                }\n           vm' = Map.insertWith mappend (packageConfigId p) uv vm_cleared\n           -- In the old days, if you said `ghc -package p-0.1 -package p-0.2`\n           -- (or if p-0.1 was registered in the pkgdb as exposed: True),\n           -- the second package flag would override the first one and you\n           -- would only see p-0.2 in exposed modules.  This is good for\n           -- usability.\n           --\n           -- However, with thinning and renaming (or Backpack), there might be\n           -- situations where you legitimately want to see two versions of a\n           -- package at the same time, and this behavior would make it\n           -- impossible to do so.  So we decided that if you pass\n           -- -hide-all-packages, this should turn OFF the overriding behavior\n           -- where an exposed package hides all other packages with the same\n           -- name.  This should not affect Cabal at all, which only ever\n           -- exposes one package at a time.\n           --\n           -- NB: Why a variable no_hide_others?  We have to apply this logic to\n           -- -plugin-package too, and it's more consistent if the switch in\n           -- behavior is based off of\n           -- -hide-all-packages/-hide-all-plugin-packages depending on what\n           -- flag is in question.\n           vm_cleared | no_hide_others = vm\n                      -- NB: renamings never clear\n                      | (_:_) <- rns = vm\n                      | otherwise = Map.filterWithKey\n                            (\\k uv -> k == packageConfigId p\n                                   || First (Just n) /= uv_package_name uv) vm\n         _ -> panic \"applyPackageFlag\"\n\n    HidePackage str ->\n       case findPackages prec_map pkg_db (PackageArg str) pkgs unusable of\n         Left ps  -> packageFlagErr dflags flag ps\n         Right ps -> return vm'\n          where vm' = foldl' (flip Map.delete) vm (map packageConfigId ps)\n\n-- | Like 'selectPackages', but doesn't return a list of unmatched\n-- packages.  Furthermore, any packages it returns are *renamed*\n-- if the 'UnitArg' has a renaming associated with it.\nfindPackages :: PackagePrecedenceIndex\n             -> PackageConfigMap -> PackageArg -> [PackageConfig]\n             -> UnusablePackages\n             -> Either [(PackageConfig, UnusablePackageReason)]\n                [PackageConfig]\nfindPackages prec_map pkg_db arg pkgs unusable\n  = let ps = mapMaybe (finder arg) pkgs\n    in if null ps\n        then Left (mapMaybe (\\(x,y) -> finder arg x >>= \\x' -> return (x',y))\n                            (Map.elems unusable))\n        else Right (sortByPreference prec_map ps)\n  where\n    finder (PackageArg str) p\n      = if str == sourcePackageIdString p || str == packageNameString p\n          then Just p\n          else Nothing\n    finder (UnitIdArg uid) p\n      = let (iuid, mb_indef) = splitUnitIdInsts uid\n        in if iuid == installedPackageConfigId p\n              then Just (case mb_indef of\n                            Nothing    -> p\n                            Just indef -> renamePackage pkg_db (indefUnitIdInsts indef) p)\n              else Nothing\n\nselectPackages :: PackagePrecedenceIndex -> PackageArg -> [PackageConfig]\n               -> UnusablePackages\n               -> Either [(PackageConfig, UnusablePackageReason)]\n                  ([PackageConfig], [PackageConfig])\nselectPackages prec_map arg pkgs unusable\n  = let matches = matching arg\n        (ps,rest) = partition matches pkgs\n    in if null ps\n        then Left (filter (matches.fst) (Map.elems unusable))\n        else Right (sortByPreference prec_map ps, rest)\n\n-- | Rename a 'PackageConfig' according to some module instantiation.\nrenamePackage :: PackageConfigMap -> [(ModuleName, Module)]\n              -> PackageConfig -> PackageConfig\nrenamePackage pkg_map insts conf =\n    let hsubst = listToUFM insts\n        smod  = renameHoleModule' pkg_map hsubst\n        new_insts = map (\\(k,v) -> (k,smod v)) (instantiatedWith conf)\n    in conf {\n        instantiatedWith = new_insts,\n        exposedModules = map (\\(mod_name, mb_mod) -> (mod_name, fmap smod mb_mod))\n                             (exposedModules conf)\n    }\n\n\n-- A package named on the command line can either include the\n-- version, or just the name if it is unambiguous.\nmatchingStr :: String -> PackageConfig -> Bool\nmatchingStr str p\n        =  str == sourcePackageIdString p\n        || str == packageNameString p\n\nmatchingId :: InstalledUnitId -> PackageConfig -> Bool\nmatchingId uid p = uid == installedPackageConfigId p\n\nmatching :: PackageArg -> PackageConfig -> Bool\nmatching (PackageArg str) = matchingStr str\nmatching (UnitIdArg (DefiniteUnitId (DefUnitId uid)))  = matchingId uid\nmatching (UnitIdArg _)  = \\_ -> False -- TODO: warn in this case\n\n-- | This sorts a list of packages, putting \"preferred\" packages first.\n-- See 'compareByPreference' for the semantics of \"preference\".\nsortByPreference :: PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]\nsortByPreference prec_map = sortBy (flip (compareByPreference prec_map))\n\n-- | Returns 'GT' if @pkg@ should be preferred over @pkg'@ when picking\n-- which should be \"active\".  Here is the order of preference:\n--\n--      1. First, prefer the latest version\n--      2. If the versions are the same, prefer the package that\n--      came in the latest package database.\n--\n-- Pursuant to #12518, we could change this policy to, for example, remove\n-- the version preference, meaning that we would always prefer the packages\n-- in later package database.\n--\n-- Instead, we use that preference based policy only when one of the packages\n-- is integer-gmp and the other is integer-simple.\n-- This currently only happens when we're looking up which concrete\n-- package to use in place of @integer-wired-in@ and that two different\n-- package databases supply a different integer library. For more about\n-- the fake @integer-wired-in@ package, see Note [The integer library]\n-- in the @PrelNames@ module.\ncompareByPreference\n    :: PackagePrecedenceIndex\n    -> PackageConfig\n    -> PackageConfig\n    -> Ordering\ncompareByPreference prec_map pkg pkg'\n  | Just prec  <- Map.lookup (unitId pkg)  prec_map\n  , Just prec' <- Map.lookup (unitId pkg') prec_map\n  , differentIntegerPkgs pkg pkg'\n  = compare prec prec'\n\n  | otherwise\n  = case comparing packageVersion pkg pkg' of\n        GT -> GT\n        EQ | Just prec  <- Map.lookup (unitId pkg)  prec_map\n           , Just prec' <- Map.lookup (unitId pkg') prec_map\n           -- Prefer the package from the later DB flag (i.e., higher\n           -- precedence)\n           -> compare prec prec'\n           | otherwise\n           -> EQ\n        LT -> LT\n\n  where isIntegerPkg p = packageNameString p `elem`\n          [\"integer-simple\", \"integer-gmp\"]\n        differentIntegerPkgs p p' =\n          isIntegerPkg p && isIntegerPkg p' &&\n          (packageName p /= packageName p')\n\ncomparing :: Ord a => (t -> a) -> t -> t -> Ordering\ncomparing f a b = f a `compare` f b\n\npackageFlagErr :: DynFlags\n               -> PackageFlag\n               -> [(PackageConfig, UnusablePackageReason)]\n               -> IO a\npackageFlagErr dflags flag reasons\n  = packageFlagErr' dflags (pprFlag flag) reasons\n\ntrustFlagErr :: DynFlags\n             -> TrustFlag\n             -> [(PackageConfig, UnusablePackageReason)]\n             -> IO a\ntrustFlagErr dflags flag reasons\n  = packageFlagErr' dflags (pprTrustFlag flag) reasons\n\npackageFlagErr' :: DynFlags\n               -> SDoc\n               -> [(PackageConfig, UnusablePackageReason)]\n               -> IO a\npackageFlagErr' dflags flag_doc reasons\n  = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))\n  where err = text \"cannot satisfy \" <> flag_doc <>\n                (if null reasons then Outputable.empty else text \": \") $$\n              nest 4 (ppr_reasons $$\n                      text \"(use -v for more information)\")\n        ppr_reasons = vcat (map ppr_reason reasons)\n        ppr_reason (p, reason) =\n            pprReason (ppr (unitId p) <+> text \"is\") reason\n\npprFlag :: PackageFlag -> SDoc\npprFlag flag = case flag of\n    HidePackage p   -> text \"-hide-package \" <> text p\n    ExposePackage doc _ _ -> text doc\n\npprTrustFlag :: TrustFlag -> SDoc\npprTrustFlag flag = case flag of\n    TrustPackage p    -> text \"-trust \" <> text p\n    DistrustPackage p -> text \"-distrust \" <> text p\n\n-- -----------------------------------------------------------------------------\n-- Wired-in packages\n--\n-- See Note [Wired-in packages] in Module\n\ntype WiredInUnitId = String\ntype WiredPackagesMap = Map WiredUnitId WiredUnitId\n\nwired_in_pkgids :: [WiredInUnitId]\nwired_in_pkgids = map unitIdString wiredInUnitIds\n\nfindWiredInPackages\n   :: DynFlags\n   -> PackagePrecedenceIndex\n   -> [PackageConfig]           -- database\n   -> VisibilityMap             -- info on what packages are visible\n                                -- for wired in selection\n   -> IO ([PackageConfig],  -- package database updated for wired in\n          WiredPackagesMap) -- map from unit id to wired identity\n\nfindWiredInPackages dflags prec_map pkgs vis_map = do\n  -- Now we must find our wired-in packages, and rename them to\n  -- their canonical names (eg. base-1.0 ==> base), as described\n  -- in Note [Wired-in packages] in Module\n  let\n        matches :: PackageConfig -> WiredInUnitId -> Bool\n        pc `matches` pid\n            -- See Note [The integer library] in PrelNames\n            | pid == unitIdString integerUnitId\n            = packageNameString pc `elem` [\"integer-gmp\", \"integer-simple\"]\n        pc `matches` pid = packageNameString pc == pid\n\n        -- find which package corresponds to each wired-in package\n        -- delete any other packages with the same name\n        -- update the package and any dependencies to point to the new\n        -- one.\n        --\n        -- When choosing which package to map to a wired-in package\n        -- name, we try to pick the latest version of exposed packages.\n        -- However, if there are no exposed wired in packages available\n        -- (e.g. -hide-all-packages was used), we can't bail: we *have*\n        -- to assign a package for the wired-in package: so we try again\n        -- with hidden packages included to (and pick the latest\n        -- version).\n        --\n        -- You can also override the default choice by using -ignore-package:\n        -- this works even when there is no exposed wired in package\n        -- available.\n        --\n        findWiredInPackage :: [PackageConfig] -> WiredInUnitId\n                           -> IO (Maybe (WiredInUnitId, PackageConfig))\n        findWiredInPackage pkgs wired_pkg =\n           let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ]\n               all_exposed_ps =\n                    [ p | p <- all_ps\n                        , Map.member (packageConfigId p) vis_map ] in\n           case all_exposed_ps of\n            [] -> case all_ps of\n                       []   -> notfound\n                       many -> pick (head (sortByPreference prec_map many))\n            many -> pick (head (sortByPreference prec_map many))\n          where\n                notfound = do\n                          debugTraceMsg dflags 2 $\n                            text \"wired-in package \"\n                                 <> text wired_pkg\n                                 <> text \" not found.\"\n                          return Nothing\n                pick :: PackageConfig\n                     -> IO (Maybe (WiredInUnitId, PackageConfig))\n                pick pkg = do\n                        debugTraceMsg dflags 2 $\n                            text \"wired-in package \"\n                                 <> text wired_pkg\n                                 <> text \" mapped to \"\n                                 <> ppr (unitId pkg)\n                        return (Just (wired_pkg, pkg))\n\n\n  mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_pkgids\n  let\n        wired_in_pkgs = catMaybes mb_wired_in_pkgs\n\n        -- this is old: we used to assume that if there were\n        -- multiple versions of wired-in packages installed that\n        -- they were mutually exclusive.  Now we're assuming that\n        -- you have one \"main\" version of each wired-in package\n        -- (the latest version), and the others are backward-compat\n        -- wrappers that depend on this one.  e.g. base-4.0 is the\n        -- latest, base-3.0 is a compat wrapper depending on base-4.0.\n        {-\n        deleteOtherWiredInPackages pkgs = filterOut bad pkgs\n          where bad p = any (p `matches`) wired_in_pkgids\n                      && package p `notElem` map fst wired_in_ids\n        -}\n\n        wiredInMap :: Map WiredUnitId WiredUnitId\n        wiredInMap = Map.fromList\n          [ (key, DefUnitId (stringToInstalledUnitId wiredInUnitId))\n          | (wiredInUnitId, pkg) <- wired_in_pkgs\n          , Just key <- pure $ definitePackageConfigId pkg\n          ]\n\n        updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs\n          where upd_pkg pkg\n                  | Just def_uid <- definitePackageConfigId pkg\n                  , Just wiredInUnitId <- Map.lookup def_uid wiredInMap\n                  = let fs = installedUnitIdFS (unDefUnitId wiredInUnitId)\n                    in pkg {\n                      unitId = fsToInstalledUnitId fs,\n                      componentId = ComponentId fs\n                    }\n                  | otherwise\n                  = pkg\n                upd_deps pkg = pkg {\n                      -- temporary harmless DefUnitId invariant violation\n                      depends = map (unDefUnitId . upd_wired_in wiredInMap . DefUnitId) (depends pkg),\n                      exposedModules\n                        = map (\\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v))\n                              (exposedModules pkg)\n                    }\n\n\n  return (updateWiredInDependencies pkgs, wiredInMap)\n\n-- Helper functions for rewiring Module and UnitId.  These\n-- rewrite UnitIds of modules in wired-in packages to the form known to the\n-- compiler, as described in Note [Wired-in packages] in Module.\n--\n-- For instance, base-4.9.0.0 will be rewritten to just base, to match\n-- what appears in PrelNames.\n\nupd_wired_in_mod :: WiredPackagesMap -> Module -> Module\nupd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m\n\nupd_wired_in_uid :: WiredPackagesMap -> UnitId -> UnitId\nupd_wired_in_uid wiredInMap (DefiniteUnitId def_uid) =\n    DefiniteUnitId (upd_wired_in wiredInMap def_uid)\nupd_wired_in_uid wiredInMap (IndefiniteUnitId indef_uid) =\n    IndefiniteUnitId $ newIndefUnitId\n        (indefUnitIdComponentId indef_uid)\n        (map (\\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (indefUnitIdInsts indef_uid))\n\nupd_wired_in :: WiredPackagesMap -> DefUnitId -> DefUnitId\nupd_wired_in wiredInMap key\n    | Just key' <- Map.lookup key wiredInMap = key'\n    | otherwise = key\n\nupdateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap\nupdateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)\n  where f vm (from, to) = case Map.lookup (DefiniteUnitId from) vis_map of\n                    Nothing -> vm\n                    Just r -> Map.insert (DefiniteUnitId to) r\n                                (Map.delete (DefiniteUnitId from) vm)\n\n\n-- ----------------------------------------------------------------------------\n\n-- | The reason why a package is unusable.\ndata UnusablePackageReason\n  = -- | We ignored it explicitly using @-ignore-package@.\n    IgnoredWithFlag\n    -- | This package transitively depends on a package that was never present\n    -- in any of the provided databases.\n  | BrokenDependencies   [InstalledUnitId]\n    -- | This package transitively depends on a package involved in a cycle.\n    -- Note that the list of 'InstalledUnitId' reports the direct dependencies\n    -- of this package that (transitively) depended on the cycle, and not\n    -- the actual cycle itself (which we report separately at high verbosity.)\n  | CyclicDependencies   [InstalledUnitId]\n    -- | This package transitively depends on a package which was ignored.\n  | IgnoredDependencies  [InstalledUnitId]\n    -- | This package transitively depends on a package which was\n    -- shadowed by an ABI-incompatible package.\n  | ShadowedDependencies [InstalledUnitId]\n\ninstance Outputable UnusablePackageReason where\n    ppr IgnoredWithFlag = text \"[ignored with flag]\"\n    ppr (BrokenDependencies uids)   = brackets (text \"broken\" <+> ppr uids)\n    ppr (CyclicDependencies uids)   = brackets (text \"cyclic\" <+> ppr uids)\n    ppr (IgnoredDependencies uids)  = brackets (text \"ignored\" <+> ppr uids)\n    ppr (ShadowedDependencies uids) = brackets (text \"shadowed\" <+> ppr uids)\n\ntype UnusablePackages = Map InstalledUnitId\n                            (PackageConfig, UnusablePackageReason)\n\npprReason :: SDoc -> UnusablePackageReason -> SDoc\npprReason pref reason = case reason of\n  IgnoredWithFlag ->\n      pref <+> text \"ignored due to an -ignore-package flag\"\n  BrokenDependencies deps ->\n      pref <+> text \"unusable due to missing dependencies:\" $$\n        nest 2 (hsep (map ppr deps))\n  CyclicDependencies deps ->\n      pref <+> text \"unusable due to cyclic dependencies:\" $$\n        nest 2 (hsep (map ppr deps))\n  IgnoredDependencies deps ->\n      pref <+> text (\"unusable because the -ignore-package flag was used to \" ++\n                     \"ignore at least one of its dependencies:\") $$\n        nest 2 (hsep (map ppr deps))\n  ShadowedDependencies deps ->\n      pref <+> text \"unusable due to shadowed dependencies:\" $$\n        nest 2 (hsep (map ppr deps))\n\nreportCycles :: DynFlags -> [SCC PackageConfig] -> IO ()\nreportCycles dflags sccs = mapM_ report sccs\n  where\n    report (AcyclicSCC _) = return ()\n    report (CyclicSCC vs) =\n        debugTraceMsg dflags 2 $\n          text \"these packages are involved in a cycle:\" $$\n            nest 2 (hsep (map (ppr . unitId) vs))\n\nreportUnusable :: DynFlags -> UnusablePackages -> IO ()\nreportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)\n  where\n    report (ipid, (_, reason)) =\n       debugTraceMsg dflags 2 $\n         pprReason\n           (text \"package\" <+> ppr ipid <+> text \"is\") reason\n\n-- ----------------------------------------------------------------------------\n--\n-- Utilities on the database\n--\n\n-- | A reverse dependency index, mapping an 'InstalledUnitId' to\n-- the 'InstalledUnitId's which have a dependency on it.\ntype RevIndex = Map InstalledUnitId [InstalledUnitId]\n\n-- | Compute the reverse dependency index of a package database.\nreverseDeps :: InstalledPackageIndex -> RevIndex\nreverseDeps db = Map.foldl' go Map.empty db\n  where\n    go r pkg = foldl' (go' (unitId pkg)) r (depends pkg)\n    go' from r to = Map.insertWith (++) to [from] r\n\n-- | Given a list of 'InstalledUnitId's to remove, a database,\n-- and a reverse dependency index (as computed by 'reverseDeps'),\n-- remove those packages, plus any packages which depend on them.\n-- Returns the pruned database, as well as a list of 'PackageConfig's\n-- that was removed.\nremovePackages :: [InstalledUnitId] -> RevIndex\n               -> InstalledPackageIndex\n               -> (InstalledPackageIndex, [PackageConfig])\nremovePackages uids index m = go uids (m,[])\n  where\n    go [] (m,pkgs) = (m,pkgs)\n    go (uid:uids) (m,pkgs)\n        | Just pkg <- Map.lookup uid m\n        = case Map.lookup uid index of\n            Nothing    -> go uids (Map.delete uid m, pkg:pkgs)\n            Just rdeps -> go (rdeps ++ uids) (Map.delete uid m, pkg:pkgs)\n        | otherwise\n        = go uids (m,pkgs)\n\n-- | Given a 'PackageConfig' from some 'InstalledPackageIndex',\n-- return all entries in 'depends' which correspond to packages\n-- that do not exist in the index.\ndepsNotAvailable :: InstalledPackageIndex\n                 -> PackageConfig\n                 -> [InstalledUnitId]\ndepsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (depends pkg)\n\n-- | Given a 'PackageConfig' from some 'InstalledPackageIndex'\n-- return all entries in 'abiDepends' which correspond to packages\n-- that do not exist, OR have mismatching ABIs.\ndepsAbiMismatch :: InstalledPackageIndex\n                -> PackageConfig\n                -> [InstalledUnitId]\ndepsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ abiDepends pkg\n  where\n    abiMatch (dep_uid, abi)\n        | Just dep_pkg <- Map.lookup dep_uid pkg_map\n        = abiHash dep_pkg == abi\n        | otherwise\n        = False\n\n-- -----------------------------------------------------------------------------\n-- Ignore packages\n\nignorePackages :: [IgnorePackageFlag] -> [PackageConfig] -> UnusablePackages\nignorePackages flags pkgs = Map.fromList (concatMap doit flags)\n  where\n  doit (IgnorePackage str) =\n     case partition (matchingStr str) pkgs of\n         (ps, _) -> [ (unitId p, (p, IgnoredWithFlag))\n                    | p <- ps ]\n        -- missing package is not an error for -ignore-package,\n        -- because a common usage is to -ignore-package P as\n        -- a preventative measure just in case P exists.\n\n-- ----------------------------------------------------------------------------\n--\n-- Merging databases\n--\n\n-- | For each package, a mapping from uid -> i indicates that this\n-- package was brought into GHC by the ith @-package-db@ flag on\n-- the command line.  We use this mapping to make sure we prefer\n-- packages that were defined later on the command line, if there\n-- is an ambiguity.\ntype PackagePrecedenceIndex = Map InstalledUnitId Int\n\n-- | Given a list of databases, merge them together, where\n-- packages with the same unit id in later databases override\n-- earlier ones.  This does NOT check if the resulting database\n-- makes sense (that's done by 'validateDatabase').\nmergeDatabases :: DynFlags -> [(FilePath, [PackageConfig])]\n               -> IO (InstalledPackageIndex, PackagePrecedenceIndex)\nmergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]\n  where\n    merge (pkg_map, prec_map) (i, (db_path, db)) = do\n      debugTraceMsg dflags 2 $\n          text \"loading package database\" <+> text db_path\n      forM_ (Set.toList override_set) $ \\pkg ->\n          debugTraceMsg dflags 2 $\n              text \"package\" <+> ppr pkg <+>\n              text \"overrides a previously defined package\"\n      return (pkg_map', prec_map')\n     where\n      db_map = mk_pkg_map db\n      mk_pkg_map = Map.fromList . map (\\p -> (unitId p, p))\n\n      -- The set of UnitIds which appear in both db and pkgs.  These are the\n      -- ones that get overridden.  Compute this just to give some\n      -- helpful debug messages at -v2\n      override_set :: Set InstalledUnitId\n      override_set = Set.intersection (Map.keysSet db_map)\n                                      (Map.keysSet pkg_map)\n\n      -- Now merge the sets together (NB: in case of duplicate,\n      -- first argument preferred)\n      pkg_map' :: InstalledPackageIndex\n      pkg_map' = Map.union db_map pkg_map\n\n      prec_map' :: PackagePrecedenceIndex\n      prec_map' = Map.union (Map.map (const i) db_map) prec_map\n\n-- | Validates a database, removing unusable packages from it\n-- (this includes removing packages that the user has explicitly\n-- ignored.)  Our general strategy:\n--\n-- 1. Remove all broken packages (dangling dependencies)\n-- 2. Remove all packages that are cyclic\n-- 3. Apply ignore flags\n-- 4. Remove all packages which have deps with mismatching ABIs\n--\nvalidateDatabase :: DynFlags -> InstalledPackageIndex\n                 -> (InstalledPackageIndex, UnusablePackages, [SCC PackageConfig])\nvalidateDatabase dflags pkg_map1 =\n    (pkg_map5, unusable, sccs)\n  where\n    ignore_flags = reverse (ignorePackageFlags dflags)\n\n    -- Compute the reverse dependency index\n    index = reverseDeps pkg_map1\n\n    -- Helper function\n    mk_unusable mk_err dep_matcher m uids =\n      Map.fromList [ (unitId pkg, (pkg, mk_err (dep_matcher m pkg)))\n                   | pkg <- uids ]\n\n    -- Find broken packages\n    directly_broken = filter (not . null . depsNotAvailable pkg_map1)\n                             (Map.elems pkg_map1)\n    (pkg_map2, broken) = removePackages (map unitId directly_broken) index pkg_map1\n    unusable_broken = mk_unusable BrokenDependencies depsNotAvailable pkg_map2 broken\n\n    -- Find recursive packages\n    sccs = stronglyConnComp [ (pkg, unitId pkg, depends pkg)\n                            | pkg <- Map.elems pkg_map2 ]\n    getCyclicSCC (CyclicSCC vs) = map unitId vs\n    getCyclicSCC (AcyclicSCC _) = []\n    (pkg_map3, cyclic) = removePackages (concatMap getCyclicSCC sccs) index pkg_map2\n    unusable_cyclic = mk_unusable CyclicDependencies depsNotAvailable pkg_map3 cyclic\n\n    -- Apply ignore flags\n    directly_ignored = ignorePackages ignore_flags (Map.elems pkg_map3)\n    (pkg_map4, ignored) = removePackages (Map.keys directly_ignored) index pkg_map3\n    unusable_ignored = mk_unusable IgnoredDependencies depsNotAvailable pkg_map4 ignored\n\n    -- Knock out packages whose dependencies don't agree with ABI\n    -- (i.e., got invalidated due to shadowing)\n    directly_shadowed = filter (not . null . depsAbiMismatch pkg_map4)\n                               (Map.elems pkg_map4)\n    (pkg_map5, shadowed) = removePackages (map unitId directly_shadowed) index pkg_map4\n    unusable_shadowed = mk_unusable ShadowedDependencies depsAbiMismatch pkg_map5 shadowed\n\n    unusable = directly_ignored `Map.union` unusable_ignored\n                                `Map.union` unusable_broken\n                                `Map.union` unusable_cyclic\n                                `Map.union` unusable_shadowed\n\n-- -----------------------------------------------------------------------------\n-- When all the command-line options are in, we can process our package\n-- settings and populate the package state.\n\nmkPackageState\n    :: DynFlags\n    -- initial databases, in the order they were specified on\n    -- the command line (later databases shadow earlier ones)\n    -> [(FilePath, [PackageConfig])]\n    -> [PreloadUnitId]              -- preloaded packages\n    -> IO (PackageState,\n           [PreloadUnitId],         -- new packages to preload\n           Maybe [(ModuleName, Module)])\n\nmkPackageState dflags dbs preload0 = do\n{-\n   Plan.\n\n   There are two main steps for making the package state:\n\n    1. We want to build a single, unified package database based\n       on all of the input databases, which upholds the invariant that\n       there is only one package per any UnitId and there are no\n       dangling dependencies.  We'll do this by merging, and\n       then successively filtering out bad dependencies.\n\n       a) Merge all the databases together.\n          If an input database defines unit ID that is already in\n          the unified database, that package SHADOWS the existing\n          package in the current unified database.  Note that\n          order is important: packages defined later in the list of\n          command line arguments shadow those defined earlier.\n\n       b) Remove all packages with missing dependencies, or\n          mutually recursive dependencies.\n\n       b) Remove packages selected by -ignore-package from input database\n\n       c) Remove all packages which depended on packages that are now\n          shadowed by an ABI-incompatible package\n\n       d) report (with -v) any packages that were removed by steps 1-3\n\n    2. We want to look at the flags controlling package visibility,\n       and build a mapping of what module names are in scope and\n       where they live.\n\n       a) on the final, unified database, we apply -trust/-distrust\n          flags directly, modifying the database so that the 'trusted'\n          field has the correct value.\n\n       b) we use the -package/-hide-package flags to compute a\n          visibility map, stating what packages are \"exposed\" for\n          the purposes of computing the module map.\n          * if any flag refers to a package which was removed by 1-5, then\n            we can give an error message explaining why\n          * if -hide-all-packages what not specified, this step also\n            hides packages which are superseded by later exposed packages\n          * this step is done TWICE if -plugin-package/-hide-all-plugin-packages\n            are used\n\n       c) based on the visibility map, we pick wired packages and rewrite\n          them to have the expected unitId.\n\n       d) finally, using the visibility map and the package database,\n          we build a mapping saying what every in scope module name points to.\n-}\n\n  -- This, and the other reverse's that you will see, are due to the face that\n  -- packageFlags, pluginPackageFlags, etc. are all specified in *reverse* order\n  -- than they are on the command line.\n  let other_flags = reverse (packageFlags dflags)\n  debugTraceMsg dflags 2 $\n      text \"package flags\" <+> ppr other_flags\n\n  -- Merge databases together, without checking validity\n  (pkg_map1, prec_map) <- mergeDatabases dflags dbs\n\n  -- Now that we've merged everything together, prune out unusable\n  -- packages.\n  let (pkg_map2, unusable, sccs) = validateDatabase dflags pkg_map1\n\n  reportCycles dflags sccs\n  reportUnusable dflags unusable\n\n  -- Apply trust flags (these flags apply regardless of whether\n  -- or not packages are visible or not)\n  pkgs1 <- foldM (applyTrustFlag dflags prec_map unusable)\n                 (Map.elems pkg_map2) (reverse (trustFlags dflags))\n  let prelim_pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs1\n\n  --\n  -- Calculate the initial set of packages, prior to any package flags.\n  -- This set contains the latest version of all valid (not unusable) packages,\n  -- or is empty if we have -hide-all-packages\n  --\n  let preferLater pkg pkg' =\n        case compareByPreference prec_map pkg pkg' of\n            GT -> pkg\n            _  -> pkg'\n      calcInitial m pkg = addToUDFM_C preferLater m (fsPackageName pkg) pkg\n      initial = if gopt Opt_HideAllPackages dflags\n                    then emptyUDFM\n                    else foldl' calcInitial emptyUDFM pkgs1\n      vis_map1 = foldUDFM (\\p vm ->\n                            -- Note: we NEVER expose indefinite packages by\n                            -- default, because it's almost assuredly not\n                            -- what you want (no mix-in linking has occurred).\n                            if exposed p && unitIdIsDefinite (packageConfigId p)\n                               then Map.insert (packageConfigId p)\n                                               UnitVisibility {\n                                                 uv_expose_all = True,\n                                                 uv_renamings = [],\n                                                 uv_package_name = First (Just (fsPackageName p)),\n                                                 uv_requirements = Map.empty,\n                                                 uv_explicit = False\n                                               }\n                                               vm\n                               else vm)\n                         Map.empty initial\n\n  --\n  -- Compute a visibility map according to the command-line flags (-package,\n  -- -hide-package).  This needs to know about the unusable packages, since if a\n  -- user tries to enable an unusable package, we should let them know.\n  --\n  vis_map2 <- foldM (applyPackageFlag dflags prec_map prelim_pkg_db unusable\n                        (gopt Opt_HideAllPackages dflags) pkgs1)\n                            vis_map1 other_flags\n\n  --\n  -- Sort out which packages are wired in. This has to be done last, since\n  -- it modifies the unit ids of wired in packages, but when we process\n  -- package arguments we need to key against the old versions.\n  --\n  (pkgs2, wired_map) <- findWiredInPackages dflags prec_map pkgs1 vis_map2\n  let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs2\n\n  -- Update the visibility map, so we treat wired packages as visible.\n  let vis_map = updateVisibilityMap wired_map vis_map2\n\n  let hide_plugin_pkgs = gopt Opt_HideAllPluginPackages dflags\n  plugin_vis_map <-\n    case pluginPackageFlags dflags of\n        -- common case; try to share the old vis_map\n        [] | not hide_plugin_pkgs -> return vis_map\n           | otherwise -> return Map.empty\n        _ -> do let plugin_vis_map1\n                        | hide_plugin_pkgs = Map.empty\n                        -- Use the vis_map PRIOR to wired in,\n                        -- because otherwise applyPackageFlag\n                        -- won't work.\n                        | otherwise = vis_map2\n                plugin_vis_map2\n                    <- foldM (applyPackageFlag dflags prec_map prelim_pkg_db unusable\n                                (gopt Opt_HideAllPluginPackages dflags) pkgs1)\n                             plugin_vis_map1\n                             (reverse (pluginPackageFlags dflags))\n                -- Updating based on wired in packages is mostly\n                -- good hygiene, because it won't matter: no wired in\n                -- package has a compiler plugin.\n                -- TODO: If a wired in package had a compiler plugin,\n                -- and you tried to pick different wired in packages\n                -- with the plugin flags and the normal flags... what\n                -- would happen?  I don't know!  But this doesn't seem\n                -- likely to actually happen.\n                return (updateVisibilityMap wired_map plugin_vis_map2)\n\n  --\n  -- Here we build up a set of the packages mentioned in -package\n  -- flags on the command line; these are called the \"preload\"\n  -- packages.  we link these packages in eagerly.  The preload set\n  -- should contain at least rts & base, which is why we pretend that\n  -- the command line contains -package rts & -package base.\n  --\n  -- NB: preload IS important even for type-checking, because we\n  -- need the correct include path to be set.\n  --\n  let preload1 = Map.keys (Map.filter uv_explicit vis_map)\n\n  let pkgname_map = foldl' add Map.empty pkgs2\n        where add pn_map p\n                = Map.insert (packageName p) (componentId p) pn_map\n\n  -- The explicitPackages accurately reflects the set of packages we have turned\n  -- on; as such, it also is the only way one can come up with requirements.\n  -- The requirement context is directly based off of this: we simply\n  -- look for nested unit IDs that are directly fed holes: the requirements\n  -- of those units are precisely the ones we need to track\n  let explicit_pkgs = Map.keys vis_map\n      req_ctx = Map.map (Set.toList)\n              $ Map.unionsWith Set.union (map uv_requirements (Map.elems vis_map))\n\n\n  let preload2 = preload1\n\n  let\n      -- add base & rts to the preload packages\n      basicLinkedPackages\n       | gopt Opt_AutoLinkPackages dflags\n          = filter (flip elemUDFM (unPackageConfigMap pkg_db))\n                [baseUnitId, rtsUnitId]\n       | otherwise = []\n      -- but in any case remove the current package from the set of\n      -- preloaded packages so that base/rts does not end up in the\n      -- set up preloaded package when we are just building it\n      -- (NB: since this is only relevant for base/rts it doesn't matter\n      -- that thisUnitIdInsts_ is not wired yet)\n      --\n      preload3 = nub $ filter (/= thisPackage dflags)\n                     $ (basicLinkedPackages ++ preload2)\n\n  -- Close the preload packages with their dependencies\n  dep_preload <- closeDeps dflags pkg_db (zip (map toInstalledUnitId preload3) (repeat Nothing))\n  let new_dep_preload = filter (`notElem` preload0) dep_preload\n\n  let mod_map1 = mkModuleToPkgConfAll dflags pkg_db vis_map\n      mod_map2 = mkUnusableModuleToPkgConfAll unusable\n      mod_map = Map.union mod_map1 mod_map2\n\n  dumpIfSet_dyn (dflags { pprCols = 200 }) Opt_D_dump_mod_map \"Mod Map\"\n    (pprModuleMap mod_map)\n\n  -- Force pstate to avoid leaking the dflags0 passed to mkPackageState\n  let !pstate = PackageState{\n    preloadPackages     = dep_preload,\n    explicitPackages    = explicit_pkgs,\n    pkgIdMap            = pkg_db,\n    moduleToPkgConfAll  = mod_map,\n    pluginModuleToPkgConfAll = mkModuleToPkgConfAll dflags pkg_db plugin_vis_map,\n    packageNameMap          = pkgname_map,\n    unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ],\n    requirementContext = req_ctx\n    }\n  let new_insts = fmap (map (fmap (upd_wired_in_mod wired_map))) (thisUnitIdInsts_ dflags)\n  return (pstate, new_dep_preload, new_insts)\n\n-- | Given a wired-in 'UnitId', \"unwire\" it into the 'UnitId'\n-- that it was recorded as in the package database.\nunwireUnitId :: DynFlags -> UnitId -> UnitId\nunwireUnitId dflags uid@(DefiniteUnitId def_uid) =\n    maybe uid DefiniteUnitId (Map.lookup def_uid (unwireMap (pkgState dflags)))\nunwireUnitId _ uid = uid\n\n-- -----------------------------------------------------------------------------\n-- | Makes the mapping from module to package info\n\n-- Slight irritation: we proceed by leafing through everything\n-- in the installed package database, which makes handling indefinite\n-- packages a bit bothersome.\n\nmkModuleToPkgConfAll\n  :: DynFlags\n  -> PackageConfigMap\n  -> VisibilityMap\n  -> ModuleToPkgConfAll\nmkModuleToPkgConfAll dflags pkg_db vis_map =\n    -- What should we fold on?  Both situations are awkward:\n    --\n    --    * Folding on the visibility map means that we won't create\n    --      entries for packages that aren't mentioned in vis_map\n    --      (e.g., hidden packages, causing #14717)\n    --\n    --    * Folding on pkg_db is awkward because if we have an\n    --      Backpack instantiation, we need to possibly add a\n    --      package from pkg_db multiple times to the actual\n    --      ModuleToPkgConfAll.  Also, we don't really want\n    --      definite package instantiations to show up in the\n    --      list of possibilities.\n    --\n    -- So what will we do instead?  We'll extend vis_map with\n    -- entries for every definite (for non-Backpack) and\n    -- indefinite (for Backpack) package, so that we get the\n    -- hidden entries we need.\n    Map.foldlWithKey extend_modmap emptyMap vis_map_extended\n where\n  vis_map_extended = Map.union vis_map {- preferred -} default_vis\n\n  default_vis = Map.fromList\n                  [ (packageConfigId pkg, mempty)\n                  | pkg <- eltsUDFM (unPackageConfigMap pkg_db)\n                  -- Exclude specific instantiations of an indefinite\n                  -- package\n                  , indefinite pkg || null (instantiatedWith pkg)\n                  ]\n\n  emptyMap = Map.empty\n  setOrigins m os = fmap (const os) m\n  extend_modmap modmap uid\n    UnitVisibility { uv_expose_all = b, uv_renamings = rns }\n    = addListTo modmap theBindings\n   where\n    pkg = pkg_lookup uid\n\n    theBindings :: [(ModuleName, Map Module ModuleOrigin)]\n    theBindings = newBindings b rns\n\n    newBindings :: Bool\n                -> [(ModuleName, ModuleName)]\n                -> [(ModuleName, Map Module ModuleOrigin)]\n    newBindings e rns  = es e ++ hiddens ++ map rnBinding rns\n\n    rnBinding :: (ModuleName, ModuleName)\n              -> (ModuleName, Map Module ModuleOrigin)\n    rnBinding (orig, new) = (new, setOrigins origEntry fromFlag)\n     where origEntry = case lookupUFM esmap orig of\n            Just r -> r\n            Nothing -> throwGhcException (CmdLineError (showSDoc dflags\n                        (text \"package flag: could not find module name\" <+>\n                            ppr orig <+> text \"in package\" <+> ppr pk)))\n\n    es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]\n    es e = do\n     (m, exposedReexport) <- exposed_mods\n     let (pk', m', origin') =\n          case exposedReexport of\n           Nothing -> (pk, m, fromExposedModules e)\n           Just (Module pk' m') ->\n            let pkg' = pkg_lookup pk'\n            in (pk', m', fromReexportedModules e pkg')\n     return (m, mkModMap pk' m' origin')\n\n    esmap :: UniqFM (Map Module ModuleOrigin)\n    esmap = listToUFM (es False) -- parameter here doesn't matter, orig will\n                                 -- be overwritten\n\n    hiddens = [(m, mkModMap pk m ModHidden) | m <- hidden_mods]\n\n    pk = packageConfigId pkg\n    pkg_lookup uid = lookupPackage' (isIndefinite dflags) pkg_db uid\n                        `orElse` pprPanic \"pkg_lookup\" (ppr uid)\n\n    exposed_mods = exposedModules pkg\n    hidden_mods = hiddenModules pkg\n\n-- | Make a 'ModuleToPkgConfAll' covering a set of unusable packages.\nmkUnusableModuleToPkgConfAll :: UnusablePackages -> ModuleToPkgConfAll\nmkUnusableModuleToPkgConfAll unusables =\n    Map.foldl' extend_modmap Map.empty unusables\n where\n    extend_modmap modmap (pkg, reason) = addListTo modmap bindings\n      where bindings :: [(ModuleName, Map Module ModuleOrigin)]\n            bindings = exposed ++ hidden\n\n            origin = ModUnusable reason\n            pkg_id = packageConfigId pkg\n\n            exposed = map get_exposed exposed_mods\n            hidden = [(m, mkModMap pkg_id m origin) | m <- hidden_mods]\n\n            get_exposed (mod, Just mod') = (mod, Map.singleton mod' origin)\n            get_exposed (mod, _)         = (mod, mkModMap pkg_id mod origin)\n\n            exposed_mods = exposedModules pkg\n            hidden_mods = hiddenModules pkg\n\n-- | Add a list of key/value pairs to a nested map.\n--\n-- The outer map is processed with 'Data.Map.Strict' to prevent memory leaks\n-- when reloading modules in GHCi (see Trac #4029). This ensures that each\n-- value is forced before installing into the map.\naddListTo :: (Monoid a, Ord k1, Ord k2)\n          => Map k1 (Map k2 a)\n          -> [(k1, Map k2 a)]\n          -> Map k1 (Map k2 a)\naddListTo = foldl' merge\n  where merge m (k, v) = MapStrict.insertWith (Map.unionWith mappend) k v m\n\n-- | Create a singleton module mapping\nmkModMap :: UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin\nmkModMap pkg mod = Map.singleton (mkModule pkg mod)\n\n-- -----------------------------------------------------------------------------\n-- Extracting information from the packages in scope\n\n-- Many of these functions take a list of packages: in those cases,\n-- the list is expected to contain the \"dependent packages\",\n-- i.e. those packages that were found to be depended on by the\n-- current module/program.  These can be auto or non-auto packages, it\n-- doesn't really matter.  The list is always combined with the list\n-- of preload (command-line) packages to determine which packages to\n-- use.\n\n-- | Find all the include directories in these and the preload packages\ngetPackageIncludePath :: DynFlags -> [PreloadUnitId] -> IO [String]\ngetPackageIncludePath dflags pkgs =\n  collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs\n\ncollectIncludeDirs :: [PackageConfig] -> [FilePath]\ncollectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))\n\n-- | Find all the library paths in these and the preload packages\ngetPackageLibraryPath :: DynFlags -> [PreloadUnitId] -> IO [String]\ngetPackageLibraryPath dflags pkgs =\n  collectLibraryPaths dflags `fmap` getPreloadPackagesAnd dflags pkgs\n\ncollectLibraryPaths :: DynFlags -> [PackageConfig] -> [FilePath]\ncollectLibraryPaths dflags = nub . filter notNull\n                           . concatMap (libraryDirsForWay dflags)\n\n-- | Find all the link options in these and the preload packages,\n-- returning (package hs lib options, extra library options, other flags)\ngetPackageLinkOpts :: DynFlags -> [PreloadUnitId] -> IO ([String], [String], [String])\ngetPackageLinkOpts dflags pkgs =\n  collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs\n\ncollectLinkOpts :: DynFlags -> [PackageConfig] -> ([String], [String], [String])\ncollectLinkOpts dflags ps =\n    (\n        concatMap (map (\"-l\" ++) . packageHsLibs dflags) ps,\n        concatMap (map (\"-l\" ++) . extraLibraries) ps,\n        concatMap ldOptions ps\n    )\ncollectArchives :: DynFlags -> PackageConfig -> IO [FilePath]\ncollectArchives dflags pc =\n  filterM doesFileExist [ searchPath </> (\"lib\" ++ lib ++ \".a\")\n                        | searchPath <- searchPaths\n                        , lib <- libs ]\n  where searchPaths = nub . filter notNull . libraryDirsForWay dflags $ pc\n        libs        = packageHsLibs dflags pc ++ extraLibraries pc\n\ngetLibs :: DynFlags -> [PreloadUnitId] -> IO [(String,String)]\ngetLibs dflags pkgs = do\n  ps <- getPreloadPackagesAnd dflags pkgs\n  fmap concat . forM ps $ \\p -> do\n    let candidates = [ (l </> f, f) | l <- collectLibraryPaths dflags [p]\n                                    , f <- (\\n -> \"lib\" ++ n ++ \".a\") <$> packageHsLibs dflags p ]\n    filterM (doesFileExist . fst) candidates\n\npackageHsLibs :: DynFlags -> PackageConfig -> [String]\npackageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)\n  where\n        ways0 = ways dflags\n\n        ways1 = filter (/= WayDyn) ways0\n        -- the name of a shared library is libHSfoo-ghc<version>.so\n        -- we leave out the _dyn, because it is superfluous\n\n        -- debug and profiled RTSs include support for -eventlog\n        ways2 | WayDebug `elem` ways1 || WayProf `elem` ways1\n              = filter (/= WayEventLog) ways1\n              | otherwise\n              = ways1\n\n        tag     = mkBuildTag (filter (not . wayRTSOnly) ways2)\n        rts_tag = mkBuildTag ways2\n\n        mkDynName x\n         | WayDyn `notElem` ways dflags = x\n         | \"HS\" `isPrefixOf` x          =\n              x ++ '-':programName dflags ++ projectVersion dflags\n           -- For non-Haskell libraries, we use the name \"Cfoo\". The .a\n           -- file is libCfoo.a, and the .so is libfoo.so. That way the\n           -- linker knows what we mean for the vanilla (-lCfoo) and dyn\n           -- (-lfoo) ways. We therefore need to strip the 'C' off here.\n         | Just x' <- stripPrefix \"C\" x = x'\n         | otherwise\n            = panic (\"Don't understand library name \" ++ x)\n\n        -- Add _thr and other rts suffixes to packages named\n        -- `rts` or `rts-1.0`. Why both?  Traditionally the rts\n        -- package is called `rts` only.  However the tooling\n        -- usually expects a package name to have a version.\n        -- As such we will gradually move towards the `rts-1.0`\n        -- package name, at which point the `rts` package name\n        -- will eventually be unused.\n        --\n        -- This change elevates the need to add custom hooks\n        -- and handling specifically for the `rts` package for\n        -- example in ghc-cabal.\n        addSuffix rts@\"HSrts\"    = rts       ++ (expandTag rts_tag)\n        addSuffix rts@\"HSrts-1.0\"= rts       ++ (expandTag rts_tag)\n        addSuffix other_lib      = other_lib ++ (expandTag tag)\n\n        expandTag t | null t = \"\"\n                    | otherwise = '_':t\n\n-- | Either the 'libraryDirs' or 'libraryDynDirs' as appropriate for the way.\nlibraryDirsForWay :: DynFlags -> PackageConfig -> [String]\nlibraryDirsForWay dflags\n  | WayDyn `elem` ways dflags = libraryDynDirs\n  | otherwise                 = libraryDirs\n\n-- | Find all the C-compiler options in these and the preload packages\ngetPackageExtraCcOpts :: DynFlags -> [PreloadUnitId] -> IO [String]\ngetPackageExtraCcOpts dflags pkgs = do\n  ps <- getPreloadPackagesAnd dflags pkgs\n  return (concatMap ccOptions ps)\n\n-- | Find all the package framework paths in these and the preload packages\ngetPackageFrameworkPath  :: DynFlags -> [PreloadUnitId] -> IO [String]\ngetPackageFrameworkPath dflags pkgs = do\n  ps <- getPreloadPackagesAnd dflags pkgs\n  return (nub (filter notNull (concatMap frameworkDirs ps)))\n\n-- | Find all the package frameworks in these and the preload packages\ngetPackageFrameworks  :: DynFlags -> [PreloadUnitId] -> IO [String]\ngetPackageFrameworks dflags pkgs = do\n  ps <- getPreloadPackagesAnd dflags pkgs\n  return (concatMap frameworks ps)\n\n-- -----------------------------------------------------------------------------\n-- Package Utils\n\n-- | Takes a 'ModuleName', and if the module is in any package returns\n-- list of modules which take that name.\nlookupModuleInAllPackages :: DynFlags\n                          -> ModuleName\n                          -> [(Module, PackageConfig)]\nlookupModuleInAllPackages dflags m\n  = case lookupModuleWithSuggestions dflags m Nothing of\n      LookupFound a b -> [(a,b)]\n      LookupMultiple rs -> map f rs\n        where f (m,_) = (m, expectJust \"lookupModule\" (lookupPackage dflags\n                                                         (moduleUnitId m)))\n      _ -> []\n\n-- | The result of performing a lookup\ndata LookupResult =\n    -- | Found the module uniquely, nothing else to do\n    LookupFound Module PackageConfig\n    -- | Multiple modules with the same name in scope\n  | LookupMultiple [(Module, ModuleOrigin)]\n    -- | No modules found, but there were some hidden ones with\n    -- an exact name match.  First is due to package hidden, second\n    -- is due to module being hidden\n  | LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]\n    -- | No modules found, but there were some unusable ones with\n    -- an exact name match\n  | LookupUnusable [(Module, ModuleOrigin)]\n    -- | Nothing found, here are some suggested different names\n  | LookupNotFound [ModuleSuggestion] -- suggestions\n\ndata ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin\n                      | SuggestHidden ModuleName Module ModuleOrigin\n\nlookupModuleWithSuggestions :: DynFlags\n                            -> ModuleName\n                            -> Maybe FastString\n                            -> LookupResult\nlookupModuleWithSuggestions dflags\n  = lookupModuleWithSuggestions' dflags\n        (moduleToPkgConfAll (pkgState dflags))\n\nlookupPluginModuleWithSuggestions :: DynFlags\n                                  -> ModuleName\n                                  -> Maybe FastString\n                                  -> LookupResult\nlookupPluginModuleWithSuggestions dflags\n  = lookupModuleWithSuggestions' dflags\n        (pluginModuleToPkgConfAll (pkgState dflags))\n\nlookupModuleWithSuggestions' :: DynFlags\n                            -> ModuleToPkgConfAll\n                            -> ModuleName\n                            -> Maybe FastString\n                            -> LookupResult\nlookupModuleWithSuggestions' dflags mod_map m mb_pn\n  = case Map.lookup m mod_map of\n        Nothing -> LookupNotFound suggestions\n        Just xs ->\n          case foldl' classify ([],[],[], []) (Map.toList xs) of\n            ([], [], [], []) -> LookupNotFound suggestions\n            (_, _, _, [(m, _)])             -> LookupFound m (mod_pkg m)\n            (_, _, _, exposed@(_:_))        -> LookupMultiple exposed\n            ([], [], unusable@(_:_), [])    -> LookupUnusable unusable\n            (hidden_pkg, hidden_mod, _, []) ->\n              LookupHidden hidden_pkg hidden_mod\n  where\n    classify (hidden_pkg, hidden_mod, unusable, exposed) (m, origin0) =\n      let origin = filterOrigin mb_pn (mod_pkg m) origin0\n          x = (m, origin)\n      in case origin of\n          ModHidden\n            -> (hidden_pkg, x:hidden_mod, unusable, exposed)\n          ModUnusable _\n            -> (hidden_pkg, hidden_mod, x:unusable, exposed)\n          _ | originEmpty origin\n            -> (hidden_pkg,   hidden_mod, unusable, exposed)\n            | originVisible origin\n            -> (hidden_pkg, hidden_mod, unusable, x:exposed)\n            | otherwise\n            -> (x:hidden_pkg, hidden_mod, unusable, exposed)\n\n    pkg_lookup p = lookupPackage dflags p `orElse` pprPanic \"lookupModuleWithSuggestions\" (ppr p <+> ppr m)\n    mod_pkg = pkg_lookup . moduleUnitId\n\n    -- Filters out origins which are not associated with the given package\n    -- qualifier.  No-op if there is no package qualifier.  Test if this\n    -- excluded all origins with 'originEmpty'.\n    filterOrigin :: Maybe FastString\n                 -> PackageConfig\n                 -> ModuleOrigin\n                 -> ModuleOrigin\n    filterOrigin Nothing _ o = o\n    filterOrigin (Just pn) pkg o =\n      case o of\n          ModHidden -> if go pkg then ModHidden else mempty\n          (ModUnusable _) -> if go pkg then o else mempty\n          ModOrigin { fromOrigPackage = e, fromExposedReexport = res,\n                      fromHiddenReexport = rhs }\n            -> ModOrigin {\n                  fromOrigPackage = if go pkg then e else Nothing\n                , fromExposedReexport = filter go res\n                , fromHiddenReexport = filter go rhs\n                , fromPackageFlag = False -- always excluded\n                }\n      where go pkg = pn == fsPackageName pkg\n\n    suggestions\n      | gopt Opt_HelpfulErrors dflags =\n           fuzzyLookup (moduleNameString m) all_mods\n      | otherwise = []\n\n    all_mods :: [(String, ModuleSuggestion)]     -- All modules\n    all_mods = sortBy (comparing fst) $\n        [ (moduleNameString m, suggestion)\n        | (m, e) <- Map.toList (moduleToPkgConfAll (pkgState dflags))\n        , suggestion <- map (getSuggestion m) (Map.toList e)\n        ]\n    getSuggestion name (mod, origin) =\n        (if originVisible origin then SuggestVisible else SuggestHidden)\n            name mod origin\n\nlistVisibleModuleNames :: DynFlags -> [ModuleName]\nlistVisibleModuleNames dflags =\n    map fst (filter visible (Map.toList (moduleToPkgConfAll (pkgState dflags))))\n  where visible (_, ms) = any originVisible (Map.elems ms)\n\n-- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of\n-- 'PackageConfig's\ngetPreloadPackagesAnd :: DynFlags -> [PreloadUnitId] -> IO [PackageConfig]\ngetPreloadPackagesAnd dflags pkgids0 =\n  let\n      pkgids  = pkgids0 ++\n                  -- An indefinite package will have insts to HOLE,\n                  -- which is not a real package. Don't look it up.\n                  -- Fixes #14525\n                  if isIndefinite dflags\n                    then []\n                    else map (toInstalledUnitId . moduleUnitId . snd)\n                             (thisUnitIdInsts dflags)\n      state   = pkgState dflags\n      pkg_map = pkgIdMap state\n      preload = preloadPackages state\n      pairs = zip pkgids (repeat Nothing)\n  in do\n  all_pkgs <- throwErr dflags (foldM (add_package dflags pkg_map) preload pairs)\n  return (map (getInstalledPackageDetails dflags) all_pkgs)\n\n-- Takes a list of packages, and returns the list with dependencies included,\n-- in reverse dependency order (a package appears before those it depends on).\ncloseDeps :: DynFlags\n          -> PackageConfigMap\n          -> [(InstalledUnitId, Maybe InstalledUnitId)]\n          -> IO [InstalledUnitId]\ncloseDeps dflags pkg_map ps\n    = throwErr dflags (closeDepsErr dflags pkg_map ps)\n\nthrowErr :: DynFlags -> MaybeErr MsgDoc a -> IO a\nthrowErr dflags m\n              = case m of\n                Failed e    -> throwGhcExceptionIO (CmdLineError (showSDoc dflags e))\n                Succeeded r -> return r\n\ncloseDepsErr :: DynFlags\n             -> PackageConfigMap\n             -> [(InstalledUnitId,Maybe InstalledUnitId)]\n             -> MaybeErr MsgDoc [InstalledUnitId]\ncloseDepsErr dflags pkg_map ps = foldM (add_package dflags pkg_map) [] ps\n\n-- internal helper\nadd_package :: DynFlags\n            -> PackageConfigMap\n            -> [PreloadUnitId]\n            -> (PreloadUnitId,Maybe PreloadUnitId)\n            -> MaybeErr MsgDoc [PreloadUnitId]\nadd_package dflags pkg_db ps (p, mb_parent)\n  | p `elem` ps = return ps     -- Check if we've already added this package\n  | otherwise =\n      case lookupInstalledPackage' pkg_db p of\n        Nothing -> Failed (missingPackageMsg p <>\n                           missingDependencyMsg mb_parent)\n        Just pkg -> do\n           -- Add the package's dependents also\n           ps' <- foldM add_unit_key ps (depends pkg)\n           return (p : ps')\n          where\n            add_unit_key ps key\n              = add_package dflags pkg_db ps (key, Just p)\n\nmissingPackageMsg :: Outputable pkgid => pkgid -> SDoc\nmissingPackageMsg p = text \"unknown package:\" <+> ppr p\n\nmissingDependencyMsg :: Maybe InstalledUnitId -> SDoc\nmissingDependencyMsg Nothing = Outputable.empty\nmissingDependencyMsg (Just parent)\n  = space <> parens (text \"dependency of\" <+> ftext (installedUnitIdFS parent))\n\n-- -----------------------------------------------------------------------------\n\ncomponentIdString :: DynFlags -> ComponentId -> Maybe String\ncomponentIdString dflags cid = do\n    conf <- lookupInstalledPackage dflags (componentIdToInstalledUnitId cid)\n    return $\n        case sourceLibName conf of\n            Nothing -> sourcePackageIdString conf\n            Just (PackageName libname) ->\n                packageNameString conf\n                    ++ \"-\" ++ showVersion (packageVersion conf)\n                    ++ \":\" ++ unpackFS libname\n\ndisplayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String\ndisplayInstalledUnitId dflags uid =\n    fmap sourcePackageIdString (lookupInstalledPackage dflags uid)\n\n-- | Will the 'Name' come from a dynamically linked library?\nisDllName :: DynFlags -> Module -> Name -> Bool\n-- Despite the \"dll\", I think this function just means that\n-- the symbol comes from another dynamically-linked package,\n-- and applies on all platforms, not just Windows\nisDllName dflags this_mod name\n  | not (gopt Opt_ExternalDynamicRefs dflags) = False\n  | Just mod <- nameModule_maybe name\n    -- Issue #8696 - when GHC is dynamically linked, it will attempt\n    -- to load the dynamic dependencies of object files at compile\n    -- time for things like QuasiQuotes or\n    -- TemplateHaskell. Unfortunately, this interacts badly with\n    -- intra-package linking, because we don't generate indirect\n    -- (dynamic) symbols for intra-package calls. This means that if a\n    -- module with an intra-package call is loaded without its\n    -- dependencies, then GHC fails to link. This is the cause of #\n    --\n    -- In the mean time, always force dynamic indirections to be\n    -- generated: when the module name isn't the module being\n    -- compiled, references are dynamic.\n    = case platformOS $ targetPlatform dflags of\n        -- On Windows the hack for #8696 makes it unlinkable.\n        -- As the entire setup of the code from Cmm down to the RTS expects\n        -- the use of trampolines for the imported functions only when\n        -- doing intra-package linking, e.g. refering to a symbol defined in the same\n        -- package should not use a trampoline.\n        -- I much rather have dynamic TH not supported than the entire Dynamic linking\n        -- not due to a hack.\n        -- Also not sure this would break on Windows anyway.\n        OSMinGW32 -> moduleUnitId mod /= moduleUnitId this_mod\n\n        -- For the other platforms, still perform the hack\n        _         -> mod /= this_mod\n\n  | otherwise = False  -- no, it is not even an external name\n\n-- -----------------------------------------------------------------------------\n-- Displaying packages\n\n-- | Show (very verbose) package info\npprPackages :: DynFlags -> SDoc\npprPackages = pprPackagesWith pprPackageConfig\n\npprPackagesWith :: (PackageConfig -> SDoc) -> DynFlags -> SDoc\npprPackagesWith pprIPI dflags =\n    vcat (intersperse (text \"---\") (map pprIPI (listPackageConfigMap dflags)))\n\n-- | Show simplified package info.\n--\n-- The idea is to only print package id, and any information that might\n-- be different from the package databases (exposure, trust)\npprPackagesSimple :: DynFlags -> SDoc\npprPackagesSimple = pprPackagesWith pprIPI\n    where pprIPI ipi = let i = installedUnitIdFS (unitId ipi)\n                           e = if exposed ipi then text \"E\" else text \" \"\n                           t = if trusted ipi then text \"T\" else text \" \"\n                       in e <> t <> text \"  \" <> ftext i\n\n-- | Show the mapping of modules to where they come from.\npprModuleMap :: ModuleToPkgConfAll -> SDoc\npprModuleMap mod_map =\n  vcat (map pprLine (Map.toList mod_map))\n    where\n      pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e)))\n      pprEntry :: Outputable a => ModuleName -> (Module, a) -> SDoc\n      pprEntry m (m',o)\n        | m == moduleName m' = ppr (moduleUnitId m') <+> parens (ppr o)\n        | otherwise = ppr m' <+> parens (ppr o)\n\nfsPackageName :: PackageConfig -> FastString\nfsPackageName = mkFastString . packageNameString\n\n-- | Given a fully instantiated 'UnitId', improve it into a\n-- 'InstalledUnitId' if we can find it in the package database.\nimproveUnitId :: PackageConfigMap -> UnitId -> UnitId\nimproveUnitId _ uid@(DefiniteUnitId _) = uid -- short circuit\nimproveUnitId pkg_map uid =\n    -- Do NOT lookup indefinite ones, they won't be useful!\n    case lookupPackage' False pkg_map uid of\n        Nothing  -> uid\n        Just pkg ->\n            -- Do NOT improve if the indefinite unit id is not\n            -- part of the closure unique set.  See\n            -- Note [UnitId to InstalledUnitId improvement]\n            if installedPackageConfigId pkg `elementOfUniqSet` preloadClosure pkg_map\n                then packageConfigId pkg\n                else uid\n\n-- | Retrieve the 'PackageConfigMap' from 'DynFlags'; used\n-- in the @hs-boot@ loop-breaker.\ngetPackageConfigMap :: DynFlags -> PackageConfigMap\ngetPackageConfigMap = pkgIdMap . pkgState\n", "num_lines": 2175}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\n-- | The CompPipeline monad and associated ops\n--\n-- Defined in separate module so that it can safely be imported from Hooks\nmodule PipelineMonad (\n    CompPipeline(..), evalP\n  , PhasePlus(..)\n  , PipeEnv(..), PipeState(..), PipelineOutput(..)\n  , getPipeEnv, getPipeState, setDynFlags, setModLocation, setForeignOs\n  ) where\n\nimport GhcPrelude\n\nimport MonadUtils\nimport Outputable\nimport DynFlags\nimport DriverPhases\nimport HscTypes\nimport Module\nimport FileCleanup (TempFileLifetime)\n\nimport Control.Monad\n\nnewtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) }\n\nevalP :: CompPipeline a -> PipeEnv -> PipeState -> IO a\nevalP f env st = liftM snd $ unP f env st\n\ninstance Functor CompPipeline where\n    fmap = liftM\n\ninstance Applicative CompPipeline where\n    pure a = P $ \\_env state -> return (state, a)\n    (<*>) = ap\n\ninstance Monad CompPipeline where\n  P m >>= k = P $ \\env state -> do (state',a) <- m env state\n                                   unP (k a) env state'\n\ninstance MonadIO CompPipeline where\n    liftIO m = P $ \\_env state -> do a <- m; return (state, a)\n\ndata PhasePlus = RealPhase Phase\n               | HscOut HscSource ModuleName HscStatus\n\ninstance Outputable PhasePlus where\n    ppr (RealPhase p) = ppr p\n    ppr (HscOut {}) = text \"HscOut\"\n\n-- -----------------------------------------------------------------------------\n-- The pipeline uses a monad to carry around various bits of information\n\n-- PipeEnv: invariant information passed down\ndata PipeEnv = PipeEnv {\n       stop_phase   :: Phase,       -- ^ Stop just before this phase\n       src_filename :: String,      -- ^ basename of original input source\n       src_basename :: String,      -- ^ basename of original input source\n       src_suffix   :: String,      -- ^ its extension\n       output_spec  :: PipelineOutput -- ^ says where to put the pipeline output\n  }\n\n-- PipeState: information that might change during a pipeline run\ndata PipeState = PipeState {\n       hsc_env   :: HscEnv,\n          -- ^ only the DynFlags change in the HscEnv.  The DynFlags change\n          -- at various points, for example when we read the OPTIONS_GHC\n          -- pragmas in the Cpp phase.\n       maybe_loc :: Maybe ModLocation,\n          -- ^ the ModLocation.  This is discovered during compilation,\n          -- in the Hsc phase where we read the module header.\n       foreign_os :: [FilePath]\n         -- ^ additional object files resulting from compiling foreign\n         -- code. They come from two sources: foreign stubs, and\n         -- add{C,Cxx,Objc,Objcxx}File from template haskell\n  }\n\ndata PipelineOutput\n  = Temporary TempFileLifetime\n        -- ^ Output should be to a temporary file: we're going to\n        -- run more compilation steps on this output later.\n  | Persistent\n        -- ^ We want a persistent file, i.e. a file in the current directory\n        -- derived from the input filename, but with the appropriate extension.\n        -- eg. in \"ghc -c Foo.hs\" the output goes into ./Foo.o.\n  | SpecificFile\n        -- ^ The output must go into the specific outputFile in DynFlags.\n        -- We don't store the filename in the constructor as it changes\n        -- when doing -dynamic-too.\n    deriving Show\n\ngetPipeEnv :: CompPipeline PipeEnv\ngetPipeEnv = P $ \\env state -> return (state, env)\n\ngetPipeState :: CompPipeline PipeState\ngetPipeState = P $ \\_env state -> return (state, state)\n\ninstance HasDynFlags CompPipeline where\n    getDynFlags = P $ \\_env state -> return (state, hsc_dflags (hsc_env state))\n\nsetDynFlags :: DynFlags -> CompPipeline ()\nsetDynFlags dflags = P $ \\_env state ->\n  return (state{hsc_env= (hsc_env state){ hsc_dflags = dflags }}, ())\n\nsetModLocation :: ModLocation -> CompPipeline ()\nsetModLocation loc = P $ \\_env state ->\n  return (state{ maybe_loc = Just loc }, ())\n\nsetForeignOs :: [FilePath] -> CompPipeline ()\nsetForeignOs os = P $ \\_env state ->\n  return (state{ foreign_os = os }, ())\n", "num_lines": 111}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-------------------------------------------------------------------------------\n--\n-- | Platform constants\n--\n-- (c) The University of Glasgow 2013\n--\n-------------------------------------------------------------------------------\n\nmodule PlatformConstants (PlatformConstants(..)) where\n\nimport GhcPrelude\n\n-- Produced by deriveConstants\n#include \"GHCConstantsHaskellType.hs\"\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE CPP #-}\nmodule Plugins (\n      -- * Plugins\n      Plugin(..)\n    , defaultPlugin\n    , CommandLineOption\n      -- ** Recompilation checking\n    , purePlugin, impurePlugin, flagRecompile\n    , PluginRecompile(..)\n\n      -- * Plugin types\n      -- ** Frontend plugins\n    , FrontendPlugin(..), defaultFrontendPlugin, FrontendPluginAction\n      -- ** Core plugins\n      -- | Core plugins allow plugins to register as a Core-to-Core pass.\n    , CorePlugin\n      -- ** Typechecker plugins\n      -- | Typechecker plugins allow plugins to provide evidence to the\n      -- typechecker.\n    , TcPlugin\n      -- ** Source plugins\n      -- | GHC offers a number of points where plugins can access and modify its\n      -- front-end (\\\"source\\\") representation. These include:\n      --\n      -- - access to the parser result with 'parsedResultAction'\n      -- - access to the renamed AST with 'renamedResultAction'\n      -- - access to the typechecked AST with 'typeCheckResultAction'\n      -- - access to the Template Haskell splices with 'spliceRunAction'\n      -- - access to loaded interface files with 'interfaceLoadAction'\n      --\n    , keepRenamedSource\n\n      -- * Internal\n    , PluginWithArgs(..), plugins, pluginRecompile'\n    , LoadedPlugin(..), lpModuleName\n    , StaticPlugin(..)\n    , mapPlugins, withPlugins, withPlugins_\n    ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} CoreMonad ( CoreToDo, CoreM )\nimport qualified TcRnTypes\nimport TcRnTypes ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports )\nimport HsSyn\nimport DynFlags\nimport HscTypes\nimport GhcMonad\nimport DriverPhases\nimport Module ( ModuleName, Module(moduleName))\nimport Fingerprint\nimport Data.List\nimport Outputable (Outputable(..), text, (<+>))\n\n--Qualified import so we can define a Semigroup instance\n-- but it doesn't clash with Outputable.<>\nimport qualified Data.Semigroup\n\nimport Control.Monad\n\n-- | Command line options gathered from the -PModule.Name:stuff syntax\n-- are given to you as this type\ntype CommandLineOption = String\n\n-- | 'Plugin' is the compiler plugin data type. Try to avoid\n-- constructing one of these directly, and just modify some fields of\n-- 'defaultPlugin' instead: this is to try and preserve source-code\n-- compatibility when we add fields to this.\n--\n-- Nonetheless, this API is preliminary and highly likely to change in\n-- the future.\ndata Plugin = Plugin {\n    installCoreToDos :: CorePlugin\n    -- ^ Modify the Core pipeline that will be used for compilation.\n    -- This is called as the Core pipeline is built for every module\n    -- being compiled, and plugins get the opportunity to modify the\n    -- pipeline in a nondeterministic order.\n  , tcPlugin :: TcPlugin\n    -- ^ An optional typechecker plugin, which may modify the\n    -- behaviour of the constraint solver.\n  , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile\n    -- ^ Specify how the plugin should affect recompilation.\n  , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule\n                            -> Hsc HsParsedModule\n    -- ^ Modify the module when it is parsed. This is called by\n    -- HscMain when the parsing is successful.\n  , renamedResultAction :: [CommandLineOption] -> TcGblEnv\n                                -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)\n    -- ^ Modify each group after it is renamed. This is called after each\n    -- `HsGroup` has been renamed.\n  , typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv\n                               -> TcM TcGblEnv\n    -- ^ Modify the module when it is type checked. This is called at the\n    -- very end of typechecking.\n  , spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc\n                         -> TcM (LHsExpr GhcTc)\n    -- ^ Modify the TH splice or quasiqoute before it is run.\n  , interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface\n                                          -> IfM lcl ModIface\n    -- ^ Modify an interface that have been loaded. This is called by\n    -- LoadIface when an interface is successfully loaded. Not applied to\n    -- the loading of the plugin interface. Tools that rely on information from\n    -- modules other than the currently compiled one should implement this\n    -- function.\n  }\n\n-- Note [Source plugins]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- The `Plugin` datatype have been extended by fields that allow access to the\n-- different inner representations that are generated during the compilation\n-- process. These fields are `parsedResultAction`, `renamedResultAction`,\n-- `typeCheckResultAction`, `spliceRunAction` and `interfaceLoadAction`.\n--\n-- The main purpose of these plugins is to help tool developers. They allow\n-- development tools to extract the information about the source code of a big\n-- Haskell project during the normal build procedure. In this case the plugin\n-- acts as the tools access point to the compiler that can be controlled by\n-- compiler flags. This is important because the manipulation of compiler flags\n-- is supported by most build environment.\n--\n-- For the full discussion, check the full proposal at:\n-- https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal\n\ndata PluginWithArgs = PluginWithArgs\n  { paPlugin :: Plugin\n    -- ^ the actual callable plugin\n  , paArguments :: [CommandLineOption]\n    -- ^ command line arguments for the plugin\n  }\n\n-- | A plugin with its arguments. The result of loading the plugin.\ndata LoadedPlugin = LoadedPlugin\n  { lpPlugin :: PluginWithArgs\n  -- ^ the actual plugin together with its commandline arguments\n  , lpModule :: ModIface\n  -- ^ the module containing the plugin\n  }\n\n-- | A static plugin with its arguments. For registering compiled-in plugins\n-- through the GHC API.\ndata StaticPlugin = StaticPlugin\n  { spPlugin :: PluginWithArgs\n  -- ^ the actual plugin together with its commandline arguments\n  }\n\nlpModuleName :: LoadedPlugin -> ModuleName\nlpModuleName = moduleName . mi_module . lpModule\n\npluginRecompile' :: PluginWithArgs -> IO PluginRecompile\npluginRecompile' (PluginWithArgs plugin args) = pluginRecompile plugin args\n\ndata PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint\n\ninstance Outputable PluginRecompile where\n  ppr ForceRecompile = text \"ForceRecompile\"\n  ppr NoForceRecompile = text \"NoForceRecompile\"\n  ppr (MaybeRecompile fp) = text \"MaybeRecompile\" <+> ppr fp\n\ninstance Semigroup PluginRecompile where\n  ForceRecompile <> _ = ForceRecompile\n  NoForceRecompile <> r = r\n  MaybeRecompile fp <> NoForceRecompile   = MaybeRecompile fp\n  MaybeRecompile fp <> MaybeRecompile fp' = MaybeRecompile (fingerprintFingerprints [fp, fp'])\n  MaybeRecompile _fp <> ForceRecompile     = ForceRecompile\n\ninstance Monoid PluginRecompile where\n  mempty = NoForceRecompile\n\ntype CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]\ntype TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin\n\npurePlugin, impurePlugin, flagRecompile :: [CommandLineOption] -> IO PluginRecompile\npurePlugin _args = return NoForceRecompile\n\nimpurePlugin _args = return ForceRecompile\n\nflagRecompile =\n  return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort\n\n-- | Default plugin: does nothing at all, except for marking that safe\n-- inference has failed unless @-fplugin-trustworthy@ is passed. For\n-- compatibility reaso you should base all your plugin definitions on this\n-- default value.\ndefaultPlugin :: Plugin\ndefaultPlugin = Plugin {\n        installCoreToDos      = const return\n      , tcPlugin              = const Nothing\n      , pluginRecompile  = impurePlugin\n      , renamedResultAction   = \\_ env grp -> return (env, grp)\n      , parsedResultAction    = \\_ _ -> return\n      , typeCheckResultAction = \\_ _ -> return\n      , spliceRunAction       = \\_ -> return\n      , interfaceLoadAction   = \\_ -> return\n    }\n\n\n-- | A renamer plugin which mades the renamed source available in\n-- a typechecker plugin.\nkeepRenamedSource :: [CommandLineOption] -> TcGblEnv\n                  -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)\nkeepRenamedSource _ gbl_env group =\n  return (gbl_env { tcg_rn_decls = update (tcg_rn_decls gbl_env)\n                  , tcg_rn_exports = update_exports (tcg_rn_exports gbl_env) }, group)\n  where\n    update_exports Nothing = Just []\n    update_exports m = m\n\n    update Nothing = Just emptyRnGroup\n    update m       = m\n\n\ntype PluginOperation m a = Plugin -> [CommandLineOption] -> a -> m a\ntype ConstPluginOperation m a = Plugin -> [CommandLineOption] -> a -> m ()\n\nplugins :: DynFlags -> [PluginWithArgs]\nplugins df =\n  map lpPlugin (cachedPlugins df) ++\n  map spPlugin (staticPlugins df)\n\n-- | Perform an operation by using all of the plugins in turn.\nwithPlugins :: Monad m => DynFlags -> PluginOperation m a -> a -> m a\nwithPlugins df transformation input = foldM go input (plugins df)\n  where\n    go arg (PluginWithArgs p opts) = transformation p opts arg\n\nmapPlugins :: DynFlags -> (Plugin -> [CommandLineOption] -> a) -> [a]\nmapPlugins df f = map (\\(PluginWithArgs p opts) -> f p opts) (plugins df)\n\n-- | Perform a constant operation by using all of the plugins in turn.\nwithPlugins_ :: Monad m => DynFlags -> ConstPluginOperation m a -> a -> m ()\nwithPlugins_ df transformation input\n  = mapM_ (\\(PluginWithArgs p opts) -> transformation p opts input)\n          (plugins df)\n\ntype FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc ()\ndata FrontendPlugin = FrontendPlugin {\n      frontend :: FrontendPluginAction\n    }\ndefaultFrontendPlugin :: FrontendPlugin\ndefaultFrontendPlugin = FrontendPlugin { frontend = \\_ _ -> return () }\n", "num_lines": 242}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Pretty-printing TyThings\n--\n-- (c) The GHC Team 2005\n--\n-----------------------------------------------------------------------------\n\n{-# LANGUAGE CPP #-}\nmodule PprTyThing (\n        pprTyThing,\n        pprTyThingInContext,\n        pprTyThingLoc,\n        pprTyThingInContextLoc,\n        pprTyThingHdr,\n        pprTypeForUser,\n        pprFamInst\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Type    ( ArgFlag(..), TyThing(..), mkTyVarBinders, pprUserForAll )\nimport IfaceSyn ( ShowSub(..), ShowHowMuch(..), AltPpr(..)\n  , showToHeader, pprIfaceDecl )\nimport CoAxiom ( coAxiomTyCon )\nimport HscTypes( tyThingParent_maybe )\nimport MkIface ( tyThingToIfaceDecl )\nimport Type ( tidyOpenType )\nimport FamInstEnv( FamInst(..), FamFlavor(..) )\nimport Type( Type, pprTypeApp, pprSigmaType )\nimport Name\nimport VarEnv( emptyTidyEnv )\nimport Outputable\n\n-- -----------------------------------------------------------------------------\n-- Pretty-printing entities that we get from the GHC API\n\n{- Note [Pretty printing via IfaceSyn]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOur general plan for prett-printing\n  - Types\n  - TyCons\n  - Classes\n  - Pattern synonyms\n  ...etc...\n\nis to convert them to IfaceSyn, and pretty-print that. For example\n  - pprType converts a Type to an IfaceType, and pretty prints that.\n  - pprTyThing converts the TyThing to an IfaceDecl,\n    and pretty prints that.\n\nSo IfaceSyn play a dual role:\n  - it's the internal version of an interface files\n  - it's used for pretty-printing\n\nWhy do this?\n\n* A significant reason is that we need to be able\n  to pretty-print IfaceSyn (to display Foo.hi), and it was a\n  pain to duplicate masses of pretty-printing goop, esp for\n  Type and IfaceType.\n\n* When pretty-printing (a type, say), we want to tidy (with\n  tidyType) to avoids having (forall a a. blah) where the two\n  a's have different uniques.\n\n  Alas, for type constructors, TyCon, tidying does not work well,\n  because a TyCon includes DataCons which include Types, which mention\n  TyCons. And tidying can't tidy a mutually recursive data structure\n  graph, only trees.\n\n* Interface files contains fast-strings, not uniques, so the very same\n  tidying must take place when we convert to IfaceDecl. E.g.\n  MkIface.tyThingToIfaceDecl which converts a TyThing (i.e. TyCon,\n  Class etc) to an IfaceDecl.\n\n  Bottom line: IfaceDecls are already 'tidy', so it's straightforward\n  to print them.\n\n* An alternative I once explored was to ensure that TyCons get type\n  variables with distinct print-names. That's ok for type variables\n  but less easy for kind variables. Processing data type declarations\n  is already so complicated that I don't think it's sensible to add\n  the extra requirement that it generates only \"pretty\" types and\n  kinds.\n\nConsequences:\n\n- IfaceSyn (and IfaceType) must contain enough information to\n  print nicely.  Hence, for example, the IfaceAppArgs type, which\n  allows us to suppress invisible kind arguments in types\n  (see Note [Suppressing invisible arguments] in IfaceType)\n\n- In a few places we have info that is used only for pretty-printing,\n  and is totally ignored when turning IfaceSyn back into TyCons\n  etc (in TcIface). For example, IfaceClosedSynFamilyTyCon\n  stores a [IfaceAxBranch] that is used only for pretty-printing.\n\n- See Note [Free tyvars in IfaceType] in IfaceType\n\nSee #7730, #8776 for details   -}\n\n--------------------\n-- | Pretty-prints a 'FamInst' (type/data family instance) with its defining location.\npprFamInst :: FamInst -> SDoc\n--  * For data instances we go via pprTyThing of the representational TyCon,\n--    because there is already much cleverness associated with printing\n--    data type declarations that I don't want to duplicate\n--  * For type instances we print directly here; there is no TyCon\n--    to give to pprTyThing\n--\n-- FamInstEnv.pprFamInst does a more quick-and-dirty job for internal purposes\n\npprFamInst (FamInst { fi_flavor = DataFamilyInst rep_tc })\n  = pprTyThingInContextLoc (ATyCon rep_tc)\n\npprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom\n                    , fi_tvs = tvs, fi_tys = lhs_tys, fi_rhs = rhs })\n  = showWithLoc (pprDefinedAt (getName axiom)) $\n    hang (text \"type instance\"\n            <+> pprUserForAll (mkTyVarBinders Specified tvs)\n                -- See Note [Printing foralls in type family instances]\n                -- in IfaceType\n            <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys)\n       2 (equals <+> ppr rhs)\n\n----------------------------\n-- | Pretty-prints a 'TyThing' with its defining location.\npprTyThingLoc :: TyThing -> SDoc\npprTyThingLoc tyThing\n  = showWithLoc (pprDefinedAt (getName tyThing))\n                (pprTyThing showToHeader tyThing)\n\n-- | Pretty-prints the 'TyThing' header. For functions and data constructors\n-- the function is equivalent to 'pprTyThing' but for type constructors\n-- and classes it prints only the header part of the declaration.\npprTyThingHdr :: TyThing -> SDoc\npprTyThingHdr = pprTyThing showToHeader\n\n-- | Pretty-prints a 'TyThing' in context: that is, if the entity\n-- is a data constructor, record selector, or class method, then\n-- the entity's parent declaration is pretty-printed with irrelevant\n-- parts omitted.\npprTyThingInContext :: ShowSub -> TyThing -> SDoc\npprTyThingInContext show_sub thing\n  = go [] thing\n  where\n    go ss thing\n      = case tyThingParent_maybe thing of\n          Just parent ->\n            go (getOccName thing : ss) parent\n          Nothing ->\n            pprTyThing\n              (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) })\n              thing\n\n-- | Like 'pprTyThingInContext', but adds the defining location.\npprTyThingInContextLoc :: TyThing -> SDoc\npprTyThingInContextLoc tyThing\n  = showWithLoc (pprDefinedAt (getName tyThing))\n                (pprTyThingInContext showToHeader tyThing)\n\n-- | Pretty-prints a 'TyThing'.\npprTyThing :: ShowSub -> TyThing -> SDoc\n-- We pretty-print 'TyThing' via 'IfaceDecl'\n-- See Note [Pretty-printing TyThings]\npprTyThing ss ty_thing\n  = pprIfaceDecl ss' (tyThingToIfaceDecl ty_thing)\n  where\n    ss' = case ss_how_much ss of\n      ShowHeader (AltPpr Nothing)  -> ss { ss_how_much = ShowHeader ppr' }\n      ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' }\n      _                   -> ss\n\n    ppr' = AltPpr $ ppr_bndr $ getName ty_thing\n\n    ppr_bndr :: Name -> Maybe (OccName -> SDoc)\n    ppr_bndr name\n      | isBuiltInSyntax name\n         = Nothing\n      | otherwise\n         = case nameModule_maybe name of\n             Just mod -> Just $ \\occ -> getPprStyle $ \\sty ->\n               pprModulePrefix sty mod occ <> ppr occ\n             Nothing  -> WARN( True, ppr name ) Nothing\n             -- Nothing is unexpected here; TyThings have External names\n\npprTypeForUser :: Type -> SDoc\n-- The type is tidied\npprTypeForUser ty\n  = pprSigmaType tidy_ty\n  where\n    (_, tidy_ty)     = tidyOpenType emptyTidyEnv ty\n     -- Often the types/kinds we print in ghci are fully generalised\n     -- and have no free variables, but it turns out that we sometimes\n     -- print un-generalised kinds (eg when doing :k T), so it's\n     -- better to use tidyOpenType here\n\nshowWithLoc :: SDoc -> SDoc -> SDoc\nshowWithLoc loc doc\n    = hang doc 2 (char '\\t' <> comment <+> loc)\n                -- The tab tries to make them line up a bit\n  where\n    comment = text \"--\"\n", "num_lines": 207}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Code generation for the Static Pointer Table\n--\n-- (c) 2014 I/O Tweag\n--\n-- Each module that uses 'static' keyword declares an initialization function of\n-- the form hs_spt_init_<module>() which is emitted into the _stub.c file and\n-- annotated with __attribute__((constructor)) so that it gets executed at\n-- startup time.\n--\n-- The function's purpose is to call hs_spt_insert to insert the static\n-- pointers of this module in the hashtable of the RTS, and it looks something\n-- like this:\n--\n-- > static void hs_hpc_init_Main(void) __attribute__((constructor));\n-- > static void hs_hpc_init_Main(void) {\n-- >\n-- >   static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};\n-- >   extern StgPtr Main_r2wb_closure;\n-- >   hs_spt_insert(k0, &Main_r2wb_closure);\n-- >\n-- >   static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};\n-- >   extern StgPtr Main_r2wc_closure;\n-- >   hs_spt_insert(k1, &Main_r2wc_closure);\n-- >\n-- > }\n--\n-- where the constants are fingerprints produced from the static forms.\n--\n-- The linker must find the definitions matching the @extern StgPtr <name>@\n-- declarations. For this to work, the identifiers of static pointers need to be\n-- exported. This is done in SetLevels.newLvlVar.\n--\n-- There is also a finalization function for the time when the module is\n-- unloaded.\n--\n-- > static void hs_hpc_fini_Main(void) __attribute__((destructor));\n-- > static void hs_hpc_fini_Main(void) {\n-- >\n-- >   static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};\n-- >   hs_spt_remove(k0);\n-- >\n-- >   static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};\n-- >   hs_spt_remove(k1);\n-- >\n-- > }\n--\n\n{-# LANGUAGE ViewPatterns, TupleSections #-}\nmodule StaticPtrTable\n    ( sptCreateStaticBinds\n    , sptModuleInitCode\n    ) where\n\n{- Note [Grand plan for static forms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nStatic forms go through the compilation phases as follows.\nHere is a running example:\n\n   f x = let k = map toUpper\n         in ...(static k)...\n\n* The renamer looks for out-of-scope names in the body of the static\n  form, as always. If all names are in scope, the free variables of the\n  body are stored in AST at the location of the static form.\n\n* The typechecker verifies that all free variables occurring in the\n  static form are floatable to top level (see Note [Meaning of\n  IdBindingInfo] in TcRnTypes).  In our example, 'k' is floatable.\n  Even though it is bound in a nested let, we are fine.\n\n* The desugarer replaces the static form with an application of the\n  function 'makeStatic' (defined in module GHC.StaticPtr.Internal of\n  base).  So we get\n\n   f x = let k = map toUpper\n         in ...fromStaticPtr (makeStatic location k)...\n\n* The simplifier runs the FloatOut pass which moves the calls to 'makeStatic'\n  to the top level. Thus the FloatOut pass is always executed, even when\n  optimizations are disabled.  So we get\n\n   k = map toUpper\n   static_ptr = makeStatic location k\n   f x = ...fromStaticPtr static_ptr...\n\n  The FloatOut pass is careful to produce an /exported/ Id for a floated\n  'makeStatic' call, so the binding is not removed or inlined by the\n  simplifier.\n  E.g. the code for `f` above might look like\n\n    static_ptr = makeStatic location k\n    f x = ...(case static_ptr of ...)...\n\n  which might be simplified to\n\n    f x = ...(case makeStatic location k of ...)...\n\n  BUT the top-level binding for static_ptr must remain, so that it can be\n  collected to populate the Static Pointer Table.\n\n  Making the binding exported also has a necessary effect during the\n  CoreTidy pass.\n\n* The CoreTidy pass replaces all bindings of the form\n\n  b = /\\ ... -> makeStatic location value\n\n  with\n\n  b = /\\ ... -> StaticPtr key (StaticPtrInfo \"pkg key\" \"module\" location) value\n\n  where a distinct key is generated for each binding.\n\n* If we are compiling to object code we insert a C stub (generated by\n  sptModuleInitCode) into the final object which runs when the module is loaded,\n  inserting the static forms defined by the module into the RTS's static pointer\n  table.\n\n* If we are compiling for the byte-code interpreter, we instead explicitly add\n  the SPT entries (recorded in CgGuts' cg_spt_entries field) to the interpreter\n  process' SPT table using the addSptEntry interpreter message. This happens\n  in upsweep after we have compiled the module (see GhcMake.upsweep').\n-}\n\nimport GhcPrelude\n\nimport CLabel\nimport CoreSyn\nimport CoreUtils (collectMakeStaticArgs)\nimport DataCon\nimport DynFlags\nimport HscTypes\nimport Id\nimport MkCore (mkStringExprFSWith)\nimport Module\nimport Name\nimport Outputable\nimport Platform\nimport PrelNames\nimport TcEnv (lookupGlobal)\nimport Type\n\nimport Control.Monad.Trans.Class (lift)\nimport Control.Monad.Trans.State\nimport Data.List\nimport Data.Maybe\nimport GHC.Fingerprint\nimport qualified GHC.LanguageExtensions as LangExt\n\n-- | Replaces all bindings of the form\n--\n-- > b = /\\ ... -> makeStatic location value\n--\n--  with\n--\n-- > b = /\\ ... ->\n-- >   StaticPtr key (StaticPtrInfo \"pkg key\" \"module\" location) value\n--\n--  where a distinct key is generated for each binding.\n--\n-- It also yields the C stub that inserts these bindings into the static\n-- pointer table.\nsptCreateStaticBinds :: HscEnv -> Module -> CoreProgram\n                     -> IO ([SptEntry], CoreProgram)\nsptCreateStaticBinds hsc_env this_mod binds\n    | not (xopt LangExt.StaticPointers dflags) =\n      return ([], binds)\n    | otherwise = do\n      -- Make sure the required interface files are loaded.\n      _ <- lookupGlobal hsc_env unpackCStringName\n      (fps, binds') <- evalStateT (go [] [] binds) 0\n      return (fps, binds')\n  where\n    go fps bs xs = case xs of\n      []        -> return (reverse fps, reverse bs)\n      bnd : xs' -> do\n        (fps', bnd') <- replaceStaticBind bnd\n        go (reverse fps' ++ fps) (bnd' : bs) xs'\n\n    dflags = hsc_dflags hsc_env\n\n    -- Generates keys and replaces 'makeStatic' with 'StaticPtr'.\n    --\n    -- The 'Int' state is used to produce a different key for each binding.\n    replaceStaticBind :: CoreBind\n                      -> StateT Int IO ([SptEntry], CoreBind)\n    replaceStaticBind (NonRec b e) = do (mfp, (b', e')) <- replaceStatic b e\n                                        return (maybeToList mfp, NonRec b' e')\n    replaceStaticBind (Rec rbs) = do\n      (mfps, rbs') <- unzip <$> mapM (uncurry replaceStatic) rbs\n      return (catMaybes mfps, Rec rbs')\n\n    replaceStatic :: Id -> CoreExpr\n                  -> StateT Int IO (Maybe SptEntry, (Id, CoreExpr))\n    replaceStatic b e@(collectTyBinders -> (tvs, e0)) =\n      case collectMakeStaticArgs e0 of\n        Nothing      -> return (Nothing, (b, e))\n        Just (_, t, info, arg) -> do\n          (fp, e') <- mkStaticBind t info arg\n          return (Just (SptEntry b fp), (b, foldr Lam e' tvs))\n\n    mkStaticBind :: Type -> CoreExpr -> CoreExpr\n                 -> StateT Int IO (Fingerprint, CoreExpr)\n    mkStaticBind t srcLoc e = do\n      i <- get\n      put (i + 1)\n      staticPtrInfoDataCon <-\n        lift $ lookupDataConHscEnv staticPtrInfoDataConName\n      let fp@(Fingerprint w0 w1) = mkStaticPtrFingerprint i\n      info <- mkConApp staticPtrInfoDataCon <$>\n            (++[srcLoc]) <$>\n            mapM (mkStringExprFSWith (lift . lookupIdHscEnv))\n                 [ unitIdFS $ moduleUnitId this_mod\n                 , moduleNameFS $ moduleName this_mod\n                 ]\n\n      -- The module interface of GHC.StaticPtr should be loaded at least\n      -- when looking up 'fromStatic' during type-checking.\n      staticPtrDataCon <- lift $ lookupDataConHscEnv staticPtrDataConName\n      return (fp, mkConApp staticPtrDataCon\n                               [ Type t\n                               , mkWord64LitWordRep dflags w0\n                               , mkWord64LitWordRep dflags w1\n                               , info\n                               , e ])\n\n    mkStaticPtrFingerprint :: Int -> Fingerprint\n    mkStaticPtrFingerprint n = fingerprintString $ intercalate \":\"\n        [ unitIdString $ moduleUnitId this_mod\n        , moduleNameString $ moduleName this_mod\n        , show n\n        ]\n\n    -- Choose either 'Word64#' or 'Word#' to represent the arguments of the\n    -- 'Fingerprint' data constructor.\n    mkWord64LitWordRep dflags\n      | platformWordSize (targetPlatform dflags) < 8 = mkWord64LitWord64\n      | otherwise = mkWordLit dflags . toInteger\n\n    lookupIdHscEnv :: Name -> IO Id\n    lookupIdHscEnv n = lookupTypeHscEnv hsc_env n >>=\n                         maybe (getError n) (return . tyThingId)\n\n    lookupDataConHscEnv :: Name -> IO DataCon\n    lookupDataConHscEnv n = lookupTypeHscEnv hsc_env n >>=\n                              maybe (getError n) (return . tyThingDataCon)\n\n    getError n = pprPanic \"sptCreateStaticBinds.get: not found\" $\n      text \"Couldn't find\" <+> ppr n\n\n-- | @sptModuleInitCode module fps@ is a C stub to insert the static entries\n-- of @module@ into the static pointer table.\n--\n-- @fps@ is a list associating each binding corresponding to a static entry with\n-- its fingerprint.\nsptModuleInitCode :: Module -> [SptEntry] -> SDoc\nsptModuleInitCode _ [] = Outputable.empty\nsptModuleInitCode this_mod entries = vcat\n    [ text \"static void hs_spt_init_\" <> ppr this_mod\n           <> text \"(void) __attribute__((constructor));\"\n    , text \"static void hs_spt_init_\" <> ppr this_mod <> text \"(void)\"\n    , braces $ vcat $\n        [  text \"static StgWord64 k\" <> int i <> text \"[2] = \"\n           <> pprFingerprint fp <> semi\n        $$ text \"extern StgPtr \"\n           <> (ppr $ mkClosureLabel (idName n) (idCafInfo n)) <> semi\n        $$ text \"hs_spt_insert\" <> parens\n             (hcat $ punctuate comma\n                [ char 'k' <> int i\n                , char '&' <> ppr (mkClosureLabel (idName n) (idCafInfo n))\n                ]\n             )\n        <> semi\n        |  (i, SptEntry n fp) <- zip [0..] entries\n        ]\n    , text \"static void hs_spt_fini_\" <> ppr this_mod\n           <> text \"(void) __attribute__((destructor));\"\n    , text \"static void hs_spt_fini_\" <> ppr this_mod <> text \"(void)\"\n    , braces $ vcat $\n        [  text \"StgWord64 k\" <> int i <> text \"[2] = \"\n           <> pprFingerprint fp <> semi\n        $$ text \"hs_spt_remove\" <> parens (char 'k' <> int i) <> semi\n        | (i, (SptEntry _ fp)) <- zip [0..] entries\n        ]\n    ]\n  where\n    pprFingerprint :: Fingerprint -> SDoc\n    pprFingerprint (Fingerprint w1 w2) =\n      braces $ hcat $ punctuate comma\n                 [ integer (fromIntegral w1) <> text \"ULL\"\n                 , integer (fromIntegral w2) <> text \"ULL\"\n                 ]\n", "num_lines": 293}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n-----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2001-2003\n--\n-- Access to system tools: gcc, cp, rm etc\n--\n-----------------------------------------------------------------------------\n-}\n\n{-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-}\n\nmodule SysTools (\n        -- * Initialisation\n        initSysTools,\n        initLlvmConfig,\n\n        -- * Interface to system tools\n        module SysTools.Tasks,\n        module SysTools.Info,\n\n        linkDynLib,\n\n        copy,\n        copyWithHeader,\n\n        -- * General utilities\n        Option(..),\n        expandTopDir,\n\n        -- * Platform-specifics\n        libmLinkOpts,\n\n        -- * Mac OS X frameworks\n        getPkgFrameworkOpts,\n        getFrameworkOpts\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Module\nimport Packages\nimport Config\nimport Outputable\nimport ErrUtils\nimport Platform\nimport Util\nimport DynFlags\nimport Fingerprint\n\nimport System.FilePath\nimport System.IO\nimport System.Directory\nimport SysTools.ExtraObj\nimport SysTools.Info\nimport SysTools.Tasks\nimport SysTools.BaseDir\n\n{-\nNote [How GHC finds toolchain utilities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nSysTools.initSysProgs figures out exactly where all the auxiliary programs\nare, and initialises mutable variables to make it easy to call them.\nTo do this, it makes use of definitions in Config.hs, which is a Haskell\nfile containing variables whose value is figured out by the build system.\n\nConfig.hs contains two sorts of things\n\n  cGCC,         The *names* of the programs\n  cCPP            e.g.  cGCC = gcc\n  cUNLIT                cCPP = gcc -E\n  etc           They do *not* include paths\n\n\n  cUNLIT_DIR   The *path* to the directory containing unlit, split etc\n  cSPLIT_DIR   *relative* to the root of the build tree,\n                   for use when running *in-place* in a build tree (only)\n\n\n---------------------------------------------\nNOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):\n\nAnother hair-brained scheme for simplifying the current tool location\nnightmare in GHC: Simon originally suggested using another\nconfiguration file along the lines of GCC's specs file - which is fine\nexcept that it means adding code to read yet another configuration\nfile.  What I didn't notice is that the current package.conf is\ngeneral enough to do this:\n\nPackage\n    {name = \"tools\",    import_dirs = [],  source_dirs = [],\n     library_dirs = [], hs_libraries = [], extra_libraries = [],\n     include_dirs = [], c_includes = [],   package_deps = [],\n     extra_ghc_opts = [\"-pgmc/usr/bin/gcc\",\"-pgml${topdir}/bin/unlit\", ... etc.],\n     extra_cc_opts = [], extra_ld_opts = []}\n\nWhich would have the advantage that we get to collect together in one\nplace the path-specific package stuff with the path-specific tool\nstuff.\n                End of NOTES\n---------------------------------------------\n\n************************************************************************\n*                                                                      *\n\\subsection{Initialisation}\n*                                                                      *\n************************************************************************\n-}\n\ninitLlvmConfig :: String\n               -> IO LlvmConfig\ninitLlvmConfig top_dir\n  = do\n      targets <- readAndParse \"llvm-targets\" mkLlvmTarget\n      passes <- readAndParse \"llvm-passes\" id\n      return (targets, passes)\n  where\n    readAndParse name builder =\n      do let llvmConfigFile = top_dir </> name\n         llvmConfigStr <- readFile llvmConfigFile\n         case maybeReadFuzzy llvmConfigStr of\n           Just s -> return (fmap builder <$> s)\n           Nothing -> pgmError (\"Can't parse \" ++ show llvmConfigFile)\n\n    mkLlvmTarget :: (String, String, String) -> LlvmTarget\n    mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)\n\n\ninitSysTools :: String          -- TopDir path\n             -> IO Settings     -- Set all the mutable variables above, holding\n                                --      (a) the system programs\n                                --      (b) the package-config file\n                                --      (c) the GHC usage message\ninitSysTools top_dir\n  = do       -- see Note [topdir: How GHC finds its files]\n             -- NB: top_dir is assumed to be in standard Unix\n             -- format, '/' separated\n       mtool_dir <- findToolDir top_dir\n             -- see Note [tooldir: How GHC finds mingw on Windows]\n\n       let installed :: FilePath -> FilePath\n           installed file = top_dir </> file\n           libexec :: FilePath -> FilePath\n           libexec file = top_dir </> \"bin\" </> file\n           settingsFile = installed \"settings\"\n           platformConstantsFile = installed \"platformConstants\"\n\n       settingsStr <- readFile settingsFile\n       platformConstantsStr <- readFile platformConstantsFile\n       mySettings <- case maybeReadFuzzy settingsStr of\n                     Just s ->\n                         return s\n                     Nothing ->\n                         pgmError (\"Can't parse \" ++ show settingsFile)\n       platformConstants <- case maybeReadFuzzy platformConstantsStr of\n                            Just s ->\n                                return s\n                            Nothing ->\n                                pgmError (\"Can't parse \" ++\n                                          show platformConstantsFile)\n       let getSetting key = case lookup key mySettings of\n                            Just xs -> return $ expandTopDir top_dir xs\n                            Nothing -> pgmError (\"No entry for \" ++ show key ++ \" in \" ++ show settingsFile)\n           getToolSetting key = expandToolDir mtool_dir <$> getSetting key\n           getBooleanSetting key = case lookup key mySettings of\n                                   Just \"YES\" -> return True\n                                   Just \"NO\" -> return False\n                                   Just xs -> pgmError (\"Bad value for \" ++ show key ++ \": \" ++ show xs)\n                                   Nothing -> pgmError (\"No entry for \" ++ show key ++ \" in \" ++ show settingsFile)\n           readSetting key = case lookup key mySettings of\n                             Just xs ->\n                                 case maybeRead xs of\n                                 Just v -> return v\n                                 Nothing -> pgmError (\"Failed to read \" ++ show key ++ \" value \" ++ show xs)\n                             Nothing -> pgmError (\"No entry for \" ++ show key ++ \" in \" ++ show settingsFile)\n       crossCompiling <- getBooleanSetting \"cross compiling\"\n       targetArch <- readSetting \"target arch\"\n       targetOS <- readSetting \"target os\"\n       targetWordSize <- readSetting \"target word size\"\n       targetUnregisterised <- getBooleanSetting \"Unregisterised\"\n       targetHasGnuNonexecStack <- readSetting \"target has GNU nonexec stack\"\n       targetHasIdentDirective <- readSetting \"target has .ident directive\"\n       targetHasSubsectionsViaSymbols <- readSetting \"target has subsections via symbols\"\n       myExtraGccViaCFlags <- getSetting \"GCC extra via C opts\"\n       -- On Windows, mingw is distributed with GHC,\n       -- so we look in TopDir/../mingw/bin,\n       -- as well as TopDir/../../mingw/bin for hadrian.\n       -- It would perhaps be nice to be able to override this\n       -- with the settings file, but it would be a little fiddly\n       -- to make that possible, so for now you can't.\n       gcc_prog <- getToolSetting \"C compiler command\"\n       gcc_args_str <- getSetting \"C compiler flags\"\n       gccSupportsNoPie <- getBooleanSetting \"C compiler supports -no-pie\"\n       cpp_prog <- getToolSetting \"Haskell CPP command\"\n       cpp_args_str <- getSetting \"Haskell CPP flags\"\n       let unreg_gcc_args = if targetUnregisterised\n                            then [\"-DNO_REGS\", \"-DUSE_MINIINTERPRETER\"]\n                            else []\n           -- TABLES_NEXT_TO_CODE affects the info table layout.\n           tntc_gcc_args\n            | mkTablesNextToCode targetUnregisterised\n               = [\"-DTABLES_NEXT_TO_CODE\"]\n            | otherwise = []\n           cpp_args= map Option (words cpp_args_str)\n           gcc_args = map Option (words gcc_args_str\n                               ++ unreg_gcc_args\n                               ++ tntc_gcc_args)\n       ldSupportsCompactUnwind <- getBooleanSetting \"ld supports compact unwind\"\n       ldSupportsBuildId       <- getBooleanSetting \"ld supports build-id\"\n       ldSupportsFilelist      <- getBooleanSetting \"ld supports filelist\"\n       ldIsGnuLd               <- getBooleanSetting \"ld is GNU ld\"\n\n       let pkgconfig_path = installed \"package.conf.d\"\n           ghc_usage_msg_path  = installed \"ghc-usage.txt\"\n           ghci_usage_msg_path = installed \"ghci-usage.txt\"\n\n             -- For all systems, unlit, split, mangle are GHC utilities\n             -- architecture-specific stuff is done when building Config.hs\n           unlit_path = libexec cGHC_UNLIT_PGM\n\n       windres_path <- getToolSetting \"windres command\"\n       libtool_path <- getToolSetting \"libtool command\"\n       ar_path <- getToolSetting \"ar command\"\n       ranlib_path <- getToolSetting \"ranlib command\"\n\n       tmpdir <- getTemporaryDirectory\n\n       touch_path <- getToolSetting \"touch command\"\n\n       mkdll_prog <- getToolSetting \"dllwrap command\"\n       let mkdll_args = []\n\n       -- cpp is derived from gcc on all platforms\n       -- HACK, see setPgmP below. We keep 'words' here to remember to fix\n       -- Config.hs one day.\n\n\n       -- Other things being equal, as and ld are simply gcc\n       gcc_link_args_str <- getSetting \"C compiler link flags\"\n       let   as_prog  = gcc_prog\n             as_args  = gcc_args\n             ld_prog  = gcc_prog\n             ld_args  = gcc_args ++ map Option (words gcc_link_args_str)\n\n       -- We just assume on command line\n       lc_prog <- getSetting \"LLVM llc command\"\n       lo_prog <- getSetting \"LLVM opt command\"\n       lcc_prog <- getSetting \"LLVM clang command\"\n\n       let iserv_prog = libexec \"ghc-iserv\"\n\n       let platform = Platform {\n                          platformArch = targetArch,\n                          platformOS   = targetOS,\n                          platformWordSize = targetWordSize,\n                          platformUnregisterised = targetUnregisterised,\n                          platformHasGnuNonexecStack = targetHasGnuNonexecStack,\n                          platformHasIdentDirective = targetHasIdentDirective,\n                          platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols,\n                          platformIsCrossCompiling = crossCompiling\n                      }\n\n       return $ Settings {\n                    sTargetPlatform = platform,\n                    sTmpDir         = normalise tmpdir,\n                    sGhcUsagePath   = ghc_usage_msg_path,\n                    sGhciUsagePath  = ghci_usage_msg_path,\n                    sToolDir        = mtool_dir,\n                    sTopDir         = top_dir,\n                    sRawSettings    = mySettings,\n                    sExtraGccViaCFlags = words myExtraGccViaCFlags,\n                    sSystemPackageConfig = pkgconfig_path,\n                    sLdSupportsCompactUnwind = ldSupportsCompactUnwind,\n                    sLdSupportsBuildId       = ldSupportsBuildId,\n                    sLdSupportsFilelist      = ldSupportsFilelist,\n                    sLdIsGnuLd               = ldIsGnuLd,\n                    sGccSupportsNoPie        = gccSupportsNoPie,\n                    sProgramName             = \"ghc\",\n                    sProjectVersion          = cProjectVersion,\n                    sPgm_L   = unlit_path,\n                    sPgm_P   = (cpp_prog, cpp_args),\n                    sPgm_F   = \"\",\n                    sPgm_c   = (gcc_prog, gcc_args),\n                    sPgm_a   = (as_prog, as_args),\n                    sPgm_l   = (ld_prog, ld_args),\n                    sPgm_dll = (mkdll_prog,mkdll_args),\n                    sPgm_T   = touch_path,\n                    sPgm_windres = windres_path,\n                    sPgm_libtool = libtool_path,\n                    sPgm_ar = ar_path,\n                    sPgm_ranlib = ranlib_path,\n                    sPgm_lo  = (lo_prog,[]),\n                    sPgm_lc  = (lc_prog,[]),\n                    sPgm_lcc = (lcc_prog,[]),\n                    sPgm_i   = iserv_prog,\n                    sOpt_L       = [],\n                    sOpt_P       = [],\n                    sOpt_P_fingerprint = fingerprint0,\n                    sOpt_F       = [],\n                    sOpt_c       = [],\n                    sOpt_a       = [],\n                    sOpt_l       = [],\n                    sOpt_windres = [],\n                    sOpt_lcc     = [],\n                    sOpt_lo      = [],\n                    sOpt_lc      = [],\n                    sOpt_i       = [],\n                    sPlatformConstants = platformConstants\n             }\n\n\n{- Note [Windows stack usage]\n\nSee: Trac #8870 (and #8834 for related info) and #12186\n\nOn Windows, occasionally we need to grow the stack. In order to do\nthis, we would normally just bump the stack pointer - but there's a\ncatch on Windows.\n\nIf the stack pointer is bumped by more than a single page, then the\npages between the initial pointer and the resulting location must be\nproperly committed by the Windows virtual memory subsystem. This is\nonly needed in the event we bump by more than one page (i.e 4097 bytes\nor more).\n\nWindows compilers solve this by emitting a call to a special function\ncalled _chkstk, which does this committing of the pages for you.\n\nThe reason this was causing a segfault was because due to the fact the\nnew code generator tends to generate larger functions, we needed more\nstack space in GHC itself. In the x86 codegen, we needed approximately\n~12kb of stack space in one go, which caused the process to segfault,\nas the intervening pages were not committed.\n\nGCC can emit such a check for us automatically but only when the flag\n-fstack-check is used.\n\nSee https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html\nfor more information.\n\n-}\n\ncopy :: DynFlags -> String -> FilePath -> FilePath -> IO ()\ncopy dflags purpose from to = copyWithHeader dflags purpose Nothing from to\n\ncopyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath\n               -> IO ()\ncopyWithHeader dflags purpose maybe_header from to = do\n  showPass dflags purpose\n\n  hout <- openBinaryFile to   WriteMode\n  hin  <- openBinaryFile from ReadMode\n  ls <- hGetContents hin -- inefficient, but it'll do for now. ToDo: speed up\n  maybe (return ()) (header hout) maybe_header\n  hPutStr hout ls\n  hClose hout\n  hClose hin\n where\n  -- write the header string in UTF-8.  The header is something like\n  --   {-# LINE \"foo.hs\" #-}\n  -- and we want to make sure a Unicode filename isn't mangled.\n  header h str = do\n   hSetEncoding h utf8\n   hPutStr h str\n   hSetBinaryMode h True\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Support code}\n*                                                                      *\n************************************************************************\n-}\n\nlinkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()\nlinkDynLib dflags0 o_files dep_packages\n = do\n    let -- This is a rather ugly hack to fix dynamically linked\n        -- GHC on Windows. If GHC is linked with -threaded, then\n        -- it links against libHSrts_thr. But if base is linked\n        -- against libHSrts, then both end up getting loaded,\n        -- and things go wrong. We therefore link the libraries\n        -- with the same RTS flags that we link GHC with.\n        dflags1 = if cGhcThreaded then addWay' WayThreaded dflags0\n                                  else                     dflags0\n        dflags2 = if cGhcDebugged then addWay' WayDebug dflags1\n                                  else                  dflags1\n        dflags = updateWays dflags2\n\n        verbFlags = getVerbFlags dflags\n        o_file = outputFile dflags\n\n    pkgs <- getPreloadPackagesAnd dflags dep_packages\n\n    let pkg_lib_paths = collectLibraryPaths dflags pkgs\n    let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths\n        get_pkg_lib_path_opts l\n         | ( osElfTarget (platformOS (targetPlatform dflags)) ||\n             osMachOTarget (platformOS (targetPlatform dflags)) ) &&\n           dynLibLoader dflags == SystemDependent &&\n           WayDyn `elem` ways dflags\n            = [\"-L\" ++ l, \"-Xlinker\", \"-rpath\", \"-Xlinker\", l]\n              -- See Note [-Xlinker -rpath vs -Wl,-rpath]\n         | otherwise = [\"-L\" ++ l]\n\n    let lib_paths = libraryPaths dflags\n    let lib_path_opts = map (\"-L\"++) lib_paths\n\n    -- We don't want to link our dynamic libs against the RTS package,\n    -- because the RTS lib comes in several flavours and we want to be\n    -- able to pick the flavour when a binary is linked.\n    -- On Windows we need to link the RTS import lib as Windows does\n    -- not allow undefined symbols.\n    -- The RTS library path is still added to the library search path\n    -- above in case the RTS is being explicitly linked in (see #3807).\n    let platform = targetPlatform dflags\n        os = platformOS platform\n        pkgs_no_rts = case os of\n                      OSMinGW32 ->\n                          pkgs\n                      _ ->\n                          filter ((/= rtsUnitId) . packageConfigId) pkgs\n    let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts\n                        in  package_hs_libs ++ extra_libs ++ other_flags\n\n        -- probably _stub.o files\n        -- and last temporary shared object file\n    let extra_ld_inputs = ldInputs dflags\n\n    -- frameworks\n    pkg_framework_opts <- getPkgFrameworkOpts dflags platform\n                                              (map unitId pkgs)\n    let framework_opts = getFrameworkOpts dflags platform\n\n    case os of\n        OSMinGW32 -> do\n            -------------------------------------------------------------\n            -- Making a DLL\n            -------------------------------------------------------------\n            let output_fn = case o_file of\n                            Just s -> s\n                            Nothing -> \"HSdll.dll\"\n\n            runLink dflags (\n                    map Option verbFlags\n                 ++ [ Option \"-o\"\n                    , FileOption \"\" output_fn\n                    , Option \"-shared\"\n                    ] ++\n                    [ FileOption \"-Wl,--out-implib=\" (output_fn ++ \".a\")\n                    | gopt Opt_SharedImplib dflags\n                    ]\n                 ++ map (FileOption \"\") o_files\n\n                 -- Permit the linker to auto link _symbol to _imp_symbol\n                 -- This lets us link against DLLs without needing an \"import library\"\n                 ++ [Option \"-Wl,--enable-auto-import\"]\n\n                 ++ extra_ld_inputs\n                 ++ map Option (\n                    lib_path_opts\n                 ++ pkg_lib_path_opts\n                 ++ pkg_link_opts\n                ))\n        _ | os == OSDarwin -> do\n            -------------------------------------------------------------------\n            -- Making a darwin dylib\n            -------------------------------------------------------------------\n            -- About the options used for Darwin:\n            -- -dynamiclib\n            --   Apple's way of saying -shared\n            -- -undefined dynamic_lookup:\n            --   Without these options, we'd have to specify the correct\n            --   dependencies for each of the dylibs. Note that we could\n            --   (and should) do without this for all libraries except\n            --   the RTS; all we need to do is to pass the correct\n            --   HSfoo_dyn.dylib files to the link command.\n            --   This feature requires Mac OS X 10.3 or later; there is\n            --   a similar feature, -flat_namespace -undefined suppress,\n            --   which works on earlier versions, but it has other\n            --   disadvantages.\n            -- -single_module\n            --   Build the dynamic library as a single \"module\", i.e. no\n            --   dynamic binding nonsense when referring to symbols from\n            --   within the library. The NCG assumes that this option is\n            --   specified (on i386, at least).\n            -- -install_name\n            --   Mac OS/X stores the path where a dynamic library is (to\n            --   be) installed in the library itself.  It's called the\n            --   \"install name\" of the library. Then any library or\n            --   executable that links against it before it's installed\n            --   will search for it in its ultimate install location.\n            --   By default we set the install name to the absolute path\n            --   at build time, but it can be overridden by the\n            --   -dylib-install-name option passed to ghc. Cabal does\n            --   this.\n            -------------------------------------------------------------------\n\n            let output_fn = case o_file of { Just s -> s; Nothing -> \"a.out\"; }\n\n            instName <- case dylibInstallName dflags of\n                Just n -> return n\n                Nothing -> return $ \"@rpath\" `combine` (takeFileName output_fn)\n            runLink dflags (\n                    map Option verbFlags\n                 ++ [ Option \"-dynamiclib\"\n                    , Option \"-o\"\n                    , FileOption \"\" output_fn\n                    ]\n                 ++ map Option o_files\n                 ++ [ Option \"-undefined\",\n                      Option \"dynamic_lookup\",\n                      Option \"-single_module\" ]\n                 ++ (if platformArch platform == ArchX86_64\n                     then [ ]\n                     else [ Option \"-Wl,-read_only_relocs,suppress\" ])\n                 ++ [ Option \"-install_name\", Option instName ]\n                 ++ map Option lib_path_opts\n                 ++ extra_ld_inputs\n                 ++ map Option framework_opts\n                 ++ map Option pkg_lib_path_opts\n                 ++ map Option pkg_link_opts\n                 ++ map Option pkg_framework_opts\n                 ++ [ Option \"-Wl,-dead_strip_dylibs\" ]\n              )\n        _ -> do\n            -------------------------------------------------------------------\n            -- Making a DSO\n            -------------------------------------------------------------------\n\n            let output_fn = case o_file of { Just s -> s; Nothing -> \"a.out\"; }\n                unregisterised = platformUnregisterised (targetPlatform dflags)\n            let bsymbolicFlag = -- we need symbolic linking to resolve\n                                -- non-PIC intra-package-relocations for\n                                -- performance (where symbolic linking works)\n                                -- See Note [-Bsymbolic assumptions by GHC]\n                                [\"-Wl,-Bsymbolic\" | not unregisterised]\n\n            runLink dflags (\n                    map Option verbFlags\n                 ++ libmLinkOpts\n                 ++ [ Option \"-o\"\n                    , FileOption \"\" output_fn\n                    ]\n                 ++ map Option o_files\n                 ++ [ Option \"-shared\" ]\n                 ++ map Option bsymbolicFlag\n                    -- Set the library soname. We use -h rather than -soname as\n                    -- Solaris 10 doesn't support the latter:\n                 ++ [ Option (\"-Wl,-h,\" ++ takeFileName output_fn) ]\n                 ++ extra_ld_inputs\n                 ++ map Option lib_path_opts\n                 ++ map Option pkg_lib_path_opts\n                 ++ map Option pkg_link_opts\n              )\n\n-- | Some platforms require that we explicitly link against @libm@ if any\n-- math-y things are used (which we assume to include all programs). See #14022.\nlibmLinkOpts :: [Option]\nlibmLinkOpts =\n#if defined(HAVE_LIBM)\n  [Option \"-lm\"]\n#else\n  []\n#endif\n\ngetPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]\ngetPkgFrameworkOpts dflags platform dep_packages\n  | platformUsesFrameworks platform = do\n    pkg_framework_path_opts <- do\n        pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages\n        return $ map (\"-F\" ++) pkg_framework_paths\n\n    pkg_framework_opts <- do\n        pkg_frameworks <- getPackageFrameworks dflags dep_packages\n        return $ concat [ [\"-framework\", fw] | fw <- pkg_frameworks ]\n\n    return (pkg_framework_path_opts ++ pkg_framework_opts)\n\n  | otherwise = return []\n\ngetFrameworkOpts :: DynFlags -> Platform -> [String]\ngetFrameworkOpts dflags platform\n  | platformUsesFrameworks platform = framework_path_opts ++ framework_opts\n  | otherwise = []\n  where\n    framework_paths     = frameworkPaths dflags\n    framework_path_opts = map (\"-F\" ++) framework_paths\n\n    frameworks     = cmdlineFrameworks dflags\n    -- reverse because they're added in reverse order from the cmd line:\n    framework_opts = concat [ [\"-framework\", fw]\n                            | fw <- reverse frameworks ]\n\n{-\nNote [-Bsymbolic assumptions by GHC]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nGHC has a few assumptions about interaction of relocations in NCG and linker:\n\n1. -Bsymbolic resolves internal references when the shared library is linked,\n   which is important for performance.\n2. When there is a reference to data in a shared library from the main program,\n   the runtime linker relocates the data object into the main program using an\n   R_*_COPY relocation.\n3. If we used -Bsymbolic, then this results in multiple copies of the data\n   object, because some references have already been resolved to point to the\n   original instance. This is bad!\n\nWe work around [3.] for native compiled code by avoiding the generation of\nR_*_COPY relocations.\n\nUnregisterised compiler can't evade R_*_COPY relocations easily thus we disable\n-Bsymbolic linking there.\n\nSee related Trac tickets: #4210, #15338\n-}\n", "num_lines": 621}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section{Tidying up Core}\n-}\n\n{-# LANGUAGE CPP, ViewPatterns #-}\n\nmodule TidyPgm (\n       mkBootModDetailsTc, tidyProgram, globaliseAndTidyId\n   ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnTypes\nimport DynFlags\nimport CoreSyn\nimport CoreUnfold\nimport CoreFVs\nimport CoreTidy\nimport CoreMonad\nimport CorePrep\nimport CoreUtils        (rhsIsStatic)\nimport CoreStats        (coreBindsStats, CoreStats(..))\nimport CoreSeq          (seqBinds)\nimport CoreLint\nimport Literal\nimport Rules\nimport PatSyn\nimport ConLike\nimport CoreArity        ( exprArity, exprBotStrictness_maybe )\nimport StaticPtrTable\nimport VarEnv\nimport VarSet\nimport Var\nimport Id\nimport MkId             ( mkDictSelRhs )\nimport IdInfo\nimport InstEnv\nimport FamInstEnv\nimport Type             ( tidyTopType )\nimport Demand           ( appIsBottom, isTopSig, isBottomingSig )\nimport BasicTypes\nimport Name hiding (varName)\nimport NameSet\nimport NameEnv\nimport NameCache\nimport Avail\nimport IfaceEnv\nimport TcEnv\nimport TcRnMonad\nimport DataCon\nimport TyCon\nimport Class\nimport Module\nimport Packages( isDllName )\nimport HscTypes\nimport Maybes\nimport UniqSupply\nimport Outputable\nimport qualified ErrUtils as Err\n\nimport Control.Monad\nimport Data.Function\nimport Data.List        ( sortBy )\nimport Data.IORef       ( atomicModifyIORef' )\n\n{-\nConstructing the TypeEnv, Instances, Rules from which the\nModIface is constructed, and which goes on to subsequent modules in\n--make mode.\n\nMost of the interface file is obtained simply by serialising the\nTypeEnv.  One important consequence is that if the *interface file*\nhas pragma info if and only if the final TypeEnv does. This is not so\nimportant for *this* module, but it's essential for ghc --make:\nsubsequent compilations must not see (e.g.) the arity if the interface\nfile does not contain arity If they do, they'll exploit the arity;\nthen the arity might change, but the iface file doesn't change =>\nrecompilation does not happen => disaster.\n\nFor data types, the final TypeEnv will have a TyThing for the TyCon,\nplus one for each DataCon; the interface file will contain just one\ndata type declaration, but it is de-serialised back into a collection\nof TyThings.\n\n************************************************************************\n*                                                                      *\n                Plan A: simpleTidyPgm\n*                                                                      *\n************************************************************************\n\n\nPlan A: mkBootModDetails: omit pragmas, make interfaces small\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Ignore the bindings\n\n* Drop all WiredIn things from the TypeEnv\n        (we never want them in interface files)\n\n* Retain all TyCons and Classes in the TypeEnv, to avoid\n        having to find which ones are mentioned in the\n        types of exported Ids\n\n* Trim off the constructors of non-exported TyCons, both\n        from the TyCon and from the TypeEnv\n\n* Drop non-exported Ids from the TypeEnv\n\n* Tidy the types of the DFunIds of Instances,\n  make them into GlobalIds, (they already have External Names)\n  and add them to the TypeEnv\n\n* Tidy the types of the (exported) Ids in the TypeEnv,\n  make them into GlobalIds (they already have External Names)\n\n* Drop rules altogether\n\n* Tidy the bindings, to ensure that the Caf and Arity\n  information is correct for each top-level binder; the\n  code generator needs it. And to ensure that local names have\n  distinct OccNames in case of object-file splitting\n\n* If this an hsig file, drop the instances altogether too (they'll\n  get pulled in by the implicit module import.\n-}\n\n-- This is Plan A: make a small type env when typechecking only,\n-- or when compiling a hs-boot file, or simply when not using -O\n--\n-- We don't look at the bindings at all -- there aren't any\n-- for hs-boot files\n\nmkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails\nmkBootModDetailsTc hsc_env\n        TcGblEnv{ tcg_exports   = exports,\n                  tcg_type_env  = type_env, -- just for the Ids\n                  tcg_tcs       = tcs,\n                  tcg_patsyns   = pat_syns,\n                  tcg_insts     = insts,\n                  tcg_fam_insts = fam_insts,\n                  tcg_mod       = this_mod\n                }\n  = -- This timing isn't terribly useful since the result isn't forced, but\n    -- the message is useful to locating oneself in the compilation process.\n    Err.withTiming (pure dflags)\n                   (text \"CoreTidy\"<+>brackets (ppr this_mod))\n                   (const ()) $\n    do  { let { insts'     = map (tidyClsInstDFun globaliseAndTidyId) insts\n              ; pat_syns'  = map (tidyPatSynIds   globaliseAndTidyId) pat_syns\n              ; type_env1  = mkBootTypeEnv (availsToNameSet exports)\n                                           (typeEnvIds type_env) tcs fam_insts\n              ; type_env2  = extendTypeEnvWithPatSyns pat_syns' type_env1\n              ; dfun_ids   = map instanceDFunId insts'\n              ; type_env'  = extendTypeEnvWithIds type_env2 dfun_ids\n              }\n        ; return (ModDetails { md_types     = type_env'\n                             , md_insts     = insts'\n                             , md_fam_insts = fam_insts\n                             , md_rules     = []\n                             , md_anns      = []\n                             , md_exports   = exports\n                             , md_complete_sigs = []\n                             })\n        }\n  where\n    dflags = hsc_dflags hsc_env\n\nmkBootTypeEnv :: NameSet -> [Id] -> [TyCon] -> [FamInst] -> TypeEnv\nmkBootTypeEnv exports ids tcs fam_insts\n  = tidyTypeEnv True $\n       typeEnvFromEntities final_ids tcs fam_insts\n  where\n        -- Find the LocalIds in the type env that are exported\n        -- Make them into GlobalIds, and tidy their types\n        --\n        -- It's very important to remove the non-exported ones\n        -- because we don't tidy the OccNames, and if we don't remove\n        -- the non-exported ones we'll get many things with the\n        -- same name in the interface file, giving chaos.\n        --\n        -- Do make sure that we keep Ids that are already Global.\n        -- When typechecking an .hs-boot file, the Ids come through as\n        -- GlobalIds.\n    final_ids = [ (if isLocalId id then globaliseAndTidyId id\n                                   else id)\n                        `setIdUnfolding` BootUnfolding\n                | id <- ids\n                , keep_it id ]\n\n        -- default methods have their export flag set, but everything\n        -- else doesn't (yet), because this is pre-desugaring, so we\n        -- must test both.\n    keep_it id = isExportedId id || idName id `elemNameSet` exports\n\n\n\nglobaliseAndTidyId :: Id -> Id\n-- Takes a LocalId with an External Name,\n-- makes it into a GlobalId\n--     * unchanged Name (might be Internal or External)\n--     * unchanged details\n--     * VanillaIdInfo (makes a conservative assumption about Caf-hood)\nglobaliseAndTidyId id\n  = Id.setIdType (globaliseId id) tidy_type\n  where\n    tidy_type = tidyTopType (idType id)\n\n{-\n************************************************************************\n*                                                                      *\n        Plan B: tidy bindings, make TypeEnv full of IdInfo\n*                                                                      *\n************************************************************************\n\nPlan B: include pragmas, make interfaces\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Step 1: Figure out which Ids are externally visible\n          See Note [Choosing external Ids]\n\n* Step 2: Gather the externally visible rules, separately from\n          the top-level bindings.\n          See Note [Finding external rules]\n\n* Step 3: Tidy the bindings, externalising appropriate Ids\n          See Note [Tidy the top-level bindings]\n\n* Drop all Ids from the TypeEnv, and add all the External Ids from\n  the bindings.  (This adds their IdInfo to the TypeEnv; and adds\n  floated-out Ids that weren't even in the TypeEnv before.)\n\nNote [Choosing external Ids]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee also the section \"Interface stability\" in the\nRecompilationAvoidance commentary:\n  http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance\n\nFirst we figure out which Ids are \"external\" Ids.  An\n\"external\" Id is one that is visible from outside the compilation\nunit.  These are\n  a) the user exported ones\n  b) the ones bound to static forms\n  c) ones mentioned in the unfoldings, workers, or\n     rules of externally-visible ones\n\nWhile figuring out which Ids are external, we pick a \"tidy\" OccName\nfor each one.  That is, we make its OccName distinct from the other\nexternal OccNames in this module, so that in interface files and\nobject code we can refer to it unambiguously by its OccName.  The\nOccName for each binder is prefixed by the name of the exported Id\nthat references it; e.g. if \"f\" references \"x\" in its unfolding, then\n\"x\" is renamed to \"f_x\".  This helps distinguish the different \"x\"s\nfrom each other, and means that if \"f\" is later removed, things that\ndepend on the other \"x\"s will not need to be recompiled.  Of course,\nif there are multiple \"f_x\"s, then we have to disambiguate somehow; we\nuse \"f_x0\", \"f_x1\" etc.\n\nAs far as possible we should assign names in a deterministic fashion.\nEach time this module is compiled with the same options, we should end\nup with the same set of external names with the same types.  That is,\nthe ABI hash in the interface should not change.  This turns out to be\nquite tricky, since the order of the bindings going into the tidy\nphase is already non-deterministic, as it is based on the ordering of\nUniques, which are assigned unpredictably.\n\nTo name things in a stable way, we do a depth-first-search of the\nbindings, starting from the exports sorted by name.  This way, as long\nas the bindings themselves are deterministic (they sometimes aren't!),\nthe order in which they are presented to the tidying phase does not\naffect the names we assign.\n\nNote [Tidy the top-level bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNext we traverse the bindings top to bottom.  For each *top-level*\nbinder\n\n 1. Make it into a GlobalId; its IdDetails becomes VanillaGlobal,\n    reflecting the fact that from now on we regard it as a global,\n    not local, Id\n\n 2. Give it a system-wide Unique.\n    [Even non-exported things need system-wide Uniques because the\n    byte-code generator builds a single Name->BCO symbol table.]\n\n    We use the NameCache kept in the HscEnv as the\n    source of such system-wide uniques.\n\n    For external Ids, use the original-name cache in the NameCache\n    to ensure that the unique assigned is the same as the Id had\n    in any previous compilation run.\n\n 3. Rename top-level Ids according to the names we chose in step 1.\n    If it's an external Id, make it have a External Name, otherwise\n    make it have an Internal Name.  This is used by the code generator\n    to decide whether to make the label externally visible\n\n 4. Give it its UTTERLY FINAL IdInfo; in ptic,\n        * its unfolding, if it should have one\n\n        * its arity, computed from the number of visible lambdas\n\n        * its CAF info, computed from what is free in its RHS\n\n\nFinally, substitute these new top-level binders consistently\nthroughout, including in unfoldings.  We also tidy binders in\nRHSs, so that they print nicely in interfaces.\n-}\n\ntidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)\ntidyProgram hsc_env  (ModGuts { mg_module    = mod\n                              , mg_exports   = exports\n                              , mg_rdr_env   = rdr_env\n                              , mg_tcs       = tcs\n                              , mg_insts     = cls_insts\n                              , mg_fam_insts = fam_insts\n                              , mg_binds     = binds\n                              , mg_patsyns   = patsyns\n                              , mg_rules     = imp_rules\n                              , mg_anns      = anns\n                              , mg_complete_sigs = complete_sigs\n                              , mg_deps      = deps\n                              , mg_foreign   = foreign_stubs\n                              , mg_foreign_files = foreign_files\n                              , mg_hpc_info  = hpc_info\n                              , mg_modBreaks = modBreaks\n                              })\n\n  = Err.withTiming (pure dflags)\n                   (text \"CoreTidy\"<+>brackets (ppr mod))\n                   (const ()) $\n    do  { let { omit_prags = gopt Opt_OmitInterfacePragmas dflags\n              ; expose_all = gopt Opt_ExposeAllUnfoldings  dflags\n              ; print_unqual = mkPrintUnqualified dflags rdr_env\n              }\n\n        ; let { type_env = typeEnvFromEntities [] tcs fam_insts\n\n              ; implicit_binds\n                  = concatMap getClassImplicitBinds (typeEnvClasses type_env) ++\n                    concatMap getTyConImplicitBinds (typeEnvTyCons type_env)\n              }\n\n        ; (unfold_env, tidy_occ_env)\n              <- chooseExternalIds hsc_env mod omit_prags expose_all\n                                   binds implicit_binds imp_rules\n        ; let { (trimmed_binds, trimmed_rules)\n                    = findExternalRules omit_prags binds imp_rules unfold_env }\n\n        ; (tidy_env, tidy_binds)\n                 <- tidyTopBinds hsc_env mod unfold_env tidy_occ_env trimmed_binds\n\n        ; let { final_ids  = [ id | id <- bindersOfBinds tidy_binds,\n                                    isExternalName (idName id)]\n              ; type_env1  = extendTypeEnvWithIds type_env final_ids\n\n              ; tidy_cls_insts = map (tidyClsInstDFun (tidyVarOcc tidy_env)) cls_insts\n                -- A DFunId will have a binding in tidy_binds, and so will now be in\n                -- tidy_type_env, replete with IdInfo.  Its name will be unchanged since\n                -- it was born, but we want Global, IdInfo-rich (or not) DFunId in the\n                -- tidy_cls_insts.  Similarly the Ids inside a PatSyn.\n\n              ; tidy_rules = tidyRules tidy_env trimmed_rules\n                -- You might worry that the tidy_env contains IdInfo-rich stuff\n                -- and indeed it does, but if omit_prags is on, ext_rules is\n                -- empty\n\n                -- Tidy the Ids inside each PatSyn, very similarly to DFunIds\n                -- and then override the PatSyns in the type_env with the new tidy ones\n                -- This is really the only reason we keep mg_patsyns at all; otherwise\n                -- they could just stay in type_env\n              ; tidy_patsyns = map (tidyPatSynIds (tidyVarOcc tidy_env)) patsyns\n              ; type_env2    = extendTypeEnvWithPatSyns tidy_patsyns type_env1\n\n              ; tidy_type_env = tidyTypeEnv omit_prags type_env2\n              }\n          -- See Note [Grand plan for static forms] in StaticPtrTable.\n        ; (spt_entries, tidy_binds') <-\n             sptCreateStaticBinds hsc_env mod tidy_binds\n        ; let { spt_init_code = sptModuleInitCode mod spt_entries\n              ; add_spt_init_code =\n                  case hscTarget dflags of\n                    -- If we are compiling for the interpreter we will insert\n                    -- any necessary SPT entries dynamically\n                    HscInterpreted -> id\n                    -- otherwise add a C stub to do so\n                    _              -> (`appendStubC` spt_init_code)\n              }\n\n        ; let { -- See Note [Injecting implicit bindings]\n                all_tidy_binds = implicit_binds ++ tidy_binds'\n\n              -- Get the TyCons to generate code for.  Careful!  We must use\n              -- the untidied TypeEnv here, because we need\n              --  (a) implicit TyCons arising from types and classes defined\n              --      in this module\n              --  (b) wired-in TyCons, which are normally removed from the\n              --      TypeEnv we put in the ModDetails\n              --  (c) Constructors even if they are not exported (the\n              --      tidied TypeEnv has trimmed these away)\n              ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)\n              }\n\n        ; endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules\n\n          -- If the endPass didn't print the rules, but ddump-rules is\n          -- on, print now\n        ; unless (dopt Opt_D_dump_simpl dflags) $\n            Err.dumpIfSet_dyn dflags Opt_D_dump_rules\n              (showSDoc dflags (ppr CoreTidy <+> text \"rules\"))\n              (pprRulesForUser dflags tidy_rules)\n\n          -- Print one-line size info\n        ; let cs = coreBindsStats tidy_binds\n        ; Err.dumpIfSet_dyn dflags Opt_D_dump_core_stats \"Core Stats\"\n            (text \"Tidy size (terms,types,coercions)\"\n             <+> ppr (moduleName mod) <> colon\n             <+> int (cs_tm cs)\n             <+> int (cs_ty cs)\n             <+> int (cs_co cs) )\n\n        ; return (CgGuts { cg_module   = mod,\n                           cg_tycons   = alg_tycons,\n                           cg_binds    = all_tidy_binds,\n                           cg_foreign  = add_spt_init_code foreign_stubs,\n                           cg_foreign_files = foreign_files,\n                           cg_dep_pkgs = map fst $ dep_pkgs deps,\n                           cg_hpc_info = hpc_info,\n                           cg_modBreaks = modBreaks,\n                           cg_spt_entries = spt_entries },\n\n                   ModDetails { md_types     = tidy_type_env,\n                                md_rules     = tidy_rules,\n                                md_insts     = tidy_cls_insts,\n                                md_fam_insts = fam_insts,\n                                md_exports   = exports,\n                                md_anns      = anns,      -- are already tidy\n                                md_complete_sigs = complete_sigs\n                              })\n        }\n  where\n    dflags = hsc_dflags hsc_env\n\ntidyTypeEnv :: Bool       -- Compiling without -O, so omit prags\n            -> TypeEnv -> TypeEnv\n\n-- The completed type environment is gotten from\n--      a) the types and classes defined here (plus implicit things)\n--      b) adding Ids with correct IdInfo, including unfoldings,\n--              gotten from the bindings\n-- From (b) we keep only those Ids with External names;\n--          the CoreTidy pass makes sure these are all and only\n--          the externally-accessible ones\n-- This truncates the type environment to include only the\n-- exported Ids and things needed from them, which saves space\n--\n-- See Note [Don't attempt to trim data types]\n\ntidyTypeEnv omit_prags type_env\n = let\n        type_env1 = filterNameEnv (not . isWiredInName . getName) type_env\n          -- (1) remove wired-in things\n        type_env2 | omit_prags = mapNameEnv trimThing type_env1\n                  | otherwise  = type_env1\n          -- (2) trimmed if necessary\n    in\n    type_env2\n\n--------------------------\ntrimThing :: TyThing -> TyThing\n-- Trim off inessentials, for boot files and no -O\ntrimThing (AnId id)\n   | not (isImplicitId id)\n   = AnId (id `setIdInfo` vanillaIdInfo)\n\ntrimThing other_thing\n  = other_thing\n\nextendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv\nextendTypeEnvWithPatSyns tidy_patsyns type_env\n  = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]\n\n{-\nNote [Don't attempt to trim data types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor some time GHC tried to avoid exporting the data constructors\nof a data type if it wasn't strictly necessary to do so; see Trac #835.\nBut \"strictly necessary\" accumulated a longer and longer list\nof exceptions, and finally I gave up the battle:\n\n    commit 9a20e540754fc2af74c2e7392f2786a81d8d5f11\n    Author: Simon Peyton Jones <simonpj@microsoft.com>\n    Date:   Thu Dec 6 16:03:16 2012 +0000\n\n    Stop attempting to \"trim\" data types in interface files\n\n    Without -O, we previously tried to make interface files smaller\n    by not including the data constructors of data types.  But\n    there are a lot of exceptions, notably when Template Haskell is\n    involved or, more recently, DataKinds.\n\n    However Trac #7445 shows that even without TemplateHaskell, using\n    the Data class and invoking Language.Haskell.TH.Quote.dataToExpQ\n    is enough to require us to expose the data constructors.\n\n    So I've given up on this \"optimisation\" -- it's probably not\n    important anyway.  Now I'm simply not attempting to trim off\n    the data constructors.  The gain in simplicity is worth the\n    modest cost in interface file growth, which is limited to the\n    bits reqd to describe those data constructors.\n\n************************************************************************\n*                                                                      *\n        Implicit bindings\n*                                                                      *\n************************************************************************\n\nNote [Injecting implicit bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe inject the implicit bindings right at the end, in CoreTidy.\nSome of these bindings, notably record selectors, are not\nconstructed in an optimised form.  E.g. record selector for\n        data T = MkT { x :: {-# UNPACK #-} !Int }\nThen the unfolding looks like\n        x = \\t. case t of MkT x1 -> let x = I# x1 in x\nThis generates bad code unless it's first simplified a bit.  That is\nwhy CoreUnfold.mkImplicitUnfolding uses simpleOptExpr to do a bit of\noptimisation first.  (Only matters when the selector is used curried;\neg map x ys.)  See Trac #2070.\n\n[Oct 09: in fact, record selectors are no longer implicit Ids at all,\nbecause we really do want to optimise them properly. They are treated\nmuch like any other Id.  But doing \"light\" optimisation on an implicit\nId still makes sense.]\n\nAt one time I tried injecting the implicit bindings *early*, at the\nbeginning of SimplCore.  But that gave rise to real difficulty,\nbecause GlobalIds are supposed to have *fixed* IdInfo, but the\nsimplifier and other core-to-core passes mess with IdInfo all the\ntime.  The straw that broke the camels back was when a class selector\ngot the wrong arity -- ie the simplifier gave it arity 2, whereas\nimporting modules were expecting it to have arity 1 (Trac #2844).\nIt's much safer just to inject them right at the end, after tidying.\n\nOh: two other reasons for injecting them late:\n\n  - If implicit Ids are already in the bindings when we start TidyPgm,\n    we'd have to be careful not to treat them as external Ids (in\n    the sense of chooseExternalIds); else the Ids mentioned in *their*\n    RHSs will be treated as external and you get an interface file\n    saying      a18 = <blah>\n    but nothing referring to a18 (because the implicit Id is the\n    one that does, and implicit Ids don't appear in interface files).\n\n  - More seriously, the tidied type-envt will include the implicit\n    Id replete with a18 in its unfolding; but we won't take account\n    of a18 when computing a fingerprint for the class; result chaos.\n\nThere is one sort of implicit binding that is injected still later,\nnamely those for data constructor workers. Reason (I think): it's\nreally just a code generation trick.... binding itself makes no sense.\nSee Note [Data constructor workers] in CorePrep.\n-}\n\ngetTyConImplicitBinds :: TyCon -> [CoreBind]\ngetTyConImplicitBinds tc = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))\n\ngetClassImplicitBinds :: Class -> [CoreBind]\ngetClassImplicitBinds cls\n  = [ NonRec op (mkDictSelRhs cls val_index)\n    | (op, val_index) <- classAllSelIds cls `zip` [0..] ]\n\nget_defn :: Id -> CoreBind\nget_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id))\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Step 1: finding externals}\n*                                                                      *\n************************************************************************\n\nSee Note [Choosing external Ids].\n-}\n\ntype UnfoldEnv  = IdEnv (Name{-new name-}, Bool {-show unfolding-})\n  -- Maps each top-level Id to its new Name (the Id is tidied in step 2)\n  -- The Unique is unchanged.  If the new Name is external, it will be\n  -- visible in the interface file.\n  --\n  -- Bool => expose unfolding or not.\n\nchooseExternalIds :: HscEnv\n                  -> Module\n                  -> Bool -> Bool\n                  -> [CoreBind]\n                  -> [CoreBind]\n                  -> [CoreRule]\n                  -> IO (UnfoldEnv, TidyOccEnv)\n                  -- Step 1 from the notes above\n\nchooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules\n  = do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env\n       ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders\n       ; tidy_internal internal_ids unfold_env1 occ_env1 }\n where\n  nc_var = hsc_NC hsc_env\n\n  -- init_ext_ids is the initial list of Ids that should be\n  -- externalised.  It serves as the starting point for finding a\n  -- deterministic, tidy, renaming for all external Ids in this\n  -- module.\n  --\n  -- It is sorted, so that it has a deterministic order (i.e. it's the\n  -- same list every time this module is compiled), in contrast to the\n  -- bindings, which are ordered non-deterministically.\n  init_work_list = zip init_ext_ids init_ext_ids\n  init_ext_ids   = sortBy (compare `on` getOccName) $ filter is_external binders\n\n  -- An Id should be external if either (a) it is exported,\n  -- (b) it appears in the RHS of a local rule for an imported Id, or\n  -- See Note [Which rules to expose]\n  is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars\n\n  rule_rhs_vars  = mapUnionVarSet ruleRhsFreeVars imp_id_rules\n\n  binders          = map fst $ flattenBinds binds\n  implicit_binders = bindersOfBinds implicit_binds\n  binder_set       = mkVarSet binders\n\n  avoids   = [getOccName name | bndr <- binders ++ implicit_binders,\n                                let name = idName bndr,\n                                isExternalName name ]\n                -- In computing our \"avoids\" list, we must include\n                --      all implicit Ids\n                --      all things with global names (assigned once and for\n                --                                      all by the renamer)\n                -- since their names are \"taken\".\n                -- The type environment is a convenient source of such things.\n                -- In particular, the set of binders doesn't include\n                -- implicit Ids at this stage.\n\n        -- We also make sure to avoid any exported binders.  Consider\n        --      f{-u1-} = 1     -- Local decl\n        --      ...\n        --      f{-u2-} = 2     -- Exported decl\n        --\n        -- The second exported decl must 'get' the name 'f', so we\n        -- have to put 'f' in the avoids list before we get to the first\n        -- decl.  tidyTopId then does a no-op on exported binders.\n  init_occ_env = initTidyOccEnv avoids\n\n\n  search :: [(Id,Id)]    -- The work-list: (external id, referring id)\n                         -- Make a tidy, external Name for the external id,\n                         --   add it to the UnfoldEnv, and do the same for the\n                         --   transitive closure of Ids it refers to\n                         -- The referring id is used to generate a tidy\n                         ---  name for the external id\n         -> UnfoldEnv    -- id -> (new Name, show_unfold)\n         -> TidyOccEnv   -- occ env for choosing new Names\n         -> IO (UnfoldEnv, TidyOccEnv)\n\n  search [] unfold_env occ_env = return (unfold_env, occ_env)\n\n  search ((idocc,referrer) : rest) unfold_env occ_env\n    | idocc `elemVarEnv` unfold_env = search rest unfold_env occ_env\n    | otherwise = do\n      (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env idocc\n      let\n          (new_ids, show_unfold)\n                | omit_prags = ([], False)\n                | otherwise  = addExternal expose_all refined_id\n\n                -- 'idocc' is an *occurrence*, but we need to see the\n                -- unfolding in the *definition*; so look up in binder_set\n          refined_id = case lookupVarSet binder_set idocc of\n                         Just id -> id\n                         Nothing -> WARN( True, ppr idocc ) idocc\n\n          unfold_env' = extendVarEnv unfold_env idocc (name',show_unfold)\n          referrer' | isExportedId refined_id = refined_id\n                    | otherwise               = referrer\n      --\n      search (zip new_ids (repeat referrer') ++ rest) unfold_env' occ_env'\n\n  tidy_internal :: [Id] -> UnfoldEnv -> TidyOccEnv\n                -> IO (UnfoldEnv, TidyOccEnv)\n  tidy_internal []       unfold_env occ_env = return (unfold_env,occ_env)\n  tidy_internal (id:ids) unfold_env occ_env = do\n      (occ_env', name') <- tidyTopName mod nc_var Nothing occ_env id\n      let unfold_env' = extendVarEnv unfold_env id (name',False)\n      tidy_internal ids unfold_env' occ_env'\n\naddExternal :: Bool -> Id -> ([Id], Bool)\naddExternal expose_all id = (new_needed_ids, show_unfold)\n  where\n    new_needed_ids = bndrFvsInOrder show_unfold id\n    idinfo         = idInfo id\n    show_unfold    = show_unfolding (unfoldingInfo idinfo)\n    never_active   = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))\n    loop_breaker   = isStrongLoopBreaker (occInfo idinfo)\n    bottoming_fn   = isBottomingSig (strictnessInfo idinfo)\n\n        -- Stuff to do with the Id's unfolding\n        -- We leave the unfolding there even if there is a worker\n        -- In GHCi the unfolding is used by importers\n\n    show_unfolding (CoreUnfolding { uf_src = src, uf_guidance = guidance })\n       =  expose_all         -- 'expose_all' says to expose all\n                             -- unfoldings willy-nilly\n\n       || isStableSource src     -- Always expose things whose\n                                 -- source is an inline rule\n\n       || not (bottoming_fn      -- No need to inline bottom functions\n           || never_active       -- Or ones that say not to\n           || loop_breaker       -- Or that are loop breakers\n           || neverUnfoldGuidance guidance)\n    show_unfolding (DFunUnfolding {}) = True\n    show_unfolding _                  = False\n\n{-\n************************************************************************\n*                                                                      *\n               Deterministic free variables\n*                                                                      *\n************************************************************************\n\nWe want a deterministic free-variable list.  exprFreeVars gives us\na VarSet, which is in a non-deterministic order when converted to a\nlist.  Hence, here we define a free-variable finder that returns\nthe free variables in the order that they are encountered.\n\nSee Note [Choosing external Ids]\n-}\n\nbndrFvsInOrder :: Bool -> Id -> [Id]\nbndrFvsInOrder show_unfold id\n  = run (dffvLetBndr show_unfold id)\n\nrun :: DFFV () -> [Id]\nrun (DFFV m) = case m emptyVarSet (emptyVarSet, []) of\n                 ((_,ids),_) -> ids\n\nnewtype DFFV a\n  = DFFV (VarSet              -- Envt: non-top-level things that are in scope\n                              -- we don't want to record these as free vars\n      -> (VarSet, [Var])      -- Input State: (set, list) of free vars so far\n      -> ((VarSet,[Var]),a))  -- Output state\n\ninstance Functor DFFV where\n    fmap = liftM\n\ninstance Applicative DFFV where\n    pure a = DFFV $ \\_ st -> (st, a)\n    (<*>) = ap\n\ninstance Monad DFFV where\n  (DFFV m) >>= k = DFFV $ \\env st ->\n    case m env st of\n       (st',a) -> case k a of\n                     DFFV f -> f env st'\n\nextendScope :: Var -> DFFV a -> DFFV a\nextendScope v (DFFV f) = DFFV (\\env st -> f (extendVarSet env v) st)\n\nextendScopeList :: [Var] -> DFFV a -> DFFV a\nextendScopeList vs (DFFV f) = DFFV (\\env st -> f (extendVarSetList env vs) st)\n\ninsert :: Var -> DFFV ()\ninsert v = DFFV $ \\ env (set, ids) ->\n           let keep_me = isLocalId v &&\n                         not (v `elemVarSet` env) &&\n                           not (v `elemVarSet` set)\n           in if keep_me\n              then ((extendVarSet set v, v:ids), ())\n              else ((set,                ids),   ())\n\n\ndffvExpr :: CoreExpr -> DFFV ()\ndffvExpr (Var v)              = insert v\ndffvExpr (App e1 e2)          = dffvExpr e1 >> dffvExpr e2\ndffvExpr (Lam v e)            = extendScope v (dffvExpr e)\ndffvExpr (Tick (Breakpoint _ ids) e) = mapM_ insert ids >> dffvExpr e\ndffvExpr (Tick _other e)    = dffvExpr e\ndffvExpr (Cast e _)           = dffvExpr e\ndffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e)\ndffvExpr (Let (Rec prs) e)    = extendScopeList (map fst prs) $\n                                (mapM_ dffvBind prs >> dffvExpr e)\ndffvExpr (Case e b _ as)      = dffvExpr e >> extendScope b (mapM_ dffvAlt as)\ndffvExpr _other               = return ()\n\ndffvAlt :: (t, [Var], CoreExpr) -> DFFV ()\ndffvAlt (_,xs,r) = extendScopeList xs (dffvExpr r)\n\ndffvBind :: (Id, CoreExpr) -> DFFV ()\ndffvBind(x,r)\n  | not (isId x) = dffvExpr r\n  | otherwise    = dffvLetBndr False x >> dffvExpr r\n                -- Pass False because we are doing the RHS right here\n                -- If you say True you'll get *exponential* behaviour!\n\ndffvLetBndr :: Bool -> Id -> DFFV ()\n-- Gather the free vars of the RULES and unfolding of a binder\n-- We always get the free vars of a *stable* unfolding, but\n-- for a *vanilla* one (InlineRhs), the flag controls what happens:\n--   True <=> get fvs of even a *vanilla* unfolding\n--   False <=> ignore an InlineRhs\n-- For nested bindings (call from dffvBind) we always say \"False\" because\n--       we are taking the fvs of the RHS anyway\n-- For top-level bindings (call from addExternal, via bndrFvsInOrder)\n--       we say \"True\" if we are exposing that unfolding\ndffvLetBndr vanilla_unfold id\n  = do { go_unf (unfoldingInfo idinfo)\n       ; mapM_ go_rule (ruleInfoRules (ruleInfo idinfo)) }\n  where\n    idinfo = idInfo id\n\n    go_unf (CoreUnfolding { uf_tmpl = rhs, uf_src = src })\n       = case src of\n           InlineRhs | vanilla_unfold -> dffvExpr rhs\n                     | otherwise      -> return ()\n           _                          -> dffvExpr rhs\n\n    go_unf (DFunUnfolding { df_bndrs = bndrs, df_args = args })\n             = extendScopeList bndrs $ mapM_ dffvExpr args\n    go_unf _ = return ()\n\n    go_rule (BuiltinRule {}) = return ()\n    go_rule (Rule { ru_bndrs = bndrs, ru_rhs = rhs })\n      = extendScopeList bndrs (dffvExpr rhs)\n\n{-\n************************************************************************\n*                                                                      *\n               findExternalRules\n*                                                                      *\n************************************************************************\n\nNote [Finding external rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe complete rules are gotten by combining\n   a) local rules for imported Ids\n   b) rules embedded in the top-level Ids\n\nThere are two complications:\n  * Note [Which rules to expose]\n  * Note [Trimming auto-rules]\n\nNote [Which rules to expose]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe function 'expose_rule' filters out rules that mention, on the LHS,\nIds that aren't externally visible; these rules can't fire in a client\nmodule.\n\nThe externally-visible binders are computed (by chooseExternalIds)\nassuming that all orphan rules are externalised (see init_ext_ids in\nfunction 'search'). So in fact it's a bit conservative and we may\nexport more than we need.  (It's a sort of mutual recursion.)\n\nNote [Trimming auto-rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSecond, with auto-specialisation we may specialise local or imported\ndfuns or INLINE functions, and then later inline them.  That may leave\nbehind something like\n   RULE \"foo\" forall d. f @ Int d = f_spec\nwhere f is either local or imported, and there is no remaining\nreference to f_spec except from the RULE.\n\nNow that RULE *might* be useful to an importing module, but that is\npurely speculative, and meanwhile the code is taking up space and\ncodegen time.  I found that binary sizes jumped by 6-10% when I\nstarted to specialise INLINE functions (again, Note [Inline\nspecialisations] in Specialise).\n\nSo it seems better to drop the binding for f_spec, and the rule\nitself, if the auto-generated rule is the *only* reason that it is\nbeing kept alive.\n\n(The RULE still might have been useful in the past; that is, it was\nthe right thing to have generated it in the first place.  See Note\n[Inline specialisations] in Specialise.  But now it has served its\npurpose, and can be discarded.)\n\nSo findExternalRules does this:\n  * Remove all bindings that are kept alive *only* by isAutoRule rules\n      (this is done in trim_binds)\n  * Remove all auto rules that mention bindings that have been removed\n      (this is done by filtering by keep_rule)\n\nNB: if a binding is kept alive for some *other* reason (e.g. f_spec is\ncalled in the final code), we keep the rule too.\n\nThis stuff is the only reason for the ru_auto field in a Rule.\n-}\n\nfindExternalRules :: Bool       -- Omit pragmas\n                  -> [CoreBind]\n                  -> [CoreRule] -- Local rules for imported fns\n                  -> UnfoldEnv  -- Ids that are exported, so we need their rules\n                  -> ([CoreBind], [CoreRule])\n-- See Note [Finding external rules]\nfindExternalRules omit_prags binds imp_id_rules unfold_env\n  = (trimmed_binds, filter keep_rule all_rules)\n  where\n    imp_rules         = filter expose_rule imp_id_rules\n    imp_user_rule_fvs = mapUnionVarSet user_rule_rhs_fvs imp_rules\n\n    user_rule_rhs_fvs rule | isAutoRule rule = emptyVarSet\n                           | otherwise       = ruleRhsFreeVars rule\n\n    (trimmed_binds, local_bndrs, _, all_rules) = trim_binds binds\n\n    keep_rule rule = ruleFreeVars rule `subVarSet` local_bndrs\n        -- Remove rules that make no sense, because they mention a\n        -- local binder (on LHS or RHS) that we have now discarded.\n        -- (NB: ruleFreeVars only includes LocalIds)\n        --\n        -- LHS: we have already filtered out rules that mention internal Ids\n        --     on LHS but that isn't enough because we might have by now\n        --     discarded a binding with an external Id. (How?\n        --     chooseExternalIds is a bit conservative.)\n        --\n        -- RHS: the auto rules that might mention a binder that has\n        --      been discarded; see Note [Trimming auto-rules]\n\n    expose_rule rule\n        | omit_prags = False\n        | otherwise  = all is_external_id (ruleLhsFreeIdsList rule)\n                -- Don't expose a rule whose LHS mentions a locally-defined\n                -- Id that is completely internal (i.e. not visible to an\n                -- importing module).  NB: ruleLhsFreeIds only returns LocalIds.\n                -- See Note [Which rules to expose]\n\n    is_external_id id = case lookupVarEnv unfold_env id of\n                          Just (name, _) -> isExternalName name\n                          Nothing        -> False\n\n    trim_binds :: [CoreBind]\n               -> ( [CoreBind]   -- Trimmed bindings\n                  , VarSet       -- Binders of those bindings\n                  , VarSet       -- Free vars of those bindings + rhs of user rules\n                                 -- (we don't bother to delete the binders)\n                  , [CoreRule])  -- All rules, imported + from the bindings\n    -- This function removes unnecessary bindings, and gathers up rules from\n    -- the bindings we keep.  See Note [Trimming auto-rules]\n    trim_binds []  -- Base case, start with imp_user_rule_fvs\n       = ([], emptyVarSet, imp_user_rule_fvs, imp_rules)\n\n    trim_binds (bind:binds)\n       | any needed bndrs    -- Keep binding\n       = ( bind : binds', bndr_set', needed_fvs', local_rules ++ rules )\n       | otherwise           -- Discard binding altogether\n       = stuff\n       where\n         stuff@(binds', bndr_set, needed_fvs, rules)\n                       = trim_binds binds\n         needed bndr   = isExportedId bndr || bndr `elemVarSet` needed_fvs\n\n         bndrs         = bindersOf  bind\n         rhss          = rhssOfBind bind\n         bndr_set'     = bndr_set `extendVarSetList` bndrs\n\n         needed_fvs'   = needed_fvs                                   `unionVarSet`\n                         mapUnionVarSet idUnfoldingVars   bndrs       `unionVarSet`\n                              -- Ignore type variables in the type of bndrs\n                         mapUnionVarSet exprFreeVars      rhss        `unionVarSet`\n                         mapUnionVarSet user_rule_rhs_fvs local_rules\n            -- In needed_fvs', we don't bother to delete binders from the fv set\n\n         local_rules  = [ rule\n                        | id <- bndrs\n                        , is_external_id id   -- Only collect rules for external Ids\n                        , rule <- idCoreRules id\n                        , expose_rule rule ]  -- and ones that can fire in a client\n\n{-\n************************************************************************\n*                                                                      *\n               tidyTopName\n*                                                                      *\n************************************************************************\n\nThis is where we set names to local/global based on whether they really are\nexternally visible (see comment at the top of this module).  If the name\nwas previously local, we have to give it a unique occurrence name if\nwe intend to externalise it.\n-}\n\ntidyTopName :: Module -> IORef NameCache -> Maybe Id -> TidyOccEnv\n            -> Id -> IO (TidyOccEnv, Name)\ntidyTopName mod nc_var maybe_ref occ_env id\n  | global && internal = return (occ_env, localiseName name)\n\n  | global && external = return (occ_env, name)\n        -- Global names are assumed to have been allocated by the renamer,\n        -- so they already have the \"right\" unique\n        -- And it's a system-wide unique too\n\n  -- Now we get to the real reason that all this is in the IO Monad:\n  -- we have to update the name cache in a nice atomic fashion\n\n  | local  && internal = do { new_local_name <- atomicModifyIORef' nc_var mk_new_local\n                            ; return (occ_env', new_local_name) }\n        -- Even local, internal names must get a unique occurrence, because\n        -- if we do -split-objs we externalise the name later, in the code generator\n        --\n        -- Similarly, we must make sure it has a system-wide Unique, because\n        -- the byte-code generator builds a system-wide Name->BCO symbol table\n\n  | local  && external = do { new_external_name <- atomicModifyIORef' nc_var mk_new_external\n                            ; return (occ_env', new_external_name) }\n\n  | otherwise = panic \"tidyTopName\"\n  where\n    name        = idName id\n    external    = isJust maybe_ref\n    global      = isExternalName name\n    local       = not global\n    internal    = not external\n    loc         = nameSrcSpan name\n\n    old_occ     = nameOccName name\n    new_occ | Just ref <- maybe_ref\n            , ref /= id\n            = mkOccName (occNameSpace old_occ) $\n                   let\n                       ref_str = occNameString (getOccName ref)\n                       occ_str = occNameString old_occ\n                   in\n                   case occ_str of\n                     '$':'w':_ -> occ_str\n                        -- workers: the worker for a function already\n                        -- includes the occname for its parent, so there's\n                        -- no need to prepend the referrer.\n                     _other | isSystemName name -> ref_str\n                            | otherwise         -> ref_str ++ '_' : occ_str\n                        -- If this name was system-generated, then don't bother\n                        -- to retain its OccName, just use the referrer.  These\n                        -- system-generated names will become \"f1\", \"f2\", etc. for\n                        -- a referrer \"f\".\n            | otherwise = old_occ\n\n    (occ_env', occ') = tidyOccName occ_env new_occ\n\n    mk_new_local nc = (nc { nsUniqs = us }, mkInternalName uniq occ' loc)\n                    where\n                      (uniq, us) = takeUniqFromSupply (nsUniqs nc)\n\n    mk_new_external nc = allocateGlobalBinder nc mod occ' loc\n        -- If we want to externalise a currently-local name, check\n        -- whether we have already assigned a unique for it.\n        -- If so, use it; if not, extend the table.\n        -- All this is done by allcoateGlobalBinder.\n        -- This is needed when *re*-compiling a module in GHCi; we must\n        -- use the same name for externally-visible things as we did before.\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Step 2: top-level tidying}\n*                                                                      *\n************************************************************************\n-}\n\n-- TopTidyEnv: when tidying we need to know\n--   * nc_var: The NameCache, containing a unique supply and any pre-ordained Names.\n--        These may have arisen because the\n--        renamer read in an interface file mentioning M.$wf, say,\n--        and assigned it unique r77.  If, on this compilation, we've\n--        invented an Id whose name is $wf (but with a different unique)\n--        we want to rename it to have unique r77, so that we can do easy\n--        comparisons with stuff from the interface file\n--\n--   * occ_env: The TidyOccEnv, which tells us which local occurrences\n--     are 'used'\n--\n--   * subst_env: A Var->Var mapping that substitutes the new Var for the old\n\ntidyTopBinds :: HscEnv\n             -> Module\n             -> UnfoldEnv\n             -> TidyOccEnv\n             -> CoreProgram\n             -> IO (TidyEnv, CoreProgram)\n\ntidyTopBinds hsc_env this_mod unfold_env init_occ_env binds\n  = do mkIntegerId <- lookupMkIntegerName dflags hsc_env\n       mkNaturalId <- lookupMkNaturalName dflags hsc_env\n       integerSDataCon <- lookupIntegerSDataConName dflags hsc_env\n       naturalSDataCon <- lookupNaturalSDataConName dflags hsc_env\n       let cvt_literal nt i = case nt of\n             LitNumInteger -> Just (cvtLitInteger dflags mkIntegerId integerSDataCon i)\n             LitNumNatural -> Just (cvtLitNatural dflags mkNaturalId naturalSDataCon i)\n             _             -> Nothing\n           result      = tidy cvt_literal init_env binds\n       seqBinds (snd result) `seq` return result\n       -- This seqBinds avoids a spike in space usage (see #13564)\n  where\n    dflags = hsc_dflags hsc_env\n\n    init_env = (init_occ_env, emptyVarEnv)\n\n    tidy _           env []     = (env, [])\n    tidy cvt_literal env (b:bs)\n        = let (env1, b')  = tidyTopBind dflags this_mod cvt_literal unfold_env\n                                        env b\n              (env2, bs') = tidy cvt_literal env1 bs\n          in  (env2, b':bs')\n\n------------------------\ntidyTopBind  :: DynFlags\n             -> Module\n             -> (LitNumType -> Integer -> Maybe CoreExpr)\n             -> UnfoldEnv\n             -> TidyEnv\n             -> CoreBind\n             -> (TidyEnv, CoreBind)\n\ntidyTopBind dflags this_mod cvt_literal unfold_env\n            (occ_env,subst1) (NonRec bndr rhs)\n  = (tidy_env2,  NonRec bndr' rhs')\n  where\n    Just (name',show_unfold) = lookupVarEnv unfold_env bndr\n    caf_info      = hasCafRefs dflags this_mod\n                               (subst1, cvt_literal)\n                               (idArity bndr) rhs\n    (bndr', rhs') = tidyTopPair dflags show_unfold tidy_env2 caf_info name'\n                                (bndr, rhs)\n    subst2        = extendVarEnv subst1 bndr bndr'\n    tidy_env2     = (occ_env, subst2)\n\ntidyTopBind dflags this_mod cvt_literal unfold_env\n            (occ_env, subst1) (Rec prs)\n  = (tidy_env2, Rec prs')\n  where\n    prs' = [ tidyTopPair dflags show_unfold tidy_env2 caf_info name' (id,rhs)\n           | (id,rhs) <- prs,\n             let (name',show_unfold) =\n                    expectJust \"tidyTopBind\" $ lookupVarEnv unfold_env id\n           ]\n\n    subst2    = extendVarEnvList subst1 (bndrs `zip` map fst prs')\n    tidy_env2 = (occ_env, subst2)\n\n    bndrs = map fst prs\n\n        -- the CafInfo for a recursive group says whether *any* rhs in\n        -- the group may refer indirectly to a CAF (because then, they all do).\n    caf_info\n        | or [ mayHaveCafRefs (hasCafRefs dflags this_mod\n                                          (subst1, cvt_literal)\n                                          (idArity bndr) rhs)\n             | (bndr,rhs) <- prs ] = MayHaveCafRefs\n        | otherwise                = NoCafRefs\n\n-----------------------------------------------------------\ntidyTopPair :: DynFlags\n            -> Bool  -- show unfolding\n            -> TidyEnv  -- The TidyEnv is used to tidy the IdInfo\n                        -- It is knot-tied: don't look at it!\n            -> CafInfo\n            -> Name             -- New name\n            -> (Id, CoreExpr)   -- Binder and RHS before tidying\n            -> (Id, CoreExpr)\n        -- This function is the heart of Step 2\n        -- The rec_tidy_env is the one to use for the IdInfo\n        -- It's necessary because when we are dealing with a recursive\n        -- group, a variable late in the group might be mentioned\n        -- in the IdInfo of one early in the group\n\ntidyTopPair dflags show_unfold rhs_tidy_env caf_info name' (bndr, rhs)\n  = (bndr1, rhs1)\n  where\n    bndr1    = mkGlobalId details name' ty' idinfo'\n    details  = idDetails bndr   -- Preserve the IdDetails\n    ty'      = tidyTopType (idType bndr)\n    rhs1     = tidyExpr rhs_tidy_env rhs\n    idinfo'  = tidyTopIdInfo dflags rhs_tidy_env name' rhs rhs1 (idInfo bndr)\n                             show_unfold caf_info\n\n-- tidyTopIdInfo creates the final IdInfo for top-level\n-- binders.  There are two delicate pieces:\n--\n--  * Arity.  After CoreTidy, this arity must not change any more.\n--      Indeed, CorePrep must eta expand where necessary to make\n--      the manifest arity equal to the claimed arity.\n--\n--  * CAF info.  This must also remain valid through to code generation.\n--      We add the info here so that it propagates to all\n--      occurrences of the binders in RHSs, and hence to occurrences in\n--      unfoldings, which are inside Ids imported by GHCi. Ditto RULES.\n--      CoreToStg makes use of this when constructing SRTs.\ntidyTopIdInfo :: DynFlags -> TidyEnv -> Name -> CoreExpr -> CoreExpr\n              -> IdInfo -> Bool -> CafInfo -> IdInfo\ntidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold caf_info\n  | not is_external     -- For internal Ids (not externally visible)\n  = vanillaIdInfo       -- we only need enough info for code generation\n                        -- Arity and strictness info are enough;\n                        --      c.f. CoreTidy.tidyLetBndr\n        `setCafInfo`        caf_info\n        `setArityInfo`      arity\n        `setStrictnessInfo` final_sig\n        `setUnfoldingInfo`  minimal_unfold_info  -- See note [Preserve evaluatedness]\n                                                 -- in CoreTidy\n\n  | otherwise           -- Externally-visible Ids get the whole lot\n  = vanillaIdInfo\n        `setCafInfo`           caf_info\n        `setArityInfo`         arity\n        `setStrictnessInfo`    final_sig\n        `setOccInfo`           robust_occ_info\n        `setInlinePragInfo`    (inlinePragInfo idinfo)\n        `setUnfoldingInfo`     unfold_info\n                -- NB: we throw away the Rules\n                -- They have already been extracted by findExternalRules\n  where\n    is_external = isExternalName name\n\n    --------- OccInfo ------------\n    robust_occ_info = zapFragileOcc (occInfo idinfo)\n    -- It's important to keep loop-breaker information\n    -- when we are doing -fexpose-all-unfoldings\n\n    --------- Strictness ------------\n    mb_bot_str = exprBotStrictness_maybe orig_rhs\n\n    sig = strictnessInfo idinfo\n    final_sig | not $ isTopSig sig\n              = WARN( _bottom_hidden sig , ppr name ) sig\n              -- try a cheap-and-cheerful bottom analyser\n              | Just (_, nsig) <- mb_bot_str = nsig\n              | otherwise                    = sig\n\n    _bottom_hidden id_sig = case mb_bot_str of\n                                  Nothing         -> False\n                                  Just (arity, _) -> not (appIsBottom id_sig arity)\n\n    --------- Unfolding ------------\n    unf_info = unfoldingInfo idinfo\n    unfold_info | show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs\n                | otherwise   = minimal_unfold_info\n    minimal_unfold_info = zapUnfolding unf_info\n    unf_from_rhs = mkTopUnfolding dflags is_bot tidy_rhs\n    is_bot = isBottomingSig final_sig\n    -- NB: do *not* expose the worker if show_unfold is off,\n    --     because that means this thing is a loop breaker or\n    --     marked NOINLINE or something like that\n    -- This is important: if you expose the worker for a loop-breaker\n    -- then you can make the simplifier go into an infinite loop, because\n    -- in effect the unfolding is exposed.  See Trac #1709\n    --\n    -- You might think that if show_unfold is False, then the thing should\n    -- not be w/w'd in the first place.  But a legitimate reason is this:\n    --    the function returns bottom\n    -- In this case, show_unfold will be false (we don't expose unfoldings\n    -- for bottoming functions), but we might still have a worker/wrapper\n    -- split (see Note [Worker-wrapper for bottoming functions] in WorkWrap.hs\n\n\n    --------- Arity ------------\n    -- Usually the Id will have an accurate arity on it, because\n    -- the simplifier has just run, but not always.\n    -- One case I found was when the last thing the simplifier\n    -- did was to let-bind a non-atomic argument and then float\n    -- it to the top level. So it seems more robust just to\n    -- fix it here.\n    arity = exprArity orig_rhs\n\n{-\n************************************************************************\n*                                                                      *\n           Figuring out CafInfo for an expression\n*                                                                      *\n************************************************************************\n\nhasCafRefs decides whether a top-level closure can point into the dynamic heap.\nWe mark such things as `MayHaveCafRefs' because this information is\nused to decide whether a particular closure needs to be referenced\nin an SRT or not.\n\nThere are two reasons for setting MayHaveCafRefs:\n        a) The RHS is a CAF: a top-level updatable thunk.\n        b) The RHS refers to something that MayHaveCafRefs\n\nPossible improvement: In an effort to keep the number of CAFs (and\nhence the size of the SRTs) down, we could also look at the expression and\ndecide whether it requires a small bounded amount of heap, so we can ignore\nit as a CAF.  In these cases however, we would need to use an additional\nCAF list to keep track of non-collectable CAFs.\n\nNote [Disgusting computation of CafRefs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe compute hasCafRefs here, because IdInfo is supposed to be finalised\nafter TidyPgm.  But CorePrep does some transformations that affect CAF-hood.\nSo we have to *predict* the result here, which is revolting.\n\nIn particular CorePrep expands Integer and Natural literals. So in the\nprediction code here we resort to applying the same expansion (cvt_literal).\nUgh!\n-}\n\ntype CafRefEnv = (VarEnv Id, LitNumType -> Integer -> Maybe CoreExpr)\n  -- The env finds the Caf-ness of the Id\n  -- The LitNumType -> Integer -> CoreExpr is the desugaring functions for\n  -- Integer and Natural literals\n  -- See Note [Disgusting computation of CafRefs]\n\nhasCafRefs :: DynFlags -> Module\n           -> CafRefEnv -> Arity -> CoreExpr\n           -> CafInfo\nhasCafRefs dflags this_mod (subst, cvt_literal) arity expr\n  | is_caf || mentions_cafs = MayHaveCafRefs\n  | otherwise               = NoCafRefs\n where\n  mentions_cafs   = cafRefsE expr\n  is_dynamic_name = isDllName dflags this_mod\n  is_caf = not (arity > 0 || rhsIsStatic (targetPlatform dflags) is_dynamic_name\n                                         cvt_literal expr)\n\n  -- NB. we pass in the arity of the expression, which is expected\n  -- to be calculated by exprArity.  This is because exprArity\n  -- knows how much eta expansion is going to be done by\n  -- CorePrep later on, and we don't want to duplicate that\n  -- knowledge in rhsIsStatic below.\n\n  cafRefsE :: Expr a -> Bool\n  cafRefsE (Var id)            = cafRefsV id\n  cafRefsE (Lit lit)           = cafRefsL lit\n  cafRefsE (App f a)           = cafRefsE f || cafRefsE a\n  cafRefsE (Lam _ e)           = cafRefsE e\n  cafRefsE (Let b e)           = cafRefsEs (rhssOfBind b) || cafRefsE e\n  cafRefsE (Case e _ _ alts)   = cafRefsE e || cafRefsEs (rhssOfAlts alts)\n  cafRefsE (Tick _n e)         = cafRefsE e\n  cafRefsE (Cast e _co)        = cafRefsE e\n  cafRefsE (Type _)            = False\n  cafRefsE (Coercion _)        = False\n\n  cafRefsEs :: [Expr a] -> Bool\n  cafRefsEs []     = False\n  cafRefsEs (e:es) = cafRefsE e || cafRefsEs es\n\n  cafRefsL :: Literal -> Bool\n  -- Don't forget that mk_integer id might have Caf refs!\n  -- We first need to convert the Integer into its final form, to\n  -- see whether mkInteger is used. Same for LitNatural.\n  cafRefsL (LitNumber nt i _) = case cvt_literal nt i of\n    Just e  -> cafRefsE e\n    Nothing -> False\n  cafRefsL _                = False\n\n  cafRefsV :: Id -> Bool\n  cafRefsV id\n    | not (isLocalId id)                = mayHaveCafRefs (idCafInfo id)\n    | Just id' <- lookupVarEnv subst id = mayHaveCafRefs (idCafInfo id')\n    | otherwise                         = False\n\n\n{-\n************************************************************************\n*                                                                      *\n                  Old, dead, type-trimming code\n*                                                                      *\n************************************************************************\n\nWe used to try to \"trim off\" the constructors of data types that are\nnot exported, to reduce the size of interface files, at least without\n-O.  But that is not always possible: see the old Note [When we can't\ntrim types] below for exceptions.\n\nThen (Trac #7445) I realised that the TH problem arises for any data type\nthat we have deriving( Data ), because we can invoke\n   Language.Haskell.TH.Quote.dataToExpQ\nto get a TH Exp representation of a value built from that data type.\nYou don't even need {-# LANGUAGE TemplateHaskell #-}.\n\nAt this point I give up. The pain of trimming constructors just\ndoesn't seem worth the gain.  So I've dumped all the code, and am just\nleaving it here at the end of the module in case something like this\nis ever resurrected.\n\n\nNote [When we can't trim types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe basic idea of type trimming is to export algebraic data types\nabstractly (without their data constructors) when compiling without\n-O, unless of course they are explicitly exported by the user.\n\nWe always export synonyms, because they can be mentioned in the type\nof an exported Id.  We could do a full dependency analysis starting\nfrom the explicit exports, but that's quite painful, and not done for\nnow.\n\nBut there are some times we can't do that, indicated by the 'no_trim_types' flag.\n\nFirst, Template Haskell.  Consider (Trac #2386) this\n        module M(T, makeOne) where\n          data T = Yay String\n          makeOne = [| Yay \"Yep\" |]\nNotice that T is exported abstractly, but makeOne effectively exports it too!\nA module that splices in $(makeOne) will then look for a declaration of Yay,\nso it'd better be there.  Hence, brutally but simply, we switch off type\nconstructor trimming if TH is enabled in this module.\n\nSecond, data kinds.  Consider (Trac #5912)\n     {-# LANGUAGE DataKinds #-}\n     module M() where\n     data UnaryTypeC a = UnaryDataC a\n     type Bug = 'UnaryDataC\nWe always export synonyms, so Bug is exposed, and that means that\nUnaryTypeC must be too, even though it's not explicitly exported.  In\neffect, DataKinds means that we'd need to do a full dependency analysis\nto see what data constructors are mentioned.  But we don't do that yet.\n\nIn these two cases we just switch off type trimming altogether.\n\nmustExposeTyCon :: Bool         -- Type-trimming flag\n                -> NameSet      -- Exports\n                -> TyCon        -- The tycon\n                -> Bool         -- Can its rep be hidden?\n-- We are compiling without -O, and thus trying to write as little as\n-- possible into the interface file.  But we must expose the details of\n-- any data types whose constructors or fields are exported\nmustExposeTyCon no_trim_types exports tc\n  | no_trim_types               -- See Note [When we can't trim types]\n  = True\n\n  | not (isAlgTyCon tc)         -- Always expose synonyms (otherwise we'd have to\n                                -- figure out whether it was mentioned in the type\n                                -- of any other exported thing)\n  = True\n\n  | isEnumerationTyCon tc       -- For an enumeration, exposing the constructors\n  = True                        -- won't lead to the need for further exposure\n\n  | isFamilyTyCon tc            -- Open type family\n  = True\n\n  -- Below here we just have data/newtype decls or family instances\n\n  | null data_cons              -- Ditto if there are no data constructors\n  = True                        -- (NB: empty data types do not count as enumerations\n                                -- see Note [Enumeration types] in TyCon\n\n  | any exported_con data_cons  -- Expose rep if any datacon or field is exported\n  = True\n\n  | isNewTyCon tc && isFFITy (snd (newTyConRhs tc))\n  = True   -- Expose the rep for newtypes if the rep is an FFI type.\n           -- For a very annoying reason.  'Foreign import' is meant to\n           -- be able to look through newtypes transparently, but it\n           -- can only do that if it can \"see\" the newtype representation\n\n  | otherwise\n  = False\n  where\n    data_cons = tyConDataCons tc\n    exported_con con = any (`elemNameSet` exports)\n                           (dataConName con : dataConFieldLabels con)\n-}\n", "num_lines": 1464}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n{-\n-----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2001-2017\n--\n-- Finding the compiler's base directory.\n--\n-----------------------------------------------------------------------------\n-}\n\nmodule SysTools.BaseDir\n  ( expandTopDir, expandToolDir\n  , findTopDir, findToolDir\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Panic\n\nimport System.Environment (lookupEnv)\nimport System.FilePath\nimport Data.List\n\n-- POSIX\n#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)\nimport System.Environment (getExecutablePath)\n#endif\n\n-- Windows\n#if defined(mingw32_HOST_OS)\nimport System.Environment (getExecutablePath)\nimport System.Directory (doesDirectoryExist)\n#endif\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\n{-\nNote [topdir: How GHC finds its files]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nGHC needs various support files (library packages, RTS etc), plus\nvarious auxiliary programs (cp, gcc, etc).  It starts by finding topdir,\nthe root of GHC's support files\n\nOn Unix:\n  - ghc always has a shell wrapper that passes a -B<dir> option\n\nOn Windows:\n  - ghc never has a shell wrapper.\n  - we can find the location of the ghc binary, which is\n        $topdir/<foo>/<something>.exe\n    where <something> may be \"ghc\", \"ghc-stage2\", or similar\n  - we strip off the \"<foo>/<something>.exe\" to leave $topdir.\n\nfrom topdir we can find package.conf, ghc-asm, etc.\n\n\nNote [tooldir: How GHC finds mingw on Windows]\n\nGHC has some custom logic on Windows for finding the mingw\ntoolchain and perl. Depending on whether GHC is built\nwith the make build system or Hadrian, and on whether we're\nrunning a bindist, we might find the mingw toolchain and perl\neither under $topdir/../{mingw, perl}/ or\n$topdir/../../{mingw, perl}/.\n\n-}\n\n-- | Expand occurrences of the @$topdir@ interpolation in a string.\nexpandTopDir :: FilePath -> String -> String\nexpandTopDir = expandPathVar \"topdir\"\n\n-- | Expand occurrences of the @$tooldir@ interpolation in a string\n-- on Windows, leave the string untouched otherwise.\nexpandToolDir :: Maybe FilePath -> String -> String\n#if defined(mingw32_HOST_OS)\nexpandToolDir (Just tool_dir) s = expandPathVar \"tooldir\" tool_dir s\nexpandToolDir Nothing         _ = panic \"Could not determine $tooldir\"\n#else\nexpandToolDir _ s = s\n#endif\n\n-- | @expandPathVar var value str@\n--\n--   replaces occurences of variable @$var@ with @value@ in str.\nexpandPathVar :: String -> FilePath -> String -> String\nexpandPathVar var value str\n  | Just str' <- stripPrefix ('$':var) str\n  , null str' || isPathSeparator (head str')\n  = value ++ expandPathVar var value str'\nexpandPathVar var value (x:xs) = x : expandPathVar var value xs\nexpandPathVar _ _ [] = []\n\n-- | Returns a Unix-format path pointing to TopDir.\nfindTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).\n           -> IO String    -- TopDir (in Unix format '/' separated)\nfindTopDir (Just minusb) = return (normalise minusb)\nfindTopDir Nothing\n    = do -- The _GHC_TOP_DIR environment variable can be used to specify\n         -- the top dir when the -B argument is not specified. It is not\n         -- intended for use by users, it was added specifically for the\n         -- purpose of running GHC within GHCi.\n         maybe_env_top_dir <- lookupEnv \"_GHC_TOP_DIR\"\n         case maybe_env_top_dir of\n             Just env_top_dir -> return env_top_dir\n             Nothing -> do\n                 -- Get directory of executable\n                 maybe_exec_dir <- getBaseDir\n                 case maybe_exec_dir of\n                     -- \"Just\" on Windows, \"Nothing\" on unix\n                     Nothing -> throwGhcExceptionIO $\n                         InstallationError \"missing -B<dir> option\"\n                     Just dir -> return dir\n\ngetBaseDir :: IO (Maybe String)\n\n#if defined(mingw32_HOST_OS)\n\n-- locate the \"base dir\" when given the path\n-- to the real ghc executable (as opposed to symlink)\n-- that is running this function.\nrootDir :: FilePath -> FilePath\nrootDir = takeDirectory . takeDirectory . normalise\n\ngetBaseDir = Just . (\\p -> p </> \"lib\") . rootDir <$> getExecutablePath\n#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)\n-- on unix, this is a bit more confusing.\n-- The layout right now is something like\n--\n--   /bin/ghc-X.Y.Z <- wrapper script (1)\n--   /bin/ghc       <- symlink to wrapper script (2)\n--   /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)\n--   /lib/ghc-X.Y.Z <- $topdir (4)\n--\n-- As such, we first need to find the absolute location to the\n-- binary.\n--\n-- getExecutablePath will return (3). One takeDirectory will\n-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).\n--\n-- This of course only works due to the current layout. If\n-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}\n-- this would need to be changed accordingly.\n--\ngetBaseDir = Just . (\\p -> p </> \"lib\") . takeDirectory . takeDirectory <$> getExecutablePath\n#else\ngetBaseDir = return Nothing\n#endif\n\n-- See Note [tooldir: How GHC finds mingw and perl on Windows]\n-- Returns @Nothing@ when not on Windows.\n-- When called on Windows, it either throws an error when the\n-- tooldir can't be located, or returns @Just tooldirpath@.\nfindToolDir\n  :: FilePath -- ^ topdir\n  -> IO (Maybe FilePath)\n#if defined(mingw32_HOST_OS)\nfindToolDir top_dir = go 0 (top_dir </> \"..\")\n  where maxDepth = 3\n        go :: Int -> FilePath -> IO (Maybe FilePath)\n        go k path\n          | k == maxDepth = throwGhcExceptionIO $\n              InstallationError \"could not detect mingw toolchain\"\n          | otherwise = do\n              oneLevel <- doesDirectoryExist (path </> \"mingw\")\n              if oneLevel\n                then return (Just path)\n                else go (k+1) (path </> \"..\")\n#else\nfindToolDir _ = return Nothing\n#endif\n", "num_lines": 185}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- GHC Extra object linking code\n--\n-- (c) The GHC Team 2017\n--\n-----------------------------------------------------------------------------\n\nmodule SysTools.ExtraObj (\n  mkExtraObj, mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary,\n  checkLinkInfo, getLinkInfo, getCompilerInfo,\n  ghcLinkInfoSectionName, ghcLinkInfoNoteName, platformSupportsSavingLinkOpts,\n  haveRtsOptsFlags\n) where\n\nimport AsmUtils\nimport ErrUtils\nimport DynFlags\nimport Packages\nimport Platform\nimport Outputable\nimport SrcLoc           ( noSrcSpan )\nimport Module\nimport Elf\nimport Util\nimport GhcPrelude\n\nimport Control.Monad\nimport Data.Maybe\n\nimport Control.Monad.IO.Class\n\nimport FileCleanup\nimport SysTools.Tasks\nimport SysTools.Info\n\nmkExtraObj :: DynFlags -> Suffix -> String -> IO FilePath\nmkExtraObj dflags extn xs\n = do cFile <- newTempName dflags TFL_CurrentModule extn\n      oFile <- newTempName dflags TFL_GhcSession \"o\"\n      writeFile cFile xs\n      ccInfo <- liftIO $ getCompilerInfo dflags\n      runCc dflags\n            ([Option        \"-c\",\n              FileOption \"\" cFile,\n              Option        \"-o\",\n              FileOption \"\" oFile]\n              ++ if extn /= \"s\"\n                    then cOpts\n                    else asmOpts ccInfo)\n      return oFile\n    where\n      -- Pass a different set of options to the C compiler depending one whether\n      -- we're compiling C or assembler. When compiling C, we pass the usual\n      -- set of include directories and PIC flags.\n      cOpts = map Option (picCCOpts dflags)\n                    ++ map (FileOption \"-I\")\n                            (includeDirs $ getPackageDetails dflags rtsUnitId)\n\n      -- When compiling assembler code, we drop the usual C options, and if the\n      -- compiler is Clang, we add an extra argument to tell Clang to ignore\n      -- unused command line options. See trac #11684.\n      asmOpts ccInfo =\n            if any (ccInfo ==) [Clang, AppleClang, AppleClang51]\n                then [Option \"-Qunused-arguments\"]\n                else []\n\n-- When linking a binary, we need to create a C main() function that\n-- starts everything off.  This used to be compiled statically as part\n-- of the RTS, but that made it hard to change the -rtsopts setting,\n-- so now we generate and compile a main() stub as part of every\n-- binary and pass the -rtsopts setting directly to the RTS (#5373)\n--\n-- On Windows, when making a shared library we also may need a DllMain.\n--\nmkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath\nmkExtraObjToLinkIntoBinary dflags = do\n  when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do\n     putLogMsg dflags NoReason SevInfo noSrcSpan\n         (defaultUserStyle dflags)\n         (text \"Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main.\" $$\n          text \"    Call hs_init_ghc() from your main() function to set these options.\")\n\n  mkExtraObj dflags \"c\" (showSDoc dflags main)\n  where\n    main\n      | gopt Opt_NoHsMain dflags = Outputable.empty\n      | otherwise\n          = case ghcLink dflags of\n                  LinkDynLib -> if platformOS (targetPlatform dflags) == OSMinGW32\n                                    then dllMain\n                                    else Outputable.empty\n                  _                      -> exeMain\n\n    exeMain = vcat [\n        text \"#include \\\"Rts.h\\\"\",\n        text \"extern StgClosure ZCMain_main_closure;\",\n        text \"int main(int argc, char *argv[])\",\n        char '{',\n        text \" RtsConfig __conf = defaultRtsConfig;\",\n        text \" __conf.rts_opts_enabled = \"\n            <> text (show (rtsOptsEnabled dflags)) <> semi,\n        text \" __conf.rts_opts_suggestions = \"\n            <> text (if rtsOptsSuggestions dflags\n                        then \"true\"\n                        else \"false\") <> semi,\n        text \"__conf.keep_cafs = \"\n            <> text (if gopt Opt_KeepCAFs dflags\n                       then \"true\"\n                       else \"false\") <> semi,\n        case rtsOpts dflags of\n            Nothing   -> Outputable.empty\n            Just opts -> text \"    __conf.rts_opts= \" <>\n                          text (show opts) <> semi,\n        text \" __conf.rts_hs_main = true;\",\n        text \" return hs_main(argc,argv,&ZCMain_main_closure,__conf);\",\n        char '}',\n        char '\\n' -- final newline, to keep gcc happy\n        ]\n\n    dllMain = vcat [\n        text \"#include \\\"Rts.h\\\"\",\n        text \"#include <windows.h>\",\n        text \"#include <stdbool.h>\",\n        char '\\n',\n        text \"bool\",\n        text \"WINAPI\",\n        text \"DllMain ( HINSTANCE hInstance STG_UNUSED\",\n        text \"        , DWORD reason STG_UNUSED\",\n        text \"        , LPVOID reserved STG_UNUSED\",\n        text \"        )\",\n        text \"{\",\n        text \"  return true;\",\n        text \"}\",\n        char '\\n' -- final newline, to keep gcc happy\n        ]\n\n-- Write out the link info section into a new assembly file. Previously\n-- this was included as inline assembly in the main.c file but this\n-- is pretty fragile. gas gets upset trying to calculate relative offsets\n-- that span the .note section (notably .text) when debug info is present\nmkNoteObjsToLinkIntoBinary :: DynFlags -> [InstalledUnitId] -> IO [FilePath]\nmkNoteObjsToLinkIntoBinary dflags dep_packages = do\n   link_info <- getLinkInfo dflags dep_packages\n\n   if (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))\n     then fmap (:[]) $ mkExtraObj dflags \"s\" (showSDoc dflags (link_opts link_info))\n     else return []\n\n  where\n    link_opts info = hcat [\n      -- \"link info\" section (see Note [LinkInfo section])\n      makeElfNote ghcLinkInfoSectionName ghcLinkInfoNoteName 0 info,\n\n      -- ALL generated assembly must have this section to disable\n      -- executable stacks.  See also\n      -- compiler/nativeGen/AsmCodeGen.hs for another instance\n      -- where we need to do this.\n      if platformHasGnuNonexecStack (targetPlatform dflags)\n        then text \".section .note.GNU-stack,\\\"\\\",\"\n             <> sectionType \"progbits\" <> char '\\n'\n        else Outputable.empty\n      ]\n\n-- | Return the \"link info\" string\n--\n-- See Note [LinkInfo section]\ngetLinkInfo :: DynFlags -> [InstalledUnitId] -> IO String\ngetLinkInfo dflags dep_packages = do\n   package_link_opts <- getPackageLinkOpts dflags dep_packages\n   pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags)\n                     then getPackageFrameworks dflags dep_packages\n                     else return []\n   let extra_ld_inputs = ldInputs dflags\n   let\n      link_info = (package_link_opts,\n                   pkg_frameworks,\n                   rtsOpts dflags,\n                   rtsOptsEnabled dflags,\n                   gopt Opt_NoHsMain dflags,\n                   map showOpt extra_ld_inputs,\n                   getOpts dflags opt_l)\n   --\n   return (show link_info)\n\nplatformSupportsSavingLinkOpts :: OS -> Bool\nplatformSupportsSavingLinkOpts os\n | os == OSSolaris2 = False -- see #5382\n | otherwise        = osElfTarget os\n\n-- See Note [LinkInfo section]\nghcLinkInfoSectionName :: String\nghcLinkInfoSectionName = \".debug-ghc-link-info\"\n  -- if we use the \".debug\" prefix, then strip will strip it by default\n\n-- Identifier for the note (see Note [LinkInfo section])\nghcLinkInfoNoteName :: String\nghcLinkInfoNoteName = \"GHC link info\"\n\n-- Returns 'False' if it was, and we can avoid linking, because the\n-- previous binary was linked with \"the same options\".\ncheckLinkInfo :: DynFlags -> [InstalledUnitId] -> FilePath -> IO Bool\ncheckLinkInfo dflags pkg_deps exe_file\n | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))\n -- ToDo: Windows and OS X do not use the ELF binary format, so\n -- readelf does not work there.  We need to find another way to do\n -- this.\n = return False -- conservatively we should return True, but not\n                -- linking in this case was the behaviour for a long\n                -- time so we leave it as-is.\n | otherwise\n = do\n   link_info <- getLinkInfo dflags pkg_deps\n   debugTraceMsg dflags 3 $ text (\"Link info: \" ++ link_info)\n   m_exe_link_info <- readElfNoteAsString dflags exe_file\n                          ghcLinkInfoSectionName ghcLinkInfoNoteName\n   let sameLinkInfo = (Just link_info == m_exe_link_info)\n   debugTraceMsg dflags 3 $ case m_exe_link_info of\n     Nothing -> text \"Exe link info: Not found\"\n     Just s\n       | sameLinkInfo -> text (\"Exe link info is the same\")\n       | otherwise    -> text (\"Exe link info is different: \" ++ s)\n   return (not sameLinkInfo)\n\n{- Note [LinkInfo section]\n   ~~~~~~~~~~~~~~~~~~~~~~~\n\nThe \"link info\" is a string representing the parameters of the link. We save\nthis information in the binary, and the next time we link, if nothing else has\nchanged, we use the link info stored in the existing binary to decide whether\nto re-link or not.\n\nThe \"link info\" string is stored in a ELF section called \".debug-ghc-link-info\"\n(see ghcLinkInfoSectionName) with the SHT_NOTE type.  For some time, it used to\nnot follow the specified record-based format (see #11022).\n\n-}\n\nhaveRtsOptsFlags :: DynFlags -> Bool\nhaveRtsOptsFlags dflags =\n        isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of\n                                       RtsOptsSafeOnly -> False\n                                       _ -> True\n", "num_lines": 244}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n-----------------------------------------------------------------------------\n--\n-- Compiler information functions\n--\n-- (c) The GHC Team 2017\n--\n-----------------------------------------------------------------------------\nmodule SysTools.Info where\n\nimport Exception\nimport ErrUtils\nimport DynFlags\nimport Outputable\nimport Util\n\nimport Data.List\nimport Data.IORef\n\nimport System.IO\n\nimport Platform\nimport GhcPrelude\n\nimport SysTools.Process\n\n{- Note [Run-time linker info]\n\nSee also: Trac #5240, Trac #6063, Trac #10110\n\nBefore 'runLink', we need to be sure to get the relevant information\nabout the linker we're using at runtime to see if we need any extra\noptions. For example, GNU ld requires '--reduce-memory-overheads' and\n'--hash-size=31' in order to use reasonable amounts of memory (see\ntrac #5240.) But this isn't supported in GNU gold.\n\nGenerally, the linker changing from what was detected at ./configure\ntime has always been possible using -pgml, but on Linux it can happen\n'transparently' by installing packages like binutils-gold, which\nchange what /usr/bin/ld actually points to.\n\nClang vs GCC notes:\n\nFor gcc, 'gcc -Wl,--version' gives a bunch of output about how to\ninvoke the linker before the version information string. For 'clang',\nthe version information for 'ld' is all that's output. For this\nreason, we typically need to slurp up all of the standard error output\nand look through it.\n\nOther notes:\n\nWe cache the LinkerInfo inside DynFlags, since clients may link\nmultiple times. The definition of LinkerInfo is there to avoid a\ncircular dependency.\n\n-}\n\n{- Note [ELF needed shared libs]\n\nSome distributions change the link editor's default handling of\nELF DT_NEEDED tags to include only those shared objects that are\nneeded to resolve undefined symbols. For Template Haskell we need\nthe last temporary shared library also if it is not needed for the\ncurrently linked temporary shared library. We specify --no-as-needed\nto override the default. This flag exists in GNU ld and GNU gold.\n\nThe flag is only needed on ELF systems. On Windows (PE) and Mac OS X\n(Mach-O) the flag is not needed.\n\n-}\n\n{- Note [Windows static libGCC]\n\nThe GCC versions being upgraded to in #10726 are configured with\ndynamic linking of libgcc supported. This results in libgcc being\nlinked dynamically when a shared library is created.\n\nThis introduces thus an extra dependency on GCC dll that was not\nneeded before by shared libraries created with GHC. This is a particular\nissue on Windows because you get a non-obvious error due to this missing\ndependency. This dependent dll is also not commonly on your path.\n\nFor this reason using the static libgcc is preferred as it preserves\nthe same behaviour that existed before. There are however some very good\nreasons to have the shared version as well as described on page 181 of\nhttps://gcc.gnu.org/onlinedocs/gcc-5.2.0/gcc.pdf :\n\n\"There are several situations in which an application should use the\n shared \u00e2\u20ac\u02dclibgcc\u00e2\u20ac\u2122 instead of the static version. The most common of these\n is when the application wishes to throw and catch exceptions across different\n shared libraries. In that case, each of the libraries as well as the application\n itself should use the shared \u00e2\u20ac\u02dclibgcc\u00e2\u20ac\u2122. \"\n\n-}\n\nneededLinkArgs :: LinkerInfo -> [Option]\nneededLinkArgs (GnuLD o)     = o\nneededLinkArgs (GnuGold o)   = o\nneededLinkArgs (LlvmLLD o)   = o\nneededLinkArgs (DarwinLD o)  = o\nneededLinkArgs (SolarisLD o) = o\nneededLinkArgs (AixLD o)     = o\nneededLinkArgs UnknownLD     = []\n\n-- Grab linker info and cache it in DynFlags.\ngetLinkerInfo :: DynFlags -> IO LinkerInfo\ngetLinkerInfo dflags = do\n  info <- readIORef (rtldInfo dflags)\n  case info of\n    Just v  -> return v\n    Nothing -> do\n      v <- getLinkerInfo' dflags\n      writeIORef (rtldInfo dflags) (Just v)\n      return v\n\n-- See Note [Run-time linker info].\ngetLinkerInfo' :: DynFlags -> IO LinkerInfo\ngetLinkerInfo' dflags = do\n  let platform = targetPlatform dflags\n      os = platformOS platform\n      (pgm,args0) = pgm_l dflags\n      args1     = map Option (getOpts dflags opt_l)\n      args2     = args0 ++ args1\n      args3     = filter notNull (map showOpt args2)\n\n      -- Try to grab the info from the process output.\n      parseLinkerInfo stdo _stde _exitc\n        | any (\"GNU ld\" `isPrefixOf`) stdo =\n          -- GNU ld specifically needs to use less memory. This especially\n          -- hurts on small object files. Trac #5240.\n          -- Set DT_NEEDED for all shared libraries. Trac #10110.\n          -- TODO: Investigate if these help or hurt when using split sections.\n          return (GnuLD $ map Option [\"-Wl,--hash-size=31\",\n                                      \"-Wl,--reduce-memory-overheads\",\n                                      -- ELF specific flag\n                                      -- see Note [ELF needed shared libs]\n                                      \"-Wl,--no-as-needed\"])\n\n        | any (\"GNU gold\" `isPrefixOf`) stdo =\n          -- GNU gold only needs --no-as-needed. Trac #10110.\n          -- ELF specific flag, see Note [ELF needed shared libs]\n          return (GnuGold [Option \"-Wl,--no-as-needed\"])\n\n        | any (\"LLD\" `isPrefixOf`) stdo =\n          return (LlvmLLD $ map Option [\n                                      -- see Note [ELF needed shared libs]\n                                      \"-Wl,--no-as-needed\"])\n\n         -- Unknown linker.\n        | otherwise = fail \"invalid --version output, or linker is unsupported\"\n\n  -- Process the executable call\n  info <- catchIO (do\n             case os of\n               OSSolaris2 ->\n                 -- Solaris uses its own Solaris linker. Even all\n                 -- GNU C are recommended to configure with Solaris\n                 -- linker instead of using GNU binutils linker. Also\n                 -- all GCC distributed with Solaris follows this rule\n                 -- precisely so we assume here, the Solaris linker is\n                 -- used.\n                 return $ SolarisLD []\n               OSAIX ->\n                 -- IBM AIX uses its own non-binutils linker as well\n                 return $ AixLD []\n               OSDarwin ->\n                 -- Darwin has neither GNU Gold or GNU LD, but a strange linker\n                 -- that doesn't support --version. We can just assume that's\n                 -- what we're using.\n                 return $ DarwinLD []\n               OSMinGW32 ->\n                 -- GHC doesn't support anything but GNU ld on Windows anyway.\n                 -- Process creation is also fairly expensive on win32, so\n                 -- we short-circuit here.\n                 return $ GnuLD $ map Option\n                   [ -- Reduce ld memory usage\n                     \"-Wl,--hash-size=31\"\n                   , \"-Wl,--reduce-memory-overheads\"\n                     -- Emit gcc stack checks\n                     -- Note [Windows stack usage]\n                   , \"-fstack-check\"\n                     -- Force static linking of libGCC\n                     -- Note [Windows static libGCC]\n                   , \"-static-libgcc\" ]\n               _ -> do\n                 -- In practice, we use the compiler as the linker here. Pass\n                 -- -Wl,--version to get linker version info.\n                 (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm\n                                        ([\"-Wl,--version\"] ++ args3)\n                                        c_locale_env\n                 -- Split the output by lines to make certain kinds\n                 -- of processing easier. In particular, 'clang' and 'gcc'\n                 -- have slightly different outputs for '-Wl,--version', but\n                 -- it's still easy to figure out.\n                 parseLinkerInfo (lines stdo) (lines stde) exitc\n            )\n            (\\err -> do\n                debugTraceMsg dflags 2\n                    (text \"Error (figuring out linker information):\" <+>\n                     text (show err))\n                errorMsg dflags $ hang (text \"Warning:\") 9 $\n                  text \"Couldn't figure out linker information!\" $$\n                  text \"Make sure you're using GNU ld, GNU gold\" <+>\n                  text \"or the built in OS X linker, etc.\"\n                return UnknownLD)\n  return info\n\n-- Grab compiler info and cache it in DynFlags.\ngetCompilerInfo :: DynFlags -> IO CompilerInfo\ngetCompilerInfo dflags = do\n  info <- readIORef (rtccInfo dflags)\n  case info of\n    Just v  -> return v\n    Nothing -> do\n      v <- getCompilerInfo' dflags\n      writeIORef (rtccInfo dflags) (Just v)\n      return v\n\n-- See Note [Run-time linker info].\ngetCompilerInfo' :: DynFlags -> IO CompilerInfo\ngetCompilerInfo' dflags = do\n  let (pgm,_) = pgm_c dflags\n      -- Try to grab the info from the process output.\n      parseCompilerInfo _stdo stde _exitc\n        -- Regular GCC\n        | any (\"gcc version\" `isInfixOf`) stde =\n          return GCC\n        -- Regular clang\n        | any (\"clang version\" `isInfixOf`) stde =\n          return Clang\n        -- FreeBSD clang\n        | any (\"FreeBSD clang version\" `isInfixOf`) stde =\n          return Clang\n        -- XCode 5.1 clang\n        | any (\"Apple LLVM version 5.1\" `isPrefixOf`) stde =\n          return AppleClang51\n        -- XCode 5 clang\n        | any (\"Apple LLVM version\" `isPrefixOf`) stde =\n          return AppleClang\n        -- XCode 4.1 clang\n        | any (\"Apple clang version\" `isPrefixOf`) stde =\n          return AppleClang\n         -- Unknown linker.\n        | otherwise = fail \"invalid -v output, or compiler is unsupported\"\n\n  -- Process the executable call\n  info <- catchIO (do\n                (exitc, stdo, stde) <-\n                    readProcessEnvWithExitCode pgm [\"-v\"] c_locale_env\n                -- Split the output by lines to make certain kinds\n                -- of processing easier.\n                parseCompilerInfo (lines stdo) (lines stde) exitc\n            )\n            (\\err -> do\n                debugTraceMsg dflags 2\n                    (text \"Error (figuring out C compiler information):\" <+>\n                     text (show err))\n                errorMsg dflags $ hang (text \"Warning:\") 9 $\n                  text \"Couldn't figure out C compiler information!\" $$\n                  text \"Make sure you're using GNU gcc, or clang\"\n                return UnknownCC)\n  return info\n", "num_lines": 263}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n-----------------------------------------------------------------------------\n--\n-- Misc process handling code for SysTools\n--\n-- (c) The GHC Team 2017\n--\n-----------------------------------------------------------------------------\nmodule SysTools.Process where\n\n#include \"HsVersions.h\"\n\nimport Exception\nimport ErrUtils\nimport DynFlags\nimport FastString\nimport Outputable\nimport Panic\nimport GhcPrelude\nimport Util\nimport SrcLoc           ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )\n\nimport Control.Concurrent\nimport Data.Char\n\nimport System.Exit\nimport System.Environment\nimport System.FilePath\nimport System.IO\nimport System.IO.Error as IO\nimport System.Process\n\nimport FileCleanup\n\n-- Similar to System.Process.readCreateProcessWithExitCode, but stderr is\n-- inherited from the parent process, and output to stderr is not captured.\nreadCreateProcessWithExitCode'\n    :: CreateProcess\n    -> IO (ExitCode, String)    -- ^ stdout\nreadCreateProcessWithExitCode' proc = do\n    (_, Just outh, _, pid) <-\n        createProcess proc{ std_out = CreatePipe }\n\n    -- fork off a thread to start consuming the output\n    output  <- hGetContents outh\n    outMVar <- newEmptyMVar\n    _ <- forkIO $ evaluate (length output) >> putMVar outMVar ()\n\n    -- wait on the output\n    takeMVar outMVar\n    hClose outh\n\n    -- wait on the process\n    ex <- waitForProcess pid\n\n    return (ex, output)\n\nreplaceVar :: (String, String) -> [(String, String)] -> [(String, String)]\nreplaceVar (var, value) env =\n    (var, value) : filter (\\(var',_) -> var /= var') env\n\n-- | Version of @System.Process.readProcessWithExitCode@ that takes a\n-- key-value tuple to insert into the environment.\nreadProcessEnvWithExitCode\n    :: String -- ^ program path\n    -> [String] -- ^ program args\n    -> (String, String) -- ^ addition to the environment\n    -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)\nreadProcessEnvWithExitCode prog args env_update = do\n    current_env <- getEnvironment\n    readCreateProcessWithExitCode (proc prog args) {\n        env = Just (replaceVar env_update current_env) } \"\"\n\n-- Don't let gcc localize version info string, #8825\nc_locale_env :: (String, String)\nc_locale_env = (\"LANGUAGE\", \"C\")\n\n-- If the -B<dir> option is set, add <dir> to PATH.  This works around\n-- a bug in gcc on Windows Vista where it can't find its auxiliary\n-- binaries (see bug #1110).\ngetGccEnv :: [Option] -> IO (Maybe [(String,String)])\ngetGccEnv opts =\n  if null b_dirs\n     then return Nothing\n     else do env <- getEnvironment\n             return (Just (map mangle_path env))\n where\n  (b_dirs, _) = partitionWith get_b_opt opts\n\n  get_b_opt (Option ('-':'B':dir)) = Left dir\n  get_b_opt other = Right other\n\n  mangle_path (path,paths) | map toUpper path == \"PATH\"\n        = (path, '\\\"' : head b_dirs ++ \"\\\";\" ++ paths)\n  mangle_path other = other\n\n\n-----------------------------------------------------------------------------\n-- Running an external program\n\nrunSomething :: DynFlags\n             -> String          -- For -v message\n             -> String          -- Command name (possibly a full path)\n                                --      assumed already dos-ified\n             -> [Option]        -- Arguments\n                                --      runSomething will dos-ify them\n             -> IO ()\n\nrunSomething dflags phase_name pgm args =\n  runSomethingFiltered dflags id phase_name pgm args Nothing Nothing\n\n-- | Run a command, placing the arguments in an external response file.\n--\n-- This command is used in order to avoid overlong command line arguments on\n-- Windows. The command line arguments are first written to an external,\n-- temporary response file, and then passed to the linker via @filepath.\n-- response files for passing them in. See:\n--\n--     https://gcc.gnu.org/wiki/Response_Files\n--     https://ghc.haskell.org/trac/ghc/ticket/10777\nrunSomethingResponseFile\n  :: DynFlags -> (String->String) -> String -> String -> [Option]\n  -> Maybe [(String,String)] -> IO ()\n\nrunSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =\n    runSomethingWith dflags phase_name pgm args $ \\real_args -> do\n        fp <- getResponseFile real_args\n        let args = ['@':fp]\n        r <- builderMainLoop dflags filter_fn pgm args Nothing mb_env\n        return (r,())\n  where\n    getResponseFile args = do\n      fp <- newTempName dflags TFL_CurrentModule \"rsp\"\n      withFile fp WriteMode $ \\h -> do\n#if defined(mingw32_HOST_OS)\n          hSetEncoding h latin1\n#else\n          hSetEncoding h utf8\n#endif\n          hPutStr h $ unlines $ map escape args\n      return fp\n\n    -- Note: Response files have backslash-escaping, double quoting, and are\n    -- whitespace separated (some implementations use newline, others any\n    -- whitespace character). Therefore, escape any backslashes, newlines, and\n    -- double quotes in the argument, and surround the content with double\n    -- quotes.\n    --\n    -- Another possibility that could be considered would be to convert\n    -- backslashes in the argument to forward slashes. This would generally do\n    -- the right thing, since backslashes in general only appear in arguments\n    -- as part of file paths on Windows, and the forward slash is accepted for\n    -- those. However, escaping is more reliable, in case somehow a backslash\n    -- appears in a non-file.\n    escape x = concat\n        [ \"\\\"\"\n        , concatMap\n            (\\c ->\n                case c of\n                    '\\\\' -> \"\\\\\\\\\"\n                    '\\n' -> \"\\\\n\"\n                    '\\\"' -> \"\\\\\\\"\"\n                    _    -> [c])\n            x\n        , \"\\\"\"\n        ]\n\nrunSomethingFiltered\n  :: DynFlags -> (String->String) -> String -> String -> [Option]\n  -> Maybe FilePath -> Maybe [(String,String)] -> IO ()\n\nrunSomethingFiltered dflags filter_fn phase_name pgm args mb_cwd mb_env = do\n    runSomethingWith dflags phase_name pgm args $ \\real_args -> do\n        r <- builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env\n        return (r,())\n\nrunSomethingWith\n  :: DynFlags -> String -> String -> [Option]\n  -> ([String] -> IO (ExitCode, a))\n  -> IO a\n\nrunSomethingWith dflags phase_name pgm args io = do\n  let real_args = filter notNull (map showOpt args)\n      cmdLine = showCommandForUser pgm real_args\n  traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args\n\nhandleProc :: String -> String -> IO (ExitCode, r) -> IO r\nhandleProc pgm phase_name proc = do\n    (rc, r) <- proc `catchIO` handler\n    case rc of\n      ExitSuccess{} -> return r\n      ExitFailure n -> throwGhcExceptionIO (\n            ProgramError (\"`\" ++ takeFileName pgm ++ \"'\" ++\n                          \" failed in phase `\" ++ phase_name ++ \"'.\" ++\n                          \" (Exit code: \" ++ show n ++ \")\"))\n  where\n    handler err =\n       if IO.isDoesNotExistError err\n          then does_not_exist\n          else throwGhcExceptionIO (ProgramError $ show err)\n\n    does_not_exist = throwGhcExceptionIO (InstallationError (\"could not execute: \" ++ pgm))\n\n\nbuilderMainLoop :: DynFlags -> (String -> String) -> FilePath\n                -> [String] -> Maybe FilePath -> Maybe [(String, String)]\n                -> IO ExitCode\nbuilderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do\n  chan <- newChan\n\n  -- We use a mask here rather than a bracket because we want\n  -- to distinguish between cleaning up with and without an\n  -- exception. This is to avoid calling terminateProcess\n  -- unless an exception was raised.\n  let safely inner = mask $ \\restore -> do\n        -- acquire\n        (hStdIn, hStdOut, hStdErr, hProcess) <- restore $\n          runInteractiveProcess pgm real_args mb_cwd mb_env\n        let cleanup_handles = do\n              hClose hStdIn\n              hClose hStdOut\n              hClose hStdErr\n        r <- try $ restore $ do\n          hSetBuffering hStdOut LineBuffering\n          hSetBuffering hStdErr LineBuffering\n          let make_reader_proc h = forkIO $ readerProc chan h filter_fn\n          bracketOnError (make_reader_proc hStdOut) killThread $ \\_ ->\n            bracketOnError (make_reader_proc hStdErr) killThread $ \\_ ->\n            inner hProcess\n        case r of\n          -- onException\n          Left (SomeException e) -> do\n            terminateProcess hProcess\n            cleanup_handles\n            throw e\n          -- cleanup when there was no exception\n          Right s -> do\n            cleanup_handles\n            return s\n  safely $ \\h -> do\n    -- we don't want to finish until 2 streams have been complete\n    -- (stdout and stderr)\n    log_loop chan (2 :: Integer)\n    -- after that, we wait for the process to finish and return the exit code.\n    waitForProcess h\n  where\n    -- t starts at the number of streams we're listening to (2) decrements each\n    -- time a reader process sends EOF. We are safe from looping forever if a\n    -- reader thread dies, because they send EOF in a finally handler.\n    log_loop _ 0 = return ()\n    log_loop chan t = do\n      msg <- readChan chan\n      case msg of\n        BuildMsg msg -> do\n          putLogMsg dflags NoReason SevInfo noSrcSpan\n              (defaultUserStyle dflags) msg\n          log_loop chan t\n        BuildError loc msg -> do\n          putLogMsg dflags NoReason SevError (mkSrcSpan loc loc)\n              (defaultUserStyle dflags) msg\n          log_loop chan t\n        EOF ->\n          log_loop chan  (t-1)\n\nreaderProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()\nreaderProc chan hdl filter_fn =\n    (do str <- hGetContents hdl\n        loop (linesPlatform (filter_fn str)) Nothing)\n    `finally`\n       writeChan chan EOF\n        -- ToDo: check errors more carefully\n        -- ToDo: in the future, the filter should be implemented as\n        -- a stream transformer.\n    where\n        loop []     Nothing    = return ()\n        loop []     (Just err) = writeChan chan err\n        loop (l:ls) in_err     =\n                case in_err of\n                  Just err@(BuildError srcLoc msg)\n                    | leading_whitespace l -> do\n                        loop ls (Just (BuildError srcLoc (msg $$ text l)))\n                    | otherwise -> do\n                        writeChan chan err\n                        checkError l ls\n                  Nothing -> do\n                        checkError l ls\n                  _ -> panic \"readerProc/loop\"\n\n        checkError l ls\n           = case parseError l of\n                Nothing -> do\n                    writeChan chan (BuildMsg (text l))\n                    loop ls Nothing\n                Just (file, lineNum, colNum, msg) -> do\n                    let srcLoc = mkSrcLoc (mkFastString file) lineNum colNum\n                    loop ls (Just (BuildError srcLoc (text msg)))\n\n        leading_whitespace []    = False\n        leading_whitespace (x:_) = isSpace x\n\nparseError :: String -> Maybe (String, Int, Int, String)\nparseError s0 = case breakColon s0 of\n                Just (filename, s1) ->\n                    case breakIntColon s1 of\n                    Just (lineNum, s2) ->\n                        case breakIntColon s2 of\n                        Just (columnNum, s3) ->\n                            Just (filename, lineNum, columnNum, s3)\n                        Nothing ->\n                            Just (filename, lineNum, 0, s2)\n                    Nothing -> Nothing\n                Nothing -> Nothing\n\nbreakColon :: String -> Maybe (String, String)\nbreakColon xs = case break (':' ==) xs of\n                    (ys, _:zs) -> Just (ys, zs)\n                    _ -> Nothing\n\nbreakIntColon :: String -> Maybe (Int, String)\nbreakIntColon xs = case break (':' ==) xs of\n                       (ys, _:zs)\n                        | not (null ys) && all isAscii ys && all isDigit ys ->\n                           Just (read ys, zs)\n                       _ -> Nothing\n\ndata BuildMessage\n  = BuildMsg   !SDoc\n  | BuildError !SrcLoc !SDoc\n  | EOF\n\n-- Divvy up text stream into lines, taking platform dependent\n-- line termination into account.\nlinesPlatform :: String -> [String]\n#if !defined(mingw32_HOST_OS)\nlinesPlatform ls = lines ls\n#else\nlinesPlatform \"\" = []\nlinesPlatform xs =\n  case lineBreak xs of\n    (as,xs1) -> as : linesPlatform xs1\n  where\n   lineBreak \"\" = (\"\",\"\")\n   lineBreak ('\\r':'\\n':xs) = ([],xs)\n   lineBreak ('\\n':xs) = ([],xs)\n   lineBreak (x:xs) = let (as,bs) = lineBreak xs in (x:as,bs)\n\n#endif\n", "num_lines": 348}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n-----------------------------------------------------------------------------\n--\n-- Tasks running external programs for SysTools\n--\n-- (c) The GHC Team 2017\n--\n-----------------------------------------------------------------------------\nmodule SysTools.Tasks where\n\nimport Exception\nimport ErrUtils\nimport DynFlags\nimport Outputable\nimport Platform\nimport Util\n\nimport Data.Char\nimport Data.List\n\nimport System.IO\nimport System.Process\nimport GhcPrelude\n\nimport LlvmCodeGen.Base (llvmVersionStr, supportedLlvmVersion)\n\nimport SysTools.Process\nimport SysTools.Info\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Running an external program}\n*                                                                      *\n************************************************************************\n-}\n\nrunUnlit :: DynFlags -> [Option] -> IO ()\nrunUnlit dflags args = do\n  let prog = pgm_L dflags\n      opts = getOpts dflags opt_L\n  runSomething dflags \"Literate pre-processor\" prog\n               (map Option opts ++ args)\n\nrunCpp :: DynFlags -> [Option] -> IO ()\nrunCpp dflags args =   do\n  let (p,args0) = pgm_P dflags\n      args1 = map Option (getOpts dflags opt_P)\n      args2 = [Option \"-Werror\" | gopt Opt_WarnIsError dflags]\n                ++ [Option \"-Wundef\" | wopt Opt_WarnCPPUndef dflags]\n  mb_env <- getGccEnv args2\n  runSomethingFiltered dflags id  \"C pre-processor\" p\n                       (args0 ++ args1 ++ args2 ++ args) Nothing mb_env\n\nrunPp :: DynFlags -> [Option] -> IO ()\nrunPp dflags args =   do\n  let prog = pgm_F dflags\n      opts = map Option (getOpts dflags opt_F)\n  runSomething dflags \"Haskell pre-processor\" prog (args ++ opts)\n\nrunCc :: DynFlags -> [Option] -> IO ()\nrunCc dflags args =   do\n  let (p,args0) = pgm_c dflags\n      args1 = map Option (getOpts dflags opt_c)\n      args2 = args0 ++ args ++ args1\n      -- We take care to pass -optc flags in args1 last to ensure that the\n      -- user can override flags passed by GHC. See #14452.\n  mb_env <- getGccEnv args2\n  runSomethingResponseFile dflags cc_filter \"C Compiler\" p args2 mb_env\n where\n  -- discard some harmless warnings from gcc that we can't turn off\n  cc_filter = unlines . doFilter . lines\n\n  {-\n  gcc gives warnings in chunks like so:\n      In file included from /foo/bar/baz.h:11,\n                       from /foo/bar/baz2.h:22,\n                       from wibble.c:33:\n      /foo/flibble:14: global register variable ...\n      /foo/flibble:15: warning: call-clobbered r...\n  We break it up into its chunks, remove any call-clobbered register\n  warnings from each chunk, and then delete any chunks that we have\n  emptied of warnings.\n  -}\n  doFilter = unChunkWarnings . filterWarnings . chunkWarnings []\n  -- We can't assume that the output will start with an \"In file inc...\"\n  -- line, so we start off expecting a list of warnings rather than a\n  -- location stack.\n  chunkWarnings :: [String] -- The location stack to use for the next\n                            -- list of warnings\n                -> [String] -- The remaining lines to look at\n                -> [([String], [String])]\n  chunkWarnings loc_stack [] = [(loc_stack, [])]\n  chunkWarnings loc_stack xs\n      = case break loc_stack_start xs of\n        (warnings, lss:xs') ->\n            case span loc_start_continuation xs' of\n            (lsc, xs'') ->\n                (loc_stack, warnings) : chunkWarnings (lss : lsc) xs''\n        _ -> [(loc_stack, xs)]\n\n  filterWarnings :: [([String], [String])] -> [([String], [String])]\n  filterWarnings [] = []\n  -- If the warnings are already empty then we are probably doing\n  -- something wrong, so don't delete anything\n  filterWarnings ((xs, []) : zs) = (xs, []) : filterWarnings zs\n  filterWarnings ((xs, ys) : zs) = case filter wantedWarning ys of\n                                       [] -> filterWarnings zs\n                                       ys' -> (xs, ys') : filterWarnings zs\n\n  unChunkWarnings :: [([String], [String])] -> [String]\n  unChunkWarnings [] = []\n  unChunkWarnings ((xs, ys) : zs) = xs ++ ys ++ unChunkWarnings zs\n\n  loc_stack_start        s = \"In file included from \" `isPrefixOf` s\n  loc_start_continuation s = \"                 from \" `isPrefixOf` s\n  wantedWarning w\n   | \"warning: call-clobbered register used\" `isContainedIn` w = False\n   | otherwise = True\n\nisContainedIn :: String -> String -> Bool\nxs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)\n\n-- | Run the linker with some arguments and return the output\naskLd :: DynFlags -> [Option] -> IO String\naskLd dflags args = do\n  let (p,args0) = pgm_l dflags\n      args1     = map Option (getOpts dflags opt_l)\n      args2     = args0 ++ args1 ++ args\n  mb_env <- getGccEnv args2\n  runSomethingWith dflags \"gcc\" p args2 $ \\real_args ->\n    readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }\n\nrunAs :: DynFlags -> [Option] -> IO ()\nrunAs dflags args = do\n  let (p,args0) = pgm_a dflags\n      args1 = map Option (getOpts dflags opt_a)\n      args2 = args0 ++ args1 ++ args\n  mb_env <- getGccEnv args2\n  runSomethingFiltered dflags id \"Assembler\" p args2 Nothing mb_env\n\n-- | Run the LLVM Optimiser\nrunLlvmOpt :: DynFlags -> [Option] -> IO ()\nrunLlvmOpt dflags args = do\n  let (p,args0) = pgm_lo dflags\n      args1 = map Option (getOpts dflags opt_lo)\n      -- We take care to pass -optlo flags (e.g. args0) last to ensure that the\n      -- user can override flags passed by GHC. See #14821.\n  runSomething dflags \"LLVM Optimiser\" p (args1 ++ args ++ args0)\n\n-- | Run the LLVM Compiler\nrunLlvmLlc :: DynFlags -> [Option] -> IO ()\nrunLlvmLlc dflags args = do\n  let (p,args0) = pgm_lc dflags\n      args1 = map Option (getOpts dflags opt_lc)\n  runSomething dflags \"LLVM Compiler\" p (args0 ++ args1 ++ args)\n\n-- | Run the clang compiler (used as an assembler for the LLVM\n-- backend on OS X as LLVM doesn't support the OS X system\n-- assembler)\nrunClang :: DynFlags -> [Option] -> IO ()\nrunClang dflags args = do\n  let (clang,_) = pgm_lcc dflags\n      -- be careful what options we call clang with\n      -- see #5903 and #7617 for bugs caused by this.\n      (_,args0) = pgm_a dflags\n      args1 = map Option (getOpts dflags opt_a)\n      args2 = args0 ++ args1 ++ args\n  mb_env <- getGccEnv args2\n  Exception.catch (do\n        runSomethingFiltered dflags id \"Clang (Assembler)\" clang args2 Nothing mb_env\n    )\n    (\\(err :: SomeException) -> do\n        errorMsg dflags $\n            text (\"Error running clang! you need clang installed to use the\" ++\n                  \" LLVM backend\") $+$\n            text \"(or GHC tried to execute clang incorrectly)\"\n        throwIO err\n    )\n\n-- | Figure out which version of LLVM we are running this session\nfigureLlvmVersion :: DynFlags -> IO (Maybe (Int, Int))\nfigureLlvmVersion dflags = do\n  let (pgm,opts) = pgm_lc dflags\n      args = filter notNull (map showOpt opts)\n      -- we grab the args even though they should be useless just in\n      -- case the user is using a customised 'llc' that requires some\n      -- of the options they've specified. llc doesn't care what other\n      -- options are specified when '-version' is used.\n      args' = args ++ [\"-version\"]\n  ver <- catchIO (do\n              (pin, pout, perr, _) <- runInteractiveProcess pgm args'\n                                              Nothing Nothing\n              {- > llc -version\n                  LLVM (http://llvm.org/):\n                    LLVM version 3.5.2\n                    ...\n              -}\n              hSetBinaryMode pout False\n              _     <- hGetLine pout\n              vline <- dropWhile (not . isDigit) `fmap` hGetLine pout\n              v     <- case span (/= '.') vline of\n                        (\"\",_)  -> fail \"no digits!\"\n                        (x,y) -> return (read x\n                                        , read $ takeWhile isDigit $ drop 1 y)\n\n              hClose pin\n              hClose pout\n              hClose perr\n              return $ Just v\n            )\n            (\\err -> do\n                debugTraceMsg dflags 2\n                    (text \"Error (figuring out LLVM version):\" <+>\n                      text (show err))\n                errorMsg dflags $ vcat\n                    [ text \"Warning:\", nest 9 $\n                          text \"Couldn't figure out LLVM version!\" $$\n                          text (\"Make sure you have installed LLVM \" ++\n                                llvmVersionStr supportedLlvmVersion) ]\n                return Nothing)\n  return ver\n\n\nrunLink :: DynFlags -> [Option] -> IO ()\nrunLink dflags args = do\n  -- See Note [Run-time linker info]\n  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags\n  let (p,args0) = pgm_l dflags\n      args1     = map Option (getOpts dflags opt_l)\n      args2     = args0 ++ linkargs ++ args1 ++ args\n  mb_env <- getGccEnv args2\n  runSomethingResponseFile dflags ld_filter \"Linker\" p args2 mb_env\n  where\n    ld_filter = case (platformOS (targetPlatform dflags)) of\n                  OSSolaris2 -> sunos_ld_filter\n                  _ -> id\n{-\n  SunOS/Solaris ld emits harmless warning messages about unresolved\n  symbols in case of compiling into shared library when we do not\n  link against all the required libs. That is the case of GHC which\n  does not link against RTS library explicitly in order to be able to\n  choose the library later based on binary application linking\n  parameters. The warnings look like:\n\nUndefined                       first referenced\n  symbol                             in file\nstg_ap_n_fast                       ./T2386_Lib.o\nstg_upd_frame_info                  ./T2386_Lib.o\ntemplatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o\ntemplatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o\ntemplatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o\ntemplatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o\nnewCAF                              ./T2386_Lib.o\nstg_bh_upd_frame_info               ./T2386_Lib.o\nstg_ap_ppp_fast                     ./T2386_Lib.o\ntemplatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o\nstg_ap_p_fast                       ./T2386_Lib.o\nstg_ap_pp_fast                      ./T2386_Lib.o\nld: warning: symbol referencing errors\n\n  this is actually coming from T2386 testcase. The emitting of those\n  warnings is also a reason why so many TH testcases fail on Solaris.\n\n  Following filter code is SunOS/Solaris linker specific and should\n  filter out only linker warnings. Please note that the logic is a\n  little bit more complex due to the simple reason that we need to preserve\n  any other linker emitted messages. If there are any. Simply speaking\n  if we see \"Undefined\" and later \"ld: warning:...\" then we omit all\n  text between (including) the marks. Otherwise we copy the whole output.\n-}\n    sunos_ld_filter :: String -> String\n    sunos_ld_filter = unlines . sunos_ld_filter' . lines\n    sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)\n                          then (ld_prefix x) ++ (ld_postfix x)\n                          else x\n    breakStartsWith x y = break (isPrefixOf x) y\n    ld_prefix = fst . breakStartsWith \"Undefined\"\n    undefined_found = not . null . snd . breakStartsWith \"Undefined\"\n    ld_warn_break = breakStartsWith \"ld: warning: symbol referencing errors\"\n    ld_postfix = tail . snd . ld_warn_break\n    ld_warning_found = not . null . snd . ld_warn_break\n\n\nrunLibtool :: DynFlags -> [Option] -> IO ()\nrunLibtool dflags args = do\n  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags\n  let args1      = map Option (getOpts dflags opt_l)\n      args2      = [Option \"-static\"] ++ args1 ++ args ++ linkargs\n      libtool    = pgm_libtool dflags\n  mb_env <- getGccEnv args2\n  runSomethingFiltered dflags id \"Linker\" libtool args2 Nothing mb_env\n\nrunAr :: DynFlags -> Maybe FilePath -> [Option] -> IO ()\nrunAr dflags cwd args = do\n  let ar = pgm_ar dflags\n  runSomethingFiltered dflags id \"Ar\" ar args cwd Nothing\n\naskAr :: DynFlags -> Maybe FilePath -> [Option] -> IO String\naskAr dflags mb_cwd args = do\n  let ar = pgm_ar dflags\n  runSomethingWith dflags \"Ar\" ar args $ \\real_args ->\n    readCreateProcessWithExitCode' (proc ar real_args){ cwd = mb_cwd }\n\nrunRanlib :: DynFlags -> [Option] -> IO ()\nrunRanlib dflags args = do\n  let ranlib = pgm_ranlib dflags\n  runSomethingFiltered dflags id \"Ranlib\" ranlib args Nothing Nothing\n\nrunMkDLL :: DynFlags -> [Option] -> IO ()\nrunMkDLL dflags args = do\n  let (p,args0) = pgm_dll dflags\n      args1 = args0 ++ args\n  mb_env <- getGccEnv (args0++args)\n  runSomethingFiltered dflags id \"Make DLL\" p args1 Nothing mb_env\n\nrunWindres :: DynFlags -> [Option] -> IO ()\nrunWindres dflags args = do\n  let (gcc, gcc_args) = pgm_c dflags\n      windres = pgm_windres dflags\n      opts = map Option (getOpts dflags opt_windres)\n      quote x = \"\\\"\" ++ x ++ \"\\\"\"\n      args' = -- If windres.exe and gcc.exe are in a directory containing\n              -- spaces then windres fails to run gcc. We therefore need\n              -- to tell it what command to use...\n              Option (\"--preprocessor=\" ++\n                      unwords (map quote (gcc :\n                                          map showOpt gcc_args ++\n                                          map showOpt opts ++\n                                          [\"-E\", \"-xc\", \"-DRC_INVOKED\"])))\n              -- ...but if we do that then if windres calls popen then\n              -- it can't understand the quoting, so we have to use\n              -- --use-temp-file so that it interprets it correctly.\n              -- See #1828.\n            : Option \"--use-temp-file\"\n            : args\n  mb_env <- getGccEnv gcc_args\n  runSomethingFiltered dflags id \"Windres\" windres args' Nothing mb_env\n\ntouch :: DynFlags -> String -> String -> IO ()\ntouch dflags purpose arg =\n  runSomething dflags purpose (pgm_T dflags) [FileOption \"\" arg]\n", "num_lines": 343}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule SysTools.Terminal (stderrSupportsAnsiColors) where\n\nimport GhcPrelude\n\n#if defined MIN_VERSION_terminfo\nimport Control.Exception (catch)\nimport Data.Maybe (fromMaybe)\nimport System.Console.Terminfo (SetupTermError, Terminal, getCapability,\n                                setupTermFromEnv, termColors)\nimport System.Posix (queryTerminal, stdError)\n#elif defined mingw32_HOST_OS\nimport Control.Exception (catch, try)\nimport Data.Bits ((.|.), (.&.))\nimport Data.List (isInfixOf, isPrefixOf, isSuffixOf)\nimport Foreign (FunPtr, Ptr, allocaBytes, castPtrToFunPtr,\n                peek, plusPtr, sizeOf, with)\nimport Foreign.C (CInt(..), CWchar, peekCWStringLen)\nimport qualified Graphics.Win32 as Win32\nimport qualified System.Win32 as Win32\n#endif\n\n#if defined mingw32_HOST_OS && !defined WINAPI\n# if defined i386_HOST_ARCH\n#  define WINAPI stdcall\n# elif defined x86_64_HOST_ARCH\n#  define WINAPI ccall\n# else\n#  error unknown architecture\n# endif\n#endif\n\n-- | Check if ANSI escape sequences can be used to control color in stderr.\nstderrSupportsAnsiColors :: IO Bool\nstderrSupportsAnsiColors = do\n#if defined MIN_VERSION_terminfo\n  queryTerminal stdError `andM` do\n    (termSupportsColors <$> setupTermFromEnv)\n      `catch` \\ (_ :: SetupTermError) ->\n        pure False\n\n  where\n\n    andM :: Monad m => m Bool -> m Bool -> m Bool\n    andM mx my = do\n      x <- mx\n      if x\n        then my\n        else pure x\n\n    termSupportsColors :: Terminal -> Bool\n    termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0\n\n#elif defined mingw32_HOST_OS\n  h <- Win32.getStdHandle Win32.sTD_ERROR_HANDLE\n         `catch` \\ (_ :: IOError) ->\n           pure Win32.nullHANDLE\n  if h == Win32.nullHANDLE\n    then pure False\n    else do\n      eMode <- try (getConsoleMode h)\n      case eMode of\n        Left (_ :: IOError) -> queryCygwinTerminal h\n        Right mode\n          | modeHasVTP mode -> pure True\n          | otherwise       -> enableVTP h mode\n\n  where\n\n    queryCygwinTerminal :: Win32.HANDLE -> IO Bool\n    queryCygwinTerminal h = do\n        fileType <- Win32.getFileType h\n        if fileType /= Win32.fILE_TYPE_PIPE\n          then pure False\n          else do\n            fn <- getFileNameByHandle h\n            pure ((\"\\\\cygwin-\" `isPrefixOf` fn || \"\\\\msys-\" `isPrefixOf` fn) &&\n                  \"-pty\" `isInfixOf` fn &&\n                  \"-master\" `isSuffixOf` fn)\n      `catch` \\ (_ :: IOError) ->\n        pure False\n\n    enableVTP :: Win32.HANDLE -> Win32.DWORD -> IO Bool\n    enableVTP h mode = do\n        setConsoleMode h (modeAddVTP mode)\n        modeHasVTP <$> getConsoleMode h\n      `catch` \\ (_ :: IOError) ->\n        pure False\n\n    modeHasVTP :: Win32.DWORD -> Bool\n    modeHasVTP mode = mode .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING /= 0\n\n    modeAddVTP :: Win32.DWORD -> Win32.DWORD\n    modeAddVTP mode = mode .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING\n\neNABLE_VIRTUAL_TERMINAL_PROCESSING :: Win32.DWORD\neNABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004\n\ngetConsoleMode :: Win32.HANDLE -> IO Win32.DWORD\ngetConsoleMode h = with 64 $ \\ mode -> do\n  Win32.failIfFalse_ \"GetConsoleMode\" (c_GetConsoleMode h mode)\n  peek mode\n\nsetConsoleMode :: Win32.HANDLE -> Win32.DWORD -> IO ()\nsetConsoleMode h mode = do\n  Win32.failIfFalse_ \"SetConsoleMode\" (c_SetConsoleMode h mode)\n\nforeign import WINAPI unsafe \"windows.h GetConsoleMode\" c_GetConsoleMode\n  :: Win32.HANDLE -> Ptr Win32.DWORD -> IO Win32.BOOL\n\nforeign import WINAPI unsafe \"windows.h SetConsoleMode\" c_SetConsoleMode\n  :: Win32.HANDLE -> Win32.DWORD -> IO Win32.BOOL\n\nfileNameInfo :: CInt\nfileNameInfo = 2\n\nmAX_PATH :: Num a => a\nmAX_PATH = 260\n\ngetFileNameByHandle :: Win32.HANDLE -> IO String\ngetFileNameByHandle h = do\n  let sizeOfDWORD = sizeOf (undefined :: Win32.DWORD)\n  let sizeOfWchar = sizeOf (undefined :: CWchar)\n  -- note: implicitly assuming that DWORD has stronger alignment than wchar_t\n  let bufSize = sizeOfDWORD + mAX_PATH * sizeOfWchar\n  allocaBytes bufSize $ \\ buf -> do\n    getFileInformationByHandleEx h fileNameInfo buf (fromIntegral bufSize)\n    len :: Win32.DWORD <- peek buf\n    let len' = fromIntegral len `div` sizeOfWchar\n    peekCWStringLen (buf `plusPtr` sizeOfDWORD, min len' mAX_PATH)\n\ngetFileInformationByHandleEx\n  :: Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO ()\ngetFileInformationByHandleEx h cls buf bufSize = do\n  lib <- Win32.getModuleHandle (Just \"kernel32.dll\")\n  ptr <- Win32.getProcAddress lib \"GetFileInformationByHandleEx\"\n  let c_GetFileInformationByHandleEx =\n        mk_GetFileInformationByHandleEx (castPtrToFunPtr ptr)\n  Win32.failIfFalse_ \"getFileInformationByHandleEx\"\n    (c_GetFileInformationByHandleEx h cls buf bufSize)\n\ntype F_GetFileInformationByHandleEx a =\n  Win32.HANDLE -> CInt -> Ptr a -> Win32.DWORD -> IO Win32.BOOL\n\nforeign import WINAPI \"dynamic\"\n  mk_GetFileInformationByHandleEx\n  :: FunPtr (F_GetFileInformationByHandleEx a)\n  -> F_GetFileInformationByHandleEx a\n\n#else\n   pure False\n#endif\n", "num_lines": 154}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 1993-2004\n--\n-- This is the top-level module in the native code generator.\n--\n-- -----------------------------------------------------------------------------\n\n{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, UnboxedTuples #-}\n\nmodule AsmCodeGen (\n                    -- * Module entry point\n                    nativeCodeGen\n\n                    -- * Test-only exports: see trac #12744\n                    -- used by testGraphNoSpills, which needs to access\n                    -- the register allocator intermediate data structures\n                    -- cmmNativeGen emits\n                  , cmmNativeGen\n                  , NcgImpl(..)\n                  , x86NcgImpl\n                  ) where\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n\n\nimport GhcPrelude\n\nimport qualified X86.CodeGen\nimport qualified X86.Regs\nimport qualified X86.Instr\nimport qualified X86.Ppr\n\nimport qualified SPARC.CodeGen\nimport qualified SPARC.Regs\nimport qualified SPARC.Instr\nimport qualified SPARC.Ppr\nimport qualified SPARC.ShortcutJump\nimport qualified SPARC.CodeGen.Expand\n\nimport qualified PPC.CodeGen\nimport qualified PPC.Regs\nimport qualified PPC.RegInfo\nimport qualified PPC.Instr\nimport qualified PPC.Ppr\n\nimport RegAlloc.Liveness\nimport qualified RegAlloc.Linear.Main           as Linear\n\nimport qualified GraphColor                     as Color\nimport qualified RegAlloc.Graph.Main            as Color\nimport qualified RegAlloc.Graph.Stats           as Color\nimport qualified RegAlloc.Graph.TrivColorable   as Color\n\nimport AsmUtils\nimport TargetReg\nimport Platform\nimport BlockLayout\nimport Config\nimport Instruction\nimport PIC\nimport Reg\nimport NCGMonad\nimport CFG\nimport Dwarf\nimport Debug\n\nimport BlockId\nimport CgUtils          ( fixStgRegisters )\nimport Cmm\nimport CmmUtils\nimport Hoopl.Collections\nimport Hoopl.Label\nimport Hoopl.Block\nimport CmmOpt           ( cmmMachOpFold )\nimport PprCmm\nimport CLabel\n\nimport UniqFM\nimport UniqSupply\nimport DynFlags\nimport Util\n\nimport BasicTypes       ( Alignment )\nimport qualified Pretty\nimport BufWrite\nimport Outputable\nimport FastString\nimport UniqSet\nimport ErrUtils\nimport Module\nimport Stream (Stream)\nimport qualified Stream\n\n-- DEBUGGING ONLY\n--import OrdList\n\nimport Data.List\nimport Data.Maybe\nimport Data.Ord         ( comparing )\nimport Control.Exception\nimport Control.Monad\nimport System.IO\n\n{-\nThe native-code generator has machine-independent and\nmachine-dependent modules.\n\nThis module (\"AsmCodeGen\") is the top-level machine-independent\nmodule.  Before entering machine-dependent land, we do some\nmachine-independent optimisations (defined below) on the\n'CmmStmts's.\n\nWe convert to the machine-specific 'Instr' datatype with\n'cmmCodeGen', assuming an infinite supply of registers.  We then use\na machine-independent register allocator ('regAlloc') to rejoin\nreality.  Obviously, 'regAlloc' has machine-specific helper\nfunctions (see about \"RegAllocInfo\" below).\n\nFinally, we order the basic blocks of the function so as to minimise\nthe number of jumps between blocks, by utilising fallthrough wherever\npossible.\n\nThe machine-dependent bits break down as follows:\n\n  * [\"MachRegs\"]  Everything about the target platform's machine\n    registers (and immediate operands, and addresses, which tend to\n    intermingle/interact with registers).\n\n  * [\"MachInstrs\"]  Includes the 'Instr' datatype (possibly should\n    have a module of its own), plus a miscellany of other things\n    (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)\n\n  * [\"MachCodeGen\"]  is where 'Cmm' stuff turns into\n    machine instructions.\n\n  * [\"PprMach\"] 'pprInstr' turns an 'Instr' into text (well, really\n    a 'SDoc').\n\n  * [\"RegAllocInfo\"] In the register allocator, we manipulate\n    'MRegsState's, which are 'BitSet's, one bit per machine register.\n    When we want to say something about a specific machine register\n    (e.g., ``it gets clobbered by this instruction''), we set/unset\n    its bit.  Obviously, we do this 'BitSet' thing for efficiency\n    reasons.\n\n    The 'RegAllocInfo' module collects together the machine-specific\n    info needed to do register allocation.\n\n   * [\"RegisterAlloc\"] The (machine-independent) register allocator.\n-}\n\n--------------------\nnativeCodeGen :: DynFlags -> Module -> ModLocation -> Handle -> UniqSupply\n              -> Stream IO RawCmmGroup ()\n              -> IO UniqSupply\nnativeCodeGen dflags this_mod modLoc h us cmms\n = let platform = targetPlatform dflags\n       nCG' :: ( Outputable statics, Outputable instr\n               , Outputable jumpDest, Instruction instr)\n            => NcgImpl statics instr jumpDest -> IO UniqSupply\n       nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms\n   in case platformArch platform of\n      ArchX86       -> nCG' (x86NcgImpl    dflags)\n      ArchX86_64    -> nCG' (x86_64NcgImpl dflags)\n      ArchPPC       -> nCG' (ppcNcgImpl    dflags)\n      ArchSPARC     -> nCG' (sparcNcgImpl  dflags)\n      ArchSPARC64   -> panic \"nativeCodeGen: No NCG for SPARC64\"\n      ArchARM {}    -> panic \"nativeCodeGen: No NCG for ARM\"\n      ArchARM64     -> panic \"nativeCodeGen: No NCG for ARM64\"\n      ArchPPC_64 _  -> nCG' (ppcNcgImpl    dflags)\n      ArchAlpha     -> panic \"nativeCodeGen: No NCG for Alpha\"\n      ArchMipseb    -> panic \"nativeCodeGen: No NCG for mipseb\"\n      ArchMipsel    -> panic \"nativeCodeGen: No NCG for mipsel\"\n      ArchUnknown   -> panic \"nativeCodeGen: No NCG for unknown arch\"\n      ArchJavaScript-> panic \"nativeCodeGen: No NCG for JavaScript\"\n\nx86NcgImpl :: DynFlags -> NcgImpl (Alignment, CmmStatics)\n                                  X86.Instr.Instr X86.Instr.JumpDest\nx86NcgImpl dflags\n = (x86_64NcgImpl dflags) { ncg_x86fp_kludge = map x86fp_kludge }\n\nx86_64NcgImpl :: DynFlags -> NcgImpl (Alignment, CmmStatics)\n                                  X86.Instr.Instr X86.Instr.JumpDest\nx86_64NcgImpl dflags\n = NcgImpl {\n        cmmTopCodeGen             = X86.CodeGen.cmmTopCodeGen\n       ,generateJumpTableForInstr = X86.CodeGen.generateJumpTableForInstr dflags\n       ,getJumpDestBlockId        = X86.Instr.getJumpDestBlockId\n       ,canShortcut               = X86.Instr.canShortcut\n       ,shortcutStatics           = X86.Instr.shortcutStatics\n       ,shortcutJump              = X86.Instr.shortcutJump\n       ,pprNatCmmDecl             = X86.Ppr.pprNatCmmDecl\n       ,maxSpillSlots             = X86.Instr.maxSpillSlots dflags\n       ,allocatableRegs           = X86.Regs.allocatableRegs platform\n       ,ncg_x86fp_kludge          = id\n       ,ncgAllocMoreStack         = X86.Instr.allocMoreStack platform\n       ,ncgExpandTop              = id\n       ,ncgMakeFarBranches        = const id\n       ,extractUnwindPoints       = X86.CodeGen.extractUnwindPoints\n       ,invertCondBranches        = X86.CodeGen.invertCondBranches\n   }\n    where platform = targetPlatform dflags\n\nppcNcgImpl :: DynFlags -> NcgImpl CmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest\nppcNcgImpl dflags\n = NcgImpl {\n        cmmTopCodeGen             = PPC.CodeGen.cmmTopCodeGen\n       ,generateJumpTableForInstr = PPC.CodeGen.generateJumpTableForInstr dflags\n       ,getJumpDestBlockId        = PPC.RegInfo.getJumpDestBlockId\n       ,canShortcut               = PPC.RegInfo.canShortcut\n       ,shortcutStatics           = PPC.RegInfo.shortcutStatics\n       ,shortcutJump              = PPC.RegInfo.shortcutJump\n       ,pprNatCmmDecl             = PPC.Ppr.pprNatCmmDecl\n       ,maxSpillSlots             = PPC.Instr.maxSpillSlots dflags\n       ,allocatableRegs           = PPC.Regs.allocatableRegs platform\n       ,ncg_x86fp_kludge          = id\n       ,ncgAllocMoreStack         = PPC.Instr.allocMoreStack platform\n       ,ncgExpandTop              = id\n       ,ncgMakeFarBranches        = PPC.Instr.makeFarBranches\n       ,extractUnwindPoints       = const []\n       ,invertCondBranches        = \\_ _ -> id\n   }\n    where platform = targetPlatform dflags\n\nsparcNcgImpl :: DynFlags -> NcgImpl CmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest\nsparcNcgImpl dflags\n = NcgImpl {\n        cmmTopCodeGen             = SPARC.CodeGen.cmmTopCodeGen\n       ,generateJumpTableForInstr = SPARC.CodeGen.generateJumpTableForInstr dflags\n       ,getJumpDestBlockId        = SPARC.ShortcutJump.getJumpDestBlockId\n       ,canShortcut               = SPARC.ShortcutJump.canShortcut\n       ,shortcutStatics           = SPARC.ShortcutJump.shortcutStatics\n       ,shortcutJump              = SPARC.ShortcutJump.shortcutJump\n       ,pprNatCmmDecl             = SPARC.Ppr.pprNatCmmDecl\n       ,maxSpillSlots             = SPARC.Instr.maxSpillSlots dflags\n       ,allocatableRegs           = SPARC.Regs.allocatableRegs\n       ,ncg_x86fp_kludge          = id\n       ,ncgAllocMoreStack         = noAllocMoreStack\n       ,ncgExpandTop              = map SPARC.CodeGen.Expand.expandTop\n       ,ncgMakeFarBranches        = const id\n       ,extractUnwindPoints       = const []\n       ,invertCondBranches        = \\_ _ -> id\n   }\n\n--\n-- Allocating more stack space for spilling is currently only\n-- supported for the linear register allocator on x86/x86_64, the rest\n-- default to the panic below.  To support allocating extra stack on\n-- more platforms provide a definition of ncgAllocMoreStack.\n--\nnoAllocMoreStack :: Int -> NatCmmDecl statics instr\n                 -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)])\nnoAllocMoreStack amount _\n  = panic $   \"Register allocator: out of stack slots (need \" ++ show amount ++ \")\\n\"\n        ++  \"   If you are trying to compile SHA1.hs from the crypto library then this\\n\"\n        ++  \"   is a known limitation in the linear allocator.\\n\"\n        ++  \"\\n\"\n        ++  \"   Try enabling the graph colouring allocator with -fregs-graph instead.\"\n        ++  \"   You can still file a bug report if you like.\\n\"\n\n\n-- | Data accumulated during code generation. Mostly about statistics,\n-- but also collects debug data for DWARF generation.\ndata NativeGenAcc statics instr\n  = NGS { ngs_imports     :: ![[CLabel]]\n        , ngs_natives     :: ![[NatCmmDecl statics instr]]\n             -- ^ Native code generated, for statistics. This might\n             -- hold a lot of data, so it is important to clear this\n             -- field as early as possible if it isn't actually\n             -- required.\n        , ngs_colorStats  :: ![[Color.RegAllocStats statics instr]]\n        , ngs_linearStats :: ![[Linear.RegAllocStats]]\n        , ngs_labels      :: ![Label]\n        , ngs_debug       :: ![DebugBlock]\n        , ngs_dwarfFiles  :: !DwarfFiles\n        , ngs_unwinds     :: !(LabelMap [UnwindPoint])\n             -- ^ see Note [Unwinding information in the NCG]\n             -- and Note [What is this unwinding business?] in Debug.\n        }\n\n{-\nNote [Unwinding information in the NCG]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nUnwind information is a type of metadata which allows a debugging tool\nto reconstruct the values of machine registers at the time a procedure was\nentered. For the most part, the production of unwind information is handled by\nthe Cmm stage, where it is represented by CmmUnwind nodes.\n\nUnfortunately, the Cmm stage doesn't know everything necessary to produce\naccurate unwinding information. For instance, the x86-64 calling convention\nrequires that the stack pointer be aligned to 16 bytes, which in turn means that\nGHC must sometimes add padding to $sp prior to performing a foreign call. When\nthis happens unwind information must be updated accordingly.\nFor this reason, we make the NCG backends responsible for producing\nunwinding tables (with the extractUnwindPoints function in NcgImpl).\n\nWe accumulate the produced unwind tables over CmmGroups in the ngs_unwinds\nfield of NativeGenAcc. This is a label map which contains an entry for each\nprocedure, containing a list of unwinding points (e.g. a label and an associated\nunwinding table).\n\nSee also Note [What is this unwinding business?] in Debug.\n-}\n\nnativeCodeGen' :: (Outputable statics, Outputable instr,Outputable jumpDest,\n                   Instruction instr)\n               => DynFlags\n               -> Module -> ModLocation\n               -> NcgImpl statics instr jumpDest\n               -> Handle\n               -> UniqSupply\n               -> Stream IO RawCmmGroup ()\n               -> IO UniqSupply\nnativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms\n = do\n        -- BufHandle is a performance hack.  We could hide it inside\n        -- Pretty if it weren't for the fact that we do lots of little\n        -- printDocs here (in order to do codegen in constant space).\n        bufh <- newBufHandle h\n        let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty\n        (ngs, us') <- cmmNativeGenStream dflags this_mod modLoc ncgImpl bufh us\n                                         cmms ngs0\n        finishNativeGen dflags modLoc bufh us' ngs\n\nfinishNativeGen :: Instruction instr\n                => DynFlags\n                -> ModLocation\n                -> BufHandle\n                -> UniqSupply\n                -> NativeGenAcc statics instr\n                -> IO UniqSupply\nfinishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs\n = do\n        -- Write debug data and finish\n        let emitDw = debugLevel dflags > 0\n        us' <- if not emitDw then return us else do\n          (dwarf, us') <- dwarfGen dflags modLoc us (ngs_debug ngs)\n          emitNativeCode dflags bufh dwarf\n          return us'\n        bFlush bufh\n\n        -- dump global NCG stats for graph coloring allocator\n        let stats = concat (ngs_colorStats ngs)\n        when (not (null stats)) $ do\n\n          -- build the global register conflict graph\n          let graphGlobal\n                  = foldl' Color.union Color.initGraph\n                  $ [ Color.raGraph stat\n                          | stat@Color.RegAllocStatsStart{} <- stats]\n\n          dump_stats (Color.pprStats stats graphGlobal)\n\n          let platform = targetPlatform dflags\n          dumpIfSet_dyn dflags\n                  Opt_D_dump_asm_conflicts \"Register conflict graph\"\n                  $ Color.dotGraph\n                          (targetRegDotColor platform)\n                          (Color.trivColorable platform\n                                  (targetVirtualRegSqueeze platform)\n                                  (targetRealRegSqueeze platform))\n                  $ graphGlobal\n\n\n        -- dump global NCG stats for linear allocator\n        let linearStats = concat (ngs_linearStats ngs)\n        when (not (null linearStats)) $\n          dump_stats (Linear.pprStats (concat (ngs_natives ngs)) linearStats)\n\n        -- write out the imports\n        printSDocLn Pretty.LeftMode dflags h (mkCodeStyle AsmStyle)\n                $ makeImportsDoc dflags (concat (ngs_imports ngs))\n        return us'\n  where\n    dump_stats = dumpSDoc dflags alwaysQualify Opt_D_dump_asm_stats \"NCG stats\"\n\ncmmNativeGenStream :: (Outputable statics, Outputable instr\n                      ,Outputable jumpDest, Instruction instr)\n              => DynFlags\n              -> Module -> ModLocation\n              -> NcgImpl statics instr jumpDest\n              -> BufHandle\n              -> UniqSupply\n              -> Stream IO RawCmmGroup ()\n              -> NativeGenAcc statics instr\n              -> IO (NativeGenAcc statics instr, UniqSupply)\n\ncmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs\n = do r <- Stream.runStream cmm_stream\n      case r of\n        Left () ->\n          return (ngs { ngs_imports = reverse $ ngs_imports ngs\n                      , ngs_natives = reverse $ ngs_natives ngs\n                      , ngs_colorStats = reverse $ ngs_colorStats ngs\n                      , ngs_linearStats = reverse $ ngs_linearStats ngs\n                      },\n                  us)\n        Right (cmms, cmm_stream') -> do\n\n          -- Generate debug information\n          let debugFlag = debugLevel dflags > 0\n              !ndbgs | debugFlag = cmmDebugGen modLoc cmms\n                     | otherwise = []\n              dbgMap = debugToMap ndbgs\n\n          -- Generate native code\n          (ngs',us') <- cmmNativeGens dflags this_mod modLoc ncgImpl h\n                                             dbgMap us cmms ngs 0\n\n          -- Link native code information into debug blocks\n          -- See Note [What is this unwinding business?] in Debug.\n          let !ldbgs = cmmDebugLink (ngs_labels ngs') (ngs_unwinds ngs') ndbgs\n          dumpIfSet_dyn dflags Opt_D_dump_debug \"Debug Infos\"\n            (vcat $ map ppr ldbgs)\n\n          -- Accumulate debug information for emission in finishNativeGen.\n          let ngs'' = ngs' { ngs_debug = ngs_debug ngs' ++ ldbgs, ngs_labels = [] }\n\n          cmmNativeGenStream dflags this_mod modLoc ncgImpl h us'\n              cmm_stream' ngs''\n\n-- | Do native code generation on all these cmms.\n--\ncmmNativeGens :: forall statics instr jumpDest.\n                 (Outputable statics, Outputable instr\n                 ,Outputable jumpDest, Instruction instr)\n              => DynFlags\n              -> Module -> ModLocation\n              -> NcgImpl statics instr jumpDest\n              -> BufHandle\n              -> LabelMap DebugBlock\n              -> UniqSupply\n              -> [RawCmmDecl]\n              -> NativeGenAcc statics instr\n              -> Int\n              -> IO (NativeGenAcc statics instr, UniqSupply)\n\ncmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go\n  where\n    go :: UniqSupply -> [RawCmmDecl]\n       -> NativeGenAcc statics instr -> Int\n       -> IO (NativeGenAcc statics instr, UniqSupply)\n\n    go us [] ngs !_ =\n        return (ngs, us)\n\n    go us (cmm : cmms) ngs count = do\n        let fileIds = ngs_dwarfFiles ngs\n        (us', fileIds', native, imports, colorStats, linearStats, unwinds)\n          <- {-# SCC \"cmmNativeGen\" #-}\n             cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap\n                          cmm count\n\n        -- Generate .file directives for every new file that has been\n        -- used. Note that it is important that we generate these in\n        -- ascending order, as Clang's 3.6 assembler complains.\n        let newFileIds = sortBy (comparing snd) $\n                         nonDetEltsUFM $ fileIds' `minusUFM` fileIds\n            -- See Note [Unique Determinism and code generation]\n            pprDecl (f,n) = text \"\\t.file \" <> ppr n <+>\n                            doubleQuotes (ftext f)\n\n        emitNativeCode dflags h $ vcat $\n          map pprDecl newFileIds ++\n          map (pprNatCmmDecl ncgImpl) native\n\n        -- force evaluation all this stuff to avoid space leaks\n        {-# SCC \"seqString\" #-} evaluate $ seqString (showSDoc dflags $ vcat $ map ppr imports)\n\n        let !labels' = if debugLevel dflags > 0\n                       then cmmDebugLabels isMetaInstr native else []\n            !natives' = if dopt Opt_D_dump_asm_stats dflags\n                        then native : ngs_natives ngs else []\n\n            mCon = maybe id (:)\n            ngs' = ngs{ ngs_imports     = imports : ngs_imports ngs\n                      , ngs_natives     = natives'\n                      , ngs_colorStats  = colorStats `mCon` ngs_colorStats ngs\n                      , ngs_linearStats = linearStats `mCon` ngs_linearStats ngs\n                      , ngs_labels      = ngs_labels ngs ++ labels'\n                      , ngs_dwarfFiles  = fileIds'\n                      , ngs_unwinds     = ngs_unwinds ngs `mapUnion` unwinds\n                      }\n        go us' cmms ngs' (count + 1)\n\n    seqString []            = ()\n    seqString (x:xs)        = x `seq` seqString xs\n\n\nemitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO ()\nemitNativeCode dflags h sdoc = do\n\n        {-# SCC \"pprNativeCode\" #-} bufLeftRenderSDoc dflags h\n                                      (mkCodeStyle AsmStyle) sdoc\n\n        -- dump native code\n        dumpIfSet_dyn dflags\n                Opt_D_dump_asm \"Asm code\"\n                sdoc\n\n-- | Complete native code generation phase for a single top-level chunk of Cmm.\n--      Dumping the output of each stage along the way.\n--      Global conflict graph and NGC stats\ncmmNativeGen\n    :: forall statics instr jumpDest. (Instruction instr,\n        Outputable statics, Outputable instr, Outputable jumpDest)\n    => DynFlags\n    -> Module -> ModLocation\n    -> NcgImpl statics instr jumpDest\n        -> UniqSupply\n        -> DwarfFiles\n        -> LabelMap DebugBlock\n        -> RawCmmDecl                                   -- ^ the cmm to generate code for\n        -> Int                                          -- ^ sequence number of this top thing\n        -> IO   ( UniqSupply\n                , DwarfFiles\n                , [NatCmmDecl statics instr]                -- native code\n                , [CLabel]                                  -- things imported by this cmm\n                , Maybe [Color.RegAllocStats statics instr] -- stats for the coloring register allocator\n                , Maybe [Linear.RegAllocStats]              -- stats for the linear register allocators\n                , LabelMap [UnwindPoint]                    -- unwinding information for blocks\n                )\n\ncmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count\n = do\n        let platform = targetPlatform dflags\n\n        -- rewrite assignments to global regs\n        let fixed_cmm =\n                {-# SCC \"fixStgRegisters\" #-}\n                fixStgRegisters dflags cmm\n\n        -- cmm to cmm optimisations\n        let (opt_cmm, imports) =\n                {-# SCC \"cmmToCmm\" #-}\n                cmmToCmm dflags this_mod fixed_cmm\n\n        dumpIfSet_dyn dflags\n                Opt_D_dump_opt_cmm \"Optimised Cmm\"\n                (pprCmmGroup [opt_cmm])\n\n        let cmmCfg = {-# SCC \"getCFG\" #-}\n                     getCfgProc (cfgWeightInfo dflags) opt_cmm\n\n        -- generate native code from cmm\n        let ((native, lastMinuteImports, fileIds', nativeCfgWeights), usGen) =\n                {-# SCC \"genMachCode\" #-}\n                initUs us $ genMachCode dflags this_mod modLoc\n                                        (cmmTopCodeGen ncgImpl)\n                                        fileIds dbgMap opt_cmm cmmCfg\n\n\n        dumpIfSet_dyn dflags\n                Opt_D_dump_asm_native \"Native code\"\n                (vcat $ map (pprNatCmmDecl ncgImpl) native)\n\n        dumpIfSet_dyn dflags\n                Opt_D_dump_cfg_weights \"CFG Weights\"\n                (pprEdgeWeights nativeCfgWeights)\n\n        -- tag instructions with register liveness information\n        -- also drops dead code\n        let livenessCfg = if (backendMaintainsCfg dflags)\n                                then Just nativeCfgWeights\n                                else Nothing\n        let (withLiveness, usLive) =\n                {-# SCC \"regLiveness\" #-}\n                initUs usGen\n                        $ mapM (cmmTopLiveness livenessCfg platform) native\n\n        dumpIfSet_dyn dflags\n                Opt_D_dump_asm_liveness \"Liveness annotations added\"\n                (vcat $ map ppr withLiveness)\n\n        -- allocate registers\n        (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear, raStats, stack_updt_blks) <-\n         if ( gopt Opt_RegsGraph dflags\n           || gopt Opt_RegsIterative dflags )\n          then do\n                -- the regs usable for allocation\n                let (alloc_regs :: UniqFM (UniqSet RealReg))\n                        = foldr (\\r -> plusUFM_C unionUniqSets\n                                        $ unitUFM (targetClassOfRealReg platform r) (unitUniqSet r))\n                                emptyUFM\n                        $ allocatableRegs ncgImpl\n\n                -- do the graph coloring register allocation\n                let ((alloced, maybe_more_stack, regAllocStats), usAlloc)\n                        = {-# SCC \"RegAlloc-color\" #-}\n                          initUs usLive\n                          $ Color.regAlloc\n                                dflags\n                                alloc_regs\n                                (mkUniqSet [0 .. maxSpillSlots ncgImpl])\n                                (maxSpillSlots ncgImpl)\n                                withLiveness\n                                livenessCfg\n\n                let ((alloced', stack_updt_blks), usAlloc')\n                        = initUs usAlloc $\n                                case maybe_more_stack of\n                                Nothing     -> return (alloced, [])\n                                Just amount -> do\n                                    (alloced',stack_updt_blks) <- unzip <$>\n                                                (mapM ((ncgAllocMoreStack ncgImpl) amount) alloced)\n                                    return (alloced', concat stack_updt_blks )\n\n\n                -- dump out what happened during register allocation\n                dumpIfSet_dyn dflags\n                        Opt_D_dump_asm_regalloc \"Registers allocated\"\n                        (vcat $ map (pprNatCmmDecl ncgImpl) alloced)\n\n                dumpIfSet_dyn dflags\n                        Opt_D_dump_asm_regalloc_stages \"Build/spill stages\"\n                        (vcat   $ map (\\(stage, stats)\n                                        -> text \"# --------------------------\"\n                                        $$ text \"#  cmm \" <> int count <> text \" Stage \" <> int stage\n                                        $$ ppr stats)\n                                $ zip [0..] regAllocStats)\n\n                let mPprStats =\n                        if dopt Opt_D_dump_asm_stats dflags\n                         then Just regAllocStats else Nothing\n\n                -- force evaluation of the Maybe to avoid space leak\n                mPprStats `seq` return ()\n\n                return  ( alloced', usAlloc'\n                        , mPprStats\n                        , Nothing\n                        , [], stack_updt_blks)\n\n          else do\n                -- do linear register allocation\n                let reg_alloc proc = do\n                       (alloced, maybe_more_stack, ra_stats) <-\n                               Linear.regAlloc dflags proc\n                       case maybe_more_stack of\n                         Nothing -> return ( alloced, ra_stats, [] )\n                         Just amount -> do\n                           (alloced',stack_updt_blks) <-\n                               ncgAllocMoreStack ncgImpl amount alloced\n                           return (alloced', ra_stats, stack_updt_blks )\n\n                let ((alloced, regAllocStats, stack_updt_blks), usAlloc)\n                        = {-# SCC \"RegAlloc-linear\" #-}\n                          initUs usLive\n                          $ liftM unzip3\n                          $ mapM reg_alloc withLiveness\n\n                dumpIfSet_dyn dflags\n                        Opt_D_dump_asm_regalloc \"Registers allocated\"\n                        (vcat $ map (pprNatCmmDecl ncgImpl) alloced)\n\n                let mPprStats =\n                        if dopt Opt_D_dump_asm_stats dflags\n                         then Just (catMaybes regAllocStats) else Nothing\n\n                -- force evaluation of the Maybe to avoid space leak\n                mPprStats `seq` return ()\n\n                return  ( alloced, usAlloc\n                        , Nothing\n                        , mPprStats, (catMaybes regAllocStats)\n                        , concat stack_updt_blks )\n\n        -- Fixupblocks the register allocator inserted (from, regMoves, to)\n        let cfgRegAllocUpdates :: [(BlockId,BlockId,BlockId)]\n            cfgRegAllocUpdates = (concatMap Linear.ra_fixupList raStats)\n\n        let cfgWithFixupBlks =\n                addNodesBetween nativeCfgWeights cfgRegAllocUpdates\n\n        -- Insert stack update blocks\n        let postRegCFG =\n                foldl' (\\m (from,to) -> addImmediateSuccessor from to m )\n                       cfgWithFixupBlks stack_updt_blks\n\n        ---- x86fp_kludge.  This pass inserts ffree instructions to clear\n        ---- the FPU stack on x86.  The x86 ABI requires that the FPU stack\n        ---- is clear, and library functions can return odd results if it\n        ---- isn't.\n        ----\n        ---- NB. must happen before shortcutBranches, because that\n        ---- generates JXX_GBLs which we can't fix up in x86fp_kludge.\n        let kludged = {-# SCC \"x86fp_kludge\" #-} ncg_x86fp_kludge ncgImpl alloced\n\n        ---- generate jump tables\n        let tabled      =\n                {-# SCC \"generateJumpTables\" #-}\n                generateJumpTables ncgImpl kludged\n\n        dumpIfSet_dyn dflags\n                Opt_D_dump_cfg_weights \"CFG Update information\"\n                ( text \"stack:\" <+> ppr stack_updt_blks $$\n                  text \"linearAlloc:\" <+> ppr cfgRegAllocUpdates )\n\n        ---- shortcut branches\n        let (shorted, postShortCFG)     =\n                {-# SCC \"shortcutBranches\" #-}\n                shortcutBranches dflags ncgImpl tabled postRegCFG\n\n        let optimizedCFG =\n                optimizeCFG (cfgWeightInfo dflags) cmm postShortCFG\n\n        dumpIfSet_dyn dflags\n                Opt_D_dump_cfg_weights \"CFG Final Weights\"\n                ( pprEdgeWeights optimizedCFG )\n\n        --TODO: Partially check validity of the cfg.\n        let getBlks (CmmProc _info _lbl _live (ListGraph blocks)) = blocks\n            getBlks _ = []\n\n        when ( backendMaintainsCfg dflags &&\n                (gopt Opt_DoAsmLinting dflags || debugIsOn )) $ do\n                let blocks = concatMap getBlks shorted\n                let labels = setFromList $ fmap blockId blocks :: LabelSet\n                return $! seq (sanityCheckCfg optimizedCFG labels $\n                                text \"cfg not in lockstep\") ()\n\n        ---- sequence blocks\n        let sequenced :: [NatCmmDecl statics instr]\n            sequenced =\n                checkLayout shorted $\n                {-# SCC \"sequenceBlocks\" #-}\n                map (BlockLayout.sequenceTop\n                        dflags\n                        ncgImpl optimizedCFG)\n                    shorted\n\n        let branchOpt :: [NatCmmDecl statics instr]\n            branchOpt =\n                {-# SCC \"invertCondBranches\" #-}\n                map invert sequenced\n              where\n                invertConds = (invertCondBranches ncgImpl) optimizedCFG\n                invert top@CmmData {} = top\n                invert (CmmProc info lbl live (ListGraph blocks)) =\n                    CmmProc info lbl live (ListGraph $ invertConds info blocks)\n\n        ---- expansion of SPARC synthetic instrs\n        let expanded =\n                {-# SCC \"sparc_expand\" #-}\n                ncgExpandTop ncgImpl branchOpt\n                --ncgExpandTop ncgImpl sequenced\n\n        dumpIfSet_dyn dflags\n                Opt_D_dump_asm_expanded \"Synthetic instructions expanded\"\n                (vcat $ map (pprNatCmmDecl ncgImpl) expanded)\n\n        -- generate unwinding information from cmm\n        let unwinds :: BlockMap [UnwindPoint]\n            unwinds =\n                {-# SCC \"unwindingInfo\" #-}\n                foldl' addUnwind mapEmpty expanded\n              where\n                addUnwind acc proc =\n                    acc `mapUnion` computeUnwinding dflags ncgImpl proc\n\n        return  ( usAlloc\n                , fileIds'\n                , expanded\n                , lastMinuteImports ++ imports\n                , ppr_raStatsColor\n                , ppr_raStatsLinear\n                , unwinds )\n\n-- | Make sure all blocks we want the layout algorithm to place have been placed.\ncheckLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]\n            -> [NatCmmDecl statics instr]\ncheckLayout procsUnsequenced procsSequenced =\n        ASSERT2(setNull diff,\n                ppr \"Block sequencing dropped blocks:\" <> ppr diff)\n        procsSequenced\n  where\n        blocks1 = foldl' (setUnion) setEmpty $\n                        map getBlockIds procsUnsequenced :: LabelSet\n        blocks2 = foldl' (setUnion) setEmpty $\n                        map getBlockIds procsSequenced\n        diff = setDifference blocks1 blocks2\n\n        getBlockIds (CmmData _ _) = setEmpty\n        getBlockIds (CmmProc _ _ _ (ListGraph blocks)) =\n                setFromList $ map blockId blocks\n\n\nx86fp_kludge :: NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr -> NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr\nx86fp_kludge top@(CmmData _ _) = top\nx86fp_kludge (CmmProc info lbl live (ListGraph code)) =\n        CmmProc info lbl live (ListGraph $ X86.Instr.i386_insert_ffrees code)\n\n-- | Compute unwinding tables for the blocks of a procedure\ncomputeUnwinding :: Instruction instr\n                 => DynFlags -> NcgImpl statics instr jumpDest\n                 -> NatCmmDecl statics instr\n                    -- ^ the native code generated for the procedure\n                 -> LabelMap [UnwindPoint]\n                    -- ^ unwinding tables for all points of all blocks of the\n                    -- procedure\ncomputeUnwinding dflags _ _\n  | debugLevel dflags == 0         = mapEmpty\ncomputeUnwinding _ _ (CmmData _ _) = mapEmpty\ncomputeUnwinding _ ncgImpl (CmmProc _ _ _ (ListGraph blks)) =\n    -- In general we would need to push unwinding information down the\n    -- block-level call-graph to ensure that we fully account for all\n    -- relevant register writes within a procedure.\n    --\n    -- However, the only unwinding information that we care about in GHC is for\n    -- Sp. The fact that CmmLayoutStack already ensures that we have unwind\n    -- information at the beginning of every block means that there is no need\n    -- to perform this sort of push-down.\n    mapFromList [ (blk_lbl, extractUnwindPoints ncgImpl instrs)\n                | BasicBlock blk_lbl instrs <- blks ]\n\n-- | Build a doc for all the imports.\n--\nmakeImportsDoc :: DynFlags -> [CLabel] -> SDoc\nmakeImportsDoc dflags imports\n = dyld_stubs imports\n            $$\n            -- On recent versions of Darwin, the linker supports\n            -- dead-stripping of code and data on a per-symbol basis.\n            -- There's a hack to make this work in PprMach.pprNatCmmDecl.\n            (if platformHasSubsectionsViaSymbols platform\n             then text \".subsections_via_symbols\"\n             else Outputable.empty)\n            $$\n                -- On recent GNU ELF systems one can mark an object file\n                -- as not requiring an executable stack. If all objects\n                -- linked into a program have this note then the program\n                -- will not use an executable stack, which is good for\n                -- security. GHC generated code does not need an executable\n                -- stack so add the note in:\n            (if platformHasGnuNonexecStack platform\n             then text \".section .note.GNU-stack,\\\"\\\",\" <> sectionType \"progbits\"\n             else Outputable.empty)\n            $$\n                -- And just because every other compiler does, let's stick in\n                -- an identifier directive: .ident \"GHC x.y.z\"\n            (if platformHasIdentDirective platform\n             then let compilerIdent = text \"GHC\" <+> text cProjectVersion\n                   in text \".ident\" <+> doubleQuotes compilerIdent\n             else Outputable.empty)\n\n where\n        platform = targetPlatform dflags\n        arch = platformArch platform\n        os   = platformOS   platform\n\n        -- Generate \"symbol stubs\" for all external symbols that might\n        -- come from a dynamic library.\n        dyld_stubs :: [CLabel] -> SDoc\n{-      dyld_stubs imps = vcat $ map pprDyldSymbolStub $\n                                    map head $ group $ sort imps-}\n        -- (Hack) sometimes two Labels pretty-print the same, but have\n        -- different uniques; so we compare their text versions...\n        dyld_stubs imps\n                | needImportedSymbols dflags arch os\n                = vcat $\n                        (pprGotDeclaration dflags arch os :) $\n                        map ( pprImportedSymbol dflags platform . fst . head) $\n                        groupBy (\\(_,a) (_,b) -> a == b) $\n                        sortBy (\\(_,a) (_,b) -> compare a b) $\n                        map doPpr $\n                        imps\n                | otherwise\n                = Outputable.empty\n\n        doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel platform lbl) astyle)\n        astyle = mkCodeStyle AsmStyle\n\n-- -----------------------------------------------------------------------------\n-- Generate jump tables\n\n-- Analyzes all native code and generates data sections for all jump\n-- table instructions.\ngenerateJumpTables\n        :: NcgImpl statics instr jumpDest\n        -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]\ngenerateJumpTables ncgImpl xs = concatMap f xs\n    where f p@(CmmProc _ _ _ (ListGraph xs)) = p : concatMap g xs\n          f p = [p]\n          g (BasicBlock _ xs) = catMaybes (map (generateJumpTableForInstr ncgImpl) xs)\n\n-- -----------------------------------------------------------------------------\n-- Shortcut branches\n\nshortcutBranches\n        :: forall statics instr jumpDest. (Outputable jumpDest) => DynFlags\n        -> NcgImpl statics instr jumpDest\n        -> [NatCmmDecl statics instr]\n        -> CFG\n        -> ([NatCmmDecl statics instr],CFG)\n\nshortcutBranches dflags ncgImpl tops weights\n  | gopt Opt_AsmShortcutting dflags\n  = ( map (apply_mapping ncgImpl mapping) tops'\n    , shortcutWeightMap weights mappingBid )\n  | otherwise\n  = (tops, weights)\n  where\n    (tops', mappings) = mapAndUnzip (build_mapping ncgImpl) tops\n    mapping = mapUnions mappings :: LabelMap jumpDest\n    mappingBid = fmap (getJumpDestBlockId ncgImpl) mapping\n\nbuild_mapping :: forall instr t d statics jumpDest.\n                 NcgImpl statics instr jumpDest\n              -> GenCmmDecl d (LabelMap t) (ListGraph instr)\n              -> (GenCmmDecl d (LabelMap t) (ListGraph instr)\n                 ,LabelMap jumpDest)\nbuild_mapping _ top@(CmmData _ _) = (top, mapEmpty)\nbuild_mapping _ (CmmProc info lbl live (ListGraph []))\n  = (CmmProc info lbl live (ListGraph []), mapEmpty)\nbuild_mapping ncgImpl (CmmProc info lbl live (ListGraph (head:blocks)))\n  = (CmmProc info lbl live (ListGraph (head:others)), mapping)\n        -- drop the shorted blocks, but don't ever drop the first one,\n        -- because it is pointed to by a global label.\n  where\n    -- find all the blocks that just consist of a jump that can be\n    -- shorted.\n    -- Don't completely eliminate loops here -- that can leave a dangling jump!\n    shortcut_blocks :: [(BlockId, jumpDest)]\n    (_, shortcut_blocks, others) =\n        foldl' split (setEmpty :: LabelSet, [], []) blocks\n    split (s, shortcut_blocks, others) b@(BasicBlock id [insn])\n        | Just jd <- canShortcut ncgImpl insn\n        , Just dest <- getJumpDestBlockId ncgImpl jd\n        , not (has_info id)\n        , (setMember dest s) || dest == id -- loop checks\n        = (s, shortcut_blocks, b : others)\n    split (s, shortcut_blocks, others) (BasicBlock id [insn])\n        | Just dest <- canShortcut ncgImpl insn\n        , not (has_info id)\n        = (setInsert id s, (id,dest) : shortcut_blocks, others)\n    split (s, shortcut_blocks, others) other = (s, shortcut_blocks, other : others)\n\n    -- do not eliminate blocks that have an info table\n    has_info l = mapMember l info\n\n    -- build a mapping from BlockId to JumpDest for shorting branches\n    mapping = mapFromList shortcut_blocks\n\napply_mapping :: NcgImpl statics instr jumpDest\n              -> LabelMap jumpDest\n              -> GenCmmDecl statics h (ListGraph instr)\n              -> GenCmmDecl statics h (ListGraph instr)\napply_mapping ncgImpl ufm (CmmData sec statics)\n  = CmmData sec (shortcutStatics ncgImpl (\\bid -> mapLookup bid ufm) statics)\napply_mapping ncgImpl ufm (CmmProc info lbl live (ListGraph blocks))\n  = CmmProc info lbl live (ListGraph $ map short_bb blocks)\n  where\n    short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns\n    short_insn i = shortcutJump ncgImpl (\\bid -> mapLookup bid ufm) i\n                 -- shortcutJump should apply the mapping repeatedly,\n                 -- just in case we can short multiple branches.\n\n-- -----------------------------------------------------------------------------\n-- Instruction selection\n\n-- Native code instruction selection for a chunk of stix code.  For\n-- this part of the computation, we switch from the UniqSM monad to\n-- the NatM monad.  The latter carries not only a Unique, but also an\n-- Int denoting the current C stack pointer offset in the generated\n-- code; this is needed for creating correct spill offsets on\n-- architectures which don't offer, or for which it would be\n-- prohibitively expensive to employ, a frame pointer register.  Viz,\n-- x86.\n\n-- The offset is measured in bytes, and indicates the difference\n-- between the current (simulated) C stack-ptr and the value it was at\n-- the beginning of the block.  For stacks which grow down, this value\n-- should be either zero or negative.\n\n-- Along with the stack pointer offset, we also carry along a LabelMap of\n-- DebugBlocks, which we read to generate .location directives.\n--\n-- Switching between the two monads whilst carrying along the same\n-- Unique supply breaks abstraction.  Is that bad?\n\ngenMachCode\n        :: DynFlags\n        -> Module -> ModLocation\n        -> (RawCmmDecl -> NatM [NatCmmDecl statics instr])\n        -> DwarfFiles\n        -> LabelMap DebugBlock\n        -> RawCmmDecl\n        -> CFG\n        -> UniqSM\n                ( [NatCmmDecl statics instr]\n                , [CLabel]\n                , DwarfFiles\n                , CFG\n                )\n\ngenMachCode dflags this_mod modLoc cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg\n  = do  { initial_us <- getUniqueSupplyM\n        ; let initial_st           = mkNatM_State initial_us 0 dflags this_mod\n                                                  modLoc fileIds dbgMap cmm_cfg\n              (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)\n              final_delta          = natm_delta final_st\n              final_imports        = natm_imports final_st\n              final_cfg            = natm_cfg final_st\n        ; if   final_delta == 0\n          then return (new_tops, final_imports\n                      , natm_fileid final_st, final_cfg)\n          else pprPanic \"genMachCode: nonzero final delta\" (int final_delta)\n    }\n\n-- -----------------------------------------------------------------------------\n-- Generic Cmm optimiser\n\n{-\nHere we do:\n\n  (a) Constant folding\n  (c) Position independent code and dynamic linking\n        (i)  introduce the appropriate indirections\n             and position independent refs\n        (ii) compile a list of imported symbols\n  (d) Some arch-specific optimizations\n\n(a) will be moving to the new Hoopl pipeline, however, (c) and\n(d) are only needed by the native backend and will continue to live\nhere.\n\nIdeas for other things we could do (put these in Hoopl please!):\n\n  - shortcut jumps-to-jumps\n  - simple CSE: if an expr is assigned to a temp, then replace later occs of\n    that expr with the temp, until the expr is no longer valid (can push through\n    temp assignments, and certain assigns to mem...)\n-}\n\ncmmToCmm :: DynFlags -> Module -> RawCmmDecl -> (RawCmmDecl, [CLabel])\ncmmToCmm _ _ top@(CmmData _ _) = (top, [])\ncmmToCmm dflags this_mod (CmmProc info lbl live graph)\n    = runCmmOpt dflags this_mod $\n      do blocks' <- mapM cmmBlockConFold (toBlockList graph)\n         return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks')\n\nnewtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> (# a, [CLabel] #))\n\ninstance Functor CmmOptM where\n    fmap = liftM\n\ninstance Applicative CmmOptM where\n    pure x = CmmOptM $ \\_ _ imports -> (# x, imports #)\n    (<*>) = ap\n\ninstance Monad CmmOptM where\n  (CmmOptM f) >>= g =\n    CmmOptM $ \\dflags this_mod imports ->\n                case f dflags this_mod imports of\n                  (# x, imports' #) ->\n                    case g x of\n                      CmmOptM g' -> g' dflags this_mod imports'\n\ninstance CmmMakeDynamicReferenceM CmmOptM where\n    addImport = addImportCmmOpt\n    getThisModule = CmmOptM $ \\_ this_mod imports -> (# this_mod, imports #)\n\naddImportCmmOpt :: CLabel -> CmmOptM ()\naddImportCmmOpt lbl = CmmOptM $ \\_ _ imports -> (# (), lbl:imports #)\n\ninstance HasDynFlags CmmOptM where\n    getDynFlags = CmmOptM $ \\dflags _ imports -> (# dflags, imports #)\n\nrunCmmOpt :: DynFlags -> Module -> CmmOptM a -> (a, [CLabel])\nrunCmmOpt dflags this_mod (CmmOptM f) = case f dflags this_mod [] of\n                        (# result, imports #) -> (result, imports)\n\ncmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock\ncmmBlockConFold block = do\n  let (entry, middle, last) = blockSplit block\n      stmts = blockToList middle\n  stmts' <- mapM cmmStmtConFold stmts\n  last' <- cmmStmtConFold last\n  return $ blockJoin entry (blockFromList stmts') last'\n\n-- This does three optimizations, but they're very quick to check, so we don't\n-- bother turning them off even when the Hoopl code is active.  Since\n-- this is on the old Cmm representation, we can't reuse the code either:\n--  * reg = reg      --> nop\n--  * if 0 then jump --> nop\n--  * if 1 then jump --> jump\n-- We might be tempted to skip this step entirely of not Opt_PIC, but\n-- there is some PowerPC code for the non-PIC case, which would also\n-- have to be separated.\ncmmStmtConFold :: CmmNode e x -> CmmOptM (CmmNode e x)\ncmmStmtConFold stmt\n   = case stmt of\n        CmmAssign reg src\n           -> do src' <- cmmExprConFold DataReference src\n                 return $ case src' of\n                   CmmReg reg' | reg == reg' -> CmmComment (fsLit \"nop\")\n                   new_src -> CmmAssign reg new_src\n\n        CmmStore addr src\n           -> do addr' <- cmmExprConFold DataReference addr\n                 src'  <- cmmExprConFold DataReference src\n                 return $ CmmStore addr' src'\n\n        CmmCall { cml_target = addr }\n           -> do addr' <- cmmExprConFold JumpReference addr\n                 return $ stmt { cml_target = addr' }\n\n        CmmUnsafeForeignCall target regs args\n           -> do target' <- case target of\n                              ForeignTarget e conv -> do\n                                e' <- cmmExprConFold CallReference e\n                                return $ ForeignTarget e' conv\n                              PrimTarget _ ->\n                                return target\n                 args' <- mapM (cmmExprConFold DataReference) args\n                 return $ CmmUnsafeForeignCall target' regs args'\n\n        CmmCondBranch test true false likely\n           -> do test' <- cmmExprConFold DataReference test\n                 return $ case test' of\n                   CmmLit (CmmInt 0 _) -> CmmBranch false\n                   CmmLit (CmmInt _ _) -> CmmBranch true\n                   _other -> CmmCondBranch test' true false likely\n\n        CmmSwitch expr ids\n           -> do expr' <- cmmExprConFold DataReference expr\n                 return $ CmmSwitch expr' ids\n\n        other\n           -> return other\n\ncmmExprConFold :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr\ncmmExprConFold referenceKind expr = do\n    dflags <- getDynFlags\n\n    -- With -O1 and greater, the cmmSink pass does constant-folding, so\n    -- we don't need to do it again here.\n    let expr' = if optLevel dflags >= 1\n                    then expr\n                    else cmmExprCon dflags expr\n\n    cmmExprNative referenceKind expr'\n\ncmmExprCon :: DynFlags -> CmmExpr -> CmmExpr\ncmmExprCon dflags (CmmLoad addr rep) = CmmLoad (cmmExprCon dflags addr) rep\ncmmExprCon dflags (CmmMachOp mop args)\n    = cmmMachOpFold dflags mop (map (cmmExprCon dflags) args)\ncmmExprCon _ other = other\n\n-- handles both PIC and non-PIC cases... a very strange mixture\n-- of things to do.\ncmmExprNative :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr\ncmmExprNative referenceKind expr = do\n     dflags <- getDynFlags\n     let platform = targetPlatform dflags\n         arch = platformArch platform\n     case expr of\n        CmmLoad addr rep\n           -> do addr' <- cmmExprNative DataReference addr\n                 return $ CmmLoad addr' rep\n\n        CmmMachOp mop args\n           -> do args' <- mapM (cmmExprNative DataReference) args\n                 return $ CmmMachOp mop args'\n\n        CmmLit (CmmBlock id)\n           -> cmmExprNative referenceKind (CmmLit (CmmLabel (infoTblLbl id)))\n           -- we must convert block Ids to CLabels here, because we\n           -- might have to do the PIC transformation.  Hence we must\n           -- not modify BlockIds beyond this point.\n\n        CmmLit (CmmLabel lbl)\n           -> do\n                cmmMakeDynamicReference dflags referenceKind lbl\n        CmmLit (CmmLabelOff lbl off)\n           -> do\n                 dynRef <- cmmMakeDynamicReference dflags referenceKind lbl\n                 -- need to optimize here, since it's late\n                 return $ cmmMachOpFold dflags (MO_Add (wordWidth dflags)) [\n                     dynRef,\n                     (CmmLit $ CmmInt (fromIntegral off) (wordWidth dflags))\n                   ]\n\n        -- On powerpc (non-PIC), it's easier to jump directly to a label than\n        -- to use the register table, so we replace these registers\n        -- with the corresponding labels:\n        CmmReg (CmmGlobal EagerBlackholeInfo)\n          | arch == ArchPPC && not (positionIndependent dflags)\n          -> cmmExprNative referenceKind $\n             CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit \"__stg_EAGER_BLACKHOLE_info\")))\n        CmmReg (CmmGlobal GCEnter1)\n          | arch == ArchPPC && not (positionIndependent dflags)\n          -> cmmExprNative referenceKind $\n             CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit \"__stg_gc_enter_1\")))\n        CmmReg (CmmGlobal GCFun)\n          | arch == ArchPPC && not (positionIndependent dflags)\n          -> cmmExprNative referenceKind $\n             CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit \"__stg_gc_fun\")))\n\n        other\n           -> return other\n", "num_lines": 1205}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Copyright (c) 2018 Andreas Klebinger\n--\n\n{-# LANGUAGE TypeFamilies, ScopedTypeVariables, CPP #-}\n\n{-# OPTIONS_GHC -fprof-auto #-}\n--{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -ddump-cmm #-}\n\nmodule BlockLayout\n    ( sequenceTop )\nwhere\n\n#include \"HsVersions.h\"\nimport GhcPrelude\n\nimport Instruction\nimport NCGMonad\nimport CFG\n\nimport BlockId\nimport Cmm\nimport Hoopl.Collections\nimport Hoopl.Label\nimport Hoopl.Block\n\nimport DynFlags (gopt, GeneralFlag(..), DynFlags, backendMaintainsCfg)\nimport UniqFM\nimport Util\nimport Unique\n\nimport Digraph\nimport Outputable\nimport Maybes\n\n-- DEBUGGING ONLY\n--import Debug\n--import Debug.Trace\nimport ListSetOps (removeDups)\nimport PprCmm ()\n\nimport OrdList\nimport Data.List\nimport Data.Foldable (toList)\nimport Hoopl.Graph\n\nimport qualified Data.Set as Set\n\n{-\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  ~~~ Note [Chain based CFG serialization]\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n  For additional information also look at\n  https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/CodeLayout\n\n  We have a CFG with edge weights based on which we try to place blocks next to\n  each other.\n\n  Edge weights not only represent likelyhood of control transfer between blocks\n  but also how much a block would benefit from being placed sequentially after\n  it's predecessor.\n  For example blocks which are preceeded by an info table are more likely to end\n  up in a different cache line than their predecessor. So there is less benefit\n  in placing them sequentially.\n\n  For example consider this example:\n\n  A:  ...\n      jmp cond D (weak successor)\n      jmp B\n  B:  ...\n      jmp C\n  C:  ...\n      jmp X\n  D:  ...\n      jmp B (weak successor)\n\n  We determine a block layout by building up chunks (calling them chains) of\n  possible control flows for which blocks will be placed sequentially.\n\n  Eg for our example we might end up with two chains like:\n  [A->B->C->X],[D]. Blocks inside chains will always be placed sequentially.\n  However there is no particular order in which chains are placed since\n  (hopefully) the blocks for which sequentially is important have already\n  been placed in the same chain.\n\n  -----------------------------------------------------------------------------\n      First try to create a lists of good chains.\n  -----------------------------------------------------------------------------\n\n  We do so by taking a block not yet placed in a chain and\n  looking at these cases:\n\n  *)  Check if the best predecessor of the block is at the end of a chain.\n      If so add the current block to the end of that chain.\n\n      Eg if we look at block C and already have the chain (A -> B)\n      then we extend the chain to (A -> B -> C).\n\n      Combined with the fact that we process blocks in reverse post order\n      this means loop bodies and trivially sequential control flow already\n      ends up as a single chain.\n\n  *)  Otherwise we create a singleton chain from the block we are looking at.\n      Eg if we have from the example above already constructed (A->B)\n      and look at D we create the chain (D) resulting in the chains [A->B, D]\n\n  -----------------------------------------------------------------------------\n      We then try to fuse chains.\n  -----------------------------------------------------------------------------\n\n  There are edge cases which result in two chains being created which trivially\n  represent linear control flow. For example we might have the chains\n  [(A-B-C),(D-E)] with an cfg triangle:\n\n      A----->C->D->E\n       \\->B-/\n\n  We also get three independent chains if two branches end with a jump\n  to a common successor.\n\n  We take care of these cases by fusing chains which are connected by an\n  edge.\n\n  We do so by looking at the list of edges sorted by weight.\n  Given the edge (C -> D) we try to find two chains such that:\n      * C is at the end of chain one.\n      * D is in front of chain two.\n      * If two such chains exist we fuse them.\n  We then remove the edge and repeat the process for the rest of the edges.\n\n  -----------------------------------------------------------------------------\n      Place indirect successors (neighbours) after each other\n  -----------------------------------------------------------------------------\n\n  We might have chains [A,B,C,X],[E] in a CFG of the sort:\n\n    A ---> B ---> C --------> X(exit)\n                   \\- ->E- -/\n\n  While E does not follow X it's still beneficial to place them near each other.\n  This can be advantageous if eg C,X,E will end up in the same cache line.\n\n  TODO: If we remove edges as we use them (eg if we build up A->B remove A->B\n        from the list) we could save some more work in later phases.\n\n\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  ~~~ Note [Triangle Control Flow]\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n  Checking if an argument is already evaluating leads to a somewhat\n  special case  which looks like this:\n\n    A:\n        if (R1 & 7 != 0) goto Leval; else goto Lwork;\n    Leval: // global\n        call (I64[R1])(R1) returns to Lwork, args: 8, res: 8, upd: 8;\n    Lwork: // global\n        ...\n\n        A\n        |\\\n        | Leval\n        |/ - (This edge can be missing because of optimizations)\n        Lwork\n\n  Once we hit the metal the call instruction is just 2-3 bytes large\n  depending on the register used. So we lay out the assembly like this:\n\n        movq %rbx,%rax\n        andl $7,%eax\n        cmpq $1,%rax\n        jne Lwork\n    Leval:\n        jmp *(%rbx) # encoded in 2-3 bytes.\n    <info table>\n    Lwork:\n        ...\n\n  We could explicitly check for this control flow pattern.\n\n  This is advantageous because:\n  * It's optimal if the argument isn't evaluated.\n  * If it's evaluated we only have the extra cost of jumping over\n    the 2-3 bytes for the call.\n  * Guarantees the smaller encoding for the conditional jump.\n\n  However given that Lwork usually has an info table we\n  penalize this edge. So Leval should get placed first\n  either way and things work out for the best.\n\n  Optimizing for the evaluated case instead would penalize\n  the other code path. It adds an jump as we can't fall through\n  to Lwork because of the info table.\n  Assuming that Lwork is large the chance that the \"call\" ends up\n  in the same cache line is also fairly small.\n\n-}\n\n\n-- | Look at X number of blocks in two chains to determine\n--   if they are \"neighbours\".\nneighbourOverlapp :: Int\nneighbourOverlapp = 2\n\n-- | Only edges heavier than this are considered\n--   for fusing two chains into a single chain.\nfuseEdgeThreshold :: EdgeWeight\nfuseEdgeThreshold = 0\n\n-- | Maps blocks near the end of a chain to it's chain AND\n-- the other blocks near the end.\n-- [A,B,C,D,E] Gives entries like (B -> ([A,B], [A,B,C,D,E]))\n-- where [A,B] are blocks in the end region of a chain.\n-- This is cheaper then recomputing the ends multiple times.\ntype FrontierMap = LabelMap ([BlockId],BlockChain)\n\n-- | A non empty ordered sequence of basic blocks.\n--   It is suitable for serialization in this order.\n--\n--   We use OrdList instead of [] to allow fast append on both sides\n--   when combining chains.\nnewtype BlockChain\n    = BlockChain { chainBlocks :: (OrdList BlockId) }\n\ninstance Eq (BlockChain) where\n    (BlockChain blks1) == (BlockChain blks2)\n        = fromOL blks1 == fromOL blks2\n\n-- Useful for things like sets and debugging purposes, sorts by blocks\n-- in the chain.\ninstance Ord (BlockChain) where\n   (BlockChain lbls1) `compare` (BlockChain lbls2)\n       = (fromOL lbls1) `compare` (fromOL lbls2)\n\ninstance Outputable (BlockChain) where\n    ppr (BlockChain blks) =\n        parens (text \"Chain:\" <+> ppr (fromOL $ blks) )\n\ndata WeightedEdge = WeightedEdge !BlockId !BlockId EdgeWeight deriving (Eq)\n\n\n-- | Non deterministic! (Uniques) Sorts edges by weight and nodes.\ninstance Ord WeightedEdge where\n  compare (WeightedEdge from1 to1 weight1)\n          (WeightedEdge from2 to2 weight2)\n    | weight1 < weight2 || weight1 == weight2 && from1 < from2 ||\n      weight1 == weight2 && from1 == from2 && to1 < to2\n    = LT\n    | from1 == from2 && to1 == to2 && weight1 == weight2\n    = EQ\n    | otherwise\n    = GT\n\ninstance Outputable WeightedEdge where\n    ppr (WeightedEdge from to info) =\n        ppr from <> text \"->\" <> ppr to <> brackets (ppr info)\n\ntype WeightedEdgeList = [WeightedEdge]\n\nnoDups :: [BlockChain] -> Bool\nnoDups chains =\n    let chainBlocks = concatMap chainToBlocks chains :: [BlockId]\n        (_blocks, dups) = removeDups compare chainBlocks\n    in if null dups then True\n        else pprTrace \"Duplicates:\" (ppr (map toList dups) $$ text \"chains\" <+> ppr chains ) False\n\ninFront :: BlockId -> BlockChain -> Bool\ninFront bid (BlockChain seq)\n  = headOL seq == bid\n\nchainMember :: BlockId -> BlockChain -> Bool\nchainMember bid chain\n  = elem bid $ fromOL . chainBlocks $ chain\n--   = setMember bid . chainMembers $ chain\n\nchainSingleton :: BlockId -> BlockChain\nchainSingleton lbl\n    = BlockChain (unitOL lbl)\n\nchainSnoc :: BlockChain -> BlockId -> BlockChain\nchainSnoc (BlockChain blks) lbl\n  = BlockChain (blks `snocOL` lbl)\n\nchainConcat :: BlockChain -> BlockChain -> BlockChain\nchainConcat (BlockChain blks1) (BlockChain blks2)\n  = BlockChain (blks1 `appOL` blks2)\n\nchainToBlocks :: BlockChain -> [BlockId]\nchainToBlocks (BlockChain blks) = fromOL blks\n\n-- | Given the Chain A -> B -> C -> D and we break at C\n--   we get the two Chains (A -> B, C -> D) as result.\nbreakChainAt :: BlockId -> BlockChain\n             -> (BlockChain,BlockChain)\nbreakChainAt bid (BlockChain blks)\n    | not (bid == head rblks)\n    = panic \"Block not in chain\"\n    | otherwise\n    = (BlockChain (toOL lblks),\n       BlockChain (toOL rblks))\n  where\n    (lblks, rblks) = break (\\lbl -> lbl == bid) (fromOL blks)\n\ntakeR :: Int -> BlockChain -> [BlockId]\ntakeR n (BlockChain blks) =\n    take n . fromOLReverse $ blks\n\ntakeL :: Int -> BlockChain -> [BlockId]\ntakeL n (BlockChain blks) =\n    take n . fromOL $ blks\n\n-- | For a given list of chains try to fuse chains with strong\n--   edges between them into a single chain.\n--   Returns the list of fused chains together with a set of\n--   used edges. The set of edges is indirectly encoded in the\n--   chains so doesn't need to be considered for later passes.\nfuseChains :: WeightedEdgeList -> LabelMap BlockChain\n           -> (LabelMap BlockChain, Set.Set WeightedEdge)\nfuseChains weights chains\n    = let fronts = mapFromList $\n                    map (\\chain -> (headOL . chainBlocks $ chain,chain)) $\n                    mapElems chains :: LabelMap BlockChain\n          (chains', used, _) = applyEdges weights chains fronts Set.empty\n      in (chains', used)\n    where\n        applyEdges :: WeightedEdgeList -> LabelMap BlockChain\n                   -> LabelMap BlockChain -> Set.Set WeightedEdge\n                   -> (LabelMap BlockChain, Set.Set WeightedEdge, LabelMap BlockChain)\n        applyEdges [] chainsEnd chainsFront used\n            = (chainsEnd, used, chainsFront)\n        applyEdges (edge@(WeightedEdge from to w):edges) chainsEnd chainsFront used\n            --Since we order edges descending by weight we can stop here\n            | w <= fuseEdgeThreshold\n            = ( chainsEnd, used, chainsFront)\n            --Fuse the two chains\n            | Just c1 <- mapLookup from chainsEnd\n            , Just c2 <- mapLookup to chainsFront\n            , c1 /= c2\n            = let newChain = chainConcat c1 c2\n                  front = headOL . chainBlocks $ newChain\n                  end = lastOL . chainBlocks $ newChain\n                  chainsFront' = mapInsert front newChain $\n                                 mapDelete to chainsFront\n                  chainsEnd'   = mapInsert end newChain $\n                                 mapDelete from chainsEnd\n              in applyEdges edges chainsEnd' chainsFront'\n                            (Set.insert edge used)\n            | otherwise\n            --Check next edge\n            = applyEdges edges chainsEnd chainsFront used\n\n\n-- See also Note [Chain based CFG serialization]\n-- We have the chains (A-B-C-D) and (E-F) and an Edge C->E.\n--\n-- While placing the later after the former doesn't result in sequential\n-- control flow it is still be benefical since block C and E might end\n-- up in the same cache line.\n--\n-- So we place these chains next to each other even if we can't fuse them.\n--\n--   A -> B -> C -> D\n--             v\n--             - -> E -> F ...\n--\n-- Simple heuristic to chose which chains we want to combine:\n--   * Process edges in descending priority.\n--   * Check if there is a edge near the end of one chain which goes\n--     to a block near the start of another edge.\n--\n-- While we could take into account the space between the two blocks which\n-- share an edge this blows up compile times quite a bit. It requires\n-- us to find all edges between two chains, check the distance for all edges,\n-- rank them based on the distance and and only then we can select two chains\n-- to combine. Which would add a lot of complexity for little gain.\n\n-- | For a given list of chains and edges try to combine chains with strong\n--   edges between them.\ncombineNeighbourhood :: WeightedEdgeList -> [BlockChain]\n                     -> [BlockChain]\ncombineNeighbourhood edges chains\n    = -- pprTraceIt \"Neigbours\" $\n      applyEdges edges endFrontier startFrontier\n    where\n        --Build maps from chain ends to chains\n        endFrontier, startFrontier :: FrontierMap\n        endFrontier =\n            mapFromList $ concatMap (\\chain ->\n                                let ends = getEnds chain :: [BlockId]\n                                    entry = (ends,chain)\n                                in map (\\x -> (x,entry)) ends ) chains\n        startFrontier =\n            mapFromList $ concatMap (\\chain ->\n                                let front = getFronts chain\n                                    entry = (front,chain)\n                                in map (\\x -> (x,entry)) front) chains\n        applyEdges :: WeightedEdgeList -> FrontierMap -> FrontierMap\n                   -> [BlockChain]\n        applyEdges [] chainEnds _chainFronts =\n            ordNub $ map snd $ mapElems chainEnds\n        applyEdges ((WeightedEdge from to _w):edges) chainEnds chainFronts\n            | Just (c1_e,c1) <- mapLookup from chainEnds\n            , Just (c2_f,c2) <- mapLookup to chainFronts\n            , c1 /= c2 -- Avoid trying to concat a short chain with itself.\n            = let newChain = chainConcat c1 c2\n                  newChainFrontier = getFronts newChain\n                  newChainEnds = getEnds newChain\n                  newFronts :: FrontierMap\n                  newFronts =\n                    let withoutOld =\n                            foldl' (\\m b -> mapDelete b m :: FrontierMap) chainFronts (c2_f ++ getFronts c1)\n                        entry =\n                            (newChainFrontier,newChain) --let bound to ensure sharing\n                    in foldl' (\\m x -> mapInsert x entry m)\n                              withoutOld newChainFrontier\n\n                  newEnds =\n                    let withoutOld = foldl' (\\m b -> mapDelete b m) chainEnds (c1_e ++ getEnds c2)\n                        entry = (newChainEnds,newChain) --let bound to ensure sharing\n                    in foldl' (\\m x -> mapInsert x entry m)\n                              withoutOld newChainEnds\n              in\n                -- pprTrace \"ApplyEdges\"\n                --  (text \"before\" $$\n                --   text \"fronts\" <+> ppr chainFronts $$\n                --   text \"ends\" <+> ppr chainEnds $$\n\n                --   text \"various\" $$\n                --   text \"newChain\" <+> ppr newChain $$\n                --   text \"newChainFrontier\" <+> ppr newChainFrontier $$\n                --   text \"newChainEnds\" <+> ppr newChainEnds $$\n                --   text \"drop\" <+> ppr ((c2_f ++ getFronts c1) ++ (c1_e ++ getEnds c2)) $$\n\n                --   text \"after\" $$\n                --   text \"fronts\" <+> ppr newFronts $$\n                --   text \"ends\" <+> ppr newEnds\n                --   )\n                 applyEdges edges newEnds newFronts\n            | otherwise\n            = --pprTrace \"noNeigbours\" (ppr ()) $\n              applyEdges edges chainEnds chainFronts\n         where\n\n        getFronts chain = takeL neighbourOverlapp chain\n        getEnds chain = takeR neighbourOverlapp chain\n\n\n\n-- See [Chain based CFG serialization]\nbuildChains :: CFG -> [BlockId]\n            -> ( LabelMap BlockChain  -- Resulting chains.\n               , Set.Set (BlockId, BlockId)) --List of fused edges.\nbuildChains succWeights blocks\n  = let (_, fusedEdges, chains) = buildNext setEmpty mapEmpty blocks Set.empty\n    in (chains, fusedEdges)\n  where\n    -- We keep a map from the last block in a chain to the chain itself.\n    -- This we we can easily check if an block should be appened to an\n    -- existing chain!\n    buildNext :: LabelSet\n              -> LabelMap BlockChain -- Map from last element to chain.\n              -> [BlockId] -- Blocks to place\n              -> Set.Set (BlockId, BlockId)\n              -> ( [BlockChain]  -- Placed Blocks\n                 , Set.Set (BlockId, BlockId) --List of fused edges\n                 , LabelMap BlockChain\n                 )\n    buildNext _placed chains [] linked =\n        ([], linked, chains)\n    buildNext placed chains (block:todo) linked\n        | setMember block placed\n        = buildNext placed chains todo linked\n        | otherwise\n        = buildNext placed' chains' todo linked'\n      where\n        placed' = (foldl' (flip setInsert) placed placedBlocks)\n        linked' = Set.union linked linkedEdges\n        (placedBlocks, chains', linkedEdges) = findChain block\n\n        --Add the block to a existing or new chain\n        --Returns placed blocks, list of resulting chains\n        --and fused edges\n        findChain :: BlockId\n                -> ([BlockId],LabelMap BlockChain, Set.Set (BlockId, BlockId))\n        findChain block\n        -- B) place block at end of existing chain if\n        -- there is no better block to append.\n          | (pred:_) <- preds\n          , alreadyPlaced pred\n          , Just predChain <- mapLookup pred chains\n          , (best:_) <- filter (not . alreadyPlaced) $ getSuccs pred\n          , best == lbl\n          = --pprTrace \"B.2)\" (ppr (pred,lbl)) $\n            let newChain = chainSnoc predChain block\n                chainMap = mapInsert lbl newChain $ mapDelete pred chains\n            in  ( [lbl]\n                , chainMap\n                , Set.singleton (pred,lbl) )\n\n          | otherwise\n          = --pprTrace \"single\" (ppr lbl)\n            ( [lbl]\n            , mapInsert lbl (chainSingleton lbl) chains\n            , Set.empty)\n            where\n              alreadyPlaced blkId = (setMember blkId placed)\n              lbl = block\n              getSuccs = map fst . getSuccEdgesSorted succWeights\n              preds = map fst $ getSuccEdgesSorted predWeights lbl\n    --For efficiency we also create the map to look up predecessors here\n    predWeights = reverseEdges succWeights\n\n\n\n-- We make the CFG a Hoopl Graph, so we can reuse revPostOrder.\nnewtype BlockNode e x = BN (BlockId,[BlockId])\ninstance NonLocal (BlockNode) where\n  entryLabel (BN (lbl,_))   = lbl\n  successors (BN (_,succs)) = succs\n\nfromNode :: BlockNode C C -> BlockId\nfromNode (BN x) = fst x\n\nsequenceChain :: forall a i. (Instruction i, Outputable i) => LabelMap a -> CFG\n            -> [GenBasicBlock i] -> [GenBasicBlock i]\nsequenceChain _info _weights    [] = []\nsequenceChain _info _weights    [x] = [x]\nsequenceChain  info weights'     blocks@((BasicBlock entry _):_) =\n    --Optimization, delete edges of weight <= 0.\n    --This significantly improves performance whenever\n    --we iterate over all edges, which is a few times!\n    let weights :: CFG\n        weights\n            = filterEdges (\\_f _t edgeInfo -> edgeWeight edgeInfo > 0) weights'\n        blockMap :: LabelMap (GenBasicBlock i)\n        blockMap\n            = foldl' (\\m blk@(BasicBlock lbl _ins) ->\n                        mapInsert lbl blk m)\n                     mapEmpty blocks\n\n        toNode :: BlockId -> BlockNode C C\n        toNode bid =\n            -- sorted such that heavier successors come first.\n            BN (bid,map fst . getSuccEdgesSorted weights' $ bid)\n\n        orderedBlocks :: [BlockId]\n        orderedBlocks\n            = map fromNode $\n              revPostorderFrom (fmap (toNode . blockId) blockMap) entry\n\n        (builtChains, builtEdges)\n            = {-# SCC \"buildChains\" #-}\n              --pprTraceIt \"generatedChains\" $\n              --pprTrace \"orderedBlocks\" (ppr orderedBlocks) $\n              buildChains weights orderedBlocks\n\n        rankedEdges :: WeightedEdgeList\n        -- Sort edges descending, remove fused eges\n        rankedEdges =\n            map (\\(from, to, weight) -> WeightedEdge from to weight) .\n            filter (\\(from, to, _)\n                        -> not (Set.member (from,to) builtEdges)) .\n            sortWith (\\(_,_,w) -> - w) $ weightedEdgeList weights\n\n        (fusedChains, fusedEdges)\n            = ASSERT(noDups $ mapElems builtChains)\n              {-# SCC \"fuseChains\" #-}\n              --(pprTrace \"RankedEdges\" $ ppr rankedEdges) $\n              --pprTraceIt \"FusedChains\" $\n              fuseChains rankedEdges builtChains\n\n        rankedEdges' =\n            filter (\\edge -> not $ Set.member edge fusedEdges) $ rankedEdges\n\n        neighbourChains\n            = ASSERT(noDups $ mapElems fusedChains)\n              {-# SCC \"groupNeighbourChains\" #-}\n              --pprTraceIt \"ResultChains\" $\n              combineNeighbourhood rankedEdges' (mapElems fusedChains)\n\n        --Make sure the first block stays first\n        ([entryChain],chains')\n            = ASSERT(noDups $ neighbourChains)\n              partition (chainMember entry) neighbourChains\n        (entryChain':entryRest)\n            | inFront entry entryChain = [entryChain]\n            | (rest,entry) <- breakChainAt entry entryChain\n            = [entry,rest]\n            | otherwise = pprPanic \"Entry point eliminated\" $\n                            ppr ([entryChain],chains')\n\n        prepedChains\n            = entryChain':(entryRest++chains') :: [BlockChain]\n        blockList\n            -- = (concatMap chainToBlocks prepedChains)\n            = (concatMap fromOL $ map chainBlocks prepedChains)\n\n        --chainPlaced = setFromList $ map blockId blockList :: LabelSet\n        chainPlaced = setFromList $ blockList :: LabelSet\n        unplaced =\n            let blocks = mapKeys blockMap\n                isPlaced b = setMember (b) chainPlaced\n            in filter (\\block -> not (isPlaced block)) blocks\n\n        placedBlocks =\n            --pprTraceIt \"placedBlocks\" $\n            blockList ++ unplaced\n        getBlock bid = expectJust \"Block placment\" $ mapLookup bid blockMap\n    in\n        --Assert we placed all blocks given as input\n        ASSERT(all (\\bid -> mapMember bid blockMap) placedBlocks)\n        dropJumps info $ map getBlock placedBlocks\n\ndropJumps :: forall a i. Instruction i => LabelMap a -> [GenBasicBlock i]\n          -> [GenBasicBlock i]\ndropJumps _    [] = []\ndropJumps info ((BasicBlock lbl ins):todo)\n    | not . null $ ins --This can happen because of shortcutting\n    , [dest] <- jumpDestsOfInstr (last ins)\n    , ((BasicBlock nextLbl _) : _) <- todo\n    , not (mapMember dest info)\n    , nextLbl == dest\n    = BasicBlock lbl (init ins) : dropJumps info todo\n    | otherwise\n    = BasicBlock lbl ins : dropJumps info todo\n\n\n-- -----------------------------------------------------------------------------\n-- Sequencing the basic blocks\n\n-- Cmm BasicBlocks are self-contained entities: they always end in a\n-- jump, either non-local or to another basic block in the same proc.\n-- In this phase, we attempt to place the basic blocks in a sequence\n-- such that as many of the local jumps as possible turn into\n-- fallthroughs.\n\nsequenceTop\n    :: (Instruction instr, Outputable instr)\n    => DynFlags --Use new layout code\n    -> NcgImpl statics instr jumpDest -> CFG\n    -> NatCmmDecl statics instr -> NatCmmDecl statics instr\n\nsequenceTop _     _       _           top@(CmmData _ _) = top\nsequenceTop dflags ncgImpl edgeWeights\n            (CmmProc info lbl live (ListGraph blocks))\n  | (gopt Opt_CfgBlocklayout dflags) && backendMaintainsCfg dflags\n  --Use chain based algorithm\n  = CmmProc info lbl live ( ListGraph $ ncgMakeFarBranches ncgImpl info $\n                            sequenceChain info edgeWeights blocks )\n  | otherwise\n  --Use old algorithm\n  = CmmProc info lbl live ( ListGraph $ ncgMakeFarBranches ncgImpl info $\n                            sequenceBlocks cfg info blocks)\n  where\n    cfg\n      | (gopt Opt_WeightlessBlocklayout dflags) ||\n        (not $ backendMaintainsCfg dflags)\n      -- Don't make use of cfg in the old algorithm\n      = Nothing\n      -- Use cfg in the old algorithm\n      | otherwise = Just edgeWeights\n\n-- The old algorithm:\n-- It is very simple (and stupid): We make a graph out of\n-- the blocks where there is an edge from one block to another iff the\n-- first block ends by jumping to the second.  Then we topologically\n-- sort this graph.  Then traverse the list: for each block, we first\n-- output the block, then if it has an out edge, we move the\n-- destination of the out edge to the front of the list, and continue.\n\n-- FYI, the classic layout for basic blocks uses postorder DFS; this\n-- algorithm is implemented in Hoopl.\n\nsequenceBlocks :: Instruction inst => Maybe CFG -> LabelMap a\n               -> [GenBasicBlock inst] -> [GenBasicBlock inst]\nsequenceBlocks _edgeWeight _ [] = []\nsequenceBlocks edgeWeights infos (entry:blocks) =\n    let entryNode = mkNode edgeWeights entry\n        bodyNodes = reverse\n                    (flattenSCCs (sccBlocks edgeWeights blocks))\n    in dropJumps infos . seqBlocks infos $ ( entryNode : bodyNodes)\n  -- the first block is the entry point ==> it must remain at the start.\n\nsccBlocks\n        :: Instruction instr\n        => Maybe CFG -> [NatBasicBlock instr]\n        -> [SCC (Node BlockId (NatBasicBlock instr))]\nsccBlocks edgeWeights blocks =\n    stronglyConnCompFromEdgedVerticesUniqR\n        (map (mkNode edgeWeights) blocks)\n\nmkNode :: (Instruction t)\n       => Maybe CFG -> GenBasicBlock t\n       -> Node BlockId (GenBasicBlock t)\nmkNode edgeWeights block@(BasicBlock id instrs) =\n    DigraphNode block id outEdges\n  where\n    outEdges :: [BlockId]\n    outEdges\n      --Select the heaviest successor, ignore weights <= zero\n      = successor\n      where\n        successor\n          | Just successors <- fmap (`getSuccEdgesSorted` id)\n                                    edgeWeights -- :: Maybe [(Label, EdgeInfo)]\n          = case successors of\n            [] -> []\n            ((target,info):_)\n              | length successors > 2 || edgeWeight info <= 0 -> []\n              | otherwise -> [target]\n          | otherwise\n          = case jumpDestsOfInstr (last instrs) of\n                [one] -> [one]\n                _many -> []\n\n\nseqBlocks :: LabelMap i -> [Node BlockId (GenBasicBlock t1)]\n                        -> [GenBasicBlock t1]\nseqBlocks infos blocks = placeNext pullable0 todo0\n  where\n    -- pullable: Blocks that are not yet placed\n    -- todo:     Original order of blocks, to be followed if we have no good\n    --           reason not to;\n    --           may include blocks that have already been placed, but then\n    --           these are not in pullable\n    pullable0 = listToUFM [ (i,(b,n)) | DigraphNode b i n <- blocks ]\n    todo0     = map node_key blocks\n\n    placeNext _ [] = []\n    placeNext pullable (i:rest)\n        | Just (block, pullable') <- lookupDeleteUFM pullable i\n        = place pullable' rest block\n        | otherwise\n        -- We already placed this block, so ignore\n        = placeNext pullable rest\n\n    place pullable todo (block,[])\n                          = block : placeNext pullable todo\n    place pullable todo (block@(BasicBlock id instrs),[next])\n        | mapMember next infos\n        = block : placeNext pullable todo\n        | Just (nextBlock, pullable') <- lookupDeleteUFM pullable next\n        = BasicBlock id instrs : place pullable' todo nextBlock\n        | otherwise\n        = block : placeNext pullable todo\n    place _ _ (_,tooManyNextNodes)\n        = pprPanic \"seqBlocks\" (ppr tooManyNextNodes)\n\n\nlookupDeleteUFM :: Uniquable key => UniqFM elt -> key\n                -> Maybe (elt, UniqFM elt)\nlookupDeleteUFM m k = do -- Maybe monad\n    v <- lookupUFM m k\n    return (v, delFromUFM m k)\n\n", "num_lines": 759}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Copyright (c) 2018 Andreas Klebinger\n--\n\n{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE CPP #-}\n\nmodule CFG\n    ( CFG, CfgEdge(..), EdgeInfo(..), EdgeWeight(..)\n    , TransitionSource(..)\n\n    --Modify the CFG\n    , addWeightEdge, addEdge, delEdge\n    , addNodesBetween, shortcutWeightMap\n    , reverseEdges, filterEdges\n    , addImmediateSuccessor\n    , mkWeightInfo, adjustEdgeWeight\n\n    --Query the CFG\n    , infoEdgeList, edgeList\n    , getSuccessorEdges, getSuccessors\n    , getSuccEdgesSorted, weightedEdgeList\n    , getEdgeInfo\n    , getCfgNodes, hasNode\n    , loopMembers\n\n    --Construction/Misc\n    , getCfg, getCfgProc, pprEdgeWeights, sanityCheckCfg\n\n    --Find backedges and update their weight\n    , optimizeCFG )\nwhere\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BlockId\nimport Cmm ( RawCmmDecl, GenCmmDecl( .. ), CmmBlock, succ, g_entry\n           , CmmGraph )\nimport CmmNode\nimport CmmUtils\nimport CmmSwitch\nimport Hoopl.Collections\nimport Hoopl.Label\nimport Hoopl.Block\nimport qualified Hoopl.Graph as G\n\nimport Util\nimport Digraph\n\nimport Outputable\n-- DEBUGGING ONLY\n--import Debug\n--import OrdList\n--import Debug.Trace\nimport PprCmm ()\nimport qualified DynFlags as D\n\nimport Data.List\n\n-- import qualified Data.IntMap.Strict as M --TODO: LabelMap\n\ntype Edge = (BlockId, BlockId)\ntype Edges = [Edge]\n\nnewtype EdgeWeight\n  = EdgeWeight Int\n  deriving (Eq,Ord,Enum,Num,Real,Integral)\n\ninstance Outputable EdgeWeight where\n  ppr (EdgeWeight w) = ppr w\n\ntype EdgeInfoMap edgeInfo = LabelMap (LabelMap edgeInfo)\n\n-- | A control flow graph where edges have been annotated with a weight.\ntype CFG = EdgeInfoMap EdgeInfo\n\ndata CfgEdge\n  = CfgEdge\n  { edgeFrom :: !BlockId\n  , edgeTo :: !BlockId\n  , edgeInfo :: !EdgeInfo\n  }\n\n-- | Careful! Since we assume there is at most one edge from A to B\n--   the Eq instance does not consider weight.\ninstance Eq CfgEdge where\n  (==) (CfgEdge from1 to1 _) (CfgEdge from2 to2 _)\n    = from1 == from2 && to1 == to2\n\n-- | Edges are sorted ascending pointwise by weight, source and destination\ninstance Ord CfgEdge where\n  compare (CfgEdge from1 to1 (EdgeInfo {edgeWeight = weight1}))\n          (CfgEdge from2 to2 (EdgeInfo {edgeWeight = weight2}))\n    | weight1 < weight2 || weight1 == weight2 && from1 < from2 ||\n      weight1 == weight2 && from1 == from2 && to1 < to2\n    = LT\n    | from1 == from2 && to1 == to2 && weight1 == weight2\n    = EQ\n    | otherwise\n    = GT\n\ninstance Outputable CfgEdge where\n  ppr (CfgEdge from1 to1 edgeInfo)\n    = parens (ppr from1 <+> text \"-(\" <> ppr edgeInfo <> text \")->\" <+> ppr to1)\n\n-- | Can we trace back a edge to a specific Cmm Node\n-- or has it been introduced for codegen. We use this to maintain\n-- some information which would otherwise be lost during the\n-- Cmm <-> asm transition.\n-- See also Note [Inverting Conditional Branches]\ndata TransitionSource\n  = CmmSource (CmmNode O C)\n  | AsmCodeGen\n  deriving (Eq)\n\n-- | Information about edges\ndata EdgeInfo\n  = EdgeInfo\n  { transitionSource :: !TransitionSource\n  , edgeWeight :: !EdgeWeight\n  } deriving (Eq)\n\ninstance Outputable EdgeInfo where\n  ppr edgeInfo = text \"weight:\" <+> ppr (edgeWeight edgeInfo)\n\n-- Allow specialization\n{-# INLINEABLE mkWeightInfo #-}\n-- | Convenience function, generate edge info based\n--   on weight not originating from cmm.\nmkWeightInfo :: Integral n => n -> EdgeInfo\nmkWeightInfo = EdgeInfo AsmCodeGen . fromIntegral\n\n-- | Adjust the weight between the blocks using the given function.\n--   If there is no such edge returns the original map.\nadjustEdgeWeight :: CFG -> (EdgeWeight -> EdgeWeight)\n                 -> BlockId -> BlockId -> CFG\nadjustEdgeWeight cfg f from to\n  | Just info <- getEdgeInfo from to cfg\n  , weight <- edgeWeight info\n  = addEdge from to (info { edgeWeight = f weight}) cfg\n  | otherwise = cfg\n\ngetCfgNodes :: CFG -> LabelSet\ngetCfgNodes m = mapFoldMapWithKey (\\k v -> setFromList (k:mapKeys v)) m\n\nhasNode :: CFG -> BlockId -> Bool\nhasNode m node = mapMember node m || any (mapMember node) m\n\n-- | Check if the nodes in the cfg and the set of blocks are the same.\n--   In a case of a missmatch we panic and show the difference.\nsanityCheckCfg :: CFG -> LabelSet -> SDoc -> Bool\nsanityCheckCfg m blockSet msg\n    | blockSet == cfgNodes\n    = True\n    | otherwise =\n        pprPanic \"Block list and cfg nodes don't match\" (\n            text \"difference:\" <+> ppr diff $$\n            text \"blocks:\" <+> ppr blockSet $$\n            text \"cfg:\" <+> ppr m $$\n            msg )\n            False\n    where\n      cfgNodes = getCfgNodes m :: LabelSet\n      diff = (setUnion cfgNodes blockSet) `setDifference` (setIntersection cfgNodes blockSet) :: LabelSet\n\n-- | Filter the CFG with a custom function f.\n--   Paramaeters are `f from to edgeInfo`\nfilterEdges :: (BlockId -> BlockId -> EdgeInfo -> Bool) -> CFG -> CFG\nfilterEdges f cfg =\n    mapMapWithKey filterSources cfg\n    where\n      filterSources from m =\n        mapFilterWithKey (\\to w -> f from to w) m\n\n\n{- Note [Updating the CFG during shortcutting]\n\nSee Note [What is shortcutting] in the control flow optimization\ncode (CmmContFlowOpt.hs) for a slightly more in depth explanation on shortcutting.\n\nIn the native backend we shortcut jumps at the assembly level. (AsmCodeGen.hs)\nThis means we remove blocks containing only one jump from the code\nand instead redirecting all jumps targeting this block to the deleted\nblocks jump target.\n\nHowever we want to have an accurate representation of control\nflow in the CFG. So we add/remove edges accordingly to account\nfor the eliminated blocks and new edges.\n\nIf we shortcut A -> B -> C to A -> C:\n* We delete edges A -> B and B -> C\n* Replacing them with the edge A -> C\n\nWe also try to preserve jump weights while doing so.\n\nNote that:\n* The edge B -> C can't have interesting weights since\n  the block B consists of a single unconditional jump without branching.\n* We delete the edge A -> B and add the edge A -> C.\n* The edge A -> B can be one of many edges originating from A so likely\n  has edge weights we want to preserve.\n\nFor this reason we simply store the edge info from the original A -> B\nedge and apply this information to the new edge A -> C.\n\nSometimes we have a scenario where jump target C is not represented by an\nBlockId but an immediate value. I'm only aware of this happening without\ntables next to code currently.\n\nThen we go from A ---> B - -> IMM   to   A - -> IMM where the dashed arrows\nare not stored in the CFG.\n\nIn that case we simply delete the edge A -> B.\n\nIn terms of implementation the native backend first builds a mapping\nfrom blocks suitable for shortcutting to their jump targets.\nThen it redirects all jump instructions to these blocks using the\nbuilt up mapping.\nThis function (shortcutWeightMap) takes the same mapping and\napplies the mapping to the CFG in the way layed out above.\n\n-}\nshortcutWeightMap :: CFG -> LabelMap (Maybe BlockId) -> CFG\nshortcutWeightMap cfg cuts =\n  foldl' applyMapping cfg $ mapToList cuts\n    where\n-- takes the tuple (B,C) from the notation in [Updating the CFG during shortcutting]\n      applyMapping :: CFG -> (BlockId,Maybe BlockId) -> CFG\n      --Shortcut immediate\n      applyMapping m (from, Nothing) =\n        mapDelete from .\n        fmap (mapDelete from) $ m\n      --Regular shortcut\n      applyMapping m (from, Just to) =\n        let updatedMap :: CFG\n            updatedMap\n              = fmap (shortcutEdge (from,to)) $\n                (mapDelete from m :: CFG )\n        --Sometimes we can shortcut multiple blocks like so:\n        -- A -> B -> C -> D -> E => A -> E\n        -- so we check for such chains.\n        in case mapLookup to cuts of\n            Nothing -> updatedMap\n            Just dest -> applyMapping updatedMap (to, dest)\n      --Redirect edge from B to C\n      shortcutEdge :: (BlockId, BlockId) -> LabelMap EdgeInfo -> LabelMap EdgeInfo\n      shortcutEdge (from, to) m =\n        case mapLookup from m of\n          Just info -> mapInsert to info $ mapDelete from m\n          Nothing   -> m\n\n-- | Sometimes we insert a block which should unconditionally be executed\n--   after a given block. This function updates the CFG for these cases.\n--  So we get A -> B    => A -> A' -> B\n--             \\                  \\\n--              -> C    =>         -> C\n--\naddImmediateSuccessor :: BlockId -> BlockId -> CFG -> CFG\naddImmediateSuccessor node follower cfg\n    = updateEdges . addWeightEdge node follower uncondWeight $ cfg\n    where\n        uncondWeight = fromIntegral . D.uncondWeight .\n                       D.cfgWeightInfo $ D.unsafeGlobalDynFlags\n        targets = getSuccessorEdges cfg node\n        successors = map fst targets :: [BlockId]\n        updateEdges = addNewSuccs . remOldSuccs\n        remOldSuccs m = foldl' (flip (delEdge node)) m successors\n        addNewSuccs m =\n          foldl' (\\m' (t,info) -> addEdge follower t info m') m targets\n\n-- | Adds a new edge, overwrites existing edges if present\naddEdge :: BlockId -> BlockId -> EdgeInfo -> CFG -> CFG\naddEdge from to info cfg =\n    mapAlter addDest from cfg\n    where\n        addDest Nothing = Just $ mapSingleton to info\n        addDest (Just wm) = Just $ mapInsert to info wm\n\n-- | Adds a edge with the given weight to the cfg\n--   If there already existed an edge it is overwritten.\n--   `addWeightEdge from to weight cfg`\naddWeightEdge :: BlockId -> BlockId -> EdgeWeight -> CFG -> CFG\naddWeightEdge from to weight cfg =\n    addEdge from to (mkWeightInfo weight) cfg\n\ndelEdge :: BlockId -> BlockId -> CFG -> CFG\ndelEdge from to m =\n    mapAlter remDest from m\n    where\n        remDest Nothing = Nothing\n        remDest (Just wm) = Just $ mapDelete to wm\n\n-- | Destinations from bid ordered by weight (descending)\ngetSuccEdgesSorted :: CFG -> BlockId -> [(BlockId,EdgeInfo)]\ngetSuccEdgesSorted m bid =\n    let destMap = mapFindWithDefault mapEmpty bid m\n        cfgEdges = mapToList destMap\n        sortedEdges = sortWith (negate . edgeWeight . snd) cfgEdges\n    in  --pprTrace \"getSuccEdgesSorted\" (ppr bid <+> text \"map:\" <+> ppr m)\n        sortedEdges\n\n-- | Get successors of a given node with edge weights.\ngetSuccessorEdges :: CFG -> BlockId -> [(BlockId,EdgeInfo)]\ngetSuccessorEdges m bid = maybe [] mapToList $ mapLookup bid m\n\ngetEdgeInfo :: BlockId -> BlockId -> CFG -> Maybe EdgeInfo\ngetEdgeInfo from to m\n    | Just wm <- mapLookup from m\n    , Just info <- mapLookup to wm\n    = Just $! info\n    | otherwise\n    = Nothing\n\nreverseEdges :: CFG -> CFG\nreverseEdges cfg = foldr add mapEmpty flatElems\n  where\n    elems = mapToList $ fmap mapToList cfg :: [(BlockId,[(BlockId,EdgeInfo)])]\n    flatElems =\n        concatMap (\\(from,ws) -> map (\\(to,info) -> (to,from,info)) ws ) elems\n    add (to,from,info) m = addEdge to from info m\n\n-- | Returns a unordered list of all edges with info\ninfoEdgeList :: CFG -> [CfgEdge]\ninfoEdgeList m =\n  mapFoldMapWithKey\n    (\\from toMap ->\n      map (\\(to,info) -> CfgEdge from to info) (mapToList toMap))\n    m\n\n-- | Unordered list of edges with weight as Tuple (from,to,weight)\nweightedEdgeList :: CFG -> [(BlockId,BlockId,EdgeWeight)]\nweightedEdgeList m =\n  mapFoldMapWithKey\n    (\\from toMap ->\n      map (\\(to,info) ->\n        (from,to, edgeWeight info)) (mapToList toMap))\n    m\n      --  (\\(from, tos) -> map (\\(to,info) -> (from,to, edgeWeight info)) tos )\n\n-- | Returns a unordered list of all edges without weights\nedgeList :: CFG -> [Edge]\nedgeList m =\n        mapFoldMapWithKey (\\from toMap -> fmap (from,) (mapKeys toMap)) m\n\n-- | Get successors of a given node without edge weights.\ngetSuccessors :: CFG -> BlockId -> [BlockId]\ngetSuccessors m bid\n    | Just wm <- mapLookup bid m\n    = mapKeys wm\n    | otherwise = []\n\npprEdgeWeights :: CFG -> SDoc\npprEdgeWeights m =\n    let edges = sort $ weightedEdgeList m\n        printEdge (from, to, weight)\n            = text \"\\t\" <> ppr from <+> text \"->\" <+> ppr to <>\n              text \"[label=\\\"\" <> ppr weight <> text \"\\\",weight=\\\"\" <>\n              ppr weight <> text \"\\\"];\\n\"\n        --for the case that there are no edges from/to this node.\n        --This should rarely happen but it can save a lot of time\n        --to immediately see it when it does.\n        printNode node\n            = text \"\\t\" <> ppr node <> text \";\\n\"\n        getEdgeNodes (from, to, _weight) = [from,to]\n        edgeNodes = setFromList $ concatMap getEdgeNodes edges :: LabelSet\n        nodes = filter (\\n -> (not . setMember n) edgeNodes) . mapKeys $ mapFilter null m\n    in\n    text \"digraph {\\n\" <>\n        (foldl' (<>) empty (map printEdge edges)) <>\n        (foldl' (<>) empty (map printNode nodes)) <>\n    text \"}\\n\"\n\n{-# INLINE updateEdgeWeight #-} --Allows eliminating the tuple when possible\nupdateEdgeWeight :: (EdgeWeight -> EdgeWeight) -> Edge -> CFG -> CFG\nupdateEdgeWeight f (from, to) cfg\n    | Just oldInfo <- getEdgeInfo from to cfg\n    = let oldWeight = edgeWeight oldInfo\n          newWeight = f oldWeight\n      in addEdge from to (oldInfo {edgeWeight = newWeight}) cfg\n    | otherwise\n    = panic \"Trying to update invalid edge\"\n\n-- from to oldWeight => newWeight\nmapWeights :: (BlockId -> BlockId -> EdgeWeight -> EdgeWeight) -> CFG -> CFG\nmapWeights f cfg =\n  foldl' (\\cfg (CfgEdge from to info) ->\n            let oldWeight = edgeWeight info\n                newWeight = f from to oldWeight\n            in addEdge from to (info {edgeWeight = newWeight}) cfg)\n          cfg (infoEdgeList cfg)\n\n\n-- | Insert a block in the control flow between two other blocks.\n-- We pass a list of tuples (A,B,C) where\n-- * A -> C: Old edge\n-- * A -> B -> C : New Arc, where B is the new block.\n-- It's possible that a block has two jumps to the same block\n-- in the assembly code. However we still only store a single edge for\n-- these cases.\n-- We assign the old edge info to the edge A -> B and assign B -> C the\n-- weight of an unconditional jump.\naddNodesBetween :: CFG -> [(BlockId,BlockId,BlockId)] -> CFG\naddNodesBetween m updates =\n  foldl'  updateWeight m .\n          weightUpdates $ updates\n    where\n      weight = fromIntegral . D.uncondWeight .\n                D.cfgWeightInfo $ D.unsafeGlobalDynFlags\n      -- We might add two blocks for different jumps along a single\n      -- edge. So we end up with edges:   A -> B -> C   ,   A -> D -> C\n      -- in this case after applying the first update the weight for A -> C\n      -- is no longer available. So we calculate future weights before updates.\n      weightUpdates = map getWeight\n      getWeight :: (BlockId,BlockId,BlockId) -> (BlockId,BlockId,BlockId,EdgeInfo)\n      getWeight (from,between,old)\n        | Just edgeInfo <- getEdgeInfo from old m\n        = (from,between,old,edgeInfo)\n        | otherwise\n        = pprPanic \"Can't find weight for edge that should have one\" (\n            text \"triple\" <+> ppr (from,between,old) $$\n            text \"updates\" <+> ppr updates )\n      updateWeight :: CFG -> (BlockId,BlockId,BlockId,EdgeInfo) -> CFG\n      updateWeight m (from,between,old,edgeInfo)\n        = addEdge from between edgeInfo .\n          addWeightEdge between old weight .\n          delEdge from old $ m\n\n{-\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  ~~~       Note [CFG Edge Weights]    ~~~\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n  Edge weights assigned do not currently represent a specific\n  cost model and rather just a ranking of which blocks should\n  be placed next to each other given their connection type in\n  the CFG.\n  This is especially relevant if we whenever two blocks will\n  jump to the same target.\n\n                     A   B\n                      \\ /\n                       C\n\n  Should A or B be placed in front of C? The block layout algorithm\n  decides this based on which edge (A,C)/(B,C) is heavier. So we\n  make a educated guess how often execution will transer control\n  along each edge as well as how much we gain by placing eg A before\n  C.\n\n  We rank edges in this order:\n  * Unconditional Control Transfer - They will always\n    transfer control to their target. Unless there is a info table\n    we can turn the jump into a fallthrough as well.\n    We use 20k as default, so it's easy to spot if values have been\n    modified but unlikely that we run into issues with overflow.\n  * If branches (likely) - We assume branches marked as likely\n    are taken more than 80% of the time.\n    By ranking them below unconditional jumps we make sure we\n    prefer the unconditional if there is a conditional and\n    unconditional edge towards a block.\n  * If branches (regular) - The false branch can potentially be turned\n    into a fallthrough so we prefer it slightly over the true branch.\n  * Unlikely branches - These can be assumed to be taken less than 20%\n    of the time. So we given them one of the lowest priorities.\n  * Switches - Switches at this level are implemented as jump tables\n    so have a larger number of successors. So without more information\n    we can only say that each individual successor is unlikely to be\n    jumped to and we rank them accordingly.\n  * Calls - We currently ignore calls completly:\n        * By the time we return from a call there is a good chance\n          that the address we return to has already been evicted from\n          cache eliminating a main advantage sequential placement brings.\n        * Calls always require a info table in front of their return\n          address. This reduces the chance that we return to the same\n          cache line further.\n\n\n-}\n-- | Generate weights for a Cmm proc based on some simple heuristics.\ngetCfgProc :: D.CfgWeights -> RawCmmDecl -> CFG\ngetCfgProc _       (CmmData {}) = mapEmpty\ngetCfgProc weights (CmmProc _info _lab _live graph) = getCfg weights graph\n\ngetCfg :: D.CfgWeights -> CmmGraph -> CFG\ngetCfg weights graph =\n  foldl' insertEdge edgelessCfg $ concatMap getBlockEdges blocks\n  where\n    D.CFGWeights\n            { D.uncondWeight = uncondWeight\n            , D.condBranchWeight = condBranchWeight\n            , D.switchWeight = switchWeight\n            , D.callWeight = callWeight\n            , D.likelyCondWeight = likelyCondWeight\n            , D.unlikelyCondWeight = unlikelyCondWeight\n            --  Last two are used in other places\n            --, D.infoTablePenalty = infoTablePenalty\n            --, D.backEdgeBonus = backEdgeBonus\n            } = weights\n    -- Explicitly add all nodes to the cfg to ensure they are part of the\n    -- CFG.\n    edgelessCfg = mapFromList $ zip (map G.entryLabel blocks) (repeat mapEmpty)\n    insertEdge :: CFG -> ((BlockId,BlockId),EdgeInfo) -> CFG\n    insertEdge m ((from,to),weight) =\n      mapAlter f from m\n        where\n          f :: Maybe (LabelMap EdgeInfo) -> Maybe (LabelMap EdgeInfo)\n          f Nothing = Just $ mapSingleton to weight\n          f (Just destMap) = Just $ mapInsert to weight destMap\n    getBlockEdges :: CmmBlock -> [((BlockId,BlockId),EdgeInfo)]\n    getBlockEdges block =\n      case branch of\n        CmmBranch dest -> [mkEdge dest uncondWeight]\n        CmmCondBranch _c t f l\n          | l == Nothing ->\n              [mkEdge f condBranchWeight,   mkEdge t condBranchWeight]\n          | l == Just True ->\n              [mkEdge f unlikelyCondWeight, mkEdge t likelyCondWeight]\n          | l == Just False ->\n              [mkEdge f likelyCondWeight,   mkEdge t unlikelyCondWeight]\n        (CmmSwitch _e ids) ->\n          let switchTargets = switchTargetsToList ids\n              --Compiler performance hack - for very wide switches don't\n              --consider targets for layout.\n              adjustedWeight =\n                if (length switchTargets > 10) then -1 else switchWeight\n          in map (\\x -> mkEdge x adjustedWeight) switchTargets\n        (CmmCall { cml_cont = Just cont})  -> [mkEdge cont callWeight]\n        (CmmForeignCall {Cmm.succ = cont}) -> [mkEdge cont callWeight]\n        (CmmCall { cml_cont = Nothing })   -> []\n        other ->\n            panic \"Foo\" $\n            ASSERT2(False, ppr \"Unkown successor cause:\" <>\n              (ppr branch <+> text \"=>\" <> ppr (G.successors other)))\n            map (\\x -> ((bid,x),mkEdgeInfo 0)) $ G.successors other\n      where\n        bid = G.entryLabel block\n        mkEdgeInfo = EdgeInfo (CmmSource branch) . fromIntegral\n        mkEdge target weight = ((bid,target), mkEdgeInfo weight)\n        branch = lastNode block :: CmmNode O C\n\n    blocks = revPostorder graph :: [CmmBlock]\n\n--Find back edges by BFS\nfindBackEdges :: BlockId -> CFG -> Edges\nfindBackEdges root cfg =\n    --pprTraceIt \"Backedges:\" $\n    map fst .\n    filter (\\x -> snd x == Backward) $ typedEdges\n  where\n    edges = edgeList cfg :: [(BlockId,BlockId)]\n    getSuccs = getSuccessors cfg :: BlockId -> [BlockId]\n    typedEdges =\n      classifyEdges root getSuccs edges :: [((BlockId,BlockId),EdgeType)]\n\n\noptimizeCFG :: D.CfgWeights -> RawCmmDecl -> CFG -> CFG\noptimizeCFG _ (CmmData {}) cfg = cfg\noptimizeCFG weights (CmmProc info _lab _live graph) cfg =\n    favourFewerPreds  .\n    penalizeInfoTables info .\n    increaseBackEdgeWeight (g_entry graph) $ cfg\n  where\n\n    -- | Increase the weight of all backedges in the CFG\n    -- this helps to make loop jumpbacks the heaviest edges\n    increaseBackEdgeWeight :: BlockId -> CFG -> CFG\n    increaseBackEdgeWeight root cfg =\n        let backedges = findBackEdges root cfg\n            update weight\n              --Keep irrelevant edges irrelevant\n              | weight <= 0 = 0\n              | otherwise\n              = weight + fromIntegral (D.backEdgeBonus weights)\n        in  foldl'  (\\cfg edge -> updateEdgeWeight update edge cfg)\n                    cfg backedges\n\n    -- | Since we cant fall through info tables we penalize these.\n    penalizeInfoTables :: LabelMap a -> CFG -> CFG\n    penalizeInfoTables info cfg =\n        mapWeights fupdate cfg\n      where\n        fupdate :: BlockId -> BlockId -> EdgeWeight -> EdgeWeight\n        fupdate _ to weight\n          | mapMember to info\n          = weight - (fromIntegral $ D.infoTablePenalty weights)\n          | otherwise = weight\n\n\n{- Note [Optimize for Fallthrough]\n\n-}\n    -- | If a block has two successors, favour the one with fewer\n    -- predecessors. (As that one is more likely to become a fallthrough)\n    favourFewerPreds :: CFG -> CFG\n    favourFewerPreds cfg =\n        let\n            revCfg =\n              reverseEdges $ filterEdges\n                              (\\_from -> fallthroughTarget)  cfg\n\n            predCount n = length $ getSuccessorEdges revCfg n\n            nodes = getCfgNodes cfg\n\n            modifiers :: Int -> Int -> (EdgeWeight, EdgeWeight)\n            modifiers preds1 preds2\n              | preds1 <  preds2 = ( 1,-1)\n              | preds1 == preds2 = ( 0, 0)\n              | otherwise        = (-1, 1)\n\n            update cfg node\n              | [(s1,e1),(s2,e2)] <- getSuccessorEdges cfg node\n              , w1 <- edgeWeight e1\n              , w2 <- edgeWeight e2\n              --Only change the weights if there isn't already a ordering.\n              , w1 == w2\n              , (mod1,mod2) <- modifiers (predCount s1) (predCount s2)\n              = (\\cfg' ->\n                  (adjustEdgeWeight cfg' (+mod2) node s2))\n                  (adjustEdgeWeight cfg  (+mod1) node s1)\n              | otherwise\n              = cfg\n        in setFoldl update cfg nodes\n      where\n        fallthroughTarget :: BlockId -> EdgeInfo -> Bool\n        fallthroughTarget to (EdgeInfo source _weight)\n          | mapMember to info = False\n          | AsmCodeGen <- source = True\n          | CmmSource (CmmBranch {}) <- source = True\n          | CmmSource (CmmCondBranch {}) <- source = True\n          | otherwise = False\n\n-- | Determine loop membership of blocks based on SCC analysis\n--   Ideally we would replace this with a variant giving us loop\n--   levels instead but the SCC code will do for now.\nloopMembers :: CFG -> LabelMap Bool\nloopMembers cfg =\n    foldl' (flip setLevel) mapEmpty sccs\n  where\n    mkNode :: BlockId -> Node BlockId BlockId\n    mkNode bid = DigraphNode bid bid (getSuccessors cfg bid)\n    nodes = map mkNode (setElems $ getCfgNodes cfg)\n\n    sccs = stronglyConnCompFromEdgedVerticesOrd nodes\n\n    setLevel :: SCC BlockId -> LabelMap Bool -> LabelMap Bool\n    setLevel (AcyclicSCC bid) m = mapInsert bid False m\n    setLevel (CyclicSCC bids) m = foldl' (\\m k -> mapInsert k True m) m bids\n", "num_lines": 652}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Generating C symbol names emitted by the compiler.\nmodule CPrim\n    ( atomicReadLabel\n    , atomicWriteLabel\n    , atomicRMWLabel\n    , cmpxchgLabel\n    , popCntLabel\n    , pdepLabel\n    , pextLabel\n    , bSwapLabel\n    , clzLabel\n    , ctzLabel\n    , word2FloatLabel\n    ) where\n\nimport GhcPrelude\n\nimport CmmType\nimport CmmMachOp\nimport Outputable\n\npopCntLabel :: Width -> String\npopCntLabel w = \"hs_popcnt\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"popCntLabel: Unsupported word width \" (ppr w)\n\npdepLabel :: Width -> String\npdepLabel w = \"hs_pdep\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"pdepLabel: Unsupported word width \" (ppr w)\n\npextLabel :: Width -> String\npextLabel w = \"hs_pext\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"pextLabel: Unsupported word width \" (ppr w)\n\nbSwapLabel :: Width -> String\nbSwapLabel w = \"hs_bswap\" ++ pprWidth w\n  where\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"bSwapLabel: Unsupported word width \" (ppr w)\n\nclzLabel :: Width -> String\nclzLabel w = \"hs_clz\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"clzLabel: Unsupported word width \" (ppr w)\n\nctzLabel :: Width -> String\nctzLabel w = \"hs_ctz\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"ctzLabel: Unsupported word width \" (ppr w)\n\nword2FloatLabel :: Width -> String\nword2FloatLabel w = \"hs_word2float\" ++ pprWidth w\n  where\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"word2FloatLabel: Unsupported word width \" (ppr w)\n\natomicRMWLabel :: Width -> AtomicMachOp -> String\natomicRMWLabel w amop = \"hs_atomic_\" ++ pprFunName amop ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"atomicRMWLabel: Unsupported word width \" (ppr w)\n\n    pprFunName AMO_Add  = \"add\"\n    pprFunName AMO_Sub  = \"sub\"\n    pprFunName AMO_And  = \"and\"\n    pprFunName AMO_Nand = \"nand\"\n    pprFunName AMO_Or   = \"or\"\n    pprFunName AMO_Xor  = \"xor\"\n\ncmpxchgLabel :: Width -> String\ncmpxchgLabel w = \"hs_cmpxchg\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"cmpxchgLabel: Unsupported word width \" (ppr w)\n\natomicReadLabel :: Width -> String\natomicReadLabel w = \"hs_atomicread\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"atomicReadLabel: Unsupported word width \" (ppr w)\n\natomicWriteLabel :: Width -> String\natomicWriteLabel w = \"hs_atomicwrite\" ++ pprWidth w\n  where\n    pprWidth W8  = \"8\"\n    pprWidth W16 = \"16\"\n    pprWidth W32 = \"32\"\n    pprWidth W64 = \"64\"\n    pprWidth w   = pprPanic \"atomicWriteLabel: Unsupported word width \" (ppr w)\n", "num_lines": 124}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Dwarf (\n  dwarfGen\n  ) where\n\nimport GhcPrelude\n\nimport CLabel\nimport CmmExpr         ( GlobalReg(..) )\nimport Config          ( cProjectName, cProjectVersion )\nimport CoreSyn         ( Tickish(..) )\nimport Debug\nimport DynFlags\nimport Module\nimport Outputable\nimport Platform\nimport Unique\nimport UniqSupply\n\nimport Dwarf.Constants\nimport Dwarf.Types\n\nimport Control.Arrow    ( first )\nimport Control.Monad    ( mfilter )\nimport Data.Maybe\nimport Data.List        ( sortBy )\nimport Data.Ord         ( comparing )\nimport qualified Data.Map as Map\nimport System.FilePath\nimport System.Directory ( getCurrentDirectory )\n\nimport qualified Hoopl.Label as H\nimport qualified Hoopl.Collections as H\n\n-- | Generate DWARF/debug information\ndwarfGen :: DynFlags -> ModLocation -> UniqSupply -> [DebugBlock]\n            -> IO (SDoc, UniqSupply)\ndwarfGen _  _      us [] = return (empty, us)\ndwarfGen df modLoc us blocks = do\n\n  -- Convert debug data structures to DWARF info records\n  -- We strip out block information when running with -g0 or -g1.\n  let procs = debugSplitProcs blocks\n      stripBlocks dbg\n        | debugLevel df < 2 = dbg { dblBlocks = [] }\n        | otherwise         = dbg\n  compPath <- getCurrentDirectory\n  let lowLabel = dblCLabel $ head procs\n      highLabel = mkAsmTempEndLabel $ dblCLabel $ last procs\n      dwarfUnit = DwarfCompileUnit\n        { dwChildren = map (procToDwarf df) (map stripBlocks procs)\n        , dwName = fromMaybe \"\" (ml_hs_file modLoc)\n        , dwCompDir = addTrailingPathSeparator compPath\n        , dwProducer = cProjectName ++ \" \" ++ cProjectVersion\n        , dwLowLabel = lowLabel\n        , dwHighLabel = highLabel\n        , dwLineLabel = dwarfLineLabel\n        }\n\n  -- Check whether we have any source code information, so we do not\n  -- end up writing a pointer to an empty .debug_line section\n  -- (dsymutil on Mac Os gets confused by this).\n  let haveSrcIn blk = isJust (dblSourceTick blk) && isJust (dblPosition blk)\n                      || any haveSrcIn (dblBlocks blk)\n      haveSrc = any haveSrcIn procs\n\n  -- .debug_abbrev section: Declare the format we're using\n  let abbrevSct = pprAbbrevDecls haveSrc\n\n  -- .debug_info section: Information records on procedures and blocks\n  let -- unique to identify start and end compilation unit .debug_inf\n      (unitU, us') = takeUniqFromSupply us\n      infoSct = vcat [ ptext dwarfInfoLabel <> colon\n                     , dwarfInfoSection\n                     , compileUnitHeader unitU\n                     , pprDwarfInfo haveSrc dwarfUnit\n                     , compileUnitFooter unitU\n                     ]\n\n  -- .debug_line section: Generated mainly by the assembler, but we\n  -- need to label it\n  let lineSct = dwarfLineSection $$\n                ptext dwarfLineLabel <> colon\n\n  -- .debug_frame section: Information about the layout of the GHC stack\n  let (framesU, us'') = takeUniqFromSupply us'\n      frameSct = dwarfFrameSection $$\n                 ptext dwarfFrameLabel <> colon $$\n                 pprDwarfFrame (debugFrame framesU procs)\n\n  -- .aranges section: Information about the bounds of compilation units\n  let aranges' | gopt Opt_SplitSections df = map mkDwarfARange procs\n               | otherwise                 = [DwarfARange lowLabel highLabel]\n  let aranges = dwarfARangesSection $$ pprDwarfARanges aranges' unitU\n\n  return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')\n\n-- | Build an address range entry for one proc.\n-- With split sections, each proc needs its own entry, since they may get\n-- scattered in the final binary. Without split sections, we could make a\n-- single arange based on the first/last proc.\nmkDwarfARange :: DebugBlock -> DwarfARange\nmkDwarfARange proc = DwarfARange start end\n  where\n    start = dblCLabel proc\n    end = mkAsmTempEndLabel start\n\n-- | Header for a compilation unit, establishing global format\n-- parameters\ncompileUnitHeader :: Unique -> SDoc\ncompileUnitHeader unitU = sdocWithPlatform $ \\plat ->\n  let cuLabel = mkAsmTempLabel unitU  -- sits right before initialLength field\n      length = ppr (mkAsmTempEndLabel cuLabel) <> char '-' <> ppr cuLabel\n               <> text \"-4\"       -- length of initialLength field\n  in vcat [ ppr cuLabel <> colon\n          , text \"\\t.long \" <> length  -- compilation unit size\n          , pprHalf 3                          -- DWARF version\n          , sectionOffset (ptext dwarfAbbrevLabel) (ptext dwarfAbbrevLabel)\n                                               -- abbrevs offset\n          , text \"\\t.byte \" <> ppr (platformWordSize plat) -- word size\n          ]\n\n-- | Compilation unit footer, mainly establishing size of debug sections\ncompileUnitFooter :: Unique -> SDoc\ncompileUnitFooter unitU =\n  let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU\n  in ppr cuEndLabel <> colon\n\n-- | Splits the blocks by procedures. In the result all nested blocks\n-- will come from the same procedure as the top-level block. See\n-- Note [Splitting DebugBlocks] for details.\ndebugSplitProcs :: [DebugBlock] -> [DebugBlock]\ndebugSplitProcs b = concat $ H.mapElems $ mergeMaps $ map (split Nothing) b\n  where mergeMaps = foldr (H.mapUnionWithKey (const (++))) H.mapEmpty\n        split :: Maybe DebugBlock -> DebugBlock -> H.LabelMap [DebugBlock]\n        split parent blk = H.mapInsert prc [blk'] nested\n          where prc = dblProcedure blk\n                blk' = blk { dblBlocks = own_blks\n                           , dblParent = parent\n                           }\n                own_blks = fromMaybe [] $ H.mapLookup prc nested\n                nested = mergeMaps $ map (split parent') $ dblBlocks blk\n                -- Figure out who should be the parent of nested blocks.\n                -- If @blk@ is optimized out then it isn't a good choice\n                -- and we just use its parent.\n                parent'\n                  | Nothing <- dblPosition blk = parent\n                  | otherwise                  = Just blk\n\n{-\nNote [Splitting DebugBlocks]\n\nDWARF requires that we break up the nested DebugBlocks produced from\nthe C-- AST. For instance, we begin with tick trees containing nested procs.\nFor example,\n\n    proc A [tick1, tick2]\n      block B [tick3]\n        proc C [tick4]\n\nwhen producing DWARF we need to procs (which are represented in DWARF as\nTAG_subprogram DIEs) to be top-level DIEs. debugSplitProcs is responsible for\nthis transform, pulling out the nested procs into top-level procs.\n\nHowever, in doing this we need to be careful to preserve the parentage of the\nnested procs. This is the reason DebugBlocks carry the dblParent field, allowing\nus to reorganize the above tree as,\n\n    proc A [tick1, tick2]\n      block B [tick3]\n    proc C [tick4] parent=B\n\nHere we have annotated the new proc C with an attribute giving its original\nparent, B.\n-}\n\n-- | Generate DWARF info for a procedure debug block\nprocToDwarf :: DynFlags -> DebugBlock -> DwarfInfo\nprocToDwarf df prc\n  = DwarfSubprogram { dwChildren = map (blockToDwarf df) (dblBlocks prc)\n                    , dwName     = case dblSourceTick prc of\n                         Just s@SourceNote{} -> sourceName s\n                         _otherwise -> showSDocDump df $ ppr $ dblLabel prc\n                    , dwLabel    = dblCLabel prc\n                    , dwParent   = fmap mkAsmTempDieLabel\n                                   $ mfilter goodParent\n                                   $ fmap dblCLabel (dblParent prc)\n                    }\n  where\n  goodParent a | a == dblCLabel prc = False\n               -- Omit parent if it would be self-referential\n  goodParent a | not (externallyVisibleCLabel a)\n               , debugLevel df < 2 = False\n               -- We strip block information when running -g0 or -g1, don't\n               -- refer to blocks in that case. Fixes #14894.\n  goodParent _ = True\n\n-- | Generate DWARF info for a block\nblockToDwarf :: DynFlags -> DebugBlock -> DwarfInfo\nblockToDwarf df blk\n  = DwarfBlock { dwChildren = concatMap (tickToDwarf df) (dblTicks blk)\n                              ++ map (blockToDwarf df) (dblBlocks blk)\n               , dwLabel    = dblCLabel blk\n               , dwMarker   = marker\n               }\n  where\n    marker\n      | Just _ <- dblPosition blk = Just $ mkAsmTempLabel $ dblLabel blk\n      | otherwise                 = Nothing   -- block was optimized out\n\ntickToDwarf :: DynFlags -> Tickish () -> [DwarfInfo]\ntickToDwarf _  (SourceNote ss _) = [DwarfSrcNote ss]\ntickToDwarf _ _ = []\n\n-- | Generates the data for the debug frame section, which encodes the\n-- desired stack unwind behaviour for the debugger\ndebugFrame :: Unique -> [DebugBlock] -> DwarfFrame\ndebugFrame u procs\n  = DwarfFrame { dwCieLabel = mkAsmTempLabel u\n               , dwCieInit  = initUws\n               , dwCieProcs = map (procToFrame initUws) procs\n               }\n  where\n    initUws :: UnwindTable\n    initUws = Map.fromList [(Sp, Just (UwReg Sp 0))]\n\n-- | Generates unwind information for a procedure debug block\nprocToFrame :: UnwindTable -> DebugBlock -> DwarfFrameProc\nprocToFrame initUws blk\n  = DwarfFrameProc { dwFdeProc    = dblCLabel blk\n                   , dwFdeHasInfo = dblHasInfoTbl blk\n                   , dwFdeBlocks  = map (uncurry blockToFrame)\n                                        (setHasInfo blockUws)\n                   }\n  where blockUws :: [(DebugBlock, [UnwindPoint])]\n        blockUws = map snd $ sortBy (comparing fst) $ flatten blk\n\n        flatten :: DebugBlock\n                -> [(Int, (DebugBlock, [UnwindPoint]))]\n        flatten b@DebugBlock{ dblPosition=pos, dblUnwind=uws, dblBlocks=blocks }\n          | Just p <- pos  = (p, (b, uws')):nested\n          | otherwise      = nested -- block was optimized out\n          where uws'   = addDefaultUnwindings initUws uws\n                nested = concatMap flatten blocks\n\n        -- | If the current procedure has an info table, then we also say that\n        -- its first block has one to ensure that it gets the necessary -1\n        -- offset applied to its start address.\n        -- See Note [Info Offset] in Dwarf.Types.\n        setHasInfo :: [(DebugBlock, [UnwindPoint])]\n                   -> [(DebugBlock, [UnwindPoint])]\n        setHasInfo [] = []\n        setHasInfo (c0:cs) = first setIt c0 : cs\n          where\n            setIt child =\n              child { dblHasInfoTbl = dblHasInfoTbl child\n                                      || dblHasInfoTbl blk }\n\nblockToFrame :: DebugBlock -> [UnwindPoint] -> DwarfFrameBlock\nblockToFrame blk uws\n  = DwarfFrameBlock { dwFdeBlkHasInfo = dblHasInfoTbl blk\n                    , dwFdeUnwind     = uws\n                    }\n\naddDefaultUnwindings :: UnwindTable -> [UnwindPoint] -> [UnwindPoint]\naddDefaultUnwindings tbl pts =\n    [ UnwindPoint lbl (tbl' `mappend` tbl)\n      -- mappend is left-biased\n    | UnwindPoint lbl tbl' <- pts\n    ]\n", "num_lines": 270}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Formats on this architecture\n--      A Format is a combination of width and class\n--\n--      TODO:   Signed vs unsigned?\n--\n--      TODO:   This module is currenly shared by all architectures because\n--              NCGMonad need to know about it to make a VReg. It would be better\n--              to have architecture specific formats, and do the overloading\n--              properly. eg SPARC doesn't care about FF80.\n--\nmodule Format (\n    Format(..),\n    intFormat,\n    floatFormat,\n    isFloatFormat,\n    cmmTypeFormat,\n    formatToWidth,\n    formatInBytes\n)\n\nwhere\n\nimport GhcPrelude\n\nimport Cmm\nimport Outputable\n\n-- It looks very like the old MachRep, but it's now of purely local\n-- significance, here in the native code generator.  You can change it\n-- without global consequences.\n--\n-- A major use is as an opcode qualifier; thus the opcode\n--      mov.l a b\n-- might be encoded\n--      MOV II32 a b\n-- where the Format field encodes the \".l\" part.\n\n-- ToDo: it's not clear to me that we need separate signed-vs-unsigned formats\n--        here.  I've removed them from the x86 version, we'll see what happens --SDM\n\n-- ToDo: quite a few occurrences of Format could usefully be replaced by Width\n\ndata Format\n        = II8\n        | II16\n        | II32\n        | II64\n        | FF32\n        | FF64\n        | FF80\n        deriving (Show, Eq)\n\n\n-- | Get the integer format of this width.\nintFormat :: Width -> Format\nintFormat width\n = case width of\n        W8      -> II8\n        W16     -> II16\n        W32     -> II32\n        W64     -> II64\n        other   -> sorry $ \"The native code generator cannot \" ++\n            \"produce code for Format.intFormat \" ++ show other\n            ++ \"\\n\\tConsider using the llvm backend with -fllvm\"\n\n\n-- | Get the float format of this width.\nfloatFormat :: Width -> Format\nfloatFormat width\n = case width of\n        W32     -> FF32\n        W64     -> FF64\n        W80     -> FF80\n        other   -> pprPanic \"Format.floatFormat\" (ppr other)\n\n\n-- | Check if a format represents a floating point value.\nisFloatFormat :: Format -> Bool\nisFloatFormat format\n = case format of\n        FF32    -> True\n        FF64    -> True\n        FF80    -> True\n        _       -> False\n\n\n-- | Convert a Cmm type to a Format.\ncmmTypeFormat :: CmmType -> Format\ncmmTypeFormat ty\n        | isFloatType ty        = floatFormat (typeWidth ty)\n        | otherwise             = intFormat (typeWidth ty)\n\n\n-- | Get the Width of a Format.\nformatToWidth :: Format -> Width\nformatToWidth format\n = case format of\n        II8             -> W8\n        II16            -> W16\n        II32            -> W32\n        II64            -> W64\n        FF32            -> W32\n        FF64            -> W64\n        FF80            -> W80\n\nformatInBytes :: Format -> Int\nformatInBytes = widthInBytes . formatToWidth\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Instruction (\n        RegUsage(..),\n        noUsage,\n        GenBasicBlock(..), blockId,\n        ListGraph(..),\n        NatCmm,\n        NatCmmDecl,\n        NatBasicBlock,\n        topInfoTable,\n        entryBlocks,\n        Instruction(..)\n)\n\nwhere\n\nimport GhcPrelude\n\nimport Reg\n\nimport BlockId\nimport Hoopl.Collections\nimport Hoopl.Label\nimport DynFlags\nimport Cmm hiding (topInfoTable)\nimport Platform\n\n-- | Holds a list of source and destination registers used by a\n--      particular instruction.\n--\n--   Machine registers that are pre-allocated to stgRegs are filtered\n--      out, because they are uninteresting from a register allocation\n--      standpoint.  (We wouldn't want them to end up on the free list!)\n--\n--   As far as we are concerned, the fixed registers simply don't exist\n--      (for allocation purposes, anyway).\n--\ndata RegUsage\n        = RU [Reg] [Reg]\n\n-- | No regs read or written to.\nnoUsage :: RegUsage\nnoUsage  = RU [] []\n\n-- Our flavours of the Cmm types\n-- Type synonyms for Cmm populated with native code\ntype NatCmm instr\n        = GenCmmGroup\n                CmmStatics\n                (LabelMap CmmStatics)\n                (ListGraph instr)\n\ntype NatCmmDecl statics instr\n        = GenCmmDecl\n                statics\n                (LabelMap CmmStatics)\n                (ListGraph instr)\n\n\ntype NatBasicBlock instr\n        = GenBasicBlock instr\n\n\n-- | Returns the info table associated with the CmmDecl's entry point,\n-- if any.\ntopInfoTable :: GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i\ntopInfoTable (CmmProc infos _ _ (ListGraph (b:_)))\n  = mapLookup (blockId b) infos\ntopInfoTable _\n  = Nothing\n\n-- | Return the list of BlockIds in a CmmDecl that are entry points\n-- for this proc (i.e. they may be jumped to from outside this proc).\nentryBlocks :: GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]\nentryBlocks (CmmProc info _ _ (ListGraph code)) = entries\n  where\n        infos = mapKeys info\n        entries = case code of\n                    [] -> infos\n                    BasicBlock entry _ : _ -- first block is the entry point\n                       | entry `elem` infos -> infos\n                       | otherwise          -> entry : infos\nentryBlocks _ = []\n\n-- | Common things that we can do with instructions, on all architectures.\n--      These are used by the shared parts of the native code generator,\n--      specifically the register allocators.\n--\nclass   Instruction instr where\n\n        -- | Get the registers that are being used by this instruction.\n        --      regUsage doesn't need to do any trickery for jumps and such.\n        --      Just state precisely the regs read and written by that insn.\n        --      The consequences of control flow transfers, as far as register\n        --      allocation goes, are taken care of by the register allocator.\n        --\n        regUsageOfInstr\n                :: Platform\n                -> instr\n                -> RegUsage\n\n\n        -- | Apply a given mapping to all the register references in this\n        --      instruction.\n        patchRegsOfInstr\n                :: instr\n                -> (Reg -> Reg)\n                -> instr\n\n\n        -- | Checks whether this instruction is a jump/branch instruction.\n        --      One that can change the flow of control in a way that the\n        --      register allocator needs to worry about.\n        isJumpishInstr\n                :: instr -> Bool\n\n\n        -- | Give the possible destinations of this jump instruction.\n        --      Must be defined for all jumpish instructions.\n        jumpDestsOfInstr\n                :: instr -> [BlockId]\n\n\n        -- | Change the destination of this jump instruction.\n        --      Used in the linear allocator when adding fixup blocks for join\n        --      points.\n        patchJumpInstr\n                :: instr\n                -> (BlockId -> BlockId)\n                -> instr\n\n\n        -- | An instruction to spill a register into a spill slot.\n        mkSpillInstr\n                :: DynFlags\n                -> Reg          -- ^ the reg to spill\n                -> Int          -- ^ the current stack delta\n                -> Int          -- ^ spill slot to use\n                -> instr\n\n\n        -- | An instruction to reload a register from a spill slot.\n        mkLoadInstr\n                :: DynFlags\n                -> Reg          -- ^ the reg to reload.\n                -> Int          -- ^ the current stack delta\n                -> Int          -- ^ the spill slot to use\n                -> instr\n\n        -- | See if this instruction is telling us the current C stack delta\n        takeDeltaInstr\n                :: instr\n                -> Maybe Int\n\n        -- | Check whether this instruction is some meta thing inserted into\n        --      the instruction stream for other purposes.\n        --\n        --      Not something that has to be treated as a real machine instruction\n        --      and have its registers allocated.\n        --\n        --      eg, comments, delta, ldata, etc.\n        isMetaInstr\n                :: instr\n                -> Bool\n\n\n\n        -- | Copy the value in a register to another one.\n        --      Must work for all register classes.\n        mkRegRegMoveInstr\n                :: Platform\n                -> Reg          -- ^ source register\n                -> Reg          -- ^ destination register\n                -> instr\n\n        -- | Take the source and destination from this reg -> reg move instruction\n        --      or Nothing if it's not one\n        takeRegRegMoveInstr\n                :: instr\n                -> Maybe (Reg, Reg)\n\n        -- | Make an unconditional jump instruction.\n        --      For architectures with branch delay slots, its ok to put\n        --      a NOP after the jump. Don't fill the delay slot with an\n        --      instruction that references regs or you'll confuse the\n        --      linear allocator.\n        mkJumpInstr\n                :: BlockId\n                -> [instr]\n\n\n        -- Subtract an amount from the C stack pointer\n        mkStackAllocInstr\n                :: Platform\n                -> Int\n                -> [instr]\n\n        -- Add an amount to the C stack pointer\n        mkStackDeallocInstr\n                :: Platform\n                -> Int\n                -> [instr]\n", "num_lines": 203}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 1993-2004\n--\n-- The native code generator's monad.\n--\n-- -----------------------------------------------------------------------------\n\nmodule NCGMonad (\n        NcgImpl(..),\n        NatM_State(..), mkNatM_State,\n\n        NatM, -- instance Monad\n        initNat,\n        addImportNat,\n        addNodeBetweenNat,\n        addImmediateSuccessorNat,\n        updateCfgNat,\n        getUniqueNat,\n        mapAccumLNat,\n        setDeltaNat,\n        getDeltaNat,\n        getThisModuleNat,\n        getBlockIdNat,\n        getNewLabelNat,\n        getNewRegNat,\n        getNewRegPairNat,\n        getPicBaseMaybeNat,\n        getPicBaseNat,\n        getDynFlags,\n        getModLoc,\n        getFileId,\n        getDebugBlock,\n\n        DwarfFiles\n)\n\nwhere\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Reg\nimport Format\nimport TargetReg\n\nimport BlockId\nimport Hoopl.Collections\nimport Hoopl.Label\nimport CLabel           ( CLabel )\nimport Debug\nimport FastString       ( FastString )\nimport UniqFM\nimport UniqSupply\nimport Unique           ( Unique )\nimport DynFlags\nimport Module\n\nimport Control.Monad    ( liftM, ap )\n\nimport Instruction\nimport Outputable (SDoc, pprPanic, ppr)\nimport Cmm (RawCmmDecl, CmmStatics)\nimport CFG\n\ndata NcgImpl statics instr jumpDest = NcgImpl {\n    cmmTopCodeGen             :: RawCmmDecl -> NatM [NatCmmDecl statics instr],\n    generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr),\n    getJumpDestBlockId        :: jumpDest -> Maybe BlockId,\n    canShortcut               :: instr -> Maybe jumpDest,\n    shortcutStatics           :: (BlockId -> Maybe jumpDest) -> statics -> statics,\n    shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,\n    pprNatCmmDecl             :: NatCmmDecl statics instr -> SDoc,\n    maxSpillSlots             :: Int,\n    allocatableRegs           :: [RealReg],\n    ncg_x86fp_kludge          :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],\n    ncgExpandTop              :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],\n    ncgAllocMoreStack         :: Int -> NatCmmDecl statics instr\n                              -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)]),\n    -- ^ The list of block ids records the redirected jumps to allow us to update\n    -- the CFG.\n    ncgMakeFarBranches        :: LabelMap CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr],\n    extractUnwindPoints       :: [instr] -> [UnwindPoint],\n    -- ^ given the instruction sequence of a block, produce a list of\n    -- the block's 'UnwindPoint's\n    -- See Note [What is this unwinding business?] in Debug\n    -- and Note [Unwinding information in the NCG] in this module.\n    invertCondBranches        :: CFG -> LabelMap CmmStatics -> [NatBasicBlock instr]\n                              -> [NatBasicBlock instr]\n    -- ^ Turn the sequence of `jcc l1; jmp l2` into `jncc l2; <block_l1>`\n    -- when possible.\n    }\n\ndata NatM_State\n        = NatM_State {\n                natm_us          :: UniqSupply,\n                natm_delta       :: Int,\n                natm_imports     :: [(CLabel)],\n                natm_pic         :: Maybe Reg,\n                natm_dflags      :: DynFlags,\n                natm_this_module :: Module,\n                natm_modloc      :: ModLocation,\n                natm_fileid      :: DwarfFiles,\n                natm_debug_map   :: LabelMap DebugBlock,\n                natm_cfg         :: CFG\n        -- ^ Having a CFG with additional information is essential for some\n        -- operations. However we can't reconstruct all information once we\n        -- generated instructions. So instead we update the CFG as we go.\n        }\n\ntype DwarfFiles = UniqFM (FastString, Int)\n\nnewtype NatM result = NatM (NatM_State -> (result, NatM_State))\n\nunNat :: NatM a -> NatM_State -> (a, NatM_State)\nunNat (NatM a) = a\n\nmkNatM_State :: UniqSupply -> Int -> DynFlags -> Module -> ModLocation ->\n                DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State\nmkNatM_State us delta dflags this_mod\n        = \\loc dwf dbg cfg ->\n                NatM_State\n                        { natm_us = us\n                        , natm_delta = delta\n                        , natm_imports = []\n                        , natm_pic = Nothing\n                        , natm_dflags = dflags\n                        , natm_this_module = this_mod\n                        , natm_modloc = loc\n                        , natm_fileid = dwf\n                        , natm_debug_map = dbg\n                        , natm_cfg = cfg\n                        }\n\ninitNat :: NatM_State -> NatM a -> (a, NatM_State)\ninitNat init_st m\n        = case unNat m init_st of { (r,st) -> (r,st) }\n\ninstance Functor NatM where\n      fmap = liftM\n\ninstance Applicative NatM where\n      pure = returnNat\n      (<*>) = ap\n\ninstance Monad NatM where\n  (>>=) = thenNat\n\ninstance MonadUnique NatM where\n  getUniqueSupplyM = NatM $ \\st ->\n      case splitUniqSupply (natm_us st) of\n          (us1, us2) -> (us1, st {natm_us = us2})\n\n  getUniqueM = NatM $ \\st ->\n      case takeUniqFromSupply (natm_us st) of\n          (uniq, us') -> (uniq, st {natm_us = us'})\n\nthenNat :: NatM a -> (a -> NatM b) -> NatM b\nthenNat expr cont\n        = NatM $ \\st -> case unNat expr st of\n                        (result, st') -> unNat (cont result) st'\n\nreturnNat :: a -> NatM a\nreturnNat result\n        = NatM $ \\st ->  (result, st)\n\nmapAccumLNat :: (acc -> x -> NatM (acc, y))\n                -> acc\n                -> [x]\n                -> NatM (acc, [y])\n\nmapAccumLNat _ b []\n  = return (b, [])\nmapAccumLNat f b (x:xs)\n  = do (b__2, x__2)  <- f b x\n       (b__3, xs__2) <- mapAccumLNat f b__2 xs\n       return (b__3, x__2:xs__2)\n\ngetUniqueNat :: NatM Unique\ngetUniqueNat = NatM $ \\ st ->\n    case takeUniqFromSupply $ natm_us st of\n    (uniq, us') -> (uniq, st {natm_us = us'})\n\ninstance HasDynFlags NatM where\n    getDynFlags = NatM $ \\ st -> (natm_dflags st, st)\n\n\ngetDeltaNat :: NatM Int\ngetDeltaNat = NatM $ \\ st -> (natm_delta st, st)\n\n\nsetDeltaNat :: Int -> NatM ()\nsetDeltaNat delta = NatM $ \\ st -> ((), st {natm_delta = delta})\n\n\ngetThisModuleNat :: NatM Module\ngetThisModuleNat = NatM $ \\ st -> (natm_this_module st, st)\n\n\naddImportNat :: CLabel -> NatM ()\naddImportNat imp\n        = NatM $ \\ st -> ((), st {natm_imports = imp : natm_imports st})\n\nupdateCfgNat :: (CFG -> CFG) -> NatM ()\nupdateCfgNat f\n        = NatM $ \\ st -> ((), st { natm_cfg = f (natm_cfg st) })\n\n-- | Record that we added a block between `from` and `old`.\naddNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM ()\naddNodeBetweenNat from between to\n = do   df <- getDynFlags\n        let jmpWeight = fromIntegral . uncondWeight .\n                        cfgWeightInfo $ df\n        updateCfgNat (updateCfg jmpWeight from between to)\n  where\n    -- When transforming A -> B to A -> A' -> B\n    -- A -> A' keeps the old edge info while\n    -- A' -> B gets the info for an unconditional\n    -- jump.\n    updateCfg weight from between old m\n        | Just info <- getEdgeInfo from old m\n        = addEdge from between info .\n          addWeightEdge between old weight .\n          delEdge from old $ m\n        | otherwise\n        = pprPanic \"Faild to update cfg: Untracked edge\" (ppr (from,to))\n\n\n-- | Place `succ` after `block` and change any edges\n--   block -> X to `succ` -> X\naddImmediateSuccessorNat :: BlockId -> BlockId -> NatM ()\naddImmediateSuccessorNat block succ\n        = updateCfgNat (addImmediateSuccessor block succ)\n\ngetBlockIdNat :: NatM BlockId\ngetBlockIdNat\n = do   u <- getUniqueNat\n        return (mkBlockId u)\n\n\ngetNewLabelNat :: NatM CLabel\ngetNewLabelNat\n = blockLbl <$> getBlockIdNat\n\n\ngetNewRegNat :: Format -> NatM Reg\ngetNewRegNat rep\n = do u <- getUniqueNat\n      dflags <- getDynFlags\n      return (RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep)\n\n\ngetNewRegPairNat :: Format -> NatM (Reg,Reg)\ngetNewRegPairNat rep\n = do u <- getUniqueNat\n      dflags <- getDynFlags\n      let vLo = targetMkVirtualReg (targetPlatform dflags) u rep\n      let lo  = RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep\n      let hi  = RegVirtual $ getHiVirtualRegFromLo vLo\n      return (lo, hi)\n\n\ngetPicBaseMaybeNat :: NatM (Maybe Reg)\ngetPicBaseMaybeNat\n        = NatM (\\state -> (natm_pic state, state))\n\n\ngetPicBaseNat :: Format -> NatM Reg\ngetPicBaseNat rep\n = do   mbPicBase <- getPicBaseMaybeNat\n        case mbPicBase of\n                Just picBase -> return picBase\n                Nothing\n                 -> do\n                        reg <- getNewRegNat rep\n                        NatM (\\state -> (reg, state { natm_pic = Just reg }))\n\ngetModLoc :: NatM ModLocation\ngetModLoc\n        = NatM $ \\ st -> (natm_modloc st, st)\n\ngetFileId :: FastString -> NatM Int\ngetFileId f = NatM $ \\st ->\n  case lookupUFM (natm_fileid st) f of\n    Just (_,n) -> (n, st)\n    Nothing    -> let n = 1 + sizeUFM (natm_fileid st)\n                      fids = addToUFM (natm_fileid st) f (f,n)\n                  in n `seq` fids `seq` (n, st { natm_fileid = fids  })\n\ngetDebugBlock :: Label -> NatM (Maybe DebugBlock)\ngetDebugBlock l = NatM $ \\st -> (mapLookup l (natm_debug_map st), st)\n", "num_lines": 295}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n  This module handles generation of position independent code and\n  dynamic-linking related issues for the native code generator.\n\n  This depends both the architecture and OS, so we define it here\n  instead of in one of the architecture specific modules.\n\n  Things outside this module which are related to this:\n\n  + module CLabel\n    - PIC base label (pretty printed as local label 1)\n    - DynamicLinkerLabels - several kinds:\n        CodeStub, SymbolPtr, GotSymbolPtr, GotSymbolOffset\n    - labelDynamic predicate\n  + module Cmm\n    - The GlobalReg datatype has a PicBaseReg constructor\n    - The CmmLit datatype has a CmmLabelDiffOff constructor\n  + codeGen & RTS\n    - When tablesNextToCode, no absolute addresses are stored in info tables\n      any more. Instead, offsets from the info label are used.\n    - For Win32 only, SRTs might contain addresses of __imp_ symbol pointers\n      because Win32 doesn't support external references in data sections.\n      TODO: make sure this still works, it might be bitrotted\n  + NCG\n    - The cmmToCmm pass in AsmCodeGen calls cmmMakeDynamicReference for all\n      labels.\n    - nativeCodeGen calls pprImportedSymbol and pprGotDeclaration to output\n      all the necessary stuff for imported symbols.\n    - The NCG monad keeps track of a list of imported symbols.\n    - MachCodeGen invokes initializePicBase to generate code to initialize\n      the PIC base register when needed.\n    - MachCodeGen calls cmmMakeDynamicReference whenever it uses a CLabel\n      that wasn't in the original Cmm code (e.g. floating point literals).\n-}\n\nmodule PIC (\n        cmmMakeDynamicReference,\n        CmmMakeDynamicReferenceM(..),\n        ReferenceKind(..),\n        needImportedSymbols,\n        pprImportedSymbol,\n        pprGotDeclaration,\n\n        initializePicBase_ppc,\n        initializePicBase_x86\n)\n\nwhere\n\nimport GhcPrelude\n\nimport qualified PPC.Instr      as PPC\nimport qualified PPC.Regs       as PPC\n\nimport qualified X86.Instr      as X86\n\nimport Platform\nimport Instruction\nimport Reg\nimport NCGMonad\n\n\nimport Hoopl.Collections\nimport Cmm\nimport CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,\n                          mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),\n                          dynamicLinkerLabelInfo, mkPicBaseLabel,\n                          labelDynamic, externallyVisibleCLabel )\n\nimport CLabel           ( mkForeignLabel )\n\n\nimport BasicTypes\nimport Module\n\nimport Outputable\n\nimport DynFlags\nimport FastString\n\n\n\n--------------------------------------------------------------------------------\n-- It gets called by the cmmToCmm pass for every CmmLabel in the Cmm\n-- code. It does The Right Thing(tm) to convert the CmmLabel into a\n-- position-independent, dynamic-linking-aware reference to the thing\n-- in question.\n-- Note that this also has to be called from MachCodeGen in order to\n-- access static data like floating point literals (labels that were\n-- created after the cmmToCmm pass).\n-- The function must run in a monad that can keep track of imported symbols\n-- A function for recording an imported symbol must be passed in:\n-- - addImportCmmOpt for the CmmOptM monad\n-- - addImportNat for the NatM monad.\n\ndata ReferenceKind\n        = DataReference\n        | CallReference\n        | JumpReference\n        deriving(Eq)\n\nclass Monad m => CmmMakeDynamicReferenceM m where\n    addImport :: CLabel -> m ()\n    getThisModule :: m Module\n\ninstance CmmMakeDynamicReferenceM NatM where\n    addImport = addImportNat\n    getThisModule = getThisModuleNat\n\ncmmMakeDynamicReference\n  :: CmmMakeDynamicReferenceM m\n  => DynFlags\n  -> ReferenceKind     -- whether this is the target of a jump\n  -> CLabel            -- the label\n  -> m CmmExpr\n\ncmmMakeDynamicReference dflags referenceKind lbl\n  | Just _ <- dynamicLinkerLabelInfo lbl\n  = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through\n\n  | otherwise\n  = do this_mod <- getThisModule\n       case howToAccessLabel\n                dflags\n                (platformArch $ targetPlatform dflags)\n                (platformOS   $ targetPlatform dflags)\n                this_mod\n                referenceKind lbl of\n\n        AccessViaStub -> do\n              let stub = mkDynamicLinkerLabel CodeStub lbl\n              addImport stub\n              return $ CmmLit $ CmmLabel stub\n\n        AccessViaSymbolPtr -> do\n              let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl\n              addImport symbolPtr\n              return $ CmmLoad (cmmMakePicReference dflags symbolPtr) (bWord dflags)\n\n        AccessDirectly -> case referenceKind of\n                -- for data, we might have to make some calculations:\n              DataReference -> return $ cmmMakePicReference dflags lbl\n                -- all currently supported processors support\n                -- PC-relative branch and call instructions,\n                -- so just jump there if it's a call or a jump\n              _ -> return $ CmmLit $ CmmLabel lbl\n\n\n-- -----------------------------------------------------------------------------\n-- Create a position independent reference to a label.\n-- (but do not bother with dynamic linking).\n-- We calculate the label's address by adding some (platform-dependent)\n-- offset to our base register; this offset is calculated by\n-- the function picRelative in the platform-dependent part below.\n\ncmmMakePicReference :: DynFlags -> CLabel -> CmmExpr\ncmmMakePicReference dflags lbl\n\n        -- Windows doesn't need PIC,\n        -- everything gets relocated at runtime\n        | OSMinGW32 <- platformOS $ targetPlatform dflags\n        = CmmLit $ CmmLabel lbl\n\n        | OSAIX <- platformOS $ targetPlatform dflags\n        = CmmMachOp (MO_Add W32)\n                [ CmmReg (CmmGlobal PicBaseReg)\n                , CmmLit $ picRelative dflags\n                                (platformArch   $ targetPlatform dflags)\n                                (platformOS     $ targetPlatform dflags)\n                                lbl ]\n\n        -- both ABI versions default to medium code model\n        | ArchPPC_64 _ <- platformArch $ targetPlatform dflags\n        = CmmMachOp (MO_Add W32) -- code model medium\n                [ CmmReg (CmmGlobal PicBaseReg)\n                , CmmLit $ picRelative dflags\n                                (platformArch   $ targetPlatform dflags)\n                                (platformOS     $ targetPlatform dflags)\n                                lbl ]\n\n        | (positionIndependent dflags || gopt Opt_ExternalDynamicRefs dflags)\n            && absoluteLabel lbl\n        = CmmMachOp (MO_Add (wordWidth dflags))\n                [ CmmReg (CmmGlobal PicBaseReg)\n                , CmmLit $ picRelative dflags\n                                (platformArch   $ targetPlatform dflags)\n                                (platformOS     $ targetPlatform dflags)\n                                lbl ]\n\n        | otherwise\n        = CmmLit $ CmmLabel lbl\n\n\nabsoluteLabel :: CLabel -> Bool\nabsoluteLabel lbl\n = case dynamicLinkerLabelInfo lbl of\n        Just (GotSymbolPtr, _)    -> False\n        Just (GotSymbolOffset, _) -> False\n        _                         -> True\n\n\n--------------------------------------------------------------------------------\n-- Knowledge about how special dynamic linker labels like symbol\n-- pointers, code stubs and GOT offsets look like is located in the\n-- module CLabel.\n\n-- We have to decide which labels need to be accessed\n-- indirectly or via a piece of stub code.\ndata LabelAccessStyle\n        = AccessViaStub\n        | AccessViaSymbolPtr\n        | AccessDirectly\n\nhowToAccessLabel\n        :: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle\n\n\n-- Windows\n-- In Windows speak, a \"module\" is a set of objects linked into the\n-- same Portable Exectuable (PE) file. (both .exe and .dll files are PEs).\n--\n-- If we're compiling a multi-module program then symbols from other modules\n-- are accessed by a symbol pointer named __imp_SYMBOL. At runtime we have the\n-- following.\n--\n--   (in the local module)\n--     __imp_SYMBOL: addr of SYMBOL\n--\n--   (in the other module)\n--     SYMBOL: the real function / data.\n--\n-- To access the function at SYMBOL from our local module, we just need to\n-- dereference the local __imp_SYMBOL.\n--\n-- If not compiling with -dynamic we assume that all our code will be linked\n-- into the same .exe file. In this case we always access symbols directly,\n-- and never use __imp_SYMBOL.\n--\nhowToAccessLabel dflags _ OSMinGW32 this_mod _ lbl\n\n        -- Assume all symbols will be in the same PE, so just access them directly.\n        | not (gopt Opt_ExternalDynamicRefs dflags)\n        = AccessDirectly\n\n        -- If the target symbol is in another PE we need to access it via the\n        --      appropriate __imp_SYMBOL pointer.\n        | labelDynamic dflags this_mod lbl\n        = AccessViaSymbolPtr\n\n        -- Target symbol is in the same PE as the caller, so just access it directly.\n        | otherwise\n        = AccessDirectly\n\n\n-- Mach-O (Darwin, Mac OS X)\n--\n-- Indirect access is required in the following cases:\n--  * things imported from a dynamic library\n--  * (not on x86_64) data from a different module, if we're generating PIC code\n-- It is always possible to access something indirectly,\n-- even when it's not necessary.\n--\nhowToAccessLabel dflags arch OSDarwin this_mod DataReference lbl\n        -- data access to a dynamic library goes via a symbol pointer\n        | labelDynamic dflags this_mod lbl\n        = AccessViaSymbolPtr\n\n        -- when generating PIC code, all cross-module data references must\n        -- must go via a symbol pointer, too, because the assembler\n        -- cannot generate code for a label difference where one\n        -- label is undefined. Doesn't apply t x86_64.\n        -- Unfortunately, we don't know whether it's cross-module,\n        -- so we do it for all externally visible labels.\n        -- This is a slight waste of time and space, but otherwise\n        -- we'd need to pass the current Module all the way in to\n        -- this function.\n        | arch /= ArchX86_64\n        , positionIndependent dflags && externallyVisibleCLabel lbl\n        = AccessViaSymbolPtr\n\n        | otherwise\n        = AccessDirectly\n\nhowToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl\n        -- dyld code stubs don't work for tailcalls because the\n        -- stack alignment is only right for regular calls.\n        -- Therefore, we have to go via a symbol pointer:\n        | arch == ArchX86 || arch == ArchX86_64\n        , labelDynamic dflags this_mod lbl\n        = AccessViaSymbolPtr\n\n\nhowToAccessLabel dflags arch OSDarwin this_mod _ lbl\n        -- Code stubs are the usual method of choice for imported code;\n        -- not needed on x86_64 because Apple's new linker, ld64, generates\n        -- them automatically.\n        | arch /= ArchX86_64\n        , labelDynamic dflags this_mod lbl\n        = AccessViaStub\n\n        | otherwise\n        = AccessDirectly\n\n\n----------------------------------------------------------------------------\n-- AIX\n\n-- quite simple (for now)\nhowToAccessLabel _dflags _arch OSAIX _this_mod kind _lbl\n        = case kind of\n            DataReference -> AccessViaSymbolPtr\n            CallReference -> AccessDirectly\n            JumpReference -> AccessDirectly\n\n-- ELF (Linux)\n--\n-- ELF tries to pretend to the main application code that dynamic linking does\n-- not exist. While this may sound convenient, it tends to mess things up in\n-- very bad ways, so we have to be careful when we generate code for a non-PIE\n-- main program (-dynamic but no -fPIC).\n--\n-- Indirect access is required for references to imported symbols\n-- from position independent code. It is also required from the main program\n-- when dynamic libraries containing Haskell code are used.\n\nhowToAccessLabel _ (ArchPPC_64 _) os _ kind _\n        | osElfTarget os\n        = case kind of\n          -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC\n          DataReference -> AccessViaSymbolPtr\n          -- RTLD does not generate stubs for function descriptors\n          -- in tail calls. Create a symbol pointer and generate\n          -- the code to load the function descriptor at the call site.\n          JumpReference -> AccessViaSymbolPtr\n          -- regular calls are handled by the runtime linker\n          _             -> AccessDirectly\n\nhowToAccessLabel dflags _ os _ _ _\n        -- no PIC -> the dynamic linker does everything for us;\n        --           if we don't dynamically link to Haskell code,\n        --           it actually manages to do so without messing things up.\n        | osElfTarget os\n        , not (positionIndependent dflags) &&\n          not (gopt Opt_ExternalDynamicRefs dflags)\n        = AccessDirectly\n\nhowToAccessLabel dflags arch os this_mod DataReference lbl\n        | osElfTarget os\n        = case () of\n            -- A dynamic label needs to be accessed via a symbol pointer.\n          _ | labelDynamic dflags this_mod lbl\n            -> AccessViaSymbolPtr\n\n            -- For PowerPC32 -fPIC, we have to access even static data\n            -- via a symbol pointer (see below for an explanation why\n            -- PowerPC32 Linux is especially broken).\n            | arch == ArchPPC\n            , positionIndependent dflags\n            -> AccessViaSymbolPtr\n\n            | otherwise\n            -> AccessDirectly\n\n\n        -- In most cases, we have to avoid symbol stubs on ELF, for the following reasons:\n        --   on i386, the position-independent symbol stubs in the Procedure Linkage Table\n        --   require the address of the GOT to be loaded into register %ebx on entry.\n        --   The linker will take any reference to the symbol stub as a hint that\n        --   the label in question is a code label. When linking executables, this\n        --   will cause the linker to replace even data references to the label with\n        --   references to the symbol stub.\n\n        -- This leaves calling a (foreign) function from non-PIC code\n        -- (AccessDirectly, because we get an implicit symbol stub)\n        -- and calling functions from PIC code on non-i386 platforms (via a symbol stub)\n\nhowToAccessLabel dflags arch os this_mod CallReference lbl\n        | osElfTarget os\n        , labelDynamic dflags this_mod lbl && not (positionIndependent dflags)\n        = AccessDirectly\n\n        | osElfTarget os\n        , arch /= ArchX86\n        , labelDynamic dflags this_mod lbl\n        , positionIndependent dflags\n        = AccessViaStub\n\nhowToAccessLabel dflags _ os this_mod _ lbl\n        | osElfTarget os\n        = if labelDynamic dflags this_mod lbl\n            then AccessViaSymbolPtr\n            else AccessDirectly\n\n-- all other platforms\nhowToAccessLabel dflags _ _ _ _ _\n        | not (positionIndependent dflags)\n        = AccessDirectly\n\n        | otherwise\n        = panic \"howToAccessLabel: PIC not defined for this platform\"\n\n\n\n-- -------------------------------------------------------------------\n-- | Says what we have to add to our 'PIC base register' in order to\n--      get the address of a label.\n\npicRelative :: DynFlags -> Arch -> OS -> CLabel -> CmmLit\n\n-- Darwin, but not x86_64:\n-- The PIC base register points to the PIC base label at the beginning\n-- of the current CmmDecl. We just have to use a label difference to\n-- get the offset.\n-- We have already made sure that all labels that are not from the current\n-- module are accessed indirectly ('as' can't calculate differences between\n-- undefined labels).\npicRelative dflags arch OSDarwin lbl\n        | arch /= ArchX86_64\n        = CmmLabelDiffOff lbl mkPicBaseLabel 0 (wordWidth dflags)\n\n-- On AIX we use an indirect local TOC anchored by 'gotLabel'.\n-- This way we use up only one global TOC entry per compilation-unit\n-- (this is quite similiar to GCC's @-mminimal-toc@ compilation mode)\npicRelative dflags _ OSAIX lbl\n        = CmmLabelDiffOff lbl gotLabel 0 (wordWidth dflags)\n\n-- PowerPC Linux:\n-- The PIC base register points to our fake GOT. Use a label difference\n-- to get the offset.\n-- We have made sure that *everything* is accessed indirectly, so this\n-- is only used for offsets from the GOT to symbol pointers inside the\n-- GOT.\npicRelative dflags ArchPPC os lbl\n        | osElfTarget os\n        = CmmLabelDiffOff lbl gotLabel 0 (wordWidth dflags)\n\n\n-- Most Linux versions:\n-- The PIC base register points to the GOT. Use foo@got for symbol\n-- pointers, and foo@gotoff for everything else.\n-- Linux and Darwin on x86_64:\n-- The PIC base register is %rip, we use foo@gotpcrel for symbol pointers,\n-- and a GotSymbolOffset label for other things.\n-- For reasons of tradition, the symbol offset label is written as a plain label.\npicRelative _ arch os lbl\n        | osElfTarget os || (os == OSDarwin && arch == ArchX86_64)\n        = let   result\n                        | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl\n                        = CmmLabel $ mkDynamicLinkerLabel GotSymbolPtr lbl'\n\n                        | otherwise\n                        = CmmLabel $ mkDynamicLinkerLabel GotSymbolOffset lbl\n\n          in    result\n\npicRelative _ _ _ _\n        = panic \"PositionIndependentCode.picRelative undefined for this platform\"\n\n\n\n--------------------------------------------------------------------------------\n\nneedImportedSymbols :: DynFlags -> Arch -> OS -> Bool\nneedImportedSymbols dflags arch os\n        | os    == OSDarwin\n        , arch  /= ArchX86_64\n        = True\n\n        | os    == OSAIX\n        = True\n\n        -- PowerPC Linux: -fPIC or -dynamic\n        | osElfTarget os\n        , arch  == ArchPPC\n        = positionIndependent dflags || gopt Opt_ExternalDynamicRefs dflags\n\n        -- PowerPC 64 Linux: always\n        | osElfTarget os\n        , arch == ArchPPC_64 ELF_V1 || arch == ArchPPC_64 ELF_V2\n        = True\n\n        -- i386 (and others?): -dynamic but not -fPIC\n        | osElfTarget os\n        , arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2\n        = gopt Opt_ExternalDynamicRefs dflags &&\n          not (positionIndependent dflags)\n\n        | otherwise\n        = False\n\n-- gotLabel\n-- The label used to refer to our \"fake GOT\" from\n-- position-independent code.\ngotLabel :: CLabel\ngotLabel\n        -- HACK: this label isn't really foreign\n        = mkForeignLabel\n                (fsLit \".LCTOC1\")\n                Nothing ForeignLabelInThisPackage IsData\n\n\n\n--------------------------------------------------------------------------------\n-- We don't need to declare any offset tables.\n-- However, for PIC on x86, we need a small helper function.\npprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc\npprGotDeclaration dflags ArchX86 OSDarwin\n        | positionIndependent dflags\n        = vcat [\n                text \".section __TEXT,__textcoal_nt,coalesced,no_toc\",\n                text \".weak_definition ___i686.get_pc_thunk.ax\",\n                text \".private_extern ___i686.get_pc_thunk.ax\",\n                text \"___i686.get_pc_thunk.ax:\",\n                text \"\\tmovl (%esp), %eax\",\n                text \"\\tret\" ]\n\npprGotDeclaration _ _ OSDarwin\n        = empty\n\n-- Emit XCOFF TOC section\npprGotDeclaration _ _ OSAIX\n        = vcat $ [ text \".toc\"\n                 , text \".tc ghc_toc_table[TC],.LCTOC1\"\n                 , text \".csect ghc_toc_table[RW]\"\n                   -- See Note [.LCTOC1 in PPC PIC code]\n                 , text \".set .LCTOC1,$+0x8000\"\n                 ]\n\n\n-- PPC 64 ELF v1 needs a Table Of Contents (TOC)\npprGotDeclaration _ (ArchPPC_64 ELF_V1) _\n        = text \".section \\\".toc\\\",\\\"aw\\\"\"\n-- In ELF v2 we also need to tell the assembler that we want ABI\n-- version 2. This would normally be done at the top of the file\n-- right after a file directive, but I could not figure out how\n-- to do that.\npprGotDeclaration _ (ArchPPC_64 ELF_V2) _\n        = vcat [ text \".abiversion 2\",\n                 text \".section \\\".toc\\\",\\\"aw\\\"\"\n               ]\n\n-- Emit GOT declaration\n-- Output whatever needs to be output once per .s file.\npprGotDeclaration dflags arch os\n        | osElfTarget os\n        , arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2\n        , not (positionIndependent dflags)\n        = empty\n\n        | osElfTarget os\n        , arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2\n        = vcat [\n                -- See Note [.LCTOC1 in PPC PIC code]\n                text \".section \\\".got2\\\",\\\"aw\\\"\",\n                text \".LCTOC1 = .+32768\" ]\n\npprGotDeclaration _ _ _\n        = panic \"pprGotDeclaration: no match\"\n\n\n--------------------------------------------------------------------------------\n-- On Darwin, we have to generate our own stub code for lazy binding..\n-- For each processor architecture, there are two versions, one for PIC\n-- and one for non-PIC.\n--\n\npprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc\npprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl\n        | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl\n        = case positionIndependent dflags of\n           False ->\n            vcat [\n                text \".symbol_stub\",\n                text \"L\" <> pprCLabel platform lbl <> ptext (sLit \"$stub:\"),\n                    text \"\\t.indirect_symbol\" <+> pprCLabel platform lbl,\n                    text \"\\tjmp *L\" <> pprCLabel platform lbl\n                        <> text \"$lazy_ptr\",\n                text \"L\" <> pprCLabel platform lbl\n                    <> text \"$stub_binder:\",\n                    text \"\\tpushl $L\" <> pprCLabel platform lbl\n                        <> text \"$lazy_ptr\",\n                    text \"\\tjmp dyld_stub_binding_helper\"\n            ]\n           True ->\n            vcat [\n                text \".section __TEXT,__picsymbolstub2,\"\n                    <> text \"symbol_stubs,pure_instructions,25\",\n                text \"L\" <> pprCLabel platform lbl <> ptext (sLit \"$stub:\"),\n                    text \"\\t.indirect_symbol\" <+> pprCLabel platform lbl,\n                    text \"\\tcall ___i686.get_pc_thunk.ax\",\n                text \"1:\",\n                    text \"\\tmovl L\" <> pprCLabel platform lbl\n                        <> text \"$lazy_ptr-1b(%eax),%edx\",\n                    text \"\\tjmp *%edx\",\n                text \"L\" <> pprCLabel platform lbl\n                    <> text \"$stub_binder:\",\n                    text \"\\tlea L\" <> pprCLabel platform lbl\n                        <> text \"$lazy_ptr-1b(%eax),%eax\",\n                    text \"\\tpushl %eax\",\n                    text \"\\tjmp dyld_stub_binding_helper\"\n            ]\n          $+$ vcat [        text \".section __DATA, __la_sym_ptr\"\n                    <> (if positionIndependent dflags then int 2 else int 3)\n                    <> text \",lazy_symbol_pointers\",\n                text \"L\" <> pprCLabel platform lbl <> ptext (sLit \"$lazy_ptr:\"),\n                    text \"\\t.indirect_symbol\" <+> pprCLabel platform lbl,\n                    text \"\\t.long L\" <> pprCLabel platform lbl\n                    <> text \"$stub_binder\"]\n\n        | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl\n        = vcat [\n                text \".non_lazy_symbol_pointer\",\n                char 'L' <> pprCLabel platform lbl <> text \"$non_lazy_ptr:\",\n                text \"\\t.indirect_symbol\" <+> pprCLabel platform lbl,\n                text \"\\t.long\\t0\"]\n\n        | otherwise\n        = empty\n\n\npprImportedSymbol _ (Platform { platformOS = OSDarwin }) _\n        = empty\n\n-- XCOFF / AIX\n--\n-- Similiar to PPC64 ELF v1, there's dedicated TOC register (r2). To\n-- workaround the limitation of a global TOC we use an indirect TOC\n-- with the label `ghc_toc_table`.\n--\n-- See also GCC's `-mminimal-toc` compilation mode or\n-- http://www.ibm.com/developerworks/rational/library/overview-toc-aix/\n--\n-- NB: No DSO-support yet\n\npprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl\n        = case dynamicLinkerLabelInfo importedLbl of\n            Just (SymbolPtr, lbl)\n              -> vcat [\n                   text \"LC..\" <> pprCLabel platform lbl <> char ':',\n                   text \"\\t.long\" <+> pprCLabel platform lbl ]\n            _ -> empty\n\n-- ELF / Linux\n--\n-- In theory, we don't need to generate any stubs or symbol pointers\n-- by hand for Linux.\n--\n-- Reality differs from this in two areas.\n--\n-- 1) If we just use a dynamically imported symbol directly in a read-only\n--    section of the main executable (as GCC does), ld generates R_*_COPY\n--    relocations, which are fundamentally incompatible with reversed info\n--    tables. Therefore, we need a table of imported addresses in a writable\n--    section.\n--    The \"official\" GOT mechanism (label@got) isn't intended to be used\n--    in position dependent code, so we have to create our own \"fake GOT\"\n--    when not Opt_PIC && WayDyn `elem` ways dflags.\n--\n-- 2) PowerPC Linux is just plain broken.\n--    While it's theoretically possible to use GOT offsets larger\n--    than 16 bit, the standard crt*.o files don't, which leads to\n--    linker errors as soon as the GOT size exceeds 16 bit.\n--    Also, the assembler doesn't support @gotoff labels.\n--    In order to be able to use a larger GOT, we have to circumvent the\n--    entire GOT mechanism and do it ourselves (this is also what GCC does).\n\n\n-- When needImportedSymbols is defined,\n-- the NCG will keep track of all DynamicLinkerLabels it uses\n-- and output each of them using pprImportedSymbol.\n\npprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 _ })\n                  importedLbl\n        | osElfTarget (platformOS platform)\n        = case dynamicLinkerLabelInfo importedLbl of\n            Just (SymbolPtr, lbl)\n              -> vcat [\n                   text \".section \\\".toc\\\", \\\"aw\\\"\",\n                   text \".LC_\" <> pprCLabel platform lbl <> char ':',\n                   text \"\\t.quad\" <+> pprCLabel platform lbl ]\n            _ -> empty\n\npprImportedSymbol dflags platform importedLbl\n        | osElfTarget (platformOS platform)\n        = case dynamicLinkerLabelInfo importedLbl of\n            Just (SymbolPtr, lbl)\n              -> let symbolSize = case wordWidth dflags of\n                         W32 -> sLit \"\\t.long\"\n                         W64 -> sLit \"\\t.quad\"\n                         _ -> panic \"Unknown wordRep in pprImportedSymbol\"\n\n                 in vcat [\n                      text \".section \\\".got2\\\", \\\"aw\\\"\",\n                      text \".LC_\" <> pprCLabel platform lbl <> char ':',\n                      ptext symbolSize <+> pprCLabel platform lbl ]\n\n            -- PLT code stubs are generated automatically by the dynamic linker.\n            _ -> empty\n\npprImportedSymbol _ _ _\n        = panic \"PIC.pprImportedSymbol: no match\"\n\n--------------------------------------------------------------------------------\n-- Generate code to calculate the address that should be put in the\n-- PIC base register.\n-- This is called by MachCodeGen for every CmmProc that accessed the\n-- PIC base register. It adds the appropriate instructions to the\n-- top of the CmmProc.\n\n-- It is assumed that the first NatCmmDecl in the input list is a Proc\n-- and the rest are CmmDatas.\n\n-- Darwin is simple: just fetch the address of a local label.\n-- The FETCHPC pseudo-instruction is expanded to multiple instructions\n-- during pretty-printing so that we don't have to deal with the\n-- local label:\n\n-- PowerPC version:\n--          bcl 20,31,1f.\n--      1:  mflr picReg\n\n-- i386 version:\n--          call 1f\n--      1:  popl %picReg\n\n\n\n-- Get a pointer to our own fake GOT, which is defined on a per-module basis.\n-- This is exactly how GCC does it in linux.\n\ninitializePicBase_ppc\n        :: Arch -> OS -> Reg\n        -> [NatCmmDecl CmmStatics PPC.Instr]\n        -> NatM [NatCmmDecl CmmStatics PPC.Instr]\n\ninitializePicBase_ppc ArchPPC os picReg\n    (CmmProc info lab live (ListGraph blocks) : statics)\n    | osElfTarget os\n    = do\n        let\n            gotOffset = PPC.ImmConstantDiff\n                                (PPC.ImmCLbl gotLabel)\n                                (PPC.ImmCLbl mkPicBaseLabel)\n\n            blocks' = case blocks of\n                       [] -> []\n                       (b:bs) -> fetchPC b : map maybeFetchPC bs\n\n            maybeFetchPC b@(BasicBlock bID _)\n              | bID `mapMember` info = fetchPC b\n              | otherwise            = b\n\n            -- GCC does PIC prologs thusly:\n            --     bcl 20,31,.L1\n            -- .L1:\n            --     mflr 30\n            --     addis 30,30,.LCTOC1-.L1@ha\n            --     addi 30,30,.LCTOC1-.L1@l\n            -- TODO: below we use it over temporary register,\n            -- it can and should be optimised by picking\n            -- correct PIC reg.\n            fetchPC (BasicBlock bID insns) =\n              BasicBlock bID (PPC.FETCHPC picReg\n                              : PPC.ADDIS picReg picReg (PPC.HA gotOffset)\n                              : PPC.ADD picReg picReg\n                                        (PPC.RIImm (PPC.LO gotOffset))\n                              : PPC.MR PPC.r30 picReg\n                              : insns)\n\n        return (CmmProc info lab live (ListGraph blocks') : statics)\n\n-------------------------------------------------------------------------\n-- Load TOC into register 2\n-- PowerPC 64-bit ELF ABI 2.0 requires the address of the callee\n-- in register 12.\n-- We pass the label to FETCHTOC and create a .localentry too.\n-- TODO: Explain this better and refer to ABI spec!\n{-\nWe would like to do approximately this, but spill slot allocation\nmight be added before the first BasicBlock. That violates the ABI.\n\nFor now we will emit the prologue code in the pretty printer,\nwhich is also what we do for ELF v1.\ninitializePicBase_ppc (ArchPPC_64 ELF_V2) OSLinux picReg\n        (CmmProc info lab live (ListGraph (entry:blocks)) : statics)\n        = do\n           bID <-getUniqueM\n           return (CmmProc info lab live (ListGraph (b':entry:blocks))\n                                         : statics)\n        where   BasicBlock entryID _ = entry\n                b' = BasicBlock bID [PPC.FETCHTOC picReg lab,\n                                     PPC.BCC PPC.ALWAYS entryID]\n-}\n\ninitializePicBase_ppc _ _ _ _\n        = panic \"initializePicBase_ppc: not needed\"\n\n\n-- We cheat a bit here by defining a pseudo-instruction named FETCHGOT\n-- which pretty-prints as:\n--              call 1f\n-- 1:           popl %picReg\n--              addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg\n-- (See PprMach.hs)\n\ninitializePicBase_x86\n        :: Arch -> OS -> Reg\n        -> [NatCmmDecl (Alignment, CmmStatics) X86.Instr]\n        -> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr]\n\ninitializePicBase_x86 ArchX86 os picReg\n        (CmmProc info lab live (ListGraph blocks) : statics)\n    | osElfTarget os\n    = return (CmmProc info lab live (ListGraph blocks') : statics)\n    where blocks' = case blocks of\n                     [] -> []\n                     (b:bs) -> fetchGOT b : map maybeFetchGOT bs\n\n          -- we want to add a FETCHGOT instruction to the beginning of\n          -- every block that is an entry point, which corresponds to\n          -- the blocks that have entries in the info-table mapping.\n          maybeFetchGOT b@(BasicBlock bID _)\n            | bID `mapMember` info = fetchGOT b\n            | otherwise            = b\n\n          fetchGOT (BasicBlock bID insns) =\n             BasicBlock bID (X86.FETCHGOT picReg : insns)\n\ninitializePicBase_x86 ArchX86 OSDarwin picReg\n        (CmmProc info lab live (ListGraph (entry:blocks)) : statics)\n        = return (CmmProc info lab live (ListGraph (block':blocks)) : statics)\n\n    where BasicBlock bID insns = entry\n          block' = BasicBlock bID (X86.FETCHPC picReg : insns)\n\ninitializePicBase_x86 _ _ _ _\n        = panic \"initializePicBase_x86: not needed\"\n\n", "num_lines": 839}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-----------------------------------------------------------------------------\n--\n-- Pretty-printing assembly language\n--\n-- (c) The University of Glasgow 1993-2005\n--\n-----------------------------------------------------------------------------\n\nmodule PprBase (\n        castFloatToWord8Array,\n        castDoubleToWord8Array,\n        floatToBytes,\n        doubleToBytes,\n        pprASCII,\n        pprBytes,\n        pprSectionHeader\n)\n\nwhere\n\nimport GhcPrelude\n\nimport AsmUtils\nimport CLabel\nimport Cmm\nimport DynFlags\nimport FastString\nimport Outputable\nimport Platform\nimport FileCleanup\n\nimport qualified Data.Array.Unsafe as U ( castSTUArray )\nimport Data.Array.ST\n\nimport Control.Monad.ST\n\nimport Data.Word\nimport Data.Bits\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString as BS\nimport GHC.Exts\nimport GHC.Word\nimport System.IO.Unsafe\n\n\n\n-- -----------------------------------------------------------------------------\n-- Converting floating-point literals to integrals for printing\n\ncastFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)\ncastFloatToWord8Array = U.castSTUArray\n\ncastDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)\ncastDoubleToWord8Array = U.castSTUArray\n\n-- floatToBytes and doubleToBytes convert to the host's byte\n-- order.  Providing that we're not cross-compiling for a\n-- target with the opposite endianness, this should work ok\n-- on all targets.\n\n-- ToDo: this stuff is very similar to the shenanigans in PprAbs,\n-- could they be merged?\n\nfloatToBytes :: Float -> [Int]\nfloatToBytes f\n   = runST (do\n        arr <- newArray_ ((0::Int),3)\n        writeArray arr 0 f\n        arr <- castFloatToWord8Array arr\n        i0 <- readArray arr 0\n        i1 <- readArray arr 1\n        i2 <- readArray arr 2\n        i3 <- readArray arr 3\n        return (map fromIntegral [i0,i1,i2,i3])\n     )\n\ndoubleToBytes :: Double -> [Int]\ndoubleToBytes d\n   = runST (do\n        arr <- newArray_ ((0::Int),7)\n        writeArray arr 0 d\n        arr <- castDoubleToWord8Array arr\n        i0 <- readArray arr 0\n        i1 <- readArray arr 1\n        i2 <- readArray arr 2\n        i3 <- readArray arr 3\n        i4 <- readArray arr 4\n        i5 <- readArray arr 5\n        i6 <- readArray arr 6\n        i7 <- readArray arr 7\n        return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])\n     )\n\n-- ---------------------------------------------------------------------------\n-- Printing ASCII strings.\n--\n-- Print as a string and escape non-printable characters.\n-- This is similar to charToC in Utils.\n\npprASCII :: ByteString -> SDoc\npprASCII str\n  -- Transform this given literal bytestring to escaped string and construct\n  -- the literal SDoc directly.\n  -- See Trac #14741\n  -- and Note [Pretty print ASCII when AsmCodeGen]\n  = text $ BS.foldr (\\w s -> do1 w ++ s) \"\" str\n    where\n       do1 :: Word8 -> String\n       do1 w | 0x09 == w = \"\\\\t\"\n             | 0x0A == w = \"\\\\n\"\n             | 0x22 == w = \"\\\\\\\"\"\n             | 0x5C == w = \"\\\\\\\\\"\n               -- ASCII printable characters range\n             | w >= 0x20 && w <= 0x7E = [chr' w]\n             | otherwise = '\\\\' : octal w\n\n       -- we know that the Chars we create are in the ASCII range\n       -- so we bypass the check in \"chr\"\n       chr' :: Word8 -> Char\n       chr' (W8# w#) = C# (chr# (word2Int# w#))\n\n       octal :: Word8 -> String\n       octal w = [ chr' (ord0 + (w `unsafeShiftR` 6) .&. 0x07)\n                 , chr' (ord0 + (w `unsafeShiftR` 3) .&. 0x07)\n                 , chr' (ord0 + w .&. 0x07)\n                 ]\n       ord0 = 0x30 -- = ord '0'\n\n-- | Pretty print binary data.\n--\n-- Use either the \".string\" directive or a \".incbin\" directive.\n-- See Note [Embedding large binary blobs]\n--\n-- A NULL byte is added after the binary data.\n--\npprBytes :: ByteString -> SDoc\npprBytes bs = sdocWithDynFlags $ \\dflags ->\n  if binBlobThreshold dflags == 0\n     || fromIntegral (BS.length bs) <= binBlobThreshold dflags\n    then text \"\\t.string \" <> doubleQuotes (pprASCII bs)\n    else unsafePerformIO $ do\n      bFile <- newTempName dflags TFL_CurrentModule \".dat\"\n      BS.writeFile bFile bs\n      return $ text \"\\t.incbin \\\"\" <> text bFile <> text \"\\\"\\n\\t.byte 0\"\n\n{-\nNote [Embedding large binary blobs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nTo embed a blob of binary data (e.g. an UTF-8 encoded string) into the generated\ncode object, we have several options:\n\n   1. Generate a \".byte\" directive for each byte. This is what was done in the past\n      (see Note [Pretty print ASCII when AsmCodeGen]).\n\n   2. Generate a single \".string\"/\".asciz\" directive for the whole sequence of\n      bytes. Bytes in the ASCII printable range are rendered as characters and\n      other values are escaped (e.g., \"\\t\", \"\\077\", etc.).\n\n   3. Create a temporary file into which we dump the binary data and generate a\n      single \".incbin\" directive. The assembler will include the binary file for\n      us in the generated output object.\n\nNow the code generator uses either (2) or (3), depending on the binary blob\nsize.  Using (3) for small blobs adds too much overhead (see benchmark results\nin #16190), so we only do it when the size is above a threshold (500K at the\ntime of writing).\n\nThe threshold is configurable via the `-fbinary-blob-threshold` flag.\n\n-}\n\n\n{-\nNote [Pretty print ASCII when AsmCodeGen]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPreviously, when generating assembly code, we created SDoc with\n`(ptext . sLit)` for every bytes in literal bytestring, then\ncombine them using `hcat`.\n\nWhen handling literal bytestrings with millions of bytes,\nmillions of SDoc would be created and to combine, leading to\nhigh memory usage.\n\nNow we escape the given bytestring to string directly and construct\nSDoc only once. This improvement could dramatically decrease the\nmemory allocation from 4.7GB to 1.3GB when embedding a 3MB literal\nstring in source code. See Trac #14741 for profiling results.\n-}\n\n-- ----------------------------------------------------------------------------\n-- Printing section headers.\n--\n-- If -split-section was specified, include the suffix label, otherwise just\n-- print the section type. For Darwin, where subsections-for-symbols are\n-- used instead, only print section type.\n--\n-- For string literals, additional flags are specified to enable merging of\n-- identical strings in the linker. With -split-sections each string also gets\n-- a unique section to allow strings from unused code to be GC'd.\n\npprSectionHeader :: Platform -> Section -> SDoc\npprSectionHeader platform (Section t suffix) =\n case platformOS platform of\n   OSAIX     -> pprXcoffSectionHeader t\n   OSDarwin  -> pprDarwinSectionHeader t\n   OSMinGW32 -> pprGNUSectionHeader (char '$') t suffix\n   _         -> pprGNUSectionHeader (char '.') t suffix\n\npprGNUSectionHeader :: SDoc -> SectionType -> CLabel -> SDoc\npprGNUSectionHeader sep t suffix = sdocWithDynFlags $ \\dflags ->\n  let splitSections = gopt Opt_SplitSections dflags\n      subsection | splitSections = sep <> ppr suffix\n                 | otherwise     = empty\n  in  text \".section \" <> ptext (header dflags) <> subsection <>\n      flags dflags\n  where\n    header dflags = case t of\n      Text -> sLit \".text\"\n      Data -> sLit \".data\"\n      ReadOnlyData  | OSMinGW32 <- platformOS (targetPlatform dflags)\n                                -> sLit \".rdata\"\n                    | otherwise -> sLit \".rodata\"\n      RelocatableReadOnlyData | OSMinGW32 <- platformOS (targetPlatform dflags)\n                                -- Concept does not exist on Windows,\n                                -- So map these to R/O data.\n                                          -> sLit \".rdata$rel.ro\"\n                              | otherwise -> sLit \".data.rel.ro\"\n      UninitialisedData -> sLit \".bss\"\n      ReadOnlyData16 | OSMinGW32 <- platformOS (targetPlatform dflags)\n                                 -> sLit \".rdata$cst16\"\n                     | otherwise -> sLit \".rodata.cst16\"\n      CString\n        | OSMinGW32 <- platformOS (targetPlatform dflags)\n                    -> sLit \".rdata\"\n        | otherwise -> sLit \".rodata.str\"\n      OtherSection _ ->\n        panic \"PprBase.pprGNUSectionHeader: unknown section type\"\n    flags dflags = case t of\n      CString\n        | OSMinGW32 <- platformOS (targetPlatform dflags)\n                    -> empty\n        | otherwise -> text \",\\\"aMS\\\",\" <> sectionType \"progbits\" <> text \",1\"\n      _ -> empty\n\n-- XCOFF doesn't support relocating label-differences, so we place all\n-- RO sections into .text[PR] sections\npprXcoffSectionHeader :: SectionType -> SDoc\npprXcoffSectionHeader t = text $ case t of\n     Text                    -> \".csect .text[PR]\"\n     Data                    -> \".csect .data[RW]\"\n     ReadOnlyData            -> \".csect .text[PR] # ReadOnlyData\"\n     RelocatableReadOnlyData -> \".csect .text[PR] # RelocatableReadOnlyData\"\n     ReadOnlyData16          -> \".csect .text[PR] # ReadOnlyData16\"\n     CString                 -> \".csect .text[PR] # CString\"\n     UninitialisedData       -> \".csect .data[BS]\"\n     OtherSection _          ->\n       panic \"PprBase.pprXcoffSectionHeader: unknown section type\"\n\npprDarwinSectionHeader :: SectionType -> SDoc\npprDarwinSectionHeader t =\n  ptext $ case t of\n     Text -> sLit \".text\"\n     Data -> sLit \".data\"\n     ReadOnlyData -> sLit \".const\"\n     RelocatableReadOnlyData -> sLit \".const_data\"\n     UninitialisedData -> sLit \".data\"\n     ReadOnlyData16 -> sLit \".const\"\n     CString -> sLit \".section\\t__TEXT,__cstring,cstring_literals\"\n     OtherSection _ ->\n       panic \"PprBase.pprDarwinSectionHeader: unknown section type\"\n", "num_lines": 274}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | An architecture independent description of a register.\n--      This needs to stay architecture independent because it is used\n--      by NCGMonad and the register allocators, which are shared\n--      by all architectures.\n--\nmodule Reg (\n        RegNo,\n        Reg(..),\n        regPair,\n        regSingle,\n        isRealReg,      takeRealReg,\n        isVirtualReg,   takeVirtualReg,\n\n        VirtualReg(..),\n        renameVirtualReg,\n        classOfVirtualReg,\n        getHiVirtualRegFromLo,\n        getHiVRegFromLo,\n\n        RealReg(..),\n        regNosOfRealReg,\n        realRegsAlias,\n\n        liftPatchFnToRegReg\n)\n\nwhere\n\nimport GhcPrelude\n\nimport Outputable\nimport Unique\nimport RegClass\nimport Data.List\n\n-- | An identifier for a primitive real machine register.\ntype RegNo\n        = Int\n\n-- VirtualRegs are virtual registers.  The register allocator will\n--      eventually have to map them into RealRegs, or into spill slots.\n--\n--      VirtualRegs are allocated on the fly, usually to represent a single\n--      value in the abstract assembly code (i.e. dynamic registers are\n--      usually single assignment).\n--\n--      The  single assignment restriction isn't necessary to get correct code,\n--      although a better register allocation will result if single\n--      assignment is used -- because the allocator maps a VirtualReg into\n--      a single RealReg, even if the VirtualReg has multiple live ranges.\n--\n--      Virtual regs can be of either class, so that info is attached.\n--\ndata VirtualReg\n        = VirtualRegI  {-# UNPACK #-} !Unique\n        | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register\n        | VirtualRegF  {-# UNPACK #-} !Unique\n        | VirtualRegD  {-# UNPACK #-} !Unique\n        | VirtualRegSSE {-# UNPACK #-} !Unique\n        deriving (Eq, Show)\n\n-- This is laborious, but necessary. We can't derive Ord because\n-- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the\n-- implementation. See Note [No Ord for Unique]\n-- This is non-deterministic but we do not currently support deterministic\n-- code-generation. See Note [Unique Determinism and code generation]\ninstance Ord VirtualReg where\n  compare (VirtualRegI a) (VirtualRegI b) = nonDetCmpUnique a b\n  compare (VirtualRegHi a) (VirtualRegHi b) = nonDetCmpUnique a b\n  compare (VirtualRegF a) (VirtualRegF b) = nonDetCmpUnique a b\n  compare (VirtualRegD a) (VirtualRegD b) = nonDetCmpUnique a b\n  compare (VirtualRegSSE a) (VirtualRegSSE b) = nonDetCmpUnique a b\n  compare VirtualRegI{} _ = LT\n  compare _ VirtualRegI{} = GT\n  compare VirtualRegHi{} _ = LT\n  compare _ VirtualRegHi{} = GT\n  compare VirtualRegF{} _ = LT\n  compare _ VirtualRegF{} = GT\n  compare VirtualRegD{} _ = LT\n  compare _ VirtualRegD{} = GT\n\n\ninstance Uniquable VirtualReg where\n        getUnique reg\n         = case reg of\n                VirtualRegI u   -> u\n                VirtualRegHi u  -> u\n                VirtualRegF u   -> u\n                VirtualRegD u   -> u\n                VirtualRegSSE u -> u\n\ninstance Outputable VirtualReg where\n        ppr reg\n         = case reg of\n                VirtualRegI  u  -> text \"%vI_\"   <> pprUniqueAlways u\n                VirtualRegHi u  -> text \"%vHi_\"  <> pprUniqueAlways u\n                VirtualRegF  u  -> text \"%vF_\"   <> pprUniqueAlways u\n                VirtualRegD  u  -> text \"%vD_\"   <> pprUniqueAlways u\n                VirtualRegSSE u -> text \"%vSSE_\" <> pprUniqueAlways u\n\n\nrenameVirtualReg :: Unique -> VirtualReg -> VirtualReg\nrenameVirtualReg u r\n = case r of\n        VirtualRegI _   -> VirtualRegI  u\n        VirtualRegHi _  -> VirtualRegHi u\n        VirtualRegF _   -> VirtualRegF  u\n        VirtualRegD _   -> VirtualRegD  u\n        VirtualRegSSE _ -> VirtualRegSSE u\n\n\nclassOfVirtualReg :: VirtualReg -> RegClass\nclassOfVirtualReg vr\n = case vr of\n        VirtualRegI{}   -> RcInteger\n        VirtualRegHi{}  -> RcInteger\n        VirtualRegF{}   -> RcFloat\n        VirtualRegD{}   -> RcDouble\n        VirtualRegSSE{} -> RcDoubleSSE\n\n\n-- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform\n-- when supplied with the vreg for the lower-half of the quantity.\n-- (NB. Not reversible).\ngetHiVirtualRegFromLo :: VirtualReg -> VirtualReg\ngetHiVirtualRegFromLo reg\n = case reg of\n        -- makes a pseudo-unique with tag 'H'\n        VirtualRegI u   -> VirtualRegHi (newTagUnique u 'H')\n        _               -> panic \"Reg.getHiVirtualRegFromLo\"\n\ngetHiVRegFromLo :: Reg -> Reg\ngetHiVRegFromLo reg\n = case reg of\n        RegVirtual  vr  -> RegVirtual (getHiVirtualRegFromLo vr)\n        RegReal _       -> panic \"Reg.getHiVRegFromLo\"\n\n\n------------------------------------------------------------------------------------\n-- | RealRegs are machine regs which are available for allocation, in\n--      the usual way.  We know what class they are, because that's part of\n--      the processor's architecture.\n--\n--      RealRegPairs are pairs of real registers that are allocated together\n--      to hold a larger value, such as with Double regs on SPARC.\n--\ndata RealReg\n        = RealRegSingle {-# UNPACK #-} !RegNo\n        | RealRegPair   {-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo\n        deriving (Eq, Show, Ord)\n\ninstance Uniquable RealReg where\n        getUnique reg\n         = case reg of\n                RealRegSingle i         -> mkRegSingleUnique i\n                RealRegPair r1 r2       -> mkRegPairUnique (r1 * 65536 + r2)\n\ninstance Outputable RealReg where\n        ppr reg\n         = case reg of\n                RealRegSingle i         -> text \"%r\"  <> int i\n                RealRegPair r1 r2       -> text \"%r(\" <> int r1\n                                           <> vbar <> int r2 <> text \")\"\n\nregNosOfRealReg :: RealReg -> [RegNo]\nregNosOfRealReg rr\n = case rr of\n        RealRegSingle r1        -> [r1]\n        RealRegPair   r1 r2     -> [r1, r2]\n\n\nrealRegsAlias :: RealReg -> RealReg -> Bool\nrealRegsAlias rr1 rr2\n        = not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)\n\n--------------------------------------------------------------------------------\n-- | A register, either virtual or real\ndata Reg\n        = RegVirtual !VirtualReg\n        | RegReal    !RealReg\n        deriving (Eq, Ord)\n\nregSingle :: RegNo -> Reg\nregSingle regNo         = RegReal $ RealRegSingle regNo\n\nregPair :: RegNo -> RegNo -> Reg\nregPair regNo1 regNo2   = RegReal $ RealRegPair regNo1 regNo2\n\n\n-- We like to have Uniques for Reg so that we can make UniqFM and UniqSets\n-- in the register allocator.\ninstance Uniquable Reg where\n        getUnique reg\n         = case reg of\n                RegVirtual vr   -> getUnique vr\n                RegReal    rr   -> getUnique rr\n\n-- | Print a reg in a generic manner\n--      If you want the architecture specific names, then use the pprReg\n--      function from the appropriate Ppr module.\ninstance Outputable Reg where\n        ppr reg\n         = case reg of\n                RegVirtual vr   -> ppr vr\n                RegReal    rr   -> ppr rr\n\n\nisRealReg :: Reg -> Bool\nisRealReg reg\n = case reg of\n        RegReal _       -> True\n        RegVirtual _    -> False\n\ntakeRealReg :: Reg -> Maybe RealReg\ntakeRealReg reg\n = case reg of\n        RegReal rr      -> Just rr\n        _               -> Nothing\n\n\nisVirtualReg :: Reg -> Bool\nisVirtualReg reg\n = case reg of\n        RegReal _       -> False\n        RegVirtual _    -> True\n\ntakeVirtualReg :: Reg -> Maybe VirtualReg\ntakeVirtualReg reg\n = case reg of\n        RegReal _       -> Nothing\n        RegVirtual vr   -> Just vr\n\n\n-- | The patch function supplied by the allocator maps VirtualReg to RealReg\n--      regs, but sometimes we want to apply it to plain old Reg.\n--\nliftPatchFnToRegReg  :: (VirtualReg -> RealReg) -> (Reg -> Reg)\nliftPatchFnToRegReg patchF reg\n = case reg of\n        RegVirtual vr   -> RegReal (patchF vr)\n        RegReal _       -> reg\n", "num_lines": 242}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | An architecture independent description of a register's class.\nmodule RegClass\n        ( RegClass (..) )\n\nwhere\n\nimport GhcPrelude\n\nimport  Outputable\nimport  Unique\n\n\n-- | The class of a register.\n--      Used in the register allocator.\n--      We treat all registers in a class as being interchangable.\n--\ndata RegClass\n        = RcInteger\n        | RcFloat\n        | RcDouble\n        | RcDoubleSSE -- x86 only: the SSE regs are a separate class\n        deriving Eq\n\n\ninstance Uniquable RegClass where\n    getUnique RcInteger = mkRegClassUnique 0\n    getUnique RcFloat   = mkRegClassUnique 1\n    getUnique RcDouble  = mkRegClassUnique 2\n    getUnique RcDoubleSSE = mkRegClassUnique 3\n\ninstance Outputable RegClass where\n    ppr RcInteger       = Outputable.text \"I\"\n    ppr RcFloat         = Outputable.text \"F\"\n    ppr RcDouble        = Outputable.text \"D\"\n    ppr RcDoubleSSE     = Outputable.text \"S\"\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n-- | Hard wired things related to registers.\n--      This is module is preventing the native code generator being able to\n--      emit code for non-host architectures.\n--\n--      TODO: Do a better job of the overloading, and eliminate this module.\n--      We'd probably do better with a Register type class, and hook this to\n--      Instruction somehow.\n--\n--      TODO: We should also make arch specific versions of RegAlloc.Graph.TrivColorable\nmodule TargetReg (\n        targetVirtualRegSqueeze,\n        targetRealRegSqueeze,\n        targetClassOfRealReg,\n        targetMkVirtualReg,\n        targetRegDotColor,\n        targetClassOfReg\n)\n\nwhere\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Reg\nimport RegClass\nimport Format\n\nimport Outputable\nimport Unique\nimport Platform\n\nimport qualified X86.Regs       as X86\nimport qualified X86.RegInfo    as X86\n\nimport qualified PPC.Regs       as PPC\n\nimport qualified SPARC.Regs     as SPARC\n\ntargetVirtualRegSqueeze :: Platform -> RegClass -> VirtualReg -> Int\ntargetVirtualRegSqueeze platform\n    = case platformArch platform of\n      ArchX86       -> X86.virtualRegSqueeze\n      ArchX86_64    -> X86.virtualRegSqueeze\n      ArchPPC       -> PPC.virtualRegSqueeze\n      ArchSPARC     -> SPARC.virtualRegSqueeze\n      ArchSPARC64   -> panic \"targetVirtualRegSqueeze ArchSPARC64\"\n      ArchPPC_64 _  -> PPC.virtualRegSqueeze\n      ArchARM _ _ _ -> panic \"targetVirtualRegSqueeze ArchARM\"\n      ArchARM64     -> panic \"targetVirtualRegSqueeze ArchARM64\"\n      ArchAlpha     -> panic \"targetVirtualRegSqueeze ArchAlpha\"\n      ArchMipseb    -> panic \"targetVirtualRegSqueeze ArchMipseb\"\n      ArchMipsel    -> panic \"targetVirtualRegSqueeze ArchMipsel\"\n      ArchJavaScript-> panic \"targetVirtualRegSqueeze ArchJavaScript\"\n      ArchUnknown   -> panic \"targetVirtualRegSqueeze ArchUnknown\"\n\n\ntargetRealRegSqueeze :: Platform -> RegClass -> RealReg -> Int\ntargetRealRegSqueeze platform\n    = case platformArch platform of\n      ArchX86       -> X86.realRegSqueeze\n      ArchX86_64    -> X86.realRegSqueeze\n      ArchPPC       -> PPC.realRegSqueeze\n      ArchSPARC     -> SPARC.realRegSqueeze\n      ArchSPARC64   -> panic \"targetRealRegSqueeze ArchSPARC64\"\n      ArchPPC_64 _  -> PPC.realRegSqueeze\n      ArchARM _ _ _ -> panic \"targetRealRegSqueeze ArchARM\"\n      ArchARM64     -> panic \"targetRealRegSqueeze ArchARM64\"\n      ArchAlpha     -> panic \"targetRealRegSqueeze ArchAlpha\"\n      ArchMipseb    -> panic \"targetRealRegSqueeze ArchMipseb\"\n      ArchMipsel    -> panic \"targetRealRegSqueeze ArchMipsel\"\n      ArchJavaScript-> panic \"targetRealRegSqueeze ArchJavaScript\"\n      ArchUnknown   -> panic \"targetRealRegSqueeze ArchUnknown\"\n\ntargetClassOfRealReg :: Platform -> RealReg -> RegClass\ntargetClassOfRealReg platform\n    = case platformArch platform of\n      ArchX86       -> X86.classOfRealReg platform\n      ArchX86_64    -> X86.classOfRealReg platform\n      ArchPPC       -> PPC.classOfRealReg\n      ArchSPARC     -> SPARC.classOfRealReg\n      ArchSPARC64   -> panic \"targetClassOfRealReg ArchSPARC64\"\n      ArchPPC_64 _  -> PPC.classOfRealReg\n      ArchARM _ _ _ -> panic \"targetClassOfRealReg ArchARM\"\n      ArchARM64     -> panic \"targetClassOfRealReg ArchARM64\"\n      ArchAlpha     -> panic \"targetClassOfRealReg ArchAlpha\"\n      ArchMipseb    -> panic \"targetClassOfRealReg ArchMipseb\"\n      ArchMipsel    -> panic \"targetClassOfRealReg ArchMipsel\"\n      ArchJavaScript-> panic \"targetClassOfRealReg ArchJavaScript\"\n      ArchUnknown   -> panic \"targetClassOfRealReg ArchUnknown\"\n\ntargetMkVirtualReg :: Platform -> Unique -> Format -> VirtualReg\ntargetMkVirtualReg platform\n    = case platformArch platform of\n      ArchX86       -> X86.mkVirtualReg\n      ArchX86_64    -> X86.mkVirtualReg\n      ArchPPC       -> PPC.mkVirtualReg\n      ArchSPARC     -> SPARC.mkVirtualReg\n      ArchSPARC64   -> panic \"targetMkVirtualReg ArchSPARC64\"\n      ArchPPC_64 _  -> PPC.mkVirtualReg\n      ArchARM _ _ _ -> panic \"targetMkVirtualReg ArchARM\"\n      ArchARM64     -> panic \"targetMkVirtualReg ArchARM64\"\n      ArchAlpha     -> panic \"targetMkVirtualReg ArchAlpha\"\n      ArchMipseb    -> panic \"targetMkVirtualReg ArchMipseb\"\n      ArchMipsel    -> panic \"targetMkVirtualReg ArchMipsel\"\n      ArchJavaScript-> panic \"targetMkVirtualReg ArchJavaScript\"\n      ArchUnknown   -> panic \"targetMkVirtualReg ArchUnknown\"\n\ntargetRegDotColor :: Platform -> RealReg -> SDoc\ntargetRegDotColor platform\n    = case platformArch platform of\n      ArchX86       -> X86.regDotColor platform\n      ArchX86_64    -> X86.regDotColor platform\n      ArchPPC       -> PPC.regDotColor\n      ArchSPARC     -> SPARC.regDotColor\n      ArchSPARC64   -> panic \"targetRegDotColor ArchSPARC64\"\n      ArchPPC_64 _  -> PPC.regDotColor\n      ArchARM _ _ _ -> panic \"targetRegDotColor ArchARM\"\n      ArchARM64     -> panic \"targetRegDotColor ArchARM64\"\n      ArchAlpha     -> panic \"targetRegDotColor ArchAlpha\"\n      ArchMipseb    -> panic \"targetRegDotColor ArchMipseb\"\n      ArchMipsel    -> panic \"targetRegDotColor ArchMipsel\"\n      ArchJavaScript-> panic \"targetRegDotColor ArchJavaScript\"\n      ArchUnknown   -> panic \"targetRegDotColor ArchUnknown\"\n\n\ntargetClassOfReg :: Platform -> Reg -> RegClass\ntargetClassOfReg platform reg\n = case reg of\n   RegVirtual vr -> classOfVirtualReg vr\n   RegReal rr -> targetClassOfRealReg platform rr\n", "num_lines": 133}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Constants describing the DWARF format. Most of this simply\n-- mirrors /usr/include/dwarf.h.\n\nmodule Dwarf.Constants where\n\nimport GhcPrelude\n\nimport AsmUtils\nimport FastString\nimport Platform\nimport Outputable\n\nimport Reg\nimport X86.Regs\n\nimport Data.Word\n\n-- | Language ID used for Haskell.\ndW_LANG_Haskell :: Word\ndW_LANG_Haskell = 0x18\n  -- Thanks to Nathan Howell for getting us our very own language ID!\n\n-- * Dwarf tags\ndW_TAG_compile_unit, dW_TAG_subroutine_type,\n  dW_TAG_file_type, dW_TAG_subprogram, dW_TAG_lexical_block,\n  dW_TAG_base_type, dW_TAG_structure_type, dW_TAG_pointer_type,\n  dW_TAG_array_type, dW_TAG_subrange_type, dW_TAG_typedef,\n  dW_TAG_variable, dW_TAG_arg_variable, dW_TAG_auto_variable,\n  dW_TAG_ghc_src_note :: Word\ndW_TAG_array_type      = 1\ndW_TAG_lexical_block   = 11\ndW_TAG_pointer_type    = 15\ndW_TAG_compile_unit    = 17\ndW_TAG_structure_type  = 19\ndW_TAG_typedef         = 22\ndW_TAG_subroutine_type = 32\ndW_TAG_subrange_type   = 33\ndW_TAG_base_type       = 36\ndW_TAG_file_type       = 41\ndW_TAG_subprogram      = 46\ndW_TAG_variable        = 52\ndW_TAG_auto_variable   = 256\ndW_TAG_arg_variable    = 257\n\ndW_TAG_ghc_src_note    = 0x5b00\n\n-- * Dwarf attributes\ndW_AT_name, dW_AT_stmt_list, dW_AT_low_pc, dW_AT_high_pc, dW_AT_language,\n  dW_AT_comp_dir, dW_AT_producer, dW_AT_external, dW_AT_frame_base,\n  dW_AT_use_UTF8, dW_AT_MIPS_linkage_name :: Word\ndW_AT_name              = 0x03\ndW_AT_stmt_list         = 0x10\ndW_AT_low_pc            = 0x11\ndW_AT_high_pc           = 0x12\ndW_AT_language          = 0x13\ndW_AT_comp_dir          = 0x1b\ndW_AT_producer          = 0x25\ndW_AT_external          = 0x3f\ndW_AT_frame_base        = 0x40\ndW_AT_use_UTF8          = 0x53\ndW_AT_MIPS_linkage_name = 0x2007\n\n-- * Custom DWARF attributes\n-- Chosen a more or less random section of the vendor-extensible region\n\n-- ** Describing C-- blocks\n-- These appear in DW_TAG_lexical_scope DIEs corresponding to C-- blocks\ndW_AT_ghc_tick_parent :: Word\ndW_AT_ghc_tick_parent     = 0x2b20\n\n-- ** Describing source notes\n-- These appear in DW_TAG_ghc_src_note DIEs\ndW_AT_ghc_span_file, dW_AT_ghc_span_start_line,\n  dW_AT_ghc_span_start_col, dW_AT_ghc_span_end_line,\n  dW_AT_ghc_span_end_col :: Word\ndW_AT_ghc_span_file       = 0x2b00\ndW_AT_ghc_span_start_line = 0x2b01\ndW_AT_ghc_span_start_col  = 0x2b02\ndW_AT_ghc_span_end_line   = 0x2b03\ndW_AT_ghc_span_end_col    = 0x2b04\n\n\n-- * Abbrev declarations\ndW_CHILDREN_no, dW_CHILDREN_yes :: Word8\ndW_CHILDREN_no  = 0\ndW_CHILDREN_yes = 1\n\ndW_FORM_addr, dW_FORM_data2, dW_FORM_data4, dW_FORM_string, dW_FORM_flag,\n  dW_FORM_block1, dW_FORM_ref4, dW_FORM_ref_addr, dW_FORM_flag_present :: Word\ndW_FORM_addr   = 0x01\ndW_FORM_data2  = 0x05\ndW_FORM_data4  = 0x06\ndW_FORM_string = 0x08\ndW_FORM_flag   = 0x0c\ndW_FORM_block1 = 0x0a\ndW_FORM_ref_addr     = 0x10\ndW_FORM_ref4         = 0x13\ndW_FORM_flag_present = 0x19\n\n-- * Dwarf native types\ndW_ATE_address, dW_ATE_boolean, dW_ATE_float, dW_ATE_signed,\n  dW_ATE_signed_char, dW_ATE_unsigned, dW_ATE_unsigned_char :: Word\ndW_ATE_address       = 1\ndW_ATE_boolean       = 2\ndW_ATE_float         = 4\ndW_ATE_signed        = 5\ndW_ATE_signed_char   = 6\ndW_ATE_unsigned      = 7\ndW_ATE_unsigned_char = 8\n\n-- * Call frame information\ndW_CFA_set_loc, dW_CFA_undefined, dW_CFA_same_value,\n  dW_CFA_def_cfa, dW_CFA_def_cfa_offset, dW_CFA_def_cfa_expression,\n  dW_CFA_expression, dW_CFA_offset_extended_sf, dW_CFA_def_cfa_offset_sf,\n  dW_CFA_def_cfa_sf, dW_CFA_val_offset, dW_CFA_val_expression,\n  dW_CFA_offset :: Word8\ndW_CFA_set_loc            = 0x01\ndW_CFA_undefined          = 0x07\ndW_CFA_same_value         = 0x08\ndW_CFA_def_cfa            = 0x0c\ndW_CFA_def_cfa_offset     = 0x0e\ndW_CFA_def_cfa_expression = 0x0f\ndW_CFA_expression         = 0x10\ndW_CFA_offset_extended_sf = 0x11\ndW_CFA_def_cfa_sf         = 0x12\ndW_CFA_def_cfa_offset_sf  = 0x13\ndW_CFA_val_offset         = 0x14\ndW_CFA_val_expression     = 0x16\ndW_CFA_offset             = 0x80\n\n-- * Operations\ndW_OP_addr, dW_OP_deref, dW_OP_consts,\n  dW_OP_minus, dW_OP_mul, dW_OP_plus,\n  dW_OP_lit0, dW_OP_breg0, dW_OP_call_frame_cfa :: Word8\ndW_OP_addr           = 0x03\ndW_OP_deref          = 0x06\ndW_OP_consts         = 0x11\ndW_OP_minus          = 0x1c\ndW_OP_mul            = 0x1e\ndW_OP_plus           = 0x22\ndW_OP_lit0           = 0x30\ndW_OP_breg0          = 0x70\ndW_OP_call_frame_cfa = 0x9c\n\n-- * Dwarf section declarations\ndwarfInfoSection, dwarfAbbrevSection, dwarfLineSection,\n  dwarfFrameSection, dwarfGhcSection, dwarfARangesSection :: SDoc\ndwarfInfoSection    = dwarfSection \"info\"\ndwarfAbbrevSection  = dwarfSection \"abbrev\"\ndwarfLineSection    = dwarfSection \"line\"\ndwarfFrameSection   = dwarfSection \"frame\"\ndwarfGhcSection     = dwarfSection \"ghc\"\ndwarfARangesSection = dwarfSection \"aranges\"\n\ndwarfSection :: String -> SDoc\ndwarfSection name = sdocWithPlatform $ \\plat ->\n  case platformOS plat of\n    os | osElfTarget os\n       -> text \"\\t.section .debug_\" <> text name <> text \",\\\"\\\",\"\n          <> sectionType \"progbits\"\n       | osMachOTarget os\n       -> text \"\\t.section __DWARF,__debug_\" <> text name <> text \",regular,debug\"\n       | otherwise\n       -> text \"\\t.section .debug_\" <> text name <> text \",\\\"dr\\\"\"\n\n-- * Dwarf section labels\ndwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: PtrString\ndwarfInfoLabel   = sLit \".Lsection_info\"\ndwarfAbbrevLabel = sLit \".Lsection_abbrev\"\ndwarfLineLabel   = sLit \".Lsection_line\"\ndwarfFrameLabel  = sLit \".Lsection_frame\"\n\n-- | Mapping of registers to DWARF register numbers\ndwarfRegNo :: Platform -> Reg -> Word8\ndwarfRegNo p r = case platformArch p of\n  ArchX86\n    | r == eax  -> 0\n    | r == ecx  -> 1  -- yes, no typo\n    | r == edx  -> 2\n    | r == ebx  -> 3\n    | r == esp  -> 4\n    | r == ebp  -> 5\n    | r == esi  -> 6\n    | r == edi  -> 7\n  ArchX86_64\n    | r == rax  -> 0\n    | r == rdx  -> 1 -- this neither. The order GCC allocates registers in?\n    | r == rcx  -> 2\n    | r == rbx  -> 3\n    | r == rsi  -> 4\n    | r == rdi  -> 5\n    | r == rbp  -> 6\n    | r == rsp  -> 7\n    | r == r8   -> 8\n    | r == r9   -> 9\n    | r == r10  -> 10\n    | r == r11  -> 11\n    | r == r12  -> 12\n    | r == r13  -> 13\n    | r == r14  -> 14\n    | r == r15  -> 15\n    | r == xmm0 -> 17\n    | r == xmm1 -> 18\n    | r == xmm2 -> 19\n    | r == xmm3 -> 20\n    | r == xmm4 -> 21\n    | r == xmm5 -> 22\n    | r == xmm6 -> 23\n    | r == xmm7 -> 24\n    | r == xmm8 -> 25\n    | r == xmm9 -> 26\n    | r == xmm10 -> 27\n    | r == xmm11 -> 28\n    | r == xmm12 -> 29\n    | r == xmm13 -> 30\n    | r == xmm14 -> 31\n    | r == xmm15 -> 32\n  _other -> error \"dwarfRegNo: Unsupported platform or unknown register!\"\n\n-- | Virtual register number to use for return address.\ndwarfReturnRegNo :: Platform -> Word8\ndwarfReturnRegNo p\n  -- We \"overwrite\" IP with our pseudo register - that makes sense, as\n  -- when using this mechanism gdb already knows the IP anyway. Clang\n  -- does this too, so it must be safe.\n  = case platformArch p of\n    ArchX86    -> 8  -- eip\n    ArchX86_64 -> 16 -- rip\n    _other     -> error \"dwarfReturnRegNo: Unsupported platform!\"\n", "num_lines": 230}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Dwarf.Types\n  ( -- * Dwarf information\n    DwarfInfo(..)\n  , pprDwarfInfo\n  , pprAbbrevDecls\n    -- * Dwarf address range table\n  , DwarfARange(..)\n  , pprDwarfARanges\n    -- * Dwarf frame\n  , DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)\n  , pprDwarfFrame\n    -- * Utilities\n  , pprByte\n  , pprHalf\n  , pprData4'\n  , pprDwWord\n  , pprWord\n  , pprLEBWord\n  , pprLEBInt\n  , wordAlign\n  , sectionOffset\n  )\n  where\n\nimport GhcPrelude\n\nimport Debug\nimport CLabel\nimport CmmExpr         ( GlobalReg(..) )\nimport Encoding\nimport FastString\nimport Outputable\nimport Platform\nimport Unique\nimport Reg\nimport SrcLoc\nimport Util\n\nimport Dwarf.Constants\n\nimport qualified Data.ByteString as BS\nimport qualified Control.Monad.Trans.State.Strict as S\nimport Control.Monad (zipWithM, join)\nimport Data.Bits\nimport qualified Data.Map as Map\nimport Data.Word\nimport Data.Char\n\nimport CodeGen.Platform\n\n-- | Individual dwarf records. Each one will be encoded as an entry in\n-- the @.debug_info@ section.\ndata DwarfInfo\n  = DwarfCompileUnit { dwChildren :: [DwarfInfo]\n                     , dwName :: String\n                     , dwProducer :: String\n                     , dwCompDir :: String\n                     , dwLowLabel :: CLabel\n                     , dwHighLabel :: CLabel\n                     , dwLineLabel :: PtrString }\n  | DwarfSubprogram { dwChildren :: [DwarfInfo]\n                    , dwName :: String\n                    , dwLabel :: CLabel\n                    , dwParent :: Maybe CLabel\n                      -- ^ label of DIE belonging to the parent tick\n                    }\n  | DwarfBlock { dwChildren :: [DwarfInfo]\n               , dwLabel :: CLabel\n               , dwMarker :: Maybe CLabel\n               }\n  | DwarfSrcNote { dwSrcSpan :: RealSrcSpan\n                 }\n\n-- | Abbreviation codes used for encoding above records in the\n-- @.debug_info@ section.\ndata DwarfAbbrev\n  = DwAbbrNull          -- ^ Pseudo, used for marking the end of lists\n  | DwAbbrCompileUnit\n  | DwAbbrSubprogram\n  | DwAbbrSubprogramWithParent\n  | DwAbbrBlockWithoutCode\n  | DwAbbrBlock\n  | DwAbbrGhcSrcNote\n  deriving (Eq, Enum)\n\n-- | Generate assembly for the given abbreviation code\npprAbbrev :: DwarfAbbrev -> SDoc\npprAbbrev = pprLEBWord . fromIntegral . fromEnum\n\n-- | Abbreviation declaration. This explains the binary encoding we\n-- use for representing 'DwarfInfo'. Be aware that this must be updated\n-- along with 'pprDwarfInfo'.\npprAbbrevDecls :: Bool -> SDoc\npprAbbrevDecls haveDebugLine =\n  let mkAbbrev abbr tag chld flds =\n        let fld (tag, form) = pprLEBWord tag $$ pprLEBWord form\n        in pprAbbrev abbr $$ pprLEBWord tag $$ pprByte chld $$\n           vcat (map fld flds) $$ pprByte 0 $$ pprByte 0\n      -- These are shared between DwAbbrSubprogram and\n      -- DwAbbrSubprogramWithParent\n      subprogramAttrs =\n           [ (dW_AT_name, dW_FORM_string)\n           , (dW_AT_MIPS_linkage_name, dW_FORM_string)\n           , (dW_AT_external, dW_FORM_flag)\n           , (dW_AT_low_pc, dW_FORM_addr)\n           , (dW_AT_high_pc, dW_FORM_addr)\n           , (dW_AT_frame_base, dW_FORM_block1)\n           ]\n  in dwarfAbbrevSection $$\n     ptext dwarfAbbrevLabel <> colon $$\n     mkAbbrev DwAbbrCompileUnit dW_TAG_compile_unit dW_CHILDREN_yes\n       ([(dW_AT_name,     dW_FORM_string)\n       , (dW_AT_producer, dW_FORM_string)\n       , (dW_AT_language, dW_FORM_data4)\n       , (dW_AT_comp_dir, dW_FORM_string)\n       , (dW_AT_use_UTF8, dW_FORM_flag_present)  -- not represented in body\n       , (dW_AT_low_pc,   dW_FORM_addr)\n       , (dW_AT_high_pc,  dW_FORM_addr)\n       ] ++\n       (if haveDebugLine\n        then [ (dW_AT_stmt_list, dW_FORM_data4) ]\n        else [])) $$\n     mkAbbrev DwAbbrSubprogram dW_TAG_subprogram dW_CHILDREN_yes\n       subprogramAttrs $$\n     mkAbbrev DwAbbrSubprogramWithParent dW_TAG_subprogram dW_CHILDREN_yes\n       (subprogramAttrs ++ [(dW_AT_ghc_tick_parent, dW_FORM_ref_addr)]) $$\n     mkAbbrev DwAbbrBlockWithoutCode dW_TAG_lexical_block dW_CHILDREN_yes\n       [ (dW_AT_name, dW_FORM_string)\n       ] $$\n     mkAbbrev DwAbbrBlock dW_TAG_lexical_block dW_CHILDREN_yes\n       [ (dW_AT_name, dW_FORM_string)\n       , (dW_AT_low_pc, dW_FORM_addr)\n       , (dW_AT_high_pc, dW_FORM_addr)\n       ] $$\n     mkAbbrev DwAbbrGhcSrcNote dW_TAG_ghc_src_note dW_CHILDREN_no\n       [ (dW_AT_ghc_span_file, dW_FORM_string)\n       , (dW_AT_ghc_span_start_line, dW_FORM_data4)\n       , (dW_AT_ghc_span_start_col, dW_FORM_data2)\n       , (dW_AT_ghc_span_end_line, dW_FORM_data4)\n       , (dW_AT_ghc_span_end_col, dW_FORM_data2)\n       ] $$\n     pprByte 0\n\n-- | Generate assembly for DWARF data\npprDwarfInfo :: Bool -> DwarfInfo -> SDoc\npprDwarfInfo haveSrc d\n  = case d of\n      DwarfCompileUnit {}  -> hasChildren\n      DwarfSubprogram {}   -> hasChildren\n      DwarfBlock {}        -> hasChildren\n      DwarfSrcNote {}      -> noChildren\n  where\n    hasChildren =\n        pprDwarfInfoOpen haveSrc d $$\n        vcat (map (pprDwarfInfo haveSrc) (dwChildren d)) $$\n        pprDwarfInfoClose\n    noChildren = pprDwarfInfoOpen haveSrc d\n\n-- | Prints assembler data corresponding to DWARF info records. Note\n-- that the binary format of this is parameterized in @abbrevDecls@ and\n-- has to be kept in synch.\npprDwarfInfoOpen :: Bool -> DwarfInfo -> SDoc\npprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lowLabel\n                                           highLabel lineLbl) =\n  pprAbbrev DwAbbrCompileUnit\n  $$ pprString name\n  $$ pprString producer\n  $$ pprData4 dW_LANG_Haskell\n  $$ pprString compDir\n  $$ pprWord (ppr lowLabel)\n  $$ pprWord (ppr highLabel)\n  $$ if haveSrc\n     then sectionOffset (ptext lineLbl) (ptext dwarfLineLabel)\n     else empty\npprDwarfInfoOpen _ (DwarfSubprogram _ name label\n                                    parent) = sdocWithDynFlags $ \\df ->\n  ppr (mkAsmTempDieLabel label) <> colon\n  $$ pprAbbrev abbrev\n  $$ pprString name\n  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))\n  $$ pprFlag (externallyVisibleCLabel label)\n  $$ pprWord (ppr label)\n  $$ pprWord (ppr $ mkAsmTempEndLabel label)\n  $$ pprByte 1\n  $$ pprByte dW_OP_call_frame_cfa\n  $$ parentValue\n  where\n    abbrev = case parent of Nothing -> DwAbbrSubprogram\n                            Just _  -> DwAbbrSubprogramWithParent\n    parentValue = maybe empty pprParentDie parent\n    pprParentDie sym = sectionOffset (ppr sym) (ptext dwarfInfoLabel)\npprDwarfInfoOpen _ (DwarfBlock _ label Nothing) = sdocWithDynFlags $ \\df ->\n  ppr (mkAsmTempDieLabel label) <> colon\n  $$ pprAbbrev DwAbbrBlockWithoutCode\n  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))\npprDwarfInfoOpen _ (DwarfBlock _ label (Just marker)) = sdocWithDynFlags $ \\df ->\n  ppr (mkAsmTempDieLabel label) <> colon\n  $$ pprAbbrev DwAbbrBlock\n  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))\n  $$ pprWord (ppr marker)\n  $$ pprWord (ppr $ mkAsmTempEndLabel marker)\npprDwarfInfoOpen _ (DwarfSrcNote ss) =\n  pprAbbrev DwAbbrGhcSrcNote\n  $$ pprString' (ftext $ srcSpanFile ss)\n  $$ pprData4 (fromIntegral $ srcSpanStartLine ss)\n  $$ pprHalf (fromIntegral $ srcSpanStartCol ss)\n  $$ pprData4 (fromIntegral $ srcSpanEndLine ss)\n  $$ pprHalf (fromIntegral $ srcSpanEndCol ss)\n\n-- | Close a DWARF info record with children\npprDwarfInfoClose :: SDoc\npprDwarfInfoClose = pprAbbrev DwAbbrNull\n\n-- | A DWARF address range. This is used by the debugger to quickly locate\n-- which compilation unit a given address belongs to. This type assumes\n-- a non-segmented address-space.\ndata DwarfARange\n  = DwarfARange\n    { dwArngStartLabel :: CLabel\n    , dwArngEndLabel   :: CLabel\n    }\n\n-- | Print assembler directives corresponding to a DWARF @.debug_aranges@\n-- address table entry.\npprDwarfARanges :: [DwarfARange] -> Unique -> SDoc\npprDwarfARanges arngs unitU = sdocWithPlatform $ \\plat ->\n  let wordSize = platformWordSize plat\n      paddingSize = 4 :: Int\n      -- header is 12 bytes long.\n      -- entry is 8 bytes (32-bit platform) or 16 bytes (64-bit platform).\n      -- pad such that first entry begins at multiple of entry size.\n      pad n = vcat $ replicate n $ pprByte 0\n      initialLength = 8 + paddingSize + 2*2*wordSize\n  in pprDwWord (ppr initialLength)\n     $$ pprHalf 2\n     $$ sectionOffset (ppr $ mkAsmTempLabel $ unitU)\n                      (ptext dwarfInfoLabel)\n     $$ pprByte (fromIntegral wordSize)\n     $$ pprByte 0\n     $$ pad paddingSize\n     -- body\n     $$ vcat (map pprDwarfARange arngs)\n     -- terminus\n     $$ pprWord (char '0')\n     $$ pprWord (char '0')\n\npprDwarfARange :: DwarfARange -> SDoc\npprDwarfARange arng = pprWord (ppr $ dwArngStartLabel arng) $$ pprWord length\n  where\n    length = ppr (dwArngEndLabel arng)\n             <> char '-' <> ppr (dwArngStartLabel arng)\n\n-- | Information about unwind instructions for a procedure. This\n-- corresponds to a \"Common Information Entry\" (CIE) in DWARF.\ndata DwarfFrame\n  = DwarfFrame\n    { dwCieLabel :: CLabel\n    , dwCieInit  :: UnwindTable\n    , dwCieProcs :: [DwarfFrameProc]\n    }\n\n-- | Unwind instructions for an individual procedure. Corresponds to a\n-- \"Frame Description Entry\" (FDE) in DWARF.\ndata DwarfFrameProc\n  = DwarfFrameProc\n    { dwFdeProc    :: CLabel\n    , dwFdeHasInfo :: Bool\n    , dwFdeBlocks  :: [DwarfFrameBlock]\n      -- ^ List of blocks. Order must match asm!\n    }\n\n-- | Unwind instructions for a block. Will become part of the\n-- containing FDE.\ndata DwarfFrameBlock\n  = DwarfFrameBlock\n    { dwFdeBlkHasInfo :: Bool\n    , dwFdeUnwind     :: [UnwindPoint]\n      -- ^ these unwind points must occur in the same order as they occur\n      -- in the block\n    }\n\ninstance Outputable DwarfFrameBlock where\n  ppr (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> ppr unwinds\n\n-- | Header for the @.debug_frame@ section. Here we emit the \"Common\n-- Information Entry\" record that etablishes general call frame\n-- parameters and the default stack layout.\npprDwarfFrame :: DwarfFrame -> SDoc\npprDwarfFrame DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs}\n  = sdocWithPlatform $ \\plat ->\n    let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit \"_start\")\n        cieEndLabel = mkAsmTempEndLabel cieLabel\n        length      = ppr cieEndLabel <> char '-' <> ppr cieStartLabel\n        spReg       = dwarfGlobalRegNo plat Sp\n        retReg      = dwarfReturnRegNo plat\n        wordSize    = platformWordSize plat\n        pprInit :: (GlobalReg, Maybe UnwindExpr) -> SDoc\n        pprInit (g, uw) = pprSetUnwind plat g (Nothing, uw)\n\n        -- Preserve C stack pointer: This necessary to override that default\n        -- unwinding behavior of setting $sp = CFA.\n        preserveSp = case platformArch plat of\n          ArchX86    -> pprByte dW_CFA_same_value $$ pprLEBWord 4\n          ArchX86_64 -> pprByte dW_CFA_same_value $$ pprLEBWord 7\n          _          -> empty\n    in vcat [ ppr cieLabel <> colon\n            , pprData4' length -- Length of CIE\n            , ppr cieStartLabel <> colon\n            , pprData4' (text \"-1\")\n                               -- Common Information Entry marker (-1 = 0xf..f)\n            , pprByte 3        -- CIE version (we require DWARF 3)\n            , pprByte 0        -- Augmentation (none)\n            , pprByte 1        -- Code offset multiplicator\n            , pprByte (128-fromIntegral wordSize)\n                               -- Data offset multiplicator\n                               -- (stacks grow down => \"-w\" in signed LEB128)\n            , pprByte retReg   -- virtual register holding return address\n            ] $$\n       -- Initial unwind table\n       vcat (map pprInit $ Map.toList cieInit) $$\n       vcat [ -- RET = *CFA\n              pprByte (dW_CFA_offset+retReg)\n            , pprByte 0\n\n              -- Preserve C stack pointer\n            , preserveSp\n\n              -- Sp' = CFA\n              -- (we need to set this manually as our (STG) Sp register is\n              -- often not the architecture's default stack register)\n            , pprByte dW_CFA_val_offset\n            , pprLEBWord (fromIntegral spReg)\n            , pprLEBWord 0\n            ] $$\n       wordAlign $$\n       ppr cieEndLabel <> colon $$\n       -- Procedure unwind tables\n       vcat (map (pprFrameProc cieLabel cieInit) procs)\n\n-- | Writes a \"Frame Description Entry\" for a procedure. This consists\n-- mainly of referencing the CIE and writing state machine\n-- instructions to describe how the frame base (CFA) changes.\npprFrameProc :: CLabel -> UnwindTable -> DwarfFrameProc -> SDoc\npprFrameProc frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks)\n  = let fdeLabel    = mkAsmTempDerivedLabel procLbl (fsLit \"_fde\")\n        fdeEndLabel = mkAsmTempDerivedLabel procLbl (fsLit \"_fde_end\")\n        procEnd     = mkAsmTempEndLabel procLbl\n        ifInfo str  = if hasInfo then text str else empty\n                      -- see [Note: Info Offset]\n    in vcat [ whenPprDebug $ text \"# Unwinding for\" <+> ppr procLbl <> colon\n            , pprData4' (ppr fdeEndLabel <> char '-' <> ppr fdeLabel)\n            , ppr fdeLabel <> colon\n            , pprData4' (ppr frameLbl <> char '-' <>\n                         ptext dwarfFrameLabel)    -- Reference to CIE\n            , pprWord (ppr procLbl <> ifInfo \"-1\") -- Code pointer\n            , pprWord (ppr procEnd <> char '-' <>\n                       ppr procLbl <> ifInfo \"+1\") -- Block byte length\n            ] $$\n       vcat (S.evalState (mapM pprFrameBlock blocks) initUw) $$\n       wordAlign $$\n       ppr fdeEndLabel <> colon\n\n-- | Generates unwind information for a block. We only generate\n-- instructions where unwind information actually changes. This small\n-- optimisations saves a lot of space, as subsequent blocks often have\n-- the same unwind information.\npprFrameBlock :: DwarfFrameBlock -> S.State UnwindTable SDoc\npprFrameBlock (DwarfFrameBlock hasInfo uws0) =\n    vcat <$> zipWithM pprFrameDecl (True : repeat False) uws0\n  where\n    pprFrameDecl :: Bool -> UnwindPoint -> S.State UnwindTable SDoc\n    pprFrameDecl firstDecl (UnwindPoint lbl uws) = S.state $ \\oldUws ->\n        let -- Did a register's unwind expression change?\n            isChanged :: GlobalReg -> Maybe UnwindExpr\n                      -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)\n            isChanged g new\n                -- the value didn't change\n              | Just new == old = Nothing\n                -- the value was and still is undefined\n              | Nothing <- old\n              , Nothing <- new  = Nothing\n                -- the value changed\n              | otherwise       = Just (join old, new)\n              where\n                old = Map.lookup g oldUws\n\n            changed = Map.toList $ Map.mapMaybeWithKey isChanged uws\n\n        in if oldUws == uws\n             then (empty, oldUws)\n             else let -- see [Note: Info Offset]\n                      needsOffset = firstDecl && hasInfo\n                      lblDoc = ppr lbl <>\n                               if needsOffset then text \"-1\" else empty\n                      doc = sdocWithPlatform $ \\plat ->\n                           pprByte dW_CFA_set_loc $$ pprWord lblDoc $$\n                           vcat (map (uncurry $ pprSetUnwind plat) changed)\n                  in (doc, uws)\n\n-- Note [Info Offset]\n--\n-- GDB was pretty much written with C-like programs in mind, and as a\n-- result they assume that once you have a return address, it is a\n-- good idea to look at (PC-1) to unwind further - as that's where the\n-- \"call\" instruction is supposed to be.\n--\n-- Now on one hand, code generated by GHC looks nothing like what GDB\n-- expects, and in fact going up from a return pointer is guaranteed\n-- to land us inside an info table! On the other hand, that actually\n-- gives us some wiggle room, as we expect IP to never *actually* end\n-- up inside the info table, so we can \"cheat\" by putting whatever GDB\n-- expects to see there. This is probably pretty safe, as GDB cannot\n-- assume (PC-1) to be a valid code pointer in the first place - and I\n-- have seen no code trying to correct this.\n--\n-- Note that this will not prevent GDB from failing to look-up the\n-- correct function name for the frame, as that uses the symbol table,\n-- which we can not manipulate as easily.\n--\n-- There's a GDB patch to address this at [1]. At the moment of writing\n-- it's not merged, so I recommend building GDB with the patch if you\n-- care about unwinding. The hack above doesn't cover every case.\n--\n-- [1] https://sourceware.org/ml/gdb-patches/2018-02/msg00055.html\n\n-- | Get DWARF register ID for a given GlobalReg\ndwarfGlobalRegNo :: Platform -> GlobalReg -> Word8\ndwarfGlobalRegNo p UnwindReturnReg = dwarfReturnRegNo p\ndwarfGlobalRegNo p reg = maybe 0 (dwarfRegNo p . RegReal) $ globalRegMaybe p reg\n\n-- | Generate code for setting the unwind information for a register,\n-- optimized using its known old value in the table. Note that \"Sp\" is\n-- special: We see it as synonym for the CFA.\npprSetUnwind :: Platform\n             -> GlobalReg\n                -- ^ the register to produce an unwinding table entry for\n             -> (Maybe UnwindExpr, Maybe UnwindExpr)\n                -- ^ the old and new values of the register\n             -> SDoc\npprSetUnwind plat g  (_, Nothing)\n  = pprUndefUnwind plat g\npprSetUnwind _    Sp (Just (UwReg s _), Just (UwReg s' o')) | s == s'\n  = if o' >= 0\n    then pprByte dW_CFA_def_cfa_offset $$ pprLEBWord (fromIntegral o')\n    else pprByte dW_CFA_def_cfa_offset_sf $$ pprLEBInt o'\npprSetUnwind plat Sp (_, Just (UwReg s' o'))\n  = if o' >= 0\n    then pprByte dW_CFA_def_cfa $$\n         pprLEBRegNo plat s' $$\n         pprLEBWord (fromIntegral o')\n    else pprByte dW_CFA_def_cfa_sf $$\n         pprLEBRegNo plat s' $$\n         pprLEBInt o'\npprSetUnwind _    Sp (_, Just uw)\n  = pprByte dW_CFA_def_cfa_expression $$ pprUnwindExpr False uw\npprSetUnwind plat g  (_, Just (UwDeref (UwReg Sp o)))\n  | o < 0 && ((-o) `mod` platformWordSize plat) == 0 -- expected case\n  = pprByte (dW_CFA_offset + dwarfGlobalRegNo plat g) $$\n    pprLEBWord (fromIntegral ((-o) `div` platformWordSize plat))\n  | otherwise\n  = pprByte dW_CFA_offset_extended_sf $$\n    pprLEBRegNo plat g $$\n    pprLEBInt o\npprSetUnwind plat g  (_, Just (UwDeref uw))\n  = pprByte dW_CFA_expression $$\n    pprLEBRegNo plat g $$\n    pprUnwindExpr True uw\npprSetUnwind plat g  (_, Just (UwReg g' 0))\n  | g == g'\n  = pprByte dW_CFA_same_value $$\n    pprLEBRegNo plat g\npprSetUnwind plat g  (_, Just uw)\n  = pprByte dW_CFA_val_expression $$\n    pprLEBRegNo plat g $$\n    pprUnwindExpr True uw\n\n-- | Print the register number of the given 'GlobalReg' as an unsigned LEB128\n-- encoded number.\npprLEBRegNo :: Platform -> GlobalReg -> SDoc\npprLEBRegNo plat = pprLEBWord . fromIntegral . dwarfGlobalRegNo plat\n\n-- | Generates a DWARF expression for the given unwind expression. If\n-- @spIsCFA@ is true, we see @Sp@ as the frame base CFA where it gets\n-- mentioned.\npprUnwindExpr :: Bool -> UnwindExpr -> SDoc\npprUnwindExpr spIsCFA expr\n  = sdocWithPlatform $ \\plat ->\n    let pprE (UwConst i)\n          | i >= 0 && i < 32 = pprByte (dW_OP_lit0 + fromIntegral i)\n          | otherwise        = pprByte dW_OP_consts $$ pprLEBInt i -- lazy...\n        pprE (UwReg Sp i) | spIsCFA\n                             = if i == 0\n                               then pprByte dW_OP_call_frame_cfa\n                               else pprE (UwPlus (UwReg Sp 0) (UwConst i))\n        pprE (UwReg g i)      = pprByte (dW_OP_breg0+dwarfGlobalRegNo plat g) $$\n                               pprLEBInt i\n        pprE (UwDeref u)      = pprE u $$ pprByte dW_OP_deref\n        pprE (UwLabel l)      = pprByte dW_OP_addr $$ pprWord (ppr l)\n        pprE (UwPlus u1 u2)   = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus\n        pprE (UwMinus u1 u2)  = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus\n        pprE (UwTimes u1 u2)  = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul\n    in text \"\\t.uleb128 2f-1f\" $$ -- DW_FORM_block length\n       -- computed as the difference of the following local labels 2: and 1:\n       text \"1:\" $$\n       pprE expr $$\n       text \"2:\"\n\n-- | Generate code for re-setting the unwind information for a\n-- register to @undefined@\npprUndefUnwind :: Platform -> GlobalReg -> SDoc\npprUndefUnwind plat g  = pprByte dW_CFA_undefined $$\n                         pprLEBRegNo plat g\n\n\n-- | Align assembly at (machine) word boundary\nwordAlign :: SDoc\nwordAlign = sdocWithPlatform $ \\plat ->\n  text \"\\t.align \" <> case platformOS plat of\n    OSDarwin -> case platformWordSize plat of\n      8      -> text \"3\"\n      4      -> text \"2\"\n      _other -> error \"wordAlign: Unsupported word size!\"\n    _other   -> ppr (platformWordSize plat)\n\n-- | Assembly for a single byte of constant DWARF data\npprByte :: Word8 -> SDoc\npprByte x = text \"\\t.byte \" <> ppr (fromIntegral x :: Word)\n\n-- | Assembly for a two-byte constant integer\npprHalf :: Word16 -> SDoc\npprHalf x = text \"\\t.short\" <+> ppr (fromIntegral x :: Word)\n\n-- | Assembly for a constant DWARF flag\npprFlag :: Bool -> SDoc\npprFlag f = pprByte (if f then 0xff else 0x00)\n\n-- | Assembly for 4 bytes of dynamic DWARF data\npprData4' :: SDoc -> SDoc\npprData4' x = text \"\\t.long \" <> x\n\n-- | Assembly for 4 bytes of constant DWARF data\npprData4 :: Word -> SDoc\npprData4 = pprData4' . ppr\n\n-- | Assembly for a DWARF word of dynamic data. This means 32 bit, as\n-- we are generating 32 bit DWARF.\npprDwWord :: SDoc -> SDoc\npprDwWord = pprData4'\n\n-- | Assembly for a machine word of dynamic data. Depends on the\n-- architecture we are currently generating code for.\npprWord :: SDoc -> SDoc\npprWord s = (<> s) . sdocWithPlatform $ \\plat ->\n  case platformWordSize plat of\n    4 -> text \"\\t.long \"\n    8 -> text \"\\t.quad \"\n    n -> panic $ \"pprWord: Unsupported target platform word length \" ++\n                 show n ++ \"!\"\n\n-- | Prints a number in \"little endian base 128\" format. The idea is\n-- to optimize for small numbers by stopping once all further bytes\n-- would be 0. The highest bit in every byte signals whether there\n-- are further bytes to read.\npprLEBWord :: Word -> SDoc\npprLEBWord x | x < 128   = pprByte (fromIntegral x)\n             | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$\n                           pprLEBWord (x `shiftR` 7)\n\n-- | Same as @pprLEBWord@, but for a signed number\npprLEBInt :: Int -> SDoc\npprLEBInt x | x >= -64 && x < 64\n                        = pprByte (fromIntegral (x .&. 127))\n            | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$\n                          pprLEBInt (x `shiftR` 7)\n\n-- | Generates a dynamic null-terminated string. If required the\n-- caller needs to make sure that the string is escaped properly.\npprString' :: SDoc -> SDoc\npprString' str = text \"\\t.asciz \\\"\" <> str <> char '\"'\n\n-- | Generate a string constant. We take care to escape the string.\npprString :: String -> SDoc\npprString str\n  = pprString' $ hcat $ map escapeChar $\n    if str `lengthIs` utf8EncodedLength str\n    then str\n    else map (chr . fromIntegral) $ BS.unpack $ bytesFS $ mkFastString str\n\n-- | Escape a single non-unicode character\nescapeChar :: Char -> SDoc\nescapeChar '\\\\' = text \"\\\\\\\\\"\nescapeChar '\\\"' = text \"\\\\\\\"\"\nescapeChar '\\n' = text \"\\\\n\"\nescapeChar c\n  | isAscii c && isPrint c && c /= '?' -- prevents trigraph warnings\n  = char c\n  | otherwise\n  = char '\\\\' <> char (intToDigit (ch `div` 64)) <>\n                 char (intToDigit ((ch `div` 8) `mod` 8)) <>\n                 char (intToDigit (ch `mod` 8))\n  where ch = ord c\n\n-- | Generate an offset into another section. This is tricky because\n-- this is handled differently depending on platform: Mac Os expects\n-- us to calculate the offset using assembler arithmetic. Linux expects\n-- us to just reference the target directly, and will figure out on\n-- their own that we actually need an offset. Finally, Windows has\n-- a special directive to refer to relative offsets. Fun.\nsectionOffset :: SDoc -> SDoc -> SDoc\nsectionOffset target section = sdocWithPlatform $ \\plat ->\n  case platformOS plat of\n    OSDarwin  -> pprDwWord (target <> char '-' <> section)\n    OSMinGW32 -> text \"\\t.secrel32 \" <> target\n    _other    -> pprDwWord target\n", "num_lines": 615}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GADTs #-}\n\n-----------------------------------------------------------------------------\n--\n-- Generating machine code (instruction selection)\n--\n-- (c) The University of Glasgow 1996-2004\n--\n-----------------------------------------------------------------------------\n\n-- This is a big module, but, if you pay attention to\n-- (a) the sectioning, and (b) the type signatures,\n-- the structure should not be too overwhelming.\n\nmodule PPC.CodeGen (\n        cmmTopCodeGen,\n        generateJumpTableForInstr,\n        InstrBlock\n)\n\nwhere\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n#include \"../includes/MachDeps.h\"\n\n-- NCG stuff:\nimport GhcPrelude\n\nimport CodeGen.Platform\nimport PPC.Instr\nimport PPC.Cond\nimport PPC.Regs\nimport CPrim\nimport NCGMonad   ( NatM, getNewRegNat, getNewLabelNat\n                  , getBlockIdNat, getPicBaseNat, getNewRegPairNat\n                  , getPicBaseMaybeNat )\nimport Instruction\nimport PIC\nimport Format\nimport RegClass\nimport Reg\nimport TargetReg\nimport Platform\n\n-- Our intermediate code:\nimport BlockId\nimport PprCmm           ( pprExpr )\nimport Cmm\nimport CmmUtils\nimport CmmSwitch\nimport CLabel\nimport Hoopl.Block\nimport Hoopl.Graph\n\n-- The rest:\nimport OrdList\nimport Outputable\nimport DynFlags\n\nimport Control.Monad    ( mapAndUnzipM, when )\nimport Data.Bits\nimport Data.Word\n\nimport BasicTypes\nimport FastString\nimport Util\n\n-- -----------------------------------------------------------------------------\n-- Top-level of the instruction selector\n\n-- | 'InstrBlock's are the insn sequences generated by the insn selectors.\n-- They are really trees of insns to facilitate fast appending, where a\n-- left-to-right traversal (pre-order?) yields the insns in the correct\n-- order.\n\ncmmTopCodeGen\n        :: RawCmmDecl\n        -> NatM [NatCmmDecl CmmStatics Instr]\n\ncmmTopCodeGen (CmmProc info lab live graph) = do\n  let blocks = toBlockListEntryFirst graph\n  (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks\n  dflags <- getDynFlags\n  let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)\n      tops = proc : concat statics\n      os   = platformOS $ targetPlatform dflags\n      arch = platformArch $ targetPlatform dflags\n  case arch of\n    ArchPPC | os == OSAIX -> return tops\n            | otherwise -> do\n      picBaseMb <- getPicBaseMaybeNat\n      case picBaseMb of\n           Just picBase -> initializePicBase_ppc arch os picBase tops\n           Nothing -> return tops\n    ArchPPC_64 ELF_V1 -> fixup_entry tops\n                      -- generating function descriptor is handled in\n                      -- pretty printer\n    ArchPPC_64 ELF_V2 -> fixup_entry tops\n                      -- generating function prologue is handled in\n                      -- pretty printer\n    _          -> panic \"PPC.cmmTopCodeGen: unknown arch\"\n    where\n      fixup_entry (CmmProc info lab live (ListGraph (entry:blocks)) : statics)\n        = do\n        let BasicBlock bID insns = entry\n        bID' <- if lab == (blockLbl bID)\n                then newBlockId\n                else return bID\n        let b' = BasicBlock bID' insns\n        return (CmmProc info lab live (ListGraph (b':blocks)) : statics)\n      fixup_entry _ = panic \"cmmTopCodegen: Broken CmmProc\"\n\ncmmTopCodeGen (CmmData sec dat) = do\n  return [CmmData sec dat]  -- no translation, we just use CmmStatic\n\nbasicBlockCodeGen\n        :: Block CmmNode C C\n        -> NatM ( [NatBasicBlock Instr]\n                , [NatCmmDecl CmmStatics Instr])\n\nbasicBlockCodeGen block = do\n  let (_, nodes, tail)  = blockSplit block\n      id = entryLabel block\n      stmts = blockToList nodes\n  mid_instrs <- stmtsToInstrs stmts\n  tail_instrs <- stmtToInstrs tail\n  let instrs = mid_instrs `appOL` tail_instrs\n  -- code generation may introduce new basic block boundaries, which\n  -- are indicated by the NEWBLOCK instruction.  We must split up the\n  -- instruction stream into basic blocks again.  Also, we extract\n  -- LDATAs here too.\n  let\n        (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs\n\n        mkBlocks (NEWBLOCK id) (instrs,blocks,statics)\n          = ([], BasicBlock id instrs : blocks, statics)\n        mkBlocks (LDATA sec dat) (instrs,blocks,statics)\n          = (instrs, blocks, CmmData sec dat:statics)\n        mkBlocks instr (instrs,blocks,statics)\n          = (instr:instrs, blocks, statics)\n  return (BasicBlock id top : other_blocks, statics)\n\nstmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock\nstmtsToInstrs stmts\n   = do instrss <- mapM stmtToInstrs stmts\n        return (concatOL instrss)\n\nstmtToInstrs :: CmmNode e x -> NatM InstrBlock\nstmtToInstrs stmt = do\n  dflags <- getDynFlags\n  case stmt of\n    CmmComment s   -> return (unitOL (COMMENT s))\n    CmmTick {}     -> return nilOL\n    CmmUnwind {}   -> return nilOL\n\n    CmmAssign reg src\n      | isFloatType ty -> assignReg_FltCode format reg src\n      | target32Bit (targetPlatform dflags) &&\n        isWord64 ty    -> assignReg_I64Code      reg src\n      | otherwise      -> assignReg_IntCode format reg src\n        where ty = cmmRegType dflags reg\n              format = cmmTypeFormat ty\n\n    CmmStore addr src\n      | isFloatType ty -> assignMem_FltCode format addr src\n      | target32Bit (targetPlatform dflags) &&\n        isWord64 ty    -> assignMem_I64Code      addr src\n      | otherwise      -> assignMem_IntCode format addr src\n        where ty = cmmExprType dflags src\n              format = cmmTypeFormat ty\n\n    CmmUnsafeForeignCall target result_regs args\n       -> genCCall target result_regs args\n\n    CmmBranch id          -> genBranch id\n    CmmCondBranch arg true false prediction -> do\n      b1 <- genCondJump true arg prediction\n      b2 <- genBranch false\n      return (b1 `appOL` b2)\n    CmmSwitch arg ids -> do dflags <- getDynFlags\n                            genSwitch dflags arg ids\n    CmmCall { cml_target = arg } -> genJump arg\n    _ ->\n      panic \"stmtToInstrs: statement should have been cps'd away\"\n\n\n--------------------------------------------------------------------------------\n-- | 'InstrBlock's are the insn sequences generated by the insn selectors.\n--      They are really trees of insns to facilitate fast appending, where a\n--      left-to-right traversal yields the insns in the correct order.\n--\ntype InstrBlock\n        = OrdList Instr\n\n\n-- | Register's passed up the tree.  If the stix code forces the register\n--      to live in a pre-decided machine register, it comes out as @Fixed@;\n--      otherwise, it comes out as @Any@, and the parent can decide which\n--      register to put it in.\n--\ndata Register\n        = Fixed Format Reg InstrBlock\n        | Any   Format (Reg -> InstrBlock)\n\n\nswizzleRegisterRep :: Register -> Format -> Register\nswizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code\nswizzleRegisterRep (Any _ codefn)     format = Any   format codefn\n\n\n-- | Grab the Reg for a CmmReg\ngetRegisterReg :: Platform -> CmmReg -> Reg\n\ngetRegisterReg _ (CmmLocal (LocalReg u pk))\n  = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk)\n\ngetRegisterReg platform (CmmGlobal mid)\n  = case globalRegMaybe platform mid of\n        Just reg -> RegReal reg\n        Nothing  -> pprPanic \"getRegisterReg-memory\" (ppr $ CmmGlobal mid)\n        -- By this stage, the only MagicIds remaining should be the\n        -- ones which map to a real machine register on this\n        -- platform.  Hence ...\n\n-- | Convert a BlockId to some CmmStatic data\njumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic\njumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))\njumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)\n    where blockLabel = blockLbl blockid\n\n\n\n-- -----------------------------------------------------------------------------\n-- General things for putting together code sequences\n\n-- Expand CmmRegOff.  ToDo: should we do it this way around, or convert\n-- CmmExprs into CmmRegOff?\nmangleIndexTree :: DynFlags -> CmmExpr -> CmmExpr\nmangleIndexTree dflags (CmmRegOff reg off)\n  = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]\n  where width = typeWidth (cmmRegType dflags reg)\n\nmangleIndexTree _ _\n        = panic \"PPC.CodeGen.mangleIndexTree: no match\"\n\n-- -----------------------------------------------------------------------------\n--  Code gen for 64-bit arithmetic on 32-bit platforms\n\n{-\nSimple support for generating 64-bit code (ie, 64 bit values and 64\nbit assignments) on 32-bit platforms.  Unlike the main code generator\nwe merely shoot for generating working code as simply as possible, and\npay little attention to code quality.  Specifically, there is no\nattempt to deal cleverly with the fixed-vs-floating register\ndistinction; all values are generated into (pairs of) floating\nregisters, even if this would mean some redundant reg-reg moves as a\nresult.  Only one of the VRegUniques is returned, since it will be\nof the VRegUniqueLo form, and the upper-half VReg can be determined\nby applying getHiVRegFromLo to it.\n-}\n\ndata ChildCode64        -- a.k.a \"Register64\"\n      = ChildCode64\n           InstrBlock   -- code\n           Reg          -- the lower 32-bit temporary which contains the\n                        -- result; use getHiVRegFromLo to find the other\n                        -- VRegUnique.  Rules of this simplified insn\n                        -- selection game are therefore that the returned\n                        -- Reg may be modified\n\n\n-- | Compute an expression into a register, but\n--      we don't mind which one it is.\ngetSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)\ngetSomeReg expr = do\n  r <- getRegister expr\n  case r of\n    Any rep code -> do\n        tmp <- getNewRegNat rep\n        return (tmp, code tmp)\n    Fixed _ reg code ->\n        return (reg, code)\n\ngetI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)\ngetI64Amodes addrTree = do\n    Amode hi_addr addr_code <- getAmode D addrTree\n    case addrOffset hi_addr 4 of\n        Just lo_addr -> return (hi_addr, lo_addr, addr_code)\n        Nothing      -> do (hi_ptr, code) <- getSomeReg addrTree\n                           return (AddrRegImm hi_ptr (ImmInt 0),\n                                   AddrRegImm hi_ptr (ImmInt 4),\n                                   code)\n\n\nassignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock\nassignMem_I64Code addrTree valueTree = do\n        (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree\n        ChildCode64 vcode rlo <- iselExpr64 valueTree\n        let\n                rhi = getHiVRegFromLo rlo\n\n                -- Big-endian store\n                mov_hi = ST II32 rhi hi_addr\n                mov_lo = ST II32 rlo lo_addr\n        return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)\n\n\nassignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock\nassignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do\n   ChildCode64 vcode r_src_lo <- iselExpr64 valueTree\n   let\n         r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32\n         r_dst_hi = getHiVRegFromLo r_dst_lo\n         r_src_hi = getHiVRegFromLo r_src_lo\n         mov_lo = MR r_dst_lo r_src_lo\n         mov_hi = MR r_dst_hi r_src_hi\n   return (\n        vcode `snocOL` mov_lo `snocOL` mov_hi\n     )\n\nassignReg_I64Code _ _\n   = panic \"assignReg_I64Code(powerpc): invalid lvalue\"\n\n\niselExpr64        :: CmmExpr -> NatM ChildCode64\niselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do\n    (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree\n    (rlo, rhi) <- getNewRegPairNat II32\n    let mov_hi = LD II32 rhi hi_addr\n        mov_lo = LD II32 rlo lo_addr\n    return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)\n                         rlo\n\niselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty\n   = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))\n\niselExpr64 (CmmLit (CmmInt i _)) = do\n  (rlo,rhi) <- getNewRegPairNat II32\n  let\n        half0 = fromIntegral (fromIntegral i :: Word16)\n        half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)\n        half2 = fromIntegral (fromIntegral (i `shiftR` 32) :: Word16)\n        half3 = fromIntegral (fromIntegral (i `shiftR` 48) :: Word16)\n\n        code = toOL [\n                LIS rlo (ImmInt half1),\n                OR rlo rlo (RIImm $ ImmInt half0),\n                LIS rhi (ImmInt half3),\n                OR rhi rhi (RIImm $ ImmInt half2)\n                ]\n  return (ChildCode64 code rlo)\n\niselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do\n   ChildCode64 code1 r1lo <- iselExpr64 e1\n   ChildCode64 code2 r2lo <- iselExpr64 e2\n   (rlo,rhi) <- getNewRegPairNat II32\n   let\n        r1hi = getHiVRegFromLo r1lo\n        r2hi = getHiVRegFromLo r2lo\n        code =  code1 `appOL`\n                code2 `appOL`\n                toOL [ ADDC rlo r1lo r2lo,\n                       ADDE rhi r1hi r2hi ]\n   return (ChildCode64 code rlo)\n\niselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do\n   ChildCode64 code1 r1lo <- iselExpr64 e1\n   ChildCode64 code2 r2lo <- iselExpr64 e2\n   (rlo,rhi) <- getNewRegPairNat II32\n   let\n        r1hi = getHiVRegFromLo r1lo\n        r2hi = getHiVRegFromLo r2lo\n        code =  code1 `appOL`\n                code2 `appOL`\n                toOL [ SUBFC rlo r2lo (RIReg r1lo),\n                       SUBFE rhi r2hi r1hi ]\n   return (ChildCode64 code rlo)\n\niselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do\n    (expr_reg,expr_code) <- getSomeReg expr\n    (rlo, rhi) <- getNewRegPairNat II32\n    let mov_hi = LI rhi (ImmInt 0)\n        mov_lo = MR rlo expr_reg\n    return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)\n                         rlo\n\niselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do\n    (expr_reg,expr_code) <- getSomeReg expr\n    (rlo, rhi) <- getNewRegPairNat II32\n    let mov_hi = SRA II32 rhi expr_reg (RIImm (ImmInt 31))\n        mov_lo = MR rlo expr_reg\n    return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)\n                         rlo\niselExpr64 expr\n   = pprPanic \"iselExpr64(powerpc)\" (pprExpr expr)\n\n\n\ngetRegister :: CmmExpr -> NatM Register\ngetRegister e = do dflags <- getDynFlags\n                   getRegister' dflags e\n\ngetRegister' :: DynFlags -> CmmExpr -> NatM Register\n\ngetRegister' dflags (CmmReg (CmmGlobal PicBaseReg))\n  | OSAIX <- platformOS (targetPlatform dflags) = do\n        let code dst = toOL [ LD II32 dst tocAddr ]\n            tocAddr = AddrRegImm toc (ImmLit (text \"ghc_toc_table[TC]\"))\n        return (Any II32 code)\n  | target32Bit (targetPlatform dflags) = do\n      reg <- getPicBaseNat $ archWordFormat (target32Bit (targetPlatform dflags))\n      return (Fixed (archWordFormat (target32Bit (targetPlatform dflags)))\n                    reg nilOL)\n  | otherwise = return (Fixed II64 toc nilOL)\n\ngetRegister' dflags (CmmReg reg)\n  = return (Fixed (cmmTypeFormat (cmmRegType dflags reg))\n                  (getRegisterReg (targetPlatform dflags) reg) nilOL)\n\ngetRegister' dflags tree@(CmmRegOff _ _)\n  = getRegister' dflags (mangleIndexTree dflags tree)\n\n    -- for 32-bit architectuers, support some 64 -> 32 bit conversions:\n    -- TO_W_(x), TO_W_(x >> 32)\n\ngetRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32)\n                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])\n | target32Bit (targetPlatform dflags) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 (getHiVRegFromLo rlo) code\n\ngetRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32)\n                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])\n | target32Bit (targetPlatform dflags) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 (getHiVRegFromLo rlo) code\n\ngetRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32) [x])\n | target32Bit (targetPlatform dflags) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 rlo code\n\ngetRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32) [x])\n | target32Bit (targetPlatform dflags) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 rlo code\n\ngetRegister' dflags (CmmLoad mem pk)\n | not (isWord64 pk) = do\n        let platform = targetPlatform dflags\n        Amode addr addr_code <- getAmode D mem\n        let code dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk)\n                       addr_code `snocOL` LD format dst addr\n        return (Any format code)\n | not (target32Bit (targetPlatform dflags)) = do\n        Amode addr addr_code <- getAmode DS mem\n        let code dst = addr_code `snocOL` LD II64 dst addr\n        return (Any II64 code)\n\n          where format = cmmTypeFormat pk\n\n-- catch simple cases of zero- or sign-extended load\ngetRegister' _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II32 (\\dst -> addr_code `snocOL` LD II8 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_XX_Conv W8 W32) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II32 (\\dst -> addr_code `snocOL` LD II8 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II64 (\\dst -> addr_code `snocOL` LD II8 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_XX_Conv W8 W64) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II64 (\\dst -> addr_code `snocOL` LD II8 dst addr))\n\n-- Note: there is no Load Byte Arithmetic instruction, so no signed case here\n\ngetRegister' _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II32 (\\dst -> addr_code `snocOL` LD II16 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II32 (\\dst -> addr_code `snocOL` LA II16 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II64 (\\dst -> addr_code `snocOL` LD II16 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II64 (\\dst -> addr_code `snocOL` LA II16 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad mem _]) = do\n    Amode addr addr_code <- getAmode D mem\n    return (Any II64 (\\dst -> addr_code `snocOL` LD II32 dst addr))\n\ngetRegister' _ (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad mem _]) = do\n    -- lwa is DS-form. See Note [Power instruction format]\n    Amode addr addr_code <- getAmode DS mem\n    return (Any II64 (\\dst -> addr_code `snocOL` LA II32 dst addr))\n\ngetRegister' dflags (CmmMachOp mop [x]) -- unary MachOps\n  = case mop of\n      MO_Not rep   -> triv_ucode_int rep NOT\n\n      MO_F_Neg w   -> triv_ucode_float w FNEG\n      MO_S_Neg w   -> triv_ucode_int   w NEG\n\n      MO_FF_Conv W64 W32 -> trivialUCode  FF32 FRSP x\n      MO_FF_Conv W32 W64 -> conversionNop FF64 x\n\n      MO_FS_Conv from to -> coerceFP2Int from to x\n      MO_SF_Conv from to -> coerceInt2FP from to x\n\n      MO_SS_Conv from to\n        | from >= to -> conversionNop (intFormat to) x\n        | otherwise  -> triv_ucode_int to (EXTS (intFormat from))\n\n      MO_UU_Conv from to\n        | from >= to -> conversionNop (intFormat to) x\n        | otherwise  -> clearLeft from to\n\n      MO_XX_Conv _ to -> conversionNop (intFormat to) x\n\n      _ -> panic \"PPC.CodeGen.getRegister: no match\"\n\n    where\n        triv_ucode_int   width instr = trivialUCode (intFormat    width) instr x\n        triv_ucode_float width instr = trivialUCode (floatFormat  width) instr x\n\n        conversionNop new_format expr\n            = do e_code <- getRegister' dflags expr\n                 return (swizzleRegisterRep e_code new_format)\n\n        clearLeft from to\n            = do (src1, code1) <- getSomeReg x\n                 let arch_fmt  = intFormat (wordWidth dflags)\n                     arch_bits = widthInBits (wordWidth dflags)\n                     size      = widthInBits from\n                     code dst  = code1 `snocOL`\n                                 CLRLI arch_fmt dst src1 (arch_bits - size)\n                 return (Any (intFormat to) code)\n\ngetRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps\n  = case mop of\n      MO_F_Eq _ -> condFltReg EQQ x y\n      MO_F_Ne _ -> condFltReg NE  x y\n      MO_F_Gt _ -> condFltReg GTT x y\n      MO_F_Ge _ -> condFltReg GE  x y\n      MO_F_Lt _ -> condFltReg LTT x y\n      MO_F_Le _ -> condFltReg LE  x y\n\n      MO_Eq rep -> condIntReg EQQ rep x y\n      MO_Ne rep -> condIntReg NE  rep x y\n\n      MO_S_Gt rep -> condIntReg GTT rep x y\n      MO_S_Ge rep -> condIntReg GE  rep x y\n      MO_S_Lt rep -> condIntReg LTT rep x y\n      MO_S_Le rep -> condIntReg LE  rep x y\n\n      MO_U_Gt rep -> condIntReg GU  rep x y\n      MO_U_Ge rep -> condIntReg GEU rep x y\n      MO_U_Lt rep -> condIntReg LU  rep x y\n      MO_U_Le rep -> condIntReg LEU rep x y\n\n      MO_F_Add w  -> triv_float w FADD\n      MO_F_Sub w  -> triv_float w FSUB\n      MO_F_Mul w  -> triv_float w FMUL\n      MO_F_Quot w -> triv_float w FDIV\n\n         -- optimize addition with 32-bit immediate\n         -- (needed for PIC)\n      MO_Add W32 ->\n        case y of\n          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate W32 True imm\n            -> trivialCode W32 True ADD x (CmmLit $ CmmInt imm immrep)\n          CmmLit lit\n            -> do\n                (src, srcCode) <- getSomeReg x\n                let imm = litToImm lit\n                    code dst = srcCode `appOL` toOL [\n                                    ADDIS dst src (HA imm),\n                                    ADD dst dst (RIImm (LO imm))\n                                ]\n                return (Any II32 code)\n          _ -> trivialCode W32 True ADD x y\n\n      MO_Add rep -> trivialCode rep True ADD x y\n      MO_Sub rep ->\n        case y of\n          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)\n            -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)\n          _ -> case x of\n                 CmmLit (CmmInt imm _)\n                   | Just _ <- makeImmediate rep True imm\n                   -- subfi ('substract from' with immediate) doesn't exist\n                   -> trivialCode rep True SUBFC y x\n                 _ -> trivialCodeNoImm' (intFormat rep) SUBF y x\n\n      MO_Mul rep -> shiftMulCode rep True MULL x y\n      MO_S_MulMayOflo rep -> do\n        (src1, code1) <- getSomeReg x\n        (src2, code2) <- getSomeReg y\n        let\n          format = intFormat rep\n          code dst = code1 `appOL` code2\n                       `appOL` toOL [ MULLO format dst src1 src2\n                                    , MFOV  format dst\n                                    ]\n        return (Any format code)\n\n      MO_S_Quot rep -> divCode rep True x y\n      MO_U_Quot rep -> divCode rep False x y\n\n      MO_S_Rem rep -> remainder rep True x y\n      MO_U_Rem rep -> remainder rep False x y\n\n      MO_And rep   -> case y of\n        (CmmLit (CmmInt imm _)) | imm == -8 || imm == -4\n            -> do\n                (src, srcCode) <- getSomeReg x\n                let clear_mask = if imm == -4 then 2 else 3\n                    fmt = intFormat rep\n                    code dst = srcCode\n                               `appOL` unitOL (CLRRI fmt dst src clear_mask)\n                return (Any fmt code)\n        _ -> trivialCode rep False AND x y\n      MO_Or rep    -> trivialCode rep False OR x y\n      MO_Xor rep   -> trivialCode rep False XOR x y\n\n      MO_Shl rep   -> shiftMulCode rep False SL x y\n      MO_S_Shr rep -> srCode rep True SRA x y\n      MO_U_Shr rep -> srCode rep False SR x y\n      _         -> panic \"PPC.CodeGen.getRegister: no match\"\n\n  where\n    triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register\n    triv_float width instr = trivialCodeNoImm (floatFormat width) instr x y\n\n    remainder :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register\n    remainder rep sgn x y = do\n      let fmt = intFormat rep\n      tmp <- getNewRegNat fmt\n      code <- remainderCode rep sgn tmp x y\n      return (Any fmt code)\n\n\ngetRegister' _ (CmmLit (CmmInt i rep))\n  | Just imm <- makeImmediate rep True i\n  = let\n        code dst = unitOL (LI dst imm)\n    in\n        return (Any (intFormat rep) code)\n\ngetRegister' _ (CmmLit (CmmFloat f frep)) = do\n    lbl <- getNewLabelNat\n    dflags <- getDynFlags\n    dynRef <- cmmMakeDynamicReference dflags DataReference lbl\n    Amode addr addr_code <- getAmode D dynRef\n    let format = floatFormat frep\n        code dst =\n            LDATA (Section ReadOnlyData lbl)\n                  (Statics lbl [CmmStaticLit (CmmFloat f frep)])\n            `consOL` (addr_code `snocOL` LD format dst addr)\n    return (Any format code)\n\ngetRegister' dflags (CmmLit lit)\n  | target32Bit (targetPlatform dflags)\n  = let rep = cmmLitType dflags lit\n        imm = litToImm lit\n        code dst = toOL [\n              LIS dst (HA imm),\n              ADD dst dst (RIImm (LO imm))\n          ]\n    in return (Any (cmmTypeFormat rep) code)\n  | otherwise\n  = do lbl <- getNewLabelNat\n       dflags <- getDynFlags\n       dynRef <- cmmMakeDynamicReference dflags DataReference lbl\n       Amode addr addr_code <- getAmode D dynRef\n       let rep = cmmLitType dflags lit\n           format = cmmTypeFormat rep\n           code dst =\n            LDATA (Section ReadOnlyData lbl) (Statics lbl [CmmStaticLit lit])\n            `consOL` (addr_code `snocOL` LD format dst addr)\n       return (Any format code)\n\ngetRegister' _ other = pprPanic \"getRegister(ppc)\" (pprExpr other)\n\n    -- extend?Rep: wrap integer expression of type `from`\n    -- in a conversion to `to`\nextendSExpr :: Width -> Width -> CmmExpr -> CmmExpr\nextendSExpr from to x = CmmMachOp (MO_SS_Conv from to) [x]\n\nextendUExpr :: Width -> Width -> CmmExpr -> CmmExpr\nextendUExpr from to x = CmmMachOp (MO_UU_Conv from to) [x]\n\n-- -----------------------------------------------------------------------------\n--  The 'Amode' type: Memory addressing modes passed up the tree.\n\ndata Amode\n        = Amode AddrMode InstrBlock\n\n{-\nNow, given a tree (the argument to a CmmLoad) that references memory,\nproduce a suitable addressing mode.\n\nA Rule of the Game (tm) for Amodes: use of the addr bit must\nimmediately follow use of the code part, since the code part puts\nvalues in registers which the addr then refers to.  So you can't put\nanything in between, lest it overwrite some of those registers.  If\nyou need to do some other computation between the code part and use of\nthe addr bit, first store the effective address from the amode in a\ntemporary, then do the other computation, and then use the temporary:\n\n    code\n    LEA amode, tmp\n    ... other computation ...\n    ... (tmp) ...\n-}\n\n{- Note [Power instruction format]\nIn some instructions the 16 bit offset must be a multiple of 4, i.e.\nthe two least significant bits must be zero. The \"Power ISA\" specification\ncalls these instruction formats \"DS-FORM\" and the instructions with\narbitrary 16 bit offsets are \"D-FORM\".\n\nThe Power ISA specification document can be obtained from www.power.org.\n-}\ndata InstrForm = D | DS\n\ngetAmode :: InstrForm -> CmmExpr -> NatM Amode\ngetAmode inf tree@(CmmRegOff _ _)\n  = do dflags <- getDynFlags\n       getAmode inf (mangleIndexTree dflags tree)\n\ngetAmode _ (CmmMachOp (MO_Sub W32) [x, CmmLit (CmmInt i _)])\n  | Just off <- makeImmediate W32 True (-i)\n  = do\n        (reg, code) <- getSomeReg x\n        return (Amode (AddrRegImm reg off) code)\n\n\ngetAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit (CmmInt i _)])\n  | Just off <- makeImmediate W32 True i\n  = do\n        (reg, code) <- getSomeReg x\n        return (Amode (AddrRegImm reg off) code)\n\ngetAmode D (CmmMachOp (MO_Sub W64) [x, CmmLit (CmmInt i _)])\n  | Just off <- makeImmediate W64 True (-i)\n  = do\n        (reg, code) <- getSomeReg x\n        return (Amode (AddrRegImm reg off) code)\n\n\ngetAmode D (CmmMachOp (MO_Add W64) [x, CmmLit (CmmInt i _)])\n  | Just off <- makeImmediate W64 True i\n  = do\n        (reg, code) <- getSomeReg x\n        return (Amode (AddrRegImm reg off) code)\n\ngetAmode DS (CmmMachOp (MO_Sub W64) [x, CmmLit (CmmInt i _)])\n  | Just off <- makeImmediate W64 True (-i)\n  = do\n        (reg, code) <- getSomeReg x\n        (reg', off', code')  <-\n                     if i `mod` 4 == 0\n                      then do return (reg, off, code)\n                      else do\n                           tmp <- getNewRegNat II64\n                           return (tmp, ImmInt 0,\n                                  code `snocOL` ADD tmp reg (RIImm off))\n        return (Amode (AddrRegImm reg' off') code')\n\ngetAmode DS (CmmMachOp (MO_Add W64) [x, CmmLit (CmmInt i _)])\n  | Just off <- makeImmediate W64 True i\n  = do\n        (reg, code) <- getSomeReg x\n        (reg', off', code')  <-\n                     if i `mod` 4 == 0\n                      then do return (reg, off, code)\n                      else do\n                           tmp <- getNewRegNat II64\n                           return (tmp, ImmInt 0,\n                                  code `snocOL` ADD tmp reg (RIImm off))\n        return (Amode (AddrRegImm reg' off') code')\n\n   -- optimize addition with 32-bit immediate\n   -- (needed for PIC)\ngetAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit lit])\n  = do\n        dflags <- getDynFlags\n        (src, srcCode) <- getSomeReg x\n        let imm = litToImm lit\n        case () of\n            _ | OSAIX <- platformOS (targetPlatform dflags)\n              , isCmmLabelType lit ->\n                    -- HA16/LO16 relocations on labels not supported on AIX\n                    return (Amode (AddrRegImm src imm) srcCode)\n              | otherwise -> do\n                    tmp <- getNewRegNat II32\n                    let code = srcCode `snocOL` ADDIS tmp src (HA imm)\n                    return (Amode (AddrRegImm tmp (LO imm)) code)\n  where\n      isCmmLabelType (CmmLabel {})        = True\n      isCmmLabelType (CmmLabelOff {})     = True\n      isCmmLabelType (CmmLabelDiffOff {}) = True\n      isCmmLabelType _                    = False\n\ngetAmode _ (CmmLit lit)\n  = do\n        dflags <- getDynFlags\n        case platformArch $ targetPlatform dflags of\n             ArchPPC -> do\n                 tmp <- getNewRegNat II32\n                 let imm = litToImm lit\n                     code = unitOL (LIS tmp (HA imm))\n                 return (Amode (AddrRegImm tmp (LO imm)) code)\n             _        -> do -- TODO: Load from TOC,\n                            -- see getRegister' _ (CmmLit lit)\n                 tmp <- getNewRegNat II64\n                 let imm = litToImm lit\n                     code =  toOL [\n                          LIS tmp (HIGHESTA imm),\n                          OR tmp tmp (RIImm (HIGHERA imm)),\n                          SL  II64 tmp tmp (RIImm (ImmInt 32)),\n                          ORIS tmp tmp (HA imm)\n                          ]\n                 return (Amode (AddrRegImm tmp (LO imm)) code)\n\ngetAmode _ (CmmMachOp (MO_Add W32) [x, y])\n  = do\n        (regX, codeX) <- getSomeReg x\n        (regY, codeY) <- getSomeReg y\n        return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))\n\ngetAmode _ (CmmMachOp (MO_Add W64) [x, y])\n  = do\n        (regX, codeX) <- getSomeReg x\n        (regY, codeY) <- getSomeReg y\n        return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))\n\ngetAmode _ other\n  = do\n        (reg, code) <- getSomeReg other\n        let\n            off  = ImmInt 0\n        return (Amode (AddrRegImm reg off) code)\n\n\n--  The 'CondCode' type:  Condition codes passed up the tree.\ndata CondCode\n        = CondCode Bool Cond InstrBlock\n\n-- Set up a condition code for a conditional branch.\n\ngetCondCode :: CmmExpr -> NatM CondCode\n\n-- almost the same as everywhere else - but we need to\n-- extend small integers to 32 bit or 64 bit first\n\ngetCondCode (CmmMachOp mop [x, y])\n  = do\n    case mop of\n      MO_F_Eq W32 -> condFltCode EQQ x y\n      MO_F_Ne W32 -> condFltCode NE  x y\n      MO_F_Gt W32 -> condFltCode GTT x y\n      MO_F_Ge W32 -> condFltCode GE  x y\n      MO_F_Lt W32 -> condFltCode LTT x y\n      MO_F_Le W32 -> condFltCode LE  x y\n\n      MO_F_Eq W64 -> condFltCode EQQ x y\n      MO_F_Ne W64 -> condFltCode NE  x y\n      MO_F_Gt W64 -> condFltCode GTT x y\n      MO_F_Ge W64 -> condFltCode GE  x y\n      MO_F_Lt W64 -> condFltCode LTT x y\n      MO_F_Le W64 -> condFltCode LE  x y\n\n      MO_Eq rep -> condIntCode EQQ rep x y\n      MO_Ne rep -> condIntCode NE  rep x y\n\n      MO_S_Gt rep -> condIntCode GTT rep x y\n      MO_S_Ge rep -> condIntCode GE  rep x y\n      MO_S_Lt rep -> condIntCode LTT rep x y\n      MO_S_Le rep -> condIntCode LE  rep x y\n\n      MO_U_Gt rep -> condIntCode GU  rep x y\n      MO_U_Ge rep -> condIntCode GEU rep x y\n      MO_U_Lt rep -> condIntCode LU  rep x y\n      MO_U_Le rep -> condIntCode LEU rep x y\n\n      _ -> pprPanic \"getCondCode(powerpc)\" (pprMachOp mop)\n\ngetCondCode _ = panic \"getCondCode(2)(powerpc)\"\n\n\n-- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be\n-- passed back up the tree.\n\ncondIntCode :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode\ncondIntCode cond width x y = do\n  dflags <- getDynFlags\n  condIntCode' (target32Bit (targetPlatform dflags)) cond width x y\n\ncondIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode\n\n-- simple code for 64-bit on 32-bit platforms\ncondIntCode' True cond W64 x y\n  | condUnsigned cond\n  = do\n      ChildCode64 code_x x_lo <- iselExpr64 x\n      ChildCode64 code_y y_lo <- iselExpr64 y\n      let x_hi = getHiVRegFromLo x_lo\n          y_hi = getHiVRegFromLo y_lo\n      end_lbl <- getBlockIdNat\n      let code = code_x `appOL` code_y `appOL` toOL\n                 [ CMPL II32 x_hi (RIReg y_hi)\n                 , BCC NE end_lbl Nothing\n                 , CMPL II32 x_lo (RIReg y_lo)\n                 , BCC ALWAYS end_lbl Nothing\n\n                 , NEWBLOCK end_lbl\n                 ]\n      return (CondCode False cond code)\n  | otherwise\n  = do\n      ChildCode64 code_x x_lo <- iselExpr64 x\n      ChildCode64 code_y y_lo <- iselExpr64 y\n      let x_hi = getHiVRegFromLo x_lo\n          y_hi = getHiVRegFromLo y_lo\n      end_lbl <- getBlockIdNat\n      cmp_lo  <- getBlockIdNat\n      let code = code_x `appOL` code_y `appOL` toOL\n                 [ CMP II32 x_hi (RIReg y_hi)\n                 , BCC NE end_lbl Nothing\n                 , CMP II32 x_hi (RIImm (ImmInt 0))\n                 , BCC LE cmp_lo Nothing\n                 , CMPL II32 x_lo (RIReg y_lo)\n                 , BCC ALWAYS end_lbl Nothing\n                 , CMPL II32 y_lo (RIReg x_lo)\n                 , BCC ALWAYS end_lbl Nothing\n\n                 , NEWBLOCK end_lbl\n                 ]\n      return (CondCode False cond code)\n\n-- optimize pointer tag checks. Operation andi. sets condition register\n-- so cmpi ..., 0 is redundant.\ncondIntCode' _ cond _ (CmmMachOp (MO_And _) [x, CmmLit (CmmInt imm rep)])\n                 (CmmLit (CmmInt 0 _))\n  | not $ condUnsigned cond,\n    Just src2 <- makeImmediate rep False imm\n  = do\n      (src1, code) <- getSomeReg x\n      let code' = code `snocOL` AND r0 src1 (RIImm src2)\n      return (CondCode False cond code')\n\ncondIntCode' _ cond width x (CmmLit (CmmInt y rep))\n  | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y\n  = do\n      let op_len = max W32 width\n      let extend = extendSExpr width op_len\n      (src1, code) <- getSomeReg (extend x)\n      let format = intFormat op_len\n          code' = code `snocOL`\n            (if condUnsigned cond then CMPL else CMP) format src1 (RIImm src2)\n      return (CondCode False cond code')\n\ncondIntCode' _ cond width x y = do\n  let op_len = max W32 width\n  let extend = if condUnsigned cond then extendUExpr width op_len\n               else extendSExpr width op_len\n  (src1, code1) <- getSomeReg (extend x)\n  (src2, code2) <- getSomeReg (extend y)\n  let format = intFormat op_len\n      code' = code1 `appOL` code2 `snocOL`\n        (if condUnsigned cond then CMPL else CMP) format src1 (RIReg src2)\n  return (CondCode False cond code')\n\ncondFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode\ncondFltCode cond x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let\n        code'  = code1 `appOL` code2 `snocOL` FCMP src1 src2\n        code'' = case cond of -- twiddle CR to handle unordered case\n                    GE -> code' `snocOL` CRNOR ltbit eqbit gtbit\n                    LE -> code' `snocOL` CRNOR gtbit eqbit ltbit\n                    _ -> code'\n                 where\n                    ltbit = 0 ; eqbit = 2 ; gtbit = 1\n    return (CondCode True cond code'')\n\n\n\n-- -----------------------------------------------------------------------------\n-- Generating assignments\n\n-- Assignments are really at the heart of the whole code generation\n-- business.  Almost all top-level nodes of any real importance are\n-- assignments, which correspond to loads, stores, or register\n-- transfers.  If we're really lucky, some of the register transfers\n-- will go away, because we can use the destination register to\n-- complete the code generation for the right hand side.  This only\n-- fails when the right hand side is forced into a fixed register\n-- (e.g. the result of a call).\n\nassignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock\nassignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock\n\nassignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock\nassignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock\n\nassignMem_IntCode pk addr src = do\n    (srcReg, code) <- getSomeReg src\n    Amode dstAddr addr_code <- case pk of\n                                II64 -> getAmode DS addr\n                                _    -> getAmode D  addr\n    return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr\n\n-- dst is a reg, but src could be anything\nassignReg_IntCode _ reg src\n    = do\n        dflags <- getDynFlags\n        let dst = getRegisterReg (targetPlatform dflags) reg\n        r <- getRegister src\n        return $ case r of\n            Any _ code         -> code dst\n            Fixed _ freg fcode -> fcode `snocOL` MR dst freg\n\n\n\n-- Easy, isn't it?\nassignMem_FltCode = assignMem_IntCode\nassignReg_FltCode = assignReg_IntCode\n\n\n\ngenJump :: CmmExpr{-the branch target-} -> NatM InstrBlock\n\ngenJump (CmmLit (CmmLabel lbl))\n  = return (unitOL $ JMP lbl)\n\ngenJump tree\n  = do\n        dflags <- getDynFlags\n        genJump' tree (platformToGCP (targetPlatform dflags))\n\ngenJump' :: CmmExpr -> GenCCallPlatform -> NatM InstrBlock\n\ngenJump' tree (GCP64ELF 1)\n  = do\n        (target,code) <- getSomeReg tree\n        return (code\n               `snocOL` LD II64 r11 (AddrRegImm target (ImmInt 0))\n               `snocOL` LD II64 toc (AddrRegImm target (ImmInt 8))\n               `snocOL` MTCTR r11\n               `snocOL` LD II64 r11 (AddrRegImm target (ImmInt 16))\n               `snocOL` BCTR [] Nothing)\n\ngenJump' tree (GCP64ELF 2)\n  = do\n        (target,code) <- getSomeReg tree\n        return (code\n               `snocOL` MR r12 target\n               `snocOL` MTCTR r12\n               `snocOL` BCTR [] Nothing)\n\ngenJump' tree _\n  = do\n        (target,code) <- getSomeReg tree\n        return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing)\n\n-- -----------------------------------------------------------------------------\n--  Unconditional branches\ngenBranch :: BlockId -> NatM InstrBlock\ngenBranch = return . toOL . mkJumpInstr\n\n\n-- -----------------------------------------------------------------------------\n--  Conditional jumps\n\n{-\nConditional jumps are always to local labels, so we can use branch\ninstructions.  We peek at the arguments to decide what kind of\ncomparison to do.\n-}\n\n\ngenCondJump\n    :: BlockId      -- the branch target\n    -> CmmExpr      -- the condition on which to branch\n    -> Maybe Bool\n    -> NatM InstrBlock\n\ngenCondJump id bool prediction = do\n  CondCode _ cond code <- getCondCode bool\n  return (code `snocOL` BCC cond id prediction)\n\n\n\n-- -----------------------------------------------------------------------------\n--  Generating C calls\n\n-- Now the biggest nightmare---calls.  Most of the nastiness is buried in\n-- @get_arg@, which moves the arguments to the correct registers/stack\n-- locations.  Apart from that, the code is easy.\n\ngenCCall :: ForeignTarget      -- function to call\n         -> [CmmFormal]        -- where to put the result\n         -> [CmmActual]        -- arguments (of mixed type)\n         -> NatM InstrBlock\ngenCCall (PrimTarget MO_WriteBarrier) _ _\n = return $ unitOL LWSYNC\n\ngenCCall (PrimTarget MO_Touch) _ _\n = return $ nilOL\n\ngenCCall (PrimTarget (MO_Prefetch_Data _)) _ _\n = return $ nilOL\n\ngenCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]\n = do dflags <- getDynFlags\n      let platform = targetPlatform dflags\n          fmt      = intFormat width\n          reg_dst  = getRegisterReg platform (CmmLocal dst)\n      (instr, n_code) <- case amop of\n            AMO_Add  -> getSomeRegOrImm ADD True reg_dst\n            AMO_Sub  -> case n of\n                CmmLit (CmmInt i _)\n                  | Just imm <- makeImmediate width True (-i)\n                   -> return (ADD reg_dst reg_dst (RIImm imm), nilOL)\n                _\n                   -> do\n                         (n_reg, n_code) <- getSomeReg n\n                         return  (SUBF reg_dst n_reg reg_dst, n_code)\n            AMO_And  -> getSomeRegOrImm AND False reg_dst\n            AMO_Nand -> do (n_reg, n_code) <- getSomeReg n\n                           return (NAND reg_dst reg_dst n_reg, n_code)\n            AMO_Or   -> getSomeRegOrImm OR False reg_dst\n            AMO_Xor  -> getSomeRegOrImm XOR False reg_dst\n      Amode addr_reg addr_code <- getAmodeIndex addr\n      lbl_retry <- getBlockIdNat\n      return $ n_code `appOL` addr_code\n        `appOL` toOL [ HWSYNC\n                     , BCC ALWAYS lbl_retry Nothing\n\n                     , NEWBLOCK lbl_retry\n                     , LDR fmt reg_dst addr_reg\n                     , instr\n                     , STC fmt reg_dst addr_reg\n                     , BCC NE lbl_retry (Just False)\n                     , ISYNC\n                     ]\n         where\n           getAmodeIndex (CmmMachOp (MO_Add _) [x, y])\n             = do\n                 (regX, codeX) <- getSomeReg x\n                 (regY, codeY) <- getSomeReg y\n                 return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))\n           getAmodeIndex other\n             = do\n                 (reg, code) <- getSomeReg other\n                 return (Amode (AddrRegReg r0 reg) code) -- NB: r0 is 0 here!\n           getSomeRegOrImm op sign dst\n             = case n of\n                 CmmLit (CmmInt i _) | Just imm <- makeImmediate width sign i\n                    -> return (op dst dst (RIImm imm), nilOL)\n                 _\n                    -> do\n                          (n_reg, n_code) <- getSomeReg n\n                          return  (op dst dst (RIReg n_reg), n_code)\n\ngenCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]\n = do dflags <- getDynFlags\n      let platform = targetPlatform dflags\n          fmt      = intFormat width\n          reg_dst  = getRegisterReg platform (CmmLocal dst)\n          form     = if widthInBits width == 64 then DS else D\n      Amode addr_reg addr_code <- getAmode form addr\n      lbl_end <- getBlockIdNat\n      return $ addr_code `appOL` toOL [ HWSYNC\n                                      , LD fmt reg_dst addr_reg\n                                      , CMP fmt reg_dst (RIReg reg_dst)\n                                      , BCC NE lbl_end (Just False)\n                                      , BCC ALWAYS lbl_end Nothing\n                            -- See Note [Seemingly useless cmp and bne]\n                                      , NEWBLOCK lbl_end\n                                      , ISYNC\n                                      ]\n\n-- Note [Seemingly useless cmp and bne]\n-- In Power ISA, Book II, Section 4.4.1, Instruction Synchronize Instruction\n-- the second paragraph says that isync may complete before storage accesses\n-- \"associated\" with a preceding instruction have been performed. The cmp\n-- operation and the following bne introduce a data and control dependency\n-- on the load instruction (See also Power ISA, Book II, Appendix B.2.3, Safe\n-- Fetch).\n-- This is also what gcc does.\n\n\ngenCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do\n    code <- assignMem_IntCode (intFormat width) addr val\n    return $ unitOL(HWSYNC) `appOL` code\n\ngenCCall (PrimTarget (MO_Clz width)) [dst] [src]\n = do dflags <- getDynFlags\n      let platform = targetPlatform dflags\n          reg_dst = getRegisterReg platform (CmmLocal dst)\n      if target32Bit platform && width == W64\n        then do\n          ChildCode64 code vr_lo <- iselExpr64 src\n          lbl1 <- getBlockIdNat\n          lbl2 <- getBlockIdNat\n          lbl3 <- getBlockIdNat\n          let vr_hi = getHiVRegFromLo vr_lo\n              cntlz = toOL [ CMPL II32 vr_hi (RIImm (ImmInt 0))\n                           , BCC NE lbl2 Nothing\n                           , BCC ALWAYS lbl1 Nothing\n\n                           , NEWBLOCK lbl1\n                           , CNTLZ II32 reg_dst vr_lo\n                           , ADD reg_dst reg_dst (RIImm (ImmInt 32))\n                           , BCC ALWAYS lbl3 Nothing\n\n                           , NEWBLOCK lbl2\n                           , CNTLZ II32 reg_dst vr_hi\n                           , BCC ALWAYS lbl3 Nothing\n\n                           , NEWBLOCK lbl3\n                           ]\n          return $ code `appOL` cntlz\n        else do\n          let format = if width == W64 then II64 else II32\n          (s_reg, s_code) <- getSomeReg src\n          (pre, reg , post) <-\n            case width of\n              W64 -> return (nilOL, s_reg, nilOL)\n              W32 -> return (nilOL, s_reg, nilOL)\n              W16 -> do\n                reg_tmp <- getNewRegNat format\n                return\n                  ( unitOL $ AND reg_tmp s_reg (RIImm (ImmInt 65535))\n                  , reg_tmp\n                  , unitOL $ ADD reg_dst reg_dst (RIImm (ImmInt (-16)))\n                  )\n              W8  -> do\n                reg_tmp <- getNewRegNat format\n                return\n                  ( unitOL $ AND reg_tmp s_reg (RIImm (ImmInt 255))\n                  , reg_tmp\n                  , unitOL $ ADD reg_dst reg_dst (RIImm (ImmInt (-24)))\n                  )\n              _   -> panic \"genCall: Clz wrong format\"\n          let cntlz = unitOL (CNTLZ format reg_dst reg)\n          return $ s_code `appOL` pre `appOL` cntlz `appOL` post\n\ngenCCall (PrimTarget (MO_Ctz width)) [dst] [src]\n = do dflags <- getDynFlags\n      let platform = targetPlatform dflags\n          reg_dst = getRegisterReg platform (CmmLocal dst)\n      if target32Bit platform && width == W64\n        then do\n          let format = II32\n          ChildCode64 code vr_lo <- iselExpr64 src\n          lbl1 <- getBlockIdNat\n          lbl2 <- getBlockIdNat\n          lbl3 <- getBlockIdNat\n          x' <- getNewRegNat format\n          x'' <- getNewRegNat format\n          r' <- getNewRegNat format\n          cnttzlo <- cnttz format reg_dst vr_lo\n          let vr_hi = getHiVRegFromLo vr_lo\n              cnttz64 = toOL [ CMPL format vr_lo (RIImm (ImmInt 0))\n                             , BCC NE lbl2 Nothing\n                             , BCC ALWAYS lbl1 Nothing\n\n                             , NEWBLOCK lbl1\n                             , ADD x' vr_hi (RIImm (ImmInt (-1)))\n                             , ANDC x'' x' vr_hi\n                             , CNTLZ format r' x''\n                               -- 32 + (32 - clz(x''))\n                             , SUBFC reg_dst r' (RIImm (ImmInt 64))\n                             , BCC ALWAYS lbl3 Nothing\n\n                             , NEWBLOCK lbl2\n                             ]\n                        `appOL` cnttzlo `appOL`\n                        toOL [ BCC ALWAYS lbl3 Nothing\n\n                             , NEWBLOCK lbl3\n                             ]\n          return $ code `appOL` cnttz64\n        else do\n          let format = if width == W64 then II64 else II32\n          (s_reg, s_code) <- getSomeReg src\n          (reg_ctz, pre_code) <-\n            case width of\n              W64 -> return (s_reg, nilOL)\n              W32 -> return (s_reg, nilOL)\n              W16 -> do\n                reg_tmp <- getNewRegNat format\n                return (reg_tmp, unitOL $ ORIS reg_tmp s_reg (ImmInt 1))\n              W8  -> do\n                reg_tmp <- getNewRegNat format\n                return (reg_tmp, unitOL $ OR reg_tmp s_reg (RIImm (ImmInt 256)))\n              _   -> panic \"genCall: Ctz wrong format\"\n          ctz_code <- cnttz format reg_dst reg_ctz\n          return $ s_code `appOL` pre_code `appOL` ctz_code\n        where\n          -- cnttz(x) = sizeof(x) - cntlz(~x & (x - 1))\n          -- see Henry S. Warren, Hacker's Delight, p 107\n          cnttz format dst src = do\n            let format_bits = 8 * formatInBytes format\n            x' <- getNewRegNat format\n            x'' <- getNewRegNat format\n            r' <- getNewRegNat format\n            return $ toOL [ ADD x' src (RIImm (ImmInt (-1)))\n                          , ANDC x'' x' src\n                          , CNTLZ format r' x''\n                          , SUBFC dst r' (RIImm (ImmInt (format_bits)))\n                          ]\n\ngenCCall target dest_regs argsAndHints\n = do dflags <- getDynFlags\n      let platform = targetPlatform dflags\n      case target of\n        PrimTarget (MO_S_QuotRem  width) -> divOp1 platform True  width\n                                                   dest_regs argsAndHints\n        PrimTarget (MO_U_QuotRem  width) -> divOp1 platform False width\n                                                   dest_regs argsAndHints\n        PrimTarget (MO_U_QuotRem2 width) -> divOp2 platform width dest_regs\n                                                   argsAndHints\n        PrimTarget (MO_U_Mul2 width) -> multOp2 platform width dest_regs\n                                                argsAndHints\n        PrimTarget (MO_Add2 _) -> add2Op platform dest_regs argsAndHints\n        PrimTarget (MO_AddWordC _) -> addcOp platform dest_regs argsAndHints\n        PrimTarget (MO_SubWordC _) -> subcOp platform dest_regs argsAndHints\n        PrimTarget (MO_AddIntC width) -> addSubCOp ADDO platform width\n                                                   dest_regs argsAndHints\n        PrimTarget (MO_SubIntC width) -> addSubCOp SUBFO platform width\n                                                   dest_regs argsAndHints\n        PrimTarget MO_F64_Fabs -> fabs platform dest_regs argsAndHints\n        PrimTarget MO_F32_Fabs -> fabs platform dest_regs argsAndHints\n        _ -> genCCall' dflags (platformToGCP platform)\n                       target dest_regs argsAndHints\n        where divOp1 platform signed width [res_q, res_r] [arg_x, arg_y]\n                = do let reg_q = getRegisterReg platform (CmmLocal res_q)\n                         reg_r = getRegisterReg platform (CmmLocal res_r)\n                     remainderCode width signed reg_q arg_x arg_y\n                       <*> pure reg_r\n\n              divOp1 _ _ _ _ _\n                = panic \"genCCall: Wrong number of arguments for divOp1\"\n              divOp2 platform width [res_q, res_r]\n                                    [arg_x_high, arg_x_low, arg_y]\n                = do let reg_q = getRegisterReg platform (CmmLocal res_q)\n                         reg_r = getRegisterReg platform (CmmLocal res_r)\n                         fmt   = intFormat width\n                         half  = 4 * (formatInBytes fmt)\n                     (xh_reg, xh_code) <- getSomeReg arg_x_high\n                     (xl_reg, xl_code) <- getSomeReg arg_x_low\n                     (y_reg, y_code) <- getSomeReg arg_y\n                     s <- getNewRegNat fmt\n                     b <- getNewRegNat fmt\n                     v <- getNewRegNat fmt\n                     vn1 <- getNewRegNat fmt\n                     vn0 <- getNewRegNat fmt\n                     un32 <- getNewRegNat fmt\n                     tmp  <- getNewRegNat fmt\n                     un10 <- getNewRegNat fmt\n                     un1 <- getNewRegNat fmt\n                     un0 <- getNewRegNat fmt\n                     q1 <- getNewRegNat fmt\n                     rhat <- getNewRegNat fmt\n                     tmp1 <- getNewRegNat fmt\n                     q0 <- getNewRegNat fmt\n                     un21 <- getNewRegNat fmt\n                     again1 <- getBlockIdNat\n                     no1 <- getBlockIdNat\n                     then1 <- getBlockIdNat\n                     endif1 <- getBlockIdNat\n                     again2 <- getBlockIdNat\n                     no2 <- getBlockIdNat\n                     then2 <- getBlockIdNat\n                     endif2 <- getBlockIdNat\n                     return $ y_code `appOL` xl_code `appOL` xh_code `appOL`\n                              -- see Hacker's Delight p 196 Figure 9-3\n                              toOL [ -- b = 2 ^ (bits_in_word / 2)\n                                     LI b (ImmInt 1)\n                                   , SL fmt b b (RIImm (ImmInt half))\n                                     -- s = clz(y)\n                                   , CNTLZ fmt s y_reg\n                                     -- v = y << s\n                                   , SL fmt v y_reg (RIReg s)\n                                     -- vn1 = upper half of v\n                                   , SR fmt vn1 v (RIImm (ImmInt half))\n                                     -- vn0 = lower half of v\n                                   , CLRLI fmt vn0 v half\n                                     -- un32 = (u1 << s)\n                                     --      | (u0 >> (bits_in_word - s))\n                                   , SL fmt un32 xh_reg (RIReg s)\n                                   , SUBFC tmp s\n                                        (RIImm (ImmInt (8 * formatInBytes fmt)))\n                                   , SR fmt tmp xl_reg (RIReg tmp)\n                                   , OR un32 un32 (RIReg tmp)\n                                     -- un10 = u0 << s\n                                   , SL fmt un10 xl_reg (RIReg s)\n                                     -- un1 = upper half of un10\n                                   , SR fmt un1 un10 (RIImm (ImmInt half))\n                                     -- un0 = lower half of un10\n                                   , CLRLI fmt un0 un10 half\n                                     -- q1 = un32/vn1\n                                   , DIV fmt False q1 un32 vn1\n                                     -- rhat = un32 - q1*vn1\n                                   , MULL fmt tmp q1 (RIReg vn1)\n                                   , SUBF rhat tmp un32\n                                   , BCC ALWAYS again1 Nothing\n\n                                   , NEWBLOCK again1\n                                     -- if (q1 >= b || q1*vn0 > b*rhat + un1)\n                                   , CMPL fmt q1 (RIReg b)\n                                   , BCC GEU then1 Nothing\n                                   , BCC ALWAYS no1 Nothing\n\n                                   , NEWBLOCK no1\n                                   , MULL fmt tmp q1 (RIReg vn0)\n                                   , SL fmt tmp1 rhat (RIImm (ImmInt half))\n                                   , ADD tmp1 tmp1 (RIReg un1)\n                                   , CMPL fmt tmp (RIReg tmp1)\n                                   , BCC LEU endif1 Nothing\n                                   , BCC ALWAYS then1 Nothing\n\n                                   , NEWBLOCK then1\n                                     -- q1 = q1 - 1\n                                   , ADD q1 q1 (RIImm (ImmInt (-1)))\n                                     -- rhat = rhat + vn1\n                                   , ADD rhat rhat (RIReg vn1)\n                                     -- if (rhat < b) goto again1\n                                   , CMPL fmt rhat (RIReg b)\n                                   , BCC LTT again1 Nothing\n                                   , BCC ALWAYS endif1 Nothing\n\n                                   , NEWBLOCK endif1\n                                     -- un21 = un32*b + un1 - q1*v\n                                   , SL fmt un21 un32 (RIImm (ImmInt half))\n                                   , ADD un21 un21 (RIReg un1)\n                                   , MULL fmt tmp q1 (RIReg v)\n                                   , SUBF un21 tmp un21\n                                     -- compute second quotient digit\n                                     -- q0 = un21/vn1\n                                   , DIV fmt False q0 un21 vn1\n                                     -- rhat = un21- q0*vn1\n                                   , MULL fmt tmp q0 (RIReg vn1)\n                                   , SUBF rhat tmp un21\n                                   , BCC ALWAYS again2 Nothing\n\n                                   , NEWBLOCK again2\n                                     -- if (q0>b || q0*vn0 > b*rhat + un0)\n                                   , CMPL fmt q0 (RIReg b)\n                                   , BCC GEU then2 Nothing\n                                   , BCC ALWAYS no2 Nothing\n\n                                   , NEWBLOCK no2\n                                   , MULL fmt tmp q0 (RIReg vn0)\n                                   , SL fmt tmp1 rhat (RIImm (ImmInt half))\n                                   , ADD tmp1 tmp1 (RIReg un0)\n                                   , CMPL fmt tmp (RIReg tmp1)\n                                   , BCC LEU endif2 Nothing\n                                   , BCC ALWAYS then2 Nothing\n\n                                   , NEWBLOCK then2\n                                     -- q0 = q0 - 1\n                                   , ADD q0 q0 (RIImm (ImmInt (-1)))\n                                     -- rhat = rhat + vn1\n                                   , ADD rhat rhat (RIReg vn1)\n                                     -- if (rhat<b) goto again2\n                                   , CMPL fmt rhat (RIReg b)\n                                   , BCC LTT again2 Nothing\n                                   , BCC ALWAYS endif2 Nothing\n\n                                   , NEWBLOCK endif2\n                                     -- compute remainder\n                                     -- r = (un21*b + un0 - q0*v) >> s\n                                   , SL fmt reg_r un21 (RIImm (ImmInt half))\n                                   , ADD reg_r reg_r (RIReg un0)\n                                   , MULL fmt tmp q0 (RIReg v)\n                                   , SUBF reg_r tmp reg_r\n                                   , SR fmt reg_r reg_r (RIReg s)\n                                     -- compute quotient\n                                     -- q = q1*b + q0\n                                   , SL fmt reg_q q1 (RIImm (ImmInt half))\n                                   , ADD reg_q reg_q (RIReg q0)\n                                   ]\n              divOp2 _ _ _ _\n                = panic \"genCCall: Wrong number of arguments for divOp2\"\n              multOp2 platform width [res_h, res_l] [arg_x, arg_y]\n                = do let reg_h = getRegisterReg platform (CmmLocal res_h)\n                         reg_l = getRegisterReg platform (CmmLocal res_l)\n                         fmt = intFormat width\n                     (x_reg, x_code) <- getSomeReg arg_x\n                     (y_reg, y_code) <- getSomeReg arg_y\n                     return $ y_code `appOL` x_code\n                            `appOL` toOL [ MULL fmt reg_l x_reg (RIReg y_reg)\n                                         , MULHU fmt reg_h x_reg y_reg\n                                         ]\n              multOp2 _ _ _ _\n                = panic \"genCall: Wrong number of arguments for multOp2\"\n              add2Op platform [res_h, res_l] [arg_x, arg_y]\n                = do let reg_h = getRegisterReg platform (CmmLocal res_h)\n                         reg_l = getRegisterReg platform (CmmLocal res_l)\n                     (x_reg, x_code) <- getSomeReg arg_x\n                     (y_reg, y_code) <- getSomeReg arg_y\n                     return $ y_code `appOL` x_code\n                            `appOL` toOL [ LI reg_h (ImmInt 0)\n                                         , ADDC reg_l x_reg y_reg\n                                         , ADDZE reg_h reg_h\n                                         ]\n              add2Op _ _ _\n                = panic \"genCCall: Wrong number of arguments/results for add2\"\n\n              addcOp platform [res_r, res_c] [arg_x, arg_y]\n                = add2Op platform [res_c {-hi-}, res_r {-lo-}] [arg_x, arg_y]\n              addcOp _ _ _\n                = panic \"genCCall: Wrong number of arguments/results for addc\"\n\n              -- PowerPC subfc sets the carry for rT = ~(rA) + rB + 1,\n              -- which is 0 for borrow and 1 otherwise. We need 1 and 0\n              -- so xor with 1.\n              subcOp platform [res_r, res_c] [arg_x, arg_y]\n                = do let reg_r = getRegisterReg platform (CmmLocal res_r)\n                         reg_c = getRegisterReg platform (CmmLocal res_c)\n                     (x_reg, x_code) <- getSomeReg arg_x\n                     (y_reg, y_code) <- getSomeReg arg_y\n                     return $ y_code `appOL` x_code\n                            `appOL` toOL [ LI reg_c (ImmInt 0)\n                                         , SUBFC reg_r y_reg (RIReg x_reg)\n                                         , ADDZE reg_c reg_c\n                                         , XOR reg_c reg_c (RIImm (ImmInt 1))\n                                         ]\n              subcOp _ _ _\n                = panic \"genCCall: Wrong number of arguments/results for subc\"\n              addSubCOp instr platform width [res_r, res_c] [arg_x, arg_y]\n                = do let reg_r = getRegisterReg platform (CmmLocal res_r)\n                         reg_c = getRegisterReg platform (CmmLocal res_c)\n                     (x_reg, x_code) <- getSomeReg arg_x\n                     (y_reg, y_code) <- getSomeReg arg_y\n                     return $ y_code `appOL` x_code\n                            `appOL` toOL [ instr reg_r y_reg x_reg,\n                                           -- SUBFO argument order reversed!\n                                           MFOV (intFormat width) reg_c\n                                         ]\n              addSubCOp _ _ _ _ _\n                = panic \"genCall: Wrong number of arguments/results for addC\"\n              fabs platform [res] [arg]\n                = do let res_r = getRegisterReg platform (CmmLocal res)\n                     (arg_reg, arg_code) <- getSomeReg arg\n                     return $ arg_code `snocOL` FABS res_r arg_reg\n              fabs _ _ _\n                = panic \"genCall: Wrong number of arguments/results for fabs\"\n\n-- TODO: replace 'Int' by an enum such as 'PPC_64ABI'\ndata GenCCallPlatform = GCP32ELF | GCP64ELF !Int | GCPAIX\n\nplatformToGCP :: Platform -> GenCCallPlatform\nplatformToGCP platform\n  = case platformOS platform of\n      OSAIX    -> GCPAIX\n      _ -> case platformArch platform of\n             ArchPPC           -> GCP32ELF\n             ArchPPC_64 ELF_V1 -> GCP64ELF 1\n             ArchPPC_64 ELF_V2 -> GCP64ELF 2\n             _ -> panic \"platformToGCP: Not PowerPC\"\n\n\ngenCCall'\n    :: DynFlags\n    -> GenCCallPlatform\n    -> ForeignTarget            -- function to call\n    -> [CmmFormal]        -- where to put the result\n    -> [CmmActual]        -- arguments (of mixed type)\n    -> NatM InstrBlock\n\n{- \n    PowerPC Linux uses the System V Release 4 Calling Convention\n    for PowerPC. It is described in the\n    \"System V Application Binary Interface PowerPC Processor Supplement\".\n\n    PowerPC 64 Linux uses the System V Release 4 Calling Convention for\n    64-bit PowerPC. It is specified in\n    \"64-bit PowerPC ELF Application Binary Interface Supplement 1.9\"\n    (PPC64 ELF v1.9).\n\n    PowerPC 64 Linux in little endian mode uses the \"Power Architecture 64-Bit\n    ELF V2 ABI Specification -- OpenPOWER ABI for Linux Supplement\"\n    (PPC64 ELF v2).\n\n    AIX follows the \"PowerOpen ABI: Application Binary Interface Big-Endian\n    32-Bit Hardware Implementation\"\n\n    All four conventions are similar:\n    Parameters may be passed in general-purpose registers starting at r3, in\n    floating point registers starting at f1, or on the stack.\n\n    But there are substantial differences:\n    * The number of registers used for parameter passing and the exact set of\n      nonvolatile registers differs (see MachRegs.hs).\n    * On AIX and 64-bit ELF, stack space is always reserved for parameters,\n      even if they are passed in registers. The called routine may choose to\n      save parameters from registers to the corresponding space on the stack.\n    * On AIX and 64-bit ELF, a corresponding amount of GPRs is skipped when\n      a floating point parameter is passed in an FPR.\n    * SysV insists on either passing I64 arguments on the stack, or in two GPRs,\n      starting with an odd-numbered GPR. It may skip a GPR to achieve this.\n      AIX just treats an I64 likt two separate I32s (high word first).\n    * I64 and FF64 arguments are 8-byte aligned on the stack for SysV, but only\n      4-byte aligned like everything else on AIX.\n    * The SysV spec claims that FF32 is represented as FF64 on the stack. GCC on\n      PowerPC Linux does not agree, so neither do we.\n\n    According to all conventions, the parameter area should be part of the\n    caller's stack frame, allocated in the caller's prologue code (large enough\n    to hold the parameter lists for all called routines). The NCG already\n    uses the stack for register spilling, leaving 64 bytes free at the top.\n    If we need a larger parameter area than that, we increase the size\n    of the stack frame just before ccalling.\n-}\n\n\ngenCCall' dflags gcp target dest_regs args\n  = do\n        (finalStack,passArgumentsCode,usedRegs) <- passArguments\n                                                   (zip3 args argReps argHints)\n                                                   allArgRegs\n                                                   (allFPArgRegs platform)\n                                                   initialStackOffset\n                                                   nilOL []\n\n        (labelOrExpr, reduceToFF32) <- case target of\n            ForeignTarget (CmmLit (CmmLabel lbl)) _ -> do\n                uses_pic_base_implicitly\n                return (Left lbl, False)\n            ForeignTarget expr _ -> do\n                uses_pic_base_implicitly\n                return (Right expr, False)\n            PrimTarget mop -> outOfLineMachOp mop\n\n        let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode\n            codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32\n\n        case labelOrExpr of\n            Left lbl -> do -- the linker does all the work for us\n                return (         codeBefore\n                        `snocOL` BL lbl usedRegs\n                        `appOL`  maybeNOP -- some ABI require a NOP after BL\n                        `appOL`  codeAfter)\n            Right dyn -> do -- implement call through function pointer\n                (dynReg, dynCode) <- getSomeReg dyn\n                case gcp of\n                     GCP64ELF 1      -> return ( dynCode\n                       `appOL`  codeBefore\n                       `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 40))\n                       `snocOL` LD II64 r11 (AddrRegImm dynReg (ImmInt 0))\n                       `snocOL` LD II64 toc (AddrRegImm dynReg (ImmInt 8))\n                       `snocOL` MTCTR r11\n                       `snocOL` LD II64 r11 (AddrRegImm dynReg (ImmInt 16))\n                       `snocOL` BCTRL usedRegs\n                       `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 40))\n                       `appOL`  codeAfter)\n                     GCP64ELF 2      -> return ( dynCode\n                       `appOL`  codeBefore\n                       `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 24))\n                       `snocOL` MR r12 dynReg\n                       `snocOL` MTCTR r12\n                       `snocOL` BCTRL usedRegs\n                       `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 24))\n                       `appOL`  codeAfter)\n                     GCPAIX          -> return ( dynCode\n                       -- AIX/XCOFF follows the PowerOPEN ABI\n                       -- which is quite similiar to LinuxPPC64/ELFv1\n                       `appOL`  codeBefore\n                       `snocOL` ST spFormat toc (AddrRegImm sp (ImmInt 20))\n                       `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 0))\n                       `snocOL` LD II32 toc (AddrRegImm dynReg (ImmInt 4))\n                       `snocOL` MTCTR r11\n                       `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 8))\n                       `snocOL` BCTRL usedRegs\n                       `snocOL` LD spFormat toc (AddrRegImm sp (ImmInt 20))\n                       `appOL`  codeAfter)\n                     _               -> return ( dynCode\n                       `snocOL` MTCTR dynReg\n                       `appOL`  codeBefore\n                       `snocOL` BCTRL usedRegs\n                       `appOL`  codeAfter)\n    where\n        platform = targetPlatform dflags\n\n        uses_pic_base_implicitly = do\n            -- See Note [implicit register in PPC PIC code]\n            -- on why we claim to use PIC register here\n            when (positionIndependent dflags && target32Bit platform) $ do\n                _ <- getPicBaseNat $ archWordFormat True\n                return ()\n\n        initialStackOffset = case gcp of\n                             GCPAIX     -> 24\n                             GCP32ELF   -> 8\n                             GCP64ELF 1 -> 48\n                             GCP64ELF 2 -> 32\n                             _ -> panic \"genCall': unknown calling convention\"\n            -- size of linkage area + size of arguments, in bytes\n        stackDelta finalStack = case gcp of\n                                GCPAIX ->\n                                    roundTo 16 $ (24 +) $ max 32 $ sum $\n                                    map (widthInBytes . typeWidth) argReps\n                                GCP32ELF -> roundTo 16 finalStack\n                                GCP64ELF 1 ->\n                                    roundTo 16 $ (48 +) $ max 64 $ sum $\n                                    map (roundTo 8 . widthInBytes . typeWidth)\n                                        argReps\n                                GCP64ELF 2 ->\n                                    roundTo 16 $ (32 +) $ max 64 $ sum $\n                                    map (roundTo 8 . widthInBytes . typeWidth)\n                                        argReps\n                                _ -> panic \"genCall': unknown calling conv.\"\n\n        argReps = map (cmmExprType dflags) args\n        (argHints, _) = foreignTargetHints target\n\n        roundTo a x | x `mod` a == 0 = x\n                    | otherwise = x + a - (x `mod` a)\n\n        spFormat = if target32Bit platform then II32 else II64\n\n        -- TODO: Do not create a new stack frame if delta is too large.\n        move_sp_down finalStack\n               | delta > stackFrameHeaderSize dflags =\n                        toOL [STU spFormat sp (AddrRegImm sp (ImmInt (-delta))),\n                              DELTA (-delta)]\n               | otherwise = nilOL\n               where delta = stackDelta finalStack\n        move_sp_up finalStack\n               | delta > stackFrameHeaderSize dflags =\n                        toOL [ADD sp sp (RIImm (ImmInt delta)),\n                              DELTA 0]\n               | otherwise = nilOL\n               where delta = stackDelta finalStack\n\n        -- A NOP instruction is required after a call (bl instruction)\n        -- on AIX and 64-Bit Linux.\n        -- If the call is to a function with a different TOC (r2) the\n        -- link editor replaces the NOP instruction with a load of the TOC\n        -- from the stack to restore the TOC.\n        maybeNOP = case gcp of\n           GCP32ELF        -> nilOL\n           -- See Section 3.9.4 of OpenPower ABI\n           GCPAIX          -> unitOL NOP\n           -- See Section 3.5.11 of PPC64 ELF v1.9\n           GCP64ELF 1      -> unitOL NOP\n           -- See Section 2.3.6 of PPC64 ELF v2\n           GCP64ELF 2      -> unitOL NOP\n           _               -> panic \"maybeNOP: Unknown PowerPC 64-bit ABI\"\n\n        passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)\n        passArguments ((arg,arg_ty,_):args) gprs fprs stackOffset\n               accumCode accumUsed | isWord64 arg_ty\n                                     && target32Bit (targetPlatform dflags) =\n            do\n                ChildCode64 code vr_lo <- iselExpr64 arg\n                let vr_hi = getHiVRegFromLo vr_lo\n\n                case gcp of\n                    GCPAIX ->\n                        do let storeWord vr (gpr:_) _ = MR gpr vr\n                               storeWord vr [] offset\n                                   = ST II32 vr (AddrRegImm sp (ImmInt offset))\n                           passArguments args\n                                         (drop 2 gprs)\n                                         fprs\n                                         (stackOffset+8)\n                                         (accumCode `appOL` code\n                                               `snocOL` storeWord vr_hi gprs stackOffset\n                                               `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))\n                                         ((take 2 gprs) ++ accumUsed)\n                    GCP32ELF ->\n                        do let stackOffset' = roundTo 8 stackOffset\n                               stackCode = accumCode `appOL` code\n                                   `snocOL` ST II32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))\n                                   `snocOL` ST II32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))\n                               regCode hireg loreg =\n                                   accumCode `appOL` code\n                                       `snocOL` MR hireg vr_hi\n                                       `snocOL` MR loreg vr_lo\n\n                           case gprs of\n                               hireg : loreg : regs | even (length gprs) ->\n                                   passArguments args regs fprs stackOffset\n                                                 (regCode hireg loreg) (hireg : loreg : accumUsed)\n                               _skipped : hireg : loreg : regs ->\n                                   passArguments args regs fprs stackOffset\n                                                 (regCode hireg loreg) (hireg : loreg : accumUsed)\n                               _ -> -- only one or no regs left\n                                   passArguments args [] fprs (stackOffset'+8)\n                                                 stackCode accumUsed\n                    GCP64ELF _ -> panic \"passArguments: 32 bit code\"\n\n        passArguments ((arg,rep,hint):args) gprs fprs stackOffset accumCode accumUsed\n            | reg : _ <- regs = do\n                register <- getRegister arg_pro\n                let code = case register of\n                            Fixed _ freg fcode -> fcode `snocOL` MR reg freg\n                            Any _ acode -> acode reg\n                    stackOffsetRes = case gcp of\n                                     -- The PowerOpen ABI requires that we\n                                     -- reserve stack slots for register\n                                     -- parameters\n                                     GCPAIX    -> stackOffset + stackBytes\n                                     -- ... the SysV ABI 32-bit doesn't.\n                                     GCP32ELF -> stackOffset\n                                     -- ... but SysV ABI 64-bit does.\n                                     GCP64ELF _ -> stackOffset + stackBytes\n                passArguments args\n                              (drop nGprs gprs)\n                              (drop nFprs fprs)\n                              stackOffsetRes\n                              (accumCode `appOL` code)\n                              (reg : accumUsed)\n            | otherwise = do\n                (vr, code) <- getSomeReg arg_pro\n                passArguments args\n                              (drop nGprs gprs)\n                              (drop nFprs fprs)\n                              (stackOffset' + stackBytes)\n                              (accumCode `appOL` code\n                                         `snocOL` ST format_pro vr stackSlot)\n                              accumUsed\n            where\n                arg_pro\n                   | isBitsType rep = CmmMachOp (conv_op (typeWidth rep) (wordWidth dflags)) [arg]\n                   | otherwise      = arg\n                format_pro\n                   | isBitsType rep = intFormat (wordWidth dflags)\n                   | otherwise      = cmmTypeFormat rep\n                conv_op = case hint of\n                            SignedHint -> MO_SS_Conv\n                            _          -> MO_UU_Conv\n\n                stackOffset' = case gcp of\n                               GCPAIX ->\n                                   -- The 32bit PowerOPEN ABI is happy with\n                                   -- 32bit-alignment ...\n                                   stackOffset\n                               GCP32ELF\n                                   -- ... the SysV ABI requires 8-byte\n                                   -- alignment for doubles.\n                                | isFloatType rep && typeWidth rep == W64 ->\n                                   roundTo 8 stackOffset\n                                | otherwise ->\n                                   stackOffset\n                               GCP64ELF _ ->\n                                   -- Everything on the stack is mapped to\n                                   -- 8-byte aligned doublewords\n                                   stackOffset\n                stackOffset''\n                     | isFloatType rep && typeWidth rep == W32 =\n                         case gcp of\n                         -- The ELF v1 ABI Section 3.2.3 requires:\n                         -- \"Single precision floating point values\n                         -- are mapped to the second word in a single\n                         -- doubleword\"\n                         GCP64ELF 1      -> stackOffset' + 4\n                         _               -> stackOffset'\n                     | otherwise = stackOffset'\n\n                stackSlot = AddrRegImm sp (ImmInt stackOffset'')\n                (nGprs, nFprs, stackBytes, regs)\n                    = case gcp of\n                      GCPAIX ->\n                          case cmmTypeFormat rep of\n                          II8  -> (1, 0, 4, gprs)\n                          II16 -> (1, 0, 4, gprs)\n                          II32 -> (1, 0, 4, gprs)\n                          -- The PowerOpen ABI requires that we skip a\n                          -- corresponding number of GPRs when we use\n                          -- the FPRs.\n                          --\n                          -- E.g. for a `double` two GPRs are skipped,\n                          -- whereas for a `float` one GPR is skipped\n                          -- when parameters are assigned to\n                          -- registers.\n                          --\n                          -- The PowerOpen ABI specification can be found at\n                          -- ftp://www.sourceware.org/pub/binutils/ppc-docs/ppc-poweropen/\n                          FF32 -> (1, 1, 4, fprs)\n                          FF64 -> (2, 1, 8, fprs)\n                          II64 -> panic \"genCCall' passArguments II64\"\n                          FF80 -> panic \"genCCall' passArguments FF80\"\n                      GCP32ELF ->\n                          case cmmTypeFormat rep of\n                          II8  -> (1, 0, 4, gprs)\n                          II16 -> (1, 0, 4, gprs)\n                          II32 -> (1, 0, 4, gprs)\n                          -- ... the SysV ABI doesn't.\n                          FF32 -> (0, 1, 4, fprs)\n                          FF64 -> (0, 1, 8, fprs)\n                          II64 -> panic \"genCCall' passArguments II64\"\n                          FF80 -> panic \"genCCall' passArguments FF80\"\n                      GCP64ELF _ ->\n                          case cmmTypeFormat rep of\n                          II8  -> (1, 0, 8, gprs)\n                          II16 -> (1, 0, 8, gprs)\n                          II32 -> (1, 0, 8, gprs)\n                          II64 -> (1, 0, 8, gprs)\n                          -- The ELFv1 ABI requires that we skip a\n                          -- corresponding number of GPRs when we use\n                          -- the FPRs.\n                          FF32 -> (1, 1, 8, fprs)\n                          FF64 -> (1, 1, 8, fprs)\n                          FF80 -> panic \"genCCall' passArguments FF80\"\n\n        moveResult reduceToFF32 =\n            case dest_regs of\n                [] -> nilOL\n                [dest]\n                    | reduceToFF32 && isFloat32 rep   -> unitOL (FRSP r_dest f1)\n                    | isFloat32 rep || isFloat64 rep -> unitOL (MR r_dest f1)\n                    | isWord64 rep && target32Bit (targetPlatform dflags)\n                       -> toOL [MR (getHiVRegFromLo r_dest) r3,\n                                MR r_dest r4]\n                    | otherwise -> unitOL (MR r_dest r3)\n                    where rep = cmmRegType dflags (CmmLocal dest)\n                          r_dest = getRegisterReg platform (CmmLocal dest)\n                _ -> panic \"genCCall' moveResult: Bad dest_regs\"\n\n        outOfLineMachOp mop =\n            do\n                dflags <- getDynFlags\n                mopExpr <- cmmMakeDynamicReference dflags CallReference $\n                              mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction\n                let mopLabelOrExpr = case mopExpr of\n                        CmmLit (CmmLabel lbl) -> Left lbl\n                        _ -> Right mopExpr\n                return (mopLabelOrExpr, reduce)\n            where\n                (functionName, reduce) = case mop of\n                    MO_F32_Exp   -> (fsLit \"exp\", True)\n                    MO_F32_Log   -> (fsLit \"log\", True)\n                    MO_F32_Sqrt  -> (fsLit \"sqrt\", True)\n                    MO_F32_Fabs  -> unsupported\n\n                    MO_F32_Sin   -> (fsLit \"sin\", True)\n                    MO_F32_Cos   -> (fsLit \"cos\", True)\n                    MO_F32_Tan   -> (fsLit \"tan\", True)\n\n                    MO_F32_Asin  -> (fsLit \"asin\", True)\n                    MO_F32_Acos  -> (fsLit \"acos\", True)\n                    MO_F32_Atan  -> (fsLit \"atan\", True)\n\n                    MO_F32_Sinh  -> (fsLit \"sinh\", True)\n                    MO_F32_Cosh  -> (fsLit \"cosh\", True)\n                    MO_F32_Tanh  -> (fsLit \"tanh\", True)\n                    MO_F32_Pwr   -> (fsLit \"pow\", True)\n\n                    MO_F32_Asinh -> (fsLit \"asinh\", True)\n                    MO_F32_Acosh -> (fsLit \"acosh\", True)\n                    MO_F32_Atanh -> (fsLit \"atanh\", True)\n\n                    MO_F64_Exp   -> (fsLit \"exp\", False)\n                    MO_F64_Log   -> (fsLit \"log\", False)\n                    MO_F64_Sqrt  -> (fsLit \"sqrt\", False)\n                    MO_F64_Fabs  -> unsupported\n\n                    MO_F64_Sin   -> (fsLit \"sin\", False)\n                    MO_F64_Cos   -> (fsLit \"cos\", False)\n                    MO_F64_Tan   -> (fsLit \"tan\", False)\n\n                    MO_F64_Asin  -> (fsLit \"asin\", False)\n                    MO_F64_Acos  -> (fsLit \"acos\", False)\n                    MO_F64_Atan  -> (fsLit \"atan\", False)\n\n                    MO_F64_Sinh  -> (fsLit \"sinh\", False)\n                    MO_F64_Cosh  -> (fsLit \"cosh\", False)\n                    MO_F64_Tanh  -> (fsLit \"tanh\", False)\n                    MO_F64_Pwr   -> (fsLit \"pow\", False)\n\n                    MO_F64_Asinh -> (fsLit \"asinh\", False)\n                    MO_F64_Acosh -> (fsLit \"acosh\", False)\n                    MO_F64_Atanh -> (fsLit \"atanh\", False)\n\n                    MO_UF_Conv w -> (fsLit $ word2FloatLabel w, False)\n\n                    MO_Memcpy _  -> (fsLit \"memcpy\", False)\n                    MO_Memset _  -> (fsLit \"memset\", False)\n                    MO_Memmove _ -> (fsLit \"memmove\", False)\n                    MO_Memcmp _  -> (fsLit \"memcmp\", False)\n\n                    MO_BSwap w   -> (fsLit $ bSwapLabel w, False)\n                    MO_PopCnt w  -> (fsLit $ popCntLabel w, False)\n                    MO_Pdep w    -> (fsLit $ pdepLabel w, False)\n                    MO_Pext w    -> (fsLit $ pextLabel w, False)\n                    MO_Clz _     -> unsupported\n                    MO_Ctz _     -> unsupported\n                    MO_AtomicRMW {} -> unsupported\n                    MO_Cmpxchg w -> (fsLit $ cmpxchgLabel w, False)\n                    MO_AtomicRead _  -> unsupported\n                    MO_AtomicWrite _ -> unsupported\n\n                    MO_S_QuotRem {}  -> unsupported\n                    MO_U_QuotRem {}  -> unsupported\n                    MO_U_QuotRem2 {} -> unsupported\n                    MO_Add2 {}       -> unsupported\n                    MO_AddWordC {}   -> unsupported\n                    MO_SubWordC {}   -> unsupported\n                    MO_AddIntC {}    -> unsupported\n                    MO_SubIntC {}    -> unsupported\n                    MO_U_Mul2 {}     -> unsupported\n                    MO_WriteBarrier  -> unsupported\n                    MO_Touch         -> unsupported\n                    MO_Prefetch_Data _ -> unsupported\n                unsupported = panic (\"outOfLineCmmOp: \" ++ show mop\n                                  ++ \" not supported\")\n\n-- -----------------------------------------------------------------------------\n-- Generating a table-branch\n\ngenSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock\ngenSwitch dflags expr targets\n  | OSAIX <- platformOS (targetPlatform dflags)\n  = do\n        (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)\n        let fmt = archWordFormat $ target32Bit $ targetPlatform dflags\n            sha = if target32Bit $ targetPlatform dflags then 2 else 3\n        tmp <- getNewRegNat fmt\n        lbl <- getNewLabelNat\n        dynRef <- cmmMakeDynamicReference dflags DataReference lbl\n        (tableReg,t_code) <- getSomeReg $ dynRef\n        let code = e_code `appOL` t_code `appOL` toOL [\n                            SL fmt tmp reg (RIImm (ImmInt sha)),\n                            LD fmt tmp (AddrRegReg tableReg tmp),\n                            MTCTR tmp,\n                            BCTR ids (Just lbl)\n                    ]\n        return code\n\n  | (positionIndependent dflags) || (not $ target32Bit $ targetPlatform dflags)\n  = do\n        (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)\n        let fmt = archWordFormat $ target32Bit $ targetPlatform dflags\n            sha = if target32Bit $ targetPlatform dflags then 2 else 3\n        tmp <- getNewRegNat fmt\n        lbl <- getNewLabelNat\n        dynRef <- cmmMakeDynamicReference dflags DataReference lbl\n        (tableReg,t_code) <- getSomeReg $ dynRef\n        let code = e_code `appOL` t_code `appOL` toOL [\n                            SL fmt tmp reg (RIImm (ImmInt sha)),\n                            LD fmt tmp (AddrRegReg tableReg tmp),\n                            ADD tmp tmp (RIReg tableReg),\n                            MTCTR tmp,\n                            BCTR ids (Just lbl)\n                    ]\n        return code\n  | otherwise\n  = do\n        (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)\n        let fmt = archWordFormat $ target32Bit $ targetPlatform dflags\n            sha = if target32Bit $ targetPlatform dflags then 2 else 3\n        tmp <- getNewRegNat fmt\n        lbl <- getNewLabelNat\n        let code = e_code `appOL` toOL [\n                            SL fmt tmp reg (RIImm (ImmInt sha)),\n                            ADDIS tmp tmp (HA (ImmCLbl lbl)),\n                            LD fmt tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),\n                            MTCTR tmp,\n                            BCTR ids (Just lbl)\n                    ]\n        return code\n  where (offset, ids) = switchTargetsToTable targets\n\ngenerateJumpTableForInstr :: DynFlags -> Instr\n                          -> Maybe (NatCmmDecl CmmStatics Instr)\ngenerateJumpTableForInstr dflags (BCTR ids (Just lbl)) =\n    let jumpTable\n            | (positionIndependent dflags)\n              || (not $ target32Bit $ targetPlatform dflags)\n            = map jumpTableEntryRel ids\n            | otherwise = map (jumpTableEntry dflags) ids\n                where jumpTableEntryRel Nothing\n                        = CmmStaticLit (CmmInt 0 (wordWidth dflags))\n                      jumpTableEntryRel (Just blockid)\n                        = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0\n                                         (wordWidth dflags))\n                            where blockLabel = blockLbl blockid\n    in Just (CmmData (Section ReadOnlyData lbl) (Statics lbl jumpTable))\ngenerateJumpTableForInstr _ _ = Nothing\n\n-- -----------------------------------------------------------------------------\n-- 'condIntReg' and 'condFltReg': condition codes into registers\n\n-- Turn those condition codes into integers now (when they appear on\n-- the right hand side of an assignment).\n\n\n\ncondReg :: NatM CondCode -> NatM Register\ncondReg getCond = do\n    CondCode _ cond cond_code <- getCond\n    dflags <- getDynFlags\n    let\n        code dst = cond_code\n            `appOL` negate_code\n            `appOL` toOL [\n                MFCR dst,\n                RLWINM dst dst (bit + 1) 31 31\n            ]\n\n        negate_code | do_negate = unitOL (CRNOR bit bit bit)\n                    | otherwise = nilOL\n\n        (bit, do_negate) = case cond of\n            LTT -> (0, False)\n            LE  -> (1, True)\n            EQQ -> (2, False)\n            GE  -> (0, True)\n            GTT -> (1, False)\n\n            NE  -> (2, True)\n\n            LU  -> (0, False)\n            LEU -> (1, True)\n            GEU -> (0, True)\n            GU  -> (1, False)\n            _   -> panic \"PPC.CodeGen.codeReg: no match\"\n\n        format = archWordFormat $ target32Bit $ targetPlatform dflags\n    return (Any format code)\n\ncondIntReg :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register\ncondIntReg cond width x y = condReg (condIntCode cond width x y)\ncondFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register\ncondFltReg cond x y = condReg (condFltCode cond x y)\n\n\n\n-- -----------------------------------------------------------------------------\n-- 'trivial*Code': deal with trivial instructions\n\n-- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',\n-- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.\n-- Only look for constants on the right hand side, because that's\n-- where the generic optimizer will have put them.\n\n-- Similarly, for unary instructions, we don't have to worry about\n-- matching an StInt as the argument, because genericOpt will already\n-- have handled the constant-folding.\n\n\n\n{-\nWolfgang's PowerPC version of The Rules:\n\nA slightly modified version of The Rules to take advantage of the fact\nthat PowerPC instructions work on all registers and don't implicitly\nclobber any fixed registers.\n\n* The only expression for which getRegister returns Fixed is (CmmReg reg).\n\n* If getRegister returns Any, then the code it generates may modify only:\n        (a) fresh temporaries\n        (b) the destination register\n  It may *not* modify global registers, unless the global\n  register happens to be the destination register.\n  It may not clobber any other registers. In fact, only ccalls clobber any\n  fixed registers.\n  Also, it may not modify the counter register (used by genCCall).\n\n  Corollary: If a getRegister for a subexpression returns Fixed, you need\n  not move it to a fresh temporary before evaluating the next subexpression.\n  The Fixed register won't be modified.\n  Therefore, we don't need a counterpart for the x86's getStableReg on PPC.\n\n* SDM's First Rule is valid for PowerPC, too: subexpressions can depend on\n  the value of the destination register.\n-}\n\ntrivialCode\n        :: Width\n        -> Bool\n        -> (Reg -> Reg -> RI -> Instr)\n        -> CmmExpr\n        -> CmmExpr\n        -> NatM Register\n\ntrivialCode rep signed instr x (CmmLit (CmmInt y _))\n    | Just imm <- makeImmediate rep signed y\n    = do\n        (src1, code1) <- getSomeReg x\n        let code dst = code1 `snocOL` instr dst src1 (RIImm imm)\n        return (Any (intFormat rep) code)\n\ntrivialCode rep _ instr x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)\n    return (Any (intFormat rep) code)\n\nshiftMulCode\n        :: Width\n        -> Bool\n        -> (Format-> Reg -> Reg -> RI -> Instr)\n        -> CmmExpr\n        -> CmmExpr\n        -> NatM Register\nshiftMulCode width sign instr x (CmmLit (CmmInt y _))\n    | Just imm <- makeImmediate width sign y\n    = do\n        (src1, code1) <- getSomeReg x\n        let format = intFormat width\n        let ins_fmt = intFormat (max W32 width)\n        let code dst = code1 `snocOL` instr ins_fmt dst src1 (RIImm imm)\n        return (Any format code)\n\nshiftMulCode width _ instr x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let format = intFormat width\n    let ins_fmt = intFormat (max W32 width)\n    let code dst = code1 `appOL` code2\n                   `snocOL` instr ins_fmt dst src1 (RIReg src2)\n    return (Any format code)\n\ntrivialCodeNoImm' :: Format -> (Reg -> Reg -> Reg -> Instr)\n                 -> CmmExpr -> CmmExpr -> NatM Register\ntrivialCodeNoImm' format instr x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2\n    return (Any format code)\n\ntrivialCodeNoImm :: Format -> (Format -> Reg -> Reg -> Reg -> Instr)\n                 -> CmmExpr -> CmmExpr -> NatM Register\ntrivialCodeNoImm format instr x y\n  = trivialCodeNoImm' format (instr format) x y\n\nsrCode :: Width -> Bool -> (Format-> Reg -> Reg -> RI -> Instr)\n       -> CmmExpr -> CmmExpr -> NatM Register\nsrCode width sgn instr x (CmmLit (CmmInt y _))\n    | Just imm <- makeImmediate width sgn y\n    = do\n        let op_len = max W32 width\n            extend = if sgn then extendSExpr else extendUExpr\n        (src1, code1) <- getSomeReg (extend width op_len x)\n        let code dst = code1 `snocOL`\n                       instr (intFormat op_len) dst src1 (RIImm imm)\n        return (Any (intFormat width) code)\n\nsrCode width sgn instr x y = do\n  let op_len = max W32 width\n      extend = if sgn then extendSExpr else extendUExpr\n  (src1, code1) <- getSomeReg (extend width op_len x)\n  (src2, code2) <- getSomeReg (extendUExpr width op_len y)\n  -- Note: Shift amount `y` is unsigned\n  let code dst = code1 `appOL` code2 `snocOL`\n                 instr (intFormat op_len) dst src1 (RIReg src2)\n  return (Any (intFormat width) code)\n\ndivCode :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register\ndivCode width sgn x y = do\n  let op_len = max W32 width\n      extend = if sgn then extendSExpr else extendUExpr\n  (src1, code1) <- getSomeReg (extend width op_len x)\n  (src2, code2) <- getSomeReg (extend width op_len y)\n  let code dst = code1 `appOL` code2 `snocOL`\n                 DIV (intFormat op_len) sgn dst src1 src2\n  return (Any (intFormat width) code)\n\n\ntrivialUCode :: Format\n             -> (Reg -> Reg -> Instr)\n             -> CmmExpr\n             -> NatM Register\ntrivialUCode rep instr x = do\n    (src, code) <- getSomeReg x\n    let code' dst = code `snocOL` instr dst src\n    return (Any rep code')\n\n-- There is no \"remainder\" instruction on the PPC, so we have to do\n-- it the hard way.\n-- The \"sgn\" parameter is the signedness for the division instruction\n\nremainderCode :: Width -> Bool -> Reg -> CmmExpr -> CmmExpr\n               -> NatM (Reg -> InstrBlock)\nremainderCode rep sgn reg_q arg_x arg_y = do\n  let op_len = max W32 rep\n      fmt    = intFormat op_len\n      extend = if sgn then extendSExpr else extendUExpr\n  (x_reg, x_code) <- getSomeReg (extend rep op_len arg_x)\n  (y_reg, y_code) <- getSomeReg (extend rep op_len arg_y)\n  return $ \\reg_r -> y_code `appOL` x_code\n                     `appOL` toOL [ DIV fmt sgn reg_q x_reg y_reg\n                                  , MULL fmt reg_r reg_q (RIReg y_reg)\n                                  , SUBF reg_r reg_r x_reg\n                                  ]\n\n\ncoerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register\ncoerceInt2FP fromRep toRep x = do\n    dflags <- getDynFlags\n    let arch =  platformArch $ targetPlatform dflags\n    coerceInt2FP' arch fromRep toRep x\n\ncoerceInt2FP' :: Arch -> Width -> Width -> CmmExpr -> NatM Register\ncoerceInt2FP' ArchPPC fromRep toRep x = do\n    (src, code) <- getSomeReg x\n    lbl <- getNewLabelNat\n    itmp <- getNewRegNat II32\n    ftmp <- getNewRegNat FF64\n    dflags <- getDynFlags\n    dynRef <- cmmMakeDynamicReference dflags DataReference lbl\n    Amode addr addr_code <- getAmode D dynRef\n    let\n        code' dst = code `appOL` maybe_exts `appOL` toOL [\n                LDATA (Section ReadOnlyData lbl) $ Statics lbl\n                                 [CmmStaticLit (CmmInt 0x43300000 W32),\n                                  CmmStaticLit (CmmInt 0x80000000 W32)],\n                XORIS itmp src (ImmInt 0x8000),\n                ST II32 itmp (spRel dflags 3),\n                LIS itmp (ImmInt 0x4330),\n                ST II32 itmp (spRel dflags 2),\n                LD FF64 ftmp (spRel dflags 2)\n            ] `appOL` addr_code `appOL` toOL [\n                LD FF64 dst addr,\n                FSUB FF64 dst ftmp dst\n            ] `appOL` maybe_frsp dst\n\n        maybe_exts = case fromRep of\n                        W8 ->  unitOL $ EXTS II8 src src\n                        W16 -> unitOL $ EXTS II16 src src\n                        W32 -> nilOL\n                        _       -> panic \"PPC.CodeGen.coerceInt2FP: no match\"\n\n        maybe_frsp dst\n                = case toRep of\n                        W32 -> unitOL $ FRSP dst dst\n                        W64 -> nilOL\n                        _       -> panic \"PPC.CodeGen.coerceInt2FP: no match\"\n\n    return (Any (floatFormat toRep) code')\n\n-- On an ELF v1 Linux we use the compiler doubleword in the stack frame\n-- this is the TOC pointer doubleword on ELF v2 Linux. The latter is only\n-- set right before a call and restored right after return from the call.\n-- So it is fine.\ncoerceInt2FP' (ArchPPC_64 _) fromRep toRep x = do\n    (src, code) <- getSomeReg x\n    dflags <- getDynFlags\n    let\n        code' dst = code `appOL` maybe_exts `appOL` toOL [\n                ST II64 src (spRel dflags 3),\n                LD FF64 dst (spRel dflags 3),\n                FCFID dst dst\n            ] `appOL` maybe_frsp dst\n\n        maybe_exts = case fromRep of\n                        W8 ->  unitOL $ EXTS II8 src src\n                        W16 -> unitOL $ EXTS II16 src src\n                        W32 -> unitOL $ EXTS II32 src src\n                        W64 -> nilOL\n                        _       -> panic \"PPC.CodeGen.coerceInt2FP: no match\"\n\n        maybe_frsp dst\n                = case toRep of\n                        W32 -> unitOL $ FRSP dst dst\n                        W64 -> nilOL\n                        _       -> panic \"PPC.CodeGen.coerceInt2FP: no match\"\n\n    return (Any (floatFormat toRep) code')\n\ncoerceInt2FP' _ _ _ _ = panic \"PPC.CodeGen.coerceInt2FP: unknown arch\"\n\n\ncoerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register\ncoerceFP2Int fromRep toRep x = do\n    dflags <- getDynFlags\n    let arch =  platformArch $ targetPlatform dflags\n    coerceFP2Int' arch fromRep toRep x\n\ncoerceFP2Int' :: Arch -> Width -> Width -> CmmExpr -> NatM Register\ncoerceFP2Int' ArchPPC _ toRep x = do\n    dflags <- getDynFlags\n    -- the reps don't really matter: F*->FF64 and II32->I* are no-ops\n    (src, code) <- getSomeReg x\n    tmp <- getNewRegNat FF64\n    let\n        code' dst = code `appOL` toOL [\n                -- convert to int in FP reg\n            FCTIWZ tmp src,\n                -- store value (64bit) from FP to stack\n            ST FF64 tmp (spRel dflags 2),\n                -- read low word of value (high word is undefined)\n            LD II32 dst (spRel dflags 3)]\n    return (Any (intFormat toRep) code')\n\ncoerceFP2Int' (ArchPPC_64 _) _ toRep x = do\n    dflags <- getDynFlags\n    -- the reps don't really matter: F*->FF64 and II64->I* are no-ops\n    (src, code) <- getSomeReg x\n    tmp <- getNewRegNat FF64\n    let\n        code' dst = code `appOL` toOL [\n                -- convert to int in FP reg\n            FCTIDZ tmp src,\n                -- store value (64bit) from FP to compiler word on stack\n            ST FF64 tmp (spRel dflags 3),\n            LD II64 dst (spRel dflags 3)]\n    return (Any (intFormat toRep) code')\n\ncoerceFP2Int' _ _ _ _ = panic \"PPC.CodeGen.coerceFP2Int: unknown arch\"\n\n-- Note [.LCTOC1 in PPC PIC code]\n-- The .LCTOC1 label is defined to point 32768 bytes into the GOT table\n-- to make the most of the PPC's 16-bit displacements.\n-- As 16-bit signed offset is used (usually via addi/lwz instructions)\n-- first element will have '-32768' offset against .LCTOC1.\n\n-- Note [implicit register in PPC PIC code]\n-- PPC generates calls by labels in assembly\n-- in form of:\n--     bl puts+32768@plt\n-- in this form it's not seen directly (by GHC NCG)\n-- that r30 (PicBaseReg) is used,\n-- but r30 is a required part of PLT code setup:\n--   puts+32768@plt:\n--       lwz     r11,-30484(r30) ; offset in .LCTOC1\n--       mtctr   r11\n--       bctr\n", "num_lines": 2442}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module PPC.Cond (\n        Cond(..),\n        condNegate,\n        condUnsigned,\n        condToSigned,\n        condToUnsigned,\n)\n\nwhere\n\nimport GhcPrelude\n\nimport Panic\n\ndata Cond\n        = ALWAYS\n        | EQQ\n        | GE\n        | GEU\n        | GTT\n        | GU\n        | LE\n        | LEU\n        | LTT\n        | LU\n        | NE\n        deriving Eq\n\n\ncondNegate :: Cond -> Cond\ncondNegate ALWAYS  = panic \"condNegate: ALWAYS\"\ncondNegate EQQ     = NE\ncondNegate GE      = LTT\ncondNegate GEU     = LU\ncondNegate GTT     = LE\ncondNegate GU      = LEU\ncondNegate LE      = GTT\ncondNegate LEU     = GU\ncondNegate LTT     = GE\ncondNegate LU      = GEU\ncondNegate NE      = EQQ\n\n-- Condition utils\ncondUnsigned :: Cond -> Bool\ncondUnsigned GU  = True\ncondUnsigned LU  = True\ncondUnsigned GEU = True\ncondUnsigned LEU = True\ncondUnsigned _   = False\n\ncondToSigned :: Cond -> Cond\ncondToSigned GU  = GTT\ncondToSigned LU  = LTT\ncondToSigned GEU = GE\ncondToSigned LEU = LE\ncondToSigned x   = x\n\ncondToUnsigned :: Cond -> Cond\ncondToUnsigned GTT = GU\ncondToUnsigned LTT = LU\ncondToUnsigned GE  = GEU\ncondToUnsigned LE  = LEU\ncondToUnsigned x   = x\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Machine-dependent assembly language\n--\n-- (c) The University of Glasgow 1993-2004\n--\n-----------------------------------------------------------------------------\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n\nmodule PPC.Instr (\n    archWordFormat,\n    RI(..),\n    Instr(..),\n    stackFrameHeaderSize,\n    maxSpillSlots,\n    allocMoreStack,\n    makeFarBranches\n)\n\nwhere\n\nimport GhcPrelude\n\nimport PPC.Regs\nimport PPC.Cond\nimport Instruction\nimport Format\nimport TargetReg\nimport RegClass\nimport Reg\n\nimport CodeGen.Platform\nimport BlockId\nimport Hoopl.Collections\nimport Hoopl.Label\nimport DynFlags\nimport Cmm\nimport CmmInfo\nimport FastString\nimport CLabel\nimport Outputable\nimport Platform\nimport UniqFM (listToUFM, lookupUFM)\nimport UniqSupply\n\nimport Control.Monad (replicateM)\nimport Data.Maybe (fromMaybe)\n\n--------------------------------------------------------------------------------\n-- Format of a PPC memory address.\n--\narchWordFormat :: Bool -> Format\narchWordFormat is32Bit\n | is32Bit   = II32\n | otherwise = II64\n\n\n-- | Instruction instance for powerpc\ninstance Instruction Instr where\n        regUsageOfInstr         = ppc_regUsageOfInstr\n        patchRegsOfInstr        = ppc_patchRegsOfInstr\n        isJumpishInstr          = ppc_isJumpishInstr\n        jumpDestsOfInstr        = ppc_jumpDestsOfInstr\n        patchJumpInstr          = ppc_patchJumpInstr\n        mkSpillInstr            = ppc_mkSpillInstr\n        mkLoadInstr             = ppc_mkLoadInstr\n        takeDeltaInstr          = ppc_takeDeltaInstr\n        isMetaInstr             = ppc_isMetaInstr\n        mkRegRegMoveInstr _     = ppc_mkRegRegMoveInstr\n        takeRegRegMoveInstr     = ppc_takeRegRegMoveInstr\n        mkJumpInstr             = ppc_mkJumpInstr\n        mkStackAllocInstr       = ppc_mkStackAllocInstr\n        mkStackDeallocInstr     = ppc_mkStackDeallocInstr\n\n\nppc_mkStackAllocInstr :: Platform -> Int -> [Instr]\nppc_mkStackAllocInstr platform amount\n  = ppc_mkStackAllocInstr' platform (-amount)\n\nppc_mkStackDeallocInstr :: Platform -> Int -> [Instr]\nppc_mkStackDeallocInstr platform amount\n  = ppc_mkStackAllocInstr' platform amount\n\nppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]\nppc_mkStackAllocInstr' platform amount\n  | fits16Bits amount\n  = [ LD fmt r0 (AddrRegImm sp zero)\n    , STU fmt r0 (AddrRegImm sp immAmount)\n    ]\n  | otherwise\n  = [ LD fmt r0 (AddrRegImm sp zero)\n    , ADDIS tmp sp (HA immAmount)\n    , ADD tmp tmp (RIImm (LO immAmount))\n    , STU fmt r0 (AddrRegReg sp tmp)\n    ]\n  where\n    fmt = intFormat $ widthFromBytes ((platformWordSize platform) `quot` 8)\n    zero = ImmInt 0\n    tmp = tmpReg platform\n    immAmount = ImmInt amount\n\n--\n-- See note [extra spill slots] in X86/Instr.hs\n--\nallocMoreStack\n  :: Platform\n  -> Int\n  -> NatCmmDecl statics PPC.Instr.Instr\n  -> UniqSM (NatCmmDecl statics PPC.Instr.Instr, [(BlockId,BlockId)])\n\nallocMoreStack _ _ top@(CmmData _ _) = return (top,[])\nallocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do\n    let\n        infos   = mapKeys info\n        entries = case code of\n                    [] -> infos\n                    BasicBlock entry _ : _ -- first block is the entry point\n                        | entry `elem` infos -> infos\n                        | otherwise          -> entry : infos\n\n    uniqs <- replicateM (length entries) getUniqueM\n\n    let\n        delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up\n            where x = slots * spillSlotSize -- sp delta\n\n        alloc   = mkStackAllocInstr   platform delta\n        dealloc = mkStackDeallocInstr platform delta\n\n        retargetList = (zip entries (map mkBlockId uniqs))\n\n        new_blockmap :: LabelMap BlockId\n        new_blockmap = mapFromList retargetList\n\n        insert_stack_insns (BasicBlock id insns)\n            | Just new_blockid <- mapLookup id new_blockmap\n                = [ BasicBlock id $ alloc ++ [BCC ALWAYS new_blockid Nothing]\n                  , BasicBlock new_blockid block'\n                  ]\n            | otherwise\n                = [ BasicBlock id block' ]\n            where\n              block' = foldr insert_dealloc [] insns\n\n        insert_dealloc insn r\n            -- BCTR might or might not be a non-local jump. For\n            -- \"labeled-goto\" we use JMP, and for \"computed-goto\" we\n            -- use MTCTR followed by BCTR. See 'PPC.CodeGen.genJump'.\n            = case insn of\n                JMP _           -> dealloc ++ (insn : r)\n                BCTR [] Nothing -> dealloc ++ (insn : r)\n                BCTR ids label  -> BCTR (map (fmap retarget) ids) label : r\n                BCCFAR cond b p -> BCCFAR cond (retarget b) p : r\n                BCC    cond b p -> BCC    cond (retarget b) p : r\n                _               -> insn : r\n            -- BL and BCTRL are call-like instructions rather than\n            -- jumps, and are used only for C calls.\n\n        retarget :: BlockId -> BlockId\n        retarget b\n            = fromMaybe b (mapLookup b new_blockmap)\n\n        new_code\n            = concatMap insert_stack_insns code\n\n    -- in\n    return (CmmProc info lbl live (ListGraph new_code),retargetList)\n\n\n-- -----------------------------------------------------------------------------\n-- Machine's assembly language\n\n-- We have a few common \"instructions\" (nearly all the pseudo-ops) but\n-- mostly all of 'Instr' is machine-specific.\n\n-- Register or immediate\ndata RI\n    = RIReg Reg\n    | RIImm Imm\n\ndata Instr\n    -- comment pseudo-op\n    = COMMENT FastString\n\n    -- some static data spat out during code\n    -- generation.  Will be extracted before\n    -- pretty-printing.\n    | LDATA   Section CmmStatics\n\n    -- start a new basic block.  Useful during\n    -- codegen, removed later.  Preceding\n    -- instruction should be a jump, as per the\n    -- invariants for a BasicBlock (see Cmm).\n    | NEWBLOCK BlockId\n\n    -- specify current stack offset for\n    -- benefit of subsequent passes\n    | DELTA   Int\n\n    -- Loads and stores.\n    | LD      Format Reg AddrMode   -- Load format, dst, src\n    | LDFAR   Format Reg AddrMode   -- Load format, dst, src 32 bit offset\n    | LDR     Format Reg AddrMode   -- Load and reserve format, dst, src\n    | LA      Format Reg AddrMode   -- Load arithmetic format, dst, src\n    | ST      Format Reg AddrMode   -- Store format, src, dst\n    | STFAR   Format Reg AddrMode   -- Store format, src, dst 32 bit offset\n    | STU     Format Reg AddrMode   -- Store with Update format, src, dst\n    | STC     Format Reg AddrMode   -- Store conditional format, src, dst\n    | LIS     Reg Imm               -- Load Immediate Shifted dst, src\n    | LI      Reg Imm               -- Load Immediate dst, src\n    | MR      Reg Reg               -- Move Register dst, src -- also for fmr\n\n    | CMP     Format Reg RI         -- format, src1, src2\n    | CMPL    Format Reg RI         -- format, src1, src2\n\n    | BCC     Cond BlockId (Maybe Bool) -- cond, block, hint\n    | BCCFAR  Cond BlockId (Maybe Bool) -- cond, block, hint\n                                    --   hint:\n                                    --    Just True:  branch likely taken\n                                    --    Just False: branch likely not taken\n                                    --    Nothing:    no hint\n    | JMP     CLabel                -- same as branch,\n                                    -- but with CLabel instead of block ID\n    | MTCTR   Reg\n    | BCTR    [Maybe BlockId] (Maybe CLabel) -- with list of local destinations, and jump table location if necessary\n    | BL      CLabel [Reg]          -- with list of argument regs\n    | BCTRL   [Reg]\n\n    | ADD     Reg Reg RI            -- dst, src1, src2\n    | ADDO    Reg Reg Reg           -- add and set overflow\n    | ADDC    Reg Reg Reg           -- (carrying) dst, src1, src2\n    | ADDE    Reg Reg Reg           -- (extended) dst, src1, src2\n    | ADDZE   Reg Reg               -- (to zero extended) dst, src\n    | ADDIS   Reg Reg Imm           -- Add Immediate Shifted dst, src1, src2\n    | SUBF    Reg Reg Reg           -- dst, src1, src2 ; dst = src2 - src1\n    | SUBFO   Reg Reg Reg           -- subtract from and set overflow\n    | SUBFC   Reg Reg RI            -- (carrying) dst, src1, src2 ;\n                                    -- dst = src2 - src1\n    | SUBFE   Reg Reg Reg           -- (extended) dst, src1, src2 ;\n                                    -- dst = src2 - src1\n    | MULL    Format Reg Reg RI\n    | MULLO   Format Reg Reg Reg    -- multiply and set overflow\n    | MFOV    Format Reg            -- move overflow bit (1|33) to register\n                                    -- pseudo-instruction; pretty printed as\n                                    -- mfxer dst\n                                    -- extr[w|d]i dst, dst, 1, [1|33]\n    | MULHU   Format Reg Reg Reg\n    | DIV     Format Bool Reg Reg Reg\n    | AND     Reg Reg RI            -- dst, src1, src2\n    | ANDC    Reg Reg Reg           -- AND with complement, dst = src1 & ~ src2\n    | NAND    Reg Reg Reg           -- dst, src1, src2\n    | OR      Reg Reg RI            -- dst, src1, src2\n    | ORIS    Reg Reg Imm           -- OR Immediate Shifted dst, src1, src2\n    | XOR     Reg Reg RI            -- dst, src1, src2\n    | XORIS   Reg Reg Imm           -- XOR Immediate Shifted dst, src1, src2\n\n    | EXTS    Format Reg Reg\n    | CNTLZ   Format Reg Reg\n\n    | NEG     Reg Reg\n    | NOT     Reg Reg\n\n    | SL      Format Reg Reg RI            -- shift left\n    | SR      Format Reg Reg RI            -- shift right\n    | SRA     Format Reg Reg RI            -- shift right arithmetic\n\n    | RLWINM  Reg Reg Int Int Int   -- Rotate Left Word Immediate then AND with Mask\n    | CLRLI   Format Reg Reg Int    -- clear left immediate (extended mnemonic)\n    | CLRRI   Format Reg Reg Int    -- clear right immediate (extended mnemonic)\n\n    | FADD    Format Reg Reg Reg\n    | FSUB    Format Reg Reg Reg\n    | FMUL    Format Reg Reg Reg\n    | FDIV    Format Reg Reg Reg\n    | FABS    Reg Reg               -- abs is the same for single and double\n    | FNEG    Reg Reg               -- negate is the same for single and double prec.\n\n    | FCMP    Reg Reg\n\n    | FCTIWZ  Reg Reg           -- convert to integer word\n    | FCTIDZ  Reg Reg           -- convert to integer double word\n    | FCFID   Reg Reg           -- convert from integer double word\n    | FRSP    Reg Reg           -- reduce to single precision\n                                -- (but destination is a FP register)\n\n    | CRNOR   Int Int Int       -- condition register nor\n    | MFCR    Reg               -- move from condition register\n\n    | MFLR    Reg               -- move from link register\n    | FETCHPC Reg               -- pseudo-instruction:\n                                -- bcl to next insn, mflr reg\n    | HWSYNC                    -- heavy weight sync\n    | ISYNC                     -- instruction synchronize\n    | LWSYNC                    -- memory barrier\n    | NOP                       -- no operation, PowerPC 64 bit\n                                -- needs this as place holder to\n                                -- reload TOC pointer\n\n-- | Get the registers that are being used by this instruction.\n-- regUsage doesn't need to do any trickery for jumps and such.\n-- Just state precisely the regs read and written by that insn.\n-- The consequences of control flow transfers, as far as register\n-- allocation goes, are taken care of by the register allocator.\n--\nppc_regUsageOfInstr :: Platform -> Instr -> RegUsage\nppc_regUsageOfInstr platform instr\n = case instr of\n    LD      _ reg addr       -> usage (regAddr addr, [reg])\n    LDFAR   _ reg addr       -> usage (regAddr addr, [reg])\n    LDR     _ reg addr       -> usage (regAddr addr, [reg])\n    LA      _ reg addr       -> usage (regAddr addr, [reg])\n    ST      _ reg addr       -> usage (reg : regAddr addr, [])\n    STFAR   _ reg addr       -> usage (reg : regAddr addr, [])\n    STU     _ reg addr       -> usage (reg : regAddr addr, [])\n    STC     _ reg addr       -> usage (reg : regAddr addr, [])\n    LIS     reg _            -> usage ([], [reg])\n    LI      reg _            -> usage ([], [reg])\n    MR      reg1 reg2        -> usage ([reg2], [reg1])\n    CMP     _ reg ri         -> usage (reg : regRI ri,[])\n    CMPL    _ reg ri         -> usage (reg : regRI ri,[])\n    BCC     _ _ _            -> noUsage\n    BCCFAR  _ _ _            -> noUsage\n    MTCTR   reg              -> usage ([reg],[])\n    BCTR    _ _              -> noUsage\n    BL      _ params         -> usage (params, callClobberedRegs platform)\n    BCTRL   params           -> usage (params, callClobberedRegs platform)\n\n    ADD     reg1 reg2 ri     -> usage (reg2 : regRI ri, [reg1])\n    ADDO    reg1 reg2 reg3   -> usage ([reg2,reg3], [reg1])\n    ADDC    reg1 reg2 reg3   -> usage ([reg2,reg3], [reg1])\n    ADDE    reg1 reg2 reg3   -> usage ([reg2,reg3], [reg1])\n    ADDZE   reg1 reg2        -> usage ([reg2], [reg1])\n    ADDIS   reg1 reg2 _      -> usage ([reg2], [reg1])\n    SUBF    reg1 reg2 reg3   -> usage ([reg2,reg3], [reg1])\n    SUBFO   reg1 reg2 reg3   -> usage ([reg2,reg3], [reg1])\n    SUBFC   reg1 reg2 ri     -> usage (reg2 : regRI ri, [reg1])\n    SUBFE   reg1 reg2 reg3   -> usage ([reg2,reg3], [reg1])\n    MULL    _ reg1 reg2 ri   -> usage (reg2 : regRI ri, [reg1])\n    MULLO   _ reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])\n    MFOV    _ reg            -> usage ([], [reg])\n    MULHU   _ reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])\n    DIV     _ _ reg1 reg2 reg3\n                             -> usage ([reg2,reg3], [reg1])\n\n    AND     reg1 reg2 ri    -> usage (reg2 : regRI ri, [reg1])\n    ANDC    reg1 reg2 reg3  -> usage ([reg2,reg3], [reg1])\n    NAND    reg1 reg2 reg3  -> usage ([reg2,reg3], [reg1])\n    OR      reg1 reg2 ri    -> usage (reg2 : regRI ri, [reg1])\n    ORIS    reg1 reg2 _     -> usage ([reg2], [reg1])\n    XOR     reg1 reg2 ri    -> usage (reg2 : regRI ri, [reg1])\n    XORIS   reg1 reg2 _     -> usage ([reg2], [reg1])\n    EXTS    _  reg1 reg2    -> usage ([reg2], [reg1])\n    CNTLZ   _  reg1 reg2    -> usage ([reg2], [reg1])\n    NEG     reg1 reg2       -> usage ([reg2], [reg1])\n    NOT     reg1 reg2       -> usage ([reg2], [reg1])\n    SL      _ reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])\n    SR      _ reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])\n    SRA     _ reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])\n    RLWINM  reg1 reg2 _ _ _ -> usage ([reg2], [reg1])\n    CLRLI   _ reg1 reg2 _   -> usage ([reg2], [reg1])\n    CLRRI   _ reg1 reg2 _   -> usage ([reg2], [reg1])\n\n    FADD    _ r1 r2 r3      -> usage ([r2,r3], [r1])\n    FSUB    _ r1 r2 r3      -> usage ([r2,r3], [r1])\n    FMUL    _ r1 r2 r3      -> usage ([r2,r3], [r1])\n    FDIV    _ r1 r2 r3      -> usage ([r2,r3], [r1])\n    FABS    r1 r2           -> usage ([r2], [r1])\n    FNEG    r1 r2           -> usage ([r2], [r1])\n    FCMP    r1 r2           -> usage ([r1,r2], [])\n    FCTIWZ  r1 r2           -> usage ([r2], [r1])\n    FCTIDZ  r1 r2           -> usage ([r2], [r1])\n    FCFID   r1 r2           -> usage ([r2], [r1])\n    FRSP    r1 r2           -> usage ([r2], [r1])\n    MFCR    reg             -> usage ([], [reg])\n    MFLR    reg             -> usage ([], [reg])\n    FETCHPC reg             -> usage ([], [reg])\n    _                       -> noUsage\n  where\n    usage (src, dst) = RU (filter (interesting platform) src)\n                          (filter (interesting platform) dst)\n    regAddr (AddrRegReg r1 r2) = [r1, r2]\n    regAddr (AddrRegImm r1 _)  = [r1]\n\n    regRI (RIReg r) = [r]\n    regRI  _        = []\n\ninteresting :: Platform -> Reg -> Bool\ninteresting _        (RegVirtual _)              = True\ninteresting platform (RegReal (RealRegSingle i)) = freeReg platform i\ninteresting _        (RegReal (RealRegPair{}))\n    = panic \"PPC.Instr.interesting: no reg pairs on this arch\"\n\n\n\n-- | Apply a given mapping to all the register references in this\n-- instruction.\nppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr\nppc_patchRegsOfInstr instr env\n = case instr of\n    LD      fmt reg addr    -> LD fmt (env reg) (fixAddr addr)\n    LDFAR   fmt reg addr    -> LDFAR fmt (env reg) (fixAddr addr)\n    LDR     fmt reg addr    -> LDR fmt (env reg) (fixAddr addr)\n    LA      fmt reg addr    -> LA fmt (env reg) (fixAddr addr)\n    ST      fmt reg addr    -> ST fmt (env reg) (fixAddr addr)\n    STFAR   fmt reg addr    -> STFAR fmt (env reg) (fixAddr addr)\n    STU     fmt reg addr    -> STU fmt (env reg) (fixAddr addr)\n    STC     fmt reg addr    -> STC fmt (env reg) (fixAddr addr)\n    LIS     reg imm         -> LIS (env reg) imm\n    LI      reg imm         -> LI (env reg) imm\n    MR      reg1 reg2       -> MR (env reg1) (env reg2)\n    CMP     fmt reg ri      -> CMP fmt (env reg) (fixRI ri)\n    CMPL    fmt reg ri      -> CMPL fmt (env reg) (fixRI ri)\n    BCC     cond lbl p      -> BCC cond lbl p\n    BCCFAR  cond lbl p      -> BCCFAR cond lbl p\n    MTCTR   reg             -> MTCTR (env reg)\n    BCTR    targets lbl     -> BCTR targets lbl\n    BL      imm argRegs     -> BL imm argRegs    -- argument regs\n    BCTRL   argRegs         -> BCTRL argRegs     -- cannot be remapped\n    ADD     reg1 reg2 ri    -> ADD (env reg1) (env reg2) (fixRI ri)\n    ADDO    reg1 reg2 reg3  -> ADDO (env reg1) (env reg2) (env reg3)\n    ADDC    reg1 reg2 reg3  -> ADDC (env reg1) (env reg2) (env reg3)\n    ADDE    reg1 reg2 reg3  -> ADDE (env reg1) (env reg2) (env reg3)\n    ADDZE   reg1 reg2       -> ADDZE (env reg1) (env reg2)\n    ADDIS   reg1 reg2 imm   -> ADDIS (env reg1) (env reg2) imm\n    SUBF    reg1 reg2 reg3  -> SUBF (env reg1) (env reg2) (env reg3)\n    SUBFO   reg1 reg2 reg3  -> SUBFO (env reg1) (env reg2) (env reg3)\n    SUBFC   reg1 reg2 ri    -> SUBFC (env reg1) (env reg2) (fixRI ri)\n    SUBFE   reg1 reg2 reg3  -> SUBFE (env reg1) (env reg2) (env reg3)\n    MULL    fmt reg1 reg2 ri\n                            -> MULL fmt (env reg1) (env reg2) (fixRI ri)\n    MULLO   fmt reg1 reg2 reg3\n                            -> MULLO fmt (env reg1) (env reg2) (env reg3)\n    MFOV    fmt reg         -> MFOV fmt (env reg)\n    MULHU   fmt reg1 reg2 reg3\n                            -> MULHU fmt (env reg1) (env reg2) (env reg3)\n    DIV     fmt sgn reg1 reg2 reg3\n                            -> DIV fmt sgn (env reg1) (env reg2) (env reg3)\n\n    AND     reg1 reg2 ri    -> AND (env reg1) (env reg2) (fixRI ri)\n    ANDC    reg1 reg2 reg3  -> ANDC (env reg1) (env reg2) (env reg3)\n    NAND    reg1 reg2 reg3  -> NAND (env reg1) (env reg2) (env reg3)\n    OR      reg1 reg2 ri    -> OR  (env reg1) (env reg2) (fixRI ri)\n    ORIS    reg1 reg2 imm   -> ORIS (env reg1) (env reg2) imm\n    XOR     reg1 reg2 ri    -> XOR (env reg1) (env reg2) (fixRI ri)\n    XORIS   reg1 reg2 imm   -> XORIS (env reg1) (env reg2) imm\n    EXTS    fmt reg1 reg2   -> EXTS fmt (env reg1) (env reg2)\n    CNTLZ   fmt reg1 reg2   -> CNTLZ fmt (env reg1) (env reg2)\n    NEG     reg1 reg2       -> NEG (env reg1) (env reg2)\n    NOT     reg1 reg2       -> NOT (env reg1) (env reg2)\n    SL      fmt reg1 reg2 ri\n                            -> SL fmt (env reg1) (env reg2) (fixRI ri)\n    SR      fmt reg1 reg2 ri\n                            -> SR fmt (env reg1) (env reg2) (fixRI ri)\n    SRA     fmt reg1 reg2 ri\n                            -> SRA fmt (env reg1) (env reg2) (fixRI ri)\n    RLWINM  reg1 reg2 sh mb me\n                            -> RLWINM (env reg1) (env reg2) sh mb me\n    CLRLI   fmt reg1 reg2 n -> CLRLI fmt (env reg1) (env reg2) n\n    CLRRI   fmt reg1 reg2 n -> CLRRI fmt (env reg1) (env reg2) n\n    FADD    fmt r1 r2 r3    -> FADD fmt (env r1) (env r2) (env r3)\n    FSUB    fmt r1 r2 r3    -> FSUB fmt (env r1) (env r2) (env r3)\n    FMUL    fmt r1 r2 r3    -> FMUL fmt (env r1) (env r2) (env r3)\n    FDIV    fmt r1 r2 r3    -> FDIV fmt (env r1) (env r2) (env r3)\n    FABS    r1 r2           -> FABS (env r1) (env r2)\n    FNEG    r1 r2           -> FNEG (env r1) (env r2)\n    FCMP    r1 r2           -> FCMP (env r1) (env r2)\n    FCTIWZ  r1 r2           -> FCTIWZ (env r1) (env r2)\n    FCTIDZ  r1 r2           -> FCTIDZ (env r1) (env r2)\n    FCFID   r1 r2           -> FCFID (env r1) (env r2)\n    FRSP    r1 r2           -> FRSP (env r1) (env r2)\n    MFCR    reg             -> MFCR (env reg)\n    MFLR    reg             -> MFLR (env reg)\n    FETCHPC reg             -> FETCHPC (env reg)\n    _                       -> instr\n  where\n    fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)\n    fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i\n\n    fixRI (RIReg r) = RIReg (env r)\n    fixRI other     = other\n\n\n--------------------------------------------------------------------------------\n-- | Checks whether this instruction is a jump/branch instruction.\n-- One that can change the flow of control in a way that the\n-- register allocator needs to worry about.\nppc_isJumpishInstr :: Instr -> Bool\nppc_isJumpishInstr instr\n = case instr of\n    BCC{}       -> True\n    BCCFAR{}    -> True\n    BCTR{}      -> True\n    BCTRL{}     -> True\n    BL{}        -> True\n    JMP{}       -> True\n    _           -> False\n\n\n-- | Checks whether this instruction is a jump/branch instruction.\n-- One that can change the flow of control in a way that the\n-- register allocator needs to worry about.\nppc_jumpDestsOfInstr :: Instr -> [BlockId]\nppc_jumpDestsOfInstr insn\n  = case insn of\n        BCC _ id _      -> [id]\n        BCCFAR _ id _   -> [id]\n        BCTR targets _  -> [id | Just id <- targets]\n        _               -> []\n\n\n-- | Change the destination of this jump instruction.\n-- Used in the linear allocator when adding fixup blocks for join\n-- points.\nppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr\nppc_patchJumpInstr insn patchF\n  = case insn of\n        BCC cc id p     -> BCC cc (patchF id) p\n        BCCFAR cc id p  -> BCCFAR cc (patchF id) p\n        BCTR ids lbl    -> BCTR (map (fmap patchF) ids) lbl\n        _               -> insn\n\n\n-- -----------------------------------------------------------------------------\n\n-- | An instruction to spill a register into a spill slot.\nppc_mkSpillInstr\n   :: DynFlags\n   -> Reg       -- register to spill\n   -> Int       -- current stack delta\n   -> Int       -- spill slot to use\n   -> Instr\n\nppc_mkSpillInstr dflags reg delta slot\n  = let platform = targetPlatform dflags\n        off      = spillSlotToOffset dflags slot\n        arch     = platformArch platform\n    in\n    let fmt = case targetClassOfReg platform reg of\n                RcInteger -> case arch of\n                                ArchPPC -> II32\n                                _       -> II64\n                RcDouble  -> FF64\n                _         -> panic \"PPC.Instr.mkSpillInstr: no match\"\n        instr = case makeImmediate W32 True (off-delta) of\n                Just _  -> ST\n                Nothing -> STFAR -- pseudo instruction: 32 bit offsets\n\n    in instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))\n\n\nppc_mkLoadInstr\n   :: DynFlags\n   -> Reg       -- register to load\n   -> Int       -- current stack delta\n   -> Int       -- spill slot to use\n   -> Instr\n\nppc_mkLoadInstr dflags reg delta slot\n  = let platform = targetPlatform dflags\n        off      = spillSlotToOffset dflags slot\n        arch     = platformArch platform\n    in\n    let fmt = case targetClassOfReg platform reg of\n                RcInteger ->  case arch of\n                                 ArchPPC -> II32\n                                 _       -> II64\n                RcDouble  -> FF64\n                _         -> panic \"PPC.Instr.mkLoadInstr: no match\"\n        instr = case makeImmediate W32 True (off-delta) of\n                Just _  -> LD\n                Nothing -> LDFAR -- pseudo instruction: 32 bit offsets\n\n    in instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))\n\n\n-- | The size of a minimal stackframe header including minimal\n-- parameter save area.\nstackFrameHeaderSize :: DynFlags -> Int\nstackFrameHeaderSize dflags\n  = case platformOS platform of\n      OSAIX    -> 24 + 8 * 4\n      _ -> case platformArch platform of\n                             -- header + parameter save area\n             ArchPPC           -> 64 -- TODO: check ABI spec\n             ArchPPC_64 ELF_V1 -> 48 + 8 * 8\n             ArchPPC_64 ELF_V2 -> 32 + 8 * 8\n             _ -> panic \"PPC.stackFrameHeaderSize: not defined for this OS\"\n     where platform = targetPlatform dflags\n\n-- | The maximum number of bytes required to spill a register. PPC32\n-- has 32-bit GPRs and 64-bit FPRs, while PPC64 has 64-bit GPRs and\n-- 64-bit FPRs. So the maximum is 8 regardless of platforms unlike\n-- x86. Note that AltiVec's vector registers are 128-bit wide so we\n-- must not use this to spill them.\nspillSlotSize :: Int\nspillSlotSize = 8\n\n-- | The number of spill slots available without allocating more.\nmaxSpillSlots :: DynFlags -> Int\nmaxSpillSlots dflags\n    = ((rESERVED_C_STACK_BYTES dflags - stackFrameHeaderSize dflags)\n       `div` spillSlotSize) - 1\n--     = 0 -- useful for testing allocMoreStack\n\n-- | The number of bytes that the stack pointer should be aligned\n-- to. This is 16 both on PPC32 and PPC64 ELF (see ELF processor\n-- specific supplements).\nstackAlign :: Int\nstackAlign = 16\n\n-- | Convert a spill slot number to a *byte* offset, with no sign.\nspillSlotToOffset :: DynFlags -> Int -> Int\nspillSlotToOffset dflags slot\n   = stackFrameHeaderSize dflags + spillSlotSize * slot\n\n\n--------------------------------------------------------------------------------\n-- | See if this instruction is telling us the current C stack delta\nppc_takeDeltaInstr\n    :: Instr\n    -> Maybe Int\n\nppc_takeDeltaInstr instr\n = case instr of\n     DELTA i  -> Just i\n     _        -> Nothing\n\n\nppc_isMetaInstr\n    :: Instr\n    -> Bool\n\nppc_isMetaInstr instr\n = case instr of\n    COMMENT{}   -> True\n    LDATA{}     -> True\n    NEWBLOCK{}  -> True\n    DELTA{}     -> True\n    _           -> False\n\n\n-- | Copy the value in a register to another one.\n-- Must work for all register classes.\nppc_mkRegRegMoveInstr\n    :: Reg\n    -> Reg\n    -> Instr\n\nppc_mkRegRegMoveInstr src dst\n    = MR dst src\n\n\n-- | Make an unconditional jump instruction.\nppc_mkJumpInstr\n    :: BlockId\n    -> [Instr]\n\nppc_mkJumpInstr id\n    = [BCC ALWAYS id Nothing]\n\n\n-- | Take the source and destination from this reg -> reg move instruction\n-- or Nothing if it's not one\nppc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)\nppc_takeRegRegMoveInstr (MR dst src) = Just (src,dst)\nppc_takeRegRegMoveInstr _  = Nothing\n\n-- -----------------------------------------------------------------------------\n-- Making far branches\n\n-- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too\n-- big, we have to work around this limitation.\n\nmakeFarBranches\n        :: LabelMap CmmStatics\n        -> [NatBasicBlock Instr]\n        -> [NatBasicBlock Instr]\nmakeFarBranches info_env blocks\n    | last blockAddresses < nearLimit = blocks\n    | otherwise = zipWith handleBlock blockAddresses blocks\n    where\n        blockAddresses = scanl (+) 0 $ map blockLen blocks\n        blockLen (BasicBlock _ instrs) = length instrs\n\n        handleBlock addr (BasicBlock id instrs)\n                = BasicBlock id (zipWith makeFar [addr..] instrs)\n\n        makeFar _ (BCC ALWAYS tgt _) = BCC ALWAYS tgt Nothing\n        makeFar addr (BCC cond tgt p)\n            | abs (addr - targetAddr) >= nearLimit\n            = BCCFAR cond tgt p\n            | otherwise\n            = BCC cond tgt p\n            where Just targetAddr = lookupUFM blockAddressMap tgt\n        makeFar _ other            = other\n\n        -- 8192 instructions are allowed; let's keep some distance, as\n        -- we have a few pseudo-insns that are pretty-printed as\n        -- multiple instructions, and it's just not worth the effort\n        -- to calculate things exactly\n        nearLimit = 7000 - mapSize info_env * maxRetInfoTableSizeW\n\n        blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses\n", "num_lines": 708}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- Pretty-printing assembly language\n--\n-- (c) The University of Glasgow 1993-2005\n--\n-----------------------------------------------------------------------------\n\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule PPC.Ppr (pprNatCmmDecl) where\n\nimport GhcPrelude\n\nimport PPC.Regs\nimport PPC.Instr\nimport PPC.Cond\nimport PprBase\nimport Instruction\nimport Format\nimport Reg\nimport RegClass\nimport TargetReg\n\nimport Cmm hiding (topInfoTable)\nimport Hoopl.Collections\nimport Hoopl.Label\n\nimport BlockId\nimport CLabel\n\nimport Unique                ( pprUniqueAlways, getUnique )\nimport Platform\nimport FastString\nimport Outputable\nimport DynFlags\n\nimport Data.Word\nimport Data.Int\nimport Data.Bits\n\n-- -----------------------------------------------------------------------------\n-- Printing this stuff out\n\npprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc\npprNatCmmDecl (CmmData section dats) =\n  pprSectionAlign section $$ pprDatas dats\n\npprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =\n  case topInfoTable proc of\n    Nothing ->\n       sdocWithPlatform $ \\platform ->\n         -- special case for code without info table:\n         pprSectionAlign (Section Text lbl) $$\n         (case platformArch platform of\n            ArchPPC_64 ELF_V1 -> pprFunctionDescriptor lbl\n            ArchPPC_64 ELF_V2 -> pprFunctionPrologue lbl\n            _ -> pprLabel lbl) $$ -- blocks guaranteed not null,\n                                     -- so label needed\n         vcat (map (pprBasicBlock top_info) blocks)\n\n    Just (Statics info_lbl _) ->\n      sdocWithPlatform $ \\platform ->\n      pprSectionAlign (Section Text info_lbl) $$\n      (if platformHasSubsectionsViaSymbols platform\n          then ppr (mkDeadStripPreventer info_lbl) <> char ':'\n          else empty) $$\n      vcat (map (pprBasicBlock top_info) blocks) $$\n      -- above: Even the first block gets a label, because with branch-chain\n      -- elimination, it might be the target of a goto.\n      (if platformHasSubsectionsViaSymbols platform\n       then\n       -- See Note [Subsections Via Symbols] in X86/Ppr.hs\n                text \"\\t.long \"\n            <+> ppr info_lbl\n            <+> char '-'\n            <+> ppr (mkDeadStripPreventer info_lbl)\n       else empty)\n\npprFunctionDescriptor :: CLabel -> SDoc\npprFunctionDescriptor lab = pprGloblDecl lab\n                        $$  text \"\\t.section \\\".opd\\\", \\\"aw\\\"\"\n                        $$  text \"\\t.align 3\"\n                        $$  ppr lab <> char ':'\n                        $$  text \"\\t.quad .\"\n                        <>  ppr lab\n                        <>  text \",.TOC.@tocbase,0\"\n                        $$  text \"\\t.previous\"\n                        $$  text \"\\t.type\"\n                        <+> ppr lab\n                        <>  text \", @function\"\n                        $$  char '.' <> ppr lab <> char ':'\n\npprFunctionPrologue :: CLabel ->SDoc\npprFunctionPrologue lab =  pprGloblDecl lab\n                        $$  text \".type \"\n                        <> ppr lab\n                        <> text \", @function\"\n                        $$ ppr lab <> char ':'\n                        $$ text \"0:\\taddis\\t\" <> pprReg toc\n                        <> text \",12,.TOC.-0b@ha\"\n                        $$ text \"\\taddi\\t\" <> pprReg toc\n                        <> char ',' <> pprReg toc <> text \",.TOC.-0b@l\"\n                        $$ text \"\\t.localentry\\t\" <> ppr lab\n                        <> text \",.-\" <> ppr lab\n\npprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc\npprBasicBlock info_env (BasicBlock blockid instrs)\n  = maybe_infotable $$\n    pprLabel (blockLbl blockid) $$\n    vcat (map pprInstr instrs)\n  where\n    maybe_infotable = case mapLookup blockid info_env of\n       Nothing   -> empty\n       Just (Statics info_lbl info) ->\n           pprAlignForSection Text $$\n           vcat (map pprData info) $$\n           pprLabel info_lbl\n\n\n\npprDatas :: CmmStatics -> SDoc\npprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)\n\npprData :: CmmStatic -> SDoc\npprData (CmmString str)          = pprBytes str\npprData (CmmUninitialised bytes) = text \".space \" <> int bytes\npprData (CmmStaticLit lit)       = pprDataItem lit\n\npprGloblDecl :: CLabel -> SDoc\npprGloblDecl lbl\n  | not (externallyVisibleCLabel lbl) = empty\n  | otherwise = text \".globl \" <> ppr lbl\n\npprTypeAndSizeDecl :: CLabel -> SDoc\npprTypeAndSizeDecl lbl\n  = sdocWithPlatform $ \\platform ->\n    if platformOS platform == OSLinux && externallyVisibleCLabel lbl\n    then text \".type \" <>\n         ppr lbl <> text \", @object\"\n    else empty\n\npprLabel :: CLabel -> SDoc\npprLabel lbl = pprGloblDecl lbl\n            $$ pprTypeAndSizeDecl lbl\n            $$ (ppr lbl <> char ':')\n\n-- -----------------------------------------------------------------------------\n-- pprInstr: print an 'Instr'\n\ninstance Outputable Instr where\n    ppr instr = pprInstr instr\n\n\npprReg :: Reg -> SDoc\n\npprReg r\n  = case r of\n      RegReal    (RealRegSingle i) -> ppr_reg_no i\n      RegReal    (RealRegPair{})   -> panic \"PPC.pprReg: no reg pairs on this arch\"\n      RegVirtual (VirtualRegI  u)  -> text \"%vI_\"   <> pprUniqueAlways u\n      RegVirtual (VirtualRegHi u)  -> text \"%vHi_\"  <> pprUniqueAlways u\n      RegVirtual (VirtualRegF  u)  -> text \"%vF_\"   <> pprUniqueAlways u\n      RegVirtual (VirtualRegD  u)  -> text \"%vD_\"   <> pprUniqueAlways u\n      RegVirtual (VirtualRegSSE u) -> text \"%vSSE_\" <> pprUniqueAlways u\n  where\n    ppr_reg_no :: Int -> SDoc\n    ppr_reg_no i\n         | i <= 31   = int i      -- GPRs\n         | i <= 63   = int (i-32) -- FPRs\n         | otherwise = text \"very naughty powerpc register\"\n\n\n\npprFormat :: Format -> SDoc\npprFormat x\n = ptext (case x of\n                II8  -> sLit \"b\"\n                II16 -> sLit \"h\"\n                II32 -> sLit \"w\"\n                II64 -> sLit \"d\"\n                FF32 -> sLit \"fs\"\n                FF64 -> sLit \"fd\"\n                _    -> panic \"PPC.Ppr.pprFormat: no match\")\n\n\npprCond :: Cond -> SDoc\npprCond c\n = ptext (case c of {\n                ALWAYS  -> sLit \"\";\n                EQQ     -> sLit \"eq\";  NE    -> sLit \"ne\";\n                LTT     -> sLit \"lt\";  GE    -> sLit \"ge\";\n                GTT     -> sLit \"gt\";  LE    -> sLit \"le\";\n                LU      -> sLit \"lt\";  GEU   -> sLit \"ge\";\n                GU      -> sLit \"gt\";  LEU   -> sLit \"le\"; })\n\n\npprImm :: Imm -> SDoc\n\npprImm (ImmInt i)     = int i\npprImm (ImmInteger i) = integer i\npprImm (ImmCLbl l)    = ppr l\npprImm (ImmIndex l i) = ppr l <> char '+' <> int i\npprImm (ImmLit s)     = s\n\npprImm (ImmFloat _)  = text \"naughty float immediate\"\npprImm (ImmDouble _) = text \"naughty double immediate\"\n\npprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b\npprImm (ImmConstantDiff a b) = pprImm a <> char '-'\n                   <> lparen <> pprImm b <> rparen\n\npprImm (LO (ImmInt i))     = pprImm (LO (ImmInteger (toInteger i)))\npprImm (LO (ImmInteger i)) = pprImm (ImmInteger (toInteger lo16))\n  where\n    lo16 = fromInteger (i .&. 0xffff) :: Int16\n\npprImm (LO i)\n  = pprImm i <> text \"@l\"\n\npprImm (HI i)\n  = pprImm i <> text \"@h\"\n\npprImm (HA (ImmInt i))     = pprImm (HA (ImmInteger (toInteger i)))\npprImm (HA (ImmInteger i)) = pprImm (ImmInteger ha16)\n  where\n    ha16 = if lo16 >= 0x8000 then hi16+1 else hi16\n    hi16 = (i `shiftR` 16)\n    lo16 = i .&. 0xffff\n\npprImm (HA i)\n  = pprImm i <> text \"@ha\"\n\npprImm (HIGHERA i)\n  = pprImm i <> text \"@highera\"\n\npprImm (HIGHESTA i)\n  = pprImm i <> text \"@highesta\"\n\n\npprAddr :: AddrMode -> SDoc\npprAddr (AddrRegReg r1 r2)\n  = pprReg r1 <> char ',' <+> pprReg r2\npprAddr (AddrRegImm r1 (ImmInt i))\n  = hcat [ int i, char '(', pprReg r1, char ')' ]\npprAddr (AddrRegImm r1 (ImmInteger i))\n  = hcat [ integer i, char '(', pprReg r1, char ')' ]\npprAddr (AddrRegImm r1 imm)\n  = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]\n\n\npprSectionAlign :: Section -> SDoc\npprSectionAlign sec@(Section seg _) =\n sdocWithPlatform $ \\platform ->\n   pprSectionHeader platform sec $$\n   pprAlignForSection seg\n\n-- | Print appropriate alignment for the given section type.\npprAlignForSection :: SectionType -> SDoc\npprAlignForSection seg =\n sdocWithPlatform $ \\platform ->\n let ppc64    = not $ target32Bit platform\n in ptext $ case seg of\n       Text              -> sLit \".align 2\"\n       Data\n        | ppc64          -> sLit \".align 3\"\n        | otherwise      -> sLit \".align 2\"\n       ReadOnlyData\n        | ppc64          -> sLit \".align 3\"\n        | otherwise      -> sLit \".align 2\"\n       RelocatableReadOnlyData\n        | ppc64          -> sLit \".align 3\"\n        | otherwise      -> sLit \".align 2\"\n       UninitialisedData\n        | ppc64          -> sLit \".align 3\"\n        | otherwise      -> sLit \".align 2\"\n       ReadOnlyData16    -> sLit \".align 4\"\n       -- TODO: This is copied from the ReadOnlyData case, but it can likely be\n       -- made more efficient.\n       CString\n        | ppc64          -> sLit \".align 3\"\n        | otherwise      -> sLit \".align 2\"\n       OtherSection _    -> panic \"PprMach.pprSectionAlign: unknown section\"\n\npprDataItem :: CmmLit -> SDoc\npprDataItem lit\n  = sdocWithDynFlags $ \\dflags ->\n    vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit dflags)\n    where\n        imm = litToImm lit\n        archPPC_64 dflags = not $ target32Bit $ targetPlatform dflags\n\n        ppr_item II8   _ _ = [text \"\\t.byte\\t\" <> pprImm imm]\n\n        ppr_item II32  _ _ = [text \"\\t.long\\t\" <> pprImm imm]\n\n        ppr_item II64 _ dflags\n           | archPPC_64 dflags = [text \"\\t.quad\\t\" <> pprImm imm]\n\n\n        ppr_item FF32 (CmmFloat r _) _\n           = let bs = floatToBytes (fromRational r)\n             in  map (\\b -> text \"\\t.byte\\t\" <> pprImm (ImmInt b)) bs\n\n        ppr_item FF64 (CmmFloat r _) _\n           = let bs = doubleToBytes (fromRational r)\n             in  map (\\b -> text \"\\t.byte\\t\" <> pprImm (ImmInt b)) bs\n\n        ppr_item II16 _ _      = [text \"\\t.short\\t\" <> pprImm imm]\n\n        ppr_item II64 (CmmInt x _) dflags\n           | not(archPPC_64 dflags) =\n                [text \"\\t.long\\t\"\n                    <> int (fromIntegral\n                        (fromIntegral (x `shiftR` 32) :: Word32)),\n                 text \"\\t.long\\t\"\n                    <> int (fromIntegral (fromIntegral x :: Word32))]\n\n        ppr_item _ _ _\n                = panic \"PPC.Ppr.pprDataItem: no match\"\n\n\npprInstr :: Instr -> SDoc\n\npprInstr (COMMENT _) = empty -- nuke 'em\n{-\npprInstr (COMMENT s) =\n     if platformOS platform == OSLinux\n     then text \"# \" <> ftext s\n     else text \"; \" <> ftext s\n-}\npprInstr (DELTA d)\n   = pprInstr (COMMENT (mkFastString (\"\\tdelta = \" ++ show d)))\n\npprInstr (NEWBLOCK _)\n   = panic \"PprMach.pprInstr: NEWBLOCK\"\n\npprInstr (LDATA _ _)\n   = panic \"PprMach.pprInstr: LDATA\"\n\n{-\npprInstr (SPILL reg slot)\n   = hcat [\n           text \"\\tSPILL\",\n        char '\\t',\n        pprReg reg,\n        comma,\n        text \"SLOT\" <> parens (int slot)]\n\npprInstr (RELOAD slot reg)\n   = hcat [\n           text \"\\tRELOAD\",\n        char '\\t',\n        text \"SLOT\" <> parens (int slot),\n        comma,\n        pprReg reg]\n-}\n\npprInstr (LD fmt reg addr) = hcat [\n        char '\\t',\n        text \"l\",\n        ptext (case fmt of\n            II8  -> sLit \"bz\"\n            II16 -> sLit \"hz\"\n            II32 -> sLit \"wz\"\n            II64 -> sLit \"d\"\n            FF32 -> sLit \"fs\"\n            FF64 -> sLit \"fd\"\n            _         -> panic \"PPC.Ppr.pprInstr: no match\"\n            ),\n        case addr of AddrRegImm _ _ -> empty\n                     AddrRegReg _ _ -> char 'x',\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprAddr addr\n    ]\n\npprInstr (LDFAR fmt reg (AddrRegImm source off)) =\n   sdocWithPlatform $ \\platform -> vcat [\n         pprInstr (ADDIS (tmpReg platform) source (HA off)),\n         pprInstr (LD fmt reg (AddrRegImm (tmpReg platform) (LO off)))\n    ]\npprInstr (LDFAR _ _ _) =\n   panic \"PPC.Ppr.pprInstr LDFAR: no match\"\n\npprInstr (LDR fmt reg1 addr) = hcat [\n  text \"\\tl\",\n  case fmt of\n    II32 -> char 'w'\n    II64 -> char 'd'\n    _    -> panic \"PPC.Ppr.Instr LDR: no match\",\n  text \"arx\\t\",\n  pprReg reg1,\n  text \", \",\n  pprAddr addr\n  ]\n\npprInstr (LA fmt reg addr) = hcat [\n        char '\\t',\n        text \"l\",\n        ptext (case fmt of\n            II8  -> sLit \"ba\"\n            II16 -> sLit \"ha\"\n            II32 -> sLit \"wa\"\n            II64 -> sLit \"d\"\n            FF32 -> sLit \"fs\"\n            FF64 -> sLit \"fd\"\n            _         -> panic \"PPC.Ppr.pprInstr: no match\"\n            ),\n        case addr of AddrRegImm _ _ -> empty\n                     AddrRegReg _ _ -> char 'x',\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprAddr addr\n    ]\npprInstr (ST fmt reg addr) = hcat [\n        char '\\t',\n        text \"st\",\n        pprFormat fmt,\n        case addr of AddrRegImm _ _ -> empty\n                     AddrRegReg _ _ -> char 'x',\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprAddr addr\n    ]\npprInstr (STFAR fmt reg (AddrRegImm source off)) =\n   sdocWithPlatform $ \\platform -> vcat [\n         pprInstr (ADDIS (tmpReg platform) source (HA off)),\n         pprInstr (ST fmt reg (AddrRegImm (tmpReg platform) (LO off)))\n    ]\npprInstr (STFAR _ _ _) =\n   panic \"PPC.Ppr.pprInstr STFAR: no match\"\npprInstr (STU fmt reg addr) = hcat [\n        char '\\t',\n        text \"st\",\n        pprFormat fmt,\n        char 'u',\n        case addr of AddrRegImm _ _ -> empty\n                     AddrRegReg _ _ -> char 'x',\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprAddr addr\n    ]\npprInstr (STC fmt reg1 addr) = hcat [\n  text \"\\tst\",\n  case fmt of\n    II32 -> char 'w'\n    II64 -> char 'd'\n    _    -> panic \"PPC.Ppr.Instr STC: no match\",\n  text \"cx.\\t\",\n  pprReg reg1,\n  text \", \",\n  pprAddr addr\n  ]\npprInstr (LIS reg imm) = hcat [\n        char '\\t',\n        text \"lis\",\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprImm imm\n    ]\npprInstr (LI reg imm) = hcat [\n        char '\\t',\n        text \"li\",\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprImm imm\n    ]\npprInstr (MR reg1 reg2)\n    | reg1 == reg2 = empty\n    | otherwise = hcat [\n        char '\\t',\n        sdocWithPlatform $ \\platform ->\n        case targetClassOfReg platform reg1 of\n            RcInteger -> text \"mr\"\n            _ -> text \"fmr\",\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2\n    ]\npprInstr (CMP fmt reg ri) = hcat [\n        char '\\t',\n        op,\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprRI ri\n    ]\n    where\n        op = hcat [\n                text \"cmp\",\n                pprFormat fmt,\n                case ri of\n                    RIReg _ -> empty\n                    RIImm _ -> char 'i'\n            ]\npprInstr (CMPL fmt reg ri) = hcat [\n        char '\\t',\n        op,\n        char '\\t',\n        pprReg reg,\n        text \", \",\n        pprRI ri\n    ]\n    where\n        op = hcat [\n                text \"cmpl\",\n                pprFormat fmt,\n                case ri of\n                    RIReg _ -> empty\n                    RIImm _ -> char 'i'\n            ]\npprInstr (BCC cond blockid prediction) = hcat [\n        char '\\t',\n        text \"b\",\n        pprCond cond,\n        pprPrediction prediction,\n        char '\\t',\n        ppr lbl\n    ]\n    where lbl = mkLocalBlockLabel (getUnique blockid)\n          pprPrediction p = case p of\n            Nothing    -> empty\n            Just True  -> char '+'\n            Just False -> char '-'\n\npprInstr (BCCFAR cond blockid prediction) = vcat [\n        hcat [\n            text \"\\tb\",\n            pprCond (condNegate cond),\n            neg_prediction,\n            text \"\\t$+8\"\n        ],\n        hcat [\n            text \"\\tb\\t\",\n            ppr lbl\n        ]\n    ]\n    where lbl = mkLocalBlockLabel (getUnique blockid)\n          neg_prediction = case prediction of\n            Nothing    -> empty\n            Just True  -> char '-'\n            Just False -> char '+'\n\npprInstr (JMP lbl)\n  -- We never jump to ForeignLabels; if we ever do, c.f. handling for \"BL\"\n  | isForeignLabel lbl = panic \"PPC.Ppr.pprInstr: JMP to ForeignLabel\"\n  | otherwise =\n    hcat [ -- an alias for b that takes a CLabel\n        char '\\t',\n        text \"b\",\n        char '\\t',\n        ppr lbl\n    ]\n\npprInstr (MTCTR reg) = hcat [\n        char '\\t',\n        text \"mtctr\",\n        char '\\t',\n        pprReg reg\n    ]\npprInstr (BCTR _ _) = hcat [\n        char '\\t',\n        text \"bctr\"\n    ]\npprInstr (BL lbl _) = do\n    sdocWithPlatform $ \\platform -> case platformOS platform of\n        OSAIX ->\n          -- On AIX, \"printf\" denotes a function-descriptor (for use\n          -- by function pointers), whereas the actual entry-code\n          -- address is denoted by the dot-prefixed \".printf\" label.\n          -- Moreover, the PPC NCG only ever emits a BL instruction\n          -- for calling C ABI functions. Most of the time these calls\n          -- originate from FFI imports and have a 'ForeignLabel',\n          -- but when profiling the codegen inserts calls via\n          -- 'emitRtsCallGen' which are 'CmmLabel's even though\n          -- they'd technically be more like 'ForeignLabel's.\n          hcat [\n            text \"\\tbl\\t.\",\n            ppr lbl\n          ]\n        _ ->\n          hcat [\n            text \"\\tbl\\t\",\n            ppr lbl\n          ]\npprInstr (BCTRL _) = hcat [\n        char '\\t',\n        text \"bctrl\"\n    ]\npprInstr (ADD reg1 reg2 ri) = pprLogic (sLit \"add\") reg1 reg2 ri\npprInstr (ADDIS reg1 reg2 imm) = hcat [\n        char '\\t',\n        text \"addis\",\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprImm imm\n    ]\n\npprInstr (ADDO reg1 reg2 reg3) = pprLogic (sLit \"addo\") reg1 reg2 (RIReg reg3)\npprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit \"addc\") reg1 reg2 (RIReg reg3)\npprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit \"adde\") reg1 reg2 (RIReg reg3)\npprInstr (ADDZE reg1 reg2) = pprUnary (sLit \"addze\") reg1 reg2\npprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit \"subf\") reg1 reg2 (RIReg reg3)\npprInstr (SUBFO reg1 reg2 reg3) = pprLogic (sLit \"subfo\") reg1 reg2 (RIReg reg3)\npprInstr (SUBFC reg1 reg2 ri) = hcat [\n        char '\\t',\n        text \"subf\",\n        case ri of\n            RIReg _ -> empty\n            RIImm _ -> char 'i',\n        text \"c\\t\",\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprRI ri\n    ]\npprInstr (SUBFE reg1 reg2 reg3) = pprLogic (sLit \"subfe\") reg1 reg2 (RIReg reg3)\npprInstr (MULL fmt reg1 reg2 ri) = pprMul fmt reg1 reg2 ri\npprInstr (MULLO fmt reg1 reg2 reg3) = hcat [\n        char '\\t',\n        text \"mull\",\n        case fmt of\n          II32 -> char 'w'\n          II64 -> char 'd'\n          _    -> panic \"PPC: illegal format\",\n        text \"o\\t\",\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprReg reg3\n    ]\npprInstr (MFOV fmt reg) = vcat [\n        hcat [\n            char '\\t',\n            text \"mfxer\",\n            char '\\t',\n            pprReg reg\n            ],\n        hcat [\n            char '\\t',\n            text \"extr\",\n            case fmt of\n              II32 -> char 'w'\n              II64 -> char 'd'\n              _    -> panic \"PPC: illegal format\",\n            text \"i\\t\",\n            pprReg reg,\n            text \", \",\n            pprReg reg,\n            text \", 1, \",\n            case fmt of\n              II32 -> text \"1\"\n              II64 -> text \"33\"\n              _    -> panic \"PPC: illegal format\"\n            ]\n        ]\n\npprInstr (MULHU fmt reg1 reg2 reg3) = hcat [\n        char '\\t',\n        text \"mulh\",\n        case fmt of\n          II32 -> char 'w'\n          II64 -> char 'd'\n          _    -> panic \"PPC: illegal format\",\n        text \"u\\t\",\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprReg reg3\n    ]\n\npprInstr (DIV fmt sgn reg1 reg2 reg3) = pprDiv fmt sgn reg1 reg2 reg3\n\n        -- for some reason, \"andi\" doesn't exist.\n        -- we'll use \"andi.\" instead.\npprInstr (AND reg1 reg2 (RIImm imm)) = hcat [\n        char '\\t',\n        text \"andi.\",\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprImm imm\n    ]\npprInstr (AND reg1 reg2 ri) = pprLogic (sLit \"and\") reg1 reg2 ri\npprInstr (ANDC reg1 reg2 reg3) = pprLogic (sLit \"andc\") reg1 reg2 (RIReg reg3)\npprInstr (NAND reg1 reg2 reg3) = pprLogic (sLit \"nand\") reg1 reg2 (RIReg reg3)\n\npprInstr (OR reg1 reg2 ri) = pprLogic (sLit \"or\") reg1 reg2 ri\npprInstr (XOR reg1 reg2 ri) = pprLogic (sLit \"xor\") reg1 reg2 ri\n\npprInstr (ORIS reg1 reg2 imm) = hcat [\n        char '\\t',\n        text \"oris\",\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprImm imm\n    ]\n\npprInstr (XORIS reg1 reg2 imm) = hcat [\n        char '\\t',\n        text \"xoris\",\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprImm imm\n    ]\n\npprInstr (EXTS fmt reg1 reg2) = hcat [\n        char '\\t',\n        text \"exts\",\n        pprFormat fmt,\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2\n    ]\npprInstr (CNTLZ fmt reg1 reg2) = hcat [\n        char '\\t',\n        text \"cntlz\",\n        case fmt of\n          II32 -> char 'w'\n          II64 -> char 'd'\n          _    -> panic \"PPC: illegal format\",\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2\n    ]\n\npprInstr (NEG reg1 reg2) = pprUnary (sLit \"neg\") reg1 reg2\npprInstr (NOT reg1 reg2) = pprUnary (sLit \"not\") reg1 reg2\n\npprInstr (SR II32 reg1 reg2 (RIImm (ImmInt i))) | i < 0  || i > 31 =\n    -- Handle the case where we are asked to shift a 32 bit register by\n    -- less than zero or more than 31 bits. We convert this into a clear\n    -- of the destination register.\n    -- Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/5900\n    pprInstr (XOR reg1 reg2 (RIReg reg2))\n\npprInstr (SL II32 reg1 reg2 (RIImm (ImmInt i))) | i < 0  || i > 31 =\n    -- As above for SR, but for left shifts.\n    -- Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/10870\n    pprInstr (XOR reg1 reg2 (RIReg reg2))\n\npprInstr (SRA II32 reg1 reg2 (RIImm (ImmInt i))) | i > 31 =\n    -- PT: I don't know what to do for negative shift amounts:\n    -- For now just panic.\n    --\n    -- For shift amounts greater than 31 set all bit to the\n    -- value of the sign bit, this also what sraw does.\n    pprInstr (SRA II32 reg1 reg2 (RIImm (ImmInt 31)))\n\npprInstr (SL fmt reg1 reg2 ri) =\n         let op = case fmt of\n                       II32 -> \"slw\"\n                       II64 -> \"sld\"\n                       _    -> panic \"PPC.Ppr.pprInstr: shift illegal size\"\n         in pprLogic (sLit op) reg1 reg2 (limitShiftRI fmt ri)\n\npprInstr (SR fmt reg1 reg2 ri) =\n         let op = case fmt of\n                       II32 -> \"srw\"\n                       II64 -> \"srd\"\n                       _    -> panic \"PPC.Ppr.pprInstr: shift illegal size\"\n         in pprLogic (sLit op) reg1 reg2 (limitShiftRI fmt ri)\n\npprInstr (SRA fmt reg1 reg2 ri) =\n         let op = case fmt of\n                       II32 -> \"sraw\"\n                       II64 -> \"srad\"\n                       _    -> panic \"PPC.Ppr.pprInstr: shift illegal size\"\n         in pprLogic (sLit op) reg1 reg2 (limitShiftRI fmt ri)\n\npprInstr (RLWINM reg1 reg2 sh mb me) = hcat [\n        text \"\\trlwinm\\t\",\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        int sh,\n        text \", \",\n        int mb,\n        text \", \",\n        int me\n    ]\n\npprInstr (CLRLI fmt reg1 reg2 n) = hcat [\n        text \"\\tclrl\",\n        pprFormat fmt,\n        text \"i \",\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        int n\n    ]\npprInstr (CLRRI fmt reg1 reg2 n) = hcat [\n        text \"\\tclrr\",\n        pprFormat fmt,\n        text \"i \",\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        int n\n    ]\n\npprInstr (FADD fmt reg1 reg2 reg3) = pprBinaryF (sLit \"fadd\") fmt reg1 reg2 reg3\npprInstr (FSUB fmt reg1 reg2 reg3) = pprBinaryF (sLit \"fsub\") fmt reg1 reg2 reg3\npprInstr (FMUL fmt reg1 reg2 reg3) = pprBinaryF (sLit \"fmul\") fmt reg1 reg2 reg3\npprInstr (FDIV fmt reg1 reg2 reg3) = pprBinaryF (sLit \"fdiv\") fmt reg1 reg2 reg3\npprInstr (FABS reg1 reg2) = pprUnary (sLit \"fabs\") reg1 reg2\npprInstr (FNEG reg1 reg2) = pprUnary (sLit \"fneg\") reg1 reg2\n\npprInstr (FCMP reg1 reg2) = hcat [\n        char '\\t',\n        text \"fcmpu\\t0, \",\n            -- Note: we're using fcmpu, not fcmpo\n            -- The difference is with fcmpo, compare with NaN is an invalid operation.\n            -- We don't handle invalid fp ops, so we don't care.\n            -- Morever, we use `fcmpu 0, ...` rather than `fcmpu cr0, ...` for\n            -- better portability since some non-GNU assembler (such as\n            -- IBM's `as`) tend not to support the symbolic register name cr0.\n            -- This matches the syntax that GCC seems to emit for PPC targets.\n        pprReg reg1,\n        text \", \",\n        pprReg reg2\n    ]\n\npprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit \"fctiwz\") reg1 reg2\npprInstr (FCTIDZ reg1 reg2) = pprUnary (sLit \"fctidz\") reg1 reg2\npprInstr (FCFID reg1 reg2) = pprUnary (sLit \"fcfid\") reg1 reg2\npprInstr (FRSP reg1 reg2) = pprUnary (sLit \"frsp\") reg1 reg2\n\npprInstr (CRNOR dst src1 src2) = hcat [\n        text \"\\tcrnor\\t\",\n        int dst,\n        text \", \",\n        int src1,\n        text \", \",\n        int src2\n    ]\n\npprInstr (MFCR reg) = hcat [\n        char '\\t',\n        text \"mfcr\",\n        char '\\t',\n        pprReg reg\n    ]\n\npprInstr (MFLR reg) = hcat [\n        char '\\t',\n        text \"mflr\",\n        char '\\t',\n        pprReg reg\n    ]\n\npprInstr (FETCHPC reg) = vcat [\n        text \"\\tbcl\\t20,31,1f\",\n        hcat [ text \"1:\\tmflr\\t\", pprReg reg ]\n    ]\n\npprInstr HWSYNC = text \"\\tsync\"\n\npprInstr ISYNC  = text \"\\tisync\"\n\npprInstr LWSYNC = text \"\\tlwsync\"\n\npprInstr NOP = text \"\\tnop\"\n\n\npprLogic :: PtrString -> Reg -> Reg -> RI -> SDoc\npprLogic op reg1 reg2 ri = hcat [\n        char '\\t',\n        ptext op,\n        case ri of\n            RIReg _ -> empty\n            RIImm _ -> char 'i',\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprRI ri\n    ]\n\n\npprMul :: Format -> Reg -> Reg -> RI -> SDoc\npprMul fmt reg1 reg2 ri = hcat [\n        char '\\t',\n        text \"mull\",\n        case ri of\n            RIReg _ -> case fmt of\n              II32 -> char 'w'\n              II64 -> char 'd'\n              _    -> panic \"PPC: illegal format\"\n            RIImm _ -> char 'i',\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprRI ri\n    ]\n\n\npprDiv :: Format -> Bool -> Reg -> Reg -> Reg -> SDoc\npprDiv fmt sgn reg1 reg2 reg3 = hcat [\n        char '\\t',\n        text \"div\",\n        case fmt of\n          II32 -> char 'w'\n          II64 -> char 'd'\n          _    -> panic \"PPC: illegal format\",\n        if sgn then empty else char 'u',\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprReg reg3\n    ]\n\n\npprUnary :: PtrString -> Reg -> Reg -> SDoc\npprUnary op reg1 reg2 = hcat [\n        char '\\t',\n        ptext op,\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2\n    ]\n\n\npprBinaryF :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc\npprBinaryF op fmt reg1 reg2 reg3 = hcat [\n        char '\\t',\n        ptext op,\n        pprFFormat fmt,\n        char '\\t',\n        pprReg reg1,\n        text \", \",\n        pprReg reg2,\n        text \", \",\n        pprReg reg3\n    ]\n\npprRI :: RI -> SDoc\npprRI (RIReg r) = pprReg r\npprRI (RIImm r) = pprImm r\n\n\npprFFormat :: Format -> SDoc\npprFFormat FF64     = empty\npprFFormat FF32     = char 's'\npprFFormat _        = panic \"PPC.Ppr.pprFFormat: no match\"\n\n    -- limit immediate argument for shift instruction to range 0..63\n    -- for 64 bit size and 0..32 otherwise\nlimitShiftRI :: Format -> RI -> RI\nlimitShiftRI II64 (RIImm (ImmInt i)) | i > 63 || i < 0 =\n  panic $ \"PPC.Ppr: Shift by \" ++ show i ++ \" bits is not allowed.\"\nlimitShiftRI II32 (RIImm (ImmInt i)) | i > 31 || i < 0 =\n  panic $ \"PPC.Ppr: 32 bit: Shift by \" ++ show i ++ \" bits is not allowed.\"\nlimitShiftRI _ x = x\n", "num_lines": 987}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Machine-specific parts of the register allocator\n--\n-- (c) The University of Glasgow 1996-2004\n--\n-----------------------------------------------------------------------------\nmodule PPC.RegInfo (\n        JumpDest( DestBlockId ), getJumpDestBlockId,\n        canShortcut,\n        shortcutJump,\n\n        shortcutStatics\n)\n\nwhere\n\n#include \"nativeGen/NCG.h\"\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport PPC.Instr\n\nimport BlockId\nimport Cmm\nimport CLabel\n\nimport Unique\nimport Outputable (ppr, text, Outputable, (<>))\n\ndata JumpDest = DestBlockId BlockId\n\n-- Debug Instance\ninstance Outputable JumpDest where\n  ppr (DestBlockId bid) = text \"jd<blk>:\" <> ppr bid\n\ngetJumpDestBlockId :: JumpDest -> Maybe BlockId\ngetJumpDestBlockId (DestBlockId bid) = Just bid\n\ncanShortcut :: Instr -> Maybe JumpDest\ncanShortcut _ = Nothing\n\nshortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr\nshortcutJump _ other = other\n\n\n-- Here because it knows about JumpDest\nshortcutStatics :: (BlockId -> Maybe JumpDest) -> CmmStatics -> CmmStatics\nshortcutStatics fn (Statics lbl statics)\n  = Statics lbl $ map (shortcutStatic fn) statics\n  -- we need to get the jump tables, so apply the mapping to the entries\n  -- of a CmmData too.\n\nshortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel\nshortcutLabel fn lab\n  | Just blkId <- maybeLocalBlockLabel lab = shortBlockId fn blkId\n  | otherwise                              = lab\n\nshortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic\nshortcutStatic fn (CmmStaticLit (CmmLabel lab))\n  = CmmStaticLit (CmmLabel (shortcutLabel fn lab))\nshortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off w))\n  = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off w)\n        -- slightly dodgy, we're ignoring the second label, but this\n        -- works with the way we use CmmLabelDiffOff for jump tables now.\nshortcutStatic _ other_static\n        = other_static\n\nshortBlockId\n        :: (BlockId -> Maybe JumpDest)\n        -> BlockId\n        -> CLabel\n\nshortBlockId fn blockid =\n   case fn blockid of\n      Nothing -> mkLocalBlockLabel uq\n      Just (DestBlockId blockid')  -> shortBlockId fn blockid'\n   where uq = getUnique blockid\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 1994-2004\n--\n-- -----------------------------------------------------------------------------\n\nmodule PPC.Regs (\n        -- squeeze functions\n        virtualRegSqueeze,\n        realRegSqueeze,\n\n        mkVirtualReg,\n        regDotColor,\n\n        -- immediates\n        Imm(..),\n        strImmLit,\n        litToImm,\n\n        -- addressing modes\n        AddrMode(..),\n        addrOffset,\n\n        -- registers\n        spRel,\n        argRegs,\n        allArgRegs,\n        callClobberedRegs,\n        allMachRegNos,\n        classOfRealReg,\n        showReg,\n\n        -- machine specific\n        allFPArgRegs,\n        fits16Bits,\n        makeImmediate,\n        fReg,\n        r0, sp, toc, r3, r4, r11, r12, r27, r28, r30,\n        tmpReg,\n        f1, f20, f21,\n\n        allocatableRegs\n\n)\n\nwhere\n\n#include \"nativeGen/NCG.h\"\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Reg\nimport RegClass\nimport Format\n\nimport Cmm\nimport CLabel           ( CLabel )\nimport Unique\n\nimport CodeGen.Platform\nimport DynFlags\nimport Outputable\nimport Platform\n\nimport Data.Word        ( Word8, Word16, Word32, Word64 )\nimport Data.Int         ( Int8, Int16, Int32, Int64 )\n\n\n-- squeese functions for the graph allocator -----------------------------------\n\n-- | regSqueeze_class reg\n--      Calculate the maximum number of register colors that could be\n--      denied to a node of this class due to having this reg\n--      as a neighbour.\n--\n{-# INLINE virtualRegSqueeze #-}\nvirtualRegSqueeze :: RegClass -> VirtualReg -> Int\nvirtualRegSqueeze cls vr\n = case cls of\n        RcInteger\n         -> case vr of\n                VirtualRegI{}           -> 1\n                VirtualRegHi{}          -> 1\n                _other                  -> 0\n\n        RcDouble\n         -> case vr of\n                VirtualRegD{}           -> 1\n                VirtualRegF{}           -> 0\n                _other                  -> 0\n\n        _other -> 0\n\n{-# INLINE realRegSqueeze #-}\nrealRegSqueeze :: RegClass -> RealReg -> Int\nrealRegSqueeze cls rr\n = case cls of\n        RcInteger\n         -> case rr of\n                RealRegSingle regNo\n                        | regNo < 32    -> 1     -- first fp reg is 32\n                        | otherwise     -> 0\n\n                RealRegPair{}           -> 0\n\n        RcDouble\n         -> case rr of\n                RealRegSingle regNo\n                        | regNo < 32    -> 0\n                        | otherwise     -> 1\n\n                RealRegPair{}           -> 0\n\n        _other -> 0\n\nmkVirtualReg :: Unique -> Format -> VirtualReg\nmkVirtualReg u format\n   | not (isFloatFormat format) = VirtualRegI u\n   | otherwise\n   = case format of\n        FF32    -> VirtualRegD u\n        FF64    -> VirtualRegD u\n        _       -> panic \"mkVirtualReg\"\n\nregDotColor :: RealReg -> SDoc\nregDotColor reg\n = case classOfRealReg reg of\n        RcInteger       -> text \"blue\"\n        RcFloat         -> text \"red\"\n        RcDouble        -> text \"green\"\n        RcDoubleSSE     -> text \"yellow\"\n\n\n-- immediates ------------------------------------------------------------------\ndata Imm\n        = ImmInt        Int\n        | ImmInteger    Integer     -- Sigh.\n        | ImmCLbl       CLabel      -- AbstractC Label (with baggage)\n        | ImmLit        SDoc        -- Simple string\n        | ImmIndex    CLabel Int\n        | ImmFloat      Rational\n        | ImmDouble     Rational\n        | ImmConstantSum Imm Imm\n        | ImmConstantDiff Imm Imm\n        | LO Imm\n        | HI Imm\n        | HA Imm        {- high halfword adjusted -}\n        | HIGHERA Imm\n        | HIGHESTA Imm\n\n\nstrImmLit :: String -> Imm\nstrImmLit s = ImmLit (text s)\n\n\nlitToImm :: CmmLit -> Imm\nlitToImm (CmmInt i w)        = ImmInteger (narrowS w i)\n                -- narrow to the width: a CmmInt might be out of\n                -- range, but we assume that ImmInteger only contains\n                -- in-range values.  A signed value should be fine here.\nlitToImm (CmmFloat f W32)    = ImmFloat f\nlitToImm (CmmFloat f W64)    = ImmDouble f\nlitToImm (CmmLabel l)        = ImmCLbl l\nlitToImm (CmmLabelOff l off) = ImmIndex l off\nlitToImm (CmmLabelDiffOff l1 l2 off _)\n                             = ImmConstantSum\n                               (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))\n                               (ImmInt off)\nlitToImm _                   = panic \"PPC.Regs.litToImm: no match\"\n\n\n-- addressing modes ------------------------------------------------------------\n\ndata AddrMode\n        = AddrRegReg    Reg Reg\n        | AddrRegImm    Reg Imm\n\n\naddrOffset :: AddrMode -> Int -> Maybe AddrMode\naddrOffset addr off\n  = case addr of\n      AddrRegImm r (ImmInt n)\n       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))\n       | otherwise     -> Nothing\n       where n2 = n + off\n\n      AddrRegImm r (ImmInteger n)\n       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))\n       | otherwise     -> Nothing\n       where n2 = n + toInteger off\n\n      _ -> Nothing\n\n\n-- registers -------------------------------------------------------------------\n-- @spRel@ gives us a stack relative addressing mode for volatile\n-- temporaries and for excess call arguments.  @fpRel@, where\n-- applicable, is the same but for the frame pointer.\n\nspRel :: DynFlags\n      -> Int    -- desired stack offset in words, positive or negative\n      -> AddrMode\n\nspRel dflags n = AddrRegImm sp (ImmInt (n * wORD_SIZE dflags))\n\n\n-- argRegs is the set of regs which are read for an n-argument call to C.\n-- For archs which pass all args on the stack (x86), is empty.\n-- Sparc passes up to the first 6 args in regs.\nargRegs :: RegNo -> [Reg]\nargRegs 0 = []\nargRegs 1 = map regSingle [3]\nargRegs 2 = map regSingle [3,4]\nargRegs 3 = map regSingle [3..5]\nargRegs 4 = map regSingle [3..6]\nargRegs 5 = map regSingle [3..7]\nargRegs 6 = map regSingle [3..8]\nargRegs 7 = map regSingle [3..9]\nargRegs 8 = map regSingle [3..10]\nargRegs _ = panic \"MachRegs.argRegs(powerpc): don't know about >8 arguments!\"\n\n\nallArgRegs :: [Reg]\nallArgRegs = map regSingle [3..10]\n\n\n-- these are the regs which we cannot assume stay alive over a C call.\ncallClobberedRegs :: Platform -> [Reg]\ncallClobberedRegs _platform\n  = map regSingle (0:[2..12] ++ map fReg [0..13])\n\n\nallMachRegNos   :: [RegNo]\nallMachRegNos   = [0..63]\n\n\n{-# INLINE classOfRealReg      #-}\nclassOfRealReg :: RealReg -> RegClass\nclassOfRealReg (RealRegSingle i)\n        | i < 32        = RcInteger\n        | otherwise     = RcDouble\n\nclassOfRealReg (RealRegPair{})\n        = panic \"regClass(ppr): no reg pairs on this architecture\"\n\nshowReg :: RegNo -> String\nshowReg n\n    | n >= 0 && n <= 31   = \"%r\" ++ show n\n    | n >= 32 && n <= 63  = \"%f\" ++ show (n - 32)\n    | otherwise           = \"%unknown_powerpc_real_reg_\" ++ show n\n\n\n\n-- machine specific ------------------------------------------------------------\n\nallFPArgRegs :: Platform -> [Reg]\nallFPArgRegs platform\n    = case platformOS platform of\n      OSAIX    -> map (regSingle . fReg) [1..13]\n      _        -> case platformArch platform of\n        ArchPPC      -> map (regSingle . fReg) [1..8]\n        ArchPPC_64 _ -> map (regSingle . fReg) [1..13]\n        _            -> panic \"PPC.Regs.allFPArgRegs: unknown PPC Linux\"\n\nfits16Bits :: Integral a => a -> Bool\nfits16Bits x = x >= -32768 && x < 32768\n\nmakeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm\nmakeImmediate rep signed x = fmap ImmInt (toI16 rep signed)\n    where\n        narrow W64 False = fromIntegral (fromIntegral x :: Word64)\n        narrow W32 False = fromIntegral (fromIntegral x :: Word32)\n        narrow W16 False = fromIntegral (fromIntegral x :: Word16)\n        narrow W8  False = fromIntegral (fromIntegral x :: Word8)\n        narrow W64 True  = fromIntegral (fromIntegral x :: Int64)\n        narrow W32 True  = fromIntegral (fromIntegral x :: Int32)\n        narrow W16 True  = fromIntegral (fromIntegral x :: Int16)\n        narrow W8  True  = fromIntegral (fromIntegral x :: Int8)\n        narrow _   _     = panic \"PPC.Regs.narrow: no match\"\n\n        narrowed = narrow rep signed\n\n        toI16 W32 True\n            | narrowed >= -32768 && narrowed < 32768 = Just narrowed\n            | otherwise = Nothing\n        toI16 W32 False\n            | narrowed >= 0 && narrowed < 65536 = Just narrowed\n            | otherwise = Nothing\n        toI16 W64 True\n            | narrowed >= -32768 && narrowed < 32768 = Just narrowed\n            | otherwise = Nothing\n        toI16 W64 False\n            | narrowed >= 0 && narrowed < 65536 = Just narrowed\n            | otherwise = Nothing\n        toI16 _ _  = Just narrowed\n\n\n{-\nThe PowerPC has 64 registers of interest; 32 integer registers and 32 floating\npoint registers.\n-}\n\nfReg :: Int -> RegNo\nfReg x = (32 + x)\n\nr0, sp, toc, r3, r4, r11, r12, r27, r28, r30, f1, f20, f21 :: Reg\nr0      = regSingle 0\nsp      = regSingle 1\ntoc     = regSingle 2\nr3      = regSingle 3\nr4      = regSingle 4\nr11     = regSingle 11\nr12     = regSingle 12\nr27     = regSingle 27\nr28     = regSingle 28\nr30     = regSingle 30\nf1      = regSingle $ fReg 1\nf20     = regSingle $ fReg 20\nf21     = regSingle $ fReg 21\n\n-- allocatableRegs is allMachRegNos with the fixed-use regs removed.\n-- i.e., these are the regs for which we are prepared to allow the\n-- register allocator to attempt to map VRegs to.\nallocatableRegs :: Platform -> [RealReg]\nallocatableRegs platform\n   = let isFree i = freeReg platform i\n     in  map RealRegSingle $ filter isFree allMachRegNos\n\n-- temporary register for compiler use\ntmpReg :: Platform -> Reg\ntmpReg platform =\n       case platformArch platform of\n       ArchPPC      -> regSingle 13\n       ArchPPC_64 _ -> regSingle 30\n       _            -> panic \"PPC.Regs.tmpReg: unknowm arch\"\n", "num_lines": 339}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-----------------------------------------------------------------------------\n--\n-- The register liveness determinator\n--\n-- (c) The University of Glasgow 2004-2013\n--\n-----------------------------------------------------------------------------\n\nmodule RegAlloc.Liveness (\n        RegSet,\n        RegMap, emptyRegMap,\n        BlockMap, mapEmpty,\n        LiveCmmDecl,\n        InstrSR   (..),\n        LiveInstr (..),\n        Liveness (..),\n        LiveInfo (..),\n        LiveBasicBlock,\n\n        mapBlockTop,    mapBlockTopM,   mapSCCM,\n        mapGenBlockTop, mapGenBlockTopM,\n        stripLive,\n        stripLiveBlock,\n        slurpConflicts,\n        slurpReloadCoalesce,\n        eraseDeltasLive,\n        patchEraseLive,\n        patchRegsLiveInstr,\n        reverseBlocksInTops,\n        regLiveness,\n        cmmTopLiveness\n  ) where\nimport GhcPrelude\n\nimport Reg\nimport Instruction\n\nimport BlockId\nimport CFG\nimport Hoopl.Collections\nimport Hoopl.Label\nimport Cmm hiding (RegSet, emptyRegSet)\nimport PprCmm()\n\nimport Digraph\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport Platform\nimport UniqSet\nimport UniqFM\nimport UniqSupply\nimport Bag\nimport State\n\nimport Data.List\nimport Data.Maybe\nimport Data.IntSet              (IntSet)\n\n-----------------------------------------------------------------------------\ntype RegSet = UniqSet Reg\n\ntype RegMap a = UniqFM a\n\nemptyRegMap :: UniqFM a\nemptyRegMap = emptyUFM\n\nemptyRegSet :: RegSet\nemptyRegSet = emptyUniqSet\n\ntype BlockMap a = LabelMap a\n\n\n-- | A top level thing which carries liveness information.\ntype LiveCmmDecl statics instr\n        = GenCmmDecl\n                statics\n                LiveInfo\n                [SCC (LiveBasicBlock instr)]\n\n\n-- | The register allocator also wants to use SPILL/RELOAD meta instructions,\n--   so we'll keep those here.\ndata InstrSR instr\n        -- | A real machine instruction\n        = Instr  instr\n\n        -- | spill this reg to a stack slot\n        | SPILL  Reg Int\n\n        -- | reload this reg from a stack slot\n        | RELOAD Int Reg\n\ninstance Instruction instr => Instruction (InstrSR instr) where\n        regUsageOfInstr platform i\n         = case i of\n                Instr  instr    -> regUsageOfInstr platform instr\n                SPILL  reg _    -> RU [reg] []\n                RELOAD _ reg    -> RU [] [reg]\n\n        patchRegsOfInstr i f\n         = case i of\n                Instr instr     -> Instr (patchRegsOfInstr instr f)\n                SPILL  reg slot -> SPILL (f reg) slot\n                RELOAD slot reg -> RELOAD slot (f reg)\n\n        isJumpishInstr i\n         = case i of\n                Instr instr     -> isJumpishInstr instr\n                _               -> False\n\n        jumpDestsOfInstr i\n         = case i of\n                Instr instr     -> jumpDestsOfInstr instr\n                _               -> []\n\n        patchJumpInstr i f\n         = case i of\n                Instr instr     -> Instr (patchJumpInstr instr f)\n                _               -> i\n\n        mkSpillInstr            = error \"mkSpillInstr[InstrSR]: Not making SPILL meta-instr\"\n        mkLoadInstr             = error \"mkLoadInstr[InstrSR]: Not making LOAD meta-instr\"\n\n        takeDeltaInstr i\n         = case i of\n                Instr instr     -> takeDeltaInstr instr\n                _               -> Nothing\n\n        isMetaInstr i\n         = case i of\n                Instr instr     -> isMetaInstr instr\n                _               -> False\n\n        mkRegRegMoveInstr platform r1 r2\n            = Instr (mkRegRegMoveInstr platform r1 r2)\n\n        takeRegRegMoveInstr i\n         = case i of\n                Instr instr     -> takeRegRegMoveInstr instr\n                _               -> Nothing\n\n        mkJumpInstr target      = map Instr (mkJumpInstr target)\n\n        mkStackAllocInstr platform amount =\n             Instr <$> mkStackAllocInstr platform amount\n\n        mkStackDeallocInstr platform amount =\n             Instr <$> mkStackDeallocInstr platform amount\n\n\n-- | An instruction with liveness information.\ndata LiveInstr instr\n        = LiveInstr (InstrSR instr) (Maybe Liveness)\n\n-- | Liveness information.\n--   The regs which die are ones which are no longer live in the *next* instruction\n--   in this sequence.\n--   (NB. if the instruction is a jump, these registers might still be live\n--   at the jump target(s) - you have to check the liveness at the destination\n--   block to find out).\n\ndata Liveness\n        = Liveness\n        { liveBorn      :: RegSet       -- ^ registers born in this instruction (written to for first time).\n        , liveDieRead   :: RegSet       -- ^ registers that died because they were read for the last time.\n        , liveDieWrite  :: RegSet }     -- ^ registers that died because they were clobbered by something.\n\n\n-- | Stash regs live on entry to each basic block in the info part of the cmm code.\ndata LiveInfo\n        = LiveInfo\n                (LabelMap CmmStatics)     -- cmm info table static stuff\n                [BlockId]                 -- entry points (first one is the\n                                          -- entry point for the proc).\n                (BlockMap RegSet)         -- argument locals live on entry to this block\n                (BlockMap IntSet)         -- stack slots live on entry to this block\n\n\n-- | A basic block with liveness information.\ntype LiveBasicBlock instr\n        = GenBasicBlock (LiveInstr instr)\n\n\ninstance Outputable instr\n      => Outputable (InstrSR instr) where\n\n        ppr (Instr realInstr)\n           = ppr realInstr\n\n        ppr (SPILL reg slot)\n           = hcat [\n                text \"\\tSPILL\",\n                char ' ',\n                ppr reg,\n                comma,\n                text \"SLOT\" <> parens (int slot)]\n\n        ppr (RELOAD slot reg)\n           = hcat [\n                text \"\\tRELOAD\",\n                char ' ',\n                text \"SLOT\" <> parens (int slot),\n                comma,\n                ppr reg]\n\ninstance Outputable instr\n      => Outputable (LiveInstr instr) where\n\n        ppr (LiveInstr instr Nothing)\n         = ppr instr\n\n        ppr (LiveInstr instr (Just live))\n         =  ppr instr\n                $$ (nest 8\n                        $ vcat\n                        [ pprRegs (text \"# born:    \") (liveBorn live)\n                        , pprRegs (text \"# r_dying: \") (liveDieRead live)\n                        , pprRegs (text \"# w_dying: \") (liveDieWrite live) ]\n                    $+$ space)\n\n         where  pprRegs :: SDoc -> RegSet -> SDoc\n                pprRegs name regs\n                 | isEmptyUniqSet regs  = empty\n                 | otherwise            = name <>\n                     (pprUFM (getUniqSet regs) (hcat . punctuate space . map ppr))\n\ninstance Outputable LiveInfo where\n    ppr (LiveInfo mb_static entryIds liveVRegsOnEntry liveSlotsOnEntry)\n        =  (ppr mb_static)\n        $$ text \"# entryIds         = \" <> ppr entryIds\n        $$ text \"# liveVRegsOnEntry = \" <> ppr liveVRegsOnEntry\n        $$ text \"# liveSlotsOnEntry = \" <> text (show liveSlotsOnEntry)\n\n\n\n-- | map a function across all the basic blocks in this code\n--\nmapBlockTop\n        :: (LiveBasicBlock instr -> LiveBasicBlock instr)\n        -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr\n\nmapBlockTop f cmm\n        = evalState (mapBlockTopM (\\x -> return $ f x) cmm) ()\n\n\n-- | map a function across all the basic blocks in this code (monadic version)\n--\nmapBlockTopM\n        :: Monad m\n        => (LiveBasicBlock instr -> m (LiveBasicBlock instr))\n        -> LiveCmmDecl statics instr -> m (LiveCmmDecl statics instr)\n\nmapBlockTopM _ cmm@(CmmData{})\n        = return cmm\n\nmapBlockTopM f (CmmProc header label live sccs)\n = do   sccs'   <- mapM (mapSCCM f) sccs\n        return  $ CmmProc header label live sccs'\n\nmapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)\nmapSCCM f (AcyclicSCC x)\n = do   x'      <- f x\n        return  $ AcyclicSCC x'\n\nmapSCCM f (CyclicSCC xs)\n = do   xs'     <- mapM f xs\n        return  $ CyclicSCC xs'\n\n\n-- map a function across all the basic blocks in this code\nmapGenBlockTop\n        :: (GenBasicBlock             i -> GenBasicBlock            i)\n        -> (GenCmmDecl d h (ListGraph i) -> GenCmmDecl d h (ListGraph i))\n\nmapGenBlockTop f cmm\n        = evalState (mapGenBlockTopM (\\x -> return $ f x) cmm) ()\n\n\n-- | map a function across all the basic blocks in this code (monadic version)\nmapGenBlockTopM\n        :: Monad m\n        => (GenBasicBlock            i  -> m (GenBasicBlock            i))\n        -> (GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i)))\n\nmapGenBlockTopM _ cmm@(CmmData{})\n        = return cmm\n\nmapGenBlockTopM f (CmmProc header label live (ListGraph blocks))\n = do   blocks' <- mapM f blocks\n        return  $ CmmProc header label live (ListGraph blocks')\n\n\n-- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.\n--   Slurping of conflicts and moves is wrapped up together so we don't have\n--   to make two passes over the same code when we want to build the graph.\n--\nslurpConflicts\n        :: Instruction instr\n        => LiveCmmDecl statics instr\n        -> (Bag (UniqSet Reg), Bag (Reg, Reg))\n\nslurpConflicts live\n        = slurpCmm (emptyBag, emptyBag) live\n\n where  slurpCmm   rs  CmmData{}                = rs\n        slurpCmm   rs (CmmProc info _ _ sccs)\n                = foldl' (slurpSCC info) rs sccs\n\n        slurpSCC  info rs (AcyclicSCC b)\n                = slurpBlock info rs b\n\n        slurpSCC  info rs (CyclicSCC bs)\n                = foldl'  (slurpBlock info) rs bs\n\n        slurpBlock info rs (BasicBlock blockId instrs)\n                | LiveInfo _ _ blockLive _        <- info\n                , Just rsLiveEntry                <- mapLookup blockId blockLive\n                , (conflicts, moves)              <- slurpLIs rsLiveEntry rs instrs\n                = (consBag rsLiveEntry conflicts, moves)\n\n                | otherwise\n                = panic \"Liveness.slurpConflicts: bad block\"\n\n        slurpLIs rsLive (conflicts, moves) []\n                = (consBag rsLive conflicts, moves)\n\n        slurpLIs rsLive rs (LiveInstr _ Nothing     : lis)\n                = slurpLIs rsLive rs lis\n\n        slurpLIs rsLiveEntry (conflicts, moves) (LiveInstr instr (Just live) : lis)\n         = let\n                -- regs that die because they are read for the last time at the start of an instruction\n                --      are not live across it.\n                rsLiveAcross    = rsLiveEntry `minusUniqSet` (liveDieRead live)\n\n                -- regs live on entry to the next instruction.\n                --      be careful of orphans, make sure to delete dying regs _after_ unioning\n                --      in the ones that are born here.\n                rsLiveNext      = (rsLiveAcross `unionUniqSets` (liveBorn     live))\n                                                `minusUniqSet`  (liveDieWrite live)\n\n                -- orphan vregs are the ones that die in the same instruction they are born in.\n                --      these are likely to be results that are never used, but we still\n                --      need to assign a hreg to them..\n                rsOrphans       = intersectUniqSets\n                                        (liveBorn live)\n                                        (unionUniqSets (liveDieWrite live) (liveDieRead live))\n\n                --\n                rsConflicts     = unionUniqSets rsLiveNext rsOrphans\n\n          in    case takeRegRegMoveInstr instr of\n                 Just rr        -> slurpLIs rsLiveNext\n                                        ( consBag rsConflicts conflicts\n                                        , consBag rr moves) lis\n\n                 Nothing        -> slurpLIs rsLiveNext\n                                        ( consBag rsConflicts conflicts\n                                        , moves) lis\n\n\n-- | For spill\\/reloads\n--\n--   SPILL  v1, slot1\n--   ...\n--   RELOAD slot1, v2\n--\n--   If we can arrange that v1 and v2 are allocated to the same hreg it's more likely\n--   the spill\\/reload instrs can be cleaned and replaced by a nop reg-reg move.\n--\n--\nslurpReloadCoalesce\n        :: forall statics instr. Instruction instr\n        => LiveCmmDecl statics instr\n        -> Bag (Reg, Reg)\n\nslurpReloadCoalesce live\n        = slurpCmm emptyBag live\n\n where\n        slurpCmm :: Bag (Reg, Reg)\n                 -> GenCmmDecl t t1 [SCC (LiveBasicBlock instr)]\n                 -> Bag (Reg, Reg)\n        slurpCmm cs CmmData{}   = cs\n        slurpCmm cs (CmmProc _ _ _ sccs)\n                = slurpComp cs (flattenSCCs sccs)\n\n        slurpComp :: Bag (Reg, Reg)\n                     -> [LiveBasicBlock instr]\n                     -> Bag (Reg, Reg)\n        slurpComp  cs blocks\n         = let  (moveBags, _)   = runState (slurpCompM blocks) emptyUFM\n           in   unionManyBags (cs : moveBags)\n\n        slurpCompM :: [LiveBasicBlock instr]\n                   -> State (UniqFM [UniqFM Reg]) [Bag (Reg, Reg)]\n        slurpCompM blocks\n         = do   -- run the analysis once to record the mapping across jumps.\n                mapM_   (slurpBlock False) blocks\n\n                -- run it a second time while using the information from the last pass.\n                --      We /could/ run this many more times to deal with graphical control\n                --      flow and propagating info across multiple jumps, but it's probably\n                --      not worth the trouble.\n                mapM    (slurpBlock True) blocks\n\n        slurpBlock :: Bool -> LiveBasicBlock instr\n                   -> State (UniqFM [UniqFM Reg]) (Bag (Reg, Reg))\n        slurpBlock propagate (BasicBlock blockId instrs)\n         = do   -- grab the slot map for entry to this block\n                slotMap         <- if propagate\n                                        then getSlotMap blockId\n                                        else return emptyUFM\n\n                (_, mMoves)     <- mapAccumLM slurpLI slotMap instrs\n                return $ listToBag $ catMaybes mMoves\n\n        slurpLI :: UniqFM Reg                           -- current slotMap\n                -> LiveInstr instr\n                -> State (UniqFM [UniqFM Reg])          -- blockId -> [slot -> reg]\n                                                        --      for tracking slotMaps across jumps\n\n                         ( UniqFM Reg                   -- new slotMap\n                         , Maybe (Reg, Reg))            -- maybe a new coalesce edge\n\n        slurpLI slotMap li\n\n                -- remember what reg was stored into the slot\n                | LiveInstr (SPILL reg slot) _  <- li\n                , slotMap'                      <- addToUFM slotMap slot reg\n                = return (slotMap', Nothing)\n\n                -- add an edge between the this reg and the last one stored into the slot\n                | LiveInstr (RELOAD slot reg) _ <- li\n                = case lookupUFM slotMap slot of\n                        Just reg2\n                         | reg /= reg2  -> return (slotMap, Just (reg, reg2))\n                         | otherwise    -> return (slotMap, Nothing)\n\n                        Nothing         -> return (slotMap, Nothing)\n\n                -- if we hit a jump, remember the current slotMap\n                | LiveInstr (Instr instr) _     <- li\n                , targets                       <- jumpDestsOfInstr instr\n                , not $ null targets\n                = do    mapM_   (accSlotMap slotMap) targets\n                        return  (slotMap, Nothing)\n\n                | otherwise\n                = return (slotMap, Nothing)\n\n        -- record a slotmap for an in edge to this block\n        accSlotMap slotMap blockId\n                = modify (\\s -> addToUFM_C (++) s blockId [slotMap])\n\n        -- work out the slot map on entry to this block\n        --      if we have slot maps for multiple in-edges then we need to merge them.\n        getSlotMap blockId\n         = do   map             <- get\n                let slotMaps    = fromMaybe [] (lookupUFM map blockId)\n                return          $ foldr mergeSlotMaps emptyUFM slotMaps\n\n        mergeSlotMaps :: UniqFM Reg -> UniqFM Reg -> UniqFM Reg\n        mergeSlotMaps map1 map2\n                = listToUFM\n                $ [ (k, r1)\n                  | (k, r1) <- nonDetUFMToList map1\n                  -- This is non-deterministic but we do not\n                  -- currently support deterministic code-generation.\n                  -- See Note [Unique Determinism and code generation]\n                  , case lookupUFM map2 k of\n                          Nothing -> False\n                          Just r2 -> r1 == r2 ]\n\n\n-- | Strip away liveness information, yielding NatCmmDecl\nstripLive\n        :: (Outputable statics, Outputable instr, Instruction instr)\n        => DynFlags\n        -> LiveCmmDecl statics instr\n        -> NatCmmDecl statics instr\n\nstripLive dflags live\n        = stripCmm live\n\n where  stripCmm :: (Outputable statics, Outputable instr, Instruction instr)\n                 => LiveCmmDecl statics instr -> NatCmmDecl statics instr\n        stripCmm (CmmData sec ds)       = CmmData sec ds\n        stripCmm (CmmProc (LiveInfo info (first_id:_) _ _) label live sccs)\n         = let  final_blocks    = flattenSCCs sccs\n\n                -- make sure the block that was first in the input list\n                --      stays at the front of the output. This is the entry point\n                --      of the proc, and it needs to come first.\n                ((first':_), rest')\n                                = partition ((== first_id) . blockId) final_blocks\n\n           in   CmmProc info label live\n                          (ListGraph $ map (stripLiveBlock dflags) $ first' : rest')\n\n        -- If the proc has blocks but we don't know what the first one was, then we're dead.\n        stripCmm proc\n                 = pprPanic \"RegAlloc.Liveness.stripLive: no first_id on proc\" (ppr proc)\n\n-- | Strip away liveness information from a basic block,\n--   and make real spill instructions out of SPILL, RELOAD pseudos along the way.\n\nstripLiveBlock\n        :: Instruction instr\n        => DynFlags\n        -> LiveBasicBlock instr\n        -> NatBasicBlock instr\n\nstripLiveBlock dflags (BasicBlock i lis)\n =      BasicBlock i instrs'\n\n where  (instrs', _)\n                = runState (spillNat [] lis) 0\n\n        spillNat acc []\n         =      return (reverse acc)\n\n        spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)\n         = do   delta   <- get\n                spillNat (mkSpillInstr dflags reg delta slot : acc) instrs\n\n        spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)\n         = do   delta   <- get\n                spillNat (mkLoadInstr dflags reg delta slot : acc) instrs\n\n        spillNat acc (LiveInstr (Instr instr) _ : instrs)\n         | Just i <- takeDeltaInstr instr\n         = do   put i\n                spillNat acc instrs\n\n        spillNat acc (LiveInstr (Instr instr) _ : instrs)\n         =      spillNat (instr : acc) instrs\n\n\n-- | Erase Delta instructions.\n\neraseDeltasLive\n        :: Instruction instr\n        => LiveCmmDecl statics instr\n        -> LiveCmmDecl statics instr\n\neraseDeltasLive cmm\n        = mapBlockTop eraseBlock cmm\n where\n        eraseBlock (BasicBlock id lis)\n                = BasicBlock id\n                $ filter (\\(LiveInstr i _) -> not $ isJust $ takeDeltaInstr i)\n                $ lis\n\n\n-- | Patch the registers in this code according to this register mapping.\n--   also erase reg -> reg moves when the reg is the same.\n--   also erase reg -> reg moves when the destination dies in this instr.\npatchEraseLive\n        :: Instruction instr\n        => (Reg -> Reg)\n        -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr\n\npatchEraseLive patchF cmm\n        = patchCmm cmm\n where\n        patchCmm cmm@CmmData{}  = cmm\n\n        patchCmm (CmmProc info label live sccs)\n         | LiveInfo static id blockMap mLiveSlots <- info\n         = let\n                patchRegSet set = mkUniqSet $ map patchF $ nonDetEltsUFM set\n                  -- See Note [Unique Determinism and code generation]\n                blockMap'       = mapMap (patchRegSet . getUniqSet) blockMap\n\n                info'           = LiveInfo static id blockMap' mLiveSlots\n           in   CmmProc info' label live $ map patchSCC sccs\n\n        patchSCC (AcyclicSCC b)  = AcyclicSCC (patchBlock b)\n        patchSCC (CyclicSCC  bs) = CyclicSCC  (map patchBlock bs)\n\n        patchBlock (BasicBlock id lis)\n                = BasicBlock id $ patchInstrs lis\n\n        patchInstrs []          = []\n        patchInstrs (li : lis)\n\n                | LiveInstr i (Just live)       <- li'\n                , Just (r1, r2) <- takeRegRegMoveInstr i\n                , eatMe r1 r2 live\n                = patchInstrs lis\n\n                | otherwise\n                = li' : patchInstrs lis\n\n                where   li'     = patchRegsLiveInstr patchF li\n\n        eatMe   r1 r2 live\n                -- source and destination regs are the same\n                | r1 == r2      = True\n\n                -- destination reg is never used\n                | elementOfUniqSet r2 (liveBorn live)\n                , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live)\n                = True\n\n                | otherwise     = False\n\n\n-- | Patch registers in this LiveInstr, including the liveness information.\n--\npatchRegsLiveInstr\n        :: Instruction instr\n        => (Reg -> Reg)\n        -> LiveInstr instr -> LiveInstr instr\n\npatchRegsLiveInstr patchF li\n = case li of\n        LiveInstr instr Nothing\n         -> LiveInstr (patchRegsOfInstr instr patchF) Nothing\n\n        LiveInstr instr (Just live)\n         -> LiveInstr\n                (patchRegsOfInstr instr patchF)\n                (Just live\n                        { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg\n                          liveBorn      = mapUniqSet patchF $ liveBorn live\n                        , liveDieRead   = mapUniqSet patchF $ liveDieRead live\n                        , liveDieWrite  = mapUniqSet patchF $ liveDieWrite live })\n                          -- See Note [Unique Determinism and code generation]\n\n\n--------------------------------------------------------------------------------\n-- | Convert a NatCmmDecl to a LiveCmmDecl, with liveness information\n\ncmmTopLiveness\n        :: (Outputable instr, Instruction instr)\n        => Maybe CFG -> Platform\n        -> NatCmmDecl statics instr\n        -> UniqSM (LiveCmmDecl statics instr)\ncmmTopLiveness cfg platform cmm\n        = regLiveness platform $ natCmmTopToLive cfg cmm\n\nnatCmmTopToLive\n        :: (Instruction instr, Outputable instr)\n        => Maybe CFG -> NatCmmDecl statics instr\n        -> LiveCmmDecl statics instr\n\nnatCmmTopToLive _ (CmmData i d)\n        = CmmData i d\n\nnatCmmTopToLive _ (CmmProc info lbl live (ListGraph []))\n        = CmmProc (LiveInfo info [] mapEmpty mapEmpty) lbl live []\n\nnatCmmTopToLive mCfg proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))\n        = CmmProc (LiveInfo info' (first_id : entry_ids) mapEmpty mapEmpty)\n                lbl live sccsLive\n   where\n        first_id        = blockId first\n        all_entry_ids   = entryBlocks proc\n        sccs            = sccBlocks blocks all_entry_ids mCfg\n        sccsLive        = map (fmap (\\(BasicBlock l instrs) ->\n                                       BasicBlock l (map (\\i -> LiveInstr (Instr i) Nothing) instrs)))\n                        $ sccs\n\n        entry_ids       = filter (reachable_node) .\n                          filter (/= first_id) $ all_entry_ids\n        info'           = mapFilterWithKey (\\node _ -> reachable_node node) info\n        reachable_node\n          | Just cfg <- mCfg\n          = hasNode cfg\n          | otherwise\n          = const True\n\n--\n-- Compute the liveness graph of the set of basic blocks.  Important:\n-- we also discard any unreachable code here, starting from the entry\n-- points (the first block in the list, and any blocks with info\n-- tables).  Unreachable code arises when code blocks are orphaned in\n-- earlier optimisation passes, and may confuse the register allocator\n-- by referring to registers that are not initialised.  It's easy to\n-- discard the unreachable code as part of the SCC pass, so that's\n-- exactly what we do. (#7574)\n--\nsccBlocks\n        :: forall instr . Instruction instr\n        => [NatBasicBlock instr]\n        -> [BlockId]\n        -> Maybe CFG\n        -> [SCC (NatBasicBlock instr)]\n\nsccBlocks blocks entries mcfg = map (fmap node_payload) sccs\n  where\n        nodes :: [ Node BlockId (NatBasicBlock instr) ]\n        nodes = [ DigraphNode block id (getOutEdges instrs)\n                | block@(BasicBlock id instrs) <- blocks ]\n\n        g1 = graphFromEdgedVerticesUniq nodes\n\n        reachable :: LabelSet\n        reachable\n            | Just cfg <- mcfg\n            -- Our CFG only contains reachable nodes by construction.\n            = getCfgNodes cfg\n            | otherwise\n            = setFromList $ [ node_key node | node <- reachablesG g1 roots ]\n\n        g2 = graphFromEdgedVerticesUniq [ node | node <- nodes\n                                               , node_key node\n                                                  `setMember` reachable ]\n\n        sccs = stronglyConnCompG g2\n\n        getOutEdges :: Instruction instr => [instr] -> [BlockId]\n        getOutEdges instrs = concat $ map jumpDestsOfInstr instrs\n\n        -- This is truly ugly, but I don't see a good alternative.\n        -- Digraph just has the wrong API.  We want to identify nodes\n        -- by their keys (BlockId), but Digraph requires the whole\n        -- node: (NatBasicBlock, BlockId, [BlockId]).  This takes\n        -- advantage of the fact that Digraph only looks at the key,\n        -- even though it asks for the whole triple.\n        roots = [DigraphNode (panic \"sccBlocks\") b (panic \"sccBlocks\")\n                | b <- entries ]\n\n--------------------------------------------------------------------------------\n-- Annotate code with register liveness information\n--\n\nregLiveness\n        :: (Outputable instr, Instruction instr)\n        => Platform\n        -> LiveCmmDecl statics instr\n        -> UniqSM (LiveCmmDecl statics instr)\n\nregLiveness _ (CmmData i d)\n        = return $ CmmData i d\n\nregLiveness _ (CmmProc info lbl live [])\n        | LiveInfo static mFirst _ _    <- info\n        = return $ CmmProc\n                        (LiveInfo static mFirst mapEmpty mapEmpty)\n                        lbl live []\n\nregLiveness platform (CmmProc info lbl live sccs)\n        | LiveInfo static mFirst _ liveSlotsOnEntry     <- info\n        = let   (ann_sccs, block_live)  = computeLiveness platform sccs\n\n          in    return $ CmmProc (LiveInfo static mFirst block_live liveSlotsOnEntry)\n                           lbl live ann_sccs\n\n\n-- -----------------------------------------------------------------------------\n-- | Check ordering of Blocks\n--   The computeLiveness function requires SCCs to be in reverse\n--   dependent order.  If they're not the liveness information will be\n--   wrong, and we'll get a bad allocation.  Better to check for this\n--   precondition explicitly or some other poor sucker will waste a\n--   day staring at bad assembly code..\n--\ncheckIsReverseDependent\n        :: Instruction instr\n        => [SCC (LiveBasicBlock instr)]         -- ^ SCCs of blocks that we're about to run the liveness determinator on.\n        -> Maybe BlockId                        -- ^ BlockIds that fail the test (if any)\n\ncheckIsReverseDependent sccs'\n = go emptyUniqSet sccs'\n\n where  go _ []\n         = Nothing\n\n        go blocksSeen (AcyclicSCC block : sccs)\n         = let  dests           = slurpJumpDestsOfBlock block\n                blocksSeen'     = unionUniqSets blocksSeen $ mkUniqSet [blockId block]\n                badDests        = dests `minusUniqSet` blocksSeen'\n           in   case nonDetEltsUniqSet badDests of\n                 -- See Note [Unique Determinism and code generation]\n                 []             -> go blocksSeen' sccs\n                 bad : _        -> Just bad\n\n        go blocksSeen (CyclicSCC blocks : sccs)\n         = let  dests           = unionManyUniqSets $ map slurpJumpDestsOfBlock blocks\n                blocksSeen'     = unionUniqSets blocksSeen $ mkUniqSet $ map blockId blocks\n                badDests        = dests `minusUniqSet` blocksSeen'\n           in   case nonDetEltsUniqSet badDests of\n                 -- See Note [Unique Determinism and code generation]\n                 []             -> go blocksSeen' sccs\n                 bad : _        -> Just bad\n\n        slurpJumpDestsOfBlock (BasicBlock _ instrs)\n                = unionManyUniqSets\n                $ map (mkUniqSet . jumpDestsOfInstr)\n                        [ i | LiveInstr i _ <- instrs]\n\n\n-- | If we've compute liveness info for this code already we have to reverse\n--   the SCCs in each top to get them back to the right order so we can do it again.\nreverseBlocksInTops :: LiveCmmDecl statics instr -> LiveCmmDecl statics instr\nreverseBlocksInTops top\n = case top of\n        CmmData{}                       -> top\n        CmmProc info lbl live sccs      -> CmmProc info lbl live (reverse sccs)\n\n\n-- | Computing liveness\n--\n--  On entry, the SCCs must be in \"reverse\" order: later blocks may transfer\n--  control to earlier ones only, else `panic`.\n--\n--  The SCCs returned are in the *opposite* order, which is exactly what we\n--  want for the next pass.\n--\ncomputeLiveness\n        :: (Outputable instr, Instruction instr)\n        => Platform\n        -> [SCC (LiveBasicBlock instr)]\n        -> ([SCC (LiveBasicBlock instr)],       -- instructions annotated with list of registers\n                                                -- which are \"dead after this instruction\".\n               BlockMap RegSet)                 -- blocks annotated with set of live registers\n                                                -- on entry to the block.\n\ncomputeLiveness platform sccs\n = case checkIsReverseDependent sccs of\n        Nothing         -> livenessSCCs platform mapEmpty [] sccs\n        Just bad        -> pprPanic \"RegAlloc.Liveness.computeLiveness\"\n                                (vcat   [ text \"SCCs aren't in reverse dependent order\"\n                                        , text \"bad blockId\" <+> ppr bad\n                                        , ppr sccs])\n\nlivenessSCCs\n       :: Instruction instr\n       => Platform\n       -> BlockMap RegSet\n       -> [SCC (LiveBasicBlock instr)]          -- accum\n       -> [SCC (LiveBasicBlock instr)]\n       -> ( [SCC (LiveBasicBlock instr)]\n          , BlockMap RegSet)\n\nlivenessSCCs _ blockmap done []\n        = (done, blockmap)\n\nlivenessSCCs platform blockmap done (AcyclicSCC block : sccs)\n = let  (blockmap', block')     = livenessBlock platform blockmap block\n   in   livenessSCCs platform blockmap' (AcyclicSCC block' : done) sccs\n\nlivenessSCCs platform blockmap done\n        (CyclicSCC blocks : sccs) =\n        livenessSCCs platform blockmap' (CyclicSCC blocks':done) sccs\n where      (blockmap', blocks')\n                = iterateUntilUnchanged linearLiveness equalBlockMaps\n                                      blockmap blocks\n\n            iterateUntilUnchanged\n                :: (a -> b -> (a,c)) -> (a -> a -> Bool)\n                -> a -> b\n                -> (a,c)\n\n            iterateUntilUnchanged f eq a b\n                = head $\n                  concatMap tail $\n                  groupBy (\\(a1, _) (a2, _) -> eq a1 a2) $\n                  iterate (\\(a, _) -> f a b) $\n                  (a, panic \"RegLiveness.livenessSCCs\")\n\n\n            linearLiveness\n                :: Instruction instr\n                => BlockMap RegSet -> [LiveBasicBlock instr]\n                -> (BlockMap RegSet, [LiveBasicBlock instr])\n\n            linearLiveness = mapAccumL (livenessBlock platform)\n\n                -- probably the least efficient way to compare two\n                -- BlockMaps for equality.\n            equalBlockMaps a b\n                = a' == b'\n              where a' = map f $ mapToList a\n                    b' = map f $ mapToList b\n                    f (key,elt) = (key, nonDetEltsUniqSet elt)\n                    -- See Note [Unique Determinism and code generation]\n\n\n\n-- | Annotate a basic block with register liveness information.\n--\nlivenessBlock\n        :: Instruction instr\n        => Platform\n        -> BlockMap RegSet\n        -> LiveBasicBlock instr\n        -> (BlockMap RegSet, LiveBasicBlock instr)\n\nlivenessBlock platform blockmap (BasicBlock block_id instrs)\n = let\n        (regsLiveOnEntry, instrs1)\n            = livenessBack platform emptyUniqSet blockmap [] (reverse instrs)\n        blockmap'       = mapInsert block_id regsLiveOnEntry blockmap\n\n        instrs2         = livenessForward platform regsLiveOnEntry instrs1\n\n        output          = BasicBlock block_id instrs2\n\n   in   ( blockmap', output)\n\n-- | Calculate liveness going forwards,\n--   filling in when regs are born\n\nlivenessForward\n        :: Instruction instr\n        => Platform\n        -> RegSet                       -- regs live on this instr\n        -> [LiveInstr instr] -> [LiveInstr instr]\n\nlivenessForward _        _           []  = []\nlivenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis)\n        | Just live <- mLive\n        = let\n                RU _ written  = regUsageOfInstr platform instr\n                -- Regs that are written to but weren't live on entry to this instruction\n                --      are recorded as being born here.\n                rsBorn          = mkUniqSet\n                                $ filter (\\r -> not $ elementOfUniqSet r rsLiveEntry) written\n\n                rsLiveNext      = (rsLiveEntry `unionUniqSets` rsBorn)\n                                        `minusUniqSet` (liveDieRead live)\n                                        `minusUniqSet` (liveDieWrite live)\n\n        in LiveInstr instr (Just live { liveBorn = rsBorn })\n                : livenessForward platform rsLiveNext lis\n\n        | otherwise\n        = li : livenessForward platform rsLiveEntry lis\n\n\n-- | Calculate liveness going backwards,\n--   filling in when regs die, and what regs are live across each instruction\n\nlivenessBack\n        :: Instruction instr\n        => Platform\n        -> RegSet                       -- regs live on this instr\n        -> BlockMap RegSet              -- regs live on entry to other BBs\n        -> [LiveInstr instr]            -- instructions (accum)\n        -> [LiveInstr instr]            -- instructions\n        -> (RegSet, [LiveInstr instr])\n\nlivenessBack _        liveregs _        done []  = (liveregs, done)\n\nlivenessBack platform liveregs blockmap acc (instr : instrs)\n = let  (liveregs', instr')     = liveness1 platform liveregs blockmap instr\n   in   livenessBack platform liveregs' blockmap (instr' : acc) instrs\n\n\n-- don't bother tagging comments or deltas with liveness\nliveness1\n        :: Instruction instr\n        => Platform\n        -> RegSet\n        -> BlockMap RegSet\n        -> LiveInstr instr\n        -> (RegSet, LiveInstr instr)\n\nliveness1 _ liveregs _ (LiveInstr instr _)\n        | isMetaInstr instr\n        = (liveregs, LiveInstr instr Nothing)\n\nliveness1 platform liveregs blockmap (LiveInstr instr _)\n\n        | not_a_branch\n        = (liveregs1, LiveInstr instr\n                        (Just $ Liveness\n                        { liveBorn      = emptyUniqSet\n                        , liveDieRead   = mkUniqSet r_dying\n                        , liveDieWrite  = mkUniqSet w_dying }))\n\n        | otherwise\n        = (liveregs_br, LiveInstr instr\n                        (Just $ Liveness\n                        { liveBorn      = emptyUniqSet\n                        , liveDieRead   = mkUniqSet r_dying_br\n                        , liveDieWrite  = mkUniqSet w_dying }))\n\n        where\n            !(RU read written) = regUsageOfInstr platform instr\n\n            -- registers that were written here are dead going backwards.\n            -- registers that were read here are live going backwards.\n            liveregs1   = (liveregs `delListFromUniqSet` written)\n                                    `addListToUniqSet` read\n\n            -- registers that are not live beyond this point, are recorded\n            --  as dying here.\n            r_dying     = [ reg | reg <- read, reg `notElem` written,\n                              not (elementOfUniqSet reg liveregs) ]\n\n            w_dying     = [ reg | reg <- written,\n                             not (elementOfUniqSet reg liveregs) ]\n\n            -- union in the live regs from all the jump destinations of this\n            -- instruction.\n            targets      = jumpDestsOfInstr instr -- where we go from here\n            not_a_branch = null targets\n\n            targetLiveRegs target\n                  = case mapLookup target blockmap of\n                                Just ra -> ra\n                                Nothing -> emptyRegSet\n\n            live_from_branch = unionManyUniqSets (map targetLiveRegs targets)\n\n            liveregs_br = liveregs1 `unionUniqSets` live_from_branch\n\n            -- registers that are live only in the branch targets should\n            -- be listed as dying here.\n            live_branch_only = live_from_branch `minusUniqSet` liveregs\n            r_dying_br  = nonDetEltsUniqSet (mkUniqSet r_dying `unionUniqSets`\n                                             live_branch_only)\n                          -- See Note [Unique Determinism and code generation]\n", "num_lines": 1025}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Utils for calculating general worst, bound, squeese and free, functions.\n--\n--   as per: \"A Generalized Algorithm for Graph-Coloring Register Allocation\"\n--           Michael Smith, Normal Ramsey, Glenn Holloway.\n--           PLDI 2004\n--\n--   These general versions are not used in GHC proper because they are too slow.\n--   Instead, hand written optimised versions are provided for each architecture\n--   in MachRegs*.hs\n--\n--   This code is here because we can test the architecture specific code against\n--   it.\n--\nmodule RegAlloc.Graph.ArchBase (\n        RegClass(..),\n        Reg(..),\n        RegSub(..),\n\n        worst,\n        bound,\n        squeese\n) where\nimport GhcPrelude\n\nimport UniqSet\nimport UniqFM\nimport Unique\n\n\n-- Some basic register classes.\n--      These aren't necessarily in 1-to-1 correspondence with the allocatable\n--      RegClasses in MachRegs.hs\ndata RegClass\n        -- general purpose regs\n        = ClassG32      -- 32 bit GPRs\n        | ClassG16      -- 16 bit GPRs\n        | ClassG8       -- 8  bit GPRs\n\n        -- floating point regs\n        | ClassF64      -- 64 bit FPRs\n        deriving (Show, Eq, Enum)\n\n\n-- | A register of some class\ndata Reg\n        -- a register of some class\n        = Reg RegClass Int\n\n        -- a sub-component of one of the other regs\n        | RegSub RegSub Reg\n        deriving (Show, Eq)\n\n\n-- | so we can put regs in UniqSets\ninstance Uniquable Reg where\n        getUnique (Reg c i)\n         = mkRegSingleUnique\n         $ fromEnum c * 1000 + i\n\n        getUnique (RegSub s (Reg c i))\n         = mkRegSubUnique\n         $ fromEnum s * 10000 + fromEnum c * 1000 + i\n\n        getUnique (RegSub _ (RegSub _ _))\n          = error \"RegArchBase.getUnique: can't have a sub-reg of a sub-reg.\"\n\n\n-- | A subcomponent of another register\ndata RegSub\n        = SubL16        -- lowest 16 bits\n        | SubL8         -- lowest  8 bits\n        | SubL8H        -- second lowest 8 bits\n        deriving (Show, Enum, Ord, Eq)\n\n\n-- | Worst case displacement\n--\n--      a node N of classN has some number of neighbors,\n--      all of which are from classC.\n--\n--      (worst neighbors classN classC) is the maximum number of potential\n--      colors for N that can be lost by coloring its neighbors.\n--\n-- This should be hand coded/cached for each particular architecture,\n--      because the compute time is very long..\nworst   :: (RegClass    -> UniqSet Reg)\n        -> (Reg         -> UniqSet Reg)\n        -> Int -> RegClass -> RegClass -> Int\n\nworst regsOfClass regAlias neighbors classN classC\n = let  regAliasS regs  = unionManyUniqSets\n                        $ map regAlias\n                        $ nonDetEltsUniqSet regs\n                        -- This is non-deterministic but we do not\n                        -- currently support deterministic code-generation.\n                        -- See Note [Unique Determinism and code generation]\n\n        -- all the regs in classes N, C\n        regsN           = regsOfClass classN\n        regsC           = regsOfClass classC\n\n        -- all the possible subsets of c which have size < m\n        regsS           = filter (\\s -> sizeUniqSet s >= 1\n                                     && sizeUniqSet s <= neighbors)\n                        $ powersetLS regsC\n\n        -- for each of the subsets of C, the regs which conflict\n        -- with posiblities for N\n        regsS_conflict\n                = map (\\s -> intersectUniqSets regsN (regAliasS s)) regsS\n\n  in    maximum $ map sizeUniqSet $ regsS_conflict\n\n\n-- | For a node N of classN and neighbors of classesC\n--      (bound classN classesC) is the maximum number of potential\n--      colors for N that can be lost by coloring its neighbors.\nbound   :: (RegClass    -> UniqSet Reg)\n        -> (Reg         -> UniqSet Reg)\n        -> RegClass -> [RegClass] -> Int\n\nbound regsOfClass regAlias classN classesC\n = let  regAliasS regs  = unionManyUniqSets\n                        $ map regAlias\n                        $ nonDetEltsUFM regs\n                        -- See Note [Unique Determinism and code generation]\n\n        regsC_aliases\n                = unionManyUniqSets\n                $ map (regAliasS . getUniqSet . regsOfClass) classesC\n\n        overlap = intersectUniqSets (regsOfClass classN) regsC_aliases\n\n   in   sizeUniqSet overlap\n\n\n-- | The total squeese on a particular node with a list of neighbors.\n--\n--   A version of this should be constructed for each particular architecture,\n--   possibly including uses of bound, so that alised registers don't get\n--   counted twice, as per the paper.\nsqueese :: (RegClass    -> UniqSet Reg)\n        -> (Reg         -> UniqSet Reg)\n        -> RegClass -> [(Int, RegClass)] -> Int\n\nsqueese regsOfClass regAlias classN countCs\n        = sum\n        $ map (\\(i, classC) -> worst regsOfClass regAlias i classN classC)\n        $ countCs\n\n\n-- | powerset (for lists)\npowersetL :: [a] -> [[a]]\npowersetL       = map concat . mapM (\\x -> [[],[x]])\n\n\n-- | powersetLS (list of sets)\npowersetLS :: Uniquable a => UniqSet a -> [UniqSet a]\npowersetLS s    = map mkUniqSet $ powersetL $ nonDetEltsUniqSet s\n  -- See Note [Unique Determinism and code generation]\n", "num_lines": 162}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | A description of the register set of the X86.\n--\n--   This isn't used directly in GHC proper.\n--\n--   See RegArchBase.hs for the reference.\n--   See MachRegs.hs for the actual trivColorable function used in GHC.\n--\nmodule RegAlloc.Graph.ArchX86 (\n        classOfReg,\n        regsOfClass,\n        regName,\n        regAlias,\n        worst,\n        squeese,\n) where\n\nimport GhcPrelude\n\nimport RegAlloc.Graph.ArchBase  (Reg(..), RegSub(..), RegClass(..))\nimport UniqSet\n\nimport qualified Data.Array as A\n\n\n-- | Determine the class of a register\nclassOfReg :: Reg -> RegClass\nclassOfReg reg\n = case reg of\n        Reg c _         -> c\n\n        RegSub SubL16 _ -> ClassG16\n        RegSub SubL8  _ -> ClassG8\n        RegSub SubL8H _ -> ClassG8\n\n\n-- | Determine all the regs that make up a certain class.\nregsOfClass :: RegClass -> UniqSet Reg\nregsOfClass c\n = case c of\n        ClassG32\n         -> mkUniqSet   [ Reg ClassG32  i\n                        | i <- [0..7] ]\n\n        ClassG16\n         -> mkUniqSet   [ RegSub SubL16 (Reg ClassG32 i)\n                        | i <- [0..7] ]\n\n        ClassG8\n         -> unionUniqSets\n                (mkUniqSet [ RegSub SubL8  (Reg ClassG32 i) | i <- [0..3] ])\n                (mkUniqSet [ RegSub SubL8H (Reg ClassG32 i) | i <- [0..3] ])\n\n        ClassF64\n         -> mkUniqSet   [ Reg ClassF64  i\n                        | i <- [0..5] ]\n\n\n-- | Determine the common name of a reg\n--      returns Nothing if this reg is not part of the machine.\nregName :: Reg -> Maybe String\nregName reg\n = case reg of\n        Reg ClassG32 i\n         | i <= 7 ->\n           let names = A.listArray (0,8)\n                       [ \"eax\", \"ebx\", \"ecx\", \"edx\"\n                       , \"ebp\", \"esi\", \"edi\", \"esp\" ]\n           in Just $ names A.! i\n\n        RegSub SubL16 (Reg ClassG32 i)\n         | i <= 7 ->\n           let names = A.listArray (0,8)\n                       [ \"ax\", \"bx\", \"cx\", \"dx\"\n                       , \"bp\", \"si\", \"di\", \"sp\"]\n           in Just $ names A.! i\n\n        RegSub SubL8  (Reg ClassG32 i)\n         | i <= 3 ->\n           let names = A.listArray (0,4) [ \"al\", \"bl\", \"cl\", \"dl\"]\n           in Just $ names A.! i\n\n        RegSub SubL8H (Reg ClassG32 i)\n         | i <= 3 ->\n           let names = A.listArray (0,4) [ \"ah\", \"bh\", \"ch\", \"dh\"]\n           in Just $ names A.! i\n\n        _         -> Nothing\n\n\n-- | Which regs alias what other regs.\nregAlias :: Reg -> UniqSet Reg\nregAlias reg\n = case reg of\n\n        -- 32 bit regs alias all of the subregs\n        Reg ClassG32 i\n\n         -- for eax, ebx, ecx, eds\n         |  i <= 3\n         -> mkUniqSet\n         $ [ Reg ClassG32 i,   RegSub SubL16 reg\n           , RegSub SubL8 reg, RegSub SubL8H reg ]\n\n         -- for esi, edi, esp, ebp\n         | 4 <= i && i <= 7\n         -> mkUniqSet\n         $ [ Reg ClassG32 i,   RegSub SubL16 reg ]\n\n        -- 16 bit subregs alias the whole reg\n        RegSub SubL16 r@(Reg ClassG32 _)\n         ->     regAlias r\n\n        -- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg\n        RegSub SubL8  r@(Reg ClassG32 _)\n         -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8 r ]\n\n        RegSub SubL8H r@(Reg ClassG32 _)\n         -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8H r ]\n\n        -- fp\n        Reg ClassF64 _\n         -> unitUniqSet reg\n\n        _ -> error \"regAlias: invalid register\"\n\n\n-- | Optimised versions of RegColorBase.{worst, squeese} specific to x86\nworst :: Int -> RegClass -> RegClass -> Int\nworst n classN classC\n = case classN of\n        ClassG32\n         -> case classC of\n                ClassG32        -> min n 8\n                ClassG16        -> min n 8\n                ClassG8         -> min n 4\n                ClassF64        -> 0\n\n        ClassG16\n         -> case classC of\n                ClassG32        -> min n 8\n                ClassG16        -> min n 8\n                ClassG8         -> min n 4\n                ClassF64        -> 0\n\n        ClassG8\n         -> case classC of\n                ClassG32        -> min (n*2) 8\n                ClassG16        -> min (n*2) 8\n                ClassG8         -> min n 8\n                ClassF64        -> 0\n\n        ClassF64\n         -> case classC of\n                ClassF64        -> min n 6\n                _               -> 0\n\nsqueese :: RegClass -> [(Int, RegClass)] -> Int\nsqueese classN countCs\n        = sum (map (\\(i, classC) -> worst i classN classC) countCs)\n\n", "num_lines": 162}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Register coalescing.\nmodule RegAlloc.Graph.Coalesce (\n        regCoalesce,\n        slurpJoinMovs\n) where\nimport GhcPrelude\n\nimport RegAlloc.Liveness\nimport Instruction\nimport Reg\n\nimport Cmm\nimport Bag\nimport Digraph\nimport UniqFM\nimport UniqSet\nimport UniqSupply\n\n\n-- | Do register coalescing on this top level thing\n--\n--   For Reg -> Reg moves, if the first reg dies at the same time the\n--   second reg is born then the mov only serves to join live ranges.\n--   The two regs can be renamed to be the same and the move instruction\n--   safely erased.\nregCoalesce\n        :: Instruction instr\n        => [LiveCmmDecl statics instr]\n        -> UniqSM [LiveCmmDecl statics instr]\n\nregCoalesce code\n = do\n        let joins       = foldl' unionBags emptyBag\n                        $ map slurpJoinMovs code\n\n        let alloc       = foldl' buildAlloc emptyUFM\n                        $ bagToList joins\n\n        let patched     = map (patchEraseLive (sinkReg alloc)) code\n\n        return patched\n\n\n-- | Add a v1 = v2 register renaming to the map.\n--   The register with the lowest lexical name is set as the\n--   canonical version.\nbuildAlloc :: UniqFM Reg -> (Reg, Reg) -> UniqFM Reg\nbuildAlloc fm (r1, r2)\n = let  rmin    = min r1 r2\n        rmax    = max r1 r2\n   in   addToUFM fm rmax rmin\n\n\n-- | Determine the canonical name for a register by following\n--   v1 = v2 renamings in this map.\nsinkReg :: UniqFM Reg -> Reg -> Reg\nsinkReg fm r\n = case lookupUFM fm r of\n        Nothing -> r\n        Just r' -> sinkReg fm r'\n\n\n-- | Slurp out mov instructions that only serve to join live ranges.\n--\n--   During a mov, if the source reg dies and the destination reg is\n--   born then we can rename the two regs to the same thing and\n--   eliminate the move.\nslurpJoinMovs\n        :: Instruction instr\n        => LiveCmmDecl statics instr\n        -> Bag (Reg, Reg)\n\nslurpJoinMovs live\n        = slurpCmm emptyBag live\n where\n        slurpCmm   rs  CmmData{}\n         = rs\n\n        slurpCmm   rs (CmmProc _ _ _ sccs)\n         = foldl' slurpBlock rs (flattenSCCs sccs)\n\n        slurpBlock rs (BasicBlock _ instrs)\n         = foldl' slurpLI    rs instrs\n\n        slurpLI    rs (LiveInstr _      Nothing)    = rs\n        slurpLI    rs (LiveInstr instr (Just live))\n                | Just (r1, r2) <- takeRegRegMoveInstr instr\n                , elementOfUniqSet r1 $ liveDieRead live\n                , elementOfUniqSet r2 $ liveBorn live\n\n                -- only coalesce movs between two virtuals for now,\n                -- else we end up with allocatable regs in the live\n                -- regs list..\n                , isVirtualReg r1 && isVirtualReg r2\n                = consBag (r1, r2) rs\n\n                | otherwise\n                = rs\n\n", "num_lines": 100}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\n-- | Graph coloring register allocator.\nmodule RegAlloc.Graph.Main (\n        regAlloc\n) where\nimport GhcPrelude\n\nimport qualified GraphColor as Color\nimport RegAlloc.Liveness\nimport RegAlloc.Graph.Spill\nimport RegAlloc.Graph.SpillClean\nimport RegAlloc.Graph.SpillCost\nimport RegAlloc.Graph.Stats\nimport RegAlloc.Graph.TrivColorable\nimport Instruction\nimport TargetReg\nimport RegClass\nimport Reg\n\nimport Bag\nimport DynFlags\nimport Outputable\nimport Platform\nimport UniqFM\nimport UniqSet\nimport UniqSupply\nimport Util (seqList)\nimport CFG\n\nimport Data.Maybe\nimport Control.Monad\n\n\n-- | The maximum number of build\\/spill cycles we'll allow.\n--\n--   It should only take 3 or 4 cycles for the allocator to converge.\n--   If it takes any longer than this it's probably in an infinite loop,\n--   so it's better just to bail out and report a bug.\nmaxSpinCount    :: Int\nmaxSpinCount    = 10\n\n\n-- | The top level of the graph coloring register allocator.\nregAlloc\n        :: (Outputable statics, Outputable instr, Instruction instr)\n        => DynFlags\n        -> UniqFM (UniqSet RealReg)     -- ^ registers we can use for allocation\n        -> UniqSet Int                  -- ^ set of available spill slots.\n        -> Int                          -- ^ current number of spill slots\n        -> [LiveCmmDecl statics instr]  -- ^ code annotated with liveness information.\n        -> Maybe CFG                    -- ^ CFG of basic blocks if available\n        -> UniqSM ( [NatCmmDecl statics instr]\n                  , Maybe Int, [RegAllocStats statics instr] )\n           -- ^ code with registers allocated, additional stacks required\n           -- and stats for each stage of allocation\n\nregAlloc dflags regsFree slotsFree slotsCount code cfg\n = do\n        -- TODO: the regClass function is currently hard coded to the default\n        --       target architecture. Would prefer to determine this from dflags.\n        --       There are other uses of targetRegClass later in this module.\n        let platform = targetPlatform dflags\n            triv = trivColorable platform\n                        (targetVirtualRegSqueeze platform)\n                        (targetRealRegSqueeze platform)\n\n        (code_final, debug_codeGraphs, slotsCount', _)\n                <- regAlloc_spin dflags 0\n                        triv\n                        regsFree slotsFree slotsCount [] code cfg\n\n        let needStack\n                | slotsCount == slotsCount'\n                = Nothing\n                | otherwise\n                = Just slotsCount'\n\n        return  ( code_final\n                , needStack\n                , reverse debug_codeGraphs )\n\n\n-- | Perform solver iterations for the graph coloring allocator.\n--\n--   We extract a register confict graph from the provided cmm code,\n--   and try to colour it. If that works then we use the solution rewrite\n--   the code with real hregs. If coloring doesn't work we add spill code\n--   and try to colour it again. After `maxSpinCount` iterations we give up.\n--\nregAlloc_spin\n        :: forall instr statics.\n           (Instruction instr,\n            Outputable instr,\n            Outputable statics)\n        => DynFlags\n        -> Int  -- ^ Number of solver iterations we've already performed.\n        -> Color.Triv VirtualReg RegClass RealReg\n                -- ^ Function for calculating whether a register is trivially\n                --   colourable.\n        -> UniqFM (UniqSet RealReg)      -- ^ Free registers that we can allocate.\n        -> UniqSet Int                   -- ^ Free stack slots that we can use.\n        -> Int                           -- ^ Number of spill slots in use\n        -> [RegAllocStats statics instr] -- ^ Current regalloc stats to add to.\n        -> [LiveCmmDecl statics instr]   -- ^ Liveness annotated code to allocate.\n        -> Maybe CFG\n        -> UniqSM ( [NatCmmDecl statics instr]\n                  , [RegAllocStats statics instr]\n                  , Int                  -- Slots in use\n                  , Color.Graph VirtualReg RegClass RealReg)\n\nregAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGraphs code cfg\n = do\n        let platform = targetPlatform dflags\n\n        -- If any of these dump flags are turned on we want to hang on to\n        -- intermediate structures in the allocator - otherwise tell the\n        -- allocator to ditch them early so we don't end up creating space leaks.\n        let dump = or\n                [ dopt Opt_D_dump_asm_regalloc_stages dflags\n                , dopt Opt_D_dump_asm_stats dflags\n                , dopt Opt_D_dump_asm_conflicts dflags ]\n\n        -- Check that we're not running off down the garden path.\n        when (spinCount > maxSpinCount)\n         $ pprPanic \"regAlloc_spin: max build/spill cycle count exceeded.\"\n           (  text \"It looks like the register allocator is stuck in an infinite loop.\"\n           $$ text \"max cycles  = \" <> int maxSpinCount\n           $$ text \"regsFree    = \" <> (hcat $ punctuate space $ map ppr\n                                             $ nonDetEltsUniqSet $ unionManyUniqSets\n                                             $ nonDetEltsUFM regsFree)\n              -- This is non-deterministic but we do not\n              -- currently support deterministic code-generation.\n              -- See Note [Unique Determinism and code generation]\n           $$ text \"slotsFree   = \" <> ppr (sizeUniqSet slotsFree))\n\n        -- Build the register conflict graph from the cmm code.\n        (graph  :: Color.Graph VirtualReg RegClass RealReg)\n                <- {-# SCC \"BuildGraph\" #-} buildGraph code\n\n        -- VERY IMPORTANT:\n        --   We really do want the graph to be fully evaluated _before_ we\n        --   start coloring. If we don't do this now then when the call to\n        --   Color.colorGraph forces bits of it, the heap will be filled with\n        --   half evaluated pieces of graph and zillions of apply thunks.\n        seqGraph graph `seq` return ()\n\n        -- Build a map of the cost of spilling each instruction.\n        -- This is a lazy binding, so the map will only be computed if we\n        -- actually have to spill to the stack.\n        let spillCosts  = foldl' plusSpillCostInfo zeroSpillCostInfo\n                        $ map (slurpSpillCostInfo platform cfg) code\n\n        -- The function to choose regs to leave uncolored.\n        let spill       = chooseSpill spillCosts\n\n        -- Record startup state in our log.\n        let stat1\n             = if spinCount == 0\n                 then   Just $ RegAllocStatsStart\n                        { raLiveCmm     = code\n                        , raGraph       = graph\n                        , raSpillCosts  = spillCosts }\n                 else   Nothing\n\n        -- Try and color the graph.\n        let (graph_colored, rsSpill, rmCoalesce)\n                = {-# SCC \"ColorGraph\" #-}\n                  Color.colorGraph\n                       (gopt Opt_RegsIterative dflags)\n                       spinCount\n                       regsFree triv spill graph\n\n        -- Rewrite registers in the code that have been coalesced.\n        let patchF reg\n                | RegVirtual vr <- reg\n                = case lookupUFM rmCoalesce vr of\n                        Just vr'        -> patchF (RegVirtual vr')\n                        Nothing         -> reg\n\n                | otherwise\n                = reg\n\n        let (code_coalesced :: [LiveCmmDecl statics instr])\n                = map (patchEraseLive patchF) code\n\n        -- Check whether we've found a coloring.\n        if isEmptyUniqSet rsSpill\n\n         -- Coloring was successful because no registers needed to be spilled.\n         then do\n                -- if -fasm-lint is turned on then validate the graph.\n                -- This checks for bugs in the graph allocator itself.\n                let graph_colored_lint  =\n                        if gopt Opt_DoAsmLinting dflags\n                                then Color.validateGraph (text \"\")\n                                        True    -- Require all nodes to be colored.\n                                        graph_colored\n                                else graph_colored\n\n                -- Rewrite the code to use real hregs, using the colored graph.\n                let code_patched\n                        = map (patchRegsFromGraph platform graph_colored_lint)\n                              code_coalesced\n\n                -- Clean out unneeded SPILL/RELOAD meta instructions.\n                --   The spill code generator just spills the entire live range\n                --   of a vreg, but it might not need to be on the stack for\n                --   its entire lifetime.\n                let code_spillclean\n                        = map (cleanSpills platform) code_patched\n\n                -- Strip off liveness information from the allocated code.\n                -- Also rewrite SPILL/RELOAD meta instructions into real machine\n                -- instructions along the way\n                let code_final\n                        = map (stripLive dflags) code_spillclean\n\n                -- Record what happened in this stage for debugging\n                let stat\n                     =  RegAllocStatsColored\n                        { raCode                = code\n                        , raGraph               = graph\n                        , raGraphColored        = graph_colored_lint\n                        , raCoalesced           = rmCoalesce\n                        , raCodeCoalesced       = code_coalesced\n                        , raPatched             = code_patched\n                        , raSpillClean          = code_spillclean\n                        , raFinal               = code_final\n                        , raSRMs                = foldl' addSRM (0, 0, 0)\n                                                $ map countSRMs code_spillclean }\n\n                -- Bundle up all the register allocator statistics.\n                --   .. but make sure to drop them on the floor if they're not\n                --      needed, otherwise we'll get a space leak.\n                let statList =\n                        if dump then [stat] ++ maybeToList stat1 ++ debug_codeGraphs\n                                else []\n\n                -- Ensure all the statistics are evaluated, to avoid space leaks.\n                seqList statList (return ())\n\n                return  ( code_final\n                        , statList\n                        , slotsCount\n                        , graph_colored_lint)\n\n         -- Coloring was unsuccessful. We need to spill some register to the\n         -- stack, make a new graph, and try to color it again.\n         else do\n                -- if -fasm-lint is turned on then validate the graph\n                let graph_colored_lint  =\n                        if gopt Opt_DoAsmLinting dflags\n                                then Color.validateGraph (text \"\")\n                                        False   -- don't require nodes to be colored\n                                        graph_colored\n                                else graph_colored\n\n                -- Spill uncolored regs to the stack.\n                (code_spilled, slotsFree', slotsCount', spillStats)\n                        <- regSpill platform code_coalesced slotsFree slotsCount rsSpill\n\n                -- Recalculate liveness information.\n                -- NOTE: we have to reverse the SCCs here to get them back into\n                --       the reverse-dependency order required by computeLiveness.\n                --       If they're not in the correct order that function will panic.\n                code_relive     <- mapM (regLiveness platform . reverseBlocksInTops)\n                                        code_spilled\n\n                -- Record what happened in this stage for debugging.\n                let stat        =\n                        RegAllocStatsSpill\n                        { raCode        = code\n                        , raGraph       = graph_colored_lint\n                        , raCoalesced   = rmCoalesce\n                        , raSpillStats  = spillStats\n                        , raSpillCosts  = spillCosts\n                        , raSpilled     = code_spilled }\n\n                -- Bundle up all the register allocator statistics.\n                --   .. but make sure to drop them on the floor if they're not\n                --      needed, otherwise we'll get a space leak.\n                let statList =\n                        if dump\n                                then [stat] ++ maybeToList stat1 ++ debug_codeGraphs\n                                else []\n\n                -- Ensure all the statistics are evaluated, to avoid space leaks.\n                seqList statList (return ())\n\n                regAlloc_spin dflags (spinCount + 1) triv regsFree slotsFree'\n                              slotsCount' statList code_relive cfg\n\n\n-- | Build a graph from the liveness and coalesce information in this code.\nbuildGraph\n        :: Instruction instr\n        => [LiveCmmDecl statics instr]\n        -> UniqSM (Color.Graph VirtualReg RegClass RealReg)\n\nbuildGraph code\n = do\n        -- Slurp out the conflicts and reg->reg moves from this code.\n        let (conflictList, moveList) =\n                unzip $ map slurpConflicts code\n\n        -- Slurp out the spill/reload coalesces.\n        let moveList2           = map slurpReloadCoalesce code\n\n        -- Add the reg-reg conflicts to the graph.\n        let conflictBag         = unionManyBags conflictList\n        let graph_conflict\n                = foldrBag graphAddConflictSet Color.initGraph conflictBag\n\n        -- Add the coalescences edges to the graph.\n        let moveBag\n                = unionBags (unionManyBags moveList2)\n                            (unionManyBags moveList)\n\n        let graph_coalesce\n                = foldrBag graphAddCoalesce graph_conflict moveBag\n\n        return  graph_coalesce\n\n\n-- | Add some conflict edges to the graph.\n--   Conflicts between virtual and real regs are recorded as exclusions.\ngraphAddConflictSet\n        :: UniqSet Reg\n        -> Color.Graph VirtualReg RegClass RealReg\n        -> Color.Graph VirtualReg RegClass RealReg\n\ngraphAddConflictSet set graph\n = let  virtuals        = mkUniqSet\n                        [ vr | RegVirtual vr <- nonDetEltsUniqSet set ]\n\n        graph1  = Color.addConflicts virtuals classOfVirtualReg graph\n\n        graph2  = foldr (\\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2)\n                        graph1\n                        [ (vr, rr)\n                                | RegVirtual vr <- nonDetEltsUniqSet set\n                                , RegReal    rr <- nonDetEltsUniqSet set]\n                          -- See Note [Unique Determinism and code generation]\n\n   in   graph2\n\n\n-- | Add some coalesence edges to the graph\n--   Coalesences between virtual and real regs are recorded as preferences.\ngraphAddCoalesce\n        :: (Reg, Reg)\n        -> Color.Graph VirtualReg RegClass RealReg\n        -> Color.Graph VirtualReg RegClass RealReg\n\ngraphAddCoalesce (r1, r2) graph\n        | RegReal rr            <- r1\n        , RegVirtual vr         <- r2\n        = Color.addPreference (vr, classOfVirtualReg vr) rr graph\n\n        | RegReal rr            <- r2\n        , RegVirtual vr         <- r1\n        = Color.addPreference (vr, classOfVirtualReg vr) rr graph\n\n        | RegVirtual vr1        <- r1\n        , RegVirtual vr2        <- r2\n        = Color.addCoalesce\n                (vr1, classOfVirtualReg vr1)\n                (vr2, classOfVirtualReg vr2)\n                graph\n\n        -- We can't coalesce two real regs, but there could well be existing\n        --      hreg,hreg moves in the input code. We'll just ignore these\n        --      for coalescing purposes.\n        | RegReal _             <- r1\n        , RegReal _             <- r2\n        = graph\n\n        | otherwise\n        = panic \"graphAddCoalesce\"\n\n\n-- | Patch registers in code using the reg -> reg mapping in this graph.\npatchRegsFromGraph\n        :: (Outputable statics, Outputable instr, Instruction instr)\n        => Platform -> Color.Graph VirtualReg RegClass RealReg\n        -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr\n\npatchRegsFromGraph platform graph code\n = patchEraseLive patchF code\n where\n        -- Function to lookup the hardreg for a virtual reg from the graph.\n        patchF reg\n                -- leave real regs alone.\n                | RegReal{}     <- reg\n                = reg\n\n                -- this virtual has a regular node in the graph.\n                | RegVirtual vr <- reg\n                , Just node     <- Color.lookupNode graph vr\n                = case Color.nodeColor node of\n                        Just color      -> RegReal    color\n                        Nothing         -> RegVirtual vr\n\n                -- no node in the graph for this virtual, bad news.\n                | otherwise\n                = pprPanic \"patchRegsFromGraph: register mapping failed.\"\n                        (  text \"There is no node in the graph for register \"\n                                <> ppr reg\n                        $$ ppr code\n                        $$ Color.dotGraph\n                                (\\_ -> text \"white\")\n                                (trivColorable platform\n                                        (targetVirtualRegSqueeze platform)\n                                        (targetRealRegSqueeze platform))\n                                graph)\n\n\n-----\n-- for when laziness just isn't what you wanted...\n--  We need to deepSeq the whole graph before trying to colour it to avoid\n--  space leaks.\nseqGraph :: Color.Graph VirtualReg RegClass RealReg -> ()\nseqGraph graph          = seqNodes (nonDetEltsUFM (Color.graphMap graph))\n   -- See Note [Unique Determinism and code generation]\n\nseqNodes :: [Color.Node VirtualReg RegClass RealReg] -> ()\nseqNodes ns\n = case ns of\n        []              -> ()\n        (n : ns)        -> seqNode n `seq` seqNodes ns\n\nseqNode :: Color.Node VirtualReg RegClass RealReg -> ()\nseqNode node\n        =     seqVirtualReg     (Color.nodeId node)\n        `seq` seqRegClass       (Color.nodeClass node)\n        `seq` seqMaybeRealReg   (Color.nodeColor node)\n        `seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeConflicts node)))\n        `seq` (seqRealRegList    (nonDetEltsUniqSet (Color.nodeExclusions node)))\n        `seq` (seqRealRegList (Color.nodePreference node))\n        `seq` (seqVirtualRegList (nonDetEltsUniqSet (Color.nodeCoalesce node)))\n              -- It's OK to use nonDetEltsUniqSet for seq\n\nseqVirtualReg :: VirtualReg -> ()\nseqVirtualReg reg = reg `seq` ()\n\nseqRealReg :: RealReg -> ()\nseqRealReg reg = reg `seq` ()\n\nseqRegClass :: RegClass -> ()\nseqRegClass c = c `seq` ()\n\nseqMaybeRealReg :: Maybe RealReg -> ()\nseqMaybeRealReg mr\n = case mr of\n        Nothing         -> ()\n        Just r          -> seqRealReg r\n\nseqVirtualRegList :: [VirtualReg] -> ()\nseqVirtualRegList rs\n = case rs of\n        []              -> ()\n        (r : rs)        -> seqVirtualReg r `seq` seqVirtualRegList rs\n\nseqRealRegList :: [RealReg] -> ()\nseqRealRegList rs\n = case rs of\n        []              -> ()\n        (r : rs)        -> seqRealReg r `seq` seqRealRegList rs\n", "num_lines": 470}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | When there aren't enough registers to hold all the vregs we have to spill\n--   some of those vregs to slots on the stack. This module is used modify the\n--   code to use those slots.\nmodule RegAlloc.Graph.Spill (\n        regSpill,\n        SpillStats(..),\n        accSpillSL\n) where\nimport GhcPrelude\n\nimport RegAlloc.Liveness\nimport Instruction\nimport Reg\nimport Cmm hiding (RegSet)\nimport BlockId\nimport Hoopl.Collections\n\nimport MonadUtils\nimport State\nimport Unique\nimport UniqFM\nimport UniqSet\nimport UniqSupply\nimport Outputable\nimport Platform\n\nimport Data.List\nimport Data.Maybe\nimport Data.IntSet              (IntSet)\nimport qualified Data.IntSet    as IntSet\n\n\n-- | Spill all these virtual regs to stack slots.\n--\n--   Bumps the number of required stack slots if required.\n--\n--\n--   TODO: See if we can split some of the live ranges instead of just globally\n--         spilling the virtual reg. This might make the spill cleaner's job easier.\n--\n--   TODO: On CISCy x86 and x86_64 we don't necessarily have to add a mov instruction\n--         when making spills. If an instr is using a spilled virtual we may be able to\n--         address the spill slot directly.\n--\nregSpill\n        :: Instruction instr\n        => Platform\n        -> [LiveCmmDecl statics instr]  -- ^ the code\n        -> UniqSet Int                  -- ^ available stack slots\n        -> Int                          -- ^ current number of spill slots.\n        -> UniqSet VirtualReg           -- ^ the regs to spill\n        -> UniqSM\n            ([LiveCmmDecl statics instr]\n                 -- code with SPILL and RELOAD meta instructions added.\n            , UniqSet Int               -- left over slots\n            , Int                       -- slot count in use now.\n            , SpillStats )              -- stats about what happened during spilling\n\nregSpill platform code slotsFree slotCount regs\n\n        -- Not enough slots to spill these regs.\n        | sizeUniqSet slotsFree < sizeUniqSet regs\n        = -- pprTrace \"Bumping slot count:\" (ppr slotCount <> text \" -> \" <> ppr (slotCount+512)) $\n          let slotsFree' = (addListToUniqSet slotsFree [slotCount+1 .. slotCount+512])\n          in regSpill platform code slotsFree' (slotCount+512) regs\n\n        | otherwise\n        = do\n                -- Allocate a slot for each of the spilled regs.\n                let slots       = take (sizeUniqSet regs) $ nonDetEltsUniqSet slotsFree\n                let regSlotMap  = listToUFM\n                                $ zip (nonDetEltsUniqSet regs) slots\n                    -- This is non-deterministic but we do not\n                    -- currently support deterministic code-generation.\n                    -- See Note [Unique Determinism and code generation]\n\n                -- Grab the unique supply from the monad.\n                us      <- getUniqueSupplyM\n\n                -- Run the spiller on all the blocks.\n                let (code', state')     =\n                        runState (mapM (regSpill_top platform regSlotMap) code)\n                                 (initSpillS us)\n\n                return  ( code'\n                        , minusUniqSet slotsFree (mkUniqSet slots)\n                        , slotCount\n                        , makeSpillStats state')\n\n\n-- | Spill some registers to stack slots in a top-level thing.\nregSpill_top\n        :: Instruction instr\n        => Platform\n        -> RegMap Int\n                -- ^ map of vregs to slots they're being spilled to.\n        -> LiveCmmDecl statics instr\n                -- ^ the top level thing.\n        -> SpillM (LiveCmmDecl statics instr)\n\nregSpill_top platform regSlotMap cmm\n = case cmm of\n        CmmData{}\n         -> return cmm\n\n        CmmProc info label live sccs\n         |  LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry <- info\n         -> do\n                -- The liveVRegsOnEntry contains the set of vregs that are live\n                -- on entry to each basic block. If we spill one of those vregs\n                -- we remove it from that set and add the corresponding slot\n                -- number to the liveSlotsOnEntry set. The spill cleaner needs\n                -- this information to erase unneeded spill and reload instructions\n                -- after we've done a successful allocation.\n                let liveSlotsOnEntry' :: BlockMap IntSet\n                    liveSlotsOnEntry'\n                        = mapFoldlWithKey patchLiveSlot\n                                          liveSlotsOnEntry liveVRegsOnEntry\n\n                let info'\n                        = LiveInfo static firstId\n                                liveVRegsOnEntry\n                                liveSlotsOnEntry'\n\n                -- Apply the spiller to all the basic blocks in the CmmProc.\n                sccs'   <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs\n\n                return  $ CmmProc info' label live sccs'\n\n where  -- Given a BlockId and the set of registers live in it,\n        -- if registers in this block are being spilled to stack slots,\n        -- then record the fact that these slots are now live in those blocks\n        -- in the given slotmap.\n        patchLiveSlot\n                :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet\n\n        patchLiveSlot slotMap blockId regsLive\n         = let\n                -- Slots that are already recorded as being live.\n                curSlotsLive    = fromMaybe IntSet.empty\n                                $ mapLookup blockId slotMap\n\n                moreSlotsLive   = IntSet.fromList\n                                $ catMaybes\n                                $ map (lookupUFM regSlotMap)\n                                $ nonDetEltsUniqSet regsLive\n                    -- See Note [Unique Determinism and code generation]\n\n                slotMap'\n                 = mapInsert blockId (IntSet.union curSlotsLive moreSlotsLive)\n                             slotMap\n\n           in   slotMap'\n\n\n-- | Spill some registers to stack slots in a basic block.\nregSpill_block\n        :: Instruction instr\n        => Platform\n        -> UniqFM Int   -- ^ map of vregs to slots they're being spilled to.\n        -> LiveBasicBlock instr\n        -> SpillM (LiveBasicBlock instr)\n\nregSpill_block platform regSlotMap (BasicBlock i instrs)\n = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs\n        return  $ BasicBlock i (concat instrss')\n\n\n-- | Spill some registers to stack slots in a single instruction.\n--   If the instruction uses registers that need to be spilled, then it is\n--   prefixed (or postfixed) with the appropriate RELOAD or SPILL meta\n--   instructions.\nregSpill_instr\n        :: Instruction instr\n        => Platform\n        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.\n        -> LiveInstr instr\n        -> SpillM [LiveInstr instr]\n\nregSpill_instr _ _ li@(LiveInstr _ Nothing)\n = do   return [li]\n\nregSpill_instr platform regSlotMap\n        (LiveInstr instr (Just _))\n = do\n        -- work out which regs are read and written in this instr\n        let RU rlRead rlWritten = regUsageOfInstr platform instr\n\n        -- sometimes a register is listed as being read more than once,\n        --      nub this so we don't end up inserting two lots of spill code.\n        let rsRead_             = nub rlRead\n        let rsWritten_          = nub rlWritten\n\n        -- if a reg is modified, it appears in both lists, want to undo this..\n        let rsRead              = rsRead_    \\\\ rsWritten_\n        let rsWritten           = rsWritten_ \\\\ rsRead_\n        let rsModify            = intersect rsRead_ rsWritten_\n\n        -- work out if any of the regs being used are currently being spilled.\n        let rsSpillRead         = filter (\\r -> elemUFM r regSlotMap) rsRead\n        let rsSpillWritten      = filter (\\r -> elemUFM r regSlotMap) rsWritten\n        let rsSpillModify       = filter (\\r -> elemUFM r regSlotMap) rsModify\n\n        -- rewrite the instr and work out spill code.\n        (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead\n        (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten\n        (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify\n\n        let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)\n        let prefixes                    = concat mPrefixes\n        let postfixes                   = concat mPostfixes\n\n        -- final code\n        let instrs'     =  prefixes\n                        ++ [LiveInstr instr3 Nothing]\n                        ++ postfixes\n\n        return $ instrs'\n\n\n-- | Add a RELOAD met a instruction to load a value for an instruction that\n--   writes to a vreg that is being spilled.\nspillRead\n        :: Instruction instr\n        => UniqFM Int\n        -> instr\n        -> Reg\n        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))\n\nspillRead regSlotMap instr reg\n | Just slot     <- lookupUFM regSlotMap reg\n = do    (instr', nReg)  <- patchInstr reg instr\n\n         modify $ \\s -> s\n                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }\n\n         return  ( instr'\n                 , ( [LiveInstr (RELOAD slot nReg) Nothing]\n                 , []) )\n\n | otherwise     = panic \"RegSpill.spillRead: no slot defined for spilled reg\"\n\n\n-- | Add a SPILL meta instruction to store a value for an instruction that\n--   writes to a vreg that is being spilled.\nspillWrite\n        :: Instruction instr\n        => UniqFM Int\n        -> instr\n        -> Reg\n        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))\n\nspillWrite regSlotMap instr reg\n | Just slot     <- lookupUFM regSlotMap reg\n = do    (instr', nReg)  <- patchInstr reg instr\n\n         modify $ \\s -> s\n                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }\n\n         return  ( instr'\n                 , ( []\n                   , [LiveInstr (SPILL nReg slot) Nothing]))\n\n | otherwise     = panic \"RegSpill.spillWrite: no slot defined for spilled reg\"\n\n\n-- | Add both RELOAD and SPILL meta instructions for an instruction that\n--   both reads and writes to a vreg that is being spilled.\nspillModify\n        :: Instruction instr\n        => UniqFM Int\n        -> instr\n        -> Reg\n        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))\n\nspillModify regSlotMap instr reg\n | Just slot     <- lookupUFM regSlotMap reg\n = do    (instr', nReg)  <- patchInstr reg instr\n\n         modify $ \\s -> s\n                { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }\n\n         return  ( instr'\n                 , ( [LiveInstr (RELOAD slot nReg) Nothing]\n                   , [LiveInstr (SPILL nReg slot) Nothing]))\n\n | otherwise     = panic \"RegSpill.spillModify: no slot defined for spilled reg\"\n\n\n-- | Rewrite uses of this virtual reg in an instr to use a different\n--   virtual reg.\npatchInstr\n        :: Instruction instr\n        => Reg -> instr -> SpillM (instr, Reg)\n\npatchInstr reg instr\n = do   nUnique         <- newUnique\n\n        -- The register we're rewriting is suppoed to be virtual.\n        -- If it's not then something has gone horribly wrong.\n        let nReg\n             = case reg of\n                RegVirtual vr\n                 -> RegVirtual (renameVirtualReg nUnique vr)\n\n                RegReal{}\n                 -> panic \"RegAlloc.Graph.Spill.patchIntr: not patching real reg\"\n\n        let instr'      = patchReg1 reg nReg instr\n        return          (instr', nReg)\n\n\npatchReg1\n        :: Instruction instr\n        => Reg -> Reg -> instr -> instr\n\npatchReg1 old new instr\n = let  patchF r\n                | r == old      = new\n                | otherwise     = r\n   in   patchRegsOfInstr instr patchF\n\n\n-- Spiller monad --------------------------------------------------------------\n-- | State monad for the spill code generator.\ntype SpillM a\n        = State SpillS a\n\n-- | Spill code generator state.\ndata SpillS\n        = SpillS\n        { -- | Unique supply for generating fresh vregs.\n          stateUS       :: UniqSupply\n\n          -- | Spilled vreg vs the number of times it was loaded, stored.\n        , stateSpillSL  :: UniqFM (Reg, Int, Int) }\n\n\n-- | Create a new spiller state.\ninitSpillS :: UniqSupply -> SpillS\ninitSpillS uniqueSupply\n        = SpillS\n        { stateUS       = uniqueSupply\n        , stateSpillSL  = emptyUFM }\n\n\n-- | Allocate a new unique in the spiller monad.\nnewUnique :: SpillM Unique\nnewUnique\n = do   us      <- gets stateUS\n        case takeUniqFromSupply us of\n         (uniq, us')\n          -> do modify $ \\s -> s { stateUS = us' }\n                return uniq\n\n\n-- | Add a spill/reload count to a stats record for a register.\naccSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)\naccSpillSL (r1, s1, l1) (_, s2, l2)\n        = (r1, s1 + s2, l1 + l2)\n\n\n-- Spiller stats --------------------------------------------------------------\n-- | Spiller statistics.\n--   Tells us what registers were spilled.\ndata SpillStats\n        = SpillStats\n        { spillStoreLoad        :: UniqFM (Reg, Int, Int) }\n\n\n-- | Extract spiller statistics from the spiller state.\nmakeSpillStats :: SpillS -> SpillStats\nmakeSpillStats s\n        = SpillStats\n        { spillStoreLoad        = stateSpillSL s }\n\n\ninstance Outputable SpillStats where\n ppr stats\n        = pprUFM (spillStoreLoad stats)\n                 (vcat . map (\\(r, s, l) -> ppr r <+> int s <+> int l))\n", "num_lines": 383}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Clean out unneeded spill\\/reload instructions.\n--\n--   Handling of join points\n--   ~~~~~~~~~~~~~~~~~~~~~~~\n--\n--   B1:                          B2:\n--    ...                          ...\n--       RELOAD SLOT(0), %r1          RELOAD SLOT(0), %r1\n--       ... A ...                    ... B ...\n--       jump B3                      jump B3\n--\n--                B3: ... C ...\n--                    RELOAD SLOT(0), %r1\n--                    ...\n--\n--   The Plan\n--   ~~~~~~~~\n--   As long as %r1 hasn't been written to in A, B or C then we don't need\n--   the reload in B3.\n--\n--   What we really care about here is that on the entry to B3, %r1 will\n--   always have the same value that is in SLOT(0) (ie, %r1 is _valid_)\n--\n--   This also works if the reloads in B1\\/B2 were spills instead, because\n--   spilling %r1 to a slot makes that slot have the same value as %r1.\n--\nmodule RegAlloc.Graph.SpillClean (\n        cleanSpills\n) where\nimport GhcPrelude\n\nimport RegAlloc.Liveness\nimport Instruction\nimport Reg\n\nimport BlockId\nimport Cmm\nimport UniqSet\nimport UniqFM\nimport Unique\nimport State\nimport Outputable\nimport Platform\nimport Hoopl.Collections\n\nimport Data.List\nimport Data.Maybe\nimport Data.IntSet              (IntSet)\nimport qualified Data.IntSet    as IntSet\n\n\n-- | The identification number of a spill slot.\n--   A value is stored in a spill slot when we don't have a free\n--   register to hold it.\ntype Slot = Int\n\n\n-- | Clean out unneeded spill\\/reloads from this top level thing.\ncleanSpills\n        :: Instruction instr\n        => Platform\n        -> LiveCmmDecl statics instr\n        -> LiveCmmDecl statics instr\n\ncleanSpills platform cmm\n        = evalState (cleanSpin platform 0 cmm) initCleanS\n\n\n-- | Do one pass of cleaning.\ncleanSpin\n        :: Instruction instr\n        => Platform\n        -> Int                              -- ^ Iteration number for the cleaner.\n        -> LiveCmmDecl statics instr        -- ^ Liveness annotated code to clean.\n        -> CleanM (LiveCmmDecl statics instr)\n\ncleanSpin platform spinCount code\n = do\n        -- Initialise count of cleaned spill and reload instructions.\n        modify $ \\s -> s\n                { sCleanedSpillsAcc     = 0\n                , sCleanedReloadsAcc    = 0\n                , sReloadedBy           = emptyUFM }\n\n        code_forward    <- mapBlockTopM (cleanBlockForward platform) code\n        code_backward   <- cleanTopBackward code_forward\n\n        -- During the cleaning of each block we collected information about\n        -- what regs were valid across each jump. Based on this, work out\n        -- whether it will be safe to erase reloads after join points for\n        -- the next pass.\n        collateJoinPoints\n\n        -- Remember how many spill and reload instructions we cleaned in this pass.\n        spills          <- gets sCleanedSpillsAcc\n        reloads         <- gets sCleanedReloadsAcc\n        modify $ \\s -> s\n                { sCleanedCount = (spills, reloads) : sCleanedCount s }\n\n        -- If nothing was cleaned in this pass or the last one\n        --      then we're done and it's time to bail out.\n        cleanedCount    <- gets sCleanedCount\n        if take 2 cleanedCount == [(0, 0), (0, 0)]\n           then return code\n\n        -- otherwise go around again\n           else cleanSpin platform (spinCount + 1) code_backward\n\n\n-------------------------------------------------------------------------------\n-- | Clean out unneeded reload instructions,\n--   while walking forward over the code.\ncleanBlockForward\n        :: Instruction instr\n        => Platform\n        -> LiveBasicBlock instr\n        -> CleanM (LiveBasicBlock instr)\n\ncleanBlockForward platform (BasicBlock blockId instrs)\n = do\n        -- See if we have a valid association for the entry to this block.\n        jumpValid       <- gets sJumpValid\n        let assoc       = case lookupUFM jumpValid blockId of\n                                Just assoc      -> assoc\n                                Nothing         -> emptyAssoc\n\n        instrs_reload   <- cleanForward platform blockId assoc [] instrs\n        return  $ BasicBlock blockId instrs_reload\n\n\n\n-- | Clean out unneeded reload instructions.\n--\n--   Walking forwards across the code\n--     On a reload, if we know a reg already has the same value as a slot\n--     then we don't need to do the reload.\n--\ncleanForward\n        :: Instruction instr\n        => Platform\n        -> BlockId                  -- ^ the block that we're currently in\n        -> Assoc Store              -- ^ two store locations are associated if\n                                    --     they have the same value\n        -> [LiveInstr instr]        -- ^ acc\n        -> [LiveInstr instr]        -- ^ instrs to clean (in backwards order)\n        -> CleanM [LiveInstr instr] -- ^ cleaned instrs  (in forward   order)\n\ncleanForward _ _ _ acc []\n        = return acc\n\n-- Rewrite live range joins via spill slots to just a spill and a reg-reg move\n-- hopefully the spill will be also be cleaned in the next pass\ncleanForward platform blockId assoc acc (li1 : li2 : instrs)\n\n        | LiveInstr (SPILL  reg1  slot1) _      <- li1\n        , LiveInstr (RELOAD slot2 reg2)  _      <- li2\n        , slot1 == slot2\n        = do\n                modify $ \\s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }\n                cleanForward platform blockId assoc acc\n                 $ li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing\n                       : instrs\n\ncleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)\n        | Just (r1, r2) <- takeRegRegMoveInstr i1\n        = if r1 == r2\n                -- Erase any left over nop reg reg moves while we're here\n                -- this will also catch any nop moves that the previous case\n                -- happens to add.\n                then cleanForward platform blockId assoc acc instrs\n\n                -- If r1 has the same value as some slots and we copy r1 to r2,\n                --      then r2 is now associated with those slots instead\n                else do let assoc'      = addAssoc (SReg r1) (SReg r2)\n                                        $ delAssoc (SReg r2)\n                                        $ assoc\n\n                        cleanForward platform blockId assoc' (li : acc) instrs\n\n\ncleanForward platform blockId assoc acc (li : instrs)\n\n        -- Update association due to the spill.\n        | LiveInstr (SPILL reg slot) _  <- li\n        = let   assoc'  = addAssoc (SReg reg)  (SSlot slot)\n                        $ delAssoc (SSlot slot)\n                        $ assoc\n          in    cleanForward platform blockId assoc' (li : acc) instrs\n\n        -- Clean a reload instr.\n        | LiveInstr (RELOAD{}) _        <- li\n        = do    (assoc', mli)   <- cleanReload platform blockId assoc li\n                case mli of\n                 Nothing        -> cleanForward platform blockId assoc' acc\n                                                instrs\n\n                 Just li'       -> cleanForward platform blockId assoc' (li' : acc)\n                                                instrs\n\n        -- Remember the association over a jump.\n        | LiveInstr instr _     <- li\n        , targets               <- jumpDestsOfInstr instr\n        , not $ null targets\n        = do    mapM_ (accJumpValid assoc) targets\n                cleanForward platform blockId assoc (li : acc) instrs\n\n        -- Writing to a reg changes its value.\n        | LiveInstr instr _     <- li\n        , RU _ written          <- regUsageOfInstr platform instr\n        = let assoc'    = foldr delAssoc assoc (map SReg $ nub written)\n          in  cleanForward platform blockId assoc' (li : acc) instrs\n\n\n\n-- | Try and rewrite a reload instruction to something more pleasing\ncleanReload\n        :: Instruction instr\n        => Platform\n        -> BlockId\n        -> Assoc Store\n        -> LiveInstr instr\n        -> CleanM (Assoc Store, Maybe (LiveInstr instr))\n\ncleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg) _)\n\n        -- If the reg we're reloading already has the same value as the slot\n        --      then we can erase the instruction outright.\n        | elemAssoc (SSlot slot) (SReg reg) assoc\n        = do    modify  $ \\s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }\n                return  (assoc, Nothing)\n\n        -- If we can find another reg with the same value as this slot then\n        --      do a move instead of a reload.\n        | Just reg2     <- findRegOfSlot assoc slot\n        = do    modify $ \\s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }\n\n                let assoc'      = addAssoc (SReg reg) (SReg reg2)\n                                $ delAssoc (SReg reg)\n                                $ assoc\n\n                return  ( assoc'\n                        , Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing)\n\n        -- Gotta keep this instr.\n        | otherwise\n        = do    -- Update the association.\n                let assoc'\n                        = addAssoc (SReg reg)  (SSlot slot)\n                                -- doing the reload makes reg and slot the same value\n                        $ delAssoc (SReg reg)\n                                -- reg value changes on reload\n                        $ assoc\n\n                -- Remember that this block reloads from this slot.\n                accBlockReloadsSlot blockId slot\n\n                return  (assoc', Just li)\n\ncleanReload _ _ _ _\n        = panic \"RegSpillClean.cleanReload: unhandled instr\"\n\n\n-------------------------------------------------------------------------------\n-- | Clean out unneeded spill instructions,\n--   while walking backwards over the code.\n--\n--      If there were no reloads from a slot between a spill and the last one\n--      then the slot was never read and we don't need the spill.\n--\n--      SPILL   r0 -> s1\n--      RELOAD  s1 -> r2\n--      SPILL   r3 -> s1        <--- don't need this spill\n--      SPILL   r4 -> s1\n--      RELOAD  s1 -> r5\n--\n--      Maintain a set of\n--              \"slots which were spilled to but not reloaded from yet\"\n--\n--      Walking backwards across the code:\n--       a) On a reload from a slot, remove it from the set.\n--\n--       a) On a spill from a slot\n--              If the slot is in set then we can erase the spill,\n--               because it won't be reloaded from until after the next spill.\n--\n--              otherwise\n--               keep the spill and add the slot to the set\n--\n-- TODO: This is mostly inter-block\n--       we should really be updating the noReloads set as we cross jumps also.\n--\n-- TODO: generate noReloads from liveSlotsOnEntry\n--\ncleanTopBackward\n        :: Instruction instr\n        => LiveCmmDecl statics instr\n        -> CleanM (LiveCmmDecl statics instr)\n\ncleanTopBackward cmm\n = case cmm of\n        CmmData{}\n         -> return cmm\n\n        CmmProc info label live sccs\n         | LiveInfo _ _ _ liveSlotsOnEntry <- info\n         -> do  sccs'   <- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs\n                return  $ CmmProc info label live sccs'\n\n\ncleanBlockBackward\n        :: Instruction instr\n        => BlockMap IntSet\n        -> LiveBasicBlock instr\n        -> CleanM (LiveBasicBlock instr)\n\ncleanBlockBackward liveSlotsOnEntry (BasicBlock blockId instrs)\n = do   instrs_spill    <- cleanBackward liveSlotsOnEntry  emptyUniqSet  [] instrs\n        return  $ BasicBlock blockId instrs_spill\n\n\n\ncleanBackward\n        :: Instruction instr\n        => BlockMap IntSet          -- ^ Slots live on entry to each block\n        -> UniqSet Int              -- ^ Slots that have been spilled, but not reloaded from\n        -> [LiveInstr instr]        -- ^ acc\n        -> [LiveInstr instr]        -- ^ Instrs to clean (in forwards order)\n        -> CleanM [LiveInstr instr] -- ^ Cleaned instrs  (in backwards order)\n\ncleanBackward liveSlotsOnEntry noReloads acc lis\n = do   reloadedBy      <- gets sReloadedBy\n        cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis\n\n\ncleanBackward'\n        :: Instruction instr\n        => BlockMap IntSet\n        -> UniqFM [BlockId]\n        -> UniqSet Int\n        -> [LiveInstr instr]\n        -> [LiveInstr instr]\n        -> State CleanS [LiveInstr instr]\n\ncleanBackward' _ _ _      acc []\n        = return  acc\n\ncleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)\n\n        -- If nothing ever reloads from this slot then we don't need the spill.\n        | LiveInstr (SPILL _ slot) _    <- li\n        , Nothing       <- lookupUFM reloadedBy (SSlot slot)\n        = do    modify $ \\s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }\n                cleanBackward liveSlotsOnEntry noReloads acc instrs\n\n        | LiveInstr (SPILL _ slot) _    <- li\n        = if elementOfUniqSet slot noReloads\n\n           -- We can erase this spill because the slot won't be read until\n           -- after the next one\n           then do\n                modify $ \\s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }\n                cleanBackward liveSlotsOnEntry noReloads acc instrs\n\n           else do\n                -- This slot is being spilled to, but we haven't seen any reloads yet.\n                let noReloads'  = addOneToUniqSet noReloads slot\n                cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs\n\n        -- if we reload from a slot then it's no longer unused\n        | LiveInstr (RELOAD slot _) _   <- li\n        , noReloads'            <- delOneFromUniqSet noReloads slot\n        = cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs\n\n        -- If a slot is live in a jump target then assume it's reloaded there.\n        --\n        -- TODO: A real dataflow analysis would do a better job here.\n        --       If the target block _ever_ used the slot then we assume\n        --       it always does, but if those reloads are cleaned the slot\n        --       liveness map doesn't get updated.\n        | LiveInstr instr _     <- li\n        , targets               <- jumpDestsOfInstr instr\n        = do\n                let slotsReloadedByTargets\n                        = IntSet.unions\n                        $ catMaybes\n                        $ map (flip mapLookup liveSlotsOnEntry)\n                        $ targets\n\n                let noReloads'\n                        = foldl' delOneFromUniqSet noReloads\n                        $ IntSet.toList slotsReloadedByTargets\n\n                cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs\n\n        -- some other instruction\n        | otherwise\n        = cleanBackward liveSlotsOnEntry noReloads (li : acc) instrs\n\n\n-- | Combine the associations from all the inward control flow edges.\n--\ncollateJoinPoints :: CleanM ()\ncollateJoinPoints\n = modify $ \\s -> s\n        { sJumpValid    = mapUFM intersects (sJumpValidAcc s)\n        , sJumpValidAcc = emptyUFM }\n\nintersects :: [Assoc Store]     -> Assoc Store\nintersects []           = emptyAssoc\nintersects assocs       = foldl1' intersectAssoc assocs\n\n\n-- | See if we have a reg with the same value as this slot in the association table.\nfindRegOfSlot :: Assoc Store -> Int -> Maybe Reg\nfindRegOfSlot assoc slot\n        | close                 <- closeAssoc (SSlot slot) assoc\n        , Just (SReg reg)       <- find isStoreReg $ nonDetEltsUniqSet close\n           -- See Note [Unique Determinism and code generation]\n        = Just reg\n\n        | otherwise\n        = Nothing\n\n\n-------------------------------------------------------------------------------\n-- | Cleaner monad.\ntype CleanM\n        = State CleanS\n\n-- | Cleaner state.\ndata CleanS\n        = CleanS\n        { -- | Regs which are valid at the start of each block.\n          sJumpValid            :: UniqFM (Assoc Store)\n\n          -- | Collecting up what regs were valid across each jump.\n          --    in the next pass we can collate these and write the results\n          --    to sJumpValid.\n        , sJumpValidAcc         :: UniqFM [Assoc Store]\n\n          -- | Map of (slot -> blocks which reload from this slot)\n          --    used to decide if whether slot spilled to will ever be\n          --    reloaded from on this path.\n        , sReloadedBy           :: UniqFM [BlockId]\n\n          -- | Spills and reloads cleaned each pass (latest at front)\n        , sCleanedCount         :: [(Int, Int)]\n\n          -- | Spills and reloads that have been cleaned in this pass so far.\n        , sCleanedSpillsAcc     :: Int\n        , sCleanedReloadsAcc    :: Int }\n\n\n-- | Construct the initial cleaner state.\ninitCleanS :: CleanS\ninitCleanS\n        = CleanS\n        { sJumpValid            = emptyUFM\n        , sJumpValidAcc         = emptyUFM\n\n        , sReloadedBy           = emptyUFM\n\n        , sCleanedCount         = []\n\n        , sCleanedSpillsAcc     = 0\n        , sCleanedReloadsAcc    = 0 }\n\n\n-- | Remember the associations before a jump.\naccJumpValid :: Assoc Store -> BlockId -> CleanM ()\naccJumpValid assocs target\n = modify $ \\s -> s {\n        sJumpValidAcc = addToUFM_C (++)\n                                (sJumpValidAcc s)\n                                target\n                                [assocs] }\n\n\naccBlockReloadsSlot :: BlockId -> Slot -> CleanM ()\naccBlockReloadsSlot blockId slot\n = modify $ \\s -> s {\n        sReloadedBy = addToUFM_C (++)\n                                (sReloadedBy s)\n                                (SSlot slot)\n                                [blockId] }\n\n\n-------------------------------------------------------------------------------\n-- A store location can be a stack slot or a register\ndata Store\n        = SSlot Int\n        | SReg  Reg\n\n\n-- | Check if this is a reg store.\nisStoreReg :: Store -> Bool\nisStoreReg ss\n = case ss of\n        SSlot _ -> False\n        SReg  _ -> True\n\n\n-- Spill cleaning is only done once all virtuals have been allocated to realRegs\ninstance Uniquable Store where\n    getUnique (SReg  r)\n        | RegReal (RealRegSingle i)     <- r\n        = mkRegSingleUnique i\n\n        | RegReal (RealRegPair r1 r2)   <- r\n        = mkRegPairUnique (r1 * 65535 + r2)\n\n        | otherwise\n        = error $ \"RegSpillClean.getUnique: found virtual reg during spill clean,\"\n                ++ \"only real regs expected.\"\n\n    getUnique (SSlot i) = mkRegSubUnique i    -- [SLPJ] I hope \"SubUnique\" is ok\n\n\ninstance Outputable Store where\n        ppr (SSlot i)   = text \"slot\" <> int i\n        ppr (SReg  r)   = ppr r\n\n\n-------------------------------------------------------------------------------\n-- Association graphs.\n-- In the spill cleaner, two store locations are associated if they are known\n-- to hold the same value.\n--\ntype Assoc a    = UniqFM (UniqSet a)\n\n-- | An empty association\nemptyAssoc :: Assoc a\nemptyAssoc      = emptyUFM\n\n\n-- | Add an association between these two things.\naddAssoc :: Uniquable a\n         => a -> a -> Assoc a -> Assoc a\n\naddAssoc a b m\n = let  m1      = addToUFM_C unionUniqSets m  a (unitUniqSet b)\n        m2      = addToUFM_C unionUniqSets m1 b (unitUniqSet a)\n   in   m2\n\n\n-- | Delete all associations to a node.\ndelAssoc :: (Uniquable a)\n         => a -> Assoc a -> Assoc a\n\ndelAssoc a m\n        | Just aSet     <- lookupUFM  m a\n        , m1            <- delFromUFM m a\n        = nonDetFoldUniqSet (\\x m -> delAssoc1 x a m) m1 aSet\n          -- It's OK to use nonDetFoldUFM here because deletion is commutative\n\n        | otherwise     = m\n\n\n-- | Delete a single association edge (a -> b).\ndelAssoc1 :: Uniquable a\n          => a -> a -> Assoc a -> Assoc a\n\ndelAssoc1 a b m\n        | Just aSet     <- lookupUFM m a\n        = addToUFM m a (delOneFromUniqSet aSet b)\n\n        | otherwise     = m\n\n\n-- | Check if these two things are associated.\nelemAssoc :: (Uniquable a)\n          => a -> a -> Assoc a -> Bool\n\nelemAssoc a b m\n        = elementOfUniqSet b (closeAssoc a m)\n\n\n-- | Find the refl. trans. closure of the association from this point.\ncloseAssoc :: (Uniquable a)\n        => a -> Assoc a -> UniqSet a\n\ncloseAssoc a assoc\n =      closeAssoc' assoc emptyUniqSet (unitUniqSet a)\n where\n        closeAssoc' assoc visited toVisit\n         = case nonDetEltsUniqSet toVisit of\n             -- See Note [Unique Determinism and code generation]\n\n                -- nothing else to visit, we're done\n                []      -> visited\n\n                (x:_)\n                 -- we've already seen this node\n                 |  elementOfUniqSet x visited\n                 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)\n\n                 -- haven't seen this node before,\n                 --     remember to visit all its neighbors\n                 |  otherwise\n                 -> let neighbors\n                         = case lookupUFM assoc x of\n                                Nothing         -> emptyUniqSet\n                                Just set        -> set\n\n                   in closeAssoc' assoc\n                        (addOneToUniqSet visited x)\n                        (unionUniqSets   toVisit neighbors)\n\n-- | Intersect two associations.\nintersectAssoc :: Assoc a -> Assoc a -> Assoc a\nintersectAssoc a b\n        = intersectUFM_C (intersectUniqSets) a b\n\n", "num_lines": 615}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule RegAlloc.Graph.SpillCost (\n        SpillCostRecord,\n        plusSpillCostRecord,\n        pprSpillCostRecord,\n\n        SpillCostInfo,\n        zeroSpillCostInfo,\n        plusSpillCostInfo,\n\n        slurpSpillCostInfo,\n        chooseSpill,\n\n        lifeMapFromSpillCostInfo\n) where\nimport GhcPrelude\n\nimport RegAlloc.Liveness\nimport Instruction\nimport RegClass\nimport Reg\n\nimport GraphBase\n\nimport Hoopl.Collections (mapLookup)\nimport Cmm\nimport UniqFM\nimport UniqSet\nimport Digraph          (flattenSCCs)\nimport Outputable\nimport Platform\nimport State\nimport CFG\n\nimport Data.List        (nub, minimumBy)\nimport Data.Maybe\nimport Control.Monad (join)\n\n\n-- | Records the expected cost to spill some regster.\ntype SpillCostRecord\n =      ( VirtualReg    -- register name\n        , Int           -- number of writes to this reg\n        , Int           -- number of reads from this reg\n        , Int)          -- number of instrs this reg was live on entry to\n\n\n-- | Map of `SpillCostRecord`\ntype SpillCostInfo\n        = UniqFM SpillCostRecord\n\n-- | Block membership in a loop\ntype LoopMember = Bool\n\ntype SpillCostState = State (UniqFM SpillCostRecord) ()\n\n-- | An empty map of spill costs.\nzeroSpillCostInfo :: SpillCostInfo\nzeroSpillCostInfo       = emptyUFM\n\n\n-- | Add two spill cost infos.\nplusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo\nplusSpillCostInfo sc1 sc2\n        = plusUFM_C plusSpillCostRecord sc1 sc2\n\n\n-- | Add two spill cost records.\nplusSpillCostRecord :: SpillCostRecord -> SpillCostRecord -> SpillCostRecord\nplusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)\n        | r1 == r2      = (r1, a1 + a2, b1 + b2, c1 + c2)\n        | otherwise     = error \"RegSpillCost.plusRegInt: regs don't match\"\n\n\n-- | Slurp out information used for determining spill costs.\n--\n--   For each vreg, the number of times it was written to, read from,\n--   and the number of instructions it was live on entry to (lifetime)\n--\nslurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr)\n                   => Platform\n                   -> Maybe CFG\n                   -> LiveCmmDecl statics instr\n                   -> SpillCostInfo\n\nslurpSpillCostInfo platform cfg cmm\n        = execState (countCmm cmm) zeroSpillCostInfo\n where\n        countCmm CmmData{}              = return ()\n        countCmm (CmmProc info _ _ sccs)\n                = mapM_ (countBlock info)\n                $ flattenSCCs sccs\n\n        -- Lookup the regs that are live on entry to this block in\n        --      the info table from the CmmProc.\n        countBlock info (BasicBlock blockId instrs)\n                | LiveInfo _ _ blockLive _ <- info\n                , Just rsLiveEntry  <- mapLookup blockId blockLive\n                , rsLiveEntry_virt  <- takeVirtuals rsLiveEntry\n                = countLIs (loopMember blockId) rsLiveEntry_virt instrs\n\n                | otherwise\n                = error \"RegAlloc.SpillCost.slurpSpillCostInfo: bad block\"\n\n        countLIs :: LoopMember -> UniqSet VirtualReg -> [LiveInstr instr] -> SpillCostState\n        countLIs _      _      []\n                = return ()\n\n        -- Skip over comment and delta pseudo instrs.\n        countLIs inLoop rsLive (LiveInstr instr Nothing : lis)\n                | isMetaInstr instr\n                = countLIs inLoop rsLive lis\n\n                | otherwise\n                = pprPanic \"RegSpillCost.slurpSpillCostInfo\"\n                $ text \"no liveness information on instruction \" <> ppr instr\n\n        countLIs inLoop rsLiveEntry (LiveInstr instr (Just live) : lis)\n         = do\n                -- Increment the lifetime counts for regs live on entry to this instr.\n                mapM_ (incLifetime (loopCount inLoop)) $ nonDetEltsUniqSet rsLiveEntry\n                    -- This is non-deterministic but we do not\n                    -- currently support deterministic code-generation.\n                    -- See Note [Unique Determinism and code generation]\n\n                -- Increment counts for what regs were read/written from.\n                let (RU read written)   = regUsageOfInstr platform instr\n                mapM_ (incUses (loopCount inLoop)) $ catMaybes $ map takeVirtualReg $ nub read\n                mapM_ (incDefs (loopCount inLoop)) $ catMaybes $ map takeVirtualReg $ nub written\n\n                -- Compute liveness for entry to next instruction.\n                let liveDieRead_virt    = takeVirtuals (liveDieRead  live)\n                let liveDieWrite_virt   = takeVirtuals (liveDieWrite live)\n                let liveBorn_virt       = takeVirtuals (liveBorn     live)\n\n                let rsLiveAcross\n                        = rsLiveEntry `minusUniqSet` liveDieRead_virt\n\n                let rsLiveNext\n                        = (rsLiveAcross `unionUniqSets` liveBorn_virt)\n                                        `minusUniqSet`  liveDieWrite_virt\n\n                countLIs inLoop rsLiveNext lis\n\n        loopCount inLoop\n          | inLoop = 10\n          | otherwise = 1\n        incDefs     count reg = modify $ \\s -> addToUFM_C plusSpillCostRecord s reg (reg, count, 0, 0)\n        incUses     count reg = modify $ \\s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, count, 0)\n        incLifetime count reg = modify $ \\s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, count)\n\n        loopBlocks = CFG.loopMembers <$> cfg\n        loopMember bid\n          | Just isMember <- join (mapLookup bid <$> loopBlocks)\n          = isMember\n          | otherwise\n          = False\n\n-- | Take all the virtual registers from this set.\ntakeVirtuals :: UniqSet Reg -> UniqSet VirtualReg\ntakeVirtuals set = mkUniqSet\n  [ vr | RegVirtual vr <- nonDetEltsUniqSet set ]\n  -- See Note [Unique Determinism and code generation]\n\n\n-- | Choose a node to spill from this graph\nchooseSpill\n        :: SpillCostInfo\n        -> Graph VirtualReg RegClass RealReg\n        -> VirtualReg\n\nchooseSpill info graph\n = let  cost    = spillCost_length info graph\n        node    = minimumBy (\\n1 n2 -> compare (cost $ nodeId n1) (cost $ nodeId n2))\n                $ nonDetEltsUFM $ graphMap graph\n                -- See Note [Unique Determinism and code generation]\n\n   in   nodeId node\n\n\n-------------------------------------------------------------------------------\n-- | Chaitins spill cost function is:\n--\n--   cost =     sum         loadCost * freq (u)  +    sum        storeCost * freq (d)\n--          u <- uses (v)                         d <- defs (v)\n--\n--   There are no loops in our code at the moment, so we can set the freq's to 1.\n--\n--  If we don't have live range splitting then Chaitins function performs badly\n--  if we have lots of nested live ranges and very few registers.\n--\n--               v1 v2 v3\n--      def v1   .\n--      use v1   .\n--      def v2   .  .\n--      def v3   .  .  .\n--      use v1   .  .  .\n--      use v3   .  .  .\n--      use v2   .  .\n--      use v1   .\n--\n--           defs uses degree   cost\n--      v1:  1     3     3      1.5\n--      v2:  1     2     3      1.0\n--      v3:  1     1     3      0.666\n--\n--   v3 has the lowest cost, but if we only have 2 hardregs and we insert\n--   spill code for v3 then this isn't going to improve the colorability of\n--   the graph.\n--\n--  When compiling SHA1, which as very long basic blocks and some vregs\n--  with very long live ranges the allocator seems to try and spill from\n--  the inside out and eventually run out of stack slots.\n--\n--  Without live range splitting, its's better to spill from the outside\n--  in so set the cost of very long live ranges to zero\n--\n{-\nspillCost_chaitin\n        :: SpillCostInfo\n        -> Graph Reg RegClass Reg\n        -> Reg\n        -> Float\n\nspillCost_chaitin info graph reg\n        -- Spilling a live range that only lives for 1 instruction\n        -- isn't going to help us at all - and we definitely want to avoid\n        -- trying to re-spill previously inserted spill code.\n        | lifetime <= 1         = 1/0\n\n        -- It's unlikely that we'll find a reg for a live range this long\n        -- better to spill it straight up and not risk trying to keep it around\n        -- and have to go through the build/color cycle again.\n        | lifetime > allocatableRegsInClass (regClass reg) * 10\n        = 0\n\n        -- Otherwise revert to chaitin's regular cost function.\n        | otherwise     = fromIntegral (uses + defs)\n                        / fromIntegral (nodeDegree graph reg)\n        where (_, defs, uses, lifetime)\n                = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg\n-}\n\n-- Just spill the longest live range.\nspillCost_length\n        :: SpillCostInfo\n        -> Graph VirtualReg RegClass RealReg\n        -> VirtualReg\n        -> Float\n\nspillCost_length info _ reg\n        | lifetime <= 1         = 1/0\n        | otherwise             = 1 / fromIntegral lifetime\n        where (_, _, _, lifetime)\n                = fromMaybe (reg, 0, 0, 0)\n                $ lookupUFM info reg\n\n\n-- | Extract a map of register lifetimes from a `SpillCostInfo`.\nlifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)\nlifeMapFromSpillCostInfo info\n        = listToUFM\n        $ map (\\(r, _, _, life) -> (r, (r, life)))\n        $ nonDetEltsUFM info\n        -- See Note [Unique Determinism and code generation]\n\n\n-- | Determine the degree (number of neighbors) of this node which\n--   have the same class.\nnodeDegree\n        :: (VirtualReg -> RegClass)\n        -> Graph VirtualReg RegClass RealReg\n        -> VirtualReg\n        -> Int\n\nnodeDegree classOfVirtualReg graph reg\n        | Just node     <- lookupUFM (graphMap graph) reg\n\n        , virtConflicts\n           <- length\n           $ filter (\\r -> classOfVirtualReg r == classOfVirtualReg reg)\n           $ nonDetEltsUniqSet\n           -- See Note [Unique Determinism and code generation]\n           $ nodeConflicts node\n\n        = virtConflicts + sizeUniqSet (nodeExclusions node)\n\n        | otherwise\n        = 0\n\n\n-- | Show a spill cost record, including the degree from the graph\n--   and final calulated spill cost.\npprSpillCostRecord\n        :: (VirtualReg -> RegClass)\n        -> (Reg -> SDoc)\n        -> Graph VirtualReg RegClass RealReg\n        -> SpillCostRecord\n        -> SDoc\n\npprSpillCostRecord regClass pprReg graph (reg, uses, defs, life)\n        =  hsep\n        [ pprReg (RegVirtual reg)\n        , ppr uses\n        , ppr defs\n        , ppr life\n        , ppr $ nodeDegree regClass graph reg\n        , text $ show $ (fromIntegral (uses + defs)\n                       / fromIntegral (nodeDegree regClass graph reg) :: Float) ]\n\n", "num_lines": 311}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP #-}\n\n-- | Carries interesting info for debugging / profiling of the\n--   graph coloring register allocator.\nmodule RegAlloc.Graph.Stats (\n        RegAllocStats (..),\n\n        pprStats,\n        pprStatsSpills,\n        pprStatsLifetimes,\n        pprStatsConflict,\n        pprStatsLifeConflict,\n\n        countSRMs, addSRM\n) where\n\n#include \"nativeGen/NCG.h\"\n\nimport GhcPrelude\n\nimport qualified GraphColor as Color\nimport RegAlloc.Liveness\nimport RegAlloc.Graph.Spill\nimport RegAlloc.Graph.SpillCost\nimport RegAlloc.Graph.TrivColorable\nimport Instruction\nimport RegClass\nimport Reg\nimport TargetReg\n\nimport PprCmm()\nimport Outputable\nimport UniqFM\nimport UniqSet\nimport State\n\n-- | Holds interesting statistics from the register allocator.\ndata RegAllocStats statics instr\n\n        -- Information about the initial conflict graph.\n        = RegAllocStatsStart\n        { -- | Initial code, with liveness.\n          raLiveCmm     :: [LiveCmmDecl statics instr]\n\n          -- | The initial, uncolored graph.\n        , raGraph       :: Color.Graph VirtualReg RegClass RealReg\n\n          -- | Information to help choose which regs to spill.\n        , raSpillCosts  :: SpillCostInfo }\n\n\n        -- Information about an intermediate graph.\n        -- This is one that we couldn't color, so had to insert spill code\n        -- instruction stream.\n        | RegAllocStatsSpill\n        { -- | Code we tried to allocate registers for.\n          raCode        :: [LiveCmmDecl statics instr]\n\n          -- | Partially colored graph.\n        , raGraph       :: Color.Graph VirtualReg RegClass RealReg\n\n          -- | The regs that were coalesced.\n        , raCoalesced   :: UniqFM VirtualReg\n\n          -- | Spiller stats.\n        , raSpillStats  :: SpillStats\n\n          -- | Number of instructions each reg lives for.\n        , raSpillCosts  :: SpillCostInfo\n\n          -- | Code with spill instructions added.\n        , raSpilled     :: [LiveCmmDecl statics instr] }\n\n\n        -- a successful coloring\n        | RegAllocStatsColored\n        { -- | Code we tried to allocate registers for.\n          raCode          :: [LiveCmmDecl statics instr]\n\n          -- | Uncolored graph.\n        , raGraph         :: Color.Graph VirtualReg RegClass RealReg\n\n          -- | Coalesced and colored graph.\n        , raGraphColored  :: Color.Graph VirtualReg RegClass RealReg\n\n          -- | Regs that were coalesced.\n        , raCoalesced     :: UniqFM VirtualReg\n\n          -- | Code with coalescings applied.\n        , raCodeCoalesced :: [LiveCmmDecl statics instr]\n\n          -- | Code with vregs replaced by hregs.\n        , raPatched       :: [LiveCmmDecl statics instr]\n\n          -- | Code with unneeded spill\\/reloads cleaned out.\n        , raSpillClean    :: [LiveCmmDecl statics instr]\n\n          -- | Final code.\n        , raFinal         :: [NatCmmDecl statics instr]\n\n          -- | Spill\\/reload\\/reg-reg moves present in this code.\n        , raSRMs          :: (Int, Int, Int) }\n\n\ninstance (Outputable statics, Outputable instr)\n       => Outputable (RegAllocStats statics instr) where\n\n ppr (s@RegAllocStatsStart{}) = sdocWithPlatform $ \\platform ->\n           text \"#  Start\"\n        $$ text \"#  Native code with liveness information.\"\n        $$ ppr (raLiveCmm s)\n        $$ text \"\"\n        $$ text \"#  Initial register conflict graph.\"\n        $$ Color.dotGraph\n                (targetRegDotColor platform)\n                (trivColorable platform\n                        (targetVirtualRegSqueeze platform)\n                        (targetRealRegSqueeze platform))\n                (raGraph s)\n\n\n ppr (s@RegAllocStatsSpill{}) =\n           text \"#  Spill\"\n\n        $$ text \"#  Code with liveness information.\"\n        $$ ppr (raCode s)\n        $$ text \"\"\n\n        $$ (if (not $ isNullUFM $ raCoalesced s)\n                then    text \"#  Registers coalesced.\"\n                        $$ pprUFMWithKeys (raCoalesced s) (vcat . map ppr)\n                        $$ text \"\"\n                else empty)\n\n        $$ text \"#  Spills inserted.\"\n        $$ ppr (raSpillStats s)\n        $$ text \"\"\n\n        $$ text \"#  Code with spills inserted.\"\n        $$ ppr (raSpilled s)\n\n\n ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })\n    = sdocWithPlatform $ \\platform ->\n           text \"#  Colored\"\n\n        $$ text \"#  Code with liveness information.\"\n        $$ ppr (raCode s)\n        $$ text \"\"\n\n        $$ text \"#  Register conflict graph (colored).\"\n        $$ Color.dotGraph\n                (targetRegDotColor platform)\n                (trivColorable platform\n                        (targetVirtualRegSqueeze platform)\n                        (targetRealRegSqueeze platform))\n                (raGraphColored s)\n        $$ text \"\"\n\n        $$ (if (not $ isNullUFM $ raCoalesced s)\n                then    text \"#  Registers coalesced.\"\n                        $$ pprUFMWithKeys (raCoalesced s) (vcat . map ppr)\n                        $$ text \"\"\n                else empty)\n\n        $$ text \"#  Native code after coalescings applied.\"\n        $$ ppr (raCodeCoalesced s)\n        $$ text \"\"\n\n        $$ text \"#  Native code after register allocation.\"\n        $$ ppr (raPatched s)\n        $$ text \"\"\n\n        $$ text \"#  Clean out unneeded spill/reloads.\"\n        $$ ppr (raSpillClean s)\n        $$ text \"\"\n\n        $$ text \"#  Final code, after rewriting spill/rewrite pseudo instrs.\"\n        $$ ppr (raFinal s)\n        $$ text \"\"\n        $$  text \"#  Score:\"\n        $$ (text \"#          spills  inserted: \" <> int spills)\n        $$ (text \"#          reloads inserted: \" <> int reloads)\n        $$ (text \"#   reg-reg moves remaining: \" <> int moves)\n        $$ text \"\"\n\n\n-- | Do all the different analysis on this list of RegAllocStats\npprStats\n        :: [RegAllocStats statics instr]\n        -> Color.Graph VirtualReg RegClass RealReg\n        -> SDoc\n\npprStats stats graph\n = let  outSpills       = pprStatsSpills    stats\n        outLife         = pprStatsLifetimes stats\n        outConflict     = pprStatsConflict  stats\n        outScatter      = pprStatsLifeConflict stats graph\n\n  in    vcat [outSpills, outLife, outConflict, outScatter]\n\n\n-- | Dump a table of how many spill loads \\/ stores were inserted for each vreg.\npprStatsSpills\n        :: [RegAllocStats statics instr] -> SDoc\n\npprStatsSpills stats\n = let\n        finals  = [ s   | s@RegAllocStatsColored{} <- stats]\n\n        -- sum up how many stores\\/loads\\/reg-reg-moves were left in the code\n        total   = foldl' addSRM (0, 0, 0)\n                $ map raSRMs finals\n\n    in  (  text \"-- spills-added-total\"\n        $$ text \"--    (stores, loads, reg_reg_moves_remaining)\"\n        $$ ppr total\n        $$ text \"\")\n\n\n-- | Dump a table of how long vregs tend to live for in the initial code.\npprStatsLifetimes\n        :: [RegAllocStats statics instr] -> SDoc\n\npprStatsLifetimes stats\n = let  info            = foldl' plusSpillCostInfo zeroSpillCostInfo\n                                [ raSpillCosts s\n                                        | s@RegAllocStatsStart{} <- stats ]\n\n        lifeBins        = binLifetimeCount $ lifeMapFromSpillCostInfo info\n\n   in   (  text \"-- vreg-population-lifetimes\"\n        $$ text \"--   (instruction_count, number_of_vregs_that_lived_that_long)\"\n        $$ pprUFM lifeBins (vcat . map ppr)\n        $$ text \"\\n\")\n\n\nbinLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)\nbinLifetimeCount fm\n = let  lifes   = map (\\l -> (l, (l, 1)))\n                $ map snd\n                $ nonDetEltsUFM fm\n                -- See Note [Unique Determinism and code generation]\n\n   in   addListToUFM_C\n                (\\(l1, c1) (_, c2) -> (l1, c1 + c2))\n                emptyUFM\n                lifes\n\n\n-- | Dump a table of how many conflicts vregs tend to have in the initial code.\npprStatsConflict\n        :: [RegAllocStats statics instr] -> SDoc\n\npprStatsConflict stats\n = let  confMap = foldl' (plusUFM_C (\\(c1, n1) (_, n2) -> (c1, n1 + n2)))\n                        emptyUFM\n                $ map Color.slurpNodeConflictCount\n                        [ raGraph s | s@RegAllocStatsStart{} <- stats ]\n\n   in   (  text \"-- vreg-conflicts\"\n        $$ text \"--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)\"\n        $$ pprUFM confMap (vcat . map ppr)\n        $$ text \"\\n\")\n\n\n-- | For every vreg, dump how many conflicts it has, and its lifetime.\n--      Good for making a scatter plot.\npprStatsLifeConflict\n        :: [RegAllocStats statics instr]\n        -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph\n        -> SDoc\n\npprStatsLifeConflict stats graph\n = let  lifeMap = lifeMapFromSpillCostInfo\n                $ foldl' plusSpillCostInfo zeroSpillCostInfo\n                $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]\n\n        scatter = map   (\\r ->  let lifetime  = case lookupUFM lifeMap r of\n                                                      Just (_, l) -> l\n                                                      Nothing     -> 0\n                                    Just node = Color.lookupNode graph r\n                                in parens $ hcat $ punctuate (text \", \")\n                                        [ doubleQuotes $ ppr $ Color.nodeId node\n                                        , ppr $ sizeUniqSet (Color.nodeConflicts node)\n                                        , ppr $ lifetime ])\n                $ map Color.nodeId\n                $ nonDetEltsUFM\n                -- See Note [Unique Determinism and code generation]\n                $ Color.graphMap graph\n\n   in   (  text \"-- vreg-conflict-lifetime\"\n        $$ text \"--   (vreg, vreg_conflicts, vreg_lifetime)\"\n        $$ (vcat scatter)\n        $$ text \"\\n\")\n\n\n-- | Count spill/reload/reg-reg moves.\n--      Lets us see how well the register allocator has done.\ncountSRMs\n        :: Instruction instr\n        => LiveCmmDecl statics instr -> (Int, Int, Int)\n\ncountSRMs cmm\n        = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)\n\n\ncountSRM_block\n        :: Instruction instr\n        => GenBasicBlock (LiveInstr instr)\n        -> State (Int, Int, Int) (GenBasicBlock (LiveInstr instr))\n\ncountSRM_block (BasicBlock i instrs)\n = do   instrs' <- mapM countSRM_instr instrs\n        return  $ BasicBlock i instrs'\n\n\ncountSRM_instr\n        :: Instruction instr\n        => LiveInstr instr -> State (Int, Int, Int) (LiveInstr instr)\n\ncountSRM_instr li\n        | LiveInstr SPILL{} _    <- li\n        = do    modify  $ \\(s, r, m)    -> (s + 1, r, m)\n                return li\n\n        | LiveInstr RELOAD{} _  <- li\n        = do    modify  $ \\(s, r, m)    -> (s, r + 1, m)\n                return li\n\n        | LiveInstr instr _     <- li\n        , Just _        <- takeRegRegMoveInstr instr\n        = do    modify  $ \\(s, r, m)    -> (s, r, m + 1)\n                return li\n\n        | otherwise\n        =       return li\n\n\n-- sigh..\naddSRM :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)\naddSRM (s1, r1, m1) (s2, r2, m2)\n = let  !s = s1 + s2\n        !r = r1 + r2\n        !m = m1 + m2\n   in   (s, r, m)\n\n", "num_lines": 348}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule RegAlloc.Graph.TrivColorable (\n        trivColorable,\n)\n\nwhere\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport RegClass\nimport Reg\n\nimport GraphBase\n\nimport UniqSet\nimport Platform\nimport Panic\n\n-- trivColorable ---------------------------------------------------------------\n\n-- trivColorable function for the graph coloring allocator\n--\n--      This gets hammered by scanGraph during register allocation,\n--      so needs to be fairly efficient.\n--\n--      NOTE:   This only works for arcitectures with just RcInteger and RcDouble\n--              (which are disjoint) ie. x86, x86_64 and ppc\n--\n--      The number of allocatable regs is hard coded in here so we can do\n--              a fast comparison in trivColorable.\n--\n--      It's ok if these numbers are _less_ than the actual number of free\n--              regs, but they can't be more or the register conflict\n--              graph won't color.\n--\n--      If the graph doesn't color then the allocator will panic, but it won't\n--              generate bad object code or anything nasty like that.\n--\n--      There is an allocatableRegsInClass :: RegClass -> Int, but doing\n--      the unboxing is too slow for us here.\n--      TODO: Is that still true? Could we use allocatableRegsInClass\n--      without losing performance now?\n--\n--      Look at includes/stg/MachRegs.h to get the numbers.\n--\n\n\n-- Disjoint registers ----------------------------------------------------------\n--\n--      The definition has been unfolded into individual cases for speed.\n--      Each architecture has a different register setup, so we use a\n--      different regSqueeze function for each.\n--\naccSqueeze\n        :: Int\n        -> Int\n        -> (reg -> Int)\n        -> UniqSet reg\n        -> Int\n\naccSqueeze count maxCount squeeze us = acc count (nonDetEltsUniqSet us)\n  -- See Note [Unique Determinism and code generation]\n  where acc count [] = count\n        acc count _ | count >= maxCount = count\n        acc count (r:rs) = acc (count + squeeze r) rs\n\n{- Note [accSqueeze]\n~~~~~~~~~~~~~~~~~~~~\nBL 2007/09\nDoing a nice fold over the UniqSet makes trivColorable use\n32% of total compile time and 42% of total alloc when compiling SHA1.hs from darcs.\nTherefore the UniqFM is made non-abstract and we use custom fold.\n\nMS 2010/04\nWhen converting UniqFM to use Data.IntMap, the fold cannot use UniqFM internal\nrepresentation any more. But it is imperative that the accSqueeze stops\nthe folding if the count gets greater or equal to maxCount. We thus convert\nUniqFM to a (lazy) list, do the fold and stops if necessary, which was\nthe most efficient variant tried. Benchmark compiling 10-times SHA1.hs follows.\n(original = previous implementation, folding = fold of the whole UFM,\n lazyFold = the current implementation,\n hackFold = using internal representation of Data.IntMap)\n\n                                 original  folding   hackFold  lazyFold\n -O -fasm (used everywhere)      31.509s   30.387s   30.791s   30.603s\n                                 100.00%   96.44%    97.72%    97.12%\n -fregs-graph                    67.938s   74.875s   62.673s   64.679s\n                                 100.00%   110.21%   92.25%    95.20%\n -fregs-iterative                89.761s   143.913s  81.075s   86.912s\n                                 100.00%   160.33%   90.32%    96.83%\n -fnew-codegen                   38.225s   37.142s   37.551s   37.119s\n                                 100.00%   97.17%    98.24%    97.11%\n -fnew-codegen -fregs-graph      91.786s   91.51s    87.368s   86.88s\n                                 100.00%   99.70%    95.19%    94.65%\n -fnew-codegen -fregs-iterative  206.72s   343.632s  194.694s  208.677s\n                                 100.00%   166.23%   94.18%    100.95%\n-}\n\ntrivColorable\n        :: Platform\n        -> (RegClass -> VirtualReg -> Int)\n        -> (RegClass -> RealReg    -> Int)\n        -> Triv VirtualReg RegClass RealReg\n\ntrivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions\n        | let cALLOCATABLE_REGS_INTEGER\n                  =        (case platformArch platform of\n                            ArchX86       -> 3\n                            ArchX86_64    -> 5\n                            ArchPPC       -> 16\n                            ArchSPARC     -> 14\n                            ArchSPARC64   -> panic \"trivColorable ArchSPARC64\"\n                            ArchPPC_64 _  -> 15\n                            ArchARM _ _ _ -> panic \"trivColorable ArchARM\"\n                            ArchARM64     -> panic \"trivColorable ArchARM64\"\n                            ArchAlpha     -> panic \"trivColorable ArchAlpha\"\n                            ArchMipseb    -> panic \"trivColorable ArchMipseb\"\n                            ArchMipsel    -> panic \"trivColorable ArchMipsel\"\n                            ArchJavaScript-> panic \"trivColorable ArchJavaScript\"\n                            ArchUnknown   -> panic \"trivColorable ArchUnknown\")\n        , count2        <- accSqueeze 0 cALLOCATABLE_REGS_INTEGER\n                                (virtualRegSqueeze RcInteger)\n                                conflicts\n\n        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_INTEGER\n                                (realRegSqueeze   RcInteger)\n                                exclusions\n\n        = count3 < cALLOCATABLE_REGS_INTEGER\n\ntrivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions\n        | let cALLOCATABLE_REGS_FLOAT\n                  =        (case platformArch platform of\n                            ArchX86       -> 0\n                            ArchX86_64    -> 0\n                            ArchPPC       -> 0\n                            ArchSPARC     -> 22\n                            ArchSPARC64   -> panic \"trivColorable ArchSPARC64\"\n                            ArchPPC_64 _  -> 0\n                            ArchARM _ _ _ -> panic \"trivColorable ArchARM\"\n                            ArchARM64     -> panic \"trivColorable ArchARM64\"\n                            ArchAlpha     -> panic \"trivColorable ArchAlpha\"\n                            ArchMipseb    -> panic \"trivColorable ArchMipseb\"\n                            ArchMipsel    -> panic \"trivColorable ArchMipsel\"\n                            ArchJavaScript-> panic \"trivColorable ArchJavaScript\"\n                            ArchUnknown   -> panic \"trivColorable ArchUnknown\")\n        , count2        <- accSqueeze 0 cALLOCATABLE_REGS_FLOAT\n                                (virtualRegSqueeze RcFloat)\n                                conflicts\n\n        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_FLOAT\n                                (realRegSqueeze   RcFloat)\n                                exclusions\n\n        = count3 < cALLOCATABLE_REGS_FLOAT\n\ntrivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions\n        | let cALLOCATABLE_REGS_DOUBLE\n                  =        (case platformArch platform of\n                            ArchX86       -> 6\n                            ArchX86_64    -> 0\n                            ArchPPC       -> 26\n                            ArchSPARC     -> 11\n                            ArchSPARC64   -> panic \"trivColorable ArchSPARC64\"\n                            ArchPPC_64 _  -> 20\n                            ArchARM _ _ _ -> panic \"trivColorable ArchARM\"\n                            ArchARM64     -> panic \"trivColorable ArchARM64\"\n                            ArchAlpha     -> panic \"trivColorable ArchAlpha\"\n                            ArchMipseb    -> panic \"trivColorable ArchMipseb\"\n                            ArchMipsel    -> panic \"trivColorable ArchMipsel\"\n                            ArchJavaScript-> panic \"trivColorable ArchJavaScript\"\n                            ArchUnknown   -> panic \"trivColorable ArchUnknown\")\n        , count2        <- accSqueeze 0 cALLOCATABLE_REGS_DOUBLE\n                                (virtualRegSqueeze RcDouble)\n                                conflicts\n\n        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_DOUBLE\n                                (realRegSqueeze   RcDouble)\n                                exclusions\n\n        = count3 < cALLOCATABLE_REGS_DOUBLE\n\ntrivColorable platform virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts exclusions\n        | let cALLOCATABLE_REGS_SSE\n                  =        (case platformArch platform of\n                            ArchX86       -> 8\n                            ArchX86_64    -> 10\n                            ArchPPC       -> 0\n                            ArchSPARC     -> 0\n                            ArchSPARC64   -> panic \"trivColorable ArchSPARC64\"\n                            ArchPPC_64 _  -> 0\n                            ArchARM _ _ _ -> panic \"trivColorable ArchARM\"\n                            ArchARM64     -> panic \"trivColorable ArchARM64\"\n                            ArchAlpha     -> panic \"trivColorable ArchAlpha\"\n                            ArchMipseb    -> panic \"trivColorable ArchMipseb\"\n                            ArchMipsel    -> panic \"trivColorable ArchMipsel\"\n                            ArchJavaScript-> panic \"trivColorable ArchJavaScript\"\n                            ArchUnknown   -> panic \"trivColorable ArchUnknown\")\n        , count2        <- accSqueeze 0 cALLOCATABLE_REGS_SSE\n                                (virtualRegSqueeze RcDoubleSSE)\n                                conflicts\n\n        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_SSE\n                                (realRegSqueeze   RcDoubleSSE)\n                                exclusions\n\n        = count3 < cALLOCATABLE_REGS_SSE\n\n\n-- Specification Code ----------------------------------------------------------\n--\n--      The trivColorable function for each particular architecture should\n--      implement the following function, but faster.\n--\n\n{-\ntrivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool\ntrivColorable classN conflicts exclusions\n = let\n\n        acc :: Reg -> (Int, Int) -> (Int, Int)\n        acc r (cd, cf)\n         = case regClass r of\n                RcInteger       -> (cd+1, cf)\n                RcFloat         -> (cd,   cf+1)\n                _               -> panic \"Regs.trivColorable: reg class not handled\"\n\n        tmp                     = nonDetFoldUFM acc (0, 0) conflicts\n        (countInt,  countFloat) = nonDetFoldUFM acc tmp    exclusions\n\n        squeese         = worst countInt   classN RcInteger\n                        + worst countFloat classN RcFloat\n\n   in   squeese < allocatableRegsInClass classN\n\n-- | Worst case displacement\n--      node N of classN has n neighbors of class C.\n--\n--      We currently only have RcInteger and RcDouble, which don't conflict at all.\n--      This is a bit boring compared to what's in RegArchX86.\n--\nworst :: Int -> RegClass -> RegClass -> Int\nworst n classN classC\n = case classN of\n        RcInteger\n         -> case classC of\n                RcInteger       -> min n (allocatableRegsInClass RcInteger)\n                RcFloat         -> 0\n\n        RcDouble\n         -> case classC of\n                RcFloat         -> min n (allocatableRegsInClass RcFloat)\n                RcInteger       -> 0\n\n-- allocatableRegs is allMachRegNos with the fixed-use regs removed.\n-- i.e., these are the regs for which we are prepared to allow the\n-- register allocator to attempt to map VRegs to.\nallocatableRegs :: [RegNo]\nallocatableRegs\n   = let isFree i = freeReg i\n     in  filter isFree allMachRegNos\n\n\n-- | The number of regs in each class.\n--      We go via top level CAFs to ensure that we're not recomputing\n--      the length of these lists each time the fn is called.\nallocatableRegsInClass :: RegClass -> Int\nallocatableRegsInClass cls\n = case cls of\n        RcInteger       -> allocatableRegsInteger\n        RcFloat         -> allocatableRegsDouble\n\nallocatableRegsInteger :: Int\nallocatableRegsInteger\n        = length $ filter (\\r -> regClass r == RcInteger)\n                 $ map RealReg allocatableRegs\n\nallocatableRegsFloat :: Int\nallocatableRegsFloat\n        = length $ filter (\\r -> regClass r == RcFloat\n                 $ map RealReg allocatableRegs\n-}\n", "num_lines": 286}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Put common type definitions here to break recursive module dependencies.\n\nmodule RegAlloc.Linear.Base (\n        BlockAssignment,\n\n        Loc(..),\n        regsOfLoc,\n\n        -- for stats\n        SpillReason(..),\n        RegAllocStats(..),\n\n        -- the allocator monad\n        RA_State(..),\n)\n\nwhere\n\nimport GhcPrelude\n\nimport RegAlloc.Linear.StackMap\nimport RegAlloc.Liveness\nimport Reg\n\nimport DynFlags\nimport Outputable\nimport Unique\nimport UniqFM\nimport UniqSupply\nimport BlockId\n\n\n-- | Used to store the register assignment on entry to a basic block.\n--      We use this to handle join points, where multiple branch instructions\n--      target a particular label. We have to insert fixup code to make\n--      the register assignments from the different sources match up.\n--\ntype BlockAssignment freeRegs\n        = BlockMap (freeRegs, RegMap Loc)\n\n\n-- | Where a vreg is currently stored\n--      A temporary can be marked as living in both a register and memory\n--      (InBoth), for example if it was recently loaded from a spill location.\n--      This makes it cheap to spill (no save instruction required), but we\n--      have to be careful to turn this into InReg if the value in the\n--      register is changed.\n\n--      This is also useful when a temporary is about to be clobbered.  We\n--      save it in a spill location, but mark it as InBoth because the current\n--      instruction might still want to read it.\n--\ndata Loc\n        -- | vreg is in a register\n        = InReg   !RealReg\n\n        -- | vreg is held in a stack slot\n        | InMem   {-# UNPACK #-}  !StackSlot\n\n\n        -- | vreg is held in both a register and a stack slot\n        | InBoth   !RealReg\n                   {-# UNPACK #-} !StackSlot\n        deriving (Eq, Show, Ord)\n\ninstance Outputable Loc where\n        ppr l = text (show l)\n\n\n-- | Get the reg numbers stored in this Loc.\nregsOfLoc :: Loc -> [RealReg]\nregsOfLoc (InReg r)    = [r]\nregsOfLoc (InBoth r _) = [r]\nregsOfLoc (InMem _)    = []\n\n\n-- | Reasons why instructions might be inserted by the spiller.\n--      Used when generating stats for -ddrop-asm-stats.\n--\ndata SpillReason\n        -- | vreg was spilled to a slot so we could use its\n        --      current hreg for another vreg\n        = SpillAlloc    !Unique\n\n        -- | vreg was moved because its hreg was clobbered\n        | SpillClobber  !Unique\n\n        -- | vreg was loaded from a spill slot\n        | SpillLoad     !Unique\n\n        -- | reg-reg move inserted during join to targets\n        | SpillJoinRR   !Unique\n\n        -- | reg-mem move inserted during join to targets\n        | SpillJoinRM   !Unique\n\n\n-- | Used to carry interesting stats out of the register allocator.\ndata RegAllocStats\n        = RegAllocStats\n        { ra_spillInstrs        :: UniqFM [Int]\n        , ra_fixupList     :: [(BlockId,BlockId,BlockId)]\n        -- ^ (from,fixup,to) : We inserted fixup code between from and to\n        }\n\n\n-- | The register allocator state\ndata RA_State freeRegs\n        = RA_State\n\n        {\n        -- | the current mapping from basic blocks to\n        --      the register assignments at the beginning of that block.\n          ra_blockassig :: BlockAssignment freeRegs\n\n        -- | free machine registers\n        , ra_freeregs   :: !freeRegs\n\n        -- | assignment of temps to locations\n        , ra_assig      :: RegMap Loc\n\n        -- | current stack delta\n        , ra_delta      :: Int\n\n        -- | free stack slots for spilling\n        , ra_stack      :: StackMap\n\n        -- | unique supply for generating names for join point fixup blocks.\n        , ra_us         :: UniqSupply\n\n        -- | Record why things were spilled, for -ddrop-asm-stats.\n        --      Just keep a list here instead of a map of regs -> reasons.\n        --      We don't want to slow down the allocator if we're not going to emit the stats.\n        , ra_spills     :: [SpillReason]\n        , ra_DynFlags   :: DynFlags\n\n        -- | (from,fixup,to) : We inserted fixup code between from and to\n        , ra_fixups     :: [(BlockId,BlockId,BlockId)] }\n\n\n", "num_lines": 142}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule RegAlloc.Linear.FreeRegs (\n    FR(..),\n    maxSpillSlots\n)\n\n#include \"HsVersions.h\"\n\nwhere\n\nimport GhcPrelude\n\nimport Reg\nimport RegClass\n\nimport DynFlags\nimport Panic\nimport Platform\n\n-- -----------------------------------------------------------------------------\n-- The free register set\n-- This needs to be *efficient*\n-- Here's an inefficient 'executable specification' of the FreeRegs data type:\n--\n--      type FreeRegs = [RegNo]\n--      noFreeRegs = 0\n--      releaseReg n f = if n `elem` f then f else (n : f)\n--      initFreeRegs = allocatableRegs\n--      getFreeRegs cls f = filter ( (==cls) . regClass . RealReg ) f\n--      allocateReg f r = filter (/= r) f\n\nimport qualified RegAlloc.Linear.PPC.FreeRegs    as PPC\nimport qualified RegAlloc.Linear.SPARC.FreeRegs  as SPARC\nimport qualified RegAlloc.Linear.X86.FreeRegs    as X86\nimport qualified RegAlloc.Linear.X86_64.FreeRegs as X86_64\n\nimport qualified PPC.Instr\nimport qualified SPARC.Instr\nimport qualified X86.Instr\n\nclass Show freeRegs => FR freeRegs where\n    frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs\n    frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]\n    frInitFreeRegs :: Platform -> freeRegs\n    frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs\n\ninstance FR X86.FreeRegs where\n    frAllocateReg  = \\_ -> X86.allocateReg\n    frGetFreeRegs  = X86.getFreeRegs\n    frInitFreeRegs = X86.initFreeRegs\n    frReleaseReg   = \\_ -> X86.releaseReg\n\ninstance FR X86_64.FreeRegs where\n    frAllocateReg  = \\_ -> X86_64.allocateReg\n    frGetFreeRegs  = X86_64.getFreeRegs\n    frInitFreeRegs = X86_64.initFreeRegs\n    frReleaseReg   = \\_ -> X86_64.releaseReg\n\ninstance FR PPC.FreeRegs where\n    frAllocateReg  = \\_ -> PPC.allocateReg\n    frGetFreeRegs  = \\_ -> PPC.getFreeRegs\n    frInitFreeRegs = PPC.initFreeRegs\n    frReleaseReg   = \\_ -> PPC.releaseReg\n\ninstance FR SPARC.FreeRegs where\n    frAllocateReg  = SPARC.allocateReg\n    frGetFreeRegs  = \\_ -> SPARC.getFreeRegs\n    frInitFreeRegs = SPARC.initFreeRegs\n    frReleaseReg   = SPARC.releaseReg\n\nmaxSpillSlots :: DynFlags -> Int\nmaxSpillSlots dflags\n              = case platformArch (targetPlatform dflags) of\n                ArchX86       -> X86.Instr.maxSpillSlots dflags\n                ArchX86_64    -> X86.Instr.maxSpillSlots dflags\n                ArchPPC       -> PPC.Instr.maxSpillSlots dflags\n                ArchSPARC     -> SPARC.Instr.maxSpillSlots dflags\n                ArchSPARC64   -> panic \"maxSpillSlots ArchSPARC64\"\n                ArchARM _ _ _ -> panic \"maxSpillSlots ArchARM\"\n                ArchARM64     -> panic \"maxSpillSlots ArchARM64\"\n                ArchPPC_64 _  -> PPC.Instr.maxSpillSlots dflags\n                ArchAlpha     -> panic \"maxSpillSlots ArchAlpha\"\n                ArchMipseb    -> panic \"maxSpillSlots ArchMipseb\"\n                ArchMipsel    -> panic \"maxSpillSlots ArchMipsel\"\n                ArchJavaScript-> panic \"maxSpillSlots ArchJavaScript\"\n                ArchUnknown   -> panic \"maxSpillSlots ArchUnknown\"\n\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Handles joining of a jump instruction to its targets.\n\n--      The first time we encounter a jump to a particular basic block, we\n--      record the assignment of temporaries.  The next time we encounter a\n--      jump to the same block, we compare our current assignment to the\n--      stored one.  They might be different if spilling has occurred in one\n--      branch; so some fixup code will be required to match up the assignments.\n--\nmodule RegAlloc.Linear.JoinToTargets (joinToTargets) where\n\nimport GhcPrelude\n\nimport RegAlloc.Linear.State\nimport RegAlloc.Linear.Base\nimport RegAlloc.Linear.FreeRegs\nimport RegAlloc.Liveness\nimport Instruction\nimport Reg\n\nimport BlockId\nimport Hoopl.Collections\nimport Digraph\nimport DynFlags\nimport Outputable\nimport Unique\nimport UniqFM\nimport UniqSet\n\n-- | For a jump instruction at the end of a block, generate fixup code so its\n--      vregs are in the correct regs for its destination.\n--\njoinToTargets\n        :: (FR freeRegs, Instruction instr, Outputable instr)\n        => BlockMap RegSet              -- ^ maps the unique of the blockid to the set of vregs\n                                        --      that are known to be live on the entry to each block.\n\n        -> BlockId                      -- ^ id of the current block\n        -> instr                        -- ^ branch instr on the end of the source block.\n\n        -> RegM freeRegs ([NatBasicBlock instr] -- fresh blocks of fixup code.\n                         , instr)               -- the original branch\n                                                -- instruction, but maybe\n                                                -- patched to jump\n                                                -- to a fixup block first.\n\njoinToTargets block_live id instr\n\n        -- we only need to worry about jump instructions.\n        | not $ isJumpishInstr instr\n        = return ([], instr)\n\n        | otherwise\n        = joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)\n\n-----\njoinToTargets'\n        :: (FR freeRegs, Instruction instr, Outputable instr)\n        => BlockMap RegSet              -- ^ maps the unique of the blockid to the set of vregs\n                                        --      that are known to be live on the entry to each block.\n\n        -> [NatBasicBlock instr]        -- ^ acc blocks of fixup code.\n\n        -> BlockId                      -- ^ id of the current block\n        -> instr                        -- ^ branch instr on the end of the source block.\n\n        -> [BlockId]                    -- ^ branch destinations still to consider.\n\n        -> RegM freeRegs ([NatBasicBlock instr], instr)\n\n-- no more targets to consider. all done.\njoinToTargets' _          new_blocks _ instr []\n        = return (new_blocks, instr)\n\n-- handle a branch target.\njoinToTargets' block_live new_blocks block_id instr (dest:dests)\n = do\n        -- get the map of where the vregs are stored on entry to each basic block.\n        block_assig     <- getBlockAssigR\n\n        -- get the assignment on entry to the branch instruction.\n        assig           <- getAssigR\n\n        -- adjust the current assignment to remove any vregs that are not live\n        -- on entry to the destination block.\n        let Just live_set       = mapLookup dest block_live\n        let still_live uniq _   = uniq `elemUniqSet_Directly` live_set\n        let adjusted_assig      = filterUFM_Directly still_live assig\n\n        -- and free up those registers which are now free.\n        let to_free =\n                [ r     | (reg, loc) <- nonDetUFMToList assig\n                        -- This is non-deterministic but we do not\n                        -- currently support deterministic code-generation.\n                        -- See Note [Unique Determinism and code generation]\n                        , not (elemUniqSet_Directly reg live_set)\n                        , r          <- regsOfLoc loc ]\n\n        case mapLookup dest block_assig of\n         Nothing\n          -> joinToTargets_first\n                        block_live new_blocks block_id instr dest dests\n                        block_assig adjusted_assig to_free\n\n         Just (_, dest_assig)\n          -> joinToTargets_again\n                        block_live new_blocks block_id instr dest dests\n                        adjusted_assig dest_assig\n\n\n-- this is the first time we jumped to this block.\njoinToTargets_first :: (FR freeRegs, Instruction instr, Outputable instr)\n                    => BlockMap RegSet\n                    -> [NatBasicBlock instr]\n                    -> BlockId\n                    -> instr\n                    -> BlockId\n                    -> [BlockId]\n                    -> BlockAssignment freeRegs\n                    -> RegMap Loc\n                    -> [RealReg]\n                    -> RegM freeRegs ([NatBasicBlock instr], instr)\njoinToTargets_first block_live new_blocks block_id instr dest dests\n        block_assig src_assig\n        to_free\n\n = do   dflags <- getDynFlags\n        let platform = targetPlatform dflags\n\n        -- free up the regs that are not live on entry to this block.\n        freeregs        <- getFreeRegsR\n        let freeregs' = foldl' (flip $ frReleaseReg platform) freeregs to_free\n\n        -- remember the current assignment on entry to this block.\n        setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)\n\n        joinToTargets' block_live new_blocks block_id instr dests\n\n\n-- we've jumped to this block before\njoinToTargets_again :: (Instruction instr, FR freeRegs, Outputable instr)\n                    => BlockMap RegSet\n                    -> [NatBasicBlock instr]\n                    -> BlockId\n                    -> instr\n                    -> BlockId\n                    -> [BlockId]\n                    -> UniqFM Loc\n                    -> UniqFM Loc\n                    -> RegM freeRegs ([NatBasicBlock instr], instr)\njoinToTargets_again\n    block_live new_blocks block_id instr dest dests\n    src_assig dest_assig\n\n        -- the assignments already match, no problem.\n        | nonDetUFMToList dest_assig == nonDetUFMToList src_assig\n        -- This is non-deterministic but we do not\n        -- currently support deterministic code-generation.\n        -- See Note [Unique Determinism and code generation]\n        = joinToTargets' block_live new_blocks block_id instr dests\n\n        -- assignments don't match, need fixup code\n        | otherwise\n        = do\n\n                -- make a graph of what things need to be moved where.\n                let graph = makeRegMovementGraph src_assig dest_assig\n\n                -- look for cycles in the graph. This can happen if regs need to be swapped.\n                -- Note that we depend on the fact that this function does a\n                --      bottom up traversal of the tree-like portions of the graph.\n                --\n                --  eg, if we have\n                --      R1 -> R2 -> R3\n                --\n                --  ie move value in R1 to R2 and value in R2 to R3.\n                --\n                -- We need to do the R2 -> R3 move before R1 -> R2.\n                --\n                let sccs  = stronglyConnCompFromEdgedVerticesOrdR graph\n\n              -- debugging\n                {-\n                pprTrace\n                        (\"joinToTargets: making fixup code\")\n                        (vcat   [ text \"        in block: \"     <> ppr block_id\n                                , text \" jmp instruction: \"     <> ppr instr\n                                , text \"  src assignment: \"     <> ppr src_assig\n                                , text \" dest assignment: \"     <> ppr dest_assig\n                                , text \"  movement graph: \"     <> ppr graph\n                                , text \"   sccs of graph: \"     <> ppr sccs\n                                , text \"\"])\n                        (return ())\n                -}\n                delta           <- getDeltaR\n                fixUpInstrs_    <- mapM (handleComponent delta instr) sccs\n                let fixUpInstrs = concat fixUpInstrs_\n\n                -- make a new basic block containing the fixup code.\n                --      A the end of the current block we will jump to the fixup one,\n                --      then that will jump to our original destination.\n                fixup_block_id <- mkBlockId <$> getUniqueR\n                let block = BasicBlock fixup_block_id\n                                $ fixUpInstrs ++ mkJumpInstr dest\n\n                -- if we didn't need any fixups, then don't include the block\n                case fixUpInstrs of\n                 []     -> joinToTargets' block_live new_blocks block_id instr dests\n\n                 -- patch the original branch instruction so it goes to our\n                 --     fixup block instead.\n                 _      -> let  instr'  =  patchJumpInstr instr\n                                            (\\bid -> if bid == dest\n                                                        then fixup_block_id\n                                                        else bid) -- no change!\n\n                           in do\n                                {- --debugging\n                                pprTrace \"FixUpEdge info:\"\n                                    (\n                                    text \"inBlock:\" <> ppr block_id $$\n                                    text \"instr:\" <> ppr instr $$\n                                    text \"instr':\" <> ppr instr' $$\n                                    text \"fixup_block_id':\" <>\n                                        ppr fixup_block_id $$\n                                    text \"dest:\" <> ppr dest\n                                    ) (return ())\n                                -}\n                                recordFixupBlock block_id fixup_block_id dest\n                                joinToTargets' block_live (block : new_blocks)\n                                               block_id instr' dests\n\n\n-- | Construct a graph of register\\/spill movements.\n--\n--      Cyclic components seem to occur only very rarely.\n--\n--      We cut some corners by not handling memory-to-memory moves.\n--      This shouldn't happen because every temporary gets its own stack slot.\n--\nmakeRegMovementGraph :: RegMap Loc -> RegMap Loc -> [Node Loc Unique]\nmakeRegMovementGraph adjusted_assig dest_assig\n = [ node       | (vreg, src) <- nonDetUFMToList adjusted_assig\n                    -- This is non-deterministic but we do not\n                    -- currently support deterministic code-generation.\n                    -- See Note [Unique Determinism and code generation]\n                    -- source reg might not be needed at the dest:\n                , Just loc <- [lookupUFM_Directly dest_assig vreg]\n                , node <- expandNode vreg src loc ]\n\n\n-- | Expand out the destination, so InBoth destinations turn into\n--      a combination of InReg and InMem.\n\n--      The InBoth handling is a little tricky here.  If the destination is\n--      InBoth, then we must ensure that the value ends up in both locations.\n--      An InBoth  destination must conflict with an InReg or InMem source, so\n--      we expand an InBoth destination as necessary.\n--\n--      An InBoth source is slightly different: we only care about the register\n--      that the source value is in, so that we can move it to the destinations.\n--\nexpandNode\n        :: a\n        -> Loc                  -- ^ source of move\n        -> Loc                  -- ^ destination of move\n        -> [Node Loc a ]\n\nexpandNode vreg loc@(InReg src) (InBoth dst mem)\n        | src == dst = [DigraphNode vreg loc [InMem mem]]\n        | otherwise  = [DigraphNode vreg loc [InReg dst, InMem mem]]\n\nexpandNode vreg loc@(InMem src) (InBoth dst mem)\n        | src == mem = [DigraphNode vreg loc [InReg dst]]\n        | otherwise  = [DigraphNode vreg loc [InReg dst, InMem mem]]\n\nexpandNode _        (InBoth _ src) (InMem dst)\n        | src == dst = [] -- guaranteed to be true\n\nexpandNode _        (InBoth src _) (InReg dst)\n        | src == dst = []\n\nexpandNode vreg     (InBoth src _) dst\n        = expandNode vreg (InReg src) dst\n\nexpandNode vreg src dst\n        | src == dst = []\n        | otherwise  = [DigraphNode vreg src [dst]]\n\n\n-- | Generate fixup code for a particular component in the move graph\n--      This component tells us what values need to be moved to what\n--      destinations. We have eliminated any possibility of single-node\n--      cycles in expandNode above.\n--\nhandleComponent\n        :: Instruction instr\n        => Int -> instr -> SCC (Node Loc Unique)\n        -> RegM freeRegs [instr]\n\n-- If the graph is acyclic then we won't get the swapping problem below.\n--      In this case we can just do the moves directly, and avoid having to\n--      go via a spill slot.\n--\nhandleComponent delta _  (AcyclicSCC (DigraphNode vreg src dsts))\n        = mapM (makeMove delta vreg src) dsts\n\n\n-- Handle some cyclic moves.\n--      This can happen if we have two regs that need to be swapped.\n--      eg:\n--           vreg   source loc   dest loc\n--          (vreg1, InReg r1,    [InReg r2])\n--          (vreg2, InReg r2,    [InReg r1])\n--\n--      To avoid needing temp register, we just spill all the source regs, then\n--      reaload them into their destination regs.\n--\n--      Note that we can not have cycles that involve memory locations as\n--      sources as single destination because memory locations (stack slots)\n--      are allocated exclusively for a virtual register and therefore can not\n--      require a fixup.\n--\nhandleComponent delta instr\n        (CyclicSCC ((DigraphNode vreg (InReg sreg) ((InReg dreg: _))) : rest))\n        -- dest list may have more than one element, if the reg is also InMem.\n = do\n        -- spill the source into its slot\n        (instrSpill, slot)\n                        <- spillR (RegReal sreg) vreg\n\n        -- reload into destination reg\n        instrLoad       <- loadR (RegReal dreg) slot\n\n        remainingFixUps <- mapM (handleComponent delta instr)\n                                (stronglyConnCompFromEdgedVerticesOrdR rest)\n\n        -- make sure to do all the reloads after all the spills,\n        --      so we don't end up clobbering the source values.\n        return ([instrSpill] ++ concat remainingFixUps ++ [instrLoad])\n\nhandleComponent _ _ (CyclicSCC _)\n = panic \"Register Allocator: handleComponent cyclic\"\n\n\n-- | Move a vreg between these two locations.\n--\nmakeMove\n    :: Instruction instr\n    => Int      -- ^ current C stack delta.\n    -> Unique   -- ^ unique of the vreg that we're moving.\n    -> Loc      -- ^ source location.\n    -> Loc      -- ^ destination location.\n    -> RegM freeRegs instr  -- ^ move instruction.\n\nmakeMove delta vreg src dst\n = do dflags <- getDynFlags\n      let platform = targetPlatform dflags\n\n      case (src, dst) of\n          (InReg s, InReg d) ->\n              do recordSpill (SpillJoinRR vreg)\n                 return $ mkRegRegMoveInstr platform (RegReal s) (RegReal d)\n          (InMem s, InReg d) ->\n              do recordSpill (SpillJoinRM vreg)\n                 return $ mkLoadInstr dflags (RegReal d) delta s\n          (InReg s, InMem d) ->\n              do recordSpill (SpillJoinRM vreg)\n                 return $ mkSpillInstr dflags (RegReal s) delta d\n          _ ->\n              -- we don't handle memory to memory moves.\n              -- they shouldn't happen because we don't share\n              -- stack slots between vregs.\n              panic (\"makeMove \" ++ show vreg ++ \" (\" ++ show src ++ \") (\"\n                  ++ show dst ++ \")\"\n                  ++ \" we don't handle mem->mem moves.\")\n\n", "num_lines": 378}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n--\n-- The register allocator\n--\n-- (c) The University of Glasgow 2004\n--\n-----------------------------------------------------------------------------\n\n{-\nThe algorithm is roughly:\n\n  1) Compute strongly connected components of the basic block list.\n\n  2) Compute liveness (mapping from pseudo register to\n     point(s) of death?).\n\n  3) Walk instructions in each basic block.  We keep track of\n        (a) Free real registers (a bitmap?)\n        (b) Current assignment of temporaries to machine registers and/or\n            spill slots (call this the \"assignment\").\n        (c) Partial mapping from basic block ids to a virt-to-loc mapping.\n            When we first encounter a branch to a basic block,\n            we fill in its entry in this table with the current mapping.\n\n     For each instruction:\n        (a) For each temporary *read* by the instruction:\n            If the temporary does not have a real register allocation:\n                - Allocate a real register from the free list.  If\n                  the list is empty:\n                  - Find a temporary to spill.  Pick one that is\n                    not used in this instruction (ToDo: not\n                    used for a while...)\n                  - generate a spill instruction\n                - If the temporary was previously spilled,\n                  generate an instruction to read the temp from its spill loc.\n            (optimisation: if we can see that a real register is going to\n            be used soon, then don't use it for allocation).\n\n        (b) For each real register clobbered by this instruction:\n            If a temporary resides in it,\n                If the temporary is live after this instruction,\n                    Move the temporary to another (non-clobbered & free) reg,\n                    or spill it to memory.  Mark the temporary as residing\n                    in both memory and a register if it was spilled (it might\n                    need to be read by this instruction).\n\n            (ToDo: this is wrong for jump instructions?)\n\n            We do this after step (a), because if we start with\n               movq v1, %rsi\n            which is an instruction that clobbers %rsi, if v1 currently resides\n            in %rsi we want to get\n               movq %rsi, %freereg\n               movq %rsi, %rsi     -- will disappear\n            instead of\n               movq %rsi, %freereg\n               movq %freereg, %rsi\n\n        (c) Update the current assignment\n\n        (d) If the instruction is a branch:\n              if the destination block already has a register assignment,\n                Generate a new block with fixup code and redirect the\n                jump to the new block.\n              else,\n                Update the block id->assignment mapping with the current\n                assignment.\n\n        (e) Delete all register assignments for temps which are read\n            (only) and die here.  Update the free register list.\n\n        (f) Mark all registers clobbered by this instruction as not free,\n            and mark temporaries which have been spilled due to clobbering\n            as in memory (step (a) marks then as in both mem & reg).\n\n        (g) For each temporary *written* by this instruction:\n            Allocate a real register as for (b), spilling something\n            else if necessary.\n                - except when updating the assignment, drop any memory\n                  locations that the temporary was previously in, since\n                  they will be no longer valid after this instruction.\n\n        (h) Delete all register assignments for temps which are\n            written and die here (there should rarely be any).  Update\n            the free register list.\n\n        (i) Rewrite the instruction with the new mapping.\n\n        (j) For each spilled reg known to be now dead, re-add its stack slot\n            to the free list.\n\n-}\n\nmodule RegAlloc.Linear.Main (\n        regAlloc,\n        module  RegAlloc.Linear.Base,\n        module  RegAlloc.Linear.Stats\n  ) where\n\n#include \"HsVersions.h\"\n\n\nimport GhcPrelude\n\nimport RegAlloc.Linear.State\nimport RegAlloc.Linear.Base\nimport RegAlloc.Linear.StackMap\nimport RegAlloc.Linear.FreeRegs\nimport RegAlloc.Linear.Stats\nimport RegAlloc.Linear.JoinToTargets\nimport qualified RegAlloc.Linear.PPC.FreeRegs    as PPC\nimport qualified RegAlloc.Linear.SPARC.FreeRegs  as SPARC\nimport qualified RegAlloc.Linear.X86.FreeRegs    as X86\nimport qualified RegAlloc.Linear.X86_64.FreeRegs as X86_64\nimport TargetReg\nimport RegAlloc.Liveness\nimport Instruction\nimport Reg\n\nimport BlockId\nimport Hoopl.Collections\nimport Cmm hiding (RegSet)\n\nimport Digraph\nimport DynFlags\nimport Unique\nimport UniqSet\nimport UniqFM\nimport UniqSupply\nimport Outputable\nimport Platform\n\nimport Data.Maybe\nimport Data.List\nimport Control.Monad\n\n-- -----------------------------------------------------------------------------\n-- Top level of the register allocator\n\n-- Allocate registers\nregAlloc\n        :: (Outputable instr, Instruction instr)\n        => DynFlags\n        -> LiveCmmDecl statics instr\n        -> UniqSM ( NatCmmDecl statics instr\n                  , Maybe Int  -- number of extra stack slots required,\n                               -- beyond maxSpillSlots\n                  , Maybe RegAllocStats\n                  )\n\nregAlloc _ (CmmData sec d)\n        = return\n                ( CmmData sec d\n                , Nothing\n                , Nothing )\n\nregAlloc _ (CmmProc (LiveInfo info _ _ _) lbl live [])\n        = return ( CmmProc info lbl live (ListGraph [])\n                 , Nothing\n                 , Nothing )\n\nregAlloc dflags (CmmProc static lbl live sccs)\n        | LiveInfo info entry_ids@(first_id:_) block_live _ <- static\n        = do\n                -- do register allocation on each component.\n                (final_blocks, stats, stack_use)\n                        <- linearRegAlloc dflags entry_ids block_live sccs\n\n                -- make sure the block that was first in the input list\n                --      stays at the front of the output\n                let ((first':_), rest')\n                                = partition ((== first_id) . blockId) final_blocks\n\n                let max_spill_slots = maxSpillSlots dflags\n                    extra_stack\n                      | stack_use > max_spill_slots\n                      = Just (stack_use - max_spill_slots)\n                      | otherwise\n                      = Nothing\n\n                return  ( CmmProc info lbl live (ListGraph (first' : rest'))\n                        , extra_stack\n                        , Just stats)\n\n-- bogus. to make non-exhaustive match warning go away.\nregAlloc _ (CmmProc _ _ _ _)\n        = panic \"RegAllocLinear.regAlloc: no match\"\n\n\n-- -----------------------------------------------------------------------------\n-- Linear sweep to allocate registers\n\n\n-- | Do register allocation on some basic blocks.\n--   But be careful to allocate a block in an SCC only if it has\n--   an entry in the block map or it is the first block.\n--\nlinearRegAlloc\n        :: (Outputable instr, Instruction instr)\n        => DynFlags\n        -> [BlockId] -- ^ entry points\n        -> BlockMap RegSet\n              -- ^ live regs on entry to each basic block\n        -> [SCC (LiveBasicBlock instr)]\n              -- ^ instructions annotated with \"deaths\"\n        -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)\n\nlinearRegAlloc dflags entry_ids block_live sccs\n = case platformArch platform of\n      ArchX86        -> go $ (frInitFreeRegs platform :: X86.FreeRegs)\n      ArchX86_64     -> go $ (frInitFreeRegs platform :: X86_64.FreeRegs)\n      ArchSPARC      -> go $ (frInitFreeRegs platform :: SPARC.FreeRegs)\n      ArchSPARC64    -> panic \"linearRegAlloc ArchSPARC64\"\n      ArchPPC        -> go $ (frInitFreeRegs platform :: PPC.FreeRegs)\n      ArchARM _ _ _  -> panic \"linearRegAlloc ArchARM\"\n      ArchARM64      -> panic \"linearRegAlloc ArchARM64\"\n      ArchPPC_64 _   -> go $ (frInitFreeRegs platform :: PPC.FreeRegs)\n      ArchAlpha      -> panic \"linearRegAlloc ArchAlpha\"\n      ArchMipseb     -> panic \"linearRegAlloc ArchMipseb\"\n      ArchMipsel     -> panic \"linearRegAlloc ArchMipsel\"\n      ArchJavaScript -> panic \"linearRegAlloc ArchJavaScript\"\n      ArchUnknown    -> panic \"linearRegAlloc ArchUnknown\"\n where\n  go f = linearRegAlloc' dflags f entry_ids block_live sccs\n  platform = targetPlatform dflags\n\nlinearRegAlloc'\n        :: (FR freeRegs, Outputable instr, Instruction instr)\n        => DynFlags\n        -> freeRegs\n        -> [BlockId]                    -- ^ entry points\n        -> BlockMap RegSet              -- ^ live regs on entry to each basic block\n        -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with \"deaths\"\n        -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)\n\nlinearRegAlloc' dflags initFreeRegs entry_ids block_live sccs\n = do   us      <- getUniqueSupplyM\n        let (_, stack, stats, blocks) =\n                runR dflags mapEmpty initFreeRegs emptyRegMap (emptyStackMap dflags) us\n                    $ linearRA_SCCs entry_ids block_live [] sccs\n        return  (blocks, stats, getStackUse stack)\n\n\nlinearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr)\n              => [BlockId]\n              -> BlockMap RegSet\n              -> [NatBasicBlock instr]\n              -> [SCC (LiveBasicBlock instr)]\n              -> RegM freeRegs [NatBasicBlock instr]\n\nlinearRA_SCCs _ _ blocksAcc []\n        = return $ reverse blocksAcc\n\nlinearRA_SCCs entry_ids block_live blocksAcc (AcyclicSCC block : sccs)\n = do   blocks' <- processBlock block_live block\n        linearRA_SCCs entry_ids block_live\n                ((reverse blocks') ++ blocksAcc)\n                sccs\n\nlinearRA_SCCs entry_ids block_live blocksAcc (CyclicSCC blocks : sccs)\n = do\n        blockss' <- process entry_ids block_live blocks [] (return []) False\n        linearRA_SCCs entry_ids block_live\n                (reverse (concat blockss') ++ blocksAcc)\n                sccs\n\n{- from John Dias's patch 2008/10/16:\n   The linear-scan allocator sometimes allocates a block\n   before allocating one of its predecessors, which could lead to\n   inconsistent allocations. Make it so a block is only allocated\n   if a predecessor has set the \"incoming\" assignments for the block, or\n   if it's the procedure's entry block.\n\n   BL 2009/02: Careful. If the assignment for a block doesn't get set for\n   some reason then this function will loop. We should probably do some\n   more sanity checking to guard against this eventuality.\n-}\n\nprocess :: (FR freeRegs, Instruction instr, Outputable instr)\n        => [BlockId]\n        -> BlockMap RegSet\n        -> [GenBasicBlock (LiveInstr instr)]\n        -> [GenBasicBlock (LiveInstr instr)]\n        -> [[NatBasicBlock instr]]\n        -> Bool\n        -> RegM freeRegs [[NatBasicBlock instr]]\n\nprocess _ _ [] []         accum _\n        = return $ reverse accum\n\nprocess entry_ids block_live [] next_round accum madeProgress\n        | not madeProgress\n\n          {- BUGS: There are so many unreachable blocks in the code the warnings are overwhelming.\n             pprTrace \"RegAlloc.Linear.Main.process: no progress made, bailing out.\"\n                (  text \"Unreachable blocks:\"\n                $$ vcat (map ppr next_round)) -}\n        = return $ reverse accum\n\n        | otherwise\n        = process entry_ids block_live\n                  next_round [] accum False\n\nprocess entry_ids block_live (b@(BasicBlock id _) : blocks)\n        next_round accum madeProgress\n = do\n        block_assig <- getBlockAssigR\n\n        if isJust (mapLookup id block_assig)\n             || id `elem` entry_ids\n         then do\n                b'  <- processBlock block_live b\n                process entry_ids block_live blocks\n                        next_round (b' : accum) True\n\n         else   process entry_ids block_live blocks\n                        (b : next_round) accum madeProgress\n\n\n-- | Do register allocation on this basic block\n--\nprocessBlock\n        :: (FR freeRegs, Outputable instr, Instruction instr)\n        => BlockMap RegSet              -- ^ live regs on entry to each basic block\n        -> LiveBasicBlock instr         -- ^ block to do register allocation on\n        -> RegM freeRegs [NatBasicBlock instr]   -- ^ block with registers allocated\n\nprocessBlock block_live (BasicBlock id instrs)\n = do   initBlock id block_live\n        (instrs', fixups)\n                <- linearRA block_live [] [] id instrs\n        return  $ BasicBlock id instrs' : fixups\n\n\n-- | Load the freeregs and current reg assignment into the RegM state\n--      for the basic block with this BlockId.\ninitBlock :: FR freeRegs\n          => BlockId -> BlockMap RegSet -> RegM freeRegs ()\ninitBlock id block_live\n = do   dflags <- getDynFlags\n        let platform = targetPlatform dflags\n        block_assig     <- getBlockAssigR\n        case mapLookup id block_assig of\n                -- no prior info about this block: we must consider\n                -- any fixed regs to be allocated, but we can ignore\n                -- virtual regs (presumably this is part of a loop,\n                -- and we'll iterate again).  The assignment begins\n                -- empty.\n                Nothing\n                 -> do  -- pprTrace \"initFreeRegs\" (text $ show initFreeRegs) (return ())\n                        case mapLookup id block_live of\n                          Nothing ->\n                            setFreeRegsR    (frInitFreeRegs platform)\n                          Just live ->\n                            setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)\n                                                  [ r | RegReal r <- nonDetEltsUniqSet live ]\n                            -- See Note [Unique Determinism and code generation]\n                        setAssigR       emptyRegMap\n\n                -- load info about register assignments leading into this block.\n                Just (freeregs, assig)\n                 -> do  setFreeRegsR    freeregs\n                        setAssigR       assig\n\n\n-- | Do allocation for a sequence of instructions.\nlinearRA\n        :: (FR freeRegs, Outputable instr, Instruction instr)\n        => BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.\n        -> [instr]                              -- ^ accumulator for instructions already processed.\n        -> [NatBasicBlock instr]                -- ^ accumulator for blocks of fixup code.\n        -> BlockId                              -- ^ id of the current block, for debugging.\n        -> [LiveInstr instr]                    -- ^ liveness annotated instructions in this block.\n\n        -> RegM freeRegs\n                ( [instr]                       --   instructions after register allocation\n                , [NatBasicBlock instr])        --   fresh blocks of fixup code.\n\n\nlinearRA _          accInstr accFixup _ []\n        = return\n                ( reverse accInstr              -- instrs need to be returned in the correct order.\n                , accFixup)                     -- it doesn't matter what order the fixup blocks are returned in.\n\n\nlinearRA block_live accInstr accFixups id (instr:instrs)\n = do\n        (accInstr', new_fixups) <- raInsn block_live accInstr id instr\n\n        linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs\n\n\n-- | Do allocation for a single instruction.\nraInsn\n        :: (FR freeRegs, Outputable instr, Instruction instr)\n        => BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.\n        -> [instr]                              -- ^ accumulator for instructions already processed.\n        -> BlockId                              -- ^ the id of the current block, for debugging\n        -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.\n        -> RegM freeRegs\n                ( [instr]                       -- new instructions\n                , [NatBasicBlock instr])        -- extra fixup blocks\n\nraInsn _     new_instrs _ (LiveInstr ii Nothing)\n        | Just n        <- takeDeltaInstr ii\n        = do    setDeltaR n\n                return (new_instrs, [])\n\nraInsn _     new_instrs _ (LiveInstr ii@(Instr i) Nothing)\n        | isMetaInstr ii\n        = return (i : new_instrs, [])\n\n\nraInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))\n = do\n    assig    <- getAssigR\n\n    -- If we have a reg->reg move between virtual registers, where the\n    -- src register is not live after this instruction, and the dst\n    -- register does not already have an assignment,\n    -- and the source register is assigned to a register, not to a spill slot,\n    -- then we can eliminate the instruction.\n    -- (we can't eliminate it if the source register is on the stack, because\n    --  we do not want to use one spill slot for different virtual registers)\n    case takeRegRegMoveInstr instr of\n        Just (src,dst)  | src `elementOfUniqSet` (liveDieRead live),\n                          isVirtualReg dst,\n                          not (dst `elemUFM` assig),\n                          isRealReg src || isInReg src assig -> do\n           case src of\n              (RegReal rr) -> setAssigR (addToUFM assig dst (InReg rr))\n                -- if src is a fixed reg, then we just map dest to this\n                -- reg in the assignment.  src must be an allocatable reg,\n                -- otherwise it wouldn't be in r_dying.\n              _virt -> case lookupUFM assig src of\n                         Nothing -> panic \"raInsn\"\n                         Just loc ->\n                           setAssigR (addToUFM (delFromUFM assig src) dst loc)\n\n           -- we have eliminated this instruction\n          {-\n          freeregs <- getFreeRegsR\n          assig <- getAssigR\n          pprTrace \"raInsn\" (text \"ELIMINATED: \" <> docToSDoc (pprInstr instr)\n                        $$ ppr r_dying <+> ppr w_dying $$ text (show freeregs) $$ ppr assig) $ do\n          -}\n           return (new_instrs, [])\n\n        _ -> genRaInsn block_live new_instrs id instr\n                        (nonDetEltsUniqSet $ liveDieRead live)\n                        (nonDetEltsUniqSet $ liveDieWrite live)\n                        -- See Note [Unique Determinism and code generation]\n\nraInsn _ _ _ instr\n        = pprPanic \"raInsn\" (text \"no match for:\" <> ppr instr)\n\n-- ToDo: what can we do about\n--\n--     R1 = x\n--     jump I64[x] // [R1]\n--\n-- where x is mapped to the same reg as R1.  We want to coalesce x and\n-- R1, but the register allocator doesn't know whether x will be\n-- assigned to again later, in which case x and R1 should be in\n-- different registers.  Right now we assume the worst, and the\n-- assignment to R1 will clobber x, so we'll spill x into another reg,\n-- generating another reg->reg move.\n\n\nisInReg :: Reg -> RegMap Loc -> Bool\nisInReg src assig | Just (InReg _) <- lookupUFM assig src = True\n                  | otherwise = False\n\n\ngenRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)\n          => BlockMap RegSet\n          -> [instr]\n          -> BlockId\n          -> instr\n          -> [Reg]\n          -> [Reg]\n          -> RegM freeRegs ([instr], [NatBasicBlock instr])\n\ngenRaInsn block_live new_instrs block_id instr r_dying w_dying = do\n  dflags <- getDynFlags\n  let platform = targetPlatform dflags\n  case regUsageOfInstr platform instr of { RU read written ->\n    do\n    let real_written    = [ rr  | (RegReal     rr) <- written ]\n    let virt_written    = [ vr  | (RegVirtual  vr) <- written ]\n\n    -- we don't need to do anything with real registers that are\n    -- only read by this instr.  (the list is typically ~2 elements,\n    -- so using nub isn't a problem).\n    let virt_read       = nub [ vr      | (RegVirtual vr) <- read ]\n\n    -- debugging\n{-    freeregs <- getFreeRegsR\n    assig    <- getAssigR\n    pprDebugAndThen (defaultDynFlags Settings{ sTargetPlatform=platform } undefined) trace \"genRaInsn\"\n        (ppr instr\n                $$ text \"r_dying      = \" <+> ppr r_dying\n                $$ text \"w_dying      = \" <+> ppr w_dying\n                $$ text \"virt_read    = \" <+> ppr virt_read\n                $$ text \"virt_written = \" <+> ppr virt_written\n                $$ text \"freeregs     = \" <+> text (show freeregs)\n                $$ text \"assig        = \" <+> ppr assig)\n        $ do\n-}\n\n    -- (a), (b) allocate real regs for all regs read by this instruction.\n    (r_spills, r_allocd) <-\n        allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read\n\n    -- (c) save any temporaries which will be clobbered by this instruction\n    clobber_saves <- saveClobberedTemps real_written r_dying\n\n    -- (d) Update block map for new destinations\n    -- NB. do this before removing dead regs from the assignment, because\n    -- these dead regs might in fact be live in the jump targets (they're\n    -- only dead in the code that follows in the current basic block).\n    (fixup_blocks, adjusted_instr)\n        <- joinToTargets block_live block_id instr\n\n    -- Debugging - show places where the reg alloc inserted\n    -- assignment fixup blocks.\n    -- when (not $ null fixup_blocks) $\n    --    pprTrace \"fixup_blocks\" (ppr fixup_blocks) (return ())\n\n    -- (e) Delete all register assignments for temps which are read\n    --     (only) and die here.  Update the free register list.\n    releaseRegs r_dying\n\n    -- (f) Mark regs which are clobbered as unallocatable\n    clobberRegs real_written\n\n    -- (g) Allocate registers for temporaries *written* (only)\n    (w_spills, w_allocd) <-\n        allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written\n\n    -- (h) Release registers for temps which are written here and not\n    -- used again.\n    releaseRegs w_dying\n\n    let\n        -- (i) Patch the instruction\n        patch_map\n                = listToUFM\n                        [ (t, RegReal r)\n                                | (t, r) <- zip virt_read    r_allocd\n                                         ++ zip virt_written w_allocd ]\n\n        patched_instr\n                = patchRegsOfInstr adjusted_instr patchLookup\n\n        patchLookup x\n                = case lookupUFM patch_map x of\n                        Nothing -> x\n                        Just y  -> y\n\n\n    -- (j) free up stack slots for dead spilled regs\n    -- TODO (can't be bothered right now)\n\n    -- erase reg->reg moves where the source and destination are the same.\n    --  If the src temp didn't die in this instr but happened to be allocated\n    --  to the same real reg as the destination, then we can erase the move anyway.\n    let squashed_instr  = case takeRegRegMoveInstr patched_instr of\n                                Just (src, dst)\n                                 | src == dst   -> []\n                                _               -> [patched_instr]\n\n    let code = squashed_instr ++ w_spills ++ reverse r_spills\n                ++ clobber_saves ++ new_instrs\n\n--    pprTrace \"patched-code\" ((vcat $ map (docToSDoc . pprInstr) code)) $ do\n--    pprTrace \"pached-fixup\" ((ppr fixup_blocks)) $ do\n\n    return (code, fixup_blocks)\n\n  }\n\n-- -----------------------------------------------------------------------------\n-- releaseRegs\n\nreleaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()\nreleaseRegs regs = do\n  dflags <- getDynFlags\n  let platform = targetPlatform dflags\n  assig <- getAssigR\n  free <- getFreeRegsR\n  let loop assig !free [] = do setAssigR assig; setFreeRegsR free; return ()\n      loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs\n      loop assig !free (r:rs) =\n         case lookupUFM assig r of\n         Just (InBoth real _) -> loop (delFromUFM assig r)\n                                      (frReleaseReg platform real free) rs\n         Just (InReg real)    -> loop (delFromUFM assig r)\n                                      (frReleaseReg platform real free) rs\n         _                    -> loop (delFromUFM assig r) free rs\n  loop assig free regs\n\n\n-- -----------------------------------------------------------------------------\n-- Clobber real registers\n\n-- For each temp in a register that is going to be clobbered:\n--      - if the temp dies after this instruction, do nothing\n--      - otherwise, put it somewhere safe (another reg if possible,\n--              otherwise spill and record InBoth in the assignment).\n--      - for allocateRegs on the temps *read*,\n--      - clobbered regs are allocatable.\n--\n--      for allocateRegs on the temps *written*,\n--        - clobbered regs are not allocatable.\n--\n\nsaveClobberedTemps\n        :: (Instruction instr, FR freeRegs)\n        => [RealReg]            -- real registers clobbered by this instruction\n        -> [Reg]                -- registers which are no longer live after this insn\n        -> RegM freeRegs [instr]         -- return: instructions to spill any temps that will\n                                -- be clobbered.\n\nsaveClobberedTemps [] _\n        = return []\n\nsaveClobberedTemps clobbered dying\n = do\n        assig   <- getAssigR\n        let to_spill\n                = [ (temp,reg)\n                        | (temp, InReg reg) <- nonDetUFMToList assig\n                        -- This is non-deterministic but we do not\n                        -- currently support deterministic code-generation.\n                        -- See Note [Unique Determinism and code generation]\n                        , any (realRegsAlias reg) clobbered\n                        , temp `notElem` map getUnique dying  ]\n\n        (instrs,assig') <- clobber assig [] to_spill\n        setAssigR assig'\n        return instrs\n\n   where\n     clobber assig instrs []\n            = return (instrs, assig)\n\n     clobber assig instrs ((temp, reg) : rest)\n       = do dflags <- getDynFlags\n            let platform = targetPlatform dflags\n\n            freeRegs <- getFreeRegsR\n            let regclass = targetClassOfRealReg platform reg\n                freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs\n\n            case filter (`notElem` clobbered) freeRegs_thisClass of\n\n              -- (1) we have a free reg of the right class that isn't\n              -- clobbered by this instruction; use it to save the\n              -- clobbered value.\n              (my_reg : _) -> do\n                  setFreeRegsR (frAllocateReg platform my_reg freeRegs)\n\n                  let new_assign = addToUFM assig temp (InReg my_reg)\n                  let instr = mkRegRegMoveInstr platform\n                                  (RegReal reg) (RegReal my_reg)\n\n                  clobber new_assign (instr : instrs) rest\n\n              -- (2) no free registers: spill the value\n              [] -> do\n                  (spill, slot)   <- spillR (RegReal reg) temp\n\n                  -- record why this reg was spilled for profiling\n                  recordSpill (SpillClobber temp)\n\n                  let new_assign  = addToUFM assig temp (InBoth reg slot)\n\n                  clobber new_assign (spill : instrs) rest\n\n\n\n-- | Mark all these real regs as allocated,\n--      and kick out their vreg assignments.\n--\nclobberRegs :: FR freeRegs => [RealReg] -> RegM freeRegs ()\nclobberRegs []\n        = return ()\n\nclobberRegs clobbered\n = do   dflags <- getDynFlags\n        let platform = targetPlatform dflags\n\n        freeregs        <- getFreeRegsR\n        setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs clobbered\n\n        assig           <- getAssigR\n        setAssigR $! clobber assig (nonDetUFMToList assig)\n          -- This is non-deterministic but we do not\n          -- currently support deterministic code-generation.\n          -- See Note [Unique Determinism and code generation]\n\n   where\n        -- if the temp was InReg and clobbered, then we will have\n        -- saved it in saveClobberedTemps above.  So the only case\n        -- we have to worry about here is InBoth.  Note that this\n        -- also catches temps which were loaded up during allocation\n        -- of read registers, not just those saved in saveClobberedTemps.\n\n        clobber assig []\n                = assig\n\n        clobber assig ((temp, InBoth reg slot) : rest)\n                | any (realRegsAlias reg) clobbered\n                = clobber (addToUFM assig temp (InMem slot)) rest\n\n        clobber assig (_:rest)\n                = clobber assig rest\n\n-- -----------------------------------------------------------------------------\n-- allocateRegsAndSpill\n\n-- Why are we performing a spill?\ndata SpillLoc = ReadMem StackSlot  -- reading from register only in memory\n              | WriteNew           -- writing to a new variable\n              | WriteMem           -- writing to register only in memory\n-- Note that ReadNew is not valid, since you don't want to be reading\n-- from an uninitialized register.  We also don't need the location of\n-- the register in memory, since that will be invalidated by the write.\n-- Technically, we could coalesce WriteNew and WriteMem into a single\n-- entry as well. -- EZY\n\n-- This function does several things:\n--   For each temporary referred to by this instruction,\n--   we allocate a real register (spilling another temporary if necessary).\n--   We load the temporary up from memory if necessary.\n--   We also update the register assignment in the process, and\n--   the list of free registers and free stack slots.\n\nallocateRegsAndSpill\n        :: (FR freeRegs, Outputable instr, Instruction instr)\n        => Bool                 -- True <=> reading (load up spilled regs)\n        -> [VirtualReg]         -- don't push these out\n        -> [instr]              -- spill insns\n        -> [RealReg]            -- real registers allocated (accum.)\n        -> [VirtualReg]         -- temps to allocate\n        -> RegM freeRegs ( [instr] , [RealReg])\n\nallocateRegsAndSpill _       _    spills alloc []\n        = return (spills, reverse alloc)\n\nallocateRegsAndSpill reading keep spills alloc (r:rs)\n = do   assig <- getAssigR\n        let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig\n        case lookupUFM assig r of\n                -- case (1a): already in a register\n                Just (InReg my_reg) ->\n                        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs\n\n                -- case (1b): already in a register (and memory)\n                -- NB1. if we're writing this register, update its assignment to be\n                -- InReg, because the memory value is no longer valid.\n                -- NB2. This is why we must process written registers here, even if they\n                -- are also read by the same instruction.\n                Just (InBoth my_reg _)\n                 -> do  when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))\n                        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs\n\n                -- Not already in a register, so we need to find a free one...\n                Just (InMem slot) | reading   -> doSpill (ReadMem slot)\n                                  | otherwise -> doSpill WriteMem\n                Nothing | reading   ->\n                   pprPanic \"allocateRegsAndSpill: Cannot read from uninitialized register\" (ppr r)\n                   -- NOTE: if the input to the NCG contains some\n                   -- unreachable blocks with junk code, this panic\n                   -- might be triggered.  Make sure you only feed\n                   -- sensible code into the NCG.  In CmmPipeline we\n                   -- call removeUnreachableBlocks at the end for this\n                   -- reason.\n\n                        | otherwise -> doSpill WriteNew\n\n\n-- reading is redundant with reason, but we keep it around because it's\n-- convenient and it maintains the recursive structure of the allocator. -- EZY\nallocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)\n                        => Bool\n                        -> [VirtualReg]\n                        -> [instr]\n                        -> [RealReg]\n                        -> VirtualReg\n                        -> [VirtualReg]\n                        -> UniqFM Loc\n                        -> SpillLoc\n                        -> RegM freeRegs ([instr], [RealReg])\nallocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc\n = do   dflags <- getDynFlags\n        let platform = targetPlatform dflags\n        freeRegs                <- getFreeRegsR\n        let freeRegs_thisClass  = frGetFreeRegs platform (classOfVirtualReg r) freeRegs\n\n        case freeRegs_thisClass of\n\n         -- case (2): we have a free register\n         (my_reg : _) ->\n           do   spills'   <- loadTemp r spill_loc my_reg spills\n\n                setAssigR       (addToUFM assig r $! newLocation spill_loc my_reg)\n                setFreeRegsR $  frAllocateReg platform my_reg freeRegs\n\n                allocateRegsAndSpill reading keep spills' (my_reg : alloc) rs\n\n\n          -- case (3): we need to push something out to free up a register\n         [] ->\n           do   let inRegOrBoth (InReg _) = True\n                    inRegOrBoth (InBoth _ _) = True\n                    inRegOrBoth _ = False\n                let candidates' =\n                      flip delListFromUFM keep $\n                      filterUFM inRegOrBoth $\n                      assig\n                      -- This is non-deterministic but we do not\n                      -- currently support deterministic code-generation.\n                      -- See Note [Unique Determinism and code generation]\n                let candidates = nonDetUFMToList candidates'\n\n                -- the vregs we could kick out that are already in a slot\n                let candidates_inBoth\n                        = [ (temp, reg, mem)\n                          | (temp, InBoth reg mem) <- candidates\n                          , targetClassOfRealReg platform reg == classOfVirtualReg r ]\n\n                -- the vregs we could kick out that are only in a reg\n                --      this would require writing the reg to a new slot before using it.\n                let candidates_inReg\n                        = [ (temp, reg)\n                          | (temp, InReg reg) <- candidates\n                          , targetClassOfRealReg platform reg == classOfVirtualReg r ]\n\n                let result\n\n                        -- we have a temporary that is in both register and mem,\n                        -- just free up its register for use.\n                        | (temp, my_reg, slot) : _      <- candidates_inBoth\n                        = do    spills' <- loadTemp r spill_loc my_reg spills\n                                let assig1  = addToUFM assig temp (InMem slot)\n                                let assig2  = addToUFM assig1 r $! newLocation spill_loc my_reg\n\n                                setAssigR assig2\n                                allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs\n\n                        -- otherwise, we need to spill a temporary that currently\n                        -- resides in a register.\n                        | (temp_to_push_out, (my_reg :: RealReg)) : _\n                                        <- candidates_inReg\n                        = do\n                                (spill_insn, slot) <- spillR (RegReal my_reg) temp_to_push_out\n                                let spill_store  = (if reading then id else reverse)\n                                                        [ -- COMMENT (fsLit \"spill alloc\")\n                                                           spill_insn ]\n\n                                -- record that this temp was spilled\n                                recordSpill (SpillAlloc temp_to_push_out)\n\n                                -- update the register assignment\n                                let assig1  = addToUFM assig temp_to_push_out   (InMem slot)\n                                let assig2  = addToUFM assig1 r                 $! newLocation spill_loc my_reg\n                                setAssigR assig2\n\n                                -- if need be, load up a spilled temp into the reg we've just freed up.\n                                spills' <- loadTemp r spill_loc my_reg spills\n\n                                allocateRegsAndSpill reading keep\n                                        (spill_store ++ spills')\n                                        (my_reg:alloc) rs\n\n\n                        -- there wasn't anything to spill, so we're screwed.\n                        | otherwise\n                        = pprPanic (\"RegAllocLinear.allocRegsAndSpill: no spill candidates\\n\")\n                        $ vcat\n                                [ text \"allocating vreg:  \" <> text (show r)\n                                , text \"assignment:       \" <> ppr assig\n                                , text \"freeRegs:         \" <> text (show freeRegs)\n                                , text \"initFreeRegs:     \" <> text (show (frInitFreeRegs platform `asTypeOf` freeRegs)) ]\n\n                result\n\n\n-- | Calculate a new location after a register has been loaded.\nnewLocation :: SpillLoc -> RealReg -> Loc\n-- if the tmp was read from a slot, then now its in a reg as well\nnewLocation (ReadMem slot) my_reg = InBoth my_reg slot\n-- writes will always result in only the register being available\nnewLocation _ my_reg = InReg my_reg\n\n-- | Load up a spilled temporary if we need to (read from memory).\nloadTemp\n        :: (Instruction instr)\n        => VirtualReg   -- the temp being loaded\n        -> SpillLoc     -- the current location of this temp\n        -> RealReg      -- the hreg to load the temp into\n        -> [instr]\n        -> RegM freeRegs [instr]\n\nloadTemp vreg (ReadMem slot) hreg spills\n = do\n        insn <- loadR (RegReal hreg) slot\n        recordSpill (SpillLoad $ getUnique vreg)\n        return  $  {- COMMENT (fsLit \"spill load\") : -} insn : spills\n\nloadTemp _ _ _ spills =\n   return spills\n\n", "num_lines": 918}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | The assignment of virtual registers to stack slots\n\n--      We have lots of stack slots. Memory-to-memory moves are a pain on most\n--      architectures. Therefore, we avoid having to generate memory-to-memory moves\n--      by simply giving every virtual register its own stack slot.\n\n--      The StackMap stack map keeps track of virtual register - stack slot\n--      associations and of which stack slots are still free. Once it has been\n--      associated, a stack slot is never \"freed\" or removed from the StackMap again,\n--      it remains associated until we are done with the current CmmProc.\n--\nmodule RegAlloc.Linear.StackMap (\n        StackSlot,\n        StackMap(..),\n        emptyStackMap,\n        getStackSlotFor,\n        getStackUse\n)\n\nwhere\n\nimport GhcPrelude\n\nimport DynFlags\nimport UniqFM\nimport Unique\n\n\n-- | Identifier for a stack slot.\ntype StackSlot = Int\n\ndata StackMap\n        = StackMap\n        { -- | The slots that are still available to be allocated.\n          stackMapNextFreeSlot  :: !Int\n\n          -- | Assignment of vregs to stack slots.\n        , stackMapAssignment    :: UniqFM StackSlot }\n\n\n-- | An empty stack map, with all slots available.\nemptyStackMap :: DynFlags -> StackMap\nemptyStackMap _ = StackMap 0 emptyUFM\n\n\n-- | If this vreg unique already has a stack assignment then return the slot number,\n--      otherwise allocate a new slot, and update the map.\n--\ngetStackSlotFor :: StackMap -> Unique -> (StackMap, Int)\n\ngetStackSlotFor fs@(StackMap _ reserved) reg\n  | Just slot <- lookupUFM reserved reg  =  (fs, slot)\n\ngetStackSlotFor (StackMap freeSlot reserved) reg =\n    (StackMap (freeSlot+1) (addToUFM reserved reg freeSlot), freeSlot)\n\n-- | Return the number of stack slots that were allocated\ngetStackUse :: StackMap -> Int\ngetStackUse (StackMap freeSlot _) = freeSlot\n\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\n-- | State monad for the linear register allocator.\n\n--      Here we keep all the state that the register allocator keeps track\n--      of as it walks the instructions in a basic block.\n\nmodule RegAlloc.Linear.State (\n        RA_State(..),\n        RegM,\n        runR,\n\n        spillR,\n        loadR,\n\n        getFreeRegsR,\n        setFreeRegsR,\n\n        getAssigR,\n        setAssigR,\n\n        getBlockAssigR,\n        setBlockAssigR,\n\n        setDeltaR,\n        getDeltaR,\n\n        getUniqueR,\n\n        recordSpill,\n        recordFixupBlock\n)\nwhere\n\nimport GhcPrelude\n\nimport RegAlloc.Linear.Stats\nimport RegAlloc.Linear.StackMap\nimport RegAlloc.Linear.Base\nimport RegAlloc.Liveness\nimport Instruction\nimport Reg\nimport BlockId\n\nimport DynFlags\nimport Unique\nimport UniqSupply\n\nimport Control.Monad (liftM, ap)\n\n-- | The register allocator monad type.\nnewtype RegM freeRegs a\n        = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) }\n\ninstance Functor (RegM freeRegs) where\n      fmap = liftM\n\ninstance Applicative (RegM freeRegs) where\n      pure a  =  RegM $ \\s -> (# s, a #)\n      (<*>) = ap\n\ninstance Monad (RegM freeRegs) where\n  m >>= k   =  RegM $ \\s -> case unReg m s of { (# s, a #) -> unReg (k a) s }\n\ninstance HasDynFlags (RegM a) where\n    getDynFlags = RegM $ \\s -> (# s, ra_DynFlags s #)\n\n\n-- | Run a computation in the RegM register allocator monad.\nrunR    :: DynFlags\n        -> BlockAssignment freeRegs\n        -> freeRegs\n        -> RegMap Loc\n        -> StackMap\n        -> UniqSupply\n        -> RegM freeRegs a\n        -> (BlockAssignment freeRegs, StackMap, RegAllocStats, a)\n\nrunR dflags block_assig freeregs assig stack us thing =\n  case unReg thing\n        (RA_State\n                { ra_blockassig = block_assig\n                , ra_freeregs   = freeregs\n                , ra_assig      = assig\n                , ra_delta      = 0{-???-}\n                , ra_stack      = stack\n                , ra_us         = us\n                , ra_spills     = []\n                , ra_DynFlags   = dflags\n                , ra_fixups     = [] })\n   of\n        (# state'@RA_State\n                { ra_blockassig = block_assig\n                , ra_stack      = stack' }\n                , returned_thing #)\n\n         ->     (block_assig, stack', makeRAStats state', returned_thing)\n\n\n-- | Make register allocator stats from its final state.\nmakeRAStats :: RA_State freeRegs -> RegAllocStats\nmakeRAStats state\n        = RegAllocStats\n        { ra_spillInstrs        = binSpillReasons (ra_spills state)\n        , ra_fixupList          = ra_fixups state }\n\n\nspillR :: Instruction instr\n       => Reg -> Unique -> RegM freeRegs (instr, Int)\n\nspillR reg temp = RegM $ \\ s@RA_State{ra_delta=delta, ra_stack=stack} ->\n  let dflags = ra_DynFlags s\n      (stack',slot) = getStackSlotFor stack temp\n      instr  = mkSpillInstr dflags reg delta slot\n  in\n  (# s{ra_stack=stack'}, (instr,slot) #)\n\n\nloadR :: Instruction instr\n      => Reg -> Int -> RegM freeRegs instr\n\nloadR reg slot = RegM $ \\ s@RA_State{ra_delta=delta} ->\n  let dflags = ra_DynFlags s\n  in (# s, mkLoadInstr dflags reg delta slot #)\n\ngetFreeRegsR :: RegM freeRegs freeRegs\ngetFreeRegsR = RegM $ \\ s@RA_State{ra_freeregs = freeregs} ->\n  (# s, freeregs #)\n\nsetFreeRegsR :: freeRegs -> RegM freeRegs ()\nsetFreeRegsR regs = RegM $ \\ s ->\n  (# s{ra_freeregs = regs}, () #)\n\ngetAssigR :: RegM freeRegs (RegMap Loc)\ngetAssigR = RegM $ \\ s@RA_State{ra_assig = assig} ->\n  (# s, assig #)\n\nsetAssigR :: RegMap Loc -> RegM freeRegs ()\nsetAssigR assig = RegM $ \\ s ->\n  (# s{ra_assig=assig}, () #)\n\ngetBlockAssigR :: RegM freeRegs (BlockAssignment freeRegs)\ngetBlockAssigR = RegM $ \\ s@RA_State{ra_blockassig = assig} ->\n  (# s, assig #)\n\nsetBlockAssigR :: BlockAssignment freeRegs -> RegM freeRegs ()\nsetBlockAssigR assig = RegM $ \\ s ->\n  (# s{ra_blockassig = assig}, () #)\n\nsetDeltaR :: Int -> RegM freeRegs ()\nsetDeltaR n = RegM $ \\ s ->\n  (# s{ra_delta = n}, () #)\n\ngetDeltaR :: RegM freeRegs Int\ngetDeltaR = RegM $ \\s -> (# s, ra_delta s #)\n\ngetUniqueR :: RegM freeRegs Unique\ngetUniqueR = RegM $ \\s ->\n  case takeUniqFromSupply (ra_us s) of\n    (uniq, us) -> (# s{ra_us = us}, uniq #)\n\n\n-- | Record that a spill instruction was inserted, for profiling.\nrecordSpill :: SpillReason -> RegM freeRegs ()\nrecordSpill spill\n    = RegM $ \\s -> (# s { ra_spills = spill : ra_spills s}, () #)\n\n-- | Record a created fixup block\nrecordFixupBlock :: BlockId -> BlockId -> BlockId -> RegM freeRegs ()\nrecordFixupBlock from between to\n    = RegM $ \\s -> (# s { ra_fixups = (from,between,to) : ra_fixups s}, () #)\n", "num_lines": 172}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module RegAlloc.Linear.Stats (\n        binSpillReasons,\n        countRegRegMovesNat,\n        pprStats\n)\n\nwhere\n\nimport GhcPrelude\n\nimport RegAlloc.Linear.Base\nimport RegAlloc.Liveness\nimport Instruction\n\nimport UniqFM\nimport Outputable\n\nimport State\n\n-- | Build a map of how many times each reg was alloced, clobbered, loaded etc.\nbinSpillReasons\n        :: [SpillReason] -> UniqFM [Int]\n\nbinSpillReasons reasons\n        = addListToUFM_C\n                (zipWith (+))\n                emptyUFM\n                (map (\\reason -> case reason of\n                        SpillAlloc r    -> (r, [1, 0, 0, 0, 0])\n                        SpillClobber r  -> (r, [0, 1, 0, 0, 0])\n                        SpillLoad r     -> (r, [0, 0, 1, 0, 0])\n                        SpillJoinRR r   -> (r, [0, 0, 0, 1, 0])\n                        SpillJoinRM r   -> (r, [0, 0, 0, 0, 1])) reasons)\n\n\n-- | Count reg-reg moves remaining in this code.\ncountRegRegMovesNat\n        :: Instruction instr\n        => NatCmmDecl statics instr -> Int\n\ncountRegRegMovesNat cmm\n        = execState (mapGenBlockTopM countBlock cmm) 0\n where\n        countBlock b@(BasicBlock _ instrs)\n         = do   mapM_ countInstr instrs\n                return  b\n\n        countInstr instr\n                | Just _        <- takeRegRegMoveInstr instr\n                = do    modify (+ 1)\n                        return instr\n\n                | otherwise\n                =       return instr\n\n\n-- | Pretty print some RegAllocStats\npprStats\n        :: Instruction instr\n        => [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc\n\npprStats code statss\n = let  -- sum up all the instrs inserted by the spiller\n        spills          = foldl' (plusUFM_C (zipWith (+)))\n                                emptyUFM\n                        $ map ra_spillInstrs statss\n\n        spillTotals     = foldl' (zipWith (+))\n                                [0, 0, 0, 0, 0]\n                        $ nonDetEltsUFM spills\n                        -- See Note [Unique Determinism and code generation]\n\n        -- count how many reg-reg-moves remain in the code\n        moves           = sum $ map countRegRegMovesNat code\n\n        pprSpill (reg, spills)\n                = parens $ (hcat $ punctuate (text \", \")  (doubleQuotes (ppr reg) : map ppr spills))\n\n   in   (  text \"-- spills-added-total\"\n        $$ text \"--    (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)\"\n        $$ (parens $ (hcat $ punctuate (text \", \") (map ppr spillTotals ++ [ppr moves])))\n        $$ text \"\"\n        $$ text \"-- spills-added\"\n        $$ text \"--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)\"\n        $$ (pprUFMWithKeys spills (vcat . map pprSpill))\n        $$ text \"\")\n\n", "num_lines": 88}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Free regs map for PowerPC\nmodule RegAlloc.Linear.PPC.FreeRegs\nwhere\n\nimport GhcPrelude\n\nimport PPC.Regs\nimport RegClass\nimport Reg\n\nimport Outputable\nimport Platform\n\nimport Data.Word\nimport Data.Bits\n\n-- The PowerPC has 32 integer and 32 floating point registers.\n-- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much\n-- better.\n-- Note that when getFreeRegs scans for free registers, it starts at register\n-- 31 and counts down. This is a hack for the PowerPC - the higher-numbered\n-- registers are callee-saves, while the lower regs are caller-saves, so it\n-- makes sense to start at the high end.\n-- Apart from that, the code does nothing PowerPC-specific, so feel free to\n-- add your favourite platform to the #if (if you have 64 registers but only\n-- 32-bit words).\n\ndata FreeRegs = FreeRegs !Word32 !Word32\n              deriving( Show )  -- The Show is used in an ASSERT\n\nnoFreeRegs :: FreeRegs\nnoFreeRegs = FreeRegs 0 0\n\nreleaseReg :: RealReg -> FreeRegs -> FreeRegs\nreleaseReg (RealRegSingle r) (FreeRegs g f)\n    | r > 31    = FreeRegs g (f .|. (1 `shiftL` (r - 32)))\n    | otherwise = FreeRegs (g .|. (1 `shiftL` r)) f\n\nreleaseReg _ _\n        = panic \"RegAlloc.Linear.PPC.releaseReg: bad reg\"\n\ninitFreeRegs :: Platform -> FreeRegs\ninitFreeRegs platform = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)\n\ngetFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily\ngetFreeRegs cls (FreeRegs g f)\n    | RcDouble <- cls = go f (0x80000000) 63\n    | RcInteger <- cls = go g (0x80000000) 31\n    | otherwise = pprPanic \"RegAllocLinear.getFreeRegs: Bad register class\" (ppr cls)\n    where\n        go _ 0 _ = []\n        go x m i | x .&. m /= 0 = RealRegSingle i : (go x (m `shiftR` 1) $! i-1)\n                 | otherwise    = go x (m `shiftR` 1) $! i-1\n\nallocateReg :: RealReg -> FreeRegs -> FreeRegs\nallocateReg (RealRegSingle r) (FreeRegs g f)\n    | r > 31    = FreeRegs g (f .&. complement (1 `shiftL` (r - 32)))\n    | otherwise = FreeRegs (g .&. complement (1 `shiftL` r)) f\n\nallocateReg _ _\n        = panic \"RegAlloc.Linear.PPC.allocateReg: bad reg\"\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Free regs map for SPARC\nmodule RegAlloc.Linear.SPARC.FreeRegs\nwhere\n\nimport GhcPrelude\n\nimport SPARC.Regs\nimport RegClass\nimport Reg\n\nimport CodeGen.Platform\nimport Outputable\nimport Platform\n\nimport Data.Word\nimport Data.Bits\n\n\n--------------------------------------------------------------------------------\n-- SPARC is like PPC, except for twinning of floating point regs.\n--      When we allocate a double reg we must take an even numbered\n--      float reg, as well as the one after it.\n\n\n-- Holds bitmaps showing what registers are currently allocated.\n--      The float and double reg bitmaps overlap, but we only alloc\n--      float regs into the float map, and double regs into the double map.\n--\n--      Free regs have a bit set in the corresponding bitmap.\n--\ndata FreeRegs\n        = FreeRegs\n                !Word32         -- int    reg bitmap    regs  0..31\n                !Word32         -- float  reg bitmap    regs 32..63\n                !Word32         -- double reg bitmap    regs 32..63\n\ninstance Show FreeRegs where\n        show = showFreeRegs\n\n-- | A reg map where no regs are free to be allocated.\nnoFreeRegs :: FreeRegs\nnoFreeRegs = FreeRegs 0 0 0\n\n\n-- | The initial set of free regs.\ninitFreeRegs :: Platform -> FreeRegs\ninitFreeRegs platform\n =      foldl' (flip $ releaseReg platform) noFreeRegs allocatableRegs\n\n\n-- | Get all the free registers of this class.\ngetFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily\ngetFreeRegs cls (FreeRegs g f d)\n        | RcInteger <- cls = map RealRegSingle                  $ go 1 g 1 0\n        | RcFloat   <- cls = map RealRegSingle                  $ go 1 f 1 32\n        | RcDouble  <- cls = map (\\i -> RealRegPair i (i+1))    $ go 2 d 1 32\n        | otherwise = pprPanic \"RegAllocLinear.getFreeRegs: Bad register class \" (ppr cls)\n        where\n                go _    _      0    _\n                        = []\n\n                go step bitmap mask ix\n                        | bitmap .&. mask /= 0\n                        = ix : (go step bitmap (mask `shiftL` step) $! ix + step)\n\n                        | otherwise\n                        = go step bitmap (mask `shiftL` step) $! ix + step\n\n\n-- | Grab a register.\nallocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs\nallocateReg platform\n         reg@(RealRegSingle r)\n             (FreeRegs g f d)\n\n        -- can't allocate free regs\n        | not $ freeReg platform r\n        = pprPanic \"SPARC.FreeRegs.allocateReg: not allocating pinned reg\" (ppr reg)\n\n        -- a general purpose reg\n        | r <= 31\n        = let   mask    = complement (bitMask r)\n          in    FreeRegs\n                        (g .&. mask)\n                        f\n                        d\n\n        -- a float reg\n        | r >= 32, r <= 63\n        = let   mask    = complement (bitMask (r - 32))\n\n                -- the mask of the double this FP reg aliases\n                maskLow = if r `mod` 2 == 0\n                                then complement (bitMask (r - 32))\n                                else complement (bitMask (r - 32 - 1))\n          in    FreeRegs\n                        g\n                        (f .&. mask)\n                        (d .&. maskLow)\n\n        | otherwise\n        = pprPanic \"SPARC.FreeRegs.releaseReg: not allocating bad reg\" (ppr reg)\n\nallocateReg _\n         reg@(RealRegPair r1 r2)\n             (FreeRegs g f d)\n\n        | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0\n        , r2 >= 32, r2 <= 63\n        = let   mask1   = complement (bitMask (r1 - 32))\n                mask2   = complement (bitMask (r2 - 32))\n          in\n                FreeRegs\n                        g\n                        ((f .&. mask1) .&. mask2)\n                        (d .&. mask1)\n\n        | otherwise\n        = pprPanic \"SPARC.FreeRegs.releaseReg: not allocating bad reg\" (ppr reg)\n\n\n\n-- | Release a register from allocation.\n--      The register liveness information says that most regs die after a C call,\n--      but we still don't want to allocate to some of them.\n--\nreleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs\nreleaseReg platform\n         reg@(RealRegSingle r)\n        regs@(FreeRegs g f d)\n\n        -- don't release pinned reg\n        | not $ freeReg platform r\n        = regs\n\n        -- a general purpose reg\n        | r <= 31\n        = let   mask    = bitMask r\n          in    FreeRegs (g .|. mask) f d\n\n        -- a float reg\n        | r >= 32, r <= 63\n        = let   mask    = bitMask (r - 32)\n\n                -- the mask of the double this FP reg aliases\n                maskLow = if r `mod` 2 == 0\n                                then bitMask (r - 32)\n                                else bitMask (r - 32 - 1)\n          in    FreeRegs\n                        g\n                        (f .|. mask)\n                        (d .|. maskLow)\n\n        | otherwise\n        = pprPanic \"SPARC.FreeRegs.releaseReg: not releasing bad reg\" (ppr reg)\n\nreleaseReg _\n         reg@(RealRegPair r1 r2)\n             (FreeRegs g f d)\n\n        | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0\n        , r2 >= 32, r2 <= 63\n        = let   mask1   = bitMask (r1 - 32)\n                mask2   = bitMask (r2 - 32)\n          in\n                FreeRegs\n                        g\n                        ((f .|. mask1) .|. mask2)\n                        (d .|. mask1)\n\n        | otherwise\n        = pprPanic \"SPARC.FreeRegs.releaseReg: not releasing bad reg\" (ppr reg)\n\n\n\nbitMask :: Int -> Word32\nbitMask n       = 1 `shiftL` n\n\n\nshowFreeRegs :: FreeRegs -> String\nshowFreeRegs regs\n        =  \"FreeRegs\\n\"\n        ++ \"    integer: \" ++ (show $ getFreeRegs RcInteger regs)       ++ \"\\n\"\n        ++ \"      float: \" ++ (show $ getFreeRegs RcFloat   regs)       ++ \"\\n\"\n        ++ \"     double: \" ++ (show $ getFreeRegs RcDouble  regs)       ++ \"\\n\"\n\n", "num_lines": 188}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Free regs map for i386\nmodule RegAlloc.Linear.X86.FreeRegs\nwhere\n\nimport GhcPrelude\n\nimport X86.Regs\nimport RegClass\nimport Reg\nimport Panic\nimport Platform\n\nimport Data.Word\nimport Data.Bits\n\nnewtype FreeRegs = FreeRegs Word32\n    deriving Show\n\nnoFreeRegs :: FreeRegs\nnoFreeRegs = FreeRegs 0\n\nreleaseReg :: RealReg -> FreeRegs -> FreeRegs\nreleaseReg (RealRegSingle n) (FreeRegs f)\n        = FreeRegs (f .|. (1 `shiftL` n))\n\nreleaseReg _ _\n        = panic \"RegAlloc.Linear.X86.FreeRegs.releaseReg: no reg\"\n\ninitFreeRegs :: Platform -> FreeRegs\ninitFreeRegs platform\n        = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)\n\ngetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily\ngetFreeRegs platform cls (FreeRegs f) = go f 0\n\n  where go 0 _ = []\n        go n m\n          | n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls\n          = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))\n\n          | otherwise\n          = go (n `shiftR` 1) $! (m+1)\n        -- ToDo: there's no point looking through all the integer registers\n        -- in order to find a floating-point one.\n\nallocateReg :: RealReg -> FreeRegs -> FreeRegs\nallocateReg (RealRegSingle r) (FreeRegs f)\n        = FreeRegs (f .&. complement (1 `shiftL` r))\n\nallocateReg _ _\n        = panic \"RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg\"\n\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Free regs map for x86_64\nmodule RegAlloc.Linear.X86_64.FreeRegs\nwhere\n\nimport GhcPrelude\n\nimport X86.Regs\nimport RegClass\nimport Reg\nimport Panic\nimport Platform\n\nimport Data.Word\nimport Data.Bits\n\nnewtype FreeRegs = FreeRegs Word64\n    deriving Show\n\nnoFreeRegs :: FreeRegs\nnoFreeRegs = FreeRegs 0\n\nreleaseReg :: RealReg -> FreeRegs -> FreeRegs\nreleaseReg (RealRegSingle n) (FreeRegs f)\n        = FreeRegs (f .|. (1 `shiftL` n))\n\nreleaseReg _ _\n        = panic \"RegAlloc.Linear.X86_64.FreeRegs.releaseReg: no reg\"\n\ninitFreeRegs :: Platform -> FreeRegs\ninitFreeRegs platform\n        = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)\n\ngetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily\ngetFreeRegs platform cls (FreeRegs f) = go f 0\n\n  where go 0 _ = []\n        go n m\n          | n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls\n          = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))\n\n          | otherwise\n          = go (n `shiftR` 1) $! (m+1)\n        -- ToDo: there's no point looking through all the integer registers\n        -- in order to find a floating-point one.\n\nallocateReg :: RealReg -> FreeRegs -> FreeRegs\nallocateReg (RealRegSingle r) (FreeRegs f)\n        = FreeRegs (f .&. complement (1 `shiftL` r))\n\nallocateReg _ _\n        = panic \"RegAlloc.Linear.X86_64.FreeRegs.allocateReg: no reg\"\n\n\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule SPARC.AddrMode (\n        AddrMode(..),\n        addrOffset\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.Imm\nimport SPARC.Base\nimport Reg\n\n-- addressing modes ------------------------------------------------------------\n\n-- | Represents a memory address in an instruction.\n--      Being a RISC machine, the SPARC addressing modes are very regular.\n--\ndata AddrMode\n        = AddrRegReg    Reg Reg         -- addr = r1 + r2\n        | AddrRegImm    Reg Imm         -- addr = r1 + imm\n\n\n-- | Add an integer offset to the address in an AddrMode.\n--\naddrOffset :: AddrMode -> Int -> Maybe AddrMode\naddrOffset addr off\n  = case addr of\n      AddrRegImm r (ImmInt n)\n       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))\n       | otherwise     -> Nothing\n       where n2 = n + off\n\n      AddrRegImm r (ImmInteger n)\n       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))\n       | otherwise     -> Nothing\n       where n2 = n + toInteger off\n\n      AddrRegReg r (RegReal (RealRegSingle 0))\n       | fits13Bits off -> Just (AddrRegImm r (ImmInt off))\n       | otherwise     -> Nothing\n\n      _ -> Nothing\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Bits and pieces on the bottom of the module dependency tree.\n--      Also import the required constants, so we know what we're using.\n--\n--      In the interests of cross-compilation, we want to free ourselves\n--      from the autoconf generated modules like main/Constants\n\nmodule SPARC.Base (\n        wordLength,\n        wordLengthInBits,\n        spillAreaLength,\n        spillSlotSize,\n        extraStackArgsHere,\n        fits13Bits,\n        is32BitInteger,\n        largeOffsetError\n)\n\nwhere\n\nimport GhcPrelude\n\nimport DynFlags\nimport Panic\n\nimport Data.Int\n\n\n-- On 32 bit SPARC, pointers are 32 bits.\nwordLength :: Int\nwordLength = 4\n\nwordLengthInBits :: Int\nwordLengthInBits\n        = wordLength * 8\n\n-- Size of the available spill area\nspillAreaLength :: DynFlags -> Int\nspillAreaLength\n        = rESERVED_C_STACK_BYTES\n\n-- | We need 8 bytes because our largest registers are 64 bit.\nspillSlotSize :: Int\nspillSlotSize = 8\n\n\n-- | We (allegedly) put the first six C-call arguments in registers;\n--      where do we start putting the rest of them?\nextraStackArgsHere :: Int\nextraStackArgsHere = 23\n\n\n{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}\n-- | Check whether an offset is representable with 13 bits.\nfits13Bits :: Integral a => a -> Bool\nfits13Bits x = x >= -4096 && x < 4096\n\n-- | Check whether an integer will fit in 32 bits.\n--      A CmmInt is intended to be truncated to the appropriate\n--      number of bits, so here we truncate it to Int64.  This is\n--      important because e.g. -1 as a CmmInt might be either\n--      -1 or 18446744073709551615.\n--\nis32BitInteger :: Integer -> Bool\nis32BitInteger i\n        = i64 <= 0x7fffffff && i64 >= -0x80000000\n        where i64 = fromIntegral i :: Int64\n\n\n-- | Sadness.\nlargeOffsetError :: (Show a) => a -> b\nlargeOffsetError i\n  = panic (\"ERROR: SPARC native-code generator cannot handle large offset (\"\n                ++ show i ++ \");\\nprobably because of large constant data structures;\" ++\n                \"\\nworkaround: use -fllvm on this module.\\n\")\n\n\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Generating machine code (instruction selection)\n--\n-- (c) The University of Glasgow 1996-2013\n--\n-----------------------------------------------------------------------------\n\n{-# LANGUAGE GADTs #-}\nmodule SPARC.CodeGen (\n        cmmTopCodeGen,\n        generateJumpTableForInstr,\n        InstrBlock\n)\n\nwhere\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n#include \"../includes/MachDeps.h\"\n\n-- NCG stuff:\nimport GhcPrelude\n\nimport SPARC.Base\nimport SPARC.CodeGen.Sanity\nimport SPARC.CodeGen.Amode\nimport SPARC.CodeGen.CondCode\nimport SPARC.CodeGen.Gen64\nimport SPARC.CodeGen.Gen32\nimport SPARC.CodeGen.Base\nimport SPARC.Ppr        ()\nimport SPARC.Instr\nimport SPARC.Imm\nimport SPARC.AddrMode\nimport SPARC.Regs\nimport SPARC.Stack\nimport Instruction\nimport Format\nimport NCGMonad   ( NatM, getNewRegNat, getNewLabelNat )\n\n-- Our intermediate code:\nimport BlockId\nimport Cmm\nimport CmmUtils\nimport CmmSwitch\nimport Hoopl.Block\nimport Hoopl.Graph\nimport PIC\nimport Reg\nimport CLabel\nimport CPrim\n\n-- The rest:\nimport BasicTypes\nimport DynFlags\nimport FastString\nimport OrdList\nimport Outputable\nimport Platform\n\nimport Control.Monad    ( mapAndUnzipM )\n\n-- | Top level code generation\ncmmTopCodeGen :: RawCmmDecl\n              -> NatM [NatCmmDecl CmmStatics Instr]\n\ncmmTopCodeGen (CmmProc info lab live graph)\n = do let blocks = toBlockListEntryFirst graph\n      (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks\n\n      let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)\n      let tops = proc : concat statics\n\n      return tops\n\ncmmTopCodeGen (CmmData sec dat) = do\n  return [CmmData sec dat]  -- no translation, we just use CmmStatic\n\n\n-- | Do code generation on a single block of CMM code.\n--      code generation may introduce new basic block boundaries, which\n--      are indicated by the NEWBLOCK instruction.  We must split up the\n--      instruction stream into basic blocks again.  Also, we extract\n--      LDATAs here too.\nbasicBlockCodeGen :: CmmBlock\n                  -> NatM ( [NatBasicBlock Instr]\n                          , [NatCmmDecl CmmStatics Instr])\n\nbasicBlockCodeGen block = do\n  let (_, nodes, tail)  = blockSplit block\n      id = entryLabel block\n      stmts = blockToList nodes\n  mid_instrs <- stmtsToInstrs stmts\n  tail_instrs <- stmtToInstrs tail\n  let instrs = mid_instrs `appOL` tail_instrs\n  let\n        (top,other_blocks,statics)\n                = foldrOL mkBlocks ([],[],[]) instrs\n\n        mkBlocks (NEWBLOCK id) (instrs,blocks,statics)\n          = ([], BasicBlock id instrs : blocks, statics)\n\n        mkBlocks (LDATA sec dat) (instrs,blocks,statics)\n          = (instrs, blocks, CmmData sec dat:statics)\n\n        mkBlocks instr (instrs,blocks,statics)\n          = (instr:instrs, blocks, statics)\n\n        -- do intra-block sanity checking\n        blocksChecked\n                = map (checkBlock block)\n                $ BasicBlock id top : other_blocks\n\n  return (blocksChecked, statics)\n\n\n-- | Convert some Cmm statements to SPARC instructions.\nstmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock\nstmtsToInstrs stmts\n   = do instrss <- mapM stmtToInstrs stmts\n        return (concatOL instrss)\n\n\nstmtToInstrs :: CmmNode e x -> NatM InstrBlock\nstmtToInstrs stmt = do\n  dflags <- getDynFlags\n  case stmt of\n    CmmComment s   -> return (unitOL (COMMENT s))\n    CmmTick {}     -> return nilOL\n    CmmUnwind {}   -> return nilOL\n\n    CmmAssign reg src\n      | isFloatType ty  -> assignReg_FltCode format reg src\n      | isWord64 ty     -> assignReg_I64Code        reg src\n      | otherwise       -> assignReg_IntCode format reg src\n        where ty = cmmRegType dflags reg\n              format = cmmTypeFormat ty\n\n    CmmStore addr src\n      | isFloatType ty  -> assignMem_FltCode format addr src\n      | isWord64 ty     -> assignMem_I64Code      addr src\n      | otherwise       -> assignMem_IntCode format addr src\n        where ty = cmmExprType dflags src\n              format = cmmTypeFormat ty\n\n    CmmUnsafeForeignCall target result_regs args\n       -> genCCall target result_regs args\n\n    CmmBranch   id              -> genBranch id\n    CmmCondBranch arg true false _ -> do\n      b1 <- genCondJump true arg\n      b2 <- genBranch false\n      return (b1 `appOL` b2)\n    CmmSwitch arg ids   -> do dflags <- getDynFlags\n                              genSwitch dflags arg ids\n    CmmCall { cml_target = arg } -> genJump arg\n\n    _\n     -> panic \"stmtToInstrs: statement should have been cps'd away\"\n\n\n{-\nNow, given a tree (the argument to a CmmLoad) that references memory,\nproduce a suitable addressing mode.\n\nA Rule of the Game (tm) for Amodes: use of the addr bit must\nimmediately follow use of the code part, since the code part puts\nvalues in registers which the addr then refers to.  So you can't put\nanything in between, lest it overwrite some of those registers.  If\nyou need to do some other computation between the code part and use of\nthe addr bit, first store the effective address from the amode in a\ntemporary, then do the other computation, and then use the temporary:\n\n    code\n    LEA amode, tmp\n    ... other computation ...\n    ... (tmp) ...\n-}\n\n\n\n-- | Convert a BlockId to some CmmStatic data\njumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic\njumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))\njumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)\n    where blockLabel = blockLbl blockid\n\n\n\n-- -----------------------------------------------------------------------------\n-- Generating assignments\n\n-- Assignments are really at the heart of the whole code generation\n-- business.  Almost all top-level nodes of any real importance are\n-- assignments, which correspond to loads, stores, or register\n-- transfers.  If we're really lucky, some of the register transfers\n-- will go away, because we can use the destination register to\n-- complete the code generation for the right hand side.  This only\n-- fails when the right hand side is forced into a fixed register\n-- (e.g. the result of a call).\n\nassignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock\nassignMem_IntCode pk addr src = do\n    (srcReg, code) <- getSomeReg src\n    Amode dstAddr addr_code <- getAmode addr\n    return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr\n\n\nassignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock\nassignReg_IntCode _ reg src = do\n    dflags <- getDynFlags\n    r <- getRegister src\n    let dst = getRegisterReg (targetPlatform dflags) reg\n    return $ case r of\n        Any _ code         -> code dst\n        Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst\n\n\n\n-- Floating point assignment to memory\nassignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock\nassignMem_FltCode pk addr src = do\n    dflags <- getDynFlags\n    Amode dst__2 code1 <- getAmode addr\n    (src__2, code2) <- getSomeReg src\n    tmp1 <- getNewRegNat pk\n    let\n        pk__2   = cmmExprType dflags src\n        code__2 = code1 `appOL` code2 `appOL`\n            if   formatToWidth pk == typeWidth pk__2\n            then unitOL (ST pk src__2 dst__2)\n            else toOL   [ FxTOy (cmmTypeFormat pk__2) pk src__2 tmp1\n                        , ST    pk tmp1 dst__2]\n    return code__2\n\n-- Floating point assignment to a register/temporary\nassignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock\nassignReg_FltCode pk dstCmmReg srcCmmExpr = do\n    dflags <- getDynFlags\n    let platform = targetPlatform dflags\n    srcRegister <- getRegister srcCmmExpr\n    let dstReg  = getRegisterReg platform dstCmmReg\n\n    return $ case srcRegister of\n        Any _ code                  -> code dstReg\n        Fixed _ srcFixedReg srcCode -> srcCode `snocOL` FMOV pk srcFixedReg dstReg\n\n\n\n\ngenJump :: CmmExpr{-the branch target-} -> NatM InstrBlock\n\ngenJump (CmmLit (CmmLabel lbl))\n  = return (toOL [CALL (Left target) 0 True, NOP])\n  where\n    target = ImmCLbl lbl\n\ngenJump tree\n  = do\n        (target, code) <- getSomeReg tree\n        return (code `snocOL` JMP (AddrRegReg target g0)  `snocOL` NOP)\n\n-- -----------------------------------------------------------------------------\n--  Unconditional branches\n\ngenBranch :: BlockId -> NatM InstrBlock\ngenBranch = return . toOL . mkJumpInstr\n\n\n-- -----------------------------------------------------------------------------\n--  Conditional jumps\n\n{-\nConditional jumps are always to local labels, so we can use branch\ninstructions.  We peek at the arguments to decide what kind of\ncomparison to do.\n\nSPARC: First, we have to ensure that the condition codes are set\naccording to the supplied comparison operation.  We generate slightly\ndifferent code for floating point comparisons, because a floating\npoint operation cannot directly precede a @BF@.  We assume the worst\nand fill that slot with a @NOP@.\n\nSPARC: Do not fill the delay slots here; you will confuse the register\nallocator.\n-}\n\n\ngenCondJump\n    :: BlockId      -- the branch target\n    -> CmmExpr      -- the condition on which to branch\n    -> NatM InstrBlock\n\n\n\ngenCondJump bid bool = do\n  CondCode is_float cond code <- getCondCode bool\n  return (\n       code `appOL`\n       toOL (\n         if   is_float\n         then [NOP, BF cond False bid, NOP]\n         else [BI cond False bid, NOP]\n       )\n    )\n\n\n\n-- -----------------------------------------------------------------------------\n-- Generating a table-branch\n\ngenSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock\ngenSwitch dflags expr targets\n        | positionIndependent dflags\n        = error \"MachCodeGen: sparc genSwitch PIC not finished\\n\"\n\n        | otherwise\n        = do    (e_reg, e_code) <- getSomeReg (cmmOffset dflags expr offset)\n\n                base_reg        <- getNewRegNat II32\n                offset_reg      <- getNewRegNat II32\n                dst             <- getNewRegNat II32\n\n                label           <- getNewLabelNat\n\n                return $ e_code `appOL`\n                 toOL\n                        [ -- load base of jump table\n                          SETHI (HI (ImmCLbl label)) base_reg\n                        , OR    False base_reg (RIImm $ LO $ ImmCLbl label) base_reg\n\n                        -- the addrs in the table are 32 bits wide..\n                        , SLL   e_reg (RIImm $ ImmInt 2) offset_reg\n\n                        -- load and jump to the destination\n                        , LD      II32 (AddrRegReg base_reg offset_reg) dst\n                        , JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label\n                        , NOP ]\n  where (offset, ids) = switchTargetsToTable targets\n\ngenerateJumpTableForInstr :: DynFlags -> Instr\n                          -> Maybe (NatCmmDecl CmmStatics Instr)\ngenerateJumpTableForInstr dflags (JMP_TBL _ ids label) =\n  let jumpTable = map (jumpTableEntry dflags) ids\n  in Just (CmmData (Section ReadOnlyData label) (Statics label jumpTable))\ngenerateJumpTableForInstr _ _ = Nothing\n\n\n\n-- -----------------------------------------------------------------------------\n-- Generating C calls\n\n{-\n   Now the biggest nightmare---calls.  Most of the nastiness is buried in\n   @get_arg@, which moves the arguments to the correct registers/stack\n   locations.  Apart from that, the code is easy.\n\n   The SPARC calling convention is an absolute\n   nightmare.  The first 6x32 bits of arguments are mapped into\n   %o0 through %o5, and the remaining arguments are dumped to the\n   stack, beginning at [%sp+92].  (Note that %o6 == %sp.)\n\n   If we have to put args on the stack, move %o6==%sp down by\n   the number of words to go on the stack, to ensure there's enough space.\n\n   According to Fraser and Hanson's lcc book, page 478, fig 17.2,\n   16 words above the stack pointer is a word for the address of\n   a structure return value.  I use this as a temporary location\n   for moving values from float to int regs.  Certainly it isn't\n   safe to put anything in the 16 words starting at %sp, since\n   this area can get trashed at any time due to window overflows\n   caused by signal handlers.\n\n   A final complication (if the above isn't enough) is that\n   we can't blithely calculate the arguments one by one into\n   %o0 .. %o5.  Consider the following nested calls:\n\n       fff a (fff b c)\n\n   Naive code moves a into %o0, and (fff b c) into %o1.  Unfortunately\n   the inner call will itself use %o0, which trashes the value put there\n   in preparation for the outer call.  Upshot: we need to calculate the\n   args into temporary regs, and move those to arg regs or onto the\n   stack only immediately prior to the call proper.  Sigh.\n-}\n\ngenCCall\n    :: ForeignTarget            -- function to call\n    -> [CmmFormal]        -- where to put the result\n    -> [CmmActual]        -- arguments (of mixed type)\n    -> NatM InstrBlock\n\n\n\n-- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream\n-- are guaranteed to take place before writes afterwards (unlike on PowerPC).\n-- Ref: Section 8.4 of the SPARC V9 Architecture manual.\n--\n-- In the SPARC case we don't need a barrier.\n--\ngenCCall (PrimTarget MO_WriteBarrier) _ _\n = return $ nilOL\n\ngenCCall (PrimTarget (MO_Prefetch_Data _)) _ _\n = return $ nilOL\n\ngenCCall target dest_regs args\n = do   -- work out the arguments, and assign them to integer regs\n        argcode_and_vregs       <- mapM arg_to_int_vregs args\n        let (argcodes, vregss)  = unzip argcode_and_vregs\n        let vregs               = concat vregss\n\n        let n_argRegs           = length allArgRegs\n        let n_argRegs_used      = min (length vregs) n_argRegs\n\n\n        -- deal with static vs dynamic call targets\n        callinsns <- case target of\n                ForeignTarget (CmmLit (CmmLabel lbl)) _ ->\n                        return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))\n\n                ForeignTarget expr _\n                 -> do  (dyn_c, dyn_rs) <- arg_to_int_vregs expr\n                        let dyn_r = case dyn_rs of\n                                      [dyn_r'] -> dyn_r'\n                                      _ -> panic \"SPARC.CodeGen.genCCall: arg_to_int\"\n                        return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)\n\n                PrimTarget mop\n                 -> do  res     <- outOfLineMachOp mop\n                        lblOrMopExpr <- case res of\n                                Left lbl -> do\n                                        return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))\n\n                                Right mopExpr -> do\n                                        (dyn_c, dyn_rs) <- arg_to_int_vregs mopExpr\n                                        let dyn_r = case dyn_rs of\n                                                      [dyn_r'] -> dyn_r'\n                                                      _ -> panic \"SPARC.CodeGen.genCCall: arg_to_int\"\n                                        return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)\n\n                        return lblOrMopExpr\n\n        let argcode = concatOL argcodes\n\n        let (move_sp_down, move_sp_up)\n                   = let diff = length vregs - n_argRegs\n                         nn   = if odd diff then diff + 1 else diff -- keep 8-byte alignment\n                     in  if   nn <= 0\n                         then (nilOL, nilOL)\n                         else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))\n\n        let transfer_code\n                = toOL (move_final vregs allArgRegs extraStackArgsHere)\n\n        dflags <- getDynFlags\n        return\n         $      argcode                 `appOL`\n                move_sp_down            `appOL`\n                transfer_code           `appOL`\n                callinsns               `appOL`\n                unitOL NOP              `appOL`\n                move_sp_up              `appOL`\n                assign_code (targetPlatform dflags) dest_regs\n\n\n-- | Generate code to calculate an argument, and move it into one\n--      or two integer vregs.\narg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])\narg_to_int_vregs arg = do dflags <- getDynFlags\n                          arg_to_int_vregs' dflags arg\n\narg_to_int_vregs' :: DynFlags -> CmmExpr -> NatM (OrdList Instr, [Reg])\narg_to_int_vregs' dflags arg\n\n        -- If the expr produces a 64 bit int, then we can just use iselExpr64\n        | isWord64 (cmmExprType dflags arg)\n        = do    (ChildCode64 code r_lo) <- iselExpr64 arg\n                let r_hi                = getHiVRegFromLo r_lo\n                return (code, [r_hi, r_lo])\n\n        | otherwise\n        = do    (src, code)     <- getSomeReg arg\n                let pk          = cmmExprType dflags arg\n\n                case cmmTypeFormat pk of\n\n                 -- Load a 64 bit float return value into two integer regs.\n                 FF64 -> do\n                        v1 <- getNewRegNat II32\n                        v2 <- getNewRegNat II32\n\n                        let code2 =\n                                code                            `snocOL`\n                                FMOV FF64 src f0                `snocOL`\n                                ST   FF32  f0 (spRel 16)        `snocOL`\n                                LD   II32  (spRel 16) v1        `snocOL`\n                                ST   FF32  f1 (spRel 16)        `snocOL`\n                                LD   II32  (spRel 16) v2\n\n                        return  (code2, [v1,v2])\n\n                 -- Load a 32 bit float return value into an integer reg\n                 FF32 -> do\n                        v1 <- getNewRegNat II32\n\n                        let code2 =\n                                code                            `snocOL`\n                                ST   FF32  src (spRel 16)       `snocOL`\n                                LD   II32  (spRel 16) v1\n\n                        return (code2, [v1])\n\n                 -- Move an integer return value into its destination reg.\n                 _ -> do\n                        v1 <- getNewRegNat II32\n\n                        let code2 =\n                                code                            `snocOL`\n                                OR False g0 (RIReg src) v1\n\n                        return (code2, [v1])\n\n\n-- | Move args from the integer vregs into which they have been\n--      marshalled, into %o0 .. %o5, and the rest onto the stack.\n--\nmove_final :: [Reg] -> [Reg] -> Int -> [Instr]\n\n-- all args done\nmove_final [] _ _\n        = []\n\n-- out of aregs; move to stack\nmove_final (v:vs) [] offset\n        = ST II32 v (spRel offset)\n        : move_final vs [] (offset+1)\n\n-- move into an arg (%o[0..5]) reg\nmove_final (v:vs) (a:az) offset\n        = OR False g0 (RIReg v) a\n        : move_final vs az offset\n\n\n-- | Assign results returned from the call into their\n--      destination regs.\n--\nassign_code :: Platform -> [LocalReg] -> OrdList Instr\n\nassign_code _ [] = nilOL\n\nassign_code platform [dest]\n = let  rep     = localRegType dest\n        width   = typeWidth rep\n        r_dest  = getRegisterReg platform (CmmLocal dest)\n\n        result\n                | isFloatType rep\n                , W32   <- width\n                = unitOL $ FMOV FF32 (regSingle $ fReg 0) r_dest\n\n                | isFloatType rep\n                , W64   <- width\n                = unitOL $ FMOV FF64 (regSingle $ fReg 0) r_dest\n\n                | not $ isFloatType rep\n                , W32   <- width\n                = unitOL $ mkRegRegMoveInstr platform (regSingle $ oReg 0) r_dest\n\n                | not $ isFloatType rep\n                , W64           <- width\n                , r_dest_hi     <- getHiVRegFromLo r_dest\n                = toOL  [ mkRegRegMoveInstr platform (regSingle $ oReg 0) r_dest_hi\n                        , mkRegRegMoveInstr platform (regSingle $ oReg 1) r_dest]\n\n                | otherwise\n                = panic \"SPARC.CodeGen.GenCCall: no match\"\n\n   in   result\n\nassign_code _ _\n        = panic \"SPARC.CodeGen.GenCCall: no match\"\n\n\n\n-- | Generate a call to implement an out-of-line floating point operation\noutOfLineMachOp\n        :: CallishMachOp\n        -> NatM (Either CLabel CmmExpr)\n\noutOfLineMachOp mop\n = do   let functionName\n                = outOfLineMachOp_table mop\n\n        dflags  <- getDynFlags\n        mopExpr <- cmmMakeDynamicReference dflags CallReference\n                $  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction\n\n        let mopLabelOrExpr\n                = case mopExpr of\n                        CmmLit (CmmLabel lbl)   -> Left lbl\n                        _                       -> Right mopExpr\n\n        return mopLabelOrExpr\n\n\n-- | Decide what C function to use to implement a CallishMachOp\n--\noutOfLineMachOp_table\n        :: CallishMachOp\n        -> FastString\n\noutOfLineMachOp_table mop\n = case mop of\n        MO_F32_Exp    -> fsLit \"expf\"\n        MO_F32_Log    -> fsLit \"logf\"\n        MO_F32_Sqrt   -> fsLit \"sqrtf\"\n        MO_F32_Fabs   -> unsupported\n        MO_F32_Pwr    -> fsLit \"powf\"\n\n        MO_F32_Sin    -> fsLit \"sinf\"\n        MO_F32_Cos    -> fsLit \"cosf\"\n        MO_F32_Tan    -> fsLit \"tanf\"\n\n        MO_F32_Asin   -> fsLit \"asinf\"\n        MO_F32_Acos   -> fsLit \"acosf\"\n        MO_F32_Atan   -> fsLit \"atanf\"\n\n        MO_F32_Sinh   -> fsLit \"sinhf\"\n        MO_F32_Cosh   -> fsLit \"coshf\"\n        MO_F32_Tanh   -> fsLit \"tanhf\"\n\n        MO_F32_Asinh  -> fsLit \"asinhf\"\n        MO_F32_Acosh  -> fsLit \"acoshf\"\n        MO_F32_Atanh  -> fsLit \"atanhf\"\n\n        MO_F64_Exp    -> fsLit \"exp\"\n        MO_F64_Log    -> fsLit \"log\"\n        MO_F64_Sqrt   -> fsLit \"sqrt\"\n        MO_F64_Fabs   -> unsupported\n        MO_F64_Pwr    -> fsLit \"pow\"\n\n        MO_F64_Sin    -> fsLit \"sin\"\n        MO_F64_Cos    -> fsLit \"cos\"\n        MO_F64_Tan    -> fsLit \"tan\"\n\n        MO_F64_Asin   -> fsLit \"asin\"\n        MO_F64_Acos   -> fsLit \"acos\"\n        MO_F64_Atan   -> fsLit \"atan\"\n\n        MO_F64_Sinh   -> fsLit \"sinh\"\n        MO_F64_Cosh   -> fsLit \"cosh\"\n        MO_F64_Tanh   -> fsLit \"tanh\"\n\n        MO_F64_Asinh  -> fsLit \"asinh\"\n        MO_F64_Acosh  -> fsLit \"acosh\"\n        MO_F64_Atanh  -> fsLit \"atanh\"\n\n        MO_UF_Conv w -> fsLit $ word2FloatLabel w\n\n        MO_Memcpy _  -> fsLit \"memcpy\"\n        MO_Memset _  -> fsLit \"memset\"\n        MO_Memmove _ -> fsLit \"memmove\"\n        MO_Memcmp _  -> fsLit \"memcmp\"\n\n        MO_BSwap w   -> fsLit $ bSwapLabel w\n        MO_PopCnt w  -> fsLit $ popCntLabel w\n        MO_Pdep w    -> fsLit $ pdepLabel w\n        MO_Pext w    -> fsLit $ pextLabel w\n        MO_Clz w     -> fsLit $ clzLabel w\n        MO_Ctz w     -> fsLit $ ctzLabel w\n        MO_AtomicRMW w amop -> fsLit $ atomicRMWLabel w amop\n        MO_Cmpxchg w -> fsLit $ cmpxchgLabel w\n        MO_AtomicRead w -> fsLit $ atomicReadLabel w\n        MO_AtomicWrite w -> fsLit $ atomicWriteLabel w\n\n        MO_S_QuotRem {}  -> unsupported\n        MO_U_QuotRem {}  -> unsupported\n        MO_U_QuotRem2 {} -> unsupported\n        MO_Add2 {}       -> unsupported\n        MO_AddWordC {}   -> unsupported\n        MO_SubWordC {}   -> unsupported\n        MO_AddIntC {}    -> unsupported\n        MO_SubIntC {}    -> unsupported\n        MO_U_Mul2 {}     -> unsupported\n        MO_WriteBarrier  -> unsupported\n        MO_Touch         -> unsupported\n        (MO_Prefetch_Data _) -> unsupported\n    where unsupported = panic (\"outOfLineCmmOp: \" ++ show mop\n                            ++ \" not supported here\")\n\n", "num_lines": 695}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SPARC.Cond (\n        Cond(..),\n        condUnsigned,\n        condToSigned,\n        condToUnsigned\n)\n\nwhere\n\nimport GhcPrelude\n\n-- | Branch condition codes.\ndata Cond\n        = ALWAYS\n        | EQQ\n        | GE\n        | GEU\n        | GTT\n        | GU\n        | LE\n        | LEU\n        | LTT\n        | LU\n        | NE\n        | NEG\n        | NEVER\n        | POS\n        | VC\n        | VS\n        deriving Eq\n\n\ncondUnsigned :: Cond -> Bool\ncondUnsigned GU  = True\ncondUnsigned LU  = True\ncondUnsigned GEU = True\ncondUnsigned LEU = True\ncondUnsigned _   = False\n\n\ncondToSigned :: Cond -> Cond\ncondToSigned GU  = GTT\ncondToSigned LU  = LTT\ncondToSigned GEU = GE\ncondToSigned LEU = LE\ncondToSigned x   = x\n\n\ncondToUnsigned :: Cond -> Cond\ncondToUnsigned GTT = GU\ncondToUnsigned LTT = LU\ncondToUnsigned GE  = GEU\ncondToUnsigned LE  = LEU\ncondToUnsigned x   = x\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SPARC.Imm (\n        -- immediate values\n        Imm(..),\n        strImmLit,\n        litToImm\n)\n\nwhere\n\nimport GhcPrelude\n\nimport Cmm\nimport CLabel\n\nimport Outputable\n\n-- | An immediate value.\n--      Not all of these are directly representable by the machine.\n--      Things like ImmLit are slurped out and put in a data segment instead.\n--\ndata Imm\n        = ImmInt        Int\n\n        -- Sigh.\n        | ImmInteger    Integer\n\n        -- AbstractC Label (with baggage)\n        | ImmCLbl       CLabel\n\n        -- Simple string\n        | ImmLit        SDoc\n        | ImmIndex      CLabel Int\n        | ImmFloat      Rational\n        | ImmDouble     Rational\n\n        | ImmConstantSum  Imm Imm\n        | ImmConstantDiff Imm Imm\n\n        | LO    Imm\n        | HI    Imm\n\n\n-- | Create a ImmLit containing this string.\nstrImmLit :: String -> Imm\nstrImmLit s = ImmLit (text s)\n\n\n-- | Convert a CmmLit to an Imm.\n--      Narrow to the width: a CmmInt might be out of\n--      range, but we assume that ImmInteger only contains\n--      in-range values.  A signed value should be fine here.\n--\nlitToImm :: CmmLit -> Imm\nlitToImm lit\n = case lit of\n        CmmInt i w              -> ImmInteger (narrowS w i)\n        CmmFloat f W32          -> ImmFloat f\n        CmmFloat f W64          -> ImmDouble f\n        CmmLabel l              -> ImmCLbl l\n        CmmLabelOff l off       -> ImmIndex l off\n\n        CmmLabelDiffOff l1 l2 off _\n         -> ImmConstantSum\n                (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))\n                (ImmInt off)\n\n        _               -> panic \"SPARC.Regs.litToImm: no match\"\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Machine-dependent assembly language\n--\n-- (c) The University of Glasgow 1993-2004\n--\n-----------------------------------------------------------------------------\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n\nmodule SPARC.Instr (\n        RI(..),\n        riZero,\n\n        fpRelEA,\n        moveSp,\n\n        isUnconditionalJump,\n\n        Instr(..),\n        maxSpillSlots\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.Stack\nimport SPARC.Imm\nimport SPARC.AddrMode\nimport SPARC.Cond\nimport SPARC.Regs\nimport SPARC.Base\nimport TargetReg\nimport Instruction\nimport RegClass\nimport Reg\nimport Format\n\nimport CLabel\nimport CodeGen.Platform\nimport BlockId\nimport DynFlags\nimport Cmm\nimport FastString\nimport Outputable\nimport Platform\n\n\n-- | Register or immediate\ndata RI\n        = RIReg Reg\n        | RIImm Imm\n\n-- | Check if a RI represents a zero value.\n--      - a literal zero\n--      - register %g0, which is always zero.\n--\nriZero :: RI -> Bool\nriZero (RIImm (ImmInt 0))                       = True\nriZero (RIImm (ImmInteger 0))                   = True\nriZero (RIReg (RegReal (RealRegSingle 0)))      = True\nriZero _                                        = False\n\n\n-- | Calculate the effective address which would be used by the\n--      corresponding fpRel sequence.\nfpRelEA :: Int -> Reg -> Instr\nfpRelEA n dst\n   = ADD False False fp (RIImm (ImmInt (n * wordLength))) dst\n\n\n-- | Code to shift the stack pointer by n words.\nmoveSp :: Int -> Instr\nmoveSp n\n   = ADD False False sp (RIImm (ImmInt (n * wordLength))) sp\n\n-- | An instruction that will cause the one after it never to be exectuted\nisUnconditionalJump :: Instr -> Bool\nisUnconditionalJump ii\n = case ii of\n        CALL{}          -> True\n        JMP{}           -> True\n        JMP_TBL{}       -> True\n        BI ALWAYS _ _   -> True\n        BF ALWAYS _ _   -> True\n        _               -> False\n\n\n-- | instance for sparc instruction set\ninstance Instruction Instr where\n        regUsageOfInstr         = sparc_regUsageOfInstr\n        patchRegsOfInstr        = sparc_patchRegsOfInstr\n        isJumpishInstr          = sparc_isJumpishInstr\n        jumpDestsOfInstr        = sparc_jumpDestsOfInstr\n        patchJumpInstr          = sparc_patchJumpInstr\n        mkSpillInstr            = sparc_mkSpillInstr\n        mkLoadInstr             = sparc_mkLoadInstr\n        takeDeltaInstr          = sparc_takeDeltaInstr\n        isMetaInstr             = sparc_isMetaInstr\n        mkRegRegMoveInstr       = sparc_mkRegRegMoveInstr\n        takeRegRegMoveInstr     = sparc_takeRegRegMoveInstr\n        mkJumpInstr             = sparc_mkJumpInstr\n        mkStackAllocInstr       = panic \"no sparc_mkStackAllocInstr\"\n        mkStackDeallocInstr     = panic \"no sparc_mkStackDeallocInstr\"\n\n\n-- | SPARC instruction set.\n--      Not complete. This is only the ones we need.\n--\ndata Instr\n\n        -- meta ops --------------------------------------------------\n        -- comment pseudo-op\n        = COMMENT FastString\n\n        -- some static data spat out during code generation.\n        -- Will be extracted before pretty-printing.\n        | LDATA   Section CmmStatics\n\n        -- Start a new basic block.  Useful during codegen, removed later.\n        -- Preceding instruction should be a jump, as per the invariants\n        -- for a BasicBlock (see Cmm).\n        | NEWBLOCK BlockId\n\n        -- specify current stack offset for benefit of subsequent passes.\n        | DELTA   Int\n\n        -- real instrs -----------------------------------------------\n        -- Loads and stores.\n        | LD            Format AddrMode Reg             -- format, src, dst\n        | ST            Format Reg AddrMode             -- format, src, dst\n\n        -- Int Arithmetic.\n        --      x:   add/sub with carry bit.\n        --              In SPARC V9 addx and friends were renamed addc.\n        --\n        --      cc:  modify condition codes\n        --\n        | ADD           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst\n        | SUB           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst\n\n        | UMUL          Bool Reg RI Reg                 --     cc?, src1, src2, dst\n        | SMUL          Bool Reg RI Reg                 --     cc?, src1, src2, dst\n\n\n        -- The SPARC divide instructions perform 64bit by 32bit division\n        --   The Y register is xored into the first operand.\n\n        --   On _some implementations_ the Y register is overwritten by\n        --   the remainder, so we have to make sure it is 0 each time.\n\n        --   dst <- ((Y `shiftL` 32) `or` src1) `div` src2\n        | UDIV          Bool Reg RI Reg                 --     cc?, src1, src2, dst\n        | SDIV          Bool Reg RI Reg                 --     cc?, src1, src2, dst\n\n        | RDY           Reg                             -- move contents of Y register to reg\n        | WRY           Reg  Reg                        -- Y <- src1 `xor` src2\n\n        -- Logic operations.\n        | AND           Bool Reg RI Reg                 -- cc?, src1, src2, dst\n        | ANDN          Bool Reg RI Reg                 -- cc?, src1, src2, dst\n        | OR            Bool Reg RI Reg                 -- cc?, src1, src2, dst\n        | ORN           Bool Reg RI Reg                 -- cc?, src1, src2, dst\n        | XOR           Bool Reg RI Reg                 -- cc?, src1, src2, dst\n        | XNOR          Bool Reg RI Reg                 -- cc?, src1, src2, dst\n        | SLL           Reg RI Reg                      -- src1, src2, dst\n        | SRL           Reg RI Reg                      -- src1, src2, dst\n        | SRA           Reg RI Reg                      -- src1, src2, dst\n\n        -- Load immediates.\n        | SETHI         Imm Reg                         -- src, dst\n\n        -- Do nothing.\n        -- Implemented by the assembler as SETHI 0, %g0, but worth an alias\n        | NOP\n\n        -- Float Arithmetic.\n        -- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single\n        -- instructions right up until we spit them out.\n        --\n        | FABS          Format Reg Reg                  -- src dst\n        | FADD          Format Reg Reg Reg              -- src1, src2, dst\n        | FCMP          Bool Format Reg Reg             -- exception?, src1, src2, dst\n        | FDIV          Format Reg Reg Reg              -- src1, src2, dst\n        | FMOV          Format Reg Reg                  -- src, dst\n        | FMUL          Format Reg Reg Reg              -- src1, src2, dst\n        | FNEG          Format Reg Reg                  -- src, dst\n        | FSQRT         Format Reg Reg                  -- src, dst\n        | FSUB          Format Reg Reg Reg              -- src1, src2, dst\n        | FxTOy         Format Format Reg Reg           -- src, dst\n\n        -- Jumping around.\n        | BI            Cond Bool BlockId               -- cond, annul?, target\n        | BF            Cond Bool BlockId               -- cond, annul?, target\n\n        | JMP           AddrMode                        -- target\n\n        -- With a tabled jump we know all the possible destinations.\n        -- We also need this info so we can work out what regs are live across the jump.\n        --\n        | JMP_TBL       AddrMode [Maybe BlockId] CLabel\n\n        | CALL          (Either Imm Reg) Int Bool       -- target, args, terminal\n\n\n-- | regUsage returns the sets of src and destination registers used\n--      by a particular instruction.  Machine registers that are\n--      pre-allocated to stgRegs are filtered out, because they are\n--      uninteresting from a register allocation standpoint.  (We wouldn't\n--      want them to end up on the free list!)  As far as we are concerned,\n--      the fixed registers simply don't exist (for allocation purposes,\n--      anyway).\n\n--      regUsage doesn't need to do any trickery for jumps and such.  Just\n--      state precisely the regs read and written by that insn.  The\n--      consequences of control flow transfers, as far as register\n--      allocation goes, are taken care of by the register allocator.\n--\nsparc_regUsageOfInstr :: Platform -> Instr -> RegUsage\nsparc_regUsageOfInstr platform instr\n = case instr of\n    LD    _ addr reg            -> usage (regAddr addr,         [reg])\n    ST    _ reg addr            -> usage (reg : regAddr addr,   [])\n    ADD   _ _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    SUB   _ _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    UMUL    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    SMUL    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    UDIV    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    SDIV    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    RDY       rd                -> usage ([],                   [rd])\n    WRY       r1 r2             -> usage ([r1, r2],             [])\n    AND     _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    ANDN    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    OR      _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    ORN     _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    XOR     _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    XNOR    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    SLL       r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    SRL       r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    SRA       r1 ar r2          -> usage (r1 : regRI ar,        [r2])\n    SETHI   _ reg               -> usage ([],                   [reg])\n    FABS    _ r1 r2             -> usage ([r1],                 [r2])\n    FADD    _ r1 r2 r3          -> usage ([r1, r2],             [r3])\n    FCMP    _ _  r1 r2          -> usage ([r1, r2],             [])\n    FDIV    _ r1 r2 r3          -> usage ([r1, r2],             [r3])\n    FMOV    _ r1 r2             -> usage ([r1],                 [r2])\n    FMUL    _ r1 r2 r3          -> usage ([r1, r2],             [r3])\n    FNEG    _ r1 r2             -> usage ([r1],                 [r2])\n    FSQRT   _ r1 r2             -> usage ([r1],                 [r2])\n    FSUB    _ r1 r2 r3          -> usage ([r1, r2],             [r3])\n    FxTOy   _ _  r1 r2          -> usage ([r1],                 [r2])\n\n    JMP     addr                -> usage (regAddr addr, [])\n    JMP_TBL addr _ _            -> usage (regAddr addr, [])\n\n    CALL  (Left _  )  _ True    -> noUsage\n    CALL  (Left _  )  n False   -> usage (argRegs n, callClobberedRegs)\n    CALL  (Right reg) _ True    -> usage ([reg], [])\n    CALL  (Right reg) n False   -> usage (reg : (argRegs n), callClobberedRegs)\n    _                           -> noUsage\n\n  where\n    usage (src, dst)\n     = RU (filter (interesting platform) src)\n          (filter (interesting platform) dst)\n\n    regAddr (AddrRegReg r1 r2)  = [r1, r2]\n    regAddr (AddrRegImm r1 _)   = [r1]\n\n    regRI (RIReg r)             = [r]\n    regRI  _                    = []\n\n\n-- | Interesting regs are virtuals, or ones that are allocatable\n--      by the register allocator.\ninteresting :: Platform -> Reg -> Bool\ninteresting platform reg\n = case reg of\n        RegVirtual _                    -> True\n        RegReal (RealRegSingle r1)      -> freeReg platform r1\n        RegReal (RealRegPair r1 _)      -> freeReg platform r1\n\n\n\n-- | Apply a given mapping to tall the register references in this instruction.\nsparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr\nsparc_patchRegsOfInstr instr env = case instr of\n    LD    fmt addr reg          -> LD fmt (fixAddr addr) (env reg)\n    ST    fmt reg addr          -> ST fmt (env reg) (fixAddr addr)\n\n    ADD   x cc r1 ar r2         -> ADD   x cc  (env r1) (fixRI ar) (env r2)\n    SUB   x cc r1 ar r2         -> SUB   x cc  (env r1) (fixRI ar) (env r2)\n    UMUL    cc r1 ar r2         -> UMUL    cc  (env r1) (fixRI ar) (env r2)\n    SMUL    cc r1 ar r2         -> SMUL    cc  (env r1) (fixRI ar) (env r2)\n    UDIV    cc r1 ar r2         -> UDIV    cc  (env r1) (fixRI ar) (env r2)\n    SDIV    cc r1 ar r2         -> SDIV    cc  (env r1) (fixRI ar) (env r2)\n    RDY   rd                    -> RDY         (env rd)\n    WRY   r1 r2                 -> WRY         (env r1) (env r2)\n    AND   b r1 ar r2            -> AND   b     (env r1) (fixRI ar) (env r2)\n    ANDN  b r1 ar r2            -> ANDN  b     (env r1) (fixRI ar) (env r2)\n    OR    b r1 ar r2            -> OR    b     (env r1) (fixRI ar) (env r2)\n    ORN   b r1 ar r2            -> ORN   b     (env r1) (fixRI ar) (env r2)\n    XOR   b r1 ar r2            -> XOR   b     (env r1) (fixRI ar) (env r2)\n    XNOR  b r1 ar r2            -> XNOR  b     (env r1) (fixRI ar) (env r2)\n    SLL   r1 ar r2              -> SLL         (env r1) (fixRI ar) (env r2)\n    SRL   r1 ar r2              -> SRL         (env r1) (fixRI ar) (env r2)\n    SRA   r1 ar r2              -> SRA         (env r1) (fixRI ar) (env r2)\n\n    SETHI imm reg               -> SETHI imm (env reg)\n\n    FABS  s r1 r2               -> FABS    s   (env r1) (env r2)\n    FADD  s r1 r2 r3            -> FADD    s   (env r1) (env r2) (env r3)\n    FCMP  e s r1 r2             -> FCMP e  s   (env r1) (env r2)\n    FDIV  s r1 r2 r3            -> FDIV    s   (env r1) (env r2) (env r3)\n    FMOV  s r1 r2               -> FMOV    s   (env r1) (env r2)\n    FMUL  s r1 r2 r3            -> FMUL    s   (env r1) (env r2) (env r3)\n    FNEG  s r1 r2               -> FNEG    s   (env r1) (env r2)\n    FSQRT s r1 r2               -> FSQRT   s   (env r1) (env r2)\n    FSUB  s r1 r2 r3            -> FSUB    s   (env r1) (env r2) (env r3)\n    FxTOy s1 s2 r1 r2           -> FxTOy s1 s2 (env r1) (env r2)\n\n    JMP     addr                -> JMP     (fixAddr addr)\n    JMP_TBL addr ids l          -> JMP_TBL (fixAddr addr) ids l\n\n    CALL  (Left i) n t          -> CALL (Left i) n t\n    CALL  (Right r) n t         -> CALL (Right (env r)) n t\n    _                           -> instr\n\n  where\n    fixAddr (AddrRegReg r1 r2)  = AddrRegReg   (env r1) (env r2)\n    fixAddr (AddrRegImm r1 i)   = AddrRegImm   (env r1) i\n\n    fixRI (RIReg r)             = RIReg (env r)\n    fixRI other                 = other\n\n\n--------------------------------------------------------------------------------\nsparc_isJumpishInstr :: Instr -> Bool\nsparc_isJumpishInstr instr\n = case instr of\n        BI{}            -> True\n        BF{}            -> True\n        JMP{}           -> True\n        JMP_TBL{}       -> True\n        CALL{}          -> True\n        _               -> False\n\nsparc_jumpDestsOfInstr :: Instr -> [BlockId]\nsparc_jumpDestsOfInstr insn\n  = case insn of\n        BI   _ _ id     -> [id]\n        BF   _ _ id     -> [id]\n        JMP_TBL _ ids _ -> [id | Just id <- ids]\n        _               -> []\n\n\nsparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr\nsparc_patchJumpInstr insn patchF\n  = case insn of\n        BI cc annul id  -> BI cc annul (patchF id)\n        BF cc annul id  -> BF cc annul (patchF id)\n        JMP_TBL n ids l -> JMP_TBL n (map (fmap patchF) ids) l\n        _               -> insn\n\n\n--------------------------------------------------------------------------------\n-- | Make a spill instruction.\n--      On SPARC we spill below frame pointer leaving 2 words/spill\nsparc_mkSpillInstr\n    :: DynFlags\n    -> Reg      -- ^ register to spill\n    -> Int      -- ^ current stack delta\n    -> Int      -- ^ spill slot to use\n    -> Instr\n\nsparc_mkSpillInstr dflags reg _ slot\n = let  platform = targetPlatform dflags\n        off      = spillSlotToOffset dflags slot\n        off_w    = 1 + (off `div` 4)\n        fmt      = case targetClassOfReg platform reg of\n                        RcInteger -> II32\n                        RcFloat   -> FF32\n                        RcDouble  -> FF64\n                        _         -> panic \"sparc_mkSpillInstr\"\n\n    in ST fmt reg (fpRel (negate off_w))\n\n\n-- | Make a spill reload instruction.\nsparc_mkLoadInstr\n    :: DynFlags\n    -> Reg      -- ^ register to load into\n    -> Int      -- ^ current stack delta\n    -> Int      -- ^ spill slot to use\n    -> Instr\n\nsparc_mkLoadInstr dflags reg _ slot\n  = let platform = targetPlatform dflags\n        off      = spillSlotToOffset dflags slot\n        off_w    = 1 + (off `div` 4)\n        fmt      = case targetClassOfReg platform reg of\n                        RcInteger -> II32\n                        RcFloat   -> FF32\n                        RcDouble  -> FF64\n                        _         -> panic \"sparc_mkLoadInstr\"\n\n        in LD fmt (fpRel (- off_w)) reg\n\n\n--------------------------------------------------------------------------------\n-- | See if this instruction is telling us the current C stack delta\nsparc_takeDeltaInstr\n        :: Instr\n        -> Maybe Int\n\nsparc_takeDeltaInstr instr\n = case instr of\n        DELTA i         -> Just i\n        _               -> Nothing\n\n\nsparc_isMetaInstr\n        :: Instr\n        -> Bool\n\nsparc_isMetaInstr instr\n = case instr of\n        COMMENT{}       -> True\n        LDATA{}         -> True\n        NEWBLOCK{}      -> True\n        DELTA{}         -> True\n        _               -> False\n\n\n-- | Make a reg-reg move instruction.\n--      On SPARC v8 there are no instructions to move directly between\n--      floating point and integer regs. If we need to do that then we\n--      have to go via memory.\n--\nsparc_mkRegRegMoveInstr\n    :: Platform\n    -> Reg\n    -> Reg\n    -> Instr\n\nsparc_mkRegRegMoveInstr platform src dst\n        | srcClass      <- targetClassOfReg platform src\n        , dstClass      <- targetClassOfReg platform dst\n        , srcClass == dstClass\n        = case srcClass of\n                RcInteger -> ADD  False False src (RIReg g0) dst\n                RcDouble  -> FMOV FF64 src dst\n                RcFloat   -> FMOV FF32 src dst\n                _         -> panic \"sparc_mkRegRegMoveInstr\"\n\n        | otherwise\n        = panic \"SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same\"\n\n\n-- | Check whether an instruction represents a reg-reg move.\n--      The register allocator attempts to eliminate reg->reg moves whenever it can,\n--      by assigning the src and dest temporaries to the same real register.\n--\nsparc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)\nsparc_takeRegRegMoveInstr instr\n = case instr of\n        ADD False False src (RIReg src2) dst\n         | g0 == src2           -> Just (src, dst)\n\n        FMOV FF64 src dst       -> Just (src, dst)\n        FMOV FF32  src dst      -> Just (src, dst)\n        _                       -> Nothing\n\n\n-- | Make an unconditional branch instruction.\nsparc_mkJumpInstr\n        :: BlockId\n        -> [Instr]\n\nsparc_mkJumpInstr id\n =       [BI ALWAYS False id\n        , NOP]                  -- fill the branch delay slot.\n", "num_lines": 486}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Pretty-printing assembly language\n--\n-- (c) The University of Glasgow 1993-2005\n--\n-----------------------------------------------------------------------------\n\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\nmodule SPARC.Ppr (\n        pprNatCmmDecl,\n        pprBasicBlock,\n        pprData,\n        pprInstr,\n        pprFormat,\n        pprImm,\n        pprDataItem\n)\n\nwhere\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n\nimport GhcPrelude\n\nimport SPARC.Regs\nimport SPARC.Instr\nimport SPARC.Cond\nimport SPARC.Imm\nimport SPARC.AddrMode\nimport SPARC.Base\nimport Instruction\nimport Reg\nimport Format\nimport PprBase\n\nimport Cmm hiding (topInfoTable)\nimport PprCmm()\nimport BlockId\nimport CLabel\nimport Hoopl.Label\nimport Hoopl.Collections\n\nimport Unique           ( pprUniqueAlways )\nimport Outputable\nimport Platform\nimport FastString\n\n-- -----------------------------------------------------------------------------\n-- Printing this stuff out\n\npprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc\npprNatCmmDecl (CmmData section dats) =\n  pprSectionAlign section $$ pprDatas dats\n\npprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =\n  case topInfoTable proc of\n    Nothing ->\n        -- special case for code without info table:\n        pprSectionAlign (Section Text lbl) $$\n        pprLabel lbl $$ -- blocks guaranteed not null, so label needed\n        vcat (map (pprBasicBlock top_info) blocks)\n\n    Just (Statics info_lbl _) ->\n      sdocWithPlatform $ \\platform ->\n      (if platformHasSubsectionsViaSymbols platform\n          then pprSectionAlign dspSection $$\n               ppr (mkDeadStripPreventer info_lbl) <> char ':'\n          else empty) $$\n      vcat (map (pprBasicBlock top_info) blocks) $$\n      -- above: Even the first block gets a label, because with branch-chain\n      -- elimination, it might be the target of a goto.\n      (if platformHasSubsectionsViaSymbols platform\n       then\n       -- See Note [Subsections Via Symbols] in X86/Ppr.hs\n                text \"\\t.long \"\n            <+> ppr info_lbl\n            <+> char '-'\n            <+> ppr (mkDeadStripPreventer info_lbl)\n       else empty)\n\ndspSection :: Section\ndspSection = Section Text $\n    panic \"subsections-via-symbols doesn't combine with split-sections\"\n\npprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc\npprBasicBlock info_env (BasicBlock blockid instrs)\n  = maybe_infotable $$\n    pprLabel (blockLbl blockid) $$\n    vcat (map pprInstr instrs)\n  where\n    maybe_infotable = case mapLookup blockid info_env of\n       Nothing   -> empty\n       Just (Statics info_lbl info) ->\n           pprAlignForSection Text $$\n           vcat (map pprData info) $$\n           pprLabel info_lbl\n\n\npprDatas :: CmmStatics -> SDoc\npprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)\n\npprData :: CmmStatic -> SDoc\npprData (CmmString str)          = pprBytes str\npprData (CmmUninitialised bytes) = text \".skip \" <> int bytes\npprData (CmmStaticLit lit)       = pprDataItem lit\n\npprGloblDecl :: CLabel -> SDoc\npprGloblDecl lbl\n  | not (externallyVisibleCLabel lbl) = empty\n  | otherwise = text \".global \" <> ppr lbl\n\npprTypeAndSizeDecl :: CLabel -> SDoc\npprTypeAndSizeDecl lbl\n    = sdocWithPlatform $ \\platform ->\n      if platformOS platform == OSLinux && externallyVisibleCLabel lbl\n      then text \".type \" <> ppr lbl <> ptext (sLit \", @object\")\n      else empty\n\npprLabel :: CLabel -> SDoc\npprLabel lbl = pprGloblDecl lbl\n            $$ pprTypeAndSizeDecl lbl\n            $$ (ppr lbl <> char ':')\n\n-- -----------------------------------------------------------------------------\n-- pprInstr: print an 'Instr'\n\ninstance Outputable Instr where\n    ppr instr = pprInstr instr\n\n\n-- | Pretty print a register.\npprReg :: Reg -> SDoc\npprReg reg\n = case reg of\n        RegVirtual vr\n         -> case vr of\n                VirtualRegI   u -> text \"%vI_\"   <> pprUniqueAlways u\n                VirtualRegHi  u -> text \"%vHi_\"  <> pprUniqueAlways u\n                VirtualRegF   u -> text \"%vF_\"   <> pprUniqueAlways u\n                VirtualRegD   u -> text \"%vD_\"   <> pprUniqueAlways u\n                VirtualRegSSE u -> text \"%vSSE_\" <> pprUniqueAlways u\n\n        RegReal rr\n         -> case rr of\n                RealRegSingle r1\n                 -> pprReg_ofRegNo r1\n\n                RealRegPair r1 r2\n                 -> text \"(\" <> pprReg_ofRegNo r1\n                 <> vbar     <> pprReg_ofRegNo r2\n                 <> text \")\"\n\n\n\n-- | Pretty print a register name, based on this register number.\n--   The definition has been unfolded so we get a jump-table in the\n--   object code. This function is called quite a lot when emitting\n--   the asm file..\n--\npprReg_ofRegNo :: Int -> SDoc\npprReg_ofRegNo i\n = ptext\n    (case i of {\n         0 -> sLit \"%g0\";   1 -> sLit \"%g1\";\n         2 -> sLit \"%g2\";   3 -> sLit \"%g3\";\n         4 -> sLit \"%g4\";   5 -> sLit \"%g5\";\n         6 -> sLit \"%g6\";   7 -> sLit \"%g7\";\n         8 -> sLit \"%o0\";   9 -> sLit \"%o1\";\n        10 -> sLit \"%o2\";  11 -> sLit \"%o3\";\n        12 -> sLit \"%o4\";  13 -> sLit \"%o5\";\n        14 -> sLit \"%o6\";  15 -> sLit \"%o7\";\n        16 -> sLit \"%l0\";  17 -> sLit \"%l1\";\n        18 -> sLit \"%l2\";  19 -> sLit \"%l3\";\n        20 -> sLit \"%l4\";  21 -> sLit \"%l5\";\n        22 -> sLit \"%l6\";  23 -> sLit \"%l7\";\n        24 -> sLit \"%i0\";  25 -> sLit \"%i1\";\n        26 -> sLit \"%i2\";  27 -> sLit \"%i3\";\n        28 -> sLit \"%i4\";  29 -> sLit \"%i5\";\n        30 -> sLit \"%i6\";  31 -> sLit \"%i7\";\n        32 -> sLit \"%f0\";  33 -> sLit \"%f1\";\n        34 -> sLit \"%f2\";  35 -> sLit \"%f3\";\n        36 -> sLit \"%f4\";  37 -> sLit \"%f5\";\n        38 -> sLit \"%f6\";  39 -> sLit \"%f7\";\n        40 -> sLit \"%f8\";  41 -> sLit \"%f9\";\n        42 -> sLit \"%f10\"; 43 -> sLit \"%f11\";\n        44 -> sLit \"%f12\"; 45 -> sLit \"%f13\";\n        46 -> sLit \"%f14\"; 47 -> sLit \"%f15\";\n        48 -> sLit \"%f16\"; 49 -> sLit \"%f17\";\n        50 -> sLit \"%f18\"; 51 -> sLit \"%f19\";\n        52 -> sLit \"%f20\"; 53 -> sLit \"%f21\";\n        54 -> sLit \"%f22\"; 55 -> sLit \"%f23\";\n        56 -> sLit \"%f24\"; 57 -> sLit \"%f25\";\n        58 -> sLit \"%f26\"; 59 -> sLit \"%f27\";\n        60 -> sLit \"%f28\"; 61 -> sLit \"%f29\";\n        62 -> sLit \"%f30\"; 63 -> sLit \"%f31\";\n        _  -> sLit \"very naughty sparc register\" })\n\n\n-- | Pretty print a format for an instruction suffix.\npprFormat :: Format -> SDoc\npprFormat x\n = ptext\n    (case x of\n        II8     -> sLit \"ub\"\n        II16    -> sLit \"uh\"\n        II32    -> sLit \"\"\n        II64    -> sLit \"d\"\n        FF32    -> sLit \"\"\n        FF64    -> sLit \"d\"\n        _       -> panic \"SPARC.Ppr.pprFormat: no match\")\n\n\n-- | Pretty print a format for an instruction suffix.\n--      eg LD is 32bit on sparc, but LDD is 64 bit.\npprStFormat :: Format -> SDoc\npprStFormat x\n = ptext\n    (case x of\n        II8   -> sLit \"b\"\n        II16  -> sLit \"h\"\n        II32  -> sLit \"\"\n        II64  -> sLit \"x\"\n        FF32  -> sLit \"\"\n        FF64  -> sLit \"d\"\n        _       -> panic \"SPARC.Ppr.pprFormat: no match\")\n\n\n-- | Pretty print a condition code.\npprCond :: Cond -> SDoc\npprCond c\n = ptext\n    (case c of\n        ALWAYS  -> sLit \"\"\n        NEVER   -> sLit \"n\"\n        GEU     -> sLit \"geu\"\n        LU      -> sLit \"lu\"\n        EQQ     -> sLit \"e\"\n        GTT     -> sLit \"g\"\n        GE      -> sLit \"ge\"\n        GU      -> sLit \"gu\"\n        LTT     -> sLit \"l\"\n        LE      -> sLit \"le\"\n        LEU     -> sLit \"leu\"\n        NE      -> sLit \"ne\"\n        NEG     -> sLit \"neg\"\n        POS     -> sLit \"pos\"\n        VC      -> sLit \"vc\"\n        VS      -> sLit \"vs\")\n\n\n-- | Pretty print an address mode.\npprAddr :: AddrMode -> SDoc\npprAddr am\n = case am of\n        AddrRegReg r1 (RegReal (RealRegSingle 0))\n         -> pprReg r1\n\n        AddrRegReg r1 r2\n         -> hcat [ pprReg r1, char '+', pprReg r2 ]\n\n        AddrRegImm r1 (ImmInt i)\n         | i == 0               -> pprReg r1\n         | not (fits13Bits i)   -> largeOffsetError i\n         | otherwise            -> hcat [ pprReg r1, pp_sign, int i ]\n         where\n                pp_sign = if i > 0 then char '+' else empty\n\n        AddrRegImm r1 (ImmInteger i)\n         | i == 0               -> pprReg r1\n         | not (fits13Bits i)   -> largeOffsetError i\n         | otherwise            -> hcat [ pprReg r1, pp_sign, integer i ]\n         where\n                pp_sign = if i > 0 then char '+' else empty\n\n        AddrRegImm r1 imm\n         -> hcat [ pprReg r1, char '+', pprImm imm ]\n\n\n-- | Pretty print an immediate value.\npprImm :: Imm -> SDoc\npprImm imm\n = case imm of\n        ImmInt i        -> int i\n        ImmInteger i    -> integer i\n        ImmCLbl l       -> ppr l\n        ImmIndex l i    -> ppr l <> char '+' <> int i\n        ImmLit s        -> s\n\n        ImmConstantSum a b\n         -> pprImm a <> char '+' <> pprImm b\n\n        ImmConstantDiff a b\n         -> pprImm a <> char '-' <> lparen <> pprImm b <> rparen\n\n        LO i\n         -> hcat [ text \"%lo(\", pprImm i, rparen ]\n\n        HI i\n         -> hcat [ text \"%hi(\", pprImm i, rparen ]\n\n        -- these should have been converted to bytes and placed\n        --      in the data section.\n        ImmFloat _      -> text \"naughty float immediate\"\n        ImmDouble _     -> text \"naughty double immediate\"\n\n\n-- | Pretty print a section \\/ segment header.\n--      On SPARC all the data sections must be at least 8 byte aligned\n--      incase we store doubles in them.\n--\npprSectionAlign :: Section -> SDoc\npprSectionAlign sec@(Section seg _) =\n  sdocWithPlatform $ \\platform ->\n    pprSectionHeader platform sec $$\n    pprAlignForSection seg\n\n-- | Print appropriate alignment for the given section type.\npprAlignForSection :: SectionType -> SDoc\npprAlignForSection seg =\n    ptext (case seg of\n      Text              -> sLit \".align 4\"\n      Data              -> sLit \".align 8\"\n      ReadOnlyData      -> sLit \".align 8\"\n      RelocatableReadOnlyData\n                        -> sLit \".align 8\"\n      UninitialisedData -> sLit \".align 8\"\n      ReadOnlyData16    -> sLit \".align 16\"\n      -- TODO: This is copied from the ReadOnlyData case, but it can likely be\n      -- made more efficient.\n      CString           -> sLit \".align 8\"\n      OtherSection _    -> panic \"PprMach.pprSectionHeader: unknown section\")\n\n-- | Pretty print a data item.\npprDataItem :: CmmLit -> SDoc\npprDataItem lit\n  = sdocWithDynFlags $ \\dflags ->\n    vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit)\n    where\n        imm = litToImm lit\n\n        ppr_item II8   _        = [text \"\\t.byte\\t\" <> pprImm imm]\n        ppr_item II32  _        = [text \"\\t.long\\t\" <> pprImm imm]\n\n        ppr_item FF32  (CmmFloat r _)\n         = let bs = floatToBytes (fromRational r)\n           in  map (\\b -> text \"\\t.byte\\t\" <> pprImm (ImmInt b)) bs\n\n        ppr_item FF64 (CmmFloat r _)\n         = let bs = doubleToBytes (fromRational r)\n           in  map (\\b -> text \"\\t.byte\\t\" <> pprImm (ImmInt b)) bs\n\n        ppr_item II16  _        = [text \"\\t.short\\t\" <> pprImm imm]\n        ppr_item II64  _        = [text \"\\t.quad\\t\" <> pprImm imm]\n        ppr_item _ _            = panic \"SPARC.Ppr.pprDataItem: no match\"\n\n\n-- | Pretty print an instruction.\npprInstr :: Instr -> SDoc\n\n-- nuke comments.\npprInstr (COMMENT _)\n        = empty\n\npprInstr (DELTA d)\n        = pprInstr (COMMENT (mkFastString (\"\\tdelta = \" ++ show d)))\n\n-- Newblocks and LData should have been slurped out before producing the .s file.\npprInstr (NEWBLOCK _)\n        = panic \"X86.Ppr.pprInstr: NEWBLOCK\"\n\npprInstr (LDATA _ _)\n        = panic \"PprMach.pprInstr: LDATA\"\n\n-- 64 bit FP loads are expanded into individual instructions in CodeGen.Expand\npprInstr (LD FF64 _ reg)\n        | RegReal (RealRegSingle{})     <- reg\n        = panic \"SPARC.Ppr: not emitting potentially misaligned LD FF64 instr\"\n\npprInstr (LD format addr reg)\n        = hcat [\n               text \"\\tld\",\n               pprFormat format,\n               char '\\t',\n               lbrack,\n               pprAddr addr,\n               pp_rbracket_comma,\n               pprReg reg\n            ]\n\n-- 64 bit FP stores are expanded into individual instructions in CodeGen.Expand\npprInstr (ST FF64 reg _)\n        | RegReal (RealRegSingle{}) <- reg\n        = panic \"SPARC.Ppr: not emitting potentially misaligned ST FF64 instr\"\n\n-- no distinction is made between signed and unsigned bytes on stores for the\n-- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),\n-- so we call a special-purpose pprFormat for ST..\npprInstr (ST format reg addr)\n        = hcat [\n               text \"\\tst\",\n               pprStFormat format,\n               char '\\t',\n               pprReg reg,\n               pp_comma_lbracket,\n               pprAddr addr,\n               rbrack\n            ]\n\n\npprInstr (ADD x cc reg1 ri reg2)\n        | not x && not cc && riZero ri\n        = hcat [ text \"\\tmov\\t\", pprReg reg1, comma, pprReg reg2 ]\n\n        | otherwise\n        = pprRegRIReg (if x then sLit \"addx\" else sLit \"add\") cc reg1 ri reg2\n\n\npprInstr (SUB x cc reg1 ri reg2)\n        | not x && cc && reg2 == g0\n        = hcat [ text \"\\tcmp\\t\", pprReg reg1, comma, pprRI ri ]\n\n        | not x && not cc && riZero ri\n        = hcat [ text \"\\tmov\\t\", pprReg reg1, comma, pprReg reg2 ]\n\n        | otherwise\n        = pprRegRIReg (if x then sLit \"subx\" else sLit \"sub\") cc reg1 ri reg2\n\npprInstr (AND  b reg1 ri reg2) = pprRegRIReg (sLit \"and\")  b reg1 ri reg2\n\npprInstr (ANDN b reg1 ri reg2) = pprRegRIReg (sLit \"andn\") b reg1 ri reg2\n\npprInstr (OR b reg1 ri reg2)\n        | not b && reg1 == g0\n        = let doit = hcat [ text \"\\tmov\\t\", pprRI ri, comma, pprReg reg2 ]\n          in  case ri of\n                   RIReg rrr | rrr == reg2 -> empty\n                   _                       -> doit\n\n        | otherwise\n        = pprRegRIReg (sLit \"or\") b reg1 ri reg2\n\npprInstr (ORN b reg1 ri reg2)  = pprRegRIReg (sLit \"orn\") b reg1 ri reg2\n\npprInstr (XOR  b reg1 ri reg2) = pprRegRIReg (sLit \"xor\")  b reg1 ri reg2\npprInstr (XNOR b reg1 ri reg2) = pprRegRIReg (sLit \"xnor\") b reg1 ri reg2\n\npprInstr (SLL reg1 ri reg2)    = pprRegRIReg (sLit \"sll\") False reg1 ri reg2\npprInstr (SRL reg1 ri reg2)    = pprRegRIReg (sLit \"srl\") False reg1 ri reg2\npprInstr (SRA reg1 ri reg2)    = pprRegRIReg (sLit \"sra\") False reg1 ri reg2\n\npprInstr (RDY rd)              = text \"\\trd\\t%y,\" <> pprReg rd\npprInstr (WRY reg1 reg2)\n        = text \"\\twr\\t\"\n                <> pprReg reg1\n                <> char ','\n                <> pprReg reg2\n                <> char ','\n                <> text \"%y\"\n\npprInstr (SMUL b reg1 ri reg2) = pprRegRIReg (sLit \"smul\")  b reg1 ri reg2\npprInstr (UMUL b reg1 ri reg2) = pprRegRIReg (sLit \"umul\")  b reg1 ri reg2\npprInstr (SDIV b reg1 ri reg2) = pprRegRIReg (sLit \"sdiv\")  b reg1 ri reg2\npprInstr (UDIV b reg1 ri reg2) = pprRegRIReg (sLit \"udiv\")  b reg1 ri reg2\n\npprInstr (SETHI imm reg)\n  = hcat [\n        text \"\\tsethi\\t\",\n        pprImm imm,\n        comma,\n        pprReg reg\n    ]\n\npprInstr NOP\n        = text \"\\tnop\"\n\npprInstr (FABS format reg1 reg2)\n        = pprFormatRegReg (sLit \"fabs\") format reg1 reg2\n\npprInstr (FADD format reg1 reg2 reg3)\n        = pprFormatRegRegReg (sLit \"fadd\") format reg1 reg2 reg3\n\npprInstr (FCMP e format reg1 reg2)\n        = pprFormatRegReg (if e then sLit \"fcmpe\" else sLit \"fcmp\")\n                          format reg1 reg2\n\npprInstr (FDIV format reg1 reg2 reg3)\n        = pprFormatRegRegReg (sLit \"fdiv\") format reg1 reg2 reg3\n\npprInstr (FMOV format reg1 reg2)\n        = pprFormatRegReg (sLit \"fmov\") format reg1 reg2\n\npprInstr (FMUL format reg1 reg2 reg3)\n        = pprFormatRegRegReg (sLit \"fmul\") format reg1 reg2 reg3\n\npprInstr (FNEG format reg1 reg2)\n        = pprFormatRegReg (sLit \"fneg\") format reg1 reg2\n\npprInstr (FSQRT format reg1 reg2)\n        = pprFormatRegReg (sLit \"fsqrt\") format reg1 reg2\n\npprInstr (FSUB format reg1 reg2 reg3)\n        = pprFormatRegRegReg (sLit \"fsub\") format reg1 reg2 reg3\n\npprInstr (FxTOy format1 format2 reg1 reg2)\n  = hcat [\n        text \"\\tf\",\n        ptext\n        (case format1 of\n            II32  -> sLit \"ito\"\n            FF32  -> sLit \"sto\"\n            FF64  -> sLit \"dto\"\n            _     -> panic \"SPARC.Ppr.pprInstr.FxToY: no match\"),\n        ptext\n        (case format2 of\n            II32  -> sLit \"i\\t\"\n            II64  -> sLit \"x\\t\"\n            FF32  -> sLit \"s\\t\"\n            FF64  -> sLit \"d\\t\"\n            _     -> panic \"SPARC.Ppr.pprInstr.FxToY: no match\"),\n        pprReg reg1, comma, pprReg reg2\n    ]\n\n\npprInstr (BI cond b blockid)\n  = hcat [\n        text \"\\tb\", pprCond cond,\n        if b then pp_comma_a else empty,\n        char '\\t',\n        ppr (blockLbl blockid)\n    ]\n\npprInstr (BF cond b blockid)\n  = hcat [\n        text \"\\tfb\", pprCond cond,\n        if b then pp_comma_a else empty,\n        char '\\t',\n        ppr (blockLbl blockid)\n    ]\n\npprInstr (JMP addr) = text \"\\tjmp\\t\" <> pprAddr addr\npprInstr (JMP_TBL op _ _)  = pprInstr (JMP op)\n\npprInstr (CALL (Left imm) n _)\n  = hcat [ text \"\\tcall\\t\", pprImm imm, comma, int n ]\n\npprInstr (CALL (Right reg) n _)\n  = hcat [ text \"\\tcall\\t\", pprReg reg, comma, int n ]\n\n\n-- | Pretty print a RI\npprRI :: RI -> SDoc\npprRI (RIReg r) = pprReg r\npprRI (RIImm r) = pprImm r\n\n\n-- | Pretty print a two reg instruction.\npprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc\npprFormatRegReg name format reg1 reg2\n  = hcat [\n        char '\\t',\n        ptext name,\n        (case format of\n            FF32 -> text \"s\\t\"\n            FF64 -> text \"d\\t\"\n            _    -> panic \"SPARC.Ppr.pprFormatRegReg: no match\"),\n\n        pprReg reg1,\n        comma,\n        pprReg reg2\n    ]\n\n\n-- | Pretty print a three reg instruction.\npprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc\npprFormatRegRegReg name format reg1 reg2 reg3\n  = hcat [\n        char '\\t',\n        ptext name,\n        (case format of\n            FF32  -> text \"s\\t\"\n            FF64  -> text \"d\\t\"\n            _    -> panic \"SPARC.Ppr.pprFormatRegReg: no match\"),\n        pprReg reg1,\n        comma,\n        pprReg reg2,\n        comma,\n        pprReg reg3\n    ]\n\n\n-- | Pretty print an instruction of two regs and a ri.\npprRegRIReg :: PtrString -> Bool -> Reg -> RI -> Reg -> SDoc\npprRegRIReg name b reg1 ri reg2\n  = hcat [\n        char '\\t',\n        ptext name,\n        if b then text \"cc\\t\" else char '\\t',\n        pprReg reg1,\n        comma,\n        pprRI ri,\n        comma,\n        pprReg reg2\n    ]\n\n{-\npprRIReg :: PtrString -> Bool -> RI -> Reg -> SDoc\npprRIReg name b ri reg1\n  = hcat [\n        char '\\t',\n        ptext name,\n        if b then text \"cc\\t\" else char '\\t',\n        pprRI ri,\n        comma,\n        pprReg reg1\n    ]\n-}\n\n{-\npp_ld_lbracket :: SDoc\npp_ld_lbracket    = text \"\\tld\\t[\"\n-}\n\npp_rbracket_comma :: SDoc\npp_rbracket_comma = text \"],\"\n\n\npp_comma_lbracket :: SDoc\npp_comma_lbracket = text \",[\"\n\n\npp_comma_a :: SDoc\npp_comma_a        = text \",a\"\n\n", "num_lines": 639}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 1994-2004\n--\n-- -----------------------------------------------------------------------------\n\nmodule SPARC.Regs (\n        -- registers\n        showReg,\n        virtualRegSqueeze,\n        realRegSqueeze,\n        classOfRealReg,\n        allRealRegs,\n\n        -- machine specific info\n        gReg, iReg, lReg, oReg, fReg,\n        fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,\n\n        -- allocatable\n        allocatableRegs,\n\n        -- args\n        argRegs,\n        allArgRegs,\n        callClobberedRegs,\n\n        --\n        mkVirtualReg,\n        regDotColor\n)\n\nwhere\n\n\nimport GhcPrelude\n\nimport CodeGen.Platform.SPARC\nimport Reg\nimport RegClass\nimport Format\n\nimport Unique\nimport Outputable\n\n{-\n        The SPARC has 64 registers of interest; 32 integer registers and 32\n        floating point registers.  The mapping of STG registers to SPARC\n        machine registers is defined in StgRegs.h.  We are, of course,\n        prepared for any eventuality.\n\n        The whole fp-register pairing thing on sparcs is a huge nuisance.  See\n        includes/stg/MachRegs.h for a description of what's going on\n        here.\n-}\n\n\n-- | Get the standard name for the register with this number.\nshowReg :: RegNo -> String\nshowReg n\n        | n >= 0  && n < 8   = \"%g\" ++ show n\n        | n >= 8  && n < 16  = \"%o\" ++ show (n-8)\n        | n >= 16 && n < 24  = \"%l\" ++ show (n-16)\n        | n >= 24 && n < 32  = \"%i\" ++ show (n-24)\n        | n >= 32 && n < 64  = \"%f\" ++ show (n-32)\n        | otherwise          = panic \"SPARC.Regs.showReg: unknown sparc register\"\n\n\n-- Get the register class of a certain real reg\nclassOfRealReg :: RealReg -> RegClass\nclassOfRealReg reg\n = case reg of\n        RealRegSingle i\n                | i < 32        -> RcInteger\n                | otherwise     -> RcFloat\n\n        RealRegPair{}           -> RcDouble\n\n\n-- | regSqueeze_class reg\n--      Calculate the maximum number of register colors that could be\n--      denied to a node of this class due to having this reg\n--      as a neighbour.\n--\n{-# INLINE virtualRegSqueeze #-}\nvirtualRegSqueeze :: RegClass -> VirtualReg -> Int\n\nvirtualRegSqueeze cls vr\n = case cls of\n        RcInteger\n         -> case vr of\n                VirtualRegI{}           -> 1\n                VirtualRegHi{}          -> 1\n                _other                  -> 0\n\n        RcFloat\n         -> case vr of\n                VirtualRegF{}           -> 1\n                VirtualRegD{}           -> 2\n                _other                  -> 0\n\n        RcDouble\n         -> case vr of\n                VirtualRegF{}           -> 1\n                VirtualRegD{}           -> 1\n                _other                  -> 0\n\n        _other -> 0\n\n{-# INLINE realRegSqueeze #-}\nrealRegSqueeze :: RegClass -> RealReg -> Int\n\nrealRegSqueeze cls rr\n = case cls of\n        RcInteger\n         -> case rr of\n                RealRegSingle regNo\n                        | regNo < 32    -> 1\n                        | otherwise     -> 0\n\n                RealRegPair{}           -> 0\n\n        RcFloat\n         -> case rr of\n                RealRegSingle regNo\n                        | regNo < 32    -> 0\n                        | otherwise     -> 1\n\n                RealRegPair{}           -> 2\n\n        RcDouble\n         -> case rr of\n                RealRegSingle regNo\n                        | regNo < 32    -> 0\n                        | otherwise     -> 1\n\n                RealRegPair{}           -> 1\n\n        _other -> 0\n\n-- | All the allocatable registers in the machine,\n--      including register pairs.\nallRealRegs :: [RealReg]\nallRealRegs\n        =  [ (RealRegSingle i)          | i <- [0..63] ]\n        ++ [ (RealRegPair   i (i+1))    | i <- [32, 34 .. 62 ] ]\n\n\n-- | Get the regno for this sort of reg\ngReg, lReg, iReg, oReg, fReg :: Int -> RegNo\n\ngReg x  = x             -- global regs\noReg x  = (8 + x)       -- output regs\nlReg x  = (16 + x)      -- local regs\niReg x  = (24 + x)      -- input regs\nfReg x  = (32 + x)      -- float regs\n\n\n-- | Some specific regs used by the code generator.\ng0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg\n\nf6  = RegReal (RealRegSingle (fReg 6))\nf8  = RegReal (RealRegSingle (fReg 8))\nf22 = RegReal (RealRegSingle (fReg 22))\nf26 = RegReal (RealRegSingle (fReg 26))\nf27 = RegReal (RealRegSingle (fReg 27))\n\n-- g0 is always zero, and writes to it vanish.\ng0  = RegReal (RealRegSingle (gReg 0))\ng1  = RegReal (RealRegSingle (gReg 1))\ng2  = RegReal (RealRegSingle (gReg 2))\n\n-- FP, SP, int and float return (from C) regs.\nfp  = RegReal (RealRegSingle (iReg 6))\nsp  = RegReal (RealRegSingle (oReg 6))\no0  = RegReal (RealRegSingle (oReg 0))\no1  = RegReal (RealRegSingle (oReg 1))\nf0  = RegReal (RealRegSingle (fReg 0))\nf1  = RegReal (RealRegSingle (fReg 1))\n\n-- | Produce the second-half-of-a-double register given the first half.\n{-\nfPair :: Reg -> Maybe Reg\nfPair (RealReg n)\n        | n >= 32 && n `mod` 2 == 0  = Just (RealReg (n+1))\n\nfPair (VirtualRegD u)\n        = Just (VirtualRegHi u)\n\nfPair reg\n        = trace (\"MachInstrs.fPair: can't get high half of supposed double reg \" ++ showPpr reg)\n                Nothing\n-}\n\n\n-- | All the regs that the register allocator can allocate to,\n--      with the fixed use regs removed.\n--\nallocatableRegs :: [RealReg]\nallocatableRegs\n   = let isFree rr\n           = case rr of\n                RealRegSingle r     -> freeReg r\n                RealRegPair   r1 r2 -> freeReg r1 && freeReg r2\n     in filter isFree allRealRegs\n\n\n-- | The registers to place arguments for function calls,\n--      for some number of arguments.\n--\nargRegs :: RegNo -> [Reg]\nargRegs r\n = case r of\n        0       -> []\n        1       -> map (RegReal . RealRegSingle . oReg) [0]\n        2       -> map (RegReal . RealRegSingle . oReg) [0,1]\n        3       -> map (RegReal . RealRegSingle . oReg) [0,1,2]\n        4       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3]\n        5       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4]\n        6       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5]\n        _       -> panic \"MachRegs.argRegs(sparc): don't know about >6 arguments!\"\n\n\n-- | All all the regs that could possibly be returned by argRegs\n--\nallArgRegs :: [Reg]\nallArgRegs\n        = map (RegReal . RealRegSingle) [oReg i | i <- [0..5]]\n\n\n-- These are the regs that we cannot assume stay alive over a C call.\n--      TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02\n--\ncallClobberedRegs :: [Reg]\ncallClobberedRegs\n        = map (RegReal . RealRegSingle)\n                (  oReg 7 :\n                  [oReg i | i <- [0..5]] ++\n                  [gReg i | i <- [1..7]] ++\n                  [fReg i | i <- [0..31]] )\n\n\n\n-- | Make a virtual reg with this format.\nmkVirtualReg :: Unique -> Format -> VirtualReg\nmkVirtualReg u format\n        | not (isFloatFormat format)\n        = VirtualRegI u\n\n        | otherwise\n        = case format of\n                FF32    -> VirtualRegF u\n                FF64    -> VirtualRegD u\n                _       -> panic \"mkVReg\"\n\n\nregDotColor :: RealReg -> SDoc\nregDotColor reg\n = case classOfRealReg reg of\n        RcInteger       -> text \"blue\"\n        RcFloat         -> text \"red\"\n        _other          -> text \"green\"\n", "num_lines": 262}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SPARC.ShortcutJump (\n        JumpDest(..), getJumpDestBlockId,\n        canShortcut,\n        shortcutJump,\n        shortcutStatics,\n        shortBlockId\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.Instr\nimport SPARC.Imm\n\nimport CLabel\nimport BlockId\nimport Cmm\n\nimport Panic\nimport Outputable\n\ndata JumpDest\n        = DestBlockId BlockId\n        | DestImm Imm\n\n-- Debug Instance\ninstance Outputable JumpDest where\n  ppr (DestBlockId bid) = text \"blk:\" <> ppr bid\n  ppr (DestImm _bid)    = text \"imm:?\"\n\ngetJumpDestBlockId :: JumpDest -> Maybe BlockId\ngetJumpDestBlockId (DestBlockId bid) = Just bid\ngetJumpDestBlockId _                 = Nothing\n\n\ncanShortcut :: Instr -> Maybe JumpDest\ncanShortcut _ = Nothing\n\n\nshortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr\nshortcutJump _ other = other\n\n\n\nshortcutStatics :: (BlockId -> Maybe JumpDest) -> CmmStatics -> CmmStatics\nshortcutStatics fn (Statics lbl statics)\n  = Statics lbl $ map (shortcutStatic fn) statics\n  -- we need to get the jump tables, so apply the mapping to the entries\n  -- of a CmmData too.\n\nshortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel\nshortcutLabel fn lab\n  | Just blkId <- maybeLocalBlockLabel lab = shortBlockId fn blkId\n  | otherwise                              = lab\n\nshortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic\nshortcutStatic fn (CmmStaticLit (CmmLabel lab))\n        = CmmStaticLit (CmmLabel (shortcutLabel fn lab))\nshortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off w))\n        = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off w)\n-- slightly dodgy, we're ignoring the second label, but this\n-- works with the way we use CmmLabelDiffOff for jump tables now.\nshortcutStatic _ other_static\n        = other_static\n\n\nshortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel\nshortBlockId fn blockid =\n   case fn blockid of\n      Nothing -> blockLbl blockid\n      Just (DestBlockId blockid')  -> shortBlockId fn blockid'\n      Just (DestImm (ImmCLbl lbl)) -> lbl\n      _other -> panic \"shortBlockId\"\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SPARC.Stack (\n        spRel,\n        fpRel,\n        spillSlotToOffset,\n        maxSpillSlots\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.AddrMode\nimport SPARC.Regs\nimport SPARC.Base\nimport SPARC.Imm\n\nimport DynFlags\nimport Outputable\n\n-- | Get an AddrMode relative to the address in sp.\n--      This gives us a stack relative addressing mode for volatile\n--      temporaries and for excess call arguments.\n--\nspRel :: Int            -- ^ stack offset in words, positive or negative\n      -> AddrMode\n\nspRel n = AddrRegImm sp (ImmInt (n * wordLength))\n\n\n-- | Get an address relative to the frame pointer.\n--      This doesn't work work for offsets greater than 13 bits; we just hope for the best\n--\nfpRel :: Int -> AddrMode\nfpRel n\n        = AddrRegImm fp (ImmInt (n * wordLength))\n\n\n-- | Convert a spill slot number to a *byte* offset, with no sign.\n--\nspillSlotToOffset :: DynFlags -> Int -> Int\nspillSlotToOffset dflags slot\n        | slot >= 0 && slot < maxSpillSlots dflags\n        = 64 + spillSlotSize * slot\n\n        | otherwise\n        = pprPanic \"spillSlotToOffset:\"\n                      (   text \"invalid spill location: \" <> int slot\n                      $$  text \"maxSpillSlots:          \" <> int (maxSpillSlots dflags))\n\n\n-- | The maximum number of spill slots available on the C stack.\n--      If we use up all of the slots, then we're screwed.\n--\n--      Why do we reserve 64 bytes, instead of using the whole thing??\n--              -- BL 2009/02/15\n--\nmaxSpillSlots :: DynFlags -> Int\nmaxSpillSlots dflags\n        = ((spillAreaLength dflags - 64) `div` spillSlotSize) - 1\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SPARC.CodeGen.Amode (\n        getAmode\n)\n\nwhere\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} SPARC.CodeGen.Gen32\nimport SPARC.CodeGen.Base\nimport SPARC.AddrMode\nimport SPARC.Imm\nimport SPARC.Instr\nimport SPARC.Regs\nimport SPARC.Base\nimport NCGMonad\nimport Format\n\nimport Cmm\n\nimport OrdList\n\n\n-- | Generate code to reference a memory address.\ngetAmode\n        :: CmmExpr      -- ^ expr producing an address\n        -> NatM Amode\n\ngetAmode tree@(CmmRegOff _ _)\n    = do dflags <- getDynFlags\n         getAmode (mangleIndexTree dflags tree)\n\ngetAmode (CmmMachOp (MO_Sub _) [x, CmmLit (CmmInt i _)])\n  | fits13Bits (-i)\n  = do\n       (reg, code) <- getSomeReg x\n       let\n         off  = ImmInt (-(fromInteger i))\n       return (Amode (AddrRegImm reg off) code)\n\n\ngetAmode (CmmMachOp (MO_Add _) [x, CmmLit (CmmInt i _)])\n  | fits13Bits i\n  = do\n       (reg, code) <- getSomeReg x\n       let\n         off  = ImmInt (fromInteger i)\n       return (Amode (AddrRegImm reg off) code)\n\ngetAmode (CmmMachOp (MO_Add _) [x, y])\n  = do\n    (regX, codeX) <- getSomeReg x\n    (regY, codeY) <- getSomeReg y\n    let\n        code = codeX `appOL` codeY\n    return (Amode (AddrRegReg regX regY) code)\n\ngetAmode (CmmLit lit)\n  = do\n        let imm__2      = litToImm lit\n        tmp1    <- getNewRegNat II32\n        tmp2    <- getNewRegNat II32\n\n        let code = toOL [ SETHI (HI imm__2) tmp1\n                        , OR    False tmp1 (RIImm (LO imm__2)) tmp2]\n\n        return (Amode (AddrRegReg tmp2 g0) code)\n\ngetAmode other\n  = do\n       (reg, code) <- getSomeReg other\n       let\n            off  = ImmInt 0\n       return (Amode (AddrRegImm reg off) code)\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SPARC.CodeGen.Base (\n        InstrBlock,\n        CondCode(..),\n        ChildCode64(..),\n        Amode(..),\n\n        Register(..),\n        setFormatOfRegister,\n\n        getRegisterReg,\n        mangleIndexTree\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.Instr\nimport SPARC.Cond\nimport SPARC.AddrMode\nimport SPARC.Regs\nimport Format\nimport Reg\n\nimport CodeGen.Platform\nimport DynFlags\nimport Cmm\nimport PprCmmExpr ()\nimport Platform\n\nimport Outputable\nimport OrdList\n\n--------------------------------------------------------------------------------\n-- | 'InstrBlock's are the insn sequences generated by the insn selectors.\n--      They are really trees of insns to facilitate fast appending, where a\n--      left-to-right traversal yields the insns in the correct order.\n--\ntype InstrBlock\n        = OrdList Instr\n\n\n-- | Condition codes passed up the tree.\n--\ndata CondCode\n        = CondCode Bool Cond InstrBlock\n\n\n-- | a.k.a \"Register64\"\n--      Reg is the lower 32-bit temporary which contains the result.\n--      Use getHiVRegFromLo to find the other VRegUnique.\n--\n--      Rules of this simplified insn selection game are therefore that\n--      the returned Reg may be modified\n--\ndata ChildCode64\n   = ChildCode64\n        InstrBlock\n        Reg\n\n\n-- | Holds code that references a memory address.\ndata Amode\n        = Amode\n                -- the AddrMode we can use in the instruction\n                --      that does the real load\\/store.\n                AddrMode\n\n                -- other setup code we have to run first before we can use the\n                --      above AddrMode.\n                InstrBlock\n\n\n\n--------------------------------------------------------------------------------\n-- | Code to produce a result into a register.\n--      If the result must go in a specific register, it comes out as Fixed.\n--      Otherwise, the parent can decide which register to put it in.\n--\ndata Register\n        = Fixed Format Reg InstrBlock\n        | Any   Format (Reg -> InstrBlock)\n\n\n-- | Change the format field in a Register.\nsetFormatOfRegister\n        :: Register -> Format -> Register\n\nsetFormatOfRegister reg format\n = case reg of\n        Fixed _ reg code        -> Fixed format reg code\n        Any _ codefn            -> Any   format codefn\n\n\n--------------------------------------------------------------------------------\n-- | Grab the Reg for a CmmReg\ngetRegisterReg :: Platform -> CmmReg -> Reg\n\ngetRegisterReg _ (CmmLocal (LocalReg u pk))\n        = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk)\n\ngetRegisterReg platform (CmmGlobal mid)\n  = case globalRegMaybe platform mid of\n        Just reg -> RegReal reg\n        Nothing  -> pprPanic\n                        \"SPARC.CodeGen.Base.getRegisterReg: global is in memory\"\n                        (ppr $ CmmGlobal mid)\n\n\n-- Expand CmmRegOff.  ToDo: should we do it this way around, or convert\n-- CmmExprs into CmmRegOff?\nmangleIndexTree :: DynFlags -> CmmExpr -> CmmExpr\n\nmangleIndexTree dflags (CmmRegOff reg off)\n        = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]\n        where width = typeWidth (cmmRegType dflags reg)\n\nmangleIndexTree _ _\n        = panic \"SPARC.CodeGen.Base.mangleIndexTree: no match\"\n", "num_lines": 120}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SPARC.CodeGen.CondCode (\n        getCondCode,\n        condIntCode,\n        condFltCode\n)\n\nwhere\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} SPARC.CodeGen.Gen32\nimport SPARC.CodeGen.Base\nimport SPARC.Instr\nimport SPARC.Regs\nimport SPARC.Cond\nimport SPARC.Imm\nimport SPARC.Base\nimport NCGMonad\nimport Format\n\nimport Cmm\n\nimport OrdList\nimport Outputable\n\n\ngetCondCode :: CmmExpr -> NatM CondCode\ngetCondCode (CmmMachOp mop [x, y])\n  =\n    case mop of\n      MO_F_Eq W32 -> condFltCode EQQ x y\n      MO_F_Ne W32 -> condFltCode NE  x y\n      MO_F_Gt W32 -> condFltCode GTT x y\n      MO_F_Ge W32 -> condFltCode GE  x y\n      MO_F_Lt W32 -> condFltCode LTT x y\n      MO_F_Le W32 -> condFltCode LE  x y\n\n      MO_F_Eq W64 -> condFltCode EQQ x y\n      MO_F_Ne W64 -> condFltCode NE  x y\n      MO_F_Gt W64 -> condFltCode GTT x y\n      MO_F_Ge W64 -> condFltCode GE  x y\n      MO_F_Lt W64 -> condFltCode LTT x y\n      MO_F_Le W64 -> condFltCode LE  x y\n\n      MO_Eq   _   -> condIntCode EQQ  x y\n      MO_Ne   _   -> condIntCode NE   x y\n\n      MO_S_Gt _   -> condIntCode GTT  x y\n      MO_S_Ge _   -> condIntCode GE   x y\n      MO_S_Lt _   -> condIntCode LTT  x y\n      MO_S_Le _   -> condIntCode LE   x y\n\n      MO_U_Gt _   -> condIntCode GU   x y\n      MO_U_Ge _   -> condIntCode GEU  x y\n      MO_U_Lt _   -> condIntCode LU   x y\n      MO_U_Le _   -> condIntCode LEU  x y\n\n      _           -> pprPanic \"SPARC.CodeGen.CondCode.getCondCode\" (ppr (CmmMachOp mop [x,y]))\n\ngetCondCode other = pprPanic \"SPARC.CodeGen.CondCode.getCondCode\" (ppr other)\n\n\n\n\n\n-- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be\n-- passed back up the tree.\n\ncondIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode\ncondIntCode cond x (CmmLit (CmmInt y _))\n  | fits13Bits y\n  = do\n       (src1, code) <- getSomeReg x\n       let\n           src2 = ImmInt (fromInteger y)\n           code' = code `snocOL` SUB False True src1 (RIImm src2) g0\n       return (CondCode False cond code')\n\ncondIntCode cond x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let\n        code__2 = code1 `appOL` code2 `snocOL`\n                  SUB False True src1 (RIReg src2) g0\n    return (CondCode False cond code__2)\n\n\ncondFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode\ncondFltCode cond x y = do\n    dflags <- getDynFlags\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    tmp <- getNewRegNat FF64\n    let\n        promote x = FxTOy FF32 FF64 x tmp\n\n        pk1   = cmmExprType dflags x\n        pk2   = cmmExprType dflags y\n\n        code__2 =\n                if pk1 `cmmEqType` pk2 then\n                    code1 `appOL` code2 `snocOL`\n                    FCMP True (cmmTypeFormat pk1) src1 src2\n                else if typeWidth pk1 == W32 then\n                    code1 `snocOL` promote src1 `appOL` code2 `snocOL`\n                    FCMP True FF64 tmp src2\n                else\n                    code1 `appOL` code2 `snocOL` promote src2 `snocOL`\n                    FCMP True FF64 src1 tmp\n    return (CondCode True cond code__2)\n", "num_lines": 111}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Expand out synthetic instructions into single machine instrs.\nmodule SPARC.CodeGen.Expand (\n        expandTop\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.Instr\nimport SPARC.Imm\nimport SPARC.AddrMode\nimport SPARC.Regs\nimport SPARC.Ppr        ()\nimport Instruction\nimport Reg\nimport Format\nimport Cmm\n\n\nimport Outputable\nimport OrdList\n\n-- | Expand out synthetic instructions in this top level thing\nexpandTop :: NatCmmDecl CmmStatics Instr -> NatCmmDecl CmmStatics Instr\nexpandTop top@(CmmData{})\n        = top\n\nexpandTop (CmmProc info lbl live (ListGraph blocks))\n        = CmmProc info lbl live (ListGraph $ map expandBlock blocks)\n\n\n-- | Expand out synthetic instructions in this block\nexpandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr\n\nexpandBlock (BasicBlock label instrs)\n = let  instrs_ol       = expandBlockInstrs instrs\n        instrs'         = fromOL instrs_ol\n   in   BasicBlock label instrs'\n\n\n-- | Expand out some instructions\nexpandBlockInstrs :: [Instr] -> OrdList Instr\nexpandBlockInstrs []    = nilOL\n\nexpandBlockInstrs (ii:is)\n = let  ii_doubleRegs   = remapRegPair ii\n        is_misaligned   = expandMisalignedDoubles ii_doubleRegs\n\n   in   is_misaligned `appOL` expandBlockInstrs is\n\n\n\n-- | In the SPARC instruction set the FP register pairs that are used\n--      to hold 64 bit floats are refered to by just the first reg\n--      of the pair. Remap our internal reg pairs to the appropriate reg.\n--\n--      For example:\n--          ldd [%l1], (%f0 | %f1)\n--\n--      gets mapped to\n--          ldd [$l1], %f0\n--\nremapRegPair :: Instr -> Instr\nremapRegPair instr\n = let  patchF reg\n         = case reg of\n                RegReal (RealRegSingle _)\n                        -> reg\n\n                RegReal (RealRegPair r1 r2)\n\n                        -- sanity checking\n                        | r1         >= 32\n                        , r1         <= 63\n                        , r1 `mod` 2 == 0\n                        , r2         == r1 + 1\n                        -> RegReal (RealRegSingle r1)\n\n                        | otherwise\n                        -> pprPanic \"SPARC.CodeGen.Expand: not remapping dodgy looking reg pair \" (ppr reg)\n\n                RegVirtual _\n                        -> pprPanic \"SPARC.CodeGen.Expand: not remapping virtual reg \" (ppr reg)\n\n   in   patchRegsOfInstr instr patchF\n\n\n\n\n-- Expand out 64 bit load/stores into individual instructions to handle\n--      possible double alignment problems.\n--\n--      TODO:   It'd be better to use a scratch reg instead of the add/sub thing.\n--              We might be able to do this faster if we use the UA2007 instr set\n--              instead of restricting ourselves to SPARC V9.\n--\nexpandMisalignedDoubles :: Instr -> OrdList Instr\nexpandMisalignedDoubles instr\n\n        -- Translate to:\n        --    add g1,g2,g1\n        --    ld  [g1],%fn\n        --    ld  [g1+4],%f(n+1)\n        --    sub g1,g2,g1           -- to restore g1\n        | LD FF64 (AddrRegReg r1 r2) fReg       <- instr\n        =       toOL    [ ADD False False r1 (RIReg r2) r1\n                        , LD  FF32  (AddrRegReg r1 g0)          fReg\n                        , LD  FF32  (AddrRegImm r1 (ImmInt 4))  (fRegHi fReg)\n                        , SUB False False r1 (RIReg r2) r1 ]\n\n        -- Translate to\n        --    ld  [addr],%fn\n        --    ld  [addr+4],%f(n+1)\n        | LD FF64 addr fReg                     <- instr\n        = let   Just addr'      = addrOffset addr 4\n          in    toOL    [ LD  FF32  addr        fReg\n                        , LD  FF32  addr'       (fRegHi fReg) ]\n\n        -- Translate to:\n        --    add g1,g2,g1\n        --    st  %fn,[g1]\n        --    st  %f(n+1),[g1+4]\n        --    sub g1,g2,g1           -- to restore g1\n        | ST FF64 fReg (AddrRegReg r1 r2)       <- instr\n        =       toOL    [ ADD False False r1 (RIReg r2) r1\n                        , ST  FF32  fReg           (AddrRegReg r1 g0)\n                        , ST  FF32  (fRegHi fReg)  (AddrRegImm r1 (ImmInt 4))\n                        , SUB False False r1 (RIReg r2) r1 ]\n\n        -- Translate to\n        --    ld  [addr],%fn\n        --    ld  [addr+4],%f(n+1)\n        | ST FF64 fReg addr                     <- instr\n        = let   Just addr'      = addrOffset addr 4\n          in    toOL    [ ST  FF32  fReg           addr\n                        , ST  FF32  (fRegHi fReg)  addr'         ]\n\n        -- some other instr\n        | otherwise\n        = unitOL instr\n\n\n\n-- | The high partner for this float reg.\nfRegHi :: Reg -> Reg\nfRegHi (RegReal (RealRegSingle r1))\n        | r1            >= 32\n        , r1            <= 63\n        , r1 `mod` 2 == 0\n        = (RegReal $ RealRegSingle (r1 + 1))\n\n-- Can't take high partner for non-low reg.\nfRegHi reg\n        = pprPanic \"SPARC.CodeGen.Expand: can't take fRegHi from \" (ppr reg)\n", "num_lines": 156}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Evaluation of 32 bit values.\nmodule SPARC.CodeGen.Gen32 (\n        getSomeReg,\n        getRegister\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.CodeGen.CondCode\nimport SPARC.CodeGen.Amode\nimport SPARC.CodeGen.Gen64\nimport SPARC.CodeGen.Base\nimport SPARC.Stack\nimport SPARC.Instr\nimport SPARC.Cond\nimport SPARC.AddrMode\nimport SPARC.Imm\nimport SPARC.Regs\nimport SPARC.Base\nimport NCGMonad\nimport Format\nimport Reg\n\nimport Cmm\n\nimport Control.Monad (liftM)\nimport DynFlags\nimport OrdList\nimport Outputable\n\n-- | The dual to getAnyReg: compute an expression into a register, but\n--      we don't mind which one it is.\ngetSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)\ngetSomeReg expr = do\n  r <- getRegister expr\n  case r of\n    Any rep code -> do\n        tmp <- getNewRegNat rep\n        return (tmp, code tmp)\n    Fixed _ reg code ->\n        return (reg, code)\n\n\n\n-- | Make code to evaluate a 32 bit expression.\n--\ngetRegister :: CmmExpr -> NatM Register\n\ngetRegister (CmmReg reg)\n  = do dflags <- getDynFlags\n       let platform = targetPlatform dflags\n       return (Fixed (cmmTypeFormat (cmmRegType dflags reg))\n                     (getRegisterReg platform reg) nilOL)\n\ngetRegister tree@(CmmRegOff _ _)\n  = do dflags <- getDynFlags\n       getRegister (mangleIndexTree dflags tree)\n\ngetRegister (CmmMachOp (MO_UU_Conv W64 W32)\n             [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 (getHiVRegFromLo rlo) code\n\ngetRegister (CmmMachOp (MO_SS_Conv W64 W32)\n             [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 (getHiVRegFromLo rlo) code\n\ngetRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 rlo code\n\ngetRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 rlo code\n\n\n-- Load a literal float into a float register.\n--      The actual literal is stored in a new data area, and we load it\n--      at runtime.\ngetRegister (CmmLit (CmmFloat f W32)) = do\n\n    -- a label for the new data area\n    lbl <- getNewLabelNat\n    tmp <- getNewRegNat II32\n\n    let code dst = toOL [\n            -- the data area\n            LDATA (Section ReadOnlyData lbl) $ Statics lbl\n                         [CmmStaticLit (CmmFloat f W32)],\n\n            -- load the literal\n            SETHI (HI (ImmCLbl lbl)) tmp,\n            LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]\n\n    return (Any FF32 code)\n\ngetRegister (CmmLit (CmmFloat d W64)) = do\n    lbl <- getNewLabelNat\n    tmp <- getNewRegNat II32\n    let code dst = toOL [\n            LDATA (Section ReadOnlyData lbl) $ Statics lbl\n                         [CmmStaticLit (CmmFloat d W64)],\n            SETHI (HI (ImmCLbl lbl)) tmp,\n            LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]\n    return (Any FF64 code)\n\n\n-- Unary machine ops\ngetRegister (CmmMachOp mop [x])\n  = case mop of\n        -- Floating point negation -------------------------\n        MO_F_Neg W32            -> trivialUFCode FF32 (FNEG FF32) x\n        MO_F_Neg W64            -> trivialUFCode FF64 (FNEG FF64) x\n\n\n        -- Integer negation --------------------------------\n        MO_S_Neg rep            -> trivialUCode (intFormat rep) (SUB False False g0) x\n        MO_Not rep              -> trivialUCode (intFormat rep) (XNOR False g0) x\n\n\n        -- Float word size conversion ----------------------\n        MO_FF_Conv W64 W32      -> coerceDbl2Flt x\n        MO_FF_Conv W32 W64      -> coerceFlt2Dbl x\n\n\n        -- Float <-> Signed Int conversion -----------------\n        MO_FS_Conv from to      -> coerceFP2Int from to x\n        MO_SF_Conv from to      -> coerceInt2FP from to x\n\n\n        -- Unsigned integer word size conversions ----------\n\n        -- If it's the same size, then nothing needs to be done.\n        MO_UU_Conv from to\n         | from == to           -> conversionNop (intFormat to)  x\n\n        -- To narrow an unsigned word, mask out the high bits to simulate what would\n        --      happen if we copied the value into a smaller register.\n        MO_UU_Conv W16 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))\n        MO_UU_Conv W32 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))\n\n        -- for narrowing 32 bit to 16 bit, don't use a literal mask value like the W16->W8\n        --      case because the only way we can load it is via SETHI, which needs 2 ops.\n        --      Do some shifts to chop out the high bits instead.\n        MO_UU_Conv W32 W16\n         -> do  tmpReg          <- getNewRegNat II32\n                (xReg, xCode)   <- getSomeReg x\n                let code dst\n                        =       xCode\n                        `appOL` toOL\n                                [ SLL xReg   (RIImm $ ImmInt 16) tmpReg\n                                , SRL tmpReg (RIImm $ ImmInt 16) dst]\n\n                return  $ Any II32 code\n\n                --       trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))\n\n        -- To widen an unsigned word we don't have to do anything.\n        --      Just leave it in the same register and mark the result as the new size.\n        MO_UU_Conv W8  W16      -> conversionNop (intFormat W16)  x\n        MO_UU_Conv W8  W32      -> conversionNop (intFormat W32)  x\n        MO_UU_Conv W16 W32      -> conversionNop (intFormat W32)  x\n\n\n        -- Signed integer word size conversions ------------\n\n        -- Mask out high bits when narrowing them\n        MO_SS_Conv W16 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))\n        MO_SS_Conv W32 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))\n        MO_SS_Conv W32 W16      -> trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))\n\n        -- Sign extend signed words when widening them.\n        MO_SS_Conv W8  W16      -> integerExtend W8  W16 x\n        MO_SS_Conv W8  W32      -> integerExtend W8  W32 x\n        MO_SS_Conv W16 W32      -> integerExtend W16 W32 x\n\n        _                       -> panic (\"Unknown unary mach op: \" ++ show mop)\n\n\n-- Binary machine ops\ngetRegister (CmmMachOp mop [x, y])\n  = case mop of\n      MO_Eq _           -> condIntReg EQQ x y\n      MO_Ne _           -> condIntReg NE x y\n\n      MO_S_Gt _         -> condIntReg GTT x y\n      MO_S_Ge _         -> condIntReg GE x y\n      MO_S_Lt _         -> condIntReg LTT x y\n      MO_S_Le _         -> condIntReg LE x y\n\n      MO_U_Gt W32       -> condIntReg GU  x y\n      MO_U_Ge W32       -> condIntReg GEU x y\n      MO_U_Lt W32       -> condIntReg LU  x y\n      MO_U_Le W32       -> condIntReg LEU x y\n\n      MO_U_Gt W16       -> condIntReg GU  x y\n      MO_U_Ge W16       -> condIntReg GEU x y\n      MO_U_Lt W16       -> condIntReg LU  x y\n      MO_U_Le W16       -> condIntReg LEU x y\n\n      MO_Add W32        -> trivialCode W32 (ADD False False) x y\n      MO_Sub W32        -> trivialCode W32 (SUB False False) x y\n\n      MO_S_MulMayOflo rep -> imulMayOflo rep x y\n\n      MO_S_Quot W32     -> idiv True  False x y\n      MO_U_Quot W32     -> idiv False False x y\n\n      MO_S_Rem  W32     -> irem True  x y\n      MO_U_Rem  W32     -> irem False x y\n\n      MO_F_Eq _         -> condFltReg EQQ x y\n      MO_F_Ne _         -> condFltReg NE x y\n\n      MO_F_Gt _         -> condFltReg GTT x y\n      MO_F_Ge _         -> condFltReg GE x y\n      MO_F_Lt _         -> condFltReg LTT x y\n      MO_F_Le _         -> condFltReg LE x y\n\n      MO_F_Add  w       -> trivialFCode w FADD x y\n      MO_F_Sub  w       -> trivialFCode w FSUB x y\n      MO_F_Mul  w       -> trivialFCode w FMUL x y\n      MO_F_Quot w       -> trivialFCode w FDIV x y\n\n      MO_And rep        -> trivialCode rep (AND False) x y\n      MO_Or  rep        -> trivialCode rep (OR  False) x y\n      MO_Xor rep        -> trivialCode rep (XOR False) x y\n\n      MO_Mul rep        -> trivialCode rep (SMUL False) x y\n\n      MO_Shl rep        -> trivialCode rep SLL  x y\n      MO_U_Shr rep      -> trivialCode rep SRL x y\n      MO_S_Shr rep      -> trivialCode rep SRA x y\n\n      _                 -> pprPanic \"getRegister(sparc) - binary CmmMachOp (1)\" (pprMachOp mop)\n\ngetRegister (CmmLoad mem pk) = do\n    Amode src code <- getAmode mem\n    let\n        code__2 dst     = code `snocOL` LD (cmmTypeFormat pk) src dst\n    return (Any (cmmTypeFormat pk) code__2)\n\ngetRegister (CmmLit (CmmInt i _))\n  | fits13Bits i\n  = let\n        src = ImmInt (fromInteger i)\n        code dst = unitOL (OR False g0 (RIImm src) dst)\n    in\n        return (Any II32 code)\n\ngetRegister (CmmLit lit)\n  = let imm = litToImm lit\n        code dst = toOL [\n            SETHI (HI imm) dst,\n            OR False dst (RIImm (LO imm)) dst]\n    in return (Any II32 code)\n\n\ngetRegister _\n        = panic \"SPARC.CodeGen.Gen32.getRegister: no match\"\n\n\n-- | sign extend and widen\nintegerExtend\n        :: Width                -- ^ width of source expression\n        -> Width                -- ^ width of result\n        -> CmmExpr              -- ^ source expression\n        -> NatM Register\n\nintegerExtend from to expr\n = do   -- load the expr into some register\n        (reg, e_code)   <- getSomeReg expr\n        tmp             <- getNewRegNat II32\n        let bitCount\n                = case (from, to) of\n                        (W8,  W32)      -> 24\n                        (W16, W32)      -> 16\n                        (W8,  W16)      -> 24\n                        _               -> panic \"SPARC.CodeGen.Gen32: no match\"\n        let code dst\n                = e_code\n\n                -- local shift word left to load the sign bit\n                `snocOL`  SLL reg (RIImm (ImmInt bitCount)) tmp\n\n                -- arithmetic shift right to sign extend\n                `snocOL`  SRA tmp (RIImm (ImmInt bitCount)) dst\n\n        return (Any (intFormat to) code)\n\n\n-- | For nop word format conversions we set the resulting value to have the\n--      required size, but don't need to generate any actual code.\n--\nconversionNop\n        :: Format -> CmmExpr -> NatM Register\n\nconversionNop new_rep expr\n = do   e_code <- getRegister expr\n        return (setFormatOfRegister e_code new_rep)\n\n\n\n-- | Generate an integer division instruction.\nidiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register\n\n-- For unsigned division with a 32 bit numerator,\n--              we can just clear the Y register.\nidiv False cc x y\n = do\n        (a_reg, a_code)         <- getSomeReg x\n        (b_reg, b_code)         <- getSomeReg y\n\n        let code dst\n                =       a_code\n                `appOL` b_code\n                `appOL` toOL\n                        [ WRY  g0 g0\n                        , UDIV cc a_reg (RIReg b_reg) dst]\n\n        return (Any II32 code)\n\n\n-- For _signed_ division with a 32 bit numerator,\n--              we have to sign extend the numerator into the Y register.\nidiv True cc x y\n = do\n        (a_reg, a_code)         <- getSomeReg x\n        (b_reg, b_code)         <- getSomeReg y\n\n        tmp                     <- getNewRegNat II32\n\n        let code dst\n                =       a_code\n                `appOL` b_code\n                `appOL` toOL\n                        [ SRA  a_reg (RIImm (ImmInt 16)) tmp            -- sign extend\n                        , SRA  tmp   (RIImm (ImmInt 16)) tmp\n\n                        , WRY  tmp g0\n                        , SDIV cc a_reg (RIReg b_reg) dst]\n\n        return (Any II32 code)\n\n\n-- | Do an integer remainder.\n--\n--       NOTE:  The SPARC v8 architecture manual says that integer division\n--              instructions _may_ generate a remainder, depending on the implementation.\n--              If so it is _recommended_ that the remainder is placed in the Y register.\n--\n--          The UltraSparc 2007 manual says Y is _undefined_ after division.\n--\n--              The SPARC T2 doesn't store the remainder, not sure about the others.\n--              It's probably best not to worry about it, and just generate our own\n--              remainders.\n--\nirem :: Bool -> CmmExpr -> CmmExpr -> NatM Register\n\n-- For unsigned operands:\n--              Division is between a 64 bit numerator and a 32 bit denominator,\n--              so we still have to clear the Y register.\nirem False x y\n = do\n        (a_reg, a_code) <- getSomeReg x\n        (b_reg, b_code) <- getSomeReg y\n\n        tmp_reg         <- getNewRegNat II32\n\n        let code dst\n                =       a_code\n                `appOL` b_code\n                `appOL` toOL\n                        [ WRY   g0 g0\n                        , UDIV  False         a_reg (RIReg b_reg) tmp_reg\n                        , UMUL  False       tmp_reg (RIReg b_reg) tmp_reg\n                        , SUB   False False   a_reg (RIReg tmp_reg) dst]\n\n        return  (Any II32 code)\n\n\n\n-- For signed operands:\n--              Make sure to sign extend into the Y register, or the remainder\n--              will have the wrong sign when the numerator is negative.\n--\n--      TODO:   When sign extending, GCC only shifts the a_reg right by 17 bits,\n--              not the full 32. Not sure why this is, something to do with overflow?\n--              If anyone cares enough about the speed of signed remainder they\n--              can work it out themselves (then tell me). -- BL 2009/01/20\nirem True x y\n = do\n        (a_reg, a_code) <- getSomeReg x\n        (b_reg, b_code) <- getSomeReg y\n\n        tmp1_reg        <- getNewRegNat II32\n        tmp2_reg        <- getNewRegNat II32\n\n        let code dst\n                =       a_code\n                `appOL` b_code\n                `appOL` toOL\n                        [ SRA   a_reg      (RIImm (ImmInt 16)) tmp1_reg -- sign extend\n                        , SRA   tmp1_reg   (RIImm (ImmInt 16)) tmp1_reg -- sign extend\n                        , WRY   tmp1_reg g0\n\n                        , SDIV  False          a_reg (RIReg b_reg)    tmp2_reg\n                        , SMUL  False       tmp2_reg (RIReg b_reg)    tmp2_reg\n                        , SUB   False False    a_reg (RIReg tmp2_reg) dst]\n\n        return (Any II32 code)\n\n\nimulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register\nimulMayOflo rep a b\n = do\n        (a_reg, a_code) <- getSomeReg a\n        (b_reg, b_code) <- getSomeReg b\n        res_lo <- getNewRegNat II32\n        res_hi <- getNewRegNat II32\n\n        let shift_amt  = case rep of\n                          W32 -> 31\n                          W64 -> 63\n                          _ -> panic \"shift_amt\"\n\n        let code dst = a_code `appOL` b_code `appOL`\n                       toOL [\n                           SMUL False a_reg (RIReg b_reg) res_lo,\n                           RDY res_hi,\n                           SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,\n                           SUB False False res_lo (RIReg res_hi) dst\n                        ]\n        return (Any II32 code)\n\n\n-- -----------------------------------------------------------------------------\n-- 'trivial*Code': deal with trivial instructions\n\n-- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',\n-- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.\n-- Only look for constants on the right hand side, because that's\n-- where the generic optimizer will have put them.\n\n-- Similarly, for unary instructions, we don't have to worry about\n-- matching an StInt as the argument, because genericOpt will already\n-- have handled the constant-folding.\n\ntrivialCode\n        :: Width\n        -> (Reg -> RI -> Reg -> Instr)\n        -> CmmExpr\n        -> CmmExpr\n        -> NatM Register\n\ntrivialCode _ instr x (CmmLit (CmmInt y _))\n  | fits13Bits y\n  = do\n      (src1, code) <- getSomeReg x\n      let\n        src2 = ImmInt (fromInteger y)\n        code__2 dst = code `snocOL` instr src1 (RIImm src2) dst\n      return (Any II32 code__2)\n\n\ntrivialCode _ instr x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let\n        code__2 dst = code1 `appOL` code2 `snocOL`\n                      instr src1 (RIReg src2) dst\n    return (Any II32 code__2)\n\n\ntrivialFCode\n        :: Width\n        -> (Format -> Reg -> Reg -> Reg -> Instr)\n        -> CmmExpr\n        -> CmmExpr\n        -> NatM Register\n\ntrivialFCode pk instr x y = do\n    dflags <- getDynFlags\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    tmp <- getNewRegNat FF64\n    let\n        promote x = FxTOy FF32 FF64 x tmp\n\n        pk1   = cmmExprType dflags x\n        pk2   = cmmExprType dflags y\n\n        code__2 dst =\n                if pk1 `cmmEqType` pk2 then\n                    code1 `appOL` code2 `snocOL`\n                    instr (floatFormat pk) src1 src2 dst\n                else if typeWidth pk1 == W32 then\n                    code1 `snocOL` promote src1 `appOL` code2 `snocOL`\n                    instr FF64 tmp src2 dst\n                else\n                    code1 `appOL` code2 `snocOL` promote src2 `snocOL`\n                    instr FF64 src1 tmp dst\n    return (Any (cmmTypeFormat $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64)\n                code__2)\n\n\n\ntrivialUCode\n        :: Format\n        -> (RI -> Reg -> Instr)\n        -> CmmExpr\n        -> NatM Register\n\ntrivialUCode format instr x = do\n    (src, code) <- getSomeReg x\n    let\n        code__2 dst = code `snocOL` instr (RIReg src) dst\n    return (Any format code__2)\n\n\ntrivialUFCode\n        :: Format\n        -> (Reg -> Reg -> Instr)\n        -> CmmExpr\n        -> NatM Register\n\ntrivialUFCode pk instr x = do\n    (src, code) <- getSomeReg x\n    let\n        code__2 dst = code `snocOL` instr src dst\n    return (Any pk code__2)\n\n\n\n\n-- Coercions -------------------------------------------------------------------\n\n-- | Coerce a integer value to floating point\ncoerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register\ncoerceInt2FP width1 width2 x = do\n    (src, code) <- getSomeReg x\n    let\n        code__2 dst = code `appOL` toOL [\n            ST (intFormat width1) src (spRel (-2)),\n            LD (intFormat width1) (spRel (-2)) dst,\n            FxTOy (intFormat width1) (floatFormat width2) dst dst]\n    return (Any (floatFormat $ width2) code__2)\n\n\n\n-- | Coerce a floating point value to integer\n--\n--   NOTE: On sparc v9 there are no instructions to move a value from an\n--         FP register directly to an int register, so we have to use a load/store.\n--\ncoerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register\ncoerceFP2Int width1 width2 x\n = do   let fformat1      = floatFormat width1\n            fformat2      = floatFormat width2\n\n            iformat2      = intFormat   width2\n\n        (fsrc, code)    <- getSomeReg x\n        fdst            <- getNewRegNat fformat2\n\n        let code2 dst\n                =       code\n                `appOL` toOL\n                        -- convert float to int format, leaving it in a float reg.\n                        [ FxTOy fformat1 iformat2 fsrc fdst\n\n                        -- store the int into mem, then load it back to move\n                        --      it into an actual int reg.\n                        , ST    fformat2 fdst (spRel (-2))\n                        , LD    iformat2 (spRel (-2)) dst]\n\n        return (Any iformat2 code2)\n\n\n-- | Coerce a double precision floating point value to single precision.\ncoerceDbl2Flt :: CmmExpr -> NatM Register\ncoerceDbl2Flt x = do\n    (src, code) <- getSomeReg x\n    return (Any FF32 (\\dst -> code `snocOL` FxTOy FF64 FF32 src dst))\n\n\n-- | Coerce a single precision floating point value to double precision\ncoerceFlt2Dbl :: CmmExpr -> NatM Register\ncoerceFlt2Dbl x = do\n    (src, code) <- getSomeReg x\n    return (Any FF64 (\\dst -> code `snocOL` FxTOy FF32 FF64 src dst))\n\n\n\n\n-- Condition Codes -------------------------------------------------------------\n--\n-- Evaluate a comparison, and get the result into a register.\n--\n-- Do not fill the delay slots here. you will confuse the register allocator.\n--\ncondIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register\ncondIntReg EQQ x (CmmLit (CmmInt 0 _)) = do\n    (src, code) <- getSomeReg x\n    let\n        code__2 dst = code `appOL` toOL [\n            SUB False True g0 (RIReg src) g0,\n            SUB True False g0 (RIImm (ImmInt (-1))) dst]\n    return (Any II32 code__2)\n\ncondIntReg EQQ x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let\n        code__2 dst = code1 `appOL` code2 `appOL` toOL [\n            XOR False src1 (RIReg src2) dst,\n            SUB False True g0 (RIReg dst) g0,\n            SUB True False g0 (RIImm (ImmInt (-1))) dst]\n    return (Any II32 code__2)\n\ncondIntReg NE x (CmmLit (CmmInt 0 _)) = do\n    (src, code) <- getSomeReg x\n    let\n        code__2 dst = code `appOL` toOL [\n            SUB False True g0 (RIReg src) g0,\n            ADD True False g0 (RIImm (ImmInt 0)) dst]\n    return (Any II32 code__2)\n\ncondIntReg NE x y = do\n    (src1, code1) <- getSomeReg x\n    (src2, code2) <- getSomeReg y\n    let\n        code__2 dst = code1 `appOL` code2 `appOL` toOL [\n            XOR False src1 (RIReg src2) dst,\n            SUB False True g0 (RIReg dst) g0,\n            ADD True False g0 (RIImm (ImmInt 0)) dst]\n    return (Any II32 code__2)\n\ncondIntReg cond x y = do\n    bid1 <- liftM (\\a -> seq a a) getBlockIdNat\n    bid2 <- liftM (\\a -> seq a a) getBlockIdNat\n    CondCode _ cond cond_code <- condIntCode cond x y\n    let\n        code__2 dst\n         =      cond_code\n          `appOL` toOL\n                [ BI cond False bid1\n                , NOP\n\n                , OR False g0 (RIImm (ImmInt 0)) dst\n                , BI ALWAYS False bid2\n                , NOP\n\n                , NEWBLOCK bid1\n                , OR False g0 (RIImm (ImmInt 1)) dst\n                , BI ALWAYS False bid2\n                , NOP\n\n                , NEWBLOCK bid2]\n\n    return (Any II32 code__2)\n\n\ncondFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register\ncondFltReg cond x y = do\n    bid1 <- liftM (\\a -> seq a a) getBlockIdNat\n    bid2 <- liftM (\\a -> seq a a) getBlockIdNat\n\n    CondCode _ cond cond_code <- condFltCode cond x y\n    let\n        code__2 dst\n         =      cond_code\n          `appOL` toOL\n                [ NOP\n                , BF cond False bid1\n                , NOP\n\n                , OR False g0 (RIImm (ImmInt 0)) dst\n                , BI ALWAYS False bid2\n                , NOP\n\n                , NEWBLOCK bid1\n                , OR False g0 (RIImm (ImmInt 1)) dst\n                , BI ALWAYS False bid2\n                , NOP\n\n                , NEWBLOCK bid2 ]\n\n    return (Any II32 code__2)\n", "num_lines": 693}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Evaluation of 64 bit values on 32 bit platforms.\nmodule SPARC.CodeGen.Gen64 (\n        assignMem_I64Code,\n        assignReg_I64Code,\n        iselExpr64\n)\n\nwhere\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} SPARC.CodeGen.Gen32\nimport SPARC.CodeGen.Base\nimport SPARC.CodeGen.Amode\nimport SPARC.Regs\nimport SPARC.AddrMode\nimport SPARC.Imm\nimport SPARC.Instr\nimport SPARC.Ppr()\nimport NCGMonad\nimport Instruction\nimport Format\nimport Reg\n\nimport Cmm\n\nimport DynFlags\nimport OrdList\nimport Outputable\n\n-- | Code to assign a 64 bit value to memory.\nassignMem_I64Code\n        :: CmmExpr              -- ^ expr producing the destination address\n        -> CmmExpr              -- ^ expr producing the source value.\n        -> NatM InstrBlock\n\nassignMem_I64Code addrTree valueTree\n = do\n     ChildCode64 vcode rlo      <- iselExpr64 valueTree\n\n     (src, acode) <- getSomeReg addrTree\n     let\n         rhi = getHiVRegFromLo rlo\n\n         -- Big-endian store\n         mov_hi = ST II32 rhi (AddrRegImm src (ImmInt 0))\n         mov_lo = ST II32 rlo (AddrRegImm src (ImmInt 4))\n\n         code   = vcode `appOL` acode `snocOL` mov_hi `snocOL` mov_lo\n\n{-     pprTrace \"assignMem_I64Code\"\n        (vcat   [ text \"addrTree:  \" <+> ppr addrTree\n                , text \"valueTree: \" <+> ppr valueTree\n                , text \"vcode:\"\n                , vcat $ map ppr $ fromOL vcode\n                , text \"\"\n                , text \"acode:\"\n                , vcat $ map ppr $ fromOL acode ])\n       $ -}\n     return code\n\n\n-- | Code to assign a 64 bit value to a register.\nassignReg_I64Code\n        :: CmmReg               -- ^ the destination register\n        -> CmmExpr              -- ^ expr producing the source value\n        -> NatM InstrBlock\n\nassignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree\n = do\n     ChildCode64 vcode r_src_lo <- iselExpr64 valueTree\n     let\n         r_dst_lo = RegVirtual $ mkVirtualReg u_dst (cmmTypeFormat pk)\n         r_dst_hi = getHiVRegFromLo r_dst_lo\n         r_src_hi = getHiVRegFromLo r_src_lo\n         mov_lo = mkMOV r_src_lo r_dst_lo\n         mov_hi = mkMOV r_src_hi r_dst_hi\n         mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg\n\n     return (vcode `snocOL` mov_hi `snocOL` mov_lo)\n\nassignReg_I64Code _ _\n   = panic \"assignReg_I64Code(sparc): invalid lvalue\"\n\n\n\n\n-- | Get the value of an expression into a 64 bit register.\n\niselExpr64 :: CmmExpr -> NatM ChildCode64\n\n-- Load a 64 bit word\niselExpr64 (CmmLoad addrTree ty)\n | isWord64 ty\n = do   Amode amode addr_code   <- getAmode addrTree\n        let result\n\n                | AddrRegReg r1 r2      <- amode\n                = do    rlo     <- getNewRegNat II32\n                        tmp     <- getNewRegNat II32\n                        let rhi = getHiVRegFromLo rlo\n\n                        return  $ ChildCode64\n                                (        addr_code\n                                `appOL`  toOL\n                                         [ ADD False False r1 (RIReg r2) tmp\n                                         , LD II32 (AddrRegImm tmp (ImmInt 0)) rhi\n                                         , LD II32 (AddrRegImm tmp (ImmInt 4)) rlo ])\n                                rlo\n\n                | AddrRegImm r1 (ImmInt i) <- amode\n                = do    rlo     <- getNewRegNat II32\n                        let rhi = getHiVRegFromLo rlo\n\n                        return  $ ChildCode64\n                                (        addr_code\n                                `appOL`  toOL\n                                         [ LD II32 (AddrRegImm r1 (ImmInt $ 0 + i)) rhi\n                                         , LD II32 (AddrRegImm r1 (ImmInt $ 4 + i)) rlo ])\n                                rlo\n\n                | otherwise\n                = panic \"SPARC.CodeGen.Gen64: no match\"\n\n        result\n\n\n-- Add a literal to a 64 bit integer\niselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)])\n = do   ChildCode64 code1 r1_lo <- iselExpr64 e1\n        let r1_hi       = getHiVRegFromLo r1_lo\n\n        r_dst_lo        <- getNewRegNat II32\n        let r_dst_hi    =  getHiVRegFromLo r_dst_lo\n\n        let code =      code1\n                `appOL` toOL\n                        [ ADD False True  r1_lo (RIImm (ImmInteger i)) r_dst_lo\n                        , ADD True  False r1_hi (RIReg g0)         r_dst_hi ]\n\n        return  $ ChildCode64 code r_dst_lo\n\n\n-- Addition of II64\niselExpr64 (CmmMachOp (MO_Add _) [e1, e2])\n = do   ChildCode64 code1 r1_lo <- iselExpr64 e1\n        let r1_hi       = getHiVRegFromLo r1_lo\n\n        ChildCode64 code2 r2_lo <- iselExpr64 e2\n        let r2_hi       = getHiVRegFromLo r2_lo\n\n        r_dst_lo        <- getNewRegNat II32\n        let r_dst_hi    = getHiVRegFromLo r_dst_lo\n\n        let code =      code1\n                `appOL` code2\n                `appOL` toOL\n                        [ ADD False True  r1_lo (RIReg r2_lo) r_dst_lo\n                        , ADD True  False r1_hi (RIReg r2_hi) r_dst_hi ]\n\n        return  $ ChildCode64 code r_dst_lo\n\n\niselExpr64 (CmmReg (CmmLocal (LocalReg uq ty)))\n | isWord64 ty\n = do\n     r_dst_lo <-  getNewRegNat II32\n     let r_dst_hi = getHiVRegFromLo r_dst_lo\n         r_src_lo = RegVirtual $ mkVirtualReg uq II32\n         r_src_hi = getHiVRegFromLo r_src_lo\n         mov_lo = mkMOV r_src_lo r_dst_lo\n         mov_hi = mkMOV r_src_hi r_dst_hi\n         mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg\n     return (\n            ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo\n         )\n\n-- Convert something into II64\niselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])\n = do\n        r_dst_lo        <- getNewRegNat II32\n        let r_dst_hi    = getHiVRegFromLo r_dst_lo\n\n        -- compute expr and load it into r_dst_lo\n        (a_reg, a_code) <- getSomeReg expr\n\n        dflags <- getDynFlags\n        let platform = targetPlatform dflags\n            code        = a_code\n                `appOL` toOL\n                        [ mkRegRegMoveInstr platform g0    r_dst_hi     -- clear high 32 bits\n                        , mkRegRegMoveInstr platform a_reg r_dst_lo ]\n\n        return  $ ChildCode64 code r_dst_lo\n\n-- only W32 supported for now\niselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr])\n = do\n        r_dst_lo        <- getNewRegNat II32\n        let r_dst_hi    = getHiVRegFromLo r_dst_lo\n\n        -- compute expr and load it into r_dst_lo\n        (a_reg, a_code) <- getSomeReg expr\n\n        dflags          <- getDynFlags\n        let platform    = targetPlatform dflags\n            code        = a_code\n                `appOL` toOL\n                        [ SRA a_reg (RIImm (ImmInt 31)) r_dst_hi\n                        , mkRegRegMoveInstr platform a_reg r_dst_lo ]\n\n        return  $ ChildCode64 code r_dst_lo\n\n\niselExpr64 expr\n   = pprPanic \"iselExpr64(sparc)\" (ppr expr)\n", "num_lines": 217}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | One ounce of sanity checking is worth 10000000000000000 ounces\n-- of staring blindly at assembly code trying to find the problem..\nmodule SPARC.CodeGen.Sanity (\n        checkBlock\n)\n\nwhere\n\nimport GhcPrelude\n\nimport SPARC.Instr\nimport SPARC.Ppr        ()\nimport Instruction\n\nimport Cmm\n\nimport Outputable\n\n\n-- | Enforce intra-block invariants.\n--\ncheckBlock :: CmmBlock\n           -> NatBasicBlock Instr\n           -> NatBasicBlock Instr\n\ncheckBlock cmm block@(BasicBlock _ instrs)\n        | checkBlockInstrs instrs\n        = block\n\n        | otherwise\n        = pprPanic\n                (\"SPARC.CodeGen: bad block\\n\")\n                ( vcat  [ text \" -- cmm -----------------\\n\"\n                        , ppr cmm\n                        , text \" -- native code ---------\\n\"\n                        , ppr block ])\n\n\ncheckBlockInstrs :: [Instr] -> Bool\ncheckBlockInstrs ii\n\n        -- An unconditional jumps end the block.\n        --      There must be an unconditional jump in the block, otherwise\n        --      the register liveness determinator will get the liveness\n        --      information wrong.\n        --\n        --      If the block ends with a cmm call that never returns\n        --      then there can be unreachable instructions after the jump,\n        --      but we don't mind here.\n        --\n        | instr : NOP : _       <- ii\n        , isUnconditionalJump instr\n        = True\n\n        -- All jumps must have a NOP in their branch delay slot.\n        --      The liveness determinator and register allocators aren't smart\n        --      enough to handle branch delay slots.\n        --\n        | instr : NOP : is      <- ii\n        , isJumpishInstr instr\n        = checkBlockInstrs is\n\n        -- keep checking\n        | _:i2:is               <- ii\n        = checkBlockInstrs (i2:is)\n\n        -- this block is no good\n        | otherwise\n        = False\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GADTs, NondecreasingIndentation #-}\n\n-- The default iteration limit is a bit too low for the definitions\n-- in this module.\n{-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}\n\n-----------------------------------------------------------------------------\n--\n-- Generating machine code (instruction selection)\n--\n-- (c) The University of Glasgow 1996-2004\n--\n-----------------------------------------------------------------------------\n\n-- This is a big module, but, if you pay attention to\n-- (a) the sectioning, and (b) the type signatures, the\n-- structure should not be too overwhelming.\n\nmodule X86.CodeGen (\n        cmmTopCodeGen,\n        generateJumpTableForInstr,\n        extractUnwindPoints,\n        invertCondBranches,\n        InstrBlock\n)\n\nwhere\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n#include \"../includes/MachDeps.h\"\n\n-- NCG stuff:\nimport GhcPrelude\n\nimport X86.Instr\nimport X86.Cond\nimport X86.Regs\nimport X86.RegInfo\n\n--TODO: Remove - Just for development/debugging\nimport X86.Ppr()\n\nimport CodeGen.Platform\nimport CPrim\nimport Debug            ( DebugBlock(..), UnwindPoint(..), UnwindTable\n                        , UnwindExpr(UwReg), toUnwindExpr )\nimport Instruction\nimport PIC\nimport NCGMonad   ( NatM, getNewRegNat, getNewLabelNat, setDeltaNat\n                  , getDeltaNat, getBlockIdNat, getPicBaseNat, getNewRegPairNat\n                  , getPicBaseMaybeNat, getDebugBlock, getFileId\n                  , addImmediateSuccessorNat, updateCfgNat)\nimport CFG\nimport Format\nimport Reg\nimport Platform\n\n-- Our intermediate code:\nimport BasicTypes\nimport BlockId\nimport Module           ( primUnitId )\nimport PprCmm           ()\nimport CmmUtils\nimport CmmSwitch\nimport Cmm\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport Hoopl.Label\nimport CLabel\nimport CoreSyn          ( Tickish(..) )\nimport SrcLoc           ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )\n\n-- The rest:\nimport ForeignCall      ( CCallConv(..) )\nimport OrdList\nimport Outputable\nimport FastString\nimport DynFlags\nimport Util\nimport UniqSupply       ( getUniqueM )\n\nimport Control.Monad\nimport Data.Bits\nimport Data.Foldable (fold)\nimport Data.Int\nimport Data.Maybe\nimport Data.Word\n\nimport qualified Data.Map as M\n\nis32BitPlatform :: NatM Bool\nis32BitPlatform = do\n    dflags <- getDynFlags\n    return $ target32Bit (targetPlatform dflags)\n\nsse2Enabled :: NatM Bool\nsse2Enabled = do\n  dflags <- getDynFlags\n  return (isSse2Enabled dflags)\n\nsse4_2Enabled :: NatM Bool\nsse4_2Enabled = do\n  dflags <- getDynFlags\n  return (isSse4_2Enabled dflags)\n\nif_sse2 :: NatM a -> NatM a -> NatM a\nif_sse2 sse2 x87 = do\n  b <- sse2Enabled\n  if b then sse2 else x87\n\ncmmTopCodeGen\n        :: RawCmmDecl\n        -> NatM [NatCmmDecl (Alignment, CmmStatics) Instr]\n\ncmmTopCodeGen (CmmProc info lab live graph) = do\n  let blocks = toBlockListEntryFirst graph\n  (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks\n  picBaseMb <- getPicBaseMaybeNat\n  dflags <- getDynFlags\n  let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)\n      tops = proc : concat statics\n      os   = platformOS $ targetPlatform dflags\n\n  case picBaseMb of\n      Just picBase -> initializePicBase_x86 ArchX86 os picBase tops\n      Nothing -> return tops\n\ncmmTopCodeGen (CmmData sec dat) = do\n  return [CmmData sec (1, dat)]  -- no translation, we just use CmmStatic\n\n\nbasicBlockCodeGen\n        :: CmmBlock\n        -> NatM ( [NatBasicBlock Instr]\n                , [NatCmmDecl (Alignment, CmmStatics) Instr])\n\nbasicBlockCodeGen block = do\n  let (_, nodes, tail)  = blockSplit block\n      id = entryLabel block\n      stmts = blockToList nodes\n  -- Generate location directive\n  dbg <- getDebugBlock (entryLabel block)\n  loc_instrs <- case dblSourceTick =<< dbg of\n    Just (SourceNote span name)\n      -> do fileId <- getFileId (srcSpanFile span)\n            let line = srcSpanStartLine span; col = srcSpanStartCol span\n            return $ unitOL $ LOCATION fileId line col name\n    _ -> return nilOL\n  mid_instrs <- stmtsToInstrs id stmts\n  tail_instrs <- stmtToInstrs id tail\n  let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs\n  instrs' <- fold <$> traverse addSpUnwindings instrs\n  -- code generation may introduce new basic block boundaries, which\n  -- are indicated by the NEWBLOCK instruction.  We must split up the\n  -- instruction stream into basic blocks again.  Also, we extract\n  -- LDATAs here too.\n  let\n        (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs'\n\n        mkBlocks (NEWBLOCK id) (instrs,blocks,statics)\n          = ([], BasicBlock id instrs : blocks, statics)\n        mkBlocks (LDATA sec dat) (instrs,blocks,statics)\n          = (instrs, blocks, CmmData sec dat:statics)\n        mkBlocks instr (instrs,blocks,statics)\n          = (instr:instrs, blocks, statics)\n  return (BasicBlock id top : other_blocks, statics)\n\n-- | Convert 'DELTA' instructions into 'UNWIND' instructions to capture changes\n-- in the @sp@ register. See Note [What is this unwinding business?] in Debug\n-- for details.\naddSpUnwindings :: Instr -> NatM (OrdList Instr)\naddSpUnwindings instr@(DELTA d) = do\n    dflags <- getDynFlags\n    if debugLevel dflags >= 1\n        then do lbl <- mkAsmTempLabel <$> getUniqueM\n                let unwind = M.singleton MachSp (Just $ UwReg MachSp $ negate d)\n                return $ toOL [ instr, UNWIND lbl unwind ]\n        else return (unitOL instr)\naddSpUnwindings instr = return $ unitOL instr\n\nstmtsToInstrs :: BlockId -> [CmmNode e x] -> NatM InstrBlock\nstmtsToInstrs bid stmts\n   = do instrss <- mapM (stmtToInstrs bid) stmts\n        return (concatOL instrss)\n\n-- | `bid` refers to the current block and is used to update the CFG\n--   if new blocks are inserted in the control flow.\nstmtToInstrs :: BlockId -> CmmNode e x -> NatM InstrBlock\nstmtToInstrs bid stmt = do\n  dflags <- getDynFlags\n  is32Bit <- is32BitPlatform\n  case stmt of\n    CmmComment s   -> return (unitOL (COMMENT s))\n    CmmTick {}     -> return nilOL\n\n    CmmUnwind regs -> do\n      let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable\n          to_unwind_entry (reg, expr) = M.singleton reg (fmap toUnwindExpr expr)\n      case foldMap to_unwind_entry regs of\n        tbl | M.null tbl -> return nilOL\n            | otherwise  -> do\n                lbl <- mkAsmTempLabel <$> getUniqueM\n                return $ unitOL $ UNWIND lbl tbl\n\n    CmmAssign reg src\n      | isFloatType ty         -> assignReg_FltCode format reg src\n      | is32Bit && isWord64 ty -> assignReg_I64Code      reg src\n      | otherwise              -> assignReg_IntCode format reg src\n        where ty = cmmRegType dflags reg\n              format = cmmTypeFormat ty\n\n    CmmStore addr src\n      | isFloatType ty         -> assignMem_FltCode format addr src\n      | is32Bit && isWord64 ty -> assignMem_I64Code      addr src\n      | otherwise              -> assignMem_IntCode format addr src\n        where ty = cmmExprType dflags src\n              format = cmmTypeFormat ty\n\n    CmmUnsafeForeignCall target result_regs args\n       -> genCCall dflags is32Bit target result_regs args bid\n\n    CmmBranch id          -> return $ genBranch id\n\n    --We try to arrange blocks such that the likely branch is the fallthrough\n    --in CmmContFlowOpt. So we can assume the condition is likely false here.\n    CmmCondBranch arg true false _ -> genCondBranch bid true false arg\n    CmmSwitch arg ids -> do dflags <- getDynFlags\n                            genSwitch dflags arg ids\n    CmmCall { cml_target = arg\n            , cml_args_regs = gregs } -> do\n                                dflags <- getDynFlags\n                                genJump arg (jumpRegs dflags gregs)\n    _ ->\n      panic \"stmtToInstrs: statement should have been cps'd away\"\n\n\njumpRegs :: DynFlags -> [GlobalReg] -> [Reg]\njumpRegs dflags gregs = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]\n    where platform = targetPlatform dflags\n\n--------------------------------------------------------------------------------\n-- | 'InstrBlock's are the insn sequences generated by the insn selectors.\n--      They are really trees of insns to facilitate fast appending, where a\n--      left-to-right traversal yields the insns in the correct order.\n--\ntype InstrBlock\n        = OrdList Instr\n\n\n-- | Condition codes passed up the tree.\n--\ndata CondCode\n        = CondCode Bool Cond InstrBlock\n\n\n-- | a.k.a \"Register64\"\n--      Reg is the lower 32-bit temporary which contains the result.\n--      Use getHiVRegFromLo to find the other VRegUnique.\n--\n--      Rules of this simplified insn selection game are therefore that\n--      the returned Reg may be modified\n--\ndata ChildCode64\n   = ChildCode64\n        InstrBlock\n        Reg\n\n\n-- | Register's passed up the tree.  If the stix code forces the register\n--      to live in a pre-decided machine register, it comes out as @Fixed@;\n--      otherwise, it comes out as @Any@, and the parent can decide which\n--      register to put it in.\n--\ndata Register\n        = Fixed Format Reg InstrBlock\n        | Any   Format (Reg -> InstrBlock)\n\n\nswizzleRegisterRep :: Register -> Format -> Register\nswizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code\nswizzleRegisterRep (Any _ codefn)     format = Any   format codefn\n\n\n-- | Grab the Reg for a CmmReg\ngetRegisterReg :: Platform -> Bool -> CmmReg -> Reg\n\ngetRegisterReg _ use_sse2 (CmmLocal (LocalReg u pk))\n  = let fmt = cmmTypeFormat pk in\n    if isFloatFormat fmt && not use_sse2\n       then RegVirtual (mkVirtualReg u FF80)\n       else RegVirtual (mkVirtualReg u fmt)\n\ngetRegisterReg platform _ (CmmGlobal mid)\n  = case globalRegMaybe platform mid of\n        Just reg -> RegReal $ reg\n        Nothing  -> pprPanic \"getRegisterReg-memory\" (ppr $ CmmGlobal mid)\n        -- By this stage, the only MagicIds remaining should be the\n        -- ones which map to a real machine register on this\n        -- platform.  Hence ...\n\n\n-- | Memory addressing modes passed up the tree.\ndata Amode\n        = Amode AddrMode InstrBlock\n\n{-\nNow, given a tree (the argument to a CmmLoad) that references memory,\nproduce a suitable addressing mode.\n\nA Rule of the Game (tm) for Amodes: use of the addr bit must\nimmediately follow use of the code part, since the code part puts\nvalues in registers which the addr then refers to.  So you can't put\nanything in between, lest it overwrite some of those registers.  If\nyou need to do some other computation between the code part and use of\nthe addr bit, first store the effective address from the amode in a\ntemporary, then do the other computation, and then use the temporary:\n\n    code\n    LEA amode, tmp\n    ... other computation ...\n    ... (tmp) ...\n-}\n\n\n-- | Check whether an integer will fit in 32 bits.\n--      A CmmInt is intended to be truncated to the appropriate\n--      number of bits, so here we truncate it to Int64.  This is\n--      important because e.g. -1 as a CmmInt might be either\n--      -1 or 18446744073709551615.\n--\nis32BitInteger :: Integer -> Bool\nis32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000\n  where i64 = fromIntegral i :: Int64\n\n\n-- | Convert a BlockId to some CmmStatic data\njumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic\njumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))\njumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)\n    where blockLabel = blockLbl blockid\n\n\n-- -----------------------------------------------------------------------------\n-- General things for putting together code sequences\n\n-- Expand CmmRegOff.  ToDo: should we do it this way around, or convert\n-- CmmExprs into CmmRegOff?\nmangleIndexTree :: DynFlags -> CmmReg -> Int -> CmmExpr\nmangleIndexTree dflags reg off\n  = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]\n  where width = typeWidth (cmmRegType dflags reg)\n\n-- | The dual to getAnyReg: compute an expression into a register, but\n--      we don't mind which one it is.\ngetSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)\ngetSomeReg expr = do\n  r <- getRegister expr\n  case r of\n    Any rep code -> do\n        tmp <- getNewRegNat rep\n        return (tmp, code tmp)\n    Fixed _ reg code ->\n        return (reg, code)\n\n\nassignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock\nassignMem_I64Code addrTree valueTree = do\n  Amode addr addr_code <- getAmode addrTree\n  ChildCode64 vcode rlo <- iselExpr64 valueTree\n  let\n        rhi = getHiVRegFromLo rlo\n\n        -- Little-endian store\n        mov_lo = MOV II32 (OpReg rlo) (OpAddr addr)\n        mov_hi = MOV II32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))\n  return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)\n\n\nassignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock\nassignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do\n   ChildCode64 vcode r_src_lo <- iselExpr64 valueTree\n   let\n         r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32\n         r_dst_hi = getHiVRegFromLo r_dst_lo\n         r_src_hi = getHiVRegFromLo r_src_lo\n         mov_lo = MOV II32 (OpReg r_src_lo) (OpReg r_dst_lo)\n         mov_hi = MOV II32 (OpReg r_src_hi) (OpReg r_dst_hi)\n   return (\n        vcode `snocOL` mov_lo `snocOL` mov_hi\n     )\n\nassignReg_I64Code _ _\n   = panic \"assignReg_I64Code(i386): invalid lvalue\"\n\n\niselExpr64        :: CmmExpr -> NatM ChildCode64\niselExpr64 (CmmLit (CmmInt i _)) = do\n  (rlo,rhi) <- getNewRegPairNat II32\n  let\n        r = fromIntegral (fromIntegral i :: Word32)\n        q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32)\n        code = toOL [\n                MOV II32 (OpImm (ImmInteger r)) (OpReg rlo),\n                MOV II32 (OpImm (ImmInteger q)) (OpReg rhi)\n                ]\n  return (ChildCode64 code rlo)\n\niselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do\n   Amode addr addr_code <- getAmode addrTree\n   (rlo,rhi) <- getNewRegPairNat II32\n   let\n        mov_lo = MOV II32 (OpAddr addr) (OpReg rlo)\n        mov_hi = MOV II32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)\n   return (\n            ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)\n                        rlo\n     )\n\niselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty\n   = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))\n\n-- we handle addition, but rather badly\niselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do\n   ChildCode64 code1 r1lo <- iselExpr64 e1\n   (rlo,rhi) <- getNewRegPairNat II32\n   let\n        r = fromIntegral (fromIntegral i :: Word32)\n        q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32)\n        r1hi = getHiVRegFromLo r1lo\n        code =  code1 `appOL`\n                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),\n                       ADD II32 (OpImm (ImmInteger r)) (OpReg rlo),\n                       MOV II32 (OpReg r1hi) (OpReg rhi),\n                       ADC II32 (OpImm (ImmInteger q)) (OpReg rhi) ]\n   return (ChildCode64 code rlo)\n\niselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do\n   ChildCode64 code1 r1lo <- iselExpr64 e1\n   ChildCode64 code2 r2lo <- iselExpr64 e2\n   (rlo,rhi) <- getNewRegPairNat II32\n   let\n        r1hi = getHiVRegFromLo r1lo\n        r2hi = getHiVRegFromLo r2lo\n        code =  code1 `appOL`\n                code2 `appOL`\n                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),\n                       ADD II32 (OpReg r2lo) (OpReg rlo),\n                       MOV II32 (OpReg r1hi) (OpReg rhi),\n                       ADC II32 (OpReg r2hi) (OpReg rhi) ]\n   return (ChildCode64 code rlo)\n\niselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do\n   ChildCode64 code1 r1lo <- iselExpr64 e1\n   ChildCode64 code2 r2lo <- iselExpr64 e2\n   (rlo,rhi) <- getNewRegPairNat II32\n   let\n        r1hi = getHiVRegFromLo r1lo\n        r2hi = getHiVRegFromLo r2lo\n        code =  code1 `appOL`\n                code2 `appOL`\n                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),\n                       SUB II32 (OpReg r2lo) (OpReg rlo),\n                       MOV II32 (OpReg r1hi) (OpReg rhi),\n                       SBB II32 (OpReg r2hi) (OpReg rhi) ]\n   return (ChildCode64 code rlo)\n\niselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do\n     fn <- getAnyReg expr\n     r_dst_lo <-  getNewRegNat II32\n     let r_dst_hi = getHiVRegFromLo r_dst_lo\n         code = fn r_dst_lo\n     return (\n             ChildCode64 (code `snocOL`\n                          MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi))\n                          r_dst_lo\n            )\n\niselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do\n     fn <- getAnyReg expr\n     r_dst_lo <-  getNewRegNat II32\n     let r_dst_hi = getHiVRegFromLo r_dst_lo\n         code = fn r_dst_lo\n     return (\n             ChildCode64 (code `snocOL`\n                          MOV II32 (OpReg r_dst_lo) (OpReg eax) `snocOL`\n                          CLTD II32 `snocOL`\n                          MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL`\n                          MOV II32 (OpReg edx) (OpReg r_dst_hi))\n                          r_dst_lo\n            )\n\niselExpr64 expr\n   = pprPanic \"iselExpr64(i386)\" (ppr expr)\n\n\n--------------------------------------------------------------------------------\ngetRegister :: CmmExpr -> NatM Register\ngetRegister e = do dflags <- getDynFlags\n                   is32Bit <- is32BitPlatform\n                   getRegister' dflags is32Bit e\n\ngetRegister' :: DynFlags -> Bool -> CmmExpr -> NatM Register\n\ngetRegister' dflags is32Bit (CmmReg reg)\n  = case reg of\n        CmmGlobal PicBaseReg\n         | is32Bit ->\n            -- on x86_64, we have %rip for PicBaseReg, but it's not\n            -- a full-featured register, it can only be used for\n            -- rip-relative addressing.\n            do reg' <- getPicBaseNat (archWordFormat is32Bit)\n               return (Fixed (archWordFormat is32Bit) reg' nilOL)\n        _ ->\n            do use_sse2 <- sse2Enabled\n               let\n                 fmt = cmmTypeFormat (cmmRegType dflags reg)\n                 format | not use_sse2 && isFloatFormat fmt = FF80\n                        | otherwise                         = fmt\n               --\n               let platform = targetPlatform dflags\n               return (Fixed format\n                             (getRegisterReg platform use_sse2 reg)\n                             nilOL)\n\n\ngetRegister' dflags is32Bit (CmmRegOff r n)\n  = getRegister' dflags is32Bit $ mangleIndexTree dflags r n\n\ngetRegister' dflags is32Bit (CmmMachOp (MO_AlignmentCheck align _) [e])\n  = addAlignmentCheck align <$> getRegister' dflags is32Bit e\n\n-- for 32-bit architectuers, support some 64 -> 32 bit conversions:\n-- TO_W_(x), TO_W_(x >> 32)\n\ngetRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32)\n                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])\n | is32Bit = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 (getHiVRegFromLo rlo) code\n\ngetRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32)\n                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])\n | is32Bit = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 (getHiVRegFromLo rlo) code\n\ngetRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32) [x])\n | is32Bit = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 rlo code\n\ngetRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x])\n | is32Bit = do\n  ChildCode64 code rlo <- iselExpr64 x\n  return $ Fixed II32 rlo code\n\ngetRegister' _ _ (CmmLit lit@(CmmFloat f w)) =\n  if_sse2 float_const_sse2 float_const_x87\n where\n  float_const_sse2\n    | f == 0.0 = do\n      let\n          format = floatFormat w\n          code dst = unitOL  (XOR format (OpReg dst) (OpReg dst))\n        -- I don't know why there are xorpd, xorps, and pxor instructions.\n        -- They all appear to do the same thing --SDM\n      return (Any format code)\n\n   | otherwise = do\n      Amode addr code <- memConstant (widthInBytes w) lit\n      loadFloatAmode True w addr code\n\n  float_const_x87 = case w of\n    W64\n      | f == 0.0 ->\n        let code dst = unitOL (GLDZ dst)\n        in  return (Any FF80 code)\n\n      | f == 1.0 ->\n        let code dst = unitOL (GLD1 dst)\n        in  return (Any FF80 code)\n\n    _otherwise -> do\n      Amode addr code <- memConstant (widthInBytes w) lit\n      loadFloatAmode False w addr code\n\n-- catch simple cases of zero- or sign-extended load\ngetRegister' _ _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad addr _]) = do\n  code <- intLoadCode (MOVZxL II8) addr\n  return (Any II32 code)\n\ngetRegister' _ _ (CmmMachOp (MO_SS_Conv W8 W32) [CmmLoad addr _]) = do\n  code <- intLoadCode (MOVSxL II8) addr\n  return (Any II32 code)\n\ngetRegister' _ _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad addr _]) = do\n  code <- intLoadCode (MOVZxL II16) addr\n  return (Any II32 code)\n\ngetRegister' _ _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad addr _]) = do\n  code <- intLoadCode (MOVSxL II16) addr\n  return (Any II32 code)\n\n-- catch simple cases of zero- or sign-extended load\ngetRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad addr _])\n | not is32Bit = do\n  code <- intLoadCode (MOVZxL II8) addr\n  return (Any II64 code)\n\ngetRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W8 W64) [CmmLoad addr _])\n | not is32Bit = do\n  code <- intLoadCode (MOVSxL II8) addr\n  return (Any II64 code)\n\ngetRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad addr _])\n | not is32Bit = do\n  code <- intLoadCode (MOVZxL II16) addr\n  return (Any II64 code)\n\ngetRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad addr _])\n | not is32Bit = do\n  code <- intLoadCode (MOVSxL II16) addr\n  return (Any II64 code)\n\ngetRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad addr _])\n | not is32Bit = do\n  code <- intLoadCode (MOV II32) addr -- 32-bit loads zero-extend\n  return (Any II64 code)\n\ngetRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad addr _])\n | not is32Bit = do\n  code <- intLoadCode (MOVSxL II32) addr\n  return (Any II64 code)\n\ngetRegister' _ is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),\n                                     CmmLit displacement])\n | not is32Bit = do\n      return $ Any II64 (\\dst -> unitOL $\n        LEA II64 (OpAddr (ripRel (litToImm displacement))) (OpReg dst))\n\ngetRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps\n    sse2 <- sse2Enabled\n    case mop of\n      MO_F_Neg w\n         | sse2      -> sse2NegCode w x\n         | otherwise -> trivialUFCode FF80 (GNEG FF80) x\n\n      MO_S_Neg w -> triv_ucode NEGI (intFormat w)\n      MO_Not w   -> triv_ucode NOT  (intFormat w)\n\n      -- Nop conversions\n      MO_UU_Conv W32 W8  -> toI8Reg  W32 x\n      MO_SS_Conv W32 W8  -> toI8Reg  W32 x\n      MO_XX_Conv W32 W8  -> toI8Reg  W32 x\n      MO_UU_Conv W16 W8  -> toI8Reg  W16 x\n      MO_SS_Conv W16 W8  -> toI8Reg  W16 x\n      MO_XX_Conv W16 W8  -> toI8Reg  W16 x\n      MO_UU_Conv W32 W16 -> toI16Reg W32 x\n      MO_SS_Conv W32 W16 -> toI16Reg W32 x\n      MO_XX_Conv W32 W16 -> toI16Reg W32 x\n\n      MO_UU_Conv W64 W32 | not is32Bit -> conversionNop II64 x\n      MO_SS_Conv W64 W32 | not is32Bit -> conversionNop II64 x\n      MO_XX_Conv W64 W32 | not is32Bit -> conversionNop II64 x\n      MO_UU_Conv W64 W16 | not is32Bit -> toI16Reg W64 x\n      MO_SS_Conv W64 W16 | not is32Bit -> toI16Reg W64 x\n      MO_XX_Conv W64 W16 | not is32Bit -> toI16Reg W64 x\n      MO_UU_Conv W64 W8  | not is32Bit -> toI8Reg  W64 x\n      MO_SS_Conv W64 W8  | not is32Bit -> toI8Reg  W64 x\n      MO_XX_Conv W64 W8  | not is32Bit -> toI8Reg  W64 x\n\n      MO_UU_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x\n      MO_SS_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x\n      MO_XX_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x\n\n      -- widenings\n      MO_UU_Conv W8  W32 -> integerExtend W8  W32 MOVZxL x\n      MO_UU_Conv W16 W32 -> integerExtend W16 W32 MOVZxL x\n      MO_UU_Conv W8  W16 -> integerExtend W8  W16 MOVZxL x\n\n      MO_SS_Conv W8  W32 -> integerExtend W8  W32 MOVSxL x\n      MO_SS_Conv W16 W32 -> integerExtend W16 W32 MOVSxL x\n      MO_SS_Conv W8  W16 -> integerExtend W8  W16 MOVSxL x\n\n      -- We don't care about the upper bits for MO_XX_Conv, so MOV is enough. However, on 32-bit we\n      -- have 8-bit registers only for a few registers (as opposed to x86-64 where every register\n      -- has 8-bit version). So for 32-bit code, we'll just zero-extend.\n      MO_XX_Conv W8  W32\n          | is32Bit   -> integerExtend W8 W32 MOVZxL x\n          | otherwise -> integerExtend W8 W32 MOV x\n      MO_XX_Conv W8  W16\n          | is32Bit   -> integerExtend W8 W16 MOVZxL x\n          | otherwise -> integerExtend W8 W16 MOV x\n      MO_XX_Conv W16 W32 -> integerExtend W16 W32 MOV x\n\n      MO_UU_Conv W8  W64 | not is32Bit -> integerExtend W8  W64 MOVZxL x\n      MO_UU_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOVZxL x\n      MO_UU_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOVZxL x\n      MO_SS_Conv W8  W64 | not is32Bit -> integerExtend W8  W64 MOVSxL x\n      MO_SS_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOVSxL x\n      MO_SS_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOVSxL x\n      -- For 32-to-64 bit zero extension, amd64 uses an ordinary movl.\n      -- However, we don't want the register allocator to throw it\n      -- away as an unnecessary reg-to-reg move, so we keep it in\n      -- the form of a movzl and print it as a movl later.\n      -- This doesn't apply to MO_XX_Conv since in this case we don't care about\n      -- the upper bits. So we can just use MOV.\n      MO_XX_Conv W8  W64 | not is32Bit -> integerExtend W8  W64 MOV x\n      MO_XX_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOV x\n      MO_XX_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOV x\n\n      MO_FF_Conv W32 W64\n        | sse2      -> coerceFP2FP W64 x\n        | otherwise -> conversionNop FF80 x\n\n      MO_FF_Conv W64 W32 -> coerceFP2FP W32 x\n\n      MO_FS_Conv from to -> coerceFP2Int from to x\n      MO_SF_Conv from to -> coerceInt2FP from to x\n\n      MO_V_Insert {}   -> needLlvm\n      MO_V_Extract {}  -> needLlvm\n      MO_V_Add {}      -> needLlvm\n      MO_V_Sub {}      -> needLlvm\n      MO_V_Mul {}      -> needLlvm\n      MO_VS_Quot {}    -> needLlvm\n      MO_VS_Rem {}     -> needLlvm\n      MO_VS_Neg {}     -> needLlvm\n      MO_VU_Quot {}    -> needLlvm\n      MO_VU_Rem {}     -> needLlvm\n      MO_VF_Insert {}  -> needLlvm\n      MO_VF_Extract {} -> needLlvm\n      MO_VF_Add {}     -> needLlvm\n      MO_VF_Sub {}     -> needLlvm\n      MO_VF_Mul {}     -> needLlvm\n      MO_VF_Quot {}    -> needLlvm\n      MO_VF_Neg {}     -> needLlvm\n\n      _other -> pprPanic \"getRegister\" (pprMachOp mop)\n   where\n        triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register\n        triv_ucode instr format = trivialUCode format (instr format) x\n\n        -- signed or unsigned extension.\n        integerExtend :: Width -> Width\n                      -> (Format -> Operand -> Operand -> Instr)\n                      -> CmmExpr -> NatM Register\n        integerExtend from to instr expr = do\n            (reg,e_code) <- if from == W8 then getByteReg expr\n                                          else getSomeReg expr\n            let\n                code dst =\n                  e_code `snocOL`\n                  instr (intFormat from) (OpReg reg) (OpReg dst)\n            return (Any (intFormat to) code)\n\n        toI8Reg :: Width -> CmmExpr -> NatM Register\n        toI8Reg new_rep expr\n            = do codefn <- getAnyReg expr\n                 return (Any (intFormat new_rep) codefn)\n                -- HACK: use getAnyReg to get a byte-addressable register.\n                -- If the source was a Fixed register, this will add the\n                -- mov instruction to put it into the desired destination.\n                -- We're assuming that the destination won't be a fixed\n                -- non-byte-addressable register; it won't be, because all\n                -- fixed registers are word-sized.\n\n        toI16Reg = toI8Reg -- for now\n\n        conversionNop :: Format -> CmmExpr -> NatM Register\n        conversionNop new_format expr\n            = do e_code <- getRegister' dflags is32Bit expr\n                 return (swizzleRegisterRep e_code new_format)\n\n\ngetRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps\n  sse2 <- sse2Enabled\n  case mop of\n      MO_F_Eq _ -> condFltReg is32Bit EQQ x y\n      MO_F_Ne _ -> condFltReg is32Bit NE  x y\n      MO_F_Gt _ -> condFltReg is32Bit GTT x y\n      MO_F_Ge _ -> condFltReg is32Bit GE  x y\n      -- Invert comparison condition and swap operands\n      -- See Note [SSE Parity Checks]\n      MO_F_Lt _ -> condFltReg is32Bit GTT  y x\n      MO_F_Le _ -> condFltReg is32Bit GE   y x\n\n      MO_Eq _   -> condIntReg EQQ x y\n      MO_Ne _   -> condIntReg NE  x y\n\n      MO_S_Gt _ -> condIntReg GTT x y\n      MO_S_Ge _ -> condIntReg GE  x y\n      MO_S_Lt _ -> condIntReg LTT x y\n      MO_S_Le _ -> condIntReg LE  x y\n\n      MO_U_Gt _ -> condIntReg GU  x y\n      MO_U_Ge _ -> condIntReg GEU x y\n      MO_U_Lt _ -> condIntReg LU  x y\n      MO_U_Le _ -> condIntReg LEU x y\n\n      MO_F_Add w  | sse2      -> trivialFCode_sse2 w ADD  x y\n                  | otherwise -> trivialFCode_x87    GADD x y\n      MO_F_Sub w  | sse2      -> trivialFCode_sse2 w SUB  x y\n                  | otherwise -> trivialFCode_x87    GSUB x y\n      MO_F_Quot w | sse2      -> trivialFCode_sse2 w FDIV x y\n                  | otherwise -> trivialFCode_x87    GDIV x y\n      MO_F_Mul w  | sse2      -> trivialFCode_sse2 w MUL x y\n                  | otherwise -> trivialFCode_x87    GMUL x y\n\n      MO_Add rep -> add_code rep x y\n      MO_Sub rep -> sub_code rep x y\n\n      MO_S_Quot rep -> div_code rep True  True  x y\n      MO_S_Rem  rep -> div_code rep True  False x y\n      MO_U_Quot rep -> div_code rep False True  x y\n      MO_U_Rem  rep -> div_code rep False False x y\n\n      MO_S_MulMayOflo rep -> imulMayOflo rep x y\n\n      MO_Mul W8  -> imulW8 x y\n      MO_Mul rep -> triv_op rep IMUL\n      MO_And rep -> triv_op rep AND\n      MO_Or  rep -> triv_op rep OR\n      MO_Xor rep -> triv_op rep XOR\n\n        {- Shift ops on x86s have constraints on their source, it\n           either has to be Imm, CL or 1\n            => trivialCode is not restrictive enough (sigh.)\n        -}\n      MO_Shl rep   -> shift_code rep SHL x y {-False-}\n      MO_U_Shr rep -> shift_code rep SHR x y {-False-}\n      MO_S_Shr rep -> shift_code rep SAR x y {-False-}\n\n      MO_V_Insert {}   -> needLlvm\n      MO_V_Extract {}  -> needLlvm\n      MO_V_Add {}      -> needLlvm\n      MO_V_Sub {}      -> needLlvm\n      MO_V_Mul {}      -> needLlvm\n      MO_VS_Quot {}    -> needLlvm\n      MO_VS_Rem {}     -> needLlvm\n      MO_VS_Neg {}     -> needLlvm\n      MO_VF_Insert {}  -> needLlvm\n      MO_VF_Extract {} -> needLlvm\n      MO_VF_Add {}     -> needLlvm\n      MO_VF_Sub {}     -> needLlvm\n      MO_VF_Mul {}     -> needLlvm\n      MO_VF_Quot {}    -> needLlvm\n      MO_VF_Neg {}     -> needLlvm\n\n      _other -> pprPanic \"getRegister(x86) - binary CmmMachOp (1)\" (pprMachOp mop)\n  where\n    --------------------\n    triv_op width instr = trivialCode width op (Just op) x y\n                        where op   = instr (intFormat width)\n\n    -- Special case for IMUL for bytes, since the result of IMULB will be in\n    -- %ax, the split to %dx/%edx/%rdx and %ax/%eax/%rax happens only for wider\n    -- values.\n    imulW8 :: CmmExpr -> CmmExpr -> NatM Register\n    imulW8 arg_a arg_b = do\n        (a_reg, a_code) <- getNonClobberedReg arg_a\n        b_code <- getAnyReg arg_b\n\n        let code = a_code `appOL` b_code eax `appOL`\n                   toOL [ IMUL2 format (OpReg a_reg) ]\n            format = intFormat W8\n\n        return (Fixed format eax code)\n\n\n    imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register\n    imulMayOflo rep a b = do\n         (a_reg, a_code) <- getNonClobberedReg a\n         b_code <- getAnyReg b\n         let\n             shift_amt  = case rep of\n                           W32 -> 31\n                           W64 -> 63\n                           _ -> panic \"shift_amt\"\n\n             format = intFormat rep\n             code = a_code `appOL` b_code eax `appOL`\n                        toOL [\n                           IMUL2 format (OpReg a_reg),   -- result in %edx:%eax\n                           SAR format (OpImm (ImmInt shift_amt)) (OpReg eax),\n                                -- sign extend lower part\n                           SUB format (OpReg edx) (OpReg eax)\n                                -- compare against upper\n                           -- eax==0 if high part == sign extended low part\n                        ]\n         return (Fixed format eax code)\n\n    --------------------\n    shift_code :: Width\n               -> (Format -> Operand -> Operand -> Instr)\n               -> CmmExpr\n               -> CmmExpr\n               -> NatM Register\n\n    {- Case1: shift length as immediate -}\n    shift_code width instr x (CmmLit lit) = do\n          x_code <- getAnyReg x\n          let\n               format = intFormat width\n               code dst\n                  = x_code dst `snocOL`\n                    instr format (OpImm (litToImm lit)) (OpReg dst)\n          return (Any format code)\n\n    {- Case2: shift length is complex (non-immediate)\n      * y must go in %ecx.\n      * we cannot do y first *and* put its result in %ecx, because\n        %ecx might be clobbered by x.\n      * if we do y second, then x cannot be\n        in a clobbered reg.  Also, we cannot clobber x's reg\n        with the instruction itself.\n      * so we can either:\n        - do y first, put its result in a fresh tmp, then copy it to %ecx later\n        - do y second and put its result into %ecx.  x gets placed in a fresh\n          tmp.  This is likely to be better, because the reg alloc can\n          eliminate this reg->reg move here (it won't eliminate the other one,\n          because the move is into the fixed %ecx).\n    -}\n    shift_code width instr x y{-amount-} = do\n        x_code <- getAnyReg x\n        let format = intFormat width\n        tmp <- getNewRegNat format\n        y_code <- getAnyReg y\n        let\n           code = x_code tmp `appOL`\n                  y_code ecx `snocOL`\n                  instr format (OpReg ecx) (OpReg tmp)\n        return (Fixed format tmp code)\n\n    --------------------\n    add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register\n    add_code rep x (CmmLit (CmmInt y _))\n        | is32BitInteger y = add_int rep x y\n    add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y\n      where format = intFormat rep\n    -- TODO: There are other interesting patterns we want to replace\n    --     with a LEA, e.g. `(x + offset) + (y << shift)`.\n\n    --------------------\n    sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register\n    sub_code rep x (CmmLit (CmmInt y _))\n        | is32BitInteger (-y) = add_int rep x (-y)\n    sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y\n\n    -- our three-operand add instruction:\n    add_int width x y = do\n        (x_reg, x_code) <- getSomeReg x\n        let\n            format = intFormat width\n            imm = ImmInt (fromInteger y)\n            code dst\n               = x_code `snocOL`\n                 LEA format\n                        (OpAddr (AddrBaseIndex (EABaseReg x_reg) EAIndexNone imm))\n                        (OpReg dst)\n        --\n        return (Any format code)\n\n    ----------------------\n\n    -- See Note [DIV/IDIV for bytes]\n    div_code W8 signed quotient x y = do\n        let widen | signed    = MO_SS_Conv W8 W16\n                  | otherwise = MO_UU_Conv W8 W16\n        div_code\n            W16\n            signed\n            quotient\n            (CmmMachOp widen [x])\n            (CmmMachOp widen [y])\n\n    div_code width signed quotient x y = do\n           (y_op, y_code) <- getRegOrMem y -- cannot be clobbered\n           x_code <- getAnyReg x\n           let\n             format = intFormat width\n             widen | signed    = CLTD format\n                   | otherwise = XOR format (OpReg edx) (OpReg edx)\n\n             instr | signed    = IDIV\n                   | otherwise = DIV\n\n             code = y_code `appOL`\n                    x_code eax `appOL`\n                    toOL [widen, instr format y_op]\n\n             result | quotient  = eax\n                    | otherwise = edx\n\n           return (Fixed format result code)\n\n\ngetRegister' _ _ (CmmLoad mem pk)\n  | isFloatType pk\n  = do\n    Amode addr mem_code <- getAmode mem\n    use_sse2 <- sse2Enabled\n    loadFloatAmode use_sse2 (typeWidth pk) addr mem_code\n\ngetRegister' _ is32Bit (CmmLoad mem pk)\n  | is32Bit && not (isWord64 pk)\n  = do\n    code <- intLoadCode instr mem\n    return (Any format code)\n  where\n    width = typeWidth pk\n    format = intFormat width\n    instr = case width of\n                W8     -> MOVZxL II8\n                _other -> MOV format\n        -- We always zero-extend 8-bit loads, if we\n        -- can't think of anything better.  This is because\n        -- we can't guarantee access to an 8-bit variant of every register\n        -- (esi and edi don't have 8-bit variants), so to make things\n        -- simpler we do our 8-bit arithmetic with full 32-bit registers.\n\n-- Simpler memory load code on x86_64\ngetRegister' _ is32Bit (CmmLoad mem pk)\n | not is32Bit\n  = do\n    code <- intLoadCode (MOV format) mem\n    return (Any format code)\n  where format = intFormat $ typeWidth pk\n\ngetRegister' _ is32Bit (CmmLit (CmmInt 0 width))\n  = let\n        format = intFormat width\n\n        -- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits\n        format1 = if is32Bit then format\n                           else case format of\n                                II64 -> II32\n                                _ -> format\n        code dst\n           = unitOL (XOR format1 (OpReg dst) (OpReg dst))\n    in\n        return (Any format code)\n\n  -- optimisation for loading small literals on x86_64: take advantage\n  -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit\n  -- instruction forms are shorter.\ngetRegister' dflags is32Bit (CmmLit lit)\n  | not is32Bit, isWord64 (cmmLitType dflags lit), not (isBigLit lit)\n  = let\n        imm = litToImm lit\n        code dst = unitOL (MOV II32 (OpImm imm) (OpReg dst))\n    in\n        return (Any II64 code)\n  where\n   isBigLit (CmmInt i _) = i < 0 || i > 0xffffffff\n   isBigLit _ = False\n        -- note1: not the same as (not.is32BitLit), because that checks for\n        -- signed literals that fit in 32 bits, but we want unsigned\n        -- literals here.\n        -- note2: all labels are small, because we're assuming the\n        -- small memory model (see gcc docs, -mcmodel=small).\n\ngetRegister' dflags _ (CmmLit lit)\n  = do let format = cmmTypeFormat (cmmLitType dflags lit)\n           imm = litToImm lit\n           code dst = unitOL (MOV format (OpImm imm) (OpReg dst))\n       return (Any format code)\n\ngetRegister' _ _ other\n    | isVecExpr other  = needLlvm\n    | otherwise        = pprPanic \"getRegister(x86)\" (ppr other)\n\n\nintLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr\n   -> NatM (Reg -> InstrBlock)\nintLoadCode instr mem = do\n  Amode src mem_code <- getAmode mem\n  return (\\dst -> mem_code `snocOL` instr (OpAddr src) (OpReg dst))\n\n-- Compute an expression into *any* register, adding the appropriate\n-- move instruction if necessary.\ngetAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)\ngetAnyReg expr = do\n  r <- getRegister expr\n  anyReg r\n\nanyReg :: Register -> NatM (Reg -> InstrBlock)\nanyReg (Any _ code)          = return code\nanyReg (Fixed rep reg fcode) = return (\\dst -> fcode `snocOL` reg2reg rep reg dst)\n\n-- A bit like getSomeReg, but we want a reg that can be byte-addressed.\n-- Fixed registers might not be byte-addressable, so we make sure we've\n-- got a temporary, inserting an extra reg copy if necessary.\ngetByteReg :: CmmExpr -> NatM (Reg, InstrBlock)\ngetByteReg expr = do\n  is32Bit <- is32BitPlatform\n  if is32Bit\n      then do r <- getRegister expr\n              case r of\n                Any rep code -> do\n                    tmp <- getNewRegNat rep\n                    return (tmp, code tmp)\n                Fixed rep reg code\n                    | isVirtualReg reg -> return (reg,code)\n                    | otherwise -> do\n                        tmp <- getNewRegNat rep\n                        return (tmp, code `snocOL` reg2reg rep reg tmp)\n                    -- ToDo: could optimise slightly by checking for\n                    -- byte-addressable real registers, but that will\n                    -- happen very rarely if at all.\n      else getSomeReg expr -- all regs are byte-addressable on x86_64\n\n-- Another variant: this time we want the result in a register that cannot\n-- be modified by code to evaluate an arbitrary expression.\ngetNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)\ngetNonClobberedReg expr = do\n  dflags <- getDynFlags\n  r <- getRegister expr\n  case r of\n    Any rep code -> do\n        tmp <- getNewRegNat rep\n        return (tmp, code tmp)\n    Fixed rep reg code\n        -- only certain regs can be clobbered\n        | reg `elem` instrClobberedRegs (targetPlatform dflags)\n        -> do\n                tmp <- getNewRegNat rep\n                return (tmp, code `snocOL` reg2reg rep reg tmp)\n        | otherwise ->\n                return (reg, code)\n\nreg2reg :: Format -> Reg -> Reg -> Instr\nreg2reg format src dst\n  | format == FF80 = GMOV src dst\n  | otherwise    = MOV format (OpReg src) (OpReg dst)\n\n\n--------------------------------------------------------------------------------\ngetAmode :: CmmExpr -> NatM Amode\ngetAmode e = do is32Bit <- is32BitPlatform\n                getAmode' is32Bit e\n\ngetAmode' :: Bool -> CmmExpr -> NatM Amode\ngetAmode' _ (CmmRegOff r n) = do dflags <- getDynFlags\n                                 getAmode $ mangleIndexTree dflags r n\n\ngetAmode' is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),\n                                                  CmmLit displacement])\n | not is32Bit\n    = return $ Amode (ripRel (litToImm displacement)) nilOL\n\n\n-- This is all just ridiculous, since it carefully undoes\n-- what mangleIndexTree has just done.\ngetAmode' is32Bit (CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)])\n  | is32BitLit is32Bit lit\n  -- ASSERT(rep == II32)???\n  = do (x_reg, x_code) <- getSomeReg x\n       let off = ImmInt (-(fromInteger i))\n       return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)\n\ngetAmode' is32Bit (CmmMachOp (MO_Add _rep) [x, CmmLit lit])\n  | is32BitLit is32Bit lit\n  -- ASSERT(rep == II32)???\n  = do (x_reg, x_code) <- getSomeReg x\n       let off = litToImm lit\n       return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)\n\n-- Turn (lit1 << n  + lit2) into  (lit2 + lit1 << n) so it will be\n-- recognised by the next rule.\ngetAmode' is32Bit (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),\n                                  b@(CmmLit _)])\n  = getAmode' is32Bit (CmmMachOp (MO_Add rep) [b,a])\n\n-- Matches: (x + offset) + (y << shift)\ngetAmode' _ (CmmMachOp (MO_Add _) [CmmRegOff x offset,\n                                   CmmMachOp (MO_Shl _)\n                                        [y, CmmLit (CmmInt shift _)]])\n  | shift == 0 || shift == 1 || shift == 2 || shift == 3\n  = x86_complex_amode (CmmReg x) y shift (fromIntegral offset)\n\ngetAmode' _ (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _)\n                                        [y, CmmLit (CmmInt shift _)]])\n  | shift == 0 || shift == 1 || shift == 2 || shift == 3\n  = x86_complex_amode x y shift 0\n\ngetAmode' _ (CmmMachOp (MO_Add _)\n                [x, CmmMachOp (MO_Add _)\n                        [CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)],\n                         CmmLit (CmmInt offset _)]])\n  | shift == 0 || shift == 1 || shift == 2 || shift == 3\n  && is32BitInteger offset\n  = x86_complex_amode x y shift offset\n\ngetAmode' _ (CmmMachOp (MO_Add _) [x,y])\n  = x86_complex_amode x y 0 0\n\ngetAmode' is32Bit (CmmLit lit) | is32BitLit is32Bit lit\n  = return (Amode (ImmAddr (litToImm lit) 0) nilOL)\n\ngetAmode' _ expr = do\n  (reg,code) <- getSomeReg expr\n  return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)\n\n-- | Like 'getAmode', but on 32-bit use simple register addressing\n-- (i.e. no index register). This stops us from running out of\n-- registers on x86 when using instructions such as cmpxchg, which can\n-- use up to three virtual registers and one fixed register.\ngetSimpleAmode :: DynFlags -> Bool -> CmmExpr -> NatM Amode\ngetSimpleAmode dflags is32Bit addr\n    | is32Bit = do\n        addr_code <- getAnyReg addr\n        addr_r <- getNewRegNat (intFormat (wordWidth dflags))\n        let amode = AddrBaseIndex (EABaseReg addr_r) EAIndexNone (ImmInt 0)\n        return $! Amode amode (addr_code addr_r)\n    | otherwise = getAmode addr\n\nx86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode\nx86_complex_amode base index shift offset\n  = do (x_reg, x_code) <- getNonClobberedReg base\n        -- x must be in a temp, because it has to stay live over y_code\n        -- we could compre x_reg and y_reg and do something better here...\n       (y_reg, y_code) <- getSomeReg index\n       let\n           code = x_code `appOL` y_code\n           base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8;\n                                n -> panic $ \"x86_complex_amode: unhandled shift! (\" ++ show n ++ \")\"\n       return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset)))\n               code)\n\n\n\n\n-- -----------------------------------------------------------------------------\n-- getOperand: sometimes any operand will do.\n\n-- getNonClobberedOperand: the value of the operand will remain valid across\n-- the computation of an arbitrary expression, unless the expression\n-- is computed directly into a register which the operand refers to\n-- (see trivialCode where this function is used for an example).\n\ngetNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)\ngetNonClobberedOperand (CmmLit lit) = do\n  use_sse2 <- sse2Enabled\n  if use_sse2 && isSuitableFloatingPointLit lit\n    then do\n      let CmmFloat _ w = lit\n      Amode addr code <- memConstant (widthInBytes w) lit\n      return (OpAddr addr, code)\n     else do\n\n  is32Bit <- is32BitPlatform\n  dflags <- getDynFlags\n  if is32BitLit is32Bit lit && not (isFloatType (cmmLitType dflags lit))\n    then return (OpImm (litToImm lit), nilOL)\n    else getNonClobberedOperand_generic (CmmLit lit)\n\ngetNonClobberedOperand (CmmLoad mem pk) = do\n  is32Bit <- is32BitPlatform\n  use_sse2 <- sse2Enabled\n  if (not (isFloatType pk) || use_sse2)\n      && (if is32Bit then not (isWord64 pk) else True)\n    then do\n      dflags <- getDynFlags\n      let platform = targetPlatform dflags\n      Amode src mem_code <- getAmode mem\n      (src',save_code) <-\n        if (amodeCouldBeClobbered platform src)\n                then do\n                   tmp <- getNewRegNat (archWordFormat is32Bit)\n                   return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0),\n                           unitOL (LEA (archWordFormat is32Bit)\n                                       (OpAddr src)\n                                       (OpReg tmp)))\n                else\n                   return (src, nilOL)\n      return (OpAddr src', mem_code `appOL` save_code)\n    else do\n      getNonClobberedOperand_generic (CmmLoad mem pk)\n\ngetNonClobberedOperand e = getNonClobberedOperand_generic e\n\ngetNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)\ngetNonClobberedOperand_generic e = do\n    (reg, code) <- getNonClobberedReg e\n    return (OpReg reg, code)\n\namodeCouldBeClobbered :: Platform -> AddrMode -> Bool\namodeCouldBeClobbered platform amode = any (regClobbered platform) (addrModeRegs amode)\n\nregClobbered :: Platform -> Reg -> Bool\nregClobbered platform (RegReal (RealRegSingle rr)) = freeReg platform rr\nregClobbered _ _ = False\n\n-- getOperand: the operand is not required to remain valid across the\n-- computation of an arbitrary expression.\ngetOperand :: CmmExpr -> NatM (Operand, InstrBlock)\n\ngetOperand (CmmLit lit) = do\n  use_sse2 <- sse2Enabled\n  if (use_sse2 && isSuitableFloatingPointLit lit)\n    then do\n      let CmmFloat _ w = lit\n      Amode addr code <- memConstant (widthInBytes w) lit\n      return (OpAddr addr, code)\n    else do\n\n  is32Bit <- is32BitPlatform\n  dflags <- getDynFlags\n  if is32BitLit is32Bit lit && not (isFloatType (cmmLitType dflags lit))\n    then return (OpImm (litToImm lit), nilOL)\n    else getOperand_generic (CmmLit lit)\n\ngetOperand (CmmLoad mem pk) = do\n  is32Bit <- is32BitPlatform\n  use_sse2 <- sse2Enabled\n  if (not (isFloatType pk) || use_sse2) && (if is32Bit then not (isWord64 pk) else True)\n     then do\n       Amode src mem_code <- getAmode mem\n       return (OpAddr src, mem_code)\n     else\n       getOperand_generic (CmmLoad mem pk)\n\ngetOperand e = getOperand_generic e\n\ngetOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)\ngetOperand_generic e = do\n    (reg, code) <- getSomeReg e\n    return (OpReg reg, code)\n\nisOperand :: Bool -> CmmExpr -> Bool\nisOperand _ (CmmLoad _ _) = True\nisOperand is32Bit (CmmLit lit)  = is32BitLit is32Bit lit\n                          || isSuitableFloatingPointLit lit\nisOperand _ _            = False\n\n-- | Given a 'Register', produce a new 'Register' with an instruction block\n-- which will check the value for alignment. Used for @-falignment-sanitisation@.\naddAlignmentCheck :: Int -> Register -> Register\naddAlignmentCheck align reg =\n    case reg of\n      Fixed fmt reg code -> Fixed fmt reg (code `appOL` check fmt reg)\n      Any fmt f          -> Any fmt (\\reg -> f reg `appOL` check fmt reg)\n  where\n    check :: Format -> Reg -> InstrBlock\n    check fmt reg =\n        ASSERT(not $ isFloatFormat fmt)\n        toOL [ TEST fmt (OpImm $ ImmInt $ align-1) (OpReg reg)\n             , JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel\n             ]\n\nmemConstant :: Int -> CmmLit -> NatM Amode\nmemConstant align lit = do\n  lbl <- getNewLabelNat\n  let rosection = Section ReadOnlyData lbl\n  dflags <- getDynFlags\n  (addr, addr_code) <- if target32Bit (targetPlatform dflags)\n                       then do dynRef <- cmmMakeDynamicReference\n                                             dflags\n                                             DataReference\n                                             lbl\n                               Amode addr addr_code <- getAmode dynRef\n                               return (addr, addr_code)\n                       else return (ripRel (ImmCLbl lbl), nilOL)\n  let code =\n        LDATA rosection (align, Statics lbl [CmmStaticLit lit])\n        `consOL` addr_code\n  return (Amode addr code)\n\n\nloadFloatAmode :: Bool -> Width -> AddrMode -> InstrBlock -> NatM Register\nloadFloatAmode use_sse2 w addr addr_code = do\n  let format = floatFormat w\n      code dst = addr_code `snocOL`\n                 if use_sse2\n                    then MOV format (OpAddr addr) (OpReg dst)\n                    else GLD format addr dst\n  return (Any (if use_sse2 then format else FF80) code)\n\n\n-- if we want a floating-point literal as an operand, we can\n-- use it directly from memory.  However, if the literal is\n-- zero, we're better off generating it into a register using\n-- xor.\nisSuitableFloatingPointLit :: CmmLit -> Bool\nisSuitableFloatingPointLit (CmmFloat f _) = f /= 0.0\nisSuitableFloatingPointLit _ = False\n\ngetRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)\ngetRegOrMem e@(CmmLoad mem pk) = do\n  is32Bit <- is32BitPlatform\n  use_sse2 <- sse2Enabled\n  if (not (isFloatType pk) || use_sse2) && (if is32Bit then not (isWord64 pk) else True)\n     then do\n       Amode src mem_code <- getAmode mem\n       return (OpAddr src, mem_code)\n     else do\n       (reg, code) <- getNonClobberedReg e\n       return (OpReg reg, code)\ngetRegOrMem e = do\n    (reg, code) <- getNonClobberedReg e\n    return (OpReg reg, code)\n\nis32BitLit :: Bool -> CmmLit -> Bool\nis32BitLit is32Bit (CmmInt i W64)\n | not is32Bit\n    = -- assume that labels are in the range 0-2^31-1: this assumes the\n      -- small memory model (see gcc docs, -mcmodel=small).\n      is32BitInteger i\nis32BitLit _ _ = True\n\n\n\n\n-- Set up a condition code for a conditional branch.\n\ngetCondCode :: CmmExpr -> NatM CondCode\n\n-- yes, they really do seem to want exactly the same!\n\ngetCondCode (CmmMachOp mop [x, y])\n  =\n    case mop of\n      MO_F_Eq W32 -> condFltCode EQQ x y\n      MO_F_Ne W32 -> condFltCode NE  x y\n      MO_F_Gt W32 -> condFltCode GTT x y\n      MO_F_Ge W32 -> condFltCode GE  x y\n      -- Invert comparison condition and swap operands\n      -- See Note [SSE Parity Checks]\n      MO_F_Lt W32 -> condFltCode GTT  y x\n      MO_F_Le W32 -> condFltCode GE   y x\n\n      MO_F_Eq W64 -> condFltCode EQQ x y\n      MO_F_Ne W64 -> condFltCode NE  x y\n      MO_F_Gt W64 -> condFltCode GTT x y\n      MO_F_Ge W64 -> condFltCode GE  x y\n      MO_F_Lt W64 -> condFltCode GTT y x\n      MO_F_Le W64 -> condFltCode GE  y x\n\n      _ -> condIntCode (machOpToCond mop) x y\n\ngetCondCode other = pprPanic \"getCondCode(2)(x86,x86_64)\" (ppr other)\n\nmachOpToCond :: MachOp -> Cond\nmachOpToCond mo = case mo of\n  MO_Eq _   -> EQQ\n  MO_Ne _   -> NE\n  MO_S_Gt _ -> GTT\n  MO_S_Ge _ -> GE\n  MO_S_Lt _ -> LTT\n  MO_S_Le _ -> LE\n  MO_U_Gt _ -> GU\n  MO_U_Ge _ -> GEU\n  MO_U_Lt _ -> LU\n  MO_U_Le _ -> LEU\n  _other -> pprPanic \"machOpToCond\" (pprMachOp mo)\n\n\n-- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be\n-- passed back up the tree.\n\ncondIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode\ncondIntCode cond x y = do is32Bit <- is32BitPlatform\n                          condIntCode' is32Bit cond x y\n\ncondIntCode' :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode\n\n-- memory vs immediate\ncondIntCode' is32Bit cond (CmmLoad x pk) (CmmLit lit)\n | is32BitLit is32Bit lit = do\n    Amode x_addr x_code <- getAmode x\n    let\n        imm  = litToImm lit\n        code = x_code `snocOL`\n                  CMP (cmmTypeFormat pk) (OpImm imm) (OpAddr x_addr)\n    --\n    return (CondCode False cond code)\n\n-- anything vs zero, using a mask\n-- TODO: Add some sanity checking!!!!\ncondIntCode' is32Bit cond (CmmMachOp (MO_And _) [x,o2]) (CmmLit (CmmInt 0 pk))\n    | (CmmLit lit@(CmmInt mask _)) <- o2, is32BitLit is32Bit lit\n    = do\n      (x_reg, x_code) <- getSomeReg x\n      let\n         code = x_code `snocOL`\n                TEST (intFormat pk) (OpImm (ImmInteger mask)) (OpReg x_reg)\n      --\n      return (CondCode False cond code)\n\n-- anything vs zero\ncondIntCode' _ cond x (CmmLit (CmmInt 0 pk)) = do\n    (x_reg, x_code) <- getSomeReg x\n    let\n        code = x_code `snocOL`\n                  TEST (intFormat pk) (OpReg x_reg) (OpReg x_reg)\n    --\n    return (CondCode False cond code)\n\n-- anything vs operand\ncondIntCode' is32Bit cond x y\n | isOperand is32Bit y = do\n    dflags <- getDynFlags\n    (x_reg, x_code) <- getNonClobberedReg x\n    (y_op,  y_code) <- getOperand y\n    let\n        code = x_code `appOL` y_code `snocOL`\n                  CMP (cmmTypeFormat (cmmExprType dflags x)) y_op (OpReg x_reg)\n    return (CondCode False cond code)\n-- operand vs. anything: invert the comparison so that we can use a\n-- single comparison instruction.\n | isOperand is32Bit x\n , Just revcond <- maybeFlipCond cond = do\n    dflags <- getDynFlags\n    (y_reg, y_code) <- getNonClobberedReg y\n    (x_op,  x_code) <- getOperand x\n    let\n        code = y_code `appOL` x_code `snocOL`\n                  CMP (cmmTypeFormat (cmmExprType dflags x)) x_op (OpReg y_reg)\n    return (CondCode False revcond code)\n\n-- anything vs anything\ncondIntCode' _ cond x y = do\n  dflags <- getDynFlags\n  (y_reg, y_code) <- getNonClobberedReg y\n  (x_op, x_code) <- getRegOrMem x\n  let\n        code = y_code `appOL`\n               x_code `snocOL`\n                  CMP (cmmTypeFormat (cmmExprType dflags x)) (OpReg y_reg) x_op\n  return (CondCode False cond code)\n\n\n\n--------------------------------------------------------------------------------\ncondFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode\n\ncondFltCode cond x y\n  = if_sse2 condFltCode_sse2 condFltCode_x87\n  where\n\n  condFltCode_x87\n    = ASSERT(cond `elem` ([EQQ, NE, LE, LTT, GE, GTT])) do\n    (x_reg, x_code) <- getNonClobberedReg x\n    (y_reg, y_code) <- getSomeReg y\n    let\n        code = x_code `appOL` y_code `snocOL`\n                GCMP cond x_reg y_reg\n    -- The GCMP insn does the test and sets the zero flag if comparable\n    -- and true.  Hence we always supply EQQ as the condition to test.\n    return (CondCode True EQQ code)\n\n  -- in the SSE2 comparison ops (ucomiss, ucomisd) the left arg may be\n  -- an operand, but the right must be a reg.  We can probably do better\n  -- than this general case...\n  condFltCode_sse2 = do\n    dflags <- getDynFlags\n    (x_reg, x_code) <- getNonClobberedReg x\n    (y_op, y_code) <- getOperand y\n    let\n        code = x_code `appOL`\n               y_code `snocOL`\n                  CMP (floatFormat $ cmmExprWidth dflags x) y_op (OpReg x_reg)\n        -- NB(1): we need to use the unsigned comparison operators on the\n        -- result of this comparison.\n    return (CondCode True (condToUnsigned cond) code)\n\n-- -----------------------------------------------------------------------------\n-- Generating assignments\n\n-- Assignments are really at the heart of the whole code generation\n-- business.  Almost all top-level nodes of any real importance are\n-- assignments, which correspond to loads, stores, or register\n-- transfers.  If we're really lucky, some of the register transfers\n-- will go away, because we can use the destination register to\n-- complete the code generation for the right hand side.  This only\n-- fails when the right hand side is forced into a fixed register\n-- (e.g. the result of a call).\n\nassignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock\nassignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock\n\nassignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock\nassignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock\n\n\n-- integer assignment to memory\n\n-- specific case of adding/subtracting an integer to a particular address.\n-- ToDo: catch other cases where we can use an operation directly on a memory\n-- address.\nassignMem_IntCode pk addr (CmmMachOp op [CmmLoad addr2 _,\n                                                 CmmLit (CmmInt i _)])\n   | addr == addr2, pk /= II64 || is32BitInteger i,\n     Just instr <- check op\n   = do Amode amode code_addr <- getAmode addr\n        let code = code_addr `snocOL`\n                   instr pk (OpImm (ImmInt (fromIntegral i))) (OpAddr amode)\n        return code\n   where\n        check (MO_Add _) = Just ADD\n        check (MO_Sub _) = Just SUB\n        check _ = Nothing\n        -- ToDo: more?\n\n-- general case\nassignMem_IntCode pk addr src = do\n    is32Bit <- is32BitPlatform\n    Amode addr code_addr <- getAmode addr\n    (code_src, op_src)   <- get_op_RI is32Bit src\n    let\n        code = code_src `appOL`\n               code_addr `snocOL`\n                  MOV pk op_src (OpAddr addr)\n        -- NOTE: op_src is stable, so it will still be valid\n        -- after code_addr.  This may involve the introduction\n        -- of an extra MOV to a temporary register, but we hope\n        -- the register allocator will get rid of it.\n    --\n    return code\n  where\n    get_op_RI :: Bool -> CmmExpr -> NatM (InstrBlock,Operand)   -- code, operator\n    get_op_RI is32Bit (CmmLit lit) | is32BitLit is32Bit lit\n      = return (nilOL, OpImm (litToImm lit))\n    get_op_RI _ op\n      = do (reg,code) <- getNonClobberedReg op\n           return (code, OpReg reg)\n\n\n-- Assign; dst is a reg, rhs is mem\nassignReg_IntCode pk reg (CmmLoad src _) = do\n  load_code <- intLoadCode (MOV pk) src\n  dflags <- getDynFlags\n  let platform = targetPlatform dflags\n  return (load_code (getRegisterReg platform False{-no sse2-} reg))\n\n-- dst is a reg, but src could be anything\nassignReg_IntCode _ reg src = do\n  dflags <- getDynFlags\n  let platform = targetPlatform dflags\n  code <- getAnyReg src\n  return (code (getRegisterReg platform False{-no sse2-} reg))\n\n\n-- Floating point assignment to memory\nassignMem_FltCode pk addr src = do\n  (src_reg, src_code) <- getNonClobberedReg src\n  Amode addr addr_code <- getAmode addr\n  use_sse2 <- sse2Enabled\n  let\n        code = src_code `appOL`\n               addr_code `snocOL`\n                if use_sse2 then MOV pk (OpReg src_reg) (OpAddr addr)\n                            else GST pk src_reg addr\n  return code\n\n-- Floating point assignment to a register/temporary\nassignReg_FltCode _ reg src = do\n  use_sse2 <- sse2Enabled\n  src_code <- getAnyReg src\n  dflags <- getDynFlags\n  let platform = targetPlatform dflags\n  return (src_code (getRegisterReg platform use_sse2 reg))\n\n\ngenJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock\n\ngenJump (CmmLoad mem _) regs = do\n  Amode target code <- getAmode mem\n  return (code `snocOL` JMP (OpAddr target) regs)\n\ngenJump (CmmLit lit) regs = do\n  return (unitOL (JMP (OpImm (litToImm lit)) regs))\n\ngenJump expr regs = do\n  (reg,code) <- getSomeReg expr\n  return (code `snocOL` JMP (OpReg reg) regs)\n\n\n-- -----------------------------------------------------------------------------\n--  Unconditional branches\n\ngenBranch :: BlockId -> InstrBlock\ngenBranch = toOL . mkJumpInstr\n\n\n\n-- -----------------------------------------------------------------------------\n--  Conditional jumps/branches\n\n{-\nConditional jumps are always to local labels, so we can use branch\ninstructions.  We peek at the arguments to decide what kind of\ncomparison to do.\n\nI386: First, we have to ensure that the condition\ncodes are set according to the supplied comparison operation.\n-}\n\n\ngenCondBranch\n    :: BlockId      -- the source of the jump\n    -> BlockId      -- the true branch target\n    -> BlockId      -- the false branch target\n    -> CmmExpr      -- the condition on which to branch\n    -> NatM InstrBlock -- Instructions\n\ngenCondBranch bid id false expr = do\n  is32Bit <- is32BitPlatform\n  genCondBranch' is32Bit bid id false expr\n\n-- | We return the instructions generated.\ngenCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr\n               -> NatM InstrBlock\n\n-- 64-bit integer comparisons on 32-bit\ngenCondBranch' is32Bit _bid true false (CmmMachOp mop [e1,e2])\n  | is32Bit, Just W64 <- maybeIntComparison mop = do\n  ChildCode64 code1 r1_lo <- iselExpr64 e1\n  ChildCode64 code2 r2_lo <- iselExpr64 e2\n  let r1_hi = getHiVRegFromLo r1_lo\n      r2_hi = getHiVRegFromLo r2_lo\n      cond = machOpToCond mop\n      Just cond' = maybeFlipCond cond\n  --TODO: Update CFG for x86\n  let code = code1 `appOL` code2 `appOL` toOL [\n        CMP II32 (OpReg r2_hi) (OpReg r1_hi),\n        JXX cond true,\n        JXX cond' false,\n        CMP II32 (OpReg r2_lo) (OpReg r1_lo),\n        JXX cond true] `appOL` genBranch false\n  return code\n\ngenCondBranch' _ bid id false bool = do\n  CondCode is_float cond cond_code <- getCondCode bool\n  use_sse2 <- sse2Enabled\n  if not is_float || not use_sse2\n    then\n        return (cond_code `snocOL` JXX cond id `appOL` genBranch false)\n    else do\n        -- See Note [SSE Parity Checks]\n        let jmpFalse = genBranch false\n            code\n                = case cond of\n                  NE  -> or_unordered\n                  GU  -> plain_test\n                  GEU -> plain_test\n                  -- Use ASSERT so we don't break releases if\n                  -- LTT/LE creep in somehow.\n                  LTT ->\n                    ASSERT2(False, ppr \"Should have been turned into >\")\n                    and_ordered\n                  LE  ->\n                    ASSERT2(False, ppr \"Should have been turned into >=\")\n                    and_ordered\n                  _   -> and_ordered\n\n            plain_test = unitOL (\n                  JXX cond id\n                ) `appOL` jmpFalse\n            or_unordered = toOL [\n                  JXX cond id,\n                  JXX PARITY id\n                ] `appOL` jmpFalse\n            and_ordered = toOL [\n                  JXX PARITY false,\n                  JXX cond id,\n                  JXX ALWAYS false\n                ]\n        updateCfgNat (\\cfg -> adjustEdgeWeight cfg (+3) bid false)\n        return (cond_code `appOL` code)\n\n-- -----------------------------------------------------------------------------\n--  Generating C calls\n\n-- Now the biggest nightmare---calls.  Most of the nastiness is buried in\n-- @get_arg@, which moves the arguments to the correct registers/stack\n-- locations.  Apart from that, the code is easy.\n--\n-- (If applicable) Do not fill the delay slots here; you will confuse the\n-- register allocator.\n\ngenCCall\n    :: DynFlags\n    -> Bool                     -- 32 bit platform?\n    -> ForeignTarget            -- function to call\n    -> [CmmFormal]        -- where to put the result\n    -> [CmmActual]        -- arguments (of mixed type)\n    -> BlockId      -- The block we are in\n    -> NatM InstrBlock\n\n-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -\n\n-- Unroll memcpy calls if the source and destination pointers are at\n-- least DWORD aligned and the number of bytes to copy isn't too\n-- large.  Otherwise, call C's memcpy.\ngenCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _\n         [dst, src, CmmLit (CmmInt n _)] _\n    | fromInteger insns <= maxInlineMemcpyInsns dflags && align .&. 3 == 0 = do\n        code_dst <- getAnyReg dst\n        dst_r <- getNewRegNat format\n        code_src <- getAnyReg src\n        src_r <- getNewRegNat format\n        tmp_r <- getNewRegNat format\n        return $ code_dst dst_r `appOL` code_src src_r `appOL`\n            go dst_r src_r tmp_r (fromInteger n)\n  where\n    -- The number of instructions we will generate (approx). We need 2\n    -- instructions per move.\n    insns = 2 * ((n + sizeBytes - 1) `div` sizeBytes)\n\n    format = if align .&. 4 /= 0 then II32 else (archWordFormat is32Bit)\n\n    -- The size of each move, in bytes.\n    sizeBytes :: Integer\n    sizeBytes = fromIntegral (formatInBytes format)\n\n    go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr\n    go dst src tmp i\n        | i >= sizeBytes =\n            unitOL (MOV format (OpAddr src_addr) (OpReg tmp)) `appOL`\n            unitOL (MOV format (OpReg tmp) (OpAddr dst_addr)) `appOL`\n            go dst src tmp (i - sizeBytes)\n        -- Deal with remaining bytes.\n        | i >= 4 =  -- Will never happen on 32-bit\n            unitOL (MOV II32 (OpAddr src_addr) (OpReg tmp)) `appOL`\n            unitOL (MOV II32 (OpReg tmp) (OpAddr dst_addr)) `appOL`\n            go dst src tmp (i - 4)\n        | i >= 2 =\n            unitOL (MOVZxL II16 (OpAddr src_addr) (OpReg tmp)) `appOL`\n            unitOL (MOV II16 (OpReg tmp) (OpAddr dst_addr)) `appOL`\n            go dst src tmp (i - 2)\n        | i >= 1 =\n            unitOL (MOVZxL II8 (OpAddr src_addr) (OpReg tmp)) `appOL`\n            unitOL (MOV II8 (OpReg tmp) (OpAddr dst_addr)) `appOL`\n            go dst src tmp (i - 1)\n        | otherwise = nilOL\n      where\n        src_addr = AddrBaseIndex (EABaseReg src) EAIndexNone\n                   (ImmInteger (n - i))\n        dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone\n                   (ImmInteger (n - i))\n\ngenCCall dflags _ (PrimTarget (MO_Memset align)) _\n         [dst,\n          CmmLit (CmmInt c _),\n          CmmLit (CmmInt n _)]\n         _\n    | fromInteger insns <= maxInlineMemsetInsns dflags && align .&. 3 == 0 = do\n        code_dst <- getAnyReg dst\n        dst_r <- getNewRegNat format\n        return $ code_dst dst_r `appOL` go dst_r (fromInteger n)\n  where\n    (format, val) = case align .&. 3 of\n        2 -> (II16, c2)\n        0 -> (II32, c4)\n        _ -> (II8, c)\n    c2 = c `shiftL` 8 .|. c\n    c4 = c2 `shiftL` 16 .|. c2\n\n    -- The number of instructions we will generate (approx). We need 1\n    -- instructions per move.\n    insns = (n + sizeBytes - 1) `div` sizeBytes\n\n    -- The size of each move, in bytes.\n    sizeBytes :: Integer\n    sizeBytes = fromIntegral (formatInBytes format)\n\n    go :: Reg -> Integer -> OrdList Instr\n    go dst i\n        -- TODO: Add movabs instruction and support 64-bit sets.\n        | i >= sizeBytes =  -- This might be smaller than the below sizes\n            unitOL (MOV format (OpImm (ImmInteger val)) (OpAddr dst_addr)) `appOL`\n            go dst (i - sizeBytes)\n        | i >= 4 =  -- Will never happen on 32-bit\n            unitOL (MOV II32 (OpImm (ImmInteger c4)) (OpAddr dst_addr)) `appOL`\n            go dst (i - 4)\n        | i >= 2 =\n            unitOL (MOV II16 (OpImm (ImmInteger c2)) (OpAddr dst_addr)) `appOL`\n            go dst (i - 2)\n        | i >= 1 =\n            unitOL (MOV II8 (OpImm (ImmInteger c)) (OpAddr dst_addr)) `appOL`\n            go dst (i - 1)\n        | otherwise = nilOL\n      where\n        dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone\n                   (ImmInteger (n - i))\n\ngenCCall _ _ (PrimTarget MO_WriteBarrier) _ _ _ = return nilOL\n        -- write barrier compiles to no code on x86/x86-64;\n        -- we keep it this long in order to prevent earlier optimisations.\n\ngenCCall _ _ (PrimTarget MO_Touch) _ _ _ = return nilOL\n\ngenCCall _ is32bit (PrimTarget (MO_Prefetch_Data n )) _  [src] _ =\n        case n of\n            0 -> genPrefetch src $ PREFETCH NTA  format\n            1 -> genPrefetch src $ PREFETCH Lvl2 format\n            2 -> genPrefetch src $ PREFETCH Lvl1 format\n            3 -> genPrefetch src $ PREFETCH Lvl0 format\n            l -> panic $ \"unexpected prefetch level in genCCall MO_Prefetch_Data: \" ++ (show l)\n            -- the c / llvm prefetch convention is 0, 1, 2, and 3\n            -- the x86 corresponding names are : NTA, 2 , 1, and 0\n   where\n        format = archWordFormat is32bit\n        -- need to know what register width for pointers!\n        genPrefetch inRegSrc prefetchCTor =\n            do\n                code_src <- getAnyReg inRegSrc\n                src_r <- getNewRegNat format\n                return $ code_src src_r `appOL`\n                  (unitOL (prefetchCTor  (OpAddr\n                              ((AddrBaseIndex (EABaseReg src_r )   EAIndexNone (ImmInt 0))))  ))\n                  -- prefetch always takes an address\n\ngenCCall dflags is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] _ = do\n    let platform = targetPlatform dflags\n    let dst_r = getRegisterReg platform False (CmmLocal dst)\n    case width of\n        W64 | is32Bit -> do\n               ChildCode64 vcode rlo <- iselExpr64 src\n               let dst_rhi = getHiVRegFromLo dst_r\n                   rhi     = getHiVRegFromLo rlo\n               return $ vcode `appOL`\n                        toOL [ MOV II32 (OpReg rlo) (OpReg dst_rhi),\n                               MOV II32 (OpReg rhi) (OpReg dst_r),\n                               BSWAP II32 dst_rhi,\n                               BSWAP II32 dst_r ]\n        W16 -> do code_src <- getAnyReg src\n                  return $ code_src dst_r `appOL`\n                           unitOL (BSWAP II32 dst_r) `appOL`\n                           unitOL (SHR II32 (OpImm $ ImmInt 16) (OpReg dst_r))\n        _   -> do code_src <- getAnyReg src\n                  return $ code_src dst_r `appOL` unitOL (BSWAP format dst_r)\n  where\n    format = intFormat width\n\ngenCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]\n         args@[src] bid = do\n    sse4_2 <- sse4_2Enabled\n    let platform = targetPlatform dflags\n    if sse4_2\n        then do code_src <- getAnyReg src\n                src_r <- getNewRegNat format\n                let dst_r = getRegisterReg platform False (CmmLocal dst)\n                return $ code_src src_r `appOL`\n                    (if width == W8 then\n                         -- The POPCNT instruction doesn't take a r/m8\n                         unitOL (MOVZxL II8 (OpReg src_r) (OpReg src_r)) `appOL`\n                         unitOL (POPCNT II16 (OpReg src_r) dst_r)\n                     else\n                         unitOL (POPCNT format (OpReg src_r) dst_r)) `appOL`\n                    (if width == W8 || width == W16 then\n                         -- We used a 16-bit destination register above,\n                         -- so zero-extend\n                         unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r))\n                     else nilOL)\n        else do\n            targetExpr <- cmmMakeDynamicReference dflags\n                          CallReference lbl\n            let target = ForeignTarget targetExpr (ForeignConvention CCallConv\n                                                           [NoHint] [NoHint]\n                                                           CmmMayReturn)\n            genCCall dflags is32Bit target dest_regs args bid\n  where\n    format = intFormat width\n    lbl = mkCmmCodeLabel primUnitId (fsLit (popCntLabel width))\n\ngenCCall dflags is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst]\n         args@[src, mask] bid = do\n    let platform = targetPlatform dflags\n    if isBmi2Enabled dflags\n        then do code_src  <- getAnyReg src\n                code_mask <- getAnyReg mask\n                src_r     <- getNewRegNat format\n                mask_r    <- getNewRegNat format\n                let dst_r = getRegisterReg platform False (CmmLocal dst)\n                return $ code_src src_r `appOL` code_mask mask_r `appOL`\n                    (if width == W8 then\n                         -- The PDEP instruction doesn't take a r/m8\n                         unitOL (MOVZxL II8  (OpReg src_r ) (OpReg src_r )) `appOL`\n                         unitOL (MOVZxL II8  (OpReg mask_r) (OpReg mask_r)) `appOL`\n                         unitOL (PDEP   II16 (OpReg mask_r) (OpReg src_r ) dst_r)\n                     else\n                         unitOL (PDEP format (OpReg mask_r) (OpReg src_r) dst_r)) `appOL`\n                    (if width == W8 || width == W16 then\n                         -- We used a 16-bit destination register above,\n                         -- so zero-extend\n                         unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r))\n                     else nilOL)\n        else do\n            targetExpr <- cmmMakeDynamicReference dflags\n                          CallReference lbl\n            let target = ForeignTarget targetExpr (ForeignConvention CCallConv\n                                                           [NoHint] [NoHint]\n                                                           CmmMayReturn)\n            genCCall dflags is32Bit target dest_regs args bid\n  where\n    format = intFormat width\n    lbl = mkCmmCodeLabel primUnitId (fsLit (pdepLabel width))\n\ngenCCall dflags is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst]\n         args@[src, mask] bid = do\n    let platform = targetPlatform dflags\n    if isBmi2Enabled dflags\n        then do code_src  <- getAnyReg src\n                code_mask <- getAnyReg mask\n                src_r     <- getNewRegNat format\n                mask_r    <- getNewRegNat format\n                let dst_r = getRegisterReg platform False (CmmLocal dst)\n                return $ code_src src_r `appOL` code_mask mask_r `appOL`\n                    (if width == W8 then\n                         -- The PEXT instruction doesn't take a r/m8\n                         unitOL (MOVZxL II8 (OpReg src_r ) (OpReg src_r )) `appOL`\n                         unitOL (MOVZxL II8 (OpReg mask_r) (OpReg mask_r)) `appOL`\n                         unitOL (PEXT II16 (OpReg mask_r) (OpReg src_r) dst_r)\n                     else\n                         unitOL (PEXT format (OpReg mask_r) (OpReg src_r) dst_r)) `appOL`\n                    (if width == W8 || width == W16 then\n                         -- We used a 16-bit destination register above,\n                         -- so zero-extend\n                         unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r))\n                     else nilOL)\n        else do\n            targetExpr <- cmmMakeDynamicReference dflags\n                          CallReference lbl\n            let target = ForeignTarget targetExpr (ForeignConvention CCallConv\n                                                           [NoHint] [NoHint]\n                                                           CmmMayReturn)\n            genCCall dflags is32Bit target dest_regs args bid\n  where\n    format = intFormat width\n    lbl = mkCmmCodeLabel primUnitId (fsLit (pextLabel width))\n\ngenCCall dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bid\n  | is32Bit && width == W64 = do\n    -- Fallback to `hs_clz64` on i386\n    targetExpr <- cmmMakeDynamicReference dflags CallReference lbl\n    let target = ForeignTarget targetExpr (ForeignConvention CCallConv\n                                           [NoHint] [NoHint]\n                                           CmmMayReturn)\n    genCCall dflags is32Bit target dest_regs args bid\n\n  | otherwise = do\n    code_src <- getAnyReg src\n    let dst_r = getRegisterReg platform False (CmmLocal dst)\n    if isBmi2Enabled dflags\n        then do\n            src_r <- getNewRegNat (intFormat width)\n            return $ appOL (code_src src_r) $ case width of\n                W8 -> toOL\n                    [ MOVZxL II8  (OpReg src_r)       (OpReg src_r) -- zero-extend to 32 bit\n                    , LZCNT  II32 (OpReg src_r)       dst_r         -- lzcnt with extra 24 zeros\n                    , SUB    II32 (OpImm (ImmInt 24)) (OpReg dst_r) -- compensate for extra zeros\n                    ]\n                W16 -> toOL\n                    [ LZCNT  II16 (OpReg src_r) dst_r\n                    , MOVZxL II16 (OpReg dst_r) (OpReg dst_r) -- zero-extend from 16 bit\n                    ]\n                _ -> unitOL (LZCNT (intFormat width) (OpReg src_r) dst_r)\n        else do\n            let format = if width == W8 then II16 else intFormat width\n            src_r <- getNewRegNat format\n            tmp_r <- getNewRegNat format\n            return $ code_src src_r `appOL` toOL\n                     ([ MOVZxL  II8    (OpReg src_r) (OpReg src_r) | width == W8 ] ++\n                      [ BSR     format (OpReg src_r) tmp_r\n                      , MOV     II32   (OpImm (ImmInt (2*bw-1))) (OpReg dst_r)\n                      , CMOV NE format (OpReg tmp_r) dst_r\n                      , XOR     format (OpImm (ImmInt (bw-1))) (OpReg dst_r)\n                      ]) -- NB: We don't need to zero-extend the result for the\n                         -- W8/W16 cases because the 'MOV' insn already\n                         -- took care of implicitly clearing the upper bits\n  where\n    bw = widthInBits width\n    platform = targetPlatform dflags\n    lbl = mkCmmCodeLabel primUnitId (fsLit (clzLabel width))\n\ngenCCall dflags is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] bid\n  | is32Bit, width == W64 = do\n      ChildCode64 vcode rlo <- iselExpr64 src\n      let rhi     = getHiVRegFromLo rlo\n          dst_r   = getRegisterReg platform False (CmmLocal dst)\n      lbl1 <- getBlockIdNat\n      lbl2 <- getBlockIdNat\n      let format = if width == W8 then II16 else intFormat width\n      tmp_r <- getNewRegNat format\n\n      -- New CFG Edges:\n      --  bid -> lbl2\n      --  bid -> lbl1 -> lbl2\n      --  We also changes edges originating at bid to start at lbl2 instead.\n      updateCfgNat (addWeightEdge bid lbl1 110 .\n                    addWeightEdge lbl1 lbl2 110 .\n                    addImmediateSuccessor bid lbl2)\n\n      -- The following instruction sequence corresponds to the pseudo-code\n      --\n      --  if (src) {\n      --    dst = src.lo32 ? BSF(src.lo32) : (BSF(src.hi32) + 32);\n      --  } else {\n      --    dst = 64;\n      --  }\n      return $ vcode `appOL` toOL\n               ([ MOV      II32 (OpReg rhi)         (OpReg tmp_r)\n                , OR       II32 (OpReg rlo)         (OpReg tmp_r)\n                , MOV      II32 (OpImm (ImmInt 64)) (OpReg dst_r)\n                , JXX EQQ    lbl2\n                , JXX ALWAYS lbl1\n\n                , NEWBLOCK   lbl1\n                , BSF     II32 (OpReg rhi)         dst_r\n                , ADD     II32 (OpImm (ImmInt 32)) (OpReg dst_r)\n                , BSF     II32 (OpReg rlo)         tmp_r\n                , CMOV NE II32 (OpReg tmp_r)       dst_r\n                , JXX ALWAYS lbl2\n\n                , NEWBLOCK   lbl2\n                ])\n\n  | otherwise = do\n    code_src <- getAnyReg src\n    let dst_r = getRegisterReg platform False (CmmLocal dst)\n\n    if isBmi2Enabled dflags\n    then do\n        src_r <- getNewRegNat (intFormat width)\n        return $ appOL (code_src src_r) $ case width of\n            W8 -> toOL\n                [ OR    II32 (OpImm (ImmInteger 0xFFFFFF00)) (OpReg src_r)\n                , TZCNT II32 (OpReg src_r)        dst_r\n                ]\n            W16 -> toOL\n                [ TZCNT  II16 (OpReg src_r) dst_r\n                , MOVZxL II16 (OpReg dst_r) (OpReg dst_r)\n                ]\n            _ -> unitOL $ TZCNT (intFormat width) (OpReg src_r) dst_r\n    else do\n        -- The following insn sequence makes sure 'ctz 0' has a defined value.\n        -- starting with Haswell, one could use the TZCNT insn instead.\n        let format = if width == W8 then II16 else intFormat width\n        src_r <- getNewRegNat format\n        tmp_r <- getNewRegNat format\n        return $ code_src src_r `appOL` toOL\n                 ([ MOVZxL  II8    (OpReg src_r) (OpReg src_r) | width == W8 ] ++\n                  [ BSF     format (OpReg src_r) tmp_r\n                  , MOV     II32   (OpImm (ImmInt bw)) (OpReg dst_r)\n                  , CMOV NE format (OpReg tmp_r) dst_r\n                  ]) -- NB: We don't need to zero-extend the result for the\n                     -- W8/W16 cases because the 'MOV' insn already\n                     -- took care of implicitly clearing the upper bits\n  where\n    bw = widthInBits width\n    platform = targetPlatform dflags\n\ngenCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do\n    targetExpr <- cmmMakeDynamicReference dflags\n                  CallReference lbl\n    let target = ForeignTarget targetExpr (ForeignConvention CCallConv\n                                           [NoHint] [NoHint]\n                                           CmmMayReturn)\n    genCCall dflags is32Bit target dest_regs args bid\n  where\n    lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width))\n\ngenCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop))\n                                           [dst] [addr, n] bid = do\n    Amode amode addr_code <-\n        if amop `elem` [AMO_Add, AMO_Sub]\n        then getAmode addr\n        else getSimpleAmode dflags is32Bit addr  -- See genCCall for MO_Cmpxchg\n    arg <- getNewRegNat format\n    arg_code <- getAnyReg n\n    use_sse2 <- sse2Enabled\n    let platform = targetPlatform dflags\n        dst_r    = getRegisterReg platform use_sse2 (CmmLocal dst)\n    code <- op_code dst_r arg amode\n    return $ addr_code `appOL` arg_code arg `appOL` code\n  where\n    -- Code for the operation\n    op_code :: Reg       -- Destination reg\n            -> Reg       -- Register containing argument\n            -> AddrMode  -- Address of location to mutate\n            -> NatM (OrdList Instr)\n    op_code dst_r arg amode = case amop of\n        -- In the common case where dst_r is a virtual register the\n        -- final move should go away, because it's the last use of arg\n        -- and the first use of dst_r.\n        AMO_Add  -> return $ toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode))\n                                  , MOV format (OpReg arg) (OpReg dst_r)\n                                  ]\n        AMO_Sub  -> return $ toOL [ NEGI format (OpReg arg)\n                                  , LOCK (XADD format (OpReg arg) (OpAddr amode))\n                                  , MOV format (OpReg arg) (OpReg dst_r)\n                                  ]\n        AMO_And  -> cmpxchg_code (\\ src dst -> unitOL $ AND format src dst)\n        AMO_Nand -> cmpxchg_code (\\ src dst -> toOL [ AND format src dst\n                                                    , NOT format dst\n                                                    ])\n        AMO_Or   -> cmpxchg_code (\\ src dst -> unitOL $ OR format src dst)\n        AMO_Xor  -> cmpxchg_code (\\ src dst -> unitOL $ XOR format src dst)\n      where\n        -- Simulate operation that lacks a dedicated instruction using\n        -- cmpxchg.\n        cmpxchg_code :: (Operand -> Operand -> OrdList Instr)\n                     -> NatM (OrdList Instr)\n        cmpxchg_code instrs = do\n            lbl <- getBlockIdNat\n            tmp <- getNewRegNat format\n\n            --Record inserted blocks\n            addImmediateSuccessorNat bid lbl\n            updateCfgNat (addWeightEdge lbl lbl 0)\n\n            return $ toOL\n                [ MOV format (OpAddr amode) (OpReg eax)\n                , JXX ALWAYS lbl\n                , NEWBLOCK lbl\n                  -- Keep old value so we can return it:\n                , MOV format (OpReg eax) (OpReg dst_r)\n                , MOV format (OpReg eax) (OpReg tmp)\n                ]\n                `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL\n                [ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode))\n                , JXX NE lbl\n                ]\n\n    format = intFormat width\n\ngenCCall dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] _ = do\n  load_code <- intLoadCode (MOV (intFormat width)) addr\n  let platform = targetPlatform dflags\n  use_sse2 <- sse2Enabled\n  return (load_code (getRegisterReg platform use_sse2 (CmmLocal dst)))\n\ngenCCall _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] _ = do\n    code <- assignMem_IntCode (intFormat width) addr val\n    return $ code `snocOL` MFENCE\n\ngenCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _ = do\n    -- On x86 we don't have enough registers to use cmpxchg with a\n    -- complicated addressing mode, so on that architecture we\n    -- pre-compute the address first.\n    Amode amode addr_code <- getSimpleAmode dflags is32Bit addr\n    newval <- getNewRegNat format\n    newval_code <- getAnyReg new\n    oldval <- getNewRegNat format\n    oldval_code <- getAnyReg old\n    use_sse2 <- sse2Enabled\n    let platform = targetPlatform dflags\n        dst_r    = getRegisterReg platform use_sse2 (CmmLocal dst)\n        code     = toOL\n                   [ MOV format (OpReg oldval) (OpReg eax)\n                   , LOCK (CMPXCHG format (OpReg newval) (OpAddr amode))\n                   , MOV format (OpReg eax) (OpReg dst_r)\n                   ]\n    return $ addr_code `appOL` newval_code newval `appOL` oldval_code oldval\n        `appOL` code\n  where\n    format = intFormat width\n\ngenCCall _ is32Bit target dest_regs args bid = do\n  dflags <- getDynFlags\n  let platform = targetPlatform dflags\n      sse2     = isSse2Enabled dflags\n  case (target, dest_regs) of\n    -- void return type prim op\n    (PrimTarget op, []) ->\n        outOfLineCmmOp bid op Nothing args\n    -- we only cope with a single result for foreign calls\n    (PrimTarget op, [r])\n      | sse2 -> case op of\n          MO_F32_Fabs -> case args of\n            [x] -> sse2FabsCode W32 x\n            _ -> panic \"genCCall: Wrong number of arguments for fabs\"\n          MO_F64_Fabs -> case args of\n            [x] -> sse2FabsCode W64 x\n            _ -> panic \"genCCall: Wrong number of arguments for fabs\"\n\n          MO_F32_Sqrt -> actuallyInlineSSE2Op (\\fmt r -> SQRT fmt (OpReg r)) FF32 args\n          MO_F64_Sqrt -> actuallyInlineSSE2Op (\\fmt r -> SQRT fmt (OpReg r)) FF64 args\n          _other_op -> outOfLineCmmOp bid op (Just r) args\n      | otherwise -> do\n        l1 <- getNewLabelNat\n        l2 <- getNewLabelNat\n        if sse2\n          then outOfLineCmmOp bid op (Just r) args\n          else case op of\n              MO_F32_Sqrt -> actuallyInlineFloatOp GSQRT FF32 args\n              MO_F64_Sqrt -> actuallyInlineFloatOp GSQRT FF64 args\n\n              MO_F32_Sin  -> actuallyInlineFloatOp (\\s -> GSIN s l1 l2) FF32 args\n              MO_F64_Sin  -> actuallyInlineFloatOp (\\s -> GSIN s l1 l2) FF64 args\n\n              MO_F32_Cos  -> actuallyInlineFloatOp (\\s -> GCOS s l1 l2) FF32 args\n              MO_F64_Cos  -> actuallyInlineFloatOp (\\s -> GCOS s l1 l2) FF64 args\n\n              MO_F32_Tan  -> actuallyInlineFloatOp (\\s -> GTAN s l1 l2) FF32 args\n              MO_F64_Tan  -> actuallyInlineFloatOp (\\s -> GTAN s l1 l2) FF64 args\n\n              _other_op   -> outOfLineCmmOp bid op (Just r) args\n\n       where\n        actuallyInlineFloatOp = actuallyInlineFloatOp' False\n        actuallyInlineSSE2Op = actuallyInlineFloatOp' True\n\n        actuallyInlineFloatOp' usesSSE instr format [x]\n              = do res <- trivialUFCode format (instr format) x\n                   any <- anyReg res\n                   return (any (getRegisterReg platform usesSSE (CmmLocal r)))\n\n        actuallyInlineFloatOp' _ _ _ args\n              = panic $ \"genCCall.actuallyInlineFloatOp': bad number of arguments! (\"\n                      ++ show (length args) ++ \")\"\n\n        sse2FabsCode :: Width -> CmmExpr -> NatM InstrBlock\n        sse2FabsCode w x = do\n          let fmt = floatFormat w\n          x_code <- getAnyReg x\n          let\n            const | FF32 <- fmt = CmmInt 0x7fffffff W32\n                  | otherwise   = CmmInt 0x7fffffffffffffff W64\n          Amode amode amode_code <- memConstant (widthInBytes w) const\n          tmp <- getNewRegNat fmt\n          let\n            code dst = x_code dst `appOL` amode_code `appOL` toOL [\n                MOV fmt (OpAddr amode) (OpReg tmp),\n                AND fmt (OpReg tmp) (OpReg dst)\n                ]\n\n          return $ code (getRegisterReg platform True (CmmLocal r))\n\n    (PrimTarget (MO_S_QuotRem  width), _) -> divOp1 platform True  width dest_regs args\n    (PrimTarget (MO_U_QuotRem  width), _) -> divOp1 platform False width dest_regs args\n    (PrimTarget (MO_U_QuotRem2 width), _) -> divOp2 platform False width dest_regs args\n    (PrimTarget (MO_Add2 width), [res_h, res_l]) ->\n        case args of\n        [arg_x, arg_y] ->\n            do hCode <- getAnyReg (CmmLit (CmmInt 0 width))\n               let format = intFormat width\n               lCode <- anyReg =<< trivialCode width (ADD_CC format)\n                                     (Just (ADD_CC format)) arg_x arg_y\n               let reg_l = getRegisterReg platform True (CmmLocal res_l)\n                   reg_h = getRegisterReg platform True (CmmLocal res_h)\n                   code = hCode reg_h `appOL`\n                          lCode reg_l `snocOL`\n                          ADC format (OpImm (ImmInteger 0)) (OpReg reg_h)\n               return code\n        _ -> panic \"genCCall: Wrong number of arguments/results for add2\"\n    (PrimTarget (MO_AddWordC width), [res_r, res_c]) ->\n        addSubIntC platform ADD_CC (const Nothing) CARRY width res_r res_c args\n    (PrimTarget (MO_SubWordC width), [res_r, res_c]) ->\n        addSubIntC platform SUB_CC (const Nothing) CARRY width res_r res_c args\n    (PrimTarget (MO_AddIntC width), [res_r, res_c]) ->\n        addSubIntC platform ADD_CC (Just . ADD_CC) OFLO width res_r res_c args\n    (PrimTarget (MO_SubIntC width), [res_r, res_c]) ->\n        addSubIntC platform SUB_CC (const Nothing) OFLO width res_r res_c args\n    (PrimTarget (MO_U_Mul2 width), [res_h, res_l]) ->\n        case args of\n        [arg_x, arg_y] ->\n            do (y_reg, y_code) <- getRegOrMem arg_y\n               x_code <- getAnyReg arg_x\n               let format = intFormat width\n                   reg_h = getRegisterReg platform True (CmmLocal res_h)\n                   reg_l = getRegisterReg platform True (CmmLocal res_l)\n                   code = y_code `appOL`\n                          x_code rax `appOL`\n                          toOL [MUL2 format y_reg,\n                                MOV format (OpReg rdx) (OpReg reg_h),\n                                MOV format (OpReg rax) (OpReg reg_l)]\n               return code\n        _ -> panic \"genCCall: Wrong number of arguments/results for mul2\"\n\n    _ -> if is32Bit\n         then genCCall32' dflags target dest_regs args\n         else genCCall64' dflags target dest_regs args\n\n  where divOp1 platform signed width results [arg_x, arg_y]\n            = divOp platform signed width results Nothing arg_x arg_y\n        divOp1 _ _ _ _ _\n            = panic \"genCCall: Wrong number of arguments for divOp1\"\n        divOp2 platform signed width results [arg_x_high, arg_x_low, arg_y]\n            = divOp platform signed width results (Just arg_x_high) arg_x_low arg_y\n        divOp2 _ _ _ _ _\n            = panic \"genCCall: Wrong number of arguments for divOp2\"\n\n        -- See Note [DIV/IDIV for bytes]\n        divOp platform signed W8 [res_q, res_r] m_arg_x_high arg_x_low arg_y =\n            let widen | signed = MO_SS_Conv W8 W16\n                      | otherwise = MO_UU_Conv W8 W16\n                arg_x_low_16 = CmmMachOp widen [arg_x_low]\n                arg_y_16 = CmmMachOp widen [arg_y]\n                m_arg_x_high_16 = (\\p -> CmmMachOp widen [p]) <$> m_arg_x_high\n            in divOp\n                  platform signed W16 [res_q, res_r]\n                  m_arg_x_high_16 arg_x_low_16 arg_y_16\n\n        divOp platform signed width [res_q, res_r]\n              m_arg_x_high arg_x_low arg_y\n            = do let format = intFormat width\n                     reg_q = getRegisterReg platform True (CmmLocal res_q)\n                     reg_r = getRegisterReg platform True (CmmLocal res_r)\n                     widen | signed    = CLTD format\n                           | otherwise = XOR format (OpReg rdx) (OpReg rdx)\n                     instr | signed    = IDIV\n                           | otherwise = DIV\n                 (y_reg, y_code) <- getRegOrMem arg_y\n                 x_low_code <- getAnyReg arg_x_low\n                 x_high_code <- case m_arg_x_high of\n                                Just arg_x_high ->\n                                    getAnyReg arg_x_high\n                                Nothing ->\n                                    return $ const $ unitOL widen\n                 return $ y_code `appOL`\n                          x_low_code rax `appOL`\n                          x_high_code rdx `appOL`\n                          toOL [instr format y_reg,\n                                MOV format (OpReg rax) (OpReg reg_q),\n                                MOV format (OpReg rdx) (OpReg reg_r)]\n        divOp _ _ _ _ _ _ _\n            = panic \"genCCall: Wrong number of results for divOp\"\n\n        addSubIntC platform instr mrevinstr cond width\n                   res_r res_c [arg_x, arg_y]\n            = do let format = intFormat width\n                 rCode <- anyReg =<< trivialCode width (instr format)\n                                       (mrevinstr format) arg_x arg_y\n                 reg_tmp <- getNewRegNat II8\n                 let reg_c = getRegisterReg platform True (CmmLocal res_c)\n                     reg_r = getRegisterReg platform True (CmmLocal res_r)\n                     code = rCode reg_r `snocOL`\n                            SETCC cond (OpReg reg_tmp) `snocOL`\n                            MOVZxL II8 (OpReg reg_tmp) (OpReg reg_c)\n\n                 return code\n        addSubIntC _ _ _ _ _ _ _ _\n            = panic \"genCCall: Wrong number of arguments/results for addSubIntC\"\n\n-- Note [DIV/IDIV for bytes]\n--\n-- IDIV reminder:\n--   Size    Dividend   Divisor   Quotient    Remainder\n--   byte    %ax         r/m8      %al          %ah\n--   word    %dx:%ax     r/m16     %ax          %dx\n--   dword   %edx:%eax   r/m32     %eax         %edx\n--   qword   %rdx:%rax   r/m64     %rax         %rdx\n--\n-- We do a special case for the byte division because the current\n-- codegen doesn't deal well with accessing %ah register (also,\n-- accessing %ah in 64-bit mode is complicated because it cannot be an\n-- operand of many instructions). So we just widen operands to 16 bits\n-- and get the results from %al, %dl. This is not optimal, but a few\n-- register moves are probably not a huge deal when doing division.\n\ngenCCall32' :: DynFlags\n            -> ForeignTarget            -- function to call\n            -> [CmmFormal]        -- where to put the result\n            -> [CmmActual]        -- arguments (of mixed type)\n            -> NatM InstrBlock\ngenCCall32' dflags target dest_regs args = do\n        let\n            prom_args = map (maybePromoteCArg dflags W32) args\n\n            -- Align stack to 16n for calls, assuming a starting stack\n            -- alignment of 16n - word_size on procedure entry. Which we\n            -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]\n            sizes               = map (arg_size_bytes . cmmExprType dflags) (reverse args)\n            raw_arg_size        = sum sizes + wORD_SIZE dflags\n            arg_pad_size        = (roundTo 16 $ raw_arg_size) - raw_arg_size\n            tot_arg_size        = raw_arg_size + arg_pad_size - wORD_SIZE dflags\n        delta0 <- getDeltaNat\n        setDeltaNat (delta0 - arg_pad_size)\n\n        use_sse2 <- sse2Enabled\n        push_codes <- mapM (push_arg use_sse2) (reverse prom_args)\n        delta <- getDeltaNat\n        MASSERT(delta == delta0 - tot_arg_size)\n\n        -- deal with static vs dynamic call targets\n        (callinsns,cconv) <-\n          case target of\n            ForeignTarget (CmmLit (CmmLabel lbl)) conv\n               -> -- ToDo: stdcall arg sizes\n                  return (unitOL (CALL (Left fn_imm) []), conv)\n               where fn_imm = ImmCLbl lbl\n            ForeignTarget expr conv\n               -> do { (dyn_r, dyn_c) <- getSomeReg expr\n                     ; ASSERT( isWord32 (cmmExprType dflags expr) )\n                       return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }\n            PrimTarget _\n                -> panic $ \"genCCall: Can't handle PrimTarget call type here, error \"\n                            ++ \"probably because too many return values.\"\n\n        let push_code\n                | arg_pad_size /= 0\n                = toOL [SUB II32 (OpImm (ImmInt arg_pad_size)) (OpReg esp),\n                        DELTA (delta0 - arg_pad_size)]\n                  `appOL` concatOL push_codes\n                | otherwise\n                = concatOL push_codes\n\n              -- Deallocate parameters after call for ccall;\n              -- but not for stdcall (callee does it)\n              --\n              -- We have to pop any stack padding we added\n              -- even if we are doing stdcall, though (#5052)\n            pop_size\n               | ForeignConvention StdCallConv _ _ _ <- cconv = arg_pad_size\n               | otherwise = tot_arg_size\n\n            call = callinsns `appOL`\n                   toOL (\n                      (if pop_size==0 then [] else\n                       [ADD II32 (OpImm (ImmInt pop_size)) (OpReg esp)])\n                      ++\n                      [DELTA delta0]\n                   )\n        setDeltaNat delta0\n\n        dflags <- getDynFlags\n        let platform = targetPlatform dflags\n\n        let\n            -- assign the results, if necessary\n            assign_code []     = nilOL\n            assign_code [dest]\n              | isFloatType ty =\n                 if use_sse2\n                    then let tmp_amode = AddrBaseIndex (EABaseReg esp)\n                                                       EAIndexNone\n                                                       (ImmInt 0)\n                             fmt = floatFormat w\n                         in toOL [ SUB II32 (OpImm (ImmInt b)) (OpReg esp),\n                                   DELTA (delta0 - b),\n                                   GST fmt fake0 tmp_amode,\n                                   MOV fmt (OpAddr tmp_amode) (OpReg r_dest),\n                                   ADD II32 (OpImm (ImmInt b)) (OpReg esp),\n                                   DELTA delta0]\n                    else unitOL (GMOV fake0 r_dest)\n              | isWord64 ty    = toOL [MOV II32 (OpReg eax) (OpReg r_dest),\n                                        MOV II32 (OpReg edx) (OpReg r_dest_hi)]\n              | otherwise      = unitOL (MOV (intFormat w)\n                                             (OpReg eax)\n                                             (OpReg r_dest))\n              where\n                    ty = localRegType dest\n                    w  = typeWidth ty\n                    b  = widthInBytes w\n                    r_dest_hi = getHiVRegFromLo r_dest\n                    r_dest    = getRegisterReg platform use_sse2 (CmmLocal dest)\n            assign_code many = pprPanic \"genCCall.assign_code - too many return values:\" (ppr many)\n\n        return (push_code `appOL`\n                call `appOL`\n                assign_code dest_regs)\n\n      where\n        -- If the size is smaller than the word, we widen things (see maybePromoteCArg)\n        arg_size_bytes :: CmmType -> Int\n        arg_size_bytes ty = max (widthInBytes (typeWidth ty)) (widthInBytes (wordWidth dflags))\n\n        roundTo a x | x `mod` a == 0 = x\n                    | otherwise = x + a - (x `mod` a)\n\n        push_arg :: Bool -> CmmActual {-current argument-}\n                        -> NatM InstrBlock  -- code\n\n        push_arg use_sse2 arg -- we don't need the hints on x86\n          | isWord64 arg_ty = do\n            ChildCode64 code r_lo <- iselExpr64 arg\n            delta <- getDeltaNat\n            setDeltaNat (delta - 8)\n            let r_hi = getHiVRegFromLo r_lo\n            return (       code `appOL`\n                           toOL [PUSH II32 (OpReg r_hi), DELTA (delta - 4),\n                                 PUSH II32 (OpReg r_lo), DELTA (delta - 8),\n                                 DELTA (delta-8)]\n                )\n\n          | isFloatType arg_ty = do\n            (reg, code) <- getSomeReg arg\n            delta <- getDeltaNat\n            setDeltaNat (delta-size)\n            return (code `appOL`\n                            toOL [SUB II32 (OpImm (ImmInt size)) (OpReg esp),\n                                  DELTA (delta-size),\n                                  let addr = AddrBaseIndex (EABaseReg esp)\n                                                            EAIndexNone\n                                                            (ImmInt 0)\n                                      format = floatFormat (typeWidth arg_ty)\n                                  in\n                                  if use_sse2\n                                     then MOV format (OpReg reg) (OpAddr addr)\n                                     else GST format reg addr\n                                 ]\n                           )\n\n          | otherwise = do\n            -- Arguments can be smaller than 32-bit, but we still use @PUSH\n            -- II32@ - the usual calling conventions expect integers to be\n            -- 4-byte aligned.\n            ASSERT((typeWidth arg_ty) <= W32) return ()\n            (operand, code) <- getOperand arg\n            delta <- getDeltaNat\n            setDeltaNat (delta-size)\n            return (code `snocOL`\n                    PUSH II32 operand `snocOL`\n                    DELTA (delta-size))\n\n          where\n             arg_ty = cmmExprType dflags arg\n             size = arg_size_bytes arg_ty -- Byte size\n\ngenCCall64' :: DynFlags\n            -> ForeignTarget      -- function to call\n            -> [CmmFormal]        -- where to put the result\n            -> [CmmActual]        -- arguments (of mixed type)\n            -> NatM InstrBlock\ngenCCall64' dflags target dest_regs args = do\n    -- load up the register arguments\n    let prom_args = map (maybePromoteCArg dflags W32) args\n\n    (stack_args, int_regs_used, fp_regs_used, load_args_code, assign_args_code)\n         <-\n        if platformOS platform == OSMinGW32\n        then load_args_win prom_args [] [] (allArgRegs platform) nilOL\n        else do\n           (stack_args, aregs, fregs, load_args_code, assign_args_code)\n               <- load_args prom_args (allIntArgRegs platform)\n                                      (allFPArgRegs platform)\n                                      nilOL nilOL\n           let used_regs rs as = reverse (drop (length rs) (reverse as))\n               fregs_used      = used_regs fregs (allFPArgRegs platform)\n               aregs_used      = used_regs aregs (allIntArgRegs platform)\n           return (stack_args, aregs_used, fregs_used, load_args_code\n                                                      , assign_args_code)\n\n    let\n        arg_regs_used = int_regs_used ++ fp_regs_used\n        arg_regs = [eax] ++ arg_regs_used\n                -- for annotating the call instruction with\n        sse_regs = length fp_regs_used\n        arg_stack_slots = if platformOS platform == OSMinGW32\n                          then length stack_args + length (allArgRegs platform)\n                          else length stack_args\n        tot_arg_size = arg_size * arg_stack_slots\n\n\n    -- Align stack to 16n for calls, assuming a starting stack\n    -- alignment of 16n - word_size on procedure entry. Which we\n    -- maintain. See Note [rts/StgCRun.c : Stack Alignment on X86]\n    (real_size, adjust_rsp) <-\n        if (tot_arg_size + wORD_SIZE dflags) `rem` 16 == 0\n            then return (tot_arg_size, nilOL)\n            else do -- we need to adjust...\n                delta <- getDeltaNat\n                setDeltaNat (delta - wORD_SIZE dflags)\n                return (tot_arg_size + wORD_SIZE dflags, toOL [\n                                SUB II64 (OpImm (ImmInt (wORD_SIZE dflags))) (OpReg rsp),\n                                DELTA (delta - wORD_SIZE dflags) ])\n\n    -- push the stack args, right to left\n    push_code <- push_args (reverse stack_args) nilOL\n    -- On Win64, we also have to leave stack space for the arguments\n    -- that we are passing in registers\n    lss_code <- if platformOS platform == OSMinGW32\n                then leaveStackSpace (length (allArgRegs platform))\n                else return nilOL\n    delta <- getDeltaNat\n\n    -- deal with static vs dynamic call targets\n    (callinsns,_cconv) <-\n      case target of\n        ForeignTarget (CmmLit (CmmLabel lbl)) conv\n           -> -- ToDo: stdcall arg sizes\n              return (unitOL (CALL (Left fn_imm) arg_regs), conv)\n           where fn_imm = ImmCLbl lbl\n        ForeignTarget expr conv\n           -> do (dyn_r, dyn_c) <- getSomeReg expr\n                 return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)\n        PrimTarget _\n            -> panic $ \"genCCall: Can't handle PrimTarget call type here, error \"\n                        ++ \"probably because too many return values.\"\n\n    let\n        -- The x86_64 ABI requires us to set %al to the number of SSE2\n        -- registers that contain arguments, if the called routine\n        -- is a varargs function.  We don't know whether it's a\n        -- varargs function or not, so we have to assume it is.\n        --\n        -- It's not safe to omit this assignment, even if the number\n        -- of SSE2 regs in use is zero.  If %al is larger than 8\n        -- on entry to a varargs function, seg faults ensue.\n        assign_eax n = unitOL (MOV II32 (OpImm (ImmInt n)) (OpReg eax))\n\n    let call = callinsns `appOL`\n               toOL (\n                    -- Deallocate parameters after call for ccall;\n                    -- stdcall has callee do it, but is not supported on\n                    -- x86_64 target (see #3336)\n                  (if real_size==0 then [] else\n                   [ADD (intFormat (wordWidth dflags)) (OpImm (ImmInt real_size)) (OpReg esp)])\n                  ++\n                  [DELTA (delta + real_size)]\n               )\n    setDeltaNat (delta + real_size)\n\n    let\n        -- assign the results, if necessary\n        assign_code []     = nilOL\n        assign_code [dest] =\n          case typeWidth rep of\n                W32 | isFloatType rep -> unitOL (MOV (floatFormat W32)\n                                                     (OpReg xmm0)\n                                                     (OpReg r_dest))\n                W64 | isFloatType rep -> unitOL (MOV (floatFormat W64)\n                                                     (OpReg xmm0)\n                                                     (OpReg r_dest))\n                _ -> unitOL (MOV (cmmTypeFormat rep) (OpReg rax) (OpReg r_dest))\n          where\n                rep = localRegType dest\n                r_dest = getRegisterReg platform True (CmmLocal dest)\n        assign_code _many = panic \"genCCall.assign_code many\"\n\n    return (adjust_rsp          `appOL`\n            push_code           `appOL`\n            load_args_code      `appOL`\n            assign_args_code    `appOL`\n            lss_code            `appOL`\n            assign_eax sse_regs `appOL`\n            call                `appOL`\n            assign_code dest_regs)\n\n  where platform = targetPlatform dflags\n        arg_size = 8 -- always, at the mo\n\n\n        load_args :: [CmmExpr]\n                  -> [Reg]         -- int regs avail for args\n                  -> [Reg]         -- FP regs avail for args\n                  -> InstrBlock    -- code computing args\n                  -> InstrBlock    -- code assigning args to ABI regs\n                  -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock,InstrBlock)\n        -- no more regs to use\n        load_args args [] [] code acode     =\n            return (args, [], [], code, acode)\n\n        -- no more args to push\n        load_args [] aregs fregs code acode =\n            return ([], aregs, fregs, code, acode)\n\n        load_args (arg : rest) aregs fregs code acode\n            | isFloatType arg_rep = case fregs of\n                 []     -> push_this_arg\n                 (r:rs) -> do\n                    (code',acode') <- reg_this_arg r\n                    load_args rest aregs rs code' acode'\n            | otherwise           = case aregs of\n                 []     -> push_this_arg\n                 (r:rs) -> do\n                    (code',acode') <- reg_this_arg r\n                    load_args rest rs fregs code' acode'\n            where\n\n              -- put arg into the list of stack pushed args\n              push_this_arg = do\n                 (args',ars,frs,code',acode')\n                     <- load_args rest aregs fregs code acode\n                 return (arg:args', ars, frs, code', acode')\n\n              -- pass the arg into the given register\n              reg_this_arg r\n                -- \"operand\" args can be directly assigned into r\n                | isOperand False arg = do\n                    arg_code <- getAnyReg arg\n                    return (code, (acode `appOL` arg_code r))\n                -- The last non-operand arg can be directly assigned after its\n                -- computation without going into a temporary register\n                | all (isOperand False) rest = do\n                    arg_code   <- getAnyReg arg\n                    return (code `appOL` arg_code r,acode)\n\n                -- other args need to be computed beforehand to avoid clobbering\n                -- previously assigned registers used to pass parameters (see\n                -- #11792, #12614). They are assigned into temporary registers\n                -- and get assigned to proper call ABI registers after they all\n                -- have been computed.\n                | otherwise     = do\n                    arg_code <- getAnyReg arg\n                    tmp      <- getNewRegNat arg_fmt\n                    let\n                      code'  = code `appOL` arg_code tmp\n                      acode' = acode `snocOL` reg2reg arg_fmt tmp r\n                    return (code',acode')\n\n              arg_rep = cmmExprType dflags arg\n              arg_fmt = cmmTypeFormat arg_rep\n\n        load_args_win :: [CmmExpr]\n                      -> [Reg]        -- used int regs\n                      -> [Reg]        -- used FP regs\n                      -> [(Reg, Reg)] -- (int, FP) regs avail for args\n                      -> InstrBlock\n                      -> NatM ([CmmExpr],[Reg],[Reg],InstrBlock,InstrBlock)\n        load_args_win args usedInt usedFP [] code\n            = return (args, usedInt, usedFP, code, nilOL)\n            -- no more regs to use\n        load_args_win [] usedInt usedFP _ code\n            = return ([], usedInt, usedFP, code, nilOL)\n            -- no more args to push\n        load_args_win (arg : rest) usedInt usedFP\n                      ((ireg, freg) : regs) code\n            | isFloatType arg_rep = do\n                 arg_code <- getAnyReg arg\n                 load_args_win rest (ireg : usedInt) (freg : usedFP) regs\n                               (code `appOL`\n                                arg_code freg `snocOL`\n                                -- If we are calling a varargs function\n                                -- then we need to define ireg as well\n                                -- as freg\n                                MOV II64 (OpReg freg) (OpReg ireg))\n            | otherwise = do\n                 arg_code <- getAnyReg arg\n                 load_args_win rest (ireg : usedInt) usedFP regs\n                               (code `appOL` arg_code ireg)\n            where\n              arg_rep = cmmExprType dflags arg\n\n        push_args [] code = return code\n        push_args (arg:rest) code\n           | isFloatType arg_rep = do\n             (arg_reg, arg_code) <- getSomeReg arg\n             delta <- getDeltaNat\n             setDeltaNat (delta-arg_size)\n             let code' = code `appOL` arg_code `appOL` toOL [\n                            SUB (intFormat (wordWidth dflags)) (OpImm (ImmInt arg_size)) (OpReg rsp),\n                            DELTA (delta-arg_size),\n                            MOV (floatFormat width) (OpReg arg_reg) (OpAddr (spRel dflags 0))]\n             push_args rest code'\n\n           | otherwise = do\n             -- Arguments can be smaller than 64-bit, but we still use @PUSH\n             -- II64@ - the usual calling conventions expect integers to be\n             -- 8-byte aligned.\n             ASSERT(width <= W64) return ()\n             (arg_op, arg_code) <- getOperand arg\n             delta <- getDeltaNat\n             setDeltaNat (delta-arg_size)\n             let code' = code `appOL` arg_code `appOL` toOL [\n                                    PUSH II64 arg_op,\n                                    DELTA (delta-arg_size)]\n             push_args rest code'\n            where\n              arg_rep = cmmExprType dflags arg\n              width = typeWidth arg_rep\n\n        leaveStackSpace n = do\n             delta <- getDeltaNat\n             setDeltaNat (delta - n * arg_size)\n             return $ toOL [\n                         SUB II64 (OpImm (ImmInt (n * wORD_SIZE dflags))) (OpReg rsp),\n                         DELTA (delta - n * arg_size)]\n\nmaybePromoteCArg :: DynFlags -> Width -> CmmExpr -> CmmExpr\nmaybePromoteCArg dflags wto arg\n | wfrom < wto = CmmMachOp (MO_UU_Conv wfrom wto) [arg]\n | otherwise   = arg\n where\n   wfrom = cmmExprWidth dflags arg\n\noutOfLineCmmOp :: BlockId -> CallishMachOp -> Maybe CmmFormal -> [CmmActual]\n               -> NatM InstrBlock\noutOfLineCmmOp bid mop res args\n  = do\n      dflags <- getDynFlags\n      targetExpr <- cmmMakeDynamicReference dflags CallReference lbl\n      let target = ForeignTarget targetExpr\n                           (ForeignConvention CCallConv [] [] CmmMayReturn)\n\n      stmtToInstrs bid (CmmUnsafeForeignCall target (catMaybes [res]) args)\n  where\n        -- Assume we can call these functions directly, and that they're not in a dynamic library.\n        -- TODO: Why is this ok? Under linux this code will be in libm.so\n        --       Is it because they're really implemented as a primitive instruction by the assembler??  -- BL 2009/12/31\n        lbl = mkForeignLabel fn Nothing ForeignLabelInThisPackage IsFunction\n\n        fn = case mop of\n              MO_F32_Sqrt  -> fsLit \"sqrtf\"\n              MO_F32_Fabs  -> fsLit \"fabsf\"\n              MO_F32_Sin   -> fsLit \"sinf\"\n              MO_F32_Cos   -> fsLit \"cosf\"\n              MO_F32_Tan   -> fsLit \"tanf\"\n              MO_F32_Exp   -> fsLit \"expf\"\n              MO_F32_Log   -> fsLit \"logf\"\n\n              MO_F32_Asin  -> fsLit \"asinf\"\n              MO_F32_Acos  -> fsLit \"acosf\"\n              MO_F32_Atan  -> fsLit \"atanf\"\n\n              MO_F32_Sinh  -> fsLit \"sinhf\"\n              MO_F32_Cosh  -> fsLit \"coshf\"\n              MO_F32_Tanh  -> fsLit \"tanhf\"\n              MO_F32_Pwr   -> fsLit \"powf\"\n\n              MO_F32_Asinh -> fsLit \"asinhf\"\n              MO_F32_Acosh -> fsLit \"acoshf\"\n              MO_F32_Atanh -> fsLit \"atanhf\"\n\n              MO_F64_Sqrt  -> fsLit \"sqrt\"\n              MO_F64_Fabs  -> fsLit \"fabs\"\n              MO_F64_Sin   -> fsLit \"sin\"\n              MO_F64_Cos   -> fsLit \"cos\"\n              MO_F64_Tan   -> fsLit \"tan\"\n              MO_F64_Exp   -> fsLit \"exp\"\n              MO_F64_Log   -> fsLit \"log\"\n\n              MO_F64_Asin  -> fsLit \"asin\"\n              MO_F64_Acos  -> fsLit \"acos\"\n              MO_F64_Atan  -> fsLit \"atan\"\n\n              MO_F64_Sinh  -> fsLit \"sinh\"\n              MO_F64_Cosh  -> fsLit \"cosh\"\n              MO_F64_Tanh  -> fsLit \"tanh\"\n              MO_F64_Pwr   -> fsLit \"pow\"\n\n              MO_F64_Asinh  -> fsLit \"asinh\"\n              MO_F64_Acosh  -> fsLit \"acosh\"\n              MO_F64_Atanh  -> fsLit \"atanh\"\n\n              MO_Memcpy _  -> fsLit \"memcpy\"\n              MO_Memset _  -> fsLit \"memset\"\n              MO_Memmove _ -> fsLit \"memmove\"\n              MO_Memcmp _  -> fsLit \"memcmp\"\n\n              MO_PopCnt _  -> fsLit \"popcnt\"\n              MO_BSwap _   -> fsLit \"bswap\"\n              MO_Clz w     -> fsLit $ clzLabel w\n              MO_Ctz _     -> unsupported\n\n              MO_Pdep w    -> fsLit $ pdepLabel w\n              MO_Pext w    -> fsLit $ pextLabel w\n\n              MO_AtomicRMW _ _ -> fsLit \"atomicrmw\"\n              MO_AtomicRead _  -> fsLit \"atomicread\"\n              MO_AtomicWrite _ -> fsLit \"atomicwrite\"\n              MO_Cmpxchg _     -> fsLit \"cmpxchg\"\n\n              MO_UF_Conv _ -> unsupported\n\n              MO_S_QuotRem {}  -> unsupported\n              MO_U_QuotRem {}  -> unsupported\n              MO_U_QuotRem2 {} -> unsupported\n              MO_Add2 {}       -> unsupported\n              MO_AddIntC {}    -> unsupported\n              MO_SubIntC {}    -> unsupported\n              MO_AddWordC {}   -> unsupported\n              MO_SubWordC {}   -> unsupported\n              MO_U_Mul2 {}     -> unsupported\n              MO_WriteBarrier  -> unsupported\n              MO_Touch         -> unsupported\n              (MO_Prefetch_Data _ ) -> unsupported\n        unsupported = panic (\"outOfLineCmmOp: \" ++ show mop\n                          ++ \" not supported here\")\n\n-- -----------------------------------------------------------------------------\n-- Generating a table-branch\n\ngenSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock\n\ngenSwitch dflags expr targets\n  | positionIndependent dflags\n  = do\n        (reg,e_code) <- getNonClobberedReg (cmmOffset dflags expr offset)\n           -- getNonClobberedReg because it needs to survive across t_code\n        lbl <- getNewLabelNat\n        dflags <- getDynFlags\n        let is32bit = target32Bit (targetPlatform dflags)\n            os = platformOS (targetPlatform dflags)\n            -- Might want to use .rodata.<function we're in> instead, but as\n            -- long as it's something unique it'll work out since the\n            -- references to the jump table are in the appropriate section.\n            rosection = case os of\n              -- on Mac OS X/x86_64, put the jump table in the text section to\n              -- work around a limitation of the linker.\n              -- ld64 is unable to handle the relocations for\n              --     .quad L1 - L0\n              -- if L0 is not preceded by a non-anonymous label in its section.\n              OSDarwin | not is32bit -> Section Text lbl\n              _ -> Section ReadOnlyData lbl\n        dynRef <- cmmMakeDynamicReference dflags DataReference lbl\n        (tableReg,t_code) <- getSomeReg $ dynRef\n        let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)\n                                       (EAIndex reg (wORD_SIZE dflags)) (ImmInt 0))\n\n        offsetReg <- getNewRegNat (intFormat (wordWidth dflags))\n        return $ if is32bit || os == OSDarwin\n                 then e_code `appOL` t_code `appOL` toOL [\n                                ADD (intFormat (wordWidth dflags)) op (OpReg tableReg),\n                                JMP_TBL (OpReg tableReg) ids rosection lbl\n                       ]\n                 else -- HACK: On x86_64 binutils<2.17 is only able to generate\n                      -- PC32 relocations, hence we only get 32-bit offsets in\n                      -- the jump table. As these offsets are always negative\n                      -- we need to properly sign extend them to 64-bit. This\n                      -- hack should be removed in conjunction with the hack in\n                      -- PprMach.hs/pprDataItem once binutils 2.17 is standard.\n                      e_code `appOL` t_code `appOL` toOL [\n                               MOVSxL II32 op (OpReg offsetReg),\n                               ADD (intFormat (wordWidth dflags))\n                                   (OpReg offsetReg)\n                                   (OpReg tableReg),\n                               JMP_TBL (OpReg tableReg) ids rosection lbl\n                       ]\n  | otherwise\n  = do\n        (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)\n        lbl <- getNewLabelNat\n        let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (wORD_SIZE dflags)) (ImmCLbl lbl))\n            code = e_code `appOL` toOL [\n                    JMP_TBL op ids (Section ReadOnlyData lbl) lbl\n                 ]\n        return code\n  where\n    (offset, blockIds) = switchTargetsToTable targets\n    ids = map (fmap DestBlockId) blockIds\n\ngenerateJumpTableForInstr :: DynFlags -> Instr -> Maybe (NatCmmDecl (Alignment, CmmStatics) Instr)\ngenerateJumpTableForInstr dflags (JMP_TBL _ ids section lbl)\n    = let getBlockId (DestBlockId id) = id\n          getBlockId _ = panic \"Non-Label target in Jump Table\"\n          blockIds = map (fmap getBlockId) ids\n      in Just (createJumpTable dflags blockIds section lbl)\ngenerateJumpTableForInstr _ _ = Nothing\n\ncreateJumpTable :: DynFlags -> [Maybe BlockId] -> Section -> CLabel\n                -> GenCmmDecl (Alignment, CmmStatics) h g\ncreateJumpTable dflags ids section lbl\n    = let jumpTable\n            | positionIndependent dflags =\n                  let ww = wordWidth dflags\n                      jumpTableEntryRel Nothing\n                          = CmmStaticLit (CmmInt 0 ww)\n                      jumpTableEntryRel (Just blockid)\n                          = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0 ww)\n                          where blockLabel = blockLbl blockid\n                  in map jumpTableEntryRel ids\n            | otherwise = map (jumpTableEntry dflags) ids\n      in CmmData section (1, Statics lbl jumpTable)\n\nextractUnwindPoints :: [Instr] -> [UnwindPoint]\nextractUnwindPoints instrs =\n    [ UnwindPoint lbl unwinds | UNWIND lbl unwinds <- instrs]\n\n-- -----------------------------------------------------------------------------\n-- 'condIntReg' and 'condFltReg': condition codes into registers\n\n-- Turn those condition codes into integers now (when they appear on\n-- the right hand side of an assignment).\n--\n-- (If applicable) Do not fill the delay slots here; you will confuse the\n-- register allocator.\n\ncondIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register\n\ncondIntReg cond x y = do\n  CondCode _ cond cond_code <- condIntCode cond x y\n  tmp <- getNewRegNat II8\n  let\n        code dst = cond_code `appOL` toOL [\n                    SETCC cond (OpReg tmp),\n                    MOVZxL II8 (OpReg tmp) (OpReg dst)\n                  ]\n  return (Any II32 code)\n\n\n-----------------------------------------------------------\n---          Note [SSE Parity Checks]                   ---\n-----------------------------------------------------------\n\n-- We have to worry about unordered operands (eg. comparisons\n-- against NaN).  If the operands are unordered, the comparison\n-- sets the parity flag, carry flag and zero flag.\n-- All comparisons are supposed to return false for unordered\n-- operands except for !=, which returns true.\n--\n-- Optimisation: we don't have to test the parity flag if we\n-- know the test has already excluded the unordered case: eg >\n-- and >= test for a zero carry flag, which can only occur for\n-- ordered operands.\n--\n-- By reversing comparisons we can avoid testing the parity\n-- for < and <= as well. If any of the arguments is an NaN we\n-- return false either way. If both arguments are valid then\n-- x <= y  <->  y >= x  holds. So it's safe to swap these.\n--\n-- We invert the condition inside getRegister'and  getCondCode\n-- which should cover all invertable cases.\n-- All other functions translating FP comparisons to assembly\n-- use these to two generate the comparison code.\n--\n-- As an example consider a simple check:\n--\n-- func :: Float -> Float -> Int\n-- func x y = if x < y then 1 else 0\n--\n-- Which in Cmm gives the floating point comparison.\n--\n--  if (%MO_F_Lt_W32(F1, F2)) goto c2gg; else goto c2gf;\n--\n-- We used to compile this to an assembly code block like this:\n-- _c2gh:\n--  ucomiss %xmm2,%xmm1\n--  jp _c2gf\n--  jb _c2gg\n--  jmp _c2gf\n--\n-- Where we have to introduce an explicit\n-- check for unordered results (using jmp parity):\n--\n-- We can avoid this by exchanging the arguments and inverting the direction\n-- of the comparison. This results in the sequence of:\n--\n--  ucomiss %xmm1,%xmm2\n--  ja _c2g2\n--  jmp _c2g1\n--\n-- Removing the jump reduces the pressure on the branch predidiction system\n-- and plays better with the uOP cache.\n\ncondFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register\ncondFltReg is32Bit cond x y = if_sse2 condFltReg_sse2 condFltReg_x87\n where\n  condFltReg_x87 = do\n    CondCode _ cond cond_code <- condFltCode cond x y\n    tmp <- getNewRegNat II8\n    let\n        code dst = cond_code `appOL` toOL [\n                    SETCC cond (OpReg tmp),\n                    MOVZxL II8 (OpReg tmp) (OpReg dst)\n                  ]\n    return (Any II32 code)\n\n  condFltReg_sse2 = do\n    CondCode _ cond cond_code <- condFltCode cond x y\n    tmp1 <- getNewRegNat (archWordFormat is32Bit)\n    tmp2 <- getNewRegNat (archWordFormat is32Bit)\n    let -- See Note [SSE Parity Checks]\n        code dst =\n           cond_code `appOL`\n             (case cond of\n                NE  -> or_unordered dst\n                GU  -> plain_test   dst\n                GEU -> plain_test   dst\n                -- Use ASSERT so we don't break releases if these creep in.\n                LTT -> ASSERT2(False, ppr \"Should have been turned into >\")\n                       and_ordered  dst\n                LE  -> ASSERT2(False, ppr \"Should have been turned into >=\")\n                       and_ordered  dst\n                _   -> and_ordered  dst)\n\n        plain_test dst = toOL [\n                    SETCC cond (OpReg tmp1),\n                    MOVZxL II8 (OpReg tmp1) (OpReg dst)\n                 ]\n        or_unordered dst = toOL [\n                    SETCC cond (OpReg tmp1),\n                    SETCC PARITY (OpReg tmp2),\n                    OR II8 (OpReg tmp1) (OpReg tmp2),\n                    MOVZxL II8 (OpReg tmp2) (OpReg dst)\n                  ]\n        and_ordered dst = toOL [\n                    SETCC cond (OpReg tmp1),\n                    SETCC NOTPARITY (OpReg tmp2),\n                    AND II8 (OpReg tmp1) (OpReg tmp2),\n                    MOVZxL II8 (OpReg tmp2) (OpReg dst)\n                  ]\n    return (Any II32 code)\n\n\n-- -----------------------------------------------------------------------------\n-- 'trivial*Code': deal with trivial instructions\n\n-- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',\n-- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.\n-- Only look for constants on the right hand side, because that's\n-- where the generic optimizer will have put them.\n\n-- Similarly, for unary instructions, we don't have to worry about\n-- matching an StInt as the argument, because genericOpt will already\n-- have handled the constant-folding.\n\n\n{-\nThe Rules of the Game are:\n\n* You cannot assume anything about the destination register dst;\n  it may be anything, including a fixed reg.\n\n* You may compute an operand into a fixed reg, but you may not\n  subsequently change the contents of that fixed reg.  If you\n  want to do so, first copy the value either to a temporary\n  or into dst.  You are free to modify dst even if it happens\n  to be a fixed reg -- that's not your problem.\n\n* You cannot assume that a fixed reg will stay live over an\n  arbitrary computation.  The same applies to the dst reg.\n\n* Temporary regs obtained from getNewRegNat are distinct from\n  each other and from all other regs, and stay live over\n  arbitrary computations.\n\n--------------------\n\nSDM's version of The Rules:\n\n* If getRegister returns Any, that means it can generate correct\n  code which places the result in any register, period.  Even if that\n  register happens to be read during the computation.\n\n  Corollary #1: this means that if you are generating code for an\n  operation with two arbitrary operands, you cannot assign the result\n  of the first operand into the destination register before computing\n  the second operand.  The second operand might require the old value\n  of the destination register.\n\n  Corollary #2: A function might be able to generate more efficient\n  code if it knows the destination register is a new temporary (and\n  therefore not read by any of the sub-computations).\n\n* If getRegister returns Any, then the code it generates may modify only:\n        (a) fresh temporaries\n        (b) the destination register\n        (c) known registers (eg. %ecx is used by shifts)\n  In particular, it may *not* modify global registers, unless the global\n  register happens to be the destination register.\n-}\n\ntrivialCode :: Width -> (Operand -> Operand -> Instr)\n            -> Maybe (Operand -> Operand -> Instr)\n            -> CmmExpr -> CmmExpr -> NatM Register\ntrivialCode width instr m a b\n    = do is32Bit <- is32BitPlatform\n         trivialCode' is32Bit width instr m a b\n\ntrivialCode' :: Bool -> Width -> (Operand -> Operand -> Instr)\n             -> Maybe (Operand -> Operand -> Instr)\n             -> CmmExpr -> CmmExpr -> NatM Register\ntrivialCode' is32Bit width _ (Just revinstr) (CmmLit lit_a) b\n  | is32BitLit is32Bit lit_a = do\n  b_code <- getAnyReg b\n  let\n       code dst\n         = b_code dst `snocOL`\n           revinstr (OpImm (litToImm lit_a)) (OpReg dst)\n  return (Any (intFormat width) code)\n\ntrivialCode' _ width instr _ a b\n  = genTrivialCode (intFormat width) instr a b\n\n-- This is re-used for floating pt instructions too.\ngenTrivialCode :: Format -> (Operand -> Operand -> Instr)\n               -> CmmExpr -> CmmExpr -> NatM Register\ngenTrivialCode rep instr a b = do\n  (b_op, b_code) <- getNonClobberedOperand b\n  a_code <- getAnyReg a\n  tmp <- getNewRegNat rep\n  let\n     -- We want the value of b to stay alive across the computation of a.\n     -- But, we want to calculate a straight into the destination register,\n     -- because the instruction only has two operands (dst := dst `op` src).\n     -- The troublesome case is when the result of b is in the same register\n     -- as the destination reg.  In this case, we have to save b in a\n     -- new temporary across the computation of a.\n     code dst\n        | dst `regClashesWithOp` b_op =\n                b_code `appOL`\n                unitOL (MOV rep b_op (OpReg tmp)) `appOL`\n                a_code dst `snocOL`\n                instr (OpReg tmp) (OpReg dst)\n        | otherwise =\n                b_code `appOL`\n                a_code dst `snocOL`\n                instr b_op (OpReg dst)\n  return (Any rep code)\n\nregClashesWithOp :: Reg -> Operand -> Bool\nreg `regClashesWithOp` OpReg reg2   = reg == reg2\nreg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode)\n_   `regClashesWithOp` _            = False\n\n-----------\n\ntrivialUCode :: Format -> (Operand -> Instr)\n             -> CmmExpr -> NatM Register\ntrivialUCode rep instr x = do\n  x_code <- getAnyReg x\n  let\n     code dst =\n        x_code dst `snocOL`\n        instr (OpReg dst)\n  return (Any rep code)\n\n-----------\n\ntrivialFCode_x87 :: (Format -> Reg -> Reg -> Reg -> Instr)\n                 -> CmmExpr -> CmmExpr -> NatM Register\ntrivialFCode_x87 instr x y = do\n  (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too\n  (y_reg, y_code) <- getSomeReg y\n  let\n     format = FF80 -- always, on x87\n     code dst =\n        x_code `appOL`\n        y_code `snocOL`\n        instr format x_reg y_reg dst\n  return (Any format code)\n\ntrivialFCode_sse2 :: Width -> (Format -> Operand -> Operand -> Instr)\n                  -> CmmExpr -> CmmExpr -> NatM Register\ntrivialFCode_sse2 pk instr x y\n    = genTrivialCode format (instr format) x y\n    where format = floatFormat pk\n\n\ntrivialUFCode :: Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register\ntrivialUFCode format instr x = do\n  (x_reg, x_code) <- getSomeReg x\n  let\n     code dst =\n        x_code `snocOL`\n        instr x_reg dst\n  return (Any format code)\n\n\n--------------------------------------------------------------------------------\ncoerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register\ncoerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87\n where\n   coerce_x87 = do\n     (x_reg, x_code) <- getSomeReg x\n     let\n           opc  = case to of W32 -> GITOF; W64 -> GITOD;\n                             n -> panic $ \"coerceInt2FP.x87: unhandled width (\"\n                                         ++ show n ++ \")\"\n           code dst = x_code `snocOL` opc x_reg dst\n        -- ToDo: works for non-II32 reps?\n     return (Any FF80 code)\n\n   coerce_sse2 = do\n     (x_op, x_code) <- getOperand x  -- ToDo: could be a safe operand\n     let\n           opc  = case to of W32 -> CVTSI2SS; W64 -> CVTSI2SD\n                             n -> panic $ \"coerceInt2FP.sse: unhandled width (\"\n                                         ++ show n ++ \")\"\n           code dst = x_code `snocOL` opc (intFormat from) x_op dst\n     return (Any (floatFormat to) code)\n        -- works even if the destination rep is <II32\n\n--------------------------------------------------------------------------------\ncoerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register\ncoerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87\n where\n   coerceFP2Int_x87 = do\n     (x_reg, x_code) <- getSomeReg x\n     let\n           opc  = case from of W32 -> GFTOI; W64 -> GDTOI\n                               n -> panic $ \"coerceFP2Int.x87: unhandled width (\"\n                                           ++ show n ++ \")\"\n           code dst = x_code `snocOL` opc x_reg dst\n        -- ToDo: works for non-II32 reps?\n     return (Any (intFormat to) code)\n\n   coerceFP2Int_sse2 = do\n     (x_op, x_code) <- getOperand x  -- ToDo: could be a safe operand\n     let\n           opc  = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ;\n                               n -> panic $ \"coerceFP2Init.sse: unhandled width (\"\n                                           ++ show n ++ \")\"\n           code dst = x_code `snocOL` opc (intFormat to) x_op dst\n     return (Any (intFormat to) code)\n         -- works even if the destination rep is <II32\n\n\n--------------------------------------------------------------------------------\ncoerceFP2FP :: Width -> CmmExpr -> NatM Register\ncoerceFP2FP to x = do\n  use_sse2 <- sse2Enabled\n  (x_reg, x_code) <- getSomeReg x\n  let\n        opc | use_sse2  = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD;\n                                     n -> panic $ \"coerceFP2FP: unhandled width (\"\n                                                 ++ show n ++ \")\"\n            | otherwise = GDTOF\n        code dst = x_code `snocOL` opc x_reg dst\n  return (Any (if use_sse2 then floatFormat to else FF80) code)\n\n--------------------------------------------------------------------------------\n\nsse2NegCode :: Width -> CmmExpr -> NatM Register\nsse2NegCode w x = do\n  let fmt = floatFormat w\n  x_code <- getAnyReg x\n  -- This is how gcc does it, so it can't be that bad:\n  let\n    const = case fmt of\n      FF32 -> CmmInt 0x80000000 W32\n      FF64 -> CmmInt 0x8000000000000000 W64\n      x@II8  -> wrongFmt x\n      x@II16 -> wrongFmt x\n      x@II32 -> wrongFmt x\n      x@II64 -> wrongFmt x\n      x@FF80 -> wrongFmt x\n      where\n        wrongFmt x = panic $ \"sse2NegCode: \" ++ show x\n  Amode amode amode_code <- memConstant (widthInBytes w) const\n  tmp <- getNewRegNat fmt\n  let\n    code dst = x_code dst `appOL` amode_code `appOL` toOL [\n        MOV fmt (OpAddr amode) (OpReg tmp),\n        XOR fmt (OpReg tmp) (OpReg dst)\n        ]\n  --\n  return (Any fmt code)\n\nisVecExpr :: CmmExpr -> Bool\nisVecExpr (CmmMachOp (MO_V_Insert {}) _)   = True\nisVecExpr (CmmMachOp (MO_V_Extract {}) _)  = True\nisVecExpr (CmmMachOp (MO_V_Add {}) _)      = True\nisVecExpr (CmmMachOp (MO_V_Sub {}) _)      = True\nisVecExpr (CmmMachOp (MO_V_Mul {}) _)      = True\nisVecExpr (CmmMachOp (MO_VS_Quot {}) _)    = True\nisVecExpr (CmmMachOp (MO_VS_Rem {}) _)     = True\nisVecExpr (CmmMachOp (MO_VS_Neg {}) _)     = True\nisVecExpr (CmmMachOp (MO_VF_Insert {}) _)  = True\nisVecExpr (CmmMachOp (MO_VF_Extract {}) _) = True\nisVecExpr (CmmMachOp (MO_VF_Add {}) _)     = True\nisVecExpr (CmmMachOp (MO_VF_Sub {}) _)     = True\nisVecExpr (CmmMachOp (MO_VF_Mul {}) _)     = True\nisVecExpr (CmmMachOp (MO_VF_Quot {}) _)    = True\nisVecExpr (CmmMachOp (MO_VF_Neg {}) _)     = True\nisVecExpr (CmmMachOp _ [e])                = isVecExpr e\nisVecExpr _                                = False\n\nneedLlvm :: NatM a\nneedLlvm =\n    sorry $ unlines [\"The native code generator does not support vector\"\n                    ,\"instructions. Please use -fllvm.\"]\n\n-- | This works on the invariant that all jumps in the given blocks are required.\n--   Starting from there we try to make a few more jumps redundant by reordering\n--   them.\ninvertCondBranches :: CFG -> LabelMap a -> [NatBasicBlock Instr]\n                   -> [NatBasicBlock Instr]\ninvertCondBranches cfg keep bs =\n    --trace \"Foo\" $\n    invert bs\n  where\n    invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]\n    invert ((BasicBlock lbl1 ins@(_:_:_xs)):b2@(BasicBlock lbl2 _):bs)\n      | --pprTrace \"Block\" (ppr lbl1) True,\n        (jmp1,jmp2) <- last2 ins\n      , JXX cond1 target1 <- jmp1\n      , target1 == lbl2\n      --, pprTrace \"CutChance\" (ppr b1) True\n      , JXX ALWAYS target2 <- jmp2\n      -- We have enough information to check if we can perform the inversion\n      -- TODO: We could also check for the last asm instruction which sets\n      -- status flags instead. Which I suspect is worse in terms of compiler\n      -- performance, but might be applicable to more cases\n      , Just edgeInfo1 <- getEdgeInfo lbl1 target1 cfg\n      , Just edgeInfo2 <- getEdgeInfo lbl1 target2 cfg\n      -- Both jumps come from the same cmm statement\n      , transitionSource edgeInfo1 == transitionSource edgeInfo2\n      , (CmmSource cmmCondBranch) <- transitionSource edgeInfo1\n\n      --Int comparisons are invertable\n      , CmmCondBranch (CmmMachOp op _args) _ _ _ <- cmmCondBranch\n      , Just _ <- maybeIntComparison op\n      , Just invCond <- maybeInvertCond cond1\n\n      --Swap the last two jumps, invert the conditional jumps condition.\n      = let jumps =\n              case () of\n                -- We are free the eliminate the jmp. So we do so.\n                _ | not (mapMember target1 keep)\n                    -> [JXX invCond target2]\n                -- If the conditional target is unlikely we put the other\n                -- target at the front.\n                  | edgeWeight edgeInfo2 > edgeWeight edgeInfo1\n                    -> [JXX invCond target2, JXX ALWAYS target1]\n                -- Keep things as-is otherwise\n                  | otherwise\n                    -> [jmp1, jmp2]\n        in --pprTrace \"Cutable\" (ppr [jmp1,jmp2] <+> text \"=>\" <+> ppr jumps) $\n           (BasicBlock lbl1\n            (dropTail 2 ins ++ jumps))\n            : invert (b2:bs)\n    invert (b:bs) = b : invert bs\n    invert [] = []\n", "num_lines": 3502}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module X86.Cond (\n        Cond(..),\n        condUnsigned,\n        condToSigned,\n        condToUnsigned,\n        maybeFlipCond,\n        maybeInvertCond\n)\n\nwhere\n\nimport GhcPrelude\n\ndata Cond\n        = ALWAYS        -- What's really used? ToDo\n        | EQQ\n        | GE\n        | GEU\n        | GTT\n        | GU\n        | LE\n        | LEU\n        | LTT\n        | LU\n        | NE\n        | NEG\n        | POS\n        | CARRY\n        | OFLO\n        | PARITY\n        | NOTPARITY\n        deriving Eq\n\ncondUnsigned :: Cond -> Bool\ncondUnsigned GU  = True\ncondUnsigned LU  = True\ncondUnsigned GEU = True\ncondUnsigned LEU = True\ncondUnsigned _   = False\n\n\ncondToSigned :: Cond -> Cond\ncondToSigned GU  = GTT\ncondToSigned LU  = LTT\ncondToSigned GEU = GE\ncondToSigned LEU = LE\ncondToSigned x   = x\n\n\ncondToUnsigned :: Cond -> Cond\ncondToUnsigned GTT = GU\ncondToUnsigned LTT = LU\ncondToUnsigned GE  = GEU\ncondToUnsigned LE  = LEU\ncondToUnsigned x   = x\n\n-- | @maybeFlipCond c@ returns @Just c'@ if it is possible to flip the\n-- arguments to the conditional @c@, and the new condition should be @c'@.\nmaybeFlipCond :: Cond -> Maybe Cond\nmaybeFlipCond cond  = case cond of\n        EQQ   -> Just EQQ\n        NE    -> Just NE\n        LU    -> Just GU\n        GU    -> Just LU\n        LEU   -> Just GEU\n        GEU   -> Just LEU\n        LTT   -> Just GTT\n        GTT   -> Just LTT\n        LE    -> Just GE\n        GE    -> Just LE\n        _other -> Nothing\n\n-- | If we apply @maybeInvertCond@ to the condition of a jump we turn\n-- jumps taken into jumps not taken and vice versa.\n--\n-- Careful! If the used comparison and the conditional jump\n-- don't match the above behaviour will NOT hold.\n-- When used for FP comparisons this does not consider unordered\n-- numbers.\n-- Also inverting twice might return a synonym for the original condition.\nmaybeInvertCond :: Cond -> Maybe Cond\nmaybeInvertCond cond  = case cond of\n        ALWAYS  -> Nothing\n        EQQ     -> Just NE\n        NE      -> Just EQQ\n\n        NEG     -> Just POS\n        POS     -> Just NEG\n\n        GEU     -> Just LU\n        LU      -> Just GEU\n\n        GE      -> Just LTT\n        LTT     -> Just GE\n\n        GTT     -> Just LE\n        LE      -> Just GTT\n\n        GU      -> Just LEU\n        LEU     -> Just GU\n\n        --GEU \"==\" NOTCARRY, they are synonyms\n        --at the assembly level\n        CARRY   -> Just GEU\n\n        OFLO    -> Nothing\n\n        PARITY  -> Just NOTPARITY\n        NOTPARITY -> Just PARITY\n", "num_lines": 110}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, TypeFamilies #-}\n\n-----------------------------------------------------------------------------\n--\n-- Machine-dependent assembly language\n--\n-- (c) The University of Glasgow 1993-2004\n--\n-----------------------------------------------------------------------------\n\nmodule X86.Instr (Instr(..), Operand(..), PrefetchVariant(..), JumpDest(..),\n                  getJumpDestBlockId, canShortcut, shortcutStatics,\n                  shortcutJump, i386_insert_ffrees, allocMoreStack,\n                  maxSpillSlots, archWordFormat )\nwhere\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n\nimport GhcPrelude\n\nimport X86.Cond\nimport X86.Regs\nimport Instruction\nimport Format\nimport RegClass\nimport Reg\nimport TargetReg\n\nimport BlockId\nimport Hoopl.Collections\nimport Hoopl.Label\nimport CodeGen.Platform\nimport Cmm\nimport FastString\nimport Outputable\nimport Platform\n\nimport BasicTypes       (Alignment)\nimport CLabel\nimport DynFlags\nimport UniqSet\nimport Unique\nimport UniqSupply\nimport Debug (UnwindTable)\n\nimport Control.Monad\nimport Data.Maybe       (fromMaybe)\n\n-- Format of an x86/x86_64 memory address, in bytes.\n--\narchWordFormat :: Bool -> Format\narchWordFormat is32Bit\n | is32Bit   = II32\n | otherwise = II64\n\n-- | Instruction instance for x86 instruction set.\ninstance Instruction Instr where\n        regUsageOfInstr         = x86_regUsageOfInstr\n        patchRegsOfInstr        = x86_patchRegsOfInstr\n        isJumpishInstr          = x86_isJumpishInstr\n        jumpDestsOfInstr        = x86_jumpDestsOfInstr\n        patchJumpInstr          = x86_patchJumpInstr\n        mkSpillInstr            = x86_mkSpillInstr\n        mkLoadInstr             = x86_mkLoadInstr\n        takeDeltaInstr          = x86_takeDeltaInstr\n        isMetaInstr             = x86_isMetaInstr\n        mkRegRegMoveInstr       = x86_mkRegRegMoveInstr\n        takeRegRegMoveInstr     = x86_takeRegRegMoveInstr\n        mkJumpInstr             = x86_mkJumpInstr\n        mkStackAllocInstr       = x86_mkStackAllocInstr\n        mkStackDeallocInstr     = x86_mkStackDeallocInstr\n\n\n-- -----------------------------------------------------------------------------\n-- Intel x86 instructions\n\n{-\nIntel, in their infinite wisdom, selected a stack model for floating\npoint registers on x86.  That might have made sense back in 1979 --\nnowadays we can see it for the nonsense it really is.  A stack model\nfits poorly with the existing nativeGen infrastructure, which assumes\nflat integer and FP register sets.  Prior to this commit, nativeGen\ncould not generate correct x86 FP code -- to do so would have meant\nsomehow working the register-stack paradigm into the register\nallocator and spiller, which sounds very difficult.\n\nWe have decided to cheat, and go for a simple fix which requires no\ninfrastructure modifications, at the expense of generating ropey but\ncorrect FP code.  All notions of the x86 FP stack and its insns have\nbeen removed.  Instead, we pretend (to the instruction selector and\nregister allocator) that x86 has six floating point registers, %fake0\n.. %fake5, which can be used in the usual flat manner.  We further\nclaim that x86 has floating point instructions very similar to SPARC\nand Alpha, that is, a simple 3-operand register-register arrangement.\nCode generation and register allocation proceed on this basis.\n\nWhen we come to print out the final assembly, our convenient fiction\nis converted to dismal reality.  Each fake instruction is\nindependently converted to a series of real x86 instructions.\n%fake0 .. %fake5 are mapped to %st(0) .. %st(5).  To do reg-reg\narithmetic operations, the two operands are pushed onto the top of the\nFP stack, the operation done, and the result copied back into the\nrelevant register.  There are only six %fake registers because 2 are\nneeded for the translation, and x86 has 8 in total.\n\nThe translation is inefficient but is simple and it works.  A cleverer\ntranslation would handle a sequence of insns, simulating the FP stack\ncontents, would not impose a fixed mapping from %fake to %st regs, and\nhopefully could avoid most of the redundant reg-reg moves of the\ncurrent translation.\n\nWe might as well make use of whatever unique FP facilities Intel have\nchosen to bless us with (let's not be churlish, after all).\nHence GLDZ and GLD1.  Bwahahahahahahaha!\n-}\n\n{-\nNote [x86 Floating point precision]\n\nIntel's internal floating point registers are by default 80 bit\nextended precision.  This means that all operations done on values in\nregisters are done at 80 bits, and unless the intermediate values are\ntruncated to the appropriate size (32 or 64 bits) by storing in\nmemory, calculations in registers will give different results from\ncalculations which pass intermediate values in memory (eg. via\nfunction calls).\n\nOne solution is to set the FPU into 64 bit precision mode.  Some OSs\ndo this (eg. FreeBSD) and some don't (eg. Linux).  The problem here is\nthat this will only affect 64-bit precision arithmetic; 32-bit\ncalculations will still be done at 64-bit precision in registers.  So\nit doesn't solve the whole problem.\n\nThere's also the issue of what the C library is expecting in terms of\nprecision.  It seems to be the case that glibc on Linux expects the\nFPU to be set to 80 bit precision, so setting it to 64 bit could have\nunexpected effects.  Changing the default could have undesirable\neffects on other 3rd-party library code too, so the right thing would\nbe to save/restore the FPU control word across Haskell code if we were\nto do this.\n\ngcc's -ffloat-store gives consistent results by always storing the\nresults of floating-point calculations in memory, which works for both\n32 and 64-bit precision.  However, it only affects the values of\nuser-declared floating point variables in C, not intermediate results.\nGHC in -fvia-C mode uses -ffloat-store (see the -fexcess-precision\nflag).\n\nAnother problem is how to spill floating point registers in the\nregister allocator.  Should we spill the whole 80 bits, or just 64?\nOn an OS which is set to 64 bit precision, spilling 64 is fine.  On\nLinux, spilling 64 bits will round the results of some operations.\nThis is what gcc does.  Spilling at 80 bits requires taking up a full\n128 bit slot (so we get alignment).  We spill at 80-bits and ignore\nthe alignment problems.\n\nIn the future [edit: now available in GHC 7.0.1, with the -msse2\nflag], we'll use the SSE registers for floating point.  This requires\na CPU that supports SSE2 (ordinary SSE only supports 32 bit precision\nfloat ops), which means P4 or Xeon and above.  Using SSE will solve\nall these problems, because the SSE registers use fixed 32 bit or 64\nbit precision.\n\n--SDM 1/2003\n-}\n\ndata Instr\n        -- comment pseudo-op\n        = COMMENT FastString\n\n        -- location pseudo-op (file, line, col, name)\n        | LOCATION Int Int Int String\n\n        -- some static data spat out during code\n        -- generation.  Will be extracted before\n        -- pretty-printing.\n        | LDATA   Section (Alignment, CmmStatics)\n\n        -- start a new basic block.  Useful during\n        -- codegen, removed later.  Preceding\n        -- instruction should be a jump, as per the\n        -- invariants for a BasicBlock (see Cmm).\n        | NEWBLOCK BlockId\n\n        -- unwinding information\n        -- See Note [Unwinding information in the NCG].\n        | UNWIND CLabel UnwindTable\n\n        -- specify current stack offset for benefit of subsequent passes.\n        -- This carries a BlockId so it can be used in unwinding information.\n        | DELTA  Int\n\n        -- Moves.\n        | MOV         Format Operand Operand\n        | CMOV   Cond Format Operand Reg\n        | MOVZxL      Format Operand Operand -- format is the size of operand 1\n        | MOVSxL      Format Operand Operand -- format is the size of operand 1\n        -- x86_64 note: plain mov into a 32-bit register always zero-extends\n        -- into the 64-bit reg, in contrast to the 8 and 16-bit movs which\n        -- don't affect the high bits of the register.\n\n        -- Load effective address (also a very useful three-operand add instruction :-)\n        | LEA         Format Operand Operand\n\n        -- Int Arithmetic.\n        | ADD         Format Operand Operand\n        | ADC         Format Operand Operand\n        | SUB         Format Operand Operand\n        | SBB         Format Operand Operand\n\n        | MUL         Format Operand Operand\n        | MUL2        Format Operand         -- %edx:%eax = operand * %rax\n        | IMUL        Format Operand Operand -- signed int mul\n        | IMUL2       Format Operand         -- %edx:%eax = operand * %eax\n\n        | DIV         Format Operand         -- eax := eax:edx/op, edx := eax:edx%op\n        | IDIV        Format Operand         -- ditto, but signed\n\n        -- Int Arithmetic, where the effects on the condition register\n        -- are important. Used in specialized sequences such as MO_Add2.\n        -- Do not rewrite these instructions to \"equivalent\" ones that\n        -- have different effect on the condition register! (See #9013.)\n        | ADD_CC      Format Operand Operand\n        | SUB_CC      Format Operand Operand\n\n        -- Simple bit-twiddling.\n        | AND         Format Operand Operand\n        | OR          Format Operand Operand\n        | XOR         Format Operand Operand\n        | NOT         Format Operand\n        | NEGI        Format Operand         -- NEG instruction (name clash with Cond)\n        | BSWAP       Format Reg\n\n        -- Shifts (amount may be immediate or %cl only)\n        | SHL         Format Operand{-amount-} Operand\n        | SAR         Format Operand{-amount-} Operand\n        | SHR         Format Operand{-amount-} Operand\n\n        | BT          Format Imm Operand\n        | NOP\n\n        -- x86 Float Arithmetic.\n        -- Note that we cheat by treating G{ABS,MOV,NEG} of doubles\n        -- as single instructions right up until we spit them out.\n        -- all the 3-operand fake fp insns are src1 src2 dst\n        -- and furthermore are constrained to be fp regs only.\n        -- IMPORTANT: keep is_G_insn up to date with any changes here\n        | GMOV        Reg Reg -- src(fpreg), dst(fpreg)\n        | GLD         Format AddrMode Reg -- src, dst(fpreg)\n        | GST         Format Reg AddrMode -- src(fpreg), dst\n\n        | GLDZ        Reg -- dst(fpreg)\n        | GLD1        Reg -- dst(fpreg)\n\n        | GFTOI       Reg Reg -- src(fpreg), dst(intreg)\n        | GDTOI       Reg Reg -- src(fpreg), dst(intreg)\n\n        | GITOF       Reg Reg -- src(intreg), dst(fpreg)\n        | GITOD       Reg Reg -- src(intreg), dst(fpreg)\n\n        | GDTOF       Reg Reg -- src(fpreg), dst(fpreg)\n\n        | GADD        Format Reg Reg Reg -- src1, src2, dst\n        | GDIV        Format Reg Reg Reg -- src1, src2, dst\n        | GSUB        Format Reg Reg Reg -- src1, src2, dst\n        | GMUL        Format Reg Reg Reg -- src1, src2, dst\n\n                -- FP compare.  Cond must be `elem` [EQQ, NE, LE, LTT, GE, GTT]\n                -- Compare src1 with src2; set the Zero flag iff the numbers are\n                -- comparable and the comparison is True.  Subsequent code must\n                -- test the %eflags zero flag regardless of the supplied Cond.\n        | GCMP        Cond Reg Reg -- src1, src2\n\n        | GABS        Format Reg Reg -- src, dst\n        | GNEG        Format Reg Reg -- src, dst\n        | GSQRT       Format Reg Reg -- src, dst\n        | GSIN        Format CLabel CLabel Reg Reg -- src, dst\n        | GCOS        Format CLabel CLabel Reg Reg -- src, dst\n        | GTAN        Format CLabel CLabel Reg Reg -- src, dst\n\n        | GFREE         -- do ffree on all x86 regs; an ugly hack\n\n\n        -- SSE2 floating point: we use a restricted set of the available SSE2\n        -- instructions for floating-point.\n        -- use MOV for moving (either movss or movsd (movlpd better?))\n        | CVTSS2SD      Reg Reg            -- F32 to F64\n        | CVTSD2SS      Reg Reg            -- F64 to F32\n        | CVTTSS2SIQ    Format Operand Reg -- F32 to I32/I64 (with truncation)\n        | CVTTSD2SIQ    Format Operand Reg -- F64 to I32/I64 (with truncation)\n        | CVTSI2SS      Format Operand Reg -- I32/I64 to F32\n        | CVTSI2SD      Format Operand Reg -- I32/I64 to F64\n\n        -- use ADD, SUB, and SQRT for arithmetic.  In both cases, operands\n        -- are  Operand Reg.\n\n        -- SSE2 floating-point division:\n        | FDIV          Format Operand Operand   -- divisor, dividend(dst)\n\n        -- use CMP for comparisons.  ucomiss and ucomisd instructions\n        -- compare single/double prec floating point respectively.\n\n        | SQRT          Format Operand Reg      -- src, dst\n\n\n        -- Comparison\n        | TEST          Format Operand Operand\n        | CMP           Format Operand Operand\n        | SETCC         Cond Operand\n\n        -- Stack Operations.\n        | PUSH          Format Operand\n        | POP           Format Operand\n        -- both unused (SDM):\n        --  | PUSHA\n        --  | POPA\n\n        -- Jumping around.\n        | JMP         Operand [Reg] -- including live Regs at the call\n        | JXX         Cond BlockId  -- includes unconditional branches\n        | JXX_GBL     Cond Imm      -- non-local version of JXX\n        -- Table jump\n        | JMP_TBL     Operand   -- Address to jump to\n                      [Maybe JumpDest] -- Targets of the jump table\n                      Section   -- Data section jump table should be put in\n                      CLabel    -- Label of jump table\n        | CALL        (Either Imm Reg) [Reg]\n\n        -- Other things.\n        | CLTD Format            -- sign extend %eax into %edx:%eax\n\n        | FETCHGOT    Reg        -- pseudo-insn for ELF position-independent code\n                                 -- pretty-prints as\n                                 --       call 1f\n                                 -- 1:    popl %reg\n                                 --       addl __GLOBAL_OFFSET_TABLE__+.-1b, %reg\n        | FETCHPC     Reg        -- pseudo-insn for Darwin position-independent code\n                                 -- pretty-prints as\n                                 --       call 1f\n                                 -- 1:    popl %reg\n\n    -- bit counting instructions\n        | POPCNT      Format Operand Reg -- [SSE4.2] count number of bits set to 1\n        | LZCNT       Format Operand Reg -- [BMI2] count number of leading zeros\n        | TZCNT       Format Operand Reg -- [BMI2] count number of trailing zeros\n        | BSF         Format Operand Reg -- bit scan forward\n        | BSR         Format Operand Reg -- bit scan reverse\n\n    -- bit manipulation instructions\n        | PDEP        Format Operand Operand Reg -- [BMI2] deposit bits to   the specified mask\n        | PEXT        Format Operand Operand Reg -- [BMI2] extract bits from the specified mask\n\n    -- prefetch\n        | PREFETCH  PrefetchVariant Format Operand -- prefetch Variant, addr size, address to prefetch\n                                        -- variant can be NTA, Lvl0, Lvl1, or Lvl2\n\n        | LOCK        Instr -- lock prefix\n        | XADD        Format Operand Operand -- src (r), dst (r/m)\n        | CMPXCHG     Format Operand Operand -- src (r), dst (r/m), eax implicit\n        | MFENCE\n\ndata PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2\n\n\ndata Operand\n        = OpReg  Reg            -- register\n        | OpImm  Imm            -- immediate value\n        | OpAddr AddrMode       -- memory reference\n\n\n\n-- | Returns which registers are read and written as a (read, written)\n-- pair.\nx86_regUsageOfInstr :: Platform -> Instr -> RegUsage\nx86_regUsageOfInstr platform instr\n = case instr of\n    MOV    _ src dst    -> usageRW src dst\n    CMOV _ _ src dst    -> mkRU (use_R src [dst]) [dst]\n    MOVZxL _ src dst    -> usageRW src dst\n    MOVSxL _ src dst    -> usageRW src dst\n    LEA    _ src dst    -> usageRW src dst\n    ADD    _ src dst    -> usageRM src dst\n    ADC    _ src dst    -> usageRM src dst\n    SUB    _ src dst    -> usageRM src dst\n    SBB    _ src dst    -> usageRM src dst\n    IMUL   _ src dst    -> usageRM src dst\n\n    -- Result of IMULB will be in just in %ax\n    IMUL2  II8 src       -> mkRU (eax:use_R src []) [eax]\n    -- Result of IMUL for wider values, will be split between %dx/%edx/%rdx and\n    -- %ax/%eax/%rax.\n    IMUL2  _ src        -> mkRU (eax:use_R src []) [eax,edx]\n\n    MUL    _ src dst    -> usageRM src dst\n    MUL2   _ src        -> mkRU (eax:use_R src []) [eax,edx]\n    DIV    _ op -> mkRU (eax:edx:use_R op []) [eax,edx]\n    IDIV   _ op -> mkRU (eax:edx:use_R op []) [eax,edx]\n    ADD_CC _ src dst    -> usageRM src dst\n    SUB_CC _ src dst    -> usageRM src dst\n    AND    _ src dst    -> usageRM src dst\n    OR     _ src dst    -> usageRM src dst\n\n    XOR    _ (OpReg src) (OpReg dst)\n        | src == dst    -> mkRU [] [dst]\n\n    XOR    _ src dst    -> usageRM src dst\n    NOT    _ op         -> usageM op\n    BSWAP  _ reg        -> mkRU [reg] [reg]\n    NEGI   _ op         -> usageM op\n    SHL    _ imm dst    -> usageRM imm dst\n    SAR    _ imm dst    -> usageRM imm dst\n    SHR    _ imm dst    -> usageRM imm dst\n    BT     _ _   src    -> mkRUR (use_R src [])\n\n    PUSH   _ op         -> mkRUR (use_R op [])\n    POP    _ op         -> mkRU [] (def_W op)\n    TEST   _ src dst    -> mkRUR (use_R src $! use_R dst [])\n    CMP    _ src dst    -> mkRUR (use_R src $! use_R dst [])\n    SETCC  _ op         -> mkRU [] (def_W op)\n    JXX    _ _          -> mkRU [] []\n    JXX_GBL _ _         -> mkRU [] []\n    JMP     op regs     -> mkRUR (use_R op regs)\n    JMP_TBL op _ _ _    -> mkRUR (use_R op [])\n    CALL (Left _)  params   -> mkRU params (callClobberedRegs platform)\n    CALL (Right reg) params -> mkRU (reg:params) (callClobberedRegs platform)\n    CLTD   _            -> mkRU [eax] [edx]\n    NOP                 -> mkRU [] []\n\n    GMOV   src dst      -> mkRU [src] [dst]\n    GLD    _ src dst    -> mkRU (use_EA src []) [dst]\n    GST    _ src dst    -> mkRUR (src : use_EA dst [])\n\n    GLDZ   dst          -> mkRU [] [dst]\n    GLD1   dst          -> mkRU [] [dst]\n\n    GFTOI  src dst      -> mkRU [src] [dst]\n    GDTOI  src dst      -> mkRU [src] [dst]\n\n    GITOF  src dst      -> mkRU [src] [dst]\n    GITOD  src dst      -> mkRU [src] [dst]\n\n    GDTOF  src dst      -> mkRU [src] [dst]\n\n    GADD   _ s1 s2 dst  -> mkRU [s1,s2] [dst]\n    GSUB   _ s1 s2 dst  -> mkRU [s1,s2] [dst]\n    GMUL   _ s1 s2 dst  -> mkRU [s1,s2] [dst]\n    GDIV   _ s1 s2 dst  -> mkRU [s1,s2] [dst]\n\n    GCMP   _ src1 src2   -> mkRUR [src1,src2]\n    GABS   _ src dst     -> mkRU [src] [dst]\n    GNEG   _ src dst     -> mkRU [src] [dst]\n    GSQRT  _ src dst     -> mkRU [src] [dst]\n    GSIN   _ _ _ src dst -> mkRU [src] [dst]\n    GCOS   _ _ _ src dst -> mkRU [src] [dst]\n    GTAN   _ _ _ src dst -> mkRU [src] [dst]\n\n    CVTSS2SD   src dst  -> mkRU [src] [dst]\n    CVTSD2SS   src dst  -> mkRU [src] [dst]\n    CVTTSS2SIQ _ src dst -> mkRU (use_R src []) [dst]\n    CVTTSD2SIQ _ src dst -> mkRU (use_R src []) [dst]\n    CVTSI2SS   _ src dst -> mkRU (use_R src []) [dst]\n    CVTSI2SD   _ src dst -> mkRU (use_R src []) [dst]\n    FDIV _     src dst  -> usageRM src dst\n    SQRT _ src dst      -> mkRU (use_R src []) [dst]\n\n    FETCHGOT reg        -> mkRU [] [reg]\n    FETCHPC  reg        -> mkRU [] [reg]\n\n    COMMENT _           -> noUsage\n    LOCATION{}          -> noUsage\n    UNWIND{}            -> noUsage\n    DELTA   _           -> noUsage\n\n    POPCNT _ src dst -> mkRU (use_R src []) [dst]\n    LZCNT  _ src dst -> mkRU (use_R src []) [dst]\n    TZCNT  _ src dst -> mkRU (use_R src []) [dst]\n    BSF    _ src dst -> mkRU (use_R src []) [dst]\n    BSR    _ src dst -> mkRU (use_R src []) [dst]\n\n    PDEP   _ src mask dst -> mkRU (use_R src $ use_R mask []) [dst]\n    PEXT   _ src mask dst -> mkRU (use_R src $ use_R mask []) [dst]\n\n    -- note: might be a better way to do this\n    PREFETCH _  _ src -> mkRU (use_R src []) []\n    LOCK i              -> x86_regUsageOfInstr platform i\n    XADD _ src dst      -> usageMM src dst\n    CMPXCHG _ src dst   -> usageRMM src dst (OpReg eax)\n    MFENCE -> noUsage\n\n    _other              -> panic \"regUsage: unrecognised instr\"\n where\n    -- # Definitions\n    --\n    -- Written: If the operand is a register, it's written. If it's an\n    -- address, registers mentioned in the address are read.\n    --\n    -- Modified: If the operand is a register, it's both read and\n    -- written. If it's an address, registers mentioned in the address\n    -- are read.\n\n    -- 2 operand form; first operand Read; second Written\n    usageRW :: Operand -> Operand -> RegUsage\n    usageRW op (OpReg reg)      = mkRU (use_R op []) [reg]\n    usageRW op (OpAddr ea)      = mkRUR (use_R op $! use_EA ea [])\n    usageRW _ _                 = panic \"X86.RegInfo.usageRW: no match\"\n\n    -- 2 operand form; first operand Read; second Modified\n    usageRM :: Operand -> Operand -> RegUsage\n    usageRM op (OpReg reg)      = mkRU (use_R op [reg]) [reg]\n    usageRM op (OpAddr ea)      = mkRUR (use_R op $! use_EA ea [])\n    usageRM _ _                 = panic \"X86.RegInfo.usageRM: no match\"\n\n    -- 2 operand form; first operand Modified; second Modified\n    usageMM :: Operand -> Operand -> RegUsage\n    usageMM (OpReg src) (OpReg dst) = mkRU [src, dst] [src, dst]\n    usageMM (OpReg src) (OpAddr ea) = mkRU (use_EA ea [src]) [src]\n    usageMM _ _                     = panic \"X86.RegInfo.usageMM: no match\"\n\n    -- 3 operand form; first operand Read; second Modified; third Modified\n    usageRMM :: Operand -> Operand -> Operand -> RegUsage\n    usageRMM (OpReg src) (OpReg dst) (OpReg reg) = mkRU [src, dst, reg] [dst, reg]\n    usageRMM (OpReg src) (OpAddr ea) (OpReg reg) = mkRU (use_EA ea [src, reg]) [reg]\n    usageRMM _ _ _                               = panic \"X86.RegInfo.usageRMM: no match\"\n\n    -- 1 operand form; operand Modified\n    usageM :: Operand -> RegUsage\n    usageM (OpReg reg)          = mkRU [reg] [reg]\n    usageM (OpAddr ea)          = mkRUR (use_EA ea [])\n    usageM _                    = panic \"X86.RegInfo.usageM: no match\"\n\n    -- Registers defd when an operand is written.\n    def_W (OpReg reg)           = [reg]\n    def_W (OpAddr _ )           = []\n    def_W _                     = panic \"X86.RegInfo.def_W: no match\"\n\n    -- Registers used when an operand is read.\n    use_R (OpReg reg)  tl = reg : tl\n    use_R (OpImm _)    tl = tl\n    use_R (OpAddr ea)  tl = use_EA ea tl\n\n    -- Registers used to compute an effective address.\n    use_EA (ImmAddr _ _) tl = tl\n    use_EA (AddrBaseIndex base index _) tl =\n        use_base base $! use_index index tl\n        where use_base (EABaseReg r)  tl = r : tl\n              use_base _              tl = tl\n              use_index EAIndexNone   tl = tl\n              use_index (EAIndex i _) tl = i : tl\n\n    mkRUR src = src' `seq` RU src' []\n        where src' = filter (interesting platform) src\n\n    mkRU src dst = src' `seq` dst' `seq` RU src' dst'\n        where src' = filter (interesting platform) src\n              dst' = filter (interesting platform) dst\n\n-- | Is this register interesting for the register allocator?\ninteresting :: Platform -> Reg -> Bool\ninteresting _        (RegVirtual _)              = True\ninteresting platform (RegReal (RealRegSingle i)) = freeReg platform i\ninteresting _        (RegReal (RealRegPair{}))   = panic \"X86.interesting: no reg pairs on this arch\"\n\n\n\n-- | Applies the supplied function to all registers in instructions.\n-- Typically used to change virtual registers to real registers.\nx86_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr\nx86_patchRegsOfInstr instr env\n = case instr of\n    MOV  fmt src dst     -> patch2 (MOV  fmt) src dst\n    CMOV cc fmt src dst  -> CMOV cc fmt (patchOp src) (env dst)\n    MOVZxL fmt src dst   -> patch2 (MOVZxL fmt) src dst\n    MOVSxL fmt src dst   -> patch2 (MOVSxL fmt) src dst\n    LEA  fmt src dst     -> patch2 (LEA  fmt) src dst\n    ADD  fmt src dst     -> patch2 (ADD  fmt) src dst\n    ADC  fmt src dst     -> patch2 (ADC  fmt) src dst\n    SUB  fmt src dst     -> patch2 (SUB  fmt) src dst\n    SBB  fmt src dst     -> patch2 (SBB  fmt) src dst\n    IMUL fmt src dst     -> patch2 (IMUL fmt) src dst\n    IMUL2 fmt src        -> patch1 (IMUL2 fmt) src\n    MUL fmt src dst      -> patch2 (MUL fmt) src dst\n    MUL2 fmt src         -> patch1 (MUL2 fmt) src\n    IDIV fmt op          -> patch1 (IDIV fmt) op\n    DIV fmt op           -> patch1 (DIV fmt) op\n    ADD_CC fmt src dst   -> patch2 (ADD_CC fmt) src dst\n    SUB_CC fmt src dst   -> patch2 (SUB_CC fmt) src dst\n    AND  fmt src dst     -> patch2 (AND  fmt) src dst\n    OR   fmt src dst     -> patch2 (OR   fmt) src dst\n    XOR  fmt src dst     -> patch2 (XOR  fmt) src dst\n    NOT  fmt op          -> patch1 (NOT  fmt) op\n    BSWAP fmt reg        -> BSWAP fmt (env reg)\n    NEGI fmt op          -> patch1 (NEGI fmt) op\n    SHL  fmt imm dst     -> patch1 (SHL fmt imm) dst\n    SAR  fmt imm dst     -> patch1 (SAR fmt imm) dst\n    SHR  fmt imm dst     -> patch1 (SHR fmt imm) dst\n    BT   fmt imm src     -> patch1 (BT  fmt imm) src\n    TEST fmt src dst     -> patch2 (TEST fmt) src dst\n    CMP  fmt src dst     -> patch2 (CMP  fmt) src dst\n    PUSH fmt op          -> patch1 (PUSH fmt) op\n    POP  fmt op          -> patch1 (POP  fmt) op\n    SETCC cond op        -> patch1 (SETCC cond) op\n    JMP op regs          -> JMP (patchOp op) regs\n    JMP_TBL op ids s lbl -> JMP_TBL (patchOp op) ids s lbl\n\n    GMOV src dst         -> GMOV (env src) (env dst)\n    GLD  fmt src dst     -> GLD fmt (lookupAddr src) (env dst)\n    GST  fmt src dst     -> GST fmt (env src) (lookupAddr dst)\n\n    GLDZ dst            -> GLDZ (env dst)\n    GLD1 dst            -> GLD1 (env dst)\n\n    GFTOI src dst       -> GFTOI (env src) (env dst)\n    GDTOI src dst       -> GDTOI (env src) (env dst)\n\n    GITOF src dst       -> GITOF (env src) (env dst)\n    GITOD src dst       -> GITOD (env src) (env dst)\n\n    GDTOF src dst       -> GDTOF (env src) (env dst)\n\n    GADD fmt s1 s2 dst   -> GADD fmt (env s1) (env s2) (env dst)\n    GSUB fmt s1 s2 dst   -> GSUB fmt (env s1) (env s2) (env dst)\n    GMUL fmt s1 s2 dst   -> GMUL fmt (env s1) (env s2) (env dst)\n    GDIV fmt s1 s2 dst   -> GDIV fmt (env s1) (env s2) (env dst)\n\n    GCMP fmt src1 src2   -> GCMP fmt (env src1) (env src2)\n    GABS fmt src dst     -> GABS fmt (env src) (env dst)\n    GNEG fmt src dst     -> GNEG fmt (env src) (env dst)\n    GSQRT fmt src dst    -> GSQRT fmt (env src) (env dst)\n    GSIN fmt l1 l2 src dst       -> GSIN fmt l1 l2 (env src) (env dst)\n    GCOS fmt l1 l2 src dst       -> GCOS fmt l1 l2 (env src) (env dst)\n    GTAN fmt l1 l2 src dst       -> GTAN fmt l1 l2 (env src) (env dst)\n\n    CVTSS2SD src dst    -> CVTSS2SD (env src) (env dst)\n    CVTSD2SS src dst    -> CVTSD2SS (env src) (env dst)\n    CVTTSS2SIQ fmt src dst -> CVTTSS2SIQ fmt (patchOp src) (env dst)\n    CVTTSD2SIQ fmt src dst -> CVTTSD2SIQ fmt (patchOp src) (env dst)\n    CVTSI2SS fmt src dst -> CVTSI2SS fmt (patchOp src) (env dst)\n    CVTSI2SD fmt src dst -> CVTSI2SD fmt (patchOp src) (env dst)\n    FDIV fmt src dst     -> FDIV fmt (patchOp src) (patchOp dst)\n    SQRT fmt src dst    -> SQRT fmt (patchOp src) (env dst)\n\n    CALL (Left _)  _    -> instr\n    CALL (Right reg) p  -> CALL (Right (env reg)) p\n\n    FETCHGOT reg        -> FETCHGOT (env reg)\n    FETCHPC  reg        -> FETCHPC  (env reg)\n\n    NOP                 -> instr\n    COMMENT _           -> instr\n    LOCATION {}         -> instr\n    UNWIND {}           -> instr\n    DELTA _             -> instr\n\n    JXX _ _             -> instr\n    JXX_GBL _ _         -> instr\n    CLTD _              -> instr\n\n    POPCNT fmt src dst -> POPCNT fmt (patchOp src) (env dst)\n    LZCNT  fmt src dst -> LZCNT  fmt (patchOp src) (env dst)\n    TZCNT  fmt src dst -> TZCNT  fmt (patchOp src) (env dst)\n    PDEP   fmt src mask dst -> PDEP   fmt (patchOp src) (patchOp mask) (env dst)\n    PEXT   fmt src mask dst -> PEXT   fmt (patchOp src) (patchOp mask) (env dst)\n    BSF    fmt src dst -> BSF    fmt (patchOp src) (env dst)\n    BSR    fmt src dst -> BSR    fmt (patchOp src) (env dst)\n\n    PREFETCH lvl format src -> PREFETCH lvl format (patchOp src)\n\n    LOCK i               -> LOCK (x86_patchRegsOfInstr i env)\n    XADD fmt src dst     -> patch2 (XADD fmt) src dst\n    CMPXCHG fmt src dst  -> patch2 (CMPXCHG fmt) src dst\n    MFENCE               -> instr\n\n    _other              -> panic \"patchRegs: unrecognised instr\"\n\n  where\n    patch1 :: (Operand -> a) -> Operand -> a\n    patch1 insn op      = insn $! patchOp op\n    patch2 :: (Operand -> Operand -> a) -> Operand -> Operand -> a\n    patch2 insn src dst = (insn $! patchOp src) $! patchOp dst\n\n    patchOp (OpReg  reg) = OpReg $! env reg\n    patchOp (OpImm  imm) = OpImm imm\n    patchOp (OpAddr ea)  = OpAddr $! lookupAddr ea\n\n    lookupAddr (ImmAddr imm off) = ImmAddr imm off\n    lookupAddr (AddrBaseIndex base index disp)\n      = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp\n      where\n        lookupBase EABaseNone       = EABaseNone\n        lookupBase EABaseRip        = EABaseRip\n        lookupBase (EABaseReg r)    = EABaseReg $! env r\n\n        lookupIndex EAIndexNone     = EAIndexNone\n        lookupIndex (EAIndex r i)   = (EAIndex $! env r) i\n\n\n--------------------------------------------------------------------------------\nx86_isJumpishInstr\n        :: Instr -> Bool\n\nx86_isJumpishInstr instr\n = case instr of\n        JMP{}           -> True\n        JXX{}           -> True\n        JXX_GBL{}       -> True\n        JMP_TBL{}       -> True\n        CALL{}          -> True\n        _               -> False\n\n\nx86_jumpDestsOfInstr\n        :: Instr\n        -> [BlockId]\n\nx86_jumpDestsOfInstr insn\n  = case insn of\n        JXX _ id        -> [id]\n        JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids]\n        _               -> []\n\n\nx86_patchJumpInstr\n        :: Instr -> (BlockId -> BlockId) -> Instr\n\nx86_patchJumpInstr insn patchF\n  = case insn of\n        JXX cc id       -> JXX cc (patchF id)\n        JMP_TBL op ids section lbl\n          -> JMP_TBL op (map (fmap (patchJumpDest patchF)) ids) section lbl\n        _               -> insn\n    where\n        patchJumpDest f (DestBlockId id) = DestBlockId (f id)\n        patchJumpDest _ dest             = dest\n\n\n\n\n\n-- -----------------------------------------------------------------------------\n-- | Make a spill instruction.\nx86_mkSpillInstr\n    :: DynFlags\n    -> Reg      -- register to spill\n    -> Int      -- current stack delta\n    -> Int      -- spill slot to use\n    -> Instr\n\nx86_mkSpillInstr dflags reg delta slot\n  = let off     = spillSlotToOffset platform slot - delta\n    in\n    case targetClassOfReg platform reg of\n           RcInteger   -> MOV (archWordFormat is32Bit)\n                              (OpReg reg) (OpAddr (spRel dflags off))\n           RcDouble    -> GST FF80 reg (spRel dflags off) {- RcFloat/RcDouble -}\n           RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel dflags off))\n           _         -> panic \"X86.mkSpillInstr: no match\"\n    where platform = targetPlatform dflags\n          is32Bit = target32Bit platform\n\n-- | Make a spill reload instruction.\nx86_mkLoadInstr\n    :: DynFlags\n    -> Reg      -- register to load\n    -> Int      -- current stack delta\n    -> Int      -- spill slot to use\n    -> Instr\n\nx86_mkLoadInstr dflags reg delta slot\n  = let off     = spillSlotToOffset platform slot - delta\n    in\n        case targetClassOfReg platform reg of\n              RcInteger -> MOV (archWordFormat is32Bit)\n                               (OpAddr (spRel dflags off)) (OpReg reg)\n              RcDouble  -> GLD FF80 (spRel dflags off) reg {- RcFloat/RcDouble -}\n              RcDoubleSSE -> MOV FF64 (OpAddr (spRel dflags off)) (OpReg reg)\n              _           -> panic \"X86.x86_mkLoadInstr\"\n    where platform = targetPlatform dflags\n          is32Bit = target32Bit platform\n\nspillSlotSize :: Platform -> Int\nspillSlotSize dflags = if is32Bit then 12 else 8\n    where is32Bit = target32Bit dflags\n\nmaxSpillSlots :: DynFlags -> Int\nmaxSpillSlots dflags\n    = ((rESERVED_C_STACK_BYTES dflags - 64) `div` spillSlotSize (targetPlatform dflags)) - 1\n--     = 0 -- useful for testing allocMoreStack\n\n-- number of bytes that the stack pointer should be aligned to\nstackAlign :: Int\nstackAlign = 16\n\n-- convert a spill slot number to a *byte* offset, with no sign:\n-- decide on a per arch basis whether you are spilling above or below\n-- the C stack pointer.\nspillSlotToOffset :: Platform -> Int -> Int\nspillSlotToOffset platform slot\n   = 64 + spillSlotSize platform * slot\n\n--------------------------------------------------------------------------------\n\n-- | See if this instruction is telling us the current C stack delta\nx86_takeDeltaInstr\n        :: Instr\n        -> Maybe Int\n\nx86_takeDeltaInstr instr\n = case instr of\n        DELTA i         -> Just i\n        _               -> Nothing\n\n\nx86_isMetaInstr\n        :: Instr\n        -> Bool\n\nx86_isMetaInstr instr\n = case instr of\n        COMMENT{}       -> True\n        LOCATION{}      -> True\n        LDATA{}         -> True\n        NEWBLOCK{}      -> True\n        UNWIND{}        -> True\n        DELTA{}         -> True\n        _               -> False\n\n\n\n-- | Make a reg-reg move instruction.\n--      On SPARC v8 there are no instructions to move directly between\n--      floating point and integer regs. If we need to do that then we\n--      have to go via memory.\n--\nx86_mkRegRegMoveInstr\n    :: Platform\n    -> Reg\n    -> Reg\n    -> Instr\n\nx86_mkRegRegMoveInstr platform src dst\n = case targetClassOfReg platform src of\n        RcInteger -> case platformArch platform of\n                     ArchX86    -> MOV II32 (OpReg src) (OpReg dst)\n                     ArchX86_64 -> MOV II64 (OpReg src) (OpReg dst)\n                     _          -> panic \"x86_mkRegRegMoveInstr: Bad arch\"\n        RcDouble    -> GMOV src dst\n        RcDoubleSSE -> MOV FF64 (OpReg src) (OpReg dst)\n        _     -> panic \"X86.RegInfo.mkRegRegMoveInstr: no match\"\n\n-- | Check whether an instruction represents a reg-reg move.\n--      The register allocator attempts to eliminate reg->reg moves whenever it can,\n--      by assigning the src and dest temporaries to the same real register.\n--\nx86_takeRegRegMoveInstr\n        :: Instr\n        -> Maybe (Reg,Reg)\n\nx86_takeRegRegMoveInstr (MOV _ (OpReg r1) (OpReg r2))\n        = Just (r1,r2)\n\nx86_takeRegRegMoveInstr _  = Nothing\n\n\n-- | Make an unconditional branch instruction.\nx86_mkJumpInstr\n        :: BlockId\n        -> [Instr]\n\nx86_mkJumpInstr id\n        = [JXX ALWAYS id]\n\n-- Note [Windows stack layout]\n-- | On most OSes the kernel will place a guard page after the current stack\n--   page.  If you allocate larger than a page worth you may jump over this\n--   guard page.  Not only is this a security issue, but on certain OSes such\n--   as Windows a new page won't be allocated if you don't hit the guard.  This\n--   will cause a segfault or access fault.\n--\n--   This function defines if the current allocation amount requires a probe.\n--   On Windows (for now) we emit a call to _chkstk for this.  For other OSes\n--   this is not yet implemented.\n--   See https://docs.microsoft.com/en-us/windows/desktop/DevNotes/-win32-chkstk\n--   The Windows stack looks like this:\n--\n--                         +-------------------+\n--                         |        SP         |\n--                         +-------------------+\n--                         |                   |\n--                         |    GUARD PAGE     |\n--                         |                   |\n--                         +-------------------+\n--                         |                   |\n--                         |                   |\n--                         |     UNMAPPED      |\n--                         |                   |\n--                         |                   |\n--                         +-------------------+\n--\n--   In essense each allocation larger than a page size needs to be chunked and\n--   a probe emitted after each page allocation.  You have to hit the guard\n--   page so the kernel can map in the next page, otherwise you'll segfault.\n--\nneeds_probe_call :: Platform -> Int -> Bool\nneeds_probe_call platform amount\n  = case platformOS platform of\n     OSMinGW32 -> case platformArch platform of\n                    ArchX86    -> amount > (4 * 1024)\n                    ArchX86_64 -> amount > (8 * 1024)\n                    _          -> False\n     _         -> False\n\nx86_mkStackAllocInstr\n        :: Platform\n        -> Int\n        -> [Instr]\nx86_mkStackAllocInstr platform amount\n  = case platformOS platform of\n      OSMinGW32 ->\n        -- These will clobber AX but this should be ok because\n        --\n        -- 1. It is the first thing we do when entering the closure and AX is\n        --    a caller saved registers on Windows both on x86_64 and x86.\n        --\n        -- 2. The closures are only entered via a call or longjmp in which case\n        --    there are no expectations for volatile registers.\n        --\n        -- 3. When the target is a local branch point it is re-targeted\n        --    after the dealloc, preserving #2.  See note [extra spill slots].\n        --\n        -- We emit a call because the stack probes are quite involved and\n        -- would bloat code size a lot.  GHC doesn't really have an -Os.\n        -- __chkstk is guaranteed to leave all nonvolatile registers and AX\n        -- untouched.  It's part of the standard prologue code for any Windows\n        -- function dropping the stack more than a page.\n        -- See Note [Windows stack layout]\n        case platformArch platform of\n            ArchX86    | needs_probe_call platform amount ->\n                           [ MOV II32 (OpImm (ImmInt amount)) (OpReg eax)\n                           , CALL (Left $ strImmLit \"___chkstk_ms\") [eax]\n                           , SUB II32 (OpReg eax) (OpReg esp)\n                           ]\n                       | otherwise ->\n                           [ SUB II32 (OpImm (ImmInt amount)) (OpReg esp)\n                           , TEST II32 (OpReg esp) (OpReg esp)\n                           ]\n            ArchX86_64 | needs_probe_call platform amount ->\n                           [ MOV II64 (OpImm (ImmInt amount)) (OpReg rax)\n                           , CALL (Left $ strImmLit \"___chkstk_ms\") [rax]\n                           , SUB II64 (OpReg rax) (OpReg rsp)\n                           ]\n                       | otherwise ->\n                           [ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp)\n                           , TEST II64 (OpReg rsp) (OpReg rsp)\n                           ]\n            _ -> panic \"x86_mkStackAllocInstr\"\n      _       ->\n        case platformArch platform of\n          ArchX86    -> [ SUB II32 (OpImm (ImmInt amount)) (OpReg esp) ]\n          ArchX86_64 -> [ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp) ]\n          _ -> panic \"x86_mkStackAllocInstr\"\n\nx86_mkStackDeallocInstr\n        :: Platform\n        -> Int\n        -> [Instr]\nx86_mkStackDeallocInstr platform amount\n  = case platformArch platform of\n      ArchX86    -> [ADD II32 (OpImm (ImmInt amount)) (OpReg esp)]\n      ArchX86_64 -> [ADD II64 (OpImm (ImmInt amount)) (OpReg rsp)]\n      _ -> panic \"x86_mkStackDeallocInstr\"\n\ni386_insert_ffrees\n        :: [GenBasicBlock Instr]\n        -> [GenBasicBlock Instr]\n\ni386_insert_ffrees blocks\n   | any (any is_G_instr) [ instrs | BasicBlock _ instrs <- blocks ]\n   = map insertGFREEs blocks\n   | otherwise\n   = blocks\n where\n   insertGFREEs (BasicBlock id insns)\n     = BasicBlock id (insertBeforeNonlocalTransfers GFREE insns)\n\ninsertBeforeNonlocalTransfers :: Instr -> [Instr] -> [Instr]\ninsertBeforeNonlocalTransfers insert insns\n     = foldr p [] insns\n     where p insn r = case insn of\n                        CALL _ _    -> insert : insn : r\n                        JMP _ _     -> insert : insn : r\n                        JXX_GBL _ _ -> panic \"insertBeforeNonlocalTransfers: cannot handle JXX_GBL\"\n                        _           -> insn : r\n\n\n-- if you ever add a new FP insn to the fake x86 FP insn set,\n-- you must update this too\nis_G_instr :: Instr -> Bool\nis_G_instr instr\n   = case instr of\n        GMOV{}          -> True\n        GLD{}           -> True\n        GST{}           -> True\n        GLDZ{}          -> True\n        GLD1{}          -> True\n        GFTOI{}         -> True\n        GDTOI{}         -> True\n        GITOF{}         -> True\n        GITOD{}         -> True\n        GDTOF{}         -> True\n        GADD{}          -> True\n        GDIV{}          -> True\n        GSUB{}          -> True\n        GMUL{}          -> True\n        GCMP{}          -> True\n        GABS{}          -> True\n        GNEG{}          -> True\n        GSQRT{}         -> True\n        GSIN{}          -> True\n        GCOS{}          -> True\n        GTAN{}          -> True\n        GFREE           -> panic \"is_G_instr: GFREE (!)\"\n        _               -> False\n\n\n--\n-- Note [extra spill slots]\n--\n-- If the register allocator used more spill slots than we have\n-- pre-allocated (rESERVED_C_STACK_BYTES), then we must allocate more\n-- C stack space on entry and exit from this proc.  Therefore we\n-- insert a \"sub $N, %rsp\" at every entry point, and an \"add $N, %rsp\"\n-- before every non-local jump.\n--\n-- This became necessary when the new codegen started bundling entire\n-- functions together into one proc, because the register allocator\n-- assigns a different stack slot to each virtual reg within a proc.\n-- To avoid using so many slots we could also:\n--\n--   - split up the proc into connected components before code generator\n--\n--   - rename the virtual regs, so that we re-use vreg names and hence\n--     stack slots for non-overlapping vregs.\n--\n-- Note that when a block is both a non-local entry point (with an\n-- info table) and a local branch target, we have to split it into\n-- two, like so:\n--\n--    <info table>\n--    L:\n--       <code>\n--\n-- becomes\n--\n--    <info table>\n--    L:\n--       subl $rsp, N\n--       jmp Lnew\n--    Lnew:\n--       <code>\n--\n-- and all branches pointing to L are retargetted to point to Lnew.\n-- Otherwise, we would repeat the $rsp adjustment for each branch to\n-- L.\n--\n-- Returns a list of (L,Lnew) pairs.\n--\nallocMoreStack\n  :: Platform\n  -> Int\n  -> NatCmmDecl statics X86.Instr.Instr\n  -> UniqSM (NatCmmDecl statics X86.Instr.Instr, [(BlockId,BlockId)])\n\nallocMoreStack _ _ top@(CmmData _ _) = return (top,[])\nallocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do\n    let entries = entryBlocks proc\n\n    uniqs <- replicateM (length entries) getUniqueM\n\n    let\n      delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up\n        where x = slots * spillSlotSize platform -- sp delta\n\n      alloc   = mkStackAllocInstr   platform delta\n      dealloc = mkStackDeallocInstr platform delta\n\n      retargetList = (zip entries (map mkBlockId uniqs))\n\n      new_blockmap :: LabelMap BlockId\n      new_blockmap = mapFromList retargetList\n\n      insert_stack_insns (BasicBlock id insns)\n         | Just new_blockid <- mapLookup id new_blockmap\n         = [ BasicBlock id $ alloc ++ [JXX ALWAYS new_blockid]\n           , BasicBlock new_blockid block' ]\n         | otherwise\n         = [ BasicBlock id block' ]\n         where\n           block' = foldr insert_dealloc [] insns\n\n      insert_dealloc insn r = case insn of\n         JMP _ _     -> dealloc ++ (insn : r)\n         JXX_GBL _ _ -> panic \"insert_dealloc: cannot handle JXX_GBL\"\n         _other      -> x86_patchJumpInstr insn retarget : r\n           where retarget b = fromMaybe b (mapLookup b new_blockmap)\n\n      new_code = concatMap insert_stack_insns code\n    -- in\n    return (CmmProc info lbl live (ListGraph new_code), retargetList)\n\ndata JumpDest = DestBlockId BlockId | DestImm Imm\n\n-- Debug Instance\ninstance Outputable JumpDest where\n  ppr (DestBlockId bid) = text \"jd<blk>:\" <> ppr bid\n  ppr (DestImm _imm)    = text \"jd<imm>:noShow\"\n\n\ngetJumpDestBlockId :: JumpDest -> Maybe BlockId\ngetJumpDestBlockId (DestBlockId bid) = Just bid\ngetJumpDestBlockId _                 = Nothing\n\ncanShortcut :: Instr -> Maybe JumpDest\ncanShortcut (JXX ALWAYS id)      = Just (DestBlockId id)\ncanShortcut (JMP (OpImm imm) _)  = Just (DestImm imm)\ncanShortcut _                    = Nothing\n\n\n-- This helper shortcuts a sequence of branches.\n-- The blockset helps avoid following cycles.\nshortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr\nshortcutJump fn insn = shortcutJump' fn (setEmpty :: LabelSet) insn\n  where\n    shortcutJump' :: (BlockId -> Maybe JumpDest) -> LabelSet -> Instr -> Instr\n    shortcutJump' fn seen insn@(JXX cc id) =\n        if setMember id seen then insn\n        else case fn id of\n            Nothing                -> insn\n            Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')\n            Just (DestImm imm)     -> shortcutJump' fn seen' (JXX_GBL cc imm)\n        where seen' = setInsert id seen\n    shortcutJump' fn _ (JMP_TBL addr blocks section tblId) =\n        let updateBlock (Just (DestBlockId bid))  =\n                case fn bid of\n                    Nothing   -> Just (DestBlockId bid )\n                    Just dest -> Just dest\n            updateBlock dest = dest\n            blocks' = map updateBlock blocks\n        in  JMP_TBL addr blocks' section tblId\n    shortcutJump' _ _ other = other\n\n-- Here because it knows about JumpDest\nshortcutStatics :: (BlockId -> Maybe JumpDest) -> (Alignment, CmmStatics) -> (Alignment, CmmStatics)\nshortcutStatics fn (align, Statics lbl statics)\n  = (align, Statics lbl $ map (shortcutStatic fn) statics)\n  -- we need to get the jump tables, so apply the mapping to the entries\n  -- of a CmmData too.\n\nshortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel\nshortcutLabel fn lab\n  | Just blkId <- maybeLocalBlockLabel lab = shortBlockId fn emptyUniqSet blkId\n  | otherwise                              = lab\n\nshortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic\nshortcutStatic fn (CmmStaticLit (CmmLabel lab))\n  = CmmStaticLit (CmmLabel (shortcutLabel fn lab))\nshortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off w))\n  = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off w)\n        -- slightly dodgy, we're ignoring the second label, but this\n        -- works with the way we use CmmLabelDiffOff for jump tables now.\nshortcutStatic _ other_static\n        = other_static\n\nshortBlockId\n        :: (BlockId -> Maybe JumpDest)\n        -> UniqSet Unique\n        -> BlockId\n        -> CLabel\n\nshortBlockId fn seen blockid =\n  case (elementOfUniqSet uq seen, fn blockid) of\n    (True, _)    -> blockLbl blockid\n    (_, Nothing) -> blockLbl blockid\n    (_, Just (DestBlockId blockid'))  -> shortBlockId fn (addOneToUniqSet seen uq) blockid'\n    (_, Just (DestImm (ImmCLbl lbl))) -> lbl\n    (_, _other) -> panic \"shortBlockId\"\n  where uq = getUnique blockid\n", "num_lines": 1188}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n--\n-- Pretty-printing assembly language\n--\n-- (c) The University of Glasgow 1993-2005\n--\n-----------------------------------------------------------------------------\n\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule X86.Ppr (\n        pprNatCmmDecl,\n        pprData,\n        pprInstr,\n        pprFormat,\n        pprImm,\n        pprDataItem,\n)\n\nwhere\n\n#include \"HsVersions.h\"\n#include \"nativeGen/NCG.h\"\n\nimport GhcPrelude\n\nimport X86.Regs\nimport X86.Instr\nimport X86.Cond\nimport Instruction\nimport Format\nimport Reg\nimport PprBase\n\n\nimport Hoopl.Collections\nimport Hoopl.Label\nimport BasicTypes       (Alignment)\nimport DynFlags\nimport Cmm              hiding (topInfoTable)\nimport BlockId\nimport CLabel\nimport Unique           ( pprUniqueAlways )\nimport Platform\nimport FastString\nimport Outputable\n\nimport Data.Word\nimport Data.Bits\n\n-- -----------------------------------------------------------------------------\n-- Printing this stuff out\n--\n--\n-- Note [Subsections Via Symbols]\n--\n-- If we are using the .subsections_via_symbols directive\n-- (available on recent versions of Darwin),\n-- we have to make sure that there is some kind of reference\n-- from the entry code to a label on the _top_ of of the info table,\n-- so that the linker will not think it is unreferenced and dead-strip\n-- it. That's why the label is called a DeadStripPreventer (_dsp).\n--\n-- The LLVM code gen already creates `iTableSuf` symbols, where\n-- the X86 would generate the DeadStripPreventer (_dsp) symbol.\n-- Therefore all that is left for llvm code gen, is to ensure\n-- that all the `iTableSuf` symbols are marked as used.\n-- As of this writing the documentation regarding the\n-- .subsections_via_symbols and -dead_strip can be found at\n-- <https://developer.apple.com/library/mac/documentation/DeveloperTools/Reference/Assembler/040-Assembler_Directives/asm_directives.html#//apple_ref/doc/uid/TP30000823-TPXREF101>\n\npprProcAlignment :: SDoc\npprProcAlignment = sdocWithDynFlags $ \\dflags ->\n  (maybe empty pprAlign . cmmProcAlignment $ dflags)\n\npprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc\npprNatCmmDecl (CmmData section dats) =\n  pprSectionAlign section $$ pprDatas dats\n\npprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =\n  sdocWithDynFlags $ \\dflags ->\n  pprProcAlignment $$\n  case topInfoTable proc of\n    Nothing ->\n        -- special case for code without info table:\n        pprSectionAlign (Section Text lbl) $$\n        pprProcAlignment $$\n        pprLabel lbl $$ -- blocks guaranteed not null, so label needed\n        vcat (map (pprBasicBlock top_info) blocks) $$\n        (if debugLevel dflags > 0\n         then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$\n        pprSizeDecl lbl\n\n    Just (Statics info_lbl _) ->\n      sdocWithPlatform $ \\platform ->\n      pprSectionAlign (Section Text info_lbl) $$\n      pprProcAlignment $$\n      (if platformHasSubsectionsViaSymbols platform\n          then ppr (mkDeadStripPreventer info_lbl) <> char ':'\n          else empty) $$\n      vcat (map (pprBasicBlock top_info) blocks) $$\n      -- above: Even the first block gets a label, because with branch-chain\n      -- elimination, it might be the target of a goto.\n      (if platformHasSubsectionsViaSymbols platform\n       then -- See Note [Subsections Via Symbols]\n                text \"\\t.long \"\n            <+> ppr info_lbl\n            <+> char '-'\n            <+> ppr (mkDeadStripPreventer info_lbl)\n       else empty) $$\n      pprSizeDecl info_lbl\n\n-- | Output the ELF .size directive.\npprSizeDecl :: CLabel -> SDoc\npprSizeDecl lbl\n = sdocWithPlatform $ \\platform ->\n   if osElfTarget (platformOS platform)\n   then text \"\\t.size\" <+> ppr lbl <> ptext (sLit \", .-\") <> ppr lbl\n   else empty\n\npprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc\npprBasicBlock info_env (BasicBlock blockid instrs)\n  = sdocWithDynFlags $ \\dflags ->\n    maybe_infotable dflags $\n    pprLabel asmLbl $$\n    vcat (map pprInstr instrs) $$\n    (if debugLevel dflags > 0\n     then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty)\n  where\n    asmLbl = blockLbl blockid\n    maybe_infotable dflags c = case mapLookup blockid info_env of\n       Nothing -> c\n       Just (Statics infoLbl info) ->\n           pprAlignForSection Text $$\n           infoTableLoc $$\n           vcat (map pprData info) $$\n           pprLabel infoLbl $$\n           c $$\n           (if debugLevel dflags > 0\n            then ppr (mkAsmTempEndLabel infoLbl) <> char ':' else empty)\n    -- Make sure the info table has the right .loc for the block\n    -- coming right after it. See [Note: Info Offset]\n    infoTableLoc = case instrs of\n      (l@LOCATION{} : _) -> pprInstr l\n      _other             -> empty\n\npprDatas :: (Alignment, CmmStatics) -> SDoc\npprDatas (align, (Statics lbl dats))\n = vcat (pprAlign align : pprLabel lbl : map pprData dats)\n\npprData :: CmmStatic -> SDoc\npprData (CmmString str) = pprBytes str\n\npprData (CmmUninitialised bytes)\n = sdocWithPlatform $ \\platform ->\n   if platformOS platform == OSDarwin then text \".space \" <> int bytes\n                                      else text \".skip \"  <> int bytes\n\npprData (CmmStaticLit lit) = pprDataItem lit\n\npprGloblDecl :: CLabel -> SDoc\npprGloblDecl lbl\n  | not (externallyVisibleCLabel lbl) = empty\n  | otherwise = text \".globl \" <> ppr lbl\n\npprLabelType' :: DynFlags -> CLabel -> SDoc\npprLabelType' dflags lbl =\n  if isCFunctionLabel lbl || functionOkInfoTable then\n    text \"@function\"\n  else\n    text \"@object\"\n  where\n    {-\n    NOTE: This is a bit hacky.\n\n    With the `tablesNextToCode` info tables look like this:\n    ```\n      <info table data>\n    label_info:\n      <info table code>\n    ```\n    So actually info table label points exactly to the code and we can mark\n    the label as @function. (This is required to make perf and potentially other\n    tools to work on Haskell binaries).\n    This usually works well but it can cause issues with a linker.\n    A linker uses different algorithms for the relocation depending on\n    the symbol type.For some reason, a linker will generate JUMP_SLOT relocation\n    when constructor info table is referenced from a data section.\n    This only happens with static constructor call so\n    we mark _con_info symbols as `@object` to avoid the issue with relocations.\n\n    @SimonMarlow hack explanation:\n    \"The reasoning goes like this:\n\n    * The danger when we mark a symbol as `@function` is that the linker will\n      redirect it to point to the PLT and use a `JUMP_SLOT` relocation when\n      the symbol refers to something outside the current shared object.\n      A PLT / JUMP_SLOT reference only works for symbols that we jump to, not\n      for symbols representing data,, nor for info table symbol references which\n      we expect to point directly to the info table.\n    * GHC generates code that might refer to any info table symbol from the text\n      segment, but that's OK, because those will be explicit GOT references\n      generated by the code generator.\n    * When we refer to info tables from the data segment, it's either\n      * a FUN_STATIC/THUNK_STATIC local to this module\n      * a `con_info` that could be from anywhere\n\n    So, the only info table symbols that we might refer to from the data segment\n    of another shared object are `con_info` symbols, so those are the ones we\n    need to exclude from getting the @function treatment.\n    \"\n\n    A good place to check for more\n    https://ghc.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode\n\n    Another possible hack is to create an extra local function symbol for\n    every code-like thing to give the needed information for to the tools\n    but mess up with the relocation. https://phabricator.haskell.org/D4730\n    -}\n    functionOkInfoTable = tablesNextToCode dflags &&\n      isInfoTableLabel lbl && not (isConInfoTableLabel lbl)\n\n\npprTypeDecl :: CLabel -> SDoc\npprTypeDecl lbl\n    = sdocWithPlatform $ \\platform ->\n      if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl\n      then\n        sdocWithDynFlags $ \\df ->\n          text \".type \" <> ppr lbl <> ptext (sLit  \", \") <> pprLabelType' df lbl\n      else empty\n\npprLabel :: CLabel -> SDoc\npprLabel lbl = pprGloblDecl lbl\n            $$ pprTypeDecl lbl\n            $$ (ppr lbl <> char ':')\n\npprAlign :: Int -> SDoc\npprAlign bytes\n        = sdocWithPlatform $ \\platform ->\n          text \".align \" <> int (alignment platform)\n  where\n        alignment platform = if platformOS platform == OSDarwin\n                             then log2 bytes\n                             else      bytes\n\n        log2 :: Int -> Int  -- cache the common ones\n        log2 1 = 0\n        log2 2 = 1\n        log2 4 = 2\n        log2 8 = 3\n        log2 n = 1 + log2 (n `quot` 2)\n\n-- -----------------------------------------------------------------------------\n-- pprInstr: print an 'Instr'\n\ninstance Outputable Instr where\n    ppr instr = pprInstr instr\n\n\npprReg :: Format -> Reg -> SDoc\npprReg f r\n  = case r of\n      RegReal    (RealRegSingle i) ->\n          sdocWithPlatform $ \\platform ->\n          if target32Bit platform then ppr32_reg_no f i\n                                  else ppr64_reg_no f i\n      RegReal    (RealRegPair _ _) -> panic \"X86.Ppr: no reg pairs on this arch\"\n      RegVirtual (VirtualRegI  u)  -> text \"%vI_\"   <> pprUniqueAlways u\n      RegVirtual (VirtualRegHi u)  -> text \"%vHi_\"  <> pprUniqueAlways u\n      RegVirtual (VirtualRegF  u)  -> text \"%vF_\"   <> pprUniqueAlways u\n      RegVirtual (VirtualRegD  u)  -> text \"%vD_\"   <> pprUniqueAlways u\n      RegVirtual (VirtualRegSSE u) -> text \"%vSSE_\" <> pprUniqueAlways u\n  where\n    ppr32_reg_no :: Format -> Int -> SDoc\n    ppr32_reg_no II8   = ppr32_reg_byte\n    ppr32_reg_no II16  = ppr32_reg_word\n    ppr32_reg_no _     = ppr32_reg_long\n\n    ppr32_reg_byte i = ptext\n      (case i of {\n         0 -> sLit \"%al\";     1 -> sLit \"%bl\";\n         2 -> sLit \"%cl\";     3 -> sLit \"%dl\";\n        _  -> sLit $ \"very naughty I386 byte register: \" ++ show i\n      })\n\n    ppr32_reg_word i = ptext\n      (case i of {\n         0 -> sLit \"%ax\";     1 -> sLit \"%bx\";\n         2 -> sLit \"%cx\";     3 -> sLit \"%dx\";\n         4 -> sLit \"%si\";     5 -> sLit \"%di\";\n         6 -> sLit \"%bp\";     7 -> sLit \"%sp\";\n        _  -> sLit \"very naughty I386 word register\"\n      })\n\n    ppr32_reg_long i = ptext\n      (case i of {\n         0 -> sLit \"%eax\";    1 -> sLit \"%ebx\";\n         2 -> sLit \"%ecx\";    3 -> sLit \"%edx\";\n         4 -> sLit \"%esi\";    5 -> sLit \"%edi\";\n         6 -> sLit \"%ebp\";    7 -> sLit \"%esp\";\n         _  -> ppr_reg_float i\n      })\n\n    ppr64_reg_no :: Format -> Int -> SDoc\n    ppr64_reg_no II8   = ppr64_reg_byte\n    ppr64_reg_no II16  = ppr64_reg_word\n    ppr64_reg_no II32  = ppr64_reg_long\n    ppr64_reg_no _     = ppr64_reg_quad\n\n    ppr64_reg_byte i = ptext\n      (case i of {\n         0 -> sLit \"%al\";     1 -> sLit \"%bl\";\n         2 -> sLit \"%cl\";     3 -> sLit \"%dl\";\n         4 -> sLit \"%sil\";    5 -> sLit \"%dil\"; -- new 8-bit regs!\n         6 -> sLit \"%bpl\";    7 -> sLit \"%spl\";\n         8 -> sLit \"%r8b\";    9  -> sLit \"%r9b\";\n        10 -> sLit \"%r10b\";   11 -> sLit \"%r11b\";\n        12 -> sLit \"%r12b\";   13 -> sLit \"%r13b\";\n        14 -> sLit \"%r14b\";   15 -> sLit \"%r15b\";\n        _  -> sLit $ \"very naughty x86_64 byte register: \" ++ show i\n      })\n\n    ppr64_reg_word i = ptext\n      (case i of {\n         0 -> sLit \"%ax\";     1 -> sLit \"%bx\";\n         2 -> sLit \"%cx\";     3 -> sLit \"%dx\";\n         4 -> sLit \"%si\";     5 -> sLit \"%di\";\n         6 -> sLit \"%bp\";     7 -> sLit \"%sp\";\n         8 -> sLit \"%r8w\";    9  -> sLit \"%r9w\";\n        10 -> sLit \"%r10w\";   11 -> sLit \"%r11w\";\n        12 -> sLit \"%r12w\";   13 -> sLit \"%r13w\";\n        14 -> sLit \"%r14w\";   15 -> sLit \"%r15w\";\n        _  -> sLit \"very naughty x86_64 word register\"\n      })\n\n    ppr64_reg_long i = ptext\n      (case i of {\n         0 -> sLit \"%eax\";    1  -> sLit \"%ebx\";\n         2 -> sLit \"%ecx\";    3  -> sLit \"%edx\";\n         4 -> sLit \"%esi\";    5  -> sLit \"%edi\";\n         6 -> sLit \"%ebp\";    7  -> sLit \"%esp\";\n         8 -> sLit \"%r8d\";    9  -> sLit \"%r9d\";\n        10 -> sLit \"%r10d\";   11 -> sLit \"%r11d\";\n        12 -> sLit \"%r12d\";   13 -> sLit \"%r13d\";\n        14 -> sLit \"%r14d\";   15 -> sLit \"%r15d\";\n        _  -> sLit \"very naughty x86_64 register\"\n      })\n\n    ppr64_reg_quad i = ptext\n      (case i of {\n         0 -> sLit \"%rax\";      1 -> sLit \"%rbx\";\n         2 -> sLit \"%rcx\";      3 -> sLit \"%rdx\";\n         4 -> sLit \"%rsi\";      5 -> sLit \"%rdi\";\n         6 -> sLit \"%rbp\";      7 -> sLit \"%rsp\";\n         8 -> sLit \"%r8\";       9 -> sLit \"%r9\";\n        10 -> sLit \"%r10\";    11 -> sLit \"%r11\";\n        12 -> sLit \"%r12\";    13 -> sLit \"%r13\";\n        14 -> sLit \"%r14\";    15 -> sLit \"%r15\";\n        _  -> ppr_reg_float i\n      })\n\nppr_reg_float :: Int -> PtrString\nppr_reg_float i = case i of\n        16 -> sLit \"%fake0\";  17 -> sLit \"%fake1\"\n        18 -> sLit \"%fake2\";  19 -> sLit \"%fake3\"\n        20 -> sLit \"%fake4\";  21 -> sLit \"%fake5\"\n        24 -> sLit \"%xmm0\";   25 -> sLit \"%xmm1\"\n        26 -> sLit \"%xmm2\";   27 -> sLit \"%xmm3\"\n        28 -> sLit \"%xmm4\";   29 -> sLit \"%xmm5\"\n        30 -> sLit \"%xmm6\";   31 -> sLit \"%xmm7\"\n        32 -> sLit \"%xmm8\";   33 -> sLit \"%xmm9\"\n        34 -> sLit \"%xmm10\";  35 -> sLit \"%xmm11\"\n        36 -> sLit \"%xmm12\";  37 -> sLit \"%xmm13\"\n        38 -> sLit \"%xmm14\";  39 -> sLit \"%xmm15\"\n        _  -> sLit \"very naughty x86 register\"\n\npprFormat :: Format -> SDoc\npprFormat x\n = ptext (case x of\n                II8   -> sLit \"b\"\n                II16  -> sLit \"w\"\n                II32  -> sLit \"l\"\n                II64  -> sLit \"q\"\n                FF32  -> sLit \"ss\"      -- \"scalar single-precision float\" (SSE2)\n                FF64  -> sLit \"sd\"      -- \"scalar double-precision float\" (SSE2)\n                FF80  -> sLit \"t\"\n                )\n\npprFormat_x87 :: Format -> SDoc\npprFormat_x87 x\n  = ptext $ case x of\n                FF32  -> sLit \"s\"\n                FF64  -> sLit \"l\"\n                FF80  -> sLit \"t\"\n                _     -> panic \"X86.Ppr.pprFormat_x87\"\n\npprCond :: Cond -> SDoc\npprCond c\n = ptext (case c of {\n                GEU     -> sLit \"ae\";   LU    -> sLit \"b\";\n                EQQ     -> sLit \"e\";    GTT   -> sLit \"g\";\n                GE      -> sLit \"ge\";   GU    -> sLit \"a\";\n                LTT     -> sLit \"l\";    LE    -> sLit \"le\";\n                LEU     -> sLit \"be\";   NE    -> sLit \"ne\";\n                NEG     -> sLit \"s\";    POS   -> sLit \"ns\";\n                CARRY   -> sLit \"c\";   OFLO  -> sLit \"o\";\n                PARITY  -> sLit \"p\";   NOTPARITY -> sLit \"np\";\n                ALWAYS  -> sLit \"mp\"})\n\n\npprImm :: Imm -> SDoc\npprImm (ImmInt i)     = int i\npprImm (ImmInteger i) = integer i\npprImm (ImmCLbl l)    = ppr l\npprImm (ImmIndex l i) = ppr l <> char '+' <> int i\npprImm (ImmLit s)     = s\n\npprImm (ImmFloat _)  = text \"naughty float immediate\"\npprImm (ImmDouble _) = text \"naughty double immediate\"\n\npprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b\npprImm (ImmConstantDiff a b) = pprImm a <> char '-'\n                            <> lparen <> pprImm b <> rparen\n\n\n\npprAddr :: AddrMode -> SDoc\npprAddr (ImmAddr imm off)\n  = let pp_imm = pprImm imm\n    in\n    if (off == 0) then\n        pp_imm\n    else if (off < 0) then\n        pp_imm <> int off\n    else\n        pp_imm <> char '+' <> int off\n\npprAddr (AddrBaseIndex base index displacement)\n  = sdocWithPlatform $ \\platform ->\n    let\n        pp_disp  = ppr_disp displacement\n        pp_off p = pp_disp <> char '(' <> p <> char ')'\n        pp_reg r = pprReg (archWordFormat (target32Bit platform)) r\n    in\n    case (base, index) of\n      (EABaseNone,  EAIndexNone) -> pp_disp\n      (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)\n      (EABaseRip,   EAIndexNone) -> pp_off (text \"%rip\")\n      (EABaseNone,  EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)\n      (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r\n                                       <> comma <> int i)\n      _                         -> panic \"X86.Ppr.pprAddr: no match\"\n\n  where\n    ppr_disp (ImmInt 0) = empty\n    ppr_disp imm        = pprImm imm\n\n-- | Print section header and appropriate alignment for that section.\npprSectionAlign :: Section -> SDoc\npprSectionAlign (Section (OtherSection _) _) =\n     panic \"X86.Ppr.pprSectionAlign: unknown section\"\npprSectionAlign sec@(Section seg _) =\n  sdocWithPlatform $ \\platform ->\n    pprSectionHeader platform sec $$\n    pprAlignForSection seg\n\n-- | Print appropriate alignment for the given section type.\npprAlignForSection :: SectionType -> SDoc\npprAlignForSection seg =\n  sdocWithPlatform $ \\platform ->\n    text \".align \" <>\n    case platformOS platform of\n      -- Darwin: alignments are given as shifts.\n      OSDarwin\n       | target32Bit platform ->\n          case seg of\n           ReadOnlyData16    -> int 4\n           CString           -> int 1\n           _                 -> int 2\n       | otherwise ->\n          case seg of\n           ReadOnlyData16    -> int 4\n           CString           -> int 1\n           _                 -> int 3\n      -- Other: alignments are given as bytes.\n      _\n       | target32Bit platform ->\n          case seg of\n           Text              -> text \"4,0x90\"\n           ReadOnlyData16    -> int 16\n           CString           -> int 1\n           _                 -> int 4\n       | otherwise ->\n          case seg of\n           ReadOnlyData16    -> int 16\n           CString           -> int 1\n           _                 -> int 8\n\npprDataItem :: CmmLit -> SDoc\npprDataItem lit = sdocWithDynFlags $ \\dflags -> pprDataItem' dflags lit\n\npprDataItem' :: DynFlags -> CmmLit -> SDoc\npprDataItem' dflags lit\n  = vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit)\n    where\n        platform = targetPlatform dflags\n        imm = litToImm lit\n\n        -- These seem to be common:\n        ppr_item II8   _ = [text \"\\t.byte\\t\" <> pprImm imm]\n        ppr_item II16  _ = [text \"\\t.word\\t\" <> pprImm imm]\n        ppr_item II32  _ = [text \"\\t.long\\t\" <> pprImm imm]\n\n        ppr_item FF32  (CmmFloat r _)\n           = let bs = floatToBytes (fromRational r)\n             in  map (\\b -> text \"\\t.byte\\t\" <> pprImm (ImmInt b)) bs\n\n        ppr_item FF64 (CmmFloat r _)\n           = let bs = doubleToBytes (fromRational r)\n             in  map (\\b -> text \"\\t.byte\\t\" <> pprImm (ImmInt b)) bs\n\n        ppr_item II64 _\n            = case platformOS platform of\n              OSDarwin\n               | target32Bit platform ->\n                  case lit of\n                  CmmInt x _ ->\n                      [text \"\\t.long\\t\"\n                          <> int (fromIntegral (fromIntegral x :: Word32)),\n                       text \"\\t.long\\t\"\n                          <> int (fromIntegral\n                              (fromIntegral (x `shiftR` 32) :: Word32))]\n                  _ -> panic \"X86.Ppr.ppr_item: no match for II64\"\n               | otherwise ->\n                  [text \"\\t.quad\\t\" <> pprImm imm]\n              _\n               | target32Bit platform ->\n                  [text \"\\t.quad\\t\" <> pprImm imm]\n               | otherwise ->\n                  -- x86_64: binutils can't handle the R_X86_64_PC64\n                  -- relocation type, which means we can't do\n                  -- pc-relative 64-bit addresses. Fortunately we're\n                  -- assuming the small memory model, in which all such\n                  -- offsets will fit into 32 bits, so we have to stick\n                  -- to 32-bit offset fields and modify the RTS\n                  -- appropriately\n                  --\n                  -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h\n                  --\n                  case lit of\n                  -- A relative relocation:\n                  CmmLabelDiffOff _ _ _ _ ->\n                      [text \"\\t.long\\t\" <> pprImm imm,\n                       text \"\\t.long\\t0\"]\n                  _ ->\n                      [text \"\\t.quad\\t\" <> pprImm imm]\n\n        ppr_item _ _\n                = panic \"X86.Ppr.ppr_item: no match\"\n\n\nasmComment :: SDoc -> SDoc\nasmComment c = whenPprDebug $ text \"# \" <> c\n\npprInstr :: Instr -> SDoc\n\npprInstr (COMMENT s)\n   = asmComment (ftext s)\n\npprInstr (LOCATION file line col _name)\n   = text \"\\t.loc \" <> ppr file <+> ppr line <+> ppr col\n\npprInstr (DELTA d)\n   = asmComment $ text (\"\\tdelta = \" ++ show d)\n\npprInstr (NEWBLOCK _)\n   = panic \"PprMach.pprInstr: NEWBLOCK\"\n\npprInstr (UNWIND lbl d)\n   = asmComment (text \"\\tunwind = \" <> ppr d)\n     $$ ppr lbl <> colon\n\npprInstr (LDATA _ _)\n   = panic \"PprMach.pprInstr: LDATA\"\n\n{-\npprInstr (SPILL reg slot)\n   = hcat [\n        text \"\\tSPILL\",\n        char ' ',\n        pprUserReg reg,\n        comma,\n        text \"SLOT\" <> parens (int slot)]\n\npprInstr (RELOAD slot reg)\n   = hcat [\n        text \"\\tRELOAD\",\n        char ' ',\n        text \"SLOT\" <> parens (int slot),\n        comma,\n        pprUserReg reg]\n-}\n\n-- Replace 'mov $0x0,%reg' by 'xor %reg,%reg', which is smaller and cheaper.\n-- The code generator catches most of these already, but not all.\npprInstr (MOV format (OpImm (ImmInt 0)) dst@(OpReg _))\n  = pprInstr (XOR format' dst dst)\n  where format' = case format of\n          II64 -> II32          -- 32-bit version is equivalent, and smaller\n          _    -> format\npprInstr (MOV format src dst)\n  = pprFormatOpOp (sLit \"mov\") format src dst\n\npprInstr (CMOV cc format src dst)\n  = pprCondOpReg (sLit \"cmov\") format cc src dst\n\npprInstr (MOVZxL II32 src dst) = pprFormatOpOp (sLit \"mov\") II32 src dst\n        -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple\n        -- movl.  But we represent it as a MOVZxL instruction, because\n        -- the reg alloc would tend to throw away a plain reg-to-reg\n        -- move, and we still want it to do that.\n\npprInstr (MOVZxL formats src dst)\n  = pprFormatOpOpCoerce (sLit \"movz\") formats II32 src dst\n        -- zero-extension only needs to extend to 32 bits: on x86_64,\n        -- the remaining zero-extension to 64 bits is automatic, and the 32-bit\n        -- instruction is shorter.\n\npprInstr (MOVSxL formats src dst)\n  = sdocWithPlatform $ \\platform ->\n    pprFormatOpOpCoerce (sLit \"movs\") formats (archWordFormat (target32Bit platform)) src dst\n\n-- here we do some patching, since the physical registers are only set late\n-- in the code generation.\npprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))\n  | reg1 == reg3\n  = pprFormatOpOp (sLit \"add\") format (OpReg reg2) dst\n\npprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))\n  | reg2 == reg3\n  = pprFormatOpOp (sLit \"add\") format (OpReg reg1) dst\n\npprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))\n  | reg1 == reg3\n  = pprInstr (ADD format (OpImm displ) dst)\n\npprInstr (LEA format src dst) = pprFormatOpOp (sLit \"lea\") format src dst\n\npprInstr (ADD format (OpImm (ImmInt (-1))) dst)\n  = pprFormatOp (sLit \"dec\") format dst\npprInstr (ADD format (OpImm (ImmInt 1)) dst)\n  = pprFormatOp (sLit \"inc\") format dst\npprInstr (ADD format src dst) = pprFormatOpOp (sLit \"add\") format src dst\npprInstr (ADC format src dst) = pprFormatOpOp (sLit \"adc\") format src dst\npprInstr (SUB format src dst) = pprFormatOpOp (sLit \"sub\") format src dst\npprInstr (SBB format src dst) = pprFormatOpOp (sLit \"sbb\") format src dst\npprInstr (IMUL format op1 op2) = pprFormatOpOp (sLit \"imul\") format op1 op2\n\npprInstr (ADD_CC format src dst)\n  = pprFormatOpOp (sLit \"add\") format src dst\npprInstr (SUB_CC format src dst)\n  = pprFormatOpOp (sLit \"sub\") format src dst\n\n{- A hack.  The Intel documentation says that \"The two and three\n   operand forms [of IMUL] may also be used with unsigned operands\n   because the lower half of the product is the same regardless if\n   (sic) the operands are signed or unsigned.  The CF and OF flags,\n   however, cannot be used to determine if the upper half of the\n   result is non-zero.\"  So there.\n-}\n\n-- Use a 32-bit instruction when possible as it saves a byte.\n-- Notably, extracting the tag bits of a pointer has this form.\n-- TODO: we could save a byte in a subsequent CMP instruction too,\n-- but need something like a peephole pass for this\npprInstr (AND II64 src@(OpImm (ImmInteger mask)) dst)\n  | 0 <= mask && mask < 0xffffffff\n    = pprInstr (AND II32 src dst)\npprInstr (AND FF32 src dst) = pprOpOp (sLit \"andps\") FF32 src dst\npprInstr (AND FF64 src dst) = pprOpOp (sLit \"andpd\") FF64 src dst\npprInstr (AND format src dst) = pprFormatOpOp (sLit \"and\") format src dst\npprInstr (OR  format src dst) = pprFormatOpOp (sLit \"or\")  format src dst\n\npprInstr (XOR FF32 src dst) = pprOpOp (sLit \"xorps\") FF32 src dst\npprInstr (XOR FF64 src dst) = pprOpOp (sLit \"xorpd\") FF64 src dst\npprInstr (XOR format src dst) = pprFormatOpOp (sLit \"xor\")  format src dst\n\npprInstr (POPCNT format src dst) = pprOpOp (sLit \"popcnt\") format src (OpReg dst)\npprInstr (LZCNT format src dst)  = pprOpOp (sLit \"lzcnt\")  format src (OpReg dst)\npprInstr (TZCNT format src dst)  = pprOpOp (sLit \"tzcnt\")  format src (OpReg dst)\npprInstr (BSF format src dst)    = pprOpOp (sLit \"bsf\")    format src (OpReg dst)\npprInstr (BSR format src dst)    = pprOpOp (sLit \"bsr\")    format src (OpReg dst)\n\npprInstr (PDEP format src mask dst)   = pprFormatOpOpReg (sLit \"pdep\") format src mask dst\npprInstr (PEXT format src mask dst)   = pprFormatOpOpReg (sLit \"pext\") format src mask dst\n\npprInstr (PREFETCH NTA format src ) = pprFormatOp_ (sLit \"prefetchnta\") format src\npprInstr (PREFETCH Lvl0 format src) = pprFormatOp_ (sLit \"prefetcht0\") format src\npprInstr (PREFETCH Lvl1 format src) = pprFormatOp_ (sLit \"prefetcht1\") format src\npprInstr (PREFETCH Lvl2 format src) = pprFormatOp_ (sLit \"prefetcht2\") format src\n\npprInstr (NOT format op) = pprFormatOp (sLit \"not\") format op\npprInstr (BSWAP format op) = pprFormatOp (sLit \"bswap\") format (OpReg op)\npprInstr (NEGI format op) = pprFormatOp (sLit \"neg\") format op\n\npprInstr (SHL format src dst) = pprShift (sLit \"shl\") format src dst\npprInstr (SAR format src dst) = pprShift (sLit \"sar\") format src dst\npprInstr (SHR format src dst) = pprShift (sLit \"shr\") format src dst\n\npprInstr (BT  format imm src) = pprFormatImmOp (sLit \"bt\") format imm src\n\npprInstr (CMP format src dst)\n  | isFloatFormat format =  pprFormatOpOp (sLit \"ucomi\") format src dst -- SSE2\n  | otherwise     =  pprFormatOpOp (sLit \"cmp\")   format src dst\n\npprInstr (TEST format src dst) = sdocWithPlatform $ \\platform ->\n  let format' = case (src,dst) of\n        -- Match instructions like 'test $0x3,%esi' or 'test $0x7,%rbx'.\n        -- We can replace them by equivalent, but smaller instructions\n        -- by reducing the size of the immediate operand as far as possible.\n        -- (We could handle masks larger than a single byte too,\n        -- but it would complicate the code considerably\n        -- and tag checks are by far the most common case.)\n        -- The mask must have the high bit clear for this smaller encoding\n        -- to be completely equivalent to the original; in particular so\n        -- that the signed comparison condition bits are the same as they\n        -- would be if doing a full word comparison. See Trac #13425.\n        (OpImm (ImmInteger mask), OpReg dstReg)\n          | 0 <= mask && mask < 128 -> minSizeOfReg platform dstReg\n        _ -> format\n  in pprFormatOpOp (sLit \"test\") format' src dst\n  where\n    minSizeOfReg platform (RegReal (RealRegSingle i))\n      | target32Bit platform && i <= 3        = II8  -- al, bl, cl, dl\n      | target32Bit platform && i <= 7        = II16 -- si, di, bp, sp\n      | not (target32Bit platform) && i <= 15 = II8  -- al .. r15b\n    minSizeOfReg _ _ = format                 -- other\n\npprInstr (PUSH format op) = pprFormatOp (sLit \"push\") format op\npprInstr (POP format op) = pprFormatOp (sLit \"pop\") format op\n\n-- both unused (SDM):\n-- pprInstr PUSHA = text \"\\tpushal\"\n-- pprInstr POPA = text \"\\tpopal\"\n\npprInstr NOP = text \"\\tnop\"\npprInstr (CLTD II8) = text \"\\tcbtw\"\npprInstr (CLTD II16) = text \"\\tcwtd\"\npprInstr (CLTD II32) = text \"\\tcltd\"\npprInstr (CLTD II64) = text \"\\tcqto\"\npprInstr (CLTD x) = panic $ \"pprInstr: \" ++ show x\n\npprInstr (SETCC cond op) = pprCondInstr (sLit \"set\") cond (pprOperand II8 op)\n\npprInstr (JXX cond blockid)\n  = pprCondInstr (sLit \"j\") cond (ppr lab)\n  where lab = blockLbl blockid\n\npprInstr        (JXX_GBL cond imm) = pprCondInstr (sLit \"j\") cond (pprImm imm)\n\npprInstr        (JMP (OpImm imm) _) = text \"\\tjmp \" <> pprImm imm\npprInstr (JMP op _)          = sdocWithPlatform $ \\platform ->\n                               text \"\\tjmp *\"\n                                   <> pprOperand (archWordFormat (target32Bit platform)) op\npprInstr (JMP_TBL op _ _ _)  = pprInstr (JMP op [])\npprInstr        (CALL (Left imm) _)    = text \"\\tcall \" <> pprImm imm\npprInstr (CALL (Right reg) _)   = sdocWithPlatform $ \\platform ->\n                                  text \"\\tcall *\"\n                                      <> pprReg (archWordFormat (target32Bit platform)) reg\n\npprInstr (IDIV fmt op)   = pprFormatOp (sLit \"idiv\") fmt op\npprInstr (DIV fmt op)    = pprFormatOp (sLit \"div\")  fmt op\npprInstr (IMUL2 fmt op)  = pprFormatOp (sLit \"imul\") fmt op\n\n-- x86_64 only\npprInstr (MUL format op1 op2) = pprFormatOpOp (sLit \"mul\") format op1 op2\npprInstr (MUL2 format op) = pprFormatOp (sLit \"mul\") format op\n\npprInstr (FDIV format op1 op2) = pprFormatOpOp (sLit \"div\") format op1 op2\npprInstr (SQRT format op1 op2) = pprFormatOpReg (sLit \"sqrt\") format op1 op2\n\npprInstr (CVTSS2SD from to)      = pprRegReg (sLit \"cvtss2sd\") from to\npprInstr (CVTSD2SS from to)      = pprRegReg (sLit \"cvtsd2ss\") from to\npprInstr (CVTTSS2SIQ fmt from to) = pprFormatFormatOpReg (sLit \"cvttss2si\") FF32 fmt from to\npprInstr (CVTTSD2SIQ fmt from to) = pprFormatFormatOpReg (sLit \"cvttsd2si\") FF64 fmt from to\npprInstr (CVTSI2SS fmt from to)   = pprFormatOpReg (sLit \"cvtsi2ss\") fmt from to\npprInstr (CVTSI2SD fmt from to)   = pprFormatOpReg (sLit \"cvtsi2sd\") fmt from to\n\n    -- FETCHGOT for PIC on ELF platforms\npprInstr (FETCHGOT reg)\n   = vcat [ text \"\\tcall 1f\",\n            hcat [ text \"1:\\tpopl\\t\", pprReg II32 reg ],\n            hcat [ text \"\\taddl\\t$_GLOBAL_OFFSET_TABLE_+(.-1b), \",\n                   pprReg II32 reg ]\n          ]\n\n    -- FETCHPC for PIC on Darwin/x86\n    -- get the instruction pointer into a register\n    -- (Terminology note: the IP is called Program Counter on PPC,\n    --  and it's a good thing to use the same name on both platforms)\npprInstr (FETCHPC reg)\n   = vcat [ text \"\\tcall 1f\",\n            hcat [ text \"1:\\tpopl\\t\", pprReg II32 reg ]\n          ]\n\n\n-- -----------------------------------------------------------------------------\n-- i386 floating-point\n\n-- Simulating a flat register set on the x86 FP stack is tricky.\n-- you have to free %st(7) before pushing anything on the FP reg stack\n-- so as to preclude the possibility of a FP stack overflow exception.\npprInstr g@(GMOV src dst)\n   | src == dst\n   = empty\n   | otherwise\n   = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])\n\n-- GLD fmt addr dst ==> FLDsz addr ; FSTP (dst+1)\npprInstr g@(GLD fmt addr dst)\n = pprG g (hcat [gtab, text \"fld\", pprFormat_x87 fmt, gsp,\n                 pprAddr addr, gsemi, gpop dst 1])\n\n-- GST fmt src addr ==> FLD dst ; FSTPsz addr\npprInstr g@(GST fmt src addr)\n | src == fake0 && fmt /= FF80 -- fstt instruction doesn't exist\n = pprG g (hcat [gtab,\n                 text \"fst\", pprFormat_x87 fmt, gsp, pprAddr addr])\n | otherwise\n = pprG g (hcat [gtab, gpush src 0, gsemi,\n                 text \"fstp\", pprFormat_x87 fmt, gsp, pprAddr addr])\n\npprInstr g@(GLDZ dst)\n = pprG g (hcat [gtab, text \"fldz ; \", gpop dst 1])\npprInstr g@(GLD1 dst)\n = pprG g (hcat [gtab, text \"fld1 ; \", gpop dst 1])\n\npprInstr (GFTOI src dst)\n   = pprInstr (GDTOI src dst)\n\npprInstr g@(GDTOI src dst)\n   = pprG g (vcat [\n         hcat [gtab, text \"subl $8, %esp ; fnstcw 4(%esp)\"],\n         hcat [gtab, gpush src 0],\n         hcat [gtab, text \"movzwl 4(%esp), \", reg,\n                     text \" ; orl $0xC00, \", reg],\n         hcat [gtab, text \"movl \", reg, text \", 0(%esp) ; fldcw 0(%esp)\"],\n         hcat [gtab, text \"fistpl 0(%esp)\"],\n         hcat [gtab, text \"fldcw 4(%esp) ; movl 0(%esp), \", reg],\n         hcat [gtab, text \"addl $8, %esp\"]\n     ])\n   where\n     reg = pprReg II32 dst\n\npprInstr (GITOF src dst)\n   = pprInstr (GITOD src dst)\n\npprInstr g@(GITOD src dst)\n   = pprG g (hcat [gtab, text \"pushl \", pprReg II32 src,\n                   text \" ; fildl (%esp) ; \",\n                   gpop dst 1, text \" ; addl $4,%esp\"])\n\npprInstr g@(GDTOF src dst)\n  = pprG g (vcat [gtab <> gpush src 0,\n                  gtab <> text \"subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;\",\n                  gtab <> gpop dst 1])\n\n{- Gruesome swamp follows.  If you're unfortunate enough to have ventured\n   this far into the jungle AND you give a Rat's Ass (tm) what's going\n   on, here's the deal.  Generate code to do a floating point comparison\n   of src1 and src2, of kind cond, and set the Zero flag if true.\n\n   The complications are to do with handling NaNs correctly.  We want the\n   property that if either argument is NaN, then the result of the\n   comparison is False ... except if we're comparing for inequality,\n   in which case the answer is True.\n\n   Here's how the general (non-inequality) case works.  As an\n   example, consider generating the an equality test:\n\n     pushl %eax         -- we need to mess with this\n     <get src1 to top of FPU stack>\n     fcomp <src2 location in FPU stack> and pop pushed src1\n                -- Result of comparison is in FPU Status Register bits\n                -- C3 C2 and C0\n     fstsw %ax  -- Move FPU Status Reg to %ax\n     sahf       -- move C3 C2 C0 from %ax to integer flag reg\n     -- now the serious magic begins\n     setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0\n     sete  %al     -- %al = if arg1 == arg2 then 1 else 0\n     andb %ah,%al  -- %al &= %ah\n                   -- so %al == 1 iff (comparable && same); else it holds 0\n     decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);\n                      else %al == 0xFF, ZeroFlag=0\n     -- the zero flag is now set as we desire.\n     popl %eax\n\n   The special case of inequality differs thusly:\n\n     setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0\n     setne %al     -- %al = if arg1 /= arg2 then 1 else 0\n     orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0\n     decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)\n                                                     else (%al == 0xFF, ZF=0)\n-}\npprInstr g@(GCMP cond src1 src2)\n   | case cond of { NE -> True; _ -> False }\n   = pprG g (vcat [\n        hcat [gtab, text \"pushl %eax ; \",gpush src1 0],\n        hcat [gtab, text \"fcomp \", greg src2 1,\n                    text \"; fstsw %ax ; sahf ;  setpe %ah\"],\n        hcat [gtab, text \"setne %al ;  \",\n              text \"orb %ah,%al ;  decb %al ;  popl %eax\"]\n    ])\n   | otherwise\n   = pprG g (vcat [\n        hcat [gtab, text \"pushl %eax ; \",gpush src1 0],\n        hcat [gtab, text \"fcomp \", greg src2 1,\n                    text \"; fstsw %ax ; sahf ;  setpo %ah\"],\n        hcat [gtab, text \"set\", pprCond (fix_FP_cond cond), text \" %al ;  \",\n              text \"andb %ah,%al ;  decb %al ;  popl %eax\"]\n    ])\n    where\n        {- On the 486, the flags set by FP compare are the unsigned ones!\n           (This looks like a HACK to me.  WDP 96/03)\n        -}\n        fix_FP_cond :: Cond -> Cond\n        fix_FP_cond GE   = GEU\n        fix_FP_cond GTT  = GU\n        fix_FP_cond LTT  = LU\n        fix_FP_cond LE   = LEU\n        fix_FP_cond EQQ  = EQQ\n        fix_FP_cond NE   = NE\n        fix_FP_cond _    = panic \"X86.Ppr.fix_FP_cond: no match\"\n        -- there should be no others\n\n\npprInstr g@(GABS _ src dst)\n   = pprG g (hcat [gtab, gpush src 0, text \" ; fabs ; \", gpop dst 1])\n\npprInstr g@(GNEG _ src dst)\n   = pprG g (hcat [gtab, gpush src 0, text \" ; fchs ; \", gpop dst 1])\n\npprInstr g@(GSQRT fmt src dst)\n   = pprG g (hcat [gtab, gpush src 0, text \" ; fsqrt\"] $$\n             hcat [gtab, gcoerceto fmt, gpop dst 1])\n\npprInstr g@(GSIN fmt l1 l2 src dst)\n   = pprG g (pprTrigOp \"fsin\" False l1 l2 src dst fmt)\n\npprInstr g@(GCOS fmt l1 l2 src dst)\n   = pprG g (pprTrigOp \"fcos\" False l1 l2 src dst fmt)\n\npprInstr g@(GTAN fmt l1 l2 src dst)\n   = pprG g (pprTrigOp \"fptan\" True l1 l2 src dst fmt)\n\n-- In the translations for GADD, GMUL, GSUB and GDIV,\n-- the first two cases are mere optimisations.  The otherwise clause\n-- generates correct code under all circumstances.\n\npprInstr g@(GADD _ src1 src2 dst)\n   | src1 == dst\n   = pprG g (text \"\\t#GADD-xxxcase1\" $$\n             hcat [gtab, gpush src2 0,\n                   text \" ; faddp %st(0),\", greg src1 1])\n   | src2 == dst\n   = pprG g (text \"\\t#GADD-xxxcase2\" $$\n             hcat [gtab, gpush src1 0,\n                   text \" ; faddp %st(0),\", greg src2 1])\n   | otherwise\n   = pprG g (hcat [gtab, gpush src1 0,\n                   text \" ; fadd \", greg src2 1, text \",%st(0)\",\n                   gsemi, gpop dst 1])\n\n\npprInstr g@(GMUL _ src1 src2 dst)\n   | src1 == dst\n   = pprG g (text \"\\t#GMUL-xxxcase1\" $$\n             hcat [gtab, gpush src2 0,\n                   text \" ; fmulp %st(0),\", greg src1 1])\n   | src2 == dst\n   = pprG g (text \"\\t#GMUL-xxxcase2\" $$\n             hcat [gtab, gpush src1 0,\n                   text \" ; fmulp %st(0),\", greg src2 1])\n   | otherwise\n   = pprG g (hcat [gtab, gpush src1 0,\n             text \" ; fmul \", greg src2 1, text \",%st(0)\",\n             gsemi, gpop dst 1])\n\n\npprInstr g@(GSUB _ src1 src2 dst)\n   | src1 == dst\n   = pprG g (text \"\\t#GSUB-xxxcase1\" $$\n             hcat [gtab, gpush src2 0,\n                   text \" ; fsubrp %st(0),\", greg src1 1])\n   | src2 == dst\n   = pprG g (text \"\\t#GSUB-xxxcase2\" $$\n             hcat [gtab, gpush src1 0,\n                   text \" ; fsubp %st(0),\", greg src2 1])\n   | otherwise\n   = pprG g (hcat [gtab, gpush src1 0,\n                   text \" ; fsub \", greg src2 1, text \",%st(0)\",\n                   gsemi, gpop dst 1])\n\n\npprInstr g@(GDIV _ src1 src2 dst)\n   | src1 == dst\n   = pprG g (text \"\\t#GDIV-xxxcase1\" $$\n             hcat [gtab, gpush src2 0,\n                   text \" ; fdivrp %st(0),\", greg src1 1])\n   | src2 == dst\n   = pprG g (text \"\\t#GDIV-xxxcase2\" $$\n             hcat [gtab, gpush src1 0,\n                   text \" ; fdivp %st(0),\", greg src2 1])\n   | otherwise\n   = pprG g (hcat [gtab, gpush src1 0,\n                   text \" ; fdiv \", greg src2 1, text \",%st(0)\",\n                   gsemi, gpop dst 1])\n\n\npprInstr GFREE\n   = vcat [ text \"\\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)\",\n            text \"\\tffree %st(4) ;ffree %st(5)\"\n          ]\n\n-- Atomics\n\npprInstr (LOCK i) = text \"\\tlock\" $$ pprInstr i\n\npprInstr MFENCE = text \"\\tmfence\"\n\npprInstr (XADD format src dst) = pprFormatOpOp (sLit \"xadd\") format src dst\n\npprInstr (CMPXCHG format src dst)\n   = pprFormatOpOp (sLit \"cmpxchg\") format src dst\n\n\npprTrigOp :: String -> Bool -> CLabel -> CLabel\n          -> Reg -> Reg -> Format -> SDoc\npprTrigOp op -- fsin, fcos or fptan\n          isTan -- we need a couple of extra steps if we're doing tan\n          l1 l2 -- internal labels for us to use\n          src dst fmt\n    = -- We'll be needing %eax later on\n      hcat [gtab, text \"pushl %eax;\"] $$\n      -- tan is going to use an extra space on the FP stack\n      (if isTan then hcat [gtab, text \"ffree %st(6)\"] else empty) $$\n      -- First put the value in %st(0) and try to apply the op to it\n      hcat [gpush src 0, text (\"; \" ++ op)] $$\n      -- Now look to see if C2 was set (overflow, |value| >= 2^63)\n      hcat [gtab, text \"fnstsw %ax\"] $$\n      hcat [gtab, text \"test   $0x400,%eax\"] $$\n      -- If we were in bounds then jump to the end\n      hcat [gtab, text \"je     \" <> ppr l1] $$\n      -- Otherwise we need to shrink the value. Start by\n      -- loading pi, doubleing it (by adding it to itself),\n      -- and then swapping pi with the value, so the value we\n      -- want to apply op to is in %st(0) again\n      hcat [gtab, text \"ffree %st(7); fldpi\"] $$\n      hcat [gtab, text \"fadd   %st(0),%st\"] $$\n      hcat [gtab, text \"fxch   %st(1)\"] $$\n      -- Now we have a loop in which we make the value smaller,\n      -- see if it's small enough, and loop if not\n      (ppr l2 <> char ':') $$\n      hcat [gtab, text \"fprem1\"] $$\n      -- My Debian libc uses fstsw here for the tan code, but I can't\n      -- see any reason why it should need to be different for tan.\n      hcat [gtab, text \"fnstsw %ax\"] $$\n      hcat [gtab, text \"test   $0x400,%eax\"] $$\n      hcat [gtab, text \"jne    \" <> ppr l2] $$\n      hcat [gtab, text \"fstp   %st(1)\"] $$\n      hcat [gtab, text op] $$\n      (ppr l1 <> char ':') $$\n      -- Pop the 1.0 tan gave us\n      (if isTan then hcat [gtab, text \"fstp %st(0)\"] else empty) $$\n      -- Restore %eax\n      hcat [gtab, text \"popl %eax;\"] $$\n      -- And finally make the result the right size\n      hcat [gtab, gcoerceto fmt, gpop dst 1]\n\n--------------------------\n\n-- coerce %st(0) to the specified size\ngcoerceto :: Format -> SDoc\ngcoerceto FF64 = empty\ngcoerceto FF32 = empty --text \"subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; \"\ngcoerceto _    = panic \"X86.Ppr.gcoerceto: no match\"\n\ngpush :: Reg -> RegNo -> SDoc\ngpush reg offset\n   = hcat [text \"fld \", greg reg offset]\n\ngpop :: Reg -> RegNo -> SDoc\ngpop reg offset\n   = hcat [text \"fstp \", greg reg offset]\n\ngreg :: Reg -> RegNo -> SDoc\ngreg reg offset = text \"%st(\" <> int (gregno reg - firstfake+offset) <> char ')'\n\ngsemi :: SDoc\ngsemi = text \" ; \"\n\ngtab :: SDoc\ngtab  = char '\\t'\n\ngsp :: SDoc\ngsp   = char ' '\n\ngregno :: Reg -> RegNo\ngregno (RegReal (RealRegSingle i)) = i\ngregno _           = --pprPanic \"gregno\" (ppr other)\n                     999   -- bogus; only needed for debug printing\n\npprG :: Instr -> SDoc -> SDoc\npprG fake actual\n   = (char '#' <> pprGInstr fake) $$ actual\n\n\npprGInstr :: Instr -> SDoc\npprGInstr (GMOV src dst)   = pprFormatRegReg (sLit \"gmov\") FF64 src dst\npprGInstr (GLD fmt src dst) = pprFormatAddrReg (sLit \"gld\") fmt src dst\npprGInstr (GST fmt src dst) = pprFormatRegAddr (sLit \"gst\") fmt src dst\n\npprGInstr (GLDZ dst) = pprFormatReg (sLit \"gldz\") FF64 dst\npprGInstr (GLD1 dst) = pprFormatReg (sLit \"gld1\") FF64 dst\n\npprGInstr (GFTOI src dst) = pprFormatFormatRegReg (sLit \"gftoi\") FF32 II32 src dst\npprGInstr (GDTOI src dst) = pprFormatFormatRegReg (sLit \"gdtoi\") FF64 II32 src dst\n\npprGInstr (GITOF src dst) = pprFormatFormatRegReg (sLit \"gitof\") II32 FF32 src dst\npprGInstr (GITOD src dst) = pprFormatFormatRegReg (sLit \"gitod\") II32 FF64 src dst\npprGInstr (GDTOF src dst) = pprFormatFormatRegReg (sLit \"gdtof\") FF64 FF32 src dst\n\npprGInstr (GCMP co src dst) = pprCondRegReg (sLit \"gcmp_\") FF64 co src dst\npprGInstr (GABS fmt src dst) = pprFormatRegReg (sLit \"gabs\") fmt src dst\npprGInstr (GNEG fmt src dst) = pprFormatRegReg (sLit \"gneg\") fmt src dst\npprGInstr (GSQRT fmt src dst) = pprFormatRegReg (sLit \"gsqrt\") fmt src dst\npprGInstr (GSIN fmt _ _ src dst) = pprFormatRegReg (sLit \"gsin\") fmt src dst\npprGInstr (GCOS fmt _ _ src dst) = pprFormatRegReg (sLit \"gcos\") fmt src dst\npprGInstr (GTAN fmt _ _ src dst) = pprFormatRegReg (sLit \"gtan\") fmt src dst\n\npprGInstr (GADD fmt src1 src2 dst) = pprFormatRegRegReg (sLit \"gadd\") fmt src1 src2 dst\npprGInstr (GSUB fmt src1 src2 dst) = pprFormatRegRegReg (sLit \"gsub\") fmt src1 src2 dst\npprGInstr (GMUL fmt src1 src2 dst) = pprFormatRegRegReg (sLit \"gmul\") fmt src1 src2 dst\npprGInstr (GDIV fmt src1 src2 dst) = pprFormatRegRegReg (sLit \"gdiv\") fmt src1 src2 dst\n\npprGInstr _ = panic \"X86.Ppr.pprGInstr: no match\"\n\npprDollImm :: Imm -> SDoc\npprDollImm i = text \"$\" <> pprImm i\n\n\npprOperand :: Format -> Operand -> SDoc\npprOperand f (OpReg r)   = pprReg f r\npprOperand _ (OpImm i)   = pprDollImm i\npprOperand _ (OpAddr ea) = pprAddr ea\n\n\npprMnemonic_  :: PtrString -> SDoc\npprMnemonic_ name =\n   char '\\t' <> ptext name <> space\n\n\npprMnemonic  :: PtrString -> Format -> SDoc\npprMnemonic name format =\n   char '\\t' <> ptext name <> pprFormat format <> space\n\n\npprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc\npprFormatImmOp name format imm op1\n  = hcat [\n        pprMnemonic name format,\n        char '$',\n        pprImm imm,\n        comma,\n        pprOperand format op1\n    ]\n\n\npprFormatOp_ :: PtrString -> Format -> Operand -> SDoc\npprFormatOp_ name format op1\n  = hcat [\n        pprMnemonic_ name ,\n        pprOperand format op1\n    ]\n\npprFormatOp :: PtrString -> Format -> Operand -> SDoc\npprFormatOp name format op1\n  = hcat [\n        pprMnemonic name format,\n        pprOperand format op1\n    ]\n\n\npprFormatOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc\npprFormatOpOp name format op1 op2\n  = hcat [\n        pprMnemonic name format,\n        pprOperand format op1,\n        comma,\n        pprOperand format op2\n    ]\n\n\npprOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc\npprOpOp name format op1 op2\n  = hcat [\n        pprMnemonic_ name,\n        pprOperand format op1,\n        comma,\n        pprOperand format op2\n    ]\n\n\npprFormatReg :: PtrString -> Format -> Reg -> SDoc\npprFormatReg name format reg1\n  = hcat [\n        pprMnemonic name format,\n        pprReg format reg1\n    ]\n\n\npprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc\npprFormatRegReg name format reg1 reg2\n  = hcat [\n        pprMnemonic name format,\n        pprReg format reg1,\n        comma,\n        pprReg format reg2\n    ]\n\n\npprRegReg :: PtrString -> Reg -> Reg -> SDoc\npprRegReg name reg1 reg2\n  = sdocWithPlatform $ \\platform ->\n    hcat [\n        pprMnemonic_ name,\n        pprReg (archWordFormat (target32Bit platform)) reg1,\n        comma,\n        pprReg (archWordFormat (target32Bit platform)) reg2\n    ]\n\n\npprFormatOpReg :: PtrString -> Format -> Operand -> Reg -> SDoc\npprFormatOpReg name format op1 reg2\n  = sdocWithPlatform $ \\platform ->\n    hcat [\n        pprMnemonic name format,\n        pprOperand format op1,\n        comma,\n        pprReg (archWordFormat (target32Bit platform)) reg2\n    ]\n\npprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc\npprCondOpReg name format cond op1 reg2\n  = hcat [\n        char '\\t',\n        ptext name,\n        pprCond cond,\n        space,\n        pprOperand format op1,\n        comma,\n        pprReg format reg2\n    ]\n\npprCondRegReg :: PtrString -> Format -> Cond -> Reg -> Reg -> SDoc\npprCondRegReg name format cond reg1 reg2\n  = hcat [\n        char '\\t',\n        ptext name,\n        pprCond cond,\n        space,\n        pprReg format reg1,\n        comma,\n        pprReg format reg2\n    ]\n\npprFormatFormatRegReg :: PtrString -> Format -> Format -> Reg -> Reg -> SDoc\npprFormatFormatRegReg name format1 format2 reg1 reg2\n  = hcat [\n        char '\\t',\n        ptext name,\n        pprFormat format1,\n        pprFormat format2,\n        space,\n        pprReg format1 reg1,\n        comma,\n        pprReg format2 reg2\n    ]\n\npprFormatFormatOpReg :: PtrString -> Format -> Format -> Operand -> Reg -> SDoc\npprFormatFormatOpReg name format1 format2 op1 reg2\n  = hcat [\n        pprMnemonic name format2,\n        pprOperand format1 op1,\n        comma,\n        pprReg format2 reg2\n    ]\n\npprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc\npprFormatRegRegReg name format reg1 reg2 reg3\n  = hcat [\n        pprMnemonic name format,\n        pprReg format reg1,\n        comma,\n        pprReg format reg2,\n        comma,\n        pprReg format reg3\n    ]\n\npprFormatOpOpReg :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc\npprFormatOpOpReg name format op1 op2 reg3\n  = hcat [\n        pprMnemonic name format,\n        pprOperand format op1,\n        comma,\n        pprOperand format op2,\n        comma,\n        pprReg format reg3\n    ]\n\npprFormatAddrReg :: PtrString -> Format -> AddrMode -> Reg -> SDoc\npprFormatAddrReg name format op dst\n  = hcat [\n        pprMnemonic name format,\n        pprAddr op,\n        comma,\n        pprReg format dst\n    ]\n\n\npprFormatRegAddr :: PtrString -> Format -> Reg -> AddrMode -> SDoc\npprFormatRegAddr name format src op\n  = hcat [\n        pprMnemonic name format,\n        pprReg format src,\n        comma,\n        pprAddr op\n    ]\n\n\npprShift :: PtrString -> Format -> Operand -> Operand -> SDoc\npprShift name format src dest\n  = hcat [\n        pprMnemonic name format,\n        pprOperand II8 src,  -- src is 8-bit sized\n        comma,\n        pprOperand format dest\n    ]\n\n\npprFormatOpOpCoerce :: PtrString -> Format -> Format -> Operand -> Operand -> SDoc\npprFormatOpOpCoerce name format1 format2 op1 op2\n  = hcat [ char '\\t', ptext name, pprFormat format1, pprFormat format2, space,\n        pprOperand format1 op1,\n        comma,\n        pprOperand format2 op2\n    ]\n\n\npprCondInstr :: PtrString -> Cond -> SDoc -> SDoc\npprCondInstr name cond arg\n  = hcat [ char '\\t', ptext name, pprCond cond, space, arg]\n", "num_lines": 1366}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule X86.RegInfo (\n        mkVirtualReg,\n        regDotColor\n)\n\nwhere\n\n#include \"nativeGen/NCG.h\"\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Format\nimport Reg\n\nimport Outputable\nimport Platform\nimport Unique\n\nimport UniqFM\nimport X86.Regs\n\n\nmkVirtualReg :: Unique -> Format -> VirtualReg\nmkVirtualReg u format\n   = case format of\n        FF32    -> VirtualRegSSE u\n        FF64    -> VirtualRegSSE u\n        FF80    -> VirtualRegD   u\n        _other  -> VirtualRegI   u\n\nregDotColor :: Platform -> RealReg -> SDoc\nregDotColor platform reg\n = case (lookupUFM (regColors platform) reg) of\n        Just str -> text str\n        _        -> panic \"Register not assigned a color\"\n\nregColors :: Platform -> UniqFM [Char]\nregColors platform = listToUFM (normalRegColors platform ++ fpRegColors platform)\n\nnormalRegColors :: Platform -> [(Reg,String)]\nnormalRegColors platform =\n    zip (map regSingle [0..lastint platform]) colors\n  where\n    -- 16 colors - enough for amd64 gp regs\n    colors = [\"#800000\",\"#ff0000\",\"#808000\",\"#ffff00\",\"#008000\"\n             ,\"#00ff00\",\"#008080\",\"#00ffff\",\"#000080\",\"#0000ff\"\n             ,\"#800080\",\"#ff00ff\",\"#87005f\",\"#875f00\",\"#87af00\"\n             ,\"#ff00af\"]\n\nfpRegColors :: Platform -> [(Reg,String)]\nfpRegColors platform =\n        [ (fake0, \"red\")\n        , (fake1, \"red\")\n        , (fake2, \"red\")\n        , (fake3, \"red\")\n        , (fake4, \"red\")\n        , (fake5, \"red\") ]\n\n        ++ zip (map regSingle [firstxmm..lastxmm platform]) greys\n  where\n    -- 16 shades of grey, enough for the currently supported\n    -- SSE extensions.\n    greys = [\"#0e0e0e\",\"#1c1c1c\",\"#2a2a2a\",\"#383838\",\"#464646\"\n            ,\"#545454\",\"#626262\",\"#707070\",\"#7e7e7e\",\"#8c8c8c\"\n            ,\"#9a9a9a\",\"#a8a8a8\",\"#b6b6b6\",\"#c4c4c4\",\"#d2d2d2\"\n            ,\"#e0e0e0\"]\n\n\n\n--     32 shades of grey - use for avx 512 if we ever need it\n--     greys = [\"#070707\",\"#0e0e0e\",\"#151515\",\"#1c1c1c\"\n--             ,\"#232323\",\"#2a2a2a\",\"#313131\",\"#383838\",\"#3f3f3f\"\n--             ,\"#464646\",\"#4d4d4d\",\"#545454\",\"#5b5b5b\",\"#626262\"\n--             ,\"#696969\",\"#707070\",\"#777777\",\"#7e7e7e\",\"#858585\"\n--             ,\"#8c8c8c\",\"#939393\",\"#9a9a9a\",\"#a1a1a1\",\"#a8a8a8\"\n--             ,\"#afafaf\",\"#b6b6b6\",\"#bdbdbd\",\"#c4c4c4\",\"#cbcbcb\"\n--             ,\"#d2d2d2\",\"#d9d9d9\",\"#e0e0e0\"]\n\n\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule X86.Regs (\n        -- squeese functions for the graph allocator\n        virtualRegSqueeze,\n        realRegSqueeze,\n\n        -- immediates\n        Imm(..),\n        strImmLit,\n        litToImm,\n\n        -- addressing modes\n        AddrMode(..),\n        addrOffset,\n\n        -- registers\n        spRel,\n        argRegs,\n        allArgRegs,\n        allIntArgRegs,\n        callClobberedRegs,\n        instrClobberedRegs,\n        allMachRegNos,\n        classOfRealReg,\n        showReg,\n\n        -- machine specific\n        EABase(..), EAIndex(..), addrModeRegs,\n\n        eax, ebx, ecx, edx, esi, edi, ebp, esp,\n        fake0, fake1, fake2, fake3, fake4, fake5, firstfake,\n\n        rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp,\n        r8,  r9,  r10, r11, r12, r13, r14, r15,\n        lastint,\n        xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,\n        xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15,\n        xmm,\n        firstxmm, lastxmm,\n\n        ripRel,\n        allFPArgRegs,\n\n        allocatableRegs\n)\n\nwhere\n\n#include \"nativeGen/NCG.h\"\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CodeGen.Platform\nimport Reg\nimport RegClass\n\nimport Cmm\nimport CLabel           ( CLabel )\nimport DynFlags\nimport Outputable\nimport Platform\n\nimport qualified Data.Array as A\n\n-- | regSqueeze_class reg\n--      Calculate the maximum number of register colors that could be\n--      denied to a node of this class due to having this reg\n--      as a neighbour.\n--\n{-# INLINE virtualRegSqueeze #-}\nvirtualRegSqueeze :: RegClass -> VirtualReg -> Int\n\nvirtualRegSqueeze cls vr\n = case cls of\n        RcInteger\n         -> case vr of\n                VirtualRegI{}           -> 1\n                VirtualRegHi{}          -> 1\n                _other                  -> 0\n\n        RcDouble\n         -> case vr of\n                VirtualRegD{}           -> 1\n                VirtualRegF{}           -> 0\n                _other                  -> 0\n\n        RcDoubleSSE\n         -> case vr of\n                VirtualRegSSE{}         -> 1\n                _other                  -> 0\n\n        _other -> 0\n\n{-# INLINE realRegSqueeze #-}\nrealRegSqueeze :: RegClass -> RealReg -> Int\nrealRegSqueeze cls rr\n = case cls of\n        RcInteger\n         -> case rr of\n                RealRegSingle regNo\n                        | regNo < firstfake -> 1\n                        | otherwise     -> 0\n\n                RealRegPair{}           -> 0\n\n        RcDouble\n         -> case rr of\n                RealRegSingle regNo\n                        | regNo >= firstfake && regNo <= lastfake -> 1\n                        | otherwise     -> 0\n\n                RealRegPair{}           -> 0\n\n        RcDoubleSSE\n         -> case rr of\n                RealRegSingle regNo | regNo >= firstxmm -> 1\n                _otherwise                        -> 0\n\n        _other -> 0\n\n-- -----------------------------------------------------------------------------\n-- Immediates\n\ndata Imm\n  = ImmInt      Int\n  | ImmInteger  Integer     -- Sigh.\n  | ImmCLbl     CLabel      -- AbstractC Label (with baggage)\n  | ImmLit      SDoc        -- Simple string\n  | ImmIndex    CLabel Int\n  | ImmFloat    Rational\n  | ImmDouble   Rational\n  | ImmConstantSum Imm Imm\n  | ImmConstantDiff Imm Imm\n\nstrImmLit :: String -> Imm\nstrImmLit s = ImmLit (text s)\n\n\nlitToImm :: CmmLit -> Imm\nlitToImm (CmmInt i w)        = ImmInteger (narrowS w i)\n                -- narrow to the width: a CmmInt might be out of\n                -- range, but we assume that ImmInteger only contains\n                -- in-range values.  A signed value should be fine here.\nlitToImm (CmmFloat f W32)    = ImmFloat f\nlitToImm (CmmFloat f W64)    = ImmDouble f\nlitToImm (CmmLabel l)        = ImmCLbl l\nlitToImm (CmmLabelOff l off) = ImmIndex l off\nlitToImm (CmmLabelDiffOff l1 l2 off _)\n                             = ImmConstantSum\n                               (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))\n                               (ImmInt off)\nlitToImm _                   = panic \"X86.Regs.litToImm: no match\"\n\n-- addressing modes ------------------------------------------------------------\n\ndata AddrMode\n        = AddrBaseIndex EABase EAIndex Displacement\n        | ImmAddr Imm Int\n\ndata EABase       = EABaseNone  | EABaseReg Reg | EABaseRip\ndata EAIndex      = EAIndexNone | EAIndex Reg Int\ntype Displacement = Imm\n\n\naddrOffset :: AddrMode -> Int -> Maybe AddrMode\naddrOffset addr off\n  = case addr of\n      ImmAddr i off0      -> Just (ImmAddr i (off0 + off))\n\n      AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))\n      AddrBaseIndex r i (ImmInteger n)\n        -> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))\n\n      AddrBaseIndex r i (ImmCLbl lbl)\n        -> Just (AddrBaseIndex r i (ImmIndex lbl off))\n\n      AddrBaseIndex r i (ImmIndex lbl ix)\n        -> Just (AddrBaseIndex r i (ImmIndex lbl (ix+off)))\n\n      _ -> Nothing  -- in theory, shouldn't happen\n\n\naddrModeRegs :: AddrMode -> [Reg]\naddrModeRegs (AddrBaseIndex b i _) =  b_regs ++ i_regs\n  where\n   b_regs = case b of { EABaseReg r -> [r]; _ -> [] }\n   i_regs = case i of { EAIndex r _ -> [r]; _ -> [] }\naddrModeRegs _ = []\n\n\n-- registers -------------------------------------------------------------------\n\n-- @spRel@ gives us a stack relative addressing mode for volatile\n-- temporaries and for excess call arguments.  @fpRel@, where\n-- applicable, is the same but for the frame pointer.\n\n\nspRel :: DynFlags\n      -> Int -- ^ desired stack offset in bytes, positive or negative\n      -> AddrMode\nspRel dflags n\n | target32Bit (targetPlatform dflags)\n    = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt n)\n | otherwise\n    = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt n)\n\n-- The register numbers must fit into 32 bits on x86, so that we can\n-- use a Word32 to represent the set of free registers in the register\n-- allocator.\n\nfirstfake, lastfake :: RegNo\nfirstfake = 16\nlastfake  = 21\n\nfirstxmm :: RegNo\nfirstxmm  = 24\n\nlastxmm :: Platform -> RegNo\nlastxmm platform\n | target32Bit platform = 31\n | otherwise            = 39\n\nlastint :: Platform -> RegNo\nlastint platform\n | target32Bit platform = 7 -- not %r8..%r15\n | otherwise            = 15\n\nintregnos :: Platform -> [RegNo]\nintregnos platform = [0 .. lastint platform]\n\nfakeregnos :: [RegNo]\nfakeregnos  = [firstfake .. lastfake]\n\nxmmregnos :: Platform -> [RegNo]\nxmmregnos platform = [firstxmm  .. lastxmm platform]\n\nfloatregnos :: Platform -> [RegNo]\nfloatregnos platform = fakeregnos ++ xmmregnos platform\n\n-- argRegs is the set of regs which are read for an n-argument call to C.\n-- For archs which pass all args on the stack (x86), is empty.\n-- Sparc passes up to the first 6 args in regs.\nargRegs :: RegNo -> [Reg]\nargRegs _       = panic \"MachRegs.argRegs(x86): should not be used!\"\n\n-- | The complete set of machine registers.\nallMachRegNos :: Platform -> [RegNo]\nallMachRegNos platform = intregnos platform ++ floatregnos platform\n\n-- | Take the class of a register.\n{-# INLINE classOfRealReg #-}\nclassOfRealReg :: Platform -> RealReg -> RegClass\n-- On x86, we might want to have an 8-bit RegClass, which would\n-- contain just regs 1-4 (the others don't have 8-bit versions).\n-- However, we can get away without this at the moment because the\n-- only allocatable integer regs are also 8-bit compatible (1, 3, 4).\nclassOfRealReg platform reg\n = case reg of\n        RealRegSingle i\n          | i <= lastint platform -> RcInteger\n          | i <= lastfake         -> RcDouble\n          | otherwise             -> RcDoubleSSE\n\n        RealRegPair{}   -> panic \"X86.Regs.classOfRealReg: RegPairs on this arch\"\n\n-- | Get the name of the register with this number.\nshowReg :: Platform -> RegNo -> String\nshowReg platform n\n        | n >= firstxmm  = \"%xmm\" ++ show (n-firstxmm)\n        | n >= firstfake = \"%fake\" ++ show (n-firstfake)\n        | n >= 8         = \"%r\" ++ show n\n        | otherwise      = regNames platform A.! n\n\nregNames :: Platform -> A.Array Int String\nregNames platform\n    = if target32Bit platform\n      then A.listArray (0,8) [\"%eax\", \"%ebx\", \"%ecx\", \"%edx\", \"%esi\", \"%edi\", \"%ebp\", \"%esp\"]\n      else A.listArray (0,8) [\"%rax\", \"%rbx\", \"%rcx\", \"%rdx\", \"%rsi\", \"%rdi\", \"%rbp\", \"%rsp\"]\n\n\n\n-- machine specific ------------------------------------------------------------\n\n\n{-\nIntel x86 architecture:\n- All registers except 7 (esp) are available for use.\n- Only ebx, esi, edi and esp are available across a C call (they are callee-saves).\n- Registers 0-7 have 16-bit counterparts (ax, bx etc.)\n- Registers 0-3 have 8 bit counterparts (ah, bh etc.)\n- Registers fake0..fake5 are fakes; we pretend x86 has 6 conventionally-addressable\n  fp registers, and 3-operand insns for them, and we translate this into\n  real stack-based x86 fp code after register allocation.\n\nThe fp registers are all Double registers; we don't have any RcFloat class\nregs.  @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should\nnever generate them.\n-}\n\nfake0, fake1, fake2, fake3, fake4, fake5,\n       eax, ebx, ecx, edx, esp, ebp, esi, edi :: Reg\n\neax   = regSingle 0\nebx   = regSingle 1\necx   = regSingle 2\nedx   = regSingle 3\nesi   = regSingle 4\nedi   = regSingle 5\nebp   = regSingle 6\nesp   = regSingle 7\nfake0 = regSingle 16\nfake1 = regSingle 17\nfake2 = regSingle 18\nfake3 = regSingle 19\nfake4 = regSingle 20\nfake5 = regSingle 21\n\n\n\n{-\nAMD x86_64 architecture:\n- All 16 integer registers are addressable as 8, 16, 32 and 64-bit values:\n\n  8     16    32    64\n  ---------------------\n  al    ax    eax   rax\n  bl    bx    ebx   rbx\n  cl    cx    ecx   rcx\n  dl    dx    edx   rdx\n  sil   si    esi   rsi\n  dil   si    edi   rdi\n  bpl   bp    ebp   rbp\n  spl   sp    esp   rsp\n  r10b  r10w  r10d  r10\n  r11b  r11w  r11d  r11\n  r12b  r12w  r12d  r12\n  r13b  r13w  r13d  r13\n  r14b  r14w  r14d  r14\n  r15b  r15w  r15d  r15\n-}\n\nrax, rbx, rcx, rdx, rsp, rbp, rsi, rdi,\n  r8, r9, r10, r11, r12, r13, r14, r15,\n  xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,\n  xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15 :: Reg\n\nrax   = regSingle 0\nrbx   = regSingle 1\nrcx   = regSingle 2\nrdx   = regSingle 3\nrsi   = regSingle 4\nrdi   = regSingle 5\nrbp   = regSingle 6\nrsp   = regSingle 7\nr8    = regSingle 8\nr9    = regSingle 9\nr10   = regSingle 10\nr11   = regSingle 11\nr12   = regSingle 12\nr13   = regSingle 13\nr14   = regSingle 14\nr15   = regSingle 15\nxmm0  = regSingle 24\nxmm1  = regSingle 25\nxmm2  = regSingle 26\nxmm3  = regSingle 27\nxmm4  = regSingle 28\nxmm5  = regSingle 29\nxmm6  = regSingle 30\nxmm7  = regSingle 31\nxmm8  = regSingle 32\nxmm9  = regSingle 33\nxmm10 = regSingle 34\nxmm11 = regSingle 35\nxmm12 = regSingle 36\nxmm13 = regSingle 37\nxmm14 = regSingle 38\nxmm15 = regSingle 39\n\nripRel :: Displacement -> AddrMode\nripRel imm      = AddrBaseIndex EABaseRip EAIndexNone imm\n\n\n -- so we can re-use some x86 code:\n{-\neax = rax\nebx = rbx\necx = rcx\nedx = rdx\nesi = rsi\nedi = rdi\nebp = rbp\nesp = rsp\n-}\n\nxmm :: RegNo -> Reg\nxmm n = regSingle (firstxmm+n)\n\n\n\n\n-- | these are the regs which we cannot assume stay alive over a C call.\ncallClobberedRegs       :: Platform -> [Reg]\n-- caller-saves registers\ncallClobberedRegs platform\n | target32Bit platform = [eax,ecx,edx] ++ map regSingle (floatregnos platform)\n | platformOS platform == OSMinGW32\n   = [rax,rcx,rdx,r8,r9,r10,r11]\n   -- Only xmm0-5 are caller-saves registers on 64bit windows.\n   -- ( https://docs.microsoft.com/en-us/cpp/build/register-usage )\n   -- For details check the Win64 ABI.\n   ++ map regSingle fakeregnos ++ map xmm [0  .. 5]\n | otherwise\n    -- all xmm regs are caller-saves\n    -- caller-saves registers\n    = [rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11]\n   ++ map regSingle (floatregnos platform)\n\nallArgRegs :: Platform -> [(Reg, Reg)]\nallArgRegs platform\n | platformOS platform == OSMinGW32 = zip [rcx,rdx,r8,r9]\n                                          (map regSingle [firstxmm ..])\n | otherwise = panic \"X86.Regs.allArgRegs: not defined for this arch\"\n\nallIntArgRegs :: Platform -> [Reg]\nallIntArgRegs platform\n | (platformOS platform == OSMinGW32) || target32Bit platform\n    = panic \"X86.Regs.allIntArgRegs: not defined for this platform\"\n | otherwise = [rdi,rsi,rdx,rcx,r8,r9]\n\nallFPArgRegs :: Platform -> [Reg]\nallFPArgRegs platform\n | platformOS platform == OSMinGW32\n    = panic \"X86.Regs.allFPArgRegs: not defined for this platform\"\n | otherwise = map regSingle [firstxmm .. firstxmm+7]\n\n-- Machine registers which might be clobbered by instructions that\n-- generate results into fixed registers, or need arguments in a fixed\n-- register.\ninstrClobberedRegs :: Platform -> [Reg]\ninstrClobberedRegs platform\n | target32Bit platform = [ eax, ecx, edx ]\n | otherwise            = [ rax, rcx, rdx ]\n\n--\n\n-- allocatableRegs is allMachRegNos with the fixed-use regs removed.\n-- i.e., these are the regs for which we are prepared to allow the\n-- register allocator to attempt to map VRegs to.\nallocatableRegs :: Platform -> [RealReg]\nallocatableRegs platform\n   = let isFree i = freeReg platform i\n     in  map RealRegSingle $ filter isFree (allMachRegNos platform)\n\n", "num_lines": 457}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule ApiAnnotation (\n  getAnnotation, getAndRemoveAnnotation,\n  getAnnotationComments,getAndRemoveAnnotationComments,\n  ApiAnns,\n  ApiAnnKey,\n  AnnKeywordId(..),\n  AnnotationComment(..),\n  IsUnicodeSyntax(..),\n  unicodeAnn,\n  HasE(..),\n  LRdrName -- Exists for haddocks only\n  ) where\n\nimport GhcPrelude\n\nimport RdrName\nimport Outputable\nimport SrcLoc\nimport qualified Data.Map as Map\nimport Data.Data\n\n\n{-\nNote [Api annotations]\n~~~~~~~~~~~~~~~~~~~~~~\nGiven a parse tree of a Haskell module, how can we reconstruct\nthe original Haskell source code, retaining all whitespace and\nsource code comments?  We need to track the locations of all\nelements from the original source: this includes keywords such as\n'let' / 'in' / 'do' etc as well as punctuation such as commas and\nbraces, and also comments.  We collectively refer to this\nmetadata as the \"API annotations\".\n\nRather than annotate the resulting parse tree with these locations\ndirectly (this would be a major change to some fairly core data\nstructures in GHC), we instead capture locations for these elements in a\nstructure separate from the parse tree, and returned in the\npm_annotations field of the ParsedModule type.\n\nThe full ApiAnns type is\n\n> type ApiAnns = ( Map.Map ApiAnnKey [SrcSpan]                  -- non-comments\n>                , Map.Map SrcSpan [Located AnnotationComment]) -- comments\n\nNON-COMMENT ELEMENTS\n\nIntuitively, every AST element directly contains a bag of keywords\n(keywords can show up more than once in a node: a semicolon i.e. newline\ncan show up multiple times before the next AST element), each of which\nneeds to be associated with its location in the original source code.\n\nConsequently, the structure that records non-comment elements is logically\na two level map, from the SrcSpan of the AST element containing it, to\na map from keywords ('AnnKeyWord') to all locations of the keyword directly\nin the AST element:\n\n> type ApiAnnKey = (SrcSpan,AnnKeywordId)\n>\n> Map.Map ApiAnnKey [SrcSpan]\n\nSo\n\n> let x = 1 in 2 *x\n\nwould result in the AST element\n\n  L span (HsLet (binds for x = 1) (2 * x))\n\nand the annotations\n\n  (span,AnnLet) having the location of the 'let' keyword\n  (span,AnnEqual) having the location of the '=' sign\n  (span,AnnIn)  having the location of the 'in' keyword\n\nFor any given element in the AST, there is only a set number of\nkeywords that are applicable for it (e.g., you'll never see an\n'import' keyword associated with a let-binding.)  The set of allowed\nkeywords is documented in a comment associated with the constructor\nof a given AST element, although the ground truth is in Parser\nand RdrHsSyn (which actually add the annotations; see #13012).\n\nCOMMENT ELEMENTS\n\nEvery comment is associated with a *located* AnnotationComment.\nWe associate comments with the lowest (most specific) AST element\nenclosing them:\n\n> Map.Map SrcSpan [Located AnnotationComment]\n\nPARSER STATE\n\nThere are three fields in PState (the parser state) which play a role\nwith annotations.\n\n>  annotations :: [(ApiAnnKey,[SrcSpan])],\n>  comment_q :: [Located AnnotationComment],\n>  annotations_comments :: [(SrcSpan,[Located AnnotationComment])]\n\nThe 'annotations' and 'annotations_comments' fields are simple: they simply\naccumulate annotations that will end up in 'ApiAnns' at the end\n(after they are passed to Map.fromList).\n\nThe 'comment_q' field captures comments as they are seen in the token stream,\nso that when they are ready to be allocated via the parser they are\navailable (at the time we lex a comment, we don't know what the enclosing\nAST node of it is, so we can't associate it with a SrcSpan in\nannotations_comments).\n\nPARSER EMISSION OF ANNOTATIONS\n\nThe parser interacts with the lexer using the function\n\n> addAnnotation :: SrcSpan -> AnnKeywordId -> SrcSpan -> P ()\n\nwhich takes the AST element SrcSpan, the annotation keyword and the\ntarget SrcSpan.\n\nThis adds the annotation to the `annotations` field of `PState` and\ntransfers any comments in `comment_q` WHICH ARE ENCLOSED by\nthe SrcSpan of this element to the `annotations_comments`\nfield.  (Comments which are outside of this annotation are deferred\nuntil later. 'allocateComments' in 'Lexer' is responsible for\nmaking sure we only attach comments that actually fit in the 'SrcSpan'.)\n\nThe wiki page describing this feature is\nhttps://ghc.haskell.org/trac/ghc/wiki/ApiAnnotations\n\n-}\n-- ---------------------------------------------------------------------\n\n-- If you update this, update the Note [Api annotations] above\ntype ApiAnns = ( Map.Map ApiAnnKey [SrcSpan]\n               , Map.Map SrcSpan [Located AnnotationComment])\n\n-- If you update this, update the Note [Api annotations] above\ntype ApiAnnKey = (SrcSpan,AnnKeywordId)\n\n\n-- | Retrieve a list of annotation 'SrcSpan's based on the 'SrcSpan'\n-- of the annotated AST element, and the known type of the annotation.\ngetAnnotation :: ApiAnns -> SrcSpan -> AnnKeywordId -> [SrcSpan]\ngetAnnotation (anns,_) span ann\n   = case Map.lookup (span,ann) anns of\n       Nothing -> []\n       Just ss -> ss\n\n-- | Retrieve a list of annotation 'SrcSpan's based on the 'SrcSpan'\n-- of the annotated AST element, and the known type of the annotation.\n-- The list is removed from the annotations.\ngetAndRemoveAnnotation :: ApiAnns -> SrcSpan -> AnnKeywordId\n                       -> ([SrcSpan],ApiAnns)\ngetAndRemoveAnnotation (anns,cs) span ann\n   = case Map.lookup (span,ann) anns of\n       Nothing -> ([],(anns,cs))\n       Just ss -> (ss,(Map.delete (span,ann) anns,cs))\n\n-- |Retrieve the comments allocated to the current 'SrcSpan'\n--\n--  Note: A given 'SrcSpan' may appear in multiple AST elements,\n--  beware of duplicates\ngetAnnotationComments :: ApiAnns -> SrcSpan -> [Located AnnotationComment]\ngetAnnotationComments (_,anns) span =\n  case Map.lookup span anns of\n    Just cs -> cs\n    Nothing -> []\n\n-- |Retrieve the comments allocated to the current 'SrcSpan', and\n-- remove them from the annotations\ngetAndRemoveAnnotationComments :: ApiAnns -> SrcSpan\n                               -> ([Located AnnotationComment],ApiAnns)\ngetAndRemoveAnnotationComments (anns,canns) span =\n  case Map.lookup span canns of\n    Just cs -> (cs,(anns,Map.delete span canns))\n    Nothing -> ([],(anns,canns))\n\n-- --------------------------------------------------------------------\n\n-- | API Annotations exist so that tools can perform source to source\n-- conversions of Haskell code. They are used to keep track of the\n-- various syntactic keywords that are not captured in the existing\n-- AST.\n--\n-- The annotations, together with original source comments are made\n-- available in the @'pm_annotations'@ field of @'GHC.ParsedModule'@.\n-- Comments are only retained if @'Opt_KeepRawTokenStream'@ is set in\n-- @'DynFlags.DynFlags'@ before parsing.\n--\n-- The wiki page describing this feature is\n-- https://ghc.haskell.org/trac/ghc/wiki/ApiAnnotations\n--\n-- Note: in general the names of these are taken from the\n-- corresponding token, unless otherwise noted\n-- See note [Api annotations] above for details of the usage\ndata AnnKeywordId\n    = AnnAnyclass\n    | AnnAs\n    | AnnAt\n    | AnnBang  -- ^ '!'\n    | AnnBackquote -- ^ '`'\n    | AnnBy\n    | AnnCase -- ^ case or lambda case\n    | AnnClass\n    | AnnClose -- ^  '\\#)' or '\\#-}'  etc\n    | AnnCloseB -- ^ '|)'\n    | AnnCloseBU -- ^ '|)', unicode variant\n    | AnnCloseC -- ^ '}'\n    | AnnCloseQ  -- ^ '|]'\n    | AnnCloseQU -- ^ '|]', unicode variant\n    | AnnCloseP -- ^ ')'\n    | AnnCloseS -- ^ ']'\n    | AnnColon\n    | AnnComma -- ^ as a list separator\n    | AnnCommaTuple -- ^ in a RdrName for a tuple\n    | AnnDarrow -- ^ '=>'\n    | AnnDarrowU -- ^ '=>', unicode variant\n    | AnnData\n    | AnnDcolon -- ^ '::'\n    | AnnDcolonU -- ^ '::', unicode variant\n    | AnnDefault\n    | AnnDeriving\n    | AnnDo\n    | AnnDot    -- ^ '.'\n    | AnnDotdot -- ^ '..'\n    | AnnElse\n    | AnnEqual\n    | AnnExport\n    | AnnFamily\n    | AnnForall\n    | AnnForallU -- ^ Unicode variant\n    | AnnForeign\n    | AnnFunId -- ^ for function name in matches where there are\n               -- multiple equations for the function.\n    | AnnGroup\n    | AnnHeader -- ^ for CType\n    | AnnHiding\n    | AnnIf\n    | AnnImport\n    | AnnIn\n    | AnnInfix -- ^ 'infix' or 'infixl' or 'infixr'\n    | AnnInstance\n    | AnnLam\n    | AnnLarrow     -- ^ '<-'\n    | AnnLarrowU    -- ^ '<-', unicode variant\n    | AnnLet\n    | AnnMdo\n    | AnnMinus -- ^ '-'\n    | AnnModule\n    | AnnNewtype\n    | AnnName -- ^ where a name loses its location in the AST, this carries it\n    | AnnOf\n    | AnnOpen    -- ^ '(\\#' or '{-\\# LANGUAGE' etc\n    | AnnOpenB   -- ^ '(|'\n    | AnnOpenBU  -- ^ '(|', unicode variant\n    | AnnOpenC   -- ^ '{'\n    | AnnOpenE   -- ^ '[e|' or '[e||'\n    | AnnOpenEQ  -- ^ '[|'\n    | AnnOpenEQU -- ^ '[|', unicode variant\n    | AnnOpenP   -- ^ '('\n    | AnnOpenPE  -- ^ '$('\n    | AnnOpenPTE -- ^ '$$('\n    | AnnOpenS   -- ^ '['\n    | AnnPackageName\n    | AnnPattern\n    | AnnProc\n    | AnnQualified\n    | AnnRarrow -- ^ '->'\n    | AnnRarrowU -- ^ '->', unicode variant\n    | AnnRec\n    | AnnRole\n    | AnnSafe\n    | AnnSemi -- ^ ';'\n    | AnnSimpleQuote -- ^ '''\n    | AnnSignature\n    | AnnStatic -- ^ 'static'\n    | AnnStock\n    | AnnThen\n    | AnnThIdSplice -- ^ '$'\n    | AnnThIdTySplice -- ^ '$$'\n    | AnnThTyQuote -- ^ double '''\n    | AnnTilde -- ^ '~'\n    | AnnType\n    | AnnUnit -- ^ '()' for types\n    | AnnUsing\n    | AnnVal  -- ^ e.g. INTEGER\n    | AnnValStr  -- ^ String value, will need quotes when output\n    | AnnVbar -- ^ '|'\n    | AnnVia -- ^ 'via'\n    | AnnWhere\n    | Annlarrowtail -- ^ '-<'\n    | AnnlarrowtailU -- ^ '-<', unicode variant\n    | Annrarrowtail -- ^ '->'\n    | AnnrarrowtailU -- ^ '->', unicode variant\n    | AnnLarrowtail -- ^ '-<<'\n    | AnnLarrowtailU -- ^ '-<<', unicode variant\n    | AnnRarrowtail -- ^ '>>-'\n    | AnnRarrowtailU -- ^ '>>-', unicode variant\n    | AnnEofPos\n    deriving (Eq, Ord, Data, Show)\n\ninstance Outputable AnnKeywordId where\n  ppr x = text (show x)\n\n-- ---------------------------------------------------------------------\n\ndata AnnotationComment =\n  -- Documentation annotations\n    AnnDocCommentNext  String     -- ^ something beginning '-- |'\n  | AnnDocCommentPrev  String     -- ^ something beginning '-- ^'\n  | AnnDocCommentNamed String     -- ^ something beginning '-- $'\n  | AnnDocSection      Int String -- ^ a section heading\n  | AnnDocOptions      String     -- ^ doc options (prune, ignore-exports, etc)\n  | AnnLineComment     String     -- ^ comment starting by \"--\"\n  | AnnBlockComment    String     -- ^ comment in {- -}\n    deriving (Eq, Ord, Data, Show)\n-- Note: these are based on the Token versions, but the Token type is\n-- defined in Lexer.x and bringing it in here would create a loop\n\ninstance Outputable AnnotationComment where\n  ppr x = text (show x)\n\n-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',\n--             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma',\n--             'ApiAnnotation.AnnRarrow'\n--             'ApiAnnotation.AnnTilde'\n--   - May have 'ApiAnnotation.AnnComma' when in a list\ntype LRdrName = Located RdrName\n\n\n-- | Certain tokens can have alternate representations when unicode syntax is\n-- enabled. This flag is attached to those tokens in the lexer so that the\n-- original source representation can be reproduced in the corresponding\n-- 'ApiAnnotation'\ndata IsUnicodeSyntax = UnicodeSyntax | NormalSyntax\n    deriving (Eq, Ord, Data, Show)\n\n-- | Convert a normal annotation into its unicode equivalent one\nunicodeAnn :: AnnKeywordId -> AnnKeywordId\nunicodeAnn AnnForall     = AnnForallU\nunicodeAnn AnnDcolon     = AnnDcolonU\nunicodeAnn AnnLarrow     = AnnLarrowU\nunicodeAnn AnnRarrow     = AnnRarrowU\nunicodeAnn AnnDarrow     = AnnDarrowU\nunicodeAnn Annlarrowtail = AnnlarrowtailU\nunicodeAnn Annrarrowtail = AnnrarrowtailU\nunicodeAnn AnnLarrowtail = AnnLarrowtailU\nunicodeAnn AnnRarrowtail = AnnRarrowtailU\nunicodeAnn AnnOpenB      = AnnOpenBU\nunicodeAnn AnnCloseB     = AnnCloseBU\nunicodeAnn AnnOpenEQ     = AnnOpenEQU\nunicodeAnn AnnCloseQ     = AnnCloseQU\nunicodeAnn ann           = ann\n\n\n-- | Some template haskell tokens have two variants, one with an `e` the other\n-- not:\n--\n-- >  [| or [e|\n-- >  [|| or [e||\n--\n-- This type indicates whether the 'e' is present or not.\ndata HasE = HasE | NoE\n     deriving (Eq, Ord, Data, Show)\n", "num_lines": 365}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Character classification\n{-# LANGUAGE CPP #-}\nmodule Ctype\n        ( is_ident      -- Char# -> Bool\n        , is_symbol     -- Char# -> Bool\n        , is_any        -- Char# -> Bool\n        , is_space      -- Char# -> Bool\n        , is_lower      -- Char# -> Bool\n        , is_upper      -- Char# -> Bool\n        , is_digit      -- Char# -> Bool\n        , is_alphanum   -- Char# -> Bool\n\n        , is_decdigit, is_hexdigit, is_octdigit, is_bindigit\n        , hexDigit, octDecDigit\n        ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Data.Bits        ( Bits((.&.),(.|.)) )\nimport Data.Char        ( ord, chr )\nimport Data.Word\nimport Panic\n\n-- Bit masks\n\ncIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit :: Word8\ncIdent  =  1\ncSymbol =  2\ncAny    =  4\ncSpace  =  8\ncLower  = 16\ncUpper  = 32\ncDigit  = 64\n\n-- | The predicates below look costly, but aren't, GHC+GCC do a great job\n-- at the big case below.\n\n{-# INLINABLE is_ctype #-}\nis_ctype :: Word8 -> Char -> Bool\nis_ctype mask c = (charType c .&. mask) /= 0\n\nis_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit,\n    is_alphanum :: Char -> Bool\nis_ident  = is_ctype cIdent\nis_symbol = is_ctype cSymbol\nis_any    = is_ctype cAny\nis_space  = is_ctype cSpace\nis_lower  = is_ctype cLower\nis_upper  = is_ctype cUpper\nis_digit  = is_ctype cDigit\nis_alphanum = is_ctype (cLower+cUpper+cDigit)\n\n-- Utils\n\nhexDigit :: Char -> Int\nhexDigit c | is_decdigit c = ord c - ord '0'\n           | otherwise     = ord (to_lower c) - ord 'a' + 10\n\noctDecDigit :: Char -> Int\noctDecDigit c = ord c - ord '0'\n\nis_decdigit :: Char -> Bool\nis_decdigit c\n        =  c >= '0' && c <= '9'\n\nis_hexdigit :: Char -> Bool\nis_hexdigit c\n        =  is_decdigit c\n        || (c >= 'a' && c <= 'f')\n        || (c >= 'A' && c <= 'F')\n\nis_octdigit :: Char -> Bool\nis_octdigit c = c >= '0' && c <= '7'\n\nis_bindigit :: Char -> Bool\nis_bindigit c = c == '0' || c == '1'\n\nto_lower :: Char -> Char\nto_lower c\n  | c >=  'A' && c <= 'Z' = chr (ord c - (ord 'A' - ord 'a'))\n  | otherwise = c\n\ncharType :: Char -> Word8\ncharType c = case c of\n   '\\0'   -> 0                             -- \\000\n   '\\1'   -> 0                             -- \\001\n   '\\2'   -> 0                             -- \\002\n   '\\3'   -> 0                             -- \\003\n   '\\4'   -> 0                             -- \\004\n   '\\5'   -> 0                             -- \\005\n   '\\6'   -> 0                             -- \\006\n   '\\7'   -> 0                             -- \\007\n   '\\8'   -> 0                             -- \\010\n   '\\9'   -> cSpace                        -- \\t  (not allowed in strings, so !cAny)\n   '\\10'  -> cSpace                        -- \\n  (ditto)\n   '\\11'  -> cSpace                        -- \\v  (ditto)\n   '\\12'  -> cSpace                        -- \\f  (ditto)\n   '\\13'  -> cSpace                        --  ^M (ditto)\n   '\\14'  -> 0                             -- \\016\n   '\\15'  -> 0                             -- \\017\n   '\\16'  -> 0                             -- \\020\n   '\\17'  -> 0                             -- \\021\n   '\\18'  -> 0                             -- \\022\n   '\\19'  -> 0                             -- \\023\n   '\\20'  -> 0                             -- \\024\n   '\\21'  -> 0                             -- \\025\n   '\\22'  -> 0                             -- \\026\n   '\\23'  -> 0                             -- \\027\n   '\\24'  -> 0                             -- \\030\n   '\\25'  -> 0                             -- \\031\n   '\\26'  -> 0                             -- \\032\n   '\\27'  -> 0                             -- \\033\n   '\\28'  -> 0                             -- \\034\n   '\\29'  -> 0                             -- \\035\n   '\\30'  -> 0                             -- \\036\n   '\\31'  -> 0                             -- \\037\n   '\\32'  -> cAny .|. cSpace               --\n   '\\33'  -> cAny .|. cSymbol              -- !\n   '\\34'  -> cAny                          -- \"\n   '\\35'  -> cAny .|. cSymbol              --  #\n   '\\36'  -> cAny .|. cSymbol              --  $\n   '\\37'  -> cAny .|. cSymbol              -- %\n   '\\38'  -> cAny .|. cSymbol              -- &\n   '\\39'  -> cAny .|. cIdent               -- '\n   '\\40'  -> cAny                          -- (\n   '\\41'  -> cAny                          -- )\n   '\\42'  -> cAny .|. cSymbol              --  *\n   '\\43'  -> cAny .|. cSymbol              -- +\n   '\\44'  -> cAny                          -- ,\n   '\\45'  -> cAny .|. cSymbol              -- -\n   '\\46'  -> cAny .|. cSymbol              -- .\n   '\\47'  -> cAny .|. cSymbol              --  /\n   '\\48'  -> cAny .|. cIdent  .|. cDigit   -- 0\n   '\\49'  -> cAny .|. cIdent  .|. cDigit   -- 1\n   '\\50'  -> cAny .|. cIdent  .|. cDigit   -- 2\n   '\\51'  -> cAny .|. cIdent  .|. cDigit   -- 3\n   '\\52'  -> cAny .|. cIdent  .|. cDigit   -- 4\n   '\\53'  -> cAny .|. cIdent  .|. cDigit   -- 5\n   '\\54'  -> cAny .|. cIdent  .|. cDigit   -- 6\n   '\\55'  -> cAny .|. cIdent  .|. cDigit   -- 7\n   '\\56'  -> cAny .|. cIdent  .|. cDigit   -- 8\n   '\\57'  -> cAny .|. cIdent  .|. cDigit   -- 9\n   '\\58'  -> cAny .|. cSymbol              -- :\n   '\\59'  -> cAny                          -- ;\n   '\\60'  -> cAny .|. cSymbol              -- <\n   '\\61'  -> cAny .|. cSymbol              -- =\n   '\\62'  -> cAny .|. cSymbol              -- >\n   '\\63'  -> cAny .|. cSymbol              -- ?\n   '\\64'  -> cAny .|. cSymbol              -- @\n   '\\65'  -> cAny .|. cIdent  .|. cUpper   -- A\n   '\\66'  -> cAny .|. cIdent  .|. cUpper   -- B\n   '\\67'  -> cAny .|. cIdent  .|. cUpper   -- C\n   '\\68'  -> cAny .|. cIdent  .|. cUpper   -- D\n   '\\69'  -> cAny .|. cIdent  .|. cUpper   -- E\n   '\\70'  -> cAny .|. cIdent  .|. cUpper   -- F\n   '\\71'  -> cAny .|. cIdent  .|. cUpper   -- G\n   '\\72'  -> cAny .|. cIdent  .|. cUpper   -- H\n   '\\73'  -> cAny .|. cIdent  .|. cUpper   -- I\n   '\\74'  -> cAny .|. cIdent  .|. cUpper   -- J\n   '\\75'  -> cAny .|. cIdent  .|. cUpper   -- K\n   '\\76'  -> cAny .|. cIdent  .|. cUpper   -- L\n   '\\77'  -> cAny .|. cIdent  .|. cUpper   -- M\n   '\\78'  -> cAny .|. cIdent  .|. cUpper   -- N\n   '\\79'  -> cAny .|. cIdent  .|. cUpper   -- O\n   '\\80'  -> cAny .|. cIdent  .|. cUpper   -- P\n   '\\81'  -> cAny .|. cIdent  .|. cUpper   -- Q\n   '\\82'  -> cAny .|. cIdent  .|. cUpper   -- R\n   '\\83'  -> cAny .|. cIdent  .|. cUpper   -- S\n   '\\84'  -> cAny .|. cIdent  .|. cUpper   -- T\n   '\\85'  -> cAny .|. cIdent  .|. cUpper   -- U\n   '\\86'  -> cAny .|. cIdent  .|. cUpper   -- V\n   '\\87'  -> cAny .|. cIdent  .|. cUpper   -- W\n   '\\88'  -> cAny .|. cIdent  .|. cUpper   -- X\n   '\\89'  -> cAny .|. cIdent  .|. cUpper   -- Y\n   '\\90'  -> cAny .|. cIdent  .|. cUpper   -- Z\n   '\\91'  -> cAny                          -- [\n   '\\92'  -> cAny .|. cSymbol              -- backslash\n   '\\93'  -> cAny                          -- ]\n   '\\94'  -> cAny .|. cSymbol              --  ^\n   '\\95'  -> cAny .|. cIdent  .|. cLower   -- _\n   '\\96'  -> cAny                          -- `\n   '\\97'  -> cAny .|. cIdent  .|. cLower   -- a\n   '\\98'  -> cAny .|. cIdent  .|. cLower   -- b\n   '\\99'  -> cAny .|. cIdent  .|. cLower   -- c\n   '\\100' -> cAny .|. cIdent  .|. cLower   -- d\n   '\\101' -> cAny .|. cIdent  .|. cLower   -- e\n   '\\102' -> cAny .|. cIdent  .|. cLower   -- f\n   '\\103' -> cAny .|. cIdent  .|. cLower   -- g\n   '\\104' -> cAny .|. cIdent  .|. cLower   -- h\n   '\\105' -> cAny .|. cIdent  .|. cLower   -- i\n   '\\106' -> cAny .|. cIdent  .|. cLower   -- j\n   '\\107' -> cAny .|. cIdent  .|. cLower   -- k\n   '\\108' -> cAny .|. cIdent  .|. cLower   -- l\n   '\\109' -> cAny .|. cIdent  .|. cLower   -- m\n   '\\110' -> cAny .|. cIdent  .|. cLower   -- n\n   '\\111' -> cAny .|. cIdent  .|. cLower   -- o\n   '\\112' -> cAny .|. cIdent  .|. cLower   -- p\n   '\\113' -> cAny .|. cIdent  .|. cLower   -- q\n   '\\114' -> cAny .|. cIdent  .|. cLower   -- r\n   '\\115' -> cAny .|. cIdent  .|. cLower   -- s\n   '\\116' -> cAny .|. cIdent  .|. cLower   -- t\n   '\\117' -> cAny .|. cIdent  .|. cLower   -- u\n   '\\118' -> cAny .|. cIdent  .|. cLower   -- v\n   '\\119' -> cAny .|. cIdent  .|. cLower   -- w\n   '\\120' -> cAny .|. cIdent  .|. cLower   -- x\n   '\\121' -> cAny .|. cIdent  .|. cLower   -- y\n   '\\122' -> cAny .|. cIdent  .|. cLower   -- z\n   '\\123' -> cAny                          -- {\n   '\\124' -> cAny .|. cSymbol              --  |\n   '\\125' -> cAny                          -- }\n   '\\126' -> cAny .|. cSymbol              -- ~\n   '\\127' -> 0                             -- \\177\n   _ -> panic (\"charType: \" ++ show c)\n", "num_lines": 216}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule HaddockUtils where\n\nimport GhcPrelude\n\nimport HsSyn\nimport SrcLoc\n\nimport Control.Monad\n\n-- -----------------------------------------------------------------------------\n-- Adding documentation to record fields (used in parsing).\n\naddFieldDoc :: LConDeclField a -> Maybe LHsDocString -> LConDeclField a\naddFieldDoc (L l fld) doc\n  = L l (fld { cd_fld_doc = cd_fld_doc fld `mplus` doc })\n\naddFieldDocs :: [LConDeclField a] -> Maybe LHsDocString -> [LConDeclField a]\naddFieldDocs [] _ = []\naddFieldDocs (x:xs) doc = addFieldDoc x doc : xs\n\n\naddConDoc :: LConDecl a -> Maybe LHsDocString -> LConDecl a\naddConDoc decl    Nothing = decl\naddConDoc (L p c) doc     = L p ( c { con_doc = con_doc c `mplus` doc } )\n\naddConDocs :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]\naddConDocs [] _ = []\naddConDocs [x] doc = [addConDoc x doc]\naddConDocs (x:xs) doc = x : addConDocs xs doc\n\naddConDocFirst :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]\naddConDocFirst [] _ = []\naddConDocFirst (x:xs) doc = addConDoc x doc : xs\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- Functions over HsSyn specialised to RdrName.\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule   RdrHsSyn (\n        mkHsOpApp,\n        mkHsIntegral, mkHsFractional, mkHsIsString,\n        mkHsDo, mkSpliceDecl,\n        mkRoleAnnotDecl,\n        mkClassDecl,\n        mkTyData, mkDataFamInst,\n        mkTySynonym, mkTyFamInstEqn,\n        mkTyFamInst,\n        mkFamDecl, mkLHsSigType,\n        mkInlinePragma,\n        mkPatSynMatchGroup,\n        mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp\n        mkTyClD, mkInstD,\n        mkRdrRecordCon, mkRdrRecordUpd,\n        setRdrNameSpace,\n        filterCTuple,\n\n        cvBindGroup,\n        cvBindsAndSigs,\n        cvTopDecls,\n        placeHolderPunRhs,\n\n        -- Stuff to do with Foreign declarations\n        mkImport,\n        parseCImport,\n        mkExport,\n        mkExtName,    -- RdrName -> CLabelString\n        mkGadtDecl,   -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName\n        mkConDeclH98,\n        mkATDefault,\n\n        -- Bunch of functions in the parser monad for\n        -- checking and constructing values\n        checkBlockArguments,\n        checkPrecP,           -- Int -> P Int\n        checkContext,         -- HsType -> P HsContext\n        checkPattern,         -- HsExp -> P HsPat\n        bang_RDR,\n        isBangRdr,\n        isTildeRdr,\n        checkPatterns,        -- SrcLoc -> [HsExp] -> P [HsPat]\n        checkMonadComp,       -- P (HsStmtContext RdrName)\n        checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl\n        checkValSigLhs,\n        checkDoAndIfThenElse,\n        LRuleTyTmVar, RuleTyTmVar(..),\n        mkRuleBndrs, mkRuleTyVarBndrs,\n        checkRuleTyVarBndrNames,\n        checkRecordSyntax,\n        checkEmptyGADTs,\n        addFatalError, hintBangPat,\n        TyEl(..), mergeOps, mergeDataCon,\n\n        -- Help with processing exports\n        ImpExpSubSpec(..),\n        ImpExpQcSpec(..),\n        mkModuleImpExp,\n        mkTypeImpExp,\n        mkImpExpSubSpec,\n        checkImportSpec,\n\n        -- Token symbols\n        forallSym,\n        starSym,\n\n        -- Warnings and errors\n        warnStarIsType,\n        failOpFewArgs,\n\n        SumOrTuple (..), mkSumOrTuple,\n\n        -- Expression/command ambiguity resolution\n        PV,\n        ExpCmdP(ExpCmdP, runExpCmdP),\n        ExpCmdI(..),\n        ecFromExp,\n        ecFromCmd,\n        ecHsLam,\n        ecHsLet,\n        ecOpApp,\n        ecHsCase,\n        ecHsApp,\n        ecHsIf,\n        ecHsDo,\n        ecHsPar,\n\n    ) where\n\nimport GhcPrelude\nimport HsSyn            -- Lots of it\nimport TyCon            ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )\nimport DataCon          ( DataCon, dataConTyCon )\nimport ConLike          ( ConLike(..) )\nimport CoAxiom          ( Role, fsFromRole )\nimport RdrName\nimport Name\nimport BasicTypes\nimport TcEvidence       ( idHsWrapper )\nimport Lexer\nimport Lexeme           ( isLexCon )\nimport Type             ( TyThing(..), funTyCon )\nimport TysWiredIn       ( cTupleTyConName, tupleTyCon, tupleDataCon,\n                          nilDataConName, nilDataConKey,\n                          listTyConName, listTyConKey, eqTyCon_RDR,\n                          tupleTyConName, cTupleTyConNameArity_maybe )\nimport ForeignCall\nimport PrelNames        ( allNameStrings )\nimport SrcLoc\nimport Unique           ( hasKey )\nimport OrdList          ( OrdList, fromOL )\nimport Bag              ( emptyBag, consBag )\nimport Outputable\nimport FastString\nimport Maybes\nimport Util\nimport ApiAnnotation\nimport Data.List\nimport DynFlags ( WarningFlag(..) )\n\nimport Control.Monad\nimport Text.ParserCombinators.ReadP as ReadP\nimport Data.Char\nimport qualified Data.Monoid as Monoid\nimport Data.Data       ( dataTypeOf, fromConstr, dataTypeConstrs )\n\n#include \"HsVersions.h\"\n\n\n{- **********************************************************************\n\n  Construction functions for Rdr stuff\n\n  ********************************************************************* -}\n\n-- | mkClassDecl builds a RdrClassDecl, filling in the names for tycon and\n-- datacon by deriving them from the name of the class.  We fill in the names\n-- for the tycon and datacon corresponding to the class, by deriving them\n-- from the name of the class itself.  This saves recording the names in the\n-- interface file (which would be equally good).\n\n-- Similarly for mkConDecl, mkClassOpSig and default-method names.\n\n--         *** See Note [The Naming story] in HsDecls ****\n\nmkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)\nmkTyClD (dL->L loc d) = cL loc (TyClD noExt d)\n\nmkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)\nmkInstD (dL->L loc d) = cL loc (InstD noExt d)\n\nmkClassDecl :: SrcSpan\n            -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)\n            -> Located (a,[LHsFunDep GhcPs])\n            -> OrdList (LHsDecl GhcPs)\n            -> P (LTyClDecl GhcPs)\n\nmkClassDecl loc (dL->L _ (mcxt, tycl_hdr)) fds where_cls\n  = do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls\n       ; let cxt = fromMaybe (noLoc []) mcxt\n       ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr\n       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan\n       ; (tyvars,annst) <- checkTyVarsP (text \"class\") whereDots cls tparams\n       ; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan\n       ; (at_defs, annsi) <- mapAndUnzipM (eitherToP . mkATDefault) at_insts\n       ; sequence_ annsi\n       ; return (cL loc (ClassDecl { tcdCExt = noExt, tcdCtxt = cxt\n                                   , tcdLName = cls, tcdTyVars = tyvars\n                                   , tcdFixity = fixity\n                                   , tcdFDs = snd (unLoc fds)\n                                   , tcdSigs = mkClassOpSigs sigs\n                                   , tcdMeths = binds\n                                   , tcdATs = ats, tcdATDefs = at_defs\n                                   , tcdDocs  = docs })) }\n\nmkATDefault :: LTyFamInstDecl GhcPs\n            -> Either (SrcSpan, SDoc) (LTyFamDefltEqn GhcPs, P ())\n-- ^ Take a type-family instance declaration and turn it into\n-- a type-family default equation for a class declaration.\n-- We parse things as the former and use this function to convert to the latter\n--\n-- We use the Either monad because this also called from \"Convert\".\n--\n-- The @P ()@ we return corresponds represents an action which will add\n-- some necessary paren annotations to the parsing context. Naturally, this\n-- is not something that the \"Convert\" use cares about.\nmkATDefault (dL->L loc (TyFamInstDecl { tfid_eqn = HsIB { hsib_body = e }}))\n      | FamEqn { feqn_tycon = tc, feqn_bndrs = bndrs, feqn_pats = pats\n               , feqn_fixity = fixity, feqn_rhs = rhs } <- e\n      = do { (tvs, anns) <- checkTyVars (text \"default\") equalsDots tc pats\n           ; let f = cL loc (FamEqn { feqn_ext    = noExt\n                                    , feqn_tycon  = tc\n                                    , feqn_bndrs  = ASSERT( isNothing bndrs )\n                                                    Nothing\n                                    , feqn_pats   = tvs\n                                    , feqn_fixity = fixity\n                                    , feqn_rhs    = rhs })\n           ; pure (f, addAnnsAt loc anns) }\nmkATDefault (dL->L _ (TyFamInstDecl (HsIB _ (XFamEqn _)))) = panic \"mkATDefault\"\nmkATDefault (dL->L _ (TyFamInstDecl (XHsImplicitBndrs _))) = panic \"mkATDefault\"\nmkATDefault _ = panic \"mkATDefault: Impossible Match\"\n                                -- due to #15884\n\nmkTyData :: SrcSpan\n         -> NewOrData\n         -> Maybe (Located CType)\n         -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)\n         -> Maybe (LHsKind GhcPs)\n         -> [LConDecl GhcPs]\n         -> HsDeriving GhcPs\n         -> P (LTyClDecl GhcPs)\nmkTyData loc new_or_data cType (dL->L _ (mcxt, tycl_hdr))\n         ksig data_cons maybe_deriv\n  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr\n       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan\n       ; (tyvars, anns) <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams\n       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan\n       ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv\n       ; return (cL loc (DataDecl { tcdDExt = noExt,\n                                    tcdLName = tc, tcdTyVars = tyvars,\n                                    tcdFixity = fixity,\n                                    tcdDataDefn = defn })) }\n\nmkDataDefn :: NewOrData\n           -> Maybe (Located CType)\n           -> Maybe (LHsContext GhcPs)\n           -> Maybe (LHsKind GhcPs)\n           -> [LConDecl GhcPs]\n           -> HsDeriving GhcPs\n           -> P (HsDataDefn GhcPs)\nmkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv\n  = do { checkDatatypeContext mcxt\n       ; let cxt = fromMaybe (noLoc []) mcxt\n       ; return (HsDataDefn { dd_ext = noExt\n                            , dd_ND = new_or_data, dd_cType = cType\n                            , dd_ctxt = cxt\n                            , dd_cons = data_cons\n                            , dd_kindSig = ksig\n                            , dd_derivs = maybe_deriv }) }\n\n\nmkTySynonym :: SrcSpan\n            -> LHsType GhcPs  -- LHS\n            -> LHsType GhcPs  -- RHS\n            -> P (LTyClDecl GhcPs)\nmkTySynonym loc lhs rhs\n  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs\n       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan\n       ; (tyvars, anns) <- checkTyVarsP (text \"type\") equalsDots tc tparams\n       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan\n       ; return (cL loc (SynDecl { tcdSExt = noExt\n                                 , tcdLName = tc, tcdTyVars = tyvars\n                                 , tcdFixity = fixity\n                                 , tcdRhs = rhs })) }\n\nmkTyFamInstEqn :: Maybe [LHsTyVarBndr GhcPs]\n               -> LHsType GhcPs\n               -> LHsType GhcPs\n               -> P (TyFamInstEqn GhcPs,[AddAnn])\nmkTyFamInstEqn bndrs lhs rhs\n  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs\n       ; return (mkHsImplicitBndrs\n                  (FamEqn { feqn_ext    = noExt\n                          , feqn_tycon  = tc\n                          , feqn_bndrs  = bndrs\n                          , feqn_pats   = tparams\n                          , feqn_fixity = fixity\n                          , feqn_rhs    = rhs }),\n                 ann) }\n\nmkDataFamInst :: SrcSpan\n              -> NewOrData\n              -> Maybe (Located CType)\n              -> (Maybe ( LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs]\n                        , LHsType GhcPs)\n              -> Maybe (LHsKind GhcPs)\n              -> [LConDecl GhcPs]\n              -> HsDeriving GhcPs\n              -> P (LInstDecl GhcPs)\nmkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)\n              ksig data_cons maybe_deriv\n  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr\n       ; mapM_ (\\a -> a loc) ann -- Add any API Annotations to the top SrcSpan\n       ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv\n       ; return (cL loc (DataFamInstD noExt (DataFamInstDecl (mkHsImplicitBndrs\n                  (FamEqn { feqn_ext    = noExt\n                          , feqn_tycon  = tc\n                          , feqn_bndrs  = bndrs\n                          , feqn_pats   = tparams\n                          , feqn_fixity = fixity\n                          , feqn_rhs    = defn }))))) }\n\nmkTyFamInst :: SrcSpan\n            -> TyFamInstEqn GhcPs\n            -> P (LInstDecl GhcPs)\nmkTyFamInst loc eqn\n  = return (cL loc (TyFamInstD noExt (TyFamInstDecl eqn)))\n\nmkFamDecl :: SrcSpan\n          -> FamilyInfo GhcPs\n          -> LHsType GhcPs                   -- LHS\n          -> Located (FamilyResultSig GhcPs) -- Optional result signature\n          -> Maybe (LInjectivityAnn GhcPs)   -- Injectivity annotation\n          -> P (LTyClDecl GhcPs)\nmkFamDecl loc info lhs ksig injAnn\n  = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs\n       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan\n       ; (tyvars, anns) <- checkTyVarsP (ppr info) equals_or_where tc tparams\n       ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan\n       ; return (cL loc (FamDecl noExt (FamilyDecl\n                                           { fdExt       = noExt\n                                           , fdInfo      = info, fdLName = tc\n                                           , fdTyVars    = tyvars\n                                           , fdFixity    = fixity\n                                           , fdResultSig = ksig\n                                           , fdInjectivityAnn = injAnn }))) }\n  where\n    equals_or_where = case info of\n                        DataFamily          -> empty\n                        OpenTypeFamily      -> empty\n                        ClosedTypeFamily {} -> whereDots\n\nmkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs\n-- If the user wrote\n--      [pads| ... ]   then return a QuasiQuoteD\n--      $(e)           then return a SpliceD\n-- but if she wrote, say,\n--      f x            then behave as if she'd written $(f x)\n--                     ie a SpliceD\n--\n-- Typed splices are not allowed at the top level, thus we do not represent them\n-- as spliced declaration.  See #10945\nmkSpliceDecl lexpr@(dL->L loc expr)\n  | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr\n  = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)\n\n  | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr\n  = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)\n\n  | otherwise\n  = SpliceD noExt (SpliceDecl noExt (cL loc (mkUntypedSplice NoParens lexpr))\n                              ImplicitSplice)\n\nmkRoleAnnotDecl :: SrcSpan\n                -> Located RdrName                -- type being annotated\n                -> [Located (Maybe FastString)]      -- roles\n                -> P (LRoleAnnotDecl GhcPs)\nmkRoleAnnotDecl loc tycon roles\n  = do { roles' <- mapM parse_role roles\n       ; return $ cL loc $ RoleAnnotDecl noExt tycon roles' }\n  where\n    role_data_type = dataTypeOf (undefined :: Role)\n    all_roles = map fromConstr $ dataTypeConstrs role_data_type\n    possible_roles = [(fsFromRole role, role) | role <- all_roles]\n\n    parse_role (dL->L loc_role Nothing) = return $ cL loc_role Nothing\n    parse_role (dL->L loc_role (Just role))\n      = case lookup role possible_roles of\n          Just found_role -> return $ cL loc_role $ Just found_role\n          Nothing         ->\n            let nearby = fuzzyLookup (unpackFS role)\n                  (mapFst unpackFS possible_roles)\n            in\n            addFatalError loc_role\n              (text \"Illegal role name\" <+> quotes (ppr role) $$\n               suggestions nearby)\n    parse_role _ = panic \"parse_role: Impossible Match\"\n                                -- due to #15884\n\n    suggestions []   = empty\n    suggestions [r]  = text \"Perhaps you meant\" <+> quotes (ppr r)\n      -- will this last case ever happen??\n    suggestions list = hang (text \"Perhaps you meant one of these:\")\n                       2 (pprWithCommas (quotes . ppr) list)\n\n{- **********************************************************************\n\n  #cvBinds-etc# Converting to @HsBinds@, etc.\n\n  ********************************************************************* -}\n\n-- | Function definitions are restructured here. Each is assumed to be recursive\n-- initially, and non recursive definitions are discovered by the dependency\n-- analyser.\n\n\n--  | Groups together bindings for a single function\ncvTopDecls :: OrdList (LHsDecl GhcPs) -> [LHsDecl GhcPs]\ncvTopDecls decls = go (fromOL decls)\n  where\n    go :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]\n    go []                     = []\n    go ((dL->L l (ValD x b)) : ds)\n      = cL l' (ValD x b') : go ds'\n        where (dL->L l' b', ds') = getMonoBind (cL l b) ds\n    go (d : ds)                    = d : go ds\n\n-- Declaration list may only contain value bindings and signatures.\ncvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)\ncvBindGroup binding\n  = do { (mbs, sigs, fam_ds, tfam_insts\n         , dfam_insts, _) <- cvBindsAndSigs binding\n       ; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)\n         return $ ValBinds noExt mbs sigs }\n\ncvBindsAndSigs :: OrdList (LHsDecl GhcPs)\n  -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]\n          , [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl])\n-- Input decls contain just value bindings and signatures\n-- and in case of class or instance declarations also\n-- associated type declarations. They might also contain Haddock comments.\ncvBindsAndSigs fb = go (fromOL fb)\n  where\n    go []              = return (emptyBag, [], [], [], [], [])\n    go ((dL->L l (ValD _ b)) : ds)\n      = do { (bs, ss, ts, tfis, dfis, docs) <- go ds'\n           ; return (b' `consBag` bs, ss, ts, tfis, dfis, docs) }\n      where\n        (b', ds') = getMonoBind (cL l b) ds\n    go ((dL->L l decl) : ds)\n      = do { (bs, ss, ts, tfis, dfis, docs) <- go ds\n           ; case decl of\n               SigD _ s\n                 -> return (bs, cL l s : ss, ts, tfis, dfis, docs)\n               TyClD _ (FamDecl _ t)\n                 -> return (bs, ss, cL l t : ts, tfis, dfis, docs)\n               InstD _ (TyFamInstD { tfid_inst = tfi })\n                 -> return (bs, ss, ts, cL l tfi : tfis, dfis, docs)\n               InstD _ (DataFamInstD { dfid_inst = dfi })\n                 -> return (bs, ss, ts, tfis, cL l dfi : dfis, docs)\n               DocD _ d\n                 -> return (bs, ss, ts, tfis, dfis, cL l d : docs)\n               SpliceD _ d\n                 -> addFatalError l $\n                    hang (text \"Declaration splices are allowed only\" <+>\n                          text \"at the top level:\")\n                       2 (ppr d)\n               _ -> pprPanic \"cvBindsAndSigs\" (ppr decl) }\n\n-----------------------------------------------------------------------------\n-- Group function bindings into equation groups\n\ngetMonoBind :: LHsBind GhcPs -> [LHsDecl GhcPs]\n  -> (LHsBind GhcPs, [LHsDecl GhcPs])\n-- Suppose      (b',ds') = getMonoBind b ds\n--      ds is a list of parsed bindings\n--      b is a MonoBinds that has just been read off the front\n\n-- Then b' is the result of grouping more equations from ds that\n-- belong with b into a single MonoBinds, and ds' is the depleted\n-- list of parsed bindings.\n--\n-- All Haddock comments between equations inside the group are\n-- discarded.\n--\n-- No AndMonoBinds or EmptyMonoBinds here; just single equations\n\ngetMonoBind (dL->L loc1 (FunBind { fun_id = fun_id1@(dL->L _ f1)\n                                 , fun_matches =\n                                   MG { mg_alts = (dL->L _ mtchs1) } }))\n            binds\n  | has_args mtchs1\n  = go mtchs1 loc1 binds []\n  where\n    go mtchs loc\n       ((dL->L loc2 (ValD _ (FunBind { fun_id = (dL->L _ f2)\n                                    , fun_matches =\n                                        MG { mg_alts = (dL->L _ mtchs2) } })))\n         : binds) _\n        | f1 == f2 = go (mtchs2 ++ mtchs)\n                        (combineSrcSpans loc loc2) binds []\n    go mtchs loc (doc_decl@(dL->L loc2 (DocD {})) : binds) doc_decls\n        = let doc_decls' = doc_decl : doc_decls\n          in go mtchs (combineSrcSpans loc loc2) binds doc_decls'\n    go mtchs loc binds doc_decls\n        = ( cL loc (makeFunBind fun_id1 (reverse mtchs))\n          , (reverse doc_decls) ++ binds)\n        -- Reverse the final matches, to get it back in the right order\n        -- Do the same thing with the trailing doc comments\n\ngetMonoBind bind binds = (bind, binds)\n\nhas_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool\nhas_args []                                    = panic \"RdrHsSyn:has_args\"\nhas_args ((dL->L _ (Match { m_pats = args })) : _) = not (null args)\n        -- Don't group together FunBinds if they have\n        -- no arguments.  This is necessary now that variable bindings\n        -- with no arguments are now treated as FunBinds rather\n        -- than pattern bindings (tests/rename/should_fail/rnfail002).\nhas_args ((dL->L _ (XMatch _)) : _) = panic \"has_args\"\nhas_args (_ : _) = panic \"has_args:Impossible Match\" -- due to #15884\n\n{- **********************************************************************\n\n  #PrefixToHS-utils# Utilities for conversion\n\n  ********************************************************************* -}\n\n{- Note [Parsing data constructors is hard]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe problem with parsing data constructors is that they look a lot like types.\nCompare:\n\n  (s1)   data T = C t1 t2\n  (s2)   type T = C t1 t2\n\nSyntactically, there's little difference between these declarations, except in\n(s1) 'C' is a data constructor, but in (s2) 'C' is a type constructor.\n\nThis similarity would pose no problem if we knew ahead of time if we are\nparsing a type or a constructor declaration. Looking at (s1) and (s2), a simple\n(but wrong!) rule comes to mind: in 'data' declarations assume we are parsing\ndata constructors, and in other contexts (e.g. 'type' declarations) assume we\nare parsing type constructors.\n\nThis simple rule does not work because of two problematic cases:\n\n  (p1)   data T = C t1 t2 :+ t3\n  (p2)   data T = C t1 t2 => t3\n\nIn (p1) we encounter (:+) and it turns out we are parsing an infix data\ndeclaration, so (C t1 t2) is a type and 'C' is a type constructor.\nIn (p2) we encounter (=>) and it turns out we are parsing an existential\ncontext, so (C t1 t2) is a constraint and 'C' is a type constructor.\n\nAs the result, in order to determine whether (C t1 t2) declares a data\nconstructor, a type, or a context, we would need unlimited lookahead which\n'happy' is not so happy with.\n\nTo further complicate matters, the interpretation of (!) and (~) is different\nin constructors and types:\n\n  (b1)   type T = C ! D\n  (b2)   data T = C ! D\n  (b3)   data T = C ! D => E\n\nIn (b1) and (b3), (!) is a type operator with two arguments: 'C' and 'D'. At\nthe same time, in (b2) it is a strictness annotation: 'C' is a data constructor\nwith a single strict argument 'D'. For the programmer, these cases are usually\neasy to tell apart due to whitespace conventions:\n\n  (b2)   data T = C !D         -- no space after the bang hints that\n                               -- it is a strictness annotation\n\nFor the parser, on the other hand, this whitespace does not matter. We cannot\ntell apart (b2) from (b3) until we encounter (=>), so it requires unlimited\nlookahead.\n\nThe solution that accounts for all of these issues is to initially parse data\ndeclarations and types as a reversed list of TyEl:\n\n  data TyEl = TyElOpr RdrName\n            | TyElOpd (HsType GhcPs)\n            | TyElBang | TyElTilde\n            | ...\n\nFor example, both occurences of (C ! D) in the following example are parsed\ninto equal lists of TyEl:\n\n  data T = C ! D => C ! D   results in   [ TyElOpd (HsTyVar \"D\")\n                                         , TyElBang\n                                         , TyElOpd (HsTyVar \"C\") ]\n\nNote that elements are in reverse order. Also, 'C' is parsed as a type\nconstructor (HsTyVar) even when it is a data constructor. We fix this in\n`tyConToDataCon`.\n\nBy the time the list of TyEl is assembled, we have looked ahead enough to\ndecide whether to reduce using `mergeOps` (for types) or `mergeDataCon` (for\ndata constructors). These functions are where the actual job of parsing is\ndone.\n\n-}\n\n-- | Reinterpret a type constructor, including type operators, as a data\n--   constructor.\n-- See Note [Parsing data constructors is hard]\ntyConToDataCon :: SrcSpan -> RdrName -> Either (SrcSpan, SDoc) (Located RdrName)\ntyConToDataCon loc tc\n  | isTcOcc occ || isDataOcc occ\n  , isLexCon (occNameFS occ)\n  = return (cL loc (setRdrNameSpace tc srcDataName))\n\n  | otherwise\n  = Left (loc, msg)\n  where\n    occ = rdrNameOcc tc\n    msg = text \"Not a data constructor:\" <+> quotes (ppr tc)\n\nmkPatSynMatchGroup :: Located RdrName\n                   -> Located (OrdList (LHsDecl GhcPs))\n                   -> P (MatchGroup GhcPs (LHsExpr GhcPs))\nmkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) =\n    do { matches <- mapM fromDecl (fromOL decls)\n       ; when (null matches) (wrongNumberErr loc)\n       ; return $ mkMatchGroup FromSource matches }\n  where\n    fromDecl (dL->L loc decl@(ValD _ (PatBind _\n                             pat@(dL->L _ (ConPatIn ln@(dL->L _ name) details))\n                                   rhs _))) =\n        do { unless (name == patsyn_name) $\n               wrongNameBindingErr loc decl\n           ; match <- case details of\n               PrefixCon pats -> return $ Match { m_ext = noExt\n                                                , m_ctxt = ctxt, m_pats = pats\n                                                , m_grhss = rhs }\n                   where\n                     ctxt = FunRhs { mc_fun = ln\n                                   , mc_fixity = Prefix\n                                   , mc_strictness = NoSrcStrict }\n\n               InfixCon p1 p2 -> return $ Match { m_ext = noExt\n                                                , m_ctxt = ctxt\n                                                , m_pats = [p1, p2]\n                                                , m_grhss = rhs }\n                   where\n                     ctxt = FunRhs { mc_fun = ln\n                                   , mc_fixity = Infix\n                                   , mc_strictness = NoSrcStrict }\n\n               RecCon{} -> recordPatSynErr loc pat\n           ; return $ cL loc match }\n    fromDecl (dL->L loc decl) = extraDeclErr loc decl\n\n    extraDeclErr loc decl =\n        addFatalError loc $\n        text \"pattern synonym 'where' clause must contain a single binding:\" $$\n        ppr decl\n\n    wrongNameBindingErr loc decl =\n      addFatalError loc $\n      text \"pattern synonym 'where' clause must bind the pattern synonym's name\"\n      <+> quotes (ppr patsyn_name) $$ ppr decl\n\n    wrongNumberErr loc =\n      addFatalError loc $\n      text \"pattern synonym 'where' clause cannot be empty\" $$\n      text \"In the pattern synonym declaration for: \" <+> ppr (patsyn_name)\n\nrecordPatSynErr :: SrcSpan -> LPat GhcPs -> P a\nrecordPatSynErr loc pat =\n    addFatalError loc $\n    text \"record syntax not supported for pattern synonym declarations:\" $$\n    ppr pat\n\nmkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr GhcPs]\n                -> Maybe (LHsContext GhcPs) -> HsConDeclDetails GhcPs\n                -> ConDecl GhcPs\n\nmkConDeclH98 name mb_forall mb_cxt args\n  = ConDeclH98 { con_ext    = noExt\n               , con_name   = name\n               , con_forall = noLoc $ isJust mb_forall\n               , con_ex_tvs = mb_forall `orElse` []\n               , con_mb_cxt = mb_cxt\n               , con_args   = args'\n               , con_doc    = Nothing }\n  where\n    args' = nudgeHsSrcBangs args\n\nmkGadtDecl :: [Located RdrName]\n           -> LHsType GhcPs     -- Always a HsForAllTy\n           -> (ConDecl GhcPs, [AddAnn])\nmkGadtDecl names ty\n  = (ConDeclGADT { con_g_ext  = noExt\n                 , con_names  = names\n                 , con_forall = cL l $ isLHsForAllTy ty'\n                 , con_qvars  = mkHsQTvs tvs\n                 , con_mb_cxt = mcxt\n                 , con_args   = args'\n                 , con_res_ty = res_ty\n                 , con_doc    = Nothing }\n    , anns1 ++ anns2)\n  where\n    (ty'@(dL->L l _),anns1) = peel_parens ty []\n    (tvs, rho) = splitLHsForAllTyInvis ty'\n    (mcxt, tau, anns2) = split_rho rho []\n\n    split_rho (dL->L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) ann\n      = (Just cxt, tau, ann)\n    split_rho (dL->L l (HsParTy _ ty)) ann\n      = split_rho ty (ann++mkParensApiAnn l)\n    split_rho tau                  ann\n      = (Nothing, tau, ann)\n\n    (args, res_ty) = split_tau tau\n    args' = nudgeHsSrcBangs args\n\n    -- See Note [GADT abstract syntax] in HsDecls\n    split_tau (dL->L _ (HsFunTy _ (dL->L loc (HsRecTy _ rf)) res_ty))\n      = (RecCon (cL loc rf), res_ty)\n    split_tau tau\n      = (PrefixCon [], tau)\n\n    peel_parens (dL->L l (HsParTy _ ty)) ann = peel_parens ty\n                                                       (ann++mkParensApiAnn l)\n    peel_parens ty                   ann = (ty, ann)\n\nnudgeHsSrcBangs :: HsConDeclDetails GhcPs -> HsConDeclDetails GhcPs\n-- ^ This function ensures that fields with strictness or packedness\n-- annotations put these annotations on an outer 'HsBangTy'.\n--\n-- The problem is that in the parser, strictness and packedness annotations\n-- bind more tightly that docstrings. However, the expectation downstream of\n-- the parser (by functions such as 'getBangType' and 'getBangStrictness')\n-- is that docstrings bind more tightly so that 'HsBangTy' may end up as the\n-- top-level type.\n--\n-- See #15206\nnudgeHsSrcBangs details\n  = case details of\n      PrefixCon as -> PrefixCon (map go as)\n      RecCon r -> RecCon r\n      InfixCon a1 a2 -> InfixCon (go a1) (go a2)\n  where\n    go (dL->L l (HsDocTy _ (dL->L _ (HsBangTy _ s lty)) lds)) =\n      cL l (HsBangTy noExt s (addCLoc lty lds (HsDocTy noExt lty lds)))\n    go lty = lty\n\n\nsetRdrNameSpace :: RdrName -> NameSpace -> RdrName\n-- ^ This rather gruesome function is used mainly by the parser.\n-- When parsing:\n--\n-- > data T a = T | T1 Int\n--\n-- we parse the data constructors as /types/ because of parser ambiguities,\n-- so then we need to change the /type constr/ to a /data constr/\n--\n-- The exact-name case /can/ occur when parsing:\n--\n-- > data [] a = [] | a : [a]\n--\n-- For the exact-name case we return an original name.\nsetRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)\nsetRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)\nsetRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)\nsetRdrNameSpace (Exact n)    ns\n  | Just thing <- wiredInNameTyThing_maybe n\n  = setWiredInNameSpace thing ns\n    -- Preserve Exact Names for wired-in things,\n    -- notably tuples and lists\n\n  | isExternalName n\n  = Orig (nameModule n) occ\n\n  | otherwise   -- This can happen when quoting and then\n                -- splicing a fixity declaration for a type\n  = Exact (mkSystemNameAt (nameUnique n) occ (nameSrcSpan n))\n  where\n    occ = setOccNameSpace ns (nameOccName n)\n\nsetWiredInNameSpace :: TyThing -> NameSpace -> RdrName\nsetWiredInNameSpace (ATyCon tc) ns\n  | isDataConNameSpace ns\n  = ty_con_data_con tc\n  | isTcClsNameSpace ns\n  = Exact (getName tc)      -- No-op\n\nsetWiredInNameSpace (AConLike (RealDataCon dc)) ns\n  | isTcClsNameSpace ns\n  = data_con_ty_con dc\n  | isDataConNameSpace ns\n  = Exact (getName dc)      -- No-op\n\nsetWiredInNameSpace thing ns\n  = pprPanic \"setWiredinNameSpace\" (pprNameSpace ns <+> ppr thing)\n\nty_con_data_con :: TyCon -> RdrName\nty_con_data_con tc\n  | isTupleTyCon tc\n  , Just dc <- tyConSingleDataCon_maybe tc\n  = Exact (getName dc)\n\n  | tc `hasKey` listTyConKey\n  = Exact nilDataConName\n\n  | otherwise  -- See Note [setRdrNameSpace for wired-in names]\n  = Unqual (setOccNameSpace srcDataName (getOccName tc))\n\ndata_con_ty_con :: DataCon -> RdrName\ndata_con_ty_con dc\n  | let tc = dataConTyCon dc\n  , isTupleTyCon tc\n  = Exact (getName tc)\n\n  | dc `hasKey` nilDataConKey\n  = Exact listTyConName\n\n  | otherwise  -- See Note [setRdrNameSpace for wired-in names]\n  = Unqual (setOccNameSpace tcClsName (getOccName dc))\n\n-- | Replaces constraint tuple names with corresponding boxed ones.\nfilterCTuple :: RdrName -> RdrName\nfilterCTuple (Exact n)\n  | Just arity <- cTupleTyConNameArity_maybe n\n  = Exact $ tupleTyConName BoxedTuple arity\nfilterCTuple rdr = rdr\n\n\n{- Note [setRdrNameSpace for wired-in names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn GHC.Types, which declares (:), we have\n  infixr 5 :\nThe ambiguity about which \":\" is meant is resolved by parsing it as a\ndata constructor, but then using dataTcOccs to try the type constructor too;\nand that in turn calls setRdrNameSpace to change the name-space of \":\" to\ntcClsName.  There isn't a corresponding \":\" type constructor, but it's painful\nto make setRdrNameSpace partial, so we just make an Unqual name instead. It\nreally doesn't matter!\n-}\n\ncheckTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]\n             -> P (LHsQTyVars GhcPs, [AddAnn])\n-- Same as checkTyVars, but in the P monad\ncheckTyVarsP pp_what equals_or_where tc tparms\n  = do { let checkedTvs = checkTyVars pp_what equals_or_where tc tparms\n       ; eitherToP checkedTvs }\n\neitherToP :: Either (SrcSpan, SDoc) a -> P a\n-- Adapts the Either monad to the P monad\neitherToP (Left (loc, doc)) = addFatalError loc doc\neitherToP (Right thing)     = return thing\n\ncheckTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]\n            -> Either (SrcSpan, SDoc)\n                      ( LHsQTyVars GhcPs  -- the synthesized type variables\n                      , [AddAnn] )        -- action which adds annotations\n-- ^ Check whether the given list of type parameters are all type variables\n-- (possibly with a kind signature).\n-- We use the Either monad because it's also called (via 'mkATDefault') from\n-- \"Convert\".\ncheckTyVars pp_what equals_or_where tc tparms\n  = do { (tvs, anns) <- fmap unzip $ mapM check tparms\n       ; return (mkHsQTvs tvs, concat anns) }\n  where\n    check (HsTypeArg _ ki@(L loc _))\n                              = Left (loc,\n                                      vcat [ text \"Unexpected type application\" <+>\n                                            text \"@\" <> ppr ki\n                                          , text \"In the\" <+> pp_what <+>\n                                            ptext (sLit \"declaration for\") <+> quotes (ppr tc)])\n    check (HsValArg ty) = chkParens [] ty\n    check (HsArgPar sp) = Left (sp, vcat [text \"Malformed\" <+> pp_what\n                           <+> text \"declaration for\" <+> quotes (ppr tc)])\n        -- Keep around an action for adjusting the annotations of extra parens\n    chkParens :: [AddAnn] -> LHsType GhcPs\n              -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs, [AddAnn])\n    chkParens acc (dL->L l (HsParTy _ ty)) = chkParens (mkParensApiAnn l\n                                                        ++ acc) ty\n    chkParens acc ty = case chk ty of\n      Left err -> Left err\n      Right tv -> Right (tv, reverse acc)\n\n        -- Check that the name space is correct!\n    chk :: LHsType GhcPs -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs)\n    chk (dL->L l (HsKindSig _ (dL->L lv (HsTyVar _ _ (dL->L _ tv))) k))\n        | isRdrTyVar tv    = return (cL l (KindedTyVar noExt (cL lv tv) k))\n    chk (dL->L l (HsTyVar _ _ (dL->L ltv tv)))\n        | isRdrTyVar tv    = return (cL l (UserTyVar noExt (cL ltv tv)))\n    chk t@(dL->L loc _)\n        = Left (loc,\n                vcat [ text \"Unexpected type\" <+> quotes (ppr t)\n                     , text \"In the\" <+> pp_what\n                       <+> ptext (sLit \"declaration for\") <+> quotes tc'\n                     , vcat[ (text \"A\" <+> pp_what\n                              <+> ptext (sLit \"declaration should have form\"))\n                     , nest 2\n                       (pp_what\n                        <+> tc'\n                        <+> hsep (map text (takeList tparms allNameStrings))\n                        <+> equals_or_where) ] ])\n\n    -- Avoid printing a constraint tuple in the error message. Print\n    -- a plain old tuple instead (since that's what the user probably\n    -- wrote). See #14907\n    tc' = ppr $ fmap filterCTuple tc\n\n\n\nwhereDots, equalsDots :: SDoc\n-- Second argument to checkTyVars\nwhereDots  = text \"where ...\"\nequalsDots = text \"= ...\"\n\ncheckDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()\ncheckDatatypeContext Nothing = return ()\ncheckDatatypeContext (Just c)\n    = do allowed <- getBit DatatypeContextsBit\n         unless allowed $\n             addError (getLoc c)\n                 (text \"Illegal datatype context (use DatatypeContexts):\"\n                  <+> pprLHsContext c)\n\ntype LRuleTyTmVar = Located RuleTyTmVar\ndata RuleTyTmVar = RuleTyTmVar (Located RdrName) (Maybe (LHsType GhcPs))\n-- ^ Essentially a wrapper for a @RuleBndr GhcPs@\n\n-- turns RuleTyTmVars into RuleBnrs - this is straightforward\nmkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]\nmkRuleBndrs = fmap (fmap cvt_one)\n  where cvt_one (RuleTyTmVar v Nothing)    = RuleBndr    noExt v\n        cvt_one (RuleTyTmVar v (Just sig)) =\n          RuleBndrSig noExt v (mkLHsSigWcType sig)\n\n-- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting\nmkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs]\nmkRuleTyVarBndrs = fmap (fmap cvt_one)\n  where cvt_one (RuleTyTmVar v Nothing)    = UserTyVar   noExt (fmap tm_to_ty v)\n        cvt_one (RuleTyTmVar v (Just sig))\n          = KindedTyVar noExt (fmap tm_to_ty v) sig\n    -- takes something in namespace 'varName' to something in namespace 'tvName'\n        tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ)\n        tm_to_ty _ = panic \"mkRuleTyVarBndrs\"\n\n-- See note [Parsing explicit foralls in Rules] in Parser.y\ncheckRuleTyVarBndrNames :: [LHsTyVarBndr GhcPs] -> P ()\ncheckRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)\n  where check (dL->L loc (Unqual occ)) = do\n          when ((occNameString occ ==) `any` [\"forall\",\"family\",\"role\"])\n               (addFatalError loc (text $ \"parse error on input \"\n                                    ++ occNameString occ))\n        check _ = panic \"checkRuleTyVarBndrNames\"\n\ncheckRecordSyntax :: Outputable a => Located a -> P (Located a)\ncheckRecordSyntax lr@(dL->L loc r)\n    = do allowed <- getBit TraditionalRecordSyntaxBit\n         unless allowed $ addError loc $\n           text \"Illegal record syntax (use TraditionalRecordSyntax):\" <+> ppr r\n         return lr\n\n-- | Check if the gadt_constrlist is empty. Only raise parse error for\n-- `data T where` to avoid affecting existing error message, see #8258.\ncheckEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])\n                -> P (Located ([AddAnn], [LConDecl GhcPs]))\ncheckEmptyGADTs gadts@(dL->L span (_, []))           -- Empty GADT declaration.\n    = do gadtSyntax <- getBit GadtSyntaxBit   -- GADTs implies GADTSyntax\n         unless gadtSyntax $ addError span $ vcat\n           [ text \"Illegal keyword 'where' in data declaration\"\n           , text \"Perhaps you intended to use GADTs or a similar language\"\n           , text \"extension to enable syntax: data T where\"\n           ]\n         return gadts\ncheckEmptyGADTs gadts = return gadts              -- Ordinary GADT declaration.\n\ncheckTyClHdr :: Bool               -- True  <=> class header\n                                   -- False <=> type header\n             -> LHsType GhcPs\n             -> P (Located RdrName,      -- the head symbol (type or class name)\n                   [LHsTypeArg GhcPs],      -- parameters of head symbol\n                   LexicalFixity,        -- the declaration is in infix format\n                   [AddAnn]) -- API Annotation for HsParTy when stripping parens\n-- Well-formedness check and decomposition of type and class heads.\n-- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])\n--              Int :*: Bool   into    (:*:, [Int, Bool])\n-- returning the pieces\ncheckTyClHdr is_cls ty\n  = goL ty [] [] Prefix\n  where\n    goL (dL->L l ty) acc ann fix = go l ty acc ann fix\n\n    -- workaround to define '*' despite StarIsType\n    go lp (HsParTy _ (dL->L l (HsStarTy _ isUni))) acc ann fix\n      = do { warnStarBndr l\n           ; let name = mkOccName tcClsName (starSym isUni)\n           ; return (cL l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) }\n\n    go l (HsTyVar _ _ (dL->L _ tc)) acc ann fix\n      | isRdrTc tc               = return (cL l tc, acc, fix, ann)\n    go _ (HsOpTy _ t1 ltc@(dL->L _ tc) t2) acc ann _fix\n      | isRdrTc tc               = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, ann)\n    go l (HsParTy _ ty)    acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix\n    go _ (HsAppTy _ t1 t2) acc ann fix = goL t1 (HsValArg t2:acc) ann fix\n    go _ (HsAppKindTy l ty ki) acc ann fix = goL ty (HsTypeArg l ki:acc) ann fix\n    go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ann fix\n      = return (cL l (nameRdrName tup_name), map HsValArg ts, fix, ann)\n      where\n        arity = length ts\n        tup_name | is_cls    = cTupleTyConName arity\n                 | otherwise = getName (tupleTyCon Boxed arity)\n          -- See Note [Unit tuples] in HsTypes  (TODO: is this still relevant?)\n    go l _ _ _ _\n      = addFatalError l (text \"Malformed head of type or class declaration:\"\n                          <+> ppr ty)\n\n-- | Yield a parse error if we have a function applied directly to a do block\n-- etc. and BlockArguments is not enabled.\ncheckBlockArguments :: forall b. ExpCmdI b => Located (b GhcPs) -> PV ()\ncheckBlockArguments = case expCmdG @b of { ExpG -> checkExpr; CmdG -> checkCmd }\n  where\n    checkExpr :: LHsExpr GhcPs -> P ()\n    checkExpr expr = case unLoc expr of\n      HsDo _ DoExpr _ -> check \"do block\" expr\n      HsDo _ MDoExpr _ -> check \"mdo block\" expr\n      HsLam {} -> check \"lambda expression\" expr\n      HsCase {} -> check \"case expression\" expr\n      HsLamCase {} -> check \"lambda-case expression\" expr\n      HsLet {} -> check \"let expression\" expr\n      HsIf {} -> check \"if expression\" expr\n      HsProc {} -> check \"proc expression\" expr\n      _ -> return ()\n\n    checkCmd :: LHsCmd GhcPs -> P ()\n    checkCmd cmd = case unLoc cmd of\n      HsCmdLam {} -> check \"lambda command\" cmd\n      HsCmdCase {} -> check \"case command\" cmd\n      HsCmdIf {} -> check \"if command\" cmd\n      HsCmdLet {} -> check \"let command\" cmd\n      HsCmdDo {} -> check \"do command\" cmd\n      _ -> return ()\n\n    check :: (HasSrcSpan a, Outputable a) => String -> a -> P ()\n    check element a = do\n      blockArguments <- getBit BlockArgumentsBit\n      unless blockArguments $\n        addError (getLoc a) $\n          text \"Unexpected \" <> text element <> text \" in function application:\"\n           $$ nest 4 (ppr a)\n           $$ text \"You could write it with parentheses\"\n           $$ text \"Or perhaps you meant to enable BlockArguments?\"\n\n-- | Validate the context constraints and break up a context into a list\n-- of predicates.\n--\n-- @\n--     (Eq a, Ord b)        -->  [Eq a, Ord b]\n--     Eq a                 -->  [Eq a]\n--     (Eq a)               -->  [Eq a]\n--     (((Eq a)))           -->  [Eq a]\n-- @\ncheckContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)\ncheckContext (dL->L l orig_t)\n  = check [] (cL l orig_t)\n where\n  check anns (dL->L lp (HsTupleTy _ HsBoxedOrConstraintTuple ts))\n    -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can\n    -- be used as context constraints.\n    = return (anns ++ mkParensApiAnn lp,cL l ts)                -- Ditto ()\n\n  check anns (dL->L lp1 (HsParTy _ ty))\n                                  -- to be sure HsParTy doesn't get into the way\n       = check anns' ty\n         where anns' = if l == lp1 then anns\n                                   else (anns ++ mkParensApiAnn lp1)\n\n  -- no need for anns, returning original\n  check _anns t = checkNoDocs msg t *> return ([],cL l [cL l orig_t])\n\n  msg = text \"data constructor context\"\n\n-- | Check recursively if there are any 'HsDocTy's in the given type.\n-- This only works on a subset of types produced by 'btype_no_ops'\ncheckNoDocs :: SDoc -> LHsType GhcPs -> P ()\ncheckNoDocs msg ty = go ty\n  where\n    go (dL->L _ (HsAppKindTy _ ty ki)) = go ty *> go ki\n    go (dL->L _ (HsAppTy _ t1 t2)) = go t1 *> go t2\n    go (dL->L l (HsDocTy _ t ds)) = addError l $ hsep\n                                  [ text \"Unexpected haddock\", quotes (ppr ds)\n                                  , text \"on\", msg, quotes (ppr t) ]\n    go _ = pure ()\n\n-- -------------------------------------------------------------------------\n-- Checking Patterns.\n\n-- We parse patterns as expressions and check for valid patterns below,\n-- converting the expression into a pattern at the same time.\n\ncheckPattern :: SDoc -> LHsExpr GhcPs -> P (LPat GhcPs)\ncheckPattern msg e = checkLPat msg e\n\ncheckPatterns :: SDoc -> [LHsExpr GhcPs] -> P [LPat GhcPs]\ncheckPatterns msg es = mapM (checkPattern msg) es\n\ncheckLPat :: SDoc -> LHsExpr GhcPs -> P (LPat GhcPs)\ncheckLPat msg e@(dL->L l _) = checkPat msg l e []\n\ncheckPat :: SDoc -> SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs]\n         -> P (LPat GhcPs)\ncheckPat _ loc (dL->L l e@(HsVar _ (dL->L _ c))) args\n  | isRdrDataCon c = return (cL loc (ConPatIn (cL l c) (PrefixCon args)))\n  | not (null args) && patIsRec c =\n      patFail (text \"Perhaps you intended to use RecursiveDo\") l e\ncheckPat msg loc e args     -- OK to let this happen even if bang-patterns\n                        -- are not enabled, because there is no valid\n                        -- non-bang-pattern parse of (C ! e)\n  | Just (e', args') <- splitBang e\n  = do  { args'' <- checkPatterns msg args'\n        ; checkPat msg loc e' (args'' ++ args) }\ncheckPat msg loc (dL->L _ (HsApp _ f e)) args\n  = do p <- checkLPat msg e\n       checkPat msg loc f (p : args)\ncheckPat msg loc (dL->L _ e) []\n  = do p <- checkAPat msg loc e\n       return (cL loc p)\ncheckPat msg loc e _\n  = patFail msg loc (unLoc e)\n\ncheckAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs)\ncheckAPat msg loc e0 = do\n nPlusKPatterns <- getBit NPlusKPatternsBit\n case e0 of\n   EWildPat _ -> return (WildPat noExt)\n   HsVar _ x  -> return (VarPat noExt x)\n   HsLit _ (HsStringPrim _ _) -- (#13260)\n       -> addFatalError loc (text \"Illegal unboxed string literal in pattern:\"\n                              $$ ppr e0)\n\n   HsLit _ l  -> return (LitPat noExt l)\n\n   -- Overloaded numeric patterns (e.g. f 0 x = x)\n   -- Negation is recorded separately, so that the literal is zero or +ve\n   -- NB. Negative *primitive* literals are already handled by the lexer\n   HsOverLit _ pos_lit          -> return (mkNPat (cL loc pos_lit) Nothing)\n   NegApp _ (dL->L l (HsOverLit _ pos_lit)) _\n                        -> return (mkNPat (cL l pos_lit) (Just noSyntaxExpr))\n\n   SectionR _ (dL->L lb (HsVar _ (dL->L _ bang))) e    -- (! x)\n        | bang == bang_RDR\n        -> do { hintBangPat loc e0\n              ; e' <- checkLPat msg e\n              ; addAnnotation loc AnnBang lb\n              ; return  (BangPat noExt e') }\n\n   ELazyPat _ e         -> checkLPat msg e >>= (return . (LazyPat noExt))\n   EAsPat _ n e         -> checkLPat msg e >>= (return . (AsPat noExt) n)\n   -- view pattern is well-formed if the pattern is\n   EViewPat _ expr patE -> checkLPat msg patE >>=\n                            (return . (\\p -> ViewPat noExt expr p))\n   ExprWithTySig _ e t  -> do e <- checkLPat msg e\n                              return (SigPat noExt e t)\n\n   -- n+k patterns\n   OpApp _ (dL->L nloc (HsVar _ (dL->L _ n)))\n           (dL->L _    (HsVar _ (dL->L _ plus)))\n           (dL->L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}})))\n                      | nPlusKPatterns && (plus == plus_RDR)\n                      -> return (mkNPlusKPat (cL nloc n) (cL lloc lit))\n   OpApp _ l (dL->L cl (HsVar _ (dL->L _ c))) r\n     | isDataOcc (rdrNameOcc c) -> do\n         l <- checkLPat msg l\n         r <- checkLPat msg r\n         return (ConPatIn (cL cl c) (InfixCon l r))\n\n   OpApp {}           -> patFail msg loc e0\n\n   ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es\n                             return (ListPat noExt ps)\n\n   HsPar _ e          -> checkLPat msg e >>= (return . (ParPat noExt))\n\n   ExplicitTuple _ es b\n     | all tupArgPresent es  -> do ps <- mapM (checkLPat msg)\n                                           [e | (dL->L _ (Present _ e)) <- es]\n                                   return (TuplePat noExt ps b)\n     | otherwise -> addFatalError loc (text \"Illegal tuple section in pattern:\"\n                                        $$ ppr e0)\n\n   ExplicitSum _ alt arity expr -> do\n     p <- checkLPat msg expr\n     return (SumPat noExt p alt arity)\n\n   RecordCon { rcon_con_name = c, rcon_flds = HsRecFields fs dd }\n                        -> do fs <- mapM (checkPatField msg) fs\n                              return (ConPatIn c (RecCon (HsRecFields fs dd)))\n   HsSpliceE _ s | not (isTypedSplice s)\n               -> return (SplicePat noExt s)\n   _           -> patFail msg loc e0\n\nplaceHolderPunRhs :: LHsExpr GhcPs\n-- The RHS of a punned record field will be filled in by the renamer\n-- It's better not to make it an error, in case we want to print it when\n-- debugging\nplaceHolderPunRhs = noLoc (HsVar noExt (noLoc pun_RDR))\n\nplus_RDR, bang_RDR, pun_RDR :: RdrName\nplus_RDR = mkUnqual varName (fsLit \"+\") -- Hack\nbang_RDR = mkUnqual varName (fsLit \"!\") -- Hack\npun_RDR  = mkUnqual varName (fsLit \"pun-right-hand-side\")\n\nisBangRdr, isTildeRdr :: RdrName -> Bool\nisBangRdr (Unqual occ) = occNameFS occ == fsLit \"!\"\nisBangRdr _ = False\nisTildeRdr = (==eqTyCon_RDR)\n\ncheckPatField :: SDoc -> LHsRecField GhcPs (LHsExpr GhcPs)\n              -> P (LHsRecField GhcPs (LPat GhcPs))\ncheckPatField msg (dL->L l fld) = do p <- checkLPat msg (hsRecFieldArg fld)\n                                     return (cL l (fld { hsRecFieldArg = p }))\n\npatFail :: SDoc -> SrcSpan -> HsExpr GhcPs -> P a\npatFail msg loc e = addFatalError loc err\n    where err = text \"Parse error in pattern:\" <+> ppr e\n             $$ msg\n\npatIsRec :: RdrName -> Bool\npatIsRec e = e == mkUnqual varName (fsLit \"rec\")\n\n\n---------------------------------------------------------------------------\n-- Check Equation Syntax\n\ncheckValDef :: SDoc\n            -> SrcStrictness\n            -> LHsExpr GhcPs\n            -> Maybe (LHsType GhcPs)\n            -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))\n            -> P ([AddAnn],HsBind GhcPs)\n\ncheckValDef msg _strictness lhs (Just sig) grhss\n        -- x :: ty = rhs  parses as a *pattern* binding\n  = checkPatBind msg (cL (combineLocs lhs sig)\n                        (ExprWithTySig noExt lhs (mkLHsSigWcType sig))) grhss\n\ncheckValDef msg strictness lhs Nothing g@(dL->L l (_,grhss))\n  = do  { mb_fun <- isFunLhs lhs\n        ; case mb_fun of\n            Just (fun, is_infix, pats, ann) ->\n              checkFunBind msg strictness ann (getLoc lhs)\n                           fun is_infix pats (cL l grhss)\n            Nothing -> checkPatBind msg lhs g }\n\ncheckFunBind :: SDoc\n             -> SrcStrictness\n             -> [AddAnn]\n             -> SrcSpan\n             -> Located RdrName\n             -> LexicalFixity\n             -> [LHsExpr GhcPs]\n             -> Located (GRHSs GhcPs (LHsExpr GhcPs))\n             -> P ([AddAnn],HsBind GhcPs)\ncheckFunBind msg strictness ann lhs_loc fun is_infix pats (dL->L rhs_span grhss)\n  = do  ps <- checkPatterns msg pats\n        let match_span = combineSrcSpans lhs_loc rhs_span\n        -- Add back the annotations stripped from any HsPar values in the lhs\n        -- mapM_ (\\a -> a match_span) ann\n        return (ann, makeFunBind fun\n                  [cL match_span (Match { m_ext = noExt\n                                        , m_ctxt = FunRhs\n                                            { mc_fun    = fun\n                                            , mc_fixity = is_infix\n                                            , mc_strictness = strictness }\n                                        , m_pats = ps\n                                        , m_grhss = grhss })])\n        -- The span of the match covers the entire equation.\n        -- That isn't quite right, but it'll do for now.\n\nmakeFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]\n            -> HsBind GhcPs\n-- Like HsUtils.mkFunBind, but we need to be able to set the fixity too\nmakeFunBind fn ms\n  = FunBind { fun_ext = noExt,\n              fun_id = fn,\n              fun_matches = mkMatchGroup FromSource ms,\n              fun_co_fn = idHsWrapper,\n              fun_tick = [] }\n\ncheckPatBind :: SDoc\n             -> LHsExpr GhcPs\n             -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))\n             -> P ([AddAnn],HsBind GhcPs)\ncheckPatBind msg lhs (dL->L _ (_,grhss))\n  = do  { lhs <- checkPattern msg lhs\n        ; return ([],PatBind noExt lhs grhss\n                    ([],[])) }\n\ncheckValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)\ncheckValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v)))\n  | isUnqual v\n  , not (isDataOcc (rdrNameOcc v))\n  = return lrdr\n\ncheckValSigLhs lhs@(dL->L l _)\n  = addFatalError l ((text \"Invalid type signature:\" <+>\n                       ppr lhs <+> text \":: ...\")\n                      $$ text hint)\n  where\n    hint | foreign_RDR `looks_like` lhs\n         = \"Perhaps you meant to use ForeignFunctionInterface?\"\n         | default_RDR `looks_like` lhs\n         = \"Perhaps you meant to use DefaultSignatures?\"\n         | pattern_RDR `looks_like` lhs\n         = \"Perhaps you meant to use PatternSynonyms?\"\n         | otherwise\n         = \"Should be of form <variable> :: <type>\"\n\n    -- A common error is to forget the ForeignFunctionInterface flag\n    -- so check for that, and suggest.  cf Trac #3805\n    -- Sadly 'foreign import' still barfs 'parse error' because\n    --  'import' is a keyword\n    looks_like s (dL->L _ (HsVar _ (dL->L _ v))) = v == s\n    looks_like s (dL->L _ (HsApp _ lhs _))   = looks_like s lhs\n    looks_like _ _                       = False\n\n    foreign_RDR = mkUnqual varName (fsLit \"foreign\")\n    default_RDR = mkUnqual varName (fsLit \"default\")\n    pattern_RDR = mkUnqual varName (fsLit \"pattern\")\n\ncheckDoAndIfThenElse\n  :: forall b. ExpCmdI b =>\n     LHsExpr GhcPs\n  -> Bool\n  -> Located (b GhcPs)\n  -> Bool\n  -> Located (b GhcPs)\n  -> P ()\ncheckDoAndIfThenElse =\n  case expCmdG @b of\n    ExpG -> checkDoAndIfThenElse'\n    CmdG -> checkDoAndIfThenElse'\n\ncheckDoAndIfThenElse'\n  :: (HasSrcSpan a, Outputable a, Outputable b, HasSrcSpan c, Outputable c)\n  => a -> Bool -> b -> Bool -> c -> P ()\ncheckDoAndIfThenElse' guardExpr semiThen thenExpr semiElse elseExpr\n | semiThen || semiElse\n    = do doAndIfThenElse <- getBit DoAndIfThenElseBit\n         unless doAndIfThenElse $ do\n             addError (combineLocs guardExpr elseExpr)\n                            (text \"Unexpected semi-colons in conditional:\"\n                          $$ nest 4 expr\n                          $$ text \"Perhaps you meant to use DoAndIfThenElse?\")\n | otherwise            = return ()\n    where pprOptSemi True  = semi\n          pprOptSemi False = empty\n          expr = text \"if\"   <+> ppr guardExpr <> pprOptSemi semiThen <+>\n                 text \"then\" <+> ppr thenExpr  <> pprOptSemi semiElse <+>\n                 text \"else\" <+> ppr elseExpr\n\n\n        -- The parser left-associates, so there should\n        -- not be any OpApps inside the e's\nsplitBang :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])\n-- Splits (f ! g a b) into (f, [(! g), a, b])\nsplitBang (dL->L _ (OpApp _ l_arg bang@(dL->L _ (HsVar _ (dL->L _ op))) r_arg))\n  | op == bang_RDR = Just (l_arg, cL l' (SectionR noExt bang arg1) : argns)\n  where\n    l' = combineLocs bang arg1\n    (arg1,argns) = split_bang r_arg []\n    split_bang (dL->L _ (HsApp _ f e)) es = split_bang f (e:es)\n    split_bang e                       es = (e,es)\nsplitBang _ = Nothing\n\n-- See Note [isFunLhs vs mergeDataCon]\nisFunLhs :: LHsExpr GhcPs\n      -> P (Maybe (Located RdrName, LexicalFixity, [LHsExpr GhcPs],[AddAnn]))\n-- A variable binding is parsed as a FunBind.\n-- Just (fun, is_infix, arg_pats) if e is a function LHS\n--\n-- The whole LHS is parsed as a single expression.\n-- Any infix operators on the LHS will parse left-associatively\n-- E.g.         f !x y !z\n--      will parse (rather strangely) as\n--              (f ! x y) ! z\n--      It's up to isFunLhs to sort out the mess\n--\n-- a .!. !b\n\nisFunLhs e = go e [] []\n where\n   go (dL->L loc (HsVar _ (dL->L _ f))) es ann\n       | not (isRdrDataCon f)        = return (Just (cL loc f, Prefix, es, ann))\n   go (dL->L _ (HsApp _ f e)) es       ann = go f (e:es) ann\n   go (dL->L l (HsPar _ e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)\n\n        -- Things of the form `!x` are also FunBinds\n        -- See Note [FunBind vs PatBind]\n   go (dL->L _ (SectionR _ (dL->L _ (HsVar _ (dL->L _ bang)))\n                (dL->L l (HsVar _ (L _ var))))) [] ann\n        | bang == bang_RDR\n        , not (isRdrDataCon var)     = return (Just (cL l var, Prefix, [], ann))\n\n      -- For infix function defns, there should be only one infix *function*\n      -- (though there may be infix *datacons* involved too).  So we don't\n      -- need fixity info to figure out which function is being defined.\n      --      a `K1` b `op` c `K2` d\n      -- must parse as\n      --      (a `K1` b) `op` (c `K2` d)\n      -- The renamer checks later that the precedences would yield such a parse.\n      --\n      -- There is a complication to deal with bang patterns.\n      --\n      -- ToDo: what about this?\n      --              x + 1 `op` y = ...\n\n   go e@(L loc (OpApp _ l (dL->L loc' (HsVar _ (dL->L _ op))) r)) es ann\n        | Just (e',es') <- splitBang e\n        = do { bang_on <- getBit BangPatBit\n             ; if bang_on then go e' (es' ++ es) ann\n               else return (Just (cL loc' op, Infix, (l:r:es), ann)) }\n                -- No bangs; behave just like the next case\n        | not (isRdrDataCon op)         -- We have found the function!\n        = return (Just (cL loc' op, Infix, (l:r:es), ann))\n        | otherwise                     -- Infix data con; keep going\n        = do { mb_l <- go l es ann\n             ; case mb_l of\n                 Just (op', Infix, j : k : es', ann')\n                   -> return (Just (op', Infix, j : op_app : es', ann'))\n                   where\n                     op_app = cL loc (OpApp noExt k\n                               (cL loc' (HsVar noExt (cL loc' op))) r)\n                 _ -> return Nothing }\n   go _ _ _ = return Nothing\n\n-- | Either an operator or an operand.\ndata TyEl = TyElOpr RdrName | TyElOpd (HsType GhcPs)\n          | TyElKindApp SrcSpan (LHsType GhcPs)\n          -- See Note [TyElKindApp SrcSpan interpretation]\n          | TyElTilde | TyElBang\n          | TyElUnpackedness ([AddAnn], SourceText, SrcUnpackedness)\n          | TyElDocPrev HsDocString\n\n\n{- Note [TyElKindApp SrcSpan interpretation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA TyElKindApp captures type application written in haskell as\n\n    @ Foo\n\nwhere Foo is some type.\n\nThe SrcSpan reflects both elements, and there are AnnAt and AnnVal API\nAnnotations attached to this SrcSpan for the specific locations of\neach within it.\n-}\n\ninstance Outputable TyEl where\n  ppr (TyElOpr name) = ppr name\n  ppr (TyElOpd ty) = ppr ty\n  ppr (TyElKindApp _ ki) = text \"@\" <> ppr ki\n  ppr TyElTilde = text \"~\"\n  ppr TyElBang = text \"!\"\n  ppr (TyElUnpackedness (_, _, unpk)) = ppr unpk\n  ppr (TyElDocPrev doc) = ppr doc\n\ntyElStrictness :: TyEl -> Maybe (AnnKeywordId, SrcStrictness)\ntyElStrictness TyElTilde = Just (AnnTilde, SrcLazy)\ntyElStrictness TyElBang = Just (AnnBang, SrcStrict)\ntyElStrictness _ = Nothing\n\n-- | Extract a strictness/unpackedness annotation from the front of a reversed\n-- 'TyEl' list.\npStrictMark\n  :: [Located TyEl] -- reversed TyEl\n  -> Maybe ( Located HsSrcBang {- a strictness/upnackedness marker -}\n           , [AddAnn]\n           , [Located TyEl] {- remaining TyEl -})\npStrictMark ((dL->L l1 x1) : (dL->L l2 x2) : xs)\n  | Just (strAnnId, str) <- tyElStrictness x1\n  , TyElUnpackedness (unpkAnns, prag, unpk) <- x2\n  = Just ( cL (combineSrcSpans l1 l2) (HsSrcBang prag unpk str)\n         , unpkAnns ++ [\\s -> addAnnotation s strAnnId l1]\n         , xs )\npStrictMark ((dL->L l x1) : xs)\n  | Just (strAnnId, str) <- tyElStrictness x1\n  = Just ( cL l (HsSrcBang NoSourceText NoSrcUnpack str)\n         , [\\s -> addAnnotation s strAnnId l]\n         , xs )\npStrictMark ((dL->L l x1) : xs)\n  | TyElUnpackedness (anns, prag, unpk) <- x1\n  = Just ( cL l (HsSrcBang prag unpk NoSrcStrict)\n         , anns\n         , xs )\npStrictMark _ = Nothing\n\npBangTy\n  :: LHsType GhcPs  -- a type to be wrapped inside HsBangTy\n  -> [Located TyEl] -- reversed TyEl\n  -> ( Bool           {- has a strict mark been consumed? -}\n     , LHsType GhcPs  {- the resulting BangTy -}\n     , P ()           {- add annotations -}\n     , [Located TyEl] {- remaining TyEl -})\npBangTy lt@(dL->L l1 _) xs =\n  case pStrictMark xs of\n    Nothing -> (False, lt, pure (), xs)\n    Just (dL->L l2 strictMark, anns, xs') ->\n      let bl = combineSrcSpans l1 l2\n          bt = HsBangTy noExt strictMark lt\n      in (True, cL bl bt, addAnnsAt bl anns, xs')\n\n-- | Merge a /reversed/ and /non-empty/ soup of operators and operands\n--   into a type.\n--\n-- User input: @F x y + G a b * X@\n-- Input to 'mergeOps': [X, *, b, a, G, +, y, x, F]\n-- Output corresponds to what the user wrote assuming all operators are of the\n-- same fixity and right-associative.\n--\n-- It's a bit silly that we're doing it at all, as the renamer will have to\n-- rearrange this, and it'd be easier to keep things separate.\n--\n-- See Note [Parsing data constructors is hard]\nmergeOps :: [Located TyEl] -> P (LHsType GhcPs)\nmergeOps ((dL->L l1 (TyElOpd t)) : xs)\n  | (_, t', addAnns, xs') <- pBangTy (cL l1 t) xs\n  , null xs' -- We accept a BangTy only when there are no preceding TyEl.\n  = addAnns >> return t'\nmergeOps all_xs = go (0 :: Int) [] id all_xs\n  where\n    -- NB. When modifying clauses in 'go', make sure that the reasoning in\n    -- Note [Non-empty 'acc' in mergeOps clause [end]] is still correct.\n\n    -- clause [unpk]:\n    -- handle (NO)UNPACK pragmas\n    go k acc ops_acc ((dL->L l (TyElUnpackedness (anns, unpkSrc, unpk))):xs) =\n      if not (null acc) && null xs\n      then do { acc' <- eitherToP $ mergeOpsAcc acc\n              ; let a = ops_acc acc'\n                    strictMark = HsSrcBang unpkSrc unpk NoSrcStrict\n                    bl = combineSrcSpans l (getLoc a)\n                    bt = HsBangTy noExt strictMark a\n              ; addAnnsAt bl anns\n              ; return (cL bl bt) }\n      else addFatalError l unpkError\n      where\n        unpkSDoc = case unpkSrc of\n          NoSourceText -> ppr unpk\n          SourceText str -> text str <> text \" #-}\"\n        unpkError\n          | not (null xs) = unpkSDoc <+> text \"cannot appear inside a type.\"\n          | null acc && k == 0 = unpkSDoc <+> text \"must be applied to a type.\"\n          | otherwise =\n              -- See Note [Impossible case in mergeOps clause [unpk]]\n              panic \"mergeOps.UNPACK: impossible position\"\n\n    -- clause [doc]:\n    -- we do not expect to encounter any docs\n    go _ _ _ ((dL->L l (TyElDocPrev _)):_) =\n      failOpDocPrev l\n\n    -- to improve error messages, we do a bit of guesswork to determine if the\n    -- user intended a '!' or a '~' as a strictness annotation\n    go k acc ops_acc ((dL->L l x) : xs)\n      | Just (_, str) <- tyElStrictness x\n      , let guess [] = True\n            guess ((dL->L _ (TyElOpd _)):_) = False\n            guess ((dL->L _ (TyElOpr _)):_) = True\n            guess ((dL->L _ (TyElKindApp _ _)):_) = False\n            guess ((dL->L _ (TyElTilde)):_) = True\n            guess ((dL->L _ (TyElBang)):_) = True\n            guess ((dL->L _ (TyElUnpackedness _)):_) = True\n            guess ((dL->L _ (TyElDocPrev _)):xs') = guess xs'\n            guess _ = panic \"mergeOps.go.guess: Impossible Match\"\n                      -- due to #15884\n        in guess xs\n      = if not (null acc) && (k > 1 || length acc > 1)\n        then do { a <- eitherToP (mergeOpsAcc acc)\n                ; failOpStrictnessCompound (cL l str) (ops_acc a) }\n        else failOpStrictnessPosition (cL l str)\n\n    -- clause [opr]:\n    -- when we encounter an operator, we must have accumulated\n    -- something for its rhs, and there must be something left\n    -- to build its lhs.\n    go k acc ops_acc ((dL->L l (TyElOpr op)):xs) =\n      if null acc || null (filter isTyElOpd xs)\n        then failOpFewArgs (cL l op)\n        else do { acc' <- eitherToP (mergeOpsAcc acc)\n                ; go (k + 1) [] (\\c -> mkLHsOpTy c (cL l op) (ops_acc acc')) xs }\n      where\n        isTyElOpd (dL->L _ (TyElOpd _)) = True\n        isTyElOpd _ = False\n\n    -- clause [opr.1]: interpret 'TyElTilde' as an operator\n    go k acc ops_acc ((dL->L l TyElTilde):xs) =\n      let op = eqTyCon_RDR\n      in go k acc ops_acc (cL l (TyElOpr op):xs)\n\n    -- clause [opr.2]: interpret 'TyElBang' as an operator\n    go k acc ops_acc ((dL->L l TyElBang):xs) =\n      let op = mkUnqual tcClsName (fsLit \"!\")\n      in go k acc ops_acc (cL l (TyElOpr op):xs)\n\n    -- clause [opd]:\n    -- whenever an operand is encountered, it is added to the accumulator\n    go k acc ops_acc ((dL->L l (TyElOpd a)):xs) = go k (HsValArg (cL l a):acc) ops_acc xs\n\n    -- clause [tyapp]:\n    -- whenever a type application is encountered, it is added to the accumulator\n    go k acc ops_acc ((dL->L _ (TyElKindApp l a)):xs) = go k (HsTypeArg l a:acc) ops_acc xs\n\n    -- clause [end]\n    -- See Note [Non-empty 'acc' in mergeOps clause [end]]\n    go _ acc ops_acc [] = do { acc' <- eitherToP (mergeOpsAcc acc)\n                             ; return (ops_acc acc') }\n\n    go _ _ _ _ = panic \"mergeOps.go: Impossible Match\"\n                        -- due to #15884\n\nmergeOpsAcc :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]\n         -> Either (SrcSpan, SDoc) (LHsType GhcPs)\nmergeOpsAcc [] = panic \"mergeOpsAcc: empty input\"\nmergeOpsAcc (HsTypeArg _ (L loc ki):_)\n  = Left (loc, text \"Unexpected type application:\" <+> ppr ki)\nmergeOpsAcc (HsValArg ty : xs) = go1 ty xs\n  where\n    go1 :: LHsType GhcPs\n        -> [HsArg (LHsType GhcPs) (LHsKind GhcPs)]\n        -> Either (SrcSpan, SDoc) (LHsType GhcPs)\n    go1 lhs []     = Right lhs\n    go1 lhs (x:xs) = case x of\n        HsValArg ty -> go1 (mkHsAppTy lhs ty) xs\n        HsTypeArg loc ki -> let ty = mkHsAppKindTy loc lhs ki\n                            in go1 ty xs\n        HsArgPar _ -> go1 lhs xs\nmergeOpsAcc (HsArgPar _: xs) = mergeOpsAcc xs\n\n{- Note [Impossible case in mergeOps clause [unpk]]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis case should never occur. Let us consider all possible\nvariations of 'acc', 'xs', and 'k':\n\n  acc          xs        k\n==============================\n  null   |    null       0      -- \"must be applied to a type\"\n  null   |  not null     0      -- \"must be applied to a type\"\nnot null |    null       0      -- successful parse\nnot null |  not null     0      -- \"cannot appear inside a type\"\n  null   |    null      >0      -- handled in clause [opr]\n  null   |  not null    >0      -- \"cannot appear inside a type\"\nnot null |    null      >0      -- successful parse\nnot null |  not null    >0      -- \"cannot appear inside a type\"\n\nThe (null acc && null xs && k>0) case is handled in clause [opr]\nby the following check:\n\n    if ... || null (filter isTyElOpd xs)\n     then failOpFewArgs (L l op)\n\nWe know that this check has been performed because k>0, and by\nthe time we reach the end of the list (null xs), the only way\nfor (null acc) to hold is that there was not a single TyElOpd\nbetween the operator and the end of the list. But this case is\ncaught by the check and reported as 'failOpFewArgs'.\n-}\n\n{- Note [Non-empty 'acc' in mergeOps clause [end]]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn clause [end] we need to know that 'acc' is non-empty to call 'mergeAcc'\nwithout a check.\n\nRunning 'mergeOps' with an empty input list is forbidden, so we do not consider\nthis possibility. This means we'll hit at least one other clause before we\nreach clause [end].\n\n* Clauses [unpk] and [doc] do not call 'go' recursively, so we cannot hit\n  clause [end] from there.\n* Clause [opd] makes 'acc' non-empty, so if we hit clause [end] after it, 'acc'\n  will be non-empty.\n* Clause [opr] checks that (filter isTyElOpd xs) is not null - so we are going\n  to hit clause [opd] at least once before we reach clause [end], making 'acc'\n  non-empty.\n* There are no other clauses.\n\nTherefore, it is safe to omit a check for non-emptiness of 'acc' in clause\n[end].\n\n-}\n\npInfixSide :: [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])\npInfixSide ((dL->L l (TyElOpd t)):xs)\n  | (True, t', addAnns, xs') <- pBangTy (cL l t) xs\n  = Just (t', addAnns, xs')\npInfixSide (el:xs1)\n  | Just t1 <- pLHsTypeArg el\n  = go [t1] xs1\n   where\n     go :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)]\n        -> [Located TyEl] -> Maybe (LHsType GhcPs, P (), [Located TyEl])\n     go acc (el:xs)\n       | Just t <- pLHsTypeArg el\n       = go (t:acc) xs\n     go acc xs = case mergeOpsAcc acc of\n       Left _ -> Nothing\n       Right acc' -> Just (acc', pure (), xs)\npInfixSide _ = Nothing\n\npLHsTypeArg :: Located TyEl -> Maybe (HsArg (LHsType GhcPs) (LHsKind GhcPs))\npLHsTypeArg (dL->L l (TyElOpd a)) = Just (HsValArg (L l a))\npLHsTypeArg (dL->L _ (TyElKindApp l a)) = Just (HsTypeArg l a)\npLHsTypeArg _ = Nothing\n\npDocPrev :: [Located TyEl] -> (Maybe LHsDocString, [Located TyEl])\npDocPrev = go Nothing\n  where\n    go mTrailingDoc ((dL->L l (TyElDocPrev doc)):xs) =\n      go (mTrailingDoc `mplus` Just (cL l doc)) xs\n    go mTrailingDoc xs = (mTrailingDoc, xs)\n\norErr :: Maybe a -> b -> Either b a\norErr (Just a) _ = Right a\norErr Nothing b = Left b\n\n{- Note [isFunLhs vs mergeDataCon]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen parsing a function LHS, we do not know whether to treat (!) as\na strictness annotation or an infix operator:\n\n  f ! a = ...\n\nWithout -XBangPatterns, this parses as   (!) f a = ...\n   with -XBangPatterns, this parses as   f (!a) = ...\n\nSo in function declarations we opted to always parse as if -XBangPatterns\nwere off, and then rejig in 'isFunLhs'.\n\nThere are two downsides to this approach:\n\n1. It is not particularly elegant, as there's a point in our pipeline where\n   the representation is awfully incorrect. For instance,\n      f !a b !c = ...\n   will be first parsed as\n      (f ! a b) ! c = ...\n\n2. There are cases that it fails to cover, for instance infix declarations:\n      !a + !b = ...\n   will trigger an error.\n\nUnfortunately, we cannot define different productions in the 'happy' grammar\ndepending on whether -XBangPatterns are enabled.\n\nWhen parsing data constructors, we face a similar issue:\n  (a) data T1 = C ! D\n  (b) data T2 = C ! D => ...\n\nIn (a) the first bang is a strictness annotation, but in (b) it is a type\noperator. A 'happy'-based parser does not have unlimited lookahead to check for\n=>, so we must first parse (C ! D) into a common representation.\n\nIf we tried to mirror the approach used in functions, we would parse both sides\nof => as types, and then rejig. However, we take a different route and use an\nintermediate data structure, a reversed list of 'TyEl'.\nSee Note [Parsing data constructors is hard] for details.\n\nThis approach does not suffer from the issues of 'isFunLhs':\n\n1. A sequence of 'TyEl' is a dedicated intermediate representation, not an\n   incorrectly parsed type. Therefore, we do not have confusing states in our\n   pipeline. (Except for representing data constructors as type variables).\n\n2. We can handle infix data constructors with strictness annotations:\n    data T a b = !a :+ !b\n\n-}\n\n\n-- | Merge a /reversed/ and /non-empty/ soup of operators and operands\n--   into a data constructor.\n--\n-- User input: @C !A B -- ^ doc@\n-- Input to 'mergeDataCon': [\"doc\", B, !, A, C]\n-- Output: (C, PrefixCon [!A, B], \"doc\")\n--\n-- See Note [Parsing data constructors is hard]\n-- See Note [isFunLhs vs mergeDataCon]\nmergeDataCon\n      :: [Located TyEl]\n      -> P ( Located RdrName         -- constructor name\n           , HsConDeclDetails GhcPs  -- constructor field information\n           , Maybe LHsDocString      -- docstring to go on the constructor\n           )\nmergeDataCon all_xs =\n  do { (addAnns, a) <- eitherToP res\n     ; addAnns\n     ; return a }\n  where\n    -- We start by splitting off the trailing documentation comment,\n    -- if any exists.\n    (mTrailingDoc, all_xs') = pDocPrev all_xs\n\n    -- Determine whether the trailing documentation comment exists and is the\n    -- only docstring in this constructor declaration.\n    --\n    -- When true, it means that it applies to the constructor itself:\n    --    data T = C\n    --             A\n    --             B -- ^ Comment on C (singleDoc == True)\n    --\n    -- When false, it means that it applies to the last field:\n    --    data T = C -- ^ Comment on C\n    --             A -- ^ Comment on A\n    --             B -- ^ Comment on B (singleDoc == False)\n    singleDoc = isJust mTrailingDoc &&\n                null [ () | (dL->L _ (TyElDocPrev _)) <- all_xs' ]\n\n    -- The result of merging the list of reversed TyEl into a\n    -- data constructor, along with [AddAnn].\n    res = goFirst all_xs'\n\n    -- Take the trailing docstring into account when interpreting\n    -- the docstring near the constructor.\n    --\n    --    data T = C -- ^ docstring right after C\n    --             A\n    --             B -- ^ trailing docstring\n    --\n    -- 'mkConDoc' must be applied to the docstring right after C, so that it\n    -- falls back to the trailing docstring when appropriate (see singleDoc).\n    mkConDoc mDoc | singleDoc = mDoc `mplus` mTrailingDoc\n                  | otherwise = mDoc\n\n    -- The docstring for the last field of a data constructor.\n    trailingFieldDoc | singleDoc = Nothing\n                     | otherwise = mTrailingDoc\n\n    goFirst [ dL->L l (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ]\n      = do { data_con <- tyConToDataCon l tc\n           ; return (pure (), (data_con, PrefixCon [], mTrailingDoc)) }\n    goFirst ((dL->L l (TyElOpd (HsRecTy _ fields))):xs)\n      | (mConDoc, xs') <- pDocPrev xs\n      , [ dL->L l' (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ] <- xs'\n      = do { data_con <- tyConToDataCon l' tc\n           ; let mDoc = mTrailingDoc `mplus` mConDoc\n           ; return (pure (), (data_con, RecCon (cL l fields), mDoc)) }\n    goFirst [dL->L l (TyElOpd (HsTupleTy _ HsBoxedOrConstraintTuple ts))]\n      = return ( pure ()\n               , ( cL l (getRdrName (tupleDataCon Boxed (length ts)))\n                 , PrefixCon ts\n                 , mTrailingDoc ) )\n    goFirst ((dL->L l (TyElOpd t)):xs)\n      | (_, t', addAnns, xs') <- pBangTy (cL l t) xs\n      = go addAnns Nothing [mkLHsDocTyMaybe t' trailingFieldDoc] xs'\n    goFirst (L l (TyElKindApp _ _):_)\n      = goInfix Monoid.<> Left (l, kindAppErr)\n    goFirst xs\n      = go (pure ()) mTrailingDoc [] xs\n\n    go addAnns mLastDoc ts [ dL->L l (TyElOpd (HsTyVar _ _ (dL->L _ tc))) ]\n      = do { data_con <- tyConToDataCon l tc\n           ; return (addAnns, (data_con, PrefixCon ts, mkConDoc mLastDoc)) }\n    go addAnns mLastDoc ts ((dL->L l (TyElDocPrev doc)):xs) =\n      go addAnns (mLastDoc `mplus` Just (cL l doc)) ts xs\n    go addAnns mLastDoc ts ((dL->L l (TyElOpd t)):xs)\n      | (_, t', addAnns', xs') <- pBangTy (cL l t) xs\n      , t'' <- mkLHsDocTyMaybe t' mLastDoc\n      = go (addAnns >> addAnns') Nothing (t'':ts) xs'\n    go _ _ _ ((dL->L _ (TyElOpr _)):_) =\n      -- Encountered an operator: backtrack to the beginning and attempt\n      -- to parse as an infix definition.\n      goInfix\n    go _ _ _ (L l (TyElKindApp _ _):_) =  goInfix Monoid.<> Left (l, kindAppErr)\n    go _ _ _ _ = Left malformedErr\n      where\n        malformedErr =\n          ( foldr combineSrcSpans noSrcSpan (map getLoc all_xs')\n          , text \"Cannot parse data constructor\" <+>\n            text \"in a data/newtype declaration:\" $$\n            nest 2 (hsep . reverse $ map ppr all_xs'))\n\n    goInfix =\n      do { let xs0 = all_xs'\n         ; (rhs_t, rhs_addAnns, xs1) <- pInfixSide xs0 `orErr` malformedErr\n         ; let (mOpDoc, xs2) = pDocPrev xs1\n         ; (op, xs3) <- case xs2 of\n              (dL->L l (TyElOpr op)) : xs3 ->\n                do { data_con <- tyConToDataCon l op\n                   ; return (data_con, xs3) }\n              _ -> Left malformedErr\n         ; let (mLhsDoc, xs4) = pDocPrev xs3\n         ; (lhs_t, lhs_addAnns, xs5) <- pInfixSide xs4 `orErr` malformedErr\n         ; unless (null xs5) (Left malformedErr)\n         ; let rhs = mkLHsDocTyMaybe rhs_t trailingFieldDoc\n               lhs = mkLHsDocTyMaybe lhs_t mLhsDoc\n               addAnns = lhs_addAnns >> rhs_addAnns\n         ; return (addAnns, (op, InfixCon lhs rhs, mkConDoc mOpDoc)) }\n      where\n        malformedErr =\n          ( foldr combineSrcSpans noSrcSpan (map getLoc all_xs')\n          , text \"Cannot parse an infix data constructor\" <+>\n            text \"in a data/newtype declaration:\" $$\n            nest 2 (hsep . reverse $ map ppr all_xs'))\n\n    kindAppErr =\n      text \"Unexpected kind application\" <+>\n      text \"in a data/newtype declaration:\" $$\n      nest 2 (hsep . reverse $ map ppr all_xs')\n\n---------------------------------------------------------------------------\n-- | Check for monad comprehensions\n--\n-- If the flag MonadComprehensions is set, return a 'MonadComp' context,\n-- otherwise use the usual 'ListComp' context\n\ncheckMonadComp :: P (HsStmtContext Name)\ncheckMonadComp = do\n    monadComprehensions <- getBit MonadComprehensionsBit\n    return $ if monadComprehensions\n                then MonadComp\n                else ListComp\n\n-- -------------------------------------------------------------------------\n-- Expression/command ambiguity (arrow syntax).\n-- See Note [Ambiguous syntactic categories]\n--\n\n-- ExpCmdP as defined is isomorphic to a pair of parsers:\n--\n--   data ExpCmdP = ExpCmdP { expP :: PV (LHsExpr GhcPs)\n--                          , cmdP :: PV (LHsCmd  GhcPs) }\n--\n-- See Note [Parser-Validator]\n-- See Note [Ambiguous syntactic categories]\nnewtype ExpCmdP =\n  ExpCmdP { runExpCmdP :: forall b. ExpCmdI b => PV (Located (b GhcPs)) }\n\n-- See Note [Ambiguous syntactic categories]\ndata ExpCmdG b where\n  ExpG :: ExpCmdG HsExpr\n  CmdG :: ExpCmdG HsCmd\n\n-- See Note [Ambiguous syntactic categories]\nclass    ExpCmdI b      where expCmdG :: ExpCmdG b\ninstance ExpCmdI HsExpr where expCmdG = ExpG\ninstance ExpCmdI HsCmd  where expCmdG = CmdG\n\necFromCmd :: LHsCmd GhcPs -> ExpCmdP\necFromCmd c@(getLoc -> l) = ExpCmdP onB\n  where\n    onB :: forall b. ExpCmdI b => PV (Located (b GhcPs))\n    onB = case expCmdG @b of { ExpG -> onExp; CmdG -> return c }\n    onExp :: P (LHsExpr GhcPs)\n    onExp = do\n      addError l $ vcat\n        [ text \"Arrow command found where an expression was expected:\",\n          nest 2 (ppr c) ]\n      return (cL l hsHoleExpr)\n\necFromExp :: LHsExpr GhcPs -> ExpCmdP\necFromExp e@(getLoc -> l) = ExpCmdP onB\n  where\n    onB :: forall b. ExpCmdI b => PV (Located (b GhcPs))\n    onB = case expCmdG @b of { ExpG -> return e; CmdG -> onCmd }\n    onCmd :: P (LHsCmd GhcPs)\n    onCmd =\n      addFatalError l $\n        text \"Parse error in command:\" <+> ppr e\n\nhsHoleExpr :: HsExpr (GhcPass id)\nhsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc \"_\"))\n\necHsLam :: forall b. ExpCmdI b => MatchGroup GhcPs (Located (b GhcPs)) -> b GhcPs\necHsLam = case expCmdG @b of { ExpG -> HsLam noExt; CmdG -> HsCmdLam noExt }\n\necHsLet :: forall b. ExpCmdI b => LHsLocalBinds GhcPs -> Located (b GhcPs) -> b GhcPs\necHsLet = case expCmdG @b of { ExpG -> HsLet noExt; CmdG -> HsCmdLet noExt }\n\necOpApp :: forall b. ExpCmdI b => Located (b GhcPs) -> LHsExpr GhcPs\n        -> Located (b GhcPs) -> b GhcPs\necOpApp = case expCmdG @b of { ExpG -> OpApp noExt; CmdG -> cmdOpApp }\n  where\n    cmdOpApp c1 op c2 =\n      let cmdArg c = cL (getLoc c) $ HsCmdTop noExt c in\n      HsCmdArrForm noExt op Infix Nothing [cmdArg c1, cmdArg c2]\n\necHsCase :: forall b. ExpCmdI b =>\n  LHsExpr GhcPs -> MatchGroup GhcPs (Located (b GhcPs)) -> b GhcPs\necHsCase = case expCmdG @b of { ExpG -> HsCase noExt; CmdG -> HsCmdCase noExt }\n\necHsApp :: forall b. ExpCmdI b =>\n  Located (b GhcPs) -> LHsExpr GhcPs -> b GhcPs\necHsApp = case expCmdG @b of { ExpG -> HsApp noExt; CmdG -> HsCmdApp noExt }\n\necHsIf :: forall b. ExpCmdI b =>\n   LHsExpr GhcPs -> Located (b GhcPs) -> Located (b GhcPs) -> b GhcPs\necHsIf = case expCmdG @b of { ExpG -> mkHsIf; CmdG -> mkHsCmdIf }\n\necHsDo :: forall b. ExpCmdI b =>\n  Located [LStmt GhcPs (Located (b GhcPs))] -> b GhcPs\necHsDo = case expCmdG @b of { ExpG -> HsDo noExt DoExpr; CmdG -> HsCmdDo noExt }\n\necHsPar :: forall b. ExpCmdI b => Located (b GhcPs) -> b GhcPs\necHsPar = case expCmdG @b of { ExpG -> HsPar noExt; CmdG -> HsCmdPar noExt }\n\n{- Note [Ambiguous syntactic categories]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThere are places in the grammar where we do not know whether we are parsing an\nexpression or a pattern without unlimited lookahead (which we do not have in\n'happy'):\n\nView patterns:\n\n    f (Con a b     ) = ...  -- 'Con a b' is a pattern\n    f (Con a b -> x) = ...  -- 'Con a b' is an expression\n\ndo-notation:\n\n    do { Con a b <- x } -- 'Con a b' is a pattern\n    do { Con a b }      -- 'Con a b' is an expression\n\nGuards:\n\n    x | True <- p && q = ...  -- 'True' is a pattern\n    x | True           = ...  -- 'True' is an expression\n\nTop-level value/function declarations (FunBind/PatBind):\n\n    f !a         -- TH splice\n    f !a = ...   -- function declaration\n\n    Until we encounter the = sign, we don't know if it's a top-level\n    TemplateHaskell splice where ! is an infix operator, or if it's a function\n    declaration where ! is a strictness annotation.\n\nThere are also places in the grammar where we do not know whether we are\nparsing an expression or a command:\n\n    proc x -> do { (stuff) -< x }   -- 'stuff' is an expression\n    proc x -> do { (stuff) }        -- 'stuff' is a command\n\n    Until we encounter arrow syntax (-<) we don't know whether to parse 'stuff'\n    as an expression or a command.\n\nIn fact, do-notation is subject to both ambiguities:\n\n    proc x -> do { (stuff) -< x }        -- 'stuff' is an expression\n    proc x -> do { (stuff) <- f -< x }   -- 'stuff' is a pattern\n    proc x -> do { (stuff) }             -- 'stuff' is a command\n\nThere are many possible solutions to this problem. For an overview of the ones\nwe decided against, see Note [Resolving parsing ambiguities: non-taken alternatives]\n\nThe solution that keeps basic definitions (such as HsExpr) clean, keeps the\nconcerns local to the parser, and does not require duplication of hsSyn types,\nor an extra pass over the entire AST, is to parse into a function from a GADT\nto a parser-validator:\n\n    data ExpCmdG b where\n      ExpG :: ExpCmdG HsExpr\n      CmdG :: ExpCmdG HsCmd\n\n    type ExpCmd = forall b. ExpCmdG b -> PV (Located (b GhcPs))\n\n    checkExp :: ExpCmd -> PV (LHsExpr GhcPs)\n    checkCmd :: ExpCmd -> PV (LHsCmd GhcPs)\n    checkExp f = f ExpG  -- interpret as an expression\n    checkCmd f = f CmdG  -- interpret as a command\n\nConsider the 'alts' production used to parse case-of alternatives:\n\n  alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }\n    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }\n    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }\n\nWe abstract over LHsExpr, and it becomes:\n\n  alts :: { forall b. ExpCmdG b -> PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }\n    : alts1\n        { \\tag -> $1 tag >>= \\ $1 ->\n                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }\n    | ';' alts\n        { \\tag -> $2 tag >>= \\ $2 ->\n                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }\n\nNote that 'ExpCmdG' is a singleton type, the value is completely\ndetermined by the type:\n\n  when (b~HsExpr),  tag = ExpG\n  when (b~HsCmd),   tag = CmdG\n\nThis is a clear indication that we can use a class to pass this value behind\nthe scenes:\n\n  class    ExpCmdI b      where expCmdG :: ExpCmdG b\n  instance ExpCmdI HsExpr where expCmdG = ExpG\n  instance ExpCmdI HsCmd  where expCmdG = CmdG\n\nAnd now the 'alts' production is simplified, as we no longer need to\nthread 'tag' explicitly:\n\n  alts :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }\n    : alts1     { $1 >>= \\ $1 ->\n                  return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }\n    | ';' alts  { $2 >>= \\ $2 ->\n                  return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }\n\nCompared to the initial definition, the added bits are:\n\n    forall b. ExpCmdI b => PV ( ... ) -- in the type signature\n    $1 >>= \\ $1 -> return $           -- in one reduction rule\n    $2 >>= \\ $2 -> return $           -- in another reduction rule\n\nThe overhead is constant relative to the size of the rest of the reduction\nrule, so this approach scales well to large parser productions.\n\n-}\n\n\n{- Note [Resolving parsing ambiguities: non-taken alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nAlternative I, extra constructors in HsExpr\n-------------------------------------------\nWe could add extra constructors to HsExpr to represent command-specific and\npattern-specific syntactic constructs. Under this scheme, we parse patterns\nand commands as expressions and rejig later.  This is what GHC used to do, and\nit polluted 'HsExpr' with irrelevant constructors:\n\n  * for commands: 'HsArrForm', 'HsArrApp'\n  * for patterns: 'EWildPat', 'EAsPat', 'EViewPat', 'ELazyPat'\n\n(As of now, we still do that for patterns, but we plan to fix it).\n\nThere are several issues with this:\n\n  * The implementation details of parsing are leaking into hsSyn definitions.\n\n  * Code that uses HsExpr has to panic on these impossible-after-parsing cases.\n\n  * HsExpr is arbitrarily selected as the extension basis. Why not extend\n    HsCmd or HsPat with extra constructors instead?\n\n  * We cannot handle corner cases. For instance, the following function\n    declaration LHS is not a valid expression (see Trac #1087):\n\n      !a + !b = ...\n\n  * There are points in the pipeline where the representation was awfully\n    incorrect. For instance,\n\n      f !a b !c = ...\n\n    is first parsed as\n\n      (f ! a b) ! c = ...\n\n\nAlternative II, extra constructors in HsExpr for GhcPs\n------------------------------------------------------\nWe could address some of the problems with Alternative I by using Trees That\nGrow and extending HsExpr only in the GhcPs pass. However, GhcPs corresponds to\nthe output of parsing, not to its intermediate results, so we wouldn't want\nthem there either.\n\nAlternative III, extra constructors in HsExpr for GhcPrePs\n----------------------------------------------------------\nWe could introduce a new pass, GhcPrePs, to keep GhcPs pristine.\nUnfortunately, creating a new pass would significantly bloat conversion code\nand slow down the compiler by adding another linear-time pass over the entire\nAST. For example, in order to build HsExpr GhcPrePs, we would need to build\nHsLocalBinds GhcPrePs (as part of HsLet), and we never want HsLocalBinds\nGhcPrePs.\n\n\nAlternative IV, sum type and bottom-up data flow\n------------------------------------------------\nExpressions and commands are disjoint. There are no user inputs that could be\ninterpreted as either an expression or a command depending on outer context:\n\n  5        -- definitely an expression\n  x -< y   -- definitely a command\n\nEven though we have both 'HsLam' and 'HsCmdLam', we can look at\nthe body to disambiguate:\n\n  \\p -> 5        -- definitely an expression\n  \\p -> x -< y   -- definitely a command\n\nThis means we could use a bottom-up flow of information to determine\nwhether we are parsing an expression or a command, using a sum type\nfor intermediate results:\n\n  Either (LHsExpr GhcPs) (LHsCmd GhcPs)\n\nThere are two problems with this:\n\n  * We cannot handle the ambiguity between expressions and\n    patterns, which are not disjoint.\n\n  * Bottom-up flow of information leads to poor error messages. Consider\n\n        if ... then 5 else (x -< y)\n\n    Do we report that '5' is not a valid command or that (x -< y) is not a\n    valid expression?  It depends on whether we want the entire node to be\n    'HsIf' or 'HsCmdIf', and this information flows top-down, from the\n    surrounding parsing context (are we in 'proc'?)\n\nAlternative V, backtracking with parser combinators\n---------------------------------------------------\nOne might think we could sidestep the issue entirely by using a backtracking\nparser and doing something along the lines of (try pExpr <|> pPat).\n\nTurns out, this wouldn't work very well, as there can be patterns inside\nexpressions (e.g. via 'case', 'let', 'do') and expressions inside patterns\n(e.g. view patterns). To handle this, we would need to backtrack while\nbacktracking, and unbound levels of backtracking lead to very fragile\nperformance.\n\nAlternative VI, an intermediate data type\n-----------------------------------------\nThere are common syntactic elements of expressions, commands, and patterns\n(e.g. all of them must have balanced parentheses), and we can capture this\ncommon structure in an intermediate data type, Frame:\n\ndata Frame\n  = FrameVar RdrName\n    -- ^ Identifier: Just, map, BS.length\n  | FrameTuple [LTupArgFrame] Boxity\n    -- ^ Tuple (section): (a,b) (a,b,c) (a,,) (,a,)\n  | FrameTySig LFrame (LHsSigWcType GhcPs)\n    -- ^ Type signature: x :: ty\n  | FramePar (SrcSpan, SrcSpan) LFrame\n    -- ^ Parentheses\n  | FrameIf LFrame LFrame LFrame\n    -- ^ If-expression: if p then x else y\n  | FrameCase LFrame [LFrameMatch]\n    -- ^ Case-expression: case x of { p1 -> e1; p2 -> e2 }\n  | FrameDo (HsStmtContext Name) [LFrameStmt]\n    -- ^ Do-expression: do { s1; a <- s2; s3 }\n  ...\n  | FrameExpr (HsExpr GhcPs)   -- unambiguously an expression\n  | FramePat (HsPat GhcPs)     -- unambiguously a pattern\n  | FrameCommand (HsCmd GhcPs) -- unambiguously a command\n\nTo determine which constructors 'Frame' needs to have, we take the union of\nintersections between HsExpr, HsCmd, and HsPat.\n\nThe intersection between HsPat and HsExpr:\n\n  HsPat  =  VarPat   | TuplePat      | SigPat        | ParPat   | ...\n  HsExpr =  HsVar    | ExplicitTuple | ExprWithTySig | HsPar    | ...\n  -------------------------------------------------------------------\n  Frame  =  FrameVar | FrameTuple    | FrameTySig    | FramePar | ...\n\nThe intersection between HsCmd and HsExpr:\n\n  HsCmd  = HsCmdIf | HsCmdCase | HsCmdDo | HsCmdPar\n  HsExpr = HsIf    | HsCase    | HsDo    | HsPar\n  ------------------------------------------------\n  Frame = FrameIf  | FrameCase | FrameDo | FramePar\n\nThe intersection between HsCmd and HsPat:\n\n  HsPat  = ParPat   | ...\n  HsCmd  = HsCmdPar | ...\n  -----------------------\n  Frame  = FramePar | ...\n\nTake the union of each intersection and this yields the final 'Frame' data\ntype. The problem with this approach is that we end up duplicating a good\nportion of hsSyn:\n\n    Frame         for  HsExpr, HsPat, HsCmd\n    TupArgFrame   for  HsTupArg\n    FrameMatch    for  Match\n    FrameStmt     for  StmtLR\n    FrameGRHS     for  GRHS\n    FrameGRHSs    for  GRHSs\n    ...\n\nAlternative VII, a product type\n-------------------------------\nWe could avoid the intermediate representation of Alternative VI by parsing\ninto a product of interpretations directly:\n\n    -- See Note [Parser-Validator]\n    type ExpCmdPat = ( PV (LHsExpr GhcPs)\n                     , PV (LHsCmd GhcPs)\n                     , PV (LHsPat GhcPs) )\n\nThis means that in positions where we do not know whether to produce\nexpression, a pattern, or a command, we instead produce a parser-validator for\neach possible option.\n\nThen, as soon as we have parsed far enough to resolve the ambiguity, we pick\nthe appropriate component of the product, discarding the rest:\n\n    checkExpOf3 (e, _, _) = e  -- interpret as an expression\n    checkCmdOf3 (_, c, _) = c  -- interpret as a command\n    checkPatOf3 (_, _, p) = p  -- interpret as a pattern\n\nWe can easily define ambiguities between arbitrary subsets of interpretations.\nFor example, when we know ahead of type that only an expression or a command is\npossible, but not a pattern, we can use a smaller type:\n\n    -- See Note [Parser-Validator]\n    type ExpCmd = (PV (LHsExpr GhcPs), PV (LHsCmd GhcPs))\n\n    checkExpOf2 (e, _) = e  -- interpret as an expression\n    checkCmdOf2 (_, c) = c  -- interpret as a command\n\nHowever, there is a slight problem with this approach, namely code duplication\nin parser productions. Consider the 'alts' production used to parse case-of\nalternatives:\n\n  alts :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }\n    : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }\n    | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }\n\nUnder the new scheme, we have to completely duplicate its type signature and\neach reduction rule:\n\n  alts :: { ( PV (Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)])) -- as an expression\n            , PV (Located ([AddAnn],[LMatch GhcPs (LHsCmd GhcPs)]))  -- as a command\n            ) }\n    : alts1\n        { ( checkExpOf2 $1 >>= \\ $1 ->\n            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)\n          , checkCmdOf2 $1 >>= \\ $1 ->\n            return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1)\n          ) }\n    | ';' alts\n        { ( checkExpOf2 $2 >>= \\ $2 ->\n            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)\n          , checkCmdOf2 $2 >>= \\ $2 ->\n            return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2)\n          ) }\n\nAnd the same goes for other productions: 'altslist', 'alts1', 'alt', 'alt_rhs',\n'ralt', 'gdpats', 'gdpat', 'exp', ... and so on. That is a lot of code!\n\n-}\n\n---------------------------------------------------------------------------\n-- Miscellaneous utilities\n\n-- | Check if a fixity is valid. We support bypassing the usual bound checks\n-- for some special operators.\ncheckPrecP\n        :: Located (SourceText,Int)             -- ^ precedence\n        -> Located (OrdList (Located RdrName))  -- ^ operators\n        -> P ()\ncheckPrecP (dL->L l (_,i)) (dL->L _ ol)\n | 0 <= i, i <= maxPrecedence = pure ()\n | all specialOp ol = pure ()\n | otherwise = addFatalError l (text (\"Precedence out of range: \" ++ show i))\n  where\n    specialOp op = unLoc op `elem` [ eqTyCon_RDR\n                                   , getRdrName funTyCon ]\n\nmkRecConstrOrUpdate\n        :: LHsExpr GhcPs\n        -> SrcSpan\n        -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)\n        -> P (HsExpr GhcPs)\n\nmkRecConstrOrUpdate (dL->L l (HsVar _ (dL->L _ c))) _ (fs,dd)\n  | isRdrDataCon c\n  = return (mkRdrRecordCon (cL l c) (mk_rec_fields fs dd))\nmkRecConstrOrUpdate exp _ (fs,dd)\n  | Just dd_loc <- dd = addFatalError dd_loc (text \"You cannot use `..' in a record update\")\n  | otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))\n\nmkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs\nmkRdrRecordUpd exp flds\n  = RecordUpd { rupd_ext  = noExt\n              , rupd_expr = exp\n              , rupd_flds = flds }\n\nmkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs\nmkRdrRecordCon con flds\n  = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }\n\nmk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg\nmk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }\nmk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs\n                                     , rec_dotdot = Just (cL s (length fs)) }\n\nmk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs\nmk_rec_upd_field (HsRecField (dL->L loc (FieldOcc _ rdr)) arg pun)\n  = HsRecField (L loc (Unambiguous noExt rdr)) arg pun\nmk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc _)) _ _)\n  = panic \"mk_rec_upd_field\"\nmk_rec_upd_field (HsRecField _ _ _)\n  = panic \"mk_rec_upd_field: Impossible Match\" -- due to #15884\n\nmkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation\n               -> InlinePragma\n-- The (Maybe Activation) is because the user can omit\n-- the activation spec (and usually does)\nmkInlinePragma src (inl, match_info) mb_act\n  = InlinePragma { inl_src = src -- Note [Pragma source text] in BasicTypes\n                 , inl_inline = inl\n                 , inl_sat    = Nothing\n                 , inl_act    = act\n                 , inl_rule   = match_info }\n  where\n    act = case mb_act of\n            Just act -> act\n            Nothing  -> -- No phase specified\n                        case inl of\n                          NoInline -> NeverActive\n                          _other   -> AlwaysActive\n\n-----------------------------------------------------------------------------\n-- utilities for foreign declarations\n\n-- construct a foreign import declaration\n--\nmkImport :: Located CCallConv\n         -> Located Safety\n         -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)\n         -> P (HsDecl GhcPs)\nmkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =\n    case unLoc cconv of\n      CCallConv          -> mkCImport\n      CApiConv           -> mkCImport\n      StdCallConv        -> mkCImport\n      PrimCallConv       -> mkOtherImport\n      JavaScriptCallConv -> mkOtherImport\n  where\n    -- Parse a C-like entity string of the following form:\n    --   \"[static] [chname] [&] [cid]\" | \"dynamic\" | \"wrapper\"\n    -- If 'cid' is missing, the function name 'v' is used instead as symbol\n    -- name (cf section 8.5.1 in Haskell 2010 report).\n    mkCImport = do\n      let e = unpackFS entity\n      case parseCImport cconv safety (mkExtName (unLoc v)) e (cL loc esrc) of\n        Nothing         -> addFatalError loc (text \"Malformed entity string\")\n        Just importSpec -> returnSpec importSpec\n\n    -- currently, all the other import conventions only support a symbol name in\n    -- the entity string. If it is missing, we use the function name instead.\n    mkOtherImport = returnSpec importSpec\n      where\n        entity'    = if nullFS entity\n                        then mkExtName (unLoc v)\n                        else entity\n        funcTarget = CFunction (StaticTarget esrc entity' Nothing True)\n        importSpec = CImport cconv safety Nothing funcTarget (cL loc esrc)\n\n    returnSpec spec = return $ ForD noExt $ ForeignImport\n          { fd_i_ext  = noExt\n          , fd_name   = v\n          , fd_sig_ty = ty\n          , fd_fi     = spec\n          }\n\n\n\n-- the string \"foo\" is ambiguous: either a header or a C identifier.  The\n-- C identifier case comes first in the alternatives below, so we pick\n-- that one.\nparseCImport :: Located CCallConv -> Located Safety -> FastString -> String\n             -> Located SourceText\n             -> Maybe ForeignImport\nparseCImport cconv safety nm str sourceText =\n listToMaybe $ map fst $ filter (null.snd) $\n     readP_to_S parse str\n where\n   parse = do\n       skipSpaces\n       r <- choice [\n          string \"dynamic\" >> return (mk Nothing (CFunction DynamicTarget)),\n          string \"wrapper\" >> return (mk Nothing CWrapper),\n          do optional (token \"static\" >> skipSpaces)\n             ((mk Nothing <$> cimp nm) +++\n              (do h <- munch1 hdr_char\n                  skipSpaces\n                  mk (Just (Header (SourceText h) (mkFastString h)))\n                      <$> cimp nm))\n         ]\n       skipSpaces\n       return r\n\n   token str = do _ <- string str\n                  toks <- look\n                  case toks of\n                      c : _\n                       | id_char c -> pfail\n                      _            -> return ()\n\n   mk h n = CImport cconv safety h n sourceText\n\n   hdr_char c = not (isSpace c)\n   -- header files are filenames, which can contain\n   -- pretty much any char (depending on the platform),\n   -- so just accept any non-space character\n   id_first_char c = isAlpha    c || c == '_'\n   id_char       c = isAlphaNum c || c == '_'\n\n   cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)\n             +++ (do isFun <- case unLoc cconv of\n                               CApiConv ->\n                                  option True\n                                         (do token \"value\"\n                                             skipSpaces\n                                             return False)\n                               _ -> return True\n                     cid' <- cid\n                     return (CFunction (StaticTarget NoSourceText cid'\n                                        Nothing isFun)))\n          where\n            cid = return nm +++\n                  (do c  <- satisfy id_first_char\n                      cs <-  many (satisfy id_char)\n                      return (mkFastString (c:cs)))\n\n\n-- construct a foreign export declaration\n--\nmkExport :: Located CCallConv\n         -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)\n         -> P (HsDecl GhcPs)\nmkExport (dL->L lc cconv) (dL->L le (StringLiteral esrc entity), v, ty)\n = return $ ForD noExt $\n   ForeignExport { fd_e_ext = noExt, fd_name = v, fd_sig_ty = ty\n                 , fd_fe = CExport (cL lc (CExportStatic esrc entity' cconv))\n                                   (cL le esrc) }\n  where\n    entity' | nullFS entity = mkExtName (unLoc v)\n            | otherwise     = entity\n\n-- Supplying the ext_name in a foreign decl is optional; if it\n-- isn't there, the Haskell name is assumed. Note that no transformation\n-- of the Haskell name is then performed, so if you foreign export (++),\n-- it's external name will be \"++\". Too bad; it's important because we don't\n-- want z-encoding (e.g. names with z's in them shouldn't be doubled)\n--\nmkExtName :: RdrName -> CLabelString\nmkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))\n\n--------------------------------------------------------------------------------\n-- Help with module system imports/exports\n\ndata ImpExpSubSpec = ImpExpAbs\n                   | ImpExpAll\n                   | ImpExpList [Located ImpExpQcSpec]\n                   | ImpExpAllWith [Located ImpExpQcSpec]\n\ndata ImpExpQcSpec = ImpExpQcName (Located RdrName)\n                  | ImpExpQcType (Located RdrName)\n                  | ImpExpQcWildcard\n\nmkModuleImpExp :: Located ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)\nmkModuleImpExp (dL->L l specname) subs =\n  case subs of\n    ImpExpAbs\n      | isVarNameSpace (rdrNameSpace name)\n                       -> return $ IEVar noExt (cL l (ieNameFromSpec specname))\n      | otherwise      -> IEThingAbs noExt . cL l <$> nameT\n    ImpExpAll          -> IEThingAll noExt . cL l <$> nameT\n    ImpExpList xs      ->\n      (\\newName -> IEThingWith noExt (cL l newName)\n        NoIEWildcard (wrapped xs) []) <$> nameT\n    ImpExpAllWith xs                       ->\n      do allowed <- getBit PatternSynonymsBit\n         if allowed\n          then\n            let withs = map unLoc xs\n                pos   = maybe NoIEWildcard IEWildcard\n                          (findIndex isImpExpQcWildcard withs)\n                ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs\n            in (\\newName\n                        -> IEThingWith noExt (cL l newName) pos ies [])\n               <$> nameT\n          else addFatalError l\n            (text \"Illegal export form (use PatternSynonyms to enable)\")\n  where\n    name = ieNameVal specname\n    nameT =\n      if isVarNameSpace (rdrNameSpace name)\n        then addFatalError l\n              (text \"Expecting a type constructor but found a variable,\"\n               <+> quotes (ppr name) <> text \".\"\n              $$ if isSymOcc $ rdrNameOcc name\n                   then text \"If\" <+> quotes (ppr name)\n                        <+> text \"is a type constructor\"\n           <+> text \"then enable ExplicitNamespaces and use the 'type' keyword.\"\n                   else empty)\n        else return $ ieNameFromSpec specname\n\n    ieNameVal (ImpExpQcName ln)  = unLoc ln\n    ieNameVal (ImpExpQcType ln)  = unLoc ln\n    ieNameVal (ImpExpQcWildcard) = panic \"ieNameVal got wildcard\"\n\n    ieNameFromSpec (ImpExpQcName ln)  = IEName ln\n    ieNameFromSpec (ImpExpQcType ln)  = IEType ln\n    ieNameFromSpec (ImpExpQcWildcard) = panic \"ieName got wildcard\"\n\n    wrapped = map (onHasSrcSpan ieNameFromSpec)\n\nmkTypeImpExp :: Located RdrName   -- TcCls or Var name space\n             -> P (Located RdrName)\nmkTypeImpExp name =\n  do allowed <- getBit ExplicitNamespacesBit\n     unless allowed $ addError (getLoc name) $\n       text \"Illegal keyword 'type' (use ExplicitNamespaces to enable)\"\n     return (fmap (`setRdrNameSpace` tcClsName) name)\n\ncheckImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs])\ncheckImportSpec ie@(dL->L _ specs) =\n    case [l | (dL->L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of\n      [] -> return ie\n      (l:_) -> importSpecError l\n  where\n    importSpecError l =\n      addFatalError l\n        (text \"Illegal import form, this syntax can only be used to bundle\"\n        $+$ text \"pattern synonyms with types in module exports.\")\n\n-- In the correct order\nmkImpExpSubSpec :: [Located ImpExpQcSpec] -> P ([AddAnn], ImpExpSubSpec)\nmkImpExpSubSpec [] = return ([], ImpExpList [])\nmkImpExpSubSpec [dL->L _ ImpExpQcWildcard] =\n  return ([], ImpExpAll)\nmkImpExpSubSpec xs =\n  if (any (isImpExpQcWildcard . unLoc) xs)\n    then return $ ([], ImpExpAllWith xs)\n    else return $ ([], ImpExpList xs)\n\nisImpExpQcWildcard :: ImpExpQcSpec -> Bool\nisImpExpQcWildcard ImpExpQcWildcard = True\nisImpExpQcWildcard _                = False\n\n-----------------------------------------------------------------------------\n-- Warnings and failures\n\nwarnStarIsType :: SrcSpan -> P ()\nwarnStarIsType span = addWarning Opt_WarnStarIsType span msg\n  where\n    msg =  text \"Using\" <+> quotes (text \"*\")\n           <+> text \"(or its Unicode variant) to mean\"\n           <+> quotes (text \"Data.Kind.Type\")\n        $$ text \"relies on the StarIsType extension, which will become\"\n        $$ text \"deprecated in the future.\"\n        $$ text \"Suggested fix: use\" <+> quotes (text \"Type\")\n           <+> text \"from\" <+> quotes (text \"Data.Kind\") <+> text \"instead.\"\n\nwarnStarBndr :: SrcSpan -> P ()\nwarnStarBndr span = addWarning Opt_WarnStarBinder span msg\n  where\n    msg =  text \"Found binding occurrence of\" <+> quotes (text \"*\")\n           <+> text \"yet StarIsType is enabled.\"\n        $$ text \"NB. To use (or export) this operator in\"\n           <+> text \"modules with StarIsType,\"\n        $$ text \"    including the definition module, you must qualify it.\"\n\nfailOpFewArgs :: Located RdrName -> P a\nfailOpFewArgs (dL->L loc op) =\n  do { star_is_type <- getBit StarIsTypeBit\n     ; let msg = too_few $$ starInfo star_is_type op\n     ; addFatalError loc msg }\n  where\n    too_few = text \"Operator applied to too few arguments:\" <+> ppr op\n\nfailOpDocPrev :: SrcSpan -> P a\nfailOpDocPrev loc = addFatalError loc msg\n  where\n    msg = text \"Unexpected documentation comment.\"\n\nfailOpStrictnessCompound :: Located SrcStrictness -> LHsType GhcPs -> P a\nfailOpStrictnessCompound (dL->L _ str) (dL->L loc ty) = addFatalError loc msg\n  where\n    msg = text \"Strictness annotation applied to a compound type.\" $$\n          text \"Did you mean to add parentheses?\" $$\n          nest 2 (ppr str <> parens (ppr ty))\n\nfailOpStrictnessPosition :: Located SrcStrictness -> P a\nfailOpStrictnessPosition (dL->L loc _) = addFatalError loc msg\n  where\n    msg = text \"Strictness annotation cannot appear in this position.\"\n\n-----------------------------------------------------------------------------\n-- Misc utils\n\ntype PV = P -- See Note [Parser-Validator]\n\n{- Note [Parser-Validator]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen resolving ambiguities, we need to postpone failure to make a choice later.\nFor example, if we have ambiguity between some A and B, our parser could be\n\n  abParser :: P (Maybe A, Maybe B)\n\nThis way we can represent four possible outcomes of parsing:\n\n    (Just a, Nothing)       -- definitely A\n    (Nothing, Just b)       -- definitely B\n    (Just a, Just b)        -- either A or B\n    (Nothing, Nothing)      -- neither A nor B\n\nHowever, if we want to report informative parse errors, accumulate warnings,\nand add API annotations, we are better off using 'P' instead of 'Maybe':\n\n  abParser :: P (P A, P B)\n\nSo we have an outer layer of P that consumes the input and builds the inner\nlayer, which validates the input.\n\nFor clarity, we introduce the notion of a parser-validator: a parser that does\nnot consume any input, but may fail or use other effects. Thus we have:\n\n  abParser :: P (PV A, PV B)\n\n-}\n\n-- | Hint about bang patterns, assuming @BangPatterns@ is off.\nhintBangPat :: SrcSpan -> HsExpr GhcPs -> P ()\nhintBangPat span e = do\n    bang_on <- getBit BangPatBit\n    unless bang_on $\n      addFatalError span\n        (text \"Illegal bang-pattern (use BangPatterns):\" $$ ppr e)\n\ndata SumOrTuple\n  = Sum ConTag Arity (LHsExpr GhcPs)\n  | Tuple [LHsTupArg GhcPs]\n\nmkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs)\n\n-- Tuple\nmkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple noExt es boxity)\n\n-- Sum\nmkSumOrTuple Unboxed _ (Sum alt arity e) =\n    return (ExplicitSum noExt alt arity e)\nmkSumOrTuple Boxed l (Sum alt arity (dL->L _ e)) =\n    addFatalError l (hang (text \"Boxed sums not supported:\") 2\n                      (ppr_boxed_sum alt arity e))\n  where\n    ppr_boxed_sum :: ConTag -> Arity -> HsExpr GhcPs -> SDoc\n    ppr_boxed_sum alt arity e =\n      text \"(\" <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt)\n      <+> text \")\"\n\n    ppr_bars n = hsep (replicate n (Outputable.char '|'))\n\nmkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs\nmkLHsOpTy x op y =\n  let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y\n  in cL loc (mkHsOpTy x op y)\n\nmkLHsDocTy :: LHsType GhcPs -> LHsDocString -> LHsType GhcPs\nmkLHsDocTy t doc =\n  let loc = getLoc t `combineSrcSpans` getLoc doc\n  in cL loc (HsDocTy noExt t doc)\n\nmkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs\nmkLHsDocTyMaybe t = maybe t (mkLHsDocTy t)\n\n-----------------------------------------------------------------------------\n-- Token symbols\n\nstarSym :: Bool -> String\nstarSym True = \"\u00e2\u02dc\u2026\"\nstarSym False = \"*\"\n\nforallSym :: Bool -> String\nforallSym True = \"\u00e2\u02c6\u20ac\"\nforallSym False = \"forall\"\n", "num_lines": 2765}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[Foreign]{Foreign calls}\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule ForeignCall (\n        ForeignCall(..), isSafeForeignCall,\n        Safety(..), playSafe, playInterruptible,\n\n        CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,\n        CCallSpec(..),\n        CCallTarget(..), isDynamicTarget,\n        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,\n\n        Header(..), CType(..),\n    ) where\n\nimport GhcPrelude\n\nimport FastString\nimport Binary\nimport Outputable\nimport Module\nimport BasicTypes ( SourceText, pprWithSourceText )\n\nimport Data.Char\nimport Data.Data\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Data types}\n*                                                                      *\n************************************************************************\n-}\n\nnewtype ForeignCall = CCall CCallSpec\n  deriving Eq\n\nisSafeForeignCall :: ForeignCall -> Bool\nisSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe\n\n-- We may need more clues to distinguish foreign calls\n-- but this simple printer will do for now\ninstance Outputable ForeignCall where\n  ppr (CCall cc)  = ppr cc\n\ndata Safety\n  = PlaySafe            -- Might invoke Haskell GC, or do a call back, or\n                        -- switch threads, etc.  So make sure things are\n                        -- tidy before the call. Additionally, in the threaded\n                        -- RTS we arrange for the external call to be executed\n                        -- by a separate OS thread, i.e., _concurrently_ to the\n                        -- execution of other Haskell threads.\n\n  | PlayInterruptible   -- Like PlaySafe, but additionally\n                        -- the worker thread running this foreign call may\n                        -- be unceremoniously killed, so it must be scheduled\n                        -- on an unbound thread.\n\n  | PlayRisky           -- None of the above can happen; the call will return\n                        -- without interacting with the runtime system at all\n  deriving ( Eq, Show, Data )\n        -- Show used just for Show Lex.Token, I think\n\ninstance Outputable Safety where\n  ppr PlaySafe = text \"safe\"\n  ppr PlayInterruptible = text \"interruptible\"\n  ppr PlayRisky = text \"unsafe\"\n\nplaySafe :: Safety -> Bool\nplaySafe PlaySafe = True\nplaySafe PlayInterruptible = True\nplaySafe PlayRisky = False\n\nplayInterruptible :: Safety -> Bool\nplayInterruptible PlayInterruptible = True\nplayInterruptible _ = False\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Calling C}\n*                                                                      *\n************************************************************************\n-}\n\ndata CExportSpec\n  = CExportStatic               -- foreign export ccall foo :: ty\n        SourceText              -- of the CLabelString.\n                                -- See note [Pragma source text] in BasicTypes\n        CLabelString            -- C Name of exported function\n        CCallConv\n  deriving Data\n\ndata CCallSpec\n  =  CCallSpec  CCallTarget     -- What to call\n                CCallConv       -- Calling convention to use.\n                Safety\n  deriving( Eq )\n\n-- The call target:\n\n-- | How to call a particular function in C-land.\ndata CCallTarget\n  -- An \"unboxed\" ccall# to named function in a particular package.\n  = StaticTarget\n        SourceText                -- of the CLabelString.\n                                  -- See note [Pragma source text] in BasicTypes\n        CLabelString                    -- C-land name of label.\n\n        (Maybe UnitId)              -- What package the function is in.\n                                        -- If Nothing, then it's taken to be in the current package.\n                                        -- Note: This information is only used for PrimCalls on Windows.\n                                        --       See CLabel.labelDynamic and CoreToStg.coreToStgApp\n                                        --       for the difference in representation between PrimCalls\n                                        --       and ForeignCalls. If the CCallTarget is representing\n                                        --       a regular ForeignCall then it's safe to set this to Nothing.\n\n  -- The first argument of the import is the name of a function pointer (an Addr#).\n  --    Used when importing a label as \"foreign import ccall \"dynamic\" ...\"\n        Bool                            -- True => really a function\n                                        -- False => a value; only\n                                        -- allowed in CAPI imports\n  | DynamicTarget\n\n  deriving( Eq, Data )\n\nisDynamicTarget :: CCallTarget -> Bool\nisDynamicTarget DynamicTarget = True\nisDynamicTarget _             = False\n\n{-\nStuff to do with calling convention:\n\nccall:          Caller allocates parameters, *and* deallocates them.\n\nstdcall:        Caller allocates parameters, callee deallocates.\n                Function name has @N after it, where N is number of arg bytes\n                e.g.  _Foo@8. This convention is x86 (win32) specific.\n\nSee: http://www.programmersheaven.com/2/Calling-conventions\n-}\n\n-- any changes here should be replicated in  the CallConv type in template haskell\ndata CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv\n  deriving (Eq, Data)\n\ninstance Outputable CCallConv where\n  ppr StdCallConv = text \"stdcall\"\n  ppr CCallConv   = text \"ccall\"\n  ppr CApiConv    = text \"capi\"\n  ppr PrimCallConv = text \"prim\"\n  ppr JavaScriptCallConv = text \"javascript\"\n\ndefaultCCallConv :: CCallConv\ndefaultCCallConv = CCallConv\n\nccallConvToInt :: CCallConv -> Int\nccallConvToInt StdCallConv = 0\nccallConvToInt CCallConv   = 1\nccallConvToInt CApiConv    = panic \"ccallConvToInt CApiConv\"\nccallConvToInt (PrimCallConv {}) = panic \"ccallConvToInt PrimCallConv\"\nccallConvToInt JavaScriptCallConv = panic \"ccallConvToInt JavaScriptCallConv\"\n\n{-\nGenerate the gcc attribute corresponding to the given\ncalling convention (used by PprAbsC):\n-}\n\nccallConvAttribute :: CCallConv -> SDoc\nccallConvAttribute StdCallConv       = text \"__attribute__((__stdcall__))\"\nccallConvAttribute CCallConv         = empty\nccallConvAttribute CApiConv          = empty\nccallConvAttribute (PrimCallConv {}) = panic \"ccallConvAttribute PrimCallConv\"\nccallConvAttribute JavaScriptCallConv = panic \"ccallConvAttribute JavaScriptCallConv\"\n\ntype CLabelString = FastString          -- A C label, completely unencoded\n\npprCLabelString :: CLabelString -> SDoc\npprCLabelString lbl = ftext lbl\n\nisCLabelString :: CLabelString -> Bool  -- Checks to see if this is a valid C label\nisCLabelString lbl\n  = all ok (unpackFS lbl)\n  where\n    ok c = isAlphaNum c || c == '_' || c == '.'\n        -- The '.' appears in e.g. \"foo.so\" in the\n        -- module part of a ExtName.  Maybe it should be separate\n\n-- Printing into C files:\n\ninstance Outputable CExportSpec where\n  ppr (CExportStatic _ str _) = pprCLabelString str\n\ninstance Outputable CCallSpec where\n  ppr (CCallSpec fun cconv safety)\n    = hcat [ whenPprDebug callconv, ppr_fun fun ]\n    where\n      callconv = text \"{-\" <> ppr cconv <> text \"-}\"\n\n      gc_suf | playSafe safety = text \"_GC\"\n             | otherwise       = empty\n\n      ppr_fun (StaticTarget st _fn mPkgId isFun)\n        = text (if isFun then \"__pkg_ccall\"\n                         else \"__pkg_ccall_value\")\n       <> gc_suf\n       <+> (case mPkgId of\n            Nothing -> empty\n            Just pkgId -> ppr pkgId)\n       <+> (pprWithSourceText st empty)\n\n      ppr_fun DynamicTarget\n        = text \"__dyn_ccall\" <> gc_suf <+> text \"\\\"\\\"\"\n\n-- The filename for a C header file\n-- Note [Pragma source text] in BasicTypes\ndata Header = Header SourceText FastString\n    deriving (Eq, Data)\n\ninstance Outputable Header where\n    ppr (Header st h) = pprWithSourceText st (doubleQuotes $ ppr h)\n\n-- | A C type, used in CAPI FFI calls\n--\n--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\\# CTYPE'@,\n--        'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal',\n--        'ApiAnnotation.AnnClose' @'\\#-}'@,\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ndata CType = CType SourceText -- Note [Pragma source text] in BasicTypes\n                   (Maybe Header) -- header to include for this type\n                   (SourceText,FastString) -- the type itself\n    deriving (Eq, Data)\n\ninstance Outputable CType where\n    ppr (CType stp mh (stct,ct))\n      = pprWithSourceText stp (text \"{-# CTYPE\") <+> hDoc\n        <+> pprWithSourceText stct (doubleQuotes (ftext ct)) <+> text \"#-}\"\n        where hDoc = case mh of\n                     Nothing -> empty\n                     Just h -> ppr h\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Misc}\n*                                                                      *\n************************************************************************\n-}\n\ninstance Binary ForeignCall where\n    put_ bh (CCall aa) = put_ bh aa\n    get bh = do aa <- get bh; return (CCall aa)\n\ninstance Binary Safety where\n    put_ bh PlaySafe = do\n            putByte bh 0\n    put_ bh PlayInterruptible = do\n            putByte bh 1\n    put_ bh PlayRisky = do\n            putByte bh 2\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return PlaySafe\n              1 -> do return PlayInterruptible\n              _ -> do return PlayRisky\n\ninstance Binary CExportSpec where\n    put_ bh (CExportStatic ss aa ab) = do\n            put_ bh ss\n            put_ bh aa\n            put_ bh ab\n    get bh = do\n          ss <- get bh\n          aa <- get bh\n          ab <- get bh\n          return (CExportStatic ss aa ab)\n\ninstance Binary CCallSpec where\n    put_ bh (CCallSpec aa ab ac) = do\n            put_ bh aa\n            put_ bh ab\n            put_ bh ac\n    get bh = do\n          aa <- get bh\n          ab <- get bh\n          ac <- get bh\n          return (CCallSpec aa ab ac)\n\ninstance Binary CCallTarget where\n    put_ bh (StaticTarget ss aa ab ac) = do\n            putByte bh 0\n            put_ bh ss\n            put_ bh aa\n            put_ bh ab\n            put_ bh ac\n    put_ bh DynamicTarget = do\n            putByte bh 1\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do ss <- get bh\n                      aa <- get bh\n                      ab <- get bh\n                      ac <- get bh\n                      return (StaticTarget ss aa ab ac)\n              _ -> do return DynamicTarget\n\ninstance Binary CCallConv where\n    put_ bh CCallConv = do\n            putByte bh 0\n    put_ bh StdCallConv = do\n            putByte bh 1\n    put_ bh PrimCallConv = do\n            putByte bh 2\n    put_ bh CApiConv = do\n            putByte bh 3\n    put_ bh JavaScriptCallConv = do\n            putByte bh 4\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return CCallConv\n              1 -> do return StdCallConv\n              2 -> do return PrimCallConv\n              3 -> do return CApiConv\n              _ -> do return JavaScriptCallConv\n\ninstance Binary CType where\n    put_ bh (CType s mh fs) = do put_ bh s\n                                 put_ bh mh\n                                 put_ bh fs\n    get bh = do s  <- get bh\n                mh <- get bh\n                fs <- get bh\n                return (CType s mh fs)\n\ninstance Binary Header where\n    put_ bh (Header s h) = put_ bh s >> put_ bh h\n    get bh = do s <- get bh\n                h <- get bh\n                return (Header s h)\n", "num_lines": 349}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- | This is where we define a mapping from Uniques to their associated\n-- known-key Names for things associated with tuples and sums. We use this\n-- mapping while deserializing known-key Names in interface file symbol tables,\n-- which are encoded as their Unique. See Note [Symbol table representation of\n-- names] for details.\n--\n\nmodule KnownUniques\n    ( -- * Looking up known-key names\n      knownUniqueName\n\n      -- * Getting the 'Unique's of 'Name's\n      -- ** Anonymous sums\n    , mkSumTyConUnique\n    , mkSumDataConUnique\n      -- ** Tuples\n      -- *** Vanilla\n    , mkTupleTyConUnique\n    , mkTupleDataConUnique\n      -- *** Constraint\n    , mkCTupleTyConUnique\n    , mkCTupleDataConUnique\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TysWiredIn\nimport TyCon\nimport DataCon\nimport Id\nimport BasicTypes\nimport Outputable\nimport Unique\nimport Name\nimport Util\n\nimport Data.Bits\nimport Data.Maybe\n\n-- | Get the 'Name' associated with a known-key 'Unique'.\nknownUniqueName :: Unique -> Maybe Name\nknownUniqueName u =\n    case tag of\n      'z' -> Just $ getUnboxedSumName n\n      '4' -> Just $ getTupleTyConName Boxed n\n      '5' -> Just $ getTupleTyConName Unboxed n\n      '7' -> Just $ getTupleDataConName Boxed n\n      '8' -> Just $ getTupleDataConName Unboxed n\n      'k' -> Just $ getCTupleTyConName n\n      'm' -> Just $ getCTupleDataConUnique n\n      _   -> Nothing\n  where\n    (tag, n) = unpkUnique u\n\n--------------------------------------------------\n-- Anonymous sums\n--\n-- Sum arities start from 2. The encoding is a bit funny: we break up the\n-- integral part into bitfields for the arity, an alternative index (which is\n-- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a\n-- tag (used to identify the sum's TypeRep binding).\n--\n-- This layout is chosen to remain compatible with the usual unique allocation\n-- for wired-in data constructors described in Unique.hs\n--\n-- TyCon for sum of arity k:\n--   00000000 kkkkkkkk 11111100\n\n-- TypeRep of TyCon for sum of arity k:\n--   00000000 kkkkkkkk 11111101\n--\n-- DataCon for sum of arity k and alternative n (zero-based):\n--   00000000 kkkkkkkk nnnnnn00\n--\n-- TypeRep for sum DataCon of arity k and alternative n (zero-based):\n--   00000000 kkkkkkkk nnnnnn10\n\nmkSumTyConUnique :: Arity -> Unique\nmkSumTyConUnique arity =\n    ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the\n                         -- alternative\n    mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)\n\nmkSumDataConUnique :: ConTagZ -> Arity -> Unique\nmkSumDataConUnique alt arity\n  | alt >= arity\n  = panic (\"mkSumDataConUnique: \" ++ show alt ++ \" >= \" ++ show arity)\n  | otherwise\n  = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}\n\ngetUnboxedSumName :: Int -> Name\ngetUnboxedSumName n\n  | n .&. 0xfc == 0xfc\n  = case tag of\n      0x0 -> tyConName $ sumTyCon arity\n      0x1 -> getRep $ sumTyCon arity\n      _   -> pprPanic \"getUnboxedSumName: invalid tag\" (ppr tag)\n  | tag == 0x0\n  = dataConName $ sumDataCon (alt + 1) arity\n  | tag == 0x1\n  = getName $ dataConWrapId $ sumDataCon (alt + 1) arity\n  | tag == 0x2\n  = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity\n  | otherwise\n  = pprPanic \"getUnboxedSumName\" (ppr n)\n  where\n    arity = n `shiftR` 8\n    alt = (n .&. 0xfc) `shiftR` 2\n    tag = 0x3 .&. n\n    getRep tycon =\n        fromMaybe (pprPanic \"getUnboxedSumName(getRep)\" (ppr tycon))\n        $ tyConRepName_maybe tycon\n\n-- Note [Uniques for tuple type and data constructors]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Wired-in type constructor keys occupy *two* slots:\n--    * u: the TyCon itself\n--    * u+1: the TyConRepName of the TyCon\n--\n-- Wired-in tuple data constructor keys occupy *three* slots:\n--    * u: the DataCon itself\n--    * u+1: its worker Id\n--    * u+2: the TyConRepName of the promoted TyCon\n\n--------------------------------------------------\n-- Constraint tuples\n\nmkCTupleTyConUnique :: Arity -> Unique\nmkCTupleTyConUnique a = mkUnique 'k' (2*a)\n\nmkCTupleDataConUnique :: Arity -> Unique\nmkCTupleDataConUnique a = mkUnique 'm' (3*a)\n\ngetCTupleTyConName :: Int -> Name\ngetCTupleTyConName n =\n    case n `divMod` 2 of\n      (arity, 0) -> cTupleTyConName arity\n      (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity\n      _          -> panic \"getCTupleTyConName: impossible\"\n\ngetCTupleDataConUnique :: Int -> Name\ngetCTupleDataConUnique n =\n    case n `divMod` 3 of\n      (arity,  0) -> cTupleDataConName arity\n      (_arity, 1) -> panic \"getCTupleDataConName: no worker\"\n      (arity,  2) -> mkPrelTyConRepName $ cTupleDataConName arity\n      _           -> panic \"getCTupleDataConName: impossible\"\n\n--------------------------------------------------\n-- Normal tuples\n\nmkTupleDataConUnique :: Boxity -> Arity -> Unique\nmkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- may be used in C labels\nmkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)\n\nmkTupleTyConUnique :: Boxity -> Arity -> Unique\nmkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)\nmkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)\n\ngetTupleTyConName :: Boxity -> Int -> Name\ngetTupleTyConName boxity n =\n    case n `divMod` 2 of\n      (arity, 0) -> tyConName $ tupleTyCon boxity arity\n      (arity, 1) -> fromMaybe (panic \"getTupleTyConName\")\n                    $ tyConRepName_maybe $ tupleTyCon boxity arity\n      _          -> panic \"getTupleTyConName: impossible\"\n\ngetTupleDataConName :: Boxity -> Int -> Name\ngetTupleDataConName boxity n =\n    case n `divMod` 3 of\n      (arity, 0) -> dataConName $ tupleDataCon boxity arity\n      (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity\n      (arity, 2) -> fromMaybe (panic \"getTupleDataCon\")\n                    $ tyConRepName_maybe $ promotedTupleDataCon boxity arity\n      _          -> panic \"getTupleDataConName: impossible\"\n", "num_lines": 181}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- | The @PrelInfo@ interface to the compiler's prelude knowledge.\n--\n-- This module serves as the central gathering point for names which the\n-- compiler knows something about. This includes functions for,\n--\n--  * discerning whether a 'Name' is known-key\n--\n--  * given a 'Unique', looking up its corresponding known-key 'Name'\n--\n-- See Note [Known-key names] and Note [About wired-in things] for information\n-- about the two types of prelude things in GHC.\n--\nmodule PrelInfo (\n        -- * Known-key names\n        isKnownKeyName,\n        lookupKnownKeyName,\n        lookupKnownNameInfo,\n\n        -- ** Internal use\n        -- | 'knownKeyNames' is exported to seed the original name cache only;\n        -- if you find yourself wanting to look at it you might consider using\n        -- 'lookupKnownKeyName' or 'isKnownKeyName'.\n        knownKeyNames,\n\n        -- * Miscellaneous\n        wiredInIds, ghcPrimIds,\n        primOpRules, builtinRules,\n\n        ghcPrimExports,\n        primOpId,\n\n        -- * Random other things\n        maybeCharLikeCon, maybeIntLikeCon,\n\n        -- * Class categories\n        isNumericClass, isStandardClass\n\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport KnownUniques\nimport Unique           ( isValidKnownKeyUnique )\n\nimport ConLike          ( ConLike(..) )\nimport THNames          ( templateHaskellNames )\nimport PrelNames\nimport PrelRules\nimport Avail\nimport PrimOp\nimport DataCon\nimport Id\nimport Name\nimport NameEnv\nimport MkId\nimport Outputable\nimport TysPrim\nimport TysWiredIn\nimport HscTypes\nimport Class\nimport TyCon\nimport UniqFM\nimport Util\nimport TcTypeNats ( typeNatTyCons )\n\nimport Control.Applicative ((<|>))\nimport Data.List        ( intercalate )\nimport Data.Array\nimport Data.Maybe\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[builtinNameInfo]{Lookup built-in names}\n*                                                                      *\n************************************************************************\n\nNote [About wired-in things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Wired-in things are Ids\\/TyCons that are completely known to the compiler.\n  They are global values in GHC, (e.g.  listTyCon :: TyCon).\n\n* A wired in Name contains the thing itself inside the Name:\n        see Name.wiredInNameTyThing_maybe\n  (E.g. listTyConName contains listTyCon.\n\n* The name cache is initialised with (the names of) all wired-in things\n  (except tuples and sums; see Note [Known-])\n\n* The type environment itself contains no wired in things. The type\n  checker sees if the Name is wired in before looking up the name in\n  the type environment.\n\n* MkIface prunes out wired-in things before putting them in an interface file.\n  So interface files never contain wired-in things.\n-}\n\n\n-- | This list is used to ensure that when you say \"Prelude.map\" in your source\n-- code, or in an interface file, you get a Name with the correct known key (See\n-- Note [Known-key names] in PrelNames)\nknownKeyNames :: [Name]\nknownKeyNames\n  | debugIsOn\n  , Just badNamesStr <- knownKeyNamesOkay all_names\n  = panic (\"badAllKnownKeyNames:\\n\" ++ badNamesStr)\n       -- NB: We can't use ppr here, because this is sometimes evaluated in a\n       -- context where there are no DynFlags available, leading to a cryptic\n       -- \"<<details unavailable>>\" error. (This seems to happen only in the\n       -- stage 2 compiler, for reasons I [Richard] have no clue of.)\n  | otherwise\n  = all_names\n  where\n    all_names =\n      concat [ wired_tycon_kk_names funTyCon\n             , concatMap wired_tycon_kk_names primTyCons\n\n             , concatMap wired_tycon_kk_names wiredInTyCons\n               -- Does not include tuples\n\n             , concatMap wired_tycon_kk_names typeNatTyCons\n\n             , map idName wiredInIds\n             , map (idName . primOpId) allThePrimOps\n             , basicKnownKeyNames\n             , templateHaskellNames\n             ]\n    -- All of the names associated with a wired-in TyCon.\n    -- This includes the TyCon itself, its DataCons and promoted TyCons.\n    wired_tycon_kk_names :: TyCon -> [Name]\n    wired_tycon_kk_names tc =\n        tyConName tc : (rep_names tc ++ implicits)\n      where implicits = concatMap thing_kk_names (implicitTyConThings tc)\n\n    wired_datacon_kk_names :: DataCon -> [Name]\n    wired_datacon_kk_names dc =\n      dataConName dc : rep_names (promoteDataCon dc)\n\n    thing_kk_names :: TyThing -> [Name]\n    thing_kk_names (ATyCon tc)                 = wired_tycon_kk_names tc\n    thing_kk_names (AConLike (RealDataCon dc)) = wired_datacon_kk_names dc\n    thing_kk_names thing                       = [getName thing]\n\n    -- The TyConRepName for a known-key TyCon has a known key,\n    -- but isn't itself an implicit thing.  Yurgh.\n    -- NB: if any of the wired-in TyCons had record fields, the record\n    --     field names would be in a similar situation.  Ditto class ops.\n    --     But it happens that there aren't any\n    rep_names tc = case tyConRepName_maybe tc of\n                        Just n  -> [n]\n                        Nothing -> []\n\n-- | Check the known-key names list of consistency.\nknownKeyNamesOkay :: [Name] -> Maybe String\nknownKeyNamesOkay all_names\n  | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names\n  = Just $ \"    Out-of-range known-key uniques: [\"\n        ++ intercalate \", \" (map (occNameString . nameOccName) ns) ++\n         \"]\"\n  | null badNamesPairs\n  = Nothing\n  | otherwise\n  = Just badNamesStr\n  where\n    namesEnv      = foldl' (\\m n -> extendNameEnv_Acc (:) singleton m n n)\n                           emptyUFM all_names\n    badNamesEnv   = filterNameEnv (\\ns -> ns `lengthExceeds` 1) namesEnv\n    badNamesPairs = nonDetUFMToList badNamesEnv\n      -- It's OK to use nonDetUFMToList here because the ordering only affects\n      -- the message when we get a panic\n    badNamesStrs  = map pairToStr badNamesPairs\n    badNamesStr   = unlines badNamesStrs\n\n    pairToStr (uniq, ns) = \"        \" ++\n                           show uniq ++\n                           \": [\" ++\n                           intercalate \", \" (map (occNameString . nameOccName) ns) ++\n                           \"]\"\n\n-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a\n-- known-key thing.\nlookupKnownKeyName :: Unique -> Maybe Name\nlookupKnownKeyName u =\n    knownUniqueName u <|> lookupUFM knownKeysMap u\n\n-- | Is a 'Name' known-key?\nisKnownKeyName :: Name -> Bool\nisKnownKeyName n =\n    isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap\n\nknownKeysMap :: UniqFM Name\nknownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ]\n\n-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by\n-- GHCi's ':info' command.\nlookupKnownNameInfo :: Name -> SDoc\nlookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of\n    -- If we do find a doc, we add comment delimeters to make the output\n    -- of ':info' valid Haskell.\n    Nothing  -> empty\n    Just doc -> vcat [text \"{-\", doc, text \"-}\"]\n\n-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)\nknownNamesInfo :: NameEnv SDoc\nknownNamesInfo = unitNameEnv coercibleTyConName $\n    vcat [ text \"Coercible is a special constraint with custom solving rules.\"\n         , text \"It is not a class.\"\n         , text \"Please see section 9.14.4 of the user's guide for details.\" ]\n\n{-\nWe let a lot of \"non-standard\" values be visible, so that we can make\nsense of them in interface pragmas. It's cool, though they all have\n\"non-standard\" names, so they won't get past the parser in user code.\n\n************************************************************************\n*                                                                      *\n                PrimOpIds\n*                                                                      *\n************************************************************************\n-}\n\nprimOpIds :: Array Int Id\n-- A cache of the PrimOp Ids, indexed by PrimOp tag\nprimOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op)\n                                   | op <- allThePrimOps ]\n\nprimOpId :: PrimOp -> Id\nprimOpId op = primOpIds ! primOpTag op\n\n{-\n************************************************************************\n*                                                                      *\n            Export lists for pseudo-modules (GHC.Prim)\n*                                                                      *\n************************************************************************\n\nGHC.Prim \"exports\" all the primops and primitive types, some\nwired-in Ids.\n-}\n\nghcPrimExports :: [IfaceExport]\nghcPrimExports\n = map (avail . idName) ghcPrimIds ++\n   map (avail . idName . primOpId) allThePrimOps ++\n   [ AvailTC n [n] []\n   | tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc  ]\n\n{-\n************************************************************************\n*                                                                      *\n            Built-in keys\n*                                                                      *\n************************************************************************\n\nToDo: make it do the ``like'' part properly (as in 0.26 and before).\n-}\n\nmaybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool\nmaybeCharLikeCon con = con `hasKey` charDataConKey\nmaybeIntLikeCon  con = con `hasKey` intDataConKey\n\n{-\n************************************************************************\n*                                                                      *\n            Class predicates\n*                                                                      *\n************************************************************************\n-}\n\nisNumericClass, isStandardClass :: Class -> Bool\n\nisNumericClass     clas = classKey clas `is_elem` numericClassKeys\nisStandardClass    clas = classKey clas `is_elem` standardClassKeys\n\nis_elem :: Eq a => a -> [a] -> Bool\nis_elem = isIn \"is_X_Class\"\n", "num_lines": 286}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[PrelNames]{Definitions of prelude modules and names}\n\n\nNota Bene: all Names defined in here should come from the base package\n\n - ModuleNames for prelude modules,\n        e.g.    pREL_BASE_Name :: ModuleName\n\n - Modules for prelude modules\n        e.g.    pREL_Base :: Module\n\n - Uniques for Ids, DataCons, TyCons and Classes that the compiler\n   \"knows about\" in some way\n        e.g.    intTyConKey :: Unique\n                minusClassOpKey :: Unique\n\n - Names for Ids, DataCons, TyCons and Classes that the compiler\n   \"knows about\" in some way\n        e.g.    intTyConName :: Name\n                minusName    :: Name\n   One of these Names contains\n        (a) the module and occurrence name of the thing\n        (b) its Unique\n   The way the compiler \"knows about\" one of these things is\n   where the type checker or desugarer needs to look it up. For\n   example, when desugaring list comprehensions the desugarer\n   needs to conjure up 'foldr'.  It does this by looking up\n   foldrName in the environment.\n\n - RdrNames for Ids, DataCons etc that the compiler may emit into\n   generated code (e.g. for deriving).  It's not necessary to know\n   the uniques for these guys, only their names\n\n\nNote [Known-key names]\n~~~~~~~~~~~~~~~~~~~~~~\nIt is *very* important that the compiler gives wired-in things and\nthings with \"known-key\" names the correct Uniques wherever they\noccur. We have to be careful about this in exactly two places:\n\n  1. When we parse some source code, renaming the AST better yield an\n     AST whose Names have the correct uniques\n\n  2. When we read an interface file, the read-in gubbins better have\n     the right uniques\n\nThis is accomplished through a combination of mechanisms:\n\n  1. When parsing source code, the RdrName-decorated AST has some\n     RdrNames which are Exact. These are wired-in RdrNames where the\n     we could directly tell from the parsed syntax what Name to\n     use. For example, when we parse a [] in a type we can just insert\n     an Exact RdrName Name with the listTyConKey.\n\n     Currently, I believe this is just an optimisation: it would be\n     equally valid to just output Orig RdrNames that correctly record\n     the module etc we expect the final Name to come from. However,\n     were we to eliminate isBuiltInOcc_maybe it would become essential\n     (see point 3).\n\n  2. The knownKeyNames (which consist of the basicKnownKeyNames from\n     the module, and those names reachable via the wired-in stuff from\n     TysWiredIn) are used to initialise the \"OrigNameCache\" in\n     IfaceEnv.  This initialization ensures that when the type checker\n     or renamer (both of which use IfaceEnv) look up an original name\n     (i.e. a pair of a Module and an OccName) for a known-key name\n     they get the correct Unique.\n\n     This is the most important mechanism for ensuring that known-key\n     stuff gets the right Unique, and is why it is so important to\n     place your known-key names in the appropriate lists.\n\n  3. For \"infinite families\" of known-key names (i.e. tuples and sums), we\n     have to be extra careful. Because there are an infinite number of\n     these things, we cannot add them to the list of known-key names\n     used to initialise the OrigNameCache. Instead, we have to\n     rely on never having to look them up in that cache. See\n     Note [Infinite families of known-key names] for details.\n\n\nNote [Infinite families of known-key names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInfinite families of known-key things (e.g. tuples and sums) pose a tricky\nproblem: we can't add them to the knownKeyNames finite map which we use to\nensure that, e.g., a reference to (,) gets assigned the right unique (if this\ndoesn't sound familiar see Note [Known-key names] above).\n\nWe instead handle tuples and sums separately from the \"vanilla\" known-key\nthings,\n\n  a) The parser recognises them specially and generates an Exact Name (hence not\n     looked up in the orig-name cache)\n\n  b) The known infinite families of names are specially serialised by\n     BinIface.putName, with that special treatment detected when we read back to\n     ensure that we get back to the correct uniques. See Note [Symbol table\n     representation of names] in BinIface and Note [How tuples work] in\n     TysWiredIn.\n\nMost of the infinite families cannot occur in source code, so mechanisms (a) and (b)\nsuffice to ensure that they always have the right Unique. In particular,\nimplicit param TyCon names, constraint tuples and Any TyCons cannot be mentioned\nby the user. For those things that *can* appear in source programs,\n\n  c) IfaceEnv.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax\n     directly onto the corresponding name, rather than trying to find it in the\n     original-name cache.\n\n     See also Note [Built-in syntax and the OrigNameCache]\n\n\nNote [The integer library]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nClearly, we need to know the names of various definitions of the integer\nlibrary, e.g. the type itself, `mkInteger` etc. But there are two possible\nimplementations of the integer library:\n\n * integer-gmp (fast, but uses libgmp, which may not be available on all\n   targets and is GPL licensed)\n * integer-simple (slow, but pure Haskell and BSD-licensed)\n\nWe want the compiler to work with either one. The way we achieve this is:\n\n * When compiling the integer-{gmp,simple} library, we pass\n     -this-unit-id  integer-wired-in\n   to GHC (see the cabal file libraries/integer-{gmp,simple}.\n * This way, GHC can use just this UnitID (see Module.integerUnitId) when\n   generating code, and the linker will succeed.\n\nUnfortuately, the abstraction is not complete: When using integer-gmp, we\nreally want to use the S# constructor directly. This is controlled by\nthe `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use\nthis constructor directly (see  CorePrep.lookupIntegerSDataConName)\n\nWhen GHC reads the package data base, it (internally only) pretends it has UnitId\n`integer-wired-in` instead of the actual UnitId (which includes the version\nnumber); just like for `base` and other packages, as described in\nNote [Wired-in packages] in Module. This is done in Packages.findWiredInPackages.\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule PrelNames (\n        Unique, Uniquable(..), hasKey,  -- Re-exported for convenience\n\n        -----------------------------------------------------------\n        module PrelNames,       -- A huge bunch of (a) Names,  e.g. intTyConName\n                                --                 (b) Uniques e.g. intTyConKey\n                                --                 (c) Groups of classes and types\n                                --                 (d) miscellaneous things\n                                -- So many that we export them all\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Module\nimport OccName\nimport RdrName\nimport Unique\nimport Name\nimport SrcLoc\nimport FastString\n\n{-\n************************************************************************\n*                                                                      *\n     allNameStrings\n*                                                                      *\n************************************************************************\n-}\n\nallNameStrings :: [String]\n-- Infinite list of a,b,c...z, aa, ab, ac, ... etc\nallNameStrings = [ c:cs | cs <- \"\" : allNameStrings, c <- ['a'..'z'] ]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Local Names}\n*                                                                      *\n************************************************************************\n\nThis *local* name is used by the interactive stuff\n-}\n\nitName :: Unique -> SrcSpan -> Name\nitName uniq loc = mkInternalName uniq (mkOccNameFS varName (fsLit \"it\")) loc\n\n-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly\n-- during compiler debugging.\nmkUnboundName :: OccName -> Name\nmkUnboundName occ = mkInternalName unboundKey occ noSrcSpan\n\nisUnboundName :: Name -> Bool\nisUnboundName name = name `hasKey` unboundKey\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Known key Names}\n*                                                                      *\n************************************************************************\n\nThis section tells what the compiler knows about the association of\nnames with uniques.  These ones are the *non* wired-in ones.  The\nwired in ones are defined in TysWiredIn etc.\n-}\n\nbasicKnownKeyNames :: [Name]  -- See Note [Known-key names]\nbasicKnownKeyNames\n = genericTyConNames\n ++ [   --  Classes.  *Must* include:\n        --      classes that are grabbed by key (e.g., eqClassKey)\n        --      classes in \"Class.standardClassKeys\" (quite a few)\n        eqClassName,                    -- mentioned, derivable\n        ordClassName,                   -- derivable\n        boundedClassName,               -- derivable\n        numClassName,                   -- mentioned, numeric\n        enumClassName,                  -- derivable\n        monadClassName,\n        functorClassName,\n        realClassName,                  -- numeric\n        integralClassName,              -- numeric\n        fractionalClassName,            -- numeric\n        floatingClassName,              -- numeric\n        realFracClassName,              -- numeric\n        realFloatClassName,             -- numeric\n        dataClassName,\n        isStringClassName,\n        applicativeClassName,\n        alternativeClassName,\n        foldableClassName,\n        traversableClassName,\n        semigroupClassName, sappendName,\n        monoidClassName, memptyName, mappendName, mconcatName,\n\n        -- The IO type\n        -- See Note [TyConRepNames for non-wired-in TyCons]\n        ioTyConName, ioDataConName,\n        runMainIOName,\n        runRWName,\n\n        -- Type representation types\n        trModuleTyConName, trModuleDataConName,\n        trNameTyConName, trNameSDataConName, trNameDDataConName,\n        trTyConTyConName, trTyConDataConName,\n\n        -- Typeable\n        typeableClassName,\n        typeRepTyConName,\n        someTypeRepTyConName,\n        someTypeRepDataConName,\n        kindRepTyConName,\n        kindRepTyConAppDataConName,\n        kindRepVarDataConName,\n        kindRepAppDataConName,\n        kindRepFunDataConName,\n        kindRepTYPEDataConName,\n        kindRepTypeLitSDataConName,\n        kindRepTypeLitDDataConName,\n        typeLitSortTyConName,\n        typeLitSymbolDataConName,\n        typeLitNatDataConName,\n        typeRepIdName,\n        mkTrTypeName,\n        mkTrConName,\n        mkTrAppName,\n        mkTrFunName,\n        typeSymbolTypeRepName, typeNatTypeRepName,\n        trGhcPrimModuleName,\n\n        -- KindReps for common cases\n        starKindRepName,\n        starArrStarKindRepName,\n        starArrStarArrStarKindRepName,\n\n        -- Dynamic\n        toDynName,\n\n        -- Numeric stuff\n        negateName, minusName, geName, eqName,\n\n        -- Conversion functions\n        rationalTyConName,\n        ratioTyConName, ratioDataConName,\n        fromRationalName, fromIntegerName,\n        toIntegerName, toRationalName,\n        fromIntegralName, realToFracName,\n\n        -- Int# stuff\n        divIntName, modIntName,\n\n        -- String stuff\n        fromStringName,\n\n        -- Enum stuff\n        enumFromName, enumFromThenName,\n        enumFromThenToName, enumFromToName,\n\n        -- Applicative stuff\n        pureAName, apAName, thenAName,\n\n        -- Functor stuff\n        fmapName,\n\n        -- Monad stuff\n        thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,\n        returnMName, joinMName,\n\n        -- MonadFail\n        monadFailClassName, failMName, failMName_preMFP,\n\n        -- MonadFix\n        monadFixClassName, mfixName,\n\n        -- Arrow stuff\n        arrAName, composeAName, firstAName,\n        appAName, choiceAName, loopAName,\n\n        -- Ix stuff\n        ixClassName,\n\n        -- Show stuff\n        showClassName,\n\n        -- Read stuff\n        readClassName,\n\n        -- Stable pointers\n        newStablePtrName,\n\n        -- GHC Extensions\n        groupWithName,\n\n        -- Strings and lists\n        unpackCStringName,\n        unpackCStringFoldrName, unpackCStringUtf8Name,\n\n        -- Overloaded lists\n        isListClassName,\n        fromListName,\n        fromListNName,\n        toListName,\n\n        -- List operations\n        concatName, filterName, mapName,\n        zipName, foldrName, buildName, augmentName, appendName,\n\n        -- FFI primitive types that are not wired-in.\n        stablePtrTyConName, ptrTyConName, funPtrTyConName,\n        int8TyConName, int16TyConName, int32TyConName, int64TyConName,\n        word16TyConName, word32TyConName, word64TyConName,\n\n        -- Others\n        otherwiseIdName, inlineIdName,\n        eqStringName, assertName, breakpointName, breakpointCondName,\n        opaqueTyConName,\n        assertErrorName, traceName,\n        printName, fstName, sndName,\n        dollarName,\n\n        -- Integer\n        integerTyConName, mkIntegerName,\n        integerToWord64Name, integerToInt64Name,\n        word64ToIntegerName, int64ToIntegerName,\n        plusIntegerName, timesIntegerName, smallIntegerName,\n        wordToIntegerName,\n        integerToWordName, integerToIntName, minusIntegerName,\n        negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,\n        absIntegerName, signumIntegerName,\n        leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,\n        compareIntegerName, quotRemIntegerName, divModIntegerName,\n        quotIntegerName, remIntegerName, divIntegerName, modIntegerName,\n        floatFromIntegerName, doubleFromIntegerName,\n        encodeFloatIntegerName, encodeDoubleIntegerName,\n        decodeDoubleIntegerName,\n        gcdIntegerName, lcmIntegerName,\n        andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,\n        shiftLIntegerName, shiftRIntegerName, bitIntegerName,\n        integerSDataConName,naturalSDataConName,\n\n        -- Natural\n        naturalTyConName,\n        naturalFromIntegerName, naturalToIntegerName,\n        plusNaturalName, minusNaturalName, timesNaturalName, mkNaturalName,\n        wordToNaturalName,\n\n        -- Float/Double\n        rationalToFloatName,\n        rationalToDoubleName,\n\n        -- Other classes\n        randomClassName, randomGenClassName, monadPlusClassName,\n\n        -- Type-level naturals\n        knownNatClassName, knownSymbolClassName,\n\n        -- Overloaded labels\n        isLabelClassName,\n\n        -- Implicit Parameters\n        ipClassName,\n\n        -- Overloaded record fields\n        hasFieldClassName,\n\n        -- Call Stacks\n        callStackTyConName,\n        emptyCallStackName, pushCallStackName,\n\n        -- Source Locations\n        srcLocDataConName,\n\n        -- Annotation type checking\n        toAnnotationWrapperName\n\n        -- The Ordering type\n        , orderingTyConName\n        , ordLTDataConName, ordEQDataConName, ordGTDataConName\n\n        -- The SPEC type for SpecConstr\n        , specTyConName\n\n        -- The Either type\n        , eitherTyConName, leftDataConName, rightDataConName\n\n        -- Plugins\n        , pluginTyConName\n        , frontendPluginTyConName\n\n        -- Generics\n        , genClassName, gen1ClassName\n        , datatypeClassName, constructorClassName, selectorClassName\n\n        -- Monad comprehensions\n        , guardMName\n        , liftMName\n        , mzipName\n\n        -- GHCi Sandbox\n        , ghciIoClassName, ghciStepIoMName\n\n        -- StaticPtr\n        , makeStaticName\n        , staticPtrTyConName\n        , staticPtrDataConName, staticPtrInfoDataConName\n        , fromStaticPtrName\n\n        -- Fingerprint\n        , fingerprintDataConName\n\n        -- Custom type errors\n        , errorMessageTypeErrorFamName\n        , typeErrorTextDataConName\n        , typeErrorAppendDataConName\n        , typeErrorVAppendDataConName\n        , typeErrorShowTypeDataConName\n\n    ]\n\ngenericTyConNames :: [Name]\ngenericTyConNames = [\n    v1TyConName, u1TyConName, par1TyConName, rec1TyConName,\n    k1TyConName, m1TyConName, sumTyConName, prodTyConName,\n    compTyConName, rTyConName, dTyConName,\n    cTyConName, sTyConName, rec0TyConName,\n    d1TyConName, c1TyConName, s1TyConName, noSelTyConName,\n    repTyConName, rep1TyConName, uRecTyConName,\n    uAddrTyConName, uCharTyConName, uDoubleTyConName,\n    uFloatTyConName, uIntTyConName, uWordTyConName,\n    prefixIDataConName, infixIDataConName, leftAssociativeDataConName,\n    rightAssociativeDataConName, notAssociativeDataConName,\n    sourceUnpackDataConName, sourceNoUnpackDataConName,\n    noSourceUnpackednessDataConName, sourceLazyDataConName,\n    sourceStrictDataConName, noSourceStrictnessDataConName,\n    decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,\n    metaDataDataConName, metaConsDataConName, metaSelDataConName\n  ]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Module names}\n*                                                                      *\n************************************************************************\n\n\n--MetaHaskell Extension Add a new module here\n-}\n\npRELUDE :: Module\npRELUDE         = mkBaseModule_ pRELUDE_NAME\n\ngHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,\n    gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,\n    gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,\n    gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING,\n    dATA_FOLDABLE, dATA_TRAVERSABLE,\n    gHC_CONC, gHC_IO, gHC_IO_Exception,\n    gHC_ST, gHC_ARR, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL,\n    gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC,\n    tYPEABLE, tYPEABLE_INTERNAL, gENERICS,\n    rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL,\n    aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS,\n    cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_TYPENATS, dATA_TYPE_EQUALITY,\n    dATA_COERCE, dEBUG_TRACE :: Module\n\ngHC_PRIM        = mkPrimModule (fsLit \"GHC.Prim\")   -- Primitive types and values\ngHC_TYPES       = mkPrimModule (fsLit \"GHC.Types\")\ngHC_MAGIC       = mkPrimModule (fsLit \"GHC.Magic\")\ngHC_CSTRING     = mkPrimModule (fsLit \"GHC.CString\")\ngHC_CLASSES     = mkPrimModule (fsLit \"GHC.Classes\")\n\ngHC_BASE        = mkBaseModule (fsLit \"GHC.Base\")\ngHC_ENUM        = mkBaseModule (fsLit \"GHC.Enum\")\ngHC_GHCI        = mkBaseModule (fsLit \"GHC.GHCi\")\ngHC_SHOW        = mkBaseModule (fsLit \"GHC.Show\")\ngHC_READ        = mkBaseModule (fsLit \"GHC.Read\")\ngHC_NUM         = mkBaseModule (fsLit \"GHC.Num\")\ngHC_MAYBE       = mkBaseModule (fsLit \"GHC.Maybe\")\ngHC_INTEGER_TYPE= mkIntegerModule (fsLit \"GHC.Integer.Type\")\ngHC_NATURAL     = mkBaseModule (fsLit \"GHC.Natural\")\ngHC_LIST        = mkBaseModule (fsLit \"GHC.List\")\ngHC_TUPLE       = mkPrimModule (fsLit \"GHC.Tuple\")\ndATA_TUPLE      = mkBaseModule (fsLit \"Data.Tuple\")\ndATA_EITHER     = mkBaseModule (fsLit \"Data.Either\")\ndATA_STRING     = mkBaseModule (fsLit \"Data.String\")\ndATA_FOLDABLE   = mkBaseModule (fsLit \"Data.Foldable\")\ndATA_TRAVERSABLE= mkBaseModule (fsLit \"Data.Traversable\")\ngHC_CONC        = mkBaseModule (fsLit \"GHC.Conc\")\ngHC_IO          = mkBaseModule (fsLit \"GHC.IO\")\ngHC_IO_Exception = mkBaseModule (fsLit \"GHC.IO.Exception\")\ngHC_ST          = mkBaseModule (fsLit \"GHC.ST\")\ngHC_ARR         = mkBaseModule (fsLit \"GHC.Arr\")\ngHC_STABLE      = mkBaseModule (fsLit \"GHC.Stable\")\ngHC_PTR         = mkBaseModule (fsLit \"GHC.Ptr\")\ngHC_ERR         = mkBaseModule (fsLit \"GHC.Err\")\ngHC_REAL        = mkBaseModule (fsLit \"GHC.Real\")\ngHC_FLOAT       = mkBaseModule (fsLit \"GHC.Float\")\ngHC_TOP_HANDLER = mkBaseModule (fsLit \"GHC.TopHandler\")\nsYSTEM_IO       = mkBaseModule (fsLit \"System.IO\")\ndYNAMIC         = mkBaseModule (fsLit \"Data.Dynamic\")\ntYPEABLE        = mkBaseModule (fsLit \"Data.Typeable\")\ntYPEABLE_INTERNAL = mkBaseModule (fsLit \"Data.Typeable.Internal\")\ngENERICS        = mkBaseModule (fsLit \"Data.Data\")\nrEAD_PREC       = mkBaseModule (fsLit \"Text.ParserCombinators.ReadPrec\")\nlEX             = mkBaseModule (fsLit \"Text.Read.Lex\")\ngHC_INT         = mkBaseModule (fsLit \"GHC.Int\")\ngHC_WORD        = mkBaseModule (fsLit \"GHC.Word\")\nmONAD           = mkBaseModule (fsLit \"Control.Monad\")\nmONAD_FIX       = mkBaseModule (fsLit \"Control.Monad.Fix\")\nmONAD_ZIP       = mkBaseModule (fsLit \"Control.Monad.Zip\")\nmONAD_FAIL      = mkBaseModule (fsLit \"Control.Monad.Fail\")\naRROW           = mkBaseModule (fsLit \"Control.Arrow\")\ncONTROL_APPLICATIVE = mkBaseModule (fsLit \"Control.Applicative\")\ngHC_DESUGAR = mkBaseModule (fsLit \"GHC.Desugar\")\nrANDOM          = mkBaseModule (fsLit \"System.Random\")\ngHC_EXTS        = mkBaseModule (fsLit \"GHC.Exts\")\ncONTROL_EXCEPTION_BASE = mkBaseModule (fsLit \"Control.Exception.Base\")\ngHC_GENERICS    = mkBaseModule (fsLit \"GHC.Generics\")\ngHC_TYPELITS    = mkBaseModule (fsLit \"GHC.TypeLits\")\ngHC_TYPENATS    = mkBaseModule (fsLit \"GHC.TypeNats\")\ndATA_TYPE_EQUALITY = mkBaseModule (fsLit \"Data.Type.Equality\")\ndATA_COERCE     = mkBaseModule (fsLit \"Data.Coerce\")\ndEBUG_TRACE     = mkBaseModule (fsLit \"Debug.Trace\")\n\ngHC_SRCLOC :: Module\ngHC_SRCLOC = mkBaseModule (fsLit \"GHC.SrcLoc\")\n\ngHC_STACK, gHC_STACK_TYPES :: Module\ngHC_STACK = mkBaseModule (fsLit \"GHC.Stack\")\ngHC_STACK_TYPES = mkBaseModule (fsLit \"GHC.Stack.Types\")\n\ngHC_STATICPTR :: Module\ngHC_STATICPTR = mkBaseModule (fsLit \"GHC.StaticPtr\")\n\ngHC_STATICPTR_INTERNAL :: Module\ngHC_STATICPTR_INTERNAL = mkBaseModule (fsLit \"GHC.StaticPtr.Internal\")\n\ngHC_FINGERPRINT_TYPE :: Module\ngHC_FINGERPRINT_TYPE = mkBaseModule (fsLit \"GHC.Fingerprint.Type\")\n\ngHC_OVER_LABELS :: Module\ngHC_OVER_LABELS = mkBaseModule (fsLit \"GHC.OverloadedLabels\")\n\ngHC_RECORDS :: Module\ngHC_RECORDS = mkBaseModule (fsLit \"GHC.Records\")\n\nmAIN, rOOT_MAIN :: Module\nmAIN            = mkMainModule_ mAIN_NAME\nrOOT_MAIN       = mkMainModule (fsLit \":Main\") -- Root module for initialisation\n\nmkInteractiveModule :: Int -> Module\n-- (mkInteractiveMoudule 9) makes module 'interactive:M9'\nmkInteractiveModule n = mkModule interactiveUnitId (mkModuleName (\"Ghci\" ++ show n))\n\npRELUDE_NAME, mAIN_NAME :: ModuleName\npRELUDE_NAME   = mkModuleNameFS (fsLit \"Prelude\")\nmAIN_NAME      = mkModuleNameFS (fsLit \"Main\")\n\ndATA_ARRAY_PARALLEL_NAME, dATA_ARRAY_PARALLEL_PRIM_NAME :: ModuleName\ndATA_ARRAY_PARALLEL_NAME      = mkModuleNameFS (fsLit \"Data.Array.Parallel\")\ndATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit \"Data.Array.Parallel.Prim\")\n\nmkPrimModule :: FastString -> Module\nmkPrimModule m = mkModule primUnitId (mkModuleNameFS m)\n\nmkIntegerModule :: FastString -> Module\nmkIntegerModule m = mkModule integerUnitId (mkModuleNameFS m)\n\nmkBaseModule :: FastString -> Module\nmkBaseModule m = mkModule baseUnitId (mkModuleNameFS m)\n\nmkBaseModule_ :: ModuleName -> Module\nmkBaseModule_ m = mkModule baseUnitId m\n\nmkThisGhcModule :: FastString -> Module\nmkThisGhcModule m = mkModule thisGhcUnitId (mkModuleNameFS m)\n\nmkThisGhcModule_ :: ModuleName -> Module\nmkThisGhcModule_ m = mkModule thisGhcUnitId m\n\nmkMainModule :: FastString -> Module\nmkMainModule m = mkModule mainUnitId (mkModuleNameFS m)\n\nmkMainModule_ :: ModuleName -> Module\nmkMainModule_ m = mkModule mainUnitId m\n\n{-\n************************************************************************\n*                                                                      *\n                        RdrNames\n*                                                                      *\n************************************************************************\n-}\n\nmain_RDR_Unqual    :: RdrName\nmain_RDR_Unqual = mkUnqual varName (fsLit \"main\")\n        -- We definitely don't want an Orig RdrName, because\n        -- main might, in principle, be imported into module Main\n\neq_RDR, ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR,\n    ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName\neq_RDR                  = nameRdrName eqName\nge_RDR                  = nameRdrName geName\nle_RDR                  = varQual_RDR  gHC_CLASSES (fsLit \"<=\")\nlt_RDR                  = varQual_RDR  gHC_CLASSES (fsLit \"<\")\ngt_RDR                  = varQual_RDR  gHC_CLASSES (fsLit \">\")\ncompare_RDR             = varQual_RDR  gHC_CLASSES (fsLit \"compare\")\nltTag_RDR               = nameRdrName  ordLTDataConName\neqTag_RDR               = nameRdrName  ordEQDataConName\ngtTag_RDR               = nameRdrName  ordGTDataConName\n\neqClass_RDR, numClass_RDR, ordClass_RDR, enumClass_RDR, monadClass_RDR\n    :: RdrName\neqClass_RDR             = nameRdrName eqClassName\nnumClass_RDR            = nameRdrName numClassName\nordClass_RDR            = nameRdrName ordClassName\nenumClass_RDR           = nameRdrName enumClassName\nmonadClass_RDR          = nameRdrName monadClassName\n\nmap_RDR, append_RDR :: RdrName\nmap_RDR                 = nameRdrName mapName\nappend_RDR              = nameRdrName appendName\n\nfoldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR_preMFP,\n  failM_RDR :: RdrName\nfoldr_RDR               = nameRdrName foldrName\nbuild_RDR               = nameRdrName buildName\nreturnM_RDR             = nameRdrName returnMName\nbindM_RDR               = nameRdrName bindMName\nfailM_RDR_preMFP        = nameRdrName failMName_preMFP\nfailM_RDR               = nameRdrName failMName\n\nleft_RDR, right_RDR :: RdrName\nleft_RDR                = nameRdrName leftDataConName\nright_RDR               = nameRdrName rightDataConName\n\nfromEnum_RDR, toEnum_RDR :: RdrName\nfromEnum_RDR            = varQual_RDR gHC_ENUM (fsLit \"fromEnum\")\ntoEnum_RDR              = varQual_RDR gHC_ENUM (fsLit \"toEnum\")\n\nenumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName\nenumFrom_RDR            = nameRdrName enumFromName\nenumFromTo_RDR          = nameRdrName enumFromToName\nenumFromThen_RDR        = nameRdrName enumFromThenName\nenumFromThenTo_RDR      = nameRdrName enumFromThenToName\n\nratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR :: RdrName\nratioDataCon_RDR        = nameRdrName ratioDataConName\nplusInteger_RDR         = nameRdrName plusIntegerName\ntimesInteger_RDR        = nameRdrName timesIntegerName\n\nioDataCon_RDR :: RdrName\nioDataCon_RDR           = nameRdrName ioDataConName\n\neqString_RDR, unpackCString_RDR, unpackCStringFoldr_RDR,\n    unpackCStringUtf8_RDR :: RdrName\neqString_RDR            = nameRdrName eqStringName\nunpackCString_RDR       = nameRdrName unpackCStringName\nunpackCStringFoldr_RDR  = nameRdrName unpackCStringFoldrName\nunpackCStringUtf8_RDR   = nameRdrName unpackCStringUtf8Name\n\nnewStablePtr_RDR :: RdrName\nnewStablePtr_RDR        = nameRdrName newStablePtrName\n\nbindIO_RDR, returnIO_RDR :: RdrName\nbindIO_RDR              = nameRdrName bindIOName\nreturnIO_RDR            = nameRdrName returnIOName\n\nfromInteger_RDR, fromRational_RDR, minus_RDR, times_RDR, plus_RDR :: RdrName\nfromInteger_RDR         = nameRdrName fromIntegerName\nfromRational_RDR        = nameRdrName fromRationalName\nminus_RDR               = nameRdrName minusName\ntimes_RDR               = varQual_RDR  gHC_NUM (fsLit \"*\")\nplus_RDR                = varQual_RDR gHC_NUM (fsLit \"+\")\n\ntoInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName\ntoInteger_RDR           = nameRdrName toIntegerName\ntoRational_RDR          = nameRdrName toRationalName\nfromIntegral_RDR        = nameRdrName fromIntegralName\n\nstringTy_RDR, fromString_RDR :: RdrName\nstringTy_RDR            = tcQual_RDR gHC_BASE (fsLit \"String\")\nfromString_RDR          = nameRdrName fromStringName\n\nfromList_RDR, fromListN_RDR, toList_RDR :: RdrName\nfromList_RDR = nameRdrName fromListName\nfromListN_RDR = nameRdrName fromListNName\ntoList_RDR = nameRdrName toListName\n\ncompose_RDR :: RdrName\ncompose_RDR             = varQual_RDR gHC_BASE (fsLit \".\")\n\nnot_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,\n    and_RDR, range_RDR, inRange_RDR, index_RDR,\n    unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName\nand_RDR                 = varQual_RDR gHC_CLASSES (fsLit \"&&\")\nnot_RDR                 = varQual_RDR gHC_CLASSES (fsLit \"not\")\ngetTag_RDR              = varQual_RDR gHC_BASE (fsLit \"getTag\")\nsucc_RDR                = varQual_RDR gHC_ENUM (fsLit \"succ\")\npred_RDR                = varQual_RDR gHC_ENUM (fsLit \"pred\")\nminBound_RDR            = varQual_RDR gHC_ENUM (fsLit \"minBound\")\nmaxBound_RDR            = varQual_RDR gHC_ENUM (fsLit \"maxBound\")\nrange_RDR               = varQual_RDR gHC_ARR (fsLit \"range\")\ninRange_RDR             = varQual_RDR gHC_ARR (fsLit \"inRange\")\nindex_RDR               = varQual_RDR gHC_ARR (fsLit \"index\")\nunsafeIndex_RDR         = varQual_RDR gHC_ARR (fsLit \"unsafeIndex\")\nunsafeRangeSize_RDR     = varQual_RDR gHC_ARR (fsLit \"unsafeRangeSize\")\n\nreadList_RDR, readListDefault_RDR, readListPrec_RDR, readListPrecDefault_RDR,\n    readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: RdrName\nreadList_RDR            = varQual_RDR gHC_READ (fsLit \"readList\")\nreadListDefault_RDR     = varQual_RDR gHC_READ (fsLit \"readListDefault\")\nreadListPrec_RDR        = varQual_RDR gHC_READ (fsLit \"readListPrec\")\nreadListPrecDefault_RDR = varQual_RDR gHC_READ (fsLit \"readListPrecDefault\")\nreadPrec_RDR            = varQual_RDR gHC_READ (fsLit \"readPrec\")\nparens_RDR              = varQual_RDR gHC_READ (fsLit \"parens\")\nchoose_RDR              = varQual_RDR gHC_READ (fsLit \"choose\")\nlexP_RDR                = varQual_RDR gHC_READ (fsLit \"lexP\")\nexpectP_RDR             = varQual_RDR gHC_READ (fsLit \"expectP\")\n\nreadField_RDR, readFieldHash_RDR, readSymField_RDR :: RdrName\nreadField_RDR           = varQual_RDR gHC_READ (fsLit \"readField\")\nreadFieldHash_RDR       = varQual_RDR gHC_READ (fsLit \"readFieldHash\")\nreadSymField_RDR        = varQual_RDR gHC_READ (fsLit \"readSymField\")\n\npunc_RDR, ident_RDR, symbol_RDR :: RdrName\npunc_RDR                = dataQual_RDR lEX (fsLit \"Punc\")\nident_RDR               = dataQual_RDR lEX (fsLit \"Ident\")\nsymbol_RDR              = dataQual_RDR lEX (fsLit \"Symbol\")\n\nstep_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: RdrName\nstep_RDR                = varQual_RDR  rEAD_PREC (fsLit \"step\")\nalt_RDR                 = varQual_RDR  rEAD_PREC (fsLit \"+++\")\nreset_RDR               = varQual_RDR  rEAD_PREC (fsLit \"reset\")\nprec_RDR                = varQual_RDR  rEAD_PREC (fsLit \"prec\")\npfail_RDR               = varQual_RDR  rEAD_PREC (fsLit \"pfail\")\n\nshowsPrec_RDR, shows_RDR, showString_RDR,\n    showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: RdrName\nshowsPrec_RDR           = varQual_RDR gHC_SHOW (fsLit \"showsPrec\")\nshows_RDR               = varQual_RDR gHC_SHOW (fsLit \"shows\")\nshowString_RDR          = varQual_RDR gHC_SHOW (fsLit \"showString\")\nshowSpace_RDR           = varQual_RDR gHC_SHOW (fsLit \"showSpace\")\nshowCommaSpace_RDR      = varQual_RDR gHC_SHOW (fsLit \"showCommaSpace\")\nshowParen_RDR           = varQual_RDR gHC_SHOW (fsLit \"showParen\")\n\nundefined_RDR :: RdrName\nundefined_RDR = varQual_RDR gHC_ERR (fsLit \"undefined\")\n\nerror_RDR :: RdrName\nerror_RDR = varQual_RDR gHC_ERR (fsLit \"error\")\n\n-- Generics (constructors and functions)\nu1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,\n  k1DataCon_RDR, m1DataCon_RDR, l1DataCon_RDR, r1DataCon_RDR,\n  prodDataCon_RDR, comp1DataCon_RDR,\n  unPar1_RDR, unRec1_RDR, unK1_RDR, unComp1_RDR,\n  from_RDR, from1_RDR, to_RDR, to1_RDR,\n  datatypeName_RDR, moduleName_RDR, packageName_RDR, isNewtypeName_RDR,\n  conName_RDR, conFixity_RDR, conIsRecord_RDR, selName_RDR,\n  prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR,\n  rightAssocDataCon_RDR, notAssocDataCon_RDR,\n  uAddrDataCon_RDR, uCharDataCon_RDR, uDoubleDataCon_RDR,\n  uFloatDataCon_RDR, uIntDataCon_RDR, uWordDataCon_RDR,\n  uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR,\n  uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName\n\nu1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit \"U1\")\npar1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit \"Par1\")\nrec1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit \"Rec1\")\nk1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit \"K1\")\nm1DataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit \"M1\")\n\nl1DataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit \"L1\")\nr1DataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit \"R1\")\n\nprodDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit \":*:\")\ncomp1DataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit \"Comp1\")\n\nunPar1_RDR  = varQual_RDR gHC_GENERICS (fsLit \"unPar1\")\nunRec1_RDR  = varQual_RDR gHC_GENERICS (fsLit \"unRec1\")\nunK1_RDR    = varQual_RDR gHC_GENERICS (fsLit \"unK1\")\nunComp1_RDR = varQual_RDR gHC_GENERICS (fsLit \"unComp1\")\n\nfrom_RDR  = varQual_RDR gHC_GENERICS (fsLit \"from\")\nfrom1_RDR = varQual_RDR gHC_GENERICS (fsLit \"from1\")\nto_RDR    = varQual_RDR gHC_GENERICS (fsLit \"to\")\nto1_RDR   = varQual_RDR gHC_GENERICS (fsLit \"to1\")\n\ndatatypeName_RDR  = varQual_RDR gHC_GENERICS (fsLit \"datatypeName\")\nmoduleName_RDR    = varQual_RDR gHC_GENERICS (fsLit \"moduleName\")\npackageName_RDR   = varQual_RDR gHC_GENERICS (fsLit \"packageName\")\nisNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit \"isNewtype\")\nselName_RDR       = varQual_RDR gHC_GENERICS (fsLit \"selName\")\nconName_RDR       = varQual_RDR gHC_GENERICS (fsLit \"conName\")\nconFixity_RDR     = varQual_RDR gHC_GENERICS (fsLit \"conFixity\")\nconIsRecord_RDR   = varQual_RDR gHC_GENERICS (fsLit \"conIsRecord\")\n\nprefixDataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit \"Prefix\")\ninfixDataCon_RDR      = dataQual_RDR gHC_GENERICS (fsLit \"Infix\")\nleftAssocDataCon_RDR  = nameRdrName leftAssociativeDataConName\nrightAssocDataCon_RDR = nameRdrName rightAssociativeDataConName\nnotAssocDataCon_RDR   = nameRdrName notAssociativeDataConName\n\nuAddrDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit \"UAddr\")\nuCharDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit \"UChar\")\nuDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit \"UDouble\")\nuFloatDataCon_RDR  = dataQual_RDR gHC_GENERICS (fsLit \"UFloat\")\nuIntDataCon_RDR    = dataQual_RDR gHC_GENERICS (fsLit \"UInt\")\nuWordDataCon_RDR   = dataQual_RDR gHC_GENERICS (fsLit \"UWord\")\n\nuAddrHash_RDR   = varQual_RDR gHC_GENERICS (fsLit \"uAddr#\")\nuCharHash_RDR   = varQual_RDR gHC_GENERICS (fsLit \"uChar#\")\nuDoubleHash_RDR = varQual_RDR gHC_GENERICS (fsLit \"uDouble#\")\nuFloatHash_RDR  = varQual_RDR gHC_GENERICS (fsLit \"uFloat#\")\nuIntHash_RDR    = varQual_RDR gHC_GENERICS (fsLit \"uInt#\")\nuWordHash_RDR   = varQual_RDR gHC_GENERICS (fsLit \"uWord#\")\n\nfmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR,\n    foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR,\n    mappend_RDR :: RdrName\nfmap_RDR                = nameRdrName fmapName\nreplace_RDR             = varQual_RDR gHC_BASE (fsLit \"<$\")\npure_RDR                = nameRdrName pureAName\nap_RDR                  = nameRdrName apAName\nliftA2_RDR              = varQual_RDR gHC_BASE (fsLit \"liftA2\")\nfoldable_foldr_RDR      = varQual_RDR dATA_FOLDABLE       (fsLit \"foldr\")\nfoldMap_RDR             = varQual_RDR dATA_FOLDABLE       (fsLit \"foldMap\")\nnull_RDR                = varQual_RDR dATA_FOLDABLE       (fsLit \"null\")\nall_RDR                 = varQual_RDR dATA_FOLDABLE       (fsLit \"all\")\ntraverse_RDR            = varQual_RDR dATA_TRAVERSABLE    (fsLit \"traverse\")\nmempty_RDR              = nameRdrName memptyName\nmappend_RDR             = nameRdrName mappendName\n\n----------------------\nvarQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR\n    :: Module -> FastString -> RdrName\nvarQual_RDR  mod str = mkOrig mod (mkOccNameFS varName str)\ntcQual_RDR   mod str = mkOrig mod (mkOccNameFS tcName str)\nclsQual_RDR  mod str = mkOrig mod (mkOccNameFS clsName str)\ndataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Known-key names}\n*                                                                      *\n************************************************************************\n\nMany of these Names are not really \"built in\", but some parts of the\ncompiler (notably the deriving mechanism) need to mention their names,\nand it's convenient to write them all down in one place.\n-}\n\nwildCardName :: Name\nwildCardName = mkSystemVarName wildCardKey (fsLit \"wild\")\n\nrunMainIOName, runRWName :: Name\nrunMainIOName = varQual gHC_TOP_HANDLER (fsLit \"runMainIO\") runMainKey\nrunRWName     = varQual gHC_MAGIC       (fsLit \"runRW#\")    runRWKey\n\norderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name\norderingTyConName = tcQual  gHC_TYPES (fsLit \"Ordering\") orderingTyConKey\nordLTDataConName     = dcQual gHC_TYPES (fsLit \"LT\") ordLTDataConKey\nordEQDataConName     = dcQual gHC_TYPES (fsLit \"EQ\") ordEQDataConKey\nordGTDataConName     = dcQual gHC_TYPES (fsLit \"GT\") ordGTDataConKey\n\nspecTyConName :: Name\nspecTyConName     = tcQual gHC_TYPES (fsLit \"SPEC\") specTyConKey\n\neitherTyConName, leftDataConName, rightDataConName :: Name\neitherTyConName   = tcQual  dATA_EITHER (fsLit \"Either\") eitherTyConKey\nleftDataConName   = dcQual dATA_EITHER (fsLit \"Left\")   leftDataConKey\nrightDataConName  = dcQual dATA_EITHER (fsLit \"Right\")  rightDataConKey\n\n-- Generics (types)\nv1TyConName, u1TyConName, par1TyConName, rec1TyConName,\n  k1TyConName, m1TyConName, sumTyConName, prodTyConName,\n  compTyConName, rTyConName, dTyConName,\n  cTyConName, sTyConName, rec0TyConName,\n  d1TyConName, c1TyConName, s1TyConName, noSelTyConName,\n  repTyConName, rep1TyConName, uRecTyConName,\n  uAddrTyConName, uCharTyConName, uDoubleTyConName,\n  uFloatTyConName, uIntTyConName, uWordTyConName,\n  prefixIDataConName, infixIDataConName, leftAssociativeDataConName,\n  rightAssociativeDataConName, notAssociativeDataConName,\n  sourceUnpackDataConName, sourceNoUnpackDataConName,\n  noSourceUnpackednessDataConName, sourceLazyDataConName,\n  sourceStrictDataConName, noSourceStrictnessDataConName,\n  decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,\n  metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name\n\nv1TyConName  = tcQual gHC_GENERICS (fsLit \"V1\") v1TyConKey\nu1TyConName  = tcQual gHC_GENERICS (fsLit \"U1\") u1TyConKey\npar1TyConName  = tcQual gHC_GENERICS (fsLit \"Par1\") par1TyConKey\nrec1TyConName  = tcQual gHC_GENERICS (fsLit \"Rec1\") rec1TyConKey\nk1TyConName  = tcQual gHC_GENERICS (fsLit \"K1\") k1TyConKey\nm1TyConName  = tcQual gHC_GENERICS (fsLit \"M1\") m1TyConKey\n\nsumTyConName    = tcQual gHC_GENERICS (fsLit \":+:\") sumTyConKey\nprodTyConName   = tcQual gHC_GENERICS (fsLit \":*:\") prodTyConKey\ncompTyConName   = tcQual gHC_GENERICS (fsLit \":.:\") compTyConKey\n\nrTyConName  = tcQual gHC_GENERICS (fsLit \"R\") rTyConKey\ndTyConName  = tcQual gHC_GENERICS (fsLit \"D\") dTyConKey\ncTyConName  = tcQual gHC_GENERICS (fsLit \"C\") cTyConKey\nsTyConName  = tcQual gHC_GENERICS (fsLit \"S\") sTyConKey\n\nrec0TyConName  = tcQual gHC_GENERICS (fsLit \"Rec0\") rec0TyConKey\nd1TyConName  = tcQual gHC_GENERICS (fsLit \"D1\") d1TyConKey\nc1TyConName  = tcQual gHC_GENERICS (fsLit \"C1\") c1TyConKey\ns1TyConName  = tcQual gHC_GENERICS (fsLit \"S1\") s1TyConKey\nnoSelTyConName = tcQual gHC_GENERICS (fsLit \"NoSelector\") noSelTyConKey\n\nrepTyConName  = tcQual gHC_GENERICS (fsLit \"Rep\")  repTyConKey\nrep1TyConName = tcQual gHC_GENERICS (fsLit \"Rep1\") rep1TyConKey\n\nuRecTyConName      = tcQual gHC_GENERICS (fsLit \"URec\") uRecTyConKey\nuAddrTyConName     = tcQual gHC_GENERICS (fsLit \"UAddr\") uAddrTyConKey\nuCharTyConName     = tcQual gHC_GENERICS (fsLit \"UChar\") uCharTyConKey\nuDoubleTyConName   = tcQual gHC_GENERICS (fsLit \"UDouble\") uDoubleTyConKey\nuFloatTyConName    = tcQual gHC_GENERICS (fsLit \"UFloat\") uFloatTyConKey\nuIntTyConName      = tcQual gHC_GENERICS (fsLit \"UInt\") uIntTyConKey\nuWordTyConName     = tcQual gHC_GENERICS (fsLit \"UWord\") uWordTyConKey\n\nprefixIDataConName = dcQual gHC_GENERICS (fsLit \"PrefixI\")  prefixIDataConKey\ninfixIDataConName  = dcQual gHC_GENERICS (fsLit \"InfixI\")   infixIDataConKey\nleftAssociativeDataConName  = dcQual gHC_GENERICS (fsLit \"LeftAssociative\")   leftAssociativeDataConKey\nrightAssociativeDataConName = dcQual gHC_GENERICS (fsLit \"RightAssociative\")  rightAssociativeDataConKey\nnotAssociativeDataConName   = dcQual gHC_GENERICS (fsLit \"NotAssociative\")    notAssociativeDataConKey\n\nsourceUnpackDataConName         = dcQual gHC_GENERICS (fsLit \"SourceUnpack\")         sourceUnpackDataConKey\nsourceNoUnpackDataConName       = dcQual gHC_GENERICS (fsLit \"SourceNoUnpack\")       sourceNoUnpackDataConKey\nnoSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit \"NoSourceUnpackedness\") noSourceUnpackednessDataConKey\nsourceLazyDataConName           = dcQual gHC_GENERICS (fsLit \"SourceLazy\")           sourceLazyDataConKey\nsourceStrictDataConName         = dcQual gHC_GENERICS (fsLit \"SourceStrict\")         sourceStrictDataConKey\nnoSourceStrictnessDataConName   = dcQual gHC_GENERICS (fsLit \"NoSourceStrictness\")   noSourceStrictnessDataConKey\ndecidedLazyDataConName          = dcQual gHC_GENERICS (fsLit \"DecidedLazy\")          decidedLazyDataConKey\ndecidedStrictDataConName        = dcQual gHC_GENERICS (fsLit \"DecidedStrict\")        decidedStrictDataConKey\ndecidedUnpackDataConName        = dcQual gHC_GENERICS (fsLit \"DecidedUnpack\")        decidedUnpackDataConKey\n\nmetaDataDataConName  = dcQual gHC_GENERICS (fsLit \"MetaData\")  metaDataDataConKey\nmetaConsDataConName  = dcQual gHC_GENERICS (fsLit \"MetaCons\")  metaConsDataConKey\nmetaSelDataConName   = dcQual gHC_GENERICS (fsLit \"MetaSel\")   metaSelDataConKey\n\n-- Primitive Int\ndivIntName, modIntName :: Name\ndivIntName = varQual gHC_CLASSES (fsLit \"divInt#\") divIntIdKey\nmodIntName = varQual gHC_CLASSES (fsLit \"modInt#\") modIntIdKey\n\n-- Base strings Strings\nunpackCStringName, unpackCStringFoldrName,\n    unpackCStringUtf8Name, eqStringName :: Name\nunpackCStringName       = varQual gHC_CSTRING (fsLit \"unpackCString#\") unpackCStringIdKey\nunpackCStringFoldrName  = varQual gHC_CSTRING (fsLit \"unpackFoldrCString#\") unpackCStringFoldrIdKey\nunpackCStringUtf8Name   = varQual gHC_CSTRING (fsLit \"unpackCStringUtf8#\") unpackCStringUtf8IdKey\neqStringName            = varQual gHC_BASE (fsLit \"eqString\")  eqStringIdKey\n\n-- The 'inline' function\ninlineIdName :: Name\ninlineIdName            = varQual gHC_MAGIC (fsLit \"inline\") inlineIdKey\n\n-- Base classes (Eq, Ord, Functor)\nfmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name\neqClassName       = clsQual gHC_CLASSES (fsLit \"Eq\")      eqClassKey\neqName            = varQual gHC_CLASSES (fsLit \"==\")      eqClassOpKey\nordClassName      = clsQual gHC_CLASSES (fsLit \"Ord\")     ordClassKey\ngeName            = varQual gHC_CLASSES (fsLit \">=\")      geClassOpKey\nfunctorClassName  = clsQual gHC_BASE    (fsLit \"Functor\") functorClassKey\nfmapName          = varQual gHC_BASE    (fsLit \"fmap\")    fmapClassOpKey\n\n-- Class Monad\nmonadClassName, thenMName, bindMName, returnMName, failMName_preMFP :: Name\nmonadClassName     = clsQual gHC_BASE (fsLit \"Monad\")  monadClassKey\nthenMName          = varQual gHC_BASE (fsLit \">>\")     thenMClassOpKey\nbindMName          = varQual gHC_BASE (fsLit \">>=\")    bindMClassOpKey\nreturnMName        = varQual gHC_BASE (fsLit \"return\") returnMClassOpKey\nfailMName_preMFP   = varQual gHC_BASE (fsLit \"fail\")   failMClassOpKey_preMFP\n\n-- Class MonadFail\nmonadFailClassName, failMName :: Name\nmonadFailClassName = clsQual mONAD_FAIL (fsLit \"MonadFail\") monadFailClassKey\nfailMName          = varQual mONAD_FAIL (fsLit \"fail\")      failMClassOpKey\n\n-- Class Applicative\napplicativeClassName, pureAName, apAName, thenAName :: Name\napplicativeClassName = clsQual gHC_BASE (fsLit \"Applicative\") applicativeClassKey\napAName              = varQual gHC_BASE (fsLit \"<*>\")         apAClassOpKey\npureAName            = varQual gHC_BASE (fsLit \"pure\")        pureAClassOpKey\nthenAName            = varQual gHC_BASE (fsLit \"*>\")          thenAClassOpKey\n\n-- Classes (Foldable, Traversable)\nfoldableClassName, traversableClassName :: Name\nfoldableClassName     = clsQual  dATA_FOLDABLE       (fsLit \"Foldable\")    foldableClassKey\ntraversableClassName  = clsQual  dATA_TRAVERSABLE    (fsLit \"Traversable\") traversableClassKey\n\n-- Classes (Semigroup, Monoid)\nsemigroupClassName, sappendName :: Name\nsemigroupClassName = clsQual gHC_BASE       (fsLit \"Semigroup\") semigroupClassKey\nsappendName        = varQual gHC_BASE       (fsLit \"<>\")        sappendClassOpKey\nmonoidClassName, memptyName, mappendName, mconcatName :: Name\nmonoidClassName    = clsQual gHC_BASE       (fsLit \"Monoid\")    monoidClassKey\nmemptyName         = varQual gHC_BASE       (fsLit \"mempty\")    memptyClassOpKey\nmappendName        = varQual gHC_BASE       (fsLit \"mappend\")   mappendClassOpKey\nmconcatName        = varQual gHC_BASE       (fsLit \"mconcat\")   mconcatClassOpKey\n\n\n\n-- AMP additions\n\njoinMName, alternativeClassName :: Name\njoinMName            = varQual gHC_BASE (fsLit \"join\")        joinMIdKey\nalternativeClassName = clsQual mONAD (fsLit \"Alternative\") alternativeClassKey\n\n--\njoinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey,\n    alternativeClassKey :: Unique\njoinMIdKey          = mkPreludeMiscIdUnique 750\napAClassOpKey       = mkPreludeMiscIdUnique 751 -- <*>\npureAClassOpKey     = mkPreludeMiscIdUnique 752\nthenAClassOpKey     = mkPreludeMiscIdUnique 753\nalternativeClassKey = mkPreludeMiscIdUnique 754\n\n\n-- Functions for GHC extensions\ngroupWithName :: Name\ngroupWithName = varQual gHC_EXTS (fsLit \"groupWith\") groupWithIdKey\n\n-- Random PrelBase functions\nfromStringName, otherwiseIdName, foldrName, buildName, augmentName,\n    mapName, appendName, assertName,\n    breakpointName, breakpointCondName,\n    opaqueTyConName, dollarName :: Name\ndollarName        = varQual gHC_BASE (fsLit \"$\")          dollarIdKey\notherwiseIdName   = varQual gHC_BASE (fsLit \"otherwise\")  otherwiseIdKey\nfoldrName         = varQual gHC_BASE (fsLit \"foldr\")      foldrIdKey\nbuildName         = varQual gHC_BASE (fsLit \"build\")      buildIdKey\naugmentName       = varQual gHC_BASE (fsLit \"augment\")    augmentIdKey\nmapName           = varQual gHC_BASE (fsLit \"map\")        mapIdKey\nappendName        = varQual gHC_BASE (fsLit \"++\")         appendIdKey\nassertName        = varQual gHC_BASE (fsLit \"assert\")     assertIdKey\nbreakpointName    = varQual gHC_BASE (fsLit \"breakpoint\") breakpointIdKey\nbreakpointCondName= varQual gHC_BASE (fsLit \"breakpointCond\") breakpointCondIdKey\nopaqueTyConName   = tcQual  gHC_BASE (fsLit \"Opaque\")     opaqueTyConKey\nfromStringName = varQual dATA_STRING (fsLit \"fromString\") fromStringClassOpKey\n\n-- PrelTup\nfstName, sndName :: Name\nfstName           = varQual dATA_TUPLE (fsLit \"fst\") fstIdKey\nsndName           = varQual dATA_TUPLE (fsLit \"snd\") sndIdKey\n\n-- Module GHC.Num\nnumClassName, fromIntegerName, minusName, negateName :: Name\nnumClassName      = clsQual gHC_NUM (fsLit \"Num\")         numClassKey\nfromIntegerName   = varQual gHC_NUM (fsLit \"fromInteger\") fromIntegerClassOpKey\nminusName         = varQual gHC_NUM (fsLit \"-\")           minusClassOpKey\nnegateName        = varQual gHC_NUM (fsLit \"negate\")      negateClassOpKey\n\nintegerTyConName, mkIntegerName, integerSDataConName,\n    integerToWord64Name, integerToInt64Name,\n    word64ToIntegerName, int64ToIntegerName,\n    plusIntegerName, timesIntegerName, smallIntegerName,\n    wordToIntegerName,\n    integerToWordName, integerToIntName, minusIntegerName,\n    negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,\n    absIntegerName, signumIntegerName,\n    leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,\n    compareIntegerName, quotRemIntegerName, divModIntegerName,\n    quotIntegerName, remIntegerName, divIntegerName, modIntegerName,\n    floatFromIntegerName, doubleFromIntegerName,\n    encodeFloatIntegerName, encodeDoubleIntegerName,\n    decodeDoubleIntegerName,\n    gcdIntegerName, lcmIntegerName,\n    andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,\n    shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name\nintegerTyConName      = tcQual gHC_INTEGER_TYPE (fsLit \"Integer\")           integerTyConKey\nintegerSDataConName   = dcQual gHC_INTEGER_TYPE (fsLit \"S#\")                integerSDataConKey\nmkIntegerName         = varQual gHC_INTEGER_TYPE (fsLit \"mkInteger\")         mkIntegerIdKey\nintegerToWord64Name   = varQual gHC_INTEGER_TYPE (fsLit \"integerToWord64\")   integerToWord64IdKey\nintegerToInt64Name    = varQual gHC_INTEGER_TYPE (fsLit \"integerToInt64\")    integerToInt64IdKey\nword64ToIntegerName   = varQual gHC_INTEGER_TYPE (fsLit \"word64ToInteger\")   word64ToIntegerIdKey\nint64ToIntegerName    = varQual gHC_INTEGER_TYPE (fsLit \"int64ToInteger\")    int64ToIntegerIdKey\nplusIntegerName       = varQual gHC_INTEGER_TYPE (fsLit \"plusInteger\")       plusIntegerIdKey\ntimesIntegerName      = varQual gHC_INTEGER_TYPE (fsLit \"timesInteger\")      timesIntegerIdKey\nsmallIntegerName      = varQual gHC_INTEGER_TYPE (fsLit \"smallInteger\")      smallIntegerIdKey\nwordToIntegerName     = varQual gHC_INTEGER_TYPE (fsLit \"wordToInteger\")     wordToIntegerIdKey\nintegerToWordName     = varQual gHC_INTEGER_TYPE (fsLit \"integerToWord\")     integerToWordIdKey\nintegerToIntName      = varQual gHC_INTEGER_TYPE (fsLit \"integerToInt\")      integerToIntIdKey\nminusIntegerName      = varQual gHC_INTEGER_TYPE (fsLit \"minusInteger\")      minusIntegerIdKey\nnegateIntegerName     = varQual gHC_INTEGER_TYPE (fsLit \"negateInteger\")     negateIntegerIdKey\neqIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit \"eqInteger#\")        eqIntegerPrimIdKey\nneqIntegerPrimName    = varQual gHC_INTEGER_TYPE (fsLit \"neqInteger#\")       neqIntegerPrimIdKey\nabsIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"absInteger\")        absIntegerIdKey\nsignumIntegerName     = varQual gHC_INTEGER_TYPE (fsLit \"signumInteger\")     signumIntegerIdKey\nleIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit \"leInteger#\")        leIntegerPrimIdKey\ngtIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit \"gtInteger#\")        gtIntegerPrimIdKey\nltIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit \"ltInteger#\")        ltIntegerPrimIdKey\ngeIntegerPrimName     = varQual gHC_INTEGER_TYPE (fsLit \"geInteger#\")        geIntegerPrimIdKey\ncompareIntegerName    = varQual gHC_INTEGER_TYPE (fsLit \"compareInteger\")    compareIntegerIdKey\nquotRemIntegerName    = varQual gHC_INTEGER_TYPE (fsLit \"quotRemInteger\")    quotRemIntegerIdKey\ndivModIntegerName     = varQual gHC_INTEGER_TYPE (fsLit \"divModInteger\")     divModIntegerIdKey\nquotIntegerName       = varQual gHC_INTEGER_TYPE (fsLit \"quotInteger\")       quotIntegerIdKey\nremIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"remInteger\")        remIntegerIdKey\ndivIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"divInteger\")        divIntegerIdKey\nmodIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"modInteger\")        modIntegerIdKey\nfloatFromIntegerName  = varQual gHC_INTEGER_TYPE (fsLit \"floatFromInteger\")      floatFromIntegerIdKey\ndoubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit \"doubleFromInteger\")     doubleFromIntegerIdKey\nencodeFloatIntegerName  = varQual gHC_INTEGER_TYPE (fsLit \"encodeFloatInteger\")  encodeFloatIntegerIdKey\nencodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit \"encodeDoubleInteger\") encodeDoubleIntegerIdKey\ndecodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit \"decodeDoubleInteger\") decodeDoubleIntegerIdKey\ngcdIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"gcdInteger\")        gcdIntegerIdKey\nlcmIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"lcmInteger\")        lcmIntegerIdKey\nandIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"andInteger\")        andIntegerIdKey\norIntegerName         = varQual gHC_INTEGER_TYPE (fsLit \"orInteger\")         orIntegerIdKey\nxorIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"xorInteger\")        xorIntegerIdKey\ncomplementIntegerName = varQual gHC_INTEGER_TYPE (fsLit \"complementInteger\") complementIntegerIdKey\nshiftLIntegerName     = varQual gHC_INTEGER_TYPE (fsLit \"shiftLInteger\")     shiftLIntegerIdKey\nshiftRIntegerName     = varQual gHC_INTEGER_TYPE (fsLit \"shiftRInteger\")     shiftRIntegerIdKey\nbitIntegerName        = varQual gHC_INTEGER_TYPE (fsLit \"bitInteger\")        bitIntegerIdKey\n\n-- GHC.Natural types\nnaturalTyConName, naturalSDataConName :: Name\nnaturalTyConName     = tcQual gHC_NATURAL (fsLit \"Natural\") naturalTyConKey\nnaturalSDataConName  = dcQual gHC_NATURAL (fsLit \"NatS#\")   naturalSDataConKey\n\nnaturalFromIntegerName :: Name\nnaturalFromIntegerName = varQual gHC_NATURAL (fsLit \"naturalFromInteger\") naturalFromIntegerIdKey\n\nnaturalToIntegerName, plusNaturalName, minusNaturalName, timesNaturalName,\n   mkNaturalName, wordToNaturalName :: Name\nnaturalToIntegerName  = varQual gHC_NATURAL (fsLit \"naturalToInteger\")  naturalToIntegerIdKey\nplusNaturalName       = varQual gHC_NATURAL (fsLit \"plusNatural\")       plusNaturalIdKey\nminusNaturalName      = varQual gHC_NATURAL (fsLit \"minusNatural\")      minusNaturalIdKey\ntimesNaturalName      = varQual gHC_NATURAL (fsLit \"timesNatural\")      timesNaturalIdKey\nmkNaturalName         = varQual gHC_NATURAL (fsLit \"mkNatural\")         mkNaturalIdKey\nwordToNaturalName     = varQual gHC_NATURAL (fsLit \"wordToNatural#\")    wordToNaturalIdKey\n\n-- GHC.Real types and classes\nrationalTyConName, ratioTyConName, ratioDataConName, realClassName,\n    integralClassName, realFracClassName, fractionalClassName,\n    fromRationalName, toIntegerName, toRationalName, fromIntegralName,\n    realToFracName :: Name\nrationalTyConName   = tcQual  gHC_REAL (fsLit \"Rational\")     rationalTyConKey\nratioTyConName      = tcQual  gHC_REAL (fsLit \"Ratio\")        ratioTyConKey\nratioDataConName    = dcQual  gHC_REAL (fsLit \":%\")           ratioDataConKey\nrealClassName       = clsQual gHC_REAL (fsLit \"Real\")         realClassKey\nintegralClassName   = clsQual gHC_REAL (fsLit \"Integral\")     integralClassKey\nrealFracClassName   = clsQual gHC_REAL (fsLit \"RealFrac\")     realFracClassKey\nfractionalClassName = clsQual gHC_REAL (fsLit \"Fractional\")   fractionalClassKey\nfromRationalName    = varQual gHC_REAL (fsLit \"fromRational\") fromRationalClassOpKey\ntoIntegerName       = varQual gHC_REAL (fsLit \"toInteger\")    toIntegerClassOpKey\ntoRationalName      = varQual gHC_REAL (fsLit \"toRational\")   toRationalClassOpKey\nfromIntegralName    = varQual  gHC_REAL (fsLit \"fromIntegral\")fromIntegralIdKey\nrealToFracName      = varQual  gHC_REAL (fsLit \"realToFrac\")  realToFracIdKey\n\n-- PrelFloat classes\nfloatingClassName, realFloatClassName :: Name\nfloatingClassName  = clsQual gHC_FLOAT (fsLit \"Floating\")  floatingClassKey\nrealFloatClassName = clsQual gHC_FLOAT (fsLit \"RealFloat\") realFloatClassKey\n\n-- other GHC.Float functions\nrationalToFloatName, rationalToDoubleName :: Name\nrationalToFloatName  = varQual gHC_FLOAT (fsLit \"rationalToFloat\") rationalToFloatIdKey\nrationalToDoubleName = varQual gHC_FLOAT (fsLit \"rationalToDouble\") rationalToDoubleIdKey\n\n-- Class Ix\nixClassName :: Name\nixClassName = clsQual gHC_ARR (fsLit \"Ix\") ixClassKey\n\n-- Typeable representation types\ntrModuleTyConName\n  , trModuleDataConName\n  , trNameTyConName\n  , trNameSDataConName\n  , trNameDDataConName\n  , trTyConTyConName\n  , trTyConDataConName\n  :: Name\ntrModuleTyConName     = tcQual gHC_TYPES          (fsLit \"Module\")         trModuleTyConKey\ntrModuleDataConName   = dcQual gHC_TYPES          (fsLit \"Module\")         trModuleDataConKey\ntrNameTyConName       = tcQual gHC_TYPES          (fsLit \"TrName\")         trNameTyConKey\ntrNameSDataConName    = dcQual gHC_TYPES          (fsLit \"TrNameS\")        trNameSDataConKey\ntrNameDDataConName    = dcQual gHC_TYPES          (fsLit \"TrNameD\")        trNameDDataConKey\ntrTyConTyConName      = tcQual gHC_TYPES          (fsLit \"TyCon\")          trTyConTyConKey\ntrTyConDataConName    = dcQual gHC_TYPES          (fsLit \"TyCon\")          trTyConDataConKey\n\nkindRepTyConName\n  , kindRepTyConAppDataConName\n  , kindRepVarDataConName\n  , kindRepAppDataConName\n  , kindRepFunDataConName\n  , kindRepTYPEDataConName\n  , kindRepTypeLitSDataConName\n  , kindRepTypeLitDDataConName\n  :: Name\nkindRepTyConName      = tcQual gHC_TYPES          (fsLit \"KindRep\")        kindRepTyConKey\nkindRepTyConAppDataConName = dcQual gHC_TYPES     (fsLit \"KindRepTyConApp\") kindRepTyConAppDataConKey\nkindRepVarDataConName = dcQual gHC_TYPES          (fsLit \"KindRepVar\")     kindRepVarDataConKey\nkindRepAppDataConName = dcQual gHC_TYPES          (fsLit \"KindRepApp\")     kindRepAppDataConKey\nkindRepFunDataConName = dcQual gHC_TYPES          (fsLit \"KindRepFun\")     kindRepFunDataConKey\nkindRepTYPEDataConName = dcQual gHC_TYPES         (fsLit \"KindRepTYPE\")    kindRepTYPEDataConKey\nkindRepTypeLitSDataConName = dcQual gHC_TYPES     (fsLit \"KindRepTypeLitS\") kindRepTypeLitSDataConKey\nkindRepTypeLitDDataConName = dcQual gHC_TYPES     (fsLit \"KindRepTypeLitD\") kindRepTypeLitDDataConKey\n\ntypeLitSortTyConName\n  , typeLitSymbolDataConName\n  , typeLitNatDataConName\n  :: Name\ntypeLitSortTyConName     = tcQual gHC_TYPES       (fsLit \"TypeLitSort\")    typeLitSortTyConKey\ntypeLitSymbolDataConName = dcQual gHC_TYPES       (fsLit \"TypeLitSymbol\")  typeLitSymbolDataConKey\ntypeLitNatDataConName    = dcQual gHC_TYPES       (fsLit \"TypeLitNat\")     typeLitNatDataConKey\n\n-- Class Typeable, and functions for constructing `Typeable` dictionaries\ntypeableClassName\n  , typeRepTyConName\n  , someTypeRepTyConName\n  , someTypeRepDataConName\n  , mkTrTypeName\n  , mkTrConName\n  , mkTrAppName\n  , mkTrFunName\n  , typeRepIdName\n  , typeNatTypeRepName\n  , typeSymbolTypeRepName\n  , trGhcPrimModuleName\n  :: Name\ntypeableClassName     = clsQual tYPEABLE_INTERNAL (fsLit \"Typeable\")       typeableClassKey\ntypeRepTyConName      = tcQual  tYPEABLE_INTERNAL (fsLit \"TypeRep\")        typeRepTyConKey\nsomeTypeRepTyConName   = tcQual tYPEABLE_INTERNAL (fsLit \"SomeTypeRep\")    someTypeRepTyConKey\nsomeTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit \"SomeTypeRep\")    someTypeRepDataConKey\ntypeRepIdName         = varQual tYPEABLE_INTERNAL (fsLit \"typeRep#\")       typeRepIdKey\nmkTrTypeName          = varQual tYPEABLE_INTERNAL (fsLit \"mkTrType\")       mkTrTypeKey\nmkTrConName           = varQual tYPEABLE_INTERNAL (fsLit \"mkTrCon\")        mkTrConKey\nmkTrAppName           = varQual tYPEABLE_INTERNAL (fsLit \"mkTrApp\")        mkTrAppKey\nmkTrFunName           = varQual tYPEABLE_INTERNAL (fsLit \"mkTrFun\")        mkTrFunKey\ntypeNatTypeRepName    = varQual tYPEABLE_INTERNAL (fsLit \"typeNatTypeRep\") typeNatTypeRepKey\ntypeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit \"typeSymbolTypeRep\") typeSymbolTypeRepKey\n-- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)\n-- See Note [Grand plan for Typeable] in TcTypeable.\ntrGhcPrimModuleName   = varQual gHC_TYPES         (fsLit \"tr$ModuleGHCPrim\")  trGhcPrimModuleKey\n\n-- Typeable KindReps for some common cases\nstarKindRepName, starArrStarKindRepName, starArrStarArrStarKindRepName :: Name\nstarKindRepName        = varQual gHC_TYPES         (fsLit \"krep$*\")         starKindRepKey\nstarArrStarKindRepName = varQual gHC_TYPES         (fsLit \"krep$*Arr*\")     starArrStarKindRepKey\nstarArrStarArrStarKindRepName = varQual gHC_TYPES  (fsLit \"krep$*->*->*\")   starArrStarArrStarKindRepKey\n\n-- Custom type errors\nerrorMessageTypeErrorFamName\n  , typeErrorTextDataConName\n  , typeErrorAppendDataConName\n  , typeErrorVAppendDataConName\n  , typeErrorShowTypeDataConName\n  :: Name\n\nerrorMessageTypeErrorFamName =\n  tcQual gHC_TYPELITS (fsLit \"TypeError\") errorMessageTypeErrorFamKey\n\ntypeErrorTextDataConName =\n  dcQual gHC_TYPELITS (fsLit \"Text\") typeErrorTextDataConKey\n\ntypeErrorAppendDataConName =\n  dcQual gHC_TYPELITS (fsLit \":<>:\") typeErrorAppendDataConKey\n\ntypeErrorVAppendDataConName =\n  dcQual gHC_TYPELITS (fsLit \":$$:\") typeErrorVAppendDataConKey\n\ntypeErrorShowTypeDataConName =\n  dcQual gHC_TYPELITS (fsLit \"ShowType\") typeErrorShowTypeDataConKey\n\n\n\n-- Dynamic\ntoDynName :: Name\ntoDynName = varQual dYNAMIC (fsLit \"toDyn\") toDynIdKey\n\n-- Class Data\ndataClassName :: Name\ndataClassName = clsQual gENERICS (fsLit \"Data\") dataClassKey\n\n-- Error module\nassertErrorName    :: Name\nassertErrorName   = varQual gHC_IO_Exception (fsLit \"assertError\") assertErrorIdKey\n\n-- Debug.Trace\ntraceName          :: Name\ntraceName         = varQual dEBUG_TRACE (fsLit \"trace\") traceKey\n\n-- Enum module (Enum, Bounded)\nenumClassName, enumFromName, enumFromToName, enumFromThenName,\n    enumFromThenToName, boundedClassName :: Name\nenumClassName      = clsQual gHC_ENUM (fsLit \"Enum\")           enumClassKey\nenumFromName       = varQual gHC_ENUM (fsLit \"enumFrom\")       enumFromClassOpKey\nenumFromToName     = varQual gHC_ENUM (fsLit \"enumFromTo\")     enumFromToClassOpKey\nenumFromThenName   = varQual gHC_ENUM (fsLit \"enumFromThen\")   enumFromThenClassOpKey\nenumFromThenToName = varQual gHC_ENUM (fsLit \"enumFromThenTo\") enumFromThenToClassOpKey\nboundedClassName   = clsQual gHC_ENUM (fsLit \"Bounded\")        boundedClassKey\n\n-- List functions\nconcatName, filterName, zipName :: Name\nconcatName        = varQual gHC_LIST (fsLit \"concat\") concatIdKey\nfilterName        = varQual gHC_LIST (fsLit \"filter\") filterIdKey\nzipName           = varQual gHC_LIST (fsLit \"zip\")    zipIdKey\n\n-- Overloaded lists\nisListClassName, fromListName, fromListNName, toListName :: Name\nisListClassName = clsQual gHC_EXTS (fsLit \"IsList\")    isListClassKey\nfromListName    = varQual gHC_EXTS (fsLit \"fromList\")  fromListClassOpKey\nfromListNName   = varQual gHC_EXTS (fsLit \"fromListN\") fromListNClassOpKey\ntoListName      = varQual gHC_EXTS (fsLit \"toList\")    toListClassOpKey\n\n-- Class Show\nshowClassName :: Name\nshowClassName   = clsQual gHC_SHOW (fsLit \"Show\")      showClassKey\n\n-- Class Read\nreadClassName :: Name\nreadClassName   = clsQual gHC_READ (fsLit \"Read\")      readClassKey\n\n-- Classes Generic and Generic1, Datatype, Constructor and Selector\ngenClassName, gen1ClassName, datatypeClassName, constructorClassName,\n  selectorClassName :: Name\ngenClassName  = clsQual gHC_GENERICS (fsLit \"Generic\")  genClassKey\ngen1ClassName = clsQual gHC_GENERICS (fsLit \"Generic1\") gen1ClassKey\n\ndatatypeClassName    = clsQual gHC_GENERICS (fsLit \"Datatype\")    datatypeClassKey\nconstructorClassName = clsQual gHC_GENERICS (fsLit \"Constructor\") constructorClassKey\nselectorClassName    = clsQual gHC_GENERICS (fsLit \"Selector\")    selectorClassKey\n\ngenericClassNames :: [Name]\ngenericClassNames = [genClassName, gen1ClassName]\n\n-- GHCi things\nghciIoClassName, ghciStepIoMName :: Name\nghciIoClassName = clsQual gHC_GHCI (fsLit \"GHCiSandboxIO\") ghciIoClassKey\nghciStepIoMName = varQual gHC_GHCI (fsLit \"ghciStepIO\") ghciStepIoMClassOpKey\n\n-- IO things\nioTyConName, ioDataConName,\n  thenIOName, bindIOName, returnIOName, failIOName :: Name\nioTyConName       = tcQual  gHC_TYPES (fsLit \"IO\")       ioTyConKey\nioDataConName     = dcQual  gHC_TYPES (fsLit \"IO\")       ioDataConKey\nthenIOName        = varQual gHC_BASE  (fsLit \"thenIO\")   thenIOIdKey\nbindIOName        = varQual gHC_BASE  (fsLit \"bindIO\")   bindIOIdKey\nreturnIOName      = varQual gHC_BASE  (fsLit \"returnIO\") returnIOIdKey\nfailIOName        = varQual gHC_IO    (fsLit \"failIO\")   failIOIdKey\n\n-- IO things\nprintName :: Name\nprintName         = varQual sYSTEM_IO (fsLit \"print\") printIdKey\n\n-- Int, Word, and Addr things\nint8TyConName, int16TyConName, int32TyConName, int64TyConName :: Name\nint8TyConName     = tcQual gHC_INT  (fsLit \"Int8\")  int8TyConKey\nint16TyConName    = tcQual gHC_INT  (fsLit \"Int16\") int16TyConKey\nint32TyConName    = tcQual gHC_INT  (fsLit \"Int32\") int32TyConKey\nint64TyConName    = tcQual gHC_INT  (fsLit \"Int64\") int64TyConKey\n\n-- Word module\nword16TyConName, word32TyConName, word64TyConName :: Name\nword16TyConName   = tcQual  gHC_WORD (fsLit \"Word16\") word16TyConKey\nword32TyConName   = tcQual  gHC_WORD (fsLit \"Word32\") word32TyConKey\nword64TyConName   = tcQual  gHC_WORD (fsLit \"Word64\") word64TyConKey\n\n-- PrelPtr module\nptrTyConName, funPtrTyConName :: Name\nptrTyConName      = tcQual   gHC_PTR (fsLit \"Ptr\")    ptrTyConKey\nfunPtrTyConName   = tcQual   gHC_PTR (fsLit \"FunPtr\") funPtrTyConKey\n\n-- Foreign objects and weak pointers\nstablePtrTyConName, newStablePtrName :: Name\nstablePtrTyConName    = tcQual   gHC_STABLE (fsLit \"StablePtr\")    stablePtrTyConKey\nnewStablePtrName      = varQual  gHC_STABLE (fsLit \"newStablePtr\") newStablePtrIdKey\n\n-- Recursive-do notation\nmonadFixClassName, mfixName :: Name\nmonadFixClassName  = clsQual mONAD_FIX (fsLit \"MonadFix\") monadFixClassKey\nmfixName           = varQual mONAD_FIX (fsLit \"mfix\")     mfixIdKey\n\n-- Arrow notation\narrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: Name\narrAName           = varQual aRROW (fsLit \"arr\")       arrAIdKey\ncomposeAName       = varQual gHC_DESUGAR (fsLit \">>>\") composeAIdKey\nfirstAName         = varQual aRROW (fsLit \"first\")     firstAIdKey\nappAName           = varQual aRROW (fsLit \"app\")       appAIdKey\nchoiceAName        = varQual aRROW (fsLit \"|||\")       choiceAIdKey\nloopAName          = varQual aRROW (fsLit \"loop\")      loopAIdKey\n\n-- Monad comprehensions\nguardMName, liftMName, mzipName :: Name\nguardMName         = varQual mONAD (fsLit \"guard\")    guardMIdKey\nliftMName          = varQual mONAD (fsLit \"liftM\")    liftMIdKey\nmzipName           = varQual mONAD_ZIP (fsLit \"mzip\") mzipIdKey\n\n\n-- Annotation type checking\ntoAnnotationWrapperName :: Name\ntoAnnotationWrapperName = varQual gHC_DESUGAR (fsLit \"toAnnotationWrapper\") toAnnotationWrapperIdKey\n\n-- Other classes, needed for type defaulting\nmonadPlusClassName, randomClassName, randomGenClassName,\n    isStringClassName :: Name\nmonadPlusClassName  = clsQual mONAD (fsLit \"MonadPlus\")      monadPlusClassKey\nrandomClassName     = clsQual rANDOM (fsLit \"Random\")        randomClassKey\nrandomGenClassName  = clsQual rANDOM (fsLit \"RandomGen\")     randomGenClassKey\nisStringClassName   = clsQual dATA_STRING (fsLit \"IsString\") isStringClassKey\n\n-- Type-level naturals\nknownNatClassName :: Name\nknownNatClassName     = clsQual gHC_TYPENATS (fsLit \"KnownNat\") knownNatClassNameKey\nknownSymbolClassName :: Name\nknownSymbolClassName  = clsQual gHC_TYPELITS (fsLit \"KnownSymbol\") knownSymbolClassNameKey\n\n-- Overloaded labels\nisLabelClassName :: Name\nisLabelClassName\n = clsQual gHC_OVER_LABELS (fsLit \"IsLabel\") isLabelClassNameKey\n\n-- Implicit Parameters\nipClassName :: Name\nipClassName\n  = clsQual gHC_CLASSES (fsLit \"IP\") ipClassKey\n\n-- Overloaded record fields\nhasFieldClassName :: Name\nhasFieldClassName\n = clsQual gHC_RECORDS (fsLit \"HasField\") hasFieldClassNameKey\n\n-- Source Locations\ncallStackTyConName, emptyCallStackName, pushCallStackName,\n  srcLocDataConName :: Name\ncallStackTyConName\n  = tcQual gHC_STACK_TYPES  (fsLit \"CallStack\") callStackTyConKey\nemptyCallStackName\n  = varQual gHC_STACK_TYPES (fsLit \"emptyCallStack\") emptyCallStackKey\npushCallStackName\n  = varQual gHC_STACK_TYPES (fsLit \"pushCallStack\") pushCallStackKey\nsrcLocDataConName\n  = dcQual gHC_STACK_TYPES  (fsLit \"SrcLoc\")    srcLocDataConKey\n\n-- plugins\npLUGINS :: Module\npLUGINS = mkThisGhcModule (fsLit \"Plugins\")\npluginTyConName :: Name\npluginTyConName = tcQual pLUGINS (fsLit \"Plugin\") pluginTyConKey\nfrontendPluginTyConName :: Name\nfrontendPluginTyConName = tcQual pLUGINS (fsLit \"FrontendPlugin\") frontendPluginTyConKey\n\n-- Static pointers\nmakeStaticName :: Name\nmakeStaticName =\n    varQual gHC_STATICPTR_INTERNAL (fsLit \"makeStatic\") makeStaticKey\n\nstaticPtrInfoTyConName :: Name\nstaticPtrInfoTyConName =\n    tcQual gHC_STATICPTR (fsLit \"StaticPtrInfo\") staticPtrInfoTyConKey\n\nstaticPtrInfoDataConName :: Name\nstaticPtrInfoDataConName =\n    dcQual gHC_STATICPTR (fsLit \"StaticPtrInfo\") staticPtrInfoDataConKey\n\nstaticPtrTyConName :: Name\nstaticPtrTyConName =\n    tcQual gHC_STATICPTR (fsLit \"StaticPtr\") staticPtrTyConKey\n\nstaticPtrDataConName :: Name\nstaticPtrDataConName =\n    dcQual gHC_STATICPTR (fsLit \"StaticPtr\") staticPtrDataConKey\n\nfromStaticPtrName :: Name\nfromStaticPtrName =\n    varQual gHC_STATICPTR (fsLit \"fromStaticPtr\") fromStaticPtrClassOpKey\n\nfingerprintDataConName :: Name\nfingerprintDataConName =\n    dcQual gHC_FINGERPRINT_TYPE (fsLit \"Fingerprint\") fingerprintDataConKey\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Local helpers}\n*                                                                      *\n************************************************************************\n\nAll these are original names; hence mkOrig\n-}\n\nvarQual, tcQual, clsQual, dcQual :: Module -> FastString -> Unique -> Name\nvarQual  = mk_known_key_name varName\ntcQual   = mk_known_key_name tcName\nclsQual  = mk_known_key_name clsName\ndcQual   = mk_known_key_name dataName\n\nmk_known_key_name :: NameSpace -> Module -> FastString -> Unique -> Name\nmk_known_key_name space modu str unique\n  = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}\n*                                                                      *\n************************************************************************\n--MetaHaskell extension hand allocate keys here\n-}\n\nboundedClassKey, enumClassKey, eqClassKey, floatingClassKey,\n    fractionalClassKey, integralClassKey, monadClassKey, dataClassKey,\n    functorClassKey, numClassKey, ordClassKey, readClassKey, realClassKey,\n    realFloatClassKey, realFracClassKey, showClassKey, ixClassKey :: Unique\nboundedClassKey         = mkPreludeClassUnique 1\nenumClassKey            = mkPreludeClassUnique 2\neqClassKey              = mkPreludeClassUnique 3\nfloatingClassKey        = mkPreludeClassUnique 5\nfractionalClassKey      = mkPreludeClassUnique 6\nintegralClassKey        = mkPreludeClassUnique 7\nmonadClassKey           = mkPreludeClassUnique 8\ndataClassKey            = mkPreludeClassUnique 9\nfunctorClassKey         = mkPreludeClassUnique 10\nnumClassKey             = mkPreludeClassUnique 11\nordClassKey             = mkPreludeClassUnique 12\nreadClassKey            = mkPreludeClassUnique 13\nrealClassKey            = mkPreludeClassUnique 14\nrealFloatClassKey       = mkPreludeClassUnique 15\nrealFracClassKey        = mkPreludeClassUnique 16\nshowClassKey            = mkPreludeClassUnique 17\nixClassKey              = mkPreludeClassUnique 18\n\ntypeableClassKey, typeable1ClassKey, typeable2ClassKey, typeable3ClassKey,\n    typeable4ClassKey, typeable5ClassKey, typeable6ClassKey, typeable7ClassKey\n    :: Unique\ntypeableClassKey        = mkPreludeClassUnique 20\ntypeable1ClassKey       = mkPreludeClassUnique 21\ntypeable2ClassKey       = mkPreludeClassUnique 22\ntypeable3ClassKey       = mkPreludeClassUnique 23\ntypeable4ClassKey       = mkPreludeClassUnique 24\ntypeable5ClassKey       = mkPreludeClassUnique 25\ntypeable6ClassKey       = mkPreludeClassUnique 26\ntypeable7ClassKey       = mkPreludeClassUnique 27\n\nmonadFixClassKey :: Unique\nmonadFixClassKey        = mkPreludeClassUnique 28\n\nmonadFailClassKey :: Unique\nmonadFailClassKey       = mkPreludeClassUnique 29\n\nmonadPlusClassKey, randomClassKey, randomGenClassKey :: Unique\nmonadPlusClassKey       = mkPreludeClassUnique 30\nrandomClassKey          = mkPreludeClassUnique 31\nrandomGenClassKey       = mkPreludeClassUnique 32\n\nisStringClassKey :: Unique\nisStringClassKey        = mkPreludeClassUnique 33\n\napplicativeClassKey, foldableClassKey, traversableClassKey :: Unique\napplicativeClassKey     = mkPreludeClassUnique 34\nfoldableClassKey        = mkPreludeClassUnique 35\ntraversableClassKey     = mkPreludeClassUnique 36\n\ngenClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey,\n  selectorClassKey :: Unique\ngenClassKey   = mkPreludeClassUnique 37\ngen1ClassKey  = mkPreludeClassUnique 38\n\ndatatypeClassKey    = mkPreludeClassUnique 39\nconstructorClassKey = mkPreludeClassUnique 40\nselectorClassKey    = mkPreludeClassUnique 41\n\n-- KnownNat: see Note [KnowNat & KnownSymbol and EvLit] in TcEvidence\nknownNatClassNameKey :: Unique\nknownNatClassNameKey = mkPreludeClassUnique 42\n\n-- KnownSymbol: see Note [KnownNat & KnownSymbol and EvLit] in TcEvidence\nknownSymbolClassNameKey :: Unique\nknownSymbolClassNameKey = mkPreludeClassUnique 43\n\nghciIoClassKey :: Unique\nghciIoClassKey = mkPreludeClassUnique 44\n\nisLabelClassNameKey :: Unique\nisLabelClassNameKey = mkPreludeClassUnique 45\n\nsemigroupClassKey, monoidClassKey :: Unique\nsemigroupClassKey = mkPreludeClassUnique 46\nmonoidClassKey    = mkPreludeClassUnique 47\n\n-- Implicit Parameters\nipClassKey :: Unique\nipClassKey = mkPreludeClassUnique 48\n\n-- Overloaded record fields\nhasFieldClassNameKey :: Unique\nhasFieldClassNameKey = mkPreludeClassUnique 49\n\n\n---------------- Template Haskell -------------------\n--      THNames.hs: USES ClassUniques 200-299\n-----------------------------------------------------\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}\n*                                                                      *\n************************************************************************\n-}\n\naddrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey,\n    byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey,\n    doubleTyConKey, floatPrimTyConKey, floatTyConKey, funTyConKey,\n    intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey,\n    int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int32TyConKey,\n    int64PrimTyConKey, int64TyConKey,\n    integerTyConKey, naturalTyConKey,\n    listTyConKey, foreignObjPrimTyConKey, maybeTyConKey,\n    weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey,\n    mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey,\n    ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey,\n    stablePtrTyConKey, eqTyConKey, heqTyConKey,\n    smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey :: Unique\naddrPrimTyConKey                        = mkPreludeTyConUnique  1\narrayPrimTyConKey                       = mkPreludeTyConUnique  3\nboolTyConKey                            = mkPreludeTyConUnique  4\nbyteArrayPrimTyConKey                   = mkPreludeTyConUnique  5\ncharPrimTyConKey                        = mkPreludeTyConUnique  7\ncharTyConKey                            = mkPreludeTyConUnique  8\ndoublePrimTyConKey                      = mkPreludeTyConUnique  9\ndoubleTyConKey                          = mkPreludeTyConUnique 10\nfloatPrimTyConKey                       = mkPreludeTyConUnique 11\nfloatTyConKey                           = mkPreludeTyConUnique 12\nfunTyConKey                             = mkPreludeTyConUnique 13\nintPrimTyConKey                         = mkPreludeTyConUnique 14\nintTyConKey                             = mkPreludeTyConUnique 15\nint8PrimTyConKey                        = mkPreludeTyConUnique 16\nint8TyConKey                            = mkPreludeTyConUnique 17\nint16PrimTyConKey                       = mkPreludeTyConUnique 18\nint16TyConKey                           = mkPreludeTyConUnique 19\nint32PrimTyConKey                       = mkPreludeTyConUnique 20\nint32TyConKey                           = mkPreludeTyConUnique 21\nint64PrimTyConKey                       = mkPreludeTyConUnique 22\nint64TyConKey                           = mkPreludeTyConUnique 23\nintegerTyConKey                         = mkPreludeTyConUnique 24\nnaturalTyConKey                         = mkPreludeTyConUnique 25\n\nlistTyConKey                            = mkPreludeTyConUnique 26\nforeignObjPrimTyConKey                  = mkPreludeTyConUnique 27\nmaybeTyConKey                           = mkPreludeTyConUnique 28\nweakPrimTyConKey                        = mkPreludeTyConUnique 29\nmutableArrayPrimTyConKey                = mkPreludeTyConUnique 30\nmutableByteArrayPrimTyConKey            = mkPreludeTyConUnique 31\norderingTyConKey                        = mkPreludeTyConUnique 32\nmVarPrimTyConKey                        = mkPreludeTyConUnique 33\nratioTyConKey                           = mkPreludeTyConUnique 34\nrationalTyConKey                        = mkPreludeTyConUnique 35\nrealWorldTyConKey                       = mkPreludeTyConUnique 36\nstablePtrPrimTyConKey                   = mkPreludeTyConUnique 37\nstablePtrTyConKey                       = mkPreludeTyConUnique 38\neqTyConKey                              = mkPreludeTyConUnique 40\nheqTyConKey                             = mkPreludeTyConUnique 41\narrayArrayPrimTyConKey                  = mkPreludeTyConUnique 42\nmutableArrayArrayPrimTyConKey           = mkPreludeTyConUnique 43\n\nstatePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,\n    mutVarPrimTyConKey, ioTyConKey,\n    wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey,\n    word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey,\n    word64PrimTyConKey, word64TyConKey,\n    liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey,\n    typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey,\n    funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,\n    eqReprPrimTyConKey, eqPhantPrimTyConKey, voidPrimTyConKey,\n    compactPrimTyConKey :: Unique\nstatePrimTyConKey                       = mkPreludeTyConUnique 50\nstableNamePrimTyConKey                  = mkPreludeTyConUnique 51\nstableNameTyConKey                      = mkPreludeTyConUnique 52\neqPrimTyConKey                          = mkPreludeTyConUnique 53\neqReprPrimTyConKey                      = mkPreludeTyConUnique 54\neqPhantPrimTyConKey                     = mkPreludeTyConUnique 55\nmutVarPrimTyConKey                      = mkPreludeTyConUnique 56\nioTyConKey                              = mkPreludeTyConUnique 57\nvoidPrimTyConKey                        = mkPreludeTyConUnique 58\nwordPrimTyConKey                        = mkPreludeTyConUnique 59\nwordTyConKey                            = mkPreludeTyConUnique 60\nword8PrimTyConKey                       = mkPreludeTyConUnique 61\nword8TyConKey                           = mkPreludeTyConUnique 62\nword16PrimTyConKey                      = mkPreludeTyConUnique 63\nword16TyConKey                          = mkPreludeTyConUnique 64\nword32PrimTyConKey                      = mkPreludeTyConUnique 65\nword32TyConKey                          = mkPreludeTyConUnique 66\nword64PrimTyConKey                      = mkPreludeTyConUnique 67\nword64TyConKey                          = mkPreludeTyConUnique 68\nliftedConKey                            = mkPreludeTyConUnique 69\nunliftedConKey                          = mkPreludeTyConUnique 70\nanyBoxConKey                            = mkPreludeTyConUnique 71\nkindConKey                              = mkPreludeTyConUnique 72\nboxityConKey                            = mkPreludeTyConUnique 73\ntypeConKey                              = mkPreludeTyConUnique 74\nthreadIdPrimTyConKey                    = mkPreludeTyConUnique 75\nbcoPrimTyConKey                         = mkPreludeTyConUnique 76\nptrTyConKey                             = mkPreludeTyConUnique 77\nfunPtrTyConKey                          = mkPreludeTyConUnique 78\ntVarPrimTyConKey                        = mkPreludeTyConUnique 79\ncompactPrimTyConKey                     = mkPreludeTyConUnique 80\n\n-- dotnet interop\nobjectTyConKey :: Unique\nobjectTyConKey                          = mkPreludeTyConUnique 83\n\neitherTyConKey :: Unique\neitherTyConKey                          = mkPreludeTyConUnique 84\n\n-- Kind constructors\nliftedTypeKindTyConKey, tYPETyConKey,\n  constraintKindTyConKey, runtimeRepTyConKey,\n  vecCountTyConKey, vecElemTyConKey :: Unique\nliftedTypeKindTyConKey                  = mkPreludeTyConUnique 87\ntYPETyConKey                            = mkPreludeTyConUnique 88\nconstraintKindTyConKey                  = mkPreludeTyConUnique 92\nruntimeRepTyConKey                      = mkPreludeTyConUnique 95\nvecCountTyConKey                        = mkPreludeTyConUnique 96\nvecElemTyConKey                         = mkPreludeTyConUnique 97\n\npluginTyConKey, frontendPluginTyConKey :: Unique\npluginTyConKey                          = mkPreludeTyConUnique 102\nfrontendPluginTyConKey                  = mkPreludeTyConUnique 103\n\nunknownTyConKey, unknown1TyConKey, unknown2TyConKey, unknown3TyConKey,\n    opaqueTyConKey :: Unique\nunknownTyConKey                         = mkPreludeTyConUnique 129\nunknown1TyConKey                        = mkPreludeTyConUnique 130\nunknown2TyConKey                        = mkPreludeTyConUnique 131\nunknown3TyConKey                        = mkPreludeTyConUnique 132\nopaqueTyConKey                          = mkPreludeTyConUnique 133\n\n-- Generics (Unique keys)\nv1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,\n  k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey,\n  compTyConKey, rTyConKey, dTyConKey,\n  cTyConKey, sTyConKey, rec0TyConKey,\n  d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey,\n  repTyConKey, rep1TyConKey, uRecTyConKey,\n  uAddrTyConKey, uCharTyConKey, uDoubleTyConKey,\n  uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique\n\nv1TyConKey    = mkPreludeTyConUnique 135\nu1TyConKey    = mkPreludeTyConUnique 136\npar1TyConKey  = mkPreludeTyConUnique 137\nrec1TyConKey  = mkPreludeTyConUnique 138\nk1TyConKey    = mkPreludeTyConUnique 139\nm1TyConKey    = mkPreludeTyConUnique 140\n\nsumTyConKey   = mkPreludeTyConUnique 141\nprodTyConKey  = mkPreludeTyConUnique 142\ncompTyConKey  = mkPreludeTyConUnique 143\n\nrTyConKey = mkPreludeTyConUnique 144\ndTyConKey = mkPreludeTyConUnique 146\ncTyConKey = mkPreludeTyConUnique 147\nsTyConKey = mkPreludeTyConUnique 148\n\nrec0TyConKey  = mkPreludeTyConUnique 149\nd1TyConKey    = mkPreludeTyConUnique 151\nc1TyConKey    = mkPreludeTyConUnique 152\ns1TyConKey    = mkPreludeTyConUnique 153\nnoSelTyConKey = mkPreludeTyConUnique 154\n\nrepTyConKey  = mkPreludeTyConUnique 155\nrep1TyConKey = mkPreludeTyConUnique 156\n\nuRecTyConKey    = mkPreludeTyConUnique 157\nuAddrTyConKey   = mkPreludeTyConUnique 158\nuCharTyConKey   = mkPreludeTyConUnique 159\nuDoubleTyConKey = mkPreludeTyConUnique 160\nuFloatTyConKey  = mkPreludeTyConUnique 161\nuIntTyConKey    = mkPreludeTyConUnique 162\nuWordTyConKey   = mkPreludeTyConUnique 163\n\n-- Type-level naturals\ntypeNatKindConNameKey, typeSymbolKindConNameKey,\n  typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey,\n  typeNatLeqTyFamNameKey, typeNatSubTyFamNameKey\n  , typeSymbolCmpTyFamNameKey, typeNatCmpTyFamNameKey\n  , typeNatDivTyFamNameKey\n  , typeNatModTyFamNameKey\n  , typeNatLogTyFamNameKey\n  :: Unique\ntypeNatKindConNameKey     = mkPreludeTyConUnique 164\ntypeSymbolKindConNameKey  = mkPreludeTyConUnique 165\ntypeNatAddTyFamNameKey    = mkPreludeTyConUnique 166\ntypeNatMulTyFamNameKey    = mkPreludeTyConUnique 167\ntypeNatExpTyFamNameKey    = mkPreludeTyConUnique 168\ntypeNatLeqTyFamNameKey    = mkPreludeTyConUnique 169\ntypeNatSubTyFamNameKey    = mkPreludeTyConUnique 170\ntypeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 171\ntypeNatCmpTyFamNameKey    = mkPreludeTyConUnique 172\ntypeNatDivTyFamNameKey  = mkPreludeTyConUnique 173\ntypeNatModTyFamNameKey  = mkPreludeTyConUnique 174\ntypeNatLogTyFamNameKey  = mkPreludeTyConUnique 175\n\n-- Custom user type-errors\nerrorMessageTypeErrorFamKey :: Unique\nerrorMessageTypeErrorFamKey =  mkPreludeTyConUnique 176\n\n\n\nntTyConKey:: Unique\nntTyConKey = mkPreludeTyConUnique 177\ncoercibleTyConKey :: Unique\ncoercibleTyConKey = mkPreludeTyConUnique 178\n\nproxyPrimTyConKey :: Unique\nproxyPrimTyConKey = mkPreludeTyConUnique 179\n\nspecTyConKey :: Unique\nspecTyConKey = mkPreludeTyConUnique 180\n\nanyTyConKey :: Unique\nanyTyConKey = mkPreludeTyConUnique 181\n\nsmallArrayPrimTyConKey        = mkPreludeTyConUnique  182\nsmallMutableArrayPrimTyConKey = mkPreludeTyConUnique  183\n\nstaticPtrTyConKey  :: Unique\nstaticPtrTyConKey  = mkPreludeTyConUnique 184\n\nstaticPtrInfoTyConKey :: Unique\nstaticPtrInfoTyConKey = mkPreludeTyConUnique 185\n\ncallStackTyConKey :: Unique\ncallStackTyConKey = mkPreludeTyConUnique 186\n\n-- Typeables\ntypeRepTyConKey, someTypeRepTyConKey, someTypeRepDataConKey :: Unique\ntypeRepTyConKey       = mkPreludeTyConUnique 187\nsomeTypeRepTyConKey   = mkPreludeTyConUnique 188\nsomeTypeRepDataConKey = mkPreludeTyConUnique 189\n\n\ntypeSymbolAppendFamNameKey :: Unique\ntypeSymbolAppendFamNameKey = mkPreludeTyConUnique 190\n\n---------------- Template Haskell -------------------\n--      THNames.hs: USES TyConUniques 200-299\n-----------------------------------------------------\n\n----------------------- SIMD ------------------------\n--      USES TyConUniques 300-399\n-----------------------------------------------------\n\n#include \"primop-vector-uniques.hs-incl\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}\n*                                                                      *\n************************************************************************\n-}\n\ncharDataConKey, consDataConKey, doubleDataConKey, falseDataConKey,\n    floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey,\n    ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey,\n    word8DataConKey, ioDataConKey, integerDataConKey, heqDataConKey,\n    coercibleDataConKey, eqDataConKey, nothingDataConKey, justDataConKey :: Unique\n\ncharDataConKey                          = mkPreludeDataConUnique  1\nconsDataConKey                          = mkPreludeDataConUnique  2\ndoubleDataConKey                        = mkPreludeDataConUnique  3\nfalseDataConKey                         = mkPreludeDataConUnique  4\nfloatDataConKey                         = mkPreludeDataConUnique  5\nintDataConKey                           = mkPreludeDataConUnique  6\nintegerSDataConKey                      = mkPreludeDataConUnique  7\nnothingDataConKey                       = mkPreludeDataConUnique  8\njustDataConKey                          = mkPreludeDataConUnique  9\neqDataConKey                            = mkPreludeDataConUnique 10\nnilDataConKey                           = mkPreludeDataConUnique 11\nratioDataConKey                         = mkPreludeDataConUnique 12\nword8DataConKey                         = mkPreludeDataConUnique 13\nstableNameDataConKey                    = mkPreludeDataConUnique 14\ntrueDataConKey                          = mkPreludeDataConUnique 15\nwordDataConKey                          = mkPreludeDataConUnique 16\nioDataConKey                            = mkPreludeDataConUnique 17\nintegerDataConKey                       = mkPreludeDataConUnique 18\nheqDataConKey                           = mkPreludeDataConUnique 19\n\n-- Generic data constructors\ncrossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: Unique\ncrossDataConKey                         = mkPreludeDataConUnique 20\ninlDataConKey                           = mkPreludeDataConUnique 21\ninrDataConKey                           = mkPreludeDataConUnique 22\ngenUnitDataConKey                       = mkPreludeDataConUnique 23\n\nleftDataConKey, rightDataConKey :: Unique\nleftDataConKey                          = mkPreludeDataConUnique 25\nrightDataConKey                         = mkPreludeDataConUnique 26\n\nordLTDataConKey, ordEQDataConKey, ordGTDataConKey :: Unique\nordLTDataConKey                         = mkPreludeDataConUnique 27\nordEQDataConKey                         = mkPreludeDataConUnique 28\nordGTDataConKey                         = mkPreludeDataConUnique 29\n\n\ncoercibleDataConKey                     = mkPreludeDataConUnique 32\n\nstaticPtrDataConKey :: Unique\nstaticPtrDataConKey                     = mkPreludeDataConUnique 33\n\nstaticPtrInfoDataConKey :: Unique\nstaticPtrInfoDataConKey                 = mkPreludeDataConUnique 34\n\nfingerprintDataConKey :: Unique\nfingerprintDataConKey                   = mkPreludeDataConUnique 35\n\nsrcLocDataConKey :: Unique\nsrcLocDataConKey                        = mkPreludeDataConUnique 37\n\ntrTyConTyConKey, trTyConDataConKey,\n  trModuleTyConKey, trModuleDataConKey,\n  trNameTyConKey, trNameSDataConKey, trNameDDataConKey,\n  trGhcPrimModuleKey, kindRepTyConKey,\n  typeLitSortTyConKey :: Unique\ntrTyConTyConKey                         = mkPreludeDataConUnique 40\ntrTyConDataConKey                       = mkPreludeDataConUnique 41\ntrModuleTyConKey                        = mkPreludeDataConUnique 42\ntrModuleDataConKey                      = mkPreludeDataConUnique 43\ntrNameTyConKey                          = mkPreludeDataConUnique 44\ntrNameSDataConKey                       = mkPreludeDataConUnique 45\ntrNameDDataConKey                       = mkPreludeDataConUnique 46\ntrGhcPrimModuleKey                      = mkPreludeDataConUnique 47\nkindRepTyConKey                         = mkPreludeDataConUnique 48\ntypeLitSortTyConKey                     = mkPreludeDataConUnique 49\n\ntypeErrorTextDataConKey,\n  typeErrorAppendDataConKey,\n  typeErrorVAppendDataConKey,\n  typeErrorShowTypeDataConKey\n  :: Unique\ntypeErrorTextDataConKey                 = mkPreludeDataConUnique 50\ntypeErrorAppendDataConKey               = mkPreludeDataConUnique 51\ntypeErrorVAppendDataConKey              = mkPreludeDataConUnique 52\ntypeErrorShowTypeDataConKey             = mkPreludeDataConUnique 53\n\nprefixIDataConKey, infixIDataConKey, leftAssociativeDataConKey,\n    rightAssociativeDataConKey, notAssociativeDataConKey,\n    sourceUnpackDataConKey, sourceNoUnpackDataConKey,\n    noSourceUnpackednessDataConKey, sourceLazyDataConKey,\n    sourceStrictDataConKey, noSourceStrictnessDataConKey,\n    decidedLazyDataConKey, decidedStrictDataConKey, decidedUnpackDataConKey,\n    metaDataDataConKey, metaConsDataConKey, metaSelDataConKey :: Unique\nprefixIDataConKey                       = mkPreludeDataConUnique 54\ninfixIDataConKey                        = mkPreludeDataConUnique 55\nleftAssociativeDataConKey               = mkPreludeDataConUnique 56\nrightAssociativeDataConKey              = mkPreludeDataConUnique 57\nnotAssociativeDataConKey                = mkPreludeDataConUnique 58\nsourceUnpackDataConKey                  = mkPreludeDataConUnique 59\nsourceNoUnpackDataConKey                = mkPreludeDataConUnique 60\nnoSourceUnpackednessDataConKey          = mkPreludeDataConUnique 61\nsourceLazyDataConKey                    = mkPreludeDataConUnique 62\nsourceStrictDataConKey                  = mkPreludeDataConUnique 63\nnoSourceStrictnessDataConKey            = mkPreludeDataConUnique 64\ndecidedLazyDataConKey                   = mkPreludeDataConUnique 65\ndecidedStrictDataConKey                 = mkPreludeDataConUnique 66\ndecidedUnpackDataConKey                 = mkPreludeDataConUnique 67\nmetaDataDataConKey                      = mkPreludeDataConUnique 68\nmetaConsDataConKey                      = mkPreludeDataConUnique 69\nmetaSelDataConKey                       = mkPreludeDataConUnique 70\n\nvecRepDataConKey, tupleRepDataConKey, sumRepDataConKey :: Unique\nvecRepDataConKey                        = mkPreludeDataConUnique 71\ntupleRepDataConKey                      = mkPreludeDataConUnique 72\nsumRepDataConKey                        = mkPreludeDataConUnique 73\n\n-- See Note [Wiring in RuntimeRep] in TysWiredIn\nruntimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique]\nliftedRepDataConKey :: Unique\nruntimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys)\n  = map mkPreludeDataConUnique [74..86]\n\nunliftedRepDataConKeys = vecRepDataConKey :\n                         tupleRepDataConKey :\n                         sumRepDataConKey :\n                         unliftedSimpleRepDataConKeys\n\n-- See Note [Wiring in RuntimeRep] in TysWiredIn\n-- VecCount\nvecCountDataConKeys :: [Unique]\nvecCountDataConKeys = map mkPreludeDataConUnique [87..92]\n\n-- See Note [Wiring in RuntimeRep] in TysWiredIn\n-- VecElem\nvecElemDataConKeys :: [Unique]\nvecElemDataConKeys = map mkPreludeDataConUnique [93..102]\n\n-- Typeable things\nkindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,\n    kindRepFunDataConKey, kindRepTYPEDataConKey,\n    kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey\n    :: Unique\nkindRepTyConAppDataConKey = mkPreludeDataConUnique 103\nkindRepVarDataConKey      = mkPreludeDataConUnique 104\nkindRepAppDataConKey      = mkPreludeDataConUnique 105\nkindRepFunDataConKey      = mkPreludeDataConUnique 106\nkindRepTYPEDataConKey     = mkPreludeDataConUnique 107\nkindRepTypeLitSDataConKey = mkPreludeDataConUnique 108\nkindRepTypeLitDDataConKey = mkPreludeDataConUnique 109\n\ntypeLitSymbolDataConKey, typeLitNatDataConKey :: Unique\ntypeLitSymbolDataConKey   = mkPreludeDataConUnique 110\ntypeLitNatDataConKey      = mkPreludeDataConUnique 111\n\n\n---------------- Template Haskell -------------------\n--      THNames.hs: USES DataUniques 200-250\n-----------------------------------------------------\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}\n*                                                                      *\n************************************************************************\n-}\n\nwildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey,\n    buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey,\n    seqIdKey, eqStringIdKey,\n    noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey,\n    runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey,\n    realWorldPrimIdKey, recConErrorIdKey,\n    unpackCStringUtf8IdKey, unpackCStringAppendIdKey,\n    unpackCStringFoldrIdKey, unpackCStringIdKey,\n    typeErrorIdKey, divIntIdKey, modIntIdKey,\n    absentSumFieldErrorIdKey :: Unique\n\nwildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard binders]\nabsentErrorIdKey              = mkPreludeMiscIdUnique  1\naugmentIdKey                  = mkPreludeMiscIdUnique  2\nappendIdKey                   = mkPreludeMiscIdUnique  3\nbuildIdKey                    = mkPreludeMiscIdUnique  4\nerrorIdKey                    = mkPreludeMiscIdUnique  5\nfoldrIdKey                    = mkPreludeMiscIdUnique  6\nrecSelErrorIdKey              = mkPreludeMiscIdUnique  7\nseqIdKey                      = mkPreludeMiscIdUnique  8\neqStringIdKey                 = mkPreludeMiscIdUnique 10\nnoMethodBindingErrorIdKey     = mkPreludeMiscIdUnique 11\nnonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 12\nruntimeErrorIdKey             = mkPreludeMiscIdUnique 13\npatErrorIdKey                 = mkPreludeMiscIdUnique 14\nrealWorldPrimIdKey            = mkPreludeMiscIdUnique 15\nrecConErrorIdKey              = mkPreludeMiscIdUnique 16\nunpackCStringUtf8IdKey        = mkPreludeMiscIdUnique 17\nunpackCStringAppendIdKey      = mkPreludeMiscIdUnique 18\nunpackCStringFoldrIdKey       = mkPreludeMiscIdUnique 19\nunpackCStringIdKey            = mkPreludeMiscIdUnique 20\nvoidPrimIdKey                 = mkPreludeMiscIdUnique 21\ntypeErrorIdKey                = mkPreludeMiscIdUnique 22\ndivIntIdKey                   = mkPreludeMiscIdUnique 23\nmodIntIdKey                   = mkPreludeMiscIdUnique 24\nabsentSumFieldErrorIdKey      = mkPreludeMiscIdUnique 9\n\nunsafeCoerceIdKey, concatIdKey, filterIdKey, zipIdKey, bindIOIdKey,\n    returnIOIdKey, newStablePtrIdKey,\n    printIdKey, failIOIdKey, nullAddrIdKey, voidArgIdKey,\n    fstIdKey, sndIdKey, otherwiseIdKey, assertIdKey :: Unique\nunsafeCoerceIdKey             = mkPreludeMiscIdUnique 30\nconcatIdKey                   = mkPreludeMiscIdUnique 31\nfilterIdKey                   = mkPreludeMiscIdUnique 32\nzipIdKey                      = mkPreludeMiscIdUnique 33\nbindIOIdKey                   = mkPreludeMiscIdUnique 34\nreturnIOIdKey                 = mkPreludeMiscIdUnique 35\nnewStablePtrIdKey             = mkPreludeMiscIdUnique 36\nprintIdKey                    = mkPreludeMiscIdUnique 37\nfailIOIdKey                   = mkPreludeMiscIdUnique 38\nnullAddrIdKey                 = mkPreludeMiscIdUnique 39\nvoidArgIdKey                  = mkPreludeMiscIdUnique 40\nfstIdKey                      = mkPreludeMiscIdUnique 41\nsndIdKey                      = mkPreludeMiscIdUnique 42\notherwiseIdKey                = mkPreludeMiscIdUnique 43\nassertIdKey                   = mkPreludeMiscIdUnique 44\n\nmkIntegerIdKey, smallIntegerIdKey, wordToIntegerIdKey,\n    integerToWordIdKey, integerToIntIdKey,\n    integerToWord64IdKey, integerToInt64IdKey,\n    word64ToIntegerIdKey, int64ToIntegerIdKey,\n    plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey,\n    negateIntegerIdKey,\n    eqIntegerPrimIdKey, neqIntegerPrimIdKey, absIntegerIdKey, signumIntegerIdKey,\n    leIntegerPrimIdKey, gtIntegerPrimIdKey, ltIntegerPrimIdKey, geIntegerPrimIdKey,\n    compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,\n    quotIntegerIdKey, remIntegerIdKey, divIntegerIdKey, modIntegerIdKey,\n    floatFromIntegerIdKey, doubleFromIntegerIdKey,\n    encodeFloatIntegerIdKey, encodeDoubleIntegerIdKey,\n    decodeDoubleIntegerIdKey,\n    gcdIntegerIdKey, lcmIntegerIdKey,\n    andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,\n    shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique\nmkIntegerIdKey                = mkPreludeMiscIdUnique 60\nsmallIntegerIdKey             = mkPreludeMiscIdUnique 61\nintegerToWordIdKey            = mkPreludeMiscIdUnique 62\nintegerToIntIdKey             = mkPreludeMiscIdUnique 63\nintegerToWord64IdKey          = mkPreludeMiscIdUnique 64\nintegerToInt64IdKey           = mkPreludeMiscIdUnique 65\nplusIntegerIdKey              = mkPreludeMiscIdUnique 66\ntimesIntegerIdKey             = mkPreludeMiscIdUnique 67\nminusIntegerIdKey             = mkPreludeMiscIdUnique 68\nnegateIntegerIdKey            = mkPreludeMiscIdUnique 69\neqIntegerPrimIdKey            = mkPreludeMiscIdUnique 70\nneqIntegerPrimIdKey           = mkPreludeMiscIdUnique 71\nabsIntegerIdKey               = mkPreludeMiscIdUnique 72\nsignumIntegerIdKey            = mkPreludeMiscIdUnique 73\nleIntegerPrimIdKey            = mkPreludeMiscIdUnique 74\ngtIntegerPrimIdKey            = mkPreludeMiscIdUnique 75\nltIntegerPrimIdKey            = mkPreludeMiscIdUnique 76\ngeIntegerPrimIdKey            = mkPreludeMiscIdUnique 77\ncompareIntegerIdKey           = mkPreludeMiscIdUnique 78\nquotIntegerIdKey              = mkPreludeMiscIdUnique 79\nremIntegerIdKey               = mkPreludeMiscIdUnique 80\ndivIntegerIdKey               = mkPreludeMiscIdUnique 81\nmodIntegerIdKey               = mkPreludeMiscIdUnique 82\ndivModIntegerIdKey            = mkPreludeMiscIdUnique 83\nquotRemIntegerIdKey           = mkPreludeMiscIdUnique 84\nfloatFromIntegerIdKey         = mkPreludeMiscIdUnique 85\ndoubleFromIntegerIdKey        = mkPreludeMiscIdUnique 86\nencodeFloatIntegerIdKey       = mkPreludeMiscIdUnique 87\nencodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 88\ngcdIntegerIdKey               = mkPreludeMiscIdUnique 89\nlcmIntegerIdKey               = mkPreludeMiscIdUnique 90\nandIntegerIdKey               = mkPreludeMiscIdUnique 91\norIntegerIdKey                = mkPreludeMiscIdUnique 92\nxorIntegerIdKey               = mkPreludeMiscIdUnique 93\ncomplementIntegerIdKey        = mkPreludeMiscIdUnique 94\nshiftLIntegerIdKey            = mkPreludeMiscIdUnique 95\nshiftRIntegerIdKey            = mkPreludeMiscIdUnique 96\nwordToIntegerIdKey            = mkPreludeMiscIdUnique 97\nword64ToIntegerIdKey          = mkPreludeMiscIdUnique 98\nint64ToIntegerIdKey           = mkPreludeMiscIdUnique 99\ndecodeDoubleIntegerIdKey      = mkPreludeMiscIdUnique 100\n\nrootMainKey, runMainKey :: Unique\nrootMainKey                   = mkPreludeMiscIdUnique 101\nrunMainKey                    = mkPreludeMiscIdUnique 102\n\nthenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique\nthenIOIdKey                   = mkPreludeMiscIdUnique 103\nlazyIdKey                     = mkPreludeMiscIdUnique 104\nassertErrorIdKey              = mkPreludeMiscIdUnique 105\noneShotKey                    = mkPreludeMiscIdUnique 106\nrunRWKey                      = mkPreludeMiscIdUnique 107\n\ntraceKey :: Unique\ntraceKey                      = mkPreludeMiscIdUnique 108\n\nbreakpointIdKey, breakpointCondIdKey :: Unique\nbreakpointIdKey               = mkPreludeMiscIdUnique 110\nbreakpointCondIdKey           = mkPreludeMiscIdUnique 111\n\ninlineIdKey, noinlineIdKey :: Unique\ninlineIdKey                   = mkPreludeMiscIdUnique 120\n-- see below\n\nmapIdKey, groupWithIdKey, dollarIdKey :: Unique\nmapIdKey              = mkPreludeMiscIdUnique 121\ngroupWithIdKey        = mkPreludeMiscIdUnique 122\ndollarIdKey           = mkPreludeMiscIdUnique 123\n\ncoercionTokenIdKey :: Unique\ncoercionTokenIdKey    = mkPreludeMiscIdUnique 124\n\nnoinlineIdKey                 = mkPreludeMiscIdUnique 125\n\nrationalToFloatIdKey, rationalToDoubleIdKey :: Unique\nrationalToFloatIdKey   = mkPreludeMiscIdUnique 130\nrationalToDoubleIdKey  = mkPreludeMiscIdUnique 131\n\n-- dotnet interop\nunmarshalObjectIdKey, marshalObjectIdKey, marshalStringIdKey,\n    unmarshalStringIdKey, checkDotnetResNameIdKey :: Unique\nunmarshalObjectIdKey          = mkPreludeMiscIdUnique 150\nmarshalObjectIdKey            = mkPreludeMiscIdUnique 151\nmarshalStringIdKey            = mkPreludeMiscIdUnique 152\nunmarshalStringIdKey          = mkPreludeMiscIdUnique 153\ncheckDotnetResNameIdKey       = mkPreludeMiscIdUnique 154\n\nundefinedKey :: Unique\nundefinedKey                  = mkPreludeMiscIdUnique 155\n\nmagicDictKey :: Unique\nmagicDictKey                  = mkPreludeMiscIdUnique 156\n\ncoerceKey :: Unique\ncoerceKey                     = mkPreludeMiscIdUnique 157\n\n{-\nCertain class operations from Prelude classes.  They get their own\nuniques so we can look them up easily when we want to conjure them up\nduring type checking.\n-}\n\n-- Just a placeholder for unbound variables produced by the renamer:\nunboundKey :: Unique\nunboundKey                    = mkPreludeMiscIdUnique 158\n\nfromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey,\n    enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey,\n    enumFromThenToClassOpKey, eqClassOpKey, geClassOpKey, negateClassOpKey,\n    failMClassOpKey_preMFP, bindMClassOpKey, thenMClassOpKey, returnMClassOpKey,\n    fmapClassOpKey\n    :: Unique\nfromIntegerClassOpKey         = mkPreludeMiscIdUnique 160\nminusClassOpKey               = mkPreludeMiscIdUnique 161\nfromRationalClassOpKey        = mkPreludeMiscIdUnique 162\nenumFromClassOpKey            = mkPreludeMiscIdUnique 163\nenumFromThenClassOpKey        = mkPreludeMiscIdUnique 164\nenumFromToClassOpKey          = mkPreludeMiscIdUnique 165\nenumFromThenToClassOpKey      = mkPreludeMiscIdUnique 166\neqClassOpKey                  = mkPreludeMiscIdUnique 167\ngeClassOpKey                  = mkPreludeMiscIdUnique 168\nnegateClassOpKey              = mkPreludeMiscIdUnique 169\nfailMClassOpKey_preMFP        = mkPreludeMiscIdUnique 170\nbindMClassOpKey               = mkPreludeMiscIdUnique 171 -- (>>=)\nthenMClassOpKey               = mkPreludeMiscIdUnique 172 -- (>>)\nfmapClassOpKey                = mkPreludeMiscIdUnique 173\nreturnMClassOpKey             = mkPreludeMiscIdUnique 174\n\n-- Recursive do notation\nmfixIdKey :: Unique\nmfixIdKey       = mkPreludeMiscIdUnique 175\n\n-- MonadFail operations\nfailMClassOpKey :: Unique\nfailMClassOpKey = mkPreludeMiscIdUnique 176\n\n-- Arrow notation\narrAIdKey, composeAIdKey, firstAIdKey, appAIdKey, choiceAIdKey,\n    loopAIdKey :: Unique\narrAIdKey       = mkPreludeMiscIdUnique 180\ncomposeAIdKey   = mkPreludeMiscIdUnique 181 -- >>>\nfirstAIdKey     = mkPreludeMiscIdUnique 182\nappAIdKey       = mkPreludeMiscIdUnique 183\nchoiceAIdKey    = mkPreludeMiscIdUnique 184 --  |||\nloopAIdKey      = mkPreludeMiscIdUnique 185\n\nfromStringClassOpKey :: Unique\nfromStringClassOpKey          = mkPreludeMiscIdUnique 186\n\n-- Annotation type checking\ntoAnnotationWrapperIdKey :: Unique\ntoAnnotationWrapperIdKey      = mkPreludeMiscIdUnique 187\n\n-- Conversion functions\nfromIntegralIdKey, realToFracIdKey, toIntegerClassOpKey, toRationalClassOpKey :: Unique\nfromIntegralIdKey    = mkPreludeMiscIdUnique 190\nrealToFracIdKey      = mkPreludeMiscIdUnique 191\ntoIntegerClassOpKey  = mkPreludeMiscIdUnique 192\ntoRationalClassOpKey = mkPreludeMiscIdUnique 193\n\n-- Monad comprehensions\nguardMIdKey, liftMIdKey, mzipIdKey :: Unique\nguardMIdKey     = mkPreludeMiscIdUnique 194\nliftMIdKey      = mkPreludeMiscIdUnique 195\nmzipIdKey       = mkPreludeMiscIdUnique 196\n\n-- GHCi\nghciStepIoMClassOpKey :: Unique\nghciStepIoMClassOpKey = mkPreludeMiscIdUnique 197\n\n-- Overloaded lists\nisListClassKey, fromListClassOpKey, fromListNClassOpKey, toListClassOpKey :: Unique\nisListClassKey = mkPreludeMiscIdUnique 198\nfromListClassOpKey = mkPreludeMiscIdUnique 199\nfromListNClassOpKey = mkPreludeMiscIdUnique 500\ntoListClassOpKey = mkPreludeMiscIdUnique 501\n\nproxyHashKey :: Unique\nproxyHashKey = mkPreludeMiscIdUnique 502\n\n---------------- Template Haskell -------------------\n--      THNames.hs: USES IdUniques 200-499\n-----------------------------------------------------\n\n-- Used to make `Typeable` dictionaries\nmkTyConKey\n  , mkTrTypeKey\n  , mkTrConKey\n  , mkTrAppKey\n  , mkTrFunKey\n  , typeNatTypeRepKey\n  , typeSymbolTypeRepKey\n  , typeRepIdKey\n  :: Unique\nmkTyConKey            = mkPreludeMiscIdUnique 503\nmkTrTypeKey           = mkPreludeMiscIdUnique 504\nmkTrConKey            = mkPreludeMiscIdUnique 505\nmkTrAppKey            = mkPreludeMiscIdUnique 506\ntypeNatTypeRepKey     = mkPreludeMiscIdUnique 507\ntypeSymbolTypeRepKey  = mkPreludeMiscIdUnique 508\ntypeRepIdKey          = mkPreludeMiscIdUnique 509\nmkTrFunKey            = mkPreludeMiscIdUnique 510\n\n-- Representations for primitive types\ntrTYPEKey\n  ,trTYPE'PtrRepLiftedKey\n  , trRuntimeRepKey\n  , tr'PtrRepLiftedKey\n  :: Unique\ntrTYPEKey              = mkPreludeMiscIdUnique 511\ntrTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 512\ntrRuntimeRepKey        = mkPreludeMiscIdUnique 513\ntr'PtrRepLiftedKey     = mkPreludeMiscIdUnique 514\n\n-- KindReps for common cases\nstarKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique\nstarKindRepKey        = mkPreludeMiscIdUnique 520\nstarArrStarKindRepKey = mkPreludeMiscIdUnique 521\nstarArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522\n\n-- Dynamic\ntoDynIdKey :: Unique\ntoDynIdKey            = mkPreludeMiscIdUnique 523\n\n\nbitIntegerIdKey :: Unique\nbitIntegerIdKey       = mkPreludeMiscIdUnique 550\n\nheqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: Unique\neqSCSelIdKey        = mkPreludeMiscIdUnique 551\nheqSCSelIdKey       = mkPreludeMiscIdUnique 552\ncoercibleSCSelIdKey = mkPreludeMiscIdUnique 553\n\nsappendClassOpKey :: Unique\nsappendClassOpKey = mkPreludeMiscIdUnique 554\n\nmemptyClassOpKey, mappendClassOpKey, mconcatClassOpKey :: Unique\nmemptyClassOpKey  = mkPreludeMiscIdUnique 555\nmappendClassOpKey = mkPreludeMiscIdUnique 556\nmconcatClassOpKey = mkPreludeMiscIdUnique 557\n\nemptyCallStackKey, pushCallStackKey :: Unique\nemptyCallStackKey = mkPreludeMiscIdUnique 558\npushCallStackKey  = mkPreludeMiscIdUnique 559\n\nfromStaticPtrClassOpKey :: Unique\nfromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560\n\nmakeStaticKey :: Unique\nmakeStaticKey = mkPreludeMiscIdUnique 561\n\n-- Natural\nnaturalFromIntegerIdKey, naturalToIntegerIdKey, plusNaturalIdKey,\n   minusNaturalIdKey, timesNaturalIdKey, mkNaturalIdKey,\n   naturalSDataConKey, wordToNaturalIdKey :: Unique\nnaturalFromIntegerIdKey = mkPreludeMiscIdUnique 562\nnaturalToIntegerIdKey   = mkPreludeMiscIdUnique 563\nplusNaturalIdKey        = mkPreludeMiscIdUnique 564\nminusNaturalIdKey       = mkPreludeMiscIdUnique 565\ntimesNaturalIdKey       = mkPreludeMiscIdUnique 566\nmkNaturalIdKey          = mkPreludeMiscIdUnique 567\nnaturalSDataConKey      = mkPreludeMiscIdUnique 568\nwordToNaturalIdKey      = mkPreludeMiscIdUnique 569\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Class-std-groups]{Standard groups of Prelude classes}\n*                                                                      *\n************************************************************************\n\nNOTE: @Eq@ and @Text@ do need to appear in @standardClasses@\neven though every numeric class has these two as a superclass,\nbecause the list of ambiguous dictionaries hasn't been simplified.\n-}\n\nnumericClassKeys :: [Unique]\nnumericClassKeys =\n        [ numClassKey\n        , realClassKey\n        , integralClassKey\n        ]\n        ++ fractionalClassKeys\n\nfractionalClassKeys :: [Unique]\nfractionalClassKeys =\n        [ fractionalClassKey\n        , floatingClassKey\n        , realFracClassKey\n        , realFloatClassKey\n        ]\n\n-- The \"standard classes\" are used in defaulting (Haskell 98 report 4.3.4),\n-- and are: \"classes defined in the Prelude or a standard library\"\nstandardClassKeys :: [Unique]\nstandardClassKeys = derivableClassKeys ++ numericClassKeys\n                  ++ [randomClassKey, randomGenClassKey,\n                      functorClassKey,\n                      monadClassKey, monadPlusClassKey, monadFailClassKey,\n                      semigroupClassKey, monoidClassKey,\n                      isStringClassKey,\n                      applicativeClassKey, foldableClassKey,\n                      traversableClassKey, alternativeClassKey\n                     ]\n\n{-\n@derivableClassKeys@ is also used in checking \\tr{deriving} constructs\n(@TcDeriv@).\n-}\n\nderivableClassKeys :: [Unique]\nderivableClassKeys\n  = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey,\n      boundedClassKey, showClassKey, readClassKey ]\n\n\n-- These are the \"interactive classes\" that are consulted when doing\n-- defaulting. Does not include Num or IsString, which have special\n-- handling.\ninteractiveClassNames :: [Name]\ninteractiveClassNames\n  = [ showClassName, eqClassName, ordClassName, foldableClassName\n    , traversableClassName ]\n\ninteractiveClassKeys :: [Unique]\ninteractiveClassKeys = map getUnique interactiveClassNames\n\n{-\n************************************************************************\n*                                                                      *\n   Semi-builtin names\n*                                                                      *\n************************************************************************\n\nThe following names should be considered by GHCi to be in scope always.\n\n-}\n\npretendNameIsInScope :: Name -> Bool\npretendNameIsInScope n\n  = any (n `hasKey`)\n    [ liftedTypeKindTyConKey, tYPETyConKey\n    , runtimeRepTyConKey, liftedRepDataConKey ]\n", "num_lines": 2490}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[ConFold]{Constant Folder}\n\nConceptually, constant folding should be parameterized with the kind\nof target machine to get identical behaviour during compilation time\nand runtime. We cheat a little bit here...\n\nToDo:\n   check boundaries before folding, e.g. we can fold the Float addition\n   (i1 + i2) only if it results in a valid Float.\n-}\n\n{-# LANGUAGE CPP, RankNTypes, PatternSynonyms, ViewPatterns, RecordWildCards #-}\n{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}\n\nmodule PrelRules\n   ( primOpRules\n   , builtinRules\n   , caseRules\n   )\nwhere\n\n#include \"HsVersions.h\"\n#include \"../includes/MachDeps.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} MkId ( mkPrimOpId, magicDictId )\n\nimport CoreSyn\nimport MkCore\nimport Id\nimport Literal\nimport CoreOpt     ( exprIsLiteral_maybe )\nimport PrimOp      ( PrimOp(..), tagToEnumKey )\nimport TysWiredIn\nimport TysPrim\nimport TyCon       ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon\n                   , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons\n                   , tyConFamilySize )\nimport DataCon     ( dataConTagZ, dataConTyCon, dataConWorkId )\nimport CoreUtils   ( cheapEqExpr, exprIsHNF, exprType )\nimport CoreUnfold  ( exprIsConApp_maybe )\nimport Type\nimport OccName     ( occNameFS )\nimport PrelNames\nimport Maybes      ( orElse )\nimport Name        ( Name, nameOccName )\nimport Outputable\nimport FastString\nimport BasicTypes\nimport DynFlags\nimport Platform\nimport Util\nimport Coercion     (mkUnbranchedAxInstCo,mkSymCo,Role(..))\n\nimport Control.Applicative ( Alternative(..) )\n\nimport Control.Monad\nimport qualified Control.Monad.Fail as MonadFail\nimport Data.Bits as Bits\nimport qualified Data.ByteString as BS\nimport Data.Int\nimport Data.Ratio\nimport Data.Word\n\n{-\nNote [Constant folding]\n~~~~~~~~~~~~~~~~~~~~~~~\nprimOpRules generates a rewrite rule for each primop\nThese rules do what is often called \"constant folding\"\nE.g. the rules for +# might say\n        4 +# 5 = 9\nWell, of course you'd need a lot of rules if you did it\nlike that, so we use a BuiltinRule instead, so that we\ncan match in any two literal values.  So the rule is really\nmore like\n        (Lit x) +# (Lit y) = Lit (x+#y)\nwhere the (+#) on the rhs is done at compile time\n\nThat is why these rules are built in here.\n-}\n\nprimOpRules :: Name -> PrimOp -> Maybe CoreRule\n    -- ToDo: something for integer-shift ops?\n    --       NotOp\nprimOpRules nm TagToEnumOp = mkPrimOpRule nm 2 [ tagToEnumRule ]\nprimOpRules nm DataToTagOp = mkPrimOpRule nm 2 [ dataToTagRule ]\n\n-- Int operations\nprimOpRules nm IntAddOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (+))\n                                               , identityDynFlags zeroi\n                                               , numFoldingRules IntAddOp intPrimOps\n                                               ]\nprimOpRules nm IntSubOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (-))\n                                               , rightIdentityDynFlags zeroi\n                                               , equalArgs >> retLit zeroi\n                                               , numFoldingRules IntSubOp intPrimOps\n                                               ]\nprimOpRules nm IntAddCOp   = mkPrimOpRule nm 2 [ binaryLit (intOpC2 (+))\n                                               , identityCDynFlags zeroi ]\nprimOpRules nm IntSubCOp   = mkPrimOpRule nm 2 [ binaryLit (intOpC2 (-))\n                                               , rightIdentityCDynFlags zeroi\n                                               , equalArgs >> retLitNoC zeroi ]\nprimOpRules nm IntMulOp    = mkPrimOpRule nm 2 [ binaryLit (intOp2 (*))\n                                               , zeroElem zeroi\n                                               , identityDynFlags onei\n                                               , numFoldingRules IntMulOp intPrimOps\n                                               ]\nprimOpRules nm IntQuotOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 quot)\n                                               , leftZero zeroi\n                                               , rightIdentityDynFlags onei\n                                               , equalArgs >> retLit onei ]\nprimOpRules nm IntRemOp    = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (intOp2 rem)\n                                               , leftZero zeroi\n                                               , do l <- getLiteral 1\n                                                    dflags <- getDynFlags\n                                                    guard (l == onei dflags)\n                                                    retLit zeroi\n                                               , equalArgs >> retLit zeroi\n                                               , equalArgs >> retLit zeroi ]\nprimOpRules nm AndIOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.))\n                                               , idempotent\n                                               , zeroElem zeroi ]\nprimOpRules nm OrIOp       = mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))\n                                               , idempotent\n                                               , identityDynFlags zeroi ]\nprimOpRules nm XorIOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)\n                                               , identityDynFlags zeroi\n                                               , equalArgs >> retLit zeroi ]\nprimOpRules nm NotIOp      = mkPrimOpRule nm 1 [ unaryLit complementOp\n                                               , inversePrimOp NotIOp ]\nprimOpRules nm IntNegOp    = mkPrimOpRule nm 1 [ unaryLit negOp\n                                               , inversePrimOp IntNegOp ]\nprimOpRules nm ISllOp      = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)\n                                               , rightIdentityDynFlags zeroi ]\nprimOpRules nm ISraOp      = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)\n                                               , rightIdentityDynFlags zeroi ]\nprimOpRules nm ISrlOp      = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical\n                                               , rightIdentityDynFlags zeroi ]\n\n-- Word operations\nprimOpRules nm WordAddOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (+))\n                                               , identityDynFlags zerow\n                                               , numFoldingRules WordAddOp wordPrimOps\n                                               ]\nprimOpRules nm WordSubOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (-))\n                                               , rightIdentityDynFlags zerow\n                                               , equalArgs >> retLit zerow\n                                               , numFoldingRules WordSubOp wordPrimOps\n                                               ]\nprimOpRules nm WordAddCOp  = mkPrimOpRule nm 2 [ binaryLit (wordOpC2 (+))\n                                               , identityCDynFlags zerow ]\nprimOpRules nm WordSubCOp  = mkPrimOpRule nm 2 [ binaryLit (wordOpC2 (-))\n                                               , rightIdentityCDynFlags zerow\n                                               , equalArgs >> retLitNoC zerow ]\nprimOpRules nm WordMulOp   = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (*))\n                                               , identityDynFlags onew\n                                               , numFoldingRules WordMulOp wordPrimOps\n                                               ]\nprimOpRules nm WordQuotOp  = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 quot)\n                                               , rightIdentityDynFlags onew ]\nprimOpRules nm WordRemOp   = mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (wordOp2 rem)\n                                               , leftZero zerow\n                                               , do l <- getLiteral 1\n                                                    dflags <- getDynFlags\n                                                    guard (l == onew dflags)\n                                                    retLit zerow\n                                               , equalArgs >> retLit zerow ]\nprimOpRules nm AndOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.))\n                                               , idempotent\n                                               , zeroElem zerow ]\nprimOpRules nm OrOp        = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))\n                                               , idempotent\n                                               , identityDynFlags zerow ]\nprimOpRules nm XorOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)\n                                               , identityDynFlags zerow\n                                               , equalArgs >> retLit zerow ]\nprimOpRules nm NotOp       = mkPrimOpRule nm 1 [ unaryLit complementOp\n                                               , inversePrimOp NotOp ]\nprimOpRules nm SllOp       = mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]\nprimOpRules nm SrlOp       = mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]\n\n-- coercions\nprimOpRules nm Word2IntOp     = mkPrimOpRule nm 1 [ liftLitDynFlags word2IntLit\n                                                  , inversePrimOp Int2WordOp ]\nprimOpRules nm Int2WordOp     = mkPrimOpRule nm 1 [ liftLitDynFlags int2WordLit\n                                                  , inversePrimOp Word2IntOp ]\nprimOpRules nm Narrow8IntOp   = mkPrimOpRule nm 1 [ liftLit narrow8IntLit\n                                                  , subsumedByPrimOp Narrow8IntOp\n                                                  , Narrow8IntOp `subsumesPrimOp` Narrow16IntOp\n                                                  , Narrow8IntOp `subsumesPrimOp` Narrow32IntOp ]\nprimOpRules nm Narrow16IntOp  = mkPrimOpRule nm 1 [ liftLit narrow16IntLit\n                                                  , subsumedByPrimOp Narrow8IntOp\n                                                  , subsumedByPrimOp Narrow16IntOp\n                                                  , Narrow16IntOp `subsumesPrimOp` Narrow32IntOp ]\nprimOpRules nm Narrow32IntOp  = mkPrimOpRule nm 1 [ liftLit narrow32IntLit\n                                                  , subsumedByPrimOp Narrow8IntOp\n                                                  , subsumedByPrimOp Narrow16IntOp\n                                                  , subsumedByPrimOp Narrow32IntOp\n                                                  , removeOp32 ]\nprimOpRules nm Narrow8WordOp  = mkPrimOpRule nm 1 [ liftLit narrow8WordLit\n                                                  , subsumedByPrimOp Narrow8WordOp\n                                                  , Narrow8WordOp `subsumesPrimOp` Narrow16WordOp\n                                                  , Narrow8WordOp `subsumesPrimOp` Narrow32WordOp ]\nprimOpRules nm Narrow16WordOp = mkPrimOpRule nm 1 [ liftLit narrow16WordLit\n                                                  , subsumedByPrimOp Narrow8WordOp\n                                                  , subsumedByPrimOp Narrow16WordOp\n                                                  , Narrow16WordOp `subsumesPrimOp` Narrow32WordOp ]\nprimOpRules nm Narrow32WordOp = mkPrimOpRule nm 1 [ liftLit narrow32WordLit\n                                                  , subsumedByPrimOp Narrow8WordOp\n                                                  , subsumedByPrimOp Narrow16WordOp\n                                                  , subsumedByPrimOp Narrow32WordOp\n                                                  , removeOp32 ]\nprimOpRules nm OrdOp          = mkPrimOpRule nm 1 [ liftLit char2IntLit\n                                                  , inversePrimOp ChrOp ]\nprimOpRules nm ChrOp          = mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs\n                                                       guard (litFitsInChar lit)\n                                                       liftLit int2CharLit\n                                                  , inversePrimOp OrdOp ]\nprimOpRules nm Float2IntOp    = mkPrimOpRule nm 1 [ liftLit float2IntLit ]\nprimOpRules nm Int2FloatOp    = mkPrimOpRule nm 1 [ liftLit int2FloatLit ]\nprimOpRules nm Double2IntOp   = mkPrimOpRule nm 1 [ liftLit double2IntLit ]\nprimOpRules nm Int2DoubleOp   = mkPrimOpRule nm 1 [ liftLit int2DoubleLit ]\n-- SUP: Not sure what the standard says about precision in the following 2 cases\nprimOpRules nm Float2DoubleOp = mkPrimOpRule nm 1 [ liftLit float2DoubleLit ]\nprimOpRules nm Double2FloatOp = mkPrimOpRule nm 1 [ liftLit double2FloatLit ]\n\n-- Float\nprimOpRules nm FloatAddOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+))\n                                                , identity zerof ]\nprimOpRules nm FloatSubOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (-))\n                                                , rightIdentity zerof ]\nprimOpRules nm FloatMulOp   = mkPrimOpRule nm 2 [ binaryLit (floatOp2 (*))\n                                                , identity onef\n                                                , strengthReduction twof FloatAddOp  ]\n                         -- zeroElem zerof doesn't hold because of NaN\nprimOpRules nm FloatDivOp   = mkPrimOpRule nm 2 [ guardFloatDiv >> binaryLit (floatOp2 (/))\n                                                , rightIdentity onef ]\nprimOpRules nm FloatNegOp   = mkPrimOpRule nm 1 [ unaryLit negOp\n                                                , inversePrimOp FloatNegOp ]\n\n-- Double\nprimOpRules nm DoubleAddOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (+))\n                                                 , identity zerod ]\nprimOpRules nm DoubleSubOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (-))\n                                                 , rightIdentity zerod ]\nprimOpRules nm DoubleMulOp   = mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (*))\n                                                 , identity oned\n                                                 , strengthReduction twod DoubleAddOp  ]\n                          -- zeroElem zerod doesn't hold because of NaN\nprimOpRules nm DoubleDivOp   = mkPrimOpRule nm 2 [ guardDoubleDiv >> binaryLit (doubleOp2 (/))\n                                                 , rightIdentity oned ]\nprimOpRules nm DoubleNegOp   = mkPrimOpRule nm 1 [ unaryLit negOp\n                                                 , inversePrimOp DoubleNegOp ]\n\n-- Relational operators\n\nprimOpRules nm IntEqOp    = mkRelOpRule nm (==) [ litEq True ]\nprimOpRules nm IntNeOp    = mkRelOpRule nm (/=) [ litEq False ]\nprimOpRules nm CharEqOp   = mkRelOpRule nm (==) [ litEq True ]\nprimOpRules nm CharNeOp   = mkRelOpRule nm (/=) [ litEq False ]\n\nprimOpRules nm IntGtOp    = mkRelOpRule nm (>)  [ boundsCmp Gt ]\nprimOpRules nm IntGeOp    = mkRelOpRule nm (>=) [ boundsCmp Ge ]\nprimOpRules nm IntLeOp    = mkRelOpRule nm (<=) [ boundsCmp Le ]\nprimOpRules nm IntLtOp    = mkRelOpRule nm (<)  [ boundsCmp Lt ]\n\nprimOpRules nm CharGtOp   = mkRelOpRule nm (>)  [ boundsCmp Gt ]\nprimOpRules nm CharGeOp   = mkRelOpRule nm (>=) [ boundsCmp Ge ]\nprimOpRules nm CharLeOp   = mkRelOpRule nm (<=) [ boundsCmp Le ]\nprimOpRules nm CharLtOp   = mkRelOpRule nm (<)  [ boundsCmp Lt ]\n\nprimOpRules nm FloatGtOp  = mkFloatingRelOpRule nm (>)\nprimOpRules nm FloatGeOp  = mkFloatingRelOpRule nm (>=)\nprimOpRules nm FloatLeOp  = mkFloatingRelOpRule nm (<=)\nprimOpRules nm FloatLtOp  = mkFloatingRelOpRule nm (<)\nprimOpRules nm FloatEqOp  = mkFloatingRelOpRule nm (==)\nprimOpRules nm FloatNeOp  = mkFloatingRelOpRule nm (/=)\n\nprimOpRules nm DoubleGtOp = mkFloatingRelOpRule nm (>)\nprimOpRules nm DoubleGeOp = mkFloatingRelOpRule nm (>=)\nprimOpRules nm DoubleLeOp = mkFloatingRelOpRule nm (<=)\nprimOpRules nm DoubleLtOp = mkFloatingRelOpRule nm (<)\nprimOpRules nm DoubleEqOp = mkFloatingRelOpRule nm (==)\nprimOpRules nm DoubleNeOp = mkFloatingRelOpRule nm (/=)\n\nprimOpRules nm WordGtOp   = mkRelOpRule nm (>)  [ boundsCmp Gt ]\nprimOpRules nm WordGeOp   = mkRelOpRule nm (>=) [ boundsCmp Ge ]\nprimOpRules nm WordLeOp   = mkRelOpRule nm (<=) [ boundsCmp Le ]\nprimOpRules nm WordLtOp   = mkRelOpRule nm (<)  [ boundsCmp Lt ]\nprimOpRules nm WordEqOp   = mkRelOpRule nm (==) [ litEq True ]\nprimOpRules nm WordNeOp   = mkRelOpRule nm (/=) [ litEq False ]\n\nprimOpRules nm AddrAddOp  = mkPrimOpRule nm 2 [ rightIdentityDynFlags zeroi ]\n\nprimOpRules nm SeqOp      = mkPrimOpRule nm 4 [ seqRule ]\nprimOpRules nm SparkOp    = mkPrimOpRule nm 4 [ sparkRule ]\n\nprimOpRules _  _          = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Doing the business}\n*                                                                      *\n************************************************************************\n-}\n\n-- useful shorthands\nmkPrimOpRule :: Name -> Int -> [RuleM CoreExpr] -> Maybe CoreRule\nmkPrimOpRule nm arity rules = Just $ mkBasicRule nm arity (msum rules)\n\nmkRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)\n            -> [RuleM CoreExpr] -> Maybe CoreRule\nmkRelOpRule nm cmp extra\n  = mkPrimOpRule nm 2 $\n    binaryCmpLit cmp : equal_rule : extra\n  where\n        -- x `cmp` x does not depend on x, so\n        -- compute it for the arbitrary value 'True'\n        -- and use that result\n    equal_rule = do { equalArgs\n                    ; dflags <- getDynFlags\n                    ; return (if cmp True True\n                              then trueValInt  dflags\n                              else falseValInt dflags) }\n\n{- Note [Rules for floating-point comparisons]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need different rules for floating-point values because for floats\nit is not true that x = x (for NaNs); so we do not want the equal_rule\nrule that mkRelOpRule uses.\n\nNote also that, in the case of equality/inequality, we do /not/\nwant to switch to a case-expression.  For example, we do not want\nto convert\n   case (eqFloat# x 3.8#) of\n     True -> this\n     False -> that\nto\n  case x of\n    3.8#::Float# -> this\n    _            -> that\nSee Trac #9238.  Reason: comparing floating-point values for equality\ndelicate, and we don't want to implement that delicacy in the code for\ncase expressions.  So we make it an invariant of Core that a case\nexpression never scrutinises a Float# or Double#.\n\nThis transformation is what the litEq rule does;\nsee Note [The litEq rule: converting equality to case].\nSo we /refrain/ from using litEq for mkFloatingRelOpRule.\n-}\n\nmkFloatingRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)\n                    -> Maybe CoreRule\n-- See Note [Rules for floating-point comparisons]\nmkFloatingRelOpRule nm cmp\n  = mkPrimOpRule nm 2 [binaryCmpLit cmp]\n\n-- common constants\nzeroi, onei, zerow, onew :: DynFlags -> Literal\nzeroi dflags = mkLitInt  dflags 0\nonei  dflags = mkLitInt  dflags 1\nzerow dflags = mkLitWord dflags 0\nonew  dflags = mkLitWord dflags 1\n\nzerof, onef, twof, zerod, oned, twod :: Literal\nzerof = mkLitFloat 0.0\nonef  = mkLitFloat 1.0\ntwof  = mkLitFloat 2.0\nzerod = mkLitDouble 0.0\noned  = mkLitDouble 1.0\ntwod  = mkLitDouble 2.0\n\ncmpOp :: DynFlags -> (forall a . Ord a => a -> a -> Bool)\n      -> Literal -> Literal -> Maybe CoreExpr\ncmpOp dflags cmp = go\n  where\n    done True  = Just $ trueValInt  dflags\n    done False = Just $ falseValInt dflags\n\n    -- These compares are at different types\n    go (LitChar i1)   (LitChar i2)   = done (i1 `cmp` i2)\n    go (LitFloat i1)  (LitFloat i2)  = done (i1 `cmp` i2)\n    go (LitDouble i1) (LitDouble i2) = done (i1 `cmp` i2)\n    go (LitNumber nt1 i1 _) (LitNumber nt2 i2 _)\n      | nt1 /= nt2 = Nothing\n      | otherwise  = done (i1 `cmp` i2)\n    go _               _               = Nothing\n\n--------------------------\n\nnegOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Negate\nnegOp _      (LitFloat 0.0)  = Nothing  -- can't represent -0.0 as a Rational\nnegOp dflags (LitFloat f)    = Just (mkFloatVal dflags (-f))\nnegOp _      (LitDouble 0.0) = Nothing\nnegOp dflags (LitDouble d)   = Just (mkDoubleVal dflags (-d))\nnegOp dflags (LitNumber nt i t)\n   | litNumIsSigned nt = Just (Lit (mkLitNumberWrap dflags nt (-i) t))\nnegOp _      _                = Nothing\n\ncomplementOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Binary complement\ncomplementOp dflags (LitNumber nt i t) =\n   Just (Lit (mkLitNumberWrap dflags nt (complement i) t))\ncomplementOp _      _            = Nothing\n\n--------------------------\nintOp2 :: (Integral a, Integral b)\n       => (a -> b -> Integer)\n       -> DynFlags -> Literal -> Literal -> Maybe CoreExpr\nintOp2 = intOp2' . const\n\nintOp2' :: (Integral a, Integral b)\n        => (DynFlags -> a -> b -> Integer)\n        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr\nintOp2' op dflags (LitNumber LitNumInt i1 _) (LitNumber LitNumInt i2 _) =\n  let o = op dflags\n  in  intResult dflags (fromInteger i1 `o` fromInteger i2)\nintOp2' _  _      _            _            = Nothing  -- Could find LitLit\n\nintOpC2 :: (Integral a, Integral b)\n        => (a -> b -> Integer)\n        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr\nintOpC2 op dflags (LitNumber LitNumInt i1 _) (LitNumber LitNumInt i2 _) = do\n  intCResult dflags (fromInteger i1 `op` fromInteger i2)\nintOpC2 _  _      _            _            = Nothing  -- Could find LitLit\n\nshiftRightLogical :: DynFlags -> Integer -> Int -> Integer\n-- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do\n-- Do this by converting to Word and back.  Obviously this won't work for big\n-- values, but its ok as we use it here\nshiftRightLogical dflags x n\n  | wordSizeInBits dflags == 32 = fromIntegral (fromInteger x `shiftR` n :: Word32)\n  | wordSizeInBits dflags == 64 = fromIntegral (fromInteger x `shiftR` n :: Word64)\n  | otherwise = panic \"shiftRightLogical: unsupported word size\"\n\n--------------------------\nretLit :: (DynFlags -> Literal) -> RuleM CoreExpr\nretLit l = do dflags <- getDynFlags\n              return $ Lit $ l dflags\n\nretLitNoC :: (DynFlags -> Literal) -> RuleM CoreExpr\nretLitNoC l = do dflags <- getDynFlags\n                 let lit = l dflags\n                 let ty = literalType lit\n                 return $ mkCoreUbxTup [ty, ty] [Lit lit, Lit (zeroi dflags)]\n\nwordOp2 :: (Integral a, Integral b)\n        => (a -> b -> Integer)\n        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr\nwordOp2 op dflags (LitNumber LitNumWord w1 _) (LitNumber LitNumWord w2 _)\n    = wordResult dflags (fromInteger w1 `op` fromInteger w2)\nwordOp2 _ _ _ _ = Nothing  -- Could find LitLit\n\nwordOpC2 :: (Integral a, Integral b)\n        => (a -> b -> Integer)\n        -> DynFlags -> Literal -> Literal -> Maybe CoreExpr\nwordOpC2 op dflags (LitNumber LitNumWord w1 _) (LitNumber LitNumWord w2 _) =\n  wordCResult dflags (fromInteger w1 `op` fromInteger w2)\nwordOpC2 _ _ _ _ = Nothing  -- Could find LitLit\n\nshiftRule :: (DynFlags -> Integer -> Int -> Integer) -> RuleM CoreExpr\n-- Shifts take an Int; hence third arg of op is Int\n-- Used for shift primops\n--    ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word#\n--    SllOp, SrlOp           :: Word# -> Int# -> Word#\n-- See Note [Guarding against silly shifts]\nshiftRule shift_op\n  = do { dflags <- getDynFlags\n       ; [e1, Lit (LitNumber LitNumInt shift_len _)] <- getArgs\n       ; case e1 of\n           _ | shift_len == 0\n             -> return e1\n\n           -- Do the shift at type Integer, but shift length is Int\n           Lit (LitNumber nt x t)\n             | 0 < shift_len\n             , shift_len <= wordSizeInBits dflags\n             -> let op = shift_op dflags\n                    y  = x `op` fromInteger shift_len\n                in  liftMaybe $ Just (Lit (mkLitNumberWrap dflags nt y t))\n\n           _ -> mzero }\n\nwordSizeInBits :: DynFlags -> Integer\nwordSizeInBits dflags = toInteger (platformWordSize (targetPlatform dflags) `shiftL` 3)\n\n--------------------------\nfloatOp2 :: (Rational -> Rational -> Rational)\n         -> DynFlags -> Literal -> Literal\n         -> Maybe (Expr CoreBndr)\nfloatOp2 op dflags (LitFloat f1) (LitFloat f2)\n  = Just (mkFloatVal dflags (f1 `op` f2))\nfloatOp2 _ _ _ _ = Nothing\n\n--------------------------\ndoubleOp2 :: (Rational -> Rational -> Rational)\n          -> DynFlags -> Literal -> Literal\n          -> Maybe (Expr CoreBndr)\ndoubleOp2 op dflags (LitDouble f1) (LitDouble f2)\n  = Just (mkDoubleVal dflags (f1 `op` f2))\ndoubleOp2 _ _ _ _ = Nothing\n\n--------------------------\n{- Note [The litEq rule: converting equality to case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis stuff turns\n     n ==# 3#\ninto\n     case n of\n       3# -> True\n       m  -> False\n\nThis is a Good Thing, because it allows case-of case things\nto happen, and case-default absorption to happen.  For\nexample:\n\n     if (n ==# 3#) || (n ==# 4#) then e1 else e2\nwill transform to\n     case n of\n       3# -> e1\n       4# -> e1\n       m  -> e2\n(modulo the usual precautions to avoid duplicating e1)\n-}\n\nlitEq :: Bool  -- True <=> equality, False <=> inequality\n      -> RuleM CoreExpr\nlitEq is_eq = msum\n  [ do [Lit lit, expr] <- getArgs\n       dflags <- getDynFlags\n       do_lit_eq dflags lit expr\n  , do [expr, Lit lit] <- getArgs\n       dflags <- getDynFlags\n       do_lit_eq dflags lit expr ]\n  where\n    do_lit_eq dflags lit expr = do\n      guard (not (litIsLifted lit))\n      return (mkWildCase expr (literalType lit) intPrimTy\n                    [(DEFAULT,    [], val_if_neq),\n                     (LitAlt lit, [], val_if_eq)])\n      where\n        val_if_eq  | is_eq     = trueValInt  dflags\n                   | otherwise = falseValInt dflags\n        val_if_neq | is_eq     = falseValInt dflags\n                   | otherwise = trueValInt  dflags\n\n\n-- | Check if there is comparison with minBound or maxBound, that is\n-- always true or false. For instance, an Int cannot be smaller than its\n-- minBound, so we can replace such comparison with False.\nboundsCmp :: Comparison -> RuleM CoreExpr\nboundsCmp op = do\n  dflags <- getDynFlags\n  [a, b] <- getArgs\n  liftMaybe $ mkRuleFn dflags op a b\n\ndata Comparison = Gt | Ge | Lt | Le\n\nmkRuleFn :: DynFlags -> Comparison -> CoreExpr -> CoreExpr -> Maybe CoreExpr\nmkRuleFn dflags Gt (Lit lit) _ | isMinBound dflags lit = Just $ falseValInt dflags\nmkRuleFn dflags Le (Lit lit) _ | isMinBound dflags lit = Just $ trueValInt  dflags\nmkRuleFn dflags Ge _ (Lit lit) | isMinBound dflags lit = Just $ trueValInt  dflags\nmkRuleFn dflags Lt _ (Lit lit) | isMinBound dflags lit = Just $ falseValInt dflags\nmkRuleFn dflags Ge (Lit lit) _ | isMaxBound dflags lit = Just $ trueValInt  dflags\nmkRuleFn dflags Lt (Lit lit) _ | isMaxBound dflags lit = Just $ falseValInt dflags\nmkRuleFn dflags Gt _ (Lit lit) | isMaxBound dflags lit = Just $ falseValInt dflags\nmkRuleFn dflags Le _ (Lit lit) | isMaxBound dflags lit = Just $ trueValInt  dflags\nmkRuleFn _ _ _ _                                       = Nothing\n\nisMinBound :: DynFlags -> Literal -> Bool\nisMinBound _      (LitChar c)        = c == minBound\nisMinBound dflags (LitNumber nt i _) = case nt of\n   LitNumInt     -> i == tARGET_MIN_INT dflags\n   LitNumInt64   -> i == toInteger (minBound :: Int64)\n   LitNumWord    -> i == 0\n   LitNumWord64  -> i == 0\n   LitNumNatural -> i == 0\n   LitNumInteger -> False\nisMinBound _      _                  = False\n\nisMaxBound :: DynFlags -> Literal -> Bool\nisMaxBound _      (LitChar c)       = c == maxBound\nisMaxBound dflags (LitNumber nt i _) = case nt of\n   LitNumInt     -> i == tARGET_MAX_INT dflags\n   LitNumInt64   -> i == toInteger (maxBound :: Int64)\n   LitNumWord    -> i == tARGET_MAX_WORD dflags\n   LitNumWord64  -> i == toInteger (maxBound :: Word64)\n   LitNumNatural -> False\n   LitNumInteger -> False\nisMaxBound _      _                  = False\n\n-- | Create an Int literal expression while ensuring the given Integer is in the\n-- target Int range\nintResult :: DynFlags -> Integer -> Maybe CoreExpr\nintResult dflags result = Just (intResult' dflags result)\n\nintResult' :: DynFlags -> Integer -> CoreExpr\nintResult' dflags result = Lit (mkLitIntWrap dflags result)\n\n-- | Create an unboxed pair of an Int literal expression, ensuring the given\n-- Integer is in the target Int range and the corresponding overflow flag\n-- (@0#@/@1#@) if it wasn't.\nintCResult :: DynFlags -> Integer -> Maybe CoreExpr\nintCResult dflags result = Just (mkPair [Lit lit, Lit c])\n  where\n    mkPair = mkCoreUbxTup [intPrimTy, intPrimTy]\n    (lit, b) = mkLitIntWrapC dflags result\n    c = if b then onei dflags else zeroi dflags\n\n-- | Create a Word literal expression while ensuring the given Integer is in the\n-- target Word range\nwordResult :: DynFlags -> Integer -> Maybe CoreExpr\nwordResult dflags result = Just (wordResult' dflags result)\n\nwordResult' :: DynFlags -> Integer -> CoreExpr\nwordResult' dflags result = Lit (mkLitWordWrap dflags result)\n\n-- | Create an unboxed pair of a Word literal expression, ensuring the given\n-- Integer is in the target Word range and the corresponding carry flag\n-- (@0#@/@1#@) if it wasn't.\nwordCResult :: DynFlags -> Integer -> Maybe CoreExpr\nwordCResult dflags result = Just (mkPair [Lit lit, Lit c])\n  where\n    mkPair = mkCoreUbxTup [wordPrimTy, intPrimTy]\n    (lit, b) = mkLitWordWrapC dflags result\n    c = if b then onei dflags else zeroi dflags\n\ninversePrimOp :: PrimOp -> RuleM CoreExpr\ninversePrimOp primop = do\n  [Var primop_id `App` e] <- getArgs\n  matchPrimOpId primop primop_id\n  return e\n\nsubsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr\nthis `subsumesPrimOp` that = do\n  [Var primop_id `App` e] <- getArgs\n  matchPrimOpId that primop_id\n  return (Var (mkPrimOpId this) `App` e)\n\nsubsumedByPrimOp :: PrimOp -> RuleM CoreExpr\nsubsumedByPrimOp primop = do\n  [e@(Var primop_id `App` _)] <- getArgs\n  matchPrimOpId primop primop_id\n  return e\n\nidempotent :: RuleM CoreExpr\nidempotent = do [e1, e2] <- getArgs\n                guard $ cheapEqExpr e1 e2\n                return e1\n\n{-\nNote [Guarding against silly shifts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this code:\n\n  import Data.Bits( (.|.), shiftL )\n  chunkToBitmap :: [Bool] -> Word32\n  chunkToBitmap chunk = foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]\n\nThis optimises to:\nShift.$wgo = \\ (w_sCS :: GHC.Prim.Int#) (w1_sCT :: [GHC.Types.Bool]) ->\n    case w1_sCT of _ {\n      [] -> 0##;\n      : x_aAW xs_aAX ->\n        case x_aAW of _ {\n          GHC.Types.False ->\n            case w_sCS of wild2_Xh {\n              __DEFAULT -> Shift.$wgo (GHC.Prim.+# wild2_Xh 1) xs_aAX;\n              9223372036854775807 -> 0## };\n          GHC.Types.True ->\n            case GHC.Prim.>=# w_sCS 64 of _ {\n              GHC.Types.False ->\n                case w_sCS of wild3_Xh {\n                  __DEFAULT ->\n                    case Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX of ww_sCW { __DEFAULT ->\n                      GHC.Prim.or# (GHC.Prim.narrow32Word#\n                                      (GHC.Prim.uncheckedShiftL# 1## wild3_Xh))\n                                   ww_sCW\n                     };\n                  9223372036854775807 ->\n                    GHC.Prim.narrow32Word#\n!!!!-->                  (GHC.Prim.uncheckedShiftL# 1## 9223372036854775807)\n                };\n              GHC.Types.True ->\n                case w_sCS of wild3_Xh {\n                  __DEFAULT -> Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX;\n                  9223372036854775807 -> 0##\n                } } } }\n\nNote the massive shift on line \"!!!!\".  It can't happen, because we've checked\nthat w < 64, but the optimiser didn't spot that. We DO NOT want to constant-fold this!\nMoreover, if the programmer writes (n `uncheckedShiftL` 9223372036854775807), we\ncan't constant fold it, but if it gets to the assember we get\n     Error: operand type mismatch for `shl'\n\nSo the best thing to do is to rewrite the shift with a call to error,\nwhen the second arg is stupid.\n\nThere are two cases:\n\n- Shifting fixed-width things: the primops ISll, Sll, etc\n  These are handled by shiftRule.\n\n  We are happy to shift by any amount up to wordSize but no more.\n\n- Shifting Integers: the function shiftLInteger, shiftRInteger\n  from the 'integer' library.   These are handled by rule_shift_op,\n  and match_Integer_shift_op.\n\n  Here we could in principle shift by any amount, but we arbitary\n  limit the shift to 4 bits; in particualr we do not want shift by a\n  huge amount, which can happen in code like that above.\n\nThe two cases are more different in their code paths that is comfortable,\nbut that is only a historical accident.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Vaguely generic functions}\n*                                                                      *\n************************************************************************\n-}\n\nmkBasicRule :: Name -> Int -> RuleM CoreExpr -> CoreRule\n-- Gives the Rule the same name as the primop itself\nmkBasicRule op_name n_args rm\n  = BuiltinRule { ru_name = occNameFS (nameOccName op_name),\n                  ru_fn = op_name,\n                  ru_nargs = n_args,\n                  ru_try = \\ dflags in_scope _ -> runRuleM rm dflags in_scope }\n\nnewtype RuleM r = RuleM\n  { runRuleM :: DynFlags -> InScopeEnv -> [CoreExpr] -> Maybe r }\n\ninstance Functor RuleM where\n    fmap = liftM\n\ninstance Applicative RuleM where\n    pure x = RuleM $ \\_ _ _ -> Just x\n    (<*>) = ap\n\ninstance Monad RuleM where\n  RuleM f >>= g = RuleM $ \\dflags iu e -> case f dflags iu e of\n    Nothing -> Nothing\n    Just r -> runRuleM (g r) dflags iu e\n#if !MIN_VERSION_base(4,13,0)\n  fail = MonadFail.fail\n#endif\n\ninstance MonadFail.MonadFail RuleM where\n    fail _ = mzero\n\ninstance Alternative RuleM where\n  empty = RuleM $ \\_ _ _ -> Nothing\n  RuleM f1 <|> RuleM f2 = RuleM $ \\dflags iu args ->\n    f1 dflags iu args <|> f2 dflags iu args\n\ninstance MonadPlus RuleM\n\ninstance HasDynFlags RuleM where\n    getDynFlags = RuleM $ \\dflags _ _ -> Just dflags\n\nliftMaybe :: Maybe a -> RuleM a\nliftMaybe Nothing = mzero\nliftMaybe (Just x) = return x\n\nliftLit :: (Literal -> Literal) -> RuleM CoreExpr\nliftLit f = liftLitDynFlags (const f)\n\nliftLitDynFlags :: (DynFlags -> Literal -> Literal) -> RuleM CoreExpr\nliftLitDynFlags f = do\n  dflags <- getDynFlags\n  [Lit lit] <- getArgs\n  return $ Lit (f dflags lit)\n\nremoveOp32 :: RuleM CoreExpr\nremoveOp32 = do\n  dflags <- getDynFlags\n  if wordSizeInBits dflags == 32\n  then do\n    [e] <- getArgs\n    return e\n  else mzero\n\ngetArgs :: RuleM [CoreExpr]\ngetArgs = RuleM $ \\_ _ args -> Just args\n\ngetInScopeEnv :: RuleM InScopeEnv\ngetInScopeEnv = RuleM $ \\_ iu _ -> Just iu\n\n-- return the n-th argument of this rule, if it is a literal\n-- argument indices start from 0\ngetLiteral :: Int -> RuleM Literal\ngetLiteral n = RuleM $ \\_ _ exprs -> case drop n exprs of\n  (Lit l:_) -> Just l\n  _ -> Nothing\n\nunaryLit :: (DynFlags -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr\nunaryLit op = do\n  dflags <- getDynFlags\n  [Lit l] <- getArgs\n  liftMaybe $ op dflags (convFloating dflags l)\n\nbinaryLit :: (DynFlags -> Literal -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr\nbinaryLit op = do\n  dflags <- getDynFlags\n  [Lit l1, Lit l2] <- getArgs\n  liftMaybe $ op dflags (convFloating dflags l1) (convFloating dflags l2)\n\nbinaryCmpLit :: (forall a . Ord a => a -> a -> Bool) -> RuleM CoreExpr\nbinaryCmpLit op = do\n  dflags <- getDynFlags\n  binaryLit (\\_ -> cmpOp dflags op)\n\nleftIdentity :: Literal -> RuleM CoreExpr\nleftIdentity id_lit = leftIdentityDynFlags (const id_lit)\n\nrightIdentity :: Literal -> RuleM CoreExpr\nrightIdentity id_lit = rightIdentityDynFlags (const id_lit)\n\nidentity :: Literal -> RuleM CoreExpr\nidentity lit = leftIdentity lit `mplus` rightIdentity lit\n\nleftIdentityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr\nleftIdentityDynFlags id_lit = do\n  dflags <- getDynFlags\n  [Lit l1, e2] <- getArgs\n  guard $ l1 == id_lit dflags\n  return e2\n\n-- | Left identity rule for PrimOps like 'IntAddC' and 'WordAddC', where, in\n-- addition to the result, we have to indicate that no carry/overflow occured.\nleftIdentityCDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr\nleftIdentityCDynFlags id_lit = do\n  dflags <- getDynFlags\n  [Lit l1, e2] <- getArgs\n  guard $ l1 == id_lit dflags\n  let no_c = Lit (zeroi dflags)\n  return (mkCoreUbxTup [exprType e2, intPrimTy] [e2, no_c])\n\nrightIdentityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr\nrightIdentityDynFlags id_lit = do\n  dflags <- getDynFlags\n  [e1, Lit l2] <- getArgs\n  guard $ l2 == id_lit dflags\n  return e1\n\n-- | Right identity rule for PrimOps like 'IntSubC' and 'WordSubC', where, in\n-- addition to the result, we have to indicate that no carry/overflow occured.\nrightIdentityCDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr\nrightIdentityCDynFlags id_lit = do\n  dflags <- getDynFlags\n  [e1, Lit l2] <- getArgs\n  guard $ l2 == id_lit dflags\n  let no_c = Lit (zeroi dflags)\n  return (mkCoreUbxTup [exprType e1, intPrimTy] [e1, no_c])\n\nidentityDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr\nidentityDynFlags lit =\n  leftIdentityDynFlags lit `mplus` rightIdentityDynFlags lit\n\n-- | Identity rule for PrimOps like 'IntAddC' and 'WordAddC', where, in addition\n-- to the result, we have to indicate that no carry/overflow occured.\nidentityCDynFlags :: (DynFlags -> Literal) -> RuleM CoreExpr\nidentityCDynFlags lit =\n  leftIdentityCDynFlags lit `mplus` rightIdentityCDynFlags lit\n\nleftZero :: (DynFlags -> Literal) -> RuleM CoreExpr\nleftZero zero = do\n  dflags <- getDynFlags\n  [Lit l1, _] <- getArgs\n  guard $ l1 == zero dflags\n  return $ Lit l1\n\nrightZero :: (DynFlags -> Literal) -> RuleM CoreExpr\nrightZero zero = do\n  dflags <- getDynFlags\n  [_, Lit l2] <- getArgs\n  guard $ l2 == zero dflags\n  return $ Lit l2\n\nzeroElem :: (DynFlags -> Literal) -> RuleM CoreExpr\nzeroElem lit = leftZero lit `mplus` rightZero lit\n\nequalArgs :: RuleM ()\nequalArgs = do\n  [e1, e2] <- getArgs\n  guard $ e1 `cheapEqExpr` e2\n\nnonZeroLit :: Int -> RuleM ()\nnonZeroLit n = getLiteral n >>= guard . not . isZeroLit\n\n-- When excess precision is not requested, cut down the precision of the\n-- Rational value to that of Float/Double. We confuse host architecture\n-- and target architecture here, but it's convenient (and wrong :-).\nconvFloating :: DynFlags -> Literal -> Literal\nconvFloating dflags (LitFloat  f) | not (gopt Opt_ExcessPrecision dflags) =\n   LitFloat  (toRational (fromRational f :: Float ))\nconvFloating dflags (LitDouble d) | not (gopt Opt_ExcessPrecision dflags) =\n   LitDouble (toRational (fromRational d :: Double))\nconvFloating _ l = l\n\nguardFloatDiv :: RuleM ()\nguardFloatDiv = do\n  [Lit (LitFloat f1), Lit (LitFloat f2)] <- getArgs\n  guard $ (f1 /=0 || f2 > 0) -- see Note [negative zero]\n       && f2 /= 0            -- avoid NaN and Infinity/-Infinity\n\nguardDoubleDiv :: RuleM ()\nguardDoubleDiv = do\n  [Lit (LitDouble d1), Lit (LitDouble d2)] <- getArgs\n  guard $ (d1 /=0 || d2 > 0) -- see Note [negative zero]\n       && d2 /= 0            -- avoid NaN and Infinity/-Infinity\n-- Note [negative zero] Avoid (0 / -d), otherwise 0/(-1) reduces to\n-- zero, but we might want to preserve the negative zero here which\n-- is representable in Float/Double but not in (normalised)\n-- Rational. (#3676) Perhaps we should generate (0 :% (-1)) instead?\n\nstrengthReduction :: Literal -> PrimOp -> RuleM CoreExpr\nstrengthReduction two_lit add_op = do -- Note [Strength reduction]\n  arg <- msum [ do [arg, Lit mult_lit] <- getArgs\n                   guard (mult_lit == two_lit)\n                   return arg\n              , do [Lit mult_lit, arg] <- getArgs\n                   guard (mult_lit == two_lit)\n                   return arg ]\n  return $ Var (mkPrimOpId add_op) `App` arg `App` arg\n\n-- Note [Strength reduction]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- This rule turns floating point multiplications of the form 2.0 * x and\n-- x * 2.0 into x + x addition, because addition costs less than multiplication.\n-- See #7116\n\n-- Note [What's true and false]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- trueValInt and falseValInt represent true and false values returned by\n-- comparison primops for Char, Int, Word, Integer, Double, Float and Addr.\n-- True is represented as an unboxed 1# literal, while false is represented\n-- as 0# literal.\n-- We still need Bool data constructors (True and False) to use in a rule\n-- for constant folding of equal Strings\n\ntrueValInt, falseValInt :: DynFlags -> Expr CoreBndr\ntrueValInt  dflags = Lit $ onei  dflags -- see Note [What's true and false]\nfalseValInt dflags = Lit $ zeroi dflags\n\ntrueValBool, falseValBool :: Expr CoreBndr\ntrueValBool   = Var trueDataConId -- see Note [What's true and false]\nfalseValBool  = Var falseDataConId\n\nltVal, eqVal, gtVal :: Expr CoreBndr\nltVal = Var ordLTDataConId\neqVal = Var ordEQDataConId\ngtVal = Var ordGTDataConId\n\nmkIntVal :: DynFlags -> Integer -> Expr CoreBndr\nmkIntVal dflags i = Lit (mkLitInt dflags i)\nmkFloatVal :: DynFlags -> Rational -> Expr CoreBndr\nmkFloatVal dflags f = Lit (convFloating dflags (LitFloat  f))\nmkDoubleVal :: DynFlags -> Rational -> Expr CoreBndr\nmkDoubleVal dflags d = Lit (convFloating dflags (LitDouble d))\n\nmatchPrimOpId :: PrimOp -> Id -> RuleM ()\nmatchPrimOpId op id = do\n  op' <- liftMaybe $ isPrimOpId_maybe id\n  guard $ op == op'\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Special rules for seq, tagToEnum, dataToTag}\n*                                                                      *\n************************************************************************\n\nNote [tagToEnum#]\n~~~~~~~~~~~~~~~~~\nNasty check to ensure that tagToEnum# is applied to a type that is an\nenumeration TyCon.  Unification may refine the type later, but this\ncheck won't see that, alas.  It's crude but it works.\n\nHere's are two cases that should fail\n        f :: forall a. a\n        f = tagToEnum# 0        -- Can't do tagToEnum# at a type variable\n\n        g :: Int\n        g = tagToEnum# 0        -- Int is not an enumeration\n\nWe used to make this check in the type inference engine, but it's quite\nugly to do so, because the delayed constraint solving means that we don't\nreally know what's going on until the end. It's very much a corner case\nbecause we don't expect the user to call tagToEnum# at all; we merely\ngenerate calls in derived instances of Enum.  So we compromise: a\nrewrite rule rewrites a bad instance of tagToEnum# to an error call,\nand emits a warning.\n-}\n\ntagToEnumRule :: RuleM CoreExpr\n-- If     data T a = A | B | C\n-- then   tag2Enum# (T ty) 2# -->  B ty\ntagToEnumRule = do\n  [Type ty, Lit (LitNumber LitNumInt i _)] <- getArgs\n  case splitTyConApp_maybe ty of\n    Just (tycon, tc_args) | isEnumerationTyCon tycon -> do\n      let tag = fromInteger i\n          correct_tag dc = (dataConTagZ dc) == tag\n      (dc:rest) <- return $ filter correct_tag (tyConDataCons_maybe tycon `orElse` [])\n      ASSERT(null rest) return ()\n      return $ mkTyApps (Var (dataConWorkId dc)) tc_args\n\n    -- See Note [tagToEnum#]\n    _ -> WARN( True, text \"tagToEnum# on non-enumeration type\" <+> ppr ty )\n         return $ mkRuntimeErrorApp rUNTIME_ERROR_ID ty \"tagToEnum# on non-enumeration type\"\n\n------------------------------\ndataToTagRule :: RuleM CoreExpr\n-- See Note [dataToTag#] in primops.txt.pp\ndataToTagRule = a `mplus` b\n  where\n    -- dataToTag (tagToEnum x)   ==>   x\n    a = do\n      [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag] <- getArgs\n      guard $ tag_to_enum `hasKey` tagToEnumKey\n      guard $ ty1 `eqType` ty2\n      return tag\n\n    -- dataToTag (K e1 e2)  ==>   tag-of K\n    -- This also works (via exprIsConApp_maybe) for\n    --   dataToTag x\n    -- where x's unfolding is a constructor application\n    b = do\n      dflags <- getDynFlags\n      [_, val_arg] <- getArgs\n      in_scope <- getInScopeEnv\n      (_,floats, dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg\n      ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return ()\n      return $ wrapFloats floats (mkIntVal dflags (toInteger (dataConTagZ dc)))\n\n{- Note [dataToTag# magic]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe primop dataToTag# is unusual because it evaluates its argument.\nOnly `SeqOp` shares that property.  (Other primops do not do anything\nas fancy as argument evaluation.)  The special handling for dataToTag#\nis:\n\n* CoreUtils.exprOkForSpeculation has a special case for DataToTagOp,\n  (actually in app_ok).  Most primops with lifted arguments do not\n  evaluate those arguments, but DataToTagOp and SeqOp are two\n  exceptions.  We say that they are /never/ ok-for-speculation,\n  regardless of the evaluated-ness of their argument.\n  See CoreUtils Note [exprOkForSpeculation and SeqOp/DataToTagOp]\n\n* There is a special case for DataToTagOp in StgCmmExpr.cgExpr,\n  that evaluates its argument and then extracts the tag from\n  the returned value.\n\n* An application like (dataToTag# (Just x)) is optimised by\n  dataToTagRule in PrelRules.\n\n* A case expression like\n     case (dataToTag# e) of <alts>\n  gets transformed t\n     case e of <transformed alts>\n  by PrelRules.caseRules; see Note [caseRules for dataToTag]\n\nSee Trac #15696 for a long saga.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Rules for seq# and spark#}\n*                                                                      *\n************************************************************************\n-}\n\n{- Note [seq# magic]\n~~~~~~~~~~~~~~~~~~~~\nThe primop\n   seq# :: forall a s . a -> State# s -> (# State# s, a #)\n\nis /not/ the same as the Prelude function seq :: a -> b -> b\nas you can see from its type.  In fact, seq# is the implementation\nmechanism for 'evaluate'\n\n   evaluate :: a -> IO a\n   evaluate a = IO $ \\s -> seq# a s\n\nThe semantics of seq# is\n  * evaluate its first argument\n  * and return it\n\nThings to note\n\n* Why do we need a primop at all?  That is, instead of\n      case seq# x s of (# x, s #) -> blah\n  why not instead say this?\n      case x of { DEFAULT -> blah)\n\n  Reason (see Trac #5129): if we saw\n    catch# (\\s -> case x of { DEFAULT -> raiseIO# exn s }) handler\n\n  then we'd drop the 'case x' because the body of the case is bottom\n  anyway. But we don't want to do that; the whole /point/ of\n  seq#/evaluate is to evaluate 'x' first in the IO monad.\n\n  In short, we /always/ evaluate the first argument and never\n  just discard it.\n\n* Why return the value?  So that we can control sharing of seq'd\n  values: in\n     let x = e in x `seq` ... x ...\n  We don't want to inline x, so better to represent it as\n       let x = e in case seq# x RW of (# _, x' #) -> ... x' ...\n  also it matches the type of rseq in the Eval monad.\n\nImplementing seq#.  The compiler has magic for SeqOp in\n\n- PrelRules.seqRule: eliminate (seq# <whnf> s)\n\n- StgCmmExpr.cgExpr, and cgCase: special case for seq#\n\n- CoreUtils.exprOkForSpeculation;\n  see Note [exprOkForSpeculation and SeqOp/DataToTagOp] in CoreUtils\n\n- Simplify.addEvals records evaluated-ness for the result; see\n  Note [Adding evaluatedness info to pattern-bound variables]\n  in Simplify\n-}\n\nseqRule :: RuleM CoreExpr\nseqRule = do\n  [Type ty_a, Type _ty_s, a, s] <- getArgs\n  guard $ exprIsHNF a\n  return $ mkCoreUbxTup [exprType s, ty_a] [s, a]\n\n-- spark# :: forall a s . a -> State# s -> (# State# s, a #)\nsparkRule :: RuleM CoreExpr\nsparkRule = seqRule -- reduce on HNF, just the same\n  -- XXX perhaps we shouldn't do this, because a spark eliminated by\n  -- this rule won't be counted as a dud at runtime?\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Built in rules}\n*                                                                      *\n************************************************************************\n\nNote [Scoping for Builtin rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen compiling a (base-package) module that defines one of the\nfunctions mentioned in the RHS of a built-in rule, there's a danger\nthat we'll see\n\n        f = ...(eq String x)....\n\n        ....and lower down...\n\n        eqString = ...\n\nThen a rewrite would give\n\n        f = ...(eqString x)...\n        ....and lower down...\n        eqString = ...\n\nand lo, eqString is not in scope.  This only really matters when we get to code\ngeneration.  With -O we do a GlomBinds step that does a new SCC analysis on the whole\nset of bindings, which sorts out the dependency.  Without -O we don't do any rule\nrewriting so again we are fine.\n\n(This whole thing doesn't show up for non-built-in rules because their dependencies\nare explicit.)\n-}\n\nbuiltinRules :: [CoreRule]\n-- Rules for non-primops that can't be expressed using a RULE pragma\nbuiltinRules\n  = [BuiltinRule { ru_name = fsLit \"AppendLitString\",\n                   ru_fn = unpackCStringFoldrName,\n                   ru_nargs = 4, ru_try = match_append_lit },\n     BuiltinRule { ru_name = fsLit \"EqString\", ru_fn = eqStringName,\n                   ru_nargs = 2, ru_try = match_eq_string },\n     BuiltinRule { ru_name = fsLit \"Inline\", ru_fn = inlineIdName,\n                   ru_nargs = 2, ru_try = \\_ _ _ -> match_inline },\n     BuiltinRule { ru_name = fsLit \"MagicDict\", ru_fn = idName magicDictId,\n                   ru_nargs = 4, ru_try = \\_ _ _ -> match_magicDict },\n     mkBasicRule divIntName 2 $ msum\n        [ nonZeroLit 1 >> binaryLit (intOp2 div)\n        , leftZero zeroi\n        , do\n          [arg, Lit (LitNumber LitNumInt d _)] <- getArgs\n          Just n <- return $ exactLog2 d\n          dflags <- getDynFlags\n          return $ Var (mkPrimOpId ISraOp) `App` arg `App` mkIntVal dflags n\n        ],\n     mkBasicRule modIntName 2 $ msum\n        [ nonZeroLit 1 >> binaryLit (intOp2 mod)\n        , leftZero zeroi\n        , do\n          [arg, Lit (LitNumber LitNumInt d _)] <- getArgs\n          Just _ <- return $ exactLog2 d\n          dflags <- getDynFlags\n          return $ Var (mkPrimOpId AndIOp)\n            `App` arg `App` mkIntVal dflags (d - 1)\n        ]\n     ]\n ++ builtinIntegerRules\n ++ builtinNaturalRules\n{-# NOINLINE builtinRules #-}\n-- there is no benefit to inlining these yet, despite this, GHC produces\n-- unfoldings for this regardless since the floated list entries look small.\n\nbuiltinIntegerRules :: [CoreRule]\nbuiltinIntegerRules =\n [rule_IntToInteger   \"smallInteger\"        smallIntegerName,\n  rule_WordToInteger  \"wordToInteger\"       wordToIntegerName,\n  rule_Int64ToInteger  \"int64ToInteger\"     int64ToIntegerName,\n  rule_Word64ToInteger \"word64ToInteger\"    word64ToIntegerName,\n  rule_convert        \"integerToWord\"       integerToWordName       mkWordLitWord,\n  rule_convert        \"integerToInt\"        integerToIntName        mkIntLitInt,\n  rule_convert        \"integerToWord64\"     integerToWord64Name     (\\_ -> mkWord64LitWord64),\n  rule_convert        \"integerToInt64\"      integerToInt64Name      (\\_ -> mkInt64LitInt64),\n  rule_binop          \"plusInteger\"         plusIntegerName         (+),\n  rule_binop          \"minusInteger\"        minusIntegerName        (-),\n  rule_binop          \"timesInteger\"        timesIntegerName        (*),\n  rule_unop           \"negateInteger\"       negateIntegerName       negate,\n  rule_binop_Prim     \"eqInteger#\"          eqIntegerPrimName       (==),\n  rule_binop_Prim     \"neqInteger#\"         neqIntegerPrimName      (/=),\n  rule_unop           \"absInteger\"          absIntegerName          abs,\n  rule_unop           \"signumInteger\"       signumIntegerName       signum,\n  rule_binop_Prim     \"leInteger#\"          leIntegerPrimName       (<=),\n  rule_binop_Prim     \"gtInteger#\"          gtIntegerPrimName       (>),\n  rule_binop_Prim     \"ltInteger#\"          ltIntegerPrimName       (<),\n  rule_binop_Prim     \"geInteger#\"          geIntegerPrimName       (>=),\n  rule_binop_Ordering \"compareInteger\"      compareIntegerName      compare,\n  rule_encodeFloat    \"encodeFloatInteger\"  encodeFloatIntegerName  mkFloatLitFloat,\n  rule_convert        \"floatFromInteger\"    floatFromIntegerName    (\\_ -> mkFloatLitFloat),\n  rule_encodeFloat    \"encodeDoubleInteger\" encodeDoubleIntegerName mkDoubleLitDouble,\n  rule_decodeDouble   \"decodeDoubleInteger\" decodeDoubleIntegerName,\n  rule_convert        \"doubleFromInteger\"   doubleFromIntegerName   (\\_ -> mkDoubleLitDouble),\n  rule_rationalTo     \"rationalToFloat\"     rationalToFloatName     mkFloatExpr,\n  rule_rationalTo     \"rationalToDouble\"    rationalToDoubleName    mkDoubleExpr,\n  rule_binop          \"gcdInteger\"          gcdIntegerName          gcd,\n  rule_binop          \"lcmInteger\"          lcmIntegerName          lcm,\n  rule_binop          \"andInteger\"          andIntegerName          (.&.),\n  rule_binop          \"orInteger\"           orIntegerName           (.|.),\n  rule_binop          \"xorInteger\"          xorIntegerName          xor,\n  rule_unop           \"complementInteger\"   complementIntegerName   complement,\n  rule_shift_op       \"shiftLInteger\"       shiftLIntegerName       shiftL,\n  rule_shift_op       \"shiftRInteger\"       shiftRIntegerName       shiftR,\n  rule_bitInteger     \"bitInteger\"          bitIntegerName,\n  -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs\n  rule_divop_one      \"quotInteger\"         quotIntegerName         quot,\n  rule_divop_one      \"remInteger\"          remIntegerName          rem,\n  rule_divop_one      \"divInteger\"          divIntegerName          div,\n  rule_divop_one      \"modInteger\"          modIntegerName          mod,\n  rule_divop_both     \"divModInteger\"       divModIntegerName       divMod,\n  rule_divop_both     \"quotRemInteger\"      quotRemIntegerName      quotRem,\n  -- These rules below don't actually have to be built in, but if we\n  -- put them in the Haskell source then we'd have to duplicate them\n  -- between all Integer implementations\n  rule_XToIntegerToX \"smallIntegerToInt\"       integerToIntName    smallIntegerName,\n  rule_XToIntegerToX \"wordToIntegerToWord\"     integerToWordName   wordToIntegerName,\n  rule_XToIntegerToX \"int64ToIntegerToInt64\"   integerToInt64Name  int64ToIntegerName,\n  rule_XToIntegerToX \"word64ToIntegerToWord64\" integerToWord64Name word64ToIntegerName,\n  rule_smallIntegerTo \"smallIntegerToWord\"   integerToWordName     Int2WordOp,\n  rule_smallIntegerTo \"smallIntegerToFloat\"  floatFromIntegerName  Int2FloatOp,\n  rule_smallIntegerTo \"smallIntegerToDouble\" doubleFromIntegerName Int2DoubleOp\n  ]\n    where rule_convert str name convert\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_Integer_convert convert }\n          rule_IntToInteger str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_IntToInteger }\n          rule_WordToInteger str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_WordToInteger }\n          rule_Int64ToInteger str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_Int64ToInteger }\n          rule_Word64ToInteger str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_Word64ToInteger }\n          rule_unop str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_Integer_unop op }\n          rule_bitInteger str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_bitInteger }\n          rule_binop str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Integer_binop op }\n          rule_divop_both str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Integer_divop_both op }\n          rule_divop_one str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Integer_divop_one op }\n          rule_shift_op str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Integer_shift_op op }\n          rule_binop_Prim str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Integer_binop_Prim op }\n          rule_binop_Ordering str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Integer_binop_Ordering op }\n          rule_encodeFloat str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Integer_Int_encodeFloat op }\n          rule_decodeDouble str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_decodeDouble }\n          rule_XToIntegerToX str name toIntegerName\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_XToIntegerToX toIntegerName }\n          rule_smallIntegerTo str name primOp\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_smallIntegerTo primOp }\n          rule_rationalTo str name mkLit\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_rationalTo mkLit }\n\nbuiltinNaturalRules :: [CoreRule]\nbuiltinNaturalRules =\n [rule_binop              \"plusNatural\"        plusNaturalName         (+)\n ,rule_partial_binop      \"minusNatural\"       minusNaturalName        (\\a b -> if a >= b then Just (a - b) else Nothing)\n ,rule_binop              \"timesNatural\"       timesNaturalName        (*)\n ,rule_NaturalFromInteger \"naturalFromInteger\" naturalFromIntegerName\n ,rule_NaturalToInteger   \"naturalToInteger\"   naturalToIntegerName\n ,rule_WordToNatural      \"wordToNatural\"      wordToNaturalName\n ]\n    where rule_binop str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Natural_binop op }\n          rule_partial_binop str name op\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,\n                           ru_try = match_Natural_partial_binop op }\n          rule_NaturalToInteger str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_NaturalToInteger }\n          rule_NaturalFromInteger str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_NaturalFromInteger }\n          rule_WordToNatural str name\n           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,\n                           ru_try = match_WordToNatural }\n\n---------------------------------------------------\n-- The rule is this:\n--      unpackFoldrCString# \"foo\" c (unpackFoldrCString# \"baz\" c n)\n--      =  unpackFoldrCString# \"foobaz\" c n\n\nmatch_append_lit :: RuleFun\nmatch_append_lit _ id_unf _\n        [ Type ty1\n        , lit1\n        , c1\n        , Var unpk `App` Type ty2\n                   `App` lit2\n                   `App` c2\n                   `App` n\n        ]\n  | unpk `hasKey` unpackCStringFoldrIdKey &&\n    c1 `cheapEqExpr` c2\n  , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1\n  , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2\n  = ASSERT( ty1 `eqType` ty2 )\n    Just (Var unpk `App` Type ty1\n                   `App` Lit (LitString (s1 `BS.append` s2))\n                   `App` c1\n                   `App` n)\n\nmatch_append_lit _ _ _ _ = Nothing\n\n---------------------------------------------------\n-- The rule is this:\n--      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2\n\nmatch_eq_string :: RuleFun\nmatch_eq_string _ id_unf _\n        [Var unpk1 `App` lit1, Var unpk2 `App` lit2]\n  | unpk1 `hasKey` unpackCStringIdKey\n  , unpk2 `hasKey` unpackCStringIdKey\n  , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1\n  , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2\n  = Just (if s1 == s2 then trueValBool else falseValBool)\n\nmatch_eq_string _ _ _ _ = Nothing\n\n\n---------------------------------------------------\n-- The rule is this:\n--      inline f_ty (f a b c) = <f's unfolding> a b c\n-- (if f has an unfolding, EVEN if it's a loop breaker)\n--\n-- It's important to allow the argument to 'inline' to have args itself\n-- (a) because its more forgiving to allow the programmer to write\n--       inline f a b c\n--   or  inline (f a b c)\n-- (b) because a polymorphic f wll get a type argument that the\n--     programmer can't avoid\n--\n-- Also, don't forget about 'inline's type argument!\nmatch_inline :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)\nmatch_inline (Type _ : e : _)\n  | (Var f, args1) <- collectArgs e,\n    Just unf <- maybeUnfoldingTemplate (realIdUnfolding f)\n             -- Ignore the IdUnfoldingFun here!\n  = Just (mkApps unf args1)\n\nmatch_inline _ = Nothing\n\n\n-- See Note [magicDictId magic] in `basicTypes/MkId.hs`\n-- for a description of what is going on here.\nmatch_magicDict :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)\nmatch_magicDict [Type _, Var wrap `App` Type a `App` Type _ `App` f, x, y ]\n  | Just (fieldTy, _)   <- splitFunTy_maybe $ dropForAlls $ idType wrap\n  , Just (dictTy, _)    <- splitFunTy_maybe fieldTy\n  , Just dictTc         <- tyConAppTyCon_maybe dictTy\n  , Just (_,_,co)       <- unwrapNewTyCon_maybe dictTc\n  = Just\n  $ f `App` Cast x (mkSymCo (mkUnbranchedAxInstCo Representational co [a] []))\n      `App` y\n\nmatch_magicDict _ = Nothing\n\n-------------------------------------------------\n-- Integer rules\n--   smallInteger  (79::Int#)  = 79::Integer\n--   wordToInteger (79::Word#) = 79::Integer\n-- Similarly Int64, Word64\n\nmatch_IntToInteger :: RuleFun\nmatch_IntToInteger = match_IntToInteger_unop id\n\nmatch_WordToInteger :: RuleFun\nmatch_WordToInteger _ id_unf id [xl]\n  | Just (LitNumber LitNumWord x _) <- exprIsLiteral_maybe id_unf xl\n  = case splitFunTy_maybe (idType id) of\n    Just (_, integerTy) ->\n        Just (Lit (mkLitInteger x integerTy))\n    _ ->\n        panic \"match_WordToInteger: Id has the wrong type\"\nmatch_WordToInteger _ _ _ _ = Nothing\n\nmatch_Int64ToInteger :: RuleFun\nmatch_Int64ToInteger _ id_unf id [xl]\n  | Just (LitNumber LitNumInt64 x _) <- exprIsLiteral_maybe id_unf xl\n  = case splitFunTy_maybe (idType id) of\n    Just (_, integerTy) ->\n        Just (Lit (mkLitInteger x integerTy))\n    _ ->\n        panic \"match_Int64ToInteger: Id has the wrong type\"\nmatch_Int64ToInteger _ _ _ _ = Nothing\n\nmatch_Word64ToInteger :: RuleFun\nmatch_Word64ToInteger _ id_unf id [xl]\n  | Just (LitNumber LitNumWord64 x _) <- exprIsLiteral_maybe id_unf xl\n  = case splitFunTy_maybe (idType id) of\n    Just (_, integerTy) ->\n        Just (Lit (mkLitInteger x integerTy))\n    _ ->\n        panic \"match_Word64ToInteger: Id has the wrong type\"\nmatch_Word64ToInteger _ _ _ _ = Nothing\n\nmatch_NaturalToInteger :: RuleFun\nmatch_NaturalToInteger _ id_unf id [xl]\n  | Just (LitNumber LitNumNatural x _) <- exprIsLiteral_maybe id_unf xl\n  = case splitFunTy_maybe (idType id) of\n    Just (_, naturalTy) ->\n        Just (Lit (LitNumber LitNumInteger x naturalTy))\n    _ ->\n        panic \"match_NaturalToInteger: Id has the wrong type\"\nmatch_NaturalToInteger _ _ _ _ = Nothing\n\nmatch_NaturalFromInteger :: RuleFun\nmatch_NaturalFromInteger _ id_unf id [xl]\n  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl\n  , x >= 0\n  = case splitFunTy_maybe (idType id) of\n    Just (_, naturalTy) ->\n        Just (Lit (LitNumber LitNumNatural x naturalTy))\n    _ ->\n        panic \"match_NaturalFromInteger: Id has the wrong type\"\nmatch_NaturalFromInteger _ _ _ _ = Nothing\n\nmatch_WordToNatural :: RuleFun\nmatch_WordToNatural _ id_unf id [xl]\n  | Just (LitNumber LitNumWord x _) <- exprIsLiteral_maybe id_unf xl\n  = case splitFunTy_maybe (idType id) of\n    Just (_, naturalTy) ->\n        Just (Lit (LitNumber LitNumNatural x naturalTy))\n    _ ->\n        panic \"match_WordToNatural: Id has the wrong type\"\nmatch_WordToNatural _ _ _ _ = Nothing\n\n-------------------------------------------------\n{- Note [Rewriting bitInteger]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor most types the bitInteger operation can be implemented in terms of shifts.\nThe integer-gmp package, however, can do substantially better than this if\nallowed to provide its own implementation. However, in so doing it previously lost\nconstant-folding (see Trac #8832). The bitInteger rule above provides constant folding\nspecifically for this function.\n\nThere is, however, a bit of trickiness here when it comes to ranges. While the\nAST encodes all integers as Integers, `bit` expects the bit\nindex to be given as an Int. Hence we coerce to an Int in the rule definition.\nThis will behave a bit funny for constants larger than the word size, but the user\nshould expect some funniness given that they will have at very least ignored a\nwarning in this case.\n-}\n\nmatch_bitInteger :: RuleFun\n-- Just for GHC.Integer.Type.bitInteger :: Int# -> Integer\nmatch_bitInteger dflags id_unf fn [arg]\n  | Just (LitNumber LitNumInt x _) <- exprIsLiteral_maybe id_unf arg\n  , x >= 0\n  , x <= (wordSizeInBits dflags - 1)\n    -- Make sure x is small enough to yield a decently small iteger\n    -- Attempting to construct the Integer for\n    --    (bitInteger 9223372036854775807#)\n    -- would be a bad idea (Trac #14959)\n  , let x_int = fromIntegral x :: Int\n  = case splitFunTy_maybe (idType fn) of\n    Just (_, integerTy)\n      -> Just (Lit (LitNumber LitNumInteger (bit x_int) integerTy))\n    _ -> panic \"match_IntToInteger_unop: Id has the wrong type\"\n\nmatch_bitInteger _ _ _ _ = Nothing\n\n\n-------------------------------------------------\nmatch_Integer_convert :: Num a\n                      => (DynFlags -> a -> Expr CoreBndr)\n                      -> RuleFun\nmatch_Integer_convert convert dflags id_unf _ [xl]\n  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl\n  = Just (convert dflags (fromInteger x))\nmatch_Integer_convert _ _ _ _ _ = Nothing\n\nmatch_Integer_unop :: (Integer -> Integer) -> RuleFun\nmatch_Integer_unop unop _ id_unf _ [xl]\n  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl\n  = Just (Lit (LitNumber LitNumInteger (unop x) i))\nmatch_Integer_unop _ _ _ _ _ = Nothing\n\nmatch_IntToInteger_unop :: (Integer -> Integer) -> RuleFun\nmatch_IntToInteger_unop unop _ id_unf fn [xl]\n  | Just (LitNumber LitNumInt x _) <- exprIsLiteral_maybe id_unf xl\n  = case splitFunTy_maybe (idType fn) of\n    Just (_, integerTy) ->\n        Just (Lit (LitNumber LitNumInteger (unop x) integerTy))\n    _ ->\n        panic \"match_IntToInteger_unop: Id has the wrong type\"\nmatch_IntToInteger_unop _ _ _ _ _ = Nothing\n\nmatch_Integer_binop :: (Integer -> Integer -> Integer) -> RuleFun\nmatch_Integer_binop binop _ id_unf _ [xl,yl]\n  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl\n  = Just (Lit (mkLitInteger (x `binop` y) i))\nmatch_Integer_binop _ _ _ _ _ = Nothing\n\nmatch_Natural_binop :: (Integer -> Integer -> Integer) -> RuleFun\nmatch_Natural_binop binop _ id_unf _ [xl,yl]\n  | Just (LitNumber LitNumNatural x i) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumNatural y _) <- exprIsLiteral_maybe id_unf yl\n  = Just (Lit (mkLitNatural (x `binop` y) i))\nmatch_Natural_binop _ _ _ _ _ = Nothing\n\nmatch_Natural_partial_binop :: (Integer -> Integer -> Maybe Integer) -> RuleFun\nmatch_Natural_partial_binop binop _ id_unf _ [xl,yl]\n  | Just (LitNumber LitNumNatural x i) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumNatural y _) <- exprIsLiteral_maybe id_unf yl\n  , Just z <- x `binop` y\n  = Just (Lit (mkLitNatural z i))\nmatch_Natural_partial_binop _ _ _ _ _ = Nothing\n\n-- This helper is used for the quotRem and divMod functions\nmatch_Integer_divop_both\n   :: (Integer -> Integer -> (Integer, Integer)) -> RuleFun\nmatch_Integer_divop_both divop _ id_unf _ [xl,yl]\n  | Just (LitNumber LitNumInteger x t) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl\n  , y /= 0\n  , (r,s) <- x `divop` y\n  = Just $ mkCoreUbxTup [t,t] [Lit (mkLitInteger r t), Lit (mkLitInteger s t)]\nmatch_Integer_divop_both _ _ _ _ _ = Nothing\n\n-- This helper is used for the quot and rem functions\nmatch_Integer_divop_one :: (Integer -> Integer -> Integer) -> RuleFun\nmatch_Integer_divop_one divop _ id_unf _ [xl,yl]\n  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl\n  , y /= 0\n  = Just (Lit (mkLitInteger (x `divop` y) i))\nmatch_Integer_divop_one _ _ _ _ _ = Nothing\n\nmatch_Integer_shift_op :: (Integer -> Int -> Integer) -> RuleFun\n-- Used for shiftLInteger, shiftRInteger :: Integer -> Int# -> Integer\n-- See Note [Guarding against silly shifts]\nmatch_Integer_shift_op binop _ id_unf _ [xl,yl]\n  | Just (LitNumber LitNumInteger x i) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInt y _)     <- exprIsLiteral_maybe id_unf yl\n  , y >= 0\n  , y <= 4   -- Restrict constant-folding of shifts on Integers, somewhat\n             -- arbitrary.  We can get huge shifts in inaccessible code\n             -- (Trac #15673)\n  = Just (Lit (mkLitInteger (x `binop` fromIntegral y) i))\nmatch_Integer_shift_op _ _ _ _ _ = Nothing\n\nmatch_Integer_binop_Prim :: (Integer -> Integer -> Bool) -> RuleFun\nmatch_Integer_binop_Prim binop dflags id_unf _ [xl, yl]\n  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl\n  = Just (if x `binop` y then trueValInt dflags else falseValInt dflags)\nmatch_Integer_binop_Prim _ _ _ _ _ = Nothing\n\nmatch_Integer_binop_Ordering :: (Integer -> Integer -> Ordering) -> RuleFun\nmatch_Integer_binop_Ordering binop _ id_unf _ [xl, yl]\n  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl\n  = Just $ case x `binop` y of\n             LT -> ltVal\n             EQ -> eqVal\n             GT -> gtVal\nmatch_Integer_binop_Ordering _ _ _ _ _ = Nothing\n\nmatch_Integer_Int_encodeFloat :: RealFloat a\n                              => (a -> Expr CoreBndr)\n                              -> RuleFun\nmatch_Integer_Int_encodeFloat mkLit _ id_unf _ [xl,yl]\n  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInt y _)     <- exprIsLiteral_maybe id_unf yl\n  = Just (mkLit $ encodeFloat x (fromInteger y))\nmatch_Integer_Int_encodeFloat _ _ _ _ _ = Nothing\n\n---------------------------------------------------\n-- constant folding for Float/Double\n--\n-- This turns\n--      rationalToFloat n d\n-- into a literal Float, and similarly for Doubles.\n--\n-- it's important to not match d == 0, because that may represent a\n-- literal \"0/0\" or similar, and we can't produce a literal value for\n-- NaN or +-Inf\nmatch_rationalTo :: RealFloat a\n                 => (a -> Expr CoreBndr)\n                 -> RuleFun\nmatch_rationalTo mkLit _ id_unf _ [xl, yl]\n  | Just (LitNumber LitNumInteger x _) <- exprIsLiteral_maybe id_unf xl\n  , Just (LitNumber LitNumInteger y _) <- exprIsLiteral_maybe id_unf yl\n  , y /= 0\n  = Just (mkLit (fromRational (x % y)))\nmatch_rationalTo _ _ _ _ _ = Nothing\n\nmatch_decodeDouble :: RuleFun\nmatch_decodeDouble dflags id_unf fn [xl]\n  | Just (LitDouble x) <- exprIsLiteral_maybe id_unf xl\n  = case splitFunTy_maybe (idType fn) of\n    Just (_, res)\n      | Just [_lev1, _lev2, integerTy, intHashTy] <- tyConAppArgs_maybe res\n      -> case decodeFloat (fromRational x :: Double) of\n           (y, z) ->\n             Just $ mkCoreUbxTup [integerTy, intHashTy]\n                                 [Lit (mkLitInteger y integerTy),\n                                  Lit (mkLitInt dflags (toInteger z))]\n    _ ->\n        pprPanic \"match_decodeDouble: Id has the wrong type\"\n          (ppr fn <+> dcolon <+> ppr (idType fn))\nmatch_decodeDouble _ _ _ _ = Nothing\n\nmatch_XToIntegerToX :: Name -> RuleFun\nmatch_XToIntegerToX n _ _ _ [App (Var x) y]\n  | idName x == n\n  = Just y\nmatch_XToIntegerToX _ _ _ _ _ = Nothing\n\nmatch_smallIntegerTo :: PrimOp -> RuleFun\nmatch_smallIntegerTo primOp _ _ _ [App (Var x) y]\n  | idName x == smallIntegerName\n  = Just $ App (Var (mkPrimOpId primOp)) y\nmatch_smallIntegerTo _ _ _ _ _ = Nothing\n\n\n\n--------------------------------------------------------\n-- Note [Constant folding through nested expressions]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- We use rewrites rules to perform constant folding. It means that we don't\n-- have a global view of the expression we are trying to optimise. As a\n-- consequence we only perform local (small-step) transformations that either:\n--    1) reduce the number of operations\n--    2) rearrange the expression to increase the odds that other rules will\n--    match\n--\n-- We don't try to handle more complex expression optimisation cases that would\n-- require a global view. For example, rewriting expressions to increase\n-- sharing (e.g., Horner's method); optimisations that require local\n-- transformations increasing the number of operations; rearrangements to\n-- cancel/factorize terms (e.g., (a+b-a-b) isn't rearranged to reduce to 0).\n--\n-- We already have rules to perform constant folding on expressions with the\n-- following shape (where a and/or b are literals):\n--\n--          D)    op\n--                /\\\n--               /  \\\n--              /    \\\n--             a      b\n--\n-- To support nested expressions, we match three other shapes of expression\n-- trees:\n--\n-- A)   op1          B)       op1       C)       op1\n--      /\\                    /\\                 /\\\n--     /  \\                  /  \\               /  \\\n--    /    \\                /    \\             /    \\\n--   a     op2            op2     c          op2    op3\n--          /\\            /\\                 /\\      /\\\n--         /  \\          /  \\               /  \\    /  \\\n--        b    c        a    b             a    b  c    d\n--\n--\n-- R1) +/- simplification:\n--    ops = + or -, two literals (not siblings)\n--\n--    Examples:\n--       A: 5 + (10-x)  ==> 15-x\n--       B: (10+x) + 5  ==> 15+x\n--       C: (5+a)-(5-b) ==> 0+(a+b)\n--\n-- R2) * simplification\n--    ops = *, two literals (not siblings)\n--\n--    Examples:\n--       A: 5 * (10*x)  ==> 50*x\n--       B: (10*x) * 5  ==> 50*x\n--       C: (5*a)*(5*b) ==> 25*(a*b)\n--\n-- R3) * distribution over +/-\n--    op1 = *, op2 = + or -, two literals (not siblings)\n--\n--    This transformation doesn't reduce the number of operations but switches\n--    the outer and the inner operations so that the outer is (+) or (-) instead\n--    of (*). It increases the odds that other rules will match after this one.\n--\n--    Examples:\n--       A: 5 * (10-x)  ==> 50 - (5*x)\n--       B: (10+x) * 5  ==> 50 + (5*x)\n--       C: Not supported as it would increase the number of operations:\n--          (5+a)*(5-b) ==> 25 - 5*b + 5*a - a*b\n--\n-- R4) Simple factorization\n--\n--    op1 = + or -, op2/op3 = *,\n--    one literal for each innermost * operation (except in the D case),\n--    the two other terms are equals\n--\n--    Examples:\n--       A: x - (10*x)  ==> (-9)*x\n--       B: (10*x) + x  ==> 11*x\n--       C: (5*x)-(x*3) ==> 2*x\n--       D: x+x         ==> 2*x\n--\n-- R5) +/- propagation\n--\n--    ops = + or -, one literal\n--\n--    This transformation doesn't reduce the number of operations but propagates\n--    the constant to the outer level. It increases the odds that other rules\n--    will match after this one.\n--\n--    Examples:\n--       A: x - (10-y)  ==> (x+y) - 10\n--       B: (10+x) - y  ==> 10 + (x-y)\n--       C: N/A (caught by the A and B cases)\n--\n--------------------------------------------------------\n\n-- | Rules to perform constant folding into nested expressions\n--\n--See Note [Constant folding through nested expressions]\nnumFoldingRules :: PrimOp -> (DynFlags -> PrimOps) -> RuleM CoreExpr\nnumFoldingRules op dict = do\n  [e1,e2] <- getArgs\n  dflags <- getDynFlags\n  let PrimOps{..} = dict dflags\n  if not (gopt Opt_NumConstantFolding dflags)\n    then mzero\n    else case BinOpApp e1 op e2 of\n     -- R1) +/- simplification\n     x    :++: (y :++: v)          -> return $ mkL (x+y)   `add` v\n     x    :++: (L y :-: v)         -> return $ mkL (x+y)   `sub` v\n     x    :++: (v   :-: L y)       -> return $ mkL (x-y)   `add` v\n     L x  :-:  (y :++: v)          -> return $ mkL (x-y)   `sub` v\n     L x  :-:  (L y :-: v)         -> return $ mkL (x-y)   `add` v\n     L x  :-:  (v   :-: L y)       -> return $ mkL (x+y)   `sub` v\n\n     (y :++: v)    :-: L x         -> return $ mkL (y-x)   `add` v\n     (L y :-: v)   :-: L x         -> return $ mkL (y-x)   `sub` v\n     (v   :-: L y) :-: L x         -> return $ mkL (0-y-x) `add` v\n\n     (x :++: w)  :+: (y :++: v)    -> return $ mkL (x+y)   `add` (w `add` v)\n     (w :-: L x) :+: (L y :-: v)   -> return $ mkL (y-x)   `add` (w `sub` v)\n     (w :-: L x) :+: (v   :-: L y) -> return $ mkL (0-x-y) `add` (w `add` v)\n     (L x :-: w) :+: (L y :-: v)   -> return $ mkL (x+y)   `sub` (w `add` v)\n     (L x :-: w) :+: (v   :-: L y) -> return $ mkL (x-y)   `add` (v `sub` w)\n     (w :-: L x) :+: (y :++: v)    -> return $ mkL (y-x)   `add` (w `add` v)\n     (L x :-: w) :+: (y :++: v)    -> return $ mkL (x+y)   `add` (v `sub` w)\n     (y :++: v)  :+: (w :-: L x)   -> return $ mkL (y-x)   `add` (w `add` v)\n     (y :++: v)  :+: (L x :-: w)   -> return $ mkL (x+y)   `add` (v `sub` w)\n\n     (v   :-: L y) :-: (w :-: L x) -> return $ mkL (x-y)   `add` (v `sub` w)\n     (v   :-: L y) :-: (L x :-: w) -> return $ mkL (0-x-y) `add` (v `add` w)\n     (L y :-:   v) :-: (w :-: L x) -> return $ mkL (x+y)   `sub` (v `add` w)\n     (L y :-:   v) :-: (L x :-: w) -> return $ mkL (y-x)   `add` (w `sub` v)\n     (x :++: w)    :-: (y :++: v)  -> return $ mkL (x-y)   `add` (w `sub` v)\n     (w :-: L x)   :-: (y :++: v)  -> return $ mkL (0-y-x) `add` (w `sub` v)\n     (L x :-: w)   :-: (y :++: v)  -> return $ mkL (x-y)   `sub` (v `add` w)\n     (y :++: v)    :-: (w :-: L x) -> return $ mkL (y+x)   `add` (v `sub` w)\n     (y :++: v)    :-: (L x :-: w) -> return $ mkL (y-x)   `add` (v `add` w)\n\n     -- R2) * simplification\n     x :**: (y :**: v)             -> return $ mkL (x*y)   `mul` v\n     (x :**: w) :*: (y :**: v)     -> return $ mkL (x*y)   `mul` (w `mul` v)\n\n     -- R3) * distribution over +/-\n     x :**: (y :++: v)             -> return $ mkL (x*y)   `add` (mkL x `mul` v)\n     x :**: (L y :-: v)            -> return $ mkL (x*y)   `sub` (mkL x `mul` v)\n     x :**: (v   :-: L y)          -> return $ (mkL x `mul` v) `sub` mkL (x*y)\n\n     -- R4) Simple factorization\n     v :+: w\n      | w `cheapEqExpr` v          -> return $ mkL 2       `mul` v\n     w :+: (y :**: v)\n      | w `cheapEqExpr` v          -> return $ mkL (1+y)   `mul` v\n     w :-: (y :**: v)\n      | w `cheapEqExpr` v          -> return $ mkL (1-y)   `mul` v\n     (y :**: v) :+: w\n      | w `cheapEqExpr` v          -> return $ mkL (y+1)   `mul` v\n     (y :**: v) :-: w\n      | w `cheapEqExpr` v          -> return $ mkL (y-1)   `mul` v\n     (x :**: w) :+: (y :**: v)\n      | w `cheapEqExpr` v          -> return $ mkL (x+y)   `mul` v\n     (x :**: w) :-: (y :**: v)\n      | w `cheapEqExpr` v          -> return $ mkL (x-y)   `mul` v\n\n     -- R5) +/- propagation\n     w  :+: (y :++: v)             -> return $ mkL y `add` (w `add` v)\n     (y :++: v) :+: w              -> return $ mkL y       `add` (w `add` v)\n     w  :-: (y :++: v)             -> return $ (w `sub` v) `sub` mkL y\n     (y :++: v) :-: w              -> return $ mkL y       `add` (v `sub` w)\n     w    :-: (L y :-: v)          -> return $ (w `add` v) `sub` mkL y\n     (L y :-: v) :-: w             -> return $ mkL y       `sub` (w `add` v)\n     w    :+: (L y :-: v)          -> return $ mkL y       `add` (w `sub` v)\n     w    :+: (v :-: L y)          -> return $ (w `add` v) `sub` mkL y\n     (L y :-: v) :+: w             -> return $ mkL y       `add` (w `sub` v)\n     (v :-: L y) :+: w             -> return $ (w `add` v) `sub` mkL y\n\n     _                             -> mzero\n\n\n\n-- | Match the application of a binary primop\npattern BinOpApp  :: Arg CoreBndr -> PrimOp -> Arg CoreBndr -> CoreExpr\npattern BinOpApp  x op y =  OpVal op `App` x `App` y\n\n-- | Match a primop\npattern OpVal   :: PrimOp  -> Arg CoreBndr\npattern OpVal   op     <- Var (isPrimOpId_maybe -> Just op) where\n   OpVal op = Var (mkPrimOpId op)\n\n\n\n-- | Match a literal\npattern L :: Integer -> Arg CoreBndr\npattern L l <- Lit (isLitValue_maybe -> Just l)\n\n-- | Match an addition\npattern (:+:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr\npattern x :+: y <- BinOpApp x (isAddOp -> True) y\n\n-- | Match an addition with a literal (handle commutativity)\npattern (:++:) :: Integer -> Arg CoreBndr -> CoreExpr\npattern l :++: x <- (isAdd -> Just (l,x))\n\nisAdd :: CoreExpr -> Maybe (Integer,CoreExpr)\nisAdd e = case e of\n   L l :+: x   -> Just (l,x)\n   x   :+: L l -> Just (l,x)\n   _           -> Nothing\n\n-- | Match a multiplication\npattern (:*:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr\npattern x :*: y <- BinOpApp x (isMulOp -> True) y\n\n-- | Match a multiplication with a literal (handle commutativity)\npattern (:**:) :: Integer -> Arg CoreBndr -> CoreExpr\npattern l :**: x <- (isMul -> Just (l,x))\n\nisMul :: CoreExpr -> Maybe (Integer,CoreExpr)\nisMul e = case e of\n   L l :*: x   -> Just (l,x)\n   x   :*: L l -> Just (l,x)\n   _           -> Nothing\n\n\n-- | Match a subtraction\npattern (:-:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr\npattern x :-: y <- BinOpApp x (isSubOp -> True) y\n\nisSubOp :: PrimOp -> Bool\nisSubOp IntSubOp  = True\nisSubOp WordSubOp = True\nisSubOp _         = False\n\nisAddOp :: PrimOp -> Bool\nisAddOp IntAddOp  = True\nisAddOp WordAddOp = True\nisAddOp _         = False\n\nisMulOp :: PrimOp -> Bool\nisMulOp IntMulOp  = True\nisMulOp WordMulOp = True\nisMulOp _         = False\n\n-- | Explicit \"type-class\"-like dictionary for numeric primops\n--\n-- Depends on DynFlags because creating a literal value depends on DynFlags\ndata PrimOps = PrimOps\n   { add :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Add two numbers\n   , sub :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Sub two numbers\n   , mul :: CoreExpr -> CoreExpr -> CoreExpr -- ^ Multiply two numbers\n   , mkL :: Integer -> CoreExpr              -- ^ Create a literal value\n   }\n\nintPrimOps :: DynFlags -> PrimOps\nintPrimOps dflags = PrimOps\n   { add = \\x y -> BinOpApp x IntAddOp y\n   , sub = \\x y -> BinOpApp x IntSubOp y\n   , mul = \\x y -> BinOpApp x IntMulOp y\n   , mkL = intResult' dflags\n   }\n\nwordPrimOps :: DynFlags -> PrimOps\nwordPrimOps dflags = PrimOps\n   { add = \\x y -> BinOpApp x WordAddOp y\n   , sub = \\x y -> BinOpApp x WordSubOp y\n   , mul = \\x y -> BinOpApp x WordMulOp y\n   , mkL = wordResult' dflags\n   }\n\n\n--------------------------------------------------------\n-- Constant folding through case-expressions\n--\n-- cf Scrutinee Constant Folding in simplCore/SimplUtils\n--------------------------------------------------------\n\n-- | Match the scrutinee of a case and potentially return a new scrutinee and a\n-- function to apply to each literal alternative.\ncaseRules :: DynFlags\n          -> CoreExpr                       -- Scrutinee\n          -> Maybe ( CoreExpr               -- New scrutinee\n                   , AltCon -> Maybe AltCon -- How to fix up the alt pattern\n                                            --   Nothing <=> Unreachable\n                                            -- See Note [Unreachable caseRules alternatives]\n                   , Id -> CoreExpr)        -- How to reconstruct the original scrutinee\n                                            -- from the new case-binder\n-- e.g  case e of b {\n--         ...;\n--         con bs -> rhs;\n--         ... }\n--  ==>\n--      case e' of b' {\n--         ...;\n--         fixup_altcon[con] bs -> let b = mk_orig[b] in rhs;\n--         ... }\n\ncaseRules dflags (App (App (Var f) v) (Lit l))   -- v `op` x#\n  | Just op <- isPrimOpId_maybe f\n  , Just x  <- isLitValue_maybe l\n  , Just adjust_lit <- adjustDyadicRight op x\n  = Just (v, tx_lit_con dflags adjust_lit\n           , \\v -> (App (App (Var f) (Var v)) (Lit l)))\n\ncaseRules dflags (App (App (Var f) (Lit l)) v)   -- x# `op` v\n  | Just op <- isPrimOpId_maybe f\n  , Just x  <- isLitValue_maybe l\n  , Just adjust_lit <- adjustDyadicLeft x op\n  = Just (v, tx_lit_con dflags adjust_lit\n           , \\v -> (App (App (Var f) (Lit l)) (Var v)))\n\n\ncaseRules dflags (App (Var f) v              )   -- op v\n  | Just op <- isPrimOpId_maybe f\n  , Just adjust_lit <- adjustUnary op\n  = Just (v, tx_lit_con dflags adjust_lit\n           , \\v -> App (Var f) (Var v))\n\n-- See Note [caseRules for tagToEnum]\ncaseRules dflags (App (App (Var f) type_arg) v)\n  | Just TagToEnumOp <- isPrimOpId_maybe f\n  = Just (v, tx_con_tte dflags\n           , \\v -> (App (App (Var f) type_arg) (Var v)))\n\n-- See Note [caseRules for dataToTag]\ncaseRules _ (App (App (Var f) (Type ty)) v)       -- dataToTag x\n  | Just DataToTagOp <- isPrimOpId_maybe f\n  , Just (tc, _) <- tcSplitTyConApp_maybe ty\n  , isAlgTyCon tc\n  = Just (v, tx_con_dtt ty\n           , \\v -> App (App (Var f) (Type ty)) (Var v))\n\ncaseRules _ _ = Nothing\n\n\ntx_lit_con :: DynFlags -> (Integer -> Integer) -> AltCon -> Maybe AltCon\ntx_lit_con _      _      DEFAULT    = Just DEFAULT\ntx_lit_con dflags adjust (LitAlt l) = Just $ LitAlt (mapLitValue dflags adjust l)\ntx_lit_con _      _      alt        = pprPanic \"caseRules\" (ppr alt)\n   -- NB: mapLitValue uses mkLitIntWrap etc, to ensure that the\n   -- literal alternatives remain in Word/Int target ranges\n   -- (See Note [Word/Int underflow/overflow] in Literal and #13172).\n\nadjustDyadicRight :: PrimOp -> Integer -> Maybe (Integer -> Integer)\n-- Given (x `op` lit) return a function 'f' s.t.  f (x `op` lit) = x\nadjustDyadicRight op lit\n  = case op of\n         WordAddOp -> Just (\\y -> y-lit      )\n         IntAddOp  -> Just (\\y -> y-lit      )\n         WordSubOp -> Just (\\y -> y+lit      )\n         IntSubOp  -> Just (\\y -> y+lit      )\n         XorOp     -> Just (\\y -> y `xor` lit)\n         XorIOp    -> Just (\\y -> y `xor` lit)\n         _         -> Nothing\n\nadjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)\n-- Given (lit `op` x) return a function 'f' s.t.  f (lit `op` x) = x\nadjustDyadicLeft lit op\n  = case op of\n         WordAddOp -> Just (\\y -> y-lit      )\n         IntAddOp  -> Just (\\y -> y-lit      )\n         WordSubOp -> Just (\\y -> lit-y      )\n         IntSubOp  -> Just (\\y -> lit-y      )\n         XorOp     -> Just (\\y -> y `xor` lit)\n         XorIOp    -> Just (\\y -> y `xor` lit)\n         _         -> Nothing\n\n\nadjustUnary :: PrimOp -> Maybe (Integer -> Integer)\n-- Given (op x) return a function 'f' s.t.  f (op x) = x\nadjustUnary op\n  = case op of\n         NotOp     -> Just (\\y -> complement y)\n         NotIOp    -> Just (\\y -> complement y)\n         IntNegOp  -> Just (\\y -> negate y    )\n         _         -> Nothing\n\ntx_con_tte :: DynFlags -> AltCon -> Maybe AltCon\ntx_con_tte _      DEFAULT         = Just DEFAULT\ntx_con_tte _      alt@(LitAlt {}) = pprPanic \"caseRules\" (ppr alt)\ntx_con_tte dflags (DataAlt dc)  -- See Note [caseRules for tagToEnum]\n  = Just $ LitAlt $ mkLitInt dflags $ toInteger $ dataConTagZ dc\n\ntx_con_dtt :: Type -> AltCon -> Maybe AltCon\ntx_con_dtt _  DEFAULT = Just DEFAULT\ntx_con_dtt ty (LitAlt (LitNumber LitNumInt i _))\n   | tag >= 0\n   , tag < n_data_cons\n   = Just (DataAlt (data_cons !! tag))   -- tag is zero-indexed, as is (!!)\n   | otherwise\n   = Nothing\n   where\n     tag         = fromInteger i :: ConTagZ\n     tc          = tyConAppTyCon ty\n     n_data_cons = tyConFamilySize tc\n     data_cons   = tyConDataCons tc\n\ntx_con_dtt _ alt = pprPanic \"caseRules\" (ppr alt)\n\n\n{- Note [caseRules for tagToEnum]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to transform\n   case tagToEnum x of\n     False -> e1\n     True  -> e2\ninto\n   case x of\n     0# -> e1\n     1# -> e2\n\nThis rule eliminates a lot of boilerplate. For\n  if (x>y) then e2 else e1\nwe generate\n  case tagToEnum (x ># y) of\n    False -> e1\n    True  -> e2\nand it is nice to then get rid of the tagToEnum.\n\nBeware (Trac #14768): avoid the temptation to map constructor 0 to\nDEFAULT, in the hope of getting this\n  case (x ># y) of\n    DEFAULT -> e1\n    1#      -> e2\nThat fails utterly in the case of\n   data Colour = Red | Green | Blue\n   case tagToEnum x of\n      DEFAULT -> e1\n      Red     -> e2\n\nWe don't want to get this!\n   case x of\n      DEFAULT -> e1\n      DEFAULT -> e2\n\nInstead, we deal with turning one branch into DEFAULT in SimplUtils\n(add_default in mkCase3).\n\nNote [caseRules for dataToTag]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee also Note [dataToTag#] in primpops.txt.pp\n\nWe want to transform\n  case dataToTag x of\n    DEFAULT -> e1\n    1# -> e2\ninto\n  case x of\n    DEFAULT -> e1\n    (:) _ _ -> e2\n\nNote the need for some wildcard binders in\nthe 'cons' case.\n\nFor the time, we only apply this transformation when the type of `x` is a type\nheaded by a normal tycon. In particular, we do not apply this in the case of a\ndata family tycon, since that would require carefully applying coercion(s)\nbetween the data family and the data family instance's representation type,\nwhich caseRules isn't currently engineered to handle (#14680).\n\nNote [Unreachable caseRules alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTake care if we see something like\n  case dataToTag x of\n    DEFAULT -> e1\n    -1# -> e2\n    100 -> e3\nbecause there isn't a data constructor with tag -1 or 100. In this case the\nout-of-range alterantive is dead code -- we know the range of tags for x.\n\nHence caseRules returns (AltCon -> Maybe AltCon), with Nothing indicating\nan alternative that is unreachable.\n\nYou may wonder how this can happen: check out Trac #15436.\n-}\n", "num_lines": 2173}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[PrimOp]{Primitive operations (machine-level)}\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- The default is a bit too low for the quite large primOpInfo definition\n{-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}\n\nmodule PrimOp (\n        PrimOp(..), PrimOpVecCat(..), allThePrimOps,\n        primOpType, primOpSig,\n        primOpTag, maxPrimOpTag, primOpOcc,\n\n        tagToEnumKey,\n\n        primOpOutOfLine, primOpCodeSize,\n        primOpOkForSpeculation, primOpOkForSideEffects,\n        primOpIsCheap, primOpFixity,\n\n        getPrimOpResultInfo,  isComparisonPrimOp, PrimOpResultInfo(..),\n\n        PrimCall(..)\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TysPrim\nimport TysWiredIn\n\nimport CmmType\nimport Demand\nimport OccName          ( OccName, pprOccName, mkVarOccFS )\nimport TyCon            ( TyCon, isPrimTyCon, PrimRep(..) )\nimport Type\nimport RepType          ( typePrimRep1, tyConPrimRep1 )\nimport BasicTypes       ( Arity, Fixity(..), FixityDirection(..), Boxity(..),\n                          SourceText(..) )\nimport ForeignCall      ( CLabelString )\nimport Unique           ( Unique, mkPrimOpIdUnique )\nimport Outputable\nimport FastString\nimport Module           ( UnitId )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}\n*                                                                      *\n************************************************************************\n\nThese are in \\tr{state-interface.verb} order.\n-}\n\n-- supplies:\n-- data PrimOp = ...\n#include \"primop-data-decl.hs-incl\"\n\n-- supplies\n-- primOpTag :: PrimOp -> Int\n#include \"primop-tag.hs-incl\"\nprimOpTag _ = error \"primOpTag: unknown primop\"\n\n\ninstance Eq PrimOp where\n    op1 == op2 = primOpTag op1 == primOpTag op2\n\ninstance Ord PrimOp where\n    op1 <  op2 =  primOpTag op1 < primOpTag op2\n    op1 <= op2 =  primOpTag op1 <= primOpTag op2\n    op1 >= op2 =  primOpTag op1 >= primOpTag op2\n    op1 >  op2 =  primOpTag op1 > primOpTag op2\n    op1 `compare` op2 | op1 < op2  = LT\n                      | op1 == op2 = EQ\n                      | otherwise  = GT\n\ninstance Outputable PrimOp where\n    ppr op = pprPrimOp op\n\ndata PrimOpVecCat = IntVec\n                  | WordVec\n                  | FloatVec\n\n-- An @Enum@-derived list would be better; meanwhile... (ToDo)\n\nallThePrimOps :: [PrimOp]\nallThePrimOps =\n#include \"primop-list.hs-incl\"\n\ntagToEnumKey :: Unique\ntagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[PrimOp-info]{The essential info about each @PrimOp@}\n*                                                                      *\n************************************************************************\n\nThe @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may\nrefer to the primitive operation.  The conventional \\tr{#}-for-\nunboxed ops is added on later.\n\nThe reason for the funny characters in the names is so we do not\ninterfere with the programmer's Haskell name spaces.\n\nWe use @PrimKinds@ for the ``type'' information, because they're\n(slightly) more convenient to use than @TyCons@.\n-}\n\ndata PrimOpInfo\n  = Dyadic      OccName         -- string :: T -> T -> T\n                Type\n  | Monadic     OccName         -- string :: T -> T\n                Type\n  | Compare     OccName         -- string :: T -> T -> Int#\n                Type\n  | GenPrimOp   OccName         -- string :: \\/a1..an . T1 -> .. -> Tk -> T\n                [TyVar]\n                [Type]\n                Type\n\nmkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo\nmkDyadic str  ty = Dyadic  (mkVarOccFS str) ty\nmkMonadic str ty = Monadic (mkVarOccFS str) ty\nmkCompare str ty = Compare (mkVarOccFS str) ty\n\nmkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo\nmkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Strictness}\n*                                                                      *\n************************************************************************\n\nNot all primops are strict!\n-}\n\nprimOpStrictness :: PrimOp -> Arity -> StrictSig\n        -- See Demand.StrictnessInfo for discussion of what the results\n        -- The arity should be the arity of the primop; that's why\n        -- this function isn't exported.\n#include \"primop-strictness.hs-incl\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Fixity}\n*                                                                      *\n************************************************************************\n-}\n\nprimOpFixity :: PrimOp -> Maybe Fixity\n#include \"primop-fixity.hs-incl\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}\n*                                                                      *\n************************************************************************\n\n@primOpInfo@ gives all essential information (from which everything\nelse, notably a type, can be constructed) for each @PrimOp@.\n-}\n\nprimOpInfo :: PrimOp -> PrimOpInfo\n#include \"primop-primop-info.hs-incl\"\nprimOpInfo _ = error \"primOpInfo: unknown primop\"\n\n{-\nHere are a load of comments from the old primOp info:\n\nA @Word#@ is an unsigned @Int#@.\n\n@decodeFloat#@ is given w/ Integer-stuff (it's similar).\n\n@decodeDouble#@ is given w/ Integer-stuff (it's similar).\n\nDecoding of floating-point numbers is sorta Integer-related.  Encoding\nis done with plain ccalls now (see PrelNumExtra.hs).\n\nA @Weak@ Pointer is created by the @mkWeak#@ primitive:\n\n        mkWeak# :: k -> v -> f -> State# RealWorld\n                        -> (# State# RealWorld, Weak# v #)\n\nIn practice, you'll use the higher-level\n\n        data Weak v = Weak# v\n        mkWeak :: k -> v -> IO () -> IO (Weak v)\n\nThe following operation dereferences a weak pointer.  The weak pointer\nmay have been finalized, so the operation returns a result code which\nmust be inspected before looking at the dereferenced value.\n\n        deRefWeak# :: Weak# v -> State# RealWorld ->\n                        (# State# RealWorld, v, Int# #)\n\nOnly look at v if the Int# returned is /= 0 !!\n\nThe higher-level op is\n\n        deRefWeak :: Weak v -> IO (Maybe v)\n\nWeak pointers can be finalized early by using the finalize# operation:\n\n        finalizeWeak# :: Weak# v -> State# RealWorld ->\n                           (# State# RealWorld, Int#, IO () #)\n\nThe Int# returned is either\n\n        0 if the weak pointer has already been finalized, or it has no\n          finalizer (the third component is then invalid).\n\n        1 if the weak pointer is still alive, with the finalizer returned\n          as the third component.\n\nA {\\em stable name/pointer} is an index into a table of stable name\nentries.  Since the garbage collector is told about stable pointers,\nit is safe to pass a stable pointer to external systems such as C\nroutines.\n\n\\begin{verbatim}\nmakeStablePtr#  :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)\nfreeStablePtr   :: StablePtr# a -> State# RealWorld -> State# RealWorld\ndeRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)\neqStablePtr#    :: StablePtr# a -> StablePtr# a -> Int#\n\\end{verbatim}\n\nIt may seem a bit surprising that @makeStablePtr#@ is a @IO@\noperation since it doesn't (directly) involve IO operations.  The\nreason is that if some optimisation pass decided to duplicate calls to\n@makeStablePtr#@ and we only pass one of the stable pointers over, a\nmassive space leak can result.  Putting it into the IO monad\nprevents this.  (Another reason for putting them in a monad is to\nensure correct sequencing wrt the side-effecting @freeStablePtr@\noperation.)\n\nAn important property of stable pointers is that if you call\nmakeStablePtr# twice on the same object you get the same stable\npointer back.\n\nNote that we can implement @freeStablePtr#@ using @_ccall_@ (and,\nbesides, it's not likely to be used from Haskell) so it's not a\nprimop.\n\nQuestion: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]\n\nStable Names\n~~~~~~~~~~~~\n\nA stable name is like a stable pointer, but with three important differences:\n\n        (a) You can't deRef one to get back to the original object.\n        (b) You can convert one to an Int.\n        (c) You don't need to 'freeStableName'\n\nThe existence of a stable name doesn't guarantee to keep the object it\npoints to alive (unlike a stable pointer), hence (a).\n\nInvariants:\n\n        (a) makeStableName always returns the same value for a given\n            object (same as stable pointers).\n\n        (b) if two stable names are equal, it implies that the objects\n            from which they were created were the same.\n\n        (c) stableNameToInt always returns the same Int for a given\n            stable name.\n\n\nThese primops are pretty weird.\n\n        tagToEnum# :: Int -> a    (result type must be an enumerated type)\n\nThe constraints aren't currently checked by the front end, but the\ncode generator will fall over if they aren't satisfied.\n\n************************************************************************\n*                                                                      *\n            Which PrimOps are out-of-line\n*                                                                      *\n************************************************************************\n\nSome PrimOps need to be called out-of-line because they either need to\nperform a heap check or they block.\n-}\n\nprimOpOutOfLine :: PrimOp -> Bool\n#include \"primop-out-of-line.hs-incl\"\n\n{-\n************************************************************************\n*                                                                      *\n            Failure and side effects\n*                                                                      *\n************************************************************************\n\nNote [PrimOp can_fail and has_side_effects]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBoth can_fail and has_side_effects mean that the primop has\nsome effect that is not captured entirely by its result value.\n\n----------  has_side_effects ---------------------\nA primop \"has_side_effects\" if it has some *write* effect, visible\nelsewhere\n    - writing to the world (I/O)\n    - writing to a mutable data structure (writeIORef)\n    - throwing a synchronous Haskell exception\n\nOften such primops have a type like\n   State -> input -> (State, output)\nso the state token guarantees ordering.  In general we rely *only* on\ndata dependencies of the state token to enforce write-effect ordering\n\n * NB1: if you inline unsafePerformIO, you may end up with\n   side-effecting ops whose 'state' output is discarded.\n   And programmers may do that by hand; see Trac #9390.\n   That is why we (conservatively) do not discard write-effecting\n   primops even if both their state and result is discarded.\n\n * NB2: We consider primops, such as raiseIO#, that can raise a\n   (Haskell) synchronous exception to \"have_side_effects\" but not\n   \"can_fail\".  We must be careful about not discarding such things;\n   see the paper \"A semantics for imprecise exceptions\".\n\n * NB3: *Read* effects (like reading an IORef) don't count here,\n   because it doesn't matter if we don't do them, or do them more than\n   once.  *Sequencing* is maintained by the data dependency of the state\n   token.\n\n----------  can_fail ----------------------------\nA primop \"can_fail\" if it can fail with an *unchecked* exception on\nsome elements of its input domain. Main examples:\n   division (fails on zero demoninator)\n   array indexing (fails if the index is out of bounds)\n\nAn \"unchecked exception\" is one that is an outright error, (not\nturned into a Haskell exception,) such as seg-fault or\ndivide-by-zero error.  Such can_fail primops are ALWAYS surrounded\nwith a test that checks for the bad cases, but we need to be\nvery careful about code motion that might move it out of\nthe scope of the test.\n\nNote [Transformations affected by can_fail and has_side_effects]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe can_fail and has_side_effects properties have the following effect\non program transformations.  Summary table is followed by details.\n\n            can_fail     has_side_effects\nDiscard        YES           NO\nFloat in       YES           YES\nFloat out      NO            NO\nDuplicate      YES           NO\n\n* Discarding.   case (a `op` b) of _ -> rhs  ===>   rhs\n  You should not discard a has_side_effects primop; e.g.\n     case (writeIntArray# a i v s of (# _, _ #) -> True\n  Arguably you should be able to discard this, since the\n  returned stat token is not used, but that relies on NEVER\n  inlining unsafePerformIO, and programmers sometimes write\n  this kind of stuff by hand (Trac #9390).  So we (conservatively)\n  never discard a has_side_effects primop.\n\n  However, it's fine to discard a can_fail primop.  For example\n     case (indexIntArray# a i) of _ -> True\n  We can discard indexIntArray#; it has can_fail, but not\n  has_side_effects; see Trac #5658 which was all about this.\n  Notice that indexIntArray# is (in a more general handling of\n  effects) read effect, but we don't care about that here, and\n  treat read effects as *not* has_side_effects.\n\n  Similarly (a `/#` b) can be discarded.  It can seg-fault or\n  cause a hardware exception, but not a synchronous Haskell\n  exception.\n\n\n\n  Synchronous Haskell exceptions, e.g. from raiseIO#, are treated\n  as has_side_effects and hence are not discarded.\n\n* Float in.  You can float a can_fail or has_side_effects primop\n  *inwards*, but not inside a lambda (see Duplication below).\n\n* Float out.  You must not float a can_fail primop *outwards* lest\n  you escape the dynamic scope of the test.  Example:\n      case d ># 0# of\n        True  -> case x /# d of r -> r +# 1\n        False -> 0\n  Here we must not float the case outwards to give\n      case x/# d of r ->\n      case d ># 0# of\n        True  -> r +# 1\n        False -> 0\n\n  Nor can you float out a has_side_effects primop.  For example:\n       if blah then case writeMutVar# v True s0 of (# s1 #) -> s1\n               else s0\n  Notice that s0 is mentioned in both branches of the 'if', but\n  only one of these two will actually be consumed.  But if we\n  float out to\n      case writeMutVar# v True s0 of (# s1 #) ->\n      if blah then s1 else s0\n  the writeMutVar will be performed in both branches, which is\n  utterly wrong.\n\n* Duplication.  You cannot duplicate a has_side_effect primop.  You\n  might wonder how this can occur given the state token threading, but\n  just look at Control.Monad.ST.Lazy.Imp.strictToLazy!  We get\n  something like this\n        p = case readMutVar# s v of\n              (# s', r #) -> (S# s', r)\n        s' = case p of (s', r) -> s'\n        r  = case p of (s', r) -> r\n\n  (All these bindings are boxed.)  If we inline p at its two call\n  sites, we get a catastrophe: because the read is performed once when\n  s' is demanded, and once when 'r' is demanded, which may be much\n  later.  Utterly wrong.  Trac #3207 is real example of this happening.\n\n  However, it's fine to duplicate a can_fail primop.  That is really\n  the only difference between can_fail and has_side_effects.\n\nNote [Implementation: how can_fail/has_side_effects affect transformations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHow do we ensure that that floating/duplication/discarding are done right\nin the simplifier?\n\nTwo main predicates on primpops test these flags:\n  primOpOkForSideEffects <=> not has_side_effects\n  primOpOkForSpeculation <=> not (has_side_effects || can_fail)\n\n  * The \"no-float-out\" thing is achieved by ensuring that we never\n    let-bind a can_fail or has_side_effects primop.  The RHS of a\n    let-binding (which can float in and out freely) satisfies\n    exprOkForSpeculation; this is the let/app invariant.  And\n    exprOkForSpeculation is false of can_fail and has_side_effects.\n\n  * So can_fail and has_side_effects primops will appear only as the\n    scrutinees of cases, and that's why the FloatIn pass is capable\n    of floating case bindings inwards.\n\n  * The no-duplicate thing is done via primOpIsCheap, by making\n    has_side_effects things (very very very) not-cheap!\n-}\n\nprimOpHasSideEffects :: PrimOp -> Bool\n#include \"primop-has-side-effects.hs-incl\"\n\nprimOpCanFail :: PrimOp -> Bool\n#include \"primop-can-fail.hs-incl\"\n\nprimOpOkForSpeculation :: PrimOp -> Bool\n  -- See Note [PrimOp can_fail and has_side_effects]\n  -- See comments with CoreUtils.exprOkForSpeculation\n  -- primOpOkForSpeculation => primOpOkForSideEffects\nprimOpOkForSpeculation op\n  =  primOpOkForSideEffects op\n  && not (primOpOutOfLine op || primOpCanFail op)\n    -- I think the \"out of line\" test is because out of line things can\n    -- be expensive (eg sine, cosine), and so we may not want to speculate them\n\nprimOpOkForSideEffects :: PrimOp -> Bool\nprimOpOkForSideEffects op\n  = not (primOpHasSideEffects op)\n\n{-\nNote [primOpIsCheap]\n~~~~~~~~~~~~~~~~~~~~\n@primOpIsCheap@, as used in \\tr{SimplUtils.hs}.  For now (HACK\nWARNING), we just borrow some other predicates for a\nwhat-should-be-good-enough test.  \"Cheap\" means willing to call it more\nthan once, and/or push it inside a lambda.  The latter could change the\nbehaviour of 'seq' for primops that can fail, so we don't treat them as cheap.\n-}\n\nprimOpIsCheap :: PrimOp -> Bool\n-- See Note [PrimOp can_fail and has_side_effects]\nprimOpIsCheap op = primOpOkForSpeculation op\n-- In March 2001, we changed this to\n--      primOpIsCheap op = False\n-- thereby making *no* primops seem cheap.  But this killed eta\n-- expansion on case (x ==# y) of True -> \\s -> ...\n-- which is bad.  In particular a loop like\n--      doLoop n = loop 0\n--     where\n--         loop i | i == n    = return ()\n--                | otherwise = bar i >> loop (i+1)\n-- allocated a closure every time round because it doesn't eta expand.\n--\n-- The problem that originally gave rise to the change was\n--      let x = a +# b *# c in x +# x\n-- were we don't want to inline x. But primopIsCheap doesn't control\n-- that (it's exprIsDupable that does) so the problem doesn't occur\n-- even if primOpIsCheap sometimes says 'True'.\n\n{-\n************************************************************************\n*                                                                      *\n               PrimOp code size\n*                                                                      *\n************************************************************************\n\nprimOpCodeSize\n~~~~~~~~~~~~~~\nGives an indication of the code size of a primop, for the purposes of\ncalculating unfolding sizes; see CoreUnfold.sizeExpr.\n-}\n\nprimOpCodeSize :: PrimOp -> Int\n#include \"primop-code-size.hs-incl\"\n\nprimOpCodeSizeDefault :: Int\nprimOpCodeSizeDefault = 1\n  -- CoreUnfold.primOpSize already takes into account primOpOutOfLine\n  -- and adds some further costs for the args in that case.\n\nprimOpCodeSizeForeignCall :: Int\nprimOpCodeSizeForeignCall = 4\n\n{-\n************************************************************************\n*                                                                      *\n               PrimOp types\n*                                                                      *\n************************************************************************\n-}\n\nprimOpType :: PrimOp -> Type  -- you may want to use primOpSig instead\nprimOpType op\n  = case primOpInfo op of\n    Dyadic  _occ ty -> dyadic_fun_ty ty\n    Monadic _occ ty -> monadic_fun_ty ty\n    Compare _occ ty -> compare_fun_ty ty\n\n    GenPrimOp _occ tyvars arg_tys res_ty ->\n        mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)\n\nprimOpOcc :: PrimOp -> OccName\nprimOpOcc op = case primOpInfo op of\n               Dyadic    occ _     -> occ\n               Monadic   occ _     -> occ\n               Compare   occ _     -> occ\n               GenPrimOp occ _ _ _ -> occ\n\nisComparisonPrimOp :: PrimOp -> Bool\nisComparisonPrimOp op = case primOpInfo op of\n                          Compare {} -> True\n                          _          -> False\n\n-- primOpSig is like primOpType but gives the result split apart:\n-- (type variables, argument types, result type)\n-- It also gives arity, strictness info\n\nprimOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)\nprimOpSig op\n  = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)\n  where\n    arity = length arg_tys\n    (tyvars, arg_tys, res_ty)\n      = case (primOpInfo op) of\n        Monadic   _occ ty                    -> ([],     [ty],    ty       )\n        Dyadic    _occ ty                    -> ([],     [ty,ty], ty       )\n        Compare   _occ ty                    -> ([],     [ty,ty], intPrimTy)\n        GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty   )\n\ndata PrimOpResultInfo\n  = ReturnsPrim     PrimRep\n  | ReturnsAlg      TyCon\n\n-- Some PrimOps need not return a manifest primitive or algebraic value\n-- (i.e. they might return a polymorphic value).  These PrimOps *must*\n-- be out of line, or the code generator won't work.\n\ngetPrimOpResultInfo :: PrimOp -> PrimOpResultInfo\ngetPrimOpResultInfo op\n  = case (primOpInfo op) of\n      Dyadic  _ ty                        -> ReturnsPrim (typePrimRep1 ty)\n      Monadic _ ty                        -> ReturnsPrim (typePrimRep1 ty)\n      Compare _ _                         -> ReturnsPrim (tyConPrimRep1 intPrimTyCon)\n      GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc)\n                         | otherwise      -> ReturnsAlg tc\n                         where\n                           tc = tyConAppTyCon ty\n                        -- All primops return a tycon-app result\n                        -- The tycon can be an unboxed tuple or sum, though,\n                        -- which gives rise to a ReturnAlg\n\n{-\nWe do not currently make use of whether primops are commutable.\n\nWe used to try to move constants to the right hand side for strength\nreduction.\n-}\n\n{-\ncommutableOp :: PrimOp -> Bool\n#include \"primop-commutable.hs-incl\"\n-}\n\n-- Utils:\n\ndyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type\ndyadic_fun_ty  ty = mkVisFunTys [ty, ty] ty\nmonadic_fun_ty ty = mkVisFunTy  ty ty\ncompare_fun_ty ty = mkVisFunTys [ty, ty] intPrimTy\n\n-- Output stuff:\n\npprPrimOp  :: PrimOp -> SDoc\npprPrimOp other_op = pprOccName (primOpOcc other_op)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[PrimCall]{User-imported primitive calls}\n*                                                                      *\n************************************************************************\n-}\n\ndata PrimCall = PrimCall CLabelString UnitId\n\ninstance Outputable PrimCall where\n  ppr (PrimCall lbl pkgId)\n        = text \"__primcall\" <+> ppr pkgId <+> ppr lbl\n", "num_lines": 634}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- %************************************************************************\n-- %*                                                                   *\n--              The known-key names for Template Haskell\n-- %*                                                                   *\n-- %************************************************************************\n\nmodule THNames where\n\nimport GhcPrelude ()\n\nimport PrelNames( mk_known_key_name )\nimport Module( Module, mkModuleNameFS, mkModule, thUnitId )\nimport Name( Name )\nimport OccName( tcName, clsName, dataName, varName )\nimport RdrName( RdrName, nameRdrName )\nimport Unique\nimport FastString\n\n-- To add a name, do three things\n--\n--  1) Allocate a key\n--  2) Make a \"Name\"\n--  3) Add the name to templateHaskellNames\n\ntemplateHaskellNames :: [Name]\n-- The names that are implicitly mentioned by ``bracket''\n-- Should stay in sync with the import list of DsMeta\n\ntemplateHaskellNames = [\n    returnQName, bindQName, sequenceQName, newNameName, liftName,\n    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,\n    mkNameSName,\n    liftStringName,\n    unTypeName,\n    unTypeQName,\n    unsafeTExpCoerceName,\n\n    -- Lit\n    charLName, stringLName, integerLName, intPrimLName, wordPrimLName,\n    floatPrimLName, doublePrimLName, rationalLName, stringPrimLName,\n    charPrimLName,\n    -- Pat\n    litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName,\n    conPName, tildePName, bangPName, infixPName,\n    asPName, wildPName, recPName, listPName, sigPName, viewPName,\n    -- FieldPat\n    fieldPatName,\n    -- Match\n    matchName,\n    -- Clause\n    clauseName,\n    -- Exp\n    varEName, conEName, litEName, appEName, appTypeEName, infixEName,\n    infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName,\n    tupEName, unboxedTupEName, unboxedSumEName,\n    condEName, multiIfEName, letEName, caseEName, doEName, mdoEName, compEName,\n    fromEName, fromThenEName, fromToEName, fromThenToEName,\n    listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName,\n    labelEName, implicitParamVarEName,\n    -- FieldExp\n    fieldExpName,\n    -- Body\n    guardedBName, normalBName,\n    -- Guard\n    normalGEName, patGEName,\n    -- Stmt\n    bindSName, letSName, noBindSName, parSName, recSName,\n    -- Dec\n    funDName, valDName, dataDName, newtypeDName, tySynDName,\n    classDName, instanceWithOverlapDName,\n    standaloneDerivWithStrategyDName, sigDName, forImpDName,\n    pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,\n    pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName,\n    dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName,\n    dataInstDName, newtypeInstDName, tySynInstDName,\n    infixLDName, infixRDName, infixNDName,\n    roleAnnotDName, patSynDName, patSynSigDName,\n    implicitParamBindDName,\n    -- Cxt\n    cxtName,\n\n    -- SourceUnpackedness\n    noSourceUnpackednessName, sourceNoUnpackName, sourceUnpackName,\n    -- SourceStrictness\n    noSourceStrictnessName, sourceLazyName, sourceStrictName,\n    -- Con\n    normalCName, recCName, infixCName, forallCName, gadtCName, recGadtCName,\n    -- Bang\n    bangName,\n    -- BangType\n    bangTypeName,\n    -- VarBangType\n    varBangTypeName,\n    -- PatSynDir (for pattern synonyms)\n    unidirPatSynName, implBidirPatSynName, explBidirPatSynName,\n    -- PatSynArgs (for pattern synonyms)\n    prefixPatSynName, infixPatSynName, recordPatSynName,\n    -- Type\n    forallTName, forallVisTName, varTName, conTName, infixTName, appTName,\n    appKindTName, equalityTName, tupleTName, unboxedTupleTName,\n    unboxedSumTName, arrowTName, listTName, sigTName, litTName,\n    promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,\n    wildCardTName, implicitParamTName,\n    -- TyLit\n    numTyLitName, strTyLitName,\n    -- TyVarBndr\n    plainTVName, kindedTVName,\n    -- Role\n    nominalRName, representationalRName, phantomRName, inferRName,\n    -- Kind\n    varKName, conKName, tupleKName, arrowKName, listKName, appKName,\n    starKName, constraintKName,\n    -- FamilyResultSig\n    noSigName, kindSigName, tyVarSigName,\n    -- InjectivityAnn\n    injectivityAnnName,\n    -- Callconv\n    cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName,\n    -- Safety\n    unsafeName,\n    safeName,\n    interruptibleName,\n    -- Inline\n    noInlineDataConName, inlineDataConName, inlinableDataConName,\n    -- RuleMatch\n    conLikeDataConName, funLikeDataConName,\n    -- Phases\n    allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName,\n    -- Overlap\n    overlappableDataConName, overlappingDataConName, overlapsDataConName,\n    incoherentDataConName,\n    -- DerivStrategy\n    stockStrategyName, anyclassStrategyName,\n    newtypeStrategyName, viaStrategyName,\n    -- TExp\n    tExpDataConName,\n    -- RuleBndr\n    ruleVarName, typedRuleVarName,\n    -- FunDep\n    funDepName,\n    -- TySynEqn\n    tySynEqnName,\n    -- AnnTarget\n    valueAnnotationName, typeAnnotationName, moduleAnnotationName,\n    -- DerivClause\n    derivClauseName,\n\n    -- The type classes\n    liftClassName,\n\n    -- And the tycons\n    qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,\n    clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,\n    stmtQTyConName, decQTyConName, conQTyConName, bangTypeQTyConName,\n    varBangTypeQTyConName, typeQTyConName, expTyConName, decTyConName,\n    typeTyConName, tyVarBndrQTyConName, matchTyConName, clauseTyConName,\n    patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,\n    predQTyConName, decsQTyConName, ruleBndrQTyConName, tySynEqnQTyConName,\n    roleTyConName, tExpTyConName, injAnnTyConName, kindQTyConName,\n    overlapTyConName, derivClauseQTyConName, derivStrategyQTyConName,\n\n    -- Quasiquoting\n    quoteDecName, quoteTypeName, quoteExpName, quotePatName]\n\nthSyn, thLib, qqLib :: Module\nthSyn = mkTHModule (fsLit \"Language.Haskell.TH.Syntax\")\nthLib = mkTHModule (fsLit \"Language.Haskell.TH.Lib.Internal\")\nqqLib = mkTHModule (fsLit \"Language.Haskell.TH.Quote\")\n\nmkTHModule :: FastString -> Module\nmkTHModule m = mkModule thUnitId (mkModuleNameFS m)\n\nlibFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name\nlibFun = mk_known_key_name OccName.varName  thLib\nlibTc  = mk_known_key_name OccName.tcName   thLib\nthFun  = mk_known_key_name OccName.varName  thSyn\nthTc   = mk_known_key_name OccName.tcName   thSyn\nthCls  = mk_known_key_name OccName.clsName  thSyn\nthCon  = mk_known_key_name OccName.dataName thSyn\nqqFun  = mk_known_key_name OccName.varName  qqLib\n\n-------------------- TH.Syntax -----------------------\nliftClassName :: Name\nliftClassName = thCls (fsLit \"Lift\") liftClassKey\n\nqTyConName, nameTyConName, fieldExpTyConName, patTyConName,\n    fieldPatTyConName, expTyConName, decTyConName, typeTyConName,\n    matchTyConName, clauseTyConName, funDepTyConName, predTyConName,\n    tExpTyConName, injAnnTyConName, overlapTyConName :: Name\nqTyConName             = thTc (fsLit \"Q\")              qTyConKey\nnameTyConName          = thTc (fsLit \"Name\")           nameTyConKey\nfieldExpTyConName      = thTc (fsLit \"FieldExp\")       fieldExpTyConKey\npatTyConName           = thTc (fsLit \"Pat\")            patTyConKey\nfieldPatTyConName      = thTc (fsLit \"FieldPat\")       fieldPatTyConKey\nexpTyConName           = thTc (fsLit \"Exp\")            expTyConKey\ndecTyConName           = thTc (fsLit \"Dec\")            decTyConKey\ntypeTyConName          = thTc (fsLit \"Type\")           typeTyConKey\nmatchTyConName         = thTc (fsLit \"Match\")          matchTyConKey\nclauseTyConName        = thTc (fsLit \"Clause\")         clauseTyConKey\nfunDepTyConName        = thTc (fsLit \"FunDep\")         funDepTyConKey\npredTyConName          = thTc (fsLit \"Pred\")           predTyConKey\ntExpTyConName          = thTc (fsLit \"TExp\")           tExpTyConKey\ninjAnnTyConName        = thTc (fsLit \"InjectivityAnn\") injAnnTyConKey\noverlapTyConName       = thTc (fsLit \"Overlap\")        overlapTyConKey\n\nreturnQName, bindQName, sequenceQName, newNameName, liftName,\n    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,\n    mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeQName,\n    unsafeTExpCoerceName :: Name\nreturnQName    = thFun (fsLit \"returnQ\")   returnQIdKey\nbindQName      = thFun (fsLit \"bindQ\")     bindQIdKey\nsequenceQName  = thFun (fsLit \"sequenceQ\") sequenceQIdKey\nnewNameName    = thFun (fsLit \"newName\")   newNameIdKey\nliftName       = thFun (fsLit \"lift\")      liftIdKey\nliftStringName = thFun (fsLit \"liftString\")  liftStringIdKey\nmkNameName     = thFun (fsLit \"mkName\")     mkNameIdKey\nmkNameG_vName  = thFun (fsLit \"mkNameG_v\")  mkNameG_vIdKey\nmkNameG_dName  = thFun (fsLit \"mkNameG_d\")  mkNameG_dIdKey\nmkNameG_tcName = thFun (fsLit \"mkNameG_tc\") mkNameG_tcIdKey\nmkNameLName    = thFun (fsLit \"mkNameL\")    mkNameLIdKey\nmkNameSName    = thFun (fsLit \"mkNameS\")    mkNameSIdKey\nunTypeName     = thFun (fsLit \"unType\")     unTypeIdKey\nunTypeQName    = thFun (fsLit \"unTypeQ\")    unTypeQIdKey\nunsafeTExpCoerceName = thFun (fsLit \"unsafeTExpCoerce\") unsafeTExpCoerceIdKey\n\n\n-------------------- TH.Lib -----------------------\n-- data Lit = ...\ncharLName, stringLName, integerLName, intPrimLName, wordPrimLName,\n    floatPrimLName, doublePrimLName, rationalLName, stringPrimLName,\n    charPrimLName :: Name\ncharLName       = libFun (fsLit \"charL\")       charLIdKey\nstringLName     = libFun (fsLit \"stringL\")     stringLIdKey\nintegerLName    = libFun (fsLit \"integerL\")    integerLIdKey\nintPrimLName    = libFun (fsLit \"intPrimL\")    intPrimLIdKey\nwordPrimLName   = libFun (fsLit \"wordPrimL\")   wordPrimLIdKey\nfloatPrimLName  = libFun (fsLit \"floatPrimL\")  floatPrimLIdKey\ndoublePrimLName = libFun (fsLit \"doublePrimL\") doublePrimLIdKey\nrationalLName   = libFun (fsLit \"rationalL\")     rationalLIdKey\nstringPrimLName = libFun (fsLit \"stringPrimL\") stringPrimLIdKey\ncharPrimLName   = libFun (fsLit \"charPrimL\")   charPrimLIdKey\n\n-- data Pat = ...\nlitPName, varPName, tupPName, unboxedTupPName, unboxedSumPName, conPName,\n    infixPName, tildePName, bangPName, asPName, wildPName, recPName, listPName,\n    sigPName, viewPName :: Name\nlitPName   = libFun (fsLit \"litP\")   litPIdKey\nvarPName   = libFun (fsLit \"varP\")   varPIdKey\ntupPName   = libFun (fsLit \"tupP\")   tupPIdKey\nunboxedTupPName = libFun (fsLit \"unboxedTupP\") unboxedTupPIdKey\nunboxedSumPName = libFun (fsLit \"unboxedSumP\") unboxedSumPIdKey\nconPName   = libFun (fsLit \"conP\")   conPIdKey\ninfixPName = libFun (fsLit \"infixP\") infixPIdKey\ntildePName = libFun (fsLit \"tildeP\") tildePIdKey\nbangPName  = libFun (fsLit \"bangP\")  bangPIdKey\nasPName    = libFun (fsLit \"asP\")    asPIdKey\nwildPName  = libFun (fsLit \"wildP\")  wildPIdKey\nrecPName   = libFun (fsLit \"recP\")   recPIdKey\nlistPName  = libFun (fsLit \"listP\")  listPIdKey\nsigPName   = libFun (fsLit \"sigP\")   sigPIdKey\nviewPName  = libFun (fsLit \"viewP\")  viewPIdKey\n\n-- type FieldPat = ...\nfieldPatName :: Name\nfieldPatName = libFun (fsLit \"fieldPat\") fieldPatIdKey\n\n-- data Match = ...\nmatchName :: Name\nmatchName = libFun (fsLit \"match\") matchIdKey\n\n-- data Clause = ...\nclauseName :: Name\nclauseName = libFun (fsLit \"clause\") clauseIdKey\n\n-- data Exp = ...\nvarEName, conEName, litEName, appEName, appTypeEName, infixEName, infixAppName,\n    sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,\n    unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName,\n    caseEName, doEName, mdoEName, compEName, staticEName, unboundVarEName,\n    labelEName, implicitParamVarEName :: Name\nvarEName              = libFun (fsLit \"varE\")              varEIdKey\nconEName              = libFun (fsLit \"conE\")              conEIdKey\nlitEName              = libFun (fsLit \"litE\")              litEIdKey\nappEName              = libFun (fsLit \"appE\")              appEIdKey\nappTypeEName          = libFun (fsLit \"appTypeE\")          appTypeEIdKey\ninfixEName            = libFun (fsLit \"infixE\")            infixEIdKey\ninfixAppName          = libFun (fsLit \"infixApp\")          infixAppIdKey\nsectionLName          = libFun (fsLit \"sectionL\")          sectionLIdKey\nsectionRName          = libFun (fsLit \"sectionR\")          sectionRIdKey\nlamEName              = libFun (fsLit \"lamE\")              lamEIdKey\nlamCaseEName          = libFun (fsLit \"lamCaseE\")          lamCaseEIdKey\ntupEName              = libFun (fsLit \"tupE\")              tupEIdKey\nunboxedTupEName       = libFun (fsLit \"unboxedTupE\")       unboxedTupEIdKey\nunboxedSumEName       = libFun (fsLit \"unboxedSumE\")       unboxedSumEIdKey\ncondEName             = libFun (fsLit \"condE\")             condEIdKey\nmultiIfEName          = libFun (fsLit \"multiIfE\")          multiIfEIdKey\nletEName              = libFun (fsLit \"letE\")              letEIdKey\ncaseEName             = libFun (fsLit \"caseE\")             caseEIdKey\ndoEName               = libFun (fsLit \"doE\")               doEIdKey\nmdoEName              = libFun (fsLit \"mdoE\")              mdoEIdKey\ncompEName             = libFun (fsLit \"compE\")             compEIdKey\n-- ArithSeq skips a level\nfromEName, fromThenEName, fromToEName, fromThenToEName :: Name\nfromEName             = libFun (fsLit \"fromE\")             fromEIdKey\nfromThenEName         = libFun (fsLit \"fromThenE\")         fromThenEIdKey\nfromToEName           = libFun (fsLit \"fromToE\")           fromToEIdKey\nfromThenToEName       = libFun (fsLit \"fromThenToE\")       fromThenToEIdKey\n-- end ArithSeq\nlistEName, sigEName, recConEName, recUpdEName :: Name\nlistEName             = libFun (fsLit \"listE\")             listEIdKey\nsigEName              = libFun (fsLit \"sigE\")              sigEIdKey\nrecConEName           = libFun (fsLit \"recConE\")           recConEIdKey\nrecUpdEName           = libFun (fsLit \"recUpdE\")           recUpdEIdKey\nstaticEName           = libFun (fsLit \"staticE\")           staticEIdKey\nunboundVarEName       = libFun (fsLit \"unboundVarE\")       unboundVarEIdKey\nlabelEName            = libFun (fsLit \"labelE\")            labelEIdKey\nimplicitParamVarEName = libFun (fsLit \"implicitParamVarE\") implicitParamVarEIdKey\n\n-- type FieldExp = ...\nfieldExpName :: Name\nfieldExpName = libFun (fsLit \"fieldExp\") fieldExpIdKey\n\n-- data Body = ...\nguardedBName, normalBName :: Name\nguardedBName = libFun (fsLit \"guardedB\") guardedBIdKey\nnormalBName  = libFun (fsLit \"normalB\")  normalBIdKey\n\n-- data Guard = ...\nnormalGEName, patGEName :: Name\nnormalGEName = libFun (fsLit \"normalGE\") normalGEIdKey\npatGEName    = libFun (fsLit \"patGE\")    patGEIdKey\n\n-- data Stmt = ...\nbindSName, letSName, noBindSName, parSName, recSName :: Name\nbindSName   = libFun (fsLit \"bindS\")   bindSIdKey\nletSName    = libFun (fsLit \"letS\")    letSIdKey\nnoBindSName = libFun (fsLit \"noBindS\") noBindSIdKey\nparSName    = libFun (fsLit \"parS\")    parSIdKey\nrecSName    = libFun (fsLit \"recS\")    recSIdKey\n\n-- data Dec = ...\nfunDName, valDName, dataDName, newtypeDName, tySynDName, classDName,\n    instanceWithOverlapDName, sigDName, forImpDName, pragInlDName,\n    pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName,\n    pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName,\n    dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName,\n    openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName,\n    infixNDName, roleAnnotDName, patSynDName, patSynSigDName,\n    pragCompleteDName, implicitParamBindDName :: Name\nfunDName                         = libFun (fsLit \"funD\")                         funDIdKey\nvalDName                         = libFun (fsLit \"valD\")                         valDIdKey\ndataDName                        = libFun (fsLit \"dataD\")                        dataDIdKey\nnewtypeDName                     = libFun (fsLit \"newtypeD\")                     newtypeDIdKey\ntySynDName                       = libFun (fsLit \"tySynD\")                       tySynDIdKey\nclassDName                       = libFun (fsLit \"classD\")                       classDIdKey\ninstanceWithOverlapDName         = libFun (fsLit \"instanceWithOverlapD\")         instanceWithOverlapDIdKey\nstandaloneDerivWithStrategyDName = libFun (fsLit \"standaloneDerivWithStrategyD\") standaloneDerivWithStrategyDIdKey\nsigDName                         = libFun (fsLit \"sigD\")                         sigDIdKey\ndefaultSigDName                  = libFun (fsLit \"defaultSigD\")                  defaultSigDIdKey\nforImpDName                      = libFun (fsLit \"forImpD\")                      forImpDIdKey\npragInlDName                     = libFun (fsLit \"pragInlD\")                     pragInlDIdKey\npragSpecDName                    = libFun (fsLit \"pragSpecD\")                    pragSpecDIdKey\npragSpecInlDName                 = libFun (fsLit \"pragSpecInlD\")                 pragSpecInlDIdKey\npragSpecInstDName                = libFun (fsLit \"pragSpecInstD\")                pragSpecInstDIdKey\npragRuleDName                    = libFun (fsLit \"pragRuleD\")                    pragRuleDIdKey\npragCompleteDName                = libFun (fsLit \"pragCompleteD\")                pragCompleteDIdKey\npragAnnDName                     = libFun (fsLit \"pragAnnD\")                     pragAnnDIdKey\ndataInstDName                    = libFun (fsLit \"dataInstD\")                    dataInstDIdKey\nnewtypeInstDName                 = libFun (fsLit \"newtypeInstD\")                 newtypeInstDIdKey\ntySynInstDName                   = libFun (fsLit \"tySynInstD\")                   tySynInstDIdKey\nopenTypeFamilyDName              = libFun (fsLit \"openTypeFamilyD\")              openTypeFamilyDIdKey\nclosedTypeFamilyDName            = libFun (fsLit \"closedTypeFamilyD\")            closedTypeFamilyDIdKey\ndataFamilyDName                  = libFun (fsLit \"dataFamilyD\")                  dataFamilyDIdKey\ninfixLDName                      = libFun (fsLit \"infixLD\")                      infixLDIdKey\ninfixRDName                      = libFun (fsLit \"infixRD\")                      infixRDIdKey\ninfixNDName                      = libFun (fsLit \"infixND\")                      infixNDIdKey\nroleAnnotDName                   = libFun (fsLit \"roleAnnotD\")                   roleAnnotDIdKey\npatSynDName                      = libFun (fsLit \"patSynD\")                      patSynDIdKey\npatSynSigDName                   = libFun (fsLit \"patSynSigD\")                   patSynSigDIdKey\nimplicitParamBindDName           = libFun (fsLit \"implicitParamBindD\")           implicitParamBindDIdKey\n\n-- type Ctxt = ...\ncxtName :: Name\ncxtName = libFun (fsLit \"cxt\") cxtIdKey\n\n-- data SourceUnpackedness = ...\nnoSourceUnpackednessName, sourceNoUnpackName, sourceUnpackName :: Name\nnoSourceUnpackednessName = libFun (fsLit \"noSourceUnpackedness\") noSourceUnpackednessKey\nsourceNoUnpackName       = libFun (fsLit \"sourceNoUnpack\")       sourceNoUnpackKey\nsourceUnpackName         = libFun (fsLit \"sourceUnpack\")         sourceUnpackKey\n\n-- data SourceStrictness = ...\nnoSourceStrictnessName, sourceLazyName, sourceStrictName :: Name\nnoSourceStrictnessName = libFun (fsLit \"noSourceStrictness\") noSourceStrictnessKey\nsourceLazyName         = libFun (fsLit \"sourceLazy\")         sourceLazyKey\nsourceStrictName       = libFun (fsLit \"sourceStrict\")       sourceStrictKey\n\n-- data Con = ...\nnormalCName, recCName, infixCName, forallCName, gadtCName, recGadtCName :: Name\nnormalCName  = libFun (fsLit \"normalC\" ) normalCIdKey\nrecCName     = libFun (fsLit \"recC\"    ) recCIdKey\ninfixCName   = libFun (fsLit \"infixC\"  ) infixCIdKey\nforallCName  = libFun (fsLit \"forallC\" ) forallCIdKey\ngadtCName    = libFun (fsLit \"gadtC\"   ) gadtCIdKey\nrecGadtCName = libFun (fsLit \"recGadtC\") recGadtCIdKey\n\n-- data Bang = ...\nbangName :: Name\nbangName = libFun (fsLit \"bang\") bangIdKey\n\n-- type BangType = ...\nbangTypeName :: Name\nbangTypeName = libFun (fsLit \"bangType\") bangTKey\n\n-- type VarBangType = ...\nvarBangTypeName :: Name\nvarBangTypeName = libFun (fsLit \"varBangType\") varBangTKey\n\n-- data PatSynDir = ...\nunidirPatSynName, implBidirPatSynName, explBidirPatSynName :: Name\nunidirPatSynName    = libFun (fsLit \"unidir\")    unidirPatSynIdKey\nimplBidirPatSynName = libFun (fsLit \"implBidir\") implBidirPatSynIdKey\nexplBidirPatSynName = libFun (fsLit \"explBidir\") explBidirPatSynIdKey\n\n-- data PatSynArgs = ...\nprefixPatSynName, infixPatSynName, recordPatSynName :: Name\nprefixPatSynName = libFun (fsLit \"prefixPatSyn\") prefixPatSynIdKey\ninfixPatSynName  = libFun (fsLit \"infixPatSyn\")  infixPatSynIdKey\nrecordPatSynName = libFun (fsLit \"recordPatSyn\") recordPatSynIdKey\n\n-- data Type = ...\nforallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,\n    unboxedTupleTName, unboxedSumTName, arrowTName, listTName, appTName,\n    appKindTName, sigTName, equalityTName, litTName, promotedTName,\n    promotedTupleTName, promotedNilTName, promotedConsTName,\n    wildCardTName, implicitParamTName :: Name\nforallTName         = libFun (fsLit \"forallT\")        forallTIdKey\nforallVisTName      = libFun (fsLit \"forallVisT\")     forallVisTIdKey\nvarTName            = libFun (fsLit \"varT\")           varTIdKey\nconTName            = libFun (fsLit \"conT\")           conTIdKey\ntupleTName          = libFun (fsLit \"tupleT\")         tupleTIdKey\nunboxedTupleTName   = libFun (fsLit \"unboxedTupleT\")  unboxedTupleTIdKey\nunboxedSumTName     = libFun (fsLit \"unboxedSumT\")    unboxedSumTIdKey\narrowTName          = libFun (fsLit \"arrowT\")         arrowTIdKey\nlistTName           = libFun (fsLit \"listT\")          listTIdKey\nappTName            = libFun (fsLit \"appT\")           appTIdKey\nappKindTName        = libFun (fsLit \"appKindT\")       appKindTIdKey\nsigTName            = libFun (fsLit \"sigT\")           sigTIdKey\nequalityTName       = libFun (fsLit \"equalityT\")      equalityTIdKey\nlitTName            = libFun (fsLit \"litT\")           litTIdKey\npromotedTName       = libFun (fsLit \"promotedT\")      promotedTIdKey\npromotedTupleTName  = libFun (fsLit \"promotedTupleT\") promotedTupleTIdKey\npromotedNilTName    = libFun (fsLit \"promotedNilT\")   promotedNilTIdKey\npromotedConsTName   = libFun (fsLit \"promotedConsT\")  promotedConsTIdKey\nwildCardTName       = libFun (fsLit \"wildCardT\")      wildCardTIdKey\ninfixTName          = libFun (fsLit \"infixT\")         infixTIdKey\nimplicitParamTName  = libFun (fsLit \"implicitParamT\") implicitParamTIdKey\n\n-- data TyLit = ...\nnumTyLitName, strTyLitName :: Name\nnumTyLitName = libFun (fsLit \"numTyLit\") numTyLitIdKey\nstrTyLitName = libFun (fsLit \"strTyLit\") strTyLitIdKey\n\n-- data TyVarBndr = ...\nplainTVName, kindedTVName :: Name\nplainTVName  = libFun (fsLit \"plainTV\")  plainTVIdKey\nkindedTVName = libFun (fsLit \"kindedTV\") kindedTVIdKey\n\n-- data Role = ...\nnominalRName, representationalRName, phantomRName, inferRName :: Name\nnominalRName          = libFun (fsLit \"nominalR\")          nominalRIdKey\nrepresentationalRName = libFun (fsLit \"representationalR\") representationalRIdKey\nphantomRName          = libFun (fsLit \"phantomR\")          phantomRIdKey\ninferRName            = libFun (fsLit \"inferR\")            inferRIdKey\n\n-- data Kind = ...\nvarKName, conKName, tupleKName, arrowKName, listKName, appKName,\n  starKName, constraintKName :: Name\nvarKName        = libFun (fsLit \"varK\")         varKIdKey\nconKName        = libFun (fsLit \"conK\")         conKIdKey\ntupleKName      = libFun (fsLit \"tupleK\")       tupleKIdKey\narrowKName      = libFun (fsLit \"arrowK\")       arrowKIdKey\nlistKName       = libFun (fsLit \"listK\")        listKIdKey\nappKName        = libFun (fsLit \"appK\")         appKIdKey\nstarKName       = libFun (fsLit \"starK\")        starKIdKey\nconstraintKName = libFun (fsLit \"constraintK\")  constraintKIdKey\n\n-- data FamilyResultSig = ...\nnoSigName, kindSigName, tyVarSigName :: Name\nnoSigName    = libFun (fsLit \"noSig\")    noSigIdKey\nkindSigName  = libFun (fsLit \"kindSig\")  kindSigIdKey\ntyVarSigName = libFun (fsLit \"tyVarSig\") tyVarSigIdKey\n\n-- data InjectivityAnn = ...\ninjectivityAnnName :: Name\ninjectivityAnnName = libFun (fsLit \"injectivityAnn\") injectivityAnnIdKey\n\n-- data Callconv = ...\ncCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName :: Name\ncCallName = libFun (fsLit \"cCall\") cCallIdKey\nstdCallName = libFun (fsLit \"stdCall\") stdCallIdKey\ncApiCallName = libFun (fsLit \"cApi\") cApiCallIdKey\nprimCallName = libFun (fsLit \"prim\") primCallIdKey\njavaScriptCallName = libFun (fsLit \"javaScript\") javaScriptCallIdKey\n\n-- data Safety = ...\nunsafeName, safeName, interruptibleName :: Name\nunsafeName     = libFun (fsLit \"unsafe\") unsafeIdKey\nsafeName       = libFun (fsLit \"safe\") safeIdKey\ninterruptibleName = libFun (fsLit \"interruptible\") interruptibleIdKey\n\n-- newtype TExp a = ...\ntExpDataConName :: Name\ntExpDataConName = thCon (fsLit \"TExp\") tExpDataConKey\n\n-- data RuleBndr = ...\nruleVarName, typedRuleVarName :: Name\nruleVarName      = libFun (fsLit (\"ruleVar\"))      ruleVarIdKey\ntypedRuleVarName = libFun (fsLit (\"typedRuleVar\")) typedRuleVarIdKey\n\n-- data FunDep = ...\nfunDepName :: Name\nfunDepName     = libFun (fsLit \"funDep\") funDepIdKey\n\n-- data TySynEqn = ...\ntySynEqnName :: Name\ntySynEqnName = libFun (fsLit \"tySynEqn\") tySynEqnIdKey\n\n-- data AnnTarget = ...\nvalueAnnotationName, typeAnnotationName, moduleAnnotationName :: Name\nvalueAnnotationName  = libFun (fsLit \"valueAnnotation\")  valueAnnotationIdKey\ntypeAnnotationName   = libFun (fsLit \"typeAnnotation\")   typeAnnotationIdKey\nmoduleAnnotationName = libFun (fsLit \"moduleAnnotation\") moduleAnnotationIdKey\n\n-- type DerivClause = ...\nderivClauseName :: Name\nderivClauseName = libFun (fsLit \"derivClause\") derivClauseIdKey\n\n-- data DerivStrategy = ...\nstockStrategyName, anyclassStrategyName, newtypeStrategyName,\n  viaStrategyName :: Name\nstockStrategyName    = libFun (fsLit \"stockStrategy\")    stockStrategyIdKey\nanyclassStrategyName = libFun (fsLit \"anyclassStrategy\") anyclassStrategyIdKey\nnewtypeStrategyName  = libFun (fsLit \"newtypeStrategy\")  newtypeStrategyIdKey\nviaStrategyName      = libFun (fsLit \"viaStrategy\")      viaStrategyIdKey\n\nmatchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,\n    decQTyConName, conQTyConName, bangTypeQTyConName,\n    varBangTypeQTyConName, typeQTyConName, fieldExpQTyConName,\n    patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName,\n    ruleBndrQTyConName, tySynEqnQTyConName, roleTyConName,\n    derivClauseQTyConName, kindQTyConName, tyVarBndrQTyConName,\n    derivStrategyQTyConName :: Name\nmatchQTyConName         = libTc (fsLit \"MatchQ\")         matchQTyConKey\nclauseQTyConName        = libTc (fsLit \"ClauseQ\")        clauseQTyConKey\nexpQTyConName           = libTc (fsLit \"ExpQ\")           expQTyConKey\nstmtQTyConName          = libTc (fsLit \"StmtQ\")          stmtQTyConKey\ndecQTyConName           = libTc (fsLit \"DecQ\")           decQTyConKey\ndecsQTyConName          = libTc (fsLit \"DecsQ\")          decsQTyConKey  -- Q [Dec]\nconQTyConName           = libTc (fsLit \"ConQ\")           conQTyConKey\nbangTypeQTyConName      = libTc (fsLit \"BangTypeQ\")      bangTypeQTyConKey\nvarBangTypeQTyConName   = libTc (fsLit \"VarBangTypeQ\")   varBangTypeQTyConKey\ntypeQTyConName          = libTc (fsLit \"TypeQ\")          typeQTyConKey\nfieldExpQTyConName      = libTc (fsLit \"FieldExpQ\")      fieldExpQTyConKey\npatQTyConName           = libTc (fsLit \"PatQ\")           patQTyConKey\nfieldPatQTyConName      = libTc (fsLit \"FieldPatQ\")      fieldPatQTyConKey\npredQTyConName          = libTc (fsLit \"PredQ\")          predQTyConKey\nruleBndrQTyConName      = libTc (fsLit \"RuleBndrQ\")      ruleBndrQTyConKey\ntySynEqnQTyConName      = libTc (fsLit \"TySynEqnQ\")      tySynEqnQTyConKey\nroleTyConName           = libTc (fsLit \"Role\")           roleTyConKey\nderivClauseQTyConName   = libTc (fsLit \"DerivClauseQ\")   derivClauseQTyConKey\nkindQTyConName          = libTc (fsLit \"KindQ\")          kindQTyConKey\ntyVarBndrQTyConName     = libTc (fsLit \"TyVarBndrQ\")     tyVarBndrQTyConKey\nderivStrategyQTyConName = libTc (fsLit \"DerivStrategyQ\") derivStrategyQTyConKey\n\n-- quasiquoting\nquoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name\nquoteExpName        = qqFun (fsLit \"quoteExp\")  quoteExpKey\nquotePatName        = qqFun (fsLit \"quotePat\")  quotePatKey\nquoteDecName        = qqFun (fsLit \"quoteDec\")  quoteDecKey\nquoteTypeName       = qqFun (fsLit \"quoteType\") quoteTypeKey\n\n-- data Inline = ...\nnoInlineDataConName, inlineDataConName, inlinableDataConName :: Name\nnoInlineDataConName  = thCon (fsLit \"NoInline\")  noInlineDataConKey\ninlineDataConName    = thCon (fsLit \"Inline\")    inlineDataConKey\ninlinableDataConName = thCon (fsLit \"Inlinable\") inlinableDataConKey\n\n-- data RuleMatch = ...\nconLikeDataConName, funLikeDataConName :: Name\nconLikeDataConName = thCon (fsLit \"ConLike\") conLikeDataConKey\nfunLikeDataConName = thCon (fsLit \"FunLike\") funLikeDataConKey\n\n-- data Phases = ...\nallPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name\nallPhasesDataConName   = thCon (fsLit \"AllPhases\")   allPhasesDataConKey\nfromPhaseDataConName   = thCon (fsLit \"FromPhase\")   fromPhaseDataConKey\nbeforePhaseDataConName = thCon (fsLit \"BeforePhase\") beforePhaseDataConKey\n\n-- data Overlap = ...\noverlappableDataConName,\n  overlappingDataConName,\n  overlapsDataConName,\n  incoherentDataConName :: Name\noverlappableDataConName = thCon (fsLit \"Overlappable\") overlappableDataConKey\noverlappingDataConName  = thCon (fsLit \"Overlapping\")  overlappingDataConKey\noverlapsDataConName     = thCon (fsLit \"Overlaps\")     overlapsDataConKey\nincoherentDataConName   = thCon (fsLit \"Incoherent\")   incoherentDataConKey\n\n{- *********************************************************************\n*                                                                      *\n                     Class keys\n*                                                                      *\n********************************************************************* -}\n\n-- ClassUniques available: 200-299\n-- Check in PrelNames if you want to change this\n\nliftClassKey :: Unique\nliftClassKey = mkPreludeClassUnique 200\n\n{- *********************************************************************\n*                                                                      *\n                     TyCon keys\n*                                                                      *\n********************************************************************* -}\n\n-- TyConUniques available: 200-299\n-- Check in PrelNames if you want to change this\n\nexpTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,\n    decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,\n    stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey,\n    tyVarBndrQTyConKey, decTyConKey, bangTypeQTyConKey, varBangTypeQTyConKey,\n    fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,\n    fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,\n    predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey,\n    roleTyConKey, tExpTyConKey, injAnnTyConKey, kindQTyConKey,\n    overlapTyConKey, derivClauseQTyConKey, derivStrategyQTyConKey :: Unique\nexpTyConKey             = mkPreludeTyConUnique 200\nmatchTyConKey           = mkPreludeTyConUnique 201\nclauseTyConKey          = mkPreludeTyConUnique 202\nqTyConKey               = mkPreludeTyConUnique 203\nexpQTyConKey            = mkPreludeTyConUnique 204\ndecQTyConKey            = mkPreludeTyConUnique 205\npatTyConKey             = mkPreludeTyConUnique 206\nmatchQTyConKey          = mkPreludeTyConUnique 207\nclauseQTyConKey         = mkPreludeTyConUnique 208\nstmtQTyConKey           = mkPreludeTyConUnique 209\nconQTyConKey            = mkPreludeTyConUnique 210\ntypeQTyConKey           = mkPreludeTyConUnique 211\ntypeTyConKey            = mkPreludeTyConUnique 212\ndecTyConKey             = mkPreludeTyConUnique 213\nbangTypeQTyConKey       = mkPreludeTyConUnique 214\nvarBangTypeQTyConKey    = mkPreludeTyConUnique 215\nfieldExpTyConKey        = mkPreludeTyConUnique 216\nfieldPatTyConKey        = mkPreludeTyConUnique 217\nnameTyConKey            = mkPreludeTyConUnique 218\npatQTyConKey            = mkPreludeTyConUnique 219\nfieldPatQTyConKey       = mkPreludeTyConUnique 220\nfieldExpQTyConKey       = mkPreludeTyConUnique 221\nfunDepTyConKey          = mkPreludeTyConUnique 222\npredTyConKey            = mkPreludeTyConUnique 223\npredQTyConKey           = mkPreludeTyConUnique 224\ntyVarBndrQTyConKey      = mkPreludeTyConUnique 225\ndecsQTyConKey           = mkPreludeTyConUnique 226\nruleBndrQTyConKey       = mkPreludeTyConUnique 227\ntySynEqnQTyConKey       = mkPreludeTyConUnique 228\nroleTyConKey            = mkPreludeTyConUnique 229\ntExpTyConKey            = mkPreludeTyConUnique 230\ninjAnnTyConKey          = mkPreludeTyConUnique 231\nkindQTyConKey           = mkPreludeTyConUnique 232\noverlapTyConKey         = mkPreludeTyConUnique 233\nderivClauseQTyConKey    = mkPreludeTyConUnique 234\nderivStrategyQTyConKey  = mkPreludeTyConUnique 235\n\n{- *********************************************************************\n*                                                                      *\n                     DataCon keys\n*                                                                      *\n********************************************************************* -}\n\n-- DataConUniques available: 100-150\n-- If you want to change this, make sure you check in PrelNames\n\n-- data Inline = ...\nnoInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique\nnoInlineDataConKey  = mkPreludeDataConUnique 200\ninlineDataConKey    = mkPreludeDataConUnique 201\ninlinableDataConKey = mkPreludeDataConUnique 202\n\n-- data RuleMatch = ...\nconLikeDataConKey, funLikeDataConKey :: Unique\nconLikeDataConKey = mkPreludeDataConUnique 203\nfunLikeDataConKey = mkPreludeDataConUnique 204\n\n-- data Phases = ...\nallPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique\nallPhasesDataConKey   = mkPreludeDataConUnique 205\nfromPhaseDataConKey   = mkPreludeDataConUnique 206\nbeforePhaseDataConKey = mkPreludeDataConUnique 207\n\n-- newtype TExp a = ...\ntExpDataConKey :: Unique\ntExpDataConKey = mkPreludeDataConUnique 208\n\n-- data Overlap = ..\noverlappableDataConKey,\n  overlappingDataConKey,\n  overlapsDataConKey,\n  incoherentDataConKey :: Unique\noverlappableDataConKey = mkPreludeDataConUnique 209\noverlappingDataConKey  = mkPreludeDataConUnique 210\noverlapsDataConKey     = mkPreludeDataConUnique 211\nincoherentDataConKey   = mkPreludeDataConUnique 212\n\n{- *********************************************************************\n*                                                                      *\n                     Id keys\n*                                                                      *\n********************************************************************* -}\n\n-- IdUniques available: 200-499\n-- If you want to change this, make sure you check in PrelNames\n\nreturnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,\n    mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,\n    mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeQIdKey,\n    unsafeTExpCoerceIdKey :: Unique\nreturnQIdKey        = mkPreludeMiscIdUnique 200\nbindQIdKey          = mkPreludeMiscIdUnique 201\nsequenceQIdKey      = mkPreludeMiscIdUnique 202\nliftIdKey           = mkPreludeMiscIdUnique 203\nnewNameIdKey         = mkPreludeMiscIdUnique 204\nmkNameIdKey          = mkPreludeMiscIdUnique 205\nmkNameG_vIdKey       = mkPreludeMiscIdUnique 206\nmkNameG_dIdKey       = mkPreludeMiscIdUnique 207\nmkNameG_tcIdKey      = mkPreludeMiscIdUnique 208\nmkNameLIdKey         = mkPreludeMiscIdUnique 209\nmkNameSIdKey         = mkPreludeMiscIdUnique 210\nunTypeIdKey          = mkPreludeMiscIdUnique 211\nunTypeQIdKey         = mkPreludeMiscIdUnique 212\nunsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 213\n\n\n-- data Lit = ...\ncharLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,\n    floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey, stringPrimLIdKey,\n    charPrimLIdKey:: Unique\ncharLIdKey        = mkPreludeMiscIdUnique 220\nstringLIdKey      = mkPreludeMiscIdUnique 221\nintegerLIdKey     = mkPreludeMiscIdUnique 222\nintPrimLIdKey     = mkPreludeMiscIdUnique 223\nwordPrimLIdKey    = mkPreludeMiscIdUnique 224\nfloatPrimLIdKey   = mkPreludeMiscIdUnique 225\ndoublePrimLIdKey  = mkPreludeMiscIdUnique 226\nrationalLIdKey    = mkPreludeMiscIdUnique 227\nstringPrimLIdKey  = mkPreludeMiscIdUnique 228\ncharPrimLIdKey    = mkPreludeMiscIdUnique 229\n\nliftStringIdKey :: Unique\nliftStringIdKey     = mkPreludeMiscIdUnique 230\n\n-- data Pat = ...\nlitPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, unboxedSumPIdKey, conPIdKey,\n  infixPIdKey, tildePIdKey, bangPIdKey, asPIdKey, wildPIdKey, recPIdKey,\n  listPIdKey, sigPIdKey, viewPIdKey :: Unique\nlitPIdKey         = mkPreludeMiscIdUnique 240\nvarPIdKey         = mkPreludeMiscIdUnique 241\ntupPIdKey         = mkPreludeMiscIdUnique 242\nunboxedTupPIdKey  = mkPreludeMiscIdUnique 243\nunboxedSumPIdKey  = mkPreludeMiscIdUnique 244\nconPIdKey         = mkPreludeMiscIdUnique 245\ninfixPIdKey       = mkPreludeMiscIdUnique 246\ntildePIdKey       = mkPreludeMiscIdUnique 247\nbangPIdKey        = mkPreludeMiscIdUnique 248\nasPIdKey          = mkPreludeMiscIdUnique 249\nwildPIdKey        = mkPreludeMiscIdUnique 250\nrecPIdKey         = mkPreludeMiscIdUnique 251\nlistPIdKey        = mkPreludeMiscIdUnique 252\nsigPIdKey         = mkPreludeMiscIdUnique 253\nviewPIdKey        = mkPreludeMiscIdUnique 254\n\n-- type FieldPat = ...\nfieldPatIdKey :: Unique\nfieldPatIdKey       = mkPreludeMiscIdUnique 260\n\n-- data Match = ...\nmatchIdKey :: Unique\nmatchIdKey          = mkPreludeMiscIdUnique 261\n\n-- data Clause = ...\nclauseIdKey :: Unique\nclauseIdKey         = mkPreludeMiscIdUnique 262\n\n\n-- data Exp = ...\nvarEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey,\n    infixAppIdKey, sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey,\n    tupEIdKey, unboxedTupEIdKey, unboxedSumEIdKey, condEIdKey, multiIfEIdKey,\n    letEIdKey, caseEIdKey, doEIdKey, compEIdKey,\n    fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,\n    listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey,\n    unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey :: Unique\nvarEIdKey              = mkPreludeMiscIdUnique 270\nconEIdKey              = mkPreludeMiscIdUnique 271\nlitEIdKey              = mkPreludeMiscIdUnique 272\nappEIdKey              = mkPreludeMiscIdUnique 273\nappTypeEIdKey          = mkPreludeMiscIdUnique 274\ninfixEIdKey            = mkPreludeMiscIdUnique 275\ninfixAppIdKey          = mkPreludeMiscIdUnique 276\nsectionLIdKey          = mkPreludeMiscIdUnique 277\nsectionRIdKey          = mkPreludeMiscIdUnique 278\nlamEIdKey              = mkPreludeMiscIdUnique 279\nlamCaseEIdKey          = mkPreludeMiscIdUnique 280\ntupEIdKey              = mkPreludeMiscIdUnique 281\nunboxedTupEIdKey       = mkPreludeMiscIdUnique 282\nunboxedSumEIdKey       = mkPreludeMiscIdUnique 283\ncondEIdKey             = mkPreludeMiscIdUnique 284\nmultiIfEIdKey          = mkPreludeMiscIdUnique 285\nletEIdKey              = mkPreludeMiscIdUnique 286\ncaseEIdKey             = mkPreludeMiscIdUnique 287\ndoEIdKey               = mkPreludeMiscIdUnique 288\ncompEIdKey             = mkPreludeMiscIdUnique 289\nfromEIdKey             = mkPreludeMiscIdUnique 290\nfromThenEIdKey         = mkPreludeMiscIdUnique 291\nfromToEIdKey           = mkPreludeMiscIdUnique 292\nfromThenToEIdKey       = mkPreludeMiscIdUnique 293\nlistEIdKey             = mkPreludeMiscIdUnique 294\nsigEIdKey              = mkPreludeMiscIdUnique 295\nrecConEIdKey           = mkPreludeMiscIdUnique 296\nrecUpdEIdKey           = mkPreludeMiscIdUnique 297\nstaticEIdKey           = mkPreludeMiscIdUnique 298\nunboundVarEIdKey       = mkPreludeMiscIdUnique 299\nlabelEIdKey            = mkPreludeMiscIdUnique 300\nimplicitParamVarEIdKey = mkPreludeMiscIdUnique 301\nmdoEIdKey              = mkPreludeMiscIdUnique 302\n\n-- type FieldExp = ...\nfieldExpIdKey :: Unique\nfieldExpIdKey       = mkPreludeMiscIdUnique 305\n\n-- data Body = ...\nguardedBIdKey, normalBIdKey :: Unique\nguardedBIdKey     = mkPreludeMiscIdUnique 306\nnormalBIdKey      = mkPreludeMiscIdUnique 307\n\n-- data Guard = ...\nnormalGEIdKey, patGEIdKey :: Unique\nnormalGEIdKey     = mkPreludeMiscIdUnique 308\npatGEIdKey        = mkPreludeMiscIdUnique 309\n\n-- data Stmt = ...\nbindSIdKey, letSIdKey, noBindSIdKey, parSIdKey, recSIdKey :: Unique\nbindSIdKey       = mkPreludeMiscIdUnique 310\nletSIdKey        = mkPreludeMiscIdUnique 311\nnoBindSIdKey     = mkPreludeMiscIdUnique 312\nparSIdKey        = mkPreludeMiscIdUnique 313\nrecSIdKey        = mkPreludeMiscIdUnique 314\n\n-- data Dec = ...\nfunDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey,\n    instanceWithOverlapDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey,\n    pragInlDIdKey, pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey,\n    pragRuleDIdKey, pragAnnDIdKey, defaultSigDIdKey, dataFamilyDIdKey,\n    openTypeFamilyDIdKey, closedTypeFamilyDIdKey, dataInstDIdKey,\n    newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey,\n    infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey,\n    patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey :: Unique\nfunDIdKey                         = mkPreludeMiscIdUnique 320\nvalDIdKey                         = mkPreludeMiscIdUnique 321\ndataDIdKey                        = mkPreludeMiscIdUnique 322\nnewtypeDIdKey                     = mkPreludeMiscIdUnique 323\ntySynDIdKey                       = mkPreludeMiscIdUnique 324\nclassDIdKey                       = mkPreludeMiscIdUnique 325\ninstanceWithOverlapDIdKey         = mkPreludeMiscIdUnique 326\ninstanceDIdKey                    = mkPreludeMiscIdUnique 327\nsigDIdKey                         = mkPreludeMiscIdUnique 328\nforImpDIdKey                      = mkPreludeMiscIdUnique 329\npragInlDIdKey                     = mkPreludeMiscIdUnique 330\npragSpecDIdKey                    = mkPreludeMiscIdUnique 331\npragSpecInlDIdKey                 = mkPreludeMiscIdUnique 332\npragSpecInstDIdKey                = mkPreludeMiscIdUnique 333\npragRuleDIdKey                    = mkPreludeMiscIdUnique 334\npragAnnDIdKey                     = mkPreludeMiscIdUnique 335\ndataFamilyDIdKey                  = mkPreludeMiscIdUnique 336\nopenTypeFamilyDIdKey              = mkPreludeMiscIdUnique 337\ndataInstDIdKey                    = mkPreludeMiscIdUnique 338\nnewtypeInstDIdKey                 = mkPreludeMiscIdUnique 339\ntySynInstDIdKey                   = mkPreludeMiscIdUnique 340\nclosedTypeFamilyDIdKey            = mkPreludeMiscIdUnique 341\ninfixLDIdKey                      = mkPreludeMiscIdUnique 342\ninfixRDIdKey                      = mkPreludeMiscIdUnique 343\ninfixNDIdKey                      = mkPreludeMiscIdUnique 344\nroleAnnotDIdKey                   = mkPreludeMiscIdUnique 345\nstandaloneDerivWithStrategyDIdKey = mkPreludeMiscIdUnique 346\ndefaultSigDIdKey                  = mkPreludeMiscIdUnique 347\npatSynDIdKey                      = mkPreludeMiscIdUnique 348\npatSynSigDIdKey                   = mkPreludeMiscIdUnique 349\npragCompleteDIdKey                = mkPreludeMiscIdUnique 350\nimplicitParamBindDIdKey           = mkPreludeMiscIdUnique 351\n\n-- type Cxt = ...\ncxtIdKey :: Unique\ncxtIdKey               = mkPreludeMiscIdUnique 361\n\n-- data SourceUnpackedness = ...\nnoSourceUnpackednessKey, sourceNoUnpackKey, sourceUnpackKey :: Unique\nnoSourceUnpackednessKey = mkPreludeMiscIdUnique 362\nsourceNoUnpackKey       = mkPreludeMiscIdUnique 363\nsourceUnpackKey         = mkPreludeMiscIdUnique 364\n\n-- data SourceStrictness = ...\nnoSourceStrictnessKey, sourceLazyKey, sourceStrictKey :: Unique\nnoSourceStrictnessKey   = mkPreludeMiscIdUnique 365\nsourceLazyKey           = mkPreludeMiscIdUnique 366\nsourceStrictKey         = mkPreludeMiscIdUnique 367\n\n-- data Con = ...\nnormalCIdKey, recCIdKey, infixCIdKey, forallCIdKey, gadtCIdKey,\n  recGadtCIdKey :: Unique\nnormalCIdKey      = mkPreludeMiscIdUnique 368\nrecCIdKey         = mkPreludeMiscIdUnique 369\ninfixCIdKey       = mkPreludeMiscIdUnique 370\nforallCIdKey      = mkPreludeMiscIdUnique 371\ngadtCIdKey        = mkPreludeMiscIdUnique 372\nrecGadtCIdKey     = mkPreludeMiscIdUnique 373\n\n-- data Bang = ...\nbangIdKey :: Unique\nbangIdKey         = mkPreludeMiscIdUnique 374\n\n-- type BangType = ...\nbangTKey :: Unique\nbangTKey          = mkPreludeMiscIdUnique 375\n\n-- type VarBangType = ...\nvarBangTKey :: Unique\nvarBangTKey       = mkPreludeMiscIdUnique 376\n\n-- data PatSynDir = ...\nunidirPatSynIdKey, implBidirPatSynIdKey, explBidirPatSynIdKey :: Unique\nunidirPatSynIdKey    = mkPreludeMiscIdUnique 377\nimplBidirPatSynIdKey = mkPreludeMiscIdUnique 378\nexplBidirPatSynIdKey = mkPreludeMiscIdUnique 379\n\n-- data PatSynArgs = ...\nprefixPatSynIdKey, infixPatSynIdKey, recordPatSynIdKey :: Unique\nprefixPatSynIdKey = mkPreludeMiscIdUnique 380\ninfixPatSynIdKey  = mkPreludeMiscIdUnique 381\nrecordPatSynIdKey = mkPreludeMiscIdUnique 382\n\n-- data Type = ...\nforallTIdKey, forallVisTIdKey, varTIdKey, conTIdKey, tupleTIdKey,\n    unboxedTupleTIdKey, unboxedSumTIdKey, arrowTIdKey, listTIdKey, appTIdKey,\n    appKindTIdKey, sigTIdKey, equalityTIdKey, litTIdKey, promotedTIdKey,\n    promotedTupleTIdKey, promotedNilTIdKey, promotedConsTIdKey,\n    wildCardTIdKey, implicitParamTIdKey, infixTIdKey :: Unique\nforallTIdKey        = mkPreludeMiscIdUnique 390\nforallVisTIdKey     = mkPreludeMiscIdUnique 391\nvarTIdKey           = mkPreludeMiscIdUnique 392\nconTIdKey           = mkPreludeMiscIdUnique 393\ntupleTIdKey         = mkPreludeMiscIdUnique 394\nunboxedTupleTIdKey  = mkPreludeMiscIdUnique 395\nunboxedSumTIdKey    = mkPreludeMiscIdUnique 396\narrowTIdKey         = mkPreludeMiscIdUnique 397\nlistTIdKey          = mkPreludeMiscIdUnique 398\nappTIdKey           = mkPreludeMiscIdUnique 399\nappKindTIdKey       = mkPreludeMiscIdUnique 400\nsigTIdKey           = mkPreludeMiscIdUnique 401\nequalityTIdKey      = mkPreludeMiscIdUnique 402\nlitTIdKey           = mkPreludeMiscIdUnique 403\npromotedTIdKey      = mkPreludeMiscIdUnique 404\npromotedTupleTIdKey = mkPreludeMiscIdUnique 405\npromotedNilTIdKey   = mkPreludeMiscIdUnique 406\npromotedConsTIdKey  = mkPreludeMiscIdUnique 407\nwildCardTIdKey      = mkPreludeMiscIdUnique 408\nimplicitParamTIdKey = mkPreludeMiscIdUnique 409\ninfixTIdKey         = mkPreludeMiscIdUnique 410\n\n-- data TyLit = ...\nnumTyLitIdKey, strTyLitIdKey :: Unique\nnumTyLitIdKey = mkPreludeMiscIdUnique 411\nstrTyLitIdKey = mkPreludeMiscIdUnique 412\n\n-- data TyVarBndr = ...\nplainTVIdKey, kindedTVIdKey :: Unique\nplainTVIdKey       = mkPreludeMiscIdUnique 413\nkindedTVIdKey      = mkPreludeMiscIdUnique 414\n\n-- data Role = ...\nnominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique\nnominalRIdKey          = mkPreludeMiscIdUnique 415\nrepresentationalRIdKey = mkPreludeMiscIdUnique 416\nphantomRIdKey          = mkPreludeMiscIdUnique 417\ninferRIdKey            = mkPreludeMiscIdUnique 418\n\n-- data Kind = ...\nvarKIdKey, conKIdKey, tupleKIdKey, arrowKIdKey, listKIdKey, appKIdKey,\n  starKIdKey, constraintKIdKey :: Unique\nvarKIdKey         = mkPreludeMiscIdUnique 419\nconKIdKey         = mkPreludeMiscIdUnique 420\ntupleKIdKey       = mkPreludeMiscIdUnique 421\narrowKIdKey       = mkPreludeMiscIdUnique 422\nlistKIdKey        = mkPreludeMiscIdUnique 423\nappKIdKey         = mkPreludeMiscIdUnique 424\nstarKIdKey        = mkPreludeMiscIdUnique 425\nconstraintKIdKey  = mkPreludeMiscIdUnique 426\n\n-- data FamilyResultSig = ...\nnoSigIdKey, kindSigIdKey, tyVarSigIdKey :: Unique\nnoSigIdKey        = mkPreludeMiscIdUnique 427\nkindSigIdKey      = mkPreludeMiscIdUnique 428\ntyVarSigIdKey     = mkPreludeMiscIdUnique 429\n\n-- data InjectivityAnn = ...\ninjectivityAnnIdKey :: Unique\ninjectivityAnnIdKey = mkPreludeMiscIdUnique 430\n\n-- data Callconv = ...\ncCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey,\n  javaScriptCallIdKey :: Unique\ncCallIdKey          = mkPreludeMiscIdUnique 431\nstdCallIdKey        = mkPreludeMiscIdUnique 432\ncApiCallIdKey       = mkPreludeMiscIdUnique 433\nprimCallIdKey       = mkPreludeMiscIdUnique 434\njavaScriptCallIdKey = mkPreludeMiscIdUnique 435\n\n-- data Safety = ...\nunsafeIdKey, safeIdKey, interruptibleIdKey :: Unique\nunsafeIdKey        = mkPreludeMiscIdUnique 440\nsafeIdKey          = mkPreludeMiscIdUnique 441\ninterruptibleIdKey = mkPreludeMiscIdUnique 442\n\n-- data FunDep = ...\nfunDepIdKey :: Unique\nfunDepIdKey = mkPreludeMiscIdUnique 445\n\n-- data TySynEqn = ...\ntySynEqnIdKey :: Unique\ntySynEqnIdKey = mkPreludeMiscIdUnique 460\n\n-- quasiquoting\nquoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique\nquoteExpKey  = mkPreludeMiscIdUnique 470\nquotePatKey  = mkPreludeMiscIdUnique 471\nquoteDecKey  = mkPreludeMiscIdUnique 472\nquoteTypeKey = mkPreludeMiscIdUnique 473\n\n-- data RuleBndr = ...\nruleVarIdKey, typedRuleVarIdKey :: Unique\nruleVarIdKey      = mkPreludeMiscIdUnique 480\ntypedRuleVarIdKey = mkPreludeMiscIdUnique 481\n\n-- data AnnTarget = ...\nvalueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique\nvalueAnnotationIdKey  = mkPreludeMiscIdUnique 490\ntypeAnnotationIdKey   = mkPreludeMiscIdUnique 491\nmoduleAnnotationIdKey = mkPreludeMiscIdUnique 492\n\n-- type DerivPred = ...\nderivClauseIdKey :: Unique\nderivClauseIdKey = mkPreludeMiscIdUnique 493\n\n-- data DerivStrategy = ...\nstockStrategyIdKey, anyclassStrategyIdKey, newtypeStrategyIdKey,\n  viaStrategyIdKey :: Unique\nstockStrategyIdKey    = mkPreludeDataConUnique 494\nanyclassStrategyIdKey = mkPreludeDataConUnique 495\nnewtypeStrategyIdKey  = mkPreludeDataConUnique 496\nviaStrategyIdKey      = mkPreludeDataConUnique 497\n\n{-\n************************************************************************\n*                                                                      *\n                        RdrNames\n*                                                                      *\n************************************************************************\n-}\n\nlift_RDR, mkNameG_dRDR, mkNameG_vRDR :: RdrName\nlift_RDR     = nameRdrName liftName\nmkNameG_dRDR = nameRdrName mkNameG_dName\nmkNameG_vRDR = nameRdrName mkNameG_vName\n\n-- data Exp = ...\nconE_RDR, litE_RDR, appE_RDR, infixApp_RDR :: RdrName\nconE_RDR     = nameRdrName conEName\nlitE_RDR     = nameRdrName litEName\nappE_RDR     = nameRdrName appEName\ninfixApp_RDR = nameRdrName infixAppName\n\n-- data Lit = ...\nstringL_RDR, intPrimL_RDR, wordPrimL_RDR, floatPrimL_RDR,\n    doublePrimL_RDR, stringPrimL_RDR, charPrimL_RDR :: RdrName\nstringL_RDR     = nameRdrName stringLName\nintPrimL_RDR    = nameRdrName intPrimLName\nwordPrimL_RDR   = nameRdrName wordPrimLName\nfloatPrimL_RDR  = nameRdrName floatPrimLName\ndoublePrimL_RDR = nameRdrName doublePrimLName\nstringPrimL_RDR = nameRdrName stringPrimLName\ncharPrimL_RDR   = nameRdrName charPrimLName\n", "num_lines": 1103}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1994-1998\n\n\n\\section[TysPrim]{Wired-in knowledge about primitive types}\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- | This module defines TyCons that can't be expressed in Haskell.\n--   They are all, therefore, wired-in TyCons.  C.f module TysWiredIn\nmodule TysPrim(\n        mkPrimTyConName, -- For implicit parameters in TysWiredIn only\n\n        mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom,\n        mkTemplateKiTyVars,\n\n        mkTemplateTyConBinders, mkTemplateKindTyConBinders,\n        mkTemplateAnonTyConBinders,\n\n        alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,\n        alphaTys, alphaTy, betaTy, gammaTy, deltaTy,\n        alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep,\n        alphaTysUnliftedRep, alphaTyUnliftedRep,\n        runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,\n        openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,\n\n        -- Kind constructors...\n        tYPETyCon, tYPETyConName,\n\n        -- Kinds\n        tYPE, primRepToRuntimeRep,\n\n        funTyCon, funTyConName,\n        unexposedPrimTyCons, exposedPrimTyCons, primTyCons,\n\n        charPrimTyCon,          charPrimTy, charPrimTyConName,\n        intPrimTyCon,           intPrimTy, intPrimTyConName,\n        wordPrimTyCon,          wordPrimTy, wordPrimTyConName,\n        addrPrimTyCon,          addrPrimTy, addrPrimTyConName,\n        floatPrimTyCon,         floatPrimTy, floatPrimTyConName,\n        doublePrimTyCon,        doublePrimTy, doublePrimTyConName,\n\n        voidPrimTyCon,          voidPrimTy,\n        statePrimTyCon,         mkStatePrimTy,\n        realWorldTyCon,         realWorldTy, realWorldStatePrimTy,\n\n        proxyPrimTyCon,         mkProxyPrimTy,\n\n        arrayPrimTyCon, mkArrayPrimTy,\n        byteArrayPrimTyCon,     byteArrayPrimTy,\n        arrayArrayPrimTyCon, mkArrayArrayPrimTy,\n        smallArrayPrimTyCon, mkSmallArrayPrimTy,\n        mutableArrayPrimTyCon, mkMutableArrayPrimTy,\n        mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,\n        mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,\n        smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,\n        mutVarPrimTyCon, mkMutVarPrimTy,\n\n        mVarPrimTyCon,                  mkMVarPrimTy,\n        tVarPrimTyCon,                  mkTVarPrimTy,\n        stablePtrPrimTyCon,             mkStablePtrPrimTy,\n        stableNamePrimTyCon,            mkStableNamePrimTy,\n        compactPrimTyCon,               compactPrimTy,\n        bcoPrimTyCon,                   bcoPrimTy,\n        weakPrimTyCon,                  mkWeakPrimTy,\n        threadIdPrimTyCon,              threadIdPrimTy,\n\n        int8PrimTyCon,          int8PrimTy, int8PrimTyConName,\n        word8PrimTyCon,         word8PrimTy, word8PrimTyConName,\n\n        int16PrimTyCon,         int16PrimTy, int16PrimTyConName,\n        word16PrimTyCon,        word16PrimTy, word16PrimTyConName,\n\n        int32PrimTyCon,         int32PrimTy, int32PrimTyConName,\n        word32PrimTyCon,        word32PrimTy, word32PrimTyConName,\n\n        int64PrimTyCon,         int64PrimTy, int64PrimTyConName,\n        word64PrimTyCon,        word64PrimTy, word64PrimTyConName,\n\n        eqPrimTyCon,            -- ty1 ~# ty2\n        eqReprPrimTyCon,        -- ty1 ~R# ty2  (at role Representational)\n        eqPhantPrimTyCon,       -- ty1 ~P# ty2  (at role Phantom)\n\n        -- * SIMD\n#include \"primop-vector-tys-exports.hs-incl\"\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TysWiredIn\n  ( runtimeRepTy, unboxedTupleKind, liftedTypeKind\n  , vecRepDataConTyCon, tupleRepDataConTyCon\n  , liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy\n  , int16RepDataConTy, word16RepDataConTy\n  , wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy\n  , addrRepDataConTy\n  , floatRepDataConTy, doubleRepDataConTy\n  , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy\n  , vec64DataConTy\n  , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy\n  , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy\n  , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy\n  , doubleElemRepDataConTy\n  , mkPromotedListTy )\n\nimport Var              ( TyVar, mkTyVar )\nimport Name\nimport TyCon\nimport SrcLoc\nimport Unique\nimport PrelNames\nimport FastString\nimport Outputable\nimport TyCoRep   -- Doesn't need special access, but this is easier to avoid\n                 -- import loops which show up if you import Type instead\n\nimport Data.Char\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Primitive type constructors}\n*                                                                      *\n************************************************************************\n-}\n\nprimTyCons :: [TyCon]\nprimTyCons = unexposedPrimTyCons ++ exposedPrimTyCons\n\n-- | Primitive 'TyCon's that are defined in \"GHC.Prim\" but not exposed.\n-- It's important to keep these separate as we don't want users to be able to\n-- write them (see Trac #15209) or see them in GHCi's @:browse@ output\n-- (see Trac #12023).\nunexposedPrimTyCons :: [TyCon]\nunexposedPrimTyCons\n  = [ eqPrimTyCon\n    , eqReprPrimTyCon\n    , eqPhantPrimTyCon\n    ]\n\n-- | Primitive 'TyCon's that are defined in, and exported from, \"GHC.Prim\".\nexposedPrimTyCons :: [TyCon]\nexposedPrimTyCons\n  = [ addrPrimTyCon\n    , arrayPrimTyCon\n    , byteArrayPrimTyCon\n    , arrayArrayPrimTyCon\n    , smallArrayPrimTyCon\n    , charPrimTyCon\n    , doublePrimTyCon\n    , floatPrimTyCon\n    , intPrimTyCon\n    , int8PrimTyCon\n    , int16PrimTyCon\n    , int32PrimTyCon\n    , int64PrimTyCon\n    , bcoPrimTyCon\n    , weakPrimTyCon\n    , mutableArrayPrimTyCon\n    , mutableByteArrayPrimTyCon\n    , mutableArrayArrayPrimTyCon\n    , smallMutableArrayPrimTyCon\n    , mVarPrimTyCon\n    , tVarPrimTyCon\n    , mutVarPrimTyCon\n    , realWorldTyCon\n    , stablePtrPrimTyCon\n    , stableNamePrimTyCon\n    , compactPrimTyCon\n    , statePrimTyCon\n    , voidPrimTyCon\n    , proxyPrimTyCon\n    , threadIdPrimTyCon\n    , wordPrimTyCon\n    , word8PrimTyCon\n    , word16PrimTyCon\n    , word32PrimTyCon\n    , word64PrimTyCon\n\n    , tYPETyCon\n\n#include \"primop-vector-tycons.hs-incl\"\n    ]\n\nmkPrimTc :: FastString -> Unique -> TyCon -> Name\nmkPrimTc fs unique tycon\n  = mkWiredInName gHC_PRIM (mkTcOccFS fs)\n                  unique\n                  (ATyCon tycon)        -- Relevant TyCon\n                  UserSyntax\n\nmkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name\nmkBuiltInPrimTc fs unique tycon\n  = mkWiredInName gHC_PRIM (mkTcOccFS fs)\n                  unique\n                  (ATyCon tycon)        -- Relevant TyCon\n                  BuiltInSyntax\n\n\ncharPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, voidPrimTyConName :: Name\ncharPrimTyConName             = mkPrimTc (fsLit \"Char#\") charPrimTyConKey charPrimTyCon\nintPrimTyConName              = mkPrimTc (fsLit \"Int#\") intPrimTyConKey  intPrimTyCon\nint8PrimTyConName             = mkPrimTc (fsLit \"Int8#\") int8PrimTyConKey int8PrimTyCon\nint16PrimTyConName            = mkPrimTc (fsLit \"Int16#\") int16PrimTyConKey int16PrimTyCon\nint32PrimTyConName            = mkPrimTc (fsLit \"Int32#\") int32PrimTyConKey int32PrimTyCon\nint64PrimTyConName            = mkPrimTc (fsLit \"Int64#\") int64PrimTyConKey int64PrimTyCon\nwordPrimTyConName             = mkPrimTc (fsLit \"Word#\") wordPrimTyConKey wordPrimTyCon\nword8PrimTyConName            = mkPrimTc (fsLit \"Word8#\") word8PrimTyConKey word8PrimTyCon\nword16PrimTyConName           = mkPrimTc (fsLit \"Word16#\") word16PrimTyConKey word16PrimTyCon\nword32PrimTyConName           = mkPrimTc (fsLit \"Word32#\") word32PrimTyConKey word32PrimTyCon\nword64PrimTyConName           = mkPrimTc (fsLit \"Word64#\") word64PrimTyConKey word64PrimTyCon\naddrPrimTyConName             = mkPrimTc (fsLit \"Addr#\") addrPrimTyConKey addrPrimTyCon\nfloatPrimTyConName            = mkPrimTc (fsLit \"Float#\") floatPrimTyConKey floatPrimTyCon\ndoublePrimTyConName           = mkPrimTc (fsLit \"Double#\") doublePrimTyConKey doublePrimTyCon\nstatePrimTyConName            = mkPrimTc (fsLit \"State#\") statePrimTyConKey statePrimTyCon\nvoidPrimTyConName             = mkPrimTc (fsLit \"Void#\") voidPrimTyConKey voidPrimTyCon\nproxyPrimTyConName            = mkPrimTc (fsLit \"Proxy#\") proxyPrimTyConKey proxyPrimTyCon\neqPrimTyConName               = mkPrimTc (fsLit \"~#\") eqPrimTyConKey eqPrimTyCon\neqReprPrimTyConName           = mkBuiltInPrimTc (fsLit \"~R#\") eqReprPrimTyConKey eqReprPrimTyCon\neqPhantPrimTyConName          = mkBuiltInPrimTc (fsLit \"~P#\") eqPhantPrimTyConKey eqPhantPrimTyCon\nrealWorldTyConName            = mkPrimTc (fsLit \"RealWorld\") realWorldTyConKey realWorldTyCon\narrayPrimTyConName            = mkPrimTc (fsLit \"Array#\") arrayPrimTyConKey arrayPrimTyCon\nbyteArrayPrimTyConName        = mkPrimTc (fsLit \"ByteArray#\") byteArrayPrimTyConKey byteArrayPrimTyCon\narrayArrayPrimTyConName           = mkPrimTc (fsLit \"ArrayArray#\") arrayArrayPrimTyConKey arrayArrayPrimTyCon\nsmallArrayPrimTyConName       = mkPrimTc (fsLit \"SmallArray#\") smallArrayPrimTyConKey smallArrayPrimTyCon\nmutableArrayPrimTyConName     = mkPrimTc (fsLit \"MutableArray#\") mutableArrayPrimTyConKey mutableArrayPrimTyCon\nmutableByteArrayPrimTyConName = mkPrimTc (fsLit \"MutableByteArray#\") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon\nmutableArrayArrayPrimTyConName= mkPrimTc (fsLit \"MutableArrayArray#\") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon\nsmallMutableArrayPrimTyConName= mkPrimTc (fsLit \"SmallMutableArray#\") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon\nmutVarPrimTyConName           = mkPrimTc (fsLit \"MutVar#\") mutVarPrimTyConKey mutVarPrimTyCon\nmVarPrimTyConName             = mkPrimTc (fsLit \"MVar#\") mVarPrimTyConKey mVarPrimTyCon\ntVarPrimTyConName             = mkPrimTc (fsLit \"TVar#\") tVarPrimTyConKey tVarPrimTyCon\nstablePtrPrimTyConName        = mkPrimTc (fsLit \"StablePtr#\") stablePtrPrimTyConKey stablePtrPrimTyCon\nstableNamePrimTyConName       = mkPrimTc (fsLit \"StableName#\") stableNamePrimTyConKey stableNamePrimTyCon\ncompactPrimTyConName          = mkPrimTc (fsLit \"Compact#\") compactPrimTyConKey compactPrimTyCon\nbcoPrimTyConName              = mkPrimTc (fsLit \"BCO#\") bcoPrimTyConKey bcoPrimTyCon\nweakPrimTyConName             = mkPrimTc (fsLit \"Weak#\") weakPrimTyConKey weakPrimTyCon\nthreadIdPrimTyConName         = mkPrimTc (fsLit \"ThreadId#\") threadIdPrimTyConKey threadIdPrimTyCon\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Support code}\n*                                                                      *\n************************************************************************\n\nalphaTyVars is a list of type variables for use in templates:\n        [\"a\", \"b\", ..., \"z\", \"t1\", \"t2\", ... ]\n-}\n\nmkTemplateKindVars :: [Kind] -> [TyVar]\n-- k0  with unique (mkAlphaTyVarUnique 0)\n-- k1  with unique (mkAlphaTyVarUnique 1)\n-- ... etc\nmkTemplateKindVars [kind]\n  = [mkTyVar (mk_tv_name 0 \"k\") kind]\n    -- Special case for one kind: just \"k\"\n\nmkTemplateKindVars kinds\n  = [ mkTyVar (mk_tv_name u ('k' : show u)) kind\n    | (kind, u) <- kinds `zip` [0..] ]\nmk_tv_name :: Int -> String -> Name\nmk_tv_name u s = mkInternalName (mkAlphaTyVarUnique u)\n                                (mkTyVarOccFS (mkFastString s))\n                                noSrcSpan\n\nmkTemplateTyVarsFrom :: Int -> [Kind] -> [TyVar]\n-- a  with unique (mkAlphaTyVarUnique n)\n-- b  with unique (mkAlphaTyVarUnique n+1)\n-- ... etc\n-- Typically called as\n--   mkTemplateTyVarsFrom (length kv_bndrs) kinds\n-- where kv_bndrs are the kind-level binders of a TyCon\nmkTemplateTyVarsFrom n kinds\n  = [ mkTyVar name kind\n    | (kind, index) <- zip kinds [0..],\n      let ch_ord = index + ord 'a'\n          name_str | ch_ord <= ord 'z' = [chr ch_ord]\n                   | otherwise         = 't':show index\n          name = mk_tv_name (index + n) name_str\n    ]\n\nmkTemplateTyVars :: [Kind] -> [TyVar]\nmkTemplateTyVars = mkTemplateTyVarsFrom 1\n\nmkTemplateTyConBinders\n    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars\n    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]\n                             --     same length as first arg\n                             -- Result is anon arg kinds\n    -> [TyConBinder]\nmkTemplateTyConBinders kind_var_kinds mk_anon_arg_kinds\n  = kv_bndrs ++ tv_bndrs\n  where\n    kv_bndrs   = mkTemplateKindTyConBinders kind_var_kinds\n    anon_kinds = mk_anon_arg_kinds (mkTyVarTys (binderVars kv_bndrs))\n    tv_bndrs   = mkTemplateAnonTyConBindersFrom (length kv_bndrs) anon_kinds\n\nmkTemplateKiTyVars\n    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars\n    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]\n                             --     same length as first arg\n                             -- Result is anon arg kinds [ak1, .., akm]\n    -> [TyVar]   -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]\n-- Example: if you want the tyvars for\n--   forall (r:RuntimeRep) (a:TYPE r) (b:*). blah\n-- call mkTemplateKiTyVars [RuntimeRep] (\\[r]. [TYPE r, *)\nmkTemplateKiTyVars kind_var_kinds mk_arg_kinds\n  = kv_bndrs ++ tv_bndrs\n  where\n    kv_bndrs   = mkTemplateKindVars kind_var_kinds\n    anon_kinds = mk_arg_kinds (mkTyVarTys kv_bndrs)\n    tv_bndrs   = mkTemplateTyVarsFrom (length kv_bndrs) anon_kinds\n\nmkTemplateKindTyConBinders :: [Kind] -> [TyConBinder]\n-- Makes named, Specified binders\nmkTemplateKindTyConBinders kinds = [mkNamedTyConBinder Specified tv | tv <- mkTemplateKindVars kinds]\n\nmkTemplateAnonTyConBinders :: [Kind] -> [TyConBinder]\nmkTemplateAnonTyConBinders kinds = mkAnonTyConBinders VisArg (mkTemplateTyVars kinds)\n\nmkTemplateAnonTyConBindersFrom :: Int -> [Kind] -> [TyConBinder]\nmkTemplateAnonTyConBindersFrom n kinds = mkAnonTyConBinders VisArg (mkTemplateTyVarsFrom n kinds)\n\nalphaTyVars :: [TyVar]\nalphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind\n\nalphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar\n(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars\n\nalphaTys :: [Type]\nalphaTys = mkTyVarTys alphaTyVars\nalphaTy, betaTy, gammaTy, deltaTy :: Type\n(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys\n\nalphaTyVarsUnliftedRep :: [TyVar]\nalphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepDataConTy)\n\nalphaTyVarUnliftedRep :: TyVar\n(alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep\n\nalphaTysUnliftedRep :: [Type]\nalphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep\nalphaTyUnliftedRep :: Type\n(alphaTyUnliftedRep:_) = alphaTysUnliftedRep\n\nruntimeRep1TyVar, runtimeRep2TyVar :: TyVar\n(runtimeRep1TyVar : runtimeRep2TyVar : _)\n  = drop 16 (mkTemplateTyVars (repeat runtimeRepTy))  -- selects 'q','r'\n\nruntimeRep1Ty, runtimeRep2Ty :: Type\nruntimeRep1Ty = mkTyVarTy runtimeRep1TyVar\nruntimeRep2Ty = mkTyVarTy runtimeRep2TyVar\n\nopenAlphaTyVar, openBetaTyVar :: TyVar\n[openAlphaTyVar,openBetaTyVar]\n  = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty]\n\nopenAlphaTy, openBetaTy :: Type\nopenAlphaTy = mkTyVarTy openAlphaTyVar\nopenBetaTy  = mkTyVarTy openBetaTyVar\n\n{-\n************************************************************************\n*                                                                      *\n                FunTyCon\n*                                                                      *\n************************************************************************\n-}\n\nfunTyConName :: Name\nfunTyConName = mkPrimTyConName (fsLit \"->\") funTyConKey funTyCon\n\n-- | The @(->)@ type constructor.\n--\n-- @\n-- (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).\n--         TYPE rep1 -> TYPE rep2 -> *\n-- @\nfunTyCon :: TyCon\nfunTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm\n  where\n    tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar\n               , mkNamedTyConBinder Inferred runtimeRep2TyVar ]\n               ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty\n                                             , tYPE runtimeRep2Ty\n                                             ]\n    tc_rep_nm = mkPrelTyConRepName funTyConName\n\n{-\n************************************************************************\n*                                                                      *\n                Kinds\n*                                                                      *\n************************************************************************\n\nNote [TYPE and RuntimeRep]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nAll types that classify values have a kind of the form (TYPE rr), where\n\n    data RuntimeRep     -- Defined in ghc-prim:GHC.Types\n      = LiftedRep\n      | UnliftedRep\n      | IntRep\n      | FloatRep\n      .. etc ..\n\n    rr :: RuntimeRep\n\n    TYPE :: RuntimeRep -> TYPE 'LiftedRep  -- Built in\n\nSo for example:\n    Int        :: TYPE 'LiftedRep\n    Array# Int :: TYPE 'UnliftedRep\n    Int#       :: TYPE 'IntRep\n    Float#     :: TYPE 'FloatRep\n    Maybe      :: TYPE 'LiftedRep -> TYPE 'LiftedRep\n    (# , #)    :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2])\n\nWe abbreviate '*' specially:\n    type * = TYPE 'LiftedRep\n\nThe 'rr' parameter tells us how the value is represented at runime.\n\nGenerally speaking, you can't be polymorphic in 'rr'.  E.g\n   f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a]\n   f = /\\(rr:RuntimeRep) (a:rr) \\(a:rr). ...\nThis is no good: we could not generate code code for 'f', because the\ncalling convention for 'f' varies depending on whether the argument is\na a Int, Int#, or Float#.  (You could imagine generating specialised\ncode, one for each instantiation of 'rr', but we don't do that.)\n\nCertain functions CAN be runtime-rep-polymorphic, because the code\ngenerator never has to manipulate a value of type 'a :: TYPE rr'.\n\n* error :: forall (rr:RuntimeRep) (a:TYPE rr). String -> a\n  Code generator never has to manipulate the return value.\n\n* unsafeCoerce#, defined in MkId.unsafeCoerceId:\n  Always inlined to be a no-op\n     unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                             (a :: TYPE r1) (b :: TYPE r2).\n                             a -> b\n\n* Unboxed tuples, and unboxed sums, defined in TysWiredIn\n  Always inlined, and hence specialised to the call site\n     (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                     (a :: TYPE r1) (b :: TYPE r2).\n                     a -> b -> TYPE ('TupleRep '[r1, r2])\n\nNote [PrimRep and kindPrimRep]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs part of its source code, in TyCon, GHC has\n  data PrimRep = LiftedRep | UnliftedRep | IntRep | FloatRep | ...etc...\n\nNotice that\n * RuntimeRep is part of the syntax tree of the program being compiled\n     (defined in a library: ghc-prim:GHC.Types)\n * PrimRep is part of GHC's source code.\n     (defined in TyCon)\n\nWe need to get from one to the other; that is what kindPrimRep does.\nSuppose we have a value\n   (v :: t) where (t :: k)\nGiven this kind\n    k = TyConApp \"TYPE\" [rep]\nGHC needs to be able to figure out how 'v' is represented at runtime.\nIt expects 'rep' to be form\n    TyConApp rr_dc args\nwhere 'rr_dc' is a promoteed data constructor from RuntimeRep. So\nnow we need to go from 'dc' to the corresponding PrimRep.  We store this\nPrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo.\n\n-}\n\ntYPETyCon :: TyCon\ntYPETyConName :: Name\n\ntYPETyCon = mkKindTyCon tYPETyConName\n                        (mkTemplateAnonTyConBinders [runtimeRepTy])\n                        liftedTypeKind\n                        [Nominal]\n                        (mkPrelTyConRepName tYPETyConName)\n\n--------------------------\n-- ... and now their names\n\n-- If you edit these, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ntYPETyConName             = mkPrimTyConName (fsLit \"TYPE\") tYPETyConKey tYPETyCon\n\nmkPrimTyConName :: FastString -> Unique -> TyCon -> Name\nmkPrimTyConName = mkPrimTcName BuiltInSyntax\n  -- All of the super kinds and kinds are defined in Prim,\n  -- and use BuiltInSyntax, because they are never in scope in the source\n\nmkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name\nmkPrimTcName built_in_syntax occ key tycon\n  = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (ATyCon tycon) built_in_syntax\n\n-----------------------------\n-- | Given a RuntimeRep, applies TYPE to it.\n-- see Note [TYPE and RuntimeRep]\ntYPE :: Type -> Type\ntYPE rr = TyConApp tYPETyCon [rr]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)}\n*                                                                      *\n************************************************************************\n-}\n\n-- only used herein\npcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon\npcPrimTyCon name roles rep\n  = mkPrimTyCon name binders result_kind roles\n  where\n    binders     = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)\n    result_kind = tYPE (primRepToRuntimeRep rep)\n\n-- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep\n-- Defined here to avoid (more) module loops\nprimRepToRuntimeRep :: PrimRep -> Type\nprimRepToRuntimeRep rep = case rep of\n  VoidRep       -> TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy []]\n  LiftedRep     -> liftedRepDataConTy\n  UnliftedRep   -> unliftedRepDataConTy\n  IntRep        -> intRepDataConTy\n  Int8Rep       -> int8RepDataConTy\n  Int16Rep      -> int16RepDataConTy\n  WordRep       -> wordRepDataConTy\n  Int64Rep      -> int64RepDataConTy\n  Word8Rep      -> word8RepDataConTy\n  Word16Rep     -> word16RepDataConTy\n  Word64Rep     -> word64RepDataConTy\n  AddrRep       -> addrRepDataConTy\n  FloatRep      -> floatRepDataConTy\n  DoubleRep     -> doubleRepDataConTy\n  VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem']\n    where\n      n' = case n of\n        2  -> vec2DataConTy\n        4  -> vec4DataConTy\n        8  -> vec8DataConTy\n        16 -> vec16DataConTy\n        32 -> vec32DataConTy\n        64 -> vec64DataConTy\n        _  -> pprPanic \"Disallowed VecCount\" (ppr n)\n\n      elem' = case elem of\n        Int8ElemRep   -> int8ElemRepDataConTy\n        Int16ElemRep  -> int16ElemRepDataConTy\n        Int32ElemRep  -> int32ElemRepDataConTy\n        Int64ElemRep  -> int64ElemRepDataConTy\n        Word8ElemRep  -> word8ElemRepDataConTy\n        Word16ElemRep -> word16ElemRepDataConTy\n        Word32ElemRep -> word32ElemRepDataConTy\n        Word64ElemRep -> word64ElemRepDataConTy\n        FloatElemRep  -> floatElemRepDataConTy\n        DoubleElemRep -> doubleElemRepDataConTy\n\npcPrimTyCon0 :: Name -> PrimRep -> TyCon\npcPrimTyCon0 name rep\n  = pcPrimTyCon name [] rep\n\ncharPrimTy :: Type\ncharPrimTy      = mkTyConTy charPrimTyCon\ncharPrimTyCon :: TyCon\ncharPrimTyCon   = pcPrimTyCon0 charPrimTyConName WordRep\n\nintPrimTy :: Type\nintPrimTy       = mkTyConTy intPrimTyCon\nintPrimTyCon :: TyCon\nintPrimTyCon    = pcPrimTyCon0 intPrimTyConName IntRep\n\nint8PrimTy :: Type\nint8PrimTy     = mkTyConTy int8PrimTyCon\nint8PrimTyCon :: TyCon\nint8PrimTyCon  = pcPrimTyCon0 int8PrimTyConName Int8Rep\n\nint16PrimTy :: Type\nint16PrimTy    = mkTyConTy int16PrimTyCon\nint16PrimTyCon :: TyCon\nint16PrimTyCon = pcPrimTyCon0 int16PrimTyConName Int16Rep\n\nint32PrimTy :: Type\nint32PrimTy     = mkTyConTy int32PrimTyCon\nint32PrimTyCon :: TyCon\nint32PrimTyCon  = pcPrimTyCon0 int32PrimTyConName IntRep\n\nint64PrimTy :: Type\nint64PrimTy     = mkTyConTy int64PrimTyCon\nint64PrimTyCon :: TyCon\nint64PrimTyCon  = pcPrimTyCon0 int64PrimTyConName Int64Rep\n\nwordPrimTy :: Type\nwordPrimTy      = mkTyConTy wordPrimTyCon\nwordPrimTyCon :: TyCon\nwordPrimTyCon   = pcPrimTyCon0 wordPrimTyConName WordRep\n\nword8PrimTy :: Type\nword8PrimTy     = mkTyConTy word8PrimTyCon\nword8PrimTyCon :: TyCon\nword8PrimTyCon  = pcPrimTyCon0 word8PrimTyConName Word8Rep\n\nword16PrimTy :: Type\nword16PrimTy    = mkTyConTy word16PrimTyCon\nword16PrimTyCon :: TyCon\nword16PrimTyCon = pcPrimTyCon0 word16PrimTyConName Word16Rep\n\nword32PrimTy :: Type\nword32PrimTy    = mkTyConTy word32PrimTyCon\nword32PrimTyCon :: TyCon\nword32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep\n\nword64PrimTy :: Type\nword64PrimTy    = mkTyConTy word64PrimTyCon\nword64PrimTyCon :: TyCon\nword64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep\n\naddrPrimTy :: Type\naddrPrimTy      = mkTyConTy addrPrimTyCon\naddrPrimTyCon :: TyCon\naddrPrimTyCon   = pcPrimTyCon0 addrPrimTyConName AddrRep\n\nfloatPrimTy     :: Type\nfloatPrimTy     = mkTyConTy floatPrimTyCon\nfloatPrimTyCon :: TyCon\nfloatPrimTyCon  = pcPrimTyCon0 floatPrimTyConName FloatRep\n\ndoublePrimTy :: Type\ndoublePrimTy    = mkTyConTy doublePrimTyCon\ndoublePrimTyCon :: TyCon\ndoublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)}\n*                                                                      *\n************************************************************************\n\nNote [The equality types story]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC sports a veritable menagerie of equality types:\n\n         Type or  Lifted?  Hetero?  Role      Built in         Defining module\n         class?    L/U                        TyCon\n-----------------------------------------------------------------------------------------\n~#         T        U      hetero   nominal   eqPrimTyCon      GHC.Prim\n~~         C        L      hetero   nominal   heqTyCon         GHC.Types\n~          C        L      homo     nominal   eqTyCon          GHC.Types\n:~:        T        L      homo     nominal   (not built-in)   Data.Type.Equality\n:~~:       T        L      hetero   nominal   (not built-in)   Data.Type.Equality\n\n~R#        T        U      hetero   repr      eqReprPrimTy     GHC.Prim\nCoercible  C        L      homo     repr      coercibleTyCon   GHC.Types\nCoercion   T        L      homo     repr      (not built-in)   Data.Type.Coercion\n~P#        T        U      hetero   phantom   eqPhantPrimTyCon GHC.Prim\n\nRecall that \"hetero\" means the equality can related types of different\nkinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2)\nalso means that (k1 ~# k2), where (t1 :: k1) and (t2 :: k2).\n\nTo produce less confusion for end users, when not dumping and without\n-fprint-equality-relations, each of these groups is printed as the bottommost\nlisted equality. That is, (~#) and (~~) are both rendered as (~) in\nerror messages, and (~R#) is rendered as Coercible.\n\nLet's take these one at a time:\n\n    --------------------------\n    (~#) :: forall k1 k2. k1 -> k2 -> #\n    --------------------------\nThis is The Type Of Equality in GHC. It classifies nominal coercions.\nThis type is used in the solver for recording equality constraints.\nIt responds \"yes\" to Type.isEqPrimPred and classifies as an EqPred in\nType.classifyPredType.\n\nAll wanted constraints of this type are built with coercion holes.\n(See Note [Coercion holes] in TyCoRep.) But see also\nNote [Deferred errors for coercion holes] in TcErrors to see how\nequality constraints are deferred.\n\nWithin GHC, ~# is called eqPrimTyCon, and it is defined in TysPrim.\n\n\n    --------------------------\n    (~~) :: forall k1 k2. k1 -> k2 -> Constraint\n    --------------------------\nThis is (almost) an ordinary class, defined as if by\n  class a ~# b => a ~~ b\n  instance a ~# b => a ~~ b\nHere's what's unusual about it:\n\n * We can't actually declare it that way because we don't have syntax for ~#.\n   And ~# isn't a constraint, so even if we could write it, it wouldn't kind\n   check.\n\n * Users cannot write instances of it.\n\n * It is \"naturally coherent\". This means that the solver won't hesitate to\n   solve a goal of type (a ~~ b) even if there is, say (Int ~~ c) in the\n   context. (Normally, it waits to learn more, just in case the given\n   influences what happens next.) See Note [Naturally coherent classes]\n   in TcInteract.\n\n * It always terminates. That is, in the UndecidableInstances checks, we\n   don't worry if a (~~) constraint is too big, as we know that solving\n   equality terminates.\n\nOn the other hand, this behaves just like any class w.r.t. eager superclass\nunpacking in the solver. So a lifted equality given quickly becomes an unlifted\nequality given. This is good, because the solver knows all about unlifted\nequalities. There is some special-casing in TcInteract.matchClassInst to\npretend that there is an instance of this class, as we can't write the instance\nin Haskell.\n\nWithin GHC, ~~ is called heqTyCon, and it is defined in TysWiredIn.\n\n\n    --------------------------\n    (~) :: forall k. k -> k -> Constraint\n    --------------------------\nThis is /exactly/ like (~~), except with a homogeneous kind.\nIt is an almost-ordinary class defined as if by\n  class a ~# b => (a :: k) ~ (b :: k)\n  instance a ~# b => a ~ b\n\n * All the bullets for (~~) apply\n\n * In addition (~) is magical syntax, as ~ is a reserved symbol.\n   It cannot be exported or imported.\n\nWithin GHC, ~ is called eqTyCon, and it is defined in TysWiredIn.\n\nHistorical note: prior to July 18 (~) was defined as a\n  more-ordinary class with (~~) as a superclass.  But that made it\n  special in different ways; and the extra superclass selections to\n  get from (~) to (~#) via (~~) were tiresome.  Now it's defined\n  uniformly with (~~) and Coercible; much nicer.)\n\n\n    --------------------------\n    (:~:) :: forall k. k -> k -> *\n    (:~~:) :: forall k1 k2. k1 -> k2 -> *\n    --------------------------\nThese are perfectly ordinary GADTs, wrapping (~) and (~~) resp.\nThey are not defined within GHC at all.\n\n\n    --------------------------\n    (~R#) :: forall k1 k2. k1 -> k2 -> #\n    --------------------------\nThe is the representational analogue of ~#. This is the type of representational\nequalities that the solver works on. All wanted constraints of this type are\nbuilt with coercion holes.\n\nWithin GHC, ~R# is called eqReprPrimTyCon, and it is defined in TysPrim.\n\n\n    --------------------------\n    Coercible :: forall k. k -> k -> Constraint\n    --------------------------\nThis is quite like (~~) in the way it's defined and treated within GHC, but\nit's homogeneous. Homogeneity helps with type inference (as GHC can solve one\nkind from the other) and, in my (Richard's) estimation, will be more intuitive\nfor users.\n\nAn alternative design included HCoercible (like (~~)) and Coercible (like (~)).\nOne annoyance was that we want `coerce :: Coercible a b => a -> b`, and\nwe need the type of coerce to be fully wired-in. So the HCoercible/Coercible\nsplit required that both types be fully wired-in. Instead of doing this,\nI just got rid of HCoercible, as I'm not sure who would use it, anyway.\n\nWithin GHC, Coercible is called coercibleTyCon, and it is defined in\nTysWiredIn.\n\n\n    --------------------------\n    Coercion :: forall k. k -> k -> *\n    --------------------------\nThis is a perfectly ordinary GADT, wrapping Coercible. It is not defined\nwithin GHC at all.\n\n\n    --------------------------\n    (~P#) :: forall k1 k2. k1 -> k2 -> #\n    --------------------------\nThis is the phantom analogue of ~# and it is barely used at all.\n(The solver has no idea about this one.) Here is the motivation:\n\n    data Phant a = MkPhant\n    type role Phant phantom\n\n    Phant <Int, Bool>_P :: Phant Int ~P# Phant Bool\n\nWe just need to have something to put on that last line. You probably\ndon't need to worry about it.\n\n\n\nNote [The State# TyCon]\n~~~~~~~~~~~~~~~~~~~~~~~\nState# is the primitive, unlifted type of states.  It has one type parameter,\nthus\n        State# RealWorld\nor\n        State# s\n\nwhere s is a type variable. The only purpose of the type parameter is to\nkeep different state threads separate.  It is represented by nothing at all.\n\nThe type parameter to State# is intended to keep separate threads separate.\nEven though this parameter is not used in the definition of State#, it is\ngiven role Nominal to enforce its intended use.\n-}\n\nmkStatePrimTy :: Type -> Type\nmkStatePrimTy ty = TyConApp statePrimTyCon [ty]\n\nstatePrimTyCon :: TyCon   -- See Note [The State# TyCon]\nstatePrimTyCon   = pcPrimTyCon statePrimTyConName [Nominal] VoidRep\n\n{-\nRealWorld is deeply magical.  It is *primitive*, but it is not\n*unlifted* (hence ptrArg).  We never manipulate values of type\nRealWorld; it's only used in the type system, to parameterise State#.\n-}\n\nrealWorldTyCon :: TyCon\nrealWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind []\nrealWorldTy :: Type\nrealWorldTy          = mkTyConTy realWorldTyCon\nrealWorldStatePrimTy :: Type\nrealWorldStatePrimTy = mkStatePrimTy realWorldTy        -- State# RealWorld\n\n-- Note: the ``state-pairing'' types are not truly primitive,\n-- so they are defined in \\tr{TysWiredIn.hs}, not here.\n\n\nvoidPrimTy :: Type\nvoidPrimTy = TyConApp voidPrimTyCon []\n\nvoidPrimTyCon :: TyCon\nvoidPrimTyCon    = pcPrimTyCon voidPrimTyConName [] VoidRep\n\nmkProxyPrimTy :: Type -> Type -> Type\nmkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]\n\nproxyPrimTyCon :: TyCon\nproxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Phantom]\n  where\n     -- Kind: forall k. k -> TYPE (Tuple '[])\n     binders = mkTemplateTyConBinders [liftedTypeKind] id\n     res_kind = unboxedTupleKind []\n\n\n{- *********************************************************************\n*                                                                      *\n                Primitive equality constraints\n    See Note [The equality types story]\n*                                                                      *\n********************************************************************* -}\n\neqPrimTyCon :: TyCon  -- The representation type for equality predicates\n                      -- See Note [The equality types story]\neqPrimTyCon  = mkPrimTyCon eqPrimTyConName binders res_kind roles\n  where\n    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])\n    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id\n    res_kind = unboxedTupleKind []\n    roles    = [Nominal, Nominal, Nominal, Nominal]\n\n-- like eqPrimTyCon, but the type for *Representational* coercions\n-- this should only ever appear as the type of a covar. Its role is\n-- interpreted in coercionRole\neqReprPrimTyCon :: TyCon   -- See Note [The equality types story]\neqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles\n  where\n    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])\n    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id\n    res_kind = unboxedTupleKind []\n    roles    = [Nominal, Nominal, Representational, Representational]\n\n-- like eqPrimTyCon, but the type for *Phantom* coercions.\n-- This is only used to make higher-order equalities. Nothing\n-- should ever actually have this type!\neqPhantPrimTyCon :: TyCon\neqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind roles\n  where\n    -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[])\n    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id\n    res_kind = unboxedTupleKind []\n    roles    = [Nominal, Nominal, Phantom, Phantom]\n\n{- *********************************************************************\n*                                                                      *\n             The primitive array types\n*                                                                      *\n********************************************************************* -}\n\narrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,\n    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,\n    smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon\narrayPrimTyCon             = pcPrimTyCon arrayPrimTyConName             [Representational] UnliftedRep\nmutableArrayPrimTyCon      = pcPrimTyCon  mutableArrayPrimTyConName     [Nominal, Representational] UnliftedRep\nmutableByteArrayPrimTyCon  = pcPrimTyCon mutableByteArrayPrimTyConName  [Nominal] UnliftedRep\nbyteArrayPrimTyCon         = pcPrimTyCon0 byteArrayPrimTyConName        UnliftedRep\narrayArrayPrimTyCon        = pcPrimTyCon0 arrayArrayPrimTyConName       UnliftedRep\nmutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] UnliftedRep\nsmallArrayPrimTyCon        = pcPrimTyCon smallArrayPrimTyConName        [Representational] UnliftedRep\nsmallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep\n\nmkArrayPrimTy :: Type -> Type\nmkArrayPrimTy elt           = TyConApp arrayPrimTyCon [elt]\nbyteArrayPrimTy :: Type\nbyteArrayPrimTy             = mkTyConTy byteArrayPrimTyCon\nmkArrayArrayPrimTy :: Type\nmkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon\nmkSmallArrayPrimTy :: Type -> Type\nmkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]\nmkMutableArrayPrimTy :: Type -> Type -> Type\nmkMutableArrayPrimTy s elt  = TyConApp mutableArrayPrimTyCon [s, elt]\nmkMutableByteArrayPrimTy :: Type -> Type\nmkMutableByteArrayPrimTy s  = TyConApp mutableByteArrayPrimTyCon [s]\nmkMutableArrayArrayPrimTy :: Type -> Type\nmkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]\nmkSmallMutableArrayPrimTy :: Type -> Type -> Type\nmkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]\n\n\n{- *********************************************************************\n*                                                                      *\n                The mutable variable type\n*                                                                      *\n********************************************************************* -}\n\nmutVarPrimTyCon :: TyCon\nmutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] UnliftedRep\n\nmkMutVarPrimTy :: Type -> Type -> Type\nmkMutVarPrimTy s elt        = TyConApp mutVarPrimTyCon [s, elt]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-synch-var]{The synchronizing variable type}\n*                                                                      *\n************************************************************************\n-}\n\nmVarPrimTyCon :: TyCon\nmVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] UnliftedRep\n\nmkMVarPrimTy :: Type -> Type -> Type\nmkMVarPrimTy s elt          = TyConApp mVarPrimTyCon [s, elt]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-stm-var]{The transactional variable type}\n*                                                                      *\n************************************************************************\n-}\n\ntVarPrimTyCon :: TyCon\ntVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] UnliftedRep\n\nmkTVarPrimTy :: Type -> Type -> Type\nmkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-stable-ptrs]{The stable-pointer type}\n*                                                                      *\n************************************************************************\n-}\n\nstablePtrPrimTyCon :: TyCon\nstablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep\n\nmkStablePtrPrimTy :: Type -> Type\nmkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-stable-names]{The stable-name type}\n*                                                                      *\n************************************************************************\n-}\n\nstableNamePrimTyCon :: TyCon\nstableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Phantom] UnliftedRep\n\nmkStableNamePrimTy :: Type -> Type\nmkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-compact-nfdata]{The Compact NFData (CNF) type}\n*                                                                      *\n************************************************************************\n-}\n\ncompactPrimTyCon :: TyCon\ncompactPrimTyCon = pcPrimTyCon0 compactPrimTyConName UnliftedRep\n\ncompactPrimTy :: Type\ncompactPrimTy = mkTyConTy compactPrimTyCon\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-BCOs]{The ``bytecode object'' type}\n*                                                                      *\n************************************************************************\n-}\n\nbcoPrimTy    :: Type\nbcoPrimTy    = mkTyConTy bcoPrimTyCon\nbcoPrimTyCon :: TyCon\nbcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName UnliftedRep\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-Weak]{The ``weak pointer'' type}\n*                                                                      *\n************************************************************************\n-}\n\nweakPrimTyCon :: TyCon\nweakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] UnliftedRep\n\nmkWeakPrimTy :: Type -> Type\nmkWeakPrimTy v = TyConApp weakPrimTyCon [v]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysPrim-thread-ids]{The ``thread id'' type}\n*                                                                      *\n************************************************************************\n\nA thread id is represented by a pointer to the TSO itself, to ensure\nthat they are always unique and we can always find the TSO for a given\nthread id.  However, this has the unfortunate consequence that a\nThreadId# for a given thread is treated as a root by the garbage\ncollector and can keep TSOs around for too long.\n\nHence the programmer API for thread manipulation uses a weak pointer\nto the thread id internally.\n-}\n\nthreadIdPrimTy :: Type\nthreadIdPrimTy    = mkTyConTy threadIdPrimTyCon\nthreadIdPrimTyCon :: TyCon\nthreadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName UnliftedRep\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{SIMD vector types}\n*                                                                      *\n************************************************************************\n-}\n\n#include \"primop-vector-tys.hs-incl\"\n", "num_lines": 1078}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP Project, Glasgow University, 1994-1998\n\n\\section[TysWiredIn]{Wired-in knowledge about {\\em non-primitive} types}\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE OverloadedStrings #-}\n\n-- | This module is about types that can be defined in Haskell, but which\n--   must be wired into the compiler nonetheless.  C.f module TysPrim\nmodule TysWiredIn (\n        -- * Helper functions defined here\n        mkWiredInTyConName, -- This is used in TcTypeNats to define the\n                            -- built-in functions for evaluation.\n\n        mkWiredInIdName,    -- used in MkId\n\n        -- * All wired in things\n        wiredInTyCons, isBuiltInOcc_maybe,\n\n        -- * Bool\n        boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,\n        trueDataCon,  trueDataConId,  true_RDR,\n        falseDataCon, falseDataConId, false_RDR,\n        promotedFalseDataCon, promotedTrueDataCon,\n\n        -- * Ordering\n        orderingTyCon,\n        ordLTDataCon, ordLTDataConId,\n        ordEQDataCon, ordEQDataConId,\n        ordGTDataCon, ordGTDataConId,\n        promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,\n\n        -- * Boxing primitive types\n        boxingDataCon_maybe,\n\n        -- * Char\n        charTyCon, charDataCon, charTyCon_RDR,\n        charTy, stringTy, charTyConName,\n\n        -- * Double\n        doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,\n\n        -- * Float\n        floatTyCon, floatDataCon, floatTy, floatTyConName,\n\n        -- * Int\n        intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,\n        intTy,\n\n        -- * Word\n        wordTyCon, wordDataCon, wordTyConName, wordTy,\n\n        -- * Word8\n        word8TyCon, word8DataCon, word8TyConName, word8Ty,\n\n        -- * List\n        listTyCon, listTyCon_RDR, listTyConName, listTyConKey,\n        nilDataCon, nilDataConName, nilDataConKey,\n        consDataCon_RDR, consDataCon, consDataConName,\n        promotedNilDataCon, promotedConsDataCon,\n        mkListTy, mkPromotedListTy,\n\n        -- * Maybe\n        maybeTyCon, maybeTyConName,\n        nothingDataCon, nothingDataConName, promotedNothingDataCon,\n        justDataCon, justDataConName, promotedJustDataCon,\n\n        -- * Tuples\n        mkTupleTy, mkBoxedTupleTy,\n        tupleTyCon, tupleDataCon, tupleTyConName,\n        promotedTupleDataCon,\n        unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,\n        pairTyCon,\n        unboxedUnitTyCon, unboxedUnitDataCon,\n        unboxedTupleKind, unboxedSumKind,\n\n        -- ** Constraint tuples\n        cTupleTyConName, cTupleTyConNames, isCTupleTyConName,\n        cTupleTyConNameArity_maybe,\n        cTupleDataConName, cTupleDataConNames,\n\n        -- * Any\n        anyTyCon, anyTy, anyTypeOfKind,\n\n        -- * Recovery TyCon\n        makeRecoveryTyCon,\n\n        -- * Sums\n        mkSumTy, sumTyCon, sumDataCon,\n\n        -- * Kinds\n        typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,\n        isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,\n        liftedTypeKindTyCon, constraintKindTyCon,\n        liftedTypeKindTyConName,\n\n        -- * Equality predicates\n        heqTyCon, heqTyConName, heqClass, heqDataCon,\n        eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR,\n        coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,\n\n        -- * RuntimeRep and friends\n        runtimeRepTyCon, vecCountTyCon, vecElemTyCon,\n\n        runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,\n\n        vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,\n\n        liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy,\n        int16RepDataConTy, word16RepDataConTy,\n        wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy,\n        addrRepDataConTy,\n        floatRepDataConTy, doubleRepDataConTy,\n\n        vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,\n        vec64DataConTy,\n\n        int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,\n        int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,\n        word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,\n        doubleElemRepDataConTy\n\n    ) where\n\n#include \"HsVersions.h\"\n#include \"MachDeps.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId )\n\n-- friends:\nimport PrelNames\nimport TysPrim\nimport {-# SOURCE #-} KnownUniques\n\n-- others:\nimport CoAxiom\nimport Id\nimport Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )\nimport Module           ( Module )\nimport Type\nimport RepType\nimport DataCon\nimport {-# SOURCE #-} ConLike\nimport TyCon\nimport Class            ( Class, mkClass )\nimport RdrName\nimport Name\nimport NameEnv          ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF )\nimport NameSet          ( NameSet, mkNameSet, elemNameSet )\nimport BasicTypes       ( Arity, Boxity(..), TupleSort(..), ConTagZ,\n                          SourceText(..) )\nimport ForeignCall\nimport SrcLoc           ( noSrcSpan )\nimport Unique\nimport Data.Array\nimport FastString\nimport Outputable\nimport Util\nimport BooleanFormula   ( mkAnd )\n\nimport qualified Data.ByteString.Char8 as BS\n\nimport Data.List        ( elemIndex )\n\nalpha_tyvar :: [TyVar]\nalpha_tyvar = [alphaTyVar]\n\nalpha_ty :: [Type]\nalpha_ty = [alphaTy]\n\n{-\nNote [Wiring in RuntimeRep]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe RuntimeRep type (and friends) in GHC.Types has a bunch of constructors,\nmaking it a pain to wire in. To ease the pain somewhat, we use lists of\nthe different bits, like Uniques, Names, DataCons. These lists must be\nkept in sync with each other. The rule is this: use the order as declared\nin GHC.Types. All places where such lists exist should contain a reference\nto this Note, so a search for this Note's name should find all the lists.\n\n************************************************************************\n*                                                                      *\n\\subsection{Wired in type constructors}\n*                                                                      *\n************************************************************************\n\nIf you change which things are wired in, make sure you change their\nnames in PrelNames, so they use wTcQual, wDataQual, etc\n-}\n\n-- This list is used only to define PrelInfo.wiredInThings. That in turn\n-- is used to initialise the name environment carried around by the renamer.\n-- This means that if we look up the name of a TyCon (or its implicit binders)\n-- that occurs in this list that name will be assigned the wired-in key we\n-- define here.\n--\n-- Because of their infinite nature, this list excludes tuples, Any and implicit\n-- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).\n--\n-- See also Note [Known-key names]\nwiredInTyCons :: [TyCon]\n\nwiredInTyCons = [ -- Units are not treated like other tuples, because then\n                  -- are defined in GHC.Base, and there's only a few of them. We\n                  -- put them in wiredInTyCons so that they will pre-populate\n                  -- the name cache, so the parser in isBuiltInOcc_maybe doesn't\n                  -- need to look out for them.\n                  unitTyCon\n                , unboxedUnitTyCon\n                , anyTyCon\n                , boolTyCon\n                , charTyCon\n                , doubleTyCon\n                , floatTyCon\n                , intTyCon\n                , wordTyCon\n                , word8TyCon\n                , listTyCon\n                , maybeTyCon\n                , heqTyCon\n                , eqTyCon\n                , coercibleTyCon\n                , typeNatKindCon\n                , typeSymbolKindCon\n                , runtimeRepTyCon\n                , vecCountTyCon\n                , vecElemTyCon\n                , constraintKindTyCon\n                , liftedTypeKindTyCon\n                ]\n\nmkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name\nmkWiredInTyConName built_in modu fs unique tycon\n  = mkWiredInName modu (mkTcOccFS fs) unique\n                  (ATyCon tycon)        -- Relevant TyCon\n                  built_in\n\nmkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name\nmkWiredInDataConName built_in modu fs unique datacon\n  = mkWiredInName modu (mkDataOccFS fs) unique\n                  (AConLike (RealDataCon datacon))    -- Relevant DataCon\n                  built_in\n\nmkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name\nmkWiredInIdName mod fs uniq id\n = mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax\n\n-- See Note [Kind-changing of (~) and Coercible]\n-- in libraries/ghc-prim/GHC/Types.hs\neqTyConName, eqDataConName, eqSCSelIdName :: Name\neqTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"~\")   eqTyConKey   eqTyCon\neqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"Eq#\") eqDataConKey eqDataCon\neqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit \"eq_sel\") eqSCSelIdKey eqSCSelId\n\neqTyCon_RDR :: RdrName\neqTyCon_RDR = nameRdrName eqTyConName\n\n-- See Note [Kind-changing of (~) and Coercible]\n-- in libraries/ghc-prim/GHC/Types.hs\nheqTyConName, heqDataConName, heqSCSelIdName :: Name\nheqTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"~~\")   heqTyConKey      heqTyCon\nheqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"HEq#\") heqDataConKey heqDataCon\nheqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit \"heq_sel\") heqSCSelIdKey heqSCSelId\n\n-- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs\ncoercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name\ncoercibleTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"Coercible\")  coercibleTyConKey   coercibleTyCon\ncoercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"MkCoercible\") coercibleDataConKey coercibleDataCon\ncoercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit \"coercible_sel\") coercibleSCSelIdKey coercibleSCSelId\n\ncharTyConName, charDataConName, intTyConName, intDataConName :: Name\ncharTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"Char\") charTyConKey charTyCon\ncharDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"C#\") charDataConKey charDataCon\nintTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"Int\") intTyConKey   intTyCon\nintDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"I#\") intDataConKey  intDataCon\n\nboolTyConName, falseDataConName, trueDataConName :: Name\nboolTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"Bool\") boolTyConKey boolTyCon\nfalseDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"False\") falseDataConKey falseDataCon\ntrueDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"True\")  trueDataConKey  trueDataCon\n\nlistTyConName, nilDataConName, consDataConName :: Name\nlistTyConName     = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit \"[]\") listTyConKey listTyCon\nnilDataConName    = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit \"[]\") nilDataConKey nilDataCon\nconsDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit \":\") consDataConKey consDataCon\n\nmaybeTyConName, nothingDataConName, justDataConName :: Name\nmaybeTyConName     = mkWiredInTyConName   UserSyntax gHC_MAYBE (fsLit \"Maybe\")\n                                          maybeTyConKey maybeTyCon\nnothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit \"Nothing\")\n                                          nothingDataConKey nothingDataCon\njustDataConName    = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit \"Just\")\n                                          justDataConKey justDataCon\n\nwordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name\nwordTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"Word\")   wordTyConKey     wordTyCon\nwordDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"W#\")     wordDataConKey   wordDataCon\nword8TyConName     = mkWiredInTyConName   UserSyntax gHC_WORD  (fsLit \"Word8\")  word8TyConKey    word8TyCon\nword8DataConName   = mkWiredInDataConName UserSyntax gHC_WORD  (fsLit \"W8#\")    word8DataConKey  word8DataCon\n\nfloatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name\nfloatTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"Float\")  floatTyConKey    floatTyCon\nfloatDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"F#\")     floatDataConKey  floatDataCon\ndoubleTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit \"Double\") doubleTyConKey   doubleTyCon\ndoubleDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"D#\")     doubleDataConKey doubleDataCon\n\n-- Any\n\n{-\nNote [Any types]\n~~~~~~~~~~~~~~~~\nThe type constructor Any,\n\n    type family Any :: k where { }\n\nIt has these properties:\n\n  * Note that 'Any' is kind polymorphic since in some program we may\n    need to use Any to fill in a type variable of some kind other than *\n    (see #959 for examples).  Its kind is thus `forall k. k``.\n\n  * It is defined in module GHC.Types, and exported so that it is\n    available to users.  For this reason it's treated like any other\n    wired-in type:\n      - has a fixed unique, anyTyConKey,\n      - lives in the global name cache\n\n  * It is a *closed* type family, with no instances.  This means that\n    if   ty :: '(k1, k2)  we add a given coercion\n             g :: ty ~ (Fst ty, Snd ty)\n    If Any was a *data* type, then we'd get inconsistency because 'ty'\n    could be (Any '(k1,k2)) and then we'd have an equality with Any on\n    one side and '(,) on the other. See also #9097 and #9636.\n\n  * When instantiated at a lifted type it is inhabited by at least one value,\n    namely bottom\n\n  * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce.\n\n  * It does not claim to be a *data* type, and that's important for\n    the code generator, because the code gen may *enter* a data value\n    but never enters a function value.\n\n  * It is wired-in so we can easily refer to it where we don't have a name\n    environment (e.g. see Rules.matchRule for one example)\n\n  * If (Any k) is the type of a value, it must be a /lifted/ value. So\n    if we have (Any @(TYPE rr)) then rr must be 'LiftedRep.  See\n    Note [TYPE and RuntimeRep] in TysPrim.  This is a convenient\n    invariant, and makes isUnliftedTyCon well-defined; otherwise what\n    would (isUnliftedTyCon Any) be?\n\nIt's used to instantiate un-constrained type variables after type checking. For\nexample, 'length' has type\n\n  length :: forall a. [a] -> Int\n\nand the list datacon for the empty list has type\n\n  [] :: forall a. [a]\n\nIn order to compose these two terms as @length []@ a type\napplication is required, but there is no constraint on the\nchoice.  In this situation GHC uses 'Any',\n\n> length (Any *) ([] (Any *))\n\nAbove, we print kinds explicitly, as if with --fprint-explicit-kinds.\n\nThe Any tycon used to be quite magic, but we have since been able to\nimplement it merely with an empty kind polymorphic type family. See #10886 for a\nbit of history.\n-}\n\n\nanyTyConName :: Name\nanyTyConName =\n    mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"Any\") anyTyConKey anyTyCon\n\nanyTyCon :: TyCon\nanyTyCon = mkFamilyTyCon anyTyConName binders res_kind Nothing\n                         (ClosedSynFamilyTyCon Nothing)\n                         Nothing\n                         NotInjective\n  where\n    binders@[kv] = mkTemplateKindTyConBinders [liftedTypeKind]\n    res_kind = mkTyVarTy (binderVar kv)\n\nanyTy :: Type\nanyTy = mkTyConTy anyTyCon\n\nanyTypeOfKind :: Kind -> Type\nanyTypeOfKind kind = mkTyConApp anyTyCon [kind]\n\n-- | Make a fake, recovery 'TyCon' from an existing one.\n-- Used when recovering from errors in type declarations\nmakeRecoveryTyCon :: TyCon -> TyCon\nmakeRecoveryTyCon tc\n  = mkTcTyCon (tyConName tc)\n              bndrs res_kind\n              []               -- No scoped vars\n              True             -- Fully generalised\n              flavour          -- Keep old flavour\n  where\n    flavour = tyConFlavour tc\n    [kv] = mkTemplateKindVars [liftedTypeKind]\n    (bndrs, res_kind)\n       = case flavour of\n           PromotedDataConFlavour -> ([mkNamedTyConBinder Inferred kv], mkTyVarTy kv)\n           _ -> (tyConBinders tc, tyConResKind tc)\n        -- For data types we have already validated their kind, so it\n        -- makes sense to keep it. For promoted data constructors we haven't,\n        -- so we recover with kind (forall k. k).  Otherwise consider\n        --     data T a where { MkT :: Show a => T a }\n        -- If T is for some reason invalid, we don't want to fall over\n        -- at (promoted) use-sites of MkT.\n\n-- Kinds\ntypeNatKindConName, typeSymbolKindConName :: Name\ntypeNatKindConName    = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"Nat\")    typeNatKindConNameKey    typeNatKindCon\ntypeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"Symbol\") typeSymbolKindConNameKey typeSymbolKindCon\n\nconstraintKindTyConName :: Name\nconstraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"Constraint\") constraintKindTyConKey   constraintKindTyCon\n\nliftedTypeKindTyConName :: Name\nliftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"Type\") liftedTypeKindTyConKey liftedTypeKindTyCon\n\nruntimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name\nruntimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"RuntimeRep\") runtimeRepTyConKey runtimeRepTyCon\nvecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"VecRep\") vecRepDataConKey vecRepDataCon\ntupleRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"TupleRep\") tupleRepDataConKey tupleRepDataCon\nsumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit \"SumRep\") sumRepDataConKey sumRepDataCon\n\n-- See Note [Wiring in RuntimeRep]\nruntimeRepSimpleDataConNames :: [Name]\nruntimeRepSimpleDataConNames\n  = zipWith3Lazy mk_special_dc_name\n      [ fsLit \"LiftedRep\"\n      , fsLit \"UnliftedRep\"\n      , fsLit \"IntRep\"\n      , fsLit \"WordRep\"\n      , fsLit \"Int8Rep\"\n      , fsLit \"Int16Rep\"\n      , fsLit \"Int64Rep\"\n      , fsLit \"Word8Rep\"\n      , fsLit \"Word16Rep\"\n      , fsLit \"Word64Rep\"\n      , fsLit \"AddrRep\"\n      , fsLit \"FloatRep\"\n      , fsLit \"DoubleRep\"\n      ]\n      runtimeRepSimpleDataConKeys\n      runtimeRepSimpleDataCons\n\nvecCountTyConName :: Name\nvecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"VecCount\") vecCountTyConKey vecCountTyCon\n\n-- See Note [Wiring in RuntimeRep]\nvecCountDataConNames :: [Name]\nvecCountDataConNames = zipWith3Lazy mk_special_dc_name\n                         [ fsLit \"Vec2\", fsLit \"Vec4\", fsLit \"Vec8\"\n                         , fsLit \"Vec16\", fsLit \"Vec32\", fsLit \"Vec64\" ]\n                         vecCountDataConKeys\n                         vecCountDataCons\n\nvecElemTyConName :: Name\nvecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit \"VecElem\") vecElemTyConKey vecElemTyCon\n\n-- See Note [Wiring in RuntimeRep]\nvecElemDataConNames :: [Name]\nvecElemDataConNames = zipWith3Lazy mk_special_dc_name\n                        [ fsLit \"Int8ElemRep\", fsLit \"Int16ElemRep\", fsLit \"Int32ElemRep\"\n                        , fsLit \"Int64ElemRep\", fsLit \"Word8ElemRep\", fsLit \"Word16ElemRep\"\n                        , fsLit \"Word32ElemRep\", fsLit \"Word64ElemRep\"\n                        , fsLit \"FloatElemRep\", fsLit \"DoubleElemRep\" ]\n                        vecElemDataConKeys\n                        vecElemDataCons\n\nmk_special_dc_name :: FastString -> Unique -> DataCon -> Name\nmk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc\n\nboolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,\n    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName\nboolTyCon_RDR   = nameRdrName boolTyConName\nfalse_RDR       = nameRdrName falseDataConName\ntrue_RDR        = nameRdrName trueDataConName\nintTyCon_RDR    = nameRdrName intTyConName\ncharTyCon_RDR   = nameRdrName charTyConName\nintDataCon_RDR  = nameRdrName intDataConName\nlistTyCon_RDR   = nameRdrName listTyConName\nconsDataCon_RDR = nameRdrName consDataConName\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{mkWiredInTyCon}\n*                                                                      *\n************************************************************************\n-}\n\n-- This function assumes that the types it creates have all parameters at\n-- Representational role, and that there is no kind polymorphism.\npcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon\npcTyCon name cType tyvars cons\n  = mkAlgTyCon name\n                (mkAnonTyConBinders VisArg tyvars)\n                liftedTypeKind\n                (map (const Representational) tyvars)\n                cType\n                []              -- No stupid theta\n                (mkDataTyConRhs cons)\n                (VanillaAlgTyCon (mkPrelTyConRepName name))\n                False           -- Not in GADT syntax\n\npcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon\npcDataCon n univs = pcDataConWithFixity False n univs\n                      []    -- no ex_tvs\n                      univs -- the univs are precisely the user-written tyvars\n\npcDataConWithFixity :: Bool      -- ^ declared infix?\n                    -> Name      -- ^ datacon name\n                    -> [TyVar]   -- ^ univ tyvars\n                    -> [TyCoVar] -- ^ ex tycovars\n                    -> [TyCoVar] -- ^ user-written tycovars\n                    -> [Type]    -- ^ args\n                    -> TyCon\n                    -> DataCon\npcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n))\n                                                  NoRRI\n-- The Name's unique is the first of two free uniques;\n-- the first is used for the datacon itself,\n-- the second is used for the \"worker name\"\n--\n-- To support this the mkPreludeDataConUnique function \"allocates\"\n-- one DataCon unique per pair of Ints.\n\npcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo\n                     -> [TyVar] -> [TyCoVar] -> [TyCoVar]\n                     -> [Type] -> TyCon -> DataCon\n-- The Name should be in the DataName name space; it's the name\n-- of the DataCon itself.\n\npcDataConWithFixity' declared_infix dc_name wrk_key rri\n                     tyvars ex_tyvars user_tyvars arg_tys tycon\n  = data_con\n  where\n    tag_map = mkTyConTagMap tycon\n    -- This constructs the constructor Name to ConTag map once per\n    -- constructor, which is quadratic. It's OK here, because it's\n    -- only called for wired in data types that don't have a lot of\n    -- constructors. It's also likely that GHC will lift tag_map, since\n    -- we call pcDataConWithFixity' with static TyCons in the same module.\n    -- See Note [Constructor tag allocation] and #14657\n    data_con = mkDataCon dc_name declared_infix prom_info\n                (map (const no_bang) arg_tys)\n                []      -- No labelled fields\n                tyvars ex_tyvars\n                (mkTyCoVarBinders Specified user_tyvars)\n                []      -- No equality spec\n                []      -- No theta\n                arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))\n                rri\n                tycon\n                (lookupNameEnv_NF tag_map dc_name)\n                []      -- No stupid theta\n                (mkDataConWorkId wrk_name data_con)\n                NoDataConRep    -- Wired-in types are too simple to need wrappers\n\n    no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict\n\n    wrk_name = mkDataConWorkerName data_con wrk_key\n\n    prom_info = mkPrelTyConRepName dc_name\n\nmkDataConWorkerName :: DataCon -> Unique -> Name\nmkDataConWorkerName data_con wrk_key =\n    mkWiredInName modu wrk_occ wrk_key\n                  (AnId (dataConWorkId data_con)) UserSyntax\n  where\n    modu     = ASSERT( isExternalName dc_name )\n               nameModule dc_name\n    dc_name = dataConName data_con\n    dc_occ  = nameOccName dc_name\n    wrk_occ = mkDataConWorkerOcc dc_occ\n\n-- used for RuntimeRep and friends\npcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon\npcSpecialDataCon dc_name arg_tys tycon rri\n  = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri\n                         [] [] [] arg_tys tycon\n\n{-\n************************************************************************\n*                                                                      *\n      Kinds\n*                                                                      *\n************************************************************************\n-}\n\ntypeNatKindCon, typeSymbolKindCon :: TyCon\n-- data Nat\n-- data Symbol\ntypeNatKindCon    = pcTyCon typeNatKindConName    Nothing [] []\ntypeSymbolKindCon = pcTyCon typeSymbolKindConName Nothing [] []\n\ntypeNatKind, typeSymbolKind :: Kind\ntypeNatKind    = mkTyConTy typeNatKindCon\ntypeSymbolKind = mkTyConTy typeSymbolKindCon\n\nconstraintKindTyCon :: TyCon\nconstraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []\n\nliftedTypeKind, constraintKind :: Kind\nliftedTypeKind   = tYPE liftedRepTy\nconstraintKind   = mkTyConApp constraintKindTyCon []\n\n{-\n************************************************************************\n*                                                                      *\n                Stuff for dealing with tuples\n*                                                                      *\n************************************************************************\n\nNote [How tuples work]  See also Note [Known-key names] in PrelNames\n~~~~~~~~~~~~~~~~~~~~~~\n* There are three families of tuple TyCons and corresponding\n  DataCons, expressed by the type BasicTypes.TupleSort:\n    data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple\n\n* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon\n\n* BoxedTuples\n    - A wired-in type\n    - Data type declarations in GHC.Tuple\n    - The data constructors really have an info table\n\n* UnboxedTuples\n    - A wired-in type\n    - Have a pretend DataCon, defined in GHC.Prim,\n      but no actual declaration and no info table\n\n* ConstraintTuples\n    - Are known-key rather than wired-in. Reason: it's awkward to\n      have all the superclass selectors wired-in.\n    - Declared as classes in GHC.Classes, e.g.\n         class (c1,c2) => (c1,c2)\n    - Given constraints: the superclasses automatically become available\n    - Wanted constraints: there is a built-in instance\n         instance (c1,c2) => (c1,c2)\n      See TcInteract.matchCTuple\n    - Currently just go up to 62; beyond that\n      you have to use manual nesting\n    - Their OccNames look like (%,,,%), so they can easily be\n      distinguished from term tuples.  But (following Haskell) we\n      pretty-print saturated constraint tuples with round parens;\n      see BasicTypes.tupleParens.\n\n* In quite a lot of places things are restrcted just to\n  BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish\n  E.g. tupleTyCon has a Boxity argument\n\n* When looking up an OccName in the original-name cache\n  (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure\n  we get the right wired-in name.  This guy can't tell the difference\n  between BoxedTuple and ConstraintTuple (same OccName!), so tuples\n  are not serialised into interface files using OccNames at all.\n\n* Serialization to interface files works via the usual mechanism for known-key\n  things: instead of serializing the OccName we just serialize the key. During\n  deserialization we lookup the Name associated with the unique with the logic\n  in KnownUniques. See Note [Symbol table representation of names] for details.\n\nNote [One-tuples]\n~~~~~~~~~~~~~~~~~\nGHC supports both boxed and unboxed one-tuples:\n - Unboxed one-tuples are sometimes useful when returning a\n   single value after CPR analysis\n - A boxed one-tuple is used by DsUtils.mkSelectorBinds, when\n   there is just one binder\nBasically it keeps everythig uniform.\n\nHowever the /naming/ of the type/data constructors for one-tuples is a\nbit odd:\n  3-tuples:  (,,)   (,,)#\n  2-tuples:  (,)    (,)#\n  1-tuples:  ??\n  0-tuples:  ()     ()#\n\nZero-tuples have used up the logical name. So we use 'Unit' and 'Unit#'\nfor one-tuples.  So in ghc-prim:GHC.Tuple we see the declarations:\n  data ()     = ()\n  data Unit a = Unit a\n  data (a,b)  = (a,b)\n\nNB (Feb 16): for /constraint/ one-tuples I have 'Unit%' but no class\ndecl in GHC.Classes, so I think this part may not work properly. But\nit's unused I think.\n-}\n\n-- | Built-in syntax isn't \"in scope\" so these OccNames map to wired-in Names\n-- with BuiltInSyntax. However, this should only be necessary while resolving\n-- names produced by Template Haskell splices since we take care to encode\n-- built-in syntax names specially in interface files. See\n-- Note [Symbol table representation of names].\n--\n-- Moreover, there is no need to include names of things that the user can't\n-- write (e.g. type representation bindings like $tc(,,,)).\nisBuiltInOcc_maybe :: OccName -> Maybe Name\nisBuiltInOcc_maybe occ =\n    case name of\n      \"[]\" -> Just $ choose_ns listTyConName nilDataConName\n      \":\"    -> Just consDataConName\n\n      -- equality tycon\n      \"~\"    -> Just eqTyConName\n\n      -- function tycon\n      \"->\"   -> Just funTyConName\n\n      -- boxed tuple data/tycon\n      \"()\"    -> Just $ tup_name Boxed 0\n      _ | Just rest <- \"(\" `BS.stripPrefix` name\n        , (commas, rest') <- BS.span (==',') rest\n        , \")\" <- rest'\n             -> Just $ tup_name Boxed (1+BS.length commas)\n\n      -- unboxed tuple data/tycon\n      \"(##)\"  -> Just $ tup_name Unboxed 0\n      \"Unit#\" -> Just $ tup_name Unboxed 1\n      _ | Just rest <- \"(#\" `BS.stripPrefix` name\n        , (commas, rest') <- BS.span (==',') rest\n        , \"#)\" <- rest'\n             -> Just $ tup_name Unboxed (1+BS.length commas)\n\n      -- unboxed sum tycon\n      _ | Just rest <- \"(#\" `BS.stripPrefix` name\n        , (pipes, rest') <- BS.span (=='|') rest\n        , \"#)\" <- rest'\n             -> Just $ tyConName $ sumTyCon (1+BS.length pipes)\n\n      -- unboxed sum datacon\n      _ | Just rest <- \"(#\" `BS.stripPrefix` name\n        , (pipes1, rest') <- BS.span (=='|') rest\n        , Just rest'' <- \"_\" `BS.stripPrefix` rest'\n        , (pipes2, rest''') <- BS.span (=='|') rest''\n        , \"#)\" <- rest'''\n             -> let arity = BS.length pipes1 + BS.length pipes2 + 1\n                    alt = BS.length pipes1 + 1\n                in Just $ dataConName $ sumDataCon alt arity\n      _ -> Nothing\n  where\n    name = bytesFS $ occNameFS occ\n\n    choose_ns :: Name -> Name -> Name\n    choose_ns tc dc\n      | isTcClsNameSpace ns   = tc\n      | isDataConNameSpace ns = dc\n      | otherwise             = pprPanic \"tup_name\" (ppr occ)\n      where ns = occNameSpace occ\n\n    tup_name boxity arity\n      = choose_ns (getName (tupleTyCon   boxity arity))\n                  (getName (tupleDataCon boxity arity))\n\nmkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName\n-- No need to cache these, the caching is done in mk_tuple\nmkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr   ar)\nmkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ar)\n\nmkCTupleOcc :: NameSpace -> Arity -> OccName\nmkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar)\n\nmkBoxedTupleStr :: Arity -> String\nmkBoxedTupleStr 0  = \"()\"\nmkBoxedTupleStr 1  = \"Unit\"   -- See Note [One-tuples]\nmkBoxedTupleStr ar = '(' : commas ar ++ \")\"\n\nmkUnboxedTupleStr :: Arity -> String\nmkUnboxedTupleStr 0  = \"(##)\"\nmkUnboxedTupleStr 1  = \"Unit#\"  -- See Note [One-tuples]\nmkUnboxedTupleStr ar = \"(#\" ++ commas ar ++ \"#)\"\n\nmkConstraintTupleStr :: Arity -> String\nmkConstraintTupleStr 0  = \"(%%)\"\nmkConstraintTupleStr 1  = \"Unit%\"   -- See Note [One-tuples]\nmkConstraintTupleStr ar = \"(%\" ++ commas ar ++ \"%)\"\n\ncommas :: Arity -> String\ncommas ar = take (ar-1) (repeat ',')\n\ncTupleTyConName :: Arity -> Name\ncTupleTyConName arity\n  = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES\n                   (mkCTupleOcc tcName arity) noSrcSpan\n\ncTupleTyConNames :: [Name]\ncTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])\n\ncTupleTyConNameSet :: NameSet\ncTupleTyConNameSet = mkNameSet cTupleTyConNames\n\nisCTupleTyConName :: Name -> Bool\n-- Use Type.isCTupleClass where possible\nisCTupleTyConName n\n = ASSERT2( isExternalName n, ppr n )\n   nameModule n == gHC_CLASSES\n   && n `elemNameSet` cTupleTyConNameSet\n\n-- | If the given name is that of a constraint tuple, return its arity.\n-- Note that this is inefficient.\ncTupleTyConNameArity_maybe :: Name -> Maybe Arity\ncTupleTyConNameArity_maybe n\n  | not (isCTupleTyConName n) = Nothing\n  | otherwise = fmap adjustArity (n `elemIndex` cTupleTyConNames)\n  where\n    -- Since `cTupleTyConNames` jumps straight from the `0` to the `2`\n    -- case, we have to adjust accordingly our calculated arity.\n    adjustArity a = if a > 0 then a + 1 else a\n\ncTupleDataConName :: Arity -> Name\ncTupleDataConName arity\n  = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES\n                   (mkCTupleOcc dataName arity) noSrcSpan\n\ncTupleDataConNames :: [Name]\ncTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE])\n\ntupleTyCon :: Boxity -> Arity -> TyCon\ntupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially\ntupleTyCon Boxed   i = fst (boxedTupleArr   ! i)\ntupleTyCon Unboxed i = fst (unboxedTupleArr ! i)\n\ntupleTyConName :: TupleSort -> Arity -> Name\ntupleTyConName ConstraintTuple a = cTupleTyConName a\ntupleTyConName BoxedTuple      a = tyConName (tupleTyCon Boxed a)\ntupleTyConName UnboxedTuple    a = tyConName (tupleTyCon Unboxed a)\n\npromotedTupleDataCon :: Boxity -> Arity -> TyCon\npromotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)\n\ntupleDataCon :: Boxity -> Arity -> DataCon\ntupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i)    -- Build one specially\ntupleDataCon Boxed   i = snd (boxedTupleArr   ! i)\ntupleDataCon Unboxed i = snd (unboxedTupleArr ! i)\n\nboxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)\nboxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed   i | i <- [0..mAX_TUPLE_SIZE]]\nunboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]\n\n-- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed\n-- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type\n-- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep\n-- [IntRep, LiftedRep])@\nunboxedTupleSumKind :: TyCon -> [Type] -> Kind\nunboxedTupleSumKind tc rr_tys\n  = tYPE (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys])\n\n-- | Specialization of 'unboxedTupleSumKind' for tuples\nunboxedTupleKind :: [Type] -> Kind\nunboxedTupleKind = unboxedTupleSumKind tupleRepDataConTyCon\n\nmk_tuple :: Boxity -> Int -> (TyCon,DataCon)\nmk_tuple Boxed arity = (tycon, tuple_con)\n  where\n    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con\n                         BoxedTuple flavour\n\n    tc_binders  = mkTemplateAnonTyConBinders (nOfThem arity liftedTypeKind)\n    tc_res_kind = liftedTypeKind\n    tc_arity    = arity\n    flavour     = VanillaAlgTyCon (mkPrelTyConRepName tc_name)\n\n    dc_tvs     = binderVars tc_binders\n    dc_arg_tys = mkTyVarTys dc_tvs\n    tuple_con  = pcDataCon dc_name dc_tvs dc_arg_tys tycon\n\n    boxity  = Boxed\n    modu    = gHC_TUPLE\n    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq\n                         (ATyCon tycon) BuiltInSyntax\n    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq\n                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax\n    tc_uniq = mkTupleTyConUnique   boxity arity\n    dc_uniq = mkTupleDataConUnique boxity arity\n\nmk_tuple Unboxed arity = (tycon, tuple_con)\n  where\n    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con\n                         UnboxedTuple flavour\n\n    -- See Note [Unboxed tuple RuntimeRep vars] in TyCon\n    -- Kind:  forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> #\n    tc_binders = mkTemplateTyConBinders (nOfThem arity runtimeRepTy)\n                                        (\\ks -> map tYPE ks)\n\n    tc_res_kind = unboxedTupleKind rr_tys\n\n    tc_arity    = arity * 2\n    flavour     = UnboxedAlgTyCon $ Just (mkPrelTyConRepName tc_name)\n\n    dc_tvs               = binderVars tc_binders\n    (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs)\n    tuple_con            = pcDataCon dc_name dc_tvs dc_arg_tys tycon\n\n    boxity  = Unboxed\n    modu    = gHC_PRIM\n    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq\n                         (ATyCon tycon) BuiltInSyntax\n    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq\n                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax\n    tc_uniq = mkTupleTyConUnique   boxity arity\n    dc_uniq = mkTupleDataConUnique boxity arity\n\nunitTyCon :: TyCon\nunitTyCon = tupleTyCon Boxed 0\n\nunitTyConKey :: Unique\nunitTyConKey = getUnique unitTyCon\n\nunitDataCon :: DataCon\nunitDataCon   = head (tyConDataCons unitTyCon)\n\nunitDataConId :: Id\nunitDataConId = dataConWorkId unitDataCon\n\npairTyCon :: TyCon\npairTyCon = tupleTyCon Boxed 2\n\nunboxedUnitTyCon :: TyCon\nunboxedUnitTyCon = tupleTyCon Unboxed 0\n\nunboxedUnitDataCon :: DataCon\nunboxedUnitDataCon = tupleDataCon   Unboxed 0\n\n\n{- *********************************************************************\n*                                                                      *\n      Unboxed sums\n*                                                                      *\n********************************************************************* -}\n\n-- | OccName for n-ary unboxed sum type constructor.\nmkSumTyConOcc :: Arity -> OccName\nmkSumTyConOcc n = mkOccName tcName str\n  where\n    -- No need to cache these, the caching is done in mk_sum\n    str = '(' : '#' : bars ++ \"#)\"\n    bars = replicate (n-1) '|'\n\n-- | OccName for i-th alternative of n-ary unboxed sum data constructor.\nmkSumDataConOcc :: ConTag -> Arity -> OccName\nmkSumDataConOcc alt n = mkOccName dataName str\n  where\n    -- No need to cache these, the caching is done in mk_sum\n    str = '(' : '#' : bars alt ++ '_' : bars (n - alt - 1) ++ \"#)\"\n    bars i = replicate i '|'\n\n-- | Type constructor for n-ary unboxed sum.\nsumTyCon :: Arity -> TyCon\nsumTyCon arity\n  | arity > mAX_SUM_SIZE\n  = fst (mk_sum arity)  -- Build one specially\n\n  | arity < 2\n  = panic (\"sumTyCon: Arity starts from 2. (arity: \" ++ show arity ++ \")\")\n\n  | otherwise\n  = fst (unboxedSumArr ! arity)\n\n-- | Data constructor for i-th alternative of a n-ary unboxed sum.\nsumDataCon :: ConTag -- Alternative\n           -> Arity  -- Arity\n           -> DataCon\nsumDataCon alt arity\n  | alt > arity\n  = panic (\"sumDataCon: index out of bounds: alt: \"\n           ++ show alt ++ \" > arity \" ++ show arity)\n\n  | alt <= 0\n  = panic (\"sumDataCon: Alts start from 1. (alt: \" ++ show alt\n           ++ \", arity: \" ++ show arity ++ \")\")\n\n  | arity < 2\n  = panic (\"sumDataCon: Arity starts from 2. (alt: \" ++ show alt\n           ++ \", arity: \" ++ show arity ++ \")\")\n\n  | arity > mAX_SUM_SIZE\n  = snd (mk_sum arity) ! (alt - 1)  -- Build one specially\n\n  | otherwise\n  = snd (unboxedSumArr ! arity) ! (alt - 1)\n\n-- | Cached type and data constructors for sums. The outer array is\n-- indexed by the arity of the sum and the inner array is indexed by\n-- the alternative.\nunboxedSumArr :: Array Int (TyCon, Array Int DataCon)\nunboxedSumArr = listArray (2,mAX_SUM_SIZE) [mk_sum i | i <- [2..mAX_SUM_SIZE]]\n\n-- | Specialization of 'unboxedTupleSumKind' for sums\nunboxedSumKind :: [Type] -> Kind\nunboxedSumKind = unboxedTupleSumKind sumRepDataConTyCon\n\n-- | Create type constructor and data constructors for n-ary unboxed sum.\nmk_sum :: Arity -> (TyCon, Array ConTagZ DataCon)\nmk_sum arity = (tycon, sum_cons)\n  where\n    tycon   = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons)\n                         (UnboxedAlgTyCon rep_name)\n\n    -- Unboxed sums are currently not Typeable due to efficiency concerns. See #13276.\n    rep_name = Nothing -- Just $ mkPrelTyConRepName tc_name\n\n    tc_binders = mkTemplateTyConBinders (nOfThem arity runtimeRepTy)\n                                        (\\ks -> map tYPE ks)\n\n    tyvars = binderVars tc_binders\n\n    tc_res_kind = unboxedSumKind rr_tys\n\n    (rr_tys, tyvar_tys) = splitAt arity (mkTyVarTys tyvars)\n\n    tc_name = mkWiredInName gHC_PRIM (mkSumTyConOcc arity) tc_uniq\n                            (ATyCon tycon) BuiltInSyntax\n\n    sum_cons = listArray (0,arity-1) [sum_con i | i <- [0..arity-1]]\n    sum_con i = let dc = pcDataCon dc_name\n                                   tyvars -- univ tyvars\n                                   [tyvar_tys !! i] -- arg types\n                                   tycon\n\n                    dc_name = mkWiredInName gHC_PRIM\n                                            (mkSumDataConOcc i arity)\n                                            (dc_uniq i)\n                                            (AConLike (RealDataCon dc))\n                                            BuiltInSyntax\n                in dc\n\n    tc_uniq   = mkSumTyConUnique   arity\n    dc_uniq i = mkSumDataConUnique i arity\n\n{-\n************************************************************************\n*                                                                      *\n              Equality types and classes\n*                                                                      *\n********************************************************************* -}\n\n-- See Note [The equality types story] in TysPrim\n-- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint)\n--\n-- It's tempting to put functional dependencies on (~~), but it's not\n-- necessary because the functional-dependency coverage check looks\n-- through superclasses, and (~#) is handled in that check.\n\neqTyCon,   heqTyCon,   coercibleTyCon   :: TyCon\neqClass,   heqClass,   coercibleClass   :: Class\neqDataCon, heqDataCon, coercibleDataCon :: DataCon\neqSCSelId, heqSCSelId, coercibleSCSelId :: Id\n\n(eqTyCon, eqClass, eqDataCon, eqSCSelId)\n  = (tycon, klass, datacon, sc_sel_id)\n  where\n    tycon     = mkClassTyCon eqTyConName binders roles\n                             rhs klass\n                             (mkPrelTyConRepName eqTyConName)\n    klass     = mk_class tycon sc_pred sc_sel_id\n    datacon   = pcDataCon eqDataConName tvs [sc_pred] tycon\n\n    -- Kind: forall k. k -> k -> Constraint\n    binders   = mkTemplateTyConBinders [liftedTypeKind] (\\[k] -> [k,k])\n    roles     = [Nominal, Nominal, Nominal]\n    rhs       = mkDataTyConRhs [datacon]\n\n    tvs@[k,a,b] = binderVars binders\n    sc_pred     = mkTyConApp eqPrimTyCon (mkTyVarTys [k,k,a,b])\n    sc_sel_id   = mkDictSelId eqSCSelIdName klass\n\n(heqTyCon, heqClass, heqDataCon, heqSCSelId)\n  = (tycon, klass, datacon, sc_sel_id)\n  where\n    tycon     = mkClassTyCon heqTyConName binders roles\n                             rhs klass\n                             (mkPrelTyConRepName heqTyConName)\n    klass     = mk_class tycon sc_pred sc_sel_id\n    datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon\n\n    -- Kind: forall k1 k2. k1 -> k2 -> Constraint\n    binders   = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id\n    roles     = [Nominal, Nominal, Nominal, Nominal]\n    rhs       = mkDataTyConRhs [datacon]\n\n    tvs       = binderVars binders\n    sc_pred   = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)\n    sc_sel_id = mkDictSelId heqSCSelIdName klass\n\n(coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)\n  = (tycon, klass, datacon, sc_sel_id)\n  where\n    tycon     = mkClassTyCon coercibleTyConName binders roles\n                             rhs klass\n                             (mkPrelTyConRepName coercibleTyConName)\n    klass     = mk_class tycon sc_pred sc_sel_id\n    datacon   = pcDataCon coercibleDataConName tvs [sc_pred] tycon\n\n    -- Kind: forall k. k -> k -> Constraint\n    binders   = mkTemplateTyConBinders [liftedTypeKind] (\\[k] -> [k,k])\n    roles     = [Nominal, Representational, Representational]\n    rhs       = mkDataTyConRhs [datacon]\n\n    tvs@[k,a,b] = binderVars binders\n    sc_pred     = mkTyConApp eqReprPrimTyCon (mkTyVarTys [k, k, a, b])\n    sc_sel_id   = mkDictSelId coercibleSCSelIdName klass\n\nmk_class :: TyCon -> PredType -> Id -> Class\nmk_class tycon sc_pred sc_sel_id\n  = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id]\n            [] [] (mkAnd []) tycon\n\n\n\n{- *********************************************************************\n*                                                                      *\n                Kinds and RuntimeRep\n*                                                                      *\n********************************************************************* -}\n\n-- For information about the usage of the following type,\n-- see Note [TYPE and RuntimeRep] in module TysPrim\nruntimeRepTy :: Type\nruntimeRepTy = mkTyConTy runtimeRepTyCon\n\n-- Type synonyms; see Note [TYPE and RuntimeRep] in TysPrim\n-- type Type = tYPE 'LiftedRep\nliftedTypeKindTyCon :: TyCon\nliftedTypeKindTyCon   = buildSynTyCon liftedTypeKindTyConName\n                                       [] liftedTypeKind []\n                                       (tYPE liftedRepTy)\n\nruntimeRepTyCon :: TyCon\nruntimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []\n                          (vecRepDataCon : tupleRepDataCon :\n                           sumRepDataCon : runtimeRepSimpleDataCons)\n\nvecRepDataCon :: DataCon\nvecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon\n                                                   , mkTyConTy vecElemTyCon ]\n                                 runtimeRepTyCon\n                                 (RuntimeRep prim_rep_fun)\n  where\n    prim_rep_fun [count, elem]\n      | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count)\n      , VecElem  e <- tyConRuntimeRepInfo (tyConAppTyCon elem)\n      = [VecRep n e]\n    prim_rep_fun args\n      = pprPanic \"vecRepDataCon\" (ppr args)\n\nvecRepDataConTyCon :: TyCon\nvecRepDataConTyCon = promoteDataCon vecRepDataCon\n\ntupleRepDataCon :: DataCon\ntupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]\n                                   runtimeRepTyCon (RuntimeRep prim_rep_fun)\n  where\n    prim_rep_fun [rr_ty_list]\n      = concatMap (runtimeRepPrimRep doc) rr_tys\n      where\n        rr_tys = extractPromotedList rr_ty_list\n        doc    = text \"tupleRepDataCon\" <+> ppr rr_tys\n    prim_rep_fun args\n      = pprPanic \"tupleRepDataCon\" (ppr args)\n\ntupleRepDataConTyCon :: TyCon\ntupleRepDataConTyCon = promoteDataCon tupleRepDataCon\n\nsumRepDataCon :: DataCon\nsumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]\n                                 runtimeRepTyCon (RuntimeRep prim_rep_fun)\n  where\n    prim_rep_fun [rr_ty_list]\n      = map slotPrimRep (ubxSumRepType prim_repss)\n      where\n        rr_tys     = extractPromotedList rr_ty_list\n        doc        = text \"sumRepDataCon\" <+> ppr rr_tys\n        prim_repss = map (runtimeRepPrimRep doc) rr_tys\n    prim_rep_fun args\n      = pprPanic \"sumRepDataCon\" (ppr args)\n\nsumRepDataConTyCon :: TyCon\nsumRepDataConTyCon = promoteDataCon sumRepDataCon\n\n-- See Note [Wiring in RuntimeRep]\nruntimeRepSimpleDataCons :: [DataCon]\nliftedRepDataCon :: DataCon\nruntimeRepSimpleDataCons@(liftedRepDataCon : _)\n  = zipWithLazy mk_runtime_rep_dc\n    [ LiftedRep, UnliftedRep, IntRep, WordRep, Int8Rep, Int16Rep, Int64Rep\n    , Word8Rep, Word16Rep, Word64Rep, AddrRep, FloatRep, DoubleRep ]\n    runtimeRepSimpleDataConNames\n  where\n    mk_runtime_rep_dc primrep name\n      = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\\_ -> [primrep]))\n\n-- See Note [Wiring in RuntimeRep]\nliftedRepDataConTy, unliftedRepDataConTy,\n  intRepDataConTy, int8RepDataConTy, int16RepDataConTy, wordRepDataConTy, int64RepDataConTy,\n  word8RepDataConTy, word16RepDataConTy, word64RepDataConTy, addrRepDataConTy,\n  floatRepDataConTy, doubleRepDataConTy :: Type\n[liftedRepDataConTy, unliftedRepDataConTy,\n   intRepDataConTy, wordRepDataConTy, int8RepDataConTy, int16RepDataConTy, int64RepDataConTy,\n   word8RepDataConTy, word16RepDataConTy, word64RepDataConTy,\n   addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy]\n  = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons\n\nvecCountTyCon :: TyCon\nvecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons\n\n-- See Note [Wiring in RuntimeRep]\nvecCountDataCons :: [DataCon]\nvecCountDataCons = zipWithLazy mk_vec_count_dc\n                     [ 2, 4, 8, 16, 32, 64 ]\n                     vecCountDataConNames\n  where\n    mk_vec_count_dc n name\n      = pcSpecialDataCon name [] vecCountTyCon (VecCount n)\n\n-- See Note [Wiring in RuntimeRep]\nvec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,\n  vec64DataConTy :: Type\n[vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,\n  vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons\n\nvecElemTyCon :: TyCon\nvecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons\n\n-- See Note [Wiring in RuntimeRep]\nvecElemDataCons :: [DataCon]\nvecElemDataCons = zipWithLazy mk_vec_elem_dc\n                    [ Int8ElemRep, Int16ElemRep, Int32ElemRep, Int64ElemRep\n                    , Word8ElemRep, Word16ElemRep, Word32ElemRep, Word64ElemRep\n                    , FloatElemRep, DoubleElemRep ]\n                    vecElemDataConNames\n  where\n    mk_vec_elem_dc elem name\n      = pcSpecialDataCon name [] vecElemTyCon (VecElem elem)\n\n-- See Note [Wiring in RuntimeRep]\nint8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,\n  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,\n  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,\n  doubleElemRepDataConTy :: Type\n[int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,\n  int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,\n  word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,\n  doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon)\n                                vecElemDataCons\n\nliftedRepDataConTyCon :: TyCon\nliftedRepDataConTyCon = promoteDataCon liftedRepDataCon\n\n-- The type ('LiftedRep)\nliftedRepTy :: Type\nliftedRepTy = liftedRepDataConTy\n\n{- *********************************************************************\n*                                                                      *\n     The boxed primitive types: Char, Int, etc\n*                                                                      *\n********************************************************************* -}\n\nboxingDataCon_maybe :: TyCon -> Maybe DataCon\n--    boxingDataCon_maybe Char# = C#\n--    boxingDataCon_maybe Int#  = I#\n--    ... etc ...\n-- See Note [Boxing primitive types]\nboxingDataCon_maybe tc\n  = lookupNameEnv boxing_constr_env (tyConName tc)\n\nboxing_constr_env :: NameEnv DataCon\nboxing_constr_env\n  = mkNameEnv [(charPrimTyConName  , charDataCon  )\n              ,(intPrimTyConName   , intDataCon   )\n              ,(wordPrimTyConName  , wordDataCon  )\n              ,(floatPrimTyConName , floatDataCon )\n              ,(doublePrimTyConName, doubleDataCon) ]\n\n{- Note [Boxing primitive types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor a handful of primitive types (Int, Char, Word, Flaot, Double),\nwe can readily box and an unboxed version (Int#, Char# etc) using\nthe corresponding data constructor.  This is useful in a couple\nof places, notably let-floating -}\n\n\ncharTy :: Type\ncharTy = mkTyConTy charTyCon\n\ncharTyCon :: TyCon\ncharTyCon   = pcTyCon charTyConName\n                   (Just (CType NoSourceText Nothing\n                                  (NoSourceText,fsLit \"HsChar\")))\n                   [] [charDataCon]\ncharDataCon :: DataCon\ncharDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon\n\nstringTy :: Type\nstringTy = mkListTy charTy -- convenience only\n\nintTy :: Type\nintTy = mkTyConTy intTyCon\n\nintTyCon :: TyCon\nintTyCon = pcTyCon intTyConName\n               (Just (CType NoSourceText Nothing (NoSourceText,fsLit \"HsInt\")))\n                 [] [intDataCon]\nintDataCon :: DataCon\nintDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon\n\nwordTy :: Type\nwordTy = mkTyConTy wordTyCon\n\nwordTyCon :: TyCon\nwordTyCon = pcTyCon wordTyConName\n            (Just (CType NoSourceText Nothing (NoSourceText, fsLit \"HsWord\")))\n               [] [wordDataCon]\nwordDataCon :: DataCon\nwordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon\n\nword8Ty :: Type\nword8Ty = mkTyConTy word8TyCon\n\nword8TyCon :: TyCon\nword8TyCon = pcTyCon word8TyConName\n                     (Just (CType NoSourceText Nothing\n                            (NoSourceText, fsLit \"HsWord8\"))) []\n                     [word8DataCon]\nword8DataCon :: DataCon\nword8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon\n\nfloatTy :: Type\nfloatTy = mkTyConTy floatTyCon\n\nfloatTyCon :: TyCon\nfloatTyCon   = pcTyCon floatTyConName\n                      (Just (CType NoSourceText Nothing\n                             (NoSourceText, fsLit \"HsFloat\"))) []\n                      [floatDataCon]\nfloatDataCon :: DataCon\nfloatDataCon = pcDataCon         floatDataConName [] [floatPrimTy] floatTyCon\n\ndoubleTy :: Type\ndoubleTy = mkTyConTy doubleTyCon\n\ndoubleTyCon :: TyCon\ndoubleTyCon = pcTyCon doubleTyConName\n                      (Just (CType NoSourceText Nothing\n                             (NoSourceText,fsLit \"HsDouble\"))) []\n                      [doubleDataCon]\n\ndoubleDataCon :: DataCon\ndoubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon\n\n{-\n************************************************************************\n*                                                                      *\n              The Bool type\n*                                                                      *\n************************************************************************\n\nAn ordinary enumeration type, but deeply wired in.  There are no\nmagical operations on @Bool@ (just the regular Prelude code).\n\n{\\em BEGIN IDLE SPECULATION BY SIMON}\n\nThis is not the only way to encode @Bool@.  A more obvious coding makes\n@Bool@ just a boxed up version of @Bool#@, like this:\n\\begin{verbatim}\ntype Bool# = Int#\ndata Bool = MkBool Bool#\n\\end{verbatim}\n\nUnfortunately, this doesn't correspond to what the Report says @Bool@\nlooks like!  Furthermore, we get slightly less efficient code (I\nthink) with this coding. @gtInt@ would look like this:\n\n\\begin{verbatim}\ngtInt :: Int -> Int -> Bool\ngtInt x y = case x of I# x# ->\n            case y of I# y# ->\n            case (gtIntPrim x# y#) of\n                b# -> MkBool b#\n\\end{verbatim}\n\nNotice that the result of the @gtIntPrim@ comparison has to be turned\ninto an integer (here called @b#@), and returned in a @MkBool@ box.\n\nThe @if@ expression would compile to this:\n\\begin{verbatim}\ncase (gtInt x y) of\n  MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }\n\\end{verbatim}\n\nI think this code is a little less efficient than the previous code,\nbut I'm not certain.  At all events, corresponding with the Report is\nimportant.  The interesting thing is that the language is expressive\nenough to describe more than one alternative; and that a type doesn't\nnecessarily need to be a straightforwardly boxed version of its\nprimitive counterpart.\n\n{\\em END IDLE SPECULATION BY SIMON}\n-}\n\nboolTy :: Type\nboolTy = mkTyConTy boolTyCon\n\nboolTyCon :: TyCon\nboolTyCon = pcTyCon boolTyConName\n                    (Just (CType NoSourceText Nothing\n                           (NoSourceText, fsLit \"HsBool\")))\n                    [] [falseDataCon, trueDataCon]\n\nfalseDataCon, trueDataCon :: DataCon\nfalseDataCon = pcDataCon falseDataConName [] [] boolTyCon\ntrueDataCon  = pcDataCon trueDataConName  [] [] boolTyCon\n\nfalseDataConId, trueDataConId :: Id\nfalseDataConId = dataConWorkId falseDataCon\ntrueDataConId  = dataConWorkId trueDataCon\n\norderingTyCon :: TyCon\norderingTyCon = pcTyCon orderingTyConName Nothing\n                        [] [ordLTDataCon, ordEQDataCon, ordGTDataCon]\n\nordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon\nordLTDataCon = pcDataCon ordLTDataConName  [] [] orderingTyCon\nordEQDataCon = pcDataCon ordEQDataConName  [] [] orderingTyCon\nordGTDataCon = pcDataCon ordGTDataConName  [] [] orderingTyCon\n\nordLTDataConId, ordEQDataConId, ordGTDataConId :: Id\nordLTDataConId = dataConWorkId ordLTDataCon\nordEQDataConId = dataConWorkId ordEQDataCon\nordGTDataConId = dataConWorkId ordGTDataCon\n\n{-\n************************************************************************\n*                                                                      *\n            The List type\n   Special syntax, deeply wired in,\n   but otherwise an ordinary algebraic data type\n*                                                                      *\n************************************************************************\n\n       data [] a = [] | a : (List a)\n-}\n\nmkListTy :: Type -> Type\nmkListTy ty = mkTyConApp listTyCon [ty]\n\nlistTyCon :: TyCon\nlistTyCon =\n  buildAlgTyCon listTyConName alpha_tyvar [Representational]\n                Nothing []\n                (mkDataTyConRhs [nilDataCon, consDataCon])\n                False\n                (VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)\n\nnilDataCon :: DataCon\nnilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon\n\nconsDataCon :: DataCon\nconsDataCon = pcDataConWithFixity True {- Declared infix -}\n               consDataConName\n               alpha_tyvar [] alpha_tyvar\n               [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon\n-- Interesting: polymorphic recursion would help here.\n-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy\n-- gets the over-specific type (Type -> Type)\n\n-- Wired-in type Maybe\n\nmaybeTyCon :: TyCon\nmaybeTyCon = pcTyCon maybeTyConName Nothing alpha_tyvar\n                     [nothingDataCon, justDataCon]\n\nnothingDataCon :: DataCon\nnothingDataCon = pcDataCon nothingDataConName alpha_tyvar [] maybeTyCon\n\njustDataCon :: DataCon\njustDataCon = pcDataCon justDataConName alpha_tyvar [alphaTy] maybeTyCon\n\n{-\n** *********************************************************************\n*                                                                      *\n            The tuple types\n*                                                                      *\n************************************************************************\n\nThe tuple types are definitely magic, because they form an infinite\nfamily.\n\n\\begin{itemize}\n\\item\nThey have a special family of type constructors, of type @TyCon@\nThese contain the tycon arity, but don't require a Unique.\n\n\\item\nThey have a special family of constructors, of type\n@Id@. Again these contain their arity but don't need a Unique.\n\n\\item\nThere should be a magic way of generating the info tables and\nentry code for all tuples.\n\nBut at the moment we just compile a Haskell source\nfile\\srcloc{lib/prelude/...} containing declarations like:\n\\begin{verbatim}\ndata Tuple0             = Tup0\ndata Tuple2  a b        = Tup2  a b\ndata Tuple3  a b c      = Tup3  a b c\ndata Tuple4  a b c d    = Tup4  a b c d\n...\n\\end{verbatim}\nThe print-names associated with the magic @Id@s for tuple constructors\n``just happen'' to be the same as those generated by these\ndeclarations.\n\n\\item\nThe instance environment should have a magic way to know\nthat each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and\nso on. \\ToDo{Not implemented yet.}\n\n\\item\nThere should also be a way to generate the appropriate code for each\nof these instances, but (like the info tables and entry code) it is\ndone by enumeration\\srcloc{lib/prelude/InTup?.hs}.\n\\end{itemize}\n-}\n\n-- | Make a tuple type. The list of types should /not/ include any\n-- RuntimeRep specifications.\nmkTupleTy :: Boxity -> [Type] -> Type\n-- Special case for *boxed* 1-tuples, which are represented by the type itself\nmkTupleTy Boxed   [ty] = ty\nmkTupleTy Boxed   tys  = mkTyConApp (tupleTyCon Boxed (length tys)) tys\nmkTupleTy Unboxed tys  = mkTyConApp (tupleTyCon Unboxed (length tys))\n                                        (map getRuntimeRep tys ++ tys)\n\n-- | Build the type of a small tuple that holds the specified type of thing\nmkBoxedTupleTy :: [Type] -> Type\nmkBoxedTupleTy tys = mkTupleTy Boxed tys\n\nunitTy :: Type\nunitTy = mkTupleTy Boxed []\n\n{- *********************************************************************\n*                                                                      *\n            The sum types\n*                                                                      *\n************************************************************************\n-}\n\nmkSumTy :: [Type] -> Type\nmkSumTy tys = mkTyConApp (sumTyCon (length tys))\n                         (map getRuntimeRep tys ++ tys)\n\n-- Promoted Booleans\n\npromotedFalseDataCon, promotedTrueDataCon :: TyCon\npromotedTrueDataCon   = promoteDataCon trueDataCon\npromotedFalseDataCon  = promoteDataCon falseDataCon\n\n-- Promoted Maybe\npromotedNothingDataCon, promotedJustDataCon :: TyCon\npromotedNothingDataCon = promoteDataCon nothingDataCon\npromotedJustDataCon    = promoteDataCon justDataCon\n\n-- Promoted Ordering\n\npromotedLTDataCon\n  , promotedEQDataCon\n  , promotedGTDataCon\n  :: TyCon\npromotedLTDataCon     = promoteDataCon ordLTDataCon\npromotedEQDataCon     = promoteDataCon ordEQDataCon\npromotedGTDataCon     = promoteDataCon ordGTDataCon\n\n-- Promoted List\npromotedConsDataCon, promotedNilDataCon :: TyCon\npromotedConsDataCon   = promoteDataCon consDataCon\npromotedNilDataCon    = promoteDataCon nilDataCon\n\n-- | Make a *promoted* list.\nmkPromotedListTy :: Kind   -- ^ of the elements of the list\n                 -> [Type] -- ^ elements\n                 -> Type\nmkPromotedListTy k tys\n  = foldr cons nil tys\n  where\n    cons :: Type  -- element\n         -> Type  -- list\n         -> Type\n    cons elt list = mkTyConApp promotedConsDataCon [k, elt, list]\n\n    nil :: Type\n    nil = mkTyConApp promotedNilDataCon [k]\n\n-- | Extract the elements of a promoted list. Panics if the type is not a\n-- promoted list\nextractPromotedList :: Type    -- ^ The promoted list\n                    -> [Type]\nextractPromotedList tys = go tys\n  where\n    go list_ty\n      | Just (tc, [_k, t, ts]) <- splitTyConApp_maybe list_ty\n      = ASSERT( tc `hasKey` consDataConKey )\n        t : go ts\n\n      | Just (tc, [_k]) <- splitTyConApp_maybe list_ty\n      = ASSERT( tc `hasKey` nilDataConKey )\n        []\n\n      | otherwise\n      = pprPanic \"extractPromotedList\" (ppr tys)\n", "num_lines": 1628}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nmodule CostCentre (\n        CostCentre(..), CcName, CCFlavour(..),\n                -- All abstract except to friend: ParseIface.y\n\n        CostCentreStack,\n        CollectedCCs, emptyCollectedCCs, collectCC,\n        currentCCS, dontCareCCS,\n        isCurrentCCS,\n        maybeSingletonCCS,\n\n        mkUserCC, mkAutoCC, mkAllCafsCC,\n        mkSingletonCCS,\n        isCafCCS, isCafCC, isSccCountCC, sccAbleCC, ccFromThisModule,\n\n        pprCostCentreCore,\n        costCentreUserName, costCentreUserNameFS,\n        costCentreSrcSpan,\n\n        cmpCostCentre   -- used for removing dups in a list\n    ) where\n\nimport GhcPrelude\n\nimport Binary\nimport Var\nimport Name\nimport Module\nimport Unique\nimport Outputable\nimport SrcLoc\nimport FastString\nimport Util\nimport CostCentreState\n\nimport Data.Data\n\n-----------------------------------------------------------------------------\n-- Cost Centres\n\n-- | A Cost Centre is a single @{-# SCC #-}@ annotation.\n\ndata CostCentre\n  = NormalCC {\n                cc_flavour  :: CCFlavour,\n                 -- ^ Two cost centres may have the same name and\n                 -- module but different SrcSpans, so we need a way to\n                 -- distinguish them easily and give them different\n                 -- object-code labels.  So every CostCentre has an\n                 -- associated flavour that indicates how it was\n                 -- generated, and flavours that allow multiple instances\n                 -- of the same name and module have a deterministic 0-based\n                 -- index.\n                cc_name :: CcName,      -- ^ Name of the cost centre itself\n                cc_mod  :: Module,      -- ^ Name of module defining this CC.\n                cc_loc  :: SrcSpan\n    }\n\n  | AllCafsCC {\n                cc_mod  :: Module,      -- Name of module defining this CC.\n                cc_loc  :: SrcSpan\n    }\n  deriving Data\n\ntype CcName = FastString\n\n-- | The flavour of a cost centre.\n--\n-- Index fields represent 0-based indices giving source-code ordering of\n-- centres with the same module, name, and flavour.\ndata CCFlavour = CafCC -- ^ Auto-generated top-level thunk\n               | ExprCC !CostCentreIndex -- ^ Explicitly annotated expression\n               | DeclCC !CostCentreIndex -- ^ Explicitly annotated declaration\n               | HpcCC !CostCentreIndex -- ^ Generated by HPC for coverage\n               deriving (Eq, Ord, Data)\n\n-- | Extract the index from a flavour\nflavourIndex :: CCFlavour -> Int\nflavourIndex CafCC = 0\nflavourIndex (ExprCC x) = unCostCentreIndex x\nflavourIndex (DeclCC x) = unCostCentreIndex x\nflavourIndex (HpcCC x) = unCostCentreIndex x\n\ninstance Eq CostCentre where\n        c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False }\n\ninstance Ord CostCentre where\n        compare = cmpCostCentre\n\ncmpCostCentre :: CostCentre -> CostCentre -> Ordering\n\ncmpCostCentre (AllCafsCC  {cc_mod = m1}) (AllCafsCC  {cc_mod = m2})\n  = m1 `compare` m2\n\ncmpCostCentre NormalCC {cc_flavour = f1, cc_mod =  m1, cc_name = n1}\n              NormalCC {cc_flavour = f2, cc_mod =  m2, cc_name = n2}\n    -- first key is module name, then centre name, then flavour\n  = (m1 `compare` m2) `thenCmp` (n1 `compare` n2) `thenCmp` (f1 `compare` f2)\n\ncmpCostCentre other_1 other_2\n  = let\n        tag1 = tag_CC other_1\n        tag2 = tag_CC other_2\n    in\n    if tag1 < tag2 then LT else GT\n  where\n    tag_CC :: CostCentre -> Int\n    tag_CC (NormalCC   {}) = 0\n    tag_CC (AllCafsCC  {}) = 1\n\n\n-----------------------------------------------------------------------------\n-- Predicates on CostCentre\n\nisCafCC :: CostCentre -> Bool\nisCafCC (AllCafsCC {})                  = True\nisCafCC (NormalCC {cc_flavour = CafCC}) = True\nisCafCC _                               = False\n\n-- | Is this a cost-centre which records scc counts\nisSccCountCC :: CostCentre -> Bool\nisSccCountCC cc | isCafCC cc  = False\n                | otherwise   = True\n\n-- | Is this a cost-centre which can be sccd ?\nsccAbleCC :: CostCentre -> Bool\nsccAbleCC cc | isCafCC cc = False\n             | otherwise  = True\n\nccFromThisModule :: CostCentre -> Module -> Bool\nccFromThisModule cc m = cc_mod cc == m\n\n\n-----------------------------------------------------------------------------\n-- Building cost centres\n\nmkUserCC :: FastString -> Module -> SrcSpan -> CCFlavour -> CostCentre\nmkUserCC cc_name mod loc flavour\n  = NormalCC { cc_name = cc_name, cc_mod =  mod, cc_loc = loc,\n               cc_flavour = flavour\n    }\n\nmkAutoCC :: Id -> Module -> CostCentre\nmkAutoCC id mod\n  = NormalCC { cc_name = str, cc_mod =  mod,\n               cc_loc = nameSrcSpan (getName id),\n               cc_flavour = CafCC\n    }\n  where\n        name = getName id\n        -- beware: only external names are guaranteed to have unique\n        -- Occnames.  If the name is not external, we must append its\n        -- Unique.\n        -- See bug #249, tests prof001, prof002,  also #2411\n        str | isExternalName name = occNameFS (getOccName id)\n            | otherwise           = occNameFS (getOccName id)\n                                    `appendFS`\n                                    mkFastString ('_' : show (getUnique name))\nmkAllCafsCC :: Module -> SrcSpan -> CostCentre\nmkAllCafsCC m loc = AllCafsCC { cc_mod = m, cc_loc = loc }\n\n-----------------------------------------------------------------------------\n-- Cost Centre Stacks\n\n-- | A Cost Centre Stack is something that can be attached to a closure.\n-- This is either:\n--\n--      * the current cost centre stack (CCCS)\n--      * a pre-defined cost centre stack (there are several\n--        pre-defined CCSs, see below).\n\ndata CostCentreStack\n  = CurrentCCS          -- Pinned on a let(rec)-bound\n                        -- thunk/function/constructor, this says that the\n                        -- cost centre to be attached to the object, when it\n                        -- is allocated, is whatever is in the\n                        -- current-cost-centre-stack register.\n\n  | DontCareCCS         -- We need a CCS to stick in static closures\n                        -- (for data), but we *don't* expect them to\n                        -- accumulate any costs.  But we still need\n                        -- the placeholder.  This CCS is it.\n\n  | SingletonCCS CostCentre\n\n  deriving (Eq, Ord)    -- needed for Ord on CLabel\n\n\n-- synonym for triple which describes the cost centre info in the generated\n-- code for a module.\ntype CollectedCCs\n  = ( [CostCentre]       -- local cost-centres that need to be decl'd\n    , [CostCentreStack]  -- pre-defined \"singleton\" cost centre stacks\n    )\n\nemptyCollectedCCs :: CollectedCCs\nemptyCollectedCCs = ([], [])\n\ncollectCC :: CostCentre -> CostCentreStack -> CollectedCCs -> CollectedCCs\ncollectCC cc ccs (c, cs) = (cc : c, ccs : cs)\n\ncurrentCCS, dontCareCCS :: CostCentreStack\n\ncurrentCCS              = CurrentCCS\ndontCareCCS             = DontCareCCS\n\n-----------------------------------------------------------------------------\n-- Predicates on Cost-Centre Stacks\n\nisCurrentCCS :: CostCentreStack -> Bool\nisCurrentCCS CurrentCCS                 = True\nisCurrentCCS _                          = False\n\nisCafCCS :: CostCentreStack -> Bool\nisCafCCS (SingletonCCS cc)              = isCafCC cc\nisCafCCS _                              = False\n\nmaybeSingletonCCS :: CostCentreStack -> Maybe CostCentre\nmaybeSingletonCCS (SingletonCCS cc)     = Just cc\nmaybeSingletonCCS _                     = Nothing\n\nmkSingletonCCS :: CostCentre -> CostCentreStack\nmkSingletonCCS cc = SingletonCCS cc\n\n\n-----------------------------------------------------------------------------\n-- Printing Cost Centre Stacks.\n\n-- The outputable instance for CostCentreStack prints the CCS as a C\n-- expression.\n\ninstance Outputable CostCentreStack where\n  ppr CurrentCCS        = text \"CCCS\"\n  ppr DontCareCCS       = text \"CCS_DONT_CARE\"\n  ppr (SingletonCCS cc) = ppr cc <> text \"_ccs\"\n\n\n-----------------------------------------------------------------------------\n-- Printing Cost Centres\n--\n-- There are several different ways in which we might want to print a\n-- cost centre:\n--\n--      - the name of the cost centre, for profiling output (a C string)\n--      - the label, i.e. C label for cost centre in .hc file.\n--      - the debugging name, for output in -ddump things\n--      - the interface name, for printing in _scc_ exprs in iface files.\n--\n-- The last 3 are derived from costCentreStr below.  The first is given\n-- by costCentreName.\n\ninstance Outputable CostCentre where\n  ppr cc = getPprStyle $ \\ sty ->\n           if codeStyle sty\n           then ppCostCentreLbl cc\n           else text (costCentreUserName cc)\n\n-- Printing in Core\npprCostCentreCore :: CostCentre -> SDoc\npprCostCentreCore (AllCafsCC {cc_mod = m})\n  = text \"__sccC\" <+> braces (ppr m)\npprCostCentreCore (NormalCC {cc_flavour = flavour, cc_name = n,\n                             cc_mod = m, cc_loc = loc})\n  = text \"__scc\" <+> braces (hsep [\n        ppr m <> char '.' <> ftext n,\n        pprFlavourCore flavour,\n        whenPprDebug (ppr loc)\n    ])\n\n-- ^ Print a flavour in Core\npprFlavourCore :: CCFlavour -> SDoc\npprFlavourCore CafCC = text \"__C\"\npprFlavourCore f     = pprIdxCore $ flavourIndex f\n\n-- ^ Print a flavour's index in Core\npprIdxCore :: Int -> SDoc\npprIdxCore 0 = empty\npprIdxCore idx = whenPprDebug $ ppr idx\n\n-- Printing as a C label\nppCostCentreLbl :: CostCentre -> SDoc\nppCostCentreLbl (AllCafsCC  {cc_mod = m}) = ppr m <> text \"_CAFs_cc\"\nppCostCentreLbl (NormalCC {cc_flavour = f, cc_name = n, cc_mod = m})\n  = ppr m <> char '_' <> ztext (zEncodeFS n) <> char '_' <>\n        ppFlavourLblComponent f <> text \"_cc\"\n\n-- ^ Print the flavour component of a C label\nppFlavourLblComponent :: CCFlavour -> SDoc\nppFlavourLblComponent CafCC = text \"CAF\"\nppFlavourLblComponent (ExprCC i) = text \"EXPR\" <> ppIdxLblComponent i\nppFlavourLblComponent (DeclCC i) = text \"DECL\" <> ppIdxLblComponent i\nppFlavourLblComponent (HpcCC i) = text \"HPC\" <> ppIdxLblComponent i\n\n-- ^ Print the flavour index component of a C label\nppIdxLblComponent :: CostCentreIndex -> SDoc\nppIdxLblComponent n =\n  case unCostCentreIndex n of\n    0 -> empty\n    n -> ppr n\n\n-- This is the name to go in the user-displayed string,\n-- recorded in the cost centre declaration\ncostCentreUserName :: CostCentre -> String\ncostCentreUserName = unpackFS . costCentreUserNameFS\n\ncostCentreUserNameFS :: CostCentre -> FastString\ncostCentreUserNameFS (AllCafsCC {})  = mkFastString \"CAF\"\ncostCentreUserNameFS (NormalCC {cc_name = name, cc_flavour = is_caf})\n  =  case is_caf of\n      CafCC -> mkFastString \"CAF:\" `appendFS` name\n      _     -> name\n\ncostCentreSrcSpan :: CostCentre -> SrcSpan\ncostCentreSrcSpan = cc_loc\n\ninstance Binary CCFlavour where\n    put_ bh CafCC = do\n            putByte bh 0\n    put_ bh (ExprCC i) = do\n            putByte bh 1\n            put_ bh i\n    put_ bh (DeclCC i) = do\n            putByte bh 2\n            put_ bh i\n    put_ bh (HpcCC i) = do\n            putByte bh 3\n            put_ bh i\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return CafCC\n              1 -> ExprCC <$> get bh\n              2 -> DeclCC <$> get bh\n              _ -> HpcCC <$> get bh\n\ninstance Binary CostCentre where\n    put_ bh (NormalCC aa ab ac _ad) = do\n            putByte bh 0\n            put_ bh aa\n            put_ bh ab\n            put_ bh ac\n    put_ bh (AllCafsCC ae _af) = do\n            putByte bh 1\n            put_ bh ae\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do aa <- get bh\n                      ab <- get bh\n                      ac <- get bh\n                      return (NormalCC aa ab ac noSrcSpan)\n              _ -> do ae <- get bh\n                      return (AllCafsCC ae noSrcSpan)\n\n    -- We ignore the SrcSpans in CostCentres when we serialise them,\n    -- and set the SrcSpans to noSrcSpan when deserialising.  This is\n    -- ok, because we only need the SrcSpan when declaring the\n    -- CostCentre in the original module, it is not used by importing\n    -- modules.\n", "num_lines": 360}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\nmodule CostCentreState ( CostCentreState, newCostCentreState\n                       , CostCentreIndex, unCostCentreIndex, getCCIndex\n                       ) where\n\nimport GhcPrelude\nimport FastString\nimport FastStringEnv\n\nimport Data.Data\nimport Binary\n\n-- | Per-module state for tracking cost centre indices.\n--\n-- See documentation of 'CostCentre.cc_flavour' for more details.\nnewtype CostCentreState = CostCentreState (FastStringEnv Int)\n\n-- | Initialize cost centre state.\nnewCostCentreState :: CostCentreState\nnewCostCentreState = CostCentreState emptyFsEnv\n\n-- | An index into a given cost centre module,name,flavour set\nnewtype CostCentreIndex = CostCentreIndex { unCostCentreIndex :: Int }\n  deriving (Eq, Ord, Data, Binary)\n\n-- | Get a new index for a given cost centre name.\ngetCCIndex :: FastString\n           -> CostCentreState\n           -> (CostCentreIndex, CostCentreState)\ngetCCIndex nm (CostCentreState m) =\n    (CostCentreIndex idx, CostCentreState m')\n  where\n    m_idx = lookupFsEnv m nm\n    idx = maybe 0 id m_idx\n    m' = extendFsEnv m nm (idx + 1)\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 2011\n--\n-- Generate code to initialise cost centres\n--\n-- -----------------------------------------------------------------------------\n\nmodule ProfInit (profilingInitCode) where\n\nimport GhcPrelude\n\nimport CLabel\nimport CostCentre\nimport DynFlags\nimport Outputable\nimport Module\n\n-- -----------------------------------------------------------------------------\n-- Initialising cost centres\n\n-- We must produce declarations for the cost-centres defined in this\n-- module;\n\nprofilingInitCode :: Module -> CollectedCCs -> SDoc\nprofilingInitCode this_mod (local_CCs, singleton_CCSs)\n = sdocWithDynFlags $ \\dflags ->\n   if not (gopt Opt_SccProfilingOn dflags)\n   then empty\n   else vcat\n    $  map emit_cc_decl local_CCs\n    ++ map emit_ccs_decl singleton_CCSs\n    ++ [emit_cc_list local_CCs]\n    ++ [emit_ccs_list singleton_CCSs]\n    ++ [ text \"static void prof_init_\" <> ppr this_mod\n            <> text \"(void) __attribute__((constructor));\"\n       , text \"static void prof_init_\" <> ppr this_mod <> text \"(void)\"\n       , braces (vcat\n                 [ text \"registerCcList\" <> parens local_cc_list_label <> semi\n                 , text \"registerCcsList\" <> parens singleton_cc_list_label <> semi\n                 ])\n       ]\n where\n   emit_cc_decl cc =\n       text \"extern CostCentre\" <+> cc_lbl <> text \"[];\"\n     where cc_lbl = ppr (mkCCLabel cc)\n   local_cc_list_label = text \"local_cc_\" <> ppr this_mod\n   emit_cc_list ccs =\n      text \"static CostCentre *\" <> local_cc_list_label <> text \"[] =\"\n      <+> braces (vcat $ [ ppr (mkCCLabel cc) <> comma\n                         | cc <- ccs\n                         ] ++ [text \"NULL\"])\n      <> semi\n\n   emit_ccs_decl ccs =\n       text \"extern CostCentreStack\" <+> ccs_lbl <> text \"[];\"\n     where ccs_lbl = ppr (mkCCSLabel ccs)\n   singleton_cc_list_label = text \"singleton_cc_\" <> ppr this_mod\n   emit_ccs_list ccs =\n      text \"static CostCentreStack *\" <> singleton_cc_list_label <> text \"[] =\"\n      <+> braces (vcat $ [ ppr (mkCCSLabel cc) <> comma\n                         | cc <- ccs\n                         ] ++ [text \"NULL\"])\n      <> semi\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\n{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[RnBinds]{Renaming and dependency analysis of bindings}\n\nThis module does renaming and dependency analysis on value bindings in\nthe abstract syntax.  It does {\\em not} do cycle-checks on class or\ntype-synonym declarations; those cannot be done at this stage because\nthey may be affected by renaming (which isn't fully worked out yet).\n-}\n\nmodule RnBinds (\n   -- Renaming top-level bindings\n   rnTopBindsLHS, rnTopBindsBoot, rnValBindsRHS,\n\n   -- Renaming local bindings\n   rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,\n\n   -- Other bindings\n   rnMethodBinds, renameSigs,\n   rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl,\n   makeMiniFixityEnv, MiniFixityEnv,\n   HsSigCtxt(..)\n   ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )\n\nimport HsSyn\nimport TcRnMonad\nimport RnTypes\nimport RnPat\nimport RnNames\nimport RnEnv\nimport RnFixity\nimport RnUtils          ( HsDocContext(..), mapFvRn, extendTyVarEnvFVRn\n                        , checkDupRdrNames, warnUnusedLocalBinds,\n                        checkUnusedRecordWildcard\n                        , checkDupAndShadowedNames, bindLocalNamesFV )\nimport DynFlags\nimport Module\nimport Name\nimport NameEnv\nimport NameSet\nimport RdrName          ( RdrName, rdrNameOcc )\nimport SrcLoc\nimport ListSetOps       ( findDupsEq )\nimport BasicTypes       ( RecFlag(..) )\nimport Digraph          ( SCC(..) )\nimport Bag\nimport Util\nimport Outputable\nimport UniqSet\nimport Maybes           ( orElse )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Data.Foldable      ( toList )\nimport Data.List          ( partition, sort )\nimport Data.List.NonEmpty ( NonEmpty(..) )\n\n{-\n-- ToDo: Put the annotations into the monad, so that they arrive in the proper\n-- place and can be used when complaining.\n\nThe code tree received by the function @rnBinds@ contains definitions\nin where-clauses which are all apparently mutually recursive, but which may\nnot really depend upon each other. For example, in the top level program\n\\begin{verbatim}\nf x = y where a = x\n              y = x\n\\end{verbatim}\nthe definitions of @a@ and @y@ do not depend on each other at all.\nUnfortunately, the typechecker cannot always check such definitions.\n\\footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive\ndefinitions. In Proceedings of the International Symposium on Programming,\nToulouse, pp. 217-39. LNCS 167. Springer Verlag.}\nHowever, the typechecker usually can check definitions in which only the\nstrongly connected components have been collected into recursive bindings.\nThis is precisely what the function @rnBinds@ does.\n\nToDo: deal with case where a single monobinds binds the same variable\ntwice.\n\nThe vertag tag is a unique @Int@; the tags only need to be unique\nwithin one @MonoBinds@, so that unique-Int plumbing is done explicitly\n(heavy monad machinery not needed).\n\n\n************************************************************************\n*                                                                      *\n* naming conventions                                                   *\n*                                                                      *\n************************************************************************\n\n\\subsection[name-conventions]{Name conventions}\n\nThe basic algorithm involves walking over the tree and returning a tuple\ncontaining the new tree plus its free variables. Some functions, such\nas those walking polymorphic bindings (HsBinds) and qualifier lists in\nlist comprehensions (@Quals@), return the variables bound in local\nenvironments. These are then used to calculate the free variables of the\nexpression evaluated in these environments.\n\nConventions for variable names are as follows:\n\\begin{itemize}\n\\item\nnew code is given a prime to distinguish it from the old.\n\n\\item\na set of variables defined in @Exp@ is written @dvExp@\n\n\\item\na set of variables free in @Exp@ is written @fvExp@\n\\end{itemize}\n\n************************************************************************\n*                                                                      *\n* analysing polymorphic bindings (HsBindGroup, HsBind)\n*                                                                      *\n************************************************************************\n\n\\subsubsection[dep-HsBinds]{Polymorphic bindings}\n\nNon-recursive expressions are reconstructed without any changes at top\nlevel, although their component expressions may have to be altered.\nHowever, non-recursive expressions are currently not expected as\n\\Haskell{} programs, and this code should not be executed.\n\nMonomorphic bindings contain information that is returned in a tuple\n(a @FlatMonoBinds@) containing:\n\n\\begin{enumerate}\n\\item\na unique @Int@ that serves as the ``vertex tag'' for this binding.\n\n\\item\nthe name of a function or the names in a pattern. These are a set\nreferred to as @dvLhs@, the defined variables of the left hand side.\n\n\\item\nthe free variables of the body. These are referred to as @fvBody@.\n\n\\item\nthe definition's actual code. This is referred to as just @code@.\n\\end{enumerate}\n\nThe function @nonRecDvFv@ returns two sets of variables. The first is\nthe set of variables defined in the set of monomorphic bindings, while the\nsecond is the set of free variables in those bindings.\n\nThe set of variables defined in a non-recursive binding is just the\nunion of all of them, as @union@ removes duplicates. However, the\nfree variables in each successive set of cumulative bindings is the\nunion of those in the previous set plus those of the newest binding after\nthe defined variables of the previous set have been removed.\n\n@rnMethodBinds@ deals only with the declarations in class and\ninstance declarations.  It expects only to see @FunMonoBind@s, and\nit expects the global environment to contain bindings for the binders\n(which are all class operations).\n\n************************************************************************\n*                                                                      *\n\\subsubsection{ Top-level bindings}\n*                                                                      *\n************************************************************************\n-}\n\n-- for top-level bindings, we need to make top-level names,\n-- so we have a different entry point than for local bindings\nrnTopBindsLHS :: MiniFixityEnv\n              -> HsValBinds GhcPs\n              -> RnM (HsValBindsLR GhcRn GhcPs)\nrnTopBindsLHS fix_env binds\n  = rnValBindsLHS (topRecNameMaker fix_env) binds\n\nrnTopBindsBoot :: NameSet -> HsValBindsLR GhcRn GhcPs\n               -> RnM (HsValBinds GhcRn, DefUses)\n-- A hs-boot file has no bindings.\n-- Return a single HsBindGroup with empty binds and renamed signatures\nrnTopBindsBoot bound_names (ValBinds _ mbinds sigs)\n  = do  { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)\n        ; (sigs', fvs) <- renameSigs (HsBootCtxt bound_names) sigs\n        ; return (XValBindsLR (NValBinds [] sigs'), usesOnly fvs) }\nrnTopBindsBoot _ b = pprPanic \"rnTopBindsBoot\" (ppr b)\n\n{-\n*********************************************************\n*                                                      *\n                HsLocalBinds\n*                                                      *\n*********************************************************\n-}\n\nrnLocalBindsAndThen :: HsLocalBinds GhcPs\n                   -> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))\n                   -> RnM (result, FreeVars)\n-- This version (a) assumes that the binding vars are *not* already in scope\n--               (b) removes the binders from the free vars of the thing inside\n-- The parser doesn't produce ThenBinds\nrnLocalBindsAndThen (EmptyLocalBinds x) thing_inside =\n  thing_inside (EmptyLocalBinds x) emptyNameSet\n\nrnLocalBindsAndThen (HsValBinds x val_binds) thing_inside\n  = rnLocalValBindsAndThen val_binds $ \\ val_binds' ->\n      thing_inside (HsValBinds x val_binds')\n\nrnLocalBindsAndThen (HsIPBinds x binds) thing_inside = do\n    (binds',fv_binds) <- rnIPBinds binds\n    (thing, fvs_thing) <- thing_inside (HsIPBinds x binds') fv_binds\n    return (thing, fvs_thing `plusFV` fv_binds)\n\nrnLocalBindsAndThen (XHsLocalBindsLR _) _ = panic \"rnLocalBindsAndThen\"\n\nrnIPBinds :: HsIPBinds GhcPs -> RnM (HsIPBinds GhcRn, FreeVars)\nrnIPBinds (IPBinds _ ip_binds ) = do\n    (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds\n    return (IPBinds noExt ip_binds', plusFVs fvs_s)\nrnIPBinds (XHsIPBinds _) = panic \"rnIPBinds\"\n\nrnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars)\nrnIPBind (IPBind _ ~(Left n) expr) = do\n    (expr',fvExpr) <- rnLExpr expr\n    return (IPBind noExt (Left n) expr', fvExpr)\nrnIPBind (XIPBind _) = panic \"rnIPBind\"\n\n{-\n************************************************************************\n*                                                                      *\n                ValBinds\n*                                                                      *\n************************************************************************\n-}\n\n-- Renaming local binding groups\n-- Does duplicate/shadow check\nrnLocalValBindsLHS :: MiniFixityEnv\n                   -> HsValBinds GhcPs\n                   -> RnM ([Name], HsValBindsLR GhcRn GhcPs)\nrnLocalValBindsLHS fix_env binds\n  = do { binds' <- rnValBindsLHS (localRecNameMaker fix_env) binds\n\n         -- Check for duplicates and shadowing\n         -- Must do this *after* renaming the patterns\n         -- See Note [Collect binders only after renaming] in HsUtils\n\n         -- We need to check for dups here because we\n         -- don't don't bind all of the variables from the ValBinds at once\n         -- with bindLocatedLocals any more.\n         --\n         -- Note that we don't want to do this at the top level, since\n         -- sorting out duplicates and shadowing there happens elsewhere.\n         -- The behavior is even different. For example,\n         --   import A(f)\n         --   f = ...\n         -- should not produce a shadowing warning (but it will produce\n         -- an ambiguity warning if you use f), but\n         --   import A(f)\n         --   g = let f = ... in f\n         -- should.\n       ; let bound_names = collectHsValBinders binds'\n             -- There should be only Ids, but if there are any bogus\n             -- pattern synonyms, we'll collect them anyway, so that\n             -- we don't generate subsequent out-of-scope messages\n       ; envs <- getRdrEnvs\n       ; checkDupAndShadowedNames envs bound_names\n\n       ; return (bound_names, binds') }\n\n-- renames the left-hand sides\n-- generic version used both at the top level and for local binds\n-- does some error checking, but not what gets done elsewhere at the top level\nrnValBindsLHS :: NameMaker\n              -> HsValBinds GhcPs\n              -> RnM (HsValBindsLR GhcRn GhcPs)\nrnValBindsLHS topP (ValBinds x mbinds sigs)\n  = do { mbinds' <- mapBagM (wrapLocM (rnBindLHS topP doc)) mbinds\n       ; return $ ValBinds x mbinds' sigs }\n  where\n    bndrs = collectHsBindsBinders mbinds\n    doc   = text \"In the binding group for:\" <+> pprWithCommas ppr bndrs\n\nrnValBindsLHS _ b = pprPanic \"rnValBindsLHSFromDoc\" (ppr b)\n\n-- General version used both from the top-level and for local things\n-- Assumes the LHS vars are in scope\n--\n-- Does not bind the local fixity declarations\nrnValBindsRHS :: HsSigCtxt\n              -> HsValBindsLR GhcRn GhcPs\n              -> RnM (HsValBinds GhcRn, DefUses)\n\nrnValBindsRHS ctxt (ValBinds _ mbinds sigs)\n  = do { (sigs', sig_fvs) <- renameSigs ctxt sigs\n       ; binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn sigs')) mbinds\n       ; let !(anal_binds, anal_dus) = depAnalBinds binds_w_dus\n\n       ; let patsyn_fvs = foldr (unionNameSet . psb_ext) emptyNameSet $\n                          getPatSynBinds anal_binds\n                -- The uses in binds_w_dus for PatSynBinds do not include\n                -- variables used in the patsyn builders; see\n                -- Note [Pattern synonym builders don't yield dependencies]\n                -- But psb_fvs /does/ include those builder fvs.  So we\n                -- add them back in here to avoid bogus warnings about\n                -- unused variables (Trac #12548)\n\n             valbind'_dus = anal_dus `plusDU` usesOnly sig_fvs\n                                     `plusDU` usesOnly patsyn_fvs\n                            -- Put the sig uses *after* the bindings\n                            -- so that the binders are removed from\n                            -- the uses in the sigs\n\n        ; return (XValBindsLR (NValBinds anal_binds sigs'), valbind'_dus) }\n\nrnValBindsRHS _ b = pprPanic \"rnValBindsRHS\" (ppr b)\n\n-- Wrapper for local binds\n--\n-- The *client* of this function is responsible for checking for unused binders;\n-- it doesn't (and can't: we don't have the thing inside the binds) happen here\n--\n-- The client is also responsible for bringing the fixities into scope\nrnLocalValBindsRHS :: NameSet  -- names bound by the LHSes\n                   -> HsValBindsLR GhcRn GhcPs\n                   -> RnM (HsValBinds GhcRn, DefUses)\nrnLocalValBindsRHS bound_names binds\n  = rnValBindsRHS (LocalBindCtxt bound_names) binds\n\n-- for local binds\n-- wrapper that does both the left- and right-hand sides\n--\n-- here there are no local fixity decls passed in;\n-- the local fixity decls come from the ValBinds sigs\nrnLocalValBindsAndThen\n  :: HsValBinds GhcPs\n  -> (HsValBinds GhcRn -> FreeVars -> RnM (result, FreeVars))\n  -> RnM (result, FreeVars)\nrnLocalValBindsAndThen binds@(ValBinds _ _ sigs) thing_inside\n = do   {     -- (A) Create the local fixity environment\n          new_fixities <- makeMiniFixityEnv [ L loc sig\n                                            | L loc (FixSig _ sig) <- sigs]\n\n              -- (B) Rename the LHSes\n        ; (bound_names, new_lhs) <- rnLocalValBindsLHS new_fixities binds\n\n              --     ...and bring them (and their fixities) into scope\n        ; bindLocalNamesFV bound_names              $\n          addLocalFixities new_fixities bound_names $ do\n\n        {      -- (C) Do the RHS and thing inside\n          (binds', dus) <- rnLocalValBindsRHS (mkNameSet bound_names) new_lhs\n        ; (result, result_fvs) <- thing_inside binds' (allUses dus)\n\n                -- Report unused bindings based on the (accurate)\n                -- findUses.  E.g.\n                --      let x = x in 3\n                -- should report 'x' unused\n        ; let real_uses = findUses dus result_fvs\n              -- Insert fake uses for variables introduced implicitly by\n              -- wildcards (#4404)\n              rec_uses = hsValBindsImplicits binds'\n              implicit_uses = mkNameSet $ concatMap snd\n                                        $ rec_uses\n        ; mapM_ (\\(loc, ns) ->\n                    checkUnusedRecordWildcard loc real_uses (Just ns))\n                rec_uses\n        ; warnUnusedLocalBinds bound_names\n                                      (real_uses `unionNameSet` implicit_uses)\n\n        ; let\n            -- The variables \"used\" in the val binds are:\n            --   (1) the uses of the binds (allUses)\n            --   (2) the FVs of the thing-inside\n            all_uses = allUses dus `plusFV` result_fvs\n                -- Note [Unused binding hack]\n                -- ~~~~~~~~~~~~~~~~~~~~~~~~~~\n                -- Note that *in contrast* to the above reporting of\n                -- unused bindings, (1) above uses duUses to return *all*\n                -- the uses, even if the binding is unused.  Otherwise consider:\n                --      x = 3\n                --      y = let p = x in 'x'    -- NB: p not used\n                -- If we don't \"see\" the dependency of 'y' on 'x', we may put the\n                -- bindings in the wrong order, and the type checker will complain\n                -- that x isn't in scope\n                --\n                -- But note that this means we won't report 'x' as unused,\n                -- whereas we would if we had { x = 3; p = x; y = 'x' }\n\n        ; return (result, all_uses) }}\n                -- The bound names are pruned out of all_uses\n                -- by the bindLocalNamesFV call above\n\nrnLocalValBindsAndThen bs _ = pprPanic \"rnLocalValBindsAndThen\" (ppr bs)\n\n\n---------------------\n\n-- renaming a single bind\n\nrnBindLHS :: NameMaker\n          -> SDoc\n          -> HsBind GhcPs\n          -- returns the renamed left-hand side,\n          -- and the FreeVars *of the LHS*\n          -- (i.e., any free variables of the pattern)\n          -> RnM (HsBindLR GhcRn GhcPs)\n\nrnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat })\n  = do\n      -- we don't actually use the FV processing of rnPatsAndThen here\n      (pat',pat'_fvs) <- rnBindPat name_maker pat\n      return (bind { pat_lhs = pat', pat_ext = pat'_fvs })\n                -- We temporarily store the pat's FVs in bind_fvs;\n                -- gets updated to the FVs of the whole bind\n                -- when doing the RHS below\n\nrnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name })\n  = do { name <- applyNameMaker name_maker rdr_name\n       ; return (bind { fun_id = name\n                      , fun_ext = noExt }) }\n\nrnBindLHS name_maker _ (PatSynBind x psb@PSB{ psb_id = rdrname })\n  | isTopRecNameMaker name_maker\n  = do { addLocM checkConName rdrname\n       ; name <- lookupLocatedTopBndrRn rdrname   -- Should be in scope already\n       ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) }\n\n  | otherwise  -- Pattern synonym, not at top level\n  = do { addErr localPatternSynonymErr  -- Complain, but make up a fake\n                                        -- name so that we can carry on\n       ; name <- applyNameMaker name_maker rdrname\n       ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) }\n  where\n    localPatternSynonymErr :: SDoc\n    localPatternSynonymErr\n      = hang (text \"Illegal pattern synonym declaration for\" <+> quotes (ppr rdrname))\n           2 (text \"Pattern synonym declarations are only valid at top level\")\n\nrnBindLHS _ _ b = pprPanic \"rnBindHS\" (ppr b)\n\nrnLBind :: (Name -> [Name])      -- Signature tyvar function\n        -> LHsBindLR GhcRn GhcPs\n        -> RnM (LHsBind GhcRn, [Name], Uses)\nrnLBind sig_fn (L loc bind)\n  = setSrcSpan loc $\n    do { (bind', bndrs, dus) <- rnBind sig_fn bind\n       ; return (L loc bind', bndrs, dus) }\n\n-- assumes the left-hands-side vars are in scope\nrnBind :: (Name -> [Name])        -- Signature tyvar function\n       -> HsBindLR GhcRn GhcPs\n       -> RnM (HsBind GhcRn, [Name], Uses)\nrnBind _ bind@(PatBind { pat_lhs = pat\n                       , pat_rhs = grhss\n                                   -- pat fvs were stored in bind_fvs\n                                   -- after processing the LHS\n                       , pat_ext = pat_fvs })\n  = do  { mod <- getModule\n        ; (grhss', rhs_fvs) <- rnGRHSs PatBindRhs rnLExpr grhss\n\n                -- No scoped type variables for pattern bindings\n        ; let all_fvs = pat_fvs `plusFV` rhs_fvs\n              fvs'    = filterNameSet (nameIsLocalOrFrom mod) all_fvs\n                -- Keep locally-defined Names\n                -- As well as dependency analysis, we need these for the\n                -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan\n              bndrs = collectPatBinders pat\n              bind' = bind { pat_rhs  = grhss'\n                           , pat_ext = fvs' }\n\n              ok_nobind_pat\n                  = -- See Note [Pattern bindings that bind no variables]\n                    case unLoc pat of\n                       WildPat {}   -> True\n                       BangPat {}   -> True -- #9127, #13646\n                       SplicePat {} -> True\n                       _            -> False\n\n        -- Warn if the pattern binds no variables\n        -- See Note [Pattern bindings that bind no variables]\n        ; whenWOptM Opt_WarnUnusedPatternBinds $\n          when (null bndrs && not ok_nobind_pat) $\n          addWarn (Reason Opt_WarnUnusedPatternBinds) $\n          unusedPatBindWarn bind'\n\n        ; fvs' `seq` -- See Note [Free-variable space leak]\n          return (bind', bndrs, all_fvs) }\n\nrnBind sig_fn bind@(FunBind { fun_id = name\n                            , fun_matches = matches })\n       -- invariant: no free vars here when it's a FunBind\n  = do  { let plain_name = unLoc name\n\n        ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $\n                                -- bindSigTyVars tests for LangExt.ScopedTyVars\n                                 rnMatchGroup (mkPrefixFunRhs name)\n                                              rnLExpr matches\n        ; let is_infix = isInfixFunBind bind\n        ; when is_infix $ checkPrecMatch plain_name matches'\n\n        ; mod <- getModule\n        ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) rhs_fvs\n                -- Keep locally-defined Names\n                -- As well as dependency analysis, we need these for the\n                -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan\n\n        ; fvs' `seq` -- See Note [Free-variable space leak]\n          return (bind { fun_matches = matches'\n                       , fun_ext     = fvs' },\n                  [plain_name], rhs_fvs)\n      }\n\nrnBind sig_fn (PatSynBind x bind)\n  = do  { (bind', name, fvs) <- rnPatSynBind sig_fn bind\n        ; return (PatSynBind x bind', name, fvs) }\n\nrnBind _ b = pprPanic \"rnBind\" (ppr b)\n\n{- Note [Pattern bindings that bind no variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGenerally, we want to warn about pattern bindings like\n  Just _ = e\nbecause they don't do anything!  But we have three exceptions:\n\n* A wildcard pattern\n       _ = rhs\n  which (a) is not that different from  _v = rhs\n        (b) is sometimes used to give a type sig for,\n            or an occurrence of, a variable on the RHS\n\n* A strict pattern binding; that is, one with an outermost bang\n     !Just _ = e\n  This can fail, so unlike the lazy variant, it is not a no-op.\n  Moreover, Trac #13646 argues that even for single constructor\n  types, you might want to write the constructor.  See also #9127.\n\n* A splice pattern\n      $(th-lhs) = rhs\n   It is impossible to determine whether or not th-lhs really\n   binds any variable. We should disable the warning for any pattern\n   which contain splices, but that is a more expensive check.\n\nNote [Free-variable space leak]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe have\n    fvs' = trim fvs\nand we seq fvs' before turning it as part of a record.\n\nThe reason is that trim is sometimes something like\n    \\xs -> intersectNameSet (mkNameSet bound_names) xs\nand we don't want to retain the list bound_names. This showed up in\ntrac ticket #1136.\n-}\n\n{- *********************************************************************\n*                                                                      *\n          Dependency analysis and other support functions\n*                                                                      *\n********************************************************************* -}\n\ndepAnalBinds :: Bag (LHsBind GhcRn, [Name], Uses)\n             -> ([(RecFlag, LHsBinds GhcRn)], DefUses)\n-- Dependency analysis; this is important so that\n-- unused-binding reporting is accurate\ndepAnalBinds binds_w_dus\n  = (map get_binds sccs, map get_du sccs)\n  where\n    sccs = depAnal (\\(_, defs, _) -> defs)\n                   (\\(_, _, uses) -> nonDetEltsUniqSet uses)\n                   -- It's OK to use nonDetEltsUniqSet here as explained in\n                   -- Note [depAnal determinism] in NameEnv.\n                   (bagToList binds_w_dus)\n\n    get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)\n    get_binds (CyclicSCC  binds_w_dus)  = (Recursive, listToBag [b | (b,_,_) <- binds_w_dus])\n\n    get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)\n    get_du (CyclicSCC  binds_w_dus)      = (Just defs, uses)\n        where\n          defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]\n          uses = unionNameSets [u | (_,_,u) <- binds_w_dus]\n\n---------------------\n-- Bind the top-level forall'd type variables in the sigs.\n-- E.g  f :: forall a. a -> a\n--      f = rhs\n--      The 'a' scopes over the rhs\n--\n-- NB: there'll usually be just one (for a function binding)\n--     but if there are many, one may shadow the rest; too bad!\n--      e.g  x :: forall a. [a] -> [a]\n--           y :: forall a. [(a,a)] -> a\n--           (x,y) = e\n--      In e, 'a' will be in scope, and it'll be the one from 'y'!\n\nmkScopedTvFn :: [LSig GhcRn] -> (Name -> [Name])\n-- Return a lookup function that maps an Id Name to the names\n-- of the type variables that should scope over its body.\nmkScopedTvFn sigs = \\n -> lookupNameEnv env n `orElse` []\n  where\n    env = mkHsSigEnv get_scoped_tvs sigs\n\n    get_scoped_tvs :: LSig GhcRn -> Maybe ([Located Name], [Name])\n    -- Returns (binders, scoped tvs for those binders)\n    get_scoped_tvs (L _ (ClassOpSig _ _ names sig_ty))\n      = Just (names, hsScopedTvs sig_ty)\n    get_scoped_tvs (L _ (TypeSig _ names sig_ty))\n      = Just (names, hsWcScopedTvs sig_ty)\n    get_scoped_tvs (L _ (PatSynSig _ names sig_ty))\n      = Just (names, hsScopedTvs sig_ty)\n    get_scoped_tvs _ = Nothing\n\n-- Process the fixity declarations, making a FastString -> (Located Fixity) map\n-- (We keep the location around for reporting duplicate fixity declarations.)\n--\n-- Checks for duplicates, but not that only locally defined things are fixed.\n-- Note: for local fixity declarations, duplicates would also be checked in\n--       check_sigs below.  But we also use this function at the top level.\n\nmakeMiniFixityEnv :: [LFixitySig GhcPs] -> RnM MiniFixityEnv\n\nmakeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls\n where\n   add_one_sig env (L loc (FixitySig _ names fixity)) =\n     foldlM add_one env [ (loc,name_loc,name,fixity)\n                        | L name_loc name <- names ]\n   add_one_sig _ (L _ (XFixitySig _)) = panic \"makeMiniFixityEnv\"\n\n   add_one env (loc, name_loc, name,fixity) = do\n     { -- this fixity decl is a duplicate iff\n       -- the ReaderName's OccName's FastString is already in the env\n       -- (we only need to check the local fix_env because\n       --  definitions of non-local will be caught elsewhere)\n       let { fs = occNameFS (rdrNameOcc name)\n           ; fix_item = L loc fixity };\n\n       case lookupFsEnv env fs of\n         Nothing -> return $ extendFsEnv env fs fix_item\n         Just (L loc' _) -> do\n           { setSrcSpan loc $\n             addErrAt name_loc (dupFixityDecl loc' name)\n           ; return env}\n     }\n\ndupFixityDecl :: SrcSpan -> RdrName -> SDoc\ndupFixityDecl loc rdr_name\n  = vcat [text \"Multiple fixity declarations for\" <+> quotes (ppr rdr_name),\n          text \"also at \" <+> ppr loc]\n\n\n{- *********************************************************************\n*                                                                      *\n                Pattern synonym bindings\n*                                                                      *\n********************************************************************* -}\n\nrnPatSynBind :: (Name -> [Name])           -- Signature tyvar function\n             -> PatSynBind GhcRn GhcPs\n             -> RnM (PatSynBind GhcRn GhcRn, [Name], Uses)\nrnPatSynBind sig_fn bind@(PSB { psb_id = L l name\n                              , psb_args = details\n                              , psb_def = pat\n                              , psb_dir = dir })\n       -- invariant: no free vars here when it's a FunBind\n  = do  { pattern_synonym_ok <- xoptM LangExt.PatternSynonyms\n        ; unless pattern_synonym_ok (addErr patternSynonymErr)\n        ; let scoped_tvs = sig_fn name\n\n        ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $\n                                      rnPat PatSyn pat $ \\pat' ->\n         -- We check the 'RdrName's instead of the 'Name's\n         -- so that the binding locations are reported\n         -- from the left-hand side\n            case details of\n               PrefixCon vars ->\n                   do { checkDupRdrNames vars\n                      ; names <- mapM lookupPatSynBndr vars\n                      ; return ( (pat', PrefixCon names)\n                               , mkFVs (map unLoc names)) }\n               InfixCon var1 var2 ->\n                   do { checkDupRdrNames [var1, var2]\n                      ; name1 <- lookupPatSynBndr var1\n                      ; name2 <- lookupPatSynBndr var2\n                      -- ; checkPrecMatch -- TODO\n                      ; return ( (pat', InfixCon name1 name2)\n                               , mkFVs (map unLoc [name1, name2])) }\n               RecCon vars ->\n                   do { checkDupRdrNames (map recordPatSynSelectorId vars)\n                      ; let rnRecordPatSynField\n                              (RecordPatSynField { recordPatSynSelectorId = visible\n                                                 , recordPatSynPatVar = hidden })\n                              = do { visible' <- lookupLocatedTopBndrRn visible\n                                   ; hidden'  <- lookupPatSynBndr hidden\n                                   ; return $ RecordPatSynField { recordPatSynSelectorId = visible'\n                                                                , recordPatSynPatVar = hidden' } }\n                      ; names <- mapM rnRecordPatSynField  vars\n                      ; return ( (pat', RecCon names)\n                               , mkFVs (map (unLoc . recordPatSynPatVar) names)) }\n\n        ; (dir', fvs2) <- case dir of\n            Unidirectional -> return (Unidirectional, emptyFVs)\n            ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)\n            ExplicitBidirectional mg ->\n                do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $\n                                   rnMatchGroup (mkPrefixFunRhs (L l name))\n                                                rnLExpr mg\n                   ; return (ExplicitBidirectional mg', fvs) }\n\n        ; mod <- getModule\n        ; let fvs = fvs1 `plusFV` fvs2\n              fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs\n                -- Keep locally-defined Names\n                -- As well as dependency analysis, we need these for the\n                -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan\n\n              bind' = bind{ psb_args = details'\n                          , psb_def = pat'\n                          , psb_dir = dir'\n                          , psb_ext = fvs' }\n              selector_names = case details' of\n                                 RecCon names ->\n                                  map (unLoc . recordPatSynSelectorId) names\n                                 _ -> []\n\n        ; fvs' `seq` -- See Note [Free-variable space leak]\n          return (bind', name : selector_names , fvs1)\n          -- Why fvs1?  See Note [Pattern synonym builders don't yield dependencies]\n      }\n  where\n    -- See Note [Renaming pattern synonym variables]\n    lookupPatSynBndr = wrapLocM lookupLocalOccRn\n\n    patternSynonymErr :: SDoc\n    patternSynonymErr\n      = hang (text \"Illegal pattern synonym declaration\")\n           2 (text \"Use -XPatternSynonyms to enable this extension\")\n\nrnPatSynBind _ (XPatSynBind _) = panic \"rnPatSynBind\"\n\n{-\nNote [Renaming pattern synonym variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe rename pattern synonym declaractions backwards to normal to reuse\nthe logic already implemented for renaming patterns.\n\nWe first rename the RHS of a declaration which brings into\nscope the variables bound by the pattern (as they would be\nin normal function definitions). We then lookup the variables\nwhich we want to bind in this local environment.\n\nIt is crucial that we then only lookup in the *local* environment which\nonly contains the variables brought into scope by the pattern and nothing\nelse. Amazingly no-one encountered this bug for 3 GHC versions but\nit was possible to define a pattern synonym which referenced global\nidentifiers and worked correctly.\n\n```\nx = 5\n\npattern P :: Int -> ()\npattern P x <- _\n\nf (P x) = x\n\n> f () = 5\n```\n\nSee #13470 for the original report.\n\nNote [Pattern synonym builders don't yield dependencies]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen renaming a pattern synonym that has an explicit builder,\nreferences in the builder definition should not be used when\ncalculating dependencies. For example, consider the following pattern\nsynonym definition:\n\npattern P x <- C1 x where\n  P x = f (C1 x)\n\nf (P x) = C2 x\n\nIn this case, 'P' needs to be typechecked in two passes:\n\n1. Typecheck the pattern definition of 'P', which fully determines the\n   type of 'P'. This step doesn't require knowing anything about 'f',\n   since the builder definition is not looked at.\n\n2. Typecheck the builder definition, which needs the typechecked\n   definition of 'f' to be in scope; done by calls oo tcPatSynBuilderBind\n   in TcBinds.tcValBinds.\n\nThis behaviour is implemented in 'tcValBinds', but it crucially\ndepends on 'P' not being put in a recursive group with 'f' (which\nwould make it look like a recursive pattern synonym a la 'pattern P =\nP' which is unsound and rejected).\n\nSo:\n * We do not include builder fvs in the Uses returned by rnPatSynBind\n   (which is then used for dependency analysis)\n * But we /do/ include them in the psb_fvs for the PatSynBind\n * In rnValBinds we record these builder uses, to avoid bogus\n   unused-variable warnings (Trac #12548)\n-}\n\n{- *********************************************************************\n*                                                                      *\n                Class/instance method bindings\n*                                                                      *\n********************************************************************* -}\n\n{- @rnMethodBinds@ is used for the method bindings of a class and an instance\ndeclaration.   Like @rnBinds@ but without dependency analysis.\n\nNOTA BENE: we record each {\\em binder} of a method-bind group as a free variable.\nThat's crucial when dealing with an instance decl:\n\\begin{verbatim}\n        instance Foo (T a) where\n           op x = ...\n\\end{verbatim}\nThis might be the {\\em sole} occurrence of @op@ for an imported class @Foo@,\nand unless @op@ occurs we won't treat the type signature of @op@ in the class\ndecl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,\nin many ways the @op@ in an instance decl is just like an occurrence, not\na binder.\n-}\n\nrnMethodBinds :: Bool                   -- True <=> is a class declaration\n              -> Name                   -- Class name\n              -> [Name]                 -- Type variables from the class/instance header\n              -> LHsBinds GhcPs         -- Binds\n              -> [LSig GhcPs]           -- and signatures/pragmas\n              -> RnM (LHsBinds GhcRn, [LSig GhcRn], FreeVars)\n-- Used for\n--   * the default method bindings in a class decl\n--   * the method bindings in an instance decl\nrnMethodBinds is_cls_decl cls ktv_names binds sigs\n  = do { checkDupRdrNames (collectMethodBinders binds)\n             -- Check that the same method is not given twice in the\n             -- same instance decl      instance C T where\n             --                       f x = ...\n             --                       g y = ...\n             --                       f x = ...\n             -- We must use checkDupRdrNames because the Name of the\n             -- method is the Name of the class selector, whose SrcSpan\n             -- points to the class declaration; and we use rnMethodBinds\n             -- for instance decls too\n\n       -- Rename the bindings LHSs\n       ; binds' <- foldrBagM (rnMethodBindLHS is_cls_decl cls) emptyBag binds\n\n       -- Rename the pragmas and signatures\n       -- Annoyingly the type variables /are/ in scope for signatures, but\n       -- /are not/ in scope in the SPECIALISE instance pramas; e.g.\n       --    instance Eq a => Eq (T a) where\n       --       (==) :: a -> a -> a\n       --       {-# SPECIALISE instance Eq a => Eq (T [a]) #-}\n       ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs\n             bound_nms = mkNameSet (collectHsBindsBinders binds')\n             sig_ctxt | is_cls_decl = ClsDeclCtxt cls\n                      | otherwise   = InstDeclCtxt bound_nms\n       ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags\n       ; (other_sigs',      sig_fvs) <- extendTyVarEnvFVRn ktv_names $\n                                        renameSigs sig_ctxt other_sigs\n\n       -- Rename the bindings RHSs.  Again there's an issue about whether the\n       -- type variables from the class/instance head are in scope.\n       -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables\n       ; scoped_tvs  <- xoptM LangExt.ScopedTypeVariables\n       ; (binds'', bind_fvs) <- maybe_extend_tyvar_env scoped_tvs $\n              do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds'\n                 ; let bind_fvs = foldrBag (\\(_,_,fv1) fv2 -> fv1 `plusFV` fv2)\n                                           emptyFVs binds_w_dus\n                 ; return (mapBag fstOf3 binds_w_dus, bind_fvs) }\n\n       ; return ( binds'', spec_inst_prags' ++ other_sigs'\n                , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) }\n  where\n    -- For the method bindings in class and instance decls, we extend\n    -- the type variable environment iff -XScopedTypeVariables\n    maybe_extend_tyvar_env scoped_tvs thing_inside\n       | scoped_tvs = extendTyVarEnvFVRn ktv_names thing_inside\n       | otherwise  = thing_inside\n\nrnMethodBindLHS :: Bool -> Name\n                -> LHsBindLR GhcPs GhcPs\n                -> LHsBindsLR GhcRn GhcPs\n                -> RnM (LHsBindsLR GhcRn GhcPs)\nrnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest\n  = setSrcSpan loc $ do\n    do { sel_name <- wrapLocM (lookupInstDeclBndr cls (text \"method\")) name\n                     -- We use the selector name as the binder\n       ; let bind' = bind { fun_id = sel_name, fun_ext = noExt }\n       ; return (L loc bind' `consBag` rest ) }\n\n-- Report error for all other forms of bindings\n-- This is why we use a fold rather than map\nrnMethodBindLHS is_cls_decl _ (L loc bind) rest\n  = do { addErrAt loc $\n         vcat [ what <+> text \"not allowed in\" <+> decl_sort\n              , nest 2 (ppr bind) ]\n       ; return rest }\n  where\n    decl_sort | is_cls_decl = text \"class declaration:\"\n              | otherwise   = text \"instance declaration:\"\n    what = case bind of\n              PatBind {}    -> text \"Pattern bindings (except simple variables)\"\n              PatSynBind {} -> text \"Pattern synonyms\"\n                               -- Associated pattern synonyms are not implemented yet\n              _ -> pprPanic \"rnMethodBind\" (ppr bind)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}\n*                                                                      *\n************************************************************************\n\n@renameSigs@ checks for:\n\\begin{enumerate}\n\\item more than one sig for one thing;\n\\item signatures given for things not bound here;\n\\end{enumerate}\n\nAt the moment we don't gather free-var info from the types in\nsignatures.  We'd only need this if we wanted to report unused tyvars.\n-}\n\nrenameSigs :: HsSigCtxt\n           -> [LSig GhcPs]\n           -> RnM ([LSig GhcRn], FreeVars)\n-- Renames the signatures and performs error checks\nrenameSigs ctxt sigs\n  = do  { mapM_ dupSigDeclErr (findDupSigs sigs)\n\n        ; checkDupMinimalSigs sigs\n\n        ; (sigs', sig_fvs) <- mapFvRn (wrapLocFstM (renameSig ctxt)) sigs\n\n        ; let (good_sigs, bad_sigs) = partition (okHsSig ctxt) sigs'\n        ; mapM_ misplacedSigErr bad_sigs                 -- Misplaced\n\n        ; return (good_sigs, sig_fvs) }\n\n----------------------\n-- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory\n-- because this won't work for:\n--      instance Foo T where\n--        {-# INLINE op #-}\n--        Baz.op = ...\n-- We'll just rename the INLINE prag to refer to whatever other 'op'\n-- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)\n-- Doesn't seem worth much trouble to sort this.\n\nrenameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars)\nrenameSig _ (IdSig _ x)\n  = return (IdSig noExt x, emptyFVs)    -- Actually this never occurs\n\nrenameSig ctxt sig@(TypeSig _ vs ty)\n  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs\n        ; let doc = TypeSigCtx (ppr_sig_bndrs vs)\n        ; (new_ty, fvs) <- rnHsSigWcType BindUnlessForall doc ty\n        ; return (TypeSig noExt new_vs new_ty, fvs) }\n\nrenameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)\n  = do  { defaultSigs_on <- xoptM LangExt.DefaultSignatures\n        ; when (is_deflt && not defaultSigs_on) $\n          addErr (defaultSigErr sig)\n        ; new_v <- mapM (lookupSigOccRn ctxt sig) vs\n        ; (new_ty, fvs) <- rnHsSigType ty_ctxt ty\n        ; return (ClassOpSig noExt is_deflt new_v new_ty, fvs) }\n  where\n    (v1:_) = vs\n    ty_ctxt = GenericCtx (text \"a class method signature for\"\n                          <+> quotes (ppr v1))\n\nrenameSig _ (SpecInstSig _ src ty)\n  = do  { (new_ty, fvs) <- rnHsSigType SpecInstSigCtx ty\n        ; return (SpecInstSig noExt src new_ty,fvs) }\n\n-- {-# SPECIALISE #-} pragmas can refer to imported Ids\n-- so, in the top-level case (when mb_names is Nothing)\n-- we use lookupOccRn.  If there's both an imported and a local 'f'\n-- then the SPECIALISE pragma is ambiguous, unlike all other signatures\nrenameSig ctxt sig@(SpecSig _ v tys inl)\n  = do  { new_v <- case ctxt of\n                     TopSigCtxt {} -> lookupLocatedOccRn v\n                     _             -> lookupSigOccRn ctxt sig v\n        ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys\n        ; return (SpecSig noExt new_v new_ty inl, fvs) }\n  where\n    ty_ctxt = GenericCtx (text \"a SPECIALISE signature for\"\n                          <+> quotes (ppr v))\n    do_one (tys,fvs) ty\n      = do { (new_ty, fvs_ty) <- rnHsSigType ty_ctxt ty\n           ; return ( new_ty:tys, fvs_ty `plusFV` fvs) }\n\nrenameSig ctxt sig@(InlineSig _ v s)\n  = do  { new_v <- lookupSigOccRn ctxt sig v\n        ; return (InlineSig noExt new_v s, emptyFVs) }\n\nrenameSig ctxt (FixSig _ fsig)\n  = do  { new_fsig <- rnSrcFixityDecl ctxt fsig\n        ; return (FixSig noExt new_fsig, emptyFVs) }\n\nrenameSig ctxt sig@(MinimalSig _ s (L l bf))\n  = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf\n       return (MinimalSig noExt s (L l new_bf), emptyFVs)\n\nrenameSig ctxt sig@(PatSynSig _ vs ty)\n  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs\n        ; (ty', fvs) <- rnHsSigType ty_ctxt ty\n        ; return (PatSynSig noExt new_vs ty', fvs) }\n  where\n    ty_ctxt = GenericCtx (text \"a pattern synonym signature for\"\n                          <+> ppr_sig_bndrs vs)\n\nrenameSig ctxt sig@(SCCFunSig _ st v s)\n  = do  { new_v <- lookupSigOccRn ctxt sig v\n        ; return (SCCFunSig noExt st new_v s, emptyFVs) }\n\n-- COMPLETE Sigs can refer to imported IDs which is why we use\n-- lookupLocatedOccRn rather than lookupSigOccRn\nrenameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty)\n  = do new_bf <- traverse lookupLocatedOccRn bf\n       new_mty  <- traverse lookupLocatedOccRn mty\n\n       this_mod <- fmap tcg_mod getGblEnv\n       unless (any (nameIsLocalOrFrom this_mod . unLoc) new_bf) $ do\n         -- Why 'any'? See Note [Orphan COMPLETE pragmas]\n         addErrCtxt (text \"In\" <+> ppr sig) $ failWithTc orphanError\n\n       return (CompleteMatchSig noExt s (L l new_bf) new_mty, emptyFVs)\n  where\n    orphanError :: SDoc\n    orphanError =\n      text \"Orphan COMPLETE pragmas not supported\" $$\n      text \"A COMPLETE pragma must mention at least one data constructor\" $$\n      text \"or pattern synonym defined in the same module.\"\n\nrenameSig _ (XSig _) = panic \"renameSig\"\n\n{-\nNote [Orphan COMPLETE pragmas]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe define a COMPLETE pragma to be a non-orphan if it includes at least\none conlike defined in the current module. Why is this sufficient?\nWell if you have a pattern match\n\n  case expr of\n    P1 -> ...\n    P2 -> ...\n    P3 -> ...\n\nany COMPLETE pragma which mentions a conlike other than P1, P2 or P3\nwill not be of any use in verifying that the pattern match is\nexhaustive. So as we have certainly read the interface files that\ndefine P1, P2 and P3, we will have loaded all non-orphan COMPLETE\npragmas that could be relevant to this pattern match.\n\nFor now we simply disallow orphan COMPLETE pragmas, as the added\ncomplexity of supporting them properly doesn't seem worthwhile.\n-}\n\nppr_sig_bndrs :: [Located RdrName] -> SDoc\nppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)\n\nokHsSig :: HsSigCtxt -> LSig a -> Bool\nokHsSig ctxt (L _ sig)\n  = case (sig, ctxt) of\n     (ClassOpSig {}, ClsDeclCtxt {})  -> True\n     (ClassOpSig {}, InstDeclCtxt {}) -> True\n     (ClassOpSig {}, _)               -> False\n\n     (TypeSig {}, ClsDeclCtxt {})  -> False\n     (TypeSig {}, InstDeclCtxt {}) -> False\n     (TypeSig {}, _)               -> True\n\n     (PatSynSig {}, TopSigCtxt{}) -> True\n     (PatSynSig {}, _)            -> False\n\n     (FixSig {}, InstDeclCtxt {}) -> False\n     (FixSig {}, _)               -> True\n\n     (IdSig {}, TopSigCtxt {})   -> True\n     (IdSig {}, InstDeclCtxt {}) -> True\n     (IdSig {}, _)               -> False\n\n     (InlineSig {}, HsBootCtxt {}) -> False\n     (InlineSig {}, _)             -> True\n\n     (SpecSig {}, TopSigCtxt {})    -> True\n     (SpecSig {}, LocalBindCtxt {}) -> True\n     (SpecSig {}, InstDeclCtxt {})  -> True\n     (SpecSig {}, _)                -> False\n\n     (SpecInstSig {}, InstDeclCtxt {}) -> True\n     (SpecInstSig {}, _)               -> False\n\n     (MinimalSig {}, ClsDeclCtxt {}) -> True\n     (MinimalSig {}, _)              -> False\n\n     (SCCFunSig {}, HsBootCtxt {}) -> False\n     (SCCFunSig {}, _)             -> True\n\n     (CompleteMatchSig {}, TopSigCtxt {} ) -> True\n     (CompleteMatchSig {}, _)              -> False\n\n     (XSig _, _) -> panic \"okHsSig\"\n\n-------------------\nfindDupSigs :: [LSig GhcPs] -> [NonEmpty (Located RdrName, Sig GhcPs)]\n-- Check for duplicates on RdrName version,\n-- because renamed version has unboundName for\n-- not-in-scope binders, which gives bogus dup-sig errors\n-- NB: in a class decl, a 'generic' sig is not considered\n--     equal to an ordinary sig, so we allow, say\n--           class C a where\n--             op :: a -> a\n--             default op :: Eq a => a -> a\nfindDupSigs sigs\n  = findDupsEq matching_sig (concatMap (expand_sig . unLoc) sigs)\n  where\n    expand_sig sig@(FixSig _ (FixitySig _ ns _)) = zip ns (repeat sig)\n    expand_sig sig@(InlineSig _ n _)             = [(n,sig)]\n    expand_sig sig@(TypeSig _ ns _)              = [(n,sig) | n <- ns]\n    expand_sig sig@(ClassOpSig _ _ ns _)         = [(n,sig) | n <- ns]\n    expand_sig sig@(PatSynSig _ ns  _ )          = [(n,sig) | n <- ns]\n    expand_sig sig@(SCCFunSig _ _ n _)           = [(n,sig)]\n    expand_sig _ = []\n\n    matching_sig (L _ n1,sig1) (L _ n2,sig2)       = n1 == n2 && mtch sig1 sig2\n    mtch (FixSig {})           (FixSig {})         = True\n    mtch (InlineSig {})        (InlineSig {})      = True\n    mtch (TypeSig {})          (TypeSig {})        = True\n    mtch (ClassOpSig _ d1 _ _) (ClassOpSig _ d2 _ _) = d1 == d2\n    mtch (PatSynSig _ _ _)     (PatSynSig _ _ _)   = True\n    mtch (SCCFunSig{})         (SCCFunSig{})       = True\n    mtch _ _ = False\n\n-- Warn about multiple MINIMAL signatures\ncheckDupMinimalSigs :: [LSig GhcPs] -> RnM ()\ncheckDupMinimalSigs sigs\n  = case filter isMinimalLSig sigs of\n      minSigs@(_:_:_) -> dupMinimalSigErr minSigs\n      _ -> return ()\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Match}\n*                                                                      *\n************************************************************************\n-}\n\nrnMatchGroup :: Outputable (body GhcPs) => HsMatchContext Name\n             -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n             -> MatchGroup GhcPs (Located (body GhcPs))\n             -> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)\nrnMatchGroup ctxt rnBody (MG { mg_alts = L _ ms, mg_origin = origin })\n  = do { empty_case_ok <- xoptM LangExt.EmptyCase\n       ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt))\n       ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms\n       ; return (mkMatchGroup origin new_ms, ms_fvs) }\nrnMatchGroup _ _ (XMatchGroup {}) = panic \"rnMatchGroup\"\n\nrnMatch :: Outputable (body GhcPs) => HsMatchContext Name\n        -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n        -> LMatch GhcPs (Located (body GhcPs))\n        -> RnM (LMatch GhcRn (Located (body GhcRn)), FreeVars)\nrnMatch ctxt rnBody = wrapLocFstM (rnMatch' ctxt rnBody)\n\nrnMatch' :: Outputable (body GhcPs) => HsMatchContext Name\n         -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n         -> Match GhcPs (Located (body GhcPs))\n         -> RnM (Match GhcRn (Located (body GhcRn)), FreeVars)\nrnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss })\n  = do  { -- Note that there are no local fixity decls for matches\n        ; rnPats ctxt pats      $ \\ pats' -> do\n        { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss\n        ; let mf' = case (ctxt, mf) of\n                      (FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ })\n                                            -> mf { mc_fun = L lf funid }\n                      _                     -> ctxt\n        ; return (Match { m_ext = noExt, m_ctxt = mf', m_pats = pats'\n                        , m_grhss = grhss'}, grhss_fvs ) }}\nrnMatch' _ _ (XMatch _) = panic \"rnMatch'\"\n\nemptyCaseErr :: HsMatchContext Name -> SDoc\nemptyCaseErr ctxt = hang (text \"Empty list of alternatives in\" <+> pp_ctxt)\n                       2 (text \"Use EmptyCase to allow this\")\n  where\n    pp_ctxt = case ctxt of\n                CaseAlt    -> text \"case expression\"\n                LambdaExpr -> text \"\\\\case expression\"\n                _ -> text \"(unexpected)\" <+> pprMatchContextNoun ctxt\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Guarded right-hand sides (GRHSs)}\n*                                                                      *\n************************************************************************\n-}\n\nrnGRHSs :: HsMatchContext Name\n        -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n        -> GRHSs GhcPs (Located (body GhcPs))\n        -> RnM (GRHSs GhcRn (Located (body GhcRn)), FreeVars)\nrnGRHSs ctxt rnBody (GRHSs _ grhss (L l binds))\n  = rnLocalBindsAndThen binds   $ \\ binds' _ -> do\n    (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss\n    return (GRHSs noExt grhss' (L l binds'), fvGRHSs)\nrnGRHSs _ _ (XGRHSs _) = panic \"rnGRHSs\"\n\nrnGRHS :: HsMatchContext Name\n       -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n       -> LGRHS GhcPs (Located (body GhcPs))\n       -> RnM (LGRHS GhcRn (Located (body GhcRn)), FreeVars)\nrnGRHS ctxt rnBody = wrapLocFstM (rnGRHS' ctxt rnBody)\n\nrnGRHS' :: HsMatchContext Name\n        -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n        -> GRHS GhcPs (Located (body GhcPs))\n        -> RnM (GRHS GhcRn (Located (body GhcRn)), FreeVars)\nrnGRHS' ctxt rnBody (GRHS _ guards rhs)\n  = do  { pattern_guards_allowed <- xoptM LangExt.PatternGuards\n        ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) rnLExpr guards $ \\ _ ->\n                                    rnBody rhs\n\n        ; unless (pattern_guards_allowed || is_standard_guard guards')\n                 (addWarn NoReason (nonStdGuardErr guards'))\n\n        ; return (GRHS noExt guards' rhs', fvs) }\n  where\n        -- Standard Haskell 1.4 guards are just a single boolean\n        -- expression, rather than a list of qualifiers as in the\n        -- Glasgow extension\n    is_standard_guard []                  = True\n    is_standard_guard [L _ (BodyStmt {})] = True\n    is_standard_guard _                   = False\nrnGRHS' _ _ (XGRHS _) = panic \"rnGRHS'\"\n\n{-\n*********************************************************\n*                                                       *\n        Source-code fixity declarations\n*                                                       *\n*********************************************************\n-}\n\nrnSrcFixityDecl :: HsSigCtxt -> FixitySig GhcPs -> RnM (FixitySig GhcRn)\n-- Rename a fixity decl, so we can put\n-- the renamed decl in the renamed syntax tree\n-- Errors if the thing being fixed is not defined locally.\nrnSrcFixityDecl sig_ctxt = rn_decl\n  where\n    rn_decl :: FixitySig GhcPs -> RnM (FixitySig GhcRn)\n        -- GHC extension: look up both the tycon and data con\n        -- for con-like things; hence returning a list\n        -- If neither are in scope, report an error; otherwise\n        -- return a fixity sig for each (slightly odd)\n    rn_decl (FixitySig _ fnames fixity)\n      = do names <- concatMapM lookup_one fnames\n           return (FixitySig noExt names fixity)\n    rn_decl (XFixitySig _) = panic \"rnSrcFixityDecl\"\n\n    lookup_one :: Located RdrName -> RnM [Located Name]\n    lookup_one (L name_loc rdr_name)\n      = setSrcSpan name_loc $\n                    -- This lookup will fail if the name is not defined in the\n                    -- same binding group as this fixity declaration.\n        do names <- lookupLocalTcNames sig_ctxt what rdr_name\n           return [ L name_loc name | (_, name) <- names ]\n    what = text \"fixity signature\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Error messages}\n*                                                                      *\n************************************************************************\n-}\n\ndupSigDeclErr :: NonEmpty (Located RdrName, Sig GhcPs) -> RnM ()\ndupSigDeclErr pairs@((L loc name, sig) :| _)\n  = addErrAt loc $\n    vcat [ text \"Duplicate\" <+> what_it_is\n           <> text \"s for\" <+> quotes (ppr name)\n         , text \"at\" <+> vcat (map ppr $ sort\n                                       $ map (getLoc . fst)\n                                       $ toList pairs)\n         ]\n  where\n    what_it_is = hsSigDoc sig\n\nmisplacedSigErr :: LSig GhcRn -> RnM ()\nmisplacedSigErr (L loc sig)\n  = addErrAt loc $\n    sep [text \"Misplaced\" <+> hsSigDoc sig <> colon, ppr sig]\n\ndefaultSigErr :: Sig GhcPs -> SDoc\ndefaultSigErr sig = vcat [ hang (text \"Unexpected default signature:\")\n                              2 (ppr sig)\n                         , text \"Use DefaultSignatures to enable default signatures\" ]\n\nbindsInHsBootFile :: LHsBindsLR GhcRn GhcPs -> SDoc\nbindsInHsBootFile mbinds\n  = hang (text \"Bindings in hs-boot files are not allowed\")\n       2 (ppr mbinds)\n\nnonStdGuardErr :: Outputable body => [LStmtLR GhcRn GhcRn body] -> SDoc\nnonStdGuardErr guards\n  = hang (text \"accepting non-standard pattern guards (use PatternGuards to suppress this message)\")\n       4 (interpp'SP guards)\n\nunusedPatBindWarn :: HsBind GhcRn -> SDoc\nunusedPatBindWarn bind\n  = hang (text \"This pattern-binding binds no variables:\")\n       2 (ppr bind)\n\ndupMinimalSigErr :: [LSig GhcPs] -> RnM ()\ndupMinimalSigErr sigs@(L loc _ : _)\n  = addErrAt loc $\n    vcat [ text \"Multiple minimal complete definitions\"\n         , text \"at\" <+> vcat (map ppr $ sort $ map getLoc sigs)\n         , text \"Combine alternative minimal complete definitions with `|'\" ]\ndupMinimalSigErr [] = panic \"dupMinimalSigErr\"\n", "num_lines": 1334}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-2006\n\nRnEnv contains functions which convert RdrNames into Names.\n\n-}\n\n{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-}\n\nmodule RnEnv (\n        newTopSrcBinder,\n        lookupLocatedTopBndrRn, lookupTopBndrRn,\n        lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,\n        lookupLocalOccRn_maybe, lookupInfoOccRn,\n        lookupLocalOccThLvl_maybe, lookupLocalOccRn,\n        lookupTypeOccRn,\n        lookupGlobalOccRn, lookupGlobalOccRn_maybe,\n        lookupOccRn_overloaded, lookupGlobalOccRn_overloaded, lookupExactOcc,\n\n        ChildLookupResult(..),\n        lookupSubBndrOcc_helper,\n        combineChildLookupResult, -- Called by lookupChildrenExport\n\n        HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,\n        lookupSigCtxtOccRn,\n\n        lookupInstDeclBndr, lookupRecFieldOcc, lookupFamInstName,\n        lookupConstructorFields,\n\n        lookupGreAvailRn,\n\n        -- Rebindable Syntax\n        lookupSyntaxName, lookupSyntaxName', lookupSyntaxNames,\n        lookupIfThenElse,\n\n        -- Constructing usage information\n        addUsedGRE, addUsedGREs, addUsedDataCons,\n\n\n\n        dataTcOccs, --TODO: Move this somewhere, into utils?\n\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport LoadIface        ( loadInterfaceForName, loadSrcInterface_maybe )\nimport IfaceEnv\nimport HsSyn\nimport RdrName\nimport HscTypes\nimport TcEnv\nimport TcRnMonad\nimport RdrHsSyn         ( filterCTuple, setRdrNameSpace )\nimport TysWiredIn\nimport Name\nimport NameSet\nimport NameEnv\nimport Avail\nimport Module\nimport ConLike\nimport DataCon\nimport TyCon\nimport ErrUtils         ( MsgDoc )\nimport PrelNames        ( rOOT_MAIN )\nimport BasicTypes       ( pprWarningTxtForMsg, TopLevelFlag(..))\nimport SrcLoc\nimport Outputable\nimport Util\nimport Maybes\nimport DynFlags\nimport FastString\nimport Control.Monad\nimport ListSetOps       ( minusList )\nimport qualified GHC.LanguageExtensions as LangExt\nimport RnUnbound\nimport RnUtils\nimport qualified Data.Semigroup as Semi\nimport Data.Either      ( partitionEithers )\nimport Data.List        (find)\n\n{-\n*********************************************************\n*                                                      *\n                Source-code binders\n*                                                      *\n*********************************************************\n\nNote [Signature lazy interface loading]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nGHC's lazy interface loading can be a bit confusing, so this Note is an\nempirical description of what happens in one interesting case. When\ncompiling a signature module against an its implementation, we do NOT\nload interface files associated with its names until after the type\nchecking phase.  For example:\n\n    module ASig where\n        data T\n        f :: T -> T\n\nSuppose we compile this with -sig-of \"A is ASig\":\n\n    module B where\n        data T = T\n        f T = T\n\n    module A(module B) where\n        import B\n\nDuring type checking, we'll load A.hi because we need to know what the\nRdrEnv for the module is, but we DO NOT load the interface for B.hi!\nIt's wholly unnecessary: our local definition 'data T' in ASig is all\nthe information we need to finish type checking.  This is contrast to\ntype checking of ordinary Haskell files, in which we would not have the\nlocal definition \"data T\" and would need to consult B.hi immediately.\n(Also, this situation never occurs for hs-boot files, since you're not\nallowed to reexport from another module.)\n\nAfter type checking, we then check that the types we provided are\nconsistent with the backing implementation (in checkHiBootOrHsigIface).\nAt this point, B.hi is loaded, because we need something to compare\nagainst.\n\nI discovered this behavior when trying to figure out why type class\ninstances for Data.Map weren't in the EPS when I was type checking a\ntest very much like ASig (sigof02dm): the associated interface hadn't\nbeen loaded yet!  (The larger issue is a moot point, since an instance\ndeclared in a signature can never be a duplicate.)\n\nThis behavior might change in the future.  Consider this\nalternate module B:\n\n    module B where\n        {-# DEPRECATED T, f \"Don't use\" #-}\n        data T = T\n        f T = T\n\nOne might conceivably want to report deprecation warnings when compiling\nASig with -sig-of B, in which case we need to look at B.hi to find the\ndeprecation warnings during renaming.  At the moment, you don't get any\nwarning until you use the identifier further downstream.  This would\nrequire adjusting addUsedGRE so that during signature compilation,\nwe do not report deprecation warnings for LocalDef.  See also\nNote [Handling of deprecations]\n-}\n\nnewTopSrcBinder :: Located RdrName -> RnM Name\nnewTopSrcBinder (L loc rdr_name)\n  | Just name <- isExact_maybe rdr_name\n  =     -- This is here to catch\n        --   (a) Exact-name binders created by Template Haskell\n        --   (b) The PrelBase defn of (say) [] and similar, for which\n        --       the parser reads the special syntax and returns an Exact RdrName\n        -- We are at a binding site for the name, so check first that it\n        -- the current module is the correct one; otherwise GHC can get\n        -- very confused indeed. This test rejects code like\n        --      data T = (,) Int Int\n        -- unless we are in GHC.Tup\n    if isExternalName name then\n      do { this_mod <- getModule\n         ; unless (this_mod == nameModule name)\n                  (addErrAt loc (badOrigBinding rdr_name))\n         ; return name }\n    else   -- See Note [Binders in Template Haskell] in Convert.hs\n      do { this_mod <- getModule\n         ; externaliseName this_mod name }\n\n  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name\n  = do  { this_mod <- getModule\n        ; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)\n                 (addErrAt loc (badOrigBinding rdr_name))\n        -- When reading External Core we get Orig names as binders,\n        -- but they should agree with the module gotten from the monad\n        --\n        -- We can get built-in syntax showing up here too, sadly.  If you type\n        --      data T = (,,,)\n        -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon\n        -- uses setRdrNameSpace to make it into a data constructors.  At that point\n        -- the nice Exact name for the TyCon gets swizzled to an Orig name.\n        -- Hence the badOrigBinding error message.\n        --\n        -- Except for the \":Main.main = ...\" definition inserted into\n        -- the Main module; ugh!\n\n        -- Because of this latter case, we call newGlobalBinder with a module from\n        -- the RdrName, not from the environment.  In principle, it'd be fine to\n        -- have an arbitrary mixture of external core definitions in a single module,\n        -- (apart from module-initialisation issues, perhaps).\n        ; newGlobalBinder rdr_mod rdr_occ loc }\n\n  | otherwise\n  = do  { when (isQual rdr_name)\n                 (addErrAt loc (badQualBndrErr rdr_name))\n                -- Binders should not be qualified; if they are, and with a different\n                -- module name, we get a confusing \"M.T is not in scope\" error later\n\n        ; stage <- getStage\n        ; if isBrackStage stage then\n                -- We are inside a TH bracket, so make an *Internal* name\n                -- See Note [Top-level Names in Template Haskell decl quotes] in RnNames\n             do { uniq <- newUnique\n                ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }\n          else\n             do { this_mod <- getModule\n                ; traceRn \"newTopSrcBinder\" (ppr this_mod $$ ppr rdr_name $$ ppr loc)\n                ; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }\n        }\n\n{-\n*********************************************************\n*                                                      *\n        Source code occurrences\n*                                                      *\n*********************************************************\n\nLooking up a name in the RnEnv.\n\nNote [Type and class operator definitions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to reject all of these unless we have -XTypeOperators (Trac #3265)\n   data a :*: b  = ...\n   class a :*: b where ...\n   data (:*:) a b  = ....\n   class (:*:) a b where ...\nThe latter two mean that we are not just looking for a\n*syntactically-infix* declaration, but one that uses an operator\nOccName.  We use OccName.isSymOcc to detect that case, which isn't\nterribly efficient, but there seems to be no better way.\n-}\n\n-- Can be made to not be exposed\n-- Only used unwrapped in rnAnnProvenance\nlookupTopBndrRn :: RdrName -> RnM Name\nlookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n\n                       case nopt of\n                         Just n' -> return n'\n                         Nothing -> do traceRn \"lookupTopBndrRn fail\" (ppr n)\n                                       unboundName WL_LocalTop n\n\nlookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)\nlookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn\n\nlookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)\n-- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',\n-- and there may be several imported 'f's too, which must not confuse us.\n-- For example, this is OK:\n--      import Foo( f )\n--      infix 9 f       -- The 'f' here does not need to be qualified\n--      f x = x         -- Nor here, of course\n-- So we have to filter out the non-local ones.\n--\n-- A separate function (importsFromLocalDecls) reports duplicate top level\n-- decls, so here it's safe just to choose an arbitrary one.\n--\n-- There should never be a qualified name in a binding position in Haskell,\n-- but there can be if we have read in an external-Core file.\n-- The Haskell parser checks for the illegal qualified name in Haskell\n-- source files, so we don't need to do so here.\n\nlookupTopBndrRn_maybe rdr_name =\n  lookupExactOrOrig rdr_name Just $\n    do  {  -- Check for operators in type or class declarations\n           -- See Note [Type and class operator definitions]\n          let occ = rdrNameOcc rdr_name\n        ; when (isTcOcc occ && isSymOcc occ)\n               (do { op_ok <- xoptM LangExt.TypeOperators\n                   ; unless op_ok (addErr (opDeclErr rdr_name)) })\n\n        ; env <- getGlobalRdrEnv\n        ; case filter isLocalGRE (lookupGRE_RdrName rdr_name env) of\n            [gre] -> return (Just (gre_name gre))\n            _     -> return Nothing  -- Ambiguous (can't happen) or unbound\n    }\n\n-----------------------------------------------\n-- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames].\n-- This adds an error if the name cannot be found.\nlookupExactOcc :: Name -> RnM Name\nlookupExactOcc name\n  = do { result <- lookupExactOcc_either name\n       ; case result of\n           Left err -> do { addErr err\n                          ; return name }\n           Right name' -> return name' }\n\n-- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames].\n-- This never adds an error, but it may return one.\nlookupExactOcc_either :: Name -> RnM (Either MsgDoc Name)\n-- See Note [Looking up Exact RdrNames]\nlookupExactOcc_either name\n  | Just thing <- wiredInNameTyThing_maybe name\n  , Just tycon <- case thing of\n                    ATyCon tc                 -> Just tc\n                    AConLike (RealDataCon dc) -> Just (dataConTyCon dc)\n                    _                         -> Nothing\n  , isTupleTyCon tycon\n  = do { checkTupSize (tyConArity tycon)\n       ; return (Right name) }\n\n  | isExternalName name\n  = return (Right name)\n\n  | otherwise\n  = do { env <- getGlobalRdrEnv\n       ; let -- See Note [Splicing Exact names]\n             main_occ =  nameOccName name\n             demoted_occs = case demoteOccName main_occ of\n                              Just occ -> [occ]\n                              Nothing  -> []\n             gres = [ gre | occ <- main_occ : demoted_occs\n                          , gre <- lookupGlobalRdrEnv env occ\n                          , gre_name gre == name ]\n       ; case gres of\n           [gre] -> return (Right (gre_name gre))\n\n           []    -> -- See Note [Splicing Exact names]\n                    do { lcl_env <- getLocalRdrEnv\n                       ; if name `inLocalRdrEnvScope` lcl_env\n                         then return (Right name)\n                         else\n                         do { th_topnames_var <- fmap tcg_th_topnames getGblEnv\n                            ; th_topnames <- readTcRef th_topnames_var\n                            ; if name `elemNameSet` th_topnames\n                              then return (Right name)\n                              else return (Left exact_nm_err)\n                            }\n                       }\n           gres -> return (Left (sameNameErr gres))   -- Ugh!  See Note [Template Haskell ambiguity]\n       }\n  where\n    exact_nm_err = hang (text \"The exact Name\" <+> quotes (ppr name) <+> ptext (sLit \"is not in scope\"))\n                      2 (vcat [ text \"Probable cause: you used a unique Template Haskell name (NameU), \"\n                              , text \"perhaps via newName, but did not bind it\"\n                              , text \"If that's it, then -ddump-splices might be useful\" ])\n\nsameNameErr :: [GlobalRdrElt] -> MsgDoc\nsameNameErr [] = panic \"addSameNameErr: empty list\"\nsameNameErr gres@(_ : _)\n  = hang (text \"Same exact name in multiple name-spaces:\")\n       2 (vcat (map pp_one sorted_names) $$ th_hint)\n  where\n    sorted_names = sortWith nameSrcLoc (map gre_name gres)\n    pp_one name\n      = hang (pprNameSpace (occNameSpace (getOccName name))\n              <+> quotes (ppr name) <> comma)\n           2 (text \"declared at:\" <+> ppr (nameSrcLoc name))\n\n    th_hint = vcat [ text \"Probable cause: you bound a unique Template Haskell name (NameU),\"\n                   , text \"perhaps via newName, in different name-spaces.\"\n                   , text \"If that's it, then -ddump-splices might be useful\" ]\n\n\n-----------------------------------------------\nlookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name\n-- This is called on the method name on the left-hand side of an\n-- instance declaration binding. eg.  instance Functor T where\n--                                       fmap = ...\n--                                       ^^^^ called on this\n-- Regardless of how many unqualified fmaps are in scope, we want\n-- the one that comes from the Functor class.\n--\n-- Furthermore, note that we take no account of whether the\n-- name is only in scope qualified.  I.e. even if method op is\n-- in scope as M.op, we still allow plain 'op' on the LHS of\n-- an instance decl\n--\n-- The \"what\" parameter says \"method\" or \"associated type\",\n-- depending on what we are looking up\nlookupInstDeclBndr cls what rdr\n  = do { when (isQual rdr)\n              (addErr (badQualBndrErr rdr))\n                -- In an instance decl you aren't allowed\n                -- to use a qualified name for the method\n                -- (Although it'd make perfect sense.)\n       ; mb_name <- lookupSubBndrOcc\n                          False -- False => we don't give deprecated\n                                -- warnings when a deprecated class\n                                -- method is defined. We only warn\n                                -- when it's used\n                          cls doc rdr\n       ; case mb_name of\n           Left err -> do { addErr err; return (mkUnboundNameRdr rdr) }\n           Right nm -> return nm }\n  where\n    doc = what <+> text \"of class\" <+> quotes (ppr cls)\n\n-----------------------------------------------\nlookupFamInstName :: Maybe Name -> Located RdrName\n                  -> RnM (Located Name)\n-- Used for TyData and TySynonym family instances only,\n-- See Note [Family instance binders]\nlookupFamInstName (Just cls) tc_rdr  -- Associated type; c.f RnBinds.rnMethodBind\n  = wrapLocM (lookupInstDeclBndr cls (text \"associated type\")) tc_rdr\nlookupFamInstName Nothing tc_rdr     -- Family instance; tc_rdr is an *occurrence*\n  = lookupLocatedOccRn tc_rdr\n\n-----------------------------------------------\nlookupConstructorFields :: Name -> RnM [FieldLabel]\n-- Look up the fields of a given constructor\n--   *  For constructors from this module, use the record field env,\n--      which is itself gathered from the (as yet un-typechecked)\n--      data type decls\n--\n--    * For constructors from imported modules, use the *type* environment\n--      since imported modles are already compiled, the info is conveniently\n--      right there\n\nlookupConstructorFields con_name\n  = do  { this_mod <- getModule\n        ; if nameIsLocalOrFrom this_mod con_name then\n          do { field_env <- getRecFieldEnv\n             ; traceTc \"lookupCF\" (ppr con_name $$ ppr (lookupNameEnv field_env con_name) $$ ppr field_env)\n             ; return (lookupNameEnv field_env con_name `orElse` []) }\n          else\n          do { con <- tcLookupConLike con_name\n             ; traceTc \"lookupCF 2\" (ppr con)\n             ; return (conLikeFieldLabels con) } }\n\n\n-- In CPS style as `RnM r` is monadic\nlookupExactOrOrig :: RdrName -> (Name -> r) -> RnM r -> RnM r\nlookupExactOrOrig rdr_name res k\n  | Just n <- isExact_maybe rdr_name   -- This happens in derived code\n  = res <$> lookupExactOcc n\n  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name\n  = res <$> lookupOrig rdr_mod rdr_occ\n  | otherwise = k\n\n\n\n-----------------------------------------------\n-- | Look up an occurrence of a field in record construction or pattern\n-- matching (but not update).  When the -XDisambiguateRecordFields\n-- flag is on, take account of the data constructor name to\n-- disambiguate which field to use.\n--\n-- See Note [DisambiguateRecordFields].\nlookupRecFieldOcc :: Maybe Name -- Nothing  => just look it up as usual\n                                -- Just con => use data con to disambiguate\n                  -> RdrName\n                  -> RnM Name\nlookupRecFieldOcc mb_con rdr_name\n  | Just con <- mb_con\n  , isUnboundName con  -- Avoid error cascade\n  = return (mkUnboundNameRdr rdr_name)\n  | Just con <- mb_con\n  = do { flds <- lookupConstructorFields con\n       ; env <- getGlobalRdrEnv\n       ; let lbl      = occNameFS (rdrNameOcc rdr_name)\n             mb_field = do fl <- find ((== lbl) . flLabel) flds\n                           -- We have the label, now check it is in\n                           -- scope (with the correct qualifier if\n                           -- there is one, hence calling pickGREs).\n                           gre <- lookupGRE_FieldLabel env fl\n                           guard (not (isQual rdr_name\n                                         && null (pickGREs rdr_name [gre])))\n                           return (fl, gre)\n       ; case mb_field of\n           Just (fl, gre) -> do { addUsedGRE True gre\n                                ; return (flSelector fl) }\n           Nothing        -> lookupGlobalOccRn rdr_name }\n             -- See Note [Fall back on lookupGlobalOccRn in lookupRecFieldOcc]\n  | otherwise\n  -- This use of Global is right as we are looking up a selector which\n  -- can only be defined at the top level.\n  = lookupGlobalOccRn rdr_name\n\n{- Note [DisambiguateRecordFields]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we are looking up record fields in record construction or pattern\nmatching, we can take advantage of the data constructor name to\nresolve fields that would otherwise be ambiguous (provided the\n-XDisambiguateRecordFields flag is on).\n\nFor example, consider:\n\n   data S = MkS { x :: Int }\n   data T = MkT { x :: Int }\n\n   e = MkS { x = 3 }\n\nWhen we are renaming the occurrence of `x` in `e`, instead of looking\n`x` up directly (and finding both fields), lookupRecFieldOcc will\nsearch the fields of `MkS` to find the only possible `x` the user can\nmean.\n\nOf course, we still have to check the field is in scope, using\nlookupGRE_FieldLabel.  The handling of qualified imports is slightly\nsubtle: the occurrence may be unqualified even if the field is\nimported only qualified (but if the occurrence is qualified, the\nqualifier must be correct). For example:\n\n   module A where\n     data S = MkS { x :: Int }\n     data T = MkT { x :: Int }\n\n   module B where\n     import qualified A (S(..))\n     import A (T(MkT))\n\n     e1 = MkT   { x = 3 }   -- x not in scope, so fail\n     e2 = A.MkS { B.x = 3 } -- module qualifier is wrong, so fail\n     e3 = A.MkS { x = 3 }   -- x in scope (lack of module qualifier permitted)\n\nIn case `e1`, lookupGRE_FieldLabel will return Nothing.  In case `e2`,\nlookupGRE_FieldLabel will return the GRE for `A.x`, but then the guard\nwill fail because the field RdrName `B.x` is qualified and pickGREs\nrejects the GRE.  In case `e3`, lookupGRE_FieldLabel will return the\nGRE for `A.x` and the guard will succeed because the field RdrName `x`\nis unqualified.\n\n\nNote [Fall back on lookupGlobalOccRn in lookupRecFieldOcc]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhenever we fail to find the field or it is not in scope, mb_field\nwill be False, and we fall back on looking it up normally using\nlookupGlobalOccRn.  We don't report an error immediately because the\nactual problem might be located elsewhere.  For example (Trac #9975):\n\n   data Test = Test { x :: Int }\n   pattern Test wat = Test { x = wat }\n\nHere there are multiple declarations of Test (as a data constructor\nand as a pattern synonym), which will be reported as an error.  We\nshouldn't also report an error about the occurrence of `x` in the\npattern synonym RHS.  However, if the pattern synonym gets added to\nthe environment first, we will try and fail to find `x` amongst the\n(nonexistent) fields of the pattern synonym.\n\nAlternatively, the scope check can fail due to Template Haskell.\nConsider (Trac #12130):\n\n   module Foo where\n     import M\n     b = $(funny)\n\n   module M(funny) where\n     data T = MkT { x :: Int }\n     funny :: Q Exp\n     funny = [| MkT { x = 3 } |]\n\nWhen we splice, `MkT` is not lexically in scope, so\nlookupGRE_FieldLabel will fail.  But there is no need for\ndisambiguation anyway, because `x` is an original name, and\nlookupGlobalOccRn will find it.\n-}\n\n\n\n-- | Used in export lists to lookup the children.\nlookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName\n                        -> RnM ChildLookupResult\nlookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name\n  | isUnboundName parent\n    -- Avoid an error cascade\n  = return (FoundName NoParent (mkUnboundNameRdr rdr_name))\n\n  | otherwise = do\n  gre_env <- getGlobalRdrEnv\n\n  let original_gres = lookupGlobalRdrEnv gre_env (rdrNameOcc rdr_name)\n  -- Disambiguate the lookup based on the parent information.\n  -- The remaining GREs are things that we *could* export here, note that\n  -- this includes things which have `NoParent`. Those are sorted in\n  -- `checkPatSynParent`.\n  traceRn \"parent\" (ppr parent)\n  traceRn \"lookupExportChild original_gres:\" (ppr original_gres)\n  traceRn \"lookupExportChild picked_gres:\" (ppr $ picked_gres original_gres)\n  case picked_gres original_gres of\n    NoOccurrence ->\n      noMatchingParentErr original_gres\n    UniqueOccurrence g ->\n      if must_have_parent then noMatchingParentErr original_gres\n                          else checkFld g\n    DisambiguatedOccurrence g ->\n      checkFld g\n    AmbiguousOccurrence gres ->\n      mkNameClashErr gres\n    where\n        -- Convert into FieldLabel if necessary\n        checkFld :: GlobalRdrElt -> RnM ChildLookupResult\n        checkFld g@GRE{gre_name, gre_par} = do\n          addUsedGRE warn_if_deprec g\n          return $ case gre_par of\n            FldParent _ mfs ->\n              FoundFL  (fldParentToFieldLabel gre_name mfs)\n            _ -> FoundName gre_par gre_name\n\n        fldParentToFieldLabel :: Name -> Maybe FastString -> FieldLabel\n        fldParentToFieldLabel name mfs =\n          case mfs of\n            Nothing ->\n              let fs = occNameFS (nameOccName name)\n              in FieldLabel fs False name\n            Just fs -> FieldLabel fs True name\n\n        -- Called when we find no matching GREs after disambiguation but\n        -- there are three situations where this happens.\n        -- 1. There were none to begin with.\n        -- 2. None of the matching ones were the parent but\n        --  a. They were from an overloaded record field so we can report\n        --     a better error\n        --  b. The original lookup was actually ambiguous.\n        --     For example, the case where overloading is off and two\n        --     record fields are in scope from different record\n        --     constructors, neither of which is the parent.\n        noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult\n        noMatchingParentErr original_gres = do\n          overload_ok <- xoptM LangExt.DuplicateRecordFields\n          case original_gres of\n            [] ->  return NameNotFound\n            [g] -> return $ IncorrectParent parent\n                              (gre_name g) (ppr $ gre_name g)\n                              [p | Just p <- [getParent g]]\n            gss@(g:_:_) ->\n              if all isRecFldGRE gss && overload_ok\n                then return $\n                      IncorrectParent parent\n                        (gre_name g)\n                        (ppr $ expectJust \"noMatchingParentErr\" (greLabel g))\n                        [p | x <- gss, Just p <- [getParent x]]\n                else mkNameClashErr gss\n\n        mkNameClashErr :: [GlobalRdrElt] -> RnM ChildLookupResult\n        mkNameClashErr gres = do\n          addNameClashErrRn rdr_name gres\n          return (FoundName (gre_par (head gres)) (gre_name (head gres)))\n\n        getParent :: GlobalRdrElt -> Maybe Name\n        getParent (GRE { gre_par = p } ) =\n          case p of\n            ParentIs cur_parent -> Just cur_parent\n            FldParent { par_is = cur_parent } -> Just cur_parent\n            NoParent -> Nothing\n\n        picked_gres :: [GlobalRdrElt] -> DisambigInfo\n        -- For Unqual, find GREs that are in scope qualified or unqualified\n        -- For Qual,   find GREs that are in scope with that qualification\n        picked_gres gres\n          | isUnqual rdr_name\n          = mconcat (map right_parent gres)\n          | otherwise\n          = mconcat (map right_parent (pickGREs rdr_name gres))\n\n        right_parent :: GlobalRdrElt -> DisambigInfo\n        right_parent p\n          = case getParent p of\n               Just cur_parent\n                  | parent == cur_parent -> DisambiguatedOccurrence p\n                  | otherwise            -> NoOccurrence\n               Nothing                   -> UniqueOccurrence p\n\n\n-- This domain specific datatype is used to record why we decided it was\n-- possible that a GRE could be exported with a parent.\ndata DisambigInfo\n       = NoOccurrence\n          -- The GRE could never be exported. It has the wrong parent.\n       | UniqueOccurrence GlobalRdrElt\n          -- The GRE has no parent. It could be a pattern synonym.\n       | DisambiguatedOccurrence GlobalRdrElt\n          -- The parent of the GRE is the correct parent\n       | AmbiguousOccurrence [GlobalRdrElt]\n          -- For example, two normal identifiers with the same name are in\n          -- scope. They will both be resolved to \"UniqueOccurrence\" and the\n          -- monoid will combine them to this failing case.\n\ninstance Outputable DisambigInfo where\n  ppr NoOccurrence = text \"NoOccurence\"\n  ppr (UniqueOccurrence gre) = text \"UniqueOccurrence:\" <+> ppr gre\n  ppr (DisambiguatedOccurrence gre) = text \"DiambiguatedOccurrence:\" <+> ppr gre\n  ppr (AmbiguousOccurrence gres)    = text \"Ambiguous:\" <+> ppr gres\n\ninstance Semi.Semigroup DisambigInfo where\n  -- This is the key line: We prefer disambiguated occurrences to other\n  -- names.\n  _ <> DisambiguatedOccurrence g' = DisambiguatedOccurrence g'\n  DisambiguatedOccurrence g' <> _ = DisambiguatedOccurrence g'\n\n  NoOccurrence <> m = m\n  m <> NoOccurrence = m\n  UniqueOccurrence g <> UniqueOccurrence g'\n    = AmbiguousOccurrence [g, g']\n  UniqueOccurrence g <> AmbiguousOccurrence gs\n    = AmbiguousOccurrence (g:gs)\n  AmbiguousOccurrence gs <> UniqueOccurrence g'\n    = AmbiguousOccurrence (g':gs)\n  AmbiguousOccurrence gs <> AmbiguousOccurrence gs'\n    = AmbiguousOccurrence (gs ++ gs')\n\ninstance Monoid DisambigInfo where\n  mempty = NoOccurrence\n  mappend = (Semi.<>)\n\n-- Lookup SubBndrOcc can never be ambiguous\n--\n-- Records the result of looking up a child.\ndata ChildLookupResult\n      = NameNotFound                --  We couldn't find a suitable name\n      | IncorrectParent Name        -- Parent\n                        Name        -- Name of thing we were looking for\n                        SDoc        -- How to print the name\n                        [Name]      -- List of possible parents\n      | FoundName Parent Name       --  We resolved to a normal name\n      | FoundFL FieldLabel          --  We resolved to a FL\n\n-- | Specialised version of msum for RnM ChildLookupResult\ncombineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult\ncombineChildLookupResult [] = return NameNotFound\ncombineChildLookupResult (x:xs) = do\n  res <- x\n  case res of\n    NameNotFound -> combineChildLookupResult xs\n    _ -> return res\n\ninstance Outputable ChildLookupResult where\n  ppr NameNotFound = text \"NameNotFound\"\n  ppr (FoundName p n) = text \"Found:\" <+> ppr p <+> ppr n\n  ppr (FoundFL fls) = text \"FoundFL:\" <+> ppr fls\n  ppr (IncorrectParent p n td ns) = text \"IncorrectParent\"\n                                  <+> hsep [ppr p, ppr n, td, ppr ns]\n\nlookupSubBndrOcc :: Bool\n                 -> Name     -- Parent\n                 -> SDoc\n                 -> RdrName\n                 -> RnM (Either MsgDoc Name)\n-- Find all the things the rdr-name maps to\n-- and pick the one with the right parent namep\nlookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do\n  res <-\n    lookupExactOrOrig rdr_name (FoundName NoParent) $\n      -- This happens for built-in classes, see mod052 for example\n      lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name\n  case res of\n    NameNotFound -> return (Left (unknownSubordinateErr doc rdr_name))\n    FoundName _p n -> return (Right n)\n    FoundFL fl  ->  return (Right (flSelector fl))\n    IncorrectParent {}\n         -- See [Mismatched class methods and associated type families]\n         -- in TcInstDecls.\n      -> return $ Left (unknownSubordinateErr doc rdr_name)\n\n{-\nNote [Family instance binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data family F a\n  data instance F T = X1 | X2\n\nThe 'data instance' decl has an *occurrence* of F (and T), and *binds*\nX1 and X2.  (This is unlike a normal data type declaration which would\nbind F too.)  So we want an AvailTC F [X1,X2].\n\nNow consider a similar pair:\n  class C a where\n    data G a\n  instance C S where\n    data G S = Y1 | Y2\n\nThe 'data G S' *binds* Y1 and Y2, and has an *occurrence* of G.\n\nBut there is a small complication: in an instance decl, we don't use\nqualified names on the LHS; instead we use the class to disambiguate.\nThus:\n  module M where\n    import Blib( G )\n    class C a where\n      data G a\n    instance C S where\n      data G S = Y1 | Y2\nEven though there are two G's in scope (M.G and Blib.G), the occurrence\nof 'G' in the 'instance C S' decl is unambiguous, because C has only\none associated type called G. This is exactly what happens for methods,\nand it is only consistent to do the same thing for types. That's the\nrole of the function lookupTcdName; the (Maybe Name) give the class of\nthe encloseing instance decl, if any.\n\nNote [Looking up Exact RdrNames]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nExact RdrNames are generated by Template Haskell.  See Note [Binders\nin Template Haskell] in Convert.\n\nFor data types and classes have Exact system Names in the binding\npositions for constructors, TyCons etc.  For example\n    [d| data T = MkT Int |]\nwhen we splice in and Convert to HsSyn RdrName, we'll get\n    data (Exact (system Name \"T\")) = (Exact (system Name \"MkT\")) ...\nThese System names are generated by Convert.thRdrName\n\nBut, constructors and the like need External Names, not System Names!\nSo we do the following\n\n * In RnEnv.newTopSrcBinder we spot Exact RdrNames that wrap a\n   non-External Name, and make an External name for it. This is\n   the name that goes in the GlobalRdrEnv\n\n * When looking up an occurrence of an Exact name, done in\n   RnEnv.lookupExactOcc, we find the Name with the right unique in the\n   GlobalRdrEnv, and use the one from the envt -- it will be an\n   External Name in the case of the data type/constructor above.\n\n * Exact names are also use for purely local binders generated\n   by TH, such as    \\x_33. x_33\n   Both binder and occurrence are Exact RdrNames.  The occurrence\n   gets looked up in the LocalRdrEnv by RnEnv.lookupOccRn, and\n   misses, because lookupLocalRdrEnv always returns Nothing for\n   an Exact Name.  Now we fall through to lookupExactOcc, which\n   will find the Name is not in the GlobalRdrEnv, so we just use\n   the Exact supplied Name.\n\nNote [Splicing Exact names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the splice $(do { x <- newName \"x\"; return (VarE x) })\nThis will generate a (HsExpr RdrName) term that mentions the\nExact RdrName \"x_56\" (or whatever), but does not bind it.  So\nwhen looking such Exact names we want to check that it's in scope,\notherwise the type checker will get confused.  To do this we need to\nkeep track of all the Names in scope, and the LocalRdrEnv does just that;\nwe consult it with RdrName.inLocalRdrEnvScope.\n\nThere is another wrinkle.  With TH and -XDataKinds, consider\n   $( [d| data Nat = Zero\n          data T = MkT (Proxy 'Zero)  |] )\nAfter splicing, but before renaming we get this:\n   data Nat_77{tc} = Zero_78{d}\n   data T_79{tc} = MkT_80{d} (Proxy 'Zero_78{tc})  |] )\nThe occurrence of 'Zero in the data type for T has the right unique,\nbut it has a TcClsName name-space in its OccName.  (This is set by\nthe ctxt_ns argument of Convert.thRdrName.)  When we check that is\nin scope in the GlobalRdrEnv, we need to look up the DataName namespace\ntoo.  (An alternative would be to make the GlobalRdrEnv also have\na Name -> GRE mapping.)\n\nNote [Template Haskell ambiguity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe GlobalRdrEnv invariant says that if\n  occ -> [gre1, ..., gren]\nthen the gres have distinct Names (INVARIANT 1 of GlobalRdrEnv).\nThis is guaranteed by extendGlobalRdrEnvRn (the dups check in add_gre).\n\nSo how can we get multiple gres in lookupExactOcc_maybe?  Because in\nTH we might use the same TH NameU in two different name spaces.\neg (Trac #7241):\n   $(newName \"Foo\" >>= \\o -> return [DataD [] o [] [RecC o []] [''Show]])\nHere we generate a type constructor and data constructor with the same\nunique, but different name spaces.\n\nIt'd be nicer to rule this out in extendGlobalRdrEnvRn, but that would\nmean looking up the OccName in every name-space, just in case, and that\nseems a bit brutal.  So it's just done here on lookup.  But we might\nneed to revisit that choice.\n\nNote [Usage for sub-bndrs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf you have this\n   import qualified M( C( f ) )\n   instance M.C T where\n     f x = x\nthen is the qualified import M.f used?  Obviously yes.\nBut the RdrName used in the instance decl is unqualified.  In effect,\nwe fill in the qualification by looking for f's whose class is M.C\nBut when adding to the UsedRdrNames we must make that qualification\nexplicit (saying \"used  M.f\"), otherwise we get \"Redundant import of M.f\".\n\nSo we make up a suitable (fake) RdrName.  But be careful\n   import qualified M\n   import M( C(f) )\n   instance C T where\n     f x = x\nHere we want to record a use of 'f', not of 'M.f', otherwise\nwe'll miss the fact that the qualified import is redundant.\n\n--------------------------------------------------\n--              Occurrences\n--------------------------------------------------\n-}\n\n\nlookupLocatedOccRn :: Located RdrName -> RnM (Located Name)\nlookupLocatedOccRn = wrapLocM lookupOccRn\n\nlookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)\n-- Just look in the local environment\nlookupLocalOccRn_maybe rdr_name\n  = do { local_env <- getLocalRdrEnv\n       ; return (lookupLocalRdrEnv local_env rdr_name) }\n\nlookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevel))\n-- Just look in the local environment\nlookupLocalOccThLvl_maybe name\n  = do { lcl_env <- getLclEnv\n       ; return (lookupNameEnv (tcl_th_bndrs lcl_env) name) }\n\n-- lookupOccRn looks up an occurrence of a RdrName\nlookupOccRn :: RdrName -> RnM Name\nlookupOccRn rdr_name\n  = do { mb_name <- lookupOccRn_maybe rdr_name\n       ; case mb_name of\n           Just name -> return name\n           Nothing   -> reportUnboundName rdr_name }\n\n-- Only used in one place, to rename pattern synonym binders.\n-- See Note [Renaming pattern synonym variables] in RnBinds\nlookupLocalOccRn :: RdrName -> RnM Name\nlookupLocalOccRn rdr_name\n  = do { mb_name <- lookupLocalOccRn_maybe rdr_name\n       ; case mb_name of\n           Just name -> return name\n           Nothing   -> unboundName WL_LocalOnly rdr_name }\n\n-- lookupPromotedOccRn looks up an optionally promoted RdrName.\nlookupTypeOccRn :: RdrName -> RnM Name\n-- see Note [Demotion]\nlookupTypeOccRn rdr_name\n  | isVarOcc (rdrNameOcc rdr_name)  -- See Note [Promoted variables in types]\n  = badVarInType rdr_name\n  | otherwise\n  = do { mb_name <- lookupOccRn_maybe rdr_name\n       ; case mb_name of\n             Just name -> return name\n             Nothing   -> lookup_demoted rdr_name }\n\nlookup_demoted :: RdrName -> RnM Name\nlookup_demoted rdr_name\n  | Just demoted_rdr <- demoteRdrName rdr_name\n    -- Maybe it's the name of a *data* constructor\n  = do { data_kinds <- xoptM LangExt.DataKinds\n       ; star_is_type <- xoptM LangExt.StarIsType\n       ; let star_info = starInfo star_is_type rdr_name\n       ; if data_kinds\n            then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr\n                    ; case mb_demoted_name of\n                        Nothing -> unboundNameX WL_Any rdr_name star_info\n                        Just demoted_name ->\n                          do { whenWOptM Opt_WarnUntickedPromotedConstructors $\n                               addWarn\n                                 (Reason Opt_WarnUntickedPromotedConstructors)\n                                 (untickedPromConstrWarn demoted_name)\n                             ; return demoted_name } }\n            else do { -- We need to check if a data constructor of this name is\n                      -- in scope to give good error messages. However, we do\n                      -- not want to give an additional error if the data\n                      -- constructor happens to be out of scope! See #13947.\n                      mb_demoted_name <- discardErrs $\n                                         lookupOccRn_maybe demoted_rdr\n                    ; let suggestion | isJust mb_demoted_name = suggest_dk\n                                     | otherwise = star_info\n                    ; unboundNameX WL_Any rdr_name suggestion } }\n\n  | otherwise\n  = reportUnboundName rdr_name\n\n  where\n    suggest_dk = text \"A data constructor of that name is in scope; did you mean DataKinds?\"\n    untickedPromConstrWarn name =\n      text \"Unticked promoted constructor\" <> colon <+> quotes (ppr name) <> dot\n      $$\n      hsep [ text \"Use\"\n           , quotes (char '\\'' <> ppr name)\n           , text \"instead of\"\n           , quotes (ppr name) <> dot ]\n\nbadVarInType :: RdrName -> RnM Name\nbadVarInType rdr_name\n  = do { addErr (text \"Illegal promoted term variable in a type:\"\n                 <+> ppr rdr_name)\n       ; return (mkUnboundNameRdr rdr_name) }\n\n{- Note [Promoted variables in types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this (Trac #12686):\n   x = True\n   data Bad = Bad 'x\n\nThe parser treats the quote in 'x as saying \"use the term\nnamespace\", so we'll get (Bad x{v}), with 'x' in the\nVarName namespace.  If we don't test for this, the renamer\nwill happily rename it to the x bound at top level, and then\nthe typecheck falls over because it doesn't have 'x' in scope\nwhen kind-checking.\n\nNote [Demotion]\n~~~~~~~~~~~~~~~\nWhen the user writes:\n  data Nat = Zero | Succ Nat\n  foo :: f Zero -> Int\n\n'Zero' in the type signature of 'foo' is parsed as:\n  HsTyVar (\"Zero\", TcClsName)\n\nWhen the renamer hits this occurrence of 'Zero' it's going to realise\nthat it's not in scope. But because it is renaming a type, it knows\nthat 'Zero' might be a promoted data constructor, so it will demote\nits namespace to DataName and do a second lookup.\n\nThe final result (after the renamer) will be:\n  HsTyVar (\"Zero\", DataName)\n-}\n\nlookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName\n                   -> RnM (Maybe r)\nlookupOccRnX_maybe globalLookup wrapper rdr_name\n  = runMaybeT . msum . map MaybeT $\n      [ fmap wrapper <$> lookupLocalOccRn_maybe rdr_name\n      , globalLookup rdr_name ]\n\nlookupOccRn_maybe :: RdrName -> RnM (Maybe Name)\nlookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id\n\nlookupOccRn_overloaded :: Bool -> RdrName\n                       -> RnM (Maybe (Either Name [Name]))\nlookupOccRn_overloaded overload_ok\n  = lookupOccRnX_maybe global_lookup Left\n      where\n        global_lookup :: RdrName -> RnM (Maybe (Either Name [Name]))\n        global_lookup n =\n          runMaybeT . msum . map MaybeT $\n            [ lookupGlobalOccRn_overloaded overload_ok n\n            , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ]\n\n\n\nlookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)\n-- Looks up a RdrName occurrence in the top-level\n--   environment, including using lookupQualifiedNameGHCi\n--   for the GHCi case\n-- No filter function; does not report an error on failure\n-- Uses addUsedRdrName to record use and deprecations\nlookupGlobalOccRn_maybe rdr_name =\n  lookupExactOrOrig rdr_name Just $\n    runMaybeT . msum . map MaybeT $\n      [ fmap gre_name <$> lookupGreRn_maybe rdr_name\n      , listToMaybe <$> lookupQualifiedNameGHCi rdr_name ]\n                      -- This test is not expensive,\n                      -- and only happens for failed lookups\n\nlookupGlobalOccRn :: RdrName -> RnM Name\n-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global\n-- environment.  Adds an error message if the RdrName is not in scope.\n-- You usually want to use \"lookupOccRn\" which also looks in the local\n-- environment.\nlookupGlobalOccRn rdr_name\n  = do { mb_name <- lookupGlobalOccRn_maybe rdr_name\n       ; case mb_name of\n           Just n  -> return n\n           Nothing -> do { traceRn \"lookupGlobalOccRn\" (ppr rdr_name)\n                         ; unboundName WL_Global rdr_name } }\n\nlookupInfoOccRn :: RdrName -> RnM [Name]\n-- lookupInfoOccRn is intended for use in GHCi's \":info\" command\n-- It finds all the GREs that RdrName could mean, not complaining\n-- about ambiguity, but rather returning them all\n-- C.f. Trac #9881\nlookupInfoOccRn rdr_name =\n  lookupExactOrOrig rdr_name (:[]) $\n    do { rdr_env <- getGlobalRdrEnv\n       ; let ns = map gre_name (lookupGRE_RdrName rdr_name rdr_env)\n       ; qual_ns <- lookupQualifiedNameGHCi rdr_name\n       ; return (ns ++ (qual_ns `minusList` ns)) }\n\n-- | Like 'lookupOccRn_maybe', but with a more informative result if\n-- the 'RdrName' happens to be a record selector:\n--\n--   * Nothing         -> name not in scope (no error reported)\n--   * Just (Left x)   -> name uniquely refers to x,\n--                        or there is a name clash (reported)\n--   * Just (Right xs) -> name refers to one or more record selectors;\n--                        if overload_ok was False, this list will be\n--                        a singleton.\n\nlookupGlobalOccRn_overloaded :: Bool -> RdrName\n                             -> RnM (Maybe (Either Name [Name]))\nlookupGlobalOccRn_overloaded overload_ok rdr_name =\n  lookupExactOrOrig rdr_name (Just . Left) $\n     do  { res <- lookupGreRn_helper rdr_name\n         ; case res of\n                GreNotFound  -> return Nothing\n                OneNameMatch gre -> do\n                  let wrapper = if isRecFldGRE gre then Right . (:[]) else Left\n                  return $ Just (wrapper (gre_name gre))\n                MultipleNames gres  | all isRecFldGRE gres && overload_ok ->\n                  -- Don't record usage for ambiguous selectors\n                  -- until we know which is meant\n                  return $ Just (Right (map gre_name gres))\n                MultipleNames gres  -> do\n                  addNameClashErrRn rdr_name gres\n                  return (Just (Left (gre_name (head gres)))) }\n\n\n--------------------------------------------------\n--      Lookup in the Global RdrEnv of the module\n--------------------------------------------------\n\ndata GreLookupResult = GreNotFound\n                     | OneNameMatch GlobalRdrElt\n                     | MultipleNames [GlobalRdrElt]\n\nlookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)\n-- Look up the RdrName in the GlobalRdrEnv\n--   Exactly one binding: records it as \"used\", return (Just gre)\n--   No bindings:         return Nothing\n--   Many bindings:       report \"ambiguous\", return an arbitrary (Just gre)\n-- Uses addUsedRdrName to record use and deprecations\nlookupGreRn_maybe rdr_name\n  = do\n      res <- lookupGreRn_helper rdr_name\n      case res of\n        OneNameMatch gre ->  return $ Just gre\n        MultipleNames gres -> do\n          traceRn \"lookupGreRn_maybe:NameClash\" (ppr gres)\n          addNameClashErrRn rdr_name gres\n          return $ Just (head gres)\n        GreNotFound -> return Nothing\n\n{-\n\nNote [ Unbound vs Ambiguous Names ]\n\nlookupGreRn_maybe deals with failures in two different ways. If a name\nis unbound then we return a `Nothing` but if the name is ambiguous\nthen we raise an error and return a dummy name.\n\nThe reason for this is that when we call `lookupGreRn_maybe` we are\nspeculatively looking for whatever we are looking up. If we don't find it,\nthen we might have been looking for the wrong thing and can keep trying.\nOn the other hand, if we find a clash then there is no way to recover as\nwe found the thing we were looking for but can no longer resolve which\nthe correct one is.\n\nOne example of this is in `lookupTypeOccRn` which first looks in the type\nconstructor namespace before looking in the data constructor namespace to\ndeal with `DataKinds`.\n\nThere is however, as always, one exception to this scheme. If we find\nan ambiguous occurence of a record selector and DuplicateRecordFields\nis enabled then we defer the selection until the typechecker.\n\n-}\n\n\n\n\n-- Internal Function\nlookupGreRn_helper :: RdrName -> RnM GreLookupResult\nlookupGreRn_helper rdr_name\n  = do  { env <- getGlobalRdrEnv\n        ; case lookupGRE_RdrName rdr_name env of\n            []    -> return GreNotFound\n            [gre] -> do { addUsedGRE True gre\n                        ; return (OneNameMatch gre) }\n            gres  -> return (MultipleNames gres) }\n\nlookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)\n-- Used in export lists\n-- If not found or ambiguous, add error message, and fake with UnboundName\n-- Uses addUsedRdrName to record use and deprecations\nlookupGreAvailRn rdr_name\n  = do\n      mb_gre <- lookupGreRn_helper rdr_name\n      case mb_gre of\n        GreNotFound ->\n          do\n            traceRn \"lookupGreAvailRn\" (ppr rdr_name)\n            name <- unboundName WL_Global rdr_name\n            return (name, avail name)\n        MultipleNames gres ->\n          do\n            addNameClashErrRn rdr_name gres\n            let unbound_name = mkUnboundNameRdr rdr_name\n            return (unbound_name, avail unbound_name)\n                        -- Returning an unbound name here prevents an error\n                        -- cascade\n        OneNameMatch gre ->\n          return (gre_name gre, availFromGRE gre)\n\n\n{-\n*********************************************************\n*                                                      *\n                Deprecations\n*                                                      *\n*********************************************************\n\nNote [Handling of deprecations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* We report deprecations at each *occurrence* of the deprecated thing\n  (see Trac #5867)\n\n* We do not report deprecations for locally-defined names. For a\n  start, we may be exporting a deprecated thing. Also we may use a\n  deprecated thing in the defn of another deprecated things.  We may\n  even use a deprecated thing in the defn of a non-deprecated thing,\n  when changing a module's interface.\n\n* addUsedGREs: we do not report deprecations for sub-binders:\n     - the \"..\" completion for records\n     - the \"..\" in an export item 'T(..)'\n     - the things exported by a module export 'module M'\n-}\n\naddUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()\n-- Remember use of in-scope data constructors (Trac #7969)\naddUsedDataCons rdr_env tycon\n  = addUsedGREs [ gre\n                | dc <- tyConDataCons tycon\n                , Just gre <- [lookupGRE_Name rdr_env (dataConName dc)] ]\n\naddUsedGRE :: Bool -> GlobalRdrElt -> RnM ()\n-- Called for both local and imported things\n-- Add usage *and* warn if deprecated\naddUsedGRE warn_if_deprec gre\n  = do { when warn_if_deprec (warnIfDeprecated gre)\n       ; unless (isLocalGRE gre) $\n         do { env <- getGblEnv\n            ; traceRn \"addUsedGRE\" (ppr gre)\n            ; updMutVar (tcg_used_gres env) (gre :) } }\n\naddUsedGREs :: [GlobalRdrElt] -> RnM ()\n-- Record uses of any *imported* GREs\n-- Used for recording used sub-bndrs\n-- NB: no call to warnIfDeprecated; see Note [Handling of deprecations]\naddUsedGREs gres\n  | null imp_gres = return ()\n  | otherwise     = do { env <- getGblEnv\n                       ; traceRn \"addUsedGREs\" (ppr imp_gres)\n                       ; updMutVar (tcg_used_gres env) (imp_gres ++) }\n  where\n    imp_gres = filterOut isLocalGRE gres\n\nwarnIfDeprecated :: GlobalRdrElt -> RnM ()\nwarnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss })\n  | (imp_spec : _) <- iss\n  = do { dflags <- getDynFlags\n       ; this_mod <- getModule\n       ; when (wopt Opt_WarnWarningsDeprecations dflags &&\n               not (nameIsLocalOrFrom this_mod name)) $\n                   -- See Note [Handling of deprecations]\n         do { iface <- loadInterfaceForName doc name\n            ; case lookupImpDeprec iface gre of\n                Just txt -> addWarn (Reason Opt_WarnWarningsDeprecations)\n                                   (mk_msg imp_spec txt)\n                Nothing  -> return () } }\n  | otherwise\n  = return ()\n  where\n    occ = greOccName gre\n    name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name\n    doc = text \"The name\" <+> quotes (ppr occ) <+> ptext (sLit \"is mentioned explicitly\")\n\n    mk_msg imp_spec txt\n      = sep [ sep [ text \"In the use of\"\n                    <+> pprNonVarNameSpace (occNameSpace occ)\n                    <+> quotes (ppr occ)\n                  , parens imp_msg <> colon ]\n            , pprWarningTxtForMsg txt ]\n      where\n        imp_mod  = importSpecModule imp_spec\n        imp_msg  = text \"imported from\" <+> ppr imp_mod <> extra\n        extra | imp_mod == moduleName name_mod = Outputable.empty\n              | otherwise = text \", but defined in\" <+> ppr name_mod\n\nlookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt\nlookupImpDeprec iface gre\n  = mi_warn_fn iface (greOccName gre) `mplus`  -- Bleat if the thing,\n    case gre_par gre of                      -- or its parent, is warn'd\n       ParentIs  p              -> mi_warn_fn iface (nameOccName p)\n       FldParent { par_is = p } -> mi_warn_fn iface (nameOccName p)\n       NoParent                 -> Nothing\n\n{-\nNote [Used names with interface not loaded]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's (just) possible to find a used\nName whose interface hasn't been loaded:\n\na) It might be a WiredInName; in that case we may not load\n   its interface (although we could).\n\nb) It might be GHC.Real.fromRational, or GHC.Num.fromInteger\n   These are seen as \"used\" by the renamer (if -XRebindableSyntax)\n   is on), but the typechecker may discard their uses\n   if in fact the in-scope fromRational is GHC.Read.fromRational,\n   (see tcPat.tcOverloadedLit), and the typechecker sees that the type\n   is fixed, say, to GHC.Base.Float (see Inst.lookupSimpleInst).\n   In that obscure case it won't force the interface in.\n\nIn both cases we simply don't permit deprecations;\nthis is, after all, wired-in stuff.\n\n\n*********************************************************\n*                                                      *\n                GHCi support\n*                                                      *\n*********************************************************\n\nA qualified name on the command line can refer to any module at\nall: we try to load the interface if we don't already have it, just\nas if there was an \"import qualified M\" declaration for every\nmodule.\n\nFor example, writing `Data.List.sort` will load the interface file for\n`Data.List` as if the user had written `import qualified Data.List`.\n\nIf we fail we just return Nothing, rather than bleating\nabout \"attempting to use module \u00e2\u20ac\u02dcD\u00e2\u20ac\u2122 (./D.hs) which is not loaded\"\nwhich is what loadSrcInterface does.\n\nIt is enabled by default and disabled by the flag\n`-fno-implicit-import-qualified`.\n\nNote [Safe Haskell and GHCi]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe DON'T do this Safe Haskell as we need to check imports. We can\nand should instead check the qualified import but at the moment\nthis requires some refactoring so leave as a TODO\n-}\n\n\n\nlookupQualifiedNameGHCi :: RdrName -> RnM [Name]\nlookupQualifiedNameGHCi rdr_name\n  = -- We want to behave as we would for a source file import here,\n    -- and respect hiddenness of modules/packages, hence loadSrcInterface.\n    do { dflags  <- getDynFlags\n       ; is_ghci <- getIsGHCi\n       ; go_for_it dflags is_ghci }\n\n  where\n    go_for_it dflags is_ghci\n      | Just (mod,occ) <- isQual_maybe rdr_name\n      , is_ghci\n      , gopt Opt_ImplicitImportQualified dflags   -- Enables this GHCi behaviour\n      , not (safeDirectImpsReq dflags)            -- See Note [Safe Haskell and GHCi]\n      = do { res <- loadSrcInterface_maybe doc mod False Nothing\n           ; case res of\n                Succeeded iface\n                  -> return [ name\n                            | avail <- mi_exports iface\n                            , name  <- availNames avail\n                            , nameOccName name == occ ]\n\n                _ -> -- Either we couldn't load the interface, or\n                     -- we could but we didn't find the name in it\n                     do { traceRn \"lookupQualifiedNameGHCi\" (ppr rdr_name)\n                        ; return [] } }\n\n      | otherwise\n      = do { traceRn \"lookupQualifiedNameGHCi: off\" (ppr rdr_name)\n           ; return [] }\n\n    doc = text \"Need to find\" <+> ppr rdr_name\n\n{-\nNote [Looking up signature names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nlookupSigOccRn is used for type signatures and pragmas\nIs this valid?\n  module A\n        import M( f )\n        f :: Int -> Int\n        f x = x\nIt's clear that the 'f' in the signature must refer to A.f\nThe Haskell98 report does not stipulate this, but it will!\nSo we must treat the 'f' in the signature in the same way\nas the binding occurrence of 'f', using lookupBndrRn\n\nHowever, consider this case:\n        import M( f )\n        f :: Int -> Int\n        g x = x\nWe don't want to say 'f' is out of scope; instead, we want to\nreturn the imported 'f', so that later on the reanamer will\ncorrectly report \"misplaced type sig\".\n\nNote [Signatures for top level things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ndata HsSigCtxt = ... | TopSigCtxt NameSet | ....\n\n* The NameSet says what is bound in this group of bindings.\n  We can't use isLocalGRE from the GlobalRdrEnv, because of this:\n       f x = x\n       $( ...some TH splice... )\n       f :: Int -> Int\n  When we encounter the signature for 'f', the binding for 'f'\n  will be in the GlobalRdrEnv, and will be a LocalDef. Yet the\n  signature is mis-placed\n\n* For type signatures the NameSet should be the names bound by the\n  value bindings; for fixity declarations, the NameSet should also\n  include class sigs and record selectors\n\n      infix 3 `f`          -- Yes, ok\n      f :: C a => a -> a   -- No, not ok\n      class C a where\n        f :: a -> a\n-}\n\ndata HsSigCtxt\n  = TopSigCtxt NameSet       -- At top level, binding these names\n                             -- See Note [Signatures for top level things]\n  | LocalBindCtxt NameSet    -- In a local binding, binding these names\n  | ClsDeclCtxt   Name       -- Class decl for this class\n  | InstDeclCtxt  NameSet    -- Instance decl whose user-written method\n                             -- bindings are for these methods\n  | HsBootCtxt NameSet       -- Top level of a hs-boot file, binding these names\n  | RoleAnnotCtxt NameSet    -- A role annotation, with the names of all types\n                             -- in the group\n\ninstance Outputable HsSigCtxt where\n    ppr (TopSigCtxt ns) = text \"TopSigCtxt\" <+> ppr ns\n    ppr (LocalBindCtxt ns) = text \"LocalBindCtxt\" <+> ppr ns\n    ppr (ClsDeclCtxt n) = text \"ClsDeclCtxt\" <+> ppr n\n    ppr (InstDeclCtxt ns) = text \"InstDeclCtxt\" <+> ppr ns\n    ppr (HsBootCtxt ns) = text \"HsBootCtxt\" <+> ppr ns\n    ppr (RoleAnnotCtxt ns) = text \"RoleAnnotCtxt\" <+> ppr ns\n\nlookupSigOccRn :: HsSigCtxt\n               -> Sig GhcPs\n               -> Located RdrName -> RnM (Located Name)\nlookupSigOccRn ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig)\n\n-- | Lookup a name in relation to the names in a 'HsSigCtxt'\nlookupSigCtxtOccRn :: HsSigCtxt\n                   -> SDoc         -- ^ description of thing we're looking up,\n                                   -- like \"type family\"\n                   -> Located RdrName -> RnM (Located Name)\nlookupSigCtxtOccRn ctxt what\n  = wrapLocM $ \\ rdr_name ->\n    do { mb_name <- lookupBindGroupOcc ctxt what rdr_name\n       ; case mb_name of\n           Left err   -> do { addErr err; return (mkUnboundNameRdr rdr_name) }\n           Right name -> return name }\n\nlookupBindGroupOcc :: HsSigCtxt\n                   -> SDoc\n                   -> RdrName -> RnM (Either MsgDoc Name)\n-- Looks up the RdrName, expecting it to resolve to one of the\n-- bound names passed in.  If not, return an appropriate error message\n--\n-- See Note [Looking up signature names]\nlookupBindGroupOcc ctxt what rdr_name\n  | Just n <- isExact_maybe rdr_name\n  = lookupExactOcc_either n   -- allow for the possibility of missing Exacts;\n                              -- see Note [dataTcOccs and Exact Names]\n      -- Maybe we should check the side conditions\n      -- but it's a pain, and Exact things only show\n      -- up when you know what you are doing\n\n  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name\n  = do { n' <- lookupOrig rdr_mod rdr_occ\n       ; return (Right n') }\n\n  | otherwise\n  = case ctxt of\n      HsBootCtxt ns    -> lookup_top (`elemNameSet` ns)\n      TopSigCtxt ns    -> lookup_top (`elemNameSet` ns)\n      RoleAnnotCtxt ns -> lookup_top (`elemNameSet` ns)\n      LocalBindCtxt ns -> lookup_group ns\n      ClsDeclCtxt  cls -> lookup_cls_op cls\n      InstDeclCtxt ns  -> lookup_top (`elemNameSet` ns)\n  where\n    lookup_cls_op cls\n      = lookupSubBndrOcc True cls doc rdr_name\n      where\n        doc = text \"method of class\" <+> quotes (ppr cls)\n\n    lookup_top keep_me\n      = do { env <- getGlobalRdrEnv\n           ; let all_gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)\n           ; case filter (keep_me . gre_name) all_gres of\n               [] | null all_gres -> bale_out_with Outputable.empty\n                  | otherwise     -> bale_out_with local_msg\n               (gre:_)            -> return (Right (gre_name gre)) }\n\n    lookup_group bound_names  -- Look in the local envt (not top level)\n      = do { mname <- lookupLocalOccRn_maybe rdr_name\n           ; case mname of\n               Just n\n                 | n `elemNameSet` bound_names -> return (Right n)\n                 | otherwise                   -> bale_out_with local_msg\n               Nothing                         -> bale_out_with Outputable.empty }\n\n    bale_out_with msg\n        = return (Left (sep [ text \"The\" <+> what\n                                <+> text \"for\" <+> quotes (ppr rdr_name)\n                           , nest 2 $ text \"lacks an accompanying binding\"]\n                       $$ nest 2 msg))\n\n    local_msg = parens $ text \"The\"  <+> what <+> ptext (sLit \"must be given where\")\n                           <+> quotes (ppr rdr_name) <+> text \"is declared\"\n\n\n---------------\nlookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]\n-- GHC extension: look up both the tycon and data con or variable.\n-- Used for top-level fixity signatures and deprecations.\n-- Complain if neither is in scope.\n-- See Note [Fixity signature lookup]\nlookupLocalTcNames ctxt what rdr_name\n  = do { mb_gres <- mapM lookup (dataTcOccs rdr_name)\n       ; let (errs, names) = partitionEithers mb_gres\n       ; when (null names) $ addErr (head errs) -- Bleat about one only\n       ; return names }\n  where\n    lookup rdr = do { this_mod <- getModule\n                    ; nameEither <- lookupBindGroupOcc ctxt what rdr\n                    ; return (guard_builtin_syntax this_mod rdr nameEither) }\n\n    -- Guard against the built-in syntax (ex: `infixl 6 :`), see #15233\n    guard_builtin_syntax this_mod rdr (Right name)\n      | Just _ <- isBuiltInOcc_maybe (occName rdr)\n      , this_mod /= nameModule name\n      = Left (hsep [text \"Illegal\", what, text \"of built-in syntax:\", ppr rdr])\n      | otherwise\n      = Right (rdr, name)\n    guard_builtin_syntax _ _ (Left err) = Left err\n\ndataTcOccs :: RdrName -> [RdrName]\n-- Return both the given name and the same name promoted to the TcClsName\n-- namespace.  This is useful when we aren't sure which we are looking at.\n-- See also Note [dataTcOccs and Exact Names]\ndataTcOccs rdr_name\n  | isDataOcc occ || isVarOcc occ\n  = [rdr_name, rdr_name_tc]\n  | otherwise\n  = [rdr_name]\n  where\n    occ = rdrNameOcc rdr_name\n    rdr_name_tc = setRdrNameSpace rdr_name tcName\n\n{-\nNote [dataTcOccs and Exact Names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nExact RdrNames can occur in code generated by Template Haskell, and generally\nthose references are, well, exact. However, the TH `Name` type isn't expressive\nenough to always track the correct namespace information, so we sometimes get\nthe right Unique but wrong namespace. Thus, we still have to do the double-lookup\nfor Exact RdrNames.\n\nThere is also an awkward situation for built-in syntax. Example in GHCi\n   :info []\nThis parses as the Exact RdrName for nilDataCon, but we also want\nthe list type constructor.\n\nNote that setRdrNameSpace on an Exact name requires the Name to be External,\nwhich it always is for built in syntax.\n-}\n\n\n\n{-\n************************************************************************\n*                                                                      *\n                        Rebindable names\n        Dealing with rebindable syntax is driven by the\n        Opt_RebindableSyntax dynamic flag.\n\n        In \"deriving\" code we don't want to use rebindable syntax\n        so we switch off the flag locally\n\n*                                                                      *\n************************************************************************\n\nHaskell 98 says that when you say \"3\" you get the \"fromInteger\" from the\nStandard Prelude, regardless of what is in scope.   However, to experiment\nwith having a language that is less coupled to the standard prelude, we're\ntrying a non-standard extension that instead gives you whatever \"Prelude.fromInteger\"\nhappens to be in scope.  Then you can\n        import Prelude ()\n        import MyPrelude as Prelude\nto get the desired effect.\n\nAt the moment this just happens for\n  * fromInteger, fromRational on literals (in expressions and patterns)\n  * negate (in expressions)\n  * minus  (arising from n+k patterns)\n  * \"do\" notation\n\nWe store the relevant Name in the HsSyn tree, in\n  * HsIntegral/HsFractional/HsIsString\n  * NegApp\n  * NPlusKPat\n  * HsDo\nrespectively.  Initially, we just store the \"standard\" name (PrelNames.fromIntegralName,\nfromRationalName etc), but the renamer changes this to the appropriate user\nname if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.\n\nWe treat the original (standard) names as free-vars too, because the type checker\nchecks the type of the user thing against the type of the standard thing.\n-}\n\nlookupIfThenElse :: RnM (Maybe (SyntaxExpr GhcRn), FreeVars)\n-- Different to lookupSyntaxName because in the non-rebindable\n-- case we desugar directly rather than calling an existing function\n-- Hence the (Maybe (SyntaxExpr GhcRn)) return type\nlookupIfThenElse\n  = do { rebindable_on <- xoptM LangExt.RebindableSyntax\n       ; if not rebindable_on\n         then return (Nothing, emptyFVs)\n         else do { ite <- lookupOccRn (mkVarUnqual (fsLit \"ifThenElse\"))\n                 ; return ( Just (mkRnSyntaxExpr ite)\n                          , unitFV ite ) } }\n\nlookupSyntaxName' :: Name          -- ^ The standard name\n                  -> RnM Name      -- ^ Possibly a non-standard name\nlookupSyntaxName' std_name\n  = do { rebindable_on <- xoptM LangExt.RebindableSyntax\n       ; if not rebindable_on then\n           return std_name\n         else\n            -- Get the similarly named thing from the local environment\n           lookupOccRn (mkRdrUnqual (nameOccName std_name)) }\n\nlookupSyntaxName :: Name                             -- The standard name\n                 -> RnM (SyntaxExpr GhcRn, FreeVars) -- Possibly a non-standard\n                                                     -- name\nlookupSyntaxName std_name\n  = do { rebindable_on <- xoptM LangExt.RebindableSyntax\n       ; if not rebindable_on then\n           return (mkRnSyntaxExpr std_name, emptyFVs)\n         else\n            -- Get the similarly named thing from the local environment\n           do { usr_name <- lookupOccRn (mkRdrUnqual (nameOccName std_name))\n              ; return (mkRnSyntaxExpr usr_name, unitFV usr_name) } }\n\nlookupSyntaxNames :: [Name]                         -- Standard names\n     -> RnM ([HsExpr GhcRn], FreeVars) -- See comments with HsExpr.ReboundNames\n   -- this works with CmdTop, which wants HsExprs, not SyntaxExprs\nlookupSyntaxNames std_names\n  = do { rebindable_on <- xoptM LangExt.RebindableSyntax\n       ; if not rebindable_on then\n             return (map (HsVar noExt . noLoc) std_names, emptyFVs)\n        else\n          do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names\n             ; return (map (HsVar noExt . noLoc) usr_names, mkFVs usr_names) } }\n\n-- Error messages\n\n\nopDeclErr :: RdrName -> SDoc\nopDeclErr n\n  = hang (text \"Illegal declaration of a type or class operator\" <+> quotes (ppr n))\n       2 (text \"Use TypeOperators to declare operators in type and declarations\")\n\nbadOrigBinding :: RdrName -> SDoc\nbadOrigBinding name\n  | Just _ <- isBuiltInOcc_maybe occ\n  = text \"Illegal binding of built-in syntax:\" <+> ppr occ\n    -- Use an OccName here because we don't want to print Prelude.(,)\n  | otherwise\n  = text \"Cannot redefine a Name retrieved by a Template Haskell quote:\"\n    <+> ppr name\n    -- This can happen when one tries to use a Template Haskell splice to\n    -- define a top-level identifier with an already existing name, e.g.,\n    --\n    --   $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])\n    --\n    -- (See Trac #13968.)\n  where\n    occ = rdrNameOcc $ filterCTuple name\n", "num_lines": 1666}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[RnExpr]{Renaming of expressions}\n\nBasically dependency analysis.\n\nHandles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In\ngeneral, all of these functions return a renamed thing, and a set of\nfree variables.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule RnExpr (\n        rnLExpr, rnExpr, rnStmts\n   ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport RnBinds   ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,\n                   rnMatchGroup, rnGRHS, makeMiniFixityEnv)\nimport HsSyn\nimport TcEnv            ( isBrackStage )\nimport TcRnMonad\nimport Module           ( getModule )\nimport RnEnv\nimport RnFixity\nimport RnUtils          ( HsDocContext(..), bindLocalNamesFV, checkDupNames\n                        , bindLocalNames\n                        , mapMaybeFvRn, mapFvRn\n                        , warnUnusedLocalBinds, typeAppErr\n                        , checkUnusedRecordWildcard )\nimport RnUnbound        ( reportUnboundName )\nimport RnSplice         ( rnBracket, rnSpliceExpr, checkThLocalName )\nimport RnTypes\nimport RnPat\nimport DynFlags\nimport PrelNames\n\nimport BasicTypes\nimport Name\nimport NameSet\nimport RdrName\nimport UniqSet\nimport Data.List\nimport Util\nimport ListSetOps       ( removeDups )\nimport ErrUtils\nimport Outputable\nimport SrcLoc\nimport FastString\nimport Control.Monad\nimport TysWiredIn       ( nilDataConName )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.Ord\nimport Data.Array\nimport qualified Data.List.NonEmpty as NE\n\nimport Unique           ( mkVarOccUnique )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Expressions}\n*                                                                      *\n************************************************************************\n-}\n\nrnExprs :: [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)\nrnExprs ls = rnExprs' ls emptyUniqSet\n where\n  rnExprs' [] acc = return ([], acc)\n  rnExprs' (expr:exprs) acc =\n   do { (expr', fvExpr) <- rnLExpr expr\n        -- Now we do a \"seq\" on the free vars because typically it's small\n        -- or empty, especially in very long lists of constants\n      ; let  acc' = acc `plusFV` fvExpr\n      ; (exprs', fvExprs) <- acc' `seq` rnExprs' exprs acc'\n      ; return (expr':exprs', fvExprs) }\n\n-- Variables. We look up the variable and return the resulting name.\n\nrnLExpr :: LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)\nrnLExpr = wrapLocFstM rnExpr\n\nrnExpr :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)\n\nfinishHsVar :: Located Name -> RnM (HsExpr GhcRn, FreeVars)\n-- Separated from rnExpr because it's also used\n-- when renaming infix expressions\nfinishHsVar (L l name)\n = do { this_mod <- getModule\n      ; when (nameIsLocalOrFrom this_mod name) $\n        checkThLocalName name\n      ; return (HsVar noExt (L l name), unitFV name) }\n\nrnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)\nrnUnboundVar v\n = do { if isUnqual v\n        then -- Treat this as a \"hole\"\n             -- Do not fail right now; instead, return HsUnboundVar\n             -- and let the type checker report the error\n             do { let occ = rdrNameOcc v\n                ; uv <- if startsWithUnderscore occ\n                        then return (TrueExprHole occ)\n                        else OutOfScope occ <$> getGlobalRdrEnv\n                ; return (HsUnboundVar noExt uv, emptyFVs) }\n\n        else -- Fail immediately (qualified name)\n             do { n <- reportUnboundName v\n                ; return (HsVar noExt (noLoc n), emptyFVs) } }\n\nrnExpr (HsVar _ (L l v))\n  = do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields\n       ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields v\n       ; case mb_name of {\n           Nothing -> rnUnboundVar v ;\n           Just (Left name)\n              | name == nilDataConName -- Treat [] as an ExplicitList, so that\n                                       -- OverloadedLists works correctly\n              -> rnExpr (ExplicitList noExt Nothing [])\n\n              | otherwise\n              -> finishHsVar (L l name) ;\n            Just (Right [s]) ->\n              return ( HsRecFld noExt (Unambiguous s (L l v) ), unitFV s) ;\n           Just (Right fs@(_:_:_)) ->\n              return ( HsRecFld noExt (Ambiguous noExt (L l v))\n                     , mkFVs fs);\n           Just (Right [])         -> panic \"runExpr/HsVar\" } }\n\nrnExpr (HsIPVar x v)\n  = return (HsIPVar x v, emptyFVs)\n\nrnExpr (HsOverLabel x _ v)\n  = do { rebindable_on <- xoptM LangExt.RebindableSyntax\n       ; if rebindable_on\n         then do { fromLabel <- lookupOccRn (mkVarUnqual (fsLit \"fromLabel\"))\n                 ; return (HsOverLabel x (Just fromLabel) v, unitFV fromLabel) }\n         else return (HsOverLabel x Nothing v, emptyFVs) }\n\nrnExpr (HsLit x lit@(HsString src s))\n  = do { opt_OverloadedStrings <- xoptM LangExt.OverloadedStrings\n       ; if opt_OverloadedStrings then\n            rnExpr (HsOverLit x (mkHsIsString src s))\n         else do {\n            ; rnLit lit\n            ; return (HsLit x (convertLit lit), emptyFVs) } }\n\nrnExpr (HsLit x lit)\n  = do { rnLit lit\n       ; return (HsLit x(convertLit lit), emptyFVs) }\n\nrnExpr (HsOverLit x lit)\n  = do { ((lit', mb_neg), fvs) <- rnOverLit lit -- See Note [Negative zero]\n       ; case mb_neg of\n              Nothing -> return (HsOverLit x lit', fvs)\n              Just neg -> return (HsApp x (noLoc neg) (noLoc (HsOverLit x lit'))\n                                 , fvs ) }\n\nrnExpr (HsApp x fun arg)\n  = do { (fun',fvFun) <- rnLExpr fun\n       ; (arg',fvArg) <- rnLExpr arg\n       ; return (HsApp x fun' arg', fvFun `plusFV` fvArg) }\n\nrnExpr (HsAppType x fun arg)\n  = do { type_app <- xoptM LangExt.TypeApplications\n       ; unless type_app $ addErr $ typeAppErr \"type\" $ hswc_body arg\n       ; (fun',fvFun) <- rnLExpr fun\n       ; (arg',fvArg) <- rnHsWcType HsTypeCtx arg\n       ; return (HsAppType x fun' arg', fvFun `plusFV` fvArg) }\n\nrnExpr (OpApp _ e1 op e2)\n  = do  { (e1', fv_e1) <- rnLExpr e1\n        ; (e2', fv_e2) <- rnLExpr e2\n        ; (op', fv_op) <- rnLExpr op\n\n        -- Deal with fixity\n        -- When renaming code synthesised from \"deriving\" declarations\n        -- we used to avoid fixity stuff, but we can't easily tell any\n        -- more, so I've removed the test.  Adding HsPars in TcGenDeriv\n        -- should prevent bad things happening.\n        ; fixity <- case op' of\n              L _ (HsVar _ (L _ n)) -> lookupFixityRn n\n              L _ (HsRecFld _ f)    -> lookupFieldFixityRn f\n              _ -> return (Fixity NoSourceText minPrecedence InfixL)\n                   -- c.f. lookupFixity for unbound\n\n        ; final_e <- mkOpAppRn e1' op' fixity e2'\n        ; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) }\n\nrnExpr (NegApp _ e _)\n  = do { (e', fv_e)         <- rnLExpr e\n       ; (neg_name, fv_neg) <- lookupSyntaxName negateName\n       ; final_e            <- mkNegAppRn e' neg_name\n       ; return (final_e, fv_e `plusFV` fv_neg) }\n\n------------------------------------------\n-- Template Haskell extensions\n-- Don't ifdef-GHCI them because we want to fail gracefully\n-- (not with an rnExpr crash) in a stage-1 compiler.\nrnExpr e@(HsBracket _ br_body) = rnBracket e br_body\n\nrnExpr (HsSpliceE _ splice) = rnSpliceExpr splice\n\n---------------------------------------------\n--      Sections\n-- See Note [Parsing sections] in Parser.y\nrnExpr (HsPar x (L loc (section@(SectionL {}))))\n  = do  { (section', fvs) <- rnSection section\n        ; return (HsPar x (L loc section'), fvs) }\n\nrnExpr (HsPar x (L loc (section@(SectionR {}))))\n  = do  { (section', fvs) <- rnSection section\n        ; return (HsPar x (L loc section'), fvs) }\n\nrnExpr (HsPar x e)\n  = do  { (e', fvs_e) <- rnLExpr e\n        ; return (HsPar x e', fvs_e) }\n\nrnExpr expr@(SectionL {})\n  = do  { addErr (sectionErr expr); rnSection expr }\nrnExpr expr@(SectionR {})\n  = do  { addErr (sectionErr expr); rnSection expr }\n\n---------------------------------------------\nrnExpr (HsCoreAnn x src ann expr)\n  = do { (expr', fvs_expr) <- rnLExpr expr\n       ; return (HsCoreAnn x src ann expr', fvs_expr) }\n\nrnExpr (HsSCC x src lbl expr)\n  = do { (expr', fvs_expr) <- rnLExpr expr\n       ; return (HsSCC x src lbl expr', fvs_expr) }\nrnExpr (HsTickPragma x src info srcInfo expr)\n  = do { (expr', fvs_expr) <- rnLExpr expr\n       ; return (HsTickPragma x src info srcInfo expr', fvs_expr) }\n\nrnExpr (HsLam x matches)\n  = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches\n       ; return (HsLam x matches', fvMatch) }\n\nrnExpr (HsLamCase x matches)\n  = do { (matches', fvs_ms) <- rnMatchGroup CaseAlt rnLExpr matches\n       ; return (HsLamCase x matches', fvs_ms) }\n\nrnExpr (HsCase x expr matches)\n  = do { (new_expr, e_fvs) <- rnLExpr expr\n       ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLExpr matches\n       ; return (HsCase x new_expr new_matches, e_fvs `plusFV` ms_fvs) }\n\nrnExpr (HsLet x (L l binds) expr)\n  = rnLocalBindsAndThen binds $ \\binds' _ -> do\n      { (expr',fvExpr) <- rnLExpr expr\n      ; return (HsLet x (L l binds') expr', fvExpr) }\n\nrnExpr (HsDo x do_or_lc (L l stmts))\n  = do  { ((stmts', _), fvs) <-\n           rnStmtsWithPostProcessing do_or_lc rnLExpr\n             postProcessStmtsForApplicativeDo stmts\n             (\\ _ -> return ((), emptyFVs))\n        ; return ( HsDo x do_or_lc (L l stmts'), fvs ) }\n\nrnExpr (ExplicitList x _  exps)\n  = do  { opt_OverloadedLists <- xoptM LangExt.OverloadedLists\n        ; (exps', fvs) <- rnExprs exps\n        ; if opt_OverloadedLists\n           then do {\n            ; (from_list_n_name, fvs') <- lookupSyntaxName fromListNName\n            ; return (ExplicitList x (Just from_list_n_name) exps'\n                     , fvs `plusFV` fvs') }\n           else\n            return  (ExplicitList x Nothing exps', fvs) }\n\nrnExpr (ExplicitTuple x tup_args boxity)\n  = do { checkTupleSection tup_args\n       ; checkTupSize (length tup_args)\n       ; (tup_args', fvs) <- mapAndUnzipM rnTupArg tup_args\n       ; return (ExplicitTuple x tup_args' boxity, plusFVs fvs) }\n  where\n    rnTupArg (L l (Present x e)) = do { (e',fvs) <- rnLExpr e\n                                      ; return (L l (Present x e'), fvs) }\n    rnTupArg (L l (Missing _)) = return (L l (Missing noExt)\n                                        , emptyFVs)\n    rnTupArg (L _ (XTupArg {})) = panic \"rnExpr.XTupArg\"\n\nrnExpr (ExplicitSum x alt arity expr)\n  = do { (expr', fvs) <- rnLExpr expr\n       ; return (ExplicitSum x alt arity expr', fvs) }\n\nrnExpr (RecordCon { rcon_con_name = con_id\n                  , rcon_flds = rec_binds@(HsRecFields { rec_dotdot = dd }) })\n  = do { con_lname@(L _ con_name) <- lookupLocatedOccRn con_id\n       ; (flds, fvs)   <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds\n       ; (flds', fvss) <- mapAndUnzipM rn_field flds\n       ; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd }\n       ; return (RecordCon { rcon_ext = noExt\n                           , rcon_con_name = con_lname, rcon_flds = rec_binds' }\n                , fvs `plusFV` plusFVs fvss `addOneFV` con_name) }\n  where\n    mk_hs_var l n = HsVar noExt (L l n)\n    rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)\n                            ; return (L l (fld { hsRecFieldArg = arg' }), fvs) }\n\nrnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })\n  = do  { (expr', fvExpr) <- rnLExpr expr\n        ; (rbinds', fvRbinds) <- rnHsRecUpdFields rbinds\n        ; return (RecordUpd { rupd_ext = noExt, rupd_expr = expr'\n                            , rupd_flds = rbinds' }\n                 , fvExpr `plusFV` fvRbinds) }\n\nrnExpr (ExprWithTySig _ expr pty)\n  = do  { (pty', fvTy)    <- rnHsSigWcType BindUnlessForall ExprWithTySigCtx pty\n        ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $\n                             rnLExpr expr\n        ; return (ExprWithTySig noExt expr' pty', fvExpr `plusFV` fvTy) }\n\nrnExpr (HsIf x _ p b1 b2)\n  = do { (p', fvP) <- rnLExpr p\n       ; (b1', fvB1) <- rnLExpr b1\n       ; (b2', fvB2) <- rnLExpr b2\n       ; (mb_ite, fvITE) <- lookupIfThenElse\n       ; return (HsIf x mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }\n\nrnExpr (HsMultiIf x alts)\n  = do { (alts', fvs) <- mapFvRn (rnGRHS IfAlt rnLExpr) alts\n       -- ; return (HsMultiIf ty alts', fvs) }\n       ; return (HsMultiIf x alts', fvs) }\n\nrnExpr (ArithSeq x _ seq)\n  = do { opt_OverloadedLists <- xoptM LangExt.OverloadedLists\n       ; (new_seq, fvs) <- rnArithSeq seq\n       ; if opt_OverloadedLists\n           then do {\n            ; (from_list_name, fvs') <- lookupSyntaxName fromListName\n            ; return (ArithSeq x (Just from_list_name) new_seq\n                     , fvs `plusFV` fvs') }\n           else\n            return (ArithSeq x Nothing new_seq, fvs) }\n\n{-\nThese three are pattern syntax appearing in expressions.\nSince all the symbols are reservedops we can simply reject them.\nWe return a (bogus) EWildPat in each case.\n-}\n\nrnExpr (EWildPat _)  = return (hsHoleExpr, emptyFVs)   -- \"_\" is just a hole\nrnExpr e@(EAsPat {})\n  = do { opt_TypeApplications <- xoptM LangExt.TypeApplications\n       ; let msg | opt_TypeApplications\n                    = \"Type application syntax requires a space before '@'\"\n                 | otherwise\n                    = \"Did you mean to enable TypeApplications?\"\n       ; patSynErr e (text msg)\n       }\nrnExpr e@(EViewPat {}) = patSynErr e empty\nrnExpr e@(ELazyPat {}) = patSynErr e empty\n\n{-\n************************************************************************\n*                                                                      *\n        Static values\n*                                                                      *\n************************************************************************\n\nFor the static form we check that it is not used in splices.\nWe also collect the free variables of the term which come from\nthis module. See Note [Grand plan for static forms] in StaticPtrTable.\n-}\n\nrnExpr e@(HsStatic _ expr) = do\n    -- Normally, you wouldn't be able to construct a static expression without\n    -- first enabling -XStaticPointers in the first place, since that extension\n    -- is what makes the parser treat `static` as a keyword. But this is not a\n    -- sufficient safeguard, as one can construct static expressions by another\n    -- mechanism: Template Haskell (see #14204). To ensure that GHC is\n    -- absolutely prepared to cope with static forms, we check for\n    -- -XStaticPointers here as well.\n    unlessXOptM LangExt.StaticPointers $\n      addErr $ hang (text \"Illegal static expression:\" <+> ppr e)\n                  2 (text \"Use StaticPointers to enable this extension\")\n    (expr',fvExpr) <- rnLExpr expr\n    stage <- getStage\n    case stage of\n      Splice _ -> addErr $ sep\n             [ text \"static forms cannot be used in splices:\"\n             , nest 2 $ ppr e\n             ]\n      _ -> return ()\n    mod <- getModule\n    let fvExpr' = filterNameSet (nameIsLocalOrFrom mod) fvExpr\n    return (HsStatic fvExpr' expr', fvExpr)\n\n{-\n************************************************************************\n*                                                                      *\n        Arrow notation\n*                                                                      *\n************************************************************************\n-}\n\nrnExpr (HsProc x pat body)\n  = newArrowScope $\n    rnPat ProcExpr pat $ \\ pat' -> do\n      { (body',fvBody) <- rnCmdTop body\n      ; return (HsProc x pat' body', fvBody) }\n\nrnExpr other = pprPanic \"rnExpr: unexpected expression\" (ppr other)\n        -- HsWrap\n\nhsHoleExpr :: HsExpr (GhcPass id)\nhsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc \"_\"))\n\n----------------------\n-- See Note [Parsing sections] in Parser.y\nrnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)\nrnSection section@(SectionR x op expr)\n  = do  { (op', fvs_op)     <- rnLExpr op\n        ; (expr', fvs_expr) <- rnLExpr expr\n        ; checkSectionPrec InfixR section op' expr'\n        ; return (SectionR x op' expr', fvs_op `plusFV` fvs_expr) }\n\nrnSection section@(SectionL x expr op)\n  = do  { (expr', fvs_expr) <- rnLExpr expr\n        ; (op', fvs_op)     <- rnLExpr op\n        ; checkSectionPrec InfixL section op' expr'\n        ; return (SectionL x expr' op', fvs_op `plusFV` fvs_expr) }\n\nrnSection other = pprPanic \"rnSection\" (ppr other)\n\n{-\n************************************************************************\n*                                                                      *\n        Arrow commands\n*                                                                      *\n************************************************************************\n-}\n\nrnCmdArgs :: [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)\nrnCmdArgs [] = return ([], emptyFVs)\nrnCmdArgs (arg:args)\n  = do { (arg',fvArg) <- rnCmdTop arg\n       ; (args',fvArgs) <- rnCmdArgs args\n       ; return (arg':args', fvArg `plusFV` fvArgs) }\n\nrnCmdTop :: LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)\nrnCmdTop = wrapLocFstM rnCmdTop'\n where\n  rnCmdTop' (HsCmdTop _ cmd)\n   = do { (cmd', fvCmd) <- rnLCmd cmd\n        ; let cmd_names = [arrAName, composeAName, firstAName] ++\n                          nameSetElemsStable (methodNamesCmd (unLoc cmd'))\n        -- Generate the rebindable syntax for the monad\n        ; (cmd_names', cmd_fvs) <- lookupSyntaxNames cmd_names\n\n        ; return (HsCmdTop (cmd_names `zip` cmd_names') cmd',\n                  fvCmd `plusFV` cmd_fvs) }\n  rnCmdTop' (XCmdTop{}) = panic \"rnCmdTop\"\n\nrnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)\nrnLCmd = wrapLocFstM rnCmd\n\nrnCmd :: HsCmd GhcPs -> RnM (HsCmd GhcRn, FreeVars)\n\nrnCmd (HsCmdArrApp x arrow arg ho rtl)\n  = do { (arrow',fvArrow) <- select_arrow_scope (rnLExpr arrow)\n       ; (arg',fvArg) <- rnLExpr arg\n       ; return (HsCmdArrApp x arrow' arg' ho rtl,\n                 fvArrow `plusFV` fvArg) }\n  where\n    select_arrow_scope tc = case ho of\n        HsHigherOrderApp -> tc\n        HsFirstOrderApp  -> escapeArrowScope tc\n        -- See Note [Escaping the arrow scope] in TcRnTypes\n        -- Before renaming 'arrow', use the environment of the enclosing\n        -- proc for the (-<) case.\n        -- Local bindings, inside the enclosing proc, are not in scope\n        -- inside 'arrow'.  In the higher-order case (-<<), they are.\n\n-- infix form\nrnCmd (HsCmdArrForm _ op _ (Just _) [arg1, arg2])\n  = do { (op',fv_op) <- escapeArrowScope (rnLExpr op)\n       ; let L _ (HsVar _ (L _ op_name)) = op'\n       ; (arg1',fv_arg1) <- rnCmdTop arg1\n       ; (arg2',fv_arg2) <- rnCmdTop arg2\n        -- Deal with fixity\n       ; fixity <- lookupFixityRn op_name\n       ; final_e <- mkOpFormRn arg1' op' fixity arg2'\n       ; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) }\n\nrnCmd (HsCmdArrForm x op f fixity cmds)\n  = do { (op',fvOp) <- escapeArrowScope (rnLExpr op)\n       ; (cmds',fvCmds) <- rnCmdArgs cmds\n       ; return (HsCmdArrForm x op' f fixity cmds', fvOp `plusFV` fvCmds) }\n\nrnCmd (HsCmdApp x fun arg)\n  = do { (fun',fvFun) <- rnLCmd  fun\n       ; (arg',fvArg) <- rnLExpr arg\n       ; return (HsCmdApp x fun' arg', fvFun `plusFV` fvArg) }\n\nrnCmd (HsCmdLam x matches)\n  = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLCmd matches\n       ; return (HsCmdLam x matches', fvMatch) }\n\nrnCmd (HsCmdPar x e)\n  = do  { (e', fvs_e) <- rnLCmd e\n        ; return (HsCmdPar x e', fvs_e) }\n\nrnCmd (HsCmdCase x expr matches)\n  = do { (new_expr, e_fvs) <- rnLExpr expr\n       ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLCmd matches\n       ; return (HsCmdCase x new_expr new_matches, e_fvs `plusFV` ms_fvs) }\n\nrnCmd (HsCmdIf x _ p b1 b2)\n  = do { (p', fvP) <- rnLExpr p\n       ; (b1', fvB1) <- rnLCmd b1\n       ; (b2', fvB2) <- rnLCmd b2\n       ; (mb_ite, fvITE) <- lookupIfThenElse\n       ; return (HsCmdIf x mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2])}\n\nrnCmd (HsCmdLet x (L l binds) cmd)\n  = rnLocalBindsAndThen binds $ \\ binds' _ -> do\n      { (cmd',fvExpr) <- rnLCmd cmd\n      ; return (HsCmdLet x (L l binds') cmd', fvExpr) }\n\nrnCmd (HsCmdDo x (L l stmts))\n  = do  { ((stmts', _), fvs) <-\n            rnStmts ArrowExpr rnLCmd stmts (\\ _ -> return ((), emptyFVs))\n        ; return ( HsCmdDo x (L l stmts'), fvs ) }\n\nrnCmd cmd@(HsCmdWrap {}) = pprPanic \"rnCmd\" (ppr cmd)\nrnCmd cmd@(XCmd {})      = pprPanic \"rnCmd\" (ppr cmd)\n\n---------------------------------------------------\ntype CmdNeeds = FreeVars        -- Only inhabitants are\n                                --      appAName, choiceAName, loopAName\n\n-- find what methods the Cmd needs (loop, choice, apply)\nmethodNamesLCmd :: LHsCmd GhcRn -> CmdNeeds\nmethodNamesLCmd = methodNamesCmd . unLoc\n\nmethodNamesCmd :: HsCmd GhcRn -> CmdNeeds\n\nmethodNamesCmd (HsCmdArrApp _ _arrow _arg HsFirstOrderApp _rtl)\n  = emptyFVs\nmethodNamesCmd (HsCmdArrApp _ _arrow _arg HsHigherOrderApp _rtl)\n  = unitFV appAName\nmethodNamesCmd (HsCmdArrForm {}) = emptyFVs\nmethodNamesCmd (HsCmdWrap _ _ cmd) = methodNamesCmd cmd\n\nmethodNamesCmd (HsCmdPar _ c) = methodNamesLCmd c\n\nmethodNamesCmd (HsCmdIf _ _ _ c1 c2)\n  = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName\n\nmethodNamesCmd (HsCmdLet _ _ c)          = methodNamesLCmd c\nmethodNamesCmd (HsCmdDo _ (L _ stmts))   = methodNamesStmts stmts\nmethodNamesCmd (HsCmdApp _ c _)          = methodNamesLCmd c\nmethodNamesCmd (HsCmdLam _ match)        = methodNamesMatch match\n\nmethodNamesCmd (HsCmdCase _ _ matches)\n  = methodNamesMatch matches `addOneFV` choiceAName\n\nmethodNamesCmd (XCmd {}) = panic \"methodNamesCmd\"\n\n--methodNamesCmd _ = emptyFVs\n   -- Other forms can't occur in commands, but it's not convenient\n   -- to error here so we just do what's convenient.\n   -- The type checker will complain later\n\n---------------------------------------------------\nmethodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars\nmethodNamesMatch (MG { mg_alts = L _ ms })\n  = plusFVs (map do_one ms)\n where\n    do_one (L _ (Match { m_grhss = grhss })) = methodNamesGRHSs grhss\n    do_one (L _ (XMatch _)) = panic \"methodNamesMatch.XMatch\"\nmethodNamesMatch (XMatchGroup _) = panic \"methodNamesMatch\"\n\n-------------------------------------------------\n-- gaw 2004\nmethodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars\nmethodNamesGRHSs (GRHSs _ grhss _) = plusFVs (map methodNamesGRHS grhss)\nmethodNamesGRHSs (XGRHSs _) = panic \"methodNamesGRHSs\"\n\n-------------------------------------------------\n\nmethodNamesGRHS :: Located (GRHS GhcRn (LHsCmd GhcRn)) -> CmdNeeds\nmethodNamesGRHS (L _ (GRHS _ _ rhs)) = methodNamesLCmd rhs\nmethodNamesGRHS (L _ (XGRHS _)) = panic \"methodNamesGRHS\"\n\n---------------------------------------------------\nmethodNamesStmts :: [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars\nmethodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)\n\n---------------------------------------------------\nmethodNamesLStmt :: Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn)) -> FreeVars\nmethodNamesLStmt = methodNamesStmt . unLoc\n\nmethodNamesStmt :: StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars\nmethodNamesStmt (LastStmt _ cmd _ _)           = methodNamesLCmd cmd\nmethodNamesStmt (BodyStmt _ cmd _ _)           = methodNamesLCmd cmd\nmethodNamesStmt (BindStmt _ _ cmd _ _)         = methodNamesLCmd cmd\nmethodNamesStmt (RecStmt { recS_stmts = stmts }) =\n  methodNamesStmts stmts `addOneFV` loopAName\nmethodNamesStmt (LetStmt {})                   = emptyFVs\nmethodNamesStmt (ParStmt {})                   = emptyFVs\nmethodNamesStmt (TransStmt {})                 = emptyFVs\nmethodNamesStmt ApplicativeStmt{}              = emptyFVs\n   -- ParStmt and TransStmt can't occur in commands, but it's not\n   -- convenient to error here so we just do what's convenient\nmethodNamesStmt (XStmtLR {}) = panic \"methodNamesStmt\"\n\n{-\n************************************************************************\n*                                                                      *\n        Arithmetic sequences\n*                                                                      *\n************************************************************************\n-}\n\nrnArithSeq :: ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)\nrnArithSeq (From expr)\n = do { (expr', fvExpr) <- rnLExpr expr\n      ; return (From expr', fvExpr) }\n\nrnArithSeq (FromThen expr1 expr2)\n = do { (expr1', fvExpr1) <- rnLExpr expr1\n      ; (expr2', fvExpr2) <- rnLExpr expr2\n      ; return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2) }\n\nrnArithSeq (FromTo expr1 expr2)\n = do { (expr1', fvExpr1) <- rnLExpr expr1\n      ; (expr2', fvExpr2) <- rnLExpr expr2\n      ; return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2) }\n\nrnArithSeq (FromThenTo expr1 expr2 expr3)\n = do { (expr1', fvExpr1) <- rnLExpr expr1\n      ; (expr2', fvExpr2) <- rnLExpr expr2\n      ; (expr3', fvExpr3) <- rnLExpr expr3\n      ; return (FromThenTo expr1' expr2' expr3',\n                plusFVs [fvExpr1, fvExpr2, fvExpr3]) }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{@Stmt@s: in @do@ expressions}\n*                                                                      *\n************************************************************************\n-}\n\n{-\nNote [Deterministic ApplicativeDo and RecursiveDo desugaring]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBoth ApplicativeDo and RecursiveDo need to create tuples not\npresent in the source text.\n\nFor ApplicativeDo we create:\n\n  (a,b,c) <- (\\c b a -> (a,b,c)) <$>\n\nFor RecursiveDo we create:\n\n  mfix (\\ ~(a,b,c) -> do ...; return (a',b',c'))\n\nThe order of the components in those tuples needs to be stable\nacross recompilations, otherwise they can get optimized differently\nand we end up with incompatible binaries.\nTo get a stable order we use nameSetElemsStable.\nSee Note [Deterministic UniqFM] to learn more about nondeterminism.\n-}\n\n-- | Rename some Stmts\nrnStmts :: Outputable (body GhcPs)\n        => HsStmtContext Name\n        -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n           -- ^ How to rename the body of each statement (e.g. rnLExpr)\n        -> [LStmt GhcPs (Located (body GhcPs))]\n           -- ^ Statements\n        -> ([Name] -> RnM (thing, FreeVars))\n           -- ^ if these statements scope over something, this renames it\n           -- and returns the result.\n        -> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)\nrnStmts ctxt rnBody = rnStmtsWithPostProcessing ctxt rnBody noPostProcessStmts\n\n-- | like 'rnStmts' but applies a post-processing step to the renamed Stmts\nrnStmtsWithPostProcessing\n        :: Outputable (body GhcPs)\n        => HsStmtContext Name\n        -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n           -- ^ How to rename the body of each statement (e.g. rnLExpr)\n        -> (HsStmtContext Name\n              -> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]\n              -> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars))\n           -- ^ postprocess the statements\n        -> [LStmt GhcPs (Located (body GhcPs))]\n           -- ^ Statements\n        -> ([Name] -> RnM (thing, FreeVars))\n           -- ^ if these statements scope over something, this renames it\n           -- and returns the result.\n        -> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)\nrnStmtsWithPostProcessing ctxt rnBody ppStmts stmts thing_inside\n = do { ((stmts', thing), fvs) <-\n          rnStmtsWithFreeVars ctxt rnBody stmts thing_inside\n      ; (pp_stmts, fvs') <- ppStmts ctxt stmts'\n      ; return ((pp_stmts, thing), fvs `plusFV` fvs')\n      }\n\n-- | maybe rearrange statements according to the ApplicativeDo transformation\npostProcessStmtsForApplicativeDo\n  :: HsStmtContext Name\n  -> [(ExprLStmt GhcRn, FreeVars)]\n  -> RnM ([ExprLStmt GhcRn], FreeVars)\npostProcessStmtsForApplicativeDo ctxt stmts\n  = do {\n       -- rearrange the statements using ApplicativeStmt if\n       -- -XApplicativeDo is on.  Also strip out the FreeVars attached\n       -- to each Stmt body.\n         ado_is_on <- xoptM LangExt.ApplicativeDo\n       ; let is_do_expr | DoExpr <- ctxt = True\n                        | otherwise = False\n       -- don't apply the transformation inside TH brackets, because\n       -- DsMeta does not handle ApplicativeDo.\n       ; in_th_bracket <- isBrackStage <$> getStage\n       ; if ado_is_on && is_do_expr && not in_th_bracket\n            then do { traceRn \"ppsfa\" (ppr stmts)\n                    ; rearrangeForApplicativeDo ctxt stmts }\n            else noPostProcessStmts ctxt stmts }\n\n-- | strip the FreeVars annotations from statements\nnoPostProcessStmts\n  :: HsStmtContext Name\n  -> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]\n  -> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)\nnoPostProcessStmts _ stmts = return (map fst stmts, emptyNameSet)\n\n\nrnStmtsWithFreeVars :: Outputable (body GhcPs)\n        => HsStmtContext Name\n        -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n        -> [LStmt GhcPs (Located (body GhcPs))]\n        -> ([Name] -> RnM (thing, FreeVars))\n        -> RnM ( ([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)\n               , FreeVars)\n-- Each Stmt body is annotated with its FreeVars, so that\n-- we can rearrange statements for ApplicativeDo.\n--\n-- Variables bound by the Stmts, and mentioned in thing_inside,\n-- do not appear in the result FreeVars\n\nrnStmtsWithFreeVars ctxt _ [] thing_inside\n  = do { checkEmptyStmts ctxt\n       ; (thing, fvs) <- thing_inside []\n       ; return (([], thing), fvs) }\n\nrnStmtsWithFreeVars MDoExpr rnBody stmts thing_inside    -- Deal with mdo\n  = -- Behave like do { rec { ...all but last... }; last }\n    do { ((stmts1, (stmts2, thing)), fvs)\n           <- rnStmt MDoExpr rnBody (noLoc $ mkRecStmt all_but_last) $ \\ _ ->\n              do { last_stmt' <- checkLastStmt MDoExpr last_stmt\n                 ; rnStmt MDoExpr rnBody last_stmt' thing_inside }\n        ; return (((stmts1 ++ stmts2), thing), fvs) }\n  where\n    Just (all_but_last, last_stmt) = snocView stmts\n\nrnStmtsWithFreeVars ctxt rnBody (lstmt@(L loc _) : lstmts) thing_inside\n  | null lstmts\n  = setSrcSpan loc $\n    do { lstmt' <- checkLastStmt ctxt lstmt\n       ; rnStmt ctxt rnBody lstmt' thing_inside }\n\n  | otherwise\n  = do { ((stmts1, (stmts2, thing)), fvs)\n            <- setSrcSpan loc                         $\n               do { checkStmt ctxt lstmt\n                  ; rnStmt ctxt rnBody lstmt    $ \\ bndrs1 ->\n                    rnStmtsWithFreeVars ctxt rnBody lstmts  $ \\ bndrs2 ->\n                    thing_inside (bndrs1 ++ bndrs2) }\n        ; return (((stmts1 ++ stmts2), thing), fvs) }\n\n----------------------\n\n{-\nNote [Failing pattern matches in Stmts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nMany things desugar to HsStmts including monadic things like `do` and `mdo`\nstatements, pattern guards, and list comprehensions (see 'HsStmtContext' for an\nexhaustive list). How we deal with pattern match failure is context-dependent.\n\n * In the case of list comprehensions and pattern guards we don't need any 'fail'\n   function; the desugarer ignores the fail function field of 'BindStmt' entirely.\n * In the case of monadic contexts (e.g. monad comprehensions, do, and mdo\n   expressions) we want pattern match failure to be desugared to the appropriate\n   'fail' function (either that of Monad or MonadFail, depending on whether\n   -XMonadFailDesugaring is enabled.)\n\nAt one point we failed to make this distinction, leading to #11216.\n-}\n\nrnStmt :: Outputable (body GhcPs)\n       => HsStmtContext Name\n       -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n          -- ^ How to rename the body of the statement\n       -> LStmt GhcPs (Located (body GhcPs))\n          -- ^ The statement\n       -> ([Name] -> RnM (thing, FreeVars))\n          -- ^ Rename the stuff that this statement scopes over\n       -> RnM ( ([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)\n              , FreeVars)\n-- Variables bound by the Stmt, and mentioned in thing_inside,\n-- do not appear in the result FreeVars\n\nrnStmt ctxt rnBody (L loc (LastStmt _ body noret _)) thing_inside\n  = do  { (body', fv_expr) <- rnBody body\n        ; (ret_op, fvs1) <- if isMonadCompContext ctxt\n                            then lookupStmtName ctxt returnMName\n                            else return (noSyntaxExpr, emptyFVs)\n                            -- The 'return' in a LastStmt is used only\n                            -- for MonadComp; and we don't want to report\n                            -- \"non in scope: return\" in other cases\n                            -- Trac #15607\n\n        ; (thing,  fvs3) <- thing_inside []\n        ; return (([(L loc (LastStmt noExt body' noret ret_op), fv_expr)]\n                  , thing), fv_expr `plusFV` fvs1 `plusFV` fvs3) }\n\nrnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside\n  = do  { (body', fv_expr) <- rnBody body\n        ; (then_op, fvs1)  <- lookupStmtName ctxt thenMName\n\n        ; (guard_op, fvs2) <- if isComprehensionContext ctxt\n                              then lookupStmtName ctxt guardMName\n                              else return (noSyntaxExpr, emptyFVs)\n                              -- Only list/monad comprehensions use 'guard'\n                              -- Also for sub-stmts of same eg [ e | x<-xs, gd | blah ]\n                              -- Here \"gd\" is a guard\n\n        ; (thing, fvs3)    <- thing_inside []\n        ; return ( ([(L loc (BodyStmt noExt body' then_op guard_op), fv_expr)]\n                  , thing), fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }\n\nrnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside\n  = do  { (body', fv_expr) <- rnBody body\n                -- The binders do not scope over the expression\n        ; (bind_op, fvs1) <- lookupStmtName ctxt bindMName\n\n        ; (fail_op, fvs2) <- monadFailOp pat ctxt\n\n        ; rnPat (StmtCtxt ctxt) pat $ \\ pat' -> do\n        { (thing, fvs3) <- thing_inside (collectPatBinders pat')\n        ; return (( [( L loc (BindStmt noExt pat' body' bind_op fail_op)\n                     , fv_expr )]\n                  , thing),\n                  fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}\n       -- fv_expr shouldn't really be filtered by the rnPatsAndThen\n        -- but it does not matter because the names are unique\n\nrnStmt _ _ (L loc (LetStmt _ (L l binds))) thing_inside\n  = do  { rnLocalBindsAndThen binds $ \\binds' bind_fvs -> do\n        { (thing, fvs) <- thing_inside (collectLocalBinders binds')\n        ; return ( ([(L loc (LetStmt noExt (L l binds')), bind_fvs)], thing)\n                 , fvs) }  }\n\nrnStmt ctxt rnBody (L loc (RecStmt { recS_stmts = rec_stmts })) thing_inside\n  = do  { (return_op, fvs1)  <- lookupStmtName ctxt returnMName\n        ; (mfix_op,   fvs2)  <- lookupStmtName ctxt mfixName\n        ; (bind_op,   fvs3)  <- lookupStmtName ctxt bindMName\n        ; let empty_rec_stmt = emptyRecStmtName { recS_ret_fn  = return_op\n                                                , recS_mfix_fn = mfix_op\n                                                , recS_bind_fn = bind_op }\n\n        -- Step1: Bring all the binders of the mdo into scope\n        -- (Remember that this also removes the binders from the\n        -- finally-returned free-vars.)\n        -- And rename each individual stmt, making a\n        -- singleton segment.  At this stage the FwdRefs field\n        -- isn't finished: it's empty for all except a BindStmt\n        -- for which it's the fwd refs within the bind itself\n        -- (This set may not be empty, because we're in a recursive\n        -- context.)\n        ; rnRecStmtsAndThen rnBody rec_stmts   $ \\ segs -> do\n        { let bndrs = nameSetElemsStable $\n                        foldr (unionNameSet . (\\(ds,_,_,_) -> ds))\n                              emptyNameSet\n                              segs\n          -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]\n        ; (thing, fvs_later) <- thing_inside bndrs\n        ; let (rec_stmts', fvs) = segmentRecStmts loc ctxt empty_rec_stmt segs fvs_later\n        -- We aren't going to try to group RecStmts with\n        -- ApplicativeDo, so attaching empty FVs is fine.\n        ; return ( ((zip rec_stmts' (repeat emptyNameSet)), thing)\n                 , fvs `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) } }\n\nrnStmt ctxt _ (L loc (ParStmt _ segs _ _)) thing_inside\n  = do  { (mzip_op, fvs1)   <- lookupStmtNamePoly ctxt mzipName\n        ; (bind_op, fvs2)   <- lookupStmtName ctxt bindMName\n        ; (return_op, fvs3) <- lookupStmtName ctxt returnMName\n        ; ((segs', thing), fvs4) <- rnParallelStmts (ParStmtCtxt ctxt) return_op segs thing_inside\n        ; return (([(L loc (ParStmt noExt segs' mzip_op bind_op), fvs4)], thing)\n                 , fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }\n\nrnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = form\n                              , trS_using = using })) thing_inside\n  = do { -- Rename the 'using' expression in the context before the transform is begun\n         (using', fvs1) <- rnLExpr using\n\n         -- Rename the stmts and the 'by' expression\n         -- Keep track of the variables mentioned in the 'by' expression\n       ; ((stmts', (by', used_bndrs, thing)), fvs2)\n             <- rnStmts (TransStmtCtxt ctxt) rnLExpr stmts $ \\ bndrs ->\n                do { (by',   fvs_by) <- mapMaybeFvRn rnLExpr by\n                   ; (thing, fvs_thing) <- thing_inside bndrs\n                   ; let fvs = fvs_by `plusFV` fvs_thing\n                         used_bndrs = filter (`elemNameSet` fvs) bndrs\n                         -- The paper (Fig 5) has a bug here; we must treat any free variable\n                         -- of the \"thing inside\", **or of the by-expression**, as used\n                   ; return ((by', used_bndrs, thing), fvs) }\n\n       -- Lookup `return`, `(>>=)` and `liftM` for monad comprehensions\n       ; (return_op, fvs3) <- lookupStmtName ctxt returnMName\n       ; (bind_op,   fvs4) <- lookupStmtName ctxt bindMName\n       ; (fmap_op,   fvs5) <- case form of\n                                ThenForm -> return (noExpr, emptyFVs)\n                                _        -> lookupStmtNamePoly ctxt fmapName\n\n       ; let all_fvs  = fvs1 `plusFV` fvs2 `plusFV` fvs3\n                             `plusFV` fvs4 `plusFV` fvs5\n             bndr_map = used_bndrs `zip` used_bndrs\n             -- See Note [TransStmt binder map] in HsExpr\n\n       ; traceRn \"rnStmt: implicitly rebound these used binders:\" (ppr bndr_map)\n       ; return (([(L loc (TransStmt { trS_ext = noExt\n                                    , trS_stmts = stmts', trS_bndrs = bndr_map\n                                    , trS_by = by', trS_using = using', trS_form = form\n                                    , trS_ret = return_op, trS_bind = bind_op\n                                    , trS_fmap = fmap_op }), fvs2)], thing), all_fvs) }\n\nrnStmt _ _ (L _ ApplicativeStmt{}) _ =\n  panic \"rnStmt: ApplicativeStmt\"\n\nrnStmt _ _ (L _ XStmtLR{}) _ =\n  panic \"rnStmt: XStmtLR\"\n\nrnParallelStmts :: forall thing. HsStmtContext Name\n                -> SyntaxExpr GhcRn\n                -> [ParStmtBlock GhcPs GhcPs]\n                -> ([Name] -> RnM (thing, FreeVars))\n                -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)\n-- Note [Renaming parallel Stmts]\nrnParallelStmts ctxt return_op segs thing_inside\n  = do { orig_lcl_env <- getLocalRdrEnv\n       ; rn_segs orig_lcl_env [] segs }\n  where\n    rn_segs :: LocalRdrEnv\n            -> [Name] -> [ParStmtBlock GhcPs GhcPs]\n            -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)\n    rn_segs _ bndrs_so_far []\n      = do { let (bndrs', dups) = removeDups cmpByOcc bndrs_so_far\n           ; mapM_ dupErr dups\n           ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs')\n           ; return (([], thing), fvs) }\n\n    rn_segs env bndrs_so_far (ParStmtBlock x stmts _ _ : segs)\n      = do { ((stmts', (used_bndrs, segs', thing)), fvs)\n                    <- rnStmts ctxt rnLExpr stmts $ \\ bndrs ->\n                       setLocalRdrEnv env       $ do\n                       { ((segs', thing), fvs) <- rn_segs env (bndrs ++ bndrs_so_far) segs\n                       ; let used_bndrs = filter (`elemNameSet` fvs) bndrs\n                       ; return ((used_bndrs, segs', thing), fvs) }\n\n           ; let seg' = ParStmtBlock x stmts' used_bndrs return_op\n           ; return ((seg':segs', thing), fvs) }\n    rn_segs _ _ (XParStmtBlock{}:_) = panic \"rnParallelStmts\"\n\n    cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2\n    dupErr vs = addErr (text \"Duplicate binding in parallel list comprehension for:\"\n                    <+> quotes (ppr (NE.head vs)))\n\nlookupStmtName :: HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)\n-- Like lookupSyntaxName, but respects contexts\nlookupStmtName ctxt n\n  | rebindableContext ctxt\n  = lookupSyntaxName n\n  | otherwise\n  = return (mkRnSyntaxExpr n, emptyFVs)\n\nlookupStmtNamePoly :: HsStmtContext Name -> Name -> RnM (HsExpr GhcRn, FreeVars)\nlookupStmtNamePoly ctxt name\n  | rebindableContext ctxt\n  = do { rebindable_on <- xoptM LangExt.RebindableSyntax\n       ; if rebindable_on\n         then do { fm <- lookupOccRn (nameRdrName name)\n                 ; return (HsVar noExt (noLoc fm), unitFV fm) }\n         else not_rebindable }\n  | otherwise\n  = not_rebindable\n  where\n    not_rebindable = return (HsVar noExt (noLoc name), emptyFVs)\n\n-- | Is this a context where we respect RebindableSyntax?\n-- but ListComp are never rebindable\n-- Neither is ArrowExpr, which has its own desugarer in DsArrows\nrebindableContext :: HsStmtContext Name -> Bool\nrebindableContext ctxt = case ctxt of\n  ListComp        -> False\n  ArrowExpr       -> False\n  PatGuard {}     -> False\n\n  DoExpr          -> True\n  MDoExpr         -> True\n  MonadComp       -> True\n  GhciStmtCtxt    -> True   -- I suppose?\n\n  ParStmtCtxt   c -> rebindableContext c     -- Look inside to\n  TransStmtCtxt c -> rebindableContext c     -- the parent context\n\n{-\nNote [Renaming parallel Stmts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRenaming parallel statements is painful.  Given, say\n     [ a+c | a <- as, bs <- bss\n           | c <- bs, a <- ds ]\nNote that\n  (a) In order to report \"Defined but not used\" about 'bs', we must\n      rename each group of Stmts with a thing_inside whose FreeVars\n      include at least {a,c}\n\n  (b) We want to report that 'a' is illegally bound in both branches\n\n  (c) The 'bs' in the second group must obviously not be captured by\n      the binding in the first group\n\nTo satisfy (a) we nest the segements.\nTo satisfy (b) we check for duplicates just before thing_inside.\nTo satisfy (c) we reset the LocalRdrEnv each time.\n\n************************************************************************\n*                                                                      *\n\\subsubsection{mdo expressions}\n*                                                                      *\n************************************************************************\n-}\n\ntype FwdRefs = NameSet\ntype Segment stmts = (Defs,\n                      Uses,     -- May include defs\n                      FwdRefs,  -- A subset of uses that are\n                                --   (a) used before they are bound in this segment, or\n                                --   (b) used here, and bound in subsequent segments\n                      stmts)    -- Either Stmt or [Stmt]\n\n\n-- wrapper that does both the left- and right-hand sides\nrnRecStmtsAndThen :: Outputable (body GhcPs) =>\n                     (Located (body GhcPs)\n                  -> RnM (Located (body GhcRn), FreeVars))\n                  -> [LStmt GhcPs (Located (body GhcPs))]\n                         -- assumes that the FreeVars returned includes\n                         -- the FreeVars of the Segments\n                  -> ([Segment (LStmt GhcRn (Located (body GhcRn)))]\n                      -> RnM (a, FreeVars))\n                  -> RnM (a, FreeVars)\nrnRecStmtsAndThen rnBody s cont\n  = do  { -- (A) Make the mini fixity env for all of the stmts\n          fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s)\n\n          -- (B) Do the LHSes\n        ; new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s\n\n          --    ...bring them and their fixities into scope\n        ; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv)\n              -- Fake uses of variables introduced implicitly (warning suppression, see #4404)\n              rec_uses = lStmtsImplicits (map fst new_lhs_and_fv)\n              implicit_uses = mkNameSet $ concatMap snd $ rec_uses\n        ; bindLocalNamesFV bound_names $\n          addLocalFixities fix_env bound_names $ do\n\n          -- (C) do the right-hand-sides and thing-inside\n        { segs <- rn_rec_stmts rnBody bound_names new_lhs_and_fv\n        ; (res, fvs) <- cont segs\n        ; mapM_ (\\(loc, ns) -> checkUnusedRecordWildcard loc fvs (Just ns))\n                rec_uses\n        ; warnUnusedLocalBinds bound_names (fvs `unionNameSet` implicit_uses)\n        ; return (res, fvs) }}\n\n-- get all the fixity decls in any Let stmt\ncollectRecStmtsFixities :: [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs]\ncollectRecStmtsFixities l =\n    foldr (\\ s -> \\acc -> case s of\n            (L _ (LetStmt _ (L _ (HsValBinds _ (ValBinds _ _ sigs))))) ->\n              foldr (\\ sig -> \\ acc -> case sig of\n                                         (L loc (FixSig _ s)) -> (L loc s) : acc\n                                         _ -> acc) acc sigs\n            _ -> acc) [] l\n\n-- left-hand sides\n\nrn_rec_stmt_lhs :: Outputable body => MiniFixityEnv\n                -> LStmt GhcPs body\n                   -- rename LHS, and return its FVs\n                   -- Warning: we will only need the FreeVars below in the case of a BindStmt,\n                   -- so we don't bother to compute it accurately in the other cases\n                -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]\n\nrn_rec_stmt_lhs _ (L loc (BodyStmt _ body a b))\n  = return [(L loc (BodyStmt noExt body a b), emptyFVs)]\n\nrn_rec_stmt_lhs _ (L loc (LastStmt _ body noret a))\n  = return [(L loc (LastStmt noExt body noret a), emptyFVs)]\n\nrn_rec_stmt_lhs fix_env (L loc (BindStmt _ pat body a b))\n  = do\n      -- should the ctxt be MDo instead?\n      (pat', fv_pat) <- rnBindPat (localRecNameMaker fix_env) pat\n      return [(L loc (BindStmt noExt pat' body a b), fv_pat)]\n\nrn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ binds@(HsIPBinds {}))))\n  = failWith (badIpBinds (text \"an mdo expression\") binds)\n\nrn_rec_stmt_lhs fix_env (L loc (LetStmt _ (L l (HsValBinds x binds))))\n    = do (_bound_names, binds') <- rnLocalValBindsLHS fix_env binds\n         return [(L loc (LetStmt noExt (L l (HsValBinds x binds'))),\n                 -- Warning: this is bogus; see function invariant\n                 emptyFVs\n                 )]\n\n-- XXX Do we need to do something with the return and mfix names?\nrn_rec_stmt_lhs fix_env (L _ (RecStmt { recS_stmts = stmts }))  -- Flatten Rec inside Rec\n    = rn_rec_stmts_lhs fix_env stmts\n\nrn_rec_stmt_lhs _ stmt@(L _ (ParStmt {}))       -- Syntactically illegal in mdo\n  = pprPanic \"rn_rec_stmt\" (ppr stmt)\n\nrn_rec_stmt_lhs _ stmt@(L _ (TransStmt {}))     -- Syntactically illegal in mdo\n  = pprPanic \"rn_rec_stmt\" (ppr stmt)\n\nrn_rec_stmt_lhs _ stmt@(L _ (ApplicativeStmt {})) -- Shouldn't appear yet\n  = pprPanic \"rn_rec_stmt\" (ppr stmt)\n\nrn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))))\n  = panic \"rn_rec_stmt LetStmt EmptyLocalBinds\"\nrn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR _))))\n  = panic \"rn_rec_stmt LetStmt XHsLocalBindsLR\"\nrn_rec_stmt_lhs _ (L _ (XStmtLR _))\n  = panic \"rn_rec_stmt XStmtLR\"\n\nrn_rec_stmts_lhs :: Outputable body => MiniFixityEnv\n                 -> [LStmt GhcPs body]\n                 -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]\nrn_rec_stmts_lhs fix_env stmts\n  = do { ls <- concatMapM (rn_rec_stmt_lhs fix_env) stmts\n       ; let boundNames = collectLStmtsBinders (map fst ls)\n            -- First do error checking: we need to check for dups here because we\n            -- don't bind all of the variables from the Stmt at once\n            -- with bindLocatedLocals.\n       ; checkDupNames boundNames\n       ; return ls }\n\n\n-- right-hand-sides\n\nrn_rec_stmt :: (Outputable (body GhcPs)) =>\n               (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n            -> [Name]\n            -> (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)\n            -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]\n        -- Rename a Stmt that is inside a RecStmt (or mdo)\n        -- Assumes all binders are already in scope\n        -- Turns each stmt into a singleton Stmt\nrn_rec_stmt rnBody _ (L loc (LastStmt _ body noret _), _)\n  = do  { (body', fv_expr) <- rnBody body\n        ; (ret_op, fvs1)   <- lookupSyntaxName returnMName\n        ; return [(emptyNameSet, fv_expr `plusFV` fvs1, emptyNameSet,\n                   L loc (LastStmt noExt body' noret ret_op))] }\n\nrn_rec_stmt rnBody _ (L loc (BodyStmt _ body _ _), _)\n  = do { (body', fvs) <- rnBody body\n       ; (then_op, fvs1) <- lookupSyntaxName thenMName\n       ; return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,\n                 L loc (BodyStmt noExt body' then_op noSyntaxExpr))] }\n\nrn_rec_stmt rnBody _ (L loc (BindStmt _ pat' body _ _), fv_pat)\n  = do { (body', fv_expr) <- rnBody body\n       ; (bind_op, fvs1) <- lookupSyntaxName bindMName\n\n       ; (fail_op, fvs2) <- getMonadFailOp\n\n       ; let bndrs = mkNameSet (collectPatBinders pat')\n             fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2\n       ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs,\n                  L loc (BindStmt noExt pat' body' bind_op fail_op))] }\n\nrn_rec_stmt _ _ (L _ (LetStmt _ (L _ binds@(HsIPBinds {}))), _)\n  = failWith (badIpBinds (text \"an mdo expression\") binds)\n\nrn_rec_stmt _ all_bndrs (L loc (LetStmt _ (L l (HsValBinds x binds'))), _)\n  = do { (binds', du_binds) <- rnLocalValBindsRHS (mkNameSet all_bndrs) binds'\n           -- fixities and unused are handled above in rnRecStmtsAndThen\n       ; let fvs = allUses du_binds\n       ; return [(duDefs du_binds, fvs, emptyNameSet,\n                 L loc (LetStmt noExt (L l (HsValBinds x binds'))))] }\n\n-- no RecStmt case because they get flattened above when doing the LHSes\nrn_rec_stmt _ _ stmt@(L _ (RecStmt {}), _)\n  = pprPanic \"rn_rec_stmt: RecStmt\" (ppr stmt)\n\nrn_rec_stmt _ _ stmt@(L _ (ParStmt {}), _)       -- Syntactically illegal in mdo\n  = pprPanic \"rn_rec_stmt: ParStmt\" (ppr stmt)\n\nrn_rec_stmt _ _ stmt@(L _ (TransStmt {}), _)     -- Syntactically illegal in mdo\n  = pprPanic \"rn_rec_stmt: TransStmt\" (ppr stmt)\n\nrn_rec_stmt _ _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR _))), _)\n  = panic \"rn_rec_stmt: LetStmt XHsLocalBindsLR\"\n\nrn_rec_stmt _ _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))), _)\n  = panic \"rn_rec_stmt: LetStmt EmptyLocalBinds\"\n\nrn_rec_stmt _ _ stmt@(L _ (ApplicativeStmt {}), _)\n  = pprPanic \"rn_rec_stmt: ApplicativeStmt\" (ppr stmt)\n\nrn_rec_stmt _ _ stmt@(L _ (XStmtLR {}), _)\n  = pprPanic \"rn_rec_stmt: XStmtLR\" (ppr stmt)\n\nrn_rec_stmts :: Outputable (body GhcPs) =>\n                (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))\n             -> [Name]\n             -> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]\n             -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]\nrn_rec_stmts rnBody bndrs stmts\n  = do { segs_s <- mapM (rn_rec_stmt rnBody bndrs) stmts\n       ; return (concat segs_s) }\n\n---------------------------------------------\nsegmentRecStmts :: SrcSpan -> HsStmtContext Name\n                -> Stmt GhcRn body\n                -> [Segment (LStmt GhcRn body)] -> FreeVars\n                -> ([LStmt GhcRn body], FreeVars)\n\nsegmentRecStmts loc ctxt empty_rec_stmt segs fvs_later\n  | null segs\n  = ([], fvs_later)\n\n  | MDoExpr <- ctxt\n  = segsToStmts empty_rec_stmt grouped_segs fvs_later\n               -- Step 4: Turn the segments into Stmts\n                --         Use RecStmt when and only when there are fwd refs\n                --         Also gather up the uses from the end towards the\n                --         start, so we can tell the RecStmt which things are\n                --         used 'after' the RecStmt\n\n  | otherwise\n  = ([ L loc $\n       empty_rec_stmt { recS_stmts = ss\n                      , recS_later_ids = nameSetElemsStable\n                                           (defs `intersectNameSet` fvs_later)\n                      , recS_rec_ids   = nameSetElemsStable\n                                           (defs `intersectNameSet` uses) }]\n          -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]\n    , uses `plusFV` fvs_later)\n\n  where\n    (defs_s, uses_s, _, ss) = unzip4 segs\n    defs = plusFVs defs_s\n    uses = plusFVs uses_s\n\n                -- Step 2: Fill in the fwd refs.\n                --         The segments are all singletons, but their fwd-ref\n                --         field mentions all the things used by the segment\n                --         that are bound after their use\n    segs_w_fwd_refs = addFwdRefs segs\n\n                -- Step 3: Group together the segments to make bigger segments\n                --         Invariant: in the result, no segment uses a variable\n                --                    bound in a later segment\n    grouped_segs = glomSegments ctxt segs_w_fwd_refs\n\n----------------------------\naddFwdRefs :: [Segment a] -> [Segment a]\n-- So far the segments only have forward refs *within* the Stmt\n--      (which happens for bind:  x <- ...x...)\n-- This function adds the cross-seg fwd ref info\n\naddFwdRefs segs\n  = fst (foldr mk_seg ([], emptyNameSet) segs)\n  where\n    mk_seg (defs, uses, fwds, stmts) (segs, later_defs)\n        = (new_seg : segs, all_defs)\n        where\n          new_seg = (defs, uses, new_fwds, stmts)\n          all_defs = later_defs `unionNameSet` defs\n          new_fwds = fwds `unionNameSet` (uses `intersectNameSet` later_defs)\n                -- Add the downstream fwd refs here\n\n{-\nNote [Segmenting mdo]\n~~~~~~~~~~~~~~~~~~~~~\nNB. June 7 2012: We only glom segments that appear in an explicit mdo;\nand leave those found in \"do rec\"'s intact.  See\nhttp://ghc.haskell.org/trac/ghc/ticket/4148 for the discussion\nleading to this design choice.  Hence the test in segmentRecStmts.\n\nNote [Glomming segments]\n~~~~~~~~~~~~~~~~~~~~~~~~\nGlomming the singleton segments of an mdo into minimal recursive groups.\n\nAt first I thought this was just strongly connected components, but\nthere's an important constraint: the order of the stmts must not change.\n\nConsider\n     mdo { x <- ...y...\n           p <- z\n           y <- ...x...\n           q <- x\n           z <- y\n           r <- x }\n\nHere, the first stmt mention 'y', which is bound in the third.\nBut that means that the innocent second stmt (p <- z) gets caught\nup in the recursion.  And that in turn means that the binding for\n'z' has to be included... and so on.\n\nStart at the tail { r <- x }\nNow add the next one { z <- y ; r <- x }\nNow add one more     { q <- x ; z <- y ; r <- x }\nNow one more... but this time we have to group a bunch into rec\n     { rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }\nNow one more, which we can add on without a rec\n     { p <- z ;\n       rec { y <- ...x... ; q <- x ; z <- y } ;\n       r <- x }\nFinally we add the last one; since it mentions y we have to\nglom it together with the first two groups\n     { rec { x <- ...y...; p <- z ; y <- ...x... ;\n             q <- x ; z <- y } ;\n       r <- x }\n-}\n\nglomSegments :: HsStmtContext Name\n             -> [Segment (LStmt GhcRn body)]\n             -> [Segment [LStmt GhcRn body]]\n                                  -- Each segment has a non-empty list of Stmts\n-- See Note [Glomming segments]\n\nglomSegments _ [] = []\nglomSegments ctxt ((defs,uses,fwds,stmt) : segs)\n        -- Actually stmts will always be a singleton\n  = (seg_defs, seg_uses, seg_fwds, seg_stmts)  : others\n  where\n    segs'            = glomSegments ctxt segs\n    (extras, others) = grab uses segs'\n    (ds, us, fs, ss) = unzip4 extras\n\n    seg_defs  = plusFVs ds `plusFV` defs\n    seg_uses  = plusFVs us `plusFV` uses\n    seg_fwds  = plusFVs fs `plusFV` fwds\n    seg_stmts = stmt : concat ss\n\n    grab :: NameSet             -- The client\n         -> [Segment a]\n         -> ([Segment a],       -- Needed by the 'client'\n             [Segment a])       -- Not needed by the client\n        -- The result is simply a split of the input\n    grab uses dus\n        = (reverse yeses, reverse noes)\n        where\n          (noes, yeses)           = span not_needed (reverse dus)\n          not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)\n\n----------------------------------------------------\nsegsToStmts :: Stmt GhcRn body\n                                  -- A RecStmt with the SyntaxOps filled in\n            -> [Segment [LStmt GhcRn body]]\n                                  -- Each Segment has a non-empty list of Stmts\n            -> FreeVars           -- Free vars used 'later'\n            -> ([LStmt GhcRn body], FreeVars)\n\nsegsToStmts _ [] fvs_later = ([], fvs_later)\nsegsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later\n  = ASSERT( not (null ss) )\n    (new_stmt : later_stmts, later_uses `plusFV` uses)\n  where\n    (later_stmts, later_uses) = segsToStmts empty_rec_stmt segs fvs_later\n    new_stmt | non_rec   = head ss\n             | otherwise = cL (getLoc (head ss)) rec_stmt\n    rec_stmt = empty_rec_stmt { recS_stmts     = ss\n                              , recS_later_ids = nameSetElemsStable used_later\n                              , recS_rec_ids   = nameSetElemsStable fwds }\n          -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]\n    non_rec    = isSingleton ss && isEmptyNameSet fwds\n    used_later = defs `intersectNameSet` later_uses\n                                -- The ones needed after the RecStmt\n\n{-\n************************************************************************\n*                                                                      *\nApplicativeDo\n*                                                                      *\n************************************************************************\n\nNote [ApplicativeDo]\n\n= Example =\n\nFor a sequence of statements\n\n do\n     x <- A\n     y <- B x\n     z <- C\n     return (f x y z)\n\nWe want to transform this to\n\n  (\\(x,y) z -> f x y z) <$> (do x <- A; y <- B x; return (x,y)) <*> C\n\nIt would be easy to notice that \"y <- B x\" and \"z <- C\" are\nindependent and do something like this:\n\n do\n     x <- A\n     (y,z) <- (,) <$> B x <*> C\n     return (f x y z)\n\nBut this isn't enough! A and C were also independent, and this\ntransformation loses the ability to do A and C in parallel.\n\nThe algorithm works by first splitting the sequence of statements into\nindependent \"segments\", and a separate \"tail\" (the final statement). In\nour example above, the segements would be\n\n     [ x <- A\n     , y <- B x ]\n\n     [ z <- C ]\n\nand the tail is:\n\n     return (f x y z)\n\nThen we take these segments and make an Applicative expression from them:\n\n     (\\(x,y) z -> return (f x y z))\n       <$> do { x <- A; y <- B x; return (x,y) }\n       <*> C\n\nFinally, we recursively apply the transformation to each segment, to\ndiscover any nested parallelism.\n\n= Syntax & spec =\n\n  expr ::= ... | do {stmt_1; ..; stmt_n} expr | ...\n\n  stmt ::= pat <- expr\n         | (arg_1 | ... | arg_n)  -- applicative composition, n>=1\n         | ...                    -- other kinds of statement (e.g. let)\n\n  arg ::= pat <- expr\n        | {stmt_1; ..; stmt_n} {var_1..var_n}\n\n(note that in the actual implementation,the expr in a do statement is\nrepresented by a LastStmt as the final stmt, this is just a\nrepresentational issue and may change later.)\n\n== Transformation to introduce applicative stmts ==\n\nado {} tail = tail\nado {pat <- expr} {return expr'} = (mkArg(pat <- expr)); return expr'\nado {one} tail = one : tail\nado stmts tail\n  | n == 1 = ado before (ado after tail)\n    where (before,after) = split(stmts_1)\n  | n > 1  = (mkArg(stmts_1) | ... | mkArg(stmts_n)); tail\n  where\n    {stmts_1 .. stmts_n} = segments(stmts)\n\nsegments(stmts) =\n  -- divide stmts into segments with no interdependencies\n\nmkArg({pat <- expr}) = (pat <- expr)\nmkArg({stmt_1; ...; stmt_n}) =\n  {stmt_1; ...; stmt_n} {vars(stmt_1) u .. u vars(stmt_n)}\n\nsplit({stmt_1; ..; stmt_n) =\n  ({stmt_1; ..; stmt_i}, {stmt_i+1; ..; stmt_n})\n  -- 1 <= i <= n\n  -- i is a good place to insert a bind\n\n== Desugaring for do ==\n\ndsDo {} expr = expr\n\ndsDo {pat <- rhs; stmts} expr =\n   rhs >>= \\pat -> dsDo stmts expr\n\ndsDo {(arg_1 | ... | arg_n)} (return expr) =\n  (\\argpat (arg_1) .. argpat(arg_n) -> expr)\n     <$> argexpr(arg_1)\n     <*> ...\n     <*> argexpr(arg_n)\n\ndsDo {(arg_1 | ... | arg_n); stmts} expr =\n  join (\\argpat (arg_1) .. argpat(arg_n) -> dsDo stmts expr)\n     <$> argexpr(arg_1)\n     <*> ...\n     <*> argexpr(arg_n)\n\n-}\n\n-- | The 'Name's of @return@ and @pure@. These may not be 'returnName' and\n-- 'pureName' due to @RebindableSyntax@.\ndata MonadNames = MonadNames { return_name, pure_name :: Name }\n\n-- | rearrange a list of statements using ApplicativeDoStmt.  See\n-- Note [ApplicativeDo].\nrearrangeForApplicativeDo\n  :: HsStmtContext Name\n  -> [(ExprLStmt GhcRn, FreeVars)]\n  -> RnM ([ExprLStmt GhcRn], FreeVars)\n\nrearrangeForApplicativeDo _ [] = return ([], emptyNameSet)\nrearrangeForApplicativeDo _ [(one,_)] = return ([one], emptyNameSet)\nrearrangeForApplicativeDo ctxt stmts0 = do\n  optimal_ado <- goptM Opt_OptimalApplicativeDo\n  let stmt_tree | optimal_ado = mkStmtTreeOptimal stmts\n                | otherwise = mkStmtTreeHeuristic stmts\n  traceRn \"rearrangeForADo\" (ppr stmt_tree)\n  return_name <- lookupSyntaxName' returnMName\n  pure_name   <- lookupSyntaxName' pureAName\n  let monad_names = MonadNames { return_name = return_name\n                               , pure_name   = pure_name }\n  stmtTreeToStmts monad_names ctxt stmt_tree [last] last_fvs\n  where\n    (stmts,(last,last_fvs)) = findLast stmts0\n    findLast [] = error \"findLast\"\n    findLast [last] = ([],last)\n    findLast (x:xs) = (x:rest,last) where (rest,last) = findLast xs\n\n-- | A tree of statements using a mixture of applicative and bind constructs.\ndata StmtTree a\n  = StmtTreeOne a\n  | StmtTreeBind (StmtTree a) (StmtTree a)\n  | StmtTreeApplicative [StmtTree a]\n\ninstance Outputable a => Outputable (StmtTree a) where\n  ppr (StmtTreeOne x)          = parens (text \"StmtTreeOne\" <+> ppr x)\n  ppr (StmtTreeBind x y)       = parens (hang (text \"StmtTreeBind\")\n                                            2 (sep [ppr x, ppr y]))\n  ppr (StmtTreeApplicative xs) = parens (hang (text \"StmtTreeApplicative\")\n                                            2 (vcat (map ppr xs)))\n\nflattenStmtTree :: StmtTree a -> [a]\nflattenStmtTree t = go t []\n where\n  go (StmtTreeOne a) as = a : as\n  go (StmtTreeBind l r) as = go l (go r as)\n  go (StmtTreeApplicative ts) as = foldr go as ts\n\ntype ExprStmtTree = StmtTree (ExprLStmt GhcRn, FreeVars)\ntype Cost = Int\n\n-- | Turn a sequence of statements into an ExprStmtTree using a\n-- heuristic algorithm.  /O(n^2)/\nmkStmtTreeHeuristic :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree\nmkStmtTreeHeuristic [one] = StmtTreeOne one\nmkStmtTreeHeuristic stmts =\n  case segments stmts of\n    [one] -> split one\n    segs -> StmtTreeApplicative (map split segs)\n where\n  split [one] = StmtTreeOne one\n  split stmts =\n    StmtTreeBind (mkStmtTreeHeuristic before) (mkStmtTreeHeuristic after)\n    where (before, after) = splitSegment stmts\n\n-- | Turn a sequence of statements into an ExprStmtTree optimally,\n-- using dynamic programming.  /O(n^3)/\nmkStmtTreeOptimal :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree\nmkStmtTreeOptimal stmts =\n  ASSERT(not (null stmts)) -- the empty case is handled by the caller;\n                           -- we don't support empty StmtTrees.\n  fst (arr ! (0,n))\n  where\n    n = length stmts - 1\n    stmt_arr = listArray (0,n) stmts\n\n    -- lazy cache of optimal trees for subsequences of the input\n    arr :: Array (Int,Int) (ExprStmtTree, Cost)\n    arr = array ((0,0),(n,n))\n             [ ((lo,hi), tree lo hi)\n             | lo <- [0..n]\n             , hi <- [lo..n] ]\n\n    -- compute the optimal tree for the sequence [lo..hi]\n    tree lo hi\n      | hi == lo = (StmtTreeOne (stmt_arr ! lo), 1)\n      | otherwise =\n         case segments [ stmt_arr ! i | i <- [lo..hi] ] of\n           [] -> panic \"mkStmtTree\"\n           [_one] -> split lo hi\n           segs -> (StmtTreeApplicative trees, maximum costs)\n             where\n               bounds = scanl (\\(_,hi) a -> (hi+1, hi + length a)) (0,lo-1) segs\n               (trees,costs) = unzip (map (uncurry split) (tail bounds))\n\n    -- find the best place to split the segment [lo..hi]\n    split :: Int -> Int -> (ExprStmtTree, Cost)\n    split lo hi\n      | hi == lo = (StmtTreeOne (stmt_arr ! lo), 1)\n      | otherwise = (StmtTreeBind before after, c1+c2)\n        where\n         -- As per the paper, for a sequence s1...sn, we want to find\n         -- the split with the minimum cost, where the cost is the\n         -- sum of the cost of the left and right subsequences.\n         --\n         -- As an optimisation (also in the paper) if the cost of\n         -- s1..s(n-1) is different from the cost of s2..sn, we know\n         -- that the optimal solution is the lower of the two.  Only\n         -- in the case that these two have the same cost do we need\n         -- to do the exhaustive search.\n         --\n         ((before,c1),(after,c2))\n           | hi - lo == 1\n           = ((StmtTreeOne (stmt_arr ! lo), 1),\n              (StmtTreeOne (stmt_arr ! hi), 1))\n           | left_cost < right_cost\n           = ((left,left_cost), (StmtTreeOne (stmt_arr ! hi), 1))\n           | left_cost > right_cost\n           = ((StmtTreeOne (stmt_arr ! lo), 1), (right,right_cost))\n           | otherwise = minimumBy (comparing cost) alternatives\n           where\n             (left, left_cost) = arr ! (lo,hi-1)\n             (right, right_cost) = arr ! (lo+1,hi)\n             cost ((_,c1),(_,c2)) = c1 + c2\n             alternatives = [ (arr ! (lo,k), arr ! (k+1,hi))\n                            | k <- [lo .. hi-1] ]\n\n\n-- | Turn the ExprStmtTree back into a sequence of statements, using\n-- ApplicativeStmt where necessary.\nstmtTreeToStmts\n  :: MonadNames\n  -> HsStmtContext Name\n  -> ExprStmtTree\n  -> [ExprLStmt GhcRn]             -- ^ the \"tail\"\n  -> FreeVars                     -- ^ free variables of the tail\n  -> RnM ( [ExprLStmt GhcRn]       -- ( output statements,\n         , FreeVars )             -- , things we needed\n\n-- If we have a single bind, and we can do it without a join, transform\n-- to an ApplicativeStmt.  This corresponds to the rule\n--   dsBlock [pat <- rhs] (return expr) = expr <$> rhs\n-- In the spec, but we do it here rather than in the desugarer,\n-- because we need the typechecker to typecheck the <$> form rather than\n-- the bind form, which would give rise to a Monad constraint.\nstmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ _), _))\n                tail _tail_fvs\n  | not (isStrictPattern pat), (False,tail') <- needJoin monad_names tail\n  -- See Note [ApplicativeDo and strict patterns]\n  = mkApplicativeStmt ctxt [ApplicativeArgOne noExt pat rhs False] False tail'\nstmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_))\n                tail _tail_fvs\n  | (False,tail') <- needJoin monad_names tail\n  = mkApplicativeStmt ctxt\n      [ApplicativeArgOne noExt nlWildPatName rhs True] False tail'\n\nstmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs =\n  return (s : tail, emptyNameSet)\n\nstmtTreeToStmts monad_names ctxt (StmtTreeBind before after) tail tail_fvs = do\n  (stmts1, fvs1) <- stmtTreeToStmts monad_names ctxt after tail tail_fvs\n  let tail1_fvs = unionNameSets (tail_fvs : map snd (flattenStmtTree after))\n  (stmts2, fvs2) <- stmtTreeToStmts monad_names ctxt before stmts1 tail1_fvs\n  return (stmts2, fvs1 `plusFV` fvs2)\n\nstmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do\n   pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees\n   let (stmts', fvss) = unzip pairs\n   let (need_join, tail') = needJoin monad_names tail\n   (stmts, fvs) <- mkApplicativeStmt ctxt stmts' need_join tail'\n   return (stmts, unionNameSets (fvs:fvss))\n where\n   stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BindStmt _ pat exp _ _), _))\n     = return (ApplicativeArgOne noExt pat exp False, emptyFVs)\n   stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) =\n     return (ApplicativeArgOne noExt nlWildPatName exp True, emptyFVs)\n   stmtTreeArg ctxt tail_fvs tree = do\n     let stmts = flattenStmtTree tree\n         pvarset = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts)\n                     `intersectNameSet` tail_fvs\n         pvars = nameSetElemsStable pvarset\n           -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring]\n         pat = mkBigLHsVarPatTup pvars\n         tup = mkBigLHsVarTup pvars\n     (stmts',fvs2) <- stmtTreeToStmts monad_names ctxt tree [] pvarset\n     (mb_ret, fvs1) <-\n        if | L _ ApplicativeStmt{} <- last stmts' ->\n             return (unLoc tup, emptyNameSet)\n           | otherwise -> do\n             (ret,fvs) <- lookupStmtNamePoly ctxt returnMName\n             return (HsApp noExt (noLoc ret) tup, fvs)\n     return ( ApplicativeArgMany noExt stmts' mb_ret pat\n            , fvs1 `plusFV` fvs2)\n\n\n-- | Divide a sequence of statements into segments, where no segment\n-- depends on any variables defined by a statement in another segment.\nsegments\n  :: [(ExprLStmt GhcRn, FreeVars)]\n  -> [[(ExprLStmt GhcRn, FreeVars)]]\nsegments stmts = map fst $ merge $ reverse $ map reverse $ walk (reverse stmts)\n  where\n    allvars = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts)\n\n    -- We would rather not have a segment that just has LetStmts in\n    -- it, so combine those with an adjacent segment where possible.\n    merge [] = []\n    merge (seg : segs)\n       = case rest of\n          [] -> [(seg,all_lets)]\n          ((s,s_lets):ss) | all_lets || s_lets\n               -> (seg ++ s, all_lets && s_lets) : ss\n          _otherwise -> (seg,all_lets) : rest\n      where\n        rest = merge segs\n        all_lets = all (isLetStmt . fst) seg\n\n    -- walk splits the statement sequence into segments, traversing\n    -- the sequence from the back to the front, and keeping track of\n    -- the set of free variables of the current segment.  Whenever\n    -- this set of free variables is empty, we have a complete segment.\n    walk :: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]\n    walk [] = []\n    walk ((stmt,fvs) : stmts) = ((stmt,fvs) : seg) : walk rest\n      where (seg,rest) = chunter fvs' stmts\n            (_, fvs') = stmtRefs stmt fvs\n\n    chunter _ [] = ([], [])\n    chunter vars ((stmt,fvs) : rest)\n       | not (isEmptyNameSet vars)\n       || isStrictPatternBind stmt\n           -- See Note [ApplicativeDo and strict patterns]\n       = ((stmt,fvs) : chunk, rest')\n       where (chunk,rest') = chunter vars' rest\n             (pvars, evars) = stmtRefs stmt fvs\n             vars' = (vars `minusNameSet` pvars) `unionNameSet` evars\n    chunter _ rest = ([], rest)\n\n    stmtRefs stmt fvs\n      | isLetStmt stmt = (pvars, fvs' `minusNameSet` pvars)\n      | otherwise      = (pvars, fvs')\n      where fvs' = fvs `intersectNameSet` allvars\n            pvars = mkNameSet (collectStmtBinders (unLoc stmt))\n\n    isStrictPatternBind :: ExprLStmt GhcRn -> Bool\n    isStrictPatternBind (L _ (BindStmt _ pat _ _ _)) = isStrictPattern pat\n    isStrictPatternBind _ = False\n\n{-\nNote [ApplicativeDo and strict patterns]\n\nA strict pattern match is really a dependency.  For example,\n\ndo\n  (x,y) <- A\n  z <- B\n  return C\n\nThe pattern (_,_) must be matched strictly before we do B.  If we\nallowed this to be transformed into\n\n  (\\(x,y) -> \\z -> C) <$> A <*> B\n\nthen it could be lazier than the standard desuraging using >>=.  See #13875\nfor more examples.\n\nThus, whenever we have a strict pattern match, we treat it as a\ndependency between that statement and the following one.  The\ndependency prevents those two statements from being performed \"in\nparallel\" in an ApplicativeStmt, but doesn't otherwise affect what we\ncan do with the rest of the statements in the same \"do\" expression.\n-}\n\nisStrictPattern :: LPat (GhcPass p) -> Bool\nisStrictPattern lpat =\n  case unLoc lpat of\n    WildPat{}       -> False\n    VarPat{}        -> False\n    LazyPat{}       -> False\n    AsPat _ _ p     -> isStrictPattern p\n    ParPat _ p      -> isStrictPattern p\n    ViewPat _ _ p   -> isStrictPattern p\n    SigPat _ p _    -> isStrictPattern p\n    BangPat{}       -> True\n    ListPat{}       -> True\n    TuplePat{}      -> True\n    SumPat{}        -> True\n    ConPatIn{}      -> True\n    ConPatOut{}     -> True\n    LitPat{}        -> True\n    NPat{}          -> True\n    NPlusKPat{}     -> True\n    SplicePat{}     -> True\n    _otherwise -> panic \"isStrictPattern\"\n\nisLetStmt :: LStmt a b -> Bool\nisLetStmt (L _ LetStmt{}) = True\nisLetStmt _ = False\n\n-- | Find a \"good\" place to insert a bind in an indivisible segment.\n-- This is the only place where we use heuristics.  The current\n-- heuristic is to peel off the first group of independent statements\n-- and put the bind after those.\nsplitSegment\n  :: [(ExprLStmt GhcRn, FreeVars)]\n  -> ( [(ExprLStmt GhcRn, FreeVars)]\n     , [(ExprLStmt GhcRn, FreeVars)] )\nsplitSegment [one,two] = ([one],[two])\n  -- there is no choice when there are only two statements; this just saves\n  -- some work in a common case.\nsplitSegment stmts\n  | Just (lets,binds,rest) <- slurpIndependentStmts stmts\n  =  if not (null lets)\n       then (lets, binds++rest)\n       else (lets++binds, rest)\n  | otherwise\n  = case stmts of\n      (x:xs) -> ([x],xs)\n      _other -> (stmts,[])\n\nslurpIndependentStmts\n   :: [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]\n   -> Maybe ( [(LStmt GhcRn (Located (body GhcRn)), FreeVars)] -- LetStmts\n            , [(LStmt GhcRn (Located (body GhcRn)), FreeVars)] -- BindStmts\n            , [(LStmt GhcRn (Located (body GhcRn)), FreeVars)] )\nslurpIndependentStmts stmts = go [] [] emptyNameSet stmts\n where\n  -- If we encounter a BindStmt that doesn't depend on a previous BindStmt\n  -- in this group, then add it to the group. We have to be careful about\n  -- strict patterns though; splitSegments expects that if we return Just\n  -- then we have actually done some splitting. Otherwise it will go into\n  -- an infinite loop (#14163).\n  go lets indep bndrs ((L loc (BindStmt _ pat body bind_op fail_op), fvs): rest)\n    | isEmptyNameSet (bndrs `intersectNameSet` fvs) && not (isStrictPattern pat)\n    = go lets ((L loc (BindStmt noExt pat body bind_op fail_op), fvs) : indep)\n         bndrs' rest\n    where bndrs' = bndrs `unionNameSet` mkNameSet (collectPatBinders pat)\n  -- If we encounter a LetStmt that doesn't depend on a BindStmt in this\n  -- group, then move it to the beginning, so that it doesn't interfere with\n  -- grouping more BindStmts.\n  -- TODO: perhaps we shouldn't do this if there are any strict bindings,\n  -- because we might be moving evaluation earlier.\n  go lets indep bndrs ((L loc (LetStmt noExt binds), fvs) : rest)\n    | isEmptyNameSet (bndrs `intersectNameSet` fvs)\n    = go ((L loc (LetStmt noExt binds), fvs) : lets) indep bndrs rest\n  go _ []  _ _ = Nothing\n  go _ [_] _ _ = Nothing\n  go lets indep _ stmts = Just (reverse lets, reverse indep, stmts)\n\n-- | Build an ApplicativeStmt, and strip the \"return\" from the tail\n-- if necessary.\n--\n-- For example, if we start with\n--   do x <- E1; y <- E2; return (f x y)\n-- then we get\n--   do (E1[x] | E2[y]); f x y\n--\n-- the LastStmt in this case has the return removed, but we set the\n-- flag on the LastStmt to indicate this, so that we can print out the\n-- original statement correctly in error messages.  It is easier to do\n-- it this way rather than try to ignore the return later in both the\n-- typechecker and the desugarer (I tried it that way first!).\nmkApplicativeStmt\n  :: HsStmtContext Name\n  -> [ApplicativeArg GhcRn]             -- ^ The args\n  -> Bool                               -- ^ True <=> need a join\n  -> [ExprLStmt GhcRn]        -- ^ The body statements\n  -> RnM ([ExprLStmt GhcRn], FreeVars)\nmkApplicativeStmt ctxt args need_join body_stmts\n  = do { (fmap_op, fvs1) <- lookupStmtName ctxt fmapName\n       ; (ap_op, fvs2) <- lookupStmtName ctxt apAName\n       ; (mb_join, fvs3) <-\n           if need_join then\n             do { (join_op, fvs) <- lookupStmtName ctxt joinMName\n                ; return (Just join_op, fvs) }\n           else\n             return (Nothing, emptyNameSet)\n       ; let applicative_stmt = noLoc $ ApplicativeStmt noExt\n               (zip (fmap_op : repeat ap_op) args)\n               mb_join\n       ; return ( applicative_stmt : body_stmts\n                , fvs1 `plusFV` fvs2 `plusFV` fvs3) }\n\n-- | Given the statements following an ApplicativeStmt, determine whether\n-- we need a @join@ or not, and remove the @return@ if necessary.\nneedJoin :: MonadNames\n         -> [ExprLStmt GhcRn]\n         -> (Bool, [ExprLStmt GhcRn])\nneedJoin _monad_names [] = (False, [])  -- we're in an ApplicativeArg\nneedJoin monad_names  [L loc (LastStmt _ e _ t)]\n | Just arg <- isReturnApp monad_names e =\n       (False, [L loc (LastStmt noExt arg True t)])\nneedJoin _monad_names stmts = (True, stmts)\n\n-- | @Just e@, if the expression is @return e@ or @return $ e@,\n-- otherwise @Nothing@\nisReturnApp :: MonadNames\n            -> LHsExpr GhcRn\n            -> Maybe (LHsExpr GhcRn)\nisReturnApp monad_names (L _ (HsPar _ expr)) = isReturnApp monad_names expr\nisReturnApp monad_names (L _ e) = case e of\n  OpApp _ l op r | is_return l, is_dollar op -> Just r\n  HsApp _ f arg  | is_return f               -> Just arg\n  _otherwise -> Nothing\n where\n  is_var f (L _ (HsPar _ e)) = is_var f e\n  is_var f (L _ (HsAppType _ e _)) = is_var f e\n  is_var f (L _ (HsVar _ (L _ r))) = f r\n       -- TODO: I don't know how to get this right for rebindable syntax\n  is_var _ _ = False\n\n  is_return = is_var (\\n -> n == return_name monad_names\n                         || n == pure_name monad_names)\n  is_dollar = is_var (`hasKey` dollarIdKey)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Errors}\n*                                                                      *\n************************************************************************\n-}\n\ncheckEmptyStmts :: HsStmtContext Name -> RnM ()\n-- We've seen an empty sequence of Stmts... is that ok?\ncheckEmptyStmts ctxt\n  = unless (okEmpty ctxt) (addErr (emptyErr ctxt))\n\nokEmpty :: HsStmtContext a -> Bool\nokEmpty (PatGuard {}) = True\nokEmpty _             = False\n\nemptyErr :: HsStmtContext Name -> SDoc\nemptyErr (ParStmtCtxt {})   = text \"Empty statement group in parallel comprehension\"\nemptyErr (TransStmtCtxt {}) = text \"Empty statement group preceding 'group' or 'then'\"\nemptyErr ctxt               = text \"Empty\" <+> pprStmtContext ctxt\n\n----------------------\ncheckLastStmt :: Outputable (body GhcPs) => HsStmtContext Name\n              -> LStmt GhcPs (Located (body GhcPs))\n              -> RnM (LStmt GhcPs (Located (body GhcPs)))\ncheckLastStmt ctxt lstmt@(L loc stmt)\n  = case ctxt of\n      ListComp  -> check_comp\n      MonadComp -> check_comp\n      ArrowExpr -> check_do\n      DoExpr    -> check_do\n      MDoExpr   -> check_do\n      _         -> check_other\n  where\n    check_do    -- Expect BodyStmt, and change it to LastStmt\n      = case stmt of\n          BodyStmt _ e _ _ -> return (L loc (mkLastStmt e))\n          LastStmt {}      -> return lstmt   -- \"Deriving\" clauses may generate a\n                                             -- LastStmt directly (unlike the parser)\n          _                -> do { addErr (hang last_error 2 (ppr stmt)); return lstmt }\n    last_error = (text \"The last statement in\" <+> pprAStmtContext ctxt\n                  <+> text \"must be an expression\")\n\n    check_comp  -- Expect LastStmt; this should be enforced by the parser!\n      = case stmt of\n          LastStmt {} -> return lstmt\n          _           -> pprPanic \"checkLastStmt\" (ppr lstmt)\n\n    check_other -- Behave just as if this wasn't the last stmt\n      = do { checkStmt ctxt lstmt; return lstmt }\n\n-- Checking when a particular Stmt is ok\ncheckStmt :: HsStmtContext Name\n          -> LStmt GhcPs (Located (body GhcPs))\n          -> RnM ()\ncheckStmt ctxt (L _ stmt)\n  = do { dflags <- getDynFlags\n       ; case okStmt dflags ctxt stmt of\n           IsValid        -> return ()\n           NotValid extra -> addErr (msg $$ extra) }\n  where\n   msg = sep [ text \"Unexpected\" <+> pprStmtCat stmt <+> ptext (sLit \"statement\")\n             , text \"in\" <+> pprAStmtContext ctxt ]\n\npprStmtCat :: Stmt a body -> SDoc\npprStmtCat (TransStmt {})     = text \"transform\"\npprStmtCat (LastStmt {})      = text \"return expression\"\npprStmtCat (BodyStmt {})      = text \"body\"\npprStmtCat (BindStmt {})      = text \"binding\"\npprStmtCat (LetStmt {})       = text \"let\"\npprStmtCat (RecStmt {})       = text \"rec\"\npprStmtCat (ParStmt {})       = text \"parallel\"\npprStmtCat (ApplicativeStmt {}) = panic \"pprStmtCat: ApplicativeStmt\"\npprStmtCat (XStmtLR {})         = panic \"pprStmtCat: XStmtLR\"\n\n------------\nemptyInvalid :: Validity  -- Payload is the empty document\nemptyInvalid = NotValid Outputable.empty\n\nokStmt, okDoStmt, okCompStmt, okParStmt\n   :: DynFlags -> HsStmtContext Name\n   -> Stmt GhcPs (Located (body GhcPs)) -> Validity\n-- Return Nothing if OK, (Just extra) if not ok\n-- The \"extra\" is an SDoc that is appended to a generic error message\n\nokStmt dflags ctxt stmt\n  = case ctxt of\n      PatGuard {}        -> okPatGuardStmt stmt\n      ParStmtCtxt ctxt   -> okParStmt  dflags ctxt stmt\n      DoExpr             -> okDoStmt   dflags ctxt stmt\n      MDoExpr            -> okDoStmt   dflags ctxt stmt\n      ArrowExpr          -> okDoStmt   dflags ctxt stmt\n      GhciStmtCtxt       -> okDoStmt   dflags ctxt stmt\n      ListComp           -> okCompStmt dflags ctxt stmt\n      MonadComp          -> okCompStmt dflags ctxt stmt\n      TransStmtCtxt ctxt -> okStmt dflags ctxt stmt\n\n-------------\nokPatGuardStmt :: Stmt GhcPs (Located (body GhcPs)) -> Validity\nokPatGuardStmt stmt\n  = case stmt of\n      BodyStmt {} -> IsValid\n      BindStmt {} -> IsValid\n      LetStmt {}  -> IsValid\n      _           -> emptyInvalid\n\n-------------\nokParStmt dflags ctxt stmt\n  = case stmt of\n      LetStmt _ (L _ (HsIPBinds {})) -> emptyInvalid\n      _                              -> okStmt dflags ctxt stmt\n\n----------------\nokDoStmt dflags ctxt stmt\n  = case stmt of\n       RecStmt {}\n         | LangExt.RecursiveDo `xopt` dflags -> IsValid\n         | ArrowExpr <- ctxt -> IsValid    -- Arrows allows 'rec'\n         | otherwise         -> NotValid (text \"Use RecursiveDo\")\n       BindStmt {} -> IsValid\n       LetStmt {}  -> IsValid\n       BodyStmt {} -> IsValid\n       _           -> emptyInvalid\n\n----------------\nokCompStmt dflags _ stmt\n  = case stmt of\n       BindStmt {} -> IsValid\n       LetStmt {}  -> IsValid\n       BodyStmt {} -> IsValid\n       ParStmt {}\n         | LangExt.ParallelListComp `xopt` dflags -> IsValid\n         | otherwise -> NotValid (text \"Use ParallelListComp\")\n       TransStmt {}\n         | LangExt.TransformListComp `xopt` dflags -> IsValid\n         | otherwise -> NotValid (text \"Use TransformListComp\")\n       RecStmt {}  -> emptyInvalid\n       LastStmt {} -> emptyInvalid  -- Should not happen (dealt with by checkLastStmt)\n       ApplicativeStmt {} -> emptyInvalid\n       XStmtLR{} -> panic \"okCompStmt\"\n\n---------\ncheckTupleSection :: [LHsTupArg GhcPs] -> RnM ()\ncheckTupleSection args\n  = do  { tuple_section <- xoptM LangExt.TupleSections\n        ; checkErr (all tupArgPresent args || tuple_section) msg }\n  where\n    msg = text \"Illegal tuple section: use TupleSections\"\n\n---------\nsectionErr :: HsExpr GhcPs -> SDoc\nsectionErr expr\n  = hang (text \"A section must be enclosed in parentheses\")\n       2 (text \"thus:\" <+> (parens (ppr expr)))\n\npatSynErr :: HsExpr GhcPs -> SDoc -> RnM (HsExpr GhcRn, FreeVars)\npatSynErr e explanation = do { addErr (sep [text \"Pattern syntax in expression context:\",\n                                nest 4 (ppr e)] $$\n                                  explanation)\n                 ; return (EWildPat noExt, emptyFVs) }\n\nbadIpBinds :: Outputable a => SDoc -> a -> SDoc\nbadIpBinds what binds\n  = hang (text \"Implicit-parameter bindings illegal in\" <+> what)\n         2 (ppr binds)\n\n---------\n\nlookupSyntaxMonadFailOpName :: Bool -> RnM (SyntaxExpr GhcRn, FreeVars)\nlookupSyntaxMonadFailOpName monadFailEnabled\n  | monadFailEnabled = lookupSyntaxName failMName\n  | otherwise        = lookupSyntaxName failMName_preMFP\n\nmonadFailOp :: LPat GhcPs\n            -> HsStmtContext Name\n            -> RnM (SyntaxExpr GhcRn, FreeVars)\nmonadFailOp pat ctxt\n  -- If the pattern is irrefutable (e.g.: wildcard, tuple, ~pat, etc.)\n  -- we should not need to fail.\n  | isIrrefutableHsPat pat = return (noSyntaxExpr, emptyFVs)\n\n  -- For non-monadic contexts (e.g. guard patterns, list\n  -- comprehensions, etc.) we should not need to fail.  See Note\n  -- [Failing pattern matches in Stmts]\n  | not (isMonadFailStmtContext ctxt) = return (noSyntaxExpr, emptyFVs)\n\n  | otherwise = getMonadFailOp\n\n{-\nNote [Monad fail : Rebindable syntax, overloaded strings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nGiven the code\n  foo x = do { Just y <- x; return y }\n\nwe expect it to desugar as\n  foo x = x >>= \\r -> case r of\n                        Just y  -> return y\n                        Nothing -> fail \"Pattern match error\"\n\nBut with RebindableSyntax and OverloadedStrings, we really want\nit to desugar thus:\n  foo x = x >>= \\r -> case r of\n                        Just y  -> return y\n                        Nothing -> fail (fromString \"Patterm match error\")\n\nSo, in this case, we synthesize the function\n  \\x -> fail (fromString x)\n\n(rather than plain 'fail') for the 'fail' operation. This is done in\n'getMonadFailOp'.\n-}\ngetMonadFailOp :: RnM (SyntaxExpr GhcRn, FreeVars) -- Syntax expr fail op\ngetMonadFailOp\n = do { xMonadFailEnabled <- fmap (xopt LangExt.MonadFailDesugaring) getDynFlags\n      ; xOverloadedStrings <- fmap (xopt LangExt.OverloadedStrings) getDynFlags\n      ; xRebindableSyntax <- fmap (xopt LangExt.RebindableSyntax) getDynFlags\n      ; reallyGetMonadFailOp xRebindableSyntax xOverloadedStrings xMonadFailEnabled }\n  where\n    reallyGetMonadFailOp rebindableSyntax overloadedStrings monadFailEnabled\n      | rebindableSyntax && overloadedStrings = do\n        (failExpr, failFvs) <- lookupSyntaxMonadFailOpName monadFailEnabled\n        (fromStringExpr, fromStringFvs) <- lookupSyntaxName fromStringName\n        let arg_lit = fsLit \"arg\"\n            arg_name = mkSystemVarName (mkVarOccUnique arg_lit) arg_lit\n            arg_syn_expr = mkRnSyntaxExpr arg_name\n        let body :: LHsExpr GhcRn =\n              nlHsApp (noLoc $ syn_expr failExpr)\n                      (nlHsApp (noLoc $ syn_expr fromStringExpr)\n                                (noLoc $ syn_expr arg_syn_expr))\n        let failAfterFromStringExpr :: HsExpr GhcRn =\n              unLoc $ mkHsLam [noLoc $ VarPat noExt $ noLoc arg_name] body\n        let failAfterFromStringSynExpr :: SyntaxExpr GhcRn =\n              mkSyntaxExpr failAfterFromStringExpr\n        return (failAfterFromStringSynExpr, failFvs `plusFV` fromStringFvs)\n      | otherwise = lookupSyntaxMonadFailOpName monadFailEnabled\n", "num_lines": 2171}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns #-}\n\n{-\n\nThis module contains code which maintains and manipulates the\nfixity environment during renaming.\n\n-}\nmodule RnFixity ( MiniFixityEnv,\n                  addLocalFixities,\n  lookupFixityRn, lookupFixityRn_help,\n  lookupFieldFixityRn, lookupTyFixityRn ) where\n\nimport GhcPrelude\n\nimport LoadIface\nimport HsSyn\nimport RdrName\nimport HscTypes\nimport TcRnMonad\nimport Name\nimport NameEnv\nimport Module\nimport BasicTypes       ( Fixity(..), FixityDirection(..), minPrecedence,\n                          defaultFixity, SourceText(..) )\nimport SrcLoc\nimport Outputable\nimport Maybes\nimport Data.List\nimport Data.Function    ( on )\nimport RnUnbound\n\n{-\n*********************************************************\n*                                                      *\n                Fixities\n*                                                      *\n*********************************************************\n\nNote [Fixity signature lookup]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA fixity declaration like\n\n    infixr 2 ?\n\ncan refer to a value-level operator, e.g.:\n\n    (?) :: String -> String -> String\n\nor a type-level operator, like:\n\n    data (?) a b = A a | B b\n\nso we extend the lookup of the reader name '?' to the TcClsName namespace, as\nwell as the original namespace.\n\nThe extended lookup is also used in other places, like resolution of\ndeprecation declarations, and lookup of names in GHCi.\n-}\n\n--------------------------------\ntype MiniFixityEnv = FastStringEnv (Located Fixity)\n        -- Mini fixity env for the names we're about\n        -- to bind, in a single binding group\n        --\n        -- It is keyed by the *FastString*, not the *OccName*, because\n        -- the single fixity decl       infix 3 T\n        -- affects both the data constructor T and the type constrctor T\n        --\n        -- We keep the location so that if we find\n        -- a duplicate, we can report it sensibly\n\n--------------------------------\n-- Used for nested fixity decls to bind names along with their fixities.\n-- the fixities are given as a UFM from an OccName's FastString to a fixity decl\n\naddLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a\naddLocalFixities mini_fix_env names thing_inside\n  = extendFixityEnv (mapMaybe find_fixity names) thing_inside\n  where\n    find_fixity name\n      = case lookupFsEnv mini_fix_env (occNameFS occ) of\n          Just lfix -> Just (name, FixItem occ (unLoc lfix))\n          Nothing   -> Nothing\n      where\n        occ = nameOccName name\n\n{-\n--------------------------------\nlookupFixity is a bit strange.\n\n* Nested local fixity decls are put in the local fixity env, which we\n  find with getFixtyEnv\n\n* Imported fixities are found in the PIT\n\n* Top-level fixity decls in this module may be for Names that are\n    either  Global         (constructors, class operations)\n    or      Local/Exported (everything else)\n  (See notes with RnNames.getLocalDeclBinders for why we have this split.)\n  We put them all in the local fixity environment\n-}\n\nlookupFixityRn :: Name -> RnM Fixity\nlookupFixityRn name = lookupFixityRn' name (nameOccName name)\n\nlookupFixityRn' :: Name -> OccName -> RnM Fixity\nlookupFixityRn' name = fmap snd . lookupFixityRn_help' name\n\n-- | 'lookupFixityRn_help' returns @(True, fixity)@ if it finds a 'Fixity'\n-- in a local environment or from an interface file. Otherwise, it returns\n-- @(False, fixity)@ (e.g., for unbound 'Name's or 'Name's without\n-- user-supplied fixity declarations).\nlookupFixityRn_help :: Name\n                    -> RnM (Bool, Fixity)\nlookupFixityRn_help name =\n    lookupFixityRn_help' name (nameOccName name)\n\nlookupFixityRn_help' :: Name\n                     -> OccName\n                     -> RnM (Bool, Fixity)\nlookupFixityRn_help' name occ\n  | isUnboundName name\n  = return (False, Fixity NoSourceText minPrecedence InfixL)\n    -- Minimise errors from ubound names; eg\n    --    a>0 `foo` b>0\n    -- where 'foo' is not in scope, should not give an error (Trac #7937)\n\n  | otherwise\n  = do { local_fix_env <- getFixityEnv\n       ; case lookupNameEnv local_fix_env name of {\n           Just (FixItem _ fix) -> return (True, fix) ;\n           Nothing ->\n\n    do { this_mod <- getModule\n       ; if nameIsLocalOrFrom this_mod name\n               -- Local (and interactive) names are all in the\n               -- fixity env, and don't have entries in the HPT\n         then return (False, defaultFixity)\n         else lookup_imported } } }\n  where\n    lookup_imported\n      -- For imported names, we have to get their fixities by doing a\n      -- loadInterfaceForName, and consulting the Ifaces that comes back\n      -- from that, because the interface file for the Name might not\n      -- have been loaded yet.  Why not?  Suppose you import module A,\n      -- which exports a function 'f', thus;\n      --        module CurrentModule where\n      --          import A( f )\n      --        module A( f ) where\n      --          import B( f )\n      -- Then B isn't loaded right away (after all, it's possible that\n      -- nothing from B will be used).  When we come across a use of\n      -- 'f', we need to know its fixity, and it's then, and only\n      -- then, that we load B.hi.  That is what's happening here.\n      --\n      -- loadInterfaceForName will find B.hi even if B is a hidden module,\n      -- and that's what we want.\n      = do { iface <- loadInterfaceForName doc name\n           ; let mb_fix = mi_fix_fn iface occ\n           ; let msg = case mb_fix of\n                            Nothing ->\n                                  text \"looking up name\" <+> ppr name\n                              <+> text \"in iface, but found no fixity for it.\"\n                              <+> text \"Using default fixity instead.\"\n                            Just f ->\n                                  text \"looking up name in iface and found:\"\n                              <+> vcat [ppr name, ppr f]\n           ; traceRn \"lookupFixityRn_either:\" msg\n           ; return (maybe (False, defaultFixity) (\\f -> (True, f)) mb_fix)  }\n\n    doc = text \"Checking fixity for\" <+> ppr name\n\n---------------\nlookupTyFixityRn :: Located Name -> RnM Fixity\nlookupTyFixityRn = lookupFixityRn . unLoc\n\n-- | Look up the fixity of a (possibly ambiguous) occurrence of a record field\n-- selector.  We use 'lookupFixityRn'' so that we can specifiy the 'OccName' as\n-- the field label, which might be different to the 'OccName' of the selector\n-- 'Name' if @DuplicateRecordFields@ is in use (Trac #1173). If there are\n-- multiple possible selectors with different fixities, generate an error.\nlookupFieldFixityRn :: AmbiguousFieldOcc GhcRn -> RnM Fixity\nlookupFieldFixityRn (Unambiguous n lrdr)\n  = lookupFixityRn' n (rdrNameOcc (unLoc lrdr))\nlookupFieldFixityRn (Ambiguous _ lrdr) = get_ambiguous_fixity (unLoc lrdr)\n  where\n    get_ambiguous_fixity :: RdrName -> RnM Fixity\n    get_ambiguous_fixity rdr_name = do\n      traceRn \"get_ambiguous_fixity\" (ppr rdr_name)\n      rdr_env <- getGlobalRdrEnv\n      let elts =  lookupGRE_RdrName rdr_name rdr_env\n\n      fixities <- groupBy ((==) `on` snd) . zip elts\n                  <$> mapM lookup_gre_fixity elts\n\n      case fixities of\n        -- There should always be at least one fixity.\n        -- Something's very wrong if there are no fixity candidates, so panic\n        [] -> panic \"get_ambiguous_fixity: no candidates for a given RdrName\"\n        [ (_, fix):_ ] -> return fix\n        ambigs -> addErr (ambiguous_fixity_err rdr_name ambigs)\n                  >> return (Fixity NoSourceText minPrecedence InfixL)\n\n    lookup_gre_fixity gre = lookupFixityRn' (gre_name gre) (greOccName gre)\n\n    ambiguous_fixity_err rn ambigs\n      = vcat [ text \"Ambiguous fixity for record field\" <+> quotes (ppr rn)\n             , hang (text \"Conflicts: \") 2 . vcat .\n               map format_ambig $ concat ambigs ]\n\n    format_ambig (elt, fix) = hang (ppr fix)\n                                 2 (pprNameProvenance elt)\nlookupFieldFixityRn (XAmbiguousFieldOcc{}) = panic \"lookupFieldFixityRn\"\n", "num_lines": 215}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns #-}\n\nmodule RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where\n\nimport GhcPrelude\n\nimport TcRnTypes\nimport HsSyn\nimport SrcLoc\n\n\nrnMbLHsDoc :: Maybe LHsDocString -> RnM (Maybe LHsDocString)\nrnMbLHsDoc mb_doc = case mb_doc of\n  Just doc -> do\n    doc' <- rnLHsDoc doc\n    return (Just doc')\n  Nothing -> return Nothing\n\nrnLHsDoc :: LHsDocString -> RnM LHsDocString\nrnLHsDoc (dL->L pos doc) = do\n  doc' <- rnHsDoc doc\n  return (cL pos doc')\n\nrnHsDoc :: HsDocString -> RnM HsDocString\nrnHsDoc = pure\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[RnNames]{Extracting imported and top-level names in scope}\n-}\n\n{-# LANGUAGE CPP, NondecreasingIndentation, MultiWayIf, NamedFieldPuns #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule RnNames (\n        rnImports, getLocalNonValBinders, newRecordSelector,\n        extendGlobalRdrEnvRn,\n        gresFromAvails,\n        calculateAvails,\n        reportUnusedNames,\n        checkConName,\n        mkChildEnv,\n        findChildren,\n        dodgyMsg,\n        dodgyMsgInsert,\n        findImportUsage,\n        getMinimalImports,\n        printMinimalImports,\n        ImportDeclUsage\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport HsSyn\nimport TcEnv\nimport RnEnv\nimport RnFixity\nimport RnUtils          ( warnUnusedTopBinds, mkFieldEnv )\nimport LoadIface        ( loadSrcInterface )\nimport TcRnMonad\nimport PrelNames\nimport Module\nimport Name\nimport NameEnv\nimport NameSet\nimport Avail\nimport FieldLabel\nimport HscTypes\nimport RdrName\nimport RdrHsSyn        ( setRdrNameSpace )\nimport Outputable\nimport Maybes\nimport SrcLoc\nimport BasicTypes      ( TopLevelFlag(..), StringLiteral(..) )\nimport Util\nimport FastString\nimport FastStringEnv\nimport Id\nimport Type\nimport PatSyn\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Data.Either      ( partitionEithers, isRight, rights )\nimport Data.Map         ( Map )\nimport qualified Data.Map as Map\nimport Data.Ord         ( comparing )\nimport Data.List        ( partition, (\\\\), find, sortBy )\nimport qualified Data.Set as S\nimport System.FilePath  ((</>))\n\nimport System.IO\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{rnImports}\n*                                                                      *\n************************************************************************\n\nNote [Tracking Trust Transitively]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we import a package as well as checking that the direct imports are safe\naccording to the rules outlined in the Note [HscMain . Safe Haskell Trust Check]\nwe must also check that these rules hold transitively for all dependent modules\nand packages. Doing this without caching any trust information would be very\nslow as we would need to touch all packages and interface files a module depends\non. To avoid this we make use of the property that if a modules Safe Haskell\nmode changes, this triggers a recompilation from that module in the dependcy\ngraph. So we can just worry mostly about direct imports.\n\nThere is one trust property that can change for a package though without\nrecompliation being triggered: package trust. So we must check that all\npackages a module tranitively depends on to be trusted are still trusted when\nwe are compiling this module (as due to recompilation avoidance some modules\nbelow may not be considered trusted any more without recompilation being\ntriggered).\n\nWe handle this by augmenting the existing transitive list of packages a module M\ndepends on with a bool for each package that says if it must be trusted when the\nmodule M is being checked for trust. This list of trust required packages for a\nsingle import is gathered in the rnImportDecl function and stored in an\nImportAvails data structure. The union of these trust required packages for all\nimports is done by the rnImports function using the combine function which calls\nthe plusImportAvails function that is a union operation for the ImportAvails\ntype. This gives us in an ImportAvails structure all packages required to be\ntrusted for the module we are currently compiling. Checking that these packages\nare still trusted (and that direct imports are trusted) is done in\nHscMain.checkSafeImports.\n\nSee the note below, [Trust Own Package] for a corner case in this method and\nhow its handled.\n\n\nNote [Trust Own Package]\n~~~~~~~~~~~~~~~~~~~~~~~~\nThere is a corner case of package trust checking that the usual transitive check\ndoesn't cover. (For how the usual check operates see the Note [Tracking Trust\nTransitively] below). The case is when you import a -XSafe module M and M\nimports a -XTrustworthy module N. If N resides in a different package than M,\nthen the usual check works as M will record a package dependency on N's package\nand mark it as required to be trusted. If N resides in the same package as M\nthough, then importing M should require its own package be trusted due to N\n(since M is -XSafe so doesn't create this requirement by itself). The usual\ncheck fails as a module doesn't record a package dependency of its own package.\nSo instead we now have a bool field in a modules interface file that simply\nstates if the module requires its own package to be trusted. This field avoids\nus having to load all interface files that the module depends on to see if one\nis trustworthy.\n\n\nNote [Trust Transitive Property]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSo there is an interesting design question in regards to transitive trust\nchecking. Say I have a module B compiled with -XSafe. B is dependent on a bunch\nof modules and packages, some packages it requires to be trusted as its using\n-XTrustworthy modules from them. Now if I have a module A that doesn't use safe\nhaskell at all and simply imports B, should A inherit all the trust\nrequirements from B? Should A now also require that a package p is trusted since\nB required it?\n\nWe currently say no but saying yes also makes sense. The difference is, if a\nmodule M that doesn't use Safe Haskell imports a module N that does, should all\nthe trusted package requirements be dropped since M didn't declare that it cares\nabout Safe Haskell (so -XSafe is more strongly associated with the module doing\nthe importing) or should it be done still since the author of the module N that\nuses Safe Haskell said they cared (so -XSafe is more strongly associated with\nthe module that was compiled that used it).\n\nGoing with yes is a simpler semantics we think and harder for the user to stuff\nup but it does mean that Safe Haskell will affect users who don't care about\nSafe Haskell as they might grab a package from Cabal which uses safe haskell (say\nnetwork) and that packages imports -XTrustworthy modules from another package\n(say bytestring), so requires that package is trusted. The user may now get\ncompilation errors in code that doesn't do anything with Safe Haskell simply\nbecause they are using the network package. They will have to call 'ghc-pkg\ntrust network' to get everything working. Due to this invasive nature of going\nwith yes we have gone with no for now.\n-}\n\n-- | Process Import Decls.  See 'rnImportDecl' for a description of what\n-- the return types represent.\n-- Note: Do the non SOURCE ones first, so that we get a helpful warning\n-- for SOURCE ones that are unnecessary\nrnImports :: [LImportDecl GhcPs]\n          -> RnM ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)\nrnImports imports = do\n    tcg_env <- getGblEnv\n    -- NB: want an identity module here, because it's OK for a signature\n    -- module to import from its implementor\n    let this_mod = tcg_mod tcg_env\n    let (source, ordinary) = partition is_source_import imports\n        is_source_import d = ideclSource (unLoc d)\n    stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary\n    stuff2 <- mapAndReportM (rnImportDecl this_mod) source\n    -- Safe Haskell: See Note [Tracking Trust Transitively]\n    let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)\n    return (decls, rdr_env, imp_avails, hpc_usage)\n\n  where\n    -- See Note [Combining ImportAvails]\n    combine :: [(LImportDecl GhcRn,  GlobalRdrEnv, ImportAvails, AnyHpcUsage)]\n            -> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)\n    combine ss =\n      let (decls, rdr_env, imp_avails, hpc_usage, finsts) = foldr\n            plus\n            ([], emptyGlobalRdrEnv, emptyImportAvails, False, emptyModuleSet)\n            ss\n      in (decls, rdr_env, imp_avails { imp_finsts = moduleSetElts finsts },\n            hpc_usage)\n\n    plus (decl,  gbl_env1, imp_avails1, hpc_usage1)\n         (decls, gbl_env2, imp_avails2, hpc_usage2, finsts_set)\n      = ( decl:decls,\n          gbl_env1 `plusGlobalRdrEnv` gbl_env2,\n          imp_avails1' `plusImportAvails` imp_avails2,\n          hpc_usage1 || hpc_usage2,\n          extendModuleSetList finsts_set new_finsts )\n      where\n      imp_avails1' = imp_avails1 { imp_finsts = [] }\n      new_finsts = imp_finsts imp_avails1\n\n{-\nNote [Combining ImportAvails]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nimp_finsts in ImportAvails is a list of family instance modules\ntransitively depended on by an import. imp_finsts for a currently\ncompiled module is a union of all the imp_finsts of imports.\nComputing the union of two lists of size N is O(N^2) and if we\ndo it to M imports we end up with O(M*N^2). That can get very\nexpensive for bigger module hierarchies.\n\nUnion can be optimized to O(N log N) if we use a Set.\nimp_finsts is converted back and forth between dep_finsts, so\nchanging a type of imp_finsts means either paying for the conversions\nor changing the type of dep_finsts as well.\n\nI've measured that the conversions would cost 20% of allocations on my\ntest case, so that can be ruled out.\n\nChanging the type of dep_finsts forces checkFamInsts to\nget the module lists in non-deterministic order. If we wanted to restore\nthe deterministic order, we'd have to sort there, which is an additional\ncost. As far as I can tell, using a non-deterministic order is fine there,\nbut that's a brittle nonlocal property which I'd like to avoid.\n\nAdditionally, dep_finsts is read from an interface file, so its \"natural\"\ntype is a list. Which makes it a natural type for imp_finsts.\n\nSince rnImports.combine is really the only place that would benefit from\nit being a Set, it makes sense to optimize the hot loop in rnImports.combine\nwithout changing the representation.\n\nSo here's what we do: instead of naively merging ImportAvails with\nplusImportAvails in a loop, we make plusImportAvails merge empty imp_finsts\nand compute the union on the side using Sets. When we're done, we can\nconvert it back to a list. One nice side effect of this approach is that\nif there's a lot of overlap in the imp_finsts of imports, the\nSet doesn't really need to grow and we don't need to allocate.\n\nRunning generateModules from Trac #14693 with DEPTH=16, WIDTH=30 finishes in\n23s before, and 11s after.\n-}\n\n\n\n-- | Given a located import declaration @decl@ from @this_mod@,\n-- calculate the following pieces of information:\n--\n--  1. An updated 'LImportDecl', where all unresolved 'RdrName' in\n--     the entity lists have been resolved into 'Name's,\n--\n--  2. A 'GlobalRdrEnv' representing the new identifiers that were\n--     brought into scope (taking into account module qualification\n--     and hiding),\n--\n--  3. 'ImportAvails' summarizing the identifiers that were imported\n--     by this declaration, and\n--\n--  4. A boolean 'AnyHpcUsage' which is true if the imported module\n--     used HPC.\nrnImportDecl  :: Module -> LImportDecl GhcPs\n             -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)\nrnImportDecl this_mod\n             (L loc decl@(ImportDecl { ideclExt = noExt\n                                     , ideclName = loc_imp_mod_name\n                                     , ideclPkgQual = mb_pkg\n                                     , ideclSource = want_boot, ideclSafe = mod_safe\n                                     , ideclQualified = qual_only, ideclImplicit = implicit\n                                     , ideclAs = as_mod, ideclHiding = imp_details }))\n  = setSrcSpan loc $ do\n\n    when (isJust mb_pkg) $ do\n        pkg_imports <- xoptM LangExt.PackageImports\n        when (not pkg_imports) $ addErr packageImportErr\n\n    -- If there's an error in loadInterface, (e.g. interface\n    -- file not found) we get lots of spurious errors from 'filterImports'\n    let imp_mod_name = unLoc loc_imp_mod_name\n        doc = ppr imp_mod_name <+> text \"is directly imported\"\n\n    -- Check for self-import, which confuses the typechecker (Trac #9032)\n    -- ghc --make rejects self-import cycles already, but batch-mode may not\n    -- at least not until TcIface.tcHiBootIface, which is too late to avoid\n    -- typechecker crashes.  (Indirect self imports are not caught until\n    -- TcIface, see #10337 tracking how to make this error better.)\n    --\n    -- Originally, we also allowed 'import {-# SOURCE #-} M', but this\n    -- caused bug #10182: in one-shot mode, we should never load an hs-boot\n    -- file for the module we are compiling into the EPS.  In principle,\n    -- it should be possible to support this mode of use, but we would have to\n    -- extend Provenance to support a local definition in a qualified location.\n    -- For now, we don't support it, but see #10336\n    when (imp_mod_name == moduleName this_mod &&\n          (case mb_pkg of  -- If we have import \"<pkg>\" M, then we should\n                           -- check that \"<pkg>\" is \"this\" (which is magic)\n                           -- or the name of this_mod's package.  Yurgh!\n                           -- c.f. GHC.findModule, and Trac #9997\n             Nothing         -> True\n             Just (StringLiteral _ pkg_fs) -> pkg_fs == fsLit \"this\" ||\n                            fsToUnitId pkg_fs == moduleUnitId this_mod))\n         (addErr (text \"A module cannot import itself:\" <+> ppr imp_mod_name))\n\n    -- Check for a missing import list (Opt_WarnMissingImportList also\n    -- checks for T(..) items but that is done in checkDodgyImport below)\n    case imp_details of\n        Just (False, _) -> return () -- Explicit import list\n        _  | implicit   -> return () -- Do not bleat for implicit imports\n           | qual_only  -> return ()\n           | otherwise  -> whenWOptM Opt_WarnMissingImportList $\n                           addWarn (Reason Opt_WarnMissingImportList)\n                                   (missingImportListWarn imp_mod_name)\n\n    iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg)\n\n    -- Compiler sanity check: if the import didn't say\n    -- {-# SOURCE #-} we should not get a hi-boot file\n    WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do\n\n    -- Issue a user warning for a redundant {- SOURCE -} import\n    -- NB that we arrange to read all the ordinary imports before\n    -- any of the {- SOURCE -} imports.\n    --\n    -- in --make and GHCi, the compilation manager checks for this,\n    -- and indeed we shouldn't do it here because the existence of\n    -- the non-boot module depends on the compilation order, which\n    -- is not deterministic.  The hs-boot test can show this up.\n    dflags <- getDynFlags\n    warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))\n           (warnRedundantSourceImport imp_mod_name)\n    when (mod_safe && not (safeImportsOn dflags)) $\n        addErr (text \"safe import can't be used as Safe Haskell isn't on!\"\n                $+$ ptext (sLit $ \"please enable Safe Haskell through either \"\n                                   ++ \"Safe, Trustworthy or Unsafe\"))\n\n    let\n        qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name\n        imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,\n                                  is_dloc = loc, is_as = qual_mod_name }\n\n    -- filter the imports according to the import declaration\n    (new_imp_details, gres) <- filterImports iface imp_spec imp_details\n\n    -- for certain error messages, we\u00e2\u20ac\u2122d like to know what could be imported\n    -- here, if everything were imported\n    potential_gres <- mkGlobalRdrEnv . snd <$> filterImports iface imp_spec Nothing\n\n    let gbl_env = mkGlobalRdrEnv gres\n\n        is_hiding | Just (True,_) <- imp_details = True\n                  | otherwise                    = False\n\n        -- should the import be safe?\n        mod_safe' = mod_safe\n                    || (not implicit && safeDirectImpsReq dflags)\n                    || (implicit && safeImplicitImpsReq dflags)\n\n    let imv = ImportedModsVal\n            { imv_name        = qual_mod_name\n            , imv_span        = loc\n            , imv_is_safe     = mod_safe'\n            , imv_is_hiding   = is_hiding\n            , imv_all_exports = potential_gres\n            , imv_qualified   = qual_only\n            }\n        imports = calculateAvails dflags iface mod_safe' want_boot (ImportedByUser imv)\n\n    -- Complain if we import a deprecated module\n    whenWOptM Opt_WarnWarningsDeprecations (\n       case (mi_warns iface) of\n          WarnAll txt -> addWarn (Reason Opt_WarnWarningsDeprecations)\n                                (moduleWarn imp_mod_name txt)\n          _           -> return ()\n     )\n\n    let new_imp_decl = L loc (decl { ideclExt = noExt, ideclSafe = mod_safe'\n                                   , ideclHiding = new_imp_details })\n\n    return (new_imp_decl, gbl_env, imports, mi_hpc iface)\nrnImportDecl _ (L _ (XImportDecl _)) = panic \"rnImportDecl\"\n\n-- | Calculate the 'ImportAvails' induced by an import of a particular\n-- interface, but without 'imp_mods'.\ncalculateAvails :: DynFlags\n                -> ModIface\n                -> IsSafeImport\n                -> IsBootInterface\n                -> ImportedBy\n                -> ImportAvails\ncalculateAvails dflags iface mod_safe' want_boot imported_by =\n  let imp_mod    = mi_module iface\n      imp_sem_mod= mi_semantic_module iface\n      orph_iface = mi_orphan iface\n      has_finsts = mi_finsts iface\n      deps       = mi_deps iface\n      trust      = getSafeMode $ mi_trust iface\n      trust_pkg  = mi_trust_pkg iface\n\n      -- If the module exports anything defined in this module, just\n      -- ignore it.  Reason: otherwise it looks as if there are two\n      -- local definition sites for the thing, and an error gets\n      -- reported.  Easiest thing is just to filter them out up\n      -- front. This situation only arises if a module imports\n      -- itself, or another module that imported it.  (Necessarily,\n      -- this invoves a loop.)\n      --\n      -- We do this *after* filterImports, so that if you say\n      --      module A where\n      --         import B( AType )\n      --         type AType = ...\n      --\n      --      module B( AType ) where\n      --         import {-# SOURCE #-} A( AType )\n      --\n      -- then you won't get a 'B does not export AType' message.\n\n\n      -- Compute new transitive dependencies\n      --\n      -- 'dep_orphs' and 'dep_finsts' do NOT include the imported module\n      -- itself, but we DO need to include this module in 'imp_orphs' and\n      -- 'imp_finsts' if it defines an orphan or instance family; thus the\n      -- orph_iface/has_iface tests.\n\n      orphans | orph_iface = ASSERT2( not (imp_sem_mod `elem` dep_orphs deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )\n                             imp_sem_mod : dep_orphs deps\n              | otherwise  = dep_orphs deps\n\n      finsts | has_finsts = ASSERT2( not (imp_sem_mod `elem` dep_finsts deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )\n                            imp_sem_mod : dep_finsts deps\n             | otherwise  = dep_finsts deps\n\n      pkg = moduleUnitId (mi_module iface)\n      ipkg = toInstalledUnitId pkg\n\n      -- Does this import mean we now require our own pkg\n      -- to be trusted? See Note [Trust Own Package]\n      ptrust = trust == Sf_Trustworthy || trust_pkg\n\n      (dependent_mods, dependent_pkgs, pkg_trust_req)\n         | pkg == thisPackage dflags =\n            -- Imported module is from the home package\n            -- Take its dependent modules and add imp_mod itself\n            -- Take its dependent packages unchanged\n            --\n            -- NB: (dep_mods deps) might include a hi-boot file\n            -- for the module being compiled, CM. Do *not* filter\n            -- this out (as we used to), because when we've\n            -- finished dealing with the direct imports we want to\n            -- know if any of them depended on CM.hi-boot, in\n            -- which case we should do the hi-boot consistency\n            -- check.  See LoadIface.loadHiBootInterface\n            ((moduleName imp_mod,want_boot):dep_mods deps,dep_pkgs deps,ptrust)\n\n         | otherwise =\n            -- Imported module is from another package\n            -- Dump the dependent modules\n            -- Add the package imp_mod comes from to the dependent packages\n            ASSERT2( not (ipkg `elem` (map fst $ dep_pkgs deps))\n                   , ppr ipkg <+> ppr (dep_pkgs deps) )\n            ([], (ipkg, False) : dep_pkgs deps, False)\n\n  in ImportAvails {\n          imp_mods       = unitModuleEnv (mi_module iface) [imported_by],\n          imp_orphs      = orphans,\n          imp_finsts     = finsts,\n          imp_dep_mods   = mkModDeps dependent_mods,\n          imp_dep_pkgs   = S.fromList . map fst $ dependent_pkgs,\n          -- Add in the imported modules trusted package\n          -- requirements. ONLY do this though if we import the\n          -- module as a safe import.\n          -- See Note [Tracking Trust Transitively]\n          -- and Note [Trust Transitive Property]\n          imp_trust_pkgs = if mod_safe'\n                               then S.fromList . map fst $ filter snd dependent_pkgs\n                               else S.empty,\n          -- Do we require our own pkg to be trusted?\n          -- See Note [Trust Own Package]\n          imp_trust_own_pkg = pkg_trust_req\n     }\n\n\nwarnRedundantSourceImport :: ModuleName -> SDoc\nwarnRedundantSourceImport mod_name\n  = text \"Unnecessary {-# SOURCE #-} in the import of module\"\n          <+> quotes (ppr mod_name)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{importsFromLocalDecls}\n*                                                                      *\n************************************************************************\n\nFrom the top-level declarations of this module produce\n        * the lexical environment\n        * the ImportAvails\ncreated by its bindings.\n\nNote [Top-level Names in Template Haskell decl quotes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee also: Note [Interactively-bound Ids in GHCi] in HscTypes\n          Note [Looking up Exact RdrNames] in RnEnv\n\nConsider a Template Haskell declaration quotation like this:\n      module M where\n        f x = h [d| f = 3 |]\nWhen renaming the declarations inside [d| ...|], we treat the\ntop level binders specially in two ways\n\n1.  We give them an Internal Name, not (as usual) an External one.\n    This is done by RnEnv.newTopSrcBinder.\n\n2.  We make them *shadow* the outer bindings.\n    See Note [GlobalRdrEnv shadowing]\n\n3. We find out whether we are inside a [d| ... |] by testing the TH\n   stage. This is a slight hack, because the stage field was really\n   meant for the type checker, and here we are not interested in the\n   fields of Brack, hence the error thunks in thRnBrack.\n-}\n\nextendGlobalRdrEnvRn :: [AvailInfo]\n                     -> MiniFixityEnv\n                     -> RnM (TcGblEnv, TcLclEnv)\n-- Updates both the GlobalRdrEnv and the FixityEnv\n-- We return a new TcLclEnv only because we might have to\n-- delete some bindings from it;\n-- see Note [Top-level Names in Template Haskell decl quotes]\n\nextendGlobalRdrEnvRn avails new_fixities\n  = do  { (gbl_env, lcl_env) <- getEnvs\n        ; stage <- getStage\n        ; isGHCi <- getIsGHCi\n        ; let rdr_env  = tcg_rdr_env gbl_env\n              fix_env  = tcg_fix_env gbl_env\n              th_bndrs = tcl_th_bndrs lcl_env\n              th_lvl   = thLevel stage\n\n              -- Delete new_occs from global and local envs\n              -- If we are in a TemplateHaskell decl bracket,\n              --    we are going to shadow them\n              -- See Note [GlobalRdrEnv shadowing]\n              inBracket = isBrackStage stage\n\n              lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }\n                           -- See Note [GlobalRdrEnv shadowing]\n\n              lcl_env2 | inBracket = lcl_env_TH\n                       | otherwise = lcl_env\n\n              -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]\n              want_shadowing = isGHCi || inBracket\n              rdr_env1 | want_shadowing = shadowNames rdr_env new_names\n                       | otherwise      = rdr_env\n\n              lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs\n                                                       [ (n, (TopLevel, th_lvl))\n                                                       | n <- new_names ] }\n\n        ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres\n\n        ; let fix_env' = foldl' extend_fix_env fix_env new_gres\n              gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }\n\n        ; traceRn \"extendGlobalRdrEnvRn 2\" (pprGlobalRdrEnv True rdr_env2)\n        ; return (gbl_env', lcl_env3) }\n  where\n    new_names = concatMap availNames avails\n    new_occs  = map nameOccName new_names\n\n    -- If there is a fixity decl for the gre, add it to the fixity env\n    extend_fix_env fix_env gre\n      | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)\n      = extendNameEnv fix_env name (FixItem occ fi)\n      | otherwise\n      = fix_env\n      where\n        name = gre_name gre\n        occ  = greOccName gre\n\n    new_gres :: [GlobalRdrElt]  -- New LocalDef GREs, derived from avails\n    new_gres = concatMap localGREsFromAvail avails\n\n    add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv\n    -- Extend the GlobalRdrEnv with a LocalDef GRE\n    -- If there is already a LocalDef GRE with the same OccName,\n    --    report an error and discard the new GRE\n    -- This establishes INVARIANT 1 of GlobalRdrEnvs\n    add_gre env gre\n      | not (null dups)    -- Same OccName defined twice\n      = do { addDupDeclErr (gre : dups); return env }\n\n      | otherwise\n      = return (extendGlobalRdrEnv env gre)\n      where\n        name = gre_name gre\n        occ  = nameOccName name\n        dups = filter isLocalGRE (lookupGlobalRdrEnv env occ)\n\n\n{- *********************************************************************\n*                                                                      *\n    getLocalDeclBindersd@ returns the names for an HsDecl\n             It's used for source code.\n\n        *** See Note [The Naming story] in HsDecls ****\n*                                                                      *\n********************************************************************* -}\n\ngetLocalNonValBinders :: MiniFixityEnv -> HsGroup GhcPs\n    -> RnM ((TcGblEnv, TcLclEnv), NameSet)\n-- Get all the top-level binders bound the group *except*\n-- for value bindings, which are treated separately\n-- Specifically we return AvailInfo for\n--      * type decls (incl constructors and record selectors)\n--      * class decls (including class ops)\n--      * associated types\n--      * foreign imports\n--      * value signatures (in hs-boot files only)\n\ngetLocalNonValBinders fixity_env\n     (HsGroup { hs_valds  = binds,\n                hs_tyclds = tycl_decls,\n                hs_fords  = foreign_decls })\n  = do  { -- Process all type/class decls *except* family instances\n        ; let inst_decls = tycl_decls >>= group_instds\n        ; overload_ok <- xoptM LangExt.DuplicateRecordFields\n        ; (tc_avails, tc_fldss)\n            <- fmap unzip $ mapM (new_tc overload_ok)\n                                 (tyClGroupTyClDecls tycl_decls)\n        ; traceRn \"getLocalNonValBinders 1\" (ppr tc_avails)\n        ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env\n        ; setEnvs envs $ do {\n            -- Bring these things into scope first\n            -- See Note [Looking up family names in family instances]\n\n          -- Process all family instances\n          -- to bring new data constructors into scope\n        ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc overload_ok)\n                                                   inst_decls\n\n          -- Finish off with value binders:\n          --    foreign decls and pattern synonyms for an ordinary module\n          --    type sigs in case of a hs-boot file only\n        ; is_boot <- tcIsHsBootOrSig\n        ; let val_bndrs | is_boot   = hs_boot_sig_bndrs\n                        | otherwise = for_hs_bndrs\n        ; val_avails <- mapM new_simple val_bndrs\n\n        ; let avails    = concat nti_availss ++ val_avails\n              new_bndrs = availsToNameSetWithSelectors avails `unionNameSet`\n                          availsToNameSetWithSelectors tc_avails\n              flds      = concat nti_fldss ++ concat tc_fldss\n        ; traceRn \"getLocalNonValBinders 2\" (ppr avails)\n        ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env\n\n        -- Extend tcg_field_env with new fields (this used to be the\n        -- work of extendRecordFieldEnv)\n        ; let field_env = extendNameEnvList (tcg_field_env tcg_env) flds\n              envs      = (tcg_env { tcg_field_env = field_env }, tcl_env)\n\n        ; traceRn \"getLocalNonValBinders 3\" (vcat [ppr flds, ppr field_env])\n        ; return (envs, new_bndrs) } }\n  where\n    ValBinds _ _val_binds val_sigs = binds\n\n    for_hs_bndrs :: [Located RdrName]\n    for_hs_bndrs = hsForeignDeclsBinders foreign_decls\n\n    -- In a hs-boot file, the value binders come from the\n    --  *signatures*, and there should be no foreign binders\n    hs_boot_sig_bndrs = [ L decl_loc (unLoc n)\n                        | L decl_loc (TypeSig _ ns _) <- val_sigs, n <- ns]\n\n      -- the SrcSpan attached to the input should be the span of the\n      -- declaration, not just the name\n    new_simple :: Located RdrName -> RnM AvailInfo\n    new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name\n                            ; return (avail nm) }\n\n    new_tc :: Bool -> LTyClDecl GhcPs\n           -> RnM (AvailInfo, [(Name, [FieldLabel])])\n    new_tc overload_ok tc_decl -- NOT for type/data instances\n        = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl\n             ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs\n             ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds\n             ; let fld_env = case unLoc tc_decl of\n                     DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'\n                     _                            -> []\n             ; return (AvailTC main_name names flds', fld_env) }\n\n\n    -- Calculate the mapping from constructor names to fields, which\n    -- will go in tcg_field_env. It's convenient to do this here where\n    -- we are working with a single datatype definition.\n    mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel]\n               -> [(Name, [FieldLabel])]\n    mk_fld_env d names flds = concatMap find_con_flds (dd_cons d)\n      where\n        find_con_flds (L _ (ConDeclH98 { con_name = L _ rdr\n                                       , con_args = RecCon cdflds }))\n            = [( find_con_name rdr\n               , concatMap find_con_decl_flds (unLoc cdflds) )]\n        find_con_flds (L _ (ConDeclGADT { con_names = rdrs\n                                        , con_args = RecCon flds }))\n            = [ ( find_con_name rdr\n                 , concatMap find_con_decl_flds (unLoc flds))\n              | L _ rdr <- rdrs ]\n\n        find_con_flds _ = []\n\n        find_con_name rdr\n          = expectJust \"getLocalNonValBinders/find_con_name\" $\n              find (\\ n -> nameOccName n == rdrNameOcc rdr) names\n        find_con_decl_flds (L _ x)\n          = map find_con_decl_fld (cd_fld_names x)\n\n        find_con_decl_fld  (L _ (FieldOcc _ (L _ rdr)))\n          = expectJust \"getLocalNonValBinders/find_con_decl_fld\" $\n              find (\\ fl -> flLabel fl == lbl) flds\n          where lbl = occNameFS (rdrNameOcc rdr)\n        find_con_decl_fld (L _ (XFieldOcc _)) = panic \"getLocalNonValBinders\"\n\n    new_assoc :: Bool -> LInstDecl GhcPs\n              -> RnM ([AvailInfo], [(Name, [FieldLabel])])\n    new_assoc _ (L _ (TyFamInstD {})) = return ([], [])\n      -- type instances don't bind new names\n\n    new_assoc overload_ok (L _ (DataFamInstD _ d))\n      = do { (avail, flds) <- new_di overload_ok Nothing d\n           ; return ([avail], flds) }\n    new_assoc overload_ok (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty\n                                                      , cid_datafam_insts = adts })))\n      = do -- First, attempt to grab the name of the class from the instance.\n           -- This step could fail if the instance is not headed by a class,\n           -- such as in the following examples:\n           --\n           -- (1) The class is headed by a bang pattern, such as in\n           --     `instance !Show Int` (Trac #3811c)\n           -- (2) The class is headed by a type variable, such as in\n           --     `instance c` (Trac #16385)\n           --\n           -- If looking up the class name fails, then mb_cls_nm will\n           -- be Nothing.\n           mb_cls_nm <- runMaybeT $ do\n             -- See (1) above\n             L loc cls_rdr <- MaybeT $ pure $ getLHsInstDeclClass_maybe inst_ty\n             -- See (2) above\n             MaybeT $ setSrcSpan loc $ lookupGlobalOccRn_maybe cls_rdr\n           -- Assuming the previous step succeeded, process any associated data\n           -- family instances. If the previous step failed, bail out.\n           case mb_cls_nm of\n             Nothing -> pure ([], [])\n             Just cls_nm -> do\n               (avails, fldss)\n                 <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts\n               pure (avails, concat fldss)\n    new_assoc _ (L _ (ClsInstD _ (XClsInstDecl _))) = panic \"new_assoc\"\n    new_assoc _ (L _ (XInstDecl _))                 = panic \"new_assoc\"\n\n    new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs\n                   -> RnM (AvailInfo, [(Name, [FieldLabel])])\n    new_di overload_ok mb_cls dfid@(DataFamInstDecl { dfid_eqn =\n                                     HsIB { hsib_body = ti_decl }})\n        = do { main_name <- lookupFamInstName mb_cls (feqn_tycon ti_decl)\n             ; let (bndrs, flds) = hsDataFamInstBinders dfid\n             ; sub_names <- mapM newTopSrcBinder bndrs\n             ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds\n             ; let avail    = AvailTC (unLoc main_name) sub_names flds'\n                                  -- main_name is not bound here!\n                   fld_env  = mk_fld_env (feqn_rhs ti_decl) sub_names flds'\n             ; return (avail, fld_env) }\n    new_di _ _ (DataFamInstDecl (XHsImplicitBndrs _)) = panic \"new_di\"\n\n    new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs\n                   -> RnM (AvailInfo, [(Name, [FieldLabel])])\n    new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d\ngetLocalNonValBinders _ (XHsGroup _) = panic \"getLocalNonValBinders\"\n\nnewRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel\nnewRecordSelector _ [] _ = error \"newRecordSelector: datatype has no constructors!\"\nnewRecordSelector _ _ (L _ (XFieldOcc _)) = panic \"newRecordSelector\"\nnewRecordSelector overload_ok (dc:_) (L loc (FieldOcc _ (L _ fld)))\n  = do { selName <- newTopSrcBinder $ L loc $ field\n       ; return $ qualFieldLbl { flSelector = selName } }\n  where\n    fieldOccName = occNameFS $ rdrNameOcc fld\n    qualFieldLbl = mkFieldLabelOccs fieldOccName (nameOccName dc) overload_ok\n    field | isExact fld = fld\n              -- use an Exact RdrName as is to preserve the bindings\n              -- of an already renamer-resolved field and its use\n              -- sites. This is needed to correctly support record\n              -- selectors in Template Haskell. See Note [Binders in\n              -- Template Haskell] in Convert.hs and Note [Looking up\n              -- Exact RdrNames] in RnEnv.hs.\n          | otherwise   = mkRdrUnqual (flSelector qualFieldLbl)\n\n{-\nNote [Looking up family names in family instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n  module M where\n    type family T a :: *\n    type instance M.T Int = Bool\n\nWe might think that we can simply use 'lookupOccRn' when processing the type\ninstance to look up 'M.T'.  Alas, we can't!  The type family declaration is in\nthe *same* HsGroup as the type instance declaration.  Hence, as we are\ncurrently collecting the binders declared in that HsGroup, these binders will\nnot have been added to the global environment yet.\n\nSolution is simple: process the type family declarations first, extend\nthe environment, and then process the type instances.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Filtering imports}\n*                                                                      *\n************************************************************************\n\n@filterImports@ takes the @ExportEnv@ telling what the imported module makes\navailable, and filters it through the import spec (if any).\n\nNote [Dealing with imports]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor import M( ies ), we take the mi_exports of M, and make\n   imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)\nOne entry for each Name that M exports; the AvailInfo is the\nAvailInfo exported from M that exports that Name.\n\nThe situation is made more complicated by associated types. E.g.\n   module M where\n     class    C a    where { data T a }\n     instance C Int  where { data T Int = T1 | T2 }\n     instance C Bool where { data T Int = T3 }\nThen M's export_avails are (recall the AvailTC invariant from Avails.hs)\n  C(C,T), T(T,T1,T2,T3)\nNotice that T appears *twice*, once as a child and once as a parent. From\nthis list we construct a raw list including\n   T -> (T, T( T1, T2, T3 ), Nothing)\n   T -> (C, C( C, T ),       Nothing)\nand we combine these (in function 'combine' in 'imp_occ_env' in\n'filterImports') to get\n   T  -> (T,  T(T,T1,T2,T3), Just C)\n\nSo the overall imp_occ_env is\n   C  -> (C,  C(C,T),        Nothing)\n   T  -> (T,  T(T,T1,T2,T3), Just C)\n   T1 -> (T1, T(T,T1,T2,T3), Nothing)   -- similarly T2,T3\n\nIf we say\n   import M( T(T1,T2) )\nthen we get *two* Avails:  C(T), T(T1,T2)\n\nNote that the imp_occ_env will have entries for data constructors too,\nalthough we never look up data constructors.\n-}\n\nfilterImports\n    :: ModIface\n    -> ImpDeclSpec                     -- The span for the entire import decl\n    -> Maybe (Bool, Located [LIE GhcPs])    -- Import spec; True => hiding\n    -> RnM (Maybe (Bool, Located [LIE GhcRn]), -- Import spec w/ Names\n            [GlobalRdrElt])                   -- Same again, but in GRE form\nfilterImports iface decl_spec Nothing\n  = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface))\n  where\n    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }\n\n\nfilterImports iface decl_spec (Just (want_hiding, L l import_items))\n  = do  -- check for errors, convert RdrNames to Names\n        items1 <- mapM lookup_lie import_items\n\n        let items2 :: [(LIE GhcRn, AvailInfo)]\n            items2 = concat items1\n                -- NB the AvailInfo may have duplicates, and several items\n                --    for the same parent; e.g N(x) and N(y)\n\n            names  = availsToNameSetWithSelectors (map snd items2)\n            keep n = not (n `elemNameSet` names)\n            pruned_avails = filterAvails keep all_avails\n            hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }\n\n            gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails\n                 | otherwise   = concatMap (gresFromIE decl_spec) items2\n\n        return (Just (want_hiding, L l (map fst items2)), gres)\n  where\n    all_avails = mi_exports iface\n\n        -- See Note [Dealing with imports]\n    imp_occ_env :: OccEnv (Name,    -- the name\n                           AvailInfo,   -- the export item providing the name\n                           Maybe Name)  -- the parent of associated types\n    imp_occ_env = mkOccEnv_C combine [ (occ, (n, a, Nothing))\n                                     | a <- all_avails\n                                     , (n, occ) <- availNamesWithOccs a]\n      where\n        -- See Note [Dealing with imports]\n        -- 'combine' is only called for associated data types which appear\n        -- twice in the all_avails. In the example, we combine\n        --    T(T,T1,T2,T3) and C(C,T)  to give   (T, T(T,T1,T2,T3), Just C)\n        -- NB: the AvailTC can have fields as well as data constructors (Trac #12127)\n        combine (name1, a1@(AvailTC p1 _ _), mp1)\n                (name2, a2@(AvailTC p2 _ _), mp2)\n          = ASSERT2( name1 == name2 && isNothing mp1 && isNothing mp2\n                   , ppr name1 <+> ppr name2 <+> ppr mp1 <+> ppr mp2 )\n            if p1 == name1 then (name1, a1, Just p2)\n                           else (name1, a2, Just p1)\n        combine x y = pprPanic \"filterImports/combine\" (ppr x $$ ppr y)\n\n    lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)\n    lookup_name ie rdr\n       | isQual rdr              = failLookupWith (QualImportError rdr)\n       | Just succ <- mb_success = return succ\n       | otherwise               = failLookupWith (BadImport ie)\n      where\n        mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)\n\n    lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, AvailInfo)]\n    lookup_lie (L loc ieRdr)\n        = do (stuff, warns) <- setSrcSpan loc $\n                               liftM (fromMaybe ([],[])) $\n                               run_lookup (lookup_ie ieRdr)\n             mapM_ emit_warning warns\n             return [ (L loc ie, avail) | (ie,avail) <- stuff ]\n        where\n            -- Warn when importing T(..) if T was exported abstractly\n            emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $\n              addWarn (Reason Opt_WarnDodgyImports) (dodgyImportWarn n)\n            emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $\n              addWarn (Reason Opt_WarnMissingImportList) (missingImportListItem ieRdr)\n            emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $\n              addWarn (Reason Opt_WarnDodgyImports) (lookup_err_msg (BadImport ie))\n\n            run_lookup :: IELookupM a -> TcRn (Maybe a)\n            run_lookup m = case m of\n              Failed err -> addErr (lookup_err_msg err) >> return Nothing\n              Succeeded a -> return (Just a)\n\n            lookup_err_msg err = case err of\n              BadImport ie  -> badImportItemErr iface decl_spec ie all_avails\n              IllegalImport -> illegalImportItemErr\n              QualImportError rdr -> qualImportItemErr rdr\n\n        -- For each import item, we convert its RdrNames to Names,\n        -- and at the same time construct an AvailInfo corresponding\n        -- to what is actually imported by this item.\n        -- Returns Nothing on error.\n        -- We return a list here, because in the case of an import\n        -- item like C, if we are hiding, then C refers to *both* a\n        -- type/class and a data constructor.  Moreover, when we import\n        -- data constructors of an associated family, we need separate\n        -- AvailInfos for the data constructors and the family (as they have\n        -- different parents).  See Note [Dealing with imports]\n    lookup_ie :: IE GhcPs\n              -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])\n    lookup_ie ie = handle_bad_import $ do\n      case ie of\n        IEVar _ (L l n) -> do\n            (name, avail, _) <- lookup_name ie $ ieWrappedName n\n            return ([(IEVar noExt (L l (replaceWrappedName n name)),\n                                                  trimAvail avail name)], [])\n\n        IEThingAll _ (L l tc) -> do\n            (name, avail, mb_parent) <- lookup_name ie $ ieWrappedName tc\n            let warns = case avail of\n                          Avail {}                     -- e.g. f(..)\n                            -> [DodgyImport $ ieWrappedName tc]\n\n                          AvailTC _ subs fs\n                            | null (drop 1 subs) && null fs -- e.g. T(..) where T is a synonym\n                            -> [DodgyImport $ ieWrappedName tc]\n\n                            | not (is_qual decl_spec)  -- e.g. import M( T(..) )\n                            -> [MissingImportList]\n\n                            | otherwise\n                            -> []\n\n                renamed_ie = IEThingAll noExt (L l (replaceWrappedName tc name))\n                sub_avails = case avail of\n                               Avail {}              -> []\n                               AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\\\ [name]) fs)]\n            case mb_parent of\n              Nothing     -> return ([(renamed_ie, avail)], warns)\n                             -- non-associated ty/cls\n              Just parent -> return ((renamed_ie, AvailTC parent [name] []) : sub_avails, warns)\n                             -- associated type\n\n        IEThingAbs _ (L l tc')\n            | want_hiding   -- hiding ( C )\n                       -- Here the 'C' can be a data constructor\n                       --  *or* a type/class, or even both\n            -> let tc = ieWrappedName tc'\n                   tc_name = lookup_name ie tc\n                   dc_name = lookup_name ie (setRdrNameSpace tc srcDataName)\n               in\n               case catIELookupM [ tc_name, dc_name ] of\n                 []    -> failLookupWith (BadImport ie)\n                 names -> return ([mkIEThingAbs tc' l name | name <- names], [])\n            | otherwise\n            -> do nameAvail <- lookup_name ie (ieWrappedName tc')\n                  return ([mkIEThingAbs tc' l nameAvail]\n                         , [])\n\n        IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns rdr_fs ->\n          ASSERT2(null rdr_fs, ppr rdr_fs) do\n           (name, avail, mb_parent)\n               <- lookup_name (IEThingAbs noExt ltc) (ieWrappedName rdr_tc)\n\n           let (ns,subflds) = case avail of\n                                AvailTC _ ns' subflds' -> (ns',subflds')\n                                Avail _                -> panic \"filterImports\"\n\n           -- Look up the children in the sub-names of the parent\n           let subnames = case ns of   -- The tc is first in ns,\n                            [] -> []   -- if it is there at all\n                                       -- See the AvailTC Invariant in Avail.hs\n                            (n1:ns1) | n1 == name -> ns1\n                                     | otherwise  -> ns\n           case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of\n\n             Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs []))\n                                -- We are trying to import T( a,b,c,d ), and failed\n                                -- to find 'b' and 'd'.  So we make up an import item\n                                -- to report as failing, namely T( b, d ).\n                                -- c.f. Trac #15412\n\n             Succeeded (childnames, childflds) ->\n               case mb_parent of\n                 -- non-associated ty/cls\n                 Nothing\n                   -> return ([(IEThingWith noExt (L l name') wc childnames'\n                                                                 childflds,\n                               AvailTC name (name:map unLoc childnames) (map unLoc childflds))],\n                              [])\n                   where name' = replaceWrappedName rdr_tc name\n                         childnames' = map to_ie_post_rn childnames\n                         -- childnames' = postrn_ies childnames\n                 -- associated ty\n                 Just parent\n                   -> return ([(IEThingWith noExt (L l name') wc childnames'\n                                                           childflds,\n                                AvailTC name (map unLoc childnames) (map unLoc childflds)),\n                               (IEThingWith noExt (L l name') wc childnames'\n                                                           childflds,\n                                AvailTC parent [name] [])],\n                              [])\n                   where name' = replaceWrappedName rdr_tc name\n                         childnames' = map to_ie_post_rn childnames\n\n        _other -> failLookupWith IllegalImport\n        -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed\n        -- all errors.\n\n      where\n        mkIEThingAbs tc l (n, av, Nothing    )\n          = (IEThingAbs noExt (L l (replaceWrappedName tc n)), trimAvail av n)\n        mkIEThingAbs tc l (n, _,  Just parent)\n          = (IEThingAbs noExt (L l (replaceWrappedName tc n))\n             , AvailTC parent [n] [])\n\n        handle_bad_import m = catchIELookup m $ \\err -> case err of\n          BadImport ie | want_hiding -> return ([], [BadImportW ie])\n          _                          -> failLookupWith err\n\ntype IELookupM = MaybeErr IELookupError\n\ndata IELookupWarning\n  = BadImportW (IE GhcPs)\n  | MissingImportList\n  | DodgyImport RdrName\n  -- NB. use the RdrName for reporting a \"dodgy\" import\n\ndata IELookupError\n  = QualImportError RdrName\n  | BadImport (IE GhcPs)\n  | IllegalImport\n\nfailLookupWith :: IELookupError -> IELookupM a\nfailLookupWith err = Failed err\n\ncatchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a\ncatchIELookup m h = case m of\n  Succeeded r -> return r\n  Failed err  -> h err\n\ncatIELookupM :: [IELookupM a] -> [a]\ncatIELookupM ms = [ a | Succeeded a <- ms ]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Import/Export Utils}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Given an import\\/export spec, construct the appropriate 'GlobalRdrElt's.\ngresFromIE :: ImpDeclSpec -> (LIE GhcRn, AvailInfo) -> [GlobalRdrElt]\ngresFromIE decl_spec (L loc ie, avail)\n  = gresFromAvail prov_fn avail\n  where\n    is_explicit = case ie of\n                    IEThingAll _ name -> \\n -> n == lieWrappedName name\n                    _                 -> \\_ -> True\n    prov_fn name\n      = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec })\n      where\n        item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc }\n\n\n{-\nNote [Children for duplicate record fields]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the module\n\n    {-# LANGUAGE DuplicateRecordFields #-}\n    module M (F(foo, MkFInt, MkFBool)) where\n      data family F a\n      data instance F Int = MkFInt { foo :: Int }\n      data instance F Bool = MkFBool { foo :: Bool }\n\nThe `foo` in the export list refers to *both* selectors! For this\nreason, lookupChildren builds an environment that maps the FastString\nto a list of items, rather than a single item.\n-}\n\nmkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]\nmkChildEnv gres = foldr add emptyNameEnv gres\n  where\n    add gre env = case gre_par gre of\n        FldParent p _  -> extendNameEnv_Acc (:) singleton env p gre\n        ParentIs  p    -> extendNameEnv_Acc (:) singleton env p gre\n        NoParent       -> env\n\nfindChildren :: NameEnv [a] -> Name -> [a]\nfindChildren env n = lookupNameEnv env n `orElse` []\n\nlookupChildren :: [Either Name FieldLabel] -> [LIEWrappedName RdrName]\n               -> MaybeErr [LIEWrappedName RdrName]   -- The ones for which the lookup failed\n                           ([Located Name], [Located FieldLabel])\n-- (lookupChildren all_kids rdr_items) maps each rdr_item to its\n-- corresponding Name all_kids, if the former exists\n-- The matching is done by FastString, not OccName, so that\n--    Cls( meth, AssocTy )\n-- will correctly find AssocTy among the all_kids of Cls, even though\n-- the RdrName for AssocTy may have a (bogus) DataName namespace\n-- (Really the rdr_items should be FastStrings in the first place.)\nlookupChildren all_kids rdr_items\n  | null fails\n  = Succeeded (fmap concat (partitionEithers oks))\n       -- This 'fmap concat' trickily applies concat to the /second/ component\n       -- of the pair, whose type is ([Located Name], [[Located FieldLabel]])\n  | otherwise\n  = Failed fails\n  where\n    mb_xs = map doOne rdr_items\n    fails = [ bad_rdr | Failed bad_rdr <- mb_xs ]\n    oks   = [ ok      | Succeeded ok   <- mb_xs ]\n    oks :: [Either (Located Name) [Located FieldLabel]]\n\n    doOne item@(L l r)\n       = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc . ieWrappedName) r of\n           Just [Left n]            -> Succeeded (Left (L l n))\n           Just rs | all isRight rs -> Succeeded (Right (map (L l) (rights rs)))\n           _                        -> Failed    item\n\n    -- See Note [Children for duplicate record fields]\n    kid_env = extendFsEnvList_C (++) emptyFsEnv\n              [(either (occNameFS . nameOccName) flLabel x, [x]) | x <- all_kids]\n\n\n\n-------------------------------\n\n{-\n*********************************************************\n*                                                       *\n\\subsection{Unused names}\n*                                                       *\n*********************************************************\n-}\n\nreportUnusedNames :: Maybe (Located [LIE GhcPs])  -- Export list\n                  -> TcGblEnv -> RnM ()\nreportUnusedNames _export_decls gbl_env\n  = do  { traceRn \"RUN\" (ppr (tcg_dus gbl_env))\n        ; warnUnusedImportDecls gbl_env\n        ; warnUnusedTopBinds unused_locals\n        ; warnMissingSignatures gbl_env }\n  where\n    used_names :: NameSet\n    used_names = findUses (tcg_dus gbl_env) emptyNameSet\n    -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used\n    -- Hence findUses\n\n    -- Collect the defined names from the in-scope environment\n    defined_names :: [GlobalRdrElt]\n    defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)\n\n    -- Note that defined_and_used, defined_but_not_used\n    -- are both [GRE]; that's why we need defined_and_used\n    -- rather than just used_names\n    _defined_and_used, defined_but_not_used :: [GlobalRdrElt]\n    (_defined_and_used, defined_but_not_used)\n        = partition (gre_is_used used_names) defined_names\n\n    kids_env = mkChildEnv defined_names\n    -- This is done in mkExports too; duplicated work\n\n    gre_is_used :: NameSet -> GlobalRdrElt -> Bool\n    gre_is_used used_names (GRE {gre_name = name})\n        = name `elemNameSet` used_names\n          || any (\\ gre -> gre_name gre `elemNameSet` used_names) (findChildren kids_env name)\n                -- A use of C implies a use of T,\n                -- if C was brought into scope by T(..) or T(C)\n\n    -- Filter out the ones that are\n    --  (a) defined in this module, and\n    --  (b) not defined by a 'deriving' clause\n    -- The latter have an Internal Name, so we can filter them out easily\n    unused_locals :: [GlobalRdrElt]\n    unused_locals = filter is_unused_local defined_but_not_used\n    is_unused_local :: GlobalRdrElt -> Bool\n    is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)\n\n{- *********************************************************************\n*                                                                      *\n              Missing signatures\n*                                                                      *\n********************************************************************* -}\n\n-- | Warn the user about top level binders that lack type signatures.\n-- Called /after/ type inference, so that we can report the\n-- inferred type of the function\nwarnMissingSignatures :: TcGblEnv -> RnM ()\nwarnMissingSignatures gbl_env\n  = do { let exports = availsToNameSet (tcg_exports gbl_env)\n             sig_ns  = tcg_sigs gbl_env\n               -- We use sig_ns to exclude top-level bindings that are generated by GHC\n             binds    = collectHsBindsBinders $ tcg_binds gbl_env\n             pat_syns = tcg_patsyns gbl_env\n\n         -- Warn about missing signatures\n         -- Do this only when we have a type to offer\n       ; warn_missing_sigs  <- woptM Opt_WarnMissingSignatures\n       ; warn_only_exported <- woptM Opt_WarnMissingExportedSignatures\n       ; warn_pat_syns      <- woptM Opt_WarnMissingPatternSynonymSignatures\n\n       ; let add_sig_warns\n               | warn_only_exported = add_warns Opt_WarnMissingExportedSignatures\n               | warn_missing_sigs  = add_warns Opt_WarnMissingSignatures\n               | warn_pat_syns      = add_warns Opt_WarnMissingPatternSynonymSignatures\n               | otherwise          = return ()\n\n             add_warns flag\n                = when warn_pat_syns\n                       (mapM_ add_pat_syn_warn pat_syns) >>\n                  when (warn_missing_sigs || warn_only_exported)\n                       (mapM_ add_bind_warn binds)\n                where\n                  add_pat_syn_warn p\n                    = add_warn name $\n                      hang (text \"Pattern synonym with no type signature:\")\n                         2 (text \"pattern\" <+> pprPrefixName name <+> dcolon <+> pp_ty)\n                    where\n                      name  = patSynName p\n                      pp_ty = pprPatSynType p\n\n                  add_bind_warn :: Id -> IOEnv (Env TcGblEnv TcLclEnv) ()\n                  add_bind_warn id\n                    = do { env <- tcInitTidyEnv     -- Why not use emptyTidyEnv?\n                         ; let name    = idName id\n                               (_, ty) = tidyOpenType env (idType id)\n                               ty_msg  = pprSigmaType ty\n                         ; add_warn name $\n                           hang (text \"Top-level binding with no type signature:\")\n                              2 (pprPrefixName name <+> dcolon <+> ty_msg) }\n\n                  add_warn name msg\n                    = when (name `elemNameSet` sig_ns && export_check name)\n                           (addWarnAt (Reason flag) (getSrcSpan name) msg)\n\n                  export_check name\n                    = not warn_only_exported || name `elemNameSet` exports\n\n       ; add_sig_warns }\n\n\n{-\n*********************************************************\n*                                                       *\n\\subsection{Unused imports}\n*                                                       *\n*********************************************************\n\nThis code finds which import declarations are unused.  The\nspecification and implementation notes are here:\n  http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/UnusedImports\n\nSee also Note [Choosing the best import declaration] in RdrName\n-}\n\ntype ImportDeclUsage\n   = ( LImportDecl GhcRn   -- The import declaration\n     , [GlobalRdrElt]      -- What *is* used (normalised)\n     , [Name] )            -- What is imported but *not* used\n\nwarnUnusedImportDecls :: TcGblEnv -> RnM ()\nwarnUnusedImportDecls gbl_env\n  = do { uses <- readMutVar (tcg_used_gres gbl_env)\n       ; let user_imports = filterOut\n                              (ideclImplicit . unLoc)\n                              (tcg_rn_imports gbl_env)\n                -- This whole function deals only with *user* imports\n                -- both for warning about unnecessary ones, and for\n                -- deciding the minimal ones\n             rdr_env = tcg_rdr_env gbl_env\n             fld_env = mkFieldEnv rdr_env\n\n       ; let usage :: [ImportDeclUsage]\n             usage = findImportUsage user_imports uses\n\n       ; traceRn \"warnUnusedImportDecls\" $\n                       (vcat [ text \"Uses:\" <+> ppr uses\n                             , text \"Import usage\" <+> ppr usage])\n\n       ; whenWOptM Opt_WarnUnusedImports $\n         mapM_ (warnUnusedImport Opt_WarnUnusedImports fld_env) usage\n\n       ; whenGOptM Opt_D_dump_minimal_imports $\n         printMinimalImports usage }\n\nfindImportUsage :: [LImportDecl GhcRn]\n                -> [GlobalRdrElt]\n                -> [ImportDeclUsage]\n\nfindImportUsage imports used_gres\n  = map unused_decl imports\n  where\n    import_usage :: ImportMap\n    import_usage = mkImportMap used_gres\n\n    unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))\n      = (decl, used_gres, nameSetElemsStable unused_imps)\n      where\n        used_gres = Map.lookup (srcSpanEnd loc) import_usage\n                               -- srcSpanEnd: see Note [The ImportMap]\n                    `orElse` []\n\n        used_names   = mkNameSet (map      gre_name        used_gres)\n        used_parents = mkNameSet (mapMaybe greParent_maybe used_gres)\n\n        unused_imps   -- Not trivial; see eg Trac #7454\n          = case imps of\n              Just (False, L _ imp_ies) ->\n                                 foldr (add_unused . unLoc) emptyNameSet imp_ies\n              _other -> emptyNameSet -- No explicit import list => no unused-name list\n\n        add_unused :: IE GhcRn -> NameSet -> NameSet\n        add_unused (IEVar _ n)      acc = add_unused_name (lieWrappedName n) acc\n        add_unused (IEThingAbs _ n) acc = add_unused_name (lieWrappedName n) acc\n        add_unused (IEThingAll _ n) acc = add_unused_all  (lieWrappedName n) acc\n        add_unused (IEThingWith _ p wc ns fs) acc =\n          add_wc_all (add_unused_with pn xs acc)\n          where pn = lieWrappedName p\n                xs = map lieWrappedName ns ++ map (flSelector . unLoc) fs\n                add_wc_all = case wc of\n                            NoIEWildcard -> id\n                            IEWildcard _ -> add_unused_all pn\n        add_unused _ acc = acc\n\n        add_unused_name n acc\n          | n `elemNameSet` used_names = acc\n          | otherwise                  = acc `extendNameSet` n\n        add_unused_all n acc\n          | n `elemNameSet` used_names   = acc\n          | n `elemNameSet` used_parents = acc\n          | otherwise                    = acc `extendNameSet` n\n        add_unused_with p ns acc\n          | all (`elemNameSet` acc1) ns = add_unused_name p acc1\n          | otherwise = acc1\n          where\n            acc1 = foldr add_unused_name acc ns\n       -- If you use 'signum' from Num, then the user may well have\n       -- imported Num(signum).  We don't want to complain that\n       -- Num is not itself mentioned.  Hence the two cases in add_unused_with.\n    unused_decl (L _ (XImportDecl _)) = panic \"unused_decl\"\n\n\n{- Note [The ImportMap]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe ImportMap is a short-lived intermediate data structure records, for\neach import declaration, what stuff brought into scope by that\ndeclaration is actually used in the module.\n\nThe SrcLoc is the location of the END of a particular 'import'\ndeclaration.  Why *END*?  Because we don't want to get confused\nby the implicit Prelude import. Consider (Trac #7476) the module\n    import Foo( foo )\n    main = print foo\nThere is an implicit 'import Prelude(print)', and it gets a SrcSpan\nof line 1:1 (just the point, not a span). If we use the *START* of\nthe SrcSpan to identify the import decl, we'll confuse the implicit\nimport Prelude with the explicit 'import Foo'.  So we use the END.\nIt's just a cheap hack; we could equally well use the Span too.\n\nThe [GlobalRdrElt] are the things imported from that decl.\n-}\n\ntype ImportMap = Map SrcLoc [GlobalRdrElt]  -- See [The ImportMap]\n     -- If loc :-> gres, then\n     --   'loc' = the end loc of the bestImport of each GRE in 'gres'\n\nmkImportMap :: [GlobalRdrElt] -> ImportMap\n-- For each of a list of used GREs, find all the import decls that brought\n-- it into scope; choose one of them (bestImport), and record\n-- the RdrName in that import decl's entry in the ImportMap\nmkImportMap gres\n  = foldr add_one Map.empty gres\n  where\n    add_one gre@(GRE { gre_imp = imp_specs }) imp_map\n       = Map.insertWith add decl_loc [gre] imp_map\n       where\n          best_imp_spec = bestImport imp_specs\n          decl_loc      = srcSpanEnd (is_dloc (is_decl best_imp_spec))\n                        -- For srcSpanEnd see Note [The ImportMap]\n          add _ gres = gre : gres\n\nwarnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Name)\n                 -> ImportDeclUsage -> RnM ()\nwarnUnusedImport flag fld_env (L loc decl, used, unused)\n\n  -- Do not warn for 'import M()'\n  | Just (False,L _ []) <- ideclHiding decl\n  = return ()\n\n  -- Note [Do not warn about Prelude hiding]\n  | Just (True, L _ hides) <- ideclHiding decl\n  , not (null hides)\n  , pRELUDE_NAME == unLoc (ideclName decl)\n  = return ()\n\n  -- Nothing used; drop entire declaration\n  | null used\n  = addWarnAt (Reason flag) loc msg1\n\n  -- Everything imported is used; nop\n  | null unused\n  = return ()\n\n  -- Some imports are unused\n  | otherwise\n  = addWarnAt (Reason flag) loc  msg2\n\n  where\n    msg1 = vcat [ pp_herald <+> quotes pp_mod <+> is_redundant\n                , nest 2 (text \"except perhaps to import instances from\"\n                                   <+> quotes pp_mod)\n                , text \"To import instances alone, use:\"\n                                   <+> text \"import\" <+> pp_mod <> parens Outputable.empty ]\n    msg2 = sep [ pp_herald <+> quotes sort_unused\n               , text \"from module\" <+> quotes pp_mod <+> is_redundant]\n    pp_herald  = text \"The\" <+> pp_qual <+> text \"import of\"\n    pp_qual\n      | ideclQualified decl = text \"qualified\"\n      | otherwise           = Outputable.empty\n    pp_mod       = ppr (unLoc (ideclName decl))\n    is_redundant = text \"is redundant\"\n\n    -- In warning message, pretty-print identifiers unqualified unconditionally\n    -- to improve the consistent for ambiguous/unambiguous identifiers.\n    -- See trac#14881.\n    ppr_possible_field n = case lookupNameEnv fld_env n of\n                               Just (fld, p) -> pprNameUnqualified p <> parens (ppr fld)\n                               Nothing  -> pprNameUnqualified n\n\n    -- Print unused names in a deterministic (lexicographic) order\n    sort_unused :: SDoc\n    sort_unused = pprWithCommas ppr_possible_field $\n                  sortBy (comparing nameOccName) unused\n\n{-\nNote [Do not warn about Prelude hiding]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe do not warn about\n   import Prelude hiding( x, y )\nbecause even if nothing else from Prelude is used, it may be essential to hide\nx,y to avoid name-shadowing warnings.  Example (Trac #9061)\n   import Prelude hiding( log )\n   f x = log where log = ()\n\n\n\nNote [Printing minimal imports]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTo print the minimal imports we walk over the user-supplied import\ndecls, and simply trim their import lists.  NB that\n\n  * We do *not* change the 'qualified' or 'as' parts!\n\n  * We do not disard a decl altogether; we might need instances\n    from it.  Instead we just trim to an empty import list\n-}\n\ngetMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn]\ngetMinimalImports = mapM mk_minimal\n  where\n    mk_minimal (L l decl, used_gres, unused)\n      | null unused\n      , Just (False, _) <- ideclHiding decl\n      = return (L l decl)\n      | otherwise\n      = do { let ImportDecl { ideclName    = L _ mod_name\n                            , ideclSource  = is_boot\n                            , ideclPkgQual = mb_pkg } = decl\n           ; iface <- loadSrcInterface doc mod_name is_boot (fmap sl_fs mb_pkg)\n           ; let used_avails = gresToAvailInfo used_gres\n                 lies = map (L l) (concatMap (to_ie iface) used_avails)\n           ; return (L l (decl { ideclHiding = Just (False, L l lies) })) }\n      where\n        doc = text \"Compute minimal imports for\" <+> ppr decl\n\n    to_ie :: ModIface -> AvailInfo -> [IE GhcRn]\n    -- The main trick here is that if we're importing all the constructors\n    -- we want to say \"T(..)\", but if we're importing only a subset we want\n    -- to say \"T(A,B,C)\".  So we have to find out what the module exports.\n    to_ie _ (Avail n)\n       = [IEVar noExt (to_ie_post_rn $ noLoc n)]\n    to_ie _ (AvailTC n [m] [])\n       | n==m = [IEThingAbs noExt (to_ie_post_rn $ noLoc n)]\n    to_ie iface (AvailTC n ns fs)\n      = case [(xs,gs) |  AvailTC x xs gs <- mi_exports iface\n                 , x == n\n                 , x `elem` xs    -- Note [Partial export]\n                 ] of\n           [xs] | all_used xs -> [IEThingAll noExt (to_ie_post_rn $ noLoc n)]\n                | otherwise   ->\n                   [IEThingWith noExt (to_ie_post_rn $ noLoc n) NoIEWildcard\n                                (map (to_ie_post_rn . noLoc) (filter (/= n) ns))\n                                (map noLoc fs)]\n                                          -- Note [Overloaded field import]\n           _other | all_non_overloaded fs\n                           -> map (IEVar noExt . to_ie_post_rn_var . noLoc) $ ns\n                                 ++ map flSelector fs\n                  | otherwise ->\n                      [IEThingWith noExt (to_ie_post_rn $ noLoc n) NoIEWildcard\n                                (map (to_ie_post_rn . noLoc) (filter (/= n) ns))\n                                (map noLoc fs)]\n        where\n\n          fld_lbls = map flLabel fs\n\n          all_used (avail_occs, avail_flds)\n              = all (`elem` ns) avail_occs\n                    && all (`elem` fld_lbls) (map flLabel avail_flds)\n\n          all_non_overloaded = all (not . flIsOverloaded)\n\nprintMinimalImports :: [ImportDeclUsage] -> RnM ()\n-- See Note [Printing minimal imports]\nprintMinimalImports imports_w_usage\n  = do { imports' <- getMinimalImports imports_w_usage\n       ; this_mod <- getModule\n       ; dflags   <- getDynFlags\n       ; liftIO $\n         do { h <- openFile (mkFilename dflags this_mod) WriteMode\n            ; printForUser dflags h neverQualify (vcat (map ppr imports')) }\n              -- The neverQualify is important.  We are printing Names\n              -- but they are in the context of an 'import' decl, and\n              -- we never qualify things inside there\n              -- E.g.   import Blag( f, b )\n              -- not    import Blag( Blag.f, Blag.g )!\n       }\n  where\n    mkFilename dflags this_mod\n      | Just d <- dumpDir dflags = d </> basefn\n      | otherwise                = basefn\n      where\n        basefn = moduleNameString (moduleName this_mod) ++ \".imports\"\n\n\nto_ie_post_rn_var :: (HasOccName name) => Located name -> LIEWrappedName name\nto_ie_post_rn_var (L l n)\n  | isDataOcc $ occName n = L l (IEPattern (L l n))\n  | otherwise             = L l (IEName    (L l n))\n\n\nto_ie_post_rn :: (HasOccName name) => Located name -> LIEWrappedName name\nto_ie_post_rn (L l n)\n  | isTcOcc occ && isSymOcc occ = L l (IEType (L l n))\n  | otherwise                   = L l (IEName (L l n))\n  where occ = occName n\n\n{-\nNote [Partial export]\n~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n   module A( op ) where\n     class C a where\n       op :: a -> a\n\n   module B where\n   import A\n   f = ..op...\n\nThen the minimal import for module B is\n   import A( op )\nnot\n   import A( C( op ) )\nwhich we would usually generate if C was exported from B.  Hence\nthe (x `elem` xs) test when deciding what to generate.\n\n\nNote [Overloaded field import]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOn the other hand, if we have\n\n    {-# LANGUAGE DuplicateRecordFields #-}\n    module A where\n      data T = MkT { foo :: Int }\n\n    module B where\n      import A\n      f = ...foo...\n\nthen the minimal import for module B must be\n    import A ( T(foo) )\nbecause when DuplicateRecordFields is enabled, field selectors are\nnot in scope without their enclosing datatype.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Errors}\n*                                                                      *\n************************************************************************\n-}\n\nqualImportItemErr :: RdrName -> SDoc\nqualImportItemErr rdr\n  = hang (text \"Illegal qualified name in import item:\")\n       2 (ppr rdr)\n\nbadImportItemErrStd :: ModIface -> ImpDeclSpec -> IE GhcPs -> SDoc\nbadImportItemErrStd iface decl_spec ie\n  = sep [text \"Module\", quotes (ppr (is_mod decl_spec)), source_import,\n         text \"does not export\", quotes (ppr ie)]\n  where\n    source_import | mi_boot iface = text \"(hi-boot interface)\"\n                  | otherwise     = Outputable.empty\n\nbadImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE GhcPs\n                        -> SDoc\nbadImportItemErrDataCon dataType_occ iface decl_spec ie\n  = vcat [ text \"In module\"\n             <+> quotes (ppr (is_mod decl_spec))\n             <+> source_import <> colon\n         , nest 2 $ quotes datacon\n             <+> text \"is a data constructor of\"\n             <+> quotes dataType\n         , text \"To import it use\"\n         , nest 2 $ text \"import\"\n             <+> ppr (is_mod decl_spec)\n             <> parens_sp (dataType <> parens_sp datacon)\n         , text \"or\"\n         , nest 2 $ text \"import\"\n             <+> ppr (is_mod decl_spec)\n             <> parens_sp (dataType <> text \"(..)\")\n         ]\n  where\n    datacon_occ = rdrNameOcc $ ieName ie\n    datacon = parenSymOcc datacon_occ (ppr datacon_occ)\n    dataType = parenSymOcc dataType_occ (ppr dataType_occ)\n    source_import | mi_boot iface = text \"(hi-boot interface)\"\n                  | otherwise     = Outputable.empty\n    parens_sp d = parens (space <> d <> space)  -- T( f,g )\n\nbadImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> [AvailInfo] -> SDoc\nbadImportItemErr iface decl_spec ie avails\n  = case find checkIfDataCon avails of\n      Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie\n      Nothing  -> badImportItemErrStd iface decl_spec ie\n  where\n    checkIfDataCon (AvailTC _ ns _) =\n      case find (\\n -> importedFS == nameOccNameFS n) ns of\n        Just n  -> isDataConName n\n        Nothing -> False\n    checkIfDataCon _ = False\n    availOccName = nameOccName . availName\n    nameOccNameFS = occNameFS . nameOccName\n    importedFS = occNameFS . rdrNameOcc $ ieName ie\n\nillegalImportItemErr :: SDoc\nillegalImportItemErr = text \"Illegal import item\"\n\ndodgyImportWarn :: RdrName -> SDoc\ndodgyImportWarn item\n  = dodgyMsg (text \"import\") item (dodgyMsgInsert item :: IE GhcPs)\n\ndodgyMsg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc\ndodgyMsg kind tc ie\n  = sep [ text \"The\" <+> kind <+> ptext (sLit \"item\")\n                    -- <+> quotes (ppr (IEThingAll (noLoc (IEName $ noLoc tc))))\n                     <+> quotes (ppr ie)\n                <+> text \"suggests that\",\n          quotes (ppr tc) <+> text \"has (in-scope) constructors or class methods,\",\n          text \"but it has none\" ]\n\ndodgyMsgInsert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)\ndodgyMsgInsert tc = IEThingAll noExt ii\n  where\n    ii :: LIEWrappedName (IdP (GhcPass p))\n    ii = noLoc (IEName $ noLoc tc)\n\n\naddDupDeclErr :: [GlobalRdrElt] -> TcRn ()\naddDupDeclErr [] = panic \"addDupDeclErr: empty list\"\naddDupDeclErr gres@(gre : _)\n  = addErrAt (getSrcSpan (last sorted_names)) $\n    -- Report the error at the later location\n    vcat [text \"Multiple declarations of\" <+>\n             quotes (ppr (nameOccName name)),\n             -- NB. print the OccName, not the Name, because the\n             -- latter might not be in scope in the RdrEnv and so will\n             -- be printed qualified.\n          text \"Declared at:\" <+>\n                   vcat (map (ppr . nameSrcLoc) sorted_names)]\n  where\n    name = gre_name gre\n    sorted_names = sortWith nameSrcLoc (map gre_name gres)\n\n\n\nmissingImportListWarn :: ModuleName -> SDoc\nmissingImportListWarn mod\n  = text \"The module\" <+> quotes (ppr mod) <+> ptext (sLit \"does not have an explicit import list\")\n\nmissingImportListItem :: IE GhcPs -> SDoc\nmissingImportListItem ie\n  = text \"The import item\" <+> quotes (ppr ie) <+> ptext (sLit \"does not have an explicit import list\")\n\nmoduleWarn :: ModuleName -> WarningTxt -> SDoc\nmoduleWarn mod (WarningTxt _ txt)\n  = sep [ text \"Module\" <+> quotes (ppr mod) <> ptext (sLit \":\"),\n          nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]\nmoduleWarn mod (DeprecatedTxt _ txt)\n  = sep [ text \"Module\" <+> quotes (ppr mod)\n                                <+> text \"is deprecated:\",\n          nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]\n\npackageImportErr :: SDoc\npackageImportErr\n  = text \"Package-qualified imports are not enabled; use PackageImports\"\n\n-- This data decl will parse OK\n--      data T = a Int\n-- treating \"a\" as the constructor.\n-- It is really hard to make the parser spot this malformation.\n-- So the renamer has to check that the constructor is legal\n--\n-- We can get an operator as the constructor, even in the prefix form:\n--      data T = :% Int Int\n-- from interface files, which always print in prefix form\n\ncheckConName :: RdrName -> TcRn ()\ncheckConName name = checkErr (isRdrDataCon name) (badDataCon name)\n\nbadDataCon :: RdrName -> SDoc\nbadDataCon name\n   = hsep [text \"Illegal data constructor name\", quotes (ppr name)]\n", "num_lines": 1780}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[RnPat]{Renaming of patterns}\n\nBasically dependency analysis.\n\nHandles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In\ngeneral, all of these functions return a renamed thing, and a set of\nfree variables.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule RnPat (-- main entry points\n              rnPat, rnPats, rnBindPat, rnPatAndThen,\n\n              NameMaker, applyNameMaker,     -- a utility for making names:\n              localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,\n                                             --   sometimes we want to make top (qualified) names.\n              isTopRecNameMaker,\n\n              rnHsRecFields, HsRecFieldContext(..),\n              rnHsRecUpdFields,\n\n              -- CpsRn monad\n              CpsRn, liftCps,\n\n              -- Literals\n              rnLit, rnOverLit,\n\n             -- Pattern Error messages that are also used elsewhere\n             checkTupSize, patSigErr\n             ) where\n\n-- ENH: thin imports to only what is necessary for patterns\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} RnExpr ( rnLExpr )\nimport {-# SOURCE #-} RnSplice ( rnSplicePat )\n\n#include \"HsVersions.h\"\n\nimport HsSyn\nimport TcRnMonad\nimport TcHsSyn             ( hsOverLitName )\nimport RnEnv\nimport RnFixity\nimport RnUtils             ( HsDocContext(..), newLocalBndrRn, bindLocalNames\n                           , warnUnusedMatches, newLocalBndrRn\n                           , checkUnusedRecordWildcard\n                           , checkDupNames, checkDupAndShadowedNames\n                           , checkTupSize , unknownSubordinateErr )\nimport RnTypes\nimport PrelNames\nimport Name\nimport NameSet\nimport RdrName\nimport BasicTypes\nimport Util\nimport ListSetOps          ( removeDups )\nimport Outputable\nimport SrcLoc\nimport Literal             ( inCharRange )\nimport TysWiredIn          ( nilDataCon )\nimport DataCon\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad       ( when, liftM, ap, guard )\nimport qualified Data.List.NonEmpty as NE\nimport Data.Ratio\n\n{-\n*********************************************************\n*                                                      *\n        The CpsRn Monad\n*                                                      *\n*********************************************************\n\nNote [CpsRn monad]\n~~~~~~~~~~~~~~~~~~\nThe CpsRn monad uses continuation-passing style to support this\nstyle of programming:\n\n        do { ...\n           ; ns <- bindNames rs\n           ; ...blah... }\n\n   where rs::[RdrName], ns::[Name]\n\nThe idea is that '...blah...'\n  a) sees the bindings of ns\n  b) returns the free variables it mentions\n     so that bindNames can report unused ones\n\nIn particular,\n    mapM rnPatAndThen [p1, p2, p3]\nhas a *left-to-right* scoping: it makes the binders in\np1 scope over p2,p3.\n-}\n\nnewtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))\n                                            -> RnM (r, FreeVars) }\n        -- See Note [CpsRn monad]\n\ninstance Functor CpsRn where\n    fmap = liftM\n\ninstance Applicative CpsRn where\n    pure x = CpsRn (\\k -> k x)\n    (<*>) = ap\n\ninstance Monad CpsRn where\n  (CpsRn m) >>= mk = CpsRn (\\k -> m (\\v -> unCpsRn (mk v) k))\n\nrunCps :: CpsRn a -> RnM (a, FreeVars)\nrunCps (CpsRn m) = m (\\r -> return (r, emptyFVs))\n\nliftCps :: RnM a -> CpsRn a\nliftCps rn_thing = CpsRn (\\k -> rn_thing >>= k)\n\nliftCpsFV :: RnM (a, FreeVars) -> CpsRn a\nliftCpsFV rn_thing = CpsRn (\\k -> do { (v,fvs1) <- rn_thing\n                                     ; (r,fvs2) <- k v\n                                     ; return (r, fvs1 `plusFV` fvs2) })\n\nwrapSrcSpanCps :: (HasSrcSpan a, HasSrcSpan b) =>\n                  (SrcSpanLess a -> CpsRn (SrcSpanLess b)) -> a -> CpsRn b\n-- Set the location, and also wrap it around the value returned\nwrapSrcSpanCps fn (dL->L loc a)\n  = CpsRn (\\k -> setSrcSpan loc $\n                 unCpsRn (fn a) $ \\v ->\n                 k (cL loc v))\n\nlookupConCps :: Located RdrName -> CpsRn (Located Name)\nlookupConCps con_rdr\n  = CpsRn (\\k -> do { con_name <- lookupLocatedOccRn con_rdr\n                    ; (r, fvs) <- k con_name\n                    ; return (r, addOneFV fvs (unLoc con_name)) })\n    -- We add the constructor name to the free vars\n    -- See Note [Patterns are uses]\n\n{-\nNote [Patterns are uses]\n~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  module Foo( f, g ) where\n  data T = T1 | T2\n\n  f T1 = True\n  f T2 = False\n\n  g _ = T1\n\nArguably we should report T2 as unused, even though it appears in a\npattern, because it never occurs in a constructed position.  See\nTrac #7336.\nHowever, implementing this in the face of pattern synonyms would be\nless straightforward, since given two pattern synonyms\n\n  pattern P1 <- P2\n  pattern P2 <- ()\n\nwe need to observe the dependency between P1 and P2 so that type\nchecking can be done in the correct order (just like for value\nbindings). Dependencies between bindings is analyzed in the renamer,\nwhere we don't know yet whether P2 is a constructor or a pattern\nsynonym. So for now, we do report conid occurrences in patterns as\nuses.\n\n*********************************************************\n*                                                      *\n        Name makers\n*                                                      *\n*********************************************************\n\nExternally abstract type of name makers,\nwhich is how you go from a RdrName to a Name\n-}\n\ndata NameMaker\n  = LamMk       -- Lambdas\n      Bool      -- True <=> report unused bindings\n                --   (even if True, the warning only comes out\n                --    if -Wunused-matches is on)\n\n  | LetMk       -- Let bindings, incl top level\n                -- Do *not* check for unused bindings\n      TopLevelFlag\n      MiniFixityEnv\n\ntopRecNameMaker :: MiniFixityEnv -> NameMaker\ntopRecNameMaker fix_env = LetMk TopLevel fix_env\n\nisTopRecNameMaker :: NameMaker -> Bool\nisTopRecNameMaker (LetMk TopLevel _) = True\nisTopRecNameMaker _ = False\n\nlocalRecNameMaker :: MiniFixityEnv -> NameMaker\nlocalRecNameMaker fix_env = LetMk NotTopLevel fix_env\n\nmatchNameMaker :: HsMatchContext a -> NameMaker\nmatchNameMaker ctxt = LamMk report_unused\n  where\n    -- Do not report unused names in interactive contexts\n    -- i.e. when you type 'x <- e' at the GHCi prompt\n    report_unused = case ctxt of\n                      StmtCtxt GhciStmtCtxt -> False\n                      -- also, don't warn in pattern quotes, as there\n                      -- is no RHS where the variables can be used!\n                      ThPatQuote            -> False\n                      _                     -> True\n\nrnHsSigCps :: LHsSigWcType GhcPs -> CpsRn (LHsSigWcType GhcRn)\nrnHsSigCps sig = CpsRn (rnHsSigWcTypeScoped AlwaysBind PatCtx sig)\n\nnewPatLName :: NameMaker -> Located RdrName -> CpsRn (Located Name)\nnewPatLName name_maker rdr_name@(dL->L loc _)\n  = do { name <- newPatName name_maker rdr_name\n       ; return (cL loc name) }\n\nnewPatName :: NameMaker -> Located RdrName -> CpsRn Name\nnewPatName (LamMk report_unused) rdr_name\n  = CpsRn (\\ thing_inside ->\n        do { name <- newLocalBndrRn rdr_name\n           ; (res, fvs) <- bindLocalNames [name] (thing_inside name)\n           ; when report_unused $ warnUnusedMatches [name] fvs\n           ; return (res, name `delFV` fvs) })\n\nnewPatName (LetMk is_top fix_env) rdr_name\n  = CpsRn (\\ thing_inside ->\n        do { name <- case is_top of\n                       NotTopLevel -> newLocalBndrRn rdr_name\n                       TopLevel    -> newTopSrcBinder rdr_name\n           ; bindLocalNames [name] $       -- Do *not* use bindLocalNameFV here\n                                        -- See Note [View pattern usage]\n             addLocalFixities fix_env [name] $\n             thing_inside name })\n\n    -- Note: the bindLocalNames is somewhat suspicious\n    --       because it binds a top-level name as a local name.\n    --       however, this binding seems to work, and it only exists for\n    --       the duration of the patterns and the continuation;\n    --       then the top-level name is added to the global env\n    --       before going on to the RHSes (see RnSource.hs).\n\n{-\nNote [View pattern usage]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  let (r, (r -> x)) = x in ...\nHere the pattern binds 'r', and then uses it *only* in the view pattern.\nWe want to \"see\" this use, and in let-bindings we collect all uses and\nreport unused variables at the binding level. So we must use bindLocalNames\nhere, *not* bindLocalNameFV.  Trac #3943.\n\n\nNote [Don't report shadowing for pattern synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere is one special context where a pattern doesn't introduce any new binders -\npattern synonym declarations. Therefore we don't check to see if pattern\nvariables shadow existing identifiers as they are never bound to anything\nand have no scope.\n\nWithout this check, there would be quite a cryptic warning that the `x`\nin the RHS of the pattern synonym declaration shadowed the top level `x`.\n\n```\nx :: ()\nx = ()\n\npattern P x = Just x\n```\n\nSee #12615 for some more examples.\n\n*********************************************************\n*                                                      *\n        External entry points\n*                                                      *\n*********************************************************\n\nThere are various entry points to renaming patterns, depending on\n (1) whether the names created should be top-level names or local names\n (2) whether the scope of the names is entirely given in a continuation\n     (e.g., in a case or lambda, but not in a let or at the top-level,\n      because of the way mutually recursive bindings are handled)\n (3) whether the a type signature in the pattern can bind\n        lexically-scoped type variables (for unpacking existential\n        type vars in data constructors)\n (4) whether we do duplicate and unused variable checking\n (5) whether there are fixity declarations associated with the names\n     bound by the patterns that need to be brought into scope with them.\n\n Rather than burdening the clients of this module with all of these choices,\n we export the three points in this design space that we actually need:\n-}\n\n-- ----------- Entry point 1: rnPats -------------------\n-- Binds local names; the scope of the bindings is entirely in the thing_inside\n--   * allows type sigs to bind type vars\n--   * local namemaker\n--   * unused and duplicate checking\n--   * no fixities\nrnPats :: HsMatchContext Name -- for error messages\n       -> [LPat GhcPs]\n       -> ([LPat GhcRn] -> RnM (a, FreeVars))\n       -> RnM (a, FreeVars)\nrnPats ctxt pats thing_inside\n  = do  { envs_before <- getRdrEnvs\n\n          -- (1) rename the patterns, bringing into scope all of the term variables\n          -- (2) then do the thing inside.\n        ; unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \\ pats' -> do\n        { -- Check for duplicated and shadowed names\n          -- Must do this *after* renaming the patterns\n          -- See Note [Collect binders only after renaming] in HsUtils\n          -- Because we don't bind the vars all at once, we can't\n          --    check incrementally for duplicates;\n          -- Nor can we check incrementally for shadowing, else we'll\n          --    complain *twice* about duplicates e.g. f (x,x) = ...\n          --\n          -- See note [Don't report shadowing for pattern synonyms]\n        ; let bndrs = collectPatsBinders pats'\n        ; addErrCtxt doc_pat $\n          if isPatSynCtxt ctxt\n             then checkDupNames bndrs\n             else checkDupAndShadowedNames envs_before bndrs\n        ; thing_inside pats' } }\n  where\n    doc_pat = text \"In\" <+> pprMatchContext ctxt\n\nrnPat :: HsMatchContext Name -- for error messages\n      -> LPat GhcPs\n      -> (LPat GhcRn -> RnM (a, FreeVars))\n      -> RnM (a, FreeVars)     -- Variables bound by pattern do not\n                               -- appear in the result FreeVars\nrnPat ctxt pat thing_inside\n  = rnPats ctxt [pat] (\\pats' -> let [pat'] = pats' in thing_inside pat')\n\napplyNameMaker :: NameMaker -> Located RdrName -> RnM (Located Name)\napplyNameMaker mk rdr = do { (n, _fvs) <- runCps (newPatLName mk rdr)\n                           ; return n }\n\n-- ----------- Entry point 2: rnBindPat -------------------\n-- Binds local names; in a recursive scope that involves other bound vars\n--      e.g let { (x, Just y) = e1; ... } in ...\n--   * does NOT allows type sig to bind type vars\n--   * local namemaker\n--   * no unused and duplicate checking\n--   * fixities might be coming in\nrnBindPat :: NameMaker\n          -> LPat GhcPs\n          -> RnM (LPat GhcRn, FreeVars)\n   -- Returned FreeVars are the free variables of the pattern,\n   -- of course excluding variables bound by this pattern\n\nrnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)\n\n{-\n*********************************************************\n*                                                      *\n        The main event\n*                                                      *\n*********************************************************\n-}\n\n-- ----------- Entry point 3: rnLPatAndThen -------------------\n-- General version: parametrized by how you make new names\n\nrnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn]\nrnLPatsAndThen mk = mapM (rnLPatAndThen mk)\n  -- Despite the map, the monad ensures that each pattern binds\n  -- variables that may be mentioned in subsequent patterns in the list\n\n--------------------\n-- The workhorse\nrnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn)\nrnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat\n\nrnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)\nrnPatAndThen _  (WildPat _)   = return (WildPat noExt)\nrnPatAndThen mk (ParPat x pat)  = do { pat' <- rnLPatAndThen mk pat\n                                     ; return (ParPat x pat') }\nrnPatAndThen mk (LazyPat x pat) = do { pat' <- rnLPatAndThen mk pat\n                                     ; return (LazyPat x pat') }\nrnPatAndThen mk (BangPat x pat) = do { pat' <- rnLPatAndThen mk pat\n                                     ; return (BangPat x pat') }\nrnPatAndThen mk (VarPat x (dL->L l rdr))\n    = do { loc <- liftCps getSrcSpanM\n         ; name <- newPatName mk (cL loc rdr)\n         ; return (VarPat x (cL l name)) }\n     -- we need to bind pattern variables for view pattern expressions\n     -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)\n\nrnPatAndThen mk (SigPat x pat sig)\n  -- When renaming a pattern type signature (e.g. f (a :: T) = ...), it is\n  -- important to rename its type signature _before_ renaming the rest of the\n  -- pattern, so that type variables are first bound by the _outermost_ pattern\n  -- type signature they occur in. This keeps the type checker happy when\n  -- pattern type signatures happen to be nested (#7827)\n  --\n  -- f ((Just (x :: a) :: Maybe a)\n  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~^       `a' is first bound here\n  -- ~~~~~~~~~~~~~~~^                   the same `a' then used here\n  = do { sig' <- rnHsSigCps sig\n       ; pat' <- rnLPatAndThen mk pat\n       ; return (SigPat x pat' sig' ) }\n\nrnPatAndThen mk (LitPat x lit)\n  | HsString src s <- lit\n  = do { ovlStr <- liftCps (xoptM LangExt.OverloadedStrings)\n       ; if ovlStr\n         then rnPatAndThen mk\n                           (mkNPat (noLoc (mkHsIsString src s))\n                                      Nothing)\n         else normal_lit }\n  | otherwise = normal_lit\n  where\n    normal_lit = do { liftCps (rnLit lit); return (LitPat x (convertLit lit)) }\n\nrnPatAndThen _ (NPat x (dL->L l lit) mb_neg _eq)\n  = do { (lit', mb_neg') <- liftCpsFV $ rnOverLit lit\n       ; mb_neg' -- See Note [Negative zero]\n           <- let negative = do { (neg, fvs) <- lookupSyntaxName negateName\n                                ; return (Just neg, fvs) }\n                  positive = return (Nothing, emptyFVs)\n              in liftCpsFV $ case (mb_neg , mb_neg') of\n                                  (Nothing, Just _ ) -> negative\n                                  (Just _ , Nothing) -> negative\n                                  (Nothing, Nothing) -> positive\n                                  (Just _ , Just _ ) -> positive\n       ; eq' <- liftCpsFV $ lookupSyntaxName eqName\n       ; return (NPat x (cL l lit') mb_neg' eq') }\n\nrnPatAndThen mk (NPlusKPat x rdr (dL->L l lit) _ _ _ )\n  = do { new_name <- newPatName mk rdr\n       ; (lit', _) <- liftCpsFV $ rnOverLit lit -- See Note [Negative zero]\n                                                -- We skip negateName as\n                                                -- negative zero doesn't make\n                                                -- sense in n + k patterns\n       ; minus <- liftCpsFV $ lookupSyntaxName minusName\n       ; ge    <- liftCpsFV $ lookupSyntaxName geName\n       ; return (NPlusKPat x (cL (nameSrcSpan new_name) new_name)\n                             (cL l lit') lit' ge minus) }\n                -- The Report says that n+k patterns must be in Integral\n\nrnPatAndThen mk (AsPat x rdr pat)\n  = do { new_name <- newPatLName mk rdr\n       ; pat' <- rnLPatAndThen mk pat\n       ; return (AsPat x new_name pat') }\n\nrnPatAndThen mk p@(ViewPat x expr pat)\n  = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns\n                      ; checkErr vp_flag (badViewPat p) }\n         -- Because of the way we're arranging the recursive calls,\n         -- this will be in the right context\n       ; expr' <- liftCpsFV $ rnLExpr expr\n       ; pat' <- rnLPatAndThen mk pat\n       -- Note: at this point the PreTcType in ty can only be a placeHolder\n       -- ; return (ViewPat expr' pat' ty) }\n       ; return (ViewPat x expr' pat') }\n\nrnPatAndThen mk (ConPatIn con stuff)\n   -- rnConPatAndThen takes care of reconstructing the pattern\n   -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on.\n  = case unLoc con == nameRdrName (dataConName nilDataCon) of\n      True    -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists\n                    ; if ol_flag then rnPatAndThen mk (ListPat noExt [])\n                                 else rnConPatAndThen mk con stuff}\n      False   -> rnConPatAndThen mk con stuff\n\nrnPatAndThen mk (ListPat _ pats)\n  = do { opt_OverloadedLists <- liftCps $ xoptM LangExt.OverloadedLists\n       ; pats' <- rnLPatsAndThen mk pats\n       ; case opt_OverloadedLists of\n          True -> do { (to_list_name,_) <- liftCps $ lookupSyntaxName toListName\n                     ; return (ListPat (Just to_list_name) pats')}\n          False -> return (ListPat Nothing pats') }\n\nrnPatAndThen mk (TuplePat x pats boxed)\n  = do { liftCps $ checkTupSize (length pats)\n       ; pats' <- rnLPatsAndThen mk pats\n       ; return (TuplePat x pats' boxed) }\n\nrnPatAndThen mk (SumPat x pat alt arity)\n  = do { pat <- rnLPatAndThen mk pat\n       ; return (SumPat x pat alt arity)\n       }\n\n-- If a splice has been run already, just rename the result.\nrnPatAndThen mk (SplicePat x (HsSpliced x2 mfs (HsSplicedPat pat)))\n  = SplicePat x . HsSpliced x2 mfs . HsSplicedPat <$> rnPatAndThen mk pat\n\nrnPatAndThen mk (SplicePat _ splice)\n  = do { eith <- liftCpsFV $ rnSplicePat splice\n       ; case eith of   -- See Note [rnSplicePat] in RnSplice\n           Left  not_yet_renamed -> rnPatAndThen mk not_yet_renamed\n           Right already_renamed -> return already_renamed }\n\nrnPatAndThen _ pat = pprPanic \"rnLPatAndThen\" (ppr pat)\n\n\n--------------------\nrnConPatAndThen :: NameMaker\n                -> Located RdrName    -- the constructor\n                -> HsConPatDetails GhcPs\n                -> CpsRn (Pat GhcRn)\n\nrnConPatAndThen mk con (PrefixCon pats)\n  = do  { con' <- lookupConCps con\n        ; pats' <- rnLPatsAndThen mk pats\n        ; return (ConPatIn con' (PrefixCon pats')) }\n\nrnConPatAndThen mk con (InfixCon pat1 pat2)\n  = do  { con' <- lookupConCps con\n        ; pat1' <- rnLPatAndThen mk pat1\n        ; pat2' <- rnLPatAndThen mk pat2\n        ; fixity <- liftCps $ lookupFixityRn (unLoc con')\n        ; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }\n\nrnConPatAndThen mk con (RecCon rpats)\n  = do  { con' <- lookupConCps con\n        ; rpats' <- rnHsRecPatsAndThen mk con' rpats\n        ; return (ConPatIn con' (RecCon rpats')) }\n\ncheckUnusedRecordWildcardCps :: SrcSpan -> Maybe [Name] -> CpsRn ()\ncheckUnusedRecordWildcardCps loc dotdot_names =\n  CpsRn (\\thing -> do\n                    (r, fvs) <- thing ()\n                    checkUnusedRecordWildcard loc fvs dotdot_names\n                    return (r, fvs) )\n--------------------\nrnHsRecPatsAndThen :: NameMaker\n                   -> Located Name      -- Constructor\n                   -> HsRecFields GhcPs (LPat GhcPs)\n                   -> CpsRn (HsRecFields GhcRn (LPat GhcRn))\nrnHsRecPatsAndThen mk (dL->L _ con)\n     hs_rec_fields@(HsRecFields { rec_dotdot = dd })\n  = do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) mkVarPat\n                                            hs_rec_fields\n       ; flds' <- mapM rn_field (flds `zip` [1..])\n       ; check_unused_wildcard (implicit_binders flds' <$> dd)\n       ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }\n  where\n    mkVarPat l n = VarPat noExt (cL l n)\n    rn_field (dL->L l fld, n') =\n      do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hsRecFieldArg fld)\n         ; return (cL l (fld { hsRecFieldArg = arg' })) }\n\n    loc = maybe noSrcSpan getLoc dd\n\n    -- Get the arguments of the implicit binders\n    implicit_binders fs (unLoc -> n) = collectPatsBinders implicit_pats\n      where\n        implicit_pats = map (hsRecFieldArg . unLoc) (drop n fs)\n\n    -- Don't warn for let P{..} = ... in ...\n    check_unused_wildcard = case mk of\n                              LetMk{} -> const (return ())\n                              LamMk{} -> checkUnusedRecordWildcardCps loc\n\n        -- Suppress unused-match reporting for fields introduced by \"..\"\n    nested_mk Nothing  mk                    _  = mk\n    nested_mk (Just _) mk@(LetMk {})         _  = mk\n    nested_mk (Just (unLoc -> n)) (LamMk report_unused) n'\n      = LamMk (report_unused && (n' <= n))\n\n{-\n************************************************************************\n*                                                                      *\n        Record fields\n*                                                                      *\n************************************************************************\n-}\n\ndata HsRecFieldContext\n  = HsRecFieldCon Name\n  | HsRecFieldPat Name\n  | HsRecFieldUpd\n\nrnHsRecFields\n    :: forall arg. HasSrcSpan arg =>\n       HsRecFieldContext\n    -> (SrcSpan -> RdrName -> SrcSpanLess arg)\n         -- When punning, use this to build a new field\n    -> HsRecFields GhcPs arg\n    -> RnM ([LHsRecField GhcRn arg], FreeVars)\n\n-- This surprisingly complicated pass\n--   a) looks up the field name (possibly using disambiguation)\n--   b) fills in puns and dot-dot stuff\n-- When we've finished, we've renamed the LHS, but not the RHS,\n-- of each x=e binding\n--\n-- This is used for record construction and pattern-matching, but not updates.\n\nrnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })\n  = do { pun_ok      <- xoptM LangExt.RecordPuns\n       ; disambig_ok <- xoptM LangExt.DisambiguateRecordFields\n       ; let parent = guard disambig_ok >> mb_con\n       ; flds1  <- mapM (rn_fld pun_ok parent) flds\n       ; mapM_ (addErr . dupFieldErr ctxt) dup_flds\n       ; dotdot_flds <- rn_dotdot dotdot mb_con flds1\n       ; let all_flds | null dotdot_flds = flds1\n                      | otherwise        = flds1 ++ dotdot_flds\n       ; return (all_flds, mkFVs (getFieldIds all_flds)) }\n  where\n    mb_con = case ctxt of\n                HsRecFieldCon con  -> Just con\n                HsRecFieldPat con  -> Just con\n                _ {- update -}     -> Nothing\n\n    rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs arg\n           -> RnM (LHsRecField GhcRn arg)\n    rn_fld pun_ok parent (dL->L l\n                           (HsRecField\n                              { hsRecFieldLbl =\n                                  (dL->L loc (FieldOcc _ (dL->L ll lbl)))\n                              , hsRecFieldArg = arg\n                              , hsRecPun      = pun }))\n      = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent lbl\n           ; arg' <- if pun\n                     then do { checkErr pun_ok (badPun (cL loc lbl))\n                               -- Discard any module qualifier (#11662)\n                             ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)\n                             ; return (cL loc (mk_arg loc arg_rdr)) }\n                     else return arg\n           ; return (cL l (HsRecField\n                             { hsRecFieldLbl = (cL loc (FieldOcc\n                                                          sel (cL ll lbl)))\n                             , hsRecFieldArg = arg'\n                             , hsRecPun      = pun })) }\n    rn_fld _ _ (dL->L _ (HsRecField (dL->L _ (XFieldOcc _)) _ _))\n      = panic \"rnHsRecFields\"\n    rn_fld _ _ _ = panic \"rn_fld: Impossible Match\"\n                                -- due to #15884\n\n\n    rn_dotdot :: Maybe (Located Int)      -- See Note [DotDot fields] in HsPat\n              -> Maybe Name -- The constructor (Nothing for an\n                                --    out of scope constructor)\n              -> [LHsRecField GhcRn arg] -- Explicit fields\n              -> RnM ([LHsRecField GhcRn arg])   -- Field Labels we need to fill in\n    rn_dotdot (Just (dL -> L loc n)) (Just con) flds -- \"..\" on record construction / pat match\n      | not (isUnboundName con) -- This test is because if the constructor\n                                -- isn't in scope the constructor lookup will add\n                                -- an error but still return an unbound name. We\n                                -- don't want that to screw up the dot-dot fill-in stuff.\n      = ASSERT( flds `lengthIs` n )\n        do { dd_flag <- xoptM LangExt.RecordWildCards\n           ; checkErr dd_flag (needFlagDotDot ctxt)\n           ; (rdr_env, lcl_env) <- getRdrEnvs\n           ; con_fields <- lookupConstructorFields con\n           ; when (null con_fields) (addErr (badDotDotCon con))\n           ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldLbls flds)\n\n                   -- For constructor uses (but not patterns)\n                   -- the arg should be in scope locally;\n                   -- i.e. not top level or imported\n                   -- Eg.  data R = R { x,y :: Int }\n                   --      f x = R { .. }   -- Should expand to R {x=x}, not R{x=x,y=y}\n                 arg_in_scope lbl = mkRdrUnqual lbl `elemLocalRdrEnv` lcl_env\n\n                 (dot_dot_fields, dot_dot_gres)\n                        = unzip [ (fl, gre)\n                                | fl <- con_fields\n                                , let lbl = mkVarOccFS (flLabel fl)\n                                , not (lbl `elemOccSet` present_flds)\n                                , Just gre <- [lookupGRE_FieldLabel rdr_env fl]\n                                              -- Check selector is in scope\n                                , case ctxt of\n                                    HsRecFieldCon {} -> arg_in_scope lbl\n                                    _other           -> True ]\n\n           ; addUsedGREs dot_dot_gres\n           ; return [ cL loc (HsRecField\n                        { hsRecFieldLbl = cL loc (FieldOcc sel (cL loc arg_rdr))\n                        , hsRecFieldArg = cL loc (mk_arg loc arg_rdr)\n                        , hsRecPun      = False })\n                    | fl <- dot_dot_fields\n                    , let sel     = flSelector fl\n                    , let arg_rdr = mkVarUnqual (flLabel fl) ] }\n\n    rn_dotdot _dotdot _mb_con _flds\n      = return []\n      -- _dotdot = Nothing => No \"..\" at all\n      -- _mb_con = Nothing => Record update\n      -- _mb_con = Just unbound => Out of scope data constructor\n\n    dup_flds :: [NE.NonEmpty RdrName]\n        -- Each list represents a RdrName that occurred more than once\n        -- (the list contains all occurrences)\n        -- Each list in dup_fields is non-empty\n    (_, dup_flds) = removeDups compare (getFieldLbls flds)\n\n\n-- NB: Consider this:\n--      module Foo where { data R = R { fld :: Int } }\n--      module Odd where { import Foo; fld x = x { fld = 3 } }\n-- Arguably this should work, because the reference to 'fld' is\n-- unambiguous because there is only one field id 'fld' in scope.\n-- But currently it's rejected.\n\nrnHsRecUpdFields\n    :: [LHsRecUpdField GhcPs]\n    -> RnM ([LHsRecUpdField GhcRn], FreeVars)\nrnHsRecUpdFields flds\n  = do { pun_ok        <- xoptM LangExt.RecordPuns\n       ; overload_ok   <- xoptM LangExt.DuplicateRecordFields\n       ; (flds1, fvss) <- mapAndUnzipM (rn_fld pun_ok overload_ok) flds\n       ; mapM_ (addErr . dupFieldErr HsRecFieldUpd) dup_flds\n\n       -- Check for an empty record update  e {}\n       -- NB: don't complain about e { .. }, because rn_dotdot has done that already\n       ; when (null flds) $ addErr emptyUpdateErr\n\n       ; return (flds1, plusFVs fvss) }\n  where\n    doc = text \"constructor field name\"\n\n    rn_fld :: Bool -> Bool -> LHsRecUpdField GhcPs\n           -> RnM (LHsRecUpdField GhcRn, FreeVars)\n    rn_fld pun_ok overload_ok (dL->L l (HsRecField { hsRecFieldLbl = dL->L loc f\n                                                   , hsRecFieldArg = arg\n                                                   , hsRecPun      = pun }))\n      = do { let lbl = rdrNameAmbiguousFieldOcc f\n           ; sel <- setSrcSpan loc $\n                      -- Defer renaming of overloaded fields to the typechecker\n                      -- See Note [Disambiguating record fields] in TcExpr\n                      if overload_ok\n                          then do { mb <- lookupGlobalOccRn_overloaded\n                                            overload_ok lbl\n                                  ; case mb of\n                                      Nothing ->\n                                        do { addErr\n                                               (unknownSubordinateErr doc lbl)\n                                           ; return (Right []) }\n                                      Just r  -> return r }\n                          else fmap Left $ lookupGlobalOccRn lbl\n           ; arg' <- if pun\n                     then do { checkErr pun_ok (badPun (cL loc lbl))\n                               -- Discard any module qualifier (#11662)\n                             ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)\n                             ; return (cL loc (HsVar noExt (cL loc arg_rdr))) }\n                     else return arg\n           ; (arg'', fvs) <- rnLExpr arg'\n\n           ; let fvs' = case sel of\n                          Left sel_name -> fvs `addOneFV` sel_name\n                          Right [sel_name] -> fvs `addOneFV` sel_name\n                          Right _       -> fvs\n                 lbl' = case sel of\n                          Left sel_name ->\n                                     cL loc (Unambiguous sel_name  (cL loc lbl))\n                          Right [sel_name] ->\n                                     cL loc (Unambiguous sel_name  (cL loc lbl))\n                          Right _ -> cL loc (Ambiguous   noExt     (cL loc lbl))\n\n           ; return (cL l (HsRecField { hsRecFieldLbl = lbl'\n                                      , hsRecFieldArg = arg''\n                                      , hsRecPun      = pun }), fvs') }\n\n    dup_flds :: [NE.NonEmpty RdrName]\n        -- Each list represents a RdrName that occurred more than once\n        -- (the list contains all occurrences)\n        -- Each list in dup_fields is non-empty\n    (_, dup_flds) = removeDups compare (getFieldUpdLbls flds)\n\n\n\ngetFieldIds :: [LHsRecField GhcRn arg] -> [Name]\ngetFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds\n\ngetFieldLbls :: [LHsRecField id arg] -> [RdrName]\ngetFieldLbls flds\n  = map (unLoc . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds\n\ngetFieldUpdLbls :: [LHsRecUpdField GhcPs] -> [RdrName]\ngetFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds\n\nneedFlagDotDot :: HsRecFieldContext -> SDoc\nneedFlagDotDot ctxt = vcat [text \"Illegal `..' in record\" <+> pprRFC ctxt,\n                            text \"Use RecordWildCards to permit this\"]\n\nbadDotDotCon :: Name -> SDoc\nbadDotDotCon con\n  = vcat [ text \"Illegal `..' notation for constructor\" <+> quotes (ppr con)\n         , nest 2 (text \"The constructor has no labelled fields\") ]\n\nemptyUpdateErr :: SDoc\nemptyUpdateErr = text \"Empty record update\"\n\nbadPun :: Located RdrName -> SDoc\nbadPun fld = vcat [text \"Illegal use of punning for field\" <+> quotes (ppr fld),\n                   text \"Use NamedFieldPuns to permit this\"]\n\ndupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> SDoc\ndupFieldErr ctxt dups\n  = hsep [text \"duplicate field name\",\n          quotes (ppr (NE.head dups)),\n          text \"in record\", pprRFC ctxt]\n\npprRFC :: HsRecFieldContext -> SDoc\npprRFC (HsRecFieldCon {}) = text \"construction\"\npprRFC (HsRecFieldPat {}) = text \"pattern\"\npprRFC (HsRecFieldUpd {}) = text \"update\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Literals}\n*                                                                      *\n************************************************************************\n\nWhen literals occur we have to make sure\nthat the types and classes they involve\nare made available.\n-}\n\nrnLit :: HsLit p -> RnM ()\nrnLit (HsChar _ c) = checkErr (inCharRange c) (bogusCharError c)\nrnLit _ = return ()\n\n-- Turn a Fractional-looking literal which happens to be an integer into an\n-- Integer-looking literal.\ngeneralizeOverLitVal :: OverLitVal -> OverLitVal\ngeneralizeOverLitVal (HsFractional (FL {fl_text=src,fl_neg=neg,fl_value=val}))\n    | denominator val == 1 = HsIntegral (IL { il_text=src\n                                            , il_neg=neg\n                                            , il_value=numerator val})\ngeneralizeOverLitVal lit = lit\n\nisNegativeZeroOverLit :: HsOverLit t -> Bool\nisNegativeZeroOverLit lit\n = case ol_val lit of\n        HsIntegral i   -> 0 == il_value i && il_neg i\n        HsFractional f -> 0 == fl_value f && fl_neg f\n        _              -> False\n\n{-\nNote [Negative zero]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nThere were problems with negative zero in conjunction with Negative Literals\nextension. Numeric literal value is contained in Integer and Rational types\ninside IntegralLit and FractionalLit. These types cannot represent negative\nzero value. So we had to add explicit field 'neg' which would hold information\nabout literal sign. Here in rnOverLit we use it to detect negative zeroes and\nin this case return not only literal itself but also negateName so that users\ncan apply it explicitly. In this case it stays negative zero.  Trac #13211\n-}\n\nrnOverLit :: HsOverLit t ->\n             RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)\nrnOverLit origLit\n  = do  { opt_NumDecimals <- xoptM LangExt.NumDecimals\n        ; let { lit@(OverLit {ol_val=val})\n            | opt_NumDecimals = origLit {ol_val = generalizeOverLitVal (ol_val origLit)}\n            | otherwise       = origLit\n          }\n        ; let std_name = hsOverLitName val\n        ; (SyntaxExpr { syn_expr = from_thing_name }, fvs1)\n            <- lookupSyntaxName std_name\n        ; let rebindable = case from_thing_name of\n                                HsVar _ lv -> (unLoc lv) /= std_name\n                                _          -> panic \"rnOverLit\"\n        ; let lit' = lit { ol_witness = from_thing_name\n                         , ol_ext = rebindable }\n        ; if isNegativeZeroOverLit lit'\n          then do { (SyntaxExpr { syn_expr = negate_name }, fvs2)\n                      <- lookupSyntaxName negateName\n                  ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name)\n                                  , fvs1 `plusFV` fvs2) }\n          else return ((lit', Nothing), fvs1) }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Errors}\n*                                                                      *\n************************************************************************\n-}\n\npatSigErr :: Outputable a => a -> SDoc\npatSigErr ty\n  =  (text \"Illegal signature in pattern:\" <+> ppr ty)\n        $$ nest 4 (text \"Use ScopedTypeVariables to permit it\")\n\nbogusCharError :: Char -> SDoc\nbogusCharError c\n  = text \"character literal out of range: '\\\\\" <> char c  <> char '\\''\n\nbadViewPat :: Pat GhcPs -> SDoc\nbadViewPat pat = vcat [text \"Illegal view pattern: \" <+> ppr pat,\n                       text \"Use ViewPatterns to enable view patterns\"]\n", "num_lines": 902}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[RnSource]{Main pass of renamer}\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule RnSource (\n        rnSrcDecls, addTcgDUs, findSplice\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} RnExpr( rnLExpr )\nimport {-# SOURCE #-} RnSplice ( rnSpliceDecl, rnTopSpliceDecls )\n\nimport HsSyn\nimport FieldLabel\nimport RdrName\nimport RnTypes\nimport RnBinds\nimport RnEnv\nimport RnUtils          ( HsDocContext(..), mapFvRn, bindLocalNames\n                        , checkDupRdrNames, inHsDocContext, bindLocalNamesFV\n                        , checkShadowedRdrNames, warnUnusedTypePatterns\n                        , extendTyVarEnvFVRn, newLocalBndrsRn\n                        , withHsDocContext )\nimport RnUnbound        ( mkUnboundName, notInScopeErr )\nimport RnNames\nimport RnHsDoc          ( rnHsDoc, rnMbLHsDoc )\nimport TcAnnotations    ( annCtxt )\nimport TcRnMonad\n\nimport ForeignCall      ( CCallTarget(..) )\nimport Module\nimport HscTypes         ( Warnings(..), plusWarns )\nimport PrelNames        ( applicativeClassName, pureAName, thenAName\n                        , monadClassName, returnMName, thenMName\n                        , monadFailClassName, failMName, failMName_preMFP\n                        , semigroupClassName, sappendName\n                        , monoidClassName, mappendName\n                        )\nimport Name\nimport NameSet\nimport NameEnv\nimport Avail\nimport Outputable\nimport Bag\nimport BasicTypes       ( pprRuleName )\nimport FastString\nimport SrcLoc\nimport DynFlags\nimport Util             ( debugIsOn, filterOut, lengthExceeds, partitionWith )\nimport HscTypes         ( HscEnv, hsc_dflags )\nimport ListSetOps       ( findDupsEq, removeDups, equivClasses )\nimport Digraph          ( SCC, flattenSCC, flattenSCCs, Node(..)\n                        , stronglyConnCompFromEdgedVerticesUniq )\nimport UniqSet\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Control.Arrow ( first )\nimport Data.List ( mapAccumL )\nimport qualified Data.List.NonEmpty as NE\nimport Data.List.NonEmpty ( NonEmpty(..) )\nimport Data.Maybe ( isNothing, fromMaybe )\nimport qualified Data.Set as Set ( difference, fromList, toList, null )\n\n{- | @rnSourceDecl@ \"renames\" declarations.\nIt simultaneously performs dependency analysis and precedence parsing.\nIt also does the following error checks:\n\n* Checks that tyvars are used properly. This includes checking\n  for undefined tyvars, and tyvars in contexts that are ambiguous.\n  (Some of this checking has now been moved to module @TcMonoType@,\n  since we don't have functional dependency information at this point.)\n\n* Checks that all variable occurrences are defined.\n\n* Checks the @(..)@ etc constraints in the export list.\n\nBrings the binders of the group into scope in the appropriate places;\ndoes NOT assume that anything is in scope already\n-}\nrnSrcDecls :: HsGroup GhcPs -> RnM (TcGblEnv, HsGroup GhcRn)\n-- Rename a top-level HsGroup; used for normal source files *and* hs-boot files\nrnSrcDecls group@(HsGroup { hs_valds   = val_decls,\n                            hs_splcds  = splice_decls,\n                            hs_tyclds  = tycl_decls,\n                            hs_derivds = deriv_decls,\n                            hs_fixds   = fix_decls,\n                            hs_warnds  = warn_decls,\n                            hs_annds   = ann_decls,\n                            hs_fords   = foreign_decls,\n                            hs_defds   = default_decls,\n                            hs_ruleds  = rule_decls,\n                            hs_docs    = docs })\n = do {\n   -- (A) Process the fixity declarations, creating a mapping from\n   --     FastStrings to FixItems.\n   --     Also checks for duplicates.\n   local_fix_env <- makeMiniFixityEnv fix_decls ;\n\n   -- (B) Bring top level binders (and their fixities) into scope,\n   --     *except* for the value bindings, which get done in step (D)\n   --     with collectHsIdBinders. However *do* include\n   --\n   --        * Class ops, data constructors, and record fields,\n   --          because they do not have value declarations.\n   --\n   --        * For hs-boot files, include the value signatures\n   --          Again, they have no value declarations\n   --\n   (tc_envs, tc_bndrs) <- getLocalNonValBinders local_fix_env group ;\n\n\n   setEnvs tc_envs $ do {\n\n   failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations\n\n   -- (D1) Bring pattern synonyms into scope.\n   --      Need to do this before (D2) because rnTopBindsLHS\n   --      looks up those pattern synonyms (Trac #9889)\n\n   extendPatSynEnv val_decls local_fix_env $ \\pat_syn_bndrs -> do {\n\n   -- (D2) Rename the left-hand sides of the value bindings.\n   --     This depends on everything from (B) being in scope.\n   --     It uses the fixity env from (A) to bind fixities for view patterns.\n   new_lhs <- rnTopBindsLHS local_fix_env val_decls ;\n\n   -- Bind the LHSes (and their fixities) in the global rdr environment\n   let { id_bndrs = collectHsIdBinders new_lhs } ;  -- Excludes pattern-synonym binders\n                                                    -- They are already in scope\n   traceRn \"rnSrcDecls\" (ppr id_bndrs) ;\n   tc_envs <- extendGlobalRdrEnvRn (map avail id_bndrs) local_fix_env ;\n   setEnvs tc_envs $ do {\n\n   --  Now everything is in scope, as the remaining renaming assumes.\n\n   -- (E) Rename type and class decls\n   --     (note that value LHSes need to be in scope for default methods)\n   --\n   -- You might think that we could build proper def/use information\n   -- for type and class declarations, but they can be involved\n   -- in mutual recursion across modules, and we only do the SCC\n   -- analysis for them in the type checker.\n   -- So we content ourselves with gathering uses only; that\n   -- means we'll only report a declaration as unused if it isn't\n   -- mentioned at all.  Ah well.\n   traceRn \"Start rnTyClDecls\" (ppr tycl_decls) ;\n   (rn_tycl_decls, src_fvs1) <- rnTyClDecls tycl_decls ;\n\n   -- (F) Rename Value declarations right-hand sides\n   traceRn \"Start rnmono\" empty ;\n   let { val_bndr_set = mkNameSet id_bndrs `unionNameSet` mkNameSet pat_syn_bndrs } ;\n   is_boot <- tcIsHsBootOrSig ;\n   (rn_val_decls, bind_dus) <- if is_boot\n    -- For an hs-boot, use tc_bndrs (which collects how we're renamed\n    -- signatures), since val_bndr_set is empty (there are no x = ...\n    -- bindings in an hs-boot.)\n    then rnTopBindsBoot tc_bndrs new_lhs\n    else rnValBindsRHS (TopSigCtxt val_bndr_set) new_lhs ;\n   traceRn \"finish rnmono\" (ppr rn_val_decls) ;\n\n   -- (G) Rename Fixity and deprecations\n\n   -- Rename fixity declarations and error if we try to\n   -- fix something from another module (duplicates were checked in (A))\n   let { all_bndrs = tc_bndrs `unionNameSet` val_bndr_set } ;\n   rn_fix_decls <- mapM (mapM (rnSrcFixityDecl (TopSigCtxt all_bndrs)))\n                        fix_decls ;\n\n   -- Rename deprec decls;\n   -- check for duplicates and ensure that deprecated things are defined locally\n   -- at the moment, we don't keep these around past renaming\n   rn_warns <- rnSrcWarnDecls all_bndrs warn_decls ;\n\n   -- (H) Rename Everything else\n\n   (rn_rule_decls,    src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $\n                                   rnList rnHsRuleDecls rule_decls ;\n                           -- Inside RULES, scoped type variables are on\n   (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ;\n   (rn_ann_decls,     src_fvs4) <- rnList rnAnnDecl       ann_decls ;\n   (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl   default_decls ;\n   (rn_deriv_decls,   src_fvs6) <- rnList rnSrcDerivDecl  deriv_decls ;\n   (rn_splice_decls,  src_fvs7) <- rnList rnSpliceDecl    splice_decls ;\n      -- Haddock docs; no free vars\n   rn_docs <- mapM (wrapLocM rnDocDecl) docs ;\n\n   last_tcg_env <- getGblEnv ;\n   -- (I) Compute the results and return\n   let {rn_group = HsGroup { hs_ext     = noExt,\n                             hs_valds   = rn_val_decls,\n                             hs_splcds  = rn_splice_decls,\n                             hs_tyclds  = rn_tycl_decls,\n                             hs_derivds = rn_deriv_decls,\n                             hs_fixds   = rn_fix_decls,\n                             hs_warnds  = [], -- warns are returned in the tcg_env\n                                             -- (see below) not in the HsGroup\n                             hs_fords  = rn_foreign_decls,\n                             hs_annds  = rn_ann_decls,\n                             hs_defds  = rn_default_decls,\n                             hs_ruleds = rn_rule_decls,\n                             hs_docs   = rn_docs } ;\n\n        tcf_bndrs = hsTyClForeignBinders rn_tycl_decls rn_foreign_decls ;\n        other_def  = (Just (mkNameSet tcf_bndrs), emptyNameSet) ;\n        other_fvs  = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,\n                              src_fvs5, src_fvs6, src_fvs7] ;\n                -- It is tiresome to gather the binders from type and class decls\n\n        src_dus = [other_def] `plusDU` bind_dus `plusDU` usesOnly other_fvs ;\n                -- Instance decls may have occurrences of things bound in bind_dus\n                -- so we must put other_fvs last\n\n        final_tcg_env = let tcg_env' = (last_tcg_env `addTcgDUs` src_dus)\n                        in -- we return the deprecs in the env, not in the HsGroup above\n                        tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };\n       } ;\n   traceRn \"finish rnSrc\" (ppr rn_group) ;\n   traceRn \"finish Dus\" (ppr src_dus ) ;\n   return (final_tcg_env, rn_group)\n                    }}}}\nrnSrcDecls (XHsGroup _) = panic \"rnSrcDecls\"\n\naddTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv\n-- This function could be defined lower down in the module hierarchy,\n-- but there doesn't seem anywhere very logical to put it.\naddTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }\n\nrnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)\nrnList f xs = mapFvRn (wrapLocFstM f) xs\n\n{-\n*********************************************************\n*                                                       *\n        HsDoc stuff\n*                                                       *\n*********************************************************\n-}\n\nrnDocDecl :: DocDecl -> RnM DocDecl\nrnDocDecl (DocCommentNext doc) = do\n  rn_doc <- rnHsDoc doc\n  return (DocCommentNext rn_doc)\nrnDocDecl (DocCommentPrev doc) = do\n  rn_doc <- rnHsDoc doc\n  return (DocCommentPrev rn_doc)\nrnDocDecl (DocCommentNamed str doc) = do\n  rn_doc <- rnHsDoc doc\n  return (DocCommentNamed str rn_doc)\nrnDocDecl (DocGroup lev doc) = do\n  rn_doc <- rnHsDoc doc\n  return (DocGroup lev rn_doc)\n\n{-\n*********************************************************\n*                                                       *\n        Source-code deprecations declarations\n*                                                       *\n*********************************************************\n\nCheck that the deprecated names are defined, are defined locally, and\nthat there are no duplicate deprecations.\n\nIt's only imported deprecations, dealt with in RnIfaces, that we\ngather them together.\n-}\n\n-- checks that the deprecations are defined locally, and that there are no duplicates\nrnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM Warnings\nrnSrcWarnDecls _ []\n  = return NoWarnings\n\nrnSrcWarnDecls bndr_set decls'\n  = do { -- check for duplicates\n       ; mapM_ (\\ dups -> let ((dL->L loc rdr) :| (lrdr':_)) = dups\n                          in addErrAt loc (dupWarnDecl lrdr' rdr))\n               warn_rdr_dups\n       ; pairs_s <- mapM (addLocM rn_deprec) decls\n       ; return (WarnSome ((concat pairs_s))) }\n where\n   decls = concatMap (wd_warnings . unLoc) decls'\n\n   sig_ctxt = TopSigCtxt bndr_set\n\n   rn_deprec (Warning _ rdr_names txt)\n       -- ensures that the names are defined locally\n     = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)\n                                rdr_names\n          ; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }\n   rn_deprec (XWarnDecl _) = panic \"rnSrcWarnDecls\"\n\n   what = text \"deprecation\"\n\n   warn_rdr_dups = findDupRdrNames\n                   $ concatMap (\\(dL->L _ (Warning _ ns _)) -> ns) decls\n\nfindDupRdrNames :: [Located RdrName] -> [NonEmpty (Located RdrName)]\nfindDupRdrNames = findDupsEq (\\ x -> \\ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))\n\n-- look for duplicates among the OccNames;\n-- we check that the names are defined above\n-- invt: the lists returned by findDupsEq always have at least two elements\n\ndupWarnDecl :: Located RdrName -> RdrName -> SDoc\n-- Located RdrName -> DeprecDecl RdrName -> SDoc\ndupWarnDecl d rdr_name\n  = vcat [text \"Multiple warning declarations for\" <+> quotes (ppr rdr_name),\n          text \"also at \" <+> ppr (getLoc d)]\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Annotation declarations}\n*                                                      *\n*********************************************************\n-}\n\nrnAnnDecl :: AnnDecl GhcPs -> RnM (AnnDecl GhcRn, FreeVars)\nrnAnnDecl ann@(HsAnnotation _ s provenance expr)\n  = addErrCtxt (annCtxt ann) $\n    do { (provenance', provenance_fvs) <- rnAnnProvenance provenance\n       ; (expr', expr_fvs) <- setStage (Splice Untyped) $\n                              rnLExpr expr\n       ; return (HsAnnotation noExt s provenance' expr',\n                 provenance_fvs `plusFV` expr_fvs) }\nrnAnnDecl (XAnnDecl _) = panic \"rnAnnDecl\"\n\nrnAnnProvenance :: AnnProvenance RdrName\n                -> RnM (AnnProvenance Name, FreeVars)\nrnAnnProvenance provenance = do\n    provenance' <- traverse lookupTopBndrRn provenance\n    return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Default declarations}\n*                                                      *\n*********************************************************\n-}\n\nrnDefaultDecl :: DefaultDecl GhcPs -> RnM (DefaultDecl GhcRn, FreeVars)\nrnDefaultDecl (DefaultDecl _ tys)\n  = do { (tys', fvs) <- rnLHsTypes doc_str tys\n       ; return (DefaultDecl noExt tys', fvs) }\n  where\n    doc_str = DefaultDeclCtx\nrnDefaultDecl (XDefaultDecl _) = panic \"rnDefaultDecl\"\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Foreign declarations}\n*                                                      *\n*********************************************************\n-}\n\nrnHsForeignDecl :: ForeignDecl GhcPs -> RnM (ForeignDecl GhcRn, FreeVars)\nrnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })\n  = do { topEnv :: HscEnv <- getTopEnv\n       ; name' <- lookupLocatedTopBndrRn name\n       ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty\n\n        -- Mark any PackageTarget style imports as coming from the current package\n       ; let unitId = thisPackage $ hsc_dflags topEnv\n             spec'      = patchForeignImport unitId spec\n\n       ; return (ForeignImport { fd_i_ext = noExt\n                               , fd_name = name', fd_sig_ty = ty'\n                               , fd_fi = spec' }, fvs) }\n\nrnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })\n  = do { name' <- lookupLocatedOccRn name\n       ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty\n       ; return (ForeignExport { fd_e_ext = noExt\n                               , fd_name = name', fd_sig_ty = ty'\n                               , fd_fe = spec }\n                , fvs `addOneFV` unLoc name') }\n        -- NB: a foreign export is an *occurrence site* for name, so\n        --     we add it to the free-variable list.  It might, for example,\n        --     be imported from another module\n\nrnHsForeignDecl (XForeignDecl _) = panic \"rnHsForeignDecl\"\n\n-- | For Windows DLLs we need to know what packages imported symbols are from\n--      to generate correct calls. Imported symbols are tagged with the current\n--      package, so if they get inlined across a package boundary we'll still\n--      know where they're from.\n--\npatchForeignImport :: UnitId -> ForeignImport -> ForeignImport\npatchForeignImport unitId (CImport cconv safety fs spec src)\n        = CImport cconv safety fs (patchCImportSpec unitId spec) src\n\npatchCImportSpec :: UnitId -> CImportSpec -> CImportSpec\npatchCImportSpec unitId spec\n = case spec of\n        CFunction callTarget    -> CFunction $ patchCCallTarget unitId callTarget\n        _                       -> spec\n\npatchCCallTarget :: UnitId -> CCallTarget -> CCallTarget\npatchCCallTarget unitId callTarget =\n  case callTarget of\n  StaticTarget src label Nothing isFun\n                              -> StaticTarget src label (Just unitId) isFun\n  _                           -> callTarget\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Instance declarations}\n*                                                      *\n*********************************************************\n-}\n\nrnSrcInstDecl :: InstDecl GhcPs -> RnM (InstDecl GhcRn, FreeVars)\nrnSrcInstDecl (TyFamInstD { tfid_inst = tfi })\n  = do { (tfi', fvs) <- rnTyFamInstDecl Nothing tfi\n       ; return (TyFamInstD { tfid_ext = noExt, tfid_inst = tfi' }, fvs) }\n\nrnSrcInstDecl (DataFamInstD { dfid_inst = dfi })\n  = do { (dfi', fvs) <- rnDataFamInstDecl Nothing dfi\n       ; return (DataFamInstD { dfid_ext = noExt, dfid_inst = dfi' }, fvs) }\n\nrnSrcInstDecl (ClsInstD { cid_inst = cid })\n  = do { traceRn \"rnSrcIstDecl {\" (ppr cid)\n       ; (cid', fvs) <- rnClsInstDecl cid\n       ; traceRn \"rnSrcIstDecl end }\" empty\n       ; return (ClsInstD { cid_d_ext = noExt, cid_inst = cid' }, fvs) }\n\nrnSrcInstDecl (XInstDecl _) = panic \"rnSrcInstDecl\"\n\n-- | Warn about non-canonical typeclass instance declarations\n--\n-- A \"non-canonical\" instance definition can occur for instances of a\n-- class which redundantly defines an operation its superclass\n-- provides as well (c.f. `return`/`pure`). In such cases, a canonical\n-- instance is one where the subclass inherits its method\n-- implementation from its superclass instance (usually the subclass\n-- has a default method implementation to that effect). Consequently,\n-- a non-canonical instance occurs when this is not the case.\n--\n-- See also descriptions of 'checkCanonicalMonadInstances' and\n-- 'checkCanonicalMonoidInstances'\ncheckCanonicalInstances :: Name -> LHsSigType GhcRn -> LHsBinds GhcRn -> RnM ()\ncheckCanonicalInstances cls poly_ty mbinds = do\n    whenWOptM Opt_WarnNonCanonicalMonadInstances\n        checkCanonicalMonadInstances\n\n    whenWOptM Opt_WarnNonCanonicalMonadFailInstances\n        checkCanonicalMonadFailInstances\n\n    whenWOptM Opt_WarnNonCanonicalMonoidInstances\n        checkCanonicalMonoidInstances\n\n  where\n    -- | Warn about unsound/non-canonical 'Applicative'/'Monad' instance\n    -- declarations. Specifically, the following conditions are verified:\n    --\n    -- In 'Monad' instances declarations:\n    --\n    --  * If 'return' is overridden it must be canonical (i.e. @return = pure@)\n    --  * If '(>>)' is overridden it must be canonical (i.e. @(>>) = (*>)@)\n    --\n    -- In 'Applicative' instance declarations:\n    --\n    --  * Warn if 'pure' is defined backwards (i.e. @pure = return@).\n    --  * Warn if '(*>)' is defined backwards (i.e. @(*>) = (>>)@).\n    --\n    checkCanonicalMonadInstances\n      | cls == applicativeClassName  = do\n          forM_ (bagToList mbinds) $ \\(dL->L loc mbind) -> setSrcSpan loc $ do\n              case mbind of\n                  FunBind { fun_id = (dL->L _ name)\n                          , fun_matches = mg }\n                      | name == pureAName, isAliasMG mg == Just returnMName\n                      -> addWarnNonCanonicalMethod1\n                            Opt_WarnNonCanonicalMonadInstances \"pure\" \"return\"\n\n                      | name == thenAName, isAliasMG mg == Just thenMName\n                      -> addWarnNonCanonicalMethod1\n                            Opt_WarnNonCanonicalMonadInstances \"(*>)\" \"(>>)\"\n\n                  _ -> return ()\n\n      | cls == monadClassName  = do\n          forM_ (bagToList mbinds) $ \\(dL->L loc mbind) -> setSrcSpan loc $ do\n              case mbind of\n                  FunBind { fun_id = (dL->L _ name)\n                          , fun_matches = mg }\n                      | name == returnMName, isAliasMG mg /= Just pureAName\n                      -> addWarnNonCanonicalMethod2\n                            Opt_WarnNonCanonicalMonadInstances \"return\" \"pure\"\n\n                      | name == thenMName, isAliasMG mg /= Just thenAName\n                      -> addWarnNonCanonicalMethod2\n                            Opt_WarnNonCanonicalMonadInstances \"(>>)\" \"(*>)\"\n\n                  _ -> return ()\n\n      | otherwise = return ()\n\n    -- | Warn about unsound/non-canonical 'Monad'/'MonadFail' instance\n    -- declarations. Specifically, the following conditions are verified:\n    --\n    -- In 'Monad' instances declarations:\n    --\n    --  * If 'fail' is overridden it must be canonical\n    --    (i.e. @fail = Control.Monad.Fail.fail@)\n    --\n    -- In 'MonadFail' instance declarations:\n    --\n    --  * Warn if 'fail' is defined backwards\n    --    (i.e. @fail = Control.Monad.fail@).\n    --\n    checkCanonicalMonadFailInstances\n      | cls == monadFailClassName  = do\n          forM_ (bagToList mbinds) $ \\(dL->L loc mbind) -> setSrcSpan loc $ do\n              case mbind of\n                  FunBind { fun_id = (dL->L _ name)\n                          , fun_matches = mg }\n                      | name == failMName, isAliasMG mg == Just failMName_preMFP\n                      -> addWarnNonCanonicalMethod1\n                            Opt_WarnNonCanonicalMonadFailInstances \"fail\"\n                            \"Control.Monad.fail\"\n\n                  _ -> return ()\n\n      | cls == monadClassName  = do\n          forM_ (bagToList mbinds) $ \\(dL->L loc mbind) -> setSrcSpan loc $ do\n              case mbind of\n                  FunBind { fun_id      = (dL->L _ name)\n                          , fun_matches = mg }\n                      | name == failMName_preMFP, isAliasMG mg /= Just failMName\n                      -> addWarnNonCanonicalMethod2\n                            Opt_WarnNonCanonicalMonadFailInstances \"fail\"\n                            \"Control.Monad.Fail.fail\"\n                  _ -> return ()\n\n      | otherwise = return ()\n\n    -- | Check whether Monoid(mappend) is defined in terms of\n    -- Semigroup((<>)) (and not the other way round). Specifically,\n    -- the following conditions are verified:\n    --\n    -- In 'Monoid' instances declarations:\n    --\n    --  * If 'mappend' is overridden it must be canonical\n    --    (i.e. @mappend = (<>)@)\n    --\n    -- In 'Semigroup' instance declarations:\n    --\n    --  * Warn if '(<>)' is defined backwards (i.e. @(<>) = mappend@).\n    --\n    checkCanonicalMonoidInstances\n      | cls == semigroupClassName  = do\n          forM_ (bagToList mbinds) $ \\(dL->L loc mbind) -> setSrcSpan loc $ do\n              case mbind of\n                  FunBind { fun_id      = (dL->L _ name)\n                          , fun_matches = mg }\n                      | name == sappendName, isAliasMG mg == Just mappendName\n                      -> addWarnNonCanonicalMethod1\n                            Opt_WarnNonCanonicalMonoidInstances \"(<>)\" \"mappend\"\n\n                  _ -> return ()\n\n      | cls == monoidClassName  = do\n          forM_ (bagToList mbinds) $ \\(dL->L loc mbind) -> setSrcSpan loc $ do\n              case mbind of\n                  FunBind { fun_id = (dL->L _ name)\n                          , fun_matches = mg }\n                      | name == mappendName, isAliasMG mg /= Just sappendName\n                      -> addWarnNonCanonicalMethod2NoDefault\n                            Opt_WarnNonCanonicalMonoidInstances \"mappend\" \"(<>)\"\n\n                  _ -> return ()\n\n      | otherwise = return ()\n\n    -- | test whether MatchGroup represents a trivial \\\"lhsName = rhsName\\\"\n    -- binding, and return @Just rhsName@ if this is the case\n    isAliasMG :: MatchGroup GhcRn (LHsExpr GhcRn) -> Maybe Name\n    isAliasMG MG {mg_alts = (dL->L _\n                             [dL->L _ (Match { m_pats = []\n                                             , m_grhss = grhss })])}\n        | GRHSs _ [dL->L _ (GRHS _ [] body)] lbinds <- grhss\n        , EmptyLocalBinds _ <- unLoc lbinds\n        , HsVar _ lrhsName  <- unLoc body  = Just (unLoc lrhsName)\n    isAliasMG _ = Nothing\n\n    -- got \"lhs = rhs\" but expected something different\n    addWarnNonCanonicalMethod1 flag lhs rhs = do\n        addWarn (Reason flag) $ vcat\n                       [ text \"Noncanonical\" <+>\n                         quotes (text (lhs ++ \" = \" ++ rhs)) <+>\n                         text \"definition detected\"\n                       , instDeclCtxt1 poly_ty\n                       , text \"Move definition from\" <+>\n                         quotes (text rhs) <+>\n                         text \"to\" <+> quotes (text lhs)\n                       ]\n\n    -- expected \"lhs = rhs\" but got something else\n    addWarnNonCanonicalMethod2 flag lhs rhs = do\n        addWarn (Reason flag) $ vcat\n                       [ text \"Noncanonical\" <+>\n                         quotes (text lhs) <+>\n                         text \"definition detected\"\n                       , instDeclCtxt1 poly_ty\n                       , text \"Either remove definition for\" <+>\n                         quotes (text lhs) <+> text \"or define as\" <+>\n                         quotes (text (lhs ++ \" = \" ++ rhs))\n                       ]\n\n    -- like above, but method has no default impl\n    addWarnNonCanonicalMethod2NoDefault flag lhs rhs = do\n        addWarn (Reason flag) $ vcat\n                       [ text \"Noncanonical\" <+>\n                         quotes (text lhs) <+>\n                         text \"definition detected\"\n                       , instDeclCtxt1 poly_ty\n                       , text \"Define as\" <+>\n                         quotes (text (lhs ++ \" = \" ++ rhs))\n                       ]\n\n    -- stolen from TcInstDcls\n    instDeclCtxt1 :: LHsSigType GhcRn -> SDoc\n    instDeclCtxt1 hs_inst_ty\n      = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty))\n\n    inst_decl_ctxt :: SDoc -> SDoc\n    inst_decl_ctxt doc = hang (text \"in the instance declaration for\")\n                         2 (quotes doc <> text \".\")\n\n\nrnClsInstDecl :: ClsInstDecl GhcPs -> RnM (ClsInstDecl GhcRn, FreeVars)\nrnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds\n                           , cid_sigs = uprags, cid_tyfam_insts = ats\n                           , cid_overlap_mode = oflag\n                           , cid_datafam_insts = adts })\n  = do { (inst_ty', inst_fvs)\n           <- rnHsSigType (GenericCtx $ text \"an instance declaration\") inst_ty\n       ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty'\n       ; cls <-\n           case hsTyGetAppHead_maybe head_ty' of\n             Just (dL->L _ cls) -> pure cls\n             Nothing -> do\n               -- The instance is malformed. We'd still like\n               -- to make *some* progress (rather than failing outright), so\n               -- we report an error and continue for as long as we can.\n               -- Importantly, this error should be thrown before we reach the\n               -- typechecker, lest we encounter different errors that are\n               -- hopelessly confusing (such as the one in Trac #16114).\n               addErrAt (getLoc (hsSigType inst_ty)) $\n                 hang (text \"Illegal class instance:\" <+> quotes (ppr inst_ty))\n                    2 (vcat [ text \"Class instances must be of the form\"\n                            , nest 2 $ text \"context => C ty_1 ... ty_n\"\n                            , text \"where\" <+> quotes (char 'C')\n                              <+> text \"is a class\"\n                            ])\n               pure $ mkUnboundName (mkTcOccFS (fsLit \"<class>\"))\n\n          -- Rename the bindings\n          -- The typechecker (not the renamer) checks that all\n          -- the bindings are for the right class\n          -- (Slightly strangely) when scoped type variables are on, the\n          -- forall-d tyvars scope over the method bindings too\n       ; (mbinds', uprags', meth_fvs) <- rnMethodBinds False cls ktv_names mbinds uprags\n\n       ; checkCanonicalInstances cls inst_ty' mbinds'\n\n       -- Rename the associated types, and type signatures\n       -- Both need to have the instance type variables in scope\n       ; traceRn \"rnSrcInstDecl\" (ppr inst_ty' $$ ppr ktv_names)\n       ; ((ats', adts'), more_fvs)\n             <- extendTyVarEnvFVRn ktv_names $\n                do { (ats',  at_fvs)  <- rnATInstDecls rnTyFamInstDecl cls ktv_names ats\n                   ; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls ktv_names adts\n                   ; return ( (ats', adts'), at_fvs `plusFV` adt_fvs) }\n\n       ; let all_fvs = meth_fvs `plusFV` more_fvs\n                                `plusFV` inst_fvs\n       ; return (ClsInstDecl { cid_ext = noExt\n                             , cid_poly_ty = inst_ty', cid_binds = mbinds'\n                             , cid_sigs = uprags', cid_tyfam_insts = ats'\n                             , cid_overlap_mode = oflag\n                             , cid_datafam_insts = adts' },\n                 all_fvs) }\n             -- We return the renamed associated data type declarations so\n             -- that they can be entered into the list of type declarations\n             -- for the binding group, but we also keep a copy in the instance.\n             -- The latter is needed for well-formedness checks in the type\n             -- checker (eg, to ensure that all ATs of the instance actually\n             -- receive a declaration).\n             -- NB: Even the copies in the instance declaration carry copies of\n             --     the instance context after renaming.  This is a bit\n             --     strange, but should not matter (and it would be more work\n             --     to remove the context).\nrnClsInstDecl (XClsInstDecl _) = panic \"rnClsInstDecl\"\n\nrnFamInstEqn :: HsDocContext\n             -> Maybe (Name, [Name]) -- Nothing => not associated\n                                     -- Just (cls,tvs) => associated,\n                                     --   and gives class and tyvars of the\n                                     --   parent instance decl\n             -> [Located RdrName]    -- Kind variables from the equation's RHS\n             -> FamInstEqn GhcPs rhs\n             -> (HsDocContext -> rhs -> RnM (rhs', FreeVars))\n             -> RnM (FamInstEqn GhcRn rhs', FreeVars)\nrnFamInstEqn doc mb_cls rhs_kvars\n    (HsIB { hsib_body = FamEqn { feqn_tycon  = tycon\n                               , feqn_bndrs  = mb_bndrs\n                               , feqn_pats   = pats\n                               , feqn_fixity = fixity\n                               , feqn_rhs    = payload }}) rn_payload\n  = do { tycon'   <- lookupFamInstName (fmap fst mb_cls) tycon\n       ; let pat_kity_vars_with_dups = extractHsTyArgRdrKiTyVarsDup pats\n             -- Use the \"...Dups\" form because it's needed\n             -- below to report unsed binder on the LHS\n\n         -- Implicitly bound variables, empty if we have an explicit 'forall' according\n         -- to the \"forall-or-nothing\" rule.\n       ; let imp_vars | isNothing mb_bndrs = nubL pat_kity_vars_with_dups\n                      | otherwise = []\n       ; imp_var_names <- mapM (newTyVarNameRn mb_cls) imp_vars\n\n       ; let bndrs = fromMaybe [] mb_bndrs\n             bnd_vars = map hsLTyVarLocName bndrs\n             payload_kvars = filterOut (`elemRdr` (bnd_vars ++ imp_vars)) rhs_kvars\n             -- Make sure to filter out the kind variables that were explicitly\n             -- bound in the type patterns.\n       ; payload_kvar_names <- mapM (newTyVarNameRn mb_cls) payload_kvars\n\n         -- all names not bound in an explict forall\n       ; let all_imp_var_names = imp_var_names ++ payload_kvar_names\n\n             -- All the free vars of the family patterns\n             -- with a sensible binding location\n       ; ((bndrs', pats', payload'), fvs)\n              <- bindLocalNamesFV all_imp_var_names $\n                 bindLHsTyVarBndrs doc (Just $ inHsDocContext doc)\n                                   Nothing bndrs $ \\bndrs' ->\n                 -- Note: If we pass mb_cls instead of Nothing here,\n                 --  bindLHsTyVarBndrs will use class variables for any names\n                 --  the user meant to bring in scope here. This is an explicit\n                 --  forall, so we want fresh names, not class variables.\n                 --  Thus: always pass Nothing\n                 do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats\n                    ; (payload', rhs_fvs) <- rn_payload doc payload\n\n                       -- Report unused binders on the LHS\n                       -- See Note [Unused type variables in family instances]\n                    ; let groups :: [NonEmpty (Located RdrName)]\n                          groups = equivClasses cmpLocated $\n                                   pat_kity_vars_with_dups\n                    ; nms_dups <- mapM (lookupOccRn . unLoc) $\n                                     [ tv | (tv :| (_:_)) <- groups ]\n                          -- Add to the used variables\n                          --  a) any variables that appear *more than once* on the LHS\n                          --     e.g.   F a Int a = Bool\n                          --  b) for associated instances, the variables\n                          --     of the instance decl.  See\n                          --     Note [Unused type variables in family instances]\n                    ; let nms_used = extendNameSetList rhs_fvs $\n                                        inst_tvs ++ nms_dups\n                          inst_tvs = case mb_cls of\n                                       Nothing            -> []\n                                       Just (_, inst_tvs) -> inst_tvs\n                          all_nms = all_imp_var_names ++ hsLTyVarNames bndrs'\n                    ; warnUnusedTypePatterns all_nms nms_used\n\n                    ; return ((bndrs', pats', payload'), rhs_fvs `plusFV` pat_fvs) }\n\n       ; let all_fvs  = fvs `addOneFV` unLoc tycon'\n            -- type instance => use, hence addOneFV\n\n       ; return (HsIB { hsib_ext = all_imp_var_names -- Note [Wildcards in family instances]\n                      , hsib_body\n                          = FamEqn { feqn_ext    = noExt\n                                   , feqn_tycon  = tycon'\n                                   , feqn_bndrs  = bndrs' <$ mb_bndrs\n                                   , feqn_pats   = pats'\n                                   , feqn_fixity = fixity\n                                   , feqn_rhs    = payload' } },\n                 all_fvs) }\nrnFamInstEqn _ _ _ (HsIB _ (XFamEqn _)) _ = panic \"rnFamInstEqn\"\nrnFamInstEqn _ _ _ (XHsImplicitBndrs _) _ = panic \"rnFamInstEqn\"\n\nrnTyFamInstDecl :: Maybe (Name, [Name]) -- Just (cls,tvs) => associated,\n                                        --   and gives class and tyvars of\n                                        --   the parent instance decl\n                -> TyFamInstDecl GhcPs\n                -> RnM (TyFamInstDecl GhcRn, FreeVars)\nrnTyFamInstDecl mb_cls (TyFamInstDecl { tfid_eqn = eqn })\n  = do { (eqn', fvs) <- rnTyFamInstEqn mb_cls NotClosedTyFam eqn\n       ; return (TyFamInstDecl { tfid_eqn = eqn' }, fvs) }\n\n-- | Tracks whether we are renaming an equation in a closed type family\n-- equation ('ClosedTyFam') or not ('NotClosedTyFam').\ndata ClosedTyFamInfo\n  = NotClosedTyFam\n  | ClosedTyFam (Located RdrName) Name\n                -- The names (RdrName and Name) of the closed type family\n\nrnTyFamInstEqn :: Maybe (Name, [Name])\n               -> ClosedTyFamInfo\n               -> TyFamInstEqn GhcPs\n               -> RnM (TyFamInstEqn GhcRn, FreeVars)\nrnTyFamInstEqn mb_cls ctf_info\n    eqn@(HsIB { hsib_body = FamEqn { feqn_tycon = tycon\n                                   , feqn_rhs   = rhs }})\n  = do { let rhs_kvs = extractHsTyRdrTyVarsKindVars rhs\n       ; (eqn'@(HsIB { hsib_body =\n                       FamEqn { feqn_tycon = dL -> L _ tycon' }}), fvs)\n           <- rnFamInstEqn (TySynCtx tycon) mb_cls rhs_kvs eqn rnTySyn\n       ; case ctf_info of\n           NotClosedTyFam -> pure ()\n           ClosedTyFam fam_rdr_name fam_name ->\n             checkTc (fam_name == tycon') $\n             withHsDocContext (TyFamilyCtx fam_rdr_name) $\n             wrongTyFamName fam_name tycon'\n       ; pure (eqn', fvs) }\nrnTyFamInstEqn _ _ (HsIB _ (XFamEqn _)) = panic \"rnTyFamInstEqn\"\nrnTyFamInstEqn _ _ (XHsImplicitBndrs _) = panic \"rnTyFamInstEqn\"\n\nrnTyFamDefltEqn :: Name\n                -> TyFamDefltEqn GhcPs\n                -> RnM (TyFamDefltEqn GhcRn, FreeVars)\nrnTyFamDefltEqn cls (FamEqn { feqn_tycon  = tycon\n                            , feqn_bndrs  = bndrs\n                            , feqn_pats   = tyvars\n                            , feqn_fixity = fixity\n                            , feqn_rhs    = rhs })\n  = do { let kvs = extractHsTyRdrTyVarsKindVars rhs\n       ; bindHsQTyVars ctx Nothing (Just cls) kvs tyvars $ \\ tyvars' _ ->\n    do { tycon'      <- lookupFamInstName (Just cls) tycon\n       ; (rhs', fvs) <- rnLHsType ctx rhs\n       ; return (FamEqn { feqn_ext    = noExt\n                        , feqn_tycon  = tycon'\n                        , feqn_bndrs  = ASSERT( isNothing bndrs )\n                                        Nothing\n                        , feqn_pats   = tyvars'\n                        , feqn_fixity = fixity\n                        , feqn_rhs    = rhs' }, fvs) } }\n  where\n    ctx = TyFamilyCtx tycon\nrnTyFamDefltEqn _ (XFamEqn _) = panic \"rnTyFamDefltEqn\"\n\nrnDataFamInstDecl :: Maybe (Name, [Name])\n                  -> DataFamInstDecl GhcPs\n                  -> RnM (DataFamInstDecl GhcRn, FreeVars)\nrnDataFamInstDecl mb_cls (DataFamInstDecl { dfid_eqn = eqn@(HsIB { hsib_body =\n                           FamEqn { feqn_tycon = tycon\n                                  , feqn_rhs   = rhs }})})\n  = do { let rhs_kvs = extractDataDefnKindVars rhs\n       ; (eqn', fvs) <-\n           rnFamInstEqn (TyDataCtx tycon) mb_cls rhs_kvs eqn rnDataDefn\n       ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) }\nrnDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn _)))\n  = panic \"rnDataFamInstDecl\"\nrnDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs _))\n  = panic \"rnDataFamInstDecl\"\n\n-- Renaming of the associated types in instances.\n\n-- Rename associated type family decl in class\nrnATDecls :: Name      -- Class\n          -> [LFamilyDecl GhcPs]\n          -> RnM ([LFamilyDecl GhcRn], FreeVars)\nrnATDecls cls at_decls\n  = rnList (rnFamDecl (Just cls)) at_decls\n\nrnATInstDecls :: (Maybe (Name, [Name]) -> -- The function that renames\n                  decl GhcPs ->            -- an instance. rnTyFamInstDecl\n                  RnM (decl GhcRn, FreeVars)) -- or rnDataFamInstDecl\n              -> Name      -- Class\n              -> [Name]\n              -> [Located (decl GhcPs)]\n              -> RnM ([Located (decl GhcRn)], FreeVars)\n-- Used for data and type family defaults in a class decl\n-- and the family instance declarations in an instance\n--\n-- NB: We allow duplicate associated-type decls;\n--     See Note [Associated type instances] in TcInstDcls\nrnATInstDecls rnFun cls tv_ns at_insts\n  = rnList (rnFun (Just (cls, tv_ns))) at_insts\n    -- See Note [Renaming associated types]\n\n{- Note [Wildcards in family instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWild cards can be used in type/data family instance declarations to indicate\nthat the name of a type variable doesn't matter. Each wild card will be\nreplaced with a new unique type variable. For instance:\n\n    type family F a b :: *\n    type instance F Int _ = Int\n\nis the same as\n\n    type family F a b :: *\n    type instance F Int b = Int\n\nThis is implemented as follows: Unnamed wildcards remain unchanged after\nthe renamer, and then given fresh meta-variables during typechecking, and\nit is handled pretty much the same way as the ones in partial type signatures.\nWe however don't want to emit hole constraints on wildcards in family\ninstances, so we turn on PartialTypeSignatures and turn off warning flag to\nlet typechecker know this.\nSee related Note [Wildcards in visible kind application] in TcHsType.hs\n\nNote [Unused type variables in family instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the flag -fwarn-unused-type-patterns is on, the compiler reports\nwarnings about unused type variables in type-family instances. A\ntpye variable is considered used (i.e. cannot be turned into a wildcard)\nwhen\n\n * it occurs on the RHS of the family instance\n   e.g.   type instance F a b = a    -- a is used on the RHS\n\n * it occurs multiple times in the patterns on the LHS\n   e.g.   type instance F a a = Int  -- a appears more than once on LHS\n\n * it is one of the instance-decl variables, for associated types\n   e.g.   instance C (a,b) where\n            type T (a,b) = a\n   Here the type pattern in the type instance must be the same as that\n   for the class instance, so\n            type T (a,_) = a\n   would be rejected.  So we should not complain about an unused variable b\n\nAs usual, the warnings are not reported for type variables with names\nbeginning with an underscore.\n\nExtra-constraints wild cards are not supported in type/data family\ninstance declarations.\n\nRelevant tickets: #3699, #10586, #10982 and #11451.\n\nNote [Renaming associated types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCheck that the RHS of the decl mentions only type variables that are explicitly\nbound on the LHS.  For example, this is not ok\n   class C a b where\n      type F a x :: *\n   instance C (p,q) r where\n      type F (p,q) x = (x, r)   -- BAD: mentions 'r'\nc.f. Trac #5515\n\nKind variables, on the other hand, are allowed to be implicitly or explicitly\nbound. As examples, this (#9574) is acceptable:\n   class Funct f where\n      type Codomain f :: *\n   instance Funct ('KProxy :: KProxy o) where\n      -- o is implicitly bound by the kind signature\n      -- of the LHS type pattern ('KProxy)\n      type Codomain 'KProxy = NatTr (Proxy :: o -> *)\nAnd this (#14131) is also acceptable:\n    data family Nat :: k -> k -> *\n    -- k is implicitly bound by an invisible kind pattern\n    newtype instance Nat :: (k -> *) -> (k -> *) -> * where\n      Nat :: (forall xx. f xx -> g xx) -> Nat f g\nWe could choose to disallow this, but then associated type families would not\nbe able to be as expressive as top-level type synonyms. For example, this type\nsynonym definition is allowed:\n    type T = (Nothing :: Maybe a)\nSo for parity with type synonyms, we also allow:\n    type family   T :: Maybe a\n    type instance T = (Nothing :: Maybe a)\n\nAll this applies only for *instance* declarations.  In *class*\ndeclarations there is no RHS to worry about, and the class variables\ncan all be in scope (Trac #5862):\n    class Category (x :: k -> k -> *) where\n      type Ob x :: k -> Constraint\n      id :: Ob x a => x a a\n      (.) :: (Ob x a, Ob x b, Ob x c) => x b c -> x a b -> x a c\nHere 'k' is in scope in the kind signature, just like 'x'.\n\nAlthough type family equations can bind type variables with explicit foralls,\nit need not be the case that all variables that appear on the RHS must be bound\nby a forall. For instance, the following is acceptable:\n\n   class C a where\n     type T a b\n   instance C (Maybe a) where\n     type forall b. T (Maybe a) b = Either a b\n\nEven though `a` is not bound by the forall, this is still accepted because `a`\nwas previously bound by the `instance C (Maybe a)` part. (see Trac #16116).\n\nIn each case, the function which detects improperly bound variables on the RHS\nis TcValidity.checkValidFamPats.\n-}\n\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Stand-alone deriving declarations}\n*                                                      *\n*********************************************************\n-}\n\nrnSrcDerivDecl :: DerivDecl GhcPs -> RnM (DerivDecl GhcRn, FreeVars)\nrnSrcDerivDecl (DerivDecl _ ty mds overlap)\n  = do { standalone_deriv_ok <- xoptM LangExt.StandaloneDeriving\n       ; unless standalone_deriv_ok (addErr standaloneDerivErr)\n       ; (mds', ty', fvs)\n           <- rnLDerivStrategy DerivDeclCtx mds $ \\strat_tvs ppr_via_ty ->\n              rnAndReportFloatingViaTvs strat_tvs loc ppr_via_ty \"instance\" $\n              rnHsSigWcType BindUnlessForall DerivDeclCtx ty\n       ; warnNoDerivStrat mds' loc\n       ; return (DerivDecl noExt ty' mds' overlap, fvs) }\n  where\n    loc = getLoc $ hsib_body $ hswc_body ty\nrnSrcDerivDecl (XDerivDecl _) = panic \"rnSrcDerivDecl\"\n\nstandaloneDerivErr :: SDoc\nstandaloneDerivErr\n  = hang (text \"Illegal standalone deriving declaration\")\n       2 (text \"Use StandaloneDeriving to enable this extension\")\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Rules}\n*                                                      *\n*********************************************************\n-}\n\nrnHsRuleDecls :: RuleDecls GhcPs -> RnM (RuleDecls GhcRn, FreeVars)\nrnHsRuleDecls (HsRules { rds_src = src\n                       , rds_rules = rules })\n  = do { (rn_rules,fvs) <- rnList rnHsRuleDecl rules\n       ; return (HsRules { rds_ext = noExt\n                         , rds_src = src\n                         , rds_rules = rn_rules }, fvs) }\nrnHsRuleDecls (XRuleDecls _) = panic \"rnHsRuleDecls\"\n\nrnHsRuleDecl :: RuleDecl GhcPs -> RnM (RuleDecl GhcRn, FreeVars)\nrnHsRuleDecl (HsRule { rd_name = rule_name\n                     , rd_act  = act\n                     , rd_tyvs = tyvs\n                     , rd_tmvs = tmvs\n                     , rd_lhs  = lhs\n                     , rd_rhs  = rhs })\n  = do { let rdr_names_w_loc = map (get_var . unLoc) tmvs\n       ; checkDupRdrNames rdr_names_w_loc\n       ; checkShadowedRdrNames rdr_names_w_loc\n       ; names <- newLocalBndrsRn rdr_names_w_loc\n       ; let doc = RuleCtx (snd $ unLoc rule_name)\n       ; bindRuleTyVars doc in_rule tyvs $ \\ tyvs' ->\n         bindRuleTmVars doc tyvs' tmvs names $ \\ tmvs' ->\n    do { (lhs', fv_lhs') <- rnLExpr lhs\n       ; (rhs', fv_rhs') <- rnLExpr rhs\n       ; checkValidRule (snd $ unLoc rule_name) names lhs' fv_lhs'\n       ; return (HsRule { rd_ext  = HsRuleRn fv_lhs' fv_rhs'\n                        , rd_name = rule_name\n                        , rd_act  = act\n                        , rd_tyvs = tyvs'\n                        , rd_tmvs = tmvs'\n                        , rd_lhs  = lhs'\n                        , rd_rhs  = rhs' }, fv_lhs' `plusFV` fv_rhs') } }\n  where\n    get_var (RuleBndrSig _ v _) = v\n    get_var (RuleBndr _ v)      = v\n    get_var (XRuleBndr _)       = panic \"rnHsRuleDecl\"\n    in_rule = text \"in the rule\" <+> pprFullRuleName rule_name\nrnHsRuleDecl (XRuleDecl _) = panic \"rnHsRuleDecl\"\n\nbindRuleTmVars :: HsDocContext -> Maybe ty_bndrs\n               -> [LRuleBndr GhcPs] -> [Name]\n               -> ([LRuleBndr GhcRn] -> RnM (a, FreeVars))\n               -> RnM (a, FreeVars)\nbindRuleTmVars doc tyvs vars names thing_inside\n  = go vars names $ \\ vars' ->\n    bindLocalNamesFV names (thing_inside vars')\n  where\n    go ((dL->L l (RuleBndr _ (dL->L loc _))) : vars) (n : ns) thing_inside\n      = go vars ns $ \\ vars' ->\n        thing_inside (cL l (RuleBndr noExt (cL loc n)) : vars')\n\n    go ((dL->L l (RuleBndrSig _ (dL->L loc _) bsig)) : vars)\n       (n : ns) thing_inside\n      = rnHsSigWcTypeScoped bind_free_tvs doc bsig $ \\ bsig' ->\n        go vars ns $ \\ vars' ->\n        thing_inside (cL l (RuleBndrSig noExt (cL loc n) bsig') : vars')\n\n    go [] [] thing_inside = thing_inside []\n    go vars names _ = pprPanic \"bindRuleVars\" (ppr vars $$ ppr names)\n\n    bind_free_tvs = case tyvs of Nothing -> AlwaysBind\n                                 Just _  -> NeverBind\n\nbindRuleTyVars :: HsDocContext -> SDoc -> Maybe [LHsTyVarBndr GhcPs]\n               -> (Maybe [LHsTyVarBndr GhcRn]  -> RnM (b, FreeVars))\n               -> RnM (b, FreeVars)\nbindRuleTyVars doc in_doc (Just bndrs) thing_inside\n  = bindLHsTyVarBndrs doc (Just in_doc) Nothing bndrs (thing_inside . Just)\nbindRuleTyVars _ _ _ thing_inside = thing_inside Nothing\n\n{-\nNote [Rule LHS validity checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCheck the shape of a transformation rule LHS.  Currently we only allow\nLHSs of the form @(f e1 .. en)@, where @f@ is not one of the\n@forall@'d variables.\n\nWe used restrict the form of the 'ei' to prevent you writing rules\nwith LHSs with a complicated desugaring (and hence unlikely to match);\n(e.g. a case expression is not allowed: too elaborate.)\n\nBut there are legitimate non-trivial args ei, like sections and\nlambdas.  So it seems simmpler not to check at all, and that is why\ncheck_e is commented out.\n-}\n\ncheckValidRule :: FastString -> [Name] -> LHsExpr GhcRn -> NameSet -> RnM ()\ncheckValidRule rule_name ids lhs' fv_lhs'\n  = do  {       -- Check for the form of the LHS\n          case (validRuleLhs ids lhs') of\n                Nothing  -> return ()\n                Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)\n\n                -- Check that LHS vars are all bound\n        ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]\n        ; mapM_ (addErr . badRuleVar rule_name) bad_vars }\n\nvalidRuleLhs :: [Name] -> LHsExpr GhcRn -> Maybe (HsExpr GhcRn)\n-- Nothing => OK\n-- Just e  => Not ok, and e is the offending sub-expression\nvalidRuleLhs foralls lhs\n  = checkl lhs\n  where\n    checkl = check . unLoc\n\n    check (OpApp _ e1 op e2)              = checkl op `mplus` checkl_e e1\n                                                      `mplus` checkl_e e2\n    check (HsApp _ e1 e2)                 = checkl e1 `mplus` checkl_e e2\n    check (HsAppType _ e _)               = checkl e\n    check (HsVar _ lv)\n      | (unLoc lv) `notElem` foralls      = Nothing\n    check other                           = Just other  -- Failure\n\n        -- Check an argument\n    checkl_e _ = Nothing\n    -- Was (check_e e); see Note [Rule LHS validity checking]\n\n{-      Commented out; see Note [Rule LHS validity checking] above\n    check_e (HsVar v)     = Nothing\n    check_e (HsPar e)     = checkl_e e\n    check_e (HsLit e)     = Nothing\n    check_e (HsOverLit e) = Nothing\n\n    check_e (OpApp e1 op _ e2)   = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2\n    check_e (HsApp e1 e2)        = checkl_e e1 `mplus` checkl_e e2\n    check_e (NegApp e _)         = checkl_e e\n    check_e (ExplicitList _ es)  = checkl_es es\n    check_e other                = Just other   -- Fails\n\n    checkl_es es = foldr (mplus . checkl_e) Nothing es\n-}\n\nbadRuleVar :: FastString -> Name -> SDoc\nbadRuleVar name var\n  = sep [text \"Rule\" <+> doubleQuotes (ftext name) <> colon,\n         text \"Forall'd variable\" <+> quotes (ppr var) <+>\n                text \"does not appear on left hand side\"]\n\nbadRuleLhsErr :: FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> SDoc\nbadRuleLhsErr name lhs bad_e\n  = sep [text \"Rule\" <+> pprRuleName name <> colon,\n         nest 2 (vcat [err,\n                       text \"in left-hand side:\" <+> ppr lhs])]\n    $$\n    text \"LHS must be of form (f e1 .. en) where f is not forall'd\"\n  where\n    err = case bad_e of\n            HsUnboundVar _ uv -> notInScopeErr (mkRdrUnqual (unboundVarOcc uv))\n            _                 -> text \"Illegal expression:\" <+> ppr bad_e\n\n{- **************************************************************\n         *                                                      *\n      Renaming type, class, instance and role declarations\n*                                                               *\n*****************************************************************\n\n@rnTyDecl@ uses the `global name function' to create a new type\ndeclaration in which local names have been replaced by their original\nnames, reporting any unknown names.\n\nRenaming type variables is a pain. Because they now contain uniques,\nit is necessary to pass in an association list which maps a parsed\ntyvar to its @Name@ representation.\nIn some cases (type signatures of values),\nit is even necessary to go over the type first\nin order to get the set of tyvars used by it, make an assoc list,\nand then go over it again to rename the tyvars!\nHowever, we can also do some scoping checks at the same time.\n\nNote [Dependency analysis of type, class, and instance decls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA TyClGroup represents a strongly connected components of\ntype/class/instance decls, together with the role annotations for the\ntype/class declarations.  The renamer uses strongly connected\ncomoponent analysis to build these groups.  We do this for a number of\nreasons:\n\n* Improve kind error messages. Consider\n\n     data T f a = MkT f a\n     data S f a = MkS f (T f a)\n\n  This has a kind error, but the error message is better if you\n  check T first, (fixing its kind) and *then* S.  If you do kind\n  inference together, you might get an error reported in S, which\n  is jolly confusing.  See Trac #4875\n\n\n* Increase kind polymorphism.  See TcTyClsDecls\n  Note [Grouping of type and class declarations]\n\nWhy do the instance declarations participate?  At least two reasons\n\n* Consider (Trac #11348)\n\n     type family F a\n     type instance F Int = Bool\n\n     data R = MkR (F Int)\n\n     type Foo = 'MkR 'True\n\n  For Foo to kind-check we need to know that (F Int) ~ Bool.  But we won't\n  know that unless we've looked at the type instance declaration for F\n  before kind-checking Foo.\n\n* Another example is this (Trac #3990).\n\n     data family Complex a\n     data instance Complex Double = CD {-# UNPACK #-} !Double\n                                       {-# UNPACK #-} !Double\n\n     data T = T {-# UNPACK #-} !(Complex Double)\n\n  Here, to generate the right kind of unpacked implementation for T,\n  we must have access to the 'data instance' declaration.\n\n* Things become more complicated when we introduce transitive\n  dependencies through imported definitions, like in this scenario:\n\n      A.hs\n        type family Closed (t :: Type) :: Type where\n          Closed t = Open t\n\n        type family Open (t :: Type) :: Type\n\n      B.hs\n        data Q where\n          Q :: Closed Bool -> Q\n\n        type instance Open Int = Bool\n\n        type S = 'Q 'True\n\n  Somehow, we must ensure that the instance Open Int = Bool is checked before\n  the type synonym S. While we know that S depends upon 'Q depends upon Closed,\n  we have no idea that Closed depends upon Open!\n\n  To accomodate for these situations, we ensure that an instance is checked\n  before every @TyClDecl@ on which it does not depend. That's to say, instances\n  are checked as early as possible in @tcTyAndClassDecls@.\n\n------------------------------------\nSo much for WHY.  What about HOW?  It's pretty easy:\n\n(1) Rename the type/class, instance, and role declarations\n    individually\n\n(2) Do strongly-connected component analysis of the type/class decls,\n    We'll make a TyClGroup for each SCC\n\n    In this step we treat a reference to a (promoted) data constructor\n    K as a dependency on its parent type.  Thus\n        data T = K1 | K2\n        data S = MkS (Proxy 'K1)\n    Here S depends on 'K1 and hence on its parent T.\n\n    In this step we ignore instances; see\n    Note [No dependencies on data instances]\n\n(3) Attach roles to the appropriate SCC\n\n(4) Attach instances to the appropriate SCC.\n    We add an instance decl to SCC when:\n      all its free types/classes are bound in this SCC or earlier ones\n\n(5) We make an initial TyClGroup, with empty group_tyclds, for any\n    (orphan) instances that affect only imported types/classes\n\nSteps (3) and (4) are done by the (mapAccumL mk_group) call.\n\nNote [No dependencies on data instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n   data family D a\n   data instance D Int = D1\n   data S = MkS (Proxy 'D1)\n\nHere the declaration of S depends on the /data instance/ declaration\nfor 'D Int'.  That makes things a lot more complicated, especially\nif the data instance is an associated type of an enclosing class instance.\n(And the class instance might have several associated type instances\nwith different dependency structure!)\n\nUgh.  For now we simply don't allow promotion of data constructors for\ndata instances.  See Note [AFamDataCon: not promoting data family\nconstructors] in TcEnv\n-}\n\n\nrnTyClDecls :: [TyClGroup GhcPs]\n            -> RnM ([TyClGroup GhcRn], FreeVars)\n-- Rename the declarations and do dependency analysis on them\nrnTyClDecls tycl_ds\n  = do { -- Rename the type/class, instance, and role declaraations\n         tycls_w_fvs <- mapM (wrapLocFstM rnTyClDecl)\n                             (tyClGroupTyClDecls tycl_ds)\n       ; let tc_names = mkNameSet (map (tcdName . unLoc . fst) tycls_w_fvs)\n\n       ; instds_w_fvs <- mapM (wrapLocFstM rnSrcInstDecl) (tyClGroupInstDecls tycl_ds)\n       ; role_annots  <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds)\n\n       -- Do SCC analysis on the type/class decls\n       ; rdr_env <- getGlobalRdrEnv\n       ; let tycl_sccs = depAnalTyClDecls rdr_env tycls_w_fvs\n             role_annot_env = mkRoleAnnotEnv role_annots\n\n             inst_ds_map = mkInstDeclFreeVarsMap rdr_env tc_names instds_w_fvs\n             (init_inst_ds, rest_inst_ds) = getInsts [] inst_ds_map\n\n             first_group\n               | null init_inst_ds = []\n               | otherwise = [TyClGroup { group_ext    = noExt\n                                        , group_tyclds = []\n                                        , group_roles  = []\n                                        , group_instds = init_inst_ds }]\n\n             ((final_inst_ds, orphan_roles), groups)\n                = mapAccumL mk_group (rest_inst_ds, role_annot_env) tycl_sccs\n\n\n             all_fvs = plusFV (foldr (plusFV . snd) emptyFVs tycls_w_fvs)\n                              (foldr (plusFV . snd) emptyFVs instds_w_fvs)\n\n             all_groups = first_group ++ groups\n\n       ; ASSERT2( null final_inst_ds,  ppr instds_w_fvs $$ ppr inst_ds_map\n                                       $$ ppr (flattenSCCs tycl_sccs) $$ ppr final_inst_ds  )\n         mapM_ orphanRoleAnnotErr (nameEnvElts orphan_roles)\n\n       ; traceRn \"rnTycl dependency analysis made groups\" (ppr all_groups)\n       ; return (all_groups, all_fvs) }\n  where\n    mk_group :: (InstDeclFreeVarsMap, RoleAnnotEnv)\n             -> SCC (LTyClDecl GhcRn)\n             -> ( (InstDeclFreeVarsMap, RoleAnnotEnv)\n                , TyClGroup GhcRn )\n    mk_group (inst_map, role_env) scc\n      = ((inst_map', role_env'), group)\n      where\n        tycl_ds              = flattenSCC scc\n        bndrs                = map (tcdName . unLoc) tycl_ds\n        (inst_ds, inst_map') = getInsts      bndrs inst_map\n        (roles,   role_env') = getRoleAnnots bndrs role_env\n        group = TyClGroup { group_ext    = noExt\n                          , group_tyclds = tycl_ds\n                          , group_roles  = roles\n                          , group_instds = inst_ds }\n\n\ndepAnalTyClDecls :: GlobalRdrEnv\n                 -> [(LTyClDecl GhcRn, FreeVars)]\n                 -> [SCC (LTyClDecl GhcRn)]\n-- See Note [Dependency analysis of type, class, and instance decls]\ndepAnalTyClDecls rdr_env ds_w_fvs\n  = stronglyConnCompFromEdgedVerticesUniq edges\n  where\n    edges :: [ Node Name (LTyClDecl GhcRn) ]\n    edges = [ DigraphNode d (tcdName (unLoc d)) (map (getParent rdr_env) (nonDetEltsUniqSet fvs))\n            | (d, fvs) <- ds_w_fvs ]\n            -- It's OK to use nonDetEltsUFM here as\n            -- stronglyConnCompFromEdgedVertices is still deterministic\n            -- even if the edges are in nondeterministic order as explained\n            -- in Note [Deterministic SCC] in Digraph.\n\ntoParents :: GlobalRdrEnv -> NameSet -> NameSet\ntoParents rdr_env ns\n  = nonDetFoldUniqSet add emptyNameSet ns\n  -- It's OK to use nonDetFoldUFM because we immediately forget the\n  -- ordering by creating a set\n  where\n    add n s = extendNameSet s (getParent rdr_env n)\n\ngetParent :: GlobalRdrEnv -> Name -> Name\ngetParent rdr_env n\n  = case lookupGRE_Name rdr_env n of\n      Just gre -> case gre_par gre of\n                    ParentIs  { par_is = p } -> p\n                    FldParent { par_is = p } -> p\n                    _                        -> n\n      Nothing -> n\n\n\n{- ******************************************************\n*                                                       *\n       Role annotations\n*                                                       *\n****************************************************** -}\n\n-- | Renames role annotations, returning them as the values in a NameEnv\n-- and checks for duplicate role annotations.\n-- It is quite convenient to do both of these in the same place.\n-- See also Note [Role annotations in the renamer]\nrnRoleAnnots :: NameSet\n             -> [LRoleAnnotDecl GhcPs]\n             -> RnM [LRoleAnnotDecl GhcRn]\nrnRoleAnnots tc_names role_annots\n  = do {  -- Check for duplicates *before* renaming, to avoid\n          -- lumping together all the unboundNames\n         let (no_dups, dup_annots) = removeDups role_annots_cmp role_annots\n             role_annots_cmp (dL->L _ annot1) (dL->L _ annot2)\n               = roleAnnotDeclName annot1 `compare` roleAnnotDeclName annot2\n       ; mapM_ dupRoleAnnotErr dup_annots\n       ; mapM (wrapLocM rn_role_annot1) no_dups }\n  where\n    rn_role_annot1 (RoleAnnotDecl _ tycon roles)\n      = do {  -- the name is an *occurrence*, but look it up only in the\n              -- decls defined in this group (see #10263)\n             tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt tc_names)\n                                          (text \"role annotation\")\n                                          tycon\n           ; return $ RoleAnnotDecl noExt tycon' roles }\n    rn_role_annot1 (XRoleAnnotDecl _) = panic \"rnRoleAnnots\"\n\ndupRoleAnnotErr :: NonEmpty (LRoleAnnotDecl GhcPs) -> RnM ()\ndupRoleAnnotErr list\n  = addErrAt loc $\n    hang (text \"Duplicate role annotations for\" <+>\n          quotes (ppr $ roleAnnotDeclName first_decl) <> colon)\n       2 (vcat $ map pp_role_annot $ NE.toList sorted_list)\n    where\n      sorted_list = NE.sortBy cmp_annot list\n      ((dL->L loc first_decl) :| _) = sorted_list\n\n      pp_role_annot (dL->L loc decl) = hang (ppr decl)\n                                      4 (text \"-- written at\" <+> ppr loc)\n\n      cmp_annot (dL->L loc1 _) (dL->L loc2 _) = loc1 `compare` loc2\n\norphanRoleAnnotErr :: LRoleAnnotDecl GhcRn -> RnM ()\norphanRoleAnnotErr (dL->L loc decl)\n  = addErrAt loc $\n    hang (text \"Role annotation for a type previously declared:\")\n       2 (ppr decl) $$\n    parens (text \"The role annotation must be given where\" <+>\n            quotes (ppr $ roleAnnotDeclName decl) <+>\n            text \"is declared.\")\n\n\n{- Note [Role annotations in the renamer]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must ensure that a type's role annotation is put in the same group as the\nproper type declaration. This is because role annotations are needed during\ntype-checking when creating the type's TyCon. So, rnRoleAnnots builds a\nNameEnv (LRoleAnnotDecl Name) that maps a name to a role annotation for that\ntype, if any. Then, this map can be used to add the role annotations to the\ngroups after dependency analysis.\n\nThis process checks for duplicate role annotations, where we must be careful\nto do the check *before* renaming to avoid calling all unbound names duplicates\nof one another.\n\nThe renaming process, as usual, might identify and report errors for unbound\nnames. We exclude the annotations for unbound names in the annotation\nenvironment to avoid spurious errors for orphaned annotations.\n\nWe then (in rnTyClDecls) do a check for orphan role annotations (role\nannotations without an accompanying type decl). The check works by folding\nover components (of type [[Either (TyClDecl Name) (InstDecl Name)]]), selecting\nout the relevant role declarations for each group, as well as diminishing the\nannotation environment. After the fold is complete, anything left over in the\nname environment must be an orphan, and errors are generated.\n\nAn earlier version of this algorithm short-cut the orphan check by renaming\nonly with names declared in this module. But, this check is insufficient in\nthe case of staged module compilation (Template Haskell, GHCi).\nSee #8485. With the new lookup process (which includes types declared in other\nmodules), we get better error messages, too.\n-}\n\n\n{- ******************************************************\n*                                                       *\n       Dependency info for instances\n*                                                       *\n****************************************************** -}\n\n----------------------------------------------------------\n-- | 'InstDeclFreeVarsMap is an association of an\n--   @InstDecl@ with @FreeVars@. The @FreeVars@ are\n--   the tycon names that are both\n--     a) free in the instance declaration\n--     b) bound by this group of type/class/instance decls\ntype InstDeclFreeVarsMap = [(LInstDecl GhcRn, FreeVars)]\n\n-- | Construct an @InstDeclFreeVarsMap@ by eliminating any @Name@s from the\n--   @FreeVars@ which are *not* the binders of a @TyClDecl@.\nmkInstDeclFreeVarsMap :: GlobalRdrEnv\n                      -> NameSet\n                      -> [(LInstDecl GhcRn, FreeVars)]\n                      -> InstDeclFreeVarsMap\nmkInstDeclFreeVarsMap rdr_env tycl_bndrs inst_ds_fvs\n  = [ (inst_decl, toParents rdr_env fvs `intersectFVs` tycl_bndrs)\n    | (inst_decl, fvs) <- inst_ds_fvs ]\n\n-- | Get the @LInstDecl@s which have empty @FreeVars@ sets, and the\n--   @InstDeclFreeVarsMap@ with these entries removed.\n-- We call (getInsts tcs instd_map) when we've completed the declarations\n-- for 'tcs'.  The call returns (inst_decls, instd_map'), where\n--   inst_decls are the instance declarations all of\n--              whose free vars are now defined\n--   instd_map' is the inst-decl map with 'tcs' removed from\n--               the free-var set\ngetInsts :: [Name] -> InstDeclFreeVarsMap\n         -> ([LInstDecl GhcRn], InstDeclFreeVarsMap)\ngetInsts bndrs inst_decl_map\n  = partitionWith pick_me inst_decl_map\n  where\n    pick_me :: (LInstDecl GhcRn, FreeVars)\n            -> Either (LInstDecl GhcRn) (LInstDecl GhcRn, FreeVars)\n    pick_me (decl, fvs)\n      | isEmptyNameSet depleted_fvs = Left decl\n      | otherwise                   = Right (decl, depleted_fvs)\n      where\n        depleted_fvs = delFVs bndrs fvs\n\n{- ******************************************************\n*                                                       *\n         Renaming a type or class declaration\n*                                                       *\n****************************************************** -}\n\nrnTyClDecl :: TyClDecl GhcPs\n           -> RnM (TyClDecl GhcRn, FreeVars)\n\n-- All flavours of type family declarations (\"type family\", \"newtype family\",\n-- and \"data family\"), both top level and (for an associated type)\n-- in a class decl\nrnTyClDecl (FamDecl { tcdFam = decl })\n  = do { (decl', fvs) <- rnFamDecl Nothing decl\n       ; return (FamDecl noExt decl', fvs) }\n\nrnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,\n                      tcdFixity = fixity, tcdRhs = rhs })\n  = do { tycon' <- lookupLocatedTopBndrRn tycon\n       ; let kvs = extractHsTyRdrTyVarsKindVars rhs\n             doc = TySynCtx tycon\n       ; traceRn \"rntycl-ty\" (ppr tycon <+> ppr kvs)\n       ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \\ tyvars' _ ->\n    do { (rhs', fvs) <- rnTySyn doc rhs\n       ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars'\n                         , tcdFixity = fixity\n                         , tcdRhs = rhs', tcdSExt = fvs }, fvs) } }\n\n-- \"data\", \"newtype\" declarations\n-- both top level and (for an associated type) in an instance decl\nrnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars,\n                       tcdFixity = fixity, tcdDataDefn = defn })\n  = do { tycon' <- lookupLocatedTopBndrRn tycon\n       ; let kvs = extractDataDefnKindVars defn\n             doc = TyDataCtx tycon\n       ; traceRn \"rntycl-data\" (ppr tycon <+> ppr kvs)\n       ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \\ tyvars' no_rhs_kvs ->\n    do { (defn', fvs) <- rnDataDefn doc defn\n          -- See Note [Complete user-supplied kind signatures] in HsDecls\n       ; let cusk = hsTvbAllKinded tyvars' && no_rhs_kvs\n             rn_info = DataDeclRn { tcdDataCusk = cusk\n                                  , tcdFVs      = fvs }\n       ; traceRn \"rndata\" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs)\n       ; return (DataDecl { tcdLName    = tycon'\n                          , tcdTyVars   = tyvars'\n                          , tcdFixity   = fixity\n                          , tcdDataDefn = defn'\n                          , tcdDExt     = rn_info }, fvs) } }\n\nrnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,\n                        tcdTyVars = tyvars, tcdFixity = fixity,\n                        tcdFDs = fds, tcdSigs = sigs,\n                        tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs,\n                        tcdDocs = docs})\n  = do  { lcls' <- lookupLocatedTopBndrRn lcls\n        ; let cls' = unLoc lcls'\n              kvs = []  -- No scoped kind vars except those in\n                        -- kind signatures on the tyvars\n\n        -- Tyvars scope over superclass context and method signatures\n        ; ((tyvars', context', fds', ats'), stuff_fvs)\n            <- bindHsQTyVars cls_doc Nothing Nothing kvs tyvars $ \\ tyvars' _ -> do\n                  -- Checks for distinct tyvars\n             { (context', cxt_fvs) <- rnContext cls_doc context\n             ; fds'  <- rnFds fds\n                         -- The fundeps have no free variables\n             ; (ats', fv_ats) <- rnATDecls cls' ats\n             ; let fvs = cxt_fvs     `plusFV`\n                         fv_ats\n             ; return ((tyvars', context', fds', ats'), fvs) }\n\n        ; (at_defs', fv_at_defs) <- rnList (rnTyFamDefltEqn cls') at_defs\n\n        -- No need to check for duplicate associated type decls\n        -- since that is done by RnNames.extendGlobalRdrEnvRn\n\n        -- Check the signatures\n        -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).\n        ; let sig_rdr_names_w_locs =\n                [op | (dL->L _ (ClassOpSig _ False ops _)) <- sigs\n                    , op <- ops]\n        ; checkDupRdrNames sig_rdr_names_w_locs\n                -- Typechecker is responsible for checking that we only\n                -- give default-method bindings for things in this class.\n                -- The renamer *could* check this for class decls, but can't\n                -- for instance decls.\n\n        -- The newLocals call is tiresome: given a generic class decl\n        --      class C a where\n        --        op :: a -> a\n        --        op {| x+y |} (Inl a) = ...\n        --        op {| x+y |} (Inr b) = ...\n        --        op {| a*b |} (a*b)   = ...\n        -- we want to name both \"x\" tyvars with the same unique, so that they are\n        -- easy to group together in the typechecker.\n        ; (mbinds', sigs', meth_fvs)\n            <- rnMethodBinds True cls' (hsAllLTyVarNames tyvars') mbinds sigs\n                -- No need to check for duplicate method signatures\n                -- since that is done by RnNames.extendGlobalRdrEnvRn\n                -- and the methods are already in scope\n\n  -- Haddock docs\n        ; docs' <- mapM (wrapLocM rnDocDecl) docs\n\n        ; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs\n        ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls',\n                              tcdTyVars = tyvars', tcdFixity = fixity,\n                              tcdFDs = fds', tcdSigs = sigs',\n                              tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs',\n                              tcdDocs = docs', tcdCExt = all_fvs },\n                  all_fvs ) }\n  where\n    cls_doc  = ClassDeclCtx lcls\n\nrnTyClDecl (XTyClDecl _) = panic \"rnTyClDecl\"\n\n-- \"type\" and \"type instance\" declarations\nrnTySyn :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)\nrnTySyn doc rhs = rnLHsType doc rhs\n\nrnDataDefn :: HsDocContext -> HsDataDefn GhcPs\n           -> RnM (HsDataDefn GhcRn, FreeVars)\nrnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType\n                           , dd_ctxt = context, dd_cons = condecls\n                           , dd_kindSig = m_sig, dd_derivs = derivs })\n  = do  { checkTc (h98_style || null (unLoc context))\n                  (badGadtStupidTheta doc)\n\n        ; (m_sig', sig_fvs) <- case m_sig of\n             Just sig -> first Just <$> rnLHsKind doc sig\n             Nothing  -> return (Nothing, emptyFVs)\n        ; (context', fvs1) <- rnContext doc context\n        ; (derivs',  fvs3) <- rn_derivs derivs\n\n        -- For the constructor declarations, drop the LocalRdrEnv\n        -- in the GADT case, where the type variables in the declaration\n        -- do not scope over the constructor signatures\n        -- data T a where { T1 :: forall b. b-> b }\n        ; let { zap_lcl_env | h98_style = \\ thing -> thing\n                            | otherwise = setLocalRdrEnv emptyLocalRdrEnv }\n        ; (condecls', con_fvs) <- zap_lcl_env $ rnConDecls condecls\n           -- No need to check for duplicate constructor decls\n           -- since that is done by RnNames.extendGlobalRdrEnvRn\n\n        ; let all_fvs = fvs1 `plusFV` fvs3 `plusFV`\n                        con_fvs `plusFV` sig_fvs\n        ; return ( HsDataDefn { dd_ext = noExt\n                              , dd_ND = new_or_data, dd_cType = cType\n                              , dd_ctxt = context', dd_kindSig = m_sig'\n                              , dd_cons = condecls'\n                              , dd_derivs = derivs' }\n                 , all_fvs )\n        }\n  where\n    h98_style = case condecls of  -- Note [Stupid theta]\n                     (dL->L _ (ConDeclGADT {})) : _  -> False\n                     _                               -> True\n\n    rn_derivs (dL->L loc ds)\n      = do { deriv_strats_ok <- xoptM LangExt.DerivingStrategies\n           ; failIfTc (lengthExceeds ds 1 && not deriv_strats_ok)\n               multipleDerivClausesErr\n           ; (ds', fvs) <- mapFvRn (rnLHsDerivingClause doc) ds\n           ; return (cL loc ds', fvs) }\nrnDataDefn _ (XHsDataDefn _) = panic \"rnDataDefn\"\n\nwarnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)\n                 -> SrcSpan\n                 -> RnM ()\nwarnNoDerivStrat mds loc\n  = do { dyn_flags <- getDynFlags\n       ; when (wopt Opt_WarnMissingDerivingStrategies dyn_flags) $\n           case mds of\n             Nothing -> addWarnAt\n               (Reason Opt_WarnMissingDerivingStrategies)\n               loc\n               (if xopt LangExt.DerivingStrategies dyn_flags\n                 then no_strat_warning\n                 else no_strat_warning $+$ deriv_strat_nenabled\n               )\n             _ -> pure ()\n       }\n  where\n    no_strat_warning :: SDoc\n    no_strat_warning = text \"No deriving strategy specified. Did you want stock\"\n                       <> text \", newtype, or anyclass?\"\n    deriv_strat_nenabled :: SDoc\n    deriv_strat_nenabled = text \"Use DerivingStrategies to specify a strategy.\"\n\nrnLHsDerivingClause :: HsDocContext -> LHsDerivingClause GhcPs\n                    -> RnM (LHsDerivingClause GhcRn, FreeVars)\nrnLHsDerivingClause doc\n                (dL->L loc (HsDerivingClause\n                              { deriv_clause_ext = noExt\n                              , deriv_clause_strategy = dcs\n                              , deriv_clause_tys = (dL->L loc' dct) }))\n  = do { (dcs', dct', fvs)\n           <- rnLDerivStrategy doc dcs $ \\strat_tvs ppr_via_ty ->\n              mapFvRn (rn_deriv_ty strat_tvs ppr_via_ty) dct\n       ; warnNoDerivStrat dcs' loc\n       ; pure ( cL loc (HsDerivingClause { deriv_clause_ext = noExt\n                                         , deriv_clause_strategy = dcs'\n                                         , deriv_clause_tys = cL loc' dct' })\n              , fvs ) }\n  where\n    rn_deriv_ty :: [Name] -> SDoc -> LHsSigType GhcPs\n                -> RnM (LHsSigType GhcRn, FreeVars)\n    rn_deriv_ty strat_tvs ppr_via_ty deriv_ty@(HsIB {hsib_body = dL->L loc _}) =\n      rnAndReportFloatingViaTvs strat_tvs loc ppr_via_ty \"class\" $\n      rnHsSigType doc deriv_ty\n    rn_deriv_ty _ _ (XHsImplicitBndrs _) = panic \"rn_deriv_ty\"\nrnLHsDerivingClause _ (dL->L _ (XHsDerivingClause _))\n  = panic \"rnLHsDerivingClause\"\nrnLHsDerivingClause _ _ = panic \"rnLHsDerivingClause: Impossible Match\"\n                                -- due to #15884\n\nrnLDerivStrategy :: forall a.\n                    HsDocContext\n                 -> Maybe (LDerivStrategy GhcPs)\n                 -> ([Name]   -- The tyvars bound by the via type\n                      -> SDoc -- The pretty-printed via type (used for\n                              -- error message reporting)\n                      -> RnM (a, FreeVars))\n                 -> RnM (Maybe (LDerivStrategy GhcRn), a, FreeVars)\nrnLDerivStrategy doc mds thing_inside\n  = case mds of\n      Nothing -> boring_case Nothing\n      Just ds -> do (ds', thing, fvs) <- rn_deriv_strat ds\n                    pure (Just ds', thing, fvs)\n  where\n    rn_deriv_strat :: LDerivStrategy GhcPs\n                   -> RnM (LDerivStrategy GhcRn, a, FreeVars)\n    rn_deriv_strat (dL->L loc ds) = do\n      let extNeeded :: LangExt.Extension\n          extNeeded\n            | ViaStrategy{} <- ds\n            = LangExt.DerivingVia\n            | otherwise\n            = LangExt.DerivingStrategies\n\n      unlessXOptM extNeeded $\n        failWith $ illegalDerivStrategyErr ds\n\n      case ds of\n        StockStrategy    -> boring_case (cL loc StockStrategy)\n        AnyclassStrategy -> boring_case (cL loc AnyclassStrategy)\n        NewtypeStrategy  -> boring_case (cL loc NewtypeStrategy)\n        ViaStrategy via_ty ->\n          do (via_ty', fvs1) <- rnHsSigType doc via_ty\n             let HsIB { hsib_ext  = via_imp_tvs\n                      , hsib_body = via_body } = via_ty'\n                 (via_exp_tv_bndrs, _, _) = splitLHsSigmaTy via_body\n                 via_exp_tvs = hsLTyVarNames via_exp_tv_bndrs\n                 via_tvs = via_imp_tvs ++ via_exp_tvs\n             (thing, fvs2) <- extendTyVarEnvFVRn via_tvs $\n                              thing_inside via_tvs (ppr via_ty')\n             pure (cL loc (ViaStrategy via_ty'), thing, fvs1 `plusFV` fvs2)\n\n    boring_case :: mds\n                -> RnM (mds, a, FreeVars)\n    boring_case mds = do\n      (thing, fvs) <- thing_inside [] empty\n      pure (mds, thing, fvs)\n\n-- | Errors if a @via@ type binds any floating type variables.\n-- See @Note [Floating `via` type variables]@\nrnAndReportFloatingViaTvs\n  :: forall a. Outputable a\n  => [Name]  -- ^ The bound type variables from a @via@ type.\n  -> SrcSpan -- ^ The source span (for error reporting only).\n  -> SDoc    -- ^ The pretty-printed @via@ type (for error reporting only).\n  -> String  -- ^ A description of what the @via@ type scopes over\n             --   (for error reporting only).\n  -> RnM (a, FreeVars) -- ^ The thing the @via@ type scopes over.\n  -> RnM (a, FreeVars)\nrnAndReportFloatingViaTvs tv_names loc ppr_via_ty via_scope_desc thing_inside\n  = do (thing, thing_fvs) <- thing_inside\n       setSrcSpan loc $ mapM_ (report_floating_via_tv thing thing_fvs) tv_names\n       pure (thing, thing_fvs)\n  where\n    report_floating_via_tv :: a -> FreeVars -> Name -> RnM ()\n    report_floating_via_tv thing used_names tv_name\n      = unless (tv_name `elemNameSet` used_names) $ addErr $ vcat\n          [ text \"Type variable\" <+> quotes (ppr tv_name) <+>\n            text \"is bound in the\" <+> quotes (text \"via\") <+>\n            text \"type\" <+> quotes ppr_via_ty\n          , text \"but is not mentioned in the derived\" <+>\n            text via_scope_desc <+> quotes (ppr thing) <>\n            text \", which is illegal\" ]\n\n{-\nNote [Floating `via` type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nImagine the following `deriving via` clause:\n\n    data Quux\n      deriving Eq via (Const a Quux)\n\nThis should be rejected. Why? Because it would generate the following instance:\n\n    instance Eq Quux where\n      (==) = coerce @(Quux         -> Quux         -> Bool)\n                    @(Const a Quux -> Const a Quux -> Bool)\n                    (==) :: Const a Quux -> Const a Quux -> Bool\n\nThis instance is ill-formed, as the `a` in `Const a Quux` is unbound. The\nproblem is that `a` is never used anywhere in the derived class `Eq`. Since\n`a` is bound but has no use sites, we refer to it as \"floating\".\n\nWe use the rnAndReportFloatingViaTvs function to check that any type renamed\nwithin the context of the `via` deriving strategy actually uses all bound\n`via` type variables, and if it doesn't, it throws an error.\n-}\n\nbadGadtStupidTheta :: HsDocContext -> SDoc\nbadGadtStupidTheta _\n  = vcat [text \"No context is allowed on a GADT-style data declaration\",\n          text \"(You can put a context on each constructor, though.)\"]\n\nillegalDerivStrategyErr :: DerivStrategy GhcPs -> SDoc\nillegalDerivStrategyErr ds\n  = vcat [ text \"Illegal deriving strategy\" <> colon <+> derivStrategyName ds\n         , text enableStrategy ]\n\n  where\n    enableStrategy :: String\n    enableStrategy\n      | ViaStrategy{} <- ds\n      = \"Use DerivingVia to enable this extension\"\n      | otherwise\n      = \"Use DerivingStrategies to enable this extension\"\n\nmultipleDerivClausesErr :: SDoc\nmultipleDerivClausesErr\n  = vcat [ text \"Illegal use of multiple, consecutive deriving clauses\"\n         , text \"Use DerivingStrategies to allow this\" ]\n\nrnFamDecl :: Maybe Name -- Just cls => this FamilyDecl is nested\n                        --             inside an *class decl* for cls\n                        --             used for associated types\n          -> FamilyDecl GhcPs\n          -> RnM (FamilyDecl GhcRn, FreeVars)\nrnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars\n                             , fdFixity = fixity\n                             , fdInfo = info, fdResultSig = res_sig\n                             , fdInjectivityAnn = injectivity })\n  = do { tycon' <- lookupLocatedTopBndrRn tycon\n       ; ((tyvars', res_sig', injectivity'), fv1) <-\n            bindHsQTyVars doc Nothing mb_cls kvs tyvars $ \\ tyvars' _ ->\n            do { let rn_sig = rnFamResultSig doc\n               ; (res_sig', fv_kind) <- wrapLocFstM rn_sig res_sig\n               ; injectivity' <- traverse (rnInjectivityAnn tyvars' res_sig')\n                                          injectivity\n               ; return ( (tyvars', res_sig', injectivity') , fv_kind ) }\n       ; (info', fv2) <- rn_info tycon' info\n       ; return (FamilyDecl { fdExt = noExt\n                            , fdLName = tycon', fdTyVars = tyvars'\n                            , fdFixity = fixity\n                            , fdInfo = info', fdResultSig = res_sig'\n                            , fdInjectivityAnn = injectivity' }\n                , fv1 `plusFV` fv2) }\n  where\n     doc = TyFamilyCtx tycon\n     kvs = extractRdrKindSigVars res_sig\n\n     ----------------------\n     rn_info :: Located Name\n             -> FamilyInfo GhcPs -> RnM (FamilyInfo GhcRn, FreeVars)\n     rn_info (dL->L _ fam_name) (ClosedTypeFamily (Just eqns))\n       = do { (eqns', fvs)\n                <- rnList (rnTyFamInstEqn Nothing (ClosedTyFam tycon fam_name))\n                                          -- no class context\n                          eqns\n            ; return (ClosedTypeFamily (Just eqns'), fvs) }\n     rn_info _ (ClosedTypeFamily Nothing)\n       = return (ClosedTypeFamily Nothing, emptyFVs)\n     rn_info _ OpenTypeFamily = return (OpenTypeFamily, emptyFVs)\n     rn_info _ DataFamily     = return (DataFamily, emptyFVs)\nrnFamDecl _ (XFamilyDecl _) = panic \"rnFamDecl\"\n\nrnFamResultSig :: HsDocContext\n               -> FamilyResultSig GhcPs\n               -> RnM (FamilyResultSig GhcRn, FreeVars)\nrnFamResultSig _ (NoSig _)\n   = return (NoSig noExt, emptyFVs)\nrnFamResultSig doc (KindSig _ kind)\n   = do { (rndKind, ftvs) <- rnLHsKind doc kind\n        ;  return (KindSig noExt rndKind, ftvs) }\nrnFamResultSig doc (TyVarSig _ tvbndr)\n   = do { -- `TyVarSig` tells us that user named the result of a type family by\n          -- writing `= tyvar` or `= (tyvar :: kind)`. In such case we want to\n          -- be sure that the supplied result name is not identical to an\n          -- already in-scope type variable from an enclosing class.\n          --\n          --  Example of disallowed declaration:\n          --         class C a b where\n          --            type F b = a | a -> b\n          rdr_env <- getLocalRdrEnv\n       ;  let resName = hsLTyVarName tvbndr\n       ;  when (resName `elemLocalRdrEnv` rdr_env) $\n          addErrAt (getLoc tvbndr) $\n                     (hsep [ text \"Type variable\", quotes (ppr resName) <> comma\n                           , text \"naming a type family result,\"\n                           ] $$\n                      text \"shadows an already bound type variable\")\n\n       ; bindLHsTyVarBndr doc Nothing -- This might be a lie, but it's used for\n                                      -- scoping checks that are irrelevant here\n                          tvbndr $ \\ tvbndr' ->\n         return (TyVarSig noExt tvbndr', unitFV (hsLTyVarName tvbndr')) }\nrnFamResultSig _ (XFamilyResultSig _) = panic \"rnFamResultSig\"\n\n-- Note [Renaming injectivity annotation]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- During renaming of injectivity annotation we have to make several checks to\n-- make sure that it is well-formed.  At the moment injectivity annotation\n-- consists of a single injectivity condition, so the terms \"injectivity\n-- annotation\" and \"injectivity condition\" might be used interchangeably.  See\n-- Note [Injectivity annotation] for a detailed discussion of currently allowed\n-- injectivity annotations.\n--\n-- Checking LHS is simple because the only type variable allowed on the LHS of\n-- injectivity condition is the variable naming the result in type family head.\n-- Example of disallowed annotation:\n--\n--     type family Foo a b = r | b -> a\n--\n-- Verifying RHS of injectivity consists of checking that:\n--\n--  1. only variables defined in type family head appear on the RHS (kind\n--     variables are also allowed).  Example of disallowed annotation:\n--\n--        type family Foo a = r | r -> b\n--\n--  2. for associated types the result variable does not shadow any of type\n--     class variables. Example of disallowed annotation:\n--\n--        class Foo a b where\n--           type F a = b | b -> a\n--\n-- Breaking any of these assumptions results in an error.\n\n-- | Rename injectivity annotation. Note that injectivity annotation is just the\n-- part after the \"|\".  Everything that appears before it is renamed in\n-- rnFamDecl.\nrnInjectivityAnn :: LHsQTyVars GhcRn           -- ^ Type variables declared in\n                                               --   type family head\n                 -> LFamilyResultSig GhcRn     -- ^ Result signature\n                 -> LInjectivityAnn GhcPs      -- ^ Injectivity annotation\n                 -> RnM (LInjectivityAnn GhcRn)\nrnInjectivityAnn tvBndrs (dL->L _ (TyVarSig _ resTv))\n                 (dL->L srcSpan (InjectivityAnn injFrom injTo))\n = do\n   { (injDecl'@(dL->L _ (InjectivityAnn injFrom' injTo')), noRnErrors)\n          <- askNoErrs $\n             bindLocalNames [hsLTyVarName resTv] $\n             -- The return type variable scopes over the injectivity annotation\n             -- e.g.   type family F a = (r::*) | r -> a\n             do { injFrom' <- rnLTyVar injFrom\n                ; injTo'   <- mapM rnLTyVar injTo\n                ; return $ cL srcSpan (InjectivityAnn injFrom' injTo') }\n\n   ; let tvNames  = Set.fromList $ hsAllLTyVarNames tvBndrs\n         resName  = hsLTyVarName resTv\n         -- See Note [Renaming injectivity annotation]\n         lhsValid = EQ == (stableNameCmp resName (unLoc injFrom'))\n         rhsValid = Set.fromList (map unLoc injTo') `Set.difference` tvNames\n\n   -- if renaming of type variables ended with errors (eg. there were\n   -- not-in-scope variables) don't check the validity of injectivity\n   -- annotation. This gives better error messages.\n   ; when (noRnErrors && not lhsValid) $\n        addErrAt (getLoc injFrom)\n              ( vcat [ text $ \"Incorrect type variable on the LHS of \"\n                           ++ \"injectivity condition\"\n              , nest 5\n              ( vcat [ text \"Expected :\" <+> ppr resName\n                     , text \"Actual   :\" <+> ppr injFrom ])])\n\n   ; when (noRnErrors && not (Set.null rhsValid)) $\n      do { let errorVars = Set.toList rhsValid\n         ; addErrAt srcSpan $ ( hsep\n                        [ text \"Unknown type variable\" <> plural errorVars\n                        , text \"on the RHS of injectivity condition:\"\n                        , interpp'SP errorVars ] ) }\n\n   ; return injDecl' }\n\n-- We can only hit this case when the user writes injectivity annotation without\n-- naming the result:\n--\n--   type family F a | result -> a\n--   type family F a :: * | result -> a\n--\n-- So we rename injectivity annotation like we normally would except that\n-- this time we expect \"result\" to be reported not in scope by rnLTyVar.\nrnInjectivityAnn _ _ (dL->L srcSpan (InjectivityAnn injFrom injTo)) =\n   setSrcSpan srcSpan $ do\n   (injDecl', _) <- askNoErrs $ do\n     injFrom' <- rnLTyVar injFrom\n     injTo'   <- mapM rnLTyVar injTo\n     return $ cL srcSpan (InjectivityAnn injFrom' injTo')\n   return $ injDecl'\n\n{-\nNote [Stupid theta]\n~~~~~~~~~~~~~~~~~~~\nTrac #3850 complains about a regression wrt 6.10 for\n     data Show a => T a\nThere is no reason not to allow the stupid theta if there are no data\nconstructors.  It's still stupid, but does no harm, and I don't want\nto cause programs to break unnecessarily (notably HList).  So if there\nare no data constructors we allow h98_style = True\n-}\n\n\n{- *****************************************************\n*                                                      *\n     Support code for type/data declarations\n*                                                      *\n***************************************************** -}\n\n---------------\nwrongTyFamName :: Name -> Name -> SDoc\nwrongTyFamName fam_tc_name eqn_tc_name\n  = hang (text \"Mismatched type name in type family instance.\")\n       2 (vcat [ text \"Expected:\" <+> ppr fam_tc_name\n               , text \"  Actual:\" <+> ppr eqn_tc_name ])\n\n-----------------\nrnConDecls :: [LConDecl GhcPs] -> RnM ([LConDecl GhcRn], FreeVars)\nrnConDecls = mapFvRn (wrapLocFstM rnConDecl)\n\nrnConDecl :: ConDecl GhcPs -> RnM (ConDecl GhcRn, FreeVars)\nrnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs\n                           , con_mb_cxt = mcxt, con_args = args\n                           , con_doc = mb_doc })\n  = do  { _        <- addLocM checkConName name\n        ; new_name <- lookupLocatedTopBndrRn name\n        ; mb_doc'  <- rnMbLHsDoc mb_doc\n\n        -- We bind no implicit binders here; this is just like\n        -- a nested HsForAllTy.  E.g. consider\n        --         data T a = forall (b::k). MkT (...)\n        -- The 'k' will already be in scope from the bindHsQTyVars\n        -- for the data decl itself. So we'll get\n        --         data T {k} a = ...\n        -- And indeed we may later discover (a::k).  But that's the\n        -- scoping we get.  So no implicit binders at the existential forall\n\n        ; let ctxt = ConDeclCtx [new_name]\n        ; bindLHsTyVarBndrs ctxt (Just (inHsDocContext ctxt))\n                            Nothing ex_tvs $ \\ new_ex_tvs ->\n    do  { (new_context, fvs1) <- rnMbContext ctxt mcxt\n        ; (new_args,    fvs2) <- rnConDeclDetails (unLoc new_name) ctxt args\n        ; let all_fvs  = fvs1 `plusFV` fvs2\n        ; traceRn \"rnConDecl\" (ppr name <+> vcat\n             [ text \"ex_tvs:\" <+> ppr ex_tvs\n             , text \"new_ex_dqtvs':\" <+> ppr new_ex_tvs ])\n\n        ; return (decl { con_ext = noExt\n                       , con_name = new_name, con_ex_tvs = new_ex_tvs\n                       , con_mb_cxt = new_context, con_args = new_args\n                       , con_doc = mb_doc' },\n                  all_fvs) }}\n\nrnConDecl decl@(ConDeclGADT { con_names   = names\n                            , con_forall  = (dL->L _ explicit_forall)\n                            , con_qvars   = qtvs\n                            , con_mb_cxt  = mcxt\n                            , con_args    = args\n                            , con_res_ty  = res_ty\n                            , con_doc = mb_doc })\n  = do  { mapM_ (addLocM checkConName) names\n        ; new_names <- mapM lookupLocatedTopBndrRn names\n        ; mb_doc'   <- rnMbLHsDoc mb_doc\n\n        ; let explicit_tkvs = hsQTvExplicit qtvs\n              theta         = hsConDeclTheta mcxt\n              arg_tys       = hsConDeclArgTys args\n\n          -- We must ensure that we extract the free tkvs in left-to-right\n          -- order of their appearance in the constructor type.\n          -- That order governs the order the implicitly-quantified type\n          -- variable, and hence the order needed for visible type application\n          -- See Trac #14808.\n              free_tkvs = extractHsTvBndrs explicit_tkvs $\n                          extractHsTysRdrTyVarsDups (theta ++ arg_tys ++ [res_ty])\n\n              ctxt    = ConDeclCtx new_names\n              mb_ctxt = Just (inHsDocContext ctxt)\n\n        ; traceRn \"rnConDecl\" (ppr names $$ ppr free_tkvs $$ ppr explicit_forall )\n        ; rnImplicitBndrs (not explicit_forall) free_tkvs $ \\ implicit_tkvs ->\n          bindLHsTyVarBndrs ctxt mb_ctxt Nothing explicit_tkvs $ \\ explicit_tkvs ->\n    do  { (new_cxt, fvs1)    <- rnMbContext ctxt mcxt\n        ; (new_args, fvs2)   <- rnConDeclDetails (unLoc (head new_names)) ctxt args\n        ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty\n\n        ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3\n              (args', res_ty')\n                  = case args of\n                      InfixCon {}  -> pprPanic \"rnConDecl\" (ppr names)\n                      RecCon {}    -> (new_args, new_res_ty)\n                      PrefixCon as | (arg_tys, final_res_ty) <- splitHsFunType new_res_ty\n                                   -> ASSERT( null as )\n                                      -- See Note [GADT abstract syntax] in HsDecls\n                                      (PrefixCon arg_tys, final_res_ty)\n\n              new_qtvs =  HsQTvs { hsq_ext = HsQTvsRn\n                                     { hsq_implicit  = implicit_tkvs\n                                     , hsq_dependent = emptyNameSet }\n                                 , hsq_explicit  = explicit_tkvs }\n\n        ; traceRn \"rnConDecl2\" (ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs)\n        ; return (decl { con_g_ext = noExt, con_names = new_names\n                       , con_qvars = new_qtvs, con_mb_cxt = new_cxt\n                       , con_args = args', con_res_ty = res_ty'\n                       , con_doc = mb_doc' },\n                  all_fvs) } }\n\nrnConDecl (XConDecl _) = panic \"rnConDecl\"\n\n\nrnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs)\n            -> RnM (Maybe (LHsContext GhcRn), FreeVars)\nrnMbContext _    Nothing    = return (Nothing, emptyFVs)\nrnMbContext doc (Just cxt) = do { (ctx',fvs) <- rnContext doc cxt\n                                ; return (Just ctx',fvs) }\n\nrnConDeclDetails\n   :: Name\n   -> HsDocContext\n   -> HsConDetails (LHsType GhcPs) (Located [LConDeclField GhcPs])\n   -> RnM (HsConDetails (LHsType GhcRn) (Located [LConDeclField GhcRn]),\n           FreeVars)\nrnConDeclDetails _ doc (PrefixCon tys)\n  = do { (new_tys, fvs) <- rnLHsTypes doc tys\n       ; return (PrefixCon new_tys, fvs) }\n\nrnConDeclDetails _ doc (InfixCon ty1 ty2)\n  = do { (new_ty1, fvs1) <- rnLHsType doc ty1\n       ; (new_ty2, fvs2) <- rnLHsType doc ty2\n       ; return (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2) }\n\nrnConDeclDetails con doc (RecCon (dL->L l fields))\n  = do  { fls <- lookupConstructorFields con\n        ; (new_fields, fvs) <- rnConDeclFields doc fls fields\n                -- No need to check for duplicate fields\n                -- since that is done by RnNames.extendGlobalRdrEnvRn\n        ; return (RecCon (cL l new_fields), fvs) }\n\n-------------------------------------------------\n\n-- | Brings pattern synonym names and also pattern synonym selectors\n-- from record pattern synonyms into scope.\nextendPatSynEnv :: HsValBinds GhcPs -> MiniFixityEnv\n                -> ([Name] -> TcRnIf TcGblEnv TcLclEnv a) -> TcM a\nextendPatSynEnv val_decls local_fix_env thing = do {\n     names_with_fls <- new_ps val_decls\n   ; let pat_syn_bndrs = concat [ name: map flSelector fields\n                                | (name, fields) <- names_with_fls ]\n   ; let avails = map avail pat_syn_bndrs\n   ; (gbl_env, lcl_env) <- extendGlobalRdrEnvRn avails local_fix_env\n\n   ; let field_env' = extendNameEnvList (tcg_field_env gbl_env) names_with_fls\n         final_gbl_env = gbl_env { tcg_field_env = field_env' }\n   ; setEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) }\n  where\n    new_ps :: HsValBinds GhcPs -> TcM [(Name, [FieldLabel])]\n    new_ps (ValBinds _ binds _) = foldrBagM new_ps' [] binds\n    new_ps _ = panic \"new_ps\"\n\n    new_ps' :: LHsBindLR GhcPs GhcPs\n            -> [(Name, [FieldLabel])]\n            -> TcM [(Name, [FieldLabel])]\n    new_ps' bind names\n      | (dL->L bind_loc (PatSynBind _ (PSB { psb_id = (dL->L _ n)\n                                           , psb_args = RecCon as }))) <- bind\n      = do\n          bnd_name <- newTopSrcBinder (cL bind_loc n)\n          let rnames = map recordPatSynSelectorId as\n              mkFieldOcc :: Located RdrName -> LFieldOcc GhcPs\n              mkFieldOcc (dL->L l name) = cL l (FieldOcc noExt (cL l name))\n              field_occs =  map mkFieldOcc rnames\n          flds     <- mapM (newRecordSelector False [bnd_name]) field_occs\n          return ((bnd_name, flds): names)\n      | (dL->L bind_loc (PatSynBind _\n                          (PSB { psb_id = (dL->L _ n)}))) <- bind\n      = do\n        bnd_name <- newTopSrcBinder (cL bind_loc n)\n        return ((bnd_name, []): names)\n      | otherwise\n      = return names\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Support code to rename types}\n*                                                      *\n*********************************************************\n-}\n\nrnFds :: [LHsFunDep GhcPs] -> RnM [LHsFunDep GhcRn]\nrnFds fds\n  = mapM (wrapLocM rn_fds) fds\n  where\n    rn_fds (tys1, tys2)\n      = do { tys1' <- rnHsTyVars tys1\n           ; tys2' <- rnHsTyVars tys2\n           ; return (tys1', tys2') }\n\nrnHsTyVars :: [Located RdrName] -> RnM [Located Name]\nrnHsTyVars tvs  = mapM rnHsTyVar tvs\n\nrnHsTyVar :: Located RdrName -> RnM (Located Name)\nrnHsTyVar (dL->L l tyvar) = do\n  tyvar' <- lookupOccRn tyvar\n  return (cL l tyvar')\n\n{-\n*********************************************************\n*                                                      *\n        findSplice\n*                                                      *\n*********************************************************\n\nThis code marches down the declarations, looking for the first\nTemplate Haskell splice.  As it does so it\n        a) groups the declarations into a HsGroup\n        b) runs any top-level quasi-quotes\n-}\n\nfindSplice :: [LHsDecl GhcPs]\n           -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))\nfindSplice ds = addl emptyRdrGroup ds\n\naddl :: HsGroup GhcPs -> [LHsDecl GhcPs]\n     -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))\n-- This stuff reverses the declarations (again) but it doesn't matter\naddl gp []           = return (gp, Nothing)\naddl gp ((dL->L l d) : ds) = add gp l d ds\n\n\nadd :: HsGroup GhcPs -> SrcSpan -> HsDecl GhcPs -> [LHsDecl GhcPs]\n    -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))\n\n-- #10047: Declaration QuasiQuoters are expanded immediately, without\n--         causing a group split\nadd gp _ (SpliceD _ (SpliceDecl _ (dL->L _ qq@HsQuasiQuote{}) _)) ds\n  = do { (ds', _) <- rnTopSpliceDecls qq\n       ; addl gp (ds' ++ ds)\n       }\n\nadd gp loc (SpliceD _ splice@(SpliceDecl _ _ flag)) ds\n  = do { -- We've found a top-level splice.  If it is an *implicit* one\n         -- (i.e. a naked top level expression)\n         case flag of\n           ExplicitSplice -> return ()\n           ImplicitSplice -> do { th_on <- xoptM LangExt.TemplateHaskell\n                                ; unless th_on $ setSrcSpan loc $\n                                  failWith badImplicitSplice }\n\n       ; return (gp, Just (splice, ds)) }\n  where\n    badImplicitSplice = text \"Parse error: module header, import declaration\"\n                     $$ text \"or top-level declaration expected.\"\n                     -- The compiler should suggest the above, and not using\n                     -- TemplateHaskell since the former suggestion is more\n                     -- relevant to the larger base of users.\n                     -- See Trac #12146 for discussion.\n\n-- Class declarations: pull out the fixity signatures to the top\nadd gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD _ d) ds\n  | isClassDecl d\n  = let fsigs = [ cL l f\n                | (dL->L l (FixSig _ f)) <- tcdSigs d ] in\n    addl (gp { hs_tyclds = add_tycld (cL l d) ts, hs_fixds = fsigs ++ fs}) ds\n  | otherwise\n  = addl (gp { hs_tyclds = add_tycld (cL l d) ts }) ds\n\n-- Signatures: fixity sigs go a different place than all others\nadd gp@(HsGroup {hs_fixds = ts}) l (SigD _ (FixSig _ f)) ds\n  = addl (gp {hs_fixds = cL l f : ts}) ds\nadd gp@(HsGroup {hs_valds = ts}) l (SigD _ d) ds\n  = addl (gp {hs_valds = add_sig (cL l d) ts}) ds\n\n-- Value declarations: use add_bind\nadd gp@(HsGroup {hs_valds  = ts}) l (ValD _ d) ds\n  = addl (gp { hs_valds = add_bind (cL l d) ts }) ds\n\n-- Role annotations: added to the TyClGroup\nadd gp@(HsGroup {hs_tyclds = ts}) l (RoleAnnotD _ d) ds\n  = addl (gp { hs_tyclds = add_role_annot (cL l d) ts }) ds\n\n-- NB instance declarations go into TyClGroups. We throw them into the first\n-- group, just as we do for the TyClD case. The renamer will go on to group\n-- and order them later.\nadd gp@(HsGroup {hs_tyclds = ts})  l (InstD _ d) ds\n  = addl (gp { hs_tyclds = add_instd (cL l d) ts }) ds\n\n-- The rest are routine\nadd gp@(HsGroup {hs_derivds = ts})  l (DerivD _ d) ds\n  = addl (gp { hs_derivds = cL l d : ts }) ds\nadd gp@(HsGroup {hs_defds  = ts})  l (DefD _ d) ds\n  = addl (gp { hs_defds = cL l d : ts }) ds\nadd gp@(HsGroup {hs_fords  = ts}) l (ForD _ d) ds\n  = addl (gp { hs_fords = cL l d : ts }) ds\nadd gp@(HsGroup {hs_warnds  = ts})  l (WarningD _ d) ds\n  = addl (gp { hs_warnds = cL l d : ts }) ds\nadd gp@(HsGroup {hs_annds  = ts}) l (AnnD _ d) ds\n  = addl (gp { hs_annds = cL l d : ts }) ds\nadd gp@(HsGroup {hs_ruleds  = ts}) l (RuleD _ d) ds\n  = addl (gp { hs_ruleds = cL l d : ts }) ds\nadd gp l (DocD _ d) ds\n  = addl (gp { hs_docs = (cL l d) : (hs_docs gp) })  ds\nadd (HsGroup {}) _ (SpliceD _ (XSpliceDecl _)) _ = panic \"RnSource.add\"\nadd (HsGroup {}) _ (XHsDecl _)                 _ = panic \"RnSource.add\"\nadd (XHsGroup _) _ _                           _ = panic \"RnSource.add\"\n\nadd_tycld :: LTyClDecl (GhcPass p) -> [TyClGroup (GhcPass p)]\n          -> [TyClGroup (GhcPass p)]\nadd_tycld d []       = [TyClGroup { group_ext    = noExt\n                                  , group_tyclds = [d]\n                                  , group_roles  = []\n                                  , group_instds = []\n                                  }\n                       ]\nadd_tycld d (ds@(TyClGroup { group_tyclds = tyclds }):dss)\n  = ds { group_tyclds = d : tyclds } : dss\nadd_tycld _ (XTyClGroup _: _) = panic \"add_tycld\"\n\nadd_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)]\n          -> [TyClGroup (GhcPass p)]\nadd_instd d []       = [TyClGroup { group_ext    = noExt\n                                  , group_tyclds = []\n                                  , group_roles  = []\n                                  , group_instds = [d]\n                                  }\n                       ]\nadd_instd d (ds@(TyClGroup { group_instds = instds }):dss)\n  = ds { group_instds = d : instds } : dss\nadd_instd _ (XTyClGroup _: _) = panic \"add_instd\"\n\nadd_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)]\n               -> [TyClGroup (GhcPass p)]\nadd_role_annot d [] = [TyClGroup { group_ext    = noExt\n                                 , group_tyclds = []\n                                 , group_roles  = [d]\n                                 , group_instds = []\n                                 }\n                      ]\nadd_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest)\n  = tycls { group_roles = d : roles } : rest\nadd_role_annot _ (XTyClGroup _: _) = panic \"add_role_annot\"\n\nadd_bind :: LHsBind a -> HsValBinds a -> HsValBinds a\nadd_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs\nadd_bind _ (XValBindsLR {})     = panic \"RdrHsSyn:add_bind\"\n\nadd_sig :: LSig (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)\nadd_sig s (ValBinds x bs sigs) = ValBinds x bs (s:sigs)\nadd_sig _ (XValBindsLR {})     = panic \"RdrHsSyn:add_sig\"\n", "num_lines": 2423}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule RnSplice (\n        rnTopSpliceDecls,\n        rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,\n        rnBracket,\n        checkThLocalName\n        , traceSplice, SpliceInfo(..)\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Name\nimport NameSet\nimport HsSyn\nimport RdrName\nimport TcRnMonad\n\nimport RnEnv\nimport RnUtils          ( HsDocContext(..), newLocalBndrRn )\nimport RnUnbound        ( isUnboundName )\nimport RnSource         ( rnSrcDecls, findSplice )\nimport RnPat            ( rnPat )\nimport BasicTypes       ( TopLevelFlag, isTopLevel, SourceText(..) )\nimport Outputable\nimport Module\nimport SrcLoc\nimport RnTypes          ( rnLHsType )\n\nimport Control.Monad    ( unless, when )\n\nimport {-# SOURCE #-} RnExpr   ( rnLExpr )\n\nimport TcEnv            ( checkWellStaged )\nimport THNames          ( liftName )\n\nimport DynFlags\nimport FastString\nimport ErrUtils         ( dumpIfSet_dyn_printer )\nimport TcEnv            ( tcMetaTy )\nimport Hooks\nimport THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName\n                        , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )\n\nimport {-# SOURCE #-} TcExpr   ( tcPolyExpr )\nimport {-# SOURCE #-} TcSplice\n    ( runMetaD\n    , runMetaE\n    , runMetaP\n    , runMetaT\n    , tcTopSpliceExpr\n    )\n\nimport TcHsSyn\n\nimport GHCi.RemoteTypes ( ForeignRef )\nimport qualified Language.Haskell.TH as TH (Q)\n\nimport qualified GHC.LanguageExtensions as LangExt\n\n{-\n************************************************************************\n*                                                                      *\n        Template Haskell brackets\n*                                                                      *\n************************************************************************\n-}\n\nrnBracket :: HsExpr GhcPs -> HsBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)\nrnBracket e br_body\n  = addErrCtxt (quotationCtxtDoc br_body) $\n    do { -- Check that -XTemplateHaskellQuotes is enabled and available\n         thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes\n       ; unless thQuotesEnabled $\n           failWith ( vcat\n                      [ text \"Syntax error on\" <+> ppr e\n                      , text (\"Perhaps you intended to use TemplateHaskell\"\n                              ++ \" or TemplateHaskellQuotes\") ] )\n\n         -- Check for nested brackets\n       ; cur_stage <- getStage\n       ; case cur_stage of\n           { Splice Typed   -> checkTc (isTypedBracket br_body)\n                                       illegalUntypedBracket\n           ; Splice Untyped -> checkTc (not (isTypedBracket br_body))\n                                       illegalTypedBracket\n           ; RunSplice _    ->\n               -- See Note [RunSplice ThLevel] in \"TcRnTypes\".\n               pprPanic \"rnBracket: Renaming bracket when running a splice\"\n                        (ppr e)\n           ; Comp           -> return ()\n           ; Brack {}       -> failWithTc illegalBracket\n           }\n\n         -- Brackets are desugared to code that mentions the TH package\n       ; recordThUse\n\n       ; case isTypedBracket br_body of\n            True  -> do { traceRn \"Renaming typed TH bracket\" empty\n                        ; (body', fvs_e) <-\n                          setStage (Brack cur_stage RnPendingTyped) $\n                                   rn_bracket cur_stage br_body\n                        ; return (HsBracket noExt body', fvs_e) }\n\n            False -> do { traceRn \"Renaming untyped TH bracket\" empty\n                        ; ps_var <- newMutVar []\n                        ; (body', fvs_e) <-\n                          setStage (Brack cur_stage (RnPendingUntyped ps_var)) $\n                                   rn_bracket cur_stage br_body\n                        ; pendings <- readMutVar ps_var\n                        ; return (HsRnBracketOut noExt body' pendings, fvs_e) }\n       }\n\nrn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)\nrn_bracket outer_stage br@(VarBr x flg rdr_name)\n  = do { name <- lookupOccRn rdr_name\n       ; this_mod <- getModule\n\n       ; when (flg && nameIsLocalOrFrom this_mod name) $\n             -- Type variables can be quoted in TH. See #5721.\n                 do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name\n                    ; case mb_bind_lvl of\n                        { Nothing -> return ()      -- Can happen for data constructors,\n                                                    -- but nothing needs to be done for them\n\n                        ; Just (top_lvl, bind_lvl)  -- See Note [Quoting names]\n                             | isTopLevel top_lvl\n                             -> when (isExternalName name) (keepAlive name)\n                             | otherwise\n                             -> do { traceRn \"rn_bracket VarBr\"\n                                      (ppr name <+> ppr bind_lvl\n                                                <+> ppr outer_stage)\n                                   ; checkTc (thLevel outer_stage + 1 == bind_lvl)\n                                             (quotedNameStageErr br) }\n                        }\n                    }\n       ; return (VarBr x flg name, unitFV name) }\n\nrn_bracket _ (ExpBr x e) = do { (e', fvs) <- rnLExpr e\n                            ; return (ExpBr x e', fvs) }\n\nrn_bracket _ (PatBr x p)\n  = rnPat ThPatQuote p $ \\ p' -> return (PatBr x p', emptyFVs)\n\nrn_bracket _ (TypBr x t) = do { (t', fvs) <- rnLHsType TypBrCtx t\n                              ; return (TypBr x t', fvs) }\n\nrn_bracket _ (DecBrL x decls)\n  = do { group <- groupDecls decls\n       ; gbl_env  <- getGblEnv\n       ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }\n                          -- The emptyDUs is so that we just collect uses for this\n                          -- group alone in the call to rnSrcDecls below\n       ; (tcg_env, group') <- setGblEnv new_gbl_env $\n                              rnSrcDecls group\n\n              -- Discard the tcg_env; it contains only extra info about fixity\n        ; traceRn \"rn_bracket dec\" (ppr (tcg_dus tcg_env) $$\n                   ppr (duUses (tcg_dus tcg_env)))\n        ; return (DecBrG x group', duUses (tcg_dus tcg_env)) }\n  where\n    groupDecls :: [LHsDecl GhcPs] -> RnM (HsGroup GhcPs)\n    groupDecls decls\n      = do { (group, mb_splice) <- findSplice decls\n           ; case mb_splice of\n           { Nothing -> return group\n           ; Just (splice, rest) ->\n               do { group' <- groupDecls rest\n                  ; let group'' = appendGroups group group'\n                  ; return group'' { hs_splcds = noLoc splice : hs_splcds group' }\n                  }\n           }}\n\nrn_bracket _ (DecBrG {}) = panic \"rn_bracket: unexpected DecBrG\"\n\nrn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e\n                               ; return (TExpBr x e', fvs) }\n\nrn_bracket _ (XBracket {}) = panic \"rn_bracket: unexpected XBracket\"\n\nquotationCtxtDoc :: HsBracket GhcPs -> SDoc\nquotationCtxtDoc br_body\n  = hang (text \"In the Template Haskell quotation\")\n         2 (ppr br_body)\n\nillegalBracket :: SDoc\nillegalBracket =\n    text \"Template Haskell brackets cannot be nested\" <+>\n    text \"(without intervening splices)\"\n\nillegalTypedBracket :: SDoc\nillegalTypedBracket =\n    text \"Typed brackets may only appear in typed splices.\"\n\nillegalUntypedBracket :: SDoc\nillegalUntypedBracket =\n    text \"Untyped brackets may only appear in untyped splices.\"\n\nquotedNameStageErr :: HsBracket GhcPs -> SDoc\nquotedNameStageErr br\n  = sep [ text \"Stage error: the non-top-level quoted name\" <+> ppr br\n        , text \"must be used at the same stage at which it is bound\" ]\n\n\n{-\n*********************************************************\n*                                                      *\n                Splices\n*                                                      *\n*********************************************************\n\nNote [Free variables of typed splices]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider renaming this:\n        f = ...\n        h = ...$(thing \"f\")...\n\nwhere the splice is a *typed* splice.  The splice can expand into\nliterally anything, so when we do dependency analysis we must assume\nthat it might mention 'f'.  So we simply treat all locally-defined\nnames as mentioned by any splice.  This is terribly brutal, but I\ndon't see what else to do.  For example, it'll mean that every\nlocally-defined thing will appear to be used, so no unused-binding\nwarnings.  But if we miss the dependency, then we might typecheck 'h'\nbefore 'f', and that will crash the type checker because 'f' isn't in\nscope.\n\nCurrently, I'm not treating a splice as also mentioning every import,\nwhich is a bit inconsistent -- but there are a lot of them.  We might\nthereby get some bogus unused-import warnings, but we won't crash the\ntype checker.  Not very satisfactory really.\n\nNote [Renamer errors]\n~~~~~~~~~~~~~~~~~~~~~\nIt's important to wrap renamer calls in checkNoErrs, because the\nrenamer does not fail for out of scope variables etc. Instead it\nreturns a bogus term/type, so that it can report more than one error.\nWe don't want the type checker to see these bogus unbound variables.\n-}\n\nrnSpliceGen :: (HsSplice GhcRn -> RnM (a, FreeVars))\n                                            -- Outside brackets, run splice\n            -> (HsSplice GhcRn -> (PendingRnSplice, a))\n                                            -- Inside brackets, make it pending\n            -> HsSplice GhcPs\n            -> RnM (a, FreeVars)\nrnSpliceGen run_splice pend_splice splice\n  = addErrCtxt (spliceCtxt splice) $ do\n    { stage <- getStage\n    ; case stage of\n        Brack pop_stage RnPendingTyped\n          -> do { checkTc is_typed_splice illegalUntypedSplice\n                ; (splice', fvs) <- setStage pop_stage $\n                                    rnSplice splice\n                ; let (_pending_splice, result) = pend_splice splice'\n                ; return (result, fvs) }\n\n        Brack pop_stage (RnPendingUntyped ps_var)\n          -> do { checkTc (not is_typed_splice) illegalTypedSplice\n                ; (splice', fvs) <- setStage pop_stage $\n                                    rnSplice splice\n                ; let (pending_splice, result) = pend_splice splice'\n                ; ps <- readMutVar ps_var\n                ; writeMutVar ps_var (pending_splice : ps)\n                ; return (result, fvs) }\n\n        _ ->  do { (splice', fvs1) <- checkNoErrs $\n                                      setStage (Splice splice_type) $\n                                      rnSplice splice\n                   -- checkNoErrs: don't attempt to run the splice if\n                   -- renaming it failed; otherwise we get a cascade of\n                   -- errors from e.g. unbound variables\n                 ; (result, fvs2) <- run_splice splice'\n                 ; return (result, fvs1 `plusFV` fvs2) } }\n   where\n     is_typed_splice = isTypedSplice splice\n     splice_type = if is_typed_splice\n                   then Typed\n                   else Untyped\n\n------------------\n\n-- | Returns the result of running a splice and the modFinalizers collected\n-- during the execution.\n--\n-- See Note [Delaying modFinalizers in untyped splices].\nrunRnSplice :: UntypedSpliceFlavour\n            -> (LHsExpr GhcTc -> TcRn res)\n            -> (res -> SDoc)    -- How to pretty-print res\n                                -- Usually just ppr, but not for [Decl]\n            -> HsSplice GhcRn   -- Always untyped\n            -> TcRn (res, [ForeignRef (TH.Q ())])\nrunRnSplice flavour run_meta ppr_res splice\n  = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)\n\n       ; let the_expr = case splice' of\n                HsUntypedSplice _ _ _ e   ->  e\n                HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str\n                HsTypedSplice {}          -> pprPanic \"runRnSplice\" (ppr splice)\n                HsSpliced {}              -> pprPanic \"runRnSplice\" (ppr splice)\n                HsSplicedT {}             -> pprPanic \"runRnSplice\" (ppr splice)\n                XSplice {}                -> pprPanic \"runRnSplice\" (ppr splice)\n\n             -- Typecheck the expression\n       ; meta_exp_ty   <- tcMetaTy meta_ty_name\n       ; zonked_q_expr <- zonkTopLExpr =<<\n                            tcTopSpliceExpr Untyped\n                              (tcPolyExpr the_expr meta_exp_ty)\n\n             -- Run the expression\n       ; mod_finalizers_ref <- newTcRef []\n       ; result <- setStage (RunSplice mod_finalizers_ref) $\n                     run_meta zonked_q_expr\n       ; mod_finalizers <- readTcRef mod_finalizers_ref\n       ; traceSplice (SpliceInfo { spliceDescription = what\n                                 , spliceIsDecl      = is_decl\n                                 , spliceSource      = Just the_expr\n                                 , spliceGenerated   = ppr_res result })\n\n       ; return (result, mod_finalizers) }\n\n  where\n    meta_ty_name = case flavour of\n                       UntypedExpSplice  -> expQTyConName\n                       UntypedPatSplice  -> patQTyConName\n                       UntypedTypeSplice -> typeQTyConName\n                       UntypedDeclSplice -> decsQTyConName\n    what = case flavour of\n                  UntypedExpSplice  -> \"expression\"\n                  UntypedPatSplice  -> \"pattern\"\n                  UntypedTypeSplice -> \"type\"\n                  UntypedDeclSplice -> \"declarations\"\n    is_decl = case flavour of\n                 UntypedDeclSplice -> True\n                 _                 -> False\n\n------------------\nmakePending :: UntypedSpliceFlavour\n            -> HsSplice GhcRn\n            -> PendingRnSplice\nmakePending flavour (HsUntypedSplice _ _ n e)\n  = PendingRnSplice flavour n e\nmakePending flavour (HsQuasiQuote _ n quoter q_span quote)\n  = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)\nmakePending _ splice@(HsTypedSplice {})\n  = pprPanic \"makePending\" (ppr splice)\nmakePending _ splice@(HsSpliced {})\n  = pprPanic \"makePending\" (ppr splice)\nmakePending _ splice@(HsSplicedT {})\n  = pprPanic \"makePending\" (ppr splice)\nmakePending _ splice@(XSplice {})\n  = pprPanic \"makePending\" (ppr splice)\n\n------------------\nmkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString\n                 -> LHsExpr GhcRn\n-- Return the expression (quoter \"...quote...\")\n-- which is what we must run in a quasi-quote\nmkQuasiQuoteExpr flavour quoter q_span quote\n  = cL q_span $ HsApp noExt (cL q_span\n              $ HsApp noExt (cL q_span (HsVar noExt (cL q_span quote_selector)))\n                            quoterExpr)\n                     quoteExpr\n  where\n    quoterExpr = cL q_span $! HsVar noExt $! (cL q_span quoter)\n    quoteExpr  = cL q_span $! HsLit noExt $! HsString NoSourceText quote\n    quote_selector = case flavour of\n                       UntypedExpSplice  -> quoteExpName\n                       UntypedPatSplice  -> quotePatName\n                       UntypedTypeSplice -> quoteTypeName\n                       UntypedDeclSplice -> quoteDecName\n\n---------------------\nrnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars)\n-- Not exported...used for all\nrnSplice (HsTypedSplice x hasParen splice_name expr)\n  = do  { checkTH expr \"Template Haskell typed splice\"\n        ; loc  <- getSrcSpanM\n        ; n' <- newLocalBndrRn (cL loc splice_name)\n        ; (expr', fvs) <- rnLExpr expr\n        ; return (HsTypedSplice x hasParen n' expr', fvs) }\n\nrnSplice (HsUntypedSplice x hasParen splice_name expr)\n  = do  { checkTH expr \"Template Haskell untyped splice\"\n        ; loc  <- getSrcSpanM\n        ; n' <- newLocalBndrRn (cL loc splice_name)\n        ; (expr', fvs) <- rnLExpr expr\n        ; return (HsUntypedSplice x hasParen n' expr', fvs) }\n\nrnSplice (HsQuasiQuote x splice_name quoter q_loc quote)\n  = do  { checkTH quoter \"Template Haskell quasi-quote\"\n        ; loc  <- getSrcSpanM\n        ; splice_name' <- newLocalBndrRn (cL loc splice_name)\n\n          -- Rename the quoter; akin to the HsVar case of rnExpr\n        ; quoter' <- lookupOccRn quoter\n        ; this_mod <- getModule\n        ; when (nameIsLocalOrFrom this_mod quoter') $\n          checkThLocalName quoter'\n\n        ; return (HsQuasiQuote x splice_name' quoter' q_loc quote\n                                                             , unitFV quoter') }\n\nrnSplice splice@(HsSpliced {}) = pprPanic \"rnSplice\" (ppr splice)\nrnSplice splice@(HsSplicedT {}) = pprPanic \"rnSplice\" (ppr splice)\nrnSplice splice@(XSplice {})   = pprPanic \"rnSplice\" (ppr splice)\n\n---------------------\nrnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)\nrnSpliceExpr splice\n  = rnSpliceGen run_expr_splice pend_expr_splice splice\n  where\n    pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn)\n    pend_expr_splice rn_splice\n        = (makePending UntypedExpSplice rn_splice, HsSpliceE noExt rn_splice)\n\n    run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars)\n    run_expr_splice rn_splice\n      | isTypedSplice rn_splice   -- Run it later, in the type checker\n      = do {  -- Ugh!  See Note [Splices] above\n             traceRn \"rnSpliceExpr: typed expression splice\" empty\n           ; lcl_rdr <- getLocalRdrEnv\n           ; gbl_rdr <- getGlobalRdrEnv\n           ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr\n                                                     , isLocalGRE gre]\n                 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)\n\n           ; return (HsSpliceE noExt rn_splice, lcl_names `plusFV` gbl_names) }\n\n      | otherwise  -- Run it here, see Note [Running splices in the Renamer]\n      = do { traceRn \"rnSpliceExpr: untyped expression splice\" empty\n           ; (rn_expr, mod_finalizers) <-\n                runRnSplice UntypedExpSplice runMetaE ppr rn_splice\n           ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)\n             -- See Note [Delaying modFinalizers in untyped splices].\n           ; return ( HsPar noExt $ HsSpliceE noExt\n                            . HsSpliced noExt (ThModFinalizers mod_finalizers)\n                            . HsSplicedExpr <$>\n                            lexpr3\n                    , fvs)\n           }\n\n{- Note [Running splices in the Renamer]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nSplices used to be run in the typechecker, which led to (Trac #4364). Since the\nrenamer must decide which expressions depend on which others, and it cannot\nreliably do this for arbitrary splices, we used to conservatively say that\nsplices depend on all other expressions in scope. Unfortunately, this led to\nthe problem of cyclic type declarations seen in (Trac #4364). Instead, by\nrunning splices in the renamer, we side-step the problem of determining\ndependencies: by the time the dependency analysis happens, any splices have\nalready been run, and expression dependencies can be determined as usual.\n\nHowever, see (Trac #9813), for an example where we would like to run splices\n*after* performing dependency analysis (that is, after renaming). It would be\ndesirable to typecheck \"non-splicy\" expressions (those expressions that do not\ncontain splices directly or via dependence on an expression that does) before\n\"splicy\" expressions, such that types/expressions within the same declaration\ngroup would be available to `reify` calls, for example consider the following:\n\n> module M where\n>   data D = C\n>   f = 1\n>   g = $(mapM reify ['f, 'D, ''C] ...)\n\nCompilation of this example fails since D/C/f are not in the type environment\nand thus cannot be reified as they have not been typechecked by the time the\nsplice is renamed and thus run.\n\nThese requirements are at odds: we do not want to run splices in the renamer as\nwe wish to first determine dependencies and typecheck certain expressions,\nmaking them available to reify, but cannot accurately determine dependencies\nwithout running splices in the renamer!\n\nIndeed, the conclusion of (Trac #9813) was that it is not worth the complexity\nto try and\n a) implement and maintain the code for renaming/typechecking non-splicy\n    expressions before splicy expressions,\n b) explain to TH users which expressions are/not available to reify at any\n    given point.\n\n-}\n\n{- Note [Delaying modFinalizers in untyped splices]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen splices run in the renamer, 'reify' does not have access to the local\ntype environment (Trac #11832, [1]).\n\nFor instance, in\n\n> let x = e in $(reify (mkName \"x\") >>= runIO . print >> [| return () |])\n\n'reify' cannot find @x@, because the local type environment is not yet\npopulated. To address this, we allow 'reify' execution to be deferred with\n'addModFinalizer'.\n\n> let x = e in $(do addModFinalizer (reify (mkName \"x\") >>= runIO . print)\n                    [| return () |]\n                )\n\nThe finalizer is run with the local type environment when type checking is\ncomplete.\n\nSince the local type environment is not available in the renamer, we annotate\nthe tree at the splice point [2] with @HsSpliceE (HsSpliced finalizers e)@ where\n@e@ is the result of splicing and @finalizers@ are the finalizers that have been\ncollected during evaluation of the splice [3]. In our example,\n\n> HsLet\n>   (x = e)\n>   (HsSpliceE $ HsSpliced [reify (mkName \"x\") >>= runIO . print]\n>                          (HsSplicedExpr $ return ())\n>   )\n\nWhen the typechecker finds the annotation, it inserts the finalizers in the\nglobal environment and exposes the current local environment to them [4, 5, 6].\n\n> addModFinalizersWithLclEnv [reify (mkName \"x\") >>= runIO . print]\n\nReferences:\n\n[1] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify\n[2] 'rnSpliceExpr'\n[3] 'TcSplice.qAddModFinalizer'\n[4] 'TcExpr.tcExpr' ('HsSpliceE' ('HsSpliced' ...))\n[5] 'TcHsType.tc_hs_type' ('HsSpliceTy' ('HsSpliced' ...))\n[6] 'TcPat.tc_pat' ('SplicePat' ('HsSpliced' ...))\n\n-}\n\n----------------------\nrnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)\nrnSpliceType splice\n  = rnSpliceGen run_type_splice pend_type_splice splice\n  where\n    pend_type_splice rn_splice\n       = ( makePending UntypedTypeSplice rn_splice\n         , HsSpliceTy noExt rn_splice)\n\n    run_type_splice rn_splice\n      = do { traceRn \"rnSpliceType: untyped type splice\" empty\n           ; (hs_ty2, mod_finalizers) <-\n                runRnSplice UntypedTypeSplice runMetaT ppr rn_splice\n           ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2\n                                 ; checkNoErrs $ rnLHsType doc hs_ty2 }\n                                    -- checkNoErrs: see Note [Renamer errors]\n             -- See Note [Delaying modFinalizers in untyped splices].\n           ; return ( HsParTy noExt $ HsSpliceTy noExt\n                              . HsSpliced noExt (ThModFinalizers mod_finalizers)\n                              . HsSplicedTy <$>\n                              hs_ty3\n                    , fvs\n                    ) }\n              -- Wrap the result of the splice in parens so that we don't\n              -- lose the outermost location set by runQuasiQuote (#7918)\n\n{- Note [Partial Type Splices]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPartial Type Signatures are partially supported in TH type splices: only\nanonymous wild cards are allowed.\n\n  -- ToDo: SLPJ says: I don't understand all this\n\nNormally, named wild cards are collected before renaming a (partial) type\nsignature. However, TH type splices are run during renaming, i.e. after the\ninitial traversal, leading to out of scope errors for named wild cards. We\ncan't just extend the initial traversal to collect the named wild cards in TH\ntype splices, as we'd need to expand them, which is supposed to happen only\nonce, during renaming.\n\nSimilarly, the extra-constraints wild card is handled right before renaming\ntoo, and is therefore also not supported in a TH type splice. Another reason\nto forbid extra-constraints wild cards in TH type splices is that a single\nsignature can contain many TH type splices, whereas it mustn't contain more\nthan one extra-constraints wild card. Enforcing would this be hard the way\nthings are currently organised.\n\nAnonymous wild cards pose no problem, because they start out without names and\nare given names during renaming. These names are collected right after\nrenaming. The names generated for anonymous wild cards in TH type splices will\nthus be collected as well.\n\nFor more details about renaming wild cards, see RnTypes.rnHsSigWcType\n\nNote that partial type signatures are fully supported in TH declaration\nsplices, e.g.:\n\n     [d| foo :: _ => _\n         foo x y = x == y |]\n\nThis is because in this case, the partial type signature can be treated as a\nwhole signature, instead of as an arbitrary type.\n\n-}\n\n\n----------------------\n-- | Rename a splice pattern. See Note [rnSplicePat]\nrnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn)\n                                       , FreeVars)\nrnSplicePat splice\n  = rnSpliceGen run_pat_splice pend_pat_splice splice\n  where\n    pend_pat_splice :: HsSplice GhcRn ->\n                       (PendingRnSplice, Either b (Pat GhcRn))\n    pend_pat_splice rn_splice\n      = (makePending UntypedPatSplice rn_splice\n        , Right (SplicePat noExt rn_splice))\n\n    run_pat_splice :: HsSplice GhcRn ->\n                      RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)\n    run_pat_splice rn_splice\n      = do { traceRn \"rnSplicePat: untyped pattern splice\" empty\n           ; (pat, mod_finalizers) <-\n                runRnSplice UntypedPatSplice runMetaP ppr rn_splice\n             -- See Note [Delaying modFinalizers in untyped splices].\n           ; return ( Left $ ParPat noExt $ ((SplicePat noExt)\n                              . HsSpliced noExt (ThModFinalizers mod_finalizers)\n                              . HsSplicedPat)  `onHasSrcSpan`\n                              pat\n                    , emptyFVs\n                    ) }\n              -- Wrap the result of the quasi-quoter in parens so that we don't\n              -- lose the outermost location set by runQuasiQuote (#7918)\n\n----------------------\nrnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)\nrnSpliceDecl (SpliceDecl _ (dL->L loc splice) flg)\n  = rnSpliceGen run_decl_splice pend_decl_splice splice\n  where\n    pend_decl_splice rn_splice\n       = ( makePending UntypedDeclSplice rn_splice\n         , SpliceDecl noExt (cL loc rn_splice) flg)\n\n    run_decl_splice rn_splice = pprPanic \"rnSpliceDecl\" (ppr rn_splice)\nrnSpliceDecl (XSpliceDecl _) = panic \"rnSpliceDecl\"\n\nrnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)\n-- Declaration splice at the very top level of the module\nrnTopSpliceDecls splice\n   = do  { (rn_splice, fvs) <- checkNoErrs $\n                               setStage (Splice Untyped) $\n                               rnSplice splice\n           -- As always, be sure to checkNoErrs above lest we end up with\n           -- holes making it to typechecking, hence #12584.\n           --\n           -- Note that we cannot call checkNoErrs for the whole duration\n           -- of rnTopSpliceDecls. The reason is that checkNoErrs changes\n           -- the local environment to temporarily contain a new\n           -- reference to store errors, and add_mod_finalizers would\n           -- cause this reference to be stored after checkNoErrs finishes.\n           -- This is checked by test TH_finalizer.\n         ; traceRn \"rnTopSpliceDecls: untyped declaration splice\" empty\n         ; (decls, mod_finalizers) <- checkNoErrs $\n               runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice\n         ; add_mod_finalizers_now mod_finalizers\n         ; return (decls,fvs) }\n   where\n     ppr_decls :: [LHsDecl GhcPs] -> SDoc\n     ppr_decls ds = vcat (map ppr ds)\n\n     -- Adds finalizers to the global environment instead of delaying them\n     -- to the type checker.\n     --\n     -- Declaration splices do not have an interesting local environment so\n     -- there is no point in delaying them.\n     --\n     -- See Note [Delaying modFinalizers in untyped splices].\n     add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn ()\n     add_mod_finalizers_now []             = return ()\n     add_mod_finalizers_now mod_finalizers = do\n       th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv\n       env <- getLclEnv\n       updTcRef th_modfinalizers_var $ \\fins ->\n         (env, ThModFinalizers mod_finalizers) : fins\n\n\n{-\nNote [rnSplicePat]\n~~~~~~~~~~~~~~~~~~\nRenaming a pattern splice is a bit tricky, because we need the variables\nbound in the pattern to be in scope in the RHS of the pattern. This scope\nmanagement is effectively done by using continuation-passing style in\nRnPat, through the CpsRn monad. We don't wish to be in that monad here\n(it would create import cycles and generally conflict with renaming other\nsplices), so we really want to return a (Pat RdrName) -- the result of\nrunning the splice -- which can then be further renamed in RnPat, in\nthe CpsRn monad.\n\nThe problem is that if we're renaming a splice within a bracket, we\n*don't* want to run the splice now. We really do just want to rename\nit to an HsSplice Name. Of course, then we can't know what variables\nare bound within the splice. So we accept any unbound variables and\nrename them again when the bracket is spliced in.  If a variable is brought\ninto scope by a pattern splice all is fine.  If it is not then an error is\nreported.\n\nIn any case, when we're done in rnSplicePat, we'll either have a\nPat RdrName (the result of running a top-level splice) or a Pat Name\n(the renamed nested splice). Thus, the awkward return type of\nrnSplicePat.\n-}\n\nspliceCtxt :: HsSplice GhcPs -> SDoc\nspliceCtxt splice\n  = hang (text \"In the\" <+> what) 2 (ppr splice)\n  where\n    what = case splice of\n             HsUntypedSplice {} -> text \"untyped splice:\"\n             HsTypedSplice   {} -> text \"typed splice:\"\n             HsQuasiQuote    {} -> text \"quasi-quotation:\"\n             HsSpliced       {} -> text \"spliced expression:\"\n             HsSplicedT      {} -> text \"spliced expression:\"\n             XSplice         {} -> text \"spliced expression:\"\n\n-- | The splice data to be logged\ndata SpliceInfo\n  = SpliceInfo\n    { spliceDescription  :: String\n    , spliceSource       :: Maybe (LHsExpr GhcRn) -- Nothing <=> top-level decls\n                                                  --        added by addTopDecls\n    , spliceIsDecl       :: Bool    -- True <=> put the generate code in a file\n                                    --          when -dth-dec-file is on\n    , spliceGenerated    :: SDoc\n    }\n        -- Note that 'spliceSource' is *renamed* but not *typechecked*\n        -- Reason (a) less typechecking crap\n        --        (b) data constructors after type checking have been\n        --            changed to their *wrappers*, and that makes them\n        --            print always fully qualified\n\n-- | outputs splice information for 2 flags which have different output formats:\n-- `-ddump-splices` and `-dth-dec-file`\ntraceSplice :: SpliceInfo -> TcM ()\ntraceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src\n                        , spliceGenerated = gen, spliceIsDecl = is_decl })\n  = do { loc <- case mb_src of\n                   Nothing           -> getSrcSpanM\n                   Just (dL->L loc _) -> return loc\n       ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)\n\n       ; when is_decl $  -- Raw material for -dth-dec-file\n         do { dflags <- getDynFlags\n            ; liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file\n                                             (spliceCodeDoc loc) } }\n  where\n    -- `-ddump-splices`\n    spliceDebugDoc :: SrcSpan -> SDoc\n    spliceDebugDoc loc\n      = let code = case mb_src of\n                     Nothing -> ending\n                     Just e  -> nest 2 (ppr e) : ending\n            ending = [ text \"======>\", nest 2 gen ]\n        in  hang (ppr loc <> colon <+> text \"Splicing\" <+> text sd)\n               2 (sep code)\n\n    -- `-dth-dec-file`\n    spliceCodeDoc :: SrcSpan -> SDoc\n    spliceCodeDoc loc\n      = vcat [ text \"--\" <+> ppr loc <> colon <+> text \"Splicing\" <+> text sd\n             , gen ]\n\nillegalTypedSplice :: SDoc\nillegalTypedSplice = text \"Typed splices may not appear in untyped brackets\"\n\nillegalUntypedSplice :: SDoc\nillegalUntypedSplice = text \"Untyped splices may not appear in typed brackets\"\n\ncheckThLocalName :: Name -> RnM ()\ncheckThLocalName name\n  | isUnboundName name   -- Do not report two errors for\n  = return ()            --   $(not_in_scope args)\n\n  | otherwise\n  = do  { traceRn \"checkThLocalName\" (ppr name)\n        ; mb_local_use <- getStageAndBindLevel name\n        ; case mb_local_use of {\n             Nothing -> return () ;  -- Not a locally-bound thing\n             Just (top_lvl, bind_lvl, use_stage) ->\n    do  { let use_lvl = thLevel use_stage\n        ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl\n        ; traceRn \"checkThLocalName\" (ppr name <+> ppr bind_lvl\n                                               <+> ppr use_stage\n                                               <+> ppr use_lvl)\n        ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }\n\n--------------------------------------\ncheckCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel\n                       -> Name -> TcM ()\n-- We are inside brackets, and (use_lvl > bind_lvl)\n-- Now we must check whether there's a cross-stage lift to do\n-- Examples   \\x -> [| x |]\n--            [| map |]\n--\n-- This code is similar to checkCrossStageLifting in TcExpr, but\n-- this is only run on *untyped* brackets.\n\ncheckCrossStageLifting top_lvl bind_lvl use_stage use_lvl name\n  | Brack _ (RnPendingUntyped ps_var) <- use_stage   -- Only for untyped brackets\n  , use_lvl > bind_lvl                               -- Cross-stage condition\n  = check_cross_stage_lifting top_lvl name ps_var\n  | otherwise\n  = return ()\n\ncheck_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM ()\ncheck_cross_stage_lifting top_lvl name ps_var\n  | isTopLevel top_lvl\n        -- Top-level identifiers in this module,\n        -- (which have External Names)\n        -- are just like the imported case:\n        -- no need for the 'lifting' treatment\n        -- E.g.  this is fine:\n        --   f x = x\n        --   g y = [| f 3 |]\n  = when (isExternalName name) (keepAlive name)\n    -- See Note [Keeping things alive for Template Haskell]\n\n  | otherwise\n  =     -- Nested identifiers, such as 'x' in\n        -- E.g. \\x -> [| h x |]\n        -- We must behave as if the reference to x was\n        --      h $(lift x)\n        -- We use 'x' itself as the SplicePointName, used by\n        -- the desugarer to stitch it all back together.\n        -- If 'x' occurs many times we may get many identical\n        -- bindings of the same SplicePointName, but that doesn't\n        -- matter, although it's a mite untidy.\n    do  { traceRn \"checkCrossStageLifting\" (ppr name)\n\n          -- Construct the (lift x) expression\n        ; let lift_expr   = nlHsApp (nlHsVar liftName) (nlHsVar name)\n              pend_splice = PendingRnSplice UntypedExpSplice name lift_expr\n\n          -- Update the pending splices\n        ; ps <- readMutVar ps_var\n        ; writeMutVar ps_var (pend_splice : ps) }\n\n{-\nNote [Keeping things alive for Template Haskell]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  f x = x+1\n  g y = [| f 3 |]\n\nHere 'f' is referred to from inside the bracket, which turns into data\nand mentions only f's *name*, not 'f' itself. So we need some other\nway to keep 'f' alive, lest it get dropped as dead code.  That's what\nkeepAlive does. It puts it in the keep-alive set, which subsequently\nensures that 'f' stays as a top level binding.\n\nThis must be done by the renamer, not the type checker (as of old),\nbecause the type checker doesn't typecheck the body of untyped\nbrackets (Trac #8540).\n\nA thing can have a bind_lvl of outerLevel, but have an internal name:\n   foo = [d| op = 3\n             bop = op + 1 |]\nHere the bind_lvl of 'op' is (bogusly) outerLevel, even though it is\nbound inside a bracket.  That is because we don't even even record\nbinding levels for top-level things; the binding levels are in the\nLocalRdrEnv.\n\nSo the occurrence of 'op' in the rhs of 'bop' looks a bit like a\ncross-stage thing, but it isn't really.  And in fact we never need\nto do anything here for top-level bound things, so all is fine, if\na bit hacky.\n\nFor these chaps (which have Internal Names) we don't want to put\nthem in the keep-alive set.\n\nNote [Quoting names]\n~~~~~~~~~~~~~~~~~~~~\nA quoted name 'n is a bit like a quoted expression [| n |], except that we\nhave no cross-stage lifting (c.f. TcExpr.thBrackId).  So, after incrementing\nthe use-level to account for the brackets, the cases are:\n\n        bind > use                      Error\n        bind = use+1                    OK\n        bind < use\n                Imported things         OK\n                Top-level things        OK\n                Non-top-level           Error\n\nwhere 'use' is the binding level of the 'n quote. (So inside the implied\nbracket the level would be use+1.)\n\nExamples:\n\n  f 'map        -- OK; also for top-level defns of this module\n\n  \\x. f 'x      -- Not ok (bind = 1, use = 1)\n                -- (whereas \\x. f [| x |] might have been ok, by\n                --                               cross-stage lifting\n\n  \\y. [| \\x. $(f 'y) |] -- Not ok (bind =1, use = 1)\n\n  [| \\x. $(f 'x) |]     -- OK (bind = 2, use = 1)\n-}\n", "num_lines": 905}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[RnSource]{Main pass of renamer}\n-}\n\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule RnTypes (\n        -- Type related stuff\n        rnHsType, rnLHsType, rnLHsTypes, rnContext,\n        rnHsKind, rnLHsKind, rnLHsTypeArgs,\n        rnHsSigType, rnHsWcType,\n        HsSigWcTypeScoping(..), rnHsSigWcType, rnHsSigWcTypeScoped,\n        newTyVarNameRn,\n        rnConDeclFields,\n        rnLTyVar,\n\n        -- Precence related stuff\n        mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,\n        checkPrecMatch, checkSectionPrec,\n\n        -- Binding related stuff\n        bindLHsTyVarBndr, bindLHsTyVarBndrs, rnImplicitBndrs,\n        bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,\n        extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,\n        extractHsTysRdrTyVarsDups,\n        extractRdrKindSigVars, extractDataDefnKindVars,\n        extractHsTvBndrs, extractHsTyArgRdrKiTyVarsDup,\n        nubL, elemRdr\n  ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} RnSplice( rnSpliceType )\n\nimport DynFlags\nimport HsSyn\nimport RnHsDoc          ( rnLHsDoc, rnMbLHsDoc )\nimport RnEnv\nimport RnUtils          ( HsDocContext(..), withHsDocContext, mapFvRn\n                        , pprHsDocContext, bindLocalNamesFV, typeAppErr\n                        , newLocalBndrRn, checkDupRdrNames, checkShadowedRdrNames )\nimport RnFixity         ( lookupFieldFixityRn, lookupFixityRn\n                        , lookupTyFixityRn )\nimport TcRnMonad\nimport RdrName\nimport PrelNames\nimport TysPrim          ( funTyConName )\nimport Name\nimport SrcLoc\nimport NameSet\nimport FieldLabel\n\nimport Util\nimport ListSetOps       ( deleteBys )\nimport BasicTypes       ( compareFixity, funTyFixity, negateFixity,\n                          Fixity(..), FixityDirection(..), LexicalFixity(..) )\nimport Outputable\nimport FastString\nimport Maybes\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.List          ( nubBy, partition, (\\\\) )\nimport Control.Monad      ( unless, when )\n\n#include \"HsVersions.h\"\n\n{-\nThese type renamers are in a separate module, rather than in (say) RnSource,\nto break several loop.\n\n*********************************************************\n*                                                       *\n           HsSigWcType (i.e with wildcards)\n*                                                       *\n*********************************************************\n-}\n\ndata HsSigWcTypeScoping = AlwaysBind\n                          -- ^ Always bind any free tyvars of the given type,\n                          --   regardless of whether we have a forall at the top\n                        | BindUnlessForall\n                          -- ^ Unless there's forall at the top, do the same\n                          --   thing as 'AlwaysBind'\n                        | NeverBind\n                          -- ^ Never bind any free tyvars\n\nrnHsSigWcType :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs\n              -> RnM (LHsSigWcType GhcRn, FreeVars)\nrnHsSigWcType scoping doc sig_ty\n  = rn_hs_sig_wc_type scoping doc sig_ty $ \\sig_ty' ->\n    return (sig_ty', emptyFVs)\n\nrnHsSigWcTypeScoped :: HsSigWcTypeScoping\n                       -- AlwaysBind: for pattern type sigs and rules we /do/ want\n                       --             to bring those type variables into scope, even\n                       --             if there's a forall at the top which usually\n                       --             stops that happening\n                       -- e.g  \\ (x :: forall a. a-> b) -> e\n                       -- Here we do bring 'b' into scope\n                    -> HsDocContext -> LHsSigWcType GhcPs\n                    -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))\n                    -> RnM (a, FreeVars)\n-- Used for\n--   - Signatures on binders in a RULE\n--   - Pattern type signatures\n-- Wildcards are allowed\n-- type signatures on binders only allowed with ScopedTypeVariables\nrnHsSigWcTypeScoped scoping ctx sig_ty thing_inside\n  = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables\n       ; checkErr ty_sig_okay (unexpectedTypeSigErr sig_ty)\n       ; rn_hs_sig_wc_type scoping ctx sig_ty thing_inside\n       }\n\nrn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs\n                  -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))\n                  -> RnM (a, FreeVars)\n-- rn_hs_sig_wc_type is used for source-language type signatures\nrn_hs_sig_wc_type scoping ctxt\n                  (HsWC { hswc_body = HsIB { hsib_body = hs_ty }})\n                  thing_inside\n  = do { free_vars <- extractFilteredRdrTyVarsDups hs_ty\n       ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars\n       ; let nwc_rdrs = nubL nwc_rdrs'\n             bind_free_tvs = case scoping of\n                               AlwaysBind       -> True\n                               BindUnlessForall -> not (isLHsForAllTy hs_ty)\n                               NeverBind        -> False\n       ; rnImplicitBndrs bind_free_tvs tv_rdrs $ \\ vars ->\n    do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty\n       ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = ib_ty' }\n             ib_ty'  = HsIB { hsib_ext = vars\n                            , hsib_body = hs_ty' }\n       ; (res, fvs2) <- thing_inside sig_ty'\n       ; return (res, fvs1 `plusFV` fvs2) } }\nrn_hs_sig_wc_type _ _ (HsWC _ (XHsImplicitBndrs _)) _\n  = panic \"rn_hs_sig_wc_type\"\nrn_hs_sig_wc_type _ _ (XHsWildCardBndrs _) _\n  = panic \"rn_hs_sig_wc_type\"\n\nrnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)\nrnHsWcType ctxt (HsWC { hswc_body = hs_ty })\n  = do { free_vars <- extractFilteredRdrTyVars hs_ty\n       ; (nwc_rdrs, _) <- partition_nwcs free_vars\n       ; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty\n       ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' }\n       ; return (sig_ty', fvs) }\nrnHsWcType _ (XHsWildCardBndrs _) = panic \"rnHsWcType\"\n\nrnWcBody :: HsDocContext -> [Located RdrName] -> LHsType GhcPs\n         -> RnM ([Name], LHsType GhcRn, FreeVars)\nrnWcBody ctxt nwc_rdrs hs_ty\n  = do { nwcs <- mapM newLocalBndrRn nwc_rdrs\n       ; let env = RTKE { rtke_level = TypeLevel\n                        , rtke_what  = RnTypeBody\n                        , rtke_nwcs  = mkNameSet nwcs\n                        , rtke_ctxt  = ctxt }\n       ; (hs_ty', fvs) <- bindLocalNamesFV nwcs $\n                          rn_lty env hs_ty\n       ; return (nwcs, hs_ty', fvs) }\n  where\n    rn_lty env (dL->L loc hs_ty)\n      = setSrcSpan loc $\n        do { (hs_ty', fvs) <- rn_ty env hs_ty\n           ; return (cL loc hs_ty', fvs) }\n\n    rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)\n    -- A lot of faff just to allow the extra-constraints wildcard to appear\n    rn_ty env hs_ty@(HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs\n                                , hst_body = hs_body })\n      = bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc hs_ty) Nothing tvs $ \\ tvs' ->\n        do { (hs_body', fvs) <- rn_lty env hs_body\n           ; return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExt\n                                , hst_bndrs = tvs', hst_body = hs_body' }\n                    , fvs) }\n\n    rn_ty env (HsQualTy { hst_ctxt = dL->L cx hs_ctxt\n                        , hst_body = hs_ty })\n      | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt\n      , (dL->L lx (HsWildCardTy _))  <- ignoreParens hs_ctxt_last\n      = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1\n           ; setSrcSpan lx $ checkExtraConstraintWildCard env hs_ctxt1\n           ; let hs_ctxt' = hs_ctxt1' ++ [cL lx (HsWildCardTy noExt)]\n           ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty\n           ; return (HsQualTy { hst_xqual = noExt\n                              , hst_ctxt = cL cx hs_ctxt', hst_body = hs_ty' }\n                    , fvs1 `plusFV` fvs2) }\n\n      | otherwise\n      = do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt\n           ; (hs_ty', fvs2)   <- rnLHsTyKi env hs_ty\n           ; return (HsQualTy { hst_xqual = noExt\n                              , hst_ctxt = cL cx hs_ctxt'\n                              , hst_body = hs_ty' }\n                    , fvs1 `plusFV` fvs2) }\n\n    rn_ty env hs_ty = rnHsTyKi env hs_ty\n\n    rn_top_constraint env = rnLHsTyKi (env { rtke_what = RnTopConstraint })\n\n\ncheckExtraConstraintWildCard :: RnTyKiEnv -> HsContext GhcPs -> RnM ()\n-- Rename the extra-constraint spot in a type signature\n--    (blah, _) => type\n-- Check that extra-constraints are allowed at all, and\n-- if so that it's an anonymous wildcard\ncheckExtraConstraintWildCard env hs_ctxt\n  = checkWildCard env mb_bad\n  where\n    mb_bad | not (extraConstraintWildCardsAllowed env)\n           = Just base_msg\n             -- Currently, we do not allow wildcards in their full glory in\n             -- standalone deriving declarations. We only allow a single\n             -- extra-constraints wildcard \u00c3\u00a0 la:\n             --\n             --   deriving instance _ => Eq (Foo a)\n             --\n             -- i.e., we don't support things like\n             --\n             --   deriving instance (Eq a, _) => Eq (Foo a)\n           | DerivDeclCtx {} <- rtke_ctxt env\n           , not (null hs_ctxt)\n           = Just deriv_decl_msg\n           | otherwise\n           = Nothing\n\n    base_msg = text \"Extra-constraint wildcard\" <+> quotes pprAnonWildCard\n                   <+> text \"not allowed\"\n\n    deriv_decl_msg\n      = hang base_msg\n           2 (vcat [ text \"except as the sole constraint\"\n                   , nest 2 (text \"e.g., deriving instance _ => Eq (Foo a)\") ])\n\nextraConstraintWildCardsAllowed :: RnTyKiEnv -> Bool\nextraConstraintWildCardsAllowed env\n  = case rtke_ctxt env of\n      TypeSigCtx {}       -> True\n      ExprWithTySigCtx {} -> True\n      DerivDeclCtx {}     -> True\n      _                   -> False\n\n-- | Finds free type and kind variables in a type,\n--     without duplicates, and\n--     without variables that are already in scope in LocalRdrEnv\n--   NB: this includes named wildcards, which look like perfectly\n--       ordinary type variables at this point\nextractFilteredRdrTyVars :: LHsType GhcPs -> RnM FreeKiTyVarsNoDups\nextractFilteredRdrTyVars hs_ty = filterInScopeM (extractHsTyRdrTyVars hs_ty)\n\n-- | Finds free type and kind variables in a type,\n--     with duplicates, but\n--     without variables that are already in scope in LocalRdrEnv\n--   NB: this includes named wildcards, which look like perfectly\n--       ordinary type variables at this point\nextractFilteredRdrTyVarsDups :: LHsType GhcPs -> RnM FreeKiTyVarsWithDups\nextractFilteredRdrTyVarsDups hs_ty = filterInScopeM (extractHsTyRdrTyVarsDups hs_ty)\n\n-- | When the NamedWildCards extension is enabled, partition_nwcs\n-- removes type variables that start with an underscore from the\n-- FreeKiTyVars in the argument and returns them in a separate list.\n-- When the extension is disabled, the function returns the argument\n-- and empty list.  See Note [Renaming named wild cards]\npartition_nwcs :: FreeKiTyVars -> RnM ([Located RdrName], FreeKiTyVars)\npartition_nwcs free_vars\n  = do { wildcards_enabled <- xoptM LangExt.NamedWildCards\n       ; return $\n           if wildcards_enabled\n           then partition is_wildcard free_vars\n           else ([], free_vars) }\n  where\n     is_wildcard :: Located RdrName -> Bool\n     is_wildcard rdr = startsWithUnderscore (rdrNameOcc (unLoc rdr))\n\n{- Note [Renaming named wild cards]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIdentifiers starting with an underscore are always parsed as type variables.\nIt is only here in the renamer that we give the special treatment.\nSee Note [The wildcard story for types] in HsTypes.\n\nIt's easy!  When we collect the implicitly bound type variables, ready\nto bring them into scope, and NamedWildCards is on, we partition the\nvariables into the ones that start with an underscore (the named\nwildcards) and the rest. Then we just add them to the hswc_wcs field\nof the HsWildCardBndrs structure, and we are done.\n\n\n*********************************************************\n*                                                       *\n           HsSigtype (i.e. no wildcards)\n*                                                       *\n****************************************************** -}\n\nrnHsSigType :: HsDocContext -> LHsSigType GhcPs\n            -> RnM (LHsSigType GhcRn, FreeVars)\n-- Used for source-language type signatures\n-- that cannot have wildcards\nrnHsSigType ctx (HsIB { hsib_body = hs_ty })\n  = do { traceRn \"rnHsSigType\" (ppr hs_ty)\n       ; vars <- extractFilteredRdrTyVarsDups hs_ty\n       ; rnImplicitBndrs (not (isLHsForAllTy hs_ty)) vars $ \\ vars ->\n    do { (body', fvs) <- rnLHsType ctx hs_ty\n       ; return ( HsIB { hsib_ext = vars\n                       , hsib_body = body' }\n                , fvs ) } }\nrnHsSigType _ (XHsImplicitBndrs _) = panic \"rnHsSigType\"\n\nrnImplicitBndrs :: Bool    -- True <=> bring into scope any free type variables\n                           -- E.g.  f :: forall a. a->b\n                           --  we do not want to bring 'b' into scope, hence False\n                           -- But   f :: a -> b\n                           --  we want to bring both 'a' and 'b' into scope\n                -> FreeKiTyVarsWithDups\n                                   -- Free vars of hs_ty (excluding wildcards)\n                                   -- May have duplicates, which is\n                                   -- checked here\n                -> ([Name] -> RnM (a, FreeVars))\n                -> RnM (a, FreeVars)\nrnImplicitBndrs bind_free_tvs\n                fvs_with_dups\n                thing_inside\n  = do { let fvs = nubL fvs_with_dups\n             real_fvs | bind_free_tvs = fvs\n                      | otherwise     = []\n\n       ; traceRn \"rnImplicitBndrs\" $\n         vcat [ ppr fvs_with_dups, ppr fvs, ppr real_fvs ]\n\n       ; loc <- getSrcSpanM\n       ; vars <- mapM (newLocalBndrRn . cL loc . unLoc) real_fvs\n\n       ; bindLocalNamesFV vars $\n         thing_inside vars }\n\n{- ******************************************************\n*                                                       *\n           LHsType and HsType\n*                                                       *\n****************************************************** -}\n\n{-\nrnHsType is here because we call it from loadInstDecl, and I didn't\nwant a gratuitous knot.\n\nNote [Context quantification]\n-----------------------------\nVariables in type signatures are implicitly quantified\nwhen (1) they are in a type signature not beginning\nwith \"forall\" or (2) in any qualified type T => R.\nWe are phasing out (2) since it leads to inconsistencies\n(Trac #4426):\n\ndata A = A (a -> a)           is an error\ndata A = A (Eq a => a -> a)   binds \"a\"\ndata A = A (Eq a => a -> b)   binds \"a\" and \"b\"\ndata A = A (() => a -> b)     binds \"a\" and \"b\"\nf :: forall a. a -> b         is an error\nf :: forall a. () => a -> b   is an error\nf :: forall a. a -> (() => b) binds \"a\" and \"b\"\n\nThis situation is now considered to be an error. See rnHsTyKi for case\nHsForAllTy Qualified.\n\nNote [QualTy in kinds]\n~~~~~~~~~~~~~~~~~~~~~~\nI was wondering whether QualTy could occur only at TypeLevel.  But no,\nwe can have a qualified type in a kind too. Here is an example:\n\n  type family F a where\n    F Bool = Nat\n    F Nat  = Type\n\n  type family G a where\n    G Type = Type -> Type\n    G ()   = Nat\n\n  data X :: forall k1 k2. (F k1 ~ G k2) => k1 -> k2 -> Type where\n    MkX :: X 'True '()\n\nSee that k1 becomes Bool and k2 becomes (), so the equality is\nsatisfied. If I write MkX :: X 'True 'False, compilation fails with a\nsuitable message:\n\n  MkX :: X 'True '()\n    \u00e2\u20ac\u00a2 Couldn't match kind \u00e2\u20ac\u02dcG Bool\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dcNat\u00e2\u20ac\u2122\n      Expected kind: G Bool\n        Actual kind: F Bool\n\nHowever: in a kind, the constraints in the QualTy must all be\nequalities; or at least, any kinds with a class constraint are\nuninhabited.\n-}\n\ndata RnTyKiEnv\n  = RTKE { rtke_ctxt  :: HsDocContext\n         , rtke_level :: TypeOrKind  -- Am I renaming a type or a kind?\n         , rtke_what  :: RnTyKiWhat  -- And within that what am I renaming?\n         , rtke_nwcs  :: NameSet     -- These are the in-scope named wildcards\n    }\n\ndata RnTyKiWhat = RnTypeBody\n                | RnTopConstraint   -- Top-level context of HsSigWcTypes\n                | RnConstraint      -- All other constraints\n\ninstance Outputable RnTyKiEnv where\n  ppr (RTKE { rtke_level = lev, rtke_what = what\n            , rtke_nwcs = wcs, rtke_ctxt = ctxt })\n    = text \"RTKE\"\n      <+> braces (sep [ ppr lev, ppr what, ppr wcs\n                      , pprHsDocContext ctxt ])\n\ninstance Outputable RnTyKiWhat where\n  ppr RnTypeBody      = text \"RnTypeBody\"\n  ppr RnTopConstraint = text \"RnTopConstraint\"\n  ppr RnConstraint    = text \"RnConstraint\"\n\nmkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv\nmkTyKiEnv cxt level what\n = RTKE { rtke_level = level, rtke_nwcs = emptyNameSet\n        , rtke_what = what, rtke_ctxt = cxt }\n\nisRnKindLevel :: RnTyKiEnv -> Bool\nisRnKindLevel (RTKE { rtke_level = KindLevel }) = True\nisRnKindLevel _                                 = False\n\n--------------\nrnLHsType  :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)\nrnLHsType ctxt ty = rnLHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty\n\nrnLHsTypes :: HsDocContext -> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)\nrnLHsTypes doc tys = mapFvRn (rnLHsType doc) tys\n\nrnHsType  :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)\nrnHsType ctxt ty = rnHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty\n\nrnLHsKind  :: HsDocContext -> LHsKind GhcPs -> RnM (LHsKind GhcRn, FreeVars)\nrnLHsKind ctxt kind = rnLHsTyKi (mkTyKiEnv ctxt KindLevel RnTypeBody) kind\n\nrnHsKind  :: HsDocContext -> HsKind GhcPs -> RnM (HsKind GhcRn, FreeVars)\nrnHsKind ctxt kind = rnHsTyKi  (mkTyKiEnv ctxt KindLevel RnTypeBody) kind\n\n-- renaming a type only, not a kind\nrnLHsTypeArg :: HsDocContext -> LHsTypeArg GhcPs\n                -> RnM (LHsTypeArg GhcRn, FreeVars)\nrnLHsTypeArg ctxt (HsValArg ty)\n   = do { (tys_rn, fvs) <- rnLHsType ctxt ty\n        ; return (HsValArg tys_rn, fvs) }\nrnLHsTypeArg ctxt (HsTypeArg l ki)\n   = do { (kis_rn, fvs) <- rnLHsKind ctxt ki\n        ; return (HsTypeArg l kis_rn, fvs) }\nrnLHsTypeArg _ (HsArgPar sp)\n   = return (HsArgPar sp, emptyFVs)\n\nrnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs]\n                 -> RnM ([LHsTypeArg GhcRn], FreeVars)\nrnLHsTypeArgs doc args = mapFvRn (rnLHsTypeArg doc) args\n\n--------------\nrnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs\n              -> RnM (LHsContext GhcRn, FreeVars)\nrnTyKiContext env (dL->L loc cxt)\n  = do { traceRn \"rncontext\" (ppr cxt)\n       ; let env' = env { rtke_what = RnConstraint }\n       ; (cxt', fvs) <- mapFvRn (rnLHsTyKi env') cxt\n       ; return (cL loc cxt', fvs) }\n\nrnContext :: HsDocContext -> LHsContext GhcPs\n          -> RnM (LHsContext GhcRn, FreeVars)\nrnContext doc theta = rnTyKiContext (mkTyKiEnv doc TypeLevel RnConstraint) theta\n\n--------------\nrnLHsTyKi  :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)\nrnLHsTyKi env (dL->L loc ty)\n  = setSrcSpan loc $\n    do { (ty', fvs) <- rnHsTyKi env ty\n       ; return (cL loc ty', fvs) }\n\nrnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)\n\nrnHsTyKi env ty@(HsForAllTy { hst_fvf = fvf, hst_bndrs = tyvars\n                            , hst_body = tau })\n  = do { checkPolyKinds env ty\n       ; bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc ty)\n                           Nothing tyvars $ \\ tyvars' ->\n    do { (tau',  fvs) <- rnLHsTyKi env tau\n       ; return ( HsForAllTy { hst_fvf = fvf, hst_xforall = noExt\n                             , hst_bndrs = tyvars' , hst_body =  tau' }\n                , fvs) } }\n\nrnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })\n  = do { checkPolyKinds env ty  -- See Note [QualTy in kinds]\n       ; (ctxt', fvs1) <- rnTyKiContext env lctxt\n       ; (tau',  fvs2) <- rnLHsTyKi env tau\n       ; return (HsQualTy { hst_xqual = noExt, hst_ctxt = ctxt'\n                          , hst_body =  tau' }\n                , fvs1 `plusFV` fvs2) }\n\nrnHsTyKi env (HsTyVar _ ip (dL->L loc rdr_name))\n  = do { when (isRnKindLevel env && isRdrTyVar rdr_name) $\n         unlessXOptM LangExt.PolyKinds $ addErr $\n         withHsDocContext (rtke_ctxt env) $\n         vcat [ text \"Unexpected kind variable\" <+> quotes (ppr rdr_name)\n              , text \"Perhaps you intended to use PolyKinds\" ]\n           -- Any type variable at the kind level is illegal without the use\n           -- of PolyKinds (see #14710)\n       ; name <- rnTyVar env rdr_name\n       ; return (HsTyVar noExt ip (cL loc name), unitFV name) }\n\nrnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2)\n  = setSrcSpan (getLoc l_op) $\n    do  { (l_op', fvs1) <- rnHsTyOp env ty l_op\n        ; fix   <- lookupTyFixityRn l_op'\n        ; (ty1', fvs2) <- rnLHsTyKi env ty1\n        ; (ty2', fvs3) <- rnLHsTyKi env ty2\n        ; res_ty <- mkHsOpTyRn (\\t1 t2 -> HsOpTy noExt t1 l_op' t2)\n                               (unLoc l_op') fix ty1' ty2'\n        ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) }\n\nrnHsTyKi env (HsParTy _ ty)\n  = do { (ty', fvs) <- rnLHsTyKi env ty\n       ; return (HsParTy noExt ty', fvs) }\n\nrnHsTyKi env (HsBangTy _ b ty)\n  = do { (ty', fvs) <- rnLHsTyKi env ty\n       ; return (HsBangTy noExt b ty', fvs) }\n\nrnHsTyKi env ty@(HsRecTy _ flds)\n  = do { let ctxt = rtke_ctxt env\n       ; fls          <- get_fields ctxt\n       ; (flds', fvs) <- rnConDeclFields ctxt fls flds\n       ; return (HsRecTy noExt flds', fvs) }\n  where\n    get_fields (ConDeclCtx names)\n      = concatMapM (lookupConstructorFields . unLoc) names\n    get_fields _\n      = do { addErr (hang (text \"Record syntax is illegal here:\")\n                                   2 (ppr ty))\n           ; return [] }\n\nrnHsTyKi env (HsFunTy _ ty1 ty2)\n  = do { (ty1', fvs1) <- rnLHsTyKi env ty1\n        -- Might find a for-all as the arg of a function type\n       ; (ty2', fvs2) <- rnLHsTyKi env ty2\n        -- Or as the result.  This happens when reading Prelude.hi\n        -- when we find return :: forall m. Monad m -> forall a. a -> m a\n\n        -- Check for fixity rearrangements\n       ; res_ty <- mkHsOpTyRn (HsFunTy noExt) funTyConName funTyFixity ty1' ty2'\n       ; return (res_ty, fvs1 `plusFV` fvs2) }\n\nrnHsTyKi env listTy@(HsListTy _ ty)\n  = do { data_kinds <- xoptM LangExt.DataKinds\n       ; when (not data_kinds && isRnKindLevel env)\n              (addErr (dataKindsErr env listTy))\n       ; (ty', fvs) <- rnLHsTyKi env ty\n       ; return (HsListTy noExt ty', fvs) }\n\nrnHsTyKi env t@(HsKindSig _ ty k)\n  = do { checkPolyKinds env t\n       ; kind_sigs_ok <- xoptM LangExt.KindSignatures\n       ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty)\n       ; (ty', fvs1) <- rnLHsTyKi env ty\n       ; (k', fvs2)  <- rnLHsTyKi (env { rtke_level = KindLevel }) k\n       ; return (HsKindSig noExt ty' k', fvs1 `plusFV` fvs2) }\n\n-- Unboxed tuples are allowed to have poly-typed arguments.  These\n-- sometimes crop up as a result of CPR worker-wrappering dictionaries.\nrnHsTyKi env tupleTy@(HsTupleTy _ tup_con tys)\n  = do { data_kinds <- xoptM LangExt.DataKinds\n       ; when (not data_kinds && isRnKindLevel env)\n              (addErr (dataKindsErr env tupleTy))\n       ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys\n       ; return (HsTupleTy noExt tup_con tys', fvs) }\n\nrnHsTyKi env sumTy@(HsSumTy _ tys)\n  = do { data_kinds <- xoptM LangExt.DataKinds\n       ; when (not data_kinds && isRnKindLevel env)\n              (addErr (dataKindsErr env sumTy))\n       ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys\n       ; return (HsSumTy noExt tys', fvs) }\n\n-- Ensure that a type-level integer is nonnegative (#8306, #8412)\nrnHsTyKi env tyLit@(HsTyLit _ t)\n  = do { data_kinds <- xoptM LangExt.DataKinds\n       ; unless data_kinds (addErr (dataKindsErr env tyLit))\n       ; when (negLit t) (addErr negLitErr)\n       ; checkPolyKinds env tyLit\n       ; return (HsTyLit noExt t, emptyFVs) }\n  where\n    negLit (HsStrTy _ _) = False\n    negLit (HsNumTy _ i) = i < 0\n    negLitErr = text \"Illegal literal in type (type literals must not be negative):\" <+> ppr tyLit\n\nrnHsTyKi env (HsAppTy _ ty1 ty2)\n  = do { (ty1', fvs1) <- rnLHsTyKi env ty1\n       ; (ty2', fvs2) <- rnLHsTyKi env ty2\n       ; return (HsAppTy noExt ty1' ty2', fvs1 `plusFV` fvs2) }\n\nrnHsTyKi env (HsAppKindTy l ty k)\n  = do { kind_app <- xoptM LangExt.TypeApplications\n       ; unless kind_app (addErr (typeAppErr \"kind\" k))\n       ; (ty', fvs1) <- rnLHsTyKi env ty\n       ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k\n       ; return (HsAppKindTy l ty' k', fvs1 `plusFV` fvs2) }\n\nrnHsTyKi env t@(HsIParamTy _ n ty)\n  = do { notInKinds env t\n       ; (ty', fvs) <- rnLHsTyKi env ty\n       ; return (HsIParamTy noExt n ty', fvs) }\n\nrnHsTyKi _ (HsStarTy _ isUni)\n  = return (HsStarTy noExt isUni, emptyFVs)\n\nrnHsTyKi _ (HsSpliceTy _ sp)\n  = rnSpliceType sp\n\nrnHsTyKi env (HsDocTy _ ty haddock_doc)\n  = do { (ty', fvs) <- rnLHsTyKi env ty\n       ; haddock_doc' <- rnLHsDoc haddock_doc\n       ; return (HsDocTy noExt ty' haddock_doc', fvs) }\n\nrnHsTyKi _ (XHsType (NHsCoreTy ty))\n  = return (XHsType (NHsCoreTy ty), emptyFVs)\n    -- The emptyFVs probably isn't quite right\n    -- but I don't think it matters\n\nrnHsTyKi env ty@(HsExplicitListTy _ ip tys)\n  = do { checkPolyKinds env ty\n       ; data_kinds <- xoptM LangExt.DataKinds\n       ; unless data_kinds (addErr (dataKindsErr env ty))\n       ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys\n       ; return (HsExplicitListTy noExt ip tys', fvs) }\n\nrnHsTyKi env ty@(HsExplicitTupleTy _ tys)\n  = do { checkPolyKinds env ty\n       ; data_kinds <- xoptM LangExt.DataKinds\n       ; unless data_kinds (addErr (dataKindsErr env ty))\n       ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys\n       ; return (HsExplicitTupleTy noExt tys', fvs) }\n\nrnHsTyKi env (HsWildCardTy _)\n  = do { checkAnonWildCard env\n       ; return (HsWildCardTy noExt, emptyFVs) }\n\n--------------\nrnTyVar :: RnTyKiEnv -> RdrName -> RnM Name\nrnTyVar env rdr_name\n  = do { name <- lookupTypeOccRn rdr_name\n       ; checkNamedWildCard env name\n       ; return name }\n\nrnLTyVar :: Located RdrName -> RnM (Located Name)\n-- Called externally; does not deal with wildards\nrnLTyVar (dL->L loc rdr_name)\n  = do { tyvar <- lookupTypeOccRn rdr_name\n       ; return (cL loc tyvar) }\n\n--------------\nrnHsTyOp :: Outputable a\n         => RnTyKiEnv -> a -> Located RdrName\n         -> RnM (Located Name, FreeVars)\nrnHsTyOp env overall_ty (dL->L loc op)\n  = do { ops_ok <- xoptM LangExt.TypeOperators\n       ; op' <- rnTyVar env op\n       ; unless (ops_ok || op' `hasKey` eqTyConKey) $\n           addErr (opTyErr op overall_ty)\n       ; let l_op' = cL loc op'\n       ; return (l_op', unitFV op') }\n\n--------------\nnotAllowed :: SDoc -> SDoc\nnotAllowed doc\n  = text \"Wildcard\" <+> quotes doc <+> ptext (sLit \"not allowed\")\n\ncheckWildCard :: RnTyKiEnv -> Maybe SDoc -> RnM ()\ncheckWildCard env (Just doc)\n  = addErr $ vcat [doc, nest 2 (text \"in\" <+> pprHsDocContext (rtke_ctxt env))]\ncheckWildCard _ Nothing\n  = return ()\n\ncheckAnonWildCard :: RnTyKiEnv -> RnM ()\n-- Report an error if an anonymous wildcard is illegal here\ncheckAnonWildCard env\n  = checkWildCard env mb_bad\n  where\n    mb_bad :: Maybe SDoc\n    mb_bad | not (wildCardsAllowed env)\n           = Just (notAllowed pprAnonWildCard)\n           | otherwise\n           = case rtke_what env of\n               RnTypeBody      -> Nothing\n               RnConstraint    -> Just constraint_msg\n               RnTopConstraint -> Just constraint_msg\n\n    constraint_msg = hang\n                         (notAllowed pprAnonWildCard <+> text \"in a constraint\")\n                        2 hint_msg\n    hint_msg = vcat [ text \"except as the last top-level constraint of a type signature\"\n                    , nest 2 (text \"e.g  f :: (Eq a, _) => blah\") ]\n\ncheckNamedWildCard :: RnTyKiEnv -> Name -> RnM ()\n-- Report an error if a named wildcard is illegal here\ncheckNamedWildCard env name\n  = checkWildCard env mb_bad\n  where\n    mb_bad | not (name `elemNameSet` rtke_nwcs env)\n           = Nothing  -- Not a wildcard\n           | not (wildCardsAllowed env)\n           = Just (notAllowed (ppr name))\n           | otherwise\n           = case rtke_what env of\n               RnTypeBody      -> Nothing   -- Allowed\n               RnTopConstraint -> Nothing   -- Allowed\n               RnConstraint    -> Just constraint_msg\n    constraint_msg = notAllowed (ppr name) <+> text \"in a constraint\"\n\nwildCardsAllowed :: RnTyKiEnv -> Bool\n-- ^ In what contexts are wildcards permitted\nwildCardsAllowed env\n   = case rtke_ctxt env of\n       TypeSigCtx {}       -> True\n       TypBrCtx {}         -> True   -- Template Haskell quoted type\n       SpliceTypeCtx {}    -> True   -- Result of a Template Haskell splice\n       ExprWithTySigCtx {} -> True\n       PatCtx {}           -> True\n       RuleCtx {}          -> True\n       FamPatCtx {}        -> True   -- Not named wildcards though\n       GHCiCtx {}          -> True\n       HsTypeCtx {}        -> True\n       _                   -> False\n\n\n\n---------------\n-- | Ensures either that we're in a type or that -XPolyKinds is set\ncheckPolyKinds :: Outputable ty\n                => RnTyKiEnv\n                -> ty      -- ^ type\n                -> RnM ()\ncheckPolyKinds env ty\n  | isRnKindLevel env\n  = do { polykinds <- xoptM LangExt.PolyKinds\n       ; unless polykinds $\n         addErr (text \"Illegal kind:\" <+> ppr ty $$\n                 text \"Did you mean to enable PolyKinds?\") }\ncheckPolyKinds _ _ = return ()\n\nnotInKinds :: Outputable ty\n           => RnTyKiEnv\n           -> ty\n           -> RnM ()\nnotInKinds env ty\n  | isRnKindLevel env\n  = addErr (text \"Illegal kind:\" <+> ppr ty)\nnotInKinds _ _ = return ()\n\n{- *****************************************************\n*                                                      *\n          Binding type variables\n*                                                      *\n***************************************************** -}\n\nbindSigTyVarsFV :: [Name]\n                -> RnM (a, FreeVars)\n                -> RnM (a, FreeVars)\n-- Used just before renaming the defn of a function\n-- with a separate type signature, to bring its tyvars into scope\n-- With no -XScopedTypeVariables, this is a no-op\nbindSigTyVarsFV tvs thing_inside\n  = do  { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables\n        ; if not scoped_tyvars then\n                thing_inside\n          else\n                bindLocalNamesFV tvs thing_inside }\n\n-- | Simply bring a bunch of RdrNames into scope. No checking for\n-- validity, at all. The binding location is taken from the location\n-- on each name.\nbindLRdrNames :: [Located RdrName]\n              -> ([Name] -> RnM (a, FreeVars))\n              -> RnM (a, FreeVars)\nbindLRdrNames rdrs thing_inside\n  = do { var_names <- mapM (newTyVarNameRn Nothing) rdrs\n       ; bindLocalNamesFV var_names $\n         thing_inside var_names }\n\n---------------\nbindHsQTyVars :: forall a b.\n                 HsDocContext\n              -> Maybe SDoc         -- Just d => check for unused tvs\n                                    --   d is a phrase like \"in the type ...\"\n              -> Maybe a            -- Just _  => an associated type decl\n              -> [Located RdrName]  -- Kind variables from scope, no dups\n              -> (LHsQTyVars GhcPs)\n              -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))\n                  -- The Bool is True <=> all kind variables used in the\n                  -- kind signature are bound on the left.  Reason:\n                  -- the last clause of Note [CUSKs: Complete user-supplied\n                  -- kind signatures] in HsDecls\n              -> RnM (b, FreeVars)\n\n-- See Note [bindHsQTyVars examples]\n-- (a) Bring kind variables into scope\n--     both (i)  passed in body_kv_occs\n--     and  (ii) mentioned in the kinds of hsq_bndrs\n-- (b) Bring type variables into scope\n--\nbindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside\n  = do { let hs_tv_bndrs = hsQTvExplicit hsq_bndrs\n             bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs\n\n       ; let -- See Note [bindHsQTyVars examples] for what\n             -- all these various things are doing\n             bndrs, kv_occs, implicit_kvs :: [Located RdrName]\n             bndrs        = map hsLTyVarLocName hs_tv_bndrs\n             kv_occs      = nubL (bndr_kv_occs ++ body_kv_occs)\n                                 -- Make sure to list the binder kvs before the\n                                 -- body kvs, as mandated by\n                                 -- Note [Ordering of implicit variables]\n             implicit_kvs = filter_occs bndrs kv_occs\n             -- dep_bndrs is the subset of bndrs that are dependent\n             --   i.e. appear in bndr/body_kv_occs\n             -- Can't use implicit_kvs because we've deleted bndrs from that!\n             dep_bndrs = filter (`elemRdr` kv_occs) bndrs\n             del       = deleteBys eqLocated\n             all_bound_on_lhs = null ((body_kv_occs `del` bndrs) `del` bndr_kv_occs)\n\n       ; traceRn \"checkMixedVars3\" $\n           vcat [ text \"kv_occs\" <+> ppr kv_occs\n                , text \"bndrs\"   <+> ppr hs_tv_bndrs\n                , text \"bndr_kv_occs\"   <+> ppr bndr_kv_occs\n                , text \"wubble\" <+> ppr ((kv_occs \\\\ bndrs) \\\\ bndr_kv_occs)\n                ]\n\n       ; implicit_kv_nms <- mapM (newTyVarNameRn mb_assoc) implicit_kvs\n\n       ; bindLocalNamesFV implicit_kv_nms                     $\n         bindLHsTyVarBndrs doc mb_in_doc mb_assoc hs_tv_bndrs $ \\ rn_bndrs ->\n    do { traceRn \"bindHsQTyVars\" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs)\n       ; dep_bndr_nms <- mapM (lookupLocalOccRn . unLoc) dep_bndrs\n       ; thing_inside (HsQTvs { hsq_ext = HsQTvsRn\n                                   { hsq_implicit  = implicit_kv_nms\n                                   , hsq_dependent = mkNameSet dep_bndr_nms }\n                              , hsq_explicit  = rn_bndrs })\n                      all_bound_on_lhs } }\n\n  where\n    filter_occs :: [Located RdrName]   -- Bound here\n                -> [Located RdrName]   -- Potential implicit binders\n                -> [Located RdrName]   -- Final implicit binders\n    -- Filter out any potential implicit binders that are either\n    -- already in scope, or are explicitly bound in the same HsQTyVars\n    filter_occs bndrs occs\n      = filterOut is_in_scope occs\n      where\n        is_in_scope locc = locc `elemRdr` bndrs\n\n{- Note [bindHsQTyVars examples]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n   data T k (a::k1) (b::k) :: k2 -> k1 -> *\n\nThen:\n  hs_tv_bndrs = [k, a::k1, b::k], the explicitly-bound variables\n  bndrs       = [k,a,b]\n\n  bndr_kv_occs = [k,k1], kind variables free in kind signatures\n                         of hs_tv_bndrs\n\n  body_kv_occs = [k2,k1], kind variables free in the\n                          result kind signature\n\n  implicit_kvs = [k1,k2], kind variables free in kind signatures\n                          of hs_tv_bndrs, and not bound by bndrs\n\n* We want to quantify add implicit bindings for implicit_kvs\n\n* The \"dependent\" bndrs (hsq_dependent) are the subset of\n  bndrs that are free in bndr_kv_occs or body_kv_occs\n\n* If implicit_body_kvs is non-empty, then there is a kind variable\n  mentioned in the kind signature that is not bound \"on the left\".\n  That's one of the rules for a CUSK, so we pass that info on\n  as the second argument to thing_inside.\n\n* Order is not important in these lists.  All we are doing is\n  bring Names into scope.\n\nFinally, you may wonder why filter_occs removes in-scope variables\nfrom bndr/body_kv_occs.  How can anything be in scope?  Answer:\nHsQTyVars is /also/ used (slightly oddly) for Haskell-98 syntax\nConDecls\n   data T a = forall (b::k). MkT a b\nThe ConDecl has a LHsQTyVars in it; but 'a' scopes over the entire\nConDecl.  Hence the local RdrEnv may be non-empty and we must filter\nout 'a' from the free vars.  (Mind you, in this situation all the\nimplicit kind variables are bound at the data type level, so there\nare none to bind in the ConDecl, so there are no implicitly bound\nvariables at all.\n\nNote [Kind variable scoping]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have\n  data T (a :: k) k = ...\nwe report \"k is out of scope\" for (a::k).  Reason: k is not brought\ninto scope until the explicit k-binding that follows.  It would be\nterribly confusing to bring into scope an /implicit/ k for a's kind\nand a distinct, shadowing explicit k that follows, something like\n  data T {k1} (a :: k1) k = ...\n\nSo the rule is:\n\n   the implicit binders never include any\n   of the explicit binders in the group\n\nNote that in the denerate case\n  data T (a :: a) = blah\nwe get a complaint the second 'a' is not in scope.\n\nThat applies to foralls too: e.g.\n   forall (a :: k) k . blah\n\nBut if the foralls are split, we treat the two groups separately:\n   forall (a :: k). forall k. blah\nHere we bring into scope an implicit k, which is later shadowed\nby the explicit k.\n\nIn implementation terms\n\n* In bindHsQTyVars 'k' is free in bndr_kv_occs; then we delete\n  the binders {a,k}, and so end with no implicit binders.  Then we\n  rename the binders left-to-right, and hence see that 'k' is out of\n  scope in the kind of 'a'.\n\n* Similarly in extract_hs_tv_bndrs\n\nNote [Variables used as both types and kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe bind the type variables tvs, and kvs is the set of free variables of the\nkinds in the scope of the binding. Here is one typical example:\n\n   forall a b. a -> (b::k) -> (c::a)\n\nHere, tvs will be {a,b}, and kvs {k,a}.\n\nWe must make sure that kvs includes all of variables in the kinds of type\nvariable bindings. For instance:\n\n   forall k (a :: k). Proxy a\n\nIf we only look in the body of the `forall` type, we will mistakenly conclude\nthat kvs is {}. But in fact, the type variable `k` is also used as a kind\nvariable in (a :: k), later in the binding. (This mistake lead to #14710.)\nSo tvs is {k,a} and kvs is {k}.\n\nNB: we do this only at the binding site of 'tvs'.\n-}\n\nbindLHsTyVarBndrs :: HsDocContext\n                  -> Maybe SDoc            -- Just d => check for unused tvs\n                                           --   d is a phrase like \"in the type ...\"\n                  -> Maybe a               -- Just _  => an associated type decl\n                  -> [LHsTyVarBndr GhcPs]  -- User-written tyvars\n                  -> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))\n                  -> RnM (b, FreeVars)\nbindLHsTyVarBndrs doc mb_in_doc mb_assoc tv_bndrs thing_inside\n  = do { when (isNothing mb_assoc) (checkShadowedRdrNames tv_names_w_loc)\n       ; checkDupRdrNames tv_names_w_loc\n       ; go tv_bndrs thing_inside }\n  where\n    tv_names_w_loc = map hsLTyVarLocName tv_bndrs\n\n    go []     thing_inside = thing_inside []\n    go (b:bs) thing_inside = bindLHsTyVarBndr doc mb_assoc b $ \\ b' ->\n                             do { (res, fvs) <- go bs $ \\ bs' ->\n                                                thing_inside (b' : bs')\n                                ; warn_unused b' fvs\n                                ; return (res, fvs) }\n\n    warn_unused tv_bndr fvs = case mb_in_doc of\n      Just in_doc -> warnUnusedForAll in_doc tv_bndr fvs\n      Nothing     -> return ()\n\nbindLHsTyVarBndr :: HsDocContext\n                 -> Maybe a   -- associated class\n                 -> LHsTyVarBndr GhcPs\n                 -> (LHsTyVarBndr GhcRn -> RnM (b, FreeVars))\n                 -> RnM (b, FreeVars)\nbindLHsTyVarBndr _doc mb_assoc (dL->L loc\n                                 (UserTyVar x\n                                    lrdr@(dL->L lv _))) thing_inside\n  = do { nm <- newTyVarNameRn mb_assoc lrdr\n       ; bindLocalNamesFV [nm] $\n         thing_inside (cL loc (UserTyVar x (cL lv nm))) }\n\nbindLHsTyVarBndr doc mb_assoc (dL->L loc (KindedTyVar x lrdr@(dL->L lv _) kind))\n                 thing_inside\n  = do { sig_ok <- xoptM LangExt.KindSignatures\n           ; unless sig_ok (badKindSigErr doc kind)\n           ; (kind', fvs1) <- rnLHsKind doc kind\n           ; tv_nm  <- newTyVarNameRn mb_assoc lrdr\n           ; (b, fvs2) <- bindLocalNamesFV [tv_nm]\n               $ thing_inside (cL loc (KindedTyVar x (cL lv tv_nm) kind'))\n           ; return (b, fvs1 `plusFV` fvs2) }\n\nbindLHsTyVarBndr _ _ (dL->L _ (XTyVarBndr{})) _ = panic \"bindLHsTyVarBndr\"\nbindLHsTyVarBndr _ _ _ _ = panic \"bindLHsTyVarBndr: Impossible Match\"\n                             -- due to #15884\n\nnewTyVarNameRn :: Maybe a -> Located RdrName -> RnM Name\nnewTyVarNameRn mb_assoc (dL->L loc rdr)\n  = do { rdr_env <- getLocalRdrEnv\n       ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of\n           (Just _, Just n) -> return n\n              -- Use the same Name as the parent class decl\n\n           _                -> newLocalBndrRn (cL loc rdr) }\n{-\n*********************************************************\n*                                                       *\n        ConDeclField\n*                                                       *\n*********************************************************\n\nWhen renaming a ConDeclField, we have to find the FieldLabel\nassociated with each field.  But we already have all the FieldLabels\navailable (since they were brought into scope by\nRnNames.getLocalNonValBinders), so we just take the list as an\nargument, build a map and look them up.\n-}\n\nrnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField GhcPs]\n                -> RnM ([LConDeclField GhcRn], FreeVars)\n-- Also called from RnSource\n-- No wildcards can appear in record fields\nrnConDeclFields ctxt fls fields\n   = mapFvRn (rnField fl_env env) fields\n  where\n    env    = mkTyKiEnv ctxt TypeLevel RnTypeBody\n    fl_env = mkFsEnv [ (flLabel fl, fl) | fl <- fls ]\n\nrnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs\n        -> RnM (LConDeclField GhcRn, FreeVars)\nrnField fl_env env (dL->L l (ConDeclField _ names ty haddock_doc))\n  = do { let new_names = map (fmap lookupField) names\n       ; (new_ty, fvs) <- rnLHsTyKi env ty\n       ; new_haddock_doc <- rnMbLHsDoc haddock_doc\n       ; return (cL l (ConDeclField noExt new_names new_ty new_haddock_doc)\n                , fvs) }\n  where\n    lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn\n    lookupField (FieldOcc _ (dL->L lr rdr)) =\n        FieldOcc (flSelector fl) (cL lr rdr)\n      where\n        lbl = occNameFS $ rdrNameOcc rdr\n        fl  = expectJust \"rnField\" $ lookupFsEnv fl_env lbl\n    lookupField (XFieldOcc{}) = panic \"rnField\"\nrnField _ _ (dL->L _ (XConDeclField _)) = panic \"rnField\"\nrnField _ _ _ = panic \"rnField: Impossible Match\"\n                             -- due to #15884\n\n{-\n************************************************************************\n*                                                                      *\n        Fixities and precedence parsing\n*                                                                      *\n************************************************************************\n\n@mkOpAppRn@ deals with operator fixities.  The argument expressions\nare assumed to be already correctly arranged.  It needs the fixities\nrecorded in the OpApp nodes, because fixity info applies to the things\nthe programmer actually wrote, so you can't find it out from the Name.\n\nFurthermore, the second argument is guaranteed not to be another\noperator application.  Why? Because the parser parses all\noperator applications left-associatively, EXCEPT negation, which\nwe need to handle specially.\nInfix types are read in a *right-associative* way, so that\n        a `op` b `op` c\nis always read in as\n        a `op` (b `op` c)\n\nmkHsOpTyRn rearranges where necessary.  The two arguments\nhave already been renamed and rearranged.  It's made rather tiresome\nby the presence of ->, which is a separate syntactic construct.\n-}\n\n---------------\n-- Building (ty1 `op1` (ty21 `op2` ty22))\nmkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)\n           -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn\n           -> RnM (HsType GhcRn)\n\nmkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsOpTy noExt ty21 op2 ty22))\n  = do  { fix2 <- lookupTyFixityRn op2\n        ; mk_hs_op_ty mk1 pp_op1 fix1 ty1\n                      (\\t1 t2 -> HsOpTy noExt t1 op2 t2)\n                      (unLoc op2) fix2 ty21 ty22 loc2 }\n\nmkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsFunTy _ ty21 ty22))\n  = mk_hs_op_ty mk1 pp_op1 fix1 ty1\n                (HsFunTy noExt) funTyConName funTyFixity ty21 ty22 loc2\n\nmkHsOpTyRn mk1 _ _ ty1 ty2              -- Default case, no rearrangment\n  = return (mk1 ty1 ty2)\n\n---------------\nmk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)\n            -> Name -> Fixity -> LHsType GhcRn\n            -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)\n            -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan\n            -> RnM (HsType GhcRn)\nmk_hs_op_ty mk1 op1 fix1 ty1\n            mk2 op2 fix2 ty21 ty22 loc2\n  | nofix_error     = do { precParseErr (NormalOp op1,fix1) (NormalOp op2,fix2)\n                         ; return (mk1 ty1 (cL loc2 (mk2 ty21 ty22))) }\n  | associate_right = return (mk1 ty1 (cL loc2 (mk2 ty21 ty22)))\n  | otherwise       = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)\n                           new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21\n                         ; return (mk2 (noLoc new_ty) ty22) }\n  where\n    (nofix_error, associate_right) = compareFixity fix1 fix2\n\n\n---------------------------\nmkOpAppRn :: LHsExpr GhcRn             -- Left operand; already rearranged\n          -> LHsExpr GhcRn -> Fixity   -- Operator and fixity\n          -> LHsExpr GhcRn             -- Right operand (not an OpApp, but might\n                                       -- be a NegApp)\n          -> RnM (HsExpr GhcRn)\n\n-- (e11 `op1` e12) `op2` e2\nmkOpAppRn e1@(dL->L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2\n  | nofix_error\n  = do precParseErr (get_op op1,fix1) (get_op op2,fix2)\n       return (OpApp fix2 e1 op2 e2)\n\n  | associate_right = do\n    new_e <- mkOpAppRn e12 op2 fix2 e2\n    return (OpApp fix1 e11 op1 (cL loc' new_e))\n  where\n    loc'= combineLocs e12 e2\n    (nofix_error, associate_right) = compareFixity fix1 fix2\n\n---------------------------\n--      (- neg_arg) `op` e2\nmkOpAppRn e1@(dL->L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2\n  | nofix_error\n  = do precParseErr (NegateOp,negateFixity) (get_op op2,fix2)\n       return (OpApp fix2 e1 op2 e2)\n\n  | associate_right\n  = do new_e <- mkOpAppRn neg_arg op2 fix2 e2\n       return (NegApp noExt (cL loc' new_e) neg_name)\n  where\n    loc' = combineLocs neg_arg e2\n    (nofix_error, associate_right) = compareFixity negateFixity fix2\n\n---------------------------\n--      e1 `op` - neg_arg\nmkOpAppRn e1 op1 fix1 e2@(dL->L _ (NegApp {})) -- NegApp can occur on the right\n  | not associate_right                        -- We *want* right association\n  = do precParseErr (get_op op1, fix1) (NegateOp, negateFixity)\n       return (OpApp fix1 e1 op1 e2)\n  where\n    (_, associate_right) = compareFixity fix1 negateFixity\n\n---------------------------\n--      Default case\nmkOpAppRn e1 op fix e2                  -- Default case, no rearrangment\n  = ASSERT2( right_op_ok fix (unLoc e2),\n             ppr e1 $$ text \"---\" $$ ppr op $$ text \"---\" $$ ppr fix $$ text \"---\" $$ ppr e2\n    )\n    return (OpApp fix e1 op e2)\n\n----------------------------\n\n-- | Name of an operator in an operator application or section\ndata OpName = NormalOp Name         -- ^ A normal identifier\n            | NegateOp              -- ^ Prefix negation\n            | UnboundOp UnboundVar  -- ^ An unbound indentifier\n            | RecFldOp (AmbiguousFieldOcc GhcRn)\n              -- ^ A (possibly ambiguous) record field occurrence\n\ninstance Outputable OpName where\n  ppr (NormalOp n)   = ppr n\n  ppr NegateOp       = ppr negateName\n  ppr (UnboundOp uv) = ppr uv\n  ppr (RecFldOp fld) = ppr fld\n\nget_op :: LHsExpr GhcRn -> OpName\n-- An unbound name could be either HsVar or HsUnboundVar\n-- See RnExpr.rnUnboundVar\nget_op (dL->L _ (HsVar _ n))         = NormalOp (unLoc n)\nget_op (dL->L _ (HsUnboundVar _ uv)) = UnboundOp uv\nget_op (dL->L _ (HsRecFld _ fld))    = RecFldOp fld\nget_op other                         = pprPanic \"get_op\" (ppr other)\n\n-- Parser left-associates everything, but\n-- derived instances may have correctly-associated things to\n-- in the right operand.  So we just check that the right operand is OK\nright_op_ok :: Fixity -> HsExpr GhcRn -> Bool\nright_op_ok fix1 (OpApp fix2 _ _ _)\n  = not error_please && associate_right\n  where\n    (error_please, associate_right) = compareFixity fix1 fix2\nright_op_ok _ _\n  = True\n\n-- Parser initially makes negation bind more tightly than any other operator\n-- And \"deriving\" code should respect this (use HsPar if not)\nmkNegAppRn :: LHsExpr (GhcPass id) -> SyntaxExpr (GhcPass id)\n           -> RnM (HsExpr (GhcPass id))\nmkNegAppRn neg_arg neg_name\n  = ASSERT( not_op_app (unLoc neg_arg) )\n    return (NegApp noExt neg_arg neg_name)\n\nnot_op_app :: HsExpr id -> Bool\nnot_op_app (OpApp {}) = False\nnot_op_app _          = True\n\n---------------------------\nmkOpFormRn :: LHsCmdTop GhcRn            -- Left operand; already rearranged\n          -> LHsExpr GhcRn -> Fixity     -- Operator and fixity\n          -> LHsCmdTop GhcRn             -- Right operand (not an infix)\n          -> RnM (HsCmd GhcRn)\n\n-- (e11 `op1` e12) `op2` e2\nmkOpFormRn a1@(dL->L loc\n                    (HsCmdTop _\n                     (dL->L _ (HsCmdArrForm x op1 f (Just fix1)\n                        [a11,a12]))))\n        op2 fix2 a2\n  | nofix_error\n  = do precParseErr (get_op op1,fix1) (get_op op2,fix2)\n       return (HsCmdArrForm x op2 f (Just fix2) [a1, a2])\n\n  | associate_right\n  = do new_c <- mkOpFormRn a12 op2 fix2 a2\n       return (HsCmdArrForm noExt op1 f (Just fix1)\n               [a11, cL loc (HsCmdTop [] (cL loc new_c))])\n        -- TODO: locs are wrong\n  where\n    (nofix_error, associate_right) = compareFixity fix1 fix2\n\n--      Default case\nmkOpFormRn arg1 op fix arg2                     -- Default case, no rearrangment\n  = return (HsCmdArrForm noExt op Infix (Just fix) [arg1, arg2])\n\n\n--------------------------------------\nmkConOpPatRn :: Located Name -> Fixity -> LPat GhcRn -> LPat GhcRn\n             -> RnM (Pat GhcRn)\n\nmkConOpPatRn op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2\n  = do  { fix1 <- lookupFixityRn (unLoc op1)\n        ; let (nofix_error, associate_right) = compareFixity fix1 fix2\n\n        ; if nofix_error then do\n                { precParseErr (NormalOp (unLoc op1),fix1)\n                               (NormalOp (unLoc op2),fix2)\n                ; return (ConPatIn op2 (InfixCon p1 p2)) }\n\n          else if associate_right then do\n                { new_p <- mkConOpPatRn op2 fix2 p12 p2\n                ; return (ConPatIn op1 (InfixCon p11 (cL loc new_p))) }\n                -- XXX loc right?\n          else return (ConPatIn op2 (InfixCon p1 p2)) }\n\nmkConOpPatRn op _ p1 p2                         -- Default case, no rearrangment\n  = ASSERT( not_op_pat (unLoc p2) )\n    return (ConPatIn op (InfixCon p1 p2))\n\nnot_op_pat :: Pat GhcRn -> Bool\nnot_op_pat (ConPatIn _ (InfixCon _ _)) = False\nnot_op_pat _                           = True\n\n--------------------------------------\ncheckPrecMatch :: Name -> MatchGroup GhcRn body -> RnM ()\n  -- Check precedence of a function binding written infix\n  --   eg  a `op` b `C` c = ...\n  -- See comments with rnExpr (OpApp ...) about \"deriving\"\n\ncheckPrecMatch op (MG { mg_alts = (dL->L _ ms) })\n  = mapM_ check ms\n  where\n    check (dL->L _ (Match { m_pats = (dL->L l1 p1)\n                                   : (dL->L l2 p2)\n                                   : _ }))\n      = setSrcSpan (combineSrcSpans l1 l2) $\n        do checkPrec op p1 False\n           checkPrec op p2 True\n\n    check _ = return ()\n        -- This can happen.  Consider\n        --      a `op` True = ...\n        --      op          = ...\n        -- The infix flag comes from the first binding of the group\n        -- but the second eqn has no args (an error, but not discovered\n        -- until the type checker).  So we don't want to crash on the\n        -- second eqn.\ncheckPrecMatch _ (XMatchGroup {}) = panic \"checkPrecMatch\"\n\ncheckPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()\ncheckPrec op (ConPatIn op1 (InfixCon _ _)) right = do\n    op_fix@(Fixity _ op_prec  op_dir) <- lookupFixityRn op\n    op1_fix@(Fixity _ op1_prec op1_dir) <- lookupFixityRn (unLoc op1)\n    let\n        inf_ok = op1_prec > op_prec ||\n                 (op1_prec == op_prec &&\n                  (op1_dir == InfixR && op_dir == InfixR && right ||\n                   op1_dir == InfixL && op_dir == InfixL && not right))\n\n        info  = (NormalOp op,          op_fix)\n        info1 = (NormalOp (unLoc op1), op1_fix)\n        (infol, infor) = if right then (info, info1) else (info1, info)\n    unless inf_ok (precParseErr infol infor)\n\ncheckPrec _ _ _\n  = return ()\n\n-- Check precedence of (arg op) or (op arg) respectively\n-- If arg is itself an operator application, then either\n--   (a) its precedence must be higher than that of op\n--   (b) its precedency & associativity must be the same as that of op\ncheckSectionPrec :: FixityDirection -> HsExpr GhcPs\n        -> LHsExpr GhcRn -> LHsExpr GhcRn -> RnM ()\ncheckSectionPrec direction section op arg\n  = case unLoc arg of\n        OpApp fix _ op' _ -> go_for_it (get_op op') fix\n        NegApp _ _ _      -> go_for_it NegateOp     negateFixity\n        _                 -> return ()\n  where\n    op_name = get_op op\n    go_for_it arg_op arg_fix@(Fixity _ arg_prec assoc) = do\n          op_fix@(Fixity _ op_prec _) <- lookupFixityOp op_name\n          unless (op_prec < arg_prec\n                  || (op_prec == arg_prec && direction == assoc))\n                 (sectionPrecErr (get_op op, op_fix)\n                                 (arg_op, arg_fix) section)\n\n-- | Look up the fixity for an operator name.  Be careful to use\n-- 'lookupFieldFixityRn' for (possibly ambiguous) record fields\n-- (see Trac #13132).\nlookupFixityOp :: OpName -> RnM Fixity\nlookupFixityOp (NormalOp n)  = lookupFixityRn n\nlookupFixityOp NegateOp      = lookupFixityRn negateName\nlookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (unboundVarOcc u))\nlookupFixityOp (RecFldOp f)  = lookupFieldFixityRn f\n\n\n-- Precedence-related error messages\n\nprecParseErr :: (OpName,Fixity) -> (OpName,Fixity) -> RnM ()\nprecParseErr op1@(n1,_) op2@(n2,_)\n  | is_unbound n1 || is_unbound n2\n  = return ()     -- Avoid error cascade\n  | otherwise\n  = addErr $ hang (text \"Precedence parsing error\")\n      4 (hsep [text \"cannot mix\", ppr_opfix op1, ptext (sLit \"and\"),\n               ppr_opfix op2,\n               text \"in the same infix expression\"])\n\nsectionPrecErr :: (OpName,Fixity) -> (OpName,Fixity) -> HsExpr GhcPs -> RnM ()\nsectionPrecErr op@(n1,_) arg_op@(n2,_) section\n  | is_unbound n1 || is_unbound n2\n  = return ()     -- Avoid error cascade\n  | otherwise\n  = addErr $ vcat [text \"The operator\" <+> ppr_opfix op <+> ptext (sLit \"of a section\"),\n         nest 4 (sep [text \"must have lower precedence than that of the operand,\",\n                      nest 2 (text \"namely\" <+> ppr_opfix arg_op)]),\n         nest 4 (text \"in the section:\" <+> quotes (ppr section))]\n\nis_unbound :: OpName -> Bool\nis_unbound (NormalOp n) = isUnboundName n\nis_unbound UnboundOp{}  = True\nis_unbound _            = False\n\nppr_opfix :: (OpName, Fixity) -> SDoc\nppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)\n   where\n     pp_op | NegateOp <- op = text \"prefix `-'\"\n           | otherwise      = quotes (ppr op)\n\n\n{- *****************************************************\n*                                                      *\n                 Errors\n*                                                      *\n***************************************************** -}\n\nunexpectedTypeSigErr :: LHsSigWcType GhcPs -> SDoc\nunexpectedTypeSigErr ty\n  = hang (text \"Illegal type signature:\" <+> quotes (ppr ty))\n       2 (text \"Type signatures are only allowed in patterns with ScopedTypeVariables\")\n\nbadKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM ()\nbadKindSigErr doc (dL->L loc ty)\n  = setSrcSpan loc $ addErr $\n    withHsDocContext doc $\n    hang (text \"Illegal kind signature:\" <+> quotes (ppr ty))\n       2 (text \"Perhaps you intended to use KindSignatures\")\n\ndataKindsErr :: RnTyKiEnv -> HsType GhcPs -> SDoc\ndataKindsErr env thing\n  = hang (text \"Illegal\" <+> pp_what <> colon <+> quotes (ppr thing))\n       2 (text \"Perhaps you intended to use DataKinds\")\n  where\n    pp_what | isRnKindLevel env = text \"kind\"\n            | otherwise          = text \"type\"\n\ninTypeDoc :: HsType GhcPs -> SDoc\ninTypeDoc ty = text \"In the type\" <+> quotes (ppr ty)\n\nwarnUnusedForAll :: SDoc -> LHsTyVarBndr GhcRn -> FreeVars -> TcM ()\nwarnUnusedForAll in_doc (dL->L loc tv) used_names\n  = whenWOptM Opt_WarnUnusedForalls $\n    unless (hsTyVarName tv `elemNameSet` used_names) $\n    addWarnAt (Reason Opt_WarnUnusedForalls) loc $\n    vcat [ text \"Unused quantified type variable\" <+> quotes (ppr tv)\n         , in_doc ]\n\nopTyErr :: Outputable a => RdrName -> a -> SDoc\nopTyErr op overall_ty\n  = hang (text \"Illegal operator\" <+> quotes (ppr op) <+> ptext (sLit \"in type\") <+> quotes (ppr overall_ty))\n         2 (text \"Use TypeOperators to allow operators in types\")\n\n{-\n************************************************************************\n*                                                                      *\n      Finding the free type variables of a (HsType RdrName)\n*                                                                      *\n************************************************************************\n\n\nNote [Kind and type-variable binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a type signature we may implicitly bind type/kind variables. For example:\n  *   f :: a -> a\n      f = ...\n    Here we need to find the free type variables of (a -> a),\n    so that we know what to quantify\n\n  *   class C (a :: k) where ...\n    This binds 'k' in ..., as well as 'a'\n\n  *   f (x :: a -> [a]) = ....\n    Here we bind 'a' in ....\n\n  *   f (x :: T a -> T (b :: k)) = ...\n    Here we bind both 'a' and the kind variable 'k'\n\n  *   type instance F (T (a :: Maybe k)) = ...a...k...\n    Here we want to constrain the kind of 'a', and bind 'k'.\n\nTo do that, we need to walk over a type and find its free type/kind variables.\nWe preserve the left-to-right order of each variable occurrence.\nSee Note [Ordering of implicit variables].\n\nClients of this code can remove duplicates with nubL.\n\nNote [Ordering of implicit variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSince the advent of -XTypeApplications, GHC makes promises about the ordering\nof implicit variable quantification. Specifically, we offer that implicitly\nquantified variables (such as those in const :: a -> b -> a, without a `forall`)\nwill occur in left-to-right order of first occurrence. Here are a few examples:\n\n  const :: a -> b -> a       -- forall a b. ...\n  f :: Eq a => b -> a -> a   -- forall a b. ...  contexts are included\n\n  type a <-< b = b -> a\n  g :: a <-< b               -- forall a b. ...  type synonyms matter\n\n  class Functor f where\n    fmap :: (a -> b) -> f a -> f b   -- forall f a b. ...\n    -- The f is quantified by the class, so only a and b are considered in fmap\n\nThis simple story is complicated by the possibility of dependency: all variables\nmust come after any variables mentioned in their kinds.\n\n  typeRep :: Typeable a => TypeRep (a :: k)   -- forall k a. ...\n\nThe k comes first because a depends on k, even though the k appears later than\nthe a in the code. Thus, GHC does ScopedSort on the variables.\nSee Note [ScopedSort] in Type.\n\nImplicitly bound variables are collected by any function which returns a\nFreeKiTyVars, FreeKiTyVarsWithDups, or FreeKiTyVarsNoDups, which notably\nincludes the `extract-` family of functions (extractHsTysRdrTyVarsDups,\nextractHsTyVarBndrsKVs, etc.).\nThese functions thus promise to keep left-to-right ordering.\n\nNote [Implicit quantification in type synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe typically bind type/kind variables implicitly when they are in a kind\nannotation on the LHS, for example:\n\n  data Proxy (a :: k) = Proxy\n  type KindOf (a :: k) = k\n\nHere 'k' is in the kind annotation of a type variable binding, KindedTyVar, and\nwe want to implicitly quantify over it.  This is easy: just extract all free\nvariables from the kind signature. That's what we do in extract_hs_tv_bndrs_kvs\n\nBy contrast, on the RHS we can't simply collect *all* free variables. Which of\nthe following are allowed?\n\n  type TySyn1 = a :: Type\n  type TySyn2 = 'Nothing :: Maybe a\n  type TySyn3 = 'Just ('Nothing :: Maybe a)\n  type TySyn4 = 'Left a :: Either Type a\n\nAfter some design deliberations (see non-taken alternatives below), the answer\nis to reject TySyn1 and TySyn3, but allow TySyn2 and TySyn4, at least for now.\nWe implicitly quantify over free variables of the outermost kind signature, if\none exists:\n\n  * In TySyn1, the outermost kind signature is (:: Type), and it does not have\n    any free variables.\n  * In TySyn2, the outermost kind signature is (:: Maybe a), it contains a\n    free variable 'a', which we implicitly quantify over.\n  * In TySyn3, there is no outermost kind signature. The (:: Maybe a) signature\n    is hidden inside 'Just.\n  * In TySyn4, the outermost kind signature is (:: Either Type a), it contains\n    a free variable 'a', which we implicitly quantify over. That is why we can\n    also use it to the left of the double colon: 'Left a\n\nThe logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type\nsynonyms and type family instances.\n\nThis is something of a stopgap solution until we can explicitly bind invisible\ntype/kind variables:\n\n  type TySyn3 :: forall a. Maybe a\n  type TySyn3 @a = 'Just ('Nothing :: Maybe a)\n\nNote [Implicit quantification in type synonyms: non-taken alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nAlternative I: No quantification\n--------------------------------\nWe could offer no implicit quantification on the RHS, accepting none of the\nTySyn<N> examples. The user would have to bind the variables explicitly:\n\n  type TySyn1 a = a :: Type\n  type TySyn2 a = 'Nothing :: Maybe a\n  type TySyn3 a = 'Just ('Nothing :: Maybe a)\n  type TySyn4 a = 'Left a :: Either Type a\n\nHowever, this would mean that one would have to specify 'a' at call sites every\ntime, which could be undesired.\n\nAlternative II: Indiscriminate quantification\n---------------------------------------------\nWe could implicitly quantify over all free variables on the RHS just like we do\non the LHS. Then we would infer the following kinds:\n\n  TySyn1 :: forall {a}. Type\n  TySyn2 :: forall {a}. Maybe a\n  TySyn3 :: forall {a}. Maybe (Maybe a)\n  TySyn4 :: forall {a}. Either Type a\n\nThis would work fine for TySyn<2,3,4>, but TySyn1 is clearly bogus: the variable\nis free-floating, not fixed by anything.\n\nAlternative III: reportFloatingKvs\n----------------------------------\nWe could augment Alternative II by hunting down free-floating variables during\ntype checking. While viable, this would mean we'd end up accepting this:\n\n  data Prox k (a :: k)\n  type T = Prox k\n\n-}\n\n-- See Note [Kind and type-variable binders]\n-- These lists are guaranteed to preserve left-to-right ordering of\n-- the types the variables were extracted from. See also\n-- Note [Ordering of implicit variables].\ntype FreeKiTyVars = [Located RdrName]\n\n-- | A 'FreeKiTyVars' list that is allowed to have duplicate variables.\ntype FreeKiTyVarsWithDups = FreeKiTyVars\n\n-- | A 'FreeKiTyVars' list that contains no duplicate variables.\ntype FreeKiTyVarsNoDups   = FreeKiTyVars\n\nfilterInScope :: LocalRdrEnv -> FreeKiTyVars -> FreeKiTyVars\nfilterInScope rdr_env = filterOut (inScope rdr_env . unLoc)\n\nfilterInScopeM :: FreeKiTyVars -> RnM FreeKiTyVars\nfilterInScopeM vars\n  = do { rdr_env <- getLocalRdrEnv\n       ; return (filterInScope rdr_env vars) }\n\ninScope :: LocalRdrEnv -> RdrName -> Bool\ninScope rdr_env rdr = rdr `elemLocalRdrEnv` rdr_env\n\nextract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups\nextract_tyarg (HsValArg ty) acc = extract_lty ty acc\nextract_tyarg (HsTypeArg _ ki) acc = extract_lty ki acc\nextract_tyarg (HsArgPar _) acc = acc\n\nextract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups\nextract_tyargs args acc = foldr extract_tyarg acc args\n\nextractHsTyArgRdrKiTyVarsDup :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups\nextractHsTyArgRdrKiTyVarsDup args\n  = extract_tyargs args []\n\n-- | 'extractHsTyRdrTyVars' finds the type/kind variables\n--                          of a HsType/HsKind.\n-- It's used when making the @forall@s explicit.\n-- When the same name occurs multiple times in the types, only the first\n-- occurrence is returned.\n-- See Note [Kind and type-variable binders]\nextractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVarsNoDups\nextractHsTyRdrTyVars ty\n  = nubL (extractHsTyRdrTyVarsDups ty)\n\n-- | 'extractHsTyRdrTyVarsDups' finds the type/kind variables\n--                              of a HsType/HsKind.\n-- It's used when making the @forall@s explicit.\n-- When the same name occurs multiple times in the types, all occurrences\n-- are returned.\nextractHsTyRdrTyVarsDups :: LHsType GhcPs -> FreeKiTyVarsWithDups\nextractHsTyRdrTyVarsDups ty\n  = extract_lty ty []\n\n-- | Extracts the free type/kind variables from the kind signature of a HsType.\n--   This is used to implicitly quantify over @k@ in @type T = Nothing :: Maybe k@.\n-- When the same name occurs multiple times in the type, only the first\n-- occurrence is returned, and the left-to-right order of variables is\n-- preserved.\n-- See Note [Kind and type-variable binders] and\n--     Note [Ordering of implicit variables] and\n--     Note [Implicit quantification in type synonyms].\nextractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVarsNoDups\nextractHsTyRdrTyVarsKindVars (unLoc -> ty) =\n  case ty of\n    HsParTy _ ty -> extractHsTyRdrTyVarsKindVars ty\n    HsKindSig _ _ ki -> extractHsTyRdrTyVars ki\n    _ -> []\n\n-- | Extracts free type and kind variables from types in a list.\n-- When the same name occurs multiple times in the types, all occurrences\n-- are returned.\nextractHsTysRdrTyVarsDups :: [LHsType GhcPs] -> FreeKiTyVarsWithDups\nextractHsTysRdrTyVarsDups tys\n  = extract_ltys tys []\n\n-- Returns the free kind variables of any explictly-kinded binders, returning\n-- variable occurrences in left-to-right order.\n-- See Note [Ordering of implicit variables].\n-- NB: Does /not/ delete the binders themselves.\n--     However duplicates are removed\n--     E.g. given  [k1, a:k1, b:k2]\n--          the function returns [k1,k2], even though k1 is bound here\nextractHsTyVarBndrsKVs :: [LHsTyVarBndr GhcPs] -> FreeKiTyVarsNoDups\nextractHsTyVarBndrsKVs tv_bndrs\n  = nubL (extract_hs_tv_bndrs_kvs tv_bndrs)\n\n-- Returns the free kind variables in a type family result signature, returning\n-- variable occurrences in left-to-right order.\n-- See Note [Ordering of implicit variables].\nextractRdrKindSigVars :: LFamilyResultSig GhcPs -> [Located RdrName]\nextractRdrKindSigVars (dL->L _ resultSig)\n  | KindSig _ k                              <- resultSig = extractHsTyRdrTyVars k\n  | TyVarSig _ (dL->L _ (KindedTyVar _ _ k)) <- resultSig = extractHsTyRdrTyVars k\n  | otherwise =  []\n\n-- Get type/kind variables mentioned in the kind signature, preserving\n-- left-to-right order and without duplicates:\n--\n--  * data T a (b :: k1) :: k2 -> k1 -> k2 -> Type   -- result: [k2,k1]\n--  * data T a (b :: k1)                             -- result: []\n--\n-- See Note [Ordering of implicit variables].\nextractDataDefnKindVars :: HsDataDefn GhcPs ->  FreeKiTyVarsNoDups\nextractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig })\n  = maybe [] extractHsTyRdrTyVars ksig\nextractDataDefnKindVars (XHsDataDefn _) = panic \"extractDataDefnKindVars\"\n\nextract_lctxt :: LHsContext GhcPs\n              -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups\nextract_lctxt ctxt = extract_ltys (unLoc ctxt)\n\nextract_ltys :: [LHsType GhcPs]\n             -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups\nextract_ltys tys acc = foldr extract_lty acc tys\n\nextract_lty :: LHsType GhcPs\n            -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups\nextract_lty (dL->L _ ty) acc\n  = case ty of\n      HsTyVar _ _  ltv            -> extract_tv ltv acc\n      HsBangTy _ _ ty             -> extract_lty ty acc\n      HsRecTy _ flds              -> foldr (extract_lty\n                                            . cd_fld_type . unLoc) acc\n                                           flds\n      HsAppTy _ ty1 ty2           -> extract_lty ty1 $\n                                     extract_lty ty2 acc\n      HsAppKindTy _ ty k          -> extract_lty ty $\n                                     extract_lty k acc\n      HsListTy _ ty               -> extract_lty ty acc\n      HsTupleTy _ _ tys           -> extract_ltys tys acc\n      HsSumTy _ tys               -> extract_ltys tys acc\n      HsFunTy _ ty1 ty2           -> extract_lty ty1 $\n                                     extract_lty ty2 acc\n      HsIParamTy _ _ ty           -> extract_lty ty acc\n      HsOpTy _ ty1 tv ty2         -> extract_tv tv $\n                                     extract_lty ty1 $\n                                     extract_lty ty2 acc\n      HsParTy _ ty                -> extract_lty ty acc\n      HsSpliceTy {}               -> acc  -- Type splices mention no tvs\n      HsDocTy _ ty _              -> extract_lty ty acc\n      HsExplicitListTy _ _ tys    -> extract_ltys tys acc\n      HsExplicitTupleTy _ tys     -> extract_ltys tys acc\n      HsTyLit _ _                 -> acc\n      HsStarTy _ _                -> acc\n      HsKindSig _ ty ki           -> extract_lty ty $\n                                     extract_lty ki acc\n      HsForAllTy { hst_bndrs = tvs, hst_body = ty }\n                                  -> extract_hs_tv_bndrs tvs acc $\n                                     extract_lty ty []\n      HsQualTy { hst_ctxt = ctxt, hst_body = ty }\n                                  -> extract_lctxt ctxt $\n                                     extract_lty ty acc\n      XHsType {}                  -> acc\n      -- We deal with these separately in rnLHsTypeWithWildCards\n      HsWildCardTy {}             -> acc\n\nextractHsTvBndrs :: [LHsTyVarBndr GhcPs]\n                 -> FreeKiTyVarsWithDups           -- Free in body\n                 -> FreeKiTyVarsWithDups       -- Free in result\nextractHsTvBndrs tv_bndrs body_fvs\n  = extract_hs_tv_bndrs tv_bndrs [] body_fvs\n\nextract_hs_tv_bndrs :: [LHsTyVarBndr GhcPs]\n                    -> FreeKiTyVarsWithDups  -- Accumulator\n                    -> FreeKiTyVarsWithDups  -- Free in body\n                    -> FreeKiTyVarsWithDups\n-- In (forall (a :: Maybe e). a -> b) we have\n--     'a' is bound by the forall\n--     'b' is a free type variable\n--     'e' is a free kind variable\nextract_hs_tv_bndrs tv_bndrs acc_vars body_vars\n  | null tv_bndrs = body_vars ++ acc_vars\n  | otherwise = filterOut (`elemRdr` tv_bndr_rdrs) (bndr_vars ++ body_vars) ++ acc_vars\n    -- NB: delete all tv_bndr_rdrs from bndr_vars as well as body_vars.\n    -- See Note [Kind variable scoping]\n  where\n    bndr_vars = extract_hs_tv_bndrs_kvs tv_bndrs\n    tv_bndr_rdrs = map hsLTyVarLocName tv_bndrs\n\nextract_hs_tv_bndrs_kvs :: [LHsTyVarBndr GhcPs] -> [Located RdrName]\n-- Returns the free kind variables of any explictly-kinded binders, returning\n-- variable occurrences in left-to-right order.\n-- See Note [Ordering of implicit variables].\n-- NB: Does /not/ delete the binders themselves.\n--     Duplicates are /not/ removed\n--     E.g. given  [k1, a:k1, b:k2]\n--          the function returns [k1,k2], even though k1 is bound here\nextract_hs_tv_bndrs_kvs tv_bndrs =\n    foldr extract_lty []\n          [k | (dL->L _ (KindedTyVar _ _ k)) <- tv_bndrs]\n\nextract_tv :: Located RdrName\n           -> [Located RdrName] -> [Located RdrName]\nextract_tv tv acc =\n  if isRdrTyVar (unLoc tv) then tv:acc else acc\n\n-- Deletes duplicates in a list of Located things.\n--\n-- Importantly, this function is stable with respect to the original ordering\n-- of things in the list. This is important, as it is a property that GHC\n-- relies on to maintain the left-to-right ordering of implicitly quantified\n-- type variables.\n-- See Note [Ordering of implicit variables].\nnubL :: Eq a => [Located a] -> [Located a]\nnubL = nubBy eqLocated\n\nelemRdr :: Located RdrName -> [Located RdrName] -> Bool\nelemRdr x = any (eqLocated x)\n", "num_lines": 1790}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nThis module contains helper functions for reporting and creating\nunbound variables.\n\n-}\nmodule RnUnbound ( mkUnboundName\n                 , mkUnboundNameRdr\n                 , isUnboundName\n                 , reportUnboundName\n                 , unknownNameSuggestions\n                 , WhereLooking(..)\n                 , unboundName\n                 , unboundNameX\n                 , notInScopeErr ) where\n\nimport GhcPrelude\n\nimport RdrName\nimport HscTypes\nimport TcRnMonad\nimport Name\nimport Module\nimport SrcLoc\nimport Outputable\nimport PrelNames ( mkUnboundName, isUnboundName, getUnique)\nimport Util\nimport Maybes\nimport DynFlags\nimport FastString\nimport Data.List\nimport Data.Function ( on )\nimport UniqDFM (udfmToList)\n\n{-\n************************************************************************\n*                                                                      *\n               What to do when a lookup fails\n*                                                                      *\n************************************************************************\n-}\n\ndata WhereLooking = WL_Any        -- Any binding\n                  | WL_Global     -- Any top-level binding (local or imported)\n                  | WL_LocalTop   -- Any top-level binding in this module\n                  | WL_LocalOnly\n                        -- Only local bindings\n                        -- (pattern synonyms declaractions,\n                        -- see Note [Renaming pattern synonym variables])\n\nmkUnboundNameRdr :: RdrName -> Name\nmkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)\n\nreportUnboundName :: RdrName -> RnM Name\nreportUnboundName rdr = unboundName WL_Any rdr\n\nunboundName :: WhereLooking -> RdrName -> RnM Name\nunboundName wl rdr = unboundNameX wl rdr Outputable.empty\n\nunboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name\nunboundNameX where_look rdr_name extra\n  = do  { dflags <- getDynFlags\n        ; let show_helpful_errors = gopt Opt_HelpfulErrors dflags\n              err = notInScopeErr rdr_name $$ extra\n        ; if not show_helpful_errors\n          then addErr err\n          else do { local_env  <- getLocalRdrEnv\n                  ; global_env <- getGlobalRdrEnv\n                  ; impInfo <- getImports\n                  ; currmod <- getModule\n                  ; hpt <- getHpt\n                  ; let suggestions = unknownNameSuggestions_ where_look\n                          dflags hpt currmod global_env local_env impInfo\n                          rdr_name\n                  ; addErr (err $$ suggestions) }\n        ; return (mkUnboundNameRdr rdr_name) }\n\nnotInScopeErr :: RdrName -> SDoc\nnotInScopeErr rdr_name\n  = hang (text \"Not in scope:\")\n       2 (what <+> quotes (ppr rdr_name))\n  where\n    what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))\n\ntype HowInScope = Either SrcSpan ImpDeclSpec\n     -- Left loc    =>  locally bound at loc\n     -- Right ispec =>  imported as specified by ispec\n\n\n-- | Called from the typechecker (TcErrors) when we find an unbound variable\nunknownNameSuggestions :: DynFlags\n                       -> HomePackageTable -> Module\n                       -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails\n                       -> RdrName -> SDoc\nunknownNameSuggestions = unknownNameSuggestions_ WL_Any\n\nunknownNameSuggestions_ :: WhereLooking -> DynFlags\n                       -> HomePackageTable -> Module\n                       -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails\n                       -> RdrName -> SDoc\nunknownNameSuggestions_ where_look dflags hpt curr_mod global_env local_env\n                          imports tried_rdr_name =\n    similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$\n    importSuggestions where_look global_env hpt\n                      curr_mod imports tried_rdr_name $$\n    extensionSuggestions tried_rdr_name\n\n\nsimilarNameSuggestions :: WhereLooking -> DynFlags\n                        -> GlobalRdrEnv -> LocalRdrEnv\n                        -> RdrName -> SDoc\nsimilarNameSuggestions where_look dflags global_env\n                        local_env tried_rdr_name\n  = case suggest of\n      []  -> Outputable.empty\n      [p] -> perhaps <+> pp_item p\n      ps  -> sep [ perhaps <+> text \"one of these:\"\n                 , nest 2 (pprWithCommas pp_item ps) ]\n  where\n    all_possibilities :: [(String, (RdrName, HowInScope))]\n    all_possibilities\n       =  [ (showPpr dflags r, (r, Left loc))\n          | (r,loc) <- local_possibilities local_env ]\n       ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]\n\n    suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities\n    perhaps = text \"Perhaps you meant\"\n\n    pp_item :: (RdrName, HowInScope) -> SDoc\n    pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined\n        where loc' = case loc of\n                     UnhelpfulSpan l -> parens (ppr l)\n                     RealSrcSpan l -> parens (text \"line\" <+> int (srcSpanStartLine l))\n    pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+>   -- Imported\n                              parens (text \"imported from\" <+> ppr (is_mod is))\n\n    pp_ns :: RdrName -> SDoc\n    pp_ns rdr | ns /= tried_ns = pprNameSpace ns\n              | otherwise      = Outputable.empty\n      where ns = rdrNameSpace rdr\n\n    tried_occ     = rdrNameOcc tried_rdr_name\n    tried_is_sym  = isSymOcc tried_occ\n    tried_ns      = occNameSpace tried_occ\n    tried_is_qual = isQual tried_rdr_name\n\n    correct_name_space occ =  nameSpacesRelated (occNameSpace occ) tried_ns\n                           && isSymOcc occ == tried_is_sym\n        -- Treat operator and non-operators as non-matching\n        -- This heuristic avoids things like\n        --      Not in scope 'f'; perhaps you meant '+' (from Prelude)\n\n    local_ok = case where_look of { WL_Any -> True\n                                  ; WL_LocalOnly -> True\n                                  ; _ -> False }\n    local_possibilities :: LocalRdrEnv -> [(RdrName, SrcSpan)]\n    local_possibilities env\n      | tried_is_qual = []\n      | not local_ok  = []\n      | otherwise     = [ (mkRdrUnqual occ, nameSrcSpan name)\n                        | name <- localRdrEnvElts env\n                        , let occ = nameOccName name\n                        , correct_name_space occ]\n\n    global_possibilities :: GlobalRdrEnv -> [(RdrName, (RdrName, HowInScope))]\n    global_possibilities global_env\n      | tried_is_qual = [ (rdr_qual, (rdr_qual, how))\n                        | gre <- globalRdrEnvElts global_env\n                        , isGreOk where_look gre\n                        , let name = gre_name gre\n                              occ  = nameOccName name\n                        , correct_name_space occ\n                        , (mod, how) <- qualsInScope gre\n                        , let rdr_qual = mkRdrQual mod occ ]\n\n      | otherwise = [ (rdr_unqual, pair)\n                    | gre <- globalRdrEnvElts global_env\n                    , isGreOk where_look gre\n                    , let name = gre_name gre\n                          occ  = nameOccName name\n                          rdr_unqual = mkRdrUnqual occ\n                    , correct_name_space occ\n                    , pair <- case (unquals_in_scope gre, quals_only gre) of\n                                (how:_, _)    -> [ (rdr_unqual, how) ]\n                                ([],    pr:_) -> [ pr ]  -- See Note [Only-quals]\n                                ([],    [])   -> [] ]\n\n              -- Note [Only-quals]\n              -- The second alternative returns those names with the same\n              -- OccName as the one we tried, but live in *qualified* imports\n              -- e.g. if you have:\n              --\n              -- > import qualified Data.Map as Map\n              -- > foo :: Map\n              --\n              -- then we suggest @Map.Map@.\n\n    --------------------\n    unquals_in_scope :: GlobalRdrElt -> [HowInScope]\n    unquals_in_scope (GRE { gre_name = n, gre_lcl = lcl, gre_imp = is })\n      | lcl       = [ Left (nameSrcSpan n) ]\n      | otherwise = [ Right ispec\n                    | i <- is, let ispec = is_decl i\n                    , not (is_qual ispec) ]\n\n\n    --------------------\n    quals_only :: GlobalRdrElt -> [(RdrName, HowInScope)]\n    -- Ones for which *only* the qualified version is in scope\n    quals_only (GRE { gre_name = n, gre_imp = is })\n      = [ (mkRdrQual (is_as ispec) (nameOccName n), Right ispec)\n        | i <- is, let ispec = is_decl i, is_qual ispec ]\n\n-- | Generate helpful suggestions if a qualified name Mod.foo is not in scope.\nimportSuggestions :: WhereLooking\n                  -> GlobalRdrEnv\n                  -> HomePackageTable -> Module\n                  -> ImportAvails -> RdrName -> SDoc\nimportSuggestions where_look global_env hpt currMod imports rdr_name\n  | WL_LocalOnly <- where_look                 = Outputable.empty\n  | not (isQual rdr_name || isUnqual rdr_name) = Outputable.empty\n  | null interesting_imports\n  , Just name <- mod_name\n  , show_not_imported_line name\n  = hsep\n      [ text \"No module named\"\n      , quotes (ppr name)\n      , text \"is imported.\"\n      ]\n  | is_qualified\n  , null helpful_imports\n  , [(mod,_)] <- interesting_imports\n  = hsep\n      [ text \"Module\"\n      , quotes (ppr mod)\n      , text \"does not export\"\n      , quotes (ppr occ_name) <> dot\n      ]\n  | is_qualified\n  , null helpful_imports\n  , not (null interesting_imports)\n  , mods <- map fst interesting_imports\n  = hsep\n      [ text \"Neither\"\n      , quotedListWithNor (map ppr mods)\n      , text \"exports\"\n      , quotes (ppr occ_name) <> dot\n      ]\n  | [(mod,imv)] <- helpful_imports_non_hiding\n  = fsep\n      [ text \"Perhaps you want to add\"\n      , quotes (ppr occ_name)\n      , text \"to the import list\"\n      , text \"in the import of\"\n      , quotes (ppr mod)\n      , parens (ppr (imv_span imv)) <> dot\n      ]\n  | not (null helpful_imports_non_hiding)\n  = fsep\n      [ text \"Perhaps you want to add\"\n      , quotes (ppr occ_name)\n      , text \"to one of these import lists:\"\n      ]\n    $$\n    nest 2 (vcat\n        [ quotes (ppr mod) <+> parens (ppr (imv_span imv))\n        | (mod,imv) <- helpful_imports_non_hiding\n        ])\n  | [(mod,imv)] <- helpful_imports_hiding\n  = fsep\n      [ text \"Perhaps you want to remove\"\n      , quotes (ppr occ_name)\n      , text \"from the explicit hiding list\"\n      , text \"in the import of\"\n      , quotes (ppr mod)\n      , parens (ppr (imv_span imv)) <> dot\n      ]\n  | not (null helpful_imports_hiding)\n  = fsep\n      [ text \"Perhaps you want to remove\"\n      , quotes (ppr occ_name)\n      , text \"from the hiding clauses\"\n      , text \"in one of these imports:\"\n      ]\n    $$\n    nest 2 (vcat\n        [ quotes (ppr mod) <+> parens (ppr (imv_span imv))\n        | (mod,imv) <- helpful_imports_hiding\n        ])\n  | otherwise\n  = Outputable.empty\n where\n  is_qualified = isQual rdr_name\n  (mod_name, occ_name) = case rdr_name of\n    Unqual occ_name        -> (Nothing, occ_name)\n    Qual mod_name occ_name -> (Just mod_name, occ_name)\n    _                      -> error \"importSuggestions: dead code\"\n\n\n  -- What import statements provide \"Mod\" at all\n  -- or, if this is an unqualified name, are not qualified imports\n  interesting_imports = [ (mod, imp)\n    | (mod, mod_imports) <- moduleEnvToList (imp_mods imports)\n    , Just imp <- return $ pick (importedByUser mod_imports)\n    ]\n\n  -- We want to keep only one for each original module; preferably one with an\n  -- explicit import list (for no particularly good reason)\n  pick :: [ImportedModsVal] -> Maybe ImportedModsVal\n  pick = listToMaybe . sortBy (compare `on` prefer) . filter select\n    where select imv = case mod_name of Just name -> imv_name imv == name\n                                        Nothing   -> not (imv_qualified imv)\n          prefer imv = (imv_is_hiding imv, imv_span imv)\n\n  -- Which of these would export a 'foo'\n  -- (all of these are restricted imports, because if they were not, we\n  -- wouldn't have an out-of-scope error in the first place)\n  helpful_imports = filter helpful interesting_imports\n    where helpful (_,imv)\n            = not . null $ lookupGlobalRdrEnv (imv_all_exports imv) occ_name\n\n  -- Which of these do that because of an explicit hiding list resp. an\n  -- explicit import list\n  (helpful_imports_hiding, helpful_imports_non_hiding)\n    = partition (imv_is_hiding . snd) helpful_imports\n\n  -- See note [When to show/hide the module-not-imported line]\n  show_not_imported_line :: ModuleName -> Bool                    -- #15611\n  show_not_imported_line modnam\n      | modnam `elem` globMods                = False    -- #14225     -- 1\n      | moduleName currMod == modnam          = False                  -- 2.1\n      | is_last_loaded_mod modnam hpt_uniques = False                  -- 2.2\n      | otherwise                             = True\n    where\n      hpt_uniques = map fst (udfmToList hpt)\n      is_last_loaded_mod _ []         = False\n      is_last_loaded_mod modnam uniqs = last uniqs == getUnique modnam\n      globMods = nub [ mod\n                     | gre <- globalRdrEnvElts global_env\n                     , isGreOk where_look gre\n                     , (mod, _) <- qualsInScope gre\n                     ]\n\nextensionSuggestions :: RdrName -> SDoc\nextensionSuggestions rdrName\n  | rdrName == mkUnqual varName (fsLit \"mdo\") ||\n    rdrName == mkUnqual varName (fsLit \"rec\")\n      = text \"Perhaps you meant to use RecursiveDo\"\n  | otherwise = Outputable.empty\n\nqualsInScope :: GlobalRdrElt -> [(ModuleName, HowInScope)]\n-- Ones for which the qualified version is in scope\nqualsInScope GRE { gre_name = n, gre_lcl = lcl, gre_imp = is }\n      | lcl = case nameModule_maybe n of\n                Nothing -> []\n                Just m  -> [(moduleName m, Left (nameSrcSpan n))]\n      | otherwise = [ (is_as ispec, Right ispec)\n                    | i <- is, let ispec = is_decl i ]\n\nisGreOk :: WhereLooking -> GlobalRdrElt -> Bool\nisGreOk where_look = case where_look of\n                         WL_LocalTop  -> isLocalGRE\n                         WL_LocalOnly -> const False\n                         _            -> const True\n\n{- Note [When to show/hide the module-not-imported line]           -- #15611\nFor the error message:\n    Not in scope X.Y\n    Module X does not export Y\n    No module named \u00e2\u20ac\u02dcX\u00e2\u20ac\u2122 is imported:\nthere are 2 cases, where we hide the last \"no module is imported\" line:\n1. If the module X has been imported.\n2. If the module X is the current module. There are 2 subcases:\n   2.1 If the unknown module name is in a input source file,\n       then we can use the getModule function to get the current module name.\n       (See test T15611a)\n   2.2 If the unknown module name has been entered by the user in GHCi,\n       then the getModule function returns something like \"interactive:Ghci1\",\n       and we have to check the current module in the last added entry of\n       the HomePackageTable. (See test T15611b)\n-}\n", "num_lines": 382}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nThis module contains miscellaneous functions related to renaming.\n\n-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule RnUtils (\n        checkDupRdrNames, checkShadowedRdrNames,\n        checkDupNames, checkDupAndShadowedNames, dupNamesErr,\n        checkTupSize,\n        addFvRn, mapFvRn, mapMaybeFvRn,\n        warnUnusedMatches, warnUnusedTypePatterns,\n        warnUnusedTopBinds, warnUnusedLocalBinds,\n        checkUnusedRecordWildcard,\n        mkFieldEnv,\n        unknownSubordinateErr, badQualBndrErr, typeAppErr,\n        HsDocContext(..), pprHsDocContext,\n        inHsDocContext, withHsDocContext,\n\n        newLocalBndrRn, newLocalBndrsRn,\n\n        bindLocalNames, bindLocalNamesFV,\n\n        addNameClashErrRn, extendTyVarEnvFVRn\n\n)\n\nwhere\n\n\nimport GhcPrelude\n\nimport HsSyn\nimport RdrName\nimport HscTypes\nimport TcEnv\nimport TcRnMonad\nimport Name\nimport NameSet\nimport NameEnv\nimport DataCon\nimport SrcLoc\nimport Outputable\nimport Util\nimport BasicTypes       ( TopLevelFlag(..) )\nimport ListSetOps       ( removeDups )\nimport DynFlags\nimport FastString\nimport Control.Monad\nimport Data.List\nimport Constants        ( mAX_TUPLE_SIZE )\nimport qualified Data.List.NonEmpty as NE\nimport qualified GHC.LanguageExtensions as LangExt\n\n{-\n*********************************************************\n*                                                      *\n\\subsection{Binding}\n*                                                      *\n*********************************************************\n-}\n\nnewLocalBndrRn :: Located RdrName -> RnM Name\n-- Used for non-top-level binders.  These should\n-- never be qualified.\nnewLocalBndrRn (dL->L loc rdr_name)\n  | Just name <- isExact_maybe rdr_name\n  = return name -- This happens in code generated by Template Haskell\n                -- See Note [Binders in Template Haskell] in Convert.hs\n  | otherwise\n  = do { unless (isUnqual rdr_name)\n                (addErrAt loc (badQualBndrErr rdr_name))\n       ; uniq <- newUnique\n       ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }\n\nnewLocalBndrsRn :: [Located RdrName] -> RnM [Name]\nnewLocalBndrsRn = mapM newLocalBndrRn\n\nbindLocalNames :: [Name] -> RnM a -> RnM a\nbindLocalNames names enclosed_scope\n  = do { lcl_env <- getLclEnv\n       ; let th_level  = thLevel (tcl_th_ctxt lcl_env)\n             th_bndrs' = extendNameEnvList (tcl_th_bndrs lcl_env)\n                           [ (n, (NotTopLevel, th_level)) | n <- names ]\n             rdr_env'  = extendLocalRdrEnvList (tcl_rdr lcl_env) names\n       ; setLclEnv (lcl_env { tcl_th_bndrs = th_bndrs'\n                            , tcl_rdr      = rdr_env' })\n                    enclosed_scope }\n\nbindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)\nbindLocalNamesFV names enclosed_scope\n  = do  { (result, fvs) <- bindLocalNames names enclosed_scope\n        ; return (result, delFVs names fvs) }\n\n-------------------------------------\n\nextendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)\nextendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside\n\n-------------------------------------\ncheckDupRdrNames :: [Located RdrName] -> RnM ()\n-- Check for duplicated names in a binding group\ncheckDupRdrNames rdr_names_w_loc\n  = mapM_ (dupNamesErr getLoc) dups\n  where\n    (_, dups) = removeDups (\\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc\n\ncheckDupNames :: [Name] -> RnM ()\n-- Check for duplicated names in a binding group\ncheckDupNames names = check_dup_names (filterOut isSystemName names)\n                -- See Note [Binders in Template Haskell] in Convert\n\ncheck_dup_names :: [Name] -> RnM ()\ncheck_dup_names names\n  = mapM_ (dupNamesErr nameSrcSpan) dups\n  where\n    (_, dups) = removeDups (\\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names\n\n---------------------\ncheckShadowedRdrNames :: [Located RdrName] -> RnM ()\ncheckShadowedRdrNames loc_rdr_names\n  = do { envs <- getRdrEnvs\n       ; checkShadowedOccs envs get_loc_occ filtered_rdrs }\n  where\n    filtered_rdrs = filterOut (isExact . unLoc) loc_rdr_names\n                -- See Note [Binders in Template Haskell] in Convert\n    get_loc_occ (dL->L loc rdr) = (loc,rdrNameOcc rdr)\n\ncheckDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM ()\ncheckDupAndShadowedNames envs names\n  = do { check_dup_names filtered_names\n       ; checkShadowedOccs envs get_loc_occ filtered_names }\n  where\n    filtered_names = filterOut isSystemName names\n                -- See Note [Binders in Template Haskell] in Convert\n    get_loc_occ name = (nameSrcSpan name, nameOccName name)\n\n-------------------------------------\ncheckShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv)\n                  -> (a -> (SrcSpan, OccName))\n                  -> [a] -> RnM ()\ncheckShadowedOccs (global_env,local_env) get_loc_occ ns\n  = whenWOptM Opt_WarnNameShadowing $\n    do  { traceRn \"checkShadowedOccs:shadow\" (ppr (map get_loc_occ ns))\n        ; mapM_ check_shadow ns }\n  where\n    check_shadow n\n        | startsWithUnderscore occ = return ()  -- Do not report shadowing for \"_x\"\n                                                -- See Trac #3262\n        | Just n <- mb_local = complain [text \"bound at\" <+> ppr (nameSrcLoc n)]\n        | otherwise = do { gres' <- filterM is_shadowed_gre gres\n                         ; complain (map pprNameProvenance gres') }\n        where\n          (loc,occ) = get_loc_occ n\n          mb_local  = lookupLocalRdrOcc local_env occ\n          gres      = lookupGRE_RdrName (mkRdrUnqual occ) global_env\n                -- Make an Unqualified RdrName and look that up, so that\n                -- we don't find any GREs that are in scope qualified-only\n\n          complain []      = return ()\n          complain pp_locs = addWarnAt (Reason Opt_WarnNameShadowing)\n                                       loc\n                                       (shadowedNameWarn occ pp_locs)\n\n    is_shadowed_gre :: GlobalRdrElt -> RnM Bool\n        -- Returns False for record selectors that are shadowed, when\n        -- punning or wild-cards are on (cf Trac #2723)\n    is_shadowed_gre gre | isRecFldGRE gre\n        = do { dflags <- getDynFlags\n             ; return $ not (xopt LangExt.RecordPuns dflags\n                             || xopt LangExt.RecordWildCards dflags) }\n    is_shadowed_gre _other = return True\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Free variable manipulation}\n*                                                                      *\n************************************************************************\n-}\n\n-- A useful utility\naddFvRn :: FreeVars -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)\naddFvRn fvs1 thing_inside = do { (res, fvs2) <- thing_inside\n                               ; return (res, fvs1 `plusFV` fvs2) }\n\nmapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)\nmapFvRn f xs = do stuff <- mapM f xs\n                  case unzip stuff of\n                      (ys, fvs_s) -> return (ys, plusFVs fvs_s)\n\nmapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)\nmapMaybeFvRn _ Nothing = return (Nothing, emptyFVs)\nmapMaybeFvRn f (Just x) = do { (y, fvs) <- f x; return (Just y, fvs) }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Envt utility functions}\n*                                                                      *\n************************************************************************\n-}\n\nwarnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()\nwarnUnusedTopBinds gres\n    = whenWOptM Opt_WarnUnusedTopBinds\n    $ do env <- getGblEnv\n         let isBoot = tcg_src env == HsBootFile\n         let noParent gre = case gre_par gre of\n                            NoParent -> True\n                            _        -> False\n             -- Don't warn about unused bindings with parents in\n             -- .hs-boot files, as you are sometimes required to give\n             -- unused bindings (trac #3449).\n             -- HOWEVER, in a signature file, you are never obligated to put a\n             -- definition in the main text.  Thus, if you define something\n             -- and forget to export it, we really DO want to warn.\n             gres' = if isBoot then filter noParent gres\n                               else                 gres\n         warnUnusedGREs gres'\n\n\n-- | Checks to see if we need to warn for -Wunused-record-wildcards or\n-- -Wredundant-record-wildcards\ncheckUnusedRecordWildcard :: SrcSpan\n                          -> FreeVars\n                          -> Maybe [Name]\n                          -> RnM ()\ncheckUnusedRecordWildcard _ _ Nothing    = return ()\ncheckUnusedRecordWildcard loc _ (Just [])  = do\n  -- Add a new warning if the .. pattern binds no variables\n  setSrcSpan loc $ warnRedundantRecordWildcard\ncheckUnusedRecordWildcard loc fvs (Just dotdot_names) =\n  setSrcSpan loc $ warnUnusedRecordWildcard dotdot_names fvs\n\n\n-- | Produce a warning when the `..` pattern binds no new\n-- variables.\n--\n-- @\n--   data P = P { x :: Int }\n--\n--   foo (P{x, ..}) = x\n-- @\n--\n-- The `..` here doesn't bind any variables as `x` is already bound.\nwarnRedundantRecordWildcard :: RnM ()\nwarnRedundantRecordWildcard =\n  whenWOptM Opt_WarnRedundantRecordWildcards\n            (addWarn (Reason Opt_WarnRedundantRecordWildcards)\n                     redundantWildcardWarning)\n\n\n-- | Produce a warning when no variables bound by a `..` pattern are used.\n--\n-- @\n--   data P = P { x :: Int }\n--\n--   foo (P{..}) = ()\n-- @\n--\n-- The `..` pattern binds `x` but it is not used in the RHS so we issue\n-- a warning.\nwarnUnusedRecordWildcard :: [Name] -> FreeVars -> RnM ()\nwarnUnusedRecordWildcard ns used_names = do\n  let used = filter (`elemNameSet` used_names) ns\n  traceRn \"warnUnused\" (ppr ns $$ ppr used_names $$ ppr used)\n  warnIfFlag Opt_WarnUnusedRecordWildcards (null used)\n    unusedRecordWildcardWarning\n\n\n\nwarnUnusedLocalBinds, warnUnusedMatches, warnUnusedTypePatterns\n  :: [Name] -> FreeVars -> RnM ()\nwarnUnusedLocalBinds   = check_unused Opt_WarnUnusedLocalBinds\nwarnUnusedMatches      = check_unused Opt_WarnUnusedMatches\nwarnUnusedTypePatterns = check_unused Opt_WarnUnusedTypePatterns\n\ncheck_unused :: WarningFlag -> [Name] -> FreeVars -> RnM ()\ncheck_unused flag bound_names used_names\n  = whenWOptM flag (warnUnused flag (filterOut (`elemNameSet` used_names)\n                                               bound_names))\n\n-------------------------\n--      Helpers\nwarnUnusedGREs :: [GlobalRdrElt] -> RnM ()\nwarnUnusedGREs gres = mapM_ warnUnusedGRE gres\n\nwarnUnused :: WarningFlag -> [Name] -> RnM ()\nwarnUnused flag names = do\n    fld_env <- mkFieldEnv <$> getGlobalRdrEnv\n    mapM_ (warnUnused1 flag fld_env) names\n\nwarnUnused1 :: WarningFlag -> NameEnv (FieldLabelString, Name) -> Name -> RnM ()\nwarnUnused1 flag fld_env name\n  = when (reportable name occ) $\n    addUnusedWarning flag\n                     occ (nameSrcSpan name)\n                     (text $ \"Defined but not used\" ++ opt_str)\n  where\n    occ = case lookupNameEnv fld_env name of\n              Just (fl, _) -> mkVarOccFS fl\n              Nothing      -> nameOccName name\n    opt_str = case flag of\n                Opt_WarnUnusedTypePatterns -> \" on the right hand side\"\n                _ -> \"\"\n\nwarnUnusedGRE :: GlobalRdrElt -> RnM ()\nwarnUnusedGRE gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = is })\n  | lcl       = do fld_env <- mkFieldEnv <$> getGlobalRdrEnv\n                   warnUnused1 Opt_WarnUnusedTopBinds fld_env name\n  | otherwise = when (reportable name occ) (mapM_ warn is)\n  where\n    occ = greOccName gre\n    warn spec = addUnusedWarning Opt_WarnUnusedTopBinds occ span msg\n        where\n           span = importSpecLoc spec\n           pp_mod = quotes (ppr (importSpecModule spec))\n           msg = text \"Imported from\" <+> pp_mod <+> ptext (sLit \"but not used\")\n\n-- | Make a map from selector names to field labels and parent tycon\n-- names, to be used when reporting unused record fields.\nmkFieldEnv :: GlobalRdrEnv -> NameEnv (FieldLabelString, Name)\nmkFieldEnv rdr_env = mkNameEnv [ (gre_name gre, (lbl, par_is (gre_par gre)))\n                               | gres <- occEnvElts rdr_env\n                               , gre <- gres\n                               , Just lbl <- [greLabel gre]\n                               ]\n\n-- | Should we report the fact that this 'Name' is unused? The\n-- 'OccName' may differ from 'nameOccName' due to\n-- DuplicateRecordFields.\nreportable :: Name -> OccName -> Bool\nreportable name occ\n  | isWiredInName name = False    -- Don't report unused wired-in names\n                                  -- Otherwise we get a zillion warnings\n                                  -- from Data.Tuple\n  | otherwise = not (startsWithUnderscore occ)\n\naddUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM ()\naddUnusedWarning flag occ span msg\n  = addWarnAt (Reason flag) span $\n    sep [msg <> colon,\n         nest 2 $ pprNonVarNameSpace (occNameSpace occ)\n                        <+> quotes (ppr occ)]\n\nunusedRecordWildcardWarning :: SDoc\nunusedRecordWildcardWarning =\n  wildcardDoc $ text \"No variables bound in the record wildcard match are used\"\n\nredundantWildcardWarning :: SDoc\nredundantWildcardWarning =\n  wildcardDoc $ text \"Record wildcard does not bind any new variables\"\n\nwildcardDoc :: SDoc -> SDoc\nwildcardDoc herald =\n  herald\n    $$ nest 2 (text \"Possible fix\" <> colon <+> text \"omit the\"\n                                            <+> quotes (text \"..\"))\n\naddNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM ()\naddNameClashErrRn rdr_name gres\n  | all isLocalGRE gres && not (all isRecFldGRE gres)\n               -- If there are two or more *local* defns, we'll have reported\n  = return ()  -- that already, and we don't want an error cascade\n  | otherwise\n  = addErr (vcat [ text \"Ambiguous occurrence\" <+> quotes (ppr rdr_name)\n                 , text \"It could refer to\"\n                 , nest 3 (vcat (msg1 : msgs)) ])\n  where\n    (np1:nps) = gres\n    msg1 =  text \"either\" <+> ppr_gre np1\n    msgs = [text \"    or\" <+> ppr_gre np | np <- nps]\n    ppr_gre gre = sep [ pp_gre_name gre <> comma\n                      , pprNameProvenance gre]\n\n    -- When printing the name, take care to qualify it in the same\n    -- way as the provenance reported by pprNameProvenance, namely\n    -- the head of 'gre_imp'.  Otherwise we get confusing reports like\n    --   Ambiguous occurrence \u00e2\u20ac\u02dcnull\u00e2\u20ac\u2122\n    --   It could refer to either \u00e2\u20ac\u02dcT15487a.null\u00e2\u20ac\u2122,\n    --                            imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at T15487.hs:1:8-13\n    --                     or ...\n    -- See Trac #15487\n    pp_gre_name gre@(GRE { gre_name = name, gre_par = parent\n                         , gre_lcl = lcl, gre_imp = iss })\n      | FldParent { par_lbl = Just lbl } <- parent\n      = text \"the field\" <+> quotes (ppr lbl)\n      | otherwise\n      = quotes (pp_qual <> dot <> ppr (nameOccName name))\n      where\n        pp_qual | lcl\n                = ppr (nameModule name)\n                | imp : _ <- iss  -- This 'imp' is the one that\n                                  -- pprNameProvenance chooses\n                , ImpDeclSpec { is_as = mod } <- is_decl imp\n                = ppr mod\n                | otherwise\n                = pprPanic \"addNameClassErrRn\" (ppr gre $$ ppr iss)\n                  -- Invariant: either 'lcl' is True or 'iss' is non-empty\n\nshadowedNameWarn :: OccName -> [SDoc] -> SDoc\nshadowedNameWarn occ shadowed_locs\n  = sep [text \"This binding for\" <+> quotes (ppr occ)\n            <+> text \"shadows the existing binding\" <> plural shadowed_locs,\n         nest 2 (vcat shadowed_locs)]\n\n\nunknownSubordinateErr :: SDoc -> RdrName -> SDoc\nunknownSubordinateErr doc op    -- Doc is \"method of class\" or\n                                -- \"field of constructor\"\n  = quotes (ppr op) <+> text \"is not a (visible)\" <+> doc\n\n\ndupNamesErr :: Outputable n => (n -> SrcSpan) -> NE.NonEmpty n -> RnM ()\ndupNamesErr get_loc names\n  = addErrAt big_loc $\n    vcat [text \"Conflicting definitions for\" <+> quotes (ppr (NE.head names)),\n          locations]\n  where\n    locs      = map get_loc (NE.toList names)\n    big_loc   = foldr1 combineSrcSpans locs\n    locations = text \"Bound at:\" <+> vcat (map ppr (sort locs))\n\nbadQualBndrErr :: RdrName -> SDoc\nbadQualBndrErr rdr_name\n  = text \"Qualified name in binding position:\" <+> ppr rdr_name\n\ntypeAppErr :: String -> LHsType GhcPs -> SDoc\ntypeAppErr what (L _ k)\n  = hang (text \"Illegal visible\" <+> text what <+> text \"application\"\n            <+> quotes (char '@' <> ppr k))\n       2 (text \"Perhaps you intended to use TypeApplications\")\n\ncheckTupSize :: Int -> RnM ()\ncheckTupSize tup_size\n  | tup_size <= mAX_TUPLE_SIZE\n  = return ()\n  | otherwise\n  = addErr (sep [text \"A\" <+> int tup_size <> ptext (sLit \"-tuple is too large for GHC\"),\n                 nest 2 (parens (text \"max size is\" <+> int mAX_TUPLE_SIZE)),\n                 nest 2 (text \"Workaround: use nested tuples or define a data type\")])\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Contexts for renaming errors}\n*                                                                      *\n************************************************************************\n-}\n\n-- AZ:TODO: Change these all to be Name instead of RdrName.\n--          Merge TcType.UserTypeContext in to it.\ndata HsDocContext\n  = TypeSigCtx SDoc\n  | PatCtx\n  | SpecInstSigCtx\n  | DefaultDeclCtx\n  | ForeignDeclCtx (Located RdrName)\n  | DerivDeclCtx\n  | RuleCtx FastString\n  | TyDataCtx (Located RdrName)\n  | TySynCtx (Located RdrName)\n  | TyFamilyCtx (Located RdrName)\n  | FamPatCtx (Located RdrName)    -- The patterns of a type/data family instance\n  | ConDeclCtx [Located Name]\n  | ClassDeclCtx (Located RdrName)\n  | ExprWithTySigCtx\n  | TypBrCtx\n  | HsTypeCtx\n  | GHCiCtx\n  | SpliceTypeCtx (LHsType GhcPs)\n  | ClassInstanceCtx\n  | GenericCtx SDoc   -- Maybe we want to use this more!\n\nwithHsDocContext :: HsDocContext -> SDoc -> SDoc\nwithHsDocContext ctxt doc = doc $$ inHsDocContext ctxt\n\ninHsDocContext :: HsDocContext -> SDoc\ninHsDocContext ctxt = text \"In\" <+> pprHsDocContext ctxt\n\npprHsDocContext :: HsDocContext -> SDoc\npprHsDocContext (GenericCtx doc)      = doc\npprHsDocContext (TypeSigCtx doc)      = text \"the type signature for\" <+> doc\npprHsDocContext PatCtx                = text \"a pattern type-signature\"\npprHsDocContext SpecInstSigCtx        = text \"a SPECIALISE instance pragma\"\npprHsDocContext DefaultDeclCtx        = text \"a `default' declaration\"\npprHsDocContext DerivDeclCtx          = text \"a deriving declaration\"\npprHsDocContext (RuleCtx name)        = text \"the transformation rule\" <+> ftext name\npprHsDocContext (TyDataCtx tycon)     = text \"the data type declaration for\" <+> quotes (ppr tycon)\npprHsDocContext (FamPatCtx tycon)     = text \"a type pattern of family instance for\" <+> quotes (ppr tycon)\npprHsDocContext (TySynCtx name)       = text \"the declaration for type synonym\" <+> quotes (ppr name)\npprHsDocContext (TyFamilyCtx name)    = text \"the declaration for type family\" <+> quotes (ppr name)\npprHsDocContext (ClassDeclCtx name)   = text \"the declaration for class\" <+> quotes (ppr name)\npprHsDocContext ExprWithTySigCtx      = text \"an expression type signature\"\npprHsDocContext TypBrCtx              = text \"a Template-Haskell quoted type\"\npprHsDocContext HsTypeCtx             = text \"a type argument\"\npprHsDocContext GHCiCtx               = text \"GHCi input\"\npprHsDocContext (SpliceTypeCtx hs_ty) = text \"the spliced type\" <+> quotes (ppr hs_ty)\npprHsDocContext ClassInstanceCtx      = text \"TcSplice.reifyInstances\"\n\npprHsDocContext (ForeignDeclCtx name)\n   = text \"the foreign declaration for\" <+> quotes (ppr name)\npprHsDocContext (ConDeclCtx [name])\n   = text \"the definition of data constructor\" <+> quotes (ppr name)\npprHsDocContext (ConDeclCtx names)\n   = text \"the definition of data constructors\" <+> interpp'SP names\n", "num_lines": 513}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section[CoreMonad]{The core pipeline monad}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule CoreMonad (\n    -- * Configuration of the core-to-core passes\n    CoreToDo(..), runWhen, runMaybe,\n    SimplMode(..),\n    FloatOutSwitches(..),\n    pprPassDetails,\n\n    -- * Plugins\n    CorePluginPass, bindsOnlyPass,\n\n    -- * Counting\n    SimplCount, doSimplTick, doFreeSimplTick, simplCountN,\n    pprSimplCount, plusSimplCount, zeroSimplCount,\n    isZeroSimplCount, hasDetailedCounts, Tick(..),\n\n    -- * The monad\n    CoreM, runCoreM,\n\n    -- ** Reading from the monad\n    getHscEnv, getRuleBase, getModule,\n    getDynFlags, getOrigNameCache, getPackageFamInstEnv,\n    getVisibleOrphanMods,\n    getPrintUnqualified, getSrcSpanM,\n\n    -- ** Writing to the monad\n    addSimplCount,\n\n    -- ** Lifting into the monad\n    liftIO, liftIOWithCount,\n    liftIO1, liftIO2, liftIO3, liftIO4,\n\n    -- ** Global initialization\n    reinitializeGlobals,\n\n    -- ** Dealing with annotations\n    getAnnotations, getFirstAnnotations,\n\n    -- ** Screen output\n    putMsg, putMsgS, errorMsg, errorMsgS, warnMsg,\n    fatalErrorMsg, fatalErrorMsgS,\n    debugTraceMsg, debugTraceMsgS,\n    dumpIfSet_dyn\n  ) where\n\nimport GhcPrelude hiding ( read )\n\nimport CoreSyn\nimport HscTypes\nimport Module\nimport DynFlags\nimport BasicTypes       ( CompilerPhase(..) )\nimport Annotations\n\nimport IOEnv hiding     ( liftIO, failM, failWithM )\nimport qualified IOEnv  ( liftIO )\nimport Var\nimport Outputable\nimport FastString\nimport qualified ErrUtils as Err\nimport ErrUtils( Severity(..) )\nimport UniqSupply\nimport UniqFM       ( UniqFM, mapUFM, filterUFM )\nimport MonadUtils\nimport NameCache\nimport SrcLoc\nimport Data.List\nimport Data.Ord\nimport Data.Dynamic\nimport Data.IORef\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport qualified Data.Map.Strict as MapStrict\nimport Data.Word\nimport Control.Monad\nimport Control.Applicative ( Alternative(..) )\n\n{-\n************************************************************************\n*                                                                      *\n              The CoreToDo type and related types\n          Abstraction of core-to-core passes to run.\n*                                                                      *\n************************************************************************\n-}\n\ndata CoreToDo           -- These are diff core-to-core passes,\n                        -- which may be invoked in any order,\n                        -- as many times as you like.\n\n  = CoreDoSimplify      -- The core-to-core simplifier.\n        Int                    -- Max iterations\n        SimplMode\n  | CoreDoPluginPass String CorePluginPass\n  | CoreDoFloatInwards\n  | CoreDoFloatOutwards FloatOutSwitches\n  | CoreLiberateCase\n  | CoreDoPrintCore\n  | CoreDoStaticArgs\n  | CoreDoCallArity\n  | CoreDoExitify\n  | CoreDoStrictness\n  | CoreDoWorkerWrapper\n  | CoreDoSpecialising\n  | CoreDoSpecConstr\n  | CoreCSE\n  | CoreDoRuleCheck CompilerPhase String   -- Check for non-application of rules\n                                           -- matching this string\n  | CoreDoNothing                -- Useful when building up\n  | CoreDoPasses [CoreToDo]      -- lists of these things\n\n  | CoreDesugar    -- Right after desugaring, no simple optimisation yet!\n  | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces\n                       --                 Core output, and hence useful to pass to endPass\n\n  | CoreTidy\n  | CorePrep\n  | CoreOccurAnal\n\ninstance Outputable CoreToDo where\n  ppr (CoreDoSimplify _ _)     = text \"Simplifier\"\n  ppr (CoreDoPluginPass s _)   = text \"Core plugin: \" <+> text s\n  ppr CoreDoFloatInwards       = text \"Float inwards\"\n  ppr (CoreDoFloatOutwards f)  = text \"Float out\" <> parens (ppr f)\n  ppr CoreLiberateCase         = text \"Liberate case\"\n  ppr CoreDoStaticArgs         = text \"Static argument\"\n  ppr CoreDoCallArity          = text \"Called arity analysis\"\n  ppr CoreDoExitify            = text \"Exitification transformation\"\n  ppr CoreDoStrictness         = text \"Demand analysis\"\n  ppr CoreDoWorkerWrapper      = text \"Worker Wrapper binds\"\n  ppr CoreDoSpecialising       = text \"Specialise\"\n  ppr CoreDoSpecConstr         = text \"SpecConstr\"\n  ppr CoreCSE                  = text \"Common sub-expression\"\n  ppr CoreDesugar              = text \"Desugar (before optimization)\"\n  ppr CoreDesugarOpt           = text \"Desugar (after optimization)\"\n  ppr CoreTidy                 = text \"Tidy Core\"\n  ppr CorePrep                 = text \"CorePrep\"\n  ppr CoreOccurAnal            = text \"Occurrence analysis\"\n  ppr CoreDoPrintCore          = text \"Print core\"\n  ppr (CoreDoRuleCheck {})     = text \"Rule check\"\n  ppr CoreDoNothing            = text \"CoreDoNothing\"\n  ppr (CoreDoPasses passes)    = text \"CoreDoPasses\" <+> ppr passes\n\npprPassDetails :: CoreToDo -> SDoc\npprPassDetails (CoreDoSimplify n md) = vcat [ text \"Max iterations =\" <+> int n\n                                            , ppr md ]\npprPassDetails _ = Outputable.empty\n\ndata SimplMode             -- See comments in SimplMonad\n  = SimplMode\n        { sm_names      :: [String] -- Name(s) of the phase\n        , sm_phase      :: CompilerPhase\n        , sm_dflags     :: DynFlags -- Just for convenient non-monadic\n                                    -- access; we don't override these\n        , sm_rules      :: Bool     -- Whether RULES are enabled\n        , sm_inline     :: Bool     -- Whether inlining is enabled\n        , sm_case_case  :: Bool     -- Whether case-of-case is enabled\n        , sm_eta_expand :: Bool     -- Whether eta-expansion is enabled\n        }\n\ninstance Outputable SimplMode where\n    ppr (SimplMode { sm_phase = p, sm_names = ss\n                   , sm_rules = r, sm_inline = i\n                   , sm_eta_expand = eta, sm_case_case = cc })\n       = text \"SimplMode\" <+> braces (\n         sep [ text \"Phase =\" <+> ppr p <+>\n               brackets (text (concat $ intersperse \",\" ss)) <> comma\n             , pp_flag i   (sLit \"inline\") <> comma\n             , pp_flag r   (sLit \"rules\") <> comma\n             , pp_flag eta (sLit \"eta-expand\") <> comma\n             , pp_flag cc  (sLit \"case-of-case\") ])\n         where\n           pp_flag f s = ppUnless f (text \"no\") <+> ptext s\n\ndata FloatOutSwitches = FloatOutSwitches {\n  floatOutLambdas   :: Maybe Int,  -- ^ Just n <=> float lambdas to top level, if\n                                   -- doing so will abstract over n or fewer\n                                   -- value variables\n                                   -- Nothing <=> float all lambdas to top level,\n                                   --             regardless of how many free variables\n                                   -- Just 0 is the vanilla case: float a lambda\n                                   --    iff it has no free vars\n\n  floatOutConstants :: Bool,       -- ^ True <=> float constants to top level,\n                                   --            even if they do not escape a lambda\n  floatOutOverSatApps :: Bool,\n                             -- ^ True <=> float out over-saturated applications\n                             --            based on arity information.\n                             -- See Note [Floating over-saturated applications]\n                             -- in SetLevels\n  floatToTopLevelOnly :: Bool      -- ^ Allow floating to the top level only.\n  }\ninstance Outputable FloatOutSwitches where\n    ppr = pprFloatOutSwitches\n\npprFloatOutSwitches :: FloatOutSwitches -> SDoc\npprFloatOutSwitches sw\n  = text \"FOS\" <+> (braces $\n     sep $ punctuate comma $\n     [ text \"Lam =\"    <+> ppr (floatOutLambdas sw)\n     , text \"Consts =\" <+> ppr (floatOutConstants sw)\n     , text \"OverSatApps =\"   <+> ppr (floatOutOverSatApps sw) ])\n\n-- The core-to-core pass ordering is derived from the DynFlags:\nrunWhen :: Bool -> CoreToDo -> CoreToDo\nrunWhen True  do_this = do_this\nrunWhen False _       = CoreDoNothing\n\nrunMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo\nrunMaybe (Just x) f = f x\nrunMaybe Nothing  _ = CoreDoNothing\n\n{-\n\n************************************************************************\n*                                                                      *\n             Types for Plugins\n*                                                                      *\n************************************************************************\n-}\n\n-- | A description of the plugin pass itself\ntype CorePluginPass = ModGuts -> CoreM ModGuts\n\nbindsOnlyPass :: (CoreProgram -> CoreM CoreProgram) -> ModGuts -> CoreM ModGuts\nbindsOnlyPass pass guts\n  = do { binds' <- pass (mg_binds guts)\n       ; return (guts { mg_binds = binds' }) }\n\n{-\n************************************************************************\n*                                                                      *\n             Counting and logging\n*                                                                      *\n************************************************************************\n-}\n\ngetVerboseSimplStats :: (Bool -> SDoc) -> SDoc\ngetVerboseSimplStats = getPprDebug          -- For now, anyway\n\nzeroSimplCount     :: DynFlags -> SimplCount\nisZeroSimplCount   :: SimplCount -> Bool\nhasDetailedCounts  :: SimplCount -> Bool\npprSimplCount      :: SimplCount -> SDoc\ndoSimplTick        :: DynFlags -> Tick -> SimplCount -> SimplCount\ndoFreeSimplTick    ::             Tick -> SimplCount -> SimplCount\nplusSimplCount     :: SimplCount -> SimplCount -> SimplCount\n\ndata SimplCount\n   = VerySimplCount !Int        -- Used when don't want detailed stats\n\n   | SimplCount {\n        ticks   :: !Int,        -- Total ticks\n        details :: !TickCounts, -- How many of each type\n\n        n_log   :: !Int,        -- N\n        log1    :: [Tick],      -- Last N events; <= opt_HistorySize,\n                                --   most recent first\n        log2    :: [Tick]       -- Last opt_HistorySize events before that\n                                -- Having log1, log2 lets us accumulate the\n                                -- recent history reasonably efficiently\n     }\n\ntype TickCounts = Map Tick Int\n\nsimplCountN :: SimplCount -> Int\nsimplCountN (VerySimplCount n)         = n\nsimplCountN (SimplCount { ticks = n }) = n\n\nzeroSimplCount dflags\n                -- This is where we decide whether to do\n                -- the VerySimpl version or the full-stats version\n  | dopt Opt_D_dump_simpl_stats dflags\n  = SimplCount {ticks = 0, details = Map.empty,\n                n_log = 0, log1 = [], log2 = []}\n  | otherwise\n  = VerySimplCount 0\n\nisZeroSimplCount (VerySimplCount n)         = n==0\nisZeroSimplCount (SimplCount { ticks = n }) = n==0\n\nhasDetailedCounts (VerySimplCount {}) = False\nhasDetailedCounts (SimplCount {})     = True\n\ndoFreeSimplTick tick sc@SimplCount { details = dts }\n  = sc { details = dts `addTick` tick }\ndoFreeSimplTick _ sc = sc\n\ndoSimplTick dflags tick\n    sc@(SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1 })\n  | nl >= historySize dflags = sc1 { n_log = 1, log1 = [tick], log2 = l1 }\n  | otherwise                = sc1 { n_log = nl+1, log1 = tick : l1 }\n  where\n    sc1 = sc { ticks = tks+1, details = dts `addTick` tick }\n\ndoSimplTick _ _ (VerySimplCount n) = VerySimplCount (n+1)\n\n\naddTick :: TickCounts -> Tick -> TickCounts\naddTick fm tick = MapStrict.insertWith (+) tick 1 fm\n\nplusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 })\n               sc2@(SimplCount { ticks = tks2, details = dts2 })\n  = log_base { ticks = tks1 + tks2\n             , details = MapStrict.unionWith (+) dts1 dts2 }\n  where\n        -- A hackish way of getting recent log info\n    log_base | null (log1 sc2) = sc1    -- Nothing at all in sc2\n             | null (log2 sc2) = sc2 { log2 = log1 sc1 }\n             | otherwise       = sc2\n\nplusSimplCount (VerySimplCount n) (VerySimplCount m) = VerySimplCount (n+m)\nplusSimplCount _                  _                  = panic \"plusSimplCount\"\n       -- We use one or the other consistently\n\npprSimplCount (VerySimplCount n) = text \"Total ticks:\" <+> int n\npprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })\n  = vcat [text \"Total ticks:    \" <+> int tks,\n          blankLine,\n          pprTickCounts dts,\n          getVerboseSimplStats $ \\dbg -> if dbg\n          then\n                vcat [blankLine,\n                      text \"Log (most recent first)\",\n                      nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]\n          else Outputable.empty\n    ]\n\n{- Note [Which transformations are innocuous]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAt one point (Jun 18) I wondered if some transformations (ticks)\nmight be  \"innocuous\", in the sense that they do not unlock a later\ntransformation that does not occur in the same pass.  If so, we could\nrefrain from bumping the overall tick-count for such innocuous\ntransformations, and perhaps terminate the simplifier one pass\nearlier.\n\nBUt alas I found that virtually nothing was innocuous!  This Note\njust records what I learned, in case anyone wants to try again.\n\nThese transformations are not innocuous:\n\n*** NB: I think these ones could be made innocuous\n          EtaExpansion\n          LetFloatFromLet\n\nLetFloatFromLet\n    x = K (let z = e2 in Just z)\n  prepareRhs transforms to\n    x2 = let z=e2 in Just z\n    x  = K xs\n  And now more let-floating can happen in the\n  next pass, on x2\n\nPreInlineUnconditionally\n  Example in spectral/cichelli/Auxil\n     hinsert = ...let lo = e in\n                  let j = ...lo... in\n                  case x of\n                    False -> ()\n                    True -> case lo of I# lo' ->\n                              ...j...\n  When we PreInlineUnconditionally j, lo's occ-info changes to once,\n  so it can be PreInlineUnconditionally in the next pass, and a\n  cascade of further things can happen.\n\nPostInlineUnconditionally\n  let x = e in\n  let y = ...x.. in\n  case .. of { A -> ...x...y...\n               B -> ...x...y... }\n  Current postinlineUnconditinaly will inline y, and then x; sigh.\n\n  But PostInlineUnconditionally might also unlock subsequent\n  transformations for the same reason as PreInlineUnconditionally,\n  so it's probably not innocuous anyway.\n\nKnownBranch, BetaReduction:\n  May drop chunks of code, and thereby enable PreInlineUnconditionally\n  for some let-binding which now occurs once\n\nEtaExpansion:\n  Example in imaginary/digits-of-e1\n    fail = \\void. e          where e :: IO ()\n  --> etaExpandRhs\n    fail = \\void. (\\s. (e |> g) s) |> sym g      where g :: IO () ~ S -> (S,())\n  --> Next iteration of simplify\n    fail1 = \\void. \\s. (e |> g) s\n    fail = fail1 |> Void#->sym g\n  And now inline 'fail'\n\nCaseMerge:\n  case x of y {\n    DEFAULT -> case y of z { pi -> ei }\n    alts2 }\n  ---> CaseMerge\n    case x of { pi -> let z = y in ei\n              ; alts2 }\n  The \"let z=y\" case-binder-swap gets dealt with in the next pass\n-}\n\npprTickCounts :: Map Tick Int -> SDoc\npprTickCounts counts\n  = vcat (map pprTickGroup groups)\n  where\n    groups :: [[(Tick,Int)]]    -- Each group shares a comon tag\n                                -- toList returns common tags adjacent\n    groups = groupBy same_tag (Map.toList counts)\n    same_tag (tick1,_) (tick2,_) = tickToTag tick1 == tickToTag tick2\n\npprTickGroup :: [(Tick, Int)] -> SDoc\npprTickGroup group@((tick1,_):_)\n  = hang (int (sum [n | (_,n) <- group]) <+> text (tickString tick1))\n       2 (vcat [ int n <+> pprTickCts tick\n                                    -- flip as we want largest first\n               | (tick,n) <- sortBy (flip (comparing snd)) group])\npprTickGroup [] = panic \"pprTickGroup\"\n\ndata Tick  -- See Note [Which transformations are innocuous]\n  = PreInlineUnconditionally    Id\n  | PostInlineUnconditionally   Id\n\n  | UnfoldingDone               Id\n  | RuleFired                   FastString      -- Rule name\n\n  | LetFloatFromLet\n  | EtaExpansion                Id      -- LHS binder\n  | EtaReduction                Id      -- Binder on outer lambda\n  | BetaReduction               Id      -- Lambda binder\n\n\n  | CaseOfCase                  Id      -- Bndr on *inner* case\n  | KnownBranch                 Id      -- Case binder\n  | CaseMerge                   Id      -- Binder on outer case\n  | AltMerge                    Id      -- Case binder\n  | CaseElim                    Id      -- Case binder\n  | CaseIdentity                Id      -- Case binder\n  | FillInCaseDefault           Id      -- Case binder\n\n  | SimplifierDone              -- Ticked at each iteration of the simplifier\n\ninstance Outputable Tick where\n  ppr tick = text (tickString tick) <+> pprTickCts tick\n\ninstance Eq Tick where\n  a == b = case a `cmpTick` b of\n           EQ -> True\n           _ -> False\n\ninstance Ord Tick where\n  compare = cmpTick\n\ntickToTag :: Tick -> Int\ntickToTag (PreInlineUnconditionally _)  = 0\ntickToTag (PostInlineUnconditionally _) = 1\ntickToTag (UnfoldingDone _)             = 2\ntickToTag (RuleFired _)                 = 3\ntickToTag LetFloatFromLet               = 4\ntickToTag (EtaExpansion _)              = 5\ntickToTag (EtaReduction _)              = 6\ntickToTag (BetaReduction _)             = 7\ntickToTag (CaseOfCase _)                = 8\ntickToTag (KnownBranch _)               = 9\ntickToTag (CaseMerge _)                 = 10\ntickToTag (CaseElim _)                  = 11\ntickToTag (CaseIdentity _)              = 12\ntickToTag (FillInCaseDefault _)         = 13\ntickToTag SimplifierDone                = 16\ntickToTag (AltMerge _)                  = 17\n\ntickString :: Tick -> String\ntickString (PreInlineUnconditionally _) = \"PreInlineUnconditionally\"\ntickString (PostInlineUnconditionally _)= \"PostInlineUnconditionally\"\ntickString (UnfoldingDone _)            = \"UnfoldingDone\"\ntickString (RuleFired _)                = \"RuleFired\"\ntickString LetFloatFromLet              = \"LetFloatFromLet\"\ntickString (EtaExpansion _)             = \"EtaExpansion\"\ntickString (EtaReduction _)             = \"EtaReduction\"\ntickString (BetaReduction _)            = \"BetaReduction\"\ntickString (CaseOfCase _)               = \"CaseOfCase\"\ntickString (KnownBranch _)              = \"KnownBranch\"\ntickString (CaseMerge _)                = \"CaseMerge\"\ntickString (AltMerge _)                 = \"AltMerge\"\ntickString (CaseElim _)                 = \"CaseElim\"\ntickString (CaseIdentity _)             = \"CaseIdentity\"\ntickString (FillInCaseDefault _)        = \"FillInCaseDefault\"\ntickString SimplifierDone               = \"SimplifierDone\"\n\npprTickCts :: Tick -> SDoc\npprTickCts (PreInlineUnconditionally v) = ppr v\npprTickCts (PostInlineUnconditionally v)= ppr v\npprTickCts (UnfoldingDone v)            = ppr v\npprTickCts (RuleFired v)                = ppr v\npprTickCts LetFloatFromLet              = Outputable.empty\npprTickCts (EtaExpansion v)             = ppr v\npprTickCts (EtaReduction v)             = ppr v\npprTickCts (BetaReduction v)            = ppr v\npprTickCts (CaseOfCase v)               = ppr v\npprTickCts (KnownBranch v)              = ppr v\npprTickCts (CaseMerge v)                = ppr v\npprTickCts (AltMerge v)                 = ppr v\npprTickCts (CaseElim v)                 = ppr v\npprTickCts (CaseIdentity v)             = ppr v\npprTickCts (FillInCaseDefault v)        = ppr v\npprTickCts _                            = Outputable.empty\n\ncmpTick :: Tick -> Tick -> Ordering\ncmpTick a b = case (tickToTag a `compare` tickToTag b) of\n                GT -> GT\n                EQ -> cmpEqTick a b\n                LT -> LT\n\ncmpEqTick :: Tick -> Tick -> Ordering\ncmpEqTick (PreInlineUnconditionally a)  (PreInlineUnconditionally b)    = a `compare` b\ncmpEqTick (PostInlineUnconditionally a) (PostInlineUnconditionally b)   = a `compare` b\ncmpEqTick (UnfoldingDone a)             (UnfoldingDone b)               = a `compare` b\ncmpEqTick (RuleFired a)                 (RuleFired b)                   = a `compare` b\ncmpEqTick (EtaExpansion a)              (EtaExpansion b)                = a `compare` b\ncmpEqTick (EtaReduction a)              (EtaReduction b)                = a `compare` b\ncmpEqTick (BetaReduction a)             (BetaReduction b)               = a `compare` b\ncmpEqTick (CaseOfCase a)                (CaseOfCase b)                  = a `compare` b\ncmpEqTick (KnownBranch a)               (KnownBranch b)                 = a `compare` b\ncmpEqTick (CaseMerge a)                 (CaseMerge b)                   = a `compare` b\ncmpEqTick (AltMerge a)                  (AltMerge b)                    = a `compare` b\ncmpEqTick (CaseElim a)                  (CaseElim b)                    = a `compare` b\ncmpEqTick (CaseIdentity a)              (CaseIdentity b)                = a `compare` b\ncmpEqTick (FillInCaseDefault a)         (FillInCaseDefault b)           = a `compare` b\ncmpEqTick _                             _                               = EQ\n\n{-\n************************************************************************\n*                                                                      *\n             Monad and carried data structure definitions\n*                                                                      *\n************************************************************************\n-}\n\nnewtype CoreState = CoreState {\n        cs_uniq_supply :: UniqSupply\n}\n\ndata CoreReader = CoreReader {\n        cr_hsc_env             :: HscEnv,\n        cr_rule_base           :: RuleBase,\n        cr_module              :: Module,\n        cr_print_unqual        :: PrintUnqualified,\n        cr_loc                 :: SrcSpan,   -- Use this for log/error messages so they\n                                             -- are at least tagged with the right source file\n        cr_visible_orphan_mods :: !ModuleSet\n}\n\n-- Note: CoreWriter used to be defined with data, rather than newtype.  If it\n-- is defined that way again, the cw_simpl_count field, at least, must be\n-- strict to avoid a space leak (Trac #7702).\nnewtype CoreWriter = CoreWriter {\n        cw_simpl_count :: SimplCount\n}\n\nemptyWriter :: DynFlags -> CoreWriter\nemptyWriter dflags = CoreWriter {\n        cw_simpl_count = zeroSimplCount dflags\n    }\n\nplusWriter :: CoreWriter -> CoreWriter -> CoreWriter\nplusWriter w1 w2 = CoreWriter {\n        cw_simpl_count = (cw_simpl_count w1) `plusSimplCount` (cw_simpl_count w2)\n    }\n\ntype CoreIOEnv = IOEnv CoreReader\n\n-- | The monad used by Core-to-Core passes to access common state, register simplification\n-- statistics and so on\nnewtype CoreM a = CoreM { unCoreM :: CoreState -> CoreIOEnv (a, CoreState, CoreWriter) }\n\ninstance Functor CoreM where\n    fmap = liftM\n\ninstance Monad CoreM where\n    mx >>= f = CoreM $ \\s -> do\n            (x, s', w1) <- unCoreM mx s\n            (y, s'', w2) <- unCoreM (f x) s'\n            let w = w1 `plusWriter` w2\n            return $ seq w (y, s'', w)\n            -- forcing w before building the tuple avoids a space leak\n            -- (Trac #7702)\n\ninstance Applicative CoreM where\n    pure x = CoreM $ \\s -> nop s x\n    (<*>) = ap\n    m *> k = m >>= \\_ -> k\n\ninstance Alternative CoreM where\n    empty   = CoreM (const Control.Applicative.empty)\n    m <|> n = CoreM (\\rs -> unCoreM m rs <|> unCoreM n rs)\n\ninstance MonadPlus CoreM\n\ninstance MonadUnique CoreM where\n    getUniqueSupplyM = do\n        us <- getS cs_uniq_supply\n        let (us1, us2) = splitUniqSupply us\n        modifyS (\\s -> s { cs_uniq_supply = us2 })\n        return us1\n\n    getUniqueM = do\n        us <- getS cs_uniq_supply\n        let (u,us') = takeUniqFromSupply us\n        modifyS (\\s -> s { cs_uniq_supply = us' })\n        return u\n\nrunCoreM :: HscEnv\n         -> RuleBase\n         -> UniqSupply\n         -> Module\n         -> ModuleSet\n         -> PrintUnqualified\n         -> SrcSpan\n         -> CoreM a\n         -> IO (a, SimplCount)\nrunCoreM hsc_env rule_base us mod orph_imps print_unqual loc m\n  = liftM extract $ runIOEnv reader $ unCoreM m state\n  where\n    reader = CoreReader {\n            cr_hsc_env = hsc_env,\n            cr_rule_base = rule_base,\n            cr_module = mod,\n            cr_visible_orphan_mods = orph_imps,\n            cr_print_unqual = print_unqual,\n            cr_loc = loc\n        }\n    state = CoreState {\n            cs_uniq_supply = us\n        }\n\n    extract :: (a, CoreState, CoreWriter) -> (a, SimplCount)\n    extract (value, _, writer) = (value, cw_simpl_count writer)\n\n{-\n************************************************************************\n*                                                                      *\n             Core combinators, not exported\n*                                                                      *\n************************************************************************\n-}\n\nnop :: CoreState -> a -> CoreIOEnv (a, CoreState, CoreWriter)\nnop s x = do\n    r <- getEnv\n    return (x, s, emptyWriter $ (hsc_dflags . cr_hsc_env) r)\n\nread :: (CoreReader -> a) -> CoreM a\nread f = CoreM (\\s -> getEnv >>= (\\r -> nop s (f r)))\n\ngetS :: (CoreState -> a) -> CoreM a\ngetS f = CoreM (\\s -> nop s (f s))\n\nmodifyS :: (CoreState -> CoreState) -> CoreM ()\nmodifyS f = CoreM (\\s -> nop (f s) ())\n\nwrite :: CoreWriter -> CoreM ()\nwrite w = CoreM (\\s -> return ((), s, w))\n\n-- \\subsection{Lifting IO into the monad}\n\n-- | Lift an 'IOEnv' operation into 'CoreM'\nliftIOEnv :: CoreIOEnv a -> CoreM a\nliftIOEnv mx = CoreM (\\s -> mx >>= (\\x -> nop s x))\n\ninstance MonadIO CoreM where\n    liftIO = liftIOEnv . IOEnv.liftIO\n\n-- | Lift an 'IO' operation into 'CoreM' while consuming its 'SimplCount'\nliftIOWithCount :: IO (SimplCount, a) -> CoreM a\nliftIOWithCount what = liftIO what >>= (\\(count, x) -> addSimplCount count >> return x)\n\n{-\n************************************************************************\n*                                                                      *\n             Reader, writer and state accessors\n*                                                                      *\n************************************************************************\n-}\n\ngetHscEnv :: CoreM HscEnv\ngetHscEnv = read cr_hsc_env\n\ngetRuleBase :: CoreM RuleBase\ngetRuleBase = read cr_rule_base\n\ngetVisibleOrphanMods :: CoreM ModuleSet\ngetVisibleOrphanMods = read cr_visible_orphan_mods\n\ngetPrintUnqualified :: CoreM PrintUnqualified\ngetPrintUnqualified = read cr_print_unqual\n\ngetSrcSpanM :: CoreM SrcSpan\ngetSrcSpanM = read cr_loc\n\naddSimplCount :: SimplCount -> CoreM ()\naddSimplCount count = write (CoreWriter { cw_simpl_count = count })\n\n-- Convenience accessors for useful fields of HscEnv\n\ninstance HasDynFlags CoreM where\n    getDynFlags = fmap hsc_dflags getHscEnv\n\ninstance HasModule CoreM where\n    getModule = read cr_module\n\n-- | The original name cache is the current mapping from 'Module' and\n-- 'OccName' to a compiler-wide unique 'Name'\ngetOrigNameCache :: CoreM OrigNameCache\ngetOrigNameCache = do\n    nameCacheRef <- fmap hsc_NC getHscEnv\n    liftIO $ fmap nsNames $ readIORef nameCacheRef\n\ngetPackageFamInstEnv :: CoreM PackageFamInstEnv\ngetPackageFamInstEnv = do\n    hsc_env <- getHscEnv\n    eps <- liftIO $ hscEPS hsc_env\n    return $ eps_fam_inst_env eps\n\n{-# DEPRECATED reinitializeGlobals \"It is not necessary to call reinitializeGlobals. Since GHC 8.2, this function is a no-op and will be removed in GHC 8.4\" #-}\nreinitializeGlobals :: CoreM ()\nreinitializeGlobals = return ()\n\n{-\n************************************************************************\n*                                                                      *\n             Dealing with annotations\n*                                                                      *\n************************************************************************\n-}\n\n-- | Get all annotations of a given type. This happens lazily, that is\n-- no deserialization will take place until the [a] is actually demanded and\n-- the [a] can also be empty (the UniqFM is not filtered).\n--\n-- This should be done once at the start of a Core-to-Core pass that uses\n-- annotations.\n--\n-- See Note [Annotations]\ngetAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (UniqFM [a])\ngetAnnotations deserialize guts = do\n     hsc_env <- getHscEnv\n     ann_env <- liftIO $ prepareAnnotations hsc_env (Just guts)\n     return (deserializeAnns deserialize ann_env)\n\n-- | Get at most one annotation of a given type per Unique.\ngetFirstAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (UniqFM a)\ngetFirstAnnotations deserialize guts\n  = liftM (mapUFM head . filterUFM (not . null))\n  $ getAnnotations deserialize guts\n\n{-\nNote [Annotations]\n~~~~~~~~~~~~~~~~~~\nA Core-to-Core pass that wants to make use of annotations calls\ngetAnnotations or getFirstAnnotations at the beginning to obtain a UniqFM with\nannotations of a specific type. This produces all annotations from interface\nfiles read so far. However, annotations from interface files read during the\npass will not be visible until getAnnotations is called again. This is similar\nto how rules work and probably isn't too bad.\n\nThe current implementation could be optimised a bit: when looking up\nannotations for a thing from the HomePackageTable, we could search directly in\nthe module where the thing is defined rather than building one UniqFM which\ncontains all annotations we know of. This would work because annotations can\nonly be given to things defined in the same module. However, since we would\nonly want to deserialise every annotation once, we would have to build a cache\nfor every module in the HTP. In the end, it's probably not worth it as long as\nwe aren't using annotations heavily.\n\n************************************************************************\n*                                                                      *\n                Direct screen output\n*                                                                      *\n************************************************************************\n-}\n\nmsg :: Severity -> SDoc -> CoreM ()\nmsg sev doc\n  = do { dflags <- getDynFlags\n       ; loc    <- getSrcSpanM\n       ; unqual <- getPrintUnqualified\n       ; let sty = case sev of\n                     SevError   -> err_sty\n                     SevWarning -> err_sty\n                     SevDump    -> dump_sty\n                     _          -> user_sty\n             err_sty  = mkErrStyle dflags unqual\n             user_sty = mkUserStyle dflags unqual AllTheWay\n             dump_sty = mkDumpStyle dflags unqual\n       ; liftIO $ putLogMsg dflags NoReason sev loc sty doc }\n\n-- | Output a String message to the screen\nputMsgS :: String -> CoreM ()\nputMsgS = putMsg . text\n\n-- | Output a message to the screen\nputMsg :: SDoc -> CoreM ()\nputMsg = msg SevInfo\n\n-- | Output an error to the screen. Does not cause the compiler to die.\nerrorMsgS :: String -> CoreM ()\nerrorMsgS = errorMsg . text\n\n-- | Output an error to the screen. Does not cause the compiler to die.\nerrorMsg :: SDoc -> CoreM ()\nerrorMsg = msg SevError\n\nwarnMsg :: SDoc -> CoreM ()\nwarnMsg = msg SevWarning\n\n-- | Output a fatal error to the screen. Does not cause the compiler to die.\nfatalErrorMsgS :: String -> CoreM ()\nfatalErrorMsgS = fatalErrorMsg . text\n\n-- | Output a fatal error to the screen. Does not cause the compiler to die.\nfatalErrorMsg :: SDoc -> CoreM ()\nfatalErrorMsg = msg SevFatal\n\n-- | Output a string debugging message at verbosity level of @-v@ or higher\ndebugTraceMsgS :: String -> CoreM ()\ndebugTraceMsgS = debugTraceMsg . text\n\n-- | Outputs a debugging message at verbosity level of @-v@ or higher\ndebugTraceMsg :: SDoc -> CoreM ()\ndebugTraceMsg = msg SevDump\n\n-- | Show some labelled 'SDoc' if a particular flag is set or at a verbosity level of @-v -ddump-most@ or higher\ndumpIfSet_dyn :: DumpFlag -> String -> SDoc -> CoreM ()\ndumpIfSet_dyn flag str doc\n  = do { dflags <- getDynFlags\n       ; unqual <- getPrintUnqualified\n       ; when (dopt flag dflags) $ liftIO $\n         Err.dumpSDoc dflags unqual flag str doc }\n", "num_lines": 845}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section{Common subexpression}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule CSE (cseProgram, cseOneExpr) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSubst\nimport Var              ( Var )\nimport VarEnv           ( elemInScopeSet, mkInScopeSet )\nimport Id               ( Id, idType, isDeadBinder\n                        , idInlineActivation, setInlineActivation\n                        , zapIdOccInfo, zapIdUsageInfo, idInlinePragma\n                        , isJoinId, isJoinId_maybe )\nimport CoreUtils        ( mkAltExpr, eqExpr\n                        , exprIsTickedString\n                        , stripTicksE, stripTicksT, mkTicks )\nimport CoreFVs          ( exprFreeVars )\nimport Type             ( tyConAppArgs )\nimport CoreSyn\nimport Outputable\nimport BasicTypes\nimport CoreMap\nimport Util             ( filterOut )\nimport Data.List        ( mapAccumL )\n\n{-\n                        Simple common sub-expression\n                        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we see\n        x1 = C a b\n        x2 = C x1 b\nwe build up a reverse mapping:   C a b  -> x1\n                                 C x1 b -> x2\nand apply that to the rest of the program.\n\nWhen we then see\n        y1 = C a b\n        y2 = C y1 b\nwe replace the C a b with x1.  But then we *dont* want to\nadd   x1 -> y1  to the mapping.  Rather, we want the reverse, y1 -> x1\nso that a subsequent binding\n        y2 = C y1 b\nwill get transformed to C x1 b, and then to x2.\n\nSo we carry an extra var->var substitution which we apply *before* looking up in the\nreverse mapping.\n\n\nNote [Shadowing]\n~~~~~~~~~~~~~~~~\nWe have to be careful about shadowing.\nFor example, consider\n        f = \\x -> let y = x+x in\n                      h = \\x -> x+x\n                  in ...\n\nHere we must *not* do CSE on the inner x+x!  The simplifier used to guarantee no\nshadowing, but it doesn't any more (it proved too hard), so we clone as we go.\nWe can simply add clones to the substitution already described.\n\n\nNote [CSE for bindings]\n~~~~~~~~~~~~~~~~~~~~~~~\nLet-bindings have two cases, implemented by addBinding.\n\n* SUBSTITUTE: applies when the RHS is a variable\n\n     let x = y in ...(h x)....\n\n  Here we want to extend the /substitution/ with x -> y, so that the\n  (h x) in the body might CSE with an enclosing (let v = h y in ...).\n  NB: the substitution maps InIds, so we extend the substitution with\n      a binding for the original InId 'x'\n\n  How can we have a variable on the RHS? Doesn't the simplifier inline them?\n\n    - First, the original RHS might have been (g z) which has CSE'd\n      with an enclosing (let y = g z in ...).  This is super-important.\n      See Trac #5996:\n         x1 = C a b\n         x2 = C x1 b\n         y1 = C a b\n         y2 = C y1 b\n      Here we CSE y1's rhs to 'x1', and then we must add (y1->x1) to\n      the substitution so that we can CSE the binding for y2.\n\n    - Second, we use addBinding for case expression scrutinees too;\n      see Note [CSE for case expressions]\n\n* EXTEND THE REVERSE MAPPING: applies in all other cases\n\n     let x = h y in ...(h y)...\n\n  Here we want to extend the /reverse mapping (cs_map)/ so that\n  we CSE the (h y) call to x.\n\n  Note that we use EXTEND even for a trivial expression, provided it\n  is not a variable or literal. In particular this /includes/ type\n  applications. This can be important (Trac #13156); e.g.\n     case f @ Int of { r1 ->\n     case f @ Int of { r2 -> ...\n  Here we want to common-up the two uses of (f @ Int) so we can\n  remove one of the case expressions.\n\n  See also Note [Corner case for case expressions] for another\n  reason not to use SUBSTITUTE for all trivial expressions.\n\nNotice that\n  - The SUBSTITUTE situation extends the substitution (cs_subst)\n  - The EXTEND situation extends the reverse mapping (cs_map)\n\nNotice also that in the SUBSTITUTE case we leave behind a binding\n  x = y\neven though we /also/ carry a substitution x -> y.  Can we just drop\nthe binding instead?  Well, not at top level! See SimplUtils\nNote [Top level and postInlineUnconditionally]; and in any case CSE\napplies only to the /bindings/ of the program, and we leave it to the\nsimplifier to propate effects to the RULES.  Finally, it doesn't seem\nworth the effort to discard the nested bindings because the simplifier\nwill do it next.\n\nNote [CSE for case expressions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  case scrut_expr of x { ...alts... }\nThis is very like a strict let-binding\n  let !x = scrut_expr in ...\nSo we use (addBinding x scrut_expr) to process scrut_expr and x, and as a\nresult all the stuff under Note [CSE for bindings] applies directly.\n\nFor example:\n\n* Trivial scrutinee\n     f = \\x -> case x of wild {\n                 (a:as) -> case a of wild1 {\n                             (p,q) -> ...(wild1:as)...\n\n  Here, (wild1:as) is morally the same as (a:as) and hence equal to\n  wild. But that's not quite obvious.  In the rest of the compiler we\n  want to keep it as (wild1:as), but for CSE purpose that's a bad\n  idea.\n\n  By using addBinding we add the binding (wild1 -> a) to the substitution,\n  which does exactly the right thing.\n\n  (Notice this is exactly backwards to what the simplifier does, which\n  is to try to replaces uses of 'a' with uses of 'wild1'.)\n\n  This is the main reason that addBinding is called with a trivial rhs.\n\n* Non-trivial scrutinee\n     case (f x) of y { pat -> ...let z = f x in ... }\n\n  By using addBinding we'll add (f x :-> y) to the cs_map, and\n  thereby CSE the inner (f x) to y.\n\nNote [CSE for INLINE and NOINLINE]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are some subtle interactions of CSE with functions that the user\nhas marked as INLINE or NOINLINE. (Examples from Roman Leshchinskiy.)\nConsider\n\n        yes :: Int  {-# NOINLINE yes #-}\n        yes = undefined\n\n        no :: Int   {-# NOINLINE no #-}\n        no = undefined\n\n        foo :: Int -> Int -> Int  {-# NOINLINE foo #-}\n        foo m n = n\n\n        {-# RULES \"foo/no\" foo no = id #-}\n\n        bar :: Int -> Int\n        bar = foo yes\n\nWe do not expect the rule to fire.  But if we do CSE, then we risk\ngetting yes=no, and the rule does fire.  Actually, it won't because\nNOINLINE means that 'yes' will never be inlined, not even if we have\nyes=no.  So that's fine (now; perhaps in the olden days, yes=no would\nhave substituted even if 'yes' was NOINLINE).\n\nBut we do need to take care.  Consider\n\n        {-# NOINLINE bar #-}\n        bar = <rhs>     -- Same rhs as foo\n\n        foo = <rhs>\n\nIf CSE produces\n        foo = bar\nthen foo will never be inlined to <rhs> (when it should be, if <rhs>\nis small).  The conclusion here is this:\n\n   We should not add\n       <rhs> :-> bar\n  to the CSEnv if 'bar' has any constraints on when it can inline;\n  that is, if its 'activation' not always active.  Otherwise we\n  might replace <rhs> by 'bar', and then later be unable to see that it\n  really was <rhs>.\n\nAn except to the rule is when the INLINE pragma is not from the user, e.g. from\nWorkWrap (see Note [Wrapper activation]). We can tell because noUserInlineSpec\nis then true.\n\nNote that we do not (currently) do CSE on the unfolding stored inside\nan Id, even if it is a 'stable' unfolding.  That means that when an\nunfolding happens, it is always faithful to what the stable unfolding\noriginally was.\n\nNote [CSE for stable unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   {-# Unf = Stable (\\pq. build blah) #-}\n   foo = x\n\nHere 'foo' has a stable unfolding, but its (optimised) RHS is trivial.\n(Turns out that this actually happens for the enumFromTo method of\nthe Integer instance of Enum in GHC.Enum.)  Suppose moreover that foo's\nstable unfolding originates from an INLINE or INLINEABLE pragma on foo.\nThen we obviously do NOT want to extend the substitution with (foo->x),\nbecause we promised to inline foo as what the user wrote.  See similar\nSimplUtils Note [Stable unfoldings and postInlineUnconditionally].\n\nNor do we want to change the reverse mapping. Suppose we have\n\n   {-# Unf = Stable (\\pq. build blah) #-}\n   foo = <expr>\n   bar = <expr>\n\nThere could conceivably be merit in rewriting the RHS of bar:\n   bar = foo\nbut now bar's inlining behaviour will change, and importing\nmodules might see that.  So it seems dodgy and we don't do it.\n\nStable unfoldings are also created during worker/wrapper when we decide\nthat a function's definition is so small that it should always inline.\nIn this case we still want to do CSE (#13340). Hence the use of\nisAnyInlinePragma rather than isStableUnfolding.\n\nNote [Corner case for case expressions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere is another reason that we do not use SUBSTITUTE for\nall trivial expressions. Consider\n   case x |> co of (y::Array# Int) { ... }\n\nWe do not want to extend the substitution with (y -> x |> co); since y\nis of unlifted type, this would destroy the let/app invariant if (x |>\nco) was not ok-for-speculation.\n\nBut surely (x |> co) is ok-for-speculation, becasue it's a trivial\nexpression, and x's type is also unlifted, presumably.  Well, maybe\nnot if you are using unsafe casts.  I actually found a case where we\nhad\n   (x :: HValue) |> (UnsafeCo :: HValue ~ Array# Int)\n\nNote [CSE for join points?]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must not be naive about join points in CSE:\n   join j = e in\n   if b then jump j else 1 + e\nThe expression (1 + jump j) is not good (see Note [Invariants on join points] in\nCoreSyn). This seems to come up quite seldom, but it happens (first seen\ncompiling ppHtml in Haddock.Backends.Xhtml).\n\nWe could try and be careful by tracking which join points are still valid at\neach subexpression, but since join points aren't allocated or shared, there's\nless to gain by trying to CSE them. (#13219)\n\nNote [Look inside join-point binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAnother way how CSE for joint points is tricky is\n\n  let join foo x = (x, 42)\n      join bar x = (x, 42)\n  in \u00e2\u20ac\u00a6 jump foo 1 \u00e2\u20ac\u00a6 jump bar 2 \u00e2\u20ac\u00a6\n\nnaively, CSE would turn this into\n\n  let join foo x = (x, 42)\n      join bar = foo\n  in \u00e2\u20ac\u00a6 jump foo 1 \u00e2\u20ac\u00a6 jump bar 2 \u00e2\u20ac\u00a6\n\nbut now bar is a join point that claims arity one, but its right-hand side\nis not a lambda, breaking the join-point invariant (this was #15002).\n\nSo `cse_bind` must zoom past the lambdas of a join point (using\n`collectNBinders`) and resume searching for CSE opportunities only in\nthe body of the join point.\n\nNote [CSE for recursive bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  f = \\x ... f....\n  g = \\y ... g ...\nwhere the \"...\" are identical.  Could we CSE them?  In full generality\nwith mutual recursion it's quite hard; but for self-recursive bindings\n(which are very common) it's rather easy:\n\n* Maintain a separate cs_rec_map, that maps\n      (\\f. (\\x. ...f...) ) -> f\n  Note the \\f in the domain of the mapping!\n\n* When we come across the binding for 'g', look up (\\g. (\\y. ...g...))\n  Bingo we get a hit.  So we can replace the 'g' binding with\n     g = f\n\nWe can't use cs_map for this, because the key isn't an expression of\nthe program; it's a kind of synthetic key for recursive bindings.\n\n\n************************************************************************\n*                                                                      *\n\\section{Common subexpression}\n*                                                                      *\n************************************************************************\n-}\n\ncseProgram :: CoreProgram -> CoreProgram\ncseProgram binds = snd (mapAccumL (cseBind TopLevel) emptyCSEnv binds)\n\ncseBind :: TopLevelFlag -> CSEnv -> CoreBind -> (CSEnv, CoreBind)\ncseBind toplevel env (NonRec b e)\n  = (env2, NonRec b2 e2)\n  where\n    (env1, b1)       = addBinder env b\n    (env2, (b2, e2)) = cse_bind toplevel env1 (b,e) b1\n\ncseBind toplevel env (Rec [(in_id, rhs)])\n  | noCSE in_id\n  = (env1, Rec [(out_id, rhs')])\n\n  -- See Note [CSE for recursive bindings]\n  | Just previous <- lookupCSRecEnv env out_id rhs''\n  , let previous' = mkTicks ticks previous\n        out_id'   = delayInlining toplevel out_id\n  = -- We have a hit in the recursive-binding cache\n    (extendCSSubst env1 in_id previous', NonRec out_id' previous')\n\n  | otherwise\n  = (extendCSRecEnv env1 out_id rhs'' id_expr', Rec [(zapped_id, rhs')])\n\n  where\n    (env1, [out_id]) = addRecBinders env [in_id]\n    rhs'  = cseExpr env1 rhs\n    rhs'' = stripTicksE tickishFloatable rhs'\n    ticks = stripTicksT tickishFloatable rhs'\n    id_expr'  = varToCoreExpr out_id\n    zapped_id = zapIdUsageInfo out_id\n\ncseBind toplevel env (Rec pairs)\n  = (env2, Rec pairs')\n  where\n    (env1, bndrs1) = addRecBinders env (map fst pairs)\n    (env2, pairs') = mapAccumL do_one env1 (zip pairs bndrs1)\n\n    do_one env (pr, b1) = cse_bind toplevel env pr b1\n\n-- | Given a binding of @in_id@ to @in_rhs@, and a fresh name to refer\n-- to @in_id@ (@out_id@, created from addBinder or addRecBinders),\n-- first try to CSE @in_rhs@, and then add the resulting (possibly CSE'd)\n-- binding to the 'CSEnv', so that we attempt to CSE any expressions\n-- which are equal to @out_rhs@.\ncse_bind :: TopLevelFlag -> CSEnv -> (InId, InExpr) -> OutId -> (CSEnv, (OutId, OutExpr))\ncse_bind toplevel env (in_id, in_rhs) out_id\n  | isTopLevel toplevel, exprIsTickedString in_rhs\n      -- See Note [Take care with literal strings]\n  = (env', (out_id', in_rhs))\n\n  | Just arity <- isJoinId_maybe in_id\n      -- See Note [Look inside join-point binders]\n  = let (params, in_body) = collectNBinders arity in_rhs\n        (env', params') = addBinders env params\n        out_body = tryForCSE env' in_body\n    in (env, (out_id, mkLams params' out_body))\n\n  | otherwise\n  = (env', (out_id'', out_rhs))\n  where\n    (env', out_id') = addBinding env in_id out_id out_rhs\n    (cse_done, out_rhs) = try_for_cse env in_rhs\n    out_id'' | cse_done  = delayInlining toplevel out_id'\n             | otherwise = out_id'\n\ndelayInlining :: TopLevelFlag -> Id -> Id\n-- Add a NOINLINE[2] if the Id doesn't have an INLNE pragma already\ndelayInlining top_lvl bndr\n  | isTopLevel top_lvl\n  , isAlwaysActive (idInlineActivation bndr)\n  = bndr `setInlineActivation` activeAfterInitial\n  | otherwise\n  = bndr\n\naddBinding :: CSEnv                      -- Includes InId->OutId cloning\n           -> InVar                      -- Could be a let-bound type\n           -> OutId -> OutExpr           -- Processed binding\n           -> (CSEnv, OutId)             -- Final env, final bndr\n-- Extend the CSE env with a mapping [rhs -> out-id]\n-- unless we can instead just substitute [in-id -> rhs]\n--\n-- It's possible for the binder to be a type variable (see\n-- Note [Type-let] in CoreSyn), in which case we can just substitute.\naddBinding env in_id out_id rhs'\n  | not (isId in_id) = (extendCSSubst env in_id rhs',     out_id)\n  | noCSE in_id      = (env,                              out_id)\n  | use_subst        = (extendCSSubst env in_id rhs',     out_id)\n  | otherwise        = (extendCSEnv env rhs' id_expr', zapped_id)\n  where\n    id_expr'  = varToCoreExpr out_id\n    zapped_id = zapIdUsageInfo out_id\n       -- Putting the Id into the cs_map makes it possible that\n       -- it'll become shared more than it is now, which would\n       -- invalidate (the usage part of) its demand info.\n       --    This caused Trac #100218.\n       -- Easiest thing is to zap the usage info; subsequently\n       -- performing late demand-analysis will restore it.  Don't zap\n       -- the strictness info; it's not necessary to do so, and losing\n       -- it is bad for performance if you don't do late demand\n       -- analysis\n\n    -- Should we use SUBSTITUTE or EXTEND?\n    -- See Note [CSE for bindings]\n    use_subst = case rhs' of\n                   Var {} -> True\n                   _      -> False\n\n-- | Given a binder `let x = e`, this function\n-- determines whether we should add `e -> x` to the cs_map\nnoCSE :: InId -> Bool\nnoCSE id =  not (isAlwaysActive (idInlineActivation id)) &&\n            not (noUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))\n             -- See Note [CSE for INLINE and NOINLINE]\n         || isAnyInlinePragma (idInlinePragma id)\n             -- See Note [CSE for stable unfoldings]\n         || isJoinId id\n             -- See Note [CSE for join points?]\n\n\n{- Note [Take care with literal strings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this example:\n\n  x = \"foo\"#\n  y = \"foo\"#\n  ...x...y...x...y....\n\nWe would normally turn this into:\n\n  x = \"foo\"#\n  y = x\n  ...x...x...x...x....\n\nBut this breaks an invariant of Core, namely that the RHS of a top-level binding\nof type Addr# must be a string literal, not another variable. See Note\n[CoreSyn top-level string literals] in CoreSyn.\n\nFor this reason, we special case top-level bindings to literal strings and leave\nthe original RHS unmodified. This produces:\n\n  x = \"foo\"#\n  y = \"foo\"#\n  ...x...x...x...x....\n\nNow 'y' will be discarded as dead code, and we are done.\n\nThe net effect is that for the y-binding we want to\n  - Use SUBSTITUTE, by extending the substitution with  y :-> x\n  - but leave the original binding for y undisturbed\n\nThis is done by cse_bind.  I got it wrong the first time (Trac #13367).\n\nNote [Delay inlining after CSE]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose (Trac #15445) we have\n   f,g :: Num a => a -> a\n   f x = ...f (x-1).....\n   g y = ...g (y-1) ....\n\nand we make some specialisations of 'g', either automatically, or via\na SPECIALISE pragma.  Then CSE kicks in and notices that the RHSs of\n'f' and 'g' are identical, so we get\n   f x = ...f (x-1)...\n   g = f\n   {-# RULES g @Int _ = $sg #-}\n\nNow there is terrible danger that, in an importing module, we'll inline\n'g' before we have a chance to run its specialisation!\n\nSolution: during CSE, when adding a top-level\n  g = f\nbinding after a \"hit\" in the CSE cache, add a NOINLINE[2] activation\nto it, to ensure it's not inlined right away.\n\nWhy top level only?  Because for nested bindings we are already past\nphase 2 and will never return there.\n-}\n\ntryForCSE :: CSEnv -> InExpr -> OutExpr\ntryForCSE env expr = snd (try_for_cse env expr)\n\ntry_for_cse :: CSEnv -> InExpr -> (Bool, OutExpr)\n-- (False, e') => We did not CSE the entire expression,\n--                but we might have CSE'd some sub-expressions,\n--                yielding e'\n--\n-- (True, te') => We CSE'd the entire expression,\n--                yielding the trivial expression te'\ntry_for_cse env expr\n  | Just e <- lookupCSEnv env expr'' = (True,  mkTicks ticks e)\n  | otherwise                        = (False, expr')\n    -- The varToCoreExpr is needed if we have\n    --   case e of xco { ...case e of yco { ... } ... }\n    -- Then CSE will substitute yco -> xco;\n    -- but these are /coercion/ variables\n  where\n    expr'  = cseExpr env expr\n    expr'' = stripTicksE tickishFloatable expr'\n    ticks  = stripTicksT tickishFloatable expr'\n    -- We don't want to lose the source notes when a common sub\n    -- expression gets eliminated. Hence we push all (!) of them on\n    -- top of the replaced sub-expression. This is probably not too\n    -- useful in practice, but upholds our semantics.\n\n-- | Runs CSE on a single expression.\n--\n-- This entry point is not used in the compiler itself, but is provided\n-- as a convenient entry point for users of the GHC API.\ncseOneExpr :: InExpr -> OutExpr\ncseOneExpr e = cseExpr env e\n  where env = emptyCSEnv {cs_subst = mkEmptySubst (mkInScopeSet (exprFreeVars e)) }\n\ncseExpr :: CSEnv -> InExpr -> OutExpr\ncseExpr env (Type t)              = Type (substTy (csEnvSubst env) t)\ncseExpr env (Coercion c)          = Coercion (substCo (csEnvSubst env) c)\ncseExpr _   (Lit lit)             = Lit lit\ncseExpr env (Var v)               = lookupSubst env v\ncseExpr env (App f a)             = App (cseExpr env f) (tryForCSE env a)\ncseExpr env (Tick t e)            = Tick t (cseExpr env e)\ncseExpr env (Cast e co)           = Cast (tryForCSE env e) (substCo (csEnvSubst env) co)\ncseExpr env (Lam b e)             = let (env', b') = addBinder env b\n                                    in Lam b' (cseExpr env' e)\ncseExpr env (Let bind e)          = let (env', bind') = cseBind NotTopLevel env bind\n                                    in Let bind' (cseExpr env' e)\ncseExpr env (Case e bndr ty alts) = cseCase env e bndr ty alts\n\ncseCase :: CSEnv -> InExpr -> InId -> InType -> [InAlt] -> OutExpr\ncseCase env scrut bndr ty alts\n  = Case scrut1 bndr3 ty' $\n    combineAlts alt_env (map cse_alt alts)\n  where\n    ty' = substTy (csEnvSubst env) ty\n    scrut1 = tryForCSE env scrut\n\n    bndr1 = zapIdOccInfo bndr\n      -- Zapping the OccInfo is needed because the extendCSEnv\n      -- in cse_alt may mean that a dead case binder\n      -- becomes alive, and Lint rejects that\n    (env1, bndr2)    = addBinder env bndr1\n    (alt_env, bndr3) = addBinding env1 bndr bndr2 scrut1\n         -- addBinding: see Note [CSE for case expressions]\n\n    con_target :: OutExpr\n    con_target = lookupSubst alt_env bndr\n\n    arg_tys :: [OutType]\n    arg_tys = tyConAppArgs (idType bndr3)\n\n    -- Given case x of { K y z -> ...K y z... }\n    -- CSE K y z into x...\n    cse_alt (DataAlt con, args, rhs)\n        | not (null args)\n                -- ... but don't try CSE if there are no args; it just increases the number\n                -- of live vars.  E.g.\n                --      case x of { True -> ....True.... }\n                -- Don't replace True by x!\n                -- Hence the 'null args', which also deal with literals and DEFAULT\n        = (DataAlt con, args', tryForCSE new_env rhs)\n        where\n          (env', args') = addBinders alt_env args\n          new_env       = extendCSEnv env' con_expr con_target\n          con_expr      = mkAltExpr (DataAlt con) args' arg_tys\n\n    cse_alt (con, args, rhs)\n        = (con, args', tryForCSE env' rhs)\n        where\n          (env', args') = addBinders alt_env args\n\ncombineAlts :: CSEnv -> [InAlt] -> [InAlt]\n-- See Note [Combine case alternatives]\ncombineAlts env ((_,bndrs1,rhs1) : rest_alts)\n  | all isDeadBinder bndrs1\n  = (DEFAULT, [], rhs1) : filtered_alts\n  where\n    in_scope = substInScope (csEnvSubst env)\n    filtered_alts = filterOut identical rest_alts\n    identical (_con, bndrs, rhs) = all ok bndrs && eqExpr in_scope rhs1 rhs\n    ok bndr = isDeadBinder bndr || not (bndr `elemInScopeSet` in_scope)\n\ncombineAlts _ alts = alts  -- Default case\n\n{- Note [Combine case alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ncombineAlts is just a more heavyweight version of the use of\ncombineIdenticalAlts in SimplUtils.prepareAlts.  The basic idea is\nto transform\n\n    DEFAULT -> e1\n    K x     -> e1\n    W y z   -> e2\n===>\n   DEFAULT -> e1\n   W y z   -> e2\n\nIn the simplifier we use cheapEqExpr, because it is called a lot.\nBut here in CSE we use the full eqExpr.  After all, two alternatives usually\ndiffer near the root, so it probably isn't expensive to compare the full\nalternative.  It seems like the same kind of thing that CSE is supposed\nto be doing, which is why I put it here.\n\nI acutally saw some examples in the wild, where some inlining made e1 too\nbig for cheapEqExpr to catch it.\n\n\n************************************************************************\n*                                                                      *\n\\section{The CSE envt}\n*                                                                      *\n************************************************************************\n-}\n\ndata CSEnv\n  = CS { cs_subst :: Subst  -- Maps InBndrs to OutExprs\n            -- The substitution variables to\n            -- /trivial/ OutExprs, not arbitrary expressions\n\n       , cs_map   :: CoreMap OutExpr   -- The reverse mapping\n            -- Maps a OutExpr to a /trivial/ OutExpr\n            -- The key of cs_map is stripped of all Ticks\n\n       , cs_rec_map :: CoreMap OutExpr\n            -- See Note [CSE for recursive bindings]\n       }\n\nemptyCSEnv :: CSEnv\nemptyCSEnv = CS { cs_map = emptyCoreMap, cs_rec_map = emptyCoreMap\n                , cs_subst = emptySubst }\n\nlookupCSEnv :: CSEnv -> OutExpr -> Maybe OutExpr\nlookupCSEnv (CS { cs_map = csmap }) expr\n  = lookupCoreMap csmap expr\n\nextendCSEnv :: CSEnv -> OutExpr -> OutExpr -> CSEnv\nextendCSEnv cse expr triv_expr\n  = cse { cs_map = extendCoreMap (cs_map cse) sexpr triv_expr }\n  where\n    sexpr = stripTicksE tickishFloatable expr\n\nextendCSRecEnv :: CSEnv -> OutId -> OutExpr -> OutExpr -> CSEnv\n-- See Note [CSE for recursive bindings]\nextendCSRecEnv cse bndr expr triv_expr\n  = cse { cs_rec_map = extendCoreMap (cs_rec_map cse) (Lam bndr expr) triv_expr }\n\nlookupCSRecEnv :: CSEnv -> OutId -> OutExpr -> Maybe OutExpr\n-- See Note [CSE for recursive bindings]\nlookupCSRecEnv (CS { cs_rec_map = csmap }) bndr expr\n  = lookupCoreMap csmap (Lam bndr expr)\n\ncsEnvSubst :: CSEnv -> Subst\ncsEnvSubst = cs_subst\n\nlookupSubst :: CSEnv -> Id -> OutExpr\nlookupSubst (CS { cs_subst = sub}) x = lookupIdSubst (text \"CSE.lookupSubst\") sub x\n\nextendCSSubst :: CSEnv -> Id  -> CoreExpr -> CSEnv\nextendCSSubst cse x rhs = cse { cs_subst = extendSubst (cs_subst cse) x rhs }\n\n-- | Add clones to the substitution to deal with shadowing.  See\n-- Note [Shadowing] for more details.  You should call this whenever\n-- you go under a binder.\naddBinder :: CSEnv -> Var -> (CSEnv, Var)\naddBinder cse v = (cse { cs_subst = sub' }, v')\n                where\n                  (sub', v') = substBndr (cs_subst cse) v\n\naddBinders :: CSEnv -> [Var] -> (CSEnv, [Var])\naddBinders cse vs = (cse { cs_subst = sub' }, vs')\n                where\n                  (sub', vs') = substBndrs (cs_subst cse) vs\n\naddRecBinders :: CSEnv -> [Id] -> (CSEnv, [Id])\naddRecBinders cse vs = (cse { cs_subst = sub' }, vs')\n                where\n                  (sub', vs') = substRecBndrs (cs_subst cse) vs\n", "num_lines": 702}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n************************************************************************\n*                                                                      *\n\\section[FloatIn]{Floating Inwards pass}\n*                                                                      *\n************************************************************************\n\nThe main purpose of @floatInwards@ is floating into branches of a\ncase, so that we don't allocate things, save them on the stack, and\nthen discover that they aren't needed in the chosen branch.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# OPTIONS_GHC -fprof-auto #-}\n\nmodule FloatIn ( floatInwards ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport MkCore hiding    ( wrapFloats )\nimport HscTypes         ( ModGuts(..) )\nimport CoreUtils\nimport CoreFVs\nimport CoreMonad        ( CoreM )\nimport Id               ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )\nimport Var\nimport Type\nimport VarSet\nimport Util\nimport DynFlags\nimport Outputable\n-- import Data.List        ( mapAccumL )\nimport BasicTypes       ( RecFlag(..), isRec )\n\n{-\nTop-level interface function, @floatInwards@.  Note that we do not\nactually float any bindings downwards from the top-level.\n-}\n\nfloatInwards :: ModGuts -> CoreM ModGuts\nfloatInwards pgm@(ModGuts { mg_binds = binds })\n  = do { dflags <- getDynFlags\n       ; return (pgm { mg_binds = map (fi_top_bind dflags) binds }) }\n  where\n    fi_top_bind dflags (NonRec binder rhs)\n      = NonRec binder (fiExpr dflags [] (freeVars rhs))\n    fi_top_bind dflags (Rec pairs)\n      = Rec [ (b, fiExpr dflags [] (freeVars rhs)) | (b, rhs) <- pairs ]\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Mail from Andr\\'e [edited]}\n*                                                                      *\n************************************************************************\n\n{\\em Will wrote: What??? I thought the idea was to float as far\ninwards as possible, no matter what.  This is dropping all bindings\nevery time it sees a lambda of any kind.  Help! }\n\nYou are assuming we DO DO full laziness AFTER floating inwards!  We\nhave to [not float inside lambdas] if we don't.\n\nIf we indeed do full laziness after the floating inwards (we could\ncheck the compilation flags for that) then I agree we could be more\naggressive and do float inwards past lambdas.\n\nActually we are not doing a proper full laziness (see below), which\nwas another reason for not floating inwards past a lambda.\n\nThis can easily be fixed.  The problem is that we float lets outwards,\nbut there are a few expressions which are not let bound, like case\nscrutinees and case alternatives.  After floating inwards the\nsimplifier could decide to inline the let and the laziness would be\nlost, e.g.\n\n\\begin{verbatim}\nlet a = expensive             ==> \\b -> case expensive of ...\nin \\ b -> case a of ...\n\\end{verbatim}\nThe fix is\n\\begin{enumerate}\n\\item\nto let bind the algebraic case scrutinees (done, I think) and\nthe case alternatives (except the ones with an\nunboxed type)(not done, I think). This is best done in the\nSetLevels.hs module, which tags things with their level numbers.\n\\item\ndo the full laziness pass (floating lets outwards).\n\\item\nsimplify. The simplifier inlines the (trivial) lets that were\n created but were not floated outwards.\n\\end{enumerate}\n\nWith the fix I think Will's suggestion that we can gain even more from\nstrictness by floating inwards past lambdas makes sense.\n\nWe still gain even without going past lambdas, as things may be\nstrict in the (new) context of a branch (where it was floated to) or\nof a let rhs, e.g.\n\\begin{verbatim}\nlet a = something            case x of\nin case x of                   alt1 -> case something of a -> a + a\n     alt1 -> a + a      ==>    alt2 -> b\n     alt2 -> b\n\nlet a = something           let b = case something of a -> a + a\nin let b = a + a        ==> in (b,b)\nin (b,b)\n\\end{verbatim}\nAlso, even if a is not found to be strict in the new context and is\nstill left as a let, if the branch is not taken (or b is not entered)\nthe closure for a is not built.\n\n************************************************************************\n*                                                                      *\n\\subsection{Main floating-inwards code}\n*                                                                      *\n************************************************************************\n-}\n\ntype FreeVarSet  = DIdSet\ntype BoundVarSet = DIdSet\n\ndata FloatInBind = FB BoundVarSet FreeVarSet FloatBind\n        -- The FreeVarSet is the free variables of the binding.  In the case\n        -- of recursive bindings, the set doesn't include the bound\n        -- variables.\n\ntype FloatInBinds = [FloatInBind]\n        -- In reverse dependency order (innermost binder first)\n\nfiExpr :: DynFlags\n       -> FloatInBinds      -- Binds we're trying to drop\n                            -- as far \"inwards\" as possible\n       -> CoreExprWithFVs   -- Input expr\n       -> CoreExpr          -- Result\n\nfiExpr _ to_drop (_, AnnLit lit)     = wrapFloats to_drop (Lit lit)\n                                       -- See Note [Dead bindings]\nfiExpr _ to_drop (_, AnnType ty)     = ASSERT( null to_drop ) Type ty\nfiExpr _ to_drop (_, AnnVar v)       = wrapFloats to_drop (Var v)\nfiExpr _ to_drop (_, AnnCoercion co) = wrapFloats to_drop (Coercion co)\nfiExpr dflags to_drop (_, AnnCast expr (co_ann, co))\n  = wrapFloats (drop_here ++ co_drop) $\n    Cast (fiExpr dflags e_drop expr) co\n  where\n    [drop_here, e_drop, co_drop]\n      = sepBindsByDropPoint dflags False\n          [freeVarsOf expr, freeVarsOfAnn co_ann]\n          to_drop\n\n{-\nApplications: we do float inside applications, mainly because we\nneed to get at all the arguments.  The next simplifier run will\npull out any silly ones.\n-}\n\nfiExpr dflags to_drop ann_expr@(_,AnnApp {})\n  = wrapFloats drop_here $ wrapFloats extra_drop $\n    mkTicks ticks $\n    mkApps (fiExpr dflags fun_drop ann_fun)\n           (zipWith (fiExpr dflags) arg_drops ann_args)\n  where\n    (ann_fun, ann_args, ticks) = collectAnnArgsTicks tickishFloatable ann_expr\n    fun_ty  = exprType (deAnnotate ann_fun)\n    fun_fvs = freeVarsOf ann_fun\n    arg_fvs = map freeVarsOf ann_args\n\n    (drop_here : extra_drop : fun_drop : arg_drops)\n       = sepBindsByDropPoint dflags False\n                             (extra_fvs : fun_fvs : arg_fvs)\n                             to_drop\n         -- Shortcut behaviour: if to_drop is empty,\n         -- sepBindsByDropPoint returns a suitable bunch of empty\n         -- lists without evaluating extra_fvs, and hence without\n         -- peering into each argument\n\n    (_, extra_fvs) = foldl' add_arg (fun_ty, extra_fvs0) ann_args\n    extra_fvs0 = case ann_fun of\n                   (_, AnnVar _) -> fun_fvs\n                   _             -> emptyDVarSet\n          -- Don't float the binding for f into f x y z; see Note [Join points]\n          -- for why we *can't* do it when f is a join point. (If f isn't a\n          -- join point, floating it in isn't especially harmful but it's\n          -- useless since the simplifier will immediately float it back out.)\n\n    add_arg :: (Type,FreeVarSet) -> CoreExprWithFVs -> (Type,FreeVarSet)\n    add_arg (fun_ty, extra_fvs) (_, AnnType ty)\n      = (piResultTy fun_ty ty, extra_fvs)\n\n    add_arg (fun_ty, extra_fvs) (arg_fvs, arg)\n      | noFloatIntoArg arg arg_ty\n      = (res_ty, extra_fvs `unionDVarSet` arg_fvs)\n      | otherwise\n      = (res_ty, extra_fvs)\n      where\n       (arg_ty, res_ty) = splitFunTy fun_ty\n\n{- Note [Dead bindings]\n~~~~~~~~~~~~~~~~~~~~~~~\nAt a literal we won't usually have any floated bindings; the\nonly way that can happen is if the binding wrapped the literal\n/in the original input program/.  e.g.\n   case x of { DEFAULT -> 1# }\nBut, while this may be unusual it is not actually wrong, and it did\nonce happen (Trac #15696).\n\nNote [Do not destroy the let/app invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWatch out for\n   f (x +# y)\nWe don't want to float bindings into here\n   f (case ... of { x -> x +# y })\nbecause that might destroy the let/app invariant, which requires\nunlifted function arguments to be ok-for-speculation.\n\nNote [Join points]\n~~~~~~~~~~~~~~~~~~\nGenerally, we don't need to worry about join points - there are places we're\nnot allowed to float them, but since they can't have occurrences in those\nplaces, we're not tempted.\n\nWe do need to be careful about jumps, however:\n\n  joinrec j x y z = ... in\n  jump j a b c\n\nPrevious versions often floated the definition of a recursive function into its\nonly non-recursive occurrence. But for a join point, this is a disaster:\n\n  (joinrec j x y z = ... in\n  jump j) a b c -- wrong!\n\nEvery jump must be exact, so the jump to j must have three arguments. Hence\nwe're careful not to float into the target of a jump (though we can float into\nthe arguments just fine).\n\nNote [Floating in past a lambda group]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* We must be careful about floating inside a value lambda.\n  That risks losing laziness.\n  The float-out pass might rescue us, but then again it might not.\n\n* We must be careful about type lambdas too.  At one time we did, and\n  there is no risk of duplicating work thereby, but we do need to be\n  careful.  In particular, here is a bad case (it happened in the\n  cichelli benchmark:\n        let v = ...\n        in let f = /\\t -> \\a -> ...\n           ==>\n        let f = /\\t -> let v = ... in \\a -> ...\n  This is bad as now f is an updatable closure (update PAP)\n  and has arity 0.\n\n* Hack alert!  We only float in through one-shot lambdas,\n  not (as you might guess) through lone big lambdas.\n  Reason: we float *out* past big lambdas (see the test in the Lam\n  case of FloatOut.floatExpr) and we don't want to float straight\n  back in again.\n\n  It *is* important to float into one-shot lambdas, however;\n  see the remarks with noFloatIntoRhs.\n\nSo we treat lambda in groups, using the following rule:\n\n Float in if (a) there is at least one Id,\n         and (b) there are no non-one-shot Ids\n\n Otherwise drop all the bindings outside the group.\n\nThis is what the 'go' function in the AnnLam case is doing.\n\n(Join points are handled similarly: a join point is considered one-shot iff\nit's non-recursive, so we float only into non-recursive join points.)\n\nUrk! if all are tyvars, and we don't float in, we may miss an\n      opportunity to float inside a nested case branch\n\n\nNote [Floating coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWe could, in principle, have a coercion binding like\n   case f x of co { DEFAULT -> e1 e2 }\nIt's not common to have a function that returns a coercion, but nothing\nin Core prohibits it.  If so, 'co' might be mentioned in e1 or e2\n/only in a type/.  E.g. suppose e1 was\n  let (x :: Int |> co) = blah in blah2\n\n\nBut, with coercions appearing in types, there is a complication: we\nmight be floating in a \"strict let\" -- that is, a case. Case expressions\nmention their return type. We absolutely can't float a coercion binding\ninward to the point that the type of the expression it's about to wrap\nmentions the coercion. So we include the union of the sets of free variables\nof the types of all the drop points involved. If any of the floaters\nbind a coercion variable mentioned in any of the types, that binder must\nbe dropped right away.\n\n-}\n\nfiExpr dflags to_drop lam@(_, AnnLam _ _)\n  | noFloatIntoLam bndrs       -- Dump it all here\n     -- NB: Must line up with noFloatIntoRhs (AnnLam...); see Trac #7088\n  = wrapFloats to_drop (mkLams bndrs (fiExpr dflags [] body))\n\n  | otherwise           -- Float inside\n  = mkLams bndrs (fiExpr dflags to_drop body)\n\n  where\n    (bndrs, body) = collectAnnBndrs lam\n\n{-\nWe don't float lets inwards past an SCC.\n        ToDo: keep info on current cc, and when passing\n        one, if it is not the same, annotate all lets in binds with current\n        cc, change current cc to the new one and float binds into expr.\n-}\n\nfiExpr dflags to_drop (_, AnnTick tickish expr)\n  | tickish `tickishScopesLike` SoftScope\n  = Tick tickish (fiExpr dflags to_drop expr)\n\n  | otherwise -- Wimp out for now - we could push values in\n  = wrapFloats to_drop (Tick tickish (fiExpr dflags [] expr))\n\n{-\nFor @Lets@, the possible ``drop points'' for the \\tr{to_drop}\nbindings are: (a)~in the body, (b1)~in the RHS of a NonRec binding,\nor~(b2), in each of the RHSs of the pairs of a @Rec@.\n\nNote that we do {\\em weird things} with this let's binding.  Consider:\n\\begin{verbatim}\nlet\n    w = ...\nin {\n    let v = ... w ...\n    in ... v .. w ...\n}\n\\end{verbatim}\nLook at the inner \\tr{let}.  As \\tr{w} is used in both the bind and\nbody of the inner let, we could panic and leave \\tr{w}'s binding where\nit is.  But \\tr{v} is floatable further into the body of the inner let, and\n{\\em then} \\tr{w} will also be only in the body of that inner let.\n\nSo: rather than drop \\tr{w}'s binding here, we add it onto the list of\nthings to drop in the outer let's body, and let nature take its\ncourse.\n\nNote [extra_fvs (1): avoid floating into RHS]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider let x=\\y....t... in body.  We do not necessarily want to float\na binding for t into the RHS, because it'll immediately be floated out\nagain.  (It won't go inside the lambda else we risk losing work.)\nIn letrec, we need to be more careful still. We don't want to transform\n        let x# = y# +# 1#\n        in\n        letrec f = \\z. ...x#...f...\n        in ...\ninto\n        letrec f = let x# = y# +# 1# in \\z. ...x#...f... in ...\nbecause now we can't float the let out again, because a letrec\ncan't have unboxed bindings.\n\nSo we make \"extra_fvs\" which is the rhs_fvs of such bindings, and\narrange to dump bindings that bind extra_fvs before the entire let.\n\nNote [extra_fvs (2): free variables of rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  let x{rule mentioning y} = rhs in body\nHere y is not free in rhs or body; but we still want to dump bindings\nthat bind y outside the let.  So we augment extra_fvs with the\nidRuleAndUnfoldingVars of x.  No need for type variables, hence not using\nidFreeVars.\n-}\n\nfiExpr dflags to_drop (_,AnnLet bind body)\n  = fiExpr dflags (after ++ new_float : before) body\n           -- to_drop is in reverse dependency order\n  where\n    (before, new_float, after) = fiBind dflags to_drop bind body_fvs\n    body_fvs    = freeVarsOf body\n\n{- Note [Floating primops]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe try to float-in a case expression over an unlifted type.  The\nmotivating example was Trac #5658: in particular, this change allows\narray indexing operations, which have a single DEFAULT alternative\nwithout any binders, to be floated inward.\n\nSIMD primops for unpacking SIMD vectors into an unboxed tuple of unboxed\nscalars also need to be floated inward, but unpacks have a single non-DEFAULT\nalternative that binds the elements of the tuple. We now therefore also support\nfloating in cases with a single alternative that may bind values.\n\nBut there are wrinkles\n\n* Which unlifted cases do we float? See PrimOp.hs\n  Note [PrimOp can_fail and has_side_effects] which explains:\n   - We can float-in can_fail primops, but we can't float them out.\n   - But we can float a has_side_effects primop, but NOT inside a lambda,\n     so for now we don't float them at all.\n  Hence exprOkForSideEffects\n\n* Because we can float can-fail primops (array indexing, division) inwards\n  but not outwards, we must be careful not to transform\n     case a /# b of r -> f (F# r)\n  ===>\n    f (case a /# b of r -> F# r)\n  because that creates a new thunk that wasn't there before.  And\n  because it can't be floated out (can_fail), the thunk will stay\n  there.  Disaster!  (This happened in nofib 'simple' and 'scs'.)\n\n  Solution: only float cases into the branches of other cases, and\n  not into the arguments of an application, or the RHS of a let. This\n  is somewhat conservative, but it's simple.  And it still hits the\n  cases like Trac #5658.   This is implemented in sepBindsByJoinPoint;\n  if is_case is False we dump all floating cases right here.\n\n* Trac #14511 is another example of why we want to restrict float-in\n  of case-expressions.  Consider\n     case indexArray# a n of (# r #) -> writeArray# ma i (f r)\n  Now, floating that indexing operation into the (f r) thunk will\n  not create any new thunks, but it will keep the array 'a' alive\n  for much longer than the programmer expected.\n\n  So again, not floating a case into a let or argument seems like\n  the Right Thing\n\nFor @Case@, the possible drop points for the 'to_drop'\nbindings are:\n  (a) inside the scrutinee\n  (b) inside one of the alternatives/default (default FVs always /first/!).\n\n-}\n\nfiExpr dflags to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)])\n  | isUnliftedType (idType case_bndr)\n  , exprOkForSideEffects (deAnnotate scrut)\n      -- See Note [Floating primops]\n  = wrapFloats shared_binds $\n    fiExpr dflags (case_float : rhs_binds) rhs\n  where\n    case_float = FB (mkDVarSet (case_bndr : alt_bndrs)) scrut_fvs\n                    (FloatCase scrut' case_bndr con alt_bndrs)\n    scrut'     = fiExpr dflags scrut_binds scrut\n    rhs_fvs    = freeVarsOf rhs `delDVarSetList` (case_bndr : alt_bndrs)\n    scrut_fvs  = freeVarsOf scrut\n\n    [shared_binds, scrut_binds, rhs_binds]\n       = sepBindsByDropPoint dflags False\n           [scrut_fvs, rhs_fvs]\n           to_drop\n\nfiExpr dflags to_drop (_, AnnCase scrut case_bndr ty alts)\n  = wrapFloats drop_here1 $\n    wrapFloats drop_here2 $\n    Case (fiExpr dflags scrut_drops scrut) case_bndr ty\n         (zipWith fi_alt alts_drops_s alts)\n  where\n        -- Float into the scrut and alts-considered-together just like App\n    [drop_here1, scrut_drops, alts_drops]\n       = sepBindsByDropPoint dflags False\n           [scrut_fvs, all_alts_fvs]\n           to_drop\n\n        -- Float into the alts with the is_case flag set\n    (drop_here2 : alts_drops_s)\n      | [ _ ] <- alts = [] : [alts_drops]\n      | otherwise     = sepBindsByDropPoint dflags True alts_fvs alts_drops\n\n    scrut_fvs    = freeVarsOf scrut\n    alts_fvs     = map alt_fvs alts\n    all_alts_fvs = unionDVarSets alts_fvs\n    alt_fvs (_con, args, rhs)\n      = foldl' delDVarSet (freeVarsOf rhs) (case_bndr:args)\n           -- Delete case_bndr and args from free vars of rhs\n           -- to get free vars of alt\n\n    fi_alt to_drop (con, args, rhs) = (con, args, fiExpr dflags to_drop rhs)\n\n------------------\nfiBind :: DynFlags\n       -> FloatInBinds      -- Binds we're trying to drop\n                            -- as far \"inwards\" as possible\n       -> CoreBindWithFVs   -- Input binding\n       -> DVarSet           -- Free in scope of binding\n       -> ( FloatInBinds    -- Land these before\n          , FloatInBind     -- The binding itself\n          , FloatInBinds)   -- Land these after\n\nfiBind dflags to_drop (AnnNonRec id ann_rhs@(rhs_fvs, rhs)) body_fvs\n  = ( extra_binds ++ shared_binds          -- Land these before\n                                           -- See Note [extra_fvs (1,2)]\n    , FB (unitDVarSet id) rhs_fvs'         -- The new binding itself\n          (FloatLet (NonRec id rhs'))\n    , body_binds )                         -- Land these after\n\n  where\n    body_fvs2 = body_fvs `delDVarSet` id\n\n    rule_fvs = bndrRuleAndUnfoldingVarsDSet id        -- See Note [extra_fvs (2): free variables of rules]\n    extra_fvs | noFloatIntoRhs NonRecursive id rhs\n              = rule_fvs `unionDVarSet` rhs_fvs\n              | otherwise\n              = rule_fvs\n        -- See Note [extra_fvs (1): avoid floating into RHS]\n        -- No point in floating in only to float straight out again\n        -- We *can't* float into ok-for-speculation unlifted RHSs\n        -- But do float into join points\n\n    [shared_binds, extra_binds, rhs_binds, body_binds]\n        = sepBindsByDropPoint dflags False\n            [extra_fvs, rhs_fvs, body_fvs2]\n            to_drop\n\n        -- Push rhs_binds into the right hand side of the binding\n    rhs'     = fiRhs dflags rhs_binds id ann_rhs\n    rhs_fvs' = rhs_fvs `unionDVarSet` floatedBindsFVs rhs_binds `unionDVarSet` rule_fvs\n                        -- Don't forget the rule_fvs; the binding mentions them!\n\nfiBind dflags to_drop (AnnRec bindings) body_fvs\n  = ( extra_binds ++ shared_binds\n    , FB (mkDVarSet ids) rhs_fvs'\n         (FloatLet (Rec (fi_bind rhss_binds bindings)))\n    , body_binds )\n  where\n    (ids, rhss) = unzip bindings\n    rhss_fvs = map freeVarsOf rhss\n\n        -- See Note [extra_fvs (1,2)]\n    rule_fvs = mapUnionDVarSet bndrRuleAndUnfoldingVarsDSet ids\n    extra_fvs = rule_fvs `unionDVarSet`\n                unionDVarSets [ rhs_fvs | (bndr, (rhs_fvs, rhs)) <- bindings\n                              , noFloatIntoRhs Recursive bndr rhs ]\n\n    (shared_binds:extra_binds:body_binds:rhss_binds)\n        = sepBindsByDropPoint dflags False\n            (extra_fvs:body_fvs:rhss_fvs)\n            to_drop\n\n    rhs_fvs' = unionDVarSets rhss_fvs `unionDVarSet`\n               unionDVarSets (map floatedBindsFVs rhss_binds) `unionDVarSet`\n               rule_fvs         -- Don't forget the rule variables!\n\n    -- Push rhs_binds into the right hand side of the binding\n    fi_bind :: [FloatInBinds]       -- one per \"drop pt\" conjured w/ fvs_of_rhss\n            -> [(Id, CoreExprWithFVs)]\n            -> [(Id, CoreExpr)]\n\n    fi_bind to_drops pairs\n      = [ (binder, fiRhs dflags to_drop binder rhs)\n        | ((binder, rhs), to_drop) <- zipEqual \"fi_bind\" pairs to_drops ]\n\n------------------\nfiRhs :: DynFlags -> FloatInBinds -> CoreBndr -> CoreExprWithFVs -> CoreExpr\nfiRhs dflags to_drop bndr rhs\n  | Just join_arity <- isJoinId_maybe bndr\n  , let (bndrs, body) = collectNAnnBndrs join_arity rhs\n  = mkLams bndrs (fiExpr dflags to_drop body)\n  | otherwise\n  = fiExpr dflags to_drop rhs\n\n------------------\nnoFloatIntoLam :: [Var] -> Bool\nnoFloatIntoLam bndrs = any bad bndrs\n  where\n    bad b = isId b && not (isOneShotBndr b)\n    -- Don't float inside a non-one-shot lambda\n\nnoFloatIntoRhs :: RecFlag -> Id -> CoreExprWithFVs' -> Bool\n-- ^ True if it's a bad idea to float bindings into this RHS\nnoFloatIntoRhs is_rec bndr rhs\n  | isJoinId bndr\n  = isRec is_rec -- Joins are one-shot iff non-recursive\n\n  | otherwise\n  = noFloatIntoArg rhs (idType bndr)\n\nnoFloatIntoArg :: CoreExprWithFVs' -> Type -> Bool\nnoFloatIntoArg expr expr_ty\n  | isUnliftedType expr_ty\n  = True  -- See Note [Do not destroy the let/app invariant]\n\n   | AnnLam bndr e <- expr\n   , (bndrs, _) <- collectAnnBndrs e\n   =  noFloatIntoLam (bndr:bndrs)  -- Wrinkle 1 (a)\n   || all isTyVar (bndr:bndrs)     -- Wrinkle 1 (b)\n      -- See Note [noFloatInto considerations] wrinkle 2\n\n  | otherwise  -- Note [noFloatInto considerations] wrinkle 2\n  = exprIsTrivial deann_expr || exprIsHNF deann_expr\n  where\n    deann_expr = deAnnotate' expr\n\n{- Note [noFloatInto considerations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen do we want to float bindings into\n   - noFloatIntoRHs: the RHS of a let-binding\n   - noFloatIntoArg: the argument of a function application\n\nDefinitely don't float in if it has unlifted type; that\nwould destroy the let/app invariant.\n\n* Wrinkle 1: do not float in if\n     (a) any non-one-shot value lambdas\n  or (b) all type lambdas\n  In both cases we'll float straight back out again\n  NB: Must line up with fiExpr (AnnLam...); see Trac #7088\n\n  (a) is important: we /must/ float into a one-shot lambda group\n  (which includes join points). This makes a big difference\n  for things like\n     f x# = let x = I# x#\n            in let j = \\() -> ...x...\n               in if <condition> then normal-path else j ()\n  If x is used only in the error case join point, j, we must float the\n  boxing constructor into it, else we box it every time which is very\n  bad news indeed.\n\n* Wrinkle 2: for RHSs, do not float into a HNF; we'll just float right\n  back out again... not tragic, but a waste of time.\n\n  For function arguments we will still end up with this\n  in-then-out stuff; consider\n    letrec x = e in f x\n  Here x is not a HNF, so we'll produce\n    f (letrec x = e in x)\n  which is OK... it's not that common, and we'll end up\n  floating out again, in CorePrep if not earlier.\n  Still, we use exprIsTrivial to catch this case (sigh)\n\n\n************************************************************************\n*                                                                      *\n\\subsection{@sepBindsByDropPoint@}\n*                                                                      *\n************************************************************************\n\nThis is the crucial function.  The idea is: We have a wad of bindings\nthat we'd like to distribute inside a collection of {\\em drop points};\ninsides the alternatives of a \\tr{case} would be one example of some\ndrop points; the RHS and body of a non-recursive \\tr{let} binding\nwould be another (2-element) collection.\n\nSo: We're given a list of sets-of-free-variables, one per drop point,\nand a list of floating-inwards bindings.  If a binding can go into\nonly one drop point (without suddenly making something out-of-scope),\nin it goes.  If a binding is used inside {\\em multiple} drop points,\nthen it has to go in a you-must-drop-it-above-all-these-drop-points\npoint.\n\nWe have to maintain the order on these drop-point-related lists.\n-}\n\n-- pprFIB :: FloatInBinds -> SDoc\n-- pprFIB fibs = text \"FIB:\" <+> ppr [b | FB _ _ b <- fibs]\n\nsepBindsByDropPoint\n    :: DynFlags\n    -> Bool                -- True <=> is case expression\n    -> [FreeVarSet]        -- One set of FVs per drop point\n                           -- Always at least two long!\n    -> FloatInBinds        -- Candidate floaters\n    -> [FloatInBinds]      -- FIRST one is bindings which must not be floated\n                           -- inside any drop point; the rest correspond\n                           -- one-to-one with the input list of FV sets\n\n-- Every input floater is returned somewhere in the result;\n-- none are dropped, not even ones which don't seem to be\n-- free in *any* of the drop-point fvs.  Why?  Because, for example,\n-- a binding (let x = E in B) might have a specialised version of\n-- x (say x') stored inside x, but x' isn't free in E or B.\n\ntype DropBox = (FreeVarSet, FloatInBinds)\n\nsepBindsByDropPoint dflags is_case drop_pts floaters\n  | null floaters  -- Shortcut common case\n  = [] : [[] | _ <- drop_pts]\n\n  | otherwise\n  = ASSERT( drop_pts `lengthAtLeast` 2 )\n    go floaters (map (\\fvs -> (fvs, [])) (emptyDVarSet : drop_pts))\n  where\n    n_alts = length drop_pts\n\n    go :: FloatInBinds -> [DropBox] -> [FloatInBinds]\n        -- The *first* one in the argument list is the drop_here set\n        -- The FloatInBinds in the lists are in the reverse of\n        -- the normal FloatInBinds order; that is, they are the right way round!\n\n    go [] drop_boxes = map (reverse . snd) drop_boxes\n\n    go (bind_w_fvs@(FB bndrs bind_fvs bind) : binds) drop_boxes@(here_box : fork_boxes)\n        = go binds new_boxes\n        where\n          -- \"here\" means the group of bindings dropped at the top of the fork\n\n          (used_here : used_in_flags) = [ fvs `intersectsDVarSet` bndrs\n                                        | (fvs, _) <- drop_boxes]\n\n          drop_here = used_here || cant_push\n\n          n_used_alts = count id used_in_flags -- returns number of Trues in list.\n\n          cant_push\n            | is_case   = n_used_alts == n_alts   -- Used in all, don't push\n                                                  -- Remember n_alts > 1\n                          || (n_used_alts > 1 && not (floatIsDupable dflags bind))\n                             -- floatIsDupable: see Note [Duplicating floats]\n\n            | otherwise = floatIsCase bind || n_used_alts > 1\n                             -- floatIsCase: see Note [Floating primops]\n\n          new_boxes | drop_here = (insert here_box : fork_boxes)\n                    | otherwise = (here_box : new_fork_boxes)\n\n          new_fork_boxes = zipWithEqual \"FloatIn.sepBinds\" insert_maybe\n                                        fork_boxes used_in_flags\n\n          insert :: DropBox -> DropBox\n          insert (fvs,drops) = (fvs `unionDVarSet` bind_fvs, bind_w_fvs:drops)\n\n          insert_maybe box True  = insert box\n          insert_maybe box False = box\n\n    go _ _ = panic \"sepBindsByDropPoint/go\"\n\n\n{- Note [Duplicating floats]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nFor case expressions we duplicate the binding if it is reasonably\nsmall, and if it is not used in all the RHSs This is good for\nsituations like\n     let x = I# y in\n     case e of\n       C -> error x\n       D -> error x\n       E -> ...not mentioning x...\n\nIf the thing is used in all RHSs there is nothing gained,\nso we don't duplicate then.\n-}\n\nfloatedBindsFVs :: FloatInBinds -> FreeVarSet\nfloatedBindsFVs binds = mapUnionDVarSet fbFVs binds\n\nfbFVs :: FloatInBind -> DVarSet\nfbFVs (FB _ fvs _) = fvs\n\nwrapFloats :: FloatInBinds -> CoreExpr -> CoreExpr\n-- Remember FloatInBinds is in *reverse* dependency order\nwrapFloats []               e = e\nwrapFloats (FB _ _ fl : bs) e = wrapFloats bs (wrapFloat fl e)\n\nfloatIsDupable :: DynFlags -> FloatBind -> Bool\nfloatIsDupable dflags (FloatCase scrut _ _ _) = exprIsDupable dflags scrut\nfloatIsDupable dflags (FloatLet (Rec prs))    = all (exprIsDupable dflags . snd) prs\nfloatIsDupable dflags (FloatLet (NonRec _ r)) = exprIsDupable dflags r\n\nfloatIsCase :: FloatBind -> Bool\nfloatIsCase (FloatCase {}) = True\nfloatIsCase (FloatLet {})  = False\n", "num_lines": 772}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[FloatOut]{Float bindings outwards (towards the top level)}\n\n``Long-distance'' floating of bindings towards the top level.\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule FloatOut ( floatOutwards ) where\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreUtils\nimport MkCore\nimport CoreArity        ( etaExpand )\nimport CoreMonad        ( FloatOutSwitches(..) )\n\nimport DynFlags\nimport ErrUtils         ( dumpIfSet_dyn )\nimport Id               ( Id, idArity, idType, isBottomingId,\n                          isJoinId, isJoinId_maybe )\nimport SetLevels\nimport UniqSupply       ( UniqSupply )\nimport Bag\nimport Util\nimport Maybes\nimport Outputable\nimport Type\nimport qualified Data.IntMap as M\n\nimport Data.List        ( partition )\n\n#include \"HsVersions.h\"\n\n{-\n        -----------------\n        Overall game plan\n        -----------------\n\nThe Big Main Idea is:\n\n        To float out sub-expressions that can thereby get outside\n        a non-one-shot value lambda, and hence may be shared.\n\n\nTo achieve this we may need to do two things:\n\n   a) Let-bind the sub-expression:\n\n        f (g x)  ==>  let lvl = f (g x) in lvl\n\n      Now we can float the binding for 'lvl'.\n\n   b) More than that, we may need to abstract wrt a type variable\n\n        \\x -> ... /\\a -> let v = ...a... in ....\n\n      Here the binding for v mentions 'a' but not 'x'.  So we\n      abstract wrt 'a', to give this binding for 'v':\n\n            vp = /\\a -> ...a...\n            v  = vp a\n\n      Now the binding for vp can float out unimpeded.\n      I can't remember why this case seemed important enough to\n      deal with, but I certainly found cases where important floats\n      didn't happen if we did not abstract wrt tyvars.\n\nWith this in mind we can also achieve another goal: lambda lifting.\nWe can make an arbitrary (function) binding float to top level by\nabstracting wrt *all* local variables, not just type variables, leaving\na binding that can be floated right to top level.  Whether or not this\nhappens is controlled by a flag.\n\n\nRandom comments\n~~~~~~~~~~~~~~~\n\nAt the moment we never float a binding out to between two adjacent\nlambdas.  For example:\n\n@\n        \\x y -> let t = x+x in ...\n===>\n        \\x -> let t = x+x in \\y -> ...\n@\nReason: this is less efficient in the case where the original lambda\nis never partially applied.\n\nBut there's a case I've seen where this might not be true.  Consider:\n@\nelEm2 x ys\n  = elem' x ys\n  where\n    elem' _ []  = False\n    elem' x (y:ys)      = x==y || elem' x ys\n@\nIt turns out that this generates a subexpression of the form\n@\n        \\deq x ys -> let eq = eqFromEqDict deq in ...\n@\nwhich might usefully be separated to\n@\n        \\deq -> let eq = eqFromEqDict deq in \\xy -> ...\n@\nWell, maybe.  We don't do this at the moment.\n\nNote [Join points]\n~~~~~~~~~~~~~~~~~~\nEvery occurrence of a join point must be a tail call (see Note [Invariants on\njoin points] in CoreSyn), so we must be careful with how far we float them. The\nmechanism for doing so is the *join ceiling*, detailed in Note [Join ceiling]\nin SetLevels. For us, the significance is that a binder might be marked to be\ndropped at the nearest boundary between tail calls and non-tail calls. For\nexample:\n\n  (< join j = ... in\n     let x = < ... > in\n     case < ... > of\n       A -> ...\n       B -> ...\n   >) < ... > < ... >\n\nHere the join ceilings are marked with angle brackets. Either side of an\napplication is a join ceiling, as is the scrutinee position of a case\nexpression or the RHS of a let binding (but not a join point).\n\nWhy do we *want* do float join points at all? After all, they're never\nallocated, so there's no sharing to be gained by floating them. However, the\nother benefit of floating is making RHSes small, and this can have a significant\nimpact. In particular, stream fusion has been known to produce nested loops like\nthis:\n\n  joinrec j1 x1 =\n    joinrec j2 x2 =\n      joinrec j3 x3 = ... jump j1 (x3 + 1) ... jump j2 (x3 + 1) ...\n      in jump j3 x2\n    in jump j2 x1\n  in jump j1 x\n\n(Assume x1 and x2 do *not* occur free in j3.)\n\nHere j1 and j2 are wholly superfluous---each of them merely forwards its\nargument to j3. Since j3 only refers to x3, we can float j2 and j3 to make\neverything one big mutual recursion:\n\n  joinrec j1 x1 = jump j2 x1\n          j2 x2 = jump j3 x2\n          j3 x3 = ... jump j1 (x3 + 1) ... jump j2 (x3 + 1) ...\n  in jump j1 x\n\nNow the simplifier will happily inline the trivial j1 and j2, leaving only j3.\nWithout floating, we're stuck with three loops instead of one.\n\n************************************************************************\n*                                                                      *\n\\subsection[floatOutwards]{@floatOutwards@: let-floating interface function}\n*                                                                      *\n************************************************************************\n-}\n\nfloatOutwards :: FloatOutSwitches\n              -> DynFlags\n              -> UniqSupply\n              -> CoreProgram -> IO CoreProgram\n\nfloatOutwards float_sws dflags us pgm\n  = do {\n        let { annotated_w_levels = setLevels float_sws pgm us ;\n              (fss, binds_s')    = unzip (map floatTopBind annotated_w_levels)\n            } ;\n\n        dumpIfSet_dyn dflags Opt_D_verbose_core2core \"Levels added:\"\n                  (vcat (map ppr annotated_w_levels));\n\n        let { (tlets, ntlets, lams) = get_stats (sum_stats fss) };\n\n        dumpIfSet_dyn dflags Opt_D_dump_simpl_stats \"FloatOut stats:\"\n                (hcat [ int tlets,  text \" Lets floated to top level; \",\n                        int ntlets, text \" Lets floated elsewhere; from \",\n                        int lams,   text \" Lambda groups\"]);\n\n        return (bagToList (unionManyBags binds_s'))\n    }\n\nfloatTopBind :: LevelledBind -> (FloatStats, Bag CoreBind)\nfloatTopBind bind\n  = case (floatBind bind) of { (fs, floats, bind') ->\n    let float_bag = flattenTopFloats floats\n    in case bind' of\n      -- bind' can't have unlifted values or join points, so can only be one\n      -- value bind, rec or non-rec (see comment on floatBind)\n      [Rec prs]    -> (fs, unitBag (Rec (addTopFloatPairs float_bag prs)))\n      [NonRec b e] -> (fs, float_bag `snocBag` NonRec b e)\n      _            -> pprPanic \"floatTopBind\" (ppr bind') }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[FloatOut-Bind]{Floating in a binding (the business end)}\n*                                                                      *\n************************************************************************\n-}\n\nfloatBind :: LevelledBind -> (FloatStats, FloatBinds, [CoreBind])\n  -- Returns a list with either\n  --   * A single non-recursive binding (value or join point), or\n  --   * The following, in order:\n  --     * Zero or more non-rec unlifted bindings\n  --     * One or both of:\n  --       * A recursive group of join binds\n  --       * A recursive group of value binds\n  -- See Note [Floating out of Rec rhss] for why things get arranged this way.\nfloatBind (NonRec (TB var _) rhs)\n  = case (floatRhs var rhs) of { (fs, rhs_floats, rhs') ->\n\n        -- A tiresome hack:\n        -- see Note [Bottoming floats: eta expansion] in SetLevels\n    let rhs'' | isBottomingId var = etaExpand (idArity var) rhs'\n              | otherwise         = rhs'\n\n    in (fs, rhs_floats, [NonRec var rhs'']) }\n\nfloatBind (Rec pairs)\n  = case floatList do_pair pairs of { (fs, rhs_floats, new_pairs) ->\n    let (new_ul_pairss, new_other_pairss) = unzip new_pairs\n        (new_join_pairs, new_l_pairs)     = partition (isJoinId . fst)\n                                                      (concat new_other_pairss)\n        -- Can't put the join points and the values in the same rec group\n        new_rec_binds | null new_join_pairs = [ Rec new_l_pairs    ]\n                      | null new_l_pairs    = [ Rec new_join_pairs ]\n                      | otherwise           = [ Rec new_l_pairs\n                                              , Rec new_join_pairs ]\n        new_non_rec_binds = [ NonRec b e | (b, e) <- concat new_ul_pairss ]\n    in\n    (fs, rhs_floats, new_non_rec_binds ++ new_rec_binds) }\n  where\n    do_pair :: (LevelledBndr, LevelledExpr)\n            -> (FloatStats, FloatBinds,\n                ([(Id,CoreExpr)],  -- Non-recursive unlifted value bindings\n                 [(Id,CoreExpr)])) -- Join points and lifted value bindings\n    do_pair (TB name spec, rhs)\n      | isTopLvl dest_lvl  -- See Note [floatBind for top level]\n      = case (floatRhs name rhs) of { (fs, rhs_floats, rhs') ->\n        (fs, emptyFloats, ([], addTopFloatPairs (flattenTopFloats rhs_floats)\n                                                [(name, rhs')]))}\n      | otherwise         -- Note [Floating out of Rec rhss]\n      = case (floatRhs name rhs) of { (fs, rhs_floats, rhs') ->\n        case (partitionByLevel dest_lvl rhs_floats) of { (rhs_floats', heres) ->\n        case (splitRecFloats heres) of { (ul_pairs, pairs, case_heres) ->\n        let pairs' = (name, installUnderLambdas case_heres rhs') : pairs in\n        (fs, rhs_floats', (ul_pairs, pairs')) }}}\n      where\n        dest_lvl = floatSpecLevel spec\n\nsplitRecFloats :: Bag FloatBind\n               -> ([(Id,CoreExpr)], -- Non-recursive unlifted value bindings\n                   [(Id,CoreExpr)], -- Join points and lifted value bindings\n                   Bag FloatBind)   -- A tail of further bindings\n-- The \"tail\" begins with a case\n-- See Note [Floating out of Rec rhss]\nsplitRecFloats fs\n  = go [] [] (bagToList fs)\n  where\n    go ul_prs prs (FloatLet (NonRec b r) : fs) | isUnliftedType (idType b)\n                                               , not (isJoinId b)\n                                               = go ((b,r):ul_prs) prs fs\n                                               | otherwise\n                                               = go ul_prs ((b,r):prs) fs\n    go ul_prs prs (FloatLet (Rec prs')   : fs) = go ul_prs (prs' ++ prs) fs\n    go ul_prs prs fs                           = (reverse ul_prs, prs,\n                                                  listToBag fs)\n                                                   -- Order only matters for\n                                                   -- non-rec\n\ninstallUnderLambdas :: Bag FloatBind -> CoreExpr -> CoreExpr\n-- Note [Floating out of Rec rhss]\ninstallUnderLambdas floats e\n  | isEmptyBag floats = e\n  | otherwise         = go e\n  where\n    go (Lam b e)                 = Lam b (go e)\n    go e                         = install floats e\n\n---------------\nfloatList :: (a -> (FloatStats, FloatBinds, b)) -> [a] -> (FloatStats, FloatBinds, [b])\nfloatList _ [] = (zeroStats, emptyFloats, [])\nfloatList f (a:as) = case f a            of { (fs_a,  binds_a,  b)  ->\n                     case floatList f as of { (fs_as, binds_as, bs) ->\n                     (fs_a `add_stats` fs_as, binds_a `plusFloats`  binds_as, b:bs) }}\n\n{-\nNote [Floating out of Rec rhss]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider   Rec { f<1,0> = \\xy. body }\nFrom the body we may get some floats. The ones with level <1,0> must\nstay here, since they may mention f.  Ideally we'd like to make them\npart of the Rec block pairs -- but we can't if there are any\nFloatCases involved.\n\nNor is it a good idea to dump them in the rhs, but outside the lambda\n    f = case x of I# y -> \\xy. body\nbecause now f's arity might get worse, which is Not Good. (And if\nthere's an SCC around the RHS it might not get better again.\nSee Trac #5342.)\n\nSo, gruesomely, we split the floats into\n * the outer FloatLets, which can join the Rec, and\n * an inner batch starting in a FloatCase, which are then\n   pushed *inside* the lambdas.\nThis loses full-laziness the rare situation where there is a\nFloatCase and a Rec interacting.\n\nIf there are unlifted FloatLets (that *aren't* join points) among the floats,\nwe can't add them to the recursive group without angering Core Lint, but since\nthey must be ok-for-speculation, they can't actually be making any recursive\ncalls, so we can safely pull them out and keep them non-recursive.\n\n(Why is something getting floated to <1,0> that doesn't make a recursive call?\nThe case that came up in testing was that f *and* the unlifted binding were\ngetting floated *to the same place*:\n\n  \\x<2,0> ->\n    ... <3,0>\n    letrec { f<F<2,0>> =\n      ... let x'<F<2,0>> = x +# 1# in ...\n    } in ...\n\nEverything gets labeled \"float to <2,0>\" because it all depends on x, but this\nmakes f and x' look mutually recursive when they're not.\n\nThe test was shootout/k-nucleotide, as compiled using commit 47d5dd68 on the\nwip/join-points branch.\n\nTODO: This can probably be solved somehow in SetLevels. The difference between\n\"this *is at* level <2,0>\" and \"this *depends on* level <2,0>\" is very\nimportant.)\n\nNote [floatBind for top level]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe may have a *nested* binding whose destination level is (FloatMe tOP_LEVEL), thus\n         letrec { foo <0,0> = .... (let bar<0,0> = .. in ..) .... }\nThe binding for bar will be in the \"tops\" part of the floating binds,\nand thus not partioned by floatBody.\n\nWe could perhaps get rid of the 'tops' component of the floating binds,\nbut this case works just as well.\n\n\n************************************************************************\n\n\\subsection[FloatOut-Expr]{Floating in expressions}\n*                                                                      *\n************************************************************************\n-}\n\nfloatBody :: Level\n          -> LevelledExpr\n          -> (FloatStats, FloatBinds, CoreExpr)\n\nfloatBody lvl arg       -- Used rec rhss, and case-alternative rhss\n  = case (floatExpr arg) of { (fsa, floats, arg') ->\n    case (partitionByLevel lvl floats) of { (floats', heres) ->\n        -- Dump bindings are bound here\n    (fsa, floats', install heres arg') }}\n\n-----------------\n\n{- Note [Floating past breakpoints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe used to disallow floating out of breakpoint ticks (see #10052). However, I\nthink this is too restrictive.\n\nConsider the case of an expression scoped over by a breakpoint tick,\n\n  tick<...> (let x = ... in f x)\n\nIn this case it is completely legal to float out x, despite the fact that\nbreakpoint ticks are scoped,\n\n  let x = ... in (tick<...>  f x)\n\nThe reason here is that we know that the breakpoint will still be hit when the\nexpression is entered since the tick still scopes over the RHS.\n\n-}\n\nfloatExpr :: LevelledExpr\n          -> (FloatStats, FloatBinds, CoreExpr)\nfloatExpr (Var v)   = (zeroStats, emptyFloats, Var v)\nfloatExpr (Type ty) = (zeroStats, emptyFloats, Type ty)\nfloatExpr (Coercion co) = (zeroStats, emptyFloats, Coercion co)\nfloatExpr (Lit lit) = (zeroStats, emptyFloats, Lit lit)\n\nfloatExpr (App e a)\n  = case (atJoinCeiling $ floatExpr  e) of { (fse, floats_e, e') ->\n    case (atJoinCeiling $ floatExpr  a) of { (fsa, floats_a, a') ->\n    (fse `add_stats` fsa, floats_e `plusFloats` floats_a, App e' a') }}\n\nfloatExpr lam@(Lam (TB _ lam_spec) _)\n  = let (bndrs_w_lvls, body) = collectBinders lam\n        bndrs                = [b | TB b _ <- bndrs_w_lvls]\n        bndr_lvl             = asJoinCeilLvl (floatSpecLevel lam_spec)\n        -- All the binders have the same level\n        -- See SetLevels.lvlLamBndrs\n        -- Use asJoinCeilLvl to make this the join ceiling\n    in\n    case (floatBody bndr_lvl body) of { (fs, floats, body') ->\n    (add_to_stats fs floats, floats, mkLams bndrs body') }\n\nfloatExpr (Tick tickish expr)\n  | tickish `tickishScopesLike` SoftScope -- not scoped, can just float\n  = case (atJoinCeiling $ floatExpr expr)    of { (fs, floating_defns, expr') ->\n    (fs, floating_defns, Tick tickish expr') }\n\n  | not (tickishCounts tickish) || tickishCanSplit tickish\n  = case (atJoinCeiling $ floatExpr expr)    of { (fs, floating_defns, expr') ->\n    let -- Annotate bindings floated outwards past an scc expression\n        -- with the cc.  We mark that cc as \"duplicated\", though.\n        annotated_defns = wrapTick (mkNoCount tickish) floating_defns\n    in\n    (fs, annotated_defns, Tick tickish expr') }\n\n  -- Note [Floating past breakpoints]\n  | Breakpoint{} <- tickish\n  = case (floatExpr expr)    of { (fs, floating_defns, expr') ->\n    (fs, floating_defns, Tick tickish expr') }\n\n  | otherwise\n  = pprPanic \"floatExpr tick\" (ppr tickish)\n\nfloatExpr (Cast expr co)\n  = case (atJoinCeiling $ floatExpr expr) of { (fs, floating_defns, expr') ->\n    (fs, floating_defns, Cast expr' co) }\n\nfloatExpr (Let bind body)\n  = case bind_spec of\n      FloatMe dest_lvl\n        -> case (floatBind bind) of { (fsb, bind_floats, binds') ->\n           case (floatExpr body) of { (fse, body_floats, body') ->\n           let new_bind_floats = foldr plusFloats emptyFloats\n                                   (map (unitLetFloat dest_lvl) binds') in\n           ( add_stats fsb fse\n           , bind_floats `plusFloats` new_bind_floats\n                         `plusFloats` body_floats\n           , body') }}\n\n      StayPut bind_lvl  -- See Note [Avoiding unnecessary floating]\n        -> case (floatBind bind)          of { (fsb, bind_floats, binds') ->\n           case (floatBody bind_lvl body) of { (fse, body_floats, body') ->\n           ( add_stats fsb fse\n           , bind_floats `plusFloats` body_floats\n           , foldr Let body' binds' ) }}\n  where\n    bind_spec = case bind of\n                 NonRec (TB _ s) _     -> s\n                 Rec ((TB _ s, _) : _) -> s\n                 Rec []                -> panic \"floatExpr:rec\"\n\nfloatExpr (Case scrut (TB case_bndr case_spec) ty alts)\n  = case case_spec of\n      FloatMe dest_lvl  -- Case expression moves\n        | [(con@(DataAlt {}), bndrs, rhs)] <- alts\n        -> case atJoinCeiling $ floatExpr scrut of { (fse, fde, scrut') ->\n           case                 floatExpr rhs   of { (fsb, fdb, rhs') ->\n           let\n             float = unitCaseFloat dest_lvl scrut'\n                          case_bndr con [b | TB b _ <- bndrs]\n           in\n           (add_stats fse fsb, fde `plusFloats` float `plusFloats` fdb, rhs') }}\n        | otherwise\n        -> pprPanic \"Floating multi-case\" (ppr alts)\n\n      StayPut bind_lvl  -- Case expression stays put\n        -> case atJoinCeiling $ floatExpr scrut of { (fse, fde, scrut') ->\n           case floatList (float_alt bind_lvl) alts of { (fsa, fda, alts')  ->\n           (add_stats fse fsa, fda `plusFloats` fde, Case scrut' case_bndr ty alts')\n           }}\n  where\n    float_alt bind_lvl (con, bs, rhs)\n        = case (floatBody bind_lvl rhs) of { (fs, rhs_floats, rhs') ->\n          (fs, rhs_floats, (con, [b | TB b _ <- bs], rhs')) }\n\nfloatRhs :: CoreBndr\n         -> LevelledExpr\n         -> (FloatStats, FloatBinds, CoreExpr)\nfloatRhs bndr rhs\n  | Just join_arity <- isJoinId_maybe bndr\n  , Just (bndrs, body) <- try_collect join_arity rhs []\n  = case bndrs of\n      []                -> floatExpr rhs\n      (TB _ lam_spec):_ ->\n        let lvl = floatSpecLevel lam_spec in\n        case floatBody lvl body of { (fs, floats, body') ->\n        (fs, floats, mkLams [b | TB b _ <- bndrs] body') }\n  | otherwise\n  = atJoinCeiling $ floatExpr rhs\n  where\n    try_collect 0 expr      acc = Just (reverse acc, expr)\n    try_collect n (Lam b e) acc = try_collect (n-1) e (b:acc)\n    try_collect _ _         _   = Nothing\n\n{-\nNote [Avoiding unnecessary floating]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn general we want to avoid floating a let unnecessarily, because\nit might worsen strictness:\n    let\n       x = ...(let y = e in y+y)....\nHere y is demanded.  If we float it outside the lazy 'x=..' then\nwe'd have to zap its demand info, and it may never be restored.\n\nSo at a 'let' we leave the binding right where the are unless\nthe binding will escape a value lambda, e.g.\n\n(\\x -> let y = fac 100 in y)\n\nThat's what the partitionByMajorLevel does in the floatExpr (Let ...)\ncase.\n\nNotice, though, that we must take care to drop any bindings\nfrom the body of the let that depend on the staying-put bindings.\n\nWe used instead to do the partitionByMajorLevel on the RHS of an '=',\nin floatRhs.  But that was quite tiresome.  We needed to test for\nvalues or trival rhss, because (in particular) we don't want to insert\nnew bindings between the \"=\" and the \"\\\".  E.g.\n        f = \\x -> let <bind> in <body>\nWe do not want\n        f = let <bind> in \\x -> <body>\n(a) The simplifier will immediately float it further out, so we may\n        as well do so right now; in general, keeping rhss as manifest\n        values is good\n(b) If a float-in pass follows immediately, it might add yet more\n        bindings just after the '='.  And some of them might (correctly)\n        be strict even though the 'let f' is lazy, because f, being a value,\n        gets its demand-info zapped by the simplifier.\nAnd even all that turned out to be very fragile, and broke\naltogether when profiling got in the way.\n\nSo now we do the partition right at the (Let..) itself.\n\n************************************************************************\n*                                                                      *\n\\subsection{Utility bits for floating stats}\n*                                                                      *\n************************************************************************\n\nI didn't implement this with unboxed numbers.  I don't want to be too\nstrict in this stuff, as it is rarely turned on.  (WDP 95/09)\n-}\n\ndata FloatStats\n  = FlS Int  -- Number of top-floats * lambda groups they've been past\n        Int  -- Number of non-top-floats * lambda groups they've been past\n        Int  -- Number of lambda (groups) seen\n\nget_stats :: FloatStats -> (Int, Int, Int)\nget_stats (FlS a b c) = (a, b, c)\n\nzeroStats :: FloatStats\nzeroStats = FlS 0 0 0\n\nsum_stats :: [FloatStats] -> FloatStats\nsum_stats xs = foldr add_stats zeroStats xs\n\nadd_stats :: FloatStats -> FloatStats -> FloatStats\nadd_stats (FlS a1 b1 c1) (FlS a2 b2 c2)\n  = FlS (a1 + a2) (b1 + b2) (c1 + c2)\n\nadd_to_stats :: FloatStats -> FloatBinds -> FloatStats\nadd_to_stats (FlS a b c) (FB tops ceils others)\n  = FlS (a + lengthBag tops)\n        (b + lengthBag ceils + lengthBag (flattenMajor others))\n        (c + 1)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Utility bits for floating}\n*                                                                      *\n************************************************************************\n\nNote [Representation of FloatBinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe FloatBinds types is somewhat important.  We can get very large numbers\nof floating bindings, often all destined for the top level.  A typical example\nis     x = [4,2,5,2,5, .... ]\nThen we get lots of small expressions like (fromInteger 4), which all get\nlifted to top level.\n\nThe trouble is that\n  (a) we partition these floating bindings *at every binding site*\n  (b) SetLevels introduces a new bindings site for every float\nSo we had better not look at each binding at each binding site!\n\nThat is why MajorEnv is represented as a finite map.\n\nWe keep the bindings destined for the *top* level separate, because\nwe float them out even if they don't escape a *value* lambda; see\npartitionByMajorLevel.\n-}\n\ntype FloatLet = CoreBind        -- INVARIANT: a FloatLet is always lifted\ntype MajorEnv = M.IntMap MinorEnv         -- Keyed by major level\ntype MinorEnv = M.IntMap (Bag FloatBind)  -- Keyed by minor level\n\ndata FloatBinds  = FB !(Bag FloatLet)           -- Destined for top level\n                      !(Bag FloatBind)          -- Destined for join ceiling\n                      !MajorEnv                 -- Other levels\n     -- See Note [Representation of FloatBinds]\n\ninstance Outputable FloatBinds where\n  ppr (FB fbs ceils defs)\n      = text \"FB\" <+> (braces $ vcat\n           [ text \"tops =\"     <+> ppr fbs\n           , text \"ceils =\"    <+> ppr ceils\n           , text \"non-tops =\" <+> ppr defs ])\n\nflattenTopFloats :: FloatBinds -> Bag CoreBind\nflattenTopFloats (FB tops ceils defs)\n  = ASSERT2( isEmptyBag (flattenMajor defs), ppr defs )\n    ASSERT2( isEmptyBag ceils, ppr ceils )\n    tops\n\naddTopFloatPairs :: Bag CoreBind -> [(Id,CoreExpr)] -> [(Id,CoreExpr)]\naddTopFloatPairs float_bag prs\n  = foldrBag add prs float_bag\n  where\n    add (NonRec b r) prs  = (b,r):prs\n    add (Rec prs1)   prs2 = prs1 ++ prs2\n\nflattenMajor :: MajorEnv -> Bag FloatBind\nflattenMajor = M.foldr (unionBags . flattenMinor) emptyBag\n\nflattenMinor :: MinorEnv -> Bag FloatBind\nflattenMinor = M.foldr unionBags emptyBag\n\nemptyFloats :: FloatBinds\nemptyFloats = FB emptyBag emptyBag M.empty\n\nunitCaseFloat :: Level -> CoreExpr -> Id -> AltCon -> [Var] -> FloatBinds\nunitCaseFloat (Level major minor t) e b con bs\n  | t == JoinCeilLvl\n  = FB emptyBag floats M.empty\n  | otherwise\n  = FB emptyBag emptyBag (M.singleton major (M.singleton minor floats))\n  where\n    floats = unitBag (FloatCase e b con bs)\n\nunitLetFloat :: Level -> FloatLet -> FloatBinds\nunitLetFloat lvl@(Level major minor t) b\n  | isTopLvl lvl     = FB (unitBag b) emptyBag M.empty\n  | t == JoinCeilLvl = FB emptyBag floats M.empty\n  | otherwise        = FB emptyBag emptyBag (M.singleton major\n                                              (M.singleton minor floats))\n  where\n    floats = unitBag (FloatLet b)\n\nplusFloats :: FloatBinds -> FloatBinds -> FloatBinds\nplusFloats (FB t1 c1 l1) (FB t2 c2 l2)\n  = FB (t1 `unionBags` t2) (c1 `unionBags` c2) (l1 `plusMajor` l2)\n\nplusMajor :: MajorEnv -> MajorEnv -> MajorEnv\nplusMajor = M.unionWith plusMinor\n\nplusMinor :: MinorEnv -> MinorEnv -> MinorEnv\nplusMinor = M.unionWith unionBags\n\ninstall :: Bag FloatBind -> CoreExpr -> CoreExpr\ninstall defn_groups expr\n  = foldrBag wrapFloat expr defn_groups\n\npartitionByLevel\n        :: Level                -- Partitioning level\n        -> FloatBinds           -- Defns to be divided into 2 piles...\n        -> (FloatBinds,         -- Defns  with level strictly < partition level,\n            Bag FloatBind)      -- The rest\n\n{-\n--       ---- partitionByMajorLevel ----\n-- Float it if we escape a value lambda,\n--     *or* if we get to the top level\n--     *or* if it's a case-float and its minor level is < current\n--\n-- If we can get to the top level, say \"yes\" anyway. This means that\n--      x = f e\n-- transforms to\n--    lvl = e\n--    x = f lvl\n-- which is as it should be\n\npartitionByMajorLevel (Level major _) (FB tops defns)\n  = (FB tops outer, heres `unionBags` flattenMajor inner)\n  where\n    (outer, mb_heres, inner) = M.splitLookup major defns\n    heres = case mb_heres of\n               Nothing -> emptyBag\n               Just h  -> flattenMinor h\n-}\n\npartitionByLevel (Level major minor typ) (FB tops ceils defns)\n  = (FB tops ceils' (outer_maj `plusMajor` M.singleton major outer_min),\n     here_min `unionBags` here_ceil\n              `unionBags` flattenMinor inner_min\n              `unionBags` flattenMajor inner_maj)\n\n  where\n    (outer_maj, mb_here_maj, inner_maj) = M.splitLookup major defns\n    (outer_min, mb_here_min, inner_min) = case mb_here_maj of\n                                            Nothing -> (M.empty, Nothing, M.empty)\n                                            Just min_defns -> M.splitLookup minor min_defns\n    here_min = mb_here_min `orElse` emptyBag\n    (here_ceil, ceils') | typ == JoinCeilLvl = (ceils, emptyBag)\n                        | otherwise          = (emptyBag, ceils)\n\n-- Like partitionByLevel, but instead split out the bindings that are marked\n-- to float to the nearest join ceiling (see Note [Join points])\npartitionAtJoinCeiling :: FloatBinds -> (FloatBinds, Bag FloatBind)\npartitionAtJoinCeiling (FB tops ceils defs)\n  = (FB tops emptyBag defs, ceils)\n\n-- Perform some action at a join ceiling, i.e., don't let join points float out\n-- (see Note [Join points])\natJoinCeiling :: (FloatStats, FloatBinds, CoreExpr)\n              -> (FloatStats, FloatBinds, CoreExpr)\natJoinCeiling (fs, floats, expr')\n  = (fs, floats', install ceils expr')\n  where\n    (floats', ceils) = partitionAtJoinCeiling floats\n\nwrapTick :: Tickish Id -> FloatBinds -> FloatBinds\nwrapTick t (FB tops ceils defns)\n  = FB (mapBag wrap_bind tops) (wrap_defns ceils)\n       (M.map (M.map wrap_defns) defns)\n  where\n    wrap_defns = mapBag wrap_one\n\n    wrap_bind (NonRec binder rhs) = NonRec binder (maybe_tick rhs)\n    wrap_bind (Rec pairs)         = Rec (mapSnd maybe_tick pairs)\n\n    wrap_one (FloatLet bind)      = FloatLet (wrap_bind bind)\n    wrap_one (FloatCase e b c bs) = FloatCase (maybe_tick e) b c bs\n\n    maybe_tick e | exprIsHNF e = tickHNFArgs t e\n                 | otherwise   = mkTick t e\n      -- we don't need to wrap a tick around an HNF when we float it\n      -- outside a tick: that is an invariant of the tick semantics\n      -- Conversely, inlining of HNFs inside an SCC is allowed, and\n      -- indeed the HNF we're floating here might well be inlined back\n      -- again, and we don't want to end up with duplicate ticks.\n", "num_lines": 756}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1994-1998\n\n\\section[LiberateCase]{Unroll recursion to allow evals to be lifted from a loop}\n-}\n\n{-# LANGUAGE CPP #-}\nmodule LiberateCase ( liberateCase ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport CoreSyn\nimport CoreUnfold       ( couldBeSmallEnoughToInline )\nimport TysWiredIn       ( unitDataConId )\nimport Id\nimport VarEnv\nimport Util             ( notNull )\n\n{-\nThe liberate-case transformation\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis module walks over @Core@, and looks for @case@ on free variables.\nThe criterion is:\n        if there is case on a free on the route to the recursive call,\n        then the recursive call is replaced with an unfolding.\n\nExample\n\n   f = \\ t -> case v of\n                 V a b -> a : f t\n\n=> the inner f is replaced.\n\n   f = \\ t -> case v of\n                 V a b -> a : (letrec\n                                f =  \\ t -> case v of\n                                               V a b -> a : f t\n                               in f) t\n(note the NEED for shadowing)\n\n=> Simplify\n\n  f = \\ t -> case v of\n                 V a b -> a : (letrec\n                                f = \\ t -> a : f t\n                               in f t)\n\nBetter code, because 'a' is  free inside the inner letrec, rather\nthan needing projection from v.\n\nNote that this deals with *free variables*.  SpecConstr deals with\n*arguments* that are of known form.  E.g.\n\n        last []     = error\n        last (x:[]) = x\n        last (x:xs) = last xs\n\n\nNote [Scrutinee with cast]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n    f = \\ t -> case (v `cast` co) of\n                 V a b -> a : f t\n\nExactly the same optimisation (unrolling one call to f) will work here,\ndespite the cast.  See mk_alt_env in the Case branch of libCase.\n\n\nTo think about (Apr 94)\n~~~~~~~~~~~~~~\nMain worry: duplicating code excessively.  At the moment we duplicate\nthe entire binding group once at each recursive call.  But there may\nbe a group of recursive calls which share a common set of evaluated\nfree variables, in which case the duplication is a plain waste.\n\nAnother thing we could consider adding is some unfold-threshold thing,\nso that we'll only duplicate if the size of the group rhss isn't too\nbig.\n\nData types\n~~~~~~~~~~\nThe ``level'' of a binder tells how many\nrecursive defns lexically enclose the binding\nA recursive defn \"encloses\" its RHS, not its\nscope.  For example:\n\\begin{verbatim}\n        letrec f = let g = ... in ...\n        in\n        let h = ...\n        in ...\n\\end{verbatim}\nHere, the level of @f@ is zero, the level of @g@ is one,\nand the level of @h@ is zero (NB not one).\n\n\n************************************************************************\n*                                                                      *\n         Top-level code\n*                                                                      *\n************************************************************************\n-}\n\nliberateCase :: DynFlags -> CoreProgram -> CoreProgram\nliberateCase dflags binds = do_prog (initEnv dflags) binds\n  where\n    do_prog _   [] = []\n    do_prog env (bind:binds) = bind' : do_prog env' binds\n                             where\n                               (env', bind') = libCaseBind env bind\n\n{-\n************************************************************************\n*                                                                      *\n         Main payload\n*                                                                      *\n************************************************************************\n\nBindings\n~~~~~~~~\n-}\n\nlibCaseBind :: LibCaseEnv -> CoreBind -> (LibCaseEnv, CoreBind)\n\nlibCaseBind env (NonRec binder rhs)\n  = (addBinders env [binder], NonRec binder (libCase env rhs))\n\nlibCaseBind env (Rec pairs)\n  = (env_body, Rec pairs')\n  where\n    binders = map fst pairs\n\n    env_body = addBinders env binders\n\n    pairs' = [(binder, libCase env_rhs rhs) | (binder,rhs) <- pairs]\n\n        -- We extend the rec-env by binding each Id to its rhs, first\n        -- processing the rhs with an *un-extended* environment, so\n        -- that the same process doesn't occur for ever!\n    env_rhs | is_dupable_bind = addRecBinds env dup_pairs\n            | otherwise       = env\n\n    dup_pairs = [ (localiseId binder, libCase env_body rhs)\n                | (binder, rhs) <- pairs ]\n        -- localiseID : see Note [Need to localiseId in libCaseBind]\n\n    is_dupable_bind = small_enough && all ok_pair pairs\n\n    -- Size: we are going to duplicate dup_pairs; to find their\n    --       size, build a fake binding (let { dup_pairs } in (),\n    --       and find the size of that\n    -- See Note [Small enough]\n    small_enough = case bombOutSize env of\n                      Nothing   -> True   -- Infinity\n                      Just size -> couldBeSmallEnoughToInline (lc_dflags env) size $\n                                   Let (Rec dup_pairs) (Var unitDataConId)\n\n    ok_pair (id,_)\n        =  idArity id > 0          -- Note [Only functions!]\n        && not (isBottomingId id)  -- Note [Not bottoming ids]\n\n{- Note [Not bottoming Ids]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDo not specialise error-functions (this is unusual, but I once saw it,\n(acually in Data.Typable.Internal)\n\nNote [Only functions!]\n~~~~~~~~~~~~~~~~~~~~~~\nConsider the following code\n\n       f = g (case v of V a b -> a : t f)\n\nwhere g is expensive. If we aren't careful, liberate case will turn this into\n\n       f = g (case v of\n               V a b -> a : t (letrec f = g (case v of V a b -> a : f t)\n                                in f)\n             )\n\nYikes! We evaluate g twice. This leads to a O(2^n) explosion\nif g calls back to the same code recursively.\n\nSolution: make sure that we only do the liberate-case thing on *functions*\n\nNote [Small enough]\n~~~~~~~~~~~~~~~~~~~\nConsider\n  \\fv. letrec\n         f = \\x. BIG...(case fv of { (a,b) -> ...g.. })...\n         g = \\y. SMALL...f...\n\nThen we *can* in principle do liberate-case on 'g' (small RHS) but not\nfor 'f' (too big).  But doing so is not profitable, because duplicating\n'g' at its call site in 'f' doesn't get rid of any cases.  So we just\nask for the whole group to be small enough.\n\nNote [Need to localiseId in libCaseBind]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe call to localiseId is needed for two subtle reasons\n(a)  Reset the export flags on the binders so\n        that we don't get name clashes on exported things if the\n        local binding floats out to top level.  This is most unlikely\n        to happen, since the whole point concerns free variables.\n        But resetting the export flag is right regardless.\n\n(b)  Make the name an Internal one.  External Names should never be\n        nested; if it were floated to the top level, we'd get a name\n        clash at code generation time.\n\nExpressions\n~~~~~~~~~~~\n-}\n\nlibCase :: LibCaseEnv\n        -> CoreExpr\n        -> CoreExpr\n\nlibCase env (Var v)             = libCaseApp env v []\nlibCase _   (Lit lit)           = Lit lit\nlibCase _   (Type ty)           = Type ty\nlibCase _   (Coercion co)       = Coercion co\nlibCase env e@(App {})          | let (fun, args) = collectArgs e\n                                , Var v <- fun\n                                = libCaseApp env v args\nlibCase env (App fun arg)       = App (libCase env fun) (libCase env arg)\nlibCase env (Tick tickish body) = Tick tickish (libCase env body)\nlibCase env (Cast e co)         = Cast (libCase env e) co\n\nlibCase env (Lam binder body)\n  = Lam binder (libCase (addBinders env [binder]) body)\n\nlibCase env (Let bind body)\n  = Let bind' (libCase env_body body)\n  where\n    (env_body, bind') = libCaseBind env bind\n\nlibCase env (Case scrut bndr ty alts)\n  = Case (libCase env scrut) bndr ty (map (libCaseAlt env_alts) alts)\n  where\n    env_alts = addBinders (mk_alt_env scrut) [bndr]\n    mk_alt_env (Var scrut_var) = addScrutedVar env scrut_var\n    mk_alt_env (Cast scrut _)  = mk_alt_env scrut       -- Note [Scrutinee with cast]\n    mk_alt_env _               = env\n\nlibCaseAlt :: LibCaseEnv -> (AltCon, [CoreBndr], CoreExpr)\n                         -> (AltCon, [CoreBndr], CoreExpr)\nlibCaseAlt env (con,args,rhs) = (con, args, libCase (addBinders env args) rhs)\n\n{-\nIds\n~~~\n\nTo unfold, we can't just wrap the id itself in its binding if it's a join point:\n\n  jump j a b c  =>  (joinrec j x y z = ... in jump j) a b c -- wrong!!!\n\nEvery jump must provide all arguments, so we have to be careful to wrap the\nwhole jump instead:\n\n  jump j a b c  =>  joinrec j x y z = ... in jump j a b c -- right\n\n-}\n\nlibCaseApp :: LibCaseEnv -> Id -> [CoreExpr] -> CoreExpr\nlibCaseApp env v args\n  | Just the_bind <- lookupRecId env v  -- It's a use of a recursive thing\n  , notNull free_scruts                 -- with free vars scrutinised in RHS\n  = Let the_bind expr'\n\n  | otherwise\n  = expr'\n\n  where\n    rec_id_level = lookupLevel env v\n    free_scruts  = freeScruts env rec_id_level\n    expr'        = mkApps (Var v) (map (libCase env) args)\n\nfreeScruts :: LibCaseEnv\n           -> LibCaseLevel      -- Level of the recursive Id\n           -> [Id]              -- Ids that are scrutinised between the binding\n                                -- of the recursive Id and here\nfreeScruts env rec_bind_lvl\n  = [v | (v, scrut_bind_lvl, scrut_at_lvl) <- lc_scruts env\n       , scrut_bind_lvl <= rec_bind_lvl\n       , scrut_at_lvl > rec_bind_lvl]\n        -- Note [When to specialise]\n        -- Note [Avoiding fruitless liberate-case]\n\n{-\nNote [When to specialise]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  f = \\x. letrec g = \\y. case x of\n                           True  -> ... (f a) ...\n                           False -> ... (g b) ...\n\nWe get the following levels\n          f  0\n          x  1\n          g  1\n          y  2\n\nThen 'x' is being scrutinised at a deeper level than its binding, so\nit's added to lc_sruts:  [(x,1)]\n\nWe do *not* want to specialise the call to 'f', because 'x' is not free\nin 'f'.  So here the bind-level of 'x' (=1) is not <= the bind-level of 'f' (=0).\n\nWe *do* want to specialise the call to 'g', because 'x' is free in g.\nHere the bind-level of 'x' (=1) is <= the bind-level of 'g' (=1).\n\nNote [Avoiding fruitless liberate-case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider also:\n  f = \\x. case top_lvl_thing of\n                I# _ -> let g = \\y. ... g ...\n                        in ...\n\nHere, top_lvl_thing is scrutinised at a level (1) deeper than its\nbinding site (0).  Nevertheless, we do NOT want to specialise the call\nto 'g' because all the structure in its free variables is already\nvisible at the definition site for g.  Hence, when considering specialising\nan occurrence of 'g', we want to check that there's a scruted-var v st\n\n   a) v's binding site is *outside* g\n   b) v's scrutinisation site is *inside* g\n\n\n************************************************************************\n*                                                                      *\n        Utility functions\n*                                                                      *\n************************************************************************\n-}\n\naddBinders :: LibCaseEnv -> [CoreBndr] -> LibCaseEnv\naddBinders env@(LibCaseEnv { lc_lvl = lvl, lc_lvl_env = lvl_env }) binders\n  = env { lc_lvl_env = lvl_env' }\n  where\n    lvl_env' = extendVarEnvList lvl_env (binders `zip` repeat lvl)\n\naddRecBinds :: LibCaseEnv -> [(Id,CoreExpr)] -> LibCaseEnv\naddRecBinds env@(LibCaseEnv {lc_lvl = lvl, lc_lvl_env = lvl_env,\n                             lc_rec_env = rec_env}) pairs\n  = env { lc_lvl = lvl', lc_lvl_env = lvl_env', lc_rec_env = rec_env' }\n  where\n    lvl'     = lvl + 1\n    lvl_env' = extendVarEnvList lvl_env [(binder,lvl) | (binder,_) <- pairs]\n    rec_env' = extendVarEnvList rec_env [(binder, Rec pairs) | (binder,_) <- pairs]\n\naddScrutedVar :: LibCaseEnv\n              -> Id             -- This Id is being scrutinised by a case expression\n              -> LibCaseEnv\n\naddScrutedVar env@(LibCaseEnv { lc_lvl = lvl, lc_lvl_env = lvl_env,\n                                lc_scruts = scruts }) scrut_var\n  | bind_lvl < lvl\n  = env { lc_scruts = scruts' }\n        -- Add to scruts iff the scrut_var is being scrutinised at\n        -- a deeper level than its defn\n\n  | otherwise = env\n  where\n    scruts'  = (scrut_var, bind_lvl, lvl) : scruts\n    bind_lvl = case lookupVarEnv lvl_env scrut_var of\n                 Just lvl -> lvl\n                 Nothing  -> topLevel\n\nlookupRecId :: LibCaseEnv -> Id -> Maybe CoreBind\nlookupRecId env id = lookupVarEnv (lc_rec_env env) id\n\nlookupLevel :: LibCaseEnv -> Id -> LibCaseLevel\nlookupLevel env id\n  = case lookupVarEnv (lc_lvl_env env) id of\n      Just lvl -> lvl\n      Nothing  -> topLevel\n\n{-\n************************************************************************\n*                                                                      *\n         The environment\n*                                                                      *\n************************************************************************\n-}\n\ntype LibCaseLevel = Int\n\ntopLevel :: LibCaseLevel\ntopLevel = 0\n\ndata LibCaseEnv\n  = LibCaseEnv {\n        lc_dflags :: DynFlags,\n\n        lc_lvl :: LibCaseLevel, -- Current level\n                -- The level is incremented when (and only when) going\n                -- inside the RHS of a (sufficiently small) recursive\n                -- function.\n\n        lc_lvl_env :: IdEnv LibCaseLevel,\n                -- Binds all non-top-level in-scope Ids (top-level and\n                -- imported things have a level of zero)\n\n        lc_rec_env :: IdEnv CoreBind,\n                -- Binds *only* recursively defined ids, to their own\n                -- binding group, and *only* in their own RHSs\n\n        lc_scruts :: [(Id, LibCaseLevel, LibCaseLevel)]\n                -- Each of these Ids was scrutinised by an enclosing\n                -- case expression, at a level deeper than its binding\n                -- level.\n                --\n                -- The first LibCaseLevel is the *binding level* of\n                --   the scrutinised Id,\n                -- The second is the level *at which it was scrutinised*.\n                --   (see Note [Avoiding fruitless liberate-case])\n                -- The former is a bit redundant, since you could always\n                -- look it up in lc_lvl_env, but it's just cached here\n                --\n                -- The order is insignificant; it's a bag really\n                --\n                -- There's one element per scrutinisation;\n                --    in principle the same Id may appear multiple times,\n                --    although that'd be unusual:\n                --       case x of { (a,b) -> ....(case x of ...) .. }\n        }\n\ninitEnv :: DynFlags -> LibCaseEnv\ninitEnv dflags\n  = LibCaseEnv { lc_dflags = dflags,\n                 lc_lvl = 0,\n                 lc_lvl_env = emptyVarEnv,\n                 lc_rec_env = emptyVarEnv,\n                 lc_scruts = [] }\n\n-- Bomb-out size for deciding if\n-- potential liberatees are too big.\n-- (passed in from cmd-line args)\nbombOutSize :: LibCaseEnv -> Maybe Int\nbombOutSize = liberateCaseThreshold . lc_dflags\n", "num_lines": 443}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n************************************************************************\n*                                                                      *\n\\section[OccurAnal]{Occurrence analysis pass}\n*                                                                      *\n************************************************************************\n\nThe occurrence analyser re-typechecks a core expression, returning a new\ncore expression with (hopefully) improved usage information.\n-}\n\n{-# LANGUAGE CPP, BangPatterns, MultiWayIf, ViewPatterns  #-}\n\nmodule OccurAnal (\n        occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreFVs\nimport CoreUtils        ( exprIsTrivial, isDefaultAlt, isExpandableApp,\n                          stripTicksTopE, mkTicks )\nimport CoreArity        ( joinRhsArity )\nimport Id\nimport IdInfo\nimport Name( localiseName )\nimport BasicTypes\nimport Module( Module )\nimport Coercion\nimport Type\n\nimport VarSet\nimport VarEnv\nimport Var\nimport Demand           ( argOneShots, argsOneShots )\nimport Digraph          ( SCC(..), Node(..)\n                        , stronglyConnCompFromEdgedVerticesUniq\n                        , stronglyConnCompFromEdgedVerticesUniqR )\nimport Unique\nimport UniqFM\nimport UniqSet\nimport Util\nimport Outputable\nimport Data.List\nimport Control.Arrow    ( second )\n\n{-\n************************************************************************\n*                                                                      *\n    occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap\n*                                                                      *\n************************************************************************\n\nHere's the externally-callable interface:\n-}\n\noccurAnalysePgm :: Module         -- Used only in debug output\n                -> (Id -> Bool)         -- Active unfoldings\n                -> (Activation -> Bool) -- Active rules\n                -> [CoreRule]\n                -> CoreProgram -> CoreProgram\noccurAnalysePgm this_mod active_unf active_rule imp_rules binds\n  | isEmptyDetails final_usage\n  = occ_anald_binds\n\n  | otherwise   -- See Note [Glomming]\n  = WARN( True, hang (text \"Glomming in\" <+> ppr this_mod <> colon)\n                   2 (ppr final_usage ) )\n    occ_anald_glommed_binds\n  where\n    init_env = initOccEnv { occ_rule_act = active_rule\n                          , occ_unf_act  = active_unf }\n\n    (final_usage, occ_anald_binds) = go init_env binds\n    (_, occ_anald_glommed_binds)   = occAnalRecBind init_env TopLevel\n                                                    imp_rule_edges\n                                                    (flattenBinds occ_anald_binds)\n                                                    initial_uds\n          -- It's crucial to re-analyse the glommed-together bindings\n          -- so that we establish the right loop breakers. Otherwise\n          -- we can easily create an infinite loop (Trac #9583 is an example)\n\n    initial_uds = addManyOccsSet emptyDetails\n                            (rulesFreeVars imp_rules)\n    -- The RULES declarations keep things alive!\n\n    -- Note [Preventing loops due to imported functions rules]\n    imp_rule_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv\n                            [ mapVarEnv (const maps_to) $\n                                getUniqSet (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule)\n                            | imp_rule <- imp_rules\n                            , not (isBuiltinRule imp_rule)  -- See Note [Plugin rules]\n                            , let maps_to = exprFreeIds (ru_rhs imp_rule)\n                                             `delVarSetList` ru_bndrs imp_rule\n                            , arg <- ru_args imp_rule ]\n\n    go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind])\n    go _ []\n        = (initial_uds, [])\n    go env (bind:binds)\n        = (final_usage, bind' ++ binds')\n        where\n           (bs_usage, binds')   = go env binds\n           (final_usage, bind') = occAnalBind env TopLevel imp_rule_edges bind\n                                              bs_usage\n\noccurAnalyseExpr :: CoreExpr -> CoreExpr\n        -- Do occurrence analysis, and discard occurrence info returned\noccurAnalyseExpr = occurAnalyseExpr' True -- do binder swap\n\noccurAnalyseExpr_NoBinderSwap :: CoreExpr -> CoreExpr\noccurAnalyseExpr_NoBinderSwap = occurAnalyseExpr' False -- do not do binder swap\n\noccurAnalyseExpr' :: Bool -> CoreExpr -> CoreExpr\noccurAnalyseExpr' enable_binder_swap expr\n  = snd (occAnal env expr)\n  where\n    env = initOccEnv { occ_binder_swap = enable_binder_swap }\n\n{- Note [Plugin rules]\n~~~~~~~~~~~~~~~~~~~~~~\nConal Elliott (Trac #11651) built a GHC plugin that added some\nBuiltinRules (for imported Ids) to the mg_rules field of ModGuts, to\ndo some domain-specific transformations that could not be expressed\nwith an ordinary pattern-matching CoreRule.  But then we can't extract\nthe dependencies (in imp_rule_edges) from ru_rhs etc, because a\nBuiltinRule doesn't have any of that stuff.\n\nSo we simply assume that BuiltinRules have no dependencies, and filter\nthem out from the imp_rule_edges comprehension.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                Bindings\n*                                                                      *\n************************************************************************\n\nNote [Recursive bindings: the grand plan]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we come across a binding group\n  Rec { x1 = r1; ...; xn = rn }\nwe treat it like this (occAnalRecBind):\n\n1. Occurrence-analyse each right hand side, and build a\n   \"Details\" for each binding to capture the results.\n\n   Wrap the details in a Node (details, node-id, dep-node-ids),\n   where node-id is just the unique of the binder, and\n   dep-node-ids lists all binders on which this binding depends.\n   We'll call these the \"scope edges\".\n   See Note [Forming the Rec groups].\n\n   All this is done by makeNode.\n\n2. Do SCC-analysis on these Nodes.  Each SCC will become a new Rec or\n   NonRec.  The key property is that every free variable of a binding\n   is accounted for by the scope edges, so that when we are done\n   everything is still in scope.\n\n3. For each Cyclic SCC of the scope-edge SCC-analysis in (2), we\n   identify suitable loop-breakers to ensure that inlining terminates.\n   This is done by occAnalRec.\n\n4. To do so we form a new set of Nodes, with the same details, but\n   different edges, the \"loop-breaker nodes\". The loop-breaker nodes\n   have both more and fewer dependencies than the scope edges\n   (see Note [Choosing loop breakers])\n\n   More edges: if f calls g, and g has an active rule that mentions h\n               then we add an edge from f -> h\n\n   Fewer edges: we only include dependencies on active rules, on rule\n                RHSs (not LHSs) and if there is an INLINE pragma only\n                on the stable unfolding (and vice versa).  The scope\n                edges must be much more inclusive.\n\n5.  The \"weak fvs\" of a node are, by definition:\n       the scope fvs - the loop-breaker fvs\n    See Note [Weak loop breakers], and the nd_weak field of Details\n\n6.  Having formed the loop-breaker nodes\n\nNote [Dead code]\n~~~~~~~~~~~~~~~~\nDropping dead code for a cyclic Strongly Connected Component is done\nin a very simple way:\n\n        the entire SCC is dropped if none of its binders are mentioned\n        in the body; otherwise the whole thing is kept.\n\nThe key observation is that dead code elimination happens after\ndependency analysis: so 'occAnalBind' processes SCCs instead of the\noriginal term's binding groups.\n\nThus 'occAnalBind' does indeed drop 'f' in an example like\n\n        letrec f = ...g...\n               g = ...(...g...)...\n        in\n           ...g...\n\nwhen 'g' no longer uses 'f' at all (eg 'f' does not occur in a RULE in\n'g'). 'occAnalBind' first consumes 'CyclicSCC g' and then it consumes\n'AcyclicSCC f', where 'body_usage' won't contain 'f'.\n\n------------------------------------------------------------\nNote [Forming Rec groups]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWe put bindings {f = ef; g = eg } in a Rec group if \"f uses g\"\nand \"g uses f\", no matter how indirectly.  We do a SCC analysis\nwith an edge f -> g if \"f uses g\".\n\nMore precisely, \"f uses g\" iff g should be in scope wherever f is.\nThat is, g is free in:\n  a) the rhs 'ef'\n  b) or the RHS of a rule for f (Note [Rules are extra RHSs])\n  c) or the LHS or a rule for f (Note [Rule dependency info])\n\nThese conditions apply regardless of the activation of the RULE (eg it might be\ninactive in this phase but become active later).  Once a Rec is broken up\nit can never be put back together, so we must be conservative.\n\nThe principle is that, regardless of rule firings, every variable is\nalways in scope.\n\n  * Note [Rules are extra RHSs]\n    ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    A RULE for 'f' is like an extra RHS for 'f'. That way the \"parent\"\n    keeps the specialised \"children\" alive.  If the parent dies\n    (because it isn't referenced any more), then the children will die\n    too (unless they are already referenced directly).\n\n    To that end, we build a Rec group for each cyclic strongly\n    connected component,\n        *treating f's rules as extra RHSs for 'f'*.\n    More concretely, the SCC analysis runs on a graph with an edge\n    from f -> g iff g is mentioned in\n        (a) f's rhs\n        (b) f's RULES\n    These are rec_edges.\n\n    Under (b) we include variables free in *either* LHS *or* RHS of\n    the rule.  The former might seems silly, but see Note [Rule\n    dependency info].  So in Example [eftInt], eftInt and eftIntFB\n    will be put in the same Rec, even though their 'main' RHSs are\n    both non-recursive.\n\n  * Note [Rule dependency info]\n    ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    The VarSet in a RuleInfo is used for dependency analysis in the\n    occurrence analyser.  We must track free vars in *both* lhs and rhs.\n    Hence use of idRuleVars, rather than idRuleRhsVars in occAnalBind.\n    Why both? Consider\n        x = y\n        RULE f x = v+4\n    Then if we substitute y for x, we'd better do so in the\n    rule's LHS too, so we'd better ensure the RULE appears to mention 'x'\n    as well as 'v'\n\n  * Note [Rules are visible in their own rec group]\n    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    We want the rules for 'f' to be visible in f's right-hand side.\n    And we'd like them to be visible in other functions in f's Rec\n    group.  E.g. in Note [Specialisation rules] we want f' rule\n    to be visible in both f's RHS, and fs's RHS.\n\n    This means that we must simplify the RULEs first, before looking\n    at any of the definitions.  This is done by Simplify.simplRecBind,\n    when it calls addLetIdInfo.\n\n------------------------------------------------------------\nNote [Choosing loop breakers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLoop breaking is surprisingly subtle.  First read the section 4 of\n\"Secrets of the GHC inliner\".  This describes our basic plan.\nWe avoid infinite inlinings by choosing loop breakers, and\nensuring that a loop breaker cuts each loop.\n\nSee also Note [Inlining and hs-boot files] in ToIface, which deals\nwith a closely related source of infinite loops.\n\nFundamentally, we do SCC analysis on a graph.  For each recursive\ngroup we choose a loop breaker, delete all edges to that node,\nre-analyse the SCC, and iterate.\n\nBut what is the graph?  NOT the same graph as was used for Note\n[Forming Rec groups]!  In particular, a RULE is like an equation for\n'f' that is *always* inlined if it is applicable.  We do *not* disable\nrules for loop-breakers.  It's up to whoever makes the rules to make\nsure that the rules themselves always terminate.  See Note [Rules for\nrecursive functions] in Simplify.hs\n\nHence, if\n    f's RHS (or its INLINE template if it has one) mentions g, and\n    g has a RULE that mentions h, and\n    h has a RULE that mentions f\n\nthen we *must* choose f to be a loop breaker.  Example: see Note\n[Specialisation rules].\n\nIn general, take the free variables of f's RHS, and augment it with\nall the variables reachable by RULES from those starting points.  That\nis the whole reason for computing rule_fv_env in occAnalBind.  (Of\ncourse we only consider free vars that are also binders in this Rec\ngroup.)  See also Note [Finding rule RHS free vars]\n\nNote that when we compute this rule_fv_env, we only consider variables\nfree in the *RHS* of the rule, in contrast to the way we build the\nRec group in the first place (Note [Rule dependency info])\n\nNote that if 'g' has RHS that mentions 'w', we should add w to\ng's loop-breaker edges.  More concretely there is an edge from f -> g\niff\n        (a) g is mentioned in f's RHS `xor` f's INLINE rhs\n            (see Note [Inline rules])\n        (b) or h is mentioned in f's RHS, and\n            g appears in the RHS of an active RULE of h\n            or a transitive sequence of active rules starting with h\n\nWhy \"active rules\"?  See Note [Finding rule RHS free vars]\n\nNote that in Example [eftInt], *neither* eftInt *nor* eftIntFB is\nchosen as a loop breaker, because their RHSs don't mention each other.\nAnd indeed both can be inlined safely.\n\nNote again that the edges of the graph we use for computing loop breakers\nare not the same as the edges we use for computing the Rec blocks.\nThat's why we compute\n\n- rec_edges          for the Rec block analysis\n- loop_breaker_nodes for the loop breaker analysis\n\n  * Note [Finding rule RHS free vars]\n    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    Consider this real example from Data Parallel Haskell\n         tagZero :: Array Int -> Array Tag\n         {-# INLINE [1] tagZeroes #-}\n         tagZero xs = pmap (\\x -> fromBool (x==0)) xs\n\n         {-# RULES \"tagZero\" [~1] forall xs n.\n             pmap fromBool <blah blah> = tagZero xs #-}\n    So tagZero's RHS mentions pmap, and pmap's RULE mentions tagZero.\n    However, tagZero can only be inlined in phase 1 and later, while\n    the RULE is only active *before* phase 1.  So there's no problem.\n\n    To make this work, we look for the RHS free vars only for\n    *active* rules. That's the reason for the occ_rule_act field\n    of the OccEnv.\n\n  * Note [Weak loop breakers]\n    ~~~~~~~~~~~~~~~~~~~~~~~~~\n    There is a last nasty wrinkle.  Suppose we have\n\n        Rec { f = f_rhs\n              RULE f [] = g\n\n              h = h_rhs\n              g = h\n              ...more...\n        }\n\n    Remember that we simplify the RULES before any RHS (see Note\n    [Rules are visible in their own rec group] above).\n\n    So we must *not* postInlineUnconditionally 'g', even though\n    its RHS turns out to be trivial.  (I'm assuming that 'g' is\n    not choosen as a loop breaker.)  Why not?  Because then we\n    drop the binding for 'g', which leaves it out of scope in the\n    RULE!\n\n    Here's a somewhat different example of the same thing\n        Rec { g = h\n            ; h = ...f...\n            ; f = f_rhs\n              RULE f [] = g }\n    Here the RULE is \"below\" g, but we *still* can't postInlineUnconditionally\n    g, because the RULE for f is active throughout.  So the RHS of h\n    might rewrite to     h = ...g...\n    So g must remain in scope in the output program!\n\n    We \"solve\" this by:\n\n        Make g a \"weak\" loop breaker (OccInfo = IAmLoopBreaker True)\n        iff g is a \"missing free variable\" of the Rec group\n\n    A \"missing free variable\" x is one that is mentioned in an RHS or\n    INLINE or RULE of a binding in the Rec group, but where the\n    dependency on x may not show up in the loop_breaker_nodes (see\n    note [Choosing loop breakers} above).\n\n    A normal \"strong\" loop breaker has IAmLoopBreaker False.  So\n\n                                    Inline  postInlineUnconditionally\n   strong   IAmLoopBreaker False    no      no\n   weak     IAmLoopBreaker True     yes     no\n            other                   yes     yes\n\n    The **sole** reason for this kind of loop breaker is so that\n    postInlineUnconditionally does not fire.  Ugh.  (Typically it'll\n    inline via the usual callSiteInline stuff, so it'll be dead in the\n    next pass, so the main Ugh is the tiresome complication.)\n\nNote [Rules for imported functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n   f = /\\a. B.g a\n   RULE B.g Int = 1 + f Int\nNote that\n  * The RULE is for an imported function.\n  * f is non-recursive\nNow we\ncan get\n   f Int --> B.g Int      Inlining f\n         --> 1 + f Int    Firing RULE\nand so the simplifier goes into an infinite loop. This\nwould not happen if the RULE was for a local function,\nbecause we keep track of dependencies through rules.  But\nthat is pretty much impossible to do for imported Ids.  Suppose\nf's definition had been\n   f = /\\a. C.h a\nwhere (by some long and devious process), C.h eventually inlines to\nB.g.  We could only spot such loops by exhaustively following\nunfoldings of C.h etc, in case we reach B.g, and hence (via the RULE)\nf.\n\nNote that RULES for imported functions are important in practice; they\noccur a lot in the libraries.\n\nWe regard this potential infinite loop as a *programmer* error.\nIt's up the programmer not to write silly rules like\n     RULE f x = f x\nand the example above is just a more complicated version.\n\nNote [Preventing loops due to imported functions rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider:\n  import GHC.Base (foldr)\n\n  {-# RULES \"filterList\" forall p. foldr (filterFB (:) p) [] = filter p #-}\n  filter p xs = build (\\c n -> foldr (filterFB c p) n xs)\n  filterFB c p = ...\n\n  f = filter p xs\n\nNote that filter is not a loop-breaker, so what happens is:\n  f =          filter p xs\n    = {inline} build (\\c n -> foldr (filterFB c p) n xs)\n    = {inline} foldr (filterFB (:) p) [] xs\n    = {RULE}   filter p xs\n\nWe are in an infinite loop.\n\nA more elaborate example (that I actually saw in practice when I went to\nmark GHC.List.filter as INLINABLE) is as follows. Say I have this module:\n  {-# LANGUAGE RankNTypes #-}\n  module GHCList where\n\n  import Prelude hiding (filter)\n  import GHC.Base (build)\n\n  {-# INLINABLE filter #-}\n  filter :: (a -> Bool) -> [a] -> [a]\n  filter p [] = []\n  filter p (x:xs) = if p x then x : filter p xs else filter p xs\n\n  {-# NOINLINE [0] filterFB #-}\n  filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b\n  filterFB c p x r | p x       = x `c` r\n                   | otherwise = r\n\n  {-# RULES\n  \"filter\"     [~1] forall p xs.  filter p xs = build (\\c n -> foldr\n  (filterFB c p) n xs)\n  \"filterList\" [1]  forall p.     foldr (filterFB (:) p) [] = filter p\n   #-}\n\nThen (because RULES are applied inside INLINABLE unfoldings, but inlinings\nare not), the unfolding given to \"filter\" in the interface file will be:\n  filter p []     = []\n  filter p (x:xs) = if p x then x : build (\\c n -> foldr (filterFB c p) n xs)\n                           else     build (\\c n -> foldr (filterFB c p) n xs\n\nNote that because this unfolding does not mention \"filter\", filter is not\nmarked as a strong loop breaker. Therefore at a use site in another module:\n  filter p xs\n    = {inline}\n      case xs of []     -> []\n                 (x:xs) -> if p x then x : build (\\c n -> foldr (filterFB c p) n xs)\n                                  else     build (\\c n -> foldr (filterFB c p) n xs)\n\n  build (\\c n -> foldr (filterFB c p) n xs)\n    = {inline} foldr (filterFB (:) p) [] xs\n    = {RULE}   filter p xs\n\nAnd we are in an infinite loop again, except that this time the loop is producing an\ninfinitely large *term* (an unrolling of filter) and so the simplifier finally\ndies with \"ticks exhausted\"\n\nBecause of this problem, we make a small change in the occurrence analyser\ndesigned to mark functions like \"filter\" as strong loop breakers on the basis that:\n  1. The RHS of filter mentions the local function \"filterFB\"\n  2. We have a rule which mentions \"filterFB\" on the LHS and \"filter\" on the RHS\n\nSo for each RULE for an *imported* function we are going to add\ndependency edges between the *local* FVS of the rule LHS and the\n*local* FVS of the rule RHS. We don't do anything special for RULES on\nlocal functions because the standard occurrence analysis stuff is\npretty good at getting loop-breakerness correct there.\n\nIt is important to note that even with this extra hack we aren't always going to get\nthings right. For example, it might be that the rule LHS mentions an imported Id,\nand another module has a RULE that can rewrite that imported Id to one of our local\nIds.\n\nNote [Specialising imported functions] (referred to from Specialise)\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBUT for *automatically-generated* rules, the programmer can't be\nresponsible for the \"programmer error\" in Note [Rules for imported\nfunctions].  In paricular, consider specialising a recursive function\ndefined in another module.  If we specialise a recursive function B.g,\nwe get\n         g_spec = .....(B.g Int).....\n         RULE B.g Int = g_spec\nHere, g_spec doesn't look recursive, but when the rule fires, it\nbecomes so.  And if B.g was mutually recursive, the loop might\nnot be as obvious as it is here.\n\nTo avoid this,\n * When specialising a function that is a loop breaker,\n   give a NOINLINE pragma to the specialised function\n\nNote [Glomming]\n~~~~~~~~~~~~~~~\nRULES for imported Ids can make something at the top refer to something at the bottom:\n        f = \\x -> B.g (q x)\n        h = \\y -> 3\n\n        RULE:  B.g (q x) = h x\n\nApplying this rule makes f refer to h, although f doesn't appear to\ndepend on h.  (And, as in Note [Rules for imported functions], the\ndependency might be more indirect. For example, f might mention C.t\nrather than B.g, where C.t eventually inlines to B.g.)\n\nNOTICE that this cannot happen for rules whose head is a\nlocally-defined function, because we accurately track dependencies\nthrough RULES.  It only happens for rules whose head is an imported\nfunction (B.g in the example above).\n\nSolution:\n  - When simplifying, bring all top level identifiers into\n    scope at the start, ignoring the Rec/NonRec structure, so\n    that when 'h' pops up in f's rhs, we find it in the in-scope set\n    (as the simplifier generally expects). This happens in simplTopBinds.\n\n  - In the occurrence analyser, if there are any out-of-scope\n    occurrences that pop out of the top, which will happen after\n    firing the rule:      f = \\x -> h x\n                          h = \\y -> 3\n    then just glom all the bindings into a single Rec, so that\n    the *next* iteration of the occurrence analyser will sort\n    them all out.   This part happens in occurAnalysePgm.\n\n------------------------------------------------------------\nNote [Inline rules]\n~~~~~~~~~~~~~~~~~~~\nNone of the above stuff about RULES applies to Inline Rules,\nstored in a CoreUnfolding.  The unfolding, if any, is simplified\nat the same time as the regular RHS of the function (ie *not* like\nNote [Rules are visible in their own rec group]), so it should be\ntreated *exactly* like an extra RHS.\n\nOr, rather, when computing loop-breaker edges,\n  * If f has an INLINE pragma, and it is active, we treat the\n    INLINE rhs as f's rhs\n  * If it's inactive, we treat f as having no rhs\n  * If it has no INLINE pragma, we look at f's actual rhs\n\n\nThere is a danger that we'll be sub-optimal if we see this\n     f = ...f...\n     [INLINE f = ..no f...]\nwhere f is recursive, but the INLINE is not. This can just about\nhappen with a sufficiently odd set of rules; eg\n\n        foo :: Int -> Int\n        {-# INLINE [1] foo #-}\n        foo x = x+1\n\n        bar :: Int -> Int\n        {-# INLINE [1] bar #-}\n        bar x = foo x + 1\n\n        {-# RULES \"foo\" [~1] forall x. foo x = bar x #-}\n\nHere the RULE makes bar recursive; but it's INLINE pragma remains\nnon-recursive. It's tempting to then say that 'bar' should not be\na loop breaker, but an attempt to do so goes wrong in two ways:\n   a) We may get\n         $df = ...$cfoo...\n         $cfoo = ...$df....\n         [INLINE $cfoo = ...no-$df...]\n      But we want $cfoo to depend on $df explicitly so that we\n      put the bindings in the right order to inline $df in $cfoo\n      and perhaps break the loop altogether.  (Maybe this\n   b)\n\n\nExample [eftInt]\n~~~~~~~~~~~~~~~\nExample (from GHC.Enum):\n\n  eftInt :: Int# -> Int# -> [Int]\n  eftInt x y = ...(non-recursive)...\n\n  {-# INLINE [0] eftIntFB #-}\n  eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r\n  eftIntFB c n x y = ...(non-recursive)...\n\n  {-# RULES\n  \"eftInt\"  [~1] forall x y. eftInt x y = build (\\ c n -> eftIntFB c n x y)\n  \"eftIntList\"  [1] eftIntFB  (:) [] = eftInt\n   #-}\n\nNote [Specialisation rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this group, which is typical of what SpecConstr builds:\n\n   fs a = ....f (C a)....\n   f  x = ....f (C a)....\n   {-# RULE f (C a) = fs a #-}\n\nSo 'f' and 'fs' are in the same Rec group (since f refers to fs via its RULE).\n\nBut watch out!  If 'fs' is not chosen as a loop breaker, we may get an infinite loop:\n  - the RULE is applied in f's RHS (see Note [Self-recursive rules] in Simplify\n  - fs is inlined (say it's small)\n  - now there's another opportunity to apply the RULE\n\nThis showed up when compiling Control.Concurrent.Chan.getChanContents.\n\n------------------------------------------------------------\nNote [Finding join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's the occurrence analyser's job to find bindings that we can turn into join\npoints, but it doesn't perform that transformation right away. Rather, it marks\nthe eligible bindings as part of their occurrence data, leaving it to the\nsimplifier (or to simpleOptPgm) to actually change the binder's 'IdDetails'.\nThe simplifier then eta-expands the RHS if needed and then updates the\noccurrence sites. Dividing the work this way means that the occurrence analyser\nstill only takes one pass, yet one can always tell the difference between a\nfunction call and a jump by looking at the occurrence (because the same pass\nchanges the 'IdDetails' and propagates the binders to their occurrence sites).\n\nTo track potential join points, we use the 'occ_tail' field of OccInfo. A value\nof `AlwaysTailCalled n` indicates that every occurrence of the variable is a\ntail call with `n` arguments (counting both value and type arguments). Otherwise\n'occ_tail' will be 'NoTailCallInfo'. The tail call info flows bottom-up with the\nrest of 'OccInfo' until it goes on the binder.\n\nNote [Rules and join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThings get fiddly with rules. Suppose we have:\n\n  let j :: Int -> Int\n      j y = 2 * y\n      k :: Int -> Int -> Int\n      {-# RULES \"SPEC k 0\" k 0 = j #-}\n      k x y = x + 2 * y\n  in ...\n\nNow suppose that both j and k appear only as saturated tail calls in the body.\nThus we would like to make them both join points. The rule complicates matters,\nthough, as its RHS has an unapplied occurrence of j. *However*, if we were to\neta-expand the rule, all would be well:\n\n  {-# RULES \"SPEC k 0\" forall a. k 0 a = j a #-}\n\nSo conceivably we could notice that a potential join point would have an\n\"undersaturated\" rule and account for it. This would mean we could make\nsomething that's been specialised a join point, for instance. But local bindings\nare rarely specialised, and being overly cautious about rules only\ncosts us anything when, for some `j`:\n\n  * Before specialisation, `j` has non-tail calls, so it can't be a join point.\n  * During specialisation, `j` gets specialised and thus acquires rules.\n  * Sometime afterward, the non-tail calls to `j` disappear (as dead code, say),\n    and so now `j` *could* become a join point.\n\nThis appears to be very rare in practice. TODO Perhaps we should gather\nstatistics to be sure.\n\n------------------------------------------------------------\nNote [Adjusting right-hand sides]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere's a bit of a dance we need to do after analysing a lambda expression or\na right-hand side. In particular, we need to\n\n  a) call 'markAllInsideLam' *unless* the binding is for a thunk, a one-shot\n     lambda, or a non-recursive join point; and\n  b) call 'markAllNonTailCalled' *unless* the binding is for a join point.\n\nSome examples, with how the free occurrences in e (assumed not to be a value\nlambda) get marked:\n\n                             inside lam    non-tail-called\n  ------------------------------------------------------------\n  let x = e                  No            Yes\n  let f = \\x -> e            Yes           Yes\n  let f = \\x{OneShot} -> e   No            Yes\n  \\x -> e                    Yes           Yes\n  join j x = e               No            No\n  joinrec j x = e            Yes           No\n\nThere are a few other caveats; most importantly, if we're marking a binding as\n'AlwaysTailCalled', it's *going* to be a join point, so we treat it as one so\nthat the effect cascades properly. Consequently, at the time the RHS is\nanalysed, we won't know what adjustments to make; thus 'occAnalLamOrRhs' must\nreturn the unadjusted 'UsageDetails', to be adjusted by 'adjustRhsUsage' once\njoin-point-hood has been decided.\n\nThus the overall sequence taking place in 'occAnalNonRecBind' and\n'occAnalRecBind' is as follows:\n\n  1. Call 'occAnalLamOrRhs' to find usage information for the RHS.\n  2. Call 'tagNonRecBinder' or 'tagRecBinders', which decides whether to make\n     the binding a join point.\n  3. Call 'adjustRhsUsage' accordingly. (Done as part of 'tagRecBinders' when\n     recursive.)\n\n(In the recursive case, this logic is spread between 'makeNode' and\n'occAnalRec'.)\n-}\n\n------------------------------------------------------------------\n--                 occAnalBind\n------------------------------------------------------------------\n\noccAnalBind :: OccEnv           -- The incoming OccEnv\n            -> TopLevelFlag\n            -> ImpRuleEdges\n            -> CoreBind\n            -> UsageDetails             -- Usage details of scope\n            -> (UsageDetails,           -- Of the whole let(rec)\n                [CoreBind])\n\noccAnalBind env lvl top_env (NonRec binder rhs) body_usage\n  = occAnalNonRecBind env lvl top_env binder rhs body_usage\noccAnalBind env lvl top_env (Rec pairs) body_usage\n  = occAnalRecBind env lvl top_env pairs body_usage\n\n-----------------\noccAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr\n                  -> UsageDetails -> (UsageDetails, [CoreBind])\noccAnalNonRecBind env lvl imp_rule_edges binder rhs body_usage\n  | isTyVar binder      -- A type let; we don't gather usage info\n  = (body_usage, [NonRec binder rhs])\n\n  | not (binder `usedIn` body_usage)    -- It's not mentioned\n  = (body_usage, [])\n\n  | otherwise                   -- It's mentioned in the body\n  = (body_usage' `andUDs` rhs_usage', [NonRec tagged_binder rhs'])\n  where\n    (body_usage', tagged_binder) = tagNonRecBinder lvl body_usage binder\n    mb_join_arity = willBeJoinId_maybe tagged_binder\n\n    (bndrs, body) = collectBinders rhs\n\n    (rhs_usage1, bndrs', body') = occAnalNonRecRhs env tagged_binder bndrs body\n    rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body'\n           -- For a /non-recursive/ join point we can mark all\n           -- its join-lambda as one-shot; and it's a good idea to do so\n\n    -- Unfoldings\n    -- See Note [Unfoldings and join points]\n    rhs_usage2 = case occAnalUnfolding env NonRecursive binder of\n                   Just unf_usage -> rhs_usage1 `andUDs` unf_usage\n                   Nothing        -> rhs_usage1\n\n    -- Rules\n    -- See Note [Rules are extra RHSs] and Note [Rule dependency info]\n    rules_w_uds = occAnalRules env mb_join_arity NonRecursive tagged_binder\n    rule_uds    = map (\\(_, l, r) -> l `andUDs` r) rules_w_uds\n    rhs_usage3 = foldr andUDs rhs_usage2 rule_uds\n    rhs_usage4 = case lookupVarEnv imp_rule_edges binder of\n                   Nothing -> rhs_usage3\n                   Just vs -> addManyOccsSet rhs_usage3 vs\n       -- See Note [Preventing loops due to imported functions rules]\n\n    -- Final adjustment\n    rhs_usage' = adjustRhsUsage mb_join_arity NonRecursive bndrs' rhs_usage4\n\n-----------------\noccAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)]\n               -> UsageDetails -> (UsageDetails, [CoreBind])\noccAnalRecBind env lvl imp_rule_edges pairs body_usage\n  = foldr (occAnalRec env lvl) (body_usage, []) sccs\n        -- For a recursive group, we\n        --      * occ-analyse all the RHSs\n        --      * compute strongly-connected components\n        --      * feed those components to occAnalRec\n        -- See Note [Recursive bindings: the grand plan]\n  where\n    sccs :: [SCC Details]\n    sccs = {-# SCC \"occAnalBind.scc\" #-}\n           stronglyConnCompFromEdgedVerticesUniq nodes\n\n    nodes :: [LetrecNode]\n    nodes = {-# SCC \"occAnalBind.assoc\" #-}\n            map (makeNode env imp_rule_edges bndr_set) pairs\n\n    bndr_set = mkVarSet (map fst pairs)\n\n{-\nNote [Unfoldings and join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe assume that anything in an unfolding occurs multiple times, since unfoldings\nare often copied (that's the whole point!). But we still need to track tail\ncalls for the purpose of finding join points.\n-}\n\n-----------------------------\noccAnalRec :: OccEnv -> TopLevelFlag\n           -> SCC Details\n           -> (UsageDetails, [CoreBind])\n           -> (UsageDetails, [CoreBind])\n\n        -- The NonRec case is just like a Let (NonRec ...) above\noccAnalRec _ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs\n                                 , nd_uds = rhs_uds, nd_rhs_bndrs = rhs_bndrs }))\n           (body_uds, binds)\n  | not (bndr `usedIn` body_uds)\n  = (body_uds, binds)           -- See Note [Dead code]\n\n  | otherwise                   -- It's mentioned in the body\n  = (body_uds' `andUDs` rhs_uds',\n     NonRec tagged_bndr rhs : binds)\n  where\n    (body_uds', tagged_bndr) = tagNonRecBinder lvl body_uds bndr\n    rhs_uds' = adjustRhsUsage (willBeJoinId_maybe tagged_bndr) NonRecursive\n                              rhs_bndrs rhs_uds\n\n        -- The Rec case is the interesting one\n        -- See Note [Recursive bindings: the grand plan]\n        -- See Note [Loop breaking]\noccAnalRec env lvl (CyclicSCC details_s) (body_uds, binds)\n  | not (any (`usedIn` body_uds) bndrs) -- NB: look at body_uds, not total_uds\n  = (body_uds, binds)                   -- See Note [Dead code]\n\n  | otherwise   -- At this point we always build a single Rec\n  = -- pprTrace \"occAnalRec\" (vcat\n    --  [ text \"weak_fvs\" <+> ppr weak_fvs\n    --  , text \"lb nodes\" <+> ppr loop_breaker_nodes])\n    (final_uds, Rec pairs : binds)\n\n  where\n    bndrs    = map nd_bndr details_s\n    bndr_set = mkVarSet bndrs\n\n    ------------------------------\n        -- See Note [Choosing loop breakers] for loop_breaker_nodes\n    final_uds :: UsageDetails\n    loop_breaker_nodes :: [LetrecNode]\n    (final_uds, loop_breaker_nodes)\n      = mkLoopBreakerNodes env lvl bndr_set body_uds details_s\n\n    ------------------------------\n    weak_fvs :: VarSet\n    weak_fvs = mapUnionVarSet nd_weak details_s\n\n    ---------------------------\n    -- Now reconstruct the cycle\n    pairs :: [(Id,CoreExpr)]\n    pairs | isEmptyVarSet weak_fvs = reOrderNodes   0 bndr_set weak_fvs loop_breaker_nodes []\n          | otherwise              = loopBreakNodes 0 bndr_set weak_fvs loop_breaker_nodes []\n          -- If weak_fvs is empty, the loop_breaker_nodes will include\n          -- all the edges in the original scope edges [remember,\n          -- weak_fvs is the difference between scope edges and\n          -- lb-edges], so a fresh SCC computation would yield a\n          -- single CyclicSCC result; and reOrderNodes deals with\n          -- exactly that case\n\n\n------------------------------------------------------------------\n--                 Loop breaking\n------------------------------------------------------------------\n\ntype Binding = (Id,CoreExpr)\n\nloopBreakNodes :: Int\n               -> VarSet        -- All binders\n               -> VarSet        -- Binders whose dependencies may be \"missing\"\n                                -- See Note [Weak loop breakers]\n               -> [LetrecNode]\n               -> [Binding]             -- Append these to the end\n               -> [Binding]\n{-\nloopBreakNodes is applied to the list of nodes for a cyclic strongly\nconnected component (there's guaranteed to be a cycle).  It returns\nthe same nodes, but\n        a) in a better order,\n        b) with some of the Ids having a IAmALoopBreaker pragma\n\nThe \"loop-breaker\" Ids are sufficient to break all cycles in the SCC.  This means\nthat the simplifier can guarantee not to loop provided it never records an inlining\nfor these no-inline guys.\n\nFurthermore, the order of the binds is such that if we neglect dependencies\non the no-inline Ids then the binds are topologically sorted.  This means\nthat the simplifier will generally do a good job if it works from top bottom,\nrecording inlinings for any Ids which aren't marked as \"no-inline\" as it goes.\n-}\n\n-- Return the bindings sorted into a plausible order, and marked with loop breakers.\nloopBreakNodes depth bndr_set weak_fvs nodes binds\n  = -- pprTrace \"loopBreakNodes\" (ppr nodes) $\n    go (stronglyConnCompFromEdgedVerticesUniqR nodes) binds\n  where\n    go []         binds = binds\n    go (scc:sccs) binds = loop_break_scc scc (go sccs binds)\n\n    loop_break_scc scc binds\n      = case scc of\n          AcyclicSCC node  -> mk_non_loop_breaker weak_fvs node : binds\n          CyclicSCC nodes  -> reOrderNodes depth bndr_set weak_fvs nodes binds\n\n----------------------------------\nreOrderNodes :: Int -> VarSet -> VarSet -> [LetrecNode] -> [Binding] -> [Binding]\n    -- Choose a loop breaker, mark it no-inline,\n    -- and call loopBreakNodes on the rest\nreOrderNodes _ _ _ []     _     = panic \"reOrderNodes\"\nreOrderNodes _ _ _ [node] binds = mk_loop_breaker node : binds\nreOrderNodes depth bndr_set weak_fvs (node : nodes) binds\n  = -- pprTrace \"reOrderNodes\" (vcat [ text \"unchosen\" <+> ppr unchosen\n    --                              , text \"chosen\" <+> ppr chosen_nodes ]) $\n    loopBreakNodes new_depth bndr_set weak_fvs unchosen $\n    (map mk_loop_breaker chosen_nodes ++ binds)\n  where\n    (chosen_nodes, unchosen) = chooseLoopBreaker approximate_lb\n                                                 (nd_score (node_payload node))\n                                                 [node] [] nodes\n\n    approximate_lb = depth >= 2\n    new_depth | approximate_lb = 0\n              | otherwise      = depth+1\n        -- After two iterations (d=0, d=1) give up\n        -- and approximate, returning to d=0\n\nmk_loop_breaker :: LetrecNode -> Binding\nmk_loop_breaker (node_payload -> ND { nd_bndr = bndr, nd_rhs = rhs})\n  = (bndr `setIdOccInfo` strongLoopBreaker { occ_tail = tail_info }, rhs)\n  where\n    tail_info = tailCallInfo (idOccInfo bndr)\n\nmk_non_loop_breaker :: VarSet -> LetrecNode -> Binding\n-- See Note [Weak loop breakers]\nmk_non_loop_breaker weak_fvs (node_payload -> ND { nd_bndr = bndr\n                                                 , nd_rhs = rhs})\n  | bndr `elemVarSet` weak_fvs = (setIdOccInfo bndr occ', rhs)\n  | otherwise                  = (bndr, rhs)\n  where\n    occ' = weakLoopBreaker { occ_tail = tail_info }\n    tail_info = tailCallInfo (idOccInfo bndr)\n\n----------------------------------\nchooseLoopBreaker :: Bool             -- True <=> Too many iterations,\n                                      --          so approximate\n                  -> NodeScore            -- Best score so far\n                  -> [LetrecNode]       -- Nodes with this score\n                  -> [LetrecNode]       -- Nodes with higher scores\n                  -> [LetrecNode]       -- Unprocessed nodes\n                  -> ([LetrecNode], [LetrecNode])\n    -- This loop looks for the bind with the lowest score\n    -- to pick as the loop  breaker.  The rest accumulate in\nchooseLoopBreaker _ _ loop_nodes acc []\n  = (loop_nodes, acc)        -- Done\n\n    -- If approximate_loop_breaker is True, we pick *all*\n    -- nodes with lowest score, else just one\n    -- See Note [Complexity of loop breaking]\nchooseLoopBreaker approx_lb loop_sc loop_nodes acc (node : nodes)\n  | approx_lb\n  , rank sc == rank loop_sc\n  = chooseLoopBreaker approx_lb loop_sc (node : loop_nodes) acc nodes\n\n  | sc `betterLB` loop_sc  -- Better score so pick this new one\n  = chooseLoopBreaker approx_lb sc [node] (loop_nodes ++ acc) nodes\n\n  | otherwise              -- Worse score so don't pick it\n  = chooseLoopBreaker approx_lb loop_sc loop_nodes (node : acc) nodes\n  where\n    sc = nd_score (node_payload node)\n\n{-\nNote [Complexity of loop breaking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe loop-breaking algorithm knocks out one binder at a time, and\nperforms a new SCC analysis on the remaining binders.  That can\nbehave very badly in tightly-coupled groups of bindings; in the\nworst case it can be (N**2)*log N, because it does a full SCC\non N, then N-1, then N-2 and so on.\n\nTo avoid this, we switch plans after 2 (or whatever) attempts:\n  Plan A: pick one binder with the lowest score, make it\n          a loop breaker, and try again\n  Plan B: pick *all* binders with the lowest score, make them\n          all loop breakers, and try again\nSince there are only a small finite number of scores, this will\nterminate in a constant number of iterations, rather than O(N)\niterations.\n\nYou might thing that it's very unlikely, but RULES make it much\nmore likely.  Here's a real example from Trac #1969:\n  Rec { $dm = \\d.\\x. op d\n        {-# RULES forall d. $dm Int d  = $s$dm1\n                  forall d. $dm Bool d = $s$dm2 #-}\n\n        dInt = MkD .... opInt ...\n        dInt = MkD .... opBool ...\n        opInt  = $dm dInt\n        opBool = $dm dBool\n\n        $s$dm1 = \\x. op dInt\n        $s$dm2 = \\x. op dBool }\nThe RULES stuff means that we can't choose $dm as a loop breaker\n(Note [Choosing loop breakers]), so we must choose at least (say)\nopInt *and* opBool, and so on.  The number of loop breakders is\nlinear in the number of instance declarations.\n\nNote [Loop breakers and INLINE/INLINABLE pragmas]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAvoid choosing a function with an INLINE pramga as the loop breaker!\nIf such a function is mutually-recursive with a non-INLINE thing,\nthen the latter should be the loop-breaker.\n\nIt's vital to distinguish between INLINE and INLINABLE (the\nBool returned by hasStableCoreUnfolding_maybe).  If we start with\n   Rec { {-# INLINABLE f #-}\n         f x = ...f... }\nand then worker/wrapper it through strictness analysis, we'll get\n   Rec { {-# INLINABLE $wf #-}\n         $wf p q = let x = (p,q) in ...f...\n\n         {-# INLINE f #-}\n         f x = case x of (p,q) -> $wf p q }\n\nNow it is vital that we choose $wf as the loop breaker, so we can\ninline 'f' in '$wf'.\n\nNote [DFuns should not be loop breakers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's particularly bad to make a DFun into a loop breaker.  See\nNote [How instance declarations are translated] in TcInstDcls\n\nWe give DFuns a higher score than ordinary CONLIKE things because\nif there's a choice we want the DFun to be the non-loop breaker. Eg\n\nrec { sc = /\\ a \\$dC. $fBWrap (T a) ($fCT @ a $dC)\n\n      $fCT :: forall a_afE. (Roman.C a_afE) => Roman.C (Roman.T a_afE)\n      {-# DFUN #-}\n      $fCT = /\\a \\$dC. MkD (T a) ((sc @ a $dC) |> blah) ($ctoF @ a $dC)\n    }\n\nHere 'sc' (the superclass) looks CONLIKE, but we'll never get to it\nif we can't unravel the DFun first.\n\nNote [Constructor applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's really really important to inline dictionaries.  Real\nexample (the Enum Ordering instance from GHC.Base):\n\n     rec     f = \\ x -> case d of (p,q,r) -> p x\n             g = \\ x -> case d of (p,q,r) -> q x\n             d = (v, f, g)\n\nHere, f and g occur just once; but we can't inline them into d.\nOn the other hand we *could* simplify those case expressions if\nwe didn't stupidly choose d as the loop breaker.\nBut we won't because constructor args are marked \"Many\".\nInlining dictionaries is really essential to unravelling\nthe loops in static numeric dictionaries, see GHC.Float.\n\nNote [Closure conversion]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWe treat (\\x. C p q) as a high-score candidate in the letrec scoring algorithm.\nThe immediate motivation came from the result of a closure-conversion transformation\nwhich generated code like this:\n\n    data Clo a b = forall c. Clo (c -> a -> b) c\n\n    ($:) :: Clo a b -> a -> b\n    Clo f env $: x = f env x\n\n    rec { plus = Clo plus1 ()\n\n        ; plus1 _ n = Clo plus2 n\n\n        ; plus2 Zero     n = n\n        ; plus2 (Succ m) n = Succ (plus $: m $: n) }\n\nIf we inline 'plus' and 'plus1', everything unravels nicely.  But if\nwe choose 'plus1' as the loop breaker (which is entirely possible\notherwise), the loop does not unravel nicely.\n\n\n@occAnalUnfolding@ deals with the question of bindings where the Id is marked\nby an INLINE pragma.  For these we record that anything which occurs\nin its RHS occurs many times.  This pessimistically assumes that this\ninlined binder also occurs many times in its scope, but if it doesn't\nwe'll catch it next time round.  At worst this costs an extra simplifier pass.\nToDo: try using the occurrence info for the inline'd binder.\n\n[March 97] We do the same for atomic RHSs.  Reason: see notes with loopBreakSCC.\n[June 98, SLPJ]  I've undone this change; I don't understand it.  See notes with loopBreakSCC.\n\n\n************************************************************************\n*                                                                      *\n                   Making nodes\n*                                                                      *\n************************************************************************\n-}\n\ntype ImpRuleEdges = IdEnv IdSet     -- Mapping from FVs of imported RULE LHSs to RHS FVs\n\nnoImpRuleEdges :: ImpRuleEdges\nnoImpRuleEdges = emptyVarEnv\n\ntype LetrecNode = Node Unique Details  -- Node comes from Digraph\n                                       -- The Unique key is gotten from the Id\ndata Details\n  = ND { nd_bndr :: Id          -- Binder\n       , nd_rhs  :: CoreExpr    -- RHS, already occ-analysed\n       , nd_rhs_bndrs :: [CoreBndr] -- Outer lambdas of RHS\n                                    -- INVARIANT: (nd_rhs_bndrs nd, _) ==\n                                    --              collectBinders (nd_rhs nd)\n\n       , nd_uds  :: UsageDetails  -- Usage from RHS, and RULES, and stable unfoldings\n                                  -- ignoring phase (ie assuming all are active)\n                                  -- See Note [Forming Rec groups]\n\n       , nd_inl  :: IdSet       -- Free variables of\n                                --   the stable unfolding (if present and active)\n                                --   or the RHS (if not)\n                                -- but excluding any RULES\n                                -- This is the IdSet that may be used if the Id is inlined\n\n       , nd_weak :: IdSet       -- Binders of this Rec that are mentioned in nd_uds\n                                -- but are *not* in nd_inl.  These are the ones whose\n                                -- dependencies might not be respected by loop_breaker_nodes\n                                -- See Note [Weak loop breakers]\n\n       , nd_active_rule_fvs :: IdSet   -- Free variables of the RHS of active RULES\n\n       , nd_score :: NodeScore\n  }\n\ninstance Outputable Details where\n   ppr nd = text \"ND\" <> braces\n             (sep [ text \"bndr =\" <+> ppr (nd_bndr nd)\n                  , text \"uds =\" <+> ppr (nd_uds nd)\n                  , text \"inl =\" <+> ppr (nd_inl nd)\n                  , text \"weak =\" <+> ppr (nd_weak nd)\n                  , text \"rule =\" <+> ppr (nd_active_rule_fvs nd)\n                  , text \"score =\" <+> ppr (nd_score nd)\n             ])\n\n-- The NodeScore is compared lexicographically;\n--      e.g. lower rank wins regardless of size\ntype NodeScore = ( Int     -- Rank: lower => more likely to be picked as loop breaker\n                 , Int     -- Size of rhs: higher => more likely to be picked as LB\n                           -- Maxes out at maxExprSize; we just use it to prioritise\n                           -- small functions\n                 , Bool )  -- Was it a loop breaker before?\n                           -- True => more likely to be picked\n                           -- Note [Loop breakers, node scoring, and stability]\n\nrank :: NodeScore -> Int\nrank (r, _, _) = r\n\nmakeNode :: OccEnv -> ImpRuleEdges -> VarSet\n         -> (Var, CoreExpr) -> LetrecNode\n-- See Note [Recursive bindings: the grand plan]\nmakeNode env imp_rule_edges bndr_set (bndr, rhs)\n  = DigraphNode details (varUnique bndr) (nonDetKeysUniqSet node_fvs)\n    -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR\n    -- is still deterministic with edges in nondeterministic order as\n    -- explained in Note [Deterministic SCC] in Digraph.\n  where\n    details = ND { nd_bndr            = bndr\n                 , nd_rhs             = rhs'\n                 , nd_rhs_bndrs       = bndrs'\n                 , nd_uds             = rhs_usage3\n                 , nd_inl             = inl_fvs\n                 , nd_weak            = node_fvs `minusVarSet` inl_fvs\n                 , nd_active_rule_fvs = active_rule_fvs\n                 , nd_score           = pprPanic \"makeNodeDetails\" (ppr bndr) }\n\n    -- Constructing the edges for the main Rec computation\n    -- See Note [Forming Rec groups]\n    (bndrs, body) = collectBinders rhs\n    (rhs_usage1, bndrs', body') = occAnalRecRhs env bndrs body\n    rhs' = mkLams bndrs' body'\n    rhs_usage2 = foldr andUDs rhs_usage1 rule_uds\n                   -- Note [Rules are extra RHSs]\n                   -- Note [Rule dependency info]\n    rhs_usage3 = case mb_unf_uds of\n                   Just unf_uds -> rhs_usage2 `andUDs` unf_uds\n                   Nothing      -> rhs_usage2\n    node_fvs = udFreeVars bndr_set rhs_usage3\n\n    -- Finding the free variables of the rules\n    is_active = occ_rule_act env :: Activation -> Bool\n\n    rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)]\n    rules_w_uds = occAnalRules env (Just (length bndrs)) Recursive bndr\n\n    rules_w_rhs_fvs :: [(Activation, VarSet)]    -- Find the RHS fvs\n    rules_w_rhs_fvs = maybe id (\\ids -> ((AlwaysActive, ids):))\n                               (lookupVarEnv imp_rule_edges bndr)\n      -- See Note [Preventing loops due to imported functions rules]\n                      [ (ru_act rule, udFreeVars bndr_set rhs_uds)\n                      | (rule, _, rhs_uds) <- rules_w_uds ]\n    rule_uds = map (\\(_, l, r) -> l `andUDs` r) rules_w_uds\n    active_rule_fvs = unionVarSets [fvs | (a,fvs) <- rules_w_rhs_fvs\n                                        , is_active a]\n\n    -- Finding the usage details of the INLINE pragma (if any)\n    mb_unf_uds = occAnalUnfolding env Recursive bndr\n\n    -- Find the \"nd_inl\" free vars; for the loop-breaker phase\n    inl_fvs = case mb_unf_uds of\n                Nothing -> udFreeVars bndr_set rhs_usage1 -- No INLINE, use RHS\n                Just unf_uds -> udFreeVars bndr_set unf_uds\n                      -- We could check for an *active* INLINE (returning\n                      -- emptyVarSet for an inactive one), but is_active\n                      -- isn't the right thing (it tells about\n                      -- RULE activation), so we'd need more plumbing\n\nmkLoopBreakerNodes :: OccEnv -> TopLevelFlag\n                   -> VarSet\n                   -> UsageDetails   -- for BODY of let\n                   -> [Details]\n                   -> (UsageDetails, -- adjusted\n                       [LetrecNode])\n-- Does four things\n--   a) tag each binder with its occurrence info\n--   b) add a NodeScore to each node\n--   c) make a Node with the right dependency edges for\n--      the loop-breaker SCC analysis\n--   d) adjust each RHS's usage details according to\n--      the binder's (new) shotness and join-point-hood\nmkLoopBreakerNodes env lvl bndr_set body_uds details_s\n  = (final_uds, zipWith mk_lb_node details_s bndrs')\n  where\n    (final_uds, bndrs') = tagRecBinders lvl body_uds\n                            [ ((nd_bndr nd)\n                               ,(nd_uds nd)\n                               ,(nd_rhs_bndrs nd))\n                            | nd <- details_s ]\n    mk_lb_node nd@(ND { nd_bndr = bndr, nd_rhs = rhs, nd_inl = inl_fvs }) bndr'\n      = DigraphNode nd' (varUnique bndr) (nonDetKeysUniqSet lb_deps)\n              -- It's OK to use nonDetKeysUniqSet here as\n              -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges\n              -- in nondeterministic order as explained in\n              -- Note [Deterministic SCC] in Digraph.\n      where\n        nd'     = nd { nd_bndr = bndr', nd_score = score }\n        score   = nodeScore env bndr bndr' rhs lb_deps\n        lb_deps = extendFvs_ rule_fv_env inl_fvs\n\n    rule_fv_env :: IdEnv IdSet\n        -- Maps a variable f to the variables from this group\n        --      mentioned in RHS of active rules for f\n        -- Domain is *subset* of bound vars (others have no rule fvs)\n    rule_fv_env = transClosureFV (mkVarEnv init_rule_fvs)\n    init_rule_fvs   -- See Note [Finding rule RHS free vars]\n      = [ (b, trimmed_rule_fvs)\n        | ND { nd_bndr = b, nd_active_rule_fvs = rule_fvs } <- details_s\n        , let trimmed_rule_fvs = rule_fvs `intersectVarSet` bndr_set\n        , not (isEmptyVarSet trimmed_rule_fvs) ]\n\n\n------------------------------------------\nnodeScore :: OccEnv\n          -> Id        -- Binder has old occ-info (just for loop-breaker-ness)\n          -> Id        -- Binder with new occ-info\n          -> CoreExpr  -- RHS\n          -> VarSet    -- Loop-breaker dependencies\n          -> NodeScore\nnodeScore env old_bndr new_bndr bind_rhs lb_deps\n  | not (isId old_bndr)     -- A type or cercion variable is never a loop breaker\n  = (100, 0, False)\n\n  | old_bndr `elemVarSet` lb_deps  -- Self-recursive things are great loop breakers\n  = (0, 0, True)                   -- See Note [Self-recursion and loop breakers]\n\n  | not (occ_unf_act env old_bndr) -- A binder whose inlining is inactive (e.g. has\n  = (0, 0, True)                   -- a NOINLINE pragma) makes a great loop breaker\n\n  | exprIsTrivial rhs\n  = mk_score 10  -- Practically certain to be inlined\n    -- Used to have also: && not (isExportedId bndr)\n    -- But I found this sometimes cost an extra iteration when we have\n    --      rec { d = (a,b); a = ...df...; b = ...df...; df = d }\n    -- where df is the exported dictionary. Then df makes a really\n    -- bad choice for loop breaker\n\n  | DFunUnfolding { df_args = args } <- id_unfolding\n    -- Never choose a DFun as a loop breaker\n    -- Note [DFuns should not be loop breakers]\n  = (9, length args, is_lb)\n\n    -- Data structures are more important than INLINE pragmas\n    -- so that dictionary/method recursion unravels\n\n  | CoreUnfolding { uf_guidance = UnfWhen {} } <- id_unfolding\n  = mk_score 6\n\n  | is_con_app rhs   -- Data types help with cases:\n  = mk_score 5       -- Note [Constructor applications]\n\n  | isStableUnfolding id_unfolding\n  , can_unfold\n  = mk_score 3\n\n  | isOneOcc (idOccInfo new_bndr)\n  = mk_score 2  -- Likely to be inlined\n\n  | can_unfold  -- The Id has some kind of unfolding\n  = mk_score 1\n\n  | otherwise\n  = (0, 0, is_lb)\n\n  where\n    mk_score :: Int -> NodeScore\n    mk_score rank = (rank, rhs_size, is_lb)\n\n    is_lb    = isStrongLoopBreaker (idOccInfo old_bndr)\n    rhs      = case id_unfolding of\n                 CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs }\n                    | isStableSource src\n                    -> unf_rhs\n                 _  -> bind_rhs\n       -- 'bind_rhs' is irrelevant for inlining things with a stable unfolding\n    rhs_size = case id_unfolding of\n                 CoreUnfolding { uf_guidance = guidance }\n                    | UnfIfGoodArgs { ug_size = size } <- guidance\n                    -> size\n                 _  -> cheapExprSize rhs\n\n    can_unfold   = canUnfold id_unfolding\n    id_unfolding = realIdUnfolding old_bndr\n       -- realIdUnfolding: Ignore loop-breaker-ness here because\n       -- that is what we are setting!\n\n        -- Checking for a constructor application\n        -- Cheap and cheerful; the simplifier moves casts out of the way\n        -- The lambda case is important to spot x = /\\a. C (f a)\n        -- which comes up when C is a dictionary constructor and\n        -- f is a default method.\n        -- Example: the instance for Show (ST s a) in GHC.ST\n        --\n        -- However we *also* treat (\\x. C p q) as a con-app-like thing,\n        --      Note [Closure conversion]\n    is_con_app (Var v)    = isConLikeId v\n    is_con_app (App f _)  = is_con_app f\n    is_con_app (Lam _ e)  = is_con_app e\n    is_con_app (Tick _ e) = is_con_app e\n    is_con_app _          = False\n\nmaxExprSize :: Int\nmaxExprSize = 20  -- Rather arbitrary\n\ncheapExprSize :: CoreExpr -> Int\n-- Maxes out at maxExprSize\ncheapExprSize e\n  = go 0 e\n  where\n    go n e | n >= maxExprSize = n\n           | otherwise        = go1 n e\n\n    go1 n (Var {})        = n+1\n    go1 n (Lit {})        = n+1\n    go1 n (Type {})       = n\n    go1 n (Coercion {})   = n\n    go1 n (Tick _ e)      = go1 n e\n    go1 n (Cast e _)      = go1 n e\n    go1 n (App f a)       = go (go1 n f) a\n    go1 n (Lam b e)\n      | isTyVar b         = go1 n e\n      | otherwise         = go (n+1) e\n    go1 n (Let b e)       = gos (go1 n e) (rhssOfBind b)\n    go1 n (Case e _ _ as) = gos (go1 n e) (rhssOfAlts as)\n\n    gos n [] = n\n    gos n (e:es) | n >= maxExprSize = n\n                 | otherwise        = gos (go1 n e) es\n\nbetterLB :: NodeScore -> NodeScore -> Bool\n-- If  n1 `betterLB` n2  then choose n1 as the loop breaker\nbetterLB (rank1, size1, lb1) (rank2, size2, _)\n  | rank1 < rank2 = True\n  | rank1 > rank2 = False\n  | size1 < size2 = False   -- Make the bigger n2 into the loop breaker\n  | size1 > size2 = True\n  | lb1           = True    -- Tie-break: if n1 was a loop breaker before, choose it\n  | otherwise     = False   -- See Note [Loop breakers, node scoring, and stability]\n\n{- Note [Self-recursion and loop breakers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have\n   rec { f = ...f...g...\n       ; g = .....f...   }\nthen 'f' has to be a loop breaker anyway, so we may as well choose it\nright away, so that g can inline freely.\n\nThis is really just a cheap hack. Consider\n   rec { f = ...g...\n       ; g = ..f..h...\n      ;  h = ...f....}\nHere f or g are better loop breakers than h; but we might accidentally\nchoose h.  Finding the minimal set of loop breakers is hard.\n\nNote [Loop breakers, node scoring, and stability]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTo choose a loop breaker, we give a NodeScore to each node in the SCC,\nand pick the one with the best score (according to 'betterLB').\n\nWe need to be jolly careful (Trac #12425, #12234) about the stability\nof this choice. Suppose we have\n\n    let rec { f = ...g...g...\n            ; g = ...f...f... }\n    in\n    case x of\n      True  -> ...f..\n      False -> ..f...\n\nIn each iteration of the simplifier the occurrence analyser OccAnal\nchooses a loop breaker. Suppose in iteration 1 it choose g as the loop\nbreaker. That means it is free to inline f.\n\nSuppose that GHC decides to inline f in the branches of the case, but\n(for some reason; eg it is not saturated) in the rhs of g. So we get\n\n    let rec { f = ...g...g...\n            ; g = ...f...f... }\n    in\n    case x of\n      True  -> ...g...g.....\n      False -> ..g..g....\n\nNow suppose that, for some reason, in the next iteration the occurrence\nanalyser chooses f as the loop breaker, so it can freely inline g. And\nagain for some reason the simplifier inlines g at its calls in the case\nbranches, but not in the RHS of f. Then we get\n\n    let rec { f = ...g...g...\n            ; g = ...f...f... }\n    in\n    case x of\n      True  -> ...(...f...f...)...(...f..f..).....\n      False -> ..(...f...f...)...(..f..f...)....\n\nYou can see where this is going! Each iteration of the simplifier\ndoubles the number of calls to f or g. No wonder GHC is slow!\n\n(In the particular example in comment:3 of #12425, f and g are the two\nmutually recursive fmap instances for CondT and Result. They are both\nmarked INLINE which, oddly, is why they don't inline in each other's\nRHS, because the call there is not saturated.)\n\nThe root cause is that we flip-flop on our choice of loop breaker. I\nalways thought it didn't matter, and indeed for any single iteration\nto terminate, it doesn't matter. But when we iterate, it matters a\nlot!!\n\nSo The Plan is this:\n   If there is a tie, choose the node that\n   was a loop breaker last time round\n\nHence the is_lb field of NodeScore\n\n************************************************************************\n*                                                                      *\n                   Right hand sides\n*                                                                      *\n************************************************************************\n-}\n\noccAnalRhs :: OccEnv -> RecFlag -> Id -> [CoreBndr] -> CoreExpr\n           -> (UsageDetails, [CoreBndr], CoreExpr)\n              -- Returned usage details covers only the RHS,\n              -- and *not* the RULE or INLINE template for the Id\noccAnalRhs env Recursive _ bndrs body\n  = occAnalRecRhs env bndrs body\noccAnalRhs env NonRecursive id bndrs body\n  = occAnalNonRecRhs env id bndrs body\n\noccAnalRecRhs :: OccEnv -> [CoreBndr] -> CoreExpr    -- Rhs lambdas, body\n           -> (UsageDetails, [CoreBndr], CoreExpr)\n              -- Returned usage details covers only the RHS,\n              -- and *not* the RULE or INLINE template for the Id\noccAnalRecRhs env bndrs body = occAnalLamOrRhs (rhsCtxt env) bndrs body\n\noccAnalNonRecRhs :: OccEnv\n                 -> Id -> [CoreBndr] -> CoreExpr    -- Binder; rhs lams, body\n                     -- Binder is already tagged with occurrence info\n                 -> (UsageDetails, [CoreBndr], CoreExpr)\n              -- Returned usage details covers only the RHS,\n              -- and *not* the RULE or INLINE template for the Id\noccAnalNonRecRhs env bndr bndrs body\n  = occAnalLamOrRhs rhs_env bndrs body\n  where\n    env1 | is_join_point    = env  -- See Note [Join point RHSs]\n         | certainly_inline = env  -- See Note [Cascading inlines]\n         | otherwise        = rhsCtxt env\n\n    -- See Note [Sources of one-shot information]\n    rhs_env = env1 { occ_one_shots = argOneShots dmd }\n\n    certainly_inline -- See Note [Cascading inlines]\n      = case occ of\n          OneOcc { occ_in_lam = in_lam, occ_one_br = one_br }\n            -> not in_lam && one_br && active && not_stable\n          _ -> False\n\n    is_join_point = isAlwaysTailCalled occ\n    -- Like (isJoinId bndr) but happens one step earlier\n    --  c.f. willBeJoinId_maybe\n\n    occ        = idOccInfo bndr\n    dmd        = idDemandInfo bndr\n    active     = isAlwaysActive (idInlineActivation bndr)\n    not_stable = not (isStableUnfolding (idUnfolding bndr))\n\noccAnalUnfolding :: OccEnv\n                 -> RecFlag\n                 -> Id\n                 -> Maybe UsageDetails\n                      -- Just the analysis, not a new unfolding. The unfolding\n                      -- got analysed when it was created and we don't need to\n                      -- update it.\noccAnalUnfolding env rec_flag id\n  = case realIdUnfolding id of -- ignore previous loop-breaker flag\n      CoreUnfolding { uf_tmpl = rhs, uf_src = src }\n        | not (isStableSource src)\n        -> Nothing\n        | otherwise\n        -> Just $ markAllMany usage\n        where\n          (bndrs, body) = collectBinders rhs\n          (usage, _, _) = occAnalRhs env rec_flag id bndrs body\n\n      DFunUnfolding { df_bndrs = bndrs, df_args = args }\n        -> Just $ zapDetails (delDetailsList usage bndrs)\n        where\n          usage = andUDsList (map (fst . occAnal env) args)\n\n      _ -> Nothing\n\noccAnalRules :: OccEnv\n             -> Maybe JoinArity -- If the binder is (or MAY become) a join\n                                -- point, what its join arity is (or WOULD\n                                -- become). See Note [Rules and join points].\n             -> RecFlag\n             -> Id\n             -> [(CoreRule,      -- Each (non-built-in) rule\n                  UsageDetails,  -- Usage details for LHS\n                  UsageDetails)] -- Usage details for RHS\noccAnalRules env mb_expected_join_arity rec_flag id\n  = [ (rule, lhs_uds, rhs_uds) | rule@Rule {} <- idCoreRules id\n                               , let (lhs_uds, rhs_uds) = occ_anal_rule rule ]\n  where\n    occ_anal_rule (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })\n      = (lhs_uds, final_rhs_uds)\n      where\n        lhs_uds = addManyOccsSet emptyDetails $\n                    (exprsFreeVars args `delVarSetList` bndrs)\n        (rhs_bndrs, rhs_body) = collectBinders rhs\n        (rhs_uds, _, _) = occAnalRhs env rec_flag id rhs_bndrs rhs_body\n                            -- Note [Rules are extra RHSs]\n                            -- Note [Rule dependency info]\n        final_rhs_uds = adjust_tail_info args $ markAllMany $\n                          (rhs_uds `delDetailsList` bndrs)\n    occ_anal_rule _\n      = (emptyDetails, emptyDetails)\n\n    adjust_tail_info args uds -- see Note [Rules and join points]\n      = case mb_expected_join_arity of\n          Just ar | args `lengthIs` ar -> uds\n          _                            -> markAllNonTailCalled uds\n{- Note [Join point RHSs]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   x = e\n   join j = Just x\n\nWe want to inline x into j right away, so we don't want to give\nthe join point a RhsCtxt (Trac #14137).  It's not a huge deal, because\nthe FloatIn pass knows to float into join point RHSs; and the simplifier\ndoes not float things out of join point RHSs.  But it's a simple, cheap\nthing to do.  See Trac #14137.\n\nNote [Cascading inlines]\n~~~~~~~~~~~~~~~~~~~~~~~~\nBy default we use an rhsCtxt for the RHS of a binding.  This tells the\nocc anal n that it's looking at an RHS, which has an effect in\noccAnalApp.  In particular, for constructor applications, it makes\nthe arguments appear to have NoOccInfo, so that we don't inline into\nthem. Thus    x = f y\n              k = Just x\nwe do not want to inline x.\n\nBut there's a problem.  Consider\n     x1 = a0 : []\n     x2 = a1 : x1\n     x3 = a2 : x2\n     g  = f x3\nFirst time round, it looks as if x1 and x2 occur as an arg of a\nlet-bound constructor ==> give them a many-occurrence.\nBut then x3 is inlined (unconditionally as it happens) and\nnext time round, x2 will be, and the next time round x1 will be\nResult: multiple simplifier iterations.  Sigh.\n\nSo, when analysing the RHS of x3 we notice that x3 will itself\ndefinitely inline the next time round, and so we analyse x3's rhs in\nan ordinary context, not rhsCtxt.  Hence the \"certainly_inline\" stuff.\n\nAnnoyingly, we have to approximate SimplUtils.preInlineUnconditionally.\nIf (a) the RHS is expandable (see isExpandableApp in occAnalApp), and\n   (b) certainly_inline says \"yes\" when preInlineUnconditionally says \"no\"\nthen the simplifier iterates indefinitely:\n        x = f y\n        k = Just x   -- We decide that k is 'certainly_inline'\n        v = ...k...  -- but preInlineUnconditionally doesn't inline it\ninline ==>\n        k = Just (f y)\n        v = ...k...\nfloat ==>\n        x1 = f y\n        k = Just x1\n        v = ...k...\n\nThis is worse than the slow cascade, so we only want to say \"certainly_inline\"\nif it really is certain.  Look at the note with preInlineUnconditionally\nfor the various clauses.\n\n\n************************************************************************\n*                                                                      *\n                Expressions\n*                                                                      *\n************************************************************************\n-}\n\noccAnal :: OccEnv\n        -> CoreExpr\n        -> (UsageDetails,       -- Gives info only about the \"interesting\" Ids\n            CoreExpr)\n\noccAnal _   expr@(Type _) = (emptyDetails,         expr)\noccAnal _   expr@(Lit _)  = (emptyDetails,         expr)\noccAnal env expr@(Var _)  = occAnalApp env (expr, [], [])\n    -- At one stage, I gathered the idRuleVars for the variable here too,\n    -- which in a way is the right thing to do.\n    -- But that went wrong right after specialisation, when\n    -- the *occurrences* of the overloaded function didn't have any\n    -- rules in them, so the *specialised* versions looked as if they\n    -- weren't used at all.\n\noccAnal _ (Coercion co)\n  = (addManyOccsSet emptyDetails (coVarsOfCo co), Coercion co)\n        -- See Note [Gather occurrences of coercion variables]\n\n{-\nNote [Gather occurrences of coercion variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need to gather info about what coercion variables appear, so that\nwe can sort them into the right place when doing dependency analysis.\n-}\n\noccAnal env (Tick tickish body)\n  | SourceNote{} <- tickish\n  = (usage, Tick tickish body')\n                  -- SourceNotes are best-effort; so we just proceed as usual.\n                  -- If we drop a tick due to the issues described below it's\n                  -- not the end of the world.\n\n  | tickish `tickishScopesLike` SoftScope\n  = (markAllNonTailCalled usage, Tick tickish body')\n\n  | Breakpoint _ ids <- tickish\n  = (usage_lam `andUDs` foldr addManyOccs emptyDetails ids, Tick tickish body')\n    -- never substitute for any of the Ids in a Breakpoint\n\n  | otherwise\n  = (usage_lam, Tick tickish body')\n  where\n    !(usage,body') = occAnal env body\n    -- for a non-soft tick scope, we can inline lambdas only\n    usage_lam = markAllNonTailCalled (markAllInsideLam usage)\n                  -- TODO There may be ways to make ticks and join points play\n                  -- nicer together, but right now there are problems:\n                  --   let j x = ... in tick<t> (j 1)\n                  -- Making j a join point may cause the simplifier to drop t\n                  -- (if the tick is put into the continuation). So we don't\n                  -- count j 1 as a tail call.\n                  -- See #14242.\n\noccAnal env (Cast expr co)\n  = case occAnal env expr of { (usage, expr') ->\n    let usage1 = zapDetailsIf (isRhsEnv env) usage\n          -- usage1: if we see let x = y `cast` co\n          -- then mark y as 'Many' so that we don't\n          -- immediately inline y again.\n        usage2 = addManyOccsSet usage1 (coVarsOfCo co)\n          -- usage2: see Note [Gather occurrences of coercion variables]\n    in (markAllNonTailCalled usage2, Cast expr' co)\n    }\n\noccAnal env app@(App _ _)\n  = occAnalApp env (collectArgsTicks tickishFloatable app)\n\n-- Ignore type variables altogether\n--   (a) occurrences inside type lambdas only not marked as InsideLam\n--   (b) type variables not in environment\n\noccAnal env (Lam x body)\n  | isTyVar x\n  = case occAnal env body of { (body_usage, body') ->\n    (markAllNonTailCalled body_usage, Lam x body')\n    }\n\n-- For value lambdas we do a special hack.  Consider\n--      (\\x. \\y. ...x...)\n-- If we did nothing, x is used inside the \\y, so would be marked\n-- as dangerous to dup.  But in the common case where the abstraction\n-- is applied to two arguments this is over-pessimistic.\n-- So instead, we just mark each binder with its occurrence\n-- info in the *body* of the multiple lambda.\n-- Then, the simplifier is careful when partially applying lambdas.\n\noccAnal env expr@(Lam _ _)\n  = case occAnalLamOrRhs env binders body of { (usage, tagged_binders, body') ->\n    let\n        expr'       = mkLams tagged_binders body'\n        usage1      = markAllNonTailCalled usage\n        one_shot_gp = all isOneShotBndr tagged_binders\n        final_usage | one_shot_gp = usage1\n                    | otherwise   = markAllInsideLam usage1\n    in\n    (final_usage, expr') }\n  where\n    (binders, body) = collectBinders expr\n\noccAnal env (Case scrut bndr ty alts)\n  = case occ_anal_scrut scrut alts     of { (scrut_usage, scrut') ->\n    case mapAndUnzip occ_anal_alt alts of { (alts_usage_s, alts')   ->\n    let\n        alts_usage  = foldr orUDs emptyDetails alts_usage_s\n        (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr\n        total_usage = markAllNonTailCalled scrut_usage `andUDs` alts_usage1\n                        -- Alts can have tail calls, but the scrutinee can't\n    in\n    total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }}\n  where\n    alt_env = mkAltEnv env scrut bndr\n    occ_anal_alt = occAnalAlt alt_env\n\n    occ_anal_scrut (Var v) (alt1 : other_alts)\n        | not (null other_alts) || not (isDefaultAlt alt1)\n        = (mkOneOcc env v True 0, Var v)\n            -- The 'True' says that the variable occurs in an interesting\n            -- context; the case has at least one non-default alternative\n    occ_anal_scrut (Tick t e) alts\n        | t `tickishScopesLike` SoftScope\n          -- No reason to not look through all ticks here, but only\n          -- for soft-scoped ticks we can do so without having to\n          -- update returned occurance info (see occAnal)\n        = second (Tick t) $ occ_anal_scrut e alts\n\n    occ_anal_scrut scrut _alts\n        = occAnal (vanillaCtxt env) scrut    -- No need for rhsCtxt\n\noccAnal env (Let bind body)\n  = case occAnal env body                of { (body_usage, body') ->\n    case occAnalBind env NotTopLevel\n                     noImpRuleEdges bind\n                     body_usage          of { (final_usage, new_binds) ->\n       (final_usage, mkLets new_binds body') }}\n\noccAnalArgs :: OccEnv -> [CoreExpr] -> [OneShots] -> (UsageDetails, [CoreExpr])\noccAnalArgs _ [] _\n  = (emptyDetails, [])\n\noccAnalArgs env (arg:args) one_shots\n  | isTypeArg arg\n  = case occAnalArgs env args one_shots of { (uds, args') ->\n    (uds, arg:args') }\n\n  | otherwise\n  = case argCtxt env one_shots           of { (arg_env, one_shots') ->\n    case occAnal arg_env arg             of { (uds1, arg') ->\n    case occAnalArgs env args one_shots' of { (uds2, args') ->\n    (uds1 `andUDs` uds2, arg':args') }}}\n\n{-\nApplications are dealt with specially because we want\nthe \"build hack\" to work.\n\nNote [Arguments of let-bound constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n    f x = let y = expensive x in\n          let z = (True,y) in\n          (case z of {(p,q)->q}, case z of {(p,q)->q})\nWe feel free to duplicate the WHNF (True,y), but that means\nthat y may be duplicated thereby.\n\nIf we aren't careful we duplicate the (expensive x) call!\nConstructors are rather like lambdas in this way.\n-}\n\noccAnalApp :: OccEnv\n           -> (Expr CoreBndr, [Arg CoreBndr], [Tickish Id])\n           -> (UsageDetails, Expr CoreBndr)\noccAnalApp env (Var fun, args, ticks)\n  | null ticks = (uds, mkApps (Var fun) args')\n  | otherwise  = (uds, mkTicks ticks $ mkApps (Var fun) args')\n  where\n    uds = fun_uds `andUDs` final_args_uds\n\n    !(args_uds, args') = occAnalArgs env args one_shots\n    !final_args_uds\n       | isRhsEnv env && is_exp = markAllNonTailCalled $\n                                  markAllInsideLam args_uds\n       | otherwise              = markAllNonTailCalled args_uds\n       -- We mark the free vars of the argument of a constructor or PAP\n       -- as \"inside-lambda\", if it is the RHS of a let(rec).\n       -- This means that nothing gets inlined into a constructor or PAP\n       -- argument position, which is what we want.  Typically those\n       -- constructor arguments are just variables, or trivial expressions.\n       -- We use inside-lam because it's like eta-expanding the PAP.\n       --\n       -- This is the *whole point* of the isRhsEnv predicate\n       -- See Note [Arguments of let-bound constructors]\n\n    n_val_args = valArgCount args\n    n_args     = length args\n    fun_uds    = mkOneOcc env fun (n_val_args > 0) n_args\n    is_exp     = isExpandableApp fun n_val_args\n        -- See Note [CONLIKE pragma] in BasicTypes\n        -- The definition of is_exp should match that in Simplify.prepareRhs\n\n    one_shots  = argsOneShots (idStrictness fun) guaranteed_val_args\n    guaranteed_val_args = n_val_args + length (takeWhile isOneShotInfo\n                                                         (occ_one_shots env))\n        -- See Note [Sources of one-shot information], bullet point A']\n\noccAnalApp env (fun, args, ticks)\n  = (markAllNonTailCalled (fun_uds `andUDs` args_uds),\n     mkTicks ticks $ mkApps fun' args')\n  where\n    !(fun_uds, fun') = occAnal (addAppCtxt env args) fun\n        -- The addAppCtxt is a bit cunning.  One iteration of the simplifier\n        -- often leaves behind beta redexs like\n        --      (\\x y -> e) a1 a2\n        -- Here we would like to mark x,y as one-shot, and treat the whole\n        -- thing much like a let.  We do this by pushing some True items\n        -- onto the context stack.\n    !(args_uds, args') = occAnalArgs env args []\n\nzapDetailsIf :: Bool              -- If this is true\n             -> UsageDetails      -- Then do zapDetails on this\n             -> UsageDetails\nzapDetailsIf True  uds = zapDetails uds\nzapDetailsIf False uds = uds\n\n{-\nNote [Sources of one-shot information]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe occurrence analyser obtains one-shot-lambda information from two sources:\n\nA:  Saturated applications:  eg   f e1 .. en\n\n    In general, given a call (f e1 .. en) we can propagate one-shot info from\n    f's strictness signature into e1 .. en, but /only/ if n is enough to\n    saturate the strictness signature. A strictness signature like\n\n          f :: C1(C1(L))LS\n\n    means that *if f is applied to three arguments* then it will guarantee to\n    call its first argument at most once, and to call the result of that at\n    most once. But if f has fewer than three arguments, all bets are off; e.g.\n\n          map (f (\\x y. expensive) e2) xs\n\n    Here the \\x y abstraction may be called many times (once for each element of\n    xs) so we should not mark x and y as one-shot. But if it was\n\n          map (f (\\x y. expensive) 3 2) xs\n\n    then the first argument of f will be called at most once.\n\n    The one-shot info, derived from f's strictness signature, is\n    computed by 'argsOneShots', called in occAnalApp.\n\nA': Non-obviously saturated applications: eg    build (f (\\x y -> expensive))\n    where f is as above.\n\n    In this case, f is only manifestly applied to one argument, so it does not\n    look saturated. So by the previous point, we should not use its strictness\n    signature to learn about the one-shotness of \\x y. But in this case we can:\n    build is fully applied, so we may use its strictness signature; and from\n    that we learn that build calls its argument with two arguments *at most once*.\n\n    So there is really only one call to f, and it will have three arguments. In\n    that sense, f is saturated, and we may proceed as described above.\n\n    Hence the computation of 'guaranteed_val_args' in occAnalApp, using\n    '(occ_one_shots env)'.  See also Trac #13227, comment:9\n\nB:  Let-bindings:  eg   let f = \\c. let ... in \\n -> blah\n                        in (build f, build f)\n\n    Propagate one-shot info from the demanand-info on 'f' to the\n    lambdas in its RHS (which may not be syntactically at the top)\n\n    This information must have come from a previous run of the demanand\n    analyser.\n\nPreviously, the demand analyser would *also* set the one-shot information, but\nthat code was buggy (see #11770), so doing it only in on place, namely here, is\nsaner.\n\nNote [OneShots]\n~~~~~~~~~~~~~~~\nWhen analysing an expression, the occ_one_shots argument contains information\nabout how the function is being used. The length of the list indicates\nhow many arguments will eventually be passed to the analysed expression,\nand the OneShotInfo indicates whether this application is once or multiple times.\n\nExample:\n\n Context of f                occ_one_shots when analysing f\n\n f 1 2                       [OneShot, OneShot]\n map (f 1)                   [OneShot, NoOneShotInfo]\n build f                     [OneShot, OneShot]\n f 1 2 `seq` f 2 1           [NoOneShotInfo, OneShot]\n\nNote [Binders in case alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n    case x of y { (a,b) -> f y }\nWe treat 'a', 'b' as dead, because they don't physically occur in the\ncase alternative.  (Indeed, a variable is dead iff it doesn't occur in\nits scope in the output of OccAnal.)  It really helps to know when\nbinders are unused.  See esp the call to isDeadBinder in\nSimplify.mkDupableAlt\n\nIn this example, though, the Simplifier will bring 'a' and 'b' back to\nlife, beause it binds 'y' to (a,b) (imagine got inlined and\nscrutinised y).\n-}\n\noccAnalLamOrRhs :: OccEnv -> [CoreBndr] -> CoreExpr\n                -> (UsageDetails, [CoreBndr], CoreExpr)\noccAnalLamOrRhs env [] body\n  = case occAnal env body of (body_usage, body') -> (body_usage, [], body')\n      -- RHS of thunk or nullary join point\noccAnalLamOrRhs env (bndr:bndrs) body\n  | isTyVar bndr\n  = -- Important: Keep the environment so that we don't inline into an RHS like\n    --   \\(@ x) -> C @x (f @x)\n    -- (see the beginning of Note [Cascading inlines]).\n    case occAnalLamOrRhs env bndrs body of\n      (body_usage, bndrs', body') -> (body_usage, bndr:bndrs', body')\noccAnalLamOrRhs env binders body\n  = case occAnal env_body body of { (body_usage, body') ->\n    let\n        (final_usage, tagged_binders) = tagLamBinders body_usage binders'\n                      -- Use binders' to put one-shot info on the lambdas\n    in\n    (final_usage, tagged_binders, body') }\n  where\n    (env_body, binders') = oneShotGroup env binders\n\noccAnalAlt :: (OccEnv, Maybe (Id, CoreExpr))\n           -> CoreAlt\n           -> (UsageDetails, Alt IdWithOccInfo)\noccAnalAlt (env, scrut_bind) (con, bndrs, rhs)\n  = case occAnal env rhs of { (rhs_usage1, rhs1) ->\n    let\n      (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs\n                                -- See Note [Binders in case alternatives]\n      (alt_usg', rhs2) = wrapAltRHS env scrut_bind alt_usg tagged_bndrs rhs1\n    in\n    (alt_usg', (con, tagged_bndrs, rhs2)) }\n\nwrapAltRHS :: OccEnv\n           -> Maybe (Id, CoreExpr)      -- proxy mapping generated by mkAltEnv\n           -> UsageDetails              -- usage for entire alt (p -> rhs)\n           -> [Var]                     -- alt binders\n           -> CoreExpr                  -- alt RHS\n           -> (UsageDetails, CoreExpr)\nwrapAltRHS env (Just (scrut_var, let_rhs)) alt_usg bndrs alt_rhs\n  | occ_binder_swap env\n  , scrut_var `usedIn` alt_usg -- bndrs are not be present in alt_usg so this\n                               -- handles condition (a) in Note [Binder swap]\n  , not captured               -- See condition (b) in Note [Binder swap]\n  = ( alt_usg' `andUDs` let_rhs_usg\n    , Let (NonRec tagged_scrut_var let_rhs') alt_rhs )\n  where\n    captured = any (`usedIn` let_rhs_usg) bndrs  -- Check condition (b)\n\n    -- The rhs of the let may include coercion variables\n    -- if the scrutinee was a cast, so we must gather their\n    -- usage. See Note [Gather occurrences of coercion variables]\n    -- Moreover, the rhs of the let may mention the case-binder, and\n    -- we want to gather its occ-info as well\n    (let_rhs_usg, let_rhs') = occAnal env let_rhs\n\n    (alt_usg', tagged_scrut_var) = tagLamBinder alt_usg scrut_var\n\nwrapAltRHS _ _ alt_usg _ alt_rhs\n  = (alt_usg, alt_rhs)\n\n{-\n************************************************************************\n*                                                                      *\n                    OccEnv\n*                                                                      *\n************************************************************************\n-}\n\ndata OccEnv\n  = OccEnv { occ_encl       :: !OccEncl      -- Enclosing context information\n           , occ_one_shots  :: !OneShots     -- See Note [OneShots]\n           , occ_gbl_scrut  :: GlobalScruts\n\n           , occ_unf_act   :: Id -> Bool   -- Which Id unfoldings are active\n\n           , occ_rule_act   :: Activation -> Bool   -- Which rules are active\n             -- See Note [Finding rule RHS free vars]\n\n           , occ_binder_swap :: !Bool -- enable the binder_swap\n             -- See CorePrep Note [Dead code in CorePrep]\n    }\n\ntype GlobalScruts = IdSet   -- See Note [Binder swap on GlobalId scrutinees]\n\n-----------------------------\n-- OccEncl is used to control whether to inline into constructor arguments\n-- For example:\n--      x = (p,q)               -- Don't inline p or q\n--      y = /\\a -> (p a, q a)   -- Still don't inline p or q\n--      z = f (p,q)             -- Do inline p,q; it may make a rule fire\n-- So OccEncl tells enough about the context to know what to do when\n-- we encounter a constructor application or PAP.\n\ndata OccEncl\n  = OccRhs              -- RHS of let(rec), albeit perhaps inside a type lambda\n                        -- Don't inline into constructor args here\n  | OccVanilla          -- Argument of function, body of lambda, scruintee of case etc.\n                        -- Do inline into constructor args here\n\ninstance Outputable OccEncl where\n  ppr OccRhs     = text \"occRhs\"\n  ppr OccVanilla = text \"occVanilla\"\n\n-- See note [OneShots]\ntype OneShots = [OneShotInfo]\n\ninitOccEnv :: OccEnv\ninitOccEnv\n  = OccEnv { occ_encl      = OccVanilla\n           , occ_one_shots = []\n           , occ_gbl_scrut = emptyVarSet\n                 -- To be conservative, we say that all\n                 -- inlines and rules are active\n           , occ_unf_act   = \\_ -> True\n           , occ_rule_act  = \\_ -> True\n           , occ_binder_swap = True }\n\nvanillaCtxt :: OccEnv -> OccEnv\nvanillaCtxt env = env { occ_encl = OccVanilla, occ_one_shots = [] }\n\nrhsCtxt :: OccEnv -> OccEnv\nrhsCtxt env = env { occ_encl = OccRhs, occ_one_shots = [] }\n\nargCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots])\nargCtxt env []\n  = (env { occ_encl = OccVanilla, occ_one_shots = [] }, [])\nargCtxt env (one_shots:one_shots_s)\n  = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s)\n\nisRhsEnv :: OccEnv -> Bool\nisRhsEnv (OccEnv { occ_encl = OccRhs })     = True\nisRhsEnv (OccEnv { occ_encl = OccVanilla }) = False\n\noneShotGroup :: OccEnv -> [CoreBndr]\n             -> ( OccEnv\n                , [CoreBndr] )\n        -- The result binders have one-shot-ness set that they might not have had originally.\n        -- This happens in (build (\\c n -> e)).  Here the occurrence analyser\n        -- linearity context knows that c,n are one-shot, and it records that fact in\n        -- the binder. This is useful to guide subsequent float-in/float-out tranformations\n\noneShotGroup env@(OccEnv { occ_one_shots = ctxt }) bndrs\n  = go ctxt bndrs []\n  where\n    go ctxt [] rev_bndrs\n      = ( env { occ_one_shots = ctxt, occ_encl = OccVanilla }\n        , reverse rev_bndrs )\n\n    go [] bndrs rev_bndrs\n      = ( env { occ_one_shots = [], occ_encl = OccVanilla }\n        , reverse rev_bndrs ++ bndrs )\n\n    go ctxt@(one_shot : ctxt') (bndr : bndrs) rev_bndrs\n      | isId bndr = go ctxt' bndrs (bndr': rev_bndrs)\n      | otherwise = go ctxt  bndrs (bndr : rev_bndrs)\n      where\n        bndr' = updOneShotInfo bndr one_shot\n               -- Use updOneShotInfo, not setOneShotInfo, as pre-existing\n               -- one-shot info might be better than what we can infer, e.g.\n               -- due to explicit use of the magic 'oneShot' function.\n               -- See Note [The oneShot function]\n\n\nmarkJoinOneShots :: Maybe JoinArity -> [Var] -> [Var]\n-- Mark the lambdas of a non-recursive join point as one-shot.\n-- This is good to prevent gratuitous float-out etc\nmarkJoinOneShots mb_join_arity bndrs\n  = case mb_join_arity of\n      Nothing -> bndrs\n      Just n  -> go n bndrs\n where\n   go 0 bndrs  = bndrs\n   go _ []     = [] -- This can legitimately happen.\n                    -- e.g.    let j = case ... in j True\n                    -- This will become an arity-1 join point after the\n                    -- simplifier has eta-expanded it; but it may not have\n                    -- enough lambdas /yet/. (Lint checks that JoinIds do\n                    -- have enough lambdas.)\n   go n (b:bs) = b' : go (n-1) bs\n     where\n       b' | isId b    = setOneShotLambda b\n          | otherwise = b\n\naddAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv\naddAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args\n  = env { occ_one_shots = replicate (valArgCount args) OneShotLam ++ ctxt }\n\ntransClosureFV :: UniqFM VarSet -> UniqFM VarSet\n-- If (f,g), (g,h) are in the input, then (f,h) is in the output\n--                                   as well as (f,g), (g,h)\ntransClosureFV env\n  | no_change = env\n  | otherwise = transClosureFV (listToUFM new_fv_list)\n  where\n    (no_change, new_fv_list) = mapAccumL bump True (nonDetUFMToList env)\n      -- It's OK to use nonDetUFMToList here because we'll forget the\n      -- ordering by creating a new set with listToUFM\n    bump no_change (b,fvs)\n      | no_change_here = (no_change, (b,fvs))\n      | otherwise      = (False,     (b,new_fvs))\n      where\n        (new_fvs, no_change_here) = extendFvs env fvs\n\n-------------\nextendFvs_ :: UniqFM VarSet -> VarSet -> VarSet\nextendFvs_ env s = fst (extendFvs env s)   -- Discard the Bool flag\n\nextendFvs :: UniqFM VarSet -> VarSet -> (VarSet, Bool)\n-- (extendFVs env s) returns\n--     (s `union` env(s), env(s) `subset` s)\nextendFvs env s\n  | isNullUFM env\n  = (s, True)\n  | otherwise\n  = (s `unionVarSet` extras, extras `subVarSet` s)\n  where\n    extras :: VarSet    -- env(s)\n    extras = nonDetFoldUFM unionVarSet emptyVarSet $\n      -- It's OK to use nonDetFoldUFM here because unionVarSet commutes\n             intersectUFM_C (\\x _ -> x) env (getUniqSet s)\n\n{-\n************************************************************************\n*                                                                      *\n                    Binder swap\n*                                                                      *\n************************************************************************\n\nNote [Binder swap]\n~~~~~~~~~~~~~~~~~~\nThe \"binder swap\" tranformation swaps occurence of the\nscrutinee of a case for occurrences of the case-binder:\n\n (1)  case x of b { pi -> ri }\n         ==>\n      case x of b { pi -> let x=b in ri }\n\n (2)  case (x |> co) of b { pi -> ri }\n        ==>\n      case (x |> co) of b { pi -> let x = b |> sym co in ri }\n\nIn both cases, the trivial 'let' can be eliminated by the\nimmediately following simplifier pass.\n\nThere are two reasons for making this swap:\n\n(A) It reduces the number of occurrences of the scrutinee, x.\n    That in turn might reduce its occurrences to one, so we\n    can inline it and save an allocation.  E.g.\n      let x = factorial y in case x of b { I# v -> ...x... }\n    If we replace 'x' by 'b' in the alternative we get\n      let x = factorial y in case x of b { I# v -> ...b... }\n    and now we can inline 'x', thus\n      case (factorial y) of b { I# v -> ...b... }\n\n(B) The case-binder b has unfolding information; in the\n    example above we know that b = I# v. That in turn allows\n    nested cases to simplify.  Consider\n       case x of b { I# v ->\n       ...(case x of b2 { I# v2 -> rhs })...\n    If we replace 'x' by 'b' in the alternative we get\n       case x of b { I# v ->\n       ...(case b of b2 { I# v2 -> rhs })...\n    and now it is trivial to simplify the inner case:\n       case x of b { I# v ->\n       ...(let b2 = b in rhs)...\n\n    The same can happen even if the scrutinee is a variable\n    with a cast: see Note [Case of cast]\n\nIn both cases, in a particular alternative (pi -> ri), we only\nadd the binding if\n  (a) x occurs free in (pi -> ri)\n        (ie it occurs in ri, but is not bound in pi)\n  (b) the pi does not bind b (or the free vars of co)\nWe need (a) and (b) for the inserted binding to be correct.\n\nFor the alternatives where we inject the binding, we can transfer\nall x's OccInfo to b.  And that is the point.\n\nNotice that\n  * The deliberate shadowing of 'x'.\n  * That (a) rapidly becomes false, so no bindings are injected.\n\nThe reason for doing these transformations /here in the occurrence\nanalyser/ is because it allows us to adjust the OccInfo for 'x' and\n'b' as we go.\n\n  * Suppose the only occurrences of 'x' are the scrutinee and in the\n    ri; then this transformation makes it occur just once, and hence\n    get inlined right away.\n\n  * If instead we do this in the Simplifier, we don't know whether 'x'\n    is used in ri, so we are forced to pessimistically zap b's OccInfo\n    even though it is typically dead (ie neither it nor x appear in\n    the ri).  There's nothing actually wrong with zapping it, except\n    that it's kind of nice to know which variables are dead.  My nose\n    tells me to keep this information as robustly as possible.\n\nThe Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding\n{x=b}; it's Nothing if the binder-swap doesn't happen.\n\nThere is a danger though.  Consider\n      let v = x +# y\n      in case (f v) of w -> ...v...v...\nAnd suppose that (f v) expands to just v.  Then we'd like to\nuse 'w' instead of 'v' in the alternative.  But it may be too\nlate; we may have substituted the (cheap) x+#y for v in the\nsame simplifier pass that reduced (f v) to v.\n\nI think this is just too bad.  CSE will recover some of it.\n\nNote [Case of cast]\n~~~~~~~~~~~~~~~~~~~\nConsider        case (x `cast` co) of b { I# ->\n                ... (case (x `cast` co) of {...}) ...\nWe'd like to eliminate the inner case.  That is the motivation for\nequation (2) in Note [Binder swap].  When we get to the inner case, we\ninline x, cancel the casts, and away we go.\n\nNote [Binder swap on GlobalId scrutinees]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the scrutinee is a GlobalId we must take care in two ways\n\n i) In order to *know* whether 'x' occurs free in the RHS, we need its\n    occurrence info. BUT, we don't gather occurrence info for\n    GlobalIds.  That's the reason for the (small) occ_gbl_scrut env in\n    OccEnv is for: it says \"gather occurrence info for these\".\n\n ii) We must call localiseId on 'x' first, in case it's a GlobalId, or\n     has an External Name. See, for example, SimplEnv Note [Global Ids in\n     the substitution].\n\nNote [Zap case binders in proxy bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFrom the original\n     case x of cb(dead) { p -> ...x... }\nwe will get\n     case x of cb(live) { p -> let x = cb in ...x... }\n\nCore Lint never expects to find an *occurrence* of an Id marked\nas Dead, so we must zap the OccInfo on cb before making the\nbinding x = cb.  See Trac #5028.\n\nNB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier\ndoesn't use it. So this is only to satisfy the perhpas-over-picky Lint.\n\nHistorical note [no-case-of-case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe *used* to suppress the binder-swap in case expressions when\n-fno-case-of-case is on.  Old remarks:\n    \"This happens in the first simplifier pass,\n    and enhances full laziness.  Here's the bad case:\n            f = \\ y -> ...(case x of I# v -> ...(case x of ...) ... )\n    If we eliminate the inner case, we trap it inside the I# v -> arm,\n    which might prevent some full laziness happening.  I've seen this\n    in action in spectral/cichelli/Prog.hs:\n             [(m,n) | m <- [1..max], n <- [1..max]]\n    Hence the check for NoCaseOfCase.\"\nHowever, now the full-laziness pass itself reverses the binder-swap, so this\ncheck is no longer necessary.\n\nHistorical note [Suppressing the case binder-swap]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis old note describes a problem that is also fixed by doing the\nbinder-swap in OccAnal:\n\n    There is another situation when it might make sense to suppress the\n    case-expression binde-swap. If we have\n\n        case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }\n                       ...other cases .... }\n\n    We'll perform the binder-swap for the outer case, giving\n\n        case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 }\n                       ...other cases .... }\n\n    But there is no point in doing it for the inner case, because w1 can't\n    be inlined anyway.  Furthermore, doing the case-swapping involves\n    zapping w2's occurrence info (see paragraphs that follow), and that\n    forces us to bind w2 when doing case merging.  So we get\n\n        case x of w1 { A -> let w2 = w1 in e1\n                       B -> let w2 = w1 in e2\n                       ...other cases .... }\n\n    This is plain silly in the common case where w2 is dead.\n\n    Even so, I can't see a good way to implement this idea.  I tried\n    not doing the binder-swap if the scrutinee was already evaluated\n    but that failed big-time:\n\n            data T = MkT !Int\n\n            case v of w  { MkT x ->\n            case x of x1 { I# y1 ->\n            case x of x2 { I# y2 -> ...\n\n    Notice that because MkT is strict, x is marked \"evaluated\".  But to\n    eliminate the last case, we must either make sure that x (as well as\n    x1) has unfolding MkT y1.  The straightforward thing to do is to do\n    the binder-swap.  So this whole note is a no-op.\n\nIt's fixed by doing the binder-swap in OccAnal because we can do the\nbinder-swap unconditionally and still get occurrence analysis\ninformation right.\n-}\n\nmkAltEnv :: OccEnv -> CoreExpr -> Id -> (OccEnv, Maybe (Id, CoreExpr))\n-- Does three things: a) makes the occ_one_shots = OccVanilla\n--                    b) extends the GlobalScruts if possible\n--                    c) returns a proxy mapping, binding the scrutinee\n--                       to the case binder, if possible\nmkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr\n  = case stripTicksTopE (const True) scrut of\n      Var v           -> add_scrut v case_bndr'\n      Cast (Var v) co -> add_scrut v (Cast case_bndr' (mkSymCo co))\n                          -- See Note [Case of cast]\n      _               -> (env { occ_encl = OccVanilla }, Nothing)\n\n  where\n    add_scrut v rhs\n      | isGlobalId v = (env { occ_encl = OccVanilla }, Nothing)\n      | otherwise    = ( env { occ_encl = OccVanilla\n                             , occ_gbl_scrut = pe `extendVarSet` v }\n                       , Just (localise v, rhs) )\n      -- ToDO: this isGlobalId stuff is a TEMPORARY FIX\n      --       to avoid the binder-swap for GlobalIds\n      --       See Trac #16346\n\n    case_bndr' = Var (zapIdOccInfo case_bndr)\n                   -- See Note [Zap case binders in proxy bindings]\n\n    -- Localise the scrut_var before shadowing it; we're making a\n    -- new binding for it, and it might have an External Name, or\n    -- even be a GlobalId; Note [Binder swap on GlobalId scrutinees]\n    -- Also we don't want any INLINE or NOINLINE pragmas!\n    localise scrut_var = mkLocalIdOrCoVar (localiseName (idName scrut_var))\n                                          (idType scrut_var)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[OccurAnal-types]{OccEnv}\n*                                                                      *\n************************************************************************\n\nNote [UsageDetails and zapping]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nOn many occasions, we must modify all gathered occurrence data at once. For\ninstance, all occurrences underneath a (non-one-shot) lambda set the\n'occ_in_lam' flag to become 'True'. We could use 'mapVarEnv' to do this, but\nthat takes O(n) time and we will do this often---in particular, there are many\nplaces where tail calls are not allowed, and each of these causes all variables\nto get marked with 'NoTailCallInfo'.\n\nInstead of relying on `mapVarEnv`, then, we carry three 'IdEnv's around along\nwith the 'OccInfoEnv'. Each of these extra environments is a \"zapped set\"\nrecording which variables have been zapped in some way. Zapping all occurrence\ninfo then simply means setting the corresponding zapped set to the whole\n'OccInfoEnv', a fast O(1) operation.\n-}\n\ntype OccInfoEnv = IdEnv OccInfo -- A finite map from ids to their usage\n                -- INVARIANT: never IAmDead\n                -- (Deadness is signalled by not being in the map at all)\n\ntype ZappedSet = OccInfoEnv -- Values are ignored\n\ndata UsageDetails\n  = UD { ud_env       :: !OccInfoEnv\n       , ud_z_many    :: ZappedSet   -- apply 'markMany' to these\n       , ud_z_in_lam  :: ZappedSet   -- apply 'markInsideLam' to these\n       , ud_z_no_tail :: ZappedSet } -- apply 'markNonTailCalled' to these\n  -- INVARIANT: All three zapped sets are subsets of the OccInfoEnv\n\ninstance Outputable UsageDetails where\n  ppr ud = ppr (ud_env (flattenUsageDetails ud))\n\n-------------------\n-- UsageDetails API\n\nandUDs, orUDs\n        :: UsageDetails -> UsageDetails -> UsageDetails\nandUDs = combineUsageDetailsWith addOccInfo\norUDs  = combineUsageDetailsWith orOccInfo\n\nandUDsList :: [UsageDetails] -> UsageDetails\nandUDsList = foldl' andUDs emptyDetails\n\nmkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails\nmkOneOcc env id int_cxt arity\n  | isLocalId id\n  = singleton $ OneOcc { occ_in_lam  = False\n                       , occ_one_br  = True\n                       , occ_int_cxt = int_cxt\n                       , occ_tail    = AlwaysTailCalled arity }\n  | id `elemVarSet` occ_gbl_scrut env\n  = singleton noOccInfo\n\n  | otherwise\n  = emptyDetails\n  where\n    singleton info = emptyDetails { ud_env = unitVarEnv id info }\n\naddOneOcc :: UsageDetails -> Id -> OccInfo -> UsageDetails\naddOneOcc ud id info\n  = ud { ud_env = extendVarEnv_C plus_zapped (ud_env ud) id info }\n      `alterZappedSets` (`delVarEnv` id)\n  where\n    plus_zapped old new = doZapping ud id old `addOccInfo` new\n\naddManyOccsSet :: UsageDetails -> VarSet -> UsageDetails\naddManyOccsSet usage id_set = nonDetFoldUniqSet addManyOccs usage id_set\n  -- It's OK to use nonDetFoldUFM here because addManyOccs commutes\n\n-- Add several occurrences, assumed not to be tail calls\naddManyOccs :: Var -> UsageDetails -> UsageDetails\naddManyOccs v u | isId v    = addOneOcc u v noOccInfo\n                | otherwise = u\n        -- Give a non-committal binder info (i.e noOccInfo) because\n        --   a) Many copies of the specialised thing can appear\n        --   b) We don't want to substitute a BIG expression inside a RULE\n        --      even if that's the only occurrence of the thing\n        --      (Same goes for INLINE.)\n\ndelDetails :: UsageDetails -> Id -> UsageDetails\ndelDetails ud bndr\n  = ud `alterUsageDetails` (`delVarEnv` bndr)\n\ndelDetailsList :: UsageDetails -> [Id] -> UsageDetails\ndelDetailsList ud bndrs\n  = ud `alterUsageDetails` (`delVarEnvList` bndrs)\n\nemptyDetails :: UsageDetails\nemptyDetails = UD { ud_env       = emptyVarEnv\n                  , ud_z_many    = emptyVarEnv\n                  , ud_z_in_lam  = emptyVarEnv\n                  , ud_z_no_tail = emptyVarEnv }\n\nisEmptyDetails :: UsageDetails -> Bool\nisEmptyDetails = isEmptyVarEnv . ud_env\n\nmarkAllMany, markAllInsideLam, markAllNonTailCalled, zapDetails\n  :: UsageDetails -> UsageDetails\nmarkAllMany          ud = ud { ud_z_many    = ud_env ud }\nmarkAllInsideLam     ud = ud { ud_z_in_lam  = ud_env ud }\nmarkAllNonTailCalled ud = ud { ud_z_no_tail = ud_env ud }\n\nzapDetails = markAllMany . markAllNonTailCalled -- effectively sets to noOccInfo\n\nlookupDetails :: UsageDetails -> Id -> OccInfo\nlookupDetails ud id\n  | isCoVar id  -- We do not currenly gather occurrence info (from types)\n  = noOccInfo   -- for CoVars, so we must conservatively mark them as used\n                -- See Note [DoO not mark CoVars as dead]\n  | otherwise\n  = case lookupVarEnv (ud_env ud) id of\n      Just occ -> doZapping ud id occ\n      Nothing  -> IAmDead\n\nusedIn :: Id -> UsageDetails -> Bool\nv `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud\n\nudFreeVars :: VarSet -> UsageDetails -> VarSet\n-- Find the subset of bndrs that are mentioned in uds\nudFreeVars bndrs ud = restrictUniqSetToUFM bndrs (ud_env ud)\n\n{- Note [Do not mark CoVars as dead]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's obviously wrong to mark CoVars as dead if they are used.\nCurrently we don't traverse types to gather usase info for CoVars,\nso we had better treat them as having noOccInfo.\n\nThis showed up in Trac #15696 we had something like\n  case eq_sel d of co -> ...(typeError @(...co...) \"urk\")...\n\nThen 'd' was substitued by a dictionary, so the expression\nsimpified to\n  case (Coercion <blah>) of co -> ...(typeError @(...co...) \"urk\")...\n\nBut then the \"drop the case altogether\" equation of rebuildCase\nthought that 'co' was dead, and discarded the entire case. Urk!\n\nI have no idea how we managed to avoid this pitfall for so long!\n-}\n\n-------------------\n-- Auxiliary functions for UsageDetails implementation\n\ncombineUsageDetailsWith :: (OccInfo -> OccInfo -> OccInfo)\n                        -> UsageDetails -> UsageDetails -> UsageDetails\ncombineUsageDetailsWith plus_occ_info ud1 ud2\n  | isEmptyDetails ud1 = ud2\n  | isEmptyDetails ud2 = ud1\n  | otherwise\n  = UD { ud_env       = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2)\n       , ud_z_many    = plusVarEnv (ud_z_many    ud1) (ud_z_many    ud2)\n       , ud_z_in_lam  = plusVarEnv (ud_z_in_lam  ud1) (ud_z_in_lam  ud2)\n       , ud_z_no_tail = plusVarEnv (ud_z_no_tail ud1) (ud_z_no_tail ud2) }\n\ndoZapping :: UsageDetails -> Var -> OccInfo -> OccInfo\ndoZapping ud var occ\n  = doZappingByUnique ud (varUnique var) occ\n\ndoZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo\ndoZappingByUnique ud uniq\n  = (if | in_subset ud_z_many    -> markMany\n        | in_subset ud_z_in_lam  -> markInsideLam\n        | otherwise              -> id) .\n    (if | in_subset ud_z_no_tail -> markNonTailCalled\n        | otherwise              -> id)\n  where\n    in_subset field = uniq `elemVarEnvByKey` field ud\n\nalterZappedSets :: UsageDetails -> (ZappedSet -> ZappedSet) -> UsageDetails\nalterZappedSets ud f\n  = ud { ud_z_many    = f (ud_z_many    ud)\n       , ud_z_in_lam  = f (ud_z_in_lam  ud)\n       , ud_z_no_tail = f (ud_z_no_tail ud) }\n\nalterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails\nalterUsageDetails ud f\n  = ud { ud_env = f (ud_env ud) }\n      `alterZappedSets` f\n\nflattenUsageDetails :: UsageDetails -> UsageDetails\nflattenUsageDetails ud\n  = ud { ud_env = mapUFM_Directly (doZappingByUnique ud) (ud_env ud) }\n      `alterZappedSets` const emptyVarEnv\n\n-------------------\n-- See Note [Adjusting right-hand sides]\nadjustRhsUsage :: Maybe JoinArity -> RecFlag\n               -> [CoreBndr] -- Outer lambdas, AFTER occ anal\n               -> UsageDetails -> UsageDetails\nadjustRhsUsage mb_join_arity rec_flag bndrs usage\n  = maybe_mark_lam (maybe_drop_tails usage)\n  where\n    maybe_mark_lam ud   | one_shot   = ud\n                        | otherwise  = markAllInsideLam ud\n    maybe_drop_tails ud | exact_join = ud\n                        | otherwise  = markAllNonTailCalled ud\n\n    one_shot = case mb_join_arity of\n                 Just join_arity\n                   | isRec rec_flag -> False\n                   | otherwise      -> all isOneShotBndr (drop join_arity bndrs)\n                 Nothing            -> all isOneShotBndr bndrs\n\n    exact_join = case mb_join_arity of\n                   Just join_arity -> bndrs `lengthIs` join_arity\n                   _               -> False\n\ntype IdWithOccInfo = Id\n\ntagLamBinders :: UsageDetails          -- Of scope\n              -> [Id]                  -- Binders\n              -> (UsageDetails,        -- Details with binders removed\n                 [IdWithOccInfo])    -- Tagged binders\ntagLamBinders usage binders\n  = usage' `seq` (usage', bndrs')\n  where\n    (usage', bndrs') = mapAccumR tagLamBinder usage binders\n\ntagLamBinder :: UsageDetails       -- Of scope\n             -> Id                 -- Binder\n             -> (UsageDetails,     -- Details with binder removed\n                 IdWithOccInfo)    -- Tagged binders\n-- Used for lambda and case binders\n-- It copes with the fact that lambda bindings can have a\n-- stable unfolding, used for join points\ntagLamBinder usage bndr\n  = (usage2, bndr')\n  where\n        occ    = lookupDetails usage bndr\n        bndr'  = setBinderOcc (markNonTailCalled occ) bndr\n                   -- Don't try to make an argument into a join point\n        usage1 = usage `delDetails` bndr\n        usage2 | isId bndr = addManyOccsSet usage1 (idUnfoldingVars bndr)\n                               -- This is effectively the RHS of a\n                               -- non-join-point binding, so it's okay to use\n                               -- addManyOccsSet, which assumes no tail calls\n               | otherwise = usage1\n\ntagNonRecBinder :: TopLevelFlag           -- At top level?\n                -> UsageDetails           -- Of scope\n                -> CoreBndr               -- Binder\n                -> (UsageDetails,         -- Details with binder removed\n                    IdWithOccInfo)        -- Tagged binder\n\ntagNonRecBinder lvl usage binder\n = let\n     occ     = lookupDetails usage binder\n     will_be_join = decideJoinPointHood lvl usage [binder]\n     occ'    | will_be_join = -- must already be marked AlwaysTailCalled\n                              ASSERT(isAlwaysTailCalled occ) occ\n             | otherwise    = markNonTailCalled occ\n     binder' = setBinderOcc occ' binder\n     usage'  = usage `delDetails` binder\n   in\n   usage' `seq` (usage', binder')\n\ntagRecBinders :: TopLevelFlag           -- At top level?\n              -> UsageDetails           -- Of body of let ONLY\n              -> [(CoreBndr,            -- Binder\n                   UsageDetails,        -- RHS usage details\n                   [CoreBndr])]         -- Lambdas in new RHS\n              -> (UsageDetails,         -- Adjusted details for whole scope,\n                                        -- with binders removed\n                  [IdWithOccInfo])      -- Tagged binders\n-- Substantially more complicated than non-recursive case. Need to adjust RHS\n-- details *before* tagging binders (because the tags depend on the RHSes).\ntagRecBinders lvl body_uds triples\n = let\n     (bndrs, rhs_udss, _) = unzip3 triples\n\n     -- 1. Determine join-point-hood of whole group, as determined by\n     --    the *unadjusted* usage details\n     unadj_uds     = foldr andUDs body_uds rhs_udss\n     will_be_joins = decideJoinPointHood lvl unadj_uds bndrs\n\n     -- 2. Adjust usage details of each RHS, taking into account the\n     --    join-point-hood decision\n     rhs_udss' = map adjust triples\n     adjust (bndr, rhs_uds, rhs_bndrs)\n       = adjustRhsUsage mb_join_arity Recursive rhs_bndrs rhs_uds\n       where\n         -- Can't use willBeJoinId_maybe here because we haven't tagged the\n         -- binder yet (the tag depends on these adjustments!)\n         mb_join_arity\n           | will_be_joins\n           , let occ = lookupDetails unadj_uds bndr\n           , AlwaysTailCalled arity <- tailCallInfo occ\n           = Just arity\n           | otherwise\n           = ASSERT(not will_be_joins) -- Should be AlwaysTailCalled if\n             Nothing                   -- we are making join points!\n\n     -- 3. Compute final usage details from adjusted RHS details\n     adj_uds   = foldr andUDs body_uds rhs_udss'\n\n     -- 4. Tag each binder with its adjusted details\n     bndrs'    = [ setBinderOcc (lookupDetails adj_uds bndr) bndr\n                 | bndr <- bndrs ]\n\n     -- 5. Drop the binders from the adjusted details and return\n     usage'    = adj_uds `delDetailsList` bndrs\n   in\n   (usage', bndrs')\n\nsetBinderOcc :: OccInfo -> CoreBndr -> CoreBndr\nsetBinderOcc occ_info bndr\n  | isTyVar bndr      = bndr\n  | isExportedId bndr = if isManyOccs (idOccInfo bndr)\n                          then bndr\n                          else setIdOccInfo bndr noOccInfo\n            -- Don't use local usage info for visible-elsewhere things\n            -- BUT *do* erase any IAmALoopBreaker annotation, because we're\n            -- about to re-generate it and it shouldn't be \"sticky\"\n\n  | otherwise = setIdOccInfo bndr occ_info\n\n-- | Decide whether some bindings should be made into join points or not.\n-- Returns `False` if they can't be join points. Note that it's an\n-- all-or-nothing decision, as if multiple binders are given, they're\n-- assumed to be mutually recursive.\n--\n-- It must, however, be a final decision. If we say \"True\" for 'f',\n-- and then subsequently decide /not/ make 'f' into a join point, then\n-- the decision about another binding 'g' might be invalidated if (say)\n-- 'f' tail-calls 'g'.\n--\n-- See Note [Invariants on join points] in CoreSyn.\ndecideJoinPointHood :: TopLevelFlag -> UsageDetails\n                    -> [CoreBndr]\n                    -> Bool\ndecideJoinPointHood TopLevel _ _\n  = False\ndecideJoinPointHood NotTopLevel usage bndrs\n  | isJoinId (head bndrs)\n  = WARN(not all_ok, text \"OccurAnal failed to rediscover join point(s):\" <+>\n                       ppr bndrs)\n    all_ok\n  | otherwise\n  = all_ok\n  where\n    -- See Note [Invariants on join points]; invariants cited by number below.\n    -- Invariant 2 is always satisfiable by the simplifier by eta expansion.\n    all_ok = -- Invariant 3: Either all are join points or none are\n             all ok bndrs\n\n    ok bndr\n      | -- Invariant 1: Only tail calls, all same join arity\n        AlwaysTailCalled arity <- tailCallInfo (lookupDetails usage bndr)\n\n      , -- Invariant 1 as applied to LHSes of rules\n        all (ok_rule arity) (idCoreRules bndr)\n\n        -- Invariant 2a: stable unfoldings\n        -- See Note [Join points and INLINE pragmas]\n      , ok_unfolding arity (realIdUnfolding bndr)\n\n        -- Invariant 4: Satisfies polymorphism rule\n      , isValidJoinPointType arity (idType bndr)\n      = True\n\n      | otherwise\n      = False\n\n    ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans\n    ok_rule join_arity (Rule { ru_args = args })\n      = args `lengthIs` join_arity\n        -- Invariant 1 as applied to LHSes of rules\n\n    -- ok_unfolding returns False if we should /not/ convert a non-join-id\n    -- into a join-id, even though it is AlwaysTailCalled\n    ok_unfolding join_arity (CoreUnfolding { uf_src = src, uf_tmpl = rhs })\n      = not (isStableSource src && join_arity > joinRhsArity rhs)\n    ok_unfolding _ (DFunUnfolding {})\n      = False\n    ok_unfolding _ _\n      = True\n\nwillBeJoinId_maybe :: CoreBndr -> Maybe JoinArity\nwillBeJoinId_maybe bndr\n  = case tailCallInfo (idOccInfo bndr) of\n      AlwaysTailCalled arity -> Just arity\n      _                      -> isJoinId_maybe bndr\n\n\n{- Note [Join points and INLINE pragmas]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   f x = let g = \\x. not  -- Arity 1\n             {-# INLINE g #-}\n         in case x of\n              A -> g True True\n              B -> g True False\n              C -> blah2\n\nHere 'g' is always tail-called applied to 2 args, but the stable\nunfolding captured by the INLINE pragma has arity 1.  If we try to\nconvert g to be a join point, its unfolding will still have arity 1\n(since it is stable, and we don't meddle with stable unfoldings), and\nLint will complain (see Note [Invariants on join points], (2a), in\nCoreSyn.  Trac #13413.\n\nMoreover, since g is going to be inlined anyway, there is no benefit\nfrom making it a join point.\n\nIf it is recursive, and uselessly marked INLINE, this will stop us\nmaking it a join point, which is annoying.  But occasionally\n(notably in class methods; see Note [Instances and loop breakers] in\nTcInstDcls) we mark recursive things as INLINE but the recursion\nunravels; so ignoring INLINE pragmas on recursive things isn't good\neither.\n\nSee Invariant 2a of Note [Invariants on join points] in CoreSyn\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Operations over OccInfo}\n*                                                                      *\n************************************************************************\n-}\n\nmarkMany, markInsideLam, markNonTailCalled :: OccInfo -> OccInfo\n\nmarkMany IAmDead = IAmDead\nmarkMany occ     = ManyOccs { occ_tail = occ_tail occ }\n\nmarkInsideLam occ@(OneOcc {}) = occ { occ_in_lam = True }\nmarkInsideLam occ             = occ\n\nmarkNonTailCalled IAmDead = IAmDead\nmarkNonTailCalled occ     = occ { occ_tail = NoTailCallInfo }\n\naddOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo\n\naddOccInfo a1 a2  = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )\n                    ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo`\n                                          tailCallInfo a2 }\n                                -- Both branches are at least One\n                                -- (Argument is never IAmDead)\n\n-- (orOccInfo orig new) is used\n-- when combining occurrence info from branches of a case\n\norOccInfo (OneOcc { occ_in_lam = in_lam1, occ_int_cxt = int_cxt1\n                  , occ_tail   = tail1 })\n          (OneOcc { occ_in_lam = in_lam2, occ_int_cxt = int_cxt2\n                  , occ_tail   = tail2 })\n  = OneOcc { occ_one_br  = False -- False, because it occurs in both branches\n           , occ_in_lam  = in_lam1 || in_lam2\n           , occ_int_cxt = int_cxt1 && int_cxt2\n           , occ_tail    = tail1 `andTailCallInfo` tail2 }\n\norOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )\n                  ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo`\n                                        tailCallInfo a2 }\n\nandTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo\nandTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2)\n  | arity1 == arity2 = info\nandTailCallInfo _ _  = NoTailCallInfo\n", "num_lines": 2892}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\n************************************************************************\n\n               Static Argument Transformation pass\n\n************************************************************************\n\nMay be seen as removing invariants from loops:\nArguments of recursive functions that do not change in recursive\ncalls are removed from the recursion, which is done locally\nand only passes the arguments which effectively change.\n\nExample:\nmap = /\\ ab -> \\f -> \\xs -> case xs of\n                 []       -> []\n                 (a:b) -> f a : map f b\n\nas map is recursively called with the same argument f (unmodified)\nwe transform it to\n\nmap = /\\ ab -> \\f -> \\xs -> let map' ys = case ys of\n                       []     -> []\n                       (a:b) -> f a : map' b\n                in map' xs\n\nNotice that for a compiler that uses lambda lifting this is\nuseless as map' will be transformed back to what map was.\n\nWe could possibly do the same for big lambdas, but we don't as\nthey will eventually be removed in later stages of the compiler,\ntherefore there is no penalty in keeping them.\n\nWe only apply the SAT when the number of static args is > 2. This\nproduces few bad cases.  See\n                should_transform\nin saTransform.\n\nHere are the headline nofib results:\n                  Size    Allocs   Runtime\nMin             +0.0%    -13.7%    -21.4%\nMax             +0.1%     +0.0%     +5.4%\nGeometric Mean  +0.0%     -0.2%     -6.9%\n\nThe previous patch, to fix polymorphic floatout demand signatures, is\nessential to make this work well!\n-}\n\n{-# LANGUAGE CPP #-}\nmodule SAT ( doStaticArgs ) where\n\nimport GhcPrelude\n\nimport Var\nimport CoreSyn\nimport CoreUtils\nimport Type\nimport Coercion\nimport Id\nimport Name\nimport VarEnv\nimport UniqSupply\nimport Util\nimport UniqFM\nimport VarSet\nimport Unique\nimport UniqSet\nimport Outputable\n\nimport Data.List\nimport FastString\n\n#include \"HsVersions.h\"\n\ndoStaticArgs :: UniqSupply -> CoreProgram -> CoreProgram\ndoStaticArgs us binds = snd $ mapAccumL sat_bind_threaded_us us binds\n  where\n    sat_bind_threaded_us us bind =\n        let (us1, us2) = splitUniqSupply us\n        in (us1, fst $ runSAT us2 (satBind bind emptyUniqSet))\n\n-- We don't bother to SAT recursive groups since it can lead\n-- to massive code expansion: see Andre Santos' thesis for details.\n-- This means we only apply the actual SAT to Rec groups of one element,\n-- but we want to recurse into the others anyway to discover other binds\nsatBind :: CoreBind -> IdSet -> SatM (CoreBind, IdSATInfo)\nsatBind (NonRec binder expr) interesting_ids = do\n    (expr', sat_info_expr, expr_app) <- satExpr expr interesting_ids\n    return (NonRec binder expr', finalizeApp expr_app sat_info_expr)\nsatBind (Rec [(binder, rhs)]) interesting_ids = do\n    let interesting_ids' = interesting_ids `addOneToUniqSet` binder\n        (rhs_binders, rhs_body) = collectBinders rhs\n    (rhs_body', sat_info_rhs_body) <- satTopLevelExpr rhs_body interesting_ids'\n    let sat_info_rhs_from_args = unitVarEnv binder (bindersToSATInfo rhs_binders)\n        sat_info_rhs' = mergeIdSATInfo sat_info_rhs_from_args sat_info_rhs_body\n\n        shadowing = binder `elementOfUniqSet` interesting_ids\n        sat_info_rhs'' = if shadowing\n                        then sat_info_rhs' `delFromUFM` binder -- For safety\n                        else sat_info_rhs'\n\n    bind' <- saTransformMaybe binder (lookupUFM sat_info_rhs' binder)\n                              rhs_binders rhs_body'\n    return (bind', sat_info_rhs'')\nsatBind (Rec pairs) interesting_ids = do\n    let (binders, rhss) = unzip pairs\n    rhss_SATed <- mapM (\\e -> satTopLevelExpr e interesting_ids) rhss\n    let (rhss', sat_info_rhss') = unzip rhss_SATed\n    return (Rec (zipEqual \"satBind\" binders rhss'), mergeIdSATInfos sat_info_rhss')\n\ndata App = VarApp Id | TypeApp Type | CoApp Coercion\ndata Staticness a = Static a | NotStatic\n\ntype IdAppInfo = (Id, SATInfo)\n\ntype SATInfo = [Staticness App]\ntype IdSATInfo = IdEnv SATInfo\nemptyIdSATInfo :: IdSATInfo\nemptyIdSATInfo = emptyUFM\n\n{-\npprIdSATInfo id_sat_info = vcat (map pprIdAndSATInfo (Map.toList id_sat_info))\n  where pprIdAndSATInfo (v, sat_info) = hang (ppr v <> colon) 4 (pprSATInfo sat_info)\n-}\n\npprSATInfo :: SATInfo -> SDoc\npprSATInfo staticness = hcat $ map pprStaticness staticness\n\npprStaticness :: Staticness App -> SDoc\npprStaticness (Static (VarApp _))  = text \"SV\"\npprStaticness (Static (TypeApp _)) = text \"ST\"\npprStaticness (Static (CoApp _))   = text \"SC\"\npprStaticness NotStatic            = text \"NS\"\n\n\nmergeSATInfo :: SATInfo -> SATInfo -> SATInfo\nmergeSATInfo l r = zipWith mergeSA l r\n  where\n    mergeSA NotStatic _ = NotStatic\n    mergeSA _ NotStatic = NotStatic\n    mergeSA (Static (VarApp v)) (Static (VarApp v'))\n      | v == v'   = Static (VarApp v)\n      | otherwise = NotStatic\n    mergeSA (Static (TypeApp t)) (Static (TypeApp t'))\n      | t `eqType` t' = Static (TypeApp t)\n      | otherwise     = NotStatic\n    mergeSA (Static (CoApp c)) (Static (CoApp c'))\n      | c `eqCoercion` c' = Static (CoApp c)\n      | otherwise             = NotStatic\n    mergeSA _ _  = pprPanic \"mergeSATInfo\" $\n                          text \"Left:\"\n                       <> pprSATInfo l <> text \", \"\n                       <> text \"Right:\"\n                       <> pprSATInfo r\n\nmergeIdSATInfo :: IdSATInfo -> IdSATInfo -> IdSATInfo\nmergeIdSATInfo = plusUFM_C mergeSATInfo\n\nmergeIdSATInfos :: [IdSATInfo] -> IdSATInfo\nmergeIdSATInfos = foldl' mergeIdSATInfo emptyIdSATInfo\n\nbindersToSATInfo :: [Id] -> SATInfo\nbindersToSATInfo vs = map (Static . binderToApp) vs\n    where binderToApp v | isId v    = VarApp v\n                        | isTyVar v = TypeApp $ mkTyVarTy v\n                        | otherwise = CoApp $ mkCoVarCo v\n\nfinalizeApp :: Maybe IdAppInfo -> IdSATInfo -> IdSATInfo\nfinalizeApp Nothing id_sat_info = id_sat_info\nfinalizeApp (Just (v, sat_info')) id_sat_info =\n    let sat_info'' = case lookupUFM id_sat_info v of\n                        Nothing -> sat_info'\n                        Just sat_info -> mergeSATInfo sat_info sat_info'\n    in extendVarEnv id_sat_info v sat_info''\n\nsatTopLevelExpr :: CoreExpr -> IdSet -> SatM (CoreExpr, IdSATInfo)\nsatTopLevelExpr expr interesting_ids = do\n    (expr', sat_info_expr, expr_app) <- satExpr expr interesting_ids\n    return (expr', finalizeApp expr_app sat_info_expr)\n\nsatExpr :: CoreExpr -> IdSet -> SatM (CoreExpr, IdSATInfo, Maybe IdAppInfo)\nsatExpr var@(Var v) interesting_ids = do\n    let app_info = if v `elementOfUniqSet` interesting_ids\n                   then Just (v, [])\n                   else Nothing\n    return (var, emptyIdSATInfo, app_info)\n\nsatExpr lit@(Lit _) _ = do\n    return (lit, emptyIdSATInfo, Nothing)\n\nsatExpr (Lam binders body) interesting_ids = do\n    (body', sat_info, this_app) <- satExpr body interesting_ids\n    return (Lam binders body', finalizeApp this_app sat_info, Nothing)\n\nsatExpr (App fn arg) interesting_ids = do\n    (fn', sat_info_fn, fn_app) <- satExpr fn interesting_ids\n    let satRemainder = boring fn' sat_info_fn\n    case fn_app of\n        Nothing -> satRemainder Nothing\n        Just (fn_id, fn_app_info) ->\n            -- TODO: remove this use of append somehow (use a data structure with O(1) append but a left-to-right kind of interface)\n            let satRemainderWithStaticness arg_staticness = satRemainder $ Just (fn_id, fn_app_info ++ [arg_staticness])\n            in case arg of\n                Type t     -> satRemainderWithStaticness $ Static (TypeApp t)\n                Coercion c -> satRemainderWithStaticness $ Static (CoApp c)\n                Var v      -> satRemainderWithStaticness $ Static (VarApp v)\n                _          -> satRemainderWithStaticness $ NotStatic\n  where\n    boring :: CoreExpr -> IdSATInfo -> Maybe IdAppInfo -> SatM (CoreExpr, IdSATInfo, Maybe IdAppInfo)\n    boring fn' sat_info_fn app_info =\n        do (arg', sat_info_arg, arg_app) <- satExpr arg interesting_ids\n           let sat_info_arg' = finalizeApp arg_app sat_info_arg\n               sat_info = mergeIdSATInfo sat_info_fn sat_info_arg'\n           return (App fn' arg', sat_info, app_info)\n\nsatExpr (Case expr bndr ty alts) interesting_ids = do\n    (expr', sat_info_expr, expr_app) <- satExpr expr interesting_ids\n    let sat_info_expr' = finalizeApp expr_app sat_info_expr\n\n    zipped_alts' <- mapM satAlt alts\n    let (alts', sat_infos_alts) = unzip zipped_alts'\n    return (Case expr' bndr ty alts', mergeIdSATInfo sat_info_expr' (mergeIdSATInfos sat_infos_alts), Nothing)\n  where\n    satAlt (con, bndrs, expr) = do\n        (expr', sat_info_expr) <- satTopLevelExpr expr interesting_ids\n        return ((con, bndrs, expr'), sat_info_expr)\n\nsatExpr (Let bind body) interesting_ids = do\n    (body', sat_info_body, body_app) <- satExpr body interesting_ids\n    (bind', sat_info_bind) <- satBind bind interesting_ids\n    return (Let bind' body', mergeIdSATInfo sat_info_body sat_info_bind, body_app)\n\nsatExpr (Tick tickish expr) interesting_ids = do\n    (expr', sat_info_expr, expr_app) <- satExpr expr interesting_ids\n    return (Tick tickish expr', sat_info_expr, expr_app)\n\nsatExpr ty@(Type _) _ = do\n    return (ty, emptyIdSATInfo, Nothing)\n\nsatExpr co@(Coercion _) _ = do\n    return (co, emptyIdSATInfo, Nothing)\n\nsatExpr (Cast expr coercion) interesting_ids = do\n    (expr', sat_info_expr, expr_app) <- satExpr expr interesting_ids\n    return (Cast expr' coercion, sat_info_expr, expr_app)\n\n{-\n************************************************************************\n\n                Static Argument Transformation Monad\n\n************************************************************************\n-}\n\ntype SatM result = UniqSM result\n\nrunSAT :: UniqSupply -> SatM a -> a\nrunSAT = initUs_\n\nnewUnique :: SatM Unique\nnewUnique = getUniqueM\n\n{-\n************************************************************************\n\n                Static Argument Transformation Monad\n\n************************************************************************\n\nTo do the transformation, the game plan is to:\n\n1. Create a small nonrecursive RHS that takes the\n   original arguments to the function but discards\n   the ones that are static and makes a call to the\n   SATed version with the remainder. We intend that\n   this will be inlined later, removing the overhead\n\n2. Bind this nonrecursive RHS over the original body\n   WITH THE SAME UNIQUE as the original body so that\n   any recursive calls to the original now go via\n   the small wrapper\n\n3. Rebind the original function to a new one which contains\n   our SATed function and just makes a call to it:\n   we call the thing making this call the local body\n\nExample: transform this\n\n    map :: forall a b. (a->b) -> [a] -> [b]\n    map = /\\ab. \\(f:a->b) (as:[a]) -> body[map]\nto\n    map :: forall a b. (a->b) -> [a] -> [b]\n    map = /\\ab. \\(f:a->b) (as:[a]) ->\n         letrec map' :: [a] -> [b]\n                    -- The \"worker function\n                map' = \\(as:[a]) ->\n                         let map :: forall a' b'. (a -> b) -> [a] -> [b]\n                                -- The \"shadow function\n                             map = /\\a'b'. \\(f':(a->b) (as:[a]).\n                                   map' as\n                         in body[map]\n         in map' as\n\nNote [Shadow binding]\n~~~~~~~~~~~~~~~~~~~~~\nThe calls to the inner map inside body[map] should get inlined\nby the local re-binding of 'map'.  We call this the \"shadow binding\".\n\nBut we can't use the original binder 'map' unchanged, because\nit might be exported, in which case the shadow binding won't be\ndiscarded as dead code after it is inlined.\n\nSo we use a hack: we make a new SysLocal binder with the *same* unique\nas binder.  (Another alternative would be to reset the export flag.)\n\nNote [Binder type capture]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nNotice that in the inner map (the \"shadow function\"), the static arguments\nare discarded -- it's as if they were underscores.  Instead, mentions\nof these arguments (notably in the types of dynamic arguments) are bound\nby the *outer* lambdas of the main function.  So we must make up fresh\nnames for the static arguments so that they do not capture variables\nmentioned in the types of dynamic args.\n\nIn the map example, the shadow function must clone the static type\nargument a,b, giving a',b', to ensure that in the \\(as:[a]), the 'a'\nis bound by the outer forall.  We clone f' too for consistency, but\nthat doesn't matter either way because static Id arguments aren't\nmentioned in the shadow binding at all.\n\nIf we don't we get something like this:\n\n[Exported]\n[Arity 3]\nGHC.Base.until =\n  \\ (@ a_aiK)\n    (p_a6T :: a_aiK -> GHC.Types.Bool)\n    (f_a6V :: a_aiK -> a_aiK)\n    (x_a6X :: a_aiK) ->\n    letrec {\n      sat_worker_s1aU :: a_aiK -> a_aiK\n      []\n      sat_worker_s1aU =\n        \\ (x_a6X :: a_aiK) ->\n          let {\n            sat_shadow_r17 :: forall a_a3O.\n                              (a_a3O -> GHC.Types.Bool) -> (a_a3O -> a_a3O) -> a_a3O -> a_a3O\n            []\n            sat_shadow_r17 =\n              \\ (@ a_aiK)\n                (p_a6T :: a_aiK -> GHC.Types.Bool)\n                (f_a6V :: a_aiK -> a_aiK)\n                (x_a6X :: a_aiK) ->\n                sat_worker_s1aU x_a6X } in\n          case p_a6T x_a6X of wild_X3y [ALWAYS Dead Nothing] {\n            GHC.Types.False -> GHC.Base.until @ a_aiK p_a6T f_a6V (f_a6V x_a6X);\n            GHC.Types.True -> x_a6X\n          }; } in\n    sat_worker_s1aU x_a6X\n\nWhere sat_shadow has captured the type variables of x_a6X etc as it has a a_aiK\ntype argument. This is bad because it means the application sat_worker_s1aU x_a6X\nis not well typed.\n-}\n\nsaTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind\nsaTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body\n  | Just arg_staticness <- maybe_arg_staticness\n  , should_transform arg_staticness\n  = saTransform binder arg_staticness rhs_binders rhs_body\n  | otherwise\n  = return (Rec [(binder, mkLams rhs_binders rhs_body)])\n  where\n    should_transform staticness = n_static_args > 1 -- THIS IS THE DECISION POINT\n      where\n        n_static_args = count isStaticValue staticness\n\nsaTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind\nsaTransform binder arg_staticness rhs_binders rhs_body\n  = do  { shadow_lam_bndrs <- mapM clone binders_w_staticness\n        ; uniq             <- newUnique\n        ; return (NonRec binder (mk_new_rhs uniq shadow_lam_bndrs)) }\n  where\n    -- Running example: foldr\n    -- foldr \\alpha \\beta c n xs = e, for some e\n    -- arg_staticness = [Static TypeApp, Static TypeApp, Static VarApp, Static VarApp, NonStatic]\n    -- rhs_binders = [\\alpha, \\beta, c, n, xs]\n    -- rhs_body = e\n\n    binders_w_staticness = rhs_binders `zip` (arg_staticness ++ repeat NotStatic)\n                                        -- Any extra args are assumed NotStatic\n\n    non_static_args :: [Var]\n            -- non_static_args = [xs]\n            -- rhs_binders_without_type_capture = [\\alpha', \\beta', c, n, xs]\n    non_static_args = [v | (v, NotStatic) <- binders_w_staticness]\n\n    clone (bndr, NotStatic) = return bndr\n    clone (bndr, _        ) = do { uniq <- newUnique\n                                 ; return (setVarUnique bndr uniq) }\n\n    -- new_rhs = \\alpha beta c n xs ->\n    --           let sat_worker = \\xs -> let sat_shadow = \\alpha' beta' c n xs ->\n    --                                       sat_worker xs\n    --                                   in e\n    --           in sat_worker xs\n    mk_new_rhs uniq shadow_lam_bndrs\n        = mkLams rhs_binders $\n          Let (Rec [(rec_body_bndr, rec_body)])\n          local_body\n        where\n          local_body = mkVarApps (Var rec_body_bndr) non_static_args\n\n          rec_body = mkLams non_static_args $\n                     Let (NonRec shadow_bndr shadow_rhs) rhs_body\n\n            -- See Note [Binder type capture]\n          shadow_rhs = mkLams shadow_lam_bndrs local_body\n            -- nonrec_rhs = \\alpha' beta' c n xs -> sat_worker xs\n\n          rec_body_bndr = mkSysLocal (fsLit \"sat_worker\") uniq (exprType rec_body)\n            -- rec_body_bndr = sat_worker\n\n            -- See Note [Shadow binding]; make a SysLocal\n          shadow_bndr = mkSysLocal (occNameFS (getOccName binder))\n                                   (idUnique binder)\n                                   (exprType shadow_rhs)\n\nisStaticValue :: Staticness App -> Bool\nisStaticValue (Static (VarApp _)) = True\nisStaticValue _                   = False\n", "num_lines": 434}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section{SetLevels}\n\n                ***************************\n                        Overview\n                ***************************\n\n1. We attach binding levels to Core bindings, in preparation for floating\n   outwards (@FloatOut@).\n\n2. We also let-ify many expressions (notably case scrutinees), so they\n   will have a fighting chance of being floated sensible.\n\n3. Note [Need for cloning during float-out]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n   We clone the binders of any floatable let-binding, so that when it is\n   floated out it will be unique. Example\n      (let x=2 in x) + (let x=3 in x)\n   we must clone before floating so we get\n      let x1=2 in\n      let x2=3 in\n      x1+x2\n\n   NOTE: this can't be done using the uniqAway idea, because the variable\n         must be unique in the whole program, not just its current scope,\n         because two variables in different scopes may float out to the\n         same top level place\n\n   NOTE: Very tiresomely, we must apply this substitution to\n         the rules stored inside a variable too.\n\n   We do *not* clone top-level bindings, because some of them must not change,\n   but we *do* clone bindings that are heading for the top level\n\n4. Note [Binder-swap during float-out]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n   In the expression\n        case x of wild { p -> ...wild... }\n   we substitute x for wild in the RHS of the case alternatives:\n        case x of wild { p -> ...x... }\n   This means that a sub-expression involving x is not \"trapped\" inside the RHS.\n   And it's not inconvenient because we already have a substitution.\n\n  Note that this is EXACTLY BACKWARDS from the what the simplifier does.\n  The simplifier tries to get rid of occurrences of x, in favour of wild,\n  in the hope that there will only be one remaining occurrence of x, namely\n  the scrutinee of the case, and we can inline it.\n-}\n\n{-# LANGUAGE CPP, MultiWayIf #-}\nmodule SetLevels (\n        setLevels,\n\n        Level(..), LevelType(..), tOP_LEVEL, isJoinCeilLvl, asJoinCeilLvl,\n        LevelledBind, LevelledExpr, LevelledBndr,\n        FloatSpec(..), floatSpecLevel,\n\n        incMinorLvl, ltMajLvl, ltLvl, isTopLvl\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreMonad        ( FloatOutSwitches(..) )\nimport CoreUtils        ( exprType, exprIsHNF\n                        , exprOkForSpeculation\n                        , exprIsTopLevelBindable\n                        , isExprLevPoly\n                        , collectMakeStaticArgs\n                        )\nimport CoreArity        ( exprBotStrictness_maybe )\nimport CoreFVs          -- all of it\nimport CoreSubst\nimport MkCore           ( sortQuantVars )\n\nimport Id\nimport IdInfo\nimport Var\nimport VarSet\nimport UniqSet          ( nonDetFoldUniqSet )\nimport UniqDSet         ( getUniqDSet )\nimport VarEnv\nimport Literal          ( litIsTrivial )\nimport Demand           ( StrictSig, Demand, isStrictDmd, splitStrictSig, increaseStrictSigArity )\nimport Name             ( getOccName, mkSystemVarName )\nimport OccName          ( occNameString )\nimport Type             ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType, closeOverKindsDSet )\nimport BasicTypes       ( Arity, RecFlag(..), isRec )\nimport DataCon          ( dataConOrigResTy )\nimport TysWiredIn\nimport UniqSupply\nimport Util\nimport Outputable\nimport FastString\nimport UniqDFM\nimport FV\nimport Data.Maybe\nimport MonadUtils       ( mapAccumLM )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Level numbers}\n*                                                                      *\n************************************************************************\n-}\n\ntype LevelledExpr = TaggedExpr FloatSpec\ntype LevelledBind = TaggedBind FloatSpec\ntype LevelledBndr = TaggedBndr FloatSpec\n\ndata Level = Level Int  -- Level number of enclosing lambdas\n                   Int  -- Number of big-lambda and/or case expressions and/or\n                        -- context boundaries between\n                        -- here and the nearest enclosing lambda\n                   LevelType -- Binder or join ceiling?\ndata LevelType = BndrLvl | JoinCeilLvl deriving (Eq)\n\ndata FloatSpec\n  = FloatMe Level       -- Float to just inside the binding\n                        --    tagged with this level\n  | StayPut Level       -- Stay where it is; binding is\n                        --     tagged with this level\n\nfloatSpecLevel :: FloatSpec -> Level\nfloatSpecLevel (FloatMe l) = l\nfloatSpecLevel (StayPut l) = l\n\n{-\nThe {\\em level number} on a (type-)lambda-bound variable is the\nnesting depth of the (type-)lambda which binds it.  The outermost lambda\nhas level 1, so (Level 0 0) means that the variable is bound outside any lambda.\n\nOn an expression, it's the maximum level number of its free\n(type-)variables.  On a let(rec)-bound variable, it's the level of its\nRHS.  On a case-bound variable, it's the number of enclosing lambdas.\n\nTop-level variables: level~0.  Those bound on the RHS of a top-level\ndefinition but ``before'' a lambda; e.g., the \\tr{x} in (levels shown\nas ``subscripts'')...\n\\begin{verbatim}\na_0 = let  b_? = ...  in\n           x_1 = ... b ... in ...\n\\end{verbatim}\n\nThe main function @lvlExpr@ carries a ``context level'' (@le_ctxt_lvl@).\nThat's meant to be the level number of the enclosing binder in the\nfinal (floated) program.  If the level number of a sub-expression is\nless than that of the context, then it might be worth let-binding the\nsub-expression so that it will indeed float.\n\nIf you can float to level @Level 0 0@ worth doing so because then your\nallocation becomes static instead of dynamic.  We always start with\ncontext @Level 0 0@.\n\n\nNote [FloatOut inside INLINE]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n@InlineCtxt@ very similar to @Level 0 0@, but is used for one purpose:\nto say \"don't float anything out of here\".  That's exactly what we\nwant for the body of an INLINE, where we don't want to float anything\nout at all.  See notes with lvlMFE below.\n\nBut, check this out:\n\n-- At one time I tried the effect of not floating anything out of an InlineMe,\n-- but it sometimes works badly.  For example, consider PrelArr.done.  It\n-- has the form         __inline (\\d. e)\n-- where e doesn't mention d.  If we float this to\n--      __inline (let x = e in \\d. x)\n-- things are bad.  The inliner doesn't even inline it because it doesn't look\n-- like a head-normal form.  So it seems a lesser evil to let things float.\n-- In SetLevels we do set the context to (Level 0 0) when we get to an InlineMe\n-- which discourages floating out.\n\nSo the conclusion is: don't do any floating at all inside an InlineMe.\n(In the above example, don't float the {x=e} out of the \\d.)\n\nOne particular case is that of workers: we don't want to float the\ncall to the worker outside the wrapper, otherwise the worker might get\ninlined into the floated expression, and an importing module won't see\nthe worker at all.\n\nNote [Join ceiling]\n~~~~~~~~~~~~~~~~~~~\nJoin points can't float very far; too far, and they can't remain join points\nSo, suppose we have:\n\n  f x = (joinrec j y = ... x ... in jump j x) + 1\n\nOne may be tempted to float j out to the top of f's RHS, but then the jump\nwould not be a tail call. Thus we keep track of a level called the *join\nceiling* past which join points are not allowed to float.\n\nThe troublesome thing is that, unlike most levels to which something might\nfloat, there is not necessarily an identifier to which the join ceiling is\nattached. Fortunately, if something is to be floated to a join ceiling, it must\nbe dropped at the *nearest* join ceiling. Thus each level is marked as to\nwhether it is a join ceiling, so that FloatOut can tell which binders are being\nfloated to the nearest join ceiling and which to a particular binder (or set of\nbinders).\n-}\n\ninstance Outputable FloatSpec where\n  ppr (FloatMe l) = char 'F' <> ppr l\n  ppr (StayPut l) = ppr l\n\ntOP_LEVEL :: Level\ntOP_LEVEL   = Level 0 0 BndrLvl\n\nincMajorLvl :: Level -> Level\nincMajorLvl (Level major _ _) = Level (major + 1) 0 BndrLvl\n\nincMinorLvl :: Level -> Level\nincMinorLvl (Level major minor _) = Level major (minor+1) BndrLvl\n\nasJoinCeilLvl :: Level -> Level\nasJoinCeilLvl (Level major minor _) = Level major minor JoinCeilLvl\n\nmaxLvl :: Level -> Level -> Level\nmaxLvl l1@(Level maj1 min1 _) l2@(Level maj2 min2 _)\n  | (maj1 > maj2) || (maj1 == maj2 && min1 > min2) = l1\n  | otherwise                                      = l2\n\nltLvl :: Level -> Level -> Bool\nltLvl (Level maj1 min1 _) (Level maj2 min2 _)\n  = (maj1 < maj2) || (maj1 == maj2 && min1 < min2)\n\nltMajLvl :: Level -> Level -> Bool\n    -- Tells if one level belongs to a difft *lambda* level to another\nltMajLvl (Level maj1 _ _) (Level maj2 _ _) = maj1 < maj2\n\nisTopLvl :: Level -> Bool\nisTopLvl (Level 0 0 _) = True\nisTopLvl _             = False\n\nisJoinCeilLvl :: Level -> Bool\nisJoinCeilLvl (Level _ _ t) = t == JoinCeilLvl\n\ninstance Outputable Level where\n  ppr (Level maj min typ)\n    = hcat [ char '<', int maj, char ',', int min, char '>'\n           , ppWhen (typ == JoinCeilLvl) (char 'C') ]\n\ninstance Eq Level where\n  (Level maj1 min1 _) == (Level maj2 min2 _) = maj1 == maj2 && min1 == min2\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Main level-setting code}\n*                                                                      *\n************************************************************************\n-}\n\nsetLevels :: FloatOutSwitches\n          -> CoreProgram\n          -> UniqSupply\n          -> [LevelledBind]\n\nsetLevels float_lams binds us\n  = initLvl us (do_them init_env binds)\n  where\n    init_env = initialEnv float_lams\n\n    do_them :: LevelEnv -> [CoreBind] -> LvlM [LevelledBind]\n    do_them _ [] = return []\n    do_them env (b:bs)\n      = do { (lvld_bind, env') <- lvlTopBind env b\n           ; lvld_binds <- do_them env' bs\n           ; return (lvld_bind : lvld_binds) }\n\nlvlTopBind :: LevelEnv -> Bind Id -> LvlM (LevelledBind, LevelEnv)\nlvlTopBind env (NonRec bndr rhs)\n  = do { rhs' <- lvl_top env NonRecursive bndr rhs\n       ; let (env', [bndr']) = substAndLvlBndrs NonRecursive env tOP_LEVEL [bndr]\n       ; return (NonRec bndr' rhs', env') }\n\nlvlTopBind env (Rec pairs)\n  = do { let (env', bndrs') = substAndLvlBndrs Recursive env tOP_LEVEL\n                                               (map fst pairs)\n       ; rhss' <- mapM (\\(b,r) -> lvl_top env' Recursive b r) pairs\n       ; return (Rec (bndrs' `zip` rhss'), env') }\n\nlvl_top :: LevelEnv -> RecFlag -> Id -> CoreExpr -> LvlM LevelledExpr\nlvl_top env is_rec bndr rhs\n  = lvlRhs env is_rec\n           (isBottomingId bndr)\n           Nothing  -- Not a join point\n           (freeVars rhs)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Setting expression levels}\n*                                                                      *\n************************************************************************\n\nNote [Floating over-saturated applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we see (f x y), and (f x) is a redex (ie f's arity is 1),\nwe call (f x) an \"over-saturated application\"\n\nShould we float out an over-sat app, if can escape a value lambda?\nIt is sometimes very beneficial (-7% runtime -4% alloc over nofib -O2).\nBut we don't want to do it for class selectors, because the work saved\nis minimal, and the extra local thunks allocated cost money.\n\nArguably we could float even class-op applications if they were going to\ntop level -- but then they must be applied to a constant dictionary and\nwill almost certainly be optimised away anyway.\n-}\n\nlvlExpr :: LevelEnv             -- Context\n        -> CoreExprWithFVs      -- Input expression\n        -> LvlM LevelledExpr    -- Result expression\n\n{-\nThe @le_ctxt_lvl@ is, roughly, the level of the innermost enclosing\nbinder.  Here's an example\n\n        v = \\x -> ...\\y -> let r = case (..x..) of\n                                        ..x..\n                           in ..\n\nWhen looking at the rhs of @r@, @le_ctxt_lvl@ will be 1 because that's\nthe level of @r@, even though it's inside a level-2 @\\y@.  It's\nimportant that @le_ctxt_lvl@ is 1 and not 2 in @r@'s rhs, because we\ndon't want @lvlExpr@ to turn the scrutinee of the @case@ into an MFE\n--- because it isn't a *maximal* free expression.\n\nIf there were another lambda in @r@'s rhs, it would get level-2 as well.\n-}\n\nlvlExpr env (_, AnnType ty)     = return (Type (CoreSubst.substTy (le_subst env) ty))\nlvlExpr env (_, AnnCoercion co) = return (Coercion (substCo (le_subst env) co))\nlvlExpr env (_, AnnVar v)       = return (lookupVar env v)\nlvlExpr _   (_, AnnLit lit)     = return (Lit lit)\n\nlvlExpr env (_, AnnCast expr (_, co)) = do\n    expr' <- lvlNonTailExpr env expr\n    return (Cast expr' (substCo (le_subst env) co))\n\nlvlExpr env (_, AnnTick tickish expr) = do\n    expr' <- lvlNonTailExpr env expr\n    let tickish' = substTickish (le_subst env) tickish\n    return (Tick tickish' expr')\n\nlvlExpr env expr@(_, AnnApp _ _) = lvlApp env expr (collectAnnArgs expr)\n\n-- We don't split adjacent lambdas.  That is, given\n--      \\x y -> (x+1,y)\n-- we don't float to give\n--      \\x -> let v = x+1 in \\y -> (v,y)\n-- Why not?  Because partial applications are fairly rare, and splitting\n-- lambdas makes them more expensive.\n\nlvlExpr env expr@(_, AnnLam {})\n  = do { new_body <- lvlNonTailMFE new_env True body\n       ; return (mkLams new_bndrs new_body) }\n  where\n    (bndrs, body)        = collectAnnBndrs expr\n    (env1, bndrs1)       = substBndrsSL NonRecursive env bndrs\n    (new_env, new_bndrs) = lvlLamBndrs env1 (le_ctxt_lvl env) bndrs1\n        -- At one time we called a special version of collectBinders,\n        -- which ignored coercions, because we don't want to split\n        -- a lambda like this (\\x -> coerce t (\\s -> ...))\n        -- This used to happen quite a bit in state-transformer programs,\n        -- but not nearly so much now non-recursive newtypes are transparent.\n        -- [See SetLevels rev 1.50 for a version with this approach.]\n\nlvlExpr env (_, AnnLet bind body)\n  = do { (bind', new_env) <- lvlBind env bind\n       ; body' <- lvlExpr new_env body\n           -- No point in going via lvlMFE here.  If the binding is alive\n           -- (mentioned in body), and the whole let-expression doesn't\n           -- float, then neither will the body\n       ; return (Let bind' body') }\n\nlvlExpr env (_, AnnCase scrut case_bndr ty alts)\n  = do { scrut' <- lvlNonTailMFE env True scrut\n       ; lvlCase env (freeVarsOf scrut) scrut' case_bndr ty alts }\n\nlvlNonTailExpr :: LevelEnv             -- Context\n               -> CoreExprWithFVs      -- Input expression\n               -> LvlM LevelledExpr    -- Result expression\nlvlNonTailExpr env expr\n  = lvlExpr (placeJoinCeiling env) expr\n\n-------------------------------------------\nlvlApp :: LevelEnv\n       -> CoreExprWithFVs\n       -> (CoreExprWithFVs, [CoreExprWithFVs]) -- Input application\n        -> LvlM LevelledExpr                   -- Result expression\nlvlApp env orig_expr ((_,AnnVar fn), args)\n  | floatOverSat env   -- See Note [Floating over-saturated applications]\n  , arity > 0\n  , arity < n_val_args\n  , Nothing <- isClassOpId_maybe fn\n  =  do { rargs' <- mapM (lvlNonTailMFE env False) rargs\n        ; lapp'  <- lvlNonTailMFE env False lapp\n        ; return (foldl' App lapp' rargs') }\n\n  | otherwise\n  = do { (_, args') <- mapAccumLM lvl_arg stricts args\n            -- Take account of argument strictness; see\n            -- Note [Floating to the top]\n       ; return (foldl' App (lookupVar env fn) args') }\n  where\n    n_val_args = count (isValArg . deAnnotate) args\n    arity      = idArity fn\n\n    stricts :: [Demand]   -- True for strict /value/ arguments\n    stricts = case splitStrictSig (idStrictness fn) of\n                (arg_ds, _) | arg_ds `lengthExceeds` n_val_args\n                            -> []\n                            | otherwise\n                            -> arg_ds\n\n    -- Separate out the PAP that we are floating from the extra\n    -- arguments, by traversing the spine until we have collected\n    -- (n_val_args - arity) value arguments.\n    (lapp, rargs) = left (n_val_args - arity) orig_expr []\n\n    left 0 e               rargs = (e, rargs)\n    left n (_, AnnApp f a) rargs\n       | isValArg (deAnnotate a) = left (n-1) f (a:rargs)\n       | otherwise               = left n     f (a:rargs)\n    left _ _ _                   = panic \"SetLevels.lvlExpr.left\"\n\n    is_val_arg :: CoreExprWithFVs -> Bool\n    is_val_arg (_, AnnType {}) = False\n    is_val_arg _               = True\n\n    lvl_arg :: [Demand] -> CoreExprWithFVs -> LvlM ([Demand], LevelledExpr)\n    lvl_arg strs arg | (str1 : strs') <- strs\n                     , is_val_arg arg\n                     = do { arg' <- lvlMFE env (isStrictDmd str1) arg\n                          ; return (strs', arg') }\n                     | otherwise\n                     = do { arg' <- lvlMFE env False arg\n                          ; return (strs, arg') }\n\nlvlApp env _ (fun, args)\n  =  -- No PAPs that we can float: just carry on with the\n     -- arguments and the function.\n     do { args' <- mapM (lvlNonTailMFE env False) args\n        ; fun'  <- lvlNonTailExpr env fun\n        ; return (foldl' App fun' args') }\n\n-------------------------------------------\nlvlCase :: LevelEnv             -- Level of in-scope names/tyvars\n        -> DVarSet              -- Free vars of input scrutinee\n        -> LevelledExpr         -- Processed scrutinee\n        -> Id -> Type           -- Case binder and result type\n        -> [CoreAltWithFVs]     -- Input alternatives\n        -> LvlM LevelledExpr    -- Result expression\nlvlCase env scrut_fvs scrut' case_bndr ty alts\n  -- See Note [Floating single-alternative cases]\n  | [(con@(DataAlt {}), bs, body)] <- alts\n  , exprIsHNF (deTagExpr scrut')  -- See Note [Check the output scrutinee for exprIsHNF]\n  , not (isTopLvl dest_lvl)       -- Can't have top-level cases\n  , not (floatTopLvlOnly env)     -- Can float anywhere\n  =     -- Always float the case if possible\n        -- Unlike lets we don't insist that it escapes a value lambda\n    do { (env1, (case_bndr' : bs')) <- cloneCaseBndrs env dest_lvl (case_bndr : bs)\n       ; let rhs_env = extendCaseBndrEnv env1 case_bndr scrut'\n       ; body' <- lvlMFE rhs_env True body\n       ; let alt' = (con, map (stayPut dest_lvl) bs', body')\n       ; return (Case scrut' (TB case_bndr' (FloatMe dest_lvl)) ty' [alt']) }\n\n  | otherwise     -- Stays put\n  = do { let (alts_env1, [case_bndr']) = substAndLvlBndrs NonRecursive env incd_lvl [case_bndr]\n             alts_env = extendCaseBndrEnv alts_env1 case_bndr scrut'\n       ; alts' <- mapM (lvl_alt alts_env) alts\n       ; return (Case scrut' case_bndr' ty' alts') }\n  where\n    ty' = substTy (le_subst env) ty\n\n    incd_lvl = incMinorLvl (le_ctxt_lvl env)\n    dest_lvl = maxFvLevel (const True) env scrut_fvs\n            -- Don't abstract over type variables, hence const True\n\n    lvl_alt alts_env (con, bs, rhs)\n      = do { rhs' <- lvlMFE new_env True rhs\n           ; return (con, bs', rhs') }\n      where\n        (new_env, bs') = substAndLvlBndrs NonRecursive alts_env incd_lvl bs\n\n{- Note [Floating single-alternative cases]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n  data T a = MkT !a\n  f :: T Int -> blah\n  f x vs = case x of { MkT y ->\n             let f vs = ...(case y of I# w -> e)...f..\n             in f vs\n\nHere we can float the (case y ...) out, because y is sure\nto be evaluated, to give\n  f x vs = case x of { MkT y ->\n           caes y of I# w ->\n             let f vs = ...(e)...f..\n             in f vs\n\nThat saves unboxing it every time round the loop.  It's important in\nsome DPH stuff where we really want to avoid that repeated unboxing in\nthe inner loop.\n\nThings to note:\n\n * The test we perform is exprIsHNF, and /not/ exprOkForSpeculation.\n\n     - exrpIsHNF catches the key case of an evaluated variable\n\n     - exprOkForSpeculation is /false/ of an evaluated variable;\n       See Note [exprOkForSpeculation and evaluated variables] in CoreUtils\n       So we'd actually miss the key case!\n\n     - Nothing is gained from the extra generality of exprOkForSpeculation\n       since we only consider floating a case whose single alternative\n       is a DataAlt   K a b -> rhs\n\n * We can't float a case to top level\n\n * It's worth doing this float even if we don't float\n   the case outside a value lambda.  Example\n     case x of {\n       MkT y -> (case y of I# w2 -> ..., case y of I# w2 -> ...)\n   If we floated the cases out we could eliminate one of them.\n\n * We only do this with a single-alternative case\n\nNote [Check the output scrutinee for exprIsHNF]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n  case x of y {\n    A -> ....(case y of alts)....\n  }\n\nBecause of the binder-swap, the inner case will get substituted to\n(case x of ..).  So when testing whether the scrutinee is in HNF we\nmust be careful to test the *result* scrutinee ('x' in this case), not\nthe *input* one 'y'.  The latter *is* in HNF here (because y is\nevaluated), but the former is not -- and indeed we can't float the\ninner case out, at least not unless x is also evaluated at its binding\nsite.  See Trac #5453.\n\nThat's why we apply exprIsHNF to scrut' and not to scrut.\n\nSee Note [Floating single-alternative cases] for why\nwe use exprIsHNF in the first place.\n-}\n\nlvlNonTailMFE :: LevelEnv             -- Level of in-scope names/tyvars\n              -> Bool                 -- True <=> strict context [body of case\n                                      --   or let]\n              -> CoreExprWithFVs      -- input expression\n              -> LvlM LevelledExpr    -- Result expression\nlvlNonTailMFE env strict_ctxt ann_expr\n  = lvlMFE (placeJoinCeiling env) strict_ctxt ann_expr\n\nlvlMFE ::  LevelEnv             -- Level of in-scope names/tyvars\n        -> Bool                 -- True <=> strict context [body of case or let]\n        -> CoreExprWithFVs      -- input expression\n        -> LvlM LevelledExpr    -- Result expression\n-- lvlMFE is just like lvlExpr, except that it might let-bind\n-- the expression, so that it can itself be floated.\n\nlvlMFE env _ (_, AnnType ty)\n  = return (Type (CoreSubst.substTy (le_subst env) ty))\n\n-- No point in floating out an expression wrapped in a coercion or note\n-- If we do we'll transform  lvl = e |> co\n--                       to  lvl' = e; lvl = lvl' |> co\n-- and then inline lvl.  Better just to float out the payload.\nlvlMFE env strict_ctxt (_, AnnTick t e)\n  = do { e' <- lvlMFE env strict_ctxt e\n       ; let t' = substTickish (le_subst env) t\n       ; return (Tick t' e') }\n\nlvlMFE env strict_ctxt (_, AnnCast e (_, co))\n  = do  { e' <- lvlMFE env strict_ctxt e\n        ; return (Cast e' (substCo (le_subst env) co)) }\n\nlvlMFE env strict_ctxt e@(_, AnnCase {})\n  | strict_ctxt       -- Don't share cases in a strict context\n  = lvlExpr env e     -- See Note [Case MFEs]\n\nlvlMFE env strict_ctxt ann_expr\n  |  floatTopLvlOnly env && not (isTopLvl dest_lvl)\n         -- Only floating to the top level is allowed.\n  || anyDVarSet isJoinId fvs   -- If there is a free join, don't float\n                               -- See Note [Free join points]\n  || isExprLevPoly expr\n         -- We can't let-bind levity polymorphic expressions\n         -- See Note [Levity polymorphism invariants] in CoreSyn\n  || notWorthFloating expr abs_vars\n  || not float_me\n  =     -- Don't float it out\n    lvlExpr env ann_expr\n\n  |  float_is_new_lam || exprIsTopLevelBindable expr expr_ty\n         -- No wrapping needed if the type is lifted, or is a literal string\n         -- or if we are wrapping it in one or more value lambdas\n  = do { expr1 <- lvlFloatRhs abs_vars dest_lvl rhs_env NonRecursive\n                              (isJust mb_bot_str)\n                              join_arity_maybe\n                              ann_expr\n                  -- Treat the expr just like a right-hand side\n       ; var <- newLvlVar expr1 join_arity_maybe is_mk_static\n       ; let var2 = annotateBotStr var float_n_lams mb_bot_str\n       ; return (Let (NonRec (TB var2 (FloatMe dest_lvl)) expr1)\n                     (mkVarApps (Var var2) abs_vars)) }\n\n  -- OK, so the float has an unlifted type (not top-level bindable)\n  --     and no new value lambdas (float_is_new_lam is False)\n  -- Try for the boxing strategy\n  -- See Note [Floating MFEs of unlifted type]\n  | escapes_value_lam\n  , not expr_ok_for_spec -- Boxing/unboxing isn't worth it for cheap expressions\n                         -- See Note [Test cheapness with exprOkForSpeculation]\n  , Just (tc, _) <- splitTyConApp_maybe expr_ty\n  , Just dc <- boxingDataCon_maybe tc\n  , let dc_res_ty = dataConOrigResTy dc  -- No free type variables\n        [bx_bndr, ubx_bndr] = mkTemplateLocals [dc_res_ty, expr_ty]\n  = do { expr1 <- lvlExpr rhs_env ann_expr\n       ; let l1r       = incMinorLvlFrom rhs_env\n             float_rhs = mkLams abs_vars_w_lvls $\n                         Case expr1 (stayPut l1r ubx_bndr) dc_res_ty\n                             [(DEFAULT, [], mkConApp dc [Var ubx_bndr])]\n\n       ; var <- newLvlVar float_rhs Nothing is_mk_static\n       ; let l1u      = incMinorLvlFrom env\n             use_expr = Case (mkVarApps (Var var) abs_vars)\n                             (stayPut l1u bx_bndr) expr_ty\n                             [(DataAlt dc, [stayPut l1u ubx_bndr], Var ubx_bndr)]\n       ; return (Let (NonRec (TB var (FloatMe dest_lvl)) float_rhs)\n                     use_expr) }\n\n  | otherwise          -- e.g. do not float unboxed tuples\n  = lvlExpr env ann_expr\n\n  where\n    expr         = deAnnotate ann_expr\n    expr_ty      = exprType expr\n    fvs          = freeVarsOf ann_expr\n    fvs_ty       = tyCoVarsOfType expr_ty\n    is_bot       = isBottomThunk mb_bot_str\n    is_function  = isFunction ann_expr\n    mb_bot_str   = exprBotStrictness_maybe expr\n                           -- See Note [Bottoming floats]\n                           -- esp Bottoming floats (2)\n    expr_ok_for_spec = exprOkForSpeculation expr\n    dest_lvl     = destLevel env fvs fvs_ty is_function is_bot False\n    abs_vars     = abstractVars dest_lvl env fvs\n\n    -- float_is_new_lam: the floated thing will be a new value lambda\n    -- replacing, say (g (x+4)) by (lvl x).  No work is saved, nor is\n    -- allocation saved.  The benefit is to get it to the top level\n    -- and hence out of the body of this function altogether, making\n    -- it smaller and more inlinable\n    float_is_new_lam = float_n_lams > 0\n    float_n_lams     = count isId abs_vars\n\n    (rhs_env, abs_vars_w_lvls) = lvlLamBndrs env dest_lvl abs_vars\n\n    join_arity_maybe = Nothing\n\n    is_mk_static = isJust (collectMakeStaticArgs expr)\n        -- Yuk: See Note [Grand plan for static forms] in main/StaticPtrTable\n\n        -- A decision to float entails let-binding this thing, and we only do\n        -- that if we'll escape a value lambda, or will go to the top level.\n    float_me = saves_work || saves_alloc || is_mk_static\n\n    -- We can save work if we can move a redex outside a value lambda\n    -- But if float_is_new_lam is True, then the redex is wrapped in a\n    -- a new lambda, so no work is saved\n    saves_work = escapes_value_lam && not float_is_new_lam\n\n    escapes_value_lam = dest_lvl `ltMajLvl` (le_ctxt_lvl env)\n                  -- See Note [Escaping a value lambda]\n\n    -- See Note [Floating to the top]\n    saves_alloc =  isTopLvl dest_lvl\n                && floatConsts env\n                && (not strict_ctxt || is_bot || exprIsHNF expr)\n\nisBottomThunk :: Maybe (Arity, s) -> Bool\n-- See Note [Bottoming floats] (2)\nisBottomThunk (Just (0, _)) = True   -- Zero arity\nisBottomThunk _             = False\n\n{- Note [Floating to the top]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe are keen to float something to the top level, even if it does not\nescape a value lambda (and hence save work), for two reasons:\n\n  * Doing so makes the function smaller, by floating out\n    bottoming expressions, or integer or string literals.  That in\n    turn makes it easier to inline, with less duplication.\n\n  * (Minor) Doing so may turn a dynamic allocation (done by machine\n    instructions) into a static one. Minor because we are assuming\n    we are not escaping a value lambda.\n\nBut do not so if:\n     - the context is a strict, and\n     - the expression is not a HNF, and\n     - the expression is not bottoming\n\nExammples:\n\n* Bottoming\n      f x = case x of\n              0 -> error <big thing>\n              _ -> x+1\n  Here we want to float (error <big thing>) to top level, abstracting\n  over 'x', so as to make f's RHS smaller.\n\n* HNF\n      f = case y of\n            True  -> p:q\n            False -> blah\n  We may as well float the (p:q) so it becomes a static data structure.\n\n* Case scrutinee\n      f = case g True of ....\n  Don't float (g True) to top level; then we have the admin of a\n  top-level thunk to worry about, with zero gain.\n\n* Case alternative\n      h = case y of\n             True  -> g True\n             False -> False\n  Don't float (g True) to the top level\n\n* Arguments\n     t = f (g True)\n  If f is lazy, we /do/ float (g True) because then we can allocate\n  the thunk statically rather than dynamically.  But if f is strict\n  we don't (see the use of idStrictness in lvlApp).  It's not clear\n  if this test is worth the bother: it's only about CAFs!\n\nIt's controlled by a flag (floatConsts), because doing this too\nearly loses opportunities for RULES which (needless to say) are\nimportant in some nofib programs (gcd is an example).  [SPJ note:\nI think this is obselete; the flag seems always on.]\n\nNote [Floating join point bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMostly we only float a join point if it can /stay/ a join point.  But\nthere is one exception: if it can go to the top level (Trac #13286).\nConsider\n  f x = joinrec j y n = <...j y' n'...>\n        in jump j x 0\n\nHere we may just as well produce\n  j y n = <....j y' n'...>\n  f x = j x 0\n\nand now there is a chance that 'f' will be inlined at its call sites.\nIt shouldn't make a lot of difference, but thes tests\n  perf/should_run/MethSharing\n  simplCore/should_compile/spec-inline\nand one nofib program, all improve if you do float to top, because\nof the resulting inlining of f.  So ok, let's do it.\n\nNote [Free join points]\n~~~~~~~~~~~~~~~~~~~~~~~\nWe never float a MFE that has a free join-point variable.  You mght think\nthis can never occur.  After all, consider\n     join j x = ...\n     in ....(jump j x)....\nHow might we ever want to float that (jump j x)?\n  * If it would escape a value lambda, thus\n        join j x = ... in (\\y. ...(jump j x)... )\n    then 'j' isn't a valid join point in the first place.\n\nBut consider\n     join j x = .... in\n     joinrec j2 y =  ...(jump j x)...(a+b)....\n\nSince j2 is recursive, it /is/ worth floating (a+b) out of the joinrec.\nBut it is emphatically /not/ good to float the (jump j x) out:\n (a) 'j' will stop being a join point\n (b) In any case, jumping to 'j' must be an exit of the j2 loop, so no\n     work would be saved by floating it out of the \\y.\n\nEven if we floated 'j' to top level, (b) would still hold.\n\nBottom line: never float a MFE that has a free JoinId.\n\nNote [Floating MFEs of unlifted type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n   case f x of (r::Int#) -> blah\nwe'd like to float (f x). But it's not trivial because it has type\nInt#, and we don't want to evaluate it too early.  But we can instead\nfloat a boxed version\n   y = case f x of r -> I# r\nand replace the original (f x) with\n   case (case y of I# r -> r) of r -> blah\n\nBeing able to float unboxed expressions is sometimes important; see\nTrac #12603.  I'm not sure how /often/ it is important, but it's\nnot hard to achieve.\n\nWe only do it for a fixed collection of types for which we have a\nconvenient boxing constructor (see boxingDataCon_maybe).  In\nparticular we /don't/ do it for unboxed tuples; it's better to float\nthe components of the tuple individually.\n\nI did experiment with a form of boxing that works for any type, namely\nwrapping in a function.  In our example\n\n   let y = case f x of r -> \\v. f x\n   in case y void of r -> blah\n\nIt works fine, but it's 50% slower (based on some crude benchmarking).\nI suppose we could do it for types not covered by boxingDataCon_maybe,\nbut it's more code and I'll wait to see if anyone wants it.\n\nNote [Test cheapness with exprOkForSpeculation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't want to float very cheap expressions by boxing and unboxing.\nBut we use exprOkForSpeculation for the test, not exprIsCheap.\nWhy?  Because it's important /not/ to transform\n     f (a /# 3)\nto\n     f (case bx of I# a -> a /# 3)\nand float bx = I# (a /# 3), because the application of f no\nlonger obeys the let/app invariant.  But (a /# 3) is ok-for-spec\ndue to a special hack that says division operators can't fail\nwhen the denominator is definitely non-zero.  And yet that\nsame expression says False to exprIsCheap.  Simplest way to\nguarantee the let/app invariant is to use the same function!\n\nIf an expression is okay for speculation, we could also float it out\n*without* boxing and unboxing, since evaluating it early is okay.\nHowever, it turned out to usually be better not to float such expressions,\nsince they tend to be extremely cheap things like (x +# 1#). Even the\ncost of spilling the let-bound variable to the stack across a call may\nexceed the cost of recomputing such an expression. (And we can't float\nunlifted bindings to top-level.)\n\nWe could try to do something smarter here, and float out expensive yet\nokay-for-speculation things, such as division by non-zero constants.\nBut I suspect it's a narrow target.\n\nNote [Bottoming floats]\n~~~~~~~~~~~~~~~~~~~~~~~\nIf we see\n        f = \\x. g (error \"urk\")\nwe'd like to float the call to error, to get\n        lvl = error \"urk\"\n        f = \\x. g lvl\n\nBut, as ever, we need to be careful:\n\n(1) We want to float a bottoming\n    expression even if it has free variables:\n        f = \\x. g (let v = h x in error (\"urk\" ++ v))\n    Then we'd like to abstract over 'x' can float the whole arg of g:\n        lvl = \\x. let v = h x in error (\"urk\" ++ v)\n        f = \\x. g (lvl x)\n    To achieve this we pass is_bot to destLevel\n\n(2) We do not do this for lambdas that return\n    bottom.  Instead we treat the /body/ of such a function specially,\n    via point (1).  For example:\n        f = \\x. ....(\\y z. if x then error y else error z)....\n    ===>\n        lvl = \\x z y. if b then error y else error z\n        f = \\x. ...(\\y z. lvl x z y)...\n    (There is no guarantee that we'll choose the perfect argument order.)\n\n(3) If we have a /binding/ that returns bottom, we want to float it to top\n    level, even if it has free vars (point (1)), and even it has lambdas.\n    Example:\n       ... let { v = \\y. error (show x ++ show y) } in ...\n    We want to abstract over x and float the whole thing to top:\n       lvl = \\xy. errror (show x ++ show y)\n       ...let {v = lvl x} in ...\n\n    Then of course we don't want to separately float the body (error ...)\n    as /another/ MFE, so we tell lvlFloatRhs not to do that, via the is_bot\n    argument.\n\nSee Maessen's paper 1999 \"Bottom extraction: factoring error handling out\nof functional programs\" (unpublished I think).\n\nWhen we do this, we set the strictness and arity of the new bottoming\nId, *immediately*, for three reasons:\n\n  * To prevent the abstracted thing being immediately inlined back in again\n    via preInlineUnconditionally.  The latter has a test for bottoming Ids\n    to stop inlining them, so we'd better make sure it *is* a bottoming Id!\n\n  * So that it's properly exposed as such in the interface file, even if\n    this is all happening after strictness analysis.\n\n  * In case we do CSE with the same expression that *is* marked bottom\n        lvl          = error \"urk\"\n          x{str=bot) = error \"urk\"\n    Here we don't want to replace 'x' with 'lvl', else we may get Lint\n    errors, e.g. via a case with empty alternatives:  (case x of {})\n    Lint complains unless the scrutinee of such a case is clearly bottom.\n\n    This was reported in Trac #11290.   But since the whole bottoming-float\n    thing is based on the cheap-and-cheerful exprIsBottom, I'm not sure\n    that it'll nail all such cases.\n\nNote [Bottoming floats: eta expansion] c.f Note [Bottoming floats]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTiresomely, though, the simplifier has an invariant that the manifest\narity of the RHS should be the same as the arity; but we can't call\netaExpand during SetLevels because it works over a decorated form of\nCoreExpr.  So we do the eta expansion later, in FloatOut.\n\nNote [Case MFEs]\n~~~~~~~~~~~~~~~~\nWe don't float a case expression as an MFE from a strict context.  Why not?\nBecause in doing so we share a tiny bit of computation (the switch) but\nin exchange we build a thunk, which is bad.  This case reduces allocation\nby 7% in spectral/puzzle (a rather strange benchmark) and 1.2% in real/fem.\nDoesn't change any other allocation at all.\n\nWe will make a separate decision for the scrutinee and alternatives.\n\nHowever this can have a knock-on effect for fusion: consider\n    \\v -> foldr k z (case x of I# y -> build ..y..)\nPerhaps we can float the entire (case x of ...) out of the \\v.  Then\nfusion will not happen, but we will get more sharing.  But if we don't\nfloat the case (as advocated here) we won't float the (build ...y..)\neither, so fusion will happen.  It can be a big effect, esp in some\nartificial benchmarks (e.g. integer, queens), but there is no perfect\nanswer.\n\n-}\n\nannotateBotStr :: Id -> Arity -> Maybe (Arity, StrictSig) -> Id\n-- See Note [Bottoming floats] for why we want to add\n-- bottoming information right now\n--\n-- n_extra are the number of extra value arguments added during floating\nannotateBotStr id n_extra mb_str\n  = case mb_str of\n      Nothing           -> id\n      Just (arity, sig) -> id `setIdArity`      (arity + n_extra)\n                              `setIdStrictness` (increaseStrictSigArity n_extra sig)\n\nnotWorthFloating :: CoreExpr -> [Var] -> Bool\n-- Returns True if the expression would be replaced by\n-- something bigger than it is now.  For example:\n--   abs_vars = tvars only:  return True if e is trivial,\n--                           but False for anything bigger\n--   abs_vars = [x] (an Id): return True for trivial, or an application (f x)\n--                           but False for (f x x)\n--\n-- One big goal is that floating should be idempotent.  Eg if\n-- we replace e with (lvl79 x y) and then run FloatOut again, don't want\n-- to replace (lvl79 x y) with (lvl83 x y)!\n\nnotWorthFloating e abs_vars\n  = go e (count isId abs_vars)\n  where\n    go (Var {}) n    = n >= 0\n    go (Lit lit) n   = ASSERT( n==0 )\n                       litIsTrivial lit   -- Note [Floating literals]\n    go (Tick t e) n  = not (tickishIsCode t) && go e n\n    go (Cast e _)  n = go e n\n    go (App e arg) n\n       | Type {}     <- arg = go e n\n       | Coercion {} <- arg = go e n\n       | n==0               = False\n       | is_triv arg        = go e (n-1)\n       | otherwise          = False\n    go _ _                  = False\n\n    is_triv (Lit {})              = True        -- Treat all literals as trivial\n    is_triv (Var {})              = True        -- (ie not worth floating)\n    is_triv (Cast e _)            = is_triv e\n    is_triv (App e (Type {}))     = is_triv e\n    is_triv (App e (Coercion {})) = is_triv e\n    is_triv (Tick t e)            = not (tickishIsCode t) && is_triv e\n    is_triv _                     = False\n\n{-\nNote [Floating literals]\n~~~~~~~~~~~~~~~~~~~~~~~~\nIt's important to float Integer literals, so that they get shared,\nrather than being allocated every time round the loop.\nHence the litIsTrivial.\n\nDitto literal strings (LitString), which we'd like to float to top\nlevel, which is now possible.\n\n\nNote [Escaping a value lambda]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to float even cheap expressions out of value lambdas,\nbecause that saves allocation.  Consider\n        f = \\x.  .. (\\y.e) ...\nThen we'd like to avoid allocating the (\\y.e) every time we call f,\n(assuming e does not mention x). An example where this really makes a\ndifference is simplrun009.\n\nAnother reason it's good is because it makes SpecContr fire on functions.\nConsider\n        f = \\x. ....(f (\\y.e))....\nAfter floating we get\n        lvl = \\y.e\n        f = \\x. ....(f lvl)...\nand that is much easier for SpecConstr to generate a robust\nspecialisation for.\n\nHowever, if we are wrapping the thing in extra value lambdas (in\nabs_vars), then nothing is saved.  E.g.\n        f = \\xyz. ...(e1[y],e2)....\nIf we float\n        lvl = \\y. (e1[y],e2)\n        f = \\xyz. ...(lvl y)...\nwe have saved nothing: one pair will still be allocated for each\ncall of 'f'.  Hence the (not float_is_lam) in float_me.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Bindings}\n*                                                                      *\n************************************************************************\n\nThe binding stuff works for top level too.\n-}\n\nlvlBind :: LevelEnv\n        -> CoreBindWithFVs\n        -> LvlM (LevelledBind, LevelEnv)\n\nlvlBind env (AnnNonRec bndr rhs)\n  | isTyVar bndr    -- Don't do anything for TyVar binders\n                    --   (simplifier gets rid of them pronto)\n  || isCoVar bndr   -- Difficult to fix up CoVar occurrences (see extendPolyLvlEnv)\n                    -- so we will ignore this case for now\n  || not (profitableFloat env dest_lvl)\n  || (isTopLvl dest_lvl && not (exprIsTopLevelBindable deann_rhs bndr_ty))\n          -- We can't float an unlifted binding to top level (except\n          -- literal strings), so we don't float it at all.  It's a\n          -- bit brutal, but unlifted bindings aren't expensive either\n\n  = -- No float\n    do { rhs' <- lvlRhs env NonRecursive is_bot mb_join_arity rhs\n       ; let  bind_lvl        = incMinorLvl (le_ctxt_lvl env)\n              (env', [bndr']) = substAndLvlBndrs NonRecursive env bind_lvl [bndr]\n       ; return (NonRec bndr' rhs', env') }\n\n  -- Otherwise we are going to float\n  | null abs_vars\n  = do {  -- No type abstraction; clone existing binder\n         rhs' <- lvlFloatRhs [] dest_lvl env NonRecursive\n                             is_bot mb_join_arity rhs\n       ; (env', [bndr']) <- cloneLetVars NonRecursive env dest_lvl [bndr]\n       ; let bndr2 = annotateBotStr bndr' 0 mb_bot_str\n       ; return (NonRec (TB bndr2 (FloatMe dest_lvl)) rhs', env') }\n\n  | otherwise\n  = do {  -- Yes, type abstraction; create a new binder, extend substitution, etc\n         rhs' <- lvlFloatRhs abs_vars dest_lvl env NonRecursive\n                             is_bot mb_join_arity rhs\n       ; (env', [bndr']) <- newPolyBndrs dest_lvl env abs_vars [bndr]\n       ; let bndr2 = annotateBotStr bndr' n_extra mb_bot_str\n       ; return (NonRec (TB bndr2 (FloatMe dest_lvl)) rhs', env') }\n\n  where\n    bndr_ty    = idType bndr\n    ty_fvs     = tyCoVarsOfType bndr_ty\n    rhs_fvs    = freeVarsOf rhs\n    bind_fvs   = rhs_fvs `unionDVarSet` dIdFreeVars bndr\n    abs_vars   = abstractVars dest_lvl env bind_fvs\n    dest_lvl   = destLevel env bind_fvs ty_fvs (isFunction rhs) is_bot is_join\n\n    deann_rhs  = deAnnotate rhs\n    mb_bot_str = exprBotStrictness_maybe deann_rhs\n    is_bot     = isJust mb_bot_str\n        -- NB: not isBottomThunk!  See Note [Bottoming floats] point (3)\n\n    n_extra    = count isId abs_vars\n    mb_join_arity = isJoinId_maybe bndr\n    is_join       = isJust mb_join_arity\n\nlvlBind env (AnnRec pairs)\n  |  floatTopLvlOnly env && not (isTopLvl dest_lvl)\n         -- Only floating to the top level is allowed.\n  || not (profitableFloat env dest_lvl)\n  = do { let bind_lvl       = incMinorLvl (le_ctxt_lvl env)\n             (env', bndrs') = substAndLvlBndrs Recursive env bind_lvl bndrs\n             lvl_rhs (b,r)  = lvlRhs env' Recursive is_bot (isJoinId_maybe b) r\n       ; rhss' <- mapM lvl_rhs pairs\n       ; return (Rec (bndrs' `zip` rhss'), env') }\n\n  | null abs_vars\n  = do { (new_env, new_bndrs) <- cloneLetVars Recursive env dest_lvl bndrs\n       ; new_rhss <- mapM (do_rhs new_env) pairs\n       ; return ( Rec ([TB b (FloatMe dest_lvl) | b <- new_bndrs] `zip` new_rhss)\n                , new_env) }\n\n-- ToDo: when enabling the floatLambda stuff,\n--       I think we want to stop doing this\n  | [(bndr,rhs)] <- pairs\n  , count isId abs_vars > 1\n  = do  -- Special case for self recursion where there are\n        -- several variables carried around: build a local loop:\n        --      poly_f = \\abs_vars. \\lam_vars . letrec f = \\lam_vars. rhs in f lam_vars\n        -- This just makes the closures a bit smaller.  If we don't do\n        -- this, allocation rises significantly on some programs\n        --\n        -- We could elaborate it for the case where there are several\n        -- mutually recursive functions, but it's quite a bit more complicated\n        --\n        -- This all seems a bit ad hoc -- sigh\n    let (rhs_env, abs_vars_w_lvls) = lvlLamBndrs env dest_lvl abs_vars\n        rhs_lvl = le_ctxt_lvl rhs_env\n\n    (rhs_env', [new_bndr]) <- cloneLetVars Recursive rhs_env rhs_lvl [bndr]\n    let\n        (lam_bndrs, rhs_body)   = collectAnnBndrs rhs\n        (body_env1, lam_bndrs1) = substBndrsSL NonRecursive rhs_env' lam_bndrs\n        (body_env2, lam_bndrs2) = lvlLamBndrs body_env1 rhs_lvl lam_bndrs1\n    new_rhs_body <- lvlRhs body_env2 Recursive is_bot (get_join bndr) rhs_body\n    (poly_env, [poly_bndr]) <- newPolyBndrs dest_lvl env abs_vars [bndr]\n    return (Rec [(TB poly_bndr (FloatMe dest_lvl)\n                 , mkLams abs_vars_w_lvls $\n                   mkLams lam_bndrs2 $\n                   Let (Rec [( TB new_bndr (StayPut rhs_lvl)\n                             , mkLams lam_bndrs2 new_rhs_body)])\n                       (mkVarApps (Var new_bndr) lam_bndrs1))]\n           , poly_env)\n\n  | otherwise  -- Non-null abs_vars\n  = do { (new_env, new_bndrs) <- newPolyBndrs dest_lvl env abs_vars bndrs\n       ; new_rhss <- mapM (do_rhs new_env) pairs\n       ; return ( Rec ([TB b (FloatMe dest_lvl) | b <- new_bndrs] `zip` new_rhss)\n                , new_env) }\n\n  where\n    (bndrs,rhss) = unzip pairs\n    is_join  = isJoinId (head bndrs)\n                -- bndrs is always non-empty and if one is a join they all are\n                -- Both are checked by Lint\n    is_fun   = all isFunction rhss\n    is_bot   = False  -- It's odd to have an unconditionally divergent\n                      -- function in a Rec, and we don't much care what\n                      -- happens to it.  False is simple!\n\n    do_rhs env (bndr,rhs) = lvlFloatRhs abs_vars dest_lvl env Recursive\n                                        is_bot (get_join bndr)\n                                        rhs\n\n    get_join bndr | need_zap  = Nothing\n                  | otherwise = isJoinId_maybe bndr\n    need_zap = dest_lvl `ltLvl` joinCeilingLevel env\n\n        -- Finding the free vars of the binding group is annoying\n    bind_fvs = ((unionDVarSets [ freeVarsOf rhs | (_, rhs) <- pairs])\n                `unionDVarSet`\n                (fvDVarSet $ unionsFV [ idFVs bndr\n                                      | (bndr, (_,_)) <- pairs]))\n               `delDVarSetList`\n                bndrs\n\n    ty_fvs   = foldr (unionVarSet . tyCoVarsOfType . idType) emptyVarSet bndrs\n    dest_lvl = destLevel env bind_fvs ty_fvs is_fun is_bot is_join\n    abs_vars = abstractVars dest_lvl env bind_fvs\n\nprofitableFloat :: LevelEnv -> Level -> Bool\nprofitableFloat env dest_lvl\n  =  (dest_lvl `ltMajLvl` le_ctxt_lvl env)  -- Escapes a value lambda\n  || isTopLvl dest_lvl                      -- Going all the way to top level\n\n\n----------------------------------------------------\n-- Three help functions for the type-abstraction case\n\nlvlRhs :: LevelEnv\n       -> RecFlag\n       -> Bool               -- Is this a bottoming function\n       -> Maybe JoinArity\n       -> CoreExprWithFVs\n       -> LvlM LevelledExpr\nlvlRhs env rec_flag is_bot mb_join_arity expr\n  = lvlFloatRhs [] (le_ctxt_lvl env) env\n                rec_flag is_bot mb_join_arity expr\n\nlvlFloatRhs :: [OutVar] -> Level -> LevelEnv -> RecFlag\n            -> Bool   -- Binding is for a bottoming function\n            -> Maybe JoinArity\n            -> CoreExprWithFVs\n            -> LvlM (Expr LevelledBndr)\n-- Ignores the le_ctxt_lvl in env; treats dest_lvl as the baseline\nlvlFloatRhs abs_vars dest_lvl env rec is_bot mb_join_arity rhs\n  = do { body' <- if not is_bot  -- See Note [Floating from a RHS]\n                     && any isId bndrs\n                  then lvlMFE  body_env True body\n                  else lvlExpr body_env      body\n       ; return (mkLams bndrs' body') }\n  where\n    (bndrs, body)     | Just join_arity <- mb_join_arity\n                      = collectNAnnBndrs join_arity rhs\n                      | otherwise\n                      = collectAnnBndrs rhs\n    (env1, bndrs1)    = substBndrsSL NonRecursive env bndrs\n    all_bndrs         = abs_vars ++ bndrs1\n    (body_env, bndrs') | Just _ <- mb_join_arity\n                      = lvlJoinBndrs env1 dest_lvl rec all_bndrs\n                      | otherwise\n                      = case lvlLamBndrs env1 dest_lvl all_bndrs of\n                          (env2, bndrs') -> (placeJoinCeiling env2, bndrs')\n        -- The important thing here is that we call lvlLamBndrs on\n        -- all these binders at once (abs_vars and bndrs), so they\n        -- all get the same major level.  Otherwise we create stupid\n        -- let-bindings inside, joyfully thinking they can float; but\n        -- in the end they don't because we never float bindings in\n        -- between lambdas\n\n{- Note [Floating from a RHS]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen floating the RHS of a let-binding, we don't always want to apply\nlvlMFE to the body of a lambda, as we usually do, because the entire\nbinding body is already going to the right place (dest_lvl).\n\nA particular example is the top level.  Consider\n   concat = /\\ a -> foldr ..a.. (++) []\nWe don't want to float the body of the lambda to get\n   lvl    = /\\ a -> foldr ..a.. (++) []\n   concat = /\\ a -> lvl a\nThat would be stupid.\n\nPreviously this was avoided in a much nastier way, by testing strict_ctxt\nin float_me in lvlMFE.  But that wasn't even right because it would fail\nto float out the error sub-expression in\n    f = \\x. case x of\n              True  -> error (\"blah\" ++ show x)\n              False -> ...\n\nBut we must be careful:\n\n* If we had\n    f = \\x -> factorial 20\n  we /would/ want to float that (factorial 20) out!  Functions are treated\n  differently: see the use of isFunction in the calls to destLevel. If\n  there are only type lambdas, then destLevel will say \"go to top, and\n  abstract over the free tyvars\" and we don't want that here.\n\n* But if we had\n    f = \\x -> error (...x....)\n  we would NOT want to float the bottoming expression out to give\n    lvl = \\x -> error (...x...)\n    f = \\x -> lvl x\n\nConclusion: use lvlMFE if there are\n  * any value lambdas in the original function, and\n  * this is not a bottoming function (the is_bot argument)\nUse lvlExpr otherwise.  A little subtle, and I got it wrong at least twice\n(e.g. Trac #13369).\n-}\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Deciding floatability}\n*                                                                      *\n************************************************************************\n-}\n\nsubstAndLvlBndrs :: RecFlag -> LevelEnv -> Level -> [InVar] -> (LevelEnv, [LevelledBndr])\nsubstAndLvlBndrs is_rec env lvl bndrs\n  = lvlBndrs subst_env lvl subst_bndrs\n  where\n    (subst_env, subst_bndrs) = substBndrsSL is_rec env bndrs\n\nsubstBndrsSL :: RecFlag -> LevelEnv -> [InVar] -> (LevelEnv, [OutVar])\n-- So named only to avoid the name clash with CoreSubst.substBndrs\nsubstBndrsSL is_rec env@(LE { le_subst = subst, le_env = id_env }) bndrs\n  = ( env { le_subst    = subst'\n          , le_env      = foldl' add_id  id_env (bndrs `zip` bndrs') }\n    , bndrs')\n  where\n    (subst', bndrs') = case is_rec of\n                         NonRecursive -> substBndrs    subst bndrs\n                         Recursive    -> substRecBndrs subst bndrs\n\nlvlLamBndrs :: LevelEnv -> Level -> [OutVar] -> (LevelEnv, [LevelledBndr])\n-- Compute the levels for the binders of a lambda group\nlvlLamBndrs env lvl bndrs\n  = lvlBndrs env new_lvl bndrs\n  where\n    new_lvl | any is_major bndrs = incMajorLvl lvl\n            | otherwise          = incMinorLvl lvl\n\n    is_major bndr = isId bndr && not (isProbablyOneShotLambda bndr)\n       -- The \"probably\" part says \"don't float things out of a\n       -- probable one-shot lambda\"\n       -- See Note [Computing one-shot info] in Demand.hs\n\nlvlJoinBndrs :: LevelEnv -> Level -> RecFlag -> [OutVar]\n             -> (LevelEnv, [LevelledBndr])\nlvlJoinBndrs env lvl rec bndrs\n  = lvlBndrs env new_lvl bndrs\n  where\n    new_lvl | isRec rec = incMajorLvl lvl\n            | otherwise = incMinorLvl lvl\n      -- Non-recursive join points are one-shot; recursive ones are not\n\nlvlBndrs :: LevelEnv -> Level -> [CoreBndr] -> (LevelEnv, [LevelledBndr])\n-- The binders returned are exactly the same as the ones passed,\n-- apart from applying the substitution, but they are now paired\n-- with a (StayPut level)\n--\n-- The returned envt has le_ctxt_lvl updated to the new_lvl\n--\n-- All the new binders get the same level, because\n-- any floating binding is either going to float past\n-- all or none.  We never separate binders.\nlvlBndrs env@(LE { le_lvl_env = lvl_env }) new_lvl bndrs\n  = ( env { le_ctxt_lvl = new_lvl\n          , le_join_ceil = new_lvl\n          , le_lvl_env  = addLvls new_lvl lvl_env bndrs }\n    , map (stayPut new_lvl) bndrs)\n\nstayPut :: Level -> OutVar -> LevelledBndr\nstayPut new_lvl bndr = TB bndr (StayPut new_lvl)\n\n  -- Destination level is the max Id level of the expression\n  -- (We'll abstract the type variables, if any.)\ndestLevel :: LevelEnv\n          -> DVarSet    -- Free vars of the term\n          -> TyCoVarSet -- Free in the /type/ of the term\n                        -- (a subset of the previous argument)\n          -> Bool   -- True <=> is function\n          -> Bool   -- True <=> is bottom\n          -> Bool   -- True <=> is a join point\n          -> Level\n-- INVARIANT: if is_join=True then result >= join_ceiling\ndestLevel env fvs fvs_ty is_function is_bot is_join\n  | isTopLvl max_fv_id_level  -- Float even joins if they get to top level\n                              -- See Note [Floating join point bindings]\n  = tOP_LEVEL\n\n  | is_join  -- Never float a join point past the join ceiling\n             -- See Note [Join points] in FloatOut\n  = if max_fv_id_level `ltLvl` join_ceiling\n    then join_ceiling\n    else max_fv_id_level\n\n  | is_bot              -- Send bottoming bindings to the top\n  = as_far_as_poss      -- regardless; see Note [Bottoming floats]\n                        -- Esp Bottoming floats (1)\n\n  | Just n_args <- floatLams env\n  , n_args > 0  -- n=0 case handled uniformly by the 'otherwise' case\n  , is_function\n  , countFreeIds fvs <= n_args\n  = as_far_as_poss  -- Send functions to top level; see\n                    -- the comments with isFunction\n\n  | otherwise = max_fv_id_level\n  where\n    join_ceiling    = joinCeilingLevel env\n    max_fv_id_level = maxFvLevel isId env fvs -- Max over Ids only; the\n                                              -- tyvars will be abstracted\n\n    as_far_as_poss = maxFvLevel' isId env fvs_ty\n                     -- See Note [Floating and kind casts]\n\n{- Note [Floating and kind casts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n   case x of\n     K (co :: * ~# k) -> let v :: Int |> co\n                             v = e\n                         in blah\n\nThen, even if we are abstracting over Ids, or if e is bottom, we can't\nfloat v outside the 'co' binding.  Reason: if we did we'd get\n    v' :: forall k. (Int ~# Age) => Int |> co\nand now 'co' isn't in scope in that type. The underlying reason is\nthat 'co' is a value-level thing and we can't abstract over that in a\ntype (else we'd get a dependent type).  So if v's /type/ mentions 'co'\nwe can't float it out beyond the binding site of 'co'.\n\nThat's why we have this as_far_as_poss stuff.  Usually as_far_as_poss\nis just tOP_LEVEL; but occasionally a coercion variable (which is an\nId) mentioned in type prevents this.\n\nExample Trac #14270 comment:15.\n-}\n\n\nisFunction :: CoreExprWithFVs -> Bool\n-- The idea here is that we want to float *functions* to\n-- the top level.  This saves no work, but\n--      (a) it can make the host function body a lot smaller,\n--              and hence inlinable.\n--      (b) it can also save allocation when the function is recursive:\n--          h = \\x -> letrec f = \\y -> ...f...y...x...\n--                    in f x\n--     becomes\n--          f = \\x y -> ...(f x)...y...x...\n--          h = \\x -> f x x\n--     No allocation for f now.\n-- We may only want to do this if there are sufficiently few free\n-- variables.  We certainly only want to do it for values, and not for\n-- constructors.  So the simple thing is just to look for lambdas\nisFunction (_, AnnLam b e) | isId b    = True\n                           | otherwise = isFunction e\n-- isFunction (_, AnnTick _ e)         = isFunction e  -- dubious\nisFunction _                           = False\n\ncountFreeIds :: DVarSet -> Int\ncountFreeIds = nonDetFoldUDFM add 0 . getUniqDSet\n  -- It's OK to use nonDetFoldUDFM here because we're just counting things.\n  where\n    add :: Var -> Int -> Int\n    add v n | isId v    = n+1\n            | otherwise = n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Free-To-Level Monad}\n*                                                                      *\n************************************************************************\n-}\n\ndata LevelEnv\n  = LE { le_switches :: FloatOutSwitches\n       , le_ctxt_lvl :: Level           -- The current level\n       , le_lvl_env  :: VarEnv Level    -- Domain is *post-cloned* TyVars and Ids\n       , le_join_ceil:: Level           -- Highest level to which joins float\n                                        -- Invariant: always >= le_ctxt_lvl\n\n       -- See Note [le_subst and le_env]\n       , le_subst    :: Subst           -- Domain is pre-cloned TyVars and Ids\n                                        -- The Id -> CoreExpr in the Subst is ignored\n                                        -- (since we want to substitute a LevelledExpr for\n                                        -- an Id via le_env) but we do use the Co/TyVar substs\n       , le_env      :: IdEnv ([OutVar], LevelledExpr)  -- Domain is pre-cloned Ids\n    }\n\n{- Note [le_subst and le_env]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe clone let- and case-bound variables so that they are still distinct\nwhen floated out; hence the le_subst/le_env.  (see point 3 of the\nmodule overview comment).  We also use these envs when making a\nvariable polymorphic because we want to float it out past a big\nlambda.\n\nThe le_subst and le_env always implement the same mapping,\n     in_x :->  out_x a b\nwhere out_x is an OutVar, and a,b are its arguments (when\nwe perform abstraction at the same time as floating).\n\n  le_subst maps to CoreExpr\n  le_env   maps to LevelledExpr\n\nSince the range is always a variable or application, there is never\nany difference between the two, but sadly the types differ.  The\nle_subst is used when substituting in a variable's IdInfo; the le_env\nwhen we find a Var.\n\nIn addition the le_env records a [OutVar] of variables free in the\nOutExpr/LevelledExpr, just so we don't have to call freeVars\nrepeatedly.  This list is always non-empty, and the first element is\nout_x\n\nThe domain of the both envs is *pre-cloned* Ids, though\n\nThe domain of the le_lvl_env is the *post-cloned* Ids\n-}\n\ninitialEnv :: FloatOutSwitches -> LevelEnv\ninitialEnv float_lams\n  = LE { le_switches = float_lams\n       , le_ctxt_lvl = tOP_LEVEL\n       , le_join_ceil = panic \"initialEnv\"\n       , le_lvl_env = emptyVarEnv\n       , le_subst = emptySubst\n       , le_env = emptyVarEnv }\n\naddLvl :: Level -> VarEnv Level -> OutVar -> VarEnv Level\naddLvl dest_lvl env v' = extendVarEnv env v' dest_lvl\n\naddLvls :: Level -> VarEnv Level -> [OutVar] -> VarEnv Level\naddLvls dest_lvl env vs = foldl' (addLvl dest_lvl) env vs\n\nfloatLams :: LevelEnv -> Maybe Int\nfloatLams le = floatOutLambdas (le_switches le)\n\nfloatConsts :: LevelEnv -> Bool\nfloatConsts le = floatOutConstants (le_switches le)\n\nfloatOverSat :: LevelEnv -> Bool\nfloatOverSat le = floatOutOverSatApps (le_switches le)\n\nfloatTopLvlOnly :: LevelEnv -> Bool\nfloatTopLvlOnly le = floatToTopLevelOnly (le_switches le)\n\nincMinorLvlFrom :: LevelEnv -> Level\nincMinorLvlFrom env = incMinorLvl (le_ctxt_lvl env)\n\n-- extendCaseBndrEnv adds the mapping case-bndr->scrut-var if it can\n-- See Note [Binder-swap during float-out]\nextendCaseBndrEnv :: LevelEnv\n                  -> Id                 -- Pre-cloned case binder\n                  -> Expr LevelledBndr  -- Post-cloned scrutinee\n                  -> LevelEnv\nextendCaseBndrEnv le@(LE { le_subst = subst, le_env = id_env })\n                  case_bndr (Var scrut_var)\n  = le { le_subst   = extendSubstWithVar subst case_bndr scrut_var\n       , le_env     = add_id id_env (case_bndr, scrut_var) }\nextendCaseBndrEnv env _ _ = env\n\n-- See Note [Join ceiling]\nplaceJoinCeiling :: LevelEnv -> LevelEnv\nplaceJoinCeiling le@(LE { le_ctxt_lvl = lvl })\n  = le { le_ctxt_lvl = lvl', le_join_ceil = lvl' }\n  where\n    lvl' = asJoinCeilLvl (incMinorLvl lvl)\n\nmaxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level\nmaxFvLevel max_me env var_set\n  = foldDVarSet (maxIn max_me env) tOP_LEVEL var_set\n\nmaxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level\n-- Same but for TyCoVarSet\nmaxFvLevel' max_me env var_set\n  = nonDetFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set\n\nmaxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level\nmaxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl\n  = case lookupVarEnv id_env in_var of\n      Just (abs_vars, _) -> foldr max_out lvl abs_vars\n      Nothing            -> max_out in_var lvl\n  where\n    max_out out_var lvl\n        | max_me out_var = case lookupVarEnv lvl_env out_var of\n                                Just lvl' -> maxLvl lvl' lvl\n                                Nothing   -> lvl\n        | otherwise = lvl       -- Ignore some vars depending on max_me\n\nlookupVar :: LevelEnv -> Id -> LevelledExpr\nlookupVar le v = case lookupVarEnv (le_env le) v of\n                    Just (_, expr) -> expr\n                    _              -> Var v\n\n-- Level to which join points are allowed to float (boundary of current tail\n-- context). See Note [Join ceiling]\njoinCeilingLevel :: LevelEnv -> Level\njoinCeilingLevel = le_join_ceil\n\nabstractVars :: Level -> LevelEnv -> DVarSet -> [OutVar]\n        -- Find the variables in fvs, free vars of the target expression,\n        -- whose level is greater than the destination level\n        -- These are the ones we are going to abstract out\n        --\n        -- Note that to get reproducible builds, the variables need to be\n        -- abstracted in deterministic order, not dependent on the values of\n        -- Uniques. This is achieved by using DVarSets, deterministic free\n        -- variable computation and deterministic sort.\n        -- See Note [Unique Determinism] in Unique for explanation of why\n        -- Uniques are not deterministic.\nabstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs\n  =  -- NB: sortQuantVars might not put duplicates next to each other\n    map zap $ sortQuantVars $\n    filter abstract_me      $\n    dVarSetElems            $\n    closeOverKindsDSet      $\n    substDVarSet subst in_fvs\n        -- NB: it's important to call abstract_me only on the OutIds the\n        -- come from substDVarSet (not on fv, which is an InId)\n  where\n    abstract_me v = case lookupVarEnv lvl_env v of\n                        Just lvl -> dest_lvl `ltLvl` lvl\n                        Nothing  -> False\n\n        -- We are going to lambda-abstract, so nuke any IdInfo,\n        -- and add the tyvars of the Id (if necessary)\n    zap v | isId v = WARN( isStableUnfolding (idUnfolding v) ||\n                           not (isEmptyRuleInfo (idSpecialisation v)),\n                           text \"absVarsOf: discarding info on\" <+> ppr v )\n                     setIdInfo v vanillaIdInfo\n          | otherwise = v\n\ntype LvlM result = UniqSM result\n\ninitLvl :: UniqSupply -> UniqSM a -> a\ninitLvl = initUs_\n\nnewPolyBndrs :: Level -> LevelEnv -> [OutVar] -> [InId]\n             -> LvlM (LevelEnv, [OutId])\n-- The envt is extended to bind the new bndrs to dest_lvl, but\n-- the le_ctxt_lvl is unaffected\nnewPolyBndrs dest_lvl\n             env@(LE { le_lvl_env = lvl_env, le_subst = subst, le_env = id_env })\n             abs_vars bndrs\n = ASSERT( all (not . isCoVar) bndrs )   -- What would we add to the CoSubst in this case. No easy answer.\n   do { uniqs <- getUniquesM\n      ; let new_bndrs = zipWith mk_poly_bndr bndrs uniqs\n            bndr_prs  = bndrs `zip` new_bndrs\n            env' = env { le_lvl_env = addLvls dest_lvl lvl_env new_bndrs\n                       , le_subst   = foldl' add_subst subst   bndr_prs\n                       , le_env     = foldl' add_id    id_env  bndr_prs }\n      ; return (env', new_bndrs) }\n  where\n    add_subst env (v, v') = extendIdSubst env v (mkVarApps (Var v') abs_vars)\n    add_id    env (v, v') = extendVarEnv env v ((v':abs_vars), mkVarApps (Var v') abs_vars)\n\n    mk_poly_bndr bndr uniq = transferPolyIdInfo bndr abs_vars $         -- Note [transferPolyIdInfo] in Id.hs\n                             transfer_join_info bndr $\n                             mkSysLocalOrCoVar (mkFastString str) uniq poly_ty\n                           where\n                             str     = \"poly_\" ++ occNameString (getOccName bndr)\n                             poly_ty = mkLamTypes abs_vars (CoreSubst.substTy subst (idType bndr))\n\n    -- If we are floating a join point to top level, it stops being\n    -- a join point.  Otherwise it continues to be a join point,\n    -- but we may need to adjust its arity\n    dest_is_top = isTopLvl dest_lvl\n    transfer_join_info bndr new_bndr\n      | Just join_arity <- isJoinId_maybe bndr\n      , not dest_is_top\n      = new_bndr `asJoinId` join_arity + length abs_vars\n      | otherwise\n      = new_bndr\n\nnewLvlVar :: LevelledExpr        -- The RHS of the new binding\n          -> Maybe JoinArity     -- Its join arity, if it is a join point\n          -> Bool                -- True <=> the RHS looks like (makeStatic ...)\n          -> LvlM Id\nnewLvlVar lvld_rhs join_arity_maybe is_mk_static\n  = do { uniq <- getUniqueM\n       ; return (add_join_info (mk_id uniq rhs_ty))\n       }\n  where\n    add_join_info var = var `asJoinId_maybe` join_arity_maybe\n    de_tagged_rhs = deTagExpr lvld_rhs\n    rhs_ty        = exprType de_tagged_rhs\n\n    mk_id uniq rhs_ty\n      -- See Note [Grand plan for static forms] in StaticPtrTable.\n      | is_mk_static\n      = mkExportedVanillaId (mkSystemVarName uniq (mkFastString \"static_ptr\"))\n                            rhs_ty\n      | otherwise\n      = mkSysLocalOrCoVar (mkFastString \"lvl\") uniq rhs_ty\n\ncloneCaseBndrs :: LevelEnv -> Level -> [Var] -> LvlM (LevelEnv, [Var])\ncloneCaseBndrs env@(LE { le_subst = subst, le_lvl_env = lvl_env, le_env = id_env })\n               new_lvl vs\n  = do { us <- getUniqueSupplyM\n       ; let (subst', vs') = cloneBndrs subst us vs\n             env' = env { le_ctxt_lvl  = new_lvl\n                        , le_join_ceil = new_lvl\n                        , le_lvl_env   = addLvls new_lvl lvl_env vs'\n                        , le_subst     = subst'\n                        , le_env       = foldl' add_id id_env (vs `zip` vs') }\n\n       ; return (env', vs') }\n\ncloneLetVars :: RecFlag -> LevelEnv -> Level -> [InVar]\n             -> LvlM (LevelEnv, [OutVar])\n-- See Note [Need for cloning during float-out]\n-- Works for Ids bound by let(rec)\n-- The dest_lvl is attributed to the binders in the new env,\n-- but cloneVars doesn't affect the le_ctxt_lvl of the incoming env\ncloneLetVars is_rec\n          env@(LE { le_subst = subst, le_lvl_env = lvl_env, le_env = id_env })\n          dest_lvl vs\n  = do { us <- getUniqueSupplyM\n       ; let vs1  = map zap vs\n                      -- See Note [Zapping the demand info]\n             (subst', vs2) = case is_rec of\n                               NonRecursive -> cloneBndrs      subst us vs1\n                               Recursive    -> cloneRecIdBndrs subst us vs1\n             prs  = vs `zip` vs2\n             env' = env { le_lvl_env = addLvls dest_lvl lvl_env vs2\n                        , le_subst   = subst'\n                        , le_env     = foldl' add_id id_env prs }\n\n       ; return (env', vs2) }\n  where\n    zap :: Var -> Var\n    zap v | isId v    = zap_join (zapIdDemandInfo v)\n          | otherwise = v\n\n    zap_join | isTopLvl dest_lvl = zapJoinId\n             | otherwise         = id\n\nadd_id :: IdEnv ([Var], LevelledExpr) -> (Var, Var) -> IdEnv ([Var], LevelledExpr)\nadd_id id_env (v, v1)\n  | isTyVar v = delVarEnv    id_env v\n  | otherwise = extendVarEnv id_env v ([v1], ASSERT(not (isCoVar v1)) Var v1)\n\n{-\nNote [Zapping the demand info]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nVERY IMPORTANT: we must zap the demand info if the thing is going to\nfloat out, because it may be less demanded than at its original\nbinding site.  Eg\n   f :: Int -> Int\n   f x = let v = 3*4 in v+x\nHere v is strict; but if we float v to top level, it isn't any more.\n\nSimilarly, if we're floating a join point, it won't be one anymore, so we zap\njoin point information as well.\n-}\n", "num_lines": 1723}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[SimplCore]{Driver for simplifying @Core@ programs}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule SimplCore ( core2core, simplifyExpr ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport CoreSyn\nimport HscTypes\nimport CSE              ( cseProgram )\nimport Rules            ( mkRuleBase, unionRuleBase,\n                          extendRuleBaseList, ruleCheckProgram, addRuleInfo,\n                          getRules )\nimport PprCore          ( pprCoreBindings, pprCoreExpr )\nimport OccurAnal        ( occurAnalysePgm, occurAnalyseExpr )\nimport IdInfo\nimport CoreStats        ( coreBindsSize, coreBindsStats, exprSize )\nimport CoreUtils        ( mkTicks, stripTicksTop )\nimport CoreLint         ( endPass, lintPassResult, dumpPassResult,\n                          lintAnnots )\nimport Simplify         ( simplTopBinds, simplExpr, simplRules )\nimport SimplUtils       ( simplEnvForGHCi, activeRule, activeUnfolding )\nimport SimplEnv\nimport SimplMonad\nimport CoreMonad\nimport qualified ErrUtils as Err\nimport FloatIn          ( floatInwards )\nimport FloatOut         ( floatOutwards )\nimport FamInstEnv\nimport Id\nimport ErrUtils         ( withTiming )\nimport BasicTypes       ( CompilerPhase(..), isDefaultInlinePragma, defaultInlinePragma )\nimport VarSet\nimport VarEnv\nimport LiberateCase     ( liberateCase )\nimport SAT              ( doStaticArgs )\nimport Specialise       ( specProgram)\nimport SpecConstr       ( specConstrProgram)\nimport DmdAnal          ( dmdAnalProgram )\nimport CallArity        ( callArityAnalProgram )\nimport Exitify          ( exitifyProgram )\nimport WorkWrap         ( wwTopBinds )\nimport SrcLoc\nimport Util\nimport Module\nimport Plugins          ( withPlugins, installCoreToDos )\nimport DynamicLoading  -- ( initializePlugins )\n\nimport UniqSupply       ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )\nimport UniqFM\nimport Outputable\nimport Control.Monad\nimport qualified GHC.LanguageExtensions as LangExt\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The driver for the simplifier}\n*                                                                      *\n************************************************************************\n-}\n\ncore2core :: HscEnv -> ModGuts -> IO ModGuts\ncore2core hsc_env guts@(ModGuts { mg_module  = mod\n                                , mg_loc     = loc\n                                , mg_deps    = deps\n                                , mg_rdr_env = rdr_env })\n  = do { us <- mkSplitUniqSupply 's'\n       -- make sure all plugins are loaded\n\n       ; let builtin_passes = getCoreToDo dflags\n             orph_mods = mkModuleSet (mod : dep_orphs deps)\n       ;\n       ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base us mod\n                                    orph_mods print_unqual loc $\n                           do { hsc_env' <- getHscEnv\n                              ; dflags' <- liftIO $ initializePlugins hsc_env'\n                                                      (hsc_dflags hsc_env')\n                              ; all_passes <- withPlugins dflags'\n                                                installCoreToDos\n                                                builtin_passes\n                              ; runCorePasses all_passes guts }\n\n       ; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_stats\n             \"Grand total simplifier statistics\"\n             (pprSimplCount stats)\n\n       ; return guts2 }\n  where\n    dflags         = hsc_dflags hsc_env\n    home_pkg_rules = hptRules hsc_env (dep_mods deps)\n    hpt_rule_base  = mkRuleBase home_pkg_rules\n    print_unqual   = mkPrintUnqualified dflags rdr_env\n    -- mod: get the module out of the current HscEnv so we can retrieve it from the monad.\n    -- This is very convienent for the users of the monad (e.g. plugins do not have to\n    -- consume the ModGuts to find the module) but somewhat ugly because mg_module may\n    -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which\n    -- would mean our cached value would go out of date.\n\n{-\n************************************************************************\n*                                                                      *\n           Generating the main optimisation pipeline\n*                                                                      *\n************************************************************************\n-}\n\ngetCoreToDo :: DynFlags -> [CoreToDo]\ngetCoreToDo dflags\n  = flatten_todos core_todo\n  where\n    opt_level     = optLevel           dflags\n    phases        = simplPhases        dflags\n    max_iter      = maxSimplIterations dflags\n    rule_check    = ruleCheck          dflags\n    call_arity    = gopt Opt_CallArity                    dflags\n    exitification = gopt Opt_Exitification                dflags\n    strictness    = gopt Opt_Strictness                   dflags\n    full_laziness = gopt Opt_FullLaziness                 dflags\n    do_specialise = gopt Opt_Specialise                   dflags\n    do_float_in   = gopt Opt_FloatIn                      dflags\n    cse           = gopt Opt_CSE                          dflags\n    spec_constr   = gopt Opt_SpecConstr                   dflags\n    liberate_case = gopt Opt_LiberateCase                 dflags\n    late_dmd_anal = gopt Opt_LateDmdAnal                  dflags\n    late_specialise = gopt Opt_LateSpecialise             dflags\n    static_args   = gopt Opt_StaticArgumentTransformation dflags\n    rules_on      = gopt Opt_EnableRewriteRules           dflags\n    eta_expand_on = gopt Opt_DoLambdaEtaExpansion         dflags\n    ww_on         = gopt Opt_WorkerWrapper                dflags\n    static_ptrs   = xopt LangExt.StaticPointers           dflags\n\n    maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)\n\n    maybe_strictness_before phase\n      = runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness\n\n    base_mode = SimplMode { sm_phase      = panic \"base_mode\"\n                          , sm_names      = []\n                          , sm_dflags     = dflags\n                          , sm_rules      = rules_on\n                          , sm_eta_expand = eta_expand_on\n                          , sm_inline     = True\n                          , sm_case_case  = True }\n\n    simpl_phase phase names iter\n      = CoreDoPasses\n      $   [ maybe_strictness_before phase\n          , CoreDoSimplify iter\n                (base_mode { sm_phase = Phase phase\n                           , sm_names = names })\n\n          , maybe_rule_check (Phase phase) ]\n\n    simpl_phases = CoreDoPasses [ simpl_phase phase [\"main\"] max_iter\n                                | phase <- [phases, phases-1 .. 1] ]\n\n\n        -- initial simplify: mk specialiser happy: minimum effort please\n    simpl_gently = CoreDoSimplify max_iter\n                       (base_mode { sm_phase = InitialPhase\n                                  , sm_names = [\"Gentle\"]\n                                  , sm_rules = rules_on   -- Note [RULEs enabled in SimplGently]\n                                  , sm_inline = True\n                                              -- See Note [Inline in InitialPhase]\n                                  , sm_case_case = False })\n                          -- Don't do case-of-case transformations.\n                          -- This makes full laziness work better\n\n    strictness_pass = if ww_on\n                       then [CoreDoStrictness,CoreDoWorkerWrapper]\n                       else [CoreDoStrictness]\n\n\n    -- New demand analyser\n    demand_analyser = (CoreDoPasses (\n                           strictness_pass ++\n                           [simpl_phase 0 [\"post-worker-wrapper\"] max_iter]\n                           ))\n\n    -- Static forms are moved to the top level with the FloatOut pass.\n    -- See Note [Grand plan for static forms] in StaticPtrTable.\n    static_ptrs_float_outwards =\n      runWhen static_ptrs $ CoreDoPasses\n        [ simpl_gently -- Float Out can't handle type lets (sometimes created\n                       -- by simpleOptPgm via mkParallelBindings)\n        , CoreDoFloatOutwards FloatOutSwitches\n          { floatOutLambdas   = Just 0\n          , floatOutConstants = True\n          , floatOutOverSatApps = False\n          , floatToTopLevelOnly = True\n          }\n        ]\n\n    core_todo =\n     if opt_level == 0 then\n       [ static_ptrs_float_outwards,\n         CoreDoSimplify max_iter\n             (base_mode { sm_phase = Phase 0\n                        , sm_names = [\"Non-opt simplification\"] })\n       ]\n\n     else {- opt_level >= 1 -} [\n\n    -- We want to do the static argument transform before full laziness as it\n    -- may expose extra opportunities to float things outwards. However, to fix\n    -- up the output of the transformation we need at do at least one simplify\n    -- after this before anything else\n        runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),\n\n        -- initial simplify: mk specialiser happy: minimum effort please\n        simpl_gently,\n\n        -- Specialisation is best done before full laziness\n        -- so that overloaded functions have all their dictionary lambdas manifest\n        runWhen do_specialise CoreDoSpecialising,\n\n        if full_laziness then\n           CoreDoFloatOutwards FloatOutSwitches {\n                                 floatOutLambdas   = Just 0,\n                                 floatOutConstants = True,\n                                 floatOutOverSatApps = False,\n                                 floatToTopLevelOnly = False }\n                -- Was: gentleFloatOutSwitches\n                --\n                -- I have no idea why, but not floating constants to\n                -- top level is very bad in some cases.\n                --\n                -- Notably: p_ident in spectral/rewrite\n                --          Changing from \"gentle\" to \"constantsOnly\"\n                --          improved rewrite's allocation by 19%, and\n                --          made 0.0% difference to any other nofib\n                --          benchmark\n                --\n                -- Not doing floatOutOverSatApps yet, we'll do\n                -- that later on when we've had a chance to get more\n                -- accurate arity information.  In fact it makes no\n                -- difference at all to performance if we do it here,\n                -- but maybe we save some unnecessary to-and-fro in\n                -- the simplifier.\n        else\n           -- Even with full laziness turned off, we still need to float static\n           -- forms to the top level. See Note [Grand plan for static forms] in\n           -- StaticPtrTable.\n           static_ptrs_float_outwards,\n\n        simpl_phases,\n\n                -- Phase 0: allow all Ids to be inlined now\n                -- This gets foldr inlined before strictness analysis\n\n                -- At least 3 iterations because otherwise we land up with\n                -- huge dead expressions because of an infelicity in the\n                -- simplifier.\n                --      let k = BIG in foldr k z xs\n                -- ==>  let k = BIG in letrec go = \\xs -> ...(k x).... in go xs\n                -- ==>  let k = BIG in letrec go = \\xs -> ...(BIG x).... in go xs\n                -- Don't stop now!\n        simpl_phase 0 [\"main\"] (max max_iter 3),\n\n        runWhen do_float_in CoreDoFloatInwards,\n            -- Run float-inwards immediately before the strictness analyser\n            -- Doing so pushes bindings nearer their use site and hence makes\n            -- them more likely to be strict. These bindings might only show\n            -- up after the inlining from simplification.  Example in fulsom,\n            -- Csg.calc, where an arg of timesDouble thereby becomes strict.\n\n        runWhen call_arity $ CoreDoPasses\n            [ CoreDoCallArity\n            , simpl_phase 0 [\"post-call-arity\"] max_iter\n            ],\n\n        runWhen strictness demand_analyser,\n\n        runWhen exitification CoreDoExitify,\n            -- See note [Placement of the exitification pass]\n\n        runWhen full_laziness $\n           CoreDoFloatOutwards FloatOutSwitches {\n                                 floatOutLambdas     = floatLamArgs dflags,\n                                 floatOutConstants   = True,\n                                 floatOutOverSatApps = True,\n                                 floatToTopLevelOnly = False },\n                -- nofib/spectral/hartel/wang doubles in speed if you\n                -- do full laziness late in the day.  It only happens\n                -- after fusion and other stuff, so the early pass doesn't\n                -- catch it.  For the record, the redex is\n                --        f_el22 (f_el21 r_midblock)\n\n\n        runWhen cse CoreCSE,\n                -- We want CSE to follow the final full-laziness pass, because it may\n                -- succeed in commoning up things floated out by full laziness.\n                -- CSE used to rely on the no-shadowing invariant, but it doesn't any more\n\n        runWhen do_float_in CoreDoFloatInwards,\n\n        maybe_rule_check (Phase 0),\n\n                -- Case-liberation for -O2.  This should be after\n                -- strictness analysis and the simplification which follows it.\n        runWhen liberate_case (CoreDoPasses [\n            CoreLiberateCase,\n            simpl_phase 0 [\"post-liberate-case\"] max_iter\n            ]),         -- Run the simplifier after LiberateCase to vastly\n                        -- reduce the possibility of shadowing\n                        -- Reason: see Note [Shadowing] in SpecConstr.hs\n\n        runWhen spec_constr CoreDoSpecConstr,\n\n        maybe_rule_check (Phase 0),\n\n        runWhen late_specialise\n          (CoreDoPasses [ CoreDoSpecialising\n                        , simpl_phase 0 [\"post-late-spec\"] max_iter]),\n\n        -- LiberateCase can yield new CSE opportunities because it peels\n        -- off one layer of a recursive function (concretely, I saw this\n        -- in wheel-sieve1), and I'm guessing that SpecConstr can too\n        -- And CSE is a very cheap pass. So it seems worth doing here.\n        runWhen ((liberate_case || spec_constr) && cse) CoreCSE,\n\n        -- Final clean-up simplification:\n        simpl_phase 0 [\"final\"] max_iter,\n\n        runWhen late_dmd_anal $ CoreDoPasses (\n            strictness_pass ++\n            [simpl_phase 0 [\"post-late-ww\"] max_iter]\n          ),\n\n        -- Final run of the demand_analyser, ensures that one-shot thunks are\n        -- really really one-shot thunks. Only needed if the demand analyser\n        -- has run at all. See Note [Final Demand Analyser run] in DmdAnal\n        -- It is EXTREMELY IMPORTANT to run this pass, otherwise execution\n        -- can become /exponentially/ more expensive. See Trac #11731, #12996.\n        runWhen (strictness || late_dmd_anal) CoreDoStrictness,\n\n        maybe_rule_check (Phase 0)\n     ]\n\n    -- Remove 'CoreDoNothing' and flatten 'CoreDoPasses' for clarity.\n    flatten_todos [] = []\n    flatten_todos (CoreDoNothing : rest) = flatten_todos rest\n    flatten_todos (CoreDoPasses passes : rest) =\n      flatten_todos passes ++ flatten_todos rest\n    flatten_todos (todo : rest) = todo : flatten_todos rest\n\n{- Note [Inline in InitialPhase]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn GHC 8 and earlier we did not inline anything in the InitialPhase. But that is\nconfusing for users because when they say INLINE they expect the function to inline\nright away.\n\nSo now we do inlining immediately, even in the InitialPhase, assuming that the\nId's Activation allows it.\n\nThis is a surprisingly big deal. Compiler performance improved a lot\nwhen I made this change:\n\n   perf/compiler/T5837.run            T5837 [stat too good] (normal)\n   perf/compiler/parsing001.run       parsing001 [stat too good] (normal)\n   perf/compiler/T12234.run           T12234 [stat too good] (optasm)\n   perf/compiler/T9020.run            T9020 [stat too good] (optasm)\n   perf/compiler/T3064.run            T3064 [stat too good] (normal)\n   perf/compiler/T9961.run            T9961 [stat too good] (normal)\n   perf/compiler/T13056.run           T13056 [stat too good] (optasm)\n   perf/compiler/T9872d.run           T9872d [stat too good] (normal)\n   perf/compiler/T783.run             T783 [stat too good] (normal)\n   perf/compiler/T12227.run           T12227 [stat too good] (normal)\n   perf/should_run/lazy-bs-alloc.run  lazy-bs-alloc [stat too good] (normal)\n   perf/compiler/T1969.run            T1969 [stat too good] (normal)\n   perf/compiler/T9872a.run           T9872a [stat too good] (normal)\n   perf/compiler/T9872c.run           T9872c [stat too good] (normal)\n   perf/compiler/T9872b.run           T9872b [stat too good] (normal)\n   perf/compiler/T9872d.run           T9872d [stat too good] (normal)\n\nNote [RULEs enabled in SimplGently]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRULES are enabled when doing \"gentle\" simplification.  Two reasons:\n\n  * We really want the class-op cancellation to happen:\n        op (df d1 d2) --> $cop3 d1 d2\n    because this breaks the mutual recursion between 'op' and 'df'\n\n  * I wanted the RULE\n        lift String ===> ...\n    to work in Template Haskell when simplifying\n    splices, so we get simpler code for literal strings\n\nBut watch out: list fusion can prevent floating.  So use phase control\nto switch off those rules until after floating.\n\n************************************************************************\n*                                                                      *\n                  The CoreToDo interpreter\n*                                                                      *\n************************************************************************\n-}\n\nrunCorePasses :: [CoreToDo] -> ModGuts -> CoreM ModGuts\nrunCorePasses passes guts\n  = foldM do_pass guts passes\n  where\n    do_pass guts CoreDoNothing = return guts\n    do_pass guts (CoreDoPasses ps) = runCorePasses ps guts\n    do_pass guts pass\n       = withTiming getDynFlags\n                    (ppr pass <+> brackets (ppr mod))\n                    (const ()) $ do\n            { guts' <- lintAnnots (ppr pass) (doCorePass pass) guts\n            ; endPass pass (mg_binds guts') (mg_rules guts')\n            ; return guts' }\n\n    mod = mg_module guts\n\ndoCorePass :: CoreToDo -> ModGuts -> CoreM ModGuts\ndoCorePass pass@(CoreDoSimplify {})  = {-# SCC \"Simplify\" #-}\n                                       simplifyPgm pass\n\ndoCorePass CoreCSE                   = {-# SCC \"CommonSubExpr\" #-}\n                                       doPass cseProgram\n\ndoCorePass CoreLiberateCase          = {-# SCC \"LiberateCase\" #-}\n                                       doPassD liberateCase\n\ndoCorePass CoreDoFloatInwards        = {-# SCC \"FloatInwards\" #-}\n                                       floatInwards\n\ndoCorePass (CoreDoFloatOutwards f)   = {-# SCC \"FloatOutwards\" #-}\n                                       doPassDUM (floatOutwards f)\n\ndoCorePass CoreDoStaticArgs          = {-# SCC \"StaticArgs\" #-}\n                                       doPassU doStaticArgs\n\ndoCorePass CoreDoCallArity           = {-# SCC \"CallArity\" #-}\n                                       doPassD callArityAnalProgram\n\ndoCorePass CoreDoExitify             = {-# SCC \"Exitify\" #-}\n                                       doPass exitifyProgram\n\ndoCorePass CoreDoStrictness          = {-# SCC \"NewStranal\" #-}\n                                       doPassDFM dmdAnalProgram\n\ndoCorePass CoreDoWorkerWrapper       = {-# SCC \"WorkWrap\" #-}\n                                       doPassDFU wwTopBinds\n\ndoCorePass CoreDoSpecialising        = {-# SCC \"Specialise\" #-}\n                                       specProgram\n\ndoCorePass CoreDoSpecConstr          = {-# SCC \"SpecConstr\" #-}\n                                       specConstrProgram\n\ndoCorePass CoreDoPrintCore              = observe   printCore\ndoCorePass (CoreDoRuleCheck phase pat)  = ruleCheckPass phase pat\ndoCorePass CoreDoNothing                = return\ndoCorePass (CoreDoPasses passes)        = runCorePasses passes\n\n#if defined(GHCI)\ndoCorePass (CoreDoPluginPass _ pass) = {-# SCC \"Plugin\" #-} pass\n#else\ndoCorePass pass@CoreDoPluginPass {}  = pprPanic \"doCorePass\" (ppr pass)\n#endif\n\ndoCorePass pass@CoreDesugar          = pprPanic \"doCorePass\" (ppr pass)\ndoCorePass pass@CoreDesugarOpt       = pprPanic \"doCorePass\" (ppr pass)\ndoCorePass pass@CoreTidy             = pprPanic \"doCorePass\" (ppr pass)\ndoCorePass pass@CorePrep             = pprPanic \"doCorePass\" (ppr pass)\ndoCorePass pass@CoreOccurAnal        = pprPanic \"doCorePass\" (ppr pass)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Core pass combinators}\n*                                                                      *\n************************************************************************\n-}\n\nprintCore :: DynFlags -> CoreProgram -> IO ()\nprintCore dflags binds\n    = Err.dumpIfSet dflags True \"Print Core\" (pprCoreBindings binds)\n\nruleCheckPass :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts\nruleCheckPass current_phase pat guts =\n    withTiming getDynFlags\n               (text \"RuleCheck\"<+>brackets (ppr $ mg_module guts))\n               (const ()) $ do\n    { rb <- getRuleBase\n    ; dflags <- getDynFlags\n    ; vis_orphs <- getVisibleOrphanMods\n    ; let rule_fn fn = getRules (RuleEnv rb vis_orphs) fn\n                        ++ (mg_rules guts)\n    ; liftIO $ putLogMsg dflags NoReason Err.SevDump noSrcSpan\n                   (defaultDumpStyle dflags)\n                   (ruleCheckProgram current_phase pat\n                      rule_fn (mg_binds guts))\n    ; return guts }\n\ndoPassDUM :: (DynFlags -> UniqSupply -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPassDUM do_pass = doPassM $ \\binds -> do\n    dflags <- getDynFlags\n    us     <- getUniqueSupplyM\n    liftIO $ do_pass dflags us binds\n\ndoPassDM :: (DynFlags -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPassDM do_pass = doPassDUM (\\dflags -> const (do_pass dflags))\n\ndoPassD :: (DynFlags -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPassD do_pass = doPassDM (\\dflags -> return . do_pass dflags)\n\ndoPassDU :: (DynFlags -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPassDU do_pass = doPassDUM (\\dflags us -> return . do_pass dflags us)\n\ndoPassU :: (UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPassU do_pass = doPassDU (const do_pass)\n\ndoPassDFM :: (DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPassDFM do_pass guts = do\n    dflags <- getDynFlags\n    p_fam_env <- getPackageFamInstEnv\n    let fam_envs = (p_fam_env, mg_fam_inst_env guts)\n    doPassM (liftIO . do_pass dflags fam_envs) guts\n\ndoPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPassDFU do_pass guts = do\n    dflags <- getDynFlags\n    us     <- getUniqueSupplyM\n    p_fam_env <- getPackageFamInstEnv\n    let fam_envs = (p_fam_env, mg_fam_inst_env guts)\n    doPass (do_pass dflags fam_envs us) guts\n\n-- Most passes return no stats and don't change rules: these combinators\n-- let us lift them to the full blown ModGuts+CoreM world\ndoPassM :: Monad m => (CoreProgram -> m CoreProgram) -> ModGuts -> m ModGuts\ndoPassM bind_f guts = do\n    binds' <- bind_f (mg_binds guts)\n    return (guts { mg_binds = binds' })\n\ndoPass :: (CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts\ndoPass bind_f guts = return $ guts { mg_binds = bind_f (mg_binds guts) }\n\n-- Observer passes just peek; don't modify the bindings at all\nobserve :: (DynFlags -> CoreProgram -> IO a) -> ModGuts -> CoreM ModGuts\nobserve do_pass = doPassM $ \\binds -> do\n    dflags <- getDynFlags\n    _ <- liftIO $ do_pass dflags binds\n    return binds\n\n{-\n************************************************************************\n*                                                                      *\n        Gentle simplification\n*                                                                      *\n************************************************************************\n-}\n\nsimplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do\n             -> CoreExpr\n             -> IO CoreExpr\n-- simplifyExpr is called by the driver to simplify an\n-- expression typed in at the interactive prompt\n--\n-- Also used by Template Haskell\nsimplifyExpr dflags expr\n  = withTiming (pure dflags) (text \"Simplify [expr]\") (const ()) $\n    do  {\n        ; us <-  mkSplitUniqSupply 's'\n\n        ; let sz = exprSize expr\n\n        ; (expr', counts) <- initSmpl dflags emptyRuleEnv\n                               emptyFamInstEnvs us sz\n                               (simplExprGently (simplEnvForGHCi dflags) expr)\n\n        ; Err.dumpIfSet dflags (dopt Opt_D_dump_simpl_stats dflags)\n                  \"Simplifier statistics\" (pprSimplCount counts)\n\n        ; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl \"Simplified expression\"\n                        (pprCoreExpr expr')\n\n        ; return expr'\n        }\n\nsimplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr\n-- Simplifies an expression\n--      does occurrence analysis, then simplification\n--      and repeats (twice currently) because one pass\n--      alone leaves tons of crud.\n-- Used (a) for user expressions typed in at the interactive prompt\n--      (b) the LHS and RHS of a RULE\n--      (c) Template Haskell splices\n--\n-- The name 'Gently' suggests that the SimplMode is SimplGently,\n-- and in fact that is so.... but the 'Gently' in simplExprGently doesn't\n-- enforce that; it just simplifies the expression twice\n\n-- It's important that simplExprGently does eta reduction; see\n-- Note [Simplifying the left-hand side of a RULE] above.  The\n-- simplifier does indeed do eta reduction (it's in Simplify.completeLam)\n-- but only if -O is on.\n\nsimplExprGently env expr = do\n    expr1 <- simplExpr env (occurAnalyseExpr expr)\n    simplExpr env (occurAnalyseExpr expr1)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The driver for the simplifier}\n*                                                                      *\n************************************************************************\n-}\n\nsimplifyPgm :: CoreToDo -> ModGuts -> CoreM ModGuts\nsimplifyPgm pass guts\n  = do { hsc_env <- getHscEnv\n       ; us <- getUniqueSupplyM\n       ; rb <- getRuleBase\n       ; liftIOWithCount $\n         simplifyPgmIO pass hsc_env us rb guts }\n\nsimplifyPgmIO :: CoreToDo\n              -> HscEnv\n              -> UniqSupply\n              -> RuleBase\n              -> ModGuts\n              -> IO (SimplCount, ModGuts)  -- New bindings\n\nsimplifyPgmIO pass@(CoreDoSimplify max_iterations mode)\n              hsc_env us hpt_rule_base\n              guts@(ModGuts { mg_module = this_mod\n                            , mg_rdr_env = rdr_env\n                            , mg_deps = deps\n                            , mg_binds = binds, mg_rules = rules\n                            , mg_fam_inst_env = fam_inst_env })\n  = do { (termination_msg, it_count, counts_out, guts')\n           <- do_iteration us 1 [] binds rules\n\n        ; Err.dumpIfSet dflags (dopt Opt_D_verbose_core2core dflags &&\n                                dopt Opt_D_dump_simpl_stats  dflags)\n                  \"Simplifier statistics for following pass\"\n                  (vcat [text termination_msg <+> text \"after\" <+> ppr it_count\n                                              <+> text \"iterations\",\n                         blankLine,\n                         pprSimplCount counts_out])\n\n        ; return (counts_out, guts')\n    }\n  where\n    dflags       = hsc_dflags hsc_env\n    print_unqual = mkPrintUnqualified dflags rdr_env\n    simpl_env    = mkSimplEnv mode\n    active_rule  = activeRule mode\n    active_unf   = activeUnfolding mode\n\n    do_iteration :: UniqSupply\n                 -> Int          -- Counts iterations\n                 -> [SimplCount] -- Counts from earlier iterations, reversed\n                 -> CoreProgram  -- Bindings in\n                 -> [CoreRule]   -- and orphan rules\n                 -> IO (String, Int, SimplCount, ModGuts)\n\n    do_iteration us iteration_no counts_so_far binds rules\n        -- iteration_no is the number of the iteration we are\n        -- about to begin, with '1' for the first\n      | iteration_no > max_iterations   -- Stop if we've run out of iterations\n      = WARN( debugIsOn && (max_iterations > 2)\n            , hang (text \"Simplifier bailing out after\" <+> int max_iterations\n                    <+> text \"iterations\"\n                    <+> (brackets $ hsep $ punctuate comma $\n                         map (int . simplCountN) (reverse counts_so_far)))\n                 2 (text \"Size =\" <+> ppr (coreBindsStats binds)))\n\n                -- Subtract 1 from iteration_no to get the\n                -- number of iterations we actually completed\n        return ( \"Simplifier baled out\", iteration_no - 1\n               , totalise counts_so_far\n               , guts { mg_binds = binds, mg_rules = rules } )\n\n      -- Try and force thunks off the binds; significantly reduces\n      -- space usage, especially with -O.  JRS, 000620.\n      | let sz = coreBindsSize binds\n      , () <- sz `seq` ()     -- Force it\n      = do {\n                -- Occurrence analysis\n           let { tagged_binds = {-# SCC \"OccAnal\" #-}\n                     occurAnalysePgm this_mod active_unf active_rule rules\n                                     binds\n               } ;\n           Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal \"Occurrence analysis\"\n                     (pprCoreBindings tagged_binds);\n\n                -- Get any new rules, and extend the rule base\n                -- See Note [Overall plumbing for rules] in Rules.hs\n                -- We need to do this regularly, because simplification can\n                -- poke on IdInfo thunks, which in turn brings in new rules\n                -- behind the scenes.  Otherwise there's a danger we'll simply\n                -- miss the rules for Ids hidden inside imported inlinings\n           eps <- hscEPS hsc_env ;\n           let  { rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps)\n                ; rule_base2 = extendRuleBaseList rule_base1 rules\n                ; fam_envs = (eps_fam_inst_env eps, fam_inst_env)\n                ; vis_orphs = this_mod : dep_orphs deps } ;\n\n                -- Simplify the program\n           ((binds1, rules1), counts1) <-\n             initSmpl dflags (mkRuleEnv rule_base2 vis_orphs) fam_envs us1 sz $\n               do { (floats, env1) <- {-# SCC \"SimplTopBinds\" #-}\n                                      simplTopBinds simpl_env tagged_binds\n\n                      -- Apply the substitution to rules defined in this module\n                      -- for imported Ids.  Eg  RULE map my_f = blah\n                      -- If we have a substitution my_f :-> other_f, we'd better\n                      -- apply it to the rule to, or it'll never match\n                  ; rules1 <- simplRules env1 Nothing rules Nothing\n\n                  ; return (getTopFloatBinds floats, rules1) } ;\n\n                -- Stop if nothing happened; don't dump output\n                -- See Note [Which transformations are innocuous] in CoreMonad\n           if isZeroSimplCount counts1 then\n                return ( \"Simplifier reached fixed point\", iteration_no\n                       , totalise (counts1 : counts_so_far)  -- Include \"free\" ticks\n                       , guts { mg_binds = binds1, mg_rules = rules1 } )\n           else do {\n                -- Short out indirections\n                -- We do this *after* at least one run of the simplifier\n                -- because indirection-shorting uses the export flag on *occurrences*\n                -- and that isn't guaranteed to be ok until after the first run propagates\n                -- stuff from the binding site to its occurrences\n                --\n                -- ToDo: alas, this means that indirection-shorting does not happen at all\n                --       if the simplifier does nothing (not common, I know, but unsavoury)\n           let { binds2 = {-# SCC \"ZapInd\" #-} shortOutIndirections binds1 } ;\n\n                -- Dump the result of this iteration\n           dump_end_iteration dflags print_unqual iteration_no counts1 binds2 rules1 ;\n           lintPassResult hsc_env pass binds2 ;\n\n                -- Loop\n           do_iteration us2 (iteration_no + 1) (counts1:counts_so_far) binds2 rules1\n           } }\n      | otherwise = panic \"do_iteration\"\n      where\n        (us1, us2) = splitUniqSupply us\n\n        -- Remember the counts_so_far are reversed\n        totalise :: [SimplCount] -> SimplCount\n        totalise = foldr (\\c acc -> acc `plusSimplCount` c)\n                         (zeroSimplCount dflags)\n\nsimplifyPgmIO _ _ _ _ _ = panic \"simplifyPgmIO\"\n\n-------------------\ndump_end_iteration :: DynFlags -> PrintUnqualified -> Int\n                   -> SimplCount -> CoreProgram -> [CoreRule] -> IO ()\ndump_end_iteration dflags print_unqual iteration_no counts binds rules\n  = dumpPassResult dflags print_unqual mb_flag hdr pp_counts binds rules\n  where\n    mb_flag | dopt Opt_D_dump_simpl_iterations dflags = Just Opt_D_dump_simpl_iterations\n            | otherwise                               = Nothing\n            -- Show details if Opt_D_dump_simpl_iterations is on\n\n    hdr = text \"Simplifier iteration=\" <> int iteration_no\n    pp_counts = vcat [ text \"---- Simplifier counts for\" <+> hdr\n                     , pprSimplCount counts\n                     , text \"---- End of simplifier counts for\" <+> hdr ]\n\n{-\n************************************************************************\n*                                                                      *\n                Shorting out indirections\n*                                                                      *\n************************************************************************\n\nIf we have this:\n\n        x_local = <expression>\n        ...bindings...\n        x_exported = x_local\n\nwhere x_exported is exported, and x_local is not, then we replace it with this:\n\n        x_exported = <expression>\n        x_local = x_exported\n        ...bindings...\n\nWithout this we never get rid of the x_exported = x_local thing.  This\nsave a gratuitous jump (from \\tr{x_exported} to \\tr{x_local}), and\nmakes strictness information propagate better.  This used to happen in\nthe final phase, but it's tidier to do it here.\n\nNote [Messing up the exported Id's RULES]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must be careful about discarding (obviously) or even merging the\nRULES on the exported Id. The example that went bad on me at one stage\nwas this one:\n\n    iterate :: (a -> a) -> a -> [a]\n        [Exported]\n    iterate = iterateList\n\n    iterateFB c f x = x `c` iterateFB c f (f x)\n    iterateList f x =  x : iterateList f (f x)\n        [Not exported]\n\n    {-# RULES\n    \"iterate\"   forall f x.     iterate f x = build (\\c _n -> iterateFB c f x)\n    \"iterateFB\"                 iterateFB (:) = iterateList\n     #-}\n\nThis got shorted out to:\n\n    iterateList :: (a -> a) -> a -> [a]\n    iterateList = iterate\n\n    iterateFB c f x = x `c` iterateFB c f (f x)\n    iterate f x =  x : iterate f (f x)\n\n    {-# RULES\n    \"iterate\"   forall f x.     iterate f x = build (\\c _n -> iterateFB c f x)\n    \"iterateFB\"                 iterateFB (:) = iterate\n     #-}\n\nAnd now we get an infinite loop in the rule system\n        iterate f x -> build (\\cn -> iterateFB c f x)\n                    -> iterateFB (:) f x\n                    -> iterate f x\n\nOld \"solution\":\n        use rule switching-off pragmas to get rid\n        of iterateList in the first place\n\nBut in principle the user *might* want rules that only apply to the Id\nhe says.  And inline pragmas are similar\n   {-# NOINLINE f #-}\n   f = local\n   local = <stuff>\nThen we do not want to get rid of the NOINLINE.\n\nHence hasShortableIdinfo.\n\n\nNote [Rules and indirection-zapping]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nProblem: what if x_exported has a RULE that mentions something in ...bindings...?\nThen the things mentioned can be out of scope!  Solution\n a) Make sure that in this pass the usage-info from x_exported is\n        available for ...bindings...\n b) If there are any such RULES, rec-ify the entire top-level.\n    It'll get sorted out next time round\n\nOther remarks\n~~~~~~~~~~~~~\nIf more than one exported thing is equal to a local thing (i.e., the\nlocal thing really is shared), then we do one only:\n\\begin{verbatim}\n        x_local = ....\n        x_exported1 = x_local\n        x_exported2 = x_local\n==>\n        x_exported1 = ....\n\n        x_exported2 = x_exported1\n\\end{verbatim}\n\nWe rely on prior eta reduction to simplify things like\n\\begin{verbatim}\n        x_exported = /\\ tyvars -> x_local tyvars\n==>\n        x_exported = x_local\n\\end{verbatim}\nHence,there's a possibility of leaving unchanged something like this:\n\\begin{verbatim}\n        x_local = ....\n        x_exported1 = x_local Int\n\\end{verbatim}\nBy the time we've thrown away the types in STG land this\ncould be eliminated.  But I don't think it's very common\nand it's dangerous to do this fiddling in STG land\nbecause we might elminate a binding that's mentioned in the\nunfolding for something.\n\nNote [Indirection zapping and ticks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nUnfortunately this is another place where we need a special case for\nticks. The following happens quite regularly:\n\n        x_local = <expression>\n        x_exported = tick<x> x_local\n\nWhich we want to become:\n\n        x_exported =  tick<x> <expression>\n\nAs it makes no sense to keep the tick and the expression on separate\nbindings. Note however that that this might increase the ticks scoping\nover the execution of x_local, so we can only do this for floatable\nticks. More often than not, other references will be unfoldings of\nx_exported, and therefore carry the tick anyway.\n-}\n\ntype IndEnv = IdEnv (Id, [Tickish Var]) -- Maps local_id -> exported_id, ticks\n\nshortOutIndirections :: CoreProgram -> CoreProgram\nshortOutIndirections binds\n  | isEmptyVarEnv ind_env = binds\n  | no_need_to_flatten    = binds'                      -- See Note [Rules and indirect-zapping]\n  | otherwise             = [Rec (flattenBinds binds')] -- for this no_need_to_flatten stuff\n  where\n    ind_env            = makeIndEnv binds\n    -- These exported Ids are the subjects  of the indirection-elimination\n    exp_ids            = map fst $ nonDetEltsUFM ind_env\n      -- It's OK to use nonDetEltsUFM here because we forget the ordering\n      -- by immediately converting to a set or check if all the elements\n      -- satisfy a predicate.\n    exp_id_set         = mkVarSet exp_ids\n    no_need_to_flatten = all (null . ruleInfoRules . idSpecialisation) exp_ids\n    binds'             = concatMap zap binds\n\n    zap (NonRec bndr rhs) = [NonRec b r | (b,r) <- zapPair (bndr,rhs)]\n    zap (Rec pairs)       = [Rec (concatMap zapPair pairs)]\n\n    zapPair (bndr, rhs)\n        | bndr `elemVarSet` exp_id_set\n        = []   -- Kill the exported-id binding\n\n        | Just (exp_id, ticks) <- lookupVarEnv ind_env bndr\n        , (exp_id', lcl_id') <- transferIdInfo exp_id bndr\n        =      -- Turn a local-id binding into two bindings\n               --    exp_id = rhs; lcl_id = exp_id\n          [ (exp_id', mkTicks ticks rhs),\n            (lcl_id', Var exp_id') ]\n\n        | otherwise\n        = [(bndr,rhs)]\n\nmakeIndEnv :: [CoreBind] -> IndEnv\nmakeIndEnv binds\n  = foldr add_bind emptyVarEnv binds\n  where\n    add_bind :: CoreBind -> IndEnv -> IndEnv\n    add_bind (NonRec exported_id rhs) env = add_pair (exported_id, rhs) env\n    add_bind (Rec pairs)              env = foldr add_pair env pairs\n\n    add_pair :: (Id,CoreExpr) -> IndEnv -> IndEnv\n    add_pair (exported_id, exported) env\n        | (ticks, Var local_id) <- stripTicksTop tickishFloatable exported\n        , shortMeOut env exported_id local_id\n        = extendVarEnv env local_id (exported_id, ticks)\n    add_pair _ env = env\n\n-----------------\nshortMeOut :: IndEnv -> Id -> Id -> Bool\nshortMeOut ind_env exported_id local_id\n-- The if-then-else stuff is just so I can get a pprTrace to see\n-- how often I don't get shorting out because of IdInfo stuff\n  = if isExportedId exported_id &&              -- Only if this is exported\n\n       isLocalId local_id &&                    -- Only if this one is defined in this\n                                                --      module, so that we *can* change its\n                                                --      binding to be the exported thing!\n\n       not (isExportedId local_id) &&           -- Only if this one is not itself exported,\n                                                --      since the transformation will nuke it\n\n       not (local_id `elemVarEnv` ind_env)      -- Only if not already substituted for\n    then\n        if hasShortableIdInfo exported_id\n        then True       -- See Note [Messing up the exported Id's IdInfo]\n        else WARN( True, text \"Not shorting out:\" <+> ppr exported_id )\n             False\n    else\n        False\n\n-----------------\nhasShortableIdInfo :: Id -> Bool\n-- True if there is no user-attached IdInfo on exported_id,\n-- so we can safely discard it\n-- See Note [Messing up the exported Id's IdInfo]\nhasShortableIdInfo id\n  =  isEmptyRuleInfo (ruleInfo info)\n  && isDefaultInlinePragma (inlinePragInfo info)\n  && not (isStableUnfolding (unfoldingInfo info))\n  where\n     info = idInfo id\n\n-----------------\n{- Note [Transferring IdInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have\n     lcl_id = e; exp_id = lcl_id\n\nand lcl_id has useful IdInfo, we don't want to discard it by going\n     gbl_id = e; lcl_id = gbl_id\n\nInstead, transfer IdInfo from lcl_id to exp_id, specifically\n* (Stable) unfolding\n* Strictness\n* Rules\n* Inline pragma\n\nOverwriting, rather than merging, seems to work ok.\n\nWe also zap the InlinePragma on the lcl_id. It might originally\nhave had a NOINLINE, which we have now transferred; and we really\nwant the lcl_id to inline now that its RHS is trivial!\n-}\n\ntransferIdInfo :: Id -> Id -> (Id, Id)\n-- See Note [Transferring IdInfo]\ntransferIdInfo exported_id local_id\n  = ( modifyIdInfo transfer exported_id\n    , local_id `setInlinePragma` defaultInlinePragma )\n  where\n    local_info = idInfo local_id\n    transfer exp_info = exp_info `setStrictnessInfo`    strictnessInfo local_info\n                                 `setUnfoldingInfo`     unfoldingInfo local_info\n                                 `setInlinePragInfo`    inlinePragInfo local_info\n                                 `setRuleInfo`          addRuleInfo (ruleInfo exp_info) new_info\n    new_info = setRuleInfoHead (idName exported_id)\n                               (ruleInfo local_info)\n        -- Remember to set the function-name field of the\n        -- rules as we transfer them from one function to another\n", "num_lines": 1031}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section[SimplMonad]{The simplifier Monad}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule SimplEnv (\n        -- * The simplifier mode\n        setMode, getMode, updMode, seDynFlags,\n\n        -- * Environments\n        SimplEnv(..), pprSimplEnv,   -- Temp not abstract\n        mkSimplEnv, extendIdSubst,\n        SimplEnv.extendTvSubst, SimplEnv.extendCvSubst,\n        zapSubstEnv, setSubstEnv,\n        getInScope, setInScopeFromE, setInScopeFromF,\n        setInScopeSet, modifyInScope, addNewInScopeIds,\n        getSimplRules,\n\n        -- * Substitution results\n        SimplSR(..), mkContEx, substId, lookupRecBndr, refineFromInScope,\n\n        -- * Simplifying 'Id' binders\n        simplNonRecBndr, simplNonRecJoinBndr, simplRecBndrs, simplRecJoinBndrs,\n        simplBinder, simplBinders,\n        substTy, substTyVar, getTCvSubst,\n        substCo, substCoVar,\n\n        -- * Floats\n        SimplFloats(..), emptyFloats, mkRecFloats,\n        mkFloatBind, addLetFloats, addJoinFloats, addFloats,\n        extendFloats, wrapFloats,\n        doFloatFromRhs, getTopFloatBinds,\n\n        -- * LetFloats\n        LetFloats, letFloatBinds, emptyLetFloats, unitLetFloat,\n        addLetFlts,  mapLetFloats,\n\n        -- * JoinFloats\n        JoinFloat, JoinFloats, emptyJoinFloats,\n        wrapJoinFloats, wrapJoinFloatsX, unitJoinFloat, addJoinFlts\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport SimplMonad\nimport CoreMonad                ( SimplMode(..) )\nimport CoreSyn\nimport CoreUtils\nimport Var\nimport VarEnv\nimport VarSet\nimport OrdList\nimport Id\nimport MkCore                   ( mkWildValBinder )\nimport DynFlags                 ( DynFlags )\nimport TysWiredIn\nimport qualified Type\nimport Type hiding              ( substTy, substTyVar, substTyVarBndr )\nimport qualified Coercion\nimport Coercion hiding          ( substCo, substCoVar, substCoVarBndr )\nimport BasicTypes\nimport MonadUtils\nimport Outputable\nimport Util\nimport UniqFM                   ( pprUniqFM )\n\nimport Data.List\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{The @SimplEnv@ type}\n*                                                                      *\n************************************************************************\n-}\n\ndata SimplEnv\n  = SimplEnv {\n     ----------- Static part of the environment -----------\n     -- Static in the sense of lexically scoped,\n     -- wrt the original expression\n\n        seMode      :: SimplMode\n\n        -- The current substitution\n      , seTvSubst   :: TvSubstEnv      -- InTyVar |--> OutType\n      , seCvSubst   :: CvSubstEnv      -- InCoVar |--> OutCoercion\n      , seIdSubst   :: SimplIdSubst    -- InId    |--> OutExpr\n\n     ----------- Dynamic part of the environment -----------\n     -- Dynamic in the sense of describing the setup where\n     -- the expression finally ends up\n\n        -- The current set of in-scope variables\n        -- They are all OutVars, and all bound in this module\n      , seInScope   :: InScopeSet       -- OutVars only\n    }\n\ndata SimplFloats\n  = SimplFloats\n      { -- Ordinary let bindings\n        sfLetFloats  :: LetFloats\n                -- See Note [LetFloats]\n\n        -- Join points\n      , sfJoinFloats :: JoinFloats\n                -- Handled separately; they don't go very far\n                -- We consider these to be /inside/ sfLetFloats\n                -- because join points can refer to ordinary bindings,\n                -- but not vice versa\n\n        -- Includes all variables bound by sfLetFloats and\n        -- sfJoinFloats, plus at least whatever is in scope where\n        -- these bindings land up.\n      , sfInScope :: InScopeSet  -- All OutVars\n      }\n\ninstance Outputable SimplFloats where\n  ppr (SimplFloats { sfLetFloats = lf, sfJoinFloats = jf, sfInScope = is })\n    = text \"SimplFloats\"\n      <+> braces (vcat [ text \"lets: \" <+> ppr lf\n                       , text \"joins:\" <+> ppr jf\n                       , text \"in_scope:\" <+> ppr is ])\n\nemptyFloats :: SimplEnv -> SimplFloats\nemptyFloats env\n  = SimplFloats { sfLetFloats  = emptyLetFloats\n                , sfJoinFloats = emptyJoinFloats\n                , sfInScope    = seInScope env }\n\npprSimplEnv :: SimplEnv -> SDoc\n-- Used for debugging; selective\npprSimplEnv env\n  = vcat [text \"TvSubst:\" <+> ppr (seTvSubst env),\n          text \"CvSubst:\" <+> ppr (seCvSubst env),\n          text \"IdSubst:\" <+> id_subst_doc,\n          text \"InScope:\" <+> in_scope_vars_doc\n    ]\n  where\n   id_subst_doc = pprUniqFM ppr (seIdSubst env)\n   in_scope_vars_doc = pprVarSet (getInScopeVars (seInScope env))\n                                 (vcat . map ppr_one)\n   ppr_one v | isId v = ppr v <+> ppr (idUnfolding v)\n             | otherwise = ppr v\n\ntype SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr\n        -- See Note [Extending the Subst] in CoreSubst\n\n-- | A substitution result.\ndata SimplSR\n  = DoneEx OutExpr (Maybe JoinArity)\n       -- If  x :-> DoneEx e ja   is in the SimplIdSubst\n       -- then replace occurrences of x by e\n       -- and  ja = Just a <=> x is a join-point of arity a\n       -- See Note [Join arity in SimplIdSubst]\n\n\n  | DoneId OutId\n       -- If  x :-> DoneId v   is in the SimplIdSubst\n       -- then replace occurrences of x by v\n       -- and  v is a join-point of arity a\n       --      <=> x is a join-point of arity a\n\n  | ContEx TvSubstEnv                 -- A suspended substitution\n           CvSubstEnv\n           SimplIdSubst\n           InExpr\n      -- If   x :-> ContEx tv cv id e   is in the SimplISubst\n      -- then replace occurrences of x by (subst (tv,cv,id) e)\n\ninstance Outputable SimplSR where\n  ppr (DoneId v)    = text \"DoneId\" <+> ppr v\n  ppr (DoneEx e mj) = text \"DoneEx\" <> pp_mj <+> ppr e\n    where\n      pp_mj = case mj of\n                Nothing -> empty\n                Just n  -> parens (int n)\n\n  ppr (ContEx _tv _cv _id e) = vcat [text \"ContEx\" <+> ppr e {-,\n                                ppr (filter_env tv), ppr (filter_env id) -}]\n        -- where\n        -- fvs = exprFreeVars e\n        -- filter_env env = filterVarEnv_Directly keep env\n        -- keep uniq _ = uniq `elemUFM_Directly` fvs\n\n{-\nNote [SimplEnv invariants]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nseInScope:\n        The in-scope part of Subst includes *all* in-scope TyVars and Ids\n        The elements of the set may have better IdInfo than the\n        occurrences of in-scope Ids, and (more important) they will\n        have a correctly-substituted type.  So we use a lookup in this\n        set to replace occurrences\n\n        The Ids in the InScopeSet are replete with their Rules,\n        and as we gather info about the unfolding of an Id, we replace\n        it in the in-scope set.\n\n        The in-scope set is actually a mapping OutVar -> OutVar, and\n        in case expressions we sometimes bind\n\nseIdSubst:\n        The substitution is *apply-once* only, because InIds and OutIds\n        can overlap.\n        For example, we generally omit mappings\n                a77 -> a77\n        from the substitution, when we decide not to clone a77, but it's quite\n        legitimate to put the mapping in the substitution anyway.\n\n        Furthermore, consider\n                let x = case k of I# x77 -> ... in\n                let y = case k of I# x77 -> ... in ...\n        and suppose the body is strict in both x and y.  Then the simplifier\n        will pull the first (case k) to the top; so the second (case k) will\n        cancel out, mapping x77 to, well, x77!  But one is an in-Id and the\n        other is an out-Id.\n\n        Of course, the substitution *must* applied! Things in its domain\n        simply aren't necessarily bound in the result.\n\n* substId adds a binding (DoneId new_id) to the substitution if\n        the Id's unique has changed\n\n  Note, though that the substitution isn't necessarily extended\n  if the type of the Id changes.  Why not?  Because of the next point:\n\n* We *always, always* finish by looking up in the in-scope set\n  any variable that doesn't get a DoneEx or DoneVar hit in the substitution.\n  Reason: so that we never finish up with a \"old\" Id in the result.\n  An old Id might point to an old unfolding and so on... which gives a space\n  leak.\n\n  [The DoneEx and DoneVar hits map to \"new\" stuff.]\n\n* It follows that substExpr must not do a no-op if the substitution is empty.\n  substType is free to do so, however.\n\n* When we come to a let-binding (say) we generate new IdInfo, including an\n  unfolding, attach it to the binder, and add this newly adorned binder to\n  the in-scope set.  So all subsequent occurrences of the binder will get\n  mapped to the full-adorned binder, which is also the one put in the\n  binding site.\n\n* The in-scope \"set\" usually maps x->x; we use it simply for its domain.\n  But sometimes we have two in-scope Ids that are synomyms, and should\n  map to the same target:  x->x, y->x.  Notably:\n        case y of x { ... }\n  That's why the \"set\" is actually a VarEnv Var\n\nNote [Join arity in SimplIdSubst]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe have to remember which incoming variables are join points: the occurrences\nmay not be marked correctly yet, and we're in change of propagating the change if\nOccurAnal makes something a join point).\n\nNormally the in-scope set is where we keep the latest information, but\nthe in-scope set tracks only OutVars; if a binding is unconditionally\ninlined (via DoneEx), it never makes it into the in-scope set, and we\nneed to know at the occurrence site that the variable is a join point\nso that we know to drop the context. Thus we remember which join\npoints we're substituting. -}\n\nmkSimplEnv :: SimplMode -> SimplEnv\nmkSimplEnv mode\n  = SimplEnv { seMode = mode\n             , seInScope = init_in_scope\n             , seTvSubst = emptyVarEnv\n             , seCvSubst = emptyVarEnv\n             , seIdSubst = emptyVarEnv }\n        -- The top level \"enclosing CC\" is \"SUBSUMED\".\n\ninit_in_scope :: InScopeSet\ninit_in_scope = mkInScopeSet (unitVarSet (mkWildValBinder unitTy))\n              -- See Note [WildCard binders]\n\n{-\nNote [WildCard binders]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe program to be simplified may have wild binders\n    case e of wild { p -> ... }\nWe want to *rename* them away, so that there are no\noccurrences of 'wild-id' (with wildCardKey).  The easy\nway to do that is to start of with a representative\nId in the in-scope set\n\nThere can be *occurrences* of wild-id.  For example,\nMkCore.mkCoreApp transforms\n   e (a /# b)   -->   case (a /# b) of wild { DEFAULT -> e wild }\nThis is ok provided 'wild' isn't free in 'e', and that's the delicate\nthing. Generally, you want to run the simplifier to get rid of the\nwild-ids before doing much else.\n\nIt's a very dark corner of GHC.  Maybe it should be cleaned up.\n-}\n\ngetMode :: SimplEnv -> SimplMode\ngetMode env = seMode env\n\nseDynFlags :: SimplEnv -> DynFlags\nseDynFlags env = sm_dflags (seMode env)\n\nsetMode :: SimplMode -> SimplEnv -> SimplEnv\nsetMode mode env = env { seMode = mode }\n\nupdMode :: (SimplMode -> SimplMode) -> SimplEnv -> SimplEnv\nupdMode upd env = env { seMode = upd (seMode env) }\n\n---------------------\nextendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv\nextendIdSubst env@(SimplEnv {seIdSubst = subst}) var res\n  = ASSERT2( isId var && not (isCoVar var), ppr var )\n    env { seIdSubst = extendVarEnv subst var res }\n\nextendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv\nextendTvSubst env@(SimplEnv {seTvSubst = tsubst}) var res\n  = ASSERT2( isTyVar var, ppr var $$ ppr res )\n    env {seTvSubst = extendVarEnv tsubst var res}\n\nextendCvSubst :: SimplEnv -> CoVar -> Coercion -> SimplEnv\nextendCvSubst env@(SimplEnv {seCvSubst = csubst}) var co\n  = ASSERT( isCoVar var )\n    env {seCvSubst = extendVarEnv csubst var co}\n\n---------------------\ngetInScope :: SimplEnv -> InScopeSet\ngetInScope env = seInScope env\n\nsetInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv\nsetInScopeSet env in_scope = env {seInScope = in_scope}\n\nsetInScopeFromE :: SimplEnv -> SimplEnv -> SimplEnv\n-- See Note [Setting the right in-scope set]\nsetInScopeFromE rhs_env here_env = rhs_env { seInScope = seInScope here_env }\n\nsetInScopeFromF :: SimplEnv -> SimplFloats -> SimplEnv\nsetInScopeFromF env floats = env { seInScope = sfInScope floats }\n\naddNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv\n        -- The new Ids are guaranteed to be freshly allocated\naddNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs\n  = env { seInScope = in_scope `extendInScopeSetList` vs,\n          seIdSubst = id_subst `delVarEnvList` vs }\n        -- Why delete?  Consider\n        --      let x = a*b in (x, \\x -> x+3)\n        -- We add [x |-> a*b] to the substitution, but we must\n        -- _delete_ it from the substitution when going inside\n        -- the (\\x -> ...)!\n\nmodifyInScope :: SimplEnv -> CoreBndr -> SimplEnv\n-- The variable should already be in scope, but\n-- replace the existing version with this new one\n-- which has more information\nmodifyInScope env@(SimplEnv {seInScope = in_scope}) v\n  = env {seInScope = extendInScopeSet in_scope v}\n\n{- Note [Setting the right in-scope set]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  \\x. (let x = e in b) arg[x]\nwhere the let shadows the lambda.  Really this means something like\n  \\x1. (let x2 = e in b) arg[x1]\n\n- When we capture the 'arg' in an ApplyToVal continuation, we capture\n  the environment, which says what 'x' is bound to, namely x1\n\n- Then that continuation gets pushed under the let\n\n- Finally we simplify 'arg'.  We want\n     - the static, lexical environment bindig x :-> x1\n     - the in-scopeset from \"here\", under the 'let' which includes\n       both x1 and x2\n\nIt's important to have the right in-scope set, else we may rename a\nvariable to one that is already in scope.  So we must pick up the\nin-scope set from \"here\", but otherwise use the environment we\ncaptured along with 'arg'.  This transfer of in-scope set is done by\nsetInScopeFromE.\n-}\n\n---------------------\nzapSubstEnv :: SimplEnv -> SimplEnv\nzapSubstEnv env = env {seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}\n\nsetSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv\nsetSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }\n\nmkContEx :: SimplEnv -> InExpr -> SimplSR\nmkContEx (SimplEnv { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }) e = ContEx tvs cvs ids e\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{LetFloats}\n*                                                                      *\n************************************************************************\n\nNote [LetFloats]\n~~~~~~~~~~~~~~~~\nThe LetFloats is a bunch of bindings, classified by a FloatFlag.\n\n* All of them satisfy the let/app invariant\n\nExamples\n\n  NonRec x (y:ys)       FltLifted\n  Rec [(x,rhs)]         FltLifted\n\n  NonRec x* (p:q)       FltOKSpec   -- RHS is WHNF.  Question: why not FltLifted?\n  NonRec x# (y +# 3)    FltOkSpec   -- Unboxed, but ok-for-spec'n\n\n  NonRec x* (f y)       FltCareful  -- Strict binding; might fail or diverge\n\nCan't happen:\n  NonRec x# (a /# b)    -- Might fail; does not satisfy let/app\n  NonRec x# (f y)       -- Might diverge; does not satisfy let/app\n-}\n\ndata LetFloats = LetFloats (OrdList OutBind) FloatFlag\n                 -- See Note [LetFloats]\n\ntype JoinFloat  = OutBind\ntype JoinFloats = OrdList JoinFloat\n\ndata FloatFlag\n  = FltLifted   -- All bindings are lifted and lazy *or*\n                --     consist of a single primitive string literal\n                --  Hence ok to float to top level, or recursive\n\n  | FltOkSpec   -- All bindings are FltLifted *or*\n                --      strict (perhaps because unlifted,\n                --      perhaps because of a strict binder),\n                --        *and* ok-for-speculation\n                --  Hence ok to float out of the RHS\n                --  of a lazy non-recursive let binding\n                --  (but not to top level, or into a rec group)\n\n  | FltCareful  -- At least one binding is strict (or unlifted)\n                --      and not guaranteed cheap\n                --      Do not float these bindings out of a lazy let\n\ninstance Outputable LetFloats where\n  ppr (LetFloats binds ff) = ppr ff $$ ppr (fromOL binds)\n\ninstance Outputable FloatFlag where\n  ppr FltLifted  = text \"FltLifted\"\n  ppr FltOkSpec  = text \"FltOkSpec\"\n  ppr FltCareful = text \"FltCareful\"\n\nandFF :: FloatFlag -> FloatFlag -> FloatFlag\nandFF FltCareful _          = FltCareful\nandFF FltOkSpec  FltCareful = FltCareful\nandFF FltOkSpec  _          = FltOkSpec\nandFF FltLifted  flt        = flt\n\ndoFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> SimplFloats -> OutExpr -> Bool\n-- If you change this function look also at FloatIn.noFloatFromRhs\ndoFloatFromRhs lvl rec str (SimplFloats { sfLetFloats = LetFloats fs ff }) rhs\n  =  not (isNilOL fs) && want_to_float && can_float\n  where\n     want_to_float = isTopLevel lvl || exprIsCheap rhs || exprIsExpandable rhs\n                     -- See Note [Float when cheap or expandable]\n     can_float = case ff of\n                   FltLifted  -> True\n                   FltOkSpec  -> isNotTopLevel lvl && isNonRec rec\n                   FltCareful -> isNotTopLevel lvl && isNonRec rec && str\n\n{-\nNote [Float when cheap or expandable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to float a let from a let if the residual RHS is\n   a) cheap, such as (\\x. blah)\n   b) expandable, such as (f b) if f is CONLIKE\nBut there are\n  - cheap things that are not expandable (eg \\x. expensive)\n  - expandable things that are not cheap (eg (f b) where b is CONLIKE)\nso we must take the 'or' of the two.\n-}\n\nemptyLetFloats :: LetFloats\nemptyLetFloats = LetFloats nilOL FltLifted\n\nemptyJoinFloats :: JoinFloats\nemptyJoinFloats = nilOL\n\nunitLetFloat :: OutBind -> LetFloats\n-- This key function constructs a singleton float with the right form\nunitLetFloat bind = ASSERT(all (not . isJoinId) (bindersOf bind))\n                    LetFloats (unitOL bind) (flag bind)\n  where\n    flag (Rec {})                = FltLifted\n    flag (NonRec bndr rhs)\n      | not (isStrictId bndr)    = FltLifted\n      | exprIsTickedString rhs   = FltLifted\n          -- String literals can be floated freely.\n          -- See Note [CoreSyn top-level string literals] in CoreSyn.\n      | exprOkForSpeculation rhs = FltOkSpec  -- Unlifted, and lifted but ok-for-spec (eg HNF)\n      | otherwise                = ASSERT2( not (isUnliftedType (idType bndr)), ppr bndr )\n                                   FltCareful\n      -- Unlifted binders can only be let-bound if exprOkForSpeculation holds\n\nunitJoinFloat :: OutBind -> JoinFloats\nunitJoinFloat bind = ASSERT(all isJoinId (bindersOf bind))\n                     unitOL bind\n\nmkFloatBind :: SimplEnv -> OutBind -> (SimplFloats, SimplEnv)\n-- Make a singleton SimplFloats, and\n-- extend the incoming SimplEnv's in-scope set with its binders\n-- These binders may already be in the in-scope set,\n-- but may have by now been augmented with more IdInfo\nmkFloatBind env bind\n  = (floats, env { seInScope = in_scope' })\n  where\n    floats\n      | isJoinBind bind\n      = SimplFloats { sfLetFloats  = emptyLetFloats\n                    , sfJoinFloats = unitJoinFloat bind\n                    , sfInScope    = in_scope' }\n      | otherwise\n      = SimplFloats { sfLetFloats  = unitLetFloat bind\n                    , sfJoinFloats = emptyJoinFloats\n                    , sfInScope    = in_scope' }\n\n    in_scope' = seInScope env `extendInScopeSetBind` bind\n\nextendFloats :: SimplFloats -> OutBind -> SimplFloats\n-- Add this binding to the floats, and extend the in-scope env too\nextendFloats (SimplFloats { sfLetFloats  = floats\n                          , sfJoinFloats = jfloats\n                          , sfInScope    = in_scope })\n             bind\n  | isJoinBind bind\n  = SimplFloats { sfInScope    = in_scope'\n                , sfLetFloats  = floats\n                , sfJoinFloats = jfloats' }\n  | otherwise\n  = SimplFloats { sfInScope    = in_scope'\n                , sfLetFloats  = floats'\n                , sfJoinFloats = jfloats }\n  where\n    in_scope' = in_scope `extendInScopeSetBind` bind\n    floats'   = floats  `addLetFlts`  unitLetFloat bind\n    jfloats'  = jfloats `addJoinFlts` unitJoinFloat bind\n\naddLetFloats :: SimplFloats -> LetFloats -> SimplFloats\n-- Add the let-floats for env2 to env1;\n-- *plus* the in-scope set for env2, which is bigger\n-- than that for env1\naddLetFloats floats let_floats@(LetFloats binds _)\n  = floats { sfLetFloats = sfLetFloats floats `addLetFlts` let_floats\n           , sfInScope   = foldlOL extendInScopeSetBind\n                                   (sfInScope floats) binds }\n\naddJoinFloats :: SimplFloats -> JoinFloats -> SimplFloats\naddJoinFloats floats join_floats\n  = floats { sfJoinFloats = sfJoinFloats floats `addJoinFlts` join_floats\n           , sfInScope    = foldlOL extendInScopeSetBind\n                                    (sfInScope floats) join_floats }\n\nextendInScopeSetBind :: InScopeSet -> CoreBind -> InScopeSet\nextendInScopeSetBind in_scope bind\n  = extendInScopeSetList in_scope (bindersOf bind)\n\naddFloats :: SimplFloats -> SimplFloats -> SimplFloats\n-- Add both let-floats and join-floats for env2 to env1;\n-- *plus* the in-scope set for env2, which is bigger\n-- than that for env1\naddFloats (SimplFloats { sfLetFloats = lf1, sfJoinFloats = jf1 })\n          (SimplFloats { sfLetFloats = lf2, sfJoinFloats = jf2, sfInScope = in_scope })\n  = SimplFloats { sfLetFloats  = lf1 `addLetFlts` lf2\n                , sfJoinFloats = jf1 `addJoinFlts` jf2\n                , sfInScope    = in_scope }\n\naddLetFlts :: LetFloats -> LetFloats -> LetFloats\naddLetFlts (LetFloats bs1 l1) (LetFloats bs2 l2)\n  = LetFloats (bs1 `appOL` bs2) (l1 `andFF` l2)\n\nletFloatBinds :: LetFloats -> [CoreBind]\nletFloatBinds (LetFloats bs _) = fromOL bs\n\naddJoinFlts :: JoinFloats -> JoinFloats -> JoinFloats\naddJoinFlts = appOL\n\nmkRecFloats :: SimplFloats -> SimplFloats\n-- Flattens the floats from env2 into a single Rec group,\n-- They must either all be lifted LetFloats or all JoinFloats\nmkRecFloats floats@(SimplFloats { sfLetFloats  = LetFloats bs ff\n                                , sfJoinFloats = jbs\n                                , sfInScope    = in_scope })\n  = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) )\n    ASSERT2( isNilOL bs || isNilOL jbs, ppr floats )\n    SimplFloats { sfLetFloats  = floats'\n                , sfJoinFloats = jfloats'\n                , sfInScope    = in_scope }\n  where\n    floats'  | isNilOL bs  = emptyLetFloats\n             | otherwise   = unitLetFloat (Rec (flattenBinds (fromOL bs)))\n    jfloats' | isNilOL jbs = emptyJoinFloats\n             | otherwise   = unitJoinFloat (Rec (flattenBinds (fromOL jbs)))\n\nwrapFloats :: SimplFloats -> OutExpr -> OutExpr\n-- Wrap the floats around the expression; they should all\n-- satisfy the let/app invariant, so mkLets should do the job just fine\nwrapFloats (SimplFloats { sfLetFloats  = LetFloats bs _\n                        , sfJoinFloats = jbs }) body\n  = foldrOL Let (wrapJoinFloats jbs body) bs\n     -- Note: Always safe to put the joins on the inside\n     -- since the values can't refer to them\n\nwrapJoinFloatsX :: SimplFloats -> OutExpr -> (SimplFloats, OutExpr)\n-- Wrap the sfJoinFloats of the env around the expression,\n-- and take them out of the SimplEnv\nwrapJoinFloatsX floats body\n  = ( floats { sfJoinFloats = emptyJoinFloats }\n    , wrapJoinFloats (sfJoinFloats floats) body )\n\nwrapJoinFloats :: JoinFloats -> OutExpr -> OutExpr\n-- Wrap the sfJoinFloats of the env around the expression,\n-- and take them out of the SimplEnv\nwrapJoinFloats join_floats body\n  = foldrOL Let body join_floats\n\ngetTopFloatBinds :: SimplFloats -> [CoreBind]\ngetTopFloatBinds (SimplFloats { sfLetFloats  = lbs\n                              , sfJoinFloats = jbs})\n  = ASSERT( isNilOL jbs )  -- Can't be any top-level join bindings\n    letFloatBinds lbs\n\nmapLetFloats :: LetFloats -> ((Id,CoreExpr) -> (Id,CoreExpr)) -> LetFloats\nmapLetFloats (LetFloats fs ff) fun\n   = LetFloats (mapOL app fs) ff\n   where\n    app (NonRec b e) = case fun (b,e) of (b',e') -> NonRec b' e'\n    app (Rec bs)     = Rec (map fun bs)\n\n{-\n************************************************************************\n*                                                                      *\n                Substitution of Vars\n*                                                                      *\n************************************************************************\n\nNote [Global Ids in the substitution]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe look up even a global (eg imported) Id in the substitution. Consider\n   case X.g_34 of b { (a,b) ->  ... case X.g_34 of { (p,q) -> ...} ... }\nThe binder-swap in the occurrence analyser will add a binding\nfor a LocalId version of g (with the same unique though):\n   case X.g_34 of b { (a,b) ->  let g_34 = b in\n                                ... case X.g_34 of { (p,q) -> ...} ... }\nSo we want to look up the inner X.g_34 in the substitution, where we'll\nfind that it has been substituted by b.  (Or conceivably cloned.)\n-}\n\nsubstId :: SimplEnv -> InId -> SimplSR\n-- Returns DoneEx only on a non-Var expression\nsubstId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v\n  = case lookupVarEnv ids v of  -- Note [Global Ids in the substitution]\n        Nothing               -> DoneId (refineFromInScope in_scope v)\n        Just (DoneId v)       -> DoneId (refineFromInScope in_scope v)\n        Just res              -> res    -- DoneEx non-var, or ContEx\n\n        -- Get the most up-to-date thing from the in-scope set\n        -- Even though it isn't in the substitution, it may be in\n        -- the in-scope set with better IdInfo\n\nrefineFromInScope :: InScopeSet -> Var -> Var\nrefineFromInScope in_scope v\n  | isLocalId v = case lookupInScope in_scope v of\n                  Just v' -> v'\n                  Nothing -> WARN( True, ppr v ) v  -- This is an error!\n  | otherwise = v\n\nlookupRecBndr :: SimplEnv -> InId -> OutId\n-- Look up an Id which has been put into the envt by simplRecBndrs,\n-- but where we have not yet done its RHS\nlookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v\n  = case lookupVarEnv ids v of\n        Just (DoneId v) -> v\n        Just _ -> pprPanic \"lookupRecBndr\" (ppr v)\n        Nothing -> refineFromInScope in_scope v\n\n{-\n************************************************************************\n*                                                                      *\n\\section{Substituting an Id binder}\n*                                                                      *\n************************************************************************\n\n\nThese functions are in the monad only so that they can be made strict via seq.\n\nNote [Return type for join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n   (join j :: Char -> Int -> Int) 77\n   (     j x = \\y. y + ord x    )\n   (in case v of                )\n   (     A -> j 'x'             )\n   (     B -> j 'y'             )\n   (     C -> <blah>            )\n\nThe simplifier pushes the \"apply to 77\" continuation inwards to give\n\n   join j :: Char -> Int\n        j x = (\\y. y + ord x) 77\n   in case v of\n        A -> j 'x'\n        B -> j 'y'\n        C -> <blah> 77\n\nNotice that the \"apply to 77\" continuation went into the RHS of the\njoin point.  And that meant that the return type of the join point\nchanged!!\n\nThat's why we pass res_ty into simplNonRecJoinBndr, and substIdBndr\ntakes a (Just res_ty) argument so that it knows to do the type-changing\nthing.\n-}\n\nsimplBinders :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])\nsimplBinders  env bndrs = mapAccumLM simplBinder  env bndrs\n\n-------------\nsimplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)\n-- Used for lambda and case-bound variables\n-- Clone Id if necessary, substitute type\n-- Return with IdInfo already substituted, but (fragile) occurrence info zapped\n-- The substitution is extended only if the variable is cloned, because\n-- we *don't* need to use it to track occurrence info.\nsimplBinder env bndr\n  | isTyVar bndr  = do  { let (env', tv) = substTyVarBndr env bndr\n                        ; seqTyVar tv `seq` return (env', tv) }\n  | otherwise     = do  { let (env', id) = substIdBndr Nothing env bndr\n                        ; seqId id `seq` return (env', id) }\n\n---------------\nsimplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)\n-- A non-recursive let binder\nsimplNonRecBndr env id\n  = do  { let (env1, id1) = substIdBndr Nothing env id\n        ; seqId id1 `seq` return (env1, id1) }\n\n---------------\nsimplNonRecJoinBndr :: SimplEnv -> OutType -> InBndr\n                    -> SimplM (SimplEnv, OutBndr)\n-- A non-recursive let binder for a join point;\n-- context being pushed inward may change the type\n-- See Note [Return type for join points]\nsimplNonRecJoinBndr env res_ty id\n  = do  { let (env1, id1) = substIdBndr (Just res_ty) env id\n        ; seqId id1 `seq` return (env1, id1) }\n\n---------------\nsimplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv\n-- Recursive let binders\nsimplRecBndrs env@(SimplEnv {}) ids\n  = ASSERT(all (not . isJoinId) ids)\n    do  { let (env1, ids1) = mapAccumL (substIdBndr Nothing) env ids\n        ; seqIds ids1 `seq` return env1 }\n\n---------------\nsimplRecJoinBndrs :: SimplEnv -> OutType -> [InBndr] -> SimplM SimplEnv\n-- Recursive let binders for join points;\n-- context being pushed inward may change types\n-- See Note [Return type for join points]\nsimplRecJoinBndrs env@(SimplEnv {}) res_ty ids\n  = ASSERT(all isJoinId ids)\n    do  { let (env1, ids1) = mapAccumL (substIdBndr (Just res_ty)) env ids\n        ; seqIds ids1 `seq` return env1 }\n\n---------------\nsubstIdBndr :: Maybe OutType -> SimplEnv -> InBndr -> (SimplEnv, OutBndr)\n-- Might be a coercion variable\nsubstIdBndr new_res_ty env bndr\n  | isCoVar bndr  = substCoVarBndr env bndr\n  | otherwise     = substNonCoVarIdBndr new_res_ty env bndr\n\n---------------\nsubstNonCoVarIdBndr\n   :: Maybe OutType -- New result type, if a join binder\n                    -- See Note [Return type for join points]\n   -> SimplEnv\n   -> InBndr    -- Env and binder to transform\n   -> (SimplEnv, OutBndr)\n-- Clone Id if necessary, substitute its type\n-- Return an Id with its\n--      * Type substituted\n--      * UnfoldingInfo, Rules, WorkerInfo zapped\n--      * Fragile OccInfo (only) zapped: Note [Robust OccInfo]\n--      * Robust info, retained especially arity and demand info,\n--         so that they are available to occurrences that occur in an\n--         earlier binding of a letrec\n--\n-- For the robust info, see Note [Arity robustness]\n--\n-- Augment the substitution  if the unique changed\n-- Extend the in-scope set with the new Id\n--\n-- Similar to CoreSubst.substIdBndr, except that\n--      the type of id_subst differs\n--      all fragile info is zapped\nsubstNonCoVarIdBndr new_res_ty\n                    env@(SimplEnv { seInScope = in_scope\n                                  , seIdSubst = id_subst })\n                    old_id\n  = ASSERT2( not (isCoVar old_id), ppr old_id )\n    (env { seInScope = in_scope `extendInScopeSet` new_id,\n           seIdSubst = new_subst }, new_id)\n  where\n    id1    = uniqAway in_scope old_id\n    id2    = substIdType env id1\n\n    id3    | Just res_ty <- new_res_ty\n           = id2 `setIdType` setJoinResTy (idJoinArity id2) res_ty (idType id2)\n                             -- See Note [Return type for join points]\n           | otherwise\n           = id2\n\n    new_id = zapFragileIdInfo id3       -- Zaps rules, worker-info, unfolding\n                                        -- and fragile OccInfo\n\n        -- Extend the substitution if the unique has changed,\n        -- or there's some useful occurrence information\n        -- See the notes with substTyVarBndr for the delSubstEnv\n    new_subst | new_id /= old_id\n              = extendVarEnv id_subst old_id (DoneId new_id)\n              | otherwise\n              = delVarEnv id_subst old_id\n\n------------------------------------\nseqTyVar :: TyVar -> ()\nseqTyVar b = b `seq` ()\n\nseqId :: Id -> ()\nseqId id = seqType (idType id)  `seq`\n           idInfo id            `seq`\n           ()\n\nseqIds :: [Id] -> ()\nseqIds []       = ()\nseqIds (id:ids) = seqId id `seq` seqIds ids\n\n{-\nNote [Arity robustness]\n~~~~~~~~~~~~~~~~~~~~~~~\nWe *do* transfer the arity from from the in_id of a let binding to the\nout_id.  This is important, so that the arity of an Id is visible in\nits own RHS.  For example:\n        f = \\x. ....g (\\y. f y)....\nWe can eta-reduce the arg to g, because f is a value.  But that\nneeds to be visible.\n\nThis interacts with the 'state hack' too:\n        f :: Bool -> IO Int\n        f = \\x. case x of\n                  True  -> f y\n                  False -> \\s -> ...\nCan we eta-expand f?  Only if we see that f has arity 1, and then we\ntake advantage of the 'state hack' on the result of\n(f y) :: State# -> (State#, Int) to expand the arity one more.\n\nThere is a disadvantage though.  Making the arity visible in the RHS\nallows us to eta-reduce\n        f = \\x -> f x\nto\n        f = f\nwhich technically is not sound.   This is very much a corner case, so\nI'm not worried about it.  Another idea is to ensure that f's arity\nnever decreases; its arity started as 1, and we should never eta-reduce\nbelow that.\n\n\nNote [Robust OccInfo]\n~~~~~~~~~~~~~~~~~~~~~\nIt's important that we *do* retain the loop-breaker OccInfo, because\nthat's what stops the Id getting inlined infinitely, in the body of\nthe letrec.\n-}\n\n\n{-\n************************************************************************\n*                                                                      *\n                Impedance matching to type substitution\n*                                                                      *\n************************************************************************\n-}\n\ngetTCvSubst :: SimplEnv -> TCvSubst\ngetTCvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env\n                      , seCvSubst = cv_env })\n  = mkTCvSubst in_scope (tv_env, cv_env)\n\nsubstTy :: SimplEnv -> Type -> Type\nsubstTy env ty = Type.substTy (getTCvSubst env) ty\n\nsubstTyVar :: SimplEnv -> TyVar -> Type\nsubstTyVar env tv = Type.substTyVar (getTCvSubst env) tv\n\nsubstTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)\nsubstTyVarBndr env tv\n  = case Type.substTyVarBndr (getTCvSubst env) tv of\n        (TCvSubst in_scope' tv_env' cv_env', tv')\n           -> (env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, tv')\n\nsubstCoVar :: SimplEnv -> CoVar -> Coercion\nsubstCoVar env tv = Coercion.substCoVar (getTCvSubst env) tv\n\nsubstCoVarBndr :: SimplEnv -> CoVar -> (SimplEnv, CoVar)\nsubstCoVarBndr env cv\n  = case Coercion.substCoVarBndr (getTCvSubst env) cv of\n        (TCvSubst in_scope' tv_env' cv_env', cv')\n           -> (env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, cv')\n\nsubstCo :: SimplEnv -> Coercion -> Coercion\nsubstCo env co = Coercion.substCo (getTCvSubst env) co\n\n------------------\nsubstIdType :: SimplEnv -> Id -> Id\nsubstIdType (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv_env }) id\n  |  (isEmptyVarEnv tv_env && isEmptyVarEnv cv_env)\n  || noFreeVarsOfType old_ty\n  = id\n  | otherwise = Id.setIdType id (Type.substTy (TCvSubst in_scope tv_env cv_env) old_ty)\n                -- The tyCoVarsOfType is cheaper than it looks\n                -- because we cache the free tyvars of the type\n                -- in a Note in the id's type itself\n  where\n    old_ty = idType id\n", "num_lines": 937}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section[Simplify]{The main module of the simplifier}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule Simplify ( simplTopBinds, simplExpr, simplRules ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport SimplMonad\nimport Type hiding      ( substTy, substTyVar, extendTvSubst, extendCvSubst )\nimport SimplEnv\nimport SimplUtils\nimport OccurAnal        ( occurAnalyseExpr )\nimport FamInstEnv       ( FamInstEnv )\nimport Literal          ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326\nimport Id\nimport MkId             ( seqId )\nimport MkCore           ( FloatBind, mkImpossibleExpr, castBottomExpr )\nimport qualified MkCore as MkCore\nimport IdInfo\nimport Name             ( mkSystemVarName, isExternalName, getOccFS )\nimport Coercion hiding  ( substCo, substCoVar )\nimport OptCoercion      ( optCoercion )\nimport FamInstEnv       ( topNormaliseType_maybe )\nimport DataCon          ( DataCon, dataConWorkId, dataConRepStrictness\n                        , dataConRepArgTys, isUnboxedTupleCon\n                        , StrictnessMark (..) )\nimport CoreMonad        ( Tick(..), SimplMode(..) )\nimport CoreSyn\nimport Demand           ( StrictSig(..), dmdTypeDepth, isStrictDmd )\nimport PprCore          ( pprCoreExpr )\nimport CoreUnfold\nimport CoreUtils\nimport CoreOpt          ( pushCoTyArg, pushCoValArg\n                        , joinPointBinding_maybe, joinPointBindings_maybe )\nimport Rules            ( mkRuleInfo, lookupRule, getRules )\nimport Demand           ( mkClosedStrictSig, topDmd, botRes )\nimport BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel,\n                          RecFlag(..), Arity )\nimport MonadUtils       ( mapAccumLM, liftIO )\nimport Var              ( isTyCoVar )\nimport Maybes           (  orElse )\nimport Control.Monad\nimport Outputable\nimport FastString\nimport Pair\nimport Util\nimport ErrUtils\nimport Module          ( moduleName, pprModuleName )\nimport PrimOp          ( PrimOp (SeqOp) )\n\n\n{-\nThe guts of the simplifier is in this module, but the driver loop for\nthe simplifier is in SimplCore.hs.\n\nNote [The big picture]\n~~~~~~~~~~~~~~~~~~~~~~\nThe general shape of the simplifier is this:\n\n  simplExpr :: SimplEnv -> InExpr -> SimplCont -> SimplM (SimplFloats, OutExpr)\n  simplBind :: SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)\n\n * SimplEnv contains\n     - Simplifier mode (which includes DynFlags for convenience)\n     - Ambient substitution\n     - InScopeSet\n\n * SimplFloats contains\n     - Let-floats (which includes ok-for-spec case-floats)\n     - Join floats\n     - InScopeSet (including all the floats)\n\n * Expressions\n      simplExpr :: SimplEnv -> InExpr -> SimplCont\n                -> SimplM (SimplFloats, OutExpr)\n   The result of simplifying an /expression/ is (floats, expr)\n      - A bunch of floats (let bindings, join bindings)\n      - A simplified expression.\n   The overall result is effectively (let floats in expr)\n\n * Bindings\n      simplBind :: SimplEnv -> InBind -> SimplM (SimplFloats, SimplEnv)\n   The result of simplifying a binding is\n     - A bunch of floats, the last of which is the simplified binding\n       There may be auxiliary bindings too; see prepareRhs\n     - An environment suitable for simplifying the scope of the binding\n\n   The floats may also be empty, if the binding is inlined unconditionally;\n   in that case the returned SimplEnv will have an augmented substitution.\n\n   The returned floats and env both have an in-scope set, and they are\n   guaranteed to be the same.\n\n\nNote [Shadowing]\n~~~~~~~~~~~~~~~~\nThe simplifier used to guarantee that the output had no shadowing, but\nit does not do so any more.   (Actually, it never did!)  The reason is\ndocumented with simplifyArgs.\n\n\nEta expansion\n~~~~~~~~~~~~~~\nFor eta expansion, we want to catch things like\n\n        case e of (a,b) -> \\x -> case a of (p,q) -> \\y -> r\n\nIf the \\x was on the RHS of a let, we'd eta expand to bring the two\nlambdas together.  And in general that's a good thing to do.  Perhaps\nwe should eta expand wherever we find a (value) lambda?  Then the eta\nexpansion at a let RHS can concentrate solely on the PAP case.\n\n************************************************************************\n*                                                                      *\n\\subsection{Bindings}\n*                                                                      *\n************************************************************************\n-}\n\nsimplTopBinds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)\n-- See Note [The big picture]\nsimplTopBinds env0 binds0\n  = do  {       -- Put all the top-level binders into scope at the start\n                -- so that if a transformation rule has unexpectedly brought\n                -- anything into scope, then we don't get a complaint about that.\n                -- It's rather as if the top-level binders were imported.\n                -- See note [Glomming] in OccurAnal.\n        ; env1 <- {-#SCC \"simplTopBinds-simplRecBndrs\" #-} simplRecBndrs env0 (bindersOfBinds binds0)\n        ; (floats, env2) <- {-#SCC \"simplTopBinds-simpl_binds\" #-} simpl_binds env1 binds0\n        ; freeTick SimplifierDone\n        ; return (floats, env2) }\n  where\n        -- We need to track the zapped top-level binders, because\n        -- they should have their fragile IdInfo zapped (notably occurrence info)\n        -- That's why we run down binds and bndrs' simultaneously.\n        --\n    simpl_binds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)\n    simpl_binds env []           = return (emptyFloats env, env)\n    simpl_binds env (bind:binds) = do { (float,  env1) <- simpl_bind env bind\n                                      ; (floats, env2) <- simpl_binds env1 binds\n                                      ; return (float `addFloats` floats, env2) }\n\n    simpl_bind env (Rec pairs)\n      = simplRecBind env TopLevel Nothing pairs\n    simpl_bind env (NonRec b r)\n      = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) Nothing\n           ; simplRecOrTopPair env' TopLevel NonRecursive Nothing b b' r }\n\n{-\n************************************************************************\n*                                                                      *\n        Lazy bindings\n*                                                                      *\n************************************************************************\n\nsimplRecBind is used for\n        * recursive bindings only\n-}\n\nsimplRecBind :: SimplEnv -> TopLevelFlag -> MaybeJoinCont\n             -> [(InId, InExpr)]\n             -> SimplM (SimplFloats, SimplEnv)\nsimplRecBind env0 top_lvl mb_cont pairs0\n  = do  { (env_with_info, triples) <- mapAccumLM add_rules env0 pairs0\n        ; (rec_floats, env1) <- go env_with_info triples\n        ; return (mkRecFloats rec_floats, env1) }\n  where\n    add_rules :: SimplEnv -> (InBndr,InExpr) -> SimplM (SimplEnv, (InBndr, OutBndr, InExpr))\n        -- Add the (substituted) rules to the binder\n    add_rules env (bndr, rhs)\n        = do { (env', bndr') <- addBndrRules env bndr (lookupRecBndr env bndr) mb_cont\n             ; return (env', (bndr, bndr', rhs)) }\n\n    go env [] = return (emptyFloats env, env)\n\n    go env ((old_bndr, new_bndr, rhs) : pairs)\n        = do { (float, env1) <- simplRecOrTopPair env top_lvl Recursive mb_cont\n                                                  old_bndr new_bndr rhs\n             ; (floats, env2) <- go env1 pairs\n             ; return (float `addFloats` floats, env2) }\n\n{-\nsimplOrTopPair is used for\n        * recursive bindings (whether top level or not)\n        * top-level non-recursive bindings\n\nIt assumes the binder has already been simplified, but not its IdInfo.\n-}\n\nsimplRecOrTopPair :: SimplEnv\n                  -> TopLevelFlag -> RecFlag -> MaybeJoinCont\n                  -> InId -> OutBndr -> InExpr  -- Binder and rhs\n                  -> SimplM (SimplFloats, SimplEnv)\n\nsimplRecOrTopPair env top_lvl is_rec mb_cont old_bndr new_bndr rhs\n  | Just env' <- preInlineUnconditionally env top_lvl old_bndr rhs env\n  = {-#SCC \"simplRecOrTopPair-pre-inline-uncond\" #-}\n    trace_bind \"pre-inline-uncond\" $\n    do { tick (PreInlineUnconditionally old_bndr)\n       ; return ( emptyFloats env, env' ) }\n\n  | Just cont <- mb_cont\n  = {-#SCC \"simplRecOrTopPair-join\" #-}\n    ASSERT( isNotTopLevel top_lvl && isJoinId new_bndr )\n    trace_bind \"join\" $\n    simplJoinBind env cont old_bndr new_bndr rhs env\n\n  | otherwise\n  = {-#SCC \"simplRecOrTopPair-normal\" #-}\n    trace_bind \"normal\" $\n    simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env\n\n  where\n    dflags = seDynFlags env\n\n    -- trace_bind emits a trace for each top-level binding, which\n    -- helps to locate the tracing for inlining and rule firing\n    trace_bind what thing_inside\n      | not (dopt Opt_D_verbose_core2core dflags)\n      = thing_inside\n      | otherwise\n      = pprTrace (\"SimplBind \" ++ what) (ppr old_bndr) thing_inside\n\n--------------------------\nsimplLazyBind :: SimplEnv\n              -> TopLevelFlag -> RecFlag\n              -> InId -> OutId          -- Binder, both pre-and post simpl\n                                        -- Not a JoinId\n                                        -- The OutId has IdInfo, except arity, unfolding\n                                        -- Ids only, no TyVars\n              -> InExpr -> SimplEnv     -- The RHS and its environment\n              -> SimplM (SimplFloats, SimplEnv)\n-- Precondition: not a JoinId\n-- Precondition: rhs obeys the let/app invariant\n-- NOT used for JoinIds\nsimplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se\n  = ASSERT( isId bndr )\n    ASSERT2( not (isJoinId bndr), ppr bndr )\n    -- pprTrace \"simplLazyBind\" ((ppr bndr <+> ppr bndr1) $$ ppr rhs $$ ppr (seIdSubst rhs_se)) $\n    do  { let   rhs_env     = rhs_se `setInScopeFromE` env\n                (tvs, body) = case collectTyAndValBinders rhs of\n                                (tvs, [], body)\n                                  | surely_not_lam body -> (tvs, body)\n                                _                       -> ([], rhs)\n\n                surely_not_lam (Lam {})     = False\n                surely_not_lam (Tick t e)\n                  | not (tickishFloatable t) = surely_not_lam e\n                   -- eta-reduction could float\n                surely_not_lam _            = True\n                        -- Do not do the \"abstract tyvar\" thing if there's\n                        -- a lambda inside, because it defeats eta-reduction\n                        --    f = /\\a. \\x. g a x\n                        -- should eta-reduce.\n\n\n        ; (body_env, tvs') <- {-#SCC \"simplBinders\" #-} simplBinders rhs_env tvs\n                -- See Note [Floating and type abstraction] in SimplUtils\n\n        -- Simplify the RHS\n        ; let rhs_cont = mkRhsStop (substTy body_env (exprType body))\n        ; (body_floats0, body0) <- {-#SCC \"simplExprF\" #-} simplExprF body_env body rhs_cont\n\n              -- Never float join-floats out of a non-join let-binding\n              -- So wrap the body in the join-floats right now\n              -- Hence: body_floats1 consists only of let-floats\n        ; let (body_floats1, body1) = wrapJoinFloatsX body_floats0 body0\n\n        -- ANF-ise a constructor or PAP rhs\n        -- We get at most one float per argument here\n        ; (let_floats, body2) <- {-#SCC \"prepareRhs\" #-} prepareRhs (getMode env) top_lvl\n                                            (getOccFS bndr1) (idInfo bndr1) body1\n        ; let body_floats2 = body_floats1 `addLetFloats` let_floats\n\n        ; (rhs_floats, rhs')\n            <-  if not (doFloatFromRhs top_lvl is_rec False body_floats2 body2)\n                then                    -- No floating, revert to body1\n                     {-#SCC \"simplLazyBind-no-floating\" #-}\n                     do { rhs' <- mkLam env tvs' (wrapFloats body_floats2 body1) rhs_cont\n                        ; return (emptyFloats env, rhs') }\n\n                else if null tvs then   -- Simple floating\n                     {-#SCC \"simplLazyBind-simple-floating\" #-}\n                     do { tick LetFloatFromLet\n                        ; return (body_floats2, body2) }\n\n                else                    -- Do type-abstraction first\n                     {-#SCC \"simplLazyBind-type-abstraction-first\" #-}\n                     do { tick LetFloatFromLet\n                        ; (poly_binds, body3) <- abstractFloats (seDynFlags env) top_lvl\n                                                                tvs' body_floats2 body2\n                        ; let floats = foldl' extendFloats (emptyFloats env) poly_binds\n                        ; rhs' <- mkLam env tvs' body3 rhs_cont\n                        ; return (floats, rhs') }\n\n        ; (bind_float, env2) <- completeBind (env `setInScopeFromF` rhs_floats)\n                                             top_lvl Nothing bndr bndr1 rhs'\n        ; return (rhs_floats `addFloats` bind_float, env2) }\n\n--------------------------\nsimplJoinBind :: SimplEnv\n              -> SimplCont\n              -> InId -> OutId          -- Binder, both pre-and post simpl\n                                        -- The OutId has IdInfo, except arity,\n                                        --   unfolding\n              -> InExpr -> SimplEnv     -- The right hand side and its env\n              -> SimplM (SimplFloats, SimplEnv)\nsimplJoinBind env cont old_bndr new_bndr rhs rhs_se\n  = do  { let rhs_env = rhs_se `setInScopeFromE` env\n        ; rhs' <- simplJoinRhs rhs_env old_bndr rhs cont\n        ; completeBind env NotTopLevel (Just cont) old_bndr new_bndr rhs' }\n\n--------------------------\nsimplNonRecX :: SimplEnv\n             -> InId            -- Old binder; not a JoinId\n             -> OutExpr         -- Simplified RHS\n             -> SimplM (SimplFloats, SimplEnv)\n-- A specialised variant of simplNonRec used when the RHS is already\n-- simplified, notably in knownCon.  It uses case-binding where necessary.\n--\n-- Precondition: rhs satisfies the let/app invariant\n\nsimplNonRecX env bndr new_rhs\n  | ASSERT2( not (isJoinId bndr), ppr bndr )\n    isDeadBinder bndr   -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p }\n  = return (emptyFloats env, env)    --  Here c is dead, and we avoid\n                                         --  creating the binding c = (a,b)\n\n  | Coercion co <- new_rhs\n  = return (emptyFloats env, extendCvSubst env bndr co)\n\n  | otherwise\n  = do  { (env', bndr') <- simplBinder env bndr\n        ; completeNonRecX NotTopLevel env' (isStrictId bndr) bndr bndr' new_rhs }\n                -- simplNonRecX is only used for NotTopLevel things\n\n--------------------------\ncompleteNonRecX :: TopLevelFlag -> SimplEnv\n                -> Bool\n                -> InId                 -- Old binder; not a JoinId\n                -> OutId                -- New binder\n                -> OutExpr              -- Simplified RHS\n                -> SimplM (SimplFloats, SimplEnv)    -- The new binding is in the floats\n-- Precondition: rhs satisfies the let/app invariant\n--               See Note [CoreSyn let/app invariant] in CoreSyn\n\ncompleteNonRecX top_lvl env is_strict old_bndr new_bndr new_rhs\n  = ASSERT2( not (isJoinId new_bndr), ppr new_bndr )\n    do  { (prepd_floats, rhs1) <- prepareRhs (getMode env) top_lvl (getOccFS new_bndr)\n                                             (idInfo new_bndr) new_rhs\n        ; let floats = emptyFloats env `addLetFloats` prepd_floats\n        ; (rhs_floats, rhs2) <-\n                if doFloatFromRhs NotTopLevel NonRecursive is_strict floats rhs1\n                then    -- Add the floats to the main env\n                     do { tick LetFloatFromLet\n                        ; return (floats, rhs1) }\n                else    -- Do not float; wrap the floats around the RHS\n                     return (emptyFloats env, wrapFloats floats rhs1)\n\n        ; (bind_float, env2) <- completeBind (env `setInScopeFromF` rhs_floats)\n                                             NotTopLevel Nothing\n                                             old_bndr new_bndr rhs2\n        ; return (rhs_floats `addFloats` bind_float, env2) }\n\n\n{- *********************************************************************\n*                                                                      *\n           prepareRhs, makeTrivial\n*                                                                      *\n************************************************************************\n\nNote [prepareRhs]\n~~~~~~~~~~~~~~~~~\nprepareRhs takes a putative RHS, checks whether it's a PAP or\nconstructor application and, if so, converts it to ANF, so that the\nresulting thing can be inlined more easily.  Thus\n        x = (f a, g b)\nbecomes\n        t1 = f a\n        t2 = g b\n        x = (t1,t2)\n\nWe also want to deal well cases like this\n        v = (f e1 `cast` co) e2\nHere we want to make e1,e2 trivial and get\n        x1 = e1; x2 = e2; v = (f x1 `cast` co) v2\nThat's what the 'go' loop in prepareRhs does\n-}\n\nprepareRhs :: SimplMode -> TopLevelFlag\n           -> FastString   -- Base for any new variables\n           -> IdInfo       -- IdInfo for the LHS of this binding\n           -> OutExpr\n           -> SimplM (LetFloats, OutExpr)\n-- Transforms a RHS into a better RHS by adding floats\n-- e.g        x = Just e\n-- becomes    a = e\n--            x = Just a\n-- See Note [prepareRhs]\nprepareRhs mode top_lvl occ info (Cast rhs co)  -- Note [Float coercions]\n  | Pair ty1 _ty2 <- coercionKind co         -- Do *not* do this if rhs has an unlifted type\n  , not (isUnliftedType ty1)                 -- see Note [Float coercions (unlifted)]\n  = do  { (floats, rhs') <- makeTrivialWithInfo mode top_lvl occ sanitised_info rhs\n        ; return (floats, Cast rhs' co) }\n  where\n    sanitised_info = vanillaIdInfo `setStrictnessInfo` strictnessInfo info\n                                   `setDemandInfo`     demandInfo info\n\nprepareRhs mode top_lvl occ _ rhs0\n  = do  { (_is_exp, floats, rhs1) <- go 0 rhs0\n        ; return (floats, rhs1) }\n  where\n    go :: Int -> OutExpr -> SimplM (Bool, LetFloats, OutExpr)\n    go n_val_args (Cast rhs co)\n        = do { (is_exp, floats, rhs') <- go n_val_args rhs\n             ; return (is_exp, floats, Cast rhs' co) }\n    go n_val_args (App fun (Type ty))\n        = do { (is_exp, floats, rhs') <- go n_val_args fun\n             ; return (is_exp, floats, App rhs' (Type ty)) }\n    go n_val_args (App fun arg)\n        = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun\n             ; case is_exp of\n                False -> return (False, emptyLetFloats, App fun arg)\n                True  -> do { (floats2, arg') <- makeTrivial mode top_lvl occ arg\n                            ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } }\n    go n_val_args (Var fun)\n        = return (is_exp, emptyLetFloats, Var fun)\n        where\n          is_exp = isExpandableApp fun n_val_args   -- The fun a constructor or PAP\n                        -- See Note [CONLIKE pragma] in BasicTypes\n                        -- The definition of is_exp should match that in\n                        -- OccurAnal.occAnalApp\n\n    go n_val_args (Tick t rhs)\n        -- We want to be able to float bindings past this\n        -- tick. Non-scoping ticks don't care.\n        | tickishScoped t == NoScope\n        = do { (is_exp, floats, rhs') <- go n_val_args rhs\n             ; return (is_exp, floats, Tick t rhs') }\n\n        -- On the other hand, for scoping ticks we need to be able to\n        -- copy them on the floats, which in turn is only allowed if\n        -- we can obtain non-counting ticks.\n        | (not (tickishCounts t) || tickishCanSplit t)\n        = do { (is_exp, floats, rhs') <- go n_val_args rhs\n             ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr)\n                   floats' = mapLetFloats floats tickIt\n             ; return (is_exp, floats', Tick t rhs') }\n\n    go _ other\n        = return (False, emptyLetFloats, other)\n\n{-\nNote [Float coercions]\n~~~~~~~~~~~~~~~~~~~~~~\nWhen we find the binding\n        x = e `cast` co\nwe'd like to transform it to\n        x' = e\n        x = x `cast` co         -- A trivial binding\nThere's a chance that e will be a constructor application or function, or something\nlike that, so moving the coercion to the usage site may well cancel the coercions\nand lead to further optimisation.  Example:\n\n     data family T a :: *\n     data instance T Int = T Int\n\n     foo :: Int -> Int -> Int\n     foo m n = ...\n        where\n          x = T m\n          go 0 = 0\n          go n = case x of { T m -> go (n-m) }\n                -- This case should optimise\n\nNote [Preserve strictness when floating coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the Note [Float coercions] transformation, keep the strictness info.\nEg\n        f = e `cast` co    -- f has strictness SSL\nWhen we transform to\n        f' = e             -- f' also has strictness SSL\n        f = f' `cast` co   -- f still has strictness SSL\n\nIts not wrong to drop it on the floor, but better to keep it.\n\nNote [Float coercions (unlifted)]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBUT don't do [Float coercions] if 'e' has an unlifted type.\nThis *can* happen:\n\n     foo :: Int = (error (# Int,Int #) \"urk\")\n                  `cast` CoUnsafe (# Int,Int #) Int\n\nIf do the makeTrivial thing to the error call, we'll get\n    foo = case error (# Int,Int #) \"urk\" of v -> v `cast` ...\nBut 'v' isn't in scope!\n\nThese strange casts can happen as a result of case-of-case\n        bar = case (case x of { T -> (# 2,3 #); F -> error \"urk\" }) of\n                (# p,q #) -> p+q\n-}\n\nmakeTrivialArg :: SimplMode -> ArgSpec -> SimplM (LetFloats, ArgSpec)\nmakeTrivialArg mode (ValArg e)\n  = do { (floats, e') <- makeTrivial mode NotTopLevel (fsLit \"arg\") e\n       ; return (floats, ValArg e') }\nmakeTrivialArg _ arg\n  = return (emptyLetFloats, arg)  -- CastBy, TyArg\n\nmakeTrivial :: SimplMode -> TopLevelFlag\n            -> FastString  -- ^ A \"friendly name\" to build the new binder from\n            -> OutExpr     -- ^ This expression satisfies the let/app invariant\n            -> SimplM (LetFloats, OutExpr)\n-- Binds the expression to a variable, if it's not trivial, returning the variable\nmakeTrivial mode top_lvl context expr\n = makeTrivialWithInfo mode top_lvl context vanillaIdInfo expr\n\nmakeTrivialWithInfo :: SimplMode -> TopLevelFlag\n                    -> FastString  -- ^ a \"friendly name\" to build the new binder from\n                    -> IdInfo\n                    -> OutExpr     -- ^ This expression satisfies the let/app invariant\n                    -> SimplM (LetFloats, OutExpr)\n-- Propagate strictness and demand info to the new binder\n-- Note [Preserve strictness when floating coercions]\n-- Returned SimplEnv has same substitution as incoming one\nmakeTrivialWithInfo mode top_lvl occ_fs info expr\n  | exprIsTrivial expr                          -- Already trivial\n  || not (bindingOk top_lvl expr expr_ty)       -- Cannot trivialise\n                                                --   See Note [Cannot trivialise]\n  = return (emptyLetFloats, expr)\n\n  | otherwise\n  = do  { (floats, expr1) <- prepareRhs mode top_lvl occ_fs info expr\n        ; if   exprIsTrivial expr1  -- See Note [Trivial after prepareRhs]\n          then return (floats, expr1)\n          else do\n        { uniq <- getUniqueM\n        ; let name = mkSystemVarName uniq occ_fs\n              var  = mkLocalIdOrCoVarWithInfo name expr_ty info\n\n        -- Now something very like completeBind,\n        -- but without the postInlineUnconditinoally part\n        ; (arity, is_bot, expr2) <- tryEtaExpandRhs mode var expr1\n        ; unf <- mkLetUnfolding (sm_dflags mode) top_lvl InlineRhs var expr2\n\n        ; let final_id = addLetBndrInfo var arity is_bot unf\n              bind     = NonRec final_id expr2\n\n        ; return ( floats `addLetFlts` unitLetFloat bind, Var final_id ) }}\n   where\n     expr_ty = exprType expr\n\nbindingOk :: TopLevelFlag -> CoreExpr -> Type -> Bool\n-- True iff we can have a binding of this expression at this level\n-- Precondition: the type is the type of the expression\nbindingOk top_lvl expr expr_ty\n  | isTopLevel top_lvl = exprIsTopLevelBindable expr expr_ty\n  | otherwise          = True\n\n{- Note [Trivial after prepareRhs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we call makeTrival on (e |> co), the recursive use of prepareRhs\nmay leave us with\n   { a1 = e }  and   (a1 |> co)\nNow the latter is trivial, so we don't want to let-bind it.\n\nNote [Cannot trivialise]\n~~~~~~~~~~~~~~~~~~~~~~~~\nConsider:\n   f :: Int -> Addr#\n\n   foo :: Bar\n   foo = Bar (f 3)\n\nThen we can't ANF-ise foo, even though we'd like to, because\nwe can't make a top-level binding for the Addr# (f 3). And if\nso we don't want to turn it into\n   foo = let x = f 3 in Bar x\nbecause we'll just end up inlining x back, and that makes the\nsimplifier loop.  Better not to ANF-ise it at all.\n\nLiteral strings are an exception.\n\n   foo = Ptr \"blob\"#\n\nWe want to turn this into:\n\n   foo1 = \"blob\"#\n   foo = Ptr foo1\n\nSee Note [CoreSyn top-level string literals] in CoreSyn.\n\n************************************************************************\n*                                                                      *\n          Completing a lazy binding\n*                                                                      *\n************************************************************************\n\ncompleteBind\n  * deals only with Ids, not TyVars\n  * takes an already-simplified binder and RHS\n  * is used for both recursive and non-recursive bindings\n  * is used for both top-level and non-top-level bindings\n\nIt does the following:\n  - tries discarding a dead binding\n  - tries PostInlineUnconditionally\n  - add unfolding [this is the only place we add an unfolding]\n  - add arity\n\nIt does *not* attempt to do let-to-case.  Why?  Because it is used for\n  - top-level bindings (when let-to-case is impossible)\n  - many situations where the \"rhs\" is known to be a WHNF\n                (so let-to-case is inappropriate).\n\nNor does it do the atomic-argument thing\n-}\n\ncompleteBind :: SimplEnv\n             -> TopLevelFlag            -- Flag stuck into unfolding\n             -> MaybeJoinCont           -- Required only for join point\n             -> InId                    -- Old binder\n             -> OutId -> OutExpr        -- New binder and RHS\n             -> SimplM (SimplFloats, SimplEnv)\n-- completeBind may choose to do its work\n--      * by extending the substitution (e.g. let x = y in ...)\n--      * or by adding to the floats in the envt\n--\n-- Binder /can/ be a JoinId\n-- Precondition: rhs obeys the let/app invariant\ncompleteBind env top_lvl mb_cont old_bndr new_bndr new_rhs\n | isCoVar old_bndr\n = case new_rhs of\n     Coercion co -> return (emptyFloats env, extendCvSubst env old_bndr co)\n     _           -> return (mkFloatBind env (NonRec new_bndr new_rhs))\n\n | otherwise\n = ASSERT( isId new_bndr )\n   do { let old_info = idInfo old_bndr\n            old_unf  = unfoldingInfo old_info\n            occ_info = occInfo old_info\n\n         -- Do eta-expansion on the RHS of the binding\n         -- See Note [Eta-expanding at let bindings] in SimplUtils\n      ; (new_arity, is_bot, final_rhs) <- tryEtaExpandRhs (getMode env)\n                                                          new_bndr new_rhs\n\n        -- Simplify the unfolding\n      ; new_unfolding <- simplLetUnfolding env top_lvl mb_cont old_bndr\n                                           final_rhs (idType new_bndr) old_unf\n\n      ; let final_bndr = addLetBndrInfo new_bndr new_arity is_bot new_unfolding\n\n      ; if postInlineUnconditionally env top_lvl final_bndr occ_info final_rhs\n\n        then -- Inline and discard the binding\n             do  { tick (PostInlineUnconditionally old_bndr)\n                 ; return ( emptyFloats env\n                          , extendIdSubst env old_bndr $\n                            DoneEx final_rhs (isJoinId_maybe new_bndr)) }\n                -- Use the substitution to make quite, quite sure that the\n                -- substitution will happen, since we are going to discard the binding\n\n        else -- Keep the binding\n             -- pprTrace \"Binding\" (ppr final_bndr <+> ppr new_unfolding) $\n             return (mkFloatBind env (NonRec final_bndr final_rhs)) }\n\naddLetBndrInfo :: OutId -> Arity -> Bool -> Unfolding -> OutId\naddLetBndrInfo new_bndr new_arity is_bot new_unf\n  = new_bndr `setIdInfo` info5\n  where\n    info1 = idInfo new_bndr `setArityInfo` new_arity\n\n    -- Unfolding info: Note [Setting the new unfolding]\n    info2 = info1 `setUnfoldingInfo` new_unf\n\n    -- Demand info: Note [Setting the demand info]\n    -- We also have to nuke demand info if for some reason\n    -- eta-expansion *reduces* the arity of the binding to less\n    -- than that of the strictness sig. This can happen: see Note [Arity decrease].\n    info3 | isEvaldUnfolding new_unf\n            || (case strictnessInfo info2 of\n                  StrictSig dmd_ty -> new_arity < dmdTypeDepth dmd_ty)\n          = zapDemandInfo info2 `orElse` info2\n          | otherwise\n          = info2\n\n    -- Bottoming bindings: see Note [Bottoming bindings]\n    info4 | is_bot    = info3 `setStrictnessInfo`\n                        mkClosedStrictSig (replicate new_arity topDmd) botRes\n          | otherwise = info3\n\n     -- Zap call arity info. We have used it by now (via\n     -- `tryEtaExpandRhs`), and the simplifier can invalidate this\n     -- information, leading to broken code later (e.g. #13479)\n    info5 = zapCallArityInfo info4\n\n\n{- Note [Arity decrease]\n~~~~~~~~~~~~~~~~~~~~~~~~\nGenerally speaking the arity of a binding should not decrease.  But it *can*\nlegitimately happen because of RULES.  Eg\n        f = g Int\nwhere g has arity 2, will have arity 2.  But if there's a rewrite rule\n        g Int --> h\nwhere h has arity 1, then f's arity will decrease.  Here's a real-life example,\nwhich is in the output of Specialise:\n\n     Rec {\n        $dm {Arity 2} = \\d.\\x. op d\n        {-# RULES forall d. $dm Int d = $s$dm #-}\n\n        dInt = MkD .... opInt ...\n        opInt {Arity 1} = $dm dInt\n\n        $s$dm {Arity 0} = \\x. op dInt }\n\nHere opInt has arity 1; but when we apply the rule its arity drops to 0.\nThat's why Specialise goes to a little trouble to pin the right arity\non specialised functions too.\n\nNote [Bottoming bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n   let x = error \"urk\"\n   in ...(case x of <alts>)...\nor\n   let f = \\x. error (x ++ \"urk\")\n   in ...(case f \"foo\" of <alts>)...\n\nThen we'd like to drop the dead <alts> immediately.  So it's good to\npropagate the info that x's RHS is bottom to x's IdInfo as rapidly as\npossible.\n\nWe use tryEtaExpandRhs on every binding, and it turns ou that the\narity computation it performs (via CoreArity.findRhsArity) already\ndoes a simple bottoming-expression analysis.  So all we need to do\nis propagate that info to the binder's IdInfo.\n\nThis showed up in Trac #12150; see comment:16.\n\nNote [Setting the demand info]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the unfolding is a value, the demand info may\ngo pear-shaped, so we nuke it.  Example:\n     let x = (a,b) in\n     case x of (p,q) -> h p q x\nHere x is certainly demanded. But after we've nuked\nthe case, we'll get just\n     let x = (a,b) in h a b x\nand now x is not demanded (I'm assuming h is lazy)\nThis really happens.  Similarly\n     let f = \\x -> e in ...f..f...\nAfter inlining f at some of its call sites the original binding may\n(for example) be no longer strictly demanded.\nThe solution here is a bit ad hoc...\n\n\n************************************************************************\n*                                                                      *\n\\subsection[Simplify-simplExpr]{The main function: simplExpr}\n*                                                                      *\n************************************************************************\n\nThe reason for this OutExprStuff stuff is that we want to float *after*\nsimplifying a RHS, not before.  If we do so naively we get quadratic\nbehaviour as things float out.\n\nTo see why it's important to do it after, consider this (real) example:\n\n        let t = f x\n        in fst t\n==>\n        let t = let a = e1\n                    b = e2\n                in (a,b)\n        in fst t\n==>\n        let a = e1\n            b = e2\n            t = (a,b)\n        in\n        a       -- Can't inline a this round, cos it appears twice\n==>\n        e1\n\nEach of the ==> steps is a round of simplification.  We'd save a\nwhole round if we float first.  This can cascade.  Consider\n\n        let f = g d\n        in \\x -> ...f...\n==>\n        let f = let d1 = ..d.. in \\y -> e\n        in \\x -> ...f...\n==>\n        let d1 = ..d..\n        in \\x -> ...(\\y ->e)...\n\nOnly in this second round can the \\y be applied, and it\nmight do the same again.\n-}\n\nsimplExpr :: SimplEnv -> CoreExpr -> SimplM CoreExpr\nsimplExpr env (Type ty)\n  = do { ty' <- simplType env ty  -- See Note [Avoiding space leaks in OutType]\n       ; return (Type ty') }\n\nsimplExpr env expr\n  = simplExprC env expr (mkBoringStop expr_out_ty)\n  where\n    expr_out_ty :: OutType\n    expr_out_ty = substTy env (exprType expr)\n    -- NB: Since 'expr' is term-valued, not (Type ty), this call\n    --     to exprType will succeed.  exprType fails on (Type ty).\n\nsimplExprC :: SimplEnv\n           -> InExpr     -- A term-valued expression, never (Type ty)\n           -> SimplCont\n           -> SimplM OutExpr\n        -- Simplify an expression, given a continuation\nsimplExprC env expr cont\n  = -- pprTrace \"simplExprC\" (ppr expr $$ ppr cont {- $$ ppr (seIdSubst env) -} $$ ppr (seLetFloats env) ) $\n    do  { (floats, expr') <- simplExprF env expr cont\n        ; -- pprTrace \"simplExprC ret\" (ppr expr $$ ppr expr') $\n          -- pprTrace \"simplExprC ret3\" (ppr (seInScope env')) $\n          -- pprTrace \"simplExprC ret4\" (ppr (seLetFloats env')) $\n          return (wrapFloats floats expr') }\n\n--------------------------------------------------\nsimplExprF :: SimplEnv\n           -> InExpr     -- A term-valued expression, never (Type ty)\n           -> SimplCont\n           -> SimplM (SimplFloats, OutExpr)\n\nsimplExprF env e cont\n  = {- pprTrace \"simplExprF\" (vcat\n      [ ppr e\n      , text \"cont =\" <+> ppr cont\n      , text \"inscope =\" <+> ppr (seInScope env)\n      , text \"tvsubst =\" <+> ppr (seTvSubst env)\n      , text \"idsubst =\" <+> ppr (seIdSubst env)\n      , text \"cvsubst =\" <+> ppr (seCvSubst env)\n      ]) $ -}\n    simplExprF1 env e cont\n\nsimplExprF1 :: SimplEnv -> InExpr -> SimplCont\n            -> SimplM (SimplFloats, OutExpr)\n\nsimplExprF1 _ (Type ty) _\n  = pprPanic \"simplExprF: type\" (ppr ty)\n    -- simplExprF does only with term-valued expressions\n    -- The (Type ty) case is handled separately by simplExpr\n    -- and by the other callers of simplExprF\n\nsimplExprF1 env (Var v)        cont = {-#SCC \"simplIdF\" #-} simplIdF env v cont\nsimplExprF1 env (Lit lit)      cont = {-#SCC \"rebuild\" #-} rebuild env (Lit lit) cont\nsimplExprF1 env (Tick t expr)  cont = {-#SCC \"simplTick\" #-} simplTick env t expr cont\nsimplExprF1 env (Cast body co) cont = {-#SCC \"simplCast\" #-} simplCast env body co cont\nsimplExprF1 env (Coercion co)  cont = {-#SCC \"simplCoercionF\" #-} simplCoercionF env co cont\n\nsimplExprF1 env (App fun arg) cont\n  = {-#SCC \"simplExprF1-App\" #-} case arg of\n      Type ty -> do { -- The argument type will (almost) certainly be used\n                      -- in the output program, so just force it now.\n                      -- See Note [Avoiding space leaks in OutType]\n                      arg' <- simplType env ty\n\n                      -- But use substTy, not simplType, to avoid forcing\n                      -- the hole type; it will likely not be needed.\n                      -- See Note [The hole type in ApplyToTy]\n                    ; let hole' = substTy env (exprType fun)\n\n                    ; simplExprF env fun $\n                      ApplyToTy { sc_arg_ty  = arg'\n                                , sc_hole_ty = hole'\n                                , sc_cont    = cont } }\n      _       -> simplExprF env fun $\n                 ApplyToVal { sc_arg = arg, sc_env = env\n                            , sc_dup = NoDup, sc_cont = cont }\n\nsimplExprF1 env expr@(Lam {}) cont\n  = {-#SCC \"simplExprF1-Lam\" #-}\n    simplLam env zapped_bndrs body cont\n        -- The main issue here is under-saturated lambdas\n        --   (\\x1. \\x2. e) arg1\n        -- Here x1 might have \"occurs-once\" occ-info, because occ-info\n        -- is computed assuming that a group of lambdas is applied\n        -- all at once.  If there are too few args, we must zap the\n        -- occ-info, UNLESS the remaining binders are one-shot\n  where\n    (bndrs, body) = collectBinders expr\n    zapped_bndrs | need_to_zap = map zap bndrs\n                 | otherwise   = bndrs\n\n    need_to_zap = any zappable_bndr (drop n_args bndrs)\n    n_args = countArgs cont\n        -- NB: countArgs counts all the args (incl type args)\n        -- and likewise drop counts all binders (incl type lambdas)\n\n    zappable_bndr b = isId b && not (isOneShotBndr b)\n    zap b | isTyVar b = b\n          | otherwise = zapLamIdInfo b\n\nsimplExprF1 env (Case scrut bndr _ alts) cont\n  = {-#SCC \"simplExprF1-Case\" #-}\n    simplExprF env scrut (Select { sc_dup = NoDup, sc_bndr = bndr\n                                 , sc_alts = alts\n                                 , sc_env = env, sc_cont = cont })\n\nsimplExprF1 env (Let (Rec pairs) body) cont\n  | Just pairs' <- joinPointBindings_maybe pairs\n  = {-#SCC \"simplRecJoinPoin\" #-} simplRecJoinPoint env pairs' body cont\n\n  | otherwise\n  = {-#SCC \"simplRecE\" #-} simplRecE env pairs body cont\n\nsimplExprF1 env (Let (NonRec bndr rhs) body) cont\n  | Type ty <- rhs    -- First deal with type lets (let a = Type ty in e)\n  = {-#SCC \"simplExprF1-NonRecLet-Type\" #-}\n    ASSERT( isTyVar bndr )\n    do { ty' <- simplType env ty\n       ; simplExprF (extendTvSubst env bndr ty') body cont }\n\n  | Just (bndr', rhs') <- joinPointBinding_maybe bndr rhs\n  = {-#SCC \"simplNonRecJoinPoint\" #-} simplNonRecJoinPoint env bndr' rhs' body cont\n\n  | otherwise\n  = {-#SCC \"simplNonRecE\" #-} simplNonRecE env bndr (rhs, env) ([], body) cont\n\n{- Note [Avoiding space leaks in OutType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSince the simplifier is run for multiple iterations, we need to ensure\nthat any thunks in the output of one simplifier iteration are forced\nby the evaluation of the next simplifier iteration. Otherwise we may\nretain multiple copies of the Core program and leak a terrible amount\nof memory (as in #13426).\n\nThe simplifier is naturally strict in the entire \"Expr part\" of the\ninput Core program, because any expression may contain binders, which\nwe must find in order to extend the SimplEnv accordingly. But types\ndo not contain binders and so it is tempting to write things like\n\n    simplExpr env (Type ty) = return (Type (substTy env ty))   -- Bad!\n\nThis is Bad because the result includes a thunk (substTy env ty) which\nretains a reference to the whole simplifier environment; and the next\nsimplifier iteration will not force this thunk either, because the\nline above is not strict in ty.\n\nSo instead our strategy is for the simplifier to fully evaluate\nOutTypes when it emits them into the output Core program, for example\n\n    simplExpr env (Type ty) = do { ty' <- simplType env ty     -- Good\n                                 ; return (Type ty') }\n\nwhere the only difference from above is that simplType calls seqType\non the result of substTy.\n\nHowever, SimplCont can also contain OutTypes and it's not necessarily\na good idea to force types on the way in to SimplCont, because they\nmay end up not being used and forcing them could be a lot of wasted\nwork. T5631 is a good example of this.\n\n- For ApplyToTy's sc_arg_ty, we force the type on the way in because\n  the type will almost certainly appear as a type argument in the\n  output program.\n\n- For the hole types in Stop and ApplyToTy, we force the type when we\n  emit it into the output program, after obtaining it from\n  contResultType. (The hole type in ApplyToTy is only directly used\n  to form the result type in a new Stop continuation.)\n-}\n\n---------------------------------\n-- Simplify a join point, adding the context.\n-- Context goes *inside* the lambdas. IOW, if the join point has arity n, we do:\n--   \\x1 .. xn -> e => \\x1 .. xn -> E[e]\n-- Note that we need the arity of the join point, since e may be a lambda\n-- (though this is unlikely). See Note [Case-of-case and join points].\nsimplJoinRhs :: SimplEnv -> InId -> InExpr -> SimplCont\n             -> SimplM OutExpr\nsimplJoinRhs env bndr expr cont\n  | Just arity <- isJoinId_maybe bndr\n  =  do { let (join_bndrs, join_body) = collectNBinders arity expr\n        ; (env', join_bndrs') <- simplLamBndrs env join_bndrs\n        ; join_body' <- simplExprC env' join_body cont\n        ; return $ mkLams join_bndrs' join_body' }\n\n  | otherwise\n  = pprPanic \"simplJoinRhs\" (ppr bndr)\n\n---------------------------------\nsimplType :: SimplEnv -> InType -> SimplM OutType\n        -- Kept monadic just so we can do the seqType\n        -- See Note [Avoiding space leaks in OutType]\nsimplType env ty\n  = -- pprTrace \"simplType\" (ppr ty $$ ppr (seTvSubst env)) $\n    seqType new_ty `seq` return new_ty\n  where\n    new_ty = substTy env ty\n\n---------------------------------\nsimplCoercionF :: SimplEnv -> InCoercion -> SimplCont\n               -> SimplM (SimplFloats, OutExpr)\nsimplCoercionF env co cont\n  = do { co' <- simplCoercion env co\n       ; rebuild env (Coercion co') cont }\n\nsimplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion\nsimplCoercion env co\n  = do { dflags <- getDynFlags\n       ; let opt_co = optCoercion dflags (getTCvSubst env) co\n       ; seqCo opt_co `seq` return opt_co }\n\n-----------------------------------\n-- | Push a TickIt context outwards past applications and cases, as\n-- long as this is a non-scoping tick, to let case and application\n-- optimisations apply.\n\nsimplTick :: SimplEnv -> Tickish Id -> InExpr -> SimplCont\n          -> SimplM (SimplFloats, OutExpr)\nsimplTick env tickish expr cont\n  -- A scoped tick turns into a continuation, so that we can spot\n  -- (scc t (\\x . e)) in simplLam and eliminate the scc.  If we didn't do\n  -- it this way, then it would take two passes of the simplifier to\n  -- reduce ((scc t (\\x . e)) e').\n  -- NB, don't do this with counting ticks, because if the expr is\n  -- bottom, then rebuildCall will discard the continuation.\n\n-- XXX: we cannot do this, because the simplifier assumes that\n-- the context can be pushed into a case with a single branch. e.g.\n--    scc<f>  case expensive of p -> e\n-- becomes\n--    case expensive of p -> scc<f> e\n--\n-- So I'm disabling this for now.  It just means we will do more\n-- simplifier iterations that necessary in some cases.\n\n--  | tickishScoped tickish && not (tickishCounts tickish)\n--  = simplExprF env expr (TickIt tickish cont)\n\n  -- For unscoped or soft-scoped ticks, we are allowed to float in new\n  -- cost, so we simply push the continuation inside the tick.  This\n  -- has the effect of moving the tick to the outside of a case or\n  -- application context, allowing the normal case and application\n  -- optimisations to fire.\n  | tickish `tickishScopesLike` SoftScope\n  = do { (floats, expr') <- simplExprF env expr cont\n       ; return (floats, mkTick tickish expr')\n       }\n\n  -- Push tick inside if the context looks like this will allow us to\n  -- do a case-of-case - see Note [case-of-scc-of-case]\n  | Select {} <- cont, Just expr' <- push_tick_inside\n  = simplExprF env expr' cont\n\n  -- We don't want to move the tick, but we might still want to allow\n  -- floats to pass through with appropriate wrapping (or not, see\n  -- wrap_floats below)\n  --- | not (tickishCounts tickish) || tickishCanSplit tickish\n  -- = wrap_floats\n\n  | otherwise\n  = no_floating_past_tick\n\n where\n\n  -- Try to push tick inside a case, see Note [case-of-scc-of-case].\n  push_tick_inside =\n    case expr0 of\n      Case scrut bndr ty alts\n             -> Just $ Case (tickScrut scrut) bndr ty (map tickAlt alts)\n      _other -> Nothing\n   where (ticks, expr0) = stripTicksTop movable (Tick tickish expr)\n         movable t      = not (tickishCounts t) ||\n                          t `tickishScopesLike` NoScope ||\n                          tickishCanSplit t\n         tickScrut e    = foldr mkTick e ticks\n         -- Alternatives get annotated with all ticks that scope in some way,\n         -- but we don't want to count entries.\n         tickAlt (c,bs,e) = (c,bs, foldr mkTick e ts_scope)\n         ts_scope         = map mkNoCount $\n                            filter (not . (`tickishScopesLike` NoScope)) ticks\n\n  no_floating_past_tick =\n    do { let (inc,outc) = splitCont cont\n       ; (floats, expr1) <- simplExprF env expr inc\n       ; let expr2    = wrapFloats floats expr1\n             tickish' = simplTickish env tickish\n       ; rebuild env (mkTick tickish' expr2) outc\n       }\n\n-- Alternative version that wraps outgoing floats with the tick.  This\n-- results in ticks being duplicated, as we don't make any attempt to\n-- eliminate the tick if we re-inline the binding (because the tick\n-- semantics allows unrestricted inlining of HNFs), so I'm not doing\n-- this any more.  FloatOut will catch any real opportunities for\n-- floating.\n--\n--  wrap_floats =\n--    do { let (inc,outc) = splitCont cont\n--       ; (env', expr') <- simplExprF (zapFloats env) expr inc\n--       ; let tickish' = simplTickish env tickish\n--       ; let wrap_float (b,rhs) = (zapIdStrictness (setIdArity b 0),\n--                                   mkTick (mkNoCount tickish') rhs)\n--              -- when wrapping a float with mkTick, we better zap the Id's\n--              -- strictness info and arity, because it might be wrong now.\n--       ; let env'' = addFloats env (mapFloats env' wrap_float)\n--       ; rebuild env'' expr' (TickIt tickish' outc)\n--       }\n\n\n  simplTickish env tickish\n    | Breakpoint n ids <- tickish\n          = Breakpoint n (map (getDoneId . substId env) ids)\n    | otherwise = tickish\n\n  -- Push type application and coercion inside a tick\n  splitCont :: SimplCont -> (SimplCont, SimplCont)\n  splitCont cont@(ApplyToTy { sc_cont = tail }) = (cont { sc_cont = inc }, outc)\n    where (inc,outc) = splitCont tail\n  splitCont (CastIt co c) = (CastIt co inc, outc)\n    where (inc,outc) = splitCont c\n  splitCont other = (mkBoringStop (contHoleType other), other)\n\n  getDoneId (DoneId id)  = id\n  getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in CoreSubst\n  getDoneId other = pprPanic \"getDoneId\" (ppr other)\n\n-- Note [case-of-scc-of-case]\n-- It's pretty important to be able to transform case-of-case when\n-- there's an SCC in the way.  For example, the following comes up\n-- in nofib/real/compress/Encode.hs:\n--\n--        case scctick<code_string.r1>\n--             case $wcode_string_r13s wild_XC w1_s137 w2_s138 l_aje\n--             of _ { (# ww1_s13f, ww2_s13g, ww3_s13h #) ->\n--             (ww1_s13f, ww2_s13g, ww3_s13h)\n--             }\n--        of _ { (ww_s12Y, ww1_s12Z, ww2_s130) ->\n--        tick<code_string.f1>\n--        (ww_s12Y,\n--         ww1_s12Z,\n--         PTTrees.PT\n--           @ GHC.Types.Char @ GHC.Types.Int wild2_Xj ww2_s130 r_ajf)\n--        }\n--\n-- We really want this case-of-case to fire, because then the 3-tuple\n-- will go away (indeed, the CPR optimisation is relying on this\n-- happening).  But the scctick is in the way - we need to push it\n-- inside to expose the case-of-case.  So we perform this\n-- transformation on the inner case:\n--\n--   scctick c (case e of { p1 -> e1; ...; pn -> en })\n--    ==>\n--   case (scctick c e) of { p1 -> scc c e1; ...; pn -> scc c en }\n--\n-- So we've moved a constant amount of work out of the scc to expose\n-- the case.  We only do this when the continuation is interesting: in\n-- for now, it has to be another Case (maybe generalise this later).\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The main rebuilder}\n*                                                                      *\n************************************************************************\n-}\n\nrebuild :: SimplEnv -> OutExpr -> SimplCont -> SimplM (SimplFloats, OutExpr)\n-- At this point the substitution in the SimplEnv should be irrelevant;\n-- only the in-scope set matters\nrebuild env expr cont\n  = case cont of\n      Stop {}          -> return (emptyFloats env, expr)\n      TickIt t cont    -> rebuild env (mkTick t expr) cont\n      CastIt co cont   -> rebuild env (mkCast expr co) cont\n                       -- NB: mkCast implements the (Coercion co |> g) optimisation\n\n      Select { sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont }\n        -> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont\n\n      StrictArg { sc_fun = fun, sc_cont = cont }\n        -> rebuildCall env (fun `addValArgTo` expr) cont\n      StrictBind { sc_bndr = b, sc_bndrs = bs, sc_body = body\n                 , sc_env = se, sc_cont = cont }\n        -> do { (floats1, env') <- simplNonRecX (se `setInScopeFromE` env) b expr\n                                  -- expr satisfies let/app since it started life\n                                  -- in a call to simplNonRecE\n              ; (floats2, expr') <- simplLam env' bs body cont\n              ; return (floats1 `addFloats` floats2, expr') }\n\n      ApplyToTy  { sc_arg_ty = ty, sc_cont = cont}\n        -> rebuild env (App expr (Type ty)) cont\n\n      ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag, sc_cont = cont}\n        -- See Note [Avoid redundant simplification]\n        -> do { (_, _, arg') <- simplArg env dup_flag se arg\n              ; rebuild env (App expr arg') cont }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Lambdas}\n*                                                                      *\n************************************************************************\n-}\n\n{- Note [Optimising reflexivity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's important (for compiler performance) to get rid of reflexivity as soon\nas it appears.  See Trac #11735, #14737, and #15019.\n\nIn particular, we want to behave well on\n\n *  e |> co1 |> co2\n    where the two happen to cancel out entirely. That is quite common;\n    e.g. a newtype wrapping and unwrapping cancel.\n\n\n * (f |> co) @t1 @t2 ... @tn x1 .. xm\n   Here we wil use pushCoTyArg and pushCoValArg successively, which\n   build up NthCo stacks.  Silly to do that if co is reflexive.\n\nHowever, we don't want to call isReflexiveCo too much, because it uses\ntype equality which is expensive on big types (Trac #14737 comment:7).\n\nA good compromise (determined experimentally) seems to be to call\nisReflexiveCo\n * when composing casts, and\n * at the end\n\nIn investigating this I saw missed opportunities for on-the-fly\ncoercion shrinkage. See Trac #15090.\n-}\n\n\nsimplCast :: SimplEnv -> InExpr -> Coercion -> SimplCont\n          -> SimplM (SimplFloats, OutExpr)\nsimplCast env body co0 cont0\n  = do  { co1   <- {-#SCC \"simplCast-simplCoercion\" #-} simplCoercion env co0\n        ; cont1 <- {-#SCC \"simplCast-addCoerce\" #-}\n                   if isReflCo co1\n                   then return cont0  -- See Note [Optimising reflexivity]\n                   else addCoerce co1 cont0\n        ; {-#SCC \"simplCast-simplExprF\" #-} simplExprF env body cont1 }\n  where\n        -- If the first parameter is MRefl, then simplifying revealed a\n        -- reflexive coercion. Omit.\n        addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont\n        addCoerceM MRefl   cont = return cont\n        addCoerceM (MCo co) cont = addCoerce co cont\n\n        addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont\n        addCoerce co1 (CastIt co2 cont)  -- See Note [Optimising reflexivity]\n          | isReflexiveCo co' = return cont\n          | otherwise         = addCoerce co' cont\n          where\n            co' = mkTransCo co1 co2\n\n        addCoerce co cont@(ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail })\n          | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty\n          = {-#SCC \"addCoerce-pushCoTyArg\" #-}\n            do { tail' <- addCoerceM m_co' tail\n               ; return (cont { sc_arg_ty = arg_ty', sc_cont = tail' }) }\n\n        addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se\n                                      , sc_dup = dup, sc_cont = tail })\n          | Just (co1, m_co2) <- pushCoValArg co\n          , Pair _ new_ty <- coercionKind co1\n          , not (isTypeLevPoly new_ty)  -- Without this check, we get a lev-poly arg\n                                        -- See Note [Levity polymorphism invariants] in CoreSyn\n                                        -- test: typecheck/should_run/EtaExpandLevPoly\n          = {-#SCC \"addCoerce-pushCoValArg\" #-}\n            do { tail' <- addCoerceM m_co2 tail\n               ; if isReflCo co1\n                 then return (cont { sc_cont = tail' })\n                      -- Avoid simplifying if possible;\n                      -- See Note [Avoiding exponential behaviour]\n                 else do\n               { (dup', arg_se', arg') <- simplArg env dup arg_se arg\n                    -- When we build the ApplyTo we can't mix the OutCoercion\n                    -- 'co' with the InExpr 'arg', so we simplify\n                    -- to make it all consistent.  It's a bit messy.\n                    -- But it isn't a common case.\n                    -- Example of use: Trac #995\n               ; return (ApplyToVal { sc_arg  = mkCast arg' co1\n                                    , sc_env  = arg_se'\n                                    , sc_dup  = dup'\n                                    , sc_cont = tail' }) } }\n\n        addCoerce co cont\n          | isReflexiveCo co = return cont  -- Having this at the end makes a huge\n                                            -- difference in T12227, for some reason\n                                            -- See Note [Optimising reflexivity]\n          | otherwise        = return (CastIt co cont)\n\nsimplArg :: SimplEnv -> DupFlag -> StaticEnv -> CoreExpr\n         -> SimplM (DupFlag, StaticEnv, OutExpr)\nsimplArg env dup_flag arg_env arg\n  | isSimplified dup_flag\n  = return (dup_flag, arg_env, arg)\n  | otherwise\n  = do { arg' <- simplExpr (arg_env `setInScopeFromE` env) arg\n       ; return (Simplified, zapSubstEnv arg_env, arg') }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Lambdas}\n*                                                                      *\n************************************************************************\n-}\n\nsimplLam :: SimplEnv -> [InId] -> InExpr -> SimplCont\n         -> SimplM (SimplFloats, OutExpr)\n\nsimplLam env [] body cont\n  = simplExprF env body cont\n\nsimplLam env (bndr:bndrs) body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont })\n  = do { tick (BetaReduction bndr)\n       ; simplLam (extendTvSubst env bndr arg_ty) bndrs body cont }\n\nsimplLam env (bndr:bndrs) body (ApplyToVal { sc_arg = arg, sc_env = arg_se\n                                           , sc_cont = cont, sc_dup = dup })\n  | isSimplified dup  -- Don't re-simplify if we've simplified it once\n                      -- See Note [Avoiding exponential behaviour]\n  = do  { tick (BetaReduction bndr)\n        ; (floats1, env') <- simplNonRecX env zapped_bndr arg\n        ; (floats2, expr') <- simplLam env' bndrs body cont\n        ; return (floats1 `addFloats` floats2, expr') }\n\n  | otherwise\n  = do  { tick (BetaReduction bndr)\n        ; simplNonRecE env zapped_bndr (arg, arg_se) (bndrs, body) cont }\n  where\n    zapped_bndr  -- See Note [Zap unfolding when beta-reducing]\n      | isId bndr = zapStableUnfolding bndr\n      | otherwise = bndr\n\n      -- Discard a non-counting tick on a lambda.  This may change the\n      -- cost attribution slightly (moving the allocation of the\n      -- lambda elsewhere), but we don't care: optimisation changes\n      -- cost attribution all the time.\nsimplLam env bndrs body (TickIt tickish cont)\n  | not (tickishCounts tickish)\n  = simplLam env bndrs body cont\n\n        -- Not enough args, so there are real lambdas left to put in the result\nsimplLam env bndrs body cont\n  = do  { (env', bndrs') <- simplLamBndrs env bndrs\n        ; body' <- simplExpr env' body\n        ; new_lam <- mkLam env bndrs' body' cont\n        ; rebuild env' new_lam cont }\n\n-------------\nsimplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)\n-- Used for lambda binders.  These sometimes have unfoldings added by\n-- the worker/wrapper pass that must be preserved, because they can't\n-- be reconstructed from context.  For example:\n--      f x = case x of (a,b) -> fw a b x\n--      fw a b x{=(a,b)} = ...\n-- The \"{=(a,b)}\" is an unfolding we can't reconstruct otherwise.\nsimplLamBndr env bndr\n  | isId bndr && isFragileUnfolding old_unf   -- Special case\n  = do { (env1, bndr1) <- simplBinder env bndr\n       ; unf'          <- simplStableUnfolding env1 NotTopLevel Nothing bndr\n                                               old_unf (idType bndr1)\n       ; let bndr2 = bndr1 `setIdUnfolding` unf'\n       ; return (modifyInScope env1 bndr2, bndr2) }\n\n  | otherwise\n  = simplBinder env bndr                -- Normal case\n  where\n    old_unf = idUnfolding bndr\n\nsimplLamBndrs :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])\nsimplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs\n\n------------------\nsimplNonRecE :: SimplEnv\n             -> InId                    -- The binder, always an Id\n                                        -- Never a join point\n             -> (InExpr, SimplEnv)      -- Rhs of binding (or arg of lambda)\n             -> ([InBndr], InExpr)      -- Body of the let/lambda\n                                        --      \\xs.e\n             -> SimplCont\n             -> SimplM (SimplFloats, OutExpr)\n\n-- simplNonRecE is used for\n--  * non-top-level non-recursive non-join-point lets in expressions\n--  * beta reduction\n--\n-- simplNonRec env b (rhs, rhs_se) (bs, body) k\n--   = let env in\n--     cont< let b = rhs_se(rhs) in \\bs.body >\n--\n-- It deals with strict bindings, via the StrictBind continuation,\n-- which may abort the whole process\n--\n-- Precondition: rhs satisfies the let/app invariant\n--               Note [CoreSyn let/app invariant] in CoreSyn\n--\n-- The \"body\" of the binding comes as a pair of ([InId],InExpr)\n-- representing a lambda; so we recurse back to simplLam\n-- Why?  Because of the binder-occ-info-zapping done before\n--       the call to simplLam in simplExprF (Lam ...)\n\nsimplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont\n  | ASSERT( isId bndr && not (isJoinId bndr) ) True\n  , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs rhs_se\n  = do { tick (PreInlineUnconditionally bndr)\n       ; -- pprTrace \"preInlineUncond\" (ppr bndr <+> ppr rhs) $\n         simplLam env' bndrs body cont }\n\n  -- Deal with strict bindings\n  | isStrictId bndr          -- Includes coercions\n  , sm_case_case (getMode env)\n  = simplExprF (rhs_se `setInScopeFromE` env) rhs\n               (StrictBind { sc_bndr = bndr, sc_bndrs = bndrs, sc_body = body\n                           , sc_env = env, sc_cont = cont, sc_dup = NoDup })\n\n  -- Deal with lazy bindings\n  | otherwise\n  = ASSERT( not (isTyVar bndr) )\n    do { (env1, bndr1) <- simplNonRecBndr env bndr\n       ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 Nothing\n       ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se\n       ; (floats2, expr') <- simplLam env3 bndrs body cont\n       ; return (floats1 `addFloats` floats2, expr') }\n\n------------------\nsimplRecE :: SimplEnv\n          -> [(InId, InExpr)]\n          -> InExpr\n          -> SimplCont\n          -> SimplM (SimplFloats, OutExpr)\n\n-- simplRecE is used for\n--  * non-top-level recursive lets in expressions\nsimplRecE env pairs body cont\n  = do  { let bndrs = map fst pairs\n        ; MASSERT(all (not . isJoinId) bndrs)\n        ; env1 <- simplRecBndrs env bndrs\n                -- NB: bndrs' don't have unfoldings or rules\n                -- We add them as we go down\n        ; (floats1, env2) <- simplRecBind env1 NotTopLevel Nothing pairs\n        ; (floats2, expr') <- simplExprF env2 body cont\n        ; return (floats1 `addFloats` floats2, expr') }\n\n{- Note [Avoiding exponential behaviour]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOne way in which we can get exponential behaviour is if we simplify a\nbig expression, and the re-simplify it -- and then this happens in a\ndeeply-nested way.  So we must be jolly careful about re-simplifying\nan expression.  That is why completeNonRecX does not try\npreInlineUnconditionally.\n\nExample:\n  f BIG, where f has a RULE\nThen\n * We simplify BIG before trying the rule; but the rule does not fire\n * We inline f = \\x. x True\n * So if we did preInlineUnconditionally we'd re-simplify (BIG True)\n\nHowever, if BIG has /not/ already been simplified, we'd /like/ to\nsimplify BIG True; maybe good things happen.  That is why\n\n* simplLam has\n    - a case for (isSimplified dup), which goes via simplNonRecX, and\n    - a case for the un-simplified case, which goes via simplNonRecE\n\n* We go to some efforts to avoid unnecessarily simplifying ApplyToVal,\n  in at least two places\n    - In simplCast/addCoerce, where we check for isReflCo\n    - In rebuildCall we avoid simplifying arguments before we have to\n      (see Note [Trying rewrite rules])\n\n\nNote [Zap unfolding when beta-reducing]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLambda-bound variables can have stable unfoldings, such as\n   $j = \\x. \\b{Unf=Just x}. e\nSee Note [Case binders and join points] below; the unfolding for lets\nus optimise e better.  However when we beta-reduce it we want to\nrevert to using the actual value, otherwise we can end up in the\nstupid situation of\n          let x = blah in\n          let b{Unf=Just x} = y\n          in ...b...\nHere it'd be far better to drop the unfolding and use the actual RHS.\n\n************************************************************************\n*                                                                      *\n                     Join points\n*                                                                      *\n********************************************************************* -}\n\n{- Note [Rules and unfolding for join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n   simplExpr (join j x = rhs                         ) cont\n             (      {- RULE j (p:ps) = blah -}       )\n             (      {- StableUnfolding j = blah -}   )\n             (in blah                                )\n\nThen we will push 'cont' into the rhs of 'j'.  But we should *also* push\n'cont' into the RHS of\n  * Any RULEs for j, e.g. generated by SpecConstr\n  * Any stable unfolding for j, e.g. the result of an INLINE pragma\n\nSimplifying rules and stable-unfoldings happens a bit after\nsimplifying the right-hand side, so we remember whether or not it\nis a join point, and what 'cont' is, in a value of type MaybeJoinCont\n\nTrac #13900 wsa caused by forgetting to push 'cont' into the RHS\nof a SpecConstr-generated RULE for a join point.\n-}\n\ntype MaybeJoinCont = Maybe SimplCont\n  -- Nothing => Not a join point\n  -- Just k  => This is a join binding with continuation k\n  -- See Note [Rules and unfolding for join points]\n\nsimplNonRecJoinPoint :: SimplEnv -> InId -> InExpr\n                     -> InExpr -> SimplCont\n                     -> SimplM (SimplFloats, OutExpr)\nsimplNonRecJoinPoint env bndr rhs body cont\n  | ASSERT( isJoinId bndr ) True\n  , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env\n  = do { tick (PreInlineUnconditionally bndr)\n       ; simplExprF env' body cont }\n\n   | otherwise\n   = wrapJoinCont env cont $ \\ env cont ->\n     do { -- We push join_cont into the join RHS and the body;\n          -- and wrap wrap_cont around the whole thing\n        ; let res_ty = contResultType cont\n        ; (env1, bndr1)    <- simplNonRecJoinBndr env res_ty bndr\n        ; (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (Just cont)\n        ; (floats1, env3)  <- simplJoinBind env2 cont bndr bndr2 rhs env\n        ; (floats2, body') <- simplExprF env3 body cont\n        ; return (floats1 `addFloats` floats2, body') }\n\n\n------------------\nsimplRecJoinPoint :: SimplEnv -> [(InId, InExpr)]\n                  -> InExpr -> SimplCont\n                  -> SimplM (SimplFloats, OutExpr)\nsimplRecJoinPoint env pairs body cont\n  = wrapJoinCont env cont $ \\ env cont ->\n    do { let bndrs = map fst pairs\n             res_ty = contResultType cont\n       ; env1 <- simplRecJoinBndrs env res_ty bndrs\n               -- NB: bndrs' don't have unfoldings or rules\n               -- We add them as we go down\n       ; (floats1, env2)  <- simplRecBind env1 NotTopLevel (Just cont) pairs\n       ; (floats2, body') <- simplExprF env2 body cont\n       ; return (floats1 `addFloats` floats2, body') }\n\n--------------------\nwrapJoinCont :: SimplEnv -> SimplCont\n             -> (SimplEnv -> SimplCont -> SimplM (SimplFloats, OutExpr))\n             -> SimplM (SimplFloats, OutExpr)\n-- Deal with making the continuation duplicable if necessary,\n-- and with the no-case-of-case situation.\nwrapJoinCont env cont thing_inside\n  | contIsStop cont        -- Common case; no need for fancy footwork\n  = thing_inside env cont\n\n  | not (sm_case_case (getMode env))\n    -- See Note [Join points wih -fno-case-of-case]\n  = do { (floats1, expr1) <- thing_inside env (mkBoringStop (contHoleType cont))\n       ; let (floats2, expr2) = wrapJoinFloatsX floats1 expr1\n       ; (floats3, expr3) <- rebuild (env `setInScopeFromF` floats2) expr2 cont\n       ; return (floats2 `addFloats` floats3, expr3) }\n\n  | otherwise\n    -- Normal case; see Note [Join points and case-of-case]\n  = do { (floats1, cont')  <- mkDupableCont env cont\n       ; (floats2, result) <- thing_inside (env `setInScopeFromF` floats1) cont'\n       ; return (floats1 `addFloats` floats2, result) }\n\n\n--------------------\ntrimJoinCont :: Id -> Maybe JoinArity -> SimplCont -> SimplCont\n-- Drop outer context from join point invocation (jump)\n-- See Note [Join points and case-of-case]\n\ntrimJoinCont _ Nothing cont\n  = cont -- Not a jump\ntrimJoinCont var (Just arity) cont\n  = trim arity cont\n  where\n    trim 0 cont@(Stop {})\n      = cont\n    trim 0 cont\n      = mkBoringStop (contResultType cont)\n    trim n cont@(ApplyToVal { sc_cont = k })\n      = cont { sc_cont = trim (n-1) k }\n    trim n cont@(ApplyToTy { sc_cont = k })\n      = cont { sc_cont = trim (n-1) k } -- join arity counts types!\n    trim _ cont\n      = pprPanic \"completeCall\" $ ppr var $$ ppr cont\n\n\n{- Note [Join points and case-of-case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we perform the case-of-case transform (or otherwise push continuations\ninward), we want to treat join points specially. Since they're always\ntail-called and we want to maintain this invariant, we can do this (for any\nevaluation context E):\n\n  E[join j = e\n    in case ... of\n         A -> jump j 1\n         B -> jump j 2\n         C -> f 3]\n\n    -->\n\n  join j = E[e]\n  in case ... of\n       A -> jump j 1\n       B -> jump j 2\n       C -> E[f 3]\n\nAs is evident from the example, there are two components to this behavior:\n\n  1. When entering the RHS of a join point, copy the context inside.\n  2. When a join point is invoked, discard the outer context.\n\nWe need to be very careful here to remain consistent---neither part is\noptional!\n\nWe need do make the continuation E duplicable (since we are duplicating it)\nwith mkDuableCont.\n\n\nNote [Join points wih -fno-case-of-case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSupose case-of-case is switched off, and we are simplifying\n\n    case (join j x = <j-rhs> in\n          case y of\n             A -> j 1\n             B -> j 2\n             C -> e) of <outer-alts>\n\nUsually, we'd push the outer continuation (case . of <outer-alts>) into\nboth the RHS and the body of the join point j.  But since we aren't doing\ncase-of-case we may then end up with this totally bogus result\n\n    join x = case <j-rhs> of <outer-alts> in\n    case (case y of\n             A -> j 1\n             B -> j 2\n             C -> e) of <outer-alts>\n\nThis would be OK in the language of the paper, but not in GHC: j is no longer\na join point.  We can only do the \"push contination into the RHS of the\njoin point j\" if we also push the contination right down to the /jumps/ to\nj, so that it can evaporate there.  If we are doing case-of-case, we'll get to\n\n    join x = case <j-rhs> of <outer-alts> in\n    case y of\n      A -> j 1\n      B -> j 2\n      C -> case e of <outer-alts>\n\nwhich is great.\n\nBottom line: if case-of-case is off, we must stop pushing the continuation\ninwards altogether at any join point.  Instead simplify the (join ... in ...)\nwith a Stop continuation, and wrap the original continuation around the\noutside.  Surprisingly tricky!\n\n\n************************************************************************\n*                                                                      *\n                     Variables\n*                                                                      *\n************************************************************************\n-}\n\nsimplVar :: SimplEnv -> InVar -> SimplM OutExpr\n-- Look up an InVar in the environment\nsimplVar env var\n  | isTyVar var = return (Type (substTyVar env var))\n  | isCoVar var = return (Coercion (substCoVar env var))\n  | otherwise\n  = case substId env var of\n        ContEx tvs cvs ids e -> simplExpr (setSubstEnv env tvs cvs ids) e\n        DoneId var1          -> return (Var var1)\n        DoneEx e _           -> return e\n\nsimplIdF :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr)\nsimplIdF env var cont\n  = case substId env var of\n      ContEx tvs cvs ids e -> simplExprF (setSubstEnv env tvs cvs ids) e cont\n                                -- Don't trim; haven't already simplified e,\n                                -- so the cont is not embodied in e\n\n      DoneId var1 -> completeCall env var1 (trimJoinCont var (isJoinId_maybe var1) cont)\n\n      DoneEx e mb_join -> simplExprF (zapSubstEnv env) e (trimJoinCont var mb_join cont)\n              -- Note [zapSubstEnv]\n              -- The template is already simplified, so don't re-substitute.\n              -- This is VITAL.  Consider\n              --      let x = e in\n              --      let y = \\z -> ...x... in\n              --      \\ x -> ...y...\n              -- We'll clone the inner \\x, adding x->x' in the id_subst\n              -- Then when we inline y, we must *not* replace x by x' in\n              -- the inlined copy!!\n\n---------------------------------------------------------\n--      Dealing with a call site\n\ncompleteCall :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr)\ncompleteCall env var cont\n  | Just expr <- callSiteInline dflags var active_unf\n                                lone_variable arg_infos interesting_cont\n  -- Inline the variable's RHS\n  = do { checkedTick (UnfoldingDone var)\n       ; dump_inline expr cont\n       ; simplExprF (zapSubstEnv env) expr cont }\n\n  | otherwise\n  -- Don't inline; instead rebuild the call\n  = do { rule_base <- getSimplRules\n       ; let info = mkArgInfo env var (getRules rule_base var)\n                              n_val_args call_cont\n       ; rebuildCall env info cont }\n\n  where\n    dflags = seDynFlags env\n    (lone_variable, arg_infos, call_cont) = contArgs cont\n    n_val_args       = length arg_infos\n    interesting_cont = interestingCallContext env call_cont\n    active_unf       = activeUnfolding (getMode env) var\n\n    dump_inline unfolding cont\n      | not (dopt Opt_D_dump_inlinings dflags) = return ()\n      | not (dopt Opt_D_verbose_core2core dflags)\n      = when (isExternalName (idName var)) $\n            liftIO $ printOutputForUser dflags alwaysQualify $\n                sep [text \"Inlining done:\", nest 4 (ppr var)]\n      | otherwise\n      = liftIO $ printOutputForUser dflags alwaysQualify $\n           sep [text \"Inlining done: \" <> ppr var,\n                nest 4 (vcat [text \"Inlined fn: \" <+> nest 2 (ppr unfolding),\n                              text \"Cont:  \" <+> ppr cont])]\n\nrebuildCall :: SimplEnv\n            -> ArgInfo\n            -> SimplCont\n            -> SimplM (SimplFloats, OutExpr)\n-- We decided not to inline, so\n--    - simplify the arguments\n--    - try rewrite rules\n--    - and rebuild\n\n---------- Bottoming applications --------------\nrebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_strs = [] }) cont\n  -- When we run out of strictness args, it means\n  -- that the call is definitely bottom; see SimplUtils.mkArgInfo\n  -- Then we want to discard the entire strict continuation.  E.g.\n  --    * case (error \"hello\") of { ... }\n  --    * (error \"Hello\") arg\n  --    * f (error \"Hello\") where f is strict\n  --    etc\n  -- Then, especially in the first of these cases, we'd like to discard\n  -- the continuation, leaving just the bottoming expression.  But the\n  -- type might not be right, so we may have to add a coerce.\n  | not (contIsTrivial cont)     -- Only do this if there is a non-trivial\n                                 -- continuation to discard, else we do it\n                                 -- again and again!\n  = seqType cont_ty `seq`        -- See Note [Avoiding space leaks in OutType]\n    return (emptyFloats env, castBottomExpr res cont_ty)\n  where\n    res     = argInfoExpr fun rev_args\n    cont_ty = contResultType cont\n\n---------- Try rewrite RULES --------------\n-- See Note [Trying rewrite rules]\nrebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args\n                              , ai_rules = Just (nr_wanted, rules) }) cont\n  | nr_wanted == 0 || no_more_args\n  , let info' = info { ai_rules = Nothing }\n  = -- We've accumulated a simplified call in <fun,rev_args>\n    -- so try rewrite rules; see Note [RULEs apply to simplified arguments]\n    -- See also Note [Rules for recursive functions]\n    do { mb_match <- tryRules env rules fun (reverse rev_args) cont\n       ; case mb_match of\n             Just (env', rhs, cont') -> simplExprF env' rhs cont'\n             Nothing                 -> rebuildCall env info' cont }\n  where\n    no_more_args = case cont of\n                      ApplyToTy  {} -> False\n                      ApplyToVal {} -> False\n                      _             -> True\n\n\n---------- Simplify applications and casts --------------\nrebuildCall env info (CastIt co cont)\n  = rebuildCall env (addCastTo info co) cont\n\nrebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont })\n  = rebuildCall env (addTyArgTo info arg_ty) cont\n\nrebuildCall env info@(ArgInfo { ai_encl = encl_rules, ai_type = fun_ty\n                              , ai_strs = str:strs, ai_discs = disc:discs })\n            (ApplyToVal { sc_arg = arg, sc_env = arg_se\n                        , sc_dup = dup_flag, sc_cont = cont })\n  | isSimplified dup_flag     -- See Note [Avoid redundant simplification]\n  = rebuildCall env (addValArgTo info' arg) cont\n\n  | str         -- Strict argument\n  , sm_case_case (getMode env)\n  = -- pprTrace \"Strict Arg\" (ppr arg $$ ppr (seIdSubst env) $$ ppr (seInScope env)) $\n    simplExprF (arg_se `setInScopeFromE` env) arg\n               (StrictArg { sc_fun = info', sc_cci = cci_strict\n                          , sc_dup = Simplified, sc_cont = cont })\n                -- Note [Shadowing]\n\n  | otherwise                           -- Lazy argument\n        -- DO NOT float anything outside, hence simplExprC\n        -- There is no benefit (unlike in a let-binding), and we'd\n        -- have to be very careful about bogus strictness through\n        -- floating a demanded let.\n  = do  { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg\n                             (mkLazyArgStop arg_ty cci_lazy)\n        ; rebuildCall env (addValArgTo info' arg') cont }\n  where\n    info'  = info { ai_strs = strs, ai_discs = discs }\n    arg_ty = funArgTy fun_ty\n\n    -- Use this for lazy arguments\n    cci_lazy | encl_rules = RuleArgCtxt\n             | disc > 0   = DiscArgCtxt  -- Be keener here\n             | otherwise  = BoringCtxt   -- Nothing interesting\n\n    -- ..and this for strict arguments\n    cci_strict | encl_rules = RuleArgCtxt\n               | disc > 0   = DiscArgCtxt\n               | otherwise  = RhsCtxt\n      -- Why RhsCtxt?  if we see f (g x) (h x), and f is strict, we\n      -- want to be a bit more eager to inline g, because it may\n      -- expose an eval (on x perhaps) that can be eliminated or\n      -- shared. I saw this in nofib 'boyer2', RewriteFuns.onewayunify1\n      -- It's worth an 18% improvement in allocation for this\n      -- particular benchmark; 5% on 'mate' and 1.3% on 'multiplier'\n\n---------- No further useful info, revert to generic rebuild ------------\nrebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont\n  = rebuild env (argInfoExpr fun rev_args) cont\n\n{- Note [Trying rewrite rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider an application (f e1 e2 e3) where the e1,e2,e3 are not yet\nsimplified.  We want to simplify enough arguments to allow the rules\nto apply, but it's more efficient to avoid simplifying e2,e3 if e1 alone\nis sufficient.  Example: class ops\n   (+) dNumInt e2 e3\nIf we rewrite ((+) dNumInt) to plusInt, we can take advantage of the\nlatter's strictness when simplifying e2, e3.  Moreover, suppose we have\n  RULE  f Int = \\x. x True\n\nThen given (f Int e1) we rewrite to\n   (\\x. x True) e1\nwithout simplifying e1.  Now we can inline x into its unique call site,\nand absorb the True into it all in the same pass.  If we simplified\ne1 first, we couldn't do that; see Note [Avoiding exponential behaviour].\n\nSo we try to apply rules if either\n  (a) no_more_args: we've run out of argument that the rules can \"see\"\n  (b) nr_wanted: none of the rules wants any more arguments\n\n\nNote [RULES apply to simplified arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's very desirable to try RULES once the arguments have been simplified, because\ndoing so ensures that rule cascades work in one pass.  Consider\n   {-# RULES g (h x) = k x\n             f (k x) = x #-}\n   ...f (g (h x))...\nThen we want to rewrite (g (h x)) to (k x) and only then try f's rules. If\nwe match f's rules against the un-simplified RHS, it won't match.  This\nmakes a particularly big difference when superclass selectors are involved:\n        op ($p1 ($p2 (df d)))\nWe want all this to unravel in one sweep.\n\nNote [Avoid redundant simplification]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBecause RULES apply to simplified arguments, there's a danger of repeatedly\nsimplifying already-simplified arguments.  An important example is that of\n        (>>=) d e1 e2\nHere e1, e2 are simplified before the rule is applied, but don't really\nparticipate in the rule firing. So we mark them as Simplified to avoid\nre-simplifying them.\n\nNote [Shadowing]\n~~~~~~~~~~~~~~~~\nThis part of the simplifier may break the no-shadowing invariant\nConsider\n        f (...(\\a -> e)...) (case y of (a,b) -> e')\nwhere f is strict in its second arg\nIf we simplify the innermost one first we get (...(\\a -> e)...)\nSimplifying the second arg makes us float the case out, so we end up with\n        case y of (a,b) -> f (...(\\a -> e)...) e'\nSo the output does not have the no-shadowing invariant.  However, there is\nno danger of getting name-capture, because when the first arg was simplified\nwe used an in-scope set that at least mentioned all the variables free in its\nstatic environment, and that is enough.\n\nWe can't just do innermost first, or we'd end up with a dual problem:\n        case x of (a,b) -> f e (...(\\a -> e')...)\n\nI spent hours trying to recover the no-shadowing invariant, but I just could\nnot think of an elegant way to do it.  The simplifier is already knee-deep in\ncontinuations.  We have to keep the right in-scope set around; AND we have\nto get the effect that finding (error \"foo\") in a strict arg position will\ndiscard the entire application and replace it with (error \"foo\").  Getting\nall this at once is TOO HARD!\n\n\n************************************************************************\n*                                                                      *\n                Rewrite rules\n*                                                                      *\n************************************************************************\n-}\n\ntryRules :: SimplEnv -> [CoreRule]\n         -> Id -> [ArgSpec]\n         -> SimplCont\n         -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))\n\ntryRules env rules fn args call_cont\n  | null rules\n  = return Nothing\n\n{- Disabled until we fix #8326\n  | fn `hasKey` tagToEnumKey   -- See Note [Optimising tagToEnum#]\n  , [_type_arg, val_arg] <- args\n  , Select dup bndr ((_,[],rhs1) : rest_alts) se cont <- call_cont\n  , isDeadBinder bndr\n  = do { let enum_to_tag :: CoreAlt -> CoreAlt\n                -- Takes   K -> e  into   tagK# -> e\n                -- where tagK# is the tag of constructor K\n             enum_to_tag (DataAlt con, [], rhs)\n               = ASSERT( isEnumerationTyCon (dataConTyCon con) )\n                (LitAlt tag, [], rhs)\n              where\n                tag = mkLitInt dflags (toInteger (dataConTag con - fIRST_TAG))\n             enum_to_tag alt = pprPanic \"tryRules: tagToEnum\" (ppr alt)\n\n             new_alts = (DEFAULT, [], rhs1) : map enum_to_tag rest_alts\n             new_bndr = setIdType bndr intPrimTy\n                 -- The binder is dead, but should have the right type\n      ; return (Just (val_arg, Select dup new_bndr new_alts se cont)) }\n-}\n\n  | Just (rule, rule_rhs) <- lookupRule dflags (getUnfoldingInRuleMatch env)\n                                        (activeRule (getMode env)) fn\n                                        (argInfoAppArgs args) rules\n  -- Fire a rule for the function\n  = do { checkedTick (RuleFired (ruleName rule))\n       ; let cont' = pushSimplifiedArgs zapped_env\n                                        (drop (ruleArity rule) args)\n                                        call_cont\n                     -- (ruleArity rule) says how\n                     -- many args the rule consumed\n\n             occ_anald_rhs = occurAnalyseExpr rule_rhs\n                 -- See Note [Occurrence-analyse after rule firing]\n       ; dump rule rule_rhs\n       ; return (Just (zapped_env, occ_anald_rhs, cont')) }\n            -- The occ_anald_rhs and cont' are all Out things\n            -- hence zapping the environment\n\n  | otherwise  -- No rule fires\n  = do { nodump  -- This ensures that an empty file is written\n       ; return Nothing }\n\n  where\n    dflags     = seDynFlags env\n    zapped_env = zapSubstEnv env  -- See Note [zapSubstEnv]\n\n    printRuleModule rule\n      = parens (maybe (text \"BUILTIN\")\n                      (pprModuleName . moduleName)\n                      (ruleModule rule))\n\n    dump rule rule_rhs\n      | dopt Opt_D_dump_rule_rewrites dflags\n      = log_rule dflags Opt_D_dump_rule_rewrites \"Rule fired\" $ vcat\n          [ text \"Rule:\" <+> ftext (ruleName rule)\n          , text \"Module:\" <+>  printRuleModule rule\n          , text \"Before:\" <+> hang (ppr fn) 2 (sep (map ppr args))\n          , text \"After: \" <+> pprCoreExpr rule_rhs\n          , text \"Cont:  \" <+> ppr call_cont ]\n\n      | dopt Opt_D_dump_rule_firings dflags\n      = log_rule dflags Opt_D_dump_rule_firings \"Rule fired:\" $\n          ftext (ruleName rule)\n            <+> printRuleModule rule\n\n      | otherwise\n      = return ()\n\n    nodump\n      | dopt Opt_D_dump_rule_rewrites dflags\n      = liftIO $ dumpSDoc dflags alwaysQualify Opt_D_dump_rule_rewrites \"\" empty\n\n      | dopt Opt_D_dump_rule_firings dflags\n      = liftIO $ dumpSDoc dflags alwaysQualify Opt_D_dump_rule_firings \"\" empty\n\n      | otherwise\n      = return ()\n\n    log_rule dflags flag hdr details\n      = liftIO . dumpSDoc dflags alwaysQualify flag \"\" $\n                   sep [text hdr, nest 4 details]\n\ntrySeqRules :: SimplEnv\n            -> OutExpr -> InExpr   -- Scrutinee and RHS\n            -> SimplCont\n            -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont))\n-- See Note [User-defined RULES for seq]\ntrySeqRules in_env scrut rhs cont\n  = do { rule_base <- getSimplRules\n       ; tryRules in_env (getRules rule_base seqId) seqId out_args rule_cont }\n  where\n    no_cast_scrut = drop_casts scrut\n    scrut_ty  = exprType no_cast_scrut\n    seq_id_ty = idType seqId\n    rhs_ty    = substTy in_env (exprType rhs)\n    out_args  = [ TyArg { as_arg_ty  = scrut_ty\n                        , as_hole_ty = seq_id_ty }\n                , TyArg { as_arg_ty  = rhs_ty\n                       , as_hole_ty  = piResultTy seq_id_ty scrut_ty }\n                , ValArg no_cast_scrut]\n    rule_cont = ApplyToVal { sc_dup = NoDup, sc_arg = rhs\n                           , sc_env = in_env, sc_cont = cont }\n    -- Lazily evaluated, so we don't do most of this\n\n    drop_casts (Cast e _) = drop_casts e\n    drop_casts e          = e\n\n{- Note [User-defined RULES for seq]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven\n   case (scrut |> co) of _ -> rhs\nlook for rules that match the expression\n   seq @t1 @t2 scrut\nwhere scrut :: t1\n      rhs   :: t2\n\nIf you find a match, rewrite it, and apply to 'rhs'.\n\nNotice that we can simply drop casts on the fly here, which\nmakes it more likely that a rule will match.\n\nSee Note [User-defined RULES for seq] in MkId.\n\nNote [Occurrence-analyse after rule firing]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAfter firing a rule, we occurrence-analyse the instantiated RHS before\nsimplifying it.  Usually this doesn't make much difference, but it can\nbe huge.  Here's an example (simplCore/should_compile/T7785)\n\n  map f (map f (map f xs)\n\n= -- Use build/fold form of map, twice\n  map f (build (\\cn. foldr (mapFB c f) n\n                           (build (\\cn. foldr (mapFB c f) n xs))))\n\n= -- Apply fold/build rule\n  map f (build (\\cn. (\\cn. foldr (mapFB c f) n xs) (mapFB c f) n))\n\n= -- Beta-reduce\n  -- Alas we have no occurrence-analysed, so we don't know\n  -- that c is used exactly once\n  map f (build (\\cn. let c1 = mapFB c f in\n                     foldr (mapFB c1 f) n xs))\n\n= -- Use mapFB rule:   mapFB (mapFB c f) g = mapFB c (f.g)\n  -- We can do this because (mapFB c n) is a PAP and hence expandable\n  map f (build (\\cn. let c1 = mapFB c n in\n                     foldr (mapFB c (f.f)) n x))\n\nThis is not too bad.  But now do the same with the outer map, and\nwe get another use of mapFB, and t can interact with /both/ remaining\nmapFB calls in the above expression.  This is stupid because actually\nthat 'c1' binding is dead.  The outer map introduces another c2. If\nthere is a deep stack of maps we get lots of dead bindings, and lots\nof redundant work as we repeatedly simplify the result of firing rules.\n\nThe easy thing to do is simply to occurrence analyse the result of\nthe rule firing.  Note that this occ-anals not only the RHS of the\nrule, but also the function arguments, which by now are OutExprs.\nE.g.\n      RULE f (g x) = x+1\n\nCall   f (g BIG)  -->   (\\x. x+1) BIG\n\nThe rule binders are lambda-bound and applied to the OutExpr arguments\n(here BIG) which lack all internal occurrence info.\n\nIs this inefficient?  Not really: we are about to walk over the result\nof the rule firing to simplify it, so occurrence analysis is at most\na constant factor.\n\nPossible improvement: occ-anal the rules when putting them in the\ndatabase; and in the simplifier just occ-anal the OutExpr arguments.\nBut that's more complicated and the rule RHS is usually tiny; so I'm\njust doing the simple thing.\n\nHistorical note: previously we did occ-anal the rules in Rule.hs,\nbut failed to occ-anal the OutExpr arguments, which led to the\nnasty performance problem described above.\n\n\nNote [Optimising tagToEnum#]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have an enumeration data type:\n\n  data Foo = A | B | C\n\nThen we want to transform\n\n   case tagToEnum# x of   ==>    case x of\n     A -> e1                       DEFAULT -> e1\n     B -> e2                       1#      -> e2\n     C -> e3                       2#      -> e3\n\nthereby getting rid of the tagToEnum# altogether.  If there was a DEFAULT\nalternative we retain it (remember it comes first).  If not the case must\nbe exhaustive, and we reflect that in the transformed version by adding\na DEFAULT.  Otherwise Lint complains that the new case is not exhaustive.\nSee #8317.\n\nNote [Rules for recursive functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nYou might think that we shouldn't apply rules for a loop breaker:\ndoing so might give rise to an infinite loop, because a RULE is\nrather like an extra equation for the function:\n     RULE:           f (g x) y = x+y\n     Eqn:            f a     y = a-y\n\nBut it's too drastic to disable rules for loop breakers.\nEven the foldr/build rule would be disabled, because foldr\nis recursive, and hence a loop breaker:\n     foldr k z (build g) = g k z\nSo it's up to the programmer: rules can cause divergence\n\n\n************************************************************************\n*                                                                      *\n                Rebuilding a case expression\n*                                                                      *\n************************************************************************\n\nNote [Case elimination]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe case-elimination transformation discards redundant case expressions.\nStart with a simple situation:\n\n        case x# of      ===>   let y# = x# in e\n          y# -> e\n\n(when x#, y# are of primitive type, of course).  We can't (in general)\ndo this for algebraic cases, because we might turn bottom into\nnon-bottom!\n\nThe code in SimplUtils.prepareAlts has the effect of generalise this\nidea to look for a case where we're scrutinising a variable, and we\nknow that only the default case can match.  For example:\n\n        case x of\n          0#      -> ...\n          DEFAULT -> ...(case x of\n                         0#      -> ...\n                         DEFAULT -> ...) ...\n\nHere the inner case is first trimmed to have only one alternative, the\nDEFAULT, after which it's an instance of the previous case.  This\nreally only shows up in eliminating error-checking code.\n\nNote that SimplUtils.mkCase combines identical RHSs.  So\n\n        case e of       ===> case e of DEFAULT -> r\n           True  -> r\n           False -> r\n\nNow again the case may be elminated by the CaseElim transformation.\nThis includes things like (==# a# b#)::Bool so that we simplify\n      case ==# a# b# of { True -> x; False -> x }\nto just\n      x\nThis particular example shows up in default methods for\ncomparison operations (e.g. in (>=) for Int.Int32)\n\nNote [Case to let transformation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf a case over a lifted type has a single alternative, and is being\nused as a strict 'let' (all isDeadBinder bndrs), we may want to do\nthis transformation:\n\n    case e of r       ===>   let r = e in ...r...\n      _ -> ...r...\n\nWe treat the unlifted and lifted cases separately:\n\n* Unlifted case: 'e' satisfies exprOkForSpeculation\n  (ok-for-spec is needed to satisfy the let/app invariant).\n  This turns     case a +# b of r -> ...r...\n  into           let r = a +# b in ...r...\n  and thence     .....(a +# b)....\n\n  However, if we have\n      case indexArray# a i of r -> ...r...\n  we might like to do the same, and inline the (indexArray# a i).\n  But indexArray# is not okForSpeculation, so we don't build a let\n  in rebuildCase (lest it get floated *out*), so the inlining doesn't\n  happen either.  Annoying.\n\n* Lifted case: we need to be sure that the expression is already\n  evaluated (exprIsHNF).  If it's not already evaluated\n      - we risk losing exceptions, divergence or\n        user-specified thunk-forcing\n      - even if 'e' is guaranteed to converge, we don't want to\n        create a thunk (call by need) instead of evaluating it\n        right away (call by value)\n\n  However, we can turn the case into a /strict/ let if the 'r' is\n  used strictly in the body.  Then we won't lose divergence; and\n  we won't build a thunk because the let is strict.\n  See also Note [Case-to-let for strictly-used binders]\n\n  NB: absentError satisfies exprIsHNF: see Note [aBSENT_ERROR_ID] in MkCore.\n  We want to turn\n     case (absentError \"foo\") of r -> ...MkT r...\n  into\n     let r = absentError \"foo\" in ...MkT r...\n\n\nNote [Case-to-let for strictly-used binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have this:\n   case <scrut> of r { _ -> ..r.. }\n\nwhere 'r' is used strictly in (..r..), we can safely transform to\n   let r = <scrut> in ...r...\n\nThis is a Good Thing, because 'r' might be dead (if the body just\ncalls error), or might be used just once (in which case it can be\ninlined); or we might be able to float the let-binding up or down.\nE.g. Trac #15631 has an example.\n\nNote that this can change the error behaviour.  For example, we might\ntransform\n    case x of { _ -> error \"bad\" }\n    --> error \"bad\"\nwhich is might be puzzling if 'x' currently lambda-bound, but later gets\nlet-bound to (error \"good\").\n\nNevertheless, the paper \"A semantics for imprecise exceptions\" allows\nthis transformation. If you want to fix the evaluation order, use\n'pseq'.  See Trac #8900 for an example where the loss of this\ntransformation bit us in practice.\n\nSee also Note [Empty case alternatives] in CoreSyn.\n\nHistorical notes\n\nThere have been various earlier versions of this patch:\n\n* By Sept 18 the code looked like this:\n     || scrut_is_demanded_var scrut\n\n    scrut_is_demanded_var :: CoreExpr -> Bool\n    scrut_is_demanded_var (Cast s _) = scrut_is_demanded_var s\n    scrut_is_demanded_var (Var _)    = isStrictDmd (idDemandInfo case_bndr)\n    scrut_is_demanded_var _          = False\n\n  This only fired if the scrutinee was a /variable/, which seems\n  an unnecessary restriction. So in Trac #15631 I relaxed it to allow\n  arbitrary scrutinees.  Less code, less to explain -- but the change\n  had 0.00% effect on nofib.\n\n* Previously, in Jan 13 the code looked like this:\n     || case_bndr_evald_next rhs\n\n    case_bndr_evald_next :: CoreExpr -> Bool\n      -- See Note [Case binder next]\n    case_bndr_evald_next (Var v)         = v == case_bndr\n    case_bndr_evald_next (Cast e _)      = case_bndr_evald_next e\n    case_bndr_evald_next (App e _)       = case_bndr_evald_next e\n    case_bndr_evald_next (Case e _ _ _)  = case_bndr_evald_next e\n    case_bndr_evald_next _               = False\n\n  This patch was part of fixing Trac #7542. See also\n  Note [Eta reduction of an eval'd function] in CoreUtils.)\n\n\nFurther notes about case elimination\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider:       test :: Integer -> IO ()\n                test = print\n\nTurns out that this compiles to:\n    Print.test\n      = \\ eta :: Integer\n          eta1 :: Void# ->\n          case PrelNum.< eta PrelNum.zeroInteger of wild { __DEFAULT ->\n          case hPutStr stdout\n                 (PrelNum.jtos eta ($w[] @ Char))\n                 eta1\n          of wild1 { (# new_s, a4 #) -> PrelIO.lvl23 new_s  }}\n\nNotice the strange '<' which has no effect at all. This is a funny one.\nIt started like this:\n\nf x y = if x < 0 then jtos x\n          else if y==0 then \"\" else jtos x\n\nAt a particular call site we have (f v 1).  So we inline to get\n\n        if v < 0 then jtos x\n        else if 1==0 then \"\" else jtos x\n\nNow simplify the 1==0 conditional:\n\n        if v<0 then jtos v else jtos v\n\nNow common-up the two branches of the case:\n\n        case (v<0) of DEFAULT -> jtos v\n\nWhy don't we drop the case?  Because it's strict in v.  It's technically\nwrong to drop even unnecessary evaluations, and in practice they\nmay be a result of 'seq' so we *definitely* don't want to drop those.\nI don't really know how to improve this situation.\n\n\nNote [FloatBinds from constructor wrappers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have FloatBinds coming from the constructor wrapper\n(as in Note [exprIsConApp_maybe on data constructors with wrappers]),\new cannot float past them. We'd need to float the FloatBind\ntogether with the simplify floats, unfortunately the\nsimplifier doesn't have case-floats. The simplest thing we can\ndo is to wrap all the floats here. The next iteration of the\nsimplifier will take care of all these cases and lets.\n\nGiven data T = MkT !Bool, this allows us to simplify\ncase $WMkT b of { MkT x -> f x }\nto\ncase b of { b' -> f b' }.\n\nWe could try and be more clever (like maybe wfloats only contain\nlet binders, so we could float them). But the need for the\nextra complication is not clear.\n-}\n\n---------------------------------------------------------\n--      Eliminate the case if possible\n\nrebuildCase, reallyRebuildCase\n   :: SimplEnv\n   -> OutExpr          -- Scrutinee\n   -> InId             -- Case binder\n   -> [InAlt]          -- Alternatives (inceasing order)\n   -> SimplCont\n   -> SimplM (SimplFloats, OutExpr)\n\n--------------------------------------------------\n--      1. Eliminate the case if there's a known constructor\n--------------------------------------------------\n\nrebuildCase env scrut case_bndr alts cont\n  | Lit lit <- scrut    -- No need for same treatment as constructors\n                        -- because literals are inlined more vigorously\n  , not (litIsLifted lit)\n  = do  { tick (KnownBranch case_bndr)\n        ; case findAlt (LitAlt lit) alts of\n            Nothing           -> missingAlt env case_bndr alts cont\n            Just (_, bs, rhs) -> simple_rhs env [] scrut bs rhs }\n\n  | Just (in_scope', wfloats, con, ty_args, other_args)\n      <- exprIsConApp_maybe (getUnfoldingInRuleMatch env) scrut\n        -- Works when the scrutinee is a variable with a known unfolding\n        -- as well as when it's an explicit constructor application\n  , let env0 = setInScopeSet env in_scope'\n  = do  { tick (KnownBranch case_bndr)\n        ; case findAlt (DataAlt con) alts of\n            Nothing  -> missingAlt env0 case_bndr alts cont\n            Just (DEFAULT, bs, rhs) -> let con_app = Var (dataConWorkId con)\n                                                 `mkTyApps` ty_args\n                                                 `mkApps`   other_args\n                                       in simple_rhs env0 wfloats con_app bs rhs\n            Just (_, bs, rhs)       -> knownCon env0 scrut wfloats con ty_args other_args\n                                                case_bndr bs rhs cont\n        }\n  where\n    simple_rhs env wfloats scrut' bs rhs =\n      ASSERT( null bs )\n      do { (floats1, env') <- simplNonRecX env case_bndr scrut'\n             -- scrut is a constructor application,\n             -- hence satisfies let/app invariant\n         ; (floats2, expr') <- simplExprF env' rhs cont\n         ; case wfloats of\n             [] -> return (floats1 `addFloats` floats2, expr')\n             _ -> return\n               -- See Note [FloatBinds from constructor wrappers]\n                   ( emptyFloats env,\n                     MkCore.wrapFloats wfloats $\n                     wrapFloats (floats1 `addFloats` floats2) expr' )}\n\n\n--------------------------------------------------\n--      2. Eliminate the case if scrutinee is evaluated\n--------------------------------------------------\n\nrebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont\n  -- See if we can get rid of the case altogether\n  -- See Note [Case elimination]\n  -- mkCase made sure that if all the alternatives are equal,\n  -- then there is now only one (DEFAULT) rhs\n\n  -- 2a.  Dropping the case altogether, if\n  --      a) it binds nothing (so it's really just a 'seq')\n  --      b) evaluating the scrutinee has no side effects\n  | is_plain_seq\n  , exprOkForSideEffects scrut\n          -- The entire case is dead, so we can drop it\n          -- if the scrutinee converges without having imperative\n          -- side effects or raising a Haskell exception\n          -- See Note [PrimOp can_fail and has_side_effects] in PrimOp\n   = simplExprF env rhs cont\n\n  -- 2b.  Turn the case into a let, if\n  --      a) it binds only the case-binder\n  --      b) unlifted case: the scrutinee is ok-for-speculation\n  --           lifted case: the scrutinee is in HNF (or will later be demanded)\n  -- See Note [Case to let transformation]\n  | all_dead_bndrs\n  , doCaseToLet scrut case_bndr\n  = do { tick (CaseElim case_bndr)\n       ; (floats1, env') <- simplNonRecX env case_bndr scrut\n       ; (floats2, expr') <- simplExprF env' rhs cont\n       ; return (floats1 `addFloats` floats2, expr') }\n\n  -- 2c. Try the seq rules if\n  --     a) it binds only the case binder\n  --     b) a rule for seq applies\n  -- See Note [User-defined RULES for seq] in MkId\n  | is_plain_seq\n  = do { mb_rule <- trySeqRules env scrut rhs cont\n       ; case mb_rule of\n           Just (env', rule_rhs, cont') -> simplExprF env' rule_rhs cont'\n           Nothing                      -> reallyRebuildCase env scrut case_bndr alts cont }\n  where\n    all_dead_bndrs = all isDeadBinder bndrs       -- bndrs are [InId]\n    is_plain_seq   = all_dead_bndrs && isDeadBinder case_bndr -- Evaluation *only* for effect\n\nrebuildCase env scrut case_bndr alts cont\n  = reallyRebuildCase env scrut case_bndr alts cont\n\n\ndoCaseToLet :: OutExpr          -- Scrutinee\n            -> InId             -- Case binder\n            -> Bool\n-- The situation is         case scrut of b { DEFAULT -> body }\n-- Can we transform thus?   let { b = scrut } in body\ndoCaseToLet scrut case_bndr\n  | isTyCoVar case_bndr    -- Respect CoreSyn\n  = isTyCoArg scrut        -- Note [CoreSyn type and coercion invariant]\n\n  | isUnliftedType (idType case_bndr)\n  = exprOkForSpeculation scrut\n\n  | otherwise  -- Scrut has a lifted type\n  = exprIsHNF scrut\n    || isStrictDmd (idDemandInfo case_bndr)\n    -- See Note [Case-to-let for strictly-used binders]\n\n--------------------------------------------------\n--      3. Catch-all case\n--------------------------------------------------\n\nreallyRebuildCase env scrut case_bndr alts cont\n  | not (sm_case_case (getMode env))\n  = do { case_expr <- simplAlts env scrut case_bndr alts\n                                (mkBoringStop (contHoleType cont))\n       ; rebuild env case_expr cont }\n\n  | otherwise\n  = do { (floats, cont') <- mkDupableCaseCont env alts cont\n       ; case_expr <- simplAlts (env `setInScopeFromF` floats)\n                                scrut case_bndr alts cont'\n       ; return (floats, case_expr) }\n\n{-\nsimplCaseBinder checks whether the scrutinee is a variable, v.  If so,\ntry to eliminate uses of v in the RHSs in favour of case_bndr; that\nway, there's a chance that v will now only be used once, and hence\ninlined.\n\nHistorical note: we use to do the \"case binder swap\" in the Simplifier\nso there were additional complications if the scrutinee was a variable.\nNow the binder-swap stuff is done in the occurrence analyser; see\nOccurAnal Note [Binder swap].\n\nNote [knownCon occ info]\n~~~~~~~~~~~~~~~~~~~~~~~~\nIf the case binder is not dead, then neither are the pattern bound\nvariables:\n        case <any> of x { (a,b) ->\n        case x of { (p,q) -> p } }\nHere (a,b) both look dead, but come alive after the inner case is eliminated.\nThe point is that we bring into the envt a binding\n        let x = (a,b)\nafter the outer case, and that makes (a,b) alive.  At least we do unless\nthe case binder is guaranteed dead.\n\nNote [Case alternative occ info]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we are simply reconstructing a case (the common case), we always\nzap the occurrence info on the binders in the alternatives.  Even\nif the case binder is dead, the scrutinee is usually a variable, and *that*\ncan bring the case-alternative binders back to life.\nSee Note [Add unfolding for scrutinee]\n\nNote [Improving seq]\n~~~~~~~~~~~~~~~~~~~\nConsider\n        type family F :: * -> *\n        type instance F Int = Int\n\nWe'd like to transform\n        case e of (x :: F Int) { DEFAULT -> rhs }\n===>\n        case e `cast` co of (x'::Int)\n           I# x# -> let x = x' `cast` sym co\n                    in rhs\n\nso that 'rhs' can take advantage of the form of x'.  Notice that Note\n[Case of cast] (in OccurAnal) may then apply to the result.\n\nWe'd also like to eliminate empty types (Trac #13468). So if\n\n    data Void\n    type instance F Bool = Void\n\nthen we'd like to transform\n        case (x :: F Bool) of { _ -> error \"urk\" }\n===>\n        case (x |> co) of (x' :: Void) of {}\n\nNota Bene: we used to have a built-in rule for 'seq' that dropped\ncasts, so that\n    case (x |> co) of { _ -> blah }\ndropped the cast; in order to improve the chances of trySeqRules\nfiring.  But that works in the /opposite/ direction to Note [Improving\nseq] so there's a danger of flip/flopping.  Better to make trySeqRules\ninsensitive to the cast, which is now is.\n\nThe need for [Improving seq] showed up in Roman's experiments.  Example:\n  foo :: F Int -> Int -> Int\n  foo t n = t `seq` bar n\n     where\n       bar 0 = 0\n       bar n = bar (n - case t of TI i -> i)\nHere we'd like to avoid repeated evaluating t inside the loop, by\ntaking advantage of the `seq`.\n\nAt one point I did transformation in LiberateCase, but it's more\nrobust here.  (Otherwise, there's a danger that we'll simply drop the\n'seq' altogether, before LiberateCase gets to see it.)\n-}\n\nsimplAlts :: SimplEnv\n          -> OutExpr         -- Scrutinee\n          -> InId            -- Case binder\n          -> [InAlt]         -- Non-empty\n          -> SimplCont\n          -> SimplM OutExpr  -- Returns the complete simplified case expression\n\nsimplAlts env0 scrut case_bndr alts cont'\n  = do  { traceSmpl \"simplAlts\" (vcat [ ppr case_bndr\n                                      , text \"cont':\" <+> ppr cont'\n                                      , text \"in_scope\" <+> ppr (seInScope env0) ])\n        ; (env1, case_bndr1) <- simplBinder env0 case_bndr\n        ; let case_bndr2 = case_bndr1 `setIdUnfolding` evaldUnfolding\n              env2       = modifyInScope env1 case_bndr2\n              -- See Note [Case binder evaluated-ness]\n\n        ; fam_envs <- getFamEnvs\n        ; (alt_env', scrut', case_bndr') <- improveSeq fam_envs env2 scrut\n                                                       case_bndr case_bndr2 alts\n\n        ; (imposs_deflt_cons, in_alts) <- prepareAlts scrut' case_bndr' alts\n          -- NB: it's possible that the returned in_alts is empty: this is handled\n          -- by the caller (rebuildCase) in the missingAlt function\n\n        ; alts' <- mapM (simplAlt alt_env' (Just scrut') imposs_deflt_cons case_bndr' cont') in_alts\n        ; -- pprTrace \"simplAlts\" (ppr case_bndr $$ ppr alts_ty $$ ppr alts_ty' $$ ppr alts $$ ppr cont') $\n\n        ; let alts_ty' = contResultType cont'\n        -- See Note [Avoiding space leaks in OutType]\n        ; seqType alts_ty' `seq`\n          mkCase (seDynFlags env0) scrut' case_bndr' alts_ty' alts' }\n\n\n------------------------------------\nimproveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv\n           -> OutExpr -> InId -> OutId -> [InAlt]\n           -> SimplM (SimplEnv, OutExpr, OutId)\n-- Note [Improving seq]\nimproveSeq fam_envs env scrut case_bndr case_bndr1 [(DEFAULT,_,_)]\n  | Just (co, ty2) <- topNormaliseType_maybe fam_envs (idType case_bndr1)\n  = do { case_bndr2 <- newId (fsLit \"nt\") ty2\n        ; let rhs  = DoneEx (Var case_bndr2 `Cast` mkSymCo co) Nothing\n              env2 = extendIdSubst env case_bndr rhs\n        ; return (env2, scrut `Cast` co, case_bndr2) }\n\nimproveSeq _ env scrut _ case_bndr1 _\n  = return (env, scrut, case_bndr1)\n\n\n------------------------------------\nsimplAlt :: SimplEnv\n         -> Maybe OutExpr  -- The scrutinee\n         -> [AltCon]       -- These constructors can't be present when\n                           -- matching the DEFAULT alternative\n         -> OutId          -- The case binder\n         -> SimplCont\n         -> InAlt\n         -> SimplM OutAlt\n\nsimplAlt env _ imposs_deflt_cons case_bndr' cont' (DEFAULT, bndrs, rhs)\n  = ASSERT( null bndrs )\n    do  { let env' = addBinderUnfolding env case_bndr'\n                                        (mkOtherCon imposs_deflt_cons)\n                -- Record the constructors that the case-binder *can't* be.\n        ; rhs' <- simplExprC env' rhs cont'\n        ; return (DEFAULT, [], rhs') }\n\nsimplAlt env scrut' _ case_bndr' cont' (LitAlt lit, bndrs, rhs)\n  = ASSERT( null bndrs )\n    do  { env' <- addAltUnfoldings env scrut' case_bndr' (Lit lit)\n        ; rhs' <- simplExprC env' rhs cont'\n        ; return (LitAlt lit, [], rhs') }\n\nsimplAlt env scrut' _ case_bndr' cont' (DataAlt con, vs, rhs)\n  = do  { -- See Note [Adding evaluatedness info to pattern-bound variables]\n          let vs_with_evals = addEvals scrut' con vs\n        ; (env', vs') <- simplLamBndrs env vs_with_evals\n\n                -- Bind the case-binder to (con args)\n        ; let inst_tys' = tyConAppArgs (idType case_bndr')\n              con_app :: OutExpr\n              con_app   = mkConApp2 con inst_tys' vs'\n\n        ; env'' <- addAltUnfoldings env' scrut' case_bndr' con_app\n        ; rhs' <- simplExprC env'' rhs cont'\n        ; return (DataAlt con, vs', rhs') }\n\n{- Note [Adding evaluatedness info to pattern-bound variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\naddEvals records the evaluated-ness of the bound variables of\na case pattern.  This is *important*.  Consider\n\n     data T = T !Int !Int\n\n     case x of { T a b -> T (a+1) b }\n\nWe really must record that b is already evaluated so that we don't\ngo and re-evaluate it when constructing the result.\nSee Note [Data-con worker strictness] in MkId.hs\n\nNB: simplLamBinders preserves this eval info\n\nIn addition to handling data constructor fields with !s, addEvals\nalso records the fact that the result of seq# is always in WHNF.\nSee Note [seq# magic] in PrelRules.  Example (Trac #15226):\n\n  case seq# v s of\n    (# s', v' #) -> E\n\nwe want the compiler to be aware that v' is in WHNF in E.\n\nOpen problem: we don't record that v itself is in WHNF (and we can't\ndo it here).  The right thing is to do some kind of binder-swap;\nsee Trac #15226 for discussion.\n-}\n\naddEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id]\n-- See Note [Adding evaluatedness info to pattern-bound variables]\naddEvals scrut con vs\n  -- Deal with seq# applications\n  | Just scr <- scrut\n  , isUnboxedTupleCon con\n  , [s,x] <- vs\n    -- Use stripNArgs rather than collectArgsTicks to avoid building\n    -- a list of arguments only to throw it away immediately.\n  , Just (Var f) <- stripNArgs 4 scr\n  , Just SeqOp <- isPrimOpId_maybe f\n  , let x' = zapIdOccInfoAndSetEvald MarkedStrict x\n  = [s, x']\n\n  -- Deal with banged datacon fields\naddEvals _scrut con vs = go vs the_strs\n    where\n      the_strs = dataConRepStrictness con\n\n      go [] [] = []\n      go (v:vs') strs | isTyVar v = v : go vs' strs\n      go (v:vs') (str:strs) = zapIdOccInfoAndSetEvald str v : go vs' strs\n      go _ _ = pprPanic \"Simplify.addEvals\"\n                (ppr con $$\n                 ppr vs  $$\n                 ppr_with_length (map strdisp the_strs) $$\n                 ppr_with_length (dataConRepArgTys con) $$\n                 ppr_with_length (dataConRepStrictness con))\n        where\n          ppr_with_length list\n            = ppr list <+> parens (text \"length =\" <+> ppr (length list))\n          strdisp MarkedStrict = \"MarkedStrict\"\n          strdisp NotMarkedStrict = \"NotMarkedStrict\"\n\nzapIdOccInfoAndSetEvald :: StrictnessMark -> Id -> Id\nzapIdOccInfoAndSetEvald str v =\n  setCaseBndrEvald str $ -- Add eval'dness info\n  zapIdOccInfo v         -- And kill occ info;\n                         -- see Note [Case alternative occ info]\n\naddAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv\naddAltUnfoldings env scrut case_bndr con_app\n  = do { let con_app_unf = mk_simple_unf con_app\n             env1 = addBinderUnfolding env case_bndr con_app_unf\n\n             -- See Note [Add unfolding for scrutinee]\n             env2 = case scrut of\n                      Just (Var v)           -> addBinderUnfolding env1 v con_app_unf\n                      Just (Cast (Var v) co) -> addBinderUnfolding env1 v $\n                                                mk_simple_unf (Cast con_app (mkSymCo co))\n                      _                      -> env1\n\n       ; traceSmpl \"addAltUnf\" (vcat [ppr case_bndr <+> ppr scrut, ppr con_app])\n       ; return env2 }\n  where\n    mk_simple_unf = mkSimpleUnfolding (seDynFlags env)\n\naddBinderUnfolding :: SimplEnv -> Id -> Unfolding -> SimplEnv\naddBinderUnfolding env bndr unf\n  | debugIsOn, Just tmpl <- maybeUnfoldingTemplate unf\n  = WARN( not (eqType (idType bndr) (exprType tmpl)),\n          ppr bndr $$ ppr (idType bndr) $$ ppr tmpl $$ ppr (exprType tmpl) )\n    modifyInScope env (bndr `setIdUnfolding` unf)\n\n  | otherwise\n  = modifyInScope env (bndr `setIdUnfolding` unf)\n\nzapBndrOccInfo :: Bool -> Id -> Id\n-- Consider  case e of b { (a,b) -> ... }\n-- Then if we bind b to (a,b) in \"...\", and b is not dead,\n-- then we must zap the deadness info on a,b\nzapBndrOccInfo keep_occ_info pat_id\n  | keep_occ_info = pat_id\n  | otherwise     = zapIdOccInfo pat_id\n\n{- Note [Case binder evaluated-ness]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe pin on a (OtherCon []) unfolding to the case-binder of a Case,\neven though it'll be over-ridden in every case alternative with a more\ninformative unfolding.  Why?  Because suppose a later, less clever, pass\nsimply replaces all occurrences of the case binder with the binder itself;\nthen Lint may complain about the let/app invariant.  Example\n    case e of b { DEFAULT -> let v = reallyUnsafePtrEq# b y in ....\n                ; K       -> blah }\n\nThe let/app invariant requires that y is evaluated in the call to\nreallyUnsafePtrEq#, which it is.  But we still want that to be true if we\npropagate binders to occurrences.\n\nThis showed up in Trac #13027.\n\nNote [Add unfolding for scrutinee]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn general it's unlikely that a variable scrutinee will appear\nin the case alternatives   case x of { ...x unlikely to appear... }\nbecause the binder-swap in OccAnal has got rid of all such occurrences\nSee Note [Binder swap] in OccAnal.\n\nBUT it is still VERY IMPORTANT to add a suitable unfolding for a\nvariable scrutinee, in simplAlt.  Here's why\n   case x of y\n     (a,b) -> case b of c\n                I# v -> ...(f y)...\nThere is no occurrence of 'b' in the (...(f y)...).  But y gets\nthe unfolding (a,b), and *that* mentions b.  If f has a RULE\n    RULE f (p, I# q) = ...\nwe want that rule to match, so we must extend the in-scope env with a\nsuitable unfolding for 'y'.  It's *essential* for rule matching; but\nit's also good for case-elimintation -- suppose that 'f' was inlined\nand did multi-level case analysis, then we'd solve it in one\nsimplifier sweep instead of two.\n\nExactly the same issue arises in SpecConstr;\nsee Note [Add scrutinee to ValueEnv too] in SpecConstr\n\nHOWEVER, given\n  case x of y { Just a -> r1; Nothing -> r2 }\nwe do not want to add the unfolding x -> y to 'x', which might seem cool,\nsince 'y' itself has different unfoldings in r1 and r2.  Reason: if we\ndid that, we'd have to zap y's deadness info and that is a very useful\npiece of information.\n\nSo instead we add the unfolding x -> Just a, and x -> Nothing in the\nrespective RHSs.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Known constructor}\n*                                                                      *\n************************************************************************\n\nWe are a bit careful with occurrence info.  Here's an example\n\n        (\\x* -> case x of (a*, b) -> f a) (h v, e)\n\nwhere the * means \"occurs once\".  This effectively becomes\n        case (h v, e) of (a*, b) -> f a)\nand then\n        let a* = h v; b = e in f a\nand then\n        f (h v)\n\nAll this should happen in one sweep.\n-}\n\nknownCon :: SimplEnv\n         -> OutExpr                                           -- The scrutinee\n         -> [FloatBind] -> DataCon -> [OutType] -> [OutExpr]  -- The scrutinee (in pieces)\n         -> InId -> [InBndr] -> InExpr                        -- The alternative\n         -> SimplCont\n         -> SimplM (SimplFloats, OutExpr)\n\nknownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont\n  = do  { (floats1, env1)  <- bind_args env bs dc_args\n        ; (floats2, env2) <- bind_case_bndr env1\n        ; (floats3, expr') <- simplExprF env2 rhs cont\n        ; case dc_floats of\n            [] ->\n              return (floats1 `addFloats` floats2 `addFloats` floats3, expr')\n            _ ->\n              return ( emptyFloats env\n               -- See Note [FloatBinds from constructor wrappers]\n                     , MkCore.wrapFloats dc_floats $\n                       wrapFloats (floats1 `addFloats` floats2 `addFloats` floats3) expr') }\n  where\n    zap_occ = zapBndrOccInfo (isDeadBinder bndr)    -- bndr is an InId\n\n                  -- Ugh!\n    bind_args env' [] _  = return (emptyFloats env', env')\n\n    bind_args env' (b:bs') (Type ty : args)\n      = ASSERT( isTyVar b )\n        bind_args (extendTvSubst env' b ty) bs' args\n\n    bind_args env' (b:bs') (Coercion co : args)\n      = ASSERT( isCoVar b )\n        bind_args (extendCvSubst env' b co) bs' args\n\n    bind_args env' (b:bs') (arg : args)\n      = ASSERT( isId b )\n        do { let b' = zap_occ b\n             -- Note that the binder might be \"dead\", because it doesn't\n             -- occur in the RHS; and simplNonRecX may therefore discard\n             -- it via postInlineUnconditionally.\n             -- Nevertheless we must keep it if the case-binder is alive,\n             -- because it may be used in the con_app.  See Note [knownCon occ info]\n           ; (floats1, env2) <- simplNonRecX env' b' arg  -- arg satisfies let/app invariant\n           ; (floats2, env3)  <- bind_args env2 bs' args\n           ; return (floats1 `addFloats` floats2, env3) }\n\n    bind_args _ _ _ =\n      pprPanic \"bind_args\" $ ppr dc $$ ppr bs $$ ppr dc_args $$\n                             text \"scrut:\" <+> ppr scrut\n\n       -- It's useful to bind bndr to scrut, rather than to a fresh\n       -- binding      x = Con arg1 .. argn\n       -- because very often the scrut is a variable, so we avoid\n       -- creating, and then subsequently eliminating, a let-binding\n       -- BUT, if scrut is a not a variable, we must be careful\n       -- about duplicating the arg redexes; in that case, make\n       -- a new con-app from the args\n    bind_case_bndr env\n      | isDeadBinder bndr   = return (emptyFloats env, env)\n      | exprIsTrivial scrut = return (emptyFloats env\n                                     , extendIdSubst env bndr (DoneEx scrut Nothing))\n      | otherwise           = do { dc_args <- mapM (simplVar env) bs\n                                         -- dc_ty_args are aready OutTypes,\n                                         -- but bs are InBndrs\n                                 ; let con_app = Var (dataConWorkId dc)\n                                                 `mkTyApps` dc_ty_args\n                                                 `mkApps`   dc_args\n                                 ; simplNonRecX env bndr con_app }\n\n-------------------\nmissingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont\n           -> SimplM (SimplFloats, OutExpr)\n                -- This isn't strictly an error, although it is unusual.\n                -- It's possible that the simplifier might \"see\" that\n                -- an inner case has no accessible alternatives before\n                -- it \"sees\" that the entire branch of an outer case is\n                -- inaccessible.  So we simply put an error case here instead.\nmissingAlt env case_bndr _ cont\n  = WARN( True, text \"missingAlt\" <+> ppr case_bndr )\n    -- See Note [Avoiding space leaks in OutType]\n    let cont_ty = contResultType cont\n    in seqType cont_ty `seq`\n       return (emptyFloats env, mkImpossibleExpr cont_ty)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Duplicating continuations}\n*                                                                      *\n************************************************************************\n\nConsider\n  let x* = case e of { True -> e1; False -> e2 }\n  in b\nwhere x* is a strict binding.  Then mkDupableCont will be given\nthe continuation\n   case [] of { True -> e1; False -> e2 } ; let x* = [] in b ; stop\nand will split it into\n   dupable:      case [] of { True -> $j1; False -> $j2 } ; stop\n   join floats:  $j1 = e1, $j2 = e2\n   non_dupable:  let x* = [] in b; stop\n\nPutting this back together would give\n   let x* = let { $j1 = e1; $j2 = e2 } in\n            case e of { True -> $j1; False -> $j2 }\n   in b\n(Of course we only do this if 'e' wants to duplicate that continuation.)\nNote how important it is that the new join points wrap around the\ninner expression, and not around the whole thing.\n\nIn contrast, any let-bindings introduced by mkDupableCont can wrap\naround the entire thing.\n\nNote [Bottom alternatives]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we have\n     case (case x of { A -> error .. ; B -> e; C -> error ..)\n       of alts\nthen we can just duplicate those alts because the A and C cases\nwill disappear immediately.  This is more direct than creating\njoin points and inlining them away.  See Trac #4930.\n-}\n\n--------------------\nmkDupableCaseCont :: SimplEnv -> [InAlt] -> SimplCont\n                  -> SimplM (SimplFloats, SimplCont)\nmkDupableCaseCont env alts cont\n  | altsWouldDup alts = mkDupableCont env cont\n  | otherwise         = return (emptyFloats env, cont)\n\naltsWouldDup :: [InAlt] -> Bool -- True iff strictly > 1 non-bottom alternative\naltsWouldDup []  = False        -- See Note [Bottom alternatives]\naltsWouldDup [_] = False\naltsWouldDup (alt:alts)\n  | is_bot_alt alt = altsWouldDup alts\n  | otherwise      = not (all is_bot_alt alts)\n  where\n    is_bot_alt (_,_,rhs) = exprIsBottom rhs\n\n-------------------------\nmkDupableCont :: SimplEnv -> SimplCont\n              -> SimplM ( SimplFloats  -- Incoming SimplEnv augmented with\n                                       --   extra let/join-floats and in-scope variables\n                        , SimplCont)   -- dup_cont: duplicable continuation\n\nmkDupableCont env cont\n  | contIsDupable cont\n  = return (emptyFloats env, cont)\n\nmkDupableCont _ (Stop {}) = panic \"mkDupableCont\"     -- Handled by previous eqn\n\nmkDupableCont env (CastIt ty cont)\n  = do  { (floats, cont') <- mkDupableCont env cont\n        ; return (floats, CastIt ty cont') }\n\n-- Duplicating ticks for now, not sure if this is good or not\nmkDupableCont env (TickIt t cont)\n  = do  { (floats, cont') <- mkDupableCont env cont\n        ; return (floats, TickIt t cont') }\n\nmkDupableCont env (StrictBind { sc_bndr = bndr, sc_bndrs = bndrs\n                              , sc_body = body, sc_env = se, sc_cont = cont})\n  -- See Note [Duplicating StrictBind]\n  = do { let sb_env = se `setInScopeFromE` env\n       ; (sb_env1, bndr') <- simplBinder sb_env bndr\n       ; (floats1, join_inner) <- simplLam sb_env1 bndrs body cont\n          -- No need to use mkDupableCont before simplLam; we\n          -- use cont once here, and then share the result if necessary\n\n       ; let join_body = wrapFloats floats1 join_inner\n             res_ty    = contResultType cont\n\n       ; (floats2, body2)\n            <- if exprIsDupable (seDynFlags env) join_body\n               then return (emptyFloats env, join_body)\n               else do { join_bndr <- newJoinId [bndr'] res_ty\n                       ; let join_call = App (Var join_bndr) (Var bndr')\n                             join_rhs  = Lam (setOneShotLambda bndr') join_body\n                             join_bind = NonRec join_bndr join_rhs\n                             floats    = emptyFloats env `extendFloats` join_bind\n                       ; return (floats, join_call) }\n       ; return ( floats2\n                , StrictBind { sc_bndr = bndr', sc_bndrs = []\n                             , sc_body = body2\n                             , sc_env  = zapSubstEnv se `setInScopeFromF` floats2\n                                         -- See Note [StaticEnv invariant] in SimplUtils\n                             , sc_dup  = OkToDup\n                             , sc_cont = mkBoringStop res_ty } ) }\n\nmkDupableCont env (StrictArg { sc_fun = info, sc_cci = cci, sc_cont = cont })\n        -- See Note [Duplicating StrictArg]\n        -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable\n  = do { (floats1, cont') <- mkDupableCont env cont\n       ; (floats_s, args') <- mapAndUnzipM (makeTrivialArg (getMode env))\n                                           (ai_args info)\n       ; return ( foldl' addLetFloats floats1 floats_s\n                , StrictArg { sc_fun = info { ai_args = args' }\n                            , sc_cci = cci\n                            , sc_cont = cont'\n                            , sc_dup = OkToDup} ) }\n\nmkDupableCont env (ApplyToTy { sc_cont = cont\n                             , sc_arg_ty = arg_ty, sc_hole_ty = hole_ty })\n  = do  { (floats, cont') <- mkDupableCont env cont\n        ; return (floats, ApplyToTy { sc_cont = cont'\n                                    , sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) }\n\nmkDupableCont env (ApplyToVal { sc_arg = arg, sc_dup = dup\n                              , sc_env = se, sc_cont = cont })\n  =     -- e.g.         [...hole...] (...arg...)\n        --      ==>\n        --              let a = ...arg...\n        --              in [...hole...] a\n        -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable\n    do  { (floats1, cont') <- mkDupableCont env cont\n        ; let env' = env `setInScopeFromF` floats1\n        ; (_, se', arg') <- simplArg env' dup se arg\n        ; (let_floats2, arg'') <- makeTrivial (getMode env) NotTopLevel (fsLit \"karg\") arg'\n        ; let all_floats = floats1 `addLetFloats` let_floats2\n        ; return ( all_floats\n                 , ApplyToVal { sc_arg = arg''\n                              , sc_env = se' `setInScopeFromF` all_floats\n                                         -- Ensure that sc_env includes the free vars of\n                                         -- arg'' in its in-scope set, even if makeTrivial\n                                         -- has turned arg'' into a fresh variable\n                                         -- See Note [StaticEnv invariant] in SimplUtils\n                              , sc_dup = OkToDup, sc_cont = cont' }) }\n\nmkDupableCont env (Select { sc_bndr = case_bndr, sc_alts = alts\n                          , sc_env = se, sc_cont = cont })\n  =     -- e.g.         (case [...hole...] of { pi -> ei })\n        --      ===>\n        --              let ji = \\xij -> ei\n        --              in case [...hole...] of { pi -> ji xij }\n        -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable\n    do  { tick (CaseOfCase case_bndr)\n        ; (floats, alt_cont) <- mkDupableCaseCont env alts cont\n                -- NB: We call mkDupableCaseCont here to make cont duplicable\n                --     (if necessary, depending on the number of alts)\n                -- And this is important: see Note [Fusing case continuations]\n\n        ; let alt_env = se `setInScopeFromF` floats\n        ; (alt_env', case_bndr') <- simplBinder alt_env case_bndr\n        ; alts' <- mapM (simplAlt alt_env' Nothing [] case_bndr' alt_cont) alts\n        -- Safe to say that there are no handled-cons for the DEFAULT case\n                -- NB: simplBinder does not zap deadness occ-info, so\n                -- a dead case_bndr' will still advertise its deadness\n                -- This is really important because in\n                --      case e of b { (# p,q #) -> ... }\n                -- b is always dead, and indeed we are not allowed to bind b to (# p,q #),\n                -- which might happen if e was an explicit unboxed pair and b wasn't marked dead.\n                -- In the new alts we build, we have the new case binder, so it must retain\n                -- its deadness.\n        -- NB: we don't use alt_env further; it has the substEnv for\n        --     the alternatives, and we don't want that\n\n        ; (join_floats, alts'') <- mapAccumLM (mkDupableAlt (seDynFlags env) case_bndr')\n                                              emptyJoinFloats alts'\n\n        ; let all_floats = floats `addJoinFloats` join_floats\n                           -- Note [Duplicated env]\n        ; return (all_floats\n                 , Select { sc_dup  = OkToDup\n                          , sc_bndr = case_bndr'\n                          , sc_alts = alts''\n                          , sc_env  = zapSubstEnv se `setInScopeFromF` all_floats\n                                      -- See Note [StaticEnv invariant] in SimplUtils\n                          , sc_cont = mkBoringStop (contResultType cont) } ) }\n\nmkDupableAlt :: DynFlags -> OutId\n             -> JoinFloats -> OutAlt\n             -> SimplM (JoinFloats, OutAlt)\nmkDupableAlt dflags case_bndr jfloats (con, bndrs', rhs')\n  | exprIsDupable dflags rhs'  -- Note [Small alternative rhs]\n  = return (jfloats, (con, bndrs', rhs'))\n\n  | otherwise\n  = do  { let rhs_ty'  = exprType rhs'\n              scrut_ty = idType case_bndr\n              case_bndr_w_unf\n                = case con of\n                      DEFAULT    -> case_bndr\n                      DataAlt dc -> setIdUnfolding case_bndr unf\n                          where\n                                 -- See Note [Case binders and join points]\n                             unf = mkInlineUnfolding rhs\n                             rhs = mkConApp2 dc (tyConAppArgs scrut_ty) bndrs'\n\n                      LitAlt {} -> WARN( True, text \"mkDupableAlt\"\n                                                <+> ppr case_bndr <+> ppr con )\n                                   case_bndr\n                           -- The case binder is alive but trivial, so why has\n                           -- it not been substituted away?\n\n              final_bndrs'\n                | isDeadBinder case_bndr = filter abstract_over bndrs'\n                | otherwise              = bndrs' ++ [case_bndr_w_unf]\n\n              abstract_over bndr\n                  | isTyVar bndr = True -- Abstract over all type variables just in case\n                  | otherwise    = not (isDeadBinder bndr)\n                        -- The deadness info on the new Ids is preserved by simplBinders\n              final_args = varsToCoreExprs final_bndrs'\n                           -- Note [Join point abstraction]\n\n                -- We make the lambdas into one-shot-lambdas.  The\n                -- join point is sure to be applied at most once, and doing so\n                -- prevents the body of the join point being floated out by\n                -- the full laziness pass\n              really_final_bndrs     = map one_shot final_bndrs'\n              one_shot v | isId v    = setOneShotLambda v\n                         | otherwise = v\n              join_rhs   = mkLams really_final_bndrs rhs'\n\n        ; join_bndr <- newJoinId final_bndrs' rhs_ty'\n\n        ; let join_call = mkApps (Var join_bndr) final_args\n              alt'      = (con, bndrs', join_call)\n\n        ; return ( jfloats `addJoinFlts` unitJoinFloat (NonRec join_bndr join_rhs)\n                 , alt') }\n                -- See Note [Duplicated env]\n\n{-\nNote [Fusing case continuations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's important to fuse two successive case continuations when the\nfirst has one alternative.  That's why we call prepareCaseCont here.\nConsider this, which arises from thunk splitting (see Note [Thunk\nsplitting] in WorkWrap):\n\n      let\n        x* = case (case v of {pn -> rn}) of\n               I# a -> I# a\n      in body\n\nThe simplifier will find\n    (Var v) with continuation\n            Select (pn -> rn) (\n            Select [I# a -> I# a] (\n            StrictBind body Stop\n\nSo we'll call mkDupableCont on\n   Select [I# a -> I# a] (StrictBind body Stop)\nThere is just one alternative in the first Select, so we want to\nsimplify the rhs (I# a) with continuation (StrictBind body Stop)\nSupposing that body is big, we end up with\n          let $j a = <let x = I# a in body>\n          in case v of { pn -> case rn of\n                                 I# a -> $j a }\nThis is just what we want because the rn produces a box that\nthe case rn cancels with.\n\nSee Trac #4957 a fuller example.\n\nNote [Case binders and join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n   case (case .. ) of c {\n     I# c# -> ....c....\n\nIf we make a join point with c but not c# we get\n  $j = \\c -> ....c....\n\nBut if later inlining scrutinises the c, thus\n\n  $j = \\c -> ... case c of { I# y -> ... } ...\n\nwe won't see that 'c' has already been scrutinised.  This actually\nhappens in the 'tabulate' function in wave4main, and makes a significant\ndifference to allocation.\n\nAn alternative plan is this:\n\n   $j = \\c# -> let c = I# c# in ...c....\n\nbut that is bad if 'c' is *not* later scrutinised.\n\nSo instead we do both: we pass 'c' and 'c#' , and record in c's inlining\n(a stable unfolding) that it's really I# c#, thus\n\n   $j = \\c# -> \\c[=I# c#] -> ...c....\n\nAbsence analysis may later discard 'c'.\n\nNB: take great care when doing strictness analysis;\n    see Note [Lambda-bound unfoldings] in DmdAnal.\n\nAlso note that we can still end up passing stuff that isn't used.  Before\nstrictness analysis we have\n   let $j x y c{=(x,y)} = (h c, ...)\n   in ...\nAfter strictness analysis we see that h is strict, we end up with\n   let $j x y c{=(x,y)} = ($wh x y, ...)\nand c is unused.\n\nNote [Duplicated env]\n~~~~~~~~~~~~~~~~~~~~~\nSome of the alternatives are simplified, but have not been turned into a join point\nSo they *must* have a zapped subst-env.  So we can't use completeNonRecX to\nbind the join point, because it might to do PostInlineUnconditionally, and\nwe'd lose that when zapping the subst-env.  We could have a per-alt subst-env,\nbut zapping it (as we do in mkDupableCont, the Select case) is safe, and\nat worst delays the join-point inlining.\n\nNote [Small alternative rhs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is worth checking for a small RHS because otherwise we\nget extra let bindings that may cause an extra iteration of the simplifier to\ninline back in place.  Quite often the rhs is just a variable or constructor.\nThe Ord instance of Maybe in PrelMaybe.hs, for example, took several extra\niterations because the version with the let bindings looked big, and so wasn't\ninlined, but after the join points had been inlined it looked smaller, and so\nwas inlined.\n\nNB: we have to check the size of rhs', not rhs.\nDuplicating a small InAlt might invalidate occurrence information\nHowever, if it *is* dupable, we return the *un* simplified alternative,\nbecause otherwise we'd need to pair it up with an empty subst-env....\nbut we only have one env shared between all the alts.\n(Remember we must zap the subst-env before re-simplifying something).\nRather than do this we simply agree to re-simplify the original (small) thing later.\n\nNote [Funky mkLamTypes]\n~~~~~~~~~~~~~~~~~~~~~~\nNotice the funky mkLamTypes.  If the constructor has existentials\nit's possible that the join point will be abstracted over\ntype variables as well as term variables.\n Example:  Suppose we have\n        data T = forall t.  C [t]\n Then faced with\n        case (case e of ...) of\n            C t xs::[t] -> rhs\n We get the join point\n        let j :: forall t. [t] -> ...\n            j = /\\t \\xs::[t] -> rhs\n        in\n        case (case e of ...) of\n            C t xs::[t] -> j t xs\n\nNote [Duplicating StrictArg]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe make a StrictArg duplicable simply by making all its\nstored-up arguments (in sc_fun) trivial, by let-binding\nthem.  Thus:\n        f E [..hole..]\n        ==>     let a = E\n                in f a [..hole..]\nNow if the thing in the hole is a case expression (which is when\nwe'll call mkDupableCont), we'll push the function call into the\nbranches, which is what we want.  Now RULES for f may fire, and\ncall-pattern specialisation.  Here's an example from Trac #3116\n     go (n+1) (case l of\n                 1  -> bs'\n                 _  -> Chunk p fpc (o+1) (l-1) bs')\nIf we can push the call for 'go' inside the case, we get\ncall-pattern specialisation for 'go', which is *crucial* for\nthis program.\n\nHere is the (&&) example:\n        && E (case x of { T -> F; F -> T })\n  ==>   let a = E in\n        case x of { T -> && a F; F -> && a T }\nMuch better!\n\nNotice that\n  * Arguments to f *after* the strict one are handled by\n    the ApplyToVal case of mkDupableCont.  Eg\n        f [..hole..] E\n\n  * We can only do the let-binding of E because the function\n    part of a StrictArg continuation is an explicit syntax\n    tree.  In earlier versions we represented it as a function\n    (CoreExpr -> CoreEpxr) which we couldn't take apart.\n\nHistorical aide: previously we did this (where E is a\nbig argument:\n        f E [..hole..]\n        ==>     let $j = \\a -> f E a\n                in $j [..hole..]\n\nBut this is terrible! Here's an example:\n        && E (case x of { T -> F; F -> T })\nNow, && is strict so we end up simplifying the case with\nan ArgOf continuation.  If we let-bind it, we get\n        let $j = \\v -> && E v\n        in simplExpr (case x of { T -> F; F -> T })\n                     (ArgOf (\\r -> $j r)\nAnd after simplifying more we get\n        let $j = \\v -> && E v\n        in case x of { T -> $j F; F -> $j T }\nWhich is a Very Bad Thing\n\n\nNote [Duplicating StrictBind]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe make a StrictBind duplicable in a very similar way to\nthat for case expressions.  After all,\n   let x* = e in b   is similar to    case e of x -> b\n\nSo we potentially make a join-point for the body, thus:\n   let x = [] in b   ==>   join j x = b\n                           in let x = [] in j x\n\n\nNote [Join point abstraction]  Historical note\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNB: This note is now historical, describing how (in the past) we used\nto add a void argument to nullary join points.  But now that \"join\npoint\" is not a fuzzy concept but a formal syntactic construct (as\ndistinguished by the JoinId constructor of IdDetails), each of these\nconcerns is handled separately, with no need for a vestigial extra\nargument.\n\nJoin points always have at least one value argument,\nfor several reasons\n\n* If we try to lift a primitive-typed something out\n  for let-binding-purposes, we will *caseify* it (!),\n  with potentially-disastrous strictness results.  So\n  instead we turn it into a function: \\v -> e\n  where v::Void#.  The value passed to this function is void,\n  which generates (almost) no code.\n\n* CPR.  We used to say \"&& isUnliftedType rhs_ty'\" here, but now\n  we make the join point into a function whenever used_bndrs'\n  is empty.  This makes the join-point more CPR friendly.\n  Consider:       let j = if .. then I# 3 else I# 4\n                  in case .. of { A -> j; B -> j; C -> ... }\n\n  Now CPR doesn't w/w j because it's a thunk, so\n  that means that the enclosing function can't w/w either,\n  which is a lose.  Here's the example that happened in practice:\n          kgmod :: Int -> Int -> Int\n          kgmod x y = if x > 0 && y < 0 || x < 0 && y > 0\n                      then 78\n                      else 5\n\n* Let-no-escape.  We want a join point to turn into a let-no-escape\n  so that it is implemented as a jump, and one of the conditions\n  for LNE is that it's not updatable.  In CoreToStg, see\n  Note [What is a non-escaping let]\n\n* Floating.  Since a join point will be entered once, no sharing is\n  gained by floating out, but something might be lost by doing\n  so because it might be allocated.\n\nI have seen a case alternative like this:\n        True -> \\v -> ...\nIt's a bit silly to add the realWorld dummy arg in this case, making\n        $j = \\s v -> ...\n           True -> $j s\n(the \\v alone is enough to make CPR happy) but I think it's rare\n\nThere's a slight infelicity here: we pass the overall\ncase_bndr to all the join points if it's used in *any* RHS,\nbecause we don't know its usage in each RHS separately\n\n\n\n************************************************************************\n*                                                                      *\n                    Unfoldings\n*                                                                      *\n************************************************************************\n-}\n\nsimplLetUnfolding :: SimplEnv-> TopLevelFlag\n                  -> MaybeJoinCont\n                  -> InId\n                  -> OutExpr -> OutType\n                  -> Unfolding -> SimplM Unfolding\nsimplLetUnfolding env top_lvl cont_mb id new_rhs rhs_ty unf\n  | isStableUnfolding unf\n  = simplStableUnfolding env top_lvl cont_mb id unf rhs_ty\n  | isExitJoinId id\n  = return noUnfolding -- See Note [Do not inline exit join points] in Exitify\n  | otherwise\n  = mkLetUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs\n\n-------------------\nmkLetUnfolding :: DynFlags -> TopLevelFlag -> UnfoldingSource\n               -> InId -> OutExpr -> SimplM Unfolding\nmkLetUnfolding dflags top_lvl src id new_rhs\n  = is_bottoming `seq`  -- See Note [Force bottoming field]\n    return (mkUnfolding dflags src is_top_lvl is_bottoming new_rhs)\n            -- We make an  unfolding *even for loop-breakers*.\n            -- Reason: (a) It might be useful to know that they are WHNF\n            --         (b) In TidyPgm we currently assume that, if we want to\n            --             expose the unfolding then indeed we *have* an unfolding\n            --             to expose.  (We could instead use the RHS, but currently\n            --             we don't.)  The simple thing is always to have one.\n  where\n    is_top_lvl   = isTopLevel top_lvl\n    is_bottoming = isBottomingId id\n\n-------------------\nsimplStableUnfolding :: SimplEnv -> TopLevelFlag\n                     -> MaybeJoinCont  -- Just k => a join point with continuation k\n                     -> InId\n                     -> Unfolding -> OutType -> SimplM Unfolding\n-- Note [Setting the new unfolding]\nsimplStableUnfolding env top_lvl mb_cont id unf rhs_ty\n  = case unf of\n      NoUnfolding   -> return unf\n      BootUnfolding -> return unf\n      OtherCon {}   -> return unf\n\n      DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args }\n        -> do { (env', bndrs') <- simplBinders unf_env bndrs\n              ; args' <- mapM (simplExpr env') args\n              ; return (mkDFunUnfolding bndrs' con args') }\n\n      CoreUnfolding { uf_tmpl = expr, uf_src = src, uf_guidance = guide }\n        | isStableSource src\n        -> do { expr' <- case mb_cont of -- See Note [Rules and unfolding for join points]\n                           Just cont -> simplJoinRhs unf_env id expr cont\n                           Nothing   -> simplExprC unf_env expr (mkBoringStop rhs_ty)\n              ; case guide of\n                  UnfWhen { ug_arity = arity\n                          , ug_unsat_ok = sat_ok\n                          , ug_boring_ok = boring_ok\n                          }\n                          -- Happens for INLINE things\n                     -> let guide' =\n                              UnfWhen { ug_arity = arity\n                                      , ug_unsat_ok = sat_ok\n                                      , ug_boring_ok =\n                                          boring_ok || inlineBoringOk expr'\n                                      }\n                        -- Refresh the boring-ok flag, in case expr'\n                        -- has got small. This happens, notably in the inlinings\n                        -- for dfuns for single-method classes; see\n                        -- Note [Single-method classes] in TcInstDcls.\n                        -- A test case is Trac #4138\n                        -- But retain a previous boring_ok of True; e.g. see\n                        -- the way it is set in calcUnfoldingGuidanceWithArity\n                        in return (mkCoreUnfolding src is_top_lvl expr' guide')\n                            -- See Note [Top-level flag on inline rules] in CoreUnfold\n\n                  _other              -- Happens for INLINABLE things\n                     -> mkLetUnfolding dflags top_lvl src id expr' }\n                -- If the guidance is UnfIfGoodArgs, this is an INLINABLE\n                -- unfolding, and we need to make sure the guidance is kept up\n                -- to date with respect to any changes in the unfolding.\n\n        | otherwise -> return noUnfolding   -- Discard unstable unfoldings\n  where\n    dflags     = seDynFlags env\n    is_top_lvl = isTopLevel top_lvl\n    act        = idInlineActivation id\n    unf_env    = updMode (updModeForStableUnfoldings act) env\n         -- See Note [Simplifying inside stable unfoldings] in SimplUtils\n\n{-\nNote [Force bottoming field]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need to force bottoming, or the new unfolding holds\non to the old unfolding (which is part of the id).\n\nNote [Setting the new unfolding]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* If there's an INLINE pragma, we simplify the RHS gently.  Maybe we\n  should do nothing at all, but simplifying gently might get rid of\n  more crap.\n\n* If not, we make an unfolding from the new RHS.  But *only* for\n  non-loop-breakers. Making loop breakers not have an unfolding at all\n  means that we can avoid tests in exprIsConApp, for example.  This is\n  important: if exprIsConApp says 'yes' for a recursive thing, then we\n  can get into an infinite loop\n\nIf there's a stable unfolding on a loop breaker (which happens for\nINLINABLE), we hang on to the inlining.  It's pretty dodgy, but the\nuser did say 'INLINE'.  May need to revisit this choice.\n\n************************************************************************\n*                                                                      *\n                    Rules\n*                                                                      *\n************************************************************************\n\nNote [Rules in a letrec]\n~~~~~~~~~~~~~~~~~~~~~~~~\nAfter creating fresh binders for the binders of a letrec, we\nsubstitute the RULES and add them back onto the binders; this is done\n*before* processing any of the RHSs.  This is important.  Manuel found\ncases where he really, really wanted a RULE for a recursive function\nto apply in that function's own right-hand side.\n\nSee Note [Forming Rec groups] in OccurAnal\n-}\n\naddBndrRules :: SimplEnv -> InBndr -> OutBndr\n             -> MaybeJoinCont   -- Just k for a join point binder\n                                -- Nothing otherwise\n             -> SimplM (SimplEnv, OutBndr)\n-- Rules are added back into the bin\naddBndrRules env in_id out_id mb_cont\n  | null old_rules\n  = return (env, out_id)\n  | otherwise\n  = do { new_rules <- simplRules env (Just out_id) old_rules mb_cont\n       ; let final_id  = out_id `setIdSpecialisation` mkRuleInfo new_rules\n       ; return (modifyInScope env final_id, final_id) }\n  where\n    old_rules = ruleInfoRules (idSpecialisation in_id)\n\nsimplRules :: SimplEnv -> Maybe OutId -> [CoreRule]\n           -> MaybeJoinCont -> SimplM [CoreRule]\nsimplRules env mb_new_id rules mb_cont\n  = mapM simpl_rule rules\n  where\n    simpl_rule rule@(BuiltinRule {})\n      = return rule\n\n    simpl_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args\n                          , ru_fn = fn_name, ru_rhs = rhs })\n      = do { (env', bndrs') <- simplBinders env bndrs\n           ; let rhs_ty = substTy env' (exprType rhs)\n                 rhs_cont = case mb_cont of  -- See Note [Rules and unfolding for join points]\n                                Nothing   -> mkBoringStop rhs_ty\n                                Just cont -> ASSERT2( join_ok, bad_join_msg )\n                                             cont\n                 rule_env = updMode updModeForRules env'\n                 fn_name' = case mb_new_id of\n                              Just id -> idName id\n                              Nothing -> fn_name\n\n                 -- join_ok is an assertion check that the join-arity of the\n                 -- binder matches that of the rule, so that pushing the\n                 -- continuation into the RHS makes sense\n                 join_ok = case mb_new_id of\n                             Just id | Just join_arity <- isJoinId_maybe id\n                                     -> length args == join_arity\n                             _ -> False\n                 bad_join_msg = vcat [ ppr mb_new_id, ppr rule\n                                     , ppr (fmap isJoinId_maybe mb_new_id) ]\n\n           ; args' <- mapM (simplExpr rule_env) args\n           ; rhs'  <- simplExprC rule_env rhs rhs_cont\n           ; return (rule { ru_bndrs = bndrs'\n                          , ru_fn    = fn_name'\n                          , ru_args  = args'\n                          , ru_rhs   = rhs' }) }\n", "num_lines": 3603}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section[SimplMonad]{The simplifier Monad}\n-}\n\nmodule SimplMonad (\n        -- The monad\n        SimplM,\n        initSmpl, traceSmpl,\n        getSimplRules, getFamEnvs,\n\n        -- Unique supply\n        MonadUnique(..), newId, newJoinId,\n\n        -- Counting\n        SimplCount, tick, freeTick, checkedTick,\n        getSimplCount, zeroSimplCount, pprSimplCount,\n        plusSimplCount, isZeroSimplCount\n    ) where\n\nimport GhcPrelude\n\nimport Var              ( Var, isTyVar, mkLocalVar )\nimport Name             ( mkSystemVarName )\nimport Id               ( Id, mkSysLocalOrCoVar )\nimport IdInfo           ( IdDetails(..), vanillaIdInfo, setArityInfo )\nimport Type             ( Type, mkLamTypes )\nimport FamInstEnv       ( FamInstEnv )\nimport CoreSyn          ( RuleEnv(..) )\nimport UniqSupply\nimport DynFlags\nimport CoreMonad\nimport Outputable\nimport FastString\nimport MonadUtils\nimport ErrUtils as Err\nimport Panic (throwGhcExceptionIO, GhcException (..))\nimport BasicTypes          ( IntWithInf, treatZeroAsInf, mkIntWithInf )\nimport Control.Monad       ( liftM, ap )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Monad plumbing}\n*                                                                      *\n************************************************************************\n\nFor the simplifier monad, we want to {\\em thread} a unique supply and a counter.\n(Command-line switches move around through the explicitly-passed SimplEnv.)\n-}\n\nnewtype SimplM result\n  =  SM  { unSM :: SimplTopEnv  -- Envt that does not change much\n                -> UniqSupply   -- We thread the unique supply because\n                                -- constantly splitting it is rather expensive\n                -> SimplCount\n                -> IO (result, UniqSupply, SimplCount)}\n  -- we only need IO here for dump output\n\ndata SimplTopEnv\n  = STE { st_flags     :: DynFlags\n        , st_max_ticks :: IntWithInf  -- Max #ticks in this simplifier run\n        , st_rules     :: RuleEnv\n        , st_fams      :: (FamInstEnv, FamInstEnv) }\n\ninitSmpl :: DynFlags -> RuleEnv -> (FamInstEnv, FamInstEnv)\n         -> UniqSupply          -- No init count; set to 0\n         -> Int                 -- Size of the bindings, used to limit\n                                -- the number of ticks we allow\n         -> SimplM a\n         -> IO (a, SimplCount)\n\ninitSmpl dflags rules fam_envs us size m\n  = do (result, _, count) <- unSM m env us (zeroSimplCount dflags)\n       return (result, count)\n  where\n    env = STE { st_flags = dflags, st_rules = rules\n              , st_max_ticks = computeMaxTicks dflags size\n              , st_fams = fam_envs }\n\ncomputeMaxTicks :: DynFlags -> Int -> IntWithInf\n-- Compute the max simplifier ticks as\n--     (base-size + pgm-size) * magic-multiplier * tick-factor/100\n-- where\n--    magic-multiplier is a constant that gives reasonable results\n--    base-size is a constant to deal with size-zero programs\ncomputeMaxTicks dflags size\n  = treatZeroAsInf $\n    fromInteger ((toInteger (size + base_size)\n                  * toInteger (tick_factor * magic_multiplier))\n          `div` 100)\n  where\n    tick_factor      = simplTickFactor dflags\n    base_size        = 100\n    magic_multiplier = 40\n        -- MAGIC NUMBER, multiplies the simplTickFactor\n        -- We can afford to be generous; this is really\n        -- just checking for loops, and shouldn't usually fire\n        -- A figure of 20 was too small: see Trac #5539.\n\n{-# INLINE thenSmpl #-}\n{-# INLINE thenSmpl_ #-}\n{-# INLINE returnSmpl #-}\n\n\ninstance Functor SimplM where\n    fmap = liftM\n\ninstance Applicative SimplM where\n    pure  = returnSmpl\n    (<*>) = ap\n    (*>)  = thenSmpl_\n\ninstance Monad SimplM where\n   (>>)   = (*>)\n   (>>=)  = thenSmpl\n\nreturnSmpl :: a -> SimplM a\nreturnSmpl e = SM (\\_st_env us sc -> return (e, us, sc))\n\nthenSmpl  :: SimplM a -> (a -> SimplM b) -> SimplM b\nthenSmpl_ :: SimplM a -> SimplM b -> SimplM b\n\nthenSmpl m k\n  = SM $ \\st_env us0 sc0 -> do\n      (m_result, us1, sc1) <- unSM m st_env us0 sc0\n      unSM (k m_result) st_env us1 sc1\n\nthenSmpl_ m k\n  = SM $ \\st_env us0 sc0 -> do\n      (_, us1, sc1) <- unSM m st_env us0 sc0\n      unSM k st_env us1 sc1\n\n-- TODO: this specializing is not allowed\n-- {-# SPECIALIZE mapM         :: (a -> SimplM b) -> [a] -> SimplM [b] #-}\n-- {-# SPECIALIZE mapAndUnzipM :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c]) #-}\n-- {-# SPECIALIZE mapAccumLM   :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c]) #-}\n\ntraceSmpl :: String -> SDoc -> SimplM ()\ntraceSmpl herald doc\n  = do { dflags <- getDynFlags\n       ; liftIO $ Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_trace \"Simpl Trace\"\n           (hang (text herald) 2 doc) }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The unique supply}\n*                                                                      *\n************************************************************************\n-}\n\ninstance MonadUnique SimplM where\n    getUniqueSupplyM\n       = SM (\\_st_env us sc -> case splitUniqSupply us of\n                                (us1, us2) -> return (us1, us2, sc))\n\n    getUniqueM\n       = SM (\\_st_env us sc -> case takeUniqFromSupply us of\n                                (u, us') -> return (u, us', sc))\n\n    getUniquesM\n        = SM (\\_st_env us sc -> case splitUniqSupply us of\n                                (us1, us2) -> return (uniqsFromSupply us1, us2, sc))\n\ninstance HasDynFlags SimplM where\n    getDynFlags = SM (\\st_env us sc -> return (st_flags st_env, us, sc))\n\ninstance MonadIO SimplM where\n    liftIO m = SM $ \\_ us sc -> do\n      x <- m\n      return (x, us, sc)\n\ngetSimplRules :: SimplM RuleEnv\ngetSimplRules = SM (\\st_env us sc -> return (st_rules st_env, us, sc))\n\ngetFamEnvs :: SimplM (FamInstEnv, FamInstEnv)\ngetFamEnvs = SM (\\st_env us sc -> return (st_fams st_env, us, sc))\n\nnewId :: FastString -> Type -> SimplM Id\nnewId fs ty = do uniq <- getUniqueM\n                 return (mkSysLocalOrCoVar fs uniq ty)\n\nnewJoinId :: [Var] -> Type -> SimplM Id\nnewJoinId bndrs body_ty\n  = do { uniq <- getUniqueM\n       ; let name       = mkSystemVarName uniq (fsLit \"$j\")\n             join_id_ty = mkLamTypes bndrs body_ty  -- Note [Funky mkLamTypes]\n             arity      = length (filter (not . isTyVar) bndrs)\n             join_arity = length bndrs\n             details    = JoinId join_arity\n             id_info    = vanillaIdInfo `setArityInfo` arity\n--                                        `setOccInfo` strongLoopBreaker\n\n       ; return (mkLocalVar details name join_id_ty id_info) }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Counting up what we've done}\n*                                                                      *\n************************************************************************\n-}\n\ngetSimplCount :: SimplM SimplCount\ngetSimplCount = SM (\\_st_env us sc -> return (sc, us, sc))\n\ntick :: Tick -> SimplM ()\ntick t = SM (\\st_env us sc -> let sc' = doSimplTick (st_flags st_env) t sc\n                              in sc' `seq` return ((), us, sc'))\n\ncheckedTick :: Tick -> SimplM ()\n-- Try to take a tick, but fail if too many\ncheckedTick t\n  = SM (\\st_env us sc ->\n           if st_max_ticks st_env <= mkIntWithInf (simplCountN sc)\n           then throwGhcExceptionIO $\n                  PprProgramError \"Simplifier ticks exhausted\" (msg sc)\n           else let sc' = doSimplTick (st_flags st_env) t sc\n                in sc' `seq` return ((), us, sc'))\n  where\n    msg sc = vcat\n      [ text \"When trying\" <+> ppr t\n      , text \"To increase the limit, use -fsimpl-tick-factor=N (default 100).\"\n      , space\n      , text \"If you need to increase the limit substantially, please file a\"\n      , text \"bug report and indicate the factor you needed.\"\n      , space\n      , text \"If GHC was unable to complete compilation even\"\n               <+> text \"with a very large factor\"\n      , text \"(a thousand or more), please consult the\"\n                <+> doubleQuotes (text \"Known bugs or infelicities\")\n      , text \"section in the Users Guide before filing a report. There are a\"\n      , text \"few situations unlikely to occur in practical programs for which\"\n      , text \"simplifier non-termination has been judged acceptable.\"\n      , space\n      , pp_details sc\n      , pprSimplCount sc ]\n    pp_details sc\n      | hasDetailedCounts sc = empty\n      | otherwise = text \"To see detailed counts use -ddump-simpl-stats\"\n\n\nfreeTick :: Tick -> SimplM ()\n-- Record a tick, but don't add to the total tick count, which is\n-- used to decide when nothing further has happened\nfreeTick t\n   = SM (\\_st_env us sc -> let sc' = doFreeSimplTick t sc\n                           in sc' `seq` return ((), us, sc'))\n", "num_lines": 251}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section[SimplUtils]{The simplifier utilities}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule SimplUtils (\n        -- Rebuilding\n        mkLam, mkCase, prepareAlts, tryEtaExpandRhs,\n\n        -- Inlining,\n        preInlineUnconditionally, postInlineUnconditionally,\n        activeUnfolding, activeRule,\n        getUnfoldingInRuleMatch,\n        simplEnvForGHCi, updModeForStableUnfoldings, updModeForRules,\n\n        -- The continuation type\n        SimplCont(..), DupFlag(..), StaticEnv,\n        isSimplified, contIsStop,\n        contIsDupable, contResultType, contHoleType,\n        contIsTrivial, contArgs,\n        countArgs,\n        mkBoringStop, mkRhsStop, mkLazyArgStop, contIsRhsOrArg,\n        interestingCallContext,\n\n        -- ArgInfo\n        ArgInfo(..), ArgSpec(..), mkArgInfo,\n        addValArgTo, addCastTo, addTyArgTo,\n        argInfoExpr, argInfoAppArgs, pushSimplifiedArgs,\n\n        abstractFloats,\n\n        -- Utilities\n        isExitJoinId\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport SimplEnv\nimport CoreMonad        ( SimplMode(..), Tick(..) )\nimport DynFlags\nimport CoreSyn\nimport qualified CoreSubst\nimport PprCore\nimport CoreFVs\nimport CoreUtils\nimport CoreArity\nimport CoreUnfold\nimport Name\nimport Id\nimport IdInfo\nimport Var\nimport Demand\nimport SimplMonad\nimport Type     hiding( substTy )\nimport Coercion hiding( substCo )\nimport DataCon          ( dataConWorkId, isNullaryRepDataCon )\nimport VarSet\nimport BasicTypes\nimport Util\nimport OrdList          ( isNilOL )\nimport MonadUtils\nimport Outputable\nimport Pair\nimport PrelRules\nimport FastString       ( fsLit )\n\nimport Control.Monad    ( when )\nimport Data.List        ( sortBy )\n\n{-\n************************************************************************\n*                                                                      *\n                The SimplCont and DupFlag types\n*                                                                      *\n************************************************************************\n\nA SimplCont allows the simplifier to traverse the expression in a\nzipper-like fashion.  The SimplCont represents the rest of the expression,\n\"above\" the point of interest.\n\nYou can also think of a SimplCont as an \"evaluation context\", using\nthat term in the way it is used for operational semantics. This is the\nway I usually think of it, For example you'll often see a syntax for\nevaluation context looking like\n        C ::= []  |  C e   |  case C of alts  |  C `cast` co\nThat's the kind of thing we are doing here, and I use that syntax in\nthe comments.\n\n\nKey points:\n  * A SimplCont describes a *strict* context (just like\n    evaluation contexts do).  E.g. Just [] is not a SimplCont\n\n  * A SimplCont describes a context that *does not* bind\n    any variables.  E.g. \\x. [] is not a SimplCont\n-}\n\ndata SimplCont\n  = Stop                -- Stop[e] = e\n        OutType         -- Type of the <hole>\n        CallCtxt        -- Tells if there is something interesting about\n                        --          the context, and hence the inliner\n                        --          should be a bit keener (see interestingCallContext)\n                        -- Specifically:\n                        --     This is an argument of a function that has RULES\n                        --     Inlining the call might allow the rule to fire\n                        -- Never ValAppCxt (use ApplyToVal instead)\n                        -- or CaseCtxt (use Select instead)\n\n  | CastIt              -- (CastIt co K)[e] = K[ e `cast` co ]\n        OutCoercion             -- The coercion simplified\n                                -- Invariant: never an identity coercion\n        SimplCont\n\n  | ApplyToVal         -- (ApplyToVal arg K)[e] = K[ e arg ]\n      { sc_dup  :: DupFlag      -- See Note [DupFlag invariants]\n      , sc_arg  :: InExpr       -- The argument,\n      , sc_env  :: StaticEnv    -- see Note [StaticEnv invariant]\n      , sc_cont :: SimplCont }\n\n  | ApplyToTy          -- (ApplyToTy ty K)[e] = K[ e ty ]\n      { sc_arg_ty  :: OutType     -- Argument type\n      , sc_hole_ty :: OutType     -- Type of the function, presumably (forall a. blah)\n                                  -- See Note [The hole type in ApplyToTy]\n      , sc_cont    :: SimplCont }\n\n  | Select             -- (Select alts K)[e] = K[ case e of alts ]\n      { sc_dup  :: DupFlag        -- See Note [DupFlag invariants]\n      , sc_bndr :: InId           -- case binder\n      , sc_alts :: [InAlt]        -- Alternatives\n      , sc_env  :: StaticEnv      -- See Note [StaticEnv invariant]\n      , sc_cont :: SimplCont }\n\n  -- The two strict forms have no DupFlag, because we never duplicate them\n  | StrictBind          -- (StrictBind x xs b K)[e] = let x = e in K[\\xs.b]\n                        --       or, equivalently,  = K[ (\\x xs.b) e ]\n      { sc_dup   :: DupFlag        -- See Note [DupFlag invariants]\n      , sc_bndr  :: InId\n      , sc_bndrs :: [InBndr]\n      , sc_body  :: InExpr\n      , sc_env   :: StaticEnv      -- See Note [StaticEnv invariant]\n      , sc_cont  :: SimplCont }\n\n  | StrictArg           -- (StrictArg (f e1 ..en) K)[e] = K[ f e1 .. en e ]\n      { sc_dup  :: DupFlag     -- Always Simplified or OkToDup\n      , sc_fun  :: ArgInfo     -- Specifies f, e1..en, Whether f has rules, etc\n                               --     plus strictness flags for *further* args\n      , sc_cci  :: CallCtxt    -- Whether *this* argument position is interesting\n      , sc_cont :: SimplCont }\n\n  | TickIt              -- (TickIt t K)[e] = K[ tick t e ]\n        (Tickish Id)    -- Tick tickish <hole>\n        SimplCont\n\ntype StaticEnv = SimplEnv       -- Just the static part is relevant\n\ndata DupFlag = NoDup       -- Unsimplified, might be big\n             | Simplified  -- Simplified\n             | OkToDup     -- Simplified and small\n\nisSimplified :: DupFlag -> Bool\nisSimplified NoDup = False\nisSimplified _     = True       -- Invariant: the subst-env is empty\n\nperhapsSubstTy :: DupFlag -> StaticEnv -> Type -> Type\nperhapsSubstTy dup env ty\n  | isSimplified dup = ty\n  | otherwise        = substTy env ty\n\n{- Note [StaticEnv invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe pair up an InExpr or InAlts with a StaticEnv, which establishes the\nlexical scope for that InExpr.  When we simplify that InExpr/InAlts, we\nuse\n  - Its captured StaticEnv\n  - Overriding its InScopeSet with the larger one at the\n    simplification point.\n\nWhy override the InScopeSet?  Example:\n      (let y = ey in f) ex\nBy the time we simplify ex, 'y' will be in scope.\n\nHowever the InScopeSet in the StaticEnv is not irrelevant: it should\ninclude all the free vars of applying the substitution to the InExpr.\nReason: contHoleType uses perhapsSubstTy to apply the substitution to\nthe expression, and that (rightly) gives ASSERT failures if the InScopeSet\nisn't big enough.\n\nNote [DupFlag invariants]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nIn both (ApplyToVal dup _ env k)\n   and  (Select dup _ _ env k)\nthe following invariants hold\n\n  (a) if dup = OkToDup, then continuation k is also ok-to-dup\n  (b) if dup = OkToDup or Simplified, the subst-env is empty\n      (and and hence no need to re-simplify)\n-}\n\ninstance Outputable DupFlag where\n  ppr OkToDup    = text \"ok\"\n  ppr NoDup      = text \"nodup\"\n  ppr Simplified = text \"simpl\"\n\ninstance Outputable SimplCont where\n  ppr (Stop ty interesting) = text \"Stop\" <> brackets (ppr interesting) <+> ppr ty\n  ppr (CastIt co cont  )    = (text \"CastIt\" <+> pprOptCo co) $$ ppr cont\n  ppr (TickIt t cont)       = (text \"TickIt\" <+> ppr t) $$ ppr cont\n  ppr (ApplyToTy  { sc_arg_ty = ty, sc_cont = cont })\n    = (text \"ApplyToTy\" <+> pprParendType ty) $$ ppr cont\n  ppr (ApplyToVal { sc_arg = arg, sc_dup = dup, sc_cont = cont })\n    = (text \"ApplyToVal\" <+> ppr dup <+> pprParendExpr arg)\n                                        $$ ppr cont\n  ppr (StrictBind { sc_bndr = b, sc_cont = cont })\n    = (text \"StrictBind\" <+> ppr b) $$ ppr cont\n  ppr (StrictArg { sc_fun = ai, sc_cont = cont })\n    = (text \"StrictArg\" <+> ppr (ai_fun ai)) $$ ppr cont\n  ppr (Select { sc_dup = dup, sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont })\n    = (text \"Select\" <+> ppr dup <+> ppr bndr) $$\n       whenPprDebug (nest 2 $ vcat [ppr (seTvSubst se), ppr alts]) $$ ppr cont\n\n\n{- Note [The hole type in ApplyToTy]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe sc_hole_ty field of ApplyToTy records the type of the \"hole\" in the\ncontinuation.  It is absolutely necessary to compute contHoleType, but it is\nnot used for anything else (and hence may not be evaluated).\n\nWhy is it necessary for contHoleType?  Consider the continuation\n     ApplyToType Int (Stop Int)\ncorresponding to\n     (<hole> @Int) :: Int\nWhat is the type of <hole>?  It could be (forall a. Int) or (forall a. a),\nand there is no way to know which, so we must record it.\n\nIn a chain of applications  (f @t1 @t2 @t3) we'll lazily compute exprType\nfor (f @t1) and (f @t1 @t2), which is potentially non-linear; but it probably\ndoesn't matter because we'll never compute them all.\n\n************************************************************************\n*                                                                      *\n                ArgInfo and ArgSpec\n*                                                                      *\n************************************************************************\n-}\n\ndata ArgInfo\n  = ArgInfo {\n        ai_fun   :: OutId,      -- The function\n        ai_args  :: [ArgSpec],  -- ...applied to these args (which are in *reverse* order)\n\n        ai_type  :: OutType,    -- Type of (f a1 ... an)\n\n        ai_rules :: FunRules,   -- Rules for this function\n\n        ai_encl :: Bool,        -- Flag saying whether this function\n                                -- or an enclosing one has rules (recursively)\n                                --      True => be keener to inline in all args\n\n        ai_strs :: [Bool],      -- Strictness of remaining arguments\n                                --   Usually infinite, but if it is finite it guarantees\n                                --   that the function diverges after being given\n                                --   that number of args\n        ai_discs :: [Int]       -- Discounts for remaining arguments; non-zero => be keener to inline\n                                --   Always infinite\n    }\n\ndata ArgSpec\n  = ValArg OutExpr                    -- Apply to this (coercion or value); c.f. ApplyToVal\n  | TyArg { as_arg_ty  :: OutType     -- Apply to this type; c.f. ApplyToTy\n          , as_hole_ty :: OutType }   -- Type of the function (presumably forall a. blah)\n  | CastBy OutCoercion                -- Cast by this; c.f. CastIt\n\ninstance Outputable ArgSpec where\n  ppr (ValArg e)                 = text \"ValArg\" <+> ppr e\n  ppr (TyArg { as_arg_ty = ty }) = text \"TyArg\" <+> ppr ty\n  ppr (CastBy c)                 = text \"CastBy\" <+> ppr c\n\naddValArgTo :: ArgInfo -> OutExpr -> ArgInfo\naddValArgTo ai arg = ai { ai_args = ValArg arg : ai_args ai\n                        , ai_type = applyTypeToArg (ai_type ai) arg\n                        , ai_rules = decRules (ai_rules ai) }\n\naddTyArgTo :: ArgInfo -> OutType -> ArgInfo\naddTyArgTo ai arg_ty = ai { ai_args = arg_spec : ai_args ai\n                          , ai_type = piResultTy poly_fun_ty arg_ty\n                          , ai_rules = decRules (ai_rules ai) }\n  where\n    poly_fun_ty = ai_type ai\n    arg_spec    = TyArg { as_arg_ty = arg_ty, as_hole_ty = poly_fun_ty }\n\naddCastTo :: ArgInfo -> OutCoercion -> ArgInfo\naddCastTo ai co = ai { ai_args = CastBy co : ai_args ai\n                     , ai_type = pSnd (coercionKind co) }\n\nargInfoAppArgs :: [ArgSpec] -> [OutExpr]\nargInfoAppArgs []                              = []\nargInfoAppArgs (CastBy {}                : _)  = []  -- Stop at a cast\nargInfoAppArgs (ValArg e                 : as) = e       : argInfoAppArgs as\nargInfoAppArgs (TyArg { as_arg_ty = ty } : as) = Type ty : argInfoAppArgs as\n\npushSimplifiedArgs :: SimplEnv -> [ArgSpec] -> SimplCont -> SimplCont\npushSimplifiedArgs _env []           k = k\npushSimplifiedArgs env  (arg : args) k\n  = case arg of\n      TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty }\n               -> ApplyToTy  { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = rest }\n      ValArg e -> ApplyToVal { sc_arg = e, sc_env = env, sc_dup = Simplified, sc_cont = rest }\n      CastBy c -> CastIt c rest\n  where\n    rest = pushSimplifiedArgs env args k\n           -- The env has an empty SubstEnv\n\nargInfoExpr :: OutId -> [ArgSpec] -> OutExpr\n-- NB: the [ArgSpec] is reversed so that the first arg\n-- in the list is the last one in the application\nargInfoExpr fun rev_args\n  = go rev_args\n  where\n    go []                              = Var fun\n    go (ValArg a                 : as) = go as `App` a\n    go (TyArg { as_arg_ty = ty } : as) = go as `App` Type ty\n    go (CastBy co                : as) = mkCast (go as) co\n\n\ntype FunRules = Maybe (Int, [CoreRule]) -- Remaining rules for this function\n     -- Nothing => No rules\n     -- Just (n, rules) => some rules, requiring at least n more type/value args\n\ndecRules :: FunRules -> FunRules\ndecRules (Just (n, rules)) = Just (n-1, rules)\ndecRules Nothing           = Nothing\n\nmkFunRules :: [CoreRule] -> FunRules\nmkFunRules [] = Nothing\nmkFunRules rs = Just (n_required, rs)\n  where\n    n_required = maximum (map ruleArity rs)\n\n{-\n************************************************************************\n*                                                                      *\n                Functions on SimplCont\n*                                                                      *\n************************************************************************\n-}\n\nmkBoringStop :: OutType -> SimplCont\nmkBoringStop ty = Stop ty BoringCtxt\n\nmkRhsStop :: OutType -> SimplCont       -- See Note [RHS of lets] in CoreUnfold\nmkRhsStop ty = Stop ty RhsCtxt\n\nmkLazyArgStop :: OutType -> CallCtxt -> SimplCont\nmkLazyArgStop ty cci = Stop ty cci\n\n-------------------\ncontIsRhsOrArg :: SimplCont -> Bool\ncontIsRhsOrArg (Stop {})       = True\ncontIsRhsOrArg (StrictBind {}) = True\ncontIsRhsOrArg (StrictArg {})  = True\ncontIsRhsOrArg _               = False\n\ncontIsRhs :: SimplCont -> Bool\ncontIsRhs (Stop _ RhsCtxt) = True\ncontIsRhs _                = False\n\n-------------------\ncontIsStop :: SimplCont -> Bool\ncontIsStop (Stop {}) = True\ncontIsStop _         = False\n\ncontIsDupable :: SimplCont -> Bool\ncontIsDupable (Stop {})                         = True\ncontIsDupable (ApplyToTy  { sc_cont = k })      = contIsDupable k\ncontIsDupable (ApplyToVal { sc_dup = OkToDup }) = True -- See Note [DupFlag invariants]\ncontIsDupable (Select { sc_dup = OkToDup })     = True -- ...ditto...\ncontIsDupable (StrictArg { sc_dup = OkToDup })  = True -- ...ditto...\ncontIsDupable (CastIt _ k)                      = contIsDupable k\ncontIsDupable _                                 = False\n\n-------------------\ncontIsTrivial :: SimplCont -> Bool\ncontIsTrivial (Stop {})                                         = True\ncontIsTrivial (ApplyToTy { sc_cont = k })                       = contIsTrivial k\ncontIsTrivial (ApplyToVal { sc_arg = Coercion _, sc_cont = k }) = contIsTrivial k\ncontIsTrivial (CastIt _ k)                                      = contIsTrivial k\ncontIsTrivial _                                                 = False\n\n-------------------\ncontResultType :: SimplCont -> OutType\ncontResultType (Stop ty _)                  = ty\ncontResultType (CastIt _ k)                 = contResultType k\ncontResultType (StrictBind { sc_cont = k }) = contResultType k\ncontResultType (StrictArg { sc_cont = k })  = contResultType k\ncontResultType (Select { sc_cont = k })     = contResultType k\ncontResultType (ApplyToTy  { sc_cont = k }) = contResultType k\ncontResultType (ApplyToVal { sc_cont = k }) = contResultType k\ncontResultType (TickIt _ k)                 = contResultType k\n\ncontHoleType :: SimplCont -> OutType\ncontHoleType (Stop ty _)                      = ty\ncontHoleType (TickIt _ k)                     = contHoleType k\ncontHoleType (CastIt co _)                    = pFst (coercionKind co)\ncontHoleType (StrictBind { sc_bndr = b, sc_dup = dup, sc_env = se })\n  = perhapsSubstTy dup se (idType b)\ncontHoleType (StrictArg { sc_fun = ai })      = funArgTy (ai_type ai)\ncontHoleType (ApplyToTy  { sc_hole_ty = ty }) = ty  -- See Note [The hole type in ApplyToTy]\ncontHoleType (ApplyToVal { sc_arg = e, sc_env = se, sc_dup = dup, sc_cont = k })\n  = mkVisFunTy (perhapsSubstTy dup se (exprType e))\n               (contHoleType k)\ncontHoleType (Select { sc_dup = d, sc_bndr =  b, sc_env = se })\n  = perhapsSubstTy d se (idType b)\n\n-------------------\ncountArgs :: SimplCont -> Int\n-- Count all arguments, including types, coercions, and other values\ncountArgs (ApplyToTy  { sc_cont = cont }) = 1 + countArgs cont\ncountArgs (ApplyToVal { sc_cont = cont }) = 1 + countArgs cont\ncountArgs _                               = 0\n\ncontArgs :: SimplCont -> (Bool, [ArgSummary], SimplCont)\n-- Summarises value args, discards type args and coercions\n-- The returned continuation of the call is only used to\n-- answer questions like \"are you interesting?\"\ncontArgs cont\n  | lone cont = (True, [], cont)\n  | otherwise = go [] cont\n  where\n    lone (ApplyToTy  {}) = False  -- See Note [Lone variables] in CoreUnfold\n    lone (ApplyToVal {}) = False\n    lone (CastIt {})     = False\n    lone _               = True\n\n    go args (ApplyToVal { sc_arg = arg, sc_env = se, sc_cont = k })\n                                        = go (is_interesting arg se : args) k\n    go args (ApplyToTy { sc_cont = k }) = go args k\n    go args (CastIt _ k)                = go args k\n    go args k                           = (False, reverse args, k)\n\n    is_interesting arg se = interestingArg se arg\n                   -- Do *not* use short-cutting substitution here\n                   -- because we want to get as much IdInfo as possible\n\n\n-------------------\nmkArgInfo :: SimplEnv\n          -> Id\n          -> [CoreRule] -- Rules for function\n          -> Int        -- Number of value args\n          -> SimplCont  -- Context of the call\n          -> ArgInfo\n\nmkArgInfo env fun rules n_val_args call_cont\n  | n_val_args < idArity fun            -- Note [Unsaturated functions]\n  = ArgInfo { ai_fun = fun, ai_args = [], ai_type = fun_ty\n            , ai_rules = fun_rules\n            , ai_encl = False\n            , ai_strs = vanilla_stricts\n            , ai_discs = vanilla_discounts }\n  | otherwise\n  = ArgInfo { ai_fun = fun, ai_args = [], ai_type = fun_ty\n            , ai_rules = fun_rules\n            , ai_encl  = interestingArgContext rules call_cont\n            , ai_strs  = arg_stricts\n            , ai_discs = arg_discounts }\n  where\n    fun_ty = idType fun\n\n    fun_rules = mkFunRules rules\n\n    vanilla_discounts, arg_discounts :: [Int]\n    vanilla_discounts = repeat 0\n    arg_discounts = case idUnfolding fun of\n                        CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_args = discounts}}\n                              -> discounts ++ vanilla_discounts\n                        _     -> vanilla_discounts\n\n    vanilla_stricts, arg_stricts :: [Bool]\n    vanilla_stricts  = repeat False\n\n    arg_stricts\n      | not (sm_inline (seMode env))\n      = vanilla_stricts -- See Note [Do not expose strictness if sm_inline=False]\n      | otherwise\n      = add_type_str fun_ty $\n        case splitStrictSig (idStrictness fun) of\n          (demands, result_info)\n                | not (demands `lengthExceeds` n_val_args)\n                ->      -- Enough args, use the strictness given.\n                        -- For bottoming functions we used to pretend that the arg\n                        -- is lazy, so that we don't treat the arg as an\n                        -- interesting context.  This avoids substituting\n                        -- top-level bindings for (say) strings into\n                        -- calls to error.  But now we are more careful about\n                        -- inlining lone variables, so its ok (see SimplUtils.analyseCont)\n                   if isBotRes result_info then\n                        map isStrictDmd demands         -- Finite => result is bottom\n                   else\n                        map isStrictDmd demands ++ vanilla_stricts\n               | otherwise\n               -> WARN( True, text \"More demands than arity\" <+> ppr fun <+> ppr (idArity fun)\n                                <+> ppr n_val_args <+> ppr demands )\n                   vanilla_stricts      -- Not enough args, or no strictness\n\n    add_type_str :: Type -> [Bool] -> [Bool]\n    -- If the function arg types are strict, record that in the 'strictness bits'\n    -- No need to instantiate because unboxed types (which dominate the strict\n    --   types) can't instantiate type variables.\n    -- add_type_str is done repeatedly (for each call);\n    --   might be better once-for-all in the function\n    -- But beware primops/datacons with no strictness\n\n    add_type_str _ [] = []\n    add_type_str fun_ty all_strs@(str:strs)\n      | Just (arg_ty, fun_ty') <- splitFunTy_maybe fun_ty        -- Add strict-type info\n      = (str || Just False == isLiftedType_maybe arg_ty)\n        : add_type_str fun_ty' strs\n          -- If the type is levity-polymorphic, we can't know whether it's\n          -- strict. isLiftedType_maybe will return Just False only when\n          -- we're sure the type is unlifted.\n\n      | Just (_, fun_ty') <- splitForAllTy_maybe fun_ty\n      = add_type_str fun_ty' all_strs     -- Look through foralls\n\n      | otherwise\n      = all_strs\n\n{- Note [Unsaturated functions]\n  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (test eyeball/inline4)\n        x = a:as\n        y = f x\nwhere f has arity 2.  Then we do not want to inline 'x', because\nit'll just be floated out again.  Even if f has lots of discounts\non its first argument -- it must be saturated for these to kick in\n\nNote [Do not expose strictness if sm_inline=False]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTrac #15163 showed a case in which we had\n\n  {-# INLINE [1] zip #-}\n  zip = undefined\n\n  {-# RULES \"foo\" forall as bs. stream (zip as bs) = ..blah... #-}\n\nIf we expose zip's bottoming nature when simplifing the LHS of the\nRULE we get\n  {-# RULES \"foo\" forall as bs.\n                   stream (case zip of {}) = ..blah... #-}\ndiscarding the arguments to zip.  Usually this is fine, but on the\nLHS of a rule it's not, because 'as' and 'bs' are now not bound on\nthe LHS.\n\nThis is a pretty pathalogical example, so I'm not losing sleep over\nit, but the simplest solution was to check sm_inline; if it is False,\nwhich it is on the LHS of a rule (see updModeForRules), then don't\nmake use of the strictness info for the function.\n-}\n\n\n{-\n************************************************************************\n*                                                                      *\n        Interesting arguments\n*                                                                      *\n************************************************************************\n\nNote [Interesting call context]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to avoid inlining an expression where there can't possibly be\nany gain, such as in an argument position.  Hence, if the continuation\nis interesting (eg. a case scrutinee, application etc.) then we\ninline, otherwise we don't.\n\nPreviously some_benefit used to return True only if the variable was\napplied to some value arguments.  This didn't work:\n\n        let x = _coerce_ (T Int) Int (I# 3) in\n        case _coerce_ Int (T Int) x of\n                I# y -> ....\n\nwe want to inline x, but can't see that it's a constructor in a case\nscrutinee position, and some_benefit is False.\n\nAnother example:\n\ndMonadST = _/\\_ t -> :Monad (g1 _@_ t, g2 _@_ t, g3 _@_ t)\n\n....  case dMonadST _@_ x0 of (a,b,c) -> ....\n\nwe'd really like to inline dMonadST here, but we *don't* want to\ninline if the case expression is just\n\n        case x of y { DEFAULT -> ... }\n\nsince we can just eliminate this case instead (x is in WHNF).  Similar\napplies when x is bound to a lambda expression.  Hence\ncontIsInteresting looks for case expressions with just a single\ndefault case.\n\nNote [No case of case is boring]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we see\n   case f x of <alts>\n\nwe'd usually treat the context as interesting, to encourage 'f' to\ninline.  But if case-of-case is off, it's really not so interesting\nafter all, because we are unlikely to be able to push the case\nexpression into the branches of any case in f's unfolding.  So, to\nreduce unnecessary code expansion, we just make the context look boring.\nThis made a small compile-time perf improvement in perf/compiler/T6048,\nand it looks plausible to me.\n-}\n\ninterestingCallContext :: SimplEnv -> SimplCont -> CallCtxt\n-- See Note [Interesting call context]\ninterestingCallContext env cont\n  = interesting cont\n  where\n    interesting (Select {})\n       | sm_case_case (getMode env) = CaseCtxt\n       | otherwise                  = BoringCtxt\n       -- See Note [No case of case is boring]\n\n    interesting (ApplyToVal {}) = ValAppCtxt\n        -- Can happen if we have (f Int |> co) y\n        -- If f has an INLINE prag we need to give it some\n        -- motivation to inline. See Note [Cast then apply]\n        -- in CoreUnfold\n\n    interesting (StrictArg { sc_cci = cci }) = cci\n    interesting (StrictBind {})              = BoringCtxt\n    interesting (Stop _ cci)                 = cci\n    interesting (TickIt _ k)                 = interesting k\n    interesting (ApplyToTy { sc_cont = k })  = interesting k\n    interesting (CastIt _ k)                 = interesting k\n        -- If this call is the arg of a strict function, the context\n        -- is a bit interesting.  If we inline here, we may get useful\n        -- evaluation information to avoid repeated evals: e.g.\n        --      x + (y * z)\n        -- Here the contIsInteresting makes the '*' keener to inline,\n        -- which in turn exposes a constructor which makes the '+' inline.\n        -- Assuming that +,* aren't small enough to inline regardless.\n        --\n        -- It's also very important to inline in a strict context for things\n        -- like\n        --              foldr k z (f x)\n        -- Here, the context of (f x) is strict, and if f's unfolding is\n        -- a build it's *great* to inline it here.  So we must ensure that\n        -- the context for (f x) is not totally uninteresting.\n\ninterestingArgContext :: [CoreRule] -> SimplCont -> Bool\n-- If the argument has form (f x y), where x,y are boring,\n-- and f is marked INLINE, then we don't want to inline f.\n-- But if the context of the argument is\n--      g (f x y)\n-- where g has rules, then we *do* want to inline f, in case it\n-- exposes a rule that might fire.  Similarly, if the context is\n--      h (g (f x x))\n-- where h has rules, then we do want to inline f; hence the\n-- call_cont argument to interestingArgContext\n--\n-- The ai-rules flag makes this happen; if it's\n-- set, the inliner gets just enough keener to inline f\n-- regardless of how boring f's arguments are, if it's marked INLINE\n--\n-- The alternative would be to *always* inline an INLINE function,\n-- regardless of how boring its context is; but that seems overkill\n-- For example, it'd mean that wrapper functions were always inlined\n--\n-- The call_cont passed to interestingArgContext is the context of\n-- the call itself, e.g. g <hole> in the example above\ninterestingArgContext rules call_cont\n  = notNull rules || enclosing_fn_has_rules\n  where\n    enclosing_fn_has_rules = go call_cont\n\n    go (Select {})                  = False\n    go (ApplyToVal {})              = False  -- Shouldn't really happen\n    go (ApplyToTy  {})              = False  -- Ditto\n    go (StrictArg { sc_cci = cci }) = interesting cci\n    go (StrictBind {})              = False      -- ??\n    go (CastIt _ c)                 = go c\n    go (Stop _ cci)                 = interesting cci\n    go (TickIt _ c)                 = go c\n\n    interesting RuleArgCtxt = True\n    interesting _           = False\n\n\n{- Note [Interesting arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn argument is interesting if it deserves a discount for unfoldings\nwith a discount in that argument position.  The idea is to avoid\nunfolding a function that is applied only to variables that have no\nunfolding (i.e. they are probably lambda bound): f x y z There is\nlittle point in inlining f here.\n\nGenerally, *values* (like (C a b) and (\\x.e)) deserve discounts.  But\nwe must look through lets, eg (let x = e in C a b), because the let will\nfloat, exposing the value, if we inline.  That makes it different to\nexprIsHNF.\n\nBefore 2009 we said it was interesting if the argument had *any* structure\nat all; i.e. (hasSomeUnfolding v).  But does too much inlining; see Trac #3016.\n\nBut we don't regard (f x y) as interesting, unless f is unsaturated.\nIf it's saturated and f hasn't inlined, then it's probably not going\nto now!\n\nNote [Conlike is interesting]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n        f d = ...((*) d x y)...\n        ... f (df d')...\nwhere df is con-like. Then we'd really like to inline 'f' so that the\nrule for (*) (df d) can fire.  To do this\n  a) we give a discount for being an argument of a class-op (eg (*) d)\n  b) we say that a con-like argument (eg (df d)) is interesting\n-}\n\ninterestingArg :: SimplEnv -> CoreExpr -> ArgSummary\n-- See Note [Interesting arguments]\ninterestingArg env e = go env 0 e\n  where\n    -- n is # value args to which the expression is applied\n    go env n (Var v)\n       = case substId env v of\n           DoneId v'            -> go_var n v'\n           DoneEx e _           -> go (zapSubstEnv env)             n e\n           ContEx tvs cvs ids e -> go (setSubstEnv env tvs cvs ids) n e\n\n    go _   _ (Lit {})          = ValueArg\n    go _   _ (Type _)          = TrivArg\n    go _   _ (Coercion _)      = TrivArg\n    go env n (App fn (Type _)) = go env n fn\n    go env n (App fn _)        = go env (n+1) fn\n    go env n (Tick _ a)        = go env n a\n    go env n (Cast e _)        = go env n e\n    go env n (Lam v e)\n       | isTyVar v             = go env n e\n       | n>0                   = NonTrivArg     -- (\\x.b) e   is NonTriv\n       | otherwise             = ValueArg\n    go _ _ (Case {})           = NonTrivArg\n    go env n (Let b e)         = case go env' n e of\n                                   ValueArg -> ValueArg\n                                   _        -> NonTrivArg\n                               where\n                                 env' = env `addNewInScopeIds` bindersOf b\n\n    go_var n v\n       | isConLikeId v     = ValueArg   -- Experimenting with 'conlike' rather that\n                                        --    data constructors here\n       | idArity v > n     = ValueArg   -- Catches (eg) primops with arity but no unfolding\n       | n > 0             = NonTrivArg -- Saturated or unknown call\n       | conlike_unfolding = ValueArg   -- n==0; look for an interesting unfolding\n                                        -- See Note [Conlike is interesting]\n       | otherwise         = TrivArg    -- n==0, no useful unfolding\n       where\n         conlike_unfolding = isConLikeUnfolding (idUnfolding v)\n\n{-\n************************************************************************\n*                                                                      *\n                  SimplMode\n*                                                                      *\n************************************************************************\n\nThe SimplMode controls several switches; see its definition in\nCoreMonad\n        sm_rules      :: Bool     -- Whether RULES are enabled\n        sm_inline     :: Bool     -- Whether inlining is enabled\n        sm_case_case  :: Bool     -- Whether case-of-case is enabled\n        sm_eta_expand :: Bool     -- Whether eta-expansion is enabled\n-}\n\nsimplEnvForGHCi :: DynFlags -> SimplEnv\nsimplEnvForGHCi dflags\n  = mkSimplEnv $ SimplMode { sm_names  = [\"GHCi\"]\n                           , sm_phase  = InitialPhase\n                           , sm_dflags = dflags\n                           , sm_rules  = rules_on\n                           , sm_inline = False\n                           , sm_eta_expand = eta_expand_on\n                           , sm_case_case  = True }\n  where\n    rules_on      = gopt Opt_EnableRewriteRules   dflags\n    eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags\n   -- Do not do any inlining, in case we expose some unboxed\n   -- tuple stuff that confuses the bytecode interpreter\n\nupdModeForStableUnfoldings :: Activation -> SimplMode -> SimplMode\n-- See Note [Simplifying inside stable unfoldings]\nupdModeForStableUnfoldings inline_rule_act current_mode\n  = current_mode { sm_phase      = phaseFromActivation inline_rule_act\n                 , sm_inline     = True\n                 , sm_eta_expand = False }\n                     -- sm_eta_expand: see Note [No eta expansion in stable unfoldings]\n       -- For sm_rules, just inherit; sm_rules might be \"off\"\n       -- because of -fno-enable-rewrite-rules\n  where\n    phaseFromActivation (ActiveAfter _ n) = Phase n\n    phaseFromActivation _                 = InitialPhase\n\nupdModeForRules :: SimplMode -> SimplMode\n-- See Note [Simplifying rules]\nupdModeForRules current_mode\n  = current_mode { sm_phase      = InitialPhase\n                 , sm_inline     = False  -- See Note [Do not expose strictness if sm_inline=False]\n                 , sm_rules      = False\n                 , sm_eta_expand = False }\n\n{- Note [Simplifying rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen simplifying a rule LHS, refrain from /any/ inlining or applying\nof other RULES.\n\nDoing anything to the LHS is plain confusing, because it means that what the\nrule matches is not what the user wrote. c.f. Trac #10595, and #10528.\nMoreover, inlining (or applying rules) on rule LHSs risks introducing\nTicks into the LHS, which makes matching trickier. Trac #10665, #10745.\n\nDoing this to either side confounds tools like HERMIT, which seek to reason\nabout and apply the RULES as originally written. See Trac #10829.\n\nNote [No eta expansion in stable unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have a stable unfolding\n\n  f :: Ord a => a -> IO ()\n  -- Unfolding template\n  --    = /\\a \\(d:Ord a) (x:a). bla\n\nwe do not want to eta-expand to\n\n  f :: Ord a => a -> IO ()\n  -- Unfolding template\n  --    = (/\\a \\(d:Ord a) (x:a) (eta:State#). bla eta) |> co\n\nbecause not specialisation of the overloading doesn't work properly\n(see Note [Specialisation shape] in Specialise), Trac #9509.\n\nSo we disable eta-expansion in stable unfoldings.\n\nNote [Inlining in gentle mode]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSomething is inlined if\n   (i)   the sm_inline flag is on, AND\n   (ii)  the thing has an INLINE pragma, AND\n   (iii) the thing is inlinable in the earliest phase.\n\nExample of why (iii) is important:\n  {-# INLINE [~1] g #-}\n  g = ...\n\n  {-# INLINE f #-}\n  f x = g (g x)\n\nIf we were to inline g into f's inlining, then an importing module would\nnever be able to do\n        f e --> g (g e) ---> RULE fires\nbecause the stable unfolding for f has had g inlined into it.\n\nOn the other hand, it is bad not to do ANY inlining into an\nstable unfolding, because then recursive knots in instance declarations\ndon't get unravelled.\n\nHowever, *sometimes* SimplGently must do no call-site inlining at all\n(hence sm_inline = False).  Before full laziness we must be careful\nnot to inline wrappers, because doing so inhibits floating\n    e.g. ...(case f x of ...)...\n    ==> ...(case (case x of I# x# -> fw x#) of ...)...\n    ==> ...(case x of I# x# -> case fw x# of ...)...\nand now the redex (f x) isn't floatable any more.\n\nThe no-inlining thing is also important for Template Haskell.  You might be\ncompiling in one-shot mode with -O2; but when TH compiles a splice before\nrunning it, we don't want to use -O2.  Indeed, we don't want to inline\nanything, because the byte-code interpreter might get confused about\nunboxed tuples and suchlike.\n\nNote [Simplifying inside stable unfoldings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must take care with simplification inside stable unfoldings (which come from\nINLINE pragmas).\n\nFirst, consider the following example\n        let f = \\pq -> BIG\n        in\n        let g = \\y -> f y y\n            {-# INLINE g #-}\n        in ...g...g...g...g...g...\nNow, if that's the ONLY occurrence of f, it might be inlined inside g,\nand thence copied multiple times when g is inlined. HENCE we treat\nany occurrence in a stable unfolding as a multiple occurrence, not a single\none; see OccurAnal.addRuleUsage.\n\nSecond, we do want *do* to some modest rules/inlining stuff in stable\nunfoldings, partly to eliminate senseless crap, and partly to break\nthe recursive knots generated by instance declarations.\n\nHowever, suppose we have\n        {-# INLINE <act> f #-}\n        f = <rhs>\nmeaning \"inline f in phases p where activation <act>(p) holds\".\nThen what inlinings/rules can we apply to the copy of <rhs> captured in\nf's stable unfolding?  Our model is that literally <rhs> is substituted for\nf when it is inlined.  So our conservative plan (implemented by\nupdModeForStableUnfoldings) is this:\n\n  -------------------------------------------------------------\n  When simplifying the RHS of a stable unfolding, set the phase\n  to the phase in which the stable unfolding first becomes active\n  -------------------------------------------------------------\n\nThat ensures that\n\n  a) Rules/inlinings that *cease* being active before p will\n     not apply to the stable unfolding, consistent with it being\n     inlined in its *original* form in phase p.\n\n  b) Rules/inlinings that only become active *after* p will\n     not apply to the stable unfolding, again to be consistent with\n     inlining the *original* rhs in phase p.\n\nFor example,\n        {-# INLINE f #-}\n        f x = ...g...\n\n        {-# NOINLINE [1] g #-}\n        g y = ...\n\n        {-# RULE h g = ... #-}\nHere we must not inline g into f's RHS, even when we get to phase 0,\nbecause when f is later inlined into some other module we want the\nrule for h to fire.\n\nSimilarly, consider\n        {-# INLINE f #-}\n        f x = ...g...\n\n        g y = ...\nand suppose that there are auto-generated specialisations and a strictness\nwrapper for g.  The specialisations get activation AlwaysActive, and the\nstrictness wrapper get activation (ActiveAfter 0).  So the strictness\nwrepper fails the test and won't be inlined into f's stable unfolding. That\nmeans f can inline, expose the specialised call to g, so the specialisation\nrules can fire.\n\nA note about wrappers\n~~~~~~~~~~~~~~~~~~~~~\nIt's also important not to inline a worker back into a wrapper.\nA wrapper looks like\n        wraper = inline_me (\\x -> ...worker... )\nNormally, the inline_me prevents the worker getting inlined into\nthe wrapper (initially, the worker's only call site!).  But,\nif the wrapper is sure to be called, the strictness analyser will\nmark it 'demanded', so when the RHS is simplified, it'll get an ArgOf\ncontinuation.\n-}\n\nactiveUnfolding :: SimplMode -> Id -> Bool\nactiveUnfolding mode id\n  | isCompulsoryUnfolding (realIdUnfolding id)\n  = True   -- Even sm_inline can't override compulsory unfoldings\n  | otherwise\n  = isActive (sm_phase mode) (idInlineActivation id)\n  && sm_inline mode\n      -- `or` isStableUnfolding (realIdUnfolding id)\n      -- Inline things when\n      --  (a) they are active\n      --  (b) sm_inline says so, except that for stable unfoldings\n      --                         (ie pragmas) we inline anyway\n\ngetUnfoldingInRuleMatch :: SimplEnv -> InScopeEnv\n-- When matching in RULE, we want to \"look through\" an unfolding\n-- (to see a constructor) if *rules* are on, even if *inlinings*\n-- are not.  A notable example is DFuns, which really we want to\n-- match in rules like (op dfun) in gentle mode. Another example\n-- is 'otherwise' which we want exprIsConApp_maybe to be able to\n-- see very early on\ngetUnfoldingInRuleMatch env\n  = (in_scope, id_unf)\n  where\n    in_scope = seInScope env\n    mode = getMode env\n    id_unf id | unf_is_active id = idUnfolding id\n              | otherwise        = NoUnfolding\n    unf_is_active id\n     | not (sm_rules mode) = -- active_unfolding_minimal id\n                             isStableUnfolding (realIdUnfolding id)\n        -- Do we even need to test this?  I think this InScopeEnv\n        -- is only consulted if activeRule returns True, which\n        -- never happens if sm_rules is False\n     | otherwise           = isActive (sm_phase mode) (idInlineActivation id)\n\n----------------------\nactiveRule :: SimplMode -> Activation -> Bool\n-- Nothing => No rules at all\nactiveRule mode\n  | not (sm_rules mode) = \\_ -> False     -- Rewriting is off\n  | otherwise           = isActive (sm_phase mode)\n\n{-\n************************************************************************\n*                                                                      *\n                  preInlineUnconditionally\n*                                                                      *\n************************************************************************\n\npreInlineUnconditionally\n~~~~~~~~~~~~~~~~~~~~~~~~\n@preInlineUnconditionally@ examines a bndr to see if it is used just\nonce in a completely safe way, so that it is safe to discard the\nbinding inline its RHS at the (unique) usage site, REGARDLESS of how\nbig the RHS might be.  If this is the case we don't simplify the RHS\nfirst, but just inline it un-simplified.\n\nThis is much better than first simplifying a perhaps-huge RHS and then\ninlining and re-simplifying it.  Indeed, it can be at least quadratically\nbetter.  Consider\n\n        x1 = e1\n        x2 = e2[x1]\n        x3 = e3[x2]\n        ...etc...\n        xN = eN[xN-1]\n\nWe may end up simplifying e1 N times, e2 N-1 times, e3 N-3 times etc.\nThis can happen with cascades of functions too:\n\n        f1 = \\x1.e1\n        f2 = \\xs.e2[f1]\n        f3 = \\xs.e3[f3]\n        ...etc...\n\nTHE MAIN INVARIANT is this:\n\n        ----  preInlineUnconditionally invariant -----\n   IF preInlineUnconditionally chooses to inline x = <rhs>\n   THEN doing the inlining should not change the occurrence\n        info for the free vars of <rhs>\n        ----------------------------------------------\n\nFor example, it's tempting to look at trivial binding like\n        x = y\nand inline it unconditionally.  But suppose x is used many times,\nbut this is the unique occurrence of y.  Then inlining x would change\ny's occurrence info, which breaks the invariant.  It matters: y\nmight have a BIG rhs, which will now be dup'd at every occurrenc of x.\n\n\nEven RHSs labelled InlineMe aren't caught here, because there might be\nno benefit from inlining at the call site.\n\n[Sept 01] Don't unconditionally inline a top-level thing, because that\ncan simply make a static thing into something built dynamically.  E.g.\n        x = (a,b)\n        main = \\s -> h x\n\n[Remember that we treat \\s as a one-shot lambda.]  No point in\ninlining x unless there is something interesting about the call site.\n\nBut watch out: if you aren't careful, some useful foldr/build fusion\ncan be lost (most notably in spectral/hartel/parstof) because the\nfoldr didn't see the build.  Doing the dynamic allocation isn't a big\ndeal, in fact, but losing the fusion can be.  But the right thing here\nseems to be to do a callSiteInline based on the fact that there is\nsomething interesting about the call site (it's strict).  Hmm.  That\nseems a bit fragile.\n\nConclusion: inline top level things gaily until Phase 0 (the last\nphase), at which point don't.\n\nNote [pre/postInlineUnconditionally in gentle mode]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEven in gentle mode we want to do preInlineUnconditionally.  The\nreason is that too little clean-up happens if you don't inline\nuse-once things.  Also a bit of inlining is *good* for full laziness;\nit can expose constant sub-expressions.  Example in\nspectral/mandel/Mandel.hs, where the mandelset function gets a useful\nlet-float if you inline windowToViewport\n\nHowever, as usual for Gentle mode, do not inline things that are\ninactive in the initial stages.  See Note [Gentle mode].\n\nNote [Stable unfoldings and preInlineUnconditionally]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSurprisingly, do not pre-inline-unconditionally Ids with INLINE pragmas!\nExample\n\n   {-# INLINE f #-}\n   f :: Eq a => a -> a\n   f x = ...\n\n   fInt :: Int -> Int\n   fInt = f Int dEqInt\n\n   ...fInt...fInt...fInt...\n\nHere f occurs just once, in the RHS of fInt. But if we inline it there\nit might make fInt look big, and we'll lose the opportunity to inline f\nat each of fInt's call sites.  The INLINE pragma will only inline when\nthe application is saturated for exactly this reason; and we don't\nwant PreInlineUnconditionally to second-guess it.  A live example is\nTrac #3736.\n    c.f. Note [Stable unfoldings and postInlineUnconditionally]\n\nNB: if the pragma is INLINEABLE, then we don't want to behave in\nthis special way -- an INLINEABLE pragma just says to GHC \"inline this\nif you like\".  But if there is a unique occurrence, we want to inline\nthe stable unfolding, not the RHS.\n\nNote [Top-level bottoming Ids]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDon't inline top-level Ids that are bottoming, even if they are used just\nonce, because FloatOut has gone to some trouble to extract them out.\nInlining them won't make the program run faster!\n\nNote [Do not inline CoVars unconditionally]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCoercion variables appear inside coercions, and the RHS of a let-binding\nis a term (not a coercion) so we can't necessarily inline the latter in\nthe former.\n-}\n\npreInlineUnconditionally\n    :: SimplEnv -> TopLevelFlag -> InId\n    -> InExpr -> StaticEnv  -- These two go together\n    -> Maybe SimplEnv       -- Returned env has extended substitution\n-- Precondition: rhs satisfies the let/app invariant\n-- See Note [CoreSyn let/app invariant] in CoreSyn\n-- Reason: we don't want to inline single uses, or discard dead bindings,\n--         for unlifted, side-effect-ful bindings\npreInlineUnconditionally env top_lvl bndr rhs rhs_env\n  | not pre_inline_unconditionally           = Nothing\n  | not active                               = Nothing\n  | isTopLevel top_lvl && isBottomingId bndr = Nothing -- Note [Top-level bottoming Ids]\n  | isCoVar bndr                             = Nothing -- Note [Do not inline CoVars unconditionally]\n  | isExitJoinId bndr                        = Nothing -- Note [Do not inline exit join points]\n                                                       -- in module Exitify\n  | not (one_occ (idOccInfo bndr))           = Nothing\n  | not (isStableUnfolding unf)              = Just (extend_subst_with rhs)\n\n  -- Note [Stable unfoldings and preInlineUnconditionally]\n  | isInlinablePragma inline_prag\n  , Just inl <- maybeUnfoldingTemplate unf   = Just (extend_subst_with inl)\n  | otherwise                                = Nothing\n  where\n    unf = idUnfolding bndr\n    extend_subst_with inl_rhs = extendIdSubst env bndr (mkContEx rhs_env inl_rhs)\n\n    one_occ IAmDead = True -- Happens in ((\\x.1) v)\n    one_occ (OneOcc { occ_one_br = True      -- One textual occurrence\n                    , occ_in_lam = in_lam\n                    , occ_int_cxt = int_cxt })\n        | not in_lam = isNotTopLevel top_lvl || early_phase\n        | otherwise  = int_cxt && canInlineInLam rhs\n    one_occ _        = False\n\n    pre_inline_unconditionally = gopt Opt_SimplPreInlining (seDynFlags env)\n    mode   = getMode env\n    active = isActive (sm_phase mode) (inlinePragmaActivation inline_prag)\n             -- See Note [pre/postInlineUnconditionally in gentle mode]\n    inline_prag = idInlinePragma bndr\n\n-- Be very careful before inlining inside a lambda, because (a) we must not\n-- invalidate occurrence information, and (b) we want to avoid pushing a\n-- single allocation (here) into multiple allocations (inside lambda).\n-- Inlining a *function* with a single *saturated* call would be ok, mind you.\n--      || (if is_cheap && not (canInlineInLam rhs) then pprTrace \"preinline\" (ppr bndr <+> ppr rhs) ok else ok)\n--      where\n--              is_cheap = exprIsCheap rhs\n--              ok = is_cheap && int_cxt\n\n        --      int_cxt         The context isn't totally boring\n        -- E.g. let f = \\ab.BIG in \\y. map f xs\n        --      Don't want to substitute for f, because then we allocate\n        --      its closure every time the \\y is called\n        -- But: let f = \\ab.BIG in \\y. map (f y) xs\n        --      Now we do want to substitute for f, even though it's not\n        --      saturated, because we're going to allocate a closure for\n        --      (f y) every time round the loop anyhow.\n\n        -- canInlineInLam => free vars of rhs are (Once in_lam) or Many,\n        -- so substituting rhs inside a lambda doesn't change the occ info.\n        -- Sadly, not quite the same as exprIsHNF.\n    canInlineInLam (Lit _)    = True\n    canInlineInLam (Lam b e)  = isRuntimeVar b || canInlineInLam e\n    canInlineInLam (Tick t e) = not (tickishIsCode t) && canInlineInLam e\n    canInlineInLam _          = False\n      -- not ticks.  Counting ticks cannot be duplicated, and non-counting\n      -- ticks around a Lam will disappear anyway.\n\n    early_phase = case sm_phase mode of\n                    Phase 0 -> False\n                    _       -> True\n-- If we don't have this early_phase test, consider\n--      x = length [1,2,3]\n-- The full laziness pass carefully floats all the cons cells to\n-- top level, and preInlineUnconditionally floats them all back in.\n-- Result is (a) static allocation replaced by dynamic allocation\n--           (b) many simplifier iterations because this tickles\n--               a related problem; only one inlining per pass\n--\n-- On the other hand, I have seen cases where top-level fusion is\n-- lost if we don't inline top level thing (e.g. string constants)\n-- Hence the test for phase zero (which is the phase for all the final\n-- simplifications).  Until phase zero we take no special notice of\n-- top level things, but then we become more leery about inlining\n-- them.\n\n{-\n************************************************************************\n*                                                                      *\n                  postInlineUnconditionally\n*                                                                      *\n************************************************************************\n\npostInlineUnconditionally\n~~~~~~~~~~~~~~~~~~~~~~~~~\n@postInlineUnconditionally@ decides whether to unconditionally inline\na thing based on the form of its RHS; in particular if it has a\ntrivial RHS.  If so, we can inline and discard the binding altogether.\n\nNB: a loop breaker has must_keep_binding = True and non-loop-breakers\nonly have *forward* references. Hence, it's safe to discard the binding\n\nNOTE: This isn't our last opportunity to inline.  We're at the binding\nsite right now, and we'll get another opportunity when we get to the\noccurrence(s)\n\nNote that we do this unconditional inlining only for trival RHSs.\nDon't inline even WHNFs inside lambdas; doing so may simply increase\nallocation when the function is called. This isn't the last chance; see\nNOTE above.\n\nNB: Even inline pragmas (e.g. IMustBeINLINEd) are ignored here Why?\nBecause we don't even want to inline them into the RHS of constructor\narguments. See NOTE above\n\nNB: At one time even NOINLINE was ignored here: if the rhs is trivial\nit's best to inline it anyway.  We often get a=E; b=a from desugaring,\nwith both a and b marked NOINLINE.  But that seems incompatible with\nour new view that inlining is like a RULE, so I'm sticking to the 'active'\nstory for now.\n-}\n\npostInlineUnconditionally\n    :: SimplEnv -> TopLevelFlag\n    -> OutId            -- The binder (*not* a CoVar), including its unfolding\n    -> OccInfo          -- From the InId\n    -> OutExpr\n    -> Bool\n-- Precondition: rhs satisfies the let/app invariant\n-- See Note [CoreSyn let/app invariant] in CoreSyn\n-- Reason: we don't want to inline single uses, or discard dead bindings,\n--         for unlifted, side-effect-ful bindings\npostInlineUnconditionally env top_lvl bndr occ_info rhs\n  | not active                  = False\n  | isWeakLoopBreaker occ_info  = False -- If it's a loop-breaker of any kind, don't inline\n                                        -- because it might be referred to \"earlier\"\n  | isStableUnfolding unfolding = False -- Note [Stable unfoldings and postInlineUnconditionally]\n  | isTopLevel top_lvl          = False -- Note [Top level and postInlineUnconditionally]\n  | exprIsTrivial rhs           = True\n  | otherwise\n  = case occ_info of\n        -- The point of examining occ_info here is that for *non-values*\n        -- that occur outside a lambda, the call-site inliner won't have\n        -- a chance (because it doesn't know that the thing\n        -- only occurs once).   The pre-inliner won't have gotten\n        -- it either, if the thing occurs in more than one branch\n        -- So the main target is things like\n        --      let x = f y in\n        --      case v of\n        --         True  -> case x of ...\n        --         False -> case x of ...\n        -- This is very important in practice; e.g. wheel-seive1 doubles\n        -- in allocation if you miss this out\n      OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt }\n               -- OneOcc => no code-duplication issue\n        ->     smallEnoughToInline dflags unfolding     -- Small enough to dup\n                        -- ToDo: consider discount on smallEnoughToInline if int_cxt is true\n                        --\n                        -- NB: Do NOT inline arbitrarily big things, even if one_br is True\n                        -- Reason: doing so risks exponential behaviour.  We simplify a big\n                        --         expression, inline it, and simplify it again.  But if the\n                        --         very same thing happens in the big expression, we get\n                        --         exponential cost!\n                        -- PRINCIPLE: when we've already simplified an expression once,\n                        -- make sure that we only inline it if it's reasonably small.\n\n           && (not in_lam ||\n                        -- Outside a lambda, we want to be reasonably aggressive\n                        -- about inlining into multiple branches of case\n                        -- e.g. let x = <non-value>\n                        --      in case y of { C1 -> ..x..; C2 -> ..x..; C3 -> ... }\n                        -- Inlining can be a big win if C3 is the hot-spot, even if\n                        -- the uses in C1, C2 are not 'interesting'\n                        -- An example that gets worse if you add int_cxt here is 'clausify'\n\n                (isCheapUnfolding unfolding && int_cxt))\n                        -- isCheap => acceptable work duplication; in_lam may be true\n                        -- int_cxt to prevent us inlining inside a lambda without some\n                        -- good reason.  See the notes on int_cxt in preInlineUnconditionally\n\n      IAmDead -> True   -- This happens; for example, the case_bndr during case of\n                        -- known constructor:  case (a,b) of x { (p,q) -> ... }\n                        -- Here x isn't mentioned in the RHS, so we don't want to\n                        -- create the (dead) let-binding  let x = (a,b) in ...\n\n      _ -> False\n\n-- Here's an example that we don't handle well:\n--      let f = if b then Left (\\x.BIG) else Right (\\y.BIG)\n--      in \\y. ....case f of {...} ....\n-- Here f is used just once, and duplicating the case work is fine (exprIsCheap).\n-- But\n--  - We can't preInlineUnconditionally because that woud invalidate\n--    the occ info for b.\n--  - We can't postInlineUnconditionally because the RHS is big, and\n--    that risks exponential behaviour\n--  - We can't call-site inline, because the rhs is big\n-- Alas!\n\n  where\n    unfolding = idUnfolding bndr\n    dflags    = seDynFlags env\n    active    = isActive (sm_phase (getMode env)) (idInlineActivation bndr)\n        -- See Note [pre/postInlineUnconditionally in gentle mode]\n\n{-\nNote [Top level and postInlineUnconditionally]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't do postInlineUnconditionally for top-level things (even for\nones that are trivial):\n\n  * Doing so will inline top-level error expressions that have been\n    carefully floated out by FloatOut.  More generally, it might\n    replace static allocation with dynamic.\n\n  * Even for trivial expressions there's a problem.  Consider\n      {-# RULE \"foo\" forall (xs::[T]). reverse xs = ruggle xs #-}\n      blah xs = reverse xs\n      ruggle = sort\n    In one simplifier pass we might fire the rule, getting\n      blah xs = ruggle xs\n    but in *that* simplifier pass we must not do postInlineUnconditionally\n    on 'ruggle' because then we'll have an unbound occurrence of 'ruggle'\n\n    If the rhs is trivial it'll be inlined by callSiteInline, and then\n    the binding will be dead and discarded by the next use of OccurAnal\n\n  * There is less point, because the main goal is to get rid of local\n    bindings used in multiple case branches.\n\n  * The inliner should inline trivial things at call sites anyway.\n\n  * The Id might be exported.  We could check for that separately,\n    but since we aren't going to postInlineUnconditionally /any/\n    top-level bindings, we don't need to test.\n\nNote [Stable unfoldings and postInlineUnconditionally]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDo not do postInlineUnconditionally if the Id has a stable unfolding,\notherwise we lose the unfolding.  Example\n\n     -- f has stable unfolding with rhs (e |> co)\n     --   where 'e' is big\n     f = e |> co\n\nThen there's a danger we'll optimise to\n\n     f' = e\n     f = f' |> co\n\nand now postInlineUnconditionally, losing the stable unfolding on f.  Now f'\nwon't inline because 'e' is too big.\n\n    c.f. Note [Stable unfoldings and preInlineUnconditionally]\n\n\n************************************************************************\n*                                                                      *\n        Rebuilding a lambda\n*                                                                      *\n************************************************************************\n-}\n\nmkLam :: SimplEnv -> [OutBndr] -> OutExpr -> SimplCont -> SimplM OutExpr\n-- mkLam tries three things\n--      a) eta reduction, if that gives a trivial expression\n--      b) eta expansion [only if there are some value lambdas]\n\nmkLam _env [] body _cont\n  = return body\nmkLam env bndrs body cont\n  = do { dflags <- getDynFlags\n       ; mkLam' dflags bndrs body }\n  where\n    mkLam' :: DynFlags -> [OutBndr] -> OutExpr -> SimplM OutExpr\n    mkLam' dflags bndrs (Cast body co)\n      | not (any bad bndrs)\n        -- Note [Casts and lambdas]\n      = do { lam <- mkLam' dflags bndrs body\n           ; return (mkCast lam (mkPiCos Representational bndrs co)) }\n      where\n        co_vars  = tyCoVarsOfCo co\n        bad bndr = isCoVar bndr && bndr `elemVarSet` co_vars\n\n    mkLam' dflags bndrs body@(Lam {})\n      = mkLam' dflags (bndrs ++ bndrs1) body1\n      where\n        (bndrs1, body1) = collectBinders body\n\n    mkLam' dflags bndrs (Tick t expr)\n      | tickishFloatable t\n      = mkTick t <$> mkLam' dflags bndrs expr\n\n    mkLam' dflags bndrs body\n      | gopt Opt_DoEtaReduction dflags\n      , Just etad_lam <- tryEtaReduce bndrs body\n      = do { tick (EtaReduction (head bndrs))\n           ; return etad_lam }\n\n      | not (contIsRhs cont)   -- See Note [Eta-expanding lambdas]\n      , sm_eta_expand (getMode env)\n      , any isRuntimeVar bndrs\n      , let body_arity = exprEtaExpandArity dflags body\n      , body_arity > 0\n      = do { tick (EtaExpansion (head bndrs))\n           ; let res = mkLams bndrs (etaExpand body_arity body)\n           ; traceSmpl \"eta expand\" (vcat [text \"before\" <+> ppr (mkLams bndrs body)\n                                          , text \"after\" <+> ppr res])\n           ; return res }\n\n      | otherwise\n      = return (mkLams bndrs body)\n\n{-\nNote [Eta expanding lambdas]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn general we *do* want to eta-expand lambdas. Consider\n   f (\\x -> case x of (a,b) -> \\s -> blah)\nwhere 's' is a state token, and hence can be eta expanded.  This\nshowed up in the code for GHc.IO.Handle.Text.hPutChar, a rather\nimportant function!\n\nThe eta-expansion will never happen unless we do it now.  (Well, it's\npossible that CorePrep will do it, but CorePrep only has a half-baked\neta-expander that can't deal with casts.  So it's much better to do it\nhere.)\n\nHowever, when the lambda is let-bound, as the RHS of a let, we have a\nbetter eta-expander (in the form of tryEtaExpandRhs), so we don't\nbother to try expansion in mkLam in that case; hence the contIsRhs\nguard.\n\nNB: We check the SimplEnv (sm_eta_expand), not DynFlags.\n    See Note [No eta expansion in stable unfoldings]\n\nNote [Casts and lambdas]\n~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n        (\\x. (\\y. e) `cast` g1) `cast` g2\nThere is a danger here that the two lambdas look separated, and the\nfull laziness pass might float an expression to between the two.\n\nSo this equation in mkLam' floats the g1 out, thus:\n        (\\x. e `cast` g1)  -->  (\\x.e) `cast` (tx -> g1)\nwhere x:tx.\n\nIn general, this floats casts outside lambdas, where (I hope) they\nmight meet and cancel with some other cast:\n        \\x. e `cast` co   ===>   (\\x. e) `cast` (tx -> co)\n        /\\a. e `cast` co  ===>   (/\\a. e) `cast` (/\\a. co)\n        /\\g. e `cast` co  ===>   (/\\g. e) `cast` (/\\g. co)\n                          (if not (g `in` co))\n\nNotice that it works regardless of 'e'.  Originally it worked only\nif 'e' was itself a lambda, but in some cases that resulted in\nfruitless iteration in the simplifier.  A good example was when\ncompiling Text.ParserCombinators.ReadPrec, where we had a definition\nlike    (\\x. Get `cast` g)\nwhere Get is a constructor with nonzero arity.  Then mkLam eta-expanded\nthe Get, and the next iteration eta-reduced it, and then eta-expanded\nit again.\n\nNote also the side condition for the case of coercion binders.\nIt does not make sense to transform\n        /\\g. e `cast` g  ==>  (/\\g.e) `cast` (/\\g.g)\nbecause the latter is not well-kinded.\n\n************************************************************************\n*                                                                      *\n              Eta expansion\n*                                                                      *\n************************************************************************\n-}\n\ntryEtaExpandRhs :: SimplMode -> OutId -> OutExpr\n                -> SimplM (Arity, Bool, OutExpr)\n-- See Note [Eta-expanding at let bindings]\n-- If tryEtaExpandRhs rhs = (n, is_bot, rhs') then\n--   (a) rhs' has manifest arity\n--   (b) if is_bot is True then rhs' applied to n args is guaranteed bottom\ntryEtaExpandRhs mode bndr rhs\n  | Just join_arity <- isJoinId_maybe bndr\n  = do { let (join_bndrs, join_body) = collectNBinders join_arity rhs\n       ; return (count isId join_bndrs, exprIsBottom join_body, rhs) }\n         -- Note [Do not eta-expand join points]\n         -- But do return the correct arity and bottom-ness, because\n         -- these are used to set the bndr's IdInfo (Trac #15517)\n\n  | otherwise\n  = do { (new_arity, is_bot, new_rhs) <- try_expand\n\n       ; WARN( new_arity < old_id_arity,\n               (text \"Arity decrease:\" <+> (ppr bndr <+> ppr old_id_arity\n                <+> ppr old_arity <+> ppr new_arity) $$ ppr new_rhs) )\n                        -- Note [Arity decrease] in Simplify\n         return (new_arity, is_bot, new_rhs) }\n  where\n    try_expand\n      | exprIsTrivial rhs\n      = return (exprArity rhs, False, rhs)\n\n      | sm_eta_expand mode      -- Provided eta-expansion is on\n      , new_arity > old_arity   -- And the current manifest arity isn't enough\n      = do { tick (EtaExpansion bndr)\n           ; return (new_arity, is_bot, etaExpand new_arity rhs) }\n\n      | otherwise\n      = return (old_arity, is_bot && new_arity == old_arity, rhs)\n\n    dflags       = sm_dflags mode\n    old_arity    = exprArity rhs -- See Note [Do not expand eta-expand PAPs]\n    old_id_arity = idArity bndr\n\n    (new_arity1, is_bot) = findRhsArity dflags bndr rhs old_arity\n    new_arity2 = idCallArity bndr\n    new_arity  = max new_arity1 new_arity2\n\n{-\nNote [Eta-expanding at let bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe now eta expand at let-bindings, which is where the payoff comes.\nThe most significant thing is that we can do a simple arity analysis\n(in CoreArity.findRhsArity), which we can't do for free-floating lambdas\n\nOne useful consequence of not eta-expanding lambdas is this example:\n   genMap :: C a => ...\n   {-# INLINE genMap #-}\n   genMap f xs = ...\n\n   myMap :: D a => ...\n   {-# INLINE myMap #-}\n   myMap = genMap\n\nNotice that 'genMap' should only inline if applied to two arguments.\nIn the stable unfolding for myMap we'll have the unfolding\n    (\\d -> genMap Int (..d..))\nWe do not want to eta-expand to\n    (\\d f xs -> genMap Int (..d..) f xs)\nbecause then 'genMap' will inline, and it really shouldn't: at least\nas far as the programmer is concerned, it's not applied to two\narguments!\n\nNote [Do not eta-expand join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSimilarly to CPR (see Note [Don't CPR join points] in WorkWrap), a join point\nstands well to gain from its outer binding's eta-expansion, and eta-expanding a\njoin point is fraught with issues like how to deal with a cast:\n\n    let join $j1 :: IO ()\n             $j1 = ...\n             $j2 :: Int -> IO ()\n             $j2 n = if n > 0 then $j1\n                              else ...\n\n    =>\n\n    let join $j1 :: IO ()\n             $j1 = (\\eta -> ...)\n                     `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ())\n                                 ~  IO ()\n             $j2 :: Int -> IO ()\n             $j2 n = (\\eta -> if n > 0 then $j1\n                                       else ...)\n                     `cast` N:IO :: State# RealWorld -> (# State# RealWorld, ())\n                                 ~  IO ()\n\nThe cast here can't be pushed inside the lambda (since it's not casting to a\nfunction type), so the lambda has to stay, but it can't because it contains a\nreference to a join point. In fact, $j2 can't be eta-expanded at all. Rather\nthan try and detect this situation (and whatever other situations crop up!), we\ndon't bother; again, any surrounding eta-expansion will improve these join\npoints anyway, since an outer cast can *always* be pushed inside. By the time\nCorePrep comes around, the code is very likely to look more like this:\n\n    let join $j1 :: State# RealWorld -> (# State# RealWorld, ())\n             $j1 = (...) eta\n             $j2 :: Int -> State# RealWorld -> (# State# RealWorld, ())\n             $j2 = if n > 0 then $j1\n                            else (...) eta\n\nNote [Do not eta-expand PAPs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used to have old_arity = manifestArity rhs, which meant that we\nwould eta-expand even PAPs.  But this gives no particular advantage,\nand can lead to a massive blow-up in code size, exhibited by Trac #9020.\nSuppose we have a PAP\n    foo :: IO ()\n    foo = returnIO ()\nThen we can eta-expand do\n    foo = (\\eta. (returnIO () |> sym g) eta) |> g\nwhere\n    g :: IO () ~ State# RealWorld -> (# State# RealWorld, () #)\n\nBut there is really no point in doing this, and it generates masses of\ncoercions and whatnot that eventually disappear again. For T9020, GHC\nallocated 6.6G beore, and 0.8G afterwards; and residency dropped from\n1.8G to 45M.\n\nBut note that this won't eta-expand, say\n  f = \\g -> map g\nDoes it matter not eta-expanding such functions?  I'm not sure.  Perhaps\nstrictness analysis will have less to bite on?\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Floating lets out of big lambdas}\n*                                                                      *\n************************************************************************\n\nNote [Floating and type abstraction]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n        x = /\\a. C e1 e2\nWe'd like to float this to\n        y1 = /\\a. e1\n        y2 = /\\a. e2\n        x  = /\\a. C (y1 a) (y2 a)\nfor the usual reasons: we want to inline x rather vigorously.\n\nYou may think that this kind of thing is rare.  But in some programs it is\ncommon.  For example, if you do closure conversion you might get:\n\n        data a :-> b = forall e. (e -> a -> b) :$ e\n\n        f_cc :: forall a. a :-> a\n        f_cc = /\\a. (\\e. id a) :$ ()\n\nNow we really want to inline that f_cc thing so that the\nconstruction of the closure goes away.\n\nSo I have elaborated simplLazyBind to understand right-hand sides that look\nlike\n        /\\ a1..an. body\n\nand treat them specially. The real work is done in SimplUtils.abstractFloats,\nbut there is quite a bit of plumbing in simplLazyBind as well.\n\nThe same transformation is good when there are lets in the body:\n\n        /\\abc -> let(rec) x = e in b\n   ==>\n        let(rec) x' = /\\abc -> let x = x' a b c in e\n        in\n        /\\abc -> let x = x' a b c in b\n\nThis is good because it can turn things like:\n\n        let f = /\\a -> letrec g = ... g ... in g\ninto\n        letrec g' = /\\a -> ... g' a ...\n        in\n        let f = /\\ a -> g' a\n\nwhich is better.  In effect, it means that big lambdas don't impede\nlet-floating.\n\nThis optimisation is CRUCIAL in eliminating the junk introduced by\ndesugaring mutually recursive definitions.  Don't eliminate it lightly!\n\n[May 1999]  If we do this transformation *regardless* then we can\nend up with some pretty silly stuff.  For example,\n\n        let\n            st = /\\ s -> let { x1=r1 ; x2=r2 } in ...\n        in ..\nbecomes\n        let y1 = /\\s -> r1\n            y2 = /\\s -> r2\n            st = /\\s -> ...[y1 s/x1, y2 s/x2]\n        in ..\n\nUnless the \"...\" is a WHNF there is really no point in doing this.\nIndeed it can make things worse.  Suppose x1 is used strictly,\nand is of the form\n\n        x1* = case f y of { (a,b) -> e }\n\nIf we abstract this wrt the tyvar we then can't do the case inline\nas we would normally do.\n\nThat's why the whole transformation is part of the same process that\nfloats let-bindings and constructor arguments out of RHSs.  In particular,\nit is guarded by the doFloatFromRhs call in simplLazyBind.\n\nNote [Which type variables to abstract over]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAbstract only over the type variables free in the rhs wrt which the\nnew binding is abstracted.  Note that\n\n  * The naive approach of abstracting wrt the\n    tyvars free in the Id's /type/ fails. Consider:\n        /\\ a b -> let t :: (a,b) = (e1, e2)\n                      x :: a     = fst t\n                  in ...\n    Here, b isn't free in x's type, but we must nevertheless\n    abstract wrt b as well, because t's type mentions b.\n    Since t is floated too, we'd end up with the bogus:\n         poly_t = /\\ a b -> (e1, e2)\n         poly_x = /\\ a   -> fst (poly_t a *b*)\n\n  * We must do closeOverKinds.  Example (Trac #10934):\n       f = /\\k (f:k->*) (a:k). let t = AccFailure @ (f a) in ...\n    Here we want to float 't', but we must remember to abstract over\n    'k' as well, even though it is not explicitly mentioned in the RHS,\n    otherwise we get\n       t = /\\ (f:k->*) (a:k). AccFailure @ (f a)\n    which is obviously bogus.\n-}\n\nabstractFloats :: DynFlags -> TopLevelFlag -> [OutTyVar] -> SimplFloats\n              -> OutExpr -> SimplM ([OutBind], OutExpr)\nabstractFloats dflags top_lvl main_tvs floats body\n  = ASSERT( notNull body_floats )\n    ASSERT( isNilOL (sfJoinFloats floats) )\n    do  { (subst, float_binds) <- mapAccumLM abstract empty_subst body_floats\n        ; return (float_binds, CoreSubst.substExpr (text \"abstract_floats1\") subst body) }\n  where\n    is_top_lvl  = isTopLevel top_lvl\n    main_tv_set = mkVarSet main_tvs\n    body_floats = letFloatBinds (sfLetFloats floats)\n    empty_subst = CoreSubst.mkEmptySubst (sfInScope floats)\n\n    abstract :: CoreSubst.Subst -> OutBind -> SimplM (CoreSubst.Subst, OutBind)\n    abstract subst (NonRec id rhs)\n      = do { (poly_id1, poly_app) <- mk_poly1 tvs_here id\n           ; let (poly_id2, poly_rhs) = mk_poly2 poly_id1 tvs_here rhs'\n                 subst' = CoreSubst.extendIdSubst subst id poly_app\n           ; return (subst', NonRec poly_id2 poly_rhs) }\n      where\n        rhs' = CoreSubst.substExpr (text \"abstract_floats2\") subst rhs\n\n        -- tvs_here: see Note [Which type variables to abstract over]\n        tvs_here = scopedSort $\n                   filter (`elemVarSet` main_tv_set) $\n                   closeOverKindsList $\n                   exprSomeFreeVarsList isTyVar rhs'\n\n    abstract subst (Rec prs)\n       = do { (poly_ids, poly_apps) <- mapAndUnzipM (mk_poly1 tvs_here) ids\n            ; let subst' = CoreSubst.extendSubstList subst (ids `zip` poly_apps)\n                  poly_pairs = [ mk_poly2 poly_id tvs_here rhs'\n                               | (poly_id, rhs) <- poly_ids `zip` rhss\n                               , let rhs' = CoreSubst.substExpr (text \"abstract_floats\")\n                                                                subst' rhs ]\n            ; return (subst', Rec poly_pairs) }\n       where\n         (ids,rhss) = unzip prs\n                -- For a recursive group, it's a bit of a pain to work out the minimal\n                -- set of tyvars over which to abstract:\n                --      /\\ a b c.  let x = ...a... in\n                --                 letrec { p = ...x...q...\n                --                          q = .....p...b... } in\n                --                 ...\n                -- Since 'x' is abstracted over 'a', the {p,q} group must be abstracted\n                -- over 'a' (because x is replaced by (poly_x a)) as well as 'b'.\n                -- Since it's a pain, we just use the whole set, which is always safe\n                --\n                -- If you ever want to be more selective, remember this bizarre case too:\n                --      x::a = x\n                -- Here, we must abstract 'x' over 'a'.\n         tvs_here = scopedSort main_tvs\n\n    mk_poly1 :: [TyVar] -> Id -> SimplM (Id, CoreExpr)\n    mk_poly1 tvs_here var\n      = do { uniq <- getUniqueM\n           ; let  poly_name = setNameUnique (idName var) uniq           -- Keep same name\n                  poly_ty   = mkInvForAllTys tvs_here (idType var) -- But new type of course\n                  poly_id   = transferPolyIdInfo var tvs_here $ -- Note [transferPolyIdInfo] in Id.hs\n                              mkLocalIdOrCoVar poly_name poly_ty\n           ; return (poly_id, mkTyApps (Var poly_id) (mkTyVarTys tvs_here)) }\n                -- In the olden days, it was crucial to copy the occInfo of the original var,\n                -- because we were looking at occurrence-analysed but as yet unsimplified code!\n                -- In particular, we mustn't lose the loop breakers.  BUT NOW we are looking\n                -- at already simplified code, so it doesn't matter\n                --\n                -- It's even right to retain single-occurrence or dead-var info:\n                -- Suppose we started with  /\\a -> let x = E in B\n                -- where x occurs once in B. Then we transform to:\n                --      let x' = /\\a -> E in /\\a -> let x* = x' a in B\n                -- where x* has an INLINE prag on it.  Now, once x* is inlined,\n                -- the occurrences of x' will be just the occurrences originally\n                -- pinned on x.\n\n    mk_poly2 :: Id -> [TyVar] -> CoreExpr -> (Id, CoreExpr)\n    mk_poly2 poly_id tvs_here rhs\n      = (poly_id `setIdUnfolding` unf, poly_rhs)\n      where\n        poly_rhs = mkLams tvs_here rhs\n        unf = mkUnfolding dflags InlineRhs is_top_lvl False poly_rhs\n\n        -- We want the unfolding.  Consider\n        --      let\n        --            x = /\\a. let y = ... in Just y\n        --      in body\n        -- Then we float the y-binding out (via abstractFloats and addPolyBind)\n        -- but 'x' may well then be inlined in 'body' in which case we'd like the\n        -- opportunity to inline 'y' too.\n\n{-\nNote [Abstract over coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf a coercion variable (g :: a ~ Int) is free in the RHS, then so is the\ntype variable a.  Rather than sort this mess out, we simply bale out and abstract\nwrt all the type variables if any of them are coercion variables.\n\n\nHistorical note: if you use let-bindings instead of a substitution, beware of this:\n\n                -- Suppose we start with:\n                --\n                --      x = /\\ a -> let g = G in E\n                --\n                -- Then we'll float to get\n                --\n                --      x = let poly_g = /\\ a -> G\n                --          in /\\ a -> let g = poly_g a in E\n                --\n                -- But now the occurrence analyser will see just one occurrence\n                -- of poly_g, not inside a lambda, so the simplifier will\n                -- PreInlineUnconditionally poly_g back into g!  Badk to square 1!\n                -- (I used to think that the \"don't inline lone occurrences\" stuff\n                --  would stop this happening, but since it's the *only* occurrence,\n                --  PreInlineUnconditionally kicks in first!)\n                --\n                -- Solution: put an INLINE note on g's RHS, so that poly_g seems\n                --           to appear many times.  (NB: mkInlineMe eliminates\n                --           such notes on trivial RHSs, so do it manually.)\n\n************************************************************************\n*                                                                      *\n                prepareAlts\n*                                                                      *\n************************************************************************\n\nprepareAlts tries these things:\n\n1.  Eliminate alternatives that cannot match, including the\n    DEFAULT alternative.\n\n2.  If the DEFAULT alternative can match only one possible constructor,\n    then make that constructor explicit.\n    e.g.\n        case e of x { DEFAULT -> rhs }\n     ===>\n        case e of x { (a,b) -> rhs }\n    where the type is a single constructor type.  This gives better code\n    when rhs also scrutinises x or e.\n\n3. Returns a list of the constructors that cannot holds in the\n   DEFAULT alternative (if there is one)\n\nHere \"cannot match\" includes knowledge from GADTs\n\nIt's a good idea to do this stuff before simplifying the alternatives, to\navoid simplifying alternatives we know can't happen, and to come up with\nthe list of constructors that are handled, to put into the IdInfo of the\ncase binder, for use when simplifying the alternatives.\n\nEliminating the default alternative in (1) isn't so obvious, but it can\nhappen:\n\ndata Colour = Red | Green | Blue\n\nf x = case x of\n        Red -> ..\n        Green -> ..\n        DEFAULT -> h x\n\nh y = case y of\n        Blue -> ..\n        DEFAULT -> [ case y of ... ]\n\nIf we inline h into f, the default case of the inlined h can't happen.\nIf we don't notice this, we may end up filtering out *all* the cases\nof the inner case y, which give us nowhere to go!\n-}\n\nprepareAlts :: OutExpr -> OutId -> [InAlt] -> SimplM ([AltCon], [InAlt])\n-- The returned alternatives can be empty, none are possible\nprepareAlts scrut case_bndr' alts\n  | Just (tc, tys) <- splitTyConApp_maybe (varType case_bndr')\n           -- Case binder is needed just for its type. Note that as an\n           --   OutId, it has maximum information; this is important.\n           --   Test simpl013 is an example\n  = do { us <- getUniquesM\n       ; let (idcs1, alts1)       = filterAlts tc tys imposs_cons alts\n             (yes2,  alts2)       = refineDefaultAlt us tc tys idcs1 alts1\n             (yes3, idcs3, alts3) = combineIdenticalAlts idcs1 alts2\n             -- \"idcs\" stands for \"impossible default data constructors\"\n             -- i.e. the constructors that can't match the default case\n       ; when yes2 $ tick (FillInCaseDefault case_bndr')\n       ; when yes3 $ tick (AltMerge case_bndr')\n       ; return (idcs3, alts3) }\n\n  | otherwise  -- Not a data type, so nothing interesting happens\n  = return ([], alts)\n  where\n    imposs_cons = case scrut of\n                    Var v -> otherCons (idUnfolding v)\n                    _     -> []\n\n\n{-\n************************************************************************\n*                                                                      *\n                mkCase\n*                                                                      *\n************************************************************************\n\nmkCase tries these things\n\n* Note [Nerge nested cases]\n* Note [Eliminate identity case]\n* Note [Scrutinee constant folding]\n\nNote [Merge Nested Cases]\n~~~~~~~~~~~~~~~~~~~~~~~~~\n       case e of b {             ==>   case e of b {\n         p1 -> rhs1                      p1 -> rhs1\n         ...                             ...\n         pm -> rhsm                      pm -> rhsm\n         _  -> case b of b' {            pn -> let b'=b in rhsn\n                     pn -> rhsn          ...\n                     ...                 po -> let b'=b in rhso\n                     po -> rhso          _  -> let b'=b in rhsd\n                     _  -> rhsd\n       }\n\nwhich merges two cases in one case when -- the default alternative of\nthe outer case scrutises the same variable as the outer case. This\ntransformation is called Case Merging.  It avoids that the same\nvariable is scrutinised multiple times.\n\nNote [Eliminate Identity Case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        case e of               ===> e\n                True  -> True;\n                False -> False\n\nand similar friends.\n\nNote [Scrutinee Constant Folding]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n     case x op# k# of _ {  ===> case x of _ {\n        a1# -> e1                  (a1# inv_op# k#) -> e1\n        a2# -> e2                  (a2# inv_op# k#) -> e2\n        ...                        ...\n        DEFAULT -> ed              DEFAULT -> ed\n\n     where (x op# k#) inv_op# k# == x\n\nAnd similarly for commuted arguments and for some unary operations.\n\nThe purpose of this transformation is not only to avoid an arithmetic\noperation at runtime but to allow other transformations to apply in cascade.\n\nExample with the \"Merge Nested Cases\" optimization (from #12877):\n\n      main = case t of t0\n         0##     -> ...\n         DEFAULT -> case t0 `minusWord#` 1## of t1\n            0##    -> ...\n            DEFAUT -> case t1 `minusWord#` 1## of t2\n               0##     -> ...\n               DEFAULT -> case t2 `minusWord#` 1## of _\n                  0##     -> ...\n                  DEFAULT -> ...\n\n  becomes:\n\n      main = case t of _\n      0##     -> ...\n      1##     -> ...\n      2##     -> ...\n      3##     -> ...\n      DEFAULT -> ...\n\nThere are some wrinkles\n\n* Do not apply caseRules if there is just a single DEFAULT alternative\n     case e +# 3# of b { DEFAULT -> rhs }\n  If we applied the transformation here we would (stupidly) get\n     case a of b' { DEFAULT -> let b = e +# 3# in rhs }\n  and now the process may repeat, because that let will really\n  be a case.\n\n* The type of the scrutinee might change.  E.g.\n        case tagToEnum (x :: Int#) of (b::Bool)\n          False -> e1\n          True -> e2\n  ==>\n        case x of (b'::Int#)\n          DEFAULT -> e1\n          1#      -> e2\n\n* The case binder may be used in the right hand sides, so we need\n  to make a local binding for it, if it is alive.  e.g.\n         case e +# 10# of b\n           DEFAULT -> blah...b...\n           44#     -> blah2...b...\n  ===>\n         case e of b'\n           DEFAULT -> let b = b' +# 10# in blah...b...\n           34#     -> let b = 44# in blah2...b...\n\n  Note that in the non-DEFAULT cases we know what to bind 'b' to,\n  whereas in the DEFAULT case we must reconstruct the original value.\n  But NB: we use b'; we do not duplicate 'e'.\n\n* In dataToTag we might need to make up some fake binders;\n  see Note [caseRules for dataToTag] in PrelRules\n-}\n\nmkCase, mkCase1, mkCase2, mkCase3\n   :: DynFlags\n   -> OutExpr -> OutId\n   -> OutType -> [OutAlt]               -- Alternatives in standard (increasing) order\n   -> SimplM OutExpr\n\n--------------------------------------------------\n--      1. Merge Nested Cases\n--------------------------------------------------\n\nmkCase dflags scrut outer_bndr alts_ty ((DEFAULT, _, deflt_rhs) : outer_alts)\n  | gopt Opt_CaseMerge dflags\n  , (ticks, Case (Var inner_scrut_var) inner_bndr _ inner_alts)\n       <- stripTicksTop tickishFloatable deflt_rhs\n  , inner_scrut_var == outer_bndr\n  = do  { tick (CaseMerge outer_bndr)\n\n        ; let wrap_alt (con, args, rhs) = ASSERT( outer_bndr `notElem` args )\n                                          (con, args, wrap_rhs rhs)\n                -- Simplifier's no-shadowing invariant should ensure\n                -- that outer_bndr is not shadowed by the inner patterns\n              wrap_rhs rhs = Let (NonRec inner_bndr (Var outer_bndr)) rhs\n                -- The let is OK even for unboxed binders,\n\n              wrapped_alts | isDeadBinder inner_bndr = inner_alts\n                           | otherwise               = map wrap_alt inner_alts\n\n              merged_alts = mergeAlts outer_alts wrapped_alts\n                -- NB: mergeAlts gives priority to the left\n                --      case x of\n                --        A -> e1\n                --        DEFAULT -> case x of\n                --                      A -> e2\n                --                      B -> e3\n                -- When we merge, we must ensure that e1 takes\n                -- precedence over e2 as the value for A!\n\n        ; fmap (mkTicks ticks) $\n          mkCase1 dflags scrut outer_bndr alts_ty merged_alts\n        }\n        -- Warning: don't call mkCase recursively!\n        -- Firstly, there's no point, because inner alts have already had\n        -- mkCase applied to them, so they won't have a case in their default\n        -- Secondly, if you do, you get an infinite loop, because the bindCaseBndr\n        -- in munge_rhs may put a case into the DEFAULT branch!\n\nmkCase dflags scrut bndr alts_ty alts = mkCase1 dflags scrut bndr alts_ty alts\n\n--------------------------------------------------\n--      2. Eliminate Identity Case\n--------------------------------------------------\n\nmkCase1 _dflags scrut case_bndr _ alts@((_,_,rhs1) : _)      -- Identity case\n  | all identity_alt alts\n  = do { tick (CaseIdentity case_bndr)\n       ; return (mkTicks ticks $ re_cast scrut rhs1) }\n  where\n    ticks = concatMap (stripTicksT tickishFloatable . thdOf3) (tail alts)\n    identity_alt (con, args, rhs) = check_eq rhs con args\n\n    check_eq (Cast rhs co) con args        -- See Note [RHS casts]\n      = not (any (`elemVarSet` tyCoVarsOfCo co) args) && check_eq rhs con args\n    check_eq (Tick t e) alt args\n      = tickishFloatable t && check_eq e alt args\n\n    check_eq (Lit lit) (LitAlt lit') _     = lit == lit'\n    check_eq (Var v) _ _  | v == case_bndr = True\n    check_eq (Var v)   (DataAlt con) args\n      | null arg_tys, null args            = v == dataConWorkId con\n                                             -- Optimisation only\n    check_eq rhs        (DataAlt con) args = cheapEqExpr' tickishFloatable rhs $\n                                             mkConApp2 con arg_tys args\n    check_eq _          _             _    = False\n\n    arg_tys = tyConAppArgs (idType case_bndr)\n\n        -- Note [RHS casts]\n        -- ~~~~~~~~~~~~~~~~\n        -- We've seen this:\n        --      case e of x { _ -> x `cast` c }\n        -- And we definitely want to eliminate this case, to give\n        --      e `cast` c\n        -- So we throw away the cast from the RHS, and reconstruct\n        -- it at the other end.  All the RHS casts must be the same\n        -- if (all identity_alt alts) holds.\n        --\n        -- Don't worry about nested casts, because the simplifier combines them\n\n    re_cast scrut (Cast rhs co) = Cast (re_cast scrut rhs) co\n    re_cast scrut _             = scrut\n\nmkCase1 dflags scrut bndr alts_ty alts = mkCase2 dflags scrut bndr alts_ty alts\n\n--------------------------------------------------\n--      2. Scrutinee Constant Folding\n--------------------------------------------------\n\nmkCase2 dflags scrut bndr alts_ty alts\n  | -- See Note [Scrutinee Constant Folding]\n    case alts of  -- Not if there is just a DEFAULT alternative\n      [(DEFAULT,_,_)] -> False\n      _               -> True\n  , gopt Opt_CaseFolding dflags\n  , Just (scrut', tx_con, mk_orig) <- caseRules dflags scrut\n  = do { bndr' <- newId (fsLit \"lwild\") (exprType scrut')\n\n       ; alts' <- mapMaybeM (tx_alt tx_con mk_orig bndr') alts\n                  -- mapMaybeM: discard unreachable alternatives\n                  -- See Note [Unreachable caseRules alternatives]\n                  -- in PrelRules\n\n       ; mkCase3 dflags scrut' bndr' alts_ty $\n         add_default (re_sort alts')\n       }\n\n  | otherwise\n  = mkCase3 dflags scrut bndr alts_ty alts\n  where\n    -- We need to keep the correct association between the scrutinee and its\n    -- binder if the latter isn't dead. Hence we wrap rhs of alternatives with\n    -- \"let bndr = ... in\":\n    --\n    --     case v + 10 of y        =====> case v of y\n    --        20      -> e1                 10      -> let y = 20     in e1\n    --        DEFAULT -> e2                 DEFAULT -> let y = v + 10 in e2\n    --\n    -- Other transformations give: =====> case v of y'\n    --                                      10      -> let y = 20      in e1\n    --                                      DEFAULT -> let y = y' + 10 in e2\n    --\n    -- This wrapping is done in tx_alt; we use mk_orig, returned by caseRules,\n    -- to construct an expression equivalent to the original one, for use\n    -- in the DEFAULT case\n\n    tx_alt :: (AltCon -> Maybe AltCon) -> (Id -> CoreExpr) -> Id\n           -> CoreAlt -> SimplM (Maybe CoreAlt)\n    tx_alt tx_con mk_orig new_bndr (con, bs, rhs)\n      = case tx_con con of\n          Nothing   -> return Nothing\n          Just con' -> do { bs' <- mk_new_bndrs new_bndr con'\n                          ; return (Just (con', bs', rhs')) }\n      where\n        rhs' | isDeadBinder bndr = rhs\n             | otherwise         = bindNonRec bndr orig_val rhs\n\n        orig_val = case con of\n                      DEFAULT    -> mk_orig new_bndr\n                      LitAlt l   -> Lit l\n                      DataAlt dc -> mkConApp2 dc (tyConAppArgs (idType bndr)) bs\n\n    mk_new_bndrs new_bndr (DataAlt dc)\n      | not (isNullaryRepDataCon dc)\n      = -- For non-nullary data cons we must invent some fake binders\n        -- See Note [caseRules for dataToTag] in PrelRules\n        do { us <- getUniquesM\n           ; let (ex_tvs, arg_ids) = dataConRepInstPat us dc\n                                        (tyConAppArgs (idType new_bndr))\n           ; return (ex_tvs ++ arg_ids) }\n    mk_new_bndrs _ _ = return []\n\n    re_sort :: [CoreAlt] -> [CoreAlt]  -- Re-sort the alternatives to\n    re_sort alts = sortBy cmpAlt alts  -- preserve the #case_invariants#\n\n    add_default :: [CoreAlt] -> [CoreAlt]\n    -- See Note [Literal cases]\n    add_default ((LitAlt {}, bs, rhs) : alts) = (DEFAULT, bs, rhs) : alts\n    add_default alts                          = alts\n\n{- Note [Literal cases]\n~~~~~~~~~~~~~~~~~~~~~~~\nIf we have\n  case tagToEnum (a ># b) of\n     False -> e1\n     True  -> e2\n\nthen caseRules for TagToEnum will turn it into\n  case tagToEnum (a ># b) of\n     0# -> e1\n     1# -> e2\n\nSince the case is exhaustive (all cases are) we can convert it to\n  case tagToEnum (a ># b) of\n     DEFAULT -> e1\n     1#      -> e2\n\nThis may generate sligthtly better code (although it should not, since\nall cases are exhaustive) and/or optimise better.  I'm not certain that\nit's necessary, but currenty we do make this change.  We do it here,\nNOT in the TagToEnum rules (see \"Beware\" in Note [caseRules for tagToEnum]\nin PrelRules)\n-}\n\n--------------------------------------------------\n--      Catch-all\n--------------------------------------------------\nmkCase3 _dflags scrut bndr alts_ty alts\n  = return (Case scrut bndr alts_ty alts)\n\n-- See Note [Exitification] and Note [Do not inline exit join points] in Exitify.hs\n-- This lives here (and not in Id) because occurrence info is only valid on\n-- InIds, so it's crucial that isExitJoinId is only called on freshly\n-- occ-analysed code. It's not a generic function you can call anywhere.\nisExitJoinId :: Var -> Bool\nisExitJoinId id = isJoinId id && isOneOcc (idOccInfo id) && occ_in_lam (idOccInfo id)\n\n{-\nNote [Dead binders]\n~~~~~~~~~~~~~~~~~~~~\nNote that dead-ness is maintained by the simplifier, so that it is\naccurate after simplification as well as before.\n\n\nNote [Cascading case merge]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCase merging should cascade in one sweep, because it\nhappens bottom-up\n\n      case e of a {\n        DEFAULT -> case a of b\n                      DEFAULT -> case b of c {\n                                     DEFAULT -> e\n                                     A -> ea\n                      B -> eb\n        C -> ec\n==>\n      case e of a {\n        DEFAULT -> case a of b\n                      DEFAULT -> let c = b in e\n                      A -> let c = b in ea\n                      B -> eb\n        C -> ec\n==>\n      case e of a {\n        DEFAULT -> let b = a in let c = b in e\n        A -> let b = a in let c = b in ea\n        B -> let b = a in eb\n        C -> ec\n\n\nHowever here's a tricky case that we still don't catch, and I don't\nsee how to catch it in one pass:\n\n  case x of c1 { I# a1 ->\n  case a1 of c2 ->\n    0 -> ...\n    DEFAULT -> case x of c3 { I# a2 ->\n               case a2 of ...\n\nAfter occurrence analysis (and its binder-swap) we get this\n\n  case x of c1 { I# a1 ->\n  let x = c1 in         -- Binder-swap addition\n  case a1 of c2 ->\n    0 -> ...\n    DEFAULT -> case x of c3 { I# a2 ->\n               case a2 of ...\n\nWhen we simplify the inner case x, we'll see that\nx=c1=I# a1.  So we'll bind a2 to a1, and get\n\n  case x of c1 { I# a1 ->\n  case a1 of c2 ->\n    0 -> ...\n    DEFAULT -> case a1 of ...\n\nThis is corect, but we can't do a case merge in this sweep\nbecause c2 /= a1.  Reason: the binding c1=I# a1 went inwards\nwithout getting changed to c1=I# c2.\n\nI don't think this is worth fixing, even if I knew how. It'll\nall come out in the next pass anyway.\n-}\n", "num_lines": 2319}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule RepType\n  (\n    -- * Code generator views onto Types\n    UnaryType, NvUnaryType, isNvUnaryType,\n    unwrapType,\n\n    -- * Predicates on types\n    isVoidTy,\n\n    -- * Type representation for the code generator\n    typePrimRep, typePrimRep1,\n    runtimeRepPrimRep, typePrimRepArgs,\n    PrimRep(..), primRepToType,\n    countFunRepArgs, countConRepArgs, tyConPrimRep, tyConPrimRep1,\n\n    -- * Unboxed sum representation type\n    ubxSumRepType, layoutUbxSum, typeSlotTy, SlotTy (..),\n    slotPrimRep, primRepSlot\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BasicTypes (Arity, RepArity)\nimport DataCon\nimport Outputable\nimport PrelNames\nimport Coercion\nimport TyCon\nimport TyCoRep\nimport Type\nimport Util\nimport TysPrim\nimport {-# SOURCE #-} TysWiredIn ( anyTypeOfKind )\n\nimport Data.List (sort)\nimport qualified Data.IntSet as IS\n\n{- **********************************************************************\n*                                                                       *\n                Representation types\n*                                                                       *\n********************************************************************** -}\n\ntype NvUnaryType = Type\ntype UnaryType   = Type\n     -- Both are always a value type; i.e. its kind is TYPE rr\n     -- for some rr; moreover the rr is never a variable.\n     --\n     --   NvUnaryType : never an unboxed tuple or sum, or void\n     --\n     --   UnaryType   : never an unboxed tuple or sum;\n     --                 can be Void# or (# #)\n\nisNvUnaryType :: Type -> Bool\nisNvUnaryType ty\n  | [_] <- typePrimRep ty\n  = True\n  | otherwise\n  = False\n\n-- INVARIANT: the result list is never empty.\ntypePrimRepArgs :: Type -> [PrimRep]\ntypePrimRepArgs ty\n  | [] <- reps\n  = [VoidRep]\n  | otherwise\n  = reps\n  where\n    reps = typePrimRep ty\n\n-- | Gets rid of the stuff that prevents us from understanding the\n-- runtime representation of a type. Including:\n--   1. Casts\n--   2. Newtypes\n--   3. Foralls\n--   4. Synonyms\n-- But not type/data families, because we don't have the envs to hand.\nunwrapType :: Type -> Type\nunwrapType ty\n  | Just (_, unwrapped)\n      <- topNormaliseTypeX stepper mappend inner_ty\n  = unwrapped\n  | otherwise\n  = inner_ty\n  where\n    inner_ty = go ty\n\n    go t | Just t' <- coreView t = go t'\n    go (ForAllTy _ t)            = go t\n    go (CastTy t _)              = go t\n    go t                         = t\n\n     -- cf. Coercion.unwrapNewTypeStepper\n    stepper rec_nts tc tys\n      | Just (ty', _) <- instNewTyCon_maybe tc tys\n      = case checkRecTc rec_nts tc of\n          Just rec_nts' -> NS_Step rec_nts' (go ty') ()\n          Nothing       -> NS_Abort   -- infinite newtypes\n      | otherwise\n      = NS_Done\n\ncountFunRepArgs :: Arity -> Type -> RepArity\ncountFunRepArgs 0 _\n  = 0\ncountFunRepArgs n ty\n  | FunTy _ arg res <- unwrapType ty\n  = length (typePrimRepArgs arg) + countFunRepArgs (n - 1) res\n  | otherwise\n  = pprPanic \"countFunRepArgs: arity greater than type can handle\" (ppr (n, ty, typePrimRep ty))\n\ncountConRepArgs :: DataCon -> RepArity\ncountConRepArgs dc = go (dataConRepArity dc) (dataConRepType dc)\n  where\n    go :: Arity -> Type -> RepArity\n    go 0 _\n      = 0\n    go n ty\n      | FunTy _ arg res <- unwrapType ty\n      = length (typePrimRep arg) + go (n - 1) res\n      | otherwise\n      = pprPanic \"countConRepArgs: arity greater than type can handle\" (ppr (n, ty, typePrimRep ty))\n\n-- | True if the type has zero width.\nisVoidTy :: Type -> Bool\nisVoidTy = null . typePrimRep\n\n\n{- **********************************************************************\n*                                                                       *\n                Unboxed sums\n See Note [Translating unboxed sums to unboxed tuples] in UnariseStg.hs\n*                                                                       *\n********************************************************************** -}\n\ntype SortedSlotTys = [SlotTy]\n\n-- | Given the arguments of a sum type constructor application,\n--   return the unboxed sum rep type.\n--\n-- E.g.\n--\n--   (# Int# | Maybe Int | (# Int#, Float# #) #)\n--\n-- We call `ubxSumRepType [ [IntRep], [LiftedRep], [IntRep, FloatRep] ]`,\n-- which returns [WordSlot, PtrSlot, WordSlot, FloatSlot]\n--\n-- INVARIANT: Result slots are sorted (via Ord SlotTy), except that at the head\n-- of the list we have the slot for the tag.\nubxSumRepType :: [[PrimRep]] -> [SlotTy]\nubxSumRepType constrs0\n  -- These first two cases never classify an actual unboxed sum, which always\n  -- has at least two disjuncts. But it could happen if a user writes, e.g.,\n  -- forall (a :: TYPE (SumRep [IntRep])). ...\n  -- which could never be instantiated. We still don't want to panic.\n  | constrs0 `lengthLessThan` 2\n  = [WordSlot]\n\n  | otherwise\n  = let\n      combine_alts :: [SortedSlotTys]  -- slots of constructors\n                   -> SortedSlotTys    -- final slots\n      combine_alts constrs = foldl' merge [] constrs\n\n      merge :: SortedSlotTys -> SortedSlotTys -> SortedSlotTys\n      merge existing_slots []\n        = existing_slots\n      merge [] needed_slots\n        = needed_slots\n      merge (es : ess) (s : ss)\n        | Just s' <- s `fitsIn` es\n        = -- found a slot, use it\n          s' : merge ess ss\n        | s < es\n        = -- we need a new slot and this is the right place for it\n          s : merge (es : ess) ss\n        | otherwise\n        = -- keep searching for a slot\n          es : merge ess (s : ss)\n\n      -- Nesting unboxed tuples and sums is OK, so we need to flatten first.\n      rep :: [PrimRep] -> SortedSlotTys\n      rep ty = sort (map primRepSlot ty)\n\n      sumRep = WordSlot : combine_alts (map rep constrs0)\n               -- WordSlot: for the tag of the sum\n    in\n      sumRep\n\nlayoutUbxSum :: SortedSlotTys -- Layout of sum. Does not include tag.\n                              -- We assume that they are in increasing order\n             -> [SlotTy]      -- Slot types of things we want to map to locations in the\n                              -- sum layout\n             -> [Int]         -- Where to map 'things' in the sum layout\nlayoutUbxSum sum_slots0 arg_slots0 =\n    go arg_slots0 IS.empty\n  where\n    go :: [SlotTy] -> IS.IntSet -> [Int]\n    go [] _\n      = []\n    go (arg : args) used\n      = let slot_idx = findSlot arg 0 sum_slots0 used\n         in slot_idx : go args (IS.insert slot_idx used)\n\n    findSlot :: SlotTy -> Int -> SortedSlotTys -> IS.IntSet -> Int\n    findSlot arg slot_idx (slot : slots) useds\n      | not (IS.member slot_idx useds)\n      , Just slot == arg `fitsIn` slot\n      = slot_idx\n      | otherwise\n      = findSlot arg (slot_idx + 1) slots useds\n    findSlot _ _ [] _\n      = pprPanic \"findSlot\" (text \"Can't find slot\" $$ ppr sum_slots0 $$ ppr arg_slots0)\n\n--------------------------------------------------------------------------------\n\n-- We have 3 kinds of slots:\n--\n--   - Pointer slot: Only shared between actual pointers to Haskell heap (i.e.\n--     boxed objects)\n--\n--   - Word slots: Shared between IntRep, WordRep, Int64Rep, Word64Rep, AddrRep.\n--\n--   - Float slots: Shared between floating point types.\n--\n--   - Void slots: Shared between void types. Not used in sums.\n--\n-- TODO(michalt): We should probably introduce `SlotTy`s for 8-/16-/32-bit\n-- values, so that we can pack things more tightly.\ndata SlotTy = PtrSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot\n  deriving (Eq, Ord)\n    -- Constructor order is important! If slot A could fit into slot B\n    -- then slot A must occur first.  E.g.  FloatSlot before DoubleSlot\n    --\n    -- We are assuming that WordSlot is smaller than or equal to Word64Slot\n    -- (would not be true on a 128-bit machine)\n\ninstance Outputable SlotTy where\n  ppr PtrSlot    = text \"PtrSlot\"\n  ppr Word64Slot = text \"Word64Slot\"\n  ppr WordSlot   = text \"WordSlot\"\n  ppr DoubleSlot = text \"DoubleSlot\"\n  ppr FloatSlot  = text \"FloatSlot\"\n\ntypeSlotTy :: UnaryType -> Maybe SlotTy\ntypeSlotTy ty\n  | isVoidTy ty\n  = Nothing\n  | otherwise\n  = Just (primRepSlot (typePrimRep1 ty))\n\nprimRepSlot :: PrimRep -> SlotTy\nprimRepSlot VoidRep     = pprPanic \"primRepSlot\" (text \"No slot for VoidRep\")\nprimRepSlot LiftedRep   = PtrSlot\nprimRepSlot UnliftedRep = PtrSlot\nprimRepSlot IntRep      = WordSlot\nprimRepSlot Int8Rep     = WordSlot\nprimRepSlot Int16Rep    = WordSlot\nprimRepSlot Int64Rep    = Word64Slot\nprimRepSlot WordRep     = WordSlot\nprimRepSlot Word8Rep    = WordSlot\nprimRepSlot Word16Rep   = WordSlot\nprimRepSlot Word64Rep   = Word64Slot\nprimRepSlot AddrRep     = WordSlot\nprimRepSlot FloatRep    = FloatSlot\nprimRepSlot DoubleRep   = DoubleSlot\nprimRepSlot VecRep{}    = pprPanic \"primRepSlot\" (text \"No slot for VecRep\")\n\nslotPrimRep :: SlotTy -> PrimRep\nslotPrimRep PtrSlot     = LiftedRep   -- choice between lifted & unlifted seems arbitrary\nslotPrimRep Word64Slot  = Word64Rep\nslotPrimRep WordSlot    = WordRep\nslotPrimRep DoubleSlot  = DoubleRep\nslotPrimRep FloatSlot   = FloatRep\n\n-- | Returns the bigger type if one fits into the other. (commutative)\nfitsIn :: SlotTy -> SlotTy -> Maybe SlotTy\nfitsIn ty1 ty2\n  | isWordSlot ty1 && isWordSlot ty2\n  = Just (max ty1 ty2)\n  | isFloatSlot ty1 && isFloatSlot ty2\n  = Just (max ty1 ty2)\n  | isPtrSlot ty1 && isPtrSlot ty2\n  = Just PtrSlot\n  | otherwise\n  = Nothing\n  where\n    isPtrSlot PtrSlot = True\n    isPtrSlot _       = False\n\n    isWordSlot Word64Slot = True\n    isWordSlot WordSlot   = True\n    isWordSlot _          = False\n\n    isFloatSlot DoubleSlot = True\n    isFloatSlot FloatSlot  = True\n    isFloatSlot _          = False\n\n\n{- **********************************************************************\n*                                                                       *\n                   PrimRep\n*                                                                       *\n********************************************************************** -}\n\n-- | Discovers the primitive representation of a 'Type'. Returns\n-- a list of 'PrimRep': it's a list because of the possibility of\n-- no runtime representation (void) or multiple (unboxed tuple/sum)\ntypePrimRep :: HasDebugCallStack => Type -> [PrimRep]\ntypePrimRep ty = kindPrimRep (text \"typePrimRep\" <+>\n                              parens (ppr ty <+> dcolon <+> ppr (typeKind ty)))\n                             (typeKind ty)\n\n-- | Like 'typePrimRep', but assumes that there is precisely one 'PrimRep' output;\n-- an empty list of PrimReps becomes a VoidRep\ntypePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep\ntypePrimRep1 ty = case typePrimRep ty of\n  []    -> VoidRep\n  [rep] -> rep\n  _     -> pprPanic \"typePrimRep1\" (ppr ty $$ ppr (typePrimRep ty))\n\n-- | Find the runtime representation of a 'TyCon'. Defined here to\n-- avoid module loops. Returns a list of the register shapes necessary.\ntyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep]\ntyConPrimRep tc\n  = kindPrimRep (text \"kindRep tc\" <+> ppr tc $$ ppr res_kind)\n                res_kind\n  where\n    res_kind = tyConResKind tc\n\n-- | Like 'tyConPrimRep', but assumed that there is precisely zero or\n-- one 'PrimRep' output\ntyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep\ntyConPrimRep1 tc = case tyConPrimRep tc of\n  []    -> VoidRep\n  [rep] -> rep\n  _     -> pprPanic \"tyConPrimRep1\" (ppr tc $$ ppr (tyConPrimRep tc))\n\n-- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's\n-- of values of types of this kind.\nkindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep]\nkindPrimRep doc ki\n  | Just ki' <- coreView ki\n  = kindPrimRep doc ki'\nkindPrimRep doc (TyConApp typ [runtime_rep])\n  = ASSERT( typ `hasKey` tYPETyConKey )\n    runtimeRepPrimRep doc runtime_rep\nkindPrimRep doc ki\n  = pprPanic \"kindPrimRep\" (ppr ki $$ doc)\n\n-- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that\n-- it encodes.\nruntimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]\nruntimeRepPrimRep doc rr_ty\n  | Just rr_ty' <- coreView rr_ty\n  = runtimeRepPrimRep doc rr_ty'\n  | TyConApp rr_dc args <- rr_ty\n  , RuntimeRep fun <- tyConRuntimeRepInfo rr_dc\n  = fun args\n  | otherwise\n  = pprPanic \"runtimeRepPrimRep\" (doc $$ ppr rr_ty)\n\n-- | Convert a PrimRep back to a Type. Used only in the unariser to give types\n-- to fresh Ids. Really, only the type's representation matters.\nprimRepToType :: PrimRep -> Type\nprimRepToType = anyTypeOfKind . tYPE . primRepToRuntimeRep\n", "num_lines": 371}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\\section[SimplStg]{Driver for simplifying @STG@ programs}\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule SimplStg ( stg2stg ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport StgSyn\n\nimport StgLint          ( lintStgTopBindings )\nimport StgStats         ( showStgStats )\nimport UnariseStg       ( unarise )\nimport StgCse           ( stgCse )\nimport StgLiftLams      ( stgLiftLams )\nimport Module           ( Module )\n\nimport DynFlags\nimport ErrUtils\nimport UniqSupply\nimport Outputable\nimport Control.Monad\nimport Control.Monad.IO.Class\nimport Control.Monad.Trans.State.Strict\n\nnewtype StgM a = StgM { _unStgM :: StateT UniqSupply IO a }\n  deriving (Functor, Applicative, Monad, MonadIO)\n\ninstance MonadUnique StgM where\n  getUniqueSupplyM = StgM (state splitUniqSupply)\n  getUniqueM = StgM (state takeUniqFromSupply)\n\nrunStgM :: UniqSupply -> StgM a -> IO a\nrunStgM us (StgM m) = evalStateT m us\n\nstg2stg :: DynFlags                  -- includes spec of what stg-to-stg passes to do\n        -> Module                    -- module being compiled\n        -> [StgTopBinding]           -- input program\n        -> IO [StgTopBinding]        -- output program\n\nstg2stg dflags this_mod binds\n  = do  { showPass dflags \"Stg2Stg\"\n        ; us <- mkSplitUniqSupply 'g'\n\n        -- Do the main business!\n        ; binds' <- runStgM us $\n            foldM do_stg_pass binds (getStgToDo dflags)\n\n        ; dump_when Opt_D_dump_stg \"STG syntax:\" binds'\n\n        ; return binds'\n   }\n\n  where\n    stg_linter what\n      | gopt Opt_DoStgLinting dflags\n      = lintStgTopBindings dflags this_mod what\n      | otherwise\n      = \\ _whodunnit _binds -> return ()\n\n    -------------------------------------------\n    do_stg_pass :: [StgTopBinding] -> StgToDo -> StgM [StgTopBinding]\n    do_stg_pass binds to_do\n      = case to_do of\n          StgDoNothing ->\n            return binds\n\n          StgStats ->\n            trace (showStgStats binds) (return binds)\n\n          StgCSE -> do\n            let binds' = {-# SCC \"StgCse\" #-} stgCse binds\n            end_pass \"StgCse\" binds'\n\n          StgLiftLams -> do\n            us <- getUniqueSupplyM\n            let binds' = {-# SCC \"StgLiftLams\" #-} stgLiftLams dflags us binds\n            end_pass \"StgLiftLams\" binds'\n\n          StgUnarise -> do\n            liftIO (dump_when Opt_D_dump_stg \"Pre unarise:\" binds)\n            us <- getUniqueSupplyM\n            liftIO (stg_linter False \"Pre-unarise\" binds)\n            let binds' = unarise us binds\n            liftIO (stg_linter True \"Unarise\" binds')\n            return binds'\n\n    dump_when flag header binds\n      = dumpIfSet_dyn dflags flag header (pprStgTopBindings binds)\n\n    end_pass what binds2\n      = liftIO $ do -- report verbosely, if required\n          dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what\n            (vcat (map ppr binds2))\n          stg_linter False what binds2\n          return binds2\n\n-- -----------------------------------------------------------------------------\n-- StgToDo:  abstraction of stg-to-stg passes to run.\n\n-- | Optional Stg-to-Stg passes.\ndata StgToDo\n  = StgCSE\n  -- ^ Common subexpression elimination\n  | StgLiftLams\n  -- ^ Lambda lifting closure variables, trading stack/register allocation for\n  -- heap allocation\n  | StgStats\n  | StgUnarise\n  -- ^ Mandatory unarise pass, desugaring unboxed tuple and sum binders\n  | StgDoNothing\n  -- ^ Useful for building up 'getStgToDo'\n  deriving Eq\n\n-- | Which Stg-to-Stg passes to run. Depends on flags, ways etc.\ngetStgToDo :: DynFlags -> [StgToDo]\ngetStgToDo dflags =\n  filter (/= StgDoNothing)\n    [ mandatory StgUnarise\n    -- Important that unarisation comes first\n    -- See Note [StgCse after unarisation] in StgCse\n    , optional Opt_StgCSE StgCSE\n    , optional Opt_StgLiftLams StgLiftLams\n    , optional Opt_StgStats StgStats\n    ] where\n      optional opt = runWhen (gopt opt dflags)\n      mandatory = id\n\nrunWhen :: Bool -> StgToDo -> StgToDo\nrunWhen True todo = todo\nrunWhen _    _    = StgDoNothing\n", "num_lines": 141}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n{-|\nNote [CSE for Stg]\n~~~~~~~~~~~~~~~~~~\nThis module implements a simple common subexpression elimination pass for STG.\nThis is useful because there are expressions that we want to common up (because\nthey are operationally equivalent), but that we cannot common up in Core, because\ntheir types differ.\nThis was originally reported as #9291.\n\nThere are two types of common code occurrences that we aim for, see\nnote [Case 1: CSEing allocated closures] and\nnote [Case 2: CSEing case binders] below.\n\n\nNote [Case 1: CSEing allocated closures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe first kind of CSE opportunity we aim for is generated by this Haskell code:\n\n    bar :: a -> (Either Int a, Either Bool a)\n    bar x = (Right x, Right x)\n\nwhich produces this Core:\n\n    bar :: forall a. a -> (Either Int a, Either Bool a)\n    bar @a x = (Right @Int @a x, Right @Bool @a x)\n\nwhere the two components of the tuple are different terms, and cannot be\ncommoned up (easily). On the STG level we have\n\n    bar [x] = let c1 = Right [x]\n                  c2 = Right [x]\n              in (c1,c2)\n\nand now it is obvious that we can write\n\n    bar [x] = let c1 = Right [x]\n              in (c1,c1)\n\ninstead.\n\n\nNote [Case 2: CSEing case binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe second kind of CSE opportunity we aim for is more interesting, and\ncame up in #9291 and #5344: The Haskell code\n\n    foo :: Either Int a -> Either Bool a\n    foo (Right x) = Right x\n    foo _         = Left False\n\nproduces this Core\n\n    foo :: forall a. Either Int a -> Either Bool a\n    foo @a e = case e of b { Left n -> \u00e2\u20ac\u00a6\n                           , Right x -> Right @Bool @a x }\n\nwhere we cannot CSE `Right @Bool @a x` with the case binder `b` as they have\ndifferent types. But in STG we have\n\n    foo [e] = case e of b { Left [n] -> \u00e2\u20ac\u00a6\n                          , Right [x] -> Right [x] }\n\nand nothing stops us from transforming that to\n\n    foo [e] = case e of b { Left [n] -> \u00e2\u20ac\u00a6\n                          , Right [x] -> b}\n\n\nNote [StgCse after unarisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider two unboxed sum terms:\n\n    (# 1 | #) :: (# Int | Int# #)\n    (# 1 | #) :: (# Int | Int  #)\n\nThese two terms are not equal as they unarise to different unboxed\ntuples. However if we run StgCse before Unarise, it'll think the two\nterms (# 1 | #) are equal, and replace one of these with a binder to\nthe other. That's bad -- Trac #15300.\n\nSolution: do unarise first.\n\n-}\n\nmodule StgCse (stgCse) where\n\nimport GhcPrelude\n\nimport DataCon\nimport Id\nimport StgSyn\nimport Outputable\nimport VarEnv\nimport CoreSyn (AltCon(..))\nimport Data.List (mapAccumL)\nimport Data.Maybe (fromMaybe)\nimport CoreMap\nimport NameEnv\nimport Control.Monad( (>=>) )\n\n--------------\n-- The Trie --\n--------------\n\n-- A lookup trie for data constructor applications, i.e.\n-- keys of type `(DataCon, [StgArg])`, following the patterns in TrieMap.\n\ndata StgArgMap a = SAM\n    { sam_var :: DVarEnv a\n    , sam_lit :: LiteralMap a\n    }\n\ninstance TrieMap StgArgMap where\n    type Key StgArgMap = StgArg\n    emptyTM  = SAM { sam_var = emptyTM\n                   , sam_lit = emptyTM }\n    lookupTM (StgVarArg var) = sam_var >.> lkDFreeVar var\n    lookupTM (StgLitArg lit) = sam_lit >.> lookupTM lit\n    alterTM  (StgVarArg var) f m = m { sam_var = sam_var m |> xtDFreeVar var f }\n    alterTM  (StgLitArg lit) f m = m { sam_lit = sam_lit m |> alterTM lit f }\n    foldTM k m = foldTM k (sam_var m) . foldTM k (sam_lit m)\n    mapTM f (SAM {sam_var = varm, sam_lit = litm}) =\n        SAM { sam_var = mapTM f varm, sam_lit = mapTM f litm }\n\nnewtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) }\n\ninstance TrieMap ConAppMap where\n    type Key ConAppMap = (DataCon, [StgArg])\n    emptyTM  = CAM emptyTM\n    lookupTM (dataCon, args) = un_cam >.> lkDNamed dataCon >=> lookupTM args\n    alterTM  (dataCon, args) f m =\n        m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f }\n    foldTM k = un_cam >.> foldTM (foldTM k)\n    mapTM f  = un_cam >.> mapTM (mapTM f) >.> CAM\n\n-----------------\n-- The CSE Env --\n-----------------\n\n-- | The CSE environment. See note [CseEnv Example]\ndata CseEnv = CseEnv\n    { ce_conAppMap :: ConAppMap OutId\n        -- ^ The main component of the environment is the trie that maps\n        --   data constructor applications (with their `OutId` arguments)\n        --   to an in-scope name that can be used instead.\n        --   This name is always either a let-bound variable or a case binder.\n    , ce_subst     :: IdEnv OutId\n        -- ^ This substitution is applied to the code as we traverse it.\n        --   Entries have one of two reasons:\n        --\n        --   * The input might have shadowing (see Note [Shadowing]), so we have\n        --     to rename some binders as we traverse the tree.\n        --   * If we remove `let x = Con z` because  `let y = Con z` is in scope,\n        --     we note this here as x \u00e2\u2020\u00a6 y.\n    , ce_bndrMap     :: IdEnv OutId\n        -- ^ If we come across a case expression case x as b of \u00e2\u20ac\u00a6 with a trivial\n        --   binder, we add b \u00e2\u2020\u00a6 x to this.\n        --   This map is *only* used when looking something up in the ce_conAppMap.\n        --   See Note [Trivial case scrutinee]\n    , ce_in_scope  :: InScopeSet\n        -- ^ The third component is an in-scope set, to rename away any\n        --   shadowing binders\n    }\n\n{-|\nNote [CseEnv Example]\n~~~~~~~~~~~~~~~~~~~~~\nThe following tables shows how the CseEnvironment changes as code is traversed,\nas well as the changes to that code.\n\n  InExpr                         OutExpr\n     conAppMap                   subst          in_scope\n  \u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\u00e2\u201d\u20ac\n  -- empty                       {}             {}\n  case \u00e2\u20ac\u00a6 as a of {Con x y ->     case \u00e2\u20ac\u00a6 as a of {Con x y ->\n  -- Con x y \u00e2\u2020\u00a6 a                 {}             {a,x,y}\n  let b = Con x y                (removed)\n  -- Con x y \u00e2\u2020\u00a6 a                 b\u00e2\u2020\u00a6a            {a,x,y,b}\n  let c = Bar a                  let c = Bar a\n  -- Con x y \u00e2\u2020\u00a6 a, Bar a \u00e2\u2020\u00a6 c      b\u00e2\u2020\u00a6a            {a,x,y,b,c}\n  let c = some expression        let c' = some expression\n  -- Con x y \u00e2\u2020\u00a6 a, Bar a \u00e2\u2020\u00a6 c      b\u00e2\u2020\u00a6a, c\u00e2\u2020\u00a6c',     {a,x,y,b,c,c'}\n  let d = Bar b                  (removed)\n  -- Con x y \u00e2\u2020\u00a6 a, Bar a \u00e2\u2020\u00a6 c      b\u00e2\u2020\u00a6a, c\u00e2\u2020\u00a6c', d\u00e2\u2020\u00a6c {a,x,y,b,c,c',d}\n  (a, b, c d)                    (a, a, c' c)\n-}\n\ninitEnv :: InScopeSet -> CseEnv\ninitEnv in_scope = CseEnv\n    { ce_conAppMap = emptyTM\n    , ce_subst     = emptyVarEnv\n    , ce_bndrMap   = emptyVarEnv\n    , ce_in_scope  = in_scope\n    }\n\nenvLookup :: DataCon -> [OutStgArg] -> CseEnv -> Maybe OutId\nenvLookup dataCon args env = lookupTM (dataCon, args') (ce_conAppMap env)\n  where args' = map go args -- See Note [Trivial case scrutinee]\n        go (StgVarArg v  ) = StgVarArg (fromMaybe v $ lookupVarEnv (ce_bndrMap env) v)\n        go (StgLitArg lit) = StgLitArg lit\n\naddDataCon :: OutId -> DataCon -> [OutStgArg] -> CseEnv -> CseEnv\n-- do not bother with nullary data constructors, they are static anyways\naddDataCon _ _ [] env = env\naddDataCon bndr dataCon args env = env { ce_conAppMap = new_env }\n  where\n    new_env = insertTM (dataCon, args) bndr (ce_conAppMap env)\n\nforgetCse :: CseEnv -> CseEnv\nforgetCse env = env { ce_conAppMap = emptyTM }\n    -- See note [Free variables of an StgClosure]\n\naddSubst :: OutId -> OutId -> CseEnv -> CseEnv\naddSubst from to env\n    = env { ce_subst = extendVarEnv (ce_subst env) from to }\n\naddTrivCaseBndr :: OutId -> OutId -> CseEnv -> CseEnv\naddTrivCaseBndr from to env\n    = env { ce_bndrMap = extendVarEnv (ce_bndrMap env) from to }\n\nsubstArgs :: CseEnv -> [InStgArg] -> [OutStgArg]\nsubstArgs env = map (substArg env)\n\nsubstArg :: CseEnv -> InStgArg -> OutStgArg\nsubstArg env (StgVarArg from) = StgVarArg (substVar env from)\nsubstArg _   (StgLitArg lit)  = StgLitArg lit\n\nsubstVar :: CseEnv -> InId -> OutId\nsubstVar env id = fromMaybe id $ lookupVarEnv (ce_subst env) id\n\n-- Functions to enter binders\n\n-- This is much simpler than the equivalent code in CoreSubst:\n--  * We do not substitute type variables, and\n--  * There is nothing relevant in IdInfo at this stage\n--    that needs substitutions.\n-- Therefore, no special treatment for a recursive group is required.\n\nsubstBndr :: CseEnv -> InId -> (CseEnv, OutId)\nsubstBndr env old_id\n  = (new_env, new_id)\n  where\n    new_id = uniqAway (ce_in_scope env) old_id\n    no_change = new_id == old_id\n    env' = env { ce_in_scope = ce_in_scope env `extendInScopeSet` new_id }\n    new_env | no_change = env' { ce_subst = extendVarEnv (ce_subst env) old_id new_id }\n            | otherwise = env'\n\nsubstBndrs :: CseEnv -> [InVar] -> (CseEnv, [OutVar])\nsubstBndrs env bndrs = mapAccumL substBndr env bndrs\n\nsubstPairs :: CseEnv -> [(InVar, a)] -> (CseEnv, [(OutVar, a)])\nsubstPairs env bndrs = mapAccumL go env bndrs\n  where go env (id, x) = let (env', id') = substBndr env id\n                         in (env', (id', x))\n\n-- Main entry point\n\nstgCse :: [InStgTopBinding] -> [OutStgTopBinding]\nstgCse binds = snd $ mapAccumL stgCseTopLvl emptyInScopeSet binds\n\n-- Top level bindings.\n--\n-- We do not CSE these, as top-level closures are allocated statically anyways.\n-- Also, they might be exported.\n-- But we still have to collect the set of in-scope variables, otherwise\n-- uniqAway might shadow a top-level closure.\n\nstgCseTopLvl :: InScopeSet -> InStgTopBinding -> (InScopeSet, OutStgTopBinding)\nstgCseTopLvl in_scope t@(StgTopStringLit _ _) = (in_scope, t)\nstgCseTopLvl in_scope (StgTopLifted (StgNonRec bndr rhs))\n    = (in_scope'\n      , StgTopLifted (StgNonRec bndr (stgCseTopLvlRhs in_scope rhs)))\n  where in_scope' = in_scope `extendInScopeSet` bndr\n\nstgCseTopLvl in_scope (StgTopLifted (StgRec eqs))\n    = ( in_scope'\n      , StgTopLifted (StgRec [ (bndr, stgCseTopLvlRhs in_scope' rhs) | (bndr, rhs) <- eqs ]))\n  where in_scope' = in_scope `extendInScopeSetList` [ bndr | (bndr, _) <- eqs ]\n\nstgCseTopLvlRhs :: InScopeSet -> InStgRhs -> OutStgRhs\nstgCseTopLvlRhs in_scope (StgRhsClosure ext ccs upd args body)\n    = let body' = stgCseExpr (initEnv in_scope) body\n      in  StgRhsClosure ext ccs upd args body'\nstgCseTopLvlRhs _ (StgRhsCon ccs dataCon args)\n    = StgRhsCon ccs dataCon args\n\n------------------------------\n-- The actual AST traversal --\n------------------------------\n\n-- Trivial cases\nstgCseExpr :: CseEnv -> InStgExpr -> OutStgExpr\nstgCseExpr env (StgApp fun args)\n    = StgApp fun' args'\n  where fun' = substVar env fun\n        args' = substArgs env args\nstgCseExpr _ (StgLit lit)\n    = StgLit lit\nstgCseExpr env (StgOpApp op args tys)\n    = StgOpApp op args' tys\n  where args' = substArgs env args\nstgCseExpr _ (StgLam _ _)\n    = pprPanic \"stgCseExp\" (text \"StgLam\")\nstgCseExpr env (StgTick tick body)\n    = let body' = stgCseExpr env body\n      in StgTick tick body'\nstgCseExpr env (StgCase scrut bndr ty alts)\n    = mkStgCase scrut' bndr' ty alts'\n  where\n    scrut' = stgCseExpr env scrut\n    (env1, bndr') = substBndr env bndr\n    env2 | StgApp trivial_scrut [] <- scrut' = addTrivCaseBndr bndr trivial_scrut env1\n                 -- See Note [Trivial case scrutinee]\n         | otherwise                         = env1\n    alts' = map (stgCseAlt env2 ty bndr') alts\n\n\n-- A constructor application.\n-- To be removed by a variable use when found in the CSE environment\nstgCseExpr env (StgConApp dataCon args tys)\n    | Just bndr' <- envLookup dataCon args' env\n    = StgApp bndr' []\n    | otherwise\n    = StgConApp dataCon args' tys\n  where args' = substArgs env args\n\n-- Let bindings\n-- The binding might be removed due to CSE (we do not want trivial bindings on\n-- the STG level), so use the smart constructor `mkStgLet` to remove the binding\n-- if empty.\nstgCseExpr env (StgLet ext binds body)\n    = let (binds', env') = stgCseBind env binds\n          body' = stgCseExpr env' body\n      in mkStgLet (StgLet ext) binds' body'\nstgCseExpr env (StgLetNoEscape ext binds body)\n    = let (binds', env') = stgCseBind env binds\n          body' = stgCseExpr env' body\n      in mkStgLet (StgLetNoEscape ext) binds' body'\n\n-- Case alternatives\n-- Extend the CSE environment\nstgCseAlt :: CseEnv -> AltType -> OutId -> InStgAlt -> OutStgAlt\nstgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs)\n    = let (env1, args') = substBndrs env args\n          env2\n            -- To avoid dealing with unboxed sums StgCse runs after unarise and\n            -- should maintain invariants listed in Note [Post-unarisation\n            -- invariants]. One of the invariants is that some binders are not\n            -- used (unboxed tuple case binders) which is what we check with\n            -- `stgCaseBndrInScope` here. If the case binder is not in scope we\n            -- don't add it to the CSE env. See also #15300.\n            | stgCaseBndrInScope ty True -- CSE runs after unarise\n            = addDataCon case_bndr dataCon (map StgVarArg args') env1\n            | otherwise\n            = env1\n            -- see note [Case 2: CSEing case binders]\n          rhs' = stgCseExpr env2 rhs\n      in (DataAlt dataCon, args', rhs')\nstgCseAlt env _ _ (altCon, args, rhs)\n    = let (env1, args') = substBndrs env args\n          rhs' = stgCseExpr env1 rhs\n      in (altCon, args', rhs')\n\n-- Bindings\nstgCseBind :: CseEnv -> InStgBinding -> (Maybe OutStgBinding, CseEnv)\nstgCseBind env (StgNonRec b e)\n    = let (env1, b') = substBndr env b\n      in case stgCseRhs env1 b' e of\n        (Nothing,      env2) -> (Nothing,                env2)\n        (Just (b2,e'), env2) -> (Just (StgNonRec b2 e'), env2)\nstgCseBind env (StgRec pairs)\n    = let (env1, pairs1) = substPairs env pairs\n      in case stgCsePairs env1 pairs1 of\n        ([],     env2) -> (Nothing, env2)\n        (pairs2, env2) -> (Just (StgRec pairs2), env2)\n\nstgCsePairs :: CseEnv -> [(OutId, InStgRhs)] -> ([(OutId, OutStgRhs)], CseEnv)\nstgCsePairs env [] = ([], env)\nstgCsePairs env0 ((b,e):pairs)\n  = let (pairMB, env1) = stgCseRhs env0 b e\n        (pairs', env2) = stgCsePairs env1 pairs\n    in (pairMB `mbCons` pairs', env2)\n  where\n    mbCons = maybe id (:)\n\n-- The RHS of a binding.\n-- If it is a constructor application, either short-cut it or extend the environment\nstgCseRhs :: CseEnv -> OutId -> InStgRhs -> (Maybe (OutId, OutStgRhs), CseEnv)\nstgCseRhs env bndr (StgRhsCon ccs dataCon args)\n    | Just other_bndr <- envLookup dataCon args' env\n    = let env' = addSubst bndr other_bndr env\n      in (Nothing, env')\n    | otherwise\n    = let env' = addDataCon bndr dataCon args' env\n            -- see note [Case 1: CSEing allocated closures]\n          pair = (bndr, StgRhsCon ccs dataCon args')\n      in (Just pair, env')\n  where args' = substArgs env args\nstgCseRhs env bndr (StgRhsClosure ext ccs upd args body)\n    = let (env1, args') = substBndrs env args\n          env2 = forgetCse env1 -- See note [Free variables of an StgClosure]\n          body' = stgCseExpr env2 body\n      in (Just (substVar env bndr, StgRhsClosure ext ccs upd args' body'), env)\n\n\nmkStgCase :: StgExpr -> OutId -> AltType -> [StgAlt] -> StgExpr\nmkStgCase scrut bndr ty alts | all isBndr alts = scrut\n                             | otherwise       = StgCase scrut bndr ty alts\n\n  where\n    -- see Note [All alternatives are the binder]\n    isBndr (_, _, StgApp f []) = f == bndr\n    isBndr _                   = False\n\n\n-- Utilities\n\n-- | This function short-cuts let-bindings that are now obsolete\nmkStgLet :: (a -> b -> b) -> Maybe a -> b -> b\nmkStgLet _      Nothing      body = body\nmkStgLet stgLet (Just binds) body = stgLet binds body\n\n\n{-\nNote [All alternatives are the binder]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen all alternatives simply refer to the case binder, then we do not have\nto bother with the case expression at all (#13588). CoreSTG does this as well,\nbut sometimes, types get into the way:\n\n    newtype T = MkT Int\n    f :: (Int, Int) -> (T, Int)\n    f (x, y) = (MkT x, y)\n\nCore cannot just turn this into\n\n    f p = p\n\nas this would not be well-typed. But to STG, where MkT is no longer in the way,\nwe can.\n\nNote [Trivial case scrutinee]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to be able to handle nested reconstruction of constructors as in\n\n    nested :: Either Int (Either Int a) -> Either Bool (Either Bool a)\n    nested (Right (Right v)) = Right (Right v)\n    nested _ = Left True\n\nSo if we come across\n\n    case x of r1\n      Right a -> case a of r2\n              Right b -> let v = Right b\n                         in Right v\n\nwe first replace v with r2. Next we want to replace Right r2 with r1. But the\nce_conAppMap contains Right a!\n\nTherefore, we add r1 \u00e2\u2020\u00a6 x to ce_bndrMap when analysing the outer case, and use\nthis substitution before looking Right r2 up in ce_conAppMap, and everything\nworks out.\n\nNote [Free variables of an StgClosure]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nStgClosures (function and thunks) have an explicit list of free variables:\n\nfoo [x] =\n    let not_a_free_var = Left [x]\n    let a_free_var = Right [x]\n    let closure = \\[x a_free_var] -> \\[y] -> bar y (Left [x]) a_free_var\n    in closure\n\nIf we were to CSE `Left [x]` in the body of `closure` with `not_a_free_var`,\nthen the list of free variables would be wrong, so for now, we do not CSE\nacross such a closure, simply because I (Joachim) was not sure about possible\nknock-on effects. If deemed safe and worth the slight code complication of\nre-calculating this list during or after this pass, this can surely be done.\n-}\n", "num_lines": 484}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Implements a selective lambda lifter, running late in the optimisation\n-- pipeline.\n--\n-- The transformation itself is implemented in \"StgLiftLams.Transformation\".\n-- If you are interested in the cost model that is employed to decide whether\n-- to lift a binding or not, look at \"StgLiftLams.Analysis\".\n-- \"StgLiftLams.LiftM\" contains the transformation monad that hides away some\n-- plumbing of the transformation.\nmodule StgLiftLams (\n    -- * Late lambda lifting in STG\n    -- $note\n    Transformation.stgLiftLams\n  ) where\n\nimport qualified StgLiftLams.Transformation as Transformation\n\n-- Note [Late lambda lifting in STG]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- $note\n-- See also the <https://ghc.haskell.org/trac/ghc/wiki/LateLamLift wiki page>\n-- and Trac #9476.\n--\n-- The basic idea behind lambda lifting is to turn locally defined functions\n-- into top-level functions. Free variables are then passed as additional\n-- arguments at *call sites* instead of having a closure allocated for them at\n-- *definition site*. Example:\n--\n-- @\n--    let x = ...; y = ... in\n--    let f = {x y} \\a -> a + x + y in\n--    let g = {f x} \\b -> f b + x in\n--    g 5\n-- @\n--\n-- Lambda lifting @f@ would\n--\n--   1. Turn @f@'s free variables into formal parameters\n--   2. Update @f@'s call site within @g@ to @f x y b@\n--   3. Update @g@'s closure: Add @y@ as an additional free variable, while\n--      removing @f@, because @f@ no longer allocates and can be floated to\n--      top-level.\n--   4. Actually float the binding of @f@ to top-level, eliminating the @let@\n--      in the process.\n--\n-- This results in the following program (with free var annotations):\n--\n-- @\n--    f x y a = a + x + y;\n--    let x = ...; y = ... in\n--    let g = {x y} \\b -> f x y b + x in\n--    g 5\n-- @\n--\n-- This optimisation is all about lifting only when it is beneficial to do so.\n-- The above seems like a worthwhile lift, judging from heap allocation:\n-- We eliminate @f@'s closure, saving to allocate a closure with 2 words, while\n-- not changing the size of @g@'s closure.\n--\n-- You can probably sense that there's some kind of cost model at play here.\n-- And you are right! But we also employ a couple of other heuristics for the\n-- lifting decision which are outlined in \"StgLiftLams.Analysis#when\".\n--\n-- The transformation is done in \"StgLiftLams.Transformation\", which calls out\n-- to 'StgLiftLams.Analysis.goodToLift' for its lifting decision.\n-- It relies on \"StgLiftLams.LiftM\", which abstracts some subtle STG invariants\n-- into a monadic substrate.\n--\n-- Suffice to say: We trade heap allocation for stack allocation.\n-- The additional arguments have to passed on the stack (or in registers,\n-- depending on architecture) every time we call the function to save a single\n-- heap allocation when entering the let binding. Nofib suggests a mean\n-- improvement of about 1% for this pass, so it seems like a worthwhile thing to\n-- do. Compile-times went up by 0.6%, so all in all a very modest change.\n--\n-- For a concrete example, look at @spectral/atom@. There's a call to 'zipWith'\n-- that is ultimately compiled to something like this\n-- (module desugaring/lowering to actual STG):\n--\n-- @\n--    propagate dt = ...;\n--    runExperiment ... =\n--      let xs = ... in\n--      let ys = ... in\n--      let go = {dt go} \\xs ys -> case (xs, ys) of\n--            ([], []) -> []\n--            (x:xs', y:ys') -> propagate dt x y : go xs' ys'\n--      in go xs ys\n-- @\n--\n-- This will lambda lift @go@ to top-level, speeding up the resulting program\n-- by roughly one percent:\n--\n-- @\n--    propagate dt = ...;\n--    go dt xs ys = case (xs, ys) of\n--      ([], []) -> []\n--      (x:xs', y:ys') -> propagate dt x y : go dt xs' ys'\n--    runExperiment ... =\n--      let xs = ... in\n--      let ys = ... in\n--      in go dt xs ys\n-- @\n", "num_lines": 103}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[StgStats]{Gathers statistical information about programs}\n\n\nThe program gather statistics about\n\\begin{enumerate}\n\\item number of boxed cases\n\\item number of unboxed cases\n\\item number of let-no-escapes\n\\item number of non-updatable lets\n\\item number of updatable lets\n\\item number of applications\n\\item number of primitive applications\n\\item number of closures (does not include lets bound to constructors)\n\\item number of free variables in closures\n%\\item number of top-level functions\n%\\item number of top-level CAFs\n\\item number of constructors\n\\end{enumerate}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule StgStats ( showStgStats ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport StgSyn\n\nimport Id (Id)\nimport Panic\n\nimport Data.Map (Map)\nimport qualified Data.Map as Map\n\ndata CounterType\n  = Literals\n  | Applications\n  | ConstructorApps\n  | PrimitiveApps\n  | LetNoEscapes\n  | StgCases\n  | FreeVariables\n  | ConstructorBinds Bool{-True<=>top-level-}\n  | ReEntrantBinds   Bool{-ditto-}\n  | SingleEntryBinds Bool{-ditto-}\n  | UpdatableBinds   Bool{-ditto-}\n  deriving (Eq, Ord)\n\ntype Count      = Int\ntype StatEnv    = Map CounterType Count\n\nemptySE :: StatEnv\nemptySE = Map.empty\n\ncombineSE :: StatEnv -> StatEnv -> StatEnv\ncombineSE = Map.unionWith (+)\n\ncombineSEs :: [StatEnv] -> StatEnv\ncombineSEs = foldr combineSE emptySE\n\ncountOne :: CounterType -> StatEnv\ncountOne c = Map.singleton c 1\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Top-level list of bindings (a ``program'')}\n*                                                                      *\n************************************************************************\n-}\n\nshowStgStats :: [StgTopBinding] -> String\n\nshowStgStats prog\n  = \"STG Statistics:\\n\\n\"\n    ++ concat (map showc (Map.toList (gatherStgStats prog)))\n  where\n    showc (x,n) = (showString (s x) . shows n) \"\\n\"\n\n    s Literals                = \"Literals                   \"\n    s Applications            = \"Applications               \"\n    s ConstructorApps         = \"ConstructorApps            \"\n    s PrimitiveApps           = \"PrimitiveApps              \"\n    s LetNoEscapes            = \"LetNoEscapes               \"\n    s StgCases                = \"StgCases                   \"\n    s FreeVariables           = \"FreeVariables              \"\n    s (ConstructorBinds True) = \"ConstructorBinds_Top       \"\n    s (ReEntrantBinds True)   = \"ReEntrantBinds_Top         \"\n    s (SingleEntryBinds True) = \"SingleEntryBinds_Top       \"\n    s (UpdatableBinds True)   = \"UpdatableBinds_Top         \"\n    s (ConstructorBinds _)    = \"ConstructorBinds_Nested    \"\n    s (ReEntrantBinds _)      = \"ReEntrantBindsBinds_Nested \"\n    s (SingleEntryBinds _)    = \"SingleEntryBinds_Nested    \"\n    s (UpdatableBinds _)      = \"UpdatableBinds_Nested      \"\n\ngatherStgStats :: [StgTopBinding] -> StatEnv\ngatherStgStats binds = combineSEs (map statTopBinding binds)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Bindings}\n*                                                                      *\n************************************************************************\n-}\n\nstatTopBinding :: StgTopBinding -> StatEnv\nstatTopBinding (StgTopStringLit _ _) = countOne Literals\nstatTopBinding (StgTopLifted bind) = statBinding True bind\n\nstatBinding :: Bool -- True <=> top-level; False <=> nested\n            -> StgBinding\n            -> StatEnv\n\nstatBinding top (StgNonRec b rhs)\n  = statRhs top (b, rhs)\n\nstatBinding top (StgRec pairs)\n  = combineSEs (map (statRhs top) pairs)\n\nstatRhs :: Bool -> (Id, StgRhs) -> StatEnv\n\nstatRhs top (_, StgRhsCon _ _ _)\n  = countOne (ConstructorBinds top)\n\nstatRhs top (_, StgRhsClosure _ _ u _ body)\n  = statExpr body `combineSE`\n    countOne (\n      case u of\n        ReEntrant   -> ReEntrantBinds   top\n        Updatable   -> UpdatableBinds   top\n        SingleEntry -> SingleEntryBinds top\n    )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Expressions}\n*                                                                      *\n************************************************************************\n-}\n\nstatExpr :: StgExpr -> StatEnv\n\nstatExpr (StgApp _ _)     = countOne Applications\nstatExpr (StgLit _)       = countOne Literals\nstatExpr (StgConApp _ _ _)= countOne ConstructorApps\nstatExpr (StgOpApp _ _ _) = countOne PrimitiveApps\nstatExpr (StgTick _ e)    = statExpr e\n\nstatExpr (StgLetNoEscape _ binds body)\n  = statBinding False{-not top-level-} binds    `combineSE`\n    statExpr body                               `combineSE`\n    countOne LetNoEscapes\n\nstatExpr (StgLet _ binds body)\n  = statBinding False{-not top-level-} binds    `combineSE`\n    statExpr body\n\nstatExpr (StgCase expr _ _ alts)\n  = statExpr expr       `combineSE`\n    stat_alts alts      `combineSE`\n    countOne StgCases\n  where\n    stat_alts alts\n        = combineSEs (map statExpr [ e | (_,_,e) <- alts ])\n\nstatExpr (StgLam {}) = panic \"statExpr StgLam\"\n", "num_lines": 174}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-2012\n\nNote [Unarisation]\n~~~~~~~~~~~~~~~~~~\nThe idea of this pass is to translate away *all* unboxed-tuple and unboxed-sum\nbinders. So for example:\n\n  f (x :: (# Int, Bool #)) = f x + f (# 1, True #)\n\n  ==>\n\n  f (x1 :: Int) (x2 :: Bool) = f x1 x2 + f 1 True\n\nIt is important that we do this at the STG level and NOT at the Core level\nbecause it would be very hard to make this pass Core-type-preserving. In this\nexample the type of 'f' changes, for example.\n\nSTG fed to the code generators *must* be unarised because the code generators do\nnot support unboxed tuple and unboxed sum binders natively.\n\nIn more detail: (see next note for unboxed sums)\n\nSuppose that a variable x : (# t1, t2 #).\n\n  * At the binding site for x, make up fresh vars  x1:t1, x2:t2\n\n  * Extend the UnariseEnv   x :-> MultiVal [x1,x2]\n\n  * Replace the binding with a curried binding for x1,x2\n\n       Lambda:   \\x.e                ==>   \\x1 x2. e\n       Case alt: MkT a b x c d -> e  ==>   MkT a b x1 x2 c d -> e\n\n  * Replace argument occurrences with a sequence of args via a lookup in\n    UnariseEnv\n\n       f a b x c d   ==>   f a b x1 x2 c d\n\n  * Replace tail-call occurrences with an unboxed tuple via a lookup in\n    UnariseEnv\n\n       x  ==>  (# x1, x2 #)\n\n    So, for example\n\n       f x = x    ==>   f x1 x2 = (# x1, x2 #)\n\n  * We /always/ eliminate a case expression when\n\n       - It scrutinises an unboxed tuple or unboxed sum\n\n       - The scrutinee is a variable (or when it is an explicit tuple, but the\n         simplifier eliminates those)\n\n    The case alternative (there can be only one) can be one of these two\n    things:\n\n      - An unboxed tuple pattern. e.g.\n\n          case v of x { (# x1, x2, x3 #) -> ... }\n\n        Scrutinee has to be in form `(# t1, t2, t3 #)` so we just extend the\n        environment with\n\n          x :-> MultiVal [t1,t2,t3]\n          x1 :-> UnaryVal t1, x2 :-> UnaryVal t2, x3 :-> UnaryVal t3\n\n      - A DEFAULT alternative. Just the same, without the bindings for x1,x2,x3\n\nBy the end of this pass, we only have unboxed tuples in return positions.\nUnboxed sums are completely eliminated, see next note.\n\nNote [Translating unboxed sums to unboxed tuples]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nUnarise also eliminates unboxed sum binders, and translates unboxed sums in\nreturn positions to unboxed tuples. We want to overlap fields of a sum when\ntranslating it to a tuple to have efficient memory layout. When translating a\nsum pattern to a tuple pattern, we need to translate it so that binders of sum\nalternatives will be mapped to right arguments after the term translation. So\ntranslation of sum DataCon applications to tuple DataCon applications and\ntranslation of sum patterns to tuple patterns need to be in sync.\n\nThese translations work like this. Suppose we have\n\n  (# x1 | | ... #) :: (# t1 | t2 | ... #)\n\nremember that t1, t2 ... can be sums and tuples too. So we first generate\nlayouts of those. Then we \"merge\" layouts of each alternative, which gives us a\nsum layout with best overlapping possible.\n\nLayout of a flat type 'ty1' is just [ty1].\nLayout of a tuple is just concatenation of layouts of its fields.\n\nFor layout of a sum type,\n\n  - We first get layouts of all alternatives.\n  - We sort these layouts based on their \"slot types\".\n  - We merge all the alternatives.\n\nFor example, say we have (# (# Int#, Char #) | (# Int#, Int# #) | Int# #)\n\n  - Layouts of alternatives: [ [Word, Ptr], [Word, Word], [Word] ]\n  - Sorted: [ [Ptr, Word], [Word, Word], [Word] ]\n  - Merge all alternatives together: [ Ptr, Word, Word ]\n\nWe add a slot for the tag to the first position. So our tuple type is\n\n  (# Tag#, Any, Word#, Word# #)\n  (we use Any for pointer slots)\n\nNow, any term of this sum type needs to generate a tuple of this type instead.\nThe translation works by simply putting arguments to first slots that they fit\nin. Suppose we had\n\n  (# (# 42#, 'c' #) | | #)\n\n42# fits in Word#, 'c' fits in Any, so we generate this application:\n\n  (# 1#, 'c', 42#, rubbish #)\n\nAnother example using the same type: (# | (# 2#, 3# #) | #). 2# fits in Word#,\n3# fits in Word #, so we get:\n\n  (# 2#, rubbish, 2#, 3# #).\n\nNote [Types in StgConApp]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have this unboxed sum term:\n\n  (# 123 | #)\n\nWhat will be the unboxed tuple representation? We can't tell without knowing the\ntype of this term. For example, these are all valid tuples for this:\n\n  (# 1#, 123 #)          -- when type is (# Int | String #)\n  (# 1#, 123, rubbish #) -- when type is (# Int | Float# #)\n  (# 1#, 123, rubbish, rubbish #)\n                         -- when type is (# Int | (# Int, Int, Int #) #)\n\nSo we pass type arguments of the DataCon's TyCon in StgConApp to decide what\nlayout to use. Note that unlifted values can't be let-bound, so we don't need\ntypes in StgRhsCon.\n\nNote [UnariseEnv can map to literals]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTo avoid redundant case expressions when unarising unboxed sums, UnariseEnv\nneeds to map variables to literals too. Suppose we have this Core:\n\n  f (# x | #)\n\n  ==> (CorePrep)\n\n  case (# x | #) of y {\n    _ -> f y\n  }\n\n  ==> (MultiVal)\n\n  case (# 1#, x #) of [x1, x2] {\n    _ -> f x1 x2\n  }\n\nTo eliminate this case expression we need to map x1 to 1# in UnariseEnv:\n\n  x1 :-> UnaryVal 1#, x2 :-> UnaryVal x\n\nso that `f x1 x2` becomes `f 1# x`.\n\nNote [Unarisation and arity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBecause of unarisation, the arity that will be recorded in the generated info\ntable for an Id may be larger than the idArity. Instead we record what we call\nthe RepArity, which is the Arity taking into account any expanded arguments, and\ncorresponds to the number of (possibly-void) *registers* arguments will arrive\nin.\n\nNote [Post-unarisation invariants]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSTG programs after unarisation have these invariants:\n\n  * No unboxed sums at all.\n\n  * No unboxed tuple binders. Tuples only appear in return position.\n\n  * DataCon applications (StgRhsCon and StgConApp) don't have void arguments.\n    This means that it's safe to wrap `StgArg`s of DataCon applications with\n    `StgCmmEnv.NonVoid`, for example.\n\n  * Alt binders (binders in patterns) are always non-void.\n-}\n\n{-# LANGUAGE CPP, TupleSections #-}\n\nmodule UnariseStg (unarise) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BasicTypes\nimport CoreSyn\nimport DataCon\nimport FastString (FastString, mkFastString)\nimport Id\nimport Literal\nimport MkCore (aBSENT_SUM_FIELD_ERROR_ID)\nimport MkId (voidPrimId, voidArgId)\nimport MonadUtils (mapAccumLM)\nimport Outputable\nimport RepType\nimport StgSyn\nimport Type\nimport TysPrim (intPrimTy,wordPrimTy,word64PrimTy)\nimport TysWiredIn\nimport UniqSupply\nimport Util\nimport VarEnv\n\nimport Data.Bifunctor (second)\nimport Data.Maybe (mapMaybe)\nimport qualified Data.IntMap as IM\n\n--------------------------------------------------------------------------------\n\n-- | A mapping from binders to the Ids they were expanded/renamed to.\n--\n--   x :-> MultiVal [a,b,c] in rho\n--\n-- iff  x's typePrimRep is not a singleton, or equivalently\n--      x's type is an unboxed tuple, sum or void.\n--\n--    x :-> UnaryVal x'\n--\n-- iff x's RepType is UnaryRep or equivalently\n--     x's type is not unboxed tuple, sum or void.\n--\n-- So\n--     x :-> MultiVal [a] in rho\n-- means x is represented by singleton tuple.\n--\n--     x :-> MultiVal [] in rho\n-- means x is void.\n--\n-- INVARIANT: OutStgArgs in the range only have NvUnaryTypes\n--            (i.e. no unboxed tuples, sums or voids)\n--\ntype UnariseEnv = VarEnv UnariseVal\n\ndata UnariseVal\n  = MultiVal [OutStgArg] -- MultiVal to tuple. Can be empty list (void).\n  | UnaryVal OutStgArg   -- See NOTE [Renaming during unarisation].\n\ninstance Outputable UnariseVal where\n  ppr (MultiVal args) = text \"MultiVal\" <+> ppr args\n  ppr (UnaryVal arg)   = text \"UnaryVal\" <+> ppr arg\n\n-- | Extend the environment, checking the UnariseEnv invariant.\nextendRho :: UnariseEnv -> Id -> UnariseVal -> UnariseEnv\nextendRho rho x (MultiVal args)\n  = ASSERT(all (isNvUnaryType . stgArgType) args)\n    extendVarEnv rho x (MultiVal args)\nextendRho rho x (UnaryVal val)\n  = ASSERT(isNvUnaryType (stgArgType val))\n    extendVarEnv rho x (UnaryVal val)\n\n--------------------------------------------------------------------------------\n\nunarise :: UniqSupply -> [StgTopBinding] -> [StgTopBinding]\nunarise us binds = initUs_ us (mapM (unariseTopBinding emptyVarEnv) binds)\n\nunariseTopBinding :: UnariseEnv -> StgTopBinding -> UniqSM StgTopBinding\nunariseTopBinding rho (StgTopLifted bind)\n  = StgTopLifted <$> unariseBinding rho bind\nunariseTopBinding _ bind@StgTopStringLit{} = return bind\n\nunariseBinding :: UnariseEnv -> StgBinding -> UniqSM StgBinding\nunariseBinding rho (StgNonRec x rhs)\n  = StgNonRec x <$> unariseRhs rho rhs\nunariseBinding rho (StgRec xrhss)\n  = StgRec <$> mapM (\\(x, rhs) -> (x,) <$> unariseRhs rho rhs) xrhss\n\nunariseRhs :: UnariseEnv -> StgRhs -> UniqSM StgRhs\nunariseRhs rho (StgRhsClosure ext ccs update_flag args expr)\n  = do (rho', args1) <- unariseFunArgBinders rho args\n       expr' <- unariseExpr rho' expr\n       return (StgRhsClosure ext ccs update_flag args1 expr')\n\nunariseRhs rho (StgRhsCon ccs con args)\n  = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con))\n    return (StgRhsCon ccs con (unariseConArgs rho args))\n\n--------------------------------------------------------------------------------\n\nunariseExpr :: UnariseEnv -> StgExpr -> UniqSM StgExpr\n\nunariseExpr rho e@(StgApp f [])\n  = case lookupVarEnv rho f of\n      Just (MultiVal args)  -- Including empty tuples\n        -> return (mkTuple args)\n      Just (UnaryVal (StgVarArg f'))\n        -> return (StgApp f' [])\n      Just (UnaryVal (StgLitArg f'))\n        -> return (StgLit f')\n      Nothing\n        -> return e\n\nunariseExpr rho e@(StgApp f args)\n  = return (StgApp f' (unariseFunArgs rho args))\n  where\n    f' = case lookupVarEnv rho f of\n           Just (UnaryVal (StgVarArg f')) -> f'\n           Nothing -> f\n           err -> pprPanic \"unariseExpr - app2\" (ppr e $$ ppr err)\n               -- Can't happen because 'args' is non-empty, and\n               -- a tuple or sum cannot be applied to anything\n\nunariseExpr _ (StgLit l)\n  = return (StgLit l)\n\nunariseExpr rho (StgConApp dc args ty_args)\n  | Just args' <- unariseMulti_maybe rho dc args ty_args\n  = return (mkTuple args')\n\n  | otherwise\n  , let args' = unariseConArgs rho args\n  = return (StgConApp dc args' (map stgArgType args'))\n\nunariseExpr rho (StgOpApp op args ty)\n  = return (StgOpApp op (unariseFunArgs rho args) ty)\n\nunariseExpr _ e@StgLam{}\n  = pprPanic \"unariseExpr: found lambda\" (ppr e)\n\nunariseExpr rho (StgCase scrut bndr alt_ty alts)\n  -- tuple/sum binders in the scrutinee can always be eliminated\n  | StgApp v [] <- scrut\n  , Just (MultiVal xs) <- lookupVarEnv rho v\n  = elimCase rho xs bndr alt_ty alts\n\n  -- Handle strict lets for tuples and sums:\n  --   case (# a,b #) of r -> rhs\n  -- and analogously for sums\n  | StgConApp dc args ty_args <- scrut\n  , Just args' <- unariseMulti_maybe rho dc args ty_args\n  = elimCase rho args' bndr alt_ty alts\n\n  -- general case\n  | otherwise\n  = do scrut' <- unariseExpr rho scrut\n       alts'  <- unariseAlts rho alt_ty bndr alts\n       return (StgCase scrut' bndr alt_ty alts')\n                       -- bndr may have a unboxed sum/tuple type but it will be\n                       -- dead after unarise (checked in StgLint)\n\nunariseExpr rho (StgLet ext bind e)\n  = StgLet ext <$> unariseBinding rho bind <*> unariseExpr rho e\n\nunariseExpr rho (StgLetNoEscape ext bind e)\n  = StgLetNoEscape ext <$> unariseBinding rho bind <*> unariseExpr rho e\n\nunariseExpr rho (StgTick tick e)\n  = StgTick tick <$> unariseExpr rho e\n\n-- Doesn't return void args.\nunariseMulti_maybe :: UnariseEnv -> DataCon -> [InStgArg] -> [Type] -> Maybe [OutStgArg]\nunariseMulti_maybe rho dc args ty_args\n  | isUnboxedTupleCon dc\n  = Just (unariseConArgs rho args)\n\n  | isUnboxedSumCon dc\n  , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args)\n  = Just (mkUbxSum dc ty_args args1)\n\n  | otherwise\n  = Nothing\n\n--------------------------------------------------------------------------------\n\nelimCase :: UnariseEnv\n         -> [OutStgArg] -- non-void args\n         -> InId -> AltType -> [InStgAlt] -> UniqSM OutStgExpr\n\nelimCase rho args bndr (MultiValAlt _) [(_, bndrs, rhs)]\n  = do let rho1 = extendRho rho bndr (MultiVal args)\n           rho2\n             | isUnboxedTupleBndr bndr\n             = mapTupleIdBinders bndrs args rho1\n             | otherwise\n             = ASSERT(isUnboxedSumBndr bndr)\n               if null bndrs then rho1\n                             else mapSumIdBinders bndrs args rho1\n\n       unariseExpr rho2 rhs\n\nelimCase rho args bndr (MultiValAlt _) alts\n  | isUnboxedSumBndr bndr\n  = do let (tag_arg : real_args) = args\n       tag_bndr <- mkId (mkFastString \"tag\") tagTy\n          -- this won't be used but we need a binder anyway\n       let rho1 = extendRho rho bndr (MultiVal args)\n           scrut' = case tag_arg of\n                      StgVarArg v     -> StgApp v []\n                      StgLitArg l     -> StgLit l\n\n       alts' <- unariseSumAlts rho1 real_args alts\n       return (StgCase scrut' tag_bndr tagAltTy alts')\n\nelimCase _ args bndr alt_ty alts\n  = pprPanic \"elimCase - unhandled case\"\n      (ppr args <+> ppr bndr <+> ppr alt_ty $$ ppr alts)\n\n--------------------------------------------------------------------------------\n\nunariseAlts :: UnariseEnv -> AltType -> InId -> [StgAlt] -> UniqSM [StgAlt]\nunariseAlts rho (MultiValAlt n) bndr [(DEFAULT, [], e)]\n  | isUnboxedTupleBndr bndr\n  = do (rho', ys) <- unariseConArgBinder rho bndr\n       e' <- unariseExpr rho' e\n       return [(DataAlt (tupleDataCon Unboxed n), ys, e')]\n\nunariseAlts rho (MultiValAlt n) bndr [(DataAlt _, ys, e)]\n  | isUnboxedTupleBndr bndr\n  = do (rho', ys1) <- unariseConArgBinders rho ys\n       MASSERT(ys1 `lengthIs` n)\n       let rho'' = extendRho rho' bndr (MultiVal (map StgVarArg ys1))\n       e' <- unariseExpr rho'' e\n       return [(DataAlt (tupleDataCon Unboxed n), ys1, e')]\n\nunariseAlts _ (MultiValAlt _) bndr alts\n  | isUnboxedTupleBndr bndr\n  = pprPanic \"unariseExpr: strange multi val alts\" (ppr alts)\n\n-- In this case we don't need to scrutinize the tag bit\nunariseAlts rho (MultiValAlt _) bndr [(DEFAULT, _, rhs)]\n  | isUnboxedSumBndr bndr\n  = do (rho_sum_bndrs, sum_bndrs) <- unariseConArgBinder rho bndr\n       rhs' <- unariseExpr rho_sum_bndrs rhs\n       return [(DataAlt (tupleDataCon Unboxed (length sum_bndrs)), sum_bndrs, rhs')]\n\nunariseAlts rho (MultiValAlt _) bndr alts\n  | isUnboxedSumBndr bndr\n  = do (rho_sum_bndrs, scrt_bndrs@(tag_bndr : real_bndrs)) <- unariseConArgBinder rho bndr\n       alts' <- unariseSumAlts rho_sum_bndrs (map StgVarArg real_bndrs) alts\n       let inner_case = StgCase (StgApp tag_bndr []) tag_bndr tagAltTy alts'\n       return [ (DataAlt (tupleDataCon Unboxed (length scrt_bndrs)),\n                 scrt_bndrs,\n                 inner_case) ]\n\nunariseAlts rho _ _ alts\n  = mapM (\\alt -> unariseAlt rho alt) alts\n\nunariseAlt :: UnariseEnv -> StgAlt -> UniqSM StgAlt\nunariseAlt rho (con, xs, e)\n  = do (rho', xs') <- unariseConArgBinders rho xs\n       (con, xs',) <$> unariseExpr rho' e\n\n--------------------------------------------------------------------------------\n\n-- | Make alternatives that match on the tag of a sum\n-- (i.e. generate LitAlts for the tag)\nunariseSumAlts :: UnariseEnv\n               -> [StgArg] -- sum components _excluding_ the tag bit.\n               -> [StgAlt] -- original alternative with sum LHS\n               -> UniqSM [StgAlt]\nunariseSumAlts env args alts\n  = do alts' <- mapM (unariseSumAlt env args) alts\n       return (mkDefaultLitAlt alts')\n\nunariseSumAlt :: UnariseEnv\n              -> [StgArg] -- sum components _excluding_ the tag bit.\n              -> StgAlt   -- original alternative with sum LHS\n              -> UniqSM StgAlt\nunariseSumAlt rho _ (DEFAULT, _, e)\n  = ( DEFAULT, [], ) <$> unariseExpr rho e\n\nunariseSumAlt rho args (DataAlt sumCon, bs, e)\n  = do let rho' = mapSumIdBinders bs args rho\n       e' <- unariseExpr rho' e\n       return ( LitAlt (LitNumber LitNumInt (fromIntegral (dataConTag sumCon)) intPrimTy), [], e' )\n\nunariseSumAlt _ scrt alt\n  = pprPanic \"unariseSumAlt\" (ppr scrt $$ ppr alt)\n\n--------------------------------------------------------------------------------\n\nmapTupleIdBinders\n  :: [InId]       -- Un-processed binders of a tuple alternative.\n                  -- Can have void binders.\n  -> [OutStgArg]  -- Arguments that form the tuple (after unarisation).\n                  -- Can't have void args.\n  -> UnariseEnv\n  -> UnariseEnv\nmapTupleIdBinders ids args0 rho0\n  = ASSERT(not (any (isVoidTy . stgArgType) args0))\n    let\n      ids_unarised :: [(Id, [PrimRep])]\n      ids_unarised = map (\\id -> (id, typePrimRep (idType id))) ids\n\n      map_ids :: UnariseEnv -> [(Id, [PrimRep])] -> [StgArg] -> UnariseEnv\n      map_ids rho [] _  = rho\n      map_ids rho ((x, x_reps) : xs) args =\n        let\n          x_arity = length x_reps\n          (x_args, args') =\n            ASSERT(args `lengthAtLeast` x_arity)\n            splitAt x_arity args\n\n          rho'\n            | x_arity == 1\n            = ASSERT(x_args `lengthIs` 1)\n              extendRho rho x (UnaryVal (head x_args))\n            | otherwise\n            = extendRho rho x (MultiVal x_args)\n        in\n          map_ids rho' xs args'\n    in\n      map_ids rho0 ids_unarised args0\n\nmapSumIdBinders\n  :: [InId]      -- Binder of a sum alternative (remember that sum patterns\n                 -- only have one binder, so this list should be a singleton)\n  -> [OutStgArg] -- Arguments that form the sum (NOT including the tag).\n                 -- Can't have void args.\n  -> UnariseEnv\n  -> UnariseEnv\n\nmapSumIdBinders [id] args rho0\n  = ASSERT(not (any (isVoidTy . stgArgType) args))\n    let\n      arg_slots = map primRepSlot $ concatMap (typePrimRep . stgArgType) args\n      id_slots  = map primRepSlot $ typePrimRep (idType id)\n      layout1   = layoutUbxSum arg_slots id_slots\n    in\n      if isMultiValBndr id\n        then extendRho rho0 id (MultiVal [ args !! i | i <- layout1 ])\n        else ASSERT(layout1 `lengthIs` 1)\n             extendRho rho0 id (UnaryVal (args !! head layout1))\n\nmapSumIdBinders ids sum_args _\n  = pprPanic \"mapSumIdBinders\" (ppr ids $$ ppr sum_args)\n\n-- | Build a unboxed sum term from arguments of an alternative.\n--\n-- Example, for (# x | #) :: (# (# #) | Int #) we call\n--\n--   mkUbxSum (# _ | #) [ (# #), Int ] [ voidPrimId ]\n--\n-- which returns\n--\n--   [ 1#, rubbish ]\n--\nmkUbxSum\n  :: DataCon      -- Sum data con\n  -> [Type]       -- Type arguments of the sum data con\n  -> [OutStgArg]  -- Actual arguments of the alternative.\n  -> [OutStgArg]  -- Final tuple arguments\nmkUbxSum dc ty_args args0\n  = let\n      (_ : sum_slots) = ubxSumRepType (map typePrimRep ty_args)\n        -- drop tag slot\n\n      tag = dataConTag dc\n\n      layout'  = layoutUbxSum sum_slots (mapMaybe (typeSlotTy . stgArgType) args0)\n      tag_arg  = StgLitArg (LitNumber LitNumInt (fromIntegral tag) intPrimTy)\n      arg_idxs = IM.fromList (zipEqual \"mkUbxSum\" layout' args0)\n\n      mkTupArgs :: Int -> [SlotTy] -> IM.IntMap StgArg -> [StgArg]\n      mkTupArgs _ [] _\n        = []\n      mkTupArgs arg_idx (slot : slots_left) arg_map\n        | Just stg_arg <- IM.lookup arg_idx arg_map\n        = stg_arg : mkTupArgs (arg_idx + 1) slots_left arg_map\n        | otherwise\n        = slotRubbishArg slot : mkTupArgs (arg_idx + 1) slots_left arg_map\n\n      slotRubbishArg :: SlotTy -> StgArg\n      slotRubbishArg PtrSlot    = StgVarArg aBSENT_SUM_FIELD_ERROR_ID\n                         -- See Note [aBSENT_SUM_FIELD_ERROR_ID] in MkCore\n      slotRubbishArg WordSlot   = StgLitArg (LitNumber LitNumWord 0 wordPrimTy)\n      slotRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0 word64PrimTy)\n      slotRubbishArg FloatSlot  = StgLitArg (LitFloat 0)\n      slotRubbishArg DoubleSlot = StgLitArg (LitDouble 0)\n    in\n      tag_arg : mkTupArgs 0 sum_slots arg_idxs\n\n--------------------------------------------------------------------------------\n\n{-\nFor arguments (StgArg) and binders (Id) we have two kind of unarisation:\n\n  - When unarising function arg binders and arguments, we don't want to remove\n    void binders and arguments. For example,\n\n      f :: (# (# #), (# #) #) -> Void# -> RealWorld# -> ...\n      f x y z = <body>\n\n    Here after unarise we should still get a function with arity 3. Similarly\n    in the call site we shouldn't remove void arguments:\n\n      f (# (# #), (# #) #) voidId rw\n\n    When unarising <body>, we extend the environment with these binders:\n\n      x :-> MultiVal [], y :-> MultiVal [], z :-> MultiVal []\n\n    Because their rep types are `MultiRep []` (aka. void). This means that when\n    we see `x` in a function argument position, we actually replace it with a\n    void argument. When we see it in a DataCon argument position, we just get\n    rid of it, because DataCon applications in STG are always saturated.\n\n  - When unarising case alternative binders we remove void binders, but we\n    still update the environment the same way, because those binders may be\n    used in the RHS. Example:\n\n      case x of y {\n        (# x1, x2, x3 #) -> <RHS>\n      }\n\n    We know that y can't be void, because we don't scrutinize voids, so x will\n    be unarised to some number of arguments, and those arguments will have at\n    least one non-void thing. So in the rho we will have something like:\n\n      x :-> MultiVal [xu1, xu2]\n\n    Now, after we eliminate void binders in the pattern, we get exactly the same\n    number of binders, and extend rho again with these:\n\n      x1 :-> UnaryVal xu1\n      x2 :-> MultiVal [] -- x2 is void\n      x3 :-> UnaryVal xu2\n\n    Now when we see x2 in a function argument position or in return position, we\n    generate void#. In constructor argument position, we just remove it.\n\nSo in short, when we have a void id,\n\n  - We keep it if it's a lambda argument binder or\n                       in argument position of an application.\n\n  - We remove it if it's a DataCon field binder or\n                         in argument position of a DataCon application.\n-}\n\nunariseArgBinder\n    :: Bool -- data con arg?\n    -> UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])\nunariseArgBinder is_con_arg rho x =\n  case typePrimRep (idType x) of\n    []\n      | is_con_arg\n      -> return (extendRho rho x (MultiVal []), [])\n      | otherwise -- fun arg, do not remove void binders\n      -> return (extendRho rho x (MultiVal []), [voidArgId])\n\n    [rep]\n      -- Arg represented as single variable, but original type may still be an\n      -- unboxed sum/tuple, e.g. (# Void# | Void# #).\n      --\n      -- While not unarising the binder in this case does not break any programs\n      -- (because it unarises to a single variable), it triggers StgLint as we\n      -- break the the post-unarisation invariant that says unboxed tuple/sum\n      -- binders should vanish. See Note [Post-unarisation invariants].\n      | isUnboxedSumType (idType x) || isUnboxedTupleType (idType x)\n      -> do x' <- mkId (mkFastString \"us\") (primRepToType rep)\n            return (extendRho rho x (MultiVal [StgVarArg x']), [x'])\n      | otherwise\n      -> return (rho, [x])\n\n    reps -> do\n      xs <- mkIds (mkFastString \"us\") (map primRepToType reps)\n      return (extendRho rho x (MultiVal (map StgVarArg xs)), xs)\n\n--------------------------------------------------------------------------------\n\n-- | MultiVal a function argument. Never returns an empty list.\nunariseFunArg :: UnariseEnv -> StgArg -> [StgArg]\nunariseFunArg rho (StgVarArg x) =\n  case lookupVarEnv rho x of\n    Just (MultiVal [])  -> [voidArg]   -- NB: do not remove void args\n    Just (MultiVal as)  -> as\n    Just (UnaryVal arg) -> [arg]\n    Nothing             -> [StgVarArg x]\nunariseFunArg _ arg = [arg]\n\nunariseFunArgs :: UnariseEnv -> [StgArg] -> [StgArg]\nunariseFunArgs = concatMap . unariseFunArg\n\nunariseFunArgBinders :: UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])\nunariseFunArgBinders rho xs = second concat <$> mapAccumLM unariseFunArgBinder rho xs\n\n-- Result list of binders is never empty\nunariseFunArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])\nunariseFunArgBinder = unariseArgBinder False\n\n--------------------------------------------------------------------------------\n\n-- | MultiVal a DataCon argument. Returns an empty list when argument is void.\nunariseConArg :: UnariseEnv -> InStgArg -> [OutStgArg]\nunariseConArg rho (StgVarArg x) =\n  case lookupVarEnv rho x of\n    Just (UnaryVal arg) -> [arg]\n    Just (MultiVal as) -> as      -- 'as' can be empty\n    Nothing\n      | isVoidTy (idType x) -> [] -- e.g. C realWorld#\n                                  -- Here realWorld# is not in the envt, but\n                                  -- is a void, and so should be eliminated\n      | otherwise -> [StgVarArg x]\nunariseConArg _ arg@(StgLitArg lit) =\n    ASSERT(not (isVoidTy (literalType lit)))  -- We have no void literals\n    [arg]\n\nunariseConArgs :: UnariseEnv -> [InStgArg] -> [OutStgArg]\nunariseConArgs = concatMap . unariseConArg\n\nunariseConArgBinders :: UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])\nunariseConArgBinders rho xs = second concat <$> mapAccumLM unariseConArgBinder rho xs\n\n-- Different from `unariseFunArgBinder`: result list of binders may be empty.\n-- See DataCon applications case in Note [Post-unarisation invariants].\nunariseConArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])\nunariseConArgBinder = unariseArgBinder True\n\n--------------------------------------------------------------------------------\n\nmkIds :: FastString -> [UnaryType] -> UniqSM [Id]\nmkIds fs tys = mapM (mkId fs) tys\n\nmkId :: FastString -> UnaryType -> UniqSM Id\nmkId = mkSysLocalOrCoVarM\n\nisMultiValBndr :: Id -> Bool\nisMultiValBndr id\n  | [_] <- typePrimRep (idType id)\n  = False\n  | otherwise\n  = True\n\nisUnboxedSumBndr :: Id -> Bool\nisUnboxedSumBndr = isUnboxedSumType . idType\n\nisUnboxedTupleBndr :: Id -> Bool\nisUnboxedTupleBndr = isUnboxedTupleType . idType\n\nmkTuple :: [StgArg] -> StgExpr\nmkTuple args = StgConApp (tupleDataCon Unboxed (length args)) args (map stgArgType args)\n\ntagAltTy :: AltType\ntagAltTy = PrimAlt IntRep\n\ntagTy :: Type\ntagTy = intPrimTy\n\nvoidArg :: StgArg\nvoidArg = StgVarArg voidPrimId\n\nmkDefaultLitAlt :: [StgAlt] -> [StgAlt]\n-- We have an exhauseive list of literal alternatives\n--    1# -> e1\n--    2# -> e2\n-- Since they are exhaustive, we can replace one with DEFAULT, to avoid\n-- generating a final test. Remember, the DEFAULT comes first if it exists.\nmkDefaultLitAlt [] = pprPanic \"elimUbxSumExpr.mkDefaultAlt\" (text \"Empty alts\")\nmkDefaultLitAlt alts@((DEFAULT, _, _) : _) = alts\nmkDefaultLitAlt ((LitAlt{}, [], rhs) : alts) = (DEFAULT, [], rhs) : alts\nmkDefaultLitAlt alts = pprPanic \"mkDefaultLitAlt\" (text \"Not a lit alt:\" <+> ppr alts)\n", "num_lines": 768}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n\n-- | Provides the heuristics for when it's beneficial to lambda lift bindings.\n-- Most significantly, this employs a cost model to estimate impact on heap\n-- allocations, by looking at an STG expression's 'Skeleton'.\nmodule StgLiftLams.Analysis (\n    -- * #when# When to lift\n    -- $when\n\n    -- * #clogro# Estimating closure growth\n    -- $clogro\n\n    -- * AST annotation\n    Skeleton(..), BinderInfo(..), binderInfoBndr,\n    LlStgBinding, LlStgExpr, LlStgRhs, LlStgAlt, tagSkeletonTopBind,\n    -- * Lifting decision\n    goodToLift,\n    closureGrowth -- Exported just for the docs\n  ) where\n\nimport GhcPrelude\n\nimport BasicTypes\nimport Demand\nimport DynFlags\nimport Id\nimport SMRep ( WordOff )\nimport StgSyn\nimport qualified StgCmmArgRep\nimport qualified StgCmmClosure\nimport qualified StgCmmLayout\nimport Outputable\nimport Util\nimport VarSet\n\nimport Data.Maybe ( mapMaybe )\n\n-- Note [When to lift]\n-- ~~~~~~~~~~~~~~~~~~~\n-- $when\n-- The analysis proceeds in two steps:\n--\n--   1. It tags the syntax tree with analysis information in the form of\n--      'BinderInfo' at each binder and 'Skeleton's at each let-binding\n--      by 'tagSkeletonTopBind' and friends.\n--   2. The resulting syntax tree is treated by the \"StgLiftLams.Transformation\"\n--      module, calling out to 'goodToLift' to decide if a binding is worthwhile\n--      to lift.\n--      'goodToLift' consults argument occurrence information in 'BinderInfo'\n--      and estimates 'closureGrowth', for which it needs the 'Skeleton'.\n--\n-- So the annotations from 'tagSkeletonTopBind' ultimately fuel 'goodToLift',\n-- which employs a number of heuristics to identify and exclude lambda lifting\n-- opportunities deemed non-beneficial:\n--\n--  [Top-level bindings] can't be lifted.\n--  [Thunks] and data constructors shouldn't be lifted in order not to destroy\n--    sharing.\n--  [Argument occurrences] #arg_occs# of binders prohibit them to be lifted.\n--    Doing the lift would re-introduce the very allocation at call sites that\n--    we tried to get rid off in the first place. We capture analysis\n--    information in 'BinderInfo'. Note that we also consider a nullary\n--    application as argument occurrence, because it would turn into an n-ary\n--    partial application created by a generic apply function. This occurs in\n--    CPS-heavy code like the CS benchmark.\n--  [Join points] should not be lifted, simply because there's no reduction in\n--    allocation to be had.\n--  [Abstracting over join points] destroys join points, because they end up as\n--    arguments to the lifted function.\n--  [Abstracting over known local functions] turns a known call into an unknown\n--    call (e.g. some @stg_ap_*@), which is generally slower. Can be turned off\n--    with @-fstg-lift-lams-known@.\n--  [Calling convention] Don't lift when the resulting function would have a\n--    higher arity than available argument registers for the calling convention.\n--    Can be influenced with @-fstg-lift-(non)rec-args(-any)@.\n--  [Closure growth] introduced when former free variables have to be available\n--    at call sites may actually lead to an increase in overall allocations\n--  resulting from a lift. Estimating closure growth is described in\n--  \"StgLiftLams.Analysis#clogro\" and is what most of this module is ultimately\n--  concerned with.\n--\n-- There's a <https://ghc.haskell.org/trac/ghc/wiki/LateLamLift wiki page> with\n-- some more background and history.\n\n-- Note [Estimating closure growth]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- $clogro\n-- We estimate closure growth by abstracting the syntax tree into a 'Skeleton',\n-- capturing only syntactic details relevant to 'closureGrowth', such as\n--\n--   * 'ClosureSk', representing closure allocation.\n--   * 'RhsSk', representing a RHS of a binding and how many times it's called\n--     by an appropriate 'DmdShell'.\n--   * 'AltSk', 'BothSk' and 'NilSk' for choice, sequence and empty element.\n--\n-- This abstraction is mostly so that the main analysis function 'closureGrowth'\n-- can stay simple and focused. Also, skeletons tend to be much smaller than\n-- the syntax tree they abstract, so it makes sense to construct them once and\n-- and operate on them instead of the actual syntax tree.\n--\n-- A more detailed treatment of computing closure growth, including examples,\n-- can be found in the paper referenced from the\n-- <https://ghc.haskell.org/trac/ghc/wiki/LateLamLift wiki page>.\n\nllTrace :: String -> SDoc -> a -> a\nllTrace _ _ c = c\n-- llTrace a b c = pprTrace a b c\n\ntype instance BinderP      'LiftLams = BinderInfo\ntype instance XRhsClosure  'LiftLams = DIdSet\ntype instance XLet         'LiftLams = Skeleton\ntype instance XLetNoEscape 'LiftLams = Skeleton\n\nfreeVarsOfRhs :: (XRhsClosure pass ~ DIdSet) => GenStgRhs pass -> DIdSet\nfreeVarsOfRhs (StgRhsCon _ _ args) = mkDVarSet [ id | StgVarArg id <- args ]\nfreeVarsOfRhs (StgRhsClosure fvs _ _ _ _) = fvs\n\n-- | Captures details of the syntax tree relevant to the cost model, such as\n-- closures, multi-shot lambdas and case expressions.\ndata Skeleton\n  = ClosureSk !Id !DIdSet {- ^ free vars -} !Skeleton\n  | RhsSk !DmdShell {- ^ how often the RHS was entered -} !Skeleton\n  | AltSk !Skeleton !Skeleton\n  | BothSk !Skeleton !Skeleton\n  | NilSk\n\nbothSk :: Skeleton -> Skeleton -> Skeleton\nbothSk NilSk b = b\nbothSk a NilSk = a\nbothSk a b     = BothSk a b\n\naltSk :: Skeleton -> Skeleton -> Skeleton\naltSk NilSk b = b\naltSk a NilSk = a\naltSk a b     = AltSk a b\n\nrhsSk :: DmdShell -> Skeleton -> Skeleton\nrhsSk _        NilSk = NilSk\nrhsSk body_dmd skel  = RhsSk body_dmd skel\n\n-- | The type used in binder positions in 'GenStgExpr's.\ndata BinderInfo\n  = BindsClosure !Id !Bool -- ^ Let(-no-escape)-bound thing with a flag\n                           --   indicating whether it occurs as an argument\n                           --   or in a nullary application\n                           --   (see \"StgLiftLams.Analysis#arg_occs\").\n  | BoringBinder !Id       -- ^ Every other kind of binder\n\n-- | Gets the bound 'Id' out a 'BinderInfo'.\nbinderInfoBndr :: BinderInfo -> Id\nbinderInfoBndr (BoringBinder bndr)   = bndr\nbinderInfoBndr (BindsClosure bndr _) = bndr\n\n-- | Returns 'Nothing' for 'BoringBinder's and 'Just' the flag indicating\n-- occurrences as argument or in a nullary applications otherwise.\nbinderInfoOccursAsArg :: BinderInfo -> Maybe Bool\nbinderInfoOccursAsArg BoringBinder{}     = Nothing\nbinderInfoOccursAsArg (BindsClosure _ b) = Just b\n\ninstance Outputable Skeleton where\n  ppr NilSk = text \"\"\n  ppr (AltSk l r) = vcat\n    [ text \"{ \" <+> ppr l\n    , text \"ALT\"\n    , text \"  \" <+> ppr r\n    , text \"}\"\n    ]\n  ppr (BothSk l r) = ppr l $$ ppr r\n  ppr (ClosureSk f fvs body) = ppr f <+> ppr fvs $$ nest 2 (ppr body)\n  ppr (RhsSk body_dmd body) = hcat\n    [ text \"\u00ce\u00bb[\"\n    , ppr str\n    , text \", \"\n    , ppr use\n    , text \"]. \"\n    , ppr body\n    ]\n    where\n      str\n        | isStrictDmd body_dmd = '1'\n        | otherwise = '0'\n      use\n        | isAbsDmd body_dmd = '0'\n        | isUsedOnce body_dmd = '1'\n        | otherwise = '\u00cf\u2030'\n\ninstance Outputable BinderInfo where\n  ppr = ppr . binderInfoBndr\n\ninstance OutputableBndr BinderInfo where\n  pprBndr b = pprBndr b . binderInfoBndr\n  pprPrefixOcc = pprPrefixOcc . binderInfoBndr\n  pprInfixOcc = pprInfixOcc . binderInfoBndr\n  bndrIsJoin_maybe = bndrIsJoin_maybe . binderInfoBndr\n\nmkArgOccs :: [StgArg] -> IdSet\nmkArgOccs = mkVarSet . mapMaybe stg_arg_var\n  where\n    stg_arg_var (StgVarArg occ) = Just occ\n    stg_arg_var _               = Nothing\n\n-- | Tags every binder with its 'BinderInfo' and let bindings with their\n-- 'Skeleton's.\ntagSkeletonTopBind :: CgStgBinding -> LlStgBinding\n-- NilSk is OK when tagging top-level bindings. Also, top-level things are never\n-- lambda-lifted, so no need to track their argument occurrences. They can also\n-- never be let-no-escapes (thus we pass False).\ntagSkeletonTopBind bind = bind'\n  where\n    (_, _, _, bind') = tagSkeletonBinding False NilSk emptyVarSet bind\n\n-- | Tags binders of an 'StgExpr' with its 'BinderInfo' and let bindings with\n-- their 'Skeleton's. Additionally, returns its 'Skeleton' and the set of binder\n-- occurrences in argument and nullary application position\n-- (cf. \"StgLiftLams.Analysis#arg_occs\").\ntagSkeletonExpr :: CgStgExpr -> (Skeleton, IdSet, LlStgExpr)\ntagSkeletonExpr (StgLit lit)\n  = (NilSk, emptyVarSet, StgLit lit)\ntagSkeletonExpr (StgConApp con args tys)\n  = (NilSk, mkArgOccs args, StgConApp con args tys)\ntagSkeletonExpr (StgOpApp op args ty)\n  = (NilSk, mkArgOccs args, StgOpApp op args ty)\ntagSkeletonExpr (StgApp f args)\n  = (NilSk, arg_occs, StgApp f args)\n  where\n    arg_occs\n      -- This checks for nullary applications, which we treat the same as\n      -- argument occurrences, see \"StgLiftLams.Analysis#arg_occs\".\n      | null args = unitVarSet f\n      | otherwise = mkArgOccs args\ntagSkeletonExpr (StgLam _ _) = pprPanic \"stgLiftLams\" (text \"StgLam\")\ntagSkeletonExpr (StgCase scrut bndr ty alts)\n  = (skel, arg_occs, StgCase scrut' bndr' ty alts')\n  where\n    (scrut_skel, scrut_arg_occs, scrut') = tagSkeletonExpr scrut\n    (alt_skels, alt_arg_occss, alts') = mapAndUnzip3 tagSkeletonAlt alts\n    skel = bothSk scrut_skel (foldr altSk NilSk alt_skels)\n    arg_occs = unionVarSets (scrut_arg_occs:alt_arg_occss) `delVarSet` bndr\n    bndr' = BoringBinder bndr\ntagSkeletonExpr (StgTick t e)\n  = (skel, arg_occs, StgTick t e')\n  where\n    (skel, arg_occs, e') = tagSkeletonExpr e\ntagSkeletonExpr (StgLet _ bind body) = tagSkeletonLet False body bind\ntagSkeletonExpr (StgLetNoEscape _ bind body) = tagSkeletonLet True body bind\n\nmkLet :: Bool -> Skeleton -> LlStgBinding -> LlStgExpr -> LlStgExpr\nmkLet True = StgLetNoEscape\nmkLet _    = StgLet\n\ntagSkeletonLet\n  :: Bool\n  -- ^ Is the binding a let-no-escape?\n  -> CgStgExpr\n  -- ^ Let body\n  -> CgStgBinding\n  -- ^ Binding group\n  -> (Skeleton, IdSet, LlStgExpr)\n  -- ^ RHS skeletons, argument occurrences and annotated binding\ntagSkeletonLet is_lne body bind\n  = (let_skel, arg_occs, mkLet is_lne scope bind' body')\n  where\n    (body_skel, body_arg_occs, body') = tagSkeletonExpr body\n    (let_skel, arg_occs, scope, bind')\n      = tagSkeletonBinding is_lne body_skel body_arg_occs bind\n\ntagSkeletonBinding\n  :: Bool\n  -- ^ Is the binding a let-no-escape?\n  -> Skeleton\n  -- ^ Let body skeleton\n  -> IdSet\n  -- ^ Argument occurrences in the body\n  -> CgStgBinding\n  -- ^ Binding group\n  -> (Skeleton, IdSet, Skeleton, LlStgBinding)\n  -- ^ Let skeleton, argument occurrences, scope skeleton of binding and\n  --   the annotated binding\ntagSkeletonBinding is_lne body_skel body_arg_occs (StgNonRec bndr rhs)\n  = (let_skel, arg_occs, scope, bind')\n  where\n    (rhs_skel, rhs_arg_occs, rhs') = tagSkeletonRhs bndr rhs\n    arg_occs = (body_arg_occs `unionVarSet` rhs_arg_occs) `delVarSet` bndr\n    bind_skel\n      | is_lne    = rhs_skel -- no closure is allocated for let-no-escapes\n      | otherwise = ClosureSk bndr (freeVarsOfRhs rhs) rhs_skel\n    let_skel = bothSk body_skel bind_skel\n    occurs_as_arg = bndr `elemVarSet` body_arg_occs\n    -- Compared to the recursive case, this exploits the fact that @bndr@ is\n    -- never free in @rhs@.\n    scope = body_skel\n    bind' = StgNonRec (BindsClosure bndr occurs_as_arg) rhs'\ntagSkeletonBinding is_lne body_skel body_arg_occs (StgRec pairs)\n  = (let_skel, arg_occs, scope, StgRec pairs')\n  where\n    (bndrs, _) = unzip pairs\n    -- Local recursive STG bindings also regard the defined binders as free\n    -- vars. We want to delete those for our cost model, as these are known\n    -- calls anyway when we add them to the same top-level recursive group as\n    -- the top-level binding currently being analysed.\n    skel_occs_rhss' = map (uncurry tagSkeletonRhs) pairs\n    rhss_arg_occs = map sndOf3 skel_occs_rhss'\n    scope_occs = unionVarSets (body_arg_occs:rhss_arg_occs)\n    arg_occs = scope_occs `delVarSetList` bndrs\n    -- @skel_rhss@ aren't yet wrapped in closures. We'll do that in a moment,\n    -- but we also need the un-wrapped skeletons for calculating the @scope@\n    -- of the group, as the outer closures don't contribute to closure growth\n    -- when we lift this specific binding.\n    scope = foldr (bothSk . fstOf3) body_skel skel_occs_rhss'\n    -- Now we can build the actual Skeleton for the expression just by\n    -- iterating over each bind pair.\n    (bind_skels, pairs') = unzip (zipWith single_bind bndrs skel_occs_rhss')\n    let_skel = foldr bothSk body_skel bind_skels\n    single_bind bndr (skel_rhs, _, rhs') = (bind_skel, (bndr', rhs'))\n      where\n        -- Here, we finally add the closure around each @skel_rhs@.\n        bind_skel\n          | is_lne    = skel_rhs -- no closure is allocated for let-no-escapes\n          | otherwise = ClosureSk bndr fvs skel_rhs\n        fvs = freeVarsOfRhs rhs' `dVarSetMinusVarSet` mkVarSet bndrs\n        bndr' = BindsClosure bndr (bndr `elemVarSet` scope_occs)\n\ntagSkeletonRhs :: Id -> CgStgRhs -> (Skeleton, IdSet, LlStgRhs)\ntagSkeletonRhs _ (StgRhsCon ccs dc args)\n  = (NilSk, mkArgOccs args, StgRhsCon ccs dc args)\ntagSkeletonRhs bndr (StgRhsClosure fvs ccs upd bndrs body)\n  = (rhs_skel, body_arg_occs, StgRhsClosure fvs ccs upd bndrs' body')\n  where\n    bndrs' = map BoringBinder bndrs\n    (body_skel, body_arg_occs, body') = tagSkeletonExpr body\n    rhs_skel = rhsSk (rhsDmdShell bndr) body_skel\n\n-- | How many times will the lambda body of the RHS bound to the given\n-- identifier be evaluated, relative to its defining context? This function\n-- computes the answer in form of a 'DmdShell'.\nrhsDmdShell :: Id -> DmdShell\nrhsDmdShell bndr\n  | is_thunk = oneifyDmd ds\n  | otherwise = peelManyCalls (idArity bndr) cd\n  where\n    is_thunk = idArity bndr == 0\n    -- Let's pray idDemandInfo is still OK after unarise...\n    (ds, cd) = toCleanDmd (idDemandInfo bndr)\n\ntagSkeletonAlt :: CgStgAlt -> (Skeleton, IdSet, LlStgAlt)\ntagSkeletonAlt (con, bndrs, rhs)\n  = (alt_skel, arg_occs, (con, map BoringBinder bndrs, rhs'))\n  where\n    (alt_skel, alt_arg_occs, rhs') = tagSkeletonExpr rhs\n    arg_occs = alt_arg_occs `delVarSetList` bndrs\n\n-- | Combines several heuristics to decide whether to lambda-lift a given\n-- @let@-binding to top-level. See \"StgLiftLams.Analysis#when\" for details.\ngoodToLift\n  :: DynFlags\n  -> TopLevelFlag\n  -> RecFlag\n  -> (DIdSet -> DIdSet) -- ^ An expander function, turning 'InId's into\n                        -- 'OutId's. See 'StgLiftLams.LiftM.liftedIdsExpander'.\n  -> [(BinderInfo, LlStgRhs)]\n  -> Skeleton\n  -> Maybe DIdSet       -- ^ @Just abs_ids@ <=> This binding is beneficial to\n                        -- lift and @abs_ids@ are the variables it would\n                        -- abstract over\ngoodToLift dflags top_lvl rec_flag expander pairs scope = decide\n  [ (\"top-level\", isTopLevel top_lvl) -- keep in sync with Note [When to lift]\n  , (\"memoized\", any_memoized)\n  , (\"argument occurrences\", arg_occs)\n  , (\"join point\", is_join_point)\n  , (\"abstracts join points\", abstracts_join_ids)\n  , (\"abstracts known local function\", abstracts_known_local_fun)\n  , (\"args spill on stack\", args_spill_on_stack)\n  , (\"increases allocation\", inc_allocs)\n  ] where\n      decide deciders\n        | not (fancy_or deciders)\n        = llTrace \"stgLiftLams:lifting\"\n                  (ppr bndrs <+> ppr abs_ids $$\n                   ppr allocs $$\n                   ppr scope) $\n          Just abs_ids\n        | otherwise\n        = Nothing\n      ppr_deciders = vcat . map (text . fst) . filter snd\n      fancy_or deciders\n        = llTrace \"stgLiftLams:goodToLift\" (ppr bndrs $$ ppr_deciders deciders) $\n          any snd deciders\n\n      bndrs = map (binderInfoBndr . fst) pairs\n      bndrs_set = mkVarSet bndrs\n      rhss = map snd pairs\n\n      -- First objective: Calculate @abs_ids@, e.g. the former free variables\n      -- the lifted binding would abstract over. We have to merge the free\n      -- variables of all RHS to get the set of variables that will have to be\n      -- passed through parameters.\n      fvs = unionDVarSets (map freeVarsOfRhs rhss)\n      -- To lift the binding to top-level, we want to delete the lifted binders\n      -- themselves from the free var set. Local let bindings track recursive\n      -- occurrences in their free variable set. We neither want to apply our\n      -- cost model to them (see 'tagSkeletonRhs'), nor pass them as parameters\n      -- when lifted, as these are known calls. We call the resulting set the\n      -- identifiers we abstract over, thus @abs_ids@. These are all 'OutId's.\n      -- We will save the set in 'LiftM.e_expansions' for each of the variables\n      -- if we perform the lift.\n      abs_ids = expander (delDVarSetList fvs bndrs)\n\n      -- We don't lift updatable thunks or constructors\n      any_memoized = any is_memoized_rhs rhss\n      is_memoized_rhs StgRhsCon{} = True\n      is_memoized_rhs (StgRhsClosure _ _ upd _ _) = isUpdatable upd\n\n      -- Don't lift binders occuring as arguments. This would result in complex\n      -- argument expressions which would have to be given a name, reintroducing\n      -- the very allocation at each call site that we wanted to get rid off in\n      -- the first place.\n      arg_occs = or (mapMaybe (binderInfoOccursAsArg . fst) pairs)\n\n      -- These don't allocate anyway.\n      is_join_point = any isJoinId bndrs\n\n      -- Abstracting over join points/let-no-escapes spoils them.\n      abstracts_join_ids = any isJoinId (dVarSetElems abs_ids)\n\n      -- Abstracting over known local functions that aren't floated themselves\n      -- turns a known, fast call into an unknown, slow call:\n      --\n      --    let f x = ...\n      --        g y = ... f x ... -- this was a known call\n      --    in g 4\n      --\n      -- After lifting @g@, but not @f@:\n      --\n      --    l_g f y = ... f y ... -- this is now an unknown call\n      --    let f x = ...\n      --    in l_g f 4\n      --\n      -- We can abuse the results of arity analysis for this:\n      -- idArity f > 0 ==> known\n      known_fun id = idArity id > 0\n      abstracts_known_local_fun\n        = not (liftLamsKnown dflags) && any known_fun (dVarSetElems abs_ids)\n\n      -- Number of arguments of a RHS in the current binding group if we decide\n      -- to lift it\n      n_args\n        = length\n        . StgCmmClosure.nonVoidIds -- void parameters don't appear in Cmm\n        . (dVarSetElems abs_ids ++)\n        . rhsLambdaBndrs\n      max_n_args\n        | isRec rec_flag = liftLamsRecArgs dflags\n        | otherwise      = liftLamsNonRecArgs dflags\n      -- We have 5 hardware registers on x86_64 to pass arguments in. Any excess\n      -- args are passed on the stack, which means slow memory accesses\n      args_spill_on_stack\n        | Just n <- max_n_args = maximum (map n_args rhss) > n\n        | otherwise = False\n\n      -- We only perform the lift if allocations didn't increase.\n      -- Note that @clo_growth@ will be 'infinity' if there was positive growth\n      -- under a multi-shot lambda.\n      -- Also, abstracting over LNEs is unacceptable. LNEs might return\n      -- unlifted tuples, which idClosureFootprint can't cope with.\n      inc_allocs = abstracts_join_ids || allocs > 0\n      allocs = clo_growth + mkIntWithInf (negate closuresSize)\n      -- We calculate and then add up the size of each binding's closure.\n      -- GHC does not currently share closure environments, and we either lift\n      -- the entire recursive binding group or none of it.\n      closuresSize = sum $ flip map rhss $ \\rhs ->\n        closureSize dflags\n        . dVarSetElems\n        . expander\n        . flip dVarSetMinusVarSet bndrs_set\n        $ freeVarsOfRhs rhs\n      clo_growth = closureGrowth expander (idClosureFootprint dflags) bndrs_set abs_ids scope\n\nrhsLambdaBndrs :: LlStgRhs -> [Id]\nrhsLambdaBndrs StgRhsCon{} = []\nrhsLambdaBndrs (StgRhsClosure _ _ _ bndrs _) = map binderInfoBndr bndrs\n\n-- | The size in words of a function closure closing over the given 'Id's,\n-- including the header.\nclosureSize :: DynFlags -> [Id] -> WordOff\nclosureSize dflags ids = words + sTD_HDR_SIZE dflags\n  -- We go through sTD_HDR_SIZE rather than fixedHdrSizeW so that we don't\n  -- optimise differently when profiling is enabled.\n  where\n    (words, _, _)\n      -- Functions have a StdHeader (as opposed to ThunkHeader).\n      = StgCmmLayout.mkVirtHeapOffsets dflags StgCmmLayout.StdHeader\n      . StgCmmClosure.addIdReps\n      . StgCmmClosure.nonVoidIds\n      $ ids\n\n-- | The number of words a single 'Id' adds to a closure's size.\n-- Note that this can't handle unboxed tuples (which may still be present in\n-- let-no-escapes, even after Unarise), in which case\n-- @'StgCmmClosure.idPrimRep'@ will crash.\nidClosureFootprint:: DynFlags -> Id -> WordOff\nidClosureFootprint dflags\n  = StgCmmArgRep.argRepSizeW dflags\n  . StgCmmArgRep.idArgRep\n\n-- | @closureGrowth expander sizer f fvs@ computes the closure growth in words\n-- as a result of lifting @f@ to top-level. If there was any growing closure\n-- under a multi-shot lambda, the result will be 'infinity'.\n-- Also see \"StgLiftLams.Analysis#clogro\".\nclosureGrowth\n  :: (DIdSet -> DIdSet)\n  -- ^ Expands outer free ids that were lifted to their free vars\n  -> (Id -> Int)\n  -- ^ Computes the closure footprint of an identifier\n  -> IdSet\n  -- ^ Binding group for which lifting is to be decided\n  -> DIdSet\n  -- ^ Free vars of the whole binding group prior to lifting it. These must be\n  --   available at call sites if we decide to lift the binding group.\n  -> Skeleton\n  -- ^ Abstraction of the scope of the function\n  -> IntWithInf\n  -- ^ Closure growth. 'infinity' indicates there was growth under a\n  --   (multi-shot) lambda.\nclosureGrowth expander sizer group abs_ids = go\n  where\n    go NilSk = 0\n    go (BothSk a b) = go a + go b\n    go (AltSk a b) = max (go a) (go b)\n    go (ClosureSk _ clo_fvs rhs)\n      -- If no binder of the @group@ occurs free in the closure, the lifting\n      -- won't have any effect on it and we can omit the recursive call.\n      | n_occs == 0 = 0\n      -- Otherwise, we account the cost of allocating the closure and add it to\n      -- the closure growth of its RHS.\n      | otherwise   = mkIntWithInf cost + go rhs\n      where\n        n_occs = sizeDVarSet (clo_fvs' `dVarSetIntersectVarSet` group)\n        -- What we close over considering prior lifting decisions\n        clo_fvs' = expander clo_fvs\n        -- Variables that would additionally occur free in the closure body if\n        -- we lift @f@\n        newbies = abs_ids `minusDVarSet` clo_fvs'\n        -- Lifting @f@ removes @f@ from the closure but adds all @newbies@\n        cost = foldDVarSet (\\id size -> sizer id + size) 0 newbies - n_occs\n    go (RhsSk body_dmd body)\n      -- The conservative assumption would be that\n      --   1. Every RHS with positive growth would be called multiple times,\n      --      modulo thunks.\n      --   2. Every RHS with negative growth wouldn't be called at all.\n      --\n      -- In the first case, we'd have to return 'infinity', while in the\n      -- second case, we'd have to return 0. But we can do far better\n      -- considering information from the demand analyser, which provides us\n      -- with conservative estimates on minimum and maximum evaluation\n      -- cardinality. The @body_dmd@ part of 'RhsSk' is the result of\n      -- 'rhsDmdShell' and accurately captures the cardinality of the RHSs body\n      -- relative to its defining context.\n      | isAbsDmd body_dmd   = 0\n      | cg <= 0             = if isStrictDmd body_dmd then cg else 0\n      | isUsedOnce body_dmd = cg\n      | otherwise           = infinity\n      where\n        cg = go body\n", "num_lines": 566}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- | Hides away distracting bookkeeping while lambda lifting into a 'LiftM'\n-- monad.\nmodule StgLiftLams.LiftM (\n    decomposeStgBinding, mkStgBinding,\n    Env (..),\n    -- * #floats# Handling floats\n    -- $floats\n    FloatLang (..), collectFloats, -- Exported just for the docs\n    -- * Transformation monad\n    LiftM, runLiftM, withCaffyness,\n    -- ** Adding bindings\n    startBindingGroup, endBindingGroup, addTopStringLit, addLiftedBinding,\n    -- ** Substitution and binders\n    withSubstBndr, withSubstBndrs, withLiftedBndr, withLiftedBndrs,\n    -- ** Occurrences\n    substOcc, isLifted, formerFreeVars, liftedIdsExpander\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BasicTypes\nimport CostCentre ( isCurrentCCS, dontCareCCS )\nimport DynFlags\nimport FastString\nimport Id\nimport IdInfo\nimport Name\nimport Outputable\nimport OrdList\nimport StgSubst\nimport StgSyn\nimport Type\nimport UniqSupply\nimport Util\nimport VarEnv\nimport VarSet\n\nimport Control.Arrow ( second )\nimport Control.Monad.Trans.Class\nimport Control.Monad.Trans.RWS.Strict ( RWST, runRWST )\nimport qualified Control.Monad.Trans.RWS.Strict as RWS\nimport Control.Monad.Trans.Cont ( ContT (..) )\nimport Data.ByteString ( ByteString )\n\n-- | @uncurry 'mkStgBinding' . 'decomposeStgBinding' = id@\ndecomposeStgBinding :: GenStgBinding pass -> (RecFlag, [(BinderP pass, GenStgRhs pass)])\ndecomposeStgBinding (StgRec pairs) = (Recursive, pairs)\ndecomposeStgBinding (StgNonRec bndr rhs) = (NonRecursive, [(bndr, rhs)])\n\nmkStgBinding :: RecFlag -> [(BinderP pass, GenStgRhs pass)] -> GenStgBinding pass\nmkStgBinding Recursive = StgRec\nmkStgBinding NonRecursive = uncurry StgNonRec . head\n\n-- | Environment threaded around in a scoped, @Reader@-like fashion.\ndata Env\n  = Env\n  { e_dflags     :: !DynFlags\n  -- ^ Read-only.\n  , e_subst      :: !Subst\n  -- ^ We need to track the renamings of local 'InId's to their lifted 'OutId',\n  -- because shadowing might make a closure's free variables unavailable at its\n  -- call sites. Consider:\n  -- @\n  --    let f y = x + y in let x = 4 in f x\n  -- @\n  -- Here, @f@ can't be lifted to top-level, because its free variable @x@ isn't\n  -- available at its call site.\n  , e_expansions :: !(IdEnv DIdSet)\n  -- ^ Lifted 'Id's don't occur as free variables in any closure anymore, because\n  -- they are bound at the top-level. Every occurrence must supply the formerly\n  -- free variables of the lifted 'Id', so they in turn become free variables of\n  -- the call sites. This environment tracks this expansion from lifted 'Id's to\n  -- their free variables.\n  --\n  -- 'InId's to 'OutId's.\n  --\n  -- Invariant: 'Id's not present in this map won't be substituted.\n  , e_in_caffy_context :: !Bool\n  -- ^ Are we currently analysing within a caffy context (e.g. the containing\n  -- top-level binder's 'idCafInfo' is 'MayHaveCafRefs')? If not, we can safely\n  -- assume that functions we lift out aren't caffy either.\n  }\n\nemptyEnv :: DynFlags -> Env\nemptyEnv dflags = Env dflags emptySubst emptyVarEnv False\n\n\n-- Note [Handling floats]\n-- ~~~~~~~~~~~~~~~~~~~~~~\n-- $floats\n-- Consider the following expression:\n--\n-- @\n--     f x =\n--       let g y = ... f y ...\n--       in g x\n-- @\n--\n-- What happens when we want to lift @g@? Normally, we'd put the lifted @l_g@\n-- binding above the binding for @f@:\n--\n-- @\n--     g f y = ... f y ...\n--     f x = g f x\n-- @\n--\n-- But this very unnecessarily turns a known call to @f@ into an unknown one, in\n-- addition to complicating matters for the analysis.\n-- Instead, we'd really like to put both functions in the same recursive group,\n-- thereby preserving the known call:\n--\n-- @\n--     Rec {\n--       g y = ... f y ...\n--       f x = g x\n--     }\n-- @\n--\n-- But we don't want this to happen for just /any/ binding. That would create\n-- possibly huge recursive groups in the process, calling for an occurrence\n-- analyser on STG.\n-- So, we need to track when we lift a binding out of a recursive RHS and add\n-- the binding to the same recursive group as the enclosing recursive binding\n-- (which must have either already been at the top-level or decided to be\n-- lifted itself in order to preserve the known call).\n--\n-- This is done by expressing this kind of nesting structure as a 'Writer' over\n-- @['FloatLang']@ and flattening this expression in 'runLiftM' by a call to\n-- 'collectFloats'.\n-- API-wise, the analysis will not need to know about the whole 'FloatLang'\n-- business and will just manipulate it indirectly through actions in 'LiftM'.\n\n-- | We need to detect when we are lifting something out of the RHS of a\n-- recursive binding (c.f. \"StgLiftLams.LiftM#floats\"), in which case that\n-- binding needs to be added to the same top-level recursive group. This\n-- requires we detect a certain nesting structure, which is encoded by\n-- 'StartBindingGroup' and 'EndBindingGroup'.\n--\n-- Although 'collectFloats' will only ever care if the current binding to be\n-- lifted (through 'LiftedBinding') will occur inside such a binding group or\n-- not, e.g. doesn't care about the nesting level as long as its greater than 0.\ndata FloatLang\n  = StartBindingGroup\n  | EndBindingGroup\n  | PlainTopBinding OutStgTopBinding\n  | LiftedBinding OutStgBinding\n\ninstance Outputable FloatLang where\n  ppr StartBindingGroup = char '('\n  ppr EndBindingGroup = char ')'\n  ppr (PlainTopBinding StgTopStringLit{}) = text \"<str>\"\n  ppr (PlainTopBinding (StgTopLifted b)) = ppr (LiftedBinding b)\n  ppr (LiftedBinding bind) = (if isRec rec then char 'r' else char 'n') <+> ppr (map fst pairs)\n    where\n      (rec, pairs) = decomposeStgBinding bind\n\n-- | Flattens an expression in @['FloatLang']@ into an STG program, see #floats.\n-- Important pre-conditions: The nesting of opening 'StartBindinGroup's and\n-- closing 'EndBindinGroup's is balanced. Also, it is crucial that every binding\n-- group has at least one recursive binding inside. Otherwise there's no point\n-- in announcing the binding group in the first place and an @ASSERT@ will\n-- trigger.\ncollectFloats :: [FloatLang] -> [OutStgTopBinding]\ncollectFloats = go (0 :: Int) []\n  where\n    go 0 [] [] = []\n    go _ _ [] = pprPanic \"collectFloats\" (text \"unterminated group\")\n    go n binds (f:rest) = case f of\n      StartBindingGroup -> go (n+1) binds rest\n      EndBindingGroup\n        | n == 0 -> pprPanic \"collectFloats\" (text \"no group to end\")\n        | n == 1 -> StgTopLifted (merge_binds binds) : go 0 [] rest\n        | otherwise -> go (n-1) binds rest\n      PlainTopBinding top_bind\n        | n == 0 -> top_bind : go n binds rest\n        | otherwise -> pprPanic \"collectFloats\" (text \"plain top binding inside group\")\n      LiftedBinding bind\n        | n == 0 -> StgTopLifted (rm_cccs bind) : go n binds rest\n        | otherwise -> go n (bind:binds) rest\n\n    map_rhss f = uncurry mkStgBinding . second (map (second f)) . decomposeStgBinding\n    rm_cccs = map_rhss removeRhsCCCS\n    merge_binds binds = ASSERT( any is_rec binds )\n                        StgRec (concatMap (snd . decomposeStgBinding . rm_cccs) binds)\n    is_rec StgRec{} = True\n    is_rec _ = False\n\n-- | Omitting this makes for strange closure allocation schemes that crash the\n-- GC.\nremoveRhsCCCS :: GenStgRhs pass -> GenStgRhs pass\nremoveRhsCCCS (StgRhsClosure ext ccs upd bndrs body)\n  | isCurrentCCS ccs\n  = StgRhsClosure ext dontCareCCS upd bndrs body\nremoveRhsCCCS (StgRhsCon ccs con args)\n  | isCurrentCCS ccs\n  = StgRhsCon dontCareCCS con args\nremoveRhsCCCS rhs = rhs\n\n-- | The analysis monad consists of the following 'RWST' components:\n--\n--     * 'Env': Reader-like context. Contains a substitution, info about how\n--       how lifted identifiers are to be expanded into applications and details\n--       such as 'DynFlags' and a flag helping with determining if a lifted\n--       binding is caffy.\n--\n--     * @'OrdList' 'FloatLang'@: Writer output for the resulting STG program.\n--\n--     * No pure state component\n--\n--     * But wrapping around 'UniqSM' for generating fresh lifted binders.\n--       (The @uniqAway@ approach could give the same name to two different\n--       lifted binders, so this is necessary.)\nnewtype LiftM a\n  = LiftM { unwrapLiftM :: RWST Env (OrdList FloatLang) () UniqSM a }\n  deriving (Functor, Applicative, Monad)\n\ninstance HasDynFlags LiftM where\n  getDynFlags = LiftM (RWS.asks e_dflags)\n\ninstance MonadUnique LiftM where\n  getUniqueSupplyM = LiftM (lift getUniqueSupplyM)\n  getUniqueM = LiftM (lift getUniqueM)\n  getUniquesM = LiftM (lift getUniquesM)\n\nrunLiftM :: DynFlags -> UniqSupply -> LiftM () -> [OutStgTopBinding]\nrunLiftM dflags us (LiftM m) = collectFloats (fromOL floats)\n  where\n    (_, _, floats) = initUs_ us (runRWST m (emptyEnv dflags) ())\n\n-- | Assumes a given caffyness for the execution of the passed action, which\n-- influences the 'cafInfo' of lifted bindings.\nwithCaffyness :: Bool -> LiftM a -> LiftM a\nwithCaffyness caffy action\n  = LiftM (RWS.local (\\e -> e { e_in_caffy_context = caffy }) (unwrapLiftM action))\n\n-- | Writes a plain 'StgTopStringLit' to the output.\naddTopStringLit :: OutId -> ByteString -> LiftM ()\naddTopStringLit id = LiftM . RWS.tell . unitOL . PlainTopBinding . StgTopStringLit id\n\n-- | Starts a recursive binding group. See #floats# and 'collectFloats'.\nstartBindingGroup :: LiftM ()\nstartBindingGroup = LiftM $ RWS.tell $ unitOL $ StartBindingGroup\n\n-- | Ends a recursive binding group. See #floats# and 'collectFloats'.\nendBindingGroup :: LiftM ()\nendBindingGroup = LiftM $ RWS.tell $ unitOL $ EndBindingGroup\n\n-- | Lifts a binding to top-level. Depending on whether it's declared inside\n-- a recursive RHS (see #floats# and 'collectFloats'), this might be added to\n-- an existing recursive top-level binding group.\naddLiftedBinding :: OutStgBinding -> LiftM ()\naddLiftedBinding = LiftM . RWS.tell . unitOL . LiftedBinding\n\n-- | Takes a binder and a continuation which is called with the substituted\n-- binder. The continuation will be evaluated in a 'LiftM' context in which that\n-- binder is deemed in scope. Think of it as a 'RWS.local' computation: After\n-- the continuation finishes, the new binding won't be in scope anymore.\nwithSubstBndr :: Id -> (Id -> LiftM a) -> LiftM a\nwithSubstBndr bndr inner = LiftM $ do\n  subst <- RWS.asks e_subst\n  let (bndr', subst') = substBndr bndr subst\n  RWS.local (\\e -> e { e_subst = subst' }) (unwrapLiftM (inner bndr'))\n\n-- | See 'withSubstBndr'.\nwithSubstBndrs :: Traversable f => f Id -> (f Id -> LiftM a) -> LiftM a\nwithSubstBndrs = runContT . traverse (ContT . withSubstBndr)\n\n-- | Similarly to 'withSubstBndr', this function takes a set of variables to\n-- abstract over, the binder to lift (and generate a fresh, substituted name\n-- for) and a continuation in which that fresh, lifted binder is in scope.\n--\n-- It takes care of all the details involved with copying and adjusting the\n-- binder, fresh name generation and caffyness.\nwithLiftedBndr :: DIdSet -> Id -> (Id -> LiftM a) -> LiftM a\nwithLiftedBndr abs_ids bndr inner = do\n  uniq <- getUniqueM\n  let str = \"$l\" ++ occNameString (getOccName bndr)\n  let ty = mkLamTypes (dVarSetElems abs_ids) (idType bndr)\n  -- When the enclosing top-level binding is not caffy, then the lifted\n  -- binding will not be caffy either. If we don't recognize this, non-caffy\n  -- things call caffy things and then codegen screws up.\n  in_caffy_ctxt <- LiftM (RWS.asks e_in_caffy_context)\n  let caf_info = if in_caffy_ctxt then MayHaveCafRefs else NoCafRefs\n  let bndr'\n        -- See Note [transferPolyIdInfo] in Id.hs. We need to do this at least\n        -- for arity information.\n        = transferPolyIdInfo bndr (dVarSetElems abs_ids)\n        -- Otherwise we confuse code gen if bndr was not caffy: the new bndr is\n        -- assumed to be caffy and will need an SRT. Transitive call sites might\n        -- not be caffy themselves and subsequently will miss a static link\n        -- field in their closure. Chaos ensues.\n        . flip setIdCafInfo caf_info\n        . mkSysLocalOrCoVar (mkFastString str) uniq\n        $ ty\n  LiftM $ RWS.local\n    (\\e -> e\n      { e_subst = extendSubst bndr bndr' $ extendInScope bndr' $ e_subst e\n      , e_expansions = extendVarEnv (e_expansions e) bndr abs_ids\n      })\n    (unwrapLiftM (inner bndr'))\n\n-- | See 'withLiftedBndr'.\nwithLiftedBndrs :: Traversable f => DIdSet -> f Id -> (f Id -> LiftM a) -> LiftM a\nwithLiftedBndrs abs_ids = runContT . traverse (ContT . withLiftedBndr abs_ids)\n\n-- | Substitutes a binder /occurrence/, which was brought in scope earlier by\n-- 'withSubstBndr'\\/'withLiftedBndr'.\nsubstOcc :: Id -> LiftM Id\nsubstOcc id = LiftM (RWS.asks (lookupIdSubst id . e_subst))\n\n-- | Whether the given binding was decided to be lambda lifted.\nisLifted :: InId -> LiftM Bool\nisLifted bndr = LiftM (RWS.asks (elemVarEnv bndr . e_expansions))\n\n-- | Returns an empty list for a binding that was not lifted and the list of all\n-- local variables the binding abstracts over (so, exactly the additional\n-- arguments at adjusted call sites) otherwise.\nformerFreeVars :: InId -> LiftM [OutId]\nformerFreeVars f = LiftM $ do\n  expansions <- RWS.asks e_expansions\n  pure $ case lookupVarEnv expansions f of\n    Nothing -> []\n    Just fvs -> dVarSetElems fvs\n\n-- | Creates an /expander function/ for the current set of lifted binders.\n-- This expander function will replace any 'InId' by their corresponding 'OutId'\n-- and, in addition, will expand any lifted binders by the former free variables\n-- it abstracts over.\nliftedIdsExpander :: LiftM (DIdSet -> DIdSet)\nliftedIdsExpander = LiftM $ do\n  expansions <- RWS.asks e_expansions\n  subst <- RWS.asks e_subst\n  -- We use @noWarnLookupIdSubst@ here in order to suppress \"not in scope\"\n  -- warnings generated by 'lookupIdSubst' due to local bindings within RHS.\n  -- These are not in the InScopeSet of @subst@ and extending the InScopeSet in\n  -- @goodToLift@/@closureGrowth@ before passing it on to @expander@ is too much\n  -- trouble.\n  let go set fv = case lookupVarEnv expansions fv of\n        Nothing -> extendDVarSet set (noWarnLookupIdSubst fv subst) -- Not lifted\n        Just fvs' -> unionDVarSet set fvs'\n  let expander fvs = foldl' go emptyDVarSet (dVarSetElems fvs)\n  pure expander\n", "num_lines": 349}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- | (Mostly) textbook instance of the lambda lifting transformation,\n-- selecting which bindings to lambda lift by consulting 'goodToLift'.\nmodule StgLiftLams.Transformation (stgLiftLams) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BasicTypes\nimport DynFlags\nimport Id\nimport IdInfo\nimport StgFVs ( annBindingFreeVars )\nimport StgLiftLams.Analysis\nimport StgLiftLams.LiftM\nimport StgSyn\nimport Outputable\nimport UniqSupply\nimport Util\nimport VarSet\nimport Control.Monad ( when )\nimport Data.Maybe ( isNothing )\n\n-- | Lambda lifts bindings to top-level deemed worth lifting (see 'goodToLift').\nstgLiftLams :: DynFlags -> UniqSupply -> [InStgTopBinding] -> [OutStgTopBinding]\nstgLiftLams dflags us = runLiftM dflags us . foldr liftTopLvl (pure ())\n\nliftTopLvl :: InStgTopBinding -> LiftM () -> LiftM ()\nliftTopLvl (StgTopStringLit bndr lit) rest = withSubstBndr bndr $ \\bndr' -> do\n  addTopStringLit bndr' lit\n  rest\nliftTopLvl (StgTopLifted bind) rest = do\n  let is_rec = isRec $ fst $ decomposeStgBinding bind\n  when is_rec startBindingGroup\n  let bind_w_fvs = annBindingFreeVars bind\n  withLiftedBind TopLevel (tagSkeletonTopBind bind_w_fvs) NilSk $ \\mb_bind' -> do\n    -- We signal lifting of a binding through returning Nothing.\n    -- Should never happen for a top-level binding, though, since we are already\n    -- at top-level.\n    case mb_bind' of\n      Nothing -> pprPanic \"StgLiftLams\" (text \"Lifted top-level binding\")\n      Just bind' -> addLiftedBinding bind'\n    when is_rec endBindingGroup\n    rest\n\nwithLiftedBind\n  :: TopLevelFlag\n  -> LlStgBinding\n  -> Skeleton\n  -> (Maybe OutStgBinding -> LiftM a)\n  -> LiftM a\nwithLiftedBind top_lvl bind scope k\n  | isTopLevel top_lvl\n  = withCaffyness (is_caffy pairs) go\n  | otherwise\n  = go\n  where\n    (rec, pairs) = decomposeStgBinding bind\n    is_caffy = any (mayHaveCafRefs . idCafInfo . binderInfoBndr . fst)\n    go = withLiftedBindPairs top_lvl rec pairs scope (k . fmap (mkStgBinding rec))\n\nwithLiftedBindPairs\n  :: TopLevelFlag\n  -> RecFlag\n  -> [(BinderInfo, LlStgRhs)]\n  -> Skeleton\n  -> (Maybe [(Id, OutStgRhs)] -> LiftM a)\n  -> LiftM a\nwithLiftedBindPairs top rec pairs scope k = do\n  let (infos, rhss) = unzip pairs\n  let bndrs = map binderInfoBndr infos\n  expander <- liftedIdsExpander\n  dflags <- getDynFlags\n  case goodToLift dflags top rec expander pairs scope of\n    -- @abs_ids@ is the set of all variables that need to become parameters.\n    Just abs_ids -> withLiftedBndrs abs_ids bndrs $ \\bndrs' -> do\n      -- Within this block, all binders in @bndrs@ will be noted as lifted, so\n      -- that the return value of @liftedIdsExpander@ in this context will also\n      -- expand the bindings in @bndrs@ to their free variables.\n      -- Now we can recurse into the RHSs and see if we can lift any further\n      -- bindings. We pass the set of expanded free variables (thus OutIds) on\n      -- to @liftRhs@ so that it can add them as parameter binders.\n      when (isRec rec) startBindingGroup\n      rhss' <- traverse (liftRhs (Just abs_ids)) rhss\n      let pairs' = zip bndrs' rhss'\n      addLiftedBinding (mkStgBinding rec pairs')\n      when (isRec rec) endBindingGroup\n      k Nothing\n    Nothing -> withSubstBndrs bndrs $ \\bndrs' -> do\n      -- Don't lift the current binding, but possibly some bindings in their\n      -- RHSs.\n      rhss' <- traverse (liftRhs Nothing) rhss\n      let pairs' = zip bndrs' rhss'\n      k (Just pairs')\n\nliftRhs\n  :: Maybe (DIdSet)\n  -- ^ @Just former_fvs@ <=> this RHS was lifted and we have to add @former_fvs@\n  -- as lambda binders, discarding all free vars.\n  -> LlStgRhs\n  -> LiftM OutStgRhs\nliftRhs mb_former_fvs rhs@(StgRhsCon ccs con args)\n  = ASSERT2(isNothing mb_former_fvs, text \"Should never lift a constructor\" $$ ppr rhs)\n    StgRhsCon ccs con <$> traverse liftArgs args\nliftRhs Nothing (StgRhsClosure _ ccs upd infos body) = do\n  -- This RHS wasn't lifted.\n  withSubstBndrs (map binderInfoBndr infos) $ \\bndrs' ->\n    StgRhsClosure noExtSilent ccs upd bndrs' <$> liftExpr body\nliftRhs (Just former_fvs) (StgRhsClosure _ ccs upd infos body) = do\n  -- This RHS was lifted. Insert extra binders for @former_fvs@.\n  withSubstBndrs (map binderInfoBndr infos) $ \\bndrs' -> do\n    let bndrs'' = dVarSetElems former_fvs ++ bndrs'\n    StgRhsClosure noExtSilent ccs upd bndrs'' <$> liftExpr body\n\nliftArgs :: InStgArg -> LiftM OutStgArg\nliftArgs a@(StgLitArg _) = pure a\nliftArgs (StgVarArg occ) = do\n  ASSERTM2( not <$> isLifted occ, text \"StgArgs should never be lifted\" $$ ppr occ )\n  StgVarArg <$> substOcc occ\n\nliftExpr :: LlStgExpr -> LiftM OutStgExpr\nliftExpr (StgLit lit) = pure (StgLit lit)\nliftExpr (StgTick t e) = StgTick t <$> liftExpr e\nliftExpr (StgApp f args) = do\n  f' <- substOcc f\n  args' <- traverse liftArgs args\n  fvs' <- formerFreeVars f\n  let top_lvl_args = map StgVarArg fvs' ++ args'\n  pure (StgApp f' top_lvl_args)\nliftExpr (StgConApp con args tys) = StgConApp con <$> traverse liftArgs args <*> pure tys\nliftExpr (StgOpApp op args ty) = StgOpApp op <$> traverse liftArgs args <*> pure ty\nliftExpr (StgLam _ _) = pprPanic \"stgLiftLams\" (text \"StgLam\")\nliftExpr (StgCase scrut info ty alts) = do\n  scrut' <- liftExpr scrut\n  withSubstBndr (binderInfoBndr info) $ \\bndr' -> do\n    alts' <- traverse liftAlt alts\n    pure (StgCase scrut' bndr' ty alts')\nliftExpr (StgLet scope bind body)\n  = withLiftedBind NotTopLevel bind scope $ \\mb_bind' -> do\n      body' <- liftExpr body\n      case mb_bind' of\n        Nothing -> pure body' -- withLiftedBindPairs decided to lift it and already added floats\n        Just bind' -> pure (StgLet noExtSilent bind' body')\nliftExpr (StgLetNoEscape scope bind body)\n  = withLiftedBind NotTopLevel bind scope $ \\mb_bind' -> do\n      body' <- liftExpr body\n      case mb_bind' of\n        Nothing -> pprPanic \"stgLiftLams\" (text \"Should never decide to lift LNEs\")\n        Just bind' -> pure (StgLetNoEscape noExtSilent bind' body')\n\nliftAlt :: LlStgAlt -> LiftM OutStgAlt\nliftAlt (con, infos, rhs) = withSubstBndrs (map binderInfoBndr infos) $ \\bndrs' ->\n  (,,) con bndrs' <$> liftExpr rhs\n", "num_lines": 156}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[CoreRules]{Transformation rules}\n-}\n\n{-# LANGUAGE CPP #-}\n\n-- | Functions for collecting together and applying rewrite rules to a module.\n-- The 'CoreRule' datatype itself is declared elsewhere.\nmodule Rules (\n        -- ** Constructing\n        emptyRuleBase, mkRuleBase, extendRuleBaseList,\n        unionRuleBase, pprRuleBase,\n\n        -- ** Checking rule applications\n        ruleCheckProgram,\n\n        -- ** Manipulating 'RuleInfo' rules\n        mkRuleInfo, extendRuleInfo, addRuleInfo,\n        addIdSpecialisations,\n\n        -- * Misc. CoreRule helpers\n        rulesOfBinds, getRules, pprRulesForUser,\n\n        lookupRule, mkRule, roughTopNames\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn          -- All of it\nimport Module           ( Module, ModuleSet, elemModuleSet )\nimport CoreSubst\nimport CoreOpt          ( exprIsLambda_maybe )\nimport CoreFVs          ( exprFreeVars, exprsFreeVars, bindFreeVars\n                        , rulesFreeVarsDSet, exprsOrphNames, exprFreeVarsList )\nimport CoreUtils        ( exprType, eqExpr, mkTick, mkTicks,\n                          stripTicksTopT, stripTicksTopE,\n                          isJoinBind )\nimport PprCore          ( pprRules )\nimport Type             ( Type, Kind, substTy, mkTCvSubst )\nimport TcType           ( tcSplitTyConApp_maybe )\nimport TysWiredIn       ( anyTypeOfKind )\nimport Coercion\nimport CoreTidy         ( tidyRules )\nimport Id\nimport IdInfo           ( RuleInfo( RuleInfo ) )\nimport Var\nimport VarEnv\nimport VarSet\nimport Name             ( Name, NamedThing(..), nameIsLocalOrFrom )\nimport NameSet\nimport NameEnv\nimport UniqFM\nimport Unify            ( ruleMatchTyKiX )\nimport BasicTypes\nimport DynFlags         ( DynFlags )\nimport Outputable\nimport FastString\nimport Maybes\nimport Bag\nimport Util\nimport Data.List\nimport Data.Ord\nimport Control.Monad    ( guard )\n\n{-\nNote [Overall plumbing for rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* After the desugarer:\n   - The ModGuts initially contains mg_rules :: [CoreRule] of\n     locally-declared rules for imported Ids.\n   - Locally-declared rules for locally-declared Ids are attached to\n     the IdInfo for that Id.  See Note [Attach rules to local ids] in\n     DsBinds\n\n* TidyPgm strips off all the rules from local Ids and adds them to\n  mg_rules, so that the ModGuts has *all* the locally-declared rules.\n\n* The HomePackageTable contains a ModDetails for each home package\n  module.  Each contains md_rules :: [CoreRule] of rules declared in\n  that module.  The HomePackageTable grows as ghc --make does its\n  up-sweep.  In batch mode (ghc -c), the HPT is empty; all imported modules\n  are treated by the \"external\" route, discussed next, regardless of\n  which package they come from.\n\n* The ExternalPackageState has a single eps_rule_base :: RuleBase for\n  Ids in other packages.  This RuleBase simply grow monotonically, as\n  ghc --make compiles one module after another.\n\n  During simplification, interface files may get demand-loaded,\n  as the simplifier explores the unfoldings for Ids it has in\n  its hand.  (Via an unsafePerformIO; the EPS is really a cache.)\n  That in turn may make the EPS rule-base grow.  In contrast, the\n  HPT never grows in this way.\n\n* The result of all this is that during Core-to-Core optimisation\n  there are four sources of rules:\n\n    (a) Rules in the IdInfo of the Id they are a rule for.  These are\n        easy: fast to look up, and if you apply a substitution then\n        it'll be applied to the IdInfo as a matter of course.\n\n    (b) Rules declared in this module for imported Ids, kept in the\n        ModGuts. If you do a substitution, you'd better apply the\n        substitution to these.  There are seldom many of these.\n\n    (c) Rules declared in the HomePackageTable.  These never change.\n\n    (d) Rules in the ExternalPackageTable. These can grow in response\n        to lazy demand-loading of interfaces.\n\n* At the moment (c) is carried in a reader-monad way by the CoreMonad.\n  The HomePackageTable doesn't have a single RuleBase because technically\n  we should only be able to \"see\" rules \"below\" this module; so we\n  generate a RuleBase for (c) by combing rules from all the modules\n  \"below\" us.  That's why we can't just select the home-package RuleBase\n  from HscEnv.\n\n  [NB: we are inconsistent here.  We should do the same for external\n  packages, but we don't.  Same for type-class instances.]\n\n* So in the outer simplifier loop, we combine (b-d) into a single\n  RuleBase, reading\n     (b) from the ModGuts,\n     (c) from the CoreMonad, and\n     (d) from its mutable variable\n  [Of coures this means that we won't see new EPS rules that come in\n  during a single simplifier iteration, but that probably does not\n  matter.]\n\n\n************************************************************************\n*                                                                      *\n\\subsection[specialisation-IdInfo]{Specialisation info about an @Id@}\n*                                                                      *\n************************************************************************\n\nA @CoreRule@ holds details of one rule for an @Id@, which\nincludes its specialisations.\n\nFor example, if a rule for @f@ contains the mapping:\n\\begin{verbatim}\n        forall a b d. [Type (List a), Type b, Var d]  ===>  f' a b\n\\end{verbatim}\nthen when we find an application of f to matching types, we simply replace\nit by the matching RHS:\n\\begin{verbatim}\n        f (List Int) Bool dict ===>  f' Int Bool\n\\end{verbatim}\nAll the stuff about how many dictionaries to discard, and what types\nto apply the specialised function to, are handled by the fact that the\nRule contains a template for the result of the specialisation.\n\nThere is one more exciting case, which is dealt with in exactly the same\nway.  If the specialised value is unboxed then it is lifted at its\ndefinition site and unlifted at its uses.  For example:\n\n        pi :: forall a. Num a => a\n\nmight have a specialisation\n\n        [Int#] ===>  (case pi' of Lift pi# -> pi#)\n\nwhere pi' :: Lift Int# is the specialised version of pi.\n-}\n\nmkRule :: Module -> Bool -> Bool -> RuleName -> Activation\n       -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule\n-- ^ Used to make 'CoreRule' for an 'Id' defined in the module being\n-- compiled. See also 'CoreSyn.CoreRule'\nmkRule this_mod is_auto is_local name act fn bndrs args rhs\n  = Rule { ru_name = name, ru_fn = fn, ru_act = act,\n           ru_bndrs = bndrs, ru_args = args,\n           ru_rhs = rhs,\n           ru_rough = roughTopNames args,\n           ru_origin = this_mod,\n           ru_orphan = orph,\n           ru_auto = is_auto, ru_local = is_local }\n  where\n        -- Compute orphanhood.  See Note [Orphans] in InstEnv\n        -- A rule is an orphan only if none of the variables\n        -- mentioned on its left-hand side are locally defined\n    lhs_names = extendNameSet (exprsOrphNames args) fn\n\n        -- Since rules get eventually attached to one of the free names\n        -- from the definition when compiling the ABI hash, we should make\n        -- it deterministic. This chooses the one with minimal OccName\n        -- as opposed to uniq value.\n    local_lhs_names = filterNameSet (nameIsLocalOrFrom this_mod) lhs_names\n    orph = chooseOrphanAnchor local_lhs_names\n\n--------------\nroughTopNames :: [CoreExpr] -> [Maybe Name]\n-- ^ Find the \\\"top\\\" free names of several expressions.\n-- Such names are either:\n--\n-- 1. The function finally being applied to in an application chain\n--    (if that name is a GlobalId: see \"Var#globalvslocal\"), or\n--\n-- 2. The 'TyCon' if the expression is a 'Type'\n--\n-- This is used for the fast-match-check for rules;\n--      if the top names don't match, the rest can't\nroughTopNames args = map roughTopName args\n\nroughTopName :: CoreExpr -> Maybe Name\nroughTopName (Type ty) = case tcSplitTyConApp_maybe ty of\n                               Just (tc,_) -> Just (getName tc)\n                               Nothing     -> Nothing\nroughTopName (Coercion _) = Nothing\nroughTopName (App f _) = roughTopName f\nroughTopName (Var f)   | isGlobalId f   -- Note [Care with roughTopName]\n                       , isDataConWorkId f || idArity f > 0\n                       = Just (idName f)\nroughTopName (Tick t e) | tickishFloatable t\n                        = roughTopName e\nroughTopName _ = Nothing\n\nruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool\n-- ^ @ruleCantMatch tpl actual@ returns True only if @actual@\n-- definitely can't match @tpl@ by instantiating @tpl@.\n-- It's only a one-way match; unlike instance matching we\n-- don't consider unification.\n--\n-- Notice that [_$_]\n--      @ruleCantMatch [Nothing] [Just n2] = False@\n--      Reason: a template variable can be instantiated by a constant\n-- Also:\n--      @ruleCantMatch [Just n1] [Nothing] = False@\n--      Reason: a local variable @v@ in the actuals might [_$_]\n\nruleCantMatch (Just n1 : ts) (Just n2 : as) = n1 /= n2 || ruleCantMatch ts as\nruleCantMatch (_       : ts) (_       : as) = ruleCantMatch ts as\nruleCantMatch _              _              = False\n\n{-\nNote [Care with roughTopName]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n    module M where { x = a:b }\n    module N where { ...f x...\n                     RULE f (p:q) = ... }\nYou'd expect the rule to match, because the matcher can\nlook through the unfolding of 'x'.  So we must avoid roughTopName\nreturning 'M.x' for the call (f x), or else it'll say \"can't match\"\nand we won't even try!!\n\nHowever, suppose we have\n         RULE g (M.h x) = ...\n         foo = ...(g (M.k v))....\nwhere k is a *function* exported by M.  We never really match\nfunctions (lambdas) except by name, so in this case it seems like\na good idea to treat 'M.k' as a roughTopName of the call.\n-}\n\npprRulesForUser :: DynFlags -> [CoreRule] -> SDoc\n-- (a) tidy the rules\n-- (b) sort them into order based on the rule name\n-- (c) suppress uniques (unless -dppr-debug is on)\n-- This combination makes the output stable so we can use in testing\n-- It's here rather than in PprCore because it calls tidyRules\npprRulesForUser dflags rules\n  = withPprStyle (defaultUserStyle dflags) $\n    pprRules $\n    sortBy (comparing ruleName) $\n    tidyRules emptyTidyEnv rules\n\n{-\n************************************************************************\n*                                                                      *\n                RuleInfo: the rules in an IdInfo\n*                                                                      *\n************************************************************************\n-}\n\n-- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable\n-- for putting into an 'IdInfo'\nmkRuleInfo :: [CoreRule] -> RuleInfo\nmkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet rules)\n\nextendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo\nextendRuleInfo (RuleInfo rs1 fvs1) rs2\n  = RuleInfo (rs2 ++ rs1) (rulesFreeVarsDSet rs2 `unionDVarSet` fvs1)\n\naddRuleInfo :: RuleInfo -> RuleInfo -> RuleInfo\naddRuleInfo (RuleInfo rs1 fvs1) (RuleInfo rs2 fvs2)\n  = RuleInfo (rs1 ++ rs2) (fvs1 `unionDVarSet` fvs2)\n\naddIdSpecialisations :: Id -> [CoreRule] -> Id\naddIdSpecialisations id rules\n  | null rules\n  = id\n  | otherwise\n  = setIdSpecialisation id $\n    extendRuleInfo (idSpecialisation id) rules\n\n-- | Gather all the rules for locally bound identifiers from the supplied bindings\nrulesOfBinds :: [CoreBind] -> [CoreRule]\nrulesOfBinds binds = concatMap (concatMap idCoreRules . bindersOf) binds\n\ngetRules :: RuleEnv -> Id -> [CoreRule]\n-- See Note [Where rules are found]\ngetRules (RuleEnv { re_base = rule_base, re_visible_orphs = orphs }) fn\n  = idCoreRules fn ++ filter (ruleIsVisible orphs) imp_rules\n  where\n    imp_rules = lookupNameEnv rule_base (idName fn) `orElse` []\n\nruleIsVisible :: ModuleSet -> CoreRule -> Bool\nruleIsVisible _ BuiltinRule{} = True\nruleIsVisible vis_orphs Rule { ru_orphan = orph, ru_origin = origin }\n    = notOrphan orph || origin `elemModuleSet` vis_orphs\n\n{- Note [Where rules are found]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe rules for an Id come from two places:\n  (a) the ones it is born with, stored inside the Id iself (idCoreRules fn),\n  (b) rules added in other modules, stored in the global RuleBase (imp_rules)\n\nIt's tempting to think that\n     - LocalIds have only (a)\n     - non-LocalIds have only (b)\n\nbut that isn't quite right:\n\n     - PrimOps and ClassOps are born with a bunch of rules inside the Id,\n       even when they are imported\n\n     - The rules in PrelRules.builtinRules should be active even\n       in the module defining the Id (when it's a LocalId), but\n       the rules are kept in the global RuleBase\n\n\n************************************************************************\n*                                                                      *\n                RuleBase\n*                                                                      *\n************************************************************************\n-}\n\n-- RuleBase itself is defined in CoreSyn, along with CoreRule\n\nemptyRuleBase :: RuleBase\nemptyRuleBase = emptyNameEnv\n\nmkRuleBase :: [CoreRule] -> RuleBase\nmkRuleBase rules = extendRuleBaseList emptyRuleBase rules\n\nextendRuleBaseList :: RuleBase -> [CoreRule] -> RuleBase\nextendRuleBaseList rule_base new_guys\n  = foldl' extendRuleBase rule_base new_guys\n\nunionRuleBase :: RuleBase -> RuleBase -> RuleBase\nunionRuleBase rb1 rb2 = plusNameEnv_C (++) rb1 rb2\n\nextendRuleBase :: RuleBase -> CoreRule -> RuleBase\nextendRuleBase rule_base rule\n  = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule\n\npprRuleBase :: RuleBase -> SDoc\npprRuleBase rules = pprUFM rules $ \\rss ->\n  vcat [ pprRules (tidyRules emptyTidyEnv rs)\n       | rs <- rss ]\n\n{-\n************************************************************************\n*                                                                      *\n                        Matching\n*                                                                      *\n************************************************************************\n-}\n\n-- | The main rule matching function. Attempts to apply all (active)\n-- supplied rules to this instance of an application in a given\n-- context, returning the rule applied and the resulting expression if\n-- successful.\nlookupRule :: DynFlags -> InScopeEnv\n           -> (Activation -> Bool)      -- When rule is active\n           -> Id -> [CoreExpr]\n           -> [CoreRule] -> Maybe (CoreRule, CoreExpr)\n\n-- See Note [Extra args in rule matching]\n-- See comments on matchRule\nlookupRule dflags in_scope is_active fn args rules\n  = -- pprTrace \"matchRules\" (ppr fn <+> ppr args $$ ppr rules ) $\n    case go [] rules of\n        []     -> Nothing\n        (m:ms) -> Just (findBest (fn,args') m ms)\n  where\n    rough_args = map roughTopName args\n\n    -- Strip ticks from arguments, see note [Tick annotations in RULE\n    -- matching]. We only collect ticks if a rule actually matches -\n    -- this matters for performance tests.\n    args' = map (stripTicksTopE tickishFloatable) args\n    ticks = concatMap (stripTicksTopT tickishFloatable) args\n\n    go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)]\n    go ms [] = ms\n    go ms (r:rs)\n      | Just e <- matchRule dflags in_scope is_active fn args' rough_args r\n      = go ((r,mkTicks ticks e):ms) rs\n      | otherwise\n      = -- pprTrace \"match failed\" (ppr r $$ ppr args $$\n        --   ppr [ (arg_id, unfoldingTemplate unf)\n        --       | Var arg_id <- args\n        --       , let unf = idUnfolding arg_id\n        --       , isCheapUnfolding unf] )\n        go ms rs\n\nfindBest :: (Id, [CoreExpr])\n         -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr)\n-- All these pairs matched the expression\n-- Return the pair the most specific rule\n-- The (fn,args) is just for overlap reporting\n\nfindBest _      (rule,ans)   [] = (rule,ans)\nfindBest target (rule1,ans1) ((rule2,ans2):prs)\n  | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs\n  | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs\n  | debugIsOn = let pp_rule rule\n                      = ifPprDebug (ppr rule)\n                                   (doubleQuotes (ftext (ruleName rule)))\n                in pprTrace \"Rules.findBest: rule overlap (Rule 1 wins)\"\n                         (vcat [ whenPprDebug $\n                                 text \"Expression to match:\" <+> ppr fn\n                                 <+> sep (map ppr args)\n                               , text \"Rule 1:\" <+> pp_rule rule1\n                               , text \"Rule 2:\" <+> pp_rule rule2]) $\n                findBest target (rule1,ans1) prs\n  | otherwise = findBest target (rule1,ans1) prs\n  where\n    (fn,args) = target\n\nisMoreSpecific :: CoreRule -> CoreRule -> Bool\n-- This tests if one rule is more specific than another\n-- We take the view that a BuiltinRule is less specific than\n-- anything else, because we want user-define rules to \"win\"\n-- In particular, class ops have a built-in rule, but we\n-- any user-specific rules to win\n--   eg (Trac #4397)\n--      truncate :: (RealFrac a, Integral b) => a -> b\n--      {-# RULES \"truncate/Double->Int\" truncate = double2Int #-}\n--      double2Int :: Double -> Int\n--   We want the specific RULE to beat the built-in class-op rule\nisMoreSpecific (BuiltinRule {}) _                = False\nisMoreSpecific (Rule {})        (BuiltinRule {}) = True\nisMoreSpecific (Rule { ru_bndrs = bndrs1, ru_args = args1 })\n               (Rule { ru_bndrs = bndrs2, ru_args = args2, ru_name = rule_name2 })\n  = isJust (matchN (in_scope, id_unfolding_fun) rule_name2 bndrs2 args2 args1)\n  where\n   id_unfolding_fun _ = NoUnfolding     -- Don't expand in templates\n   in_scope = mkInScopeSet (mkVarSet bndrs1)\n        -- Actually we should probably include the free vars\n        -- of rule1's args, but I can't be bothered\n\nnoBlackList :: Activation -> Bool\nnoBlackList _ = False           -- Nothing is black listed\n\n{-\nNote [Extra args in rule matching]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we find a matching rule, we return (Just (rule, rhs)),\nbut the rule firing has only consumed as many of the input args\nas the ruleArity says.  It's up to the caller to keep track\nof any left-over args.  E.g. if you call\n        lookupRule ... f [e1, e2, e3]\nand it returns Just (r, rhs), where r has ruleArity 2\nthen the real rewrite is\n        f e1 e2 e3 ==> rhs e3\n\nYou might think it'd be cleaner for lookupRule to deal with the\nleftover arguments, by applying 'rhs' to them, but the main call\nin the Simplifier works better as it is.  Reason: the 'args' passed\nto lookupRule are the result of a lazy substitution\n-}\n\n------------------------------------\nmatchRule :: DynFlags -> InScopeEnv -> (Activation -> Bool)\n          -> Id -> [CoreExpr] -> [Maybe Name]\n          -> CoreRule -> Maybe CoreExpr\n\n-- If (matchRule rule args) returns Just (name,rhs)\n-- then (f args) matches the rule, and the corresponding\n-- rewritten RHS is rhs\n--\n-- The returned expression is occurrence-analysed\n--\n--      Example\n--\n-- The rule\n--      forall f g x. map f (map g x) ==> map (f . g) x\n-- is stored\n--      CoreRule \"map/map\"\n--               [f,g,x]                -- tpl_vars\n--               [f,map g x]            -- tpl_args\n--               map (f.g) x)           -- rhs\n--\n-- Then the call: matchRule the_rule [e1,map e2 e3]\n--        = Just (\"map/map\", (\\f,g,x -> rhs) e1 e2 e3)\n--\n-- Any 'surplus' arguments in the input are simply put on the end\n-- of the output.\n\nmatchRule dflags rule_env _is_active fn args _rough_args\n          (BuiltinRule { ru_try = match_fn })\n-- Built-in rules can't be switched off, it seems\n  = case match_fn dflags rule_env fn args of\n        Nothing   -> Nothing\n        Just expr -> Just expr\n\nmatchRule _ in_scope is_active _ args rough_args\n          (Rule { ru_name = rule_name, ru_act = act, ru_rough = tpl_tops\n                , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs })\n  | not (is_active act)               = Nothing\n  | ruleCantMatch tpl_tops rough_args = Nothing\n  | otherwise\n  = case matchN in_scope rule_name tpl_vars tpl_args args of\n        Nothing                       -> Nothing\n        Just (bind_wrapper, tpl_vals) -> Just (bind_wrapper $\n                                               rule_fn `mkApps` tpl_vals)\n  where\n    rule_fn = mkLams tpl_vars rhs\n\n---------------------------------------\nmatchN  :: InScopeEnv\n        -> RuleName -> [Var] -> [CoreExpr]\n        -> [CoreExpr]           -- ^ Target; can have more elements than the template\n        -> Maybe (BindWrapper,  -- Floated bindings; see Note [Matching lets]\n                  [CoreExpr])\n-- For a given match template and context, find bindings to wrap around\n-- the entire result and what should be substituted for each template variable.\n-- Fail if there are two few actual arguments from the target to match the template\n\nmatchN (in_scope, id_unf) rule_name tmpl_vars tmpl_es target_es\n  = do  { subst <- go init_menv emptyRuleSubst tmpl_es target_es\n        ; let (_, matched_es) = mapAccumL lookup_tmpl subst $\n                                tmpl_vars `zip` tmpl_vars1\n        ; return (rs_binds subst, matched_es) }\n  where\n    (init_rn_env, tmpl_vars1) = mapAccumL rnBndrL (mkRnEnv2 in_scope) tmpl_vars\n                  -- See Note [Cloning the template binders]\n\n    init_menv = RV { rv_tmpls = mkVarSet tmpl_vars1\n                   , rv_lcl   = init_rn_env\n                   , rv_fltR  = mkEmptySubst (rnInScopeSet init_rn_env)\n                   , rv_unf   = id_unf }\n\n    go _    subst []     _      = Just subst\n    go _    _     _      []     = Nothing       -- Fail if too few actual args\n    go menv subst (t:ts) (e:es) = do { subst1 <- match menv subst t e\n                                     ; go menv subst1 ts es }\n\n    lookup_tmpl :: RuleSubst -> (InVar,OutVar) -> (RuleSubst, CoreExpr)\n                   -- Need to return a RuleSubst solely for the benefit of mk_fake_ty\n    lookup_tmpl rs@(RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst })\n                (tmpl_var, tmpl_var1)\n        | isId tmpl_var1\n        = case lookupVarEnv id_subst tmpl_var1 of\n             Just e -> (rs, e)\n             Nothing | Just refl_co <- isReflCoVar_maybe tmpl_var1\n                     , let co_expr   = Coercion refl_co\n                           id_subst' = extendVarEnv id_subst tmpl_var1 co_expr\n                           rs'       = rs { rs_id_subst = id_subst' }\n                     -> (rs', co_expr) -- See Note [Unbound RULE binders]\n                     | otherwise\n                     -> unbound tmpl_var\n        | otherwise\n        = case lookupVarEnv tv_subst tmpl_var1 of\n             Just ty -> (rs, Type ty)\n             Nothing -> (rs', Type fake_ty) -- See Note [Unbound RULE binders]\n        where\n          rs'     = rs { rs_tv_subst = extendVarEnv tv_subst tmpl_var1 fake_ty }\n          fake_ty = mk_fake_ty in_scope rs tmpl_var1\n                    -- This call is the sole reason we accumulate\n                    -- RuleSubst in lookup_tmpl\n\n    unbound tmpl_var\n       = pprPanic \"Template variable unbound in rewrite rule\" $\n         vcat [ text \"Variable:\" <+> ppr tmpl_var <+> dcolon <+> ppr (varType tmpl_var)\n              , text \"Rule\" <+> pprRuleName rule_name\n              , text \"Rule bndrs:\" <+> ppr tmpl_vars\n              , text \"LHS args:\" <+> ppr tmpl_es\n              , text \"Actual args:\" <+> ppr target_es ]\n\n\nmk_fake_ty :: InScopeSet -> RuleSubst -> TyVar -> Kind\n-- Roughly:\n--    mk_fake_ty subst tv = Any @(subst (tyVarKind tv))\n-- That is: apply the substitution to the kind of the given tyvar,\n-- and make an 'any' type of that kind.\n-- Tiresomely, the RuleSubst is not well adapted to substTy, leading to\n-- horrible impedence matching.\n--\n-- Happily, this function is seldom called\nmk_fake_ty in_scope (RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst }) tmpl_var1\n  = anyTypeOfKind kind\n  where\n    kind = Type.substTy (mkTCvSubst in_scope (tv_subst, cv_subst))\n                        (tyVarKind tmpl_var1)\n\n    cv_subst = to_co_env id_subst\n\n    to_co_env :: IdSubstEnv -> CvSubstEnv\n    to_co_env env = nonDetFoldUFM_Directly to_co emptyVarEnv env\n      -- It's OK to use nonDetFoldUFM_Directly because we forget the\n      -- order immediately by creating a new env\n\n    to_co uniq expr env\n      = case exprToCoercion_maybe expr of\n          Just co -> extendVarEnv_Directly env uniq co\n          Nothing -> env\n\n{- Note [Unbound RULE binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt can be the case that the binder in a rule is not actually\nbound on the LHS:\n\n* Type variables.  Type synonyms with phantom args can give rise to\n  unbound template type variables.  Consider this (Trac #10689,\n  simplCore/should_compile/T10689):\n\n    type Foo a b = b\n\n    f :: Eq a => a -> Bool\n    f x = x==x\n\n    {-# RULES \"foo\" forall (x :: Foo a Char). f x = True #-}\n    finkle = f 'c'\n\n  The rule looks like\n    forall (a::*) (d::Eq Char) (x :: Foo a Char).\n         f (Foo a Char) d x = True\n\n  Matching the rule won't bind 'a', and legitimately so.  We fudge by\n  pretending that 'a' is bound to (Any :: *).\n\n* Coercion variables.  On the LHS of a RULE for a local binder\n  we might have\n    RULE forall (c :: a~b). f (x |> c) = e\n  Now, if that binding is inlined, so that a=b=Int, we'd get\n    RULE forall (c :: Int~Int). f (x |> c) = e\n  and now when we simplify the LHS (Simplify.simplRule) we\n  optCoercion will turn that 'c' into Refl:\n    RULE forall (c :: Int~Int). f (x |> <Int>) = e\n  and then perhaps drop it altogether.  Now 'c' is unbound.\n\n  It's tricky to be sure this never happens, so instead I\n  say it's OK to have an unbound coercion binder in a RULE\n  provided its type is (c :: t~t).  Then, when the RULE\n  fires we can substitute <t> for c.\n\n  This actually happened (in a RULE for a local function)\n  in Trac #13410, and also in test T10602.\n\n\nNote [Cloning the template binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following match (example 1):\n        Template:  forall x.  f x\n        Target:               f (x+1)\nThis should succeed, because the template variable 'x' has nothing to\ndo with the 'x' in the target.\n\nLikewise this one (example 2):\n        Template:  forall x. f (\\x.x)\n        Target:              f (\\y.y)\n\nWe achieve this simply by using rnBndrL to clone the template\nbinders if they are already in scope.\n\n------ Historical note -------\nAt one point I tried simply adding the template binders to the\nin-scope set /without/ cloning them, but that failed in a horribly\nobscure way in Trac #14777.  Problem was that during matching we look\nup target-term variables in the in-scope set (see Note [Lookup\nin-scope]).  If a target-term variable happens to name-clash with a\ntemplate variable, that lookup will find the template variable, which\nis /utterly/ bogus.  In Trac #14777, this transformed a term variable\ninto a type variable, and then crashed when we wanted its idInfo.\n------ End of historical note -------\n\n\n************************************************************************\n*                                                                      *\n                   The main matcher\n*                                                                      *\n********************************************************************* -}\n\n-- * The domain of the TvSubstEnv and IdSubstEnv are the template\n--   variables passed into the match.\n--\n-- * The BindWrapper in a RuleSubst are the bindings floated out\n--   from nested matches; see the Let case of match, below\n--\ndata RuleMatchEnv\n  = RV { rv_lcl   :: RnEnv2          -- Renamings for *local bindings*\n                                     --   (lambda/case)\n       , rv_tmpls :: VarSet          -- Template variables\n                                     --   (after applying envL of rv_lcl)\n       , rv_fltR  :: Subst           -- Renamings for floated let-bindings\n                                     --   (domain disjoint from envR of rv_lcl)\n                                     -- See Note [Matching lets]\n       , rv_unf :: IdUnfoldingFun\n       }\n\nrvInScopeEnv :: RuleMatchEnv -> InScopeEnv\nrvInScopeEnv renv = (rnInScopeSet (rv_lcl renv), rv_unf renv)\n\ndata RuleSubst = RS { rs_tv_subst :: TvSubstEnv   -- Range is the\n                    , rs_id_subst :: IdSubstEnv   --   template variables\n                    , rs_binds    :: BindWrapper  -- Floated bindings\n                    , rs_bndrs    :: VarSet       -- Variables bound by floated lets\n                    }\n\ntype BindWrapper = CoreExpr -> CoreExpr\n  -- See Notes [Matching lets] and [Matching cases]\n  -- we represent the floated bindings as a core-to-core function\n\nemptyRuleSubst :: RuleSubst\nemptyRuleSubst = RS { rs_tv_subst = emptyVarEnv, rs_id_subst = emptyVarEnv\n                    , rs_binds = \\e -> e, rs_bndrs = emptyVarSet }\n\n--      At one stage I tried to match even if there are more\n--      template args than real args.\n\n--      I now think this is probably a bad idea.\n--      Should the template (map f xs) match (map g)?  I think not.\n--      For a start, in general eta expansion wastes work.\n--      SLPJ July 99\n\nmatch :: RuleMatchEnv\n      -> RuleSubst\n      -> CoreExpr               -- Template\n      -> CoreExpr               -- Target\n      -> Maybe RuleSubst\n\n-- We look through certain ticks. See note [Tick annotations in RULE matching]\nmatch renv subst e1 (Tick t e2)\n  | tickishFloatable t\n  = match renv subst' e1 e2\n  where subst' = subst { rs_binds = rs_binds subst . mkTick t }\nmatch _ _ e@Tick{} _\n  = pprPanic \"Tick in rule\" (ppr e)\n\n-- See the notes with Unify.match, which matches types\n-- Everything is very similar for terms\n\n-- Interesting examples:\n-- Consider matching\n--      \\x->f      against    \\f->f\n-- When we meet the lambdas we must remember to rename f to f' in the\n-- second expression.  The RnEnv2 does that.\n--\n-- Consider matching\n--      forall a. \\b->b    against   \\a->3\n-- We must rename the \\a.  Otherwise when we meet the lambdas we\n-- might substitute [a/b] in the template, and then erroneously\n-- succeed in matching what looks like the template variable 'a' against 3.\n\n-- The Var case follows closely what happens in Unify.match\nmatch renv subst (Var v1) e2\n  = match_var renv subst v1 e2\n\nmatch renv subst e1 (Var v2)      -- Note [Expanding variables]\n  | not (inRnEnvR rn_env v2) -- Note [Do not expand locally-bound variables]\n  , Just e2' <- expandUnfolding_maybe (rv_unf renv v2')\n  = match (renv { rv_lcl = nukeRnEnvR rn_env }) subst e1 e2'\n  where\n    v2'    = lookupRnInScope rn_env v2\n    rn_env = rv_lcl renv\n        -- Notice that we look up v2 in the in-scope set\n        -- See Note [Lookup in-scope]\n        -- No need to apply any renaming first (hence no rnOccR)\n        -- because of the not-inRnEnvR\n\nmatch renv subst e1 (Let bind e2)\n  | -- pprTrace \"match:Let\" (vcat [ppr bind, ppr $ okToFloat (rv_lcl renv) (bindFreeVars bind)]) $\n    not (isJoinBind bind) -- can't float join point out of argument position\n  , okToFloat (rv_lcl renv) (bindFreeVars bind) -- See Note [Matching lets]\n  = match (renv { rv_fltR = flt_subst' })\n          (subst { rs_binds = rs_binds subst . Let bind'\n                 , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs })\n          e1 e2\n  where\n    flt_subst = addInScopeSet (rv_fltR renv) (rs_bndrs subst)\n    (flt_subst', bind') = substBind flt_subst bind\n    new_bndrs = bindersOf bind'\n\n{- Disabled: see Note [Matching cases] below\nmatch renv (tv_subst, id_subst, binds) e1\n      (Case scrut case_bndr ty [(con, alt_bndrs, rhs)])\n  | exprOkForSpeculation scrut  -- See Note [Matching cases]\n  , okToFloat rn_env bndrs (exprFreeVars scrut)\n  = match (renv { me_env = rn_env' })\n          (tv_subst, id_subst, binds . case_wrap)\n          e1 rhs\n  where\n    rn_env   = me_env renv\n    rn_env'  = extendRnInScopeList rn_env bndrs\n    bndrs    = case_bndr : alt_bndrs\n    case_wrap rhs' = Case scrut case_bndr ty [(con, alt_bndrs, rhs')]\n-}\n\nmatch _ subst (Lit lit1) (Lit lit2)\n  | lit1 == lit2\n  = Just subst\n\nmatch renv subst (App f1 a1) (App f2 a2)\n  = do  { subst' <- match renv subst f1 f2\n        ; match renv subst' a1 a2 }\n\nmatch renv subst (Lam x1 e1) e2\n  | Just (x2, e2, ts) <- exprIsLambda_maybe (rvInScopeEnv renv) e2\n  = let renv' = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2\n                     , rv_fltR = delBndr (rv_fltR renv) x2 }\n        subst' = subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts }\n    in  match renv' subst' e1 e2\n\nmatch renv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2)\n  = do  { subst1 <- match_ty renv subst ty1 ty2\n        ; subst2 <- match renv subst1 e1 e2\n        ; let renv' = rnMatchBndr2 renv subst x1 x2\n        ; match_alts renv' subst2 alts1 alts2   -- Alts are both sorted\n        }\n\nmatch renv subst (Type ty1) (Type ty2)\n  = match_ty renv subst ty1 ty2\nmatch renv subst (Coercion co1) (Coercion co2)\n  = match_co renv subst co1 co2\n\nmatch renv subst (Cast e1 co1) (Cast e2 co2)\n  = do  { subst1 <- match_co renv subst co1 co2\n        ; match renv subst1 e1 e2 }\n\n-- Everything else fails\nmatch _ _ _e1 _e2 = -- pprTrace \"Failing at\" ((text \"e1:\" <+> ppr _e1) $$ (text \"e2:\" <+> ppr _e2)) $\n                    Nothing\n\n-------------\nmatch_co :: RuleMatchEnv\n         -> RuleSubst\n         -> Coercion\n         -> Coercion\n         -> Maybe RuleSubst\nmatch_co renv subst co1 co2\n  | Just cv <- getCoVar_maybe co1\n  = match_var renv subst cv (Coercion co2)\n  | Just (ty1, r1) <- isReflCo_maybe co1\n  = do { (ty2, r2) <- isReflCo_maybe co2\n       ; guard (r1 == r2)\n       ; match_ty renv subst ty1 ty2 }\nmatch_co renv subst co1 co2\n  | Just (tc1, cos1) <- splitTyConAppCo_maybe co1\n  = case splitTyConAppCo_maybe co2 of\n      Just (tc2, cos2)\n        |  tc1 == tc2\n        -> match_cos renv subst cos1 cos2\n      _ -> Nothing\nmatch_co renv subst co1 co2\n  | Just (arg1, res1) <- splitFunCo_maybe co1\n  = case splitFunCo_maybe co2 of\n      Just (arg2, res2)\n        -> match_cos renv subst [arg1, res1] [arg2, res2]\n      _ -> Nothing\nmatch_co _ _ _co1 _co2\n    -- Currently just deals with CoVarCo, TyConAppCo and Refl\n#if defined(DEBUG)\n  = pprTrace \"match_co: needs more cases\" (ppr _co1 $$ ppr _co2) Nothing\n#else\n  = Nothing\n#endif\n\nmatch_cos :: RuleMatchEnv\n         -> RuleSubst\n         -> [Coercion]\n         -> [Coercion]\n         -> Maybe RuleSubst\nmatch_cos renv subst (co1:cos1) (co2:cos2) =\n  do { subst' <- match_co renv subst co1 co2\n     ; match_cos renv subst' cos1 cos2 }\nmatch_cos _ subst [] [] = Just subst\nmatch_cos _ _ cos1 cos2 = pprTrace \"match_cos: not same length\" (ppr cos1 $$ ppr cos2) Nothing\n\n-------------\nrnMatchBndr2 :: RuleMatchEnv -> RuleSubst -> Var -> Var -> RuleMatchEnv\nrnMatchBndr2 renv subst x1 x2\n  = renv { rv_lcl  = rnBndr2 rn_env x1 x2\n         , rv_fltR = delBndr (rv_fltR renv) x2 }\n  where\n    rn_env = addRnInScopeSet (rv_lcl renv) (rs_bndrs subst)\n    -- Typically this is a no-op, but it may matter if\n    -- there are some floated let-bindings\n\n------------------------------------------\nmatch_alts :: RuleMatchEnv\n           -> RuleSubst\n           -> [CoreAlt]         -- Template\n           -> [CoreAlt]         -- Target\n           -> Maybe RuleSubst\nmatch_alts _ subst [] []\n  = return subst\nmatch_alts renv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2)\n  | c1 == c2\n  = do  { subst1 <- match renv' subst r1 r2\n        ; match_alts renv subst1 alts1 alts2 }\n  where\n    renv' = foldl' mb renv (vs1 `zip` vs2)\n    mb renv (v1,v2) = rnMatchBndr2 renv subst v1 v2\n\nmatch_alts _ _ _ _\n  = Nothing\n\n------------------------------------------\nokToFloat :: RnEnv2 -> VarSet -> Bool\nokToFloat rn_env bind_fvs\n  = allVarSet not_captured bind_fvs\n  where\n    not_captured fv = not (inRnEnvR rn_env fv)\n\n------------------------------------------\nmatch_var :: RuleMatchEnv\n          -> RuleSubst\n          -> Var                -- Template\n          -> CoreExpr        -- Target\n          -> Maybe RuleSubst\nmatch_var renv@(RV { rv_tmpls = tmpls, rv_lcl = rn_env, rv_fltR = flt_env })\n          subst v1 e2\n  | v1' `elemVarSet` tmpls\n  = match_tmpl_var renv subst v1' e2\n\n  | otherwise   -- v1' is not a template variable; check for an exact match with e2\n  = case e2 of  -- Remember, envR of rn_env is disjoint from rv_fltR\n       Var v2 | v1' == rnOccR rn_env v2\n              -> Just subst\n\n              | Var v2' <- lookupIdSubst (text \"match_var\") flt_env v2\n              , v1' == v2'\n              -> Just subst\n\n       _ -> Nothing\n\n  where\n    v1' = rnOccL rn_env v1\n        -- If the template is\n        --      forall x. f x (\\x -> x) = ...\n        -- Then the x inside the lambda isn't the\n        -- template x, so we must rename first!\n\n------------------------------------------\nmatch_tmpl_var :: RuleMatchEnv\n               -> RuleSubst\n               -> Var                -- Template\n               -> CoreExpr              -- Target\n               -> Maybe RuleSubst\n\nmatch_tmpl_var renv@(RV { rv_lcl = rn_env, rv_fltR = flt_env })\n               subst@(RS { rs_id_subst = id_subst, rs_bndrs = let_bndrs })\n               v1' e2\n  | any (inRnEnvR rn_env) (exprFreeVarsList e2)\n  = Nothing     -- Occurs check failure\n                -- e.g. match forall a. (\\x-> a x) against (\\y. y y)\n\n  | Just e1' <- lookupVarEnv id_subst v1'\n  = if eqExpr (rnInScopeSet rn_env) e1' e2'\n    then Just subst\n    else Nothing\n\n  | otherwise\n  =             -- Note [Matching variable types]\n                -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n                -- However, we must match the *types*; e.g.\n                --   forall (c::Char->Int) (x::Char).\n                --      f (c x) = \"RULE FIRED\"\n                -- We must only match on args that have the right type\n                -- It's actually quite difficult to come up with an example that shows\n                -- you need type matching, esp since matching is left-to-right, so type\n                -- args get matched first.  But it's possible (e.g. simplrun008) and\n                -- this is the Right Thing to do\n    do { subst' <- match_ty renv subst (idType v1') (exprType e2)\n       ; return (subst' { rs_id_subst = id_subst' }) }\n  where\n    -- e2' is the result of applying flt_env to e2\n    e2' | isEmptyVarSet let_bndrs = e2\n        | otherwise = substExpr (text \"match_tmpl_var\") flt_env e2\n\n    id_subst' = extendVarEnv (rs_id_subst subst) v1' e2'\n         -- No further renaming to do on e2',\n         -- because no free var of e2' is in the rnEnvR of the envt\n\n------------------------------------------\nmatch_ty :: RuleMatchEnv\n         -> RuleSubst\n         -> Type                -- Template\n         -> Type                -- Target\n         -> Maybe RuleSubst\n-- Matching Core types: use the matcher in TcType.\n-- Notice that we treat newtypes as opaque.  For example, suppose\n-- we have a specialised version of a function at a newtype, say\n--      newtype T = MkT Int\n-- We only want to replace (f T) with f', not (f Int).\n\nmatch_ty renv subst ty1 ty2\n  = do  { tv_subst'\n            <- Unify.ruleMatchTyKiX (rv_tmpls renv) (rv_lcl renv) tv_subst ty1 ty2\n        ; return (subst { rs_tv_subst = tv_subst' }) }\n  where\n    tv_subst = rs_tv_subst subst\n\n{-\nNote [Expanding variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere is another Very Important rule: if the term being matched is a\nvariable, we expand it so long as its unfolding is \"expandable\". (Its\noccurrence information is not necessarily up to date, so we don't use\nit.)  By \"expandable\" we mean a WHNF or a \"constructor-like\" application.\nThis is the key reason for \"constructor-like\" Ids.  If we have\n     {-# NOINLINE [1] CONLIKE g #-}\n     {-# RULE f (g x) = h x #-}\nthen in the term\n   let v = g 3 in ....(f v)....\nwe want to make the rule fire, to replace (f v) with (h 3).\n\nNote [Do not expand locally-bound variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDo *not* expand locally-bound variables, else there's a worry that the\nunfolding might mention variables that are themselves renamed.\nExample\n          case x of y { (p,q) -> ...y... }\nDon't expand 'y' to (p,q) because p,q might themselves have been\nrenamed.  Essentially we only expand unfoldings that are \"outside\"\nthe entire match.\n\nHence, (a) the guard (not (isLocallyBoundR v2))\n       (b) when we expand we nuke the renaming envt (nukeRnEnvR).\n\nNote [Tick annotations in RULE matching]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe used to unconditionally look through Notes in both template and\nexpression being matched. This is actually illegal for counting or\ncost-centre-scoped ticks, because we have no place to put them without\nchanging entry counts and/or costs. So now we just fail the match in\nthese cases.\n\nOn the other hand, where we are allowed to insert new cost into the\ntick scope, we can float them upwards to the rule application site.\n\ncf Note [Notes in call patterns] in SpecConstr\n\nNote [Matching lets]\n~~~~~~~~~~~~~~~~~~~~\nMatching a let-expression.  Consider\n        RULE forall x.  f (g x) = <rhs>\nand target expression\n        f (let { w=R } in g E))\nThen we'd like the rule to match, to generate\n        let { w=R } in (\\x. <rhs>) E\nIn effect, we want to float the let-binding outward, to enable\nthe match to happen.  This is the WHOLE REASON for accumulating\nbindings in the RuleSubst\n\nWe can only do this if the free variables of R are not bound by the\npart of the target expression outside the let binding; e.g.\n        f (\\v. let w = v+1 in g E)\nHere we obviously cannot float the let-binding for w.  Hence the\nuse of okToFloat.\n\nThere are a couple of tricky points.\n  (a) What if floating the binding captures a variable?\n        f (let v = x+1 in v) v\n      --> NOT!\n        let v = x+1 in f (x+1) v\n\n  (b) What if two non-nested let bindings bind the same variable?\n        f (let v = e1 in b1) (let v = e2 in b2)\n      --> NOT!\n        let v = e1 in let v = e2 in (f b2 b2)\n      See testsuite test \"RuleFloatLet\".\n\nOur cunning plan is this:\n  * Along with the growing substitution for template variables\n    we maintain a growing set of floated let-bindings (rs_binds)\n    plus the set of variables thus bound.\n\n  * The RnEnv2 in the MatchEnv binds only the local binders\n    in the term (lambdas, case)\n\n  * When we encounter a let in the term to be matched, we\n    check that does not mention any locally bound (lambda, case)\n    variables.  If so we fail\n\n  * We use CoreSubst.substBind to freshen the binding, using an\n    in-scope set that is the original in-scope variables plus the\n    rs_bndrs (currently floated let-bindings).  So in (a) above\n    we'll freshen the 'v' binding; in (b) above we'll freshen\n    the *second* 'v' binding.\n\n  * We apply that freshening substitution, in a lexically-scoped\n    way to the term, although lazily; this is the rv_fltR field.\n\n\nNote [Matching cases]\n~~~~~~~~~~~~~~~~~~~~~\n{- NOTE: This idea is currently disabled.  It really only works if\n         the primops involved are OkForSpeculation, and, since\n         they have side effects readIntOfAddr and touch are not.\n         Maybe we'll get back to this later .  -}\n\nConsider\n   f (case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->\n      case touch# fp s# of { _ ->\n      I# n# } } )\nThis happened in a tight loop generated by stream fusion that\nRoman encountered.  We'd like to treat this just like the let\ncase, because the primops concerned are ok-for-speculation.\nThat is, we'd like to behave as if it had been\n   case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->\n   case touch# fp s# of { _ ->\n   f (I# n# } } )\n\nNote [Lookup in-scope]\n~~~~~~~~~~~~~~~~~~~~~~\nConsider this example\n        foo :: Int -> Maybe Int -> Int\n        foo 0 (Just n) = n\n        foo m (Just n) = foo (m-n) (Just n)\n\nSpecConstr sees this fragment:\n\n        case w_smT of wild_Xf [Just A] {\n          Data.Maybe.Nothing -> lvl_smf;\n          Data.Maybe.Just n_acT [Just S(L)] ->\n            case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] ->\n              $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf\n            }};\n\nand correctly generates the rule\n\n        RULES: \"SC:$wfoo1\" [0] __forall {y_amr [Just L] :: GHC.Prim.Int#\n                                          sc_snn :: GHC.Prim.Int#}\n          $wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr))\n          = $s$wfoo_sno y_amr sc_snn ;]\n\nBUT we must ensure that this rule matches in the original function!\nNote that the call to $wfoo is\n            $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf\n\nDuring matching we expand wild_Xf to (Just n_acT).  But then we must also\nexpand n_acT to (I# y_amr).  And we can only do that if we look up n_acT\nin the in-scope set, because in wild_Xf's unfolding it won't have an unfolding\nat all.\n\nThat is why the 'lookupRnInScope' call in the (Var v2) case of 'match'\nis so important.\n\n\n************************************************************************\n*                                                                      *\n                   Rule-check the program\n*                                                                      *\n************************************************************************\n\n   We want to know what sites have rules that could have fired but didn't.\n   This pass runs over the tree (without changing it) and reports such.\n-}\n\n-- | Report partial matches for rules beginning with the specified\n-- string for the purposes of error reporting\nruleCheckProgram :: CompilerPhase               -- ^ Rule activation test\n                 -> String                      -- ^ Rule pattern\n                 -> (Id -> [CoreRule])          -- ^ Rules for an Id\n                 -> CoreProgram                 -- ^ Bindings to check in\n                 -> SDoc                        -- ^ Resulting check message\nruleCheckProgram phase rule_pat rules binds\n  | isEmptyBag results\n  = text \"Rule check results: no rule application sites\"\n  | otherwise\n  = vcat [text \"Rule check results:\",\n          line,\n          vcat [ p $$ line | p <- bagToList results ]\n         ]\n  where\n    env = RuleCheckEnv { rc_is_active = isActive phase\n                       , rc_id_unf    = idUnfolding     -- Not quite right\n                                                        -- Should use activeUnfolding\n                       , rc_pattern   = rule_pat\n                       , rc_rules = rules }\n    results = unionManyBags (map (ruleCheckBind env) binds)\n    line = text (replicate 20 '-')\n\ndata RuleCheckEnv = RuleCheckEnv {\n    rc_is_active :: Activation -> Bool,\n    rc_id_unf  :: IdUnfoldingFun,\n    rc_pattern :: String,\n    rc_rules :: Id -> [CoreRule]\n}\n\nruleCheckBind :: RuleCheckEnv -> CoreBind -> Bag SDoc\n   -- The Bag returned has one SDoc for each call site found\nruleCheckBind env (NonRec _ r) = ruleCheck env r\nruleCheckBind env (Rec prs)    = unionManyBags [ruleCheck env r | (_,r) <- prs]\n\nruleCheck :: RuleCheckEnv -> CoreExpr -> Bag SDoc\nruleCheck _   (Var _)       = emptyBag\nruleCheck _   (Lit _)       = emptyBag\nruleCheck _   (Type _)      = emptyBag\nruleCheck _   (Coercion _)  = emptyBag\nruleCheck env (App f a)     = ruleCheckApp env (App f a) []\nruleCheck env (Tick _ e)  = ruleCheck env e\nruleCheck env (Cast e _)    = ruleCheck env e\nruleCheck env (Let bd e)    = ruleCheckBind env bd `unionBags` ruleCheck env e\nruleCheck env (Lam _ e)     = ruleCheck env e\nruleCheck env (Case e _ _ as) = ruleCheck env e `unionBags`\n                                unionManyBags [ruleCheck env r | (_,_,r) <- as]\n\nruleCheckApp :: RuleCheckEnv -> Expr CoreBndr -> [Arg CoreBndr] -> Bag SDoc\nruleCheckApp env (App f a) as = ruleCheck env a `unionBags` ruleCheckApp env f (a:as)\nruleCheckApp env (Var f) as   = ruleCheckFun env f as\nruleCheckApp env other _      = ruleCheck env other\n\nruleCheckFun :: RuleCheckEnv -> Id -> [CoreExpr] -> Bag SDoc\n-- Produce a report for all rules matching the predicate\n-- saying why it doesn't match the specified application\n\nruleCheckFun env fn args\n  | null name_match_rules = emptyBag\n  | otherwise             = unitBag (ruleAppCheck_help env fn args name_match_rules)\n  where\n    name_match_rules = filter match (rc_rules env fn)\n    match rule = (rc_pattern env) `isPrefixOf` unpackFS (ruleName rule)\n\nruleAppCheck_help :: RuleCheckEnv -> Id -> [CoreExpr] -> [CoreRule] -> SDoc\nruleAppCheck_help env fn args rules\n  =     -- The rules match the pattern, so we want to print something\n    vcat [text \"Expression:\" <+> ppr (mkApps (Var fn) args),\n          vcat (map check_rule rules)]\n  where\n    n_args = length args\n    i_args = args `zip` [1::Int ..]\n    rough_args = map roughTopName args\n\n    check_rule rule = sdocWithDynFlags $ \\dflags ->\n                      rule_herald rule <> colon <+> rule_info dflags rule\n\n    rule_herald (BuiltinRule { ru_name = name })\n        = text \"Builtin rule\" <+> doubleQuotes (ftext name)\n    rule_herald (Rule { ru_name = name })\n        = text \"Rule\" <+> doubleQuotes (ftext name)\n\n    rule_info dflags rule\n        | Just _ <- matchRule dflags (emptyInScopeSet, rc_id_unf env)\n                              noBlackList fn args rough_args rule\n        = text \"matches (which is very peculiar!)\"\n\n    rule_info _ (BuiltinRule {}) = text \"does not match\"\n\n    rule_info _ (Rule { ru_act = act,\n                        ru_bndrs = rule_bndrs, ru_args = rule_args})\n        | not (rc_is_active env act)  = text \"active only in later phase\"\n        | n_args < n_rule_args        = text \"too few arguments\"\n        | n_mismatches == n_rule_args = text \"no arguments match\"\n        | n_mismatches == 0           = text \"all arguments match (considered individually), but rule as a whole does not\"\n        | otherwise                   = text \"arguments\" <+> ppr mismatches <+> text \"do not match (1-indexing)\"\n        where\n          n_rule_args  = length rule_args\n          n_mismatches = length mismatches\n          mismatches   = [i | (rule_arg, (arg,i)) <- rule_args `zip` i_args,\n                              not (isJust (match_fn rule_arg arg))]\n\n          lhs_fvs = exprsFreeVars rule_args     -- Includes template tyvars\n          match_fn rule_arg arg = match renv emptyRuleSubst rule_arg arg\n                where\n                  in_scope = mkInScopeSet (lhs_fvs `unionVarSet` exprFreeVars arg)\n                  renv = RV { rv_lcl   = mkRnEnv2 in_scope\n                            , rv_tmpls = mkVarSet rule_bndrs\n                            , rv_fltR  = mkEmptySubst in_scope\n                            , rv_unf   = rc_id_unf env }\n", "num_lines": 1281}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nToDo [Oct 2013]\n~~~~~~~~~~~~~~~\n1. Nuke ForceSpecConstr for good (it is subsumed by GHC.Types.SPEC in ghc-prim)\n2. Nuke NoSpecConstr\n\n\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[SpecConstr]{Specialise over constructors}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule SpecConstr(\n        specConstrProgram,\n        SpecConstrAnnotation(..)\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreSubst\nimport CoreUtils\nimport CoreUnfold       ( couldBeSmallEnoughToInline )\nimport CoreFVs          ( exprsFreeVarsList )\nimport CoreMonad\nimport Literal          ( litIsLifted )\nimport HscTypes         ( ModGuts(..) )\nimport WwLib            ( isWorkerSmallEnough, mkWorkerArgs )\nimport DataCon\nimport Coercion         hiding( substCo )\nimport Rules\nimport Type             hiding ( substTy )\nimport TyCon            ( tyConName )\nimport Id\nimport PprCore          ( pprParendExpr )\nimport MkCore           ( mkImpossibleExpr )\nimport VarEnv\nimport VarSet\nimport Name\nimport BasicTypes\nimport DynFlags         ( DynFlags(..), GeneralFlag( Opt_SpecConstrKeen )\n                        , gopt, hasPprDebug )\nimport Maybes           ( orElse, catMaybes, isJust, isNothing )\nimport Demand\nimport GHC.Serialized   ( deserializeWithData )\nimport Util\nimport Pair\nimport UniqSupply\nimport Outputable\nimport FastString\nimport UniqFM\nimport MonadUtils\nimport Control.Monad    ( zipWithM )\nimport Data.List\nimport PrelNames        ( specTyConName )\nimport Module\nimport TyCon ( TyCon )\nimport GHC.Exts( SpecConstrAnnotation(..) )\nimport Data.Ord( comparing )\n\n{-\n-----------------------------------------------------\n                        Game plan\n-----------------------------------------------------\n\nConsider\n        drop n []     = []\n        drop 0 xs     = []\n        drop n (x:xs) = drop (n-1) xs\n\nAfter the first time round, we could pass n unboxed.  This happens in\nnumerical code too.  Here's what it looks like in Core:\n\n        drop n xs = case xs of\n                      []     -> []\n                      (y:ys) -> case n of\n                                  I# n# -> case n# of\n                                             0 -> []\n                                             _ -> drop (I# (n# -# 1#)) xs\n\nNotice that the recursive call has an explicit constructor as argument.\nNoticing this, we can make a specialised version of drop\n\n        RULE: drop (I# n#) xs ==> drop' n# xs\n\n        drop' n# xs = let n = I# n# in ...orig RHS...\n\nNow the simplifier will apply the specialisation in the rhs of drop', giving\n\n        drop' n# xs = case xs of\n                      []     -> []\n                      (y:ys) -> case n# of\n                                  0 -> []\n                                  _ -> drop' (n# -# 1#) xs\n\nMuch better!\n\nWe'd also like to catch cases where a parameter is carried along unchanged,\nbut evaluated each time round the loop:\n\n        f i n = if i>0 || i>n then i else f (i*2) n\n\nHere f isn't strict in n, but we'd like to avoid evaluating it each iteration.\nIn Core, by the time we've w/wd (f is strict in i) we get\n\n        f i# n = case i# ># 0 of\n                   False -> I# i#\n                   True  -> case n of { I# n# ->\n                            case i# ># n# of\n                                False -> I# i#\n                                True  -> f (i# *# 2#) n\n\nAt the call to f, we see that the argument, n is known to be (I# n#),\nand n is evaluated elsewhere in the body of f, so we can play the same\ntrick as above.\n\n\nNote [Reboxing]\n~~~~~~~~~~~~~~~\nWe must be careful not to allocate the same constructor twice.  Consider\n        f p = (...(case p of (a,b) -> e)...p...,\n               ...let t = (r,s) in ...t...(f t)...)\nAt the recursive call to f, we can see that t is a pair.  But we do NOT want\nto make a specialised copy:\n        f' a b = let p = (a,b) in (..., ...)\nbecause now t is allocated by the caller, then r and s are passed to the\nrecursive call, which allocates the (r,s) pair again.\n\nThis happens if\n  (a) the argument p is used in other than a case-scrutinisation way.\n  (b) the argument to the call is not a 'fresh' tuple; you have to\n        look into its unfolding to see that it's a tuple\n\nHence the \"OR\" part of Note [Good arguments] below.\n\nALTERNATIVE 2: pass both boxed and unboxed versions.  This no longer saves\nallocation, but does perhaps save evals. In the RULE we'd have\nsomething like\n\n  f (I# x#) = f' (I# x#) x#\n\nIf at the call site the (I# x) was an unfolding, then we'd have to\nrely on CSE to eliminate the duplicate allocation.... This alternative\ndoesn't look attractive enough to pursue.\n\nALTERNATIVE 3: ignore the reboxing problem.  The trouble is that\nthe conservative reboxing story prevents many useful functions from being\nspecialised.  Example:\n        foo :: Maybe Int -> Int -> Int\n        foo   (Just m) 0 = 0\n        foo x@(Just m) n = foo x (n-m)\nHere the use of 'x' will clearly not require boxing in the specialised function.\n\nThe strictness analyser has the same problem, in fact.  Example:\n        f p@(a,b) = ...\nIf we pass just 'a' and 'b' to the worker, it might need to rebox the\npair to create (a,b).  A more sophisticated analysis might figure out\nprecisely the cases in which this could happen, but the strictness\nanalyser does no such analysis; it just passes 'a' and 'b', and hopes\nfor the best.\n\nSo my current choice is to make SpecConstr similarly aggressive, and\nignore the bad potential of reboxing.\n\n\nNote [Good arguments]\n~~~~~~~~~~~~~~~~~~~~~\nSo we look for\n\n* A self-recursive function.  Ignore mutual recursion for now,\n  because it's less common, and the code is simpler for self-recursion.\n\n* EITHER\n\n   a) At a recursive call, one or more parameters is an explicit\n      constructor application\n        AND\n      That same parameter is scrutinised by a case somewhere in\n      the RHS of the function\n\n  OR\n\n    b) At a recursive call, one or more parameters has an unfolding\n       that is an explicit constructor application\n        AND\n      That same parameter is scrutinised by a case somewhere in\n      the RHS of the function\n        AND\n      Those are the only uses of the parameter (see Note [Reboxing])\n\n\nWhat to abstract over\n~~~~~~~~~~~~~~~~~~~~~\nThere's a bit of a complication with type arguments.  If the call\nsite looks like\n\n        f p = ...f ((:) [a] x xs)...\n\nthen our specialised function look like\n\n        f_spec x xs = let p = (:) [a] x xs in ....as before....\n\nThis only makes sense if either\n  a) the type variable 'a' is in scope at the top of f, or\n  b) the type variable 'a' is an argument to f (and hence fs)\n\nActually, (a) may hold for value arguments too, in which case\nwe may not want to pass them.  Suppose 'x' is in scope at f's\ndefn, but xs is not.  Then we'd like\n\n        f_spec xs = let p = (:) [a] x xs in ....as before....\n\nSimilarly (b) may hold too.  If x is already an argument at the\ncall, no need to pass it again.\n\nFinally, if 'a' is not in scope at the call site, we could abstract\nit as we do the term variables:\n\n        f_spec a x xs = let p = (:) [a] x xs in ...as before...\n\nSo the grand plan is:\n\n        * abstract the call site to a constructor-only pattern\n          e.g.  C x (D (f p) (g q))  ==>  C s1 (D s2 s3)\n\n        * Find the free variables of the abstracted pattern\n\n        * Pass these variables, less any that are in scope at\n          the fn defn.  But see Note [Shadowing] below.\n\n\nNOTICE that we only abstract over variables that are not in scope,\nso we're in no danger of shadowing variables used in \"higher up\"\nin f_spec's RHS.\n\n\nNote [Shadowing]\n~~~~~~~~~~~~~~~~\nIn this pass we gather up usage information that may mention variables\nthat are bound between the usage site and the definition site; or (more\nseriously) may be bound to something different at the definition site.\nFor example:\n\n        f x = letrec g y v = let x = ...\n                             in ...(g (a,b) x)...\n\nSince 'x' is in scope at the call site, we may make a rewrite rule that\nlooks like\n        RULE forall a,b. g (a,b) x = ...\nBut this rule will never match, because it's really a different 'x' at\nthe call site -- and that difference will be manifest by the time the\nsimplifier gets to it.  [A worry: the simplifier doesn't *guarantee*\nno-shadowing, so perhaps it may not be distinct?]\n\nAnyway, the rule isn't actually wrong, it's just not useful.  One possibility\nis to run deShadowBinds before running SpecConstr, but instead we run the\nsimplifier.  That gives the simplest possible program for SpecConstr to\nchew on; and it virtually guarantees no shadowing.\n\nNote [Specialising for constant parameters]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis one is about specialising on a *constant* (but not necessarily\nconstructor) argument\n\n    foo :: Int -> (Int -> Int) -> Int\n    foo 0 f = 0\n    foo m f = foo (f m) (+1)\n\nIt produces\n\n    lvl_rmV :: GHC.Base.Int -> GHC.Base.Int\n    lvl_rmV =\n      \\ (ds_dlk :: GHC.Base.Int) ->\n        case ds_dlk of wild_alH { GHC.Base.I# x_alG ->\n        GHC.Base.I# (GHC.Prim.+# x_alG 1)\n\n    T.$wfoo :: GHC.Prim.Int# -> (GHC.Base.Int -> GHC.Base.Int) ->\n    GHC.Prim.Int#\n    T.$wfoo =\n      \\ (ww_sme :: GHC.Prim.Int#) (w_smg :: GHC.Base.Int -> GHC.Base.Int) ->\n        case ww_sme of ds_Xlw {\n          __DEFAULT ->\n        case w_smg (GHC.Base.I# ds_Xlw) of w1_Xmo { GHC.Base.I# ww1_Xmz ->\n        T.$wfoo ww1_Xmz lvl_rmV\n        };\n          0 -> 0\n        }\n\nThe recursive call has lvl_rmV as its argument, so we could create a specialised copy\nwith that argument baked in; that is, not passed at all.   Now it can perhaps be inlined.\n\nWhen is this worth it?  Call the constant 'lvl'\n- If 'lvl' has an unfolding that is a constructor, see if the corresponding\n  parameter is scrutinised anywhere in the body.\n\n- If 'lvl' has an unfolding that is a inlinable function, see if the corresponding\n  parameter is applied (...to enough arguments...?)\n\n  Also do this is if the function has RULES?\n\nAlso\n\nNote [Specialising for lambda parameters]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    foo :: Int -> (Int -> Int) -> Int\n    foo 0 f = 0\n    foo m f = foo (f m) (\\n -> n-m)\n\nThis is subtly different from the previous one in that we get an\nexplicit lambda as the argument:\n\n    T.$wfoo :: GHC.Prim.Int# -> (GHC.Base.Int -> GHC.Base.Int) ->\n    GHC.Prim.Int#\n    T.$wfoo =\n      \\ (ww_sm8 :: GHC.Prim.Int#) (w_sma :: GHC.Base.Int -> GHC.Base.Int) ->\n        case ww_sm8 of ds_Xlr {\n          __DEFAULT ->\n        case w_sma (GHC.Base.I# ds_Xlr) of w1_Xmf { GHC.Base.I# ww1_Xmq ->\n        T.$wfoo\n          ww1_Xmq\n          (\\ (n_ad3 :: GHC.Base.Int) ->\n             case n_ad3 of wild_alB { GHC.Base.I# x_alA ->\n             GHC.Base.I# (GHC.Prim.-# x_alA ds_Xlr)\n             })\n        };\n          0 -> 0\n        }\n\nI wonder if SpecConstr couldn't be extended to handle this? After all,\nlambda is a sort of constructor for functions and perhaps it already\nhas most of the necessary machinery?\n\nFurthermore, there's an immediate win, because you don't need to allocate the lambda\nat the call site; and if perchance it's called in the recursive call, then you\nmay avoid allocating it altogether.  Just like for constructors.\n\nLooks cool, but probably rare...but it might be easy to implement.\n\n\nNote [SpecConstr for casts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n    data family T a :: *\n    data instance T Int = T Int\n\n    foo n = ...\n       where\n         go (T 0) = 0\n         go (T n) = go (T (n-1))\n\nThe recursive call ends up looking like\n        go (T (I# ...) `cast` g)\nSo we want to spot the constructor application inside the cast.\nThat's why we have the Cast case in argToPat\n\nNote [Local recursive groups]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor a *local* recursive group, we can see all the calls to the\nfunction, so we seed the specialisation loop from the calls in the\nbody, not from the calls in the RHS.  Consider:\n\n  bar m n = foo n (n,n) (n,n) (n,n) (n,n)\n   where\n     foo n p q r s\n       | n == 0    = m\n       | n > 3000  = case p of { (p1,p2) -> foo (n-1) (p2,p1) q r s }\n       | n > 2000  = case q of { (q1,q2) -> foo (n-1) p (q2,q1) r s }\n       | n > 1000  = case r of { (r1,r2) -> foo (n-1) p q (r2,r1) s }\n       | otherwise = case s of { (s1,s2) -> foo (n-1) p q r (s2,s1) }\n\nIf we start with the RHSs of 'foo', we get lots and lots of specialisations,\nmost of which are not needed.  But if we start with the (single) call\nin the rhs of 'bar' we get exactly one fully-specialised copy, and all\nthe recursive calls go to this fully-specialised copy. Indeed, the original\nfunction is later collected as dead code.  This is very important in\nspecialising the loops arising from stream fusion, for example in NDP where\nwe were getting literally hundreds of (mostly unused) specialisations of\na local function.\n\nIn a case like the above we end up never calling the original un-specialised\nfunction.  (Although we still leave its code around just in case.)\n\nHowever, if we find any boring calls in the body, including *unsaturated*\nones, such as\n      letrec foo x y = ....foo...\n      in map foo xs\nthen we will end up calling the un-specialised function, so then we *should*\nuse the calls in the un-specialised RHS as seeds.  We call these\n\"boring call patterns\", and callsToPats reports if it finds any of these.\n\nNote [Seeding top-level recursive groups]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis seeding is done in the binding for seed_calls in specRec.\n\n1. If all the bindings in a top-level recursive group are local (not\n   exported), then all the calls are in the rest of the top-level\n   bindings.  This means we can specialise with those call patterns\n   ONLY, and NOT with the RHSs of the recursive group (exactly like\n   Note [Local recursive groups])\n\n2. But if any of the bindings are exported, the function may be called\n   with any old arguments, so (for lack of anything better) we specialise\n   based on\n     (a) the call patterns in the RHS\n     (b) the call patterns in the rest of the top-level bindings\n   NB: before Apr 15 we used (a) only, but Dimitrios had an example\n       where (b) was crucial, so I added that.\n       Adding (b) also improved nofib allocation results:\n                  multiplier: 4%   better\n                  minimax:    2.8% better\n\nActually in case (2), instead of using the calls from the RHS, it\nwould be better to specialise in the importing module.  We'd need to\nadd an INLINABLE pragma to the function, and then it can be\nspecialised in the importing scope, just as is done for type classes\nin Specialise.specImports. This remains to be done (#10346).\n\nNote [Top-level recursive groups]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTo get the call usage information from \"the rest of the top level\nbindings\" (c.f. Note [Seeding top-level recursive groups]), we work\nbackwards through the top-level bindings so we see the usage before we\nget to the binding of the function.  Before we can collect the usage\nthough, we go through all the bindings and add them to the\nenvironment. This is necessary because usage is only tracked for\nfunctions in the environment.  These two passes are called\n   'go' and 'goEnv'\nin specConstrProgram.  (Looks a bit revolting to me.)\n\nNote [Do not specialise diverging functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSpecialising a function that just diverges is a waste of code.\nFurthermore, it broke GHC (simpl014) thus:\n   {-# STR Sb #-}\n   f = \\x. case x of (a,b) -> f x\nIf we specialise f we get\n   f = \\x. case x of (a,b) -> fspec a b\nBut fspec doesn't have decent strictness info.  As it happened,\n(f x) :: IO t, so the state hack applied and we eta expanded fspec,\nand hence f.  But now f's strictness is less than its arity, which\nbreaks an invariant.\n\n\nNote [Forcing specialisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWith stream fusion and in other similar cases, we want to fully\nspecialise some (but not necessarily all!) loops regardless of their\nsize and the number of specialisations.\n\nWe allow a library to do this, in one of two ways (one which is\ndeprecated):\n\n  1) Add a parameter of type GHC.Types.SPEC (from ghc-prim) to the loop body.\n\n  2) (Deprecated) Annotate a type with ForceSpecConstr from GHC.Exts,\n     and then add *that* type as a parameter to the loop body\n\nThe reason #2 is deprecated is because it requires GHCi, which isn't\navailable for things like a cross compiler using stage1.\n\nHere's a (simplified) example from the `vector` package. You may bring\nthe special 'force specialization' type into scope by saying:\n\n  import GHC.Types (SPEC(..))\n\nor by defining your own type (again, deprecated):\n\n  data SPEC = SPEC | SPEC2\n  {-# ANN type SPEC ForceSpecConstr #-}\n\n(Note this is the exact same definition of GHC.Types.SPEC, just\nwithout the annotation.)\n\nAfter that, you say:\n\n  foldl :: (a -> b -> a) -> a -> Stream b -> a\n  {-# INLINE foldl #-}\n  foldl f z (Stream step s _) = foldl_loop SPEC z s\n    where\n      foldl_loop !sPEC z s = case step s of\n                              Yield x s' -> foldl_loop sPEC (f z x) s'\n                              Skip       -> foldl_loop sPEC z s'\n                              Done       -> z\n\nSpecConstr will spot the SPEC parameter and always fully specialise\nfoldl_loop. Note that\n\n  * We have to prevent the SPEC argument from being removed by\n    w/w which is why (a) SPEC is a sum type, and (b) we have to seq on\n    the SPEC argument.\n\n  * And lastly, the SPEC argument is ultimately eliminated by\n    SpecConstr itself so there is no runtime overhead.\n\nThis is all quite ugly; we ought to come up with a better design.\n\nForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set\nsc_force to True when calling specLoop. This flag does four things:\n\n  * Ignore specConstrThreshold, to specialise functions of arbitrary size\n        (see scTopBind)\n  * Ignore specConstrCount, to make arbitrary numbers of specialisations\n        (see specialise)\n  * Specialise even for arguments that are not scrutinised in the loop\n        (see argToPat; Trac #4448)\n  * Only specialise on recursive types a finite number of times\n        (see is_too_recursive; Trac #5550; Note [Limit recursive specialisation])\n\nThe flag holds only for specialising a single binding group, and NOT\nfor nested bindings.  (So really it should be passed around explicitly\nand not stored in ScEnv.)  Trac #14379 turned out to be caused by\n   f SPEC x = let g1 x = ...\n              in ...\nWe force-specialise f (because of the SPEC), but that generates a specialised\ncopy of g1 (as well as the original).  Alas g1 has a nested binding g2; and\nin each copy of g1 we get an unspecialised and specialised copy of g2; and so\non. Result, exponential.  So the force-spec flag now only applies to one\nlevel of bindings at a time.\n\nMechanism for this one-level-only thing:\n\n - Switch it on at the call to specRec, in scExpr and scTopBinds\n - Switch it off when doing the RHSs;\n   this can be done very conveniently in decreaseSpecCount\n\nWhat alternatives did I consider?\n\n* Annotating the loop itself doesn't work because (a) it is local and\n  (b) it will be w/w'ed and having w/w propagating annotations somehow\n  doesn't seem like a good idea. The types of the loop arguments\n  really seem to be the most persistent thing.\n\n* Annotating the types that make up the loop state doesn't work,\n  either, because (a) it would prevent us from using types like Either\n  or tuples here, (b) we don't want to restrict the set of types that\n  can be used in Stream states and (c) some types are fixed by the\n  user (e.g., the accumulator here) but we still want to specialise as\n  much as possible.\n\nAlternatives to ForceSpecConstr\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInstead of giving the loop an extra argument of type SPEC, we\nalso considered *wrapping* arguments in SPEC, thus\n  data SPEC a = SPEC a | SPEC2\n\n  loop = \\arg -> case arg of\n                     SPEC state ->\n                        case state of (x,y) -> ... loop (SPEC (x',y')) ...\n                        S2 -> error ...\nThe idea is that a SPEC argument says \"specialise this argument\nregardless of whether the function case-analyses it\".  But this\ndoesn't work well:\n  * SPEC must still be a sum type, else the strictness analyser\n    eliminates it\n  * But that means that 'loop' won't be strict in its real payload\nThis loss of strictness in turn screws up specialisation, because\nwe may end up with calls like\n   loop (SPEC (case z of (p,q) -> (q,p)))\nWithout the SPEC, if 'loop' were strict, the case would move out\nand we'd see loop applied to a pair. But if 'loop' isn't strict\nthis doesn't look like a specialisable call.\n\nNote [Limit recursive specialisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is possible for ForceSpecConstr to cause an infinite loop of specialisation.\nBecause there is no limit on the number of specialisations, a recursive call with\na recursive constructor as an argument (for example, list cons) will generate\na specialisation for that constructor. If the resulting specialisation also\ncontains a recursive call with the constructor, this could proceed indefinitely.\n\nFor example, if ForceSpecConstr is on:\n  loop :: [Int] -> [Int] -> [Int]\n  loop z []         = z\n  loop z (x:xs)     = loop (x:z) xs\nthis example will create a specialisation for the pattern\n  loop (a:b) c      = loop' a b c\n\n  loop' a b []      = (a:b)\n  loop' a b (x:xs)  = loop (x:(a:b)) xs\nand a new pattern is found:\n  loop (a:(b:c)) d  = loop'' a b c d\nwhich can continue indefinitely.\n\nRoman's suggestion to fix this was to stop after a couple of times on recursive types,\nbut still specialising on non-recursive types as much as possible.\n\nTo implement this, we count the number of times we have gone round the\n\"specialise recursively\" loop ('go' in 'specRec').  Once have gone round\nmore than N times (controlled by -fspec-constr-recursive=N) we check\n\n  - If sc_force is off, and sc_count is (Just max) then we don't\n    need to do anything: trim_pats will limit the number of specs\n\n  - Otherwise check if any function has now got more than (sc_count env)\n    specialisations.  If sc_count is \"no limit\" then we arbitrarily\n    choose 10 as the limit (ugh).\n\nSee Trac #5550.   Also Trac #13623, where this test had become over-aggressive,\nand we lost a wonderful specialisation that we really wanted!\n\nNote [NoSpecConstr]\n~~~~~~~~~~~~~~~~~~~\nThe ignoreDataCon stuff allows you to say\n    {-# ANN type T NoSpecConstr #-}\nto mean \"don't specialise on arguments of this type\".  It was added\nbefore we had ForceSpecConstr.  Lacking ForceSpecConstr we specialised\nregardless of size; and then we needed a way to turn that *off*.  Now\nthat we have ForceSpecConstr, this NoSpecConstr is probably redundant.\n(Used only for PArray, TODO: remove?)\n\n-----------------------------------------------------\n                Stuff not yet handled\n-----------------------------------------------------\n\nHere are notes arising from Roman's work that I don't want to lose.\n\nExample 1\n~~~~~~~~~\n    data T a = T !a\n\n    foo :: Int -> T Int -> Int\n    foo 0 t = 0\n    foo x t | even x    = case t of { T n -> foo (x-n) t }\n            | otherwise = foo (x-1) t\n\nSpecConstr does no specialisation, because the second recursive call\nlooks like a boxed use of the argument.  A pity.\n\n    $wfoo_sFw :: GHC.Prim.Int# -> T.T GHC.Base.Int -> GHC.Prim.Int#\n    $wfoo_sFw =\n      \\ (ww_sFo [Just L] :: GHC.Prim.Int#) (w_sFq [Just L] :: T.T GHC.Base.Int) ->\n         case ww_sFo of ds_Xw6 [Just L] {\n           __DEFAULT ->\n                case GHC.Prim.remInt# ds_Xw6 2 of wild1_aEF [Dead Just A] {\n                  __DEFAULT -> $wfoo_sFw (GHC.Prim.-# ds_Xw6 1) w_sFq;\n                  0 ->\n                    case w_sFq of wild_Xy [Just L] { T.T n_ad5 [Just U(L)] ->\n                    case n_ad5 of wild1_aET [Just A] { GHC.Base.I# y_aES [Just L] ->\n                    $wfoo_sFw (GHC.Prim.-# ds_Xw6 y_aES) wild_Xy\n                    } } };\n           0 -> 0\n\nExample 2\n~~~~~~~~~\n    data a :*: b = !a :*: !b\n    data T a = T !a\n\n    foo :: (Int :*: T Int) -> Int\n    foo (0 :*: t) = 0\n    foo (x :*: t) | even x    = case t of { T n -> foo ((x-n) :*: t) }\n                  | otherwise = foo ((x-1) :*: t)\n\nVery similar to the previous one, except that the parameters are now in\na strict tuple. Before SpecConstr, we have\n\n    $wfoo_sG3 :: GHC.Prim.Int# -> T.T GHC.Base.Int -> GHC.Prim.Int#\n    $wfoo_sG3 =\n      \\ (ww_sFU [Just L] :: GHC.Prim.Int#) (ww_sFW [Just L] :: T.T\n    GHC.Base.Int) ->\n        case ww_sFU of ds_Xws [Just L] {\n          __DEFAULT ->\n        case GHC.Prim.remInt# ds_Xws 2 of wild1_aEZ [Dead Just A] {\n          __DEFAULT ->\n            case ww_sFW of tpl_B2 [Just L] { T.T a_sFo [Just A] ->\n            $wfoo_sG3 (GHC.Prim.-# ds_Xws 1) tpl_B2             -- $wfoo1\n            };\n          0 ->\n            case ww_sFW of wild_XB [Just A] { T.T n_ad7 [Just S(L)] ->\n            case n_ad7 of wild1_aFd [Just L] { GHC.Base.I# y_aFc [Just L] ->\n            $wfoo_sG3 (GHC.Prim.-# ds_Xws y_aFc) wild_XB        -- $wfoo2\n            } } };\n          0 -> 0 }\n\nWe get two specialisations:\n\"SC:$wfoo1\" [0] __forall {a_sFB :: GHC.Base.Int sc_sGC :: GHC.Prim.Int#}\n                  Foo.$wfoo sc_sGC (Foo.T @ GHC.Base.Int a_sFB)\n                  = Foo.$s$wfoo1 a_sFB sc_sGC ;\n\"SC:$wfoo2\" [0] __forall {y_aFp :: GHC.Prim.Int# sc_sGC :: GHC.Prim.Int#}\n                  Foo.$wfoo sc_sGC (Foo.T @ GHC.Base.Int (GHC.Base.I# y_aFp))\n                  = Foo.$s$wfoo y_aFp sc_sGC ;\n\nBut perhaps the first one isn't good.  After all, we know that tpl_B2 is\na T (I# x) really, because T is strict and Int has one constructor.  (We can't\nunbox the strict fields, because T is polymorphic!)\n\n************************************************************************\n*                                                                      *\n\\subsection{Top level wrapper stuff}\n*                                                                      *\n************************************************************************\n-}\n\nspecConstrProgram :: ModGuts -> CoreM ModGuts\nspecConstrProgram guts\n  = do\n      dflags <- getDynFlags\n      us     <- getUniqueSupplyM\n      annos  <- getFirstAnnotations deserializeWithData guts\n      this_mod <- getModule\n      let binds' = reverse $ fst $ initUs us $ do\n                    -- Note [Top-level recursive groups]\n                    (env, binds) <- goEnv (initScEnv dflags this_mod annos)\n                                          (mg_binds guts)\n                        -- binds is identical to (mg_binds guts), except that the\n                        -- binders on the LHS have been replaced by extendBndr\n                        --   (SPJ this seems like overkill; I don't think the binders\n                        --    will change at all; and we don't substitute in the RHSs anyway!!)\n                    go env nullUsage (reverse binds)\n\n      return (guts { mg_binds = binds' })\n  where\n    -- See Note [Top-level recursive groups]\n    goEnv env []            = return (env, [])\n    goEnv env (bind:binds)  = do (env', bind')   <- scTopBindEnv env bind\n                                 (env'', binds') <- goEnv env' binds\n                                 return (env'', bind' : binds')\n\n    -- Arg list of bindings is in reverse order\n    go _   _   []           = return []\n    go env usg (bind:binds) = do (usg', bind') <- scTopBind env usg bind\n                                 binds' <- go env usg' binds\n                                 return (bind' : binds')\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Environment: goes downwards}\n*                                                                      *\n************************************************************************\n\nNote [Work-free values only in environment]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe sc_vals field keeps track of in-scope value bindings, so\nthat if we come across (case x of Just y ->...) we can reduce the\ncase from knowing that x is bound to a pair.\n\nBut only *work-free* values are ok here. For example if the envt had\n    x -> Just (expensive v)\nthen we do NOT want to expand to\n     let y = expensive v in ...\nbecause the x-binding still exists and we've now duplicated (expensive v).\n\nThis seldom happens because let-bound constructor applications are\nANF-ised, but it can happen as a result of on-the-fly transformations in\nSpecConstr itself.  Here is Trac #7865:\n\n        let {\n          a'_shr =\n            case xs_af8 of _ {\n              [] -> acc_af6;\n              : ds_dgt [Dmd=<L,A>] ds_dgu [Dmd=<L,A>] ->\n                (expensive x_af7, x_af7\n            } } in\n        let {\n          ds_sht =\n            case a'_shr of _ { (p'_afd, q'_afe) ->\n            TSpecConstr_DoubleInline.recursive\n              (GHC.Types.: @ GHC.Types.Int x_af7 wild_X6) (q'_afe, p'_afd)\n            } } in\n\nWhen processed knowing that xs_af8 was bound to a cons, we simplify to\n   a'_shr = (expensive x_af7, x_af7)\nand we do NOT want to inline that at the occurrence of a'_shr in ds_sht.\n(There are other occurrences of a'_shr.)  No no no.\n\nIt would be possible to do some on-the-fly ANF-ising, so that a'_shr turned\ninto a work-free value again, thus\n   a1 = expensive x_af7\n   a'_shr = (a1, x_af7)\nbut that's more work, so until its shown to be important I'm going to\nleave it for now.\n\nNote [Making SpecConstr keener]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this, in (perf/should_run/T9339)\n   last (filter odd [1..1000])\n\nAfter optimisation, including SpecConstr, we get:\n   f :: Int# -> Int -> Int\n   f x y = case case remInt# x 2# of\n             __DEFAULT -> case x of\n                            __DEFAULT -> f (+# wild_Xp 1#) (I# x)\n                            1000000# -> ...\n             0# -> case x of\n                     __DEFAULT -> f (+# wild_Xp 1#) y\n                    1000000#   -> y\n\nNot good!  We build an (I# x) box every time around the loop.\nSpecConstr (as described in the paper) does not specialise f, despite\nthe call (f ... (I# x)) because 'y' is not scrutinied in the body.\nBut it is much better to specialise f for the case where the argument\nis of form (I# x); then we build the box only when returning y, which\nis on the cold path.\n\nAnother example:\n\n   f x = ...(g x)....\n\nHere 'x' is not scrutinised in f's body; but if we did specialise 'f'\nthen the call (g x) might allow 'g' to be specialised in turn.\n\nSo sc_keen controls whether or not we take account of whether argument is\nscrutinised in the body.  True <=> ignore that, and speicalise whenever\nthe function is applied to a data constructor.\n-}\n\ndata ScEnv = SCE { sc_dflags    :: DynFlags,\n                   sc_module    :: !Module,\n                   sc_size      :: Maybe Int,   -- Size threshold\n                                                -- Nothing => no limit\n\n                   sc_count     :: Maybe Int,   -- Max # of specialisations for any one fn\n                                                -- Nothing => no limit\n                                                -- See Note [Avoiding exponential blowup]\n\n                   sc_recursive :: Int,         -- Max # of specialisations over recursive type.\n                                                -- Stops ForceSpecConstr from diverging.\n\n                   sc_keen     :: Bool,         -- Specialise on arguments that are known\n                                                -- constructors, even if they are not\n                                                -- scrutinised in the body.  See\n                                                -- Note [Making SpecConstr keener]\n\n                   sc_force     :: Bool,        -- Force specialisation?\n                                                -- See Note [Forcing specialisation]\n\n                   sc_subst     :: Subst,       -- Current substitution\n                                                -- Maps InIds to OutExprs\n\n                   sc_how_bound :: HowBoundEnv,\n                        -- Binds interesting non-top-level variables\n                        -- Domain is OutVars (*after* applying the substitution)\n\n                   sc_vals      :: ValueEnv,\n                        -- Domain is OutIds (*after* applying the substitution)\n                        -- Used even for top-level bindings (but not imported ones)\n                        -- The range of the ValueEnv is *work-free* values\n                        -- such as (\\x. blah), or (Just v)\n                        -- but NOT (Just (expensive v))\n                        -- See Note [Work-free values only in environment]\n\n                   sc_annotations :: UniqFM SpecConstrAnnotation\n             }\n\n---------------------\ntype HowBoundEnv = VarEnv HowBound      -- Domain is OutVars\n\n---------------------\ntype ValueEnv = IdEnv Value             -- Domain is OutIds\ndata Value    = ConVal AltCon [CoreArg] -- _Saturated_ constructors\n                                        --   The AltCon is never DEFAULT\n              | LambdaVal               -- Inlinable lambdas or PAPs\n\ninstance Outputable Value where\n   ppr (ConVal con args) = ppr con <+> interpp'SP args\n   ppr LambdaVal         = text \"<Lambda>\"\n\n---------------------\ninitScEnv :: DynFlags -> Module -> UniqFM SpecConstrAnnotation -> ScEnv\ninitScEnv dflags this_mod anns\n  = SCE { sc_dflags      = dflags,\n          sc_module      = this_mod,\n          sc_size        = specConstrThreshold dflags,\n          sc_count       = specConstrCount     dflags,\n          sc_recursive   = specConstrRecursive dflags,\n          sc_keen        = gopt Opt_SpecConstrKeen dflags,\n          sc_force       = False,\n          sc_subst       = emptySubst,\n          sc_how_bound   = emptyVarEnv,\n          sc_vals        = emptyVarEnv,\n          sc_annotations = anns }\n\ndata HowBound = RecFun  -- These are the recursive functions for which\n                        -- we seek interesting call patterns\n\n              | RecArg  -- These are those functions' arguments, or their sub-components;\n                        -- we gather occurrence information for these\n\ninstance Outputable HowBound where\n  ppr RecFun = text \"RecFun\"\n  ppr RecArg = text \"RecArg\"\n\nscForce :: ScEnv -> Bool -> ScEnv\nscForce env b = env { sc_force = b }\n\nlookupHowBound :: ScEnv -> Id -> Maybe HowBound\nlookupHowBound env id = lookupVarEnv (sc_how_bound env) id\n\nscSubstId :: ScEnv -> Id -> CoreExpr\nscSubstId env v = lookupIdSubst (text \"scSubstId\") (sc_subst env) v\n\nscSubstTy :: ScEnv -> Type -> Type\nscSubstTy env ty = substTy (sc_subst env) ty\n\nscSubstCo :: ScEnv -> Coercion -> Coercion\nscSubstCo env co = substCo (sc_subst env) co\n\nzapScSubst :: ScEnv -> ScEnv\nzapScSubst env = env { sc_subst = zapSubstEnv (sc_subst env) }\n\nextendScInScope :: ScEnv -> [Var] -> ScEnv\n        -- Bring the quantified variables into scope\nextendScInScope env qvars = env { sc_subst = extendInScopeList (sc_subst env) qvars }\n\n        -- Extend the substitution\nextendScSubst :: ScEnv -> Var -> OutExpr -> ScEnv\nextendScSubst env var expr = env { sc_subst = extendSubst (sc_subst env) var expr }\n\nextendScSubstList :: ScEnv -> [(Var,OutExpr)] -> ScEnv\nextendScSubstList env prs = env { sc_subst = extendSubstList (sc_subst env) prs }\n\nextendHowBound :: ScEnv -> [Var] -> HowBound -> ScEnv\nextendHowBound env bndrs how_bound\n  = env { sc_how_bound = extendVarEnvList (sc_how_bound env)\n                            [(bndr,how_bound) | bndr <- bndrs] }\n\nextendBndrsWith :: HowBound -> ScEnv -> [Var] -> (ScEnv, [Var])\nextendBndrsWith how_bound env bndrs\n  = (env { sc_subst = subst', sc_how_bound = hb_env' }, bndrs')\n  where\n    (subst', bndrs') = substBndrs (sc_subst env) bndrs\n    hb_env' = sc_how_bound env `extendVarEnvList`\n                    [(bndr,how_bound) | bndr <- bndrs']\n\nextendBndrWith :: HowBound -> ScEnv -> Var -> (ScEnv, Var)\nextendBndrWith how_bound env bndr\n  = (env { sc_subst = subst', sc_how_bound = hb_env' }, bndr')\n  where\n    (subst', bndr') = substBndr (sc_subst env) bndr\n    hb_env' = extendVarEnv (sc_how_bound env) bndr' how_bound\n\nextendRecBndrs :: ScEnv -> [Var] -> (ScEnv, [Var])\nextendRecBndrs env bndrs  = (env { sc_subst = subst' }, bndrs')\n                      where\n                        (subst', bndrs') = substRecBndrs (sc_subst env) bndrs\n\nextendBndr :: ScEnv -> Var -> (ScEnv, Var)\nextendBndr  env bndr  = (env { sc_subst = subst' }, bndr')\n                      where\n                        (subst', bndr') = substBndr (sc_subst env) bndr\n\nextendValEnv :: ScEnv -> Id -> Maybe Value -> ScEnv\nextendValEnv env _  Nothing   = env\nextendValEnv env id (Just cv)\n | valueIsWorkFree cv      -- Don't duplicate work!!  Trac #7865\n = env { sc_vals = extendVarEnv (sc_vals env) id cv }\nextendValEnv env _ _ = env\n\nextendCaseBndrs :: ScEnv -> OutExpr -> OutId -> AltCon -> [Var] -> (ScEnv, [Var])\n-- When we encounter\n--      case scrut of b\n--          C x y -> ...\n-- we want to bind b, to (C x y)\n-- NB1: Extends only the sc_vals part of the envt\n-- NB2: Kill the dead-ness info on the pattern binders x,y, since\n--      they are potentially made alive by the [b -> C x y] binding\nextendCaseBndrs env scrut case_bndr con alt_bndrs\n   = (env2, alt_bndrs')\n where\n   live_case_bndr = not (isDeadBinder case_bndr)\n   env1 | Var v <- stripTicksTopE (const True) scrut\n                         = extendValEnv env v cval\n        | otherwise      = env  -- See Note [Add scrutinee to ValueEnv too]\n   env2 | live_case_bndr = extendValEnv env1 case_bndr cval\n        | otherwise      = env1\n\n   alt_bndrs' | case scrut of { Var {} -> True; _ -> live_case_bndr }\n              = map zap alt_bndrs\n              | otherwise\n              = alt_bndrs\n\n   cval = case con of\n                DEFAULT    -> Nothing\n                LitAlt {}  -> Just (ConVal con [])\n                DataAlt {} -> Just (ConVal con vanilla_args)\n                      where\n                        vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++\n                                       varsToCoreExprs alt_bndrs\n\n   zap v | isTyVar v = v                -- See NB2 above\n         | otherwise = zapIdOccInfo v\n\n\ndecreaseSpecCount :: ScEnv -> Int -> ScEnv\n-- See Note [Avoiding exponential blowup]\ndecreaseSpecCount env n_specs\n  = env { sc_force = False   -- See Note [Forcing specialisation]\n        , sc_count = case sc_count env of\n                       Nothing -> Nothing\n                       Just n  -> Just (n `div` (n_specs + 1)) }\n        -- The \"+1\" takes account of the original function;\n        -- See Note [Avoiding exponential blowup]\n\n---------------------------------------------------\n-- See Note [Forcing specialisation]\nignoreType    :: ScEnv -> Type   -> Bool\nignoreDataCon  :: ScEnv -> DataCon -> Bool\nforceSpecBndr :: ScEnv -> Var    -> Bool\n\nignoreDataCon env dc = ignoreTyCon env (dataConTyCon dc)\n\nignoreType env ty\n  = case tyConAppTyCon_maybe ty of\n      Just tycon -> ignoreTyCon env tycon\n      _          -> False\n\nignoreTyCon :: ScEnv -> TyCon -> Bool\nignoreTyCon env tycon\n  = lookupUFM (sc_annotations env) tycon == Just NoSpecConstr\n\nforceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTys . varType $ var\n\nforceSpecFunTy :: ScEnv -> Type -> Bool\nforceSpecFunTy env = any (forceSpecArgTy env) . fst . splitFunTys\n\nforceSpecArgTy :: ScEnv -> Type -> Bool\nforceSpecArgTy env ty\n  | Just ty' <- coreView ty = forceSpecArgTy env ty'\n\nforceSpecArgTy env ty\n  | Just (tycon, tys) <- splitTyConApp_maybe ty\n  , tycon /= funTyCon\n      = tyConName tycon == specTyConName\n        || lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr\n        || any (forceSpecArgTy env) tys\n\nforceSpecArgTy _ _ = False\n\n{-\nNote [Add scrutinee to ValueEnv too]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n   case x of y\n     (a,b) -> case b of c\n                I# v -> ...(f y)...\nBy the time we get to the call (f y), the ValueEnv\nwill have a binding for y, and for c\n    y -> (a,b)\n    c -> I# v\nBUT that's not enough!  Looking at the call (f y) we\nsee that y is pair (a,b), but we also need to know what 'b' is.\nSo in extendCaseBndrs we must *also* add the binding\n   b -> I# v\nelse we lose a useful specialisation for f.  This is necessary even\nthough the simplifier has systematically replaced uses of 'x' with 'y'\nand 'b' with 'c' in the code.  The use of 'b' in the ValueEnv came\nfrom outside the case.  See Trac #4908 for the live example.\n\nNote [Avoiding exponential blowup]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe sc_count field of the ScEnv says how many times we are prepared to\nduplicate a single function.  But we must take care with recursive\nspecialisations.  Consider\n\n        let $j1 = let $j2 = let $j3 = ...\n                            in\n                            ...$j3...\n                  in\n                  ...$j2...\n        in\n        ...$j1...\n\nIf we specialise $j1 then in each specialisation (as well as the original)\nwe can specialise $j2, and similarly $j3.  Even if we make just *one*\nspecialisation of each, because we also have the original we'll get 2^n\ncopies of $j3, which is not good.\n\nSo when recursively specialising we divide the sc_count by the number of\ncopies we are making at this level, including the original.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Usage information: flows upwards}\n*                                                                      *\n************************************************************************\n-}\n\ndata ScUsage\n   = SCU {\n        scu_calls :: CallEnv,           -- Calls\n                                        -- The functions are a subset of the\n                                        --      RecFuns in the ScEnv\n\n        scu_occs :: !(IdEnv ArgOcc)     -- Information on argument occurrences\n     }                                  -- The domain is OutIds\n\ntype CallEnv = IdEnv [Call]\ndata Call = Call Id [CoreArg] ValueEnv\n        -- The arguments of the call, together with the\n        -- env giving the constructor bindings at the call site\n        -- We keep the function mainly for debug output\n\ninstance Outputable ScUsage where\n  ppr (SCU { scu_calls = calls, scu_occs = occs })\n    = text \"SCU\" <+> braces (sep [ ptext (sLit \"calls =\") <+> ppr calls\n                                         , text \"occs =\" <+> ppr occs ])\n\ninstance Outputable Call where\n  ppr (Call fn args _) = ppr fn <+> fsep (map pprParendExpr args)\n\nnullUsage :: ScUsage\nnullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv }\n\ncombineCalls :: CallEnv -> CallEnv -> CallEnv\ncombineCalls = plusVarEnv_C (++)\n  where\n--    plus cs ds | length res > 1\n--               = pprTrace \"combineCalls\" (vcat [ text \"cs:\" <+> ppr cs\n--                                               , text \"ds:\" <+> ppr ds])\n--                 res\n--               | otherwise = res\n--       where\n--          res = cs ++ ds\n\ncombineUsage :: ScUsage -> ScUsage -> ScUsage\ncombineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2),\n                           scu_occs  = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) }\n\ncombineUsages :: [ScUsage] -> ScUsage\ncombineUsages [] = nullUsage\ncombineUsages us = foldr1 combineUsage us\n\nlookupOccs :: ScUsage -> [OutVar] -> (ScUsage, [ArgOcc])\nlookupOccs (SCU { scu_calls = sc_calls, scu_occs = sc_occs }) bndrs\n  = (SCU {scu_calls = sc_calls, scu_occs = delVarEnvList sc_occs bndrs},\n     [lookupVarEnv sc_occs b `orElse` NoOcc | b <- bndrs])\n\ndata ArgOcc = NoOcc     -- Doesn't occur at all; or a type argument\n            | UnkOcc    -- Used in some unknown way\n\n            | ScrutOcc  -- See Note [ScrutOcc]\n                 (DataConEnv [ArgOcc])   -- How the sub-components are used\n\ntype DataConEnv a = UniqFM a     -- Keyed by DataCon\n\n{- Note  [ScrutOcc]\n~~~~~~~~~~~~~~~~~~~\nAn occurrence of ScrutOcc indicates that the thing, or a `cast` version of the thing,\nis *only* taken apart or applied.\n\n  Functions, literal: ScrutOcc emptyUFM\n  Data constructors:  ScrutOcc subs,\n\nwhere (subs :: UniqFM [ArgOcc]) gives usage of the *pattern-bound* components,\nThe domain of the UniqFM is the Unique of the data constructor\n\nThe [ArgOcc] is the occurrences of the *pattern-bound* components\nof the data structure.  E.g.\n        data T a = forall b. MkT a b (b->a)\nA pattern binds b, x::a, y::b, z::b->a, but not 'a'!\n\n-}\n\ninstance Outputable ArgOcc where\n  ppr (ScrutOcc xs) = text \"scrut-occ\" <> ppr xs\n  ppr UnkOcc        = text \"unk-occ\"\n  ppr NoOcc         = text \"no-occ\"\n\nevalScrutOcc :: ArgOcc\nevalScrutOcc = ScrutOcc emptyUFM\n\n-- Experimentally, this vesion of combineOcc makes ScrutOcc \"win\", so\n-- that if the thing is scrutinised anywhere then we get to see that\n-- in the overall result, even if it's also used in a boxed way\n-- This might be too aggressive; see Note [Reboxing] Alternative 3\ncombineOcc :: ArgOcc -> ArgOcc -> ArgOcc\ncombineOcc NoOcc         occ           = occ\ncombineOcc occ           NoOcc         = occ\ncombineOcc (ScrutOcc xs) (ScrutOcc ys) = ScrutOcc (plusUFM_C combineOccs xs ys)\ncombineOcc UnkOcc        (ScrutOcc ys) = ScrutOcc ys\ncombineOcc (ScrutOcc xs) UnkOcc        = ScrutOcc xs\ncombineOcc UnkOcc        UnkOcc        = UnkOcc\n\ncombineOccs :: [ArgOcc] -> [ArgOcc] -> [ArgOcc]\ncombineOccs xs ys = zipWithEqual \"combineOccs\" combineOcc xs ys\n\nsetScrutOcc :: ScEnv -> ScUsage -> OutExpr -> ArgOcc -> ScUsage\n-- _Overwrite_ the occurrence info for the scrutinee, if the scrutinee\n-- is a variable, and an interesting variable\nsetScrutOcc env usg (Cast e _) occ      = setScrutOcc env usg e occ\nsetScrutOcc env usg (Tick _ e) occ      = setScrutOcc env usg e occ\nsetScrutOcc env usg (Var v)    occ\n  | Just RecArg <- lookupHowBound env v = usg { scu_occs = extendVarEnv (scu_occs usg) v occ }\n  | otherwise                           = usg\nsetScrutOcc _env usg _other _occ        -- Catch-all\n  = usg\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The main recursive function}\n*                                                                      *\n************************************************************************\n\nThe main recursive function gathers up usage information, and\ncreates specialised versions of functions.\n-}\n\nscExpr, scExpr' :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr)\n        -- The unique supply is needed when we invent\n        -- a new name for the specialised function and its args\n\nscExpr env e = scExpr' env e\n\nscExpr' env (Var v)      = case scSubstId env v of\n                            Var v' -> return (mkVarUsage env v' [], Var v')\n                            e'     -> scExpr (zapScSubst env) e'\n\nscExpr' env (Type t)     = return (nullUsage, Type (scSubstTy env t))\nscExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c))\nscExpr' _   e@(Lit {})   = return (nullUsage, e)\nscExpr' env (Tick t e)   = do (usg, e') <- scExpr env e\n                              return (usg, Tick t e')\nscExpr' env (Cast e co)  = do (usg, e') <- scExpr env e\n                              return (usg, mkCast e' (scSubstCo env co))\n                              -- Important to use mkCast here\n                              -- See Note [SpecConstr call patterns]\nscExpr' env e@(App _ _)  = scApp env (collectArgs e)\nscExpr' env (Lam b e)    = do let (env', b') = extendBndr env b\n                              (usg, e') <- scExpr env' e\n                              return (usg, Lam b' e')\n\nscExpr' env (Case scrut b ty alts)\n  = do  { (scrut_usg, scrut') <- scExpr env scrut\n        ; case isValue (sc_vals env) scrut' of\n                Just (ConVal con args) -> sc_con_app con args scrut'\n                _other                 -> sc_vanilla scrut_usg scrut'\n        }\n  where\n    sc_con_app con args scrut'  -- Known constructor; simplify\n     = do { let (_, bs, rhs) = findAlt con alts\n                                  `orElse` (DEFAULT, [], mkImpossibleExpr ty)\n                alt_env'     = extendScSubstList env ((b,scrut') : bs `zip` trimConArgs con args)\n          ; scExpr alt_env' rhs }\n\n    sc_vanilla scrut_usg scrut' -- Normal case\n     = do { let (alt_env,b') = extendBndrWith RecArg env b\n                        -- Record RecArg for the components\n\n          ; (alt_usgs, alt_occs, alts')\n                <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts\n\n          ; let scrut_occ  = foldr combineOcc NoOcc alt_occs\n                scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ\n                -- The combined usage of the scrutinee is given\n                -- by scrut_occ, which is passed to scScrut, which\n                -- in turn treats a bare-variable scrutinee specially\n\n          ; return (foldr combineUsage scrut_usg' alt_usgs,\n                    Case scrut' b' (scSubstTy env ty) alts') }\n\n    sc_alt env scrut' b' (con,bs,rhs)\n     = do { let (env1, bs1) = extendBndrsWith RecArg env bs\n                (env2, bs2) = extendCaseBndrs env1 scrut' b' con bs1\n          ; (usg, rhs') <- scExpr env2 rhs\n          ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2)\n                scrut_occ = case con of\n                               DataAlt dc -> ScrutOcc (unitUFM dc arg_occs)\n                               _          -> ScrutOcc emptyUFM\n          ; return (usg', b_occ `combineOcc` scrut_occ, (con, bs2, rhs')) }\n\nscExpr' env (Let (NonRec bndr rhs) body)\n  | isTyVar bndr        -- Type-lets may be created by doBeta\n  = scExpr' (extendScSubst env bndr rhs) body\n\n  | otherwise\n  = do  { let (body_env, bndr') = extendBndr env bndr\n        ; rhs_info  <- scRecRhs env (bndr',rhs)\n\n        ; let body_env2 = extendHowBound body_env [bndr'] RecFun\n                           -- Note [Local let bindings]\n              rhs'      = ri_new_rhs rhs_info\n              body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs')\n\n        ; (body_usg, body') <- scExpr body_env3 body\n\n          -- NB: For non-recursive bindings we inherit sc_force flag from\n          -- the parent function (see Note [Forcing specialisation])\n        ; (spec_usg, specs) <- specNonRec env body_usg rhs_info\n\n        ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' }\n                    `combineUsage` spec_usg,  -- Note [spec_usg includes rhs_usg]\n                  mkLets [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] body')\n        }\n\n\n-- A *local* recursive group: see Note [Local recursive groups]\nscExpr' env (Let (Rec prs) body)\n  = do  { let (bndrs,rhss)      = unzip prs\n              (rhs_env1,bndrs') = extendRecBndrs env bndrs\n              rhs_env2          = extendHowBound rhs_env1 bndrs' RecFun\n              force_spec        = any (forceSpecBndr env) bndrs'\n                -- Note [Forcing specialisation]\n\n        ; rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss)\n        ; (body_usg, body')     <- scExpr rhs_env2 body\n\n        -- NB: start specLoop from body_usg\n        ; (spec_usg, specs) <- specRec NotTopLevel (scForce rhs_env2 force_spec)\n                                       body_usg rhs_infos\n                -- Do not unconditionally generate specialisations from rhs_usgs\n                -- Instead use them only if we find an unspecialised call\n                -- See Note [Local recursive groups]\n\n        ; let all_usg = spec_usg `combineUsage` body_usg  -- Note [spec_usg includes rhs_usg]\n              bind'   = Rec (concat (zipWith ruleInfoBinds rhs_infos specs))\n\n        ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' },\n                  Let bind' body') }\n\n{-\nNote [Local let bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is not uncommon to find this\n\n   let $j = \\x. <blah> in ...$j True...$j True...\n\nHere $j is an arbitrary let-bound function, but it often comes up for\njoin points.  We might like to specialise $j for its call patterns.\nNotice the difference from a letrec, where we look for call patterns\nin the *RHS* of the function.  Here we look for call patterns in the\n*body* of the let.\n\nAt one point I predicated this on the RHS mentioning the outer\nrecursive function, but that's not essential and might even be\nharmful.  I'm not sure.\n-}\n\nscApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage, CoreExpr)\n\nscApp env (Var fn, args)        -- Function is a variable\n  = ASSERT( not (null args) )\n    do  { args_w_usgs <- mapM (scExpr env) args\n        ; let (arg_usgs, args') = unzip args_w_usgs\n              arg_usg = combineUsages arg_usgs\n        ; case scSubstId env fn of\n            fn'@(Lam {}) -> scExpr (zapScSubst env) (doBeta fn' args')\n                        -- Do beta-reduction and try again\n\n            Var fn' -> return (arg_usg `combineUsage` mkVarUsage env fn' args',\n                               mkApps (Var fn') args')\n\n            other_fn' -> return (arg_usg, mkApps other_fn' args') }\n                -- NB: doing this ignores any usage info from the substituted\n                --     function, but I don't think that matters.  If it does\n                --     we can fix it.\n  where\n    doBeta :: OutExpr -> [OutExpr] -> OutExpr\n    -- ToDo: adjust for System IF\n    doBeta (Lam bndr body) (arg : args) = Let (NonRec bndr arg) (doBeta body args)\n    doBeta fn              args         = mkApps fn args\n\n-- The function is almost always a variable, but not always.\n-- In particular, if this pass follows float-in,\n-- which it may, we can get\n--      (let f = ...f... in f) arg1 arg2\nscApp env (other_fn, args)\n  = do  { (fn_usg,   fn')   <- scExpr env other_fn\n        ; (arg_usgs, args') <- mapAndUnzipM (scExpr env) args\n        ; return (combineUsages arg_usgs `combineUsage` fn_usg, mkApps fn' args') }\n\n----------------------\nmkVarUsage :: ScEnv -> Id -> [CoreExpr] -> ScUsage\nmkVarUsage env fn args\n  = case lookupHowBound env fn of\n        Just RecFun -> SCU { scu_calls = unitVarEnv fn [Call fn args (sc_vals env)]\n                           , scu_occs  = emptyVarEnv }\n        Just RecArg -> SCU { scu_calls = emptyVarEnv\n                           , scu_occs  = unitVarEnv fn arg_occ }\n        Nothing     -> nullUsage\n  where\n    -- I rather think we could use UnkOcc all the time\n    arg_occ | null args = UnkOcc\n            | otherwise = evalScrutOcc\n\n----------------------\nscTopBindEnv :: ScEnv -> CoreBind -> UniqSM (ScEnv, CoreBind)\nscTopBindEnv env (Rec prs)\n  = do  { let (rhs_env1,bndrs') = extendRecBndrs env bndrs\n              rhs_env2          = extendHowBound rhs_env1 bndrs RecFun\n\n              prs'              = zip bndrs' rhss\n        ; return (rhs_env2, Rec prs') }\n  where\n    (bndrs,rhss) = unzip prs\n\nscTopBindEnv env (NonRec bndr rhs)\n  = do  { let (env1, bndr') = extendBndr env bndr\n              env2          = extendValEnv env1 bndr' (isValue (sc_vals env) rhs)\n        ; return (env2, NonRec bndr' rhs) }\n\n----------------------\nscTopBind :: ScEnv -> ScUsage -> CoreBind -> UniqSM (ScUsage, CoreBind)\n\n{-\nscTopBind _ usage _\n  | pprTrace \"scTopBind_usage\" (ppr (scu_calls usage)) False\n  = error \"false\"\n-}\n\nscTopBind env body_usage (Rec prs)\n  | Just threshold <- sc_size env\n  , not force_spec\n  , not (all (couldBeSmallEnoughToInline (sc_dflags env) threshold) rhss)\n                -- No specialisation\n  = -- pprTrace \"scTopBind: nospec\" (ppr bndrs) $\n    do  { (rhs_usgs, rhss')   <- mapAndUnzipM (scExpr env) rhss\n        ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) }\n\n  | otherwise   -- Do specialisation\n  = do  { rhs_infos <- mapM (scRecRhs env) prs\n\n        ; (spec_usage, specs) <- specRec TopLevel (scForce env force_spec)\n                                         body_usage rhs_infos\n\n        ; return (body_usage `combineUsage` spec_usage,\n                  Rec (concat (zipWith ruleInfoBinds rhs_infos specs))) }\n  where\n    (bndrs,rhss) = unzip prs\n    force_spec   = any (forceSpecBndr env) bndrs\n      -- Note [Forcing specialisation]\n\nscTopBind env usage (NonRec bndr rhs)   -- Oddly, we don't seem to specialise top-level non-rec functions\n  = do  { (rhs_usg', rhs') <- scExpr env rhs\n        ; return (usage `combineUsage` rhs_usg', NonRec bndr rhs') }\n\n----------------------\nscRecRhs :: ScEnv -> (OutId, InExpr) -> UniqSM RhsInfo\nscRecRhs env (bndr,rhs)\n  = do  { let (arg_bndrs,body)       = collectBinders rhs\n              (body_env, arg_bndrs') = extendBndrsWith RecArg env arg_bndrs\n        ; (body_usg, body')         <- scExpr body_env body\n        ; let (rhs_usg, arg_occs)    = lookupOccs body_usg arg_bndrs'\n        ; return (RI { ri_rhs_usg = rhs_usg\n                     , ri_fn = bndr, ri_new_rhs = mkLams arg_bndrs' body'\n                     , ri_lam_bndrs = arg_bndrs, ri_lam_body = body\n                     , ri_arg_occs = arg_occs }) }\n                -- The arg_occs says how the visible,\n                -- lambda-bound binders of the RHS are used\n                -- (including the TyVar binders)\n                -- Two pats are the same if they match both ways\n\n----------------------\nruleInfoBinds :: RhsInfo -> SpecInfo -> [(Id,CoreExpr)]\nruleInfoBinds (RI { ri_fn = fn, ri_new_rhs = new_rhs })\n              (SI { si_specs = specs })\n  = [(id,rhs) | OS { os_id = id, os_rhs = rhs } <- specs] ++\n              -- First the specialised bindings\n\n    [(fn `addIdSpecialisations` rules, new_rhs)]\n              -- And now the original binding\n  where\n    rules = [r | OS { os_rule = r } <- specs]\n\n{-\n************************************************************************\n*                                                                      *\n                The specialiser itself\n*                                                                      *\n************************************************************************\n-}\n\ndata RhsInfo\n  = RI { ri_fn :: OutId                 -- The binder\n       , ri_new_rhs :: OutExpr          -- The specialised RHS (in current envt)\n       , ri_rhs_usg :: ScUsage          -- Usage info from specialising RHS\n\n       , ri_lam_bndrs :: [InVar]       -- The *original* RHS (\\xs.body)\n       , ri_lam_body  :: InExpr        --   Note [Specialise original body]\n       , ri_arg_occs  :: [ArgOcc]      -- Info on how the xs occur in body\n    }\n\ndata SpecInfo       -- Info about specialisations for a particular Id\n  = SI { si_specs :: [OneSpec]          -- The specialisations we have generated\n\n       , si_n_specs :: Int              -- Length of si_specs; used for numbering them\n\n       , si_mb_unspec :: Maybe ScUsage  -- Just cs  => we have not yet used calls in the\n       }                                --             from calls in the *original* RHS as\n                                        --             seeds for new specialisations;\n                                        --             if you decide to do so, here is the\n                                        --             RHS usage (which has not yet been\n                                        --             unleashed)\n                                        -- Nothing => we have\n                                        -- See Note [Local recursive groups]\n                                        -- See Note [spec_usg includes rhs_usg]\n\n        -- One specialisation: Rule plus definition\ndata OneSpec =\n  OS { os_pat  :: CallPat    -- Call pattern that generated this specialisation\n     , os_rule :: CoreRule   -- Rule connecting original id with the specialisation\n     , os_id   :: OutId      -- Spec id\n     , os_rhs  :: OutExpr }  -- Spec rhs\n\nnoSpecInfo :: SpecInfo\nnoSpecInfo = SI { si_specs = [], si_n_specs = 0, si_mb_unspec = Nothing }\n\n----------------------\nspecNonRec :: ScEnv\n           -> ScUsage         -- Body usage\n           -> RhsInfo         -- Structure info usage info for un-specialised RHS\n           -> UniqSM (ScUsage, SpecInfo)       -- Usage from RHSs (specialised and not)\n                                               --     plus details of specialisations\n\nspecNonRec env body_usg rhs_info\n  = specialise env (scu_calls body_usg) rhs_info\n               (noSpecInfo { si_mb_unspec = Just (ri_rhs_usg rhs_info) })\n\n----------------------\nspecRec :: TopLevelFlag -> ScEnv\n        -> ScUsage                         -- Body usage\n        -> [RhsInfo]                       -- Structure info and usage info for un-specialised RHSs\n        -> UniqSM (ScUsage, [SpecInfo])    -- Usage from all RHSs (specialised and not)\n                                           --     plus details of specialisations\n\nspecRec top_lvl env body_usg rhs_infos\n  = go 1 seed_calls nullUsage init_spec_infos\n  where\n    (seed_calls, init_spec_infos)    -- Note [Seeding top-level recursive groups]\n       | isTopLevel top_lvl\n       , any (isExportedId . ri_fn) rhs_infos   -- Seed from body and RHSs\n       = (all_calls,     [noSpecInfo | _ <- rhs_infos])\n       | otherwise                              -- Seed from body only\n       = (calls_in_body, [noSpecInfo { si_mb_unspec = Just (ri_rhs_usg ri) }\n                         | ri <- rhs_infos])\n\n    calls_in_body = scu_calls body_usg\n    calls_in_rhss = foldr (combineCalls . scu_calls . ri_rhs_usg) emptyVarEnv rhs_infos\n    all_calls = calls_in_rhss `combineCalls` calls_in_body\n\n    -- Loop, specialising, until you get no new specialisations\n    go :: Int   -- Which iteration of the \"until no new specialisations\"\n                -- loop we are on; first iteration is 1\n       -> CallEnv   -- Seed calls\n                    -- Two accumulating parameters:\n       -> ScUsage      -- Usage from earlier specialisations\n       -> [SpecInfo]   -- Details of specialisations so far\n       -> UniqSM (ScUsage, [SpecInfo])\n    go n_iter seed_calls usg_so_far spec_infos\n      | isEmptyVarEnv seed_calls\n      = -- pprTrace \"specRec1\" (vcat [ ppr (map ri_fn rhs_infos)\n        --                           , ppr seed_calls\n        --                           , ppr body_usg ]) $\n        return (usg_so_far, spec_infos)\n\n      -- Limit recursive specialisation\n      -- See Note [Limit recursive specialisation]\n      | n_iter > sc_recursive env  -- Too many iterations of the 'go' loop\n      , sc_force env || isNothing (sc_count env)\n           -- If both of these are false, the sc_count\n           -- threshold will prevent non-termination\n      , any ((> the_limit) . si_n_specs) spec_infos\n      = -- pprTrace \"specRec2\" (ppr (map (map os_pat . si_specs) spec_infos)) $\n        return (usg_so_far, spec_infos)\n\n      | otherwise\n      = -- pprTrace \"specRec3\" (vcat [ text \"bndrs\" <+> ppr (map ri_fn rhs_infos)\n        --                           , text \"iteration\" <+> int n_iter\n        --                          , text \"spec_infos\" <+> ppr (map (map os_pat . si_specs) spec_infos)\n        --                    ]) $\n        do  { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos\n            ; let (extra_usg_s, new_spec_infos) = unzip specs_w_usg\n                  extra_usg = combineUsages extra_usg_s\n                  all_usg   = usg_so_far `combineUsage` extra_usg\n            ; go (n_iter + 1) (scu_calls extra_usg) all_usg new_spec_infos }\n\n    -- See Note [Limit recursive specialisation]\n    the_limit = case sc_count env of\n                  Nothing  -> 10    -- Ugh!\n                  Just max -> max\n\n\n----------------------\nspecialise\n   :: ScEnv\n   -> CallEnv                     -- Info on newly-discovered calls to this function\n   -> RhsInfo\n   -> SpecInfo                    -- Original RHS plus patterns dealt with\n   -> UniqSM (ScUsage, SpecInfo)  -- New specialised versions and their usage\n\n-- See Note [spec_usg includes rhs_usg]\n\n-- Note: this only generates *specialised* bindings\n-- The original binding is added by ruleInfoBinds\n--\n-- Note: the rhs here is the optimised version of the original rhs\n-- So when we make a specialised copy of the RHS, we're starting\n-- from an RHS whose nested functions have been optimised already.\n\nspecialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs\n                              , ri_lam_body = body, ri_arg_occs = arg_occs })\n               spec_info@(SI { si_specs = specs, si_n_specs = spec_count\n                             , si_mb_unspec = mb_unspec })\n  | isBottomingId fn      -- Note [Do not specialise diverging functions]\n                          -- and do not generate specialisation seeds from its RHS\n  = -- pprTrace \"specialise bot\" (ppr fn) $\n    return (nullUsage, spec_info)\n\n  | isNeverActive (idInlineActivation fn) -- See Note [Transfer activation]\n    || null arg_bndrs                     -- Only specialise functions\n  = -- pprTrace \"specialise inactive\" (ppr fn) $\n    case mb_unspec of    -- Behave as if there was a single, boring call\n      Just rhs_usg -> return (rhs_usg, spec_info { si_mb_unspec = Nothing })\n                         -- See Note [spec_usg includes rhs_usg]\n      Nothing      -> return (nullUsage, spec_info)\n\n  | Just all_calls <- lookupVarEnv bind_calls fn\n  = -- pprTrace \"specialise entry {\" (ppr fn <+> ppr all_calls) $\n    do  { (boring_call, new_pats) <- callsToNewPats env fn spec_info arg_occs all_calls\n\n        ; let n_pats = length new_pats\n--        ; if (not (null new_pats) || isJust mb_unspec) then\n--            pprTrace \"specialise\" (vcat [ ppr fn <+> text \"with\" <+> int n_pats <+> text \"good patterns\"\n--                                        , text \"mb_unspec\" <+> ppr (isJust mb_unspec)\n--                                        , text \"arg_occs\" <+> ppr arg_occs\n--                                        , text \"good pats\" <+> ppr new_pats])  $\n--               return ()\n--          else return ()\n\n        ; let spec_env = decreaseSpecCount env n_pats\n        ; (spec_usgs, new_specs) <- mapAndUnzipM (spec_one spec_env fn arg_bndrs body)\n                                                 (new_pats `zip` [spec_count..])\n                -- See Note [Specialise original body]\n\n        ; let spec_usg = combineUsages spec_usgs\n\n              -- If there were any boring calls among the seeds (= all_calls), then those\n              -- calls will call the un-specialised function.  So we should use the seeds\n              -- from the _unspecialised_ function's RHS, which are in mb_unspec, by returning\n              -- then in new_usg.\n              (new_usg, mb_unspec')\n                  = case mb_unspec of\n                      Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing)\n                      _                          -> (spec_usg,                      mb_unspec)\n\n--        ; pprTrace \"specialise return }\"\n--             (vcat [ ppr fn\n--                   , text \"boring_call:\" <+> ppr boring_call\n--                   , text \"new calls:\" <+> ppr (scu_calls new_usg)]) $\n--          return ()\n\n          ; return (new_usg, SI { si_specs = new_specs ++ specs\n                                , si_n_specs = spec_count + n_pats\n                                , si_mb_unspec = mb_unspec' }) }\n\n  | otherwise  -- No new seeds, so return nullUsage\n  = return (nullUsage, spec_info)\n\n\n\n\n---------------------\nspec_one :: ScEnv\n         -> OutId       -- Function\n         -> [InVar]     -- Lambda-binders of RHS; should match patterns\n         -> InExpr      -- Body of the original function\n         -> (CallPat, Int)\n         -> UniqSM (ScUsage, OneSpec)   -- Rule and binding\n\n-- spec_one creates a specialised copy of the function, together\n-- with a rule for using it.  I'm very proud of how short this\n-- function is, considering what it does :-).\n\n{-\n  Example\n\n     In-scope: a, x::a\n     f = /\\b \\y::[(a,b)] -> ....f (b,c) ((:) (a,(b,c)) (x,v) (h w))...\n          [c::*, v::(b,c) are presumably bound by the (...) part]\n  ==>\n     f_spec = /\\ b c \\ v::(b,c) hw::[(a,(b,c))] ->\n                  (...entire body of f...) [b -> (b,c),\n                                            y -> ((:) (a,(b,c)) (x,v) hw)]\n\n     RULE:  forall b::* c::*,           -- Note, *not* forall a, x\n                   v::(b,c),\n                   hw::[(a,(b,c))] .\n\n            f (b,c) ((:) (a,(b,c)) (x,v) hw) = f_spec b c v hw\n-}\n\nspec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)\n  = do  { spec_uniq <- getUniqueM\n        ; let spec_env   = extendScSubstList (extendScInScope env qvars)\n                                             (arg_bndrs `zip` pats)\n              fn_name    = idName fn\n              fn_loc     = nameSrcSpan fn_name\n              fn_occ     = nameOccName fn_name\n              spec_occ   = mkSpecOcc fn_occ\n              -- We use fn_occ rather than fn in the rule_name string\n              -- as we don't want the uniq to end up in the rule, and\n              -- hence in the ABI, as that can cause spurious ABI\n              -- changes (#4012).\n              rule_name  = mkFastString (\"SC:\" ++ occNameString fn_occ ++ show rule_number)\n              spec_name  = mkInternalName spec_uniq spec_occ fn_loc\n--      ; pprTrace \"{spec_one\" (ppr (sc_count env) <+> ppr fn\n--                              <+> ppr pats <+> text \"-->\" <+> ppr spec_name) $\n--        return ()\n\n        -- Specialise the body\n        ; (spec_usg, spec_body) <- scExpr spec_env body\n\n--      ; pprTrace \"done spec_one}\" (ppr fn) $\n--        return ()\n\n                -- And build the results\n        ; let (spec_lam_args, spec_call_args) = mkWorkerArgs (sc_dflags env)\n                                                             qvars body_ty\n                -- Usual w/w hack to avoid generating\n                -- a spec_rhs of unlifted type and no args\n\n              spec_lam_args_str = handOutStrictnessInformation (fst (splitStrictSig spec_str)) spec_lam_args\n                -- Annotate the variables with the strictness information from\n                -- the function (see Note [Strictness information in worker binders])\n\n              spec_join_arity | isJoinId fn = Just (length spec_lam_args)\n                              | otherwise   = Nothing\n              spec_id    = mkLocalIdOrCoVar spec_name\n                                            (mkLamTypes spec_lam_args body_ty)\n                             -- See Note [Transfer strictness]\n                             `setIdStrictness` spec_str\n                             `setIdArity` count isId spec_lam_args\n                             `asJoinId_maybe` spec_join_arity\n              spec_str   = calcSpecStrictness fn spec_lam_args pats\n\n\n                -- Conditionally use result of new worker-wrapper transform\n              spec_rhs   = mkLams spec_lam_args_str spec_body\n              body_ty    = exprType spec_body\n              rule_rhs   = mkVarApps (Var spec_id) spec_call_args\n              inline_act = idInlineActivation fn\n              this_mod   = sc_module spec_env\n              rule       = mkRule this_mod True {- Auto -} True {- Local -}\n                                  rule_name inline_act fn_name qvars pats rule_rhs\n                           -- See Note [Transfer activation]\n        ; return (spec_usg, OS { os_pat = call_pat, os_rule = rule\n                               , os_id = spec_id\n                               , os_rhs = spec_rhs }) }\n\n\n-- See Note [Strictness information in worker binders]\nhandOutStrictnessInformation :: [Demand] -> [Var] -> [Var]\nhandOutStrictnessInformation = go\n  where\n    go _ [] = []\n    go [] vs = vs\n    go (d:dmds) (v:vs) | isId v = setIdDemandInfo v d : go dmds vs\n    go dmds (v:vs) = v : go dmds vs\n\ncalcSpecStrictness :: Id                     -- The original function\n                   -> [Var] -> [CoreExpr]    -- Call pattern\n                   -> StrictSig              -- Strictness of specialised thing\n-- See Note [Transfer strictness]\ncalcSpecStrictness fn qvars pats\n  = mkClosedStrictSig spec_dmds topRes\n  where\n    spec_dmds = [ lookupVarEnv dmd_env qv `orElse` topDmd | qv <- qvars, isId qv ]\n    StrictSig (DmdType _ dmds _) = idStrictness fn\n\n    dmd_env = go emptyVarEnv dmds pats\n\n    go :: DmdEnv -> [Demand] -> [CoreExpr] -> DmdEnv\n    go env ds (Type {} : pats)     = go env ds pats\n    go env ds (Coercion {} : pats) = go env ds pats\n    go env (d:ds) (pat : pats)     = go (go_one env d pat) ds pats\n    go env _      _                = env\n\n    go_one :: DmdEnv -> Demand -> CoreExpr -> DmdEnv\n    go_one env d   (Var v) = extendVarEnv_C bothDmd env v d\n    go_one env d e\n           | Just ds <- splitProdDmd_maybe d  -- NB: d does not have to be strict\n           , (Var _, args) <- collectArgs e = go env ds args\n    go_one env _         _ = env\n\n{-\nNote [spec_usg includes rhs_usg]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn calls to 'specialise', the returned ScUsage must include the rhs_usg in\nthe passed-in SpecInfo, unless there are no calls at all to the function.\n\nThe caller can, indeed must, assume this.  He should not combine in rhs_usg\nhimself, or he'll get rhs_usg twice -- and that can lead to an exponential\nblowup of duplicates in the CallEnv.  This is what gave rise to the massive\nperformance loss in Trac #8852.\n\nNote [Specialise original body]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe RhsInfo for a binding keeps the *original* body of the binding.  We\nmust specialise that, *not* the result of applying specExpr to the RHS\n(which is also kept in RhsInfo). Otherwise we end up specialising a\nspecialised RHS, and that can lead directly to exponential behaviour.\n\nNote [Transfer activation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n  This note is for SpecConstr, but exactly the same thing\n  happens in the overloading specialiser; see\n  Note [Auto-specialisation and RULES] in Specialise.\n\nIn which phase should the specialise-constructor rules be active?\nOriginally I made them always-active, but Manuel found that this\ndefeated some clever user-written rules.  Then I made them active only\nin Phase 0; after all, currently, the specConstr transformation is\nonly run after the simplifier has reached Phase 0, but that meant\nthat specialisations didn't fire inside wrappers; see test\nsimplCore/should_compile/spec-inline.\n\nSo now I just use the inline-activation of the parent Id, as the\nactivation for the specialisation RULE, just like the main specialiser;\n\nThis in turn means there is no point in specialising NOINLINE things,\nso we test for that.\n\nNote [Transfer strictness]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must transfer strictness information from the original function to\nthe specialised one.  Suppose, for example\n\n  f has strictness     SS\n        and a RULE     f (a:as) b = f_spec a as b\n\nNow we want f_spec to have strictness  LLS, otherwise we'll use call-by-need\nwhen calling f_spec instead of call-by-value.  And that can result in\nunbounded worsening in space (cf the classic foldl vs foldl')\n\nSee Trac #3437 for a good example.\n\nThe function calcSpecStrictness performs the calculation.\n\nNote [Strictness information in worker binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nAfter having calculated the strictness annotation for the worker (see Note\n[Transfer strictness] above), we also want to have this information attached to\nthe worker\u00e2\u20ac\u2122s arguments, for the benefit of later passes. The function\nhandOutStrictnessInformation decomposes the strictness annotation calculated by\ncalcSpecStrictness and attaches them to the variables.\n\n************************************************************************\n*                                                                      *\n\\subsection{Argument analysis}\n*                                                                      *\n************************************************************************\n\nThis code deals with analysing call-site arguments to see whether\nthey are constructor applications.\n\nNote [Free type variables of the qvar types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a call (f @a x True), that we want to specialise, what variables should\nwe quantify over.  Clearly over 'a' and 'x', but what about any type variables\nfree in x's type?  In fact we don't need to worry about them because (f @a)\ncan only be a well-typed application if its type is compatible with x, so any\nvariables free in x's type must be free in (f @a), and hence either be gathered\nvia 'a' itself, or be in scope at f's defn.  Hence we just take\n  (exprsFreeVars pats).\n\nBUT phantom type synonyms can mess this reasoning up,\n  eg   x::T b   with  type T b = Int\nSo we apply expandTypeSynonyms to the bound Ids.\nSee Trac # 5458.  Yuk.\n\nNote [SpecConstr call patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA \"call patterns\" that we collect is going to become the LHS of a RULE.\nIt's important that it doesn't have\n     e |> Refl\nor\n    e |> g1 |> g2\nbecause both of these will be optimised by Simplify.simplRule. In the\nformer case such optimisation benign, because the rule will match more\nterms; but in the latter we may lose a binding of 'g1' or 'g2', and\nend up with a rule LHS that doesn't bind the template variables\n(Trac #10602).\n\nThe simplifier eliminates such things, but SpecConstr itself constructs\nnew terms by substituting.  So the 'mkCast' in the Cast case of scExpr\nis very important!\n\nNote [Choosing patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~\nIf we get lots of patterns we may not want to make a specialisation\nfor each of them (code bloat), so we choose as follows, implemented\nby trim_pats.\n\n* The flag -fspec-constr-count-N sets the sc_count field\n  of the ScEnv to (Just n).  This limits the total number\n  of specialisations for a given function to N.\n\n* -fno-spec-constr-count sets the sc_count field to Nothing,\n  which switches of the limit.\n\n* The ghastly ForceSpecConstr trick also switches of the limit\n  for a particular function\n\n* Otherwise we sort the patterns to choose the most general\n  ones first; more general => more widely applicable.\n\nNote [SpecConstr and casts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #14270) a call like\n\n    let f = e\n    in ... f (K @(a |> co)) ...\n\nwhere 'co' is a coercion variable not in scope at f's definition site.\nIf we aren't caereful we'll get\n\n    let $sf a co = e (K @(a |> co))\n        RULE \"SC:f\" forall a co.  f (K @(a |> co)) = $sf a co\n        f = e\n    in ...\n\nBut alas, when we match the call we won't bind 'co', because type-matching\n(for good reasons) discards casts).\n\nI don't know how to solve this, so for now I'm just discarding any\ncall patterns that\n  * Mentions a coercion variable in a type argument\n  * That is not in scope at the binding of the function\n\nI think this is very rare.\n\nIt is important (e.g. Trac #14936) that this /only/ applies to\ncoercions mentioned in casts.  We don't want to be discombobulated\nby casts in terms!  For example, consider\n   f ((e1,e2) |> sym co)\nwhere, say,\n   f  :: Foo -> blah\n   co :: Foo ~R (Int,Int)\n\nHere we definitely do want to specialise for that pair!  We do not\nmatch on the structre of the coercion; instead we just match on a\ncoercion variable, so the RULE looks like\n\n   forall (x::Int, y::Int, co :: (Int,Int) ~R Foo)\n     f ((x,y) |> co) = $sf x y co\n\nOften the body of f looks like\n   f arg = ...(case arg |> co' of\n                (x,y) -> blah)...\n\nso that the specialised f will turn into\n   $sf x y co = let arg = (x,y) |> co\n                in ...(case arg>| co' of\n                         (x,y) -> blah)....\n\nwhich will simplify to not use 'co' at all.  But we can't guarantee\nthat co will end up unused, so we still pass it.  Absence analysis\nmay remove it later.\n\nNote that this /also/ discards the call pattern if we have a cast in a\n/term/, although in fact Rules.match does make a very flaky and\nfragile attempt to match coercions.  e.g. a call like\n    f (Maybe Age) (Nothing |> co) blah\n    where co :: Maybe Int ~ Maybe Age\nwill be discarded.  It's extremely fragile to match on the form of a\ncoercion, so I think it's better just not to try.  A more complicated\nalternative would be to discard calls that mention coercion variables\nonly in kind-casts, but I'm doing the simple thing for now.\n-}\n\ntype CallPat = ([Var], [CoreExpr])      -- Quantified variables and arguments\n                                        -- See Note [SpecConstr call patterns]\n\ncallsToNewPats :: ScEnv -> Id\n               -> SpecInfo\n               -> [ArgOcc] -> [Call]\n               -> UniqSM (Bool, [CallPat])\n        -- Result has no duplicate patterns,\n        -- nor ones mentioned in done_pats\n        -- Bool indicates that there was at least one boring pattern\ncallsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls\n  = do  { mb_pats <- mapM (callToPats env bndr_occs) calls\n\n        ; let have_boring_call = any isNothing mb_pats\n\n              good_pats :: [CallPat]\n              good_pats = catMaybes mb_pats\n\n              -- Remove patterns we have already done\n              new_pats = filterOut is_done good_pats\n              is_done p = any (samePat p . os_pat) done_specs\n\n              -- Remove duplicates\n              non_dups = nubBy samePat new_pats\n\n              -- Remove ones that have too many worker variables\n              small_pats = filterOut too_big non_dups\n              too_big (vars,_) = not (isWorkerSmallEnough (sc_dflags env) vars)\n                  -- We are about to construct w/w pair in 'spec_one'.\n                  -- Omit specialisation leading to high arity workers.\n                  -- See Note [Limit w/w arity] in WwLib\n\n                -- Discard specialisations if there are too many of them\n              trimmed_pats = trim_pats env fn spec_info small_pats\n\n--        ; pprTrace \"callsToPats\" (vcat [ text \"calls to\" <+> ppr fn <> colon <+> ppr calls\n--                                       , text \"done_specs:\" <+> ppr (map os_pat done_specs)\n--                                       , text \"good_pats:\" <+> ppr good_pats ]) $\n--          return ()\n\n        ; return (have_boring_call, trimmed_pats) }\n\n\ntrim_pats :: ScEnv -> Id -> SpecInfo -> [CallPat] -> [CallPat]\n-- See Note [Choosing patterns]\ntrim_pats env fn (SI { si_n_specs = done_spec_count }) pats\n  | sc_force env\n    || isNothing mb_scc\n    || n_remaining >= n_pats\n  = -- pprTrace \"trim_pats: no-trim\" (ppr (sc_force env) $$ ppr mb_scc $$ ppr n_remaining $$ ppr n_pats)\n    pats          -- No need to trim\n\n  | otherwise\n  = emit_trace $  -- Need to trim, so keep the best ones\n    take n_remaining sorted_pats\n\n  where\n    n_pats         = length pats\n    spec_count'    = n_pats + done_spec_count\n    n_remaining    = max_specs - done_spec_count\n    mb_scc         = sc_count env\n    Just max_specs = mb_scc\n\n    sorted_pats = map fst $\n                  sortBy (comparing snd) $\n                  [(pat, pat_cons pat) | pat <- pats]\n     -- Sort in order of increasing number of constructors\n     -- (i.e. decreasing generality) and pick the initial\n     -- segment of this list\n\n    pat_cons :: CallPat -> Int\n    -- How many data constructors of literals are in\n    -- the pattern.  More data-cons => less general\n    pat_cons (qs, ps) = foldr ((+) . n_cons) 0 ps\n       where\n          q_set = mkVarSet qs\n          n_cons (Var v) | v `elemVarSet` q_set = 0\n                         | otherwise            = 1\n          n_cons (Cast e _)  = n_cons e\n          n_cons (App e1 e2) = n_cons e1 + n_cons e2\n          n_cons (Lit {})    = 1\n          n_cons _           = 0\n\n    emit_trace result\n       | debugIsOn || hasPprDebug (sc_dflags env)\n         -- Suppress this scary message for ordinary users!  Trac #5125\n       = pprTrace \"SpecConstr\" msg result\n       | otherwise\n       = result\n    msg = vcat [ sep [ text \"Function\" <+> quotes (ppr fn)\n                     , nest 2 (text \"has\" <+>\n                               speakNOf spec_count' (text \"call pattern\") <> comma <+>\n                               text \"but the limit is\" <+> int max_specs) ]\n               , text \"Use -fspec-constr-count=n to set the bound\"\n               , text \"done_spec_count =\" <+> int done_spec_count\n               , text \"Keeping \" <+> int n_remaining <> text \", out of\" <+> int n_pats\n               , text \"Discarding:\" <+> ppr (drop n_remaining sorted_pats) ]\n\n\ncallToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat)\n        -- The [Var] is the variables to quantify over in the rule\n        --      Type variables come first, since they may scope\n        --      over the following term variables\n        -- The [CoreExpr] are the argument patterns for the rule\ncallToPats env bndr_occs call@(Call _ args con_env)\n  | args `ltLength` bndr_occs      -- Check saturated\n  = return Nothing\n  | otherwise\n  = do  { let in_scope = substInScope (sc_subst env)\n        ; (interesting, pats) <- argsToPats env in_scope con_env args bndr_occs\n        ; let pat_fvs = exprsFreeVarsList pats\n                -- To get determinism we need the list of free variables in\n                -- deterministic order. Otherwise we end up creating\n                -- lambdas with different argument orders. See\n                -- determinism/simplCore/should_compile/spec-inline-determ.hs\n                -- for an example. For explanation of determinism\n                -- considerations See Note [Unique Determinism] in Unique.\n\n              in_scope_vars = getInScopeVars in_scope\n              is_in_scope v = v `elemVarSet` in_scope_vars\n              qvars         = filterOut is_in_scope pat_fvs\n                -- Quantify over variables that are not in scope\n                -- at the call site\n                -- See Note [Free type variables of the qvar types]\n                -- See Note [Shadowing] at the top\n\n              (ktvs, ids)   = partition isTyVar qvars\n              qvars'        = scopedSort ktvs ++ map sanitise ids\n                -- Order into kind variables, type variables, term variables\n                -- The kind of a type variable may mention a kind variable\n                -- and the type of a term variable may mention a type variable\n\n              sanitise id   = id `setIdType` expandTypeSynonyms (idType id)\n                -- See Note [Free type variables of the qvar types]\n\n              -- Bad coercion variables: see Note [SpecConstr and casts]\n              bad_covars :: CoVarSet\n              bad_covars = mapUnionVarSet get_bad_covars pats\n              get_bad_covars :: CoreArg -> CoVarSet\n              get_bad_covars (Type ty)\n                = filterVarSet (\\v -> isId v && not (is_in_scope v)) $\n                  tyCoVarsOfType ty\n              get_bad_covars _\n                = emptyVarSet\n\n        ; -- pprTrace \"callToPats\"  (ppr args $$ ppr bndr_occs) $\n          WARN( not (isEmptyVarSet bad_covars)\n              , text \"SpecConstr: bad covars:\" <+> ppr bad_covars\n                $$ ppr call )\n          if interesting && isEmptyVarSet bad_covars\n          then return (Just (qvars', pats))\n          else return Nothing }\n\n    -- argToPat takes an actual argument, and returns an abstracted\n    -- version, consisting of just the \"constructor skeleton\" of the\n    -- argument, with non-constructor sub-expression replaced by new\n    -- placeholder variables.  For example:\n    --    C a (D (f x) (g y))  ==>  C p1 (D p2 p3)\n\nargToPat :: ScEnv\n         -> InScopeSet                  -- What's in scope at the fn defn site\n         -> ValueEnv                    -- ValueEnv at the call site\n         -> CoreArg                     -- A call arg (or component thereof)\n         -> ArgOcc\n         -> UniqSM (Bool, CoreArg)\n\n-- Returns (interesting, pat),\n-- where pat is the pattern derived from the argument\n--            interesting=True if the pattern is non-trivial (not a variable or type)\n-- E.g.         x:xs         --> (True, x:xs)\n--              f xs         --> (False, w)        where w is a fresh wildcard\n--              (f xs, 'c')  --> (True, (w, 'c'))  where w is a fresh wildcard\n--              \\x. x+y      --> (True, \\x. x+y)\n--              lvl7         --> (True, lvl7)      if lvl7 is bound\n--                                                 somewhere further out\n\nargToPat _env _in_scope _val_env arg@(Type {}) _arg_occ\n  = return (False, arg)\n\nargToPat env in_scope val_env (Tick _ arg) arg_occ\n  = argToPat env in_scope val_env arg arg_occ\n        -- Note [Notes in call patterns]\n        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        -- Ignore Notes.  In particular, we want to ignore any InlineMe notes\n        -- Perhaps we should not ignore profiling notes, but I'm going to\n        -- ride roughshod over them all for now.\n        --- See Note [Notes in RULE matching] in Rules\n\nargToPat env in_scope val_env (Let _ arg) arg_occ\n  = argToPat env in_scope val_env arg arg_occ\n        -- See Note [Matching lets] in Rule.hs\n        -- Look through let expressions\n        -- e.g.         f (let v = rhs in (v,w))\n        -- Here we can specialise for f (v,w)\n        -- because the rule-matcher will look through the let.\n\n{- Disabled; see Note [Matching cases] in Rule.hs\nargToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ\n  | exprOkForSpeculation scrut  -- See Note [Matching cases] in Rule.hhs\n  = argToPat env in_scope val_env rhs arg_occ\n-}\n\nargToPat env in_scope val_env (Cast arg co) arg_occ\n  | not (ignoreType env ty2)\n  = do  { (interesting, arg') <- argToPat env in_scope val_env arg arg_occ\n        ; if not interesting then\n                wildCardPat ty2\n          else do\n        { -- Make a wild-card pattern for the coercion\n          uniq <- getUniqueM\n        ; let co_name = mkSysTvName uniq (fsLit \"sg\")\n              co_var  = mkCoVar co_name (mkCoercionType Representational ty1 ty2)\n        ; return (interesting, Cast arg' (mkCoVarCo co_var)) } }\n  where\n    Pair ty1 ty2 = coercionKind co\n\n\n\n{-      Disabling lambda specialisation for now\n        It's fragile, and the spec_loop can be infinite\nargToPat in_scope val_env arg arg_occ\n  | is_value_lam arg\n  = return (True, arg)\n  where\n    is_value_lam (Lam v e)         -- Spot a value lambda, even if\n        | isId v       = True      -- it is inside a type lambda\n        | otherwise    = is_value_lam e\n    is_value_lam other = False\n-}\n\n  -- Check for a constructor application\n  -- NB: this *precedes* the Var case, so that we catch nullary constrs\nargToPat env in_scope val_env arg arg_occ\n  | Just (ConVal (DataAlt dc) args) <- isValue val_env arg\n  , not (ignoreDataCon env dc)        -- See Note [NoSpecConstr]\n  , Just arg_occs <- mb_scrut dc\n  = do  { let (ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) args\n        ; (_, args') <- argsToPats env in_scope val_env rest_args arg_occs\n        ; return (True,\n                  mkConApp dc (ty_args ++ args')) }\n  where\n    mb_scrut dc = case arg_occ of\n                    ScrutOcc bs | Just occs <- lookupUFM bs dc\n                                -> Just (occs)  -- See Note [Reboxing]\n                    _other      | sc_force env || sc_keen env\n                                -> Just (repeat UnkOcc)\n                                | otherwise\n                                -> Nothing\n\n  -- Check if the argument is a variable that\n  --    (a) is used in an interesting way in the function body\n  --    (b) we know what its value is\n  -- In that case it counts as \"interesting\"\nargToPat env in_scope val_env (Var v) arg_occ\n  | sc_force env || case arg_occ of { UnkOcc -> False; _other -> True }, -- (a)\n    is_value,                                                            -- (b)\n       -- Ignoring sc_keen here to avoid gratuitously incurring Note [Reboxing]\n       -- So sc_keen focused just on f (I# x), where we have freshly-allocated\n       -- box that we can eliminate in the caller\n    not (ignoreType env (varType v))\n  = return (True, Var v)\n  where\n    is_value\n        | isLocalId v = v `elemInScopeSet` in_scope\n                        && isJust (lookupVarEnv val_env v)\n                -- Local variables have values in val_env\n        | otherwise   = isValueUnfolding (idUnfolding v)\n                -- Imports have unfoldings\n\n--      I'm really not sure what this comment means\n--      And by not wild-carding we tend to get forall'd\n--      variables that are in scope, which in turn can\n--      expose the weakness in let-matching\n--      See Note [Matching lets] in Rules\n\n  -- Check for a variable bound inside the function.\n  -- Don't make a wild-card, because we may usefully share\n  --    e.g.  f a = let x = ... in f (x,x)\n  -- NB: this case follows the lambda and con-app cases!!\n-- argToPat _in_scope _val_env (Var v) _arg_occ\n--   = return (False, Var v)\n        -- SLPJ : disabling this to avoid proliferation of versions\n        -- also works badly when thinking about seeding the loop\n        -- from the body of the let\n        --       f x y = letrec g z = ... in g (x,y)\n        -- We don't want to specialise for that *particular* x,y\n\n  -- The default case: make a wild-card\n  -- We use this for coercions too\nargToPat _env _in_scope _val_env arg _arg_occ\n  = wildCardPat (exprType arg)\n\nwildCardPat :: Type -> UniqSM (Bool, CoreArg)\nwildCardPat ty\n  = do { uniq <- getUniqueM\n       ; let id = mkSysLocalOrCoVar (fsLit \"sc\") uniq ty\n       ; return (False, varToCoreExpr id) }\n\nargsToPats :: ScEnv -> InScopeSet -> ValueEnv\n           -> [CoreArg] -> [ArgOcc]  -- Should be same length\n           -> UniqSM (Bool, [CoreArg])\nargsToPats env in_scope val_env args occs\n  = do { stuff <- zipWithM (argToPat env in_scope val_env) args occs\n       ; let (interesting_s, args') = unzip stuff\n       ; return (or interesting_s, args') }\n\nisValue :: ValueEnv -> CoreExpr -> Maybe Value\nisValue _env (Lit lit)\n  | litIsLifted lit = Nothing\n  | otherwise       = Just (ConVal (LitAlt lit) [])\n\nisValue env (Var v)\n  | Just cval <- lookupVarEnv env v\n  = Just cval  -- You might think we could look in the idUnfolding here\n               -- but that doesn't take account of which branch of a\n               -- case we are in, which is the whole point\n\n  | not (isLocalId v) && isCheapUnfolding unf\n  = isValue env (unfoldingTemplate unf)\n  where\n    unf = idUnfolding v\n        -- However we do want to consult the unfolding\n        -- as well, for let-bound constructors!\n\nisValue env (Lam b e)\n  | isTyVar b = case isValue env e of\n                  Just _  -> Just LambdaVal\n                  Nothing -> Nothing\n  | otherwise = Just LambdaVal\n\nisValue env (Tick t e)\n  | not (tickishIsCode t)\n  = isValue env e\n\nisValue _env expr       -- Maybe it's a constructor application\n  | (Var fun, args, _) <- collectArgsTicks (not . tickishIsCode) expr\n  = case isDataConWorkId_maybe fun of\n\n        Just con | args `lengthAtLeast` dataConRepArity con\n                -- Check saturated; might be > because the\n                --                  arity excludes type args\n                -> Just (ConVal (DataAlt con) args)\n\n        _other | valArgCount args < idArity fun\n                -- Under-applied function\n               -> Just LambdaVal        -- Partial application\n\n        _other -> Nothing\n\nisValue _env _expr = Nothing\n\nvalueIsWorkFree :: Value -> Bool\nvalueIsWorkFree LambdaVal       = True\nvalueIsWorkFree (ConVal _ args) = all exprIsWorkFree args\n\nsamePat :: CallPat -> CallPat -> Bool\nsamePat (vs1, as1) (vs2, as2)\n  = all2 same as1 as2\n  where\n    same (Var v1) (Var v2)\n        | v1 `elem` vs1 = v2 `elem` vs2\n        | v2 `elem` vs2 = False\n        | otherwise     = v1 == v2\n\n    same (Lit l1)    (Lit l2)    = l1==l2\n    same (App f1 a1) (App f2 a2) = same f1 f2 && same a1 a2\n\n    same (Type {}) (Type {}) = True     -- Note [Ignore type differences]\n    same (Coercion {}) (Coercion {}) = True\n    same (Tick _ e1) e2 = same e1 e2  -- Ignore casts and notes\n    same (Cast e1 _) e2 = same e1 e2\n    same e1 (Tick _ e2) = same e1 e2\n    same e1 (Cast e2 _) = same e1 e2\n\n    same e1 e2 = WARN( bad e1 || bad e2, ppr e1 $$ ppr e2)\n                 False  -- Let, lambda, case should not occur\n    bad (Case {}) = True\n    bad (Let {})  = True\n    bad (Lam {})  = True\n    bad _other    = False\n\n{-\nNote [Ignore type differences]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe do not want to generate specialisations where the call patterns\ndiffer only in their type arguments!  Not only is it utterly useless,\nbut it also means that (with polymorphic recursion) we can generate\nan infinite number of specialisations. Example is Data.Sequence.adjustTree,\nI think.\n-}\n", "num_lines": 2357}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\\section[Specialise]{Stamping out overloading, and (optionally) polymorphism}\n-}\n\n{-# LANGUAGE CPP #-}\nmodule Specialise ( specProgram, specUnfolding ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Id\nimport TcType hiding( substTy )\nimport Type   hiding( substTy, extendTvSubstList )\nimport Module( Module, HasModule(..) )\nimport Coercion( Coercion )\nimport CoreMonad\nimport qualified CoreSubst\nimport CoreUnfold\nimport Var              ( isLocalVar )\nimport VarSet\nimport VarEnv\nimport CoreSyn\nimport Rules\nimport CoreOpt          ( collectBindersPushingCo )\nimport CoreUtils        ( exprIsTrivial, applyTypeToArgs, mkCast )\nimport CoreFVs\nimport CoreArity        ( etaExpandToJoinPointRule )\nimport UniqSupply\nimport Name\nimport MkId             ( voidArgId, voidPrimId )\nimport Maybes           ( catMaybes, isJust )\nimport MonadUtils       ( foldlM )\nimport BasicTypes\nimport HscTypes\nimport Bag\nimport DynFlags\nimport Util\nimport Outputable\nimport FastString\nimport State\nimport UniqDFM\n\nimport Control.Monad\nimport qualified Control.Monad.Fail as MonadFail\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[notes-Specialise]{Implementation notes [SLPJ, Aug 18 1993]}\n*                                                                      *\n************************************************************************\n\nThese notes describe how we implement specialisation to eliminate\noverloading.\n\nThe specialisation pass works on Core\nsyntax, complete with all the explicit dictionary application,\nabstraction and construction as added by the type checker.  The\nexisting type checker remains largely as it is.\n\nOne important thought: the {\\em types} passed to an overloaded\nfunction, and the {\\em dictionaries} passed are mutually redundant.\nIf the same function is applied to the same type(s) then it is sure to\nbe applied to the same dictionary(s)---or rather to the same {\\em\nvalues}.  (The arguments might look different but they will evaluate\nto the same value.)\n\nSecond important thought: we know that we can make progress by\ntreating dictionary arguments as static and worth specialising on.  So\nwe can do without binding-time analysis, and instead specialise on\ndictionary arguments and no others.\n\nThe basic idea\n~~~~~~~~~~~~~~\nSuppose we have\n\n        let f = <f_rhs>\n        in <body>\n\nand suppose f is overloaded.\n\nSTEP 1: CALL-INSTANCE COLLECTION\n\nWe traverse <body>, accumulating all applications of f to types and\ndictionaries.\n\n(Might there be partial applications, to just some of its types and\ndictionaries?  In principle yes, but in practice the type checker only\nbuilds applications of f to all its types and dictionaries, so partial\napplications could only arise as a result of transformation, and even\nthen I think it's unlikely.  In any case, we simply don't accumulate such\npartial applications.)\n\n\nSTEP 2: EQUIVALENCES\n\nSo now we have a collection of calls to f:\n        f t1 t2 d1 d2\n        f t3 t4 d3 d4\n        ...\nNotice that f may take several type arguments.  To avoid ambiguity, we\nsay that f is called at type t1/t2 and t3/t4.\n\nWe take equivalence classes using equality of the *types* (ignoring\nthe dictionary args, which as mentioned previously are redundant).\n\nSTEP 3: SPECIALISATION\n\nFor each equivalence class, choose a representative (f t1 t2 d1 d2),\nand create a local instance of f, defined thus:\n\n        f@t1/t2 = <f_rhs> t1 t2 d1 d2\n\nf_rhs presumably has some big lambdas and dictionary lambdas, so lots\nof simplification will now result.  However we don't actually *do* that\nsimplification.  Rather, we leave it for the simplifier to do.  If we\n*did* do it, though, we'd get more call instances from the specialised\nRHS.  We can work out what they are by instantiating the call-instance\nset from f's RHS with the types t1, t2.\n\nAdd this new id to f's IdInfo, to record that f has a specialised version.\n\nBefore doing any of this, check that f's IdInfo doesn't already\ntell us about an existing instance of f at the required type/s.\n(This might happen if specialisation was applied more than once, or\nit might arise from user SPECIALIZE pragmas.)\n\nRecursion\n~~~~~~~~~\nWait a minute!  What if f is recursive?  Then we can't just plug in\nits right-hand side, can we?\n\nBut it's ok.  The type checker *always* creates non-recursive definitions\nfor overloaded recursive functions.  For example:\n\n        f x = f (x+x)           -- Yes I know its silly\n\nbecomes\n\n        f a (d::Num a) = let p = +.sel a d\n                         in\n                         letrec fl (y::a) = fl (p y y)\n                         in\n                         fl\n\nWe still have recursion for non-overloaded functions which we\nspecialise, but the recursive call should get specialised to the\nsame recursive version.\n\n\nPolymorphism 1\n~~~~~~~~~~~~~~\n\nAll this is crystal clear when the function is applied to *constant\ntypes*; that is, types which have no type variables inside.  But what if\nit is applied to non-constant types?  Suppose we find a call of f at type\nt1/t2.  There are two possibilities:\n\n(a) The free type variables of t1, t2 are in scope at the definition point\nof f.  In this case there's no problem, we proceed just as before.  A common\nexample is as follows.  Here's the Haskell:\n\n        g y = let f x = x+x\n              in f y + f y\n\nAfter typechecking we have\n\n        g a (d::Num a) (y::a) = let f b (d'::Num b) (x::b) = +.sel b d' x x\n                                in +.sel a d (f a d y) (f a d y)\n\nNotice that the call to f is at type type \"a\"; a non-constant type.\nBoth calls to f are at the same type, so we can specialise to give:\n\n        g a (d::Num a) (y::a) = let f@a (x::a) = +.sel a d x x\n                                in +.sel a d (f@a y) (f@a y)\n\n\n(b) The other case is when the type variables in the instance types\nare *not* in scope at the definition point of f.  The example we are\nworking with above is a good case.  There are two instances of (+.sel a d),\nbut \"a\" is not in scope at the definition of +.sel.  Can we do anything?\nYes, we can \"common them up\", a sort of limited common sub-expression deal.\nThis would give:\n\n        g a (d::Num a) (y::a) = let +.sel@a = +.sel a d\n                                    f@a (x::a) = +.sel@a x x\n                                in +.sel@a (f@a y) (f@a y)\n\nThis can save work, and can't be spotted by the type checker, because\nthe two instances of +.sel weren't originally at the same type.\n\nFurther notes on (b)\n\n* There are quite a few variations here.  For example, the defn of\n  +.sel could be floated ouside the \\y, to attempt to gain laziness.\n  It certainly mustn't be floated outside the \\d because the d has to\n  be in scope too.\n\n* We don't want to inline f_rhs in this case, because\nthat will duplicate code.  Just commoning up the call is the point.\n\n* Nothing gets added to +.sel's IdInfo.\n\n* Don't bother unless the equivalence class has more than one item!\n\nNot clear whether this is all worth it.  It is of course OK to\nsimply discard call-instances when passing a big lambda.\n\nPolymorphism 2 -- Overloading\n~~~~~~~~~~~~~~\nConsider a function whose most general type is\n\n        f :: forall a b. Ord a => [a] -> b -> b\n\nThere is really no point in making a version of g at Int/Int and another\nat Int/Bool, because it's only instantiating the type variable \"a\" which\nbuys us any efficiency. Since g is completely polymorphic in b there\nain't much point in making separate versions of g for the different\nb types.\n\nThat suggests that we should identify which of g's type variables\nare constrained (like \"a\") and which are unconstrained (like \"b\").\nThen when taking equivalence classes in STEP 2, we ignore the type args\ncorresponding to unconstrained type variable.  In STEP 3 we make\npolymorphic versions.  Thus:\n\n        f@t1/ = /\\b -> <f_rhs> t1 b d1 d2\n\nWe do this.\n\n\nDictionary floating\n~~~~~~~~~~~~~~~~~~~\nConsider this\n\n        f a (d::Num a) = let g = ...\n                         in\n                         ...(let d1::Ord a = Num.Ord.sel a d in g a d1)...\n\nHere, g is only called at one type, but the dictionary isn't in scope at the\ndefinition point for g.  Usually the type checker would build a\ndefinition for d1 which enclosed g, but the transformation system\nmight have moved d1's defn inward.  Solution: float dictionary bindings\noutwards along with call instances.\n\nConsider\n\n        f x = let g p q = p==q\n                  h r s = (r+s, g r s)\n              in\n              h x x\n\n\nBefore specialisation, leaving out type abstractions we have\n\n        f df x = let g :: Eq a => a -> a -> Bool\n                     g dg p q = == dg p q\n                     h :: Num a => a -> a -> (a, Bool)\n                     h dh r s = let deq = eqFromNum dh\n                                in (+ dh r s, g deq r s)\n              in\n              h df x x\n\nAfter specialising h we get a specialised version of h, like this:\n\n                    h' r s = let deq = eqFromNum df\n                             in (+ df r s, g deq r s)\n\nBut we can't naively make an instance for g from this, because deq is not in scope\nat the defn of g.  Instead, we have to float out the (new) defn of deq\nto widen its scope.  Notice that this floating can't be done in advance -- it only\nshows up when specialisation is done.\n\nUser SPECIALIZE pragmas\n~~~~~~~~~~~~~~~~~~~~~~~\nSpecialisation pragmas can be digested by the type checker, and implemented\nby adding extra definitions along with that of f, in the same way as before\n\n        f@t1/t2 = <f_rhs> t1 t2 d1 d2\n\nIndeed the pragmas *have* to be dealt with by the type checker, because\nonly it knows how to build the dictionaries d1 and d2!  For example\n\n        g :: Ord a => [a] -> [a]\n        {-# SPECIALIZE f :: [Tree Int] -> [Tree Int] #-}\n\nHere, the specialised version of g is an application of g's rhs to the\nOrd dictionary for (Tree Int), which only the type checker can conjure\nup.  There might not even *be* one, if (Tree Int) is not an instance of\nOrd!  (All the other specialision has suitable dictionaries to hand\nfrom actual calls.)\n\nProblem.  The type checker doesn't have to hand a convenient <f_rhs>, because\nit is buried in a complex (as-yet-un-desugared) binding group.\nMaybe we should say\n\n        f@t1/t2 = f* t1 t2 d1 d2\n\nwhere f* is the Id f with an IdInfo which says \"inline me regardless!\".\nIndeed all the specialisation could be done in this way.\nThat in turn means that the simplifier has to be prepared to inline absolutely\nany in-scope let-bound thing.\n\n\nAgain, the pragma should permit polymorphism in unconstrained variables:\n\n        h :: Ord a => [a] -> b -> b\n        {-# SPECIALIZE h :: [Int] -> b -> b #-}\n\nWe *insist* that all overloaded type variables are specialised to ground types,\n(and hence there can be no context inside a SPECIALIZE pragma).\nWe *permit* unconstrained type variables to be specialised to\n        - a ground type\n        - or left as a polymorphic type variable\nbut nothing in between.  So\n\n        {-# SPECIALIZE h :: [Int] -> [c] -> [c] #-}\n\nis *illegal*.  (It can be handled, but it adds complication, and gains the\nprogrammer nothing.)\n\n\nSPECIALISING INSTANCE DECLARATIONS\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n        instance Foo a => Foo [a] where\n                ...\n        {-# SPECIALIZE instance Foo [Int] #-}\n\nThe original instance decl creates a dictionary-function\ndefinition:\n\n        dfun.Foo.List :: forall a. Foo a -> Foo [a]\n\nThe SPECIALIZE pragma just makes a specialised copy, just as for\nordinary function definitions:\n\n        dfun.Foo.List@Int :: Foo [Int]\n        dfun.Foo.List@Int = dfun.Foo.List Int dFooInt\n\nThe information about what instance of the dfun exist gets added to\nthe dfun's IdInfo in the same way as a user-defined function too.\n\n\nAutomatic instance decl specialisation?\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCan instance decls be specialised automatically?  It's tricky.\nWe could collect call-instance information for each dfun, but\nthen when we specialised their bodies we'd get new call-instances\nfor ordinary functions; and when we specialised their bodies, we might get\nnew call-instances of the dfuns, and so on.  This all arises because of\nthe unrestricted mutual recursion between instance decls and value decls.\n\nStill, there's no actual problem; it just means that we may not do all\nthe specialisation we could theoretically do.\n\nFurthermore, instance decls are usually exported and used non-locally,\nso we'll want to compile enough to get those specialisations done.\n\nLastly, there's no such thing as a local instance decl, so we can\nsurvive solely by spitting out *usage* information, and then reading that\nback in as a pragma when next compiling the file.  So for now,\nwe only specialise instance decls in response to pragmas.\n\n\nSPITTING OUT USAGE INFORMATION\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nTo spit out usage information we need to traverse the code collecting\ncall-instance information for all imported (non-prelude?) functions\nand data types. Then we equivalence-class it and spit it out.\n\nThis is done at the top-level when all the call instances which escape\nmust be for imported functions and data types.\n\n*** Not currently done ***\n\n\nPartial specialisation by pragmas\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat about partial specialisation:\n\n        k :: (Ord a, Eq b) => [a] -> b -> b -> [a]\n        {-# SPECIALIZE k :: Eq b => [Int] -> b -> b -> [a] #-}\n\nor even\n\n        {-# SPECIALIZE k :: Eq b => [Int] -> [b] -> [b] -> [a] #-}\n\nSeems quite reasonable.  Similar things could be done with instance decls:\n\n        instance (Foo a, Foo b) => Foo (a,b) where\n                ...\n        {-# SPECIALIZE instance Foo a => Foo (a,Int) #-}\n        {-# SPECIALIZE instance Foo b => Foo (Int,b) #-}\n\nHo hum.  Things are complex enough without this.  I pass.\n\n\nRequirements for the simplifier\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe simplifier has to be able to take advantage of the specialisation.\n\n* When the simplifier finds an application of a polymorphic f, it looks in\nf's IdInfo in case there is a suitable instance to call instead.  This converts\n\n        f t1 t2 d1 d2   ===>   f_t1_t2\n\nNote that the dictionaries get eaten up too!\n\n* Dictionary selection operations on constant dictionaries must be\n  short-circuited:\n\n        +.sel Int d     ===>  +Int\n\nThe obvious way to do this is in the same way as other specialised\ncalls: +.sel has inside it some IdInfo which tells that if it's applied\nto the type Int then it should eat a dictionary and transform to +Int.\n\nIn short, dictionary selectors need IdInfo inside them for constant\nmethods.\n\n* Exactly the same applies if a superclass dictionary is being\n  extracted:\n\n        Eq.sel Int d   ===>   dEqInt\n\n* Something similar applies to dictionary construction too.  Suppose\ndfun.Eq.List is the function taking a dictionary for (Eq a) to\none for (Eq [a]).  Then we want\n\n        dfun.Eq.List Int d      ===> dEq.List_Int\n\nWhere does the Eq [Int] dictionary come from?  It is built in\nresponse to a SPECIALIZE pragma on the Eq [a] instance decl.\n\nIn short, dfun Ids need IdInfo with a specialisation for each\nconstant instance of their instance declaration.\n\nAll this uses a single mechanism: the SpecEnv inside an Id\n\n\nWhat does the specialisation IdInfo look like?\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe SpecEnv of an Id maps a list of types (the template) to an expression\n\n        [Type]  |->  Expr\n\nFor example, if f has this RuleInfo:\n\n        [Int, a]  ->  \\d:Ord Int. f' a\n\nit means that we can replace the call\n\n        f Int t  ===>  (\\d. f' t)\n\nThis chucks one dictionary away and proceeds with the\nspecialised version of f, namely f'.\n\n\nWhat can't be done this way?\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere is no way, post-typechecker, to get a dictionary for (say)\nEq a from a dictionary for Eq [a].  So if we find\n\n        ==.sel [t] d\n\nwe can't transform to\n\n        eqList (==.sel t d')\n\nwhere\n        eqList :: (a->a->Bool) -> [a] -> [a] -> Bool\n\nOf course, we currently have no way to automatically derive\neqList, nor to connect it to the Eq [a] instance decl, but you\ncan imagine that it might somehow be possible.  Taking advantage\nof this is permanently ruled out.\n\nStill, this is no great hardship, because we intend to eliminate\noverloading altogether anyway!\n\nA note about non-tyvar dictionaries\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSome Ids have types like\n\n        forall a,b,c. Eq a -> Ord [a] -> tau\n\nThis seems curious at first, because we usually only have dictionary\nargs whose types are of the form (C a) where a is a type variable.\nBut this doesn't hold for the functions arising from instance decls,\nwhich sometimes get arguments with types of form (C (T a)) for some\ntype constructor T.\n\nShould we specialise wrt this compound-type dictionary?  We used to say\n\"no\", saying:\n        \"This is a heuristic judgement, as indeed is the fact that we\n        specialise wrt only dictionaries.  We choose *not* to specialise\n        wrt compound dictionaries because at the moment the only place\n        they show up is in instance decls, where they are simply plugged\n        into a returned dictionary.  So nothing is gained by specialising\n        wrt them.\"\n\nBut it is simpler and more uniform to specialise wrt these dicts too;\nand in future GHC is likely to support full fledged type signatures\nlike\n        f :: Eq [(a,b)] => ...\n\n\n************************************************************************\n*                                                                      *\n\\subsubsection{The new specialiser}\n*                                                                      *\n************************************************************************\n\nOur basic game plan is this.  For let(rec) bound function\n        f :: (C a, D c) => (a,b,c,d) -> Bool\n\n* Find any specialised calls of f, (f ts ds), where\n  ts are the type arguments t1 .. t4, and\n  ds are the dictionary arguments d1 .. d2.\n\n* Add a new definition for f1 (say):\n\n        f1 = /\\ b d -> (..body of f..) t1 b t3 d d1 d2\n\n  Note that we abstract over the unconstrained type arguments.\n\n* Add the mapping\n\n        [t1,b,t3,d]  |->  \\d1 d2 -> f1 b d\n\n  to the specialisations of f.  This will be used by the\n  simplifier to replace calls\n                (f t1 t2 t3 t4) da db\n  by\n                (\\d1 d1 -> f1 t2 t4) da db\n\n  All the stuff about how many dictionaries to discard, and what types\n  to apply the specialised function to, are handled by the fact that the\n  SpecEnv contains a template for the result of the specialisation.\n\nWe don't build *partial* specialisations for f.  For example:\n\n  f :: Eq a => a -> a -> Bool\n  {-# SPECIALISE f :: (Eq b, Eq c) => (b,c) -> (b,c) -> Bool #-}\n\nHere, little is gained by making a specialised copy of f.\nThere's a distinct danger that the specialised version would\nfirst build a dictionary for (Eq b, Eq c), and then select the (==)\nmethod from it!  Even if it didn't, not a great deal is saved.\n\nWe do, however, generate polymorphic, but not overloaded, specialisations:\n\n  f :: Eq a => [a] -> b -> b -> b\n  ... SPECIALISE f :: [Int] -> b -> b -> b ...\n\nHence, the invariant is this:\n\n        *** no specialised version is overloaded ***\n\n\n************************************************************************\n*                                                                      *\n\\subsubsection{The exported function}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Specialise calls to type-class overloaded functions occuring in a program.\nspecProgram :: ModGuts -> CoreM ModGuts\nspecProgram guts@(ModGuts { mg_module = this_mod\n                          , mg_rules = local_rules\n                          , mg_binds = binds })\n  = do { dflags <- getDynFlags\n\n             -- Specialise the bindings of this module\n       ; (binds', uds) <- runSpecM dflags this_mod (go binds)\n\n             -- Specialise imported functions\n       ; hpt_rules <- getRuleBase\n       ; let rule_base = extendRuleBaseList hpt_rules local_rules\n       ; (new_rules, spec_binds) <- specImports dflags this_mod top_env emptyVarSet\n                                                [] rule_base uds\n\n       ; let final_binds\n               | null spec_binds = binds'\n               | otherwise       = Rec (flattenBinds spec_binds) : binds'\n                   -- Note [Glom the bindings if imported functions are specialised]\n\n       ; return (guts { mg_binds = final_binds\n                      , mg_rules = new_rules ++ local_rules }) }\n  where\n        -- We need to start with a Subst that knows all the things\n        -- that are in scope, so that the substitution engine doesn't\n        -- accidentally re-use a unique that's already in use\n        -- Easiest thing is to do it all at once, as if all the top-level\n        -- decls were mutually recursive\n    top_env = SE { se_subst = CoreSubst.mkEmptySubst $ mkInScopeSet $ mkVarSet $\n                              bindersOfBinds binds\n                 , se_interesting = emptyVarSet }\n\n    go []           = return ([], emptyUDs)\n    go (bind:binds) = do (binds', uds) <- go binds\n                         (bind', uds') <- specBind top_env bind uds\n                         return (bind' ++ binds', uds')\n\n{-\nNote [Wrap bindings returned by specImports]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n'specImports' returns a set of specialized bindings. However, these are lacking\nnecessary floated dictionary bindings, which are returned by\nUsageDetails(ud_binds). These dictionaries need to be brought into scope with\n'wrapDictBinds' before the bindings returned by 'specImports' can be used. See,\nfor instance, the 'specImports' call in 'specProgram'.\n\n\nNote [Disabling cross-module specialisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSince GHC 7.10 we have performed specialisation of INLINABLE bindings living\nin modules outside of the current module. This can sometimes uncover user code\nwhich explodes in size when aggressively optimized. The\n-fno-cross-module-specialise option was introduced to allow users to being\nbitten by such instances to revert to the pre-7.10 behavior.\n\nSee Trac #10491\n-}\n\n-- | Specialise a set of calls to imported bindings\nspecImports :: DynFlags\n            -> Module\n            -> SpecEnv          -- Passed in so that all top-level Ids are in scope\n            -> VarSet           -- Don't specialise these ones\n                                -- See Note [Avoiding recursive specialisation]\n            -> [Id]             -- Stack of imported functions being specialised\n            -> RuleBase         -- Rules from this module and the home package\n                                -- (but not external packages, which can change)\n            -> UsageDetails     -- Calls for imported things, and floating bindings\n            -> CoreM ( [CoreRule]   -- New rules\n                     , [CoreBind] ) -- Specialised bindings\n                                    -- See Note [Wrapping bindings returned by specImports]\nspecImports dflags this_mod top_env done callers rule_base\n            (MkUD { ud_binds = dict_binds, ud_calls = calls })\n  -- See Note [Disabling cross-module specialisation]\n  | not $ gopt Opt_CrossModuleSpecialise dflags\n  = return ([], [])\n\n  | otherwise\n  = do { let import_calls = dVarEnvElts calls\n       ; (rules, spec_binds) <- go rule_base import_calls\n\n             -- Don't forget to wrap the specialized bindings with\n             -- bindings for the needed dictionaries.\n             -- See Note [Wrap bindings returned by specImports]\n       ; let spec_binds' = wrapDictBinds dict_binds spec_binds\n\n       ; return (rules, spec_binds') }\n  where\n    go :: RuleBase -> [CallInfoSet] -> CoreM ([CoreRule], [CoreBind])\n    go _ [] = return ([], [])\n    go rb (cis@(CIS fn _) : other_calls)\n      = do { let ok_calls = filterCalls cis dict_binds\n                     -- Drop calls that (directly or indirectly) refer to fn\n                     -- See Note [Avoiding loops]\n--           ; debugTraceMsg (text \"specImport\" <+> vcat [ ppr fn\n--                                                       , text \"calls\" <+> ppr cis\n--                                                       , text \"ud_binds =\" <+> ppr dict_binds\n--                                                       , text \"dump set =\" <+> ppr dump_set\n--                                                       , text \"filtered calls =\" <+> ppr ok_calls ])\n           ; (rules1, spec_binds1) <- specImport dflags this_mod top_env\n                                                 done callers rb fn ok_calls\n\n           ; (rules2, spec_binds2) <- go (extendRuleBaseList rb rules1) other_calls\n           ; return (rules1 ++ rules2, spec_binds1 ++ spec_binds2) }\n\nspecImport :: DynFlags\n           -> Module\n           -> SpecEnv               -- Passed in so that all top-level Ids are in scope\n           -> VarSet                -- Don't specialise these\n                                    -- See Note [Avoiding recursive specialisation]\n           -> [Id]                  -- Stack of imported functions being specialised\n           -> RuleBase              -- Rules from this module\n           -> Id -> [CallInfo]      -- Imported function and calls for it\n           -> CoreM ( [CoreRule]    -- New rules\n                    , [CoreBind] )  -- Specialised bindings\nspecImport dflags this_mod top_env done callers rb fn calls_for_fn\n  | fn `elemVarSet` done\n  = return ([], [])     -- No warning.  This actually happens all the time\n                        -- when specialising a recursive function, because\n                        -- the RHS of the specialised function contains a recursive\n                        -- call to the original function\n\n  | null calls_for_fn   -- We filtered out all the calls in deleteCallsMentioning\n  = return ([], [])\n\n  | wantSpecImport dflags unfolding\n  , Just rhs <- maybeUnfoldingTemplate unfolding\n  = do {     -- Get rules from the external package state\n             -- We keep doing this in case we \"page-fault in\"\n             -- more rules as we go along\n       ; hsc_env <- getHscEnv\n       ; eps <- liftIO $ hscEPS hsc_env\n       ; vis_orphs <- getVisibleOrphanMods\n       ; let full_rb = unionRuleBase rb (eps_rule_base eps)\n             rules_for_fn = getRules (RuleEnv full_rb vis_orphs) fn\n\n       ; (rules1, spec_pairs, uds)\n             <- -- pprTrace \"specImport1\" (vcat [ppr fn, ppr calls_for_fn, ppr rhs]) $\n                runSpecM dflags this_mod $\n                specCalls (Just this_mod) top_env rules_for_fn calls_for_fn fn rhs\n       ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs]\n             -- After the rules kick in we may get recursion, but\n             -- we rely on a global GlomBinds to sort that out later\n             -- See Note [Glom the bindings if imported functions are specialised]\n\n              -- Now specialise any cascaded calls\n       ; (rules2, spec_binds2) <- -- pprTrace \"specImport 2\" (ppr fn $$ ppr rules1 $$ ppr spec_binds1) $\n                                  specImports dflags this_mod top_env\n                                              (extendVarSet done fn)\n                                              (fn:callers)\n                                              (extendRuleBaseList rb rules1)\n                                              uds\n\n       ; let final_binds = spec_binds2 ++ spec_binds1\n\n       ; return (rules2 ++ rules1, final_binds) }\n\n  |  warnMissingSpecs dflags callers\n  = do { warnMsg (vcat [ hang (text \"Could not specialise imported function\" <+> quotes (ppr fn))\n                            2 (vcat [ text \"when specialising\" <+> quotes (ppr caller)\n                                    | caller <- callers])\n                      , whenPprDebug (text \"calls:\" <+> vcat (map (pprCallInfo fn) calls_for_fn))\n                      , text \"Probable fix: add INLINABLE pragma on\" <+> quotes (ppr fn) ])\n       ; return ([], []) }\n\n  | otherwise\n  = return ([], [])\n  where\n    unfolding = realIdUnfolding fn   -- We want to see the unfolding even for loop breakers\n\nwarnMissingSpecs :: DynFlags -> [Id] -> Bool\n-- See Note [Warning about missed specialisations]\nwarnMissingSpecs dflags callers\n  | wopt Opt_WarnAllMissedSpecs dflags = True\n  | not (wopt Opt_WarnMissedSpecs dflags) = False\n  | null callers                       = False\n  | otherwise                          = all has_inline_prag callers\n  where\n    has_inline_prag id = isAnyInlinePragma (idInlinePragma id)\n\nwantSpecImport :: DynFlags -> Unfolding -> Bool\n-- See Note [Specialise imported INLINABLE things]\nwantSpecImport dflags unf\n = case unf of\n     NoUnfolding      -> False\n     BootUnfolding    -> False\n     OtherCon {}      -> False\n     DFunUnfolding {} -> True\n     CoreUnfolding { uf_src = src, uf_guidance = _guidance }\n       | gopt Opt_SpecialiseAggressively dflags -> True\n       | isStableSource src -> True\n               -- Specialise even INLINE things; it hasn't inlined yet,\n               -- so perhaps it never will.  Moreover it may have calls\n               -- inside it that we want to specialise\n       | otherwise -> False    -- Stable, not INLINE, hence INLINABLE\n\n{- Note [Warning about missed specialisations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose\n * In module Lib, you carefully mark a function 'foo' INLINABLE\n * Import Lib(foo) into another module M\n * Call 'foo' at some specialised type in M\nThen you jolly well expect it to be specialised in M.  But what if\n'foo' calls another function 'Lib.bar'.  Then you'd like 'bar' to be\nspecialised too.  But if 'bar' is not marked INLINABLE it may well\nnot be specialised.  The warning Opt_WarnMissedSpecs warns about this.\n\nIt's more noisy to warning about a missed specialisation opportunity\nfor /every/ overloaded imported function, but sometimes useful. That\nis what Opt_WarnAllMissedSpecs does.\n\nToDo: warn about missed opportunities for local functions.\n\nNote [Specialise imported INLINABLE things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat imported functions do we specialise?  The basic set is\n * DFuns and things with INLINABLE pragmas.\nbut with -fspecialise-aggressively we add\n * Anything with an unfolding template\n\nTrac #8874 has a good example of why we want to auto-specialise DFuns.\n\nWe have the -fspecialise-aggressively flag (usually off), because we\nrisk lots of orphan modules from over-vigorous specialisation.\nHowever it's not a big deal: anything non-recursive with an\nunfolding-template will probably have been inlined already.\n\nNote [Glom the bindings if imported functions are specialised]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have an imported, *recursive*, INLINABLE function\n   f :: Eq a => a -> a\n   f = /\\a \\d x. ...(f a d)...\nIn the module being compiled we have\n   g x = f (x::Int)\nNow we'll make a specialised function\n   f_spec :: Int -> Int\n   f_spec = \\x -> ...(f Int dInt)...\n   {-# RULE  f Int _ = f_spec #-}\n   g = \\x. f Int dInt x\nNote that f_spec doesn't look recursive\nAfter rewriting with the RULE, we get\n   f_spec = \\x -> ...(f_spec)...\nBUT since f_spec was non-recursive before it'll *stay* non-recursive.\nThe occurrence analyser never turns a NonRec into a Rec.  So we must\nmake sure that f_spec is recursive.  Easiest thing is to make all\nthe specialisations for imported bindings recursive.\n\n\nNote [Avoiding recursive specialisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we specialise 'f' we may find new overloaded calls to 'g', 'h' in\n'f's RHS.  So we want to specialise g,h.  But we don't want to\nspecialise f any more!  It's possible that f's RHS might have a\nrecursive yet-more-specialised call, so we'd diverge in that case.\nAnd if the call is to the same type, one specialisation is enough.\nAvoiding this recursive specialisation loop is the reason for the\n'done' VarSet passed to specImports and specImport.\n\n************************************************************************\n*                                                                      *\n\\subsubsection{@specExpr@: the main function}\n*                                                                      *\n************************************************************************\n-}\n\ndata SpecEnv\n  = SE { se_subst :: CoreSubst.Subst\n             -- We carry a substitution down:\n             -- a) we must clone any binding that might float outwards,\n             --    to avoid name clashes\n             -- b) we carry a type substitution to use when analysing\n             --    the RHS of specialised bindings (no type-let!)\n\n\n       , se_interesting :: VarSet\n             -- Dict Ids that we know something about\n             -- and hence may be worth specialising against\n             -- See Note [Interesting dictionary arguments]\n     }\n\nspecVar :: SpecEnv -> Id -> CoreExpr\nspecVar env v = CoreSubst.lookupIdSubst (text \"specVar\") (se_subst env) v\n\nspecExpr :: SpecEnv -> CoreExpr -> SpecM (CoreExpr, UsageDetails)\n\n---------------- First the easy cases --------------------\nspecExpr env (Type ty)     = return (Type     (substTy env ty), emptyUDs)\nspecExpr env (Coercion co) = return (Coercion (substCo env co), emptyUDs)\nspecExpr env (Var v)       = return (specVar env v, emptyUDs)\nspecExpr _   (Lit lit)     = return (Lit lit,       emptyUDs)\nspecExpr env (Cast e co)\n  = do { (e', uds) <- specExpr env e\n       ; return ((mkCast e' (substCo env co)), uds) }\nspecExpr env (Tick tickish body)\n  = do { (body', uds) <- specExpr env body\n       ; return (Tick (specTickish env tickish) body', uds) }\n\n---------------- Applications might generate a call instance --------------------\nspecExpr env expr@(App {})\n  = go expr []\n  where\n    go (App fun arg) args = do (arg', uds_arg) <- specExpr env arg\n                               (fun', uds_app) <- go fun (arg':args)\n                               return (App fun' arg', uds_arg `plusUDs` uds_app)\n\n    go (Var f)       args = case specVar env f of\n                                Var f' -> return (Var f', mkCallUDs env f' args)\n                                e'     -> return (e', emptyUDs) -- I don't expect this!\n    go other         _    = specExpr env other\n\n---------------- Lambda/case require dumping of usage details --------------------\nspecExpr env e@(Lam _ _) = do\n    (body', uds) <- specExpr env' body\n    let (free_uds, dumped_dbs) = dumpUDs bndrs' uds\n    return (mkLams bndrs' (wrapDictBindsE dumped_dbs body'), free_uds)\n  where\n    (bndrs, body) = collectBinders e\n    (env', bndrs') = substBndrs env bndrs\n        -- More efficient to collect a group of binders together all at once\n        -- and we don't want to split a lambda group with dumped bindings\n\nspecExpr env (Case scrut case_bndr ty alts)\n  = do { (scrut', scrut_uds) <- specExpr env scrut\n       ; (scrut'', case_bndr', alts', alts_uds)\n             <- specCase env scrut' case_bndr alts\n       ; return (Case scrut'' case_bndr' (substTy env ty) alts'\n                , scrut_uds `plusUDs` alts_uds) }\n\n---------------- Finally, let is the interesting case --------------------\nspecExpr env (Let bind body)\n  = do { -- Clone binders\n         (rhs_env, body_env, bind') <- cloneBindSM env bind\n\n         -- Deal with the body\n       ; (body', body_uds) <- specExpr body_env body\n\n        -- Deal with the bindings\n      ; (binds', uds) <- specBind rhs_env bind' body_uds\n\n        -- All done\n      ; return (foldr Let body' binds', uds) }\n\nspecTickish :: SpecEnv -> Tickish Id -> Tickish Id\nspecTickish env (Breakpoint ix ids)\n  = Breakpoint ix [ id' | id <- ids, Var id' <- [specVar env id]]\n  -- drop vars from the list if they have a non-variable substitution.\n  -- should never happen, but it's harmless to drop them anyway.\nspecTickish _ other_tickish = other_tickish\n\nspecCase :: SpecEnv\n         -> CoreExpr            -- Scrutinee, already done\n         -> Id -> [CoreAlt]\n         -> SpecM ( CoreExpr    -- New scrutinee\n                  , Id\n                  , [CoreAlt]\n                  , UsageDetails)\nspecCase env scrut' case_bndr [(con, args, rhs)]\n  | isDictId case_bndr           -- See Note [Floating dictionaries out of cases]\n  , interestingDict env scrut'\n  , not (isDeadBinder case_bndr && null sc_args')\n  = do { (case_bndr_flt : sc_args_flt) <- mapM clone_me (case_bndr' : sc_args')\n\n       ; let sc_rhss = [ Case (Var case_bndr_flt) case_bndr' (idType sc_arg')\n                              [(con, args', Var sc_arg')]\n                       | sc_arg' <- sc_args' ]\n\n             -- Extend the substitution for RHS to map the *original* binders\n             -- to their floated versions.\n             mb_sc_flts :: [Maybe DictId]\n             mb_sc_flts = map (lookupVarEnv clone_env) args'\n             clone_env  = zipVarEnv sc_args' sc_args_flt\n             subst_prs  = (case_bndr, Var case_bndr_flt)\n                        : [ (arg, Var sc_flt)\n                          | (arg, Just sc_flt) <- args `zip` mb_sc_flts ]\n             env_rhs' = env_rhs { se_subst = CoreSubst.extendIdSubstList (se_subst env_rhs) subst_prs\n                                , se_interesting = se_interesting env_rhs `extendVarSetList`\n                                                   (case_bndr_flt : sc_args_flt) }\n\n       ; (rhs', rhs_uds)   <- specExpr env_rhs' rhs\n       ; let scrut_bind    = mkDB (NonRec case_bndr_flt scrut')\n             case_bndr_set = unitVarSet case_bndr_flt\n             sc_binds      = [(NonRec sc_arg_flt sc_rhs, case_bndr_set)\n                             | (sc_arg_flt, sc_rhs) <- sc_args_flt `zip` sc_rhss ]\n             flt_binds     = scrut_bind : sc_binds\n             (free_uds, dumped_dbs) = dumpUDs (case_bndr':args') rhs_uds\n             all_uds = flt_binds `addDictBinds` free_uds\n             alt'    = (con, args', wrapDictBindsE dumped_dbs rhs')\n       ; return (Var case_bndr_flt, case_bndr', [alt'], all_uds) }\n  where\n    (env_rhs, (case_bndr':args')) = substBndrs env (case_bndr:args)\n    sc_args' = filter is_flt_sc_arg args'\n\n    clone_me bndr = do { uniq <- getUniqueM\n                       ; return (mkUserLocalOrCoVar occ uniq ty loc) }\n       where\n         name = idName bndr\n         ty   = idType bndr\n         occ  = nameOccName name\n         loc  = getSrcSpan name\n\n    arg_set = mkVarSet args'\n    is_flt_sc_arg var =  isId var\n                      && not (isDeadBinder var)\n                      && isDictTy var_ty\n                      && not (tyCoVarsOfType var_ty `intersectsVarSet` arg_set)\n       where\n         var_ty = idType var\n\n\nspecCase env scrut case_bndr alts\n  = do { (alts', uds_alts) <- mapAndCombineSM spec_alt alts\n       ; return (scrut, case_bndr', alts', uds_alts) }\n  where\n    (env_alt, case_bndr') = substBndr env case_bndr\n    spec_alt (con, args, rhs) = do\n          (rhs', uds) <- specExpr env_rhs rhs\n          let (free_uds, dumped_dbs) = dumpUDs (case_bndr' : args') uds\n          return ((con, args', wrapDictBindsE dumped_dbs rhs'), free_uds)\n        where\n          (env_rhs, args') = substBndrs env_alt args\n\n{-\nNote [Floating dictionaries out of cases]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   g = \\d. case d of { MkD sc ... -> ...(f sc)... }\nNaively we can't float d2's binding out of the case expression,\nbecause 'sc' is bound by the case, and that in turn means we can't\nspecialise f, which seems a pity.\n\nSo we invert the case, by floating out a binding\nfor 'sc_flt' thus:\n    sc_flt = case d of { MkD sc ... -> sc }\nNow we can float the call instance for 'f'.  Indeed this is just\nwhat'll happen if 'sc' was originally bound with a let binding,\nbut case is more efficient, and necessary with equalities. So it's\ngood to work with both.\n\nYou might think that this won't make any difference, because the\ncall instance will only get nuked by the \\d.  BUT if 'g' itself is\nspecialised, then transitively we should be able to specialise f.\n\nIn general, given\n   case e of cb { MkD sc ... -> ...(f sc)... }\nwe transform to\n   let cb_flt = e\n       sc_flt = case cb_flt of { MkD sc ... -> sc }\n   in\n   case cb_flt of bg { MkD sc ... -> ....(f sc_flt)... }\n\nThe \"_flt\" things are the floated binds; we use the current substitution\nto substitute sc -> sc_flt in the RHS\n\n************************************************************************\n*                                                                      *\n                     Dealing with a binding\n*                                                                      *\n************************************************************************\n-}\n\nspecBind :: SpecEnv                     -- Use this for RHSs\n         -> CoreBind                    -- Binders are already cloned by cloneBindSM,\n                                        -- but RHSs are un-processed\n         -> UsageDetails                -- Info on how the scope of the binding\n         -> SpecM ([CoreBind],          -- New bindings\n                   UsageDetails)        -- And info to pass upstream\n\n-- Returned UsageDetails:\n--    No calls for binders of this bind\nspecBind rhs_env (NonRec fn rhs) body_uds\n  = do { (rhs', rhs_uds) <- specExpr rhs_env rhs\n       ; (fn', spec_defns, body_uds1) <- specDefn rhs_env body_uds fn rhs\n\n       ; let pairs = spec_defns ++ [(fn', rhs')]\n                        -- fn' mentions the spec_defns in its rules,\n                        -- so put the latter first\n\n             combined_uds = body_uds1 `plusUDs` rhs_uds\n\n             (free_uds, dump_dbs, float_all) = dumpBindUDs [fn] combined_uds\n\n             final_binds :: [DictBind]\n             -- See Note [From non-recursive to recursive]\n             final_binds\n               | not (isEmptyBag dump_dbs)\n               , not (null spec_defns)\n               = [recWithDumpedDicts pairs dump_dbs]\n               | otherwise\n               = [mkDB $ NonRec b r | (b,r) <- pairs]\n                 ++ bagToList dump_dbs\n\n       ; if float_all then\n             -- Rather than discard the calls mentioning the bound variables\n             -- we float this (dictionary) binding along with the others\n              return ([], free_uds `snocDictBinds` final_binds)\n         else\n             -- No call in final_uds mentions bound variables,\n             -- so we can just leave the binding here\n              return (map fst final_binds, free_uds) }\n\n\nspecBind rhs_env (Rec pairs) body_uds\n       -- Note [Specialising a recursive group]\n  = do { let (bndrs,rhss) = unzip pairs\n       ; (rhss', rhs_uds) <- mapAndCombineSM (specExpr rhs_env) rhss\n       ; let scope_uds = body_uds `plusUDs` rhs_uds\n                       -- Includes binds and calls arising from rhss\n\n       ; (bndrs1, spec_defns1, uds1) <- specDefns rhs_env scope_uds pairs\n\n       ; (bndrs3, spec_defns3, uds3)\n             <- if null spec_defns1  -- Common case: no specialisation\n                then return (bndrs1, [], uds1)\n                else do {            -- Specialisation occurred; do it again\n                          (bndrs2, spec_defns2, uds2)\n                              <- specDefns rhs_env uds1 (bndrs1 `zip` rhss)\n                        ; return (bndrs2, spec_defns2 ++ spec_defns1, uds2) }\n\n       ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs bndrs uds3\n             final_bind = recWithDumpedDicts (spec_defns3 ++ zip bndrs3 rhss')\n                                             dumped_dbs\n\n       ; if float_all then\n              return ([], final_uds `snocDictBind` final_bind)\n         else\n              return ([fst final_bind], final_uds) }\n\n\n---------------------------\nspecDefns :: SpecEnv\n          -> UsageDetails               -- Info on how it is used in its scope\n          -> [(OutId,InExpr)]           -- The things being bound and their un-processed RHS\n          -> SpecM ([OutId],            -- Original Ids with RULES added\n                    [(OutId,OutExpr)],  -- Extra, specialised bindings\n                    UsageDetails)       -- Stuff to fling upwards from the specialised versions\n\n-- Specialise a list of bindings (the contents of a Rec), but flowing usages\n-- upwards binding by binding.  Example: { f = ...g ...; g = ...f .... }\n-- Then if the input CallDetails has a specialised call for 'g', whose specialisation\n-- in turn generates a specialised call for 'f', we catch that in this one sweep.\n-- But not vice versa (it's a fixpoint problem).\n\nspecDefns _env uds []\n  = return ([], [], uds)\nspecDefns env uds ((bndr,rhs):pairs)\n  = do { (bndrs1, spec_defns1, uds1) <- specDefns env uds pairs\n       ; (bndr1, spec_defns2, uds2)  <- specDefn env uds1 bndr rhs\n       ; return (bndr1 : bndrs1, spec_defns1 ++ spec_defns2, uds2) }\n\n---------------------------\nspecDefn :: SpecEnv\n         -> UsageDetails                -- Info on how it is used in its scope\n         -> OutId -> InExpr             -- The thing being bound and its un-processed RHS\n         -> SpecM (Id,                  -- Original Id with added RULES\n                   [(Id,CoreExpr)],     -- Extra, specialised bindings\n                   UsageDetails)        -- Stuff to fling upwards from the specialised versions\n\nspecDefn env body_uds fn rhs\n  = do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds\n             rules_for_me = idCoreRules fn\n       ; (rules, spec_defns, spec_uds) <- specCalls Nothing env rules_for_me\n                                                    calls_for_me fn rhs\n       ; return ( fn `addIdSpecialisations` rules\n                , spec_defns\n                , body_uds_without_me `plusUDs` spec_uds) }\n                -- It's important that the `plusUDs` is this way\n                -- round, because body_uds_without_me may bind\n                -- dictionaries that are used in calls_for_me passed\n                -- to specDefn.  So the dictionary bindings in\n                -- spec_uds may mention dictionaries bound in\n                -- body_uds_without_me\n\n---------------------------\nspecCalls :: Maybe Module      -- Just this_mod  =>  specialising imported fn\n                               -- Nothing        =>  specialising local fn\n          -> SpecEnv\n          -> [CoreRule]        -- Existing RULES for the fn\n          -> [CallInfo]\n          -> OutId -> InExpr\n          -> SpecM SpecInfo    -- New rules, specialised bindings, and usage details\n\n-- This function checks existing rules, and does not create\n-- duplicate ones. So the caller does not need to do this filtering.\n-- See 'already_covered'\n\ntype SpecInfo = ( [CoreRule]       -- Specialisation rules\n                , [(Id,CoreExpr)]  -- Specialised definition\n                , UsageDetails )   -- Usage details from specialised RHSs\n\nspecCalls mb_mod env existing_rules calls_for_me fn rhs\n        -- The first case is the interesting one\n  |  rhs_tyvars `lengthIs`      n_tyvars -- Rhs of fn's defn has right number of big lambdas\n  && rhs_bndrs1 `lengthAtLeast` n_dicts -- and enough dict args\n  && notNull calls_for_me               -- And there are some calls to specialise\n  && not (isNeverActive (idInlineActivation fn))\n        -- Don't specialise NOINLINE things\n        -- See Note [Auto-specialisation and RULES]\n\n--   && not (certainlyWillInline (idUnfolding fn))      -- And it's not small\n--      See Note [Inline specialisation] for why we do not\n--      switch off specialisation for inline functions\n\n  = -- pprTrace \"specDefn: some\" (ppr fn $$ ppr calls_for_me $$ ppr existing_rules) $\n    foldlM spec_call ([], [], emptyUDs) calls_for_me\n\n  | otherwise   -- No calls or RHS doesn't fit our preconceptions\n  = WARN( not (exprIsTrivial rhs) && notNull calls_for_me,\n          text \"Missed specialisation opportunity for\"\n                                 <+> ppr fn $$ _trace_doc )\n          -- Note [Specialisation shape]\n    -- pprTrace \"specDefn: none\" (ppr fn <+> ppr calls_for_me) $\n    return ([], [], emptyUDs)\n  where\n    _trace_doc = sep [ ppr rhs_tyvars, ppr n_tyvars\n                     , ppr rhs_bndrs, ppr n_dicts\n                     , ppr (idInlineActivation fn) ]\n\n    fn_type                 = idType fn\n    fn_arity                = idArity fn\n    fn_unf                  = realIdUnfolding fn  -- Ignore loop-breaker-ness here\n    (tyvars, theta, _)      = tcSplitSigmaTy fn_type\n    n_tyvars                = length tyvars\n    n_dicts                 = length theta\n    inl_prag                = idInlinePragma fn\n    inl_act                 = inlinePragmaActivation inl_prag\n    is_local                = isLocalId fn\n\n        -- Figure out whether the function has an INLINE pragma\n        -- See Note [Inline specialisations]\n\n    (rhs_bndrs, rhs_body)      = collectBindersPushingCo rhs\n                                 -- See Note [Account for casts in binding]\n    (rhs_tyvars, rhs_bndrs1)   = span isTyVar rhs_bndrs\n    (rhs_dict_ids, rhs_bndrs2) = splitAt n_dicts rhs_bndrs1\n    body                       = mkLams rhs_bndrs2 rhs_body\n                                 -- Glue back on the non-dict lambdas\n\n    in_scope = CoreSubst.substInScope (se_subst env)\n\n    already_covered :: DynFlags -> [CoreRule] -> [CoreExpr] -> Bool\n    already_covered dflags new_rules args      -- Note [Specialisations already covered]\n       = isJust (lookupRule dflags (in_scope, realIdUnfolding)\n                            (const True) fn args\n                            (new_rules ++ existing_rules))\n         -- NB: we look both in the new_rules (generated by this invocation\n         --     of specCalls), and in existing_rules (passed in to specCalls)\n\n    mk_ty_args :: [Maybe Type] -> [TyVar] -> [CoreExpr]\n    mk_ty_args [] poly_tvs\n      = ASSERT( null poly_tvs ) []\n    mk_ty_args (Nothing : call_ts) (poly_tv : poly_tvs)\n      = Type (mkTyVarTy poly_tv) : mk_ty_args call_ts poly_tvs\n    mk_ty_args (Just ty : call_ts) poly_tvs\n      = Type ty : mk_ty_args call_ts poly_tvs\n    mk_ty_args (Nothing : _) [] = panic \"mk_ty_args\"\n\n    ----------------------------------------------------------\n        -- Specialise to one particular call pattern\n    spec_call :: SpecInfo                         -- Accumulating parameter\n              -> CallInfo                         -- Call instance\n              -> SpecM SpecInfo\n    spec_call spec_acc@(rules_acc, pairs_acc, uds_acc)\n              (CI { ci_key = CallKey call_ts, ci_args = call_ds })\n      = ASSERT( call_ts `lengthIs` n_tyvars  && call_ds `lengthIs` n_dicts )\n\n        -- Suppose f's defn is  f = /\\ a b c -> \\ d1 d2 -> rhs\n        -- Suppose the call is for f [Just t1, Nothing, Just t3] [dx1, dx2]\n\n        -- Construct the new binding\n        --      f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\\ b -> rhs)\n        -- PLUS the rule\n        --      RULE \"SPEC f\" forall b d1' d2'. f b d1' d2' = f1 b\n        --      In the rule, d1' and d2' are just wildcards, not used in the RHS\n        -- PLUS the usage-details\n        --      { d1' = dx1; d2' = dx2 }\n        -- where d1', d2' are cloned versions of d1,d2, with the type substitution\n        -- applied.  These auxiliary bindings just avoid duplication of dx1, dx2\n        --\n        -- Note that the substitution is applied to the whole thing.\n        -- This is convenient, but just slightly fragile.  Notably:\n        --      * There had better be no name clashes in a/b/c\n        do { let\n                -- poly_tyvars = [b] in the example above\n                -- spec_tyvars = [a,c]\n                -- ty_args     = [t1,b,t3]\n                spec_tv_binds = [(tv,ty) | (tv, Just ty) <- rhs_tyvars `zip` call_ts]\n                env1          = extendTvSubstList env spec_tv_binds\n                (rhs_env, poly_tyvars) = substBndrs env1\n                                            [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts]\n\n             -- Clone rhs_dicts, including instantiating their types\n           ; inst_dict_ids <- mapM (newDictBndr rhs_env) rhs_dict_ids\n           ; let (rhs_env2, dx_binds, spec_dict_args)\n                            = bindAuxiliaryDicts rhs_env rhs_dict_ids call_ds inst_dict_ids\n                 ty_args    = mk_ty_args call_ts poly_tyvars\n                 ev_args    = map varToCoreExpr inst_dict_ids  -- ev_args, ev_bndrs:\n                 ev_bndrs   = exprsFreeIdsList ev_args         -- See Note [Evidence foralls]\n                 rule_args  = ty_args     ++ ev_args\n                 rule_bndrs = poly_tyvars ++ ev_bndrs\n\n           ; dflags <- getDynFlags\n           ; if already_covered dflags rules_acc rule_args\n             then return spec_acc\n             else -- pprTrace \"spec_call\" (vcat [ ppr _call_info, ppr fn, ppr rhs_dict_ids\n                  --                           , text \"rhs_env2\" <+> ppr (se_subst rhs_env2)\n                  --                           , ppr dx_binds ]) $\n                  do\n           {    -- Figure out the type of the specialised function\n             let body_ty = applyTypeToArgs rhs fn_type rule_args\n                 (lam_args, app_args)           -- Add a dummy argument if body_ty is unlifted\n                   | isUnliftedType body_ty     -- C.f. WwLib.mkWorkerArgs\n                   , not (isJoinId fn)\n                   = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId])\n                   | otherwise = (poly_tyvars, poly_tyvars)\n                 spec_id_ty = mkLamTypes lam_args body_ty\n                 join_arity_change = length app_args - length rule_args\n                 spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn\n                                 = Just (orig_join_arity + join_arity_change)\n                                 | otherwise\n                                 = Nothing\n\n           ; spec_f <- newSpecIdSM fn spec_id_ty spec_join_arity\n           ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body)\n           ; this_mod <- getModule\n           ; let\n                -- The rule to put in the function's specialisation is:\n                --      forall b, d1',d2'.  f t1 b t3 d1' d2' = f1 b\n                herald = case mb_mod of\n                           Nothing        -- Specialising local fn\n                               -> text \"SPEC\"\n                           Just this_mod  -- Specialising imported fn\n                               -> text \"SPEC/\" <> ppr this_mod\n\n                rule_name = mkFastString $ showSDoc dflags $\n                            herald <+> ftext (occNameFS (getOccName fn))\n                                   <+> hsep (map ppr_call_key_ty call_ts)\n                            -- This name ends up in interface files, so use occNameString.\n                            -- Otherwise uniques end up there, making builds\n                            -- less deterministic (See #4012 comment:61 ff)\n\n                rule_wout_eta = mkRule\n                                  this_mod\n                                  True {- Auto generated -}\n                                  is_local\n                                  rule_name\n                                  inl_act       -- Note [Auto-specialisation and RULES]\n                                  (idName fn)\n                                  rule_bndrs\n                                  rule_args\n                                  (mkVarApps (Var spec_f) app_args)\n\n                spec_rule\n                  = case isJoinId_maybe fn of\n                      Just join_arity -> etaExpandToJoinPointRule join_arity\n                                                                  rule_wout_eta\n                      Nothing -> rule_wout_eta\n\n                -- Add the { d1' = dx1; d2' = dx2 } usage stuff\n                spec_uds = foldr consDictBind rhs_uds dx_binds\n\n                --------------------------------------\n                -- Add a suitable unfolding if the spec_inl_prag says so\n                -- See Note [Inline specialisations]\n                (spec_inl_prag, spec_unf)\n                  | not is_local && isStrongLoopBreaker (idOccInfo fn)\n                  = (neverInlinePragma, noUnfolding)\n                        -- See Note [Specialising imported functions] in OccurAnal\n\n                  | InlinePragma { inl_inline = Inlinable } <- inl_prag\n                  = (inl_prag { inl_inline = NoUserInline }, noUnfolding)\n\n                  | otherwise\n                  = (inl_prag, specUnfolding dflags poly_tyvars spec_app\n                                             arity_decrease fn_unf)\n\n                arity_decrease = length spec_dict_args\n                spec_app e = (e `mkApps` ty_args) `mkApps` spec_dict_args\n\n                --------------------------------------\n                -- Adding arity information just propagates it a bit faster\n                --      See Note [Arity decrease] in Simplify\n                -- Copy InlinePragma information from the parent Id.\n                -- So if f has INLINE[1] so does spec_f\n                spec_f_w_arity = spec_f `setIdArity`      max 0 (fn_arity - n_dicts)\n                                        `setInlinePragma` spec_inl_prag\n                                        `setIdUnfolding`  spec_unf\n                                        `asJoinId_maybe`  spec_join_arity\n\n           ; return ( spec_rule                  : rules_acc\n                    , (spec_f_w_arity, spec_rhs) : pairs_acc\n                    , spec_uds           `plusUDs` uds_acc\n                    ) } }\n\n{- Note [Account for casts in binding]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   f :: Eq a => a -> IO ()\n   {-# INLINABLE f\n       StableUnf = (/\\a \\(d:Eq a) (x:a). blah) |> g\n     #-}\n   f = ...\n\nIn f's stable unfolding we have done some modest simplification which\nhas pushed the cast to the outside.  (I wonder if this is the Right\nThing, but it's what happens now; see SimplUtils Note [Casts and\nlambdas].)  Now that stable unfolding must be specialised, so we want\nto push the cast back inside. It would be terrible if the cast\ndefeated specialisation!  Hence the use of collectBindersPushingCo.\n\nNote [Evidence foralls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose (Trac #12212) that we are specialising\n   f :: forall a b. (Num a, F a ~ F b) => blah\nwith a=b=Int. Then the RULE will be something like\n   RULE forall (d:Num Int) (g :: F Int ~ F Int).\n        f Int Int d g = f_spec\nBut both varToCoreExpr (when constructing the LHS args), and the\nsimplifier (when simplifying the LHS args), will transform to\n   RULE forall (d:Num Int) (g :: F Int ~ F Int).\n        f Int Int d <F Int> = f_spec\nby replacing g with Refl.  So now 'g' is unbound, which results in a later\ncrash. So we use Refl right off the bat, and do not forall-quantify 'g':\n * varToCoreExpr generates a Refl\n * exprsFreeIdsList returns the Ids bound by the args,\n   which won't include g\n\nYou might wonder if this will match as often, but the simplifier replaces\ncomplicated Refl coercions with Refl pretty aggressively.\n\nNote [Orphans and auto-generated rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we specialise an INLINABLE function, or when we have\n-fspecialise-aggressively, we auto-generate RULES that are orphans.\nWe don't want to warn about these, or we'd generate a lot of warnings.\nThus, we only warn about user-specified orphan rules.\n\nIndeed, we don't even treat the module as an orphan module if it has\nauto-generated *rule* orphans.  Orphan modules are read every time we\ncompile, so they are pretty obtrusive and slow down every compilation,\neven non-optimised ones.  (Reason: for type class instances it's a\ntype correctness issue.)  But specialisation rules are strictly for\n*optimisation* only so it's fine not to read the interface.\n\nWhat this means is that a SPEC rules from auto-specialisation in\nmodule M will be used in other modules only if M.hi has been read for\nsome other reason, which is actually pretty likely.\n-}\n\nbindAuxiliaryDicts\n        :: SpecEnv\n        -> [DictId] -> [CoreExpr]   -- Original dict bndrs, and the witnessing expressions\n        -> [DictId]                 -- A cloned dict-id for each dict arg\n        -> (SpecEnv,                -- Substitute for all orig_dicts\n            [DictBind],             -- Auxiliary dict bindings\n            [CoreExpr])             -- Witnessing expressions (all trivial)\n-- Bind any dictionary arguments to fresh names, to preserve sharing\nbindAuxiliaryDicts env@(SE { se_subst = subst, se_interesting = interesting })\n                   orig_dict_ids call_ds inst_dict_ids\n  = (env', dx_binds, spec_dict_args)\n  where\n    (dx_binds, spec_dict_args) = go call_ds inst_dict_ids\n    env' = env { se_subst = subst `CoreSubst.extendSubstList`\n                                     (orig_dict_ids `zip` spec_dict_args)\n                                  `CoreSubst.extendInScopeList` dx_ids\n               , se_interesting = interesting `unionVarSet` interesting_dicts }\n\n    dx_ids = [dx_id | (NonRec dx_id _, _) <- dx_binds]\n    interesting_dicts = mkVarSet [ dx_id | (NonRec dx_id dx, _) <- dx_binds\n                                 , interestingDict env dx ]\n                  -- See Note [Make the new dictionaries interesting]\n\n    go :: [CoreExpr] -> [CoreBndr] -> ([DictBind], [CoreExpr])\n    go [] _  = ([], [])\n    go (dx:dxs) (dx_id:dx_ids)\n      | exprIsTrivial dx = (dx_binds,                          dx        : args)\n      | otherwise        = (mkDB (NonRec dx_id dx) : dx_binds, Var dx_id : args)\n      where\n        (dx_binds, args) = go dxs dx_ids\n             -- In the first case extend the substitution but not bindings;\n             -- in the latter extend the bindings but not the substitution.\n             -- For the former, note that we bind the *original* dict in the substitution,\n             -- overriding any d->dx_id binding put there by substBndrs\n    go _ _ = pprPanic \"bindAuxiliaryDicts\" (ppr orig_dict_ids $$ ppr call_ds $$ ppr inst_dict_ids)\n\n{-\nNote [Make the new dictionaries interesting]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nImportant!  We're going to substitute dx_id1 for d\nand we want it to look \"interesting\", else we won't gather *any*\nconsequential calls. E.g.\n    f d = ...g d....\nIf we specialise f for a call (f (dfun dNumInt)), we'll get\na consequent call (g d') with an auxiliary definition\n    d' = df dNumInt\nWe want that consequent call to look interesting\n\n\nNote [From non-recursive to recursive]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEven in the non-recursive case, if any dict-binds depend on 'fn' we might\nhave built a recursive knot\n\n      f a d x = <blah>\n      MkUD { ud_binds = NonRec d7  (MkD ..f..)\n           , ud_calls = ...(f T d7)... }\n\nThe we generate\n\n     Rec { fs x = <blah>[T/a, d7/d]\n           f a d x = <blah>\n               RULE f T _ = fs\n           d7 = ...f... }\n\nHere the recursion is only through the RULE.\n\nHowever we definitely should /not/ make the Rec in this wildly common\ncase:\n      d = ...\n      MkUD { ud_binds = NonRec d7 (...d...)\n           , ud_calls = ...(f T d7)... }\n\nHere we want simply to add d to the floats, giving\n      MkUD { ud_binds = NonRec d (...)\n                        NonRec d7 (...d...)\n           , ud_calls = ...(f T d7)... }\n\nIn general, we need only make this Rec if\n  - there are some specialisations (spec_binds non-empty)\n  - there are some dict_binds that depend on f (dump_dbs non-empty)\n\nNote [Avoiding loops]\n~~~~~~~~~~~~~~~~~~~~~\nWhen specialising /dictionary functions/ we must be very careful to\navoid building loops. Here is an example that bit us badly: Trac #3591\n\n     class Eq a => C a\n     instance Eq [a] => C [a]\n\nThis translates to\n     dfun :: Eq [a] -> C [a]\n     dfun a d = MkD a d (meth d)\n\n     d4 :: Eq [T] = <blah>\n     d2 ::  C [T] = dfun T d4\n     d1 :: Eq [T] = $p1 d2\n     d3 ::  C [T] = dfun T d1\n\nNone of these definitions is recursive. What happened was that we\ngenerated a specialisation:\n\n     RULE forall d. dfun T d = dT  :: C [T]\n     dT = (MkD a d (meth d)) [T/a, d1/d]\n        = MkD T d1 (meth d1)\n\nBut now we use the RULE on the RHS of d2, to get\n\n    d2 = dT = MkD d1 (meth d1)\n    d1 = $p1 d2\n\nand now d1 is bottom!  The problem is that when specialising 'dfun' we\nshould first dump \"below\" the binding all floated dictionary bindings\nthat mention 'dfun' itself.  So d2 and d3 (and hence d1) must be\nplaced below 'dfun', and thus unavailable to it when specialising\n'dfun'.  That in turn means that the call (dfun T d1) must be\ndiscarded.  On the other hand, the call (dfun T d4) is fine, assuming\nd4 doesn't mention dfun.\n\nSolution:\n  Discard all calls that mention dictionaries that depend\n  (directly or indirectly) on the dfun we are specialising.\n  This is done by 'filterCalls'\n\n--------------\nHere's another example, this time for an imported dfun, so the call\nto filterCalls is in specImports (Trac #13429). Suppose we have\n  class Monoid v => C v a where ...\n\nWe start with a call\n   f @ [Integer] @ Integer $fC[]Integer\n\nSpecialising call to 'f' gives dict bindings\n   $dMonoid_1 :: Monoid [Integer]\n   $dMonoid_1 = M.$p1C @ [Integer] $fC[]Integer\n\n   $dC_1 :: C [Integer] (Node [Integer] Integer)\n   $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1\n\n...plus a recursive call to\n   f @ [Integer] @ (Node [Integer] Integer) $dC_1\n\nSpecialising that call gives\n   $dMonoid_2  :: Monoid [Integer]\n   $dMonoid_2  = M.$p1C @ [Integer] $dC_1\n\n   $dC_2 :: C [Integer] (Node [Integer] Integer)\n   $dC_2 = M.$fCvNode @ [Integer] $dMonoid_2\n\nNow we have two calls to the imported function\n  M.$fCvNode :: Monoid v => C v a\n  M.$fCvNode @v @a m = C m some_fun\n\nBut we must /not/ use the call (M.$fCvNode @ [Integer] $dMonoid_2)\nfor specialisation, else we get:\n\n  $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1\n  $dMonoid_2 = M.$p1C @ [Integer] $dC_1\n  $s$fCvNode = C $dMonoid_2 ...\n    RULE M.$fCvNode [Integer] _ _ = $s$fCvNode\n\nNow use the rule to rewrite the call in the RHS of $dC_1\nand we get a loop!\n\n--------------\nHere's yet another example\n\n  class C a where { foo,bar :: [a] -> [a] }\n\n  instance C Int where\n     foo x = r_bar x\n     bar xs = reverse xs\n\n  r_bar :: C a => [a] -> [a]\n  r_bar xs = bar (xs ++ xs)\n\nThat translates to:\n\n    r_bar a (c::C a) (xs::[a]) = bar a d (xs ++ xs)\n\n    Rec { $fCInt :: C Int = MkC foo_help reverse\n          foo_help (xs::[Int]) = r_bar Int $fCInt xs }\n\nThe call (r_bar $fCInt) mentions $fCInt,\n                        which mentions foo_help,\n                        which mentions r_bar\nBut we DO want to specialise r_bar at Int:\n\n    Rec { $fCInt :: C Int = MkC foo_help reverse\n          foo_help (xs::[Int]) = r_bar Int $fCInt xs\n\n          r_bar a (c::C a) (xs::[a]) = bar a d (xs ++ xs)\n            RULE r_bar Int _ = r_bar_Int\n\n          r_bar_Int xs = bar Int $fCInt (xs ++ xs)\n           }\n\nNote that, because of its RULE, r_bar joins the recursive\ngroup.  (In this case it'll unravel a short moment later.)\n\n\nNote [Specialising a recursive group]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n    let rec { f x = ...g x'...\n            ; g y = ...f y'.... }\n    in f 'a'\nHere we specialise 'f' at Char; but that is very likely to lead to\na specialisation of 'g' at Char.  We must do the latter, else the\nwhole point of specialisation is lost.\n\nBut we do not want to keep iterating to a fixpoint, because in the\npresence of polymorphic recursion we might generate an infinite number\nof specialisations.\n\nSo we use the following heuristic:\n  * Arrange the rec block in dependency order, so far as possible\n    (the occurrence analyser already does this)\n\n  * Specialise it much like a sequence of lets\n\n  * Then go through the block a second time, feeding call-info from\n    the RHSs back in the bottom, as it were\n\nIn effect, the ordering maxmimises the effectiveness of each sweep,\nand we do just two sweeps.   This should catch almost every case of\nmonomorphic recursion -- the exception could be a very knotted-up\nrecursion with multiple cycles tied up together.\n\nThis plan is implemented in the Rec case of specBindItself.\n\nNote [Specialisations already covered]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe obviously don't want to generate two specialisations for the same\nargument pattern.  There are two wrinkles\n\n1. We do the already-covered test in specDefn, not when we generate\nthe CallInfo in mkCallUDs.  We used to test in the latter place, but\nwe now iterate the specialiser somewhat, and the Id at the call site\nmight therefore not have all the RULES that we can see in specDefn\n\n2. What about two specialisations where the second is an *instance*\nof the first?  If the more specific one shows up first, we'll generate\nspecialisations for both.  If the *less* specific one shows up first,\nwe *don't* currently generate a specialisation for the more specific\none.  (See the call to lookupRule in already_covered.)  Reasons:\n  (a) lookupRule doesn't say which matches are exact (bad reason)\n  (b) if the earlier specialisation is user-provided, it's\n      far from clear that we should auto-specialise further\n\nNote [Auto-specialisation and RULES]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider:\n   g :: Num a => a -> a\n   g = ...\n\n   f :: (Int -> Int) -> Int\n   f w = ...\n   {-# RULE f g = 0 #-}\n\nSuppose that auto-specialisation makes a specialised version of\ng::Int->Int That version won't appear in the LHS of the RULE for f.\nSo if the specialisation rule fires too early, the rule for f may\nnever fire.\n\nIt might be possible to add new rules, to \"complete\" the rewrite system.\nThus when adding\n        RULE forall d. g Int d = g_spec\nalso add\n        RULE f g_spec = 0\n\nBut that's a bit complicated.  For now we ask the programmer's help,\nby *copying the INLINE activation pragma* to the auto-specialised\nrule.  So if g says {-# NOINLINE[2] g #-}, then the auto-spec rule\nwill also not be active until phase 2.  And that's what programmers\nshould jolly well do anyway, even aside from specialisation, to ensure\nthat g doesn't inline too early.\n\nThis in turn means that the RULE would never fire for a NOINLINE\nthing so not much point in generating a specialisation at all.\n\nNote [Specialisation shape]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe only specialise a function if it has visible top-level lambdas\ncorresponding to its overloading.  E.g. if\n        f :: forall a. Eq a => ....\nthen its body must look like\n        f = /\\a. \\d. ...\n\nReason: when specialising the body for a call (f ty dexp), we want to\nsubstitute dexp for d, and pick up specialised calls in the body of f.\n\nThis doesn't always work.  One example I came across was this:\n        newtype Gen a = MkGen{ unGen :: Int -> a }\n\n        choose :: Eq a => a -> Gen a\n        choose n = MkGen (\\r -> n)\n\n        oneof = choose (1::Int)\n\nIt's a silly example, but we get\n        choose = /\\a. g `cast` co\nwhere choose doesn't have any dict arguments.  Thus far I have not\ntried to fix this (wait till there's a real example).\n\nMind you, then 'choose' will be inlined (since RHS is trivial) so\nit doesn't matter.  This comes up with single-method classes\n\n   class C a where { op :: a -> a }\n   instance C a => C [a] where ....\n==>\n   $fCList :: C a => C [a]\n   $fCList = $copList |> (...coercion>...)\n   ....(uses of $fCList at particular types)...\n\nSo we suppress the WARN if the rhs is trivial.\n\nNote [Inline specialisations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere is what we do with the InlinePragma of the original function\n  * Activation/RuleMatchInfo: both transferred to the\n                              specialised function\n  * InlineSpec:\n       (a) An INLINE pragma is transferred\n       (b) An INLINABLE pragma is *not* transferred\n\nWhy (a): transfer INLINE pragmas? The point of INLINE was precisely to\nspecialise the function at its call site, and arguably that's not so\nimportant for the specialised copies.  BUT *pragma-directed*\nspecialisation now takes place in the typechecker/desugarer, with\nmanually specified INLINEs.  The specialisation here is automatic.\nIt'd be very odd if a function marked INLINE was specialised (because\nof some local use), and then forever after (including importing\nmodules) the specialised version wasn't INLINEd.  After all, the\nprogrammer said INLINE!\n\nYou might wonder why we specialise INLINE functions at all.  After\nall they should be inlined, right?  Two reasons:\n\n * Even INLINE functions are sometimes not inlined, when they aren't\n   applied to interesting arguments.  But perhaps the type arguments\n   alone are enough to specialise (even though the args are too boring\n   to trigger inlining), and it's certainly better to call the\n   specialised version.\n\n * The RHS of an INLINE function might call another overloaded function,\n   and we'd like to generate a specialised version of that function too.\n   This actually happens a lot. Consider\n      replicateM_ :: (Monad m) => Int -> m a -> m ()\n      {-# INLINABLE replicateM_ #-}\n      replicateM_ d x ma = ...\n   The strictness analyser may transform to\n      replicateM_ :: (Monad m) => Int -> m a -> m ()\n      {-# INLINE replicateM_ #-}\n      replicateM_ d x ma = case x of I# x' -> $wreplicateM_ d x' ma\n\n      $wreplicateM_ :: (Monad m) => Int# -> m a -> m ()\n      {-# INLINABLE $wreplicateM_ #-}\n      $wreplicateM_ = ...\n   Now an importing module has a specialised call to replicateM_, say\n   (replicateM_ dMonadIO).  We certainly want to specialise $wreplicateM_!\n   This particular example had a huge effect on the call to replicateM_\n   in nofib/shootout/n-body.\n\nWhy (b): discard INLINABLE pragmas? See Trac #4874 for persuasive examples.\nSuppose we have\n    {-# INLINABLE f #-}\n    f :: Ord a => [a] -> Int\n    f xs = letrec f' = ...f'... in f'\nThen, when f is specialised and optimised we might get\n    wgo :: [Int] -> Int#\n    wgo = ...wgo...\n    f_spec :: [Int] -> Int\n    f_spec xs = case wgo xs of { r -> I# r }\nand we clearly want to inline f_spec at call sites.  But if we still\nhave the big, un-optimised of f (albeit specialised) captured in an\nINLINABLE pragma for f_spec, we won't get that optimisation.\n\nSo we simply drop INLINABLE pragmas when specialising. It's not really\na complete solution; ignoring specialisation for now, INLINABLE functions\ndon't get properly strictness analysed, for example. But it works well\nfor examples involving specialisation, which is the dominant use of\nINLINABLE.  See Trac #4874.\n\n\n************************************************************************\n*                                                                      *\n\\subsubsection{UsageDetails and suchlike}\n*                                                                      *\n************************************************************************\n-}\n\ndata UsageDetails\n  = MkUD {\n      ud_binds :: !(Bag DictBind),\n               -- See Note [Floated dictionary bindings]\n               -- The order is important;\n               -- in ds1 `union` ds2, bindings in ds2 can depend on those in ds1\n               -- (Remember, Bags preserve order in GHC.)\n\n      ud_calls :: !CallDetails\n\n      -- INVARIANT: suppose bs = bindersOf ud_binds\n      -- Then 'calls' may *mention* 'bs',\n      -- but there should be no calls *for* bs\n    }\n\n-- | A 'DictBind' is a binding along with a cached set containing its free\n-- variables (both type variables and dictionaries)\ntype DictBind = (CoreBind, VarSet)\n\n{- Note [Floated dictionary bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe float out dictionary bindings for the reasons described under\n\"Dictionary floating\" above.  But not /just/ dictionary bindings.\nConsider\n\n   f :: Eq a => blah\n   f a d = rhs\n\n   $c== :: T -> T -> Bool\n   $c== x y = ...\n\n   $df :: Eq T\n   $df = Eq $c== ...\n\n   gurgle = ...(f @T $df)...\n\nWe gather the call info for (f @T $df), and we don't want to drop it\nwhen we come across the binding for $df.  So we add $df to the floats\nand continue.  But then we have to add $c== to the floats, and so on.\nThese all float above the binding for 'f', and and now we can\nsuccessfully specialise 'f'.\n\nSo the DictBinds in (ud_binds :: Bag DictBind) may contain\nnon-dictionary bindings too.\n-}\n\ninstance Outputable UsageDetails where\n  ppr (MkUD { ud_binds = dbs, ud_calls = calls })\n        = text \"MkUD\" <+> braces (sep (punctuate comma\n                [text \"binds\" <+> equals <+> ppr dbs,\n                 text \"calls\" <+> equals <+> ppr calls]))\n\nemptyUDs :: UsageDetails\nemptyUDs = MkUD { ud_binds = emptyBag, ud_calls = emptyDVarEnv }\n\n------------------------------------------------------------\ntype CallDetails  = DIdEnv CallInfoSet\n  -- The order of specialized binds and rules depends on how we linearize\n  -- CallDetails, so to get determinism we must use a deterministic set here.\n  -- See Note [Deterministic UniqFM] in UniqDFM\n\ndata CallInfoSet = CIS Id (Bag CallInfo)\n  -- The list of types and dictionaries is guaranteed to\n  -- match the type of f\n  -- The Bag may contain duplicate calls (i.e. f @T and another f @T)\n  -- These dups are eliminated by already_covered in specCalls\n\ndata CallInfo\n  = CI { ci_key  :: CallKey     -- Type arguments\n       , ci_args :: [DictExpr]  -- Dictionary arguments\n       , ci_fvs  :: VarSet      -- Free vars of the ci_key and ci_args\n                                -- call (including tyvars)\n                                -- [*not* include the main id itself, of course]\n    }\n\nnewtype CallKey   = CallKey [Maybe Type]\n  -- Nothing => unconstrained type argument\n\ntype DictExpr = CoreExpr\n\nciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet\nciSetFilter p (CIS id a) = CIS id (filterBag p a)\n\ninstance Outputable CallInfoSet where\n  ppr (CIS fn map) = hang (text \"CIS\" <+> ppr fn)\n                        2 (ppr map)\n\npprCallInfo :: Id -> CallInfo -> SDoc\npprCallInfo fn (CI { ci_key = key })\n  = ppr fn <+> ppr key\n\nppr_call_key_ty :: Maybe Type -> SDoc\nppr_call_key_ty Nothing   = char '_'\nppr_call_key_ty (Just ty) = char '@' <+> pprParendType ty\n\ninstance Outputable CallKey where\n  ppr (CallKey ts) = brackets (fsep (map ppr_call_key_ty ts))\n\ninstance Outputable CallInfo where\n  ppr (CI { ci_key = key, ci_args = args, ci_fvs = fvs })\n    = text \"CI\" <> braces (hsep [ ppr key, ppr args, ppr fvs ])\n\nunionCalls :: CallDetails -> CallDetails -> CallDetails\nunionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2\n\nunionCallInfoSet :: CallInfoSet -> CallInfoSet -> CallInfoSet\nunionCallInfoSet (CIS f calls1) (CIS _ calls2) =\n  CIS f (calls1 `unionBags` calls2)\n\ncallDetailsFVs :: CallDetails -> VarSet\ncallDetailsFVs calls =\n  nonDetFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls\n  -- It's OK to use nonDetFoldUDFM here because we forget the ordering\n  -- immediately by converting to a nondeterministic set.\n\ncallInfoFVs :: CallInfoSet -> VarSet\ncallInfoFVs (CIS _ call_info) =\n  foldrBag (\\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info\n\n------------------------------------------------------------\nsingleCall :: Id -> [Maybe Type] -> [DictExpr] -> UsageDetails\nsingleCall id tys dicts\n  = MkUD {ud_binds = emptyBag,\n          ud_calls = unitDVarEnv id $ CIS id $\n                     unitBag (CI { ci_key = CallKey tys\n                                 , ci_args = dicts\n                                 , ci_fvs  = call_fvs }) }\n  where\n    call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs\n    tys_fvs  = tyCoVarsOfTypes (catMaybes tys)\n        -- The type args (tys) are guaranteed to be part of the dictionary\n        -- types, because they are just the constrained types,\n        -- and the dictionary is therefore sure to be bound\n        -- inside the binding for any type variables free in the type;\n        -- hence it's safe to neglect tyvars free in tys when making\n        -- the free-var set for this call\n        -- BUT I don't trust this reasoning; play safe and include tys_fvs\n        --\n        -- We don't include the 'id' itself.\n\nmkCallUDs, mkCallUDs' :: SpecEnv -> Id -> [CoreExpr] -> UsageDetails\nmkCallUDs env f args\n  = -- pprTrace \"mkCallUDs\" (vcat [ ppr f, ppr args, ppr res ])\n    res\n  where\n    res = mkCallUDs' env f args\n\nmkCallUDs' env f args\n  | not (want_calls_for f)  -- Imported from elsewhere\n  || null theta             -- Not overloaded\n  = emptyUDs\n\n  |  not (all type_determines_value theta)\n  || not (spec_tys `lengthIs` n_tyvars)\n  || not ( dicts   `lengthIs` n_dicts)\n  || not (any (interestingDict env) dicts)    -- Note [Interesting dictionary arguments]\n  -- See also Note [Specialisations already covered]\n  = -- pprTrace \"mkCallUDs: discarding\" _trace_doc\n    emptyUDs    -- Not overloaded, or no specialisation wanted\n\n  | otherwise\n  = -- pprTrace \"mkCallUDs: keeping\" _trace_doc\n    singleCall f spec_tys dicts\n  where\n    _trace_doc = vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts\n                      , ppr (map (interestingDict env) dicts)]\n    (tyvars, theta, _)      = tcSplitSigmaTy (idType f)\n    constrained_tyvars      = tyCoVarsOfTypes theta\n    n_tyvars                = length tyvars\n    n_dicts                 = length theta\n\n    spec_tys = [mk_spec_ty tv ty | (tv, ty) <- tyvars `type_zip` args]\n    dicts    = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)]\n\n    -- ignores Coercion arguments\n    type_zip :: [TyVar] -> [CoreExpr] -> [(TyVar, Type)]\n    type_zip tvs      (Coercion _ : args) = type_zip tvs args\n    type_zip (tv:tvs) (Type ty : args)    = (tv, ty) : type_zip tvs args\n    type_zip _        _                   = []\n\n    mk_spec_ty tyvar ty\n        | tyvar `elemVarSet` constrained_tyvars = Just ty\n        | otherwise                             = Nothing\n\n    want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f))\n         -- For imported things, we gather call instances if\n         -- there is an unfolding that we could in principle specialise\n         -- We might still decide not to use it (consulting dflags)\n         -- in specImports\n         -- Use 'realIdUnfolding' to ignore the loop-breaker flag!\n\n    type_determines_value pred    -- See Note [Type determines value]\n        = case classifyPredType pred of\n            ClassPred cls _ -> not (isIPClass cls)  -- Superclasses can't be IPs\n            EqPred {}       -> True\n            IrredPred {}    -> True   -- Things like (D []) where D is a\n                                      -- Constraint-ranged family; Trac #7785\n            ForAllPred {}   -> True\n\n{-\nNote [Type determines value]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOnly specialise if all overloading is on non-IP *class* params,\nbecause these are the ones whose *type* determines their *value*.  In\nparrticular, with implicit params, the type args *don't* say what the\nvalue of the implicit param is!  See Trac #7101\n\nHowever, consider\n         type family D (v::*->*) :: Constraint\n         type instance D [] = ()\n         f :: D v => v Char -> Int\nIf we see a call (f \"foo\"), we'll pass a \"dictionary\"\n  () |> (g :: () ~ D [])\nand it's good to specialise f at this dictionary.\n\nSo the question is: can an implicit parameter \"hide inside\" a\ntype-family constraint like (D a).  Well, no.  We don't allow\n        type instance D Maybe = ?x:Int\nHence the IrredPred case in type_determines_value.\nSee Trac #7785.\n\nNote [Interesting dictionary arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n         \\a.\\d:Eq a.  let f = ... in ...(f d)...\nThere really is not much point in specialising f wrt the dictionary d,\nbecause the code for the specialised f is not improved at all, because\nd is lambda-bound.  We simply get junk specialisations.\n\nWhat is \"interesting\"?  Just that it has *some* structure.  But what about\nvariables?\n\n * A variable might be imported, in which case its unfolding\n   will tell us whether it has useful structure\n\n * Local variables are cloned on the way down (to avoid clashes when\n   we float dictionaries), and cloning drops the unfolding\n   (cloneIdBndr).  Moreover, we make up some new bindings, and it's a\n   nuisance to give them unfoldings.  So we keep track of the\n   \"interesting\" dictionaries as a VarSet in SpecEnv.\n   We have to take care to put any new interesting dictionary\n   bindings in the set.\n\nWe accidentally lost accurate tracking of local variables for a long\ntime, because cloned variables don't have unfoldings. But makes a\nmassive difference in a few cases, eg Trac #5113. For nofib as a\nwhole it's only a small win: 2.2% improvement in allocation for ansi,\n1.2% for bspt, but mostly 0.0!  Average 0.1% increase in binary size.\n-}\n\ninterestingDict :: SpecEnv -> CoreExpr -> Bool\n-- A dictionary argument is interesting if it has *some* structure\n-- NB: \"dictionary\" arguments include constraints of all sorts,\n--     including equality constraints; hence the Coercion case\ninterestingDict env (Var v) =  hasSomeUnfolding (idUnfolding v)\n                            || isDataConWorkId v\n                            || v `elemVarSet` se_interesting env\ninterestingDict _ (Type _)                = False\ninterestingDict _ (Coercion _)            = False\ninterestingDict env (App fn (Type _))     = interestingDict env fn\ninterestingDict env (App fn (Coercion _)) = interestingDict env fn\ninterestingDict env (Tick _ a)            = interestingDict env a\ninterestingDict env (Cast e _)            = interestingDict env e\ninterestingDict _ _                       = True\n\nplusUDs :: UsageDetails -> UsageDetails -> UsageDetails\nplusUDs (MkUD {ud_binds = db1, ud_calls = calls1})\n        (MkUD {ud_binds = db2, ud_calls = calls2})\n  = MkUD { ud_binds = db1    `unionBags`   db2\n         , ud_calls = calls1 `unionCalls`  calls2 }\n\n-----------------------------\n_dictBindBndrs :: Bag DictBind -> [Id]\n_dictBindBndrs dbs = foldrBag ((++) . bindersOf . fst) [] dbs\n\n-- | Construct a 'DictBind' from a 'CoreBind'\nmkDB :: CoreBind -> DictBind\nmkDB bind = (bind, bind_fvs bind)\n\n-- | Identify the free variables of a 'CoreBind'\nbind_fvs :: CoreBind -> VarSet\nbind_fvs (NonRec bndr rhs) = pair_fvs (bndr,rhs)\nbind_fvs (Rec prs)         = foldl' delVarSet rhs_fvs bndrs\n                           where\n                             bndrs = map fst prs\n                             rhs_fvs = unionVarSets (map pair_fvs prs)\n\npair_fvs :: (Id, CoreExpr) -> VarSet\npair_fvs (bndr, rhs) = exprSomeFreeVars interesting rhs\n                       `unionVarSet` idFreeVars bndr\n        -- idFreeVars: don't forget variables mentioned in\n        -- the rules of the bndr.  C.f. OccAnal.addRuleUsage\n        -- Also tyvars mentioned in its type; they may not appear\n        -- in the RHS\n        --      type T a = Int\n        --      x :: T a = 3\n  where\n    interesting :: InterestingVarFun\n    interesting v = isLocalVar v || (isId v && isDFunId v)\n        -- Very important: include DFunIds /even/ if it is imported\n        -- Reason: See Note [Avoiding loops], the second exmaple\n        --         involving an imported dfun.  We must know whether\n        --         a dictionary binding depends on an imported dfun,\n        --         in case we try to specialise that imported dfun\n        --         Trac #13429 illustrates\n\n-- | Flatten a set of \"dumped\" 'DictBind's, and some other binding\n-- pairs, into a single recursive binding.\nrecWithDumpedDicts :: [(Id,CoreExpr)] -> Bag DictBind ->DictBind\nrecWithDumpedDicts pairs dbs\n  = (Rec bindings, fvs)\n  where\n    (bindings, fvs) = foldrBag add\n                               ([], emptyVarSet)\n                               (dbs `snocBag` mkDB (Rec pairs))\n    add (NonRec b r, fvs') (pairs, fvs) =\n      ((b,r) : pairs, fvs `unionVarSet` fvs')\n    add (Rec prs1,   fvs') (pairs, fvs) =\n      (prs1 ++ pairs, fvs `unionVarSet` fvs')\n\nsnocDictBinds :: UsageDetails -> [DictBind] -> UsageDetails\n-- Add ud_binds to the tail end of the bindings in uds\nsnocDictBinds uds dbs\n  = uds { ud_binds = ud_binds uds `unionBags` listToBag dbs }\n\nconsDictBind :: DictBind -> UsageDetails -> UsageDetails\nconsDictBind bind uds = uds { ud_binds = bind `consBag` ud_binds uds }\n\naddDictBinds :: [DictBind] -> UsageDetails -> UsageDetails\naddDictBinds binds uds = uds { ud_binds = listToBag binds `unionBags` ud_binds uds }\n\nsnocDictBind :: UsageDetails -> DictBind -> UsageDetails\nsnocDictBind uds bind = uds { ud_binds = ud_binds uds `snocBag` bind }\n\nwrapDictBinds :: Bag DictBind -> [CoreBind] -> [CoreBind]\nwrapDictBinds dbs binds\n  = foldrBag add binds dbs\n  where\n    add (bind,_) binds = bind : binds\n\nwrapDictBindsE :: Bag DictBind -> CoreExpr -> CoreExpr\nwrapDictBindsE dbs expr\n  = foldrBag add expr dbs\n  where\n    add (bind,_) expr = Let bind expr\n\n----------------------\ndumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, Bag DictBind)\n-- Used at a lambda or case binder; just dump anything mentioning the binder\ndumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })\n  | null bndrs = (uds, emptyBag)  -- Common in case alternatives\n  | otherwise  = -- pprTrace \"dumpUDs\" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs) $\n                 (free_uds, dump_dbs)\n  where\n    free_uds = MkUD { ud_binds = free_dbs, ud_calls = free_calls }\n    bndr_set = mkVarSet bndrs\n    (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set\n    free_calls = deleteCallsMentioning dump_set $   -- Drop calls mentioning bndr_set on the floor\n                 deleteCallsFor bndrs orig_calls    -- Discard calls for bndr_set; there should be\n                                                    -- no calls for any of the dicts in dump_dbs\n\ndumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, Bag DictBind, Bool)\n-- Used at a let(rec) binding.\n-- We return a boolean indicating whether the binding itself is mentioned,\n-- directly or indirectly, by any of the ud_calls; in that case we want to\n-- float the binding itself;\n-- See Note [Floated dictionary bindings]\ndumpBindUDs bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })\n  = -- pprTrace \"dumpBindUDs\" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs) $\n    (free_uds, dump_dbs, float_all)\n  where\n    free_uds = MkUD { ud_binds = free_dbs, ud_calls = free_calls }\n    bndr_set = mkVarSet bndrs\n    (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set\n    free_calls = deleteCallsFor bndrs orig_calls\n    float_all = dump_set `intersectsVarSet` callDetailsFVs free_calls\n\ncallsForMe :: Id -> UsageDetails -> (UsageDetails, [CallInfo])\ncallsForMe fn (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })\n  = -- pprTrace (\"callsForMe\")\n    --          (vcat [ppr fn,\n    --                 text \"Orig dbs =\"     <+> ppr (_dictBindBndrs orig_dbs),\n    --                 text \"Orig calls =\"   <+> ppr orig_calls,\n    --                 text \"Dep set =\"      <+> ppr dep_set,\n    --                 text \"Calls for me =\" <+> ppr calls_for_me]) $\n    (uds_without_me, calls_for_me)\n  where\n    uds_without_me = MkUD { ud_binds = orig_dbs\n                          , ud_calls = delDVarEnv orig_calls fn }\n    calls_for_me = case lookupDVarEnv orig_calls fn of\n                        Nothing -> []\n                        Just cis -> filterCalls cis orig_dbs\n         -- filterCalls: drop calls that (directly or indirectly)\n         -- refer to fn.  See Note [Avoiding loops]\n\n----------------------\nfilterCalls :: CallInfoSet -> Bag DictBind -> [CallInfo]\n-- See Note [Avoiding loops]\nfilterCalls (CIS fn call_bag) dbs\n  = filter ok_call (bagToList call_bag)\n  where\n    dump_set = foldlBag go (unitVarSet fn) dbs\n      -- This dump-set could also be computed by splitDictBinds\n      --   (_,_,dump_set) = splitDictBinds dbs {fn}\n      -- But this variant is shorter\n\n    go so_far (db,fvs) | fvs `intersectsVarSet` so_far\n                       = extendVarSetList so_far (bindersOf db)\n                       | otherwise = so_far\n\n    ok_call (CI { ci_fvs = fvs }) = not (fvs `intersectsVarSet` dump_set)\n\n----------------------\nsplitDictBinds :: Bag DictBind -> IdSet -> (Bag DictBind, Bag DictBind, IdSet)\n-- splitDictBinds dbs bndrs returns\n--   (free_dbs, dump_dbs, dump_set)\n-- where\n--   * dump_dbs depends, transitively on bndrs\n--   * free_dbs does not depend on bndrs\n--   * dump_set = bndrs `union` bndrs(dump_dbs)\nsplitDictBinds dbs bndr_set\n   = foldlBag split_db (emptyBag, emptyBag, bndr_set) dbs\n                -- Important that it's foldl not foldr;\n                -- we're accumulating the set of dumped ids in dump_set\n   where\n    split_db (free_dbs, dump_dbs, dump_idset) db@(bind, fvs)\n        | dump_idset `intersectsVarSet` fvs     -- Dump it\n        = (free_dbs, dump_dbs `snocBag` db,\n           extendVarSetList dump_idset (bindersOf bind))\n\n        | otherwise     -- Don't dump it\n        = (free_dbs `snocBag` db, dump_dbs, dump_idset)\n\n\n----------------------\ndeleteCallsMentioning :: VarSet -> CallDetails -> CallDetails\n-- Remove calls *mentioning* bs in any way\ndeleteCallsMentioning bs calls\n  = mapDVarEnv (ciSetFilter keep_call) calls\n  where\n    keep_call (CI { ci_fvs = fvs }) = not (fvs `intersectsVarSet` bs)\n\ndeleteCallsFor :: [Id] -> CallDetails -> CallDetails\n-- Remove calls *for* bs\ndeleteCallsFor bs calls = delDVarEnvList calls bs\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Boring helper functions}\n*                                                                      *\n************************************************************************\n-}\n\nnewtype SpecM a = SpecM (State SpecState a)\n\ndata SpecState = SpecState {\n                     spec_uniq_supply :: UniqSupply,\n                     spec_module :: Module,\n                     spec_dflags :: DynFlags\n                 }\n\ninstance Functor SpecM where\n    fmap = liftM\n\ninstance Applicative SpecM where\n    pure x = SpecM $ return x\n    (<*>) = ap\n\ninstance Monad SpecM where\n    SpecM x >>= f = SpecM $ do y <- x\n                               case f y of\n                                   SpecM z ->\n                                       z\n#if !MIN_VERSION_base(4,13,0)\n    fail = MonadFail.fail\n#endif\n\ninstance MonadFail.MonadFail SpecM where\n   fail str = SpecM $ error str\n\ninstance MonadUnique SpecM where\n    getUniqueSupplyM\n        = SpecM $ do st <- get\n                     let (us1, us2) = splitUniqSupply $ spec_uniq_supply st\n                     put $ st { spec_uniq_supply = us2 }\n                     return us1\n\n    getUniqueM\n        = SpecM $ do st <- get\n                     let (u,us') = takeUniqFromSupply $ spec_uniq_supply st\n                     put $ st { spec_uniq_supply = us' }\n                     return u\n\ninstance HasDynFlags SpecM where\n    getDynFlags = SpecM $ liftM spec_dflags get\n\ninstance HasModule SpecM where\n    getModule = SpecM $ liftM spec_module get\n\nrunSpecM :: DynFlags -> Module -> SpecM a -> CoreM a\nrunSpecM dflags this_mod (SpecM spec)\n    = do us <- getUniqueSupplyM\n         let initialState = SpecState {\n                                spec_uniq_supply = us,\n                                spec_module = this_mod,\n                                spec_dflags = dflags\n                            }\n         return $ evalState spec initialState\n\nmapAndCombineSM :: (a -> SpecM (b, UsageDetails)) -> [a] -> SpecM ([b], UsageDetails)\nmapAndCombineSM _ []     = return ([], emptyUDs)\nmapAndCombineSM f (x:xs) = do (y, uds1) <- f x\n                              (ys, uds2) <- mapAndCombineSM f xs\n                              return (y:ys, uds1 `plusUDs` uds2)\n\nextendTvSubstList :: SpecEnv -> [(TyVar,Type)] -> SpecEnv\nextendTvSubstList env tv_binds\n  = env { se_subst = CoreSubst.extendTvSubstList (se_subst env) tv_binds }\n\nsubstTy :: SpecEnv -> Type -> Type\nsubstTy env ty = CoreSubst.substTy (se_subst env) ty\n\nsubstCo :: SpecEnv -> Coercion -> Coercion\nsubstCo env co = CoreSubst.substCo (se_subst env) co\n\nsubstBndr :: SpecEnv -> CoreBndr -> (SpecEnv, CoreBndr)\nsubstBndr env bs = case CoreSubst.substBndr (se_subst env) bs of\n                      (subst', bs') -> (env { se_subst = subst' }, bs')\n\nsubstBndrs :: SpecEnv -> [CoreBndr] -> (SpecEnv, [CoreBndr])\nsubstBndrs env bs = case CoreSubst.substBndrs (se_subst env) bs of\n                      (subst', bs') -> (env { se_subst = subst' }, bs')\n\ncloneBindSM :: SpecEnv -> CoreBind -> SpecM (SpecEnv, SpecEnv, CoreBind)\n-- Clone the binders of the bind; return new bind with the cloned binders\n-- Return the substitution to use for RHSs, and the one to use for the body\ncloneBindSM env@(SE { se_subst = subst, se_interesting = interesting }) (NonRec bndr rhs)\n  = do { us <- getUniqueSupplyM\n       ; let (subst', bndr') = CoreSubst.cloneIdBndr subst us bndr\n             interesting' | interestingDict env rhs\n                          = interesting `extendVarSet` bndr'\n                          | otherwise = interesting\n       ; return (env, env { se_subst = subst', se_interesting = interesting' }\n                , NonRec bndr' rhs) }\n\ncloneBindSM env@(SE { se_subst = subst, se_interesting = interesting }) (Rec pairs)\n  = do { us <- getUniqueSupplyM\n       ; let (subst', bndrs') = CoreSubst.cloneRecIdBndrs subst us (map fst pairs)\n             env' = env { se_subst = subst'\n                        , se_interesting = interesting `extendVarSetList`\n                                           [ v | (v,r) <- pairs, interestingDict env r ] }\n       ; return (env', env', Rec (bndrs' `zip` map snd pairs)) }\n\nnewDictBndr :: SpecEnv -> CoreBndr -> SpecM CoreBndr\n-- Make up completely fresh binders for the dictionaries\n-- Their bindings are going to float outwards\nnewDictBndr env b = do { uniq <- getUniqueM\n                       ; let n   = idName b\n                             ty' = substTy env (idType b)\n                       ; return (mkUserLocalOrCoVar (nameOccName n) uniq ty' (getSrcSpan n)) }\n\nnewSpecIdSM :: Id -> Type -> Maybe JoinArity -> SpecM Id\n    -- Give the new Id a similar occurrence name to the old one\nnewSpecIdSM old_id new_ty join_arity_maybe\n  = do  { uniq <- getUniqueM\n        ; let name    = idName old_id\n              new_occ = mkSpecOcc (nameOccName name)\n              new_id  = mkUserLocalOrCoVar new_occ uniq new_ty (getSrcSpan name)\n                          `asJoinId_maybe` join_arity_maybe\n        ; return new_id }\n\n{-\n                Old (but interesting) stuff about unboxed bindings\n                ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhat should we do when a value is specialised to a *strict* unboxed value?\n\n        map_*_* f (x:xs) = let h = f x\n                               t = map f xs\n                           in h:t\n\nCould convert let to case:\n\n        map_*_Int# f (x:xs) = case f x of h# ->\n                              let t = map f xs\n                              in h#:t\n\nThis may be undesirable since it forces evaluation here, but the value\nmay not be used in all branches of the body. In the general case this\ntransformation is impossible since the mutual recursion in a letrec\ncannot be expressed as a case.\n\nThere is also a problem with top-level unboxed values, since our\nimplementation cannot handle unboxed values at the top level.\n\nSolution: Lift the binding of the unboxed value and extract it when it\nis used:\n\n        map_*_Int# f (x:xs) = let h = case (f x) of h# -> _Lift h#\n                                  t = map f xs\n                              in case h of\n                                 _Lift h# -> h#:t\n\nNow give it to the simplifier and the _Lifting will be optimised away.\n\nThe benefit is that we have given the specialised \"unboxed\" values a\nvery simple lifted semantics and then leave it up to the simplifier to\noptimise it --- knowing that the overheads will be removed in nearly\nall cases.\n\nIn particular, the value will only be evaluated in the branches of the\nprogram which use it, rather than being forced at the point where the\nvalue is bound. For example:\n\n        filtermap_*_* p f (x:xs)\n          = let h = f x\n                t = ...\n            in case p x of\n                True  -> h:t\n                False -> t\n   ==>\n        filtermap_*_Int# p f (x:xs)\n          = let h = case (f x) of h# -> _Lift h#\n                t = ...\n            in case p x of\n                True  -> case h of _Lift h#\n                           -> h#:t\n                False -> t\n\nThe binding for h can still be inlined in the one branch and the\n_Lifting eliminated.\n\n\nQuestion: When won't the _Lifting be eliminated?\n\nAnswer: When they at the top-level (where it is necessary) or when\ninlining would duplicate work (or possibly code depending on\noptions). However, the _Lifting will still be eliminated if the\nstrictness analyser deems the lifted binding strict.\n-}\n", "num_lines": 2457}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n--\n-- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n--\n\n--------------------------------------------------------------\n-- Converting Core to STG Syntax\n--------------------------------------------------------------\n\n-- And, as we have the info in hand, we may convert some lets to\n-- let-no-escapes.\n\nmodule CoreToStg ( coreToStg ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreUtils        ( exprType, findDefault, isJoinBind\n                        , exprIsTickedString_maybe )\nimport CoreArity        ( manifestArity )\nimport StgSyn\n\nimport Type\nimport RepType\nimport TyCon\nimport MkId             ( coercionTokenId )\nimport Id\nimport IdInfo\nimport DataCon\nimport CostCentre\nimport VarEnv\nimport Module\nimport Name             ( isExternalName, nameOccName, nameModule_maybe )\nimport OccName          ( occNameFS )\nimport BasicTypes       ( Arity )\nimport TysWiredIn       ( unboxedUnitDataCon, unitDataConId )\nimport Literal\nimport Outputable\nimport MonadUtils\nimport FastString\nimport Util\nimport DynFlags\nimport ForeignCall\nimport Demand           ( isUsedOnce )\nimport PrimOp           ( PrimCall(..) )\nimport SrcLoc           ( mkGeneralSrcSpan )\n\nimport Data.List.NonEmpty (nonEmpty, toList)\nimport Data.Maybe    (fromMaybe)\nimport Control.Monad (liftM, ap)\n\n-- Note [Live vs free]\n-- ~~~~~~~~~~~~~~~~~~~\n--\n-- The two are not the same. Liveness is an operational property rather\n-- than a semantic one. A variable is live at a particular execution\n-- point if it can be referred to directly again. In particular, a dead\n-- variable's stack slot (if it has one):\n--\n--           - should be stubbed to avoid space leaks, and\n--           - may be reused for something else.\n--\n-- There ought to be a better way to say this. Here are some examples:\n--\n--         let v = [q] \\[x] -> e\n--         in\n--         ...v...  (but no q's)\n--\n-- Just after the `in', v is live, but q is dead. If the whole of that\n-- let expression was enclosed in a case expression, thus:\n--\n--         case (let v = [q] \\[x] -> e in ...v...) of\n--                 alts[...q...]\n--\n-- (ie `alts' mention `q'), then `q' is live even after the `in'; because\n-- we'll return later to the `alts' and need it.\n--\n-- Let-no-escapes make this a bit more interesting:\n--\n--         let-no-escape v = [q] \\ [x] -> e\n--         in\n--         ...v...\n--\n-- Here, `q' is still live at the `in', because `v' is represented not by\n-- a closure but by the current stack state.  In other words, if `v' is\n-- live then so is `q'. Furthermore, if `e' mentions an enclosing\n-- let-no-escaped variable, then its free variables are also live if `v' is.\n\n-- Note [What are these SRTs all about?]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Consider the Core program,\n--\n--     fibs = go 1 1\n--       where go a b = let c = a + c\n--                      in c : go b c\n--     add x = map (\\y -> x*y) fibs\n--\n-- In this case we have a CAF, 'fibs', which is quite large after evaluation and\n-- has only one possible user, 'add'. Consequently, we want to ensure that when\n-- all references to 'add' die we can garbage collect any bit of 'fibs' that we\n-- have evaluated.\n--\n-- However, how do we know whether there are any references to 'fibs' still\n-- around? Afterall, the only reference to it is buried in the code generated\n-- for 'add'. The answer is that we record the CAFs referred to by a definition\n-- in its info table, namely a part of it known as the Static Reference Table\n-- (SRT).\n--\n-- Since SRTs are so common, we use a special compact encoding for them in: we\n-- produce one table containing a list of CAFs in a module and then include a\n-- bitmap in each info table describing which entries of this table the closure\n-- references.\n--\n-- See also: Commentary/Rts/Storage/GC/CAFs on the GHC Wiki.\n\n-- Note [What is a non-escaping let]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- NB: Nowadays this is recognized by the occurrence analyser by turning a\n-- \"non-escaping let\" into a join point. The following is then an operational\n-- account of join points.\n--\n-- Consider:\n--\n--     let x = fvs \\ args -> e\n--     in\n--         if ... then x else\n--            if ... then x else ...\n--\n-- `x' is used twice (so we probably can't unfold it), but when it is\n-- entered, the stack is deeper than it was when the definition of `x'\n-- happened.  Specifically, if instead of allocating a closure for `x',\n-- we saved all `x's fvs on the stack, and remembered the stack depth at\n-- that moment, then whenever we enter `x' we can simply set the stack\n-- pointer(s) to these remembered (compile-time-fixed) values, and jump\n-- to the code for `x'.\n--\n-- All of this is provided x is:\n--   1. non-updatable;\n--   2. guaranteed to be entered before the stack retreats -- ie x is not\n--      buried in a heap-allocated closure, or passed as an argument to\n--      something;\n--   3. all the enters have exactly the right number of arguments,\n--      no more no less;\n--   4. all the enters are tail calls; that is, they return to the\n--      caller enclosing the definition of `x'.\n--\n-- Under these circumstances we say that `x' is non-escaping.\n--\n-- An example of when (4) does not hold:\n--\n--     let x = ...\n--     in case x of ...alts...\n--\n-- Here, `x' is certainly entered only when the stack is deeper than when\n-- `x' is defined, but here it must return to ...alts... So we can't just\n-- adjust the stack down to `x''s recalled points, because that would lost\n-- alts' context.\n--\n-- Things can get a little more complicated.  Consider:\n--\n--     let y = ...\n--     in let x = fvs \\ args -> ...y...\n--     in ...x...\n--\n-- Now, if `x' is used in a non-escaping way in ...x..., and `y' is used in a\n-- non-escaping way in ...y..., then `y' is non-escaping.\n--\n-- `x' can even be recursive!  Eg:\n--\n--     letrec x = [y] \\ [v] -> if v then x True else ...\n--     in\n--         ...(x b)...\n\n-- Note [Cost-centre initialization plan]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Previously `coreToStg` was initializing cost-centre stack fields as `noCCS`,\n-- and the fields were then fixed by a separate pass `stgMassageForProfiling`.\n-- We now initialize these correctly. The initialization works like this:\n--\n--   - For non-top level bindings always use `currentCCS`.\n--\n--   - For top-level bindings, check if the binding is a CAF\n--\n--     - CAF:      If -fcaf-all is enabled, create a new CAF just for this CAF\n--                 and use it. Note that these new cost centres need to be\n--                 collected to be able to generate cost centre initialization\n--                 code, so `coreToTopStgRhs` now returns `CollectedCCs`.\n--\n--                 If -fcaf-all is not enabled, use \"all CAFs\" cost centre.\n--\n--     - Non-CAF:  Top-level (static) data is not counted in heap profiles; nor\n--                 do we set CCCS from it; so we just slam in\n--                 dontCareCostCentre.\n\n-- --------------------------------------------------------------\n-- Setting variable info: top-level, binds, RHSs\n-- --------------------------------------------------------------\n\ncoreToStg :: DynFlags -> Module -> CoreProgram\n          -> ([StgTopBinding], CollectedCCs)\ncoreToStg dflags this_mod pgm\n  = (pgm', final_ccs)\n  where\n    (_, (local_ccs, local_cc_stacks), pgm')\n      = coreTopBindsToStg dflags this_mod emptyVarEnv emptyCollectedCCs pgm\n\n    prof = WayProf `elem` ways dflags\n\n    final_ccs\n      | prof && gopt Opt_AutoSccsOnIndividualCafs dflags\n      = (local_ccs,local_cc_stacks)  -- don't need \"all CAFs\" CC\n      | prof\n      = (all_cafs_cc:local_ccs, all_cafs_ccs:local_cc_stacks)\n      | otherwise\n      = emptyCollectedCCs\n\n    (all_cafs_cc, all_cafs_ccs) = getAllCAFsCC this_mod\n\ncoreTopBindsToStg\n    :: DynFlags\n    -> Module\n    -> IdEnv HowBound           -- environment for the bindings\n    -> CollectedCCs\n    -> CoreProgram\n    -> (IdEnv HowBound, CollectedCCs, [StgTopBinding])\n\ncoreTopBindsToStg _      _        env ccs []\n  = (env, ccs, [])\ncoreTopBindsToStg dflags this_mod env ccs (b:bs)\n  = (env2, ccs2, b':bs')\n  where\n        (env1, ccs1, b' ) =\n          coreTopBindToStg dflags this_mod env ccs b\n        (env2, ccs2, bs') =\n          coreTopBindsToStg dflags this_mod env1 ccs1 bs\n\ncoreTopBindToStg\n        :: DynFlags\n        -> Module\n        -> IdEnv HowBound\n        -> CollectedCCs\n        -> CoreBind\n        -> (IdEnv HowBound, CollectedCCs, StgTopBinding)\n\ncoreTopBindToStg _ _ env ccs (NonRec id e)\n  | Just str <- exprIsTickedString_maybe e\n  -- top-level string literal\n  -- See Note [CoreSyn top-level string literals] in CoreSyn\n  = let\n        env' = extendVarEnv env id how_bound\n        how_bound = LetBound TopLet 0\n    in (env', ccs, StgTopStringLit id str)\n\ncoreTopBindToStg dflags this_mod env ccs (NonRec id rhs)\n  = let\n        env'      = extendVarEnv env id how_bound\n        how_bound = LetBound TopLet $! manifestArity rhs\n\n        (stg_rhs, ccs') =\n            initCts env $\n              coreToTopStgRhs dflags ccs this_mod (id,rhs)\n\n        bind = StgTopLifted $ StgNonRec id stg_rhs\n    in\n    ASSERT2(consistentCafInfo id bind, ppr id )\n      -- NB: previously the assertion printed 'rhs' and 'bind'\n      --     as well as 'id', but that led to a black hole\n      --     where printing the assertion error tripped the\n      --     assertion again!\n    (env', ccs', bind)\n\ncoreTopBindToStg dflags this_mod env ccs (Rec pairs)\n  = ASSERT( not (null pairs) )\n    let\n        binders = map fst pairs\n\n        extra_env' = [ (b, LetBound TopLet $! manifestArity rhs)\n                     | (b, rhs) <- pairs ]\n        env' = extendVarEnvList env extra_env'\n\n        -- generate StgTopBindings and CAF cost centres created for CAFs\n        (ccs', stg_rhss)\n          = initCts env' $ do\n               mapAccumLM (\\ccs rhs -> do\n                            (rhs', ccs') <-\n                              coreToTopStgRhs dflags ccs this_mod rhs\n                            return (ccs', rhs'))\n                          ccs\n                          pairs\n\n        bind = StgTopLifted $ StgRec (zip binders stg_rhss)\n    in\n    ASSERT2(consistentCafInfo (head binders) bind, ppr binders)\n    (env', ccs', bind)\n\n\n-- Assertion helper: this checks that the CafInfo on the Id matches\n-- what CoreToStg has figured out about the binding's SRT.  The\n-- CafInfo will be exact in all cases except when CorePrep has\n-- floated out a binding, in which case it will be approximate.\nconsistentCafInfo :: Id -> StgTopBinding -> Bool\nconsistentCafInfo id bind\n  = WARN( not (exact || is_sat_thing) , ppr id <+> ppr id_marked_caffy <+> ppr binding_is_caffy )\n    safe\n  where\n    safe  = id_marked_caffy || not binding_is_caffy\n    exact = id_marked_caffy == binding_is_caffy\n    id_marked_caffy  = mayHaveCafRefs (idCafInfo id)\n    binding_is_caffy = topStgBindHasCafRefs bind\n    is_sat_thing = occNameFS (nameOccName (idName id)) == fsLit \"sat\"\n\ncoreToTopStgRhs\n        :: DynFlags\n        -> CollectedCCs\n        -> Module\n        -> (Id,CoreExpr)\n        -> CtsM (StgRhs, CollectedCCs)\n\ncoreToTopStgRhs dflags ccs this_mod (bndr, rhs)\n  = do { new_rhs <- coreToStgExpr rhs\n\n       ; let (stg_rhs, ccs') =\n               mkTopStgRhs dflags this_mod ccs bndr new_rhs\n             stg_arity =\n               stgRhsArity stg_rhs\n\n       ; return (ASSERT2( arity_ok stg_arity, mk_arity_msg stg_arity) stg_rhs,\n                 ccs') }\n  where\n        -- It's vital that the arity on a top-level Id matches\n        -- the arity of the generated STG binding, else an importing\n        -- module will use the wrong calling convention\n        --      (Trac #2844 was an example where this happened)\n        -- NB1: we can't move the assertion further out without\n        --      blocking the \"knot\" tied in coreTopBindsToStg\n        -- NB2: the arity check is only needed for Ids with External\n        --      Names, because they are externally visible.  The CorePrep\n        --      pass introduces \"sat\" things with Local Names and does\n        --      not bother to set their Arity info, so don't fail for those\n    arity_ok stg_arity\n       | isExternalName (idName bndr) = id_arity == stg_arity\n       | otherwise                    = True\n    id_arity  = idArity bndr\n    mk_arity_msg stg_arity\n        = vcat [ppr bndr,\n                text \"Id arity:\" <+> ppr id_arity,\n                text \"STG arity:\" <+> ppr stg_arity]\n\n-- ---------------------------------------------------------------------------\n-- Expressions\n-- ---------------------------------------------------------------------------\n\ncoreToStgExpr\n        :: CoreExpr\n        -> CtsM StgExpr\n\n-- The second and third components can be derived in a simple bottom up pass, not\n-- dependent on any decisions about which variables will be let-no-escaped or\n-- not.  The first component, that is, the decorated expression, may then depend\n-- on these components, but it in turn is not scrutinised as the basis for any\n-- decisions.  Hence no black holes.\n\n-- No LitInteger's or LitNatural's should be left by the time this is called.\n-- CorePrep should have converted them all to a real core representation.\ncoreToStgExpr (Lit (LitNumber LitNumInteger _ _)) = panic \"coreToStgExpr: LitInteger\"\ncoreToStgExpr (Lit (LitNumber LitNumNatural _ _)) = panic \"coreToStgExpr: LitNatural\"\ncoreToStgExpr (Lit l)      = return (StgLit l)\ncoreToStgExpr (App (Lit LitRubbish) _some_unlifted_type)\n  -- We lower 'LitRubbish' to @()@ here, which is much easier than doing it in\n  -- a STG to Cmm pass.\n  = coreToStgExpr (Var unitDataConId)\ncoreToStgExpr (Var v)      = coreToStgApp Nothing v               [] []\ncoreToStgExpr (Coercion _) = coreToStgApp Nothing coercionTokenId [] []\n\ncoreToStgExpr expr@(App _ _)\n  = coreToStgApp Nothing f args ticks\n  where\n    (f, args, ticks) = myCollectArgs expr\n\ncoreToStgExpr expr@(Lam _ _)\n  = let\n        (args, body) = myCollectBinders expr\n        args'        = filterStgBinders args\n    in\n    extendVarEnvCts [ (a, LambdaBound) | a <- args' ] $ do\n    body' <- coreToStgExpr body\n    let\n        result_expr = case nonEmpty args' of\n          Nothing     -> body'\n          Just args'' -> StgLam args'' body'\n\n    return result_expr\n\ncoreToStgExpr (Tick tick expr)\n  = do case tick of\n         HpcTick{}    -> return ()\n         ProfNote{}   -> return ()\n         SourceNote{} -> return ()\n         Breakpoint{} -> panic \"coreToStgExpr: breakpoint should not happen\"\n       expr2 <- coreToStgExpr expr\n       return (StgTick tick expr2)\n\ncoreToStgExpr (Cast expr _)\n  = coreToStgExpr expr\n\n-- Cases require a little more real work.\n\ncoreToStgExpr (Case scrut _ _ [])\n  = coreToStgExpr scrut\n    -- See Note [Empty case alternatives] in CoreSyn If the case\n    -- alternatives are empty, the scrutinee must diverge or raise an\n    -- exception, so we can just dive into it.\n    --\n    -- Of course this may seg-fault if the scrutinee *does* return.  A\n    -- belt-and-braces approach would be to move this case into the\n    -- code generator, and put a return point anyway that calls a\n    -- runtime system error function.\n\n\ncoreToStgExpr (Case scrut bndr _ alts) = do\n    alts2 <- extendVarEnvCts [(bndr, LambdaBound)] (mapM vars_alt alts)\n    scrut2 <- coreToStgExpr scrut\n    return (StgCase scrut2 bndr (mkStgAltType bndr alts) alts2)\n  where\n    vars_alt (con, binders, rhs)\n      | DataAlt c <- con, c == unboxedUnitDataCon\n      = -- This case is a bit smelly.\n        -- See Note [Nullary unboxed tuple] in Type.hs\n        -- where a nullary tuple is mapped to (State# World#)\n        ASSERT( null binders )\n        do { rhs2 <- coreToStgExpr rhs\n           ; return (DEFAULT, [], rhs2)  }\n      | otherwise\n      = let     -- Remove type variables\n            binders' = filterStgBinders binders\n        in\n        extendVarEnvCts [(b, LambdaBound) | b <- binders'] $ do\n        rhs2 <- coreToStgExpr rhs\n        return (con, binders', rhs2)\n\ncoreToStgExpr (Let bind body) = do\n    coreToStgLet bind body\n\ncoreToStgExpr e = pprPanic \"coreToStgExpr\" (ppr e)\n\nmkStgAltType :: Id -> [CoreAlt] -> AltType\nmkStgAltType bndr alts\n  | isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty\n  = MultiValAlt (length prim_reps)  -- always use MultiValAlt for unboxed tuples\n\n  | otherwise\n  = case prim_reps of\n      [LiftedRep] -> case tyConAppTyCon_maybe (unwrapType bndr_ty) of\n        Just tc\n          | isAbstractTyCon tc -> look_for_better_tycon\n          | isAlgTyCon tc      -> AlgAlt tc\n          | otherwise          -> ASSERT2( _is_poly_alt_tycon tc, ppr tc )\n                                  PolyAlt\n        Nothing                -> PolyAlt\n      [unlifted] -> PrimAlt unlifted\n      not_unary  -> MultiValAlt (length not_unary)\n  where\n   bndr_ty   = idType bndr\n   prim_reps = typePrimRep bndr_ty\n\n   _is_poly_alt_tycon tc\n        =  isFunTyCon tc\n        || isPrimTyCon tc   -- \"Any\" is lifted but primitive\n        || isFamilyTyCon tc -- Type family; e.g. Any, or arising from strict\n                            -- function application where argument has a\n                            -- type-family type\n\n   -- Sometimes, the TyCon is a AbstractTyCon which may not have any\n   -- constructors inside it.  Then we may get a better TyCon by\n   -- grabbing the one from a constructor alternative\n   -- if one exists.\n   look_for_better_tycon\n        | ((DataAlt con, _, _) : _) <- data_alts =\n                AlgAlt (dataConTyCon con)\n        | otherwise =\n                ASSERT(null data_alts)\n                PolyAlt\n        where\n                (data_alts, _deflt) = findDefault alts\n\n-- ---------------------------------------------------------------------------\n-- Applications\n-- ---------------------------------------------------------------------------\n\ncoreToStgApp\n         :: Maybe UpdateFlag            -- Just upd <=> this application is\n                                        -- the rhs of a thunk binding\n                                        --      x = [...] \\upd [] -> the_app\n                                        -- with specified update flag\n        -> Id                           -- Function\n        -> [CoreArg]                    -- Arguments\n        -> [Tickish Id]                 -- Debug ticks\n        -> CtsM StgExpr\n\n\ncoreToStgApp _ f args ticks = do\n    (args', ticks') <- coreToStgArgs args\n    how_bound <- lookupVarCts f\n\n    let\n        n_val_args       = valArgCount args\n\n        -- Mostly, the arity info of a function is in the fn's IdInfo\n        -- But new bindings introduced by CoreSat may not have no\n        -- arity info; it would do us no good anyway.  For example:\n        --      let f = \\ab -> e in f\n        -- No point in having correct arity info for f!\n        -- Hence the hasArity stuff below.\n        -- NB: f_arity is only consulted for LetBound things\n        f_arity   = stgArity f how_bound\n        saturated = f_arity <= n_val_args\n\n        res_ty = exprType (mkApps (Var f) args)\n        app = case idDetails f of\n                DataConWorkId dc\n                  | saturated    -> StgConApp dc args'\n                                      (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty)))\n\n                -- Some primitive operator that might be implemented as a library call.\n                PrimOpId op      -> ASSERT( saturated )\n                                    StgOpApp (StgPrimOp op) args' res_ty\n\n                -- A call to some primitive Cmm function.\n                FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True)\n                                          PrimCallConv _))\n                                 -> ASSERT( saturated )\n                                    StgOpApp (StgPrimCallOp (PrimCall lbl pkgId)) args' res_ty\n\n                -- A regular foreign call.\n                FCallId call     -> ASSERT( saturated )\n                                    StgOpApp (StgFCallOp call (idUnique f)) args' res_ty\n\n                TickBoxOpId {}   -> pprPanic \"coreToStg TickBox\" $ ppr (f,args')\n                _other           -> StgApp f args'\n\n        tapp = foldr StgTick app (ticks ++ ticks')\n\n    -- Forcing these fixes a leak in the code generator, noticed while\n    -- profiling for trac #4367\n    app `seq` return tapp\n\n-- ---------------------------------------------------------------------------\n-- Argument lists\n-- This is the guy that turns applications into A-normal form\n-- ---------------------------------------------------------------------------\n\ncoreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [Tickish Id])\ncoreToStgArgs []\n  = return ([], [])\n\ncoreToStgArgs (Type _ : args) = do     -- Type argument\n    (args', ts) <- coreToStgArgs args\n    return (args', ts)\n\ncoreToStgArgs (Coercion _ : args)  -- Coercion argument; replace with place holder\n  = do { (args', ts) <- coreToStgArgs args\n       ; return (StgVarArg coercionTokenId : args', ts) }\n\ncoreToStgArgs (Tick t e : args)\n  = ASSERT( not (tickishIsCode t) )\n    do { (args', ts) <- coreToStgArgs (e : args)\n       ; return (args', t:ts) }\n\ncoreToStgArgs (arg : args) = do         -- Non-type argument\n    (stg_args, ticks) <- coreToStgArgs args\n    arg' <- coreToStgExpr arg\n    let\n        (aticks, arg'') = stripStgTicksTop tickishFloatable arg'\n        stg_arg = case arg'' of\n                       StgApp v []        -> StgVarArg v\n                       StgConApp con [] _ -> StgVarArg (dataConWorkId con)\n                       StgLit lit         -> StgLitArg lit\n                       _                  -> pprPanic \"coreToStgArgs\" (ppr arg)\n\n        -- WARNING: what if we have an argument like (v `cast` co)\n        --          where 'co' changes the representation type?\n        --          (This really only happens if co is unsafe.)\n        -- Then all the getArgAmode stuff in CgBindery will set the\n        -- cg_rep of the CgIdInfo based on the type of v, rather\n        -- than the type of 'co'.\n        -- This matters particularly when the function is a primop\n        -- or foreign call.\n        -- Wanted: a better solution than this hacky warning\n    let\n        arg_ty = exprType arg\n        stg_arg_ty = stgArgType stg_arg\n        bad_args = (isUnliftedType arg_ty && not (isUnliftedType stg_arg_ty))\n                || (typePrimRep arg_ty /= typePrimRep stg_arg_ty)\n        -- In GHCi we coerce an argument of type BCO# (unlifted) to HValue (lifted),\n        -- and pass it to a function expecting an HValue (arg_ty).  This is ok because\n        -- we can treat an unlifted value as lifted.  But the other way round\n        -- we complain.\n        -- We also want to check if a pointer is cast to a non-ptr etc\n\n    WARN( bad_args, text \"Dangerous-looking argument. Probable cause: bad unsafeCoerce#\" $$ ppr arg )\n     return (stg_arg : stg_args, ticks ++ aticks)\n\n\n-- ---------------------------------------------------------------------------\n-- The magic for lets:\n-- ---------------------------------------------------------------------------\n\ncoreToStgLet\n         :: CoreBind     -- bindings\n         -> CoreExpr     -- body\n         -> CtsM StgExpr -- new let\n\ncoreToStgLet bind body = do\n    (bind2, body2)\n       <- do\n\n          ( bind2, env_ext)\n                <- vars_bind bind\n\n          -- Do the body\n          extendVarEnvCts env_ext $ do\n             body2 <- coreToStgExpr body\n\n             return (bind2, body2)\n\n        -- Compute the new let-expression\n    let\n        new_let | isJoinBind bind = StgLetNoEscape noExtSilent bind2 body2\n                | otherwise       = StgLet noExtSilent bind2 body2\n\n    return new_let\n  where\n    mk_binding binder rhs\n        = (binder, LetBound NestedLet (manifestArity rhs))\n\n    vars_bind :: CoreBind\n              -> CtsM (StgBinding,\n                       [(Id, HowBound)])  -- extension to environment\n\n    vars_bind (NonRec binder rhs) = do\n        rhs2 <- coreToStgRhs (binder,rhs)\n        let\n            env_ext_item = mk_binding binder rhs\n\n        return (StgNonRec binder rhs2, [env_ext_item])\n\n    vars_bind (Rec pairs)\n      =    let\n                binders = map fst pairs\n                env_ext = [ mk_binding b rhs\n                          | (b,rhs) <- pairs ]\n           in\n           extendVarEnvCts env_ext $ do\n              rhss2 <- mapM coreToStgRhs pairs\n              return (StgRec (binders `zip` rhss2), env_ext)\n\ncoreToStgRhs :: (Id,CoreExpr)\n             -> CtsM StgRhs\n\ncoreToStgRhs (bndr, rhs) = do\n    new_rhs <- coreToStgExpr rhs\n    return (mkStgRhs bndr new_rhs)\n\n-- Generate a top-level RHS. Any new cost centres generated for CAFs will be\n-- appended to `CollectedCCs` argument.\nmkTopStgRhs :: DynFlags -> Module -> CollectedCCs\n            -> Id -> StgExpr -> (StgRhs, CollectedCCs)\n\nmkTopStgRhs dflags this_mod ccs bndr rhs\n  | StgLam bndrs body <- rhs\n  = -- StgLam can't have empty arguments, so not CAF\n    ( StgRhsClosure noExtSilent\n                    dontCareCCS\n                    ReEntrant\n                    (toList bndrs) body\n    , ccs )\n\n  | StgConApp con args _ <- unticked_rhs\n  , -- Dynamic StgConApps are updatable\n    not (isDllConApp dflags this_mod con args)\n  = -- CorePrep does this right, but just to make sure\n    ASSERT2( not (isUnboxedTupleCon con || isUnboxedSumCon con)\n           , ppr bndr $$ ppr con $$ ppr args)\n    ( StgRhsCon dontCareCCS con args, ccs )\n\n  -- Otherwise it's a CAF, see Note [Cost-centre initialization plan].\n  | gopt Opt_AutoSccsOnIndividualCafs dflags\n  = ( StgRhsClosure noExtSilent\n                    caf_ccs\n                    upd_flag [] rhs\n    , collectCC caf_cc caf_ccs ccs )\n\n  | otherwise\n  = ( StgRhsClosure noExtSilent\n                    all_cafs_ccs\n                    upd_flag [] rhs\n    , ccs )\n\n  where\n    (_, unticked_rhs) = stripStgTicksTop (not . tickishIsCode) rhs\n\n    upd_flag | isUsedOnce (idDemandInfo bndr) = SingleEntry\n             | otherwise                      = Updatable\n\n    -- CAF cost centres generated for -fcaf-all\n    caf_cc = mkAutoCC bndr modl\n    caf_ccs = mkSingletonCCS caf_cc\n           -- careful: the binder might be :Main.main,\n           -- which doesn't belong to module mod_name.\n           -- bug #249, tests prof001, prof002\n    modl | Just m <- nameModule_maybe (idName bndr) = m\n         | otherwise = this_mod\n\n    -- default CAF cost centre\n    (_, all_cafs_ccs) = getAllCAFsCC this_mod\n\n-- Generate a non-top-level RHS. Cost-centre is always currentCCS,\n-- see Note [Cost-centre initialzation plan].\nmkStgRhs :: Id -> StgExpr -> StgRhs\nmkStgRhs bndr rhs\n  | StgLam bndrs body <- rhs\n  = StgRhsClosure noExtSilent\n                  currentCCS\n                  ReEntrant\n                  (toList bndrs) body\n\n  | isJoinId bndr -- must be a nullary join point\n  = ASSERT(idJoinArity bndr == 0)\n    StgRhsClosure noExtSilent\n                  currentCCS\n                  ReEntrant -- ignored for LNE\n                  [] rhs\n\n  | StgConApp con args _ <- unticked_rhs\n  = StgRhsCon currentCCS con args\n\n  | otherwise\n  = StgRhsClosure noExtSilent\n                  currentCCS\n                  upd_flag [] rhs\n  where\n    (_, unticked_rhs) = stripStgTicksTop (not . tickishIsCode) rhs\n\n    upd_flag | isUsedOnce (idDemandInfo bndr) = SingleEntry\n             | otherwise                      = Updatable\n\n  {-\n    SDM: disabled.  Eval/Apply can't handle functions with arity zero very\n    well; and making these into simple non-updatable thunks breaks other\n    assumptions (namely that they will be entered only once).\n\n    upd_flag | isPAP env rhs  = ReEntrant\n             | otherwise      = Updatable\n\n-- Detect thunks which will reduce immediately to PAPs, and make them\n-- non-updatable.  This has several advantages:\n--\n--         - the non-updatable thunk behaves exactly like the PAP,\n--\n--         - the thunk is more efficient to enter, because it is\n--           specialised to the task.\n--\n--         - we save one update frame, one stg_update_PAP, one update\n--           and lots of PAP_enters.\n--\n--         - in the case where the thunk is top-level, we save building\n--           a black hole and furthermore the thunk isn't considered to\n--           be a CAF any more, so it doesn't appear in any SRTs.\n--\n-- We do it here, because the arity information is accurate, and we need\n-- to do it before the SRT pass to save the SRT entries associated with\n-- any top-level PAPs.\n\nisPAP env (StgApp f args) = listLengthCmp args arity == LT -- idArity f > length args\n                              where\n                                 arity = stgArity f (lookupBinding env f)\nisPAP env _               = False\n\n-}\n\n{- ToDo:\n          upd = if isOnceDem dem\n                    then (if isNotTop toplev\n                            then SingleEntry    -- HA!  Paydirt for \"dem\"\n                            else\n                     (if debugIsOn then trace \"WARNING: SE CAFs unsupported, forcing UPD instead\" else id) $\n                     Updatable)\n                else Updatable\n        -- For now we forbid SingleEntry CAFs; they tickle the\n        -- ASSERT in rts/Storage.c line 215 at newCAF() re mut_link,\n        -- and I don't understand why.  There's only one SE_CAF (well,\n        -- only one that tickled a great gaping bug in an earlier attempt\n        -- at ClosureInfo.getEntryConvention) in the whole of nofib,\n        -- specifically Main.lvl6 in spectral/cryptarithm2.\n        -- So no great loss.  KSW 2000-07.\n-}\n\n-- ---------------------------------------------------------------------------\n-- A monad for the core-to-STG pass\n-- ---------------------------------------------------------------------------\n\n-- There's a lot of stuff to pass around, so we use this CtsM\n-- (\"core-to-STG monad\") monad to help.  All the stuff here is only passed\n-- *down*.\n\nnewtype CtsM a = CtsM\n    { unCtsM :: IdEnv HowBound\n             -> a\n    }\n\ndata HowBound\n  = ImportBound         -- Used only as a response to lookupBinding; never\n                        -- exists in the range of the (IdEnv HowBound)\n\n  | LetBound            -- A let(rec) in this module\n        LetInfo         -- Whether top level or nested\n        Arity           -- Its arity (local Ids don't have arity info at this point)\n\n  | LambdaBound         -- Used for both lambda and case\n  deriving (Eq)\n\ndata LetInfo\n  = TopLet              -- top level things\n  | NestedLet\n  deriving (Eq)\n\n-- For a let(rec)-bound variable, x, we record LiveInfo, the set of\n-- variables that are live if x is live.  This LiveInfo comprises\n--         (a) dynamic live variables (ones with a non-top-level binding)\n--         (b) static live variabes (CAFs or things that refer to CAFs)\n--\n-- For \"normal\" variables (a) is just x alone.  If x is a let-no-escaped\n-- variable then x is represented by a code pointer and a stack pointer\n-- (well, one for each stack).  So all of the variables needed in the\n-- execution of x are live if x is, and are therefore recorded in the\n-- LetBound constructor; x itself *is* included.\n--\n-- The set of dynamic live variables is guaranteed ot have no further\n-- let-no-escaped variables in it.\n\n-- The std monad functions:\n\ninitCts :: IdEnv HowBound -> CtsM a -> a\ninitCts env m = unCtsM m env\n\n\n\n{-# INLINE thenCts #-}\n{-# INLINE returnCts #-}\n\nreturnCts :: a -> CtsM a\nreturnCts e = CtsM $ \\_ -> e\n\nthenCts :: CtsM a -> (a -> CtsM b) -> CtsM b\nthenCts m k = CtsM $ \\env\n  -> unCtsM (k (unCtsM m env)) env\n\ninstance Functor CtsM where\n    fmap = liftM\n\ninstance Applicative CtsM where\n    pure = returnCts\n    (<*>) = ap\n\ninstance Monad CtsM where\n    (>>=)  = thenCts\n\n-- Functions specific to this monad:\n\nextendVarEnvCts :: [(Id, HowBound)] -> CtsM a -> CtsM a\nextendVarEnvCts ids_w_howbound expr\n   =    CtsM $   \\env\n   -> unCtsM expr (extendVarEnvList env ids_w_howbound)\n\nlookupVarCts :: Id -> CtsM HowBound\nlookupVarCts v = CtsM $ \\env -> lookupBinding env v\n\nlookupBinding :: IdEnv HowBound -> Id -> HowBound\nlookupBinding env v = case lookupVarEnv env v of\n                        Just xx -> xx\n                        Nothing -> ASSERT2( isGlobalId v, ppr v ) ImportBound\n\ngetAllCAFsCC :: Module -> (CostCentre, CostCentreStack)\ngetAllCAFsCC this_mod =\n    let\n      span = mkGeneralSrcSpan (mkFastString \"<entire-module>\") -- XXX do better\n      all_cafs_cc  = mkAllCafsCC this_mod span\n      all_cafs_ccs = mkSingletonCCS all_cafs_cc\n    in\n      (all_cafs_cc, all_cafs_ccs)\n\n-- Misc.\n\nfilterStgBinders :: [Var] -> [Var]\nfilterStgBinders bndrs = filter isId bndrs\n\nmyCollectBinders :: Expr Var -> ([Var], Expr Var)\nmyCollectBinders expr\n  = go [] expr\n  where\n    go bs (Lam b e)          = go (b:bs) e\n    go bs (Cast e _)         = go bs e\n    go bs e                  = (reverse bs, e)\n\n-- | Precondition: argument expression is an 'App', and there is a 'Var' at the\n-- head of the 'App' chain.\nmyCollectArgs :: CoreExpr -> (Id, [CoreArg], [Tickish Id])\nmyCollectArgs expr\n  = go expr [] []\n  where\n    go (Var v)          as ts = (v, as, ts)\n    go (App f a)        as ts = go f (a:as) ts\n    go (Tick t e)       as ts = ASSERT( all isTypeArg as )\n                                go e as (t:ts) -- ticks can appear in type apps\n    go (Cast e _)       as ts = go e as ts\n    go (Lam b e)        as ts\n       | isTyVar b            = go e as ts -- Note [Collect args]\n    go _                _  _  = pprPanic \"CoreToStg.myCollectArgs\" (ppr expr)\n\n-- Note [Collect args]\n-- ~~~~~~~~~~~~~~~~~~~\n--\n-- This big-lambda case occurred following a rather obscure eta expansion.\n-- It all seems a bit yukky to me.\n\nstgArity :: Id -> HowBound -> Arity\nstgArity _ (LetBound _ arity) = arity\nstgArity f ImportBound        = idArity f\nstgArity _ LambdaBound        = 0\n", "num_lines": 936}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Free variable analysis on STG terms.\nmodule StgFVs (\n    annTopBindingsFreeVars,\n    annBindingFreeVars\n  ) where\n\nimport GhcPrelude\n\nimport StgSyn\nimport Id\nimport VarSet\nimport CoreSyn    ( Tickish(Breakpoint) )\nimport Outputable\nimport Util\n\nimport Data.Maybe ( mapMaybe )\n\nnewtype Env\n  = Env\n  { locals :: IdSet\n  }\n\nemptyEnv :: Env\nemptyEnv = Env emptyVarSet\n\naddLocals :: [Id] -> Env -> Env\naddLocals bndrs env\n  = env { locals = extendVarSetList (locals env) bndrs }\n\n-- | Annotates a top-level STG binding group with its free variables.\nannTopBindingsFreeVars :: [StgTopBinding] -> [CgStgTopBinding]\nannTopBindingsFreeVars = map go\n  where\n    go (StgTopStringLit id bs) = StgTopStringLit id bs\n    go (StgTopLifted bind)\n      = StgTopLifted (annBindingFreeVars bind)\n\n-- | Annotates an STG binding with its free variables.\nannBindingFreeVars :: StgBinding -> CgStgBinding\nannBindingFreeVars = fst . binding emptyEnv emptyDVarSet\n\nboundIds :: StgBinding -> [Id]\nboundIds (StgNonRec b _) = [b]\nboundIds (StgRec pairs)  = map fst pairs\n\n-- Note [Tracking local binders]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- 'locals' contains non-toplevel, non-imported binders.\n-- We maintain the set in 'expr', 'alt' and 'rhs', which are the only\n-- places where new local binders are introduced.\n-- Why do it there rather than in 'binding'? Two reasons:\n--\n--   1. We call 'binding' from 'annTopBindingsFreeVars', which would\n--      add top-level bindings to the 'locals' set.\n--   2. In the let(-no-escape) case, we need to extend the environment\n--      prior to analysing the body, but we also need the fvs from the\n--      body to analyse the RHSs. No way to do this without some\n--      knot-tying.\n\n-- | This makes sure that only local, non-global free vars make it into the set.\nmkFreeVarSet :: Env -> [Id] -> DIdSet\nmkFreeVarSet env = mkDVarSet . filter (`elemVarSet` locals env)\n\nargs :: Env -> [StgArg] -> DIdSet\nargs env = mkFreeVarSet env . mapMaybe f\n  where\n    f (StgVarArg occ) = Just occ\n    f _               = Nothing\n\nbinding :: Env -> DIdSet -> StgBinding -> (CgStgBinding, DIdSet)\nbinding env body_fv (StgNonRec bndr r) = (StgNonRec bndr r', fvs)\n  where\n    -- See Note [Tacking local binders]\n    (r', rhs_fvs) = rhs env r\n    fvs = delDVarSet body_fv bndr `unionDVarSet` rhs_fvs\nbinding env body_fv (StgRec pairs) = (StgRec pairs', fvs)\n  where\n    -- See Note [Tacking local binders]\n    bndrs = map fst pairs\n    (rhss, rhs_fvss) = mapAndUnzip (rhs env . snd) pairs\n    pairs' = zip bndrs rhss\n    fvs = delDVarSetList (unionDVarSets (body_fv:rhs_fvss)) bndrs\n\nexpr :: Env -> StgExpr -> (CgStgExpr, DIdSet)\nexpr env = go\n  where\n    go (StgApp occ as)\n      = (StgApp occ as, unionDVarSet (args env as) (mkFreeVarSet env [occ]))\n    go (StgLit lit) = (StgLit lit, emptyDVarSet)\n    go (StgConApp dc as tys) = (StgConApp dc as tys, args env as)\n    go (StgOpApp op as ty) = (StgOpApp op as ty, args env as)\n    go StgLam{} = pprPanic \"StgFVs: StgLam\" empty\n    go (StgCase scrut bndr ty alts) = (StgCase scrut' bndr ty alts', fvs)\n      where\n        (scrut', scrut_fvs) = go scrut\n        -- See Note [Tacking local binders]\n        (alts', alt_fvss) = mapAndUnzip (alt (addLocals [bndr] env)) alts\n        alt_fvs = unionDVarSets alt_fvss\n        fvs = delDVarSet (unionDVarSet scrut_fvs alt_fvs) bndr\n    go (StgLet ext bind body) = go_bind (StgLet ext) bind body\n    go (StgLetNoEscape ext bind body) = go_bind (StgLetNoEscape ext) bind body\n    go (StgTick tick e) = (StgTick tick e', fvs')\n      where\n        (e', fvs) = go e\n        fvs' = unionDVarSet (tickish tick) fvs\n        tickish (Breakpoint _ ids) = mkDVarSet ids\n        tickish _                  = emptyDVarSet\n\n    go_bind dc bind body = (dc bind' body', fvs)\n      where\n        -- See Note [Tacking local binders]\n        env' = addLocals (boundIds bind) env\n        (body', body_fvs) = expr env' body\n        (bind', fvs) = binding env' body_fvs bind\n\nrhs :: Env -> StgRhs -> (CgStgRhs, DIdSet)\nrhs env (StgRhsClosure _ ccs uf bndrs body)\n  = (StgRhsClosure fvs ccs uf bndrs body', fvs)\n  where\n    -- See Note [Tacking local binders]\n    (body', body_fvs) = expr (addLocals bndrs env) body\n    fvs = delDVarSetList body_fvs bndrs\nrhs env (StgRhsCon ccs dc as) = (StgRhsCon ccs dc as, args env as)\n\nalt :: Env -> StgAlt -> (CgStgAlt, DIdSet)\nalt env (con, bndrs, e) = ((con, bndrs, e'), fvs)\n  where\n    -- See Note [Tacking local binders]\n    (e', rhs_fvs) = expr (addLocals bndrs env) e\n    fvs = delDVarSetList rhs_fvs bndrs\n", "num_lines": 131}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- |\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\nA lint pass to check basic STG invariants:\n\n- Variables should be defined before used.\n\n- Let bindings should not have unboxed types (unboxed bindings should only\n  appear in case), except when they're join points (see Note [CoreSyn let/app\n  invariant] and #14117).\n\n- If linting after unarisation, invariants listed in Note [Post-unarisation\n  invariants].\n\nBecause we don't have types and coercions in STG we can't really check types\nhere.\n\nSome history:\n\nStgLint used to check types, but it never worked and so it was disabled in 2000\nwith this note:\n\n    WARNING:\n    ~~~~~~~~\n\n    This module has suffered bit-rot; it is likely to yield lint errors\n    for Stg code that is currently perfectly acceptable for code\n    generation.  Solution: don't use it!  (KSW 2000-05).\n\nSince then there were some attempts at enabling it again, as summarised in\n#14787. It's finally decided that we remove all type checking and only look for\nbasic properties listed above.\n-}\n\n{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, TypeFamilies #-}\n\nmodule StgLint ( lintStgTopBindings ) where\n\nimport GhcPrelude\n\nimport StgSyn\n\nimport DynFlags\nimport Bag              ( Bag, emptyBag, isEmptyBag, snocBag, bagToList )\nimport BasicTypes       ( TopLevelFlag(..), isTopLevel )\nimport CostCentre       ( isCurrentCCS )\nimport Id               ( Id, idType, isJoinId, idName )\nimport VarSet\nimport DataCon\nimport CoreSyn          ( AltCon(..) )\nimport Name             ( getSrcLoc, nameIsLocalOrFrom )\nimport ErrUtils         ( MsgDoc, Severity(..), mkLocMessage )\nimport Type\nimport RepType\nimport SrcLoc\nimport Outputable\nimport Module           ( Module )\nimport qualified ErrUtils as Err\nimport Control.Applicative ((<|>))\nimport Control.Monad\n\nlintStgTopBindings :: forall a . (OutputablePass a, BinderP a ~ Id)\n                   => DynFlags\n                   -> Module -- ^ module being compiled\n                   -> Bool   -- ^ have we run Unarise yet?\n                   -> String -- ^ who produced the STG?\n                   -> [GenStgTopBinding a]\n                   -> IO ()\n\nlintStgTopBindings dflags this_mod unarised whodunnit binds\n  = {-# SCC \"StgLint\" #-}\n    case initL this_mod unarised top_level_binds (lint_binds binds) of\n      Nothing  ->\n        return ()\n      Just msg -> do\n        putLogMsg dflags NoReason Err.SevDump noSrcSpan\n          (defaultDumpStyle dflags)\n          (vcat [ text \"*** Stg Lint ErrMsgs: in\" <+>\n                        text whodunnit <+> text \"***\",\n                  msg,\n                  text \"*** Offending Program ***\",\n                  pprGenStgTopBindings binds,\n                  text \"*** End of Offense ***\"])\n        Err.ghcExit dflags 1\n  where\n    -- Bring all top-level binds into scope because CoreToStg does not generate\n    -- bindings in dependency order (so we may see a use before its definition).\n    top_level_binds = mkVarSet (bindersOfTopBinds binds)\n\n    lint_binds :: [GenStgTopBinding a] -> LintM ()\n\n    lint_binds [] = return ()\n    lint_binds (bind:binds) = do\n        binders <- lint_bind bind\n        addInScopeVars binders $\n            lint_binds binds\n\n    lint_bind (StgTopLifted bind) = lintStgBinds TopLevel bind\n    lint_bind (StgTopStringLit v _) = return [v]\n\nlintStgArg :: StgArg -> LintM ()\nlintStgArg (StgLitArg _) = return ()\nlintStgArg (StgVarArg v) = lintStgVar v\n\nlintStgVar :: Id -> LintM ()\nlintStgVar id = checkInScope id\n\nlintStgBinds\n    :: (OutputablePass a, BinderP a ~ Id)\n    => TopLevelFlag -> GenStgBinding a -> LintM [Id] -- Returns the binders\nlintStgBinds top_lvl (StgNonRec binder rhs) = do\n    lint_binds_help top_lvl (binder,rhs)\n    return [binder]\n\nlintStgBinds top_lvl (StgRec pairs)\n  = addInScopeVars binders $ do\n        mapM_ (lint_binds_help top_lvl) pairs\n        return binders\n  where\n    binders = [b | (b,_) <- pairs]\n\nlint_binds_help\n    :: (OutputablePass a, BinderP a ~ Id)\n    => TopLevelFlag\n    -> (Id, GenStgRhs a)\n    -> LintM ()\nlint_binds_help top_lvl (binder, rhs)\n  = addLoc (RhsOf binder) $ do\n        when (isTopLevel top_lvl) (checkNoCurrentCCS rhs)\n        lintStgRhs rhs\n        -- Check binder doesn't have unlifted type or it's a join point\n        checkL (isJoinId binder || not (isUnliftedType (idType binder)))\n               (mkUnliftedTyMsg binder rhs)\n\n-- | Top-level bindings can't inherit the cost centre stack from their\n-- (static) allocation site.\ncheckNoCurrentCCS\n    :: (OutputablePass a, BinderP a ~ Id)\n    => GenStgRhs a\n    -> LintM ()\ncheckNoCurrentCCS rhs@(StgRhsClosure _ ccs _ _ _)\n  | isCurrentCCS ccs\n  = addErrL (text \"Top-level StgRhsClosure with CurrentCCS\" $$ ppr rhs)\ncheckNoCurrentCCS rhs@(StgRhsCon ccs _ _)\n  | isCurrentCCS ccs\n  = addErrL (text \"Top-level StgRhsCon with CurrentCCS\" $$ ppr rhs)\ncheckNoCurrentCCS _\n  = return ()\n\nlintStgRhs :: (OutputablePass a, BinderP a ~ Id) => GenStgRhs a -> LintM ()\n\nlintStgRhs (StgRhsClosure _ _ _ [] expr)\n  = lintStgExpr expr\n\nlintStgRhs (StgRhsClosure _ _ _ binders expr)\n  = addLoc (LambdaBodyOf binders) $\n      addInScopeVars binders $\n        lintStgExpr expr\n\nlintStgRhs rhs@(StgRhsCon _ con args) = do\n    when (isUnboxedTupleCon con || isUnboxedSumCon con) $\n      addErrL (text \"StgRhsCon is an unboxed tuple or sum application\" $$\n               ppr rhs)\n    mapM_ lintStgArg args\n    mapM_ checkPostUnariseConArg args\n\nlintStgExpr :: (OutputablePass a, BinderP a ~ Id) => GenStgExpr a -> LintM ()\n\nlintStgExpr (StgLit _) = return ()\n\nlintStgExpr (StgApp fun args) = do\n    lintStgVar fun\n    mapM_ lintStgArg args\n\nlintStgExpr app@(StgConApp con args _arg_tys) = do\n    -- unboxed sums should vanish during unarise\n    lf <- getLintFlags\n    when (lf_unarised lf && isUnboxedSumCon con) $\n      addErrL (text \"Unboxed sum after unarise:\" $$\n               ppr app)\n    mapM_ lintStgArg args\n    mapM_ checkPostUnariseConArg args\n\nlintStgExpr (StgOpApp _ args _) =\n    mapM_ lintStgArg args\n\nlintStgExpr lam@(StgLam _ _) =\n    addErrL (text \"Unexpected StgLam\" <+> ppr lam)\n\nlintStgExpr (StgLet _ binds body) = do\n    binders <- lintStgBinds NotTopLevel binds\n    addLoc (BodyOfLetRec binders) $\n      addInScopeVars binders $\n        lintStgExpr body\n\nlintStgExpr (StgLetNoEscape _ binds body) = do\n    binders <- lintStgBinds NotTopLevel binds\n    addLoc (BodyOfLetRec binders) $\n      addInScopeVars binders $\n        lintStgExpr body\n\nlintStgExpr (StgTick _ expr) = lintStgExpr expr\n\nlintStgExpr (StgCase scrut bndr alts_type alts) = do\n    lintStgExpr scrut\n\n    lf <- getLintFlags\n    let in_scope = stgCaseBndrInScope alts_type (lf_unarised lf)\n\n    addInScopeVars [bndr | in_scope] (mapM_ lintAlt alts)\n\nlintAlt\n    :: (OutputablePass a, BinderP a ~ Id)\n    => (AltCon, [Id], GenStgExpr a) -> LintM ()\n\nlintAlt (DEFAULT, _, rhs) =\n    lintStgExpr rhs\n\nlintAlt (LitAlt _, _, rhs) =\n    lintStgExpr rhs\n\nlintAlt (DataAlt _, bndrs, rhs) = do\n    mapM_ checkPostUnariseBndr bndrs\n    addInScopeVars bndrs (lintStgExpr rhs)\n\n{-\n************************************************************************\n*                                                                      *\nUtilities\n*                                                                      *\n************************************************************************\n-}\n\nbindersOf :: BinderP a ~ Id => GenStgBinding a -> [Id]\nbindersOf (StgNonRec binder _) = [binder]\nbindersOf (StgRec pairs)       = [binder | (binder, _) <- pairs]\n\nbindersOfTop :: BinderP a ~ Id => GenStgTopBinding a -> [Id]\nbindersOfTop (StgTopLifted bind) = bindersOf bind\nbindersOfTop (StgTopStringLit binder _) = [binder]\n\nbindersOfTopBinds :: BinderP a ~ Id => [GenStgTopBinding a] -> [Id]\nbindersOfTopBinds = foldr ((++) . bindersOfTop) []\n\n{-\n************************************************************************\n*                                                                      *\nThe Lint monad\n*                                                                      *\n************************************************************************\n-}\n\nnewtype LintM a = LintM\n    { unLintM :: Module\n              -> LintFlags\n              -> [LintLocInfo]     -- Locations\n              -> IdSet             -- Local vars in scope\n              -> Bag MsgDoc        -- Error messages so far\n              -> (a, Bag MsgDoc)   -- Result and error messages (if any)\n    }\n\ndata LintFlags = LintFlags { lf_unarised :: !Bool\n                             -- ^ have we run the unariser yet?\n                           }\n\ndata LintLocInfo\n  = RhsOf Id            -- The variable bound\n  | LambdaBodyOf [Id]   -- The lambda-binder\n  | BodyOfLetRec [Id]   -- One of the binders\n\ndumpLoc :: LintLocInfo -> (SrcSpan, SDoc)\ndumpLoc (RhsOf v) =\n  (srcLocSpan (getSrcLoc v), text \" [RHS of \" <> pp_binders [v] <> char ']' )\ndumpLoc (LambdaBodyOf bs) =\n  (srcLocSpan (getSrcLoc (head bs)), text \" [in body of lambda with binders \" <> pp_binders bs <> char ']' )\n\ndumpLoc (BodyOfLetRec bs) =\n  (srcLocSpan (getSrcLoc (head bs)), text \" [in body of letrec with binders \" <> pp_binders bs <> char ']' )\n\n\npp_binders :: [Id] -> SDoc\npp_binders bs\n  = sep (punctuate comma (map pp_binder bs))\n  where\n    pp_binder b\n      = hsep [ppr b, dcolon, ppr (idType b)]\n\ninitL :: Module -> Bool -> IdSet -> LintM a -> Maybe MsgDoc\ninitL this_mod unarised locals (LintM m) = do\n  let (_, errs) = m this_mod (LintFlags unarised) [] locals emptyBag\n  if isEmptyBag errs then\n      Nothing\n  else\n      Just (vcat (punctuate blankLine (bagToList errs)))\n\ninstance Functor LintM where\n      fmap = liftM\n\ninstance Applicative LintM where\n      pure a = LintM $ \\_mod _lf _loc _scope errs -> (a, errs)\n      (<*>) = ap\n      (*>)  = thenL_\n\ninstance Monad LintM where\n    (>>=) = thenL\n    (>>)  = (*>)\n\nthenL :: LintM a -> (a -> LintM b) -> LintM b\nthenL m k = LintM $ \\mod lf loc scope errs\n  -> case unLintM m mod lf loc scope errs of\n      (r, errs') -> unLintM (k r) mod lf loc scope errs'\n\nthenL_ :: LintM a -> LintM b -> LintM b\nthenL_ m k = LintM $ \\mod lf loc scope errs\n  -> case unLintM m mod lf loc scope errs of\n      (_, errs') -> unLintM k mod lf loc scope errs'\n\ncheckL :: Bool -> MsgDoc -> LintM ()\ncheckL True  _   = return ()\ncheckL False msg = addErrL msg\n\n-- Case alts shouldn't have unboxed sum, unboxed tuple, or void binders.\ncheckPostUnariseBndr :: Id -> LintM ()\ncheckPostUnariseBndr bndr = do\n    lf <- getLintFlags\n    when (lf_unarised lf) $\n      forM_ (checkPostUnariseId bndr) $ \\unexpected ->\n        addErrL $\n          text \"After unarisation, binder \" <>\n          ppr bndr <> text \" has \" <> text unexpected <> text \" type \" <>\n          ppr (idType bndr)\n\n-- Arguments shouldn't have sum, tuple, or void types.\ncheckPostUnariseConArg :: StgArg -> LintM ()\ncheckPostUnariseConArg arg = case arg of\n    StgLitArg _ ->\n      return ()\n    StgVarArg id -> do\n      lf <- getLintFlags\n      when (lf_unarised lf) $\n        forM_ (checkPostUnariseId id) $ \\unexpected ->\n          addErrL $\n            text \"After unarisation, arg \" <>\n            ppr id <> text \" has \" <> text unexpected <> text \" type \" <>\n            ppr (idType id)\n\n-- Post-unarisation args and case alt binders should not have unboxed tuple,\n-- unboxed sum, or void types. Return what the binder is if it is one of these.\ncheckPostUnariseId :: Id -> Maybe String\ncheckPostUnariseId id =\n    let\n      id_ty = idType id\n      is_sum, is_tuple, is_void :: Maybe String\n      is_sum = guard (isUnboxedSumType id_ty) >> return \"unboxed sum\"\n      is_tuple = guard (isUnboxedTupleType id_ty) >> return \"unboxed tuple\"\n      is_void = guard (isVoidTy id_ty) >> return \"void\"\n    in\n      is_sum <|> is_tuple <|> is_void\n\naddErrL :: MsgDoc -> LintM ()\naddErrL msg = LintM $ \\_mod _lf loc _scope errs -> ((), addErr errs msg loc)\n\naddErr :: Bag MsgDoc -> MsgDoc -> [LintLocInfo] -> Bag MsgDoc\naddErr errs_so_far msg locs\n  = errs_so_far `snocBag` mk_msg locs\n  where\n    mk_msg (loc:_) = let (l,hdr) = dumpLoc loc\n                     in  mkLocMessage SevWarning l (hdr $$ msg)\n    mk_msg []      = msg\n\naddLoc :: LintLocInfo -> LintM a -> LintM a\naddLoc extra_loc m = LintM $ \\mod lf loc scope errs\n   -> unLintM m mod lf (extra_loc:loc) scope errs\n\naddInScopeVars :: [Id] -> LintM a -> LintM a\naddInScopeVars ids m = LintM $ \\mod lf loc scope errs\n -> let\n        new_set = mkVarSet ids\n    in unLintM m mod lf loc (scope `unionVarSet` new_set) errs\n\ngetLintFlags :: LintM LintFlags\ngetLintFlags = LintM $ \\_mod lf _loc _scope errs -> (lf, errs)\n\ncheckInScope :: Id -> LintM ()\ncheckInScope id = LintM $ \\mod _lf loc scope errs\n -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then\n        ((), addErr errs (hsep [ppr id, dcolon, ppr (idType id),\n                                text \"is out of scope\"]) loc)\n    else\n        ((), errs)\n\nmkUnliftedTyMsg :: OutputablePass a => Id -> GenStgRhs a -> SDoc\nmkUnliftedTyMsg binder rhs\n  = (text \"Let(rec) binder\" <+> quotes (ppr binder) <+>\n     text \"has unlifted type\" <+> quotes (ppr (idType binder)))\n    $$\n    (text \"RHS:\" <+> ppr rhs)\n", "num_lines": 398}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule StgSubst where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Id\nimport VarEnv\nimport Control.Monad.Trans.State.Strict\nimport Outputable\nimport Util\n\n-- | A renaming substitution from 'Id's to 'Id's. Like 'RnEnv2', but not\n-- maintaining pairs of substitutions. Like @\"CoreSubst\".'CoreSubst.Subst'@, but\n-- with the domain being 'Id's instead of entire 'CoreExpr'.\ndata Subst = Subst InScopeSet IdSubstEnv\n\ntype IdSubstEnv = IdEnv Id\n\n-- | @emptySubst = 'mkEmptySubst' 'emptyInScopeSet'@\nemptySubst :: Subst\nemptySubst = mkEmptySubst emptyInScopeSet\n\n-- | Constructs a new 'Subst' assuming the variables in the given 'InScopeSet'\n-- are in scope.\nmkEmptySubst :: InScopeSet -> Subst\nmkEmptySubst in_scope = Subst in_scope emptyVarEnv\n\n-- | Substitutes an 'Id' for another one according to the 'Subst' given in a way\n-- that avoids shadowing the 'InScopeSet', returning the result and an updated\n-- 'Subst' that should be used by subsequent substitutions.\nsubstBndr :: Id -> Subst -> (Id, Subst)\nsubstBndr id (Subst in_scope env)\n  = (new_id, Subst new_in_scope new_env)\n  where\n    new_id = uniqAway in_scope id\n    no_change = new_id == id -- in case nothing shadowed\n    new_in_scope = in_scope `extendInScopeSet` new_id\n    new_env\n      | no_change = delVarEnv env id\n      | otherwise = extendVarEnv env id new_id\n\n-- | @substBndrs = runState . traverse (state . substBndr)@\nsubstBndrs :: Traversable f => f Id -> Subst -> (f Id, Subst)\nsubstBndrs = runState . traverse (state . substBndr)\n\n-- | Substitutes an occurrence of an identifier for its counterpart recorded\n-- in the 'Subst'.\nlookupIdSubst :: HasCallStack => Id -> Subst -> Id\nlookupIdSubst id (Subst in_scope env)\n  | not (isLocalId id) = id\n  | Just id' <- lookupVarEnv env id = id'\n  | Just id' <- lookupInScope in_scope id = id'\n  | otherwise = WARN( True, text \"StgSubst.lookupIdSubst\" <+> ppr id $$ ppr in_scope)\n                id\n\n-- | Substitutes an occurrence of an identifier for its counterpart recorded\n-- in the 'Subst'. Does not generate a debug warning if the identifier to\n-- to substitute wasn't in scope.\nnoWarnLookupIdSubst :: HasCallStack => Id -> Subst -> Id\nnoWarnLookupIdSubst id (Subst in_scope env)\n  | not (isLocalId id) = id\n  | Just id' <- lookupVarEnv env id = id'\n  | Just id' <- lookupInScope in_scope id = id'\n  | otherwise = id\n\n-- | Add the 'Id' to the in-scope set and remove any existing substitutions for\n-- it.\nextendInScope :: Id -> Subst -> Subst\nextendInScope id (Subst in_scope env) = Subst (in_scope `extendInScopeSet` id) env\n\n-- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the\n-- in-scope set is such that TyCORep Note [The substitution invariant]\n-- holds after extending the substitution like this.\nextendSubst :: Id -> Id -> Subst -> Subst\nextendSubst id new_id (Subst in_scope env)\n  = ASSERT2( new_id `elemInScopeSet` in_scope, ppr id <+> ppr new_id $$ ppr in_scope )\n    Subst in_scope (extendVarEnv env id new_id)\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[StgSyn]{Shared term graph (STG) syntax for spineless-tagless code generation}\n\nThis data type represents programs just before code generation (conversion to\n@Cmm@): basically, what we have is a stylised form of @CoreSyntax@, the style\nbeing one that happens to be ideally suited to spineless tagless code\ngeneration.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE ConstraintKinds #-}\n\nmodule StgSyn (\n        StgArg(..),\n\n        GenStgTopBinding(..), GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),\n        GenStgAlt, AltType(..),\n\n        StgPass(..), BinderP, XRhsClosure, XLet, XLetNoEscape,\n        NoExtSilent, noExtSilent,\n        OutputablePass,\n\n        UpdateFlag(..), isUpdatable,\n\n        -- a set of synonyms for the vanilla parameterisation\n        StgTopBinding, StgBinding, StgExpr, StgRhs, StgAlt,\n\n        -- a set of synonyms for the code gen parameterisation\n        CgStgTopBinding, CgStgBinding, CgStgExpr, CgStgRhs, CgStgAlt,\n\n        -- a set of synonyms for the lambda lifting parameterisation\n        LlStgTopBinding, LlStgBinding, LlStgExpr, LlStgRhs, LlStgAlt,\n\n        -- a set of synonyms to distinguish in- and out variants\n        InStgArg,  InStgTopBinding,  InStgBinding,  InStgExpr,  InStgRhs,  InStgAlt,\n        OutStgArg, OutStgTopBinding, OutStgBinding, OutStgExpr, OutStgRhs, OutStgAlt,\n\n        -- StgOp\n        StgOp(..),\n\n        -- utils\n        topStgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,\n        isDllConApp,\n        stgArgType,\n        stripStgTicksTop,\n        stgCaseBndrInScope,\n\n        pprStgBinding, pprGenStgTopBindings, pprStgTopBindings\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn     ( AltCon, Tickish )\nimport CostCentre  ( CostCentreStack )\nimport Data.ByteString ( ByteString )\nimport Data.Data   ( Data )\nimport Data.List   ( intersperse )\nimport DataCon\nimport DynFlags\nimport FastString\nimport ForeignCall ( ForeignCall )\nimport Id\nimport IdInfo      ( mayHaveCafRefs )\nimport VarSet\nimport Literal     ( Literal, literalType )\nimport Module      ( Module )\nimport Outputable\nimport Packages    ( isDllName )\nimport Platform\nimport PprCore     ( {- instances -} )\nimport PrimOp      ( PrimOp, PrimCall )\nimport TyCon       ( PrimRep(..), TyCon )\nimport Type        ( Type )\nimport RepType     ( typePrimRep1 )\nimport Unique      ( Unique )\nimport Util\n\nimport Data.List.NonEmpty ( NonEmpty, toList )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{@GenStgBinding@}\n*                                                                      *\n************************************************************************\n\nAs usual, expressions are interesting; other things are boring. Here\nare the boring things [except note the @GenStgRhs@], parameterised\nwith respect to binder and occurrence information (just as in\n@CoreSyn@):\n-}\n\n-- | A top-level binding.\ndata GenStgTopBinding pass\n-- See Note [CoreSyn top-level string literals]\n  = StgTopLifted (GenStgBinding pass)\n  | StgTopStringLit Id ByteString\n\ndata GenStgBinding pass\n  = StgNonRec (BinderP pass) (GenStgRhs pass)\n  | StgRec    [(BinderP pass, GenStgRhs pass)]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{@StgArg@}\n*                                                                      *\n************************************************************************\n-}\n\ndata StgArg\n  = StgVarArg  Id\n  | StgLitArg  Literal\n\n-- | Does this constructor application refer to\n-- anything in a different *Windows* DLL?\n-- If so, we can't allocate it statically\nisDllConApp :: DynFlags -> Module -> DataCon -> [StgArg] -> Bool\nisDllConApp dflags this_mod con args\n | platformOS (targetPlatform dflags) == OSMinGW32\n    = isDllName dflags this_mod (dataConName con) || any is_dll_arg args\n | otherwise = False\n  where\n    -- NB: typePrimRep1 is legit because any free variables won't have\n    -- unlifted type (there are no unlifted things at top level)\n    is_dll_arg :: StgArg -> Bool\n    is_dll_arg (StgVarArg v) =  isAddrRep (typePrimRep1 (idType v))\n                             && isDllName dflags this_mod (idName v)\n    is_dll_arg _             = False\n\n-- True of machine addresses; these are the things that don't\n-- work across DLLs. The key point here is that VoidRep comes\n-- out False, so that a top level nullary GADT constructor is\n-- False for isDllConApp\n--    data T a where\n--      T1 :: T Int\n-- gives\n--    T1 :: forall a. (a~Int) -> T a\n-- and hence the top-level binding\n--    $WT1 :: T Int\n--    $WT1 = T1 Int (Coercion (Refl Int))\n-- The coercion argument here gets VoidRep\nisAddrRep :: PrimRep -> Bool\nisAddrRep AddrRep     = True\nisAddrRep LiftedRep   = True\nisAddrRep UnliftedRep = True\nisAddrRep _           = False\n\n-- | Type of an @StgArg@\n--\n-- Very half baked because we have lost the type arguments.\nstgArgType :: StgArg -> Type\nstgArgType (StgVarArg v)   = idType v\nstgArgType (StgLitArg lit) = literalType lit\n\n\n-- | Strip ticks of a given type from an STG expression\nstripStgTicksTop :: (Tickish Id -> Bool) -> GenStgExpr p -> ([Tickish Id], GenStgExpr p)\nstripStgTicksTop p = go []\n   where go ts (StgTick t e) | p t = go (t:ts) e\n         go ts other               = (reverse ts, other)\n\n-- | Given an alt type and whether the program is unarised, return whether the\n-- case binder is in scope.\n--\n-- Case binders of unboxed tuple or unboxed sum type always dead after the\n-- unariser has run. See Note [Post-unarisation invariants].\nstgCaseBndrInScope :: AltType -> Bool {- ^ unarised? -} -> Bool\nstgCaseBndrInScope alt_ty unarised =\n    case alt_ty of\n      AlgAlt _      -> True\n      PrimAlt _     -> True\n      MultiValAlt _ -> not unarised\n      PolyAlt       -> True\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{STG expressions}\n*                                                                      *\n************************************************************************\n\nThe @GenStgExpr@ data type is parameterised on binder and occurrence\ninfo, as before.\n\n************************************************************************\n*                                                                      *\n\\subsubsection{@GenStgExpr@ application}\n*                                                                      *\n************************************************************************\n\nAn application is of a function to a list of atoms [not expressions].\nOperationally, we want to push the arguments on the stack and call the\nfunction. (If the arguments were expressions, we would have to build\ntheir closures first.)\n\nThere is no constructor for a lone variable; it would appear as\n@StgApp var []@.\n-}\n\ndata GenStgExpr pass\n  = StgApp\n        Id       -- function\n        [StgArg] -- arguments; may be empty\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{@StgConApp@ and @StgPrimApp@---saturated applications}\n*                                                                      *\n************************************************************************\n\nThere are specialised forms of application, for constructors,\nprimitives, and literals.\n-}\n\n  | StgLit      Literal\n\n        -- StgConApp is vital for returning unboxed tuples or sums\n        -- which can't be let-bound first\n  | StgConApp   DataCon\n                [StgArg] -- Saturated\n                [Type]   -- See Note [Types in StgConApp] in UnariseStg\n\n  | StgOpApp    StgOp    -- Primitive op or foreign call\n                [StgArg] -- Saturated.\n                Type     -- Result type\n                         -- We need to know this so that we can\n                         -- assign result registers\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{@StgLam@}\n*                                                                      *\n************************************************************************\n\nStgLam is used *only* during CoreToStg's work. Before CoreToStg has\nfinished it encodes (\\x -> e) as (let f = \\x -> e in f)\nTODO: Encode this via an extension to GenStgExpr \u00c3\u00a0 la TTG.\n-}\n\n  | StgLam\n        (NonEmpty (BinderP pass))\n        StgExpr    -- Body of lambda\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{@GenStgExpr@: case-expressions}\n*                                                                      *\n************************************************************************\n\nThis has the same boxed/unboxed business as Core case expressions.\n-}\n\n  | StgCase\n        (GenStgExpr pass) -- the thing to examine\n        (BinderP pass) -- binds the result of evaluating the scrutinee\n        AltType\n        [GenStgAlt pass]\n                    -- The DEFAULT case is always *first*\n                    -- if it is there at all\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{@GenStgExpr@: @let(rec)@-expressions}\n*                                                                      *\n************************************************************************\n\nThe various forms of let(rec)-expression encode most of the\ninteresting things we want to do.\n\\begin{enumerate}\n\\item\n\\begin{verbatim}\nlet-closure x = [free-vars] [args] expr\nin e\n\\end{verbatim}\nis equivalent to\n\\begin{verbatim}\nlet x = (\\free-vars -> \\args -> expr) free-vars\n\\end{verbatim}\n\\tr{args} may be empty (and is for most closures).  It isn't under\ncircumstances like this:\n\\begin{verbatim}\nlet x = (\\y -> y+z)\n\\end{verbatim}\nThis gets mangled to\n\\begin{verbatim}\nlet-closure x = [z] [y] (y+z)\n\\end{verbatim}\nThe idea is that we compile code for @(y+z)@ in an environment in which\n@z@ is bound to an offset from \\tr{Node}, and @y@ is bound to an\noffset from the stack pointer.\n\n(A let-closure is an @StgLet@ with a @StgRhsClosure@ RHS.)\n\n\\item\n\\begin{verbatim}\nlet-constructor x = Constructor [args]\nin e\n\\end{verbatim}\n\n(A let-constructor is an @StgLet@ with a @StgRhsCon@ RHS.)\n\n\\item\nLetrec-expressions are essentially the same deal as\nlet-closure/let-constructor, so we use a common structure and\ndistinguish between them with an @is_recursive@ boolean flag.\n\n\\item\n\\begin{verbatim}\nlet-unboxed u = an arbitrary arithmetic expression in unboxed values\nin e\n\\end{verbatim}\nAll the stuff on the RHS must be fully evaluated.\nNo function calls either!\n\n(We've backed away from this toward case-expressions with\nsuitably-magical alts ...)\n\n\\item\n~[Advanced stuff here! Not to start with, but makes pattern matching\ngenerate more efficient code.]\n\n\\begin{verbatim}\nlet-escapes-not fail = expr\nin e'\n\\end{verbatim}\nHere the idea is that @e'@ guarantees not to put @fail@ in a data structure,\nor pass it to another function. All @e'@ will ever do is tail-call @fail@.\nRather than build a closure for @fail@, all we need do is to record the stack\nlevel at the moment of the @let-escapes-not@; then entering @fail@ is just\na matter of adjusting the stack pointer back down to that point and entering\nthe code for it.\n\nAnother example:\n\\begin{verbatim}\nf x y = let z = huge-expression in\n        if y==1 then z else\n        if y==2 then z else\n        1\n\\end{verbatim}\n\n(A let-escapes-not is an @StgLetNoEscape@.)\n\n\\item\nWe may eventually want:\n\\begin{verbatim}\nlet-literal x = Literal\nin e\n\\end{verbatim}\n\\end{enumerate}\n\nAnd so the code for let(rec)-things:\n-}\n\n  | StgLet\n        (XLet pass)\n        (GenStgBinding pass)    -- right hand sides (see below)\n        (GenStgExpr pass)       -- body\n\n  | StgLetNoEscape\n        (XLetNoEscape pass)\n        (GenStgBinding pass)    -- right hand sides (see below)\n        (GenStgExpr pass)       -- body\n\n{-\n%************************************************************************\n%*                                                                      *\n\\subsubsection{@GenStgExpr@: @hpc@, @scc@ and other debug annotations}\n%*                                                                      *\n%************************************************************************\n\nFinally for @hpc@ expressions we introduce a new STG construct.\n-}\n\n  | StgTick\n    (Tickish Id)\n    (GenStgExpr pass)       -- sub expression\n\n-- END of GenStgExpr\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{STG right-hand sides}\n*                                                                      *\n************************************************************************\n\nHere's the rest of the interesting stuff for @StgLet@s; the first\nflavour is for closures:\n-}\n\ndata GenStgRhs pass\n  = StgRhsClosure\n        (XRhsClosure pass) -- ^ Extension point for non-global free var\n                           --   list just before 'CodeGen'.\n        CostCentreStack    -- ^ CCS to be attached (default is CurrentCCS)\n        !UpdateFlag        -- ^ 'ReEntrant' | 'Updatable' | 'SingleEntry'\n        [BinderP pass]     -- ^ arguments; if empty, then not a function;\n                           --   as above, order is important.\n        (GenStgExpr pass)  -- ^ body\n\n{-\nAn example may be in order.  Consider:\n\\begin{verbatim}\nlet t = \\x -> \\y -> ... x ... y ... p ... q in e\n\\end{verbatim}\nPulling out the free vars and stylising somewhat, we get the equivalent:\n\\begin{verbatim}\nlet t = (\\[p,q] -> \\[x,y] -> ... x ... y ... p ...q) p q\n\\end{verbatim}\nStg-operationally, the @[x,y]@ are on the stack, the @[p,q]@ are\noffsets from @Node@ into the closure, and the code ptr for the closure\nwill be exactly that in parentheses above.\n\nThe second flavour of right-hand-side is for constructors (simple but important):\n-}\n\n  | StgRhsCon\n        CostCentreStack -- CCS to be attached (default is CurrentCCS).\n                        -- Top-level (static) ones will end up with\n                        -- DontCareCCS, because we don't count static\n                        -- data in heap profiles, and we don't set CCCS\n                        -- from static closure.\n        DataCon         -- Constructor. Never an unboxed tuple or sum, as those\n                        -- are not allocated.\n        [StgArg]        -- Args\n\n-- | Used as a data type index for the stgSyn AST\ndata StgPass\n  = Vanilla\n  | LiftLams\n  | CodeGen\n\n-- | Like 'HsExpression.NoExt', but with an 'Outputable' instance that returns\n-- 'empty'.\ndata NoExtSilent = NoExtSilent\n  deriving (Data, Eq, Ord)\n\ninstance Outputable NoExtSilent where\n  ppr _ = empty\n\n-- | Used when constructing a term with an unused extension point that should\n-- not appear in pretty-printed output at all.\nnoExtSilent :: NoExtSilent\nnoExtSilent = NoExtSilent\n-- TODO: Maybe move this to HsExtensions? I'm not sure about the implications\n-- on build time...\n\n-- TODO: Do we really want to the extension point type families to have a closed\n-- domain?\ntype family BinderP (pass :: StgPass)\ntype instance BinderP 'Vanilla = Id\ntype instance BinderP 'CodeGen = Id\n\ntype family XRhsClosure (pass :: StgPass)\ntype instance XRhsClosure 'Vanilla = NoExtSilent\n-- | Code gen needs to track non-global free vars\ntype instance XRhsClosure 'CodeGen = DIdSet\n\ntype family XLet (pass :: StgPass)\ntype instance XLet 'Vanilla = NoExtSilent\ntype instance XLet 'CodeGen = NoExtSilent\n\ntype family XLetNoEscape (pass :: StgPass)\ntype instance XLetNoEscape 'Vanilla = NoExtSilent\ntype instance XLetNoEscape 'CodeGen = NoExtSilent\n\nstgRhsArity :: StgRhs -> Int\nstgRhsArity (StgRhsClosure _ _ _ bndrs _)\n  = ASSERT( all isId bndrs ) length bndrs\n  -- The arity never includes type parameters, but they should have gone by now\nstgRhsArity (StgRhsCon _ _ _) = 0\n\n-- Note [CAF consistency]\n-- ~~~~~~~~~~~~~~~~~~~~~~\n--\n-- `topStgBindHasCafRefs` is only used by an assert (`consistentCafInfo` in\n-- `CoreToStg`) to make sure CAF-ness predicted by `TidyPgm` is consistent with\n-- reality.\n--\n-- Specifically, if the RHS mentions any Id that itself is marked\n-- `MayHaveCafRefs`; or if the binding is a top-level updateable thunk; then the\n-- `Id` for the binding should be marked `MayHaveCafRefs`. The potential trouble\n-- is that `TidyPgm` computed the CAF info on the `Id` but some transformations\n-- have taken place since then.\n\ntopStgBindHasCafRefs :: GenStgTopBinding pass -> Bool\ntopStgBindHasCafRefs (StgTopLifted (StgNonRec _ rhs))\n  = topRhsHasCafRefs rhs\ntopStgBindHasCafRefs (StgTopLifted (StgRec binds))\n  = any topRhsHasCafRefs (map snd binds)\ntopStgBindHasCafRefs StgTopStringLit{}\n  = False\n\ntopRhsHasCafRefs :: GenStgRhs pass -> Bool\ntopRhsHasCafRefs (StgRhsClosure _ _ upd _ body)\n  = -- See Note [CAF consistency]\n    isUpdatable upd || exprHasCafRefs body\ntopRhsHasCafRefs (StgRhsCon _ _ args)\n  = any stgArgHasCafRefs args\n\nexprHasCafRefs :: GenStgExpr pass -> Bool\nexprHasCafRefs (StgApp f args)\n  = stgIdHasCafRefs f || any stgArgHasCafRefs args\nexprHasCafRefs StgLit{}\n  = False\nexprHasCafRefs (StgConApp _ args _)\n  = any stgArgHasCafRefs args\nexprHasCafRefs (StgOpApp _ args _)\n  = any stgArgHasCafRefs args\nexprHasCafRefs (StgLam _ body)\n  = exprHasCafRefs body\nexprHasCafRefs (StgCase scrt _ _ alts)\n  = exprHasCafRefs scrt || any altHasCafRefs alts\nexprHasCafRefs (StgLet _ bind body)\n  = bindHasCafRefs bind || exprHasCafRefs body\nexprHasCafRefs (StgLetNoEscape _ bind body)\n  = bindHasCafRefs bind || exprHasCafRefs body\nexprHasCafRefs (StgTick _ expr)\n  = exprHasCafRefs expr\n\nbindHasCafRefs :: GenStgBinding pass -> Bool\nbindHasCafRefs (StgNonRec _ rhs)\n  = rhsHasCafRefs rhs\nbindHasCafRefs (StgRec binds)\n  = any rhsHasCafRefs (map snd binds)\n\nrhsHasCafRefs :: GenStgRhs pass -> Bool\nrhsHasCafRefs (StgRhsClosure _ _ _ _ body)\n  = exprHasCafRefs body\nrhsHasCafRefs (StgRhsCon _ _ args)\n  = any stgArgHasCafRefs args\n\naltHasCafRefs :: GenStgAlt pass -> Bool\naltHasCafRefs (_, _, rhs) = exprHasCafRefs rhs\n\nstgArgHasCafRefs :: StgArg -> Bool\nstgArgHasCafRefs (StgVarArg id)\n  = stgIdHasCafRefs id\nstgArgHasCafRefs _\n  = False\n\nstgIdHasCafRefs :: Id -> Bool\nstgIdHasCafRefs id =\n  -- We are looking for occurrences of an Id that is bound at top level, and may\n  -- have CAF refs. At this point (after TidyPgm) top-level Ids (whether\n  -- imported or defined in this module) are GlobalIds, so the test is easy.\n  isGlobalId id && mayHaveCafRefs (idCafInfo id)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Stg-case-alternatives]{STG case alternatives}\n*                                                                      *\n************************************************************************\n\nVery like in @CoreSyntax@ (except no type-world stuff).\n\nThe type constructor is guaranteed not to be abstract; that is, we can\nsee its representation. This is important because the code generator\nuses it to determine return conventions etc. But it's not trivial\nwhere there's a module loop involved, because some versions of a type\nconstructor might not have all the constructors visible. So\nmkStgAlgAlts (in CoreToStg) ensures that it gets the TyCon from the\nconstructors or literals (which are guaranteed to have the Real McCoy)\nrather than from the scrutinee type.\n-}\n\ntype GenStgAlt pass\n  = (AltCon,          -- alts: data constructor,\n     [BinderP pass],  -- constructor's parameters,\n     GenStgExpr pass) -- ...right-hand side.\n\ndata AltType\n  = PolyAlt             -- Polymorphic (a lifted type variable)\n  | MultiValAlt Int     -- Multi value of this arity (unboxed tuple or sum)\n                        -- the arity could indeed be 1 for unary unboxed tuple\n                        -- or enum-like unboxed sums\n  | AlgAlt      TyCon   -- Algebraic data type; the AltCons will be DataAlts\n  | PrimAlt     PrimRep -- Primitive data type; the AltCons (if any) will be LitAlts\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Stg]{The Plain STG parameterisation}\n*                                                                      *\n************************************************************************\n\nThis happens to be the only one we use at the moment.\n-}\n\ntype StgTopBinding = GenStgTopBinding 'Vanilla\ntype StgBinding    = GenStgBinding    'Vanilla\ntype StgExpr       = GenStgExpr       'Vanilla\ntype StgRhs        = GenStgRhs        'Vanilla\ntype StgAlt        = GenStgAlt        'Vanilla\n\ntype LlStgTopBinding = GenStgTopBinding 'LiftLams\ntype LlStgBinding    = GenStgBinding    'LiftLams\ntype LlStgExpr       = GenStgExpr       'LiftLams\ntype LlStgRhs        = GenStgRhs        'LiftLams\ntype LlStgAlt        = GenStgAlt        'LiftLams\n\ntype CgStgTopBinding = GenStgTopBinding 'CodeGen\ntype CgStgBinding    = GenStgBinding    'CodeGen\ntype CgStgExpr       = GenStgExpr       'CodeGen\ntype CgStgRhs        = GenStgRhs        'CodeGen\ntype CgStgAlt        = GenStgAlt        'CodeGen\n\n{- Many passes apply a substitution, and it's very handy to have type\n   synonyms to remind us whether or not the substitution has been applied.\n   See CoreSyn for precedence in Core land\n-}\n\ntype InStgTopBinding  = StgTopBinding\ntype InStgBinding     = StgBinding\ntype InStgArg         = StgArg\ntype InStgExpr        = StgExpr\ntype InStgRhs         = StgRhs\ntype InStgAlt         = StgAlt\ntype OutStgTopBinding = StgTopBinding\ntype OutStgBinding    = StgBinding\ntype OutStgArg        = StgArg\ntype OutStgExpr       = StgExpr\ntype OutStgRhs        = StgRhs\ntype OutStgAlt        = StgAlt\n\n{-\n\n************************************************************************\n*                                                                      *\n\\subsubsection[UpdateFlag-datatype]{@UpdateFlag@}\n*                                                                      *\n************************************************************************\n\nThis is also used in @LambdaFormInfo@ in the @ClosureInfo@ module.\n\nA @ReEntrant@ closure may be entered multiple times, but should not be\nupdated or blackholed. An @Updatable@ closure should be updated after\nevaluation (and may be blackholed during evaluation). A @SingleEntry@\nclosure will only be entered once, and so need not be updated but may\nsafely be blackholed.\n-}\n\ndata UpdateFlag = ReEntrant | Updatable | SingleEntry\n\ninstance Outputable UpdateFlag where\n    ppr u = char $ case u of\n                       ReEntrant   -> 'r'\n                       Updatable   -> 'u'\n                       SingleEntry -> 's'\n\nisUpdatable :: UpdateFlag -> Bool\nisUpdatable ReEntrant   = False\nisUpdatable SingleEntry = False\nisUpdatable Updatable   = True\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{StgOp}\n*                                                                      *\n************************************************************************\n\nAn StgOp allows us to group together PrimOps and ForeignCalls.\nIt's quite useful to move these around together, notably\nin StgOpApp and COpStmt.\n-}\n\ndata StgOp\n  = StgPrimOp  PrimOp\n\n  | StgPrimCallOp PrimCall\n\n  | StgFCallOp ForeignCall Unique\n        -- The Unique is occasionally needed by the C pretty-printer\n        -- (which lacks a unique supply), notably when generating a\n        -- typedef for foreign-export-dynamic\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Stg-pretty-printing]{Pretty-printing}\n*                                                                      *\n************************************************************************\n\nRobin Popplestone asked for semi-colon separators on STG binds; here's\nhoping he likes terminators instead...  Ditto for case alternatives.\n-}\n\ntype OutputablePass pass =\n  ( Outputable (XLet pass)\n  , Outputable (XLetNoEscape pass)\n  , Outputable (XRhsClosure pass)\n  , OutputableBndr (BinderP pass)\n  )\n\npprGenStgTopBinding\n  :: OutputablePass pass => GenStgTopBinding pass -> SDoc\npprGenStgTopBinding (StgTopStringLit bndr str)\n  = hang (hsep [pprBndr LetBind bndr, equals])\n        4 (pprHsBytes str <> semi)\npprGenStgTopBinding (StgTopLifted bind)\n  = pprGenStgBinding bind\n\npprGenStgBinding\n  :: OutputablePass pass => GenStgBinding pass -> SDoc\n\npprGenStgBinding (StgNonRec bndr rhs)\n  = hang (hsep [pprBndr LetBind bndr, equals])\n        4 (ppr rhs <> semi)\n\npprGenStgBinding (StgRec pairs)\n  = vcat [ text \"Rec {\"\n         , vcat (map ppr_bind pairs)\n         , text \"end Rec }\" ]\n  where\n    ppr_bind (bndr, expr)\n      = hang (hsep [pprBndr LetBind bndr, equals])\n             4 (ppr expr <> semi)\n\npprGenStgTopBindings\n  :: (OutputablePass pass) => [GenStgTopBinding pass] -> SDoc\npprGenStgTopBindings binds\n  = vcat $ intersperse blankLine (map pprGenStgTopBinding binds)\n\npprStgBinding :: StgBinding -> SDoc\npprStgBinding = pprGenStgBinding\n\npprStgTopBindings :: [StgTopBinding] -> SDoc\npprStgTopBindings = pprGenStgTopBindings\n\ninstance Outputable StgArg where\n    ppr = pprStgArg\n\ninstance OutputablePass pass => Outputable (GenStgTopBinding pass) where\n    ppr = pprGenStgTopBinding\n\ninstance OutputablePass pass => Outputable (GenStgBinding pass) where\n    ppr = pprGenStgBinding\n\ninstance OutputablePass pass => Outputable (GenStgExpr pass) where\n    ppr = pprStgExpr\n\ninstance OutputablePass pass => Outputable (GenStgRhs pass) where\n    ppr rhs = pprStgRhs rhs\n\npprStgArg :: StgArg -> SDoc\npprStgArg (StgVarArg var) = ppr var\npprStgArg (StgLitArg con) = ppr con\n\npprStgExpr :: OutputablePass pass => GenStgExpr pass -> SDoc\n-- special case\npprStgExpr (StgLit lit)     = ppr lit\n\n-- general case\npprStgExpr (StgApp func args)\n  = hang (ppr func) 4 (sep (map (ppr) args))\n\npprStgExpr (StgConApp con args _)\n  = hsep [ ppr con, brackets (interppSP args) ]\n\npprStgExpr (StgOpApp op args _)\n  = hsep [ pprStgOp op, brackets (interppSP args)]\n\npprStgExpr (StgLam bndrs body)\n  = sep [ char '\\\\' <+> ppr_list (map (pprBndr LambdaBind) (toList bndrs))\n            <+> text \"->\",\n         pprStgExpr body ]\n  where ppr_list = brackets . fsep . punctuate comma\n\n-- special case: let v = <very specific thing>\n--               in\n--               let ...\n--               in\n--               ...\n--\n-- Very special!  Suspicious! (SLPJ)\n\n{-\npprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))\n                        expr@(StgLet _ _))\n  = ($$)\n      (hang (hcat [text \"let { \", ppr bndr, ptext (sLit \" = \"),\n                          ppr cc,\n                          pp_binder_info bi,\n                          text \" [\", whenPprDebug (interppSP free_vars), ptext (sLit \"] \\\\\"),\n                          ppr upd_flag, text \" [\",\n                          interppSP args, char ']'])\n            8 (sep [hsep [ppr rhs, text \"} in\"]]))\n      (ppr expr)\n-}\n\n-- special case: let ... in let ...\n\npprStgExpr (StgLet ext bind expr@StgLet{})\n  = ($$)\n      (sep [hang (text \"let\" <+> ppr ext <+> text \"{\")\n                2 (hsep [pprGenStgBinding bind, text \"} in\"])])\n      (ppr expr)\n\n-- general case\npprStgExpr (StgLet ext bind expr)\n  = sep [hang (text \"let\" <+> ppr ext <+> text \"{\") 2 (pprGenStgBinding bind),\n           hang (text \"} in \") 2 (ppr expr)]\n\npprStgExpr (StgLetNoEscape ext bind expr)\n  = sep [hang (text \"let-no-escape\" <+> ppr ext <+> text \"{\")\n                2 (pprGenStgBinding bind),\n           hang (text \"} in \")\n                2 (ppr expr)]\n\npprStgExpr (StgTick tickish expr)\n  = sdocWithDynFlags $ \\dflags ->\n    if gopt Opt_SuppressTicks dflags\n    then pprStgExpr expr\n    else sep [ ppr tickish, pprStgExpr expr ]\n\n\npprStgExpr (StgCase expr bndr alt_type alts)\n  = sep [sep [text \"case\",\n           nest 4 (hsep [pprStgExpr expr,\n             whenPprDebug (dcolon <+> ppr alt_type)]),\n           text \"of\", pprBndr CaseBind bndr, char '{'],\n           nest 2 (vcat (map pprStgAlt alts)),\n           char '}']\n\npprStgAlt :: OutputablePass pass => GenStgAlt pass -> SDoc\npprStgAlt (con, params, expr)\n  = hang (hsep [ppr con, sep (map (pprBndr CasePatBind) params), text \"->\"])\n         4 (ppr expr <> semi)\n\npprStgOp :: StgOp -> SDoc\npprStgOp (StgPrimOp  op)   = ppr op\npprStgOp (StgPrimCallOp op)= ppr op\npprStgOp (StgFCallOp op _) = ppr op\n\ninstance Outputable AltType where\n  ppr PolyAlt         = text \"Polymorphic\"\n  ppr (MultiValAlt n) = text \"MultiAlt\" <+> ppr n\n  ppr (AlgAlt tc)     = text \"Alg\"    <+> ppr tc\n  ppr (PrimAlt tc)    = text \"Prim\"   <+> ppr tc\n\npprStgRhs :: OutputablePass pass => GenStgRhs pass -> SDoc\n\n-- special case\npprStgRhs (StgRhsClosure ext cc upd_flag [{-no args-}] (StgApp func []))\n  = sdocWithDynFlags $ \\dflags ->\n    hsep [ ppr cc,\n           if not $ gopt Opt_SuppressStgExts dflags\n             then ppr ext else empty,\n           text \" \\\\\", ppr upd_flag, ptext (sLit \" [] \"), ppr func ]\n\n-- general case\npprStgRhs (StgRhsClosure ext cc upd_flag args body)\n  = sdocWithDynFlags $ \\dflags ->\n    hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty,\n                if not $ gopt Opt_SuppressStgExts dflags\n                  then ppr ext else empty,\n                char '\\\\' <> ppr upd_flag, brackets (interppSP args)])\n         4 (ppr body)\n\npprStgRhs (StgRhsCon cc con args)\n  = hcat [ ppr cc,\n           space, ppr con, text \"! \", brackets (interppSP args)]\n", "num_lines": 880}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\\section[WorkWrap]{Worker/wrapper-generating back-end of strictness analyser}\n-}\n\n{-# LANGUAGE CPP #-}\nmodule WorkWrap ( wwTopBinds ) where\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreUnfold       ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding )\nimport CoreUtils        ( exprType, exprIsHNF )\nimport CoreFVs          ( exprFreeVars )\nimport Var\nimport Id\nimport IdInfo\nimport Type\nimport UniqSupply\nimport BasicTypes\nimport DynFlags\nimport Demand\nimport WwLib\nimport Util\nimport Outputable\nimport FamInstEnv\nimport MonadUtils\n\n#include \"HsVersions.h\"\n\n{-\nWe take Core bindings whose binders have:\n\n\\begin{enumerate}\n\n\\item Strictness attached (by the front-end of the strictness\nanalyser), and / or\n\n\\item Constructed Product Result information attached by the CPR\nanalysis pass.\n\n\\end{enumerate}\n\nand we return some ``plain'' bindings which have been\nworker/wrapper-ified, meaning:\n\n\\begin{enumerate}\n\n\\item Functions have been split into workers and wrappers where\nappropriate.  If a function has both strictness and CPR properties\nthen only one worker/wrapper doing both transformations is produced;\n\n\\item Binders' @IdInfos@ have been updated to reflect the existence of\nthese workers/wrappers (this is where we get STRICTNESS and CPR pragma\ninfo for exported values).\n\\end{enumerate}\n-}\n\nwwTopBinds :: DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram\n\nwwTopBinds dflags fam_envs us top_binds\n  = initUs_ us $ do\n    top_binds' <- mapM (wwBind dflags fam_envs) top_binds\n    return (concat top_binds')\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[wwBind-wwExpr]{@wwBind@ and @wwExpr@}\n*                                                                      *\n************************************************************************\n\n@wwBind@ works on a binding, trying each \\tr{(binder, expr)} pair in\nturn.  Non-recursive case first, then recursive...\n-}\n\nwwBind  :: DynFlags\n        -> FamInstEnvs\n        -> CoreBind\n        -> UniqSM [CoreBind]    -- returns a WwBinding intermediate form;\n                                -- the caller will convert to Expr/Binding,\n                                -- as appropriate.\n\nwwBind dflags fam_envs (NonRec binder rhs) = do\n    new_rhs <- wwExpr dflags fam_envs rhs\n    new_pairs <- tryWW dflags fam_envs NonRecursive binder new_rhs\n    return [NonRec b e | (b,e) <- new_pairs]\n      -- Generated bindings must be non-recursive\n      -- because the original binding was.\n\nwwBind dflags fam_envs (Rec pairs)\n  = return . Rec <$> concatMapM do_one pairs\n  where\n    do_one (binder, rhs) = do new_rhs <- wwExpr dflags fam_envs rhs\n                              tryWW dflags fam_envs Recursive binder new_rhs\n\n{-\n@wwExpr@ basically just walks the tree, looking for appropriate\nannotations that can be used. Remember it is @wwBind@ that does the\nmatching by looking for strict arguments of the correct type.\n@wwExpr@ is a version that just returns the ``Plain'' Tree.\n-}\n\nwwExpr :: DynFlags -> FamInstEnvs -> CoreExpr -> UniqSM CoreExpr\n\nwwExpr _      _ e@(Type {}) = return e\nwwExpr _      _ e@(Coercion {}) = return e\nwwExpr _      _ e@(Lit  {}) = return e\nwwExpr _      _ e@(Var  {}) = return e\n\nwwExpr dflags fam_envs (Lam binder expr)\n  = Lam new_binder <$> wwExpr dflags fam_envs expr\n  where new_binder | isId binder = zapIdUsedOnceInfo binder\n                   | otherwise   = binder\n  -- See Note [Zapping Used Once info in WorkWrap]\n\nwwExpr dflags fam_envs (App f a)\n  = App <$> wwExpr dflags fam_envs f <*> wwExpr dflags fam_envs a\n\nwwExpr dflags fam_envs (Tick note expr)\n  = Tick note <$> wwExpr dflags fam_envs expr\n\nwwExpr dflags fam_envs (Cast expr co) = do\n    new_expr <- wwExpr dflags fam_envs expr\n    return (Cast new_expr co)\n\nwwExpr dflags fam_envs (Let bind expr)\n  = mkLets <$> wwBind dflags fam_envs bind <*> wwExpr dflags fam_envs expr\n\nwwExpr dflags fam_envs (Case expr binder ty alts) = do\n    new_expr <- wwExpr dflags fam_envs expr\n    new_alts <- mapM ww_alt alts\n    let new_binder = zapIdUsedOnceInfo binder\n      -- See Note [Zapping Used Once info in WorkWrap]\n    return (Case new_expr new_binder ty new_alts)\n  where\n    ww_alt (con, binders, rhs) = do\n        new_rhs <- wwExpr dflags fam_envs rhs\n        let new_binders = [ if isId b then zapIdUsedOnceInfo b else b\n                          | b <- binders ]\n           -- See Note [Zapping Used Once info in WorkWrap]\n        return (con, new_binders, new_rhs)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[tryWW]{@tryWW@: attempt a worker/wrapper pair}\n*                                                                      *\n************************************************************************\n\n@tryWW@ just accumulates arguments, converts strictness info from the\nfront-end into the proper form, then calls @mkWwBodies@ to do\nthe business.\n\nThe only reason this is monadised is for the unique supply.\n\nNote [Don't w/w INLINE things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's very important to refrain from w/w-ing an INLINE function (ie one\nwith a stable unfolding) because the wrapper will then overwrite the\nold stable unfolding with the wrapper code.\n\nFurthermore, if the programmer has marked something as INLINE,\nwe may lose by w/w'ing it.\n\nIf the strictness analyser is run twice, this test also prevents\nwrappers (which are INLINEd) from being re-done.  (You can end up with\nseveral liked-named Ids bouncing around at the same time---absolute\nmischief.)\n\nNotice that we refrain from w/w'ing an INLINE function even if it is\nin a recursive group.  It might not be the loop breaker.  (We could\ntest for loop-breaker-hood, but I'm not sure that ever matters.)\n\nNote [Worker-wrapper for INLINABLE functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have\n  {-# INLINABLE f #-}\n  f :: Ord a => [a] -> Int -> a\n  f x y = ....f....\n\nwhere f is strict in y, we might get a more efficient loop by w/w'ing\nf.  But that would make a new unfolding which would overwrite the old\none! So the function would no longer be INLNABLE, and in particular\nwill not be specialised at call sites in other modules.\n\nThis comes in practice (Trac #6056).\n\nSolution: do the w/w for strictness analysis, but transfer the Stable\nunfolding to the *worker*.  So we will get something like this:\n\n  {-# INLINE[0] f #-}\n  f :: Ord a => [a] -> Int -> a\n  f d x y = case y of I# y' -> fw d x y'\n\n  {-# INLINABLE[0] fw #-}\n  fw :: Ord a => [a] -> Int# -> a\n  fw d x y' = let y = I# y' in ...f...\n\nHow do we \"transfer the unfolding\"? Easy: by using the old one, wrapped\nin work_fn! See CoreUnfold.mkWorkerUnfolding.\n\nNote [Worker-wrapper for NOINLINE functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used to disable worker/wrapper for NOINLINE things, but it turns out\nthis can cause unnecessary reboxing of values. Consider\n\n  {-# NOINLINE f #-}\n  f :: Int -> a\n  f x = error (show x)\n\n  g :: Bool -> Bool -> Int -> Int\n  g True  True  p = f p\n  g False True  p = p + 1\n  g b     False p = g b True p\n\nthe strictness analysis will discover f and g are strict, but because f\nhas no wrapper, the worker for g will rebox p. So we get\n\n  $wg x y p# =\n    let p = I# p# in  -- Yikes! Reboxing!\n    case x of\n      False ->\n        case y of\n          False -> $wg False True p#\n          True -> +# p# 1#\n      True ->\n        case y of\n          False -> $wg True True p#\n          True -> case f p of { }\n\n  g x y p = case p of (I# p#) -> $wg x y p#\n\nNow, in this case the reboxing will float into the True branch, and so\nthe allocation will only happen on the error path. But it won't float\ninwards if there are multiple branches that call (f p), so the reboxing\nwill happen on every call of g. Disaster.\n\nSolution: do worker/wrapper even on NOINLINE things; but move the\nNOINLINE pragma to the worker.\n\n(See Trac #13143 for a real-world example.)\n\nNote [Worker activation]\n~~~~~~~~~~~~~~~~~~~~~~~~\nFollows on from Note [Worker-wrapper for INLINABLE functions]\n\nIt is *vital* that if the worker gets an INLINABLE pragma (from the\noriginal function), then the worker has the same phase activation as\nthe wrapper (or later).  That is necessary to allow the wrapper to\ninline into the worker's unfolding: see SimplUtils\nNote [Simplifying inside stable unfoldings].\n\nIf the original is NOINLINE, it's important that the work inherit the\noriginal activation. Consider\n\n  {-# NOINLINE expensive #-}\n  expensive x = x + 1\n\n  f y = let z = expensive y in ...\n\nIf expensive's worker inherits the wrapper's activation,\nwe'll get this (because of the compromise in point (2) of\nNote [Wrapper activation])\n\n  {-# NOINLINE[0] $wexpensive #-}\n  $wexpensive x = x + 1\n  {-# INLINE[0] expensive #-}\n  expensive x = $wexpensive x\n\n  f y = let z = expensive y in ...\n\nand $wexpensive will be immediately inlined into expensive, followed by\nexpensive into f. This effectively removes the original NOINLINE!\n\nOtherwise, nothing is lost by giving the worker the same activation as the\nwrapper, because the worker won't have any chance of inlining until the\nwrapper does; there's no point in giving it an earlier activation.\n\nNote [Don't w/w inline small non-loop-breaker things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn general, we refrain from w/w-ing *small* functions, which are not\nloop breakers, because they'll inline anyway.  But we must take care:\nit may look small now, but get to be big later after other inlining\nhas happened.  So we take the precaution of adding an INLINE pragma to\nany such functions.\n\nI made this change when I observed a big function at the end of\ncompilation with a useful strictness signature but no w-w.  (It was\nsmall during demand analysis, we refrained from w/w, and then got big\nwhen something was inlined in its rhs.) When I measured it on nofib,\nit didn't make much difference; just a few percent improved allocation\non one benchmark (bspt/Euclid.space).  But nothing got worse.\n\nThere is an infelicity though.  We may get something like\n      f = g val\n==>\n      g x = case gw x of r -> I# r\n\n      f {- InlineStable, Template = g val -}\n      f = case gw x of r -> I# r\n\nThe code for f duplicates that for g, without any real benefit. It\nwon't really be executed, because calls to f will go via the inlining.\n\nNote [Don't CPR join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThere's no point in doing CPR on a join point. If the whole function is getting\nCPR'd, then the case expression around the worker function will get pushed into\nthe join point by the simplifier, which will have the same effect that CPR would\nhave - the result will be returned in an unboxed tuple.\n\n  f z = let join j x y = (x+1, y+1)\n        in case z of A -> j 1 2\n                     B -> j 2 3\n\n  =>\n\n  f z = case $wf z of (# a, b #) -> (a, b)\n  $wf z = case (let join j x y = (x+1, y+1)\n                in case z of A -> j 1 2\n                             B -> j 2 3) of (a, b) -> (# a, b #)\n\n  =>\n\n  f z = case $wf z of (# a, b #) -> (a, b)\n  $wf z = let join j x y = (# x+1, y+1 #)\n          in case z of A -> j 1 2\n                       B -> j 2 3\n\nDoing CPR on a join point would be tricky anyway, as the worker could not be\na join point because it would not be tail-called. However, doing the *argument*\npart of W/W still works for join points, since the wrapper body will make a tail\ncall:\n\n  f z = let join j x y = x + y\n        in ...\n\n  =>\n\n  f z = let join $wj x# y# = x# +# y#\n                 j x y = case x of I# x# ->\n                         case y of I# y# ->\n                         $wj x# y#\n        in ...\n\nNote [Wrapper activation]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen should the wrapper inlining be active?\n\n1. It must not be active earlier than the current Activation of the\n   Id\n\n2. It should be active at some point, despite (1) because of\n   Note [Worker-wrapper for NOINLINE functions]\n\n3. For ordinary functions with no pragmas we want to inline the\n   wrapper as early as possible (Trac #15056).  Suppose another module\n   defines    f x = g x x\n   and suppose there is some RULE for (g True True).  Then if we have\n   a call (f True), we'd expect to inline 'f' and the RULE will fire.\n   But if f is w/w'd (which it might be), we want the inlining to\n   occur just as if it hadn't been.\n\n   (This only matters if f's RHS is big enough to w/w, but small\n   enough to inline given the call site, but that can happen.)\n\n4. We do not want to inline the wrapper before specialisation.\n         module Foo where\n           f :: Num a => a -> Int -> a\n           f n 0 = n              -- Strict in the Int, hence wrapper\n           f n x = f (n+n) (x-1)\n\n           g :: Int -> Int\n           g x = f x x            -- Provokes a specialisation for f\n\n         module Bar where\n           import Foo\n\n           h :: Int -> Int\n           h x = f 3 x\n\n   In module Bar we want to give specialisations a chance to fire\n   before inlining f's wrapper.\n\nReminder: Note [Don't w/w INLINE things], so we don't need to worry\n          about INLINE things here.\n\nConclusion:\n  - If the user said NOINLINE[n], respect that\n  - If the user said NOINLINE, inline the wrapper as late as\n    poss (phase 0). This is a compromise driven by (2) above\n  - Otherwise inline wrapper in phase 2.  That allows the\n    'gentle' simplification pass to apply specialisation rules\n\nHistorical note: At one stage I tried making the wrapper inlining\nalways-active, and that had a very bad effect on nofib/imaginary/x2n1;\na wrapper was inlined before the specialisation fired.\n\nNote [Wrapper NoUserInline]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe use an inl_inline of NoUserInline on the wrapper distinguishes\nthis pragma from one that was given by the user. In particular, CSE\nwill not happen if there is a user-specified pragma, but should happen\nfor w/w\u00e2\u20ac\u2122ed things (#14186).\n-}\n\ntryWW   :: DynFlags\n        -> FamInstEnvs\n        -> RecFlag\n        -> Id                           -- The fn binder\n        -> CoreExpr                     -- The bound rhs; its innards\n                                        --   are already ww'd\n        -> UniqSM [(Id, CoreExpr)]      -- either *one* or *two* pairs;\n                                        -- if one, then no worker (only\n                                        -- the orig \"wrapper\" lives on);\n                                        -- if two, then a worker and a\n                                        -- wrapper.\ntryWW dflags fam_envs is_rec fn_id rhs\n  -- See Note [Worker-wrapper for NOINLINE functions]\n\n  | Just stable_unf <- certainlyWillInline dflags fn_info\n  = return [ (fn_id `setIdUnfolding` stable_unf, rhs) ]\n        -- See Note [Don't w/w INLINE things]\n        -- See Note [Don't w/w inline small non-loop-breaker things]\n\n  | is_fun\n  = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs\n\n  | is_thunk                                   -- See Note [Thunk splitting]\n  = splitThunk dflags fam_envs is_rec new_fn_id rhs\n\n  | otherwise\n  = return [ (new_fn_id, rhs) ]\n\n  where\n    fn_info      = idInfo fn_id\n    (wrap_dmds, res_info) = splitStrictSig (strictnessInfo fn_info)\n\n    new_fn_id = zapIdUsedOnceInfo (zapIdUsageEnvInfo fn_id)\n        -- See Note [Zapping DmdEnv after Demand Analyzer] and\n        -- See Note [Zapping Used Once info in WorkWrap]\n\n    is_fun    = notNull wrap_dmds || isJoinId fn_id\n    is_thunk  = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id)\n                           && not (isUnliftedType (idType fn_id))\n\n{-\nNote [Zapping DmdEnv after Demand Analyzer]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the worker-wrapper pass we zap the DmdEnv.  Why?\n (a) it is never used again\n (b) it wastes space\n (c) it becomes incorrect as things are cloned, because\n     we don't push the substitution into it\n\nWhy here?\n * Because we don\u00e2\u20ac\u2122t want to do it in the Demand Analyzer, as we never know\n   there when we are doing the last pass.\n * We want them to be still there at the end of DmdAnal, so that\n   -ddump-str-anal contains them.\n * We don\u00e2\u20ac\u2122t want a second pass just for that.\n * WorkWrap looks at all bindings anyway.\n\nWe also need to do it in TidyCore.tidyLetBndr to clean up after the\nfinal, worker/wrapper-less run of the demand analyser (see\nNote [Final Demand Analyser run] in DmdAnal).\n\nNote [Zapping Used Once info in WorkWrap]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the worker-wrapper pass we zap the used once info in demands and in\nstrictness signatures.\n\nWhy?\n * The simplifier may happen to transform code in a way that invalidates the\n   data (see #11731 for an example).\n * It is not used in later passes, up to code generation.\n\nSo as the data is useless and possibly wrong, we want to remove it. The most\nconvenient place to do that is the worker wrapper phase, as it runs after every\nrun of the demand analyser besides the very last one (which is the one where we\nwant to _keep_ the info for the code generator).\n\nWe do not do it in the demand analyser for the same reasons outlined in\nNote [Zapping DmdEnv after Demand Analyzer] above.\n-}\n\n\n---------------------\nsplitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> DmdResult -> CoreExpr\n         -> UniqSM [(Id, CoreExpr)]\nsplitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs\n  = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) do\n    -- The arity should match the signature\n    stuff <- mkWwBodies dflags fam_envs rhs_fvs fn_id wrap_dmds use_res_info\n    case stuff of\n      Just (work_demands, join_arity, wrap_fn, work_fn) -> do\n        work_uniq <- getUniqueM\n        let work_rhs = work_fn rhs\n            work_act = case fn_inline_spec of  -- See Note [Worker activation]\n                          NoInline -> fn_act\n                          _        -> wrap_act\n\n            work_prag = InlinePragma { inl_src = SourceText \"{-# INLINE\"\n                                     , inl_inline = fn_inline_spec\n                                     , inl_sat    = Nothing\n                                     , inl_act    = work_act\n                                     , inl_rule   = FunLike }\n              -- inl_inline: copy from fn_id; see Note [Worker-wrapper for INLINABLE functions]\n              -- inl_act:    see Note [Worker activation]\n              -- inl_rule:   it does not make sense for workers to be constructorlike.\n\n            work_join_arity | isJoinId fn_id = Just join_arity\n                            | otherwise      = Nothing\n              -- worker is join point iff wrapper is join point\n              -- (see Note [Don't CPR join points])\n\n            work_id  = mkWorkerId work_uniq fn_id (exprType work_rhs)\n                        `setIdOccInfo` occInfo fn_info\n                                -- Copy over occurrence info from parent\n                                -- Notably whether it's a loop breaker\n                                -- Doesn't matter much, since we will simplify next, but\n                                -- seems right-er to do so\n\n                        `setInlinePragma` work_prag\n\n                        `setIdUnfolding` mkWorkerUnfolding dflags work_fn fn_unfolding\n                                -- See Note [Worker-wrapper for INLINABLE functions]\n\n                        `setIdStrictness` mkClosedStrictSig work_demands work_res_info\n                                -- Even though we may not be at top level,\n                                -- it's ok to give it an empty DmdEnv\n\n                        `setIdDemandInfo` worker_demand\n\n                        `setIdArity` work_arity\n                                -- Set the arity so that the Core Lint check that the\n                                -- arity is consistent with the demand type goes\n                                -- through\n                        `asJoinId_maybe` work_join_arity\n\n            work_arity = length work_demands\n\n            -- See Note [Demand on the Worker]\n            single_call = saturatedByOneShots arity (demandInfo fn_info)\n            worker_demand | single_call = mkWorkerDemand work_arity\n                          | otherwise   = topDmd\n\n            wrap_rhs  = wrap_fn work_id\n            wrap_act  = case fn_act of  -- See Note [Wrapper activation]\n                           ActiveAfter {} -> fn_act\n                           NeverActive    -> activeDuringFinal\n                           _              -> activeAfterInitial\n            wrap_prag = InlinePragma { inl_src    = SourceText \"{-# INLINE\"\n                                     , inl_inline = NoUserInline\n                                     , inl_sat    = Nothing\n                                     , inl_act    = wrap_act\n                                     , inl_rule   = rule_match_info }\n                -- inl_act:    see Note [Wrapper activation]\n                -- inl_inline: see Note [Wrapper NoUserInline]\n                -- inl_rule:   RuleMatchInfo is (and must be) unaffected\n\n            wrap_id   = fn_id `setIdUnfolding`  mkWwInlineRule dflags wrap_rhs arity\n                              `setInlinePragma` wrap_prag\n                              `setIdOccInfo`    noOccInfo\n                                -- Zap any loop-breaker-ness, to avoid bleating from Lint\n                                -- about a loop breaker with an INLINE rule\n\n\n\n        return $ [(work_id, work_rhs), (wrap_id, wrap_rhs)]\n            -- Worker first, because wrapper mentions it\n\n      Nothing -> return [(fn_id, rhs)]\n  where\n    rhs_fvs         = exprFreeVars rhs\n    fn_inl_prag     = inlinePragInfo fn_info\n    fn_inline_spec  = inl_inline fn_inl_prag\n    fn_act          = inl_act fn_inl_prag\n    rule_match_info = inlinePragmaRuleMatchInfo fn_inl_prag\n    fn_unfolding    = unfoldingInfo fn_info\n    arity           = arityInfo fn_info\n                    -- The arity is set by the simplifier using exprEtaExpandArity\n                    -- So it may be more than the number of top-level-visible lambdas\n\n    use_res_info  | isJoinId fn_id = topRes -- Note [Don't CPR join points]\n                  | otherwise      = res_info\n    work_res_info | isJoinId fn_id = res_info -- Worker remains CPR-able\n                  | otherwise\n                  = case returnsCPR_maybe res_info of\n                       Just _  -> topRes    -- Cpr stuff done by wrapper; kill it here\n                       Nothing -> res_info  -- Preserve exception/divergence\n\n\n{-\nNote [Demand on the worker]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIf the original function is called once, according to its demand info, then\nso is the worker. This is important so that the occurrence analyser can\nattach OneShot annotations to the worker\u00e2\u20ac\u2122s lambda binders.\n\n\nExample:\n\n  -- Original function\n  f [Demand=<L,1*C1(U)>] :: (a,a) -> a\n  f = \\p -> ...\n\n  -- Wrapper\n  f [Demand=<L,1*C1(U)>] :: a -> a -> a\n  f = \\p -> case p of (a,b) -> $wf a b\n\n  -- Worker\n  $wf [Demand=<L,1*C1(C1(U))>] :: Int -> Int\n  $wf = \\a b -> ...\n\nWe need to check whether the original function is called once, with\nsufficiently many arguments. This is done using saturatedByOneShots, which\ntakes the arity of the original function (resp. the wrapper) and the demand on\nthe original function.\n\nThe demand on the worker is then calculated using mkWorkerDemand, and always of\nthe form [Demand=<L,1*(C1(...(C1(U))))>]\n\n\nNote [Do not split void functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this rather common form of binding:\n        $j = \\x:Void# -> ...no use of x...\n\nSince x is not used it'll be marked as absent.  But there is no point\nin w/w-ing because we'll simply add (\\y:Void#), see WwLib.mkWorerArgs.\n\nIf x has a more interesting type (eg Int, or Int#), there *is* a point\nin w/w so that we don't pass the argument at all.\n\nNote [Thunk splitting]\n~~~~~~~~~~~~~~~~~~~~~~\nSuppose x is used strictly (never mind whether it has the CPR\nproperty).\n\n      let\n        x* = x-rhs\n      in body\n\nsplitThunk transforms like this:\n\n      let\n        x* = case x-rhs of { I# a -> I# a }\n      in body\n\nNow simplifier will transform to\n\n      case x-rhs of\n        I# a -> let x* = I# a\n                in body\n\nwhich is what we want. Now suppose x-rhs is itself a case:\n\n        x-rhs = case e of { T -> I# a; F -> I# b }\n\nThe join point will abstract over a, rather than over (which is\nwhat would have happened before) which is fine.\n\nNotice that x certainly has the CPR property now!\n\nIn fact, splitThunk uses the function argument w/w splitting\nfunction, so that if x's demand is deeper (say U(U(L,L),L))\nthen the splitting will go deeper too.\n-}\n\n-- See Note [Thunk splitting]\n-- splitThunk converts the *non-recursive* binding\n--      x = e\n-- into\n--      x = let x = e\n--          in case x of\n--               I# y -> let x = I# y in x }\n-- See comments above. Is it not beautifully short?\n-- Moreover, it works just as well when there are\n-- several binders, and if the binders are lifted\n-- E.g.     x = e\n--     -->  x = let x = e in\n--              case x of (a,b) -> let x = (a,b)  in x\n\nsplitThunk :: DynFlags -> FamInstEnvs -> RecFlag -> Var -> Expr Var -> UniqSM [(Var, Expr Var)]\nsplitThunk dflags fam_envs is_rec fn_id rhs\n  = ASSERT(not (isJoinId fn_id))\n    do { (useful,_, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False [fn_id]\n       ; let res = [ (fn_id, Let (NonRec fn_id rhs) (wrap_fn (work_fn (Var fn_id)))) ]\n       ; if useful then ASSERT2( isNonRec is_rec, ppr fn_id ) -- The thunk must be non-recursive\n                   return res\n                   else return [(fn_id, rhs)] }\n", "num_lines": 697}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The GRASP/AQUA Project, Glasgow University, 1993-1998\n\n\\section[WwLib]{A library for the ``worker\\/wrapper'' back-end to the strictness analyser}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs\n             , deepSplitProductType_maybe, findTypeShape\n             , isWorkerSmallEnough\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport CoreSyn\nimport CoreUtils        ( exprType, mkCast )\nimport Id\nimport IdInfo           ( JoinArity )\nimport DataCon\nimport Demand\nimport MkCore           ( mkAbsentErrorApp, mkCoreUbxTup\n                        , mkCoreApp, mkCoreLet )\nimport MkId             ( voidArgId, voidPrimId )\nimport TysWiredIn       ( tupleDataCon )\nimport TysPrim          ( voidPrimTy )\nimport Literal          ( absentLiteralOf, rubbishLit )\nimport VarEnv           ( mkInScopeSet )\nimport VarSet           ( VarSet )\nimport Type\nimport RepType          ( isVoidTy, typePrimRep )\nimport Coercion\nimport FamInstEnv\nimport BasicTypes       ( Boxity(..) )\nimport TyCon\nimport UniqSupply\nimport Unique\nimport Maybes\nimport Util\nimport Outputable\nimport DynFlags\nimport FastString\nimport ListSetOps\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[mkWrapperAndWorker]{@mkWrapperAndWorker@}\n*                                                                      *\n************************************************************************\n\nHere's an example.  The original function is:\n\n\\begin{verbatim}\ng :: forall a . Int -> [a] -> a\n\ng = \\/\\ a -> \\ x ys ->\n        case x of\n          0 -> head ys\n          _ -> head (tail ys)\n\\end{verbatim}\n\nFrom this, we want to produce:\n\\begin{verbatim}\n-- wrapper (an unfolding)\ng :: forall a . Int -> [a] -> a\n\ng = \\/\\ a -> \\ x ys ->\n        case x of\n          I# x# -> $wg a x# ys\n            -- call the worker; don't forget the type args!\n\n-- worker\n$wg :: forall a . Int# -> [a] -> a\n\n$wg = \\/\\ a -> \\ x# ys ->\n        let\n            x = I# x#\n        in\n            case x of               -- note: body of g moved intact\n              0 -> head ys\n              _ -> head (tail ys)\n\\end{verbatim}\n\nSomething we have to be careful about:  Here's an example:\n\n\\begin{verbatim}\n-- \"f\" strictness: U(P)U(P)\nf (I# a) (I# b) = a +# b\n\ng = f   -- \"g\" strictness same as \"f\"\n\\end{verbatim}\n\n\\tr{f} will get a worker all nice and friendly-like; that's good.\n{\\em But we don't want a worker for \\tr{g}}, even though it has the\nsame strictness as \\tr{f}.  Doing so could break laziness, at best.\n\nConsequently, we insist that the number of strictness-info items is\nexactly the same as the number of lambda-bound arguments.  (This is\nprobably slightly paranoid, but OK in practice.)  If it isn't the\nsame, we ``revise'' the strictness info, so that we won't propagate\nthe unusable strictness-info into the interfaces.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{The worker wrapper core}\n*                                                                      *\n************************************************************************\n\n@mkWwBodies@ is called when doing the worker\\/wrapper split inside a module.\n-}\n\ntype WwResult\n  = ([Demand],              -- Demands for worker (value) args\n     JoinArity,             -- Number of worker (type OR value) args\n     Id -> CoreExpr,        -- Wrapper body, lacking only the worker Id\n     CoreExpr -> CoreExpr)  -- Worker body, lacking the original function rhs\n\nmkWwBodies :: DynFlags\n           -> FamInstEnvs\n           -> VarSet         -- Free vars of RHS\n                             -- See Note [Freshen WW arguments]\n           -> Id             -- The original function\n           -> [Demand]       -- Strictness of original function\n           -> DmdResult      -- Info about function result\n           -> UniqSM (Maybe WwResult)\n\n-- wrap_fn_args E       = \\x y -> E\n-- work_fn_args E       = E x y\n\n-- wrap_fn_str E        = case x of { (a,b) ->\n--                        case a of { (a1,a2) ->\n--                        E a1 a2 b y }}\n-- work_fn_str E        = \\a2 a2 b y ->\n--                        let a = (a1,a2) in\n--                        let x = (a,b) in\n--                        E\n\nmkWwBodies dflags fam_envs rhs_fvs fun_id demands res_info\n  = do  { let empty_subst = mkEmptyTCvSubst (mkInScopeSet rhs_fvs)\n                -- See Note [Freshen WW arguments]\n\n        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)\n             <- mkWWargs empty_subst fun_ty demands\n        ; (useful1, work_args, wrap_fn_str, work_fn_str)\n             <- mkWWstr dflags fam_envs has_inlineable_prag wrap_args\n\n        -- Do CPR w/w.  See Note [Always do CPR w/w]\n        ; (useful2, wrap_fn_cpr, work_fn_cpr, cpr_res_ty)\n              <- mkWWcpr (gopt Opt_CprAnal dflags) fam_envs res_ty res_info\n\n        ; let (work_lam_args, work_call_args) = mkWorkerArgs dflags work_args cpr_res_ty\n              worker_args_dmds = [idDemandInfo v | v <- work_call_args, isId v]\n              wrapper_body = wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var\n              worker_body = mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args\n\n        ; if isWorkerSmallEnough dflags work_args\n             && not (too_many_args_for_join_point wrap_args)\n             && ((useful1 && not only_one_void_argument) || useful2)\n          then return (Just (worker_args_dmds, length work_call_args,\n                       wrapper_body, worker_body))\n          else return Nothing\n        }\n        -- We use an INLINE unconditionally, even if the wrapper turns out to be\n        -- something trivial like\n        --      fw = ...\n        --      f = __inline__ (coerce T fw)\n        -- The point is to propagate the coerce to f's call sites, so even though\n        -- f's RHS is now trivial (size 1) we still want the __inline__ to prevent\n        -- fw from being inlined into f's RHS\n  where\n    fun_ty        = idType fun_id\n    mb_join_arity = isJoinId_maybe fun_id\n    has_inlineable_prag = isStableUnfolding (realIdUnfolding fun_id)\n                          -- See Note [Do not unpack class dictionaries]\n\n    -- Note [Do not split void functions]\n    only_one_void_argument\n      | [d] <- demands\n      , Just (arg_ty1, _) <- splitFunTy_maybe fun_ty\n      , isAbsDmd d && isVoidTy arg_ty1\n      = True\n      | otherwise\n      = False\n\n    -- Note [Join points returning functions]\n    too_many_args_for_join_point wrap_args\n      | Just join_arity <- mb_join_arity\n      , wrap_args `lengthExceeds` join_arity\n      = WARN(True, text \"Unable to worker/wrapper join point with arity \" <+>\n                     int join_arity <+> text \"but\" <+>\n                     int (length wrap_args) <+> text \"args\")\n        True\n      | otherwise\n      = False\n\n-- See Note [Limit w/w arity]\nisWorkerSmallEnough :: DynFlags -> [Var] -> Bool\nisWorkerSmallEnough dflags vars = count isId vars <= maxWorkerArgs dflags\n    -- We count only Free variables (isId) to skip Type, Kind\n    -- variables which have no runtime representation.\n\n{-\nNote [Always do CPR w/w]\n~~~~~~~~~~~~~~~~~~~~~~~~\nAt one time we refrained from doing CPR w/w for thunks, on the grounds that\nwe might duplicate work.  But that is already handled by the demand analyser,\nwhich doesn't give the CPR proprety if w/w might waste work: see\nNote [CPR for thunks] in DmdAnal.\n\nAnd if something *has* been given the CPR property and we don't w/w, it's\na disaster, because then the enclosing function might say it has the CPR\nproperty, but now doesn't and there a cascade of disaster.  A good example\nis Trac #5920.\n\nNote [Limit w/w arity]\n~~~~~~~~~~~~~~~~~~~~~~~~\nGuard against high worker arity as it generates a lot of stack traffic.\nA simplified example is Trac #11565#comment:6\n\nCurrent strategy is very simple: don't perform w/w transformation at all\nif the result produces a wrapper with arity higher than -fmax-worker-args=.\n\nIt is a bit all or nothing, consider\n\n        f (x,y) (a,b,c,d,e ... , z) = rhs\n\nCurrently we will remove all w/w ness entirely. But actually we could\nw/w on the (x,y) pair... it's the huge product that is the problem.\n\nCould we instead refrain from w/w on an arg-by-arg basis? Yes, that'd\nsolve f. But we can get a lot of args from deeply-nested products:\n\n        g (a, (b, (c, (d, ...)))) = rhs\n\nThis is harder to spot on an arg-by-arg basis. Previously mkWwStr was\ngiven some \"fuel\" saying how many arguments it could add; when we ran\nout of fuel it would stop w/wing.\nStill not very clever because it had a left-right bias.\n\n************************************************************************\n*                                                                      *\n\\subsection{Making wrapper args}\n*                                                                      *\n************************************************************************\n\nDuring worker-wrapper stuff we may end up with an unlifted thing\nwhich we want to let-bind without losing laziness.  So we\nadd a void argument.  E.g.\n\n        f = /\\a -> \\x y z -> E::Int#    -- E does not mention x,y,z\n==>\n        fw = /\\ a -> \\void -> E\n        f  = /\\ a -> \\x y z -> fw realworld\n\nWe use the state-token type which generates no code.\n-}\n\nmkWorkerArgs :: DynFlags -> [Var]\n             -> Type    -- Type of body\n             -> ([Var], -- Lambda bound args\n                 [Var]) -- Args at call site\nmkWorkerArgs dflags args res_ty\n    | any isId args || not needsAValueLambda\n    = (args, args)\n    | otherwise\n    = (args ++ [voidArgId], args ++ [voidPrimId])\n    where\n      -- See \"Making wrapper args\" section above\n      needsAValueLambda =\n        lifted\n        -- We may encounter a levity-polymorphic result, in which case we\n        -- conservatively assume that we have laziness that needs preservation.\n        -- See #15186.\n        || not (gopt Opt_FunToThunk dflags)\n           -- see Note [Protecting the last value argument]\n\n      -- Might the result be lifted?\n      lifted =\n        case isLiftedType_maybe res_ty of\n          Just lifted -> lifted\n          Nothing     -> True\n\n{-\nNote [Protecting the last value argument]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the user writes (\\_ -> E), they might be intentionally disallowing\nthe sharing of E. Since absence analysis and worker-wrapper are keen\nto remove such unused arguments, we add in a void argument to prevent\nthe function from becoming a thunk.\n\nThe user can avoid adding the void argument with the -ffun-to-thunk\nflag. However, this can create sharing, which may be bad in two ways. 1) It can\ncreate a space leak. 2) It can prevent inlining *under a lambda*. If w/w\nremoves the last argument from a function f, then f now looks like a thunk, and\nso f can't be inlined *under a lambda*.\n\nNote [Join points and beta-redexes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nOriginally, the worker would invoke the original function by calling it with\narguments, thus producing a beta-redex for the simplifier to munch away:\n\n  \\x y z -> e => (\\x y z -> e) wx wy wz\n\nNow that we have special rules about join points, however, this is Not Good if\nthe original function is itself a join point, as then it may contain invocations\nof other join points:\n\n  join j1 x = ...\n  join j2 y = if y == 0 then 0 else j1 y\n\n  =>\n\n  join j1 x = ...\n  join $wj2 y# = let wy = I# y# in (\\y -> if y == 0 then 0 else jump j1 y) wy\n  join j2 y = case y of I# y# -> jump $wj2 y#\n\nThere can't be an intervening lambda between a join point's declaration and its\noccurrences, so $wj2 here is wrong. But of course, this is easy enough to fix:\n\n  ...\n  let join $wj2 y# = let wy = I# y# in let y = wy in if y == 0 then 0 else j1 y\n  ...\n\nHence we simply do the beta-reduction here. (This would be harder if we had to\nworry about hygiene, but luckily wy is freshly generated.)\n\nNote [Join points returning functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIt is crucial that the arity of a join point depends on its *callers,* not its\nown syntax. What this means is that a join point can have \"extra lambdas\":\n\nf :: Int -> Int -> (Int, Int) -> Int\nf x y = join j (z, w) = \\(u, v) -> ...\n        in jump j (x, y)\n\nTypically this happens with functions that are seen as computing functions,\nrather than being curried. (The real-life example was GraphOps.addConflicts.)\n\nWhen we create the wrapper, it *must* be in \"eta-contracted\" form so that the\njump has the right number of arguments:\n\nf x y = join $wj z' w' = \\u' v' -> let {z = z'; w = w'; u = u'; v = v'} in ...\n             j (z, w)  = jump $wj z w\n\n(See Note [Join points and beta-redexes] for where the lets come from.) If j\nwere a function, we would instead say\n\nf x y = let $wj = \\z' w' u' v' -> let {z = z'; w = w'; u = u'; v = v'} in ...\n            j (z, w) (u, v) = $wj z w u v\n\nNotice that the worker ends up with the same lambdas; it's only the wrapper we\nhave to be concerned about.\n\nFIXME Currently the functionality to produce \"eta-contracted\" wrappers is\nunimplemented; we simply give up.\n\n************************************************************************\n*                                                                      *\n\\subsection{Coercion stuff}\n*                                                                      *\n************************************************************************\n\nWe really want to \"look through\" coerces.\nReason: I've seen this situation:\n\n        let f = coerce T (\\s -> E)\n        in \\x -> case x of\n                    p -> coerce T' f\n                    q -> \\s -> E2\n                    r -> coerce T' f\n\nIf only we w/w'd f, we'd get\n        let f = coerce T (\\s -> fw s)\n            fw = \\s -> E\n        in ...\n\nNow we'll inline f to get\n\n        let fw = \\s -> E\n        in \\x -> case x of\n                    p -> fw\n                    q -> \\s -> E2\n                    r -> fw\n\nNow we'll see that fw has arity 1, and will arity expand\nthe \\x to get what we want.\n-}\n\n-- mkWWargs just does eta expansion\n-- is driven off the function type and arity.\n-- It chomps bites off foralls, arrows, newtypes\n-- and keeps repeating that until it's satisfied the supplied arity\n\nmkWWargs :: TCvSubst            -- Freshening substitution to apply to the type\n                                --   See Note [Freshen WW arguments]\n         -> Type                -- The type of the function\n         -> [Demand]     -- Demands and one-shot info for value arguments\n         -> UniqSM  ([Var],            -- Wrapper args\n                     CoreExpr -> CoreExpr,      -- Wrapper fn\n                     CoreExpr -> CoreExpr,      -- Worker fn\n                     Type)                      -- Type of wrapper body\n\nmkWWargs subst fun_ty demands\n  | null demands\n  = return ([], id, id, substTy subst fun_ty)\n\n  | (dmd:demands') <- demands\n  , Just (arg_ty, fun_ty') <- splitFunTy_maybe fun_ty\n  = do  { uniq <- getUniqueM\n        ; let arg_ty' = substTy subst arg_ty\n              id = mk_wrap_arg uniq arg_ty' dmd\n        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)\n              <- mkWWargs subst fun_ty' demands'\n        ; return (id : wrap_args,\n                  Lam id . wrap_fn_args,\n                  apply_or_bind_then work_fn_args (varToCoreExpr id),\n                  res_ty) }\n\n  | Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty\n  = do  { uniq <- getUniqueM\n        ; let (subst', tv') = cloneTyVarBndr subst tv uniq\n                -- See Note [Freshen WW arguments]\n        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)\n             <- mkWWargs subst' fun_ty' demands\n        ; return (tv' : wrap_args,\n                  Lam tv' . wrap_fn_args,\n                  apply_or_bind_then work_fn_args (mkTyArg (mkTyVarTy tv')),\n                  res_ty) }\n\n  | Just (co, rep_ty) <- topNormaliseNewType_maybe fun_ty\n        -- The newtype case is for when the function has\n        -- a newtype after the arrow (rare)\n        --\n        -- It's also important when we have a function returning (say) a pair\n        -- wrapped in a  newtype, at least if CPR analysis can look\n        -- through such newtypes, which it probably can since they are\n        -- simply coerces.\n\n  = do { (wrap_args, wrap_fn_args, work_fn_args, res_ty)\n            <-  mkWWargs subst rep_ty demands\n       ; let co' = substCo subst co\n       ; return (wrap_args,\n                  \\e -> Cast (wrap_fn_args e) (mkSymCo co'),\n                  \\e -> work_fn_args (Cast e co'),\n                  res_ty) }\n\n  | otherwise\n  = WARN( True, ppr fun_ty )                    -- Should not happen: if there is a demand\n    return ([], id, id, substTy subst fun_ty)   -- then there should be a function arrow\n  where\n    -- See Note [Join points and beta-redexes]\n    apply_or_bind_then k arg (Lam bndr body)\n      = mkCoreLet (NonRec bndr arg) (k body)    -- Important that arg is fresh!\n    apply_or_bind_then k arg fun\n      = k $ mkCoreApp (text \"mkWWargs\") fun arg\napplyToVars :: [Var] -> CoreExpr -> CoreExpr\napplyToVars vars fn = mkVarApps fn vars\n\nmk_wrap_arg :: Unique -> Type -> Demand -> Id\nmk_wrap_arg uniq ty dmd\n  = mkSysLocalOrCoVar (fsLit \"w\") uniq ty\n       `setIdDemandInfo` dmd\n\n{- Note [Freshen WW arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWen we do a worker/wrapper split, we must not in-scope names as the arguments\nof the worker, else we'll get name capture.  E.g.\n\n   -- y1 is in scope from further out\n   f x = ..y1..\n\nIf we accidentally choose y1 as a worker argument disaster results:\n\n   fww y1 y2 = let x = (y1,y2) in ...y1...\n\nTo avoid this:\n\n  * We use a fresh unique for both type-variable and term-variable binders\n    Originally we lacked this freshness for type variables, and that led\n    to the very obscure Trac #12562.  (A type variable in the worker shadowed\n    an outer term-variable binding.)\n\n  * Because of this cloning we have to substitute in the type/kind of the\n    new binders.  That's why we carry the TCvSubst through mkWWargs.\n\n    So we need a decent in-scope set, just in case that type/kind\n    itself has foralls.  We get this from the free vars of the RHS of the\n    function since those are the only variables that might be captured.\n    It's a lazy thunk, which will only be poked if the type/kind has a forall.\n\n    Another tricky case was when f :: forall a. a -> forall a. a->a\n    (i.e. with shadowing), and then the worker used the same 'a' twice.\n\n************************************************************************\n*                                                                      *\n\\subsection{Strictness stuff}\n*                                                                      *\n************************************************************************\n-}\n\nmkWWstr :: DynFlags\n        -> FamInstEnvs\n        -> Bool    -- True <=> INLINEABLE pragma on this function defn\n                   -- See Note [Do not unpack class dictionaries]\n        -> [Var]                                -- Wrapper args; have their demand info on them\n                                                --  *Includes type variables*\n        -> UniqSM (Bool,                        -- Is this useful\n                   [Var],                       -- Worker args\n                   CoreExpr -> CoreExpr,        -- Wrapper body, lacking the worker call\n                                                -- and without its lambdas\n                                                -- This fn adds the unboxing\n\n                   CoreExpr -> CoreExpr)        -- Worker body, lacking the original body of the function,\n                                                -- and lacking its lambdas.\n                                                -- This fn does the reboxing\nmkWWstr dflags fam_envs has_inlineable_prag args\n  = go args\n  where\n    go_one arg = mkWWstr_one dflags fam_envs has_inlineable_prag arg\n\n    go []           = return (False, [], nop_fn, nop_fn)\n    go (arg : args) = do { (useful1, args1, wrap_fn1, work_fn1) <- go_one arg\n                         ; (useful2, args2, wrap_fn2, work_fn2) <- go args\n                         ; return ( useful1 || useful2\n                                  , args1 ++ args2\n                                  , wrap_fn1 . wrap_fn2\n                                  , work_fn1 . work_fn2) }\n\n{-\nNote [Unpacking arguments with product and polymorphic demands]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe argument is unpacked in a case if it has a product type and has a\nstrict *and* used demand put on it. I.e., arguments, with demands such\nas the following ones:\n\n   <S,U(U, L)>\n   <S(L,S),U>\n\nwill be unpacked, but\n\n   <S,U> or <B,U>\n\nwill not, because the pieces aren't used. This is quite important otherwise\nwe end up unpacking massive tuples passed to the bottoming function. Example:\n\n        f :: ((Int,Int) -> String) -> (Int,Int) -> a\n        f g pr = error (g pr)\n\n        main = print (f fst (1, error \"no\"))\n\nDoes 'main' print \"error 1\" or \"error no\"?  We don't really want 'f'\nto unbox its second argument.  This actually happened in GHC's onwn\nsource code, in Packages.applyPackageFlag, which ended up un-boxing\nthe enormous DynFlags tuple, and being strict in the\nas-yet-un-filled-in pkgState files.\n-}\n\n----------------------\n-- mkWWstr_one wrap_arg = (useful, work_args, wrap_fn, work_fn)\n--   *  wrap_fn assumes wrap_arg is in scope,\n--        brings into scope work_args (via cases)\n--   * work_fn assumes work_args are in scope, a\n--        brings into scope wrap_arg (via lets)\n-- See Note [How to do the worker/wrapper split]\nmkWWstr_one :: DynFlags -> FamInstEnvs\n            -> Bool    -- True <=> INLINEABLE pragma on this function defn\n                       -- See Note [Do not unpack class dictionaries]\n            -> Var\n            -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr)\nmkWWstr_one dflags fam_envs has_inlineable_prag arg\n  | isTyVar arg\n  = return (False, [arg],  nop_fn, nop_fn)\n\n  | isAbsDmd dmd\n  , Just work_fn <- mk_absent_let dflags arg\n     -- Absent case.  We can't always handle absence for arbitrary\n     -- unlifted types, so we need to choose just the cases we can\n     -- (that's what mk_absent_let does)\n  = return (True, [], nop_fn, work_fn)\n\n  | isStrictDmd dmd\n  , Just cs <- splitProdDmd_maybe dmd\n      -- See Note [Unpacking arguments with product and polymorphic demands]\n  , not (has_inlineable_prag && isClassPred arg_ty)\n      -- See Note [Do not unpack class dictionaries]\n  , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty\n  , cs `equalLength` inst_con_arg_tys\n      -- See Note [mkWWstr and unsafeCoerce]\n  = unbox_one dflags fam_envs arg cs stuff\n\n  | isSeqDmd dmd   -- For seqDmd, splitProdDmd_maybe will return Nothing, but\n                   -- it should behave like <S, U(AAAA)>, for some suitable arity\n  , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty\n  , let abs_dmds = map (const absDmd) inst_con_arg_tys\n  = unbox_one dflags fam_envs arg abs_dmds stuff\n\n  | otherwise   -- Other cases\n  = return (False, [arg], nop_fn, nop_fn)\n\n  where\n    arg_ty = idType arg\n    dmd    = idDemandInfo arg\n\nunbox_one :: DynFlags -> FamInstEnvs -> Var\n          -> [Demand]\n          -> (DataCon, [Type], [(Type, StrictnessMark)], Coercion)\n          -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr)\nunbox_one dflags fam_envs arg cs\n          (data_con, inst_tys, inst_con_arg_tys, co)\n  = do { (uniq1:uniqs) <- getUniquesM\n        ; let   -- See Note [Add demands for strict constructors]\n                cs'       = addDataConStrictness data_con cs\n                unpk_args = zipWith3 mk_ww_arg uniqs inst_con_arg_tys cs'\n                unbox_fn  = mkUnpackCase (Var arg) co uniq1\n                                         data_con unpk_args\n                arg_no_unf = zapStableUnfolding arg\n                             -- See Note [Zap unfolding when beta-reducing]\n                             -- in Simplify.hs; and see Trac #13890\n                rebox_fn   = Let (NonRec arg_no_unf con_app)\n                con_app    = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co\n         ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args\n         ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) }\n                           -- Don't pass the arg, rebox instead\n  where\n    mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd\n\n----------------------\nnop_fn :: CoreExpr -> CoreExpr\nnop_fn body = body\n\naddDataConStrictness :: DataCon -> [Demand] -> [Demand]\n-- See Note [Add demands for strict constructors]\naddDataConStrictness con ds\n  = ASSERT2( equalLength strs ds, ppr con $$ ppr strs $$ ppr ds )\n    zipWith add ds strs\n  where\n    strs = dataConRepStrictness con\n    add dmd str | isMarkedStrict str = strictifyDmd dmd\n                | otherwise          = dmd\n\n{- Note [How to do the worker/wrapper split]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe worker-wrapper transformation, mkWWstr_one, takes into account\nseveral possibilities to decide if the function is worthy for\nsplitting:\n\n1. If an argument is absent, it would be silly to pass it to\n   the worker.  Hence the isAbsDmd case.  This case must come\n   first because a demand like <S,A> or <B,A> is possible.\n   E.g. <B,A> comes from a function like\n       f x = error \"urk\"\n   and <S,A> can come from Note [Add demands for strict constructors]\n\n2. If the argument is evaluated strictly, and we can split the\n   product demand (splitProdDmd_maybe), then unbox it and w/w its\n   pieces.  For example\n\n    f :: (Int, Int) -> Int\n    f p = (case p of (a,b) -> a) + 1\n  is split to\n    f :: (Int, Int) -> Int\n    f p = case p of (a,b) -> $wf a\n\n    $wf :: Int -> Int\n    $wf a = a + 1\n\n  and\n    g :: Bool -> (Int, Int) -> Int\n    g c p = case p of (a,b) ->\n               if c then a else b\n  is split to\n   g c p = case p of (a,b) -> $gw c a b\n   $gw c a b = if c then a else b\n\n2a But do /not/ split if the components are not used; that is, the\n   usage is just 'Used' rather than 'UProd'. In this case\n   splitProdDmd_maybe returns Nothing.  Otherwise we risk decomposing\n   a massive tuple which is barely used.  Example:\n\n        f :: ((Int,Int) -> String) -> (Int,Int) -> a\n        f g pr = error (g pr)\n\n        main = print (f fst (1, error \"no\"))\n\n   Here, f does not take 'pr' apart, and it's stupid to do so.\n   Imagine that it had millions of fields. This actually happened\n   in GHC itself where the tuple was DynFlags\n\n3. A plain 'seqDmd', which is head-strict with usage UHead, can't\n   be split by splitProdDmd_maybe.  But we want it to behave just\n   like U(AAAA) for suitable number of absent demands. So we have\n   a special case for it, with arity coming from the data constructor.\n\nNote [Worker-wrapper for bottoming functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used not to split if the result is bottom.\n[Justification:  there's no efficiency to be gained.]\n\nBut it's sometimes bad not to make a wrapper.  Consider\n        fw = \\x# -> let x = I# x# in case e of\n                                        p1 -> error_fn x\n                                        p2 -> error_fn x\n                                        p3 -> the real stuff\nThe re-boxing code won't go away unless error_fn gets a wrapper too.\n[We don't do reboxing now, but in general it's better to pass an\nunboxed thing to f, and have it reboxed in the error cases....]\n\nNote [Add demands for strict constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this program (due to Roman):\n\n    data X a = X !a\n\n    foo :: X Int -> Int -> Int\n    foo (X a) n = go 0\n     where\n       go i | i < n     = a + go (i+1)\n            | otherwise = 0\n\nWe want the worker for 'foo' too look like this:\n\n    $wfoo :: Int# -> Int# -> Int#\n\nwith the first argument unboxed, so that it is not eval'd each time\naround the 'go' loop (which would otherwise happen, since 'foo' is not\nstrict in 'a').  It is sound for the wrapper to pass an unboxed arg\nbecause X is strict, so its argument must be evaluated.  And if we\n*don't* pass an unboxed argument, we can't even repair it by adding a\n`seq` thus:\n\n    foo (X a) n = a `seq` go 0\n\nbecause the seq is discarded (very early) since X is strict!\n\nSo here's what we do\n\n* We leave the demand-analysis alone.  The demand on 'a' in the\n  definition of 'foo' is <L, U(U)>; the strictness info is Lazy\n  because foo's body may or may not evaluate 'a'; but the usage info\n  says that 'a' is unpacked and its content is used.\n\n* During worker/wrapper, if we unpack a strict constructor (as we do\n  for 'foo'), we use 'addDataConStrictness' to bump up the strictness on\n  the strict arguments of the data constructor.\n\n* That in turn means that, if the usage info supports doing so\n  (i.e. splitProdDmd_maybe returns Just), we will unpack that argument\n  -- even though the original demand (e.g. on 'a') was lazy.\n\n* What does \"bump up the strictness\" mean?  Just add a head-strict\n  demand to the strictness!  Even for a demand like <L,A> we can\n  safely turn it into <S,A>; remember case (1) of\n  Note [How to do the worker/wrapper split].\n\nThe net effect is that the w/w transformation is more aggressive about\nunpacking the strict arguments of a data constructor, when that\neagerness is supported by the usage info.\n\nThere is the usual danger of reboxing, which as usual we ignore. But\nif X is monomorphic, and has an UNPACK pragma, then this optimisation\nis even more important.  We don't want the wrapper to rebox an unboxed\nargument, and pass an Int to $wfoo!\n\nThis works in nested situations like\n\n    data family Bar a\n    data instance Bar (a, b) = BarPair !(Bar a) !(Bar b)\n    newtype instance Bar Int = Bar Int\n\n    foo :: Bar ((Int, Int), Int) -> Int -> Int\n    foo f k = case f of BarPair x y ->\n              case burble of\n                 True -> case x of\n                           BarPair p q -> ...\n                 False -> ...\n\nThe extra eagerness lets us produce a worker of type:\n     $wfoo :: Int# -> Int# -> Int# -> Int -> Int\n     $wfoo p# q# y# = ...\n\neven though the `case x` is only lazily evaluated.\n\n--------- Historical note ------------\nWe used to add data-con strictness demands when demand analysing case\nexpression. However, it was noticed in #15696 that this misses some cases. For\ninstance, consider the program (from T10482)\n\n    data family Bar a\n    data instance Bar (a, b) = BarPair !(Bar a) !(Bar b)\n    newtype instance Bar Int = Bar Int\n\n    foo :: Bar ((Int, Int), Int) -> Int -> Int\n    foo f k =\n      case f of\n        BarPair x y -> case burble of\n                          True -> case x of\n                                    BarPair p q -> ...\n                          False -> ...\n\nWe really should be able to assume that `p` is already evaluated since it came\nfrom a strict field of BarPair. This strictness would allow us to produce a\nworker of type:\n\n    $wfoo :: Int# -> Int# -> Int# -> Int -> Int\n    $wfoo p# q# y# = ...\n\neven though the `case x` is only lazily evaluated\n\nIndeed before we fixed #15696 this would happen since we would float the inner\n`case x` through the `case burble` to get:\n\n    foo f k =\n      case f of\n        BarPair x y -> case x of\n                          BarPair p q -> case burble of\n                                          True -> ...\n                                          False -> ...\n\nHowever, after fixing #15696 this could no longer happen (for the reasons\ndiscussed in ticket:15696#comment:76). This means that the demand placed on `f`\nwould then be significantly weaker (since the False branch of the case on\n`burble` is not strict in `p` or `q`).\n\nConsequently, we now instead account for data-con strictness in mkWWstr_one,\napplying the strictness demands to the final result of DmdAnal. The result is\nthat we get the strict demand signature we wanted even if we can't float\nthe case on `x` up through the case on `burble`.\n\n\nNote [mkWWstr and unsafeCoerce]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBy using unsafeCoerce, it is possible to make the number of demands fail to\nmatch the number of constructor arguments; this happened in Trac #8037.\nIf so, the worker/wrapper split doesn't work right and we get a Core Lint\nbug.  The fix here is simply to decline to do w/w if that happens.\n\nNote [Record evaluated-ness in worker/wrapper]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n   data T = MkT !Int Int\n\n   f :: T -> T\n   f x = e\n\nand f's is strict, and has the CPR property.  The we are going to generate\nthis w/w split\n\n   f x = case x of\n           MkT x1 x2 -> case $wf x1 x2 of\n                           (# r1, r2 #) -> MkT r1 r2\n\n   $wfw x1 x2 = let x = MkT x1 x2 in\n                case e of\n                  MkT r1 r2 -> (# r1, r2 #)\n\nNote that\n\n* In the worker $wf, inside 'e' we can be sure that x1 will be\n  evaluated (it came from unpacking the argument MkT.  But that's no\n  immediately apparent in $wf\n\n* In the wrapper 'f', which we'll inline at call sites, we can be sure\n  that 'r1' has been evaluated (because it came from unpacking the result\n  MkT.  But that is not immediately apparent from the wrapper code.\n\nMissing these facts isn't unsound, but it loses possible future\nopportunities for optimisation.\n\nSolution: use setCaseBndrEvald when creating\n (A) The arg binders x1,x2 in mkWstr_one\n         See Trac #13077, test T13077\n (B) The result binders r1,r2 in mkWWcpr_help\n         See Trace #13077, test T13077a\n         And Trac #13027 comment:20, item (4)\nto record that the relevant binder is evaluated.\n\n\n************************************************************************\n*                                                                      *\n         Type scrutiny that is specific to demand analysis\n*                                                                      *\n************************************************************************\n\nNote [Do not unpack class dictionaries]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have\n   f :: Ord a => [a] -> Int -> a\n   {-# INLINABLE f #-}\nand we worker/wrapper f, we'll get a worker with an INLINABLE pragma\n(see Note [Worker-wrapper for INLINABLE functions] in WorkWrap), which\ncan still be specialised by the type-class specialiser, something like\n   fw :: Ord a => [a] -> Int# -> a\n\nBUT if f is strict in the Ord dictionary, we might unpack it, to get\n   fw :: (a->a->Bool) -> [a] -> Int# -> a\nand the type-class specialiser can't specialise that.  An example is\nTrac #6056.\n\nBut in any other situation a dictionary is just an ordinary value,\nand can be unpacked.  So we track the INLINABLE pragma, and switch\noff the unpacking in mkWWstr_one (see the isClassPred test).\n\nHistorical note: Trac #14955 describes how I got this fix wrong\nthe first time.\n-}\n\ndeepSplitProductType_maybe\n    :: FamInstEnvs -> Type\n    -> Maybe (DataCon, [Type], [(Type, StrictnessMark)], Coercion)\n-- If    deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co)\n-- then  dc @ tys (args::arg_tys) :: rep_ty\n--       co :: ty ~ rep_ty\n-- Why do we return the strictness of the data-con arguments?\n-- Answer: see Note [Record evaluated-ness in worker/wrapper]\ndeepSplitProductType_maybe fam_envs ty\n  | let (co, ty1) = topNormaliseType_maybe fam_envs ty\n                    `orElse` (mkRepReflCo ty, ty)\n  , Just (tc, tc_args) <- splitTyConApp_maybe ty1\n  , Just con <- isDataProductTyCon_maybe tc\n  , let arg_tys = dataConInstArgTys con tc_args\n        strict_marks = dataConRepStrictness con\n  = Just (con, tc_args, zipEqual \"dspt\" arg_tys strict_marks, co)\ndeepSplitProductType_maybe _ _ = Nothing\n\ndeepSplitCprType_maybe\n    :: FamInstEnvs -> ConTag -> Type\n    -> Maybe (DataCon, [Type], [(Type, StrictnessMark)], Coercion)\n-- If    deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co)\n-- then  dc @ tys (args::arg_tys) :: rep_ty\n--       co :: ty ~ rep_ty\n-- Why do we return the strictness of the data-con arguments?\n-- Answer: see Note [Record evaluated-ness in worker/wrapper]\ndeepSplitCprType_maybe fam_envs con_tag ty\n  | let (co, ty1) = topNormaliseType_maybe fam_envs ty\n                    `orElse` (mkRepReflCo ty, ty)\n  , Just (tc, tc_args) <- splitTyConApp_maybe ty1\n  , isDataTyCon tc\n  , let cons = tyConDataCons tc\n  , cons `lengthAtLeast` con_tag -- This might not be true if we import the\n                                 -- type constructor via a .hs-bool file (#8743)\n  , let con = cons `getNth` (con_tag - fIRST_TAG)\n        arg_tys = dataConInstArgTys con tc_args\n        strict_marks = dataConRepStrictness con\n  = Just (con, tc_args, zipEqual \"dsct\" arg_tys strict_marks, co)\ndeepSplitCprType_maybe _ _ _ = Nothing\n\nfindTypeShape :: FamInstEnvs -> Type -> TypeShape\n-- Uncover the arrow and product shape of a type\n-- The data type TypeShape is defined in Demand\n-- See Note [Trimming a demand to a type] in Demand\nfindTypeShape fam_envs ty\n  | Just (tc, tc_args)  <- splitTyConApp_maybe ty\n  , Just con <- isDataProductTyCon_maybe tc\n  = TsProd (map (findTypeShape fam_envs) $ dataConInstArgTys con tc_args)\n\n  | Just (_, res) <- splitFunTy_maybe ty\n  = TsFun (findTypeShape fam_envs res)\n\n  | Just (_, ty') <- splitForAllTy_maybe ty\n  = findTypeShape fam_envs ty'\n\n  | Just (_, ty') <- topNormaliseType_maybe fam_envs ty\n  = findTypeShape fam_envs ty'\n\n  | otherwise\n  = TsUnk\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{CPR stuff}\n*                                                                      *\n************************************************************************\n\n\n@mkWWcpr@ takes the worker/wrapper pair produced from the strictness\ninfo and adds in the CPR transformation.  The worker returns an\nunboxed tuple containing non-CPR components.  The wrapper takes this\ntuple and re-produces the correct structured output.\n\nThe non-CPR results appear ordered in the unboxed tuple as if by a\nleft-to-right traversal of the result structure.\n-}\n\nmkWWcpr :: Bool\n        -> FamInstEnvs\n        -> Type                              -- function body type\n        -> DmdResult                         -- CPR analysis results\n        -> UniqSM (Bool,                     -- Is w/w'ing useful?\n                   CoreExpr -> CoreExpr,     -- New wrapper\n                   CoreExpr -> CoreExpr,     -- New worker\n                   Type)                     -- Type of worker's body\n\nmkWWcpr opt_CprAnal fam_envs body_ty res\n    -- CPR explicitly turned off (or in -O0)\n  | not opt_CprAnal = return (False, id, id, body_ty)\n    -- CPR is turned on by default for -O and O2\n  | otherwise\n  = case returnsCPR_maybe res of\n       Nothing      -> return (False, id, id, body_ty)  -- No CPR info\n       Just con_tag | Just stuff <- deepSplitCprType_maybe fam_envs con_tag body_ty\n                    -> mkWWcpr_help stuff\n                    |  otherwise\n                       -- See Note [non-algebraic or open body type warning]\n                    -> WARN( True, text \"mkWWcpr: non-algebraic or open body type\" <+> ppr body_ty )\n                       return (False, id, id, body_ty)\n\nmkWWcpr_help :: (DataCon, [Type], [(Type,StrictnessMark)], Coercion)\n             -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type)\n\nmkWWcpr_help (data_con, inst_tys, arg_tys, co)\n  | [arg1@(arg_ty1, _)] <- arg_tys\n  , isUnliftedType arg_ty1\n        -- Special case when there is a single result of unlifted type\n        --\n        -- Wrapper:     case (..call worker..) of x -> C x\n        -- Worker:      case (   ..body..    ) of C x -> x\n  = do { (work_uniq : arg_uniq : _) <- getUniquesM\n       ; let arg       = mk_ww_local arg_uniq arg1\n             con_app   = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co\n\n       ; return ( True\n                , \\ wkr_call -> Case wkr_call arg (exprType con_app) [(DEFAULT, [], con_app)]\n                , \\ body     -> mkUnpackCase body co work_uniq data_con [arg] (varToCoreExpr arg)\n                                -- varToCoreExpr important here: arg can be a coercion\n                                -- Lacking this caused Trac #10658\n                , arg_ty1 ) }\n\n  | otherwise   -- The general case\n        -- Wrapper: case (..call worker..) of (# a, b #) -> C a b\n        -- Worker:  case (   ...body...  ) of C a b -> (# a, b #)\n  = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM\n       ; let wrap_wild   = mk_ww_local wild_uniq (ubx_tup_ty,MarkedStrict)\n             args        = zipWith mk_ww_local uniqs arg_tys\n             ubx_tup_ty  = exprType ubx_tup_app\n             ubx_tup_app = mkCoreUbxTup (map fst arg_tys) (map varToCoreExpr args)\n             con_app     = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co\n\n       ; return (True\n                , \\ wkr_call -> Case wkr_call wrap_wild (exprType con_app)  [(DataAlt (tupleDataCon Unboxed (length arg_tys)), args, con_app)]\n                , \\ body     -> mkUnpackCase body co work_uniq data_con args ubx_tup_app\n                , ubx_tup_ty ) }\n\nmkUnpackCase ::  CoreExpr -> Coercion -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr\n-- (mkUnpackCase e co uniq Con args body)\n--      returns\n-- case e |> co of bndr { Con args -> body }\n\nmkUnpackCase (Tick tickish e) co uniq con args body   -- See Note [Profiling and unpacking]\n  = Tick tickish (mkUnpackCase e co uniq con args body)\nmkUnpackCase scrut co uniq boxing_con unpk_args body\n  = Case casted_scrut bndr (exprType body)\n         [(DataAlt boxing_con, unpk_args, body)]\n  where\n    casted_scrut = scrut `mkCast` co\n    bndr = mk_ww_local uniq (exprType casted_scrut, MarkedStrict)\n\n{-\nNote [non-algebraic or open body type warning]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThere are a few cases where the W/W transformation is told that something\nreturns a constructor, but the type at hand doesn't really match this. One\nreal-world example involves unsafeCoerce:\n  foo = IO a\n  foo = unsafeCoerce c_exit\n  foreign import ccall \"c_exit\" c_exit :: IO ()\nHere CPR will tell you that `foo` returns a () constructor for sure, but trying\nto create a worker/wrapper for type `a` obviously fails.\n(This was a real example until ee8e792  in libraries/base.)\n\nIt does not seem feasible to avoid all such cases already in the analyser (and\nafter all, the analysis is not really wrong), so we simply do nothing here in\nmkWWcpr. But we still want to emit warning with -DDEBUG, to hopefully catch\nother cases where something went avoidably wrong.\n\n\nNote [Profiling and unpacking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the original function looked like\n        f = \\ x -> {-# SCC \"foo\" #-} E\n\nthen we want the CPR'd worker to look like\n        \\ x -> {-# SCC \"foo\" #-} (case E of I# x -> x)\nand definitely not\n        \\ x -> case ({-# SCC \"foo\" #-} E) of I# x -> x)\n\nThis transform doesn't move work or allocation\nfrom one cost centre to another.\n\nLater [SDM]: presumably this is because we want the simplifier to\neliminate the case, and the scc would get in the way?  I'm ok with\nincluding the case itself in the cost centre, since it is morally\npart of the function (post transformation) anyway.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Utilities}\n*                                                                      *\n************************************************************************\n\nNote [Absent errors]\n~~~~~~~~~~~~~~~~~~~~\nWe make a new binding for Ids that are marked absent, thus\n   let x = absentError \"x :: Int\"\nThe idea is that this binding will never be used; but if it\nbuggily is used we'll get a runtime error message.\n\nCoping with absence for *unlifted* types is important; see, for\nexample, Trac #4306 and Trac #15627.  In the UnliftedRep case, we can\nuse LitRubbish, which we need to apply to the required type.\nFor the unlifted types of singleton kind like Float#, Addr#, etc. we\nalso find a suitable literal, using Literal.absentLiteralOf.  We don't\nhave literals for every primitive type, so the function is partial.\n\nNote: I did try the experiment of using an error thunk for unlifted\nthings too, relying on the simplifier to drop it as dead code.\nBut this is fragile\n\n - It fails when profiling is on, which disables various optimisations\n\n - It fails when reboxing happens. E.g.\n      data T = MkT Int Int#\n      f p@(MkT a _) = ...g p....\n   where g is /lazy/ in 'p', but only uses the first component.  Then\n   'f' is /strict/ in 'p', and only uses the first component.  So we only\n   pass that component to the worker for 'f', which reconstructs 'p' to\n   pass it to 'g'.  Alas we can't say\n       ...f (MkT a (absentError Int# \"blah\"))...\n   bacause `MkT` is strict in its Int# argument, so we get an absentError\n   exception when we shouldn't.  Very annoying!\n\nSo absentError is only used for lifted types.\n-}\n\n-- | Tries to find a suitable dummy RHS to bind the given absent identifier to.\n--\n-- If @mk_absent_let _ id == Just wrap@, then @wrap e@ will wrap a let binding\n-- for @id@ with that RHS around @e@. Otherwise, there could no suitable RHS be\n-- found (currently only happens for bindings of 'VecRep' representation).\nmk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr)\nmk_absent_let dflags arg\n  -- The lifted case: Bind 'absentError'\n  -- See Note [Absent errors]\n  | not (isUnliftedType arg_ty)\n  = Just (Let (NonRec lifted_arg abs_rhs))\n  -- The 'UnliftedRep' (because polymorphic) case: Bind @__RUBBISH \\@arg_ty@\n  -- See Note [Absent errors]\n  | [UnliftedRep] <- typePrimRep arg_ty\n  = Just (Let (NonRec arg unlifted_rhs))\n  -- The monomorphic unlifted cases: Bind to some literal, if possible\n  -- See Note [Absent errors]\n  | Just tc <- tyConAppTyCon_maybe arg_ty\n  , Just lit <- absentLiteralOf tc\n  = Just (Let (NonRec arg (Lit lit)))\n  | arg_ty `eqType` voidPrimTy\n  = Just (Let (NonRec arg (Var voidPrimId)))\n  | otherwise\n  = WARN( True, text \"No absent value for\" <+> ppr arg_ty )\n    Nothing -- Can happen for 'State#' and things of 'VecRep'\n  where\n    lifted_arg   = arg `setIdStrictness` botSig\n              -- Note in strictness signature that this is bottoming\n              -- (for the sake of the \"empty case scrutinee not known to\n              -- diverge for sure lint\" warning)\n    arg_ty       = idType arg\n    abs_rhs      = mkAbsentErrorApp arg_ty msg\n    msg          = showSDoc (gopt_set dflags Opt_SuppressUniques)\n                          (ppr arg <+> ppr (idType arg))\n              -- We need to suppress uniques here because otherwise they'd\n              -- end up in the generated code as strings. This is bad for\n              -- determinism, because with different uniques the strings\n              -- will have different lengths and hence different costs for\n              -- the inliner leading to different inlining.\n              -- See also Note [Unique Determinism] in Unique\n    unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty]\n\nmk_ww_local :: Unique -> (Type, StrictnessMark) -> Id\n-- The StrictnessMark comes form the data constructor and says\n-- whether this field is strict\n-- See Note [Record evaluated-ness in worker/wrapper]\nmk_ww_local uniq (ty,str)\n  = setCaseBndrEvald str $\n    mkSysLocalOrCoVar (fsLit \"ww\") uniq ty\n", "num_lines": 1193}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule ClsInst (\n     matchGlobalInst,\n     ClsInstResult(..),\n     InstanceWhat(..), safeOverlap,\n     AssocInstInfo(..), isNotAssociated\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcEnv\nimport TcRnMonad\nimport TcType\nimport TcMType\nimport TcEvidence\nimport RnEnv( addUsedGRE )\nimport RdrName( lookupGRE_FieldLabel )\nimport InstEnv\nimport Inst( instDFunType )\nimport FamInst( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst )\n\nimport TysWiredIn\nimport TysPrim( eqPrimTyCon, eqReprPrimTyCon )\nimport PrelNames\n\nimport Id\nimport Type\nimport MkCore ( mkStringExprFS, mkNaturalExpr )\n\nimport Name   ( Name )\nimport VarEnv ( VarEnv )\nimport DataCon\nimport TyCon\nimport Class\nimport DynFlags\nimport Outputable\nimport Util( splitAtList, fstOf3 )\nimport Data.Maybe\n\n{- *******************************************************************\n*                                                                    *\n              A helper for associated types within\n              class instance declarations\n*                                                                    *\n**********************************************************************-}\n\n-- | Extra information about the parent instance declaration, needed\n-- when type-checking associated types. The 'Class' is the enclosing\n-- class, the [TyVar] are the /scoped/ type variable of the instance decl.\n-- The @VarEnv Type@ maps class variables to their instance types.\ndata AssocInstInfo\n  = NotAssociated\n  | InClsInst { ai_class    :: Class\n              , ai_tyvars   :: [TyVar]      -- ^ The /scoped/ tyvars of the instance\n                                            -- Why scoped?  See bind_me in\n                                            -- TcValidity.checkConsistentFamInst\n              , ai_inst_env :: VarEnv Type  -- ^ Maps /class/ tyvars to their instance types\n                -- See Note [Matching in the consistent-instantation check]\n    }\n\nisNotAssociated :: AssocInstInfo -> Bool\nisNotAssociated NotAssociated  = True\nisNotAssociated (InClsInst {}) = False\n\n\n{- *******************************************************************\n*                                                                    *\n                       Class lookup\n*                                                                    *\n**********************************************************************-}\n\n-- | Indicates if Instance met the Safe Haskell overlapping instances safety\n-- check.\n--\n-- See Note [Safe Haskell Overlapping Instances] in TcSimplify\n-- See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify\ntype SafeOverlapping = Bool\n\ndata ClsInstResult\n  = NoInstance   -- Definitely no instance\n\n  | OneInst { cir_new_theta :: [TcPredType]\n            , cir_mk_ev     :: [EvExpr] -> EvTerm\n            , cir_what      :: InstanceWhat }\n\n  | NotSure      -- Multiple matches and/or one or more unifiers\n\ndata InstanceWhat\n  = BuiltinInstance\n  | LocalInstance\n  | TopLevInstance { iw_dfun_id   :: DFunId\n                   , iw_safe_over :: SafeOverlapping }\n\ninstance Outputable ClsInstResult where\n  ppr NoInstance = text \"NoInstance\"\n  ppr NotSure    = text \"NotSure\"\n  ppr (OneInst { cir_new_theta = ev\n               , cir_what = what })\n    = text \"OneInst\" <+> vcat [ppr ev, ppr what]\n\ninstance Outputable InstanceWhat where\n  ppr BuiltinInstance = text \"built-in instance\"\n  ppr LocalInstance   = text \"locally-quantified instance\"\n  ppr (TopLevInstance { iw_safe_over = so })\n     = text \"top-level instance\" <+> (text $ if so then \"[safe]\" else \"[unsafe]\")\n\nsafeOverlap :: InstanceWhat -> Bool\nsafeOverlap (TopLevInstance { iw_safe_over = so }) = so\nsafeOverlap _                                      = True\n\nmatchGlobalInst :: DynFlags\n                -> Bool      -- True <=> caller is the short-cut solver\n                             -- See Note [Shortcut solving: overlap]\n                -> Class -> [Type] -> TcM ClsInstResult\nmatchGlobalInst dflags short_cut clas tys\n  | cls_name == knownNatClassName\n  = matchKnownNat    dflags short_cut clas tys\n  | cls_name == knownSymbolClassName\n  = matchKnownSymbol dflags short_cut clas tys\n  | isCTupleClass clas                = matchCTuple          clas tys\n  | cls_name == typeableClassName     = matchTypeable        clas tys\n  | clas `hasKey` heqTyConKey         = matchHeteroEquality       tys\n  | clas `hasKey` eqTyConKey          = matchHomoEquality         tys\n  | clas `hasKey` coercibleTyConKey   = matchCoercible            tys\n  | cls_name == hasFieldClassName     = matchHasField dflags short_cut clas tys\n  | otherwise                         = matchInstEnv dflags short_cut clas tys\n  where\n    cls_name = className clas\n\n\n{- ********************************************************************\n*                                                                     *\n                   Looking in the instance environment\n*                                                                     *\n***********************************************************************-}\n\n\nmatchInstEnv :: DynFlags -> Bool -> Class -> [Type] -> TcM ClsInstResult\nmatchInstEnv dflags short_cut_solver clas tys\n   = do { instEnvs <- tcGetInstEnvs\n        ; let safeOverlapCheck = safeHaskell dflags `elem` [Sf_Safe, Sf_Trustworthy]\n              (matches, unify, unsafeOverlaps) = lookupInstEnv True instEnvs clas tys\n              safeHaskFail = safeOverlapCheck && not (null unsafeOverlaps)\n        ; traceTc \"matchInstEnv\" $\n            vcat [ text \"goal:\" <+> ppr clas <+> ppr tys\n                 , text \"matches:\" <+> ppr matches\n                 , text \"unify:\" <+> ppr unify ]\n        ; case (matches, unify, safeHaskFail) of\n\n            -- Nothing matches\n            ([], [], _)\n                -> do { traceTc \"matchClass not matching\" (ppr pred)\n                      ; return NoInstance }\n\n            -- A single match (& no safe haskell failure)\n            ([(ispec, inst_tys)], [], False)\n                | short_cut_solver      -- Called from the short-cut solver\n                , isOverlappable ispec\n                -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT\n                -- then don't let the short-cut solver choose it, because a\n                -- later instance might overlap it.  Trac #14434 is an example\n                -- See Note [Shortcut solving: overlap]\n                -> do { traceTc \"matchClass: ignoring overlappable\" (ppr pred)\n                      ; return NotSure }\n\n                | otherwise\n                -> do { let dfun_id = instanceDFunId ispec\n                      ; traceTc \"matchClass success\" $\n                        vcat [text \"dict\" <+> ppr pred,\n                              text \"witness\" <+> ppr dfun_id\n                                             <+> ppr (idType dfun_id) ]\n                                -- Record that this dfun is needed\n                      ; match_one (null unsafeOverlaps) dfun_id inst_tys }\n\n            -- More than one matches (or Safe Haskell fail!). Defer any\n            -- reactions of a multitude until we learn more about the reagent\n            _   -> do { traceTc \"matchClass multiple matches, deferring choice\" $\n                        vcat [text \"dict\" <+> ppr pred,\n                              text \"matches\" <+> ppr matches]\n                      ; return NotSure } }\n   where\n     pred = mkClassPred clas tys\n\nmatch_one :: SafeOverlapping -> DFunId -> [DFunInstType] -> TcM ClsInstResult\n             -- See Note [DFunInstType: instantiating types] in InstEnv\nmatch_one so dfun_id mb_inst_tys\n  = do { traceTc \"match_one\" (ppr dfun_id $$ ppr mb_inst_tys)\n       ; (tys, theta) <- instDFunType dfun_id mb_inst_tys\n       ; traceTc \"match_one 2\" (ppr dfun_id $$ ppr tys $$ ppr theta)\n       ; return $ OneInst { cir_new_theta = theta\n                          , cir_mk_ev     = evDFunApp dfun_id tys\n                          , cir_what      = TopLevInstance { iw_dfun_id = dfun_id\n                                                           , iw_safe_over = so } } }\n\n\n{- Note [Shortcut solving: overlap]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n  instance {-# OVERLAPPABLE #-} C a where ...\nand we are typechecking\n  f :: C a => a -> a\n  f = e  -- Gives rise to [W] C a\n\nWe don't want to solve the wanted constraint with the overlappable\ninstance; rather we want to use the supplied (C a)! That was the whole\npoint of it being overlappable!  Trac #14434 wwas an example.\n\nAlas even if the instance has no overlap flag, thus\n  instance C a where ...\nthere is nothing to stop it being overlapped. GHC provides no way to\ndeclare an instance as \"final\" so it can't be overlapped.  But really\nonly final instances are OK for short-cut solving.  Sigh. Trac #15135\nwas a puzzling example.\n-}\n\n\n{- ********************************************************************\n*                                                                     *\n                   Class lookup for CTuples\n*                                                                     *\n***********************************************************************-}\n\nmatchCTuple :: Class -> [Type] -> TcM ClsInstResult\nmatchCTuple clas tys   -- (isCTupleClass clas) holds\n  = return (OneInst { cir_new_theta = tys\n                    , cir_mk_ev     = tuple_ev\n                    , cir_what      = BuiltinInstance })\n            -- The dfun *is* the data constructor!\n  where\n     data_con = tyConSingleDataCon (classTyCon clas)\n     tuple_ev = evDFunApp (dataConWrapId data_con) tys\n\n{- ********************************************************************\n*                                                                     *\n                   Class lookup for Literals\n*                                                                     *\n***********************************************************************-}\n\n{-\nNote [KnownNat & KnownSymbol and EvLit]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA part of the type-level literals implementation are the classes\n\"KnownNat\" and \"KnownSymbol\", which provide a \"smart\" constructor for\ndefining singleton values.  Here is the key stuff from GHC.TypeLits\n\n  class KnownNat (n :: Nat) where\n    natSing :: SNat n\n\n  newtype SNat (n :: Nat) = SNat Integer\n\nConceptually, this class has infinitely many instances:\n\n  instance KnownNat 0       where natSing = SNat 0\n  instance KnownNat 1       where natSing = SNat 1\n  instance KnownNat 2       where natSing = SNat 2\n  ...\n\nIn practice, we solve `KnownNat` predicates in the type-checker\n(see typecheck/TcInteract.hs) because we can't have infinitely many instances.\nThe evidence (aka \"dictionary\") for `KnownNat` is of the form `EvLit (EvNum n)`.\n\nWe make the following assumptions about dictionaries in GHC:\n  1. The \"dictionary\" for classes with a single method---like `KnownNat`---is\n     a newtype for the type of the method, so using a evidence amounts\n     to a coercion, and\n  2. Newtypes use the same representation as their definition types.\n\nSo, the evidence for `KnownNat` is just a value of the representation type,\nwrapped in two newtype constructors: one to make it into a `SNat` value,\nand another to make it into a `KnownNat` dictionary.\n\nAlso note that `natSing` and `SNat` are never actually exposed from the\nlibrary---they are just an implementation detail.  Instead, users see\na more convenient function, defined in terms of `natSing`:\n\n  natVal :: KnownNat n => proxy n -> Integer\n\nThe reason we don't use this directly in the class is that it is simpler\nand more efficient to pass around an integer rather than an entire function,\nespecially when the `KnowNat` evidence is packaged up in an existential.\n\nThe story for kind `Symbol` is analogous:\n  * class KnownSymbol\n  * newtype SSymbol\n  * Evidence: a Core literal (e.g. mkNaturalExpr)\n\n\nNote [Fabricating Evidence for Literals in Backpack]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nLet `T` be a type of kind `Nat`. When solving for a purported instance\nof `KnownNat T`, ghc tries to resolve the type `T` to an integer `n`,\nin which case the evidence `EvLit (EvNum n)` is generated on the\nfly. It might appear that this is sufficient as users cannot define\ntheir own instances of `KnownNat`. However, for backpack module this\nwould not work (see issue #15379). Consider the signature `Abstract`\n\n> signature Abstract where\n>   data T :: Nat\n>   instance KnownNat T\n\nand a module `Util` that depends on it:\n\n> module Util where\n>  import Abstract\n>  printT :: IO ()\n>  printT = do print $ natVal (Proxy :: Proxy T)\n\nClearly, we need to \"use\" the dictionary associated with `KnownNat T`\nin the module `Util`, but it is too early for the compiler to produce\na real dictionary as we still have not fixed what `T` is. Only when we\nmixin a concrete module\n\n> module Concrete where\n>   type T = 42\n\ndo we really get hold of the underlying integer. So the strategy that\nwe follow is the following\n\n1. If T is indeed available as a type alias for an integer constant,\n   generate the dictionary on the fly, failing which\n\n2. Look up the type class environment for the evidence.\n\nFinally actual code gets generate for Util only when a module like\nConcrete gets \"mixed-in\" in place of the signature Abstract. As a\nresult all things, including the typeclass instances, in Concrete gets\nreexported. So `KnownNat` gets resolved the normal way post-Backpack.\n\nA similar generation works for `KnownSymbol` as well\n\n-}\n\nmatchKnownNat :: DynFlags\n              -> Bool      -- True <=> caller is the short-cut solver\n                           -- See Note [Shortcut solving: overlap]\n              -> Class -> [Type] -> TcM ClsInstResult\nmatchKnownNat _ _ clas [ty]     -- clas = KnownNat\n  | Just n <- isNumLitTy ty = do\n        et <- mkNaturalExpr n\n        makeLitDict clas ty et\nmatchKnownNat df sc clas tys = matchInstEnv df sc clas tys\n -- See Note [Fabricating Evidence for Literals in Backpack] for why\n -- this lookup into the instance environment is required.\n\nmatchKnownSymbol :: DynFlags\n                 -> Bool      -- True <=> caller is the short-cut solver\n                              -- See Note [Shortcut solving: overlap]\n                 -> Class -> [Type] -> TcM ClsInstResult\nmatchKnownSymbol _ _ clas [ty]  -- clas = KnownSymbol\n  | Just s <- isStrLitTy ty = do\n        et <- mkStringExprFS s\n        makeLitDict clas ty et\nmatchKnownSymbol df sc clas tys = matchInstEnv df sc clas tys\n -- See Note [Fabricating Evidence for Literals in Backpack] for why\n -- this lookup into the instance environment is required.\n\nmakeLitDict :: Class -> Type -> EvExpr -> TcM ClsInstResult\n-- makeLitDict adds a coercion that will convert the literal into a dictionary\n-- of the appropriate type.  See Note [KnownNat & KnownSymbol and EvLit]\n-- in TcEvidence.  The coercion happens in 2 steps:\n--\n--     Integer -> SNat n     -- representation of literal to singleton\n--     SNat n  -> KnownNat n -- singleton to dictionary\n--\n--     The process is mirrored for Symbols:\n--     String    -> SSymbol n\n--     SSymbol n -> KnownSymbol n\nmakeLitDict clas ty et\n    | Just (_, co_dict) <- tcInstNewTyCon_maybe (classTyCon clas) [ty]\n          -- co_dict :: KnownNat n ~ SNat n\n    , [ meth ]   <- classMethods clas\n    , Just tcRep <- tyConAppTyCon_maybe -- SNat\n                      $ funResultTy         -- SNat n\n                      $ dropForAlls         -- KnownNat n => SNat n\n                      $ idType meth         -- forall n. KnownNat n => SNat n\n    , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty]\n          -- SNat n ~ Integer\n    , let ev_tm = mkEvCast et (mkTcSymCo (mkTcTransCo co_dict co_rep))\n    = return $ OneInst { cir_new_theta = []\n                       , cir_mk_ev     = \\_ -> ev_tm\n                       , cir_what      = BuiltinInstance }\n\n    | otherwise\n    = pprPanic \"makeLitDict\" $\n      text \"Unexpected evidence for\" <+> ppr (className clas)\n      $$ vcat (map (ppr . idType) (classMethods clas))\n\n{- ********************************************************************\n*                                                                     *\n                   Class lookup for Typeable\n*                                                                     *\n***********************************************************************-}\n\n-- | Assumes that we've checked that this is the 'Typeable' class,\n-- and it was applied to the correct argument.\nmatchTypeable :: Class -> [Type] -> TcM ClsInstResult\nmatchTypeable clas [k,t]  -- clas = Typeable\n  -- For the first two cases, See Note [No Typeable for polytypes or qualified types]\n  | isForAllTy k                      = return NoInstance   -- Polytype\n  | isJust (tcSplitPredFunTy_maybe t) = return NoInstance   -- Qualified type\n\n  -- Now cases that do work\n  | k `eqType` typeNatKind                 = doTyLit knownNatClassName         t\n  | k `eqType` typeSymbolKind              = doTyLit knownSymbolClassName      t\n  | tcIsConstraintKind t                   = doTyConApp clas t constraintKindTyCon []\n  | Just (arg,ret) <- splitFunTy_maybe t   = doFunTy    clas t arg ret\n  | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]\n  , onlyNamedBndrsApplied tc ks            = doTyConApp clas t tc ks\n  | Just (f,kt)   <- splitAppTy_maybe t    = doTyApp    clas t f kt\n\nmatchTypeable _ _ = return NoInstance\n\n-- | Representation for a type @ty@ of the form @arg -> ret@.\ndoFunTy :: Class -> Type -> Type -> Type -> TcM ClsInstResult\ndoFunTy clas ty arg_ty ret_ty\n  = return $ OneInst { cir_new_theta = preds\n                     , cir_mk_ev     = mk_ev\n                     , cir_what      = BuiltinInstance }\n  where\n    preds = map (mk_typeable_pred clas) [arg_ty, ret_ty]\n    mk_ev [arg_ev, ret_ev] = evTypeable ty $\n                             EvTypeableTrFun (EvExpr arg_ev) (EvExpr ret_ev)\n    mk_ev _ = panic \"TcInteract.doFunTy\"\n\n\n-- | Representation for type constructor applied to some kinds.\n-- 'onlyNamedBndrsApplied' has ensured that this application results in a type\n-- of monomorphic kind (e.g. all kind variables have been instantiated).\ndoTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcM ClsInstResult\ndoTyConApp clas ty tc kind_args\n  | Just _ <- tyConRepName_maybe tc\n  = return $ OneInst { cir_new_theta = (map (mk_typeable_pred clas) kind_args)\n                     , cir_mk_ev     = mk_ev\n                     , cir_what      = BuiltinInstance }\n  | otherwise\n  = return NoInstance\n  where\n    mk_ev kinds = evTypeable ty $ EvTypeableTyCon tc (map EvExpr kinds)\n\n-- | Representation for TyCon applications of a concrete kind. We just use the\n-- kind itself, but first we must make sure that we've instantiated all kind-\n-- polymorphism, but no more.\nonlyNamedBndrsApplied :: TyCon -> [KindOrType] -> Bool\nonlyNamedBndrsApplied tc ks\n = all isNamedTyConBinder used_bndrs &&\n   not (any isNamedTyConBinder leftover_bndrs)\n where\n   bndrs                        = tyConBinders tc\n   (used_bndrs, leftover_bndrs) = splitAtList ks bndrs\n\ndoTyApp :: Class -> Type -> Type -> KindOrType -> TcM ClsInstResult\n-- Representation for an application of a type to a type-or-kind.\n--  This may happen when the type expression starts with a type variable.\n--  Example (ignoring kind parameter):\n--    Typeable (f Int Char)                      -->\n--    (Typeable (f Int), Typeable Char)          -->\n--    (Typeable f, Typeable Int, Typeable Char)  --> (after some simp. steps)\n--    Typeable f\ndoTyApp clas ty f tk\n  | isForAllTy (tcTypeKind f)\n  = return NoInstance -- We can't solve until we know the ctr.\n  | otherwise\n  = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk]\n                     , cir_mk_ev     = mk_ev\n                     , cir_what      = BuiltinInstance }\n  where\n    mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2)\n    mk_ev _ = panic \"doTyApp\"\n\n\n-- Emit a `Typeable` constraint for the given type.\nmk_typeable_pred :: Class -> Type -> PredType\nmk_typeable_pred clas ty = mkClassPred clas [ tcTypeKind ty, ty ]\n\n  -- Typeable is implied by KnownNat/KnownSymbol. In the case of a type literal\n  -- we generate a sub-goal for the appropriate class.\n  -- See Note [Typeable for Nat and Symbol]\ndoTyLit :: Name -> Type -> TcM ClsInstResult\ndoTyLit kc t = do { kc_clas <- tcLookupClass kc\n                  ; let kc_pred    = mkClassPred kc_clas [ t ]\n                        mk_ev [ev] = evTypeable t $ EvTypeableTyLit (EvExpr ev)\n                        mk_ev _    = panic \"doTyLit\"\n                  ; return (OneInst { cir_new_theta = [kc_pred]\n                                    , cir_mk_ev     = mk_ev\n                                    , cir_what      = BuiltinInstance }) }\n\n{- Note [Typeable (T a b c)]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor type applications we always decompose using binary application,\nvia doTyApp, until we get to a *kind* instantiation.  Example\n   Proxy :: forall k. k -> *\n\nTo solve Typeable (Proxy (* -> *) Maybe) we\n  - First decompose with doTyApp,\n    to get (Typeable (Proxy (* -> *))) and Typeable Maybe\n  - Then solve (Typeable (Proxy (* -> *))) with doTyConApp\n\nIf we attempt to short-cut by solving it all at once, via\ndoTyConApp\n\n(this note is sadly truncated FIXME)\n\n\nNote [No Typeable for polytypes or qualified types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe do not support impredicative typeable, such as\n   Typeable (forall a. a->a)\n   Typeable (Eq a => a -> a)\n   Typeable (() => Int)\n   Typeable (((),()) => Int)\n\nSee Trac #9858.  For forall's the case is clear: we simply don't have\na TypeRep for them.  For qualified but not polymorphic types, like\n(Eq a => a -> a), things are murkier.  But:\n\n * We don't need a TypeRep for these things.  TypeReps are for\n   monotypes only.\n\n * Perhaps we could treat `=>` as another type constructor for `Typeable`\n   purposes, and thus support things like `Eq Int => Int`, however,\n   at the current state of affairs this would be an odd exception as\n   no other class works with impredicative types.\n   For now we leave it off, until we have a better story for impredicativity.\n\n\nNote [Typeable for Nat and Symbol]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe have special Typeable instances for Nat and Symbol.  Roughly we\nhave this instance, implemented here by doTyLit:\n      instance KnownNat n => Typeable (n :: Nat) where\n         typeRep = typeNatTypeRep @n\nwhere\n   Data.Typeable.Internals.typeNatTypeRep :: KnownNat a => TypeRep a\n\nUltimately typeNatTypeRep uses 'natSing' from KnownNat to get a\nruntime value 'n'; it turns it into a string with 'show' and uses\nthat to whiz up a TypeRep TyCon for 'n', with mkTypeLitTyCon.\nSee #10348.\n\nBecause of this rule it's inadvisable (see #15322) to have a constraint\n    f :: (Typeable (n :: Nat)) => blah\nin a function signature; it gives rise to overlap problems just as\nif you'd written\n    f :: Eq [a] => blah\n-}\n\n{- ********************************************************************\n*                                                                     *\n                   Class lookup for lifted equality\n*                                                                     *\n***********************************************************************-}\n\n-- See also Note [The equality types story] in TysPrim\nmatchHeteroEquality :: [Type] -> TcM ClsInstResult\n-- Solves (t1 ~~ t2)\nmatchHeteroEquality args\n  = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon args ]\n                    , cir_mk_ev     = evDataConApp heqDataCon args\n                    , cir_what      = BuiltinInstance })\n\nmatchHomoEquality :: [Type] -> TcM ClsInstResult\n-- Solves (t1 ~ t2)\nmatchHomoEquality args@[k,t1,t2]\n  = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon [k,k,t1,t2] ]\n                    , cir_mk_ev     = evDataConApp eqDataCon args\n                    , cir_what      = BuiltinInstance })\nmatchHomoEquality args = pprPanic \"matchHomoEquality\" (ppr args)\n\n-- See also Note [The equality types story] in TysPrim\nmatchCoercible :: [Type] -> TcM ClsInstResult\nmatchCoercible args@[k, t1, t2]\n  = return (OneInst { cir_new_theta = [ mkTyConApp eqReprPrimTyCon args' ]\n                    , cir_mk_ev     = evDataConApp coercibleDataCon args\n                    , cir_what      = BuiltinInstance })\n  where\n    args' = [k, k, t1, t2]\nmatchCoercible args = pprPanic \"matchLiftedCoercible\" (ppr args)\n\n\n{- ********************************************************************\n*                                                                     *\n              Class lookup for overloaded record fields\n*                                                                     *\n***********************************************************************-}\n\n{-\nNote [HasField instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n    data T y = MkT { foo :: [y] }\n\nand `foo` is in scope.  Then GHC will automatically solve a constraint like\n\n    HasField \"foo\" (T Int) b\n\nby emitting a new wanted\n\n    T alpha -> [alpha] ~# T Int -> b\n\nand building a HasField dictionary out of the selector function `foo`,\nappropriately cast.\n\nThe HasField class is defined (in GHC.Records) thus:\n\n    class HasField (x :: k) r a | x r -> a where\n      getField :: r -> a\n\nSince this is a one-method class, it is represented as a newtype.\nHence we can solve `HasField \"foo\" (T Int) b` by taking an expression\nof type `T Int -> b` and casting it using the newtype coercion.\nNote that\n\n    foo :: forall y . T y -> [y]\n\nso the expression we construct is\n\n    foo @alpha |> co\n\nwhere\n\n    co :: (T alpha -> [alpha]) ~# HasField \"foo\" (T Int) b\n\nis built from\n\n    co1 :: (T alpha -> [alpha]) ~# (T Int -> b)\n\nwhich is the new wanted, and\n\n    co2 :: (T Int -> b) ~# HasField \"foo\" (T Int) b\n\nwhich can be derived from the newtype coercion.\n\nIf `foo` is not in scope, or has a higher-rank or existentially\nquantified type, then the constraint is not solved automatically, but\nmay be solved by a user-supplied HasField instance.  Similarly, if we\nencounter a HasField constraint where the field is not a literal\nstring, or does not belong to the type, then we fall back on the\nnormal constraint solver behaviour.\n-}\n\n-- See Note [HasField instances]\nmatchHasField :: DynFlags -> Bool -> Class -> [Type] -> TcM ClsInstResult\nmatchHasField dflags short_cut clas tys\n  = do { fam_inst_envs <- tcGetFamInstEnvs\n       ; rdr_env       <- getGlobalRdrEnv\n       ; case tys of\n           -- We are matching HasField {k} x r a...\n           [_k_ty, x_ty, r_ty, a_ty]\n               -- x should be a literal string\n             | Just x <- isStrLitTy x_ty\n               -- r should be an applied type constructor\n             , Just (tc, args) <- tcSplitTyConApp_maybe r_ty\n               -- use representation tycon (if data family); it has the fields\n             , let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args)\n               -- x should be a field of r\n             , Just fl <- lookupTyConFieldLabel x r_tc\n               -- the field selector should be in scope\n             , Just gre <- lookupGRE_FieldLabel rdr_env fl\n\n             -> do { sel_id <- tcLookupId (flSelector fl)\n                   ; (tv_prs, preds, sel_ty) <- tcInstType newMetaTyVars sel_id\n\n                         -- The first new wanted constraint equates the actual\n                         -- type of the selector with the type (r -> a) within\n                         -- the HasField x r a dictionary.  The preds will\n                         -- typically be empty, but if the datatype has a\n                         -- \"stupid theta\" then we have to include it here.\n                   ; let theta = mkPrimEqPred sel_ty (mkVisFunTy r_ty a_ty) : preds\n\n                         -- Use the equality proof to cast the selector Id to\n                         -- type (r -> a), then use the newtype coercion to cast\n                         -- it to a HasField dictionary.\n                         mk_ev (ev1:evs) = evSelector sel_id tvs evs `evCast` co\n                           where\n                             co = mkTcSubCo (evTermCoercion (EvExpr ev1))\n                                      `mkTcTransCo` mkTcSymCo co2\n                         mk_ev [] = panic \"matchHasField.mk_ev\"\n\n                         Just (_, co2) = tcInstNewTyCon_maybe (classTyCon clas)\n                                                              tys\n\n                         tvs = mkTyVarTys (map snd tv_prs)\n\n                     -- The selector must not be \"naughty\" (i.e. the field\n                     -- cannot have an existentially quantified type), and\n                     -- it must not be higher-rank.\n                   ; if not (isNaughtyRecordSelector sel_id) && isTauTy sel_ty\n                     then do { addUsedGRE True gre\n                             ; return OneInst { cir_new_theta = theta\n                                              , cir_mk_ev     = mk_ev\n                                              , cir_what      = BuiltinInstance } }\n                     else matchInstEnv dflags short_cut clas tys }\n\n           _ -> matchInstEnv dflags short_cut clas tys }\n", "num_lines": 700}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The @FamInst@ type: family instance heads\n\n{-# LANGUAGE CPP, GADTs #-}\n\nmodule FamInst (\n        FamInstEnvs, tcGetFamInstEnvs,\n        checkFamInstConsistency, tcExtendLocalFamInstEnv,\n        tcLookupDataFamInst, tcLookupDataFamInst_maybe,\n        tcInstNewTyCon_maybe, tcTopNormaliseNewTypeTF_maybe,\n        newFamInst,\n\n        -- * Injectivity\n        makeInjectivityErrors, injTyVarsOfType, injTyVarsOfTypes\n    ) where\n\nimport GhcPrelude\n\nimport HscTypes\nimport FamInstEnv\nimport InstEnv( roughMatchTcs )\nimport Coercion\nimport CoreLint\nimport TcEvidence\nimport LoadIface\nimport TcRnMonad\nimport SrcLoc\nimport TyCon\nimport TcType\nimport CoAxiom\nimport DynFlags\nimport Module\nimport Outputable\nimport Util\nimport RdrName\nimport DataCon ( dataConName )\nimport Maybes\nimport Type\nimport TyCoRep\nimport TcMType\nimport Name\nimport Pair\nimport Panic\nimport VarSet\nimport Bag( Bag, unionBags, unitBag )\nimport Control.Monad\n\n#include \"HsVersions.h\"\n\n{- Note [The type family instance consistency story]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nTo preserve type safety we must ensure that for any given module, all\nthe type family instances used either in that module or in any module\nit directly or indirectly imports are consistent. For example, consider\n\n  module F where\n    type family F a\n\n  module A where\n    import F( F )\n    type instance F Int = Bool\n    f :: F Int -> Bool\n    f x = x\n\n  module B where\n    import F( F )\n    type instance F Int = Char\n    g :: Char -> F Int\n    g x = x\n\n  module Bad where\n    import A( f )\n    import B( g )\n    bad :: Char -> Int\n    bad c = f (g c)\n\nEven though module Bad never mentions the type family F at all, by\ncombining the functions f and g that were type checked in contradictory\ntype family instance environments, the function bad is able to coerce\nfrom one type to another. So when we type check Bad we must verify that\nthe type family instances defined in module A are consistent with those\ndefined in module B.\n\nHow do we ensure that we maintain the necessary consistency?\n\n* Call a module which defines at least one type family instance a\n  \"family instance module\". This flag `mi_finsts` is recorded in the\n  interface file.\n\n* For every module we calculate the set of all of its direct and\n  indirect dependencies that are family instance modules. This list\n  `dep_finsts` is also recorded in the interface file so we can compute\n  this list for a module from the lists for its direct dependencies.\n\n* When type checking a module M we check consistency of all the type\n  family instances that are either provided by its `dep_finsts` or\n  defined in the module M itself. This is a pairwise check, i.e., for\n  every pair of instances we must check that they are consistent.\n\n  - For family instances coming from `dep_finsts`, this is checked in\n    checkFamInstConsistency, called from tcRnImports. See Note\n    [Checking family instance consistency] for details on this check\n    (and in particular how we avoid having to do all these checks for\n    every module we compile).\n\n  - That leaves checking the family instances defined in M itself\n    against instances defined in either M or its `dep_finsts`. This is\n    checked in `tcExtendLocalFamInstEnv'.\n\nThere are four subtle points in this scheme which have not been\naddressed yet.\n\n* We have checked consistency of the family instances *defined* by M\n  or its imports, but this is not by definition the same thing as the\n  family instances *used* by M or its imports.  Specifically, we need to\n  ensure when we use a type family instance while compiling M that this\n  instance was really defined from either M or one of its imports,\n  rather than being an instance that we happened to know about from\n  reading an interface file in the course of compiling an unrelated\n  module. Otherwise, we'll end up with no record of the fact that M\n  depends on this family instance and type safety will be compromised.\n  See #13102.\n\n* It can also happen that M uses a function defined in another module\n  which is not transitively imported by M. Examples include the\n  desugaring of various overloaded constructs, and references inserted\n  by Template Haskell splices. If that function's definition makes use\n  of type family instances which are not checked against those visible\n  from M, type safety can again be compromised. See #13251.\n\n* When a module C imports a boot module B.hs-boot, we check that C's\n  type family instances are compatible with those visible from\n  B.hs-boot. However, C will eventually be linked against a different\n  module B.hs, which might define additional type family instances which\n  are inconsistent with C's. This can also lead to loss of type safety.\n  See #9562.\n\n* The call to checkFamConsistency for imported functions occurs very\n  early (in tcRnImports) and that causes problems if the imported\n  instances use type declared in the module being compiled.\n  See Note [Loading your own hi-boot file] in LoadIface.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                 Making a FamInst\n*                                                                      *\n************************************************************************\n-}\n\n-- All type variables in a FamInst must be fresh. This function\n-- creates the fresh variables and applies the necessary substitution\n-- It is defined here to avoid a dependency from FamInstEnv on the monad\n-- code.\n\nnewFamInst :: FamFlavor -> CoAxiom Unbranched -> TcM FamInst\n-- Freshen the type variables of the FamInst branches\nnewFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc })\n  = ASSERT2( tyCoVarsOfTypes lhs `subVarSet` tcv_set, text \"lhs\" <+> pp_ax )\n    ASSERT2( lhs_kind `eqType` rhs_kind, text \"kind\" <+> pp_ax $$ ppr lhs_kind $$ ppr rhs_kind )\n    -- We used to have an assertion that the tyvars of the RHS were bound\n    -- by tcv_set, but in error situations like  F Int = a that isn't\n    -- true; a later check in checkValidFamInst rejects it\n    do { (subst, tvs') <- freshenTyVarBndrs tvs\n       ; (subst, cvs') <- freshenCoVarBndrsX subst cvs\n       ; dflags <- getDynFlags\n       ; let lhs'     = substTys subst lhs\n             rhs'     = substTy  subst rhs\n             tcvs'    = tvs' ++ cvs'\n       ; ifErrsM (return ()) $ -- Don't lint when there are errors, because\n                               -- errors might mean TcTyCons.\n                               -- See Note [Recover from validity error] in TcTyClsDecls\n         when (gopt Opt_DoCoreLinting dflags) $\n           -- Check that the types involved in this instance are well formed.\n           -- Do /not/ expand type synonyms, for the reasons discussed in\n           -- Note [Linting type synonym applications].\n           case lintTypes dflags tcvs' (rhs':lhs') of\n             Nothing       -> pure ()\n             Just fail_msg -> pprPanic \"Core Lint error\" (vcat [ fail_msg\n                                                               , ppr fam_tc\n                                                               , ppr subst\n                                                               , ppr tvs'\n                                                               , ppr cvs'\n                                                               , ppr lhs'\n                                                               , ppr rhs' ])\n       ; return (FamInst { fi_fam      = tyConName fam_tc\n                         , fi_flavor   = flavor\n                         , fi_tcs      = roughMatchTcs lhs\n                         , fi_tvs      = tvs'\n                         , fi_cvs      = cvs'\n                         , fi_tys      = lhs'\n                         , fi_rhs      = rhs'\n                         , fi_axiom    = axiom }) }\n  where\n    lhs_kind = tcTypeKind (mkTyConApp fam_tc lhs)\n    rhs_kind = tcTypeKind rhs\n    tcv_set  = mkVarSet (tvs ++ cvs)\n    pp_ax    = pprCoAxiom axiom\n    CoAxBranch { cab_tvs = tvs\n               , cab_cvs = cvs\n               , cab_lhs = lhs\n               , cab_rhs = rhs } = coAxiomSingleBranch axiom\n\n\n{-\n************************************************************************\n*                                                                      *\n        Optimised overlap checking for family instances\n*                                                                      *\n************************************************************************\n\nNote [Checking family instance consistency]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor any two family instance modules that we import directly or indirectly, we\ncheck whether the instances in the two modules are consistent, *unless* we can\nbe certain that the instances of the two modules have already been checked for\nconsistency during the compilation of modules that we import.\n\nWhy do we need to check?  Consider\n   module X1 where                module X2 where\n    data T1                         data T2\n    type instance F T1 b = Int      type instance F a T2 = Char\n    f1 :: F T1 a -> Int             f2 :: Char -> F a T2\n    f1 x = x                        f2 x = x\n\nNow if we import both X1 and X2 we could make (f2 . f1) :: Int -> Char.\nNotice that neither instance is an orphan.\n\nHow do we know which pairs of modules have already been checked? For each\nmodule M we directly import, we look up the family instance modules that M\nimports (directly or indirectly), say F1, ..., FN. For any two modules\namong M, F1, ..., FN, we know that the family instances defined in those\ntwo modules are consistent--because we checked that when we compiled M.\n\nFor every other pair of family instance modules we import (directly or\nindirectly), we check that they are consistent now. (So that we can be\ncertain that the modules in our `HscTypes.dep_finsts' are consistent.)\n\nThere is some fancy footwork regarding hs-boot module loops, see\nNote [Don't check hs-boot type family instances too early]\n\nNote [Checking family instance optimization]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs explained in Note [Checking family instance consistency]\nwe need to ensure that every pair of transitive imports that define type family\ninstances is consistent.\n\nLet's define df(A) = transitive imports of A that define type family instances\n+ A, if A defines type family instances\n\nThen for every direct import A, df(A) is already consistent.\n\nLet's name the current module M.\n\nWe want to make sure that df(M) is consistent.\ndf(M) = df(D_1) U df(D_2) U ... U df(D_i) where D_1 .. D_i are direct imports.\n\nWe perform the check iteratively, maintaining a set of consistent modules 'C'\nand trying to add df(D_i) to it.\n\nThe key part is how to ensure that the union C U df(D_i) is consistent.\n\nLet's consider two modules: A and B from C U df(D_i).\nThere are nine possible ways to choose A and B from C U df(D_i):\n\n             | A in C only      | A in C and B in df(D_i) | A in df(D_i) only\n--------------------------------------------------------------------------------\nB in C only  | Already checked  | Already checked         | Needs to be checked\n             | when checking C  | when checking C         |\n--------------------------------------------------------------------------------\nB in C and   | Already checked  | Already checked         | Already checked when\nB in df(D_i) | when checking C  | when checking C         | checking df(D_i)\n--------------------------------------------------------------------------------\nB in df(D_i) | Needs to be      | Already checked         | Already checked when\nonly         | checked          | when checking df(D_i)   | checking df(D_i)\n\nThat means to ensure that C U df(D_i) is consistent we need to check every\nmodule from C - df(D_i) against every module from df(D_i) - C and\nevery module from df(D_i) - C against every module from C - df(D_i).\nBut since the checks are symmetric it suffices to pick A from C - df(D_i)\nand B from df(D_i) - C.\n\nIn other words these are the modules we need to check:\n  [ (m1, m2) | m1 <- C, m1 not in df(D_i)\n             , m2 <- df(D_i), m2 not in C ]\n\nOne final thing to note here is that if there's lot of overlap between\nsubsequent df(D_i)'s then we expect those set differences to be small.\nThat situation should be pretty common in practice, there's usually\na set of utility modules that every module imports directly or indirectly.\n\nThis is basically the idea from #13092, comment:14.\n-}\n\n-- This function doesn't check ALL instances for consistency,\n-- only ones that aren't involved in recursive knot-tying\n-- loops; see Note [Don't check hs-boot type family instances too early].\n-- We don't need to check the current module, this is done in\n-- tcExtendLocalFamInstEnv.\n-- See Note [The type family instance consistency story].\ncheckFamInstConsistency :: [Module] -> TcM ()\ncheckFamInstConsistency directlyImpMods\n  = do { dflags     <- getDynFlags\n       ; (eps, hpt) <- getEpsAndHpt\n       ; traceTc \"checkFamInstConsistency\" (ppr directlyImpMods)\n       ; let { -- Fetch the iface of a given module.  Must succeed as\n               -- all directly imported modules must already have been loaded.\n               modIface mod =\n                 case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of\n                   Nothing    -> panicDoc \"FamInst.checkFamInstConsistency\"\n                                          (ppr mod $$ pprHPT hpt)\n                   Just iface -> iface\n\n               -- Which family instance modules were checked for consistency\n               -- when we compiled `mod`?\n               -- Itself (if a family instance module) and its dep_finsts.\n               -- This is df(D_i) from\n               -- Note [Checking family instance optimization]\n             ; modConsistent :: Module -> [Module]\n             ; modConsistent mod =\n                 if mi_finsts (modIface mod) then mod:deps else deps\n                 where\n                 deps = dep_finsts . mi_deps . modIface $ mod\n\n             ; hmiModule     = mi_module . hm_iface\n             ; hmiFamInstEnv = extendFamInstEnvList emptyFamInstEnv\n                               . md_fam_insts . hm_details\n             ; hpt_fam_insts = mkModuleEnv [ (hmiModule hmi, hmiFamInstEnv hmi)\n                                           | hmi <- eltsHpt hpt]\n\n             }\n\n       ; checkMany hpt_fam_insts modConsistent directlyImpMods\n       }\n  where\n    -- See Note [Checking family instance optimization]\n    checkMany\n      :: ModuleEnv FamInstEnv   -- home package family instances\n      -> (Module -> [Module])   -- given A, modules checked when A was checked\n      -> [Module]               -- modules to process\n      -> TcM ()\n    checkMany hpt_fam_insts modConsistent mods = go [] emptyModuleSet mods\n      where\n      go :: [Module] -- list of consistent modules\n         -> ModuleSet -- set of consistent modules, same elements as the\n                      -- list above\n         -> [Module] -- modules to process\n         -> TcM ()\n      go _ _ [] = return ()\n      go consistent consistent_set (mod:mods) = do\n        sequence_\n          [ check hpt_fam_insts m1 m2\n          | m1 <- to_check_from_mod\n            -- loop over toCheckFromMod first, it's usually smaller,\n            -- it may even be empty\n          , m2 <- to_check_from_consistent\n          ]\n        go consistent' consistent_set' mods\n        where\n        mod_deps_consistent =  modConsistent mod\n        mod_deps_consistent_set = mkModuleSet mod_deps_consistent\n        consistent' = to_check_from_mod ++ consistent\n        consistent_set' =\n          extendModuleSetList consistent_set to_check_from_mod\n        to_check_from_consistent =\n          filterOut (`elemModuleSet` mod_deps_consistent_set) consistent\n        to_check_from_mod =\n          filterOut (`elemModuleSet` consistent_set) mod_deps_consistent\n        -- Why don't we just minusModuleSet here?\n        -- We could, but doing so means one of two things:\n        --\n        --   1. When looping over the cartesian product we convert\n        --   a set into a non-deterministicly ordered list. Which\n        --   happens to be fine for interface file determinism\n        --   in this case, today, because the order only\n        --   determines the order of deferred checks. But such\n        --   invariants are hard to keep.\n        --\n        --   2. When looping over the cartesian product we convert\n        --   a set into a deterministically ordered list - this\n        --   adds some additional cost of sorting for every\n        --   direct import.\n        --\n        --   That also explains why we need to keep both 'consistent'\n        --   and 'consistentSet'.\n        --\n        --   See also Note [ModuleEnv performance and determinism].\n    check hpt_fam_insts m1 m2\n      = do { env1' <- getFamInsts hpt_fam_insts m1\n           ; env2' <- getFamInsts hpt_fam_insts m2\n           -- We're checking each element of env1 against env2.\n           -- The cost of that is dominated by the size of env1, because\n           -- for each instance in env1 we look it up in the type family\n           -- environment env2, and lookup is cheap.\n           -- The code below ensures that env1 is the smaller environment.\n           ; let sizeE1 = famInstEnvSize env1'\n                 sizeE2 = famInstEnvSize env2'\n                 (env1, env2) = if sizeE1 < sizeE2 then (env1', env2')\n                                                   else (env2', env1')\n           -- Note [Don't check hs-boot type family instances too early]\n           -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n           -- Family instance consistency checking involves checking that\n           -- the family instances of our imported modules are consistent with\n           -- one another; this might lead you to think that this process\n           -- has nothing to do with the module we are about to typecheck.\n           -- Not so!  Consider the following case:\n           --\n           --   -- A.hs-boot\n           --   type family F a\n           --\n           --   -- B.hs\n           --   import {-# SOURCE #-} A\n           --   type instance F Int = Bool\n           --\n           --   -- A.hs\n           --   import B\n           --   type family F a\n           --\n           -- When typechecking A, we are NOT allowed to poke the TyThing\n           -- for F until we have typechecked the family.  Thus, we\n           -- can't do consistency checking for the instance in B\n           -- (checkFamInstConsistency is called during renaming).\n           -- Failing to defer the consistency check lead to #11062.\n           --\n           -- Additionally, we should also defer consistency checking when\n           -- type from the hs-boot file of the current module occurs on\n           -- the left hand side, as we will poke its TyThing when checking\n           -- for overlap.\n           --\n           --   -- F.hs\n           --   type family F a\n           --\n           --   -- A.hs-boot\n           --   import F\n           --   data T\n           --\n           --   -- B.hs\n           --   import {-# SOURCE #-} A\n           --   import F\n           --   type instance F T = Int\n           --\n           --   -- A.hs\n           --   import B\n           --   data T = MkT\n           --\n           -- In fact, it is even necessary to defer for occurrences in\n           -- the RHS, because we may test for *compatibility* in event\n           -- of an overlap.\n           --\n           -- Why don't we defer ALL of the checks to later?  Well, many\n           -- instances aren't involved in the recursive loop at all.  So\n           -- we might as well check them immediately; and there isn't\n           -- a good time to check them later in any case: every time\n           -- we finish kind-checking a type declaration and add it to\n           -- a context, we *then* consistency check all of the instances\n           -- which mentioned that type.  We DO want to check instances\n           -- as quickly as possible, so that we aren't typechecking\n           -- values with inconsistent axioms in scope.\n           --\n           -- See also Note [Tying the knot]\n           -- for why we are doing this at all.\n           ; let check_now = famInstEnvElts env1\n           ; mapM_ (checkForConflicts (emptyFamInstEnv, env2))           check_now\n           ; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now\n }\n\ngetFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv\ngetFamInsts hpt_fam_insts mod\n  | Just env <- lookupModuleEnv hpt_fam_insts mod = return env\n  | otherwise = do { _ <- initIfaceTcRn (loadSysInterface doc mod)\n                   ; eps <- getEps\n                   ; return (expectJust \"checkFamInstConsistency\" $\n                             lookupModuleEnv (eps_mod_fam_inst_env eps) mod) }\n  where\n    doc = ppr mod <+> text \"is a family-instance module\"\n\n{-\n************************************************************************\n*                                                                      *\n        Lookup\n*                                                                      *\n************************************************************************\n\n-}\n\n-- | If @co :: T ts ~ rep_ty@ then:\n--\n-- > instNewTyCon_maybe T ts = Just (rep_ty, co)\n--\n-- Checks for a newtype, and for being saturated\n-- Just like Coercion.instNewTyCon_maybe, but returns a TcCoercion\ntcInstNewTyCon_maybe :: TyCon -> [TcType] -> Maybe (TcType, TcCoercion)\ntcInstNewTyCon_maybe = instNewTyCon_maybe\n\n-- | Like 'tcLookupDataFamInst_maybe', but returns the arguments back if\n-- there is no data family to unwrap.\n-- Returns a Representational coercion\ntcLookupDataFamInst :: FamInstEnvs -> TyCon -> [TcType]\n                    -> (TyCon, [TcType], Coercion)\ntcLookupDataFamInst fam_inst_envs tc tc_args\n  | Just (rep_tc, rep_args, co)\n      <- tcLookupDataFamInst_maybe fam_inst_envs tc tc_args\n  = (rep_tc, rep_args, co)\n  | otherwise\n  = (tc, tc_args, mkRepReflCo (mkTyConApp tc tc_args))\n\ntcLookupDataFamInst_maybe :: FamInstEnvs -> TyCon -> [TcType]\n                          -> Maybe (TyCon, [TcType], Coercion)\n-- ^ Converts a data family type (eg F [a]) to its representation type (eg FList a)\n-- and returns a coercion between the two: co :: F [a] ~R FList a.\ntcLookupDataFamInst_maybe fam_inst_envs tc tc_args\n  | isDataFamilyTyCon tc\n  , match : _ <- lookupFamInstEnv fam_inst_envs tc tc_args\n  , FamInstMatch { fim_instance = rep_fam@(FamInst { fi_axiom = ax\n                                                   , fi_cvs   = cvs })\n                 , fim_tys      = rep_args\n                 , fim_cos      = rep_cos } <- match\n  , let rep_tc = dataFamInstRepTyCon rep_fam\n        co     = mkUnbranchedAxInstCo Representational ax rep_args\n                                      (mkCoVarCos cvs)\n  = ASSERT( null rep_cos ) -- See Note [Constrained family instances] in FamInstEnv\n    Just (rep_tc, rep_args, co)\n\n  | otherwise\n  = Nothing\n\n-- | 'tcTopNormaliseNewTypeTF_maybe' gets rid of top-level newtypes,\n-- potentially looking through newtype /instances/.\n--\n-- It is only used by the type inference engine (specifically, when\n-- solving representational equality), and hence it is careful to unwrap\n-- only if the relevant data constructor is in scope.  That's why\n-- it get a GlobalRdrEnv argument.\n--\n-- It is careful not to unwrap data/newtype instances if it can't\n-- continue unwrapping.  Such care is necessary for proper error\n-- messages.\n--\n-- It does not look through type families.\n-- It does not normalise arguments to a tycon.\n--\n-- If the result is Just (rep_ty, (co, gres), rep_ty), then\n--    co : ty ~R rep_ty\n--    gres are the GREs for the data constructors that\n--                          had to be in scope\ntcTopNormaliseNewTypeTF_maybe :: FamInstEnvs\n                              -> GlobalRdrEnv\n                              -> Type\n                              -> Maybe ((Bag GlobalRdrElt, TcCoercion), Type)\ntcTopNormaliseNewTypeTF_maybe faminsts rdr_env ty\n-- cf. FamInstEnv.topNormaliseType_maybe and Coercion.topNormaliseNewType_maybe\n  = topNormaliseTypeX stepper plus ty\n  where\n    plus :: (Bag GlobalRdrElt, TcCoercion) -> (Bag GlobalRdrElt, TcCoercion)\n         -> (Bag GlobalRdrElt, TcCoercion)\n    plus (gres1, co1) (gres2, co2) = ( gres1 `unionBags` gres2\n                                     , co1 `mkTransCo` co2 )\n\n    stepper :: NormaliseStepper (Bag GlobalRdrElt, TcCoercion)\n    stepper = unwrap_newtype `composeSteppers` unwrap_newtype_instance\n\n    -- For newtype instances we take a double step or nothing, so that\n    -- we don't return the representation type of the newtype instance,\n    -- which would lead to terrible error messages\n    unwrap_newtype_instance rec_nts tc tys\n      | Just (tc', tys', co) <- tcLookupDataFamInst_maybe faminsts tc tys\n      = mapStepResult (\\(gres, co1) -> (gres, co `mkTransCo` co1)) $\n        unwrap_newtype rec_nts tc' tys'\n      | otherwise = NS_Done\n\n    unwrap_newtype rec_nts tc tys\n      | Just con <- newTyConDataCon_maybe tc\n      , Just gre <- lookupGRE_Name rdr_env (dataConName con)\n           -- This is where we check that the\n           -- data constructor is in scope\n      = mapStepResult (\\co -> (unitBag gre, co)) $\n        unwrapNewTypeStepper rec_nts tc tys\n\n      | otherwise\n      = NS_Done\n\n{-\n************************************************************************\n*                                                                      *\n        Extending the family instance environment\n*                                                                      *\n************************************************************************\n-}\n\n-- Add new locally-defined family instances, checking consistency with\n-- previous locally-defined family instances as well as all instances\n-- available from imported modules. This requires loading all of our\n-- imports that define family instances (if we haven't loaded them already).\ntcExtendLocalFamInstEnv :: [FamInst] -> TcM a -> TcM a\n\n-- If we weren't actually given any instances to add, then we don't want\n-- to go to the bother of loading family instance module dependencies.\ntcExtendLocalFamInstEnv [] thing_inside = thing_inside\n\n-- Otherwise proceed...\ntcExtendLocalFamInstEnv fam_insts thing_inside\n = do { -- Load family-instance modules \"below\" this module, so that\n        -- allLocalFamInst can check for consistency with them\n        -- See Note [The type family instance consistency story]\n        loadDependentFamInstModules fam_insts\n\n        -- Now add the instances one by one\n      ; env <- getGblEnv\n      ; (inst_env', fam_insts') <- foldlM addLocalFamInst\n                                       (tcg_fam_inst_env env, tcg_fam_insts env)\n                                       fam_insts\n\n      ; let env' = env { tcg_fam_insts    = fam_insts'\n                       , tcg_fam_inst_env = inst_env' }\n      ; setGblEnv env' thing_inside\n      }\n\nloadDependentFamInstModules :: [FamInst] -> TcM ()\n-- Load family-instance modules \"below\" this module, so that\n-- allLocalFamInst can check for consistency with them\n-- See Note [The type family instance consistency story]\nloadDependentFamInstModules fam_insts\n = do { env <- getGblEnv\n      ; let this_mod = tcg_mod env\n            imports  = tcg_imports env\n\n            want_module mod  -- See Note [Home package family instances]\n              | mod == this_mod = False\n              | home_fams_only  = moduleUnitId mod == moduleUnitId this_mod\n              | otherwise       = True\n            home_fams_only = all (nameIsHomePackage this_mod . fi_fam) fam_insts\n\n      ; loadModuleInterfaces (text \"Loading family-instance modules\") $\n        filter want_module (imp_finsts imports) }\n\n{- Note [Home package family instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOptimization: If we're only defining type family instances\nfor type families *defined in the home package*, then we\nonly have to load interface files that belong to the home\npackage. The reason is that there's no recursion between\npackages, so modules in other packages can't possibly define\ninstances for our type families.\n\n(Within the home package, we could import a module M that\nimports us via an hs-boot file, and thereby defines an\ninstance of a type family defined in this module. So we can't\napply the same logic to avoid reading any interface files at\nall, when we define an instances for type family defined in\nthe current module.\n-}\n\n-- Check that the proposed new instance is OK,\n-- and then add it to the home inst env\n-- This must be lazy in the fam_inst arguments, see Note [Lazy axiom match]\n-- in FamInstEnv.hs\naddLocalFamInst :: (FamInstEnv,[FamInst])\n                -> FamInst\n                -> TcM (FamInstEnv, [FamInst])\naddLocalFamInst (home_fie, my_fis) fam_inst\n        -- home_fie includes home package and this module\n        -- my_fies is just the ones from this module\n  = do { traceTc \"addLocalFamInst\" (ppr fam_inst)\n\n           -- Unlike the case of class instances, don't override existing\n           -- instances in GHCi; it's unsound. See #7102.\n\n       ; mod <- getModule\n       ; traceTc \"alfi\" (ppr mod)\n\n           -- Fetch imported instances, so that we report\n           -- overlaps correctly.\n           -- Really we ought to only check consistency with\n           -- those instances which are transitively imported\n           -- by the current module, rather than every instance\n           -- we've ever seen. Fixing this is part of #13102.\n       ; eps <- getEps\n       ; let inst_envs = (eps_fam_inst_env eps, home_fie)\n             home_fie' = extendFamInstEnv home_fie fam_inst\n\n           -- Check for conflicting instance decls and injectivity violations\n       ; no_conflict    <- checkForConflicts            inst_envs fam_inst\n       ; injectivity_ok <- checkForInjectivityConflicts inst_envs fam_inst\n\n       ; if no_conflict && injectivity_ok then\n            return (home_fie', fam_inst : my_fis)\n         else\n            return (home_fie,  my_fis) }\n\n{-\n************************************************************************\n*                                                                      *\n        Checking an instance against conflicts with an instance env\n*                                                                      *\n************************************************************************\n\nCheck whether a single family instance conflicts with those in two instance\nenvironments (one for the EPS and one for the HPT).\n-}\n\ncheckForConflicts :: FamInstEnvs -> FamInst -> TcM Bool\ncheckForConflicts inst_envs fam_inst\n  = do { let conflicts = lookupFamInstEnvConflicts inst_envs fam_inst\n       ; traceTc \"checkForConflicts\" $\n         vcat [ ppr (map fim_instance conflicts)\n              , ppr fam_inst\n              -- , ppr inst_envs\n         ]\n       ; reportConflictInstErr fam_inst conflicts\n       ; return (null conflicts) }\n\n-- | Check whether a new open type family equation can be added without\n-- violating injectivity annotation supplied by the user. Returns True when\n-- this is possible and False if adding this equation would violate injectivity\n-- annotation.\ncheckForInjectivityConflicts :: FamInstEnvs -> FamInst -> TcM Bool\ncheckForInjectivityConflicts instEnvs famInst\n    | isTypeFamilyTyCon tycon\n    -- type family is injective in at least one argument\n    , Injective inj <- tyConInjectivityInfo tycon = do\n    { let axiom = coAxiomSingleBranch fi_ax\n          conflicts = lookupFamInstEnvInjectivityConflicts inj instEnvs famInst\n          -- see Note [Verifying injectivity annotation] in FamInstEnv\n          errs = makeInjectivityErrors fi_ax axiom inj conflicts\n    ; mapM_ (\\(err, span) -> setSrcSpan span $ addErr err) errs\n    ; return (null errs)\n    }\n\n    -- if there was no injectivity annotation or tycon does not represent a\n    -- type family we report no conflicts\n    | otherwise = return True\n    where tycon = famInstTyCon famInst\n          fi_ax = fi_axiom famInst\n\n-- | Build a list of injectivity errors together with their source locations.\nmakeInjectivityErrors\n   :: CoAxiom br   -- ^ Type family for which we generate errors\n   -> CoAxBranch   -- ^ Currently checked equation (represented by axiom)\n   -> [Bool]       -- ^ Injectivity annotation\n   -> [CoAxBranch] -- ^ List of injectivity conflicts\n   -> [(SDoc, SrcSpan)]\nmakeInjectivityErrors fi_ax axiom inj conflicts\n  = ASSERT2( any id inj, text \"No injective type variables\" )\n    let lhs             = coAxBranchLHS axiom\n        rhs             = coAxBranchRHS axiom\n        fam_tc          = coAxiomTyCon fi_ax\n        are_conflicts   = not $ null conflicts\n        unused_inj_tvs  = unusedInjTvsInRHS fam_tc inj lhs rhs\n        inj_tvs_unused  = not $ and (isEmptyVarSet <$> unused_inj_tvs)\n        tf_headed       = isTFHeaded rhs\n        bare_variables  = bareTvInRHSViolated lhs rhs\n        wrong_bare_rhs  = not $ null bare_variables\n\n        err_builder herald eqns\n                        = ( hang herald\n                               2 (vcat (map (pprCoAxBranchUser fam_tc) eqns))\n                          , coAxBranchSpan (head eqns) )\n        errorIf p f     = if p then [f err_builder axiom] else []\n     in    errorIf are_conflicts  (conflictInjInstErr     conflicts     )\n        ++ errorIf inj_tvs_unused (unusedInjectiveVarsErr unused_inj_tvs)\n        ++ errorIf tf_headed       tfHeadedErr\n        ++ errorIf wrong_bare_rhs (bareVariableInRHSErr   bare_variables)\n\n\n-- | Return a list of type variables that the function is injective in and that\n-- do not appear on injective positions in the RHS of a family instance\n-- declaration. The returned Pair includes invisible vars followed by visible ones\nunusedInjTvsInRHS :: TyCon -> [Bool] -> [Type] -> Type -> Pair TyVarSet\n-- INVARIANT: [Bool] list contains at least one True value\n-- See Note [Verifying injectivity annotation]. This function implements fourth\n-- check described there.\n-- In theory, instead of implementing this whole check in this way, we could\n-- attempt to unify equation with itself.  We would reject exactly the same\n-- equations but this method gives us more precise error messages by returning\n-- precise names of variables that are not mentioned in the RHS.\nunusedInjTvsInRHS tycon injList lhs rhs =\n  (`minusVarSet` injRhsVars) <$> injLHSVars\n    where\n      inj_pairs :: [(Type, ArgFlag)]\n      -- All the injective arguments, paired with their visibility\n      inj_pairs = ASSERT2( injList `equalLength` lhs\n                         , ppr tycon $$ ppr injList $$ ppr lhs )\n                  filterByList injList (lhs `zip` tyConArgFlags tycon lhs)\n\n      -- set of type and kind variables in which type family is injective\n      invis_lhs, vis_lhs :: [Type]\n      (invis_lhs, vis_lhs) = partitionInvisibles inj_pairs\n\n      invis_vars = tyCoVarsOfTypes invis_lhs\n      Pair invis_vars' vis_vars = splitVisVarsOfTypes vis_lhs\n      injLHSVars\n        = Pair (invis_vars `minusVarSet` vis_vars `unionVarSet` invis_vars')\n               vis_vars\n\n      -- set of type variables appearing in the RHS on an injective position.\n      -- For all returned variables we assume their associated kind variables\n      -- also appear in the RHS.\n      injRhsVars = injTyVarsOfType rhs\n\ninjTyVarsOfType :: TcTauType -> TcTyVarSet\n-- Collect all type variables that are either arguments to a type\n--   constructor or to /injective/ type families.\n-- Determining the overall type determines thes variables\n--\n-- E.g.   Suppose F is injective in its second arg, but not its first\n--        then injVarOfType (Either a (F [b] (a,c))) = {a,c}\n--        Determining the overall type determines a,c but not b.\ninjTyVarsOfType ty\n  | Just ty' <- coreView ty -- #12430\n  = injTyVarsOfType ty'\ninjTyVarsOfType (TyVarTy v)\n  = unitVarSet v `unionVarSet` injTyVarsOfType (tyVarKind v)\ninjTyVarsOfType (TyConApp tc tys)\n  | isTypeFamilyTyCon tc\n   = case tyConInjectivityInfo tc of\n        NotInjective  -> emptyVarSet\n        Injective inj -> injTyVarsOfTypes (filterByList inj tys)\n  | otherwise\n  = injTyVarsOfTypes tys\ninjTyVarsOfType (LitTy {})\n  = emptyVarSet\ninjTyVarsOfType (FunTy _ arg res)\n  = injTyVarsOfType arg `unionVarSet` injTyVarsOfType res\ninjTyVarsOfType (AppTy fun arg)\n  = injTyVarsOfType fun `unionVarSet` injTyVarsOfType arg\n-- No forall types in the RHS of a type family\ninjTyVarsOfType (CastTy ty _)   = injTyVarsOfType ty\ninjTyVarsOfType (CoercionTy {}) = emptyVarSet\ninjTyVarsOfType (ForAllTy {})    =\n    panic \"unusedInjTvsInRHS.injTyVarsOfType\"\n\ninjTyVarsOfTypes :: [Type] -> VarSet\ninjTyVarsOfTypes tys = mapUnionVarSet injTyVarsOfType tys\n\n-- | Is type headed by a type family application?\nisTFHeaded :: Type -> Bool\n-- See Note [Verifying injectivity annotation]. This function implements third\n-- check described there.\nisTFHeaded ty | Just ty' <- coreView ty\n              = isTFHeaded ty'\nisTFHeaded ty | (TyConApp tc args) <- ty\n              , isTypeFamilyTyCon tc\n              = args `lengthIs` tyConArity tc\nisTFHeaded _  = False\n\n\n-- | If a RHS is a bare type variable return a set of LHS patterns that are not\n-- bare type variables.\nbareTvInRHSViolated :: [Type] -> Type -> [Type]\n-- See Note [Verifying injectivity annotation]. This function implements second\n-- check described there.\nbareTvInRHSViolated pats rhs | isTyVarTy rhs\n   = filter (not . isTyVarTy) pats\nbareTvInRHSViolated _ _ = []\n\n\n-- | Type of functions that use error message and a list of axioms to build full\n-- error message (with a source location) for injective type families.\ntype InjErrorBuilder = SDoc -> [CoAxBranch] -> (SDoc, SrcSpan)\n\n-- | Build injecivity error herald common to all injectivity errors.\ninjectivityErrorHerald :: Bool -> SDoc\ninjectivityErrorHerald isSingular =\n  text \"Type family equation\" <> s isSingular <+> text \"violate\" <>\n  s (not isSingular) <+> text \"injectivity annotation\" <>\n  if isSingular then dot else colon\n  -- Above is an ugly hack.  We want this: \"sentence. herald:\" (note the dot and\n  -- colon).  But if herald is empty we want \"sentence:\" (note the colon).  We\n  -- can't test herald for emptiness so we rely on the fact that herald is empty\n  -- only when isSingular is False.  If herald is non empty it must end with a\n  -- colon.\n    where\n      s False = text \"s\"\n      s True  = empty\n\n-- | Build error message for a pair of equations violating an injectivity\n-- annotation.\nconflictInjInstErr :: [CoAxBranch] -> InjErrorBuilder -> CoAxBranch\n                   -> (SDoc, SrcSpan)\nconflictInjInstErr conflictingEqns errorBuilder tyfamEqn\n  | confEqn : _ <- conflictingEqns\n  = errorBuilder (injectivityErrorHerald False) [confEqn, tyfamEqn]\n  | otherwise\n  = panic \"conflictInjInstErr\"\n\n-- | Build error message for equation with injective type variables unused in\n-- the RHS.\nunusedInjectiveVarsErr :: Pair TyVarSet -> InjErrorBuilder -> CoAxBranch\n                       -> (SDoc, SrcSpan)\nunusedInjectiveVarsErr (Pair invis_vars vis_vars) errorBuilder tyfamEqn\n  = let (doc, loc) = errorBuilder (injectivityErrorHerald True $$ msg)\n                                  [tyfamEqn]\n    in (pprWithExplicitKindsWhen has_kinds doc, loc)\n    where\n      tvs = invis_vars `unionVarSet` vis_vars\n      has_types = not $ isEmptyVarSet vis_vars\n      has_kinds = not $ isEmptyVarSet invis_vars\n\n      doc = sep [ what <+> text \"variable\" <>\n                  pluralVarSet tvs <+> pprVarSet tvs (pprQuotedList . scopedSort)\n                , text \"cannot be inferred from the right-hand side.\" ]\n      what = case (has_types, has_kinds) of\n               (True, True)   -> text \"Type and kind\"\n               (True, False)  -> text \"Type\"\n               (False, True)  -> text \"Kind\"\n               (False, False) -> pprPanic \"mkUnusedInjectiveVarsErr\" $ ppr tvs\n      msg = doc $$ text \"In the type family equation:\"\n\n-- | Build error message for equation that has a type family call at the top\n-- level of RHS\ntfHeadedErr :: InjErrorBuilder -> CoAxBranch\n            -> (SDoc, SrcSpan)\ntfHeadedErr errorBuilder famInst\n  = errorBuilder (injectivityErrorHerald True $$\n                  text \"RHS of injective type family equation cannot\" <+>\n                  text \"be a type family:\") [famInst]\n\n-- | Build error message for equation that has a bare type variable in the RHS\n-- but LHS pattern is not a bare type variable.\nbareVariableInRHSErr :: [Type] -> InjErrorBuilder -> CoAxBranch\n                     -> (SDoc, SrcSpan)\nbareVariableInRHSErr tys errorBuilder famInst\n  = errorBuilder (injectivityErrorHerald True $$\n                  text \"RHS of injective type family equation is a bare\" <+>\n                  text \"type variable\" $$\n                  text \"but these LHS type and kind patterns are not bare\" <+>\n                  text \"variables:\" <+> pprQuotedList tys) [famInst]\n\n\nreportConflictInstErr :: FamInst -> [FamInstMatch] -> TcRn ()\nreportConflictInstErr _ []\n  = return ()  -- No conflicts\nreportConflictInstErr fam_inst (match1 : _)\n  | FamInstMatch { fim_instance = conf_inst } <- match1\n  , let sorted  = sortWith getSpan [fam_inst, conf_inst]\n        fi1     = head sorted\n        span    = coAxBranchSpan (coAxiomSingleBranch (famInstAxiom fi1))\n  = setSrcSpan span $ addErr $\n    hang (text \"Conflicting family instance declarations:\")\n       2 (vcat [ pprCoAxBranchUser (coAxiomTyCon ax) (coAxiomSingleBranch ax)\n               | fi <- sorted\n               , let ax = famInstAxiom fi ])\n where\n   getSpan = getSrcLoc . famInstAxiom\n   -- The sortWith just arranges that instances are dislayed in order\n   -- of source location, which reduced wobbling in error messages,\n   -- and is better for users\n\ntcGetFamInstEnvs :: TcM FamInstEnvs\n-- Gets both the external-package inst-env\n-- and the home-pkg inst env (includes module being compiled)\ntcGetFamInstEnvs\n  = do { eps <- getEps; env <- getGblEnv\n       ; return (eps_fam_inst_env eps, tcg_fam_inst_env env) }\n", "num_lines": 956}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 2000\n\n\nFunDeps - functional dependencies\n\nIt's better to read it as: \"if we know these, then we're going to know these\"\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule FunDeps (\n        FunDepEqn(..), pprEquation,\n        improveFromInstEnv, improveFromAnother,\n        checkInstCoverage, checkFunDeps,\n        pprFundeps\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Name\nimport Var\nimport Class\nimport Type\nimport TcType( transSuperClasses )\nimport CoAxiom( TypeEqn )\nimport Unify\nimport FamInst( injTyVarsOfTypes )\nimport InstEnv\nimport VarSet\nimport VarEnv\nimport Outputable\nimport ErrUtils( Validity(..), allValid )\nimport SrcLoc\nimport Util\n\nimport Pair             ( Pair(..) )\nimport Data.List        ( nubBy )\nimport Data.Maybe\nimport Data.Foldable    ( fold )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Generate equations from functional dependencies}\n*                                                                      *\n************************************************************************\n\n\nEach functional dependency with one variable in the RHS is responsible\nfor generating a single equality. For instance:\n     class C a b | a -> b\nThe constraints ([Wanted] C Int Bool) and [Wanted] C Int alpha\nwill generate the following FunDepEqn\n     FDEqn { fd_qtvs = []\n           , fd_eqs  = [Pair Bool alpha]\n           , fd_pred1 = C Int Bool\n           , fd_pred2 = C Int alpha\n           , fd_loc = ... }\nHowever notice that a functional dependency may have more than one variable\nin the RHS which will create more than one pair of types in fd_eqs. Example:\n     class C a b c | a -> b c\n     [Wanted] C Int alpha alpha\n     [Wanted] C Int Bool beta\nWill generate:\n     FDEqn { fd_qtvs = []\n           , fd_eqs  = [Pair Bool alpha, Pair alpha beta]\n           , fd_pred1 = C Int Bool\n           , fd_pred2 = C Int alpha\n           , fd_loc = ... }\n\nINVARIANT: Corresponding types aren't already equal\nThat is, there exists at least one non-identity equality in FDEqs.\n\nAssume:\n       class C a b c | a -> b c\n       instance C Int x x\nAnd:   [Wanted] C Int Bool alpha\nWe will /match/ the LHS of fundep equations, producing a matching substitution\nand create equations for the RHS sides. In our last example we'd have generated:\n      ({x}, [fd1,fd2])\nwhere\n       fd1 = FDEq 1 Bool x\n       fd2 = FDEq 2 alpha x\nTo ``execute'' the equation, make fresh type variable for each tyvar in the set,\ninstantiate the two types with these fresh variables, and then unify or generate\na new constraint. In the above example we would generate a new unification\nvariable 'beta' for x and produce the following constraints:\n     [Wanted] (Bool ~ beta)\n     [Wanted] (alpha ~ beta)\n\nNotice the subtle difference between the above class declaration and:\n       class C a b c | a -> b, a -> c\nwhere we would generate:\n      ({x},[fd1]),({x},[fd2])\nThis means that the template variable would be instantiated to different\nunification variables when producing the FD constraints.\n\nFinally, the position parameters will help us rewrite the wanted constraint ``on the spot''\n-}\n\ndata FunDepEqn loc\n  = FDEqn { fd_qtvs :: [TyVar]   -- Instantiate these type and kind vars\n                                 --   to fresh unification vars,\n                                 -- Non-empty only for FunDepEqns arising from instance decls\n\n          , fd_eqs   :: [TypeEqn]  -- Make these pairs of types equal\n          , fd_pred1 :: PredType   -- The FunDepEqn arose from\n          , fd_pred2 :: PredType   --  combining these two constraints\n          , fd_loc   :: loc  }\n\n{-\nGiven a bunch of predicates that must hold, such as\n\n        C Int t1, C Int t2, C Bool t3, ?x::t4, ?x::t5\n\nimprove figures out what extra equations must hold.\nFor example, if we have\n\n        class C a b | a->b where ...\n\nthen improve will return\n\n        [(t1,t2), (t4,t5)]\n\nNOTA BENE:\n\n  * improve does not iterate.  It's possible that when we make\n    t1=t2, for example, that will in turn trigger a new equation.\n    This would happen if we also had\n        C t1 t7, C t2 t8\n    If t1=t2, we also get t7=t8.\n\n    improve does *not* do this extra step.  It relies on the caller\n    doing so.\n\n  * The equations unify types that are not already equal.  So there\n    is no effect iff the result of improve is empty\n-}\n\ninstFD :: FunDep TyVar -> [TyVar] -> [Type] -> FunDep Type\n-- (instFD fd tvs tys) returns fd instantiated with (tvs -> tys)\ninstFD (ls,rs) tvs tys\n  = (map lookup ls, map lookup rs)\n  where\n    env       = zipVarEnv tvs tys\n    lookup tv = lookupVarEnv_NF env tv\n\nzipAndComputeFDEqs :: (Type -> Type -> Bool) -- Discard this FDEq if true\n                   -> [Type] -> [Type]\n                   -> [TypeEqn]\n-- Create a list of (Type,Type) pairs from two lists of types,\n-- making sure that the types are not already equal\nzipAndComputeFDEqs discard (ty1:tys1) (ty2:tys2)\n | discard ty1 ty2 = zipAndComputeFDEqs discard tys1 tys2\n | otherwise       = Pair ty1 ty2 : zipAndComputeFDEqs discard tys1 tys2\nzipAndComputeFDEqs _ _ _ = []\n\n-- Improve a class constraint from another class constraint\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nimproveFromAnother :: loc\n                   -> PredType -- Template item (usually given, or inert)\n                   -> PredType -- Workitem [that can be improved]\n                   -> [FunDepEqn loc]\n-- Post: FDEqs always oriented from the other to the workitem\n--       Equations have empty quantified variables\nimproveFromAnother loc pred1 pred2\n  | Just (cls1, tys1) <- getClassPredTys_maybe pred1\n  , Just (cls2, tys2) <- getClassPredTys_maybe pred2\n  , cls1 == cls2\n  = [ FDEqn { fd_qtvs = [], fd_eqs = eqs, fd_pred1 = pred1, fd_pred2 = pred2, fd_loc = loc }\n    | let (cls_tvs, cls_fds) = classTvsFds cls1\n    , fd <- cls_fds\n    , let (ltys1, rs1) = instFD fd cls_tvs tys1\n          (ltys2, rs2) = instFD fd cls_tvs tys2\n    , eqTypes ltys1 ltys2               -- The LHSs match\n    , let eqs = zipAndComputeFDEqs eqType rs1 rs2\n    , not (null eqs) ]\n\nimproveFromAnother _ _ _ = []\n\n\n-- Improve a class constraint from instance declarations\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\ninstance Outputable (FunDepEqn a) where\n  ppr = pprEquation\n\npprEquation :: FunDepEqn a -> SDoc\npprEquation (FDEqn { fd_qtvs = qtvs, fd_eqs = pairs })\n  = vcat [text \"forall\" <+> braces (pprWithCommas ppr qtvs),\n          nest 2 (vcat [ ppr t1 <+> text \"~\" <+> ppr t2\n                       | Pair t1 t2 <- pairs])]\n\nimproveFromInstEnv :: InstEnvs\n                   -> (PredType -> SrcSpan -> loc)\n                   -> PredType\n                   -> [FunDepEqn loc] -- Needs to be a FunDepEqn because\n                                      -- of quantified variables\n-- Post: Equations oriented from the template (matching instance) to the workitem!\nimproveFromInstEnv inst_env mk_loc pred\n  | Just (cls, tys) <- ASSERT2( isClassPred pred, ppr pred )\n                       getClassPredTys_maybe pred\n  , let (cls_tvs, cls_fds) = classTvsFds cls\n        instances          = classInstances inst_env cls\n        rough_tcs          = roughMatchTcs tys\n  = [ FDEqn { fd_qtvs = meta_tvs, fd_eqs = eqs\n            , fd_pred1 = p_inst, fd_pred2 = pred\n            , fd_loc = mk_loc p_inst (getSrcSpan (is_dfun ispec)) }\n    | fd <- cls_fds             -- Iterate through the fundeps first,\n                                -- because there often are none!\n    , let trimmed_tcs = trimRoughMatchTcs cls_tvs fd rough_tcs\n                -- Trim the rough_tcs based on the head of the fundep.\n                -- Remember that instanceCantMatch treats both arguments\n                -- symmetrically, so it's ok to trim the rough_tcs,\n                -- rather than trimming each inst_tcs in turn\n    , ispec <- instances\n    , (meta_tvs, eqs) <- improveClsFD cls_tvs fd ispec\n                                      tys trimmed_tcs -- NB: orientation\n    , let p_inst = mkClassPred cls (is_tys ispec)\n    ]\nimproveFromInstEnv _ _ _ = []\n\n\nimproveClsFD :: [TyVar] -> FunDep TyVar    -- One functional dependency from the class\n             -> ClsInst                    -- An instance template\n             -> [Type] -> [Maybe Name]     -- Arguments of this (C tys) predicate\n             -> [([TyCoVar], [TypeEqn])]   -- Empty or singleton\n\nimproveClsFD clas_tvs fd\n             (ClsInst { is_tvs = qtvs, is_tys = tys_inst, is_tcs = rough_tcs_inst })\n             tys_actual rough_tcs_actual\n\n-- Compare instance      {a,b}    C sx sp sy sq\n--         with wanted     [W] C tx tp ty tq\n--         for fundep (x,y -> p,q)  from class  (C x p y q)\n-- If (sx,sy) unifies with (tx,ty), take the subst S\n\n-- 'qtvs' are the quantified type variables, the ones which can be instantiated\n-- to make the types match.  For example, given\n--      class C a b | a->b where ...\n--      instance C (Maybe x) (Tree x) where ..\n--\n-- and a wanted constraint of form (C (Maybe t1) t2),\n-- then we will call checkClsFD with\n--\n--      is_qtvs = {x}, is_tys = [Maybe x,  Tree x]\n--                     tys_actual = [Maybe t1, t2]\n--\n-- We can instantiate x to t1, and then we want to force\n--      (Tree x) [t1/x]  ~   t2\n\n  | instanceCantMatch rough_tcs_inst rough_tcs_actual\n  = []          -- Filter out ones that can't possibly match,\n\n  | otherwise\n  = ASSERT2( equalLength tys_inst tys_actual &&\n             equalLength tys_inst clas_tvs\n            , ppr tys_inst <+> ppr tys_actual )\n\n    case tcMatchTyKis ltys1 ltys2 of\n        Nothing  -> []\n        Just subst | isJust (tcMatchTyKisX subst rtys1 rtys2)\n                        -- Don't include any equations that already hold.\n                        -- Reason: then we know if any actual improvement has happened,\n                        --         in which case we need to iterate the solver\n                        -- In making this check we must taking account of the fact that any\n                        -- qtvs that aren't already instantiated can be instantiated to anything\n                        -- at all\n                        -- NB: We can't do this 'is-useful-equation' check element-wise\n                        --     because of:\n                        --           class C a b c | a -> b c\n                        --           instance C Int x x\n                        --           [Wanted] C Int alpha Int\n                        -- We would get that  x -> alpha  (isJust) and x -> Int (isJust)\n                        -- so we would produce no FDs, which is clearly wrong.\n                  -> []\n\n                  | null fdeqs\n                  -> []\n\n                  | otherwise\n                  -> -- pprTrace \"iproveClsFD\" (vcat\n                     --  [ text \"is_tvs =\" <+> ppr qtvs\n                     --  , text \"tys_inst =\" <+> ppr tys_inst\n                     --  , text \"tys_actual =\" <+> ppr tys_actual\n                     --  , text \"ltys1 =\" <+> ppr ltys1\n                     --  , text \"ltys2 =\" <+> ppr ltys2\n                     --  , text \"subst =\" <+> ppr subst ]) $\n                     [(meta_tvs, fdeqs)]\n                        -- We could avoid this substTy stuff by producing the eqn\n                        -- (qtvs, ls1++rs1, ls2++rs2)\n                        -- which will re-do the ls1/ls2 unification when the equation is\n                        -- executed.  What we're doing instead is recording the partial\n                        -- work of the ls1/ls2 unification leaving a smaller unification problem\n                  where\n                    rtys1' = map (substTyUnchecked subst) rtys1\n\n                    fdeqs = zipAndComputeFDEqs (\\_ _ -> False) rtys1' rtys2\n                        -- Don't discard anything!\n                        -- We could discard equal types but it's an overkill to call\n                        -- eqType again, since we know for sure that /at least one/\n                        -- equation in there is useful)\n\n                    meta_tvs = [ setVarType tv (substTyUnchecked subst (varType tv))\n                               | tv <- qtvs, tv `notElemTCvSubst` subst ]\n                        -- meta_tvs are the quantified type variables\n                        -- that have not been substituted out\n                        --\n                        -- Eg.  class C a b | a -> b\n                        --      instance C Int [y]\n                        -- Given constraint C Int z\n                        -- we generate the equation\n                        --      ({y}, [y], z)\n                        --\n                        -- But note (a) we get them from the dfun_id, so they are *in order*\n                        --              because the kind variables may be mentioned in the\n                        --              type variabes' kinds\n                        --          (b) we must apply 'subst' to the kinds, in case we have\n                        --              matched out a kind variable, but not a type variable\n                        --              whose kind mentions that kind variable!\n                        --          Trac #6015, #6068\n  where\n    (ltys1, rtys1) = instFD fd clas_tvs tys_inst\n    (ltys2, rtys2) = instFD fd clas_tvs tys_actual\n\n{-\n%************************************************************************\n%*                                                                      *\n        The Coverage condition for instance declarations\n*                                                                      *\n************************************************************************\n\nNote [Coverage condition]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nExample\n      class C a b | a -> b\n      instance theta => C t1 t2\n\nFor the coverage condition, we check\n   (normal)    fv(t2) `subset` fv(t1)\n   (liberal)   fv(t2) `subset` oclose(fv(t1), theta)\n\nThe liberal version  ensures the self-consistency of the instance, but\nit does not guarantee termination. Example:\n\n   class Mul a b c | a b -> c where\n        (.*.) :: a -> b -> c\n\n   instance Mul Int Int Int where (.*.) = (*)\n   instance Mul Int Float Float where x .*. y = fromIntegral x * y\n   instance Mul a b c => Mul a [b] [c] where x .*. v = map (x.*.) v\n\nIn the third instance, it's not the case that fv([c]) `subset` fv(a,[b]).\nBut it is the case that fv([c]) `subset` oclose( theta, fv(a,[b]) )\n\nBut it is a mistake to accept the instance because then this defn:\n        f = \\ b x y -> if b then x .*. [y] else y\nmakes instance inference go into a loop, because it requires the constraint\n        Mul a [b] b\n-}\n\ncheckInstCoverage :: Bool   -- Be liberal\n                  -> Class -> [PredType] -> [Type]\n                  -> Validity\n-- \"be_liberal\" flag says whether to use \"liberal\" coverage of\n--              See Note [Coverage Condition] below\n--\n-- Return values\n--    Nothing  => no problems\n--    Just msg => coverage problem described by msg\n\ncheckInstCoverage be_liberal clas theta inst_taus\n  = allValid (map fundep_ok fds)\n  where\n    (tyvars, fds) = classTvsFds clas\n    fundep_ok fd\n       | and (isEmptyVarSet <$> undetermined_tvs) = IsValid\n       | otherwise                                = NotValid msg\n       where\n         (ls,rs) = instFD fd tyvars inst_taus\n         ls_tvs = tyCoVarsOfTypes ls\n         rs_tvs = splitVisVarsOfTypes rs\n\n         undetermined_tvs | be_liberal = liberal_undet_tvs\n                          | otherwise  = conserv_undet_tvs\n\n         closed_ls_tvs = oclose theta ls_tvs\n         liberal_undet_tvs = (`minusVarSet` closed_ls_tvs) <$> rs_tvs\n         conserv_undet_tvs = (`minusVarSet` ls_tvs)        <$> rs_tvs\n\n         undet_set = fold undetermined_tvs\n\n         msg = pprWithExplicitKindsWhen\n                 (isEmptyVarSet $ pSnd undetermined_tvs) $\n               vcat [ -- text \"ls_tvs\" <+> ppr ls_tvs\n                      -- , text \"closed ls_tvs\" <+> ppr (closeOverKinds ls_tvs)\n                      -- , text \"theta\" <+> ppr theta\n                      -- , text \"oclose\" <+> ppr (oclose theta (closeOverKinds ls_tvs))\n                      -- , text \"rs_tvs\" <+> ppr rs_tvs\n                      sep [ text \"The\"\n                            <+> ppWhen be_liberal (text \"liberal\")\n                            <+> text \"coverage condition fails in class\"\n                            <+> quotes (ppr clas)\n                          , nest 2 $ text \"for functional dependency:\"\n                            <+> quotes (pprFunDep fd) ]\n                    , sep [ text \"Reason: lhs type\"<>plural ls <+> pprQuotedList ls\n                          , nest 2 $\n                            (if isSingleton ls\n                             then text \"does not\"\n                             else text \"do not jointly\")\n                            <+> text \"determine rhs type\"<>plural rs\n                            <+> pprQuotedList rs ]\n                    , text \"Un-determined variable\" <> pluralVarSet undet_set <> colon\n                            <+> pprVarSet undet_set (pprWithCommas ppr)\n                    , ppWhen (not be_liberal &&\n                              and (isEmptyVarSet <$> liberal_undet_tvs)) $\n                      text \"Using UndecidableInstances might help\" ]\n\n{- Note [Closing over kinds in coverage]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have a fundep  (a::k) -> b\nThen if 'a' is instantiated to (x y), where x:k2->*, y:k2,\nthen fixing x really fixes k2 as well, and so k2 should be added to\nthe lhs tyvars in the fundep check.\n\nExample (Trac #8391), using liberal coverage\n      data Foo a = ...  -- Foo :: forall k. k -> *\n      class Bar a b | a -> b\n      instance Bar a (Foo a)\n\n    In the instance decl, (a:k) does fix (Foo k a), but only if we notice\n    that (a:k) fixes k.  Trac #10109 is another example.\n\nHere is a more subtle example, from HList-0.4.0.0 (Trac #10564)\n\n  class HasFieldM (l :: k) r (v :: Maybe *)\n        | l r -> v where ...\n  class HasFieldM1 (b :: Maybe [*]) (l :: k) r v\n        | b l r -> v where ...\n  class HMemberM (e1 :: k) (l :: [k]) (r :: Maybe [k])\n        | e1 l -> r\n\n  data Label :: k -> *\n  type family LabelsOf (a :: [*]) ::  *\n\n  instance (HMemberM (Label {k} (l::k)) (LabelsOf xs) b,\n            HasFieldM1 b l (r xs) v)\n         => HasFieldM l (r xs) v where\n\nIs the instance OK? Does {l,r,xs} determine v?  Well:\n\n  * From the instance constraint HMemberM (Label k l) (LabelsOf xs) b,\n    plus the fundep \"| el l -> r\" in class HMameberM,\n    we get {l,k,xs} -> b\n\n  * Note the 'k'!! We must call closeOverKinds on the seed set\n    ls_tvs = {l,r,xs}, BEFORE doing oclose, else the {l,k,xs}->b\n    fundep won't fire.  This was the reason for #10564.\n\n  * So starting from seeds {l,r,xs,k} we do oclose to get\n    first {l,r,xs,k,b}, via the HMemberM constraint, and then\n    {l,r,xs,k,b,v}, via the HasFieldM1 constraint.\n\n  * And that fixes v.\n\nHowever, we must closeOverKinds whenever augmenting the seed set\nin oclose!  Consider Trac #10109:\n\n  data Succ a   -- Succ :: forall k. k -> *\n  class Add (a :: k1) (b :: k2) (ab :: k3) | a b -> ab\n  instance (Add a b ab) => Add (Succ {k1} (a :: k1))\n                               b\n                               (Succ {k3} (ab :: k3})\n\nWe start with seed set {a:k1,b:k2} and closeOverKinds to {a,k1,b,k2}.\nNow use the fundep to extend to {a,k1,b,k2,ab}.  But we need to\ncloseOverKinds *again* now to {a,k1,b,k2,ab,k3}, so that we fix all\nthe variables free in (Succ {k3} ab).\n\nBottom line:\n  * closeOverKinds on initial seeds (done automatically\n    by tyCoVarsOfTypes in checkInstCoverage)\n  * and closeOverKinds whenever extending those seeds (in oclose)\n\nNote [The liberal coverage condition]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(oclose preds tvs) closes the set of type variables tvs,\nwrt functional dependencies in preds.  The result is a superset\nof the argument set.  For example, if we have\n        class C a b | a->b where ...\nthen\n        oclose [C (x,y) z, C (x,p) q] {x,y} = {x,y,z}\nbecause if we know x and y then that fixes z.\n\nWe also use equality predicates in the predicates; if we have an\nassumption `t1 ~ t2`, then we use the fact that if we know `t1` we\nalso know `t2` and the other way.\n  eg    oclose [C (x,y) z, a ~ x] {a,y} = {a,y,z,x}\n\noclose is used (only) when checking the coverage condition for\nan instance declaration\n\nNote [Equality superclasses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n  class (a ~ [b]) => C a b\n\nRemember from Note [The equality types story] in TysPrim, that\n  * (a ~~ b) is a superclass of (a ~ b)\n  * (a ~# b) is a superclass of (a ~~ b)\n\nSo when oclose expands superclasses we'll get a (a ~# [b]) superclass.\nBut that's an EqPred not a ClassPred, and we jolly well do want to\naccount for the mutual functional dependencies implied by (t1 ~# t2).\nHence the EqPred handling in oclose.  See Trac #10778.\n\nNote [Care with type functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #12803)\n  class C x y | x -> y\n  type family F a b\n  type family G c d = r | r -> d\n\nNow consider\n  oclose (C (F a b) (G c d)) {a,b}\n\nKnowing {a,b} fixes (F a b) regardless of the injectivity of F.\nBut knowing (G c d) fixes only {d}, because G is only injective\nin its second parameter.\n\nHence the tyCoVarsOfTypes/injTyVarsOfTypes dance in tv_fds.\n-}\n\noclose :: [PredType] -> TyCoVarSet -> TyCoVarSet\n-- See Note [The liberal coverage condition]\noclose preds fixed_tvs\n  | null tv_fds = fixed_tvs -- Fast escape hatch for common case.\n  | otherwise   = fixVarSet extend fixed_tvs\n  where\n    extend fixed_tvs = foldl' add fixed_tvs tv_fds\n       where\n          add fixed_tvs (ls,rs)\n            | ls `subVarSet` fixed_tvs = fixed_tvs `unionVarSet` closeOverKinds rs\n            | otherwise                = fixed_tvs\n            -- closeOverKinds: see Note [Closing over kinds in coverage]\n\n    tv_fds  :: [(TyCoVarSet,TyCoVarSet)]\n    tv_fds  = [ (tyCoVarsOfTypes ls, injTyVarsOfTypes rs)\n                  -- See Note [Care with type functions]\n              | pred <- preds\n              , pred' <- pred : transSuperClasses pred\n                   -- Look for fundeps in superclasses too\n              , (ls, rs) <- determined pred' ]\n\n    determined :: PredType -> [([Type],[Type])]\n    determined pred\n       = case classifyPredType pred of\n            EqPred NomEq t1 t2 -> [([t1],[t2]), ([t2],[t1])]\n               -- See Note [Equality superclasses]\n            ClassPred cls tys  -> [ instFD fd cls_tvs tys\n                                  | let (cls_tvs, cls_fds) = classTvsFds cls\n                                  , fd <- cls_fds ]\n            _ -> []\n\n\n{- *********************************************************************\n*                                                                      *\n        Check that a new instance decl is OK wrt fundeps\n*                                                                      *\n************************************************************************\n\nHere is the bad case:\n        class C a b | a->b where ...\n        instance C Int Bool where ...\n        instance C Int Char where ...\n\nThe point is that a->b, so Int in the first parameter must uniquely\ndetermine the second.  In general, given the same class decl, and given\n\n        instance C s1 s2 where ...\n        instance C t1 t2 where ...\n\nThen the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).\n\nMatters are a little more complicated if there are free variables in\nthe s2/t2.\n\n        class D a b c | a -> b\n        instance D a b => D [(a,a)] [b] Int\n        instance D a b => D [a]     [b] Bool\n\nThe instance decls don't overlap, because the third parameter keeps\nthem separate.  But we want to make sure that given any constraint\n        D s1 s2 s3\nif s1 matches\n\nNote [Bogus consistency check]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn checkFunDeps we check that a new ClsInst is consistent with all the\nClsInsts in the environment.\n\nThe bogus aspect is discussed in Trac #10675. Currenty it if the two\ntypes are *contradicatory*, using (isNothing . tcUnifyTys).  But all\nthe papers say we should check if the two types are *equal* thus\n   not (substTys subst rtys1 `eqTypes` substTys subst rtys2)\nFor now I'm leaving the bogus form because that's the way it has\nbeen for years.\n-}\n\ncheckFunDeps :: InstEnvs -> ClsInst -> [ClsInst]\n-- The Consistency Check.\n-- Check whether adding DFunId would break functional-dependency constraints\n-- Used only for instance decls defined in the module being compiled\n-- Returns a list of the ClsInst in InstEnvs that are inconsistent\n-- with the proposed new ClsInst\ncheckFunDeps inst_envs (ClsInst { is_tvs = qtvs1, is_cls = cls\n                                , is_tys = tys1, is_tcs = rough_tcs1 })\n  | null fds\n  = []\n  | otherwise\n  = nubBy eq_inst $\n    [ ispec | ispec <- cls_insts\n            , fd    <- fds\n            , is_inconsistent fd ispec ]\n  where\n    cls_insts      = classInstances inst_envs cls\n    (cls_tvs, fds) = classTvsFds cls\n    qtv_set1       = mkVarSet qtvs1\n\n    is_inconsistent fd (ClsInst { is_tvs = qtvs2, is_tys = tys2, is_tcs = rough_tcs2 })\n      | instanceCantMatch trimmed_tcs rough_tcs2\n      = False\n      | otherwise\n      = case tcUnifyTyKis bind_fn ltys1 ltys2 of\n          Nothing         -> False\n          Just subst\n            -> isNothing $   -- Bogus legacy test (Trac #10675)\n                             -- See Note [Bogus consistency check]\n               tcUnifyTyKis bind_fn (substTysUnchecked subst rtys1) (substTysUnchecked subst rtys2)\n\n      where\n        trimmed_tcs    = trimRoughMatchTcs cls_tvs fd rough_tcs1\n        (ltys1, rtys1) = instFD fd cls_tvs tys1\n        (ltys2, rtys2) = instFD fd cls_tvs tys2\n        qtv_set2       = mkVarSet qtvs2\n        bind_fn tv | tv `elemVarSet` qtv_set1 = BindMe\n                   | tv `elemVarSet` qtv_set2 = BindMe\n                   | otherwise                = Skolem\n\n    eq_inst i1 i2 = instanceDFunId i1 == instanceDFunId i2\n        -- A single instance may appear twice in the un-nubbed conflict list\n        -- because it may conflict with more than one fundep.  E.g.\n        --      class C a b c | a -> b, a -> c\n        --      instance C Int Bool Bool\n        --      instance C Int Char Char\n        -- The second instance conflicts with the first by *both* fundeps\n\ntrimRoughMatchTcs :: [TyVar] -> FunDep TyVar -> [Maybe Name] -> [Maybe Name]\n-- Computing rough_tcs for a particular fundep\n--     class C a b c | a -> b where ...\n-- For each instance .... => C ta tb tc\n-- we want to match only on the type ta; so our\n-- rough-match thing must similarly be filtered.\n-- Hence, we Nothing-ise the tb and tc types right here\n--\n-- Result list is same length as input list, just with more Nothings\ntrimRoughMatchTcs clas_tvs (ltvs, _) mb_tcs\n  = zipWith select clas_tvs mb_tcs\n  where\n    select clas_tv mb_tc | clas_tv `elem` ltvs = mb_tc\n                         | otherwise           = Nothing\n", "num_lines": 676}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nThe @Inst@ type: dictionaries or method instances\n-}\n\n{-# LANGUAGE CPP, MultiWayIf, TupleSections #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule Inst (\n       deeplySkolemise,\n       topInstantiate, topInstantiateInferred, deeplyInstantiate,\n       instCall, instDFunType, instStupidTheta, instTyVarsWith,\n       newWanted, newWanteds,\n\n       tcInstInvisibleTyBinders, tcInstInvisibleTyBinder,\n\n       newOverloadedLit, mkOverLit,\n\n       newClsInst,\n       tcGetInsts, tcGetInstEnvs, getOverlapFlag,\n       tcExtendLocalInstEnv,\n       instCallConstraints, newMethodFromName,\n       tcSyntaxName,\n\n       -- Simple functions over evidence variables\n       tyCoVarsOfWC,\n       tyCoVarsOfCt, tyCoVarsOfCts,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   TcExpr( tcPolyExpr, tcSyntaxOp )\nimport {-# SOURCE #-}   TcUnify( unifyType, unifyKind )\n\nimport BasicTypes ( IntegralLit(..), SourceText(..) )\nimport FastString\nimport HsSyn\nimport TcHsSyn\nimport TcRnMonad\nimport TcEnv\nimport TcEvidence\nimport InstEnv\nimport TysWiredIn  ( heqDataCon, eqDataCon )\nimport CoreSyn     ( isOrphan )\nimport FunDeps\nimport TcMType\nimport Type\nimport TyCoRep\nimport TcType\nimport HscTypes\nimport Class( Class )\nimport MkId( mkDictFunId )\nimport CoreSyn( Expr(..) )  -- For the Coercion constructor\nimport Id\nimport Name\nimport Var      ( EvVar, tyVarName, VarBndr(..) )\nimport DataCon\nimport VarEnv\nimport PrelNames\nimport SrcLoc\nimport DynFlags\nimport Util\nimport Outputable\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad( unless )\n\n{-\n************************************************************************\n*                                                                      *\n                Creating and emittind constraints\n*                                                                      *\n************************************************************************\n-}\n\nnewMethodFromName :: CtOrigin -> Name -> TcRhoType -> TcM (HsExpr GhcTcId)\n-- Used when Name is the wired-in name for a wired-in class method,\n-- so the caller knows its type for sure, which should be of form\n--    forall a. C a => <blah>\n-- newMethodFromName is supposed to instantiate just the outer\n-- type variable and constraint\n\nnewMethodFromName origin name inst_ty\n  = do { id <- tcLookupId name\n              -- Use tcLookupId not tcLookupGlobalId; the method is almost\n              -- always a class op, but with -XRebindableSyntax GHC is\n              -- meant to find whatever thing is in scope, and that may\n              -- be an ordinary function.\n\n       ; let ty = piResultTy (idType id) inst_ty\n             (theta, _caller_knows_this) = tcSplitPhiTy ty\n       ; wrap <- ASSERT( not (isForAllTy ty) && isSingleton theta )\n                 instCall origin [inst_ty] theta\n\n       ; return (mkHsWrap wrap (HsVar noExt (noLoc id))) }\n\n{-\n************************************************************************\n*                                                                      *\n        Deep instantiation and skolemisation\n*                                                                      *\n************************************************************************\n\nNote [Deep skolemisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~\ndeeplySkolemise decomposes and skolemises a type, returning a type\nwith all its arrows visible (ie not buried under foralls)\n\nExamples:\n\n  deeplySkolemise (Int -> forall a. Ord a => blah)\n    =  ( wp, [a], [d:Ord a], Int -> blah )\n    where wp = \\x:Int. /\\a. \\(d:Ord a). <hole> x\n\n  deeplySkolemise  (forall a. Ord a => Maybe a -> forall b. Eq b => blah)\n    =  ( wp, [a,b], [d1:Ord a,d2:Eq b], Maybe a -> blah )\n    where wp = /\\a.\\(d1:Ord a).\\(x:Maybe a)./\\b.\\(d2:Ord b). <hole> x\n\nIn general,\n  if      deeplySkolemise ty = (wrap, tvs, evs, rho)\n    and   e :: rho\n  then    wrap e :: ty\n    and   'wrap' binds tvs, evs\n\nToDo: this eta-abstraction plays fast and loose with termination,\n      because it can introduce extra lambdas.  Maybe add a `seq` to\n      fix this\n-}\n\ndeeplySkolemise :: TcSigmaType\n                -> TcM ( HsWrapper\n                       , [(Name,TyVar)]     -- All skolemised variables\n                       , [EvVar]            -- All \"given\"s\n                       , TcRhoType )\n\ndeeplySkolemise ty\n  = go init_subst ty\n  where\n    init_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ty))\n\n    go subst ty\n      | Just (arg_tys, tvs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty\n      = do { let arg_tys' = substTys subst arg_tys\n           ; ids1           <- newSysLocalIds (fsLit \"dk\") arg_tys'\n           ; (subst', tvs1) <- tcInstSkolTyVarsX subst tvs\n           ; ev_vars1       <- newEvVars (substTheta subst' theta)\n           ; (wrap, tvs_prs2, ev_vars2, rho) <- go subst' ty'\n           ; let tv_prs1 = map tyVarName tvs `zip` tvs1\n           ; return ( mkWpLams ids1\n                      <.> mkWpTyLams tvs1\n                      <.> mkWpLams ev_vars1\n                      <.> wrap\n                      <.> mkWpEvVarApps ids1\n                    , tv_prs1  ++ tvs_prs2\n                    , ev_vars1 ++ ev_vars2\n                    , mkVisFunTys arg_tys' rho ) }\n\n      | otherwise\n      = return (idHsWrapper, [], [], substTy subst ty)\n        -- substTy is a quick no-op on an empty substitution\n\n-- | Instantiate all outer type variables\n-- and any context. Never looks through arrows.\ntopInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)\n-- if    topInstantiate ty = (wrap, rho)\n-- and   e :: ty\n-- then  wrap e :: rho  (that is, wrap :: ty \"->\" rho)\ntopInstantiate = top_instantiate True\n\n-- | Instantiate all outer 'Inferred' binders\n-- and any context. Never looks through arrows or specified type variables.\n-- Used for visible type application.\ntopInstantiateInferred :: CtOrigin -> TcSigmaType\n                       -> TcM (HsWrapper, TcSigmaType)\n-- if    topInstantiate ty = (wrap, rho)\n-- and   e :: ty\n-- then  wrap e :: rho\ntopInstantiateInferred = top_instantiate False\n\ntop_instantiate :: Bool   -- True  <=> instantiate *all* variables\n                          -- False <=> instantiate only the inferred ones\n                -> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)\ntop_instantiate inst_all orig ty\n  | not (null binders && null theta)\n  = do { let (inst_bndrs, leave_bndrs) = span should_inst binders\n             (inst_theta, leave_theta)\n               | null leave_bndrs = (theta, [])\n               | otherwise        = ([], theta)\n             in_scope    = mkInScopeSet (tyCoVarsOfType ty)\n             empty_subst = mkEmptyTCvSubst in_scope\n             inst_tvs    = binderVars inst_bndrs\n       ; (subst, inst_tvs') <- mapAccumLM newMetaTyVarX empty_subst inst_tvs\n       ; let inst_theta' = substTheta subst inst_theta\n             sigma'      = substTy subst (mkForAllTys leave_bndrs $\n                                          mkPhiTy leave_theta rho)\n             inst_tv_tys' = mkTyVarTys inst_tvs'\n\n       ; wrap1 <- instCall orig inst_tv_tys' inst_theta'\n       ; traceTc \"Instantiating\"\n                 (vcat [ text \"all tyvars?\" <+> ppr inst_all\n                       , text \"origin\" <+> pprCtOrigin orig\n                       , text \"type\" <+> debugPprType ty\n                       , text \"theta\" <+> ppr theta\n                       , text \"leave_bndrs\" <+> ppr leave_bndrs\n                       , text \"with\" <+> vcat (map debugPprType inst_tv_tys')\n                       , text \"theta:\" <+>  ppr inst_theta' ])\n\n       ; (wrap2, rho2) <-\n           if null leave_bndrs\n\n         -- account for types like forall a. Num a => forall b. Ord b => ...\n           then top_instantiate inst_all orig sigma'\n\n         -- but don't loop if there were any un-inst'able tyvars\n           else return (idHsWrapper, sigma')\n\n       ; return (wrap2 <.> wrap1, rho2) }\n\n  | otherwise = return (idHsWrapper, ty)\n  where\n    (binders, phi) = tcSplitForAllVarBndrs ty\n    (theta, rho)   = tcSplitPhiTy phi\n\n    should_inst bndr\n      | inst_all  = True\n      | otherwise = binderArgFlag bndr == Inferred\n\ndeeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)\n--   Int -> forall a. a -> a  ==>  (\\x:Int. [] x alpha) :: Int -> alpha\n-- In general if\n-- if    deeplyInstantiate ty = (wrap, rho)\n-- and   e :: ty\n-- then  wrap e :: rho\n-- That is, wrap :: ty ~> rho\n--\n-- If you don't need the HsWrapper returned from this function, consider\n-- using tcSplitNestedSigmaTys in TcType, which is a pure alternative that\n-- only computes the returned TcRhoType.\n\ndeeplyInstantiate orig ty =\n  deeply_instantiate orig\n                     (mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ty)))\n                     ty\n\ndeeply_instantiate :: CtOrigin\n                   -> TCvSubst\n                   -> TcSigmaType -> TcM (HsWrapper, TcRhoType)\n-- Internal function to deeply instantiate that builds on an existing subst.\n-- It extends the input substitution and applies the final subtitution to\n-- the types on return.  See #12549.\n\ndeeply_instantiate orig subst ty\n  | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty\n  = do { (subst', tvs') <- newMetaTyVarsX subst tvs\n       ; let arg_tys' = substTys   subst' arg_tys\n             theta'   = substTheta subst' theta\n       ; ids1  <- newSysLocalIds (fsLit \"di\") arg_tys'\n       ; wrap1 <- instCall orig (mkTyVarTys tvs') theta'\n       ; traceTc \"Instantiating (deeply)\" (vcat [ text \"origin\" <+> pprCtOrigin orig\n                                                , text \"type\" <+> ppr ty\n                                                , text \"with\" <+> ppr tvs'\n                                                , text \"args:\" <+> ppr ids1\n                                                , text \"theta:\" <+>  ppr theta'\n                                                , text \"subst:\" <+> ppr subst'])\n       ; (wrap2, rho2) <- deeply_instantiate orig subst' rho\n       ; return (mkWpLams ids1\n                    <.> wrap2\n                    <.> wrap1\n                    <.> mkWpEvVarApps ids1,\n                 mkVisFunTys arg_tys' rho2) }\n\n  | otherwise\n  = do { let ty' = substTy subst ty\n       ; traceTc \"deeply_instantiate final subst\"\n                 (vcat [ text \"origin:\"   <+> pprCtOrigin orig\n                       , text \"type:\"     <+> ppr ty\n                       , text \"new type:\" <+> ppr ty'\n                       , text \"subst:\"    <+> ppr subst ])\n      ; return (idHsWrapper, ty') }\n\n\ninstTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst\n-- Use this when you want to instantiate (forall a b c. ty) with\n-- types [ta, tb, tc], but when the kinds of 'a' and 'ta' might\n-- not yet match (perhaps because there are unsolved constraints; Trac #14154)\n-- If they don't match, emit a kind-equality to promise that they will\n-- eventually do so, and thus make a kind-homongeneous substitution.\ninstTyVarsWith orig tvs tys\n  = go empty_subst tvs tys\n  where\n    empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfTypes tys))\n\n    go subst [] []\n      = return subst\n    go subst (tv:tvs) (ty:tys)\n      | tv_kind `tcEqType` ty_kind\n      = go (extendTCvSubst subst tv ty) tvs tys\n      | otherwise\n      = do { co <- emitWantedEq orig KindLevel Nominal ty_kind tv_kind\n           ; go (extendTCvSubst subst tv (ty `mkCastTy` co)) tvs tys }\n      where\n        tv_kind = substTy subst (tyVarKind tv)\n        ty_kind = tcTypeKind ty\n\n    go _ _ _ = pprPanic \"instTysWith\" (ppr tvs $$ ppr tys)\n\n{-\n************************************************************************\n*                                                                      *\n            Instantiating a call\n*                                                                      *\n************************************************************************\n\nNote [Handling boxed equality]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe solver deals entirely in terms of unboxed (primitive) equality.\nThere should never be a boxed Wanted equality. Ever. But, what if\nwe are calling `foo :: forall a. (F a ~ Bool) => ...`? That equality\nis boxed, so naive treatment here would emit a boxed Wanted equality.\n\nSo we simply check for this case and make the right boxing of evidence.\n\n-}\n\n----------------\ninstCall :: CtOrigin -> [TcType] -> TcThetaType -> TcM HsWrapper\n-- Instantiate the constraints of a call\n--      (instCall o tys theta)\n-- (a) Makes fresh dictionaries as necessary for the constraints (theta)\n-- (b) Throws these dictionaries into the LIE\n-- (c) Returns an HsWrapper ([.] tys dicts)\n\ninstCall orig tys theta\n  = do  { dict_app <- instCallConstraints orig theta\n        ; return (dict_app <.> mkWpTyApps tys) }\n\n----------------\ninstCallConstraints :: CtOrigin -> TcThetaType -> TcM HsWrapper\n-- Instantiates the TcTheta, puts all constraints thereby generated\n-- into the LIE, and returns a HsWrapper to enclose the call site.\n\ninstCallConstraints orig preds\n  | null preds\n  = return idHsWrapper\n  | otherwise\n  = do { evs <- mapM go preds\n       ; traceTc \"instCallConstraints\" (ppr evs)\n       ; return (mkWpEvApps evs) }\n  where\n    go :: TcPredType -> TcM EvTerm\n    go pred\n     | Just (Nominal, ty1, ty2) <- getEqPredTys_maybe pred -- Try short-cut #1\n     = do  { co <- unifyType Nothing ty1 ty2\n           ; return (evCoercion co) }\n\n       -- Try short-cut #2\n     | Just (tc, args@[_, _, ty1, ty2]) <- splitTyConApp_maybe pred\n     , tc `hasKey` heqTyConKey\n     = do { co <- unifyType Nothing ty1 ty2\n          ; return (evDFunApp (dataConWrapId heqDataCon) args [Coercion co]) }\n\n     | otherwise\n     = emitWanted orig pred\n\ninstDFunType :: DFunId -> [DFunInstType]\n             -> TcM ( [TcType]      -- instantiated argument types\n                    , TcThetaType ) -- instantiated constraint\n-- See Note [DFunInstType: instantiating types] in InstEnv\ninstDFunType dfun_id dfun_inst_tys\n  = do { (subst, inst_tys) <- go empty_subst dfun_tvs dfun_inst_tys\n       ; return (inst_tys, substTheta subst dfun_theta) }\n  where\n    dfun_ty = idType dfun_id\n    (dfun_tvs, dfun_theta, _) = tcSplitSigmaTy dfun_ty\n    empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType dfun_ty))\n                  -- With quantified constraints, the\n                  -- type of a dfun may not be closed\n\n    go :: TCvSubst -> [TyVar] -> [DFunInstType] -> TcM (TCvSubst, [TcType])\n    go subst [] [] = return (subst, [])\n    go subst (tv:tvs) (Just ty : mb_tys)\n      = do { (subst', tys) <- go (extendTvSubstAndInScope subst tv ty)\n                                 tvs\n                                 mb_tys\n           ; return (subst', ty : tys) }\n    go subst (tv:tvs) (Nothing : mb_tys)\n      = do { (subst', tv') <- newMetaTyVarX subst tv\n           ; (subst'', tys) <- go subst' tvs mb_tys\n           ; return (subst'', mkTyVarTy tv' : tys) }\n    go _ _ _ = pprPanic \"instDFunTypes\" (ppr dfun_id $$ ppr dfun_inst_tys)\n\n----------------\ninstStupidTheta :: CtOrigin -> TcThetaType -> TcM ()\n-- Similar to instCall, but only emit the constraints in the LIE\n-- Used exclusively for the 'stupid theta' of a data constructor\ninstStupidTheta orig theta\n  = do  { _co <- instCallConstraints orig theta -- Discard the coercion\n        ; return () }\n\n\n{- *********************************************************************\n*                                                                      *\n         Instantiating Kinds\n*                                                                      *\n********************************************************************* -}\n\n-- | Instantiates up to n invisible binders\n-- Returns the instantiating types, and body kind\ntcInstInvisibleTyBinders :: Int -> TcKind -> TcM ([TcType], TcKind)\n\ntcInstInvisibleTyBinders 0 kind\n  = return ([], kind)\ntcInstInvisibleTyBinders n ty\n  = go n empty_subst ty\n  where\n    empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ty))\n\n    go n subst kind\n      | n > 0\n      , Just (bndr, body) <- tcSplitPiTy_maybe kind\n      , isInvisibleBinder bndr\n      = do { (subst', arg) <- tcInstInvisibleTyBinder subst bndr\n           ; (args, inner_ty) <- go (n-1) subst' body\n           ; return (arg:args, inner_ty) }\n      | otherwise\n      = return ([], substTy subst kind)\n\n-- | Used only in *types*\ntcInstInvisibleTyBinder :: TCvSubst -> TyBinder -> TcM (TCvSubst, TcType)\ntcInstInvisibleTyBinder subst (Named (Bndr tv _))\n  = do { (subst', tv') <- newMetaTyVarX subst tv\n       ; return (subst', mkTyVarTy tv') }\n\ntcInstInvisibleTyBinder subst (Anon af ty)\n  | Just (mk, k1, k2) <- get_eq_tys_maybe (substTy subst ty)\n    -- Equality is the *only* constraint currently handled in types.\n    -- See Note [Constraints in kinds] in TyCoRep\n  = ASSERT( af == InvisArg )\n    do { co <- unifyKind Nothing k1 k2\n       ; arg' <- mk co\n       ; return (subst, arg') }\n\n  | otherwise  -- This should never happen\n               -- See TyCoRep Note [Constraints in kinds]\n  = pprPanic \"tcInvisibleTyBinder\" (ppr ty)\n\n-------------------------------\nget_eq_tys_maybe :: Type\n                 -> Maybe ( Coercion -> TcM Type\n                             -- given a coercion proving t1 ~# t2, produce the\n                             -- right instantiation for the TyBinder at hand\n                          , Type  -- t1\n                          , Type  -- t2\n                          )\n-- See Note [Constraints in kinds] in TyCoRep\nget_eq_tys_maybe ty\n  -- Lifted heterogeneous equality (~~)\n  | Just (tc, [_, _, k1, k2]) <- splitTyConApp_maybe ty\n  , tc `hasKey` heqTyConKey\n  = Just (\\co -> mkHEqBoxTy co k1 k2, k1, k2)\n\n  -- Lifted homogeneous equality (~)\n  | Just (tc, [_, k1, k2]) <- splitTyConApp_maybe ty\n  , tc `hasKey` eqTyConKey\n  = Just (\\co -> mkEqBoxTy co k1 k2, k1, k2)\n\n  | otherwise\n  = Nothing\n\n-- | This takes @a ~# b@ and returns @a ~~ b@.\nmkHEqBoxTy :: TcCoercion -> Type -> Type -> TcM Type\n-- monadic just for convenience with mkEqBoxTy\nmkHEqBoxTy co ty1 ty2\n  = return $\n    mkTyConApp (promoteDataCon heqDataCon) [k1, k2, ty1, ty2, mkCoercionTy co]\n  where k1 = tcTypeKind ty1\n        k2 = tcTypeKind ty2\n\n-- | This takes @a ~# b@ and returns @a ~ b@.\nmkEqBoxTy :: TcCoercion -> Type -> Type -> TcM Type\nmkEqBoxTy co ty1 ty2\n  = return $\n    mkTyConApp (promoteDataCon eqDataCon) [k, ty1, ty2, mkCoercionTy co]\n  where k = tcTypeKind ty1\n\n{-\n************************************************************************\n*                                                                      *\n                Literals\n*                                                                      *\n************************************************************************\n\n-}\n\n{-\nIn newOverloadedLit we convert directly to an Int or Integer if we\nknow that's what we want.  This may save some time, by not\ntemporarily generating overloaded literals, but it won't catch all\ncases (the rest are caught in lookupInst).\n\n-}\n\nnewOverloadedLit :: HsOverLit GhcRn\n                 -> ExpRhoType\n                 -> TcM (HsOverLit GhcTcId)\nnewOverloadedLit\n  lit@(OverLit { ol_val = val, ol_ext = rebindable }) res_ty\n  | not rebindable\n    -- all built-in overloaded lits are tau-types, so we can just\n    -- tauify the ExpType\n  = do { res_ty <- expTypeToType res_ty\n       ; dflags <- getDynFlags\n       ; case shortCutLit dflags val res_ty of\n        -- Do not generate a LitInst for rebindable syntax.\n        -- Reason: If we do, tcSimplify will call lookupInst, which\n        --         will call tcSyntaxName, which does unification,\n        --         which tcSimplify doesn't like\n           Just expr -> return (lit { ol_witness = expr\n                                    , ol_ext = OverLitTc False res_ty })\n           Nothing   -> newNonTrivialOverloadedLit orig lit\n                                                   (mkCheckExpType res_ty) }\n\n  | otherwise\n  = newNonTrivialOverloadedLit orig lit res_ty\n  where\n    orig = LiteralOrigin lit\nnewOverloadedLit XOverLit{} _ = panic \"newOverloadedLit\"\n\n-- Does not handle things that 'shortCutLit' can handle. See also\n-- newOverloadedLit in TcUnify\nnewNonTrivialOverloadedLit :: CtOrigin\n                           -> HsOverLit GhcRn\n                           -> ExpRhoType\n                           -> TcM (HsOverLit GhcTcId)\nnewNonTrivialOverloadedLit orig\n  lit@(OverLit { ol_val = val, ol_witness = HsVar _ (L _ meth_name)\n               , ol_ext = rebindable }) res_ty\n  = do  { hs_lit <- mkOverLit val\n        ; let lit_ty = hsLitType hs_lit\n        ; (_, fi') <- tcSyntaxOp orig (mkRnSyntaxExpr meth_name)\n                                      [synKnownType lit_ty] res_ty $\n                      \\_ -> return ()\n        ; let L _ witness = nlHsSyntaxApps fi' [nlHsLit hs_lit]\n        ; res_ty <- readExpType res_ty\n        ; return (lit { ol_witness = witness\n                      , ol_ext = OverLitTc rebindable res_ty }) }\nnewNonTrivialOverloadedLit _ lit _\n  = pprPanic \"newNonTrivialOverloadedLit\" (ppr lit)\n\n------------\nmkOverLit ::OverLitVal -> TcM (HsLit GhcTc)\nmkOverLit (HsIntegral i)\n  = do  { integer_ty <- tcMetaTy integerTyConName\n        ; return (HsInteger (il_text i)\n                            (il_value i) integer_ty) }\n\nmkOverLit (HsFractional r)\n  = do  { rat_ty <- tcMetaTy rationalTyConName\n        ; return (HsRat noExt r rat_ty) }\n\nmkOverLit (HsIsString src s) = return (HsString src s)\n\n{-\n************************************************************************\n*                                                                      *\n                Re-mappable syntax\n\n     Used only for arrow syntax -- find a way to nuke this\n*                                                                      *\n************************************************************************\n\nSuppose we are doing the -XRebindableSyntax thing, and we encounter\na do-expression.  We have to find (>>) in the current environment, which is\ndone by the rename. Then we have to check that it has the same type as\nControl.Monad.(>>).  Or, more precisely, a compatible type. One 'customer' had\nthis:\n\n  (>>) :: HB m n mn => m a -> n b -> mn b\n\nSo the idea is to generate a local binding for (>>), thus:\n\n        let then72 :: forall a b. m a -> m b -> m b\n            then72 = ...something involving the user's (>>)...\n        in\n        ...the do-expression...\n\nNow the do-expression can proceed using then72, which has exactly\nthe expected type.\n\nIn fact tcSyntaxName just generates the RHS for then72, because we only\nwant an actual binding in the do-expression case. For literals, we can\njust use the expression inline.\n-}\n\ntcSyntaxName :: CtOrigin\n             -> TcType                 -- ^ Type to instantiate it at\n             -> (Name, HsExpr GhcRn)   -- ^ (Standard name, user name)\n             -> TcM (Name, HsExpr GhcTcId)\n                                       -- ^ (Standard name, suitable expression)\n-- USED ONLY FOR CmdTop (sigh) ***\n-- See Note [CmdSyntaxTable] in HsExpr\n\ntcSyntaxName orig ty (std_nm, HsVar _ (L _ user_nm))\n  | std_nm == user_nm\n  = do rhs <- newMethodFromName orig std_nm ty\n       return (std_nm, rhs)\n\ntcSyntaxName orig ty (std_nm, user_nm_expr) = do\n    std_id <- tcLookupId std_nm\n    let\n        -- C.f. newMethodAtLoc\n        ([tv], _, tau) = tcSplitSigmaTy (idType std_id)\n        sigma1         = substTyWith [tv] [ty] tau\n        -- Actually, the \"tau-type\" might be a sigma-type in the\n        -- case of locally-polymorphic methods.\n\n    addErrCtxtM (syntaxNameCtxt user_nm_expr orig sigma1) $ do\n\n        -- Check that the user-supplied thing has the\n        -- same type as the standard one.\n        -- Tiresome jiggling because tcCheckSigma takes a located expression\n     span <- getSrcSpanM\n     expr <- tcPolyExpr (L span user_nm_expr) sigma1\n     return (std_nm, unLoc expr)\n\nsyntaxNameCtxt :: HsExpr GhcRn -> CtOrigin -> Type -> TidyEnv\n               -> TcRn (TidyEnv, SDoc)\nsyntaxNameCtxt name orig ty tidy_env\n  = do { inst_loc <- getCtLocM orig (Just TypeLevel)\n       ; let msg = vcat [ text \"When checking that\" <+> quotes (ppr name)\n                          <+> text \"(needed by a syntactic construct)\"\n                        , nest 2 (text \"has the required type:\"\n                                  <+> ppr (tidyType tidy_env ty))\n                        , nest 2 (pprCtLoc inst_loc) ]\n       ; return (tidy_env, msg) }\n\n{-\n************************************************************************\n*                                                                      *\n                Instances\n*                                                                      *\n************************************************************************\n-}\n\ngetOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag\n-- Construct the OverlapFlag from the global module flags,\n-- but if the overlap_mode argument is (Just m),\n--     set the OverlapMode to 'm'\ngetOverlapFlag overlap_mode\n  = do  { dflags <- getDynFlags\n        ; let overlap_ok    = xopt LangExt.OverlappingInstances dflags\n              incoherent_ok = xopt LangExt.IncoherentInstances  dflags\n              use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags\n                                  , overlapMode   = x }\n              default_oflag | incoherent_ok = use (Incoherent NoSourceText)\n                            | overlap_ok    = use (Overlaps NoSourceText)\n                            | otherwise     = use (NoOverlap NoSourceText)\n\n              final_oflag = setOverlapModeMaybe default_oflag overlap_mode\n        ; return final_oflag }\n\ntcGetInsts :: TcM [ClsInst]\n-- Gets the local class instances.\ntcGetInsts = fmap tcg_insts getGblEnv\n\nnewClsInst :: Maybe OverlapMode -> Name -> [TyVar] -> ThetaType\n           -> Class -> [Type] -> TcM ClsInst\nnewClsInst overlap_mode dfun_name tvs theta clas tys\n  = do { (subst, tvs') <- freshenTyVarBndrs tvs\n             -- Be sure to freshen those type variables,\n             -- so they are sure not to appear in any lookup\n       ; let tys' = substTys subst tys\n\n             dfun = mkDictFunId dfun_name tvs theta clas tys\n             -- The dfun uses the original 'tvs' because\n             -- (a) they don't need to be fresh\n             -- (b) they may be mentioned in the ib_binds field of\n             --     an InstInfo, and in TcEnv.pprInstInfoDetails it's\n             --     helpful to use the same names\n\n       ; oflag <- getOverlapFlag overlap_mode\n       ; let inst = mkLocalInstance dfun oflag tvs' clas tys'\n       ; warnIfFlag Opt_WarnOrphans\n                    (isOrphan (is_orphan inst))\n                    (instOrphWarn inst)\n       ; return inst }\n\ninstOrphWarn :: ClsInst -> SDoc\ninstOrphWarn inst\n  = hang (text \"Orphan instance:\") 2 (pprInstanceHdr inst)\n    $$ text \"To avoid this\"\n    $$ nest 4 (vcat possibilities)\n  where\n    possibilities =\n      text \"move the instance declaration to the module of the class or of the type, or\" :\n      text \"wrap the type with a newtype and declare the instance on the new type.\" :\n      []\n\ntcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a\n  -- Add new locally-defined instances\ntcExtendLocalInstEnv dfuns thing_inside\n = do { traceDFuns dfuns\n      ; env <- getGblEnv\n      ; (inst_env', cls_insts') <- foldlM addLocalInst\n                                          (tcg_inst_env env, tcg_insts env)\n                                          dfuns\n      ; let env' = env { tcg_insts    = cls_insts'\n                       , tcg_inst_env = inst_env' }\n      ; setGblEnv env' thing_inside }\n\naddLocalInst :: (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])\n-- Check that the proposed new instance is OK,\n-- and then add it to the home inst env\n-- If overwrite_inst, then we can overwrite a direct match\naddLocalInst (home_ie, my_insts) ispec\n   = do {\n             -- Load imported instances, so that we report\n             -- duplicates correctly\n\n             -- 'matches'  are existing instance declarations that are less\n             --            specific than the new one\n             -- 'dups'     are those 'matches' that are equal to the new one\n         ; isGHCi <- getIsGHCi\n         ; eps    <- getEps\n         ; tcg_env <- getGblEnv\n\n           -- In GHCi, we *override* any identical instances\n           -- that are also defined in the interactive context\n           -- See Note [Override identical instances in GHCi]\n         ; let home_ie'\n                 | isGHCi    = deleteFromInstEnv home_ie ispec\n                 | otherwise = home_ie\n\n               global_ie = eps_inst_env eps\n               inst_envs = InstEnvs { ie_global  = global_ie\n                                    , ie_local   = home_ie'\n                                    , ie_visible = tcVisibleOrphanMods tcg_env }\n\n             -- Check for inconsistent functional dependencies\n         ; let inconsistent_ispecs = checkFunDeps inst_envs ispec\n         ; unless (null inconsistent_ispecs) $\n           funDepErr ispec inconsistent_ispecs\n\n             -- Check for duplicate instance decls.\n         ; let (_tvs, cls, tys) = instanceHead ispec\n               (matches, _, _)  = lookupInstEnv False inst_envs cls tys\n               dups             = filter (identicalClsInstHead ispec) (map fst matches)\n         ; unless (null dups) $\n           dupInstErr ispec (head dups)\n\n         ; return (extendInstEnv home_ie' ispec, ispec : my_insts) }\n\n{-\nNote [Signature files and type class instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInstances in signature files do not have an effect when compiling:\nwhen you compile a signature against an implementation, you will\nsee the instances WHETHER OR NOT the instance is declared in\nthe file (this is because the signatures go in the EPS and we\ncan't filter them out easily.)  This is also why we cannot\nplace the instance in the hi file: it would show up as a duplicate,\nand we don't have instance reexports anyway.\n\nHowever, you might find them useful when typechecking against\na signature: the instance is a way of indicating to GHC that\nsome instance exists, in case downstream code uses it.\n\nImplementing this is a little tricky.  Consider the following\nsituation (sigof03):\n\n module A where\n     instance C T where ...\n\n module ASig where\n     instance C T\n\nWhen compiling ASig, A.hi is loaded, which brings its instances\ninto the EPS.  When we process the instance declaration in ASig,\nwe should ignore it for the purpose of doing a duplicate check,\nsince it's not actually a duplicate. But don't skip the check\nentirely, we still want this to fail (tcfail221):\n\n module ASig where\n     instance C T\n     instance C T\n\nNote that in some situations, the interface containing the type\nclass instances may not have been loaded yet at all.  The usual\nsituation when A imports another module which provides the\ninstances (sigof02m):\n\n module A(module B) where\n     import B\n\nSee also Note [Signature lazy interface loading].  We can't\nrely on this, however, since sometimes we'll have spurious\ntype class instances in the EPS, see #9422 (sigof02dm)\n\n************************************************************************\n*                                                                      *\n        Errors and tracing\n*                                                                      *\n************************************************************************\n-}\n\ntraceDFuns :: [ClsInst] -> TcRn ()\ntraceDFuns ispecs\n  = traceTc \"Adding instances:\" (vcat (map pp ispecs))\n  where\n    pp ispec = hang (ppr (instanceDFunId ispec) <+> colon)\n                  2 (ppr ispec)\n        -- Print the dfun name itself too\n\nfunDepErr :: ClsInst -> [ClsInst] -> TcRn ()\nfunDepErr ispec ispecs\n  = addClsInstsErr (text \"Functional dependencies conflict between instance declarations:\")\n                    (ispec : ispecs)\n\ndupInstErr :: ClsInst -> ClsInst -> TcRn ()\ndupInstErr ispec dup_ispec\n  = addClsInstsErr (text \"Duplicate instance declarations:\")\n                    [ispec, dup_ispec]\n\naddClsInstsErr :: SDoc -> [ClsInst] -> TcRn ()\naddClsInstsErr herald ispecs\n  = setSrcSpan (getSrcSpan (head sorted)) $\n    addErr (hang herald 2 (pprInstances sorted))\n where\n   sorted = sortWith getSrcLoc ispecs\n   -- The sortWith just arranges that instances are dislayed in order\n   -- of source location, which reduced wobbling in error messages,\n   -- and is better for users\n", "num_lines": 838}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section[TcAnnotations]{Typechecking annotations}\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcAnnotations ( tcAnnotations, annCtxt ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TcSplice ( runAnnotation )\nimport Module\nimport DynFlags\nimport Control.Monad ( when )\n\nimport HsSyn\nimport Name\nimport Annotations\nimport TcRnMonad\nimport SrcLoc\nimport Outputable\n\n-- Some platforms don't support the external interpreter, and\n-- compilation on those platforms shouldn't fail just due to\n-- annotations\n#ifndef GHCI\ntcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]\ntcAnnotations anns = do\n  dflags <- getDynFlags\n  case gopt Opt_ExternalInterpreter dflags of\n    True  -> tcAnnotations' anns\n    False -> warnAnns anns\nwarnAnns :: [LAnnDecl GhcRn] -> TcM [Annotation]\n--- No GHCI; emit a warning (not an error) and ignore. cf Trac #4268\nwarnAnns [] = return []\nwarnAnns anns@(L loc _ : _)\n  = do { setSrcSpan loc $ addWarnTc NoReason $\n             (text \"Ignoring ANN annotation\" <> plural anns <> comma\n             <+> text \"because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi\")\n       ; return [] }\n#else\ntcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]\ntcAnnotations = tcAnnotations'\n#endif\n\ntcAnnotations' :: [LAnnDecl GhcRn] -> TcM [Annotation]\ntcAnnotations' anns = mapM tcAnnotation anns\n\ntcAnnotation :: LAnnDecl GhcRn -> TcM Annotation\ntcAnnotation (L loc ann@(HsAnnotation _ _ provenance expr)) = do\n    -- Work out what the full target of this annotation was\n    mod <- getModule\n    let target = annProvenanceToTarget mod provenance\n\n    -- Run that annotation and construct the full Annotation data structure\n    setSrcSpan loc $ addErrCtxt (annCtxt ann) $ do\n      -- See #10826 -- Annotations allow one to bypass Safe Haskell.\n      dflags <- getDynFlags\n      when (safeLanguageOn dflags) $ failWithTc safeHsErr\n      runAnnotation target expr\n    where\n      safeHsErr = vcat [ text \"Annotations are not compatible with Safe Haskell.\"\n                  , text \"See https://ghc.haskell.org/trac/ghc/ticket/10826\" ]\ntcAnnotation (L _ (XAnnDecl _)) = panic \"tcAnnotation\"\n\nannProvenanceToTarget :: Module -> AnnProvenance Name\n                      -> AnnTarget Name\nannProvenanceToTarget _   (ValueAnnProvenance (L _ name)) = NamedTarget name\nannProvenanceToTarget _   (TypeAnnProvenance (L _ name))  = NamedTarget name\nannProvenanceToTarget mod ModuleAnnProvenance             = ModuleTarget mod\n\nannCtxt :: (OutputableBndrId (GhcPass p)) => AnnDecl (GhcPass p) -> SDoc\nannCtxt ann\n  = hang (text \"In the annotation:\") 2 (ppr ann)\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\nTypecheck arrow notation\n-}\n\n{-# LANGUAGE RankNTypes, TupleSections #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcArrows ( tcProc ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   TcExpr( tcMonoExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcPolyExpr )\n\nimport HsSyn\nimport TcMatches\nimport TcHsSyn( hsLPatType )\nimport TcType\nimport TcMType\nimport TcBinds\nimport TcPat\nimport TcUnify\nimport TcRnMonad\nimport TcEnv\nimport TcEvidence\nimport Id( mkLocalId )\nimport Inst\nimport Name\nimport TysWiredIn\nimport VarSet\nimport TysPrim\nimport BasicTypes( Arity )\nimport SrcLoc\nimport Outputable\nimport Util\n\nimport Control.Monad\n\n{-\nNote [Arrow overview]\n~~~~~~~~~~~~~~~~~~~~~\nHere's a summary of arrows and how they typecheck.  First, here's\na cut-down syntax:\n\n  expr ::= ....\n        |  proc pat cmd\n\n  cmd ::= cmd exp                    -- Arrow application\n       |  \\pat -> cmd                -- Arrow abstraction\n       |  (| exp cmd1 ... cmdn |)    -- Arrow form, n>=0\n       |  ... -- If, case in the usual way\n\n  cmd_type ::= carg_type --> type\n\n  carg_type ::= ()\n             |  (type, carg_type)\n\nNote that\n * The 'exp' in an arrow form can mention only\n   \"arrow-local\" variables\n\n * An \"arrow-local\" variable is bound by an enclosing\n   cmd binding form (eg arrow abstraction)\n\n * A cmd_type is here written with a funny arrow \"-->\",\n   The bit on the left is a carg_type (command argument type)\n   which itself is a nested tuple, finishing with ()\n\n * The arrow-tail operator (e1 -< e2) means\n       (| e1 <<< arr snd |) e2\n\n\n************************************************************************\n*                                                                      *\n                Proc\n*                                                                      *\n************************************************************************\n-}\n\ntcProc :: InPat GhcRn -> LHsCmdTop GhcRn        -- proc pat -> expr\n       -> ExpRhoType                            -- Expected type of whole proc expression\n       -> TcM (OutPat GhcTcId, LHsCmdTop GhcTcId, TcCoercion)\n\ntcProc pat cmd exp_ty\n  = newArrowScope $\n    do  { exp_ty <- expTypeToType exp_ty  -- no higher-rank stuff with arrows\n        ; (co, (exp_ty1, res_ty)) <- matchExpectedAppTy exp_ty\n        ; (co1, (arr_ty, arg_ty)) <- matchExpectedAppTy exp_ty1\n        ; let cmd_env = CmdEnv { cmd_arr = arr_ty }\n        ; (pat', cmd') <- tcPat ProcExpr pat (mkCheckExpType arg_ty) $\n                          tcCmdTop cmd_env cmd (unitTy, res_ty)\n        ; let res_co = mkTcTransCo co\n                         (mkTcAppCo co1 (mkTcNomReflCo res_ty))\n        ; return (pat', cmd', res_co) }\n\n{-\n************************************************************************\n*                                                                      *\n                Commands\n*                                                                      *\n************************************************************************\n-}\n\n-- See Note [Arrow overview]\ntype CmdType    = (CmdArgType, TcTauType)    -- cmd_type\ntype CmdArgType = TcTauType                  -- carg_type, a nested tuple\n\ndata CmdEnv\n  = CmdEnv {\n        cmd_arr :: TcType -- arrow type constructor, of kind *->*->*\n    }\n\nmkCmdArrTy :: CmdEnv -> TcTauType -> TcTauType -> TcTauType\nmkCmdArrTy env t1 t2 = mkAppTys (cmd_arr env) [t1, t2]\n\n---------------------------------------\ntcCmdTop :: CmdEnv\n         -> LHsCmdTop GhcRn\n         -> CmdType\n         -> TcM (LHsCmdTop GhcTcId)\n\ntcCmdTop env (L loc (HsCmdTop names cmd)) cmd_ty@(cmd_stk, res_ty)\n  = setSrcSpan loc $\n    do  { cmd'   <- tcCmd env cmd cmd_ty\n        ; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names\n        ; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names') cmd') }\ntcCmdTop _ (L _ XCmdTop{}) _ = panic \"tcCmdTop\"\n\n----------------------------------------\ntcCmd  :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTcId)\n        -- The main recursive function\ntcCmd env (L loc cmd) res_ty\n  = setSrcSpan loc $ do\n        { cmd' <- tc_cmd env cmd res_ty\n        ; return (L loc cmd') }\n\ntc_cmd :: CmdEnv -> HsCmd GhcRn  -> CmdType -> TcM (HsCmd GhcTcId)\ntc_cmd env (HsCmdPar x cmd) res_ty\n  = do  { cmd' <- tcCmd env cmd res_ty\n        ; return (HsCmdPar x cmd') }\n\ntc_cmd env (HsCmdLet x (L l binds) (L body_loc body)) res_ty\n  = do  { (binds', body') <- tcLocalBinds binds         $\n                             setSrcSpan body_loc        $\n                             tc_cmd env body res_ty\n        ; return (HsCmdLet x (L l binds') (L body_loc body')) }\n\ntc_cmd env in_cmd@(HsCmdCase x scrut matches) (stk, res_ty)\n  = addErrCtxt (cmdCtxt in_cmd) $ do\n      (scrut', scrut_ty) <- tcInferRho scrut\n      matches' <- tcMatchesCase match_ctxt scrut_ty matches (mkCheckExpType res_ty)\n      return (HsCmdCase x scrut' matches')\n  where\n    match_ctxt = MC { mc_what = CaseAlt,\n                      mc_body = mc_body }\n    mc_body body res_ty' = do { res_ty' <- expTypeToType res_ty'\n                              ; tcCmd env body (stk, res_ty') }\n\ntc_cmd env (HsCmdIf x Nothing pred b1 b2) res_ty    -- Ordinary 'if'\n  = do  { pred' <- tcMonoExpr pred (mkCheckExpType boolTy)\n        ; b1'   <- tcCmd env b1 res_ty\n        ; b2'   <- tcCmd env b2 res_ty\n        ; return (HsCmdIf x Nothing pred' b1' b2')\n    }\n\ntc_cmd env (HsCmdIf x (Just fun) pred b1 b2) res_ty -- Rebindable syntax for if\n  = do  { pred_ty <- newOpenFlexiTyVarTy\n        -- For arrows, need ifThenElse :: forall r. T -> r -> r -> r\n        -- because we're going to apply it to the environment, not\n        -- the return value.\n        ; (_, [r_tv]) <- tcInstSkolTyVars [alphaTyVar]\n        ; let r_ty = mkTyVarTy r_tv\n        ; checkTc (not (r_tv `elemVarSet` tyCoVarsOfType pred_ty))\n                  (text \"Predicate type of `ifThenElse' depends on result type\")\n        ; (pred', fun')\n            <- tcSyntaxOp IfOrigin fun (map synKnownType [pred_ty, r_ty, r_ty])\n                                       (mkCheckExpType r_ty) $ \\ _ ->\n               tcMonoExpr pred (mkCheckExpType pred_ty)\n\n        ; b1'   <- tcCmd env b1 res_ty\n        ; b2'   <- tcCmd env b2 res_ty\n        ; return (HsCmdIf x (Just fun') pred' b1' b2')\n    }\n\n-------------------------------------------\n--              Arrow application\n--          (f -< a)   or   (f -<< a)\n--\n--   D   |- fun :: a t1 t2\n--   D,G |- arg :: t1\n--  ------------------------\n--   D;G |-a  fun -< arg :: stk --> t2\n--\n--   D,G |- fun :: a t1 t2\n--   D,G |- arg :: t1\n--  ------------------------\n--   D;G |-a  fun -<< arg :: stk --> t2\n--\n-- (plus -<< requires ArrowApply)\n\ntc_cmd env cmd@(HsCmdArrApp _ fun arg ho_app lr) (_, res_ty)\n  = addErrCtxt (cmdCtxt cmd)    $\n    do  { arg_ty <- newOpenFlexiTyVarTy\n        ; let fun_ty = mkCmdArrTy env arg_ty res_ty\n        ; fun' <- select_arrow_scope (tcMonoExpr fun (mkCheckExpType fun_ty))\n\n        ; arg' <- tcMonoExpr arg (mkCheckExpType arg_ty)\n\n        ; return (HsCmdArrApp fun_ty fun' arg' ho_app lr) }\n  where\n       -- Before type-checking f, use the environment of the enclosing\n       -- proc for the (-<) case.\n       -- Local bindings, inside the enclosing proc, are not in scope\n       -- inside f.  In the higher-order case (-<<), they are.\n       -- See Note [Escaping the arrow scope] in TcRnTypes\n    select_arrow_scope tc = case ho_app of\n        HsHigherOrderApp -> tc\n        HsFirstOrderApp  -> escapeArrowScope tc\n\n-------------------------------------------\n--              Command application\n--\n-- D,G |-  exp : t\n-- D;G |-a cmd : (t,stk) --> res\n-- -----------------------------\n-- D;G |-a cmd exp : stk --> res\n\ntc_cmd env cmd@(HsCmdApp x fun arg) (cmd_stk, res_ty)\n  = addErrCtxt (cmdCtxt cmd)    $\n    do  { arg_ty <- newOpenFlexiTyVarTy\n        ; fun'   <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty)\n        ; arg'   <- tcMonoExpr arg (mkCheckExpType arg_ty)\n        ; return (HsCmdApp x fun' arg') }\n\n-------------------------------------------\n--              Lambda\n--\n-- D;G,x:t |-a cmd : stk --> res\n-- ------------------------------\n-- D;G |-a (\\x.cmd) : (t,stk) --> res\n\ntc_cmd env\n       (HsCmdLam x (MG { mg_alts = L l [L mtch_loc\n                                   (match@(Match { m_pats = pats, m_grhss = grhss }))],\n                         mg_origin = origin }))\n       (cmd_stk, res_ty)\n  = addErrCtxt (pprMatchInCtxt match)        $\n    do  { (co, arg_tys, cmd_stk') <- matchExpectedCmdArgs n_pats cmd_stk\n\n                -- Check the patterns, and the GRHSs inside\n        ; (pats', grhss') <- setSrcSpan mtch_loc                                 $\n                             tcPats LambdaExpr pats (map mkCheckExpType arg_tys) $\n                             tc_grhss grhss cmd_stk' (mkCheckExpType res_ty)\n\n        ; let match' = L mtch_loc (Match { m_ext = noExt\n                                         , m_ctxt = LambdaExpr, m_pats = pats'\n                                         , m_grhss = grhss' })\n              arg_tys = map hsLPatType pats'\n              cmd' = HsCmdLam x (MG { mg_alts = L l [match']\n                                    , mg_ext = MatchGroupTc arg_tys res_ty\n                                    , mg_origin = origin })\n        ; return (mkHsCmdWrap (mkWpCastN co) cmd') }\n  where\n    n_pats     = length pats\n    match_ctxt = (LambdaExpr :: HsMatchContext Name)    -- Maybe KappaExpr?\n    pg_ctxt    = PatGuard match_ctxt\n\n    tc_grhss (GRHSs x grhss (L l binds)) stk_ty res_ty\n        = do { (binds', grhss') <- tcLocalBinds binds $\n                                   mapM (wrapLocM (tc_grhs stk_ty res_ty)) grhss\n             ; return (GRHSs x grhss' (L l binds')) }\n    tc_grhss (XGRHSs _) _ _ = panic \"tc_grhss\"\n\n    tc_grhs stk_ty res_ty (GRHS x guards body)\n        = do { (guards', rhs') <- tcStmtsAndThen pg_ctxt tcGuardStmt guards res_ty $\n                                  \\ res_ty -> tcCmd env body\n                                                (stk_ty, checkingExpType \"tc_grhs\" res_ty)\n             ; return (GRHS x guards' rhs') }\n    tc_grhs _ _ (XGRHS _) = panic \"tc_grhs\"\n\n-------------------------------------------\n--              Do notation\n\ntc_cmd env (HsCmdDo _ (L l stmts) ) (cmd_stk, res_ty)\n  = do  { co <- unifyType Nothing unitTy cmd_stk  -- Expecting empty argument stack\n        ; stmts' <- tcStmts ArrowExpr (tcArrDoStmt env) stmts res_ty\n        ; return (mkHsCmdWrap (mkWpCastN co) (HsCmdDo res_ty (L l stmts') )) }\n\n\n-----------------------------------------------------------------\n--      Arrow ``forms''       (| e c1 .. cn |)\n--\n--      D; G |-a1 c1 : stk1 --> r1\n--      ...\n--      D; G |-an cn : stkn --> rn\n--      D |-  e :: forall e. a1 (e, stk1) t1\n--                                ...\n--                        -> an (e, stkn) tn\n--                        -> a  (e, stk) t\n--      e \\not\\in (stk, stk1, ..., stkm, t, t1, ..., tn)\n--      ----------------------------------------------\n--      D; G |-a  (| e c1 ... cn |)  :  stk --> t\n\ntc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty)\n  = addErrCtxt (cmdCtxt cmd)    $\n    do  { (cmd_args', cmd_tys) <- mapAndUnzipM tc_cmd_arg cmd_args\n                              -- We use alphaTyVar for 'w'\n        ; let e_ty = mkInvForAllTy alphaTyVar $\n                     mkVisFunTys cmd_tys $\n                     mkCmdArrTy env (mkPairTy alphaTy cmd_stk) res_ty\n        ; expr' <- tcPolyExpr expr e_ty\n        ; return (HsCmdArrForm x expr' f fixity cmd_args') }\n\n  where\n    tc_cmd_arg :: LHsCmdTop GhcRn -> TcM (LHsCmdTop GhcTcId, TcType)\n    tc_cmd_arg cmd\n       = do { arr_ty <- newFlexiTyVarTy arrowTyConKind\n            ; stk_ty <- newFlexiTyVarTy liftedTypeKind\n            ; res_ty <- newFlexiTyVarTy liftedTypeKind\n            ; let env' = env { cmd_arr = arr_ty }\n            ; cmd' <- tcCmdTop env' cmd (stk_ty, res_ty)\n            ; return (cmd',  mkCmdArrTy env' (mkPairTy alphaTy stk_ty) res_ty) }\n\ntc_cmd _ (XCmd {}) _ = panic \"tc_cmd\"\n\n-----------------------------------------------------------------\n--              Base case for illegal commands\n-- This is where expressions that aren't commands get rejected\n\ntc_cmd _ cmd _\n  = failWithTc (vcat [text \"The expression\", nest 2 (ppr cmd),\n                      text \"was found where an arrow command was expected\"])\n\n\nmatchExpectedCmdArgs :: Arity -> TcType -> TcM (TcCoercionN, [TcType], TcType)\nmatchExpectedCmdArgs 0 ty\n  = return (mkTcNomReflCo ty, [], ty)\nmatchExpectedCmdArgs n ty\n  = do { (co1, [ty1, ty2]) <- matchExpectedTyConApp pairTyCon ty\n       ; (co2, tys, res_ty) <- matchExpectedCmdArgs (n-1) ty2\n       ; return (mkTcTyConAppCo Nominal pairTyCon [co1, co2], ty1:tys, res_ty) }\n\n{-\n************************************************************************\n*                                                                      *\n                Stmts\n*                                                                      *\n************************************************************************\n-}\n\n--------------------------------\n--      Mdo-notation\n-- The distinctive features here are\n--      (a) RecStmts, and\n--      (b) no rebindable syntax\n\ntcArrDoStmt :: CmdEnv -> TcCmdStmtChecker\ntcArrDoStmt env _ (LastStmt x rhs noret _) res_ty thing_inside\n  = do  { rhs' <- tcCmd env rhs (unitTy, res_ty)\n        ; thing <- thing_inside (panic \"tcArrDoStmt\")\n        ; return (LastStmt x rhs' noret noSyntaxExpr, thing) }\n\ntcArrDoStmt env _ (BodyStmt _ rhs _ _) res_ty thing_inside\n  = do  { (rhs', elt_ty) <- tc_arr_rhs env rhs\n        ; thing          <- thing_inside res_ty\n        ; return (BodyStmt elt_ty rhs' noSyntaxExpr noSyntaxExpr, thing) }\n\ntcArrDoStmt env ctxt (BindStmt _ pat rhs _ _) res_ty thing_inside\n  = do  { (rhs', pat_ty) <- tc_arr_rhs env rhs\n        ; (pat', thing)  <- tcPat (StmtCtxt ctxt) pat (mkCheckExpType pat_ty) $\n                            thing_inside res_ty\n        ; return (mkTcBindStmt pat' rhs', thing) }\n\ntcArrDoStmt env ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names\n                            , recS_rec_ids = rec_names }) res_ty thing_inside\n  = do  { let tup_names = rec_names ++ filterOut (`elem` rec_names) later_names\n        ; tup_elt_tys <- newFlexiTyVarTys (length tup_names) liftedTypeKind\n        ; let tup_ids = zipWith mkLocalId tup_names tup_elt_tys\n        ; tcExtendIdEnv tup_ids $ do\n        { (stmts', tup_rets)\n                <- tcStmtsAndThen ctxt (tcArrDoStmt env) stmts res_ty   $ \\ _res_ty' ->\n                        -- ToDo: res_ty not really right\n                   zipWithM tcCheckId tup_names (map mkCheckExpType tup_elt_tys)\n\n        ; thing <- thing_inside res_ty\n                -- NB:  The rec_ids for the recursive things\n                --      already scope over this part. This binding may shadow\n                --      some of them with polymorphic things with the same Name\n                --      (see note [RecStmt] in HsExpr)\n\n        ; let rec_ids = takeList rec_names tup_ids\n        ; later_ids <- tcLookupLocalIds later_names\n\n        ; let rec_rets = takeList rec_names tup_rets\n        ; let ret_table = zip tup_ids tup_rets\n        ; let later_rets = [r | i <- later_ids, (j, r) <- ret_table, i == j]\n\n        ; return (emptyRecStmtId { recS_stmts = stmts'\n                                 , recS_later_ids = later_ids\n                                 , recS_rec_ids = rec_ids\n                                 , recS_ext = unitRecStmtTc\n                                     { recS_later_rets = later_rets\n                                     , recS_rec_rets = rec_rets\n                                     , recS_ret_ty = res_ty} }, thing)\n        }}\n\ntcArrDoStmt _ _ stmt _ _\n  = pprPanic \"tcArrDoStmt: unexpected Stmt\" (ppr stmt)\n\ntc_arr_rhs :: CmdEnv -> LHsCmd GhcRn -> TcM (LHsCmd GhcTcId, TcType)\ntc_arr_rhs env rhs = do { ty <- newFlexiTyVarTy liftedTypeKind\n                        ; rhs' <- tcCmd env rhs (unitTy, ty)\n                        ; return (rhs', ty) }\n\n{-\n************************************************************************\n*                                                                      *\n                Helpers\n*                                                                      *\n************************************************************************\n-}\n\nmkPairTy :: Type -> Type -> Type\nmkPairTy t1 t2 = mkTyConApp pairTyCon [t1,t2]\n\narrowTyConKind :: Kind          --  *->*->*\narrowTyConKind = mkVisFunTys [liftedTypeKind, liftedTypeKind] liftedTypeKind\n\n{-\n************************************************************************\n*                                                                      *\n                Errors\n*                                                                      *\n************************************************************************\n-}\n\ncmdCtxt :: HsCmd GhcRn -> SDoc\ncmdCtxt cmd = text \"In the command:\" <+> ppr cmd\n", "num_lines": 441}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NondecreasingIndentation #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule TcBackpack (\n    findExtraSigImports',\n    findExtraSigImports,\n    implicitRequirements',\n    implicitRequirements,\n    checkUnitId,\n    tcRnCheckUnitId,\n    tcRnMergeSignatures,\n    mergeSignatures,\n    tcRnInstantiateSignature,\n    instantiateSignature,\n) where\n\nimport GhcPrelude\n\nimport BasicTypes (defaultFixity)\nimport Packages\nimport TcRnExports\nimport DynFlags\nimport HsSyn\nimport RdrName\nimport TcRnMonad\nimport TcTyDecls\nimport InstEnv\nimport FamInstEnv\nimport Inst\nimport TcIface\nimport TcMType\nimport TcType\nimport TcSimplify\nimport LoadIface\nimport RnNames\nimport ErrUtils\nimport Id\nimport Module\nimport Name\nimport NameEnv\nimport NameSet\nimport Avail\nimport SrcLoc\nimport HscTypes\nimport Outputable\nimport Type\nimport FastString\nimport RnFixity ( lookupFixityRn )\nimport Maybes\nimport TcEnv\nimport Var\nimport IfaceSyn\nimport PrelNames\nimport qualified Data.Map as Map\n\nimport Finder\nimport UniqDSet\nimport NameShape\nimport TcErrors\nimport TcUnify\nimport RnModIface\nimport Util\n\nimport Control.Monad\nimport Data.List (find)\n\nimport {-# SOURCE #-} TcRnDriver\n\n#include \"HsVersions.h\"\n\nfixityMisMatch :: TyThing -> Fixity -> Fixity -> SDoc\nfixityMisMatch real_thing real_fixity sig_fixity =\n    vcat [ppr real_thing <+> text \"has conflicting fixities in the module\",\n          text \"and its hsig file\",\n          text \"Main module:\" <+> ppr_fix real_fixity,\n          text \"Hsig file:\" <+> ppr_fix sig_fixity]\n  where\n    ppr_fix f =\n        ppr f <+>\n        (if f == defaultFixity\n            then parens (text \"default\")\n            else empty)\n\ncheckHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn ()\ncheckHsigDeclM sig_iface sig_thing real_thing = do\n    let name = getName real_thing\n    -- TODO: Distinguish between signature merging and signature\n    -- implementation cases.\n    checkBootDeclM False sig_thing real_thing\n    real_fixity <- lookupFixityRn name\n    let sig_fixity = case mi_fix_fn sig_iface (occName name) of\n                        Nothing -> defaultFixity\n                        Just f -> f\n    when (real_fixity /= sig_fixity) $\n      addErrAt (nameSrcSpan name)\n        (fixityMisMatch real_thing real_fixity sig_fixity)\n\n-- | Given a 'ModDetails' of an instantiated signature (note that the\n-- 'ModDetails' must be knot-tied consistently with the actual implementation)\n-- and a 'GlobalRdrEnv' constructed from the implementor of this interface,\n-- verify that the actual implementation actually matches the original\n-- interface.\n--\n-- Note that it is already assumed that the implementation *exports*\n-- a sufficient set of entities, since otherwise the renaming and then\n-- typechecking of the signature 'ModIface' would have failed.\ncheckHsigIface :: TcGblEnv -> GlobalRdrEnv -> ModIface -> ModDetails -> TcRn ()\ncheckHsigIface tcg_env gr sig_iface\n  ModDetails { md_insts = sig_insts, md_fam_insts = sig_fam_insts,\n               md_types = sig_type_env, md_exports = sig_exports   } = do\n    traceTc \"checkHsigIface\" $ vcat\n        [ ppr sig_type_env, ppr sig_insts, ppr sig_exports ]\n    mapM_ check_export (map availName sig_exports)\n    unless (null sig_fam_insts) $\n        panic (\"TcRnDriver.checkHsigIface: Cannot handle family \" ++\n               \"instances in hsig files yet...\")\n    -- Delete instances so we don't look them up when\n    -- checking instance satisfiability\n    -- TODO: this should not be necessary\n    tcg_env <- getGblEnv\n    setGblEnv tcg_env { tcg_inst_env = emptyInstEnv,\n                        tcg_fam_inst_env = emptyFamInstEnv,\n                        tcg_insts = [],\n                        tcg_fam_insts = [] } $ do\n    mapM_ check_inst sig_insts\n    failIfErrsM\n  where\n    -- NB: the Names in sig_type_env are bogus.  Let's say we have H.hsig\n    -- in package p that defines T; and we implement with himpl:H.  Then the\n    -- Name is p[himpl:H]:H.T, NOT himplH:H.T.  That's OK but we just\n    -- have to look up the right name.\n    sig_type_occ_env = mkOccEnv\n                     . map (\\t -> (nameOccName (getName t), t))\n                     $ nameEnvElts sig_type_env\n    dfun_names = map getName sig_insts\n    check_export name\n      -- Skip instances, we'll check them later\n      -- TODO: Actually this should never happen, because DFuns are\n      -- never exported...\n      | name `elem` dfun_names = return ()\n      -- See if we can find the type directly in the hsig ModDetails\n      -- TODO: need to special case wired in names\n      | Just sig_thing <- lookupOccEnv sig_type_occ_env (nameOccName name) = do\n        -- NB: We use tcLookupImported_maybe because we want to EXCLUDE\n        -- tcg_env (TODO: but maybe this isn't relevant anymore).\n        r <- tcLookupImported_maybe name\n        case r of\n          Failed err -> addErr err\n          Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing\n\n      -- The hsig did NOT define this function; that means it must\n      -- be a reexport.  In this case, make sure the 'Name' of the\n      -- reexport matches the 'Name exported here.\n      | [GRE { gre_name = name' }] <- lookupGlobalRdrEnv gr (nameOccName name) =\n        when (name /= name') $ do\n            -- See Note [Error reporting bad reexport]\n            -- TODO: Actually this error swizzle doesn't work\n            let p (L _ ie) = name `elem` ieNames ie\n                loc = case tcg_rn_exports tcg_env of\n                       Just es | Just e <- find p (map fst es)\n                         -- TODO: maybe we can be a little more\n                         -- precise here and use the Located\n                         -- info for the *specific* name we matched.\n                         -> getLoc e\n                       _ -> nameSrcSpan name\n            dflags <- getDynFlags\n            addErrAt loc\n                (badReexportedBootThing dflags False name name')\n      -- This should actually never happen, but whatever...\n      | otherwise =\n        addErrAt (nameSrcSpan name)\n            (missingBootThing False name \"exported by\")\n\n-- Note [Error reporting bad reexport]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- NB: You want to be a bit careful about what location you report on reexports.\n-- If the name was declared in the hsig file, 'nameSrcSpan name' is indeed the\n-- correct source location.  However, if it was *reexported*, obviously the name\n-- is not going to have the right location.  In this case, we need to grovel in\n-- tcg_rn_exports to figure out where the reexport came from.\n\n\n\n-- | Checks if a 'ClsInst' is \"defined\". In general, for hsig files we can't\n-- assume that the implementing file actually implemented the instances (they\n-- may be reexported from elsewhere).  Where should we look for the instances?\n-- We do the same as we would otherwise: consult the EPS.  This isn't perfect\n-- (we might conclude the module exports an instance when it doesn't, see\n-- #9422), but we will never refuse to compile something.\ncheck_inst :: ClsInst -> TcM ()\ncheck_inst sig_inst = do\n    -- TODO: This could be very well generalized to support instance\n    -- declarations in boot files.\n    tcg_env <- getGblEnv\n    -- NB: Have to tug on the interface, not necessarily\n    -- tugged... but it didn't work?\n    mapM_ tcLookupImported_maybe (nameSetElemsStable (orphNamesOfClsInst sig_inst))\n    -- Based off of 'simplifyDeriv'\n    let ty = idType (instanceDFunId sig_inst)\n        skol_info = InstSkol\n        -- Based off of tcSplitDFunTy\n        (tvs, theta, pred) =\n           case tcSplitForAllTys ty of { (tvs, rho)   ->\n           case splitFunTys rho     of { (theta, pred) ->\n           (tvs, theta, pred) }}\n        origin = InstProvidedOrigin (tcg_semantic_mod tcg_env) sig_inst\n    (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize\n    (tclvl,cts) <- pushTcLevelM $ do\n       wanted <- newWanted origin\n                           (Just TypeLevel)\n                           (substTy skol_subst pred)\n       givens <- forM theta $ \\given -> do\n           loc <- getCtLocM origin (Just TypeLevel)\n           let given_pred = substTy skol_subst given\n           new_ev <- newEvVar given_pred\n           return CtGiven { ctev_pred = given_pred\n                          -- Doesn't matter, make something up\n                          , ctev_evar = new_ev\n                          , ctev_loc = loc\n                          }\n       return $ wanted : givens\n    unsolved <- simplifyWantedsTcM cts\n\n    (implic, _) <- buildImplicationFor tclvl skol_info tvs_skols [] unsolved\n    reportAllUnsolved (mkImplicWC implic)\n\n-- | Return this list of requirement interfaces that need to be merged\n-- to form @mod_name@, or @[]@ if this is not a requirement.\nrequirementMerges :: DynFlags -> ModuleName -> [IndefModule]\nrequirementMerges dflags mod_name =\n    fromMaybe [] (Map.lookup mod_name (requirementContext (pkgState dflags)))\n\n-- | For a module @modname@ of type 'HscSource', determine the list\n-- of extra \"imports\" of other requirements which should be considered part of\n-- the import of the requirement, because it transitively depends on those\n-- requirements by imports of modules from other packages.  The situation\n-- is something like this:\n--\n--      unit p where\n--          signature A\n--          signature B\n--              import A\n--\n--      unit q where\n--          dependency p[A=<A>,B=<B>]\n--          signature A\n--          signature B\n--\n-- Although q's B does not directly import A, we still have to make sure we\n-- process A first, because the merging process will cause B to indirectly\n-- import A.  This function finds the TRANSITIVE closure of all such imports\n-- we need to make.\nfindExtraSigImports' :: HscEnv\n                     -> HscSource\n                     -> ModuleName\n                     -> IO (UniqDSet ModuleName)\nfindExtraSigImports' hsc_env HsigFile modname =\n    fmap unionManyUniqDSets (forM reqs $ \\(IndefModule iuid mod_name) ->\n        (initIfaceLoad hsc_env\n            . withException\n            $ moduleFreeHolesPrecise (text \"findExtraSigImports\")\n                (mkModule (IndefiniteUnitId iuid) mod_name)))\n  where\n    reqs = requirementMerges (hsc_dflags hsc_env) modname\n\nfindExtraSigImports' _ _ _ = return emptyUniqDSet\n\n-- | 'findExtraSigImports', but in a convenient form for \"GhcMake\" and\n-- \"TcRnDriver\".\nfindExtraSigImports :: HscEnv -> HscSource -> ModuleName\n                    -> IO [(Maybe FastString, Located ModuleName)]\nfindExtraSigImports hsc_env hsc_src modname = do\n    extra_requirements <- findExtraSigImports' hsc_env hsc_src modname\n    return [ (Nothing, noLoc mod_name)\n           | mod_name <- uniqDSetToList extra_requirements ]\n\n-- A version of 'implicitRequirements'' which is more friendly\n-- for \"GhcMake\" and \"TcRnDriver\".\nimplicitRequirements :: HscEnv\n                     -> [(Maybe FastString, Located ModuleName)]\n                     -> IO [(Maybe FastString, Located ModuleName)]\nimplicitRequirements hsc_env normal_imports\n  = do mns <- implicitRequirements' hsc_env normal_imports\n       return [ (Nothing, noLoc mn) | mn <- mns ]\n\n-- Given a list of 'import M' statements in a module, figure out\n-- any extra implicit requirement imports they may have.  For\n-- example, if they 'import M' and M resolves to p[A=<B>], then\n-- they actually also import the local requirement B.\nimplicitRequirements' :: HscEnv\n                     -> [(Maybe FastString, Located ModuleName)]\n                     -> IO [ModuleName]\nimplicitRequirements' hsc_env normal_imports\n  = fmap concat $\n    forM normal_imports $ \\(mb_pkg, L _ imp) -> do\n        found <- findImportedModule hsc_env imp mb_pkg\n        case found of\n            Found _ mod | thisPackage dflags /= moduleUnitId mod ->\n                return (uniqDSetToList (moduleFreeHoles mod))\n            _ -> return []\n  where dflags = hsc_dflags hsc_env\n\n-- | Given a 'UnitId', make sure it is well typed.  This is because\n-- unit IDs come from Cabal, which does not know if things are well-typed or\n-- not; a component may have been filled with implementations for the holes\n-- that don't actually fulfill the requirements.\n--\n-- INVARIANT: the UnitId is NOT a InstalledUnitId\ncheckUnitId :: UnitId -> TcM ()\ncheckUnitId uid = do\n    case splitUnitIdInsts uid of\n      (_, Just indef) ->\n        let insts = indefUnitIdInsts indef in\n        forM_ insts $ \\(mod_name, mod) ->\n            -- NB: direct hole instantiations are well-typed by construction\n            -- (because we FORCE things to be merged in), so don't check them\n            when (not (isHoleModule mod)) $ do\n                checkUnitId (moduleUnitId mod)\n                _ <- mod `checkImplements` IndefModule indef mod_name\n                return ()\n      _ -> return () -- if it's hashed, must be well-typed\n\n-- | Top-level driver for signature instantiation (run when compiling\n-- an @hsig@ file.)\ntcRnCheckUnitId ::\n    HscEnv -> UnitId ->\n    IO (Messages, Maybe ())\ntcRnCheckUnitId hsc_env uid =\n   withTiming (pure dflags)\n              (text \"Check unit id\" <+> ppr uid)\n              (const ()) $\n   initTc hsc_env\n          HsigFile -- bogus\n          False\n          mAIN -- bogus\n          (realSrcLocSpan (mkRealSrcLoc (fsLit loc_str) 0 0)) -- bogus\n    $ checkUnitId uid\n  where\n   dflags = hsc_dflags hsc_env\n   loc_str = \"Command line argument: -unit-id \" ++ showSDoc dflags (ppr uid)\n\n-- TODO: Maybe lcl_iface0 should be pre-renamed to the right thing? Unclear...\n\n-- | Top-level driver for signature merging (run after typechecking\n-- an @hsig@ file).\ntcRnMergeSignatures :: HscEnv -> HsParsedModule -> TcGblEnv {- from local sig -} -> ModIface\n                    -> IO (Messages, Maybe TcGblEnv)\ntcRnMergeSignatures hsc_env hpm orig_tcg_env iface =\n  withTiming (pure dflags)\n             (text \"Signature merging\" <+> brackets (ppr this_mod))\n             (const ()) $\n  initTc hsc_env HsigFile False this_mod real_loc $\n    mergeSignatures hpm orig_tcg_env iface\n where\n  dflags   = hsc_dflags hsc_env\n  this_mod = mi_module iface\n  real_loc = tcg_top_loc orig_tcg_env\n\nthinModIface :: [AvailInfo] -> ModIface -> ModIface\nthinModIface avails iface =\n    iface {\n        mi_exports = avails,\n        -- mi_fixities = ...,\n        -- mi_warns = ...,\n        -- mi_anns = ...,\n        -- TODO: The use of nameOccName here is a bit dodgy, because\n        -- perhaps there might be two IfaceTopBndr that are the same\n        -- OccName but different Name.  Requires better understanding\n        -- of invariants here.\n        mi_decls = exported_decls ++ non_exported_decls ++ dfun_decls\n        -- mi_insts = ...,\n        -- mi_fam_insts = ...,\n    }\n  where\n    decl_pred occs decl = nameOccName (ifName decl) `elemOccSet` occs\n    filter_decls occs = filter (decl_pred occs . snd) (mi_decls iface)\n\n    exported_occs = mkOccSet [ occName n\n                             | a <- avails\n                             , n <- availNames a ]\n    exported_decls = filter_decls exported_occs\n\n    non_exported_occs = mkOccSet [ occName n\n                                 | (_, d) <- exported_decls\n                                 , n <- ifaceDeclNeverExportedRefs d ]\n    non_exported_decls = filter_decls non_exported_occs\n\n    dfun_pred IfaceId{ ifIdDetails = IfDFunId } = True\n    dfun_pred _ = False\n    dfun_decls = filter (dfun_pred . snd) (mi_decls iface)\n\n-- | The list of 'Name's of *non-exported* 'IfaceDecl's which this\n-- 'IfaceDecl' may refer to.  A non-exported 'IfaceDecl' should be kept\n-- after thinning if an *exported* 'IfaceDecl' (or 'mi_insts', perhaps)\n-- refers to it; we can't decide to keep it by looking at the exports\n-- of a module after thinning.  Keep this synchronized with\n-- 'rnIfaceDecl'.\nifaceDeclNeverExportedRefs :: IfaceDecl -> [Name]\nifaceDeclNeverExportedRefs d@IfaceFamily{} =\n    case ifFamFlav d of\n        IfaceClosedSynFamilyTyCon (Just (n, _))\n            -> [n]\n        _   -> []\nifaceDeclNeverExportedRefs _ = []\n\n\n-- Note [Blank hsigs for all requirements]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- One invariant that a client of GHC must uphold is that there\n-- must be an hsig file for every requirement (according to\n-- @-this-unit-id@); this ensures that for every interface\n-- file (hi), there is a source file (hsig), which helps grease\n-- the wheels of recompilation avoidance which assumes that\n-- source files always exist.\n\n{-\ninheritedSigPvpWarning :: WarningTxt\ninheritedSigPvpWarning =\n    WarningTxt (noLoc NoSourceText) [noLoc (StringLiteral NoSourceText (fsLit msg))]\n  where\n    msg = \"Inherited requirements from non-signature libraries (libraries \" ++\n          \"with modules) should not be used, as this mode of use is not \" ++\n          \"compatible with PVP-style version bounds.  Instead, copy the \" ++\n          \"declaration to the local hsig file or move the signature to a \" ++\n          \"library of its own and add that library as a dependency.\"\n-}\n\n-- Note [Handling never-exported TyThings under Backpack]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--   DEFINITION: A \"never-exported TyThing\" is a TyThing whose 'Name' will\n--   never be mentioned in the export list of a module (mi_avails).\n--   Unlike implicit TyThings (Note [Implicit TyThings]), non-exported\n--   TyThings DO have a standalone IfaceDecl declaration in their\n--   interface file.\n--\n-- Originally, Backpack was designed under the assumption that anything\n-- you could declare in a module could also be exported; thus, merging\n-- the export lists of two signatures is just merging the declarations\n-- of two signatures writ small.  Of course, in GHC Haskell, there are a\n-- few important things which are not explicitly exported but still can\n-- be used:  in particular, dictionary functions for instances, Typeable\n-- TyCon bindings, and coercion axioms for type families also count.\n--\n-- When handling these non-exported things, there two primary things\n-- we need to watch out for:\n--\n--  * Signature matching/merging is done by comparing each\n--    of the exported entities of a signature and a module.  These exported\n--    entities may refer to non-exported TyThings which must be tested for\n--    consistency.  For example, an instance (ClsInst) will refer to a\n--    non-exported DFunId.  In this case, 'checkBootDeclM' directly compares the\n--    embedded 'DFunId' in 'is_dfun'.\n--\n--    For this to work at all, we must ensure that pointers in 'is_dfun' refer\n--    to DISTINCT 'DFunId's, even though the 'Name's (may) be the same.\n--    Unfortunately, this is the OPPOSITE of how we treat most other references\n--    to 'Name's, so this case needs to be handled specially.\n--\n--    The details are in the documentation for 'typecheckIfacesForMerging'.\n--    and the Note [Resolving never-exported Names in TcIface].\n--\n--  * When we rename modules and signatures, we use the export lists to\n--    decide how the declarations should be renamed.  However, this\n--    means we don't get any guidance for how to rename non-exported\n--    entities.  Fortunately, we only need to rename these entities\n--    *consistently*, so that 'typecheckIfacesForMerging' can wire them\n--    up as needed.\n--\n--    The details are in Note [rnIfaceNeverExported] in 'RnModIface'.\n--\n-- The root cause for all of these complications is the fact that these\n-- logically \"implicit\" entities are defined indirectly in an interface\n-- file.  #13151 gives a proposal to make these *truly* implicit.\n\nmerge_msg :: ModuleName -> [IndefModule] -> SDoc\nmerge_msg mod_name [] =\n    text \"while checking the local signature\" <+> ppr mod_name <+>\n    text \"for consistency\"\nmerge_msg mod_name reqs =\n  hang (text \"while merging the signatures from\" <> colon)\n   2 (vcat [ bullet <+> ppr req | req <- reqs ] $$\n      bullet <+> text \"...and the local signature for\" <+> ppr mod_name)\n\n-- | Given a local 'ModIface', merge all inherited requirements\n-- from 'requirementMerges' into this signature, producing\n-- a final 'TcGblEnv' that matches the local signature and\n-- all required signatures.\nmergeSignatures :: HsParsedModule -> TcGblEnv -> ModIface -> TcRn TcGblEnv\nmergeSignatures\n  (HsParsedModule { hpm_module = L loc (HsModule { hsmodExports = mb_exports }),\n                    hpm_src_files = src_files })\n  orig_tcg_env lcl_iface0 = setSrcSpan loc $ do\n    -- The lcl_iface0 is the ModIface for the local hsig\n    -- file, which is guaranteed to exist, see\n    -- Note [Blank hsigs for all requirements]\n    hsc_env <- getTopEnv\n    dflags  <- getDynFlags\n\n    -- Copy over some things from the original TcGblEnv that\n    -- we want to preserve\n    updGblEnv (\\env -> env {\n        -- Renamed imports/declarations are often used\n        -- by programs that use the GHC API, e.g., Haddock.\n        -- These won't get filled by the merging process (since\n        -- we don't actually rename the parsed module again) so\n        -- we need to take them directly from the previous\n        -- typechecking.\n        --\n        -- NB: the export declarations aren't in their final\n        -- form yet.  We'll fill those in when we reprocess\n        -- the export declarations.\n        tcg_rn_imports = tcg_rn_imports orig_tcg_env,\n        tcg_rn_decls   = tcg_rn_decls   orig_tcg_env,\n        -- Annotations\n        tcg_ann_env    = tcg_ann_env    orig_tcg_env,\n        -- Documentation header\n        tcg_doc_hdr    = tcg_doc_hdr orig_tcg_env\n        -- tcg_dus?\n        -- tcg_th_used           = tcg_th_used orig_tcg_env,\n        -- tcg_th_splice_used    = tcg_th_splice_used orig_tcg_env\n        -- tcg_th_top_level_locs = tcg_th_top_level_locs orig_tcg_env\n       }) $ do\n    tcg_env <- getGblEnv\n\n    let outer_mod = tcg_mod tcg_env\n        inner_mod = tcg_semantic_mod tcg_env\n        mod_name = moduleName (tcg_mod tcg_env)\n\n    -- STEP 1: Figure out all of the external signature interfaces\n    -- we are going to merge in.\n    let reqs = requirementMerges dflags mod_name\n\n    addErrCtxt (merge_msg mod_name reqs) $ do\n\n    -- STEP 2: Read in the RAW forms of all of these interfaces\n    ireq_ifaces0 <- forM reqs $ \\(IndefModule iuid mod_name) ->\n        let m = mkModule (IndefiniteUnitId iuid) mod_name\n            im = fst (splitModuleInsts m)\n        in fmap fst\n         . withException\n         $ findAndReadIface (text \"mergeSignatures\") im m False\n\n    -- STEP 3: Get the unrenamed exports of all these interfaces,\n    -- thin it according to the export list, and do shaping on them.\n    let extend_ns nsubst as = liftIO $ extendNameShape hsc_env nsubst as\n        -- This function gets run on every inherited interface, and\n        -- it's responsible for:\n        --\n        --  1. Merging the exports of the interface into @nsubst@,\n        --  2. Adding these exports to the \"OK to import\" set (@oks@)\n        --  if they came from a package with no exposed modules\n        --  (this means we won't report a PVP error in this case), and\n        --  3. Thinning the interface according to an explicit export\n        --  list.\n        --\n        gen_subst (nsubst,oks,ifaces) (imod@(IndefModule iuid _), ireq_iface) = do\n            let insts = indefUnitIdInsts iuid\n                isFromSignaturePackage =\n                    let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid))\n                        pkg = getInstalledPackageDetails dflags inst_uid\n                    in null (exposedModules pkg)\n            -- 3(a). Rename the exports according to how the dependency\n            -- was instantiated.  The resulting export list will be accurate\n            -- except for exports *from the signature itself* (which may\n            -- be subsequently updated by exports from other signatures in\n            -- the merge.\n            as1 <- tcRnModExports insts ireq_iface\n            -- 3(b). Thin the interface if it comes from a signature package.\n            (thinned_iface, as2) <- case mb_exports of\n                    Just (L loc _)\n                      -- Check if the package containing this signature is\n                      -- a signature package (i.e., does not expose any\n                      -- modules.)  If so, we can thin it.\n                      | isFromSignaturePackage\n                      -> setSrcSpan loc $ do\n                        -- Suppress missing errors; they might be used to refer\n                        -- to entities from other signatures we are merging in.\n                        -- If an identifier truly doesn't exist in any of the\n                        -- signatures that are merged in, we will discover this\n                        -- when we run exports_from_avail on the final merged\n                        -- export list.\n                        (msgs, mb_r) <- tryTc $ do\n                            -- Suppose that we have written in a signature:\n                            --  signature A ( module A ) where {- empty -}\n                            -- If I am also inheriting a signature from a\n                            -- signature package, does 'module A' scope over\n                            -- all of its exports?\n                            --\n                            -- There are two possible interpretations:\n                            --\n                            --  1. For non self-reexports, a module reexport\n                            --  is interpreted only in terms of the local\n                            --  signature module, and not any of the inherited\n                            --  ones.  The reason for this is because after\n                            --  typechecking, module exports are completely\n                            --  erased from the interface of a file, so we\n                            --  have no way of \"interpreting\" a module reexport.\n                            --  Thus, it's only useful for the local signature\n                            --  module (where we have a useful GlobalRdrEnv.)\n                            --\n                            --  2. On the other hand, a common idiom when\n                            --  you want to \"export everything, plus a reexport\"\n                            --  in modules is to say module A ( module A, reex ).\n                            --  This applies to signature modules too; and in\n                            --  particular, you probably still want the entities\n                            --  from the inherited signatures to be preserved\n                            --  too.\n                            --\n                            -- We think it's worth making a special case for\n                            -- self reexports to make use case (2) work.  To\n                            -- do this, we take the exports of the inherited\n                            -- signature @as1@, and bundle them into a\n                            -- GlobalRdrEnv where we treat them as having come\n                            -- from the import @import A@.  Thus, we will\n                            -- pick them up if they are referenced explicitly\n                            -- (@foo@) or even if we do a module reexport\n                            -- (@module A@).\n                            let ispec = ImpSpec ImpDeclSpec{\n                                            -- NB: This needs to be mod name\n                                            -- of the local signature, not\n                                            -- the (original) module name of\n                                            -- the inherited signature,\n                                            -- because we need module\n                                            -- LocalSig (from the local\n                                            -- export list) to match it!\n                                            is_mod  = mod_name,\n                                            is_as   = mod_name,\n                                            is_qual = False,\n                                            is_dloc = loc\n                                          } ImpAll\n                                rdr_env = mkGlobalRdrEnv (gresFromAvails (Just ispec) as1)\n                            setGblEnv tcg_env {\n                                tcg_rdr_env = rdr_env\n                            } $ exports_from_avail mb_exports rdr_env\n                                    -- NB: tcg_imports is also empty!\n                                    emptyImportAvails\n                                    (tcg_semantic_mod tcg_env)\n                        case mb_r of\n                            Just (_, as2) -> return (thinModIface as2 ireq_iface, as2)\n                            Nothing -> addMessages msgs >> failM\n                    -- We can't think signatures from non signature packages\n                    _ -> return (ireq_iface, as1)\n            -- 3(c). Only identifiers from signature packages are \"ok\" to\n            -- import (that is, they are safe from a PVP perspective.)\n            -- (NB: This code is actually dead right now.)\n            let oks' | isFromSignaturePackage\n                     = extendOccSetList oks (exportOccs as2)\n                     | otherwise\n                     = oks\n            -- 3(d). Extend the name substitution (performing shaping)\n            mb_r <- extend_ns nsubst as2\n            case mb_r of\n                Left err -> failWithTc err\n                Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces)\n        nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0)\n        ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0))\n    -- Process each interface, getting the thinned interfaces as well as\n    -- the final, full set of exports @nsubst@ and the exports which are\n    -- \"ok to use\" (we won't attach 'inheritedSigPvpWarning' to them.)\n    (nsubst, ok_to_use, rev_thinned_ifaces)\n        <- foldM gen_subst (nsubst0, ok_to_use0, []) (zip reqs ireq_ifaces0)\n    let thinned_ifaces = reverse rev_thinned_ifaces\n        exports        = nameShapeExports nsubst\n        rdr_env        = mkGlobalRdrEnv (gresFromAvails Nothing exports)\n        _warn_occs     = filter (not . (`elemOccSet` ok_to_use)) (exportOccs exports)\n        warns          = NoWarnings\n        {-\n        -- TODO: Warnings are transitive, but this is not what we want here:\n        -- if a module reexports an entity from a signature, that should be OK.\n        -- Not supported in current warning framework\n        warns | null warn_occs = NoWarnings\n              | otherwise = WarnSome $ map (\\o -> (o, inheritedSigPvpWarning)) warn_occs\n        -}\n    setGblEnv tcg_env {\n        -- The top-level GlobalRdrEnv is quite interesting.  It consists\n        -- of two components:\n        --  1. First, we reuse the GlobalRdrEnv of the local signature.\n        --     This is very useful, because it means that if we have\n        --     to print a message involving some entity that the local\n        --     signature imported, we'll qualify it accordingly.\n        --  2. Second, we need to add all of the declarations we are\n        --     going to merge in (as they need to be in scope for the\n        --     final test of the export list.)\n        tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env orig_tcg_env,\n        -- Inherit imports from the local signature, so that module\n        -- rexports are picked up correctly\n        tcg_imports = tcg_imports orig_tcg_env,\n        tcg_exports = exports,\n        tcg_dus     = usesOnly (availsToNameSetWithSelectors exports),\n        tcg_warns   = warns\n        } $ do\n    tcg_env <- getGblEnv\n\n    -- Make sure we didn't refer to anything that doesn't actually exist\n    -- pprTrace \"mergeSignatures: exports_from_avail\" (ppr exports) $ return ()\n    (mb_lies, _) <- exports_from_avail mb_exports rdr_env\n                        (tcg_imports tcg_env) (tcg_semantic_mod tcg_env)\n\n    {- -- NB: This is commented out, because warns above is disabled.\n    -- If you tried to explicitly export an identifier that has a warning\n    -- attached to it, that's probably a mistake.  Warn about it.\n    case mb_lies of\n      Nothing -> return ()\n      Just lies ->\n        forM_ (concatMap (\\(L loc x) -> map (L loc) (ieNames x)) lies) $ \\(L loc n) ->\n          setSrcSpan loc $\n            unless (nameOccName n `elemOccSet` ok_to_use) $\n                addWarn NoReason $ vcat [\n                    text \"Exported identifier\" <+> quotes (ppr n) <+> text \"will cause warnings if used.\",\n                    parens (text \"To suppress this warning, remove\" <+> quotes (ppr n) <+> text \"from the export list of this signature.\")\n                    ]\n    -}\n\n    failIfErrsM\n\n    -- Save the exports\n    setGblEnv tcg_env { tcg_rn_exports = mb_lies } $ do\n    tcg_env <- getGblEnv\n\n    -- STEP 4: Rename the interfaces\n    ext_ifaces <- forM thinned_ifaces $ \\((IndefModule iuid _), ireq_iface) ->\n        tcRnModIface (indefUnitIdInsts iuid) (Just nsubst) ireq_iface\n    lcl_iface <- tcRnModIface (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0\n    let ifaces = lcl_iface : ext_ifaces\n\n    -- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env\n    let fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)\n                            | (occ, f) <- concatMap mi_fixities ifaces\n                            , rdr_elt <- lookupGlobalRdrEnv rdr_env occ ]\n\n    -- STEP 5: Typecheck the interfaces\n    let type_env_var = tcg_type_env_var tcg_env\n\n    -- typecheckIfacesForMerging does two things:\n    --      1. It merges the all of the ifaces together, and typechecks the\n    --      result to type_env.\n    --      2. It typechecks each iface individually, but with their 'Name's\n    --      resolving to the merged type_env from (1).\n    -- See typecheckIfacesForMerging for more details.\n    (type_env, detailss) <- initIfaceTcRn $\n                            typecheckIfacesForMerging inner_mod ifaces type_env_var\n    let infos = zip ifaces detailss\n\n    -- Test for cycles\n    checkSynCycles (thisPackage dflags) (typeEnvTyCons type_env) []\n\n    -- NB on type_env: it contains NO dfuns.  DFuns are recorded inside\n    -- detailss, and given a Name that doesn't correspond to anything real.  See\n    -- also Note [Signature merging DFuns]\n\n    -- Add the merged type_env to TcGblEnv, so that it gets serialized\n    -- out when we finally write out the interface.\n    --\n    -- NB: Why do we set tcg_tcs/tcg_patsyns/tcg_type_env directly,\n    -- rather than use tcExtendGlobalEnv (the normal method to add newly\n    -- defined types to TcGblEnv?)  tcExtendGlobalEnv adds these\n    -- TyThings to 'tcg_type_env_var', which is consulted when\n    -- we read in interfaces to tie the knot.  But *these TyThings themselves\n    -- come from interface*, so that would result in deadlock.  Don't\n    -- update it!\n    setGblEnv tcg_env {\n        tcg_tcs = typeEnvTyCons type_env,\n        tcg_patsyns = typeEnvPatSyns type_env,\n        tcg_type_env = type_env,\n        tcg_fix_env = fix_env\n        } $ do\n    tcg_env <- getGblEnv\n\n    -- STEP 6: Check for compatibility/merge things\n    tcg_env <- (\\x -> foldM x tcg_env infos)\n             $ \\tcg_env (iface, details) -> do\n\n        let check_export name\n              | Just sig_thing <- lookupTypeEnv (md_types details) name\n              = case lookupTypeEnv type_env (getName sig_thing) of\n                  Just thing -> checkHsigDeclM iface sig_thing thing\n                  Nothing -> panic \"mergeSignatures: check_export\"\n              -- Oops! We're looking for this export but it's\n              -- not actually in the type environment of the signature's\n              -- ModDetails.\n              --\n              -- NB: This case happens because the we're iterating\n              -- over the union of all exports, so some interfaces\n              -- won't have everything.  Note that md_exports is nonsense\n              -- (it's the same as exports); maybe we should fix this\n              -- eventually.\n              | otherwise\n              = return ()\n        mapM_ check_export (map availName exports)\n\n        -- Note [Signature merging instances]\n        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        -- Merge instances into the global environment.  The algorithm here is\n        -- dumb and simple: if an instance has exactly the same DFun type\n        -- (tested by 'memberInstEnv') as an existing instance, we drop it;\n        -- otherwise, we add it even, even if this would cause overlap.\n        --\n        -- Why don't we deduplicate instances with identical heads?  There's no\n        -- good choice if they have premises:\n        --\n        --      instance K1 a => K (T a)\n        --      instance K2 a => K (T a)\n        --\n        -- Why not eagerly error in this case?  The overlapping head does not\n        -- necessarily mean that the instances are unimplementable: in fact,\n        -- they may be implemented without overlap (if, for example, the\n        -- implementing module has 'instance K (T a)'; both are implemented in\n        -- this case.)  The implements test just checks that the wanteds are\n        -- derivable assuming the givens.\n        --\n        -- Still, overlapping instances with hypotheses like above are going\n        -- to be a bad deal, because instance resolution when we're typechecking\n        -- against the merged signature is going to have a bad time when\n        -- there are overlapping heads like this: we never backtrack, so it\n        -- may be difficult to see that a wanted is derivable.  For now,\n        -- we hope that we get lucky / the overlapping instances never\n        -- get used, but it is not a very good situation to be in.\n        --\n        let merge_inst (insts, inst_env) inst\n                | memberInstEnv inst_env inst -- test DFun Type equality\n                = (insts, inst_env)\n                | otherwise\n                -- NB: is_dfun_name inst is still nonsense here,\n                -- see Note [Signature merging DFuns]\n                = (inst:insts, extendInstEnv inst_env inst)\n            (insts, inst_env) = foldl' merge_inst\n                                    (tcg_insts tcg_env, tcg_inst_env tcg_env)\n                                    (md_insts details)\n            -- This is a HACK to prevent calculateAvails from including imp_mod\n            -- in the listing.  We don't want it because a module is NOT\n            -- supposed to include itself in its dep_orphs/dep_finsts.  See #13214\n            iface' = iface { mi_orphan = False, mi_finsts = False }\n            avails = plusImportAvails (tcg_imports tcg_env) $\n                        calculateAvails dflags iface' False False ImportedBySystem\n        return tcg_env {\n            tcg_inst_env = inst_env,\n            tcg_insts    = insts,\n            tcg_imports  = avails,\n            tcg_merged   =\n                if outer_mod == mi_module iface\n                    -- Don't add ourselves!\n                    then tcg_merged tcg_env\n                    else (mi_module iface, mi_mod_hash iface) : tcg_merged tcg_env\n            }\n\n    -- Note [Signature merging DFuns]\n    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    -- Once we know all of instances which will be defined by this merged\n    -- signature, we go through each of the DFuns and rename them with a fresh,\n    -- new, unique DFun Name, and add these DFuns to tcg_type_env (thus fixing\n    -- up the \"bogus\" names that were setup in 'typecheckIfacesForMerging'.\n    --\n    -- We can't do this fixup earlier, because we need a way to identify each\n    -- source DFun (from each of the signatures we are merging in) so that\n    -- when we have a ClsInst, we can pull up the correct DFun to check if\n    -- the types match.\n    --\n    -- See also Note [rnIfaceNeverExported] in RnModIface\n    dfun_insts <- forM (tcg_insts tcg_env) $ \\inst -> do\n        n <- newDFunName (is_cls inst) (is_tys inst) (nameSrcSpan (is_dfun_name inst))\n        let dfun = setVarName (is_dfun inst) n\n        return (dfun, inst { is_dfun_name = n, is_dfun = dfun })\n    tcg_env <- return tcg_env {\n            tcg_insts = map snd dfun_insts,\n            tcg_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) (map fst dfun_insts)\n        }\n\n    addDependentFiles src_files\n\n    return tcg_env\n\n-- | Top-level driver for signature instantiation (run when compiling\n-- an @hsig@ file.)\ntcRnInstantiateSignature ::\n    HscEnv -> Module -> RealSrcSpan ->\n    IO (Messages, Maybe TcGblEnv)\ntcRnInstantiateSignature hsc_env this_mod real_loc =\n   withTiming (pure dflags)\n              (text \"Signature instantiation\"<+>brackets (ppr this_mod))\n              (const ()) $\n   initTc hsc_env HsigFile False this_mod real_loc $ instantiateSignature\n  where\n   dflags = hsc_dflags hsc_env\n\nexportOccs :: [AvailInfo] -> [OccName]\nexportOccs = concatMap (map occName . availNames)\n\nimpl_msg :: Module -> IndefModule -> SDoc\nimpl_msg impl_mod (IndefModule req_uid req_mod_name) =\n  text \"while checking that\" <+> ppr impl_mod <+>\n  text \"implements signature\" <+> ppr req_mod_name <+>\n  text \"in\" <+> ppr req_uid\n\n-- | Check if module implements a signature.  (The signature is\n-- always un-hashed, which is why its components are specified\n-- explicitly.)\ncheckImplements :: Module -> IndefModule -> TcRn TcGblEnv\ncheckImplements impl_mod req_mod@(IndefModule uid mod_name) =\n  addErrCtxt (impl_msg impl_mod req_mod) $ do\n    let insts = indefUnitIdInsts uid\n\n    -- STEP 1: Load the implementing interface, and make a RdrEnv\n    -- for its exports.  Also, add its 'ImportAvails' to 'tcg_imports',\n    -- so that we treat all orphan instances it provides as visible\n    -- when we verify that all instances are checked (see #12945), and so that\n    -- when we eventually write out the interface we record appropriate\n    -- dependency information.\n    impl_iface <- initIfaceTcRn $\n        loadSysInterface (text \"checkImplements 1\") impl_mod\n    let impl_gr = mkGlobalRdrEnv\n                    (gresFromAvails Nothing (mi_exports impl_iface))\n        nsubst = mkNameShape (moduleName impl_mod) (mi_exports impl_iface)\n\n    -- Load all the orphans, so the subsequent 'checkHsigIface' sees\n    -- all the instances it needs to\n    loadModuleInterfaces (text \"Loading orphan modules (from implementor of hsig)\")\n                         (dep_orphs (mi_deps impl_iface))\n\n    dflags <- getDynFlags\n    let avails = calculateAvails dflags\n                    impl_iface False{- safe -} False{- boot -} ImportedBySystem\n        fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)\n                            | (occ, f) <- mi_fixities impl_iface\n                            , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ]\n    updGblEnv (\\tcg_env -> tcg_env {\n        -- Setting tcg_rdr_env to treat all exported entities from\n        -- the implementing module as in scope improves error messages,\n        -- as it reduces the amount of qualification we need.  Unfortunately,\n        -- we still end up qualifying references to external modules\n        -- (see bkpfail07 for an example); we'd need to record more\n        -- information in ModIface to solve this.\n        tcg_rdr_env = tcg_rdr_env tcg_env `plusGlobalRdrEnv` impl_gr,\n        tcg_imports = tcg_imports tcg_env `plusImportAvails` avails,\n        -- This is here so that when we call 'lookupFixityRn' for something\n        -- directly implemented by the module, we grab the right thing\n        tcg_fix_env = fix_env\n        }) $ do\n\n    -- STEP 2: Load the *unrenamed, uninstantiated* interface for\n    -- the ORIGINAL signature.  We are going to eventually rename it,\n    -- but we must proceed slowly, because it is NOT known if the\n    -- instantiation is correct.\n    let sig_mod = mkModule (IndefiniteUnitId uid) mod_name\n        isig_mod = fst (splitModuleInsts sig_mod)\n    mb_isig_iface <- findAndReadIface (text \"checkImplements 2\") isig_mod sig_mod False\n    isig_iface <- case mb_isig_iface of\n        Succeeded (iface, _) -> return iface\n        Failed err -> failWithTc $\n            hang (text \"Could not find hi interface for signature\" <+>\n                  quotes (ppr isig_mod) <> colon) 4 err\n\n    -- STEP 3: Check that the implementing interface exports everything\n    -- we need.  (Notice we IGNORE the Modules in the AvailInfos.)\n    forM_ (exportOccs (mi_exports isig_iface)) $ \\occ ->\n        case lookupGlobalRdrEnv impl_gr occ of\n            [] -> addErr $ quotes (ppr occ)\n                    <+> text \"is exported by the hsig file, but not\"\n                    <+> text \"exported by the implementing module\"\n                    <+> quotes (ppr impl_mod)\n            _ -> return ()\n    failIfErrsM\n\n    -- STEP 4: Now that the export is complete, rename the interface...\n    sig_iface <- tcRnModIface insts (Just nsubst) isig_iface\n\n    -- STEP 5: ...and typecheck it.  (Note that in both cases, the nsubst\n    -- lets us determine how top-level identifiers should be handled.)\n    sig_details <- initIfaceTcRn $ typecheckIfaceForInstantiate nsubst sig_iface\n\n    -- STEP 6: Check that it's sufficient\n    tcg_env <- getGblEnv\n    checkHsigIface tcg_env impl_gr sig_iface sig_details\n\n    -- STEP 7: Return the updated 'TcGblEnv' with the signature exports,\n    -- so we write them out.\n    return tcg_env {\n        tcg_exports = mi_exports sig_iface\n        }\n\n-- | Given 'tcg_mod', instantiate a 'ModIface' from the indefinite\n-- library to use the actual implementations of the relevant entities,\n-- checking that the implementation matches the signature.\ninstantiateSignature :: TcRn TcGblEnv\ninstantiateSignature = do\n    tcg_env <- getGblEnv\n    dflags <- getDynFlags\n    let outer_mod = tcg_mod tcg_env\n        inner_mod = tcg_semantic_mod tcg_env\n    -- TODO: setup the local RdrEnv so the error messages look a little better.\n    -- But this information isn't stored anywhere. Should we RETYPECHECK\n    -- the local one just to get the information?  Hmm...\n    MASSERT( moduleUnitId outer_mod == thisPackage dflags )\n    inner_mod `checkImplements`\n        IndefModule\n            (newIndefUnitId (thisComponentId dflags)\n                            (thisUnitIdInsts dflags))\n            (moduleName outer_mod)\n", "num_lines": 1001}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[TcBinds]{TcBinds}\n-}\n\n{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcBinds ( tcLocalBinds, tcTopBinds, tcValBinds,\n                 tcHsBootSigs, tcPolyCheck,\n                 addTypecheckedBinds,\n                 chooseInferredQuantifiers,\n                 badBootDeclErr ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )\nimport {-# SOURCE #-} TcExpr  ( tcMonoExpr )\nimport {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynBuilderBind )\nimport CoreSyn (Tickish (..))\nimport CostCentre (mkUserCC, CCFlavour(DeclCC))\nimport DynFlags\nimport FastString\nimport HsSyn\nimport HscTypes( isHsBootOrSig )\nimport TcSigs\nimport TcRnMonad\nimport TcEnv\nimport TcUnify\nimport TcSimplify\nimport TcEvidence\nimport TcHsType\nimport TcPat\nimport TcMType\nimport FamInstEnv( normaliseType )\nimport FamInst( tcGetFamInstEnvs )\nimport TyCon\nimport TcType\nimport Type( mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy)\nimport TysPrim\nimport TysWiredIn( mkBoxedTupleTy )\nimport Id\nimport Var\nimport VarSet\nimport VarEnv( TidyEnv )\nimport Module\nimport Name\nimport NameSet\nimport NameEnv\nimport SrcLoc\nimport Bag\nimport ErrUtils\nimport Digraph\nimport Maybes\nimport Util\nimport BasicTypes\nimport Outputable\nimport PrelNames( ipClassName )\nimport TcValidity (checkValidType)\nimport UniqFM\nimport UniqSet\nimport qualified GHC.LanguageExtensions as LangExt\nimport ConLike\n\nimport Control.Monad\n\n#include \"HsVersions.h\"\n\n{- *********************************************************************\n*                                                                      *\n               A useful helper function\n*                                                                      *\n********************************************************************* -}\n\naddTypecheckedBinds :: TcGblEnv -> [LHsBinds GhcTc] -> TcGblEnv\naddTypecheckedBinds tcg_env binds\n  | isHsBootOrSig (tcg_src tcg_env) = tcg_env\n    -- Do not add the code for record-selector bindings\n    -- when compiling hs-boot files\n  | otherwise = tcg_env { tcg_binds = foldr unionBags\n                                            (tcg_binds tcg_env)\n                                            binds }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Type-checking bindings}\n*                                                                      *\n************************************************************************\n\n@tcBindsAndThen@ typechecks a @HsBinds@.  The \"and then\" part is because\nit needs to know something about the {\\em usage} of the things bound,\nso that it can create specialisations of them.  So @tcBindsAndThen@\ntakes a function which, given an extended environment, E, typechecks\nthe scope of the bindings returning a typechecked thing and (most\nimportant) an LIE.  It is this LIE which is then used as the basis for\nspecialising the things bound.\n\n@tcBindsAndThen@ also takes a \"combiner\" which glues together the\nbindings and the \"thing\" to make a new \"thing\".\n\nThe real work is done by @tcBindWithSigsAndThen@.\n\nRecursive and non-recursive binds are handled in essentially the same\nway: because of uniques there are no scoping issues left.  The only\ndifference is that non-recursive bindings can bind primitive values.\n\nEven for non-recursive binding groups we add typings for each binder\nto the LVE for the following reason.  When each individual binding is\nchecked the type of its LHS is unified with that of its RHS; and\ntype-checking the LHS of course requires that the binder is in scope.\n\nAt the top-level the LIE is sure to contain nothing but constant\ndictionaries, which we resolve at the module level.\n\nNote [Polymorphic recursion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe game plan for polymorphic recursion in the code above is\n\n        * Bind any variable for which we have a type signature\n          to an Id with a polymorphic type.  Then when type-checking\n          the RHSs we'll make a full polymorphic call.\n\nThis fine, but if you aren't a bit careful you end up with a horrendous\namount of partial application and (worse) a huge space leak. For example:\n\n        f :: Eq a => [a] -> [a]\n        f xs = ...f...\n\nIf we don't take care, after typechecking we get\n\n        f = /\\a -> \\d::Eq a -> let f' = f a d\n                               in\n                               \\ys:[a] -> ...f'...\n\nNotice the stupid construction of (f a d), which is of course\nidentical to the function we're executing.  In this case, the\npolymorphic recursion isn't being used (but that's a very common case).\nThis can lead to a massive space leak, from the following top-level defn\n(post-typechecking)\n\n        ff :: [Int] -> [Int]\n        ff = f Int dEqInt\n\nNow (f dEqInt) evaluates to a lambda that has f' as a free variable; but\nf' is another thunk which evaluates to the same thing... and you end\nup with a chain of identical values all hung onto by the CAF ff.\n\n        ff = f Int dEqInt\n\n           = let f' = f Int dEqInt in \\ys. ...f'...\n\n           = let f' = let f' = f Int dEqInt in \\ys. ...f'...\n                      in \\ys. ...f'...\n\nEtc.\n\nNOTE: a bit of arity anaysis would push the (f a d) inside the (\\ys...),\nwhich would make the space leak go away in this case\n\nSolution: when typechecking the RHSs we always have in hand the\n*monomorphic* Ids for each binding.  So we just need to make sure that\nif (Method f a d) shows up in the constraints emerging from (...f...)\nwe just use the monomorphic Id.  We achieve this by adding monomorphic Ids\nto the \"givens\" when simplifying constraints.  That's what the \"lies_avail\"\nis doing.\n\nThen we get\n\n        f = /\\a -> \\d::Eq a -> letrec\n                                 fm = \\ys:[a] -> ...fm...\n                               in\n                               fm\n-}\n\ntcTopBinds :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn]\n           -> TcM (TcGblEnv, TcLclEnv)\n-- The TcGblEnv contains the new tcg_binds and tcg_spects\n-- The TcLclEnv has an extended type envt for the new bindings\ntcTopBinds binds sigs\n  = do  { -- Pattern synonym bindings populate the global environment\n          (binds', (tcg_env, tcl_env)) <- tcValBinds TopLevel binds sigs $\n            do { gbl <- getGblEnv\n               ; lcl <- getLclEnv\n               ; return (gbl, lcl) }\n        ; specs <- tcImpPrags sigs   -- SPECIALISE prags for imported Ids\n\n        ; complete_matches <- setEnvs (tcg_env, tcl_env) $ tcCompleteSigs sigs\n        ; traceTc \"complete_matches\" (ppr binds $$ ppr sigs)\n        ; traceTc \"complete_matches\" (ppr complete_matches)\n\n        ; let { tcg_env' = tcg_env { tcg_imp_specs\n                                      = specs ++ tcg_imp_specs tcg_env\n                                   , tcg_complete_matches\n                                      = complete_matches\n                                          ++ tcg_complete_matches tcg_env }\n                           `addTypecheckedBinds` map snd binds' }\n\n        ; return (tcg_env', tcl_env) }\n        -- The top level bindings are flattened into a giant\n        -- implicitly-mutually-recursive LHsBinds\n\n\n-- Note [Typechecking Complete Matches]\n-- Much like when a user bundled a pattern synonym, the result types of\n-- all the constructors in the match pragma must be consistent.\n--\n-- If we allowed pragmas with inconsistent types then it would be\n-- impossible to ever match every constructor in the list and so\n-- the pragma would be useless.\n\n\n\n\n\n-- This is only used in `tcCompleteSig`. We fold over all the conlikes,\n-- this accumulator keeps track of the first `ConLike` with a concrete\n-- return type. After fixing the return type, all other constructors with\n-- a fixed return type must agree with this.\n--\n-- The fields of `Fixed` cache the first conlike and its return type so\n-- that that we can compare all the other conlikes to it. The conlike is\n-- stored for error messages.\n--\n-- `Nothing` in the case that the type is fixed by a type signature\ndata CompleteSigType = AcceptAny | Fixed (Maybe ConLike) TyCon\n\ntcCompleteSigs  :: [LSig GhcRn] -> TcM [CompleteMatch]\ntcCompleteSigs sigs =\n  let\n      doOne :: Sig GhcRn -> TcM (Maybe CompleteMatch)\n      doOne c@(CompleteMatchSig _ _ lns mtc)\n        = fmap Just $ do\n           addErrCtxt (text \"In\" <+> ppr c) $\n            case mtc of\n              Nothing -> infer_complete_match\n              Just tc -> check_complete_match tc\n        where\n\n          checkCLTypes acc = foldM checkCLType (acc, []) (unLoc lns)\n\n          infer_complete_match = do\n            (res, cls) <- checkCLTypes AcceptAny\n            case res of\n              AcceptAny -> failWithTc ambiguousError\n              Fixed _ tc  -> return $ mkMatch cls tc\n\n          check_complete_match tc_name = do\n            ty_con <- tcLookupLocatedTyCon tc_name\n            (_, cls) <- checkCLTypes (Fixed Nothing ty_con)\n            return $ mkMatch cls ty_con\n\n          mkMatch :: [ConLike] -> TyCon -> CompleteMatch\n          mkMatch cls ty_con = CompleteMatch {\n            completeMatchConLikes = map conLikeName cls,\n            completeMatchTyCon = tyConName ty_con\n            }\n      doOne _ = return Nothing\n\n      ambiguousError :: SDoc\n      ambiguousError =\n        text \"A type signature must be provided for a set of polymorphic\"\n          <+> text \"pattern synonyms.\"\n\n\n      -- See note [Typechecking Complete Matches]\n      checkCLType :: (CompleteSigType, [ConLike]) -> Located Name\n                  -> TcM (CompleteSigType, [ConLike])\n      checkCLType (cst, cs) n = do\n        cl <- addLocM tcLookupConLike n\n        let   (_,_,_,_,_,_, res_ty) = conLikeFullSig cl\n              res_ty_con = fst <$> splitTyConApp_maybe res_ty\n        case (cst, res_ty_con) of\n          (AcceptAny, Nothing) -> return (AcceptAny, cl:cs)\n          (AcceptAny, Just tc) -> return (Fixed (Just cl) tc, cl:cs)\n          (Fixed mfcl tc, Nothing)  -> return (Fixed mfcl tc, cl:cs)\n          (Fixed mfcl tc, Just tc') ->\n            if tc == tc'\n              then return (Fixed mfcl tc, cl:cs)\n              else case mfcl of\n                     Nothing ->\n                      addErrCtxt (text \"In\" <+> ppr cl) $\n                        failWithTc typeSigErrMsg\n                     Just cl -> failWithTc (errMsg cl)\n             where\n              typeSigErrMsg :: SDoc\n              typeSigErrMsg =\n                text \"Couldn't match expected type\"\n                      <+> quotes (ppr tc)\n                      <+> text \"with\"\n                      <+> quotes (ppr tc')\n\n              errMsg :: ConLike -> SDoc\n              errMsg fcl =\n                text \"Cannot form a group of complete patterns from patterns\"\n                  <+> quotes (ppr fcl) <+> text \"and\" <+> quotes (ppr cl)\n                  <+> text \"as they match different type constructors\"\n                  <+> parens (quotes (ppr tc)\n                               <+> text \"resp.\"\n                               <+> quotes (ppr tc'))\n  in  mapMaybeM (addLocM doOne) sigs\n\ntcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id]\n-- A hs-boot file has only one BindGroup, and it only has type\n-- signatures in it.  The renamer checked all this\ntcHsBootSigs binds sigs\n  = do  { checkTc (null binds) badBootDeclErr\n        ; concat <$> mapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }\n  where\n    tc_boot_sig (TypeSig _ lnames hs_ty) = mapM f lnames\n      where\n        f (dL->L _ name)\n          = do { sigma_ty <- tcHsSigWcType (FunSigCtxt name False) hs_ty\n               ; return (mkVanillaGlobal name sigma_ty) }\n        -- Notice that we make GlobalIds, not LocalIds\n    tc_boot_sig s = pprPanic \"tcHsBootSigs/tc_boot_sig\" (ppr s)\n\nbadBootDeclErr :: MsgDoc\nbadBootDeclErr = text \"Illegal declarations in an hs-boot file\"\n\n------------------------\ntcLocalBinds :: HsLocalBinds GhcRn -> TcM thing\n             -> TcM (HsLocalBinds GhcTcId, thing)\n\ntcLocalBinds (EmptyLocalBinds x) thing_inside\n  = do  { thing <- thing_inside\n        ; return (EmptyLocalBinds x, thing) }\n\ntcLocalBinds (HsValBinds x (XValBindsLR (NValBinds binds sigs))) thing_inside\n  = do  { (binds', thing) <- tcValBinds NotTopLevel binds sigs thing_inside\n        ; return (HsValBinds x (XValBindsLR (NValBinds binds' sigs)), thing) }\ntcLocalBinds (HsValBinds _ (ValBinds {})) _ = panic \"tcLocalBinds\"\n\ntcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside\n  = do  { ipClass <- tcLookupClass ipClassName\n        ; (given_ips, ip_binds') <-\n            mapAndUnzipM (wrapLocSndM (tc_ip_bind ipClass)) ip_binds\n\n        -- If the binding binds ?x = E, we  must now\n        -- discharge any ?x constraints in expr_lie\n        -- See Note [Implicit parameter untouchables]\n        ; (ev_binds, result) <- checkConstraints (IPSkol ips)\n                                  [] given_ips thing_inside\n\n        ; return (HsIPBinds x (IPBinds ev_binds ip_binds') , result) }\n  where\n    ips = [ip | (dL->L _ (IPBind _ (Left (dL->L _ ip)) _)) <- ip_binds]\n\n        -- I wonder if we should do these one at at time\n        -- Consider     ?x = 4\n        --              ?y = ?x + 1\n    tc_ip_bind ipClass (IPBind _ (Left (dL->L _ ip)) expr)\n       = do { ty <- newOpenFlexiTyVarTy\n            ; let p = mkStrLitTy $ hsIPNameFS ip\n            ; ip_id <- newDict ipClass [ p, ty ]\n            ; expr' <- tcMonoExpr expr (mkCheckExpType ty)\n            ; let d = toDict ipClass p ty `fmap` expr'\n            ; return (ip_id, (IPBind noExt (Right ip_id) d)) }\n    tc_ip_bind _ (IPBind _ (Right {}) _) = panic \"tc_ip_bind\"\n    tc_ip_bind _ (XIPBind _) = panic \"tc_ip_bind\"\n\n    -- Coerces a `t` into a dictionry for `IP \"x\" t`.\n    -- co : t -> IP \"x\" t\n    toDict ipClass x ty = mkHsWrap $ mkWpCastR $\n                          wrapIP $ mkClassPred ipClass [x,ty]\n\ntcLocalBinds (HsIPBinds _ (XHsIPBinds _ )) _ = panic \"tcLocalBinds\"\ntcLocalBinds (XHsLocalBindsLR _)           _ = panic \"tcLocalBinds\"\n\n{- Note [Implicit parameter untouchables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe add the type variables in the types of the implicit parameters\nas untouchables, not so much because we really must not unify them,\nbut rather because we otherwise end up with constraints like this\n    Num alpha, Implic { wanted = alpha ~ Int }\nThe constraint solver solves alpha~Int by unification, but then\ndoesn't float that solved constraint out (it's not an unsolved\nwanted).  Result disaster: the (Num alpha) is again solved, this\ntime by defaulting.  No no no.\n\nHowever [Oct 10] this is all handled automatically by the\nuntouchable-range idea.\n-}\n\ntcValBinds :: TopLevelFlag\n           -> [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn]\n           -> TcM thing\n           -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)\n\ntcValBinds top_lvl binds sigs thing_inside\n  = do  { let patsyns = getPatSynBinds binds\n\n            -- Typecheck the signature\n        ; (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $\n                                tcTySigs sigs\n\n        ; let prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds)\n\n                -- Extend the envt right away with all the Ids\n                -- declared with complete type signatures\n                -- Do not extend the TcBinderStack; instead\n                -- we extend it on a per-rhs basis in tcExtendForRhs\n        ; tcExtendSigIds top_lvl poly_ids $ do\n            { (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do\n                   { thing <- thing_inside\n                     -- See Note [Pattern synonym builders don't yield dependencies]\n                     --     in RnBinds\n                   ; patsyn_builders <- mapM tcPatSynBuilderBind patsyns\n                   ; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ]\n                   ; return (extra_binds, thing) }\n            ; return (binds' ++ extra_binds', thing) }}\n\n------------------------\ntcBindGroups :: TopLevelFlag -> TcSigFun -> TcPragEnv\n             -> [(RecFlag, LHsBinds GhcRn)] -> TcM thing\n             -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)\n-- Typecheck a whole lot of value bindings,\n-- one strongly-connected component at a time\n-- Here a \"strongly connected component\" has the strightforward\n-- meaning of a group of bindings that mention each other,\n-- ignoring type signatures (that part comes later)\n\ntcBindGroups _ _ _ [] thing_inside\n  = do  { thing <- thing_inside\n        ; return ([], thing) }\n\ntcBindGroups top_lvl sig_fn prag_fn (group : groups) thing_inside\n  = do  { -- See Note [Closed binder groups]\n          type_env <- getLclTypeEnv\n        ; let closed = isClosedBndrGroup type_env (snd group)\n        ; (group', (groups', thing))\n                <- tc_group top_lvl sig_fn prag_fn group closed $\n                   tcBindGroups top_lvl sig_fn prag_fn groups thing_inside\n        ; return (group' ++ groups', thing) }\n\n-- Note [Closed binder groups]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n--  A mutually recursive group is \"closed\" if all of the free variables of\n--  the bindings are closed. For example\n--\n-- >  h = \\x -> let f = ...g...\n-- >                g = ....f...x...\n-- >             in ...\n--\n-- Here @g@ is not closed because it mentions @x@; and hence neither is @f@\n-- closed.\n--\n-- So we need to compute closed-ness on each strongly connected components,\n-- before we sub-divide it based on what type signatures it has.\n--\n\n------------------------\ntc_group :: forall thing.\n            TopLevelFlag -> TcSigFun -> TcPragEnv\n         -> (RecFlag, LHsBinds GhcRn) -> IsGroupClosed -> TcM thing\n         -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)\n\n-- Typecheck one strongly-connected component of the original program.\n-- We get a list of groups back, because there may\n-- be specialisations etc as well\n\ntc_group top_lvl sig_fn prag_fn (NonRecursive, binds) closed thing_inside\n        -- A single non-recursive binding\n        -- We want to keep non-recursive things non-recursive\n        -- so that we desugar unlifted bindings correctly\n  = do { let bind = case bagToList binds of\n                 [bind] -> bind\n                 []     -> panic \"tc_group: empty list of binds\"\n                 _      -> panic \"tc_group: NonRecursive binds is not a singleton bag\"\n       ; (bind', thing) <- tc_single top_lvl sig_fn prag_fn bind closed\n                                     thing_inside\n       ; return ( [(NonRecursive, bind')], thing) }\n\ntc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside\n  =     -- To maximise polymorphism, we do a new\n        -- strongly-connected-component analysis, this time omitting\n        -- any references to variables with type signatures.\n        -- (This used to be optional, but isn't now.)\n        -- See Note [Polymorphic recursion] in HsBinds.\n    do  { traceTc \"tc_group rec\" (pprLHsBinds binds)\n        ; when hasPatSyn $ recursivePatSynErr binds\n        ; (binds1, thing) <- go sccs\n        ; return ([(Recursive, binds1)], thing) }\n                -- Rec them all together\n  where\n    hasPatSyn = anyBag (isPatSyn . unLoc) binds\n    isPatSyn PatSynBind{} = True\n    isPatSyn _ = False\n\n    sccs :: [SCC (LHsBind GhcRn)]\n    sccs = stronglyConnCompFromEdgedVerticesUniq (mkEdges sig_fn binds)\n\n    go :: [SCC (LHsBind GhcRn)] -> TcM (LHsBinds GhcTcId, thing)\n    go (scc:sccs) = do  { (binds1, ids1) <- tc_scc scc\n                        ; (binds2, thing) <- tcExtendLetEnv top_lvl sig_fn\n                                                            closed ids1 $\n                                             go sccs\n                        ; return (binds1 `unionBags` binds2, thing) }\n    go []         = do  { thing <- thing_inside; return (emptyBag, thing) }\n\n    tc_scc (AcyclicSCC bind) = tc_sub_group NonRecursive [bind]\n    tc_scc (CyclicSCC binds) = tc_sub_group Recursive    binds\n\n    tc_sub_group rec_tc binds =\n      tcPolyBinds sig_fn prag_fn Recursive rec_tc closed binds\n\nrecursivePatSynErr :: OutputableBndrId (GhcPass p) =>\n                      LHsBinds (GhcPass p) -> TcM a\nrecursivePatSynErr binds\n  = failWithTc $\n    hang (text \"Recursive pattern synonym definition with following bindings:\")\n       2 (vcat $ map pprLBind . bagToList $ binds)\n  where\n    pprLoc loc  = parens (text \"defined at\" <+> ppr loc)\n    pprLBind (dL->L loc bind) = pprWithCommas ppr (collectHsBindBinders bind)\n                                <+> pprLoc loc\n\ntc_single :: forall thing.\n            TopLevelFlag -> TcSigFun -> TcPragEnv\n          -> LHsBind GhcRn -> IsGroupClosed -> TcM thing\n          -> TcM (LHsBinds GhcTcId, thing)\ntc_single _top_lvl sig_fn _prag_fn\n          (dL->L _ (PatSynBind _ psb@PSB{ psb_id = (dL->L _ name) }))\n          _ thing_inside\n  = do { (aux_binds, tcg_env) <- tcPatSynDecl psb (sig_fn name)\n       ; thing <- setGblEnv tcg_env thing_inside\n       ; return (aux_binds, thing)\n       }\n\ntc_single top_lvl sig_fn prag_fn lbind closed thing_inside\n  = do { (binds1, ids) <- tcPolyBinds sig_fn prag_fn\n                                      NonRecursive NonRecursive\n                                      closed\n                                      [lbind]\n       ; thing <- tcExtendLetEnv top_lvl sig_fn closed ids thing_inside\n       ; return (binds1, thing) }\n\n------------------------\ntype BKey = Int -- Just number off the bindings\n\nmkEdges :: TcSigFun -> LHsBinds GhcRn -> [Node BKey (LHsBind GhcRn)]\n-- See Note [Polymorphic recursion] in HsBinds.\nmkEdges sig_fn binds\n  = [ DigraphNode bind key [key | n <- nonDetEltsUniqSet (bind_fvs (unLoc bind)),\n                         Just key <- [lookupNameEnv key_map n], no_sig n ]\n    | (bind, key) <- keyd_binds\n    ]\n    -- It's OK to use nonDetEltsUFM here as stronglyConnCompFromEdgedVertices\n    -- is still deterministic even if the edges are in nondeterministic order\n    -- as explained in Note [Deterministic SCC] in Digraph.\n  where\n    bind_fvs (FunBind { fun_ext = fvs }) = fvs\n    bind_fvs (PatBind { pat_ext = fvs }) = fvs\n    bind_fvs _                           = emptyNameSet\n\n    no_sig :: Name -> Bool\n    no_sig n = not (hasCompleteSig sig_fn n)\n\n    keyd_binds = bagToList binds `zip` [0::BKey ..]\n\n    key_map :: NameEnv BKey     -- Which binding it comes from\n    key_map = mkNameEnv [(bndr, key) | (dL->L _ bind, key) <- keyd_binds\n                                     , bndr <- collectHsBindBinders bind ]\n\n------------------------\ntcPolyBinds :: TcSigFun -> TcPragEnv\n            -> RecFlag         -- Whether the group is really recursive\n            -> RecFlag         -- Whether it's recursive after breaking\n                               -- dependencies based on type signatures\n            -> IsGroupClosed   -- Whether the group is closed\n            -> [LHsBind GhcRn]  -- None are PatSynBind\n            -> TcM (LHsBinds GhcTcId, [TcId])\n\n-- Typechecks a single bunch of values bindings all together,\n-- and generalises them.  The bunch may be only part of a recursive\n-- group, because we use type signatures to maximise polymorphism\n--\n-- Returns a list because the input may be a single non-recursive binding,\n-- in which case the dependency order of the resulting bindings is\n-- important.\n--\n-- Knows nothing about the scope of the bindings\n-- None of the bindings are pattern synonyms\n\ntcPolyBinds sig_fn prag_fn rec_group rec_tc closed bind_list\n  = setSrcSpan loc                              $\n    recoverM (recoveryCode binder_names sig_fn) $ do\n        -- Set up main recover; take advantage of any type sigs\n\n    { traceTc \"------------------------------------------------\" Outputable.empty\n    ; traceTc \"Bindings for {\" (ppr binder_names)\n    ; dflags   <- getDynFlags\n    ; let plan = decideGeneralisationPlan dflags bind_list closed sig_fn\n    ; traceTc \"Generalisation plan\" (ppr plan)\n    ; result@(_, poly_ids) <- case plan of\n         NoGen              -> tcPolyNoGen rec_tc prag_fn sig_fn bind_list\n         InferGen mn        -> tcPolyInfer rec_tc prag_fn sig_fn mn bind_list\n         CheckGen lbind sig -> tcPolyCheck prag_fn sig lbind\n\n    ; traceTc \"} End of bindings for\" (vcat [ ppr binder_names, ppr rec_group\n                                            , vcat [ppr id <+> ppr (idType id) | id <- poly_ids]\n                                          ])\n\n    ; return result }\n  where\n    binder_names = collectHsBindListBinders bind_list\n    loc = foldr1 combineSrcSpans (map getLoc bind_list)\n         -- The mbinds have been dependency analysed and\n         -- may no longer be adjacent; so find the narrowest\n         -- span that includes them all\n\n--------------\n-- If typechecking the binds fails, then return with each\n-- signature-less binder given type (forall a.a), to minimise\n-- subsequent error messages\nrecoveryCode :: [Name] -> TcSigFun -> TcM (LHsBinds GhcTcId, [Id])\nrecoveryCode binder_names sig_fn\n  = do  { traceTc \"tcBindsWithSigs: error recovery\" (ppr binder_names)\n        ; let poly_ids = map mk_dummy binder_names\n        ; return (emptyBag, poly_ids) }\n  where\n    mk_dummy name\n      | Just sig <- sig_fn name\n      , Just poly_id <- completeSigPolyId_maybe sig\n      = poly_id\n      | otherwise\n      = mkLocalId name forall_a_a\n\nforall_a_a :: TcType\n-- At one point I had (forall r (a :: TYPE r). a), but of course\n-- that type is ill-formed: its mentions 'r' which escapes r's scope.\n-- Another alternative would be (forall (a :: TYPE kappa). a), where\n-- kappa is a unification variable. But I don't think we need that\n-- complication here. I'm going to just use (forall (a::*). a).\n-- See Trac #15276\nforall_a_a = mkSpecForAllTys [alphaTyVar] alphaTy\n\n{- *********************************************************************\n*                                                                      *\n                         tcPolyNoGen\n*                                                                      *\n********************************************************************* -}\n\ntcPolyNoGen     -- No generalisation whatsoever\n  :: RecFlag       -- Whether it's recursive after breaking\n                   -- dependencies based on type signatures\n  -> TcPragEnv -> TcSigFun\n  -> [LHsBind GhcRn]\n  -> TcM (LHsBinds GhcTcId, [TcId])\n\ntcPolyNoGen rec_tc prag_fn tc_sig_fn bind_list\n  = do { (binds', mono_infos) <- tcMonoBinds rec_tc tc_sig_fn\n                                             (LetGblBndr prag_fn)\n                                             bind_list\n       ; mono_ids' <- mapM tc_mono_info mono_infos\n       ; return (binds', mono_ids') }\n  where\n    tc_mono_info (MBI { mbi_poly_name = name, mbi_mono_id = mono_id })\n      = do { _specs <- tcSpecPrags mono_id (lookupPragEnv prag_fn name)\n           ; return mono_id }\n           -- NB: tcPrags generates error messages for\n           --     specialisation pragmas for non-overloaded sigs\n           -- Indeed that is why we call it here!\n           -- So we can safely ignore _specs\n\n\n{- *********************************************************************\n*                                                                      *\n                         tcPolyCheck\n*                                                                      *\n********************************************************************* -}\n\ntcPolyCheck :: TcPragEnv\n            -> TcIdSigInfo     -- Must be a complete signature\n            -> LHsBind GhcRn   -- Must be a FunBind\n            -> TcM (LHsBinds GhcTcId, [TcId])\n-- There is just one binding,\n--   it is a Funbind\n--   it has a complete type signature,\ntcPolyCheck prag_fn\n            (CompleteSig { sig_bndr  = poly_id\n                         , sig_ctxt  = ctxt\n                         , sig_loc   = sig_loc })\n            (dL->L loc (FunBind { fun_id = (dL->L nm_loc name)\n                                , fun_matches = matches }))\n  = setSrcSpan sig_loc $\n    do { traceTc \"tcPolyCheck\" (ppr poly_id $$ ppr sig_loc)\n       ; (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id\n                -- See Note [Instantiate sig with fresh variables]\n\n       ; mono_name <- newNameAt (nameOccName name) nm_loc\n       ; ev_vars   <- newEvVars theta\n       ; let mono_id   = mkLocalId mono_name tau\n             skol_info = SigSkol ctxt (idType poly_id) tv_prs\n             skol_tvs  = map snd tv_prs\n\n       ; (ev_binds, (co_fn, matches'))\n            <- checkConstraints skol_info skol_tvs ev_vars $\n               tcExtendBinderStack [TcIdBndr mono_id NotTopLevel]  $\n               tcExtendNameTyVarEnv tv_prs $\n               setSrcSpan loc           $\n               tcMatchesFun (cL nm_loc mono_name) matches (mkCheckExpType tau)\n\n       ; let prag_sigs = lookupPragEnv prag_fn name\n       ; spec_prags <- tcSpecPrags poly_id prag_sigs\n       ; poly_id    <- addInlinePrags poly_id prag_sigs\n\n       ; mod <- getModule\n       ; tick <- funBindTicks nm_loc mono_id mod prag_sigs\n       ; let bind' = FunBind { fun_id      = cL nm_loc mono_id\n                             , fun_matches = matches'\n                             , fun_co_fn   = co_fn\n                             , fun_ext     = placeHolderNamesTc\n                             , fun_tick    = tick }\n\n             export = ABE { abe_ext = noExt\n                          , abe_wrap = idHsWrapper\n                          , abe_poly  = poly_id\n                          , abe_mono  = mono_id\n                          , abe_prags = SpecPrags spec_prags }\n\n             abs_bind = cL loc $\n                        AbsBinds { abs_ext = noExt\n                                 , abs_tvs      = skol_tvs\n                                 , abs_ev_vars  = ev_vars\n                                 , abs_ev_binds = [ev_binds]\n                                 , abs_exports  = [export]\n                                 , abs_binds    = unitBag (cL loc bind')\n                                 , abs_sig      = True }\n\n       ; return (unitBag abs_bind, [poly_id]) }\n\ntcPolyCheck _prag_fn sig bind\n  = pprPanic \"tcPolyCheck\" (ppr sig $$ ppr bind)\n\nfunBindTicks :: SrcSpan -> TcId -> Module -> [LSig GhcRn]\n             -> TcM [Tickish TcId]\nfunBindTicks loc fun_id mod sigs\n  | (mb_cc_str : _) <- [ cc_name | (dL->L _ (SCCFunSig _ _ _ cc_name)) <- sigs ]\n      -- this can only be a singleton list, as duplicate pragmas are rejected\n      -- by the renamer\n  , let cc_str\n          | Just cc_str <- mb_cc_str\n          = sl_fs $ unLoc cc_str\n          | otherwise\n          = getOccFS (Var.varName fun_id)\n        cc_name = moduleNameFS (moduleName mod) `appendFS` consFS '.' cc_str\n  = do\n      flavour <- DeclCC <$> getCCIndexM cc_name\n      let cc = mkUserCC cc_name mod loc flavour\n      return [ProfNote cc True True]\n  | otherwise\n  = return []\n\n{- Note [Instantiate sig with fresh variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's vital to instantiate a type signature with fresh variables.\nFor example:\n      type T = forall a. [a] -> [a]\n      f :: T;\n      f = g where { g :: T; g = <rhs> }\n\n We must not use the same 'a' from the defn of T at both places!!\n(Instantiation is only necessary because of type synonyms.  Otherwise,\nit's all cool; each signature has distinct type variables from the renamer.)\n-}\n\n\n{- *********************************************************************\n*                                                                      *\n                         tcPolyInfer\n*                                                                      *\n********************************************************************* -}\n\ntcPolyInfer\n  :: RecFlag       -- Whether it's recursive after breaking\n                   -- dependencies based on type signatures\n  -> TcPragEnv -> TcSigFun\n  -> Bool         -- True <=> apply the monomorphism restriction\n  -> [LHsBind GhcRn]\n  -> TcM (LHsBinds GhcTcId, [TcId])\ntcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list\n  = do { (tclvl, wanted, (binds', mono_infos))\n             <- pushLevelAndCaptureConstraints  $\n                tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list\n\n       ; let name_taus  = [ (mbi_poly_name info, idType (mbi_mono_id info))\n                          | info <- mono_infos ]\n             sigs       = [ sig | MBI { mbi_sig = Just sig } <- mono_infos ]\n             infer_mode = if mono then ApplyMR else NoRestrictions\n\n       ; mapM_ (checkOverloadedSig mono) sigs\n\n       ; traceTc \"simplifyInfer call\" (ppr tclvl $$ ppr name_taus $$ ppr wanted)\n       ; (qtvs, givens, ev_binds, residual, insoluble)\n                 <- simplifyInfer tclvl infer_mode sigs name_taus wanted\n       ; emitConstraints residual\n\n       ; let inferred_theta = map evVarPred givens\n       ; exports <- checkNoErrs $\n                    mapM (mkExport prag_fn insoluble qtvs inferred_theta) mono_infos\n\n       ; loc <- getSrcSpanM\n       ; let poly_ids = map abe_poly exports\n             abs_bind = cL loc $\n                        AbsBinds { abs_ext = noExt\n                                 , abs_tvs = qtvs\n                                 , abs_ev_vars = givens, abs_ev_binds = [ev_binds]\n                                 , abs_exports = exports, abs_binds = binds'\n                                 , abs_sig = False }\n\n       ; traceTc \"Binding:\" (ppr (poly_ids `zip` map idType poly_ids))\n       ; return (unitBag abs_bind, poly_ids) }\n         -- poly_ids are guaranteed zonked by mkExport\n\n--------------\nmkExport :: TcPragEnv\n         -> Bool                        -- True <=> there was an insoluble type error\n                                        --          when typechecking the bindings\n         -> [TyVar] -> TcThetaType      -- Both already zonked\n         -> MonoBindInfo\n         -> TcM (ABExport GhcTc)\n-- Only called for generalisation plan InferGen, not by CheckGen or NoGen\n--\n-- mkExport generates exports with\n--      zonked type variables,\n--      zonked poly_ids\n-- The former is just because no further unifications will change\n-- the quantified type variables, so we can fix their final form\n-- right now.\n-- The latter is needed because the poly_ids are used to extend the\n-- type environment; see the invariant on TcEnv.tcExtendIdEnv\n\n-- Pre-condition: the qtvs and theta are already zonked\n\nmkExport prag_fn insoluble qtvs theta\n         mono_info@(MBI { mbi_poly_name = poly_name\n                        , mbi_sig       = mb_sig\n                        , mbi_mono_id   = mono_id })\n  = do  { mono_ty <- zonkTcType (idType mono_id)\n        ; poly_id <- mkInferredPolyId insoluble qtvs theta poly_name mb_sig mono_ty\n\n        -- NB: poly_id has a zonked type\n        ; poly_id <- addInlinePrags poly_id prag_sigs\n        ; spec_prags <- tcSpecPrags poly_id prag_sigs\n                -- tcPrags requires a zonked poly_id\n\n        -- See Note [Impedance matching]\n        -- NB: we have already done checkValidType, including an ambiguity check,\n        --     on the type; either when we checked the sig or in mkInferredPolyId\n        ; let poly_ty     = idType poly_id\n              sel_poly_ty = mkInfSigmaTy qtvs theta mono_ty\n                -- This type is just going into tcSubType,\n                -- so Inferred vs. Specified doesn't matter\n\n        ; wrap <- if sel_poly_ty `eqType` poly_ty  -- NB: eqType ignores visibility\n                  then return idHsWrapper  -- Fast path; also avoids complaint when we infer\n                                           -- an ambiguous type and have AllowAmbiguousType\n                                           -- e..g infer  x :: forall a. F a -> Int\n                  else addErrCtxtM (mk_impedance_match_msg mono_info sel_poly_ty poly_ty) $\n                       tcSubType_NC sig_ctxt sel_poly_ty poly_ty\n\n        ; warn_missing_sigs <- woptM Opt_WarnMissingLocalSignatures\n        ; when warn_missing_sigs $\n              localSigWarn Opt_WarnMissingLocalSignatures poly_id mb_sig\n\n        ; return (ABE { abe_ext = noExt\n                      , abe_wrap = wrap\n                        -- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty)\n                      , abe_poly  = poly_id\n                      , abe_mono  = mono_id\n                      , abe_prags = SpecPrags spec_prags }) }\n  where\n    prag_sigs = lookupPragEnv prag_fn poly_name\n    sig_ctxt  = InfSigCtxt poly_name\n\nmkInferredPolyId :: Bool  -- True <=> there was an insoluble error when\n                          --          checking the binding group for this Id\n                 -> [TyVar] -> TcThetaType\n                 -> Name -> Maybe TcIdSigInst -> TcType\n                 -> TcM TcId\nmkInferredPolyId insoluble qtvs inferred_theta poly_name mb_sig_inst mono_ty\n  | Just (TISI { sig_inst_sig = sig })  <- mb_sig_inst\n  , CompleteSig { sig_bndr = poly_id } <- sig\n  = return poly_id\n\n  | otherwise  -- Either no type sig or partial type sig\n  = checkNoErrs $  -- The checkNoErrs ensures that if the type is ambiguous\n                   -- we don't carry on to the impedance matching, and generate\n                   -- a duplicate ambiguity error.  There is a similar\n                   -- checkNoErrs for complete type signatures too.\n    do { fam_envs <- tcGetFamInstEnvs\n       ; let (_co, mono_ty') = normaliseType fam_envs Nominal mono_ty\n               -- Unification may not have normalised the type,\n               -- (see Note [Lazy flattening] in TcFlatten) so do it\n               -- here to make it as uncomplicated as possible.\n               -- Example: f :: [F Int] -> Bool\n               -- should be rewritten to f :: [Char] -> Bool, if possible\n               --\n               -- We can discard the coercion _co, because we'll reconstruct\n               -- it in the call to tcSubType below\n\n       ; (binders, theta') <- chooseInferredQuantifiers inferred_theta\n                                (tyCoVarsOfType mono_ty') qtvs mb_sig_inst\n\n       ; let inferred_poly_ty = mkForAllTys binders (mkPhiTy theta' mono_ty')\n\n       ; traceTc \"mkInferredPolyId\" (vcat [ppr poly_name, ppr qtvs, ppr theta'\n                                          , ppr inferred_poly_ty])\n       ; unless insoluble $\n         addErrCtxtM (mk_inf_msg poly_name inferred_poly_ty) $\n         checkValidType (InfSigCtxt poly_name) inferred_poly_ty\n         -- See Note [Validity of inferred types]\n         -- If we found an insoluble error in the function definition, don't\n         -- do this check; otherwise (Trac #14000) we may report an ambiguity\n         -- error for a rather bogus type.\n\n       ; return (mkLocalIdOrCoVar poly_name inferred_poly_ty) }\n\n\nchooseInferredQuantifiers :: TcThetaType   -- inferred\n                          -> TcTyVarSet    -- tvs free in tau type\n                          -> [TcTyVar]     -- inferred quantified tvs\n                          -> Maybe TcIdSigInst\n                          -> TcM ([TyVarBinder], TcThetaType)\nchooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing\n  = -- No type signature (partial or complete) for this binder,\n    do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs)\n                        -- Include kind variables!  Trac #7916\n             my_theta = pickCapturedPreds free_tvs inferred_theta\n             binders  = [ mkTyVarBinder Inferred tv\n                        | tv <- qtvs\n                        , tv `elemVarSet` free_tvs ]\n       ; return (binders, my_theta) }\n\nchooseInferredQuantifiers inferred_theta tau_tvs qtvs\n                          (Just (TISI { sig_inst_sig   = sig  -- Always PartialSig\n                                      , sig_inst_wcx   = wcx\n                                      , sig_inst_theta = annotated_theta\n                                      , sig_inst_skols = annotated_tvs }))\n  = -- Choose quantifiers for a partial type signature\n    do { psig_qtv_prs <- zonkTyVarTyVarPairs annotated_tvs\n\n            -- Check whether the quantified variables of the\n            -- partial signature have been unified together\n            -- See Note [Quantified variables in partial type signatures]\n       ; mapM_ report_dup_tyvar_tv_err  (findDupTyVarTvs psig_qtv_prs)\n\n            -- Check whether a quantified variable of the partial type\n            -- signature is not actually quantified.  How can that happen?\n            -- See Note [Quantification and partial signatures] Wrinkle 4\n            --     in TcSimplify\n       ; mapM_ report_mono_sig_tv_err [ n | (n,tv) <- psig_qtv_prs\n                                          , not (tv `elem` qtvs) ]\n\n       ; let psig_qtvs = mkVarSet (map snd psig_qtv_prs)\n\n       ; annotated_theta      <- zonkTcTypes annotated_theta\n       ; (free_tvs, my_theta) <- choose_psig_context psig_qtvs annotated_theta wcx\n\n       ; let keep_me    = free_tvs `unionVarSet` psig_qtvs\n             final_qtvs = [ mkTyVarBinder vis tv\n                          | tv <- qtvs -- Pulling from qtvs maintains original order\n                          , tv `elemVarSet` keep_me\n                          , let vis | tv `elemVarSet` psig_qtvs = Specified\n                                    | otherwise                 = Inferred ]\n\n       ; return (final_qtvs, my_theta) }\n  where\n    report_dup_tyvar_tv_err (n1,n2)\n      | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig\n      = addErrTc (hang (text \"Couldn't match\" <+> quotes (ppr n1)\n                        <+> text \"with\" <+> quotes (ppr n2))\n                     2 (hang (text \"both bound by the partial type signature:\")\n                           2 (ppr fn_name <+> dcolon <+> ppr hs_ty)))\n\n      | otherwise -- Can't happen; by now we know it's a partial sig\n      = pprPanic \"report_tyvar_tv_err\" (ppr sig)\n\n    report_mono_sig_tv_err n\n      | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig\n      = addErrTc (hang (text \"Can't quantify over\" <+> quotes (ppr n))\n                     2 (hang (text \"bound by the partial type signature:\")\n                           2 (ppr fn_name <+> dcolon <+> ppr hs_ty)))\n      | otherwise -- Can't happen; by now we know it's a partial sig\n      = pprPanic \"report_mono_sig_tv_err\" (ppr sig)\n\n    choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType\n                        -> TcM (VarSet, TcThetaType)\n    choose_psig_context _ annotated_theta Nothing\n      = do { let free_tvs = closeOverKinds (tyCoVarsOfTypes annotated_theta\n                                            `unionVarSet` tau_tvs)\n           ; return (free_tvs, annotated_theta) }\n\n    choose_psig_context psig_qtvs annotated_theta (Just wc_var_ty)\n      = do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta seed_tvs)\n                            -- growThetaVars just like the no-type-sig case\n                            -- Omitting this caused #12844\n                 seed_tvs = tyCoVarsOfTypes annotated_theta  -- These are put there\n                            `unionVarSet` tau_tvs            --       by the user\n\n           ; let keep_me  = psig_qtvs `unionVarSet` free_tvs\n                 my_theta = pickCapturedPreds keep_me inferred_theta\n\n           -- Fill in the extra-constraints wildcard hole with inferred_theta,\n           -- so that the Hole constraint we have already emitted\n           -- (in tcHsPartialSigType) can report what filled it in.\n           -- NB: my_theta already includes all the annotated constraints\n           ; let inferred_diff = [ pred\n                                 | pred <- my_theta\n                                 , all (not . (`eqType` pred)) annotated_theta ]\n           ; ctuple <- mk_ctuple inferred_diff\n\n           ; case tcGetCastedTyVar_maybe wc_var_ty of\n               -- We know that wc_co must have type kind(wc_var) ~ Constraint, as it\n               -- comes from the checkExpectedKind in TcHsType.tcWildCardOcc. So, to\n               -- make the kinds work out, we reverse the cast here.\n               Just (wc_var, wc_co) -> writeMetaTyVar wc_var (ctuple `mkCastTy` mkTcSymCo wc_co)\n               Nothing              -> pprPanic \"chooseInferredQuantifiers 1\" (ppr wc_var_ty)\n\n           ; traceTc \"completeTheta\" $\n                vcat [ ppr sig\n                     , ppr annotated_theta, ppr inferred_theta\n                     , ppr inferred_diff ]\n           ; return (free_tvs, my_theta) }\n\n    mk_ctuple preds = return (mkBoxedTupleTy preds)\n       -- Hack alert!  See TcHsType:\n       -- Note [Extra-constraint holes in partial type signatures]\n\n\nmk_impedance_match_msg :: MonoBindInfo\n                       -> TcType -> TcType\n                       -> TidyEnv -> TcM (TidyEnv, SDoc)\n-- This is a rare but rather awkward error messages\nmk_impedance_match_msg (MBI { mbi_poly_name = name, mbi_sig = mb_sig })\n                       inf_ty sig_ty tidy_env\n = do { (tidy_env1, inf_ty) <- zonkTidyTcType tidy_env  inf_ty\n      ; (tidy_env2, sig_ty) <- zonkTidyTcType tidy_env1 sig_ty\n      ; let msg = vcat [ text \"When checking that the inferred type\"\n                       , nest 2 $ ppr name <+> dcolon <+> ppr inf_ty\n                       , text \"is as general as its\" <+> what <+> text \"signature\"\n                       , nest 2 $ ppr name <+> dcolon <+> ppr sig_ty ]\n      ; return (tidy_env2, msg) }\n  where\n    what = case mb_sig of\n             Nothing                     -> text \"inferred\"\n             Just sig | isPartialSig sig -> text \"(partial)\"\n                      | otherwise        -> empty\n\n\nmk_inf_msg :: Name -> TcType -> TidyEnv -> TcM (TidyEnv, SDoc)\nmk_inf_msg poly_name poly_ty tidy_env\n = do { (tidy_env1, poly_ty) <- zonkTidyTcType tidy_env poly_ty\n      ; let msg = vcat [ text \"When checking the inferred type\"\n                       , nest 2 $ ppr poly_name <+> dcolon <+> ppr poly_ty ]\n      ; return (tidy_env1, msg) }\n\n\n-- | Warn the user about polymorphic local binders that lack type signatures.\nlocalSigWarn :: WarningFlag -> Id -> Maybe TcIdSigInst -> TcM ()\nlocalSigWarn flag id mb_sig\n  | Just _ <- mb_sig               = return ()\n  | not (isSigmaTy (idType id))    = return ()\n  | otherwise                      = warnMissingSignatures flag msg id\n  where\n    msg = text \"Polymorphic local binding with no type signature:\"\n\nwarnMissingSignatures :: WarningFlag -> SDoc -> Id -> TcM ()\nwarnMissingSignatures flag msg id\n  = do  { env0 <- tcInitTidyEnv\n        ; let (env1, tidy_ty) = tidyOpenType env0 (idType id)\n        ; addWarnTcM (Reason flag) (env1, mk_msg tidy_ty) }\n  where\n    mk_msg ty = sep [ msg, nest 2 $ pprPrefixName (idName id) <+> dcolon <+> ppr ty ]\n\ncheckOverloadedSig :: Bool -> TcIdSigInst -> TcM ()\n-- Example:\n--   f :: Eq a => a -> a\n--   K f = e\n-- The MR applies, but the signature is overloaded, and it's\n-- best to complain about this directly\n-- c.f Trac #11339\ncheckOverloadedSig monomorphism_restriction_applies sig\n  | not (null (sig_inst_theta sig))\n  , monomorphism_restriction_applies\n  , let orig_sig = sig_inst_sig sig\n  = setSrcSpan (sig_loc orig_sig) $\n    failWith $\n    hang (text \"Overloaded signature conflicts with monomorphism restriction\")\n       2 (ppr orig_sig)\n  | otherwise\n  = return ()\n\n{- Note [Partial type signatures and generalisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf /any/ of the signatures in the gropu is a partial type signature\n   f :: _ -> Int\nthen we *always* use the InferGen plan, and hence tcPolyInfer.\nWe do this even for a local binding with -XMonoLocalBinds, when\nwe normally use NoGen.\n\nReasons:\n  * The TcSigInfo for 'f' has a unification variable for the '_',\n    whose TcLevel is one level deeper than the current level.\n    (See pushTcLevelM in tcTySig.)  But NoGen doesn't increase\n    the TcLevel like InferGen, so we lose the level invariant.\n\n  * The signature might be   f :: forall a. _ -> a\n    so it really is polymorphic.  It's not clear what it would\n    mean to use NoGen on this, and indeed the ASSERT in tcLhs,\n    in the (Just sig) case, checks that if there is a signature\n    then we are using LetLclBndr, and hence a nested AbsBinds with\n    increased TcLevel\n\nIt might be possible to fix these difficulties somehow, but there\ndoesn't seem much point.  Indeed, adding a partial type signature is a\nway to get per-binding inferred generalisation.\n\nWe apply the MR if /all/ of the partial signatures lack a context.\nIn particular (Trac #11016):\n   f2 :: (?loc :: Int) => _\n   f2 = ?loc\nIt's stupid to apply the MR here.  This test includes an extra-constraints\nwildcard; that is, we don't apply the MR if you write\n   f3 :: _ => blah\n\nNote [Quantified variables in partial type signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  f :: forall a. a -> a -> _\n  f x y = g x y\n  g :: forall b. b -> b -> _\n  g x y = [x, y]\n\nHere, 'f' and 'g' are mutually recursive, and we end up unifying 'a' and 'b'\ntogether, which is fine.  So we bind 'a' and 'b' to TyVarTvs, which can then\nunify with each other.\n\nBut now consider:\n  f :: forall a b. a -> b -> _\n  f x y = [x, y]\n\nWe want to get an error from this, because 'a' and 'b' get unified.\nSo we make a test, one per parital signature, to check that the\nexplicitly-quantified type variables have not been unified together.\nTrac #14449 showed this up.\n\n\nNote [Validity of inferred types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need to check inferred type for validity, in case it uses language\nextensions that are not turned on.  The principle is that if the user\nsimply adds the inferred type to the program source, it'll compile fine.\nSee #8883.\n\nExamples that might fail:\n - the type might be ambiguous\n\n - an inferred theta that requires type equalities e.g. (F a ~ G b)\n                                or multi-parameter type classes\n - an inferred type that includes unboxed tuples\n\n\nNote [Impedance matching]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   f 0 x = x\n   f n x = g [] (not x)\n\n   g [] y = f 10 y\n   g _  y = f 9  y\n\nAfter typechecking we'll get\n  f_mono_ty :: a -> Bool -> Bool\n  g_mono_ty :: [b] -> Bool -> Bool\nwith constraints\n  (Eq a, Num a)\n\nNote that f is polymorphic in 'a' and g in 'b'; and these are not linked.\nThe types we really want for f and g are\n   f :: forall a. (Eq a, Num a) => a -> Bool -> Bool\n   g :: forall b. [b] -> Bool -> Bool\n\nWe can get these by \"impedance matching\":\n   tuple :: forall a b. (Eq a, Num a) => (a -> Bool -> Bool, [b] -> Bool -> Bool)\n   tuple a b d1 d1 = let ...bind f_mono, g_mono in (f_mono, g_mono)\n\n   f a d1 d2 = case tuple a Any d1 d2 of (f, g) -> f\n   g b = case tuple Integer b dEqInteger dNumInteger of (f,g) -> g\n\nSuppose the shared quantified tyvars are qtvs and constraints theta.\nThen we want to check that\n     forall qtvs. theta => f_mono_ty   is more polymorphic than   f's polytype\nand the proof is the impedance matcher.\n\nNotice that the impedance matcher may do defaulting.  See Trac #7173.\n\nIt also cleverly does an ambiguity check; for example, rejecting\n   f :: F a -> F a\nwhere F is a non-injective type function.\n-}\n\n\n{-\nNote [SPECIALISE pragmas]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nThere is no point in a SPECIALISE pragma for a non-overloaded function:\n   reverse :: [a] -> [a]\n   {-# SPECIALISE reverse :: [Int] -> [Int] #-}\n\nBut SPECIALISE INLINE *can* make sense for GADTS:\n   data Arr e where\n     ArrInt :: !Int -> ByteArray# -> Arr Int\n     ArrPair :: !Int -> Arr e1 -> Arr e2 -> Arr (e1, e2)\n\n   (!:) :: Arr e -> Int -> e\n   {-# SPECIALISE INLINE (!:) :: Arr Int -> Int -> Int #-}\n   {-# SPECIALISE INLINE (!:) :: Arr (a, b) -> Int -> (a, b) #-}\n   (ArrInt _ ba)     !: (I# i) = I# (indexIntArray# ba i)\n   (ArrPair _ a1 a2) !: i      = (a1 !: i, a2 !: i)\n\nWhen (!:) is specialised it becomes non-recursive, and can usefully\nbe inlined.  Scary!  So we only warn for SPECIALISE *without* INLINE\nfor a non-overloaded function.\n\n************************************************************************\n*                                                                      *\n                         tcMonoBinds\n*                                                                      *\n************************************************************************\n\n@tcMonoBinds@ deals with a perhaps-recursive group of HsBinds.\nThe signatures have been dealt with already.\n-}\n\ndata MonoBindInfo = MBI { mbi_poly_name :: Name\n                        , mbi_sig       :: Maybe TcIdSigInst\n                        , mbi_mono_id   :: TcId }\n\ntcMonoBinds :: RecFlag  -- Whether the binding is recursive for typechecking purposes\n                        -- i.e. the binders are mentioned in their RHSs, and\n                        --      we are not rescued by a type signature\n            -> TcSigFun -> LetBndrSpec\n            -> [LHsBind GhcRn]\n            -> TcM (LHsBinds GhcTcId, [MonoBindInfo])\ntcMonoBinds is_rec sig_fn no_gen\n           [ dL->L b_loc (FunBind { fun_id = (dL->L nm_loc name)\n                                  , fun_matches = matches\n                                  , fun_ext = fvs })]\n                             -- Single function binding,\n  | NonRecursive <- is_rec   -- ...binder isn't mentioned in RHS\n  , Nothing <- sig_fn name   -- ...with no type signature\n  =     -- Note [Single function non-recursive binding special-case]\n        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n        -- In this very special case we infer the type of the\n        -- right hand side first (it may have a higher-rank type)\n        -- and *then* make the monomorphic Id for the LHS\n        -- e.g.         f = \\(x::forall a. a->a) -> <body>\n        --      We want to infer a higher-rank type for f\n    setSrcSpan b_loc    $\n    do  { ((co_fn, matches'), rhs_ty)\n            <- tcInferInst $ \\ exp_ty ->\n                  -- tcInferInst: see TcUnify,\n                  -- Note [Deep instantiation of InferResult] in TcUnify\n               tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $\n                  -- We extend the error context even for a non-recursive\n                  -- function so that in type error messages we show the\n                  -- type of the thing whose rhs we are type checking\n               tcMatchesFun (cL nm_loc name) matches exp_ty\n\n        ; mono_id <- newLetBndr no_gen name rhs_ty\n        ; return (unitBag $ cL b_loc $\n                     FunBind { fun_id = cL nm_loc mono_id,\n                               fun_matches = matches', fun_ext = fvs,\n                               fun_co_fn = co_fn, fun_tick = [] },\n                  [MBI { mbi_poly_name = name\n                       , mbi_sig       = Nothing\n                       , mbi_mono_id   = mono_id }]) }\n\ntcMonoBinds _ sig_fn no_gen binds\n  = do  { tc_binds <- mapM (wrapLocM (tcLhs sig_fn no_gen)) binds\n\n        -- Bring the monomorphic Ids, into scope for the RHSs\n        ; let mono_infos = getMonoBindInfo tc_binds\n              rhs_id_env = [ (name, mono_id)\n                           | MBI { mbi_poly_name = name\n                                 , mbi_sig       = mb_sig\n                                 , mbi_mono_id   = mono_id } <- mono_infos\n                           , case mb_sig of\n                               Just sig -> isPartialSig sig\n                               Nothing  -> True ]\n                -- A monomorphic binding for each term variable that lacks\n                -- a complete type sig.  (Ones with a sig are already in scope.)\n\n        ; traceTc \"tcMonoBinds\" $ vcat [ ppr n <+> ppr id <+> ppr (idType id)\n                                       | (n,id) <- rhs_id_env]\n        ; binds' <- tcExtendRecIds rhs_id_env $\n                    mapM (wrapLocM tcRhs) tc_binds\n\n        ; return (listToBag binds', mono_infos) }\n\n\n------------------------\n-- tcLhs typechecks the LHS of the bindings, to construct the environment in which\n-- we typecheck the RHSs.  Basically what we are doing is this: for each binder:\n--      if there's a signature for it, use the instantiated signature type\n--      otherwise invent a type variable\n-- You see that quite directly in the FunBind case.\n--\n-- But there's a complication for pattern bindings:\n--      data T = MkT (forall a. a->a)\n--      MkT f = e\n-- Here we can guess a type variable for the entire LHS (which will be refined to T)\n-- but we want to get (f::forall a. a->a) as the RHS environment.\n-- The simplest way to do this is to typecheck the pattern, and then look up the\n-- bound mono-ids.  Then we want to retain the typechecked pattern to avoid re-doing\n-- it; hence the TcMonoBind data type in which the LHS is done but the RHS isn't\n\ndata TcMonoBind         -- Half completed; LHS done, RHS not done\n  = TcFunBind  MonoBindInfo  SrcSpan (MatchGroup GhcRn (LHsExpr GhcRn))\n  | TcPatBind [MonoBindInfo] (LPat GhcTcId) (GRHSs GhcRn (LHsExpr GhcRn))\n              TcSigmaType\n\ntcLhs :: TcSigFun -> LetBndrSpec -> HsBind GhcRn -> TcM TcMonoBind\n-- Only called with plan InferGen (LetBndrSpec = LetLclBndr)\n--                    or NoGen    (LetBndrSpec = LetGblBndr)\n-- CheckGen is used only for functions with a complete type signature,\n--          and tcPolyCheck doesn't use tcMonoBinds at all\n\ntcLhs sig_fn no_gen (FunBind { fun_id = (dL->L nm_loc name)\n                             , fun_matches = matches })\n  | Just (TcIdSig sig) <- sig_fn name\n  = -- There is a type signature.\n    -- It must be partial; if complete we'd be in tcPolyCheck!\n    --    e.g.   f :: _ -> _\n    --           f x = ...g...\n    --           Just g = ...f...\n    -- Hence always typechecked with InferGen\n    do { mono_info <- tcLhsSigId no_gen (name, sig)\n       ; return (TcFunBind mono_info nm_loc matches) }\n\n  | otherwise  -- No type signature\n  = do { mono_ty <- newOpenFlexiTyVarTy\n       ; mono_id <- newLetBndr no_gen name mono_ty\n       ; let mono_info = MBI { mbi_poly_name = name\n                             , mbi_sig       = Nothing\n                             , mbi_mono_id   = mono_id }\n       ; return (TcFunBind mono_info nm_loc matches) }\n\ntcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss })\n  = -- See Note [Typechecking pattern bindings]\n    do  { sig_mbis <- mapM (tcLhsSigId no_gen) sig_names\n\n        ; let inst_sig_fun = lookupNameEnv $ mkNameEnv $\n                             [ (mbi_poly_name mbi, mbi_mono_id mbi)\n                             | mbi <- sig_mbis ]\n\n            -- See Note [Existentials in pattern bindings]\n        ; ((pat', nosig_mbis), pat_ty)\n            <- addErrCtxt (patMonoBindsCtxt pat grhss) $\n               tcInferNoInst $ \\ exp_ty ->\n               tcLetPat inst_sig_fun no_gen pat exp_ty $\n               mapM lookup_info nosig_names\n\n        ; let mbis = sig_mbis ++ nosig_mbis\n\n        ; traceTc \"tcLhs\" (vcat [ ppr id <+> dcolon <+> ppr (idType id)\n                                | mbi <- mbis, let id = mbi_mono_id mbi ]\n                           $$ ppr no_gen)\n\n        ; return (TcPatBind mbis pat' grhss pat_ty) }\n  where\n    bndr_names = collectPatBinders pat\n    (nosig_names, sig_names) = partitionWith find_sig bndr_names\n\n    find_sig :: Name -> Either Name (Name, TcIdSigInfo)\n    find_sig name = case sig_fn name of\n                      Just (TcIdSig sig) -> Right (name, sig)\n                      _                  -> Left name\n\n      -- After typechecking the pattern, look up the binder\n      -- names that lack a signature, which the pattern has brought\n      -- into scope.\n    lookup_info :: Name -> TcM MonoBindInfo\n    lookup_info name\n      = do { mono_id <- tcLookupId name\n           ; return (MBI { mbi_poly_name = name\n                         , mbi_sig       = Nothing\n                         , mbi_mono_id   = mono_id }) }\n\ntcLhs _ _ other_bind = pprPanic \"tcLhs\" (ppr other_bind)\n        -- AbsBind, VarBind impossible\n\n-------------------\ntcLhsSigId :: LetBndrSpec -> (Name, TcIdSigInfo) -> TcM MonoBindInfo\ntcLhsSigId no_gen (name, sig)\n  = do { inst_sig <- tcInstSig sig\n       ; mono_id <- newSigLetBndr no_gen name inst_sig\n       ; return (MBI { mbi_poly_name = name\n                     , mbi_sig       = Just inst_sig\n                     , mbi_mono_id   = mono_id }) }\n\n------------\nnewSigLetBndr :: LetBndrSpec -> Name -> TcIdSigInst -> TcM TcId\nnewSigLetBndr (LetGblBndr prags) name (TISI { sig_inst_sig = id_sig })\n  | CompleteSig { sig_bndr = poly_id } <- id_sig\n  = addInlinePrags poly_id (lookupPragEnv prags name)\nnewSigLetBndr no_gen name (TISI { sig_inst_tau = tau })\n  = newLetBndr no_gen name tau\n\n-------------------\ntcRhs :: TcMonoBind -> TcM (HsBind GhcTcId)\ntcRhs (TcFunBind info@(MBI { mbi_sig = mb_sig, mbi_mono_id = mono_id })\n                 loc matches)\n  = tcExtendIdBinderStackForRhs [info]  $\n    tcExtendTyVarEnvForRhs mb_sig       $\n    do  { traceTc \"tcRhs: fun bind\" (ppr mono_id $$ ppr (idType mono_id))\n        ; (co_fn, matches') <- tcMatchesFun (cL loc (idName mono_id))\n                                 matches (mkCheckExpType $ idType mono_id)\n        ; return ( FunBind { fun_id = cL loc mono_id\n                           , fun_matches = matches'\n                           , fun_co_fn = co_fn\n                           , fun_ext = placeHolderNamesTc\n                           , fun_tick = [] } ) }\n\ntcRhs (TcPatBind infos pat' grhss pat_ty)\n  = -- When we are doing pattern bindings we *don't* bring any scoped\n    -- type variables into scope unlike function bindings\n    -- Wny not?  They are not completely rigid.\n    -- That's why we have the special case for a single FunBind in tcMonoBinds\n    tcExtendIdBinderStackForRhs infos        $\n    do  { traceTc \"tcRhs: pat bind\" (ppr pat' $$ ppr pat_ty)\n        ; grhss' <- addErrCtxt (patMonoBindsCtxt pat' grhss) $\n                    tcGRHSsPat grhss pat_ty\n        ; return ( PatBind { pat_lhs = pat', pat_rhs = grhss'\n                           , pat_ext = NPatBindTc placeHolderNamesTc pat_ty\n                           , pat_ticks = ([],[]) } )}\n\ntcExtendTyVarEnvForRhs :: Maybe TcIdSigInst -> TcM a -> TcM a\ntcExtendTyVarEnvForRhs Nothing thing_inside\n  = thing_inside\ntcExtendTyVarEnvForRhs (Just sig) thing_inside\n  = tcExtendTyVarEnvFromSig sig thing_inside\n\ntcExtendTyVarEnvFromSig :: TcIdSigInst -> TcM a -> TcM a\ntcExtendTyVarEnvFromSig sig_inst thing_inside\n  | TISI { sig_inst_skols = skol_prs, sig_inst_wcs = wcs } <- sig_inst\n  = tcExtendNameTyVarEnv wcs $\n    tcExtendNameTyVarEnv skol_prs $\n    thing_inside\n\ntcExtendIdBinderStackForRhs :: [MonoBindInfo] -> TcM a -> TcM a\n-- Extend the TcBinderStack for the RHS of the binding, with\n-- the monomorphic Id.  That way, if we have, say\n--     f = \\x -> blah\n-- and something goes wrong in 'blah', we get a \"relevant binding\"\n-- looking like  f :: alpha -> beta\n-- This applies if 'f' has a type signature too:\n--    f :: forall a. [a] -> [a]\n--    f x = True\n-- We can't unify True with [a], and a relevant binding is f :: [a] -> [a]\n-- If we had the *polymorphic* version of f in the TcBinderStack, it\n-- would not be reported as relevant, because its type is closed\ntcExtendIdBinderStackForRhs infos thing_inside\n  = tcExtendBinderStack [ TcIdBndr mono_id NotTopLevel\n                        | MBI { mbi_mono_id = mono_id } <- infos ]\n                        thing_inside\n    -- NotTopLevel: it's a monomorphic binding\n\n---------------------\ngetMonoBindInfo :: [Located TcMonoBind] -> [MonoBindInfo]\ngetMonoBindInfo tc_binds\n  = foldr (get_info . unLoc) [] tc_binds\n  where\n    get_info (TcFunBind info _ _)    rest = info : rest\n    get_info (TcPatBind infos _ _ _) rest = infos ++ rest\n\n\n{- Note [Typechecking pattern bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLook at:\n   - typecheck/should_compile/ExPat\n   - Trac #12427, typecheck/should_compile/T12427{a,b}\n\n  data T where\n    MkT :: Integral a => a -> Int -> T\n\nand suppose t :: T.  Which of these pattern bindings are ok?\n\n  E1. let { MkT p _ = t } in <body>\n\n  E2. let { MkT _ q = t } in <body>\n\n  E3. let { MkT (toInteger -> r) _ = t } in <body>\n\n* (E1) is clearly wrong because the existential 'a' escapes.\n  What type could 'p' possibly have?\n\n* (E2) is fine, despite the existential pattern, because\n  q::Int, and nothing escapes.\n\n* Even (E3) is fine.  The existential pattern binds a dictionary\n  for (Integral a) which the view pattern can use to convert the\n  a-valued field to an Integer, so r :: Integer.\n\nAn easy way to see all three is to imagine the desugaring.\nFor (E2) it would look like\n    let q = case t of MkT _ q' -> q'\n    in <body>\n\n\nWe typecheck pattern bindings as follows.  First tcLhs does this:\n\n  1. Take each type signature q :: ty, partial or complete, and\n     instantiate it (with tcLhsSigId) to get a MonoBindInfo.  This\n     gives us a fresh \"mono_id\" qm :: instantiate(ty), where qm has\n     a fresh name.\n\n     Any fresh unification variables in instantiate(ty) born here, not\n     deep under implications as would happen if we allocated them when\n     we encountered q during tcPat.\n\n  2. Build a little environment mapping \"q\" -> \"qm\" for those Ids\n     with signatures (inst_sig_fun)\n\n  3. Invoke tcLetPat to typecheck the pattern.\n\n     - We pass in the current TcLevel.  This is captured by\n       TcPat.tcLetPat, and put into the pc_lvl field of PatCtxt, in\n       PatEnv.\n\n     - When tcPat finds an existential constructor, it binds fresh\n       type variables and dictionaries as usual, increments the TcLevel,\n       and emits an implication constraint.\n\n     - When we come to a binder (TcPat.tcPatBndr), it looks it up\n       in the little environment (the pc_sig_fn field of PatCtxt).\n\n         Success => There was a type signature, so just use it,\n                    checking compatibility with the expected type.\n\n         Failure => No type sigature.\n             Infer case: (happens only outside any constructor pattern)\n                         use a unification variable\n                         at the outer level pc_lvl\n\n             Check case: use promoteTcType to promote the type\n                         to the outer level pc_lvl.  This is the\n                         place where we emit a constraint that'll blow\n                         up if existential capture takes place\n\n       Result: the type of the binder is always at pc_lvl. This is\n       crucial.\n\n  4. Throughout, when we are making up an Id for the pattern-bound variables\n     (newLetBndr), we have two cases:\n\n     - If we are generalising (generalisation plan is InferGen or\n       CheckGen), then the let_bndr_spec will be LetLclBndr.  In that case\n       we want to bind a cloned, local version of the variable, with the\n       type given by the pattern context, *not* by the signature (even if\n       there is one; see Trac #7268). The mkExport part of the\n       generalisation step will do the checking and impedance matching\n       against the signature.\n\n     - If for some some reason we are not generalising (plan = NoGen), the\n       LetBndrSpec will be LetGblBndr.  In that case we must bind the\n       global version of the Id, and do so with precisely the type given\n       in the signature.  (Then we unify with the type from the pattern\n       context type.)\n\n\nAnd that's it!  The implication constraints check for the skolem\nescape.  It's quite simple and neat, and more expressive than before\ne.g. GHC 8.0 rejects (E2) and (E3).\n\nExample for (E1), starting at level 1.  We generate\n     p :: beta:1, with constraints (forall:3 a. Integral a => a ~ beta)\nThe (a~beta) can't float (because of the 'a'), nor be solved (because\nbeta is untouchable.)\n\nExample for (E2), we generate\n     q :: beta:1, with constraint (forall:3 a. Integral a => Int ~ beta)\nThe beta is untoucable, but floats out of the constraint and can\nbe solved absolutely fine.\n\n\n************************************************************************\n*                                                                      *\n                Generalisation\n*                                                                      *\n********************************************************************* -}\n\ndata GeneralisationPlan\n  = NoGen               -- No generalisation, no AbsBinds\n\n  | InferGen            -- Implicit generalisation; there is an AbsBinds\n       Bool             --   True <=> apply the MR; generalise only unconstrained type vars\n\n  | CheckGen (LHsBind GhcRn) TcIdSigInfo\n                        -- One FunBind with a signature\n                        -- Explicit generalisation\n\n-- A consequence of the no-AbsBinds choice (NoGen) is that there is\n-- no \"polymorphic Id\" and \"monmomorphic Id\"; there is just the one\n\ninstance Outputable GeneralisationPlan where\n  ppr NoGen          = text \"NoGen\"\n  ppr (InferGen b)   = text \"InferGen\" <+> ppr b\n  ppr (CheckGen _ s) = text \"CheckGen\" <+> ppr s\n\ndecideGeneralisationPlan\n   :: DynFlags -> [LHsBind GhcRn] -> IsGroupClosed -> TcSigFun\n   -> GeneralisationPlan\ndecideGeneralisationPlan dflags lbinds closed sig_fn\n  | has_partial_sigs                         = InferGen (and partial_sig_mrs)\n  | Just (bind, sig) <- one_funbind_with_sig = CheckGen bind sig\n  | do_not_generalise closed                 = NoGen\n  | otherwise                                = InferGen mono_restriction\n  where\n    binds = map unLoc lbinds\n\n    partial_sig_mrs :: [Bool]\n    -- One for each partial signature (so empty => no partial sigs)\n    -- The Bool is True if the signature has no constraint context\n    --      so we should apply the MR\n    -- See Note [Partial type signatures and generalisation]\n    partial_sig_mrs\n      = [ null theta\n        | TcIdSig (PartialSig { psig_hs_ty = hs_ty })\n            <- mapMaybe sig_fn (collectHsBindListBinders lbinds)\n        , let (_, dL->L _ theta, _) = splitLHsSigmaTy (hsSigWcType hs_ty) ]\n\n    has_partial_sigs   = not (null partial_sig_mrs)\n\n    mono_restriction  = xopt LangExt.MonomorphismRestriction dflags\n                     && any restricted binds\n\n    do_not_generalise (IsGroupClosed _ True) = False\n        -- The 'True' means that all of the group's\n        -- free vars have ClosedTypeId=True; so we can ignore\n        -- -XMonoLocalBinds, and generalise anyway\n    do_not_generalise _ = xopt LangExt.MonoLocalBinds dflags\n\n    -- With OutsideIn, all nested bindings are monomorphic\n    -- except a single function binding with a signature\n    one_funbind_with_sig\n      | [lbind@(dL->L _ (FunBind { fun_id = v }))] <- lbinds\n      , Just (TcIdSig sig) <- sig_fn (unLoc v)\n      = Just (lbind, sig)\n      | otherwise\n      = Nothing\n\n    -- The Haskell 98 monomorphism restriction\n    restricted (PatBind {})                              = True\n    restricted (VarBind { var_id = v })                  = no_sig v\n    restricted (FunBind { fun_id = v, fun_matches = m }) = restricted_match m\n                                                           && no_sig (unLoc v)\n    restricted b = pprPanic \"isRestrictedGroup/unrestricted\" (ppr b)\n\n    restricted_match mg = matchGroupArity mg == 0\n        -- No args => like a pattern binding\n        -- Some args => a function binding\n\n    no_sig n = not (hasCompleteSig sig_fn n)\n\nisClosedBndrGroup :: TcTypeEnv -> Bag (LHsBind GhcRn) -> IsGroupClosed\nisClosedBndrGroup type_env binds\n  = IsGroupClosed fv_env type_closed\n  where\n    type_closed = allUFM (nameSetAll is_closed_type_id) fv_env\n\n    fv_env :: NameEnv NameSet\n    fv_env = mkNameEnv $ concatMap (bindFvs . unLoc) binds\n\n    bindFvs :: HsBindLR GhcRn GhcRn -> [(Name, NameSet)]\n    bindFvs (FunBind { fun_id = (dL->L _ f)\n                     , fun_ext = fvs })\n       = let open_fvs = get_open_fvs fvs\n         in [(f, open_fvs)]\n    bindFvs (PatBind { pat_lhs = pat, pat_ext = fvs })\n       = let open_fvs = get_open_fvs fvs\n         in [(b, open_fvs) | b <- collectPatBinders pat]\n    bindFvs _\n       = []\n\n    get_open_fvs fvs = filterNameSet (not . is_closed) fvs\n\n    is_closed :: Name -> ClosedTypeId\n    is_closed name\n      | Just thing <- lookupNameEnv type_env name\n      = case thing of\n          AGlobal {}                     -> True\n          ATcId { tct_info = ClosedLet } -> True\n          _                              -> False\n\n      | otherwise\n      = True  -- The free-var set for a top level binding mentions\n\n\n    is_closed_type_id :: Name -> Bool\n    -- We're already removed Global and ClosedLet Ids\n    is_closed_type_id name\n      | Just thing <- lookupNameEnv type_env name\n      = case thing of\n          ATcId { tct_info = NonClosedLet _ cl } -> cl\n          ATcId { tct_info = NotLetBound }       -> False\n          ATyVar {}                              -> False\n               -- In-scope type variables are not closed!\n          _ -> pprPanic \"is_closed_id\" (ppr name)\n\n      | otherwise\n      = True   -- The free-var set for a top level binding mentions\n               -- imported things too, so that we can report unused imports\n               -- These won't be in the local type env.\n               -- Ditto class method etc from the current module\n\n\n{- *********************************************************************\n*                                                                      *\n               Error contexts and messages\n*                                                                      *\n********************************************************************* -}\n\n-- This one is called on LHS, when pat and grhss are both Name\n-- and on RHS, when pat is TcId and grhss is still Name\npatMonoBindsCtxt :: (OutputableBndrId (GhcPass p), Outputable body)\n                 => LPat (GhcPass p) -> GRHSs GhcRn body -> SDoc\npatMonoBindsCtxt pat grhss\n  = hang (text \"In a pattern binding:\") 2 (pprPatBind pat grhss)\n", "num_lines": 1737}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule TcCanonical(\n     canonicalize,\n     unifyDerived,\n     makeSuperClasses, maybeSym,\n     StopOrContinue(..), stopWith, continueWith,\n     solveCallStack    -- For TcSimplify\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnTypes\nimport TcUnify( swapOverTyVars, metaTyVarUpdateOK )\nimport TcType\nimport Type\nimport TcFlatten\nimport TcSMonad\nimport TcEvidence\nimport TcEvTerm\nimport Class\nimport TyCon\nimport TyCoRep   -- cleverly decomposes types, good for completeness checking\nimport Coercion\nimport CoreSyn\nimport Id( idType, mkTemplateLocals )\nimport FamInstEnv ( FamInstEnvs )\nimport FamInst ( tcTopNormaliseNewTypeTF_maybe )\nimport Var\nimport VarEnv( mkInScopeSet )\nimport VarSet( delVarSetList )\nimport Outputable\nimport DynFlags( DynFlags )\nimport NameSet\nimport RdrName\nimport HsTypes( HsIPName(..) )\n\nimport Pair\nimport Util\nimport Bag\nimport MonadUtils\nimport Control.Monad\nimport Data.Maybe ( isJust )\nimport Data.List  ( zip4 )\nimport BasicTypes\n\nimport Data.Bifunctor ( bimap )\n\n{-\n************************************************************************\n*                                                                      *\n*                      The Canonicaliser                               *\n*                                                                      *\n************************************************************************\n\nNote [Canonicalization]\n~~~~~~~~~~~~~~~~~~~~~~~\n\nCanonicalization converts a simple constraint to a canonical form. It is\nunary (i.e. treats individual constraints one at a time).\n\nConstraints originating from user-written code come into being as\nCNonCanonicals (except for CHoleCans, arising from holes). We know nothing\nabout these constraints. So, first:\n\n     Classify CNonCanoncal constraints, depending on whether they\n     are equalities, class predicates, or other.\n\nThen proceed depending on the shape of the constraint. Generally speaking,\neach constraint gets flattened and then decomposed into one of several forms\n(see type Ct in TcRnTypes).\n\nWhen an already-canonicalized constraint gets kicked out of the inert set,\nit must be recanonicalized. But we know a bit about its shape from the\nlast time through, so we can skip the classification step.\n\n-}\n\n-- Top-level canonicalization\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\ncanonicalize :: Ct -> TcS (StopOrContinue Ct)\ncanonicalize (CNonCanonical { cc_ev = ev })\n  = {-# SCC \"canNC\" #-}\n    case classifyPredType pred of\n      ClassPred cls tys     -> do traceTcS \"canEvNC:cls\" (ppr cls <+> ppr tys)\n                                  canClassNC ev cls tys\n      EqPred eq_rel ty1 ty2 -> do traceTcS \"canEvNC:eq\" (ppr ty1 $$ ppr ty2)\n                                  canEqNC    ev eq_rel ty1 ty2\n      IrredPred {}          -> do traceTcS \"canEvNC:irred\" (ppr pred)\n                                  canIrred ev\n      ForAllPred _ _ pred   -> do traceTcS \"canEvNC:forall\" (ppr pred)\n                                  canForAll ev (isClassPred pred)\n  where\n    pred = ctEvPred ev\n\ncanonicalize (CQuantCan (QCI { qci_ev = ev, qci_pend_sc = pend_sc }))\n  = canForAll ev pend_sc\n\ncanonicalize (CIrredCan { cc_ev = ev })\n  | EqPred eq_rel ty1 ty2 <- classifyPredType (ctEvPred ev)\n  = -- For insolubles (all of which are equalities, do /not/ flatten the arguments\n    -- In Trac #14350 doing so led entire-unnecessary and ridiculously large\n    -- type function expansion.  Instead, canEqNC just applies\n    -- the substitution to the predicate, and may do decomposition;\n    --    e.g. a ~ [a], where [G] a ~ [Int], can decompose\n    canEqNC ev eq_rel ty1 ty2\n\n  | otherwise\n  = canIrred ev\n\ncanonicalize (CDictCan { cc_ev = ev, cc_class  = cls\n                       , cc_tyargs = xis, cc_pend_sc = pend_sc })\n  = {-# SCC \"canClass\" #-}\n    canClass ev cls xis pend_sc\n\ncanonicalize (CTyEqCan { cc_ev = ev\n                       , cc_tyvar  = tv\n                       , cc_rhs    = xi\n                       , cc_eq_rel = eq_rel })\n  = {-# SCC \"canEqLeafTyVarEq\" #-}\n    canEqNC ev eq_rel (mkTyVarTy tv) xi\n      -- NB: Don't use canEqTyVar because that expects flattened types,\n      -- and tv and xi may not be flat w.r.t. an updated inert set\n\ncanonicalize (CFunEqCan { cc_ev = ev\n                        , cc_fun    = fn\n                        , cc_tyargs = xis1\n                        , cc_fsk    = fsk })\n  = {-# SCC \"canEqLeafFunEq\" #-}\n    canCFunEqCan ev fn xis1 fsk\n\ncanonicalize (CHoleCan { cc_ev = ev, cc_hole = hole })\n  = canHole ev hole\n\n{-\n************************************************************************\n*                                                                      *\n*                      Class Canonicalization\n*                                                                      *\n************************************************************************\n-}\n\ncanClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct)\n-- \"NC\" means \"non-canonical\"; that is, we have got here\n-- from a NonCanonical constraint, not from a CDictCan\n-- Precondition: EvVar is class evidence\ncanClassNC ev cls tys\n  | isGiven ev  -- See Note [Eagerly expand given superclasses]\n  = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys\n       ; emitWork sc_cts\n       ; canClass ev cls tys False }\n\n  | isWanted ev\n  , Just ip_name <- isCallStackPred cls tys\n  , OccurrenceOf func <- ctLocOrigin loc\n  -- If we're given a CallStack constraint that arose from a function\n  -- call, we need to push the current call-site onto the stack instead\n  -- of solving it directly from a given.\n  -- See Note [Overview of implicit CallStacks] in TcEvidence\n  -- and Note [Solving CallStack constraints] in TcSMonad\n  = do { -- First we emit a new constraint that will capture the\n         -- given CallStack.\n       ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name))\n                            -- We change the origin to IPOccOrigin so\n                            -- this rule does not fire again.\n                            -- See Note [Overview of implicit CallStacks]\n\n       ; new_ev <- newWantedEvVarNC new_loc pred\n\n         -- Then we solve the wanted by pushing the call-site\n         -- onto the newly emitted CallStack\n       ; let ev_cs = EvCsPushCall func (ctLocSpan loc) (ctEvExpr new_ev)\n       ; solveCallStack ev ev_cs\n\n       ; canClass new_ev cls tys False }\n\n  | otherwise\n  = canClass ev cls tys (has_scs cls)\n\n  where\n    has_scs cls = not (null (classSCTheta cls))\n    loc  = ctEvLoc ev\n    pred = ctEvPred ev\n\nsolveCallStack :: CtEvidence -> EvCallStack -> TcS ()\n-- Also called from TcSimplify when defaulting call stacks\nsolveCallStack ev ev_cs = do\n  -- We're given ev_cs :: CallStack, but the evidence term should be a\n  -- dictionary, so we have to coerce ev_cs to a dictionary for\n  -- `IP ip CallStack`. See Note [Overview of implicit CallStacks]\n  cs_tm <- evCallStack ev_cs\n  let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev))\n  setEvBindIfWanted ev ev_tm\n\ncanClass :: CtEvidence\n         -> Class -> [Type]\n         -> Bool            -- True <=> un-explored superclasses\n         -> TcS (StopOrContinue Ct)\n-- Precondition: EvVar is class evidence\n\ncanClass ev cls tys pend_sc\n  =   -- all classes do *nominal* matching\n    ASSERT2( ctEvRole ev == Nominal, ppr ev $$ ppr cls $$ ppr tys )\n    do { (xis, cos, _kind_co) <- flattenArgsNom ev cls_tc tys\n       ; MASSERT( isTcReflCo _kind_co )\n       ; let co = mkTcTyConAppCo Nominal cls_tc cos\n             xi = mkClassPred cls xis\n             mk_ct new_ev = CDictCan { cc_ev = new_ev\n                                     , cc_tyargs = xis\n                                     , cc_class = cls\n                                     , cc_pend_sc = pend_sc }\n       ; mb <- rewriteEvidence ev xi co\n       ; traceTcS \"canClass\" (vcat [ ppr ev\n                                   , ppr xi, ppr mb ])\n       ; return (fmap mk_ct mb) }\n  where\n    cls_tc = classTyCon cls\n\n{- Note [The superclass story]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need to add superclass constraints for two reasons:\n\n* For givens [G], they give us a route to proof.  E.g.\n    f :: Ord a => a -> Bool\n    f x = x == x\n  We get a Wanted (Eq a), which can only be solved from the superclass\n  of the Given (Ord a).\n\n* For wanteds [W], and deriveds [WD], [D], they may give useful\n  functional dependencies.  E.g.\n     class C a b | a -> b where ...\n     class C a b => D a b where ...\n  Now a [W] constraint (D Int beta) has (C Int beta) as a superclass\n  and that might tell us about beta, via C's fundeps.  We can get this\n  by generating a [D] (C Int beta) constraint.  It's derived because\n  we don't actually have to cough up any evidence for it; it's only there\n  to generate fundep equalities.\n\nSee Note [Why adding superclasses can help].\n\nFor these reasons we want to generate superclass constraints for both\nGivens and Wanteds. But:\n\n* (Minor) they are often not needed, so generating them aggressively\n  is a waste of time.\n\n* (Major) if we want recursive superclasses, there would be an infinite\n  number of them.  Here is a real-life example (Trac #10318);\n\n     class (Frac (Frac a) ~ Frac a,\n            Fractional (Frac a),\n            IntegralDomain (Frac a))\n         => IntegralDomain a where\n      type Frac a :: *\n\n  Notice that IntegralDomain has an associated type Frac, and one\n  of IntegralDomain's superclasses is another IntegralDomain constraint.\n\nSo here's the plan:\n\n1. Eagerly generate superclasses for given (but not wanted)\n   constraints; see Note [Eagerly expand given superclasses].\n   This is done using mkStrictSuperClasses in canClassNC, when\n   we take a non-canonical Given constraint and cannonicalise it.\n\n   However stop if you encounter the same class twice.  That is,\n   mkStrictSuperClasses expands eagerly, but has a conservative\n   termination condition: see Note [Expanding superclasses] in TcType.\n\n2. Solve the wanteds as usual, but do no further expansion of\n   superclasses for canonical CDictCans in solveSimpleGivens or\n   solveSimpleWanteds; Note [Danger of adding superclasses during solving]\n\n   However, /do/ continue to eagerly expand superlasses for new /given/\n   /non-canonical/ constraints (canClassNC does this).  As Trac #12175\n   showed, a type-family application can expand to a class constraint,\n   and we want to see its superclasses for just the same reason as\n   Note [Eagerly expand given superclasses].\n\n3. If we have any remaining unsolved wanteds\n        (see Note [When superclasses help] in TcRnTypes)\n   try harder: take both the Givens and Wanteds, and expand\n   superclasses again.  See the calls to expandSuperClasses in\n   TcSimplify.simpl_loop and solveWanteds.\n\n   This may succeed in generating (a finite number of) extra Givens,\n   and extra Deriveds. Both may help the proof.\n\n3a An important wrinkle: only expand Givens from the current level.\n   Two reasons:\n      - We only want to expand it once, and that is best done at\n        the level it is bound, rather than repeatedly at the leaves\n        of the implication tree\n      - We may be inside a type where we can't create term-level\n        evidence anyway, so we can't superclass-expand, say,\n        (a ~ b) to get (a ~# b).  This happened in Trac #15290.\n\n4. Go round to (2) again.  This loop (2,3,4) is implemented\n   in TcSimplify.simpl_loop.\n\nThe cc_pend_sc flag in a CDictCan records whether the superclasses of\nthis constraint have been expanded.  Specifically, in Step 3 we only\nexpand superclasses for constraints with cc_pend_sc set to true (i.e.\nisPendingScDict holds).\n\nWhy do we do this?  Two reasons:\n\n* To avoid repeated work, by repeatedly expanding the superclasses of\n  same constraint,\n\n* To terminate the above loop, at least in the -XNoRecursiveSuperClasses\n  case.  If there are recursive superclasses we could, in principle,\n  expand forever, always encountering new constraints.\n\nWhen we take a CNonCanonical or CIrredCan, but end up classifying it\nas a CDictCan, we set the cc_pend_sc flag to False.\n\nNote [Superclass loops]\n~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n  class C a => D a\n  class D a => C a\n\nThen, when we expand superclasses, we'll get back to the self-same\npredicate, so we have reached a fixpoint in expansion and there is no\npoint in fruitlessly expanding further.  This case just falls out from\nour strategy.  Consider\n  f :: C a => a -> Bool\n  f x = x==x\nThen canClassNC gets the [G] d1: C a constraint, and eager emits superclasses\nG] d2: D a, [G] d3: C a (psc).  (The \"psc\" means it has its sc_pend flag set.)\nWhen processing d3 we find a match with d1 in the inert set, and we always\nkeep the inert item (d1) if possible: see Note [Replacement vs keeping] in\nTcInteract.  So d3 dies a quick, happy death.\n\nNote [Eagerly expand given superclasses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn step (1) of Note [The superclass story], why do we eagerly expand\nGiven superclasses by one layer?  (By \"one layer\" we mean expand transitively\nuntil you meet the same class again -- the conservative criterion embodied\nin expandSuperClasses.  So a \"layer\" might be a whole stack of superclasses.)\nWe do this eagerly for Givens mainly because of some very obscure\ncases like this:\n\n   instance Bad a => Eq (T a)\n\n   f :: (Ord (T a)) => blah\n   f x = ....needs Eq (T a), Ord (T a)....\n\nHere if we can't satisfy (Eq (T a)) from the givens we'll use the\ninstance declaration; but then we are stuck with (Bad a).  Sigh.\nThis is really a case of non-confluent proofs, but to stop our users\ncomplaining we expand one layer in advance.\n\nNote [Instance and Given overlap] in TcInteract.\n\nWe also want to do this if we have\n\n   f :: F (T a) => blah\n\nwhere\n   type instance F (T a) = Ord (T a)\n\nSo we may need to do a little work on the givens to expose the\nclass that has the superclasses.  That's why the superclass\nexpansion for Givens happens in canClassNC.\n\nNote [Why adding superclasses can help]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nExamples of how adding superclasses can help:\n\n    --- Example 1\n        class C a b | a -> b\n    Suppose we want to solve\n         [G] C a b\n         [W] C a beta\n    Then adding [D] beta~b will let us solve it.\n\n    -- Example 2 (similar but using a type-equality superclass)\n        class (F a ~ b) => C a b\n    And try to sllve:\n         [G] C a b\n         [W] C a beta\n    Follow the superclass rules to add\n         [G] F a ~ b\n         [D] F a ~ beta\n    Now we get [D] beta ~ b, and can solve that.\n\n    -- Example (tcfail138)\n      class L a b | a -> b\n      class (G a, L a b) => C a b\n\n      instance C a b' => G (Maybe a)\n      instance C a b  => C (Maybe a) a\n      instance L (Maybe a) a\n\n    When solving the superclasses of the (C (Maybe a) a) instance, we get\n      [G] C a b, and hance by superclasses, [G] G a, [G] L a b\n      [W] G (Maybe a)\n    Use the instance decl to get\n      [W] C a beta\n    Generate its derived superclass\n      [D] L a beta.  Now using fundeps, combine with [G] L a b to get\n      [D] beta ~ b\n    which is what we want.\n\nNote [Danger of adding superclasses during solving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere's a serious, but now out-dated example, from Trac #4497:\n\n   class Num (RealOf t) => Normed t\n   type family RealOf x\n\nAssume the generated wanted constraint is:\n   [W] RealOf e ~ e\n   [W] Normed e\n\nIf we were to be adding the superclasses during simplification we'd get:\n   [W] RealOf e ~ e\n   [W] Normed e\n   [D] RealOf e ~ fuv\n   [D] Num fuv\n==>\n   e := fuv, Num fuv, Normed fuv, RealOf fuv ~ fuv\n\nWhile looks exactly like our original constraint. If we add the\nsuperclass of (Normed fuv) again we'd loop.  By adding superclasses\ndefinitely only once, during canonicalisation, this situation can't\nhappen.\n\nMind you, now that Wanteds cannot rewrite Derived, I think this particular\nsituation can't happen.\n  -}\n\nmakeSuperClasses :: [Ct] -> TcS [Ct]\n-- Returns strict superclasses, transitively, see Note [The superclasses story]\n-- See Note [The superclass story]\n-- The loop-breaking here follows Note [Expanding superclasses] in TcType\n-- Specifically, for an incoming (C t) constraint, we return all of (C t)'s\n--    superclasses, up to /and including/ the first repetition of C\n--\n-- Example:  class D a => C a\n--           class C [a] => D a\n-- makeSuperClasses (C x) will return (D x, C [x])\n--\n-- NB: the incoming constraints have had their cc_pend_sc flag already\n--     flipped to False, by isPendingScDict, so we are /obliged/ to at\n--     least produce the immediate superclasses\nmakeSuperClasses cts = concatMapM go cts\n  where\n    go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys })\n      = mkStrictSuperClasses ev [] [] cls tys\n    go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev }))\n      = ASSERT2( isClassPred pred, ppr pred )  -- The cts should all have\n                                               -- class pred heads\n        mkStrictSuperClasses ev tvs theta cls tys\n      where\n        (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev)\n    go ct = pprPanic \"makeSuperClasses\" (ppr ct)\n\nmkStrictSuperClasses\n    :: CtEvidence\n    -> [TyVar] -> ThetaType  -- These two args are non-empty only when taking\n                             -- superclasses of a /quantified/ constraint\n    -> Class -> [Type] -> TcS [Ct]\n-- Return constraints for the strict superclasses of\n--   ev :: forall as. theta => cls tys\nmkStrictSuperClasses ev tvs theta cls tys\n  = mk_strict_superclasses (unitNameSet (className cls))\n                           ev tvs theta cls tys\n\nmk_strict_superclasses :: NameSet -> CtEvidence\n                       -> [TyVar] -> ThetaType\n                       -> Class -> [Type] -> TcS [Ct]\n-- Always return the immediate superclasses of (cls tys);\n-- and expand their superclasses, provided none of them are in rec_clss\n-- nor are repeated\nmk_strict_superclasses rec_clss ev tvs theta cls tys\n  | CtGiven { ctev_evar = evar, ctev_loc = loc } <- ev\n  = concatMapM (do_one_given evar (mk_given_loc loc)) $\n    classSCSelIds cls\n  where\n    dict_ids  = mkTemplateLocals theta\n    size      = sizeTypes tys\n\n    do_one_given evar given_loc sel_id\n      | isUnliftedType sc_pred\n      , not (null tvs && null theta)\n      = -- See Note [Equality superclasses in quantified constraints]\n        return []\n      | otherwise\n      = do { given_ev <- newGivenEvVar given_loc $\n                         (given_ty, mk_sc_sel evar sel_id)\n           ; mk_superclasses rec_clss given_ev tvs theta sc_pred }\n      where\n        sc_pred  = funResultTy (piResultTys (idType sel_id) tys)\n        given_ty = mkInfSigmaTy tvs theta sc_pred\n\n    mk_sc_sel evar sel_id\n      = EvExpr $ mkLams tvs $ mkLams dict_ids $\n        Var sel_id `mkTyApps` tys `App`\n        (evId evar `mkTyApps` mkTyVarTys tvs `mkVarApps` dict_ids)\n\n    mk_given_loc loc\n       | isCTupleClass cls\n       = loc   -- For tuple predicates, just take them apart, without\n               -- adding their (large) size into the chain.  When we\n               -- get down to a base predicate, we'll include its size.\n               -- Trac #10335\n\n       | GivenOrigin skol_info <- ctLocOrigin loc\n         -- See Note [Solving superclass constraints] in TcInstDcls\n         -- for explantation of this transformation for givens\n       = case skol_info of\n            InstSkol -> loc { ctl_origin = GivenOrigin (InstSC size) }\n            InstSC n -> loc { ctl_origin = GivenOrigin (InstSC (n `max` size)) }\n            _        -> loc\n\n       | otherwise  -- Probably doesn't happen, since this function\n       = loc        -- is only used for Givens, but does no harm\n\nmk_strict_superclasses rec_clss ev tvs theta cls tys\n  | all noFreeVarsOfType tys\n  = return [] -- Wanteds with no variables yield no deriveds.\n              -- See Note [Improvement from Ground Wanteds]\n\n  | otherwise -- Wanted/Derived case, just add Derived superclasses\n              -- that can lead to improvement.\n  = ASSERT2( null tvs && null theta, ppr tvs $$ ppr theta )\n    concatMapM do_one_derived (immSuperClasses cls tys)\n  where\n    loc = ctEvLoc ev\n\n    do_one_derived sc_pred\n      = do { sc_ev <- newDerivedNC loc sc_pred\n           ; mk_superclasses rec_clss sc_ev [] [] sc_pred }\n\nmk_superclasses :: NameSet -> CtEvidence\n                -> [TyVar] -> ThetaType -> PredType -> TcS [Ct]\n-- Return this constraint, plus its superclasses, if any\nmk_superclasses rec_clss ev tvs theta pred\n  | ClassPred cls tys <- classifyPredType pred\n  = mk_superclasses_of rec_clss ev tvs theta cls tys\n\n  | otherwise   -- Superclass is not a class predicate\n  = return [mkNonCanonical ev]\n\nmk_superclasses_of :: NameSet -> CtEvidence\n                   -> [TyVar] -> ThetaType -> Class -> [Type]\n                   -> TcS [Ct]\n-- Always return this class constraint,\n-- and expand its superclasses\nmk_superclasses_of rec_clss ev tvs theta cls tys\n  | loop_found = do { traceTcS \"mk_superclasses_of: loop\" (ppr cls <+> ppr tys)\n                    ; return [this_ct] }  -- cc_pend_sc of this_ct = True\n  | otherwise  = do { traceTcS \"mk_superclasses_of\" (vcat [ ppr cls <+> ppr tys\n                                                          , ppr (isCTupleClass cls)\n                                                          , ppr rec_clss\n                                                          ])\n                    ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys\n                    ; return (this_ct : sc_cts) }\n                                   -- cc_pend_sc of this_ct = False\n  where\n    cls_nm     = className cls\n    loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss\n                 -- Tuples never contribute to recursion, and can be nested\n    rec_clss'  = rec_clss `extendNameSet` cls_nm\n\n    this_ct | null tvs, null theta\n            = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys\n                       , cc_pend_sc = loop_found }\n                 -- NB: If there is a loop, we cut off, so we have not\n                 --     added the superclasses, hence cc_pend_sc = True\n            | otherwise\n            = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys\n                             , qci_ev = ev\n                             , qci_pend_sc = loop_found })\n\n\n{- Note [Equality superclasses in quantified constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #15359, #15593, #15625)\n  f :: (forall a. theta => a ~ b) => stuff\n\nIt's a bit odd to have a local, quantified constraint for `(a~b)`,\nbut some people want such a thing (see the tickets). And for\nCoercible it is definitely useful\n  f :: forall m. (forall p q. Coercible p q => Coercible (m p) (m q)))\n                 => stuff\n\nMoreover it's not hard to arrange; we just need to look up /equality/\nconstraints in the quantified-constraint environment, which we do in\nTcInteract.doTopReactOther.\n\nThere is a wrinkle though, in the case where 'theta' is empty, so\nwe have\n  f :: (forall a. a~b) => stuff\n\nNow, potentially, the superclass machinery kicks in, in\nmakeSuperClasses, giving us a a second quantified constrait\n       (forall a. a ~# b)\nBUT this is an unboxed value!  And nothing has prepared us for\ndictionary \"functions\" that are unboxed.  Actually it does just\nabout work, but the simplier ends up with stuff like\n   case (/\\a. eq_sel d) of df -> ...(df @Int)...\nand fails to simplify that any further.  And it doesn't satisfy\nisPredTy any more.\n\nSo for now we simply decline to take superclasses in the quantified\ncase.  Instead we have a special case in TcInteract.doTopReactOther,\nwhich looks for primitive equalities specially in the quantified\nconstraints.\n\nSee also Note [Evidence for quantified constraints] in Type.\n\n\n************************************************************************\n*                                                                      *\n*                      Irreducibles canonicalization\n*                                                                      *\n************************************************************************\n-}\n\ncanIrred :: CtEvidence -> TcS (StopOrContinue Ct)\n-- Precondition: ty not a tuple and no other evidence form\ncanIrred ev\n  = do { let pred = ctEvPred ev\n       ; traceTcS \"can_pred\" (text \"IrredPred = \" <+> ppr pred)\n       ; (xi,co) <- flatten FM_FlattenAll ev pred -- co :: xi ~ pred\n       ; rewriteEvidence ev xi co `andWhenContinue` \\ new_ev ->\n    do { -- Re-classify, in case flattening has improved its shape\n       ; case classifyPredType (ctEvPred new_ev) of\n           ClassPred cls tys     -> canClassNC new_ev cls tys\n           EqPred eq_rel ty1 ty2 -> canEqNC new_ev eq_rel ty1 ty2\n           _                     -> continueWith $\n                                    mkIrredCt new_ev } }\n\ncanHole :: CtEvidence -> Hole -> TcS (StopOrContinue Ct)\ncanHole ev hole\n  = do { let pred = ctEvPred ev\n       ; (xi,co) <- flatten FM_SubstOnly ev pred -- co :: xi ~ pred\n       ; rewriteEvidence ev xi co `andWhenContinue` \\ new_ev ->\n    do { updInertIrreds (`snocCts` (CHoleCan { cc_ev = new_ev\n                                             , cc_hole = hole }))\n       ; stopWith new_ev \"Emit insoluble hole\" } }\n\n\n{- *********************************************************************\n*                                                                      *\n*                      Quantified predicates\n*                                                                      *\n********************************************************************* -}\n\n{- Note [Quantified constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe -XQuantifiedConstraints extension allows type-class contexts like this:\n\n  data Rose f x = Rose x (f (Rose f x))\n\n  instance (Eq a, forall b. Eq b => Eq (f b))\n        => Eq (Rose f a)  where\n    (Rose x1 rs1) == (Rose x2 rs2) = x1==x2 && rs1 == rs2\n\nNote the (forall b. Eq b => Eq (f b)) in the instance contexts.\nThis quantified constraint is needed to solve the\n [W] (Eq (f (Rose f x)))\nconstraint which arises form the (==) definition.\n\nThe wiki page is\n  https://ghc.haskell.org/trac/ghc/wiki/QuantifiedConstraints\nwhich in turn contains a link to the GHC Proposal where the change\nis specified, and a Haskell Symposium paper about it.\n\nWe implement two main extensions to the design in the paper:\n\n 1. We allow a variable in the instance head, e.g.\n      f :: forall m a. (forall b. m b) => D (m a)\n    Notice the 'm' in the head of the quantified constraint, not\n    a class.\n\n 2. We suport superclasses to quantified constraints.\n    For example (contrived):\n      f :: (Ord b, forall b. Ord b => Ord (m b)) => m a -> m a -> Bool\n      f x y = x==y\n    Here we need (Eq (m a)); but the quantifed constraint deals only\n    with Ord.  But we can make it work by using its superclass.\n\nHere are the moving parts\n  * Language extension {-# LANGUAGE QuantifiedConstraints #-}\n    and add it to ghc-boot-th:GHC.LanguageExtensions.Type.Extension\n\n  * A new form of evidence, EvDFun, that is used to discharge\n    such wanted constraints\n\n  * checkValidType gets some changes to accept forall-constraints\n    only in the right places.\n\n  * Type.PredTree gets a new constructor ForAllPred, and\n    and classifyPredType analyses a PredType to decompose\n    the new forall-constraints\n\n  * TcSMonad.InertCans gets an extra field, inert_insts,\n    which holds all the Given forall-constraints.  In effect,\n    such Given constraints are like local instance decls.\n\n  * When trying to solve a class constraint, via\n    TcInteract.matchInstEnv, use the InstEnv from inert_insts\n    so that we include the local Given forall-constraints\n    in the lookup.  (See TcSMonad.getInstEnvs.)\n\n  * TcCanonical.canForAll deals with solving a\n    forall-constraint.  See\n       Note [Solving a Wanted forall-constraint]\n\n  * We augment the kick-out code to kick out an inert\n    forall constraint if it can be rewritten by a new\n    type equality; see TcSMonad.kick_out_rewritable\n\nNote that a quantified constraint is never /inferred/\n(by TcSimplify.simplifyInfer).  A function can only have a\nquantified constraint in its type if it is given an explicit\ntype signature.\n\nNote that we implement\n-}\n\ncanForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct)\n-- We have a constraint (forall as. blah => C tys)\ncanForAll ev pend_sc\n  = do { -- First rewrite it to apply the current substitution\n         -- Do not bother with type-family reductions; we can't\n         -- do them under a forall anyway (c.f. Flatten.flatten_one\n         -- on a forall type)\n         let pred = ctEvPred ev\n       ; (xi,co) <- flatten FM_SubstOnly ev pred -- co :: xi ~ pred\n       ; rewriteEvidence ev xi co `andWhenContinue` \\ new_ev ->\n\n    do { -- Now decompose into its pieces and solve it\n         -- (It takes a lot less code to flatten before decomposing.)\n       ; case classifyPredType (ctEvPred new_ev) of\n           ForAllPred tv_bndrs theta pred\n              -> solveForAll new_ev tv_bndrs theta pred pend_sc\n           _  -> pprPanic \"canForAll\" (ppr new_ev)\n    } }\n\nsolveForAll :: CtEvidence -> [TyVarBinder] -> TcThetaType -> PredType -> Bool\n            -> TcS (StopOrContinue Ct)\nsolveForAll ev tv_bndrs theta pred pend_sc\n  | CtWanted { ctev_dest = dest } <- ev\n  = -- See Note [Solving a Wanted forall-constraint]\n    do { let skol_info = QuantCtxtSkol\n             empty_subst = mkEmptyTCvSubst $ mkInScopeSet $\n                           tyCoVarsOfTypes (pred:theta) `delVarSetList` tvs\n       ; (subst, skol_tvs) <- tcInstSkolTyVarsX empty_subst tvs\n       ; given_ev_vars <- mapM newEvVar (substTheta subst theta)\n\n       ; (w_id, ev_binds)\n             <- checkConstraintsTcS skol_info skol_tvs given_ev_vars $\n                do { wanted_ev <- newWantedEvVarNC loc $\n                                  substTy subst pred\n                   ; return ( ctEvEvId wanted_ev\n                            , unitBag (mkNonCanonical wanted_ev)) }\n\n      ; setWantedEvTerm dest $\n        EvFun { et_tvs = skol_tvs, et_given = given_ev_vars\n              , et_binds = ev_binds, et_body = w_id }\n\n      ; stopWith ev \"Wanted forall-constraint\" }\n\n  | isGiven ev   -- See Note [Solving a Given forall-constraint]\n  = do { addInertForAll qci\n       ; stopWith ev \"Given forall-constraint\" }\n\n  | otherwise\n  = stopWith ev \"Derived forall-constraint\"\n  where\n    loc = ctEvLoc ev\n    tvs = binderVars tv_bndrs\n    qci = QCI { qci_ev = ev, qci_tvs = tvs\n              , qci_pred = pred, qci_pend_sc = pend_sc }\n\n{- Note [Solving a Wanted forall-constraint]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSolving a wanted forall (quantified) constraint\n  [W] df :: forall ab. (Eq a, Ord b) => C x a b\nis delightfully easy.   Just build an implication constraint\n    forall ab. (g1::Eq a, g2::Ord b) => [W] d :: C x a\nand discharge df thus:\n    df = /\\ab. \\g1 g2. let <binds> in d\nwhere <binds> is filled in by solving the implication constraint.\nAll the machinery is to hand; there is little to do.\n\nNote [Solving a Given forall-constraint]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor a Given constraint\n  [G] df :: forall ab. (Eq a, Ord b) => C x a b\nwe just add it to TcS's local InstEnv of known instances,\nvia addInertForall.  Then, if we look up (C x Int Bool), say,\nwe'll find a match in the InstEnv.\n\n\n************************************************************************\n*                                                                      *\n*        Equalities\n*                                                                      *\n************************************************************************\n\nNote [Canonicalising equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn order to canonicalise an equality, we look at the structure of the\ntwo types at hand, looking for similarities. A difficulty is that the\ntypes may look dissimilar before flattening but similar after flattening.\nHowever, we don't just want to jump in and flatten right away, because\nthis might be wasted effort. So, after looking for similarities and failing,\nwe flatten and then try again. Of course, we don't want to loop, so we\ntrack whether or not we've already flattened.\n\nIt is conceivable to do a better job at tracking whether or not a type\nis flattened, but this is left as future work. (Mar '15)\n\n\nNote [FunTy and decomposing tycon applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen can_eq_nc' attempts to decompose a tycon application we haven't yet zonked.\nThis means that we may very well have a FunTy containing a type of some unknown\nkind. For instance, we may have,\n\n    FunTy (a :: k) Int\n\nWhere k is a unification variable. tcRepSplitTyConApp_maybe panics in the event\nthat it sees such a type as it cannot determine the RuntimeReps which the (->)\nis applied to. Consequently, it is vital that we instead use\ntcRepSplitTyConApp_maybe', which simply returns Nothing in such a case.\n\nWhen this happens can_eq_nc' will fail to decompose, zonk, and try again.\nZonking should fill the variable k, meaning that decomposition will succeed the\nsecond time around.\n-}\n\ncanEqNC :: CtEvidence -> EqRel -> Type -> Type -> TcS (StopOrContinue Ct)\ncanEqNC ev eq_rel ty1 ty2\n  = do { result <- zonk_eq_types ty1 ty2\n       ; case result of\n           Left (Pair ty1' ty2') -> can_eq_nc False ev eq_rel ty1' ty1 ty2' ty2\n           Right ty              -> canEqReflexive ev eq_rel ty }\n\ncan_eq_nc\n   :: Bool            -- True => both types are flat\n   -> CtEvidence\n   -> EqRel\n   -> Type -> Type    -- LHS, after and before type-synonym expansion, resp\n   -> Type -> Type    -- RHS, after and before type-synonym expansion, resp\n   -> TcS (StopOrContinue Ct)\ncan_eq_nc flat ev eq_rel ty1 ps_ty1 ty2 ps_ty2\n  = do { traceTcS \"can_eq_nc\" $\n         vcat [ ppr flat, ppr ev, ppr eq_rel, ppr ty1, ppr ps_ty1, ppr ty2, ppr ps_ty2 ]\n       ; rdr_env <- getGlobalRdrEnvTcS\n       ; fam_insts <- getFamInstEnvs\n       ; can_eq_nc' flat rdr_env fam_insts ev eq_rel ty1 ps_ty1 ty2 ps_ty2 }\n\ncan_eq_nc'\n   :: Bool           -- True => both input types are flattened\n   -> GlobalRdrEnv   -- needed to see which newtypes are in scope\n   -> FamInstEnvs    -- needed to unwrap data instances\n   -> CtEvidence\n   -> EqRel\n   -> Type -> Type    -- LHS, after and before type-synonym expansion, resp\n   -> Type -> Type    -- RHS, after and before type-synonym expansion, resp\n   -> TcS (StopOrContinue Ct)\n\n-- Expand synonyms first; see Note [Type synonyms and canonicalization]\ncan_eq_nc' flat rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2\n  | Just ty1' <- tcView ty1 = can_eq_nc' flat rdr_env envs ev eq_rel ty1' ps_ty1 ty2  ps_ty2\n  | Just ty2' <- tcView ty2 = can_eq_nc' flat rdr_env envs ev eq_rel ty1  ps_ty1 ty2' ps_ty2\n\n-- need to check for reflexivity in the ReprEq case.\n-- See Note [Eager reflexivity check]\n-- Check only when flat because the zonk_eq_types check in canEqNC takes\n-- care of the non-flat case.\ncan_eq_nc' True _rdr_env _envs ev ReprEq ty1 _ ty2 _\n  | ty1 `tcEqType` ty2\n  = canEqReflexive ev ReprEq ty1\n\n-- When working with ReprEq, unwrap newtypes.\n-- See Note [Unwrap newtypes first]\ncan_eq_nc' _flat rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2\n  | ReprEq <- eq_rel\n  , Just stuff1 <- tcTopNormaliseNewTypeTF_maybe envs rdr_env ty1\n  = can_eq_newtype_nc ev NotSwapped ty1 stuff1 ty2 ps_ty2\n\n  | ReprEq <- eq_rel\n  , Just stuff2 <- tcTopNormaliseNewTypeTF_maybe envs rdr_env ty2\n  = can_eq_newtype_nc ev IsSwapped  ty2 stuff2 ty1 ps_ty1\n\n-- Then, get rid of casts\ncan_eq_nc' flat _rdr_env _envs ev eq_rel (CastTy ty1 co1) _ ty2 ps_ty2\n  = canEqCast flat ev eq_rel NotSwapped ty1 co1 ty2 ps_ty2\ncan_eq_nc' flat _rdr_env _envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _\n  = canEqCast flat ev eq_rel IsSwapped ty2 co2 ty1 ps_ty1\n\n-- NB: pattern match on True: we want only flat types sent to canEqTyVar.\n-- See also Note [No top-level newtypes on RHS of representational equalities]\ncan_eq_nc' True _rdr_env _envs ev eq_rel (TyVarTy tv1) ps_ty1 ty2 ps_ty2\n  = canEqTyVar ev eq_rel NotSwapped tv1 ps_ty1 ty2 ps_ty2\ncan_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 (TyVarTy tv2) ps_ty2\n  = canEqTyVar ev eq_rel IsSwapped tv2 ps_ty2 ty1 ps_ty1\n\n----------------------\n-- Otherwise try to decompose\n----------------------\n\n-- Literals\ncan_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _\n | l1 == l2\n  = do { setEvBindIfWanted ev (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1)\n       ; stopWith ev \"Equal LitTy\" }\n\n-- Try to decompose type constructor applications\n-- Including FunTy (s -> t)\ncan_eq_nc' _flat _rdr_env _envs ev eq_rel ty1 _ ty2 _\n    --- See Note [FunTy and decomposing type constructor applications].\n  | Just (tc1, tys1) <- repSplitTyConApp_maybe ty1\n  , Just (tc2, tys2) <- repSplitTyConApp_maybe ty2\n  , not (isTypeFamilyTyCon tc1)\n  , not (isTypeFamilyTyCon tc2)\n  = canTyConApp ev eq_rel tc1 tys1 tc2 tys2\n\ncan_eq_nc' _flat _rdr_env _envs ev eq_rel\n           s1@(ForAllTy {}) _ s2@(ForAllTy {}) _\n  = can_eq_nc_forall ev eq_rel s1 s2\n\n-- See Note [Canonicalising type applications] about why we require flat types\ncan_eq_nc' True _rdr_env _envs ev eq_rel (AppTy t1 s1) _ ty2 _\n  | NomEq <- eq_rel\n  , Just (t2, s2) <- tcSplitAppTy_maybe ty2\n  = can_eq_app ev t1 s1 t2 s2\ncan_eq_nc' True _rdr_env _envs ev eq_rel ty1 _ (AppTy t2 s2) _\n  | NomEq <- eq_rel\n  , Just (t1, s1) <- tcSplitAppTy_maybe ty1\n  = can_eq_app ev t1 s1 t2 s2\n\n-- No similarity in type structure detected. Flatten and try again.\ncan_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2\n  = do { (xi1, co1) <- flatten FM_FlattenAll ev ps_ty1\n       ; (xi2, co2) <- flatten FM_FlattenAll ev ps_ty2\n       ; new_ev <- rewriteEqEvidence ev NotSwapped xi1 xi2 co1 co2\n       ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 }\n\n-- We've flattened and the types don't match. Give up.\ncan_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2\n  = do { traceTcS \"can_eq_nc' catch-all case\" (ppr ps_ty1 $$ ppr ps_ty2)\n       ; case eq_rel of -- See Note [Unsolved equalities]\n            ReprEq -> continueWith (mkIrredCt ev)\n            NomEq  -> continueWith (mkInsolubleCt ev) }\n          -- No need to call canEqFailure/canEqHardFailure because they\n          -- flatten, and the types involved here are already flat\n\n{- Note [Unsolved equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have an unsolved equality like\n  (a b ~R# Int)\nthat is not necessarily insoluble!  Maybe 'a' will turn out to be a newtype.\nSo we want to make it a potentially-soluble Irred not an insoluble one.\nMissing this point is what caused Trac #15431\n-}\n\n---------------------------------\ncan_eq_nc_forall :: CtEvidence -> EqRel\n                 -> Type -> Type    -- LHS and RHS\n                 -> TcS (StopOrContinue Ct)\n-- (forall as. phi1) ~ (forall bs. phi2)\n-- Check for length match of as, bs\n-- Then build an implication constraint: forall as. phi1 ~ phi2[as/bs]\n-- But remember also to unify the kinds of as and bs\n--  (this is the 'go' loop), and actually substitute phi2[as |> cos / bs]\n-- Remember also that we might have forall z (a:z). blah\n--  so we must proceed one binder at a time (Trac #13879)\n\ncan_eq_nc_forall ev eq_rel s1 s2\n | CtWanted { ctev_loc = loc, ctev_dest = orig_dest } <- ev\n = do { let free_tvs       = tyCoVarsOfTypes [s1,s2]\n            (bndrs1, phi1) = tcSplitForAllVarBndrs s1\n            (bndrs2, phi2) = tcSplitForAllVarBndrs s2\n      ; if not (equalLength bndrs1 bndrs2)\n        then do { traceTcS \"Forall failure\" $\n                     vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2\n                          , ppr (map binderArgFlag bndrs1)\n                          , ppr (map binderArgFlag bndrs2) ]\n                ; canEqHardFailure ev s1 s2 }\n        else\n   do { traceTcS \"Creating implication for polytype equality\" $ ppr ev\n      ; let empty_subst1 = mkEmptyTCvSubst $ mkInScopeSet free_tvs\n      ; (subst1, skol_tvs) <- tcInstSkolTyVarsX empty_subst1 $\n                              binderVars bndrs1\n\n      ; let skol_info = UnifyForAllSkol phi1\n            phi1' = substTy subst1 phi1\n\n            -- Unify the kinds, extend the substitution\n            go :: [TcTyVar] -> TCvSubst -> [TyVarBinder]\n               -> TcS (TcCoercion, Cts)\n            go (skol_tv:skol_tvs) subst (bndr2:bndrs2)\n              = do { let tv2 = binderVar bndr2\n                   ; (kind_co, wanteds1) <- unify loc Nominal (tyVarKind skol_tv)\n                                                  (substTy subst (tyVarKind tv2))\n                   ; let subst' = extendTvSubst subst tv2\n                                       (mkCastTy (mkTyVarTy skol_tv) kind_co)\n                   ; (co, wanteds2) <- go skol_tvs subst' bndrs2\n                   ; return ( mkTcForAllCo skol_tv kind_co co\n                            , wanteds1 `unionBags` wanteds2 ) }\n\n            -- Done: unify phi1 ~ phi2\n            go [] subst bndrs2\n              = ASSERT( null bndrs2 )\n                unify loc (eqRelRole eq_rel) phi1' (substTy subst phi2)\n\n            go _ _ _ = panic \"cna_eq_nc_forall\"  -- case (s:ss) []\n\n            empty_subst2 = mkEmptyTCvSubst (getTCvInScope subst1)\n\n      ; all_co <- checkTvConstraintsTcS skol_info skol_tvs $\n                  go skol_tvs empty_subst2 bndrs2\n\n      ; setWantedEq orig_dest all_co\n      ; stopWith ev \"Deferred polytype equality\" } }\n\n | otherwise\n = do { traceTcS \"Omitting decomposition of given polytype equality\" $\n        pprEq s1 s2    -- See Note [Do not decompose given polytype equalities]\n      ; stopWith ev \"Discard given polytype equality\" }\n\n where\n    unify :: CtLoc -> Role -> TcType -> TcType -> TcS (TcCoercion, Cts)\n    -- This version returns the wanted constraint rather\n    -- than putting it in the work list\n    unify loc role ty1 ty2\n      | ty1 `tcEqType` ty2\n      = return (mkTcReflCo role ty1, emptyBag)\n      | otherwise\n      = do { (wanted, co) <- newWantedEq loc role ty1 ty2\n           ; return (co, unitBag (mkNonCanonical wanted)) }\n\n---------------------------------\n-- | Compare types for equality, while zonking as necessary. Gives up\n-- as soon as it finds that two types are not equal.\n-- This is quite handy when some unification has made two\n-- types in an inert Wanted to be equal. We can discover the equality without\n-- flattening, which is sometimes very expensive (in the case of type functions).\n-- In particular, this function makes a ~20% improvement in test case\n-- perf/compiler/T5030.\n--\n-- Returns either the (partially zonked) types in the case of\n-- inequality, or the one type in the case of equality. canEqReflexive is\n-- a good next step in the 'Right' case. Returning 'Left' is always safe.\n--\n-- NB: This does *not* look through type synonyms. In fact, it treats type\n-- synonyms as rigid constructors. In the future, it might be convenient\n-- to look at only those arguments of type synonyms that actually appear\n-- in the synonym RHS. But we're not there yet.\nzonk_eq_types :: TcType -> TcType -> TcS (Either (Pair TcType) TcType)\nzonk_eq_types = go\n  where\n    go (TyVarTy tv1) (TyVarTy tv2) = tyvar_tyvar tv1 tv2\n    go (TyVarTy tv1) ty2           = tyvar NotSwapped tv1 ty2\n    go ty1 (TyVarTy tv2)           = tyvar IsSwapped  tv2 ty1\n\n    -- We handle FunTys explicitly here despite the fact that they could also be\n    -- treated as an application. Why? Well, for one it's cheaper to just look\n    -- at two types (the argument and result types) than four (the argument,\n    -- result, and their RuntimeReps). Also, we haven't completely zonked yet,\n    -- so we may run into an unzonked type variable while trying to compute the\n    -- RuntimeReps of the argument and result types. This can be observed in\n    -- testcase tc269.\n    go ty1 ty2\n      | Just (arg1, res1) <- split1\n      , Just (arg2, res2) <- split2\n      = do { res_a <- go arg1 arg2\n           ; res_b <- go res1 res2\n           ; return $ combine_rev mkVisFunTy res_b res_a\n           }\n      | isJust split1 || isJust split2\n      = bale_out ty1 ty2\n      where\n        split1 = tcSplitFunTy_maybe ty1\n        split2 = tcSplitFunTy_maybe ty2\n\n    go ty1 ty2\n      | Just (tc1, tys1) <- repSplitTyConApp_maybe ty1\n      , Just (tc2, tys2) <- repSplitTyConApp_maybe ty2\n      = if tc1 == tc2 && tys1 `equalLength` tys2\n          -- Crucial to check for equal-length args, because\n          -- we cannot assume that the two args to 'go' have\n          -- the same kind.  E.g go (Proxy *      (Maybe Int))\n          --                        (Proxy (*->*) Maybe)\n          -- We'll call (go (Maybe Int) Maybe)\n          -- See Trac #13083\n        then tycon tc1 tys1 tys2\n        else bale_out ty1 ty2\n\n    go ty1 ty2\n      | Just (ty1a, ty1b) <- tcRepSplitAppTy_maybe ty1\n      , Just (ty2a, ty2b) <- tcRepSplitAppTy_maybe ty2\n      = do { res_a <- go ty1a ty2a\n           ; res_b <- go ty1b ty2b\n           ; return $ combine_rev mkAppTy res_b res_a }\n\n    go ty1@(LitTy lit1) (LitTy lit2)\n      | lit1 == lit2\n      = return (Right ty1)\n\n    go ty1 ty2 = bale_out ty1 ty2\n      -- We don't handle more complex forms here\n\n    bale_out ty1 ty2 = return $ Left (Pair ty1 ty2)\n\n    tyvar :: SwapFlag -> TcTyVar -> TcType\n          -> TcS (Either (Pair TcType) TcType)\n      -- Try to do as little as possible, as anything we do here is redundant\n      -- with flattening. In particular, no need to zonk kinds. That's why\n      -- we don't use the already-defined zonking functions\n    tyvar swapped tv ty\n      = case tcTyVarDetails tv of\n          MetaTv { mtv_ref = ref }\n            -> do { cts <- readTcRef ref\n                  ; case cts of\n                      Flexi        -> give_up\n                      Indirect ty' -> do { trace_indirect tv ty'\n                                         ; unSwap swapped go ty' ty } }\n          _ -> give_up\n      where\n        give_up = return $ Left $ unSwap swapped Pair (mkTyVarTy tv) ty\n\n    tyvar_tyvar tv1 tv2\n      | tv1 == tv2 = return (Right (mkTyVarTy tv1))\n      | otherwise  = do { (ty1', progress1) <- quick_zonk tv1\n                        ; (ty2', progress2) <- quick_zonk tv2\n                        ; if progress1 || progress2\n                          then go ty1' ty2'\n                          else return $ Left (Pair (TyVarTy tv1) (TyVarTy tv2)) }\n\n    trace_indirect tv ty\n       = traceTcS \"Following filled tyvar (zonk_eq_types)\"\n                  (ppr tv <+> equals <+> ppr ty)\n\n    quick_zonk tv = case tcTyVarDetails tv of\n      MetaTv { mtv_ref = ref }\n        -> do { cts <- readTcRef ref\n              ; case cts of\n                  Flexi        -> return (TyVarTy tv, False)\n                  Indirect ty' -> do { trace_indirect tv ty'\n                                     ; return (ty', True) } }\n      _ -> return (TyVarTy tv, False)\n\n      -- This happens for type families, too. But recall that failure\n      -- here just means to try harder, so it's OK if the type function\n      -- isn't injective.\n    tycon :: TyCon -> [TcType] -> [TcType]\n          -> TcS (Either (Pair TcType) TcType)\n    tycon tc tys1 tys2\n      = do { results <- zipWithM go tys1 tys2\n           ; return $ case combine_results results of\n               Left tys  -> Left (mkTyConApp tc <$> tys)\n               Right tys -> Right (mkTyConApp tc tys) }\n\n    combine_results :: [Either (Pair TcType) TcType]\n                    -> Either (Pair [TcType]) [TcType]\n    combine_results = bimap (fmap reverse) reverse .\n                      foldl' (combine_rev (:)) (Right [])\n\n      -- combine (in reverse) a new result onto an already-combined result\n    combine_rev :: (a -> b -> c)\n                -> Either (Pair b) b\n                -> Either (Pair a) a\n                -> Either (Pair c) c\n    combine_rev f (Left list) (Left elt) = Left (f <$> elt     <*> list)\n    combine_rev f (Left list) (Right ty) = Left (f <$> pure ty <*> list)\n    combine_rev f (Right tys) (Left elt) = Left (f <$> elt     <*> pure tys)\n    combine_rev f (Right tys) (Right ty) = Right (f ty tys)\n\n{- See Note [Unwrap newtypes first]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  newtype N m a = MkN (m a)\nThen N will get a conservative, Nominal role for its second parameter 'a',\nbecause it appears as an argument to the unknown 'm'. Now consider\n  [W] N Maybe a  ~R#  N Maybe b\n\nIf we decompose, we'll get\n  [W] a ~N# b\n\nBut if instead we unwrap we'll get\n  [W] Maybe a ~R# Maybe b\nwhich in turn gives us\n  [W] a ~R# b\nwhich is easier to satisfy.\n\nBottom line: unwrap newtypes before decomposing them!\nc.f. Trac #9123 comment:52,53 for a compelling example.\n\nNote [Newtypes can blow the stack]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n  newtype X = MkX (Int -> X)\n  newtype Y = MkY (Int -> Y)\n\nand now wish to prove\n\n  [W] X ~R Y\n\nThis Wanted will loop, expanding out the newtypes ever deeper looking\nfor a solid match or a solid discrepancy. Indeed, there is something\nappropriate to this looping, because X and Y *do* have the same representation,\nin the limit -- they're both (Fix ((->) Int)). However, no finitely-sized\ncoercion will ever witness it. This loop won't actually cause GHC to hang,\nthough, because we check our depth when unwrapping newtypes.\n\nNote [Eager reflexivity check]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n  newtype X = MkX (Int -> X)\n\nand\n\n  [W] X ~R X\n\nNaively, we would start unwrapping X and end up in a loop. Instead,\nwe do this eager reflexivity check. This is necessary only for representational\nequality because the flattener technology deals with the similar case\n(recursive type families) for nominal equality.\n\nNote that this check does not catch all cases, but it will catch the cases\nwe're most worried about, types like X above that are actually inhabited.\n\nHere's another place where this reflexivity check is key:\nConsider trying to prove (f a) ~R (f a). The AppTys in there can't\nbe decomposed, because representational equality isn't congruent with respect\nto AppTy. So, when canonicalising the equality above, we get stuck and\nwould normally produce a CIrredCan. However, we really do want to\nbe able to solve (f a) ~R (f a). So, in the representational case only,\nwe do a reflexivity check.\n\n(This would be sound in the nominal case, but unnecessary, and I [Richard\nE.] am worried that it would slow down the common case.)\n-}\n\n------------------------\n-- | We're able to unwrap a newtype. Update the bits accordingly.\ncan_eq_newtype_nc :: CtEvidence           -- ^ :: ty1 ~ ty2\n                  -> SwapFlag\n                  -> TcType                                    -- ^ ty1\n                  -> ((Bag GlobalRdrElt, TcCoercion), TcType)  -- ^ :: ty1 ~ ty1'\n                  -> TcType               -- ^ ty2\n                  -> TcType               -- ^ ty2, with type synonyms\n                  -> TcS (StopOrContinue Ct)\ncan_eq_newtype_nc ev swapped ty1 ((gres, co), ty1') ty2 ps_ty2\n  = do { traceTcS \"can_eq_newtype_nc\" $\n         vcat [ ppr ev, ppr swapped, ppr co, ppr gres, ppr ty1', ppr ty2 ]\n\n         -- check for blowing our stack:\n         -- See Note [Newtypes can blow the stack]\n       ; checkReductionDepth (ctEvLoc ev) ty1\n       ; addUsedGREs (bagToList gres)\n           -- we have actually used the newtype constructor here, so\n           -- make sure we don't warn about importing it!\n\n       ; new_ev <- rewriteEqEvidence ev swapped ty1' ps_ty2\n                                     (mkTcSymCo co) (mkTcReflCo Representational ps_ty2)\n       ; can_eq_nc False new_ev ReprEq ty1' ty1' ty2 ps_ty2 }\n\n---------\n-- ^ Decompose a type application.\n-- All input types must be flat. See Note [Canonicalising type applications]\n-- Nominal equality only!\ncan_eq_app :: CtEvidence       -- :: s1 t1 ~N s2 t2\n           -> Xi -> Xi         -- s1 t1\n           -> Xi -> Xi         -- s2 t2\n           -> TcS (StopOrContinue Ct)\n\n-- AppTys only decompose for nominal equality, so this case just leads\n-- to an irreducible constraint; see typecheck/should_compile/T10494\n-- See Note [Decomposing equality], note {4}\ncan_eq_app ev s1 t1 s2 t2\n  | CtDerived { ctev_loc = loc } <- ev\n  = do { unifyDeriveds loc [Nominal, Nominal] [s1, t1] [s2, t2]\n       ; stopWith ev \"Decomposed [D] AppTy\" }\n  | CtWanted { ctev_dest = dest, ctev_loc = loc } <- ev\n  = do { co_s <- unifyWanted loc Nominal s1 s2\n       ; let arg_loc\n               | isNextArgVisible s1 = loc\n               | otherwise           = updateCtLocOrigin loc toInvisibleOrigin\n       ; co_t <- unifyWanted arg_loc Nominal t1 t2\n       ; let co = mkAppCo co_s co_t\n       ; setWantedEq dest co\n       ; stopWith ev \"Decomposed [W] AppTy\" }\n\n    -- If there is a ForAll/(->) mismatch, the use of the Left coercion\n    -- below is ill-typed, potentially leading to a panic in splitTyConApp\n    -- Test case: typecheck/should_run/Typeable1\n    -- We could also include this mismatch check above (for W and D), but it's slow\n    -- and we'll get a better error message not doing it\n  | s1k `mismatches` s2k\n  = canEqHardFailure ev (s1 `mkAppTy` t1) (s2 `mkAppTy` t2)\n\n  | CtGiven { ctev_evar = evar, ctev_loc = loc } <- ev\n  = do { let co   = mkTcCoVarCo evar\n             co_s = mkTcLRCo CLeft  co\n             co_t = mkTcLRCo CRight co\n       ; evar_s <- newGivenEvVar loc ( mkTcEqPredLikeEv ev s1 s2\n                                     , evCoercion co_s )\n       ; evar_t <- newGivenEvVar loc ( mkTcEqPredLikeEv ev t1 t2\n                                     , evCoercion co_t )\n       ; emitWorkNC [evar_t]\n       ; canEqNC evar_s NomEq s1 s2 }\n\n  where\n    s1k = tcTypeKind s1\n    s2k = tcTypeKind s2\n\n    k1 `mismatches` k2\n      =  isForAllTy k1 && not (isForAllTy k2)\n      || not (isForAllTy k1) && isForAllTy k2\n\n-----------------------\n-- | Break apart an equality over a casted type\n-- looking like   (ty1 |> co1) ~ ty2   (modulo a swap-flag)\ncanEqCast :: Bool         -- are both types flat?\n          -> CtEvidence\n          -> EqRel\n          -> SwapFlag\n          -> TcType -> Coercion   -- LHS (res. RHS), ty1 |> co1\n          -> TcType -> TcType     -- RHS (res. LHS), ty2 both normal and pretty\n          -> TcS (StopOrContinue Ct)\ncanEqCast flat ev eq_rel swapped ty1 co1 ty2 ps_ty2\n  = do { traceTcS \"Decomposing cast\" (vcat [ ppr ev\n                                           , ppr ty1 <+> text \"|>\" <+> ppr co1\n                                           , ppr ps_ty2 ])\n       ; new_ev <- rewriteEqEvidence ev swapped ty1 ps_ty2\n                                     (mkTcGReflRightCo role ty1 co1)\n                                     (mkTcReflCo role ps_ty2)\n       ; can_eq_nc flat new_ev eq_rel ty1 ty1 ty2 ps_ty2 }\n  where\n    role = eqRelRole eq_rel\n\n------------------------\ncanTyConApp :: CtEvidence -> EqRel\n            -> TyCon -> [TcType]\n            -> TyCon -> [TcType]\n            -> TcS (StopOrContinue Ct)\n-- See Note [Decomposing TyConApps]\ncanTyConApp ev eq_rel tc1 tys1 tc2 tys2\n  | tc1 == tc2\n  , tys1 `equalLength` tys2\n  = do { inerts <- getTcSInerts\n       ; if can_decompose inerts\n         then do { traceTcS \"canTyConApp\"\n                       (ppr ev $$ ppr eq_rel $$ ppr tc1 $$ ppr tys1 $$ ppr tys2)\n                 ; canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2\n                 ; stopWith ev \"Decomposed TyConApp\" }\n         else canEqFailure ev eq_rel ty1 ty2 }\n\n  -- See Note [Skolem abstract data] (at tyConSkolem)\n  | tyConSkolem tc1 || tyConSkolem tc2\n  = do { traceTcS \"canTyConApp: skolem abstract\" (ppr tc1 $$ ppr tc2)\n       ; continueWith (mkIrredCt ev) }\n\n  -- Fail straight away for better error messages\n  -- See Note [Use canEqFailure in canDecomposableTyConApp]\n  | eq_rel == ReprEq && not (isGenerativeTyCon tc1 Representational &&\n                             isGenerativeTyCon tc2 Representational)\n  = canEqFailure ev eq_rel ty1 ty2\n  | otherwise\n  = canEqHardFailure ev ty1 ty2\n  where\n    ty1 = mkTyConApp tc1 tys1\n    ty2 = mkTyConApp tc2 tys2\n\n    loc  = ctEvLoc ev\n    pred = ctEvPred ev\n\n     -- See Note [Decomposing equality]\n    can_decompose inerts\n      =  isInjectiveTyCon tc1 (eqRelRole eq_rel)\n      || (ctEvFlavour ev /= Given && isEmptyBag (matchableGivens loc pred inerts))\n\n{-\nNote [Use canEqFailure in canDecomposableTyConApp]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must use canEqFailure, not canEqHardFailure here, because there is\nthe possibility of success if working with a representational equality.\nHere is one case:\n\n  type family TF a where TF Char = Bool\n  data family DF a\n  newtype instance DF Bool = MkDF Int\n\nSuppose we are canonicalising (Int ~R DF (TF a)), where we don't yet\nknow `a`. This is *not* a hard failure, because we might soon learn\nthat `a` is, in fact, Char, and then the equality succeeds.\n\nHere is another case:\n\n  [G] Age ~R Int\n\nwhere Age's constructor is not in scope. We don't want to report\nan \"inaccessible code\" error in the context of this Given!\n\nFor example, see typecheck/should_compile/T10493, repeated here:\n\n  import Data.Ord (Down)  -- no constructor\n\n  foo :: Coercible (Down Int) Int => Down Int -> Int\n  foo = coerce\n\nThat should compile, but only because we use canEqFailure and not\ncanEqHardFailure.\n\nNote [Decomposing equality]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have a constraint (of any flavour and role) that looks like\nT tys1 ~ T tys2, what can we conclude about tys1 and tys2? The answer,\nof course, is \"it depends\". This Note spells it all out.\n\nIn this Note, \"decomposition\" refers to taking the constraint\n  [fl] (T tys1 ~X T tys2)\n(for some flavour fl and some role X) and replacing it with\n  [fls'] (tys1 ~Xs' tys2)\nwhere that notation indicates a list of new constraints, where the\nnew constraints may have different flavours and different roles.\n\nThe key property to consider is injectivity. When decomposing a Given the\ndecomposition is sound if and only if T is injective in all of its type\narguments. When decomposing a Wanted, the decomposition is sound (assuming the\ncorrect roles in the produced equality constraints), but it may be a guess --\nthat is, an unforced decision by the constraint solver. Decomposing Wanteds\nover injective TyCons does not entail guessing. But sometimes we want to\ndecompose a Wanted even when the TyCon involved is not injective! (See below.)\n\nSo, in broad strokes, we want this rule:\n\n(*) Decompose a constraint (T tys1 ~X T tys2) if and only if T is injective\nat role X.\n\nPursuing the details requires exploring three axes:\n* Flavour: Given vs. Derived vs. Wanted\n* Role: Nominal vs. Representational\n* TyCon species: datatype vs. newtype vs. data family vs. type family vs. type variable\n\n(So a type variable isn't a TyCon, but it's convenient to put the AppTy case\nin the same table.)\n\nRight away, we can say that Derived behaves just as Wanted for the purposes\nof decomposition. The difference between Derived and Wanted is the handling of\nevidence. Since decomposition in these cases isn't a matter of soundness but of\nguessing, we want the same behavior regardless of evidence.\n\nHere is a table (discussion following) detailing where decomposition of\n   (T s1 ... sn) ~r (T t1 .. tn)\nis allowed.  The first four lines (Data types ... type family) refer\nto TyConApps with various TyCons T; the last line is for AppTy, where\nthere is presumably a type variable at the head, so it's actually\n   (s s1 ... sn) ~r (t t1 .. tn)\n\nNOMINAL               GIVEN                       WANTED\n\nDatatype               YES                         YES\nNewtype                YES                         YES\nData family            YES                         YES\nType family            YES, in injective args{1}   YES, in injective args{1}\nType variable          YES                         YES\n\nREPRESENTATIONAL      GIVEN                       WANTED\n\nDatatype               YES                         YES\nNewtype                NO{2}                      MAYBE{2}\nData family            NO{3}                      MAYBE{3}\nType family             NO                          NO\nType variable          NO{4}                       NO{4}\n\n{1}: Type families can be injective in some, but not all, of their arguments,\nso we want to do partial decomposition. This is quite different than the way\nother decomposition is done, where the decomposed equalities replace the original\none. We thus proceed much like we do with superclasses: emitting new Givens\nwhen \"decomposing\" a partially-injective type family Given and new Deriveds\nwhen \"decomposing\" a partially-injective type family Wanted. (As of the time of\nwriting, 13 June 2015, the implementation of injective type families has not\nbeen merged, but it should be soon. Please delete this parenthetical if the\nimplementation is indeed merged.)\n\n{2}: See Note [Decomposing newtypes at representational role]\n\n{3}: Because of the possibility of newtype instances, we must treat\ndata families like newtypes. See also Note [Decomposing newtypes at\nrepresentational role]. See #10534 and test case\ntypecheck/should_fail/T10534.\n\n{4}: Because type variables can stand in for newtypes, we conservatively do not\ndecompose AppTys over representational equality.\n\nIn the implementation of can_eq_nc and friends, we don't directly pattern\nmatch using lines like in the tables above, as those tables don't cover\nall cases (what about PrimTyCon? tuples?). Instead we just ask about injectivity,\nboiling the tables above down to rule (*). The exceptions to rule (*) are for\ninjective type families, which are handled separately from other decompositions,\nand the MAYBE entries above.\n\nNote [Decomposing newtypes at representational role]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis note discusses the 'newtype' line in the REPRESENTATIONAL table\nin Note [Decomposing equality]. (At nominal role, newtypes are fully\ndecomposable.)\n\nHere is a representative example of why representational equality over\nnewtypes is tricky:\n\n  newtype Nt a = Mk Bool         -- NB: a is not used in the RHS,\n  type role Nt representational  -- but the user gives it an R role anyway\n\nIf we have [W] Nt alpha ~R Nt beta, we *don't* want to decompose to\n[W] alpha ~R beta, because it's possible that alpha and beta aren't\nrepresentationally equal. Here's another example.\n\n  newtype Nt a = MkNt (Id a)\n  type family Id a where Id a = a\n\n  [W] Nt Int ~R Nt Age\n\nBecause of its use of a type family, Nt's parameter will get inferred to have\na nominal role. Thus, decomposing the wanted will yield [W] Int ~N Age, which\nis unsatisfiable. Unwrapping, though, leads to a solution.\n\nConclusion:\n * Unwrap newtypes before attempting to decompose them.\n   This is done in can_eq_nc'.\n\nIt all comes from the fact that newtypes aren't necessarily injective\nw.r.t. representational equality.\n\nFurthermore, as explained in Note [NthCo and newtypes] in TyCoRep, we can't use\nNthCo on representational coercions over newtypes. NthCo comes into play\nonly when decomposing givens.\n\nConclusion:\n * Do not decompose [G] N s ~R N t\n\nIs it sensible to decompose *Wanted* constraints over newtypes?  Yes!\nIt's the only way we could ever prove (IO Int ~R IO Age), recalling\nthat IO is a newtype.\n\nHowever we must be careful.  Consider\n\n  type role Nt representational\n\n  [G] Nt a ~R Nt b       (1)\n  [W] NT alpha ~R Nt b   (2)\n  [W] alpha ~ a          (3)\n\nIf we focus on (3) first, we'll substitute in (2), and now it's\nidentical to the given (1), so we succeed.  But if we focus on (2)\nfirst, and decompose it, we'll get (alpha ~R b), which is not soluble.\nThis is exactly like the question of overlapping Givens for class\nconstraints: see Note [Instance and Given overlap] in TcInteract.\n\nConclusion:\n  * Decompose [W] N s ~R N t  iff there no given constraint that could\n    later solve it.\n-}\n\ncanDecomposableTyConAppOK :: CtEvidence -> EqRel\n                          -> TyCon -> [TcType] -> [TcType]\n                          -> TcS ()\n-- Precondition: tys1 and tys2 are the same length, hence \"OK\"\ncanDecomposableTyConAppOK ev eq_rel tc tys1 tys2\n  = ASSERT( tys1 `equalLength` tys2 )\n    case ev of\n     CtDerived {}\n        -> unifyDeriveds loc tc_roles tys1 tys2\n\n     CtWanted { ctev_dest = dest }\n                   -- new_locs and tc_roles are both infinite, so\n                   -- we are guaranteed that cos has the same length\n                   -- as tys1 and tys2\n        -> do { cos <- zipWith4M unifyWanted new_locs tc_roles tys1 tys2\n              ; setWantedEq dest (mkTyConAppCo role tc cos) }\n\n     CtGiven { ctev_evar = evar }\n        -> do { let ev_co = mkCoVarCo evar\n              ; given_evs <- newGivenEvVars loc $\n                             [ ( mkPrimEqPredRole r ty1 ty2\n                               , evCoercion $ mkNthCo r i ev_co )\n                             | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..]\n                             , r /= Phantom\n                             , not (isCoercionTy ty1) && not (isCoercionTy ty2) ]\n              ; emitWorkNC given_evs }\n  where\n    loc        = ctEvLoc ev\n    role       = eqRelRole eq_rel\n\n      -- infinite, as tyConRolesX returns an infinite tail of Nominal\n    tc_roles   = tyConRolesX role tc\n\n      -- Add nuances to the location during decomposition:\n      --  * if the argument is a kind argument, remember this, so that error\n      --    messages say \"kind\", not \"type\". This is determined based on whether\n      --    the corresponding tyConBinder is named (that is, dependent)\n      --  * if the argument is invisible, note this as well, again by\n      --    looking at the corresponding binder\n      -- For oversaturated tycons, we need the (repeat loc) tail, which doesn't\n      -- do either of these changes. (Forgetting to do so led to #16188)\n      --\n      -- NB: infinite in length\n    new_locs = [ new_loc\n               | bndr <- tyConBinders tc\n               , let new_loc0 | isNamedTyConBinder bndr = toKindLoc loc\n                              | otherwise               = loc\n                     new_loc  | isVisibleTyConBinder bndr\n                              = updateCtLocOrigin new_loc0 toInvisibleOrigin\n                              | otherwise\n                              = new_loc0 ]\n               ++ repeat loc\n\n-- | Call when canonicalizing an equality fails, but if the equality is\n-- representational, there is some hope for the future.\n-- Examples in Note [Use canEqFailure in canDecomposableTyConApp]\ncanEqFailure :: CtEvidence -> EqRel\n             -> TcType -> TcType -> TcS (StopOrContinue Ct)\ncanEqFailure ev NomEq ty1 ty2\n  = canEqHardFailure ev ty1 ty2\ncanEqFailure ev ReprEq ty1 ty2\n  = do { (xi1, co1) <- flatten FM_FlattenAll ev ty1\n       ; (xi2, co2) <- flatten FM_FlattenAll ev ty2\n            -- We must flatten the types before putting them in the\n            -- inert set, so that we are sure to kick them out when\n            -- new equalities become available\n       ; traceTcS \"canEqFailure with ReprEq\" $\n         vcat [ ppr ev, ppr ty1, ppr ty2, ppr xi1, ppr xi2 ]\n       ; new_ev <- rewriteEqEvidence ev NotSwapped xi1 xi2 co1 co2\n       ; continueWith (mkIrredCt new_ev) }\n\n-- | Call when canonicalizing an equality fails with utterly no hope.\ncanEqHardFailure :: CtEvidence\n                 -> TcType -> TcType -> TcS (StopOrContinue Ct)\n-- See Note [Make sure that insolubles are fully rewritten]\ncanEqHardFailure ev ty1 ty2\n  = do { (s1, co1) <- flatten FM_SubstOnly ev ty1\n       ; (s2, co2) <- flatten FM_SubstOnly ev ty2\n       ; new_ev <- rewriteEqEvidence ev NotSwapped s1 s2 co1 co2\n       ; continueWith (mkInsolubleCt new_ev) }\n\n{-\nNote [Decomposing TyConApps]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we see (T s1 t1 ~ T s2 t2), then we can just decompose to\n  (s1 ~ s2, t1 ~ t2)\nand push those back into the work list.  But if\n  s1 = K k1    s2 = K k2\nthen we will just decomopose s1~s2, and it might be better to\ndo so on the spot.  An important special case is where s1=s2,\nand we get just Refl.\n\nSo canDecomposableTyCon is a fast-path decomposition that uses\nunifyWanted etc to short-cut that work.\n\nNote [Canonicalising type applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven (s1 t1) ~ ty2, how should we proceed?\nThe simple things is to see if ty2 is of form (s2 t2), and\ndecompose.  By this time s1 and s2 can't be saturated type\nfunction applications, because those have been dealt with\nby an earlier equation in can_eq_nc, so it is always sound to\ndecompose.\n\nHowever, over-eager decomposition gives bad error messages\nfor things like\n   a b ~ Maybe c\n   e f ~ p -> q\nSuppose (in the first example) we already know a~Array.  Then if we\ndecompose the application eagerly, yielding\n   a ~ Maybe\n   b ~ c\nwe get an error        \"Can't match Array ~ Maybe\",\nbut we'd prefer to get \"Can't match Array b ~ Maybe c\".\n\nSo instead can_eq_wanted_app flattens the LHS and RHS, in the hope of\nreplacing (a b) by (Array b), before using try_decompose_app to\ndecompose it.\n\nNote [Make sure that insolubles are fully rewritten]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen an equality fails, we still want to rewrite the equality\nall the way down, so that it accurately reflects\n (a) the mutable reference substitution in force at start of solving\n (b) any ty-binds in force at this point in solving\nSee Note [Rewrite insolubles] in TcSMonad.\nAnd if we don't do this there is a bad danger that\nTcSimplify.applyTyVarDefaulting will find a variable\nthat has in fact been substituted.\n\nNote [Do not decompose Given polytype equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider [G] (forall a. t1 ~ forall a. t2).  Can we decompose this?\nNo -- what would the evidence look like?  So instead we simply discard\nthis given evidence.\n\n\nNote [Combining insoluble constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs this point we have an insoluble constraint, like Int~Bool.\n\n * If it is Wanted, delete it from the cache, so that subsequent\n   Int~Bool constraints give rise to separate error messages\n\n * But if it is Derived, DO NOT delete from cache.  A class constraint\n   may get kicked out of the inert set, and then have its functional\n   dependency Derived constraints generated a second time. In that\n   case we don't want to get two (or more) error messages by\n   generating two (or more) insoluble fundep constraints from the same\n   class constraint.\n\nNote [No top-level newtypes on RHS of representational equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we're in this situation:\n\n work item:  [W] c1 : a ~R b\n     inert:  [G] c2 : b ~R Id a\n\nwhere\n  newtype Id a = Id a\n\nWe want to make sure canEqTyVar sees [W] a ~R a, after b is flattened\nand the Id newtype is unwrapped. This is assured by requiring only flat\ntypes in canEqTyVar *and* having the newtype-unwrapping check above\nthe tyvar check in can_eq_nc.\n\nNote [Occurs check error]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have an occurs check error, are we necessarily hosed? Say our\ntyvar is tv1 and the type it appears in is xi2. Because xi2 is function\nfree, then if we're computing w.r.t. nominal equality, then, yes, we're\nhosed. Nothing good can come from (a ~ [a]). If we're computing w.r.t.\nrepresentational equality, this is a little subtler. Once again, (a ~R [a])\nis a bad thing, but (a ~R N a) for a newtype N might be just fine. This\nmeans also that (a ~ b a) might be fine, because `b` might become a newtype.\n\nSo, we must check: does tv1 appear in xi2 under any type constructor\nthat is generative w.r.t. representational equality? That's what\nisInsolubleOccursCheck does.\n\nSee also #10715, which induced this addition.\n\nNote [canCFunEqCan]\n~~~~~~~~~~~~~~~~~~~\nFlattening the arguments to a type family can change the kind of the type\nfamily application. As an easy example, consider (Any k) where (k ~ Type)\nis in the inert set. The original (Any k :: k) becomes (Any Type :: Type).\nThe problem here is that the fsk in the CFunEqCan will have the old kind.\n\nThe solution is to come up with a new fsk/fmv of the right kind. For\ngivens, this is easy: just introduce a new fsk and update the flat-cache\nwith the new one. For wanteds, we want to solve the old one if favor of\nthe new one, so we use dischargeFmv. This also kicks out constraints\nfrom the inert set; this behavior is correct, as the kind-change may\nallow more constraints to be solved.\n\nWe use `isTcReflexiveCo`, to ensure that we only use the hetero-kinded case\nif we really need to.  Of course `flattenArgsNom` should return `Refl`\nwhenever possible, but Trac #15577 was an infinite loop because even\nthough the coercion was homo-kinded, `kind_co` was not `Refl`, so we\nmade a new (identical) CFunEqCan, and then the entire process repeated.\n-}\n\ncanCFunEqCan :: CtEvidence\n             -> TyCon -> [TcType]   -- LHS\n             -> TcTyVar             -- RHS\n             -> TcS (StopOrContinue Ct)\n-- ^ Canonicalise a CFunEqCan.  We know that\n--     the arg types are already flat,\n-- and the RHS is a fsk, which we must *not* substitute.\n-- So just substitute in the LHS\ncanCFunEqCan ev fn tys fsk\n  = do { (tys', cos, kind_co) <- flattenArgsNom ev fn tys\n                        -- cos :: tys' ~ tys\n\n       ; let lhs_co  = mkTcTyConAppCo Nominal fn cos\n                        -- :: F tys' ~ F tys\n             new_lhs = mkTyConApp fn tys'\n\n             flav    = ctEvFlavour ev\n       ; (ev', fsk')\n           <- if isTcReflexiveCo kind_co   -- See Note [canCFunEqCan]\n              then do { traceTcS \"canCFunEqCan: refl\" (ppr new_lhs)\n                      ; let fsk_ty = mkTyVarTy fsk\n                      ; ev' <- rewriteEqEvidence ev NotSwapped new_lhs fsk_ty\n                                                 lhs_co (mkTcNomReflCo fsk_ty)\n                      ; return (ev', fsk) }\n              else do { traceTcS \"canCFunEqCan: non-refl\" $\n                        vcat [ text \"Kind co:\" <+> ppr kind_co\n                             , text \"RHS:\" <+> ppr fsk <+> dcolon <+> ppr (tyVarKind fsk)\n                             , text \"LHS:\" <+> hang (ppr (mkTyConApp fn tys))\n                                                  2 (dcolon <+> ppr (tcTypeKind (mkTyConApp fn tys)))\n                             , text \"New LHS\" <+> hang (ppr new_lhs)\n                                                     2 (dcolon <+> ppr (tcTypeKind new_lhs)) ]\n                      ; (ev', new_co, new_fsk)\n                          <- newFlattenSkolem flav (ctEvLoc ev) fn tys'\n                      ; let xi = mkTyVarTy new_fsk `mkCastTy` kind_co\n                               -- sym lhs_co :: F tys ~ F tys'\n                               -- new_co     :: F tys' ~ new_fsk\n                               -- co         :: F tys ~ (new_fsk |> kind_co)\n                            co = mkTcSymCo lhs_co `mkTcTransCo`\n                                 mkTcCoherenceRightCo Nominal\n                                                      (mkTyVarTy new_fsk)\n                                                      kind_co\n                                                      new_co\n\n                      ; traceTcS \"Discharging fmv/fsk due to hetero flattening\" (ppr ev)\n                      ; dischargeFunEq ev fsk co xi\n                      ; return (ev', new_fsk) }\n\n       ; extendFlatCache fn tys' (ctEvCoercion ev', mkTyVarTy fsk', ctEvFlavour ev')\n       ; continueWith (CFunEqCan { cc_ev = ev', cc_fun = fn\n                                 , cc_tyargs = tys', cc_fsk = fsk' }) }\n\n---------------------\ncanEqTyVar :: CtEvidence          -- ev :: lhs ~ rhs\n           -> EqRel -> SwapFlag\n           -> TcTyVar               -- tv1\n           -> TcType                -- lhs: pretty lhs, already flat\n           -> TcType -> TcType      -- rhs: already flat\n           -> TcS (StopOrContinue Ct)\ncanEqTyVar ev eq_rel swapped tv1 ps_ty1 xi2 ps_xi2\n  | k1 `tcEqType` k2\n  = canEqTyVarHomo ev eq_rel swapped tv1 ps_ty1 xi2 ps_xi2\n\n  -- So the LHS and RHS don't have equal kinds\n  -- Note [Flattening] in TcFlatten gives us (F2), which says that\n  -- flattening is always homogeneous (doesn't change kinds). But\n  -- perhaps by flattening the kinds of the two sides of the equality\n  -- at hand makes them equal. So let's try that.\n  | otherwise\n  = do { (flat_k1, k1_co) <- flattenKind loc flav k1  -- k1_co :: flat_k1 ~N kind(xi1)\n       ; (flat_k2, k2_co) <- flattenKind loc flav k2  -- k2_co :: flat_k2 ~N kind(xi2)\n       ; traceTcS \"canEqTyVar tried flattening kinds\"\n                  (vcat [ sep [ parens (ppr tv1 <+> dcolon <+> ppr k1)\n                              , text \"~\"\n                              , parens (ppr xi2 <+> dcolon <+> ppr k2) ]\n                        , ppr flat_k1\n                        , ppr k1_co\n                        , ppr flat_k2\n                        , ppr k2_co ])\n\n         -- We know the LHS is a tyvar. So let's dump all the coercions on the RHS\n         -- If flat_k1 == flat_k2, let's dump all the coercions on the RHS and\n         -- then call canEqTyVarHomo. If they don't equal, just rewriteEqEvidence\n         -- (as an optimization, so that we don't have to flatten the kinds again)\n         -- and then emit a kind equality in canEqTyVarHetero.\n         -- See Note [Equalities with incompatible kinds]\n\n       ; let role = eqRelRole eq_rel\n       ; if flat_k1 `tcEqType` flat_k2\n         then do { let rhs_kind_co = mkTcSymCo k2_co `mkTcTransCo` k1_co\n                         -- :: kind(xi2) ~N kind(xi1)\n\n                       new_rhs     = xi2 `mkCastTy` rhs_kind_co\n                       ps_rhs      = ps_xi2 `mkCastTy` rhs_kind_co\n                       rhs_co      = mkTcGReflLeftCo role xi2 rhs_kind_co\n\n                 ; new_ev <- rewriteEqEvidence ev swapped xi1 new_rhs\n                                               (mkTcReflCo role xi1) rhs_co\n                       -- NB: rewriteEqEvidence executes a swap, if any, so we're\n                       -- NotSwapped now.\n                 ; canEqTyVarHomo new_ev eq_rel NotSwapped tv1 ps_ty1 new_rhs ps_rhs }\n         else\n    do { let sym_k1_co = mkTcSymCo k1_co  -- :: kind(xi1) ~N flat_k1\n             sym_k2_co = mkTcSymCo k2_co  -- :: kind(xi2) ~N flat_k2\n\n             new_lhs = xi1 `mkCastTy` sym_k1_co  -- :: flat_k1\n             new_rhs = xi2 `mkCastTy` sym_k2_co  -- :: flat_k2\n             ps_rhs  = ps_xi2 `mkCastTy` sym_k2_co\n\n             lhs_co = mkTcGReflLeftCo role xi1 sym_k1_co\n             rhs_co = mkTcGReflLeftCo role xi2 sym_k2_co\n               -- lhs_co :: (xi1 |> sym k1_co) ~ xi1\n               -- rhs_co :: (xi2 |> sym k2_co) ~ xi2\n\n       ; new_ev <- rewriteEqEvidence ev swapped new_lhs new_rhs lhs_co rhs_co\n         -- no longer swapped, due to rewriteEqEvidence\n       ; canEqTyVarHetero new_ev eq_rel tv1 sym_k1_co flat_k1 ps_ty1\n                                        new_rhs flat_k2 ps_rhs } }\n  where\n    xi1 = mkTyVarTy tv1\n\n    k1 = tyVarKind tv1\n    k2 = tcTypeKind xi2\n\n    loc  = ctEvLoc ev\n    flav = ctEvFlavour ev\n\ncanEqTyVarHetero :: CtEvidence   -- :: (tv1 |> co1 :: ki1) ~ (xi2 :: ki2)\n                 -> EqRel\n                 -> TcTyVar -> TcCoercionN -> TcKind  -- tv1 |> co1 :: ki1\n                 -> TcType            -- pretty tv1 (*without* the coercion)\n                 -> TcType -> TcKind  -- xi2 :: ki2\n                 -> TcType            -- pretty xi2\n                 -> TcS (StopOrContinue Ct)\ncanEqTyVarHetero ev eq_rel tv1 co1 ki1 ps_tv1 xi2 ki2 ps_xi2\n  -- See Note [Equalities with incompatible kinds]\n  | CtGiven { ctev_evar = evar } <- ev\n    -- unswapped: tm :: (lhs :: ki1) ~ (rhs :: ki2)\n    -- swapped  : tm :: (rhs :: ki2) ~ (lhs :: ki1)\n  = do { let kind_co = mkTcKindCo (mkTcCoVarCo evar)\n       ; kind_ev <- newGivenEvVar kind_loc (kind_pty, evCoercion kind_co)\n       ; let  -- kind_ev :: (ki1 :: *) ~ (ki2 :: *)   (whether swapped or not)\n              -- co1     :: kind(tv1) ~N ki1\n              -- homo_co :: ki2 ~N kind(tv1)\n             homo_co = mkTcSymCo (ctEvCoercion kind_ev) `mkTcTransCo` mkTcSymCo co1\n             rhs'    = mkCastTy xi2 homo_co     -- :: kind(tv1)\n             ps_rhs' = mkCastTy ps_xi2 homo_co  -- :: kind(tv1)\n             rhs_co  = mkTcGReflLeftCo role xi2 homo_co\n               -- rhs_co :: (xi2 |> homo_co :: kind(tv1)) ~ xi2\n\n             lhs'   = mkTyVarTy tv1       -- :: kind(tv1)\n             lhs_co = mkTcGReflRightCo role lhs' co1\n               -- lhs_co :: (tv1 :: kind(tv1)) ~ (tv1 |> co1 :: ki1)\n\n       ; traceTcS \"Hetero equality gives rise to given kind equality\"\n           (ppr kind_ev <+> dcolon <+> ppr kind_pty)\n       ; emitWorkNC [kind_ev]\n       ; type_ev <- rewriteEqEvidence ev NotSwapped lhs' rhs' lhs_co rhs_co\n       ; canEqTyVarHomo type_ev eq_rel NotSwapped tv1 ps_tv1 rhs' ps_rhs' }\n\n  -- See Note [Equalities with incompatible kinds]\n  | otherwise   -- Wanted and Derived\n                -- NB: all kind equalities are Nominal\n  = do { emitNewDerivedEq kind_loc Nominal ki1 ki2\n             -- kind_ev :: (ki1 :: *) ~ (ki2 :: *)\n       ; traceTcS \"Hetero equality gives rise to derived kind equality\" $\n           ppr ev\n       ; continueWith (mkIrredCt ev) }\n\n  where\n    kind_pty = mkHeteroPrimEqPred liftedTypeKind liftedTypeKind ki1 ki2\n    kind_loc = mkKindLoc (mkTyVarTy tv1 `mkCastTy` co1) xi2 loc\n\n    loc  = ctev_loc ev\n    role = eqRelRole eq_rel\n\n-- guaranteed that tcTypeKind lhs == tcTypeKind rhs\ncanEqTyVarHomo :: CtEvidence\n               -> EqRel -> SwapFlag\n               -> TcTyVar                -- lhs: tv1\n               -> TcType                 -- pretty lhs\n               -> TcType -> TcType       -- rhs (might not be flat)\n               -> TcS (StopOrContinue Ct)\ncanEqTyVarHomo ev eq_rel swapped tv1 ps_ty1 ty2 _\n  | Just (tv2, _) <- tcGetCastedTyVar_maybe ty2\n  , tv1 == tv2\n  = canEqReflexive ev eq_rel (mkTyVarTy tv1)\n    -- we don't need to check co because it must be reflexive\n\n  | Just (tv2, co2) <- tcGetCastedTyVar_maybe ty2\n  , swapOverTyVars tv1 tv2\n  = do { traceTcS \"canEqTyVar swapOver\" (ppr tv1 $$ ppr tv2 $$ ppr swapped)\n         -- FM_Avoid commented out: see Note [Lazy flattening] in TcFlatten\n         -- let fmode = FE { fe_ev = ev, fe_mode = FM_Avoid tv1' True }\n         -- Flatten the RHS less vigorously, to avoid gratuitous flattening\n         -- True <=> xi2 should not itself be a type-function application\n\n       ; let role    = eqRelRole eq_rel\n             sym_co2 = mkTcSymCo co2\n             ty1     = mkTyVarTy tv1\n             new_lhs = ty1 `mkCastTy` sym_co2\n             lhs_co  = mkTcGReflLeftCo role ty1 sym_co2\n\n             new_rhs = mkTyVarTy tv2\n             rhs_co  = mkTcGReflRightCo role new_rhs co2\n\n       ; new_ev <- rewriteEqEvidence ev swapped new_lhs new_rhs lhs_co rhs_co\n\n       ; dflags <- getDynFlags\n       ; canEqTyVar2 dflags new_ev eq_rel IsSwapped tv2 (ps_ty1 `mkCastTy` sym_co2) }\n\ncanEqTyVarHomo ev eq_rel swapped tv1 _ _ ps_ty2\n  = do { dflags <- getDynFlags\n       ; canEqTyVar2 dflags ev eq_rel swapped tv1 ps_ty2 }\n\n-- The RHS here is either not a casted tyvar, or it's a tyvar but we want\n-- to rewrite the LHS to the RHS (as per swapOverTyVars)\ncanEqTyVar2 :: DynFlags\n            -> CtEvidence   -- lhs ~ rhs (or, if swapped, orhs ~ olhs)\n            -> EqRel\n            -> SwapFlag\n            -> TcTyVar                  -- lhs = tv, flat\n            -> TcType                   -- rhs\n            -> TcS (StopOrContinue Ct)\n-- LHS is an inert type variable,\n-- and RHS is fully rewritten, but with type synonyms\n-- preserved as much as possible\ncanEqTyVar2 dflags ev eq_rel swapped tv1 rhs\n  | Just rhs' <- metaTyVarUpdateOK dflags tv1 rhs  -- No occurs check\n     -- Must do the occurs check even on tyvar/tyvar\n     -- equalities, in case have  x ~ (y :: ..x...)\n     -- Trac #12593\n  = do { new_ev <- rewriteEqEvidence ev swapped lhs rhs' rewrite_co1 rewrite_co2\n       ; continueWith (CTyEqCan { cc_ev = new_ev, cc_tyvar = tv1\n                                , cc_rhs = rhs', cc_eq_rel = eq_rel }) }\n\n  | otherwise  -- For some reason (occurs check, or forall) we can't unify\n               -- We must not use it for further rewriting!\n  = do { traceTcS \"canEqTyVar2 can't unify\" (ppr tv1 $$ ppr rhs)\n       ; new_ev <- rewriteEqEvidence ev swapped lhs rhs rewrite_co1 rewrite_co2\n       ; if isInsolubleOccursCheck eq_rel tv1 rhs\n         then continueWith (mkInsolubleCt new_ev)\n             -- If we have a ~ [a], it is not canonical, and in particular\n             -- we don't want to rewrite existing inerts with it, otherwise\n             -- we'd risk divergence in the constraint solver\n\n         else continueWith (mkIrredCt new_ev) }\n             -- A representational equality with an occurs-check problem isn't\n             -- insoluble! For example:\n             --   a ~R b a\n             -- We might learn that b is the newtype Id.\n             -- But, the occurs-check certainly prevents the equality from being\n             -- canonical, and we might loop if we were to use it in rewriting.\n  where\n    role = eqRelRole eq_rel\n\n    lhs = mkTyVarTy tv1\n\n    rewrite_co1  = mkTcReflCo role lhs\n    rewrite_co2  = mkTcReflCo role rhs\n\n-- | Solve a reflexive equality constraint\ncanEqReflexive :: CtEvidence    -- ty ~ ty\n               -> EqRel\n               -> TcType        -- ty\n               -> TcS (StopOrContinue Ct)   -- always Stop\ncanEqReflexive ev eq_rel ty\n  = do { setEvBindIfWanted ev (evCoercion $\n                               mkTcReflCo (eqRelRole eq_rel) ty)\n       ; stopWith ev \"Solved by reflexivity\" }\n\n{-\nNote [Canonical orientation for tyvar/tyvar equality constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we have a ~ b where both 'a' and 'b' are TcTyVars, which way\nround should be oriented in the CTyEqCan?  The rules, implemented by\ncanEqTyVarTyVar, are these\n\n * If either is a flatten-meta-variables, it goes on the left.\n\n * Put a meta-tyvar on the left if possible\n       alpha[3] ~ r\n\n * If both are meta-tyvars, put the more touchable one (deepest level\n   number) on the left, so there is the best chance of unifying it\n        alpha[3] ~ beta[2]\n\n * If both are meta-tyvars and both at the same level, put a TyVarTv\n   on the right if possible\n        alpha[2] ~ beta[2](sig-tv)\n   That way, when we unify alpha := beta, we don't lose the TyVarTv flag.\n\n * Put a meta-tv with a System Name on the left if possible so it\n   gets eliminated (improves error messages)\n\n * If one is a flatten-skolem, put it on the left so that it is\n   substituted out  Note [Eliminate flat-skols] in TcUinfy\n        fsk ~ a\n\nNote [Equalities with incompatible kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat do we do when we have an equality\n\n  (tv :: k1) ~ (rhs :: k2)\n\nwhere k1 and k2 differ? This Note explores this treacherous area.\n\nFirst off, the question above is slightly the wrong question. Flattening\na tyvar will flatten its kind (Note [Flattening] in TcFlatten); flattening\nthe kind might introduce a cast. So we might have a casted tyvar on the\nleft. We thus revise our test case to\n\n  (tv |> co :: k1) ~ (rhs :: k2)\n\nWe must proceed differently here depending on whether we have a Wanted\nor a Given. Consider this:\n\n [W] w :: (alpha :: k) ~ (Int :: Type)\n\nwhere k is a skolem. One possible way forward is this:\n\n [W] co :: k ~ Type\n [W] w :: (alpha :: k) ~ (Int |> sym co :: k)\n\nThe next step will be to unify\n\n  alpha := Int |> sym co\n\nNow, consider what error we'll report if we can't solve the \"co\"\nwanted. Its CtOrigin is the w wanted... which now reads (after zonking)\nInt ~ Int. The user thus sees that GHC can't solve Int ~ Int, which\nis embarrassing. See #11198 for more tales of destruction.\n\nThe reason for this odd behavior is much the same as\nNote [Wanteds do not rewrite Wanteds] in TcRnTypes: note that the\nnew `co` is a Wanted.\n\n   The solution is then not to use `co` to \"rewrite\" -- that is, cast\n   -- `w`, but instead to keep `w` heterogeneous and\n   irreducible. Given that we're not using `co`, there is no reason to\n   collect evidence for it, so `co` is born a Derived, with a CtOrigin\n   of KindEqOrigin.\n\nWhen the Derived is solved (by unification), the original wanted (`w`)\nwill get kicked out.\n\nNote that, if we had [G] co1 :: k ~ Type available, then none of this code would\ntrigger, because flattening would have rewritten k to Type. That is,\n`w` would look like [W] (alpha |> co1 :: Type) ~ (Int :: Type), and the tyvar\ncase will trigger, correctly rewriting alpha to (Int |> sym co1).\n\nSuccessive canonicalizations of the same Wanted may produce\nduplicate Deriveds. Similar duplications can happen with fundeps, and there\nseems to be no easy way to avoid. I expect this case to be rare.\n\nFor Givens, this problem doesn't bite, so a heterogeneous Given gives\nrise to a Given kind equality. No Deriveds here. We thus homogenise\nthe Given (see the \"homo_co\" in the Given case in canEqTyVar) and\ncarry on with a homogeneous equality constraint.\n\nSeparately, I (Richard E) spent some time pondering what to do in the case\nthat we have [W] (tv |> co1 :: k1) ~ (tv |> co2 :: k2) where k1 and k2\ndiffer. Note that the tv is the same. (This case is handled as the first\ncase in canEqTyVarHomo.) At one point, I thought we could solve this limited\nform of heterogeneous Wanted, but I then reconsidered and now treat this case\njust like any other heterogeneous Wanted.\n\nNote [Type synonyms and canonicalization]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe treat type synonym applications as xi types, that is, they do not\ncount as type function applications.  However, we do need to be a bit\ncareful with type synonyms: like type functions they may not be\ngenerative or injective.  However, unlike type functions, they are\nparametric, so there is no problem in expanding them whenever we see\nthem, since we do not need to know anything about their arguments in\norder to expand them; this is what justifies not having to treat them\nas specially as type function applications.  The thing that causes\nsome subtleties is that we prefer to leave type synonym applications\n*unexpanded* whenever possible, in order to generate better error\nmessages.\n\nIf we encounter an equality constraint with type synonym applications\non both sides, or a type synonym application on one side and some sort\nof type application on the other, we simply must expand out the type\nsynonyms in order to continue decomposing the equality constraint into\nprimitive equality constraints.  For example, suppose we have\n\n  type F a = [Int]\n\nand we encounter the equality\n\n  F a ~ [b]\n\nIn order to continue we must expand F a into [Int], giving us the\nequality\n\n  [Int] ~ [b]\n\nwhich we can then decompose into the more primitive equality\nconstraint\n\n  Int ~ b.\n\nHowever, if we encounter an equality constraint with a type synonym\napplication on one side and a variable on the other side, we should\nNOT (necessarily) expand the type synonym, since for the purpose of\ngood error messages we want to leave type synonyms unexpanded as much\nas possible.  Hence the ps_ty1, ps_ty2 argument passed to canEqTyVar.\n\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                  Evidence transformation\n*                                                                      *\n************************************************************************\n-}\n\ndata StopOrContinue a\n  = ContinueWith a    -- The constraint was not solved, although it may have\n                      --   been rewritten\n\n  | Stop CtEvidence   -- The (rewritten) constraint was solved\n         SDoc         -- Tells how it was solved\n                      -- Any new sub-goals have been put on the work list\n\ninstance Functor StopOrContinue where\n  fmap f (ContinueWith x) = ContinueWith (f x)\n  fmap _ (Stop ev s)      = Stop ev s\n\ninstance Outputable a => Outputable (StopOrContinue a) where\n  ppr (Stop ev s)      = text \"Stop\" <> parens s <+> ppr ev\n  ppr (ContinueWith w) = text \"ContinueWith\" <+> ppr w\n\ncontinueWith :: a -> TcS (StopOrContinue a)\ncontinueWith = return . ContinueWith\n\nstopWith :: CtEvidence -> String -> TcS (StopOrContinue a)\nstopWith ev s = return (Stop ev (text s))\n\nandWhenContinue :: TcS (StopOrContinue a)\n                -> (a -> TcS (StopOrContinue b))\n                -> TcS (StopOrContinue b)\nandWhenContinue tcs1 tcs2\n  = do { r <- tcs1\n       ; case r of\n           Stop ev s       -> return (Stop ev s)\n           ContinueWith ct -> tcs2 ct }\ninfixr 0 `andWhenContinue`    -- allow chaining with ($)\n\nrewriteEvidence :: CtEvidence   -- old evidence\n                -> TcPredType   -- new predicate\n                -> TcCoercion   -- Of type :: new predicate ~ <type of old evidence>\n                -> TcS (StopOrContinue CtEvidence)\n-- Returns Just new_ev iff either (i)  'co' is reflexivity\n--                             or (ii) 'co' is not reflexivity, and 'new_pred' not cached\n-- In either case, there is nothing new to do with new_ev\n{-\n     rewriteEvidence old_ev new_pred co\nMain purpose: create new evidence for new_pred;\n              unless new_pred is cached already\n* Returns a new_ev : new_pred, with same wanted/given/derived flag as old_ev\n* If old_ev was wanted, create a binding for old_ev, in terms of new_ev\n* If old_ev was given, AND not cached, create a binding for new_ev, in terms of old_ev\n* Returns Nothing if new_ev is already cached\n\n        Old evidence    New predicate is               Return new evidence\n        flavour                                        of same flavor\n        -------------------------------------------------------------------\n        Wanted          Already solved or in inert     Nothing\n        or Derived      Not                            Just new_evidence\n\n        Given           Already in inert               Nothing\n                        Not                            Just new_evidence\n\nNote [Rewriting with Refl]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the coercion is just reflexivity then you may re-use the same\nvariable.  But be careful!  Although the coercion is Refl, new_pred\nmay reflect the result of unification alpha := ty, so new_pred might\nnot _look_ the same as old_pred, and it's vital to proceed from now on\nusing new_pred.\n\nqThe flattener preserves type synonyms, so they should appear in new_pred\nas well as in old_pred; that is important for good error messages.\n -}\n\n\nrewriteEvidence old_ev@(CtDerived {}) new_pred _co\n  = -- If derived, don't even look at the coercion.\n    -- This is very important, DO NOT re-order the equations for\n    -- rewriteEvidence to put the isTcReflCo test first!\n    -- Why?  Because for *Derived* constraints, c, the coercion, which\n    -- was produced by flattening, may contain suspended calls to\n    -- (ctEvExpr c), which fails for Derived constraints.\n    -- (Getting this wrong caused Trac #7384.)\n    continueWith (old_ev { ctev_pred = new_pred })\n\nrewriteEvidence old_ev new_pred co\n  | isTcReflCo co -- See Note [Rewriting with Refl]\n  = continueWith (old_ev { ctev_pred = new_pred })\n\nrewriteEvidence ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) new_pred co\n  = do { new_ev <- newGivenEvVar loc (new_pred, new_tm)\n       ; continueWith new_ev }\n  where\n    -- mkEvCast optimises ReflCo\n    new_tm = mkEvCast (evId old_evar) (tcDowngradeRole Representational\n                                                       (ctEvRole ev)\n                                                       (mkTcSymCo co))\n\nrewriteEvidence ev@(CtWanted { ctev_dest = dest\n                             , ctev_loc = loc }) new_pred co\n  = do { mb_new_ev <- newWanted loc new_pred\n       ; MASSERT( tcCoercionRole co == ctEvRole ev )\n       ; setWantedEvTerm dest\n            (mkEvCast (getEvExpr mb_new_ev)\n                      (tcDowngradeRole Representational (ctEvRole ev) co))\n       ; case mb_new_ev of\n            Fresh  new_ev -> continueWith new_ev\n            Cached _      -> stopWith ev \"Cached wanted\" }\n\n\nrewriteEqEvidence :: CtEvidence         -- Old evidence :: olhs ~ orhs (not swapped)\n                                        --              or orhs ~ olhs (swapped)\n                  -> SwapFlag\n                  -> TcType -> TcType   -- New predicate  nlhs ~ nrhs\n                                        -- Should be zonked, because we use tcTypeKind on nlhs/nrhs\n                  -> TcCoercion         -- lhs_co, of type :: nlhs ~ olhs\n                  -> TcCoercion         -- rhs_co, of type :: nrhs ~ orhs\n                  -> TcS CtEvidence     -- Of type nlhs ~ nrhs\n-- For (rewriteEqEvidence (Given g olhs orhs) False nlhs nrhs lhs_co rhs_co)\n-- we generate\n-- If not swapped\n--      g1 : nlhs ~ nrhs = lhs_co ; g ; sym rhs_co\n-- If 'swapped'\n--      g1 : nlhs ~ nrhs = lhs_co ; Sym g ; sym rhs_co\n--\n-- For (Wanted w) we do the dual thing.\n-- New  w1 : nlhs ~ nrhs\n-- If not swapped\n--      w : olhs ~ orhs = sym lhs_co ; w1 ; rhs_co\n-- If swapped\n--      w : orhs ~ olhs = sym rhs_co ; sym w1 ; lhs_co\n--\n-- It's all a form of rewwriteEvidence, specialised for equalities\nrewriteEqEvidence old_ev swapped nlhs nrhs lhs_co rhs_co\n  | CtDerived {} <- old_ev  -- Don't force the evidence for a Derived\n  = return (old_ev { ctev_pred = new_pred })\n\n  | NotSwapped <- swapped\n  , isTcReflCo lhs_co      -- See Note [Rewriting with Refl]\n  , isTcReflCo rhs_co\n  = return (old_ev { ctev_pred = new_pred })\n\n  | CtGiven { ctev_evar = old_evar } <- old_ev\n  = do { let new_tm = evCoercion (lhs_co\n                                  `mkTcTransCo` maybeSym swapped (mkTcCoVarCo old_evar)\n                                  `mkTcTransCo` mkTcSymCo rhs_co)\n       ; newGivenEvVar loc' (new_pred, new_tm) }\n\n  | CtWanted { ctev_dest = dest } <- old_ev\n  = do { (new_ev, hole_co) <- newWantedEq loc' (ctEvRole old_ev) nlhs nrhs\n       ; let co = maybeSym swapped $\n                  mkSymCo lhs_co\n                  `mkTransCo` hole_co\n                  `mkTransCo` rhs_co\n       ; setWantedEq dest co\n       ; traceTcS \"rewriteEqEvidence\" (vcat [ppr old_ev, ppr nlhs, ppr nrhs, ppr co])\n       ; return new_ev }\n\n  | otherwise\n  = panic \"rewriteEvidence\"\n  where\n    new_pred = mkTcEqPredLikeEv old_ev nlhs nrhs\n\n      -- equality is like a type class. Bumping the depth is necessary because\n      -- of recursive newtypes, where \"reducing\" a newtype can actually make\n      -- it bigger. See Note [Newtypes can blow the stack].\n    loc      = ctEvLoc old_ev\n    loc'     = bumpCtLocDepth loc\n\n{- Note [unifyWanted and unifyDerived]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen decomposing equalities we often create new wanted constraints for\n(s ~ t).  But what if s=t?  Then it'd be faster to return Refl right away.\nSimilar remarks apply for Derived.\n\nRather than making an equality test (which traverses the structure of the\ntype, perhaps fruitlessly), unifyWanted traverses the common structure, and\nbales out when it finds a difference by creating a new Wanted constraint.\nBut where it succeeds in finding common structure, it just builds a coercion\nto reflect it.\n-}\n\nunifyWanted :: CtLoc -> Role\n            -> TcType -> TcType -> TcS Coercion\n-- Return coercion witnessing the equality of the two types,\n-- emitting new work equalities where necessary to achieve that\n-- Very good short-cut when the two types are equal, or nearly so\n-- See Note [unifyWanted and unifyDerived]\n-- The returned coercion's role matches the input parameter\nunifyWanted loc Phantom ty1 ty2\n  = do { kind_co <- unifyWanted loc Nominal (tcTypeKind ty1) (tcTypeKind ty2)\n       ; return (mkPhantomCo kind_co ty1 ty2) }\n\nunifyWanted loc role orig_ty1 orig_ty2\n  = go orig_ty1 orig_ty2\n  where\n    go ty1 ty2 | Just ty1' <- tcView ty1 = go ty1' ty2\n    go ty1 ty2 | Just ty2' <- tcView ty2 = go ty1 ty2'\n\n    go (FunTy _ s1 t1) (FunTy _ s2 t2)\n      = do { co_s <- unifyWanted loc role s1 s2\n           ; co_t <- unifyWanted loc role t1 t2\n           ; return (mkFunCo role co_s co_t) }\n    go (TyConApp tc1 tys1) (TyConApp tc2 tys2)\n      | tc1 == tc2, tys1 `equalLength` tys2\n      , isInjectiveTyCon tc1 role -- don't look under newtypes at Rep equality\n      = do { cos <- zipWith3M (unifyWanted loc)\n                              (tyConRolesX role tc1) tys1 tys2\n           ; return (mkTyConAppCo role tc1 cos) }\n\n    go ty1@(TyVarTy tv) ty2\n      = do { mb_ty <- isFilledMetaTyVar_maybe tv\n           ; case mb_ty of\n                Just ty1' -> go ty1' ty2\n                Nothing   -> bale_out ty1 ty2}\n    go ty1 ty2@(TyVarTy tv)\n      = do { mb_ty <- isFilledMetaTyVar_maybe tv\n           ; case mb_ty of\n                Just ty2' -> go ty1 ty2'\n                Nothing   -> bale_out ty1 ty2 }\n\n    go ty1@(CoercionTy {}) (CoercionTy {})\n      = return (mkReflCo role ty1) -- we just don't care about coercions!\n\n    go ty1 ty2 = bale_out ty1 ty2\n\n    bale_out ty1 ty2\n       | ty1 `tcEqType` ty2 = return (mkTcReflCo role ty1)\n        -- Check for equality; e.g. a ~ a, or (m a) ~ (m a)\n       | otherwise = emitNewWantedEq loc role orig_ty1 orig_ty2\n\nunifyDeriveds :: CtLoc -> [Role] -> [TcType] -> [TcType] -> TcS ()\n-- See Note [unifyWanted and unifyDerived]\nunifyDeriveds loc roles tys1 tys2 = zipWith3M_ (unify_derived loc) roles tys1 tys2\n\nunifyDerived :: CtLoc -> Role -> Pair TcType -> TcS ()\n-- See Note [unifyWanted and unifyDerived]\nunifyDerived loc role (Pair ty1 ty2) = unify_derived loc role ty1 ty2\n\nunify_derived :: CtLoc -> Role -> TcType -> TcType -> TcS ()\n-- Create new Derived and put it in the work list\n-- Should do nothing if the two types are equal\n-- See Note [unifyWanted and unifyDerived]\nunify_derived _   Phantom _        _        = return ()\nunify_derived loc role    orig_ty1 orig_ty2\n  = go orig_ty1 orig_ty2\n  where\n    go ty1 ty2 | Just ty1' <- tcView ty1 = go ty1' ty2\n    go ty1 ty2 | Just ty2' <- tcView ty2 = go ty1 ty2'\n\n    go (FunTy _ s1 t1) (FunTy _ s2 t2)\n      = do { unify_derived loc role s1 s2\n           ; unify_derived loc role t1 t2 }\n    go (TyConApp tc1 tys1) (TyConApp tc2 tys2)\n      | tc1 == tc2, tys1 `equalLength` tys2\n      , isInjectiveTyCon tc1 role\n      = unifyDeriveds loc (tyConRolesX role tc1) tys1 tys2\n    go ty1@(TyVarTy tv) ty2\n      = do { mb_ty <- isFilledMetaTyVar_maybe tv\n           ; case mb_ty of\n                Just ty1' -> go ty1' ty2\n                Nothing   -> bale_out ty1 ty2 }\n    go ty1 ty2@(TyVarTy tv)\n      = do { mb_ty <- isFilledMetaTyVar_maybe tv\n           ; case mb_ty of\n                Just ty2' -> go ty1 ty2'\n                Nothing   -> bale_out ty1 ty2 }\n    go ty1 ty2 = bale_out ty1 ty2\n\n    bale_out ty1 ty2\n       | ty1 `tcEqType` ty2 = return ()\n        -- Check for equality; e.g. a ~ a, or (m a) ~ (m a)\n       | otherwise = emitNewDerivedEq loc role orig_ty1 orig_ty2\n\nmaybeSym :: SwapFlag -> TcCoercion -> TcCoercion\nmaybeSym IsSwapped  co = mkTcSymCo co\nmaybeSym NotSwapped co = co\n", "num_lines": 2466}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nTypechecking class declarations\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcClassDcl ( tcClassSigs, tcClassDecl2,\n                    findMethodBind, instantiateMethod,\n                    tcClassMinimalDef,\n                    HsSigFun, mkHsSigFun,\n                    tcMkDeclCtxt, tcAddDeclCtxt, badMethodErr,\n                    instDeclCtxt1, instDeclCtxt2, instDeclCtxt3,\n                    tcATDefault\n                  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport TcEnv\nimport TcSigs\nimport TcEvidence ( idHsWrapper )\nimport TcBinds\nimport TcUnify\nimport TcHsType\nimport TcMType\nimport Type     ( getClassPredTys_maybe, piResultTys )\nimport TcType\nimport TcRnMonad\nimport DriverPhases (HscSource(..))\nimport BuildTyCl( TcMethInfo )\nimport Class\nimport Coercion ( pprCoAxiom )\nimport DynFlags\nimport FamInst\nimport FamInstEnv\nimport Id\nimport Name\nimport NameEnv\nimport NameSet\nimport Var\nimport VarEnv\nimport Outputable\nimport SrcLoc\nimport TyCon\nimport Maybes\nimport BasicTypes\nimport Bag\nimport FastString\nimport BooleanFormula\nimport Util\n\nimport Control.Monad\nimport Data.List ( mapAccumL, partition )\n\n{-\nDictionary handling\n~~~~~~~~~~~~~~~~~~~\nEvery class implicitly declares a new data type, corresponding to dictionaries\nof that class. So, for example:\n\n        class (D a) => C a where\n          op1 :: a -> a\n          op2 :: forall b. Ord b => a -> b -> b\n\nwould implicitly declare\n\n        data CDict a = CDict (D a)\n                             (a -> a)\n                             (forall b. Ord b => a -> b -> b)\n\n(We could use a record decl, but that means changing more of the existing apparatus.\nOne step at at time!)\n\nFor classes with just one superclass+method, we use a newtype decl instead:\n\n        class C a where\n          op :: forallb. a -> b -> b\n\ngenerates\n\n        newtype CDict a = CDict (forall b. a -> b -> b)\n\nNow DictTy in Type is just a form of type synomym:\n        DictTy c t = TyConTy CDict `AppTy` t\n\nDeath to \"ExpandingDicts\".\n\n\n************************************************************************\n*                                                                      *\n                Type-checking the class op signatures\n*                                                                      *\n************************************************************************\n-}\n\nillegalHsigDefaultMethod :: Name -> SDoc\nillegalHsigDefaultMethod n =\n    text \"Illegal default method(s) in class definition of\" <+> ppr n <+> text \"in hsig file\"\n\ntcClassSigs :: Name                -- Name of the class\n            -> [LSig GhcRn]\n            -> LHsBinds GhcRn\n            -> TcM [TcMethInfo]    -- Exactly one for each method\ntcClassSigs clas sigs def_methods\n  = do { traceTc \"tcClassSigs 1\" (ppr clas)\n\n       ; gen_dm_prs <- concat <$> mapM (addLocM tc_gen_sig) gen_sigs\n       ; let gen_dm_env :: NameEnv (SrcSpan, Type)\n             gen_dm_env = mkNameEnv gen_dm_prs\n\n       ; op_info <- concat <$> mapM (addLocM (tc_sig gen_dm_env)) vanilla_sigs\n\n       ; let op_names = mkNameSet [ n | (n,_,_) <- op_info ]\n       ; sequence_ [ failWithTc (badMethodErr clas n)\n                   | n <- dm_bind_names, not (n `elemNameSet` op_names) ]\n                   -- Value binding for non class-method (ie no TypeSig)\n\n       ; tcg_env <- getGblEnv\n       ; if tcg_src tcg_env == HsigFile\n            then\n               -- Error if we have value bindings\n               -- (Generic signatures without value bindings indicate\n               -- that a default of this form is expected to be\n               -- provided.)\n               when (not (null def_methods)) $\n                failWithTc (illegalHsigDefaultMethod clas)\n            else\n               -- Error for each generic signature without value binding\n               sequence_ [ failWithTc (badGenericMethod clas n)\n                         | (n,_) <- gen_dm_prs, not (n `elem` dm_bind_names) ]\n\n       ; traceTc \"tcClassSigs 2\" (ppr clas)\n       ; return op_info }\n  where\n    vanilla_sigs = [L loc (nm,ty) | L loc (ClassOpSig _ False nm ty) <- sigs]\n    gen_sigs     = [L loc (nm,ty) | L loc (ClassOpSig _ True  nm ty) <- sigs]\n    dm_bind_names :: [Name] -- These ones have a value binding in the class decl\n    dm_bind_names = [op | L _ (FunBind {fun_id = L _ op}) <- bagToList def_methods]\n\n    skol_info = TyConSkol ClassFlavour clas\n\n    tc_sig :: NameEnv (SrcSpan, Type) -> ([Located Name], LHsSigType GhcRn)\n           -> TcM [TcMethInfo]\n    tc_sig gen_dm_env (op_names, op_hs_ty)\n      = do { traceTc \"ClsSig 1\" (ppr op_names)\n           ; op_ty <- tcClassSigType skol_info op_names op_hs_ty\n                   -- Class tyvars already in scope\n\n           ; traceTc \"ClsSig 2\" (ppr op_names)\n           ; return [ (op_name, op_ty, f op_name) | L _ op_name <- op_names ] }\n           where\n             f nm | Just lty <- lookupNameEnv gen_dm_env nm = Just (GenericDM lty)\n                  | nm `elem` dm_bind_names                 = Just VanillaDM\n                  | otherwise                               = Nothing\n\n    tc_gen_sig (op_names, gen_hs_ty)\n      = do { gen_op_ty <- tcClassSigType skol_info op_names gen_hs_ty\n           ; return [ (op_name, (loc, gen_op_ty)) | L loc op_name <- op_names ] }\n\n{-\n************************************************************************\n*                                                                      *\n                Class Declarations\n*                                                                      *\n************************************************************************\n-}\n\ntcClassDecl2 :: LTyClDecl GhcRn          -- The class declaration\n             -> TcM (LHsBinds GhcTcId)\n\ntcClassDecl2 (L _ (ClassDecl {tcdLName = class_name, tcdSigs = sigs,\n                                tcdMeths = default_binds}))\n  = recoverM (return emptyLHsBinds)     $\n    setSrcSpan (getLoc class_name)      $\n    do  { clas <- tcLookupLocatedClass class_name\n\n        -- We make a separate binding for each default method.\n        -- At one time I used a single AbsBinds for all of them, thus\n        -- AbsBind [d] [dm1, dm2, dm3] { dm1 = ...; dm2 = ...; dm3 = ... }\n        -- But that desugars into\n        --      ds = \\d -> (..., ..., ...)\n        --      dm1 = \\d -> case ds d of (a,b,c) -> a\n        -- And since ds is big, it doesn't get inlined, so we don't get good\n        -- default methods.  Better to make separate AbsBinds for each\n        ; let (tyvars, _, _, op_items) = classBigSig clas\n              prag_fn     = mkPragEnv sigs default_binds\n              sig_fn      = mkHsSigFun sigs\n              clas_tyvars = snd (tcSuperSkolTyVars tyvars)\n              pred        = mkClassPred clas (mkTyVarTys clas_tyvars)\n        ; this_dict <- newEvVar pred\n\n        ; let tc_item = tcDefMeth clas clas_tyvars this_dict\n                                  default_binds sig_fn prag_fn\n        ; dm_binds <- tcExtendTyVarEnv clas_tyvars $\n                      mapM tc_item op_items\n\n        ; return (unionManyBags dm_binds) }\n\ntcClassDecl2 d = pprPanic \"tcClassDecl2\" (ppr d)\n\ntcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn\n          -> HsSigFun -> TcPragEnv -> ClassOpItem\n          -> TcM (LHsBinds GhcTcId)\n-- Generate code for default methods\n-- This is incompatible with Hugs, which expects a polymorphic\n-- default method for every class op, regardless of whether or not\n-- the programmer supplied an explicit default decl for the class.\n-- (If necessary we can fix that, but we don't have a convenient Id to hand.)\n\ntcDefMeth _ _ _ _ _ prag_fn (sel_id, Nothing)\n  = do { -- No default method\n         mapM_ (addLocM (badDmPrag sel_id))\n               (lookupPragEnv prag_fn (idName sel_id))\n       ; return emptyBag }\n\ntcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn\n          (sel_id, Just (dm_name, dm_spec))\n  | Just (L bind_loc dm_bind, bndr_loc, prags) <- findMethodBind sel_name binds_in prag_fn\n  = do { -- First look up the default method; it should be there!\n         -- It can be the orinary default method\n         -- or the generic-default method.  E.g of the latter\n         --      class C a where\n         --        op :: a -> a -> Bool\n         --        default op :: Eq a => a -> a -> Bool\n         --        op x y = x==y\n         -- The default method we generate is\n         --    $gm :: (C a, Eq a) => a -> a -> Bool\n         --    $gm x y = x==y\n\n         global_dm_id  <- tcLookupId dm_name\n       ; global_dm_id  <- addInlinePrags global_dm_id prags\n       ; local_dm_name <- newNameAt (getOccName sel_name) bndr_loc\n            -- Base the local_dm_name on the selector name, because\n            -- type errors from tcInstanceMethodBody come from here\n\n       ; spec_prags <- discardConstraints $\n                       tcSpecPrags global_dm_id prags\n       ; warnTc NoReason\n                (not (null spec_prags))\n                (text \"Ignoring SPECIALISE pragmas on default method\"\n                 <+> quotes (ppr sel_name))\n\n       ; let hs_ty = hs_sig_fn sel_name\n                     `orElse` pprPanic \"tc_dm\" (ppr sel_name)\n             -- We need the HsType so that we can bring the right\n             -- type variables into scope\n             --\n             -- Eg.   class C a where\n             --          op :: forall b. Eq b => a -> [b] -> a\n             --          gen_op :: a -> a\n             --          generic gen_op :: D a => a -> a\n             -- The \"local_dm_ty\" is precisely the type in the above\n             -- type signatures, ie with no \"forall a. C a =>\" prefix\n\n             local_dm_ty = instantiateMethod clas global_dm_id (mkTyVarTys tyvars)\n\n             lm_bind     = dm_bind { fun_id = L bind_loc local_dm_name }\n                             -- Substitute the local_meth_name for the binder\n                             -- NB: the binding is always a FunBind\n\n             warn_redundant = case dm_spec of\n                                GenericDM {} -> True\n                                VanillaDM    -> False\n                -- For GenericDM, warn if the user specifies a signature\n                -- with redundant constraints; but not for VanillaDM, where\n                -- the default method may well be 'error' or something\n\n             ctxt = FunSigCtxt sel_name warn_redundant\n\n       ; let local_dm_id = mkLocalId local_dm_name local_dm_ty\n             local_dm_sig = CompleteSig { sig_bndr = local_dm_id\n                                        , sig_ctxt  = ctxt\n                                        , sig_loc   = getLoc (hsSigType hs_ty) }\n\n       ; (ev_binds, (tc_bind, _))\n               <- checkConstraints (TyConSkol ClassFlavour (getName clas)) tyvars [this_dict] $\n                  tcPolyCheck no_prag_fn local_dm_sig\n                              (L bind_loc lm_bind)\n\n       ; let export = ABE { abe_ext   = noExt\n                          , abe_poly  = global_dm_id\n                          , abe_mono  = local_dm_id\n                          , abe_wrap  = idHsWrapper\n                          , abe_prags = IsDefaultMethod }\n             full_bind = AbsBinds { abs_ext      = noExt\n                                  , abs_tvs      = tyvars\n                                  , abs_ev_vars  = [this_dict]\n                                  , abs_exports  = [export]\n                                  , abs_ev_binds = [ev_binds]\n                                  , abs_binds    = tc_bind\n                                  , abs_sig      = True }\n\n       ; return (unitBag (L bind_loc full_bind)) }\n\n  | otherwise = pprPanic \"tcDefMeth\" (ppr sel_id)\n  where\n    sel_name = idName sel_id\n    no_prag_fn = emptyPragEnv   -- No pragmas for local_meth_id;\n                                -- they are all for meth_id\n\n---------------\ntcClassMinimalDef :: Name -> [LSig GhcRn] -> [TcMethInfo] -> TcM ClassMinimalDef\ntcClassMinimalDef _clas sigs op_info\n  = case findMinimalDef sigs of\n      Nothing -> return defMindef\n      Just mindef -> do\n        -- Warn if the given mindef does not imply the default one\n        -- That is, the given mindef should at least ensure that the\n        -- class ops without default methods are required, since we\n        -- have no way to fill them in otherwise\n        tcg_env <- getGblEnv\n        -- However, only do this test when it's not an hsig file,\n        -- since you can't write a default implementation.\n        when (tcg_src tcg_env /= HsigFile) $\n            whenIsJust (isUnsatisfied (mindef `impliesAtom`) defMindef) $\n                       (\\bf -> addWarnTc NoReason (warningMinimalDefIncomplete bf))\n        return mindef\n  where\n    -- By default require all methods without a default implementation\n    defMindef :: ClassMinimalDef\n    defMindef = mkAnd [ noLoc (mkVar name)\n                      | (name, _, Nothing) <- op_info ]\n\ninstantiateMethod :: Class -> TcId -> [TcType] -> TcType\n-- Take a class operation, say\n--      op :: forall ab. C a => forall c. Ix c => (b,c) -> a\n-- Instantiate it at [ty1,ty2]\n-- Return the \"local method type\":\n--      forall c. Ix x => (ty2,c) -> ty1\ninstantiateMethod clas sel_id inst_tys\n  = ASSERT( ok_first_pred ) local_meth_ty\n  where\n    rho_ty = piResultTys (idType sel_id) inst_tys\n    (first_pred, local_meth_ty) = tcSplitPredFunTy_maybe rho_ty\n                `orElse` pprPanic \"tcInstanceMethod\" (ppr sel_id)\n\n    ok_first_pred = case getClassPredTys_maybe first_pred of\n                      Just (clas1, _tys) -> clas == clas1\n                      Nothing -> False\n              -- The first predicate should be of form (C a b)\n              -- where C is the class in question\n\n\n---------------------------\ntype HsSigFun = Name -> Maybe (LHsSigType GhcRn)\n\nmkHsSigFun :: [LSig GhcRn] -> HsSigFun\nmkHsSigFun sigs = lookupNameEnv env\n  where\n    env = mkHsSigEnv get_classop_sig sigs\n\n    get_classop_sig :: LSig GhcRn -> Maybe ([Located Name], LHsSigType GhcRn)\n    get_classop_sig  (L _ (ClassOpSig _ _ ns hs_ty)) = Just (ns, hs_ty)\n    get_classop_sig  _                               = Nothing\n\n---------------------------\nfindMethodBind  :: Name                 -- Selector\n                -> LHsBinds GhcRn       -- A group of bindings\n                -> TcPragEnv\n                -> Maybe (LHsBind GhcRn, SrcSpan, [LSig GhcRn])\n                -- Returns the binding, the binding\n                -- site of the method binder, and any inline or\n                -- specialisation pragmas\nfindMethodBind sel_name binds prag_fn\n  = foldlBag mplus Nothing (mapBag f binds)\n  where\n    prags    = lookupPragEnv prag_fn sel_name\n\n    f bind@(L _ (FunBind { fun_id = L bndr_loc op_name }))\n      | op_name == sel_name\n             = Just (bind, bndr_loc, prags)\n    f _other = Nothing\n\n---------------------------\nfindMinimalDef :: [LSig GhcRn] -> Maybe ClassMinimalDef\nfindMinimalDef = firstJusts . map toMinimalDef\n  where\n    toMinimalDef :: LSig GhcRn -> Maybe ClassMinimalDef\n    toMinimalDef (L _ (MinimalSig _ _ (L _ bf))) = Just (fmap unLoc bf)\n    toMinimalDef _                               = Nothing\n\n{-\nNote [Polymorphic methods]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n    class Foo a where\n        op :: forall b. Ord b => a -> b -> b -> b\n    instance Foo c => Foo [c] where\n        op = e\n\nWhen typechecking the binding 'op = e', we'll have a meth_id for op\nwhose type is\n      op :: forall c. Foo c => forall b. Ord b => [c] -> b -> b -> b\n\nSo tcPolyBinds must be capable of dealing with nested polytypes;\nand so it is. See TcBinds.tcMonoBinds (with type-sig case).\n\nNote [Silly default-method bind]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we pass the default method binding to the type checker, it must\nlook like    op2 = e\nnot          $dmop2 = e\notherwise the \"$dm\" stuff comes out error messages.  But we want the\n\"$dm\" to come out in the interface file.  So we typecheck the former,\nand wrap it in a let, thus\n          $dmop2 = let op2 = e in op2\nThis makes the error messages right.\n\n\n************************************************************************\n*                                                                      *\n                Error messages\n*                                                                      *\n************************************************************************\n-}\n\ntcMkDeclCtxt :: TyClDecl GhcRn -> SDoc\ntcMkDeclCtxt decl = hsep [text \"In the\", pprTyClDeclFlavour decl,\n                      text \"declaration for\", quotes (ppr (tcdName decl))]\n\ntcAddDeclCtxt :: TyClDecl GhcRn -> TcM a -> TcM a\ntcAddDeclCtxt decl thing_inside\n  = addErrCtxt (tcMkDeclCtxt decl) thing_inside\n\nbadMethodErr :: Outputable a => a -> Name -> SDoc\nbadMethodErr clas op\n  = hsep [text \"Class\", quotes (ppr clas),\n          text \"does not have a method\", quotes (ppr op)]\n\nbadGenericMethod :: Outputable a => a -> Name -> SDoc\nbadGenericMethod clas op\n  = hsep [text \"Class\", quotes (ppr clas),\n          text \"has a generic-default signature without a binding\", quotes (ppr op)]\n\n{-\nbadGenericInstanceType :: LHsBinds Name -> SDoc\nbadGenericInstanceType binds\n  = vcat [text \"Illegal type pattern in the generic bindings\",\n          nest 2 (ppr binds)]\n\nmissingGenericInstances :: [Name] -> SDoc\nmissingGenericInstances missing\n  = text \"Missing type patterns for\" <+> pprQuotedList missing\n\ndupGenericInsts :: [(TyCon, InstInfo a)] -> SDoc\ndupGenericInsts tc_inst_infos\n  = vcat [text \"More than one type pattern for a single generic type constructor:\",\n          nest 2 (vcat (map ppr_inst_ty tc_inst_infos)),\n          text \"All the type patterns for a generic type constructor must be identical\"\n    ]\n  where\n    ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)\n-}\nbadDmPrag :: TcId -> Sig GhcRn -> TcM ()\nbadDmPrag sel_id prag\n  = addErrTc (text \"The\" <+> hsSigDoc prag <+> ptext (sLit \"for default method\")\n              <+> quotes (ppr sel_id)\n              <+> text \"lacks an accompanying binding\")\n\nwarningMinimalDefIncomplete :: ClassMinimalDef -> SDoc\nwarningMinimalDefIncomplete mindef\n  = vcat [ text \"The MINIMAL pragma does not require:\"\n         , nest 2 (pprBooleanFormulaNice mindef)\n         , text \"but there is no default implementation.\" ]\n\ninstDeclCtxt1 :: LHsSigType GhcRn -> SDoc\ninstDeclCtxt1 hs_inst_ty\n  = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty))\n\ninstDeclCtxt2 :: Type -> SDoc\ninstDeclCtxt2 dfun_ty\n  = instDeclCtxt3 cls tys\n  where\n    (_,_,cls,tys) = tcSplitDFunTy dfun_ty\n\ninstDeclCtxt3 :: Class -> [Type] -> SDoc\ninstDeclCtxt3 cls cls_tys\n  = inst_decl_ctxt (ppr (mkClassPred cls cls_tys))\n\ninst_decl_ctxt :: SDoc -> SDoc\ninst_decl_ctxt doc = hang (text \"In the instance declaration for\")\n                        2 (quotes doc)\n\ntcATDefault :: SrcSpan\n            -> TCvSubst\n            -> NameSet\n            -> ClassATItem\n            -> TcM [FamInst]\n-- ^ Construct default instances for any associated types that\n-- aren't given a user definition\n-- Returns [] or singleton\ntcATDefault loc inst_subst defined_ats (ATI fam_tc defs)\n  -- User supplied instances ==> everything is OK\n  | tyConName fam_tc `elemNameSet` defined_ats\n  = return []\n\n  -- No user instance, have defaults ==> instantiate them\n   -- Example:   class C a where { type F a b :: *; type F a b = () }\n   --            instance C [x]\n   -- Then we want to generate the decl:   type F [x] b = ()\n  | Just (rhs_ty, _loc) <- defs\n  = do { let (subst', pat_tys') = mapAccumL subst_tv inst_subst\n                                            (tyConTyVars fam_tc)\n             rhs'     = substTyUnchecked subst' rhs_ty\n             tcv' = tyCoVarsOfTypesList pat_tys'\n             (tv', cv') = partition isTyVar tcv'\n             tvs'     = scopedSort tv'\n             cvs'     = scopedSort cv'\n       ; rep_tc_name <- newFamInstTyConName (L loc (tyConName fam_tc)) pat_tys'\n       ; let axiom = mkSingleCoAxiom Nominal rep_tc_name tvs' [] cvs'\n                                     fam_tc pat_tys' rhs'\n           -- NB: no validity check. We check validity of default instances\n           -- in the class definition. Because type instance arguments cannot\n           -- be type family applications and cannot be polytypes, the\n           -- validity check is redundant.\n\n       ; traceTc \"mk_deflt_at_instance\" (vcat [ ppr fam_tc, ppr rhs_ty\n                                              , pprCoAxiom axiom ])\n       ; fam_inst <- newFamInst SynFamilyInst axiom\n       ; return [fam_inst] }\n\n   -- No defaults ==> generate a warning\n  | otherwise  -- defs = Nothing\n  = do { warnMissingAT (tyConName fam_tc)\n       ; return [] }\n  where\n    subst_tv subst tc_tv\n      | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv\n      = (subst, ty)\n      | otherwise\n      = (extendTvSubst subst tc_tv ty', ty')\n      where\n        ty' = mkTyVarTy (updateTyVarKind (substTyUnchecked subst) tc_tv)\n\nwarnMissingAT :: Name -> TcM ()\nwarnMissingAT name\n  = do { warn <- woptM Opt_WarnMissingMethods\n       ; traceTc \"warn\" (ppr name <+> ppr warn)\n       ; hsc_src <- fmap tcg_src getGblEnv\n       -- Warn only if -Wmissing-methods AND not a signature\n       ; warnTc (Reason Opt_WarnMissingMethods) (warn && hsc_src /= HsigFile)\n                (text \"No explicit\" <+> text \"associated type\"\n                    <+> text \"or default declaration for\"\n                    <+> quotes (ppr name)) }\n", "num_lines": 552}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\\section[TcDefaults]{Typechecking \\tr{default} declarations}\n-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcDefaults ( tcDefaults ) where\n\nimport GhcPrelude\n\nimport HsSyn\nimport Class\nimport TcRnMonad\nimport TcEnv\nimport TcHsType\nimport TcHsSyn\nimport TcSimplify\nimport TcValidity\nimport TcType\nimport PrelNames\nimport SrcLoc\nimport Outputable\nimport FastString\nimport qualified GHC.LanguageExtensions as LangExt\n\ntcDefaults :: [LDefaultDecl GhcRn]\n           -> TcM (Maybe [Type])    -- Defaulting types to heave\n                                    -- into Tc monad for later use\n                                    -- in Disambig.\n\ntcDefaults []\n  = getDeclaredDefaultTys       -- No default declaration, so get the\n                                -- default types from the envt;\n                                -- i.e. use the current ones\n                                -- (the caller will put them back there)\n        -- It's important not to return defaultDefaultTys here (which\n        -- we used to do) because in a TH program, tcDefaults [] is called\n        -- repeatedly, once for each group of declarations between top-level\n        -- splices.  We don't want to carefully set the default types in\n        -- one group, only for the next group to ignore them and install\n        -- defaultDefaultTys\n\ntcDefaults [L _ (DefaultDecl _ [])]\n  = return (Just [])            -- Default declaration specifying no types\n\ntcDefaults [L locn (DefaultDecl _ mono_tys)]\n  = setSrcSpan locn                     $\n    addErrCtxt defaultDeclCtxt          $\n    do  { ovl_str   <- xoptM LangExt.OverloadedStrings\n        ; ext_deflt <- xoptM LangExt.ExtendedDefaultRules\n        ; num_class    <- tcLookupClass numClassName\n        ; deflt_str <- if ovl_str\n                       then mapM tcLookupClass [isStringClassName]\n                       else return []\n        ; deflt_interactive <- if ext_deflt\n                               then mapM tcLookupClass interactiveClassNames\n                               else return []\n        ; let deflt_clss = num_class : deflt_str ++ deflt_interactive\n\n        ; tau_tys <- mapAndReportM (tc_default_ty deflt_clss) mono_tys\n\n        ; return (Just tau_tys) }\n\ntcDefaults decls@(L locn (DefaultDecl _ _) : _)\n  = setSrcSpan locn $\n    failWithTc (dupDefaultDeclErr decls)\ntcDefaults (L _ (XDefaultDecl _):_) = panic \"tcDefaults\"\n\n\ntc_default_ty :: [Class] -> LHsType GhcRn -> TcM Type\ntc_default_ty deflt_clss hs_ty\n = do   { (ty, _kind) <- solveEqualities $\n                         tcLHsType hs_ty\n        ; ty <- zonkTcTypeToType ty   -- establish Type invariants\n        ; checkValidType DefaultDeclCtxt ty\n\n        -- Check that the type is an instance of at least one of the deflt_clss\n        ; oks <- mapM (check_instance ty) deflt_clss\n        ; checkTc (or oks) (badDefaultTy ty deflt_clss)\n        ; return ty }\n\ncheck_instance :: Type -> Class -> TcM Bool\n  -- Check that ty is an instance of cls\n  -- We only care about whether it worked or not; return a boolean\ncheck_instance ty cls\n  = do  { (_, success) <- discardErrs $\n                          askNoErrs $\n                          simplifyDefault [mkClassPred cls [ty]]\n        ; return success }\n\ndefaultDeclCtxt :: SDoc\ndefaultDeclCtxt = text \"When checking the types in a default declaration\"\n\ndupDefaultDeclErr :: [Located (DefaultDecl GhcRn)] -> SDoc\ndupDefaultDeclErr (L _ (DefaultDecl _ _) : dup_things)\n  = hang (text \"Multiple default declarations\")\n       2 (vcat (map pp dup_things))\n  where\n    pp (L locn (DefaultDecl _ _))\n      = text \"here was another default declaration\" <+> ppr locn\n    pp (L _ (XDefaultDecl _)) = panic \"dupDefaultDeclErr\"\ndupDefaultDeclErr (L _ (XDefaultDecl _) : _) = panic \"dupDefaultDeclErr\"\ndupDefaultDeclErr [] = panic \"dupDefaultDeclErr []\"\n\nbadDefaultTy :: Type -> [Class] -> SDoc\nbadDefaultTy ty deflt_clss\n  = hang (text \"The default type\" <+> quotes (ppr ty) <+> ptext (sLit \"is not an instance of\"))\n       2 (foldr1 (\\a b -> a <+> text \"or\" <+> b) (map (quotes. ppr) deflt_clss))\n", "num_lines": 111}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nHandles @deriving@ clauses on @data@ declarations.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcDeriv ( tcDeriving, DerivInfo(..), mkDerivInfos ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport DynFlags\n\nimport TcRnMonad\nimport FamInst\nimport TcDerivInfer\nimport TcDerivUtils\nimport TcValidity( allDistinctTyVars )\nimport TcClassDcl( instDeclCtxt3, tcATDefault, tcMkDeclCtxt )\nimport TcEnv\nimport TcGenDeriv                       -- Deriv stuff\nimport TcValidity( checkValidInstHead )\nimport InstEnv\nimport Inst\nimport FamInstEnv\nimport TcHsType\nimport TyCoRep\n\nimport RnNames( extendGlobalRdrEnvRn )\nimport RnBinds\nimport RnEnv\nimport RnUtils    ( bindLocalNamesFV )\nimport RnSource   ( addTcgDUs )\nimport Avail\n\nimport Unify( tcUnifyTy )\nimport Class\nimport Type\nimport ErrUtils\nimport DataCon\nimport Maybes\nimport RdrName\nimport Name\nimport NameSet\nimport TyCon\nimport TcType\nimport Var\nimport VarEnv\nimport VarSet\nimport PrelNames\nimport SrcLoc\nimport Util\nimport Outputable\nimport FastString\nimport Bag\nimport Pair\nimport FV (fvVarList, unionFV, mkFVs)\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Control.Monad.Trans.Class\nimport Control.Monad.Trans.Reader\nimport Data.List\n\n{-\n************************************************************************\n*                                                                      *\n                Overview\n*                                                                      *\n************************************************************************\n\nOverall plan\n~~~~~~~~~~~~\n1.  Convert the decls (i.e. data/newtype deriving clauses,\n    plus standalone deriving) to [EarlyDerivSpec]\n\n2.  Infer the missing contexts for the InferTheta's\n\n3.  Add the derived bindings, generating InstInfos\n-}\n\ndata EarlyDerivSpec = InferTheta (DerivSpec [ThetaOrigin])\n                    | GivenTheta (DerivSpec ThetaType)\n        -- InferTheta ds => the context for the instance should be inferred\n        --      In this case ds_theta is the list of all the sets of\n        --      constraints needed, such as (Eq [a], Eq a), together with a\n        --      suitable CtLoc to get good error messages.\n        --      The inference process is to reduce this to a\n        --      simpler form (e.g. Eq a)\n        --\n        -- GivenTheta ds => the exact context for the instance is supplied\n        --                  by the programmer; it is ds_theta\n        -- See Note [Inferring the instance context] in TcDerivInfer\n\nearlyDSLoc :: EarlyDerivSpec -> SrcSpan\nearlyDSLoc (InferTheta spec) = ds_loc spec\nearlyDSLoc (GivenTheta spec) = ds_loc spec\n\nsplitEarlyDerivSpec :: [EarlyDerivSpec]\n                    -> ([DerivSpec [ThetaOrigin]], [DerivSpec ThetaType])\nsplitEarlyDerivSpec [] = ([],[])\nsplitEarlyDerivSpec (InferTheta spec : specs) =\n    case splitEarlyDerivSpec specs of (is, gs) -> (spec : is, gs)\nsplitEarlyDerivSpec (GivenTheta spec : specs) =\n    case splitEarlyDerivSpec specs of (is, gs) -> (is, spec : gs)\n\ninstance Outputable EarlyDerivSpec where\n  ppr (InferTheta spec) = ppr spec <+> text \"(Infer)\"\n  ppr (GivenTheta spec) = ppr spec <+> text \"(Given)\"\n\n{-\nNote [Data decl contexts]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n        data (RealFloat a) => Complex a = !a :+ !a deriving( Read )\n\nWe will need an instance decl like:\n\n        instance (Read a, RealFloat a) => Read (Complex a) where\n          ...\n\nThe RealFloat in the context is because the read method for Complex is bound\nto construct a Complex, and doing that requires that the argument type is\nin RealFloat.\n\nBut this ain't true for Show, Eq, Ord, etc, since they don't construct\na Complex; they only take them apart.\n\nOur approach: identify the offending classes, and add the data type\ncontext to the instance decl.  The \"offending classes\" are\n\n        Read, Enum?\n\nFURTHER NOTE ADDED March 2002.  In fact, Haskell98 now requires that\npattern matching against a constructor from a data type with a context\ngives rise to the constraints for that context -- or at least the thinned\nversion.  So now all classes are \"offending\".\n\nNote [Newtype deriving]\n~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n    class C a b\n    instance C [a] Char\n    newtype T = T Char deriving( C [a] )\n\nNotice the free 'a' in the deriving.  We have to fill this out to\n    newtype T = T Char deriving( forall a. C [a] )\n\nAnd then translate it to:\n    instance C [a] Char => C [a] T where ...\n\n\nNote [Newtype deriving superclasses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(See also Trac #1220 for an interesting exchange on newtype\nderiving and superclasses.)\n\nThe 'tys' here come from the partial application in the deriving\nclause. The last arg is the new instance type.\n\nWe must pass the superclasses; the newtype might be an instance\nof them in a different way than the representation type\nE.g.            newtype Foo a = Foo a deriving( Show, Num, Eq )\nThen the Show instance is not done via Coercible; it shows\n        Foo 3 as \"Foo 3\"\nThe Num instance is derived via Coercible, but the Show superclass\ndictionary must the Show instance for Foo, *not* the Show dictionary\ngotten from the Num dictionary. So we must build a whole new dictionary\nnot just use the Num one.  The instance we want is something like:\n     instance (Num a, Show (Foo a), Eq (Foo a)) => Num (Foo a) where\n        (+) = ((+)@a)\n        ...etc...\nThere may be a coercion needed which we get from the tycon for the newtype\nwhen the dict is constructed in TcInstDcls.tcInstDecl2\n\n\nNote [Unused constructors and deriving clauses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee Trac #3221.  Consider\n   data T = T1 | T2 deriving( Show )\nAre T1 and T2 unused?  Well, no: the deriving clause expands to mention\nboth of them.  So we gather defs/uses from deriving just like anything else.\n\n-}\n\n-- | Stuff needed to process a datatype's `deriving` clauses\ndata DerivInfo = DerivInfo { di_rep_tc  :: TyCon\n                             -- ^ The data tycon for normal datatypes,\n                             -- or the *representation* tycon for data families\n                           , di_clauses :: [LHsDerivingClause GhcRn]\n                           , di_ctxt    :: SDoc -- ^ error context\n                           }\n\n-- | Extract `deriving` clauses of proper data type (skips data families)\nmkDerivInfos :: [LTyClDecl GhcRn] -> TcM [DerivInfo]\nmkDerivInfos decls = concatMapM (mk_deriv . unLoc) decls\n  where\n\n    mk_deriv decl@(DataDecl { tcdLName = L _ data_name\n                            , tcdDataDefn =\n                                HsDataDefn { dd_derivs = L _ clauses } })\n      = do { tycon <- tcLookupTyCon data_name\n           ; return [DerivInfo { di_rep_tc = tycon, di_clauses = clauses\n                               , di_ctxt = tcMkDeclCtxt decl }] }\n    mk_deriv _ = return []\n\n{-\n\n************************************************************************\n*                                                                      *\n\\subsection[TcDeriv-driver]{Top-level function for \\tr{derivings}}\n*                                                                      *\n************************************************************************\n-}\n\ntcDeriving  :: [DerivInfo]       -- All `deriving` clauses\n            -> [LDerivDecl GhcRn] -- All stand-alone deriving declarations\n            -> TcM (TcGblEnv, Bag (InstInfo GhcRn), HsValBinds GhcRn)\ntcDeriving deriv_infos deriv_decls\n  = recoverM (do { g <- getGblEnv\n                 ; return (g, emptyBag, emptyValBindsOut)}) $\n    do  {       -- Fish the \"deriving\"-related information out of the TcEnv\n                -- And make the necessary \"equations\".\n          is_boot <- tcIsHsBootOrSig\n        ; traceTc \"tcDeriving\" (ppr is_boot)\n\n        ; early_specs <- makeDerivSpecs is_boot deriv_infos deriv_decls\n        ; traceTc \"tcDeriving 1\" (ppr early_specs)\n\n        ; let (infer_specs, given_specs) = splitEarlyDerivSpec early_specs\n        ; insts1 <- mapM genInst given_specs\n        ; insts2 <- mapM genInst infer_specs\n\n        ; dflags <- getDynFlags\n\n        ; let (_, deriv_stuff, fvs) = unzip3 (insts1 ++ insts2)\n        ; loc <- getSrcSpanM\n        ; let (binds, famInsts) = genAuxBinds dflags loc\n                                    (unionManyBags deriv_stuff)\n\n        ; let mk_inst_infos1 = map fstOf3 insts1\n        ; inst_infos1 <- apply_inst_infos mk_inst_infos1 given_specs\n\n          -- We must put all the derived type family instances (from both\n          -- infer_specs and given_specs) in the local instance environment\n          -- before proceeding, or else simplifyInstanceContexts might\n          -- get stuck if it has to reason about any of those family instances.\n          -- See Note [Staging of tcDeriving]\n        ; tcExtendLocalFamInstEnv (bagToList famInsts) $\n          -- NB: only call tcExtendLocalFamInstEnv once, as it performs\n          -- validity checking for all of the family instances you give it.\n          -- If the family instances have errors, calling it twice will result\n          -- in duplicate error messages!\n\n     do {\n        -- the stand-alone derived instances (@inst_infos1@) are used when\n        -- inferring the contexts for \"deriving\" clauses' instances\n        -- (@infer_specs@)\n        ; final_specs <- extendLocalInstEnv (map iSpec inst_infos1) $\n                         simplifyInstanceContexts infer_specs\n\n        ; let mk_inst_infos2 = map fstOf3 insts2\n        ; inst_infos2 <- apply_inst_infos mk_inst_infos2 final_specs\n        ; let inst_infos = inst_infos1 ++ inst_infos2\n\n        ; (inst_info, rn_binds, rn_dus) <-\n            renameDeriv is_boot inst_infos binds\n\n        ; unless (isEmptyBag inst_info) $\n             liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv \"Derived instances\"\n                        (ddump_deriving inst_info rn_binds famInsts))\n\n        ; gbl_env <- tcExtendLocalInstEnv (map iSpec (bagToList inst_info))\n                                          getGblEnv\n        ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ concat fvs)\n        ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) } }\n  where\n    ddump_deriving :: Bag (InstInfo GhcRn) -> HsValBinds GhcRn\n                   -> Bag FamInst             -- ^ Rep type family instances\n                   -> SDoc\n    ddump_deriving inst_infos extra_binds repFamInsts\n      =    hang (text \"Derived class instances:\")\n              2 (vcat (map (\\i -> pprInstInfoDetails i $$ text \"\") (bagToList inst_infos))\n                 $$ ppr extra_binds)\n        $$ hangP \"Derived type family instances:\"\n             (vcat (map pprRepTy (bagToList repFamInsts)))\n\n    hangP s x = text \"\" $$ hang (ptext (sLit s)) 2 x\n\n    -- Apply the suspended computations given by genInst calls.\n    -- See Note [Staging of tcDeriving]\n    apply_inst_infos :: [ThetaType -> TcM (InstInfo GhcPs)]\n                     -> [DerivSpec ThetaType] -> TcM [InstInfo GhcPs]\n    apply_inst_infos = zipWithM (\\f ds -> f (ds_theta ds))\n\n-- Prints the representable type family instance\npprRepTy :: FamInst -> SDoc\npprRepTy fi@(FamInst { fi_tys = lhs })\n  = text \"type\" <+> ppr (mkTyConApp (famInstTyCon fi) lhs) <+>\n      equals <+> ppr rhs\n  where rhs = famInstRHS fi\n\nrenameDeriv :: Bool\n            -> [InstInfo GhcPs]\n            -> Bag (LHsBind GhcPs, LSig GhcPs)\n            -> TcM (Bag (InstInfo GhcRn), HsValBinds GhcRn, DefUses)\nrenameDeriv is_boot inst_infos bagBinds\n  | is_boot     -- If we are compiling a hs-boot file, don't generate any derived bindings\n                -- The inst-info bindings will all be empty, but it's easier to\n                -- just use rn_inst_info to change the type appropriately\n  = do  { (rn_inst_infos, fvs) <- mapAndUnzipM rn_inst_info inst_infos\n        ; return ( listToBag rn_inst_infos\n                 , emptyValBindsOut, usesOnly (plusFVs fvs)) }\n\n  | otherwise\n  = discardWarnings $\n    -- Discard warnings about unused bindings etc\n    setXOptM LangExt.EmptyCase $\n    -- Derived decls (for empty types) can have\n    --    case x of {}\n    setXOptM LangExt.ScopedTypeVariables $\n    setXOptM LangExt.KindSignatures $\n    -- Derived decls (for newtype-deriving) can use ScopedTypeVariables &\n    -- KindSignatures\n    setXOptM LangExt.TypeApplications $\n    -- GND/DerivingVia uses TypeApplications in generated code\n    -- (See Note [Newtype-deriving instances] in TcGenDeriv)\n    unsetXOptM LangExt.RebindableSyntax $\n    -- See Note [Avoid RebindableSyntax when deriving]\n    do  {\n        -- Bring the extra deriving stuff into scope\n        -- before renaming the instances themselves\n        ; traceTc \"rnd\" (vcat (map (\\i -> pprInstInfoDetails i $$ text \"\") inst_infos))\n        ; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds\n        ; let aux_val_binds = ValBinds noExt aux_binds (bagToList aux_sigs)\n        ; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds\n        ; let bndrs = collectHsValBinders rn_aux_lhs\n        ; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ;\n        ; setEnvs envs $\n    do  { (rn_aux, dus_aux) <- rnValBindsRHS (TopSigCtxt (mkNameSet bndrs)) rn_aux_lhs\n        ; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos\n        ; return (listToBag rn_inst_infos, rn_aux,\n                  dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }\n\n  where\n    rn_inst_info :: InstInfo GhcPs -> TcM (InstInfo GhcRn, FreeVars)\n    rn_inst_info\n      inst_info@(InstInfo { iSpec = inst\n                          , iBinds = InstBindings\n                            { ib_binds = binds\n                            , ib_tyvars = tyvars\n                            , ib_pragmas = sigs\n                            , ib_extensions = exts -- Only for type-checking\n                            , ib_derived = sa } })\n        =  ASSERT( null sigs )\n           bindLocalNamesFV tyvars $\n           do { (rn_binds,_, fvs) <- rnMethodBinds False (is_cls_nm inst) [] binds []\n              ; let binds' = InstBindings { ib_binds = rn_binds\n                                          , ib_tyvars = tyvars\n                                          , ib_pragmas = []\n                                          , ib_extensions = exts\n                                          , ib_derived = sa }\n              ; return (inst_info { iBinds = binds' }, fvs) }\n\n{-\nNote [Newtype deriving and unused constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this (see Trac #1954):\n\n  module Bug(P) where\n  newtype P a = MkP (IO a) deriving Monad\n\nIf you compile with -Wunused-binds you do not expect the warning\n\"Defined but not used: data constructor MkP\". Yet the newtype deriving\ncode does not explicitly mention MkP, but it should behave as if you\nhad written\n  instance Monad P where\n     return x = MkP (return x)\n     ...etc...\n\nSo we want to signal a user of the data constructor 'MkP'.\nThis is the reason behind the [Name] part of the return type\nof genInst.\n\nNote [Staging of tcDeriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere's a tricky corner case for deriving (adapted from Trac #2721):\n\n    class C a where\n      type T a\n      foo :: a -> T a\n\n    instance C Int where\n      type T Int = Int\n      foo = id\n\n    newtype N = N Int deriving C\n\nThis will produce an instance something like this:\n\n    instance C N where\n      type T N = T Int\n      foo = coerce (foo :: Int -> T Int) :: N -> T N\n\nWe must be careful in order to typecheck this code. When determining the\ncontext for the instance (in simplifyInstanceContexts), we need to determine\nthat T N and T Int have the same representation, but to do that, the T N\ninstance must be in the local family instance environment. Otherwise, GHC\nwould be unable to conclude that T Int is representationally equivalent to\nT Int, and simplifyInstanceContexts would get stuck.\n\nPreviously, tcDeriving would defer adding any derived type family instances to\nthe instance environment until the very end, which meant that\nsimplifyInstanceContexts would get called without all the type family instances\nit needed in the environment in order to properly simplify instance like\nthe C N instance above.\n\nTo avoid this scenario, we carefully structure the order of events in\ntcDeriving. We first call genInst on the standalone derived instance specs and\nthe instance specs obtained from deriving clauses. Note that the return type of\ngenInst is a triple:\n\n    TcM (ThetaType -> TcM (InstInfo RdrName), BagDerivStuff, Maybe Name)\n\nThe type family instances are in the BagDerivStuff. The first field of the\ntriple is a suspended computation which, given an instance context, produces\nthe rest of the instance. The fact that it is suspended is important, because\nright now, we don't have ThetaTypes for the instances that use deriving clauses\n(only the standalone-derived ones).\n\nNow we can can collect the type family instances and extend the local instance\nenvironment. At this point, it is safe to run simplifyInstanceContexts on the\nderiving-clause instance specs, which gives us the ThetaTypes for the\nderiving-clause instances. Now we can feed all the ThetaTypes to the\nsuspended computations and obtain our InstInfos, at which point\ntcDeriving is done.\n\nAn alternative design would be to split up genInst so that the\nfamily instances are generated separately from the InstInfos. But this would\nrequire carving up a lot of the GHC deriving internals to accommodate the\nchange. On the other hand, we can keep all of the InstInfo and type family\ninstance logic together in genInst simply by converting genInst to\ncontinuation-returning style, so we opt for that route.\n\nNote [Why we don't pass rep_tc into deriveTyData]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDown in the bowels of mkEqnHelp, we need to convert the fam_tc back into\nthe rep_tc by means of a lookup. And yet we have the rep_tc right here!\nWhy look it up again? Answer: it's just easier this way.\nWe drop some number of arguments from the end of the datatype definition\nin deriveTyData. The arguments are dropped from the fam_tc.\nThis action may drop a *different* number of arguments\npassed to the rep_tc, depending on how many free variables, etc., the\ndropped patterns have.\n\nAlso, this technique carries over the kind substitution from deriveTyData\nnicely.\n\nNote [Avoid RebindableSyntax when deriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe RebindableSyntax extension interacts awkwardly with the derivation of\nany stock class whose methods require the use of string literals. The Show\nclass is a simple example (see Trac #12688):\n\n  {-# LANGUAGE RebindableSyntax, OverloadedStrings #-}\n  newtype Text = Text String\n  fromString :: String -> Text\n  fromString = Text\n\n  data Foo = Foo deriving Show\n\nThis will generate code to the effect of:\n\n  instance Show Foo where\n    showsPrec _ Foo = showString \"Foo\"\n\nBut because RebindableSyntax and OverloadedStrings are enabled, the \"Foo\"\nstring literal is now of type Text, not String, which showString doesn't\naccept! This causes the generated Show instance to fail to typecheck.\n\nTo avoid this kind of scenario, we simply turn off RebindableSyntax entirely\nin derived code.\n\n************************************************************************\n*                                                                      *\n                From HsSyn to DerivSpec\n*                                                                      *\n************************************************************************\n\n@makeDerivSpecs@ fishes around to find the info about needed derived instances.\n-}\n\nmakeDerivSpecs :: Bool\n               -> [DerivInfo]\n               -> [LDerivDecl GhcRn]\n               -> TcM [EarlyDerivSpec]\nmakeDerivSpecs is_boot deriv_infos deriv_decls\n  = do  { -- We carefully set up uses of recoverM to minimize error message\n          -- cascades. See Note [Flattening deriving clauses].\n        ; eqns1 <- sequenceA\n                     [ recoverM (pure Nothing)\n                                (deriveClause rep_tc (fmap unLoc dcs)\n                                                      pred err_ctxt)\n                     | DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses\n                                 , di_ctxt = err_ctxt } <- deriv_infos\n                     , L _ (HsDerivingClause { deriv_clause_strategy = dcs\n                                             , deriv_clause_tys = L _ preds })\n                         <- clauses\n                     , pred <- preds\n                     ]\n        ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls\n        ; let eqns = catMaybes (eqns1 ++ eqns2)\n\n        ; if is_boot then   -- No 'deriving' at all in hs-boot files\n              do { unless (null eqns) (add_deriv_err (head eqns))\n                 ; return [] }\n          else return eqns }\n  where\n    add_deriv_err eqn\n       = setSrcSpan (earlyDSLoc eqn) $\n         addErr (hang (text \"Deriving not permitted in hs-boot file\")\n                    2 (text \"Use an instance declaration instead\"))\n\n{-\nNote [Flattening deriving clauses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider what happens if you run this program (from Trac #10684) without\nDeriveGeneric enabled:\n\n    data A = A deriving (Show, Generic)\n    data B = B A deriving (Show)\n\nNaturally, you'd expect GHC to give an error to the effect of:\n\n    Can't make a derived instance of `Generic A':\n      You need -XDeriveGeneric to derive an instance for this class\n\nAnd *only* that error, since the other two derived Show instances appear to be\nindependent of this derived Generic instance. Yet GHC also used to give this\nadditional error on the program above:\n\n    No instance for (Show A)\n      arising from the 'deriving' clause of a data type declaration\n    When deriving the instance for (Show B)\n\nThis was happening because when GHC encountered any error within a single\ndata type's set of deriving clauses, it would call recoverM and move on\nto the next data type's deriving clauses. One unfortunate consequence of\nthis design is that if A's derived Generic instance failed, so its derived\nShow instance would be skipped entirely, leading to the \"No instance for\n(Show A)\" error cascade.\n\nThe solution to this problem is to \"flatten\" the set of classes that are\nderived for a particular data type via deriving clauses. That is, if\nyou have:\n\n    newtype C = C D\n      deriving (E, F, G)\n      deriving anyclass (H, I, J)\n      deriving newtype  (K, L, M)\n\nThen instead of processing instances E through M under the scope of a single\nrecoverM, we flatten these deriving clauses into the list:\n\n    [ E (Nothing)\n    , F (Nothing)\n    , G (Nothing)\n    , H (Just anyclass)\n    , I (Just anyclass)\n    , J (Just anyclass)\n    , K (Just newtype)\n    , L (Just newtype)\n    , M (Just newtype) ]\n\nAnd then process each class individually, under its own recoverM scope. That\nway, failure to derive one class doesn't cancel out other classes in the\nsame set of clause-derived classes.\n-}\n\n------------------------------------------------------------------\n-- | Process a single class in a `deriving` clause.\nderiveClause :: TyCon -> Maybe (DerivStrategy GhcRn)\n             -> LHsSigType GhcRn -> SDoc\n             -> TcM (Maybe EarlyDerivSpec)\nderiveClause rep_tc mb_strat pred err_ctxt\n  = addErrCtxt err_ctxt $\n    deriveTyData tvs tc tys mb_strat pred\n  where\n    tvs = tyConTyVars rep_tc\n    (tc, tys) = case tyConFamInstSig_maybe rep_tc of\n                        -- data family:\n                  Just (fam_tc, pats, _) -> (fam_tc, pats)\n      -- NB: deriveTyData wants the *user-specified*\n      -- name. See Note [Why we don't pass rep_tc into deriveTyData]\n\n                  _ -> (rep_tc, mkTyVarTys tvs)     -- datatype\n\n------------------------------------------------------------------\nderiveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)\n-- Process a single standalone deriving declaration\n--  e.g.   deriving instance Show a => Show (T a)\n-- Rather like tcLocalInstDecl\n--\n-- This returns a Maybe because the user might try to derive Typeable, which is\n-- a no-op nowadays.\nderiveStandalone (L loc (DerivDecl _ deriv_ty mbl_deriv_strat overlap_mode))\n  = setSrcSpan loc                   $\n    addErrCtxt (standaloneCtxt deriv_ty)  $\n    do { traceTc \"Standalone deriving decl for\" (ppr deriv_ty)\n       ; let mb_deriv_strat = fmap unLoc mbl_deriv_strat\n             ctxt           = TcType.InstDeclCtxt True\n       ; traceTc \"Deriving strategy (standalone deriving)\" $\n           vcat [ppr mb_deriv_strat, ppr deriv_ty]\n       ; (mb_deriv_strat', tvs', (deriv_ctxt', cls, inst_tys'))\n           <- tcDerivStrategy mb_deriv_strat $ do\n                (tvs, deriv_ctxt, cls, inst_tys)\n                  <- tcStandaloneDerivInstType ctxt deriv_ty\n                pure (tvs, (deriv_ctxt, cls, inst_tys))\n       ; checkTc (not (null inst_tys')) derivingNullaryErr\n       ; let inst_ty' = last inst_tys'\n         -- See Note [Unify kinds in deriving]\n       ; (tvs, deriv_ctxt, inst_tys) <-\n           case mb_deriv_strat' of\n             -- Perform an additional unification with the kind of the `via`\n             -- type and the result of the previous kind unification.\n             Just (ViaStrategy via_ty) -> do\n               let via_kind     = tcTypeKind via_ty\n                   inst_ty_kind = tcTypeKind inst_ty'\n                   mb_match     = tcUnifyTy inst_ty_kind via_kind\n\n               checkTc (isJust mb_match)\n                       (derivingViaKindErr cls inst_ty_kind\n                                           via_ty via_kind)\n\n               let Just kind_subst = mb_match\n                   ki_subst_range  = getTCvSubstRangeFVs kind_subst\n                   -- See Note [Unification of two kind variables in deriving]\n                   unmapped_tkvs = filter (\\v -> v `notElemTCvSubst` kind_subst\n                                        && not (v `elemVarSet` ki_subst_range))\n                                          tvs'\n                   (subst, _)    = substTyVarBndrs kind_subst unmapped_tkvs\n                   (final_deriv_ctxt, final_deriv_ctxt_tys)\n                     = case deriv_ctxt' of\n                         InferContext wc -> (InferContext wc, [])\n                         SupplyContext theta ->\n                           let final_theta = substTheta subst theta\n                           in (SupplyContext final_theta, final_theta)\n                   final_inst_tys   = substTys subst inst_tys'\n                   final_tvs        = tyCoVarsOfTypesWellScoped $\n                                      final_deriv_ctxt_tys ++ final_inst_tys\n               pure (final_tvs, final_deriv_ctxt, final_inst_tys)\n\n             _ -> pure (tvs', deriv_ctxt', inst_tys')\n       ; let cls_tys = take (length inst_tys - 1) inst_tys\n             inst_ty = last inst_tys\n       ; traceTc \"Standalone deriving;\" $ vcat\n              [ text \"tvs:\" <+> ppr tvs\n              , text \"mb_deriv_strat:\" <+> ppr mb_deriv_strat'\n              , text \"deriv_ctxt:\" <+> ppr deriv_ctxt\n              , text \"cls:\" <+> ppr cls\n              , text \"tys:\" <+> ppr inst_tys ]\n                -- C.f. TcInstDcls.tcLocalInstDecl1\n       ; traceTc \"Standalone deriving:\" $ vcat\n              [ text \"class:\" <+> ppr cls\n              , text \"class types:\" <+> ppr cls_tys\n              , text \"type:\" <+> ppr inst_ty ]\n\n       ; let bale_out msg = failWithTc (derivingThingErr False cls cls_tys\n                              inst_ty mb_deriv_strat' msg)\n\n       ; case tcSplitTyConApp_maybe inst_ty of\n           Just (tc, tc_args)\n              | className cls == typeableClassName\n              -> do warnUselessTypeable\n                    return Nothing\n\n              | otherwise\n              -> Just <$> mkEqnHelp (fmap unLoc overlap_mode)\n                                    tvs cls cls_tys tc tc_args\n                                    deriv_ctxt mb_deriv_strat'\n\n           _  -> -- Complain about functions, primitive types, etc,\n                 bale_out $\n                 text \"The last argument of the instance must be a data or newtype application\"\n        }\nderiveStandalone (L _ (XDerivDecl _)) = panic \"deriveStandalone\"\n\n-- Typecheck the type in a standalone deriving declaration.\n--\n-- This may appear dense, but it's mostly huffing and puffing to recognize\n-- the special case of a type with an extra-constraints wildcard context, e.g.,\n--\n--   deriving instance _ => Eq (Foo a)\n--\n-- If there is such a wildcard, we typecheck this as if we had written\n-- @deriving instance Eq (Foo a)@, and return @'InferContext' ('Just' loc)@,\n-- as the 'DerivContext', where loc is the location of the wildcard used for\n-- error reporting. This indicates that we should infer the context as if we\n-- were deriving Eq via a deriving clause\n-- (see Note [Inferring the instance context] in TcDerivInfer).\n--\n-- If there is no wildcard, then proceed as normal, and instead return\n-- @'SupplyContext' theta@, where theta is the typechecked context.\n--\n-- Note that this will never return @'InferContext' 'Nothing'@, as that can\n-- only happen with @deriving@ clauses.\ntcStandaloneDerivInstType\n  :: UserTypeCtxt -> LHsSigWcType GhcRn\n  -> TcM ([TyVar], DerivContext, Class, [Type])\ntcStandaloneDerivInstType ctxt\n    (HsWC { hswc_body = deriv_ty@(HsIB { hsib_ext = vars\n                                       , hsib_body   = deriv_ty_body })})\n  | (tvs, theta, rho) <- splitLHsSigmaTy deriv_ty_body\n  , L _ [wc_pred] <- theta\n  , L wc_span (HsWildCardTy _) <- ignoreParens wc_pred\n  = do dfun_ty <- tcHsClsInstType ctxt $\n                  HsIB { hsib_ext = vars\n                       , hsib_body\n                           = L (getLoc deriv_ty_body) $\n                             HsForAllTy { hst_fvf = ForallInvis\n                                        , hst_bndrs = tvs\n                                        , hst_xforall = noExt\n                                        , hst_body  = rho }}\n       let (tvs, _theta, cls, inst_tys) = tcSplitDFunTy dfun_ty\n       pure (tvs, InferContext (Just wc_span), cls, inst_tys)\n  | otherwise\n  = do dfun_ty <- tcHsClsInstType ctxt deriv_ty\n       let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty\n       pure (tvs, SupplyContext theta, cls, inst_tys)\n\ntcStandaloneDerivInstType _ (HsWC _ (XHsImplicitBndrs _))\n  = panic \"tcStandaloneDerivInstType\"\ntcStandaloneDerivInstType _ (XHsWildCardBndrs _)\n  = panic \"tcStandaloneDerivInstType\"\n\nwarnUselessTypeable :: TcM ()\nwarnUselessTypeable\n  = do { warn <- woptM Opt_WarnDerivingTypeable\n       ; when warn $ addWarnTc (Reason Opt_WarnDerivingTypeable)\n                   $ text \"Deriving\" <+> quotes (ppr typeableClassName) <+>\n                     text \"has no effect: all types now auto-derive Typeable\" }\n\n------------------------------------------------------------------\nderiveTyData :: [TyVar] -> TyCon -> [Type]   -- LHS of data or data instance\n                    -- Can be a data instance, hence [Type] args\n                    -- and in that case the TyCon is the /family/ tycon\n             -> Maybe (DerivStrategy GhcRn)  -- The optional deriving strategy\n             -> LHsSigType GhcRn             -- The deriving predicate\n             -> TcM (Maybe EarlyDerivSpec)\n-- The deriving clause of a data or newtype declaration\n-- I.e. not standalone deriving\n--\n-- This returns a Maybe because the user might try to derive Typeable, which is\n-- a no-op nowadays.\nderiveTyData tvs tc tc_args mb_deriv_strat deriv_pred\n  = setSrcSpan (getLoc (hsSigType deriv_pred)) $\n    -- Use loc of the 'deriving' item\n    do  { (mb_deriv_strat', deriv_tvs, (cls, cls_tys, cls_arg_kinds))\n                <- tcExtendTyVarEnv tvs $\n                -- Deriving preds may (now) mention\n                -- the type variables for the type constructor, hence tcExtendTyVarenv\n                -- The \"deriv_pred\" is a LHsType to take account of the fact that for\n                -- newtype deriving we allow deriving (forall a. C [a]).\n\n                -- Typeable is special, because Typeable :: forall k. k -> Constraint\n                -- so the argument kind 'k' is not decomposable by splitKindFunTys\n                -- as is the case for all other derivable type classes\n                     tcDerivStrategy mb_deriv_strat $\n                     tcHsDeriv deriv_pred\n\n        ; when (cls_arg_kinds `lengthIsNot` 1) $\n            failWithTc (nonUnaryErr deriv_pred)\n        ; let [cls_arg_kind] = cls_arg_kinds\n        ; if className cls == typeableClassName\n          then do warnUselessTypeable\n                  return Nothing\n          else\n\n     do {  -- Given data T a b c = ... deriving( C d ),\n           -- we want to drop type variables from T so that (C d (T a)) is well-kinded\n          let (arg_kinds, _)  = splitFunTys cls_arg_kind\n              n_args_to_drop  = length arg_kinds\n              n_args_to_keep  = length tc_args - n_args_to_drop\n                                -- See Note [tc_args and tycon arity]\n              (tc_args_to_keep, args_to_drop)\n                              = splitAt n_args_to_keep tc_args\n              inst_ty_kind    = tcTypeKind (mkTyConApp tc tc_args_to_keep)\n\n              -- Match up the kinds, and apply the resulting kind substitution\n              -- to the types.  See Note [Unify kinds in deriving]\n              -- We are assuming the tycon tyvars and the class tyvars are distinct\n              mb_match        = tcUnifyTy inst_ty_kind cls_arg_kind\n              enough_args     = n_args_to_keep >= 0\n\n        -- Check that the result really is well-kinded\n        ; checkTc (enough_args && isJust mb_match)\n                  (derivingKindErr tc cls cls_tys cls_arg_kind enough_args)\n\n        ; let propagate_subst kind_subst tkvs' cls_tys' tc_args'\n                = (final_tkvs, final_cls_tys, final_tc_args)\n                where\n                  ki_subst_range  = getTCvSubstRangeFVs kind_subst\n                  -- See Note [Unification of two kind variables in deriving]\n                  unmapped_tkvs   = filter (\\v -> v `notElemTCvSubst` kind_subst\n                                         && not (v `elemVarSet` ki_subst_range))\n                                           tkvs'\n                  (subst, _)      = substTyVarBndrs kind_subst unmapped_tkvs\n                  final_tc_args   = substTys subst tc_args'\n                  final_cls_tys   = substTys subst cls_tys'\n                  final_tkvs      = tyCoVarsOfTypesWellScoped $\n                                    final_cls_tys ++ final_tc_args\n\n        ; let tkvs = scopedSort $ fvVarList $\n                     unionFV (tyCoFVsOfTypes tc_args_to_keep)\n                             (FV.mkFVs deriv_tvs)\n              Just kind_subst = mb_match\n              (tkvs', final_cls_tys', final_tc_args')\n                = propagate_subst kind_subst tkvs cls_tys tc_args_to_keep\n\n          -- See Note [Unify kinds in deriving]\n        ; (tkvs, final_cls_tys, final_tc_args, final_mb_deriv_strat) <-\n            case mb_deriv_strat' of\n              -- Perform an additional unification with the kind of the `via`\n              -- type and the result of the previous kind unification.\n              Just (ViaStrategy via_ty) -> do\n                let final_via_ty   = via_ty\n                    final_via_kind = tcTypeKind final_via_ty\n                    final_inst_ty_kind\n                              = tcTypeKind (mkTyConApp tc final_tc_args')\n                    via_match = tcUnifyTy final_inst_ty_kind final_via_kind\n\n                checkTc (isJust via_match)\n                        (derivingViaKindErr cls final_inst_ty_kind\n                                            final_via_ty final_via_kind)\n\n                let Just via_subst = via_match\n                    (final_tkvs, final_cls_tys, final_tc_args)\n                      = propagate_subst via_subst tkvs'\n                                        final_cls_tys' final_tc_args'\n                pure ( final_tkvs, final_cls_tys, final_tc_args\n                     , Just $ ViaStrategy $ substTy via_subst via_ty\n                     )\n\n              _ -> pure ( tkvs', final_cls_tys', final_tc_args'\n                        , mb_deriv_strat' )\n\n        ; traceTc \"Deriving strategy (deriving clause)\" $\n            vcat [ppr final_mb_deriv_strat, ppr deriv_pred]\n\n        ; traceTc \"derivTyData1\" (vcat [ pprTyVars tvs, ppr tc, ppr tc_args\n                                       , ppr deriv_pred\n                                       , pprTyVars (tyCoVarsOfTypesList tc_args)\n                                       , ppr n_args_to_keep, ppr n_args_to_drop\n                                       , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match\n                                       , ppr final_tc_args, ppr final_cls_tys ])\n\n        ; traceTc \"derivTyData2\" (vcat [ ppr tkvs ])\n\n        ; let final_tc_app = mkTyConApp tc final_tc_args\n        ; checkTc (allDistinctTyVars (mkVarSet tkvs) args_to_drop)     -- (a, b, c)\n                  (derivingEtaErr cls final_cls_tys final_tc_app)\n                -- Check that\n                --  (a) The args to drop are all type variables; eg reject:\n                --              data instance T a Int = .... deriving( Monad )\n                --  (b) The args to drop are all *distinct* type variables; eg reject:\n                --              class C (a :: * -> * -> *) where ...\n                --              data instance T a a = ... deriving( C )\n                --  (c) The type class args, or remaining tycon args,\n                --      do not mention any of the dropped type variables\n                --              newtype T a s = ... deriving( ST s )\n                --              newtype instance K a a = ... deriving( Monad )\n                --\n                -- It is vital that the implementation of allDistinctTyVars\n                -- expand any type synonyms.\n                -- See Note [Eta-reducing type synonyms]\n\n        ; checkValidInstHead DerivClauseCtxt cls $\n                             final_cls_tys ++ [final_tc_app]\n                -- Check that we aren't deriving an instance of a magical\n                -- type like (~) or Coercible (#14916).\n\n        ; spec <- mkEqnHelp Nothing tkvs\n                            cls final_cls_tys tc final_tc_args\n                            (InferContext Nothing) final_mb_deriv_strat\n        ; traceTc \"derivTyData\" (ppr spec)\n        ; return $ Just spec } }\n\n\n{- Note [tc_args and tycon arity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nYou might wonder if we could use (tyConArity tc) at this point, rather\nthan (length tc_args).  But for data families the two can differ!  The\ntc and tc_args passed into 'deriveTyData' come from 'deriveClause' which\nin turn gets them from 'tyConFamInstSig_maybe' which in turn gets them\nfrom DataFamInstTyCon:\n\n| DataFamInstTyCon          -- See Note [Data type families]\n      (CoAxiom Unbranched)\n      TyCon   -- The family TyCon\n      [Type]  -- Argument types (mentions the tyConTyVars of this TyCon)\n              -- No shorter in length than the tyConTyVars of the family TyCon\n              -- How could it be longer? See [Arity of data families] in FamInstEnv\n\nNotice that the arg tys might not be the same as the family tycon arity\n(= length tyConTyVars).\n\nNote [Unify kinds in deriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #8534)\n    data T a b = MkT a deriving( Functor )\n    -- where Functor :: (*->*) -> Constraint\n\nSo T :: forall k. * -> k -> *.   We want to get\n    instance Functor (T * (a:*)) where ...\nNotice the '*' argument to T.\n\nMoreover, as well as instantiating T's kind arguments, we may need to instantiate\nC's kind args.  Consider (Trac #8865):\n  newtype T a b = MkT (Either a b) deriving( Category )\nwhere\n  Category :: forall k. (k -> k -> *) -> Constraint\nWe need to generate the instance\n  instance Category * (Either a) where ...\nNotice the '*' argument to Category.\n\nSo we need to\n * drop arguments from (T a b) to match the number of\n   arrows in the (last argument of the) class;\n * and then *unify* kind of the remaining type against the\n   expected kind, to figure out how to instantiate C's and T's\n   kind arguments.\n\nIn the two examples,\n * we unify   kind-of( T k (a:k) ) ~ kind-of( Functor )\n         i.e.      (k -> *) ~ (* -> *)   to find k:=*.\n         yielding  k:=*\n\n * we unify   kind-of( Either ) ~ kind-of( Category )\n         i.e.      (* -> * -> *)  ~ (k -> k -> k)\n         yielding  k:=*\n\nNow we get a kind substitution.  We then need to:\n\n  1. Remove the substituted-out kind variables from the quantified kind vars\n\n  2. Apply the substitution to the kinds of quantified *type* vars\n     (and extend the substitution to reflect this change)\n\n  3. Apply that extended substitution to the non-dropped args (types and\n     kinds) of the type and class\n\nForgetting step (2) caused Trac #8893:\n  data V a = V [a] deriving Functor\n  data P (x::k->*) (a:k) = P (x a) deriving Functor\n  data C (x::k->*) (a:k) = C (V (P x a)) deriving Functor\n\nWhen deriving Functor for P, we unify k to *, but we then want\nan instance   $df :: forall (x:*->*). Functor x => Functor (P * (x:*->*))\nand similarly for C.  Notice the modified kind of x, both at binding\nand occurrence sites.\n\nThis can lead to some surprising results when *visible* kind binder is\nunified (in contrast to the above examples, in which only non-visible kind\nbinders were considered). Consider this example from Trac #11732:\n\n    data T k (a :: k) = MkT deriving Functor\n\nSince unification yields k:=*, this results in a generated instance of:\n\n    instance Functor (T *) where ...\n\nwhich looks odd at first glance, since one might expect the instance head\nto be of the form Functor (T k). Indeed, one could envision an alternative\ngenerated instance of:\n\n    instance (k ~ *) => Functor (T k) where\n\nBut this does not typecheck by design: kind equalities are not allowed to be\nbound in types, only terms. But in essence, the two instance declarations are\nentirely equivalent, since even though (T k) matches any kind k, the only\npossibly value for k is *, since anything else is ill-typed. As a result, we can\njust as comfortably use (T *).\n\nAnother way of thinking about is: deriving clauses often infer constraints.\nFor example:\n\n    data S a = S a deriving Eq\n\ninfers an (Eq a) constraint in the derived instance. By analogy, when we\nare deriving Functor, we might infer an equality constraint (e.g., k ~ *).\nThe only distinction is that GHC instantiates equality constraints directly\nduring the deriving process.\n\nAnother quirk of this design choice manifests when typeclasses have visible\nkind parameters. Consider this code (also from Trac #11732):\n\n    class Cat k (cat :: k -> k -> *) where\n      catId   :: cat a a\n      catComp :: cat b c -> cat a b -> cat a c\n\n    instance Cat * (->) where\n      catId   = id\n      catComp = (.)\n\n    newtype Fun a b = Fun (a -> b) deriving (Cat k)\n\nEven though we requested a derived instance of the form (Cat k Fun), the\nkind unification will actually generate (Cat * Fun) (i.e., the same thing as if\nthe user wrote deriving (Cat *)).\n\nWhat happens with DerivingVia, when you have yet another type? Consider:\n\n  newtype Foo (a :: Type) = MkFoo (Proxy a)\n    deriving Functor via Proxy\n\nAs before, we unify the kind of Foo (* -> *) with the kind of the argument to\nFunctor (* -> *). But that's not enough: the `via` type, Proxy, has the kind\n(k -> *), which is more general than what we want. So we must additionally\nunify (k -> *) with (* -> *).\n\nCurrently, all of this unification is implemented kludgily with the pure\nunifier, which is rather tiresome. Trac #14331 lays out a plan for how this\nmight be made cleaner.\n\nNote [Unification of two kind variables in deriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs a special case of the Note above, it is possible to derive an instance of\na poly-kinded typeclass for a poly-kinded datatype. For example:\n\n    class Category (cat :: k -> k -> *) where\n    newtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category\n\nThis case is suprisingly tricky. To see why, let's write out what instance GHC\nwill attempt to derive (using -fprint-explicit-kinds syntax):\n\n    instance Category k1 (T k2 c) where ...\n\nGHC will attempt to unify k1 and k2, which produces a substitution (kind_subst)\nthat looks like [k2 :-> k1]. Importantly, we need to apply this substitution to\nthe type variable binder for c, since its kind is (k2 -> k2 -> *).\n\nWe used to accomplish this by doing the following:\n\n    unmapped_tkvs = filter (`notElemTCvSubst` kind_subst) all_tkvs\n    (subst, _)    = substTyVarBndrs kind_subst unmapped_tkvs\n\nWhere all_tkvs contains all kind variables in the class and instance types (in\nthis case, all_tkvs = [k1,k2]). But since kind_subst only has one mapping,\nthis results in unmapped_tkvs being [k1], and as a consequence, k1 gets mapped\nto another kind variable in subst! That is, subst = [k2 :-> k1, k1 :-> k_new].\nThis is bad, because applying that substitution yields the following instance:\n\n   instance Category k_new (T k1 c) where ...\n\nIn other words, keeping k1 in unmapped_tvks taints the substitution, resulting\nin an ill-kinded instance (this caused Trac #11837).\n\nTo prevent this, we need to filter out any variable from all_tkvs which either\n\n1. Appears in the domain of kind_subst. notElemTCvSubst checks this.\n2. Appears in the range of kind_subst. To do this, we compute the free\n   variable set of the range of kind_subst with getTCvSubstRangeFVs, and check\n   if a kind variable appears in that set.\n\nNote [Eta-reducing type synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOne can instantiate a type in a data family instance with a type synonym that\nmentions other type variables:\n\n  type Const a b = a\n  data family Fam (f :: * -> *) (a :: *)\n  newtype instance Fam f (Const a f) = Fam (f a) deriving Functor\n\nIt is also possible to define kind synonyms, and they can mention other types in\na datatype declaration. For example,\n\n  type Const a b = a\n  newtype T f (a :: Const * f) = T (f a) deriving Functor\n\nWhen deriving, we need to perform eta-reduction analysis to ensure that none of\nthe eta-reduced type variables are mentioned elsewhere in the declaration. But\nwe need to be careful, because if we don't expand through the Const type\nsynonym, we will mistakenly believe that f is an eta-reduced type variable and\nfail to derive Functor, even though the code above is correct (see Trac #11416,\nwhere this was first noticed). For this reason, we expand the type synonyms in\nthe eta-reduced types before doing any analysis.\n-}\n\nmkEqnHelp :: Maybe OverlapMode\n          -> [TyVar]\n          -> Class -> [Type]\n          -> TyCon -> [Type]\n          -> DerivContext\n               -- SupplyContext => context supplied (standalone deriving)\n               -- InferContext  => context inferred (deriving on data decl, or\n               --                  standalone deriving decl with a wildcard)\n          -> Maybe (DerivStrategy GhcTc)\n          -> TcRn EarlyDerivSpec\n-- Make the EarlyDerivSpec for an instance\n--      forall tvs. theta => cls (tys ++ [ty])\n-- where the 'theta' is optional (that's the Maybe part)\n-- Assumes that this declaration is well-kinded\n\nmkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args deriv_ctxt deriv_strat\n  = do {      -- Find the instance of a data family\n              -- Note [Looking up family instances for deriving]\n         fam_envs <- tcGetFamInstEnvs\n       ; let (rep_tc, rep_tc_args, _co) = tcLookupDataFamInst fam_envs tycon tc_args\n              -- If it's still a data family, the lookup failed; i.e no instance exists\n       ; when (isDataFamilyTyCon rep_tc)\n              (bale_out (text \"No family instance for\" <+> quotes (pprTypeApp tycon tc_args)))\n       ; is_boot <- tcIsHsBootOrSig\n       ; when is_boot $\n              bale_out (text \"Cannot derive instances in hs-boot files\"\n                    $+$ text \"Write an instance declaration instead\")\n\n       ; let deriv_env = DerivEnv\n                         { denv_overlap_mode = overlap_mode\n                         , denv_tvs          = tvs\n                         , denv_cls          = cls\n                         , denv_cls_tys      = cls_tys\n                         , denv_tc           = tycon\n                         , denv_tc_args      = tc_args\n                         , denv_rep_tc       = rep_tc\n                         , denv_rep_tc_args  = rep_tc_args\n                         , denv_ctxt         = deriv_ctxt\n                         , denv_strat        = deriv_strat }\n       ; flip runReaderT deriv_env $\n         if isNewTyCon rep_tc then mkNewTypeEqn else mkDataTypeEqn }\n  where\n     bale_out msg = failWithTc (derivingThingErr False cls cls_tys\n                      (mkTyConApp tycon tc_args) deriv_strat msg)\n\n{-\nNote [Looking up family instances for deriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ntcLookupFamInstExact is an auxiliary lookup wrapper which requires\nthat looked-up family instances exist.  If called with a vanilla\ntycon, the old type application is simply returned.\n\nIf we have\n  data instance F () = ... deriving Eq\n  data instance F () = ... deriving Eq\nthen tcLookupFamInstExact will be confused by the two matches;\nbut that can't happen because tcInstDecls1 doesn't call tcDeriving\nif there are any overlaps.\n\nThere are two other things that might go wrong with the lookup.\nFirst, we might see a standalone deriving clause\n   deriving Eq (F ())\nwhen there is no data instance F () in scope.\n\nNote that it's OK to have\n  data instance F [a] = ...\n  deriving Eq (F [(a,b)])\nwhere the match is not exact; the same holds for ordinary data types\nwith standalone deriving declarations.\n\nNote [Deriving, type families, and partial applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen there are no type families, it's quite easy:\n\n    newtype S a = MkS [a]\n    -- :CoS :: S  ~ []  -- Eta-reduced\n\n    instance Eq [a] => Eq (S a)         -- by coercion sym (Eq (:CoS a)) : Eq [a] ~ Eq (S a)\n    instance Monad [] => Monad S        -- by coercion sym (Monad :CoS)  : Monad [] ~ Monad S\n\nWhen type familes are involved it's trickier:\n\n    data family T a b\n    newtype instance T Int a = MkT [a] deriving( Eq, Monad )\n    -- :RT is the representation type for (T Int a)\n    --  :Co:RT    :: :RT ~ []          -- Eta-reduced!\n    --  :CoF:RT a :: T Int a ~ :RT a   -- Also eta-reduced!\n\n    instance Eq [a] => Eq (T Int a)     -- easy by coercion\n       -- d1 :: Eq [a]\n       -- d2 :: Eq (T Int a) = d1 |> Eq (sym (:Co:RT a ; :coF:RT a))\n\n    instance Monad [] => Monad (T Int)  -- only if we can eta reduce???\n       -- d1 :: Monad []\n       -- d2 :: Monad (T Int) = d1 |> Monad (sym (:Co:RT ; :coF:RT))\n\nNote the need for the eta-reduced rule axioms.  After all, we can\nwrite it out\n    instance Monad [] => Monad (T Int)  -- only if we can eta reduce???\n      return x = MkT [x]\n      ... etc ...\n\nSee Note [Eta reduction for data families] in FamInstEnv\n\n%************************************************************************\n%*                                                                      *\n                Deriving data types\n*                                                                      *\n************************************************************************\n-}\n\n-- | Derive an instance for a data type (i.e., non-newtype).\nmkDataTypeEqn :: DerivM EarlyDerivSpec\nmkDataTypeEqn\n  = do mb_strat <- asks denv_strat\n       let bale_out msg = do err <- derivingThingErrM False msg\n                             lift $ failWithTc err\n       case mb_strat of\n         Just StockStrategy    -> mk_eqn_stock    mk_originative_eqn bale_out\n         Just AnyclassStrategy -> mk_eqn_anyclass mk_originative_eqn bale_out\n         Just (ViaStrategy ty) -> mk_eqn_via ty\n         -- GeneralizedNewtypeDeriving makes no sense for non-newtypes\n         Just NewtypeStrategy  -> bale_out gndNonNewtypeErr\n         -- Lacking a user-requested deriving strategy, we will try to pick\n         -- between the stock or anyclass strategies\n         Nothing -> mk_eqn_no_mechanism mk_originative_eqn bale_out\n\n-- Derive an instance by way of an originative deriving strategy\n-- (stock or anyclass).\n--\n-- See Note [Deriving strategies]\nmk_originative_eqn\n  :: DerivSpecMechanism -- Invariant: This will be DerivSpecStock or\n                        -- DerivSpecAnyclass\n  -> DerivM EarlyDerivSpec\nmk_originative_eqn mechanism\n  = do DerivEnv { denv_overlap_mode = overlap_mode\n                , denv_tvs          = tvs\n                , denv_tc           = tc\n                , denv_tc_args      = tc_args\n                , denv_rep_tc       = rep_tc\n                , denv_cls          = cls\n                , denv_cls_tys      = cls_tys\n                , denv_ctxt         = deriv_ctxt } <- ask\n       let inst_ty  = mkTyConApp tc tc_args\n           inst_tys = cls_tys ++ [inst_ty]\n       doDerivInstErrorChecks1 mechanism\n       loc       <- lift getSrcSpanM\n       dfun_name <- lift $ newDFunName' cls tc\n       case deriv_ctxt of\n        InferContext wildcard ->\n          do { (inferred_constraints, tvs', inst_tys')\n                 <- inferConstraints mechanism\n             ; return $ InferTheta $ DS\n                   { ds_loc = loc\n                   , ds_name = dfun_name, ds_tvs = tvs'\n                   , ds_cls = cls, ds_tys = inst_tys'\n                   , ds_tc = rep_tc\n                   , ds_theta = inferred_constraints\n                   , ds_overlap = overlap_mode\n                   , ds_standalone_wildcard = wildcard\n                   , ds_mechanism = mechanism } }\n\n        SupplyContext theta ->\n            return $ GivenTheta $ DS\n                   { ds_loc = loc\n                   , ds_name = dfun_name, ds_tvs = tvs\n                   , ds_cls = cls, ds_tys = inst_tys\n                   , ds_tc = rep_tc\n                   , ds_theta = theta\n                   , ds_overlap = overlap_mode\n                   , ds_standalone_wildcard = Nothing\n                   , ds_mechanism = mechanism }\n\n-- Derive an instance by way of a coerce-based deriving strategy\n-- (newtype or via).\n--\n-- See Note [Deriving strategies]\nmk_coerce_based_eqn\n  :: (Type -> DerivSpecMechanism) -- Invariant: This will be DerivSpecNewtype\n                                  -- or DerivSpecVia\n  -> Type -- The type to coerce\n  -> DerivM EarlyDerivSpec\nmk_coerce_based_eqn mk_mechanism coerced_ty\n  = do DerivEnv { denv_overlap_mode = overlap_mode\n                , denv_tvs          = tvs\n                , denv_tc           = tycon\n                , denv_tc_args      = tc_args\n                , denv_rep_tc       = rep_tycon\n                , denv_cls          = cls\n                , denv_cls_tys      = cls_tys\n                , denv_ctxt         = deriv_ctxt } <- ask\n       sa_wildcard <- isStandaloneWildcardDeriv\n       let -- The following functions are polymorphic over the representation\n           -- type, since we might either give it the underlying type of a\n           -- newtype (for GeneralizedNewtypeDeriving) or a @via@ type\n           -- (for DerivingVia).\n           rep_tys ty  = cls_tys ++ [ty]\n           rep_pred ty = mkClassPred cls (rep_tys ty)\n           rep_pred_o ty = mkPredOrigin deriv_origin TypeLevel (rep_pred ty)\n                   -- rep_pred is the representation dictionary, from where\n                   -- we are going to get all the methods for the final\n                   -- dictionary\n\n           -- Next we figure out what superclass dictionaries to use\n           -- See Note [Newtype deriving superclasses] above\n           sc_preds   :: [PredOrigin]\n           cls_tyvars = classTyVars cls\n           inst_ty    = mkTyConApp tycon tc_args\n           inst_tys   = cls_tys ++ [inst_ty]\n           sc_preds   = map (mkPredOrigin deriv_origin TypeLevel) $\n                        substTheta (zipTvSubst cls_tyvars inst_tys) $\n                        classSCTheta cls\n           deriv_origin = mkDerivOrigin sa_wildcard\n\n           -- Next we collect constraints for the class methods\n           -- If there are no methods, we don't need any constraints\n           -- Otherwise we need (C rep_ty), for the representation methods,\n           -- and constraints to coerce each individual method\n           meth_preds :: Type -> [PredOrigin]\n           meths = classMethods cls\n           meth_preds ty\n             | null meths = [] -- No methods => no constraints\n                               -- (Trac #12814)\n             | otherwise = rep_pred_o ty : coercible_constraints ty\n           coercible_constraints ty\n             = [ mkPredOrigin (DerivOriginCoerce meth t1 t2 sa_wildcard)\n                              TypeLevel (mkReprPrimEqPred t1 t2)\n               | meth <- meths\n               , let (Pair t1 t2) = mkCoerceClassMethEqn cls tvs\n                                            inst_tys ty meth ]\n\n           all_thetas :: Type -> [ThetaOrigin]\n           all_thetas ty = [mkThetaOriginFromPreds $ meth_preds ty ++ sc_preds]\n\n           inferred_thetas = all_thetas coerced_ty\n       lift $ traceTc \"newtype deriving:\" $\n         ppr tycon <+> ppr (rep_tys coerced_ty) <+> ppr inferred_thetas\n       let mechanism = mk_mechanism coerced_ty\n           bale_out msg = do err <- derivingThingErrMechanism mechanism msg\n                             lift $ failWithTc err\n       atf_coerce_based_error_checks cls bale_out\n       doDerivInstErrorChecks1 mechanism\n       dfun_name <- lift $ newDFunName' cls tycon\n       loc       <- lift getSrcSpanM\n       case deriv_ctxt of\n        SupplyContext theta -> return $ GivenTheta $ DS\n            { ds_loc = loc\n            , ds_name = dfun_name, ds_tvs = tvs\n            , ds_cls = cls, ds_tys = inst_tys\n            , ds_tc = rep_tycon\n            , ds_theta = theta\n            , ds_overlap = overlap_mode\n            , ds_standalone_wildcard = Nothing\n            , ds_mechanism = mechanism }\n        InferContext wildcard -> return $ InferTheta $ DS\n            { ds_loc = loc\n            , ds_name = dfun_name, ds_tvs = tvs\n            , ds_cls = cls, ds_tys = inst_tys\n            , ds_tc = rep_tycon\n            , ds_theta = inferred_thetas\n            , ds_overlap = overlap_mode\n            , ds_standalone_wildcard = wildcard\n            , ds_mechanism = mechanism }\n\n-- Ensure that a class's associated type variables are suitable for\n-- GeneralizedNewtypeDeriving or DerivingVia.\n--\n-- See Note [GND and associated type families]\natf_coerce_based_error_checks\n  :: Class\n  -> (SDoc -> DerivM ())\n  -> DerivM ()\natf_coerce_based_error_checks cls bale_out\n  = let cls_tyvars = classTyVars cls\n\n        ats_look_sensible\n           =  -- Check (a) from Note [GND and associated type families]\n              no_adfs\n              -- Check (b) from Note [GND and associated type families]\n           && isNothing at_without_last_cls_tv\n              -- Check (d) from Note [GND and associated type families]\n           && isNothing at_last_cls_tv_in_kinds\n\n        (adf_tcs, atf_tcs) = partition isDataFamilyTyCon at_tcs\n        no_adfs            = null adf_tcs\n               -- We cannot newtype-derive data family instances\n\n        at_without_last_cls_tv\n          = find (\\tc -> last_cls_tv `notElem` tyConTyVars tc) atf_tcs\n        at_last_cls_tv_in_kinds\n          = find (\\tc -> any (at_last_cls_tv_in_kind . tyVarKind)\n                             (tyConTyVars tc)\n                      || at_last_cls_tv_in_kind (tyConResKind tc)) atf_tcs\n        at_last_cls_tv_in_kind kind\n          = last_cls_tv `elemVarSet` exactTyCoVarsOfType kind\n        at_tcs = classATs cls\n        last_cls_tv = ASSERT( notNull cls_tyvars )\n                      last cls_tyvars\n\n        cant_derive_err\n           = vcat [ ppUnless no_adfs adfs_msg\n                  , maybe empty at_without_last_cls_tv_msg\n                          at_without_last_cls_tv\n                  , maybe empty at_last_cls_tv_in_kinds_msg\n                          at_last_cls_tv_in_kinds\n                  ]\n        adfs_msg  = text \"the class has associated data types\"\n        at_without_last_cls_tv_msg at_tc = hang\n          (text \"the associated type\" <+> quotes (ppr at_tc)\n           <+> text \"is not parameterized over the last type variable\")\n          2 (text \"of the class\" <+> quotes (ppr cls))\n        at_last_cls_tv_in_kinds_msg at_tc = hang\n          (text \"the associated type\" <+> quotes (ppr at_tc)\n           <+> text \"contains the last type variable\")\n         2 (text \"of the class\" <+> quotes (ppr cls)\n           <+> text \"in a kind, which is not (yet) allowed\")\n    in unless ats_look_sensible $ bale_out cant_derive_err\n\nmk_eqn_stock :: (DerivSpecMechanism -> DerivM EarlyDerivSpec)\n             -> (SDoc -> DerivM EarlyDerivSpec)\n             -> DerivM EarlyDerivSpec\nmk_eqn_stock go_for_it bale_out\n  = do DerivEnv { denv_tc      = tc\n                , denv_rep_tc  = rep_tc\n                , denv_cls     = cls\n                , denv_cls_tys = cls_tys\n                , denv_ctxt    = deriv_ctxt } <- ask\n       dflags <- getDynFlags\n       case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys\n                                           tc rep_tc of\n         CanDeriveStock gen_fn -> go_for_it $ DerivSpecStock gen_fn\n         StockClassError msg   -> bale_out msg\n         _                     -> bale_out (nonStdErr cls)\n\nmk_eqn_anyclass :: (DerivSpecMechanism -> DerivM EarlyDerivSpec)\n                -> (SDoc -> DerivM EarlyDerivSpec)\n                -> DerivM EarlyDerivSpec\nmk_eqn_anyclass go_for_it bale_out\n  = do dflags <- getDynFlags\n       case canDeriveAnyClass dflags of\n         IsValid      -> go_for_it DerivSpecAnyClass\n         NotValid msg -> bale_out msg\n\nmk_eqn_newtype :: Type -- The newtype's representation type\n               -> DerivM EarlyDerivSpec\nmk_eqn_newtype = mk_coerce_based_eqn DerivSpecNewtype\n\nmk_eqn_via :: Type -- The @via@ type\n           -> DerivM EarlyDerivSpec\nmk_eqn_via = mk_coerce_based_eqn DerivSpecVia\n\nmk_eqn_no_mechanism :: (DerivSpecMechanism -> DerivM EarlyDerivSpec)\n                    -> (SDoc -> DerivM EarlyDerivSpec)\n                    -> DerivM EarlyDerivSpec\nmk_eqn_no_mechanism go_for_it bale_out\n  = do DerivEnv { denv_tc      = tc\n                , denv_rep_tc  = rep_tc\n                , denv_cls     = cls\n                , denv_cls_tys = cls_tys\n                , denv_ctxt    = deriv_ctxt } <- ask\n       dflags <- getDynFlags\n\n           -- See Note [Deriving instances for classes themselves]\n       let dac_error msg\n             | isClassTyCon rep_tc\n             = quotes (ppr tc) <+> text \"is a type class,\"\n                               <+> text \"and can only have a derived instance\"\n                               $+$ text \"if DeriveAnyClass is enabled\"\n             | otherwise\n             = nonStdErr cls $$ msg\n\n       case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys\n                                           tc rep_tc of\n           -- NB: pass the *representation* tycon to\n           -- checkOriginativeSideConditions\n           NonDerivableClass   msg -> bale_out (dac_error msg)\n           StockClassError msg     -> bale_out msg\n           CanDeriveStock gen_fn   -> go_for_it $ DerivSpecStock gen_fn\n           CanDeriveAnyClass       -> go_for_it DerivSpecAnyClass\n\n{-\n************************************************************************\n*                                                                      *\n            GeneralizedNewtypeDeriving and DerivingVia\n*                                                                      *\n************************************************************************\n-}\n\n-- | Derive an instance for a newtype.\nmkNewTypeEqn :: DerivM EarlyDerivSpec\nmkNewTypeEqn\n-- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...\n  = do DerivEnv { denv_tc           = tycon\n                , denv_rep_tc       = rep_tycon\n                , denv_rep_tc_args  = rep_tc_args\n                , denv_cls          = cls\n                , denv_cls_tys      = cls_tys\n                , denv_ctxt         = deriv_ctxt\n                , denv_strat        = mb_strat } <- ask\n       dflags <- getDynFlags\n\n       let newtype_deriving  = xopt LangExt.GeneralizedNewtypeDeriving dflags\n           deriveAnyClass    = xopt LangExt.DeriveAnyClass             dflags\n           bale_out        = bale_out' newtype_deriving\n           bale_out' b msg = do err <- derivingThingErrM b msg\n                                lift $ failWithTc err\n\n           non_std     = nonStdErr cls\n           suggest_gnd = text \"Try GeneralizedNewtypeDeriving for GHC's\"\n                     <+> text \"newtype-deriving extension\"\n\n           -- Here is the plan for newtype derivings.  We see\n           --        newtype T a1...an = MkT (t ak+1...an)\n           --          deriving (.., C s1 .. sm, ...)\n           -- where t is a type,\n           --       ak+1...an is a suffix of a1..an, and are all tyvars\n           --       ak+1...an do not occur free in t, nor in the s1..sm\n           --       (C s1 ... sm) is a  *partial applications* of class C\n           --                      with the last parameter missing\n           --       (T a1 .. ak) matches the kind of C's last argument\n           --              (and hence so does t)\n           -- The latter kind-check has been done by deriveTyData already,\n           -- and tc_args are already trimmed\n           --\n           -- We generate the instance\n           --       instance forall ({a1..ak} u fvs(s1..sm)).\n           --                C s1 .. sm t => C s1 .. sm (T a1...ak)\n           -- where T a1...ap is the partial application of\n           --       the LHS of the correct kind and p >= k\n           --\n           --      NB: the variables below are:\n           --              tc_tvs = [a1, ..., an]\n           --              tyvars_to_keep = [a1, ..., ak]\n           --              rep_ty = t ak .. an\n           --              deriv_tvs = fvs(s1..sm) \\ tc_tvs\n           --              tys = [s1, ..., sm]\n           --              rep_fn' = t\n           --\n           -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )\n           -- We generate the instance\n           --      instance Monad (ST s) => Monad (T s) where\n\n           nt_eta_arity = newTyConEtadArity rep_tycon\n                   -- For newtype T a b = MkT (S a a b), the TyCon\n                   -- machinery already eta-reduces the representation type, so\n                   -- we know that\n                   --      T a ~ S a a\n                   -- That's convenient here, because we may have to apply\n                   -- it to fewer than its original complement of arguments\n\n           -- Note [Newtype representation]\n           -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n           -- Need newTyConRhs (*not* a recursive representation finder)\n           -- to get the representation type. For example\n           --      newtype B = MkB Int\n           --      newtype A = MkA B deriving( Num )\n           -- We want the Num instance of B, *not* the Num instance of Int,\n           -- when making the Num instance of A!\n           rep_inst_ty = newTyConInstRhs rep_tycon rep_tc_args\n\n           -------------------------------------------------------------------\n           --  Figuring out whether we can only do this newtype-deriving thing\n\n           -- See Note [Determining whether newtype-deriving is appropriate]\n           might_be_newtype_derivable\n              =  not (non_coercible_class cls)\n              && eta_ok\n--            && not (isRecursiveTyCon tycon)      -- Note [Recursive newtypes]\n\n           -- Check that eta reduction is OK\n           eta_ok = rep_tc_args `lengthAtLeast` nt_eta_arity\n             -- The newtype can be eta-reduced to match the number\n             --     of type argument actually supplied\n             --        newtype T a b = MkT (S [a] b) deriving( Monad )\n             --     Here the 'b' must be the same in the rep type (S [a] b)\n             --     And the [a] must not mention 'b'.  That's all handled\n             --     by nt_eta_rity.\n\n           cant_derive_err = ppUnless eta_ok  eta_msg\n           eta_msg = text \"cannot eta-reduce the representation type enough\"\n\n       MASSERT( cls_tys `lengthIs` (classArity cls - 1) )\n       case mb_strat of\n         Just StockStrategy    -> mk_eqn_stock    mk_originative_eqn bale_out\n         Just AnyclassStrategy -> mk_eqn_anyclass mk_originative_eqn bale_out\n         Just NewtypeStrategy  ->\n           -- Since the user explicitly asked for GeneralizedNewtypeDeriving,\n           -- we don't need to perform all of the checks we normally would,\n           -- such as if the class being derived is known to produce ill-roled\n           -- coercions (e.g., Traversable), since we can just derive the\n           -- instance and let it error if need be.\n           -- See Note [Determining whether newtype-deriving is appropriate]\n           if eta_ok && newtype_deriving\n             then mk_eqn_newtype rep_inst_ty\n             else bale_out (cant_derive_err $$\n                            if newtype_deriving then empty else suggest_gnd)\n         Just (ViaStrategy via_ty) ->\n           -- NB: For DerivingVia, we don't need to any eta-reduction checking,\n           -- since the @via@ type is already \"eta-reduced\".\n           mk_eqn_via via_ty\n         Nothing\n           | might_be_newtype_derivable\n             && ((newtype_deriving && not deriveAnyClass)\n                  || std_class_via_coercible cls)\n          -> mk_eqn_newtype rep_inst_ty\n           | otherwise\n          -> case checkOriginativeSideConditions dflags deriv_ctxt cls cls_tys\n                                                 tycon rep_tycon of\n               StockClassError msg\n                 -- There's a particular corner case where\n                 --\n                 -- 1. -XGeneralizedNewtypeDeriving and -XDeriveAnyClass are\n                 --    both enabled at the same time\n                 -- 2. We're deriving a particular stock derivable class\n                 --    (such as Functor)\n                 --\n                 -- and the previous cases won't catch it. This fixes the bug\n                 -- reported in Trac #10598.\n                 | might_be_newtype_derivable && newtype_deriving\n                -> mk_eqn_newtype rep_inst_ty\n                 -- Otherwise, throw an error for a stock class\n                 | might_be_newtype_derivable && not newtype_deriving\n                -> bale_out (msg $$ suggest_gnd)\n                 | otherwise\n                -> bale_out msg\n\n               -- Must use newtype deriving or DeriveAnyClass\n               NonDerivableClass _msg\n                 -- Too hard, even with newtype deriving\n                 | newtype_deriving           -> bale_out cant_derive_err\n                 -- Try newtype deriving!\n                 -- Here we suggest GeneralizedNewtypeDeriving even in cases\n                 -- where it may not be applicable. See Trac #9600.\n                 | otherwise                  -> bale_out (non_std $$ suggest_gnd)\n\n               -- DeriveAnyClass\n               CanDeriveAnyClass -> do\n                 -- If both DeriveAnyClass and GeneralizedNewtypeDeriving are\n                 -- enabled, we take the diplomatic approach of defaulting to\n                 -- DeriveAnyClass, but emitting a warning about the choice.\n                 -- See Note [Deriving strategies]\n                 when (newtype_deriving && deriveAnyClass) $\n                   lift $ addWarnTc NoReason $ sep\n                     [ text \"Both DeriveAnyClass and\"\n                       <+> text \"GeneralizedNewtypeDeriving are enabled\"\n                     , text \"Defaulting to the DeriveAnyClass strategy\"\n                       <+> text \"for instantiating\" <+> ppr cls\n                     , text \"Use DerivingStrategies to pick\"\n                       <+> text \"a different strategy\"\n                      ]\n                 mk_originative_eqn DerivSpecAnyClass\n               -- CanDeriveStock\n               CanDeriveStock gen_fn -> mk_originative_eqn $\n                                        DerivSpecStock gen_fn\n\n{-\nNote [Recursive newtypes]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nNewtype deriving works fine, even if the newtype is recursive.\ne.g.    newtype S1 = S1 [T1 ()]\n        newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )\nRemember, too, that type families are currently (conservatively) given\na recursive flag, so this also allows newtype deriving to work\nfor type famillies.\n\nWe used to exclude recursive types, because we had a rather simple\nminded way of generating the instance decl:\n   newtype A = MkA [A]\n   instance Eq [A] => Eq A      -- Makes typechecker loop!\nBut now we require a simple context, so it's ok.\n\nNote [Determining whether newtype-deriving is appropriate]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we see\n  newtype NT = MkNT Foo\n    deriving C\nwe have to decide how to perform the deriving. Do we do newtype deriving,\nor do we do normal deriving? In general, we prefer to do newtype deriving\nwherever possible. So, we try newtype deriving unless there's a glaring\nreason not to.\n\n\"Glaring reasons not to\" include trying to derive a class for which a\ncoercion-based instance doesn't make sense. These classes are listed in\nthe definition of non_coercible_class. They include Show (since it must\nshow the name of the datatype) and Traversable (since a coercion-based\nTraversable instance is ill-roled).\n\nHowever, non_coercible_class is ignored if the user explicitly requests\nto derive an instance with GeneralizedNewtypeDeriving using the newtype\nderiving strategy. In such a scenario, GHC will unquestioningly try to\nderive the instance via coercions (even if the final generated code is\nill-roled!). See Note [Deriving strategies].\n\nNote that newtype deriving might fail, even after we commit to it. This\nis because the derived instance uses `coerce`, which must satisfy its\n`Coercible` constraint. This is different than other deriving scenarios,\nwhere we're sure that the resulting instance will type-check.\n\nNote [GND and associated type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's possible to use GeneralizedNewtypeDeriving (GND) to derive instances for\nclasses with associated type families. A general recipe is:\n\n    class C x y z where\n      type T y z x\n      op :: x -> [y] -> z\n\n    newtype N a = MkN <rep-type> deriving( C )\n\n    =====>\n\n    instance C x y <rep-type> => C x y (N a) where\n      type T y (N a) x = T y <rep-type> x\n      op = coerce (op :: x -> [y] -> <rep-type>)\n\nHowever, we must watch out for three things:\n\n(a) The class must not contain any data families. If it did, we'd have to\n    generate a fresh data constructor name for the derived data family\n    instance, and it's not clear how to do this.\n\n(b) Each associated type family's type variables must mention the last type\n    variable of the class. As an example, you wouldn't be able to use GND to\n    derive an instance of this class:\n\n      class C a b where\n        type T a\n\n    But you would be able to derive an instance of this class:\n\n      class C a b where\n        type T b\n\n    The difference is that in the latter T mentions the last parameter of C\n    (i.e., it mentions b), but the former T does not. If you tried, e.g.,\n\n      newtype Foo x = Foo x deriving (C a)\n\n    with the former definition of C, you'd end up with something like this:\n\n      instance C a (Foo x) where\n        type T a = T ???\n\n    This T family instance doesn't mention the newtype (or its representation\n    type) at all, so we disallow such constructions with GND.\n\n(c) UndecidableInstances might need to be enabled. Here's a case where it is\n    most definitely necessary:\n\n      class C a where\n        type T a\n      newtype Loop = Loop MkLoop deriving C\n\n      =====>\n\n      instance C Loop where\n        type T Loop = T Loop\n\n    Obviously, T Loop would send the typechecker into a loop. Unfortunately,\n    you might even need UndecidableInstances even in cases where the\n    typechecker would be guaranteed to terminate. For example:\n\n      instance C Int where\n        type C Int = Int\n      newtype MyInt = MyInt Int deriving C\n\n      =====>\n\n      instance C MyInt where\n        type T MyInt = T Int\n\n    GHC's termination checker isn't sophisticated enough to conclude that the\n    definition of T MyInt terminates, so UndecidableInstances is required.\n\n(d) For the time being, we do not allow the last type variable of the class to\n    appear in a /kind/ of an associated type family definition. For instance:\n\n    class C a where\n      type T1 a        -- OK\n      type T2 (x :: a) -- Illegal: a appears in the kind of x\n      type T3 y :: a   -- Illegal: a appears in the kind of (T3 y)\n\n    The reason we disallow this is because our current approach to deriving\n    associated type family instances\u00e2\u20ac\u201di.e., by unwrapping the newtype's type\n    constructor as shown above\u00e2\u20ac\u201dis ill-equipped to handle the scenario when\n    the last type variable appears as an implicit argument. In the worst case,\n    allowing the last variable to appear in a kind can result in improper Core\n    being generated (see #14728).\n\n    There is hope for this feature being added some day, as one could\n    conceivably take a newtype axiom (which witnesses a coercion between a\n    newtype and its representation type) at lift that through each associated\n    type at the Core level. See #14728, comment:3 for a sketch of how this\n    might work. Until then, we disallow this featurette wholesale.\n\nThe same criteria apply to DerivingVia.\n\n************************************************************************\n*                                                                      *\n\\subsection[TcDeriv-normal-binds]{Bindings for the various classes}\n*                                                                      *\n************************************************************************\n\nAfter all the trouble to figure out the required context for the\nderived instance declarations, all that's left is to chug along to\nproduce them.  They will then be shoved into @tcInstDecls2@, which\nwill do all its usual business.\n\nThere are lots of possibilities for code to generate.  Here are\nvarious general remarks.\n\nPRINCIPLES:\n\\begin{itemize}\n\\item\nWe want derived instances of @Eq@ and @Ord@ (both v common) to be\n``you-couldn't-do-better-by-hand'' efficient.\n\n\\item\nDeriving @Show@---also pretty common--- should also be reasonable good code.\n\n\\item\nDeriving for the other classes isn't that common or that big a deal.\n\\end{itemize}\n\nPRAGMATICS:\n\n\\begin{itemize}\n\\item\nDeriving @Ord@ is done mostly with the 1.3 @compare@ method.\n\n\\item\nDeriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.\n\n\\item\nWe {\\em normally} generate code only for the non-defaulted methods;\nthere are some exceptions for @Eq@ and (especially) @Ord@...\n\n\\item\nSometimes we use a @_con2tag_<tycon>@ function, which returns a data\nconstructor's numeric (@Int#@) tag.  These are generated by\n@gen_tag_n_con_binds@, and the heuristic for deciding if one of\nthese is around is given by @hasCon2TagFun@.\n\nThe examples under the different sections below will make this\nclearer.\n\n\\item\nMuch less often (really just for deriving @Ix@), we use a\n@_tag2con_<tycon>@ function.  See the examples.\n\n\\item\nWe use the renamer!!!  Reason: we're supposed to be\nproducing @LHsBinds Name@ for the methods, but that means\nproducing correctly-uniquified code on the fly.  This is entirely\npossible (the @TcM@ monad has a @UniqueSupply@), but it is painful.\nSo, instead, we produce @MonoBinds RdrName@ then heave 'em through\nthe renamer.  What a great hack!\n\\end{itemize}\n-}\n\n-- Generate the InstInfo for the required instance paired with the\n--   *representation* tycon for that instance,\n-- plus any auxiliary bindings required\n--\n-- Representation tycons differ from the tycon in the instance signature in\n-- case of instances for indexed families.\n--\ngenInst :: DerivSpec theta\n        -> TcM (ThetaType -> TcM (InstInfo GhcPs), BagDerivStuff, [Name])\n-- We must use continuation-returning style here to get the order in which we\n-- typecheck family instances and derived instances right.\n-- See Note [Staging of tcDeriving]\ngenInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon\n                 , ds_mechanism = mechanism, ds_tys = tys\n                 , ds_cls = clas, ds_loc = loc\n                 , ds_standalone_wildcard = wildcard })\n  = do (meth_binds, deriv_stuff, unusedNames)\n         <- set_span_and_ctxt $\n            genDerivStuff mechanism loc clas rep_tycon tys tvs\n       let mk_inst_info theta = set_span_and_ctxt $ do\n             inst_spec <- newDerivClsInst theta spec\n             doDerivInstErrorChecks2 clas inst_spec theta wildcard mechanism\n             traceTc \"newder\" (ppr inst_spec)\n             return $ InstInfo\n                       { iSpec   = inst_spec\n                       , iBinds  = InstBindings\n                                     { ib_binds = meth_binds\n                                     , ib_tyvars = map Var.varName tvs\n                                     , ib_pragmas = []\n                                     , ib_extensions = extensions\n                                     , ib_derived = True } }\n       return (mk_inst_info, deriv_stuff, unusedNames)\n  where\n    extensions :: [LangExt.Extension]\n    extensions\n      | isDerivSpecNewtype mechanism || isDerivSpecVia mechanism\n        -- Both these flags are needed for higher-rank uses of coerce\n        -- See Note [Newtype-deriving instances] in TcGenDeriv\n      = [LangExt.ImpredicativeTypes, LangExt.RankNTypes]\n      | otherwise\n      = []\n\n    set_span_and_ctxt :: TcM a -> TcM a\n    set_span_and_ctxt = setSrcSpan loc . addErrCtxt (instDeclCtxt3 clas tys)\n\ndoDerivInstErrorChecks1 :: DerivSpecMechanism -> DerivM ()\ndoDerivInstErrorChecks1 mechanism = do\n    DerivEnv { denv_tc      = tc\n             , denv_rep_tc  = rep_tc } <- ask\n    standalone <- isStandaloneDeriv\n    let anyclass_strategy = isDerivSpecAnyClass mechanism\n        via_strategy      = isDerivSpecVia mechanism\n        bale_out msg = do err <- derivingThingErrMechanism mechanism msg\n                          lift $ failWithTc err\n\n    -- For standalone deriving, check that all the data constructors are in\n    -- scope...\n    rdr_env <- lift getGlobalRdrEnv\n    let data_con_names = map dataConName (tyConDataCons rep_tc)\n        hidden_data_cons = not (isWiredInName (tyConName rep_tc)) &&\n                           (isAbstractTyCon rep_tc ||\n                            any not_in_scope data_con_names)\n        not_in_scope dc  = isNothing (lookupGRE_Name rdr_env dc)\n\n    lift $ addUsedDataCons rdr_env rep_tc\n\n    -- ...however, we don't perform this check if we're using DeriveAnyClass,\n    -- since it doesn't generate any code that requires use of a data\n    -- constructor. Nor do we perform this check with @deriving via@, as it\n    -- doesn't explicitly require the constructors to be in scope.\n    unless (anyclass_strategy || via_strategy\n            || not standalone || not hidden_data_cons) $\n           bale_out $ derivingHiddenErr tc\n\ndoDerivInstErrorChecks2 :: Class -> ClsInst -> ThetaType -> Maybe SrcSpan\n                        -> DerivSpecMechanism -> TcM ()\ndoDerivInstErrorChecks2 clas clas_inst theta wildcard mechanism\n  = do { traceTc \"doDerivInstErrorChecks2\" (ppr clas_inst)\n       ; dflags <- getDynFlags\n       ; xpartial_sigs <- xoptM LangExt.PartialTypeSignatures\n       ; wpartial_sigs <- woptM Opt_WarnPartialTypeSignatures\n\n         -- Error if PartialTypeSignatures isn't enabled when a user tries\n         -- to write @deriving instance _ => Eq (Foo a)@. Or, if that\n         -- extension is enabled, give a warning if -Wpartial-type-signatures\n         -- is enabled.\n       ; case wildcard of\n           Nothing -> pure ()\n           Just span -> setSrcSpan span $ do\n             checkTc xpartial_sigs (hang partial_sig_msg 2 pts_suggestion)\n             warnTc (Reason Opt_WarnPartialTypeSignatures)\n                    wpartial_sigs partial_sig_msg\n\n         -- Check for Generic instances that are derived with an exotic\n         -- deriving strategy like DAC\n         -- See Note [Deriving strategies]\n       ; when (exotic_mechanism && className clas `elem` genericClassNames) $\n         do { failIfTc (safeLanguageOn dflags) gen_inst_err\n            ; when (safeInferOn dflags) (recordUnsafeInfer emptyBag) } }\n  where\n    exotic_mechanism = not $ isDerivSpecStock mechanism\n\n    partial_sig_msg = text \"Found type wildcard\" <+> quotes (char '_')\n                  <+> text \"standing for\" <+> quotes (pprTheta theta)\n\n    pts_suggestion\n      = text \"To use the inferred type, enable PartialTypeSignatures\"\n\n    gen_inst_err = text \"Generic instances can only be derived in\"\n               <+> text \"Safe Haskell using the stock strategy.\"\n\ngenDerivStuff :: DerivSpecMechanism -> SrcSpan -> Class\n              -> TyCon -> [Type] -> [TyVar]\n              -> TcM (LHsBinds GhcPs, BagDerivStuff, [Name])\ngenDerivStuff mechanism loc clas tycon inst_tys tyvars\n  = case mechanism of\n      -- See Note [Bindings for Generalised Newtype Deriving]\n      DerivSpecNewtype rhs_ty -> gen_newtype_or_via rhs_ty\n\n      -- Try a stock deriver\n      DerivSpecStock gen_fn -> gen_fn loc tycon inst_tys\n\n      -- Try DeriveAnyClass\n      DerivSpecAnyClass -> do\n        let mini_env   = mkVarEnv (classTyVars clas `zip` inst_tys)\n            mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env\n        dflags <- getDynFlags\n        tyfam_insts <-\n          -- canDeriveAnyClass should ensure that this code can't be reached\n          -- unless -XDeriveAnyClass is enabled.\n          ASSERT2( isValid (canDeriveAnyClass dflags)\n                 , ppr \"genDerivStuff: bad derived class\" <+> ppr clas )\n          mapM (tcATDefault loc mini_subst emptyNameSet)\n               (classATItems clas)\n        return ( emptyBag -- No method bindings are needed...\n               , listToBag (map DerivFamInst (concat tyfam_insts))\n               -- ...but we may need to generate binding for associated type\n               -- family default instances.\n               -- See Note [DeriveAnyClass and default family instances]\n               , [] )\n\n      -- Try DerivingVia\n      DerivSpecVia via_ty -> gen_newtype_or_via via_ty\n  where\n    gen_newtype_or_via ty = do\n      (binds, faminsts) <- gen_Newtype_binds loc clas tyvars inst_tys ty\n      return (binds, faminsts, maybeToList unusedConName)\n\n    unusedConName :: Maybe Name\n    unusedConName\n      | isDerivSpecNewtype mechanism\n        -- See Note [Newtype deriving and unused constructors]\n      = Just $ getName $ head $ tyConDataCons tycon\n      | otherwise\n      = Nothing\n\n{-\nNote [Bindings for Generalised Newtype Deriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  class Eq a => C a where\n     f :: a -> a\n  newtype N a = MkN [a] deriving( C )\n  instance Eq (N a) where ...\n\nThe 'deriving C' clause generates, in effect\n  instance (C [a], Eq a) => C (N a) where\n     f = coerce (f :: [a] -> [a])\n\nThis generates a cast for each method, but allows the superclasse to\nbe worked out in the usual way.  In this case the superclass (Eq (N\na)) will be solved by the explicit Eq (N a) instance.  We do *not*\ncreate the superclasses by casting the superclass dictionaries for the\nrepresentation type.\n\nSee the paper \"Safe zero-cost coercions for Haskell\".\n\nNote [DeriveAnyClass and default family instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen a class has a associated type family with a default instance, e.g.:\n\n  class C a where\n    type T a\n    type T a = Char\n\nthen there are a couple of scenarios in which a user would expect T a to\ndefault to Char. One is when an instance declaration for C is given without\nan implementation for T:\n\n  instance C Int\n\nAnother scenario in which this can occur is when the -XDeriveAnyClass extension\nis used:\n\n  data Example = Example deriving (C, Generic)\n\nIn the latter case, we must take care to check if C has any associated type\nfamilies with default instances, because -XDeriveAnyClass will never provide\nan implementation for them. We \"fill in\" the default instances using the\ntcATDefault function from TcClassDcl (which is also used in TcInstDcls to\nhandle the empty instance declaration case).\n\nNote [Deriving strategies]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC has a notion of deriving strategies, which allow the user to explicitly\nrequest which approach to use when deriving an instance (enabled with the\n-XDerivingStrategies language extension). For more information, refer to the\noriginal Trac ticket (#10598) or the associated wiki page:\nhttps://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies\n\nA deriving strategy can be specified in a deriving clause:\n\n    newtype Foo = MkFoo Bar\n      deriving newtype C\n\nOr in a standalone deriving declaration:\n\n    deriving anyclass instance C Foo\n\n-XDerivingStrategies also allows the use of multiple deriving clauses per data\ndeclaration so that a user can derive some instance with one deriving strategy\nand other instances with another deriving strategy. For example:\n\n    newtype Baz = Baz Quux\n      deriving          (Eq, Ord)\n      deriving stock    (Read, Show)\n      deriving newtype  (Num, Floating)\n      deriving anyclass C\n\nCurrently, the deriving strategies are:\n\n* stock: Have GHC implement a \"standard\" instance for a data type, if possible\n  (e.g., Eq, Ord, Generic, Data, Functor, etc.)\n\n* anyclass: Use -XDeriveAnyClass\n\n* newtype: Use -XGeneralizedNewtypeDeriving\n\n* via: Use -XDerivingVia\n\nThe latter two strategies (newtype and via) are referred to as the\n\"coerce-based\" strategies, since they generate code that relies on the `coerce`\nfunction. The former two strategies (stock and anyclass), in contrast, are\nreferred to as the \"originative\" strategies, since they create \"original\"\ninstances instead of \"reusing\" old instances (by way of `coerce`).\n\nIf an explicit deriving strategy is not given, GHC has an algorithm it uses to\ndetermine which strategy it will actually use. The algorithm is quite long,\nso it lives in the Haskell wiki at\nhttps://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies\n(\"The deriving strategy resolution algorithm\" section).\n\nInternally, GHC uses the DerivStrategy datatype to denote a user-requested\nderiving strategy, and it uses the DerivSpecMechanism datatype to denote what\nGHC will use to derive the instance after taking the above steps. In other\nwords, GHC will always settle on a DerivSpecMechnism, even if the user did not\nask for a particular DerivStrategy (using the algorithm linked to above).\n\nNote [Deriving instances for classes themselves]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMuch of the code in TcDeriv assumes that deriving only works on data types.\nBut this assumption doesn't hold true for DeriveAnyClass, since it's perfectly\nreasonable to do something like this:\n\n  {-# LANGUAGE DeriveAnyClass #-}\n  class C1 (a :: Constraint) where\n  class C2 where\n  deriving instance C1 C2\n    -- This is equivalent to `instance C1 C2`\n\nIf DeriveAnyClass isn't enabled in the code above (i.e., it defaults to stock\nderiving), we throw a special error message indicating that DeriveAnyClass is\nthe only way to go. We don't bother throwing this error if an explicit 'stock'\nor 'newtype' keyword is used, since both options have their own perfectly\nsensible error messages in the case of the above code (as C1 isn't a stock\nderivable class, and C2 isn't a newtype).\n\n************************************************************************\n*                                                                      *\n\\subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}\n*                                                                      *\n************************************************************************\n-}\n\nnonUnaryErr :: LHsSigType GhcRn -> SDoc\nnonUnaryErr ct = quotes (ppr ct)\n  <+> text \"is not a unary constraint, as expected by a deriving clause\"\n\nnonStdErr :: Class -> SDoc\nnonStdErr cls =\n      quotes (ppr cls)\n  <+> text \"is not a stock derivable class (Eq, Show, etc.)\"\n\ngndNonNewtypeErr :: SDoc\ngndNonNewtypeErr =\n  text \"GeneralizedNewtypeDeriving cannot be used on non-newtypes\"\n\nderivingNullaryErr :: MsgDoc\nderivingNullaryErr = text \"Cannot derive instances for nullary classes\"\n\nderivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Bool -> MsgDoc\nderivingKindErr tc cls cls_tys cls_kind enough_args\n  = sep [ hang (text \"Cannot derive well-kinded instance of form\"\n                      <+> quotes (pprClassPred cls cls_tys\n                                    <+> parens (ppr tc <+> text \"...\")))\n               2 gen1_suggestion\n        , nest 2 (text \"Class\" <+> quotes (ppr cls)\n                      <+> text \"expects an argument of kind\"\n                      <+> quotes (pprKind cls_kind))\n        ]\n  where\n    gen1_suggestion | cls `hasKey` gen1ClassKey && enough_args\n                    = text \"(Perhaps you intended to use PolyKinds)\"\n                    | otherwise = Outputable.empty\n\nderivingViaKindErr :: Class -> Kind -> Type -> Kind -> MsgDoc\nderivingViaKindErr cls cls_kind via_ty via_kind\n  = hang (text \"Cannot derive instance via\" <+> quotes (pprType via_ty))\n       2 (text \"Class\" <+> quotes (ppr cls)\n               <+> text \"expects an argument of kind\"\n               <+> quotes (pprKind cls_kind) <> char ','\n      $+$ text \"but\" <+> quotes (pprType via_ty)\n               <+> text \"has kind\" <+> quotes (pprKind via_kind))\n\nderivingEtaErr :: Class -> [Type] -> Type -> MsgDoc\nderivingEtaErr cls cls_tys inst_ty\n  = sep [text \"Cannot eta-reduce to an instance of form\",\n         nest 2 (text \"instance (...) =>\"\n                <+> pprClassPred cls (cls_tys ++ [inst_ty]))]\n\nderivingThingErr :: Bool -> Class -> [Type] -> Type\n                 -> Maybe (DerivStrategy GhcTc) -> MsgDoc -> MsgDoc\nderivingThingErr newtype_deriving cls cls_tys inst_ty mb_strat why\n  = derivingThingErr' newtype_deriving cls cls_tys inst_ty mb_strat\n                      (maybe empty derivStrategyName mb_strat) why\n\nderivingThingErrM :: Bool -> MsgDoc -> DerivM MsgDoc\nderivingThingErrM newtype_deriving why\n  = do DerivEnv { denv_tc      = tc\n                , denv_tc_args = tc_args\n                , denv_cls     = cls\n                , denv_cls_tys = cls_tys\n                , denv_strat   = mb_strat } <- ask\n       pure $ derivingThingErr newtype_deriving cls cls_tys\n                               (mkTyConApp tc tc_args) mb_strat why\n\nderivingThingErrMechanism :: DerivSpecMechanism -> MsgDoc -> DerivM MsgDoc\nderivingThingErrMechanism mechanism why\n  = do DerivEnv { denv_tc      = tc\n                , denv_tc_args = tc_args\n                , denv_cls     = cls\n                , denv_cls_tys = cls_tys\n                , denv_strat   = mb_strat } <- ask\n       pure $ derivingThingErr' (isDerivSpecNewtype mechanism) cls cls_tys\n                (mkTyConApp tc tc_args) mb_strat\n                (derivStrategyName $ derivSpecMechanismToStrategy mechanism)\n                why\n\nderivingThingErr' :: Bool -> Class -> [Type] -> Type\n                  -> Maybe (DerivStrategy GhcTc) -> MsgDoc -> MsgDoc -> MsgDoc\nderivingThingErr' newtype_deriving cls cls_tys inst_ty mb_strat strat_msg why\n  = sep [(hang (text \"Can't make a derived instance of\")\n             2 (quotes (ppr pred) <+> via_mechanism)\n          $$ nest 2 extra) <> colon,\n         nest 2 why]\n  where\n    strat_used = isJust mb_strat\n    extra | not strat_used, newtype_deriving\n          = text \"(even with cunning GeneralizedNewtypeDeriving)\"\n          | otherwise = empty\n    pred = mkClassPred cls (cls_tys ++ [inst_ty])\n    via_mechanism | strat_used\n                  = text \"with the\" <+> strat_msg <+> text \"strategy\"\n                  | otherwise\n                  = empty\n\nderivingHiddenErr :: TyCon -> SDoc\nderivingHiddenErr tc\n  = hang (text \"The data constructors of\" <+> quotes (ppr tc) <+> ptext (sLit \"are not all in scope\"))\n       2 (text \"so you cannot derive an instance for it\")\n\nstandaloneCtxt :: LHsSigWcType GhcRn -> SDoc\nstandaloneCtxt ty = hang (text \"In the stand-alone deriving instance for\")\n                       2 (quotes (ppr ty))\n", "num_lines": 2243}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nFunctions for inferring (and simplifying) the context for derived instances.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE MultiWayIf #-}\n\nmodule TcDerivInfer (inferConstraints, simplifyInstanceContexts) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Bag\nimport BasicTypes\nimport Class\nimport DataCon\nimport ErrUtils\nimport Inst\nimport Outputable\nimport PrelNames\nimport TcDerivUtils\nimport TcEnv\nimport TcGenFunctor\nimport TcGenGenerics\nimport TcMType\nimport TcRnMonad\nimport TcType\nimport TyCon\nimport Type\nimport TcSimplify\nimport TcValidity (validDerivPred)\nimport TcUnify (buildImplicationFor, checkConstraints)\nimport Unify (tcUnifyTy)\nimport Util\nimport Var\nimport VarSet\n\nimport Control.Monad\nimport Control.Monad.Trans.Class  (lift)\nimport Control.Monad.Trans.Reader (ask)\nimport Data.List\nimport Data.Maybe\n\n----------------------\n\ninferConstraints :: DerivSpecMechanism\n                 -> DerivM ([ThetaOrigin], [TyVar], [TcType])\n-- inferConstraints figures out the constraints needed for the\n-- instance declaration generated by a 'deriving' clause on a\n-- data type declaration. It also returns the new in-scope type\n-- variables and instance types, in case they were changed due to\n-- the presence of functor-like constraints.\n-- See Note [Inferring the instance context]\n\n-- e.g. inferConstraints\n--        C Int (T [a])    -- Class and inst_tys\n--        :RTList a        -- Rep tycon and its arg tys\n-- where T [a] ~R :RTList a\n--\n-- Generate a sufficiently large set of constraints that typechecking the\n-- generated method definitions should succeed.   This set will be simplified\n-- before being used in the instance declaration\ninferConstraints mechanism\n  = do { DerivEnv { denv_tc          = tc\n                  , denv_tc_args     = tc_args\n                  , denv_cls         = main_cls\n                  , denv_cls_tys     = cls_tys } <- ask\n       ; wildcard <- isStandaloneWildcardDeriv\n       ; let is_anyclass = isDerivSpecAnyClass mechanism\n             infer_constraints\n               | is_anyclass = inferConstraintsDAC inst_tys\n               | otherwise   = inferConstraintsDataConArgs inst_ty inst_tys\n\n             inst_ty  = mkTyConApp tc tc_args\n             inst_tys = cls_tys ++ [inst_ty]\n\n             -- Constraints arising from superclasses\n             -- See Note [Superclasses of derived instance]\n             cls_tvs  = classTyVars main_cls\n             sc_constraints = ASSERT2( equalLength cls_tvs inst_tys\n                                     , ppr main_cls <+> ppr inst_tys )\n                              [ mkThetaOrigin (mkDerivOrigin wildcard)\n                                              TypeLevel [] [] [] $\n                                substTheta cls_subst (classSCTheta main_cls) ]\n             cls_subst = ASSERT( equalLength cls_tvs inst_tys )\n                         zipTvSubst cls_tvs inst_tys\n\n       ; (inferred_constraints, tvs', inst_tys') <- infer_constraints\n       ; lift $ traceTc \"inferConstraints\" $ vcat\n              [ ppr main_cls <+> ppr inst_tys'\n              , ppr inferred_constraints\n              ]\n       ; return ( sc_constraints ++ inferred_constraints\n                , tvs', inst_tys' ) }\n\n-- | Like 'inferConstraints', but used only in the case of deriving strategies\n-- where the constraints are inferred by inspecting the fields of each data\n-- constructor (i.e., stock- and newtype-deriving).\ninferConstraintsDataConArgs :: TcType -> [TcType]\n                            -> DerivM ([ThetaOrigin], [TyVar], [TcType])\ninferConstraintsDataConArgs inst_ty inst_tys\n  = do DerivEnv { denv_tvs         = tvs\n                , denv_rep_tc      = rep_tc\n                , denv_rep_tc_args = rep_tc_args\n                , denv_cls         = main_cls\n                , denv_cls_tys     = cls_tys } <- ask\n       wildcard <- isStandaloneWildcardDeriv\n\n       let tc_binders = tyConBinders rep_tc\n           choose_level bndr\n             | isNamedTyConBinder bndr = KindLevel\n             | otherwise               = TypeLevel\n           t_or_ks = map choose_level tc_binders ++ repeat TypeLevel\n              -- want to report *kind* errors when possible\n\n              -- Constraints arising from the arguments of each constructor\n           con_arg_constraints\n             :: (CtOrigin -> TypeOrKind\n                          -> Type\n                          -> [([PredOrigin], Maybe TCvSubst)])\n             -> ([ThetaOrigin], [TyVar], [TcType])\n           con_arg_constraints get_arg_constraints\n             = let (predss, mbSubsts) = unzip\n                     [ preds_and_mbSubst\n                     | data_con <- tyConDataCons rep_tc\n                     , (arg_n, arg_t_or_k, arg_ty)\n                         <- zip3 [1..] t_or_ks $\n                            dataConInstOrigArgTys data_con all_rep_tc_args\n                       -- No constraints for unlifted types\n                       -- See Note [Deriving and unboxed types]\n                     , not (isUnliftedType arg_ty)\n                     , let orig = DerivOriginDC data_con arg_n wildcard\n                     , preds_and_mbSubst\n                         <- get_arg_constraints orig arg_t_or_k arg_ty\n                     ]\n                   preds = concat predss\n                   -- If the constraints require a subtype to be of kind\n                   -- (* -> *) (which is the case for functor-like\n                   -- constraints), then we explicitly unify the subtype's\n                   -- kinds with (* -> *).\n                   -- See Note [Inferring the instance context]\n                   subst        = foldl' composeTCvSubst\n                                         emptyTCvSubst (catMaybes mbSubsts)\n                   unmapped_tvs = filter (\\v -> v `notElemTCvSubst` subst\n                                             && not (v `isInScope` subst)) tvs\n                   (subst', _)  = substTyVarBndrs subst unmapped_tvs\n                   preds'       = map (substPredOrigin subst') preds\n                   inst_tys'    = substTys subst' inst_tys\n                   tvs'         = tyCoVarsOfTypesWellScoped inst_tys'\n               in ([mkThetaOriginFromPreds preds'], tvs', inst_tys')\n\n           is_generic  = main_cls `hasKey` genClassKey\n           is_generic1 = main_cls `hasKey` gen1ClassKey\n           -- is_functor_like: see Note [Inferring the instance context]\n           is_functor_like = tcTypeKind inst_ty `tcEqKind` typeToTypeKind\n                          || is_generic1\n\n           get_gen1_constraints :: Class -> CtOrigin -> TypeOrKind -> Type\n                                -> [([PredOrigin], Maybe TCvSubst)]\n           get_gen1_constraints functor_cls orig t_or_k ty\n              = mk_functor_like_constraints orig t_or_k functor_cls $\n                get_gen1_constrained_tys last_tv ty\n\n           get_std_constrained_tys :: CtOrigin -> TypeOrKind -> Type\n                                   -> [([PredOrigin], Maybe TCvSubst)]\n           get_std_constrained_tys orig t_or_k ty\n               | is_functor_like\n               = mk_functor_like_constraints orig t_or_k main_cls $\n                 deepSubtypesContaining last_tv ty\n               | otherwise\n               = [( [mk_cls_pred orig t_or_k main_cls ty]\n                  , Nothing )]\n\n           mk_functor_like_constraints :: CtOrigin -> TypeOrKind\n                                       -> Class -> [Type]\n                                       -> [([PredOrigin], Maybe TCvSubst)]\n           -- 'cls' is usually main_cls (Functor or Traversable etc), but if\n           -- main_cls = Generic1, then 'cls' can be Functor; see\n           -- get_gen1_constraints\n           --\n           -- For each type, generate two constraints,\n           -- [cls ty, kind(ty) ~ (*->*)], and a kind substitution that results\n           -- from unifying  kind(ty) with * -> *. If the unification is\n           -- successful, it will ensure that the resulting instance is well\n           -- kinded. If not, the second constraint will result in an error\n           -- message which points out the kind mismatch.\n           -- See Note [Inferring the instance context]\n           mk_functor_like_constraints orig t_or_k cls\n              = map $ \\ty -> let ki = tcTypeKind ty in\n                             ( [ mk_cls_pred orig t_or_k cls ty\n                               , mkPredOrigin orig KindLevel\n                                   (mkPrimEqPred ki typeToTypeKind) ]\n                             , tcUnifyTy ki typeToTypeKind\n                             )\n\n           rep_tc_tvs      = tyConTyVars rep_tc\n           last_tv         = last rep_tc_tvs\n           -- When we first gather up the constraints to solve, most of them\n           -- contain rep_tc_tvs, i.e., the type variables from the derived\n           -- datatype's type constructor. We don't want these type variables\n           -- to appear in the final instance declaration, so we must\n           -- substitute each type variable with its counterpart in the derived\n           -- instance. rep_tc_args lists each of these counterpart types in\n           -- the same order as the type variables.\n           all_rep_tc_args\n             = rep_tc_args ++ map mkTyVarTy\n                                  (drop (length rep_tc_args) rep_tc_tvs)\n\n               -- Stupid constraints\n           stupid_constraints\n             = [ mkThetaOrigin deriv_origin TypeLevel [] [] [] $\n                 substTheta tc_subst (tyConStupidTheta rep_tc) ]\n           tc_subst = -- See the comment with all_rep_tc_args for an\n                      -- explanation of this assertion\n                      ASSERT( equalLength rep_tc_tvs all_rep_tc_args )\n                      zipTvSubst rep_tc_tvs all_rep_tc_args\n\n           -- Extra Data constraints\n           -- The Data class (only) requires that for\n           --    instance (...) => Data (T t1 t2)\n           -- IF   t1:*, t2:*\n           -- THEN (Data t1, Data t2) are among the (...) constraints\n           -- Reason: when the IF holds, we generate a method\n           --             dataCast2 f = gcast2 f\n           --         and we need the Data constraints to typecheck the method\n           extra_constraints = [mkThetaOriginFromPreds constrs]\n             where\n               constrs\n                 | main_cls `hasKey` dataClassKey\n                 , all (isLiftedTypeKind . tcTypeKind) rep_tc_args\n                 = [ mk_cls_pred deriv_origin t_or_k main_cls ty\n                   | (t_or_k, ty) <- zip t_or_ks rep_tc_args]\n                 | otherwise\n                 = []\n\n           mk_cls_pred orig t_or_k cls ty\n                -- Don't forget to apply to cls_tys' too\n              = mkPredOrigin orig t_or_k (mkClassPred cls (cls_tys' ++ [ty]))\n           cls_tys' | is_generic1 = []\n                      -- In the awkward Generic1 case, cls_tys' should be\n                      -- empty, since we are applying the class Functor.\n\n                    | otherwise   = cls_tys\n\n           deriv_origin = mkDerivOrigin wildcard\n\n       if    -- Generic constraints are easy\n          |  is_generic\n           -> return ([], tvs, inst_tys)\n\n             -- Generic1 needs Functor\n             -- See Note [Getting base classes]\n          |  is_generic1\n           -> ASSERT( rep_tc_tvs `lengthExceeds` 0 )\n              -- Generic1 has a single kind variable\n              ASSERT( cls_tys `lengthIs` 1 )\n              do { functorClass <- lift $ tcLookupClass functorClassName\n                 ; pure $ con_arg_constraints\n                        $ get_gen1_constraints functorClass }\n\n             -- The others are a bit more complicated\n          |  otherwise\n           -> -- See the comment with all_rep_tc_args for an explanation of\n              -- this assertion\n              ASSERT2( equalLength rep_tc_tvs all_rep_tc_args\n                     , ppr main_cls <+> ppr rep_tc\n                       $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args )\n                do { let (arg_constraints, tvs', inst_tys')\n                           = con_arg_constraints get_std_constrained_tys\n                   ; lift $ traceTc \"inferConstraintsDataConArgs\" $ vcat\n                          [ ppr main_cls <+> ppr inst_tys'\n                          , ppr arg_constraints\n                          ]\n                   ; return ( stupid_constraints ++ extra_constraints\n                                                 ++ arg_constraints\n                            , tvs', inst_tys') }\n\ntypeToTypeKind :: Kind\ntypeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind\n\n-- | Like 'inferConstraints', but used only in the case of @DeriveAnyClass@,\n-- which gathers its constraints based on the type signatures of the class's\n-- methods instead of the types of the data constructor's field.\n--\n-- See Note [Gathering and simplifying constraints for DeriveAnyClass]\n-- for an explanation of how these constraints are used to determine the\n-- derived instance context.\ninferConstraintsDAC :: [TcType] -> DerivM ([ThetaOrigin], [TyVar], [TcType])\ninferConstraintsDAC inst_tys\n  = do { DerivEnv { denv_tvs = tvs\n                  , denv_cls = cls } <- ask\n       ; wildcard <- isStandaloneWildcardDeriv\n\n       ; let gen_dms = [ (sel_id, dm_ty)\n                       | (sel_id, Just (_, GenericDM dm_ty)) <- classOpItems cls ]\n\n             cls_tvs = classTyVars cls\n\n             do_one_meth :: (Id, Type) -> TcM ThetaOrigin\n               -- (Id,Type) are the selector Id and the generic default method type\n               -- NB: the latter is /not/ quantified over the class variables\n               -- See Note [Gathering and simplifying constraints for DeriveAnyClass]\n             do_one_meth (sel_id, gen_dm_ty)\n               = do { let (sel_tvs, _cls_pred, meth_ty)\n                                   = tcSplitMethodTy (varType sel_id)\n                          meth_ty' = substTyWith sel_tvs inst_tys meth_ty\n                          (meth_tvs, meth_theta, meth_tau)\n                                   = tcSplitNestedSigmaTys meth_ty'\n\n                          gen_dm_ty' = substTyWith cls_tvs inst_tys gen_dm_ty\n                          (dm_tvs, dm_theta, dm_tau)\n                                     = tcSplitNestedSigmaTys gen_dm_ty'\n                          tau_eq     = mkPrimEqPred meth_tau dm_tau\n                    ; return (mkThetaOrigin (mkDerivOrigin wildcard) TypeLevel\n                                meth_tvs dm_tvs meth_theta (tau_eq:dm_theta)) }\n\n       ; theta_origins <- lift $ mapM do_one_meth gen_dms\n       ; return (theta_origins, tvs, inst_tys) }\n\n{- Note [Inferring the instance context]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are two sorts of 'deriving', as represented by the two constructors\nfor DerivContext:\n\n  * InferContext mb_wildcard: This can either be:\n    - The deriving clause for a data type.\n        (e.g, data T a = T1 a deriving( Eq ))\n      In this case, mb_wildcard = Nothing.\n    - A standalone declaration with an extra-constraints wildcard\n        (e.g., deriving instance _ => Eq (Foo a))\n      In this case, mb_wildcard = Just loc, where loc is the location\n      of the extra-constraints wildcard.\n\n    Here we must infer an instance context,\n    and generate instance declaration\n      instance Eq a => Eq (T a) where ...\n\n  * SupplyContext theta: standalone deriving\n      deriving instance Eq a => Eq (T a)\n    Here we only need to fill in the bindings;\n    the instance context (theta) is user-supplied\n\nFor the InferContext case, we must figure out the\ninstance context (inferConstraintsDataConArgs). Suppose we are inferring\nthe instance context for\n    C t1 .. tn (T s1 .. sm)\nThere are two cases\n\n  * (T s1 .. sm) :: *         (the normal case)\n    Then we behave like Eq and guess (C t1 .. tn t)\n    for each data constructor arg of type t.  More\n    details below.\n\n  * (T s1 .. sm) :: * -> *    (the functor-like case)\n    Then we behave like Functor.\n\nIn both cases we produce a bunch of un-simplified constraints\nand them simplify them in simplifyInstanceContexts; see\nNote [Simplifying the instance context].\n\nIn the functor-like case, we may need to unify some kind variables with * in\norder for the generated instance to be well-kinded. An example from\nTrac #10524:\n\n  newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1)\n    = Compose (f (g a)) deriving Functor\n\nEarlier in the deriving pipeline, GHC unifies the kind of Compose f g\n(k1 -> *) with the kind of Functor's argument (* -> *), so k1 := *. But this\nalone isn't enough, since k2 wasn't unified with *:\n\n  instance (Functor (f :: k2 -> *), Functor (g :: * -> k2)) =>\n    Functor (Compose f g) where ...\n\nThe two Functor constraints are ill-kinded. To ensure this doesn't happen, we:\n\n  1. Collect all of a datatype's subtypes which require functor-like\n     constraints.\n  2. For each subtype, create a substitution by unifying the subtype's kind\n     with (* -> *).\n  3. Compose all the substitutions into one, then apply that substitution to\n     all of the in-scope type variables and the instance types.\n\nNote [Getting base classes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFunctor and Typeable are defined in package 'base', and that is not available\nwhen compiling 'ghc-prim'.  So we must be careful that 'deriving' for stuff in\nghc-prim does not use Functor or Typeable implicitly via these lookups.\n\nNote [Deriving and unboxed types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe have some special hacks to support things like\n   data T = MkT Int# deriving ( Show )\n\nSpecifically, we use TcGenDeriv.box to box the Int# into an Int\n(which we know how to show), and append a '#'. Parentheses are not required\nfor unboxed values (`MkT -3#` is a valid expression).\n\nNote [Superclasses of derived instance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn general, a derived instance decl needs the superclasses of the derived\nclass too.  So if we have\n        data T a = ...deriving( Ord )\nthen the initial context for Ord (T a) should include Eq (T a).  Often this is\nredundant; we'll also generate an Ord constraint for each constructor argument,\nand that will probably generate enough constraints to make the Eq (T a) constraint\nbe satisfied too.  But not always; consider:\n\n data S a = S\n instance Eq (S a)\n instance Ord (S a)\n\n data T a = MkT (S a) deriving( Ord )\n instance Num a => Eq (T a)\n\nThe derived instance for (Ord (T a)) must have a (Num a) constraint!\nSimilarly consider:\n        data T a = MkT deriving( Data )\nHere there *is* no argument field, but we must nevertheless generate\na context for the Data instances:\n        instance Typeable a => Data (T a) where ...\n\n\n************************************************************************\n*                                                                      *\n         Finding the fixed point of deriving equations\n*                                                                      *\n************************************************************************\n\nNote [Simplifying the instance context]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n        data T a b = C1 (Foo a) (Bar b)\n                   | C2 Int (T b a)\n                   | C3 (T a a)\n                   deriving (Eq)\n\nWe want to come up with an instance declaration of the form\n\n        instance (Ping a, Pong b, ...) => Eq (T a b) where\n                x == y = ...\n\nIt is pretty easy, albeit tedious, to fill in the code \"...\".  The\ntrick is to figure out what the context for the instance decl is,\nnamely Ping, Pong and friends.\n\nLet's call the context reqd for the T instance of class C at types\n(a,b, ...)  C (T a b).  Thus:\n\n        Eq (T a b) = (Ping a, Pong b, ...)\n\nNow we can get a (recursive) equation from the data decl.  This part\nis done by inferConstraintsDataConArgs.\n\n        Eq (T a b) = Eq (Foo a) u Eq (Bar b)    -- From C1\n                   u Eq (T b a) u Eq Int        -- From C2\n                   u Eq (T a a)                 -- From C3\n\n\nFoo and Bar may have explicit instances for Eq, in which case we can\njust substitute for them.  Alternatively, either or both may have\ntheir Eq instances given by deriving clauses, in which case they\nform part of the system of equations.\n\nNow all we need do is simplify and solve the equations, iterating to\nfind the least fixpoint.  This is done by simplifyInstanceConstraints.\nNotice that the order of the arguments can\nswitch around, as here in the recursive calls to T.\n\nLet's suppose Eq (Foo a) = Eq a, and Eq (Bar b) = Ping b.\n\nWe start with:\n\n        Eq (T a b) = {}         -- The empty set\n\nNext iteration:\n        Eq (T a b) = Eq (Foo a) u Eq (Bar b)    -- From C1\n                   u Eq (T b a) u Eq Int        -- From C2\n                   u Eq (T a a)                 -- From C3\n\n        After simplification:\n                   = Eq a u Ping b u {} u {} u {}\n                   = Eq a u Ping b\n\nNext iteration:\n\n        Eq (T a b) = Eq (Foo a) u Eq (Bar b)    -- From C1\n                   u Eq (T b a) u Eq Int        -- From C2\n                   u Eq (T a a)                 -- From C3\n\n        After simplification:\n                   = Eq a u Ping b\n                   u (Eq b u Ping a)\n                   u (Eq a u Ping a)\n\n                   = Eq a u Ping b u Eq b u Ping a\n\nThe next iteration gives the same result, so this is the fixpoint.  We\nneed to make a canonical form of the RHS to ensure convergence.  We do\nthis by simplifying the RHS to a form in which\n\n        - the classes constrain only tyvars\n        - the list is sorted by tyvar (major key) and then class (minor key)\n        - no duplicates, of course\n\nNote [Deterministic simplifyInstanceContexts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCanonicalisation uses nonDetCmpType which is nondeterministic. Sorting\nwith nonDetCmpType puts the returned lists in a nondeterministic order.\nIf we were to return them, we'd get class constraints in\nnondeterministic order.\n\nConsider:\n\n  data ADT a b = Z a b deriving Eq\n\nThe generated code could be either:\n\n  instance (Eq a, Eq b) => Eq (Z a b) where\n\nOr:\n\n  instance (Eq b, Eq a) => Eq (Z a b) where\n\nTo prevent the order from being nondeterministic we only\ncanonicalize when comparing and return them in the same order as\nsimplifyDeriv returned them.\nSee also Note [nonDetCmpType nondeterminism]\n-}\n\n\nsimplifyInstanceContexts :: [DerivSpec [ThetaOrigin]]\n                         -> TcM [DerivSpec ThetaType]\n-- Used only for deriving clauses or standalone deriving with an\n-- extra-constraints wildcard (InferContext)\n-- See Note [Simplifying the instance context]\n\nsimplifyInstanceContexts [] = return []\n\nsimplifyInstanceContexts infer_specs\n  = do  { traceTc \"simplifyInstanceContexts\" $ vcat (map pprDerivSpec infer_specs)\n        ; iterate_deriv 1 initial_solutions }\n  where\n    ------------------------------------------------------------------\n        -- The initial solutions for the equations claim that each\n        -- instance has an empty context; this solution is certainly\n        -- in canonical form.\n    initial_solutions :: [ThetaType]\n    initial_solutions = [ [] | _ <- infer_specs ]\n\n    ------------------------------------------------------------------\n        -- iterate_deriv calculates the next batch of solutions,\n        -- compares it with the current one; finishes if they are the\n        -- same, otherwise recurses with the new solutions.\n        -- It fails if any iteration fails\n    iterate_deriv :: Int -> [ThetaType] -> TcM [DerivSpec ThetaType]\n    iterate_deriv n current_solns\n      | n > 20  -- Looks as if we are in an infinite loop\n                -- This can happen if we have -XUndecidableInstances\n                -- (See TcSimplify.tcSimplifyDeriv.)\n      = pprPanic \"solveDerivEqns: probable loop\"\n                 (vcat (map pprDerivSpec infer_specs) $$ ppr current_solns)\n      | otherwise\n      = do {      -- Extend the inst info from the explicit instance decls\n                  -- with the current set of solutions, and simplify each RHS\n             inst_specs <- zipWithM newDerivClsInst current_solns infer_specs\n           ; new_solns <- checkNoErrs $\n                          extendLocalInstEnv inst_specs $\n                          mapM gen_soln infer_specs\n\n           ; if (current_solns `eqSolution` new_solns) then\n                return [ spec { ds_theta = soln }\n                       | (spec, soln) <- zip infer_specs current_solns ]\n             else\n                iterate_deriv (n+1) new_solns }\n\n    eqSolution a b = eqListBy (eqListBy eqType) (canSolution a) (canSolution b)\n       -- Canonicalise for comparison\n       -- See Note [Deterministic simplifyInstanceContexts]\n    canSolution = map (sortBy nonDetCmpType)\n    ------------------------------------------------------------------\n    gen_soln :: DerivSpec [ThetaOrigin] -> TcM ThetaType\n    gen_soln (DS { ds_loc = loc, ds_tvs = tyvars\n                 , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs })\n      = setSrcSpan loc  $\n        addErrCtxt (derivInstCtxt the_pred) $\n        do { theta <- simplifyDeriv the_pred tyvars deriv_rhs\n                -- checkValidInstance tyvars theta clas inst_tys\n                -- Not necessary; see Note [Exotic derived instance contexts]\n\n           ; traceTc \"TcDeriv\" (ppr deriv_rhs $$ ppr theta)\n                -- Claim: the result instance declaration is guaranteed valid\n                -- Hence no need to call:\n                --   checkValidInstance tyvars theta clas inst_tys\n           ; return theta }\n      where\n        the_pred = mkClassPred clas inst_tys\n\nderivInstCtxt :: PredType -> MsgDoc\nderivInstCtxt pred\n  = text \"When deriving the instance for\" <+> parens (ppr pred)\n\n{-\n***********************************************************************************\n*                                                                                 *\n*            Simplify derived constraints\n*                                                                                 *\n***********************************************************************************\n-}\n\n-- | Given @instance (wanted) => C inst_ty@, simplify 'wanted' as much\n-- as possible. Fail if not possible.\nsimplifyDeriv :: PredType -- ^ @C inst_ty@, head of the instance we are\n                          -- deriving.  Only used for SkolemInfo.\n              -> [TyVar]  -- ^ The tyvars bound by @inst_ty@.\n              -> [ThetaOrigin] -- ^ Given and wanted constraints\n              -> TcM ThetaType -- ^ Needed constraints (after simplification),\n                               -- i.e. @['PredType']@.\nsimplifyDeriv pred tvs thetas\n  = do { (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize\n                -- The constraint solving machinery\n                -- expects *TcTyVars* not TyVars.\n                -- We use *non-overlappable* (vanilla) skolems\n                -- See Note [Overlap and deriving]\n\n       ; let skol_set  = mkVarSet tvs_skols\n             skol_info = DerivSkol pred\n             doc = text \"deriving\" <+> parens (ppr pred)\n\n             mk_given_ev :: PredType -> TcM EvVar\n             mk_given_ev given =\n               let given_pred = substTy skol_subst given\n               in newEvVar given_pred\n\n             emit_wanted_constraints :: [TyVar] -> [PredOrigin] -> TcM ()\n             emit_wanted_constraints metas_to_be preds\n               = do { -- We instantiate metas_to_be with fresh meta type\n                      -- variables. Currently, these can only be type variables\n                      -- quantified in generic default type signatures.\n                      -- See Note [Gathering and simplifying constraints for\n                      -- DeriveAnyClass]\n                      (meta_subst, _meta_tvs) <- newMetaTyVars metas_to_be\n\n                    -- Now make a constraint for each of the instantiated predicates\n                    ; let wanted_subst = skol_subst `unionTCvSubst` meta_subst\n                          mk_wanted_ct (PredOrigin wanted orig t_or_k)\n                            = do { ev <- newWanted orig (Just t_or_k) $\n                                         substTyUnchecked wanted_subst wanted\n                                 ; return (mkNonCanonical ev) }\n                    ; cts <- mapM mk_wanted_ct preds\n\n                    -- And emit them into the monad\n                    ; emitSimples (listToCts cts) }\n\n             -- Create the implications we need to solve. For stock and newtype\n             -- deriving, these implication constraints will be simple class\n             -- constraints like (C a, Ord b).\n             -- But with DeriveAnyClass, we make an implication constraint.\n             -- See Note [Gathering and simplifying constraints for DeriveAnyClass]\n             mk_wanteds :: ThetaOrigin -> TcM WantedConstraints\n             mk_wanteds (ThetaOrigin { to_anyclass_skols  = ac_skols\n                                     , to_anyclass_metas  = ac_metas\n                                     , to_anyclass_givens = ac_givens\n                                     , to_wanted_origins  = preds })\n               = do { ac_given_evs <- mapM mk_given_ev ac_givens\n                    ; (_, wanteds)\n                        <- captureConstraints $\n                           checkConstraints skol_info ac_skols ac_given_evs $\n                              -- The checkConstraints bumps the TcLevel, and\n                              -- wraps the wanted constraints in an implication,\n                              -- when (but only when) necessary\n                           emit_wanted_constraints ac_metas preds\n                    ; pure wanteds }\n\n       -- See [STEP DAC BUILD]\n       -- Generate the implication constraints, one for each method, to solve\n       -- with the skolemized variables.  Start \"one level down\" because\n       -- we are going to wrap the result in an implication with tvs_skols,\n       -- in step [DAC RESIDUAL]\n       ; (tc_lvl, wanteds) <- pushTcLevelM $\n                              mapM mk_wanteds thetas\n\n       ; traceTc \"simplifyDeriv inputs\" $\n         vcat [ pprTyVars tvs $$ ppr thetas $$ ppr wanteds, doc ]\n\n       -- See [STEP DAC SOLVE]\n       -- Simplify the constraints, starting at the same level at which\n       -- they are generated (c.f. the call to runTcSWithEvBinds in\n       -- simplifyInfer)\n       ; solved_wanteds <- setTcLevel tc_lvl   $\n                           runTcSDeriveds      $\n                           solveWantedsAndDrop $\n                           unionsWC wanteds\n\n       -- It's not yet zonked!  Obviously zonk it before peering at it\n       ; solved_wanteds <- zonkWC solved_wanteds\n\n       -- See [STEP DAC HOIST]\n       -- Split the resulting constraints into bad and good constraints,\n       -- building an @unsolved :: WantedConstraints@ representing all\n       -- the constraints we can't just shunt to the predicates.\n       -- See Note [Exotic derived instance contexts]\n       ; let residual_simple = approximateWC True solved_wanteds\n             (bad, good) = partitionBagWith get_good residual_simple\n\n             get_good :: Ct -> Either Ct PredType\n             get_good ct | validDerivPred skol_set p\n                         , isWantedCt ct\n                         = Right p\n                          -- TODO: This is wrong\n                          -- NB re 'isWantedCt': residual_wanted may contain\n                          -- unsolved CtDerived and we stick them into the\n                          -- bad set so that reportUnsolved may decide what\n                          -- to do with them\n                         | otherwise\n                         = Left ct\n                           where p = ctPred ct\n\n       ; traceTc \"simplifyDeriv outputs\" $\n         vcat [ ppr tvs_skols, ppr residual_simple, ppr good, ppr bad ]\n\n       -- Return the good unsolved constraints (unskolemizing on the way out.)\n       ; let min_theta = mkMinimalBySCs id (bagToList good)\n             -- An important property of mkMinimalBySCs (used above) is that in\n             -- addition to removing constraints that are made redundant by\n             -- superclass relationships, it also removes _duplicate_\n             -- constraints.\n             -- See Note [Gathering and simplifying constraints for\n             --           DeriveAnyClass]\n             subst_skol = zipTvSubst tvs_skols $ mkTyVarTys tvs\n                          -- The reverse substitution (sigh)\n\n       -- See [STEP DAC RESIDUAL]\n       ; min_theta_vars <- mapM newEvVar min_theta\n       ; (leftover_implic, _)\n           <- buildImplicationFor tc_lvl skol_info tvs_skols\n                                  min_theta_vars solved_wanteds\n       -- This call to simplifyTop is purely for error reporting\n       -- See Note [Error reporting for deriving clauses]\n       -- See also Note [Exotic derived instance contexts], which are caught\n       -- in this line of code.\n       ; simplifyTopImplic leftover_implic\n\n       ; return (substTheta subst_skol min_theta) }\n\n{-\nNote [Overlap and deriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider some overlapping instances:\n  instance Show a => Show [a] where ..\n  instance Show [Char] where ...\n\nNow a data type with deriving:\n  data T a = MkT [a] deriving( Show )\n\nWe want to get the derived instance\n  instance Show [a] => Show (T a) where...\nand NOT\n  instance Show a => Show (T a) where...\nso that the (Show (T Char)) instance does the Right Thing\n\nIt's very like the situation when we're inferring the type\nof a function\n   f x = show [x]\nand we want to infer\n   f :: Show [a] => a -> String\n\nBOTTOM LINE: use vanilla, non-overlappable skolems when inferring\n             the context for the derived instance.\n             Hence tcInstSkolTyVars not tcInstSuperSkolTyVars\n\nNote [Gathering and simplifying constraints for DeriveAnyClass]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDeriveAnyClass works quite differently from stock and newtype deriving in\nthe way it gathers and simplifies constraints to be used in a derived\ninstance's context. Stock and newtype deriving gather constraints by looking\nat the data constructors of the data type for which we are deriving an\ninstance. But DeriveAnyClass doesn't need to know about a data type's\ndefinition at all!\n\nTo see why, consider this example of DeriveAnyClass:\n\n  class Foo a where\n    bar :: forall b. Ix b => a -> b -> String\n    default bar :: (Show a, Ix c) => a -> c -> String\n    bar x y = show x ++ show (range (y,y))\n\n    baz :: Eq a => a -> a -> Bool\n    default baz :: (Ord a, Show a) => a -> a -> Bool\n    baz x y = compare x y == EQ\n\nBecause 'bar' and 'baz' have default signatures, this generates a top-level\ndefinition for these generic default methods\n\n  $gdm_bar :: forall a. Foo a\n           => forall c. (Show a, Ix c)\n           => a -> c -> String\n  $gdm_bar x y = show x ++ show (range (y,y))\n\n(and similarly for baz).  Now consider a 'deriving' clause\n  data Maybe s = ... deriving Foo\n\nThis derives an instance of the form:\n  instance (CX) => Foo (Maybe s) where\n    bar = $gdm_bar\n    baz = $gdm_baz\n\nNow it is GHC's job to fill in a suitable instance context (CX).  If\nGHC were typechecking the binding\n   bar = $gdm bar\nit would\n   * skolemise the expected type of bar\n   * instantiate the type of $gdm_bar with meta-type variables\n   * build an implication constraint\n\n[STEP DAC BUILD]\nSo that's what we do.  We build the constraint (call it C1)\n\n   forall[2] b. Ix b => (Show (Maybe s), Ix cc,\n                        Maybe s -> b -> String\n                            ~ Maybe s -> cc -> String)\n\nHere:\n* The level of this forall constraint is forall[2], because we are later\n  going to wrap it in a forall[1] in [STEP DAC RESIDUAL]\n\n* The 'b' comes from the quantified type variable in the expected type\n  of bar (i.e., 'to_anyclass_skols' in 'ThetaOrigin'). The 'cc' is a unification\n  variable that comes from instantiating the quantified type variable 'c' in\n  $gdm_bar's type (i.e., 'to_anyclass_metas' in 'ThetaOrigin).\n\n* The (Ix b) constraint comes from the context of bar's type\n  (i.e., 'to_wanted_givens' in 'ThetaOrigin'). The (Show (Maybe s)) and (Ix cc)\n  constraints come from the context of $gdm_bar's type\n  (i.e., 'to_anyclass_givens' in 'ThetaOrigin').\n\n* The equality constraint (Maybe s -> b -> String) ~ (Maybe s -> cc -> String)\n  comes from marrying up the instantiated type of $gdm_bar with the specified\n  type of bar. Notice that the type variables from the instance, 's' in this\n  case, are global to this constraint.\n\nNote that it is vital that we instantiate the `c` in $gdm_bar's type with a new\nunification variable for each iteration of simplifyDeriv. If we re-use the same\nunification variable across multiple iterations, then bad things can happen,\nsuch as Trac #14933.\n\nSimilarly for 'baz', givng the constraint C2\n\n   forall[2]. Eq (Maybe s) => (Ord a, Show a,\n                              Maybe s -> Maybe s -> Bool\n                                ~ Maybe s -> Maybe s -> Bool)\n\nIn this case baz has no local quantification, so the implication\nconstraint has no local skolems and there are no unification\nvariables.\n\n[STEP DAC SOLVE]\nWe can combine these two implication constraints into a single\nconstraint (C1, C2), and simplify, unifying cc:=b, to get:\n\n   forall[2] b. Ix b => Show a\n   /\\\n   forall[2]. Eq (Maybe s) => (Ord a, Show a)\n\n[STEP DAC HOIST]\nLet's call that (C1', C2').  Now we need to hoist the unsolved\nconstraints out of the implications to become our candidate for\n(CX). That is done by approximateWC, which will return:\n\n  (Show a, Ord a, Show a)\n\nNow we can use mkMinimalBySCs to remove superclasses and duplicates, giving\n\n  (Show a, Ord a)\n\nAnd that's what GHC uses for CX.\n\n[STEP DAC RESIDUAL]\nIn this case we have solved all the leftover constraints, but what if\nwe don't?  Simple!  We just form the final residual constraint\n\n   forall[1] s. CX => (C1',C2')\n\nand simplify that. In simple cases it'll succeed easily, because CX\nliterally contains the constraints in C1', C2', but if there is anything\nmore complicated it will be reported in a civilised way.\n\nNote [Error reporting for deriving clauses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA suprisingly tricky aspect of deriving to get right is reporting sensible\nerror messages. In particular, if simplifyDeriv reaches a constraint that it\ncannot solve, which might include:\n\n1. Insoluble constraints\n2. \"Exotic\" constraints (See Note [Exotic derived instance contexts])\n\nThen we report an error immediately in simplifyDeriv.\n\nAnother possible choice is to punt and let another part of the typechecker\n(e.g., simplifyInstanceContexts) catch the errors. But this tends to lead\nto worse error messages, so we do it directly in simplifyDeriv.\n\nsimplifyDeriv checks for errors in a clever way. If the deriving machinery\ninfers the context (Foo a)--that is, if this instance is to be generated:\n\n  instance Foo a => ...\n\nThen we form an implication of the form:\n\n  forall a. Foo a => <residual_wanted_constraints>\n\nAnd pass it to the simplifier. If the context (Foo a) is enough to discharge\nall the constraints in <residual_wanted_constraints>, then everything is\nhunky-dory. But if <residual_wanted_constraints> contains, say, an insoluble\nconstraint, then (Foo a) won't be able to solve it, causing GHC to error.\n\nNote [Exotic derived instance contexts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a 'derived' instance declaration, we *infer* the context.  It's a\nbit unclear what rules we should apply for this; the Haskell report is\nsilent.  Obviously, constraints like (Eq a) are fine, but what about\n        data T f a = MkT (f a) deriving( Eq )\nwhere we'd get an Eq (f a) constraint.  That's probably fine too.\n\nOne could go further: consider\n        data T a b c = MkT (Foo a b c) deriving( Eq )\n        instance (C Int a, Eq b, Eq c) => Eq (Foo a b c)\n\nNotice that this instance (just) satisfies the Paterson termination\nconditions.  Then we *could* derive an instance decl like this:\n\n        instance (C Int a, Eq b, Eq c) => Eq (T a b c)\neven though there is no instance for (C Int a), because there just\n*might* be an instance for, say, (C Int Bool) at a site where we\nneed the equality instance for T's.\n\nHowever, this seems pretty exotic, and it's quite tricky to allow\nthis, and yet give sensible error messages in the (much more common)\ncase where we really want that instance decl for C.\n\nSo for now we simply require that the derived instance context\nshould have only type-variable constraints.\n\nHere is another example:\n        data Fix f = In (f (Fix f)) deriving( Eq )\nHere, if we are prepared to allow -XUndecidableInstances we\ncould derive the instance\n        instance Eq (f (Fix f)) => Eq (Fix f)\nbut this is so delicate that I don't think it should happen inside\n'deriving'. If you want this, write it yourself!\n\nNB: if you want to lift this condition, make sure you still meet the\ntermination conditions!  If not, the deriving mechanism generates\nlarger and larger constraints.  Example:\n  data Succ a = S a\n  data Seq a = Cons a (Seq (Succ a)) | Nil deriving Show\n\nNote the lack of a Show instance for Succ.  First we'll generate\n  instance (Show (Succ a), Show a) => Show (Seq a)\nand then\n  instance (Show (Succ (Succ a)), Show (Succ a), Show a) => Show (Seq a)\nand so on.  Instead we want to complain of no instance for (Show (Succ a)).\n\nThe bottom line\n~~~~~~~~~~~~~~~\nAllow constraints which consist only of type variables, with no repeats.\n-}\n", "num_lines": 974}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nError-checking and other utilities for @deriving@ clauses or declarations.\n-}\n\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcDerivUtils (\n        DerivM, DerivEnv(..),\n        DerivSpec(..), pprDerivSpec,\n        DerivSpecMechanism(..), derivSpecMechanismToStrategy, isDerivSpecStock,\n        isDerivSpecNewtype, isDerivSpecAnyClass, isDerivSpecVia,\n        DerivContext(..), OriginativeDerivStatus(..),\n        isStandaloneDeriv, isStandaloneWildcardDeriv, mkDerivOrigin,\n        PredOrigin(..), ThetaOrigin(..), mkPredOrigin,\n        mkThetaOrigin, mkThetaOriginFromPreds, substPredOrigin,\n        checkOriginativeSideConditions, hasStockDeriving,\n        canDeriveAnyClass,\n        std_class_via_coercible, non_coercible_class,\n        newDerivClsInst, extendLocalInstEnv\n    ) where\n\nimport GhcPrelude\n\nimport Bag\nimport BasicTypes\nimport Class\nimport DataCon\nimport DynFlags\nimport ErrUtils\nimport HscTypes (lookupFixity, mi_fix)\nimport HsSyn\nimport Inst\nimport InstEnv\nimport LoadIface (loadInterfaceForName)\nimport Module (getModule)\nimport Name\nimport Outputable\nimport PrelNames\nimport SrcLoc\nimport TcGenDeriv\nimport TcGenFunctor\nimport TcGenGenerics\nimport TcRnMonad\nimport TcType\nimport THNames (liftClassKey)\nimport TyCon\nimport Type\nimport Util\nimport VarSet\n\nimport Control.Monad.Trans.Reader\nimport Data.Maybe\nimport qualified GHC.LanguageExtensions as LangExt\nimport ListSetOps (assocMaybe)\n\n-- | To avoid having to manually plumb everything in 'DerivEnv' throughout\n-- various functions in @TcDeriv@ and @TcDerivInfer@, we use 'DerivM', which\n-- is a simple reader around 'TcRn'.\ntype DerivM = ReaderT DerivEnv TcRn\n\n-- | Is GHC processing a standalone deriving declaration?\nisStandaloneDeriv :: DerivM Bool\nisStandaloneDeriv = asks (go . denv_ctxt)\n  where\n    go :: DerivContext -> Bool\n    go (InferContext wildcard) = isJust wildcard\n    go (SupplyContext {})      = True\n\n-- | Is GHC processing a standalone deriving declaration with an\n-- extra-constraints wildcard as the context?\n-- (e.g., @deriving instance _ => Eq (Foo a)@)\nisStandaloneWildcardDeriv :: DerivM Bool\nisStandaloneWildcardDeriv = asks (go . denv_ctxt)\n  where\n    go :: DerivContext -> Bool\n    go (InferContext wildcard) = isJust wildcard\n    go (SupplyContext {})      = False\n\n-- | @'mkDerivOrigin' wc@ returns 'StandAloneDerivOrigin' if @wc@ is 'True',\n-- and 'DerivClauseOrigin' if @wc@ is 'False'. Useful for error-reporting.\nmkDerivOrigin :: Bool -> CtOrigin\nmkDerivOrigin standalone_wildcard\n  | standalone_wildcard = StandAloneDerivOrigin\n  | otherwise           = DerivClauseOrigin\n\n-- | Contains all of the information known about a derived instance when\n-- determining what its @EarlyDerivSpec@ should be.\ndata DerivEnv = DerivEnv\n  { denv_overlap_mode :: Maybe OverlapMode\n    -- ^ Is this an overlapping instance?\n  , denv_tvs          :: [TyVar]\n    -- ^ Universally quantified type variables in the instance\n  , denv_cls          :: Class\n    -- ^ Class for which we need to derive an instance\n  , denv_cls_tys      :: [Type]\n    -- ^ Other arguments to the class except the last\n  , denv_tc           :: TyCon\n    -- ^ Type constructor for which the instance is requested\n    --   (last arguments to the type class)\n  , denv_tc_args      :: [Type]\n    -- ^ Arguments to the type constructor\n  , denv_rep_tc       :: TyCon\n    -- ^ The representation tycon for 'denv_tc'\n    --   (for data family instances)\n  , denv_rep_tc_args  :: [Type]\n    -- ^ The representation types for 'denv_tc_args'\n    --   (for data family instances)\n  , denv_ctxt         :: DerivContext\n    -- ^ @'SupplyContext' theta@ for standalone deriving (where @theta@ is the\n    --   context of the instance).\n    --   'InferContext' for @deriving@ clauses, or for standalone deriving that\n    --   uses a wildcard constraint.\n    --   See @Note [Inferring the instance context]@.\n  , denv_strat        :: Maybe (DerivStrategy GhcTc)\n    -- ^ 'Just' if user requests a particular deriving strategy.\n    --   Otherwise, 'Nothing'.\n  }\n\ninstance Outputable DerivEnv where\n  ppr (DerivEnv { denv_overlap_mode = overlap_mode\n                , denv_tvs          = tvs\n                , denv_cls          = cls\n                , denv_cls_tys      = cls_tys\n                , denv_tc           = tc\n                , denv_tc_args      = tc_args\n                , denv_rep_tc       = rep_tc\n                , denv_rep_tc_args  = rep_tc_args\n                , denv_ctxt         = ctxt\n                , denv_strat        = mb_strat })\n    = hang (text \"DerivEnv\")\n         2 (vcat [ text \"denv_overlap_mode\" <+> ppr overlap_mode\n                 , text \"denv_tvs\"          <+> ppr tvs\n                 , text \"denv_cls\"          <+> ppr cls\n                 , text \"denv_cls_tys\"      <+> ppr cls_tys\n                 , text \"denv_tc\"           <+> ppr tc\n                 , text \"denv_tc_args\"      <+> ppr tc_args\n                 , text \"denv_rep_tc\"       <+> ppr rep_tc\n                 , text \"denv_rep_tc_args\"  <+> ppr rep_tc_args\n                 , text \"denv_ctxt\"         <+> ppr ctxt\n                 , text \"denv_strat\"        <+> ppr mb_strat ])\n\ndata DerivSpec theta = DS { ds_loc                 :: SrcSpan\n                          , ds_name                :: Name         -- DFun name\n                          , ds_tvs                 :: [TyVar]\n                          , ds_theta               :: theta\n                          , ds_cls                 :: Class\n                          , ds_tys                 :: [Type]\n                          , ds_tc                  :: TyCon\n                          , ds_overlap             :: Maybe OverlapMode\n                          , ds_standalone_wildcard :: Maybe SrcSpan\n                              -- See Note [Inferring the instance context]\n                              -- in TcDerivInfer\n                          , ds_mechanism           :: DerivSpecMechanism }\n        -- This spec implies a dfun declaration of the form\n        --       df :: forall tvs. theta => C tys\n        -- The Name is the name for the DFun we'll build\n        -- The tyvars bind all the variables in the theta\n        -- For type families, the tycon in\n        --       in ds_tys is the *family* tycon\n        --       in ds_tc is the *representation* type\n        -- For non-family tycons, both are the same\n\n        -- the theta is either the given and final theta, in standalone deriving,\n        -- or the not-yet-simplified list of constraints together with their origin\n\n        -- ds_mechanism specifies the means by which GHC derives the instance.\n        -- See Note [Deriving strategies] in TcDeriv\n\n{-\nExample:\n\n     newtype instance T [a] = MkT (Tree a) deriving( C s )\n==>\n     axiom T [a] = :RTList a\n     axiom :RTList a = Tree a\n\n     DS { ds_tvs = [a,s], ds_cls = C, ds_tys = [s, T [a]]\n        , ds_tc = :RTList, ds_mechanism = DerivSpecNewtype (Tree a) }\n-}\n\npprDerivSpec :: Outputable theta => DerivSpec theta -> SDoc\npprDerivSpec (DS { ds_loc = l, ds_name = n, ds_tvs = tvs, ds_cls = c,\n                   ds_tys = tys, ds_theta = rhs,\n                   ds_standalone_wildcard = wildcard, ds_mechanism = mech })\n  = hang (text \"DerivSpec\")\n       2 (vcat [ text \"ds_loc                  =\" <+> ppr l\n               , text \"ds_name                 =\" <+> ppr n\n               , text \"ds_tvs                  =\" <+> ppr tvs\n               , text \"ds_cls                  =\" <+> ppr c\n               , text \"ds_tys                  =\" <+> ppr tys\n               , text \"ds_theta                =\" <+> ppr rhs\n               , text \"ds_standalone_wildcard  =\" <+> ppr wildcard\n               , text \"ds_mechanism            =\" <+> ppr mech ])\n\ninstance Outputable theta => Outputable (DerivSpec theta) where\n  ppr = pprDerivSpec\n\n-- What action to take in order to derive a class instance.\n-- See Note [Deriving strategies] in TcDeriv\ndata DerivSpecMechanism\n  = DerivSpecStock   -- \"Standard\" classes\n      (SrcSpan -> TyCon\n               -> [Type]\n               -> TcM (LHsBinds GhcPs, BagDerivStuff, [Name]))\n      -- This function returns three things:\n      --\n      -- 1. @LHsBinds GhcPs@: The derived instance's function bindings\n      --    (e.g., @compare (T x) (T y) = compare x y@)\n      -- 2. @BagDerivStuff@: Auxiliary bindings needed to support the derived\n      --    instance. As examples, derived 'Generic' instances require\n      --    associated type family instances, and derived 'Eq' and 'Ord'\n      --    instances require top-level @con2tag@ functions.\n      --    See Note [Auxiliary binders] in TcGenDeriv.\n      -- 3. @[Name]@: A list of Names for which @-Wunused-binds@ should be\n      --    suppressed. This is used to suppress unused warnings for record\n      --    selectors when deriving 'Read', 'Show', or 'Generic'.\n      --    See Note [Deriving and unused record selectors].\n\n  | DerivSpecNewtype -- -XGeneralizedNewtypeDeriving\n      Type -- The newtype rep type\n\n  | DerivSpecAnyClass -- -XDeriveAnyClass\n\n  | DerivSpecVia -- -XDerivingVia\n      Type -- The @via@ type\n\n-- | Convert a 'DerivSpecMechanism' to its corresponding 'DerivStrategy'.\nderivSpecMechanismToStrategy :: DerivSpecMechanism -> DerivStrategy GhcTc\nderivSpecMechanismToStrategy DerivSpecStock{}   = StockStrategy\nderivSpecMechanismToStrategy DerivSpecNewtype{} = NewtypeStrategy\nderivSpecMechanismToStrategy DerivSpecAnyClass  = AnyclassStrategy\nderivSpecMechanismToStrategy (DerivSpecVia t)   = ViaStrategy t\n\nisDerivSpecStock, isDerivSpecNewtype, isDerivSpecAnyClass, isDerivSpecVia\n  :: DerivSpecMechanism -> Bool\nisDerivSpecStock (DerivSpecStock{}) = True\nisDerivSpecStock _                  = False\n\nisDerivSpecNewtype (DerivSpecNewtype{}) = True\nisDerivSpecNewtype _                    = False\n\nisDerivSpecAnyClass DerivSpecAnyClass = True\nisDerivSpecAnyClass _                 = False\n\nisDerivSpecVia (DerivSpecVia{}) = True\nisDerivSpecVia _                = False\n\ninstance Outputable DerivSpecMechanism where\n  ppr (DerivSpecStock{})   = text \"DerivSpecStock\"\n  ppr (DerivSpecNewtype t) = text \"DerivSpecNewtype\" <> colon <+> ppr t\n  ppr DerivSpecAnyClass    = text \"DerivSpecAnyClass\"\n  ppr (DerivSpecVia t)     = text \"DerivSpecVia\" <> colon <+> ppr t\n\n-- | Whether GHC is processing a @deriving@ clause or a standalone deriving\n-- declaration.\ndata DerivContext\n  = InferContext (Maybe SrcSpan) -- ^ @'InferContext mb_wildcard@ is either:\n                                 --\n                                 -- * A @deriving@ clause (in which case\n                                 --   @mb_wildcard@ is 'Nothing').\n                                 --\n                                 -- * A standalone deriving declaration with\n                                 --   an extra-constraints wildcard as the\n                                 --   context (in which case @mb_wildcard@ is\n                                 --   @'Just' loc@, where @loc@ is the location\n                                 --   of the wildcard.\n                                 --\n                                 -- GHC should infer the context.\n\n  | SupplyContext ThetaType      -- ^ @'SupplyContext' theta@ is a standalone\n                                 -- deriving declaration, where @theta@ is the\n                                 -- context supplied by the user.\n\ninstance Outputable DerivContext where\n  ppr (InferContext standalone) = text \"InferContext\"  <+> ppr standalone\n  ppr (SupplyContext theta)     = text \"SupplyContext\" <+> ppr theta\n\n-- | Records whether a particular class can be derived by way of an\n-- /originative/ deriving strategy (i.e., @stock@ or @anyclass@).\n--\n-- See @Note [Deriving strategies]@ in \"TcDeriv\".\ndata OriginativeDerivStatus\n  = CanDeriveStock            -- Stock class, can derive\n      (SrcSpan -> TyCon -> [Type]\n               -> TcM (LHsBinds GhcPs, BagDerivStuff, [Name]))\n  | StockClassError SDoc      -- Stock class, but can't do it\n  | CanDeriveAnyClass         -- See Note [Deriving any class]\n  | NonDerivableClass SDoc    -- Cannot derive with either stock or anyclass\n\n-- A stock class is one either defined in the Haskell report or for which GHC\n-- otherwise knows how to generate code for (possibly requiring the use of a\n-- language extension), such as Eq, Ord, Ix, Data, Generic, etc.)\n\n-- | A 'PredType' annotated with the origin of the constraint 'CtOrigin',\n-- and whether or the constraint deals in types or kinds.\ndata PredOrigin = PredOrigin PredType CtOrigin TypeOrKind\n\n-- | A list of wanted 'PredOrigin' constraints ('to_wanted_origins') to\n-- simplify when inferring a derived instance's context. These are used in all\n-- deriving strategies, but in the particular case of @DeriveAnyClass@, we\n-- need extra information. In particular, we need:\n--\n-- * 'to_anyclass_skols', the list of type variables bound by a class method's\n--   regular type signature, which should be rigid.\n--\n-- * 'to_anyclass_metas', the list of type variables bound by a class method's\n--   default type signature. These can be unified as necessary.\n--\n-- * 'to_anyclass_givens', the list of constraints from a class method's\n--   regular type signature, which can be used to help solve constraints\n--   in the 'to_wanted_origins'.\n--\n-- (Note that 'to_wanted_origins' will likely contain type variables from the\n-- derived type class or data type, neither of which will appear in\n-- 'to_anyclass_skols' or 'to_anyclass_metas'.)\n--\n-- For all other deriving strategies, it is always the case that\n-- 'to_anyclass_skols', 'to_anyclass_metas', and 'to_anyclass_givens' are\n-- empty.\n--\n-- Here is an example to illustrate this:\n--\n-- @\n-- class Foo a where\n--   bar :: forall b. Ix b => a -> b -> String\n--   default bar :: forall y. (Show a, Ix y) => a -> y -> String\n--   bar x y = show x ++ show (range (y, y))\n--\n--   baz :: Eq a => a -> a -> Bool\n--   default baz :: Ord a => a -> a -> Bool\n--   baz x y = compare x y == EQ\n--\n-- data Quux q = Quux deriving anyclass Foo\n-- @\n--\n-- Then it would generate two 'ThetaOrigin's, one for each method:\n--\n-- @\n-- [ ThetaOrigin { to_anyclass_skols  = [b]\n--               , to_anyclass_metas  = [y]\n--               , to_anyclass_givens = [Ix b]\n--               , to_wanted_origins  = [ Show (Quux q), Ix y\n--                                      , (Quux q -> b -> String) ~\n--                                        (Quux q -> y -> String)\n--                                      ] }\n-- , ThetaOrigin { to_anyclass_skols  = []\n--               , to_anyclass_metas  = []\n--               , to_anyclass_givens = [Eq (Quux q)]\n--               , to_wanted_origins  = [ Ord (Quux q)\n--                                      , (Quux q -> Quux q -> Bool) ~\n--                                        (Quux q -> Quux q -> Bool)\n--                                      ] }\n-- ]\n-- @\n--\n-- (Note that the type variable @q@ is bound by the data type @Quux@, and thus\n-- it appears in neither 'to_anyclass_skols' nor 'to_anyclass_metas'.)\n--\n-- See @Note [Gathering and simplifying constraints for DeriveAnyClass]@\n-- in \"TcDerivInfer\" for an explanation of how 'to_wanted_origins' are\n-- determined in @DeriveAnyClass@, as well as how 'to_anyclass_skols',\n-- 'to_anyclass_metas', and 'to_anyclass_givens' are used.\ndata ThetaOrigin\n  = ThetaOrigin { to_anyclass_skols  :: [TyVar]\n                , to_anyclass_metas  :: [TyVar]\n                , to_anyclass_givens :: ThetaType\n                , to_wanted_origins  :: [PredOrigin] }\n\ninstance Outputable PredOrigin where\n  ppr (PredOrigin ty _ _) = ppr ty -- The origin is not so interesting when debugging\n\ninstance Outputable ThetaOrigin where\n  ppr (ThetaOrigin { to_anyclass_skols  = ac_skols\n                   , to_anyclass_metas  = ac_metas\n                   , to_anyclass_givens = ac_givens\n                   , to_wanted_origins  = wanted_origins })\n    = hang (text \"ThetaOrigin\")\n         2 (vcat [ text \"to_anyclass_skols  =\" <+> ppr ac_skols\n                 , text \"to_anyclass_metas  =\" <+> ppr ac_metas\n                 , text \"to_anyclass_givens =\" <+> ppr ac_givens\n                 , text \"to_wanted_origins  =\" <+> ppr wanted_origins ])\n\nmkPredOrigin :: CtOrigin -> TypeOrKind -> PredType -> PredOrigin\nmkPredOrigin origin t_or_k pred = PredOrigin pred origin t_or_k\n\nmkThetaOrigin :: CtOrigin -> TypeOrKind\n              -> [TyVar] -> [TyVar] -> ThetaType -> ThetaType\n              -> ThetaOrigin\nmkThetaOrigin origin t_or_k skols metas givens\n  = ThetaOrigin skols metas givens . map (mkPredOrigin origin t_or_k)\n\n-- A common case where the ThetaOrigin only contains wanted constraints, with\n-- no givens or locally scoped type variables.\nmkThetaOriginFromPreds :: [PredOrigin] -> ThetaOrigin\nmkThetaOriginFromPreds = ThetaOrigin [] [] []\n\nsubstPredOrigin :: HasCallStack => TCvSubst -> PredOrigin -> PredOrigin\nsubstPredOrigin subst (PredOrigin pred origin t_or_k)\n  = PredOrigin (substTy subst pred) origin t_or_k\n\n{-\n************************************************************************\n*                                                                      *\n                Class deriving diagnostics\n*                                                                      *\n************************************************************************\n\nOnly certain blessed classes can be used in a deriving clause (without the\nassistance of GeneralizedNewtypeDeriving or DeriveAnyClass). These classes\nare listed below in the definition of hasStockDeriving. The stockSideConditions\nfunction determines the criteria that needs to be met in order for a particular\nstock class to be able to be derived successfully.\n\nA class might be able to be used in a deriving clause if -XDeriveAnyClass\nis willing to support it. The canDeriveAnyClass function checks if this is the\ncase.\n-}\n\nhasStockDeriving\n  :: Class -> Maybe (SrcSpan\n                     -> TyCon\n                     -> [Type]\n                     -> TcM (LHsBinds GhcPs, BagDerivStuff, [Name]))\nhasStockDeriving clas\n  = assocMaybe gen_list (getUnique clas)\n  where\n    gen_list\n      :: [(Unique, SrcSpan\n                   -> TyCon\n                   -> [Type]\n                   -> TcM (LHsBinds GhcPs, BagDerivStuff, [Name]))]\n    gen_list = [ (eqClassKey,          simpleM gen_Eq_binds)\n               , (ordClassKey,         simpleM gen_Ord_binds)\n               , (enumClassKey,        simpleM gen_Enum_binds)\n               , (boundedClassKey,     simple gen_Bounded_binds)\n               , (ixClassKey,          simpleM gen_Ix_binds)\n               , (showClassKey,        read_or_show gen_Show_binds)\n               , (readClassKey,        read_or_show gen_Read_binds)\n               , (dataClassKey,        simpleM gen_Data_binds)\n               , (functorClassKey,     simple gen_Functor_binds)\n               , (foldableClassKey,    simple gen_Foldable_binds)\n               , (traversableClassKey, simple gen_Traversable_binds)\n               , (liftClassKey,        simple gen_Lift_binds)\n               , (genClassKey,         generic (gen_Generic_binds Gen0))\n               , (gen1ClassKey,        generic (gen_Generic_binds Gen1)) ]\n\n    simple gen_fn loc tc _\n      = let (binds, deriv_stuff) = gen_fn loc tc\n        in return (binds, deriv_stuff, [])\n\n    simpleM gen_fn loc tc _\n      = do { (binds, deriv_stuff) <- gen_fn loc tc\n           ; return (binds, deriv_stuff, []) }\n\n    read_or_show gen_fn loc tc _\n      = do { fix_env <- getDataConFixityFun tc\n           ; let (binds, deriv_stuff) = gen_fn fix_env loc tc\n                 field_names          = all_field_names tc\n           ; return (binds, deriv_stuff, field_names) }\n\n    generic gen_fn _ tc inst_tys\n      = do { (binds, faminst) <- gen_fn tc inst_tys\n           ; let field_names = all_field_names tc\n           ; return (binds, unitBag (DerivFamInst faminst), field_names) }\n\n    -- See Note [Deriving and unused record selectors]\n    all_field_names = map flSelector . concatMap dataConFieldLabels\n                                     . tyConDataCons\n\n{-\nNote [Deriving and unused record selectors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this (see Trac #13919):\n\n  module Main (main) where\n\n  data Foo = MkFoo {bar :: String} deriving Show\n\n  main :: IO ()\n  main = print (Foo \"hello\")\n\nStrictly speaking, the record selector `bar` is unused in this module, since\nneither `main` nor the derived `Show` instance for `Foo` mention `bar`.\nHowever, the behavior of `main` is affected by the presence of `bar`, since\nit will print different output depending on whether `MkFoo` is defined using\nrecord selectors or not. Therefore, we do not to issue a\n\"Defined but not used: \u00e2\u20ac\u02dcbar\u00e2\u20ac\u2122\" warning for this module, since removing `bar`\nchanges the program's behavior. This is the reason behind the [Name] part of\nthe return type of `hasStockDeriving`\u00e2\u20ac\u201dit tracks all of the record selector\n`Name`s for which -Wunused-binds should be suppressed.\n\nCurrently, the only three stock derived classes that require this are Read,\nShow, and Generic, as their derived code all depend on the record selectors\nof the derived data type's constructors.\n\nSee also Note [Newtype deriving and unused constructors] in TcDeriv for\nanother example of a similar trick.\n-}\n\ngetDataConFixityFun :: TyCon -> TcM (Name -> Fixity)\n-- If the TyCon is locally defined, we want the local fixity env;\n-- but if it is imported (which happens for standalone deriving)\n-- we need to get the fixity env from the interface file\n-- c.f. RnEnv.lookupFixity, and Trac #9830\ngetDataConFixityFun tc\n  = do { this_mod <- getModule\n       ; if nameIsLocalOrFrom this_mod name\n         then do { fix_env <- getFixityEnv\n                 ; return (lookupFixity fix_env) }\n         else do { iface <- loadInterfaceForName doc name\n                            -- Should already be loaded!\n                 ; return (mi_fix iface . nameOccName) } }\n  where\n    name = tyConName tc\n    doc = text \"Data con fixities for\" <+> ppr name\n\n------------------------------------------------------------------\n-- Check side conditions that dis-allow derivability for the originative\n-- deriving strategies (stock and anyclass).\n-- See Note [Deriving strategies] in TcDeriv for an explanation of what\n-- \"originative\" means.\n--\n-- This is *apart* from the coerce-based strategies, newtype and via.\n--\n-- Here we get the representation tycon in case of family instances as it has\n-- the data constructors - but we need to be careful to fall back to the\n-- family tycon (with indexes) in error messages.\n\ncheckOriginativeSideConditions\n  :: DynFlags -> DerivContext -> Class -> [TcType]\n  -> TyCon -> TyCon\n  -> OriginativeDerivStatus\ncheckOriginativeSideConditions dflags deriv_ctxt cls cls_tys tc rep_tc\n    -- First, check if stock deriving is possible...\n  | Just cond <- stockSideConditions deriv_ctxt cls\n  = case (cond dflags tc rep_tc) of\n        NotValid err -> StockClassError err  -- Class-specific error\n        IsValid  | null (filterOutInvisibleTypes (classTyCon cls) cls_tys)\n                   -- All stock derivable classes are unary in the sense that\n                   -- there should be not types in cls_tys (i.e., no type args\n                   -- other than last). Note that cls_types can contain\n                   -- invisible types as well (e.g., for Generic1, which is\n                   -- poly-kinded), so make sure those are not counted.\n                 , Just gen_fn <- hasStockDeriving cls\n                   -> CanDeriveStock gen_fn\n                 | otherwise -> StockClassError (classArgsErr cls cls_tys)\n                   -- e.g. deriving( Eq s )\n\n    -- ...if not, try falling back on DeriveAnyClass.\n  | NotValid err <- canDeriveAnyClass dflags\n  = NonDerivableClass err  -- Neither anyclass nor stock work\n\n  | otherwise\n  = CanDeriveAnyClass   -- DeriveAnyClass should work\n\nclassArgsErr :: Class -> [Type] -> SDoc\nclassArgsErr cls cls_tys = quotes (ppr (mkClassPred cls cls_tys)) <+> text \"is not a class\"\n\n-- Side conditions (whether the datatype must have at least one constructor,\n-- required language extensions, etc.) for using GHC's stock deriving\n-- mechanism on certain classes (as opposed to classes that require\n-- GeneralizedNewtypeDeriving or DeriveAnyClass). Returns Nothing for a\n-- class for which stock deriving isn't possible.\nstockSideConditions :: DerivContext -> Class -> Maybe Condition\nstockSideConditions deriv_ctxt cls\n  | cls_key == eqClassKey          = Just (cond_std `andCond` cond_args cls)\n  | cls_key == ordClassKey         = Just (cond_std `andCond` cond_args cls)\n  | cls_key == showClassKey        = Just (cond_std `andCond` cond_args cls)\n  | cls_key == readClassKey        = Just (cond_std `andCond` cond_args cls)\n  | cls_key == enumClassKey        = Just (cond_std `andCond` cond_isEnumeration)\n  | cls_key == ixClassKey          = Just (cond_std `andCond` cond_enumOrProduct cls)\n  | cls_key == boundedClassKey     = Just (cond_std `andCond` cond_enumOrProduct cls)\n  | cls_key == dataClassKey        = Just (checkFlag LangExt.DeriveDataTypeable `andCond`\n                                           cond_vanilla `andCond`\n                                           cond_args cls)\n  | cls_key == functorClassKey     = Just (checkFlag LangExt.DeriveFunctor `andCond`\n                                           cond_vanilla `andCond`\n                                           cond_functorOK True False)\n  | cls_key == foldableClassKey    = Just (checkFlag LangExt.DeriveFoldable `andCond`\n                                           cond_vanilla `andCond`\n                                           cond_functorOK False True)\n                                           -- Functor/Fold/Trav works ok\n                                           -- for rank-n types\n  | cls_key == traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond`\n                                           cond_vanilla `andCond`\n                                           cond_functorOK False False)\n  | cls_key == genClassKey         = Just (checkFlag LangExt.DeriveGeneric `andCond`\n                                           cond_vanilla `andCond`\n                                           cond_RepresentableOk)\n  | cls_key == gen1ClassKey        = Just (checkFlag LangExt.DeriveGeneric `andCond`\n                                           cond_vanilla `andCond`\n                                           cond_Representable1Ok)\n  | cls_key == liftClassKey        = Just (checkFlag LangExt.DeriveLift `andCond`\n                                           cond_vanilla `andCond`\n                                           cond_args cls)\n  | otherwise                      = Nothing\n  where\n    cls_key = getUnique cls\n    cond_std     = cond_stdOK deriv_ctxt False\n      -- Vanilla data constructors, at least one, and monotype arguments\n    cond_vanilla = cond_stdOK deriv_ctxt True\n      -- Vanilla data constructors but allow no data cons or polytype arguments\n\ncanDeriveAnyClass :: DynFlags -> Validity\n-- IsValid: we can (try to) derive it via an empty instance declaration\n-- NotValid s:  we can't, reason s\ncanDeriveAnyClass dflags\n  | not (xopt LangExt.DeriveAnyClass dflags)\n  = NotValid (text \"Try enabling DeriveAnyClass\")\n  | otherwise\n  = IsValid   -- OK!\n\ntype Condition\n   = DynFlags\n\n  -> TyCon    -- ^ The data type's 'TyCon'. For data families, this is the\n              -- family 'TyCon'.\n\n  -> TyCon    -- ^ For data families, this is the representation 'TyCon'.\n              -- Otherwise, this is the same as the other 'TyCon' argument.\n\n  -> Validity -- ^ 'IsValid' if deriving an instance for this 'TyCon' is\n              -- possible. Otherwise, it's @'NotValid' err@, where @err@\n              -- explains what went wrong.\n\norCond :: Condition -> Condition -> Condition\norCond c1 c2 dflags tc rep_tc\n  = case (c1 dflags tc rep_tc, c2 dflags tc rep_tc) of\n     (IsValid,    _)          -> IsValid    -- c1 succeeds\n     (_,          IsValid)    -> IsValid    -- c21 succeeds\n     (NotValid x, NotValid y) -> NotValid (x $$ text \"  or\" $$ y)\n                                            -- Both fail\n\nandCond :: Condition -> Condition -> Condition\nandCond c1 c2 dflags tc rep_tc\n  = c1 dflags tc rep_tc `andValid` c2 dflags tc rep_tc\n\n-- | Some common validity checks shared among stock derivable classes. One\n-- check that absolutely must hold is that if an instance @C (T a)@ is being\n-- derived, then @T@ must be a tycon for a data type or a newtype. The\n-- remaining checks are only performed if using a @deriving@ clause (i.e.,\n-- they're ignored if using @StandaloneDeriving@):\n--\n-- 1. The data type must have at least one constructor (this check is ignored\n--    if using @EmptyDataDeriving@).\n--\n-- 2. The data type cannot have any GADT constructors.\n--\n-- 3. The data type cannot have any constructors with existentially quantified\n--    type variables.\n--\n-- 4. The data type cannot have a context (e.g., @data Foo a = Eq a => MkFoo@).\n--\n-- 5. The data type cannot have fields with higher-rank types.\ncond_stdOK\n  :: DerivContext -- ^ 'SupplyContext' if this is standalone deriving with a\n                  -- user-supplied context, 'InferContext' if not.\n                  -- If it is the former, we relax some of the validity checks\n                  -- we would otherwise perform (i.e., \"just go for it\").\n\n  -> Bool         -- ^ 'True' <=> allow higher rank arguments and empty data\n                  -- types (with no data constructors) even in the absence of\n                  -- the -XEmptyDataDeriving extension.\n\n  -> Condition\ncond_stdOK deriv_ctxt permissive dflags tc rep_tc\n  = valid_ADT `andValid` valid_misc\n  where\n    valid_ADT, valid_misc :: Validity\n    valid_ADT\n      | isAlgTyCon tc || isDataFamilyTyCon tc\n      = IsValid\n      | otherwise\n        -- Complain about functions, primitive types, and other tycons that\n        -- stock deriving can't handle.\n      = NotValid $ text \"The last argument of the instance must be a\"\n               <+> text \"data or newtype application\"\n\n    valid_misc\n      = case deriv_ctxt of\n         SupplyContext _ -> IsValid\n                -- Don't check these conservative conditions for\n                -- standalone deriving; just generate the code\n                -- and let the typechecker handle the result\n         InferContext wildcard\n           | null data_cons -- 1.\n           , not permissive\n           -> checkFlag LangExt.EmptyDataDeriving dflags tc rep_tc `orValid`\n              NotValid (no_cons_why rep_tc $$ empty_data_suggestion)\n           | not (null con_whys)\n           -> NotValid (vcat con_whys $$ possible_fix_suggestion wildcard)\n           | otherwise\n           -> IsValid\n\n    empty_data_suggestion =\n      text \"Use EmptyDataDeriving to enable deriving for empty data types\"\n    possible_fix_suggestion wildcard\n      = case wildcard of\n          Just _ ->\n            text \"Possible fix: fill in the wildcard constraint yourself\"\n          Nothing ->\n            text \"Possible fix: use a standalone deriving declaration instead\"\n    data_cons  = tyConDataCons rep_tc\n    con_whys   = getInvalids (map check_con data_cons)\n\n    check_con :: DataCon -> Validity\n    check_con con\n      | not (null eq_spec) -- 2.\n      = bad \"is a GADT\"\n      | not (null ex_tvs) -- 3.\n      = bad \"has existential type variables in its type\"\n      | not (null theta) -- 4.\n      = bad \"has constraints in its type\"\n      | not (permissive || all isTauTy (dataConOrigArgTys con)) -- 5.\n      = bad \"has a higher-rank type\"\n      | otherwise\n      = IsValid\n      where\n        (_, ex_tvs, eq_spec, theta, _, _) = dataConFullSig con\n        bad msg = NotValid (badCon con (text msg))\n\nno_cons_why :: TyCon -> SDoc\nno_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+>\n                     text \"must have at least one data constructor\"\n\ncond_RepresentableOk :: Condition\ncond_RepresentableOk _ _ rep_tc = canDoGenerics rep_tc\n\ncond_Representable1Ok :: Condition\ncond_Representable1Ok _ _ rep_tc = canDoGenerics1 rep_tc\n\ncond_enumOrProduct :: Class -> Condition\ncond_enumOrProduct cls = cond_isEnumeration `orCond`\n                         (cond_isProduct `andCond` cond_args cls)\n\ncond_args :: Class -> Condition\n-- For some classes (eg Eq, Ord) we allow unlifted arg types\n-- by generating specialised code.  For others (eg Data) we don't.\ncond_args cls _ _ rep_tc\n  = case bad_args of\n      []     -> IsValid\n      (ty:_) -> NotValid (hang (text \"Don't know how to derive\" <+> quotes (ppr cls))\n                             2 (text \"for type\" <+> quotes (ppr ty)))\n  where\n    bad_args = [ arg_ty | con <- tyConDataCons rep_tc\n                        , arg_ty <- dataConOrigArgTys con\n                        , isUnliftedType arg_ty\n                        , not (ok_ty arg_ty) ]\n\n    cls_key = classKey cls\n    ok_ty arg_ty\n     | cls_key == eqClassKey   = check_in arg_ty ordOpTbl\n     | cls_key == ordClassKey  = check_in arg_ty ordOpTbl\n     | cls_key == showClassKey = check_in arg_ty boxConTbl\n     | cls_key == liftClassKey = check_in arg_ty litConTbl\n     | otherwise               = False    -- Read, Ix etc\n\n    check_in :: Type -> [(Type,a)] -> Bool\n    check_in arg_ty tbl = any (eqType arg_ty . fst) tbl\n\n\ncond_isEnumeration :: Condition\ncond_isEnumeration _ _ rep_tc\n  | isEnumerationTyCon rep_tc = IsValid\n  | otherwise                 = NotValid why\n  where\n    why = sep [ quotes (pprSourceTyCon rep_tc) <+>\n                  text \"must be an enumeration type\"\n              , text \"(an enumeration consists of one or more nullary, non-GADT constructors)\" ]\n                  -- See Note [Enumeration types] in TyCon\n\ncond_isProduct :: Condition\ncond_isProduct _ _ rep_tc\n  | isProductTyCon rep_tc = IsValid\n  | otherwise             = NotValid why\n  where\n    why = quotes (pprSourceTyCon rep_tc) <+>\n          text \"must have precisely one constructor\"\n\ncond_functorOK :: Bool -> Bool -> Condition\n-- OK for Functor/Foldable/Traversable class\n-- Currently: (a) at least one argument\n--            (b) don't use argument contravariantly\n--            (c) don't use argument in the wrong place, e.g. data T a = T (X a a)\n--            (d) optionally: don't use function types\n--            (e) no \"stupid context\" on data type\ncond_functorOK allowFunctions allowExQuantifiedLastTyVar _ _ rep_tc\n  | null tc_tvs\n  = NotValid (text \"Data type\" <+> quotes (ppr rep_tc)\n              <+> text \"must have some type parameters\")\n\n  | not (null bad_stupid_theta)\n  = NotValid (text \"Data type\" <+> quotes (ppr rep_tc)\n              <+> text \"must not have a class context:\" <+> pprTheta bad_stupid_theta)\n\n  | otherwise\n  = allValid (map check_con data_cons)\n  where\n    tc_tvs            = tyConTyVars rep_tc\n    last_tv           = last tc_tvs\n    bad_stupid_theta  = filter is_bad (tyConStupidTheta rep_tc)\n    is_bad pred       = last_tv `elemVarSet` exactTyCoVarsOfType pred\n      -- See Note [Check that the type variable is truly universal]\n\n    data_cons = tyConDataCons rep_tc\n    check_con con = allValid (check_universal con : foldDataConArgs (ft_check con) con)\n\n    check_universal :: DataCon -> Validity\n    check_universal con\n      | allowExQuantifiedLastTyVar\n      = IsValid -- See Note [DeriveFoldable with ExistentialQuantification]\n                -- in TcGenFunctor\n      | Just tv <- getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))\n      , tv `elem` dataConUnivTyVars con\n      , not (tv `elemVarSet` exactTyCoVarsOfTypes (dataConTheta con))\n      = IsValid   -- See Note [Check that the type variable is truly universal]\n      | otherwise\n      = NotValid (badCon con existential)\n\n    ft_check :: DataCon -> FFoldType Validity\n    ft_check con = FT { ft_triv = IsValid, ft_var = IsValid\n                      , ft_co_var = NotValid (badCon con covariant)\n                      , ft_fun = \\x y -> if allowFunctions then x `andValid` y\n                                                           else NotValid (badCon con functions)\n                      , ft_tup = \\_ xs  -> allValid xs\n                      , ft_ty_app = \\_ x   -> x\n                      , ft_bad_app = NotValid (badCon con wrong_arg)\n                      , ft_forall = \\_ x   -> x }\n\n    existential = text \"must be truly polymorphic in the last argument of the data type\"\n    covariant   = text \"must not use the type variable in a function argument\"\n    functions   = text \"must not contain function types\"\n    wrong_arg   = text \"must use the type variable only as the last argument of a data type\"\n\ncheckFlag :: LangExt.Extension -> Condition\ncheckFlag flag dflags _ _\n  | xopt flag dflags = IsValid\n  | otherwise        = NotValid why\n  where\n    why = text \"You need \" <> text flag_str\n          <+> text \"to derive an instance for this class\"\n    flag_str = case [ flagSpecName f | f <- xFlags , flagSpecFlag f == flag ] of\n                 [s]   -> s\n                 other -> pprPanic \"checkFlag\" (ppr other)\n\nstd_class_via_coercible :: Class -> Bool\n-- These standard classes can be derived for a newtype\n-- using the coercible trick *even if no -XGeneralizedNewtypeDeriving\n-- because giving so gives the same results as generating the boilerplate\nstd_class_via_coercible clas\n  = classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]\n        -- Not Read/Show because they respect the type\n        -- Not Enum, because newtypes are never in Enum\n\n\nnon_coercible_class :: Class -> Bool\n-- *Never* derive Read, Show, Typeable, Data, Generic, Generic1, Lift\n-- by Coercible, even with -XGeneralizedNewtypeDeriving\n-- Also, avoid Traversable, as the Coercible-derived instance and the \"normal\"-derived\n-- instance behave differently if there's a non-lawful Applicative out there.\n-- Besides, with roles, Coercible-deriving Traversable is ill-roled.\nnon_coercible_class cls\n  = classKey cls `elem` ([ readClassKey, showClassKey, dataClassKey\n                         , genClassKey, gen1ClassKey, typeableClassKey\n                         , traversableClassKey, liftClassKey ])\n\nbadCon :: DataCon -> SDoc -> SDoc\nbadCon con msg = text \"Constructor\" <+> quotes (ppr con) <+> msg\n\n------------------------------------------------------------------\n\nnewDerivClsInst :: ThetaType -> DerivSpec theta -> TcM ClsInst\nnewDerivClsInst theta (DS { ds_name = dfun_name, ds_overlap = overlap_mode\n                          , ds_tvs = tvs, ds_cls = clas, ds_tys = tys })\n  = newClsInst overlap_mode dfun_name tvs theta clas tys\n\nextendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a\n-- Add new locally-defined instances; don't bother to check\n-- for functional dependency errors -- that'll happen in TcInstDcls\nextendLocalInstEnv dfuns thing_inside\n = do { env <- getGblEnv\n      ; let  inst_env' = extendInstEnvList (tcg_inst_env env) dfuns\n             env'      = env { tcg_inst_env = inst_env' }\n      ; setGblEnv env' thing_inside }\n\n{-\nNote [Deriving any class]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nClassic uses of a deriving clause, or a standalone-deriving declaration, are\nfor:\n  * a stock class like Eq or Show, for which GHC knows how to generate\n    the instance code\n  * a newtype, via the mechanism enabled by GeneralizedNewtypeDeriving\n\nThe DeriveAnyClass extension adds a third way to derive instances, based on\nempty instance declarations.\n\nThe canonical use case is in combination with GHC.Generics and default method\nsignatures. These allow us to have instance declarations being empty, but still\nuseful, e.g.\n\n  data T a = ...blah..blah... deriving( Generic )\n  instance C a => C (T a)  -- No 'where' clause\n\nwhere C is some \"random\" user-defined class.\n\nThis boilerplate code can be replaced by the more compact\n\n  data T a = ...blah..blah... deriving( Generic, C )\n\nif DeriveAnyClass is enabled.\n\nThis is not restricted to Generics; any class can be derived, simply giving\nrise to an empty instance.\n\nUnfortunately, it is not clear how to determine the context (when using a\nderiving clause; in standalone deriving, the user provides the context).\nGHC uses the same heuristic for figuring out the class context that it uses for\nEq in the case of *-kinded classes, and for Functor in the case of\n* -> *-kinded classes. That may not be optimal or even wrong. But in such\ncases, standalone deriving can still be used.\n\nNote [Check that the type variable is truly universal]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor Functor and Traversable instances, we must check that the *last argument*\nof the type constructor is used truly universally quantified.  Example\n\n   data T a b where\n     T1 :: a -> b -> T a b      -- Fine! Vanilla H-98\n     T2 :: b -> c -> T a b      -- Fine! Existential c, but we can still map over 'b'\n     T3 :: b -> T Int b         -- Fine! Constraint 'a', but 'b' is still polymorphic\n     T4 :: Ord b => b -> T a b  -- No!  'b' is constrained\n     T5 :: b -> T b b           -- No!  'b' is constrained\n     T6 :: T a (b,b)            -- No!  'b' is constrained\n\nNotice that only the first of these constructors is vanilla H-98. We only\nneed to take care about the last argument (b in this case).  See Trac #8678.\nEg. for T1-T3 we can write\n\n     fmap f (T1 a b) = T1 a (f b)\n     fmap f (T2 b c) = T2 (f b) c\n     fmap f (T3 x)   = T3 (f x)\n\nWe need not perform these checks for Foldable instances, however, since\nfunctions in Foldable can only consume existentially quantified type variables,\nrather than produce them (as is the case in Functor and Traversable functions.)\nAs a result, T can have a derived Foldable instance:\n\n    foldr f z (T1 a b) = f b z\n    foldr f z (T2 b c) = f b z\n    foldr f z (T3 x)   = f x z\n    foldr f z (T4 x)   = f x z\n    foldr f z (T5 x)   = f x z\n    foldr _ z T6       = z\n\nSee Note [DeriveFoldable with ExistentialQuantification] in TcGenFunctor.\n\nFor Functor and Traversable, we must take care not to let type synonyms\nunfairly reject a type for not being truly universally quantified. An\nexample of this is:\n\n    type C (a :: Constraint) b = a\n    data T a b = C (Show a) b => MkT b\n\nHere, the existential context (C (Show a) b) does technically mention the last\ntype variable b. But this is OK, because expanding the type synonym C would\ngive us the context (Show a), which doesn't mention b. Therefore, we must make\nsure to expand type synonyms before performing this check. Not doing so led to\nTrac #13813.\n-}\n", "num_lines": 975}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n{-# LANGUAGE CPP, FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}  -- instance MonadThings is necessarily an\n                                       -- orphan\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n                                      -- in module PlaceHolder\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcEnv(\n        TyThing(..), TcTyThing(..), TcId,\n\n        -- Instance environment, and InstInfo type\n        InstInfo(..), iDFunId, pprInstInfoDetails,\n        simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon,\n        InstBindings(..),\n\n        -- Global environment\n        tcExtendGlobalEnv, tcExtendTyConEnv,\n        tcExtendGlobalEnvImplicit, setGlobalTypeEnv,\n        tcExtendGlobalValEnv,\n        tcLookupLocatedGlobal, tcLookupGlobal, tcLookupGlobalOnly,\n        tcLookupTyCon, tcLookupClass,\n        tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,\n        tcLookupLocatedGlobalId, tcLookupLocatedTyCon,\n        tcLookupLocatedClass, tcLookupAxiom,\n        lookupGlobal, ioLookupDataCon,\n\n        -- Local environment\n        tcExtendKindEnv, tcExtendKindEnvList,\n        tcExtendTyVarEnv, tcExtendNameTyVarEnv,\n        tcExtendLetEnv, tcExtendSigIds, tcExtendRecIds,\n        tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,\n        tcExtendBinderStack, tcExtendLocalTypeEnv,\n        isTypeClosedLetBndr,\n\n        tcLookup, tcLookupLocated, tcLookupLocalIds,\n        tcLookupId, tcLookupIdMaybe, tcLookupTyVar,\n        tcLookupLcl_maybe,\n        getInLocalScope,\n        wrongThingErr, pprBinders,\n\n        tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders,\n        getTypeSigNames,\n        tcExtendRecEnv,         -- For knot-tying\n\n        -- Tidying\n        tcInitTidyEnv, tcInitOpenTidyEnv,\n\n        -- Instances\n        tcLookupInstance, tcGetInstEnvs,\n\n        -- Rules\n        tcExtendRules,\n\n        -- Defaults\n        tcGetDefaultTys,\n\n        -- Global type variables\n        tcGetGlobalTyCoVars,\n\n        -- Template Haskell stuff\n        checkWellStaged, tcMetaTy, thLevel,\n        topIdLvl, isBrackStage,\n\n        -- New Ids\n        newDFunName, newDFunName', newFamInstTyConName,\n        newFamInstAxiomName,\n        mkStableIdFromString, mkStableIdFromName,\n        mkWrapperName\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport IfaceEnv\nimport TcRnMonad\nimport TcMType\nimport TcType\nimport LoadIface\nimport PrelNames\nimport TysWiredIn\nimport Id\nimport Var\nimport VarSet\nimport RdrName\nimport InstEnv\nimport DataCon ( DataCon )\nimport PatSyn  ( PatSyn )\nimport ConLike\nimport TyCon\nimport Type\nimport CoAxiom\nimport Class\nimport Name\nimport NameSet\nimport NameEnv\nimport VarEnv\nimport HscTypes\nimport DynFlags\nimport SrcLoc\nimport BasicTypes hiding( SuccessFlag(..) )\nimport Module\nimport Outputable\nimport Encoding\nimport FastString\nimport ListSetOps\nimport ErrUtils\nimport Util\nimport Maybes( MaybeErr(..), orElse )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.IORef\nimport Data.List\nimport Control.Monad\n\n{- *********************************************************************\n*                                                                      *\n            An IO interface to looking up globals\n*                                                                      *\n********************************************************************* -}\n\nlookupGlobal :: HscEnv -> Name -> IO TyThing\n-- A variant of lookupGlobal_maybe for the clients which are not\n-- interested in recovering from lookup failure and accept panic.\nlookupGlobal hsc_env name\n  = do  {\n          mb_thing <- lookupGlobal_maybe hsc_env name\n        ; case mb_thing of\n            Succeeded thing -> return thing\n            Failed msg      -> pprPanic \"lookupGlobal\" msg\n        }\n\nlookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)\n-- This may look up an Id that one one has previously looked up.\n-- If so, we are going to read its interface file, and add its bindings\n-- to the ExternalPackageTable.\nlookupGlobal_maybe hsc_env name\n  = do  {    -- Try local envt\n          let mod = icInteractiveModule (hsc_IC hsc_env)\n              dflags = hsc_dflags hsc_env\n              tcg_semantic_mod = canonicalizeModuleIfHome dflags mod\n\n        ; if nameIsLocalOrFrom tcg_semantic_mod name\n              then (return\n                (Failed (text \"Can't find local name: \" <+> ppr name)))\n                  -- Internal names can happen in GHCi\n              else\n           -- Try home package table and external package table\n          lookupImported_maybe hsc_env name\n        }\n\nlookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)\n-- Returns (Failed err) if we can't find the interface file for the thing\nlookupImported_maybe hsc_env name\n  = do  { mb_thing <- lookupTypeHscEnv hsc_env name\n        ; case mb_thing of\n            Just thing -> return (Succeeded thing)\n            Nothing    -> importDecl_maybe hsc_env name\n            }\n\nimportDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)\nimportDecl_maybe hsc_env name\n  | Just thing <- wiredInNameTyThing_maybe name\n  = do  { when (needWiredInHomeIface thing)\n               (initIfaceLoad hsc_env (loadWiredInHomeIface name))\n                -- See Note [Loading instances for wired-in things]\n        ; return (Succeeded thing) }\n  | otherwise\n  = initIfaceLoad hsc_env (importDecl name)\n\nioLookupDataCon :: HscEnv -> Name -> IO DataCon\nioLookupDataCon hsc_env name = do\n  mb_thing <- ioLookupDataCon_maybe hsc_env name\n  case mb_thing of\n    Succeeded thing -> return thing\n    Failed msg      -> pprPanic \"lookupDataConIO\" msg\n\nioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc DataCon)\nioLookupDataCon_maybe hsc_env name = do\n    thing <- lookupGlobal hsc_env name\n    return $ case thing of\n        AConLike (RealDataCon con) -> Succeeded con\n        _                          -> Failed $\n          pprTcTyThingCategory (AGlobal thing) <+> quotes (ppr name) <+>\n                text \"used as a data constructor\"\n\n{-\n************************************************************************\n*                                                                      *\n*                      tcLookupGlobal                                  *\n*                                                                      *\n************************************************************************\n\nUsing the Located versions (eg. tcLookupLocatedGlobal) is preferred,\nunless you know that the SrcSpan in the monad is already set to the\nspan of the Name.\n-}\n\n\ntcLookupLocatedGlobal :: Located Name -> TcM TyThing\n-- c.f. IfaceEnvEnv.tcIfaceGlobal\ntcLookupLocatedGlobal name\n  = addLocM tcLookupGlobal name\n\ntcLookupGlobal :: Name -> TcM TyThing\n-- The Name is almost always an ExternalName, but not always\n-- In GHCi, we may make command-line bindings (ghci> let x = True)\n-- that bind a GlobalId, but with an InternalName\ntcLookupGlobal name\n  = do  {    -- Try local envt\n          env <- getGblEnv\n        ; case lookupNameEnv (tcg_type_env env) name of {\n                Just thing -> return thing ;\n                Nothing    ->\n\n                -- Should it have been in the local envt?\n                -- (NB: use semantic mod here, since names never use\n                -- identity module, see Note [Identity versus semantic module].)\n          if nameIsLocalOrFrom (tcg_semantic_mod env) name\n          then notFound name  -- Internal names can happen in GHCi\n          else\n\n           -- Try home package table and external package table\n    do  { mb_thing <- tcLookupImported_maybe name\n        ; case mb_thing of\n            Succeeded thing -> return thing\n            Failed msg      -> failWithTc msg\n        }}}\n\n-- Look up only in this module's global env't. Don't look in imports, etc.\n-- Panic if it's not there.\ntcLookupGlobalOnly :: Name -> TcM TyThing\ntcLookupGlobalOnly name\n  = do { env <- getGblEnv\n       ; return $ case lookupNameEnv (tcg_type_env env) name of\n                    Just thing -> thing\n                    Nothing    -> pprPanic \"tcLookupGlobalOnly\" (ppr name) }\n\ntcLookupDataCon :: Name -> TcM DataCon\ntcLookupDataCon name = do\n    thing <- tcLookupGlobal name\n    case thing of\n        AConLike (RealDataCon con) -> return con\n        _                          -> wrongThingErr \"data constructor\" (AGlobal thing) name\n\ntcLookupPatSyn :: Name -> TcM PatSyn\ntcLookupPatSyn name = do\n    thing <- tcLookupGlobal name\n    case thing of\n        AConLike (PatSynCon ps) -> return ps\n        _                       -> wrongThingErr \"pattern synonym\" (AGlobal thing) name\n\ntcLookupConLike :: Name -> TcM ConLike\ntcLookupConLike name = do\n    thing <- tcLookupGlobal name\n    case thing of\n        AConLike cl -> return cl\n        _           -> wrongThingErr \"constructor-like thing\" (AGlobal thing) name\n\ntcLookupClass :: Name -> TcM Class\ntcLookupClass name = do\n    thing <- tcLookupGlobal name\n    case thing of\n        ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls\n        _                                           -> wrongThingErr \"class\" (AGlobal thing) name\n\ntcLookupTyCon :: Name -> TcM TyCon\ntcLookupTyCon name = do\n    thing <- tcLookupGlobal name\n    case thing of\n        ATyCon tc -> return tc\n        _         -> wrongThingErr \"type constructor\" (AGlobal thing) name\n\ntcLookupAxiom :: Name -> TcM (CoAxiom Branched)\ntcLookupAxiom name = do\n    thing <- tcLookupGlobal name\n    case thing of\n        ACoAxiom ax -> return ax\n        _           -> wrongThingErr \"axiom\" (AGlobal thing) name\n\ntcLookupLocatedGlobalId :: Located Name -> TcM Id\ntcLookupLocatedGlobalId = addLocM tcLookupId\n\ntcLookupLocatedClass :: Located Name -> TcM Class\ntcLookupLocatedClass = addLocM tcLookupClass\n\ntcLookupLocatedTyCon :: Located Name -> TcM TyCon\ntcLookupLocatedTyCon = addLocM tcLookupTyCon\n\n-- Find the instance that exactly matches a type class application.  The class arguments must be precisely\n-- the same as in the instance declaration (modulo renaming & casts).\n--\ntcLookupInstance :: Class -> [Type] -> TcM ClsInst\ntcLookupInstance cls tys\n  = do { instEnv <- tcGetInstEnvs\n       ; case lookupUniqueInstEnv instEnv cls tys of\n           Left err             -> failWithTc $ text \"Couldn't match instance:\" <+> err\n           Right (inst, tys)\n             | uniqueTyVars tys -> return inst\n             | otherwise        -> failWithTc errNotExact\n       }\n  where\n    errNotExact = text \"Not an exact match (i.e., some variables get instantiated)\"\n\n    uniqueTyVars tys = all isTyVarTy tys\n                    && hasNoDups (map (getTyVar \"tcLookupInstance\") tys)\n\ntcGetInstEnvs :: TcM InstEnvs\n-- Gets both the external-package inst-env\n-- and the home-pkg inst env (includes module being compiled)\ntcGetInstEnvs = do { eps <- getEps\n                   ; env <- getGblEnv\n                   ; return (InstEnvs { ie_global  = eps_inst_env eps\n                                      , ie_local   = tcg_inst_env env\n                                      , ie_visible = tcVisibleOrphanMods env }) }\n\ninstance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where\n    lookupThing = tcLookupGlobal\n\n{-\n************************************************************************\n*                                                                      *\n                Extending the global environment\n*                                                                      *\n************************************************************************\n-}\n\nsetGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv\n-- Use this to update the global type env\n-- It updates both  * the normal tcg_type_env field\n--                  * the tcg_type_env_var field seen by interface files\nsetGlobalTypeEnv tcg_env new_type_env\n  = do  {     -- Sync the type-envt variable seen by interface files\n           writeMutVar (tcg_type_env_var tcg_env) new_type_env\n         ; return (tcg_env { tcg_type_env = new_type_env }) }\n\n\ntcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r\n  -- Just extend the global environment with some TyThings\n  -- Do not extend tcg_tcs, tcg_patsyns etc\ntcExtendGlobalEnvImplicit things thing_inside\n   = do { tcg_env <- getGblEnv\n        ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things\n        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'\n        ; setGblEnv tcg_env' thing_inside }\n\ntcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r\n  -- Given a mixture of Ids, TyCons, Classes, all defined in the\n  -- module being compiled, extend the global environment\ntcExtendGlobalEnv things thing_inside\n  = do { env <- getGblEnv\n       ; let env' = env { tcg_tcs = [tc | ATyCon tc <- things] ++ tcg_tcs env,\n                          tcg_patsyns = [ps | AConLike (PatSynCon ps) <- things] ++ tcg_patsyns env }\n       ; setGblEnv env' $\n            tcExtendGlobalEnvImplicit things thing_inside\n       }\n\ntcExtendTyConEnv :: [TyCon] -> TcM r -> TcM r\n  -- Given a mixture of Ids, TyCons, Classes, all defined in the\n  -- module being compiled, extend the global environment\ntcExtendTyConEnv tycons thing_inside\n  = do { env <- getGblEnv\n       ; let env' = env { tcg_tcs = tycons ++ tcg_tcs env }\n       ; setGblEnv env' $\n         tcExtendGlobalEnvImplicit (map ATyCon tycons) thing_inside\n       }\n\ntcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a\n  -- Same deal as tcExtendGlobalEnv, but for Ids\ntcExtendGlobalValEnv ids thing_inside\n  = tcExtendGlobalEnvImplicit [AnId id | id <- ids] thing_inside\n\ntcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r\n-- Extend the global environments for the type/class knot tying game\n-- Just like tcExtendGlobalEnv, except the argument is a list of pairs\ntcExtendRecEnv gbl_stuff thing_inside\n = do  { tcg_env <- getGblEnv\n       ; let ge'      = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff\n             tcg_env' = tcg_env { tcg_type_env = ge' }\n         -- No need for setGlobalTypeEnv (which side-effects the\n         -- tcg_type_env_var); tcExtendRecEnv is used just\n         -- when kind-check a group of type/class decls. It would\n         -- in any case be wrong for an interface-file decl to end up\n         -- with a TcTyCon in it!\n       ; setGblEnv tcg_env' thing_inside }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{The local environment}\n*                                                                      *\n************************************************************************\n-}\n\ntcLookupLocated :: Located Name -> TcM TcTyThing\ntcLookupLocated = addLocM tcLookup\n\ntcLookupLcl_maybe :: Name -> TcM (Maybe TcTyThing)\ntcLookupLcl_maybe name\n  = do { local_env <- getLclTypeEnv\n       ; return (lookupNameEnv local_env name) }\n\ntcLookup :: Name -> TcM TcTyThing\ntcLookup name = do\n    local_env <- getLclTypeEnv\n    case lookupNameEnv local_env name of\n        Just thing -> return thing\n        Nothing    -> AGlobal <$> tcLookupGlobal name\n\ntcLookupTyVar :: Name -> TcM TcTyVar\ntcLookupTyVar name\n  = do { thing <- tcLookup name\n       ; case thing of\n           ATyVar _ tv -> return tv\n           _           -> pprPanic \"tcLookupTyVar\" (ppr name) }\n\ntcLookupId :: Name -> TcM Id\n-- Used when we aren't interested in the binding level, nor refinement.\n-- The \"no refinement\" part means that we return the un-refined Id regardless\n--\n-- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)\ntcLookupId name = do\n    thing <- tcLookupIdMaybe name\n    case thing of\n        Just id -> return id\n        _       -> pprPanic \"tcLookupId\" (ppr name)\n\ntcLookupIdMaybe :: Name -> TcM (Maybe Id)\ntcLookupIdMaybe name\n  = do { thing <- tcLookup name\n       ; case thing of\n           ATcId { tct_id = id} -> return $ Just id\n           AGlobal (AnId id)    -> return $ Just id\n           _                    -> return Nothing }\n\ntcLookupLocalIds :: [Name] -> TcM [TcId]\n-- We expect the variables to all be bound, and all at\n-- the same level as the lookup.  Only used in one place...\ntcLookupLocalIds ns\n  = do { env <- getLclEnv\n       ; return (map (lookup (tcl_env env)) ns) }\n  where\n    lookup lenv name\n        = case lookupNameEnv lenv name of\n                Just (ATcId { tct_id = id }) ->  id\n                _ -> pprPanic \"tcLookupLocalIds\" (ppr name)\n\ngetInLocalScope :: TcM (Name -> Bool)\ngetInLocalScope = do { lcl_env <- getLclTypeEnv\n                     ; return (`elemNameEnv` lcl_env) }\n\ntcExtendKindEnvList :: [(Name, TcTyThing)] -> TcM r -> TcM r\n-- Used only during kind checking, for TcThings that are\n--      ATcTyCon or APromotionErr\n-- No need to update the global tyvars, or tcl_th_bndrs, or tcl_rdr\ntcExtendKindEnvList things thing_inside\n  = do { traceTc \"tcExtendKindEnvList\" (ppr things)\n       ; updLclEnv upd_env thing_inside }\n  where\n    upd_env env = env { tcl_env = extendNameEnvList (tcl_env env) things }\n\ntcExtendKindEnv :: NameEnv TcTyThing -> TcM r -> TcM r\n-- A variant of tcExtendKindEvnList\ntcExtendKindEnv extra_env thing_inside\n  = do { traceTc \"tcExtendKindEnv\" (ppr extra_env)\n       ; updLclEnv upd_env thing_inside }\n  where\n    upd_env env = env { tcl_env = tcl_env env `plusNameEnv` extra_env }\n\n-----------------------\n-- Scoped type and kind variables\ntcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r\ntcExtendTyVarEnv tvs thing_inside\n  = tcExtendNameTyVarEnv (mkTyVarNamePairs tvs) thing_inside\n\ntcExtendNameTyVarEnv :: [(Name,TcTyVar)] -> TcM r -> TcM r\ntcExtendNameTyVarEnv binds thing_inside\n  -- this should be used only for explicitly mentioned scoped variables.\n  -- thus, no coercion variables\n  = do { tc_extend_local_env NotTopLevel\n                    [(name, ATyVar name tv) | (name, tv) <- binds] $\n         tcExtendBinderStack tv_binds $\n         thing_inside }\n  where\n    tv_binds :: [TcBinder]\n    tv_binds = [TcTvBndr name tv | (name,tv) <- binds]\n\nisTypeClosedLetBndr :: Id -> Bool\n-- See Note [Bindings with closed types] in TcRnTypes\nisTypeClosedLetBndr = noFreeVarsOfType . idType\n\ntcExtendRecIds :: [(Name, TcId)] -> TcM a -> TcM a\n-- Used for binding the recurive uses of Ids in a binding\n-- both top-level value bindings and and nested let/where-bindings\n-- Does not extend the TcBinderStack\ntcExtendRecIds pairs thing_inside\n  = tc_extend_local_env NotTopLevel\n          [ (name, ATcId { tct_id   = let_id\n                         , tct_info = NonClosedLet emptyNameSet False })\n          | (name, let_id) <- pairs ] $\n    thing_inside\n\ntcExtendSigIds :: TopLevelFlag -> [TcId] -> TcM a -> TcM a\n-- Used for binding the Ids that have a complete user type signature\n-- Does not extend the TcBinderStack\ntcExtendSigIds top_lvl sig_ids thing_inside\n  = tc_extend_local_env top_lvl\n          [ (idName id, ATcId { tct_id   = id\n                              , tct_info = info })\n          | id <- sig_ids\n          , let closed = isTypeClosedLetBndr id\n                info   = NonClosedLet emptyNameSet closed ]\n     thing_inside\n\n\ntcExtendLetEnv :: TopLevelFlag -> TcSigFun -> IsGroupClosed\n                  -> [TcId] -> TcM a -> TcM a\n-- Used for both top-level value bindings and and nested let/where-bindings\n-- Adds to the TcBinderStack too\ntcExtendLetEnv top_lvl sig_fn (IsGroupClosed fvs fv_type_closed)\n               ids thing_inside\n  = tcExtendBinderStack [TcIdBndr id top_lvl | id <- ids] $\n    tc_extend_local_env top_lvl\n          [ (idName id, ATcId { tct_id   = id\n                              , tct_info = mk_tct_info id })\n          | id <- ids ]\n    thing_inside\n  where\n    mk_tct_info id\n      | type_closed && isEmptyNameSet rhs_fvs = ClosedLet\n      | otherwise                             = NonClosedLet rhs_fvs type_closed\n      where\n        name        = idName id\n        rhs_fvs     = lookupNameEnv fvs name `orElse` emptyNameSet\n        type_closed = isTypeClosedLetBndr id &&\n                      (fv_type_closed || hasCompleteSig sig_fn name)\n\ntcExtendIdEnv :: [TcId] -> TcM a -> TcM a\n-- For lambda-bound and case-bound Ids\n-- Extends the TcBinderStack as well\ntcExtendIdEnv ids thing_inside\n  = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside\n\ntcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a\n-- Exactly like tcExtendIdEnv2, but for a single (name,id) pair\ntcExtendIdEnv1 name id thing_inside\n  = tcExtendIdEnv2 [(name,id)] thing_inside\n\ntcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a\ntcExtendIdEnv2 names_w_ids thing_inside\n  = tcExtendBinderStack [ TcIdBndr mono_id NotTopLevel\n                        | (_,mono_id) <- names_w_ids ] $\n    tc_extend_local_env NotTopLevel\n            [ (name, ATcId { tct_id = id\n                           , tct_info    = NotLetBound })\n            | (name,id) <- names_w_ids]\n    thing_inside\n\ntc_extend_local_env :: TopLevelFlag -> [(Name, TcTyThing)] -> TcM a -> TcM a\ntc_extend_local_env top_lvl extra_env thing_inside\n-- Precondition: the argument list extra_env has TcTyThings\n--               that ATcId or ATyVar, but nothing else\n--\n-- Invariant: the ATcIds are fully zonked. Reasons:\n--      (a) The kinds of the forall'd type variables are defaulted\n--          (see Kind.defaultKind, done in skolemiseQuantifiedTyVar)\n--      (b) There are no via-Indirect occurrences of the bound variables\n--          in the types, because instantiation does not look through such things\n--      (c) The call to tyCoVarsOfTypes is ok without looking through refs\n\n-- The second argument of type TyVarSet is a set of type variables\n-- that are bound together with extra_env and should not be regarded\n-- as free in the types of extra_env.\n  = do  { traceTc \"tc_extend_local_env\" (ppr extra_env)\n        ; env0 <- getLclEnv\n        ; env1 <- tcExtendLocalTypeEnv env0 extra_env\n        ; stage <- getStage\n        ; let env2 = extend_local_env (top_lvl, thLevel stage) extra_env env1\n        ; setLclEnv env2 thing_inside }\n  where\n    extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcLclEnv -> TcLclEnv\n    -- Extend the local LocalRdrEnv and Template Haskell staging env simultaneously\n    -- Reason for extending LocalRdrEnv: after running a TH splice we need\n    -- to do renaming.\n    extend_local_env thlvl pairs env@(TcLclEnv { tcl_rdr = rdr_env\n                                               , tcl_th_bndrs = th_bndrs })\n      = env { tcl_rdr      = extendLocalRdrEnvList rdr_env\n                                [ n | (n, _) <- pairs, isInternalName n ]\n                                -- The LocalRdrEnv contains only non-top-level names\n                                -- (GlobalRdrEnv handles the top level)\n            , tcl_th_bndrs = extendNameEnvList th_bndrs  -- We only track Ids in tcl_th_bndrs\n                                 [(n, thlvl) | (n, ATcId {}) <- pairs] }\n\ntcExtendLocalTypeEnv :: TcLclEnv -> [(Name, TcTyThing)] -> TcM TcLclEnv\ntcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things\n  | isEmptyVarSet extra_tvs\n  = return (lcl_env { tcl_env = extendNameEnvList lcl_type_env tc_ty_things })\n  | otherwise\n  = do { global_tvs <- readMutVar (tcl_tyvars lcl_env)\n       ; new_g_var  <- newMutVar (global_tvs `unionVarSet` extra_tvs)\n       ; return (lcl_env { tcl_tyvars = new_g_var\n                         , tcl_env = extendNameEnvList lcl_type_env tc_ty_things } ) }\n  where\n    extra_tvs = foldr get_tvs emptyVarSet tc_ty_things\n\n    get_tvs (_, ATcId { tct_id = id, tct_info = closed }) tvs\n      = case closed of\n          ClosedLet -> ASSERT2( is_closed_type, ppr id $$ ppr (idType id) )\n                       tvs\n          _other    -> tvs `unionVarSet` id_tvs\n        where\n           id_ty          = idType id\n           id_tvs         = tyCoVarsOfType id_ty\n           id_co_tvs      = closeOverKinds (coVarsOfType id_ty)\n           is_closed_type = not (anyVarSet isTyVar (id_tvs `minusVarSet` id_co_tvs))\n           -- We only care about being closed wrt /type/ variables\n           -- E.g. a top-level binding might have a type like\n           --          foo :: t |> co\n           -- where co :: * ~ *\n           -- or some other as-yet-unsolved kind coercion\n\n    get_tvs (_, ATyVar _ tv) tvs          -- See Note [Global TyVars]\n      = tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv) `extendVarSet` tv\n\n    get_tvs (_, ATcTyCon tc) tvs = tvs `unionVarSet` tyCoVarsOfType (tyConKind tc)\n\n    get_tvs (_, AGlobal {})       tvs = tvs\n    get_tvs (_, APromotionErr {}) tvs = tvs\n\n        -- Note [Global TyVars]\n        -- It's important to add the in-scope tyvars to the global tyvar set\n        -- as well.  Consider\n        --      f (_::r) = let g y = y::r in ...\n        -- Here, g mustn't be generalised.  This is also important during\n        -- class and instance decls, when we mustn't generalise the class tyvars\n        -- when typechecking the methods.\n        --\n        -- Nor must we generalise g over any kind variables free in r's kind\n\n\n{- *********************************************************************\n*                                                                      *\n             The TcBinderStack\n*                                                                      *\n********************************************************************* -}\n\ntcExtendBinderStack :: [TcBinder] -> TcM a -> TcM a\ntcExtendBinderStack bndrs thing_inside\n  = do { traceTc \"tcExtendBinderStack\" (ppr bndrs)\n       ; updLclEnv (\\env -> env { tcl_bndrs = bndrs ++ tcl_bndrs env })\n                   thing_inside }\n\ntcInitTidyEnv :: TcM TidyEnv\n-- We initialise the \"tidy-env\", used for tidying types before printing,\n-- by building a reverse map from the in-scope type variables to the\n-- OccName that the programmer originally used for them\ntcInitTidyEnv\n  = do  { lcl_env <- getLclEnv\n        ; go emptyTidyEnv (tcl_bndrs lcl_env) }\n  where\n    go (env, subst) []\n      = return (env, subst)\n    go (env, subst) (b : bs)\n      | TcTvBndr name tyvar <- b\n       = do { let (env', occ') = tidyOccName env (nameOccName name)\n                  name'  = tidyNameOcc name occ'\n                  tyvar1 = setTyVarName tyvar name'\n            ; tyvar2 <- zonkTcTyVarToTyVar tyvar1\n              -- Be sure to zonk here!  Tidying applies to zonked\n              -- types, so if we don't zonk we may create an\n              -- ill-kinded type (Trac #14175)\n            ; go (env', extendVarEnv subst tyvar tyvar2) bs }\n      | otherwise\n      = go (env, subst) bs\n\n-- | Get a 'TidyEnv' that includes mappings for all vars free in the given\n-- type. Useful when tidying open types.\ntcInitOpenTidyEnv :: [TyCoVar] -> TcM TidyEnv\ntcInitOpenTidyEnv tvs\n  = do { env1 <- tcInitTidyEnv\n       ; let env2 = tidyFreeTyCoVars env1 tvs\n       ; return env2 }\n\n\n\n{- *********************************************************************\n*                                                                      *\n             Adding placeholders\n*                                                                      *\n********************************************************************* -}\n\ntcAddDataFamConPlaceholders :: [LInstDecl GhcRn] -> TcM a -> TcM a\n-- See Note [AFamDataCon: not promoting data family constructors]\ntcAddDataFamConPlaceholders inst_decls thing_inside\n  = tcExtendKindEnvList [ (con, APromotionErr FamDataConPE)\n                        | lid <- inst_decls, con <- get_cons lid ]\n      thing_inside\n      -- Note [AFamDataCon: not promoting data family constructors]\n  where\n    -- get_cons extracts the *constructor* bindings of the declaration\n    get_cons :: LInstDecl GhcRn -> [Name]\n    get_cons (L _ (TyFamInstD {}))                     = []\n    get_cons (L _ (DataFamInstD { dfid_inst = fid }))  = get_fi_cons fid\n    get_cons (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fids } }))\n      = concatMap (get_fi_cons . unLoc) fids\n    get_cons (L _ (ClsInstD _ (XClsInstDecl _))) = panic \"get_cons\"\n    get_cons (L _ (XInstDecl _)) = panic \"get_cons\"\n\n    get_fi_cons :: DataFamInstDecl GhcRn -> [Name]\n    get_fi_cons (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n                  FamEqn { feqn_rhs = HsDataDefn { dd_cons = cons } }}})\n      = map unLoc $ concatMap (getConNames . unLoc) cons\n    get_fi_cons (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n                  FamEqn { feqn_rhs = XHsDataDefn _ }}})\n      = panic \"get_fi_cons\"\n    get_fi_cons (DataFamInstDecl (HsIB _ (XFamEqn _))) = panic \"get_fi_cons\"\n    get_fi_cons (DataFamInstDecl (XHsImplicitBndrs _)) = panic \"get_fi_cons\"\n\n\ntcAddPatSynPlaceholders :: [PatSynBind GhcRn GhcRn] -> TcM a -> TcM a\n-- See Note [Don't promote pattern synonyms]\ntcAddPatSynPlaceholders pat_syns thing_inside\n  = tcExtendKindEnvList [ (name, APromotionErr PatSynPE)\n                        | PSB{ psb_id = L _ name } <- pat_syns ]\n       thing_inside\n\ngetTypeSigNames :: [LSig GhcRn] -> NameSet\n-- Get the names that have a user type sig\ngetTypeSigNames sigs\n  = foldr get_type_sig emptyNameSet sigs\n  where\n    get_type_sig :: LSig GhcRn -> NameSet -> NameSet\n    get_type_sig sig ns =\n      case sig of\n        L _ (TypeSig _ names _) -> extendNameSetList ns (map unLoc names)\n        L _ (PatSynSig _ names _) -> extendNameSetList ns (map unLoc names)\n        _ -> ns\n\n\n{- Note [AFamDataCon: not promoting data family constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data family T a\n  data instance T Int = MkT\n  data Proxy (a :: k)\n  data S = MkS (Proxy 'MkT)\n\nIs it ok to use the promoted data family instance constructor 'MkT' in\nthe data declaration for S (where both declarations live in the same module)?\nNo, we don't allow this. It *might* make sense, but at least it would mean that\nwe'd have to interleave typechecking instances and data types, whereas at\npresent we do data types *then* instances.\n\nSo to check for this we put in the TcLclEnv a binding for all the family\nconstructors, bound to AFamDataCon, so that if we trip over 'MkT' when\ntype checking 'S' we'll produce a decent error message.\n\nTrac #12088 describes this limitation. Of course, when MkT and S live in\ndifferent modules then all is well.\n\nNote [Don't promote pattern synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe never promote pattern synonyms.\n\nConsider this (Trac #11265):\n  pattern A = True\n  instance Eq A\nWe want a civilised error message from the occurrence of 'A'\nin the instance, yet 'A' really has not yet been type checked.\n\nSimilarly (Trac #9161)\n  {-# LANGUAGE PatternSynonyms, DataKinds #-}\n  pattern A = ()\n  b :: A\n  b = undefined\nHere, the type signature for b mentions A.  But A is a pattern\nsynonym, which is typechecked as part of a group of bindings (for very\ngood reasons; a view pattern in the RHS may mention a value binding).\nIt is entirely reasonable to reject this, but to do so we need A to be\nin the kind environment when kind-checking the signature for B.\n\nHence tcAddPatSynPlaceholers adds a binding\n    A -> APromotionErr PatSynPE\nto the environment. Then TcHsType.tcTyVar will find A in the kind\nenvironment, and will give a 'wrongThingErr' as a result.  But the\nlookup of A won't fail.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Rules}\n*                                                                      *\n************************************************************************\n-}\n\ntcExtendRules :: [LRuleDecl GhcTc] -> TcM a -> TcM a\n        -- Just pop the new rules into the EPS and envt resp\n        -- All the rules come from an interface file, not source\n        -- Nevertheless, some may be for this module, if we read\n        -- its interface instead of its source code\ntcExtendRules lcl_rules thing_inside\n = do { env <- getGblEnv\n      ; let\n          env' = env { tcg_rules = lcl_rules ++ tcg_rules env }\n      ; setGblEnv env' thing_inside }\n\n{-\n************************************************************************\n*                                                                      *\n                Meta level\n*                                                                      *\n************************************************************************\n-}\n\ncheckWellStaged :: SDoc         -- What the stage check is for\n                -> ThLevel      -- Binding level (increases inside brackets)\n                -> ThLevel      -- Use stage\n                -> TcM ()       -- Fail if badly staged, adding an error\ncheckWellStaged pp_thing bind_lvl use_lvl\n  | use_lvl >= bind_lvl         -- OK! Used later than bound\n  = return ()                   -- E.g.  \\x -> [| $(f x) |]\n\n  | bind_lvl == outerLevel      -- GHC restriction on top level splices\n  = stageRestrictionError pp_thing\n\n  | otherwise                   -- Badly staged\n  = failWithTc $                -- E.g.  \\x -> $(f x)\n    text \"Stage error:\" <+> pp_thing <+>\n        hsep   [text \"is bound at stage\" <+> ppr bind_lvl,\n                text \"but used at stage\" <+> ppr use_lvl]\n\nstageRestrictionError :: SDoc -> TcM a\nstageRestrictionError pp_thing\n  = failWithTc $\n    sep [ text \"GHC stage restriction:\"\n        , nest 2 (vcat [ pp_thing <+> text \"is used in a top-level splice, quasi-quote, or annotation,\"\n                       , text \"and must be imported, not defined locally\"])]\n\ntopIdLvl :: Id -> ThLevel\n-- Globals may either be imported, or may be from an earlier \"chunk\"\n-- (separated by declaration splices) of this module.  The former\n--  *can* be used inside a top-level splice, but the latter cannot.\n-- Hence we give the former impLevel, but the latter topLevel\n-- E.g. this is bad:\n--      x = [| foo |]\n--      $( f x )\n-- By the time we are prcessing the $(f x), the binding for \"x\"\n-- will be in the global env, not the local one.\ntopIdLvl id | isLocalId id = outerLevel\n            | otherwise    = impLevel\n\ntcMetaTy :: Name -> TcM Type\n-- Given the name of a Template Haskell data type,\n-- return the type\n-- E.g. given the name \"Expr\" return the type \"Expr\"\ntcMetaTy tc_name = do\n    t <- tcLookupTyCon tc_name\n    return (mkTyConApp t [])\n\nisBrackStage :: ThStage -> Bool\nisBrackStage (Brack {}) = True\nisBrackStage _other     = False\n\n{-\n************************************************************************\n*                                                                      *\n                 getDefaultTys\n*                                                                      *\n************************************************************************\n-}\n\ntcGetDefaultTys :: TcM ([Type], -- Default types\n                        (Bool,  -- True <=> Use overloaded strings\n                         Bool)) -- True <=> Use extended defaulting rules\ntcGetDefaultTys\n  = do  { dflags <- getDynFlags\n        ; let ovl_strings = xopt LangExt.OverloadedStrings dflags\n              extended_defaults = xopt LangExt.ExtendedDefaultRules dflags\n                                        -- See also Trac #1974\n              flags = (ovl_strings, extended_defaults)\n\n        ; mb_defaults <- getDeclaredDefaultTys\n        ; case mb_defaults of {\n           Just tys -> return (tys, flags) ;\n                                -- User-supplied defaults\n           Nothing  -> do\n\n        -- No use-supplied default\n        -- Use [Integer, Double], plus modifications\n        { integer_ty <- tcMetaTy integerTyConName\n        ; list_ty <- tcMetaTy listTyConName\n        ; checkWiredInTyCon doubleTyCon\n        ; let deflt_tys = opt_deflt extended_defaults [unitTy, list_ty]\n                          -- Note [Extended defaults]\n                          ++ [integer_ty, doubleTy]\n                          ++ opt_deflt ovl_strings [stringTy]\n        ; return (deflt_tys, flags) } } }\n  where\n    opt_deflt True  xs = xs\n    opt_deflt False _  = []\n\n{-\nNote [Extended defaults]\n~~~~~~~~~~~~~~~~~~~~~\nIn interative mode (or with -XExtendedDefaultRules) we add () as the first type we\ntry when defaulting.  This has very little real impact, except in the following case.\nConsider:\n        Text.Printf.printf \"hello\"\nThis has type (forall a. IO a); it prints \"hello\", and returns 'undefined'.  We don't\nwant the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to\ndefault the 'a' to (), rather than to Integer (which is what would otherwise happen;\nand then GHCi doesn't attempt to print the ().  So in interactive mode, we add\n() to the list of defaulting types.  See Trac #1200.\n\nAdditionally, the list type [] is added as a default specialization for\nTraversable and Foldable. As such the default default list now has types of\nvarying kinds, e.g. ([] :: * -> *)  and (Integer :: *).\n\n************************************************************************\n*                                                                      *\n\\subsection{The InstInfo type}\n*                                                                      *\n************************************************************************\n\nThe InstInfo type summarises the information in an instance declaration\n\n    instance c => k (t tvs) where b\n\nIt is used just for *local* instance decls (not ones from interface files).\nBut local instance decls includes\n        - derived ones\n        - generic ones\nas well as explicit user written ones.\n-}\n\ndata InstInfo a\n  = InstInfo\n      { iSpec   :: ClsInst          -- Includes the dfun id\n      , iBinds  :: InstBindings a\n      }\n\niDFunId :: InstInfo a -> DFunId\niDFunId info = instanceDFunId (iSpec info)\n\ndata InstBindings a\n  = InstBindings\n      { ib_tyvars  :: [Name]   -- Names of the tyvars from the instance head\n                               -- that are lexically in scope in the bindings\n                               -- Must correspond 1-1 with the forall'd tyvars\n                               -- of the dfun Id.  When typechecking, we are\n                               -- going to extend the typechecker's envt with\n                               --     ib_tyvars -> dfun_forall_tyvars\n\n      , ib_binds   :: LHsBinds a    -- Bindings for the instance methods\n\n      , ib_pragmas :: [LSig a]      -- User pragmas recorded for generating\n                                    -- specialised instances\n\n      , ib_extensions :: [LangExt.Extension] -- Any extra extensions that should\n                                             -- be enabled when type-checking\n                                             -- this instance; needed for\n                                             -- GeneralizedNewtypeDeriving\n\n      , ib_derived :: Bool\n           -- True <=> This code was generated by GHC from a deriving clause\n           --          or standalone deriving declaration\n           --          Used only to improve error messages\n      }\n\ninstance (OutputableBndrId (GhcPass a))\n       => Outputable (InstInfo (GhcPass a)) where\n    ppr = pprInstInfoDetails\n\npprInstInfoDetails :: (OutputableBndrId (GhcPass a))\n                   => InstInfo (GhcPass a) -> SDoc\npprInstInfoDetails info\n   = hang (pprInstanceHdr (iSpec info) <+> text \"where\")\n        2 (details (iBinds info))\n  where\n    details (InstBindings { ib_binds = b }) = pprLHsBinds b\n\nsimpleInstInfoClsTy :: InstInfo a -> (Class, Type)\nsimpleInstInfoClsTy info = case instanceHead (iSpec info) of\n                           (_, cls, [ty]) -> (cls, ty)\n                           _ -> panic \"simpleInstInfoClsTy\"\n\nsimpleInstInfoTy :: InstInfo a -> Type\nsimpleInstInfoTy info = snd (simpleInstInfoClsTy info)\n\nsimpleInstInfoTyCon :: InstInfo a -> TyCon\n  -- Gets the type constructor for a simple instance declaration,\n  -- i.e. one of the form       instance (...) => C (T a b c) where ...\nsimpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)\n\n-- | Make a name for the dict fun for an instance decl.  It's an *external*\n-- name, like other top-level names, and hence must be made with\n-- newGlobalBinder.\nnewDFunName :: Class -> [Type] -> SrcSpan -> TcM Name\nnewDFunName clas tys loc\n  = do  { is_boot <- tcIsHsBootOrSig\n        ; mod     <- getModule\n        ; let info_string = occNameString (getOccName clas) ++\n                            concatMap (occNameString.getDFunTyKey) tys\n        ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)\n        ; newGlobalBinder mod dfun_occ loc }\n\n-- | Special case of 'newDFunName' to generate dict fun name for a single TyCon.\nnewDFunName' :: Class -> TyCon -> TcM Name\nnewDFunName' clas tycon        -- Just a simple wrapper\n  = do { loc <- getSrcSpanM     -- The location of the instance decl,\n                                -- not of the tycon\n       ; newDFunName clas [mkTyConApp tycon []] loc }\n       -- The type passed to newDFunName is only used to generate\n       -- a suitable string; hence the empty type arg list\n\n{-\nMake a name for the representation tycon of a family instance.  It's an\n*external* name, like other top-level names, and hence must be made with\nnewGlobalBinder.\n-}\n\nnewFamInstTyConName :: Located Name -> [Type] -> TcM Name\nnewFamInstTyConName (L loc name) tys = mk_fam_inst_name id loc name [tys]\n\nnewFamInstAxiomName :: Located Name -> [[Type]] -> TcM Name\nnewFamInstAxiomName (L loc name) branches\n  = mk_fam_inst_name mkInstTyCoOcc loc name branches\n\nmk_fam_inst_name :: (OccName -> OccName) -> SrcSpan -> Name -> [[Type]] -> TcM Name\nmk_fam_inst_name adaptOcc loc tc_name tyss\n  = do  { mod   <- getModule\n        ; let info_string = occNameString (getOccName tc_name) ++\n                            intercalate \"|\" ty_strings\n        ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)\n        ; newGlobalBinder mod (adaptOcc occ) loc }\n  where\n    ty_strings = map (concatMap (occNameString . getDFunTyKey)) tyss\n\n{-\nStable names used for foreign exports and annotations.\nFor stable names, the name must be unique (see #1533).  If the\nsame thing has several stable Ids based on it, the\ntop-level bindings generated must not have the same name.\nHence we create an External name (doesn't change), and we\nappend a Unique to the string right here.\n-}\n\nmkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId\nmkStableIdFromString str sig_ty loc occ_wrapper = do\n    uniq <- newUnique\n    mod <- getModule\n    name <- mkWrapperName \"stable\" str\n    let occ = mkVarOccFS name :: OccName\n        gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name\n        id  = mkExportedVanillaId gnm sig_ty :: Id\n    return id\n\nmkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId\nmkStableIdFromName nm = mkStableIdFromString (getOccString nm)\n\nmkWrapperName :: (MonadIO m, HasDynFlags m, HasModule m)\n              => String -> String -> m FastString\nmkWrapperName what nameBase\n    = do dflags <- getDynFlags\n         thisMod <- getModule\n         let -- Note [Generating fresh names for ccall wrapper]\n             wrapperRef = nextWrapperNum dflags\n             pkg = unitIdString  (moduleUnitId thisMod)\n             mod = moduleNameString (moduleName      thisMod)\n         wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \\mod_env ->\n             let num = lookupWithDefaultModuleEnv mod_env 0 thisMod\n                 mod_env' = extendModuleEnv mod_env thisMod (num+1)\n             in (mod_env', num)\n         let components = [what, show wrapperNum, pkg, mod, nameBase]\n         return $ mkFastString $ zEncodeString $ intercalate \":\" components\n\n{-\nNote [Generating fresh names for FFI wrappers]\n\nWe used to use a unique, rather than nextWrapperNum, to distinguish\nbetween FFI wrapper functions. However, the wrapper names that we\ngenerate are external names. This means that if a call to them ends up\nin an unfolding, then we can't alpha-rename them, and thus if the\nunique randomly changes from one compile to another then we get a\nspurious ABI change (#4012).\n\nThe wrapper counter has to be per-module, not global, so that the number we end\nup using is not dependent on the modules compiled before the current one.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Errors}\n*                                                                      *\n************************************************************************\n-}\n\npprBinders :: [Name] -> SDoc\n-- Used in error messages\n-- Use quotes for a single one; they look a bit \"busy\" for several\npprBinders [bndr] = quotes (ppr bndr)\npprBinders bndrs  = pprWithCommas ppr bndrs\n\nnotFound :: Name -> TcM TyThing\nnotFound name\n  = do { lcl_env <- getLclEnv\n       ; let stage = tcl_th_ctxt lcl_env\n       ; case stage of   -- See Note [Out of scope might be a staging error]\n           Splice {}\n             | isUnboundName name -> failM  -- If the name really isn't in scope\n                                            -- don't report it again (Trac #11941)\n             | otherwise -> stageRestrictionError (quotes (ppr name))\n           _ -> failWithTc $\n                vcat[text \"GHC internal error:\" <+> quotes (ppr name) <+>\n                     text \"is not in scope during type checking, but it passed the renamer\",\n                     text \"tcl_env of environment:\" <+> ppr (tcl_env lcl_env)]\n                       -- Take care: printing the whole gbl env can\n                       -- cause an infinite loop, in the case where we\n                       -- are in the middle of a recursive TyCon/Class group;\n                       -- so let's just not print it!  Getting a loop here is\n                       -- very unhelpful, because it hides one compiler bug with another\n       }\n\nwrongThingErr :: String -> TcTyThing -> Name -> TcM a\n-- It's important that this only calls pprTcTyThingCategory, which in\n-- turn does not look at the details of the TcTyThing.\n-- See Note [Placeholder PatSyn kinds] in TcBinds\nwrongThingErr expected thing name\n  = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>\n                text \"used as a\" <+> text expected)\n\n{- Note [Out of scope might be a staging error]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  x = 3\n  data T = MkT $(foo x)\n\nwhere 'foo' is imported from somewhere.\n\nThis is really a staging error, because we can't run code involving 'x'.\nBut in fact the type checker processes types first, so 'x' won't even be\nin the type envt when we look for it in $(foo x).  So inside splices we\nreport something missing from the type env as a staging error.\nSee Trac #5752 and #5795.\n-}\n", "num_lines": 1150}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcErrors(\n       reportUnsolved, reportAllUnsolved, warnAllUnsolved,\n       warnDefaulting,\n\n       solverDepthErrorTcS\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnTypes\nimport TcRnMonad\nimport TcMType\nimport TcUnify( occCheckForErrors, OccCheckResult(..) )\nimport TcEnv( tcInitTidyEnv )\nimport TcType\nimport RnUnbound ( unknownNameSuggestions )\nimport Type\nimport TyCoRep\nimport Unify            ( tcMatchTys )\nimport Module\nimport FamInst\nimport FamInstEnv       ( flattenTys )\nimport Inst\nimport InstEnv\nimport TyCon\nimport Class\nimport DataCon\nimport TcEvidence\nimport TcEvTerm\nimport HsExpr  ( UnboundVar(..) )\nimport HsBinds ( PatSynBind(..) )\nimport Name\nimport RdrName ( lookupGlobalRdrEnv, lookupGRE_Name, GlobalRdrEnv\n               , mkRdrUnqual, isLocalGRE, greSrcSpan )\nimport PrelNames ( typeableClassName )\nimport Id\nimport Var\nimport VarSet\nimport VarEnv\nimport NameSet\nimport Bag\nimport ErrUtils         ( ErrMsg, errDoc, pprLocErrMsg )\nimport BasicTypes\nimport ConLike          ( ConLike(..))\nimport Util\nimport FastString\nimport Outputable\nimport SrcLoc\nimport DynFlags\nimport ListSetOps       ( equivClasses )\nimport Maybes\nimport Pair\nimport qualified GHC.LanguageExtensions as LangExt\nimport FV ( fvVarList, unionFV )\n\nimport Control.Monad    ( when )\nimport Data.Foldable    ( toList )\nimport Data.List        ( partition, mapAccumL, nub, sortBy, unfoldr )\nimport qualified Data.Set as Set\n\nimport {-# SOURCE #-} TcHoleErrors ( findValidHoleFits )\n\n-- import Data.Semigroup   ( Semigroup )\nimport qualified Data.Semigroup as Semigroup\n\n\n{-\n************************************************************************\n*                                                                      *\n\\section{Errors and contexts}\n*                                                                      *\n************************************************************************\n\nToDo: for these error messages, should we note the location as coming\nfrom the insts, or just whatever seems to be around in the monad just\nnow?\n\nNote [Deferring coercion errors to runtime]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhile developing, sometimes it is desirable to allow compilation to succeed even\nif there are type errors in the code. Consider the following case:\n\n  module Main where\n\n  a :: Int\n  a = 'a'\n\n  main = print \"b\"\n\nEven though `a` is ill-typed, it is not used in the end, so if all that we're\ninterested in is `main` it is handy to be able to ignore the problems in `a`.\n\nSince we treat type equalities as evidence, this is relatively simple. Whenever\nwe run into a type mismatch in TcUnify, we normally just emit an error. But it\nis always safe to defer the mismatch to the main constraint solver. If we do\nthat, `a` will get transformed into\n\n  co :: Int ~ Char\n  co = ...\n\n  a :: Int\n  a = 'a' `cast` co\n\nThe constraint solver would realize that `co` is an insoluble constraint, and\nemit an error with `reportUnsolved`. But we can also replace the right-hand side\nof `co` with `error \"Deferred type error: Int ~ Char\"`. This allows the program\nto compile, and it will run fine unless we evaluate `a`. This is what\n`deferErrorsToRuntime` does.\n\nIt does this by keeping track of which errors correspond to which coercion\nin TcErrors. TcErrors.reportTidyWanteds does not print the errors\nand does not fail if -fdefer-type-errors is on, so that we can continue\ncompilation. The errors are turned into warnings in `reportUnsolved`.\n-}\n\n-- | Report unsolved goals as errors or warnings. We may also turn some into\n-- deferred run-time errors if `-fdefer-type-errors` is on.\nreportUnsolved :: WantedConstraints -> TcM (Bag EvBind)\nreportUnsolved wanted\n  = do { binds_var <- newTcEvBinds\n       ; defer_errors <- goptM Opt_DeferTypeErrors\n       ; warn_errors <- woptM Opt_WarnDeferredTypeErrors -- implement #10283\n       ; let type_errors | not defer_errors = TypeError\n                         | warn_errors      = TypeWarn (Reason Opt_WarnDeferredTypeErrors)\n                         | otherwise        = TypeDefer\n\n       ; defer_holes <- goptM Opt_DeferTypedHoles\n       ; warn_holes  <- woptM Opt_WarnTypedHoles\n       ; let expr_holes | not defer_holes = HoleError\n                        | warn_holes      = HoleWarn\n                        | otherwise       = HoleDefer\n\n       ; partial_sigs      <- xoptM LangExt.PartialTypeSignatures\n       ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures\n       ; let type_holes | not partial_sigs  = HoleError\n                        | warn_partial_sigs = HoleWarn\n                        | otherwise         = HoleDefer\n\n       ; defer_out_of_scope <- goptM Opt_DeferOutOfScopeVariables\n       ; warn_out_of_scope <- woptM Opt_WarnDeferredOutOfScopeVariables\n       ; let out_of_scope_holes | not defer_out_of_scope = HoleError\n                                | warn_out_of_scope      = HoleWarn\n                                | otherwise              = HoleDefer\n\n       ; report_unsolved type_errors expr_holes\n                         type_holes out_of_scope_holes\n                         binds_var wanted\n\n       ; ev_binds <- getTcEvBindsMap binds_var\n       ; return (evBindMapBinds ev_binds)}\n\n-- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on\n-- However, do not make any evidence bindings, because we don't\n-- have any convenient place to put them.\n-- See Note [Deferring coercion errors to runtime]\n-- Used by solveEqualities for kind equalities\n--      (see Note [Fail fast on kind errors] in TcSimplify]\n-- and for simplifyDefault.\nreportAllUnsolved :: WantedConstraints -> TcM ()\nreportAllUnsolved wanted\n  = do { ev_binds <- newNoTcEvBinds\n       ; report_unsolved TypeError HoleError HoleError HoleError\n                         ev_binds wanted }\n\n-- | Report all unsolved goals as warnings (but without deferring any errors to\n-- run-time). See Note [Safe Haskell Overlapping Instances Implementation] in\n-- TcSimplify\nwarnAllUnsolved :: WantedConstraints -> TcM ()\nwarnAllUnsolved wanted\n  = do { ev_binds <- newTcEvBinds\n       ; report_unsolved (TypeWarn NoReason) HoleWarn HoleWarn HoleWarn\n                         ev_binds wanted }\n\n-- | Report unsolved goals as errors or warnings.\nreport_unsolved :: TypeErrorChoice   -- Deferred type errors\n                -> HoleChoice        -- Expression holes\n                -> HoleChoice        -- Type holes\n                -> HoleChoice        -- Out of scope holes\n                -> EvBindsVar        -- cec_binds\n                -> WantedConstraints -> TcM ()\nreport_unsolved type_errors expr_holes\n    type_holes out_of_scope_holes binds_var wanted\n  | isEmptyWC wanted\n  = return ()\n  | otherwise\n  = do { traceTc \"reportUnsolved {\" $\n         vcat [ text \"type errors:\" <+> ppr type_errors\n              , text \"expr holes:\" <+> ppr expr_holes\n              , text \"type holes:\" <+> ppr type_holes\n              , text \"scope holes:\" <+> ppr out_of_scope_holes ]\n       ; traceTc \"reportUnsolved (before zonking and tidying)\" (ppr wanted)\n\n       ; wanted <- zonkWC wanted   -- Zonk to reveal all information\n       ; env0 <- tcInitTidyEnv\n            -- If we are deferring we are going to need /all/ evidence around,\n            -- including the evidence produced by unflattening (zonkWC)\n       ; let tidy_env = tidyFreeTyCoVars env0 free_tvs\n             free_tvs = tyCoVarsOfWCList wanted\n\n       ; traceTc \"reportUnsolved (after zonking):\" $\n         vcat [ text \"Free tyvars:\" <+> pprTyVars free_tvs\n              , text \"Tidy env:\" <+> ppr tidy_env\n              , text \"Wanted:\" <+> ppr wanted ]\n\n       ; warn_redundant <- woptM Opt_WarnRedundantConstraints\n       ; let err_ctxt = CEC { cec_encl  = []\n                            , cec_tidy  = tidy_env\n                            , cec_defer_type_errors = type_errors\n                            , cec_expr_holes = expr_holes\n                            , cec_type_holes = type_holes\n                            , cec_out_of_scope_holes = out_of_scope_holes\n                            , cec_suppress = insolubleWC wanted\n                                 -- See Note [Suppressing error messages]\n                                 -- Suppress low-priority errors if there\n                                 -- are insolule errors anywhere;\n                                 -- See Trac #15539 and c.f. setting ic_status\n                                 -- in TcSimplify.setImplicationStatus\n                            , cec_warn_redundant = warn_redundant\n                            , cec_binds    = binds_var }\n\n       ; tc_lvl <- getTcLevel\n       ; reportWanteds err_ctxt tc_lvl wanted\n       ; traceTc \"reportUnsolved }\" empty }\n\n--------------------------------------------\n--      Internal functions\n--------------------------------------------\n\n-- | An error Report collects messages categorised by their importance.\n-- See Note [Error report] for details.\ndata Report\n  = Report { report_important :: [SDoc]\n           , report_relevant_bindings :: [SDoc]\n           , report_valid_hole_fits :: [SDoc]\n           }\n\ninstance Outputable Report where   -- Debugging only\n  ppr (Report { report_important = imp\n              , report_relevant_bindings = rel\n              , report_valid_hole_fits = val })\n    = vcat [ text \"important:\" <+> vcat imp\n           , text \"relevant:\"  <+> vcat rel\n           , text \"valid:\"  <+> vcat val ]\n\n{- Note [Error report]\nThe idea is that error msgs are divided into three parts: the main msg, the\ncontext block (\\\"In the second argument of ...\\\"), and the relevant bindings\nblock, which are displayed in that order, with a mark to divide them.  The\nidea is that the main msg ('report_important') varies depending on the error\nin question, but context and relevant bindings are always the same, which\nshould simplify visual parsing.\n\nThe context is added when the Report is passed off to 'mkErrorReport'.\nUnfortunately, unlike the context, the relevant bindings are added in\nmultiple places so they have to be in the Report.\n-}\n\ninstance Semigroup Report where\n    Report a1 b1 c1 <> Report a2 b2 c2 = Report (a1 ++ a2) (b1 ++ b2) (c1 ++ c2)\n\ninstance Monoid Report where\n    mempty = Report [] [] []\n    mappend = (Semigroup.<>)\n\n-- | Put a doc into the important msgs block.\nimportant :: SDoc -> Report\nimportant doc = mempty { report_important = [doc] }\n\n-- | Put a doc into the relevant bindings block.\nrelevant_bindings :: SDoc -> Report\nrelevant_bindings doc = mempty { report_relevant_bindings = [doc] }\n\n-- | Put a doc into the valid hole fits block.\nvalid_hole_fits :: SDoc -> Report\nvalid_hole_fits docs = mempty { report_valid_hole_fits = [docs] }\n\ndata TypeErrorChoice   -- What to do for type errors found by the type checker\n  = TypeError     -- A type error aborts compilation with an error message\n  | TypeWarn WarnReason\n                  -- A type error is deferred to runtime, plus a compile-time warning\n                  -- The WarnReason should usually be (Reason Opt_WarnDeferredTypeErrors)\n                  -- but it isn't for the Safe Haskell Overlapping Instances warnings\n                  -- see warnAllUnsolved\n  | TypeDefer     -- A type error is deferred to runtime; no error or warning at compile time\n\ndata HoleChoice\n  = HoleError     -- A hole is a compile-time error\n  | HoleWarn      -- Defer to runtime, emit a compile-time warning\n  | HoleDefer     -- Defer to runtime, no warning\n\ninstance Outputable HoleChoice where\n  ppr HoleError = text \"HoleError\"\n  ppr HoleWarn  = text \"HoleWarn\"\n  ppr HoleDefer = text \"HoleDefer\"\n\ninstance Outputable TypeErrorChoice  where\n  ppr TypeError         = text \"TypeError\"\n  ppr (TypeWarn reason) = text \"TypeWarn\" <+> ppr reason\n  ppr TypeDefer         = text \"TypeDefer\"\n\ndata ReportErrCtxt\n    = CEC { cec_encl :: [Implication]  -- Enclosing implications\n                                       --   (innermost first)\n                                       -- ic_skols and givens are tidied, rest are not\n          , cec_tidy  :: TidyEnv\n\n          , cec_binds :: EvBindsVar    -- Make some errors (depending on cec_defer)\n                                       -- into warnings, and emit evidence bindings\n                                       -- into 'cec_binds' for unsolved constraints\n\n          , cec_defer_type_errors :: TypeErrorChoice -- Defer type errors until runtime\n\n          -- cec_expr_holes is a union of:\n          --   cec_type_holes - a set of typed holes: '_', '_a', '_foo'\n          --   cec_out_of_scope_holes - a set of variables which are\n          --                            out of scope: 'x', 'y', 'bar'\n          , cec_expr_holes :: HoleChoice           -- Holes in expressions\n          , cec_type_holes :: HoleChoice           -- Holes in types\n          , cec_out_of_scope_holes :: HoleChoice   -- Out of scope holes\n\n          , cec_warn_redundant :: Bool    -- True <=> -Wredundant-constraints\n\n          , cec_suppress :: Bool    -- True <=> More important errors have occurred,\n                                    --          so create bindings if need be, but\n                                    --          don't issue any more errors/warnings\n                                    -- See Note [Suppressing error messages]\n      }\n\ninstance Outputable ReportErrCtxt where\n  ppr (CEC { cec_binds              = bvar\n           , cec_defer_type_errors  = dte\n           , cec_expr_holes         = eh\n           , cec_type_holes         = th\n           , cec_out_of_scope_holes = osh\n           , cec_warn_redundant     = wr\n           , cec_suppress           = sup })\n    = text \"CEC\" <+> braces (vcat\n         [ text \"cec_binds\"              <+> equals <+> ppr bvar\n         , text \"cec_defer_type_errors\"  <+> equals <+> ppr dte\n         , text \"cec_expr_holes\"         <+> equals <+> ppr eh\n         , text \"cec_type_holes\"         <+> equals <+> ppr th\n         , text \"cec_out_of_scope_holes\" <+> equals <+> ppr osh\n         , text \"cec_warn_redundant\"     <+> equals <+> ppr wr\n         , text \"cec_suppress\"           <+> equals <+> ppr sup ])\n\n-- | Returns True <=> the ReportErrCtxt indicates that something is deferred\ndeferringAnyBindings :: ReportErrCtxt -> Bool\n  -- Don't check cec_type_holes, as these don't cause bindings to be deferred\ndeferringAnyBindings (CEC { cec_defer_type_errors  = TypeError\n                          , cec_expr_holes         = HoleError\n                          , cec_out_of_scope_holes = HoleError }) = False\ndeferringAnyBindings _                                            = True\n\n-- | Transforms a 'ReportErrCtxt' into one that does not defer any bindings\n-- at all.\nnoDeferredBindings :: ReportErrCtxt -> ReportErrCtxt\nnoDeferredBindings ctxt = ctxt { cec_defer_type_errors  = TypeError\n                               , cec_expr_holes         = HoleError\n                               , cec_out_of_scope_holes = HoleError }\n\n{- Note [Suppressing error messages]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe cec_suppress flag says \"don't report any errors\".  Instead, just create\nevidence bindings (as usual).  It's used when more important errors have occurred.\n\nSpecifically (see reportWanteds)\n  * If there are insoluble Givens, then we are in unreachable code and all bets\n    are off.  So don't report any further errors.\n  * If there are any insolubles (eg Int~Bool), here or in a nested implication,\n    then suppress errors from the simple constraints here.  Sometimes the\n    simple-constraint errors are a knock-on effect of the insolubles.\n\nThis suppression behaviour is controlled by the Bool flag in\nReportErrorSpec, as used in reportWanteds.\n\nBut we need to take care: flags can turn errors into warnings, and we\ndon't want those warnings to suppress subsequent errors (including\nsuppressing the essential addTcEvBind for them: Trac #15152). So in\ntryReporter we use askNoErrs to see if any error messages were\n/actually/ produced; if not, we don't switch on suppression.\n\nA consequence is that warnings never suppress warnings, so turning an\nerror into a warning may allow subsequent warnings to appear that were\npreviously suppressed.   (e.g. partial-sigs/should_fail/T14584)\n-}\n\nreportImplic :: ReportErrCtxt -> Implication -> TcM ()\nreportImplic ctxt implic@(Implic { ic_skols = tvs, ic_telescope = m_telescope\n                                 , ic_given = given\n                                 , ic_wanted = wanted, ic_binds = evb\n                                 , ic_status = status, ic_info = info\n                                 , ic_tclvl = tc_lvl })\n  | BracketSkol <- info\n  , not insoluble\n  = return ()        -- For Template Haskell brackets report only\n                     -- definite errors. The whole thing will be re-checked\n                     -- later when we plug it in, and meanwhile there may\n                     -- certainly be un-satisfied constraints\n\n  | otherwise\n  = do { traceTc \"reportImplic\" (ppr implic')\n       ; reportWanteds ctxt' tc_lvl wanted\n       ; when (cec_warn_redundant ctxt) $\n         warnRedundantConstraints ctxt' tcl_env info' dead_givens\n       ; when bad_telescope $ reportBadTelescope ctxt tcl_env m_telescope tvs }\n  where\n    tcl_env      = implicLclEnv implic\n    insoluble    = isInsolubleStatus status\n    (env1, tvs') = mapAccumL tidyVarBndr (cec_tidy ctxt) tvs\n    info'        = tidySkolemInfo env1 info\n    implic' = implic { ic_skols = tvs'\n                     , ic_given = map (tidyEvVar env1) given\n                     , ic_info  = info' }\n    ctxt1 | CoEvBindsVar{} <- evb    = noDeferredBindings ctxt\n          | otherwise                = ctxt\n          -- If we go inside an implication that has no term\n          -- evidence (e.g. unifying under a forall), we can't defer\n          -- type errors.  You could imagine using the /enclosing/\n          -- bindings (in cec_binds), but that may not have enough stuff\n          -- in scope for the bindings to be well typed.  So we just\n          -- switch off deferred type errors altogether.  See Trac #14605.\n\n    ctxt' = ctxt1 { cec_tidy     = env1\n                  , cec_encl     = implic' : cec_encl ctxt\n\n                  , cec_suppress = insoluble || cec_suppress ctxt\n                        -- Suppress inessential errors if there\n                        -- are insolubles anywhere in the\n                        -- tree rooted here, or we've come across\n                        -- a suppress-worthy constraint higher up (Trac #11541)\n\n                  , cec_binds    = evb }\n\n    dead_givens = case status of\n                    IC_Solved { ics_dead = dead } -> dead\n                    _                             -> []\n\n    bad_telescope = case status of\n              IC_BadTelescope -> True\n              _               -> False\n\nwarnRedundantConstraints :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [EvVar] -> TcM ()\n-- See Note [Tracking redundant constraints] in TcSimplify\nwarnRedundantConstraints ctxt env info ev_vars\n | null redundant_evs\n = return ()\n\n | SigSkol {} <- info\n = setLclEnv env $  -- We want to add \"In the type signature for f\"\n                    -- to the error context, which is a bit tiresome\n   addErrCtxt (text \"In\" <+> ppr info) $\n   do { env <- getLclEnv\n      ; msg <- mkErrorReport ctxt env (important doc)\n      ; reportWarning (Reason Opt_WarnRedundantConstraints) msg }\n\n | otherwise  -- But for InstSkol there already *is* a surrounding\n              -- \"In the instance declaration for Eq [a]\" context\n              -- and we don't want to say it twice. Seems a bit ad-hoc\n = do { msg <- mkErrorReport ctxt env (important doc)\n      ; reportWarning (Reason Opt_WarnRedundantConstraints) msg }\n where\n   doc = text \"Redundant constraint\" <> plural redundant_evs <> colon\n         <+> pprEvVarTheta redundant_evs\n\n   redundant_evs =\n       filterOut is_type_error $\n       case info of -- See Note [Redundant constraints in instance decls]\n         InstSkol -> filterOut (improving . idType) ev_vars\n         _        -> ev_vars\n\n   -- See #15232\n   is_type_error = isJust . userTypeError_maybe . idType\n\n   improving pred -- (transSuperClasses p) does not include p\n     = any isImprovementPred (pred : transSuperClasses pred)\n\nreportBadTelescope :: ReportErrCtxt -> TcLclEnv -> Maybe SDoc -> [TcTyVar] -> TcM ()\nreportBadTelescope ctxt env (Just telescope) skols\n  = do { msg <- mkErrorReport ctxt env (important doc)\n       ; reportError msg }\n  where\n    doc = hang (text \"These kind and type variables:\" <+> telescope $$\n                text \"are out of dependency order. Perhaps try this ordering:\")\n             2 (pprTyVars sorted_tvs)\n\n    sorted_tvs = scopedSort skols\n\nreportBadTelescope _ _ Nothing skols\n  = pprPanic \"reportBadTelescope\" (ppr skols)\n\n{- Note [Redundant constraints in instance decls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor instance declarations, we don't report unused givens if\nthey can give rise to improvement.  Example (Trac #10100):\n    class Add a b ab | a b -> ab, a ab -> b\n    instance Add Zero b b\n    instance Add a b ab => Add (Succ a) b (Succ ab)\nThe context (Add a b ab) for the instance is clearly unused in terms\nof evidence, since the dictionary has no fields.  But it is still\nneeded!  With the context, a wanted constraint\n   Add (Succ Zero) beta (Succ Zero)\nwe will reduce to (Add Zero beta Zero), and thence we get beta := Zero.\nBut without the context we won't find beta := Zero.\n\nThis only matters in instance declarations..\n-}\n\nreportWanteds :: ReportErrCtxt -> TcLevel -> WantedConstraints -> TcM ()\nreportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics })\n  = do { traceTc \"reportWanteds\" (vcat [ text \"Simples =\" <+> ppr simples\n                                       , text \"Suppress =\" <+> ppr (cec_suppress ctxt)])\n       ; traceTc \"rw2\" (ppr tidy_cts)\n\n         -- First deal with things that are utterly wrong\n         -- Like Int ~ Bool (incl nullary TyCons)\n         -- or  Int ~ t a   (AppTy on one side)\n         -- These /ones/ are not suppressed by the incoming context\n       ; let ctxt_for_insols = ctxt { cec_suppress = False }\n       ; (ctxt1, cts1) <- tryReporters ctxt_for_insols report1 tidy_cts\n\n         -- Now all the other constraints.  We suppress errors here if\n         -- any of the first batch failed, or if the enclosing context\n         -- says to suppress\n       ; let ctxt2 = ctxt { cec_suppress = cec_suppress ctxt || cec_suppress ctxt1 }\n       ; (_, leftovers) <- tryReporters ctxt2 report2 cts1\n       ; MASSERT2( null leftovers, ppr leftovers )\n\n            -- All the Derived ones have been filtered out of simples\n            -- by the constraint solver. This is ok; we don't want\n            -- to report unsolved Derived goals as errors\n            -- See Note [Do not report derived but soluble errors]\n\n     ; mapBagM_ (reportImplic ctxt2) implics }\n            -- NB ctxt1: don't suppress inner insolubles if there's only a\n            -- wanted insoluble here; but do suppress inner insolubles\n            -- if there's a *given* insoluble here (= inaccessible code)\n where\n    env = cec_tidy ctxt\n    tidy_cts = bagToList (mapBag (tidyCt env) simples)\n\n    -- report1: ones that should *not* be suppresed by\n    --          an insoluble somewhere else in the tree\n    -- It's crucial that anything that is considered insoluble\n    -- (see TcRnTypes.insolubleCt) is caught here, otherwise\n    -- we might suppress its error message, and proceed on past\n    -- type checking to get a Lint error later\n    report1 = [ (\"Out of scope\", is_out_of_scope,    True,  mkHoleReporter tidy_cts)\n              , (\"Holes\",        is_hole,            False, mkHoleReporter tidy_cts)\n              , (\"custom_error\", is_user_type_error, True,  mkUserTypeErrorReporter)\n\n              , given_eq_spec\n              , (\"insoluble2\",   utterly_wrong,  True, mkGroupReporter mkEqErr)\n              , (\"skolem eq1\",   very_wrong,     True, mkSkolReporter)\n              , (\"skolem eq2\",   skolem_eq,      True, mkSkolReporter)\n              , (\"non-tv eq\",    non_tv_eq,      True, mkSkolReporter)\n\n                  -- The only remaining equalities are alpha ~ ty,\n                  -- where alpha is untouchable; and representational equalities\n                  -- Prefer homogeneous equalities over hetero, because the\n                  -- former might be holding up the latter.\n                  -- See Note [Equalities with incompatible kinds] in TcCanonical\n              , (\"Homo eqs\",      is_homo_equality, True,  mkGroupReporter mkEqErr)\n              , (\"Other eqs\",     is_equality,      False, mkGroupReporter mkEqErr) ]\n\n    -- report2: we suppress these if there are insolubles elsewhere in the tree\n    report2 = [ (\"Implicit params\", is_ip,           False, mkGroupReporter mkIPErr)\n              , (\"Irreds\",          is_irred,        False, mkGroupReporter mkIrredErr)\n              , (\"Dicts\",           is_dict,         False, mkGroupReporter mkDictErr) ]\n\n    -- rigid_nom_eq, rigid_nom_tv_eq,\n    is_hole, is_dict,\n      is_equality, is_ip, is_irred :: Ct -> PredTree -> Bool\n\n    is_given_eq ct pred\n       | EqPred {} <- pred = arisesFromGivens ct\n       | otherwise         = False\n       -- I think all given residuals are equalities\n\n    -- Things like (Int ~N Bool)\n    utterly_wrong _ (EqPred NomEq ty1 ty2) = isRigidTy ty1 && isRigidTy ty2\n    utterly_wrong _ _                      = False\n\n    -- Things like (a ~N Int)\n    very_wrong _ (EqPred NomEq ty1 ty2) = isSkolemTy tc_lvl ty1 && isRigidTy ty2\n    very_wrong _ _                      = False\n\n    -- Things like (a ~N b) or (a  ~N  F Bool)\n    skolem_eq _ (EqPred NomEq ty1 _) = isSkolemTy tc_lvl ty1\n    skolem_eq _ _                    = False\n\n    -- Things like (F a  ~N  Int)\n    non_tv_eq _ (EqPred NomEq ty1 _) = not (isTyVarTy ty1)\n    non_tv_eq _ _                    = False\n\n    is_out_of_scope ct _ = isOutOfScopeCt ct\n    is_hole         ct _ = isHoleCt ct\n\n    is_user_type_error ct _ = isUserTypeErrorCt ct\n\n    is_homo_equality _ (EqPred _ ty1 ty2) = tcTypeKind ty1 `tcEqType` tcTypeKind ty2\n    is_homo_equality _ _                  = False\n\n    is_equality _ (EqPred {}) = True\n    is_equality _ _           = False\n\n    is_dict _ (ClassPred {}) = True\n    is_dict _ _              = False\n\n    is_ip _ (ClassPred cls _) = isIPClass cls\n    is_ip _ _                 = False\n\n    is_irred _ (IrredPred {}) = True\n    is_irred _ _              = False\n\n    given_eq_spec  -- See Note [Given errors]\n      | has_gadt_match (cec_encl ctxt)\n      = (\"insoluble1a\", is_given_eq, True,  mkGivenErrorReporter)\n      | otherwise\n      = (\"insoluble1b\", is_given_eq, False, ignoreErrorReporter)\n          -- False means don't suppress subsequent errors\n          -- Reason: we don't report all given errors\n          --         (see mkGivenErrorReporter), and we should only suppress\n          --         subsequent errors if we actually report this one!\n          --         Trac #13446 is an example\n\n    -- See Note [Given errors]\n    has_gadt_match [] = False\n    has_gadt_match (implic : implics)\n      | PatSkol {} <- ic_info implic\n      , not (ic_no_eqs implic)\n      , wopt Opt_WarnInaccessibleCode (implicDynFlags implic)\n          -- Don't bother doing this if -Winaccessible-code isn't enabled.\n          -- See Note [Avoid -Winaccessible-code when deriving] in TcInstDcls.\n      = True\n      | otherwise\n      = has_gadt_match implics\n\n---------------\nisSkolemTy :: TcLevel -> Type -> Bool\n-- The type is a skolem tyvar\nisSkolemTy tc_lvl ty\n  | Just tv <- getTyVar_maybe ty\n  =  isSkolemTyVar tv\n  || (isTyVarTyVar tv && isTouchableMetaTyVar tc_lvl tv)\n     -- The last case is for touchable TyVarTvs\n     -- we postpone untouchables to a latter test (too obscure)\n\n  | otherwise\n  = False\n\nisTyFun_maybe :: Type -> Maybe TyCon\nisTyFun_maybe ty = case tcSplitTyConApp_maybe ty of\n                      Just (tc,_) | isTypeFamilyTyCon tc -> Just tc\n                      _ -> Nothing\n\n--------------------------------------------\n--      Reporters\n--------------------------------------------\n\ntype Reporter\n  = ReportErrCtxt -> [Ct] -> TcM ()\ntype ReporterSpec\n  = ( String                     -- Name\n    , Ct -> PredTree -> Bool     -- Pick these ones\n    , Bool                       -- True <=> suppress subsequent reporters\n    , Reporter)                  -- The reporter itself\n\nmkSkolReporter :: Reporter\n-- Suppress duplicates with either the same LHS, or same location\nmkSkolReporter ctxt cts\n  = mapM_ (reportGroup mkEqErr ctxt) (group cts)\n  where\n     group [] = []\n     group (ct:cts) = (ct : yeses) : group noes\n        where\n          (yeses, noes) = partition (group_with ct) cts\n\n     group_with ct1 ct2\n       | EQ <- cmp_loc ct1 ct2 = True\n       | eq_lhs_type   ct1 ct2 = True\n       | otherwise             = False\n\nmkHoleReporter :: [Ct] -> Reporter\n-- Reports errors one at a time\nmkHoleReporter tidy_simples ctxt\n  = mapM_ $ \\ct -> do { err <- mkHoleError tidy_simples ctxt ct\n                      ; maybeReportHoleError ctxt ct err\n                      ; maybeAddDeferredHoleBinding ctxt err ct }\n\nmkUserTypeErrorReporter :: Reporter\nmkUserTypeErrorReporter ctxt\n  = mapM_ $ \\ct -> do { err <- mkUserTypeError ctxt ct\n                      ; maybeReportError ctxt err\n                      ; addDeferredBinding ctxt err ct }\n\nmkUserTypeError :: ReportErrCtxt -> Ct -> TcM ErrMsg\nmkUserTypeError ctxt ct = mkErrorMsgFromCt ctxt ct\n                        $ important\n                        $ pprUserTypeErrorTy\n                        $ case getUserTypeErrorMsg ct of\n                            Just msg -> msg\n                            Nothing  -> pprPanic \"mkUserTypeError\" (ppr ct)\n\n\nmkGivenErrorReporter :: Reporter\n-- See Note [Given errors]\nmkGivenErrorReporter ctxt cts\n  = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct\n       ; dflags <- getDynFlags\n       ; let (implic:_) = cec_encl ctxt\n                 -- Always non-empty when mkGivenErrorReporter is called\n             ct' = setCtLoc ct (setCtLocEnv (ctLoc ct) (implicLclEnv implic))\n                   -- For given constraints we overwrite the env (and hence src-loc)\n                   -- with one from the immediately-enclosing implication.\n                   -- See Note [Inaccessible code]\n\n             inaccessible_msg = hang (text \"Inaccessible code in\")\n                                   2 (ppr (ic_info implic))\n             report = important inaccessible_msg `mappend`\n                      relevant_bindings binds_msg\n\n       ; err <- mkEqErr_help dflags ctxt report ct'\n                             Nothing ty1 ty2\n\n       ; traceTc \"mkGivenErrorReporter\" (ppr ct)\n       ; reportWarning (Reason Opt_WarnInaccessibleCode) err }\n  where\n    (ct : _ )  = cts    -- Never empty\n    (ty1, ty2) = getEqPredTys (ctPred ct)\n\nignoreErrorReporter :: Reporter\n-- Discard Given errors that don't come from\n-- a pattern match; maybe we should warn instead?\nignoreErrorReporter ctxt cts\n  = do { traceTc \"mkGivenErrorReporter no\" (ppr cts $$ ppr (cec_encl ctxt))\n       ; return () }\n\n\n{- Note [Given errors]\n~~~~~~~~~~~~~~~~~~~~~~\nGiven constraints represent things for which we have (or will have)\nevidence, so they aren't errors.  But if a Given constraint is\ninsoluble, this code is inaccessible, and we might want to at least\nwarn about that.  A classic case is\n\n   data T a where\n     T1 :: T Int\n     T2 :: T a\n     T3 :: T Bool\n\n   f :: T Int -> Bool\n   f T1 = ...\n   f T2 = ...\n   f T3 = ...  -- We want to report this case as inaccessible\n\nWe'd like to point out that the T3 match is inaccessible. It\nwill have a Given constraint [G] Int ~ Bool.\n\nBut we don't want to report ALL insoluble Given constraints.  See Trac\n#12466 for a long discussion.  For example, if we aren't careful\nwe'll complain about\n   f :: ((Int ~ Bool) => a -> a) -> Int\nwhich arguably is OK.  It's more debatable for\n   g :: (Int ~ Bool) => Int -> Int\nbut it's tricky to distinguish these cases so we don't report\neither.\n\nThe bottom line is this: has_gadt_match looks for an enclosing\npattern match which binds some equality constraints.  If we\nfind one, we report the insoluble Given.\n-}\n\nmkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg)\n                             -- Make error message for a group\n                -> Reporter  -- Deal with lots of constraints\n-- Group together errors from same location,\n-- and report only the first (to avoid a cascade)\nmkGroupReporter mk_err ctxt cts\n  = mapM_ (reportGroup mk_err ctxt . toList) (equivClasses cmp_loc cts)\n\neq_lhs_type :: Ct -> Ct -> Bool\neq_lhs_type ct1 ct2\n  = case (classifyPredType (ctPred ct1), classifyPredType (ctPred ct2)) of\n       (EqPred eq_rel1 ty1 _, EqPred eq_rel2 ty2 _) ->\n         (eq_rel1 == eq_rel2) && (ty1 `eqType` ty2)\n       _ -> pprPanic \"mkSkolReporter\" (ppr ct1 $$ ppr ct2)\n\ncmp_loc :: Ct -> Ct -> Ordering\ncmp_loc ct1 ct2 = ctLocSpan (ctLoc ct1) `compare` ctLocSpan (ctLoc ct2)\n\nreportGroup :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg) -> ReportErrCtxt\n            -> [Ct] -> TcM ()\nreportGroup mk_err ctxt cts =\n  case partition isMonadFailInstanceMissing cts of\n        -- Only warn about missing MonadFail constraint when\n        -- there are no other missing constraints!\n        (monadFailCts, []) ->\n            do { err <- mk_err ctxt monadFailCts\n               ; reportWarning (Reason Opt_WarnMissingMonadFailInstances) err }\n\n        (_, cts') -> do { err <- mk_err ctxt cts'\n                        ; traceTc \"About to maybeReportErr\" $\n                          vcat [ text \"Constraint:\"             <+> ppr cts'\n                               , text \"cec_suppress =\"          <+> ppr (cec_suppress ctxt)\n                               , text \"cec_defer_type_errors =\" <+> ppr (cec_defer_type_errors ctxt) ]\n                        ; maybeReportError ctxt err\n                            -- But see Note [Always warn with -fdefer-type-errors]\n                        ; traceTc \"reportGroup\" (ppr cts')\n                        ; mapM_ (addDeferredBinding ctxt err) cts' }\n                            -- Add deferred bindings for all\n                            -- Redundant if we are going to abort compilation,\n                            -- but that's hard to know for sure, and if we don't\n                            -- abort, we need bindings for all (e.g. Trac #12156)\n  where\n    isMonadFailInstanceMissing ct =\n        case ctLocOrigin (ctLoc ct) of\n            FailablePattern _pat -> True\n            _otherwise           -> False\n\nmaybeReportHoleError :: ReportErrCtxt -> Ct -> ErrMsg -> TcM ()\n-- Unlike maybeReportError, these \"hole\" errors are\n-- /not/ suppressed by cec_suppress.  We want to see them!\nmaybeReportHoleError ctxt ct err\n  -- When -XPartialTypeSignatures is on, warnings (instead of errors) are\n  -- generated for holes in partial type signatures.\n  -- Unless -fwarn_partial_type_signatures is not on,\n  -- in which case the messages are discarded.\n  | isTypeHoleCt ct\n  = -- For partial type signatures, generate warnings only, and do that\n    -- only if -fwarn_partial_type_signatures is on\n    case cec_type_holes ctxt of\n       HoleError -> reportError err\n       HoleWarn  -> reportWarning (Reason Opt_WarnPartialTypeSignatures) err\n       HoleDefer -> return ()\n\n  -- Always report an error for out-of-scope variables\n  -- Unless -fdefer-out-of-scope-variables is on,\n  -- in which case the messages are discarded.\n  -- See Trac #12170, #12406\n  | isOutOfScopeCt ct\n  = -- If deferring, report a warning only if -Wout-of-scope-variables is on\n    case cec_out_of_scope_holes ctxt of\n      HoleError -> reportError err\n      HoleWarn  ->\n        reportWarning (Reason Opt_WarnDeferredOutOfScopeVariables) err\n      HoleDefer -> return ()\n\n  -- Otherwise this is a typed hole in an expression,\n  -- but not for an out-of-scope variable\n  | otherwise\n  = -- If deferring, report a warning only if -Wtyped-holes is on\n    case cec_expr_holes ctxt of\n       HoleError -> reportError err\n       HoleWarn  -> reportWarning (Reason Opt_WarnTypedHoles) err\n       HoleDefer -> return ()\n\nmaybeReportError :: ReportErrCtxt -> ErrMsg -> TcM ()\n-- Report the error and/or make a deferred binding for it\nmaybeReportError ctxt err\n  | cec_suppress ctxt    -- Some worse error has occurred;\n  = return ()            -- so suppress this error/warning\n\n  | otherwise\n  = case cec_defer_type_errors ctxt of\n      TypeDefer       -> return ()\n      TypeWarn reason -> reportWarning reason err\n      TypeError       -> reportError err\n\naddDeferredBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM ()\n-- See Note [Deferring coercion errors to runtime]\naddDeferredBinding ctxt err ct\n  | deferringAnyBindings ctxt\n  , CtWanted { ctev_pred = pred, ctev_dest = dest } <- ctEvidence ct\n    -- Only add deferred bindings for Wanted constraints\n  = do { dflags <- getDynFlags\n       ; let err_msg = pprLocErrMsg err\n             err_fs  = mkFastString $ showSDoc dflags $\n                       err_msg $$ text \"(deferred type error)\"\n             err_tm  = evDelayedError pred err_fs\n             ev_binds_var = cec_binds ctxt\n\n       ; case dest of\n           EvVarDest evar\n             -> addTcEvBind ev_binds_var $ mkWantedEvBind evar err_tm\n           HoleDest hole\n             -> do { -- See Note [Deferred errors for coercion holes]\n                     let co_var = coHoleCoVar hole\n                   ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var err_tm\n                   ; fillCoercionHole hole (mkTcCoVarCo co_var) }}\n\n  | otherwise   -- Do not set any evidence for Given/Derived\n  = return ()\n\nmaybeAddDeferredHoleBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM ()\nmaybeAddDeferredHoleBinding ctxt err ct\n  | isExprHoleCt ct\n  = addDeferredBinding ctxt err ct  -- Only add bindings for holes in expressions\n  | otherwise                       -- not for holes in partial type signatures\n  = return ()\n\ntryReporters :: ReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])\n-- Use the first reporter in the list whose predicate says True\ntryReporters ctxt reporters cts\n  = do { let (vis_cts, invis_cts) = partition (isVisibleOrigin . ctOrigin) cts\n       ; traceTc \"tryReporters {\" (ppr vis_cts $$ ppr invis_cts)\n       ; (ctxt', cts') <- go ctxt reporters vis_cts invis_cts\n       ; traceTc \"tryReporters }\" (ppr cts')\n       ; return (ctxt', cts') }\n  where\n    go ctxt [] vis_cts invis_cts\n      = return (ctxt, vis_cts ++ invis_cts)\n\n    go ctxt (r : rs) vis_cts invis_cts\n       -- always look at *visible* Origins before invisible ones\n       -- this is the whole point of isVisibleOrigin\n      = do { (ctxt', vis_cts') <- tryReporter ctxt r vis_cts\n           ; (ctxt'', invis_cts') <- tryReporter ctxt' r invis_cts\n           ; go ctxt'' rs vis_cts' invis_cts' }\n                -- Carry on with the rest, because we must make\n                -- deferred bindings for them if we have -fdefer-type-errors\n                -- But suppress their error messages\n\ntryReporter :: ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct])\ntryReporter ctxt (str, keep_me,  suppress_after, reporter) cts\n  | null yeses\n  = return (ctxt, cts)\n  | otherwise\n  = do { traceTc \"tryReporter{ \" (text str <+> ppr yeses)\n       ; (_, no_errs) <- askNoErrs (reporter ctxt yeses)\n       ; let suppress_now = not no_errs && suppress_after\n                            -- See Note [Suppressing error messages]\n             ctxt' = ctxt { cec_suppress = suppress_now || cec_suppress ctxt }\n       ; traceTc \"tryReporter end }\" (text str <+> ppr (cec_suppress ctxt) <+> ppr suppress_after)\n       ; return (ctxt', nos) }\n  where\n    (yeses, nos) = partition (\\ct -> keep_me ct (classifyPredType (ctPred ct))) cts\n\n\npprArising :: CtOrigin -> SDoc\n-- Used for the main, top-level error message\n-- We've done special processing for TypeEq, KindEq, Given\npprArising (TypeEqOrigin {}) = empty\npprArising (KindEqOrigin {}) = empty\npprArising (GivenOrigin {})  = empty\npprArising orig              = pprCtOrigin orig\n\n-- Add the \"arising from...\" part to a message about bunch of dicts\naddArising :: CtOrigin -> SDoc -> SDoc\naddArising orig msg = hang msg 2 (pprArising orig)\n\npprWithArising :: [Ct] -> (CtLoc, SDoc)\n-- Print something like\n--    (Eq a) arising from a use of x at y\n--    (Show a) arising from a use of p at q\n-- Also return a location for the error message\n-- Works for Wanted/Derived only\npprWithArising []\n  = panic \"pprWithArising\"\npprWithArising (ct:cts)\n  | null cts\n  = (loc, addArising (ctLocOrigin loc)\n                     (pprTheta [ctPred ct]))\n  | otherwise\n  = (loc, vcat (map ppr_one (ct:cts)))\n  where\n    loc = ctLoc ct\n    ppr_one ct' = hang (parens (pprType (ctPred ct')))\n                     2 (pprCtLoc (ctLoc ct'))\n\nmkErrorMsgFromCt :: ReportErrCtxt -> Ct -> Report -> TcM ErrMsg\nmkErrorMsgFromCt ctxt ct report\n  = mkErrorReport ctxt (ctLocEnv (ctLoc ct)) report\n\nmkErrorReport :: ReportErrCtxt -> TcLclEnv -> Report -> TcM ErrMsg\nmkErrorReport ctxt tcl_env (Report important relevant_bindings valid_subs)\n  = do { context <- mkErrInfo (cec_tidy ctxt) (tcl_ctxt tcl_env)\n       ; mkErrDocAt (RealSrcSpan (tcl_loc tcl_env))\n            (errDoc important [context] (relevant_bindings ++ valid_subs))\n       }\n\ntype UserGiven = Implication\n\ngetUserGivens :: ReportErrCtxt -> [UserGiven]\n-- One item for each enclosing implication\ngetUserGivens (CEC {cec_encl = implics}) = getUserGivensFromImplics implics\n\ngetUserGivensFromImplics :: [Implication] -> [UserGiven]\ngetUserGivensFromImplics implics\n  = reverse (filterOut (null . ic_given) implics)\n\n{- Note [Always warn with -fdefer-type-errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen -fdefer-type-errors is on we warn about *all* type errors, even\nif cec_suppress is on.  This can lead to a lot more warnings than you\nwould get errors without -fdefer-type-errors, but if we suppress any of\nthem you might get a runtime error that wasn't warned about at compile\ntime.\n\nThis is an easy design choice to change; just flip the order of the\nfirst two equations for maybeReportError\n\nTo be consistent, we should also report multiple warnings from a single\nlocation in mkGroupReporter, when -fdefer-type-errors is on.  But that\nis perhaps a bit *over*-consistent! Again, an easy choice to change.\n\nWith #10283, you can now opt out of deferred type error warnings.\n\nNote [Deferred errors for coercion holes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we need to defer a type error where the destination for the evidence\nis a coercion hole. We can't just put the error in the hole, because we can't\nmake an erroneous coercion. (Remember that coercions are erased for runtime.)\nInstead, we invent a new EvVar, bind it to an error and then make a coercion\nfrom that EvVar, filling the hole with that coercion. Because coercions'\ntypes are unlifted, the error is guaranteed to be hit before we get to the\ncoercion.\n\nNote [Do not report derived but soluble errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe wc_simples include Derived constraints that have not been solved,\nbut are not insoluble (in that case they'd be reported by 'report1').\nWe do not want to report these as errors:\n\n* Superclass constraints. If we have an unsolved [W] Ord a, we'll also have\n  an unsolved [D] Eq a, and we do not want to report that; it's just noise.\n\n* Functional dependencies.  For givens, consider\n      class C a b | a -> b\n      data T a where\n         MkT :: C a d => [d] -> T a\n      f :: C a b => T a -> F Int\n      f (MkT xs) = length xs\n  Then we get a [D] b~d.  But there *is* a legitimate call to\n  f, namely   f (MkT [True]) :: T Bool, in which b=d.  So we should\n  not reject the program.\n\n  For wanteds, something similar\n      data T a where\n        MkT :: C Int b => a -> b -> T a\n      g :: C Int c => c -> ()\n      f :: T a -> ()\n      f (MkT x y) = g x\n  Here we get [G] C Int b, [W] C Int a, hence [D] a~b.\n  But again f (MkT True True) is a legitimate call.\n\n(We leave the Deriveds in wc_simple until reportErrors, so that we don't lose\nderived superclasses between iterations of the solver.)\n\nFor functional dependencies, here is a real example,\nstripped off from libraries/utf8-string/Codec/Binary/UTF8/Generic.hs\n\n  class C a b | a -> b\n  g :: C a b => a -> b -> ()\n  f :: C a b => a -> b -> ()\n  f xa xb =\n      let loop = g xa\n      in loop xb\n\nWe will first try to infer a type for loop, and we will succeed:\n    C a b' => b' -> ()\nSubsequently, we will type check (loop xb) and all is good. But,\nrecall that we have to solve a final implication constraint:\n    C a b => (C a b' => .... cts from body of loop .... ))\nAnd now we have a problem as we will generate an equality b ~ b' and fail to\nsolve it.\n\n\n************************************************************************\n*                                                                      *\n                Irreducible predicate errors\n*                                                                      *\n************************************************************************\n-}\n\nmkIrredErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg\nmkIrredErr ctxt cts\n  = do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1\n       ; let orig = ctOrigin ct1\n             msg  = couldNotDeduce (getUserGivens ctxt) (map ctPred cts, orig)\n       ; mkErrorMsgFromCt ctxt ct1 $\n            important msg `mappend` relevant_bindings binds_msg }\n  where\n    (ct1:_) = cts\n\n----------------\nmkHoleError :: [Ct] -> ReportErrCtxt -> Ct -> TcM ErrMsg\nmkHoleError _ _ ct@(CHoleCan { cc_hole = ExprHole (OutOfScope occ rdr_env0) })\n  -- Out-of-scope variables, like 'a', where 'a' isn't bound; suggest possible\n  -- in-scope variables in the message, and note inaccessible exact matches\n  = do { dflags   <- getDynFlags\n       ; imp_info <- getImports\n       ; curr_mod <- getModule\n       ; hpt <- getHpt\n       ; let suggs_msg = unknownNameSuggestions dflags hpt curr_mod rdr_env0\n                                                (tcl_rdr lcl_env) imp_info rdr\n       ; rdr_env     <- getGlobalRdrEnv\n       ; splice_locs <- getTopLevelSpliceLocs\n       ; let match_msgs = mk_match_msgs rdr_env splice_locs\n       ; mkErrDocAt (RealSrcSpan err_loc) $\n                    errDoc [out_of_scope_msg] [] (match_msgs ++ [suggs_msg]) }\n\n  where\n    rdr         = mkRdrUnqual occ\n    ct_loc      = ctLoc ct\n    lcl_env     = ctLocEnv ct_loc\n    err_loc     = tcl_loc lcl_env\n    hole_ty     = ctEvPred (ctEvidence ct)\n    boring_type = isTyVarTy hole_ty\n\n    out_of_scope_msg -- Print v :: ty only if the type has structure\n      | boring_type = hang herald 2 (ppr occ)\n      | otherwise   = hang herald 2 (pp_with_type occ hole_ty)\n\n    herald | isDataOcc occ = text \"Data constructor not in scope:\"\n           | otherwise     = text \"Variable not in scope:\"\n\n    -- Indicate if the out-of-scope variable exactly (and unambiguously) matches\n    -- a top-level binding in a later inter-splice group; see Note [OutOfScope\n    -- exact matches]\n    mk_match_msgs rdr_env splice_locs\n      = let gres = filter isLocalGRE (lookupGlobalRdrEnv rdr_env occ)\n        in case gres of\n             [gre]\n               |  RealSrcSpan bind_loc <- greSrcSpan gre\n                  -- Find splice between the unbound variable and the match; use\n                  -- lookupLE, not lookupLT, since match could be in the splice\n               ,  Just th_loc <- Set.lookupLE bind_loc splice_locs\n               ,  err_loc < th_loc\n               -> [mk_bind_scope_msg bind_loc th_loc]\n             _ -> []\n\n    mk_bind_scope_msg bind_loc th_loc\n      | is_th_bind\n      = hang (quotes (ppr occ) <+> parens (text \"splice on\" <+> th_rng))\n           2 (text \"is not in scope before line\" <+> int th_start_ln)\n      | otherwise\n      = hang (quotes (ppr occ) <+> bind_rng <+> text \"is not in scope\")\n           2 (text \"before the splice on\" <+> th_rng)\n      where\n        bind_rng = parens (text \"line\" <+> int bind_ln)\n        th_rng\n          | th_start_ln == th_end_ln = single\n          | otherwise                = multi\n        single = text \"line\"  <+> int th_start_ln\n        multi  = text \"lines\" <+> int th_start_ln <> text \"-\" <> int th_end_ln\n        bind_ln     = srcSpanStartLine bind_loc\n        th_start_ln = srcSpanStartLine th_loc\n        th_end_ln   = srcSpanEndLine   th_loc\n        is_th_bind = th_loc `containsSpan` bind_loc\n\nmkHoleError tidy_simples ctxt ct@(CHoleCan { cc_hole = hole })\n  -- Explicit holes, like \"_\" or \"_f\"\n  = do { (ctxt, binds_msg, ct) <- relevantBindings False ctxt ct\n               -- The 'False' means \"don't filter the bindings\"; see Trac #8191\n\n       ; show_hole_constraints <- goptM Opt_ShowHoleConstraints\n       ; let constraints_msg\n               | isExprHoleCt ct, show_hole_constraints\n                  = givenConstraintsMsg ctxt\n               | otherwise = empty\n\n       ; show_valid_hole_fits <- goptM Opt_ShowValidHoleFits\n       ; (ctxt, sub_msg) <- if show_valid_hole_fits\n                            then validHoleFits ctxt tidy_simples ct\n                            else return (ctxt, empty)\n       ; mkErrorMsgFromCt ctxt ct $\n            important hole_msg `mappend`\n            relevant_bindings (binds_msg $$ constraints_msg) `mappend`\n            valid_hole_fits sub_msg}\n\n  where\n    occ       = holeOcc hole\n    hole_ty   = ctEvPred (ctEvidence ct)\n    hole_kind = tcTypeKind hole_ty\n    tyvars    = tyCoVarsOfTypeList hole_ty\n\n    hole_msg = case hole of\n      ExprHole {} -> vcat [ hang (text \"Found hole:\")\n                               2 (pp_with_type occ hole_ty)\n                          , tyvars_msg, expr_hole_hint ]\n      TypeHole {} -> vcat [ hang (text \"Found type wildcard\" <+>\n                                  quotes (ppr occ))\n                               2 (text \"standing for\" <+>\n                                  quotes pp_hole_type_with_kind)\n                          , tyvars_msg, type_hole_hint ]\n\n    pp_hole_type_with_kind\n      | isLiftedTypeKind hole_kind\n        || isCoVarType hole_ty -- Don't print the kind of unlifted\n                               -- equalities (#15039)\n      = pprType hole_ty\n      | otherwise\n      = pprType hole_ty <+> dcolon <+> pprKind hole_kind\n\n    tyvars_msg = ppUnless (null tyvars) $\n                 text \"Where:\" <+> (vcat (map loc_msg other_tvs)\n                                    $$ pprSkols ctxt skol_tvs)\n       where\n         (skol_tvs, other_tvs) = partition is_skol tyvars\n         is_skol tv = isTcTyVar tv && isSkolemTyVar tv\n                      -- Coercion variables can be free in the\n                      -- hole, via kind casts\n\n    type_hole_hint\n         | HoleError <- cec_type_holes ctxt\n         = text \"To use the inferred type, enable PartialTypeSignatures\"\n         | otherwise\n         = empty\n\n    expr_hole_hint                       -- Give hint for, say,   f x = _x\n         | lengthFS (occNameFS occ) > 1  -- Don't give this hint for plain \"_\"\n         = text \"Or perhaps\" <+> quotes (ppr occ)\n           <+> text \"is mis-spelled, or not in scope\"\n         | otherwise\n         = empty\n\n    loc_msg tv\n       | isTyVar tv\n       = case tcTyVarDetails tv of\n           MetaTv {} -> quotes (ppr tv) <+> text \"is an ambiguous type variable\"\n           _         -> empty  -- Skolems dealt with already\n       | otherwise  -- A coercion variable can be free in the hole type\n       = sdocWithDynFlags $ \\dflags ->\n         if gopt Opt_PrintExplicitCoercions dflags\n         then quotes (ppr tv) <+> text \"is a coercion variable\"\n         else empty\n\nmkHoleError _ _ ct = pprPanic \"mkHoleError\" (ppr ct)\n\n-- We unwrap the ReportErrCtxt here, to avoid introducing a loop in module\n-- imports\nvalidHoleFits :: ReportErrCtxt -- The context we're in, i.e. the\n                                        -- implications and the tidy environment\n                       -> [Ct]          -- Unsolved simple constraints\n                       -> Ct            -- The hole constraint.\n                       -> TcM (ReportErrCtxt, SDoc) -- We return the new context\n                                                    -- with a possibly updated\n                                                    -- tidy environment, and\n                                                    -- the message.\nvalidHoleFits ctxt@(CEC {cec_encl = implics\n                             , cec_tidy = lcl_env}) simps ct\n  = do { (tidy_env, msg) <- findValidHoleFits lcl_env implics simps ct\n       ; return (ctxt {cec_tidy = tidy_env}, msg) }\n\n-- See Note [Constraints include ...]\ngivenConstraintsMsg :: ReportErrCtxt -> SDoc\ngivenConstraintsMsg ctxt =\n    let constraints :: [(Type, RealSrcSpan)]\n        constraints =\n          do { implic@Implic{ ic_given = given } <- cec_encl ctxt\n             ; constraint <- given\n             ; return (varType constraint, tcl_loc (implicLclEnv implic)) }\n\n        pprConstraint (constraint, loc) =\n          ppr constraint <+> nest 2 (parens (text \"from\" <+> ppr loc))\n\n    in ppUnless (null constraints) $\n         hang (text \"Constraints include\")\n            2 (vcat $ map pprConstraint constraints)\n\npp_with_type :: OccName -> Type -> SDoc\npp_with_type occ ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType ty)\n\n----------------\nmkIPErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg\nmkIPErr ctxt cts\n  = do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1\n       ; let orig    = ctOrigin ct1\n             preds   = map ctPred cts\n             givens  = getUserGivens ctxt\n             msg | null givens\n                 = addArising orig $\n                   sep [ text \"Unbound implicit parameter\" <> plural cts\n                       , nest 2 (pprParendTheta preds) ]\n                 | otherwise\n                 = couldNotDeduce givens (preds, orig)\n\n       ; mkErrorMsgFromCt ctxt ct1 $\n            important msg `mappend` relevant_bindings binds_msg }\n  where\n    (ct1:_) = cts\n\n{-\n\nNote [Constraints include ...]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n'givenConstraintsMsg' returns the \"Constraints include ...\" message enabled by\n-fshow-hole-constraints. For example, the following hole:\n\n    foo :: (Eq a, Show a) => a -> String\n    foo x = _\n\nwould generate the message:\n\n    Constraints include\n      Eq a (from foo.hs:1:1-36)\n      Show a (from foo.hs:1:1-36)\n\nConstraints are displayed in order from innermost (closest to the hole) to\noutermost. There's currently no filtering or elimination of duplicates.\n\n\nNote [OutOfScope exact matches]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen constructing an out-of-scope error message, we not only generate a list of\npossible in-scope alternatives but also search for an exact, unambiguous match\nin a later inter-splice group.  If we find such a match, we report its presence\n(and indirectly, its scope) in the message.  For example, if a module A contains\nthe following declarations,\n\n   foo :: Int\n   foo = x\n\n   $(return [])  -- Empty top-level splice\n\n   x :: Int\n   x = 23\n\nwe will issue an error similar to\n\n   A.hs:6:7: error:\n       \u00e2\u20ac\u00a2 Variable not in scope: x :: Int\n       \u00e2\u20ac\u00a2 \u00e2\u20ac\u02dcx\u00e2\u20ac\u2122 (line 11) is not in scope before the splice on line 8\n\nBy providing information about the match, we hope to clarify why declaring a\nvariable after a top-level splice but using it before the splice generates an\nout-of-scope error (a situation which is often confusing to Haskell newcomers).\n\nNote that if we find multiple exact matches to the out-of-scope variable\n(hereafter referred to as x), we report nothing.  Such matches can only be\nduplicate record fields, as the presence of any other duplicate top-level\ndeclarations would have already halted compilation.  But if these record fields\nare declared in a later inter-splice group, then so too are their corresponding\ntypes.  Thus, these types must not occur in the inter-splice group containing x\n(any unknown types would have already been reported), and so the matches to the\nrecord fields are most likely coincidental.\n\nOne oddity of the exact match portion of the error message is that we specify\nwhere the match to x is NOT in scope.  Why not simply state where the match IS\nin scope?  It most cases, this would be just as easy and perhaps a little\nclearer for the user.  But now consider the following example:\n\n    {-# LANGUAGE TemplateHaskell #-}\n\n    module A where\n\n    import Language.Haskell.TH\n    import Language.Haskell.TH.Syntax\n\n    foo = x\n\n    $(do -------------------------------------------------\n        ds <- [d| ok1 = x\n                |]\n        addTopDecls ds\n        return [])\n\n    bar = $(do\n            ds <- [d| x = 23\n                      ok2 = x\n                    |]\n            addTopDecls ds\n            litE $ stringL \"hello\")\n\n    $(return []) -----------------------------------------\n\n    ok3 = x\n\nHere, x is out-of-scope in the declaration of foo, and so we report\n\n    A.hs:8:7: error:\n        \u00e2\u20ac\u00a2 Variable not in scope: x\n        \u00e2\u20ac\u00a2 \u00e2\u20ac\u02dcx\u00e2\u20ac\u2122 (line 16) is not in scope before the splice on lines 10-14\n\nIf we instead reported where x IS in scope, we would have to state that it is in\nscope after the second top-level splice as well as among all the top-level\ndeclarations added by both calls to addTopDecls.  But doing so would not only\nadd complexity to the code but also overwhelm the user with unneeded\ninformation.\n\nThe logic which determines where x is not in scope is straightforward: it simply\nfinds the last top-level splice which occurs after x but before (or at) the\nmatch to x (assuming such a splice exists).  In most cases, the check that the\nsplice occurs after x acts only as a sanity check.  For example, when the match\nto x is a non-TH top-level declaration and a splice S occurs before the match,\nthen x must precede S; otherwise, it would be in scope.  But when dealing with\naddTopDecls, this check serves a practical purpose.  Consider the following\ndeclarations:\n\n    $(do\n        ds <- [d| ok = x\n                  x = 23\n                |]\n        addTopDecls ds\n        return [])\n\n    foo = x\n\nIn this case, x is not in scope in the declaration for foo.  Since x occurs\nAFTER the splice containing the match, the logic does not find any splices after\nx but before or at its match, and so we report nothing about x's scope.  If we\nhad not checked whether x occurs before the splice, we would have instead\nreported that x is not in scope before the splice.  While correct, such an error\nmessage is more likely to confuse than to enlighten.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                Equality errors\n*                                                                      *\n************************************************************************\n\nNote [Inaccessible code]\n~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   data T a where\n     T1 :: T a\n     T2 :: T Bool\n\n   f :: (a ~ Int) => T a -> Int\n   f T1 = 3\n   f T2 = 4   -- Unreachable code\n\nHere the second equation is unreachable. The original constraint\n(a~Int) from the signature gets rewritten by the pattern-match to\n(Bool~Int), so the danger is that we report the error as coming from\nthe *signature* (Trac #7293).  So, for Given errors we replace the\nenv (and hence src-loc) on its CtLoc with that from the immediately\nenclosing implication.\n\nNote [Error messages for untouchables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #9109)\n  data G a where { GBool :: G Bool }\n  foo x = case x of GBool -> True\n\nHere we can't solve (t ~ Bool), where t is the untouchable result\nmeta-var 't', because of the (a ~ Bool) from the pattern match.\nSo we infer the type\n   f :: forall a t. G a -> t\nmaking the meta-var 't' into a skolem.  So when we come to report\nthe unsolved (t ~ Bool), t won't look like an untouchable meta-var\nany more.  So we don't assert that it is.\n-}\n\n-- Don't have multiple equality errors from the same location\n-- E.g.   (Int,Bool) ~ (Bool,Int)   one error will do!\nmkEqErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg\nmkEqErr ctxt (ct:_) = mkEqErr1 ctxt ct\nmkEqErr _ [] = panic \"mkEqErr\"\n\nmkEqErr1 :: ReportErrCtxt -> Ct -> TcM ErrMsg\nmkEqErr1 ctxt ct   -- Wanted or derived;\n                   -- givens handled in mkGivenErrorReporter\n  = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct\n       ; rdr_env <- getGlobalRdrEnv\n       ; fam_envs <- tcGetFamInstEnvs\n       ; exp_syns <- goptM Opt_PrintExpandedSynonyms\n       ; let (keep_going, is_oriented, wanted_msg)\n                           = mk_wanted_extra (ctLoc ct) exp_syns\n             coercible_msg = case ctEqRel ct of\n               NomEq  -> empty\n               ReprEq -> mkCoercibleExplanation rdr_env fam_envs ty1 ty2\n       ; dflags <- getDynFlags\n       ; traceTc \"mkEqErr1\" (ppr ct $$ pprCtOrigin (ctOrigin ct) $$ ppr keep_going)\n       ; let report = mconcat [important wanted_msg, important coercible_msg,\n                               relevant_bindings binds_msg]\n       ; if keep_going\n         then mkEqErr_help dflags ctxt report ct is_oriented ty1 ty2\n         else mkErrorMsgFromCt ctxt ct report }\n  where\n    (ty1, ty2) = getEqPredTys (ctPred ct)\n\n       -- If the types in the error message are the same as the types\n       -- we are unifying, don't add the extra expected/actual message\n    mk_wanted_extra :: CtLoc -> Bool -> (Bool, Maybe SwapFlag, SDoc)\n    mk_wanted_extra loc expandSyns\n      = case ctLocOrigin loc of\n          orig@TypeEqOrigin {} -> mkExpectedActualMsg ty1 ty2 orig\n                                                      t_or_k expandSyns\n            where\n              t_or_k = ctLocTypeOrKind_maybe loc\n\n          KindEqOrigin cty1 mb_cty2 sub_o sub_t_or_k\n            -> (True, Nothing, msg1 $$ msg2)\n            where\n              sub_what = case sub_t_or_k of Just KindLevel -> text \"kinds\"\n                                            _              -> text \"types\"\n              msg1 = sdocWithDynFlags $ \\dflags ->\n                     case mb_cty2 of\n                       Just cty2\n                         |  gopt Opt_PrintExplicitCoercions dflags\n                         || not (cty1 `pickyEqType` cty2)\n                         -> hang (text \"When matching\" <+> sub_what)\n                               2 (vcat [ ppr cty1 <+> dcolon <+>\n                                         ppr (tcTypeKind cty1)\n                                       , ppr cty2 <+> dcolon <+>\n                                         ppr (tcTypeKind cty2) ])\n                       _ -> text \"When matching the kind of\" <+> quotes (ppr cty1)\n              msg2 = case sub_o of\n                       TypeEqOrigin {}\n                         | Just cty2 <- mb_cty2 ->\n                         thdOf3 (mkExpectedActualMsg cty1 cty2 sub_o sub_t_or_k\n                                                     expandSyns)\n                       _ -> empty\n          _ -> (True, Nothing, empty)\n\n-- | This function tries to reconstruct why a \"Coercible ty1 ty2\" constraint\n-- is left over.\nmkCoercibleExplanation :: GlobalRdrEnv -> FamInstEnvs\n                       -> TcType -> TcType -> SDoc\nmkCoercibleExplanation rdr_env fam_envs ty1 ty2\n  | Just (tc, tys) <- tcSplitTyConApp_maybe ty1\n  , (rep_tc, _, _) <- tcLookupDataFamInst fam_envs tc tys\n  , Just msg <- coercible_msg_for_tycon rep_tc\n  = msg\n  | Just (tc, tys) <- splitTyConApp_maybe ty2\n  , (rep_tc, _, _) <- tcLookupDataFamInst fam_envs tc tys\n  , Just msg <- coercible_msg_for_tycon rep_tc\n  = msg\n  | Just (s1, _) <- tcSplitAppTy_maybe ty1\n  , Just (s2, _) <- tcSplitAppTy_maybe ty2\n  , s1 `eqType` s2\n  , has_unknown_roles s1\n  = hang (text \"NB: We cannot know what roles the parameters to\" <+>\n          quotes (ppr s1) <+> text \"have;\")\n       2 (text \"we must assume that the role is nominal\")\n  | otherwise\n  = empty\n  where\n    coercible_msg_for_tycon tc\n        | isAbstractTyCon tc\n        = Just $ hsep [ text \"NB: The type constructor\"\n                      , quotes (pprSourceTyCon tc)\n                      , text \"is abstract\" ]\n        | isNewTyCon tc\n        , [data_con] <- tyConDataCons tc\n        , let dc_name = dataConName data_con\n        , isNothing (lookupGRE_Name rdr_env dc_name)\n        = Just $ hang (text \"The data constructor\" <+> quotes (ppr dc_name))\n                    2 (sep [ text \"of newtype\" <+> quotes (pprSourceTyCon tc)\n                           , text \"is not in scope\" ])\n        | otherwise = Nothing\n\n    has_unknown_roles ty\n      | Just (tc, tys) <- tcSplitTyConApp_maybe ty\n      = tys `lengthAtLeast` tyConArity tc  -- oversaturated tycon\n      | Just (s, _) <- tcSplitAppTy_maybe ty\n      = has_unknown_roles s\n      | isTyVarTy ty\n      = True\n      | otherwise\n      = False\n\n{-\n-- | Make a listing of role signatures for all the parameterised tycons\n-- used in the provided types\n\n\n-- SLPJ Jun 15: I could not convince myself that these hints were really\n-- useful.  Maybe they are, but I think we need more work to make them\n-- actually helpful.\nmkRoleSigs :: Type -> Type -> SDoc\nmkRoleSigs ty1 ty2\n  = ppUnless (null role_sigs) $\n    hang (text \"Relevant role signatures:\")\n       2 (vcat role_sigs)\n  where\n    tcs = nameEnvElts $ tyConsOfType ty1 `plusNameEnv` tyConsOfType ty2\n    role_sigs = mapMaybe ppr_role_sig tcs\n\n    ppr_role_sig tc\n      | null roles  -- if there are no parameters, don't bother printing\n      = Nothing\n      | isBuiltInSyntax (tyConName tc)  -- don't print roles for (->), etc.\n      = Nothing\n      | otherwise\n      = Just $ hsep $ [text \"type role\", ppr tc] ++ map ppr roles\n      where\n        roles = tyConRoles tc\n-}\n\nmkEqErr_help :: DynFlags -> ReportErrCtxt -> Report\n             -> Ct\n             -> Maybe SwapFlag   -- Nothing <=> not sure\n             -> TcType -> TcType -> TcM ErrMsg\nmkEqErr_help dflags ctxt report ct oriented ty1 ty2\n  | Just (tv1, co1) <- tcGetCastedTyVar_maybe ty1\n  = mkTyVarEqErr dflags ctxt report ct oriented tv1 co1 ty2\n  | Just (tv2, co2) <- tcGetCastedTyVar_maybe ty2\n  = mkTyVarEqErr dflags ctxt report ct swapped  tv2 co2 ty1\n  | otherwise\n  = reportEqErr ctxt report ct oriented ty1 ty2\n  where\n    swapped = fmap flipSwap oriented\n\nreportEqErr :: ReportErrCtxt -> Report\n            -> Ct\n            -> Maybe SwapFlag   -- Nothing <=> not sure\n            -> TcType -> TcType -> TcM ErrMsg\nreportEqErr ctxt report ct oriented ty1 ty2\n  = mkErrorMsgFromCt ctxt ct (mconcat [misMatch, report, eqInfo])\n  where misMatch = important $ misMatchOrCND ctxt ct oriented ty1 ty2\n        eqInfo = important $ mkEqInfoMsg ct ty1 ty2\n\nmkTyVarEqErr, mkTyVarEqErr'\n  :: DynFlags -> ReportErrCtxt -> Report -> Ct\n             -> Maybe SwapFlag -> TcTyVar -> TcCoercionN -> TcType -> TcM ErrMsg\n-- tv1 and ty2 are already tidied\nmkTyVarEqErr dflags ctxt report ct oriented tv1 co1 ty2\n  = do { traceTc \"mkTyVarEqErr\" (ppr ct $$ ppr tv1 $$ ppr co1 $$ ppr ty2)\n       ; mkTyVarEqErr' dflags ctxt report ct oriented tv1 co1 ty2 }\n\nmkTyVarEqErr' dflags ctxt report ct oriented tv1 co1 ty2\n  | not insoluble_occurs_check   -- See Note [Occurs check wins]\n  , isUserSkolem ctxt tv1   -- ty2 won't be a meta-tyvar, or else the thing would\n                            -- be oriented the other way round;\n                            -- see TcCanonical.canEqTyVarTyVar\n    || isTyVarTyVar tv1 && not (isTyVarTy ty2)\n    || ctEqRel ct == ReprEq\n     -- the cases below don't really apply to ReprEq (except occurs check)\n  = mkErrorMsgFromCt ctxt ct $ mconcat\n        [ important $ misMatchOrCND ctxt ct oriented ty1 ty2\n        , important $ extraTyVarEqInfo ctxt tv1 ty2\n        , report\n        ]\n\n  | OC_Occurs <- occ_check_expand\n    -- We report an \"occurs check\" even for  a ~ F t a, where F is a type\n    -- function; it's not insoluble (because in principle F could reduce)\n    -- but we have certainly been unable to solve it\n    -- See Note [Occurs check error] in TcCanonical\n  = do { let main_msg = addArising (ctOrigin ct) $\n                        hang (text \"Occurs check: cannot construct the infinite\" <+> what <> colon)\n                              2 (sep [ppr ty1, char '~', ppr ty2])\n\n             extra2 = important $ mkEqInfoMsg ct ty1 ty2\n\n             interesting_tyvars = filter (not . noFreeVarsOfType . tyVarKind) $\n                                  filter isTyVar $\n                                  fvVarList $\n                                  tyCoFVsOfType ty1 `unionFV` tyCoFVsOfType ty2\n             extra3 = relevant_bindings $\n                      ppWhen (not (null interesting_tyvars)) $\n                      hang (text \"Type variable kinds:\") 2 $\n                      vcat (map (tyvar_binding . tidyTyCoVarOcc (cec_tidy ctxt))\n                                interesting_tyvars)\n\n             tyvar_binding tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv)\n       ; mkErrorMsgFromCt ctxt ct $\n         mconcat [important main_msg, extra2, extra3, report] }\n\n  | OC_Bad <- occ_check_expand\n  = do { let msg = vcat [ text \"Cannot instantiate unification variable\"\n                          <+> quotes (ppr tv1)\n                        , hang (text \"with a\" <+> what <+> text \"involving foralls:\") 2 (ppr ty2)\n                        , nest 2 (text \"GHC doesn't yet support impredicative polymorphism\") ]\n       -- Unlike the other reports, this discards the old 'report_important'\n       -- instead of augmenting it.  This is because the details are not likely\n       -- to be helpful since this is just an unimplemented feature.\n       ; mkErrorMsgFromCt ctxt ct $ report { report_important = [msg] } }\n\n   -- check for heterogeneous equality next; see Note [Equalities with incompatible kinds]\n   -- in TcCanonical\n  | not (k1 `tcEqType` k2)\n  = do { let main_msg = addArising (ctOrigin ct) $\n                        vcat [ hang (text \"Kind mismatch: cannot unify\" <+>\n                                     parens (ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1)) <+>\n                                     text \"with:\")\n                                  2 (sep [ppr ty2, dcolon, ppr k2])\n                             , text \"Their kinds differ.\" ]\n             cast_msg\n               | isTcReflexiveCo co1 = empty\n               | otherwise           = text \"NB:\" <+> ppr tv1 <+>\n                                       text \"was casted to have kind\" <+>\n                                       quotes (ppr k1)\n\n       ; mkErrorMsgFromCt ctxt ct (mconcat [important main_msg, important cast_msg, report]) }\n\n  -- If the immediately-enclosing implication has 'tv' a skolem, and\n  -- we know by now its an InferSkol kind of skolem, then presumably\n  -- it started life as a TyVarTv, else it'd have been unified, given\n  -- that there's no occurs-check or forall problem\n  | (implic:_) <- cec_encl ctxt\n  , Implic { ic_skols = skols } <- implic\n  , tv1 `elem` skols\n  = mkErrorMsgFromCt ctxt ct $ mconcat\n        [ important $ misMatchMsg ct oriented ty1 ty2\n        , important $ extraTyVarEqInfo ctxt tv1 ty2\n        , report\n        ]\n\n  -- Check for skolem escape\n  | (implic:_) <- cec_encl ctxt   -- Get the innermost context\n  , Implic { ic_skols = skols, ic_info = skol_info } <- implic\n  , let esc_skols = filter (`elemVarSet` (tyCoVarsOfType ty2)) skols\n  , not (null esc_skols)\n  = do { let msg = important $ misMatchMsg ct oriented ty1 ty2\n             esc_doc = sep [ text \"because\" <+> what <+> text \"variable\" <> plural esc_skols\n                             <+> pprQuotedList esc_skols\n                           , text \"would escape\" <+>\n                             if isSingleton esc_skols then text \"its scope\"\n                                                      else text \"their scope\" ]\n             tv_extra = important $\n                        vcat [ nest 2 $ esc_doc\n                             , sep [ (if isSingleton esc_skols\n                                      then text \"This (rigid, skolem)\" <+>\n                                           what <+> text \"variable is\"\n                                      else text \"These (rigid, skolem)\" <+>\n                                           what <+> text \"variables are\")\n                               <+> text \"bound by\"\n                             , nest 2 $ ppr skol_info\n                             , nest 2 $ text \"at\" <+>\n                               ppr (tcl_loc (implicLclEnv implic)) ] ]\n       ; mkErrorMsgFromCt ctxt ct (mconcat [msg, tv_extra, report]) }\n\n  -- Nastiest case: attempt to unify an untouchable variable\n  -- So tv is a meta tyvar (or started that way before we\n  -- generalised it).  So presumably it is an *untouchable*\n  -- meta tyvar or a TyVarTv, else it'd have been unified\n  -- See Note [Error messages for untouchables]\n  | (implic:_) <- cec_encl ctxt   -- Get the innermost context\n  , Implic { ic_given = given, ic_tclvl = lvl, ic_info = skol_info } <- implic\n  = ASSERT2( not (isTouchableMetaTyVar lvl tv1)\n           , ppr tv1 $$ ppr lvl )  -- See Note [Error messages for untouchables]\n    do { let msg = important $ misMatchMsg ct oriented ty1 ty2\n             tclvl_extra = important $\n                  nest 2 $\n                  sep [ quotes (ppr tv1) <+> text \"is untouchable\"\n                      , nest 2 $ text \"inside the constraints:\" <+> pprEvVarTheta given\n                      , nest 2 $ text \"bound by\" <+> ppr skol_info\n                      , nest 2 $ text \"at\" <+>\n                        ppr (tcl_loc (implicLclEnv implic)) ]\n             tv_extra = important $ extraTyVarEqInfo ctxt tv1 ty2\n             add_sig  = important $ suggestAddSig ctxt ty1 ty2\n       ; mkErrorMsgFromCt ctxt ct $ mconcat\n            [msg, tclvl_extra, tv_extra, add_sig, report] }\n\n  | otherwise\n  = reportEqErr ctxt report ct oriented (mkTyVarTy tv1) ty2\n        -- This *can* happen (Trac #6123, and test T2627b)\n        -- Consider an ambiguous top-level constraint (a ~ F a)\n        -- Not an occurs check, because F is a type function.\n  where\n    Pair _ k1 = tcCoercionKind co1\n    k2        = tcTypeKind ty2\n\n    ty1 = mkTyVarTy tv1\n    occ_check_expand       = occCheckForErrors dflags tv1 ty2\n    insoluble_occurs_check = isInsolubleOccursCheck (ctEqRel ct) tv1 ty2\n\n    what = case ctLocTypeOrKind_maybe (ctLoc ct) of\n      Just KindLevel -> text \"kind\"\n      _              -> text \"type\"\n\nmkEqInfoMsg :: Ct -> TcType -> TcType -> SDoc\n-- Report (a) ambiguity if either side is a type function application\n--            e.g. F a0 ~ Int\n--        (b) warning about injectivity if both sides are the same\n--            type function application   F a ~ F b\n--            See Note [Non-injective type functions]\nmkEqInfoMsg ct ty1 ty2\n  = tyfun_msg $$ ambig_msg\n  where\n    mb_fun1 = isTyFun_maybe ty1\n    mb_fun2 = isTyFun_maybe ty2\n\n    ambig_msg | isJust mb_fun1 || isJust mb_fun2\n              = snd (mkAmbigMsg False ct)\n              | otherwise = empty\n\n    tyfun_msg | Just tc1 <- mb_fun1\n              , Just tc2 <- mb_fun2\n              , tc1 == tc2\n              , not (isInjectiveTyCon tc1 Nominal)\n              = text \"NB:\" <+> quotes (ppr tc1)\n                <+> text \"is a non-injective type family\"\n              | otherwise = empty\n\nisUserSkolem :: ReportErrCtxt -> TcTyVar -> Bool\n-- See Note [Reporting occurs-check errors]\nisUserSkolem ctxt tv\n  = isSkolemTyVar tv && any is_user_skol_tv (cec_encl ctxt)\n  where\n    is_user_skol_tv (Implic { ic_skols = sks, ic_info = skol_info })\n      = tv `elem` sks && is_user_skol_info skol_info\n\n    is_user_skol_info (InferSkol {}) = False\n    is_user_skol_info _ = True\n\nmisMatchOrCND :: ReportErrCtxt -> Ct\n              -> Maybe SwapFlag -> TcType -> TcType -> SDoc\n-- If oriented then ty1 is actual, ty2 is expected\nmisMatchOrCND ctxt ct oriented ty1 ty2\n  | null givens ||\n    (isRigidTy ty1 && isRigidTy ty2) ||\n    isGivenCt ct\n       -- If the equality is unconditionally insoluble\n       -- or there is no context, don't report the context\n  = misMatchMsg ct oriented ty1 ty2\n  | otherwise\n  = couldNotDeduce givens ([eq_pred], orig)\n  where\n    ev      = ctEvidence ct\n    eq_pred = ctEvPred ev\n    orig    = ctEvOrigin ev\n    givens  = [ given | given <- getUserGivens ctxt, not (ic_no_eqs given)]\n              -- Keep only UserGivens that have some equalities.\n              -- See Note [Suppress redundant givens during error reporting]\n\ncouldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc\ncouldNotDeduce givens (wanteds, orig)\n  = vcat [ addArising orig (text \"Could not deduce:\" <+> pprTheta wanteds)\n         , vcat (pp_givens givens)]\n\npp_givens :: [UserGiven] -> [SDoc]\npp_givens givens\n   = case givens of\n         []     -> []\n         (g:gs) ->      ppr_given (text \"from the context:\") g\n                 : map (ppr_given (text \"or from:\")) gs\n    where\n       ppr_given herald implic@(Implic { ic_given = gs, ic_info = skol_info })\n           = hang (herald <+> pprEvVarTheta (mkMinimalBySCs evVarPred gs))\n             -- See Note [Suppress redundant givens during error reporting]\n             -- for why we use mkMinimalBySCs above.\n                2 (sep [ text \"bound by\" <+> ppr skol_info\n                       , text \"at\" <+> ppr (tcl_loc (implicLclEnv implic)) ])\n\n{-\nNote [Suppress redundant givens during error reporting]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen GHC is unable to solve a constraint and prints out an error message, it\nwill print out what given constraints are in scope to provide some context to\nthe programmer. But we shouldn't print out /every/ given, since some of them\nare not terribly helpful to diagnose type errors. Consider this example:\n\n  foo :: Int :~: Int -> a :~: b -> a :~: c\n  foo Refl Refl = Refl\n\nWhen reporting that GHC can't solve (a ~ c), there are two givens in scope:\n(Int ~ Int) and (a ~ b). But (Int ~ Int) is trivially soluble (i.e.,\nredundant), so it's not terribly useful to report it in an error message.\nTo accomplish this, we discard any Implications that do not bind any\nequalities by filtering the `givens` selected in `misMatchOrCND` (based on\nthe `ic_no_eqs` field of the Implication).\n\nBut this is not enough to avoid all redundant givens! Consider this example,\nfrom #15361:\n\n  goo :: forall (a :: Type) (b :: Type) (c :: Type).\n         a :~~: b -> a :~~: c\n  goo HRefl = HRefl\n\nMatching on HRefl brings the /single/ given (* ~ *, a ~ b) into scope.\nThe (* ~ *) part arises due the kinds of (:~~:) being unified. More\nimportantly, (* ~ *) is redundant, so we'd like not to report it. However,\nthe Implication (* ~ *, a ~ b) /does/ bind an equality (as reported by its\nic_no_eqs field), so the test above will keep it wholesale.\n\nTo refine this given, we apply mkMinimalBySCs on it to extract just the (a ~ b)\npart. This works because mkMinimalBySCs eliminates reflexive equalities in\naddition to superclasses (see Note [Remove redundant provided dicts]\nin TcPatSyn).\n-}\n\nextraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc\n-- Add on extra info about skolem constants\n-- NB: The types themselves are already tidied\nextraTyVarEqInfo ctxt tv1 ty2\n  = extraTyVarInfo ctxt tv1 $$ ty_extra ty2\n  where\n    ty_extra ty = case tcGetTyVar_maybe ty of\n                    Just tv -> extraTyVarInfo ctxt tv\n                    Nothing -> empty\n\nextraTyVarInfo :: ReportErrCtxt -> TcTyVar -> SDoc\nextraTyVarInfo ctxt tv\n  = ASSERT2( isTyVar tv, ppr tv )\n    case tcTyVarDetails tv of\n          SkolemTv {}   -> pprSkols ctxt [tv]\n          RuntimeUnk {} -> quotes (ppr tv) <+> text \"is an interactive-debugger skolem\"\n          MetaTv {}     -> empty\n\nsuggestAddSig :: ReportErrCtxt -> TcType -> TcType -> SDoc\n-- See Note [Suggest adding a type signature]\nsuggestAddSig ctxt ty1 ty2\n  | null inferred_bndrs\n  = empty\n  | [bndr] <- inferred_bndrs\n  = text \"Possible fix: add a type signature for\" <+> quotes (ppr bndr)\n  | otherwise\n  = text \"Possible fix: add type signatures for some or all of\" <+> (ppr inferred_bndrs)\n  where\n    inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2)\n    get_inf ty | Just tv <- tcGetTyVar_maybe ty\n               , isSkolemTyVar tv\n               , (implic, _) : _ <- getSkolemInfo (cec_encl ctxt) [tv]\n               , InferSkol prs <- ic_info implic\n               = map fst prs\n               | otherwise\n               = []\n\n--------------------\nmisMatchMsg :: Ct -> Maybe SwapFlag -> TcType -> TcType -> SDoc\n-- Types are already tidy\n-- If oriented then ty1 is actual, ty2 is expected\nmisMatchMsg ct oriented ty1 ty2\n  | Just NotSwapped <- oriented\n  = misMatchMsg ct (Just IsSwapped) ty2 ty1\n\n  -- These next two cases are when we're about to report, e.g., that\n  -- 'LiftedRep doesn't match 'VoidRep. Much better just to say\n  -- lifted vs. unlifted\n  | isLiftedRuntimeRep ty1\n  = lifted_vs_unlifted\n\n  | isLiftedRuntimeRep ty2\n  = lifted_vs_unlifted\n\n  | otherwise  -- So now we have Nothing or (Just IsSwapped)\n               -- For some reason we treat Nothing like IsSwapped\n  = addArising orig $\n    pprWithExplicitKindsWhenMismatch ty1 ty2 (ctOrigin ct) $\n    sep [ text herald1 <+> quotes (ppr ty1)\n        , nest padding $\n          text herald2 <+> quotes (ppr ty2)\n        , sameOccExtra ty2 ty1 ]\n  where\n    herald1 = conc [ \"Couldn't match\"\n                   , if is_repr     then \"representation of\" else \"\"\n                   , if is_oriented then \"expected\"          else \"\"\n                   , what ]\n    herald2 = conc [ \"with\"\n                   , if is_repr     then \"that of\"           else \"\"\n                   , if is_oriented then (\"actual \" ++ what) else \"\" ]\n    padding = length herald1 - length herald2\n\n    is_repr = case ctEqRel ct of { ReprEq -> True; NomEq -> False }\n    is_oriented = isJust oriented\n\n    orig = ctOrigin ct\n    what = case ctLocTypeOrKind_maybe (ctLoc ct) of\n      Just KindLevel -> \"kind\"\n      _              -> \"type\"\n\n    conc :: [String] -> String\n    conc = foldr1 add_space\n\n    add_space :: String -> String -> String\n    add_space s1 s2 | null s1   = s2\n                    | null s2   = s1\n                    | otherwise = s1 ++ (' ' : s2)\n\n    lifted_vs_unlifted\n      = addArising orig $\n        text \"Couldn't match a lifted type with an unlifted type\"\n\n-- | Prints explicit kinds (with @-fprint-explicit-kinds@) in an 'SDoc' when a\n-- type mismatch occurs to due invisible kind arguments.\n--\n-- This function first checks to see if the 'CtOrigin' argument is a\n-- 'TypeEqOrigin', and if so, uses the expected/actual types from that to\n-- check for a kind mismatch (as these types typically have more surrounding\n-- types and are likelier to be able to glean information about whether a\n-- mismatch occurred in an invisible argument position or not). If the\n-- 'CtOrigin' is not a 'TypeEqOrigin', fall back on the actual mismatched types\n-- themselves.\npprWithExplicitKindsWhenMismatch :: Type -> Type -> CtOrigin\n                                 -> SDoc -> SDoc\npprWithExplicitKindsWhenMismatch ty1 ty2 ct\n  = pprWithExplicitKindsWhen show_kinds\n  where\n    (act_ty, exp_ty) = case ct of\n      TypeEqOrigin { uo_actual = act\n                   , uo_expected = exp } -> (act, exp)\n      _                                  -> (ty1, ty2)\n    show_kinds = tcEqTypeVis act_ty exp_ty\n                 -- True when the visible bit of the types look the same,\n                 -- so we want to show the kinds in the displayed type\n\nmkExpectedActualMsg :: Type -> Type -> CtOrigin -> Maybe TypeOrKind -> Bool\n                    -> (Bool, Maybe SwapFlag, SDoc)\n-- NotSwapped means (actual, expected), IsSwapped is the reverse\n-- First return val is whether or not to print a herald above this msg\nmkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act\n                                             , uo_expected = exp\n                                             , uo_thing = maybe_thing })\n                    m_level printExpanded\n  | KindLevel <- level, occurs_check_error       = (True, Nothing, empty)\n  | isUnliftedTypeKind act, isLiftedTypeKind exp = (False, Nothing, msg2)\n  | isLiftedTypeKind act, isUnliftedTypeKind exp = (False, Nothing, msg3)\n  | tcIsLiftedTypeKind exp                       = (False, Nothing, msg4)\n  | Just msg <- num_args_msg                     = (False, Nothing, msg $$ msg1)\n  | KindLevel <- level, Just th <- maybe_thing   = (False, Nothing, msg5 th)\n  | act `pickyEqType` ty1, exp `pickyEqType` ty2 = (True, Just NotSwapped, empty)\n  | exp `pickyEqType` ty1, act `pickyEqType` ty2 = (True, Just IsSwapped, empty)\n  | otherwise                                    = (True, Nothing, msg1)\n  where\n    level = m_level `orElse` TypeLevel\n\n    occurs_check_error\n      | Just act_tv <- tcGetTyVar_maybe act\n      , act_tv `elemVarSet` tyCoVarsOfType exp\n      = True\n      | Just exp_tv <- tcGetTyVar_maybe exp\n      , exp_tv `elemVarSet` tyCoVarsOfType act\n      = True\n      | otherwise\n      = False\n\n    sort = case level of\n      TypeLevel -> text \"type\"\n      KindLevel -> text \"kind\"\n\n    msg1 = case level of\n      KindLevel\n        | Just th <- maybe_thing\n        -> msg5 th\n\n      _ | not (act `pickyEqType` exp)\n        -> pprWithExplicitKindsWhenMismatch ty1 ty2 ct $\n           vcat [ text \"Expected\" <+> sort <> colon <+> ppr exp\n                , text \"  Actual\" <+> sort <> colon <+> ppr act\n                , if printExpanded then expandedTys else empty ]\n\n        | otherwise\n        -> empty\n\n    thing_msg = case maybe_thing of\n                  Just thing -> \\_ -> quotes thing <+> text \"is\"\n                  Nothing    -> \\vowel -> text \"got a\" <>\n                                          if vowel then char 'n' else empty\n    msg2 = sep [ text \"Expecting a lifted type, but\"\n               , thing_msg True, text \"unlifted\" ]\n    msg3 = sep [ text \"Expecting an unlifted type, but\"\n               , thing_msg False, text \"lifted\" ]\n    msg4 = maybe_num_args_msg $$\n           sep [ text \"Expected a type, but\"\n               , maybe (text \"found something with kind\")\n                       (\\thing -> quotes thing <+> text \"has kind\")\n                       maybe_thing\n               , quotes (pprWithTYPE act) ]\n\n    msg5 th = pprWithExplicitKindsWhenMismatch ty1 ty2 ct $\n              hang (text \"Expected\" <+> kind_desc <> comma)\n                 2 (text \"but\" <+> quotes th <+> text \"has kind\" <+>\n                    quotes (ppr act))\n      where\n        kind_desc | tcIsConstraintKind exp = text \"a constraint\"\n\n                    -- TYPE t0\n                  | Just arg <- kindRep_maybe exp\n                  , tcIsTyVarTy arg = sdocWithDynFlags $ \\dflags ->\n                                      if gopt Opt_PrintExplicitRuntimeReps dflags\n                                      then text \"kind\" <+> quotes (ppr exp)\n                                      else text \"a type\"\n\n                  | otherwise       = text \"kind\" <+> quotes (ppr exp)\n\n    num_args_msg = case level of\n      KindLevel\n        | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act)\n           -- if one is a meta-tyvar, then it's possible that the user\n           -- has asked for something impredicative, and we couldn't unify.\n           -- Don't bother with counting arguments.\n        -> let n_act = count_args act\n               n_exp = count_args exp in\n           case n_act - n_exp of\n             n | n > 0   -- we don't know how many args there are, so don't\n                         -- recommend removing args that aren't\n               , Just thing <- maybe_thing\n               -> Just $ text \"Expecting\" <+> speakN (abs n) <+>\n                         more <+> quotes thing\n               where\n                 more\n                  | n == 1    = text \"more argument to\"\n                  | otherwise = text \"more arguments to\"  -- n > 1\n             _ -> Nothing\n\n      _ -> Nothing\n\n    maybe_num_args_msg = case num_args_msg of\n      Nothing -> empty\n      Just m  -> m\n\n    count_args ty = count isVisibleBinder $ fst $ splitPiTys ty\n\n    expandedTys =\n      ppUnless (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) $ vcat\n        [ text \"Type synonyms expanded:\"\n        , text \"Expected type:\" <+> ppr expTy1\n        , text \"  Actual type:\" <+> ppr expTy2\n        ]\n\n    (expTy1, expTy2) = expandSynonymsToMatch exp act\n\nmkExpectedActualMsg _ _ _ _ _ = panic \"mkExpectedAcutalMsg\"\n\n{- Note [Insoluble occurs check wins]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider [G] a ~ [a],  [W] a ~ [a] (Trac #13674).  The Given is insoluble\nso we don't use it for rewriting.  The Wanted is also insoluble, and\nwe don't solve it from the Given.  It's very confusing to say\n    Cannot solve a ~ [a] from given constraints a ~ [a]\n\nAnd indeed even thinking about the Givens is silly; [W] a ~ [a] is\njust as insoluble as Int ~ Bool.\n\nConclusion: if there's an insoluble occurs check (isInsolubleOccursCheck)\nthen report it first.\n\n(NB: there are potentially-soluble ones, like (a ~ F a b), and we don't\nwant to be as draconian with them.)\n\nNote [Expanding type synonyms to make types similar]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIn type error messages, if -fprint-expanded-types is used, we want to expand\ntype synonyms to make expected and found types as similar as possible, but we\nshouldn't expand types too much to make type messages even more verbose and\nharder to understand. The whole point here is to make the difference in expected\nand found types clearer.\n\n`expandSynonymsToMatch` does this, it takes two types, and expands type synonyms\nonly as much as necessary. Given two types t1 and t2:\n\n  * If they're already same, it just returns the types.\n\n  * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are\n    type constructors), it expands C1 and C2 if they're different type synonyms.\n    Then it recursively does the same thing on expanded types. If C1 and C2 are\n    same, then it applies the same procedure to arguments of C1 and arguments of\n    C2 to make them as similar as possible.\n\n    Most important thing here is to keep number of synonym expansions at\n    minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3,\n    Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and\n    `T (T3, T3, Bool)`.\n\n  * Otherwise types don't have same shapes and so the difference is clearly\n    visible. It doesn't do any expansions and show these types.\n\nNote that we only expand top-layer type synonyms. Only when top-layer\nconstructors are the same we start expanding inner type synonyms.\n\nSuppose top-layer type synonyms of t1 and t2 can expand N and M times,\nrespectively. If their type-synonym-expanded forms will meet at some point (i.e.\nwill have same shapes according to `sameShapes` function), it's possible to find\nwhere they meet in O(N+M) top-layer type synonym expansions and O(min(N,M))\ncomparisons. We first collect all the top-layer expansions of t1 and t2 in two\nlists, then drop the prefix of the longer list so that they have same lengths.\nThen we search through both lists in parallel, and return the first pair of\ntypes that have same shapes. Inner types of these two types with same shapes\nare then expanded using the same algorithm.\n\nIn case they don't meet, we return the last pair of types in the lists, which\nhas top-layer type synonyms completely expanded. (in this case the inner types\nare not expanded at all, as the current form already shows the type error)\n-}\n\n-- | Expand type synonyms in given types only enough to make them as similar as\n-- possible. Returned types are the same in terms of used type synonyms.\n--\n-- To expand all synonyms, see 'Type.expandTypeSynonyms'.\n--\n-- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for\n-- some examples of how this should work.\nexpandSynonymsToMatch :: Type -> Type -> (Type, Type)\nexpandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret)\n  where\n    (ty1_ret, ty2_ret) = go ty1 ty2\n\n    -- | Returns (type synonym expanded version of first type,\n    --            type synonym expanded version of second type)\n    go :: Type -> Type -> (Type, Type)\n    go t1 t2\n      | t1 `pickyEqType` t2 =\n        -- Types are same, nothing to do\n        (t1, t2)\n\n    go (TyConApp tc1 tys1) (TyConApp tc2 tys2)\n      | tc1 == tc2 =\n        -- Type constructors are same. They may be synonyms, but we don't\n        -- expand further.\n        let (tys1', tys2') =\n              unzip (zipWith (\\ty1 ty2 -> go ty1 ty2) tys1 tys2)\n         in (TyConApp tc1 tys1', TyConApp tc2 tys2')\n\n    go (AppTy t1_1 t1_2) (AppTy t2_1 t2_2) =\n      let (t1_1', t2_1') = go t1_1 t2_1\n          (t1_2', t2_2') = go t1_2 t2_2\n       in (mkAppTy t1_1' t1_2', mkAppTy t2_1' t2_2')\n\n    go ty1@(FunTy _ t1_1 t1_2) ty2@(FunTy _ t2_1 t2_2) =\n      let (t1_1', t2_1') = go t1_1 t2_1\n          (t1_2', t2_2') = go t1_2 t2_2\n       in ( ty1 { ft_arg = t1_1', ft_res = t1_2' }\n          , ty2 { ft_arg = t2_1', ft_res = t2_2' })\n\n    go (ForAllTy b1 t1) (ForAllTy b2 t2) =\n      -- NOTE: We may have a bug here, but we just can't reproduce it easily.\n      -- See D1016 comments for details and our attempts at producing a test\n      -- case. Short version: We probably need RnEnv2 to really get this right.\n      let (t1', t2') = go t1 t2\n       in (ForAllTy b1 t1', ForAllTy b2 t2')\n\n    go (CastTy ty1 _) ty2 = go ty1 ty2\n    go ty1 (CastTy ty2 _) = go ty1 ty2\n\n    go t1 t2 =\n      -- See Note [Expanding type synonyms to make types similar] for how this\n      -- works\n      let\n        t1_exp_tys = t1 : tyExpansions t1\n        t2_exp_tys = t2 : tyExpansions t2\n        t1_exps    = length t1_exp_tys\n        t2_exps    = length t2_exp_tys\n        dif        = abs (t1_exps - t2_exps)\n      in\n        followExpansions $\n          zipEqual \"expandSynonymsToMatch.go\"\n            (if t1_exps > t2_exps then drop dif t1_exp_tys else t1_exp_tys)\n            (if t2_exps > t1_exps then drop dif t2_exp_tys else t2_exp_tys)\n\n    -- | Expand the top layer type synonyms repeatedly, collect expansions in a\n    -- list. The list does not include the original type.\n    --\n    -- Example, if you have:\n    --\n    --   type T10 = T9\n    --   type T9  = T8\n    --   ...\n    --   type T0  = Int\n    --\n    -- `tyExpansions T10` returns [T9, T8, T7, ... Int]\n    --\n    -- This only expands the top layer, so if you have:\n    --\n    --   type M a = Maybe a\n    --\n    -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded)\n    tyExpansions :: Type -> [Type]\n    tyExpansions = unfoldr (\\t -> (\\x -> (x, x)) `fmap` tcView t)\n\n    -- | Drop the type pairs until types in a pair look alike (i.e. the outer\n    -- constructors are the same).\n    followExpansions :: [(Type, Type)] -> (Type, Type)\n    followExpansions [] = pprPanic \"followExpansions\" empty\n    followExpansions [(t1, t2)]\n      | sameShapes t1 t2 = go t1 t2 -- expand subtrees\n      | otherwise        = (t1, t2) -- the difference is already visible\n    followExpansions ((t1, t2) : tss)\n      -- Traverse subtrees when the outer shapes are the same\n      | sameShapes t1 t2 = go t1 t2\n      -- Otherwise follow the expansions until they look alike\n      | otherwise = followExpansions tss\n\n    sameShapes :: Type -> Type -> Bool\n    sameShapes AppTy{}          AppTy{}          = True\n    sameShapes (TyConApp tc1 _) (TyConApp tc2 _) = tc1 == tc2\n    sameShapes (FunTy {})       (FunTy {})       = True\n    sameShapes (ForAllTy {})    (ForAllTy {})    = True\n    sameShapes (CastTy ty1 _)   ty2              = sameShapes ty1 ty2\n    sameShapes ty1              (CastTy ty2 _)   = sameShapes ty1 ty2\n    sameShapes _                _                = False\n\nsameOccExtra :: TcType -> TcType -> SDoc\n-- See Note [Disambiguating (X ~ X) errors]\nsameOccExtra ty1 ty2\n  | Just (tc1, _) <- tcSplitTyConApp_maybe ty1\n  , Just (tc2, _) <- tcSplitTyConApp_maybe ty2\n  , let n1 = tyConName tc1\n        n2 = tyConName tc2\n        same_occ = nameOccName n1                   == nameOccName n2\n        same_pkg = moduleUnitId (nameModule n1) == moduleUnitId (nameModule n2)\n  , n1 /= n2   -- Different Names\n  , same_occ   -- but same OccName\n  = text \"NB:\" <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)\n  | otherwise\n  = empty\n  where\n    ppr_from same_pkg nm\n      | isGoodSrcSpan loc\n      = hang (quotes (ppr nm) <+> text \"is defined at\")\n           2 (ppr loc)\n      | otherwise  -- Imported things have an UnhelpfulSrcSpan\n      = hang (quotes (ppr nm))\n           2 (sep [ text \"is defined in\" <+> quotes (ppr (moduleName mod))\n                  , ppUnless (same_pkg || pkg == mainUnitId) $\n                    nest 4 $ text \"in package\" <+> quotes (ppr pkg) ])\n       where\n         pkg = moduleUnitId mod\n         mod = nameModule nm\n         loc = nameSrcSpan nm\n\n{-\nNote [Suggest adding a type signature]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe OutsideIn algorithm rejects GADT programs that don't have a principal\ntype, and indeed some that do.  Example:\n   data T a where\n     MkT :: Int -> T Int\n\n   f (MkT n) = n\n\nDoes this have type f :: T a -> a, or f :: T a -> Int?\nThe error that shows up tends to be an attempt to unify an\nuntouchable type variable.  So suggestAddSig sees if the offending\ntype variable is bound by an *inferred* signature, and suggests\nadding a declared signature instead.\n\nThis initially came up in Trac #8968, concerning pattern synonyms.\n\nNote [Disambiguating (X ~ X) errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee Trac #8278\n\nNote [Reporting occurs-check errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven (a ~ [a]), if 'a' is a rigid type variable bound by a user-supplied\ntype signature, then the best thing is to report that we can't unify\na with [a], because a is a skolem variable.  That avoids the confusing\n\"occur-check\" error message.\n\nBut nowadays when inferring the type of a function with no type signature,\neven if there are errors inside, we still generalise its signature and\ncarry on. For example\n   f x = x:x\nHere we will infer something like\n   f :: forall a. a -> [a]\nwith a deferred error of (a ~ [a]).  So in the deferred unsolved constraint\n'a' is now a skolem, but not one bound by the programmer in the context!\nHere we really should report an occurs check.\n\nSo isUserSkolem distinguishes the two.\n\nNote [Non-injective type functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's very confusing to get a message like\n     Couldn't match expected type `Depend s'\n            against inferred type `Depend s1'\nso mkTyFunInfoMsg adds:\n       NB: `Depend' is type function, and hence may not be injective\n\nWarn of loopy local equalities that were dropped.\n\n\n************************************************************************\n*                                                                      *\n                 Type-class errors\n*                                                                      *\n************************************************************************\n-}\n\nmkDictErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg\nmkDictErr ctxt cts\n  = ASSERT( not (null cts) )\n    do { inst_envs <- tcGetInstEnvs\n       ; let (ct1:_) = cts  -- ct1 just for its location\n             min_cts = elim_superclasses cts\n             lookups = map (lookup_cls_inst inst_envs) min_cts\n             (no_inst_cts, overlap_cts) = partition is_no_inst lookups\n\n       -- Report definite no-instance errors,\n       -- or (iff there are none) overlap errors\n       -- But we report only one of them (hence 'head') because they all\n       -- have the same source-location origin, to try avoid a cascade\n       -- of error from one location\n       ; (ctxt, err) <- mk_dict_err ctxt (head (no_inst_cts ++ overlap_cts))\n       ; mkErrorMsgFromCt ctxt ct1 (important err) }\n  where\n    no_givens = null (getUserGivens ctxt)\n\n    is_no_inst (ct, (matches, unifiers, _))\n      =  no_givens\n      && null matches\n      && (null unifiers || all (not . isAmbiguousTyVar) (tyCoVarsOfCtList ct))\n\n    lookup_cls_inst inst_envs ct\n                -- Note [Flattening in error message generation]\n      = (ct, lookupInstEnv True inst_envs clas (flattenTys emptyInScopeSet tys))\n      where\n        (clas, tys) = getClassPredTys (ctPred ct)\n\n\n    -- When simplifying [W] Ord (Set a), we need\n    --    [W] Eq a, [W] Ord a\n    -- but we really only want to report the latter\n    elim_superclasses cts = mkMinimalBySCs ctPred cts\n\nmk_dict_err :: ReportErrCtxt -> (Ct, ClsInstLookupResult)\n            -> TcM (ReportErrCtxt, SDoc)\n-- Report an overlap error if this class constraint results\n-- from an overlap (returning Left clas), otherwise return (Right pred)\nmk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_overlapped))\n  | null matches  -- No matches but perhaps several unifiers\n  = do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct\n       ; candidate_insts <- get_candidate_instances\n       ; return (ctxt, cannot_resolve_msg ct candidate_insts binds_msg) }\n\n  | null unsafe_overlapped   -- Some matches => overlap errors\n  = return (ctxt, overlap_msg)\n\n  | otherwise\n  = return (ctxt, safe_haskell_msg)\n  where\n    orig          = ctOrigin ct\n    pred          = ctPred ct\n    (clas, tys)   = getClassPredTys pred\n    ispecs        = [ispec | (ispec, _) <- matches]\n    unsafe_ispecs = [ispec | (ispec, _) <- unsafe_overlapped]\n    useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics)\n         -- useful_givens are the enclosing implications with non-empty givens,\n         -- modulo the horrid discardProvCtxtGivens\n\n    get_candidate_instances :: TcM [ClsInst]\n    -- See Note [Report candidate instances]\n    get_candidate_instances\n      | [ty] <- tys   -- Only try for single-parameter classes\n      = do { instEnvs <- tcGetInstEnvs\n           ; return (filter (is_candidate_inst ty)\n                            (classInstances instEnvs clas)) }\n      | otherwise = return []\n\n    is_candidate_inst ty inst -- See Note [Report candidate instances]\n      | [other_ty] <- is_tys inst\n      , Just (tc1, _) <- tcSplitTyConApp_maybe ty\n      , Just (tc2, _) <- tcSplitTyConApp_maybe other_ty\n      = let n1 = tyConName tc1\n            n2 = tyConName tc2\n            different_names = n1 /= n2\n            same_occ_names = nameOccName n1 == nameOccName n2\n        in different_names && same_occ_names\n      | otherwise = False\n\n    cannot_resolve_msg :: Ct -> [ClsInst] -> SDoc -> SDoc\n    cannot_resolve_msg ct candidate_insts binds_msg\n      = vcat [ no_inst_msg\n             , nest 2 extra_note\n             , vcat (pp_givens useful_givens)\n             , mb_patsyn_prov `orElse` empty\n             , ppWhen (has_ambig_tvs && not (null unifiers && null useful_givens))\n               (vcat [ ppUnless lead_with_ambig ambig_msg, binds_msg, potential_msg ])\n\n             , ppWhen (isNothing mb_patsyn_prov) $\n                   -- Don't suggest fixes for the provided context of a pattern\n                   -- synonym; the right fix is to bind more in the pattern\n               show_fixes (ctxtFixes has_ambig_tvs pred implics\n                           ++ drv_fixes)\n             , ppWhen (not (null candidate_insts))\n               (hang (text \"There are instances for similar types:\")\n                   2 (vcat (map ppr candidate_insts))) ]\n                   -- See Note [Report candidate instances]\n      where\n        orig = ctOrigin ct\n        -- See Note [Highlighting ambiguous type variables]\n        lead_with_ambig = has_ambig_tvs && not (any isRuntimeUnkSkol ambig_tvs)\n                        && not (null unifiers) && null useful_givens\n\n        (has_ambig_tvs, ambig_msg) = mkAmbigMsg lead_with_ambig ct\n        ambig_tvs = uncurry (++) (getAmbigTkvs ct)\n\n        no_inst_msg\n          | lead_with_ambig\n          = ambig_msg <+> pprArising orig\n              $$ text \"prevents the constraint\" <+>  quotes (pprParendType pred)\n              <+> text \"from being solved.\"\n\n          | null useful_givens\n          = addArising orig $ text \"No instance for\"\n            <+> pprParendType pred\n\n          | otherwise\n          = addArising orig $ text \"Could not deduce\"\n            <+> pprParendType pred\n\n        potential_msg\n          = ppWhen (not (null unifiers) && want_potential orig) $\n            sdocWithDynFlags $ \\dflags ->\n            getPprStyle $ \\sty ->\n            pprPotentials dflags sty potential_hdr unifiers\n\n        potential_hdr\n          = vcat [ ppWhen lead_with_ambig $\n                     text \"Probable fix: use a type annotation to specify what\"\n                     <+> pprQuotedList ambig_tvs <+> text \"should be.\"\n                 , text \"These potential instance\" <> plural unifiers\n                   <+> text \"exist:\"]\n\n        mb_patsyn_prov :: Maybe SDoc\n        mb_patsyn_prov\n          | not lead_with_ambig\n          , ProvCtxtOrigin PSB{ psb_def = (dL->L _ pat) } <- orig\n          = Just (vcat [ text \"In other words, a successful match on the pattern\"\n                       , nest 2 $ ppr pat\n                       , text \"does not provide the constraint\" <+> pprParendType pred ])\n          | otherwise = Nothing\n\n    -- Report \"potential instances\" only when the constraint arises\n    -- directly from the user's use of an overloaded function\n    want_potential (TypeEqOrigin {}) = False\n    want_potential _                 = True\n\n    extra_note | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys)\n               = text \"(maybe you haven't applied a function to enough arguments?)\"\n               | className clas == typeableClassName  -- Avoid mysterious \"No instance for (Typeable T)\n               , [_,ty] <- tys                        -- Look for (Typeable (k->*) (T k))\n               , Just (tc,_) <- tcSplitTyConApp_maybe ty\n               , not (isTypeFamilyTyCon tc)\n               = hang (text \"GHC can't yet do polykinded\")\n                    2 (text \"Typeable\" <+>\n                       parens (ppr ty <+> dcolon <+> ppr (tcTypeKind ty)))\n               | otherwise\n               = empty\n\n    drv_fixes = case orig of\n                   DerivClauseOrigin                  -> [drv_fix False]\n                   StandAloneDerivOrigin              -> [drv_fix True]\n                   DerivOriginDC _ _       standalone -> [drv_fix standalone]\n                   DerivOriginCoerce _ _ _ standalone -> [drv_fix standalone]\n                   _                -> []\n\n    drv_fix standalone_wildcard\n      | standalone_wildcard\n      = text \"fill in the wildcard constraint yourself\"\n      | otherwise\n      = hang (text \"use a standalone 'deriving instance' declaration,\")\n           2 (text \"so you can specify the instance context yourself\")\n\n    -- Normal overlap error\n    overlap_msg\n      = ASSERT( not (null matches) )\n        vcat [  addArising orig (text \"Overlapping instances for\"\n                                <+> pprType (mkClassPred clas tys))\n\n             ,  ppUnless (null matching_givens) $\n                  sep [text \"Matching givens (or their superclasses):\"\n                      , nest 2 (vcat matching_givens)]\n\n             ,  sdocWithDynFlags $ \\dflags ->\n                getPprStyle $ \\sty ->\n                pprPotentials dflags sty (text \"Matching instances:\") $\n                ispecs ++ unifiers\n\n             ,  ppWhen (null matching_givens && isSingleton matches && null unifiers) $\n                -- Intuitively, some given matched the wanted in their\n                -- flattened or rewritten (from given equalities) form\n                -- but the matcher can't figure that out because the\n                -- constraints are non-flat and non-rewritten so we\n                -- simply report back the whole given\n                -- context. Accelerate Smart.hs showed this problem.\n                  sep [ text \"There exists a (perhaps superclass) match:\"\n                      , nest 2 (vcat (pp_givens useful_givens))]\n\n             ,  ppWhen (isSingleton matches) $\n                parens (vcat [ text \"The choice depends on the instantiation of\" <+>\n                                  quotes (pprWithCommas ppr (tyCoVarsOfTypesList tys))\n                             , ppWhen (null (matching_givens)) $\n                               vcat [ text \"To pick the first instance above, use IncoherentInstances\"\n                                    , text \"when compiling the other instance declarations\"]\n                        ])]\n\n    matching_givens = mapMaybe matchable useful_givens\n\n    matchable implic@(Implic { ic_given = evvars, ic_info = skol_info })\n      = case ev_vars_matching of\n             [] -> Nothing\n             _  -> Just $ hang (pprTheta ev_vars_matching)\n                            2 (sep [ text \"bound by\" <+> ppr skol_info\n                                   , text \"at\" <+>\n                                     ppr (tcl_loc (implicLclEnv implic)) ])\n        where ev_vars_matching = filter ev_var_matches (map evVarPred evvars)\n              ev_var_matches ty = case getClassPredTys_maybe ty of\n                 Just (clas', tys')\n                   | clas' == clas\n                   , Just _ <- tcMatchTys tys tys'\n                   -> True\n                   | otherwise\n                   -> any ev_var_matches (immSuperClasses clas' tys')\n                 Nothing -> False\n\n    -- Overlap error because of Safe Haskell (first\n    -- match should be the most specific match)\n    safe_haskell_msg\n     = ASSERT( matches `lengthIs` 1 && not (null unsafe_ispecs) )\n       vcat [ addArising orig (text \"Unsafe overlapping instances for\"\n                       <+> pprType (mkClassPred clas tys))\n            , sep [text \"The matching instance is:\",\n                   nest 2 (pprInstance $ head ispecs)]\n            , vcat [ text \"It is compiled in a Safe module and as such can only\"\n                   , text \"overlap instances from the same module, however it\"\n                   , text \"overlaps the following instances from different\" <+>\n                     text \"modules:\"\n                   , nest 2 (vcat [pprInstances $ unsafe_ispecs])\n                   ]\n            ]\n\n\nctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc]\nctxtFixes has_ambig_tvs pred implics\n  | not has_ambig_tvs\n  , isTyVarClassPred pred\n  , (skol:skols) <- usefulContext implics pred\n  , let what | null skols\n             , SigSkol (PatSynCtxt {}) _ _ <- skol\n             = text \"\\\"required\\\"\"\n             | otherwise\n             = empty\n  = [sep [ text \"add\" <+> pprParendType pred\n           <+> text \"to the\" <+> what <+> text \"context of\"\n         , nest 2 $ ppr_skol skol $$\n                    vcat [ text \"or\" <+> ppr_skol skol\n                         | skol <- skols ] ] ]\n  | otherwise = []\n  where\n    ppr_skol (PatSkol (RealDataCon dc) _) = text \"the data constructor\" <+> quotes (ppr dc)\n    ppr_skol (PatSkol (PatSynCon ps)   _) = text \"the pattern synonym\"  <+> quotes (ppr ps)\n    ppr_skol skol_info = ppr skol_info\n\ndiscardProvCtxtGivens :: CtOrigin -> [UserGiven] -> [UserGiven]\ndiscardProvCtxtGivens orig givens  -- See Note [discardProvCtxtGivens]\n  | ProvCtxtOrigin (PSB {psb_id = (dL->L _ name)}) <- orig\n  = filterOut (discard name) givens\n  | otherwise\n  = givens\n  where\n    discard n (Implic { ic_info = SigSkol (PatSynCtxt n') _ _ }) = n == n'\n    discard _ _                                                  = False\n\nusefulContext :: [Implication] -> PredType -> [SkolemInfo]\n-- usefulContext picks out the implications whose context\n-- the programmer might plausibly augment to solve 'pred'\nusefulContext implics pred\n  = go implics\n  where\n    pred_tvs = tyCoVarsOfType pred\n    go [] = []\n    go (ic : ics)\n       | implausible ic = rest\n       | otherwise      = ic_info ic : rest\n       where\n          -- Stop when the context binds a variable free in the predicate\n          rest | any (`elemVarSet` pred_tvs) (ic_skols ic) = []\n               | otherwise                                 = go ics\n\n    implausible ic\n      | null (ic_skols ic)            = True\n      | implausible_info (ic_info ic) = True\n      | otherwise                     = False\n\n    implausible_info (SigSkol (InfSigCtxt {}) _ _) = True\n    implausible_info _                             = False\n    -- Do not suggest adding constraints to an *inferred* type signature\n\n{- Note [Report candidate instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have an unsolved (Num Int), where `Int` is not the Prelude Int,\nbut comes from some other module, then it may be helpful to point out\nthat there are some similarly named instances elsewhere.  So we get\nsomething like\n    No instance for (Num Int) arising from the literal \u00e2\u20ac\u02dc3\u00e2\u20ac\u2122\n    There are instances for similar types:\n      instance Num GHC.Types.Int -- Defined in \u00e2\u20ac\u02dcGHC.Num\u00e2\u20ac\u2122\nDiscussion in Trac #9611.\n\nNote [Highlighting ambiguous type variables]\n~-------------------------------------------\nWhen we encounter ambiguous type variables (i.e. type variables\nthat remain metavariables after type inference), we need a few more\nconditions before we can reason that *ambiguity* prevents constraints\nfrom being solved:\n  - We can't have any givens, as encountering a typeclass error\n    with given constraints just means we couldn't deduce\n    a solution satisfying those constraints and as such couldn't\n    bind the type variable to a known type.\n  - If we don't have any unifiers, we don't even have potential\n    instances from which an ambiguity could arise.\n  - Lastly, I don't want to mess with error reporting for\n    unknown runtime types so we just fall back to the old message there.\nOnce these conditions are satisfied, we can safely say that ambiguity prevents\nthe constraint from being solved.\n\nNote [discardProvCtxtGivens]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn most situations we call all enclosing implications \"useful\". There is one\nexception, and that is when the constraint that causes the error is from the\n\"provided\" context of a pattern synonym declaration:\n\n  pattern Pat :: (Num a, Eq a) => Show a   => a -> Maybe a\n             --  required      => provided => type\n  pattern Pat x <- (Just x, 4)\n\nWhen checking the pattern RHS we must check that it does actually bind all\nthe claimed \"provided\" constraints; in this case, does the pattern (Just x, 4)\nbind the (Show a) constraint.  Answer: no!\n\nBut the implication we generate for this will look like\n   forall a. (Num a, Eq a) => [W] Show a\nbecause when checking the pattern we must make the required\nconstraints available, since they are needed to match the pattern (in\nthis case the literal '4' needs (Num a, Eq a)).\n\nBUT we don't want to suggest adding (Show a) to the \"required\" constraints\nof the pattern synonym, thus:\n  pattern Pat :: (Num a, Eq a, Show a) => Show a => a -> Maybe a\nIt would then typecheck but it's silly.  We want the /pattern/ to bind\nthe alleged \"provided\" constraints, Show a.\n\nSo we suppress that Implication in discardProvCtxtGivens.  It's\npainfully ad-hoc but the truth is that adding it to the \"required\"\nconstraints would work.  Suprressing it solves two problems.  First,\nwe never tell the user that we could not deduce a \"provided\"\nconstraint from the \"required\" context. Second, we never give a\npossible fix that suggests to add a \"provided\" constraint to the\n\"required\" context.\n\nFor example, without this distinction the above code gives a bad error\nmessage (showing both problems):\n\n  error: Could not deduce (Show a) ... from the context: (Eq a)\n         ... Possible fix: add (Show a) to the context of\n         the signature for pattern synonym `Pat' ...\n\n-}\n\nshow_fixes :: [SDoc] -> SDoc\nshow_fixes []     = empty\nshow_fixes (f:fs) = sep [ text \"Possible fix:\"\n                        , nest 2 (vcat (f : map (text \"or\" <+>) fs))]\n\npprPotentials :: DynFlags -> PprStyle -> SDoc -> [ClsInst] -> SDoc\n-- See Note [Displaying potential instances]\npprPotentials dflags sty herald insts\n  | null insts\n  = empty\n\n  | null show_these\n  = hang herald\n       2 (vcat [ not_in_scope_msg empty\n               , flag_hint ])\n\n  | otherwise\n  = hang herald\n       2 (vcat [ pprInstances show_these\n               , ppWhen (n_in_scope_hidden > 0) $\n                 text \"...plus\"\n                   <+> speakNOf n_in_scope_hidden (text \"other\")\n               , not_in_scope_msg (text \"...plus\")\n               , flag_hint ])\n  where\n    n_show = 3 :: Int\n    show_potentials = gopt Opt_PrintPotentialInstances dflags\n\n    (in_scope, not_in_scope) = partition inst_in_scope insts\n    sorted = sortBy fuzzyClsInstCmp in_scope\n    show_these | show_potentials = sorted\n               | otherwise       = take n_show sorted\n    n_in_scope_hidden = length sorted - length show_these\n\n       -- \"in scope\" means that all the type constructors\n       -- are lexically in scope; these instances are likely\n       -- to be more useful\n    inst_in_scope :: ClsInst -> Bool\n    inst_in_scope cls_inst = nameSetAll name_in_scope $\n                             orphNamesOfTypes (is_tys cls_inst)\n\n    name_in_scope name\n      | isBuiltInSyntax name\n      = True -- E.g. (->)\n      | Just mod <- nameModule_maybe name\n      = qual_in_scope (qualName sty mod (nameOccName name))\n      | otherwise\n      = True\n\n    qual_in_scope :: QualifyName -> Bool\n    qual_in_scope NameUnqual    = True\n    qual_in_scope (NameQual {}) = True\n    qual_in_scope _             = False\n\n    not_in_scope_msg herald\n      | null not_in_scope\n      = empty\n      | otherwise\n      = hang (herald <+> speakNOf (length not_in_scope) (text \"instance\")\n                     <+> text \"involving out-of-scope types\")\n           2 (ppWhen show_potentials (pprInstances not_in_scope))\n\n    flag_hint = ppUnless (show_potentials || equalLength show_these insts) $\n                text \"(use -fprint-potential-instances to see them all)\"\n\n{- Note [Displaying potential instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen showing a list of instances for\n  - overlapping instances (show ones that match)\n  - no such instance (show ones that could match)\nwe want to give it a bit of structure.  Here's the plan\n\n* Say that an instance is \"in scope\" if all of the\n  type constructors it mentions are lexically in scope.\n  These are the ones most likely to be useful to the programmer.\n\n* Show at most n_show in-scope instances,\n  and summarise the rest (\"plus 3 others\")\n\n* Summarise the not-in-scope instances (\"plus 4 not in scope\")\n\n* Add the flag -fshow-potential-instances which replaces the\n  summary with the full list\n-}\n\n{-\nNote [Flattening in error message generation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (C (Maybe (F x))), where F is a type function, and we have\ninstances\n                C (Maybe Int) and C (Maybe a)\nSince (F x) might turn into Int, this is an overlap situation, and\nindeed (because of flattening) the main solver will have refrained\nfrom solving.  But by the time we get to error message generation, we've\nun-flattened the constraint.  So we must *re*-flatten it before looking\nup in the instance environment, lest we only report one matching\ninstance when in fact there are two.\n\nRe-flattening is pretty easy, because we don't need to keep track of\nevidence.  We don't re-use the code in TcCanonical because that's in\nthe TcS monad, and we are in TcM here.\n\nNote [Kind arguments in error messages]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt can be terribly confusing to get an error message like (Trac #9171)\n\n    Couldn't match expected type \u00e2\u20ac\u02dcGetParam Base (GetParam Base Int)\u00e2\u20ac\u2122\n                with actual type \u00e2\u20ac\u02dcGetParam Base (GetParam Base Int)\u00e2\u20ac\u2122\n\nThe reason may be that the kinds don't match up.  Typically you'll get\nmore useful information, but not when it's as a result of ambiguity.\n\nTo mitigate this, GHC attempts to enable the -fprint-explicit-kinds flag\nwhenever any error message arises due to a kind mismatch. This means that\nthe above error message would instead be displayed as:\n\n    Couldn't match expected type\n                  \u00e2\u20ac\u02dcGetParam @* @k2 @* Base (GetParam @* @* @k2 Base Int)\u00e2\u20ac\u2122\n                with actual type\n                  \u00e2\u20ac\u02dcGetParam @* @k20 @* Base (GetParam @* @* @k20 Base Int)\u00e2\u20ac\u2122\n\nWhich makes it clearer that the culprit is the mismatch between `k2` and `k20`.\n-}\n\nmkAmbigMsg :: Bool -- True when message has to be at beginning of sentence\n           -> Ct -> (Bool, SDoc)\nmkAmbigMsg prepend_msg ct\n  | null ambig_kvs && null ambig_tvs = (False, empty)\n  | otherwise                        = (True,  msg)\n  where\n    (ambig_kvs, ambig_tvs) = getAmbigTkvs ct\n\n    msg |  any isRuntimeUnkSkol ambig_kvs  -- See Note [Runtime skolems]\n        || any isRuntimeUnkSkol ambig_tvs\n        = vcat [ text \"Cannot resolve unknown runtime type\"\n                 <> plural ambig_tvs <+> pprQuotedList ambig_tvs\n               , text \"Use :print or :force to determine these types\"]\n\n        | not (null ambig_tvs)\n        = pp_ambig (text \"type\") ambig_tvs\n\n        | otherwise\n        = pp_ambig (text \"kind\") ambig_kvs\n\n    pp_ambig what tkvs\n      | prepend_msg -- \"Ambiguous type variable 't0'\"\n      = text \"Ambiguous\" <+> what <+> text \"variable\"\n        <> plural tkvs <+> pprQuotedList tkvs\n\n      | otherwise -- \"The type variable 't0' is ambiguous\"\n      = text \"The\" <+> what <+> text \"variable\" <> plural tkvs\n        <+> pprQuotedList tkvs <+> is_or_are tkvs <+> text \"ambiguous\"\n\n    is_or_are [_] = text \"is\"\n    is_or_are _   = text \"are\"\n\npprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc\npprSkols ctxt tvs\n  = vcat (map pp_one (getSkolemInfo (cec_encl ctxt) tvs))\n  where\n    pp_one (Implic { ic_info = skol_info }, tvs)\n      | UnkSkol <- skol_info\n      = hang (pprQuotedList tvs)\n           2 (is_or_are tvs \"an\" \"unknown\")\n      | otherwise\n      = vcat [ hang (pprQuotedList tvs)\n                  2 (is_or_are tvs \"a\"  \"rigid\" <+> text \"bound by\")\n             , nest 2 (pprSkolInfo skol_info)\n             , nest 2 (text \"at\" <+> ppr (foldr1 combineSrcSpans (map getSrcSpan tvs))) ]\n\n    is_or_are [_] article adjective = text \"is\" <+> text article <+> text adjective\n                                      <+> text \"type variable\"\n    is_or_are _   _       adjective = text \"are\" <+> text adjective\n                                      <+> text \"type variables\"\n\ngetAmbigTkvs :: Ct -> ([Var],[Var])\ngetAmbigTkvs ct\n  = partition (`elemVarSet` dep_tkv_set) ambig_tkvs\n  where\n    tkvs       = tyCoVarsOfCtList ct\n    ambig_tkvs = filter isAmbiguousTyVar tkvs\n    dep_tkv_set = tyCoVarsOfTypes (map tyVarKind tkvs)\n\ngetSkolemInfo :: [Implication] -> [TcTyVar]\n              -> [(Implication, [TcTyVar])]\n-- Get the skolem info for some type variables\n-- from the implication constraints that bind them\n--\n-- In the returned (implic, tvs) pairs, the 'tvs' part is non-empty\ngetSkolemInfo _ []\n  = []\n\ngetSkolemInfo [] tvs\n  = pprPanic \"No skolem info:\" (ppr tvs)\n\ngetSkolemInfo (implic:implics) tvs\n  | null tvs_here =                      getSkolemInfo implics tvs\n  | otherwise     = (implic, tvs_here) : getSkolemInfo implics tvs_other\n  where\n    (tvs_here, tvs_other) = partition (`elem` ic_skols implic) tvs\n\n-----------------------\n-- relevantBindings looks at the value environment and finds values whose\n-- types mention any of the offending type variables.  It has to be\n-- careful to zonk the Id's type first, so it has to be in the monad.\n-- We must be careful to pass it a zonked type variable, too.\n--\n-- We always remove closed top-level bindings, though,\n-- since they are never relevant (cf Trac #8233)\n\nrelevantBindings :: Bool  -- True <=> filter by tyvar; False <=> no filtering\n                          -- See Trac #8191\n                 -> ReportErrCtxt -> Ct\n                 -> TcM (ReportErrCtxt, SDoc, Ct)\n-- Also returns the zonked and tidied CtOrigin of the constraint\nrelevantBindings want_filtering ctxt ct\n  = do { dflags <- getDynFlags\n       ; (env1, tidy_orig) <- zonkTidyOrigin (cec_tidy ctxt) (ctLocOrigin loc)\n       ; let ct_tvs = tyCoVarsOfCt ct `unionVarSet` extra_tvs\n\n             -- For *kind* errors, report the relevant bindings of the\n             -- enclosing *type* equality, because that's more useful for the programmer\n             extra_tvs = case tidy_orig of\n                             KindEqOrigin t1 m_t2 _ _ -> tyCoVarsOfTypes $\n                                                         t1 : maybeToList m_t2\n                             _                        -> emptyVarSet\n       ; traceTc \"relevantBindings\" $\n           vcat [ ppr ct\n                , pprCtOrigin (ctLocOrigin loc)\n                , ppr ct_tvs\n                , pprWithCommas id [ ppr id <+> dcolon <+> ppr (idType id)\n                                   | TcIdBndr id _ <- tcl_bndrs lcl_env ]\n                , pprWithCommas id\n                    [ ppr id | TcIdBndr_ExpType id _ _ <- tcl_bndrs lcl_env ] ]\n\n       ; (tidy_env', docs, discards)\n              <- go dflags env1 ct_tvs (maxRelevantBinds dflags)\n                    emptyVarSet [] False\n                    (removeBindingShadowing $ tcl_bndrs lcl_env)\n         -- tcl_bndrs has the innermost bindings first,\n         -- which are probably the most relevant ones\n\n       ; let doc = ppUnless (null docs) $\n                   hang (text \"Relevant bindings include\")\n                      2 (vcat docs $$ ppWhen discards discardMsg)\n\n             -- Put a zonked, tidied CtOrigin into the Ct\n             loc'  = setCtLocOrigin loc tidy_orig\n             ct'   = setCtLoc ct loc'\n             ctxt' = ctxt { cec_tidy = tidy_env' }\n\n       ; return (ctxt', doc, ct') }\n  where\n    ev      = ctEvidence ct\n    loc     = ctEvLoc ev\n    lcl_env = ctLocEnv loc\n\n    run_out :: Maybe Int -> Bool\n    run_out Nothing = False\n    run_out (Just n) = n <= 0\n\n    dec_max :: Maybe Int -> Maybe Int\n    dec_max = fmap (\\n -> n - 1)\n\n\n    go :: DynFlags -> TidyEnv -> TcTyVarSet -> Maybe Int -> TcTyVarSet -> [SDoc]\n       -> Bool                          -- True <=> some filtered out due to lack of fuel\n       -> [TcBinder]\n       -> TcM (TidyEnv, [SDoc], Bool)   -- The bool says if we filtered any out\n                                        -- because of lack of fuel\n    go _ tidy_env _ _ _ docs discards []\n      = return (tidy_env, reverse docs, discards)\n    go dflags tidy_env ct_tvs n_left tvs_seen docs discards (tc_bndr : tc_bndrs)\n      = case tc_bndr of\n          TcTvBndr {} -> discard_it\n          TcIdBndr id top_lvl -> go2 (idName id) (idType id) top_lvl\n          TcIdBndr_ExpType name et top_lvl ->\n            do { mb_ty <- readExpType_maybe et\n                   -- et really should be filled in by now. But there's a chance\n                   -- it hasn't, if, say, we're reporting a kind error en route to\n                   -- checking a term. See test indexed-types/should_fail/T8129\n                   -- Or we are reporting errors from the ambiguity check on\n                   -- a local type signature\n               ; case mb_ty of\n                   Just ty -> go2 name ty top_lvl\n                   Nothing -> discard_it  -- No info; discard\n               }\n      where\n        discard_it = go dflags tidy_env ct_tvs n_left tvs_seen docs\n                        discards tc_bndrs\n        go2 id_name id_type top_lvl\n          = do { (tidy_env', tidy_ty) <- zonkTidyTcType tidy_env id_type\n               ; traceTc \"relevantBindings 1\" (ppr id_name <+> dcolon <+> ppr tidy_ty)\n               ; let id_tvs = tyCoVarsOfType tidy_ty\n                     doc = sep [ pprPrefixOcc id_name <+> dcolon <+> ppr tidy_ty\n                               , nest 2 (parens (text \"bound at\"\n                                    <+> ppr (getSrcLoc id_name)))]\n                     new_seen = tvs_seen `unionVarSet` id_tvs\n\n               ; if (want_filtering && not (hasPprDebug dflags)\n                                    && id_tvs `disjointVarSet` ct_tvs)\n                          -- We want to filter out this binding anyway\n                          -- so discard it silently\n                 then discard_it\n\n                 else if isTopLevel top_lvl && not (isNothing n_left)\n                          -- It's a top-level binding and we have not specified\n                          -- -fno-max-relevant-bindings, so discard it silently\n                 then discard_it\n\n                 else if run_out n_left && id_tvs `subVarSet` tvs_seen\n                          -- We've run out of n_left fuel and this binding only\n                          -- mentions already-seen type variables, so discard it\n                 then go dflags tidy_env ct_tvs n_left tvs_seen docs\n                         True      -- Record that we have now discarded something\n                         tc_bndrs\n\n                          -- Keep this binding, decrement fuel\n                 else go dflags tidy_env' ct_tvs (dec_max n_left) new_seen\n                         (doc:docs) discards tc_bndrs }\n\n\ndiscardMsg :: SDoc\ndiscardMsg = text \"(Some bindings suppressed;\" <+>\n             text \"use -fmax-relevant-binds=N or -fno-max-relevant-binds)\"\n\n-----------------------\nwarnDefaulting :: [Ct] -> Type -> TcM ()\nwarnDefaulting wanteds default_ty\n  = do { warn_default <- woptM Opt_WarnTypeDefaults\n       ; env0 <- tcInitTidyEnv\n       ; let tidy_env = tidyFreeTyCoVars env0 $\n                        tyCoVarsOfCtsList (listToBag wanteds)\n             tidy_wanteds = map (tidyCt tidy_env) wanteds\n             (loc, ppr_wanteds) = pprWithArising tidy_wanteds\n             warn_msg =\n                hang (hsep [ text \"Defaulting the following\"\n                           , text \"constraint\" <> plural tidy_wanteds\n                           , text \"to type\"\n                           , quotes (ppr default_ty) ])\n                     2\n                     ppr_wanteds\n       ; setCtLocM loc $ warnTc (Reason Opt_WarnTypeDefaults) warn_default warn_msg }\n\n{-\nNote [Runtime skolems]\n~~~~~~~~~~~~~~~~~~~~~~\nWe want to give a reasonably helpful error message for ambiguity\narising from *runtime* skolems in the debugger.  These\nare created by in RtClosureInspect.zonkRTTIType.\n\n************************************************************************\n*                                                                      *\n                 Error from the canonicaliser\n         These ones are called *during* constraint simplification\n*                                                                      *\n************************************************************************\n-}\n\nsolverDepthErrorTcS :: CtLoc -> TcType -> TcM a\nsolverDepthErrorTcS loc ty\n  = setCtLocM loc $\n    do { ty <- zonkTcType ty\n       ; env0 <- tcInitTidyEnv\n       ; let tidy_env     = tidyFreeTyCoVars env0 (tyCoVarsOfTypeList ty)\n             tidy_ty      = tidyType tidy_env ty\n             msg\n               = vcat [ text \"Reduction stack overflow; size =\" <+> ppr depth\n                      , hang (text \"When simplifying the following type:\")\n                           2 (ppr tidy_ty)\n                      , note ]\n       ; failWithTcM (tidy_env, msg) }\n  where\n    depth = ctLocDepth loc\n    note = vcat\n      [ text \"Use -freduction-depth=0 to disable this check\"\n      , text \"(any upper bound you could choose might fail unpredictably with\"\n      , text \" minor updates to GHC, so disabling the check is recommended if\"\n      , text \" you're sure that type checking should terminate)\" ]\n", "num_lines": 3113}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n\n{-# LANGUAGE CPP, DeriveDataTypeable #-}\n\nmodule TcEvidence (\n\n  -- HsWrapper\n  HsWrapper(..),\n  (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams,\n  mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders,\n  mkWpFun, mkWpFuns, idHsWrapper, isIdHsWrapper, pprHsWrapper,\n\n  -- Evidence bindings\n  TcEvBinds(..), EvBindsVar(..),\n  EvBindMap(..), emptyEvBindMap, extendEvBinds,\n  lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap,\n  isEmptyEvBindMap,\n  EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,\n  evBindVar, isCoEvBindsVar,\n\n  -- EvTerm (already a CoreExpr)\n  EvTerm(..), EvExpr,\n  evId, evCoercion, evCast, evDFunApp,  evDataConApp, evSelector,\n  mkEvCast, evVarsOfTerm, mkEvScSelectors, evTypeable, findNeededEvVars,\n\n  evTermCoercion, evTermCoercion_maybe,\n  EvCallStack(..),\n  EvTypeable(..),\n\n  -- TcCoercion\n  TcCoercion, TcCoercionR, TcCoercionN, TcCoercionP, CoercionHole,\n  Role(..), LeftOrRight(..), pickLR,\n  mkTcReflCo, mkTcNomReflCo, mkTcRepReflCo,\n  mkTcTyConAppCo, mkTcAppCo, mkTcFunCo,\n  mkTcAxInstCo, mkTcUnbranchedAxInstCo, mkTcForAllCo, mkTcForAllCos,\n  mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcSubCo, maybeTcSubCo,\n  tcDowngradeRole,\n  mkTcAxiomRuleCo, mkTcGReflRightCo, mkTcGReflLeftCo, mkTcPhantomCo,\n  mkTcCoherenceLeftCo,\n  mkTcCoherenceRightCo,\n  mkTcKindCo,\n  tcCoercionKind, coVarsOfTcCo,\n  mkTcCoVarCo,\n  isTcReflCo, isTcReflexiveCo,\n  tcCoercionRole,\n  unwrapIP, wrapIP\n  ) where\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Var\nimport CoAxiom\nimport Coercion\nimport PprCore ()   -- Instance OutputableBndr TyVar\nimport TcType\nimport Type\nimport TyCon\nimport DataCon( DataCon, dataConWrapId )\nimport Class( Class )\nimport PrelNames\nimport DynFlags   ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) )\nimport VarEnv\nimport VarSet\nimport Name\nimport Pair\n\nimport CoreSyn\nimport Class ( classSCSelId )\nimport Id ( isEvVar )\nimport CoreFVs ( exprSomeFreeVars )\n\nimport Util\nimport Bag\nimport qualified Data.Data as Data\nimport Outputable\nimport SrcLoc\nimport Data.IORef( IORef )\nimport UniqSet\n\n{-\nNote [TcCoercions]\n~~~~~~~~~~~~~~~~~~\n| TcCoercions are a hack used by the typechecker. Normally,\nCoercions have free variables of type (a ~# b): we call these\nCoVars. However, the type checker passes around equality evidence\n(boxed up) at type (a ~ b).\n\nAn TcCoercion is simply a Coercion whose free variables have may be either\nboxed or unboxed. After we are done with typechecking the desugarer finds the\nboxed free variables, unboxes them, and creates a resulting real Coercion with\nkosher free variables.\n\n-}\n\ntype TcCoercion  = Coercion\ntype TcCoercionN = CoercionN    -- A Nominal          coercion ~N\ntype TcCoercionR = CoercionR    -- A Representational coercion ~R\ntype TcCoercionP = CoercionP    -- a phantom coercion\n\nmkTcReflCo             :: Role -> TcType -> TcCoercion\nmkTcSymCo              :: TcCoercion -> TcCoercion\nmkTcTransCo            :: TcCoercion -> TcCoercion -> TcCoercion\nmkTcNomReflCo          :: TcType -> TcCoercionN\nmkTcRepReflCo          :: TcType -> TcCoercionR\nmkTcTyConAppCo         :: Role -> TyCon -> [TcCoercion] -> TcCoercion\nmkTcAppCo              :: TcCoercion -> TcCoercionN -> TcCoercion\nmkTcFunCo              :: Role -> TcCoercion -> TcCoercion -> TcCoercion\nmkTcAxInstCo           :: Role -> CoAxiom br -> BranchIndex\n                       -> [TcType] -> [TcCoercion] -> TcCoercion\nmkTcUnbranchedAxInstCo :: CoAxiom Unbranched -> [TcType]\n                       -> [TcCoercion] -> TcCoercionR\nmkTcForAllCo           :: TyVar -> TcCoercionN -> TcCoercion -> TcCoercion\nmkTcForAllCos          :: [(TyVar, TcCoercionN)] -> TcCoercion -> TcCoercion\nmkTcNthCo              :: Role -> Int -> TcCoercion -> TcCoercion\nmkTcLRCo               :: LeftOrRight -> TcCoercion -> TcCoercion\nmkTcSubCo              :: TcCoercionN -> TcCoercionR\nmaybeTcSubCo           :: EqRel -> TcCoercion -> TcCoercion\ntcDowngradeRole        :: Role -> Role -> TcCoercion -> TcCoercion\nmkTcAxiomRuleCo        :: CoAxiomRule -> [TcCoercion] -> TcCoercionR\nmkTcGReflRightCo       :: Role -> TcType -> TcCoercionN -> TcCoercion\nmkTcGReflLeftCo        :: Role -> TcType -> TcCoercionN -> TcCoercion\nmkTcCoherenceLeftCo    :: Role -> TcType -> TcCoercionN\n                       -> TcCoercion -> TcCoercion\nmkTcCoherenceRightCo   :: Role -> TcType -> TcCoercionN\n                       -> TcCoercion -> TcCoercion\nmkTcPhantomCo          :: TcCoercionN -> TcType -> TcType -> TcCoercionP\nmkTcKindCo             :: TcCoercion -> TcCoercionN\nmkTcCoVarCo            :: CoVar -> TcCoercion\n\ntcCoercionKind         :: TcCoercion -> Pair TcType\ntcCoercionRole         :: TcCoercion -> Role\ncoVarsOfTcCo           :: TcCoercion -> TcTyCoVarSet\nisTcReflCo             :: TcCoercion -> Bool\n\n-- | This version does a slow check, calculating the related types and seeing\n-- if they are equal.\nisTcReflexiveCo        :: TcCoercion -> Bool\n\nmkTcReflCo             = mkReflCo\nmkTcSymCo              = mkSymCo\nmkTcTransCo            = mkTransCo\nmkTcNomReflCo          = mkNomReflCo\nmkTcRepReflCo          = mkRepReflCo\nmkTcTyConAppCo         = mkTyConAppCo\nmkTcAppCo              = mkAppCo\nmkTcFunCo              = mkFunCo\nmkTcAxInstCo           = mkAxInstCo\nmkTcUnbranchedAxInstCo = mkUnbranchedAxInstCo Representational\nmkTcForAllCo           = mkForAllCo\nmkTcForAllCos          = mkForAllCos\nmkTcNthCo              = mkNthCo\nmkTcLRCo               = mkLRCo\nmkTcSubCo              = mkSubCo\nmaybeTcSubCo           = maybeSubCo\ntcDowngradeRole        = downgradeRole\nmkTcAxiomRuleCo        = mkAxiomRuleCo\nmkTcGReflRightCo       = mkGReflRightCo\nmkTcGReflLeftCo        = mkGReflLeftCo\nmkTcCoherenceLeftCo    = mkCoherenceLeftCo\nmkTcCoherenceRightCo   = mkCoherenceRightCo\nmkTcPhantomCo          = mkPhantomCo\nmkTcKindCo             = mkKindCo\nmkTcCoVarCo            = mkCoVarCo\n\ntcCoercionKind         = coercionKind\ntcCoercionRole         = coercionRole\ncoVarsOfTcCo           = coVarsOfCo\nisTcReflCo             = isReflCo\nisTcReflexiveCo        = isReflexiveCo\n\n{-\n%************************************************************************\n%*                                                                      *\n                  HsWrapper\n*                                                                      *\n************************************************************************\n-}\n\ndata HsWrapper\n  = WpHole                      -- The identity coercion\n\n  | WpCompose HsWrapper HsWrapper\n       -- (wrap1 `WpCompose` wrap2)[e] = wrap1[ wrap2[ e ]]\n       --\n       -- Hence  (\\a. []) `WpCompose` (\\b. []) = (\\a b. [])\n       -- But    ([] a)   `WpCompose` ([] b)   = ([] b a)\n\n  | WpFun HsWrapper HsWrapper TcType SDoc\n       -- (WpFun wrap1 wrap2 t1)[e] = \\(x:t1). wrap2[ e wrap1[x] ]\n       -- So note that if  wrap1 :: exp_arg <= act_arg\n       --                  wrap2 :: act_res <= exp_res\n       --           then   WpFun wrap1 wrap2 : (act_arg -> arg_res) <= (exp_arg -> exp_res)\n       -- This isn't the same as for mkFunCo, but it has to be this way\n       -- because we can't use 'sym' to flip around these HsWrappers\n       -- The TcType is the \"from\" type of the first wrapper\n       -- The SDoc explains the circumstances under which we have created this\n       -- WpFun, in case we run afoul of levity polymorphism restrictions in\n       -- the desugarer. See Note [Levity polymorphism checking] in DsMonad\n\n  | WpCast TcCoercionR        -- A cast:  [] `cast` co\n                              -- Guaranteed not the identity coercion\n                              -- At role Representational\n\n        -- Evidence abstraction and application\n        -- (both dictionaries and coercions)\n  | WpEvLam EvVar               -- \\d. []       the 'd' is an evidence variable\n  | WpEvApp EvTerm              -- [] d         the 'd' is evidence for a constraint\n        -- Kind and Type abstraction and application\n  | WpTyLam TyVar       -- \\a. []  the 'a' is a type/kind variable (not coercion var)\n  | WpTyApp KindOrType  -- [] t    the 't' is a type (not coercion)\n\n\n  | WpLet TcEvBinds             -- Non-empty (or possibly non-empty) evidence bindings,\n                                -- so that the identity coercion is always exactly WpHole\n\n-- Cannot derive Data instance because SDoc is not Data (it stores a function).\n-- So we do it manually:\ninstance Data.Data HsWrapper where\n  gfoldl _ z WpHole             = z WpHole\n  gfoldl k z (WpCompose a1 a2)  = z WpCompose `k` a1 `k` a2\n  gfoldl k z (WpFun a1 a2 a3 _) = z wpFunEmpty `k` a1 `k` a2 `k` a3\n  gfoldl k z (WpCast a1)        = z WpCast `k` a1\n  gfoldl k z (WpEvLam a1)       = z WpEvLam `k` a1\n  gfoldl k z (WpEvApp a1)       = z WpEvApp `k` a1\n  gfoldl k z (WpTyLam a1)       = z WpTyLam `k` a1\n  gfoldl k z (WpTyApp a1)       = z WpTyApp `k` a1\n  gfoldl k z (WpLet a1)         = z WpLet `k` a1\n\n  gunfold k z c = case Data.constrIndex c of\n                    1 -> z WpHole\n                    2 -> k (k (z WpCompose))\n                    3 -> k (k (k (z wpFunEmpty)))\n                    4 -> k (z WpCast)\n                    5 -> k (z WpEvLam)\n                    6 -> k (z WpEvApp)\n                    7 -> k (z WpTyLam)\n                    8 -> k (z WpTyApp)\n                    _ -> k (z WpLet)\n\n  toConstr WpHole          = wpHole_constr\n  toConstr (WpCompose _ _) = wpCompose_constr\n  toConstr (WpFun _ _ _ _) = wpFun_constr\n  toConstr (WpCast _)      = wpCast_constr\n  toConstr (WpEvLam _)     = wpEvLam_constr\n  toConstr (WpEvApp _)     = wpEvApp_constr\n  toConstr (WpTyLam _)     = wpTyLam_constr\n  toConstr (WpTyApp _)     = wpTyApp_constr\n  toConstr (WpLet _)       = wpLet_constr\n\n  dataTypeOf _ = hsWrapper_dataType\n\nhsWrapper_dataType :: Data.DataType\nhsWrapper_dataType\n  = Data.mkDataType \"HsWrapper\"\n      [ wpHole_constr, wpCompose_constr, wpFun_constr, wpCast_constr\n      , wpEvLam_constr, wpEvApp_constr, wpTyLam_constr, wpTyApp_constr\n      , wpLet_constr]\n\nwpHole_constr, wpCompose_constr, wpFun_constr, wpCast_constr, wpEvLam_constr,\n  wpEvApp_constr, wpTyLam_constr, wpTyApp_constr, wpLet_constr :: Data.Constr\nwpHole_constr    = mkHsWrapperConstr \"WpHole\"\nwpCompose_constr = mkHsWrapperConstr \"WpCompose\"\nwpFun_constr     = mkHsWrapperConstr \"WpFun\"\nwpCast_constr    = mkHsWrapperConstr \"WpCast\"\nwpEvLam_constr   = mkHsWrapperConstr \"WpEvLam\"\nwpEvApp_constr   = mkHsWrapperConstr \"WpEvApp\"\nwpTyLam_constr   = mkHsWrapperConstr \"WpTyLam\"\nwpTyApp_constr   = mkHsWrapperConstr \"WpTyApp\"\nwpLet_constr     = mkHsWrapperConstr \"WpLet\"\n\nmkHsWrapperConstr :: String -> Data.Constr\nmkHsWrapperConstr name = Data.mkConstr hsWrapper_dataType name [] Data.Prefix\n\nwpFunEmpty :: HsWrapper -> HsWrapper -> TcType -> HsWrapper\nwpFunEmpty c1 c2 t1 = WpFun c1 c2 t1 empty\n\n(<.>) :: HsWrapper -> HsWrapper -> HsWrapper\nWpHole <.> c = c\nc <.> WpHole = c\nc1 <.> c2    = c1 `WpCompose` c2\n\nmkWpFun :: HsWrapper -> HsWrapper\n        -> TcType    -- the \"from\" type of the first wrapper\n        -> TcType    -- either type of the second wrapper (used only when the\n                     -- second wrapper is the identity)\n        -> SDoc      -- what caused you to want a WpFun? Something like \"When converting ...\"\n        -> HsWrapper\nmkWpFun WpHole       WpHole       _  _  _ = WpHole\nmkWpFun WpHole       (WpCast co2) t1 _  _ = WpCast (mkTcFunCo Representational (mkTcRepReflCo t1) co2)\nmkWpFun (WpCast co1) WpHole       _  t2 _ = WpCast (mkTcFunCo Representational (mkTcSymCo co1) (mkTcRepReflCo t2))\nmkWpFun (WpCast co1) (WpCast co2) _  _  _ = WpCast (mkTcFunCo Representational (mkTcSymCo co1) co2)\nmkWpFun co1          co2          t1 _  d = WpFun co1 co2 t1 d\n\n-- | @mkWpFuns [(ty1, wrap1), (ty2, wrap2)] ty_res wrap_res@,\n-- where @wrap1 :: ty1 \"->\" ty1'@ and @wrap2 :: ty2 \"->\" ty2'@,\n-- @wrap3 :: ty3 \"->\" ty3'@ and @ty_res@ is /either/ @ty3@ or @ty3'@,\n-- gives a wrapper @(ty1' -> ty2' -> ty3) \"->\" (ty1 -> ty2 -> ty3')@.\n-- Notice that the result wrapper goes the other way round to all\n-- the others. This is a result of sub-typing contravariance.\n-- The SDoc is a description of what you were doing when you called mkWpFuns.\nmkWpFuns :: [(TcType, HsWrapper)] -> TcType -> HsWrapper -> SDoc -> HsWrapper\nmkWpFuns args res_ty res_wrap doc = snd $ go args res_ty res_wrap\n  where\n    go [] res_ty res_wrap = (res_ty, res_wrap)\n    go ((arg_ty, arg_wrap) : args) res_ty res_wrap\n      = let (tail_ty, tail_wrap) = go args res_ty res_wrap in\n        (arg_ty `mkVisFunTy` tail_ty, mkWpFun arg_wrap tail_wrap arg_ty tail_ty doc)\n\nmkWpCastR :: TcCoercionR -> HsWrapper\nmkWpCastR co\n  | isTcReflCo co = WpHole\n  | otherwise     = ASSERT2(tcCoercionRole co == Representational, ppr co)\n                    WpCast co\n\nmkWpCastN :: TcCoercionN -> HsWrapper\nmkWpCastN co\n  | isTcReflCo co = WpHole\n  | otherwise     = ASSERT2(tcCoercionRole co == Nominal, ppr co)\n                    WpCast (mkTcSubCo co)\n    -- The mkTcSubCo converts Nominal to Representational\n\nmkWpTyApps :: [Type] -> HsWrapper\nmkWpTyApps tys = mk_co_app_fn WpTyApp tys\n\nmkWpEvApps :: [EvTerm] -> HsWrapper\nmkWpEvApps args = mk_co_app_fn WpEvApp args\n\nmkWpEvVarApps :: [EvVar] -> HsWrapper\nmkWpEvVarApps vs = mk_co_app_fn WpEvApp (map (EvExpr . evId) vs)\n\nmkWpTyLams :: [TyVar] -> HsWrapper\nmkWpTyLams ids = mk_co_lam_fn WpTyLam ids\n\nmkWpLams :: [Var] -> HsWrapper\nmkWpLams ids = mk_co_lam_fn WpEvLam ids\n\nmkWpLet :: TcEvBinds -> HsWrapper\n-- This no-op is a quite a common case\nmkWpLet (EvBinds b) | isEmptyBag b = WpHole\nmkWpLet ev_binds                   = WpLet ev_binds\n\nmk_co_lam_fn :: (a -> HsWrapper) -> [a] -> HsWrapper\nmk_co_lam_fn f as = foldr (\\x wrap -> f x <.> wrap) WpHole as\n\nmk_co_app_fn :: (a -> HsWrapper) -> [a] -> HsWrapper\n-- For applications, the *first* argument must\n-- come *last* in the composition sequence\nmk_co_app_fn f as = foldr (\\x wrap -> wrap <.> f x) WpHole as\n\nidHsWrapper :: HsWrapper\nidHsWrapper = WpHole\n\nisIdHsWrapper :: HsWrapper -> Bool\nisIdHsWrapper WpHole = True\nisIdHsWrapper _      = False\n\ncollectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper)\n-- Collect the outer lambda binders of a HsWrapper,\n-- stopping as soon as you get to a non-lambda binder\ncollectHsWrapBinders wrap = go wrap []\n  where\n    -- go w ws = collectHsWrapBinders (w <.> w1 <.> ... <.> wn)\n    go :: HsWrapper -> [HsWrapper] -> ([Var], HsWrapper)\n    go (WpEvLam v)       wraps = add_lam v (gos wraps)\n    go (WpTyLam v)       wraps = add_lam v (gos wraps)\n    go (WpCompose w1 w2) wraps = go w1 (w2:wraps)\n    go wrap              wraps = ([], foldl' (<.>) wrap wraps)\n\n    gos []     = ([], WpHole)\n    gos (w:ws) = go w ws\n\n    add_lam v (vs,w) = (v:vs, w)\n\n{-\n************************************************************************\n*                                                                      *\n                  Evidence bindings\n*                                                                      *\n************************************************************************\n-}\n\ndata TcEvBinds\n  = TcEvBinds           -- Mutable evidence bindings\n       EvBindsVar       -- Mutable because they are updated \"later\"\n                        --    when an implication constraint is solved\n\n  | EvBinds             -- Immutable after zonking\n       (Bag EvBind)\n\ndata EvBindsVar\n  = EvBindsVar {\n      ebv_uniq :: Unique,\n         -- The Unique is for debug printing only\n\n      ebv_binds :: IORef EvBindMap,\n      -- The main payload: the value-level evidence bindings\n      --     (dictionaries etc)\n      -- Some Given, some Wanted\n\n      ebv_tcvs :: IORef CoVarSet\n      -- The free Given coercion vars needed by Wanted coercions that\n      -- are solved by filling in their HoleDest in-place. Since they\n      -- don't appear in ebv_binds, we keep track of their free\n      -- variables so that we can report unused given constraints\n      -- See Note [Tracking redundant constraints] in TcSimplify\n    }\n\n  | CoEvBindsVar {  -- See Note [Coercion evidence only]\n\n      -- See above for comments on ebv_uniq, ebv_tcvs\n      ebv_uniq :: Unique,\n      ebv_tcvs :: IORef CoVarSet\n    }\n\ninstance Data.Data TcEvBinds where\n  -- Placeholder; we can't travers into TcEvBinds\n  toConstr _   = abstractConstr \"TcEvBinds\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = Data.mkNoRepType \"TcEvBinds\"\n\n{- Note [Coercion evidence only]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nClass constraints etc give rise to /term/ bindings for evidence, and\nwe have nowhere to put term bindings in /types/.  So in some places we\nuse CoEvBindsVar (see newCoTcEvBinds) to signal that no term-level\nevidence bindings are allowed.  Notebly ():\n\n  - Places in types where we are solving kind constraints (all of which\n    are equalities); see solveEqualities, solveLocalEqualities,\n    checkTvConstraints\n\n  - When unifying forall-types\n-}\n\nisCoEvBindsVar :: EvBindsVar -> Bool\nisCoEvBindsVar (CoEvBindsVar {}) = True\nisCoEvBindsVar (EvBindsVar {})   = False\n\n-----------------\nnewtype EvBindMap\n  = EvBindMap {\n       ev_bind_varenv :: DVarEnv EvBind\n    }       -- Map from evidence variables to evidence terms\n            -- We use @DVarEnv@ here to get deterministic ordering when we\n            -- turn it into a Bag.\n            -- If we don't do that, when we generate let bindings for\n            -- dictionaries in dsTcEvBinds they will be generated in random\n            -- order.\n            --\n            -- For example:\n            --\n            -- let $dEq = GHC.Classes.$fEqInt in\n            -- let $$dNum = GHC.Num.$fNumInt in ...\n            --\n            -- vs\n            --\n            -- let $dNum = GHC.Num.$fNumInt in\n            -- let $dEq = GHC.Classes.$fEqInt in ...\n            --\n            -- See Note [Deterministic UniqFM] in UniqDFM for explanation why\n            -- @UniqFM@ can lead to nondeterministic order.\n\nemptyEvBindMap :: EvBindMap\nemptyEvBindMap = EvBindMap { ev_bind_varenv = emptyDVarEnv }\n\nextendEvBinds :: EvBindMap -> EvBind -> EvBindMap\nextendEvBinds bs ev_bind\n  = EvBindMap { ev_bind_varenv = extendDVarEnv (ev_bind_varenv bs)\n                                               (eb_lhs ev_bind)\n                                               ev_bind }\n\nisEmptyEvBindMap :: EvBindMap -> Bool\nisEmptyEvBindMap (EvBindMap m) = isEmptyDVarEnv m\n\nlookupEvBind :: EvBindMap -> EvVar -> Maybe EvBind\nlookupEvBind bs = lookupDVarEnv (ev_bind_varenv bs)\n\nevBindMapBinds :: EvBindMap -> Bag EvBind\nevBindMapBinds = foldEvBindMap consBag emptyBag\n\nfoldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a\nfoldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)\n\nfilterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap\nfilterEvBindMap k (EvBindMap { ev_bind_varenv = env })\n  = EvBindMap { ev_bind_varenv = filterDVarEnv k env }\n\ninstance Outputable EvBindMap where\n  ppr (EvBindMap m) = ppr m\n\n-----------------\n-- All evidence is bound by EvBinds; no side effects\ndata EvBind\n  = EvBind { eb_lhs      :: EvVar\n           , eb_rhs      :: EvTerm\n           , eb_is_given :: Bool  -- True <=> given\n                 -- See Note [Tracking redundant constraints] in TcSimplify\n    }\n\nevBindVar :: EvBind -> EvVar\nevBindVar = eb_lhs\n\nmkWantedEvBind :: EvVar -> EvTerm -> EvBind\nmkWantedEvBind ev tm = EvBind { eb_is_given = False, eb_lhs = ev, eb_rhs = tm }\n\n-- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm\nmkGivenEvBind :: EvVar -> EvTerm -> EvBind\nmkGivenEvBind ev tm = EvBind { eb_is_given = True, eb_lhs = ev, eb_rhs = tm }\n\n\n-- An EvTerm is, conceptually, a CoreExpr that implements the constraint.\n-- Unfortunately, we cannot just do\n--   type EvTerm  = CoreExpr\n-- Because of staging problems issues around EvTypeable\ndata EvTerm\n  = EvExpr EvExpr\n\n  | EvTypeable Type EvTypeable   -- Dictionary for (Typeable ty)\n\n  | EvFun     -- /\\as \\ds. let binds in v\n      { et_tvs   :: [TyVar]\n      , et_given :: [EvVar]\n      , et_binds :: TcEvBinds -- This field is why we need an EvFun\n                              -- constructor, and can't just use EvExpr\n      , et_body  :: EvVar }\n\n  deriving Data.Data\n\ntype EvExpr = CoreExpr\n\n-- An EvTerm is (usually) constructed by any of the constructors here\n-- and those more complicates ones who were moved to module TcEvTerm\n\n-- | Any sort of evidence Id, including coercions\nevId ::  EvId -> EvExpr\nevId = Var\n\n-- coercion bindings\n-- See Note [Coercion evidence terms]\nevCoercion :: TcCoercion -> EvTerm\nevCoercion co = EvExpr (Coercion co)\n\n-- | d |> co\nevCast :: EvExpr -> TcCoercion -> EvTerm\nevCast et tc | isReflCo tc = EvExpr et\n             | otherwise   = EvExpr (Cast et tc)\n\n-- Dictionary instance application\nevDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm\nevDFunApp df tys ets = EvExpr $ Var df `mkTyApps` tys `mkApps` ets\n\nevDataConApp :: DataCon -> [Type] -> [EvExpr] -> EvTerm\nevDataConApp dc tys ets = evDFunApp (dataConWrapId dc) tys ets\n\n-- Selector id plus the types at which it\n-- should be instantiated, used for HasField\n-- dictionaries; see Note [HasField instances]\n-- in TcInterface\nevSelector :: Id -> [Type] -> [EvExpr] -> EvExpr\nevSelector sel_id tys tms = Var sel_id `mkTyApps` tys `mkApps` tms\n\n-- Dictionary for (Typeable ty)\nevTypeable :: Type -> EvTypeable -> EvTerm\nevTypeable = EvTypeable\n\n-- | Instructions on how to make a 'Typeable' dictionary.\n-- See Note [Typeable evidence terms]\ndata EvTypeable\n  = EvTypeableTyCon TyCon [EvTerm]\n    -- ^ Dictionary for @Typeable T@ where @T@ is a type constructor with all of\n    -- its kind variables saturated. The @[EvTerm]@ is @Typeable@ evidence for\n    -- the applied kinds..\n\n  | EvTypeableTyApp EvTerm EvTerm\n    -- ^ Dictionary for @Typeable (s t)@,\n    -- given a dictionaries for @s@ and @t@.\n\n  | EvTypeableTrFun EvTerm EvTerm\n    -- ^ Dictionary for @Typeable (s -> t)@,\n    -- given a dictionaries for @s@ and @t@.\n\n  | EvTypeableTyLit EvTerm\n    -- ^ Dictionary for a type literal,\n    -- e.g. @Typeable \"foo\"@ or @Typeable 3@\n    -- The 'EvTerm' is evidence of, e.g., @KnownNat 3@\n    -- (see Trac #10348)\n  deriving Data.Data\n\n-- | Evidence for @CallStack@ implicit parameters.\ndata EvCallStack\n  -- See Note [Overview of implicit CallStacks]\n  = EvCsEmpty\n  | EvCsPushCall Name RealSrcSpan EvExpr\n    -- ^ @EvCsPushCall name loc stk@ represents a call to @name@, occurring at\n    -- @loc@, in a calling context @stk@.\n  deriving Data.Data\n\n{-\nNote [Typeable evidence terms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe EvTypeable data type looks isomorphic to Type, but the EvTerms\ninside can be EvIds.  Eg\n    f :: forall a. Typeable a => a -> TypeRep\n    f x = typeRep (undefined :: Proxy [a])\nHere for the (Typeable [a]) dictionary passed to typeRep we make\nevidence\n    dl :: Typeable [a] = EvTypeable [a]\n                            (EvTypeableTyApp (EvTypeableTyCon []) (EvId d))\nwhere\n    d :: Typable a\nis the lambda-bound dictionary passed into f.\n\nNote [Coercion evidence terms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA \"coercion evidence term\" takes one of these forms\n   co_tm ::= EvId v           where v :: t1 ~# t2\n           | EvCoercion co\n           | EvCast co_tm co\n\nWe do quite often need to get a TcCoercion from an EvTerm; see\n'evTermCoercion'.\n\nINVARIANT: The evidence for any constraint with type (t1 ~# t2) is\na coercion evidence term.  Consider for example\n    [G] d :: F Int a\nIf we have\n    ax7 a :: F Int a ~ (a ~ Bool)\nthen we do NOT generate the constraint\n    [G] (d |> ax7 a) :: a ~ Bool\nbecause that does not satisfy the invariant (d is not a coercion variable).\nInstead we make a binding\n    g1 :: a~Bool = g |> ax7 a\nand the constraint\n    [G] g1 :: a~Bool\nSee Trac [7238] and Note [Bind new Givens immediately] in TcRnTypes\n\nNote [EvBinds/EvTerm]\n~~~~~~~~~~~~~~~~~~~~~\nHow evidence is created and updated. Bindings for dictionaries,\nand coercions and implicit parameters are carried around in TcEvBinds\nwhich during constraint generation and simplification is always of the\nform (TcEvBinds ref). After constraint simplification is finished it\nwill be transformed to t an (EvBinds ev_bag).\n\nEvidence for coercions *SHOULD* be filled in using the TcEvBinds\nHowever, all EvVars that correspond to *wanted* coercion terms in\nan EvBind must be mutable variables so that they can be readily\ninlined (by zonking) after constraint simplification is finished.\n\nConclusion: a new wanted coercion variable should be made mutable.\n[Notice though that evidence variables that bind coercion terms\n from super classes will be \"given\" and hence rigid]\n\n\nNote [Overview of implicit CallStacks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(See https://ghc.haskell.org/trac/ghc/wiki/ExplicitCallStack/ImplicitLocations)\n\nThe goal of CallStack evidence terms is to reify locations\nin the program source as runtime values, without any support\nfrom the RTS. We accomplish this by assigning a special meaning\nto constraints of type GHC.Stack.Types.HasCallStack, an alias\n\n  type HasCallStack = (?callStack :: CallStack)\n\nImplicit parameters of type GHC.Stack.Types.CallStack (the name is not\nimportant) are solved in three steps:\n\n1. Occurrences of CallStack IPs are solved directly from the given IP,\n   just like a regular IP. For example, the occurrence of `?stk` in\n\n     error :: (?stk :: CallStack) => String -> a\n     error s = raise (ErrorCall (s ++ prettyCallStack ?stk))\n\n   will be solved for the `?stk` in `error`s context as before.\n\n2. In a function call, instead of simply passing the given IP, we first\n   append the current call-site to it. For example, consider a\n   call to the callstack-aware `error` above.\n\n     undefined :: (?stk :: CallStack) => a\n     undefined = error \"undefined!\"\n\n   Here we want to take the given `?stk` and append the current\n   call-site, before passing it to `error`. In essence, we want to\n   rewrite `error \"undefined!\"` to\n\n     let ?stk = pushCallStack <error's location> ?stk\n     in error \"undefined!\"\n\n   We achieve this effect by emitting a NEW wanted\n\n     [W] d :: IP \"stk\" CallStack\n\n   from which we build the evidence term\n\n     EvCsPushCall \"error\" <error's location> (EvId d)\n\n   that we use to solve the call to `error`. The new wanted `d` will\n   then be solved per rule (1), ie as a regular IP.\n\n   (see TcInteract.interactDict)\n\n3. We default any insoluble CallStacks to the empty CallStack. Suppose\n   `undefined` did not request a CallStack, ie\n\n     undefinedNoStk :: a\n     undefinedNoStk = error \"undefined!\"\n\n   Under the usual IP rules, the new wanted from rule (2) would be\n   insoluble as there's no given IP from which to solve it, so we\n   would get an \"unbound implicit parameter\" error.\n\n   We don't ever want to emit an insoluble CallStack IP, so we add a\n   defaulting pass to default any remaining wanted CallStacks to the\n   empty CallStack with the evidence term\n\n     EvCsEmpty\n\n   (see TcSimplify.simpl_top and TcSimplify.defaultCallStacks)\n\nThis provides a lightweight mechanism for building up call-stacks\nexplicitly, but is notably limited by the fact that the stack will\nstop at the first function whose type does not include a CallStack IP.\nFor example, using the above definition of `undefined`:\n\n  head :: [a] -> a\n  head []    = undefined\n  head (x:_) = x\n\n  g = head []\n\nthe resulting CallStack will include the call to `undefined` in `head`\nand the call to `error` in `undefined`, but *not* the call to `head`\nin `g`, because `head` did not explicitly request a CallStack.\n\n\nImportant Details:\n- GHC should NEVER report an insoluble CallStack constraint.\n\n- GHC should NEVER infer a CallStack constraint unless one was requested\n  with a partial type signature (See TcType.pickQuantifiablePreds).\n\n- A CallStack (defined in GHC.Stack.Types) is a [(String, SrcLoc)],\n  where the String is the name of the binder that is used at the\n  SrcLoc. SrcLoc is also defined in GHC.Stack.Types and contains the\n  package/module/file name, as well as the full source-span. Both\n  CallStack and SrcLoc are kept abstract so only GHC can construct new\n  values.\n\n- We will automatically solve any wanted CallStack regardless of the\n  name of the IP, i.e.\n\n    f = show (?stk :: CallStack)\n    g = show (?loc :: CallStack)\n\n  are both valid. However, we will only push new SrcLocs onto existing\n  CallStacks when the IP names match, e.g. in\n\n    head :: (?loc :: CallStack) => [a] -> a\n    head [] = error (show (?stk :: CallStack))\n\n  the printed CallStack will NOT include head's call-site. This reflects the\n  standard scoping rules of implicit-parameters.\n\n- An EvCallStack term desugars to a CoreExpr of type `IP \"some str\" CallStack`.\n  The desugarer will need to unwrap the IP newtype before pushing a new\n  call-site onto a given stack (See DsBinds.dsEvCallStack)\n\n- When we emit a new wanted CallStack from rule (2) we set its origin to\n  `IPOccOrigin ip_name` instead of the original `OccurrenceOf func`\n  (see TcInteract.interactDict).\n\n  This is a bit shady, but is how we ensure that the new wanted is\n  solved like a regular IP.\n\n-}\n\nmkEvCast :: EvExpr -> TcCoercion -> EvTerm\nmkEvCast ev lco\n  | ASSERT2( tcCoercionRole lco == Representational\n           , (vcat [text \"Coercion of wrong role passed to mkEvCast:\", ppr ev, ppr lco]))\n    isTcReflCo lco = EvExpr ev\n  | otherwise      = evCast ev lco\n\n\nmkEvScSelectors         -- Assume   class (..., D ty, ...) => C a b\n  :: Class -> [TcType]  -- C ty1 ty2\n  -> [(TcPredType,      -- D ty[ty1/a,ty2/b]\n       EvExpr)          -- :: C ty1 ty2 -> D ty[ty1/a,ty2/b]\n     ]\nmkEvScSelectors cls tys\n   = zipWith mk_pr (immSuperClasses cls tys) [0..]\n  where\n    mk_pr pred i = (pred, Var sc_sel_id `mkTyApps` tys)\n      where\n        sc_sel_id  = classSCSelId cls i -- Zero-indexed\n\nemptyTcEvBinds :: TcEvBinds\nemptyTcEvBinds = EvBinds emptyBag\n\nisEmptyTcEvBinds :: TcEvBinds -> Bool\nisEmptyTcEvBinds (EvBinds b)    = isEmptyBag b\nisEmptyTcEvBinds (TcEvBinds {}) = panic \"isEmptyTcEvBinds\"\n\nevTermCoercion_maybe :: EvTerm -> Maybe TcCoercion\n-- Applied only to EvTerms of type (s~t)\n-- See Note [Coercion evidence terms]\nevTermCoercion_maybe ev_term\n  | EvExpr e <- ev_term = go e\n  | otherwise           = Nothing\n  where\n    go :: EvExpr -> Maybe TcCoercion\n    go (Var v)       = return (mkCoVarCo v)\n    go (Coercion co) = return co\n    go (Cast tm co)  = do { co' <- go tm\n                          ; return (mkCoCast co' co) }\n    go _             = Nothing\n\nevTermCoercion :: EvTerm -> TcCoercion\nevTermCoercion tm = case evTermCoercion_maybe tm of\n                      Just co -> co\n                      Nothing -> pprPanic \"evTermCoercion\" (ppr tm)\n\n\n{- *********************************************************************\n*                                                                      *\n                  Free variables\n*                                                                      *\n********************************************************************* -}\n\nfindNeededEvVars :: EvBindMap -> VarSet -> VarSet\n-- Find all the Given evidence needed by seeds,\n-- looking transitively through binds\nfindNeededEvVars ev_binds seeds\n  = transCloVarSet also_needs seeds\n  where\n   also_needs :: VarSet -> VarSet\n   also_needs needs = nonDetFoldUniqSet add emptyVarSet needs\n     -- It's OK to use nonDetFoldUFM here because we immediately\n     -- forget about the ordering by creating a set\n\n   add :: Var -> VarSet -> VarSet\n   add v needs\n     | Just ev_bind <- lookupEvBind ev_binds v\n     , EvBind { eb_is_given = is_given, eb_rhs = rhs } <- ev_bind\n     , is_given\n     = evVarsOfTerm rhs `unionVarSet` needs\n     | otherwise\n     = needs\n\nevVarsOfTerm :: EvTerm -> VarSet\nevVarsOfTerm (EvExpr e)         = exprSomeFreeVars isEvVar e\nevVarsOfTerm (EvTypeable _ ev)  = evVarsOfTypeable ev\nevVarsOfTerm (EvFun {})         = emptyVarSet -- See Note [Free vars of EvFun]\n\nevVarsOfTerms :: [EvTerm] -> VarSet\nevVarsOfTerms = mapUnionVarSet evVarsOfTerm\n\nevVarsOfTypeable :: EvTypeable -> VarSet\nevVarsOfTypeable ev =\n  case ev of\n    EvTypeableTyCon _ e   -> mapUnionVarSet evVarsOfTerm e\n    EvTypeableTyApp e1 e2 -> evVarsOfTerms [e1,e2]\n    EvTypeableTrFun e1 e2 -> evVarsOfTerms [e1,e2]\n    EvTypeableTyLit e     -> evVarsOfTerm e\n\n\n{- Note [Free vars of EvFun]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFinding the free vars of an EvFun is made tricky by the fact the\nbindings et_binds may be a mutable variable.  Fortunately, we\ncan just squeeze by.  Here's how.\n\n* evVarsOfTerm is used only by TcSimplify.neededEvVars.\n* Each EvBindsVar in an et_binds field of an EvFun is /also/ in the\n  ic_binds field of an Implication\n* So we can track usage via the processing for that implication,\n  (see Note [Tracking redundant constraints] in TcSimplify).\n  We can ignore usage from the EvFun altogether.\n\n************************************************************************\n*                                                                      *\n                  Pretty printing\n*                                                                      *\n************************************************************************\n-}\n\ninstance Outputable HsWrapper where\n  ppr co_fn = pprHsWrapper co_fn (no_parens (text \"<>\"))\n\npprHsWrapper :: HsWrapper -> (Bool -> SDoc) -> SDoc\n-- With -fprint-typechecker-elaboration, print the wrapper\n--   otherwise just print what's inside\n-- The pp_thing_inside function takes Bool to say whether\n--    it's in a position that needs parens for a non-atomic thing\npprHsWrapper wrap pp_thing_inside\n  = sdocWithDynFlags $ \\ dflags ->\n    if gopt Opt_PrintTypecheckerElaboration dflags\n    then help pp_thing_inside wrap False\n    else pp_thing_inside False\n  where\n    help :: (Bool -> SDoc) -> HsWrapper -> Bool -> SDoc\n    -- True  <=> appears in function application position\n    -- False <=> appears as body of let or lambda\n    help it WpHole             = it\n    help it (WpCompose f1 f2)  = help (help it f2) f1\n    help it (WpFun f1 f2 t1 _) = add_parens $ text \"\\\\(x\" <> dcolon <> ppr t1 <> text \").\" <+>\n                                              help (\\_ -> it True <+> help (\\_ -> text \"x\") f1 True) f2 False\n    help it (WpCast co)   = add_parens $ sep [it False, nest 2 (text \"|>\"\n                                              <+> pprParendCo co)]\n    help it (WpEvApp id)  = no_parens  $ sep [it True, nest 2 (ppr id)]\n    help it (WpTyApp ty)  = no_parens  $ sep [it True, text \"@\" <+> pprParendType ty]\n    help it (WpEvLam id)  = add_parens $ sep [ text \"\\\\\" <> pprLamBndr id <> dot, it False]\n    help it (WpTyLam tv)  = add_parens $ sep [text \"/\\\\\" <> pprLamBndr tv <> dot, it False]\n    help it (WpLet binds) = add_parens $ sep [text \"let\" <+> braces (ppr binds), it False]\n\npprLamBndr :: Id -> SDoc\npprLamBndr v = pprBndr LambdaBind v\n\nadd_parens, no_parens :: SDoc -> Bool -> SDoc\nadd_parens d True  = parens d\nadd_parens d False = d\nno_parens d _ = d\n\ninstance Outputable TcEvBinds where\n  ppr (TcEvBinds v) = ppr v\n  ppr (EvBinds bs)  = text \"EvBinds\" <> braces (vcat (map ppr (bagToList bs)))\n\ninstance Outputable EvBindsVar where\n  ppr (EvBindsVar { ebv_uniq = u })\n     = text \"EvBindsVar\" <> angleBrackets (ppr u)\n  ppr (CoEvBindsVar { ebv_uniq = u })\n     = text \"CoEvBindsVar\" <> angleBrackets (ppr u)\n\ninstance Uniquable EvBindsVar where\n  getUnique = ebv_uniq\n\ninstance Outputable EvBind where\n  ppr (EvBind { eb_lhs = v, eb_rhs = e, eb_is_given = is_given })\n     = sep [ pp_gw <+> ppr v\n           , nest 2 $ equals <+> ppr e ]\n     where\n       pp_gw = brackets (if is_given then char 'G' else char 'W')\n   -- We cheat a bit and pretend EqVars are CoVars for the purposes of pretty printing\n\ninstance Outputable EvTerm where\n  ppr (EvExpr e)         = ppr e\n  ppr (EvTypeable ty ev) = ppr ev <+> dcolon <+> text \"Typeable\" <+> ppr ty\n  ppr (EvFun { et_tvs = tvs, et_given = gs, et_binds = bs, et_body = w })\n      = hang (text \"\\\\\" <+> sep (map pprLamBndr (tvs ++ gs)) <+> arrow)\n           2 (ppr bs $$ ppr w)   -- Not very pretty\n\ninstance Outputable EvCallStack where\n  ppr EvCsEmpty\n    = text \"[]\"\n  ppr (EvCsPushCall name loc tm)\n    = ppr (name,loc) <+> text \":\" <+> ppr tm\n\ninstance Outputable EvTypeable where\n  ppr (EvTypeableTyCon ts _)  = text \"TyCon\" <+> ppr ts\n  ppr (EvTypeableTyApp t1 t2) = parens (ppr t1 <+> ppr t2)\n  ppr (EvTypeableTrFun t1 t2) = parens (ppr t1 <+> arrow <+> ppr t2)\n  ppr (EvTypeableTyLit t1)    = text \"TyLit\" <> ppr t1\n\n\n----------------------------------------------------------------------\n-- Helper functions for dealing with IP newtype-dictionaries\n----------------------------------------------------------------------\n\n-- | Create a 'Coercion' that unwraps an implicit-parameter or\n-- overloaded-label dictionary to expose the underlying value. We\n-- expect the 'Type' to have the form `IP sym ty` or `IsLabel sym ty`,\n-- and return a 'Coercion' `co :: IP sym ty ~ ty` or\n-- `co :: IsLabel sym ty ~ Proxy# sym -> ty`.  See also\n-- Note [Type-checking overloaded labels] in TcExpr.\nunwrapIP :: Type -> CoercionR\nunwrapIP ty =\n  case unwrapNewTyCon_maybe tc of\n    Just (_,_,ax) -> mkUnbranchedAxInstCo Representational ax tys []\n    Nothing       -> pprPanic \"unwrapIP\" $\n                       text \"The dictionary for\" <+> quotes (ppr tc)\n                         <+> text \"is not a newtype!\"\n  where\n  (tc, tys) = splitTyConApp ty\n\n-- | Create a 'Coercion' that wraps a value in an implicit-parameter\n-- dictionary. See 'unwrapIP'.\nwrapIP :: Type -> CoercionR\nwrapIP ty = mkSymCo (unwrapIP ty)\n", "num_lines": 992}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- (those who have too heavy dependencies for TcEvidence)\nmodule TcEvTerm\n    ( evDelayedError, evCallStack )\nwhere\n\nimport GhcPrelude\n\nimport FastString\nimport Type\nimport CoreSyn\nimport MkCore\nimport Literal ( Literal(..) )\nimport TcEvidence\nimport HscTypes\nimport DynFlags\nimport Name\nimport Module\nimport CoreUtils\nimport PrelNames\nimport SrcLoc\n\n-- Used with Opt_DeferTypeErrors\n-- See Note [Deferring coercion errors to runtime]\n-- in TcSimplify\nevDelayedError :: Type -> FastString -> EvTerm\nevDelayedError ty msg\n  = EvExpr $\n    Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg]\n  where\n    errorId = tYPE_ERROR_ID\n    litMsg  = Lit (LitString (bytesFS msg))\n\n-- Dictionary for CallStack implicit parameters\nevCallStack :: (MonadThings m, HasModule m, HasDynFlags m) =>\n    EvCallStack -> m EvExpr\n-- See Note [Overview of implicit CallStacks] in TcEvidence.hs\nevCallStack cs = do\n  df            <- getDynFlags\n  m             <- getModule\n  srcLocDataCon <- lookupDataCon srcLocDataConName\n  let mkSrcLoc l = mkCoreConApps srcLocDataCon <$>\n               sequence [ mkStringExprFS (unitIdFS $ moduleUnitId m)\n                        , mkStringExprFS (moduleNameFS $ moduleName m)\n                        , mkStringExprFS (srcSpanFile l)\n                        , return $ mkIntExprInt df (srcSpanStartLine l)\n                        , return $ mkIntExprInt df (srcSpanStartCol l)\n                        , return $ mkIntExprInt df (srcSpanEndLine l)\n                        , return $ mkIntExprInt df (srcSpanEndCol l)\n                        ]\n\n  emptyCS <- Var <$> lookupId emptyCallStackName\n\n  pushCSVar <- lookupId pushCallStackName\n  let pushCS name loc rest =\n        mkCoreApps (Var pushCSVar) [mkCoreTup [name, loc], rest]\n\n  let mkPush name loc tm = do\n        nameExpr <- mkStringExprFS name\n        locExpr <- mkSrcLoc loc\n        -- at this point tm :: IP sym CallStack\n        -- but we need the actual CallStack to pass to pushCS,\n        -- so we use unwrapIP to strip the dictionary wrapper\n        -- See Note [Overview of implicit CallStacks]\n        let ip_co = unwrapIP (exprType tm)\n        return (pushCS nameExpr locExpr (Cast tm ip_co))\n\n  case cs of\n    EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm\n    EvCsEmpty -> return emptyCS\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n%\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[TcExpr]{Typecheck an expression}\n-}\n\n{-# LANGUAGE CPP, TupleSections, ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcExpr ( tcPolyExpr, tcMonoExpr, tcMonoExprNC,\n                tcInferSigma, tcInferSigmaNC, tcInferRho, tcInferRhoNC,\n                tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,\n                tcCheckId,\n                addExprErrCtxt,\n                getFixedTyVars ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   TcSplice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )\nimport THNames( liftStringName, liftName )\n\nimport HsSyn\nimport TcHsSyn\nimport TcRnMonad\nimport TcUnify\nimport BasicTypes\nimport Inst\nimport TcBinds          ( chooseInferredQuantifiers, tcLocalBinds )\nimport TcSigs           ( tcUserTypeSig, tcInstSig )\nimport TcSimplify       ( simplifyInfer, InferMode(..) )\nimport FamInst          ( tcGetFamInstEnvs, tcLookupDataFamInst )\nimport FamInstEnv       ( FamInstEnvs )\nimport RnEnv            ( addUsedGRE )\nimport RnUtils          ( addNameClashErrRn, unknownSubordinateErr )\nimport TcEnv\nimport TcArrows\nimport TcMatches\nimport TcHsType\nimport TcPatSyn( tcPatSynBuilderOcc, nonBidirectionalErr )\nimport TcPat\nimport TcMType\nimport TcType\nimport Id\nimport IdInfo\nimport ConLike\nimport DataCon\nimport PatSyn\nimport Name\nimport NameEnv\nimport NameSet\nimport RdrName\nimport TyCon\nimport TyCoRep\nimport Type\nimport TcEvidence\nimport VarSet\nimport MkId( seqId )\nimport TysWiredIn\nimport TysPrim( intPrimTy, mkTemplateTyVars, tYPE )\nimport PrimOp( tagToEnumKey )\nimport PrelNames\nimport DynFlags\nimport SrcLoc\nimport Util\nimport VarEnv  ( emptyTidyEnv, mkInScopeSet )\nimport ListSetOps\nimport Maybes\nimport Outputable\nimport FastString\nimport Control.Monad\nimport Class(classTyCon)\nimport UniqSet ( nonDetEltsUniqSet )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.Function\nimport Data.List\nimport qualified Data.Set as Set\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Main wrappers}\n*                                                                      *\n************************************************************************\n-}\n\ntcPolyExpr, tcPolyExprNC\n  :: LHsExpr GhcRn         -- Expression to type check\n  -> TcSigmaType           -- Expected type (could be a polytype)\n  -> TcM (LHsExpr GhcTcId) -- Generalised expr with expected type\n\n-- tcPolyExpr is a convenient place (frequent but not too frequent)\n-- place to add context information.\n-- The NC version does not do so, usually because the caller wants\n-- to do so himself.\n\ntcPolyExpr   expr res_ty = tc_poly_expr expr (mkCheckExpType res_ty)\ntcPolyExprNC expr res_ty = tc_poly_expr_nc expr (mkCheckExpType res_ty)\n\n-- these versions take an ExpType\ntc_poly_expr, tc_poly_expr_nc :: LHsExpr GhcRn -> ExpSigmaType\n                              -> TcM (LHsExpr GhcTcId)\ntc_poly_expr expr res_ty\n  = addExprErrCtxt expr $\n    do { traceTc \"tcPolyExpr\" (ppr res_ty); tc_poly_expr_nc expr res_ty }\n\ntc_poly_expr_nc (L loc expr) res_ty\n  = setSrcSpan loc $\n    do { traceTc \"tcPolyExprNC\" (ppr res_ty)\n       ; (wrap, expr')\n           <- tcSkolemiseET GenSigCtxt res_ty $ \\ res_ty ->\n              tcExpr expr res_ty\n       ; return $ L loc (mkHsWrap wrap expr') }\n\n---------------\ntcMonoExpr, tcMonoExprNC\n    :: LHsExpr GhcRn     -- Expression to type check\n    -> ExpRhoType        -- Expected type\n                         -- Definitely no foralls at the top\n    -> TcM (LHsExpr GhcTcId)\n\ntcMonoExpr expr res_ty\n  = addErrCtxt (exprCtxt expr) $\n    tcMonoExprNC expr res_ty\n\ntcMonoExprNC (L loc expr) res_ty\n  = setSrcSpan loc $\n    do  { expr' <- tcExpr expr res_ty\n        ; return (L loc expr') }\n\n---------------\ntcInferSigma, tcInferSigmaNC :: LHsExpr GhcRn -> TcM ( LHsExpr GhcTcId\n                                                    , TcSigmaType )\n-- Infer a *sigma*-type.\ntcInferSigma expr = addErrCtxt (exprCtxt expr) (tcInferSigmaNC expr)\n\ntcInferSigmaNC (L loc expr)\n  = setSrcSpan loc $\n    do { (expr', sigma) <- tcInferNoInst (tcExpr expr)\n       ; return (L loc expr', sigma) }\n\ntcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcRhoType)\n-- Infer a *rho*-type. The return type is always (shallowly) instantiated.\ntcInferRho expr = addErrCtxt (exprCtxt expr) (tcInferRhoNC expr)\n\ntcInferRhoNC expr\n  = do { (expr', sigma) <- tcInferSigmaNC expr\n       ; (wrap, rho) <- topInstantiate (lexprCtOrigin expr) sigma\n       ; return (mkLHsWrap wrap expr', rho) }\n\n\n{-\n************************************************************************\n*                                                                      *\n        tcExpr: the main expression typechecker\n*                                                                      *\n************************************************************************\n\nNB: The res_ty is always deeply skolemised.\n-}\n\ntcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)\ntcExpr (HsVar _ (L _ name))   res_ty = tcCheckId name res_ty\ntcExpr e@(HsUnboundVar _ uv)  res_ty = tcUnboundId e uv res_ty\n\ntcExpr e@(HsApp {})     res_ty = tcApp1 e res_ty\ntcExpr e@(HsAppType {}) res_ty = tcApp1 e res_ty\n\ntcExpr e@(HsLit x lit) res_ty\n  = do { let lit_ty = hsLitType lit\n       ; tcWrapResult e (HsLit x (convertLit lit)) lit_ty res_ty }\n\ntcExpr (HsPar x expr) res_ty = do { expr' <- tcMonoExprNC expr res_ty\n                                  ; return (HsPar x expr') }\n\ntcExpr (HsSCC x src lbl expr) res_ty\n  = do { expr' <- tcMonoExpr expr res_ty\n       ; return (HsSCC x src lbl expr') }\n\ntcExpr (HsTickPragma x src info srcInfo expr) res_ty\n  = do { expr' <- tcMonoExpr expr res_ty\n       ; return (HsTickPragma x src info srcInfo expr') }\n\ntcExpr (HsCoreAnn x src lbl expr) res_ty\n  = do  { expr' <- tcMonoExpr expr res_ty\n        ; return (HsCoreAnn x src lbl expr') }\n\ntcExpr (HsOverLit x lit) res_ty\n  = do  { lit' <- newOverloadedLit lit res_ty\n        ; return (HsOverLit x lit') }\n\ntcExpr (NegApp x expr neg_expr) res_ty\n  = do  { (expr', neg_expr')\n            <- tcSyntaxOp NegateOrigin neg_expr [SynAny] res_ty $\n               \\[arg_ty] ->\n               tcMonoExpr expr (mkCheckExpType arg_ty)\n        ; return (NegApp x expr' neg_expr') }\n\ntcExpr e@(HsIPVar _ x) res_ty\n  = do {   {- Implicit parameters must have a *tau-type* not a\n              type scheme.  We enforce this by creating a fresh\n              type variable as its type.  (Because res_ty may not\n              be a tau-type.) -}\n         ip_ty <- newOpenFlexiTyVarTy\n       ; let ip_name = mkStrLitTy (hsIPNameFS x)\n       ; ipClass <- tcLookupClass ipClassName\n       ; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty])\n       ; tcWrapResult e\n                   (fromDict ipClass ip_name ip_ty (HsVar noExt (noLoc ip_var)))\n                   ip_ty res_ty }\n  where\n  -- Coerces a dictionary for `IP \"x\" t` into `t`.\n  fromDict ipClass x ty = mkHsWrap $ mkWpCastR $\n                          unwrapIP $ mkClassPred ipClass [x,ty]\n  origin = IPOccOrigin x\n\ntcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty\n  = do { -- See Note [Type-checking overloaded labels]\n         loc <- getSrcSpanM\n       ; case mb_fromLabel of\n           Just fromLabel -> tcExpr (applyFromLabel loc fromLabel) res_ty\n           Nothing -> do { isLabelClass <- tcLookupClass isLabelClassName\n                         ; alpha <- newFlexiTyVarTy liftedTypeKind\n                         ; let pred = mkClassPred isLabelClass [lbl, alpha]\n                         ; loc <- getSrcSpanM\n                         ; var <- emitWantedEvVar origin pred\n                         ; tcWrapResult e\n                                       (fromDict pred (HsVar noExt (L loc var)))\n                                        alpha res_ty } }\n  where\n  -- Coerces a dictionary for `IsLabel \"x\" t` into `t`,\n  -- or `HasField \"x\" r a into `r -> a`.\n  fromDict pred = mkHsWrap $ mkWpCastR $ unwrapIP pred\n  origin = OverLabelOrigin l\n  lbl = mkStrLitTy l\n\n  applyFromLabel loc fromLabel =\n    HsAppType noExt\n         (L loc (HsVar noExt (L loc fromLabel)))\n         (mkEmptyWildCardBndrs (L loc (HsTyLit noExt (HsStrTy NoSourceText l))))\n\ntcExpr (HsLam x match) res_ty\n  = do  { (match', wrap) <- tcMatchLambda herald match_ctxt match res_ty\n        ; return (mkHsWrap wrap (HsLam x match')) }\n  where\n    match_ctxt = MC { mc_what = LambdaExpr, mc_body = tcBody }\n    herald = sep [ text \"The lambda expression\" <+>\n                   quotes (pprSetDepth (PartWay 1) $\n                           pprMatches match),\n                        -- The pprSetDepth makes the abstraction print briefly\n                   text \"has\"]\n\ntcExpr e@(HsLamCase x matches) res_ty\n  = do { (matches', wrap)\n           <- tcMatchLambda msg match_ctxt matches res_ty\n           -- The laziness annotation is because we don't want to fail here\n           -- if there are multiple arguments\n       ; return (mkHsWrap wrap $ HsLamCase x matches') }\n  where\n    msg = sep [ text \"The function\" <+> quotes (ppr e)\n              , text \"requires\"]\n    match_ctxt = MC { mc_what = CaseAlt, mc_body = tcBody }\n\ntcExpr e@(ExprWithTySig _ expr sig_ty) res_ty\n  = do { let loc = getLoc (hsSigWcType sig_ty)\n       ; sig_info <- checkNoErrs $  -- Avoid error cascade\n                     tcUserTypeSig loc sig_ty Nothing\n       ; (expr', poly_ty) <- tcExprSig expr sig_info\n       ; let expr'' = ExprWithTySig noExt expr' sig_ty\n       ; tcWrapResult e expr'' poly_ty res_ty }\n\n{-\nNote [Type-checking overloaded labels]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRecall that we have\n\n  module GHC.OverloadedLabels where\n    class IsLabel (x :: Symbol) a where\n      fromLabel :: a\n\nWe translate `#foo` to `fromLabel @\"foo\"`, where we use\n\n * the in-scope `fromLabel` if `RebindableSyntax` is enabled; or if not\n * `GHC.OverloadedLabels.fromLabel`.\n\nIn the `RebindableSyntax` case, the renamer will have filled in the\nfirst field of `HsOverLabel` with the `fromLabel` function to use, and\nwe simply apply it to the appropriate visible type argument.\n\nIn the `OverloadedLabels` case, when we see an overloaded label like\n`#foo`, we generate a fresh variable `alpha` for the type and emit an\n`IsLabel \"foo\" alpha` constraint.  Because the `IsLabel` class has a\nsingle method, it is represented by a newtype, so we can coerce\n`IsLabel \"foo\" alpha` to `alpha` (just like for implicit parameters).\n\n-}\n\n\n{-\n************************************************************************\n*                                                                      *\n                Infix operators and sections\n*                                                                      *\n************************************************************************\n\nNote [Left sections]\n~~~~~~~~~~~~~~~~~~~~\nLeft sections, like (4 *), are equivalent to\n        \\ x -> (*) 4 x,\nor, if PostfixOperators is enabled, just\n        (*) 4\nWith PostfixOperators we don't actually require the function to take\ntwo arguments at all.  For example, (x `not`) means (not x); you get\npostfix operators!  Not Haskell 98, but it's less work and kind of\nuseful.\n\nNote [Typing rule for ($)]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nPeople write\n   runST $ blah\nso much, where\n   runST :: (forall s. ST s a) -> a\nthat I have finally given in and written a special type-checking\nrule just for saturated applications of ($).\n  * Infer the type of the first argument\n  * Decompose it; should be of form (arg2_ty -> res_ty),\n       where arg2_ty might be a polytype\n  * Use arg2_ty to typecheck arg2\n\nNote [Typing rule for seq]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to allow\n       x `seq` (# p,q #)\nwhich suggests this type for seq:\n   seq :: forall (a:*) (b:Open). a -> b -> b,\nwith (b:Open) meaning that be can be instantiated with an unboxed\ntuple.  The trouble is that this might accept a partially-applied\n'seq', and I'm just not certain that would work.  I'm only sure it's\nonly going to work when it's fully applied, so it turns into\n    case x of _ -> (# p,q #)\n\nSo it seems more uniform to treat 'seq' as if it was a language\nconstruct.\n\nSee also Note [seqId magic] in MkId\n-}\n\ntcExpr expr@(OpApp fix arg1 op arg2) res_ty\n  | (L loc (HsVar _ (L lv op_name))) <- op\n  , op_name `hasKey` seqIdKey           -- Note [Typing rule for seq]\n  = do { arg1_ty <- newFlexiTyVarTy liftedTypeKind\n       ; let arg2_exp_ty = res_ty\n       ; arg1' <- tcArg op arg1 arg1_ty 1\n       ; arg2' <- addErrCtxt (funAppCtxt op arg2 2) $\n                  tc_poly_expr_nc arg2 arg2_exp_ty\n       ; arg2_ty <- readExpType arg2_exp_ty\n       ; op_id <- tcLookupId op_name\n       ; let op' = L loc (mkHsWrap (mkWpTyApps [arg1_ty, arg2_ty])\n                                   (HsVar noExt (L lv op_id)))\n       ; return $ OpApp fix arg1' op' arg2' }\n\n  | (L loc (HsVar _ (L lv op_name))) <- op\n  , op_name `hasKey` dollarIdKey        -- Note [Typing rule for ($)]\n  = do { traceTc \"Application rule\" (ppr op)\n       ; (arg1', arg1_ty) <- tcInferSigma arg1\n\n       ; let doc   = text \"The first argument of ($) takes\"\n             orig1 = lexprCtOrigin arg1\n       ; (wrap_arg1, [arg2_sigma], op_res_ty) <-\n           matchActualFunTys doc orig1 (Just (unLoc arg1)) 1 arg1_ty\n\n         -- We have (arg1 $ arg2)\n         -- So: arg1_ty = arg2_ty -> op_res_ty\n         -- where arg2_sigma maybe polymorphic; that's the point\n\n       ; arg2'  <- tcArg op arg2 arg2_sigma 2\n\n       -- Make sure that the argument type has kind '*'\n       --   ($) :: forall (r:RuntimeRep) (a:*) (b:TYPE r). (a->b) -> a -> b\n       -- Eg we do not want to allow  (D#  $  4.0#)   Trac #5570\n       --    (which gives a seg fault)\n       --\n       -- The *result* type can have any kind (Trac #8739),\n       -- so we don't need to check anything for that\n       ; _ <- unifyKind (Just (XHsType $ NHsCoreTy arg2_sigma))\n                        (tcTypeKind arg2_sigma) liftedTypeKind\n           -- ignore the evidence. arg2_sigma must have type * or #,\n           -- because we know arg2_sigma -> or_res_ty is well-kinded\n           -- (because otherwise matchActualFunTys would fail)\n           -- There's no possibility here of, say, a kind family reducing to *.\n\n       ; wrap_res <- tcSubTypeHR orig1 (Just expr) op_res_ty res_ty\n                       -- op_res -> res\n\n       ; op_id  <- tcLookupId op_name\n       ; res_ty <- readExpType res_ty\n       ; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep res_ty\n                                               , arg2_sigma\n                                               , res_ty])\n                                   (HsVar noExt (L lv op_id)))\n             -- arg1' :: arg1_ty\n             -- wrap_arg1 :: arg1_ty \"->\" (arg2_sigma -> op_res_ty)\n             -- wrap_res :: op_res_ty \"->\" res_ty\n             -- op' :: (a2_ty -> res_ty) -> a2_ty -> res_ty\n\n             -- wrap1 :: arg1_ty \"->\" (arg2_sigma -> res_ty)\n             wrap1 = mkWpFun idHsWrapper wrap_res arg2_sigma res_ty doc\n                     <.> wrap_arg1\n             doc = text \"When looking at the argument to ($)\"\n\n       ; return (OpApp fix (mkLHsWrap wrap1 arg1') op' arg2') }\n\n  | (L loc (HsRecFld _ (Ambiguous _ lbl))) <- op\n  , Just sig_ty <- obviousSig (unLoc arg1)\n    -- See Note [Disambiguating record fields]\n  = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty\n       ; sel_name <- disambiguateSelector lbl sig_tc_ty\n       ; let op' = L loc (HsRecFld noExt (Unambiguous sel_name lbl))\n       ; tcExpr (OpApp fix arg1 op' arg2) res_ty\n       }\n\n  | otherwise\n  = do { traceTc \"Non Application rule\" (ppr op)\n       ; (wrap, op', [HsValArg arg1', HsValArg arg2'])\n           <- tcApp (Just $ mk_op_msg op)\n                     op [HsValArg arg1, HsValArg arg2] res_ty\n       ; return (mkHsWrap wrap $ OpApp fix arg1' op' arg2') }\n\n-- Right sections, equivalent to \\ x -> x `op` expr, or\n--      \\ x -> op x expr\n\ntcExpr expr@(SectionR x op arg2) res_ty\n  = do { (op', op_ty) <- tcInferFun op\n       ; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty)\n                  <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty\n       ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr)\n                                 (mkVisFunTy arg1_ty op_res_ty) res_ty\n       ; arg2' <- tcArg op arg2 arg2_ty 2\n       ; return ( mkHsWrap wrap_res $\n                  SectionR x (mkLHsWrap wrap_fun op') arg2' ) }\n  where\n    fn_orig = lexprCtOrigin op\n    -- It's important to use the origin of 'op', so that call-stacks\n    -- come out right; they are driven by the OccurrenceOf CtOrigin\n    -- See Trac #13285\n\ntcExpr expr@(SectionL x arg1 op) res_ty\n  = do { (op', op_ty) <- tcInferFun op\n       ; dflags <- getDynFlags      -- Note [Left sections]\n       ; let n_reqd_args | xopt LangExt.PostfixOperators dflags = 1\n                         | otherwise                            = 2\n\n       ; (wrap_fn, (arg1_ty:arg_tys), op_res_ty)\n           <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op))\n                                n_reqd_args op_ty\n       ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr)\n                                 (mkVisFunTys arg_tys op_res_ty) res_ty\n       ; arg1' <- tcArg op arg1 arg1_ty 1\n       ; return ( mkHsWrap wrap_res $\n                  SectionL x arg1' (mkLHsWrap wrap_fn op') ) }\n  where\n    fn_orig = lexprCtOrigin op\n    -- It's important to use the origin of 'op', so that call-stacks\n    -- come out right; they are driven by the OccurrenceOf CtOrigin\n    -- See Trac #13285\n\ntcExpr expr@(ExplicitTuple x tup_args boxity) res_ty\n  | all tupArgPresent tup_args\n  = do { let arity  = length tup_args\n             tup_tc = tupleTyCon boxity arity\n       ; res_ty <- expTypeToType res_ty\n       ; (coi, arg_tys) <- matchExpectedTyConApp tup_tc res_ty\n                           -- Unboxed tuples have RuntimeRep vars, which we\n                           -- don't care about here\n                           -- See Note [Unboxed tuple RuntimeRep vars] in TyCon\n       ; let arg_tys' = case boxity of Unboxed -> drop arity arg_tys\n                                       Boxed   -> arg_tys\n       ; tup_args1 <- tcTupArgs tup_args arg_tys'\n       ; return $ mkHsWrapCo coi (ExplicitTuple x tup_args1 boxity) }\n\n  | otherwise\n  = -- The tup_args are a mixture of Present and Missing (for tuple sections)\n    do { let arity = length tup_args\n\n       ; arg_tys <- case boxity of\n           { Boxed   -> newFlexiTyVarTys arity liftedTypeKind\n           ; Unboxed -> replicateM arity newOpenFlexiTyVarTy }\n       ; let actual_res_ty\n                 = mkVisFunTys [ty | (ty, (L _ (Missing _))) <- arg_tys `zip` tup_args]\n                            (mkTupleTy boxity arg_tys)\n\n       ; wrap <- tcSubTypeHR (Shouldn'tHappenOrigin \"ExpTuple\")\n                             (Just expr)\n                             actual_res_ty res_ty\n\n       -- Handle tuple sections where\n       ; tup_args1 <- tcTupArgs tup_args arg_tys\n\n       ; return $ mkHsWrap wrap (ExplicitTuple x tup_args1 boxity) }\n\ntcExpr (ExplicitSum _ alt arity expr) res_ty\n  = do { let sum_tc = sumTyCon arity\n       ; res_ty <- expTypeToType res_ty\n       ; (coi, arg_tys) <- matchExpectedTyConApp sum_tc res_ty\n       ; -- Drop levity vars, we don't care about them here\n         let arg_tys' = drop arity arg_tys\n       ; expr' <- tcPolyExpr expr (arg_tys' `getNth` (alt - 1))\n       ; return $ mkHsWrapCo coi (ExplicitSum arg_tys' alt arity expr' ) }\n\ntcExpr (ExplicitList _ witness exprs) res_ty\n  = case witness of\n      Nothing   -> do  { res_ty <- expTypeToType res_ty\n                       ; (coi, elt_ty) <- matchExpectedListTy res_ty\n                       ; exprs' <- mapM (tc_elt elt_ty) exprs\n                       ; return $\n                         mkHsWrapCo coi $ ExplicitList elt_ty Nothing exprs' }\n\n      Just fln -> do { ((exprs', elt_ty), fln')\n                         <- tcSyntaxOp ListOrigin fln\n                                       [synKnownType intTy, SynList] res_ty $\n                            \\ [elt_ty] ->\n                            do { exprs' <-\n                                    mapM (tc_elt elt_ty) exprs\n                               ; return (exprs', elt_ty) }\n\n                     ; return $ ExplicitList elt_ty (Just fln') exprs' }\n     where tc_elt elt_ty expr = tcPolyExpr expr elt_ty\n\n{-\n************************************************************************\n*                                                                      *\n                Let, case, if, do\n*                                                                      *\n************************************************************************\n-}\n\ntcExpr (HsLet x (L l binds) expr) res_ty\n  = do  { (binds', expr') <- tcLocalBinds binds $\n                             tcMonoExpr expr res_ty\n        ; return (HsLet x (L l binds') expr') }\n\ntcExpr (HsCase x scrut matches) res_ty\n  = do  {  -- We used to typecheck the case alternatives first.\n           -- The case patterns tend to give good type info to use\n           -- when typechecking the scrutinee.  For example\n           --   case (map f) of\n           --     (x:xs) -> ...\n           -- will report that map is applied to too few arguments\n           --\n           -- But now, in the GADT world, we need to typecheck the scrutinee\n           -- first, to get type info that may be refined in the case alternatives\n          (scrut', scrut_ty) <- tcInferRho scrut\n\n        ; traceTc \"HsCase\" (ppr scrut_ty)\n        ; matches' <- tcMatchesCase match_ctxt scrut_ty matches res_ty\n        ; return (HsCase x scrut' matches') }\n where\n    match_ctxt = MC { mc_what = CaseAlt,\n                      mc_body = tcBody }\n\ntcExpr (HsIf x Nothing pred b1 b2) res_ty    -- Ordinary 'if'\n  = do { pred' <- tcMonoExpr pred (mkCheckExpType boolTy)\n       ; res_ty <- tauifyExpType res_ty\n           -- Just like Note [Case branches must never infer a non-tau type]\n           -- in TcMatches (See #10619)\n\n       ; b1' <- tcMonoExpr b1 res_ty\n       ; b2' <- tcMonoExpr b2 res_ty\n       ; return (HsIf x Nothing pred' b1' b2') }\n\ntcExpr (HsIf x (Just fun) pred b1 b2) res_ty\n  = do { ((pred', b1', b2'), fun')\n           <- tcSyntaxOp IfOrigin fun [SynAny, SynAny, SynAny] res_ty $\n              \\ [pred_ty, b1_ty, b2_ty] ->\n              do { pred' <- tcPolyExpr pred pred_ty\n                 ; b1'   <- tcPolyExpr b1   b1_ty\n                 ; b2'   <- tcPolyExpr b2   b2_ty\n                 ; return (pred', b1', b2') }\n       ; return (HsIf x (Just fun') pred' b1' b2') }\n\ntcExpr (HsMultiIf _ alts) res_ty\n  = do { res_ty <- if isSingleton alts\n                   then return res_ty\n                   else tauifyExpType res_ty\n             -- Just like TcMatches\n             -- Note [Case branches must never infer a non-tau type]\n\n       ; alts' <- mapM (wrapLocM $ tcGRHS match_ctxt res_ty) alts\n       ; res_ty <- readExpType res_ty\n       ; return (HsMultiIf res_ty alts') }\n  where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody }\n\ntcExpr (HsDo _ do_or_lc stmts) res_ty\n  = do { expr' <- tcDoStmts do_or_lc stmts res_ty\n       ; return expr' }\n\ntcExpr (HsProc x pat cmd) res_ty\n  = do  { (pat', cmd', coi) <- tcProc pat cmd res_ty\n        ; return $ mkHsWrapCo coi (HsProc x pat' cmd') }\n\n-- Typechecks the static form and wraps it with a call to 'fromStaticPtr'.\n-- See Note [Grand plan for static forms] in StaticPtrTable for an overview.\n-- To type check\n--      (static e) :: p a\n-- we want to check (e :: a),\n-- and wrap (static e) in a call to\n--    fromStaticPtr :: IsStatic p => StaticPtr a -> p a\n\ntcExpr (HsStatic fvs expr) res_ty\n  = do  { res_ty          <- expTypeToType res_ty\n        ; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty\n        ; (expr', lie)    <- captureConstraints $\n            addErrCtxt (hang (text \"In the body of a static form:\")\n                             2 (ppr expr)\n                       ) $\n            tcPolyExprNC expr expr_ty\n\n        -- Check that the free variables of the static form are closed.\n        -- It's OK to use nonDetEltsUniqSet here as the only side effects of\n        -- checkClosedInStaticForm are error messages.\n        ; mapM_ checkClosedInStaticForm $ nonDetEltsUniqSet fvs\n\n        -- Require the type of the argument to be Typeable.\n        -- The evidence is not used, but asking the constraint ensures that\n        -- the current implementation is as restrictive as future versions\n        -- of the StaticPointers extension.\n        ; typeableClass <- tcLookupClass typeableClassName\n        ; _ <- emitWantedEvVar StaticOrigin $\n                  mkTyConApp (classTyCon typeableClass)\n                             [liftedTypeKind, expr_ty]\n\n        -- Insert the constraints of the static form in a global list for later\n        -- validation.\n        ; emitStaticConstraints lie\n\n        -- Wrap the static form with the 'fromStaticPtr' call.\n        ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName p_ty\n        ; let wrap = mkWpTyApps [expr_ty]\n        ; loc <- getSrcSpanM\n        ; return $ mkHsWrapCo co $ HsApp noExt\n                                         (L loc $ mkHsWrap wrap fromStaticPtr)\n                                         (L loc (HsStatic fvs expr'))\n        }\n\n{-\n************************************************************************\n*                                                                      *\n                Record construction and update\n*                                                                      *\n************************************************************************\n-}\n\ntcExpr expr@(RecordCon { rcon_con_name = L loc con_name\n                       , rcon_flds = rbinds }) res_ty\n  = do  { con_like <- tcLookupConLike con_name\n\n        -- Check for missing fields\n        ; checkMissingFields con_like rbinds\n\n        ; (con_expr, con_sigma) <- tcInferId con_name\n        ; (con_wrap, con_tau) <-\n            topInstantiate (OccurrenceOf con_name) con_sigma\n              -- a shallow instantiation should really be enough for\n              -- a data constructor.\n        ; let arity = conLikeArity con_like\n              Right (arg_tys, actual_res_ty) = tcSplitFunTysN arity con_tau\n        ; case conLikeWrapId_maybe con_like of\n               Nothing -> nonBidirectionalErr (conLikeName con_like)\n               Just con_id -> do {\n                  res_wrap <- tcSubTypeHR (Shouldn'tHappenOrigin \"RecordCon\")\n                                          (Just expr) actual_res_ty res_ty\n                ; rbinds' <- tcRecordBinds con_like arg_tys rbinds\n                ; return $\n                  mkHsWrap res_wrap $\n                  RecordCon { rcon_ext = RecordConTc\n                                 { rcon_con_like = con_like\n                                 , rcon_con_expr = mkHsWrap con_wrap con_expr }\n                            , rcon_con_name = L loc con_id\n                            , rcon_flds = rbinds' } } }\n\n{-\nNote [Type of a record update]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe main complication with RecordUpd is that we need to explicitly\nhandle the *non-updated* fields.  Consider:\n\n        data T a b c = MkT1 { fa :: a, fb :: (b,c) }\n                     | MkT2 { fa :: a, fb :: (b,c), fc :: c -> c }\n                     | MkT3 { fd :: a }\n\n        upd :: T a b c -> (b',c) -> T a b' c\n        upd t x = t { fb = x}\n\nThe result type should be (T a b' c)\nnot (T a b c),   because 'b' *is not* mentioned in a non-updated field\nnot (T a b' c'), because 'c' *is*     mentioned in a non-updated field\nNB that it's not good enough to look at just one constructor; we must\nlook at them all; cf Trac #3219\n\nAfter all, upd should be equivalent to:\n        upd t x = case t of\n                        MkT1 p q -> MkT1 p x\n                        MkT2 a b -> MkT2 p b\n                        MkT3 d   -> error ...\n\nSo we need to give a completely fresh type to the result record,\nand then constrain it by the fields that are *not* updated (\"p\" above).\nWe call these the \"fixed\" type variables, and compute them in getFixedTyVars.\n\nNote that because MkT3 doesn't contain all the fields being updated,\nits RHS is simply an error, so it doesn't impose any type constraints.\nHence the use of 'relevant_cont'.\n\nNote [Implicit type sharing]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe also take into account any \"implicit\" non-update fields.  For example\n        data T a b where { MkT { f::a } :: T a a; ... }\nSo the \"real\" type of MkT is: forall ab. (a~b) => a -> T a b\n\nThen consider\n        upd t x = t { f=x }\nWe infer the type\n        upd :: T a b -> a -> T a b\n        upd (t::T a b) (x::a)\n           = case t of { MkT (co:a~b) (_:a) -> MkT co x }\nWe can't give it the more general type\n        upd :: T a b -> c -> T c b\n\nNote [Criteria for update]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want to allow update for existentials etc, provided the updated\nfield isn't part of the existential. For example, this should be ok.\n  data T a where { MkT { f1::a, f2::b->b } :: T a }\n  f :: T a -> b -> T b\n  f t b = t { f1=b }\n\nThe criterion we use is this:\n\n  The types of the updated fields\n  mention only the universally-quantified type variables\n  of the data constructor\n\nNB: this is not (quite) the same as being a \"naughty\" record selector\n(See Note [Naughty record selectors]) in TcTyClsDecls), at least\nin the case of GADTs. Consider\n   data T a where { MkT :: { f :: a } :: T [a] }\nThen f is not \"naughty\" because it has a well-typed record selector.\nBut we don't allow updates for 'f'.  (One could consider trying to\nallow this, but it makes my head hurt.  Badly.  And no one has asked\nfor it.)\n\nIn principle one could go further, and allow\n  g :: T a -> T a\n  g t = t { f2 = \\x -> x }\nbecause the expression is polymorphic...but that seems a bridge too far.\n\nNote [Data family example]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n    data instance T (a,b) = MkT { x::a, y::b }\n  --->\n    data :TP a b = MkT { a::a, y::b }\n    coTP a b :: T (a,b) ~ :TP a b\n\nSuppose r :: T (t1,t2), e :: t3\nThen  r { x=e } :: T (t3,t1)\n  --->\n      case r |> co1 of\n        MkT x y -> MkT e y |> co2\n      where co1 :: T (t1,t2) ~ :TP t1 t2\n            co2 :: :TP t3 t2 ~ T (t3,t2)\nThe wrapping with co2 is done by the constructor wrapper for MkT\n\nOutgoing invariants\n~~~~~~~~~~~~~~~~~~~\nIn the outgoing (HsRecordUpd scrut binds cons in_inst_tys out_inst_tys):\n\n  * cons are the data constructors to be updated\n\n  * in_inst_tys, out_inst_tys have same length, and instantiate the\n        *representation* tycon of the data cons.  In Note [Data\n        family example], in_inst_tys = [t1,t2], out_inst_tys = [t3,t2]\n\nNote [Mixed Record Field Updates]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following pattern synonym.\n\n  data MyRec = MyRec { foo :: Int, qux :: String }\n\n  pattern HisRec{f1, f2} = MyRec{foo = f1, qux=f2}\n\nThis allows updates such as the following\n\n  updater :: MyRec -> MyRec\n  updater a = a {f1 = 1 }\n\nIt would also make sense to allow the following update (which we reject).\n\n  updater a = a {f1 = 1, qux = \"two\" } ==? MyRec 1 \"two\"\n\nThis leads to confusing behaviour when the selectors in fact refer the same\nfield.\n\n  updater a = a {f1 = 1, foo = 2} ==? ???\n\nFor this reason, we reject a mixture of pattern synonym and normal record\nselectors in the same update block. Although of course we still allow the\nfollowing.\n\n  updater a = (a {f1 = 1}) {foo = 2}\n\n  > updater (MyRec 0 \"str\")\n  MyRec 2 \"str\"\n\n-}\n\ntcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty\n  = ASSERT( notNull rbnds )\n    do  { -- STEP -2: typecheck the record_expr, the record to be updated\n          (record_expr', record_rho) <- tcInferRho record_expr\n\n        -- STEP -1  See Note [Disambiguating record fields]\n        -- After this we know that rbinds is unambiguous\n        ; rbinds <- disambiguateRecordBinds record_expr record_rho rbnds res_ty\n        ; let upd_flds = map (unLoc . hsRecFieldLbl . unLoc) rbinds\n              upd_fld_occs = map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc) upd_flds\n              sel_ids      = map selectorAmbiguousFieldOcc upd_flds\n        -- STEP 0\n        -- Check that the field names are really field names\n        -- and they are all field names for proper records or\n        -- all field names for pattern synonyms.\n        ; let bad_guys = [ setSrcSpan loc $ addErrTc (notSelector fld_name)\n                         | fld <- rbinds,\n                           -- Excludes class ops\n                           let L loc sel_id = hsRecUpdFieldId (unLoc fld),\n                           not (isRecordSelector sel_id),\n                           let fld_name = idName sel_id ]\n        ; unless (null bad_guys) (sequence bad_guys >> failM)\n        -- See note [Mixed Record Selectors]\n        ; let (data_sels, pat_syn_sels) =\n                partition isDataConRecordSelector sel_ids\n        ; MASSERT( all isPatSynRecordSelector pat_syn_sels )\n        ; checkTc ( null data_sels || null pat_syn_sels )\n                  ( mixedSelectors data_sels pat_syn_sels )\n\n        -- STEP 1\n        -- Figure out the tycon and data cons from the first field name\n        ; let   -- It's OK to use the non-tc splitters here (for a selector)\n              sel_id : _  = sel_ids\n\n              mtycon :: Maybe TyCon\n              mtycon = case idDetails sel_id of\n                          RecSelId (RecSelData tycon) _ -> Just tycon\n                          _ -> Nothing\n\n              con_likes :: [ConLike]\n              con_likes = case idDetails sel_id of\n                             RecSelId (RecSelData tc) _\n                                -> map RealDataCon (tyConDataCons tc)\n                             RecSelId (RecSelPatSyn ps) _\n                                -> [PatSynCon ps]\n                             _  -> panic \"tcRecordUpd\"\n                -- NB: for a data type family, the tycon is the instance tycon\n\n              relevant_cons = conLikesWithFields con_likes upd_fld_occs\n                -- A constructor is only relevant to this process if\n                -- it contains *all* the fields that are being updated\n                -- Other ones will cause a runtime error if they occur\n\n        -- Step 2\n        -- Check that at least one constructor has all the named fields\n        -- i.e. has an empty set of bad fields returned by badFields\n        ; checkTc (not (null relevant_cons)) (badFieldsUpd rbinds con_likes)\n\n        -- Take apart a representative constructor\n        ; let con1 = ASSERT( not (null relevant_cons) ) head relevant_cons\n              (con1_tvs, _, _, _prov_theta, req_theta, con1_arg_tys, _)\n                 = conLikeFullSig con1\n              con1_flds   = map flLabel $ conLikeFieldLabels con1\n              con1_tv_tys = mkTyVarTys con1_tvs\n              con1_res_ty = case mtycon of\n                              Just tc -> mkFamilyTyConApp tc con1_tv_tys\n                              Nothing -> conLikeResTy con1 con1_tv_tys\n\n        -- Check that we're not dealing with a unidirectional pattern\n        -- synonym\n        ; unless (isJust $ conLikeWrapId_maybe con1)\n                  (nonBidirectionalErr (conLikeName con1))\n\n        -- STEP 3    Note [Criteria for update]\n        -- Check that each updated field is polymorphic; that is, its type\n        -- mentions only the universally-quantified variables of the data con\n        ; let flds1_w_tys  = zipEqual \"tcExpr:RecConUpd\" con1_flds con1_arg_tys\n              bad_upd_flds = filter bad_fld flds1_w_tys\n              con1_tv_set  = mkVarSet con1_tvs\n              bad_fld (fld, ty) = fld `elem` upd_fld_occs &&\n                                      not (tyCoVarsOfType ty `subVarSet` con1_tv_set)\n        ; checkTc (null bad_upd_flds) (badFieldTypes bad_upd_flds)\n\n        -- STEP 4  Note [Type of a record update]\n        -- Figure out types for the scrutinee and result\n        -- Both are of form (T a b c), with fresh type variables, but with\n        -- common variables where the scrutinee and result must have the same type\n        -- These are variables that appear in *any* arg of *any* of the\n        -- relevant constructors *except* in the updated fields\n        --\n        ; let fixed_tvs = getFixedTyVars upd_fld_occs con1_tvs relevant_cons\n              is_fixed_tv tv = tv `elemVarSet` fixed_tvs\n\n              mk_inst_ty :: TCvSubst -> (TyVar, TcType) -> TcM (TCvSubst, TcType)\n              -- Deals with instantiation of kind variables\n              --   c.f. TcMType.newMetaTyVars\n              mk_inst_ty subst (tv, result_inst_ty)\n                | is_fixed_tv tv   -- Same as result type\n                = return (extendTvSubst subst tv result_inst_ty, result_inst_ty)\n                | otherwise        -- Fresh type, of correct kind\n                = do { (subst', new_tv) <- newMetaTyVarX subst tv\n                     ; return (subst', mkTyVarTy new_tv) }\n\n        ; (result_subst, con1_tvs') <- newMetaTyVars con1_tvs\n        ; let result_inst_tys = mkTyVarTys con1_tvs'\n              init_subst = mkEmptyTCvSubst (getTCvInScope result_subst)\n\n        ; (scrut_subst, scrut_inst_tys) <- mapAccumLM mk_inst_ty init_subst\n                                                      (con1_tvs `zip` result_inst_tys)\n\n        ; let rec_res_ty    = TcType.substTy result_subst con1_res_ty\n              scrut_ty      = TcType.substTy scrut_subst  con1_res_ty\n              con1_arg_tys' = map (TcType.substTy result_subst) con1_arg_tys\n\n        ; wrap_res <- tcSubTypeHR (exprCtOrigin expr)\n                                  (Just expr) rec_res_ty res_ty\n        ; co_scrut <- unifyType (Just (unLoc record_expr)) record_rho scrut_ty\n                -- NB: normal unification is OK here (as opposed to subsumption),\n                -- because for this to work out, both record_rho and scrut_ty have\n                -- to be normal datatypes -- no contravariant stuff can go on\n\n        -- STEP 5\n        -- Typecheck the bindings\n        ; rbinds'      <- tcRecordUpd con1 con1_arg_tys' rbinds\n\n        -- STEP 6: Deal with the stupid theta\n        ; let theta' = substThetaUnchecked scrut_subst (conLikeStupidTheta con1)\n        ; instStupidTheta RecordUpdOrigin theta'\n\n        -- Step 7: make a cast for the scrutinee, in the\n        --         case that it's from a data family\n        ; let fam_co :: HsWrapper   -- RepT t1 .. tn ~R scrut_ty\n              fam_co | Just tycon <- mtycon\n                     , Just co_con <- tyConFamilyCoercion_maybe tycon\n                     = mkWpCastR (mkTcUnbranchedAxInstCo co_con scrut_inst_tys [])\n                     | otherwise\n                     = idHsWrapper\n\n        -- Step 8: Check that the req constraints are satisfied\n        -- For normal data constructors req_theta is empty but we must do\n        -- this check for pattern synonyms.\n        ; let req_theta' = substThetaUnchecked scrut_subst req_theta\n        ; req_wrap <- instCallConstraints RecordUpdOrigin req_theta'\n\n        -- Phew!\n        ; return $\n          mkHsWrap wrap_res $\n          RecordUpd { rupd_expr\n                          = mkLHsWrap fam_co (mkLHsWrapCo co_scrut record_expr')\n                    , rupd_flds = rbinds'\n                    , rupd_ext = RecordUpdTc\n                        { rupd_cons = relevant_cons\n                        , rupd_in_tys = scrut_inst_tys\n                        , rupd_out_tys = result_inst_tys\n                        , rupd_wrap = req_wrap }} }\n\ntcExpr e@(HsRecFld _ f) res_ty\n    = tcCheckRecSelId e f res_ty\n\n{-\n************************************************************************\n*                                                                      *\n        Arithmetic sequences                    e.g. [a,b..]\n        and their parallel-array counterparts   e.g. [: a,b.. :]\n\n*                                                                      *\n************************************************************************\n-}\n\ntcExpr (ArithSeq _ witness seq) res_ty\n  = tcArithSeq witness seq res_ty\n\n{-\n************************************************************************\n*                                                                      *\n                Template Haskell\n*                                                                      *\n************************************************************************\n-}\n\n-- HsSpliced is an annotation produced by 'RnSplice.rnSpliceExpr'.\n-- Here we get rid of it and add the finalizers to the global environment.\n--\n-- See Note [Delaying modFinalizers in untyped splices] in RnSplice.\ntcExpr (HsSpliceE _ (HsSpliced _ mod_finalizers (HsSplicedExpr expr)))\n       res_ty\n  = do addModFinalizersWithLclEnv mod_finalizers\n       tcExpr expr res_ty\ntcExpr (HsSpliceE _ splice)          res_ty\n  = tcSpliceExpr splice res_ty\ntcExpr e@(HsBracket _ brack)         res_ty\n  = tcTypedBracket e brack res_ty\ntcExpr e@(HsRnBracketOut _ brack ps) res_ty\n  = tcUntypedBracket e brack ps res_ty\n\n{-\n************************************************************************\n*                                                                      *\n                Catch-all\n*                                                                      *\n************************************************************************\n-}\n\ntcExpr other _ = pprPanic \"tcMonoExpr\" (ppr other)\n  -- Include ArrForm, ArrApp, which shouldn't appear at all\n  -- Also HsTcBracketOut, HsQuasiQuoteE\n\n{-\n************************************************************************\n*                                                                      *\n                Arithmetic sequences [a..b] etc\n*                                                                      *\n************************************************************************\n-}\n\ntcArithSeq :: Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> ExpRhoType\n           -> TcM (HsExpr GhcTcId)\n\ntcArithSeq witness seq@(From expr) res_ty\n  = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty\n       ; expr' <- tcPolyExpr expr elt_ty\n       ; enum_from <- newMethodFromName (ArithSeqOrigin seq)\n                              enumFromName elt_ty\n       ; return $ mkHsWrap wrap $\n         ArithSeq enum_from wit' (From expr') }\n\ntcArithSeq witness seq@(FromThen expr1 expr2) res_ty\n  = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty\n       ; expr1' <- tcPolyExpr expr1 elt_ty\n       ; expr2' <- tcPolyExpr expr2 elt_ty\n       ; enum_from_then <- newMethodFromName (ArithSeqOrigin seq)\n                              enumFromThenName elt_ty\n       ; return $ mkHsWrap wrap $\n         ArithSeq enum_from_then wit' (FromThen expr1' expr2') }\n\ntcArithSeq witness seq@(FromTo expr1 expr2) res_ty\n  = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty\n       ; expr1' <- tcPolyExpr expr1 elt_ty\n       ; expr2' <- tcPolyExpr expr2 elt_ty\n       ; enum_from_to <- newMethodFromName (ArithSeqOrigin seq)\n                              enumFromToName elt_ty\n       ; return $ mkHsWrap wrap $\n         ArithSeq enum_from_to wit' (FromTo expr1' expr2') }\n\ntcArithSeq witness seq@(FromThenTo expr1 expr2 expr3) res_ty\n  = do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty\n        ; expr1' <- tcPolyExpr expr1 elt_ty\n        ; expr2' <- tcPolyExpr expr2 elt_ty\n        ; expr3' <- tcPolyExpr expr3 elt_ty\n        ; eft <- newMethodFromName (ArithSeqOrigin seq)\n                              enumFromThenToName elt_ty\n        ; return $ mkHsWrap wrap $\n          ArithSeq eft wit' (FromThenTo expr1' expr2' expr3') }\n\n-----------------\narithSeqEltType :: Maybe (SyntaxExpr GhcRn) -> ExpRhoType\n                -> TcM (HsWrapper, TcType, Maybe (SyntaxExpr GhcTc))\narithSeqEltType Nothing res_ty\n  = do { res_ty <- expTypeToType res_ty\n       ; (coi, elt_ty) <- matchExpectedListTy res_ty\n       ; return (mkWpCastN coi, elt_ty, Nothing) }\narithSeqEltType (Just fl) res_ty\n  = do { (elt_ty, fl')\n           <- tcSyntaxOp ListOrigin fl [SynList] res_ty $\n              \\ [elt_ty] -> return elt_ty\n       ; return (idHsWrapper, elt_ty, Just fl') }\n\n{-\n************************************************************************\n*                                                                      *\n                Applications\n*                                                                      *\n************************************************************************\n-}\n\n-- HsArg is defined in HsTypes.hs\n\nwrapHsArgs :: (NoGhcTc (GhcPass id) ~ GhcRn)\n           => LHsExpr (GhcPass id)\n           -> [HsArg (LHsExpr (GhcPass id)) (LHsWcType GhcRn)]\n           -> LHsExpr (GhcPass id)\nwrapHsArgs f []                     = f\nwrapHsArgs f (HsValArg  a : args)   = wrapHsArgs (mkHsApp f a)          args\nwrapHsArgs f (HsTypeArg _ t : args) = wrapHsArgs (mkHsAppType f t)      args\nwrapHsArgs f (HsArgPar sp : args)   = wrapHsArgs (L sp $ HsPar noExt f) args\n\nisHsValArg :: HsArg tm ty -> Bool\nisHsValArg (HsValArg {})  = True\nisHsValArg (HsTypeArg {}) = False\nisHsValArg (HsArgPar {})  = False\n\nisArgPar :: HsArg tm ty -> Bool\nisArgPar (HsArgPar {})  = True\nisArgPar (HsValArg {})  = False\nisArgPar (HsTypeArg {}) = False\n\nisArgPar_maybe :: HsArg a b -> Maybe (HsArg c d)\nisArgPar_maybe (HsArgPar sp) = Just $ HsArgPar sp\nisArgPar_maybe _ = Nothing\n\ntype LHsExprArgIn  = HsArg (LHsExpr GhcRn)   (LHsWcType GhcRn)\ntype LHsExprArgOut = HsArg (LHsExpr GhcTcId) (LHsWcType GhcRn)\n\ntcApp1 :: HsExpr GhcRn  -- either HsApp or HsAppType\n       -> ExpRhoType -> TcM (HsExpr GhcTcId)\ntcApp1 e res_ty\n  = do { (wrap, fun, args) <- tcApp Nothing (noLoc e) [] res_ty\n       ; return (mkHsWrap wrap $ unLoc $ wrapHsArgs fun args) }\n\ntcApp :: Maybe SDoc  -- like \"The function `f' is applied to\"\n                     -- or leave out to get exactly that message\n      -> LHsExpr GhcRn -> [LHsExprArgIn] -- Function and args\n      -> ExpRhoType -> TcM (HsWrapper, LHsExpr GhcTcId, [LHsExprArgOut])\n           -- (wrap, fun, args). For an ordinary function application,\n           -- these should be assembled as (wrap (fun args)).\n           -- But OpApp is slightly different, so that's why the caller\n           -- must assemble\n\ntcApp m_herald (L sp (HsPar _ fun)) args res_ty\n  = tcApp m_herald fun (HsArgPar sp : args) res_ty\n\ntcApp m_herald (L _ (HsApp _ fun arg1)) args res_ty\n  = tcApp m_herald fun (HsValArg arg1 : args) res_ty\n\ntcApp m_herald (L _ (HsAppType _ fun ty1)) args res_ty\n  = tcApp m_herald fun (HsTypeArg noSrcSpan ty1 : args) res_ty\n\ntcApp m_herald fun@(L loc (HsRecFld _ fld_lbl)) args res_ty\n  | Ambiguous _ lbl        <- fld_lbl  -- Still ambiguous\n  , HsValArg (L _ arg) : _ <- filterOut isArgPar args -- A value arg is first\n  , Just sig_ty     <- obviousSig arg  -- A type sig on the arg disambiguates\n  = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty\n       ; sel_name  <- disambiguateSelector lbl sig_tc_ty\n       ; (tc_fun, fun_ty) <- tcInferRecSelId (Unambiguous sel_name lbl)\n       ; tcFunApp m_herald fun (L loc tc_fun) fun_ty args res_ty }\n\ntcApp m_herald fun@(L loc (HsVar _ (L _ fun_id))) args res_ty\n  -- Special typing rule for tagToEnum#\n  | fun_id `hasKey` tagToEnumKey\n  , n_val_args == 1\n  = tcTagToEnum loc fun_id args res_ty\n\n  -- Special typing rule for 'seq'\n  -- In the saturated case, behave as if seq had type\n  --    forall a (b::TYPE r). a -> b -> b\n  -- for some type r.  See Note [Typing rule for seq]\n  | fun_id `hasKey` seqIdKey\n  , n_val_args == 2\n  = do { rep <- newFlexiTyVarTy runtimeRepTy\n       ; let [alpha, beta] = mkTemplateTyVars [liftedTypeKind, tYPE rep]\n             seq_ty = mkSpecForAllTys [alpha,beta]\n                      (mkTyVarTy alpha `mkVisFunTy` mkTyVarTy beta `mkVisFunTy` mkTyVarTy beta)\n             seq_fun = L loc (HsVar noExt (L loc seqId))\n             -- seq_ty = forall (a:*) (b:TYPE r). a -> b -> b\n             -- where 'r' is a meta type variable\n        ; tcFunApp m_herald fun seq_fun seq_ty args res_ty }\n  where\n    n_val_args = count isHsValArg args\n\ntcApp _ (L loc (ExplicitList _ Nothing [])) [HsTypeArg _ ty_arg] res_ty\n  -- See Note [Visible type application for the empty list constructor]\n  = do { ty_arg' <- tcHsTypeApp ty_arg liftedTypeKind\n       ; let list_ty = TyConApp listTyCon [ty_arg']\n       ; _ <- tcSubTypeDS (OccurrenceOf nilDataConName) GenSigCtxt\n                          list_ty res_ty\n       ; let expr :: LHsExpr GhcTcId\n             expr = L loc $ ExplicitList ty_arg' Nothing []\n       ; return (idHsWrapper, expr, []) }\n\ntcApp m_herald fun args res_ty\n  = do { (tc_fun, fun_ty) <- tcInferFun fun\n       ; tcFunApp m_herald fun tc_fun fun_ty args res_ty }\n\n---------------------\ntcFunApp :: Maybe SDoc  -- like \"The function `f' is applied to\"\n                        -- or leave out to get exactly that message\n         -> LHsExpr GhcRn                  -- Renamed function\n         -> LHsExpr GhcTcId -> TcSigmaType -- Function and its type\n         -> [LHsExprArgIn]                 -- Arguments\n         -> ExpRhoType                     -- Overall result type\n         -> TcM (HsWrapper, LHsExpr GhcTcId, [LHsExprArgOut])\n            -- (wrapper-for-result, fun, args)\n            -- For an ordinary function application,\n            -- these should be assembled as wrap_res[ fun args ]\n            -- But OpApp is slightly different, so that's why the caller\n            -- must assemble\n\n-- tcFunApp deals with the general case;\n-- the special cases are handled by tcApp\ntcFunApp m_herald rn_fun tc_fun fun_sigma rn_args res_ty\n  = do { let orig = lexprCtOrigin rn_fun\n\n       ; traceTc \"tcFunApp\" (ppr rn_fun <+> dcolon <+> ppr fun_sigma $$ ppr rn_args $$ ppr res_ty)\n       ; (wrap_fun, tc_args, actual_res_ty)\n           <- tcArgs rn_fun fun_sigma orig rn_args\n                     (m_herald `orElse` mk_app_msg rn_fun rn_args)\n\n            -- this is just like tcWrapResult, but the types don't line\n            -- up to call that function\n       ; wrap_res <- addFunResCtxt True (unLoc rn_fun) actual_res_ty res_ty $\n                     tcSubTypeDS_NC_O orig GenSigCtxt\n                       (Just $ unLoc $ wrapHsArgs rn_fun rn_args)\n                       actual_res_ty res_ty\n\n       ; return (wrap_res, mkLHsWrap wrap_fun tc_fun, tc_args) }\n\nmk_app_msg :: LHsExpr GhcRn -> [LHsExprArgIn] -> SDoc\nmk_app_msg fun args = sep [ text \"The\" <+> text what <+> quotes (ppr expr)\n                          , text \"is applied to\"]\n  where\n    what | null type_app_args = \"function\"\n         | otherwise          = \"expression\"\n    -- Include visible type arguments (but not other arguments) in the herald.\n    -- See Note [Herald for matchExpectedFunTys] in TcUnify.\n    expr = mkHsAppTypes fun type_app_args\n    type_app_args = [hs_ty | HsTypeArg _ hs_ty <- args]\n\nmk_op_msg :: LHsExpr GhcRn -> SDoc\nmk_op_msg op = text \"The operator\" <+> quotes (ppr op) <+> text \"takes\"\n\n{-\nNote [Visible type application for the empty list constructor]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGetting the expression [] @Int to typecheck is slightly tricky since [] isn't\nan ordinary data constructor. By default, when tcExpr typechecks a list\nexpression, it wraps the expression in a coercion, which gives it a type to the\neffect of p[a]. It isn't until later zonking that the type becomes\nforall a. [a], but that's too late for visible type application.\n\nThe workaround is to check for empty list expressions that have a visible type\nargument in tcApp, and if so, directly typecheck [] @ty data constructor name.\nThis avoids the intermediate coercion and produces an expression of type [ty],\nas one would intuitively expect.\n\nUnfortunately, this workaround isn't terribly robust, since more involved\nexpressions such as (let in []) @Int won't work. Until a more elegant fix comes\nalong, however, this at least allows direct type application on [] to work,\nwhich is better than before.\n-}\n\n----------------\ntcInferFun :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcSigmaType)\n-- Infer type of a function\ntcInferFun (L loc (HsVar _ (L _ name)))\n  = do { (fun, ty) <- setSrcSpan loc (tcInferId name)\n               -- Don't wrap a context around a plain Id\n       ; return (L loc fun, ty) }\n\ntcInferFun (L loc (HsRecFld _ f))\n  = do { (fun, ty) <- setSrcSpan loc (tcInferRecSelId f)\n               -- Don't wrap a context around a plain Id\n       ; return (L loc fun, ty) }\n\ntcInferFun fun\n  = tcInferSigma fun\n      -- NB: tcInferSigma; see TcUnify\n      -- Note [Deep instantiation of InferResult] in TcUnify\n\n\n----------------\n-- | Type-check the arguments to a function, possibly including visible type\n-- applications\ntcArgs :: LHsExpr GhcRn   -- ^ The function itself (for err msgs only)\n       -> TcSigmaType    -- ^ the (uninstantiated) type of the function\n       -> CtOrigin       -- ^ the origin for the function's type\n       -> [LHsExprArgIn] -- ^ the args\n       -> SDoc           -- ^ the herald for matchActualFunTys\n       -> TcM (HsWrapper, [LHsExprArgOut], TcSigmaType)\n          -- ^ (a wrapper for the function, the tc'd args, result type)\ntcArgs fun orig_fun_ty fun_orig orig_args herald\n  = go [] 1 orig_fun_ty orig_args\n  where\n    -- Don't count visible type arguments when determining how many arguments\n    -- an expression is given in an arity mismatch error, since visible type\n    -- arguments reported as a part of the expression herald itself.\n    -- See Note [Herald for matchExpectedFunTys] in TcUnify.\n    orig_expr_args_arity = count isHsValArg orig_args\n\n    go _ _ fun_ty [] = return (idHsWrapper, [], fun_ty)\n\n    go acc_args n fun_ty (HsArgPar sp : args)\n      = do { (inner_wrap, args', res_ty) <- go acc_args n fun_ty args\n           ; return (inner_wrap, HsArgPar sp : args', res_ty)\n           }\n\n    go acc_args n fun_ty (HsTypeArg l hs_ty_arg : args)\n      = do { (wrap1, upsilon_ty) <- topInstantiateInferred fun_orig fun_ty\n               -- wrap1 :: fun_ty \"->\" upsilon_ty\n           ; case tcSplitForAllTy_maybe upsilon_ty of\n               Just (tvb, inner_ty)\n                 | binderArgFlag tvb == Specified ->\n                   -- It really can't be Inferred, because we've justn\n                   -- instantiated those. But, oddly, it might just be Required.\n                   -- See Note [Required quantifiers in the type of a term]\n                 do { let tv   = binderVar tvb\n                          kind = tyVarKind tv\n                    ; ty_arg <- tcHsTypeApp hs_ty_arg kind\n\n                    ; inner_ty <- zonkTcType inner_ty\n                          -- See Note [Visible type application zonk]\n                    ; let in_scope  = mkInScopeSet (tyCoVarsOfTypes [upsilon_ty, ty_arg])\n\n                          insted_ty = substTyWithInScope in_scope [tv] [ty_arg] inner_ty\n                                      -- NB: tv and ty_arg have the same kind, so this\n                                      --     substitution is kind-respecting\n                    ; traceTc \"VTA\" (vcat [ppr tv, debugPprType kind\n                                          , debugPprType ty_arg\n                                          , debugPprType (tcTypeKind ty_arg)\n                                          , debugPprType inner_ty\n                                          , debugPprType insted_ty ])\n\n                    ; (inner_wrap, args', res_ty)\n                        <- go acc_args (n+1) insted_ty args\n                   -- inner_wrap :: insted_ty \"->\" (map typeOf args') -> res_ty\n                    ; let inst_wrap = mkWpTyApps [ty_arg]\n                    ; return ( inner_wrap <.> inst_wrap <.> wrap1\n                             , HsTypeArg l hs_ty_arg : args'\n                             , res_ty ) }\n               _ -> ty_app_err upsilon_ty hs_ty_arg }\n\n    go acc_args n fun_ty (HsValArg arg : args)\n      = do { (wrap, [arg_ty], res_ty)\n               <- matchActualFunTysPart herald fun_orig (Just (unLoc fun)) 1 fun_ty\n                                        acc_args orig_expr_args_arity\n               -- wrap :: fun_ty \"->\" arg_ty -> res_ty\n           ; arg' <- tcArg fun arg arg_ty n\n           ; (inner_wrap, args', inner_res_ty)\n               <- go (arg_ty : acc_args) (n+1) res_ty args\n               -- inner_wrap :: res_ty \"->\" (map typeOf args') -> inner_res_ty\n           ; return ( mkWpFun idHsWrapper inner_wrap arg_ty res_ty doc <.> wrap\n                    , HsValArg arg' : args'\n                    , inner_res_ty ) }\n      where\n        doc = text \"When checking the\" <+> speakNth n <+>\n              text \"argument to\" <+> quotes (ppr fun)\n\n    ty_app_err ty arg\n      = do { (_, ty) <- zonkTidyTcType emptyTidyEnv ty\n           ; failWith $\n               text \"Cannot apply expression of type\" <+> quotes (ppr ty) $$\n               text \"to a visible type argument\" <+> quotes (ppr arg) }\n\n{- Note [Required quantifiers in the type of a term]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #15859)\n\n  data A k :: k -> Type      -- A      :: forall k -> k -> Type\n  type KindOf (a :: k) = k   -- KindOf :: forall k. k -> Type\n  a = (undefind :: KindOf A) @Int\n\nWith ImpredicativeTypes (thin ice, I know), we instantiate\nKindOf at type (forall k -> k -> Type), so\n  KindOf A = forall k -> k -> Type\nwhose first argument is Required\n\nWe want to reject this type application to Int, but in earlier\nGHCs we had an ASSERT that Required could not occur here.\n\nThe ice is thin; c.f. Note [No Required TyCoBinder in terms]\nin TyCoRep.\n\nNote [Visible type application zonk]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Substitutions should be kind-preserving, so we need kind(tv) = kind(ty_arg).\n\n* tcHsTypeApp only guarantees that\n    - ty_arg is zonked\n    - kind(zonk(tv)) = kind(ty_arg)\n  (checkExpectedKind zonks as it goes).\n\nSo we must zonk inner_ty as well, to guarantee consistency between zonk(tv)\nand inner_ty.  Otherwise we can build an ill-kinded type.  An example was\nTrac #14158, where we had:\n   id :: forall k. forall (cat :: k -> k -> *). forall (a :: k). cat a a\nand we had the visible type application\n  id @(->)\n\n* We instantiated k := kappa, yielding\n    forall (cat :: kappa -> kappa -> *). forall (a :: kappa). cat a a\n* Then we called tcHsTypeApp (->) with expected kind (kappa -> kappa -> *).\n* That instantiated (->) as ((->) q1 q1), and unified kappa := q1,\n  Here q1 :: RuntimeRep\n* Now we substitute\n     cat  :->  (->) q1 q1 :: TYPE q1 -> TYPE q1 -> *\n  but we must first zonk the inner_ty to get\n      forall (a :: TYPE q1). cat a a\n  so that the result of substitution is well-kinded\n  Failing to do so led to Trac #14158.\n-}\n\n----------------\ntcArg :: LHsExpr GhcRn                   -- The function (for error messages)\n      -> LHsExpr GhcRn                   -- Actual arguments\n      -> TcRhoType                       -- expected arg type\n      -> Int                             -- # of argument\n      -> TcM (LHsExpr GhcTcId)           -- Resulting argument\ntcArg fun arg ty arg_no = addErrCtxt (funAppCtxt fun arg arg_no) $\n                          tcPolyExprNC arg ty\n\n----------------\ntcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTcId]\ntcTupArgs args tys\n  = ASSERT( equalLength args tys ) mapM go (args `zip` tys)\n  where\n    go (L l (Missing {}),   arg_ty) = return (L l (Missing arg_ty))\n    go (L l (Present x expr), arg_ty) = do { expr' <- tcPolyExpr expr arg_ty\n                                           ; return (L l (Present x expr')) }\n    go (L _ (XTupArg{}), _) = panic \"tcTupArgs\"\n\n---------------------------\n-- See TcType.SyntaxOpType also for commentary\ntcSyntaxOp :: CtOrigin\n           -> SyntaxExpr GhcRn\n           -> [SyntaxOpType]           -- ^ shape of syntax operator arguments\n           -> ExpRhoType               -- ^ overall result type\n           -> ([TcSigmaType] -> TcM a) -- ^ Type check any arguments\n           -> TcM (a, SyntaxExpr GhcTcId)\n-- ^ Typecheck a syntax operator\n-- The operator is a variable or a lambda at this stage (i.e. renamer\n-- output)\ntcSyntaxOp orig expr arg_tys res_ty\n  = tcSyntaxOpGen orig expr arg_tys (SynType res_ty)\n\n-- | Slightly more general version of 'tcSyntaxOp' that allows the caller\n-- to specify the shape of the result of the syntax operator\ntcSyntaxOpGen :: CtOrigin\n              -> SyntaxExpr GhcRn\n              -> [SyntaxOpType]\n              -> SyntaxOpType\n              -> ([TcSigmaType] -> TcM a)\n              -> TcM (a, SyntaxExpr GhcTcId)\ntcSyntaxOpGen orig op arg_tys res_ty thing_inside\n  = do { (expr, sigma) <- tcInferSigma $ noLoc $ syn_expr op\n       ; traceTc \"tcSyntaxOpGen\" (ppr op $$ ppr expr $$ ppr sigma)\n       ; (result, expr_wrap, arg_wraps, res_wrap)\n           <- tcSynArgA orig sigma arg_tys res_ty $\n              thing_inside\n       ; traceTc \"tcSyntaxOpGen\" (ppr op $$ ppr expr $$ ppr sigma )\n       ; return (result, SyntaxExpr { syn_expr = mkHsWrap expr_wrap $ unLoc expr\n                                    , syn_arg_wraps = arg_wraps\n                                    , syn_res_wrap  = res_wrap }) }\n\n{-\nNote [tcSynArg]\n~~~~~~~~~~~~~~~\nBecause of the rich structure of SyntaxOpType, we must do the\ncontra-/covariant thing when working down arrows, to get the\ninstantiation vs. skolemisation decisions correct (and, more\nobviously, the orientation of the HsWrappers). We thus have\ntwo tcSynArgs.\n-}\n\n-- works on \"expected\" types, skolemising where necessary\n-- See Note [tcSynArg]\ntcSynArgE :: CtOrigin\n          -> TcSigmaType\n          -> SyntaxOpType                -- ^ shape it is expected to have\n          -> ([TcSigmaType] -> TcM a)    -- ^ check the arguments\n          -> TcM (a, HsWrapper)\n           -- ^ returns a wrapper :: (type of right shape) \"->\" (type passed in)\ntcSynArgE orig sigma_ty syn_ty thing_inside\n  = do { (skol_wrap, (result, ty_wrapper))\n           <- tcSkolemise GenSigCtxt sigma_ty $ \\ _ rho_ty ->\n              go rho_ty syn_ty\n       ; return (result, skol_wrap <.> ty_wrapper) }\n    where\n    go rho_ty SynAny\n      = do { result <- thing_inside [rho_ty]\n           ; return (result, idHsWrapper) }\n\n    go rho_ty SynRho   -- same as SynAny, because we skolemise eagerly\n      = do { result <- thing_inside [rho_ty]\n           ; return (result, idHsWrapper) }\n\n    go rho_ty SynList\n      = do { (list_co, elt_ty) <- matchExpectedListTy rho_ty\n           ; result <- thing_inside [elt_ty]\n           ; return (result, mkWpCastN list_co) }\n\n    go rho_ty (SynFun arg_shape res_shape)\n      = do { ( ( ( (result, arg_ty, res_ty)\n                 , res_wrapper )                   -- :: res_ty_out \"->\" res_ty\n               , arg_wrapper1, [], arg_wrapper2 )  -- :: arg_ty \"->\" arg_ty_out\n             , match_wrapper )         -- :: (arg_ty -> res_ty) \"->\" rho_ty\n               <- matchExpectedFunTys herald 1 (mkCheckExpType rho_ty) $\n                  \\ [arg_ty] res_ty ->\n                  do { arg_tc_ty <- expTypeToType arg_ty\n                     ; res_tc_ty <- expTypeToType res_ty\n\n                         -- another nested arrow is too much for now,\n                         -- but I bet we'll never need this\n                     ; MASSERT2( case arg_shape of\n                                   SynFun {} -> False;\n                                   _         -> True\n                               , text \"Too many nested arrows in SyntaxOpType\" $$\n                                 pprCtOrigin orig )\n\n                     ; tcSynArgA orig arg_tc_ty [] arg_shape $\n                       \\ arg_results ->\n                       tcSynArgE orig res_tc_ty res_shape $\n                       \\ res_results ->\n                       do { result <- thing_inside (arg_results ++ res_results)\n                          ; return (result, arg_tc_ty, res_tc_ty) }}\n\n           ; return ( result\n                    , match_wrapper <.>\n                      mkWpFun (arg_wrapper2 <.> arg_wrapper1) res_wrapper\n                              arg_ty res_ty doc ) }\n      where\n        herald = text \"This rebindable syntax expects a function with\"\n        doc = text \"When checking a rebindable syntax operator arising from\" <+> ppr orig\n\n    go rho_ty (SynType the_ty)\n      = do { wrap   <- tcSubTypeET orig GenSigCtxt the_ty rho_ty\n           ; result <- thing_inside []\n           ; return (result, wrap) }\n\n-- works on \"actual\" types, instantiating where necessary\n-- See Note [tcSynArg]\ntcSynArgA :: CtOrigin\n          -> TcSigmaType\n          -> [SyntaxOpType]              -- ^ argument shapes\n          -> SyntaxOpType                -- ^ result shape\n          -> ([TcSigmaType] -> TcM a)    -- ^ check the arguments\n          -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)\n            -- ^ returns a wrapper to be applied to the original function,\n            -- wrappers to be applied to arguments\n            -- and a wrapper to be applied to the overall expression\ntcSynArgA orig sigma_ty arg_shapes res_shape thing_inside\n  = do { (match_wrapper, arg_tys, res_ty)\n           <- matchActualFunTys herald orig Nothing (length arg_shapes) sigma_ty\n              -- match_wrapper :: sigma_ty \"->\" (arg_tys -> res_ty)\n       ; ((result, res_wrapper), arg_wrappers)\n           <- tc_syn_args_e arg_tys arg_shapes $ \\ arg_results ->\n              tc_syn_arg    res_ty  res_shape  $ \\ res_results ->\n              thing_inside (arg_results ++ res_results)\n       ; return (result, match_wrapper, arg_wrappers, res_wrapper) }\n  where\n    herald = text \"This rebindable syntax expects a function with\"\n\n    tc_syn_args_e :: [TcSigmaType] -> [SyntaxOpType]\n                  -> ([TcSigmaType] -> TcM a)\n                  -> TcM (a, [HsWrapper])\n                    -- the wrappers are for arguments\n    tc_syn_args_e (arg_ty : arg_tys) (arg_shape : arg_shapes) thing_inside\n      = do { ((result, arg_wraps), arg_wrap)\n               <- tcSynArgE     orig arg_ty  arg_shape  $ \\ arg1_results ->\n                  tc_syn_args_e      arg_tys arg_shapes $ \\ args_results ->\n                  thing_inside (arg1_results ++ args_results)\n           ; return (result, arg_wrap : arg_wraps) }\n    tc_syn_args_e _ _ thing_inside = (, []) <$> thing_inside []\n\n    tc_syn_arg :: TcSigmaType -> SyntaxOpType\n               -> ([TcSigmaType] -> TcM a)\n               -> TcM (a, HsWrapper)\n                  -- the wrapper applies to the overall result\n    tc_syn_arg res_ty SynAny thing_inside\n      = do { result <- thing_inside [res_ty]\n           ; return (result, idHsWrapper) }\n    tc_syn_arg res_ty SynRho thing_inside\n      = do { (inst_wrap, rho_ty) <- deeplyInstantiate orig res_ty\n               -- inst_wrap :: res_ty \"->\" rho_ty\n           ; result <- thing_inside [rho_ty]\n           ; return (result, inst_wrap) }\n    tc_syn_arg res_ty SynList thing_inside\n      = do { (inst_wrap, rho_ty) <- topInstantiate orig res_ty\n               -- inst_wrap :: res_ty \"->\" rho_ty\n           ; (list_co, elt_ty)   <- matchExpectedListTy rho_ty\n               -- list_co :: [elt_ty] ~N rho_ty\n           ; result <- thing_inside [elt_ty]\n           ; return (result, mkWpCastN (mkTcSymCo list_co) <.> inst_wrap) }\n    tc_syn_arg _ (SynFun {}) _\n      = pprPanic \"tcSynArgA hits a SynFun\" (ppr orig)\n    tc_syn_arg res_ty (SynType the_ty) thing_inside\n      = do { wrap   <- tcSubTypeO orig GenSigCtxt res_ty the_ty\n           ; result <- thing_inside []\n           ; return (result, wrap) }\n\n{-\nNote [Push result type in]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nUnify with expected result before type-checking the args so that the\ninfo from res_ty percolates to args.  This is when we might detect a\ntoo-few args situation.  (One can think of cases when the opposite\norder would give a better error message.)\nexperimenting with putting this first.\n\nHere's an example where it actually makes a real difference\n\n   class C t a b | t a -> b\n   instance C Char a Bool\n\n   data P t a = forall b. (C t a b) => MkP b\n   data Q t   = MkQ (forall a. P t a)\n\n   f1, f2 :: Q Char;\n   f1 = MkQ (MkP True)\n   f2 = MkQ (MkP True :: forall a. P Char a)\n\nWith the change, f1 will type-check, because the 'Char' info from\nthe signature is propagated into MkQ's argument. With the check\nin the other order, the extra signature in f2 is reqd.\n\n************************************************************************\n*                                                                      *\n                Expressions with a type signature\n                        expr :: type\n*                                                                      *\n********************************************************************* -}\n\ntcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTcId, TcType)\ntcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc })\n  = setSrcSpan loc $   -- Sets the location for the implication constraint\n    do { (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id\n       ; given <- newEvVars theta\n       ; traceTc \"tcExprSig: CompleteSig\" $\n         vcat [ text \"poly_id:\" <+> ppr poly_id <+> dcolon <+> ppr (idType poly_id)\n              , text \"tv_prs:\" <+> ppr tv_prs ]\n\n       ; let skol_info = SigSkol ExprSigCtxt (idType poly_id) tv_prs\n             skol_tvs  = map snd tv_prs\n       ; (ev_binds, expr') <- checkConstraints skol_info skol_tvs given $\n                              tcExtendNameTyVarEnv tv_prs $\n                              tcPolyExprNC expr tau\n\n       ; let poly_wrap = mkWpTyLams   skol_tvs\n                         <.> mkWpLams given\n                         <.> mkWpLet  ev_binds\n       ; return (mkLHsWrap poly_wrap expr', idType poly_id) }\n\ntcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })\n  = setSrcSpan loc $   -- Sets the location for the implication constraint\n    do { (tclvl, wanted, (expr', sig_inst))\n             <- pushLevelAndCaptureConstraints  $\n                do { sig_inst <- tcInstSig sig\n                   ; expr' <- tcExtendNameTyVarEnv (sig_inst_skols sig_inst) $\n                              tcExtendNameTyVarEnv (sig_inst_wcs   sig_inst) $\n                              tcPolyExprNC expr (sig_inst_tau sig_inst)\n                   ; return (expr', sig_inst) }\n       -- See Note [Partial expression signatures]\n       ; let tau = sig_inst_tau sig_inst\n             infer_mode | null (sig_inst_theta sig_inst)\n                        , isNothing (sig_inst_wcx sig_inst)\n                        = ApplyMR\n                        | otherwise\n                        = NoRestrictions\n       ; (qtvs, givens, ev_binds, residual, _)\n                 <- simplifyInfer tclvl infer_mode [sig_inst] [(name, tau)] wanted\n       ; emitConstraints residual\n\n       ; tau <- zonkTcType tau\n       ; let inferred_theta = map evVarPred givens\n             tau_tvs        = tyCoVarsOfType tau\n       ; (binders, my_theta) <- chooseInferredQuantifiers inferred_theta\n                                   tau_tvs qtvs (Just sig_inst)\n       ; let inferred_sigma = mkInfSigmaTy qtvs inferred_theta tau\n             my_sigma       = mkForAllTys binders (mkPhiTy  my_theta tau)\n       ; wrap <- if inferred_sigma `eqType` my_sigma -- NB: eqType ignores vis.\n                 then return idHsWrapper  -- Fast path; also avoids complaint when we infer\n                                          -- an ambiguous type and have AllowAmbiguousType\n                                          -- e..g infer  x :: forall a. F a -> Int\n                 else tcSubType_NC ExprSigCtxt inferred_sigma my_sigma\n\n       ; traceTc \"tcExpSig\" (ppr qtvs $$ ppr givens $$ ppr inferred_sigma $$ ppr my_sigma)\n       ; let poly_wrap = wrap\n                         <.> mkWpTyLams qtvs\n                         <.> mkWpLams givens\n                         <.> mkWpLet  ev_binds\n       ; return (mkLHsWrap poly_wrap expr', my_sigma) }\n\n\n{- Note [Partial expression signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPartial type signatures on expressions are easy to get wrong.  But\nhere is a guiding principile\n    e :: ty\nshould behave like\n    let x :: ty\n        x = e\n    in x\n\nSo for partial signatures we apply the MR if no context is given.  So\n   e :: IO _          apply the MR\n   e :: _ => IO _     do not apply the MR\njust like in TcBinds.decideGeneralisationPlan\n\nThis makes a difference (Trac #11670):\n   peek :: Ptr a -> IO CLong\n   peek ptr = peekElemOff undefined 0 :: _\nfrom (peekElemOff undefined 0) we get\n          type: IO w\n   constraints: Storable w\n\nWe must NOT try to generalise over 'w' because the signature specifies\nno constraints so we'll complain about not being able to solve\nStorable w.  Instead, don't generalise; then _ gets instantiated to\nCLong, as it should.\n-}\n\n{- *********************************************************************\n*                                                                      *\n                 tcInferId\n*                                                                      *\n********************************************************************* -}\n\ntcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTcId)\ntcCheckId name res_ty\n  = do { (expr, actual_res_ty) <- tcInferId name\n       ; traceTc \"tcCheckId\" (vcat [ppr name, ppr actual_res_ty, ppr res_ty])\n       ; addFunResCtxt False (HsVar noExt (noLoc name)) actual_res_ty res_ty $\n         tcWrapResultO (OccurrenceOf name) (HsVar noExt (noLoc name)) expr\n                                                          actual_res_ty res_ty }\n\ntcCheckRecSelId :: HsExpr GhcRn -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)\ntcCheckRecSelId rn_expr f@(Unambiguous _ (L _ lbl)) res_ty\n  = do { (expr, actual_res_ty) <- tcInferRecSelId f\n       ; addFunResCtxt False (HsRecFld noExt f) actual_res_ty res_ty $\n         tcWrapResultO (OccurrenceOfRecSel lbl) rn_expr expr actual_res_ty res_ty }\ntcCheckRecSelId rn_expr (Ambiguous _ lbl) res_ty\n  = case tcSplitFunTy_maybe =<< checkingExpType_maybe res_ty of\n      Nothing       -> ambiguousSelector lbl\n      Just (arg, _) -> do { sel_name <- disambiguateSelector lbl arg\n                          ; tcCheckRecSelId rn_expr (Unambiguous sel_name lbl)\n                                                    res_ty }\ntcCheckRecSelId _ (XAmbiguousFieldOcc _) _ = panic \"tcCheckRecSelId\"\n\n------------------------\ntcInferRecSelId :: AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTcId, TcRhoType)\ntcInferRecSelId (Unambiguous sel (L _ lbl))\n  = do { (expr', ty) <- tc_infer_id lbl sel\n       ; return (expr', ty) }\ntcInferRecSelId (Ambiguous _ lbl)\n  = ambiguousSelector lbl\ntcInferRecSelId (XAmbiguousFieldOcc _) = panic \"tcInferRecSelId\"\n\n------------------------\ntcInferId :: Name -> TcM (HsExpr GhcTcId, TcSigmaType)\n-- Look up an occurrence of an Id\n-- Do not instantiate its type\ntcInferId id_name\n  | id_name `hasKey` tagToEnumKey\n  = failWithTc (text \"tagToEnum# must appear applied to one argument\")\n        -- tcApp catches the case (tagToEnum# arg)\n\n  | id_name `hasKey` assertIdKey\n  = do { dflags <- getDynFlags\n       ; if gopt Opt_IgnoreAsserts dflags\n         then tc_infer_id (nameRdrName id_name) id_name\n         else tc_infer_assert id_name }\n\n  | otherwise\n  = do { (expr, ty) <- tc_infer_id (nameRdrName id_name) id_name\n       ; traceTc \"tcInferId\" (ppr id_name <+> dcolon <+> ppr ty)\n       ; return (expr, ty) }\n\ntc_infer_assert :: Name -> TcM (HsExpr GhcTcId, TcSigmaType)\n-- Deal with an occurrence of 'assert'\n-- See Note [Adding the implicit parameter to 'assert']\ntc_infer_assert assert_name\n  = do { assert_error_id <- tcLookupId assertErrorName\n       ; (wrap, id_rho) <- topInstantiate (OccurrenceOf assert_name)\n                                          (idType assert_error_id)\n       ; return (mkHsWrap wrap (HsVar noExt (noLoc assert_error_id)), id_rho)\n       }\n\ntc_infer_id :: RdrName -> Name -> TcM (HsExpr GhcTcId, TcSigmaType)\ntc_infer_id lbl id_name\n = do { thing <- tcLookup id_name\n      ; case thing of\n             ATcId { tct_id = id }\n               -> do { check_naughty id        -- Note [Local record selectors]\n                     ; checkThLocalId id\n                     ; return_id id }\n\n             AGlobal (AnId id)\n               -> do { check_naughty id\n                     ; return_id id }\n                    -- A global cannot possibly be ill-staged\n                    -- nor does it need the 'lifting' treatment\n                    -- hence no checkTh stuff here\n\n             AGlobal (AConLike cl) -> case cl of\n                 RealDataCon con -> return_data_con con\n                 PatSynCon ps    -> tcPatSynBuilderOcc ps\n\n             _ -> failWithTc $\n                  ppr thing <+> text \"used where a value identifier was expected\" }\n  where\n    return_id id = return (HsVar noExt (noLoc id), idType id)\n\n    return_data_con con\n       -- For data constructors, must perform the stupid-theta check\n      | null stupid_theta\n      = return (HsConLikeOut noExt (RealDataCon con), con_ty)\n\n      | otherwise\n       -- See Note [Instantiating stupid theta]\n      = do { let (tvs, theta, rho) = tcSplitSigmaTy con_ty\n           ; (subst, tvs') <- newMetaTyVars tvs\n           ; let tys'   = mkTyVarTys tvs'\n                 theta' = substTheta subst theta\n                 rho'   = substTy subst rho\n           ; wrap <- instCall (OccurrenceOf id_name) tys' theta'\n           ; addDataConStupidTheta con tys'\n           ; return ( mkHsWrap wrap (HsConLikeOut noExt (RealDataCon con))\n                    , rho') }\n\n      where\n        con_ty         = dataConUserType con\n        stupid_theta   = dataConStupidTheta con\n\n    check_naughty id\n      | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel lbl)\n      | otherwise                  = return ()\n\n\ntcUnboundId :: HsExpr GhcRn -> UnboundVar -> ExpRhoType -> TcM (HsExpr GhcTcId)\n-- Typecheck an occurrence of an unbound Id\n--\n-- Some of these started life as a true expression hole \"_\".\n-- Others might simply be variables that accidentally have no binding site\n--\n-- We turn all of them into HsVar, since HsUnboundVar can't contain an\n-- Id; and indeed the evidence for the CHoleCan does bind it, so it's\n-- not unbound any more!\ntcUnboundId rn_expr unbound res_ty\n = do { ty <- newOpenFlexiTyVarTy  -- Allow Int# etc (Trac #12531)\n      ; let occ = unboundVarOcc unbound\n      ; name <- newSysName occ\n      ; let ev = mkLocalId name ty\n      ; can <- newHoleCt (ExprHole unbound) ev ty\n      ; emitInsoluble can\n      ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar noExt (noLoc ev))\n                                                                     ty res_ty }\n\n\n{-\nNote [Adding the implicit parameter to 'assert']\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe typechecker transforms (assert e1 e2) to (assertError e1 e2).\nThis isn't really the Right Thing because there's no way to \"undo\"\nif you want to see the original source code in the typechecker\noutput.  We'll have fix this in due course, when we care more about\nbeing able to reconstruct the exact original program.\n\nNote [tagToEnum#]\n~~~~~~~~~~~~~~~~~\nNasty check to ensure that tagToEnum# is applied to a type that is an\nenumeration TyCon.  Unification may refine the type later, but this\ncheck won't see that, alas.  It's crude, because it relies on our\nknowing *now* that the type is ok, which in turn relies on the\neager-unification part of the type checker pushing enough information\nhere.  In theory the Right Thing to do is to have a new form of\nconstraint but I definitely cannot face that!  And it works ok as-is.\n\nHere's are two cases that should fail\n        f :: forall a. a\n        f = tagToEnum# 0        -- Can't do tagToEnum# at a type variable\n\n        g :: Int\n        g = tagToEnum# 0        -- Int is not an enumeration\n\nWhen data type families are involved it's a bit more complicated.\n     data family F a\n     data instance F [Int] = A | B | C\nThen we want to generate something like\n     tagToEnum# R:FListInt 3# |> co :: R:FListInt ~ F [Int]\nUsually that coercion is hidden inside the wrappers for\nconstructors of F [Int] but here we have to do it explicitly.\n\nIt's all grotesquely complicated.\n\nNote [Instantiating stupid theta]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNormally, when we infer the type of an Id, we don't instantiate,\nbecause we wish to allow for visible type application later on.\nBut if a datacon has a stupid theta, we're a bit stuck. We need\nto emit the stupid theta constraints with instantiated types. It's\ndifficult to defer this to the lazy instantiation, because a stupid\ntheta has no spot to put it in a type. So we just instantiate eagerly\nin this case. Thus, users cannot use visible type application with\na data constructor sporting a stupid theta. I won't feel so bad for\nthe users that complain.\n\n-}\n\ntcTagToEnum :: SrcSpan -> Name -> [LHsExprArgIn] -> ExpRhoType\n            -> TcM (HsWrapper, LHsExpr GhcTcId, [LHsExprArgOut])\n-- tagToEnum# :: forall a. Int# -> a\n-- See Note [tagToEnum#]   Urgh!\ntcTagToEnum loc fun_name args res_ty\n  = do { fun <- tcLookupId fun_name\n\n       ; let pars1 = mapMaybe isArgPar_maybe before\n             pars2 = mapMaybe isArgPar_maybe after\n             -- args contains exactly one HsValArg\n             (before, _:after) = break isHsValArg args\n\n       ; arg <- case filterOut isArgPar args of\n           [HsTypeArg _ hs_ty_arg, HsValArg term_arg]\n             -> do { ty_arg <- tcHsTypeApp hs_ty_arg liftedTypeKind\n                   ; _ <- tcSubTypeDS (OccurrenceOf fun_name) GenSigCtxt ty_arg res_ty\n                     -- other than influencing res_ty, we just\n                     -- don't care about a type arg passed in.\n                     -- So drop the evidence.\n                   ; return term_arg }\n           [HsValArg term_arg] -> do { _ <- expTypeToType res_ty\n                                     ; return term_arg }\n           _          -> too_many_args \"tagToEnum#\" args\n\n       ; res_ty <- readExpType res_ty\n       ; ty'    <- zonkTcType res_ty\n\n       -- Check that the type is algebraic\n       ; let mb_tc_app = tcSplitTyConApp_maybe ty'\n             Just (tc, tc_args) = mb_tc_app\n       ; checkTc (isJust mb_tc_app)\n                 (mk_error ty' doc1)\n\n       -- Look through any type family\n       ; fam_envs <- tcGetFamInstEnvs\n       ; let (rep_tc, rep_args, coi)\n               = tcLookupDataFamInst fam_envs tc tc_args\n            -- coi :: tc tc_args ~R rep_tc rep_args\n\n       ; checkTc (isEnumerationTyCon rep_tc)\n                 (mk_error ty' doc2)\n\n       ; arg' <- tcMonoExpr arg (mkCheckExpType intPrimTy)\n       ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar noExt (L loc fun)))\n             rep_ty = mkTyConApp rep_tc rep_args\n             out_args = concat\n              [ pars1\n              , [HsValArg arg']\n              , pars2\n              ]\n\n       ; return (mkWpCastR (mkTcSymCo coi), fun', out_args) }\n                 -- coi is a Representational coercion\n  where\n    doc1 = vcat [ text \"Specify the type by giving a type signature\"\n                , text \"e.g. (tagToEnum# x) :: Bool\" ]\n    doc2 = text \"Result type must be an enumeration type\"\n\n    mk_error :: TcType -> SDoc -> SDoc\n    mk_error ty what\n      = hang (text \"Bad call to tagToEnum#\"\n               <+> text \"at type\" <+> ppr ty)\n           2 what\n\ntoo_many_args :: String -> [LHsExprArgIn] -> TcM a\ntoo_many_args fun args\n  = failWith $\n    hang (text \"Too many type arguments to\" <+> text fun <> colon)\n       2 (sep (map pp args))\n  where\n    pp (HsValArg e)                             = ppr e\n    pp (HsTypeArg _ (HsWC { hswc_body = L _ t })) = pprHsType t\n    pp (HsTypeArg _ (XHsWildCardBndrs _)) = panic \"too_many_args\"\n    pp (HsArgPar _) = empty\n\n\n{-\n************************************************************************\n*                                                                      *\n                 Template Haskell checks\n*                                                                      *\n************************************************************************\n-}\n\ncheckThLocalId :: Id -> TcM ()\ncheckThLocalId id\n  = do  { mb_local_use <- getStageAndBindLevel (idName id)\n        ; case mb_local_use of\n             Just (top_lvl, bind_lvl, use_stage)\n                | thLevel use_stage > bind_lvl\n                -> checkCrossStageLifting top_lvl id use_stage\n             _  -> return ()   -- Not a locally-bound thing, or\n                               -- no cross-stage link\n    }\n\n--------------------------------------\ncheckCrossStageLifting :: TopLevelFlag -> Id -> ThStage -> TcM ()\n-- If we are inside typed brackets, and (use_lvl > bind_lvl)\n-- we must check whether there's a cross-stage lift to do\n-- Examples   \\x -> [|| x ||]\n--            [|| map ||]\n-- There is no error-checking to do, because the renamer did that\n--\n-- This is similar to checkCrossStageLifting in RnSplice, but\n-- this code is applied to *typed* brackets.\n\ncheckCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var))\n  | isTopLevel top_lvl\n  = when (isExternalName id_name) (keepAlive id_name)\n    -- See Note [Keeping things alive for Template Haskell] in RnSplice\n\n  | otherwise\n  =     -- Nested identifiers, such as 'x' in\n        -- E.g. \\x -> [|| h x ||]\n        -- We must behave as if the reference to x was\n        --      h $(lift x)\n        -- We use 'x' itself as the splice proxy, used by\n        -- the desugarer to stitch it all back together.\n        -- If 'x' occurs many times we may get many identical\n        -- bindings of the same splice proxy, but that doesn't\n        -- matter, although it's a mite untidy.\n    do  { let id_ty = idType id\n        ; checkTc (isTauTy id_ty) (polySpliceErr id)\n               -- If x is polymorphic, its occurrence sites might\n               -- have different instantiations, so we can't use plain\n               -- 'x' as the splice proxy name.  I don't know how to\n               -- solve this, and it's probably unimportant, so I'm\n               -- just going to flag an error for now\n\n        ; lift <- if isStringTy id_ty then\n                     do { sid <- tcLookupId THNames.liftStringName\n                                     -- See Note [Lifting strings]\n                        ; return (HsVar noExt (noLoc sid)) }\n                  else\n                     setConstraintVar lie_var   $\n                          -- Put the 'lift' constraint into the right LIE\n                     newMethodFromName (OccurrenceOf id_name)\n                                       THNames.liftName id_ty\n\n                   -- Update the pending splices\n        ; ps <- readMutVar ps_var\n        ; let pending_splice = PendingTcSplice id_name\n                                 (nlHsApp (noLoc lift) (nlHsVar id))\n        ; writeMutVar ps_var (pending_splice : ps)\n\n        ; return () }\n  where\n    id_name = idName id\n\ncheckCrossStageLifting _ _ _ = return ()\n\npolySpliceErr :: Id -> SDoc\npolySpliceErr id\n  = text \"Can't splice the polymorphic local variable\" <+> quotes (ppr id)\n\n{-\nNote [Lifting strings]\n~~~~~~~~~~~~~~~~~~~~~~\nIf we see $(... [| s |] ...) where s::String, we don't want to\ngenerate a mass of Cons (CharL 'x') (Cons (CharL 'y') ...)) etc.\nSo this conditional short-circuits the lifting mechanism to generate\n(liftString \"xy\") in that case.  I didn't want to use overlapping instances\nfor the Lift class in TH.Syntax, because that can lead to overlapping-instance\nerrors in a polymorphic situation.\n\nIf this check fails (which isn't impossible) we get another chance; see\nNote [Converting strings] in Convert.hs\n\nLocal record selectors\n~~~~~~~~~~~~~~~~~~~~~~\nRecord selectors for TyCons in this module are ordinary local bindings,\nwhich show up as ATcIds rather than AGlobals.  So we need to check for\nnaughtiness in both branches.  c.f. TcTyClsBindings.mkAuxBinds.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Record bindings}\n*                                                                      *\n************************************************************************\n-}\n\ngetFixedTyVars :: [FieldLabelString] -> [TyVar] -> [ConLike] -> TyVarSet\n-- These tyvars must not change across the updates\ngetFixedTyVars upd_fld_occs univ_tvs cons\n      = mkVarSet [tv1 | con <- cons\n                      , let (u_tvs, _, eqspec, prov_theta\n                             , req_theta, arg_tys, _)\n                              = conLikeFullSig con\n                            theta = eqSpecPreds eqspec\n                                     ++ prov_theta\n                                     ++ req_theta\n                            flds = conLikeFieldLabels con\n                            fixed_tvs = exactTyCoVarsOfTypes fixed_tys\n                                    -- fixed_tys: See Note [Type of a record update]\n                                        `unionVarSet` tyCoVarsOfTypes theta\n                                    -- Universally-quantified tyvars that\n                                    -- appear in any of the *implicit*\n                                    -- arguments to the constructor are fixed\n                                    -- See Note [Implicit type sharing]\n\n                            fixed_tys = [ty | (fl, ty) <- zip flds arg_tys\n                                            , not (flLabel fl `elem` upd_fld_occs)]\n                      , (tv1,tv) <- univ_tvs `zip` u_tvs\n                      , tv `elemVarSet` fixed_tvs ]\n\n{-\nNote [Disambiguating record fields]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the -XDuplicateRecordFields extension is used, and the renamer\nencounters a record selector or update that it cannot immediately\ndisambiguate (because it involves fields that belong to multiple\ndatatypes), it will defer resolution of the ambiguity to the\ntypechecker.  In this case, the `Ambiguous` constructor of\n`AmbiguousFieldOcc` is used.\n\nConsider the following definitions:\n\n        data S = MkS { foo :: Int }\n        data T = MkT { foo :: Int, bar :: Int }\n        data U = MkU { bar :: Int, baz :: Int }\n\nWhen the renamer sees `foo` as a selector or an update, it will not\nknow which parent datatype is in use.\n\nFor selectors, there are two possible ways to disambiguate:\n\n1. Check if the pushed-in type is a function whose domain is a\n   datatype, for example:\n\n       f s = (foo :: S -> Int) s\n\n       g :: T -> Int\n       g = foo\n\n    This is checked by `tcCheckRecSelId` when checking `HsRecFld foo`.\n\n2. Check if the selector is applied to an argument that has a type\n   signature, for example:\n\n       h = foo (s :: S)\n\n    This is checked by `tcApp`.\n\n\nUpdates are slightly more complex.  The `disambiguateRecordBinds`\nfunction tries to determine the parent datatype in three ways:\n\n1. Check for types that have all the fields being updated. For example:\n\n        f x = x { foo = 3, bar = 2 }\n\n   Here `f` must be updating `T` because neither `S` nor `U` have\n   both fields. This may also discover that no possible type exists.\n   For example the following will be rejected:\n\n        f' x = x { foo = 3, baz = 3 }\n\n2. Use the type being pushed in, if it is already a TyConApp. The\n   following are valid updates to `T`:\n\n        g :: T -> T\n        g x = x { foo = 3 }\n\n        g' x = x { foo = 3 } :: T\n\n3. Use the type signature of the record expression, if it exists and\n   is a TyConApp. Thus this is valid update to `T`:\n\n        h x = (x :: T) { foo = 3 }\n\n\nNote that we do not look up the types of variables being updated, and\nno constraint-solving is performed, so for example the following will\nbe rejected as ambiguous:\n\n     let bad (s :: S) = foo s\n\n     let r :: T\n         r = blah\n     in r { foo = 3 }\n\n     \\r. (r { foo = 3 },  r :: T )\n\nWe could add further tests, of a more heuristic nature. For example,\nrather than looking for an explicit signature, we could try to infer\nthe type of the argument to a selector or the record expression being\nupdated, in case we are lucky enough to get a TyConApp straight\naway. However, it might be hard for programmers to predict whether a\nparticular update is sufficiently obvious for the signature to be\nomitted. Moreover, this might change the behaviour of typechecker in\nnon-obvious ways.\n\nSee also Note [HsRecField and HsRecUpdField] in HsPat.\n-}\n\n-- Given a RdrName that refers to multiple record fields, and the type\n-- of its argument, try to determine the name of the selector that is\n-- meant.\ndisambiguateSelector :: Located RdrName -> Type -> TcM Name\ndisambiguateSelector lr@(L _ rdr) parent_type\n = do { fam_inst_envs <- tcGetFamInstEnvs\n      ; case tyConOf fam_inst_envs parent_type of\n          Nothing -> ambiguousSelector lr\n          Just p  ->\n            do { xs <- lookupParents rdr\n               ; let parent = RecSelData p\n               ; case lookup parent xs of\n                   Just gre -> do { addUsedGRE True gre\n                                  ; return (gre_name gre) }\n                   Nothing  -> failWithTc (fieldNotInType parent rdr) } }\n\n-- This field name really is ambiguous, so add a suitable \"ambiguous\n-- occurrence\" error, then give up.\nambiguousSelector :: Located RdrName -> TcM a\nambiguousSelector (L _ rdr)\n  = do { env <- getGlobalRdrEnv\n       ; let gres = lookupGRE_RdrName rdr env\n       ; setErrCtxt [] $ addNameClashErrRn rdr gres\n       ; failM }\n\n-- Disambiguate the fields in a record update.\n-- See Note [Disambiguating record fields]\ndisambiguateRecordBinds :: LHsExpr GhcRn -> TcRhoType\n                 -> [LHsRecUpdField GhcRn] -> ExpRhoType\n                 -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]\ndisambiguateRecordBinds record_expr record_rho rbnds res_ty\n    -- Are all the fields unambiguous?\n  = case mapM isUnambiguous rbnds of\n                     -- If so, just skip to looking up the Ids\n                     -- Always the case if DuplicateRecordFields is off\n      Just rbnds' -> mapM lookupSelector rbnds'\n      Nothing     -> -- If not, try to identify a single parent\n        do { fam_inst_envs <- tcGetFamInstEnvs\n             -- Look up the possible parents for each field\n           ; rbnds_with_parents <- getUpdFieldsParents\n           ; let possible_parents = map (map fst . snd) rbnds_with_parents\n             -- Identify a single parent\n           ; p <- identifyParent fam_inst_envs possible_parents\n             -- Pick the right selector with that parent for each field\n           ; checkNoErrs $ mapM (pickParent p) rbnds_with_parents }\n  where\n    -- Extract the selector name of a field update if it is unambiguous\n    isUnambiguous :: LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn,Name)\n    isUnambiguous x = case unLoc (hsRecFieldLbl (unLoc x)) of\n                        Unambiguous sel_name _ -> Just (x, sel_name)\n                        Ambiguous{}            -> Nothing\n                        XAmbiguousFieldOcc{}   -> Nothing\n\n    -- Look up the possible parents and selector GREs for each field\n    getUpdFieldsParents :: TcM [(LHsRecUpdField GhcRn\n                                , [(RecSelParent, GlobalRdrElt)])]\n    getUpdFieldsParents\n      = fmap (zip rbnds) $ mapM\n          (lookupParents . unLoc . hsRecUpdFieldRdr . unLoc)\n          rbnds\n\n    -- Given a the lists of possible parents for each field,\n    -- identify a single parent\n    identifyParent :: FamInstEnvs -> [[RecSelParent]] -> TcM RecSelParent\n    identifyParent fam_inst_envs possible_parents\n      = case foldr1 intersect possible_parents of\n        -- No parents for all fields: record update is ill-typed\n        []  -> failWithTc (noPossibleParents rbnds)\n\n        -- Exactly one datatype with all the fields: use that\n        [p] -> return p\n\n        -- Multiple possible parents: try harder to disambiguate\n        -- Can we get a parent TyCon from the pushed-in type?\n        _:_ | Just p <- tyConOfET fam_inst_envs res_ty -> return (RecSelData p)\n\n        -- Does the expression being updated have a type signature?\n        -- If so, try to extract a parent TyCon from it\n            | Just {} <- obviousSig (unLoc record_expr)\n            , Just tc <- tyConOf fam_inst_envs record_rho\n            -> return (RecSelData tc)\n\n        -- Nothing else we can try...\n        _ -> failWithTc badOverloadedUpdate\n\n    -- Make a field unambiguous by choosing the given parent.\n    -- Emits an error if the field cannot have that parent,\n    -- e.g. if the user writes\n    --     r { x = e } :: T\n    -- where T does not have field x.\n    pickParent :: RecSelParent\n               -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])\n               -> TcM (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))\n    pickParent p (upd, xs)\n      = case lookup p xs of\n                      -- Phew! The parent is valid for this field.\n                      -- Previously ambiguous fields must be marked as\n                      -- used now that we know which one is meant, but\n                      -- unambiguous ones shouldn't be recorded again\n                      -- (giving duplicate deprecation warnings).\n          Just gre -> do { unless (null (tail xs)) $ do\n                             let L loc _ = hsRecFieldLbl (unLoc upd)\n                             setSrcSpan loc $ addUsedGRE True gre\n                         ; lookupSelector (upd, gre_name gre) }\n                      -- The field doesn't belong to this parent, so report\n                      -- an error but keep going through all the fields\n          Nothing  -> do { addErrTc (fieldNotInType p\n                                      (unLoc (hsRecUpdFieldRdr (unLoc upd))))\n                         ; lookupSelector (upd, gre_name (snd (head xs))) }\n\n    -- Given a (field update, selector name) pair, look up the\n    -- selector to give a field update with an unambiguous Id\n    lookupSelector :: (LHsRecUpdField GhcRn, Name)\n                 -> TcM (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))\n    lookupSelector (L l upd, n)\n      = do { i <- tcLookupId n\n           ; let L loc af = hsRecFieldLbl upd\n                 lbl      = rdrNameAmbiguousFieldOcc af\n           ; return $ L l upd { hsRecFieldLbl\n                                  = L loc (Unambiguous i (L loc lbl)) } }\n\n\n-- Extract the outermost TyCon of a type, if there is one; for\n-- data families this is the representation tycon (because that's\n-- where the fields live).\ntyConOf :: FamInstEnvs -> TcSigmaType -> Maybe TyCon\ntyConOf fam_inst_envs ty0\n  = case tcSplitTyConApp_maybe ty of\n      Just (tc, tys) -> Just (fstOf3 (tcLookupDataFamInst fam_inst_envs tc tys))\n      Nothing        -> Nothing\n  where\n    (_, _, ty) = tcSplitSigmaTy ty0\n\n-- Variant of tyConOf that works for ExpTypes\ntyConOfET :: FamInstEnvs -> ExpRhoType -> Maybe TyCon\ntyConOfET fam_inst_envs ty0 = tyConOf fam_inst_envs =<< checkingExpType_maybe ty0\n\n-- For an ambiguous record field, find all the candidate record\n-- selectors (as GlobalRdrElts) and their parents.\nlookupParents :: RdrName -> RnM [(RecSelParent, GlobalRdrElt)]\nlookupParents rdr\n  = do { env <- getGlobalRdrEnv\n       ; let gres = lookupGRE_RdrName rdr env\n       ; mapM lookupParent gres }\n  where\n    lookupParent :: GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt)\n    lookupParent gre = do { id <- tcLookupId (gre_name gre)\n                          ; if isRecordSelector id\n                              then return (recordSelectorTyCon id, gre)\n                              else failWithTc (notSelector (gre_name gre)) }\n\n-- A type signature on the argument of an ambiguous record selector or\n-- the record expression in an update must be \"obvious\", i.e. the\n-- outermost constructor ignoring parentheses.\nobviousSig :: HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)\nobviousSig (ExprWithTySig _ _ ty) = Just ty\nobviousSig (HsPar _ p)          = obviousSig (unLoc p)\nobviousSig _                    = Nothing\n\n\n{-\nGame plan for record bindings\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n1. Find the TyCon for the bindings, from the first field label.\n\n2. Instantiate its tyvars and unify (T a1 .. an) with expected_ty.\n\nFor each binding field = value\n\n3. Instantiate the field type (from the field label) using the type\n   envt from step 2.\n\n4  Type check the value using tcArg, passing the field type as\n   the expected argument type.\n\nThis extends OK when the field types are universally quantified.\n-}\n\ntcRecordBinds\n        :: ConLike\n        -> [TcType]     -- Expected type for each field\n        -> HsRecordBinds GhcRn\n        -> TcM (HsRecordBinds GhcTcId)\n\ntcRecordBinds con_like arg_tys (HsRecFields rbinds dd)\n  = do  { mb_binds <- mapM do_bind rbinds\n        ; return (HsRecFields (catMaybes mb_binds) dd) }\n  where\n    fields = map flSelector $ conLikeFieldLabels con_like\n    flds_w_tys = zipEqual \"tcRecordBinds\" fields arg_tys\n\n    do_bind :: LHsRecField GhcRn (LHsExpr GhcRn)\n            -> TcM (Maybe (LHsRecField GhcTcId (LHsExpr GhcTcId)))\n    do_bind (L l fld@(HsRecField { hsRecFieldLbl = f\n                                 , hsRecFieldArg = rhs }))\n\n      = do { mb <- tcRecordField con_like flds_w_tys f rhs\n           ; case mb of\n               Nothing         -> return Nothing\n               Just (f', rhs') -> return (Just (L l (fld { hsRecFieldLbl = f'\n                                                          , hsRecFieldArg = rhs' }))) }\n\ntcRecordUpd\n        :: ConLike\n        -> [TcType]     -- Expected type for each field\n        -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]\n        -> TcM [LHsRecUpdField GhcTcId]\n\ntcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds\n  where\n    fields = map flSelector $ conLikeFieldLabels con_like\n    flds_w_tys = zipEqual \"tcRecordUpd\" fields arg_tys\n\n    do_bind :: LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)\n            -> TcM (Maybe (LHsRecUpdField GhcTcId))\n    do_bind (L l fld@(HsRecField { hsRecFieldLbl = L loc af\n                                 , hsRecFieldArg = rhs }))\n      = do { let lbl = rdrNameAmbiguousFieldOcc af\n                 sel_id = selectorAmbiguousFieldOcc af\n                 f = L loc (FieldOcc (idName sel_id) (L loc lbl))\n           ; mb <- tcRecordField con_like flds_w_tys f rhs\n           ; case mb of\n               Nothing         -> return Nothing\n               Just (f', rhs') ->\n                 return (Just\n                         (L l (fld { hsRecFieldLbl\n                                      = L loc (Unambiguous\n                                               (extFieldOcc (unLoc f'))\n                                               (L loc lbl))\n                                   , hsRecFieldArg = rhs' }))) }\n\ntcRecordField :: ConLike -> Assoc Name Type\n              -> LFieldOcc GhcRn -> LHsExpr GhcRn\n              -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))\ntcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs\n  | Just field_ty <- assocMaybe flds_w_tys sel_name\n      = addErrCtxt (fieldCtxt field_lbl) $\n        do { rhs' <- tcPolyExprNC rhs field_ty\n           ; let field_id = mkUserLocal (nameOccName sel_name)\n                                        (nameUnique sel_name)\n                                        field_ty loc\n                -- Yuk: the field_id has the *unique* of the selector Id\n                --          (so we can find it easily)\n                --      but is a LocalId with the appropriate type of the RHS\n                --          (so the desugarer knows the type of local binder to make)\n           ; return (Just (L loc (FieldOcc field_id lbl), rhs')) }\n      | otherwise\n      = do { addErrTc (badFieldCon con_like field_lbl)\n           ; return Nothing }\n  where\n        field_lbl = occNameFS $ rdrNameOcc (unLoc lbl)\ntcRecordField _ _ (L _ (XFieldOcc _)) _ = panic \"tcRecordField\"\n\n\ncheckMissingFields ::  ConLike -> HsRecordBinds GhcRn -> TcM ()\ncheckMissingFields con_like rbinds\n  | null field_labels   -- Not declared as a record;\n                        -- But C{} is still valid if no strict fields\n  = if any isBanged field_strs then\n        -- Illegal if any arg is strict\n        addErrTc (missingStrictFields con_like [])\n    else do\n        warn <- woptM Opt_WarnMissingFields\n        when (warn && notNull field_strs && null field_labels)\n             (warnTc (Reason Opt_WarnMissingFields) True\n                 (missingFields con_like []))\n\n  | otherwise = do              -- A record\n    unless (null missing_s_fields)\n           (addErrTc (missingStrictFields con_like missing_s_fields))\n\n    warn <- woptM Opt_WarnMissingFields\n    when (warn && notNull missing_ns_fields)\n         (warnTc (Reason Opt_WarnMissingFields) True\n             (missingFields con_like missing_ns_fields))\n\n  where\n    missing_s_fields\n        = [ flLabel fl | (fl, str) <- field_info,\n                 isBanged str,\n                 not (fl `elemField` field_names_used)\n          ]\n    missing_ns_fields\n        = [ flLabel fl | (fl, str) <- field_info,\n                 not (isBanged str),\n                 not (fl `elemField` field_names_used)\n          ]\n\n    field_names_used = hsRecFields rbinds\n    field_labels     = conLikeFieldLabels con_like\n\n    field_info = zipEqual \"missingFields\"\n                          field_labels\n                          field_strs\n\n    field_strs = conLikeImplBangs con_like\n\n    fl `elemField` flds = any (\\ fl' -> flSelector fl == fl') flds\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Errors and contexts}\n*                                                                      *\n************************************************************************\n\nBoring and alphabetical:\n-}\n\naddExprErrCtxt :: LHsExpr GhcRn -> TcM a -> TcM a\naddExprErrCtxt expr = addErrCtxt (exprCtxt expr)\n\nexprCtxt :: LHsExpr GhcRn -> SDoc\nexprCtxt expr\n  = hang (text \"In the expression:\") 2 (ppr expr)\n\nfieldCtxt :: FieldLabelString -> SDoc\nfieldCtxt field_name\n  = text \"In the\" <+> quotes (ppr field_name) <+> ptext (sLit \"field of a record\")\n\naddFunResCtxt :: Bool  -- There is at least one argument\n              -> HsExpr GhcRn -> TcType -> ExpRhoType\n              -> TcM a -> TcM a\n-- When we have a mis-match in the return type of a function\n-- try to give a helpful message about too many/few arguments\n--\n-- Used for naked variables too; but with has_args = False\naddFunResCtxt has_args fun fun_res_ty env_ty\n  = addLandmarkErrCtxtM (\\env -> (env, ) <$> mk_msg)\n      -- NB: use a landmark error context, so that an empty context\n      -- doesn't suppress some more useful context\n  where\n    mk_msg\n      = do { mb_env_ty <- readExpType_maybe env_ty\n                     -- by the time the message is rendered, the ExpType\n                     -- will be filled in (except if we're debugging)\n           ; fun_res' <- zonkTcType fun_res_ty\n           ; env'     <- case mb_env_ty of\n                           Just env_ty -> zonkTcType env_ty\n                           Nothing     ->\n                             do { dumping <- doptM Opt_D_dump_tc_trace\n                                ; MASSERT( dumping )\n                                ; newFlexiTyVarTy liftedTypeKind }\n           ; let -- See Note [Splitting nested sigma types in mismatched\n                 --           function types]\n                 (_, _, fun_tau) = tcSplitNestedSigmaTys fun_res'\n                 -- No need to call tcSplitNestedSigmaTys here, since env_ty is\n                 -- an ExpRhoTy, i.e., it's already deeply instantiated.\n                 (_, _, env_tau) = tcSplitSigmaTy env'\n                 (args_fun, res_fun) = tcSplitFunTys fun_tau\n                 (args_env, res_env) = tcSplitFunTys env_tau\n                 n_fun = length args_fun\n                 n_env = length args_env\n                 info  | n_fun == n_env = Outputable.empty\n                       | n_fun > n_env\n                       , not_fun res_env\n                       = text \"Probable cause:\" <+> quotes (ppr fun)\n                         <+> text \"is applied to too few arguments\"\n\n                       | has_args\n                       , not_fun res_fun\n                       = text \"Possible cause:\" <+> quotes (ppr fun)\n                         <+> text \"is applied to too many arguments\"\n\n                       | otherwise\n                       = Outputable.empty  -- Never suggest that a naked variable is                                         -- applied to too many args!\n           ; return info }\n      where\n        not_fun ty   -- ty is definitely not an arrow type,\n                     -- and cannot conceivably become one\n          = case tcSplitTyConApp_maybe ty of\n              Just (tc, _) -> isAlgTyCon tc\n              Nothing      -> False\n\n{-\nNote [Splitting nested sigma types in mismatched function types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen one applies a function to too few arguments, GHC tries to determine this\nfact if possible so that it may give a helpful error message. It accomplishes\nthis by checking if the type of the applied function has more argument types\nthan supplied arguments.\n\nPreviously, GHC computed the number of argument types through tcSplitSigmaTy.\nThis is incorrect in the face of nested foralls, however! This caused Trac\n#13311, for instance:\n\n  f :: forall a. (Monoid a) => forall b. (Monoid b) => Maybe a -> Maybe b\n\nIf one uses `f` like so:\n\n  do { f; putChar 'a' }\n\nThen tcSplitSigmaTy will decompose the type of `f` into:\n\n  Tyvars: [a]\n  Context: (Monoid a)\n  Argument types: []\n  Return type: forall b. Monoid b => Maybe a -> Maybe b\n\nThat is, it will conclude that there are *no* argument types, and since `f`\nwas given no arguments, it won't print a helpful error message. On the other\nhand, tcSplitNestedSigmaTys correctly decomposes `f`'s type down to:\n\n  Tyvars: [a, b]\n  Context: (Monoid a, Monoid b)\n  Argument types: [Maybe a]\n  Return type: Maybe b\n\nSo now GHC recognizes that `f` has one more argument type than it was actually\nprovided.\n-}\n\nbadFieldTypes :: [(FieldLabelString,TcType)] -> SDoc\nbadFieldTypes prs\n  = hang (text \"Record update for insufficiently polymorphic field\"\n                         <> plural prs <> colon)\n       2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ])\n\nbadFieldsUpd\n  :: [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]\n               -- Field names that don't belong to a single datacon\n  -> [ConLike] -- Data cons of the type which the first field name belongs to\n  -> SDoc\nbadFieldsUpd rbinds data_cons\n  = hang (text \"No constructor has all these fields:\")\n       2 (pprQuotedList conflictingFields)\n          -- See Note [Finding the conflicting fields]\n  where\n    -- A (preferably small) set of fields such that no constructor contains\n    -- all of them.  See Note [Finding the conflicting fields]\n    conflictingFields = case nonMembers of\n        -- nonMember belongs to a different type.\n        (nonMember, _) : _ -> [aMember, nonMember]\n        [] -> let\n            -- All of rbinds belong to one type. In this case, repeatedly add\n            -- a field to the set until no constructor contains the set.\n\n            -- Each field, together with a list indicating which constructors\n            -- have all the fields so far.\n            growingSets :: [(FieldLabelString, [Bool])]\n            growingSets = scanl1 combine membership\n            combine (_, setMem) (field, fldMem)\n              = (field, zipWith (&&) setMem fldMem)\n            in\n            -- Fields that don't change the membership status of the set\n            -- are redundant and can be dropped.\n            map (fst . head) $ groupBy ((==) `on` snd) growingSets\n\n    aMember = ASSERT( not (null members) ) fst (head members)\n    (members, nonMembers) = partition (or . snd) membership\n\n    -- For each field, which constructors contain the field?\n    membership :: [(FieldLabelString, [Bool])]\n    membership = sortMembership $\n        map (\\fld -> (fld, map (Set.member fld) fieldLabelSets)) $\n          map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) rbinds\n\n    fieldLabelSets :: [Set.Set FieldLabelString]\n    fieldLabelSets = map (Set.fromList . map flLabel . conLikeFieldLabels) data_cons\n\n    -- Sort in order of increasing number of True, so that a smaller\n    -- conflicting set can be found.\n    sortMembership =\n      map snd .\n      sortBy (compare `on` fst) .\n      map (\\ item@(_, membershipRow) -> (countTrue membershipRow, item))\n\n    countTrue = count id\n\n{-\nNote [Finding the conflicting fields]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n  data A = A {a0, a1 :: Int}\n         | B {b0, b1 :: Int}\nand we see a record update\n  x { a0 = 3, a1 = 2, b0 = 4, b1 = 5 }\nThen we'd like to find the smallest subset of fields that no\nconstructor has all of.  Here, say, {a0,b0}, or {a0,b1}, etc.\nWe don't really want to report that no constructor has all of\n{a0,a1,b0,b1}, because when there are hundreds of fields it's\nhard to see what was really wrong.\n\nWe may need more than two fields, though; eg\n  data T = A { x,y :: Int, v::Int }\n          | B { y,z :: Int, v::Int }\n          | C { z,x :: Int, v::Int }\nwith update\n   r { x=e1, y=e2, z=e3 }, we\n\nFinding the smallest subset is hard, so the code here makes\na decent stab, no more.  See Trac #7989.\n-}\n\nnaughtyRecordSel :: RdrName -> SDoc\nnaughtyRecordSel sel_id\n  = text \"Cannot use record selector\" <+> quotes (ppr sel_id) <+>\n    text \"as a function due to escaped type variables\" $$\n    text \"Probable fix: use pattern-matching syntax instead\"\n\nnotSelector :: Name -> SDoc\nnotSelector field\n  = hsep [quotes (ppr field), text \"is not a record selector\"]\n\nmixedSelectors :: [Id] -> [Id] -> SDoc\nmixedSelectors data_sels@(dc_rep_id:_) pat_syn_sels@(ps_rep_id:_)\n  = ptext\n      (sLit \"Cannot use a mixture of pattern synonym and record selectors\") $$\n    text \"Record selectors defined by\"\n      <+> quotes (ppr (tyConName rep_dc))\n      <> text \":\"\n      <+> pprWithCommas ppr data_sels $$\n    text \"Pattern synonym selectors defined by\"\n      <+> quotes (ppr (patSynName rep_ps))\n      <> text \":\"\n      <+> pprWithCommas ppr pat_syn_sels\n  where\n    RecSelPatSyn rep_ps = recordSelectorTyCon ps_rep_id\n    RecSelData rep_dc = recordSelectorTyCon dc_rep_id\nmixedSelectors _ _ = panic \"TcExpr: mixedSelectors emptylists\"\n\n\nmissingStrictFields :: ConLike -> [FieldLabelString] -> SDoc\nmissingStrictFields con fields\n  = header <> rest\n  where\n    rest | null fields = Outputable.empty  -- Happens for non-record constructors\n                                           -- with strict fields\n         | otherwise   = colon <+> pprWithCommas ppr fields\n\n    header = text \"Constructor\" <+> quotes (ppr con) <+>\n             text \"does not have the required strict field(s)\"\n\nmissingFields :: ConLike -> [FieldLabelString] -> SDoc\nmissingFields con fields\n  = header <> rest\n  where\n    rest | null fields = Outputable.empty\n         | otherwise = colon <+> pprWithCommas ppr fields\n    header = text \"Fields of\" <+> quotes (ppr con) <+>\n             text \"not initialised\"\n\n-- callCtxt fun args = text \"In the call\" <+> parens (ppr (foldl' mkHsApp fun args))\n\nnoPossibleParents :: [LHsRecUpdField GhcRn] -> SDoc\nnoPossibleParents rbinds\n  = hang (text \"No type has all these fields:\")\n       2 (pprQuotedList fields)\n  where\n    fields = map (hsRecFieldLbl . unLoc) rbinds\n\nbadOverloadedUpdate :: SDoc\nbadOverloadedUpdate = text \"Record update is ambiguous, and requires a type signature\"\n\nfieldNotInType :: RecSelParent -> RdrName -> SDoc\nfieldNotInType p rdr\n  = unknownSubordinateErr (text \"field of type\" <+> quotes (ppr p)) rdr\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Static Pointers}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A data type to describe why a variable is not closed.\ndata NotClosedReason = NotLetBoundReason\n                     | NotTypeClosed VarSet\n                     | NotClosed Name NotClosedReason\n\n-- | Checks if the given name is closed and emits an error if not.\n--\n-- See Note [Not-closed error messages].\ncheckClosedInStaticForm :: Name -> TcM ()\ncheckClosedInStaticForm name = do\n    type_env <- getLclTypeEnv\n    case checkClosed type_env name of\n      Nothing -> return ()\n      Just reason -> addErrTc $ explain name reason\n  where\n    -- See Note [Checking closedness].\n    checkClosed :: TcTypeEnv -> Name -> Maybe NotClosedReason\n    checkClosed type_env n = checkLoop type_env (unitNameSet n) n\n\n    checkLoop :: TcTypeEnv -> NameSet -> Name -> Maybe NotClosedReason\n    checkLoop type_env visited n = do\n      -- The @visited@ set is an accumulating parameter that contains the set of\n      -- visited nodes, so we avoid repeating cycles in the traversal.\n      case lookupNameEnv type_env n of\n        Just (ATcId { tct_id = tcid, tct_info = info }) -> case info of\n          ClosedLet   -> Nothing\n          NotLetBound -> Just NotLetBoundReason\n          NonClosedLet fvs type_closed -> listToMaybe $\n            -- Look for a non-closed variable in fvs\n            [ NotClosed n' reason\n            | n' <- nameSetElemsStable fvs\n            , not (elemNameSet n' visited)\n            , Just reason <- [checkLoop type_env (extendNameSet visited n') n']\n            ] ++\n            if type_closed then\n              []\n            else\n              -- We consider non-let-bound variables easier to figure out than\n              -- non-closed types, so we report non-closed types to the user\n              -- only if we cannot spot the former.\n              [ NotTypeClosed $ tyCoVarsOfType (idType tcid) ]\n        -- The binding is closed.\n        _ -> Nothing\n\n    -- Converts a reason into a human-readable sentence.\n    --\n    -- @explain name reason@ starts with\n    --\n    -- \"<name> is used in a static form but it is not closed because it\"\n    --\n    -- and then follows a list of causes. For each id in the path, the text\n    --\n    -- \"uses <id> which\"\n    --\n    -- is appended, yielding something like\n    --\n    -- \"uses <id> which uses <id1> which uses <id2> which\"\n    --\n    -- until the end of the path is reached, which is reported as either\n    --\n    -- \"is not let-bound\"\n    --\n    -- when the final node is not let-bound, or\n    --\n    -- \"has a non-closed type because it contains the type variables:\n    -- v1, v2, v3\"\n    --\n    -- when the final node has a non-closed type.\n    --\n    explain :: Name -> NotClosedReason -> SDoc\n    explain name reason =\n      quotes (ppr name) <+> text \"is used in a static form but it is not closed\"\n                        <+> text \"because it\"\n                        $$\n                        sep (causes reason)\n\n    causes :: NotClosedReason -> [SDoc]\n    causes NotLetBoundReason = [text \"is not let-bound.\"]\n    causes (NotTypeClosed vs) =\n      [ text \"has a non-closed type because it contains the\"\n      , text \"type variables:\" <+>\n        pprVarSet vs (hsep . punctuate comma . map (quotes . ppr))\n      ]\n    causes (NotClosed n reason) =\n      let msg = text \"uses\" <+> quotes (ppr n) <+> text \"which\"\n       in case reason of\n            NotClosed _ _ -> msg : causes reason\n            _   -> let (xs0, xs1) = splitAt 1 $ causes reason\n                    in fmap (msg <+>) xs0 ++ xs1\n\n-- Note [Not-closed error messages]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- When variables in a static form are not closed, we go through the trouble\n-- of explaining why they aren't.\n--\n-- Thus, the following program\n--\n-- > {-# LANGUAGE StaticPointers #-}\n-- > module M where\n-- >\n-- > f x = static g\n-- >   where\n-- >     g = h\n-- >     h = x\n--\n-- produces the error\n--\n--    'g' is used in a static form but it is not closed because it\n--    uses 'h' which uses 'x' which is not let-bound.\n--\n-- And a program like\n--\n-- > {-# LANGUAGE StaticPointers #-}\n-- > module M where\n-- >\n-- > import Data.Typeable\n-- > import GHC.StaticPtr\n-- >\n-- > f :: Typeable a => a -> StaticPtr TypeRep\n-- > f x = const (static (g undefined)) (h x)\n-- >   where\n-- >     g = h\n-- >     h = typeOf\n--\n-- produces the error\n--\n--    'g' is used in a static form but it is not closed because it\n--    uses 'h' which has a non-closed type because it contains the\n--    type variables: 'a'\n--\n\n-- Note [Checking closedness]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- @checkClosed@ checks if a binding is closed and returns a reason if it is\n-- not.\n--\n-- The bindings define a graph where the nodes are ids, and there is an edge\n-- from @id1@ to @id2@ if the rhs of @id1@ contains @id2@ among its free\n-- variables.\n--\n-- When @n@ is not closed, it has to exist in the graph some node reachable\n-- from @n@ that it is not a let-bound variable or that it has a non-closed\n-- type. Thus, the \"reason\" is a path from @n@ to this offending node.\n--\n-- When @n@ is not closed, we traverse the graph reachable from @n@ to build\n-- the reason.\n--\n", "num_lines": 2918}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, ViewPatterns, BangPatterns #-}\n\nmodule TcFlatten(\n   FlattenMode(..),\n   flatten, flattenKind, flattenArgsNom,\n\n   unflattenWanteds\n ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnTypes\nimport TcType\nimport Type\nimport TcEvidence\nimport TyCon\nimport TyCoRep   -- performs delicate algorithm on types\nimport Coercion\nimport Var\nimport VarSet\nimport VarEnv\nimport Outputable\nimport TcSMonad as TcS\nimport BasicTypes( SwapFlag(..) )\n\nimport Util\nimport Bag\nimport Control.Monad\nimport MonadUtils    ( zipWith3M )\n\nimport Control.Arrow ( first )\n\n{-\nNote [The flattening story]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* A CFunEqCan is either of form\n     [G] <F xis> : F xis ~ fsk   -- fsk is a FlatSkolTv\n     [W]       x : F xis ~ fmv   -- fmv is a FlatMetaTv\n  where\n     x is the witness variable\n     xis are function-free\n     fsk/fmv is a flatten skolem;\n        it is always untouchable (level 0)\n\n* CFunEqCans can have any flavour: [G], [W], [WD] or [D]\n\n* KEY INSIGHTS:\n\n   - A given flatten-skolem, fsk, is known a-priori to be equal to\n     F xis (the LHS), with <F xis> evidence.  The fsk is still a\n     unification variable, but it is \"owned\" by its CFunEqCan, and\n     is filled in (unflattened) only by unflattenGivens.\n\n   - A unification flatten-skolem, fmv, stands for the as-yet-unknown\n     type to which (F xis) will eventually reduce.  It is filled in\n\n\n   - All fsk/fmv variables are \"untouchable\".  To make it simple to test,\n     we simply give them TcLevel=0.  This means that in a CTyVarEq, say,\n       fmv ~ Int\n     we NEVER unify fmv.\n\n   - A unification flatten-skolem, fmv, ONLY gets unified when either\n       a) The CFunEqCan takes a step, using an axiom\n       b) By unflattenWanteds\n    They are never unified in any other form of equality.\n    For example [W] ffmv ~ Int  is stuck; it does not unify with fmv.\n\n* We *never* substitute in the RHS (i.e. the fsk/fmv) of a CFunEqCan.\n  That would destroy the invariant about the shape of a CFunEqCan,\n  and it would risk wanted/wanted interactions. The only way we\n  learn information about fsk is when the CFunEqCan takes a step.\n\n  However we *do* substitute in the LHS of a CFunEqCan (else it\n  would never get to fire!)\n\n* Unflattening:\n   - We unflatten Givens when leaving their scope (see unflattenGivens)\n   - We unflatten Wanteds at the end of each attempt to simplify the\n     wanteds; see unflattenWanteds, called from solveSimpleWanteds.\n\n* Ownership of fsk/fmv.  Each canonical [G], [W], or [WD]\n       CFunEqCan x : F xis ~ fsk/fmv\n  \"owns\" a distinct evidence variable x, and flatten-skolem fsk/fmv.\n  Why? We make a fresh fsk/fmv when the constraint is born;\n  and we never rewrite the RHS of a CFunEqCan.\n\n  In contrast a [D] CFunEqCan /shares/ its fmv with its partner [W],\n  but does not \"own\" it.  If we reduce a [D] F Int ~ fmv, where\n  say type instance F Int = ty, then we don't discharge fmv := ty.\n  Rather we simply generate [D] fmv ~ ty (in TcInteract.reduce_top_fun_eq,\n  and dischargeFmv)\n\n* Inert set invariant: if F xis1 ~ fsk1, F xis2 ~ fsk2\n                       then xis1 /= xis2\n  i.e. at most one CFunEqCan with a particular LHS\n\n* Function applications can occur in the RHS of a CTyEqCan.  No reason\n  not allow this, and it reduces the amount of flattening that must occur.\n\n* Flattening a type (F xis):\n    - If we are flattening in a Wanted/Derived constraint\n      then create new [W] x : F xis ~ fmv\n      else create new [G] x : F xis ~ fsk\n      with fresh evidence variable x and flatten-skolem fsk/fmv\n\n    - Add it to the work list\n\n    - Replace (F xis) with fsk/fmv in the type you are flattening\n\n    - You can also add the CFunEqCan to the \"flat cache\", which\n      simply keeps track of all the function applications you\n      have flattened.\n\n    - If (F xis) is in the cache already, just\n      use its fsk/fmv and evidence x, and emit nothing.\n\n    - No need to substitute in the flat-cache. It's not the end\n      of the world if we start with, say (F alpha ~ fmv1) and\n      (F Int ~ fmv2) and then find alpha := Int.  Athat will\n      simply give rise to fmv1 := fmv2 via [Interacting rule] below\n\n* Canonicalising a CFunEqCan [G/W] x : F xis ~ fsk/fmv\n    - Flatten xis (to substitute any tyvars; there are already no functions)\n                  cos :: xis ~ flat_xis\n    - New wanted  x2 :: F flat_xis ~ fsk/fmv\n    - Add new wanted to flat cache\n    - Discharge x = F cos ; x2\n\n* [Interacting rule]\n    (inert)     [W] x1 : F tys ~ fmv1\n    (work item) [W] x2 : F tys ~ fmv2\n  Just solve one from the other:\n    x2 := x1\n    fmv2 := fmv1\n  This just unites the two fsks into one.\n  Always solve given from wanted if poss.\n\n* For top-level reductions, see Note [Top-level reductions for type functions]\n  in TcInteract\n\n\nWhy given-fsks, alone, doesn't work\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCould we get away with only flatten meta-tyvars, with no flatten-skolems? No.\n\n  [W] w : alpha ~ [F alpha Int]\n\n---> flatten\n  w = ...w'...\n  [W] w' : alpha ~ [fsk]\n  [G] <F alpha Int> : F alpha Int ~ fsk\n\n--> unify (no occurs check)\n  alpha := [fsk]\n\nBut since fsk = F alpha Int, this is really an occurs check error.  If\nthat is all we know about alpha, we will succeed in constraint\nsolving, producing a program with an infinite type.\n\nEven if we did finally get (g : fsk ~ Bool) by solving (F alpha Int ~ fsk)\nusing axiom, zonking would not see it, so (x::alpha) sitting in the\ntree will get zonked to an infinite type.  (Zonking always only does\nrefl stuff.)\n\nWhy flatten-meta-vars, alone doesn't work\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLook at Simple13, with unification-fmvs only\n\n  [G] g : a ~ [F a]\n\n---> Flatten given\n  g' = g;[x]\n  [G] g'  : a ~ [fmv]\n  [W] x : F a ~ fmv\n\n--> subst a in x\n  g' = g;[x]\n  x = F g' ; x2\n  [W] x2 : F [fmv] ~ fmv\n\nAnd now we have an evidence cycle between g' and x!\n\nIf we used a given instead (ie current story)\n\n  [G] g : a ~ [F a]\n\n---> Flatten given\n  g' = g;[x]\n  [G] g'  : a ~ [fsk]\n  [G] <F a> : F a ~ fsk\n\n---> Substitute for a\n  [G] g'  : a ~ [fsk]\n  [G] F (sym g'); <F a> : F [fsk] ~ fsk\n\n\nWhy is it right to treat fmv's differently to ordinary unification vars?\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  f :: forall a. a -> a -> Bool\n  g :: F Int -> F Int -> Bool\n\nConsider\n  f (x:Int) (y:Bool)\nThis gives alpha~Int, alpha~Bool.  There is an inconsistency,\nbut really only one error.  SherLoc may tell you which location\nis most likely, based on other occurrences of alpha.\n\nConsider\n  g (x:Int) (y:Bool)\nHere we get (F Int ~ Int, F Int ~ Bool), which flattens to\n  (fmv ~ Int, fmv ~ Bool)\nBut there are really TWO separate errors.\n\n  ** We must not complain about Int~Bool. **\n\nMoreover these two errors could arise in entirely unrelated parts of\nthe code.  (In the alpha case, there must be *some* connection (eg\nv:alpha in common envt).)\n\nNote [Unflattening can force the solver to iterate]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLook at Trac #10340:\n   type family Any :: *   -- No instances\n   get :: MonadState s m => m s\n   instance MonadState s (State s) where ...\n\n   foo :: State Any Any\n   foo = get\n\nFor 'foo' we instantiate 'get' at types mm ss\n   [WD] MonadState ss mm, [WD] mm ss ~ State Any Any\nFlatten, and decompose\n   [WD] MonadState ss mm, [WD] Any ~ fmv\n   [WD] mm ~ State fmv, [WD] fmv ~ ss\nUnify mm := State fmv:\n   [WD] MonadState ss (State fmv)\n   [WD] Any ~ fmv, [WD] fmv ~ ss\nNow we are stuck; the instance does not match!!  So unflatten:\n   fmv := Any\n   ss := Any    (*)\n   [WD] MonadState Any (State Any)\n\nThe unification (*) represents progress, so we must do a second\nround of solving; this time it succeeds. This is done by the 'go'\nloop in solveSimpleWanteds.\n\nThis story does not feel right but it's the best I can do; and the\niteration only happens in pretty obscure circumstances.\n\n\n************************************************************************\n*                                                                      *\n*                  Examples\n     Here is a long series of examples I had to work through\n*                                                                      *\n************************************************************************\n\nSimple20\n~~~~~~~~\naxiom F [a] = [F a]\n\n [G] F [a] ~ a\n-->\n [G] fsk ~ a\n [G] [F a] ~ fsk  (nc)\n-->\n [G] F a ~ fsk2\n [G] fsk ~ [fsk2]\n [G] fsk ~ a\n-->\n [G] F a ~ fsk2\n [G] a ~ [fsk2]\n [G] fsk ~ a\n\n----------------------------------------\nindexed-types/should_compile/T44984\n\n  [W] H (F Bool) ~ H alpha\n  [W] alpha ~ F Bool\n-->\n  F Bool  ~ fmv0\n  H fmv0  ~ fmv1\n  H alpha ~ fmv2\n\n  fmv1 ~ fmv2\n  fmv0 ~ alpha\n\nflatten\n~~~~~~~\n  fmv0  := F Bool\n  fmv1  := H (F Bool)\n  fmv2  := H alpha\n  alpha := F Bool\nplus\n  fmv1 ~ fmv2\n\nBut these two are equal under the above assumptions.\nSolve by Refl.\n\n\n--- under plan B, namely solve fmv1:=fmv2 eagerly ---\n  [W] H (F Bool) ~ H alpha\n  [W] alpha ~ F Bool\n-->\n  F Bool  ~ fmv0\n  H fmv0  ~ fmv1\n  H alpha ~ fmv2\n\n  fmv1 ~ fmv2\n  fmv0 ~ alpha\n-->\n  F Bool  ~ fmv0\n  H fmv0  ~ fmv1\n  H alpha ~ fmv2    fmv2 := fmv1\n\n  fmv0 ~ alpha\n\nflatten\n  fmv0 := F Bool\n  fmv1 := H fmv0 = H (F Bool)\n  retain   H alpha ~ fmv2\n    because fmv2 has been filled\n  alpha := F Bool\n\n\n----------------------------\nindexed-types/should_failt/T4179\n\nafter solving\n  [W] fmv_1 ~ fmv_2\n  [W] A3 (FCon x)           ~ fmv_1    (CFunEqCan)\n  [W] A3 (x (aoa -> fmv_2)) ~ fmv_2    (CFunEqCan)\n\n----------------------------------------\nindexed-types/should_fail/T7729a\n\na)  [W]   BasePrimMonad (Rand m) ~ m1\nb)  [W]   tt m1 ~ BasePrimMonad (Rand m)\n\n--->  process (b) first\n    BasePrimMonad (Ramd m) ~ fmv_atH\n    fmv_atH ~ tt m1\n\n--->  now process (a)\n    m1 ~ s_atH ~ tt m1    -- An obscure occurs check\n\n\n----------------------------------------\ntypecheck/TcTypeNatSimple\n\nOriginal constraint\n  [W] x + y ~ x + alpha  (non-canonical)\n==>\n  [W] x + y     ~ fmv1   (CFunEqCan)\n  [W] x + alpha ~ fmv2   (CFuneqCan)\n  [W] fmv1 ~ fmv2        (CTyEqCan)\n\n(sigh)\n\n----------------------------------------\nindexed-types/should_fail/GADTwrong1\n\n  [G] Const a ~ ()\n==> flatten\n  [G] fsk ~ ()\n  work item: Const a ~ fsk\n==> fire top rule\n  [G] fsk ~ ()\n  work item fsk ~ ()\n\nSurely the work item should rewrite to () ~ ()?  Well, maybe not;\nit'a very special case.  More generally, our givens look like\nF a ~ Int, where (F a) is not reducible.\n\n\n----------------------------------------\nindexed_types/should_fail/T8227:\n\nWhy using a different can-rewrite rule in CFunEqCan heads\ndoes not work.\n\nAssuming NOT rewriting wanteds with wanteds\n\n   Inert: [W] fsk_aBh ~ fmv_aBk -> fmv_aBk\n          [W] fmv_aBk ~ fsk_aBh\n\n          [G] Scalar fsk_aBg ~ fsk_aBh\n          [G] V a ~ f_aBg\n\n   Worklist includes  [W] Scalar fmv_aBi ~ fmv_aBk\n   fmv_aBi, fmv_aBk are flatten unification variables\n\n   Work item: [W] V fsk_aBh ~ fmv_aBi\n\nNote that the inert wanteds are cyclic, because we do not rewrite\nwanteds with wanteds.\n\n\nThen we go into a loop when normalise the work-item, because we\nuse rewriteOrSame on the argument of V.\n\nConclusion: Don't make canRewrite context specific; instead use\n[W] a ~ ty to rewrite a wanted iff 'a' is a unification variable.\n\n\n----------------------------------------\n\nHere is a somewhat similar case:\n\n   type family G a :: *\n\n   blah :: (G a ~ Bool, Eq (G a)) => a -> a\n   blah = error \"urk\"\n\n   foo x = blah x\n\nFor foo we get\n   [W] Eq (G a), G a ~ Bool\nFlattening\n   [W] G a ~ fmv, Eq fmv, fmv ~ Bool\nWe can't simplify away the Eq Bool unless we substitute for fmv.\nMaybe that doesn't matter: we would still be left with unsolved\nG a ~ Bool.\n\n--------------------------\nTrac #9318 has a very simple program leading to\n\n  [W] F Int ~ Int\n  [W] F Int ~ Bool\n\nWe don't want to get \"Error Int~Bool\".  But if fmv's can rewrite\nwanteds, we will\n\n  [W] fmv ~ Int\n  [W] fmv ~ Bool\n--->\n  [W] Int ~ Bool\n\n\n************************************************************************\n*                                                                      *\n*                FlattenEnv & FlatM\n*             The flattening environment & monad\n*                                                                      *\n************************************************************************\n\n-}\n\ntype FlatWorkListRef = TcRef [Ct]  -- See Note [The flattening work list]\n\ndata FlattenEnv\n  = FE { fe_mode    :: !FlattenMode\n       , fe_loc     :: !CtLoc             -- See Note [Flattener CtLoc]\n       , fe_flavour :: !CtFlavour\n       , fe_eq_rel  :: !EqRel             -- See Note [Flattener EqRels]\n       , fe_work    :: !FlatWorkListRef } -- See Note [The flattening work list]\n\ndata FlattenMode  -- Postcondition for all three: inert wrt the type substitution\n  = FM_FlattenAll          -- Postcondition: function-free\n  | FM_SubstOnly           -- See Note [Flattening under a forall]\n\n--  | FM_Avoid TcTyVar Bool  -- See Note [Lazy flattening]\n--                           -- Postcondition:\n--                           --  * tyvar is only mentioned in result under a rigid path\n--                           --    e.g.   [a] is ok, but F a won't happen\n--                           --  * If flat_top is True, top level is not a function application\n--                           --   (but under type constructors is ok e.g. [F a])\n\ninstance Outputable FlattenMode where\n  ppr FM_FlattenAll = text \"FM_FlattenAll\"\n  ppr FM_SubstOnly  = text \"FM_SubstOnly\"\n\neqFlattenMode :: FlattenMode -> FlattenMode -> Bool\neqFlattenMode FM_FlattenAll FM_FlattenAll = True\neqFlattenMode FM_SubstOnly  FM_SubstOnly  = True\n--  FM_Avoid tv1 b1 `eq` FM_Avoid tv2 b2 = tv1 == tv2 && b1 == b2\neqFlattenMode _  _ = False\n\n-- | The 'FlatM' monad is a wrapper around 'TcS' with the following\n-- extra capabilities: (1) it offers access to a 'FlattenEnv';\n-- and (2) it maintains the flattening worklist.\n-- See Note [The flattening work list].\nnewtype FlatM a\n  = FlatM { runFlatM :: FlattenEnv -> TcS a }\n\ninstance Monad FlatM where\n  m >>= k  = FlatM $ \\env ->\n             do { a  <- runFlatM m env\n                ; runFlatM (k a) env }\n\ninstance Functor FlatM where\n  fmap = liftM\n\ninstance Applicative FlatM where\n  pure x = FlatM $ const (pure x)\n  (<*>) = ap\n\nliftTcS :: TcS a -> FlatM a\nliftTcS thing_inside\n  = FlatM $ const thing_inside\n\nemitFlatWork :: Ct -> FlatM ()\n-- See Note [The flattening work list]\nemitFlatWork ct = FlatM $ \\env -> updTcRef (fe_work env) (ct :)\n\n-- convenient wrapper when you have a CtEvidence describing\n-- the flattening operation\nrunFlattenCtEv :: FlattenMode -> CtEvidence -> FlatM a -> TcS a\nrunFlattenCtEv mode ev\n  = runFlatten mode (ctEvLoc ev) (ctEvFlavour ev) (ctEvEqRel ev)\n\n-- Run thing_inside (which does flattening), and put all\n-- the work it generates onto the main work list\n-- See Note [The flattening work list]\nrunFlatten :: FlattenMode -> CtLoc -> CtFlavour -> EqRel -> FlatM a -> TcS a\nrunFlatten mode loc flav eq_rel thing_inside\n  = do { flat_ref <- newTcRef []\n       ; let fmode = FE { fe_mode = mode\n                        , fe_loc  = loc\n                        , fe_flavour = flav\n                        , fe_eq_rel = eq_rel\n                        , fe_work = flat_ref }\n       ; res <- runFlatM thing_inside fmode\n       ; new_flats <- readTcRef flat_ref\n       ; updWorkListTcS (add_flats new_flats)\n       ; return res }\n  where\n    add_flats new_flats wl\n      = wl { wl_funeqs = add_funeqs new_flats (wl_funeqs wl) }\n\n    add_funeqs []     wl = wl\n    add_funeqs (f:fs) wl = add_funeqs fs (f:wl)\n      -- add_funeqs fs ws = reverse fs ++ ws\n      -- e.g. add_funeqs [f1,f2,f3] [w1,w2,w3,w4]\n      --        = [f3,f2,f1,w1,w2,w3,w4]\n\ntraceFlat :: String -> SDoc -> FlatM ()\ntraceFlat herald doc = liftTcS $ traceTcS herald doc\n\ngetFlatEnvField :: (FlattenEnv -> a) -> FlatM a\ngetFlatEnvField accessor\n  = FlatM $ \\env -> return (accessor env)\n\ngetEqRel :: FlatM EqRel\ngetEqRel = getFlatEnvField fe_eq_rel\n\ngetRole :: FlatM Role\ngetRole = eqRelRole <$> getEqRel\n\ngetFlavour :: FlatM CtFlavour\ngetFlavour = getFlatEnvField fe_flavour\n\ngetFlavourRole :: FlatM CtFlavourRole\ngetFlavourRole\n  = do { flavour <- getFlavour\n       ; eq_rel <- getEqRel\n       ; return (flavour, eq_rel) }\n\ngetMode :: FlatM FlattenMode\ngetMode = getFlatEnvField fe_mode\n\ngetLoc :: FlatM CtLoc\ngetLoc = getFlatEnvField fe_loc\n\ncheckStackDepth :: Type -> FlatM ()\ncheckStackDepth ty\n  = do { loc <- getLoc\n       ; liftTcS $ checkReductionDepth loc ty }\n\n-- | Change the 'EqRel' in a 'FlatM'.\nsetEqRel :: EqRel -> FlatM a -> FlatM a\nsetEqRel new_eq_rel thing_inside\n  = FlatM $ \\env ->\n    if new_eq_rel == fe_eq_rel env\n    then runFlatM thing_inside env\n    else runFlatM thing_inside (env { fe_eq_rel = new_eq_rel })\n\n-- | Change the 'FlattenMode' in a 'FlattenEnv'.\nsetMode :: FlattenMode -> FlatM a -> FlatM a\nsetMode new_mode thing_inside\n  = FlatM $ \\env ->\n    if new_mode `eqFlattenMode` fe_mode env\n    then runFlatM thing_inside env\n    else runFlatM thing_inside (env { fe_mode = new_mode })\n\n-- | Make sure that flattening actually produces a coercion (in other\n-- words, make sure our flavour is not Derived)\n-- Note [No derived kind equalities]\nnoBogusCoercions :: FlatM a -> FlatM a\nnoBogusCoercions thing_inside\n  = FlatM $ \\env ->\n    -- No new thunk is made if the flavour hasn't changed (note the bang).\n    let !env' = case fe_flavour env of\n          Derived -> env { fe_flavour = Wanted WDeriv }\n          _       -> env\n    in\n    runFlatM thing_inside env'\n\nbumpDepth :: FlatM a -> FlatM a\nbumpDepth (FlatM thing_inside)\n  = FlatM $ \\env -> do\n      -- bumpDepth can be called a lot during flattening so we force the\n      -- new env to avoid accumulating thunks.\n      { let !env' = env { fe_loc = bumpCtLocDepth (fe_loc env) }\n      ; thing_inside env' }\n\n{-\nNote [The flattening work list]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe \"flattening work list\", held in the fe_work field of FlattenEnv,\nis a list of CFunEqCans generated during flattening.  The key idea\nis this.  Consider flattening (Eq (F (G Int) (H Bool)):\n  * The flattener recursively calls itself on sub-terms before building\n    the main term, so it will encounter the terms in order\n              G Int\n              H Bool\n              F (G Int) (H Bool)\n    flattening to sub-goals\n              w1: G Int ~ fuv0\n              w2: H Bool ~ fuv1\n              w3: F fuv0 fuv1 ~ fuv2\n\n  * Processing w3 first is BAD, because we can't reduce i t,so it'll\n    get put into the inert set, and later kicked out when w1, w2 are\n    solved.  In Trac #9872 this led to inert sets containing hundreds\n    of suspended calls.\n\n  * So we want to process w1, w2 first.\n\n  * So you might think that we should just use a FIFO deque for the work-list,\n    so that putting adding goals in order w1,w2,w3 would mean we processed\n    w1 first.\n\n  * BUT suppose we have 'type instance G Int = H Char'.  Then processing\n    w1 leads to a new goal\n                w4: H Char ~ fuv0\n    We do NOT want to put that on the far end of a deque!  Instead we want\n    to put it at the *front* of the work-list so that we continue to work\n    on it.\n\nSo the work-list structure is this:\n\n  * The wl_funeqs (in TcS) is a LIFO stack; we push new goals (such as w4) on\n    top (extendWorkListFunEq), and take new work from the top\n    (selectWorkItem).\n\n  * When flattening, emitFlatWork pushes new flattening goals (like\n    w1,w2,w3) onto the flattening work list, fe_work, another\n    push-down stack.\n\n  * When we finish flattening, we *reverse* the fe_work stack\n    onto the wl_funeqs stack (which brings w1 to the top).\n\nThe function runFlatten initialises the fe_work stack, and reverses\nit onto wl_fun_eqs at the end.\n\nNote [Flattener EqRels]\n~~~~~~~~~~~~~~~~~~~~~~~\nWhen flattening, we need to know which equality relation -- nominal\nor representation -- we should be respecting. The only difference is\nthat we rewrite variables by representational equalities when fe_eq_rel\nis ReprEq, and that we unwrap newtypes when flattening w.r.t.\nrepresentational equality.\n\nNote [Flattener CtLoc]\n~~~~~~~~~~~~~~~~~~~~~~\nThe flattener does eager type-family reduction.\nType families might loop, and we\ndon't want GHC to do so. A natural solution is to have a bounded depth\nto these processes. A central difficulty is that such a solution isn't\nquite compositional. For example, say it takes F Int 10 steps to get to Bool.\nHow many steps does it take to get from F Int -> F Int to Bool -> Bool?\n10? 20? What about getting from Const Char (F Int) to Char? 11? 1? Hard to\nknow and hard to track. So, we punt, essentially. We store a CtLoc in\nthe FlattenEnv and just update the environment when recurring. In the\nTyConApp case, where there may be multiple type families to flatten,\nwe just copy the current CtLoc into each branch. If any branch hits the\nstack limit, then the whole thing fails.\n\nA consequence of this is that setting the stack limits appropriately\nwill be essentially impossible. So, the official recommendation if a\nstack limit is hit is to disable the check entirely. Otherwise, there\nwill be baffling, unpredictable errors.\n\nNote [Lazy flattening]\n~~~~~~~~~~~~~~~~~~~~~~\nThe idea of FM_Avoid mode is to flatten less aggressively.  If we have\n       a ~ [F Int]\nthere seems to be no great merit in lifting out (F Int).  But if it was\n       a ~ [G a Int]\nthen we *do* want to lift it out, in case (G a Int) reduces to Bool, say,\nwhich gets rid of the occurs-check problem.  (For the flat_top Bool, see\ncomments above and at call sites.)\n\nHOWEVER, the lazy flattening actually seems to make type inference go\n*slower*, not faster.  perf/compiler/T3064 is a case in point; it gets\n*dramatically* worse with FM_Avoid.  I think it may be because\nfloating the types out means we normalise them, and that often makes\nthem smaller and perhaps allows more re-use of previously solved\ngoals.  But to be honest I'm not absolutely certain, so I am leaving\nFM_Avoid in the code base.  What I'm removing is the unique place\nwhere it is *used*, namely in TcCanonical.canEqTyVar.\n\nSee also Note [Conservative unification check] in TcUnify, which gives\nother examples where lazy flattening caused problems.\n\nBottom line: FM_Avoid is unused for now (Nov 14).\nNote: T5321Fun got faster when I disabled FM_Avoid\n      T5837 did too, but it's pathalogical anyway\n\nNote [Phantoms in the flattener]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\ndata Proxy p = Proxy\n\nand we're flattening (Proxy ty) w.r.t. ReprEq. Then, we know that `ty`\nis really irrelevant -- it will be ignored when solving for representational\nequality later on. So, we omit flattening `ty` entirely. This may\nviolate the expectation of \"xi\"s for a bit, but the canonicaliser will\nsoon throw out the phantoms when decomposing a TyConApp. (Or, the\ncanonicaliser will emit an insoluble, in which case the unflattened version\nyields a better error message anyway.)\n\nNote [No derived kind equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA kind-level coercion can appear in types, via mkCastTy. So, whenever\nwe are generating a coercion in a dependent context (in other words,\nin a kind) we need to make sure that our flavour is never Derived\n(as Derived constraints have no evidence). The noBogusCoercions function\nchanges the flavour from Derived just for this purpose.\n\n-}\n\n{- *********************************************************************\n*                                                                      *\n*      Externally callable flattening functions                        *\n*                                                                      *\n*  They are all wrapped in runFlatten, so their                        *\n*  flattening work gets put into the work list                         *\n*                                                                      *\n********************************************************************* -}\n\nflatten :: FlattenMode -> CtEvidence -> TcType\n        -> TcS (Xi, TcCoercion)\nflatten mode ev ty\n  = do { traceTcS \"flatten {\" (ppr mode <+> ppr ty)\n       ; (ty', co) <- runFlattenCtEv mode ev (flatten_one ty)\n       ; traceTcS \"flatten }\" (ppr ty')\n       ; return (ty', co) }\n\n-- specialized to flattening kinds: never Derived, always Nominal\n-- See Note [No derived kind equalities]\nflattenKind :: CtLoc -> CtFlavour -> TcType -> TcS (Xi, TcCoercionN)\nflattenKind loc flav ty\n  = do { traceTcS \"flattenKind {\" (ppr flav <+> ppr ty)\n       ; let flav' = case flav of\n                       Derived -> Wanted WDeriv  -- the WDeriv/WOnly choice matters not\n                       _       -> flav\n       ; (ty', co) <- runFlatten FM_FlattenAll loc flav' NomEq (flatten_one ty)\n       ; traceTcS \"flattenKind }\" (ppr ty' $$ ppr co) -- co is never a panic\n       ; return (ty', co) }\n\nflattenArgsNom :: CtEvidence -> TyCon -> [TcType] -> TcS ([Xi], [TcCoercion], TcCoercionN)\n-- Externally-callable, hence runFlatten\n-- Flatten a vector of types all at once; in fact they are\n-- always the arguments of type family or class, so\n--      ctEvFlavour ev = Nominal\n-- and we want to flatten all at nominal role\n-- The kind passed in is the kind of the type family or class, call it T\n-- The last coercion returned has type (tcTypeKind(T xis) ~N tcTypeKind(T tys))\n--\n-- For Derived constraints the returned coercion may be undefined\n-- because flattening may use a Derived equality ([D] a ~ ty)\nflattenArgsNom ev tc tys\n  = do { traceTcS \"flatten_args {\" (vcat (map ppr tys))\n       ; (tys', cos, kind_co)\n           <- runFlattenCtEv FM_FlattenAll ev (flatten_args_tc tc (repeat Nominal) tys)\n       ; traceTcS \"flatten }\" (vcat (map ppr tys'))\n       ; return (tys', cos, kind_co) }\n\n\n{- *********************************************************************\n*                                                                      *\n*           The main flattening functions\n*                                                                      *\n********************************************************************* -}\n\n{- Note [Flattening]\n~~~~~~~~~~~~~~~~~~~~\n  flatten ty  ==>   (xi, co)\n    where\n      xi has no type functions, unless they appear under ForAlls\n         has no skolems that are mapped in the inert set\n         has no filled-in metavariables\n      co :: xi ~ ty\n\nKey invariants:\n  (F0) co :: xi ~ zonk(ty)\n  (F1) tcTypeKind(xi) succeeds and returns a fully zonked kind\n  (F2) tcTypeKind(xi) `eqType` zonk(tcTypeKind(ty))\n\nNote that it is flatten's job to flatten *every type function it sees*.\nflatten is only called on *arguments* to type functions, by canEqGiven.\n\nFlattening also:\n  * zonks, removing any metavariables, and\n  * applies the substitution embodied in the inert set\n\nBecause flattening zonks and the returned coercion (\"co\" above) is also\nzonked, it's possible that (co :: xi ~ ty) isn't quite true. So, instead,\nwe can rely on this fact:\n\n  (F1) tcTypeKind(xi) succeeds and returns a fully zonked kind\n\nNote that the left-hand type of co is *always* precisely xi. The right-hand\ntype may or may not be ty, however: if ty has unzonked filled-in metavariables,\nthen the right-hand type of co will be the zonked version of ty.\nIt is for this reason that we\noccasionally have to explicitly zonk, when (co :: xi ~ ty) is important\neven before we zonk the whole program. For example, see the FTRNotFollowed\ncase in flattenTyVar.\n\nWhy have these invariants on flattening? Because we sometimes use tcTypeKind\nduring canonicalisation, and we want this kind to be zonked (e.g., see\nTcCanonical.canEqTyVar).\n\nFlattening is always homogeneous. That is, the kind of the result of flattening is\nalways the same as the kind of the input, modulo zonking. More formally:\n\n  (F2) tcTypeKind(xi) `eqType` zonk(tcTypeKind(ty))\n\nThis invariant means that the kind of a flattened type might not itself be flat.\n\nRecall that in comments we use alpha[flat = ty] to represent a\nflattening skolem variable alpha which has been generated to stand in\nfor ty.\n\n----- Example of flattening a constraint: ------\n  flatten (List (F (G Int)))  ==>  (xi, cc)\n    where\n      xi  = List alpha\n      cc  = { G Int ~ beta[flat = G Int],\n              F beta ~ alpha[flat = F beta] }\nHere\n  * alpha and beta are 'flattening skolem variables'.\n  * All the constraints in cc are 'given', and all their coercion terms\n    are the identity.\n\nNB: Flattening Skolems only occur in canonical constraints, which\nare never zonked, so we don't need to worry about zonking doing\naccidental unflattening.\n\nNote that we prefer to leave type synonyms unexpanded when possible,\nso when the flattener encounters one, it first asks whether its\ntransitive expansion contains any type function applications.  If so,\nit expands the synonym and proceeds; if not, it simply returns the\nunexpanded synonym.\n\nNote [flatten_args performance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn programs with lots of type-level evaluation, flatten_args becomes\npart of a tight loop. For example, see test perf/compiler/T9872a, which\ncalls flatten_args a whopping 7,106,808 times. It is thus important\nthat flatten_args be efficient.\n\nPerformance testing showed that the current implementation is indeed\nefficient. It's critically important that zipWithAndUnzipM be\nspecialized to TcS, and it's also quite helpful to actually `inline`\nit. On test T9872a, here are the allocation stats (Dec 16, 2014):\n\n * Unspecialized, uninlined:     8,472,613,440 bytes allocated in the heap\n * Specialized, uninlined:       6,639,253,488 bytes allocated in the heap\n * Specialized, inlined:         6,281,539,792 bytes allocated in the heap\n\nTo improve performance even further, flatten_args_nom is split off\nfrom flatten_args, as nominal equality is the common case. This would\nbe natural to write using mapAndUnzipM, but even inlined, that function\nis not as performant as a hand-written loop.\n\n * mapAndUnzipM, inlined:        7,463,047,432 bytes allocated in the heap\n * hand-written recursion:       5,848,602,848 bytes allocated in the heap\n\nIf you make any change here, pay close attention to the T9872{a,b,c} tests\nand T5321Fun.\n\nIf we need to make this yet more performant, a possible way forward is to\nduplicate the flattener code for the nominal case, and make that case\nfaster. This doesn't seem quite worth it, yet.\n\nNote [flatten_exact_fam_app_fully performance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe refactor of GRefl seems to cause performance trouble for T9872x: the allocation of flatten_exact_fam_app_fully_performance increased. See note [Generalized reflexive coercion] in TyCoRep for more information about GRefl and Trac #15192 for the current state.\n\nThe explicit pattern match in homogenise_result helps with T9872a, b, c.\n\nStill, it increases the expected allocation of T9872d by ~2%.\n\nTODO: a step-by-step replay of the refactor to analyze the performance.\n\n-}\n\n{-# INLINE flatten_args_tc #-}\nflatten_args_tc\n  :: TyCon         -- T\n  -> [Role]        -- Role r\n  -> [Type]        -- Arg types [t1,..,tn]\n  -> FlatM ( [Xi]  -- List of flattened args [x1,..,xn]\n                   -- 1-1 corresp with [t1,..,tn]\n           , [Coercion]  -- List of arg coercions [co1,..,con]\n                         -- 1-1 corresp with [t1,..,tn]\n                         --    coi :: xi ~r ti\n           , CoercionN)  -- Result coercion, rco\n                         --    rco : (T t1..tn) ~N (T (x1 |> co1) .. (xn |> con))\nflatten_args_tc tc = flatten_args all_bndrs any_named_bndrs inner_ki emptyVarSet\n  -- NB: TyCon kinds are always closed\n  where\n    (bndrs, named)\n      = ty_con_binders_ty_binders' (tyConBinders tc)\n    -- it's possible that the result kind has arrows (for, e.g., a type family)\n    -- so we must split it\n    (inner_bndrs, inner_ki, inner_named) = split_pi_tys' (tyConResKind tc)\n    !all_bndrs                           = bndrs `chkAppend` inner_bndrs\n    !any_named_bndrs                     = named || inner_named\n    -- NB: Those bangs there drop allocations in T9872{a,c,d} by 8%.\n\n{-# INLINE flatten_args #-}\nflatten_args :: [TyCoBinder] -> Bool -- Binders, and True iff any of them are\n                                     -- named.\n             -> Kind -> TcTyCoVarSet -- function kind; kind's free vars\n             -> [Role] -> [Type]     -- these are in 1-to-1 correspondence\n             -> FlatM ([Xi], [Coercion], CoercionN)\n-- Coercions :: Xi ~ Type, at roles given\n-- Third coercion :: tcTypeKind(fun xis) ~N tcTypeKind(fun tys)\n-- That is, the third coercion relates the kind of some function (whose kind is\n-- passed as the first parameter) instantiated at xis to the kind of that\n-- function instantiated at the tys. This is useful in keeping flattening\n-- homoegeneous. The list of roles must be at least as long as the list of\n-- types.\nflatten_args orig_binders\n             any_named_bndrs\n             orig_inner_ki\n             orig_fvs\n             orig_roles\n             orig_tys\n  = if any_named_bndrs\n    then flatten_args_slow orig_binders\n                           orig_inner_ki\n                           orig_fvs\n                           orig_roles\n                           orig_tys\n    else flatten_args_fast orig_binders orig_inner_ki orig_roles orig_tys\n\n{-# INLINE flatten_args_fast #-}\n-- | fast path flatten_args, in which none of the binders are named and\n-- therefore we can avoid tracking a lifting context.\n-- There are many bang patterns in here. It's been observed that they\n-- greatly improve performance of an optimized build.\n-- The T9872 test cases are good witnesses of this fact.\nflatten_args_fast :: [TyCoBinder]\n                  -> Kind\n                  -> [Role]\n                  -> [Type]\n                  -> FlatM ([Xi], [Coercion], CoercionN)\nflatten_args_fast orig_binders orig_inner_ki orig_roles orig_tys\n  = fmap finish (iterate orig_tys orig_roles orig_binders)\n  where\n\n    iterate :: [Type]\n            -> [Role]\n            -> [TyCoBinder]\n            -> FlatM ([Xi], [Coercion], [TyCoBinder])\n    iterate (ty:tys) (role:roles) (_:binders) = do\n      (xi, co) <- go role ty\n      (xis, cos, binders) <- iterate tys roles binders\n      pure (xi : xis, co : cos, binders)\n    iterate [] _ binders = pure ([], [], binders)\n    iterate _ _ _ = pprPanic\n        \"flatten_args wandered into deeper water than usual\" (vcat [])\n           -- This debug information is commented out because leaving it in\n           -- causes a ~2% increase in allocations in T9872{a,c,d}.\n           {-\n             (vcat [ppr orig_binders,\n                    ppr orig_inner_ki,\n                    ppr (take 10 orig_roles), -- often infinite!\n                    ppr orig_tys])\n           -}\n\n    {-# INLINE go #-}\n    go :: Role\n       -> Type\n       -> FlatM (Xi, Coercion)\n    go role ty\n      = case role of\n          -- In the slow path we bind the Xi and Coercion from the recursive\n          -- call and then use it such\n          --\n          --   let kind_co = mkTcSymCo $ mkReflCo Nominal (tyBinderType binder)\n          --       casted_xi = xi `mkCastTy` kind_co\n          --       casted_co = xi |> kind_co ~r xi ; co\n          --\n          -- but this isn't necessary:\n          --   mkTcSymCo (Refl a b) = Refl a b,\n          --   mkCastTy x (Refl _ _) = x\n          --   mkTcGReflLeftCo _ ty (Refl _ _) `mkTransCo` co = co\n          --\n          -- Also, no need to check isAnonTyCoBinder or isNamedBinder, since\n          -- we've already established that they're all anonymous.\n          Nominal          -> setEqRel NomEq  $ flatten_one ty\n          Representational -> setEqRel ReprEq $ flatten_one ty\n          Phantom          -> -- See Note [Phantoms in the flattener]\n                              do { ty <- liftTcS $ zonkTcType ty\n                                 ; return (ty, mkReflCo Phantom ty) }\n\n\n    {-# INLINE finish #-}\n    finish :: ([Xi], [Coercion], [TyCoBinder]) -> ([Xi], [Coercion], CoercionN)\n    finish (xis, cos, binders) = (xis, cos, kind_co)\n      where\n        final_kind = mkPiTys binders orig_inner_ki\n        kind_co    = mkNomReflCo final_kind\n\n{-# INLINE flatten_args_slow #-}\n-- | Slow path, compared to flatten_args_fast, because this one must track\n-- a lifting context.\nflatten_args_slow :: [TyCoBinder] -> Kind -> TcTyCoVarSet\n                  -> [Role] -> [Type]\n                  -> FlatM ([Xi], [Coercion], CoercionN)\nflatten_args_slow binders inner_ki fvs roles tys\n-- Arguments used dependently must be flattened with proper coercions, but\n-- we're not guaranteed to get a proper coercion when flattening with the\n-- \"Derived\" flavour. So we must call noBogusCoercions when flattening arguments\n-- corresponding to binders that are dependent. However, we might legitimately\n-- have *more* arguments than binders, in the case that the inner_ki is a variable\n-- that gets instantiated with a \u00ce\u00a0-type. We conservatively choose not to produce\n-- bogus coercions for these, too. Note that this might miss an opportunity for\n-- a Derived rewriting a Derived. The solution would be to generate evidence for\n-- Deriveds, thus avoiding this whole noBogusCoercions idea. See also\n-- Note [No derived kind equalities]\n  = do { flattened_args <- zipWith3M fl (map isNamedBinder binders ++ repeat True)\n                                        roles tys\n       ; return (simplifyArgsWorker binders inner_ki fvs roles flattened_args) }\n  where\n    {-# INLINE fl #-}\n    fl :: Bool   -- must we ensure to produce a real coercion here?\n                  -- see comment at top of function\n       -> Role -> Type -> FlatM (Xi, Coercion)\n    fl True  r ty = noBogusCoercions $ fl1 r ty\n    fl False r ty =                    fl1 r ty\n\n    {-# INLINE fl1 #-}\n    fl1 :: Role -> Type -> FlatM (Xi, Coercion)\n    fl1 Nominal ty\n      = setEqRel NomEq $\n        flatten_one ty\n\n    fl1 Representational ty\n      = setEqRel ReprEq $\n        flatten_one ty\n\n    fl1 Phantom ty\n    -- See Note [Phantoms in the flattener]\n      = do { ty <- liftTcS $ zonkTcType ty\n           ; return (ty, mkReflCo Phantom ty) }\n\n------------------\nflatten_one :: TcType -> FlatM (Xi, Coercion)\n-- Flatten a type to get rid of type function applications, returning\n-- the new type-function-free type, and a collection of new equality\n-- constraints.  See Note [Flattening] for more detail.\n--\n-- Postcondition: Coercion :: Xi ~ TcType\n-- The role on the result coercion matches the EqRel in the FlattenEnv\n\nflatten_one xi@(LitTy {})\n  = do { role <- getRole\n       ; return (xi, mkReflCo role xi) }\n\nflatten_one (TyVarTy tv)\n  = flattenTyVar tv\n\nflatten_one (AppTy ty1 ty2)\n  = flatten_app_tys ty1 [ty2]\n\nflatten_one (TyConApp tc tys)\n  -- Expand type synonyms that mention type families\n  -- on the RHS; see Note [Flattening synonyms]\n  | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys\n  , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys'\n  = do { mode <- getMode\n       ; case mode of\n           FM_FlattenAll | not (isFamFreeTyCon tc)\n                         -> flatten_one expanded_ty\n           _             -> flatten_ty_con_app tc tys }\n\n  -- Otherwise, it's a type function application, and we have to\n  -- flatten it away as well, and generate a new given equality constraint\n  -- between the application and a newly generated flattening skolem variable.\n  | isTypeFamilyTyCon tc\n  = flatten_fam_app tc tys\n\n  -- For * a normal data type application\n  --     * data family application\n  -- we just recursively flatten the arguments.\n  | otherwise\n-- FM_Avoid stuff commented out; see Note [Lazy flattening]\n--  , let fmode' = case fmode of  -- Switch off the flat_top bit in FM_Avoid\n--                   FE { fe_mode = FM_Avoid tv _ }\n--                     -> fmode { fe_mode = FM_Avoid tv False }\n--                   _ -> fmode\n  = flatten_ty_con_app tc tys\n\nflatten_one ty@(FunTy _ ty1 ty2)\n  = do { (xi1,co1) <- flatten_one ty1\n       ; (xi2,co2) <- flatten_one ty2\n       ; role <- getRole\n       ; return (ty { ft_arg = xi1, ft_res = xi2 }\n                , mkFunCo role co1 co2) }\n\nflatten_one ty@(ForAllTy {})\n-- TODO (RAE): This is inadequate, as it doesn't flatten the kind of\n-- the bound tyvar. Doing so will require carrying around a substitution\n-- and the usual substTyVarBndr-like silliness. Argh.\n\n-- We allow for-alls when, but only when, no type function\n-- applications inside the forall involve the bound type variables.\n  = do { let (bndrs, rho) = tcSplitForAllVarBndrs ty\n             tvs           = binderVars bndrs\n       ; (rho', co) <- setMode FM_SubstOnly $ flatten_one rho\n                         -- Substitute only under a forall\n                         -- See Note [Flattening under a forall]\n       ; return (mkForAllTys bndrs rho', mkHomoForAllCos tvs co) }\n\nflatten_one (CastTy ty g)\n  = do { (xi, co) <- flatten_one ty\n       ; (g', _)   <- flatten_co g\n\n       ; role <- getRole\n       ; return (mkCastTy xi g', castCoercionKind co role xi ty g' g) }\n\nflatten_one (CoercionTy co) = first mkCoercionTy <$> flatten_co co\n\n-- | \"Flatten\" a coercion. Really, just zonk it so we can uphold\n-- (F1) of Note [Flattening]\nflatten_co :: Coercion -> FlatM (Coercion, Coercion)\nflatten_co co\n  = do { co <- liftTcS $ zonkCo co\n       ; env_role <- getRole\n       ; let co' = mkTcReflCo env_role (mkCoercionTy co)\n       ; return (co, co') }\n\n-- flatten (nested) AppTys\nflatten_app_tys :: Type -> [Type] -> FlatM (Xi, Coercion)\n-- commoning up nested applications allows us to look up the function's kind\n-- only once. Without commoning up like this, we would spend a quadratic amount\n-- of time looking up functions' types\nflatten_app_tys (AppTy ty1 ty2) tys = flatten_app_tys ty1 (ty2:tys)\nflatten_app_tys fun_ty arg_tys\n  = do { (fun_xi, fun_co) <- flatten_one fun_ty\n       ; flatten_app_ty_args fun_xi fun_co arg_tys }\n\n-- Given a flattened function (with the coercion produced by flattening) and\n-- a bunch of unflattened arguments, flatten the arguments and apply.\n-- The coercion argument's role matches the role stored in the FlatM monad.\n--\n-- The bang patterns used here were observed to improve performance. If you\n-- wish to remove them, be sure to check for regeressions in allocations.\nflatten_app_ty_args :: Xi -> Coercion -> [Type] -> FlatM (Xi, Coercion)\nflatten_app_ty_args fun_xi fun_co []\n  -- this will be a common case when called from flatten_fam_app, so shortcut\n  = return (fun_xi, fun_co)\nflatten_app_ty_args fun_xi fun_co arg_tys\n  = do { (xi, co, kind_co) <- case tcSplitTyConApp_maybe fun_xi of\n           Just (tc, xis) ->\n             do { let tc_roles  = tyConRolesRepresentational tc\n                      arg_roles = dropList xis tc_roles\n                ; (arg_xis, arg_cos, kind_co)\n                    <- flatten_vector (tcTypeKind fun_xi) arg_roles arg_tys\n\n                  -- Here, we have fun_co :: T xi1 xi2 ~ ty\n                  -- and we need to apply fun_co to the arg_cos. The problem is\n                  -- that using mkAppCo is wrong because that function expects\n                  -- its second coercion to be Nominal, and the arg_cos might\n                  -- not be. The solution is to use transitivity:\n                  -- T <xi1> <xi2> arg_cos ;; fun_co <arg_tys>\n                ; eq_rel <- getEqRel\n                ; let app_xi = mkTyConApp tc (xis ++ arg_xis)\n                      app_co = case eq_rel of\n                        NomEq  -> mkAppCos fun_co arg_cos\n                        ReprEq -> mkTcTyConAppCo Representational tc\n                                    (zipWith mkReflCo tc_roles xis ++ arg_cos)\n                                  `mkTcTransCo`\n                                  mkAppCos fun_co (map mkNomReflCo arg_tys)\n                ; return (app_xi, app_co, kind_co) }\n           Nothing ->\n             do { (arg_xis, arg_cos, kind_co)\n                    <- flatten_vector (tcTypeKind fun_xi) (repeat Nominal) arg_tys\n                ; let arg_xi = mkAppTys fun_xi arg_xis\n                      arg_co = mkAppCos fun_co arg_cos\n                ; return (arg_xi, arg_co, kind_co) }\n\n       ; role <- getRole\n       ; return (homogenise_result xi co role kind_co) }\n\nflatten_ty_con_app :: TyCon -> [TcType] -> FlatM (Xi, Coercion)\nflatten_ty_con_app tc tys\n  = do { role <- getRole\n       ; (xis, cos, kind_co) <- flatten_args_tc tc (tyConRolesX role tc) tys\n       ; let tyconapp_xi = mkTyConApp tc xis\n             tyconapp_co = mkTyConAppCo role tc cos\n       ; return (homogenise_result tyconapp_xi tyconapp_co role kind_co) }\n\n-- Make the result of flattening homogeneous (Note [Flattening] (F2))\nhomogenise_result :: Xi              -- a flattened type\n                  -> Coercion        -- :: xi ~r original ty\n                  -> Role            -- r\n                  -> CoercionN       -- kind_co :: tcTypeKind(xi) ~N tcTypeKind(ty)\n                  -> (Xi, Coercion)  -- (xi |> kind_co, (xi |> kind_co)\n                                     --   ~r original ty)\nhomogenise_result xi co r kind_co\n  -- the explicit pattern match here improves the performance of T9872a, b, c by\n  -- ~2%\n  | isGReflCo kind_co = (xi `mkCastTy` kind_co, co)\n  | otherwise         = (xi `mkCastTy` kind_co\n                        , (mkSymCo $ GRefl r xi (MCo kind_co)) `mkTransCo` co)\n{-# INLINE homogenise_result #-}\n\n-- Flatten a vector (list of arguments).\nflatten_vector :: Kind   -- of the function being applied to these arguments\n               -> [Role] -- If we're flatten w.r.t. ReprEq, what roles do the\n                         -- args have?\n               -> [Type] -- the args to flatten\n               -> FlatM ([Xi], [Coercion], CoercionN)\nflatten_vector ki roles tys\n  = do { eq_rel <- getEqRel\n       ; case eq_rel of\n           NomEq  -> flatten_args bndrs\n                                  any_named_bndrs\n                                  inner_ki\n                                  fvs\n                                  (repeat Nominal)\n                                  tys\n           ReprEq -> flatten_args bndrs\n                                  any_named_bndrs\n                                  inner_ki\n                                  fvs\n                                  roles\n                                  tys\n       }\n  where\n    (bndrs, inner_ki, any_named_bndrs) = split_pi_tys' ki\n    fvs                                = tyCoVarsOfType ki\n{-# INLINE flatten_vector #-}\n\n{-\nNote [Flattening synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nNot expanding synonyms aggressively improves error messages, and\nkeeps types smaller. But we need to take care.\n\nSuppose\n   type T a = a -> a\nand we want to flatten the type (T (F a)).  Then we can safely flatten\nthe (F a) to a skolem, and return (T fsk).  We don't need to expand the\nsynonym.  This works because TcTyConAppCo can deal with synonyms\n(unlike TyConAppCo), see Note [TcCoercions] in TcEvidence.\n\nBut (Trac #8979) for\n   type T a = (F a, a)    where F is a type function\nwe must expand the synonym in (say) T Int, to expose the type function\nto the flattener.\n\n\nNote [Flattening under a forall]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nUnder a forall, we\n  (a) MUST apply the inert substitution\n  (b) MUST NOT flatten type family applications\nHence FMSubstOnly.\n\nFor (a) consider   c ~ a, a ~ T (forall b. (b, [c]))\nIf we don't apply the c~a substitution to the second constraint\nwe won't see the occurs-check error.\n\nFor (b) consider  (a ~ forall b. F a b), we don't want to flatten\nto     (a ~ forall b.fsk, F a b ~ fsk)\nbecause now the 'b' has escaped its scope.  We'd have to flatten to\n       (a ~ forall b. fsk b, forall b. F a b ~ fsk b)\nand we have not begun to think about how to make that work!\n\n************************************************************************\n*                                                                      *\n             Flattening a type-family application\n*                                                                      *\n************************************************************************\n-}\n\nflatten_fam_app :: TyCon -> [TcType] -> FlatM (Xi, Coercion)\n  --   flatten_fam_app            can be over-saturated\n  --   flatten_exact_fam_app       is exactly saturated\n  --   flatten_exact_fam_app_fully lifts out the application to top level\n  -- Postcondition: Coercion :: Xi ~ F tys\nflatten_fam_app tc tys  -- Can be over-saturated\n    = ASSERT2( tys `lengthAtLeast` tyConArity tc\n             , ppr tc $$ ppr (tyConArity tc) $$ ppr tys)\n\n      do { mode <- getMode\n         ; case mode of\n             { FM_SubstOnly  -> flatten_ty_con_app tc tys\n             ; FM_FlattenAll ->\n\n                 -- Type functions are saturated\n                 -- The type function might be *over* saturated\n                 -- in which case the remaining arguments should\n                 -- be dealt with by AppTys\n      do { let (tys1, tys_rest) = splitAt (tyConArity tc) tys\n         ; (xi1, co1) <- flatten_exact_fam_app_fully tc tys1\n               -- co1 :: xi1 ~ F tys1\n\n         ; flatten_app_ty_args xi1 co1 tys_rest } } }\n\n-- the [TcType] exactly saturate the TyCon\n-- See note [flatten_exact_fam_app_fully performance]\nflatten_exact_fam_app_fully :: TyCon -> [TcType] -> FlatM (Xi, Coercion)\nflatten_exact_fam_app_fully tc tys\n  -- See Note [Reduce type family applications eagerly]\n     -- the following tcTypeKind should never be evaluated, as it's just used in\n     -- casting, and casts by refl are dropped\n  = do { mOut <- try_to_reduce_nocache tc tys\n       ; case mOut of\n           Just out -> pure out\n           Nothing -> do\n               { -- First, flatten the arguments\n               ; (xis, cos, kind_co)\n                   <- setEqRel NomEq $  -- just do this once, instead of for\n                                        -- each arg\n                      flatten_args_tc tc (repeat Nominal) tys\n                      -- kind_co :: tcTypeKind(F xis) ~N tcTypeKind(F tys)\n               ; eq_rel   <- getEqRel\n               ; cur_flav <- getFlavour\n               ; let role   = eqRelRole eq_rel\n                     ret_co = mkTyConAppCo role tc cos\n                      -- ret_co :: F xis ~ F tys; might be heterogeneous\n\n                -- Now, look in the cache\n               ; mb_ct <- liftTcS $ lookupFlatCache tc xis\n               ; case mb_ct of\n                   Just (co, rhs_ty, flav)  -- co :: F xis ~ fsk\n                        -- flav is [G] or [WD]\n                        -- See Note [Type family equations] in TcSMonad\n                     | (NotSwapped, _) <- flav `funEqCanDischargeF` cur_flav\n                     ->  -- Usable hit in the flat-cache\n                        do { traceFlat \"flatten/flat-cache hit\" $\n                               (ppr tc <+> ppr xis $$ ppr rhs_ty)\n                           ; (fsk_xi, fsk_co) <- flatten_one rhs_ty\n                                  -- The fsk may already have been unified, so\n                                  -- flatten it\n                                  -- fsk_co :: fsk_xi ~ fsk\n                           ; let xi  = fsk_xi `mkCastTy` kind_co\n                                 co' = mkTcCoherenceLeftCo role fsk_xi kind_co fsk_co\n                                       `mkTransCo`\n                                       maybeSubCo eq_rel (mkSymCo co)\n                                       `mkTransCo` ret_co\n                           ; return (xi, co')\n                           }\n                                            -- :: fsk_xi ~ F xis\n\n                   -- Try to reduce the family application right now\n                   -- See Note [Reduce type family applications eagerly]\n                   _ -> do { mOut <- try_to_reduce tc\n                                                   xis\n                                                   kind_co\n                                                   (`mkTransCo` ret_co)\n                           ; case mOut of\n                               Just out -> pure out\n                               Nothing -> do\n                                 { loc <- getLoc\n                                 ; (ev, co, fsk) <- liftTcS $\n                                     newFlattenSkolem cur_flav loc tc xis\n\n                                 -- The new constraint (F xis ~ fsk) is not\n                                 -- necessarily inert (e.g. the LHS may be a\n                                 -- redex) so we must put it in the work list\n                                 ; let ct = CFunEqCan { cc_ev     = ev\n                                                      , cc_fun    = tc\n                                                      , cc_tyargs = xis\n                                                      , cc_fsk    = fsk }\n                                 ; emitFlatWork ct\n\n                                 ; traceFlat \"flatten/flat-cache miss\" $\n                                     (ppr tc <+> ppr xis $$ ppr fsk $$ ppr ev)\n\n                                 -- NB: fsk's kind is already flattened because\n                                 --     the xis are flattened\n                                 ; let fsk_ty = mkTyVarTy fsk\n                                       xi = fsk_ty `mkCastTy` kind_co\n                                       co' = mkTcCoherenceLeftCo role fsk_ty kind_co (maybeSubCo eq_rel (mkSymCo co))\n                                             `mkTransCo` ret_co\n                                 ; return (xi, co')\n                                 }\n                           }\n               }\n        }\n\n  where\n\n    -- try_to_reduce and try_to_reduce_nocache (below) could be unified into\n    -- a more general definition, but it was observed that separating them\n    -- gives better performance (lower allocation numbers in T9872x).\n\n    try_to_reduce :: TyCon   -- F, family tycon\n                  -> [Type]  -- args, not necessarily flattened\n                  -> CoercionN -- kind_co :: tcTypeKind(F args) ~N\n                               --            tcTypeKind(F orig_args)\n                               -- where\n                               -- orig_args is what was passed to the outer\n                               -- function\n                  -> (   Coercion     -- :: (xi |> kind_co) ~ F args\n                      -> Coercion )   -- what to return from outer function\n                  -> FlatM (Maybe (Xi, Coercion))\n    try_to_reduce tc tys kind_co update_co\n      = do { checkStackDepth (mkTyConApp tc tys)\n           ; mb_match <- liftTcS $ matchFam tc tys\n           ; case mb_match of\n                 -- NB: norm_co will always be homogeneous. All type families\n                 -- are homogeneous.\n               Just (norm_co, norm_ty)\n                 -> do { traceFlat \"Eager T.F. reduction success\" $\n                         vcat [ ppr tc, ppr tys, ppr norm_ty\n                              , ppr norm_co <+> dcolon\n                                            <+> ppr (coercionKind norm_co)\n                              ]\n                       ; (xi, final_co) <- bumpDepth $ flatten_one norm_ty\n                       ; eq_rel <- getEqRel\n                       ; let co = maybeSubCo eq_rel norm_co\n                                   `mkTransCo` mkSymCo final_co\n                       ; flavour <- getFlavour\n                           -- NB: only extend cache with nominal equalities\n                       ; when (eq_rel == NomEq) $\n                         liftTcS $\n                         extendFlatCache tc tys ( co, xi, flavour )\n                       ; let role = eqRelRole eq_rel\n                             xi' = xi `mkCastTy` kind_co\n                             co' = update_co $\n                                   mkTcCoherenceLeftCo role xi kind_co (mkSymCo co)\n                       ; return $ Just (xi', co') }\n               Nothing -> pure Nothing }\n\n    try_to_reduce_nocache :: TyCon   -- F, family tycon\n                          -> [Type]  -- args, not necessarily flattened\n                          -> FlatM (Maybe (Xi, Coercion))\n    try_to_reduce_nocache tc tys\n      = do { checkStackDepth (mkTyConApp tc tys)\n           ; mb_match <- liftTcS $ matchFam tc tys\n           ; case mb_match of\n                 -- NB: norm_co will always be homogeneous. All type families\n                 -- are homogeneous.\n               Just (norm_co, norm_ty)\n                 -> do { (xi, final_co) <- bumpDepth $ flatten_one norm_ty\n                       ; eq_rel <- getEqRel\n                       ; let co  = mkSymCo (maybeSubCo eq_rel norm_co\n                                            `mkTransCo` mkSymCo final_co)\n                       ; return $ Just (xi, co) }\n               Nothing -> pure Nothing }\n\n{- Note [Reduce type family applications eagerly]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we come across a type-family application like (Append (Cons x Nil) t),\nthen, rather than flattening to a skolem etc, we may as well just reduce\nit on the spot to (Cons x t).  This saves a lot of intermediate steps.\nExamples that are helped are tests T9872, and T5321Fun.\n\nPerformance testing indicates that it's best to try this *twice*, once\nbefore flattening arguments and once after flattening arguments.\nAdding the extra reduction attempt before flattening arguments cut\nthe allocation amounts for the T9872{a,b,c} tests by half.\n\nAn example of where the early reduction appears helpful:\n\n  type family Last x where\n    Last '[x]     = x\n    Last (h ': t) = Last t\n\n  workitem: (x ~ Last '[1,2,3,4,5,6])\n\nFlattening the argument never gets us anywhere, but trying to flatten\nit at every step is quadratic in the length of the list. Reducing more\neagerly makes simplifying the right-hand type linear in its length.\n\nTesting also indicated that the early reduction should *not* use the\nflat-cache, but that the later reduction *should*. (Although the\neffect was not large.)  Hence the Bool argument to try_to_reduce.  To\nme (SLPJ) this seems odd; I get that eager reduction usually succeeds;\nand if don't use the cache for eager reduction, we will miss most of\nthe opportunities for using it at all.  More exploration would be good\nhere.\n\nAt the end, once we've got a flat rhs, we extend the flatten-cache to record\nthe result. Doing so can save lots of work when the same redex shows up more\nthan once. Note that we record the link from the redex all the way to its\n*final* value, not just the single step reduction. Interestingly, using the\nflat-cache for the first reduction resulted in an increase in allocations\nof about 3% for the four T9872x tests. However, using the flat-cache in\nthe later reduction is a similar gain. I (Richard E) don't currently (Dec '14)\nhave any knowledge as to *why* these facts are true.\n\n************************************************************************\n*                                                                      *\n             Flattening a type variable\n*                                                                      *\n********************************************************************* -}\n\n-- | The result of flattening a tyvar \"one step\".\ndata FlattenTvResult\n  = FTRNotFollowed\n      -- ^ The inert set doesn't make the tyvar equal to anything else\n\n  | FTRFollowed TcType Coercion\n      -- ^ The tyvar flattens to a not-necessarily flat other type.\n      -- co :: new type ~r old type, where the role is determined by\n      -- the FlattenEnv\n\nflattenTyVar :: TyVar -> FlatM (Xi, Coercion)\nflattenTyVar tv\n  = do { mb_yes <- flatten_tyvar1 tv\n       ; case mb_yes of\n           FTRFollowed ty1 co1  -- Recur\n             -> do { (ty2, co2) <- flatten_one ty1\n                   -- ; traceFlat \"flattenTyVar2\" (ppr tv $$ ppr ty2)\n                   ; return (ty2, co2 `mkTransCo` co1) }\n\n           FTRNotFollowed   -- Done, but make sure the kind is zonked\n                            -- Note [Flattening] invariant (F1)\n             -> do { tv' <- liftTcS $ updateTyVarKindM zonkTcType tv\n                   ; role <- getRole\n                   ; let ty' = mkTyVarTy tv'\n                   ; return (ty', mkTcReflCo role ty') } }\n\nflatten_tyvar1 :: TcTyVar -> FlatM FlattenTvResult\n-- \"Flattening\" a type variable means to apply the substitution to it\n-- Specifically, look up the tyvar in\n--   * the internal MetaTyVar box\n--   * the inerts\n-- See also the documentation for FlattenTvResult\n\nflatten_tyvar1 tv\n  = do { mb_ty <- liftTcS $ isFilledMetaTyVar_maybe tv\n       ; case mb_ty of\n           Just ty -> do { traceFlat \"Following filled tyvar\"\n                             (ppr tv <+> equals <+> ppr ty)\n                         ; role <- getRole\n                         ; return (FTRFollowed ty (mkReflCo role ty)) } ;\n           Nothing -> do { traceFlat \"Unfilled tyvar\" (ppr tv)\n                         ; fr <- getFlavourRole\n                         ; flatten_tyvar2 tv fr } }\n\nflatten_tyvar2 :: TcTyVar -> CtFlavourRole -> FlatM FlattenTvResult\n-- The tyvar is not a filled-in meta-tyvar\n-- Try in the inert equalities\n-- See Definition [Applying a generalised substitution] in TcSMonad\n-- See Note [Stability of flattening] in TcSMonad\n\nflatten_tyvar2 tv fr@(_, eq_rel)\n  = do { ieqs <- liftTcS $ getInertEqs\n       ; mode <- getMode\n       ; case lookupDVarEnv ieqs tv of\n           Just (ct:_)   -- If the first doesn't work,\n                         -- the subsequent ones won't either\n             | CTyEqCan { cc_ev = ctev, cc_tyvar = tv\n                        , cc_rhs = rhs_ty, cc_eq_rel = ct_eq_rel } <- ct\n             , let ct_fr = (ctEvFlavour ctev, ct_eq_rel)\n             , ct_fr `eqCanRewriteFR` fr  -- This is THE key call of eqCanRewriteFR\n             ->  do { traceFlat \"Following inert tyvar\"\n                        (ppr mode <+>\n                         ppr tv <+>\n                         equals <+>\n                         ppr rhs_ty $$ ppr ctev)\n                    ; let rewrite_co1 = mkSymCo (ctEvCoercion ctev)\n                          rewrite_co  = case (ct_eq_rel, eq_rel) of\n                            (ReprEq, _rel)  -> ASSERT( _rel == ReprEq )\n                                    -- if this ASSERT fails, then\n                                    -- eqCanRewriteFR answered incorrectly\n                                               rewrite_co1\n                            (NomEq, NomEq)  -> rewrite_co1\n                            (NomEq, ReprEq) -> mkSubCo rewrite_co1\n\n                    ; return (FTRFollowed rhs_ty rewrite_co) }\n                    -- NB: ct is Derived then fmode must be also, hence\n                    -- we are not going to touch the returned coercion\n                    -- so ctEvCoercion is fine.\n\n           _other -> return FTRNotFollowed }\n\n{-\nNote [An alternative story for the inert substitution]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(This entire note is just background, left here in case we ever want\n to return the previous state of affairs)\n\nWe used (GHC 7.8) to have this story for the inert substitution inert_eqs\n\n * 'a' is not in fvs(ty)\n * They are *inert* in the weaker sense that there is no infinite chain of\n   (i1 `eqCanRewrite` i2), (i2 `eqCanRewrite` i3), etc\n\nThis means that flattening must be recursive, but it does allow\n  [G] a ~ [b]\n  [G] b ~ Maybe c\n\nThis avoids \"saturating\" the Givens, which can save a modest amount of work.\nIt is easy to implement, in TcInteract.kick_out, by only kicking out an inert\nonly if (a) the work item can rewrite the inert AND\n        (b) the inert cannot rewrite the work item\n\nThis is significantly harder to think about. It can save a LOT of work\nin occurs-check cases, but we don't care about them much.  Trac #5837\nis an example; all the constraints here are Givens\n\n             [G] a ~ TF (a,Int)\n    -->\n    work     TF (a,Int) ~ fsk\n    inert    fsk ~ a\n\n    --->\n    work     fsk ~ (TF a, TF Int)\n    inert    fsk ~ a\n\n    --->\n    work     a ~ (TF a, TF Int)\n    inert    fsk ~ a\n\n    ---> (attempting to flatten (TF a) so that it does not mention a\n    work     TF a ~ fsk2\n    inert    a ~ (fsk2, TF Int)\n    inert    fsk ~ (fsk2, TF Int)\n\n    ---> (substitute for a)\n    work     TF (fsk2, TF Int) ~ fsk2\n    inert    a ~ (fsk2, TF Int)\n    inert    fsk ~ (fsk2, TF Int)\n\n    ---> (top-level reduction, re-orient)\n    work     fsk2 ~ (TF fsk2, TF Int)\n    inert    a ~ (fsk2, TF Int)\n    inert    fsk ~ (fsk2, TF Int)\n\n    ---> (attempt to flatten (TF fsk2) to get rid of fsk2\n    work     TF fsk2 ~ fsk3\n    work     fsk2 ~ (fsk3, TF Int)\n    inert    a   ~ (fsk2, TF Int)\n    inert    fsk ~ (fsk2, TF Int)\n\n    --->\n    work     TF fsk2 ~ fsk3\n    inert    fsk2 ~ (fsk3, TF Int)\n    inert    a   ~ ((fsk3, TF Int), TF Int)\n    inert    fsk ~ ((fsk3, TF Int), TF Int)\n\nBecause the incoming given rewrites all the inert givens, we get more and\nmore duplication in the inert set.  But this really only happens in pathalogical\ncasee, so we don't care.\n\n\n************************************************************************\n*                                                                      *\n             Unflattening\n*                                                                      *\n************************************************************************\n\nAn unflattening example:\n    [W] F a ~ alpha\nflattens to\n    [W] F a ~ fmv   (CFunEqCan)\n    [W] fmv ~ alpha (CTyEqCan)\nWe must solve both!\n-}\n\nunflattenWanteds :: Cts -> Cts -> TcS Cts\nunflattenWanteds tv_eqs funeqs\n = do { tclvl    <- getTcLevel\n\n      ; traceTcS \"Unflattening\" $ braces $\n        vcat [ text \"Funeqs =\" <+> pprCts funeqs\n             , text \"Tv eqs =\" <+> pprCts tv_eqs ]\n\n         -- Step 1: unflatten the CFunEqCans, except if that causes an occurs check\n         -- Occurs check: consider  [W] alpha ~ [F alpha]\n         --                 ==> (flatten) [W] F alpha ~ fmv, [W] alpha ~ [fmv]\n         --                 ==> (unify)   [W] F [fmv] ~ fmv\n         -- See Note [Unflatten using funeqs first]\n      ; funeqs <- foldrBagM unflatten_funeq emptyCts funeqs\n      ; traceTcS \"Unflattening 1\" $ braces (pprCts funeqs)\n\n          -- Step 2: unify the tv_eqs, if possible\n      ; tv_eqs  <- foldrBagM (unflatten_eq tclvl) emptyCts tv_eqs\n      ; traceTcS \"Unflattening 2\" $ braces (pprCts tv_eqs)\n\n          -- Step 3: fill any remaining fmvs with fresh unification variables\n      ; funeqs <- mapBagM finalise_funeq funeqs\n      ; traceTcS \"Unflattening 3\" $ braces (pprCts funeqs)\n\n          -- Step 4: remove any tv_eqs that look like ty ~ ty\n      ; tv_eqs <- foldrBagM finalise_eq emptyCts tv_eqs\n\n      ; let all_flat = tv_eqs `andCts` funeqs\n      ; traceTcS \"Unflattening done\" $ braces (pprCts all_flat)\n\n      ; return all_flat }\n  where\n    ----------------\n    unflatten_funeq :: Ct -> Cts -> TcS Cts\n    unflatten_funeq ct@(CFunEqCan { cc_fun = tc, cc_tyargs = xis\n                                  , cc_fsk = fmv, cc_ev = ev }) rest\n      = do {   -- fmv should be an un-filled flatten meta-tv;\n               -- we now fix its final value by filling it, being careful\n               -- to observe the occurs check.  Zonking will eliminate it\n               -- altogether in due course\n             rhs' <- zonkTcType (mkTyConApp tc xis)\n           ; case occCheckExpand [fmv] rhs' of\n               Just rhs''    -- Normal case: fill the tyvar\n                 -> do { setReflEvidence ev NomEq rhs''\n                       ; unflattenFmv fmv rhs''\n                       ; return rest }\n\n               Nothing ->  -- Occurs check\n                          return (ct `consCts` rest) }\n\n    unflatten_funeq other_ct _\n      = pprPanic \"unflatten_funeq\" (ppr other_ct)\n\n    ----------------\n    finalise_funeq :: Ct -> TcS Ct\n    finalise_funeq (CFunEqCan { cc_fsk = fmv, cc_ev = ev })\n      = do { demoteUnfilledFmv fmv\n           ; return (mkNonCanonical ev) }\n    finalise_funeq ct = pprPanic \"finalise_funeq\" (ppr ct)\n\n    ----------------\n    unflatten_eq :: TcLevel -> Ct -> Cts -> TcS Cts\n    unflatten_eq tclvl ct@(CTyEqCan { cc_ev = ev, cc_tyvar = tv\n                                    , cc_rhs = rhs, cc_eq_rel = eq_rel }) rest\n\n      | NomEq <- eq_rel -- See Note [Do not unify representational equalities]\n                        --     in TcInteract\n      , isFmvTyVar tv   -- Previously these fmvs were untouchable,\n                        -- but now they are touchable\n                        -- NB: unlike unflattenFmv, filling a fmv here /does/\n                        --     bump the unification count; it is \"improvement\"\n                        -- Note [Unflattening can force the solver to iterate]\n      = ASSERT2( tyVarKind tv `eqType` tcTypeKind rhs, ppr ct )\n           -- CTyEqCan invariant should ensure this is true\n        do { is_filled <- isFilledMetaTyVar tv\n           ; elim <- case is_filled of\n               False -> do { traceTcS \"unflatten_eq 2\" (ppr ct)\n                           ; tryFill ev tv rhs }\n               True  -> do { traceTcS \"unflatten_eq 3\" (ppr ct)\n                           ; try_fill_rhs ev tclvl tv rhs }\n           ; if elim\n             then do { setReflEvidence ev eq_rel (mkTyVarTy tv)\n                     ; return rest }\n             else return (ct `consCts` rest) }\n\n      | otherwise\n      = return (ct `consCts` rest)\n\n    unflatten_eq _ ct _ = pprPanic \"unflatten_irred\" (ppr ct)\n\n    ----------------\n    try_fill_rhs ev tclvl lhs_tv rhs\n         -- Constraint is lhs_tv ~ rhs_tv,\n         -- and lhs_tv is filled, so try RHS\n      | Just (rhs_tv, co) <- getCastedTyVar_maybe rhs\n                             -- co :: kind(rhs_tv) ~ kind(lhs_tv)\n      , isFmvTyVar rhs_tv || (isTouchableMetaTyVar tclvl rhs_tv\n                              && not (isTyVarTyVar rhs_tv))\n                              -- LHS is a filled fmv, and so is a type\n                              -- family application, which a TyVarTv should\n                              -- not unify with\n      = do { is_filled <- isFilledMetaTyVar rhs_tv\n           ; if is_filled then return False\n             else tryFill ev rhs_tv\n                          (mkTyVarTy lhs_tv `mkCastTy` mkSymCo co) }\n\n      | otherwise\n      = return False\n\n    ----------------\n    finalise_eq :: Ct -> Cts -> TcS Cts\n    finalise_eq (CTyEqCan { cc_ev = ev, cc_tyvar = tv\n                          , cc_rhs = rhs, cc_eq_rel = eq_rel }) rest\n      | isFmvTyVar tv\n      = do { ty1 <- zonkTcTyVar tv\n           ; rhs' <- zonkTcType rhs\n           ; if ty1 `tcEqType` rhs'\n             then do { setReflEvidence ev eq_rel rhs'\n                     ; return rest }\n             else return (mkNonCanonical ev `consCts` rest) }\n\n      | otherwise\n      = return (mkNonCanonical ev `consCts` rest)\n\n    finalise_eq ct _ = pprPanic \"finalise_irred\" (ppr ct)\n\ntryFill :: CtEvidence -> TcTyVar -> TcType -> TcS Bool\n-- (tryFill tv rhs ev) assumes 'tv' is an /un-filled/ MetaTv\n-- If tv does not appear in 'rhs', it set tv := rhs,\n-- binds the evidence (which should be a CtWanted) to Refl<rhs>\n-- and return True.  Otherwise returns False\ntryFill ev tv rhs\n  = ASSERT2( not (isGiven ev), ppr ev )\n    do { rhs' <- zonkTcType rhs\n       ; case () of\n            _ | Just tv' <- tcGetTyVar_maybe rhs'\n              , tv == tv'   -- tv == rhs\n              -> return True\n\n            _ | Just rhs'' <- occCheckExpand [tv] rhs'\n              -> do {       -- Fill the tyvar\n                      unifyTyVar tv rhs''\n                    ; return True }\n\n            _ | otherwise   -- Occurs check\n              -> return False\n    }\n\nsetReflEvidence :: CtEvidence -> EqRel -> TcType -> TcS ()\nsetReflEvidence ev eq_rel rhs\n  = setEvBindIfWanted ev (evCoercion refl_co)\n  where\n    refl_co = mkTcReflCo (eqRelRole eq_rel) rhs\n\n{-\nNote [Unflatten using funeqs first]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    [W] G a ~ Int\n    [W] F (G a) ~ G a\n\ndo not want to end up with\n    [W] F Int ~ Int\nbecause that might actually hold!  Better to end up with the two above\nunsolved constraints.  The flat form will be\n\n    G a ~ fmv1     (CFunEqCan)\n    F fmv1 ~ fmv2  (CFunEqCan)\n    fmv1 ~ Int     (CTyEqCan)\n    fmv1 ~ fmv2    (CTyEqCan)\n\nFlatten using the fun-eqs first.\n-}\n\n-- | Like 'splitPiTys'' but comes with a 'Bool' which is 'True' iff there is at\n-- least one named binder.\nsplit_pi_tys' :: Type -> ([TyCoBinder], Type, Bool)\nsplit_pi_tys' ty = split ty ty\n  where\n  split orig_ty ty | Just ty' <- coreView ty = split orig_ty ty'\n  split _       (ForAllTy b res) = let (bs, ty, _) = split res res\n                                   in  (Named b : bs, ty, True)\n  split _       (FunTy { ft_af = af, ft_arg = arg, ft_res = res })\n                                 = let (bs, ty, named) = split res res\n                                   in  (Anon af arg : bs, ty, named)\n  split orig_ty _                = ([], orig_ty, False)\n{-# INLINE split_pi_tys' #-}\n\n-- | Like 'tyConBindersTyCoBinders' but you also get a 'Bool' which is true iff\n-- there is at least one named binder.\nty_con_binders_ty_binders' :: [TyConBinder] -> ([TyCoBinder], Bool)\nty_con_binders_ty_binders' = foldr go ([], False)\n  where\n    go (Bndr tv (NamedTCB vis)) (bndrs, _)\n      = (Named (Bndr tv vis) : bndrs, True)\n    go (Bndr tv (AnonTCB af))   (bndrs, n)\n      = (Anon af (tyVarKind tv)   : bndrs, n)\n    {-# INLINE go #-}\n{-# INLINE ty_con_binders_ty_binders' #-}\n", "num_lines": 1880}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1998\n\n\\section[TcForeign]{Typechecking \\tr{foreign} declarations}\n\nA foreign declaration is used to either give an externally\nimplemented function a Haskell type (and calling interface) or\ngive a Haskell function an external calling interface. Either way,\nthe range of argument and result types these functions can accommodate\nis restricted to what the outside world understands (read C), and this\nmodule checks to see if a foreign declaration has got a legal type.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcForeign\n        ( tcForeignImports\n        , tcForeignExports\n\n        -- Low-level exports for hooks\n        , isForeignImport, isForeignExport\n        , tcFImport, tcFExport\n        , tcForeignImports'\n        , tcCheckFIType, checkCTarget, checkForeignArgs, checkForeignRes\n        , normaliseFfiType\n        , nonIOok, mustBeIO\n        , checkSafe, noCheckSafe\n        , tcForeignExports'\n        , tcCheckFEType\n        ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\n\nimport TcRnMonad\nimport TcHsType\nimport TcExpr\nimport TcEnv\n\nimport FamInst\nimport FamInstEnv\nimport Coercion\nimport Type\nimport ForeignCall\nimport ErrUtils\nimport Id\nimport Name\nimport RdrName\nimport DataCon\nimport TyCon\nimport TcType\nimport PrelNames\nimport DynFlags\nimport Outputable\nimport Platform\nimport SrcLoc\nimport Bag\nimport Hooks\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Data.Maybe\n\n-- Defines a binding\nisForeignImport :: LForeignDecl name -> Bool\nisForeignImport (L _ (ForeignImport {})) = True\nisForeignImport _                        = False\n\n-- Exports a binding\nisForeignExport :: LForeignDecl name -> Bool\nisForeignExport (L _ (ForeignExport {})) = True\nisForeignExport _                        = False\n\n{-\nNote [Don't recur in normaliseFfiType']\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nnormaliseFfiType' is the workhorse for normalising a type used in a foreign\ndeclaration. If we have\n\nnewtype Age = MkAge Int\n\nwe want to see that Age -> IO () is the same as Int -> IO (). But, we don't\nneed to recur on any type parameters, because no paramaterized types (with\ninteresting parameters) are marshalable! The full list of marshalable types\nis in the body of boxedMarshalableTyCon in TcType. The only members of that\nlist not at kind * are Ptr, FunPtr, and StablePtr, all of which get marshaled\nthe same way regardless of type parameter. So, no need to recur into\nparameters.\n\nSimilarly, we don't need to look in AppTy's, because nothing headed by\nan AppTy will be marshalable.\n\nNote [FFI type roles]\n~~~~~~~~~~~~~~~~~~~~~\nThe 'go' helper function within normaliseFfiType' always produces\nrepresentational coercions. But, in the \"children_only\" case, we need to\nuse these coercions in a TyConAppCo. Accordingly, the roles on the coercions\nmust be twiddled to match the expectation of the enclosing TyCon. However,\nwe cannot easily go from an R coercion to an N one, so we forbid N roles\non FFI type constructors. Currently, only two such type constructors exist:\nIO and FunPtr. Thus, this is not an onerous burden.\n\nIf we ever want to lift this restriction, we would need to make 'go' take\nthe target role as a parameter. This wouldn't be hard, but it's a complication\nnot yet necessary and so is not yet implemented.\n-}\n\n-- normaliseFfiType takes the type from an FFI declaration, and\n-- evaluates any type synonyms, type functions, and newtypes. However,\n-- we are only allowed to look through newtypes if the constructor is\n-- in scope.  We return a bag of all the newtype constructors thus found.\n-- Always returns a Representational coercion\nnormaliseFfiType :: Type -> TcM (Coercion, Type, Bag GlobalRdrElt)\nnormaliseFfiType ty\n    = do fam_envs <- tcGetFamInstEnvs\n         normaliseFfiType' fam_envs ty\n\nnormaliseFfiType' :: FamInstEnvs -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)\nnormaliseFfiType' env ty0 = go initRecTc ty0\n  where\n    go :: RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)\n    go rec_nts ty\n      | Just ty' <- tcView ty     -- Expand synonyms\n      = go rec_nts ty'\n\n      | Just (tc, tys) <- splitTyConApp_maybe ty\n      = go_tc_app rec_nts tc tys\n\n      | (bndrs, inner_ty) <- splitForAllVarBndrs ty\n      , not (null bndrs)\n      = do (coi, nty1, gres1) <- go rec_nts inner_ty\n           return ( mkHomoForAllCos (binderVars bndrs) coi\n                  , mkForAllTys bndrs nty1, gres1 )\n\n      | otherwise -- see Note [Don't recur in normaliseFfiType']\n      = return (mkRepReflCo ty, ty, emptyBag)\n\n    go_tc_app :: RecTcChecker -> TyCon -> [Type]\n              -> TcM (Coercion, Type, Bag GlobalRdrElt)\n    go_tc_app rec_nts tc tys\n        -- We don't want to look through the IO newtype, even if it is\n        -- in scope, so we have a special case for it:\n        | tc_key `elem` [ioTyConKey, funPtrTyConKey, funTyConKey]\n                  -- These *must not* have nominal roles on their parameters!\n                  -- See Note [FFI type roles]\n        = children_only\n\n        | isNewTyCon tc         -- Expand newtypes\n        , Just rec_nts' <- checkRecTc rec_nts tc\n                   -- See Note [Expanding newtypes] in TyCon.hs\n                   -- We can't just use isRecursiveTyCon; sometimes recursion is ok:\n                   --     newtype T = T (Ptr T)\n                   --   Here, we don't reject the type for being recursive.\n                   -- If this is a recursive newtype then it will normally\n                   -- be rejected later as not being a valid FFI type.\n        = do { rdr_env <- getGlobalRdrEnv\n             ; case checkNewtypeFFI rdr_env tc of\n                 Nothing  -> nothing\n                 Just gre -> do { (co', ty', gres) <- go rec_nts' nt_rhs\n                                ; return (mkTransCo nt_co co', ty', gre `consBag` gres) } }\n\n        | isFamilyTyCon tc              -- Expand open tycons\n        , (co, ty) <- normaliseTcApp env Representational tc tys\n        , not (isReflexiveCo co)\n        = do (co', ty', gres) <- go rec_nts ty\n             return (mkTransCo co co', ty', gres)\n\n        | otherwise\n        = nothing -- see Note [Don't recur in normaliseFfiType']\n        where\n          tc_key = getUnique tc\n          children_only\n            = do xs <- mapM (go rec_nts) tys\n                 let (cos, tys', gres) = unzip3 xs\n                        -- the (repeat Representational) is because 'go' always\n                        -- returns R coercions\n                     cos' = zipWith3 downgradeRole (tyConRoles tc)\n                                     (repeat Representational) cos\n                 return ( mkTyConAppCo Representational tc cos'\n                        , mkTyConApp tc tys', unionManyBags gres)\n          nt_co  = mkUnbranchedAxInstCo Representational (newTyConCo tc) tys []\n          nt_rhs = newTyConInstRhs tc tys\n\n          ty      = mkTyConApp tc tys\n          nothing = return (mkRepReflCo ty, ty, emptyBag)\n\ncheckNewtypeFFI :: GlobalRdrEnv -> TyCon -> Maybe GlobalRdrElt\ncheckNewtypeFFI rdr_env tc\n  | Just con <- tyConSingleDataCon_maybe tc\n  , Just gre <- lookupGRE_Name rdr_env (dataConName con)\n  = Just gre    -- See Note [Newtype constructor usage in foreign declarations]\n  | otherwise\n  = Nothing\n\n{-\nNote [Newtype constructor usage in foreign declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC automatically \"unwraps\" newtype constructors in foreign import/export\ndeclarations.  In effect that means that a newtype data constructor is\nused even though it is not mentioned expclitly in the source, so we don't\nwant to report it as \"defined but not used\" or \"imported but not used\".\neg     newtype D = MkD Int\n       foreign import foo :: D -> IO ()\nHere 'MkD' us used.  See Trac #7408.\n\nGHC also expands type functions during this process, so it's not enough\njust to look at the free variables of the declaration.\neg     type instance F Bool = D\n       foreign import bar :: F Bool -> IO ()\nHere again 'MkD' is used.\n\nSo we really have wait until the type checker to decide what is used.\nThat's why tcForeignImports and tecForeignExports return a (Bag GRE)\nfor the newtype constructors they see. Then TcRnDriver can add them\nto the module's usages.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Imports}\n*                                                                      *\n************************************************************************\n-}\n\ntcForeignImports :: [LForeignDecl GhcRn]\n                 -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)\ntcForeignImports decls\n  = getHooked tcForeignImportsHook tcForeignImports' >>= ($ decls)\n\ntcForeignImports' :: [LForeignDecl GhcRn]\n                  -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)\n-- For the (Bag GlobalRdrElt) result,\n-- see Note [Newtype constructor usage in foreign declarations]\ntcForeignImports' decls\n  = do { (ids, decls, gres) <- mapAndUnzip3M tcFImport $\n                               filter isForeignImport decls\n       ; return (ids, decls, unionManyBags gres) }\n\ntcFImport :: LForeignDecl GhcRn\n          -> TcM (Id, LForeignDecl GhcTc, Bag GlobalRdrElt)\ntcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty\n                                    , fd_fi = imp_decl }))\n  = setSrcSpan dloc $ addErrCtxt (foreignDeclCtxt fo)  $\n    do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty\n       ; (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty\n       ; let\n           -- Drop the foralls before inspecting the\n           -- structure of the foreign type.\n             (bndrs, res_ty)   = tcSplitPiTys norm_sig_ty\n             arg_tys           = mapMaybe binderRelevantType_maybe bndrs\n             id                = mkLocalId nm sig_ty\n                 -- Use a LocalId to obey the invariant that locally-defined\n                 -- things are LocalIds.  However, it does not need zonking,\n                 -- (so TcHsSyn.zonkForeignExports ignores it).\n\n       ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl\n          -- Can't use sig_ty here because sig_ty :: Type and\n          -- we need HsType Id hence the undefined\n       ; let fi_decl = ForeignImport { fd_name = L nloc id\n                                     , fd_sig_ty = undefined\n                                     , fd_i_ext = mkSymCo norm_co\n                                     , fd_fi = imp_decl' }\n       ; return (id, L dloc fi_decl, gres) }\ntcFImport d = pprPanic \"tcFImport\" (ppr d)\n\n-- ------------ Checking types for foreign import ----------------------\n\ntcCheckFIType :: [Type] -> Type -> ForeignImport -> TcM ForeignImport\n\ntcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src)\n  -- Foreign import label\n  = do checkCg checkCOrAsmOrLlvmOrInterp\n       -- NB check res_ty not sig_ty!\n       --    In case sig_ty is (forall a. ForeignPtr a)\n       check (isFFILabelTy (mkVisFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty)\n       cconv' <- checkCConv cconv\n       return (CImport (L lc cconv') safety mh l src)\n\ntcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do\n        -- Foreign wrapper (former f.e.d.)\n        -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid\n        -- foreign type.  For legacy reasons ft -> IO (Ptr ft) is accepted, too.\n        -- The use of the latter form is DEPRECATED, though.\n    checkCg checkCOrAsmOrLlvmOrInterp\n    cconv' <- checkCConv cconv\n    case arg_tys of\n        [arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys\n                        checkForeignRes nonIOok  checkSafe isFFIExportResultTy res1_ty\n                        checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty\n                  where\n                     (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty\n        _ -> addErrTc (illegalForeignTyErr Outputable.empty (text \"One argument expected\"))\n    return (CImport (L lc cconv') safety mh CWrapper src)\n\ntcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh\n                                            (CFunction target) src)\n  | isDynamicTarget target = do -- Foreign import dynamic\n      checkCg checkCOrAsmOrLlvmOrInterp\n      cconv' <- checkCConv cconv\n      case arg_tys of           -- The first arg must be Ptr or FunPtr\n        []                ->\n          addErrTc (illegalForeignTyErr Outputable.empty (text \"At least one argument expected\"))\n        (arg1_ty:arg_tys) -> do\n          dflags <- getDynFlags\n          let curried_res_ty = mkVisFunTys arg_tys res_ty\n          check (isFFIDynTy curried_res_ty arg1_ty)\n                (illegalForeignTyErr argument)\n          checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys\n          checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty\n      return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src\n  | cconv == PrimCallConv = do\n      dflags <- getDynFlags\n      checkTc (xopt LangExt.GHCForeignImportPrim dflags)\n              (text \"Use GHCForeignImportPrim to allow `foreign import prim'.\")\n      checkCg checkCOrAsmOrLlvmOrInterp\n      checkCTarget target\n      checkTc (playSafe safety)\n              (text \"The safe/unsafe annotation should not be used with `foreign import prim'.\")\n      checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys\n      -- prim import result is more liberal, allows (#,,#)\n      checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty\n      return idecl\n  | otherwise = do              -- Normal foreign import\n      checkCg checkCOrAsmOrLlvmOrInterp\n      cconv' <- checkCConv cconv\n      checkCTarget target\n      dflags <- getDynFlags\n      checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys\n      checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty\n      checkMissingAmpersand dflags arg_tys res_ty\n      case target of\n          StaticTarget _ _ _ False\n           | not (null arg_tys) ->\n              addErrTc (text \"`value' imports cannot have function types\")\n          _ -> return ()\n      return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src\n\n\n-- This makes a convenient place to check\n-- that the C identifier is valid for C\ncheckCTarget :: CCallTarget -> TcM ()\ncheckCTarget (StaticTarget _ str _ _) = do\n    checkCg checkCOrAsmOrLlvmOrInterp\n    checkTc (isCLabelString str) (badCName str)\n\ncheckCTarget DynamicTarget = panic \"checkCTarget DynamicTarget\"\n\n\ncheckMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM ()\ncheckMissingAmpersand dflags arg_tys res_ty\n  | null arg_tys && isFunPtrTy res_ty &&\n    wopt Opt_WarnDodgyForeignImports dflags\n  = addWarn (Reason Opt_WarnDodgyForeignImports)\n        (text \"possible missing & in foreign import of FunPtr\")\n  | otherwise\n  = return ()\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Exports}\n*                                                                      *\n************************************************************************\n-}\n\ntcForeignExports :: [LForeignDecl GhcRn]\n             -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt)\ntcForeignExports decls =\n  getHooked tcForeignExportsHook tcForeignExports' >>= ($ decls)\n\ntcForeignExports' :: [LForeignDecl GhcRn]\n             -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt)\n-- For the (Bag GlobalRdrElt) result,\n-- see Note [Newtype constructor usage in foreign declarations]\ntcForeignExports' decls\n  = foldlM combine (emptyLHsBinds, [], emptyBag) (filter isForeignExport decls)\n  where\n   combine (binds, fs, gres1) (L loc fe) = do\n       (b, f, gres2) <- setSrcSpan loc (tcFExport fe)\n       return (b `consBag` binds, L loc f : fs, gres1 `unionBags` gres2)\n\ntcFExport :: ForeignDecl GhcRn\n          -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt)\ntcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spec })\n  = addErrCtxt (foreignDeclCtxt fo) $ do\n\n    sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty\n    rhs <- tcPolyExpr (nlHsVar nm) sig_ty\n\n    (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty\n\n    spec' <- tcCheckFEType norm_sig_ty spec\n\n           -- we're exporting a function, but at a type possibly more\n           -- constrained than its declared/inferred type. Hence the need\n           -- to create a local binding which will call the exported function\n           -- at a particular type (and, maybe, overloading).\n\n\n    -- We need to give a name to the new top-level binding that\n    -- is *stable* (i.e. the compiler won't change it later),\n    -- because this name will be referred to by the C code stub.\n    id  <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc\n    return ( mkVarBind id rhs\n           , ForeignExport { fd_name = L loc id\n                           , fd_sig_ty = undefined\n                           , fd_e_ext = norm_co, fd_fe = spec' }\n           , gres)\ntcFExport d = pprPanic \"tcFExport\" (ppr d)\n\n-- ------------ Checking argument types for foreign export ----------------------\n\ntcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport\ntcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do\n    checkCg checkCOrAsmOrLlvm\n    checkTc (isCLabelString str) (badCName str)\n    cconv' <- checkCConv cconv\n    checkForeignArgs isFFIExternalTy arg_tys\n    checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty\n    return (CExport (L l (CExportStatic esrc str cconv')) src)\n  where\n      -- Drop the foralls before inspecting n\n      -- the structure of the foreign type.\n    (bndrs, res_ty) = tcSplitPiTys sig_ty\n    arg_tys         = mapMaybe binderRelevantType_maybe bndrs\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Miscellaneous}\n*                                                                      *\n************************************************************************\n-}\n\n------------ Checking argument types for foreign import ----------------------\ncheckForeignArgs :: (Type -> Validity) -> [Type] -> TcM ()\ncheckForeignArgs pred tys = mapM_ go tys\n  where\n    go ty = check (pred ty) (illegalForeignTyErr argument)\n\n------------ Checking result types for foreign calls ----------------------\n-- | Check that the type has the form\n--    (IO t) or (t) , and that t satisfies the given predicate.\n-- When calling this function, any newtype wrappers (should) have been\n-- already dealt with by normaliseFfiType.\n--\n-- We also check that the Safe Haskell condition of FFI imports having\n-- results in the IO monad holds.\n--\ncheckForeignRes :: Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()\ncheckForeignRes non_io_result_ok check_safe pred_res_ty ty\n  | Just (_, res_ty) <- tcSplitIOType_maybe ty\n  =     -- Got an IO result type, that's always fine!\n     check (pred_res_ty res_ty) (illegalForeignTyErr result)\n\n  -- Case for non-IO result type with FFI Import\n  | not non_io_result_ok\n  = addErrTc $ illegalForeignTyErr result (text \"IO result type expected\")\n\n  | otherwise\n  = do { dflags <- getDynFlags\n       ; case pred_res_ty ty of\n                -- Handle normal typecheck fail, we want to handle this first and\n                -- only report safe haskell errors if the normal type check is OK.\n           NotValid msg -> addErrTc $ illegalForeignTyErr result msg\n\n           -- handle safe infer fail\n           _ | check_safe && safeInferOn dflags\n               -> recordUnsafeInfer emptyBag\n\n           -- handle safe language typecheck fail\n           _ | check_safe && safeLanguageOn dflags\n               -> addErrTc (illegalForeignTyErr result safeHsErr)\n\n           -- success! non-IO return is fine\n           _ -> return () }\n  where\n    safeHsErr =\n      text \"Safe Haskell is on, all FFI imports must be in the IO monad\"\n\nnonIOok, mustBeIO :: Bool\nnonIOok  = True\nmustBeIO = False\n\ncheckSafe, noCheckSafe :: Bool\ncheckSafe   = True\nnoCheckSafe = False\n\n-- Checking a supported backend is in use\n\ncheckCOrAsmOrLlvm :: HscTarget -> Validity\ncheckCOrAsmOrLlvm HscC    = IsValid\ncheckCOrAsmOrLlvm HscAsm  = IsValid\ncheckCOrAsmOrLlvm HscLlvm = IsValid\ncheckCOrAsmOrLlvm _\n  = NotValid (text \"requires unregisterised, llvm (-fllvm) or native code generation (-fasm)\")\n\ncheckCOrAsmOrLlvmOrInterp :: HscTarget -> Validity\ncheckCOrAsmOrLlvmOrInterp HscC           = IsValid\ncheckCOrAsmOrLlvmOrInterp HscAsm         = IsValid\ncheckCOrAsmOrLlvmOrInterp HscLlvm        = IsValid\ncheckCOrAsmOrLlvmOrInterp HscInterpreted = IsValid\ncheckCOrAsmOrLlvmOrInterp _\n  = NotValid (text \"requires interpreted, unregisterised, llvm or native code generation\")\n\ncheckCg :: (HscTarget -> Validity) -> TcM ()\ncheckCg check = do\n    dflags <- getDynFlags\n    let target = hscTarget dflags\n    case target of\n      HscNothing -> return ()\n      _ ->\n        case check target of\n          IsValid      -> return ()\n          NotValid err -> addErrTc (text \"Illegal foreign declaration:\" <+> err)\n\n-- Calling conventions\n\ncheckCConv :: CCallConv -> TcM CCallConv\ncheckCConv CCallConv    = return CCallConv\ncheckCConv CApiConv     = return CApiConv\ncheckCConv StdCallConv  = do dflags <- getDynFlags\n                             let platform = targetPlatform dflags\n                             if platformArch platform == ArchX86\n                                 then return StdCallConv\n                                 else do -- This is a warning, not an error. see #3336\n                                         when (wopt Opt_WarnUnsupportedCallingConventions dflags) $\n                                             addWarnTc (Reason Opt_WarnUnsupportedCallingConventions)\n                                                 (text \"the 'stdcall' calling convention is unsupported on this platform,\" $$ text \"treating as ccall\")\n                                         return CCallConv\ncheckCConv PrimCallConv = do addErrTc (text \"The `prim' calling convention can only be used with `foreign import'\")\n                             return PrimCallConv\ncheckCConv JavaScriptCallConv = do dflags <- getDynFlags\n                                   if platformArch (targetPlatform dflags) == ArchJavaScript\n                                       then return JavaScriptCallConv\n                                       else do addErrTc (text \"The `javascript' calling convention is unsupported on this platform\")\n                                               return JavaScriptCallConv\n\n-- Warnings\n\ncheck :: Validity -> (MsgDoc -> MsgDoc) -> TcM ()\ncheck IsValid _             = return ()\ncheck (NotValid doc) err_fn = addErrTc (err_fn doc)\n\nillegalForeignTyErr :: SDoc -> SDoc -> SDoc\nillegalForeignTyErr arg_or_res extra\n  = hang msg 2 extra\n  where\n    msg = hsep [ text \"Unacceptable\", arg_or_res\n               , text \"type in foreign declaration:\"]\n\n-- Used for 'arg_or_res' argument to illegalForeignTyErr\nargument, result :: SDoc\nargument = text \"argument\"\nresult   = text \"result\"\n\nbadCName :: CLabelString -> MsgDoc\nbadCName target\n  = sep [quotes (ppr target) <+> text \"is not a valid C identifier\"]\n\nforeignDeclCtxt :: ForeignDecl GhcRn -> SDoc\nforeignDeclCtxt fo\n  = hang (text \"When checking declaration:\")\n       2 (ppr fo)\n", "num_lines": 570}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n    %\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nTcGenDeriv: Generating derived instance declarations\n\nThis module is nominally ``subordinate'' to @TcDeriv@, which is the\n``official'' interface to deriving-related things.\n\nThis is where we do all the grimy bindings' generation.\n-}\n\n{-# LANGUAGE CPP, ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcGenDeriv (\n        BagDerivStuff, DerivStuff(..),\n\n        gen_Eq_binds,\n        gen_Ord_binds,\n        gen_Enum_binds,\n        gen_Bounded_binds,\n        gen_Ix_binds,\n        gen_Show_binds,\n        gen_Read_binds,\n        gen_Data_binds,\n        gen_Lift_binds,\n        gen_Newtype_binds,\n        mkCoerceClassMethEqn,\n        genAuxBinds,\n        ordOpTbl, boxConTbl, litConTbl,\n        mkRdrFunBind, mkRdrFunBindEC, mkRdrFunBindSE, error_Expr\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnMonad\nimport HsSyn\nimport RdrName\nimport BasicTypes\nimport DataCon\nimport Name\nimport Fingerprint\nimport Encoding\n\nimport DynFlags\nimport PrelInfo\nimport FamInst\nimport FamInstEnv\nimport PrelNames\nimport THNames\nimport Module ( moduleName, moduleNameString\n              , moduleUnitId, unitIdString )\nimport MkId ( coerceId )\nimport PrimOp\nimport SrcLoc\nimport TyCon\nimport TcEnv\nimport TcType\nimport TcValidity ( checkValidCoAxBranch )\nimport CoAxiom    ( coAxiomSingleBranch )\nimport TysPrim\nimport TysWiredIn\nimport Type\nimport Class\nimport VarSet\nimport VarEnv\nimport Util\nimport Var\nimport Outputable\nimport Lexeme\nimport FastString\nimport Pair\nimport Bag\n\nimport Data.List  ( find, partition, intersperse )\n\ntype BagDerivStuff = Bag DerivStuff\n\ndata AuxBindSpec\n  = DerivCon2Tag TyCon  -- The con2Tag for given TyCon\n  | DerivTag2Con TyCon  -- ...ditto tag2Con\n  | DerivMaxTag  TyCon  -- ...and maxTag\n  deriving( Eq )\n  -- All these generate ZERO-BASED tag operations\n  -- I.e first constructor has tag 0\n\ndata DerivStuff     -- Please add this auxiliary stuff\n  = DerivAuxBind AuxBindSpec\n\n  -- Generics and DeriveAnyClass\n  | DerivFamInst FamInst               -- New type family instances\n\n  -- New top-level auxiliary bindings\n  | DerivHsBind (LHsBind GhcPs, LSig GhcPs) -- Also used for SYB\n\n\n{-\n************************************************************************\n*                                                                      *\n                Eq instances\n*                                                                      *\n************************************************************************\n\nHere are the heuristics for the code we generate for @Eq@. Let's\nassume we have a data type with some (possibly zero) nullary data\nconstructors and some ordinary, non-nullary ones (the rest, also\npossibly zero of them).  Here's an example, with both \\tr{N}ullary and\n\\tr{O}rdinary data cons.\n\n  data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...\n\n* For the ordinary constructors (if any), we emit clauses to do The\n  Usual Thing, e.g.,:\n\n    (==) (O1 a1 b1)    (O1 a2 b2)    = a1 == a2 && b1 == b2\n    (==) (O2 a1)       (O2 a2)       = a1 == a2\n    (==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2\n\n  Note: if we're comparing unlifted things, e.g., if 'a1' and\n  'a2' are Float#s, then we have to generate\n       case (a1 `eqFloat#` a2) of r -> r\n  for that particular test.\n\n* If there are a lot of (more than ten) nullary constructors, we emit a\n  catch-all clause of the form:\n\n      (==) a b  = case (con2tag_Foo a) of { a# ->\n                  case (con2tag_Foo b) of { b# ->\n                  case (a# ==# b#)     of {\n                    r -> r }}}\n\n  If con2tag gets inlined this leads to join point stuff, so\n  it's better to use regular pattern matching if there aren't too\n  many nullary constructors.  \"Ten\" is arbitrary, of course\n\n* If there aren't any nullary constructors, we emit a simpler\n  catch-all:\n\n     (==) a b  = False\n\n* For the @(/=)@ method, we normally just use the default method.\n  If the type is an enumeration type, we could/may/should? generate\n  special code that calls @con2tag_Foo@, much like for @(==)@ shown\n  above.\n\nWe thought about doing this: If we're also deriving 'Ord' for this\ntycon, we generate:\n  instance ... Eq (Foo ...) where\n    (==) a b  = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}\n    (/=) a b  = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }\nHowever, that requires that (Ord <whatever>) was put in the context\nfor the instance decl, which it probably wasn't, so the decls\nproduced don't get through the typechecker.\n-}\n\ngen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)\ngen_Eq_binds loc tycon = do\n    dflags <- getDynFlags\n    return (method_binds dflags, aux_binds)\n  where\n    all_cons = tyConDataCons tycon\n    (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons\n\n    -- If there are ten or more (arbitrary number) nullary constructors,\n    -- use the con2tag stuff.  For small types it's better to use\n    -- ordinary pattern matching.\n    (tag_match_cons, pat_match_cons)\n       | nullary_cons `lengthExceeds` 10 = (nullary_cons, non_nullary_cons)\n       | otherwise                       = ([],           all_cons)\n\n    no_tag_match_cons = null tag_match_cons\n\n    fall_through_eqn dflags\n      | no_tag_match_cons   -- All constructors have arguments\n      = case pat_match_cons of\n          []  -> []   -- No constructors; no fall-though case\n          [_] -> []   -- One constructor; no fall-though case\n          _   ->      -- Two or more constructors; add fall-through of\n                      --       (==) _ _ = False\n                 [([nlWildPat, nlWildPat], false_Expr)]\n\n      | otherwise -- One or more tag_match cons; add fall-through of\n                  -- extract tags compare for equality\n      = [([a_Pat, b_Pat],\n         untag_Expr dflags tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]\n                    (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]\n\n    aux_binds | no_tag_match_cons = emptyBag\n              | otherwise         = unitBag $ DerivAuxBind $ DerivCon2Tag tycon\n\n    method_binds dflags = unitBag (eq_bind dflags)\n    eq_bind dflags = mkFunBindEC 2 loc eq_RDR (const true_Expr)\n                                 (map pats_etc pat_match_cons\n                                   ++ fall_through_eqn dflags)\n\n    ------------------------------------------------------------------\n    pats_etc data_con\n      = let\n            con1_pat = nlParPat $ nlConVarPat data_con_RDR as_needed\n            con2_pat = nlParPat $ nlConVarPat data_con_RDR bs_needed\n\n            data_con_RDR = getRdrName data_con\n            con_arity   = length tys_needed\n            as_needed   = take con_arity as_RDRs\n            bs_needed   = take con_arity bs_RDRs\n            tys_needed  = dataConOrigArgTys data_con\n        in\n        ([con1_pat, con2_pat], nested_eq_expr tys_needed as_needed bs_needed)\n      where\n        nested_eq_expr []  [] [] = true_Expr\n        nested_eq_expr tys as bs\n          = foldr1 and_Expr (zipWith3Equal \"nested_eq\" nested_eq tys as bs)\n          -- Using 'foldr1' here ensures that the derived code is correctly\n          -- associated. See Trac #10859.\n          where\n            nested_eq ty a b = nlHsPar (eq_Expr ty (nlHsVar a) (nlHsVar b))\n\n{-\n************************************************************************\n*                                                                      *\n        Ord instances\n*                                                                      *\n************************************************************************\n\nNote [Generating Ord instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose constructors are K1..Kn, and some are nullary.\nThe general form we generate is:\n\n* Do case on first argument\n        case a of\n          K1 ... -> rhs_1\n          K2 ... -> rhs_2\n          ...\n          Kn ... -> rhs_n\n          _ -> nullary_rhs\n\n* To make rhs_i\n     If i = 1, 2, n-1, n, generate a single case.\n        rhs_2    case b of\n                   K1 {}  -> LT\n                   K2 ... -> ...eq_rhs(K2)...\n                   _      -> GT\n\n     Otherwise do a tag compare against the bigger range\n     (because this is the one most likely to succeed)\n        rhs_3    case tag b of tb ->\n                 if 3 <# tg then GT\n                 else case b of\n                         K3 ... -> ...eq_rhs(K3)....\n                         _      -> LT\n\n* To make eq_rhs(K), which knows that\n    a = K a1 .. av\n    b = K b1 .. bv\n  we just want to compare (a1,b1) then (a2,b2) etc.\n  Take care on the last field to tail-call into comparing av,bv\n\n* To make nullary_rhs generate this\n     case con2tag a of a# ->\n     case con2tag b of ->\n     a# `compare` b#\n\nSeveral special cases:\n\n* Two or fewer nullary constructors: don't generate nullary_rhs\n\n* Be careful about unlifted comparisons.  When comparing unboxed\n  values we can't call the overloaded functions.\n  See function unliftedOrdOp\n\nNote [Game plan for deriving Ord]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's a bad idea to define only 'compare', and build the other binary\ncomparisons on top of it; see Trac #2130, #4019.  Reason: we don't\nwant to laboriously make a three-way comparison, only to extract a\nbinary result, something like this:\n     (>) (I# x) (I# y) = case <# x y of\n                            True -> False\n                            False -> case ==# x y of\n                                       True  -> False\n                                       False -> True\n\nThis being said, we can get away with generating full code only for\n'compare' and '<' thus saving us generation of other three operators.\nOther operators can be cheaply expressed through '<':\na <= b = not $ b < a\na > b = b < a\na >= b = not $ a < b\n\nSo for sufficiently small types (few constructors, or all nullary)\nwe generate all methods; for large ones we just use 'compare'.\n\n-}\n\ndata OrdOp = OrdCompare | OrdLT | OrdLE | OrdGE | OrdGT\n\n------------\nordMethRdr :: OrdOp -> RdrName\nordMethRdr op\n  = case op of\n       OrdCompare -> compare_RDR\n       OrdLT      -> lt_RDR\n       OrdLE      -> le_RDR\n       OrdGE      -> ge_RDR\n       OrdGT      -> gt_RDR\n\n------------\nltResult :: OrdOp -> LHsExpr GhcPs\n-- Knowing a<b, what is the result for a `op` b?\nltResult OrdCompare = ltTag_Expr\nltResult OrdLT      = true_Expr\nltResult OrdLE      = true_Expr\nltResult OrdGE      = false_Expr\nltResult OrdGT      = false_Expr\n\n------------\neqResult :: OrdOp -> LHsExpr GhcPs\n-- Knowing a=b, what is the result for a `op` b?\neqResult OrdCompare = eqTag_Expr\neqResult OrdLT      = false_Expr\neqResult OrdLE      = true_Expr\neqResult OrdGE      = true_Expr\neqResult OrdGT      = false_Expr\n\n------------\ngtResult :: OrdOp -> LHsExpr GhcPs\n-- Knowing a>b, what is the result for a `op` b?\ngtResult OrdCompare = gtTag_Expr\ngtResult OrdLT      = false_Expr\ngtResult OrdLE      = false_Expr\ngtResult OrdGE      = true_Expr\ngtResult OrdGT      = true_Expr\n\n------------\ngen_Ord_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)\ngen_Ord_binds loc tycon = do\n    dflags <- getDynFlags\n    return $ if null tycon_data_cons -- No data-cons => invoke bale-out case\n      then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) []\n           , emptyBag)\n      else ( unitBag (mkOrdOp dflags OrdCompare) `unionBags` other_ops dflags\n           , aux_binds)\n  where\n    aux_binds | single_con_type = emptyBag\n              | otherwise       = unitBag $ DerivAuxBind $ DerivCon2Tag tycon\n\n        -- Note [Game plan for deriving Ord]\n    other_ops dflags\n      | (last_tag - first_tag) <= 2     -- 1-3 constructors\n        || null non_nullary_cons        -- Or it's an enumeration\n      = listToBag [mkOrdOp dflags OrdLT, lE, gT, gE]\n      | otherwise\n      = emptyBag\n\n    negate_expr = nlHsApp (nlHsVar not_RDR)\n    lE = mk_easy_FunBind loc le_RDR [a_Pat, b_Pat] $\n        negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr)\n    gT = mk_easy_FunBind loc gt_RDR [a_Pat, b_Pat] $\n        nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr\n    gE = mk_easy_FunBind loc ge_RDR [a_Pat, b_Pat] $\n        negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) a_Expr) b_Expr)\n\n    get_tag con = dataConTag con - fIRST_TAG\n        -- We want *zero-based* tags, because that's what\n        -- con2Tag returns (generated by untag_Expr)!\n\n    tycon_data_cons = tyConDataCons tycon\n    single_con_type = isSingleton tycon_data_cons\n    (first_con : _) = tycon_data_cons\n    (last_con : _)  = reverse tycon_data_cons\n    first_tag       = get_tag first_con\n    last_tag        = get_tag last_con\n\n    (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon tycon_data_cons\n\n\n    mkOrdOp :: DynFlags -> OrdOp -> LHsBind GhcPs\n    -- Returns a binding   op a b = ... compares a and b according to op ....\n    mkOrdOp dflags op = mk_easy_FunBind loc (ordMethRdr op) [a_Pat, b_Pat]\n                                        (mkOrdOpRhs dflags op)\n\n    mkOrdOpRhs :: DynFlags -> OrdOp -> LHsExpr GhcPs\n    mkOrdOpRhs dflags op       -- RHS for comparing 'a' and 'b' according to op\n      | nullary_cons `lengthAtMost` 2 -- Two nullary or fewer, so use cases\n      = nlHsCase (nlHsVar a_RDR) $\n        map (mkOrdOpAlt dflags op) tycon_data_cons\n        -- i.e.  case a of { C1 x y -> case b of C1 x y -> ....compare x,y...\n        --                   C2 x   -> case b of C2 x -> ....comopare x.... }\n\n      | null non_nullary_cons    -- All nullary, so go straight to comparing tags\n      = mkTagCmp dflags op\n\n      | otherwise                -- Mixed nullary and non-nullary\n      = nlHsCase (nlHsVar a_RDR) $\n        (map (mkOrdOpAlt dflags op) non_nullary_cons\n         ++ [mkHsCaseAlt nlWildPat (mkTagCmp dflags op)])\n\n\n    mkOrdOpAlt :: DynFlags -> OrdOp -> DataCon\n                  -> LMatch GhcPs (LHsExpr GhcPs)\n    -- Make the alternative  (Ki a1 a2 .. av ->\n    mkOrdOpAlt dflags op data_con\n      = mkHsCaseAlt (nlConVarPat data_con_RDR as_needed)\n                    (mkInnerRhs dflags op data_con)\n      where\n        as_needed    = take (dataConSourceArity data_con) as_RDRs\n        data_con_RDR = getRdrName data_con\n\n    mkInnerRhs dflags op data_con\n      | single_con_type\n      = nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con ]\n\n      | tag == first_tag\n      = nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con\n                                 , mkHsCaseAlt nlWildPat (ltResult op) ]\n      | tag == last_tag\n      = nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con\n                                 , mkHsCaseAlt nlWildPat (gtResult op) ]\n\n      | tag == first_tag + 1\n      = nlHsCase (nlHsVar b_RDR) [ mkHsCaseAlt (nlConWildPat first_con)\n                                             (gtResult op)\n                                 , mkInnerEqAlt op data_con\n                                 , mkHsCaseAlt nlWildPat (ltResult op) ]\n      | tag == last_tag - 1\n      = nlHsCase (nlHsVar b_RDR) [ mkHsCaseAlt (nlConWildPat last_con)\n                                             (ltResult op)\n                                 , mkInnerEqAlt op data_con\n                                 , mkHsCaseAlt nlWildPat (gtResult op) ]\n\n      | tag > last_tag `div` 2  -- lower range is larger\n      = untag_Expr dflags tycon [(b_RDR, bh_RDR)] $\n        nlHsIf (genPrimOpApp (nlHsVar bh_RDR) ltInt_RDR tag_lit)\n               (gtResult op) $  -- Definitely GT\n        nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con\n                                 , mkHsCaseAlt nlWildPat (ltResult op) ]\n\n      | otherwise               -- upper range is larger\n      = untag_Expr dflags tycon [(b_RDR, bh_RDR)] $\n        nlHsIf (genPrimOpApp (nlHsVar bh_RDR) gtInt_RDR tag_lit)\n               (ltResult op) $  -- Definitely LT\n        nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con\n                                 , mkHsCaseAlt nlWildPat (gtResult op) ]\n      where\n        tag     = get_tag data_con\n        tag_lit = noLoc (HsLit noExt (HsIntPrim NoSourceText (toInteger tag)))\n\n    mkInnerEqAlt :: OrdOp -> DataCon -> LMatch GhcPs (LHsExpr GhcPs)\n    -- First argument 'a' known to be built with K\n    -- Returns a case alternative  Ki b1 b2 ... bv -> compare (a1,a2,...) with (b1,b2,...)\n    mkInnerEqAlt op data_con\n      = mkHsCaseAlt (nlConVarPat data_con_RDR bs_needed) $\n        mkCompareFields op (dataConOrigArgTys data_con)\n      where\n        data_con_RDR = getRdrName data_con\n        bs_needed    = take (dataConSourceArity data_con) bs_RDRs\n\n    mkTagCmp :: DynFlags -> OrdOp -> LHsExpr GhcPs\n    -- Both constructors known to be nullary\n    -- generates (case data2Tag a of a# -> case data2Tag b of b# -> a# `op` b#\n    mkTagCmp dflags op =\n      untag_Expr dflags tycon[(a_RDR, ah_RDR),(b_RDR, bh_RDR)] $\n        unliftedOrdOp intPrimTy op ah_RDR bh_RDR\n\nmkCompareFields :: OrdOp -> [Type] -> LHsExpr GhcPs\n-- Generates nested comparisons for (a1,a2...) against (b1,b2,...)\n-- where the ai,bi have the given types\nmkCompareFields op tys\n  = go tys as_RDRs bs_RDRs\n  where\n    go []   _      _          = eqResult op\n    go [ty] (a:_)  (b:_)\n      | isUnliftedType ty     = unliftedOrdOp ty op a b\n      | otherwise             = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b)\n    go (ty:tys) (a:as) (b:bs) = mk_compare ty a b\n                                  (ltResult op)\n                                  (go tys as bs)\n                                  (gtResult op)\n    go _ _ _ = panic \"mkCompareFields\"\n\n    -- (mk_compare ty a b) generates\n    --    (case (compare a b) of { LT -> <lt>; EQ -> <eq>; GT -> <bt> })\n    -- but with suitable special cases for\n    mk_compare ty a b lt eq gt\n      | isUnliftedType ty\n      = unliftedCompare lt_op eq_op a_expr b_expr lt eq gt\n      | otherwise\n      = nlHsCase (nlHsPar (nlHsApp (nlHsApp (nlHsVar compare_RDR) a_expr) b_expr))\n          [mkHsCaseAlt (nlNullaryConPat ltTag_RDR) lt,\n           mkHsCaseAlt (nlNullaryConPat eqTag_RDR) eq,\n           mkHsCaseAlt (nlNullaryConPat gtTag_RDR) gt]\n      where\n        a_expr = nlHsVar a\n        b_expr = nlHsVar b\n        (lt_op, _, eq_op, _, _) = primOrdOps \"Ord\" ty\n\nunliftedOrdOp :: Type -> OrdOp -> RdrName -> RdrName -> LHsExpr GhcPs\nunliftedOrdOp ty op a b\n  = case op of\n       OrdCompare -> unliftedCompare lt_op eq_op a_expr b_expr\n                                     ltTag_Expr eqTag_Expr gtTag_Expr\n       OrdLT      -> wrap lt_op\n       OrdLE      -> wrap le_op\n       OrdGE      -> wrap ge_op\n       OrdGT      -> wrap gt_op\n  where\n   (lt_op, le_op, eq_op, ge_op, gt_op) = primOrdOps \"Ord\" ty\n   wrap prim_op = genPrimOpApp a_expr prim_op b_expr\n   a_expr = nlHsVar a\n   b_expr = nlHsVar b\n\nunliftedCompare :: RdrName -> RdrName\n                -> LHsExpr GhcPs -> LHsExpr GhcPs   -- What to cmpare\n                -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs\n                                                    -- Three results\n                -> LHsExpr GhcPs\n-- Return (if a < b then lt else if a == b then eq else gt)\nunliftedCompare lt_op eq_op a_expr b_expr lt eq gt\n  = nlHsIf (ascribeBool $ genPrimOpApp a_expr lt_op b_expr) lt $\n                        -- Test (<) first, not (==), because the latter\n                        -- is true less often, so putting it first would\n                        -- mean more tests (dynamically)\n        nlHsIf (ascribeBool $ genPrimOpApp a_expr eq_op b_expr) eq gt\n  where\n    ascribeBool e = nlExprWithTySig e boolTy\n\nnlConWildPat :: DataCon -> LPat GhcPs\n-- The pattern (K {})\nnlConWildPat con = noLoc (ConPatIn (noLoc (getRdrName con))\n                                   (RecCon (HsRecFields { rec_flds = []\n                                                        , rec_dotdot = Nothing })))\n\n{-\n************************************************************************\n*                                                                      *\n        Enum instances\n*                                                                      *\n************************************************************************\n\n@Enum@ can only be derived for enumeration types.  For a type\n\\begin{verbatim}\ndata Foo ... = N1 | N2 | ... | Nn\n\\end{verbatim}\n\nwe use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a\n@maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@).\n\n\\begin{verbatim}\ninstance ... Enum (Foo ...) where\n    succ x   = toEnum (1 + fromEnum x)\n    pred x   = toEnum (fromEnum x - 1)\n\n    toEnum i = tag2con_Foo i\n\n    enumFrom a = map tag2con_Foo [con2tag_Foo a .. maxtag_Foo]\n\n    -- or, really...\n    enumFrom a\n      = case con2tag_Foo a of\n          a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo)\n\n   enumFromThen a b\n     = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo]\n\n    -- or, really...\n    enumFromThen a b\n      = case con2tag_Foo a of { a# ->\n        case con2tag_Foo b of { b# ->\n        map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo)\n        }}\n\\end{verbatim}\n\nFor @enumFromTo@ and @enumFromThenTo@, we use the default methods.\n-}\n\ngen_Enum_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)\ngen_Enum_binds loc tycon = do\n    dflags <- getDynFlags\n    return (method_binds dflags, aux_binds)\n  where\n    method_binds dflags = listToBag\n      [ succ_enum      dflags\n      , pred_enum      dflags\n      , to_enum        dflags\n      , enum_from      dflags\n      , enum_from_then dflags\n      , from_enum      dflags\n      ]\n    aux_binds = listToBag $ map DerivAuxBind\n                  [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon]\n\n    occ_nm = getOccString tycon\n\n    succ_enum dflags\n      = mk_easy_FunBind loc succ_RDR [a_Pat] $\n        untag_Expr dflags tycon [(a_RDR, ah_RDR)] $\n        nlHsIf (nlHsApps eq_RDR [nlHsVar (maxtag_RDR dflags tycon),\n                               nlHsVarApps intDataCon_RDR [ah_RDR]])\n             (illegal_Expr \"succ\" occ_nm \"tried to take `succ' of last tag in enumeration\")\n             (nlHsApp (nlHsVar (tag2con_RDR dflags tycon))\n                    (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],\n                                        nlHsIntLit 1]))\n\n    pred_enum dflags\n      = mk_easy_FunBind loc pred_RDR [a_Pat] $\n        untag_Expr dflags tycon [(a_RDR, ah_RDR)] $\n        nlHsIf (nlHsApps eq_RDR [nlHsIntLit 0,\n                               nlHsVarApps intDataCon_RDR [ah_RDR]])\n             (illegal_Expr \"pred\" occ_nm \"tried to take `pred' of first tag in enumeration\")\n             (nlHsApp (nlHsVar (tag2con_RDR dflags tycon))\n                      (nlHsApps plus_RDR\n                            [ nlHsVarApps intDataCon_RDR [ah_RDR]\n                            , nlHsLit (HsInt noExt\n                                                (mkIntegralLit (-1 :: Int)))]))\n\n    to_enum dflags\n      = mk_easy_FunBind loc toEnum_RDR [a_Pat] $\n        nlHsIf (nlHsApps and_RDR\n                [nlHsApps ge_RDR [nlHsVar a_RDR, nlHsIntLit 0],\n                 nlHsApps le_RDR [ nlHsVar a_RDR\n                                 , nlHsVar (maxtag_RDR dflags tycon)]])\n             (nlHsVarApps (tag2con_RDR dflags tycon) [a_RDR])\n             (illegal_toEnum_tag occ_nm (maxtag_RDR dflags tycon))\n\n    enum_from dflags\n      = mk_easy_FunBind loc enumFrom_RDR [a_Pat] $\n          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $\n          nlHsApps map_RDR\n                [nlHsVar (tag2con_RDR dflags tycon),\n                 nlHsPar (enum_from_to_Expr\n                            (nlHsVarApps intDataCon_RDR [ah_RDR])\n                            (nlHsVar (maxtag_RDR dflags tycon)))]\n\n    enum_from_then dflags\n      = mk_easy_FunBind loc enumFromThen_RDR [a_Pat, b_Pat] $\n          untag_Expr dflags tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $\n          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR dflags tycon]) $\n            nlHsPar (enum_from_then_to_Expr\n                    (nlHsVarApps intDataCon_RDR [ah_RDR])\n                    (nlHsVarApps intDataCon_RDR [bh_RDR])\n                    (nlHsIf  (nlHsApps gt_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],\n                                               nlHsVarApps intDataCon_RDR [bh_RDR]])\n                           (nlHsIntLit 0)\n                           (nlHsVar (maxtag_RDR dflags tycon))\n                           ))\n\n    from_enum dflags\n      = mk_easy_FunBind loc fromEnum_RDR [a_Pat] $\n          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $\n          (nlHsVarApps intDataCon_RDR [ah_RDR])\n\n{-\n************************************************************************\n*                                                                      *\n        Bounded instances\n*                                                                      *\n************************************************************************\n-}\n\ngen_Bounded_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)\ngen_Bounded_binds loc tycon\n  | isEnumerationTyCon tycon\n  = (listToBag [ min_bound_enum, max_bound_enum ], emptyBag)\n  | otherwise\n  = ASSERT(isSingleton data_cons)\n    (listToBag [ min_bound_1con, max_bound_1con ], emptyBag)\n  where\n    data_cons = tyConDataCons tycon\n\n    ----- enum-flavored: ---------------------------\n    min_bound_enum = mkHsVarBind loc minBound_RDR (nlHsVar data_con_1_RDR)\n    max_bound_enum = mkHsVarBind loc maxBound_RDR (nlHsVar data_con_N_RDR)\n\n    data_con_1     = head data_cons\n    data_con_N     = last data_cons\n    data_con_1_RDR = getRdrName data_con_1\n    data_con_N_RDR = getRdrName data_con_N\n\n    ----- single-constructor-flavored: -------------\n    arity          = dataConSourceArity data_con_1\n\n    min_bound_1con = mkHsVarBind loc minBound_RDR $\n                     nlHsVarApps data_con_1_RDR (nOfThem arity minBound_RDR)\n    max_bound_1con = mkHsVarBind loc maxBound_RDR $\n                     nlHsVarApps data_con_1_RDR (nOfThem arity maxBound_RDR)\n\n{-\n************************************************************************\n*                                                                      *\n        Ix instances\n*                                                                      *\n************************************************************************\n\nDeriving @Ix@ is only possible for enumeration types and\nsingle-constructor types.  We deal with them in turn.\n\nFor an enumeration type, e.g.,\n\\begin{verbatim}\n    data Foo ... = N1 | N2 | ... | Nn\n\\end{verbatim}\nthings go not too differently from @Enum@:\n\\begin{verbatim}\ninstance ... Ix (Foo ...) where\n    range (a, b)\n      = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b]\n\n    -- or, really...\n    range (a, b)\n      = case (con2tag_Foo a) of { a# ->\n        case (con2tag_Foo b) of { b# ->\n        map tag2con_Foo (enumFromTo (I# a#) (I# b#))\n        }}\n\n    -- Generate code for unsafeIndex, because using index leads\n    -- to lots of redundant range tests\n    unsafeIndex c@(a, b) d\n      = case (con2tag_Foo d -# con2tag_Foo a) of\n               r# -> I# r#\n\n    inRange (a, b) c\n      = let\n            p_tag = con2tag_Foo c\n        in\n        p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b\n\n    -- or, really...\n    inRange (a, b) c\n      = case (con2tag_Foo a)   of { a_tag ->\n        case (con2tag_Foo b)   of { b_tag ->\n        case (con2tag_Foo c)   of { c_tag ->\n        if (c_tag >=# a_tag) then\n          c_tag <=# b_tag\n        else\n          False\n        }}}\n\\end{verbatim}\n(modulo suitable case-ification to handle the unlifted tags)\n\nFor a single-constructor type (NB: this includes all tuples), e.g.,\n\\begin{verbatim}\n    data Foo ... = MkFoo a b Int Double c c\n\\end{verbatim}\nwe follow the scheme given in Figure~19 of the Haskell~1.2 report\n(p.~147).\n-}\n\ngen_Ix_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)\n\ngen_Ix_binds loc tycon = do\n    dflags <- getDynFlags\n    return $ if isEnumerationTyCon tycon\n      then (enum_ixes dflags, listToBag $ map DerivAuxBind\n                   [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon])\n      else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon)))\n  where\n    --------------------------------------------------------------\n    enum_ixes dflags = listToBag\n      [ enum_range   dflags\n      , enum_index   dflags\n      , enum_inRange dflags\n      ]\n\n    enum_range dflags\n      = mk_easy_FunBind loc range_RDR [nlTuplePat [a_Pat, b_Pat] Boxed] $\n          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $\n          untag_Expr dflags tycon [(b_RDR, bh_RDR)] $\n          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR dflags tycon]) $\n              nlHsPar (enum_from_to_Expr\n                        (nlHsVarApps intDataCon_RDR [ah_RDR])\n                        (nlHsVarApps intDataCon_RDR [bh_RDR]))\n\n    enum_index dflags\n      = mk_easy_FunBind loc unsafeIndex_RDR\n                [noLoc (AsPat noExt (noLoc c_RDR)\n                           (nlTuplePat [a_Pat, nlWildPat] Boxed)),\n                                d_Pat] (\n           untag_Expr dflags tycon [(a_RDR, ah_RDR)] (\n           untag_Expr dflags tycon [(d_RDR, dh_RDR)] (\n           let\n                rhs = nlHsVarApps intDataCon_RDR [c_RDR]\n           in\n           nlHsCase\n             (genOpApp (nlHsVar dh_RDR) minusInt_RDR (nlHsVar ah_RDR))\n             [mkHsCaseAlt (nlVarPat c_RDR) rhs]\n           ))\n        )\n\n    -- This produces something like `(ch >= ah) && (ch <= bh)`\n    enum_inRange dflags\n      = mk_easy_FunBind loc inRange_RDR [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat] $\n          untag_Expr dflags tycon [(a_RDR, ah_RDR)] (\n          untag_Expr dflags tycon [(b_RDR, bh_RDR)] (\n          untag_Expr dflags tycon [(c_RDR, ch_RDR)] (\n          -- This used to use `if`, which interacts badly with RebindableSyntax.\n          -- See #11396.\n          nlHsApps and_RDR\n              [ genPrimOpApp (nlHsVar ch_RDR) geInt_RDR (nlHsVar ah_RDR)\n              , genPrimOpApp (nlHsVar ch_RDR) leInt_RDR (nlHsVar bh_RDR)\n              ]\n          )))\n\n    --------------------------------------------------------------\n    single_con_ixes\n      = listToBag [single_con_range, single_con_index, single_con_inRange]\n\n    data_con\n      = case tyConSingleDataCon_maybe tycon of -- just checking...\n          Nothing -> panic \"get_Ix_binds\"\n          Just dc -> dc\n\n    con_arity    = dataConSourceArity data_con\n    data_con_RDR = getRdrName data_con\n\n    as_needed = take con_arity as_RDRs\n    bs_needed = take con_arity bs_RDRs\n    cs_needed = take con_arity cs_RDRs\n\n    con_pat  xs  = nlConVarPat data_con_RDR xs\n    con_expr     = nlHsVarApps data_con_RDR cs_needed\n\n    --------------------------------------------------------------\n    single_con_range\n      = mk_easy_FunBind loc range_RDR\n          [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed] $\n        noLoc (mkHsComp ListComp stmts con_expr)\n      where\n        stmts = zipWith3Equal \"single_con_range\" mk_qual as_needed bs_needed cs_needed\n\n        mk_qual a b c = noLoc $ mkBindStmt (nlVarPat c)\n                                 (nlHsApp (nlHsVar range_RDR)\n                                          (mkLHsVarTuple [a,b]))\n\n    ----------------\n    single_con_index\n      = mk_easy_FunBind loc unsafeIndex_RDR\n                [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed,\n                 con_pat cs_needed]\n        -- We need to reverse the order we consider the components in\n        -- so that\n        --     range (l,u) !! index (l,u) i == i   -- when i is in range\n        -- (from http://haskell.org/onlinereport/ix.html) holds.\n                (mk_index (reverse $ zip3 as_needed bs_needed cs_needed))\n      where\n        -- index (l1,u1) i1 + rangeSize (l1,u1) * (index (l2,u2) i2 + ...)\n        mk_index []        = nlHsIntLit 0\n        mk_index [(l,u,i)] = mk_one l u i\n        mk_index ((l,u,i) : rest)\n          = genOpApp (\n                mk_one l u i\n            ) plus_RDR (\n                genOpApp (\n                    (nlHsApp (nlHsVar unsafeRangeSize_RDR)\n                             (mkLHsVarTuple [l,u]))\n                ) times_RDR (mk_index rest)\n           )\n        mk_one l u i\n          = nlHsApps unsafeIndex_RDR [mkLHsVarTuple [l,u], nlHsVar i]\n\n    ------------------\n    single_con_inRange\n      = mk_easy_FunBind loc inRange_RDR\n                [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed,\n                 con_pat cs_needed] $\n          if con_arity == 0\n             -- If the product type has no fields, inRange is trivially true\n             -- (see Trac #12853).\n             then true_Expr\n             else foldl1 and_Expr (zipWith3Equal \"single_con_inRange\" in_range\n                    as_needed bs_needed cs_needed)\n      where\n        in_range a b c = nlHsApps inRange_RDR [mkLHsVarTuple [a,b], nlHsVar c]\n\n{-\n************************************************************************\n*                                                                      *\n        Read instances\n*                                                                      *\n************************************************************************\n\nExample\n\n  infix 4 %%\n  data T = Int %% Int\n         | T1 { f1 :: Int }\n         | T2 T\n\ninstance Read T where\n  readPrec =\n    parens\n    ( prec 4 (\n        do x <- ReadP.step Read.readPrec\n           expectP (Symbol \"%%\")\n           y <- ReadP.step Read.readPrec\n           return (x %% y))\n      +++\n      prec (appPrec+1) (\n        -- Note the \"+1\" part; \"T2 T1 {f1=3}\" should parse ok\n        -- Record construction binds even more tightly than application\n        do expectP (Ident \"T1\")\n           expectP (Punc '{')\n           x          <- Read.readField \"f1\" (ReadP.reset readPrec)\n           expectP (Punc '}')\n           return (T1 { f1 = x }))\n      +++\n      prec appPrec (\n        do expectP (Ident \"T2\")\n           x <- ReadP.step Read.readPrec\n           return (T2 x))\n    )\n\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n\nNote [Use expectP]\n~~~~~~~~~~~~~~~~~~\nNote that we use\n   expectP (Ident \"T1\")\nrather than\n   Ident \"T1\" <- lexP\nThe latter desugares to inline code for matching the Ident and the\nstring, and this can be very voluminous. The former is much more\ncompact.  Cf Trac #7258, although that also concerned non-linearity in\nthe occurrence analyser, a separate issue.\n\nNote [Read for empty data types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat should we get for this?  (Trac #7931)\n   data Emp deriving( Read )   -- No data constructors\n\nHere we want\n  read \"[]\" :: [Emp]   to succeed, returning []\nSo we do NOT want\n   instance Read Emp where\n     readPrec = error \"urk\"\nRather we want\n   instance Read Emp where\n     readPred = pfail   -- Same as choose []\n\nBecause 'pfail' allows the parser to backtrack, but 'error' doesn't.\nThese instances are also useful for Read (Either Int Emp), where\nwe want to be able to parse (Left 3) just fine.\n-}\n\ngen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon\n               -> (LHsBinds GhcPs, BagDerivStuff)\n\ngen_Read_binds get_fixity loc tycon\n  = (listToBag [read_prec, default_readlist, default_readlistprec], emptyBag)\n  where\n    -----------------------------------------------------------------------\n    default_readlist\n        = mkHsVarBind loc readList_RDR     (nlHsVar readListDefault_RDR)\n\n    default_readlistprec\n        = mkHsVarBind loc readListPrec_RDR (nlHsVar readListPrecDefault_RDR)\n    -----------------------------------------------------------------------\n\n    data_cons = tyConDataCons tycon\n    (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon data_cons\n\n    read_prec = mkHsVarBind loc readPrec_RDR rhs\n      where\n        rhs | null data_cons -- See Note [Read for empty data types]\n            = nlHsVar pfail_RDR\n            | otherwise\n            = nlHsApp (nlHsVar parens_RDR)\n                      (foldr1 mk_alt (read_nullary_cons ++\n                                      read_non_nullary_cons))\n\n    read_non_nullary_cons = map read_non_nullary_con non_nullary_cons\n\n    read_nullary_cons\n      = case nullary_cons of\n            []    -> []\n            [con] -> [nlHsDo DoExpr (match_con con ++ [noLoc $ mkLastStmt (result_expr con [])])]\n            _     -> [nlHsApp (nlHsVar choose_RDR)\n                              (nlList (map mk_pair nullary_cons))]\n        -- NB For operators the parens around (:=:) are matched by the\n        -- enclosing \"parens\" call, so here we must match the naked\n        -- data_con_str con\n\n    match_con con | isSym con_str = [symbol_pat con_str]\n                  | otherwise     = ident_h_pat  con_str\n                  where\n                    con_str = data_con_str con\n        -- For nullary constructors we must match Ident s for normal constrs\n        -- and   Symbol s   for operators\n\n    mk_pair con = mkLHsTupleExpr [nlHsLit (mkHsString (data_con_str con)),\n                                  result_expr con []]\n\n    read_non_nullary_con data_con\n      | is_infix  = mk_parser infix_prec  infix_stmts  body\n      | is_record = mk_parser record_prec record_stmts body\n--              Using these two lines instead allows the derived\n--              read for infix and record bindings to read the prefix form\n--      | is_infix  = mk_alt prefix_parser (mk_parser infix_prec  infix_stmts  body)\n--      | is_record = mk_alt prefix_parser (mk_parser record_prec record_stmts body)\n      | otherwise = prefix_parser\n      where\n        body = result_expr data_con as_needed\n        con_str = data_con_str data_con\n\n        prefix_parser = mk_parser prefix_prec prefix_stmts body\n\n        read_prefix_con\n            | isSym con_str = [read_punc \"(\", symbol_pat con_str, read_punc \")\"]\n            | otherwise     = ident_h_pat con_str\n\n        read_infix_con\n            | isSym con_str = [symbol_pat con_str]\n            | otherwise     = [read_punc \"`\"] ++ ident_h_pat con_str ++ [read_punc \"`\"]\n\n        prefix_stmts            -- T a b c\n          = read_prefix_con ++ read_args\n\n        infix_stmts             -- a %% b, or  a `T` b\n          = [read_a1]\n            ++ read_infix_con\n            ++ [read_a2]\n\n        record_stmts            -- T { f1 = a, f2 = b }\n          = read_prefix_con\n            ++ [read_punc \"{\"]\n            ++ concat (intersperse [read_punc \",\"] field_stmts)\n            ++ [read_punc \"}\"]\n\n        field_stmts  = zipWithEqual \"lbl_stmts\" read_field labels as_needed\n\n        con_arity    = dataConSourceArity data_con\n        labels       = map flLabel $ dataConFieldLabels data_con\n        dc_nm        = getName data_con\n        is_infix     = dataConIsInfix data_con\n        is_record    = labels `lengthExceeds` 0\n        as_needed    = take con_arity as_RDRs\n        read_args    = zipWithEqual \"gen_Read_binds\" read_arg as_needed (dataConOrigArgTys data_con)\n        (read_a1:read_a2:_) = read_args\n\n        prefix_prec = appPrecedence\n        infix_prec  = getPrecedence get_fixity dc_nm\n        record_prec = appPrecedence + 1 -- Record construction binds even more tightly\n                                        -- than application; e.g. T2 T1 {x=2} means T2 (T1 {x=2})\n\n    ------------------------------------------------------------------------\n    --          Helpers\n    ------------------------------------------------------------------------\n    mk_alt e1 e2       = genOpApp e1 alt_RDR e2                         -- e1 +++ e2\n    mk_parser p ss b   = nlHsApps prec_RDR [nlHsIntLit p                -- prec p (do { ss ; b })\n                                           , nlHsDo DoExpr (ss ++ [noLoc $ mkLastStmt b])]\n    con_app con as     = nlHsVarApps (getRdrName con) as                -- con as\n    result_expr con as = nlHsApp (nlHsVar returnM_RDR) (con_app con as) -- return (con as)\n\n    -- For constructors and field labels ending in '#', we hackily\n    -- let the lexer generate two tokens, and look for both in sequence\n    -- Thus [Ident \"I\"; Symbol \"#\"].  See Trac #5041\n    ident_h_pat s | Just (ss, '#') <- snocView s = [ ident_pat ss, symbol_pat \"#\" ]\n                  | otherwise                    = [ ident_pat s ]\n\n    bindLex pat  = noLoc (mkBodyStmt (nlHsApp (nlHsVar expectP_RDR) pat))  -- expectP p\n                   -- See Note [Use expectP]\n    ident_pat  s = bindLex $ nlHsApps ident_RDR  [nlHsLit (mkHsString s)]  -- expectP (Ident \"foo\")\n    symbol_pat s = bindLex $ nlHsApps symbol_RDR [nlHsLit (mkHsString s)]  -- expectP (Symbol \">>\")\n    read_punc c  = bindLex $ nlHsApps punc_RDR   [nlHsLit (mkHsString c)]  -- expectP (Punc \"<\")\n\n    data_con_str con = occNameString (getOccName con)\n\n    read_arg a ty = ASSERT( not (isUnliftedType ty) )\n                    noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR]))\n\n    -- When reading field labels we might encounter\n    --      a  = 3\n    --      _a = 3\n    -- or   (#) = 4\n    -- Note the parens!\n    read_field lbl a =\n        [noLoc\n          (mkBindStmt\n            (nlVarPat a)\n            (nlHsApp\n              read_field\n              (nlHsVarApps reset_RDR [readPrec_RDR])\n            )\n          )\n        ]\n        where\n          lbl_str = unpackFS lbl\n          mk_read_field read_field_rdr lbl\n              = nlHsApps read_field_rdr [nlHsLit (mkHsString lbl)]\n          read_field\n              | isSym lbl_str\n              = mk_read_field readSymField_RDR lbl_str\n              | Just (ss, '#') <- snocView lbl_str -- #14918\n              = mk_read_field readFieldHash_RDR ss\n              | otherwise\n              = mk_read_field readField_RDR lbl_str\n\n{-\n************************************************************************\n*                                                                      *\n        Show instances\n*                                                                      *\n************************************************************************\n\nExample\n\n    infixr 5 :^:\n\n    data Tree a =  Leaf a  |  Tree a :^: Tree a\n\n    instance (Show a) => Show (Tree a) where\n\n        showsPrec d (Leaf m) = showParen (d > app_prec) showStr\n          where\n             showStr = showString \"Leaf \" . showsPrec (app_prec+1) m\n\n        showsPrec d (u :^: v) = showParen (d > up_prec) showStr\n          where\n             showStr = showsPrec (up_prec+1) u .\n                       showString \" :^: \"      .\n                       showsPrec (up_prec+1) v\n                -- Note: right-associativity of :^: ignored\n\n    up_prec  = 5    -- Precedence of :^:\n    app_prec = 10   -- Application has precedence one more than\n                    -- the most tightly-binding operator\n-}\n\ngen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon\n               -> (LHsBinds GhcPs, BagDerivStuff)\n\ngen_Show_binds get_fixity loc tycon\n  = (unitBag shows_prec, emptyBag)\n  where\n    data_cons = tyConDataCons tycon\n    shows_prec = mkFunBindEC 2 loc showsPrec_RDR id (map pats_etc data_cons)\n    comma_space = nlHsVar showCommaSpace_RDR\n\n    pats_etc data_con\n      | nullary_con =  -- skip the showParen junk...\n         ASSERT(null bs_needed)\n         ([nlWildPat, con_pat], mk_showString_app op_con_str)\n      | otherwise   =\n         ([a_Pat, con_pat],\n          showParen_Expr (genOpApp a_Expr ge_RDR (nlHsLit\n                         (HsInt noExt (mkIntegralLit con_prec_plus_one))))\n                         (nlHsPar (nested_compose_Expr show_thingies)))\n        where\n             data_con_RDR  = getRdrName data_con\n             con_arity     = dataConSourceArity data_con\n             bs_needed     = take con_arity bs_RDRs\n             arg_tys       = dataConOrigArgTys data_con         -- Correspond 1-1 with bs_needed\n             con_pat       = nlConVarPat data_con_RDR bs_needed\n             nullary_con   = con_arity == 0\n             labels        = map flLabel $ dataConFieldLabels data_con\n             lab_fields    = length labels\n             record_syntax = lab_fields > 0\n\n             dc_nm          = getName data_con\n             dc_occ_nm      = getOccName data_con\n             con_str        = occNameString dc_occ_nm\n             op_con_str     = wrapOpParens con_str\n             backquote_str  = wrapOpBackquotes con_str\n\n             show_thingies\n                | is_infix      = [show_arg1, mk_showString_app (\" \" ++ backquote_str ++ \" \"), show_arg2]\n                | record_syntax = mk_showString_app (op_con_str ++ \" {\") :\n                                  show_record_args ++ [mk_showString_app \"}\"]\n                | otherwise     = mk_showString_app (op_con_str ++ \" \") : show_prefix_args\n\n             show_label l = mk_showString_app (nm ++ \" = \")\n                        -- Note the spaces around the \"=\" sign.  If we\n                        -- don't have them then we get Foo { x=-1 } and\n                        -- the \"=-\" parses as a single lexeme.  Only the\n                        -- space after the '=' is necessary, but it\n                        -- seems tidier to have them both sides.\n                 where\n                   nm       = wrapOpParens (unpackFS l)\n\n             show_args               = zipWith show_arg bs_needed arg_tys\n             (show_arg1:show_arg2:_) = show_args\n             show_prefix_args        = intersperse (nlHsVar showSpace_RDR) show_args\n\n                -- Assumption for record syntax: no of fields == no of\n                -- labelled fields (and in same order)\n             show_record_args = concat $\n                                intersperse [comma_space] $\n                                [ [show_label lbl, arg]\n                                | (lbl,arg) <- zipEqual \"gen_Show_binds\"\n                                                        labels show_args ]\n\n             show_arg :: RdrName -> Type -> LHsExpr GhcPs\n             show_arg b arg_ty\n                 | isUnliftedType arg_ty\n                 -- See Note [Deriving and unboxed types] in TcDerivInfer\n                 = with_conv $\n                    nlHsApps compose_RDR\n                        [mk_shows_app boxed_arg, mk_showString_app postfixMod]\n                 | otherwise\n                 = mk_showsPrec_app arg_prec arg\n               where\n                 arg        = nlHsVar b\n                 boxed_arg  = box \"Show\" arg arg_ty\n                 postfixMod = assoc_ty_id \"Show\" postfixModTbl arg_ty\n                 with_conv expr\n                    | (Just conv) <- assoc_ty_id_maybe primConvTbl arg_ty =\n                        nested_compose_Expr\n                            [ mk_showString_app (\"(\" ++ conv ++ \" \")\n                            , expr\n                            , mk_showString_app \")\"\n                            ]\n                    | otherwise = expr\n\n                -- Fixity stuff\n             is_infix = dataConIsInfix data_con\n             con_prec_plus_one = 1 + getPrec is_infix get_fixity dc_nm\n             arg_prec | record_syntax = 0  -- Record fields don't need parens\n                      | otherwise     = con_prec_plus_one\n\nwrapOpParens :: String -> String\nwrapOpParens s | isSym s   = '(' : s ++ \")\"\n               | otherwise = s\n\nwrapOpBackquotes :: String -> String\nwrapOpBackquotes s | isSym s   = s\n                   | otherwise = '`' : s ++ \"`\"\n\nisSym :: String -> Bool\nisSym \"\"      = False\nisSym (c : _) = startsVarSym c || startsConSym c\n\n-- | showString :: String -> ShowS\nmk_showString_app :: String -> LHsExpr GhcPs\nmk_showString_app str = nlHsApp (nlHsVar showString_RDR) (nlHsLit (mkHsString str))\n\n-- | showsPrec :: Show a => Int -> a -> ShowS\nmk_showsPrec_app :: Integer -> LHsExpr GhcPs -> LHsExpr GhcPs\nmk_showsPrec_app p x\n  = nlHsApps showsPrec_RDR [nlHsLit (HsInt noExt (mkIntegralLit p)), x]\n\n-- | shows :: Show a => a -> ShowS\nmk_shows_app :: LHsExpr GhcPs -> LHsExpr GhcPs\nmk_shows_app x = nlHsApp (nlHsVar shows_RDR) x\n\ngetPrec :: Bool -> (Name -> Fixity) -> Name -> Integer\ngetPrec is_infix get_fixity nm\n  | not is_infix   = appPrecedence\n  | otherwise      = getPrecedence get_fixity nm\n\nappPrecedence :: Integer\nappPrecedence = fromIntegral maxPrecedence + 1\n  -- One more than the precedence of the most\n  -- tightly-binding operator\n\ngetPrecedence :: (Name -> Fixity) -> Name -> Integer\ngetPrecedence get_fixity nm\n   = case get_fixity nm of\n        Fixity _ x _assoc -> fromIntegral x\n          -- NB: the Report says that associativity is not taken\n          --     into account for either Read or Show; hence we\n          --     ignore associativity here\n\n{-\n************************************************************************\n*                                                                      *\n        Data instances\n*                                                                      *\n************************************************************************\n\nFrom the data type\n\n  data T a b = T1 a b | T2\n\nwe generate\n\n  $cT1 = mkDataCon $dT \"T1\" Prefix\n  $cT2 = mkDataCon $dT \"T2\" Prefix\n  $dT  = mkDataType \"Module.T\" [] [$con_T1, $con_T2]\n  -- the [] is for field labels.\n\n  instance (Data a, Data b) => Data (T a b) where\n    gfoldl k z (T1 a b) = z T `k` a `k` b\n    gfoldl k z T2           = z T2\n    -- ToDo: add gmapT,Q,M, gfoldr\n\n    gunfold k z c = case conIndex c of\n                        I# 1# -> k (k (z T1))\n                        I# 2# -> z T2\n\n    toConstr (T1 _ _) = $cT1\n    toConstr T2       = $cT2\n\n    dataTypeOf _ = $dT\n\n    dataCast1 = gcast1   -- If T :: * -> *\n    dataCast2 = gcast2   -- if T :: * -> * -> *\n-}\n\ngen_Data_binds :: SrcSpan\n               -> TyCon                 -- For data families, this is the\n                                        --  *representation* TyCon\n               -> TcM (LHsBinds GhcPs,  -- The method bindings\n                       BagDerivStuff)   -- Auxiliary bindings\ngen_Data_binds loc rep_tc\n  = do { dflags  <- getDynFlags\n\n       -- Make unique names for the data type and constructor\n       -- auxiliary bindings.  Start with the name of the TyCon/DataCon\n       -- but that might not be unique: see Trac #12245.\n       ; dt_occ  <- chooseUniqueOccTc (mkDataTOcc (getOccName rep_tc))\n       ; dc_occs <- mapM (chooseUniqueOccTc . mkDataCOcc . getOccName)\n                         (tyConDataCons rep_tc)\n       ; let dt_rdr  = mkRdrUnqual dt_occ\n             dc_rdrs = map mkRdrUnqual dc_occs\n\n       -- OK, now do the work\n       ; return (gen_data dflags dt_rdr dc_rdrs loc rep_tc) }\n\ngen_data :: DynFlags -> RdrName -> [RdrName]\n         -> SrcSpan -> TyCon\n         -> (LHsBinds GhcPs,      -- The method bindings\n             BagDerivStuff)       -- Auxiliary bindings\ngen_data dflags data_type_name constr_names loc rep_tc\n  = (listToBag [gfoldl_bind, gunfold_bind, toCon_bind, dataTypeOf_bind]\n     `unionBags` gcast_binds,\n                -- Auxiliary definitions: the data type and constructors\n     listToBag ( genDataTyCon\n               : zipWith genDataDataCon data_cons constr_names ) )\n  where\n    data_cons  = tyConDataCons rep_tc\n    n_cons     = length data_cons\n    one_constr = n_cons == 1\n    genDataTyCon :: DerivStuff\n    genDataTyCon        --  $dT\n      = DerivHsBind (mkHsVarBind loc data_type_name rhs,\n                     L loc (TypeSig noExt [L loc data_type_name] sig_ty))\n\n    sig_ty = mkLHsSigWcType (nlHsTyVar dataType_RDR)\n    rhs    = nlHsVar mkDataType_RDR\n             `nlHsApp` nlHsLit (mkHsString (showSDocOneLine dflags (ppr rep_tc)))\n             `nlHsApp` nlList (map nlHsVar constr_names)\n\n    genDataDataCon :: DataCon -> RdrName -> DerivStuff\n    genDataDataCon dc constr_name       --  $cT1 etc\n      = DerivHsBind (mkHsVarBind loc constr_name rhs,\n                     L loc (TypeSig noExt [L loc constr_name] sig_ty))\n      where\n        sig_ty   = mkLHsSigWcType (nlHsTyVar constr_RDR)\n        rhs      = nlHsApps mkConstr_RDR constr_args\n\n        constr_args\n           = [ -- nlHsIntLit (toInteger (dataConTag dc)),   -- Tag\n               nlHsVar (data_type_name)                     -- DataType\n             , nlHsLit (mkHsString (occNameString dc_occ))  -- String name\n             , nlList  labels                               -- Field labels\n             , nlHsVar fixity ]                             -- Fixity\n\n        labels   = map (nlHsLit . mkHsString . unpackFS . flLabel)\n                       (dataConFieldLabels dc)\n        dc_occ   = getOccName dc\n        is_infix = isDataSymOcc dc_occ\n        fixity | is_infix  = infix_RDR\n               | otherwise = prefix_RDR\n\n        ------------ gfoldl\n    gfoldl_bind = mkFunBindEC 3 loc gfoldl_RDR id (map gfoldl_eqn data_cons)\n\n    gfoldl_eqn con\n      = ([nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed],\n                   foldl' mk_k_app (z_Expr `nlHsApp` nlHsVar con_name) as_needed)\n                   where\n                     con_name ::  RdrName\n                     con_name = getRdrName con\n                     as_needed = take (dataConSourceArity con) as_RDRs\n                     mk_k_app e v = nlHsPar (nlHsOpApp e k_RDR (nlHsVar v))\n\n        ------------ gunfold\n    gunfold_bind = mk_easy_FunBind loc\n                     gunfold_RDR\n                     [k_Pat, z_Pat, if one_constr then nlWildPat else c_Pat]\n                     gunfold_rhs\n\n    gunfold_rhs\n        | one_constr = mk_unfold_rhs (head data_cons)   -- No need for case\n        | otherwise  = nlHsCase (nlHsVar conIndex_RDR `nlHsApp` c_Expr)\n                                (map gunfold_alt data_cons)\n\n    gunfold_alt dc = mkHsCaseAlt (mk_unfold_pat dc) (mk_unfold_rhs dc)\n    mk_unfold_rhs dc = foldr nlHsApp\n                           (z_Expr `nlHsApp` nlHsVar (getRdrName dc))\n                           (replicate (dataConSourceArity dc) (nlHsVar k_RDR))\n\n    mk_unfold_pat dc    -- Last one is a wild-pat, to avoid\n                        -- redundant test, and annoying warning\n      | tag-fIRST_TAG == n_cons-1 = nlWildPat   -- Last constructor\n      | otherwise = nlConPat intDataCon_RDR\n                             [nlLitPat (HsIntPrim NoSourceText (toInteger tag))]\n      where\n        tag = dataConTag dc\n\n        ------------ toConstr\n    toCon_bind = mkFunBindEC 1 loc toConstr_RDR id\n                     (zipWith to_con_eqn data_cons constr_names)\n    to_con_eqn dc con_name = ([nlWildConPat dc], nlHsVar con_name)\n\n        ------------ dataTypeOf\n    dataTypeOf_bind = mk_easy_FunBind\n                        loc\n                        dataTypeOf_RDR\n                        [nlWildPat]\n                        (nlHsVar data_type_name)\n\n        ------------ gcast1/2\n        -- Make the binding    dataCast1 x = gcast1 x  -- if T :: * -> *\n        --               or    dataCast2 x = gcast2 s  -- if T :: * -> * -> *\n        -- (or nothing if T has neither of these two types)\n\n        -- But care is needed for data families:\n        -- If we have   data family D a\n        --              data instance D (a,b,c) = A | B deriving( Data )\n        -- and we want  instance ... => Data (D [(a,b,c)]) where ...\n        -- then we need     dataCast1 x = gcast1 x\n        -- because D :: * -> *\n        -- even though rep_tc has kind * -> * -> * -> *\n        -- Hence looking for the kind of fam_tc not rep_tc\n        -- See Trac #4896\n    tycon_kind = case tyConFamInst_maybe rep_tc of\n                    Just (fam_tc, _) -> tyConKind fam_tc\n                    Nothing          -> tyConKind rep_tc\n    gcast_binds | tycon_kind `tcEqKind` kind1 = mk_gcast dataCast1_RDR gcast1_RDR\n                | tycon_kind `tcEqKind` kind2 = mk_gcast dataCast2_RDR gcast2_RDR\n                | otherwise                 = emptyBag\n    mk_gcast dataCast_RDR gcast_RDR\n      = unitBag (mk_easy_FunBind loc dataCast_RDR [nlVarPat f_RDR]\n                                 (nlHsVar gcast_RDR `nlHsApp` nlHsVar f_RDR))\n\n\nkind1, kind2 :: Kind\nkind1 = liftedTypeKind `mkVisFunTy` liftedTypeKind\nkind2 = liftedTypeKind `mkVisFunTy` kind1\n\ngfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR,\n    mkDataType_RDR, conIndex_RDR, prefix_RDR, infix_RDR,\n    dataCast1_RDR, dataCast2_RDR, gcast1_RDR, gcast2_RDR,\n    constr_RDR, dataType_RDR,\n    eqChar_RDR  , ltChar_RDR  , geChar_RDR  , gtChar_RDR  , leChar_RDR  ,\n    eqInt_RDR   , ltInt_RDR   , geInt_RDR   , gtInt_RDR   , leInt_RDR   ,\n    eqInt8_RDR  , ltInt8_RDR  , geInt8_RDR  , gtInt8_RDR  , leInt8_RDR  ,\n    eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR ,\n    eqWord_RDR  , ltWord_RDR  , geWord_RDR  , gtWord_RDR  , leWord_RDR  ,\n    eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR ,\n    eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_RDR,\n    eqAddr_RDR  , ltAddr_RDR  , geAddr_RDR  , gtAddr_RDR  , leAddr_RDR  ,\n    eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR ,\n    eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,\n    extendWord8_RDR, extendInt8_RDR,\n    extendWord16_RDR, extendInt16_RDR :: RdrName\ngfoldl_RDR     = varQual_RDR  gENERICS (fsLit \"gfoldl\")\ngunfold_RDR    = varQual_RDR  gENERICS (fsLit \"gunfold\")\ntoConstr_RDR   = varQual_RDR  gENERICS (fsLit \"toConstr\")\ndataTypeOf_RDR = varQual_RDR  gENERICS (fsLit \"dataTypeOf\")\ndataCast1_RDR  = varQual_RDR  gENERICS (fsLit \"dataCast1\")\ndataCast2_RDR  = varQual_RDR  gENERICS (fsLit \"dataCast2\")\ngcast1_RDR     = varQual_RDR  tYPEABLE (fsLit \"gcast1\")\ngcast2_RDR     = varQual_RDR  tYPEABLE (fsLit \"gcast2\")\nmkConstr_RDR   = varQual_RDR  gENERICS (fsLit \"mkConstr\")\nconstr_RDR     = tcQual_RDR   gENERICS (fsLit \"Constr\")\nmkDataType_RDR = varQual_RDR  gENERICS (fsLit \"mkDataType\")\ndataType_RDR   = tcQual_RDR   gENERICS (fsLit \"DataType\")\nconIndex_RDR   = varQual_RDR  gENERICS (fsLit \"constrIndex\")\nprefix_RDR     = dataQual_RDR gENERICS (fsLit \"Prefix\")\ninfix_RDR      = dataQual_RDR gENERICS (fsLit \"Infix\")\n\neqChar_RDR     = varQual_RDR  gHC_PRIM (fsLit \"eqChar#\")\nltChar_RDR     = varQual_RDR  gHC_PRIM (fsLit \"ltChar#\")\nleChar_RDR     = varQual_RDR  gHC_PRIM (fsLit \"leChar#\")\ngtChar_RDR     = varQual_RDR  gHC_PRIM (fsLit \"gtChar#\")\ngeChar_RDR     = varQual_RDR  gHC_PRIM (fsLit \"geChar#\")\n\neqInt_RDR      = varQual_RDR  gHC_PRIM (fsLit \"==#\")\nltInt_RDR      = varQual_RDR  gHC_PRIM (fsLit \"<#\" )\nleInt_RDR      = varQual_RDR  gHC_PRIM (fsLit \"<=#\")\ngtInt_RDR      = varQual_RDR  gHC_PRIM (fsLit \">#\" )\ngeInt_RDR      = varQual_RDR  gHC_PRIM (fsLit \">=#\")\n\neqInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit \"eqInt8#\")\nltInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit \"ltInt8#\" )\nleInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit \"leInt8#\")\ngtInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit \"gtInt8#\" )\ngeInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit \"geInt8#\")\n\neqInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit \"eqInt16#\")\nltInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit \"ltInt16#\" )\nleInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit \"leInt16#\")\ngtInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit \"gtInt16#\" )\ngeInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit \"geInt16#\")\n\neqWord_RDR     = varQual_RDR  gHC_PRIM (fsLit \"eqWord#\")\nltWord_RDR     = varQual_RDR  gHC_PRIM (fsLit \"ltWord#\")\nleWord_RDR     = varQual_RDR  gHC_PRIM (fsLit \"leWord#\")\ngtWord_RDR     = varQual_RDR  gHC_PRIM (fsLit \"gtWord#\")\ngeWord_RDR     = varQual_RDR  gHC_PRIM (fsLit \"geWord#\")\n\neqWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit \"eqWord8#\")\nltWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit \"ltWord8#\" )\nleWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit \"leWord8#\")\ngtWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit \"gtWord8#\" )\ngeWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit \"geWord8#\")\n\neqWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit \"eqWord16#\")\nltWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit \"ltWord16#\" )\nleWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit \"leWord16#\")\ngtWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit \"gtWord16#\" )\ngeWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit \"geWord16#\")\n\neqAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit \"eqAddr#\")\nltAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit \"ltAddr#\")\nleAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit \"leAddr#\")\ngtAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit \"gtAddr#\")\ngeAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit \"geAddr#\")\n\neqFloat_RDR    = varQual_RDR  gHC_PRIM (fsLit \"eqFloat#\")\nltFloat_RDR    = varQual_RDR  gHC_PRIM (fsLit \"ltFloat#\")\nleFloat_RDR    = varQual_RDR  gHC_PRIM (fsLit \"leFloat#\")\ngtFloat_RDR    = varQual_RDR  gHC_PRIM (fsLit \"gtFloat#\")\ngeFloat_RDR    = varQual_RDR  gHC_PRIM (fsLit \"geFloat#\")\n\neqDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit \"==##\")\nltDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit \"<##\" )\nleDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit \"<=##\")\ngtDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit \">##\" )\ngeDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit \">=##\")\n\nextendWord8_RDR = varQual_RDR  gHC_PRIM (fsLit \"extendWord8#\")\nextendInt8_RDR  = varQual_RDR  gHC_PRIM (fsLit \"extendInt8#\")\n\nextendWord16_RDR = varQual_RDR  gHC_PRIM (fsLit \"extendWord16#\")\nextendInt16_RDR  = varQual_RDR  gHC_PRIM (fsLit \"extendInt16#\")\n\n\n{-\n************************************************************************\n*                                                                      *\n                        Lift instances\n*                                                                      *\n************************************************************************\n\nExample:\n\n    data Foo a = Foo a | a :^: a deriving Lift\n\n    ==>\n\n    instance (Lift a) => Lift (Foo a) where\n        lift (Foo a)\n          = appE\n              (conE\n                (mkNameG_d \"package-name\" \"ModuleName\" \"Foo\"))\n              (lift a)\n        lift (u :^: v)\n          = infixApp\n              (lift u)\n              (conE\n                (mkNameG_d \"package-name\" \"ModuleName\" \":^:\"))\n              (lift v)\n\nNote that (mkNameG_d \"package-name\" \"ModuleName\" \"Foo\") is equivalent to what\n'Foo would be when using the -XTemplateHaskell extension. To make sure that\n-XDeriveLift can be used on stage-1 compilers, however, we explicitly invoke\nmakeG_d.\n-}\n\ngen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)\ngen_Lift_binds loc tycon = (unitBag lift_bind, emptyBag)\n  where\n    lift_bind = mkFunBindEC 1 loc lift_RDR (nlHsApp pure_Expr)\n                            (map pats_etc data_cons)\n    data_cons = tyConDataCons tycon\n\n    pats_etc data_con\n      = ([con_pat], lift_Expr)\n       where\n            con_pat      = nlConVarPat data_con_RDR as_needed\n            data_con_RDR = getRdrName data_con\n            con_arity    = dataConSourceArity data_con\n            as_needed    = take con_arity as_RDRs\n            lifted_as    = zipWithEqual \"mk_lift_app\" mk_lift_app\n                             tys_needed as_needed\n            tycon_name   = tyConName tycon\n            is_infix     = dataConIsInfix data_con\n            tys_needed   = dataConOrigArgTys data_con\n\n            mk_lift_app ty a\n              | not (isUnliftedType ty) = nlHsApp (nlHsVar lift_RDR)\n                                                  (nlHsVar a)\n              | otherwise = nlHsApp (nlHsVar litE_RDR)\n                              (primLitOp (mkBoxExp (nlHsVar a)))\n              where (primLitOp, mkBoxExp) = primLitOps \"Lift\" ty\n\n            pkg_name = unitIdString . moduleUnitId\n                     . nameModule $ tycon_name\n            mod_name = moduleNameString . moduleName . nameModule $ tycon_name\n            con_name = occNameString . nameOccName . dataConName $ data_con\n\n            conE_Expr = nlHsApp (nlHsVar conE_RDR)\n                                (nlHsApps mkNameG_dRDR\n                                  (map (nlHsLit . mkHsString)\n                                    [pkg_name, mod_name, con_name]))\n\n            lift_Expr\n              | is_infix  = nlHsApps infixApp_RDR [a1, conE_Expr, a2]\n              | otherwise = foldl' mk_appE_app conE_Expr lifted_as\n            (a1:a2:_) = lifted_as\n\nmk_appE_app :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs\nmk_appE_app a b = nlHsApps appE_RDR [a, b]\n\n{-\n************************************************************************\n*                                                                      *\n                     Newtype-deriving instances\n*                                                                      *\n************************************************************************\n\nNote [Newtype-deriving instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe take every method in the original instance and `coerce` it to fit\ninto the derived instance. We need type applications on the argument\nto `coerce` to make it obvious what instantiation of the method we're\ncoercing from.  So from, say,\n\n  class C a b where\n    op :: forall c. a -> [b] -> c -> Int\n\n  newtype T x = MkT <rep-ty>\n\n  instance C a <rep-ty> => C a (T x) where\n    op = coerce @ (a -> [<rep-ty>] -> c -> Int)\n                @ (a -> [T x]      -> c -> Int)\n                op :: forall c. a -> [T x] -> c -> Int\n\nIn addition to the type applications, we also have an explicit\ntype signature on the entire RHS. This brings the method-bound variable\n`c` into scope over the two type applications.\nSee Note [GND and QuantifiedConstraints] for more information on why this\nis important.\n\nGiving 'coerce' two explicitly-visible type arguments grants us finer control\nover how it should be instantiated. Recall\n\n  coerce :: Coercible a b => a -> b\n\nBy giving it explicit type arguments we deal with the case where\n'op' has a higher rank type, and so we must instantiate 'coerce' with\na polytype.  E.g.\n\n   class C a where op :: a -> forall b. b -> b\n   newtype T x = MkT <rep-ty>\n   instance C <rep-ty> => C (T x) where\n     op = coerce @ (<rep-ty> -> forall b. b -> b)\n                 @ (T x      -> forall b. b -> b)\n                op :: T x -> forall b. b -> b\n\nThe use of type applications is crucial here. If we had tried using only\nexplicit type signatures, like so:\n\n   instance C <rep-ty> => C (T x) where\n     op = coerce (op :: <rep-ty> -> forall b. b -> b)\n                     :: T x      -> forall b. b -> b\n\nThen GHC will attempt to deeply skolemize the two type signatures, which will\nwreak havoc with the Coercible solver. Therefore, we instead use type\napplications, which do not deeply skolemize and thus avoid this issue.\nThe downside is that we currently require -XImpredicativeTypes to permit this\npolymorphic type instantiation, so we have to switch that flag on locally in\nTcDeriv.genInst. See #8503 for more discussion.\n\nNote [Newtype-deriving trickiness]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #12768):\n  class C a where { op :: D a => a -> a }\n\n  instance C a  => C [a] where { op = opList }\n\n  opList :: (C a, D [a]) => [a] -> [a]\n  opList = ...\n\nNow suppose we try GND on this:\n  newtype N a = MkN [a] deriving( C )\n\nThe GND is expecting to get an implementation of op for N by\ncoercing opList, thus:\n\n  instance C a => C (N a) where { op = opN }\n\n  opN :: (C a, D (N a)) => N a -> N a\n  opN = coerce @([a]   -> [a])\n               @([N a] -> [N a]\n               opList :: D (N a) => [N a] -> [N a]\n\nBut there is no reason to suppose that (D [a]) and (D (N a))\nare inter-coercible; these instances might completely different.\nSo GHC rightly rejects this code.\n\nNote [GND and QuantifiedConstraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following example from #15290:\n\n  class C m where\n    join :: m (m a) -> m a\n\n  newtype T m a = MkT (m a)\n\n  deriving instance\n    (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>\n    C (T m)\n\nThe code that GHC used to generate for this was:\n\n  instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>\n      C (T m) where\n    join = coerce @(forall a.   m   (m a) ->   m a)\n                  @(forall a. T m (T m a) -> T m a)\n                  join\n\nThis instantiates `coerce` at a polymorphic type, a form of impredicative\npolymorphism, so we're already on thin ice. And in fact the ice breaks,\nas we'll explain:\n\nThe call to `coerce` gives rise to:\n\n  Coercible (forall a.   m   (m a) ->   m a)\n            (forall a. T m (T m a) -> T m a)\n\nAnd that simplified to the following implication constraint:\n\n  forall a <no-ev>. m (T m a) ~R# m (m a)\n\nBut because this constraint is under a `forall`, inside a type, we have to\nprove it *without computing any term evidence* (hence the <no-ev>). Alas, we\n*must* generate a term-level evidence binding in order to instantiate the\nquantified constraint! In response, GHC currently chooses not to use such\na quantified constraint.\nSee Note [Instances in no-evidence implications] in TcInteract.\n\nBut this isn't the death knell for combining QuantifiedConstraints with GND.\nOn the contrary, if we generate GND bindings in a slightly different way, then\nwe can avoid this situation altogether. Instead of applying `coerce` to two\npolymorphic types, we instead let an explicit type signature do the polymorphic\ninstantiation, and omit the `forall`s in the type applications.\nMore concretely, we generate the following code instead:\n\n  instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>\n      C (T m) where\n    join = coerce @(  m   (m a) ->   m a)\n                  @(T m (T m a) -> T m a)\n                  join :: forall a. T m (T m a) -> T m a\n\nNow the visible type arguments are both monotypes, so we need do any of this\nfunny quantified constraint instantiation business.\n\nYou might think that that second @(T m (T m a) -> T m a) argument is redundant\nin the presence of the explicit `:: forall a. T m (T m a) -> T m a` type\nsignature, but in fact leaving it off will break this example (from the\nT15290d test case):\n\n  class C a where\n    c :: Int -> forall b. b -> a\n\n  instance C Int\n\n  instance C Age where\n    c = coerce @(Int -> forall b. b -> Int)\n               c :: Int -> forall b. b -> Age\n\nThat is because the explicit type signature deeply skolemizes the forall-bound\n`b`, which wreaks havoc with the `Coercible` solver. An additional visible type\nargument of @(Int -> forall b. b -> Age) is enough to prevent this.\n\nBe aware that the use of an explicit type signature doesn't /solve/ this\nproblem; it just makes it less likely to occur. For example, if a class has\na truly higher-rank type like so:\n\n  class CProblem m where\n    op :: (forall b. ... (m b) ...) -> Int\n\nThen the same situation will arise again. But at least it won't arise for the\ncommon case of methods with ordinary, prenex-quantified types.\n\nNote [GND and ambiguity]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWe make an effort to make the code generated through GND be robust w.r.t.\nambiguous type variables. As one example, consider the following example\n(from #15637):\n\n  class C a where f :: String\n  instance C () where f = \"foo\"\n  newtype T = T () deriving C\n\nA na\u00c3\u00afve attempt and generating a C T instance would be:\n\n  instance C T where\n    f = coerce @String @String f\n          :: String\n\nThis isn't going to typecheck, however, since GHC doesn't know what to\ninstantiate the type variable `a` with in the call to `f` in the method body.\n(Note that `f :: forall a. String`!) To compensate for the possibility of\nambiguity here, we explicitly instantiate `a` like so:\n\n  instance C T where\n    f = coerce @String @String (f @())\n          :: String\n\nAll better now.\n-}\n\ngen_Newtype_binds :: SrcSpan\n                  -> Class   -- the class being derived\n                  -> [TyVar] -- the tvs in the instance head (this includes\n                             -- the tvs from both the class types and the\n                             -- newtype itself)\n                  -> [Type]  -- instance head parameters (incl. newtype)\n                  -> Type    -- the representation type\n                  -> TcM (LHsBinds GhcPs, BagDerivStuff)\n-- See Note [Newtype-deriving instances]\ngen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty\n  = do let ats = classATs cls\n       atf_insts <- ASSERT( all (not . isDataFamilyTyCon) ats )\n                    mapM mk_atf_inst ats\n       return ( listToBag $ map mk_bind (classMethods cls)\n              , listToBag $ map DerivFamInst atf_insts )\n  where\n    mk_bind :: Id -> LHsBind GhcPs\n    mk_bind meth_id\n      = mkRdrFunBind (L loc meth_RDR) [mkSimpleMatch\n                                          (mkPrefixFunRhs (L loc meth_RDR))\n                                          [] rhs_expr]\n      where\n        Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty meth_id\n        (_, _, from_tau) = tcSplitSigmaTy from_ty\n        (_, _, to_tau)   = tcSplitSigmaTy to_ty\n\n        meth_RDR = getRdrName meth_id\n\n        rhs_expr = nlHsVar (getRdrName coerceId)\n                                      `nlHsAppType`     from_tau\n                                      `nlHsAppType`     to_tau\n                                      `nlHsApp`         meth_app\n                                      `nlExprWithTySig` to_ty\n\n        -- The class method, applied to all of the class instance types\n        -- (including the representation type) to avoid potential ambiguity.\n        -- See Note [GND and ambiguity]\n        meth_app = foldl' nlHsAppType (nlHsVar meth_RDR) $\n                   filterOutInferredTypes (classTyCon cls) underlying_inst_tys\n                     -- Filter out any inferred arguments, since they can't be\n                     -- applied with visible type application.\n\n    mk_atf_inst :: TyCon -> TcM FamInst\n    mk_atf_inst fam_tc = do\n        rep_tc_name <- newFamInstTyConName (L loc (tyConName fam_tc))\n                                           rep_lhs_tys\n        let axiom = mkSingleCoAxiom Nominal rep_tc_name rep_tvs' [] rep_cvs'\n                                    fam_tc rep_lhs_tys rep_rhs_ty\n        -- Check (c) from Note [GND and associated type families] in TcDeriv\n        checkValidCoAxBranch fam_tc (coAxiomSingleBranch axiom)\n        newFamInst SynFamilyInst axiom\n      where\n        cls_tvs     = classTyVars cls\n        in_scope    = mkInScopeSet $ mkVarSet inst_tvs\n        lhs_env     = zipTyEnv cls_tvs inst_tys\n        lhs_subst   = mkTvSubst in_scope lhs_env\n        rhs_env     = zipTyEnv cls_tvs underlying_inst_tys\n        rhs_subst   = mkTvSubst in_scope rhs_env\n        fam_tvs     = tyConTyVars fam_tc\n        rep_lhs_tys = substTyVars lhs_subst fam_tvs\n        rep_rhs_tys = substTyVars rhs_subst fam_tvs\n        rep_rhs_ty  = mkTyConApp fam_tc rep_rhs_tys\n        rep_tcvs    = tyCoVarsOfTypesList rep_lhs_tys\n        (rep_tvs, rep_cvs) = partition isTyVar rep_tcvs\n        rep_tvs'    = scopedSort rep_tvs\n        rep_cvs'    = scopedSort rep_cvs\n\n    -- Same as inst_tys, but with the last argument type replaced by the\n    -- representation type.\n    underlying_inst_tys :: [Type]\n    underlying_inst_tys = changeLast inst_tys rhs_ty\n\nnlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs\nnlHsAppType e s = noLoc (HsAppType noExt e hs_ty)\n  where\n    hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec (typeToLHsType s)\n\nnlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs\nnlExprWithTySig e s = noLoc $ ExprWithTySig noExt (parenthesizeHsExpr sigPrec e) hs_ty\n  where\n    hs_ty = mkLHsSigWcType (typeToLHsType s)\n\nmkCoerceClassMethEqn :: Class   -- the class being derived\n                     -> [TyVar] -- the tvs in the instance head (this includes\n                                -- the tvs from both the class types and the\n                                -- newtype itself)\n                     -> [Type]  -- instance head parameters (incl. newtype)\n                     -> Type    -- the representation type\n                     -> Id      -- the method to look at\n                     -> Pair Type\n-- See Note [Newtype-deriving instances]\n-- See also Note [Newtype-deriving trickiness]\n-- The pair is the (from_type, to_type), where to_type is\n-- the type of the method we are trying to get\nmkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id\n  = Pair (substTy rhs_subst user_meth_ty)\n         (substTy lhs_subst user_meth_ty)\n  where\n    cls_tvs = classTyVars cls\n    in_scope = mkInScopeSet $ mkVarSet inst_tvs\n    lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs inst_tys)\n    rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast inst_tys rhs_ty))\n    (_class_tvs, _class_constraint, user_meth_ty)\n      = tcSplitMethodTy (varType id)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Generating extra binds (@con2tag@ and @tag2con@)}\n*                                                                      *\n************************************************************************\n\n\\begin{verbatim}\ndata Foo ... = ...\n\ncon2tag_Foo :: Foo ... -> Int#\ntag2con_Foo :: Int -> Foo ...   -- easier if Int, not Int#\nmaxtag_Foo  :: Int              -- ditto (NB: not unlifted)\n\\end{verbatim}\n\nThe `tags' here start at zero, hence the @fIRST_TAG@ (currently one)\nfiddling around.\n-}\n\ngenAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec\n                  -> (LHsBind GhcPs, LSig GhcPs)\ngenAuxBindSpec dflags loc (DerivCon2Tag tycon)\n  = (mkFunBindSE 0 loc rdr_name eqns,\n     L loc (TypeSig noExt [L loc rdr_name] sig_ty))\n  where\n    rdr_name = con2tag_RDR dflags tycon\n\n    sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $\n             mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $\n             mkParentType tycon `mkVisFunTy` intPrimTy\n\n    lots_of_constructors = tyConFamilySize tycon > 8\n                        -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS\n                        -- but we don't do vectored returns any more.\n\n    eqns | lots_of_constructors = [get_tag_eqn]\n         | otherwise = map mk_eqn (tyConDataCons tycon)\n\n    get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr)\n\n    mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs)\n    mk_eqn con = ([nlWildConPat con],\n                  nlHsLit (HsIntPrim NoSourceText\n                                    (toInteger ((dataConTag con) - fIRST_TAG))))\n\ngenAuxBindSpec dflags loc (DerivTag2Con tycon)\n  = (mkFunBindSE 0 loc rdr_name\n        [([nlConVarPat intDataCon_RDR [a_RDR]],\n           nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)],\n     L loc (TypeSig noExt [L loc rdr_name] sig_ty))\n  where\n    sig_ty = mkLHsSigWcType $ L loc $\n             XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $\n             intTy `mkVisFunTy` mkParentType tycon\n\n    rdr_name = tag2con_RDR dflags tycon\n\ngenAuxBindSpec dflags loc (DerivMaxTag tycon)\n  = (mkHsVarBind loc rdr_name rhs,\n     L loc (TypeSig noExt [L loc rdr_name] sig_ty))\n  where\n    rdr_name = maxtag_RDR dflags tycon\n    sig_ty = mkLHsSigWcType (L loc (XHsType (NHsCoreTy intTy)))\n    rhs = nlHsApp (nlHsVar intDataCon_RDR)\n                  (nlHsLit (HsIntPrim NoSourceText max_tag))\n    max_tag =  case (tyConDataCons tycon) of\n                 data_cons -> toInteger ((length data_cons) - fIRST_TAG)\n\ntype SeparateBagsDerivStuff =\n  -- AuxBinds and SYB bindings\n  ( Bag (LHsBind GhcPs, LSig GhcPs)\n  -- Extra family instances (used by Generic and DeriveAnyClass)\n  , Bag (FamInst) )\n\ngenAuxBinds :: DynFlags -> SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff\ngenAuxBinds dflags loc b = genAuxBinds' b2 where\n  (b1,b2) = partitionBagWith splitDerivAuxBind b\n  splitDerivAuxBind (DerivAuxBind x) = Left x\n  splitDerivAuxBind  x               = Right x\n\n  rm_dups = foldrBag dup_check emptyBag\n  dup_check a b = if anyBag (== a) b then b else consBag a b\n\n  genAuxBinds' :: BagDerivStuff -> SeparateBagsDerivStuff\n  genAuxBinds' = foldrBag f ( mapBag (genAuxBindSpec dflags loc) (rm_dups b1)\n                            , emptyBag )\n  f :: DerivStuff -> SeparateBagsDerivStuff -> SeparateBagsDerivStuff\n  f (DerivAuxBind _) = panic \"genAuxBinds'\" -- We have removed these before\n  f (DerivHsBind  b) = add1 b\n  f (DerivFamInst t) = add2 t\n\n  add1 x (a,b) = (x `consBag` a,b)\n  add2 x (a,b) = (a,x `consBag` b)\n\nmkParentType :: TyCon -> Type\n-- Turn the representation tycon of a family into\n-- a use of its family constructor\nmkParentType tc\n  = case tyConFamInst_maybe tc of\n       Nothing  -> mkTyConApp tc (mkTyVarTys (tyConTyVars tc))\n       Just (fam_tc,tys) -> mkTyConApp fam_tc tys\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Utility bits for generating bindings}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Make a function binding. If no equations are given, produce a function\n-- with the given arity that produces a stock error.\nmkFunBindSE :: Arity -> SrcSpan -> RdrName\n             -> [([LPat GhcPs], LHsExpr GhcPs)]\n             -> LHsBind GhcPs\nmkFunBindSE arity loc fun pats_and_exprs\n  = mkRdrFunBindSE arity (L loc fun) matches\n  where\n    matches = [mkMatch (mkPrefixFunRhs (L loc fun))\n                               (map (parenthesizePat appPrec) p) e\n                               (noLoc emptyLocalBinds)\n              | (p,e) <-pats_and_exprs]\n\nmkRdrFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]\n             -> LHsBind GhcPs\nmkRdrFunBind fun@(L loc _fun_rdr) matches\n  = L loc (mkFunBind fun matches)\n\n-- | Make a function binding. If no equations are given, produce a function\n-- with the given arity that uses an empty case expression for the last\n-- argument that is passes to the given function to produce the right-hand\n-- side.\nmkFunBindEC :: Arity -> SrcSpan -> RdrName\n            -> (LHsExpr GhcPs -> LHsExpr GhcPs)\n            -> [([LPat GhcPs], LHsExpr GhcPs)]\n            -> LHsBind GhcPs\nmkFunBindEC arity loc fun catch_all pats_and_exprs\n  = mkRdrFunBindEC arity catch_all (L loc fun) matches\n  where\n    matches = [ mkMatch (mkPrefixFunRhs (L loc fun))\n                                (map (parenthesizePat appPrec) p) e\n                                (noLoc emptyLocalBinds)\n              | (p,e) <- pats_and_exprs ]\n\n-- | Produces a function binding. When no equations are given, it generates\n-- a binding of the given arity and an empty case expression\n-- for the last argument that it passes to the given function to produce\n-- the right-hand side.\nmkRdrFunBindEC :: Arity\n               -> (LHsExpr GhcPs -> LHsExpr GhcPs)\n               -> Located RdrName\n               -> [LMatch GhcPs (LHsExpr GhcPs)]\n               -> LHsBind GhcPs\nmkRdrFunBindEC arity catch_all\n                 fun@(L loc _fun_rdr) matches = L loc (mkFunBind fun matches')\n where\n   -- Catch-all eqn looks like\n   --     fmap _ z = case z of {}\n   -- or\n   --     traverse _ z = pure (case z of)\n   -- or\n   --     foldMap _ z = mempty\n   -- It's needed if there no data cons at all,\n   -- which can happen with -XEmptyDataDecls\n   -- See Trac #4302\n   matches' = if null matches\n              then [mkMatch (mkPrefixFunRhs fun)\n                            (replicate (arity - 1) nlWildPat ++ [z_Pat])\n                            (catch_all $ nlHsCase z_Expr [])\n                            (noLoc emptyLocalBinds)]\n              else matches\n\n-- | Produces a function binding. When there are no equations, it generates\n-- a binding with the given arity that produces an error based on the name of\n-- the type of the last argument.\nmkRdrFunBindSE :: Arity -> Located RdrName ->\n                    [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs\nmkRdrFunBindSE arity\n                 fun@(L loc fun_rdr) matches = L loc (mkFunBind fun matches')\n where\n   -- Catch-all eqn looks like\n   --     compare _ _ = error \"Void compare\"\n   -- It's needed if there no data cons at all,\n   -- which can happen with -XEmptyDataDecls\n   -- See Trac #4302\n   matches' = if null matches\n              then [mkMatch (mkPrefixFunRhs fun)\n                            (replicate arity nlWildPat)\n                            (error_Expr str) (noLoc emptyLocalBinds)]\n              else matches\n   str = \"Void \" ++ occNameString (rdrNameOcc fun_rdr)\n\n\nbox ::         String           -- The class involved\n            -> LHsExpr GhcPs    -- The argument\n            -> Type             -- The argument type\n            -> LHsExpr GhcPs    -- Boxed version of the arg\n-- See Note [Deriving and unboxed types] in TcDerivInfer\nbox cls_str arg arg_ty = assoc_ty_id cls_str boxConTbl arg_ty arg\n\n---------------------\nprimOrdOps :: String    -- The class involved\n           -> Type      -- The type\n           -> (RdrName, RdrName, RdrName, RdrName, RdrName)  -- (lt,le,eq,ge,gt)\n-- See Note [Deriving and unboxed types] in TcDerivInfer\nprimOrdOps str ty = assoc_ty_id str ordOpTbl ty\n\nprimLitOps :: String -- The class involved\n           -> Type   -- The type\n           -> ( LHsExpr GhcPs -> LHsExpr GhcPs -- Constructs a Q Exp value\n              , LHsExpr GhcPs -> LHsExpr GhcPs -- Constructs a boxed value\n              )\nprimLitOps str ty = (assoc_ty_id str litConTbl ty, \\v -> boxed v)\n  where\n    boxed v\n      | ty `eqType` addrPrimTy = nlHsVar unpackCString_RDR `nlHsApp` v\n      | otherwise = assoc_ty_id str boxConTbl ty v\n\nordOpTbl :: [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]\nordOpTbl\n =  [(charPrimTy  , (ltChar_RDR  , leChar_RDR\n     , eqChar_RDR  , geChar_RDR  , gtChar_RDR  ))\n    ,(intPrimTy   , (ltInt_RDR   , leInt_RDR\n     , eqInt_RDR   , geInt_RDR   , gtInt_RDR   ))\n    ,(int8PrimTy  , (ltInt8_RDR  , leInt8_RDR\n     , eqInt8_RDR  , geInt8_RDR  , gtInt8_RDR   ))\n    ,(int16PrimTy , (ltInt16_RDR , leInt16_RDR\n     , eqInt16_RDR , geInt16_RDR , gtInt16_RDR   ))\n    ,(wordPrimTy  , (ltWord_RDR  , leWord_RDR\n     , eqWord_RDR  , geWord_RDR  , gtWord_RDR  ))\n    ,(word8PrimTy , (ltWord8_RDR , leWord8_RDR\n     , eqWord8_RDR , geWord8_RDR , gtWord8_RDR   ))\n    ,(word16PrimTy, (ltWord16_RDR, leWord16_RDR\n     , eqWord16_RDR, geWord16_RDR, gtWord16_RDR  ))\n    ,(addrPrimTy  , (ltAddr_RDR  , leAddr_RDR\n     , eqAddr_RDR  , geAddr_RDR  , gtAddr_RDR  ))\n    ,(floatPrimTy , (ltFloat_RDR , leFloat_RDR\n     , eqFloat_RDR , geFloat_RDR , gtFloat_RDR ))\n    ,(doublePrimTy, (ltDouble_RDR, leDouble_RDR\n     , eqDouble_RDR, geDouble_RDR, gtDouble_RDR)) ]\n\n-- A mapping from a primitive type to a function that constructs its boxed\n-- version.\n-- NOTE: Int8#/Word8# will become Int/Word.\nboxConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]\nboxConTbl =\n    [ (charPrimTy  , nlHsApp (nlHsVar $ getRdrName charDataCon))\n    , (intPrimTy   , nlHsApp (nlHsVar $ getRdrName intDataCon))\n    , (wordPrimTy  , nlHsApp (nlHsVar $ getRdrName wordDataCon ))\n    , (floatPrimTy , nlHsApp (nlHsVar $ getRdrName floatDataCon ))\n    , (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon))\n    , (int8PrimTy,\n        nlHsApp (nlHsVar $ getRdrName intDataCon)\n        . nlHsApp (nlHsVar extendInt8_RDR))\n    , (word8PrimTy,\n        nlHsApp (nlHsVar $ getRdrName wordDataCon)\n        .  nlHsApp (nlHsVar extendWord8_RDR))\n    , (int16PrimTy,\n        nlHsApp (nlHsVar $ getRdrName intDataCon)\n        . nlHsApp (nlHsVar extendInt16_RDR))\n    , (word16PrimTy,\n        nlHsApp (nlHsVar $ getRdrName wordDataCon)\n        .  nlHsApp (nlHsVar extendWord16_RDR))\n    ]\n\n\n-- | A table of postfix modifiers for unboxed values.\npostfixModTbl :: [(Type, String)]\npostfixModTbl\n  = [(charPrimTy  , \"#\" )\n    ,(intPrimTy   , \"#\" )\n    ,(wordPrimTy  , \"##\")\n    ,(floatPrimTy , \"#\" )\n    ,(doublePrimTy, \"##\")\n    ,(int8PrimTy, \"#\")\n    ,(word8PrimTy, \"##\")\n    ,(int16PrimTy, \"#\")\n    ,(word16PrimTy, \"##\")\n    ]\n\nprimConvTbl :: [(Type, String)]\nprimConvTbl =\n    [ (int8PrimTy, \"narrowInt8#\")\n    , (word8PrimTy, \"narrowWord8#\")\n    , (int16PrimTy, \"narrowInt16#\")\n    , (word16PrimTy, \"narrowWord16#\")\n    ]\n\nlitConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]\nlitConTbl\n  = [(charPrimTy  , nlHsApp (nlHsVar charPrimL_RDR))\n    ,(intPrimTy   , nlHsApp (nlHsVar intPrimL_RDR)\n                      . nlHsApp (nlHsVar toInteger_RDR))\n    ,(wordPrimTy  , nlHsApp (nlHsVar wordPrimL_RDR)\n                      . nlHsApp (nlHsVar toInteger_RDR))\n    ,(addrPrimTy  , nlHsApp (nlHsVar stringPrimL_RDR)\n                      . nlHsApp (nlHsApp\n                          (nlHsVar map_RDR)\n                          (compose_RDR `nlHsApps`\n                            [ nlHsVar fromIntegral_RDR\n                            , nlHsVar fromEnum_RDR\n                            ])))\n    ,(floatPrimTy , nlHsApp (nlHsVar floatPrimL_RDR)\n                      . nlHsApp (nlHsVar toRational_RDR))\n    ,(doublePrimTy, nlHsApp (nlHsVar doublePrimL_RDR)\n                      . nlHsApp (nlHsVar toRational_RDR))\n    ]\n\n-- | Lookup `Type` in an association list.\nassoc_ty_id :: HasCallStack => String           -- The class involved\n            -> [(Type,a)]       -- The table\n            -> Type             -- The type\n            -> a                -- The result of the lookup\nassoc_ty_id cls_str tbl ty\n  | Just a <- assoc_ty_id_maybe tbl ty = a\n  | otherwise =\n      pprPanic \"Error in deriving:\"\n          (text \"Can't derive\" <+> text cls_str <+>\n           text \"for primitive type\" <+> ppr ty)\n\n-- | Lookup `Type` in an association list.\nassoc_ty_id_maybe :: [(Type, a)] -> Type -> Maybe a\nassoc_ty_id_maybe tbl ty = snd <$> find (\\(t, _) -> t `eqType` ty) tbl\n\n-----------------------------------------------------------------------\n\nand_Expr :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs\nand_Expr a b = genOpApp a and_RDR    b\n\n-----------------------------------------------------------------------\n\neq_Expr :: Type -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs\neq_Expr ty a b\n    | not (isUnliftedType ty) = genOpApp a eq_RDR b\n    | otherwise               = genPrimOpApp a prim_eq b\n where\n   (_, _, prim_eq, _, _) = primOrdOps \"Eq\" ty\n\nuntag_Expr :: DynFlags -> TyCon -> [( RdrName,  RdrName)]\n              -> LHsExpr GhcPs -> LHsExpr GhcPs\nuntag_Expr _ _ [] expr = expr\nuntag_Expr dflags tycon ((untag_this, put_tag_here) : more) expr\n  = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR dflags tycon)\n                                   [untag_this])) {-of-}\n      [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr dflags tycon more expr)]\n\nenum_from_to_Expr\n        :: LHsExpr GhcPs -> LHsExpr GhcPs\n        -> LHsExpr GhcPs\nenum_from_then_to_Expr\n        :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs\n        -> LHsExpr GhcPs\n\nenum_from_to_Expr      f   t2 = nlHsApp (nlHsApp (nlHsVar enumFromTo_RDR) f) t2\nenum_from_then_to_Expr f t t2 = nlHsApp (nlHsApp (nlHsApp (nlHsVar enumFromThenTo_RDR) f) t) t2\n\nshowParen_Expr\n        :: LHsExpr GhcPs -> LHsExpr GhcPs\n        -> LHsExpr GhcPs\n\nshowParen_Expr e1 e2 = nlHsApp (nlHsApp (nlHsVar showParen_RDR) e1) e2\n\nnested_compose_Expr :: [LHsExpr GhcPs] -> LHsExpr GhcPs\n\nnested_compose_Expr []  = panic \"nested_compose_expr\"   -- Arg is always non-empty\nnested_compose_Expr [e] = parenify e\nnested_compose_Expr (e:es)\n  = nlHsApp (nlHsApp (nlHsVar compose_RDR) (parenify e)) (nested_compose_Expr es)\n\n-- impossible_Expr is used in case RHSs that should never happen.\n-- We generate these to keep the desugarer from complaining that they *might* happen!\nerror_Expr :: String -> LHsExpr GhcPs\nerror_Expr string = nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsString string))\n\n-- illegal_Expr is used when signalling error conditions in the RHS of a derived\n-- method. It is currently only used by Enum.{succ,pred}\nillegal_Expr :: String -> String -> String -> LHsExpr GhcPs\nillegal_Expr meth tp msg =\n   nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsString (meth ++ '{':tp ++ \"}: \" ++ msg)))\n\n-- illegal_toEnum_tag is an extended version of illegal_Expr, which also allows you\n-- to include the value of a_RDR in the error string.\nillegal_toEnum_tag :: String -> RdrName -> LHsExpr GhcPs\nillegal_toEnum_tag tp maxtag =\n   nlHsApp (nlHsVar error_RDR)\n           (nlHsApp (nlHsApp (nlHsVar append_RDR)\n                       (nlHsLit (mkHsString (\"toEnum{\" ++ tp ++ \"}: tag (\"))))\n                    (nlHsApp (nlHsApp (nlHsApp\n                           (nlHsVar showsPrec_RDR)\n                           (nlHsIntLit 0))\n                           (nlHsVar a_RDR))\n                           (nlHsApp (nlHsApp\n                               (nlHsVar append_RDR)\n                               (nlHsLit (mkHsString \") is outside of enumeration's range (0,\")))\n                               (nlHsApp (nlHsApp (nlHsApp\n                                        (nlHsVar showsPrec_RDR)\n                                        (nlHsIntLit 0))\n                                        (nlHsVar maxtag))\n                                        (nlHsLit (mkHsString \")\"))))))\n\nparenify :: LHsExpr GhcPs -> LHsExpr GhcPs\nparenify e@(L _ (HsVar _ _)) = e\nparenify e                   = mkHsPar e\n\n-- genOpApp wraps brackets round the operator application, so that the\n-- renamer won't subsequently try to re-associate it.\ngenOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs\ngenOpApp e1 op e2 = nlHsPar (nlHsOpApp e1 op e2)\n\ngenPrimOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs\ngenPrimOpApp e1 op e2 = nlHsPar (nlHsApp (nlHsVar tagToEnum_RDR) (nlHsOpApp e1 op e2))\n\na_RDR, b_RDR, c_RDR, d_RDR, f_RDR, k_RDR, z_RDR, ah_RDR, bh_RDR, ch_RDR, dh_RDR\n    :: RdrName\na_RDR           = mkVarUnqual (fsLit \"a\")\nb_RDR           = mkVarUnqual (fsLit \"b\")\nc_RDR           = mkVarUnqual (fsLit \"c\")\nd_RDR           = mkVarUnqual (fsLit \"d\")\nf_RDR           = mkVarUnqual (fsLit \"f\")\nk_RDR           = mkVarUnqual (fsLit \"k\")\nz_RDR           = mkVarUnqual (fsLit \"z\")\nah_RDR          = mkVarUnqual (fsLit \"a#\")\nbh_RDR          = mkVarUnqual (fsLit \"b#\")\nch_RDR          = mkVarUnqual (fsLit \"c#\")\ndh_RDR          = mkVarUnqual (fsLit \"d#\")\n\nas_RDRs, bs_RDRs, cs_RDRs :: [RdrName]\nas_RDRs         = [ mkVarUnqual (mkFastString (\"a\"++show i)) | i <- [(1::Int) .. ] ]\nbs_RDRs         = [ mkVarUnqual (mkFastString (\"b\"++show i)) | i <- [(1::Int) .. ] ]\ncs_RDRs         = [ mkVarUnqual (mkFastString (\"c\"++show i)) | i <- [(1::Int) .. ] ]\n\na_Expr, b_Expr, c_Expr, z_Expr, ltTag_Expr, eqTag_Expr, gtTag_Expr, false_Expr,\n    true_Expr, pure_Expr :: LHsExpr GhcPs\na_Expr          = nlHsVar a_RDR\nb_Expr          = nlHsVar b_RDR\nc_Expr          = nlHsVar c_RDR\nz_Expr          = nlHsVar z_RDR\nltTag_Expr      = nlHsVar ltTag_RDR\neqTag_Expr      = nlHsVar eqTag_RDR\ngtTag_Expr      = nlHsVar gtTag_RDR\nfalse_Expr      = nlHsVar false_RDR\ntrue_Expr       = nlHsVar true_RDR\npure_Expr       = nlHsVar pure_RDR\n\na_Pat, b_Pat, c_Pat, d_Pat, k_Pat, z_Pat :: LPat GhcPs\na_Pat           = nlVarPat a_RDR\nb_Pat           = nlVarPat b_RDR\nc_Pat           = nlVarPat c_RDR\nd_Pat           = nlVarPat d_RDR\nk_Pat           = nlVarPat k_RDR\nz_Pat           = nlVarPat z_RDR\n\nminusInt_RDR, tagToEnum_RDR :: RdrName\nminusInt_RDR  = getRdrName (primOpId IntSubOp   )\ntagToEnum_RDR = getRdrName (primOpId TagToEnumOp)\n\ncon2tag_RDR, tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName\n-- Generates Orig s RdrName, for the binding positions\ncon2tag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkCon2TagOcc\ntag2con_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkTag2ConOcc\nmaxtag_RDR  dflags tycon = mk_tc_deriv_name dflags tycon mkMaxTagOcc\n\nmk_tc_deriv_name :: DynFlags -> TyCon -> (OccName -> OccName) -> RdrName\nmk_tc_deriv_name dflags tycon occ_fun =\n   mkAuxBinderName dflags (tyConName tycon) occ_fun\n\nmkAuxBinderName :: DynFlags -> Name -> (OccName -> OccName) -> RdrName\n-- ^ Make a top-level binder name for an auxiliary binding for a parent name\n-- See Note [Auxiliary binders]\nmkAuxBinderName dflags parent occ_fun\n  = mkRdrUnqual (occ_fun stable_parent_occ)\n  where\n    stable_parent_occ = mkOccName (occNameSpace parent_occ) stable_string\n    stable_string\n      | hasPprDebug dflags = parent_stable\n      | otherwise          = parent_stable_hash\n    parent_stable = nameStableString parent\n    parent_stable_hash =\n      let Fingerprint high low = fingerprintString parent_stable\n      in toBase62 high ++ toBase62Padded low\n      -- See Note [Base 62 encoding 128-bit integers] in Encoding\n    parent_occ  = nameOccName parent\n\n\n{-\nNote [Auxiliary binders]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWe often want to make a top-level auxiliary binding.  E.g. for comparison we haev\n\n  instance Ord T where\n    compare a b = $con2tag a `compare` $con2tag b\n\n  $con2tag :: T -> Int\n  $con2tag = ...code....\n\nOf course these top-level bindings should all have distinct name, and we are\ngenerating RdrNames here.  We can't just use the TyCon or DataCon to distinguish\nbecause with standalone deriving two imported TyCons might both be called T!\n(See Trac #7947.)\n\nSo we use package name, module name and the name of the parent\n(T in this example) as part of the OccName we generate for the new binding.\nTo make the symbol names short we take a base62 hash of the full name.\n\nIn the past we used the *unique* from the parent, but that's not stable across\nrecompilations as uniques are nondeterministic.\n-}\n", "num_lines": 2437}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2011\n\n\nThe deriving code for the Functor, Foldable, and Traversable classes\n(equivalent to the code in TcGenDeriv, for other classes)\n-}\n\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule TcGenFunctor (\n        FFoldType(..), functorLikeTraverse,\n        deepSubtypesContaining, foldDataConArgs,\n\n        gen_Functor_binds, gen_Foldable_binds, gen_Traversable_binds\n    ) where\n\nimport GhcPrelude\n\nimport Bag\nimport DataCon\nimport FastString\nimport HsSyn\nimport Panic\nimport PrelNames\nimport RdrName\nimport SrcLoc\nimport State\nimport TcGenDeriv\nimport TcType\nimport TyCon\nimport TyCoRep\nimport Type\nimport Util\nimport Var\nimport VarSet\nimport MkId (coerceId)\nimport TysWiredIn (true_RDR, false_RDR)\n\nimport Data.Maybe (catMaybes, isJust)\n\n{-\n************************************************************************\n*                                                                      *\n                        Functor instances\n\n see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html\n\n*                                                                      *\n************************************************************************\n\nFor the data type:\n\n  data T a = T1 Int a | T2 (T a)\n\nWe generate the instance:\n\n  instance Functor T where\n      fmap f (T1 b1 a) = T1 b1 (f a)\n      fmap f (T2 ta)   = T2 (fmap f ta)\n\nNotice that we don't simply apply 'fmap' to the constructor arguments.\nRather\n  - Do nothing to an argument whose type doesn't mention 'a'\n  - Apply 'f' to an argument of type 'a'\n  - Apply 'fmap f' to other arguments\nThat's why we have to recurse deeply into the constructor argument types,\nrather than just one level, as we typically do.\n\nWhat about types with more than one type parameter?  In general, we only\nderive Functor for the last position:\n\n  data S a b = S1 [b] | S2 (a, T a b)\n  instance Functor (S a) where\n    fmap f (S1 bs)    = S1 (fmap f bs)\n    fmap f (S2 (p,q)) = S2 (a, fmap f q)\n\nHowever, we have special cases for\n         - tuples\n         - functions\n\nMore formally, we write the derivation of fmap code over type variable\n'a for type 'b as ($fmap 'a 'b).  In this general notation the derived\ninstance for T is:\n\n  instance Functor T where\n      fmap f (T1 x1 x2) = T1 ($(fmap 'a 'b1) x1) ($(fmap 'a 'a) x2)\n      fmap f (T2 x1)    = T2 ($(fmap 'a '(T a)) x1)\n\n  $(fmap 'a 'b)          =  \\x -> x     -- when b does not contain a\n  $(fmap 'a 'a)          =  f\n  $(fmap 'a '(b1,b2))    =  \\x -> case x of (x1,x2) -> ($(fmap 'a 'b1) x1, $(fmap 'a 'b2) x2)\n  $(fmap 'a '(T b1 b2))  =  fmap $(fmap 'a 'b2)   -- when a only occurs in the last parameter, b2\n  $(fmap 'a '(b -> c))   =  \\x b -> $(fmap 'a' 'c) (x ($(cofmap 'a 'b) b))\n\nFor functions, the type parameter 'a can occur in a contravariant position,\nwhich means we need to derive a function like:\n\n  cofmap :: (a -> b) -> (f b -> f a)\n\nThis is pretty much the same as $fmap, only without the $(cofmap 'a 'a) case:\n\n  $(cofmap 'a 'b)          =  \\x -> x     -- when b does not contain a\n  $(cofmap 'a 'a)          =  error \"type variable in contravariant position\"\n  $(cofmap 'a '(b1,b2))    =  \\x -> case x of (x1,x2) -> ($(cofmap 'a 'b1) x1, $(cofmap 'a 'b2) x2)\n  $(cofmap 'a '[b])        =  map $(cofmap 'a 'b)\n  $(cofmap 'a '(T b1 b2))  =  fmap $(cofmap 'a 'b2)   -- when a only occurs in the last parameter, b2\n  $(cofmap 'a '(b -> c))   =  \\x b -> $(cofmap 'a' 'c) (x ($(fmap 'a 'c) b))\n\nNote that the code produced by $(fmap _ _) is always a higher order function,\nwith type `(a -> b) -> (g a -> g b)` for some g. When we need to do pattern\nmatching on the type, this means create a lambda function (see the (,) case above).\nThe resulting code for fmap can look a bit weird, for example:\n\n  data X a = X (a,Int)\n  -- generated instance\n  instance Functor X where\n      fmap f (X x) = (\\y -> case y of (x1,x2) -> X (f x1, (\\z -> z) x2)) x\n\nThe optimizer should be able to simplify this code by simple inlining.\n\nAn older version of the deriving code tried to avoid these applied\nlambda functions by producing a meta level function. But the function to\nbe mapped, `f`, is a function on the code level, not on the meta level,\nso it was eta expanded to `\\x -> [| f $x |]`. This resulted in too much eta expansion.\nIt is better to produce too many lambdas than to eta expand, see ticket #7436.\n-}\n\ngen_Functor_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)\n-- When the argument is phantom, we can use  fmap _ = coerce\n-- See Note [Phantom types with Functor, Foldable, and Traversable]\ngen_Functor_binds loc tycon\n  | Phantom <- last (tyConRoles tycon)\n  = (unitBag fmap_bind, emptyBag)\n  where\n    fmap_name = L loc fmap_RDR\n    fmap_bind = mkRdrFunBind fmap_name fmap_eqns\n    fmap_eqns = [mkSimpleMatch fmap_match_ctxt\n                               [nlWildPat]\n                               coerce_Expr]\n    fmap_match_ctxt = mkPrefixFunRhs fmap_name\n\ngen_Functor_binds loc tycon\n  = (listToBag [fmap_bind, replace_bind], emptyBag)\n  where\n    data_cons = tyConDataCons tycon\n    fmap_name = L loc fmap_RDR\n\n    -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]\n    fmap_bind = mkRdrFunBindEC 2 id fmap_name fmap_eqns\n    fmap_match_ctxt = mkPrefixFunRhs fmap_name\n\n    fmap_eqn con = flip evalState bs_RDRs $\n                     match_for_con fmap_match_ctxt [f_Pat] con =<< parts\n      where\n        parts = sequence $ foldDataConArgs ft_fmap con\n\n    fmap_eqns = map fmap_eqn data_cons\n\n    ft_fmap :: FFoldType (State [RdrName] (LHsExpr GhcPs))\n    ft_fmap = FT { ft_triv = mkSimpleLam $ \\x -> return x\n                   -- fmap f = \\x -> x\n                 , ft_var  = return f_Expr\n                   -- fmap f = f\n                 , ft_fun  = \\g h -> do\n                     gg <- g\n                     hh <- h\n                     mkSimpleLam2 $ \\x b -> return $\n                       nlHsApp hh (nlHsApp x (nlHsApp gg b))\n                   -- fmap f = \\x b -> h (x (g b))\n                 , ft_tup = \\t gs -> do\n                     gg <- sequence gs\n                     mkSimpleLam $ mkSimpleTupleCase (match_for_con CaseAlt) t gg\n                   -- fmap f = \\x -> case x of (a1,a2,..) -> (g1 a1,g2 a2,..)\n                 , ft_ty_app = \\_ g -> nlHsApp fmap_Expr <$> g\n                   -- fmap f = fmap g\n                 , ft_forall = \\_ g -> g\n                 , ft_bad_app = panic \"in other argument in ft_fmap\"\n                 , ft_co_var = panic \"contravariant in ft_fmap\" }\n\n    -- See Note [Deriving <$]\n    replace_name = L loc replace_RDR\n\n    -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]\n    replace_bind = mkRdrFunBindEC 2 id replace_name replace_eqns\n    replace_match_ctxt = mkPrefixFunRhs replace_name\n\n    replace_eqn con = flip evalState bs_RDRs $\n        match_for_con replace_match_ctxt [z_Pat] con =<< parts\n      where\n        parts = traverse (fmap replace) $ foldDataConArgs ft_replace con\n\n    replace_eqns = map replace_eqn data_cons\n\n    ft_replace :: FFoldType (State [RdrName] Replacer)\n    ft_replace = FT { ft_triv = fmap Nested $ mkSimpleLam $ \\x -> return x\n                   -- (p <$) = \\x -> x\n                 , ft_var  = fmap Immediate $ mkSimpleLam $ \\_ -> return z_Expr\n                   -- (p <$) = const p\n                 , ft_fun  = \\g h -> do\n                     gg <- replace <$> g\n                     hh <- replace <$> h\n                     fmap Nested $ mkSimpleLam2 $ \\x b -> return $\n                       nlHsApp hh (nlHsApp x (nlHsApp gg b))\n                   -- (<$) p = \\x b -> h (x (g b))\n                 , ft_tup = \\t gs -> do\n                     gg <- traverse (fmap replace) gs\n                     fmap Nested . mkSimpleLam $\n                          mkSimpleTupleCase (match_for_con CaseAlt) t gg\n                   -- (p <$) = \\x -> case x of (a1,a2,..) -> (g1 a1,g2 a2,..)\n                 , ft_ty_app = \\_ gm -> do\n                       g <- gm\n                       case g of\n                         Nested g' -> pure . Nested $\n                                          nlHsApp fmap_Expr $ g'\n                         Immediate _ -> pure . Nested $\n                                          nlHsApp replace_Expr z_Expr\n                   -- (p <$) = fmap (p <$)\n                 , ft_forall = \\_ g -> g\n                 , ft_bad_app = panic \"in other argument in ft_replace\"\n                 , ft_co_var = panic \"contravariant in ft_replace\" }\n\n    -- Con a1 a2 ... -> Con (f1 a1) (f2 a2) ...\n    match_for_con :: HsMatchContext RdrName\n                  -> [LPat GhcPs] -> DataCon -> [LHsExpr GhcPs]\n                  -> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))\n    match_for_con ctxt = mkSimpleConMatch ctxt $\n        \\con_name xs -> return $ nlHsApps con_name xs  -- Con x1 x2 ..\n\n-- See Note [Deriving <$]\ndata Replacer = Immediate {replace :: LHsExpr GhcPs}\n              | Nested {replace :: LHsExpr GhcPs}\n\n{- Note [Deriving <$]\n   ~~~~~~~~~~~~~~~~~~\n\nWe derive the definition of <$. Allowing this to take the default definition\ncan lead to memory leaks: mapping over a structure with a constant function can\nfill the result structure with trivial thunks that retain the values from the\noriginal structure. The simplifier seems to handle this all right for simple\ntypes, but not for recursive ones. Consider\n\ndata Tree a = Bin !(Tree a) a !(Tree a) | Tip deriving Functor\n\n-- fmap _ Tip = Tip\n-- fmap f (Bin l v r) = Bin (fmap f l) (f v) (fmap f r)\n\nUsing the default definition of <$, we get (<$) x = fmap (\\_ -> x) and that\nsimplifies no further. Why is that? `fmap` is defined recursively, so GHC\ncannot inline it. The static argument transformation would turn the definition\ninto a non-recursive one\n\n-- fmap f = go where\n--   go Tip = Tip\n--   go (Bin l v r) = Bin (go l) (f v) (go r)\n\nwhich GHC could inline, producing an efficient definion of `<$`. But there are\nseveral problems. First, GHC does not perform the static argument transformation\nby default, even with -O2. Second, even when it does perform the static argument\ntransformation, it does so only when there are at least two static arguments,\nwhich is not the case for fmap. Finally, when the type in question is\nnon-regular, such as\n\ndata Nesty a = Z a | S (Nesty a) (Nest (a, a))\n\nthe function argument is no longer (entirely) static, so the static argument\ntransformation will do nothing for us.\n\nApplying the default definition of `<$` will produce a tree full of thunks that\nlook like ((\\_ -> x) x0), which represents unnecessary thunk allocation and\nalso retention of the previous value, potentially leaking memory. Instead, we\nderive <$ separately. Two aspects are different from fmap: the case of the\nsought type variable (ft_var) and the case of a type application (ft_ty_app).\nThe interesting one is ft_ty_app. We have to distinguish two cases: the\n\"immediate\" case where the type argument *is* the sought type variable, and\nthe \"nested\" case where the type argument *contains* the sought type variable.\n\nThe immediate case:\n\nSuppose we have\n\ndata Imm a = Imm (F ... a)\n\nThen we want to define\n\nx <$ Imm q = Imm (x <$ q)\n\nThe nested case:\n\nSuppose we have\n\ndata Nes a = Nes (F ... (G a))\n\nThen we want to define\n\nx <$ Nes q = Nes (fmap (x <$) q)\n\nWe use the Replacer type to tag whether the expression derived for applying\n<$ to the last type variable was the ft_var case (immediate) or one of the\nothers (letting ft_forall pass through as usual).\n\nWe could, but do not, give tuples special treatment to improve efficiency\nin some cases. Suppose we have\n\ndata Nest a = Z a | S (Nest (a,a))\n\nThe optimal definition would be\n\nx <$ Z _ = Z x\nx <$ S t = S ((x, x) <$ t)\n\nwhich produces a result with maximal internal sharing. The reason we do not\nattempt to treat this case specially is that we have no way to give\nuser-provided tuple-like types similar treatment. If the user changed the\ndefinition to\n\ndata Pair a = Pair a a\ndata Nest a = Z a | S (Nest (Pair a))\n\nthey would experience a surprising degradation in performance. -}\n\n\n{-\nUtility functions related to Functor deriving.\n\nSince several things use the same pattern of traversal, this is abstracted into functorLikeTraverse.\nThis function works like a fold: it makes a value of type 'a' in a bottom up way.\n-}\n\n-- Generic traversal for Functor deriving\n-- See Note [FFoldType and functorLikeTraverse]\ndata FFoldType a      -- Describes how to fold over a Type in a functor like way\n   = FT { ft_triv    :: a\n          -- ^ Does not contain variable\n        , ft_var     :: a\n          -- ^ The variable itself\n        , ft_co_var  :: a\n          -- ^ The variable itself, contravariantly\n        , ft_fun     :: a -> a -> a\n          -- ^ Function type\n        , ft_tup     :: TyCon -> [a] -> a\n          -- ^ Tuple type\n        , ft_ty_app  :: Type -> a -> a\n          -- ^ Type app, variable only in last argument\n        , ft_bad_app :: a\n          -- ^ Type app, variable other than in last argument\n        , ft_forall  :: TcTyVar -> a -> a\n          -- ^ Forall type\n     }\n\nfunctorLikeTraverse :: forall a.\n                       TyVar         -- ^ Variable to look for\n                    -> FFoldType a   -- ^ How to fold\n                    -> Type          -- ^ Type to process\n                    -> a\nfunctorLikeTraverse var (FT { ft_triv = caseTrivial,     ft_var = caseVar\n                            , ft_co_var = caseCoVar,     ft_fun = caseFun\n                            , ft_tup = caseTuple,        ft_ty_app = caseTyApp\n                            , ft_bad_app = caseWrongArg, ft_forall = caseForAll })\n                    ty\n  = fst (go False ty)\n  where\n    go :: Bool        -- Covariant or contravariant context\n       -> Type\n       -> (a, Bool)   -- (result of type a, does type contain var)\n\n    go co ty | Just ty' <- tcView ty = go co ty'\n    go co (TyVarTy    v) | v == var = (if co then caseCoVar else caseVar,True)\n    go co (FunTy { ft_arg = x, ft_res = y, ft_af = af })\n       | InvisArg <- af = go co y\n       | xc || yc       = (caseFun xr yr,True)\n       where (xr,xc) = go (not co) x\n             (yr,yc) = go co       y\n    go co (AppTy    x y) | xc = (caseWrongArg,   True)\n                         | yc = (caseTyApp x yr, True)\n        where (_, xc) = go co x\n              (yr,yc) = go co y\n    go co ty@(TyConApp con args)\n       | not (or xcs)     = (caseTrivial, False)   -- Variable does not occur\n       -- At this point we know that xrs, xcs is not empty,\n       -- and at least one xr is True\n       | isTupleTyCon con = (caseTuple con xrs, True)\n       | or (init xcs)    = (caseWrongArg, True)         -- T (..var..)    ty\n       | Just (fun_ty, _) <- splitAppTy_maybe ty         -- T (..no var..) ty\n                          = (caseTyApp fun_ty (last xrs), True)\n       | otherwise        = (caseWrongArg, True)   -- Non-decomposable (eg type function)\n       where\n         -- When folding over an unboxed tuple, we must explicitly drop the\n         -- runtime rep arguments, or else GHC will generate twice as many\n         -- variables in a unboxed tuple pattern match and expression as it\n         -- actually needs. See Trac #12399\n         (xrs,xcs) = unzip (map (go co) (dropRuntimeRepArgs args))\n    go co (ForAllTy (Bndr v vis) x)\n       | isVisibleArgFlag vis = panic \"unexpected visible binder\"\n       | v /= var && xc       = (caseForAll v xr,True)\n       where (xr,xc) = go co x\n\n    go _ _ = (caseTrivial,False)\n\n-- Return all syntactic subterms of ty that contain var somewhere\n-- These are the things that should appear in instance constraints\ndeepSubtypesContaining :: TyVar -> Type -> [TcType]\ndeepSubtypesContaining tv\n  = functorLikeTraverse tv\n        (FT { ft_triv = []\n            , ft_var = []\n            , ft_fun = (++)\n            , ft_tup = \\_ xs -> concat xs\n            , ft_ty_app = (:)\n            , ft_bad_app = panic \"in other argument in deepSubtypesContaining\"\n            , ft_co_var = panic \"contravariant in deepSubtypesContaining\"\n            , ft_forall = \\v xs -> filterOut ((v `elemVarSet`) . tyCoVarsOfType) xs })\n\n\nfoldDataConArgs :: FFoldType a -> DataCon -> [a]\n-- Fold over the arguments of the datacon\nfoldDataConArgs ft con\n  = map foldArg (dataConOrigArgTys con)\n  where\n    foldArg\n      = case getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con))) of\n             Just tv -> functorLikeTraverse tv ft\n             Nothing -> const (ft_triv ft)\n    -- If we are deriving Foldable for a GADT, there is a chance that the last\n    -- type variable in the data type isn't actually a type variable at all.\n    -- (for example, this can happen if the last type variable is refined to\n    -- be a concrete type such as Int). If the last type variable is refined\n    -- to be a specific type, then getTyVar_maybe will return Nothing.\n    -- See Note [DeriveFoldable with ExistentialQuantification]\n    --\n    -- The kind checks have ensured the last type parameter is of kind *.\n\n-- Make a HsLam using a fresh variable from a State monad\nmkSimpleLam :: (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs))\n            -> State [RdrName] (LHsExpr GhcPs)\n-- (mkSimpleLam fn) returns (\\x. fn(x))\nmkSimpleLam lam =\n    get >>= \\case\n      n:names -> do\n        put names\n        body <- lam (nlHsVar n)\n        return (mkHsLam [nlVarPat n] body)\n      _ -> panic \"mkSimpleLam\"\n\nmkSimpleLam2 :: (LHsExpr GhcPs -> LHsExpr GhcPs\n             -> State [RdrName] (LHsExpr GhcPs))\n             -> State [RdrName] (LHsExpr GhcPs)\nmkSimpleLam2 lam =\n    get >>= \\case\n      n1:n2:names -> do\n        put names\n        body <- lam (nlHsVar n1) (nlHsVar n2)\n        return (mkHsLam [nlVarPat n1,nlVarPat n2] body)\n      _ -> panic \"mkSimpleLam2\"\n\n-- \"Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]\"\n--\n-- @mkSimpleConMatch fold extra_pats con insides@ produces a match clause in\n-- which the LHS pattern-matches on @extra_pats@, followed by a match on the\n-- constructor @con@ and its arguments. The RHS folds (with @fold@) over @con@\n-- and its arguments, applying an expression (from @insides@) to each of the\n-- respective arguments of @con@.\nmkSimpleConMatch :: Monad m => HsMatchContext RdrName\n                 -> (RdrName -> [LHsExpr GhcPs] -> m (LHsExpr GhcPs))\n                 -> [LPat GhcPs]\n                 -> DataCon\n                 -> [LHsExpr GhcPs]\n                 -> m (LMatch GhcPs (LHsExpr GhcPs))\nmkSimpleConMatch ctxt fold extra_pats con insides = do\n    let con_name = getRdrName con\n    let vars_needed = takeList insides as_RDRs\n    let bare_pat = nlConVarPat con_name vars_needed\n    let pat = if null vars_needed\n          then bare_pat\n          else nlParPat bare_pat\n    rhs <- fold con_name\n                (zipWith (\\i v -> i `nlHsApp` nlHsVar v) insides vars_needed)\n    return $ mkMatch ctxt (extra_pats ++ [pat]) rhs\n                     (noLoc emptyLocalBinds)\n\n-- \"Con a1 a2 a3 -> fmap (\\b2 -> Con a1 b2 a3) (traverse f a2)\"\n--\n-- @mkSimpleConMatch2 fold extra_pats con insides@ behaves very similarly to\n-- 'mkSimpleConMatch', with two key differences:\n--\n-- 1. @insides@ is a @[Maybe (LHsExpr RdrName)]@ instead of a\n--    @[LHsExpr RdrName]@. This is because it filters out the expressions\n--    corresponding to arguments whose types do not mention the last type\n--    variable in a derived 'Foldable' or 'Traversable' instance (i.e., the\n--    'Nothing' elements of @insides@).\n--\n-- 2. @fold@ takes an expression as its first argument instead of a\n--    constructor name. This is because it uses a specialized\n--    constructor function expression that only takes as many parameters as\n--    there are argument types that mention the last type variable.\n--\n-- See Note [Generated code for DeriveFoldable and DeriveTraversable]\nmkSimpleConMatch2 :: Monad m\n                  => HsMatchContext RdrName\n                  -> (LHsExpr GhcPs -> [LHsExpr GhcPs]\n                                      -> m (LHsExpr GhcPs))\n                  -> [LPat GhcPs]\n                  -> DataCon\n                  -> [Maybe (LHsExpr GhcPs)]\n                  -> m (LMatch GhcPs (LHsExpr GhcPs))\nmkSimpleConMatch2 ctxt fold extra_pats con insides = do\n    let con_name = getRdrName con\n        vars_needed = takeList insides as_RDRs\n        pat = nlConVarPat con_name vars_needed\n        -- Make sure to zip BEFORE invoking catMaybes. We want the variable\n        -- indicies in each expression to match up with the argument indices\n        -- in con_expr (defined below).\n        exps = catMaybes $ zipWith (\\i v -> (`nlHsApp` nlHsVar v) <$> i)\n                                   insides vars_needed\n        -- An element of argTysTyVarInfo is True if the constructor argument\n        -- with the same index has a type which mentions the last type\n        -- variable.\n        argTysTyVarInfo = map isJust insides\n        (asWithTyVar, asWithoutTyVar) = partitionByList argTysTyVarInfo as_Vars\n\n        con_expr\n          | null asWithTyVar = nlHsApps con_name asWithoutTyVar\n          | otherwise =\n              let bs   = filterByList  argTysTyVarInfo bs_RDRs\n                  vars = filterByLists argTysTyVarInfo bs_Vars as_Vars\n              in mkHsLam (map nlVarPat bs) (nlHsApps con_name vars)\n\n    rhs <- fold con_expr exps\n    return $ mkMatch ctxt (extra_pats ++ [pat]) rhs\n                     (noLoc emptyLocalBinds)\n\n-- \"case x of (a1,a2,a3) -> fold [x1 a1, x2 a2, x3 a3]\"\nmkSimpleTupleCase :: Monad m => ([LPat GhcPs] -> DataCon -> [a]\n                                 -> m (LMatch GhcPs (LHsExpr GhcPs)))\n                  -> TyCon -> [a] -> LHsExpr GhcPs -> m (LHsExpr GhcPs)\nmkSimpleTupleCase match_for_con tc insides x\n  = do { let data_con = tyConSingleDataCon tc\n       ; match <- match_for_con [] data_con insides\n       ; return $ nlHsCase x [match] }\n\n{-\n************************************************************************\n*                                                                      *\n                        Foldable instances\n\n see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html\n\n*                                                                      *\n************************************************************************\n\nDeriving Foldable instances works the same way as Functor instances,\nonly Foldable instances are not possible for function types at all.\nGiven (data T a = T a a (T a) deriving Foldable), we get:\n\n  instance Foldable T where\n      foldr f z (T x1 x2 x3) =\n        $(foldr 'a 'a) x1 ( $(foldr 'a 'a) x2 ( $(foldr 'a '(T a)) x3 z ) )\n\n-XDeriveFoldable is different from -XDeriveFunctor in that it filters out\narguments to the constructor that would produce useless code in a Foldable\ninstance. For example, the following datatype:\n\n  data Foo a = Foo Int a Int deriving Foldable\n\nwould have the following generated Foldable instance:\n\n  instance Foldable Foo where\n    foldr f z (Foo x1 x2 x3) = $(foldr 'a 'a) x2\n\nsince neither of the two Int arguments are folded over.\n\nThe cases are:\n\n  $(foldr 'a 'a)         =  f\n  $(foldr 'a '(b1,b2))   =  \\x z -> case x of (x1,x2) -> $(foldr 'a 'b1) x1 ( $(foldr 'a 'b2) x2 z )\n  $(foldr 'a '(T b1 b2)) =  \\x z -> foldr $(foldr 'a 'b2) z x  -- when a only occurs in the last parameter, b2\n\nNote that the arguments to the real foldr function are the wrong way around,\nsince (f :: a -> b -> b), while (foldr f :: b -> t a -> b).\n\nOne can envision a case for types that don't contain the last type variable:\n\n  $(foldr 'a 'b)         =  \\x z -> z     -- when b does not contain a\n\nBut this case will never materialize, since the aforementioned filtering\nremoves all such types from consideration.\nSee Note [Generated code for DeriveFoldable and DeriveTraversable].\n\nFoldable instances differ from Functor and Traversable instances in that\nFoldable instances can be derived for data types in which the last type\nvariable is existentially quantified. In particular, if the last type variable\nis refined to a more specific type in a GADT:\n\n  data GADT a where\n      G :: a ~ Int => a -> G Int\n\nthen the deriving machinery does not attempt to check that the type a contains\nInt, since it is not syntactically equal to a type variable. That is, the\nderived Foldable instance for GADT is:\n\n  instance Foldable GADT where\n      foldr _ z (GADT _) = z\n\nSee Note [DeriveFoldable with ExistentialQuantification].\n\nNote [Deriving null]\n~~~~~~~~~~~~~~~~~~~~\n\nIn some cases, deriving the definition of 'null' can produce much better\nresults than the default definition. For example, with\n\n  data SnocList a = Nil | Snoc (SnocList a) a\n\nthe default definition of 'null' would walk the entire spine of a\nnonempty snoc-list before concluding that it is not null. But looking at\nthe Snoc constructor, we can immediately see that it contains an 'a', and\nso 'null' can return False immediately if it matches on Snoc. When we\nderive 'null', we keep track of things that cannot be null. The interesting\ncase is type application. Given\n\n  data Wrap a = Wrap (Foo (Bar a))\n\nwe use\n\n  null (Wrap fba) = all null fba\n\nbut if we see\n\n  data Wrap a = Wrap (Foo a)\n\nwe can just use\n\n  null (Wrap fa) = null fa\n\nIndeed, we allow this to happen even for tuples:\n\n  data Wrap a = Wrap (Foo (a, Int))\n\nproduces\n\n  null (Wrap fa) = null fa\n\nAs explained in Note [Deriving <$], giving tuples special performance treatment\ncould surprise users if they switch to other types, but Ryan Scott seems to\nthink it's okay to do it for now.\n-}\n\ngen_Foldable_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)\n-- When the parameter is phantom, we can use foldMap _ _ = mempty\n-- See Note [Phantom types with Functor, Foldable, and Traversable]\ngen_Foldable_binds loc tycon\n  | Phantom <- last (tyConRoles tycon)\n  = (unitBag foldMap_bind, emptyBag)\n  where\n    foldMap_name = L loc foldMap_RDR\n    foldMap_bind = mkRdrFunBind foldMap_name foldMap_eqns\n    foldMap_eqns = [mkSimpleMatch foldMap_match_ctxt\n                                  [nlWildPat, nlWildPat]\n                                  mempty_Expr]\n    foldMap_match_ctxt = mkPrefixFunRhs foldMap_name\n\ngen_Foldable_binds loc tycon\n  | null data_cons  -- There's no real point producing anything but\n                    -- foldMap for a type with no constructors.\n  = (unitBag foldMap_bind, emptyBag)\n\n  | otherwise\n  = (listToBag [foldr_bind, foldMap_bind, null_bind], emptyBag)\n  where\n    data_cons = tyConDataCons tycon\n\n    foldr_bind = mkRdrFunBind (L loc foldable_foldr_RDR) eqns\n    eqns = map foldr_eqn data_cons\n    foldr_eqn con\n      = evalState (match_foldr z_Expr [f_Pat,z_Pat] con =<< parts) bs_RDRs\n      where\n        parts = sequence $ foldDataConArgs ft_foldr con\n\n    foldMap_name = L loc foldMap_RDR\n\n    -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]\n    foldMap_bind = mkRdrFunBindEC 2 (const mempty_Expr)\n                      foldMap_name foldMap_eqns\n\n    foldMap_eqns = map foldMap_eqn data_cons\n\n    foldMap_eqn con\n      = evalState (match_foldMap [f_Pat] con =<< parts) bs_RDRs\n      where\n        parts = sequence $ foldDataConArgs ft_foldMap con\n\n    -- Given a list of NullM results, produce Nothing if any of\n    -- them is NotNull, and otherwise produce a list of Maybes\n    -- with Justs representing unknowns and Nothings representing\n    -- things that are definitely null.\n    convert :: [NullM a] -> Maybe [Maybe a]\n    convert = traverse go where\n      go IsNull = Just Nothing\n      go NotNull = Nothing\n      go (NullM a) = Just (Just a)\n\n    null_name = L loc null_RDR\n    null_match_ctxt = mkPrefixFunRhs null_name\n    null_bind = mkRdrFunBind null_name null_eqns\n    null_eqns = map null_eqn data_cons\n    null_eqn con\n      = flip evalState bs_RDRs $ do\n          parts <- sequence $ foldDataConArgs ft_null con\n          case convert parts of\n            Nothing -> return $\n              mkMatch null_match_ctxt [nlParPat (nlWildConPat con)]\n                false_Expr (noLoc emptyLocalBinds)\n            Just cp -> match_null [] con cp\n\n    -- Yields 'Just' an expression if we're folding over a type that mentions\n    -- the last type parameter of the datatype. Otherwise, yields 'Nothing'.\n    -- See Note [FFoldType and functorLikeTraverse]\n    ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))\n    ft_foldr\n      = FT { ft_triv    = return Nothing\n             -- foldr f = \\x z -> z\n           , ft_var     = return $ Just f_Expr\n             -- foldr f = f\n           , ft_tup     = \\t g -> do\n               gg  <- sequence g\n               lam <- mkSimpleLam2 $ \\x z ->\n                 mkSimpleTupleCase (match_foldr z) t gg x\n               return (Just lam)\n             -- foldr f = (\\x z -> case x of ...)\n           , ft_ty_app  = \\_ g -> do\n               gg <- g\n               mapM (\\gg' -> mkSimpleLam2 $ \\x z -> return $\n                 nlHsApps foldable_foldr_RDR [gg',z,x]) gg\n             -- foldr f = (\\x z -> foldr g z x)\n           , ft_forall  = \\_ g -> g\n           , ft_co_var  = panic \"contravariant in ft_foldr\"\n           , ft_fun     = panic \"function in ft_foldr\"\n           , ft_bad_app = panic \"in other argument in ft_foldr\" }\n\n    match_foldr :: LHsExpr GhcPs\n                -> [LPat GhcPs]\n                -> DataCon\n                -> [Maybe (LHsExpr GhcPs)]\n                -> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))\n    match_foldr z = mkSimpleConMatch2 LambdaExpr $ \\_ xs -> return (mkFoldr xs)\n      where\n        -- g1 v1 (g2 v2 (.. z))\n        mkFoldr :: [LHsExpr GhcPs] -> LHsExpr GhcPs\n        mkFoldr = foldr nlHsApp z\n\n    -- See Note [FFoldType and functorLikeTraverse]\n    ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))\n    ft_foldMap\n      = FT { ft_triv = return Nothing\n             -- foldMap f = \\x -> mempty\n           , ft_var  = return (Just f_Expr)\n             -- foldMap f = f\n           , ft_tup  = \\t g -> do\n               gg  <- sequence g\n               lam <- mkSimpleLam $ mkSimpleTupleCase match_foldMap t gg\n               return (Just lam)\n             -- foldMap f = \\x -> case x of (..,)\n           , ft_ty_app = \\_ g -> fmap (nlHsApp foldMap_Expr) <$> g\n             -- foldMap f = foldMap g\n           , ft_forall = \\_ g -> g\n           , ft_co_var = panic \"contravariant in ft_foldMap\"\n           , ft_fun = panic \"function in ft_foldMap\"\n           , ft_bad_app = panic \"in other argument in ft_foldMap\" }\n\n    match_foldMap :: [LPat GhcPs]\n                  -> DataCon\n                  -> [Maybe (LHsExpr GhcPs)]\n                  -> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))\n    match_foldMap = mkSimpleConMatch2 CaseAlt $ \\_ xs -> return (mkFoldMap xs)\n      where\n        -- mappend v1 (mappend v2 ..)\n        mkFoldMap :: [LHsExpr GhcPs] -> LHsExpr GhcPs\n        mkFoldMap [] = mempty_Expr\n        mkFoldMap xs = foldr1 (\\x y -> nlHsApps mappend_RDR [x,y]) xs\n\n    -- See Note [FFoldType and functorLikeTraverse]\n    -- Yields NullM an expression if we're folding over an expression\n    -- that may or may not be null. Yields IsNull if it's certainly\n    -- null, and yields NotNull if it's certainly not null.\n    -- See Note [Deriving null]\n    ft_null :: FFoldType (State [RdrName] (NullM (LHsExpr GhcPs)))\n    ft_null\n      = FT { ft_triv = return IsNull\n             -- null = \\_ -> True\n           , ft_var  = return NotNull\n             -- null = \\_ -> False\n           , ft_tup  = \\t g -> do\n               gg  <- sequence g\n               case convert gg of\n                 Nothing -> pure NotNull\n                 Just ggg ->\n                   NullM <$> (mkSimpleLam $ mkSimpleTupleCase match_null t ggg)\n             -- null = \\x -> case x of (..,)\n           , ft_ty_app = \\_ g -> flip fmap g $ \\nestedResult ->\n                              case nestedResult of\n                                -- If e definitely contains the parameter,\n                                -- then we can test if (G e) contains it by\n                                -- simply checking if (G e) is null\n                                NotNull -> NullM null_Expr\n                                -- This case is unreachable--it will actually be\n                                -- caught by ft_triv\n                                IsNull -> IsNull\n                                -- The general case uses (all null),\n                                -- (all (all null)), etc.\n                                NullM nestedTest -> NullM $\n                                                    nlHsApp all_Expr nestedTest\n             -- null fa = null fa, or null fa = all null fa, or null fa = True\n           , ft_forall = \\_ g -> g\n           , ft_co_var = panic \"contravariant in ft_null\"\n           , ft_fun = panic \"function in ft_null\"\n           , ft_bad_app = panic \"in other argument in ft_null\" }\n\n    match_null :: [LPat GhcPs]\n                  -> DataCon\n                  -> [Maybe (LHsExpr GhcPs)]\n                  -> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))\n    match_null = mkSimpleConMatch2 CaseAlt $ \\_ xs -> return (mkNull xs)\n      where\n        -- v1 && v2 && ..\n        mkNull :: [LHsExpr GhcPs] -> LHsExpr GhcPs\n        mkNull [] = true_Expr\n        mkNull xs = foldr1 (\\x y -> nlHsApps and_RDR [x,y]) xs\n\ndata NullM a =\n    IsNull   -- Definitely null\n  | NotNull  -- Definitely not null\n  | NullM a  -- Unknown\n\n{-\n************************************************************************\n*                                                                      *\n                        Traversable instances\n\n see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html\n*                                                                      *\n************************************************************************\n\nAgain, Traversable is much like Functor and Foldable.\n\nThe cases are:\n\n  $(traverse 'a 'a)          =  f\n  $(traverse 'a '(b1,b2))    =  \\x -> case x of (x1,x2) ->\n     liftA2 (,) ($(traverse 'a 'b1) x1) ($(traverse 'a 'b2) x2)\n  $(traverse 'a '(T b1 b2))  =  traverse $(traverse 'a 'b2)  -- when a only occurs in the last parameter, b2\n\nLike -XDeriveFoldable, -XDeriveTraversable filters out arguments whose types\ndo not mention the last type parameter. Therefore, the following datatype:\n\n  data Foo a = Foo Int a Int\n\nwould have the following derived Traversable instance:\n\n  instance Traversable Foo where\n    traverse f (Foo x1 x2 x3) =\n      fmap (\\b2 -> Foo x1 b2 x3) ( $(traverse 'a 'a) x2 )\n\nsince the two Int arguments do not produce any effects in a traversal.\n\nOne can envision a case for types that do not mention the last type parameter:\n\n  $(traverse 'a 'b)          =  pure     -- when b does not contain a\n\nBut this case will never materialize, since the aforementioned filtering\nremoves all such types from consideration.\nSee Note [Generated code for DeriveFoldable and DeriveTraversable].\n-}\n\ngen_Traversable_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)\n-- When the argument is phantom, we can use traverse = pure . coerce\n-- See Note [Phantom types with Functor, Foldable, and Traversable]\ngen_Traversable_binds loc tycon\n  | Phantom <- last (tyConRoles tycon)\n  = (unitBag traverse_bind, emptyBag)\n  where\n    traverse_name = L loc traverse_RDR\n    traverse_bind = mkRdrFunBind traverse_name traverse_eqns\n    traverse_eqns =\n        [mkSimpleMatch traverse_match_ctxt\n                       [nlWildPat, z_Pat]\n                       (nlHsApps pure_RDR [nlHsApp coerce_Expr z_Expr])]\n    traverse_match_ctxt = mkPrefixFunRhs traverse_name\n\ngen_Traversable_binds loc tycon\n  = (unitBag traverse_bind, emptyBag)\n  where\n    data_cons = tyConDataCons tycon\n\n    traverse_name = L loc traverse_RDR\n\n    -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]\n    traverse_bind = mkRdrFunBindEC 2 (nlHsApp pure_Expr)\n                                   traverse_name traverse_eqns\n    traverse_eqns = map traverse_eqn data_cons\n    traverse_eqn con\n      = evalState (match_for_con [f_Pat] con =<< parts) bs_RDRs\n      where\n        parts = sequence $ foldDataConArgs ft_trav con\n\n    -- Yields 'Just' an expression if we're folding over a type that mentions\n    -- the last type parameter of the datatype. Otherwise, yields 'Nothing'.\n    -- See Note [FFoldType and functorLikeTraverse]\n    ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs)))\n    ft_trav\n      = FT { ft_triv    = return Nothing\n             -- traverse f = pure x\n           , ft_var     = return (Just f_Expr)\n             -- traverse f = f x\n           , ft_tup     = \\t gs -> do\n               gg  <- sequence gs\n               lam <- mkSimpleLam $ mkSimpleTupleCase match_for_con t gg\n               return (Just lam)\n             -- traverse f = \\x -> case x of (a1,a2,..) ->\n             --                           liftA2 (,,) (g1 a1) (g2 a2) <*> ..\n           , ft_ty_app  = \\_ g -> fmap (nlHsApp traverse_Expr) <$> g\n             -- traverse f = traverse g\n           , ft_forall  = \\_ g -> g\n           , ft_co_var  = panic \"contravariant in ft_trav\"\n           , ft_fun     = panic \"function in ft_trav\"\n           , ft_bad_app = panic \"in other argument in ft_trav\" }\n\n    -- Con a1 a2 ... -> liftA2 (\\b1 b2 ... -> Con b1 b2 ...) (g1 a1)\n    --                    (g2 a2) <*> ...\n    match_for_con :: [LPat GhcPs]\n                  -> DataCon\n                  -> [Maybe (LHsExpr GhcPs)]\n                  -> State [RdrName] (LMatch GhcPs (LHsExpr GhcPs))\n    match_for_con = mkSimpleConMatch2 CaseAlt $\n                                             \\con xs -> return (mkApCon con xs)\n      where\n        -- liftA2 (\\b1 b2 ... -> Con b1 b2 ...) x1 x2 <*> ..\n        mkApCon :: LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs\n        mkApCon con [] = nlHsApps pure_RDR [con]\n        mkApCon con [x] = nlHsApps fmap_RDR [con,x]\n        mkApCon con (x1:x2:xs) =\n            foldl' appAp (nlHsApps liftA2_RDR [con,x1,x2]) xs\n          where appAp x y = nlHsApps ap_RDR [x,y]\n\n-----------------------------------------------------------------------\n\nf_Expr, z_Expr, fmap_Expr, replace_Expr, mempty_Expr, foldMap_Expr,\n    traverse_Expr, coerce_Expr, pure_Expr, true_Expr, false_Expr,\n    all_Expr, null_Expr :: LHsExpr GhcPs\nf_Expr        = nlHsVar f_RDR\nz_Expr        = nlHsVar z_RDR\nfmap_Expr     = nlHsVar fmap_RDR\nreplace_Expr  = nlHsVar replace_RDR\nmempty_Expr   = nlHsVar mempty_RDR\nfoldMap_Expr  = nlHsVar foldMap_RDR\ntraverse_Expr = nlHsVar traverse_RDR\ncoerce_Expr   = nlHsVar (getRdrName coerceId)\npure_Expr     = nlHsVar pure_RDR\ntrue_Expr     = nlHsVar true_RDR\nfalse_Expr    = nlHsVar false_RDR\nall_Expr      = nlHsVar all_RDR\nnull_Expr     = nlHsVar null_RDR\n\nf_RDR, z_RDR :: RdrName\nf_RDR = mkVarUnqual (fsLit \"f\")\nz_RDR = mkVarUnqual (fsLit \"z\")\n\nas_RDRs, bs_RDRs :: [RdrName]\nas_RDRs = [ mkVarUnqual (mkFastString (\"a\"++show i)) | i <- [(1::Int) .. ] ]\nbs_RDRs = [ mkVarUnqual (mkFastString (\"b\"++show i)) | i <- [(1::Int) .. ] ]\n\nas_Vars, bs_Vars :: [LHsExpr GhcPs]\nas_Vars = map nlHsVar as_RDRs\nbs_Vars = map nlHsVar bs_RDRs\n\nf_Pat, z_Pat :: LPat GhcPs\nf_Pat = nlVarPat f_RDR\nz_Pat = nlVarPat z_RDR\n\n{-\nNote [DeriveFoldable with ExistentialQuantification]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFunctor and Traversable instances can only be derived for data types whose\nlast type parameter is truly universally polymorphic. For example:\n\n  data T a b where\n    T1 ::                 b   -> T a b   -- YES, b is unconstrained\n    T2 :: Ord b   =>      b   -> T a b   -- NO, b is constrained by (Ord b)\n    T3 :: b ~ Int =>      b   -> T a b   -- NO, b is constrained by (b ~ Int)\n    T4 ::                 Int -> T a Int -- NO, this is just like T3\n    T5 :: Ord a   => a -> b   -> T a b   -- YES, b is unconstrained, even\n                                         -- though a is existential\n    T6 ::                 Int -> T Int b -- YES, b is unconstrained\n\nFor Foldable instances, however, we can completely lift the constraint that\nthe last type parameter be truly universally polymorphic. This means that T\n(as defined above) can have a derived Foldable instance:\n\n  instance Foldable (T a) where\n    foldr f z (T1 b)   = f b z\n    foldr f z (T2 b)   = f b z\n    foldr f z (T3 b)   = f b z\n    foldr f z (T4 b)   = z\n    foldr f z (T5 a b) = f b z\n    foldr f z (T6 a)   = z\n\n    foldMap f (T1 b)   = f b\n    foldMap f (T2 b)   = f b\n    foldMap f (T3 b)   = f b\n    foldMap f (T4 b)   = mempty\n    foldMap f (T5 a b) = f b\n    foldMap f (T6 a)   = mempty\n\nIn a Foldable instance, it is safe to fold over an occurrence of the last type\nparameter that is not truly universally polymorphic. However, there is a bit\nof subtlety in determining what is actually an occurrence of a type parameter.\nT3 and T4, as defined above, provide one example:\n\n  data T a b where\n    ...\n    T3 :: b ~ Int => b   -> T a b\n    T4 ::            Int -> T a Int\n    ...\n\n  instance Foldable (T a) where\n    ...\n    foldr f z (T3 b) = f b z\n    foldr f z (T4 b) = z\n    ...\n    foldMap f (T3 b) = f b\n    foldMap f (T4 b) = mempty\n    ...\n\nNotice that the argument of T3 is folded over, whereas the argument of T4 is\nnot. This is because we only fold over constructor arguments that\nsyntactically mention the universally quantified type parameter of that\nparticular data constructor. See foldDataConArgs for how this is implemented.\n\nAs another example, consider the following data type. The argument of each\nconstructor has the same type as the last type parameter:\n\n  data E a where\n    E1 :: (a ~ Int) => a   -> E a\n    E2 ::              Int -> E Int\n    E3 :: (a ~ Int) => a   -> E Int\n    E4 :: (a ~ Int) => Int -> E a\n\nOnly E1's argument is an occurrence of a universally quantified type variable\nthat is syntactically equivalent to the last type parameter, so only E1's\nargument will be folded over in a derived Foldable instance.\n\nSee Trac #10447 for the original discussion on this feature. Also see\nhttps://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFunctor\nfor a more in-depth explanation.\n\nNote [FFoldType and functorLikeTraverse]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDeriving Functor, Foldable, and Traversable all require generating expressions\nwhich perform an operation on each argument of a data constructor depending\non the argument's type. In particular, a generated operation can be different\ndepending on whether the type mentions the last type variable of the datatype\n(e.g., if you have data T a = MkT a Int, then a generated foldr expression would\nfold over the first argument of MkT, but not the second).\n\nThis pattern is abstracted with the FFoldType datatype, which provides hooks\nfor the user to specify how a constructor argument should be folded when it\nhas a type with a particular \"shape\". The shapes are as follows (assume that\na is the last type variable in a given datatype):\n\n* ft_triv:    The type does not mention the last type variable at all.\n              Examples: Int, b\n\n* ft_var:     The type is syntactically equal to the last type variable.\n              Moreover, the type appears in a covariant position (see\n              the Deriving Functor instances section of the user's guide\n              for an in-depth explanation of covariance vs. contravariance).\n              Example: a (covariantly)\n\n* ft_co_var:  The type is syntactically equal to the last type variable.\n              Moreover, the type appears in a contravariant position.\n              Example: a (contravariantly)\n\n* ft_fun:     A function type which mentions the last type variable in\n              the argument position, result position or both.\n              Examples: a -> Int, Int -> a, Maybe a -> [a]\n\n* ft_tup:     A tuple type which mentions the last type variable in at least\n              one of its fields. The TyCon argument of ft_tup represents the\n              particular tuple's type constructor.\n              Examples: (a, Int), (Maybe a, [a], Either a Int), (# Int, a #)\n\n* ft_ty_app:  A type is being applied to the last type parameter, where the\n              applied type does not mention the last type parameter (if it\n              did, it would fall under ft_bad_app). The Type argument to\n              ft_ty_app represents the applied type.\n\n              Note that functions, tuples, and foralls are distinct cases\n              and take precedence of ft_ty_app. (For example, (Int -> a) would\n              fall under (ft_fun Int a), not (ft_ty_app ((->) Int) a).\n              Examples: Maybe a, Either b a\n\n* ft_bad_app: A type application uses the last type parameter in a position\n              other than the last argument. This case is singled out because\n              Functor, Foldable, and Traversable instances cannot be derived\n              for datatypes containing arguments with such types.\n              Examples: Either a Int, Const a b\n\n* ft_forall:  A forall'd type mentions the last type parameter on its right-\n              hand side (and is not quantified on the left-hand side). This\n              case is present mostly for plumbing purposes.\n              Example: forall b. Either b a\n\nIf FFoldType describes a strategy for folding subcomponents of a Type, then\nfunctorLikeTraverse is the function that applies that strategy to the entirety\nof a Type, returning the final folded-up result.\n\nfoldDataConArgs applies functorLikeTraverse to every argument type of a\nconstructor, returning a list of the fold results. This makes foldDataConArgs\na natural way to generate the subexpressions in a generated fmap, foldr,\nfoldMap, or traverse definition (the subexpressions must then be combined in\na method-specific fashion to form the final generated expression).\n\nDeriving Generic1 also does validity checking by looking for the last type\nvariable in certain positions of a constructor's argument types, so it also\nuses foldDataConArgs. See Note [degenerate use of FFoldType] in TcGenGenerics.\n\nNote [Generated code for DeriveFoldable and DeriveTraversable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe adapt the algorithms for -XDeriveFoldable and -XDeriveTraversable based on\nthat of -XDeriveFunctor. However, there an important difference between deriving\nthe former two typeclasses and the latter one, which is best illustrated by the\nfollowing scenario:\n\n  data WithInt a = WithInt a Int# deriving (Functor, Foldable, Traversable)\n\nThe generated code for the Functor instance is straightforward:\n\n  instance Functor WithInt where\n    fmap f (WithInt a i) = WithInt (f a) i\n\nBut if we use too similar of a strategy for deriving the Foldable and\nTraversable instances, we end up with this code:\n\n  instance Foldable WithInt where\n    foldMap f (WithInt a i) = f a <> mempty\n\n  instance Traversable WithInt where\n    traverse f (WithInt a i) = fmap WithInt (f a) <*> pure i\n\nThis is unsatisfying for two reasons:\n\n1. The Traversable instance doesn't typecheck! Int# is of kind #, but pure\n   expects an argument whose type is of kind *. This effectively prevents\n   Traversable from being derived for any datatype with an unlifted argument\n   type (Trac #11174).\n\n2. The generated code contains superfluous expressions. By the Monoid laws,\n   we can reduce (f a <> mempty) to (f a), and by the Applicative laws, we can\n   reduce (fmap WithInt (f a) <*> pure i) to (fmap (\\b -> WithInt b i) (f a)).\n\nWe can fix both of these issues by incorporating a slight twist to the usual\nalgorithm that we use for -XDeriveFunctor. The differences can be summarized\nas follows:\n\n1. In the generated expression, we only fold over arguments whose types\n   mention the last type parameter. Any other argument types will simply\n   produce useless 'mempty's or 'pure's, so they can be safely ignored.\n\n2. In the case of -XDeriveTraversable, instead of applying ConName,\n   we apply (\\b_i ... b_k -> ConName a_1 ... a_n), where\n\n   * ConName has n arguments\n   * {b_i, ..., b_k} is a subset of {a_1, ..., a_n} whose indices correspond\n     to the arguments whose types mention the last type parameter. As a\n     consequence, taking the difference of {a_1, ..., a_n} and\n     {b_i, ..., b_k} yields the all the argument values of ConName whose types\n     do not mention the last type parameter. Note that [i, ..., k] is a\n     strictly increasing\u00e2\u20ac\u201dbut not necessarily consecutive\u00e2\u20ac\u201dinteger sequence.\n\n     For example, the datatype\n\n       data Foo a = Foo Int a Int a\n\n     would generate the following Traversable instance:\n\n       instance Traversable Foo where\n         traverse f (Foo a1 a2 a3 a4) =\n           fmap (\\b2 b4 -> Foo a1 b2 a3 b4) (f a2) <*> f a4\n\nTechnically, this approach would also work for -XDeriveFunctor as well, but we\ndecide not to do so because:\n\n1. There's not much benefit to generating, e.g., ((\\b -> WithInt b i) (f a))\n   instead of (WithInt (f a) i).\n\n2. There would be certain datatypes for which the above strategy would\n   generate Functor code that would fail to typecheck. For example:\n\n     data Bar f a = Bar (forall f. Functor f => f a) deriving Functor\n\n   With the conventional algorithm, it would generate something like:\n\n     fmap f (Bar a) = Bar (fmap f a)\n\n   which typechecks. But with the strategy mentioned above, it would generate:\n\n     fmap f (Bar a) = (\\b -> Bar b) (fmap f a)\n\n   which does not typecheck, since GHC cannot unify the rank-2 type variables\n   in the types of b and (fmap f a).\n\nNote [Phantom types with Functor, Foldable, and Traversable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nGiven a type F :: * -> * whose type argument has a phantom role, we can always\nproduce lawful Functor and Traversable instances using\n\n    fmap _ = coerce\n    traverse _ = pure . coerce\n\nIndeed, these are equivalent to any *strictly lawful* instances one could\nwrite, except that this definition of 'traverse' may be lazier.  That is, if\ninstances obey the laws under true equality (rather than up to some equivalence\nrelation), then they will be essentially equivalent to these. These definitions\nare incredibly cheap, so we want to use them even if it means ignoring some\nnon-strictly-lawful instance in an embedded type.\n\nFoldable has far fewer laws to work with, which leaves us unwelcome\nfreedom in implementing it. At a minimum, we would like to ensure that\na derived foldMap is always at least as good as foldMapDefault with a\nderived traverse. To accomplish that, we must define\n\n   foldMap _ _ = mempty\n\nin these cases.\n\nThis may have different strictness properties from a standard derivation.\nConsider\n\n   data NotAList a = Nil | Cons (NotAList a) deriving Foldable\n\nThe usual deriving mechanism would produce\n\n   foldMap _ Nil = mempty\n   foldMap f (Cons x) = foldMap f x\n\nwhich is strict in the entire spine of the NotAList.\n\nFinal point: why do we even care about such types? Users will rarely if ever\nmap, fold, or traverse over such things themselves, but other derived\ninstances may:\n\n   data Hasn'tAList a = NotHere a (NotAList a) deriving Foldable\n\nNote [EmptyDataDecls with Functor, Foldable, and Traversable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThere are some slightly tricky decisions to make about how to handle\nFunctor, Foldable, and Traversable instances for types with no constructors.\nFor fmap, the two basic options are\n\n   fmap _ _ = error \"Sorry, no constructors\"\n\nor\n\n   fmap _ z = case z of\n\nIn most cases, the latter is more helpful: if the thunk passed to fmap\nthrows an exception, we're generally going to be much more interested in\nthat exception than in the fact that there aren't any constructors.\n\nIn order to match the semantics for phantoms (see note above), we need to\nbe a bit careful about 'traverse'. The obvious definition would be\n\n   traverse _ z = case z of\n\nbut this is stricter than the one for phantoms. We instead use\n\n   traverse _ z = pure $ case z of\n\nFor foldMap, the obvious choices are\n\n   foldMap _ _ = mempty\n\nor\n\n   foldMap _ z = case z of\n\nWe choose the first one to be consistent with what foldMapDefault does for\na derived Traversable instance.\n-}\n", "num_lines": 1294}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2011\n\n\nThe deriving code for the Generic class\n(equivalent to the code in TcGenDeriv, for other classes)\n-}\n\n{-# LANGUAGE CPP, ScopedTypeVariables, TupleSections #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcGenGenerics (canDoGenerics, canDoGenerics1,\n                      GenericKind(..),\n                      gen_Generic_binds, get_gen1_constrained_tys) where\n\nimport GhcPrelude\n\nimport HsSyn\nimport Type\nimport TcType\nimport TcGenDeriv\nimport TcGenFunctor\nimport DataCon\nimport TyCon\nimport FamInstEnv       ( FamInst, FamFlavor(..), mkSingleCoAxiom )\nimport FamInst\nimport Module           ( moduleName, moduleNameFS\n                        , moduleUnitId, unitIdFS, getModule )\nimport IfaceEnv         ( newGlobalBinder )\nimport Name      hiding ( varName )\nimport RdrName\nimport BasicTypes\nimport TysPrim\nimport TysWiredIn\nimport PrelNames\nimport TcEnv\nimport TcRnMonad\nimport HscTypes\nimport ErrUtils( Validity(..), andValid )\nimport SrcLoc\nimport Bag\nimport VarEnv\nimport VarSet (elemVarSet)\nimport Outputable\nimport FastString\nimport Util\n\nimport Control.Monad (mplus)\nimport Data.List (zip4, partition)\nimport Data.Maybe (isJust)\n\n#include \"HsVersions.h\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Bindings for the new generic deriving mechanism}\n*                                                                      *\n************************************************************************\n\nFor the generic representation we need to generate:\n\\begin{itemize}\n\\item A Generic instance\n\\item A Rep type instance\n\\item Many auxiliary datatypes and instances for them (for the meta-information)\n\\end{itemize}\n-}\n\ngen_Generic_binds :: GenericKind -> TyCon -> [Type]\n                 -> TcM (LHsBinds GhcPs, FamInst)\ngen_Generic_binds gk tc inst_tys = do\n  repTyInsts <- tc_mkRepFamInsts gk tc inst_tys\n  return (mkBindsRep gk tc, repTyInsts)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Generating representation types}\n*                                                                      *\n************************************************************************\n-}\n\nget_gen1_constrained_tys :: TyVar -> Type -> [Type]\n-- called by TcDeriv.inferConstraints; generates a list of types, each of which\n-- must be a Functor in order for the Generic1 instance to work.\nget_gen1_constrained_tys argVar\n  = argTyFold argVar $ ArgTyAlg { ata_rec0 = const []\n                                , ata_par1 = [], ata_rec1 = const []\n                                , ata_comp = (:) }\n\n{-\n\nNote [Requirements for deriving Generic and Rep]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIn the following, T, Tfun, and Targ are \"meta-variables\" ranging over type\nexpressions.\n\n(Generic T) and (Rep T) are derivable for some type expression T if the\nfollowing constraints are satisfied.\n\n  (a) D is a type constructor *value*. In other words, D is either a type\n      constructor or it is equivalent to the head of a data family instance (up to\n      alpha-renaming).\n\n  (b) D cannot have a \"stupid context\".\n\n  (c) The right-hand side of D cannot include existential types, universally\n      quantified types, or \"exotic\" unlifted types. An exotic unlifted type\n      is one which is not listed in the definition of allowedUnliftedTy\n      (i.e., one for which we have no representation type).\n      See Note [Generics and unlifted types]\n\n  (d) T :: *.\n\n(Generic1 T) and (Rep1 T) are derivable for some type expression T if the\nfollowing constraints are satisfied.\n\n  (a),(b),(c) As above.\n\n  (d) T must expect arguments, and its last parameter must have kind *.\n\n      We use `a' to denote the parameter of D that corresponds to the last\n      parameter of T.\n\n  (e) For any type-level application (Tfun Targ) in the right-hand side of D\n      where the head of Tfun is not a tuple constructor:\n\n      (b1) `a' must not occur in Tfun.\n\n      (b2) If `a' occurs in Targ, then Tfun :: * -> *.\n\n-}\n\ncanDoGenerics :: TyCon -> Validity\n-- canDoGenerics determines if Generic/Rep can be derived.\n--\n-- Check (a) from Note [Requirements for deriving Generic and Rep] is taken\n-- care of because canDoGenerics is applied to rep tycons.\n--\n-- It returns IsValid if deriving is possible. It returns (NotValid reason)\n-- if not.\ncanDoGenerics tc\n  = mergeErrors (\n          -- Check (b) from Note [Requirements for deriving Generic and Rep].\n              (if (not (null (tyConStupidTheta tc)))\n                then (NotValid (tc_name <+> text \"must not have a datatype context\"))\n                else IsValid)\n          -- See comment below\n            : (map bad_con (tyConDataCons tc)))\n  where\n    -- The tc can be a representation tycon. When we want to display it to the\n    -- user (in an error message) we should print its parent\n    tc_name = ppr $ case tyConFamInst_maybe tc of\n        Just (ptc, _) -> ptc\n        _             -> tc\n\n        -- Check (c) from Note [Requirements for deriving Generic and Rep].\n        --\n        -- If any of the constructors has an exotic unlifted type as argument,\n        -- then we can't build the embedding-projection pair, because\n        -- it relies on instantiating *polymorphic* sum and product types\n        -- at the argument types of the constructors\n    bad_con dc = if (any bad_arg_type (dataConOrigArgTys dc))\n                  then (NotValid (ppr dc <+> text\n                    \"must not have exotic unlifted or polymorphic arguments\"))\n                  else (if (not (isVanillaDataCon dc))\n                          then (NotValid (ppr dc <+> text \"must be a vanilla data constructor\"))\n                          else IsValid)\n\n        -- Nor can we do the job if it's an existential data constructor,\n        -- Nor if the args are polymorphic types (I don't think)\n    bad_arg_type ty = (isUnliftedType ty && not (allowedUnliftedTy ty))\n                      || not (isTauTy ty)\n\n-- Returns True the Type argument is an unlifted type which has a\n-- corresponding generic representation type. For example,\n-- (allowedUnliftedTy Int#) would return True since there is the UInt\n-- representation type.\nallowedUnliftedTy :: Type -> Bool\nallowedUnliftedTy = isJust . unboxedRepRDRs\n\nmergeErrors :: [Validity] -> Validity\nmergeErrors []             = IsValid\nmergeErrors (NotValid s:t) = case mergeErrors t of\n  IsValid     -> NotValid s\n  NotValid s' -> NotValid (s <> text \", and\" $$ s')\nmergeErrors (IsValid : t) = mergeErrors t\n\n-- A datatype used only inside of canDoGenerics1. It's the result of analysing\n-- a type term.\ndata Check_for_CanDoGenerics1 = CCDG1\n  { _ccdg1_hasParam :: Bool       -- does the parameter of interest occurs in\n                                  -- this type?\n  , _ccdg1_errors   :: Validity   -- errors generated by this type\n  }\n\n{-\n\nNote [degenerate use of FFoldType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWe use foldDataConArgs here only for its ability to treat tuples\nspecially. foldDataConArgs also tracks covariance (though it assumes all\nhigher-order type parameters are covariant) and has hooks for special handling\nof functions and polytypes, but we do *not* use those.\n\nThe key issue is that Generic1 deriving currently offers no sophisticated\nsupport for functions. For example, we cannot handle\n\n  data F a = F ((a -> Int) -> Int)\n\neven though a is occurring covariantly.\n\nIn fact, our rule is harsh: a is simply not allowed to occur within the first\nargument of (->). We treat (->) the same as any other non-tuple tycon.\n\nUnfortunately, this means we have to track \"the parameter occurs in this type\"\nexplicitly, even though foldDataConArgs is also doing this internally.\n\n-}\n\n-- canDoGenerics1 determines if a Generic1/Rep1 can be derived.\n--\n-- Checks (a) through (c) from Note [Requirements for deriving Generic and Rep]\n-- are taken care of by the call to canDoGenerics.\n--\n-- It returns IsValid if deriving is possible. It returns (NotValid reason)\n-- if not.\ncanDoGenerics1 :: TyCon -> Validity\ncanDoGenerics1 rep_tc =\n  canDoGenerics rep_tc `andValid` additionalChecks\n  where\n    additionalChecks\n        -- check (d) from Note [Requirements for deriving Generic and Rep]\n      | null (tyConTyVars rep_tc) = NotValid $\n          text \"Data type\" <+> quotes (ppr rep_tc)\n      <+> text \"must have some type parameters\"\n\n      | otherwise = mergeErrors $ concatMap check_con data_cons\n\n    data_cons = tyConDataCons rep_tc\n    check_con con = case check_vanilla con of\n      j@(NotValid {}) -> [j]\n      IsValid -> _ccdg1_errors `map` foldDataConArgs (ft_check con) con\n\n    bad :: DataCon -> SDoc -> SDoc\n    bad con msg = text \"Constructor\" <+> quotes (ppr con) <+> msg\n\n    check_vanilla :: DataCon -> Validity\n    check_vanilla con | isVanillaDataCon con = IsValid\n                      | otherwise            = NotValid (bad con existential)\n\n    bmzero      = CCDG1 False IsValid\n    bmbad con s = CCDG1 True $ NotValid $ bad con s\n    bmplus (CCDG1 b1 m1) (CCDG1 b2 m2) = CCDG1 (b1 || b2) (m1 `andValid` m2)\n\n    -- check (e) from Note [Requirements for deriving Generic and Rep]\n    -- See also Note [degenerate use of FFoldType]\n    ft_check :: DataCon -> FFoldType Check_for_CanDoGenerics1\n    ft_check con = FT\n      { ft_triv = bmzero\n\n      , ft_var = caseVar, ft_co_var = caseVar\n\n      -- (component_0,component_1,...,component_n)\n      , ft_tup = \\_ components -> if any _ccdg1_hasParam (init components)\n                                  then bmbad con wrong_arg\n                                  else foldr bmplus bmzero components\n\n      -- (dom -> rng), where the head of ty is not a tuple tycon\n      , ft_fun = \\dom rng -> -- cf #8516\n          if _ccdg1_hasParam dom\n          then bmbad con wrong_arg\n          else bmplus dom rng\n\n      -- (ty arg), where head of ty is neither (->) nor a tuple constructor and\n      -- the parameter of interest does not occur in ty\n      , ft_ty_app = \\_ arg -> arg\n\n      , ft_bad_app = bmbad con wrong_arg\n      , ft_forall  = \\_ body -> body -- polytypes are handled elsewhere\n      }\n      where\n        caseVar = CCDG1 True IsValid\n\n\n    existential = text \"must not have existential arguments\"\n    wrong_arg   = text \"applies a type to an argument involving the last parameter\"\n               $$ text \"but the applied type is not of kind * -> *\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Generating the RHS of a generic default method}\n*                                                                      *\n************************************************************************\n-}\n\ntype US = Int   -- Local unique supply, just a plain Int\ntype Alt = (LPat GhcPs, LHsExpr GhcPs)\n\n-- GenericKind serves to mark if a datatype derives Generic (Gen0) or\n-- Generic1 (Gen1).\ndata GenericKind = Gen0 | Gen1\n\n-- as above, but with a payload of the TyCon's name for \"the\" parameter\ndata GenericKind_ = Gen0_ | Gen1_ TyVar\n\n-- as above, but using a single datacon's name for \"the\" parameter\ndata GenericKind_DC = Gen0_DC | Gen1_DC TyVar\n\nforgetArgVar :: GenericKind_DC -> GenericKind\nforgetArgVar Gen0_DC   = Gen0\nforgetArgVar Gen1_DC{} = Gen1\n\n-- When working only within a single datacon, \"the\" parameter's name should\n-- match that datacon's name for it.\ngk2gkDC :: GenericKind_ -> DataCon -> GenericKind_DC\ngk2gkDC Gen0_   _ = Gen0_DC\ngk2gkDC Gen1_{} d = Gen1_DC $ last $ dataConUnivTyVars d\n\n\n-- Bindings for the Generic instance\nmkBindsRep :: GenericKind -> TyCon -> LHsBinds GhcPs\nmkBindsRep gk tycon =\n    unitBag (mkRdrFunBind (L loc from01_RDR) [from_eqn])\n  `unionBags`\n    unitBag (mkRdrFunBind (L loc to01_RDR) [to_eqn])\n      where\n        -- The topmost M1 (the datatype metadata) has the exact same type\n        -- across all cases of a from/to definition, and can be factored out\n        -- to save some allocations during typechecking.\n        -- See Note [Generics compilation speed tricks]\n        from_eqn = mkHsCaseAlt x_Pat $ mkM1_E\n                                       $ nlHsPar $ nlHsCase x_Expr from_matches\n        to_eqn   = mkHsCaseAlt (mkM1_P x_Pat) $ nlHsCase x_Expr to_matches\n\n        from_matches  = [mkHsCaseAlt pat rhs | (pat,rhs) <- from_alts]\n        to_matches    = [mkHsCaseAlt pat rhs | (pat,rhs) <- to_alts  ]\n        loc           = srcLocSpan (getSrcLoc tycon)\n        datacons      = tyConDataCons tycon\n\n        (from01_RDR, to01_RDR) = case gk of\n                                   Gen0 -> (from_RDR,  to_RDR)\n                                   Gen1 -> (from1_RDR, to1_RDR)\n\n        -- Recurse over the sum first\n        from_alts, to_alts :: [Alt]\n        (from_alts, to_alts) = mkSum gk_ (1 :: US) datacons\n          where gk_ = case gk of\n                  Gen0 -> Gen0_\n                  Gen1 -> ASSERT(tyvars `lengthAtLeast` 1)\n                          Gen1_ (last tyvars)\n                    where tyvars = tyConTyVars tycon\n\n--------------------------------------------------------------------------------\n-- The type synonym instance and synonym\n--       type instance Rep (D a b) = Rep_D a b\n--       type Rep_D a b = ...representation type for D ...\n--------------------------------------------------------------------------------\n\ntc_mkRepFamInsts :: GenericKind   -- Gen0 or Gen1\n                 -> TyCon         -- The type to generate representation for\n                 -> [Type]        -- The type(s) to which Generic(1) is applied\n                                  -- in the generated instance\n                 -> TcM FamInst   -- Generated representation0 coercion\ntc_mkRepFamInsts gk tycon inst_tys =\n       -- Consider the example input tycon `D`, where data D a b = D_ a\n       -- Also consider `R:DInt`, where { data family D x y :: * -> *\n       --                               ; data instance D Int a b = D_ a }\n  do { -- `rep` = GHC.Generics.Rep or GHC.Generics.Rep1 (type family)\n       fam_tc <- case gk of\n         Gen0 -> tcLookupTyCon repTyConName\n         Gen1 -> tcLookupTyCon rep1TyConName\n\n     ; fam_envs <- tcGetFamInstEnvs\n\n     ; let -- If the derived instance is\n           --   instance Generic (Foo x)\n           -- then:\n           --   `arg_ki` = *, `inst_ty` = Foo x :: *\n           --\n           -- If the derived instance is\n           --   instance Generic1 (Bar x :: k -> *)\n           -- then:\n           --   `arg_k` = k, `inst_ty` = Bar x :: k -> *\n           (arg_ki, inst_ty) = case (gk, inst_tys) of\n             (Gen0, [inst_t])        -> (liftedTypeKind, inst_t)\n             (Gen1, [arg_k, inst_t]) -> (arg_k,          inst_t)\n             _ -> pprPanic \"tc_mkRepFamInsts\" (ppr inst_tys)\n\n     ; let mbFamInst         = tyConFamInst_maybe tycon\n           -- If we're examining a data family instance, we grab the parent\n           -- TyCon (ptc) and use it to determine the type arguments\n           -- (inst_args) for the data family *instance*'s type variables.\n           ptc               = maybe tycon fst mbFamInst\n           (_, inst_args, _) = tcLookupDataFamInst fam_envs ptc $ snd\n                                 $ tcSplitTyConApp inst_ty\n\n     ; let -- `tyvars` = [a,b]\n           (tyvars, gk_) = case gk of\n             Gen0 -> (all_tyvars, Gen0_)\n             Gen1 -> ASSERT(not $ null all_tyvars)\n                     (init all_tyvars, Gen1_ $ last all_tyvars)\n             where all_tyvars = tyConTyVars tycon\n\n       -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *\n     ; repTy <- tc_mkRepTy gk_ tycon arg_ki\n\n       -- `rep_name` is a name we generate for the synonym\n     ; mod <- getModule\n     ; loc <- getSrcSpanM\n     ; let tc_occ  = nameOccName (tyConName tycon)\n           rep_occ = case gk of Gen0 -> mkGenR tc_occ; Gen1 -> mkGen1R tc_occ\n     ; rep_name <- newGlobalBinder mod rep_occ loc\n\n       -- We make sure to substitute the tyvars with their user-supplied\n       -- type arguments before generating the Rep/Rep1 instance, since some\n       -- of the tyvars might have been instantiated when deriving.\n       -- See Note [Generating a correctly typed Rep instance].\n     ; let (env_tyvars, env_inst_args)\n             = case gk_ of\n                 Gen0_ -> (tyvars, inst_args)\n                 Gen1_ last_tv\n                          -- See the \"wrinkle\" in\n                          -- Note [Generating a correctly typed Rep instance]\n                       -> ( last_tv : tyvars\n                          , anyTypeOfKind (tyVarKind last_tv) : inst_args )\n           env        = zipTyEnv env_tyvars env_inst_args\n           in_scope   = mkInScopeSet (tyCoVarsOfTypes inst_tys)\n           subst      = mkTvSubst in_scope env\n           repTy'     = substTy  subst repTy\n           tcv'       = tyCoVarsOfTypeList inst_ty\n           (tv', cv') = partition isTyVar tcv'\n           tvs'       = scopedSort tv'\n           cvs'       = scopedSort cv'\n           axiom      = mkSingleCoAxiom Nominal rep_name tvs' [] cvs'\n                                        fam_tc inst_tys repTy'\n\n     ; newFamInst SynFamilyInst axiom  }\n\n--------------------------------------------------------------------------------\n-- Type representation\n--------------------------------------------------------------------------------\n\n-- | See documentation of 'argTyFold'; that function uses the fields of this\n-- type to interpret the structure of a type when that type is considered as an\n-- argument to a constructor that is being represented with 'Rep1'.\ndata ArgTyAlg a = ArgTyAlg\n  { ata_rec0 :: (Type -> a)\n  , ata_par1 :: a, ata_rec1 :: (Type -> a)\n  , ata_comp :: (Type -> a -> a)\n  }\n\n-- | @argTyFold@ implements a generalised and safer variant of the @arg@\n-- function from Figure 3 in <http://dreixel.net/research/pdf/gdmh.pdf>. @arg@\n-- is conceptually equivalent to:\n--\n-- > arg t = case t of\n-- >   _ | isTyVar t         -> if (t == argVar) then Par1 else Par0 t\n-- >   App f [t'] |\n-- >     representable1 f &&\n-- >     t' == argVar        -> Rec1 f\n-- >   App f [t'] |\n-- >     representable1 f &&\n-- >     t' has tyvars       -> f :.: (arg t')\n-- >   _                     -> Rec0 t\n--\n-- where @argVar@ is the last type variable in the data type declaration we are\n-- finding the representation for.\n--\n-- @argTyFold@ is more general than @arg@ because it uses 'ArgTyAlg' to\n-- abstract out the concrete invocations of @Par0@, @Rec0@, @Par1@, @Rec1@, and\n-- @:.:@.\n--\n-- @argTyFold@ is safer than @arg@ because @arg@ would lead to a GHC panic for\n-- some data types. The problematic case is when @t@ is an application of a\n-- non-representable type @f@ to @argVar@: @App f [argVar]@ is caught by the\n-- @_@ pattern, and ends up represented as @Rec0 t@. This type occurs /free/ in\n-- the RHS of the eventual @Rep1@ instance, which is therefore ill-formed. Some\n-- representable1 checks have been relaxed, and others were moved to\n-- @canDoGenerics1@.\nargTyFold :: forall a. TyVar -> ArgTyAlg a -> Type -> a\nargTyFold argVar (ArgTyAlg {ata_rec0 = mkRec0,\n                            ata_par1 = mkPar1, ata_rec1 = mkRec1,\n                            ata_comp = mkComp}) =\n  -- mkRec0 is the default; use it if there is no interesting structure\n  -- (e.g. occurrences of parameters or recursive occurrences)\n  \\t -> maybe (mkRec0 t) id $ go t where\n  go :: Type -> -- type to fold through\n        Maybe a -- the result (e.g. representation type), unless it's trivial\n  go t = isParam `mplus` isApp where\n\n    isParam = do -- handles parameters\n      t' <- getTyVar_maybe t\n      Just $ if t' == argVar then mkPar1 -- moreover, it is \"the\" parameter\n             else mkRec0 t -- NB mkRec0 instead of the conventional mkPar0\n\n    isApp = do -- handles applications\n      (phi, beta) <- tcSplitAppTy_maybe t\n\n      let interesting = argVar `elemVarSet` exactTyCoVarsOfType beta\n\n      -- Does it have no interesting structure to represent?\n      if not interesting then Nothing\n        else -- Is the argument the parameter? Special case for mkRec1.\n          if Just argVar == getTyVar_maybe beta then Just $ mkRec1 phi\n            else mkComp phi `fmap` go beta -- It must be a composition.\n\n\ntc_mkRepTy ::  -- Gen0_ or Gen1_, for Rep or Rep1\n               GenericKind_\n              -- The type to generate representation for\n            -> TyCon\n              -- The kind of the representation type's argument\n              -- See Note [Handling kinds in a Rep instance]\n            -> Kind\n               -- Generated representation0 type\n            -> TcM Type\ntc_mkRepTy gk_ tycon k =\n  do\n    d1      <- tcLookupTyCon d1TyConName\n    c1      <- tcLookupTyCon c1TyConName\n    s1      <- tcLookupTyCon s1TyConName\n    rec0    <- tcLookupTyCon rec0TyConName\n    rec1    <- tcLookupTyCon rec1TyConName\n    par1    <- tcLookupTyCon par1TyConName\n    u1      <- tcLookupTyCon u1TyConName\n    v1      <- tcLookupTyCon v1TyConName\n    plus    <- tcLookupTyCon sumTyConName\n    times   <- tcLookupTyCon prodTyConName\n    comp    <- tcLookupTyCon compTyConName\n    uAddr   <- tcLookupTyCon uAddrTyConName\n    uChar   <- tcLookupTyCon uCharTyConName\n    uDouble <- tcLookupTyCon uDoubleTyConName\n    uFloat  <- tcLookupTyCon uFloatTyConName\n    uInt    <- tcLookupTyCon uIntTyConName\n    uWord   <- tcLookupTyCon uWordTyConName\n\n    let tcLookupPromDataCon = fmap promoteDataCon . tcLookupDataCon\n\n    md         <- tcLookupPromDataCon metaDataDataConName\n    mc         <- tcLookupPromDataCon metaConsDataConName\n    ms         <- tcLookupPromDataCon metaSelDataConName\n    pPrefix    <- tcLookupPromDataCon prefixIDataConName\n    pInfix     <- tcLookupPromDataCon infixIDataConName\n    pLA        <- tcLookupPromDataCon leftAssociativeDataConName\n    pRA        <- tcLookupPromDataCon rightAssociativeDataConName\n    pNA        <- tcLookupPromDataCon notAssociativeDataConName\n    pSUpk      <- tcLookupPromDataCon sourceUnpackDataConName\n    pSNUpk     <- tcLookupPromDataCon sourceNoUnpackDataConName\n    pNSUpkness <- tcLookupPromDataCon noSourceUnpackednessDataConName\n    pSLzy      <- tcLookupPromDataCon sourceLazyDataConName\n    pSStr      <- tcLookupPromDataCon sourceStrictDataConName\n    pNSStrness <- tcLookupPromDataCon noSourceStrictnessDataConName\n    pDLzy      <- tcLookupPromDataCon decidedLazyDataConName\n    pDStr      <- tcLookupPromDataCon decidedStrictDataConName\n    pDUpk      <- tcLookupPromDataCon decidedUnpackDataConName\n\n    fix_env <- getFixityEnv\n\n    let mkSum' a b = mkTyConApp plus  [k,a,b]\n        mkProd a b = mkTyConApp times [k,a,b]\n        mkRec0 a   = mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 k a\n        mkRec1 a   = mkTyConApp rec1  [k,a]\n        mkPar1     = mkTyConTy  par1\n        mkD    a   = mkTyConApp d1 [ k, metaDataTy, sumP (tyConDataCons a) ]\n        mkC      a = mkTyConApp c1 [ k\n                                   , metaConsTy a\n                                   , prod (dataConInstOrigArgTys a\n                                            . mkTyVarTys . tyConTyVars $ tycon)\n                                          (dataConSrcBangs    a)\n                                          (dataConImplBangs   a)\n                                          (dataConFieldLabels a)]\n        mkS mlbl su ss ib a = mkTyConApp s1 [k, metaSelTy mlbl su ss ib, a]\n\n        -- Sums and products are done in the same way for both Rep and Rep1\n        sumP [] = mkTyConApp v1 [k]\n        sumP l  = foldBal mkSum' . map mkC  $ l\n        -- The Bool is True if this constructor has labelled fields\n        prod :: [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type\n        prod [] _  _  _  = mkTyConApp u1 [k]\n        prod l  sb ib fl = foldBal mkProd\n                                   [ ASSERT(null fl || lengthExceeds fl j)\n                                     arg t sb' ib' (if null fl\n                                                       then Nothing\n                                                       else Just (fl !! j))\n                                   | (t,sb',ib',j) <- zip4 l sb ib [0..] ]\n\n        arg :: Type -> HsSrcBang -> HsImplBang -> Maybe FieldLabel -> Type\n        arg t (HsSrcBang _ su ss) ib fl = mkS fl su ss ib $ case gk_ of\n            -- Here we previously used Par0 if t was a type variable, but we\n            -- realized that we can't always guarantee that we are wrapping-up\n            -- all type variables in Par0. So we decided to stop using Par0\n            -- altogether, and use Rec0 all the time.\n                      Gen0_        -> mkRec0 t\n                      Gen1_ argVar -> argPar argVar t\n          where\n            -- Builds argument representation for Rep1 (more complicated due to\n            -- the presence of composition).\n            argPar argVar = argTyFold argVar $ ArgTyAlg\n              {ata_rec0 = mkRec0, ata_par1 = mkPar1,\n               ata_rec1 = mkRec1, ata_comp = mkComp comp k}\n\n        tyConName_user = case tyConFamInst_maybe tycon of\n                           Just (ptycon, _) -> tyConName ptycon\n                           Nothing          -> tyConName tycon\n\n        dtName  = mkStrLitTy . occNameFS . nameOccName $ tyConName_user\n        mdName  = mkStrLitTy . moduleNameFS . moduleName\n                . nameModule . tyConName $ tycon\n        pkgName = mkStrLitTy . unitIdFS . moduleUnitId\n                . nameModule . tyConName $ tycon\n        isNT    = mkTyConTy $ if isNewTyCon tycon\n                              then promotedTrueDataCon\n                              else promotedFalseDataCon\n\n        ctName = mkStrLitTy . occNameFS . nameOccName . dataConName\n        ctFix c\n            | dataConIsInfix c\n            = case lookupFixity fix_env (dataConName c) of\n                   Fixity _ n InfixL -> buildFix n pLA\n                   Fixity _ n InfixR -> buildFix n pRA\n                   Fixity _ n InfixN -> buildFix n pNA\n            | otherwise = mkTyConTy pPrefix\n        buildFix n assoc = mkTyConApp pInfix [ mkTyConTy assoc\n                                             , mkNumLitTy (fromIntegral n)]\n\n        isRec c = mkTyConTy $ if dataConFieldLabels c `lengthExceeds` 0\n                              then promotedTrueDataCon\n                              else promotedFalseDataCon\n\n        selName = mkStrLitTy . flLabel\n\n        mbSel Nothing  = mkTyConApp promotedNothingDataCon [typeSymbolKind]\n        mbSel (Just s) = mkTyConApp promotedJustDataCon\n                                    [typeSymbolKind, selName s]\n\n        metaDataTy   = mkTyConApp md [dtName, mdName, pkgName, isNT]\n        metaConsTy c = mkTyConApp mc [ctName c, ctFix c, isRec c]\n        metaSelTy mlbl su ss ib =\n            mkTyConApp ms [mbSel mlbl, pSUpkness, pSStrness, pDStrness]\n          where\n            pSUpkness = mkTyConTy $ case su of\n                                         SrcUnpack   -> pSUpk\n                                         SrcNoUnpack -> pSNUpk\n                                         NoSrcUnpack -> pNSUpkness\n\n            pSStrness = mkTyConTy $ case ss of\n                                         SrcLazy     -> pSLzy\n                                         SrcStrict   -> pSStr\n                                         NoSrcStrict -> pNSStrness\n\n            pDStrness = mkTyConTy $ case ib of\n                                         HsLazy      -> pDLzy\n                                         HsStrict    -> pDStr\n                                         HsUnpack{}  -> pDUpk\n\n    return (mkD tycon)\n\nmkComp :: TyCon -> Kind -> Type -> Type -> Type\nmkComp comp k f g\n  | k1_first  = mkTyConApp comp  [k,liftedTypeKind,f,g]\n  | otherwise = mkTyConApp comp  [liftedTypeKind,k,f,g]\n  where\n    -- Which of these is the case?\n    --     newtype (:.:) {k1} {k2} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...\n    -- or  newtype (:.:) {k2} {k1} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...\n    -- We want to instantiate with k1=k, and k2=*\n    --    Reason for k2=*: see Note [Handling kinds in a Rep instance]\n    -- But we need to know which way round!\n    k1_first = k_first == p_kind_var\n    [k_first,_,_,_,p] = tyConTyVars comp\n    Just p_kind_var = getTyVar_maybe (tyVarKind p)\n\n-- Given the TyCons for each URec-related type synonym, check to see if the\n-- given type is an unlifted type that generics understands. If so, return\n-- its representation type. Otherwise, return Rec0.\n-- See Note [Generics and unlifted types]\nmkBoxTy :: TyCon -- UAddr\n        -> TyCon -- UChar\n        -> TyCon -- UDouble\n        -> TyCon -- UFloat\n        -> TyCon -- UInt\n        -> TyCon -- UWord\n        -> TyCon -- Rec0\n        -> Kind  -- What to instantiate Rec0's kind variable with\n        -> Type\n        -> Type\nmkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 k ty\n  | ty `eqType` addrPrimTy   = mkTyConApp uAddr   [k]\n  | ty `eqType` charPrimTy   = mkTyConApp uChar   [k]\n  | ty `eqType` doublePrimTy = mkTyConApp uDouble [k]\n  | ty `eqType` floatPrimTy  = mkTyConApp uFloat  [k]\n  | ty `eqType` intPrimTy    = mkTyConApp uInt    [k]\n  | ty `eqType` wordPrimTy   = mkTyConApp uWord   [k]\n  | otherwise                = mkTyConApp rec0    [k,ty]\n\n--------------------------------------------------------------------------------\n-- Dealing with sums\n--------------------------------------------------------------------------------\n\nmkSum :: GenericKind_ -- Generic or Generic1?\n      -> US          -- Base for generating unique names\n      -> [DataCon]   -- The data constructors\n      -> ([Alt],     -- Alternatives for the T->Trep \"from\" function\n          [Alt])     -- Alternatives for the Trep->T \"to\" function\n\n-- Datatype without any constructors\nmkSum _ _ [] = ([from_alt], [to_alt])\n  where\n    from_alt = (x_Pat, nlHsCase x_Expr [])\n    to_alt   = (x_Pat, nlHsCase x_Expr [])\n               -- These M1s are meta-information for the datatype\n\n-- Datatype with at least one constructor\nmkSum gk_ us datacons =\n  -- switch the payload of gk_ to be datacon-centric instead of tycon-centric\n unzip [ mk1Sum (gk2gkDC gk_ d) us i (length datacons) d\n           | (d,i) <- zip datacons [1..] ]\n\n-- Build the sum for a particular constructor\nmk1Sum :: GenericKind_DC -- Generic or Generic1?\n       -> US        -- Base for generating unique names\n       -> Int       -- The index of this constructor\n       -> Int       -- Total number of constructors\n       -> DataCon   -- The data constructor\n       -> (Alt,     -- Alternative for the T->Trep \"from\" function\n           Alt)     -- Alternative for the Trep->T \"to\" function\nmk1Sum gk_ us i n datacon = (from_alt, to_alt)\n  where\n    gk = forgetArgVar gk_\n\n    -- Existentials already excluded\n    argTys = dataConOrigArgTys datacon\n    n_args = dataConSourceArity datacon\n\n    datacon_varTys = zip (map mkGenericLocal [us .. us+n_args-1]) argTys\n    datacon_vars = map fst datacon_varTys\n    us'          = us + n_args\n\n    datacon_rdr  = getRdrName datacon\n\n    from_alt     = (nlConVarPat datacon_rdr datacon_vars, from_alt_rhs)\n    from_alt_rhs = genLR_E i n (mkProd_E gk_ us' datacon_varTys)\n\n    to_alt     = ( genLR_P i n (mkProd_P gk us' datacon_varTys)\n                 , to_alt_rhs\n                 ) -- These M1s are meta-information for the datatype\n    to_alt_rhs = case gk_ of\n      Gen0_DC        -> nlHsVarApps datacon_rdr datacon_vars\n      Gen1_DC argVar -> nlHsApps datacon_rdr $ map argTo datacon_varTys\n        where\n          argTo (var, ty) = converter ty `nlHsApp` nlHsVar var where\n            converter = argTyFold argVar $ ArgTyAlg\n              {ata_rec0 = nlHsVar . unboxRepRDR,\n               ata_par1 = nlHsVar unPar1_RDR,\n               ata_rec1 = const $ nlHsVar unRec1_RDR,\n               ata_comp = \\_ cnv -> (nlHsVar fmap_RDR `nlHsApp` cnv)\n                                    `nlHsCompose` nlHsVar unComp1_RDR}\n\n\n-- Generates the L1/R1 sum pattern\ngenLR_P :: Int -> Int -> LPat GhcPs -> LPat GhcPs\ngenLR_P i n p\n  | n == 0       = error \"impossible\"\n  | n == 1       = p\n  | i <= div n 2 = nlParPat $ nlConPat l1DataCon_RDR [genLR_P i     (div n 2) p]\n  | otherwise    = nlParPat $ nlConPat r1DataCon_RDR [genLR_P (i-m) (n-m)     p]\n                     where m = div n 2\n\n-- Generates the L1/R1 sum expression\ngenLR_E :: Int -> Int -> LHsExpr GhcPs -> LHsExpr GhcPs\ngenLR_E i n e\n  | n == 0       = error \"impossible\"\n  | n == 1       = e\n  | i <= div n 2 = nlHsVar l1DataCon_RDR `nlHsApp`\n                                            nlHsPar (genLR_E i     (div n 2) e)\n  | otherwise    = nlHsVar r1DataCon_RDR `nlHsApp`\n                                            nlHsPar (genLR_E (i-m) (n-m)     e)\n                     where m = div n 2\n\n--------------------------------------------------------------------------------\n-- Dealing with products\n--------------------------------------------------------------------------------\n\n-- Build a product expression\nmkProd_E :: GenericKind_DC    -- Generic or Generic1?\n         -> US                -- Base for unique names\n         -> [(RdrName, Type)]\n                       -- List of variables matched on the lhs and their types\n         -> LHsExpr GhcPs   -- Resulting product expression\nmkProd_E _   _ []     = mkM1_E (nlHsVar u1DataCon_RDR)\nmkProd_E gk_ _ varTys = mkM1_E (foldBal prod appVars)\n                     -- These M1s are meta-information for the constructor\n  where\n    appVars = map (wrapArg_E gk_) varTys\n    prod a b = prodDataCon_RDR `nlHsApps` [a,b]\n\nwrapArg_E :: GenericKind_DC -> (RdrName, Type) -> LHsExpr GhcPs\nwrapArg_E Gen0_DC          (var, ty) = mkM1_E $\n                            boxRepRDR ty `nlHsVarApps` [var]\n                         -- This M1 is meta-information for the selector\nwrapArg_E (Gen1_DC argVar) (var, ty) = mkM1_E $\n                            converter ty `nlHsApp` nlHsVar var\n                         -- This M1 is meta-information for the selector\n  where converter = argTyFold argVar $ ArgTyAlg\n          {ata_rec0 = nlHsVar . boxRepRDR,\n           ata_par1 = nlHsVar par1DataCon_RDR,\n           ata_rec1 = const $ nlHsVar rec1DataCon_RDR,\n           ata_comp = \\_ cnv -> nlHsVar comp1DataCon_RDR `nlHsCompose`\n                                  (nlHsVar fmap_RDR `nlHsApp` cnv)}\n\nboxRepRDR :: Type -> RdrName\nboxRepRDR = maybe k1DataCon_RDR fst . unboxedRepRDRs\n\nunboxRepRDR :: Type -> RdrName\nunboxRepRDR = maybe unK1_RDR snd . unboxedRepRDRs\n\n-- Retrieve the RDRs associated with each URec data family instance\n-- constructor. See Note [Generics and unlifted types]\nunboxedRepRDRs :: Type -> Maybe (RdrName, RdrName)\nunboxedRepRDRs ty\n  | ty `eqType` addrPrimTy   = Just (uAddrDataCon_RDR,   uAddrHash_RDR)\n  | ty `eqType` charPrimTy   = Just (uCharDataCon_RDR,   uCharHash_RDR)\n  | ty `eqType` doublePrimTy = Just (uDoubleDataCon_RDR, uDoubleHash_RDR)\n  | ty `eqType` floatPrimTy  = Just (uFloatDataCon_RDR,  uFloatHash_RDR)\n  | ty `eqType` intPrimTy    = Just (uIntDataCon_RDR,    uIntHash_RDR)\n  | ty `eqType` wordPrimTy   = Just (uWordDataCon_RDR,   uWordHash_RDR)\n  | otherwise          = Nothing\n\n-- Build a product pattern\nmkProd_P :: GenericKind       -- Gen0 or Gen1\n         -> US                -- Base for unique names\n         -> [(RdrName, Type)] -- List of variables to match,\n                              --   along with their types\n         -> LPat GhcPs      -- Resulting product pattern\nmkProd_P _  _ []     = mkM1_P (nlNullaryConPat u1DataCon_RDR)\nmkProd_P gk _ varTys = mkM1_P (foldBal prod appVars)\n                     -- These M1s are meta-information for the constructor\n  where\n    appVars = unzipWith (wrapArg_P gk) varTys\n    prod a b = nlParPat $ prodDataCon_RDR `nlConPat` [a,b]\n\nwrapArg_P :: GenericKind -> RdrName -> Type -> LPat GhcPs\nwrapArg_P Gen0 v ty = mkM1_P (nlParPat $ boxRepRDR ty `nlConVarPat` [v])\n                   -- This M1 is meta-information for the selector\nwrapArg_P Gen1 v _  = nlParPat $ m1DataCon_RDR `nlConVarPat` [v]\n\nmkGenericLocal :: US -> RdrName\nmkGenericLocal u = mkVarUnqual (mkFastString (\"g\" ++ show u))\n\nx_RDR :: RdrName\nx_RDR = mkVarUnqual (fsLit \"x\")\n\nx_Expr :: LHsExpr GhcPs\nx_Expr = nlHsVar x_RDR\n\nx_Pat :: LPat GhcPs\nx_Pat = nlVarPat x_RDR\n\nmkM1_E :: LHsExpr GhcPs -> LHsExpr GhcPs\nmkM1_E e = nlHsVar m1DataCon_RDR `nlHsApp` e\n\nmkM1_P :: LPat GhcPs -> LPat GhcPs\nmkM1_P p = nlParPat $ m1DataCon_RDR `nlConPat` [p]\n\nnlHsCompose :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs\nnlHsCompose x y = compose_RDR `nlHsApps` [x, y]\n\n-- | Variant of foldr1 for producing balanced lists\nfoldBal :: (a -> a -> a) -> [a] -> a\nfoldBal op = foldBal' op (error \"foldBal: empty list\")\n\nfoldBal' :: (a -> a -> a) -> a -> [a] -> a\nfoldBal' _  x []  = x\nfoldBal' _  _ [y] = y\nfoldBal' op x l   = let (a,b) = splitAt (length l `div` 2) l\n                    in foldBal' op x a `op` foldBal' op x b\n\n{-\nNote [Generics and unlifted types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNormally, all constants are marked with K1/Rec0. The exception to this rule is\nwhen a data constructor has an unlifted argument (e.g., Int#, Char#, etc.). In\nthat case, we must use a data family instance of URec (from GHC.Generics) to\nmark it. As a result, before we can generate K1 or unK1, we must first check\nto see if the type is actually one of the unlifted types for which URec has a\ndata family instance; if so, we generate that instead.\n\nSee wiki:Commentary/Compiler/GenericDeriving#Handlingunliftedtypes for more\ndetails on why URec is implemented the way it is.\n\nNote [Generating a correctly typed Rep instance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ntc_mkRepTy derives the RHS of the Rep(1) type family instance when deriving\nGeneric(1). That is, it derives the ellipsis in the following:\n\n    instance Generic Foo where\n      type Rep Foo = ...\n\nHowever, tc_mkRepTy only has knowledge of the *TyCon* of the type for which\na Generic(1) instance is being derived, not the fully instantiated type. As a\nresult, tc_mkRepTy builds the most generalized Rep(1) instance possible using\nthe type variables it learns from the TyCon (i.e., it uses tyConTyVars). This\ncan cause problems when the instance has instantiated type variables\n(see Trac #11732). As an example:\n\n    data T a = MkT a\n    deriving instance Generic (T Int)\n    ==>\n    instance Generic (T Int) where\n      type Rep (T Int) = (... (Rec0 a)) -- wrong!\n\n-XStandaloneDeriving is one way for the type variables to become instantiated.\nAnother way is when Generic1 is being derived for a datatype with a visible\nkind binder, e.g.,\n\n   data P k (a :: k) = MkP k deriving Generic1\n   ==>\n   instance Generic1 (P *) where\n     type Rep1 (P *) = (... (Rec0 k)) -- wrong!\n\nSee Note [Unify kinds in deriving] in TcDeriv.\n\nIn any such scenario, we must prevent a discrepancy between the LHS and RHS of\na Rep(1) instance. To do so, we create a type variable substitution that maps\nthe tyConTyVars of the TyCon to their counterparts in the fully instantiated\ntype. (For example, using T above as example, you'd map a :-> Int.) We then\napply the substitution to the RHS before generating the instance.\n\nA wrinkle in all of this: when forming the type variable substitution for\nGeneric1 instances, we map the last type variable of the tycon to Any. Why?\nIt's because of wily data types like this one (#15012):\n\n   data T a = MkT (FakeOut a)\n   type FakeOut a = Int\n\nIf we ignore a, then we'll produce the following Rep1 instance:\n\n   instance Generic1 T where\n     type Rep1 T = ... (Rec0 (FakeOut a))\n     ...\n\nOh no! Now we have `a` on the RHS, but it's completely unbound. Instead, we\nensure that `a` is mapped to Any:\n\n   instance Generic1 T where\n     type Rep1 T = ... (Rec0 (FakeOut Any))\n     ...\n\nAnd now all is good.\n\nAlternatively, we could have avoided this problem by expanding all type\nsynonyms on the RHSes of Rep1 instances. But we might blow up the size of\nthese types even further by doing this, so we choose not to do so.\n\nNote [Handling kinds in a Rep instance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBecause Generic1 is poly-kinded, the representation types were generalized to\nbe kind-polymorphic as well. As a result, tc_mkRepTy must explicitly apply\nthe kind of the instance being derived to all the representation type\nconstructors. For instance, if you have\n\n    data Empty (a :: k) = Empty deriving Generic1\n\nThen the generated code is now approximately (with -fprint-explicit-kinds\nsyntax):\n\n    instance Generic1 k (Empty k) where\n      type Rep1 k (Empty k) = U1 k\n\nMost representation types have only one kind variable, making them easy to deal\nwith. The only non-trivial case is (:.:), which is only used in Generic1\ninstances:\n\n    newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =\n        Comp1 { unComp1 :: f (g p) }\n\nHere, we do something a bit counter-intuitive: we make k1 be the kind of the\ninstance being derived, and we always make k2 be *. Why *? It's because\nthe code that GHC generates using (:.:) is always of the form x :.: Rec1 y\nfor some types x and y. In other words, the second type to which (:.:) is\napplied always has kind k -> *, for some kind k, so k2 cannot possibly be\nanything other than * in a generated Generic1 instance.\n\nNote [Generics compilation speed tricks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDeriving Generic(1) is known to have a large constant factor during\ncompilation, which contributes to noticeable compilation slowdowns when\nderiving Generic(1) for large datatypes (see Trac #5642).\n\nTo ease the pain, there is a trick one can play when generating definitions for\nto(1) and from(1). If you have a datatype like:\n\n  data Letter = A | B | C | D\n\nthen a na\u00c3\u00afve Generic instance for Letter would be:\n\n  instance Generic Letter where\n    type Rep Letter = D1 ('MetaData ...) ...\n\n    to (M1 (L1 (L1 (M1 U1)))) = A\n    to (M1 (L1 (R1 (M1 U1)))) = B\n    to (M1 (R1 (L1 (M1 U1)))) = C\n    to (M1 (R1 (R1 (M1 U1)))) = D\n\n    from A = M1 (L1 (L1 (M1 U1)))\n    from B = M1 (L1 (R1 (M1 U1)))\n    from C = M1 (R1 (L1 (M1 U1)))\n    from D = M1 (R1 (R1 (M1 U1)))\n\nNotice that in every LHS pattern-match of the 'to' definition, and in every RHS\nexpression in the 'from' definition, the topmost constructor is M1. This\ncorresponds to the datatype-specific metadata (the D1 in the Rep Letter\ninstance). But this is wasteful from a typechecking perspective, since this\ndefinition requires GHC to typecheck an application of M1 in every single case,\nleading to an O(n) increase in the number of coercions the typechecker has to\nsolve, which in turn increases allocations and degrades compilation speed.\n\nLuckily, since the topmost M1 has the exact same type across every case, we can\nfactor it out reduce the typechecker's burden:\n\n  instance Generic Letter where\n    type Rep Letter = D1 ('MetaData ...) ...\n\n    to (M1 x) = case x of\n      L1 (L1 (M1 U1)) -> A\n      L1 (R1 (M1 U1)) -> B\n      R1 (L1 (M1 U1)) -> C\n      R1 (R1 (M1 U1)) -> D\n\n    from x = M1 (case x of\n      A -> L1 (L1 (M1 U1))\n      B -> L1 (R1 (M1 U1))\n      C -> R1 (L1 (M1 U1))\n      D -> R1 (R1 (M1 U1)))\n\nA simple change, but one that pays off, since it goes turns an O(n) amount of\ncoercions to an O(1) amount.\n-}\n", "num_lines": 1044}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TcHoleErrors ( findValidHoleFits, tcFilterHoleFits, HoleFit (..)\n                    , HoleFitCandidate (..), tcCheckHoleFit, tcSubsumes\n                    , withoutUnification ) where\n\nimport GhcPrelude\n\nimport TcRnTypes\nimport TcRnMonad\nimport TcMType\nimport TcEvidence\nimport TcType\nimport Type\nimport DataCon\nimport Name\nimport RdrName ( pprNameProvenance , GlobalRdrElt (..), globalRdrEnvElts )\nimport PrelNames ( gHC_ERR )\nimport Id\nimport VarSet\nimport VarEnv\nimport Bag\nimport ConLike          ( ConLike(..) )\nimport Util\nimport TcEnv (tcLookup)\nimport Outputable\nimport DynFlags\nimport Maybes\nimport FV ( fvVarList, fvVarSet, unionFV, mkFVs, FV )\n\nimport Control.Arrow ( (&&&) )\n\nimport Control.Monad    ( filterM, replicateM )\nimport Data.List        ( partition, sort, sortOn, nubBy )\nimport Data.Graph       ( graphFromEdges, topSort )\nimport Data.Function    ( on )\n\n\nimport TcSimplify    ( simpl_top, runTcSDeriveds )\nimport TcUnify       ( tcSubType_NC )\n\nimport ExtractDocs ( extractDocs )\nimport qualified Data.Map as Map\nimport HsDoc           ( HsDocString, unpackHDS, DeclDocMap(..) )\nimport HscTypes        ( ModIface(..) )\nimport LoadIface       ( loadInterfaceForNameMaybe )\n\nimport PrelInfo (knownKeyNames)\n\n\n{-\nNote [Valid hole fits include ...]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n`findValidHoleFits` returns the \"Valid hole fits include ...\" message.\nFor example, look at the following definitions in a file called test.hs:\n\n   import Data.List (inits)\n\n   f :: [String]\n   f = _ \"hello, world\"\n\nThe hole in `f` would generate the message:\n\n  \u00e2\u20ac\u00a2 Found hole: _ :: [Char] -> [String]\n  \u00e2\u20ac\u00a2 In the expression: _\n    In the expression: _ \"hello, world\"\n    In an equation for \u00e2\u20ac\u02dcf\u00e2\u20ac\u2122: f = _ \"hello, world\"\n  \u00e2\u20ac\u00a2 Relevant bindings include f :: [String] (bound at test.hs:6:1)\n    Valid hole fits include\n      lines :: String -> [String]\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcbase-4.11.0.0:Data.OldList\u00e2\u20ac\u2122))\n      words :: String -> [String]\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcbase-4.11.0.0:Data.OldList\u00e2\u20ac\u2122))\n      inits :: forall a. [a] -> [[a]]\n        with inits @Char\n        (imported from \u00e2\u20ac\u02dcData.List\u00e2\u20ac\u2122 at mpt.hs:4:19-23\n          (and originally defined in \u00e2\u20ac\u02dcbase-4.11.0.0:Data.OldList\u00e2\u20ac\u2122))\n      repeat :: forall a. a -> [a]\n        with repeat @String\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcGHC.List\u00e2\u20ac\u2122))\n      fail :: forall (m :: * -> *). Monad m => forall a. String -> m a\n        with fail @[] @String\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcGHC.Base\u00e2\u20ac\u2122))\n      return :: forall (m :: * -> *). Monad m => forall a. a -> m a\n        with return @[] @String\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcGHC.Base\u00e2\u20ac\u2122))\n      pure :: forall (f :: * -> *). Applicative f => forall a. a -> f a\n        with pure @[] @String\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcGHC.Base\u00e2\u20ac\u2122))\n      read :: forall a. Read a => String -> a\n        with read @[String]\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcText.Read\u00e2\u20ac\u2122))\n      mempty :: forall a. Monoid a => a\n        with mempty @([Char] -> [String])\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at mpt.hs:3:8-9\n          (and originally defined in \u00e2\u20ac\u02dcGHC.Base\u00e2\u20ac\u2122))\n\nValid hole fits are found by checking top level identifiers and local bindings\nin scope for whether their type can be instantiated to the the type of the hole.\nAdditionally, we also need to check whether all relevant constraints are solved\nby choosing an identifier of that type as well, see Note [Relevant Constraints]\n\nSince checking for subsumption results in the side-effect of type variables\nbeing unified by the simplifier, we need to take care to restore them after\nto being flexible type variables after we've checked for subsumption.\nThis is to avoid affecting the hole and later checks by prematurely having\nunified one of the free unification variables.\n\nWhen outputting, we sort the hole fits by the size of the types we'd need to\napply by type application to the type of the fit to to make it fit. This is done\nin order to display \"more relevant\" suggestions first. Another option is to\nsort by building a subsumption graph of fits, i.e. a graph of which fits subsume\nwhat other fits, and then outputting those fits which are are subsumed by other\nfits (i.e. those more specific than other fits) first. This results in the ones\n\"closest\" to the type of the hole to be displayed first.\n\nTo help users understand how the suggested fit works, we also display the values\nthat the quantified type variables would take if that fit is used, like\n`mempty @([Char] -> [String])` and `pure @[] @String` in the example above.\nIf -XTypeApplications is enabled, this can even be copied verbatim as a\nreplacement for the hole.\n\n\nNote [Nested implications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nFor the simplifier to be able to use any givens present in the enclosing\nimplications to solve relevant constraints, we nest the wanted subsumption\nconstraints and relevant constraints within the enclosing implications.\n\nAs an example, let's look at the following code:\n\n  f :: Show a => a -> String\n  f x = show _\n\nThe hole will result in the hole constraint:\n\n  [WD] __a1ph {0}:: a0_a1pd[tau:2] (CHoleCan: ExprHole(_))\n\nHere the nested implications are just one level deep, namely:\n\n  [Implic {\n      TcLevel = 2\n      Skolems = a_a1pa[sk:2]\n      No-eqs = True\n      Status = Unsolved\n      Given = $dShow_a1pc :: Show a_a1pa[sk:2]\n      Wanted =\n        WC {wc_simple =\n              [WD] __a1ph {0}:: a_a1pd[tau:2] (CHoleCan: ExprHole(_))\n              [WD] $dShow_a1pe {0}:: Show a_a1pd[tau:2] (CDictCan(psc))}\n      Binds = EvBindsVar<a1pi>\n      Needed inner = []\n      Needed outer = []\n      the type signature for:\n        f :: forall a. Show a => a -> String }]\n\nAs we can see, the givens say that the information about the skolem\n`a_a1pa[sk:2]` fulfills the Show constraint.\n\nThe simples are:\n\n  [[WD] __a1ph {0}:: a0_a1pd[tau:2] (CHoleCan: ExprHole(_)),\n    [WD] $dShow_a1pe {0}:: Show a0_a1pd[tau:2] (CNonCanonical)]\n\nI.e. the hole `a0_a1pd[tau:2]` and the constraint that the type of the hole must\nfulfill `Show a0_a1pd[tau:2])`.\n\nSo when we run the check, we need to make sure that the\n\n  [WD] $dShow_a1pe {0}:: Show a0_a1pd[tau:2] (CNonCanonical)\n\nConstraint gets solved. When we now check for whether `x :: a0_a1pd[tau:2]` fits\nthe hole in `tcCheckHoleFit`, the call to `tcSubType` will end up writing the\nmeta type variable `a0_a1pd[tau:2] := a_a1pa[sk:2]`. By wrapping the wanted\nconstraints needed by tcSubType_NC and the relevant constraints (see\nNote [Relevant Constraints] for more details) in the nested implications, we\ncan pass the information in the givens along to the simplifier. For our example,\nwe end up needing to check whether the following constraints are soluble.\n\n  WC {wc_impl =\n        Implic {\n          TcLevel = 2\n          Skolems = a_a1pa[sk:2]\n          No-eqs = True\n          Status = Unsolved\n          Given = $dShow_a1pc :: Show a_a1pa[sk:2]\n          Wanted =\n            WC {wc_simple =\n                  [WD] $dShow_a1pe {0}:: Show a0_a1pd[tau:2] (CNonCanonical)}\n          Binds = EvBindsVar<a1pl>\n          Needed inner = []\n          Needed outer = []\n          the type signature for:\n            f :: forall a. Show a => a -> String }}\n\nBut since `a0_a1pd[tau:2] := a_a1pa[sk:2]` and we have from the nested\nimplications that Show a_a1pa[sk:2] is a given, this is trivial, and we end up\nwith a final WC of WC {}, confirming x :: a0_a1pd[tau:2] as a match.\n\nTo avoid side-effects on the nested implications, we create a new EvBindsVar so\nthat any changes to the ev binds during a check remains localised to that check.\n\n\nNote [Valid refinement hole fits include ...]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the `-frefinement-level-hole-fits=N` flag is given, we additionally look\nfor \"valid refinement hole fits\"\", i.e. valid hole fits with up to N\nadditional holes in them.\n\nWith `-frefinement-level-hole-fits=0` (the default), GHC will find all\nidentifiers 'f' (top-level or nested) that will fit in the hole.\n\nWith `-frefinement-level-hole-fits=1`, GHC will additionally find all\napplications 'f _' that will fit in the hole, where 'f' is an in-scope\nidentifier, applied to single argument.  It will also report the type of the\nneeded argument (a new hole).\n\nAnd similarly as the number of arguments increases\n\nAs an example, let's look at the following code:\n\n  f :: [Integer] -> Integer\n  f = _\n\nwith `-frefinement-level-hole-fits=1`, we'd get:\n\n  Valid refinement hole fits include\n\n    foldl1 (_ :: Integer -> Integer -> Integer)\n      with foldl1 @[] @Integer\n      where foldl1 :: forall (t :: * -> *).\n                      Foldable t =>\n                      forall a. (a -> a -> a) -> t a -> a\n    foldr1 (_ :: Integer -> Integer -> Integer)\n      with foldr1 @[] @Integer\n      where foldr1 :: forall (t :: * -> *).\n                      Foldable t =>\n                      forall a. (a -> a -> a) -> t a -> a\n    const (_ :: Integer)\n      with const @Integer @[Integer]\n      where const :: forall a b. a -> b -> a\n    ($) (_ :: [Integer] -> Integer)\n      with ($) @'GHC.Types.LiftedRep @[Integer] @Integer\n      where ($) :: forall a b. (a -> b) -> a -> b\n    fail (_ :: String)\n      with fail @((->) [Integer]) @Integer\n      where fail :: forall (m :: * -> *).\n                    Monad m =>\n                    forall a. String -> m a\n    return (_ :: Integer)\n      with return @((->) [Integer]) @Integer\n      where return :: forall (m :: * -> *). Monad m => forall a. a -> m a\n    (Some refinement hole fits suppressed;\n      use -fmax-refinement-hole-fits=N or -fno-max-refinement-hole-fits)\n\nWhich are hole fits with holes in them. This allows e.g. beginners to\ndiscover the fold functions and similar, but also allows for advanced users\nto figure out the valid functions in the Free monad, e.g.\n\n  instance Functor f => Monad (Free f) where\n      Pure a >>= f = f a\n      Free f >>= g = Free (fmap _a f)\n\nWill output (with -frefinment-level-hole-fits=1):\n    Found hole: _a :: Free f a -> Free f b\n          Where: \u00e2\u20ac\u02dca\u00e2\u20ac\u2122, \u00e2\u20ac\u02dcb\u00e2\u20ac\u2122 are rigid type variables bound by\n                  the type signature for:\n                    (>>=) :: forall a b. Free f a -> (a -> Free f b) -> Free f b\n                  at fms.hs:25:12-14\n                \u00e2\u20ac\u02dcf\u00e2\u20ac\u2122 is a rigid type variable bound by\n    ...\n    Relevant bindings include\n      g :: a -> Free f b (bound at fms.hs:27:16)\n      f :: f (Free f a) (bound at fms.hs:27:10)\n      (>>=) :: Free f a -> (a -> Free f b) -> Free f b\n        (bound at fms.hs:25:12)\n    ...\n    Valid refinement hole fits include\n      ...\n      (=<<) (_ :: a -> Free f b)\n        with (=<<) @(Free f) @a @b\n        where (=<<) :: forall (m :: * -> *) a b.\n                      Monad m =>\n                      (a -> m b) -> m a -> m b\n        (imported from \u00e2\u20ac\u02dcPrelude\u00e2\u20ac\u2122 at fms.hs:5:18-22\n        (and originally defined in \u00e2\u20ac\u02dcGHC.Base\u00e2\u20ac\u2122))\n      ...\n\nWhere `(=<<) _` is precisely the function we want (we ultimately want `>>= g`).\n\nWe find these refinement suggestions by considering hole fits that don't\nfit the type of the hole, but ones that would fit if given an additional\nargument. We do this by creating a new type variable with `newOpenFlexiTyVar`\n(e.g. `t_a1/m[tau:1]`), and then considering hole fits of the type\n`t_a1/m[tau:1] -> v` where `v` is the type of the hole.\n\nSince the simplifier is free to unify this new type variable with any type, we\ncan discover any identifiers that would fit if given another identifier of a\nsuitable type. This is then generalized so that we can consider any number of\nadditional arguments by setting the `-frefinement-level-hole-fits` flag to any\nnumber, and then considering hole fits like e.g. `foldl _ _` with two additional\narguments.\n\nTo make sure that the refinement hole fits are useful, we check that the types\nof the additional holes have a concrete value and not just an invented type\nvariable. This eliminates suggestions such as `head (_ :: [t0 -> a]) (_ :: t0)`,\nand limits the number of less than useful refinement hole fits.\n\nAdditionally, to further aid the user in their implementation, we show the\ntypes of the holes the binding would have to be applied to in order to work.\nIn the free monad example above, this is demonstrated with\n`(=<<) (_ :: a -> Free f b)`, which tells the user that the `(=<<)` needs to\nbe applied to an expression of type `a -> Free f b` in order to match.\nIf -XScopedTypeVariables is enabled, this hole fit can even be copied verbatim.\n\n\nNote [Relevant Constraints]\n~~~~~~~~~~~~~~~~~~~\n\nAs highlighted by Trac #14273, we need to check any relevant constraints as well\nas checking for subsumption. Relevant constraints are the simple constraints\nwhose free unification variables are mentioned in the type of the hole.\n\nIn the simplest case, these are all non-hole constraints in the simples, such\nas is the case in\n\n  f :: String\n  f = show _\n\nWhere the simples will be :\n\n  [[WD] __a1kz {0}:: a0_a1kv[tau:1] (CHoleCan: ExprHole(_)),\n    [WD] $dShow_a1kw {0}:: Show a0_a1kv[tau:1] (CNonCanonical)]\n\nHowever, when there are multiple holes, we need to be more careful. As an\nexample, Let's take a look at the following code:\n\n  f :: Show a => a -> String\n  f x = show (_b (show _a))\n\nHere there are two holes, `_a` and `_b`, and the simple constraints passed to\nfindValidHoleFits are:\n\n  [[WD] _a_a1pi {0}:: String\n                        -> a0_a1pd[tau:2] (CHoleCan: ExprHole(_b)),\n    [WD] _b_a1ps {0}:: a1_a1po[tau:2] (CHoleCan: ExprHole(_a)),\n    [WD] $dShow_a1pe {0}:: Show a0_a1pd[tau:2] (CNonCanonical),\n    [WD] $dShow_a1pp {0}:: Show a1_a1po[tau:2] (CNonCanonical)]\n\n\nHere we have the two hole constraints for `_a` and `_b`, but also additional\nconstraints that these holes must fulfill. When we are looking for a match for\nthe hole `_a`, we filter the simple constraints to the \"Relevant constraints\",\nby throwing out all hole constraints and any constraints which do not mention\na variable mentioned in the type of the hole. For hole `_a`, we will then\nonly require that the `$dShow_a1pp` constraint is solved, since that is\nthe only non-hole constraint that mentions any free type variables mentioned in\nthe hole constraint for `_a`, namely `a_a1pd[tau:2]` , and similarly for the\nhole `_b` we only require that the `$dShow_a1pe` constraint is solved.\n\nNote [Leaking errors]\n~~~~~~~~~~~~~~~~~~~\n\nWhen considering candidates, GHC believes that we're checking for validity in\nactual source. However, As evidenced by #15321, #15007 and #15202, this can\ncause bewildering error messages. The solution here is simple: if a candidate\nwould cause the type checker to error, it is not a valid hole fit, and thus it\nis discarded.\n\n-}\n\n\ndata HoleFitDispConfig = HFDC { showWrap :: Bool\n                              , showWrapVars :: Bool\n                              , showType :: Bool\n                              , showProv :: Bool\n                              , showMatches :: Bool }\n\ndebugHoleFitDispConfig :: HoleFitDispConfig\ndebugHoleFitDispConfig = HFDC True True True False False\n\n\n-- We read the various -no-show-*-of-hole-fits flags\n-- and set the display config accordingly.\ngetHoleFitDispConfig :: TcM HoleFitDispConfig\ngetHoleFitDispConfig\n  = do { sWrap <- goptM Opt_ShowTypeAppOfHoleFits\n       ; sWrapVars <- goptM Opt_ShowTypeAppVarsOfHoleFits\n       ; sType <- goptM Opt_ShowTypeOfHoleFits\n       ; sProv <- goptM Opt_ShowProvOfHoleFits\n       ; sMatc <- goptM Opt_ShowMatchesOfHoleFits\n       ; return HFDC{ showWrap = sWrap, showWrapVars = sWrapVars\n                    , showProv = sProv, showType = sType\n                    , showMatches = sMatc } }\n\n-- Which sorting algorithm to use\ndata SortingAlg = NoSorting      -- Do not sort the fits at all\n                | BySize         -- Sort them by the size of the match\n                | BySubsumption  -- Sort by full subsumption\n                deriving (Eq, Ord)\n\ngetSortingAlg :: TcM SortingAlg\ngetSortingAlg =\n    do { shouldSort <- goptM Opt_SortValidHoleFits\n       ; subsumSort <- goptM Opt_SortBySubsumHoleFits\n       ; sizeSort <- goptM Opt_SortBySizeHoleFits\n       -- We default to sizeSort unless it has been explicitly turned off\n       -- or subsumption sorting has been turned on.\n       ; return $ if not shouldSort\n                    then NoSorting\n                    else if subsumSort\n                         then BySubsumption\n                         else if sizeSort\n                              then BySize\n                              else NoSorting }\n\n\n-- | HoleFitCandidates are passed to the filter and checked whether they can be\n-- made to fit.\ndata HoleFitCandidate = IdHFCand Id             -- An id, like locals.\n                      | NameHFCand Name         -- A name, like built-in syntax.\n                      | GreHFCand GlobalRdrElt  -- A global, like imported ids.\n                      deriving (Eq)\ninstance Outputable HoleFitCandidate where\n  ppr = pprHoleFitCand\n\npprHoleFitCand :: HoleFitCandidate -> SDoc\npprHoleFitCand (IdHFCand id) = text \"Id HFC: \" <> ppr id\npprHoleFitCand (NameHFCand name) = text \"Name HFC: \" <> ppr name\npprHoleFitCand (GreHFCand gre) = text \"Gre HFC: \" <> ppr gre\n\ninstance HasOccName HoleFitCandidate where\n  occName hfc = case hfc of\n                  IdHFCand id -> occName id\n                  NameHFCand name -> occName name\n                  GreHFCand gre -> occName (gre_name gre)\n\n-- | HoleFit is the type we use for valid hole fits. It contains the\n-- element that was checked, the Id of that element as found by `tcLookup`,\n-- and the refinement level of the fit, which is the number of extra argument\n-- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`).\ndata HoleFit =\n  HoleFit { hfId   :: Id       -- The elements id in the TcM\n          , hfCand :: HoleFitCandidate  -- The candidate that was checked.\n          , hfType :: TcType -- The type of the id, possibly zonked.\n          , hfRefLvl :: Int  -- The number of holes in this fit.\n          , hfWrap :: [TcType] -- The wrapper for the match.\n          , hfMatches :: [TcType]  -- What the refinement variables got matched\n                                   -- with, if anything\n          , hfDoc :: Maybe HsDocString } -- Documentation of this HoleFit, if\n                                         -- available.\n\n\nhfName :: HoleFit -> Name\nhfName hf = case hfCand hf of\n              IdHFCand id -> idName id\n              NameHFCand name -> name\n              GreHFCand gre -> gre_name gre\n\nhfIsLcl :: HoleFit -> Bool\nhfIsLcl hf = case hfCand hf of\n               IdHFCand _    -> True\n               NameHFCand _  -> False\n               GreHFCand gre -> gre_lcl gre\n\n-- We define an Eq and Ord instance to be able to build a graph.\ninstance Eq HoleFit where\n   (==) = (==) `on` hfId\n\n-- We compare HoleFits by their name instead of their Id, since we don't\n-- want our tests to be affected by the non-determinism of `nonDetCmpVar`,\n-- which is used to compare Ids. When comparing, we want HoleFits with a lower\n-- refinement level to come first.\ninstance Ord HoleFit where\n  compare a b = cmp a b\n    where cmp  = if hfRefLvl a == hfRefLvl b\n                 then compare `on` hfName\n                 else compare `on` hfRefLvl\n\ninstance Outputable HoleFit where\n    ppr = pprHoleFit debugHoleFitDispConfig\n\n-- If enabled, we go through the fits and add any associated documentation,\n-- by looking it up in the module or the environment (for local fits)\naddDocs :: [HoleFit] -> TcM [HoleFit]\naddDocs fits =\n  do { showDocs <- goptM Opt_ShowDocsOfHoleFits\n     ; if showDocs\n       then do { (_, DeclDocMap lclDocs, _) <- extractDocs <$> getGblEnv\n               ; mapM (upd lclDocs) fits }\n       else return fits }\n  where\n   msg = text \"TcHoleErrors addDocs\"\n   lookupInIface name (ModIface { mi_decl_docs = DeclDocMap dmap })\n     = Map.lookup name dmap\n   upd lclDocs fit =\n     let name = hfName fit in\n     do { doc <- if hfIsLcl fit\n                 then pure (Map.lookup name lclDocs)\n                 else do { mbIface <- loadInterfaceForNameMaybe msg name\n                         ; return $ mbIface >>= lookupInIface name }\n        ; return $ fit {hfDoc = doc} }\n\n-- For pretty printing hole fits, we display the name and type of the fit,\n-- with added '_' to represent any extra arguments in case of a non-zero\n-- refinement level.\npprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc\npprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) hf = hang display 2 provenance\n    where name = hfName hf\n          ty = hfType hf\n          matches =  hfMatches hf\n          wrap = hfWrap hf\n          tyApp = sep $ map ((text \"@\" <>) . pprParendType) wrap\n          tyAppVars = sep $ punctuate comma $\n              map (\\(v,t) -> ppr v <+> text \"~\" <+> pprParendType t) $\n                zip vars wrap\n            where\n              vars = unwrapTypeVars ty\n              -- Attempts to get all the quantified type variables in a type,\n              -- e.g.\n              -- return :: forall (m :: * -> *) Monad m => (forall a . a) -> m a\n              -- into [m, a]\n              unwrapTypeVars :: Type -> [TyVar]\n              unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of\n                                  Just (_, unfunned) -> unwrapTypeVars unfunned\n                                  _ -> []\n                where (vars, unforalled) = splitForAllTys t\n          holeVs = sep $ map (parens . (text \"_\" <+> dcolon <+>) . ppr) matches\n          holeDisp = if sMs then holeVs\n                     else sep $ replicate (length matches) $ text \"_\"\n          occDisp = pprPrefixOcc name\n          tyDisp = ppWhen sTy $ dcolon <+> ppr ty\n          has = not . null\n          wrapDisp = ppWhen (has wrap && (sWrp || sWrpVars))\n                      $ text \"with\" <+> if sWrp || not sTy\n                                        then occDisp <+> tyApp\n                                        else tyAppVars\n          docs = case hfDoc hf of\n                   Just d -> text \"{-^\" <>\n                             (vcat . map text . lines . unpackHDS) d\n                             <> text \"-}\"\n                   _ -> empty\n          funcInfo = ppWhen (has matches && sTy) $\n                       text \"where\" <+> occDisp <+> tyDisp\n          subDisp = occDisp <+> if has matches then holeDisp else tyDisp\n          display =  subDisp $$ nest 2 (funcInfo $+$ docs $+$ wrapDisp)\n          provenance = ppWhen sProv $ parens $\n                case hfCand hf of\n                    GreHFCand gre -> pprNameProvenance gre\n                    _ -> text \"bound at\" <+> ppr (getSrcLoc name)\n\ngetLocalBindings :: TidyEnv -> Ct -> TcM [Id]\ngetLocalBindings tidy_orig ct\n = do { (env1, _) <- zonkTidyOrigin tidy_orig (ctLocOrigin loc)\n      ; go env1 [] (removeBindingShadowing $ tcl_bndrs lcl_env) }\n  where\n    loc     = ctEvLoc (ctEvidence ct)\n    lcl_env = ctLocEnv loc\n\n    go :: TidyEnv -> [Id] -> [TcBinder] -> TcM [Id]\n    go _ sofar [] = return (reverse sofar)\n    go env sofar (tc_bndr : tc_bndrs) =\n        case tc_bndr of\n          TcIdBndr id _ -> keep_it id\n          _ -> discard_it\n     where\n        discard_it = go env sofar tc_bndrs\n        keep_it id = go env (id:sofar) tc_bndrs\n\n\n\n-- See Note [Valid hole fits include ...]\nfindValidHoleFits :: TidyEnv        -- ^ The tidy_env for zonking\n                  -> [Implication]  -- ^ Enclosing implications for givens\n                  -> [Ct]\n                  -- ^ The  unsolved simple constraints in the implication for\n                  -- the hole.\n                  -> Ct -- ^ The hole constraint itself\n                  -> TcM (TidyEnv, SDoc)\nfindValidHoleFits tidy_env implics simples ct | isExprHoleCt ct =\n  do { rdr_env <- getGlobalRdrEnv\n     ; lclBinds <- getLocalBindings tidy_env ct\n     ; maxVSubs <- maxValidHoleFits <$> getDynFlags\n     ; hfdc <- getHoleFitDispConfig\n     ; sortingAlg <- getSortingAlg\n     ; let findVLimit = if sortingAlg > NoSorting then Nothing else maxVSubs\n     ; refLevel <- refLevelHoleFits <$> getDynFlags\n     ; traceTc \"findingValidHoleFitsFor { \" $ ppr ct\n     ; traceTc \"hole_lvl is:\" $ ppr hole_lvl\n     ; traceTc \"implics are: \" $ ppr implics\n     ; traceTc \"simples are: \" $ ppr simples\n     ; traceTc \"locals are: \" $ ppr lclBinds\n     ; let (lcl, gbl) = partition gre_lcl (globalRdrEnvElts rdr_env)\n           -- We remove binding shadowings here, but only for the local level.\n           -- this is so we e.g. suggest the global fmap from the Functor class\n           -- even though there is a local definition as well, such as in the\n           -- Free monad example.\n           locals = removeBindingShadowing $\n                      map IdHFCand lclBinds ++ map GreHFCand lcl\n           globals = map GreHFCand gbl\n           syntax = map NameHFCand builtIns\n           to_check = locals ++ syntax ++ globals\n     ; (searchDiscards, subs) <-\n        tcFilterHoleFits findVLimit implics relevantCts (hole_ty, []) to_check\n     ; (tidy_env, tidy_subs) <- zonkSubs tidy_env subs\n     ; tidy_sorted_subs <- sortFits sortingAlg tidy_subs\n     ; let (pVDisc, limited_subs) = possiblyDiscard maxVSubs tidy_sorted_subs\n           vDiscards = pVDisc || searchDiscards\n     ; subs_with_docs <- addDocs limited_subs\n     ; let vMsg = ppUnless (null subs_with_docs) $\n                    hang (text \"Valid hole fits include\") 2 $\n                      vcat (map (pprHoleFit hfdc) subs_with_docs)\n                        $$ ppWhen vDiscards subsDiscardMsg\n     -- Refinement hole fits. See Note [Valid refinement hole fits include ...]\n     ; (tidy_env, refMsg) <- if refLevel >= Just 0 then\n         do { maxRSubs <- maxRefHoleFits <$> getDynFlags\n            -- We can use from just, since we know that Nothing >= _ is False.\n            ; let refLvls = [1..(fromJust refLevel)]\n            -- We make a new refinement type for each level of refinement, where\n            -- the level of refinement indicates number of additional arguments\n            -- to allow.\n            ; ref_tys <- mapM mkRefTy refLvls\n            ; traceTc \"ref_tys are\" $ ppr ref_tys\n            ; let findRLimit = if sortingAlg > NoSorting then Nothing\n                                                         else maxRSubs\n            ; refDs <- mapM (flip (tcFilterHoleFits findRLimit implics\n                                     relevantCts) to_check) ref_tys\n            ; (tidy_env, tidy_rsubs) <- zonkSubs tidy_env $ concatMap snd refDs\n            ; tidy_sorted_rsubs <- sortFits sortingAlg tidy_rsubs\n            -- For refinement substitutions we want matches\n            -- like id (_ :: t), head (_ :: [t]), asTypeOf (_ :: t),\n            -- and others in that vein to appear last, since these are\n            -- unlikely to be the most relevant fits.\n            ; (tidy_env, tidy_hole_ty) <- zonkTidyTcType tidy_env hole_ty\n            ; let hasExactApp = any (tcEqType tidy_hole_ty) . hfWrap\n                  (exact, not_exact) = partition hasExactApp tidy_sorted_rsubs\n                  (pRDisc, exact_last_rfits) =\n                    possiblyDiscard maxRSubs $ not_exact ++ exact\n                  rDiscards = pRDisc || any fst refDs\n            ; rsubs_with_docs <- addDocs exact_last_rfits\n            ; return (tidy_env,\n                ppUnless (null rsubs_with_docs) $\n                  hang (text \"Valid refinement hole fits include\") 2 $\n                  vcat (map (pprHoleFit hfdc) rsubs_with_docs)\n                    $$ ppWhen rDiscards refSubsDiscardMsg) }\n       else return (tidy_env, empty)\n     ; traceTc \"findingValidHoleFitsFor }\" empty\n     ; return (tidy_env, vMsg $$ refMsg) }\n  where\n    -- We extract the type, the tcLevel and the types free variables\n    -- from from the constraint.\n    hole_ty :: TcPredType\n    hole_ty = ctPred ct\n    hole_fvs :: FV\n    hole_fvs = tyCoFVsOfType hole_ty\n    hole_lvl = ctLocLevel $ ctEvLoc $ ctEvidence ct\n\n    -- BuiltInSyntax names like (:) and []\n    builtIns :: [Name]\n    builtIns = filter isBuiltInSyntax knownKeyNames\n\n    -- We make a refinement type by adding a new type variable in front\n    -- of the type of t h hole, going from e.g. [Integer] -> Integer\n    -- to t_a1/m[tau:1] -> [Integer] -> Integer. This allows the simplifier\n    -- to unify the new type variable with any type, allowing us\n    -- to suggest a \"refinement hole fit\", like `(foldl1 _)` instead\n    -- of only concrete hole fits like `sum`.\n    mkRefTy :: Int -> TcM (TcType, [TcTyVar])\n    mkRefTy refLvl = (wrapWithVars &&& id) <$> newTyVars\n      where newTyVars = replicateM refLvl $ setLvl <$>\n                            (newOpenTypeKind >>= newFlexiTyVar)\n            setLvl = flip setMetaTyVarTcLevel hole_lvl\n            wrapWithVars vars = mkVisFunTys (map mkTyVarTy vars) hole_ty\n\n    sortFits :: SortingAlg    -- How we should sort the hole fits\n             -> [HoleFit]     -- The subs to sort\n             -> TcM [HoleFit]\n    sortFits NoSorting subs = return subs\n    sortFits BySize subs\n        = (++) <$> sortBySize (sort lclFits)\n               <*> sortBySize (sort gblFits)\n        where (lclFits, gblFits) = span hfIsLcl subs\n\n    -- To sort by subsumption, we invoke the sortByGraph function, which\n    -- builds the subsumption graph for the fits and then sorts them using a\n    -- graph sort.  Since we want locals to come first anyway, we can sort\n    -- them separately. The substitutions are already checked in local then\n    -- global order, so we can get away with using span here.\n    -- We use (<*>) to expose the parallelism, in case it becomes useful later.\n    sortFits BySubsumption subs\n        = (++) <$> sortByGraph (sort lclFits)\n               <*> sortByGraph (sort gblFits)\n        where (lclFits, gblFits) = span hfIsLcl subs\n\n    -- See Note [Relevant Constraints]\n    relevantCts :: [Ct]\n    relevantCts = if isEmptyVarSet (fvVarSet hole_fvs) then []\n                  else filter isRelevant simples\n      where ctFreeVarSet :: Ct -> VarSet\n            ctFreeVarSet = fvVarSet . tyCoFVsOfType . ctPred\n            hole_fv_set = fvVarSet hole_fvs\n            anyFVMentioned :: Ct -> Bool\n            anyFVMentioned ct = not $ isEmptyVarSet $\n                                  ctFreeVarSet ct `intersectVarSet` hole_fv_set\n            -- We filter out those constraints that have no variables (since\n            -- they won't be solved by finding a type for the type variable\n            -- representing the hole) and also other holes, since we're not\n            -- trying to find hole fits for many holes at once.\n            isRelevant ct = not (isEmptyVarSet (ctFreeVarSet ct))\n                            && anyFVMentioned ct\n                            && not (isHoleCt ct)\n\n    -- We zonk the hole fits so that the output aligns with the rest\n    -- of the typed hole error message output.\n    zonkSubs :: TidyEnv -> [HoleFit] -> TcM (TidyEnv, [HoleFit])\n    zonkSubs = zonkSubs' []\n      where zonkSubs' zs env [] = return (env, reverse zs)\n            zonkSubs' zs env (hf:hfs) = do { (env', z) <- zonkSub env hf\n                                           ; zonkSubs' (z:zs) env' hfs }\n            zonkSub env hf@HoleFit{hfType = ty, hfMatches = m, hfWrap = wrp}\n              = do { (env, ty') <- zonkTidyTcType env ty\n                   ; (env, m') <- zonkTidyTcTypes env m\n                   ; (env, wrp') <- zonkTidyTcTypes env wrp\n                   ; let zFit = hf {hfType = ty', hfMatches = m', hfWrap = wrp'}\n                   ; return (env, zFit ) }\n\n    -- Based on the flags, we might possibly discard some or all the\n    -- fits we've found.\n    possiblyDiscard :: Maybe Int -> [HoleFit] -> (Bool, [HoleFit])\n    possiblyDiscard (Just max) fits = (fits `lengthExceeds` max, take max fits)\n    possiblyDiscard Nothing fits = (False, fits)\n\n    -- Sort by size uses as a measure for relevance the sizes of the\n    -- different types needed to instantiate the fit to the type of the hole.\n    -- This is much quicker than sorting by subsumption, and gives reasonable\n    -- results in most cases.\n    sortBySize :: [HoleFit] -> TcM [HoleFit]\n    sortBySize = return . sortOn sizeOfFit\n      where sizeOfFit :: HoleFit -> TypeSize\n            sizeOfFit = sizeTypes . nubBy tcEqType .  hfWrap\n\n    -- Based on a suggestion by phadej on #ghc, we can sort the found fits\n    -- by constructing a subsumption graph, and then do a topological sort of\n    -- the graph. This makes the most specific types appear first, which are\n    -- probably those most relevant. This takes a lot of work (but results in\n    -- much more useful output), and can be disabled by\n    -- '-fno-sort-valid-hole-fits'.\n    sortByGraph :: [HoleFit] -> TcM [HoleFit]\n    sortByGraph fits = go [] fits\n      where tcSubsumesWCloning :: TcType -> TcType -> TcM Bool\n            tcSubsumesWCloning ht ty = withoutUnification fvs (tcSubsumes ht ty)\n              where fvs = tyCoFVsOfTypes [ht,ty]\n            go :: [(HoleFit, [HoleFit])] -> [HoleFit] -> TcM [HoleFit]\n            go sofar [] = do { traceTc \"subsumptionGraph was\" $ ppr sofar\n                             ; return $ uncurry (++)\n                                         $ partition hfIsLcl topSorted }\n              where toV (hf, adjs) = (hf, hfId hf, map hfId adjs)\n                    (graph, fromV, _) = graphFromEdges $ map toV sofar\n                    topSorted = map ((\\(h,_,_) -> h) . fromV) $ topSort graph\n            go sofar (hf:hfs) =\n              do { adjs <-\n                     filterM (tcSubsumesWCloning (hfType hf) . hfType) fits\n                 ; go ((hf, adjs):sofar) hfs }\n\n-- We don't (as of yet) handle holes in types, only in expressions.\nfindValidHoleFits env _ _ _ = return (env, empty)\n\n\n-- | tcFilterHoleFits filters the candidates by whether, given the implications\n-- and the relevant constraints, they can be made to match the type by\n-- running the type checker. Stops after finding limit matches.\ntcFilterHoleFits :: Maybe Int\n               -- ^ How many we should output, if limited\n               -> [Implication]\n               -- ^ Enclosing implications for givens\n               -> [Ct]\n               -- ^ Any relevant unsolved simple constraints\n               -> (TcType, [TcTyVar])\n               -- ^ The type to check for fits and a list of refinement\n               -- variables (free type variables in the type) for emulating\n               -- additional holes.\n               -> [HoleFitCandidate]\n               -- ^ The candidates to check whether fit.\n               -> TcM (Bool, [HoleFit])\n               -- ^ We return whether or not we stopped due to hitting the limit\n               -- and the fits we found.\ntcFilterHoleFits (Just 0) _ _ _ _ = return (False, []) -- Stop right away on 0\ntcFilterHoleFits limit implics relevantCts ht@(hole_ty, _) candidates =\n  do { traceTc \"checkingFitsFor {\" $ ppr hole_ty\n     ; (discards, subs) <- go [] emptyVarSet limit ht candidates\n     ; traceTc \"checkingFitsFor }\" empty\n     ; return (discards, subs) }\n  where\n    hole_fvs :: FV\n    hole_fvs = tyCoFVsOfType hole_ty\n    -- Kickoff the checking of the elements.\n    -- We iterate over the elements, checking each one in turn for whether\n    -- it fits, and adding it to the results if it does.\n    go :: [HoleFit]           -- What we've found so far.\n       -> VarSet              -- Ids we've already checked\n       -> Maybe Int           -- How many we're allowed to find, if limited\n       -> (TcType, [TcTyVar]) -- The type, and its refinement variables.\n       -> [HoleFitCandidate]  -- The elements we've yet to check.\n       -> TcM (Bool, [HoleFit])\n    go subs _ _ _ [] = return (False, reverse subs)\n    go subs _ (Just 0) _ _ = return (True, reverse subs)\n    go subs seen maxleft ty (el:elts) =\n        -- See Note [Leaking errors]\n        tryTcDiscardingErrs discard_it $\n        do { traceTc \"lookingUp\" $ ppr el\n           ; maybeThing <- lookup el\n           ; case maybeThing of\n               Just id | not_trivial id ->\n                       do { fits <- fitsHole ty (idType id)\n                          ; case fits of\n                              Just (wrp, matches) -> keep_it id wrp matches\n                              _ -> discard_it }\n               _ -> discard_it }\n        where\n          -- We want to filter out undefined and the likes from GHC.Err\n          not_trivial id = nameModule_maybe (idName id) /= Just gHC_ERR\n\n          lookup :: HoleFitCandidate -> TcM (Maybe Id)\n          lookup (IdHFCand id) = return (Just id)\n          lookup hfc = do { thing <- tcLookup name\n                          ; return $ case thing of\n                                       ATcId {tct_id = id} -> Just id\n                                       AGlobal (AnId id)   -> Just id\n                                       AGlobal (AConLike (RealDataCon con)) ->\n                                           Just (dataConWrapId con)\n                                       _ -> Nothing }\n            where name = case hfc of\n                           IdHFCand id -> idName id\n                           GreHFCand gre -> gre_name gre\n                           NameHFCand name -> name\n          discard_it = go subs seen maxleft ty elts\n          keep_it eid wrp ms = go (fit:subs) (extendVarSet seen eid)\n                                 ((\\n -> n - 1) <$> maxleft) ty elts\n            where\n              fit = HoleFit { hfId = eid, hfCand = el, hfType = (idType eid)\n                            , hfRefLvl = length (snd ty)\n                            , hfWrap = wrp, hfMatches = ms\n                            , hfDoc = Nothing }\n\n\n\n\n    unfoldWrapper :: HsWrapper -> [Type]\n    unfoldWrapper = reverse . unfWrp'\n      where unfWrp' (WpTyApp ty) = [ty]\n            unfWrp' (WpCompose w1 w2) = unfWrp' w1 ++ unfWrp' w2\n            unfWrp' _ = []\n\n\n    -- The real work happens here, where we invoke the type checker using\n    -- tcCheckHoleFit to see whether the given type fits the hole.\n    fitsHole :: (TcType, [TcTyVar]) -- The type of the hole wrapped with the\n                                    -- refinement variables created to simulate\n                                    -- additional holes (if any), and the list\n                                    -- of those variables (possibly empty).\n                                    -- As an example: If the actual type of the\n                                    -- hole (as specified by the hole\n                                    -- constraint CHoleExpr passed to\n                                    -- findValidHoleFits) is t and we want to\n                                    -- simulate N additional holes, h_ty will\n                                    -- be  r_1 -> ... -> r_N -> t, and\n                                    -- ref_vars will be [r_1, ... , r_N].\n                                    -- In the base case with no additional\n                                    -- holes, h_ty will just be t and ref_vars\n                                    -- will be [].\n             -> TcType -- The type we're checking to whether it can be\n                       -- instantiated to the type h_ty.\n             -> TcM (Maybe ([TcType], [TcType])) -- If it is not a match, we\n                                                 -- return Nothing. Otherwise,\n                                                 -- we Just return the list of\n                                                 -- types that quantified type\n                                                 -- variables in ty would take\n                                                 -- if used in place of h_ty,\n                                                 -- and the list types of any\n                                                 -- additional holes simulated\n                                                 -- with the refinement\n                                                 -- variables in ref_vars.\n    fitsHole (h_ty, ref_vars) ty =\n    -- We wrap this with the withoutUnification to avoid having side-effects\n    -- beyond the check, but we rely on the side-effects when looking for\n    -- refinement hole fits, so we can't wrap the side-effects deeper than this.\n      withoutUnification fvs $\n      do { traceTc \"checkingFitOf {\" $ ppr ty\n         ; (fits, wrp) <- tcCheckHoleFit (listToBag relevantCts) implics h_ty ty\n         ; traceTc \"Did it fit?\" $ ppr fits\n         ; traceTc \"wrap is: \" $ ppr wrp\n         ; traceTc \"checkingFitOf }\" empty\n         ; z_wrp_tys <- zonkTcTypes (unfoldWrapper wrp)\n         -- We'd like to avoid refinement suggestions like `id _ _` or\n         -- `head _ _`, and only suggest refinements where our all phantom\n         -- variables got unified during the checking. This can be disabled\n         -- with the `-fabstract-refinement-hole-fits` flag.\n         -- Here we do the additional handling when there are refinement\n         -- variables, i.e. zonk them to read their final value to check for\n         -- abstract refinements, and to report what the type of the simulated\n         -- holes must be for this to be a match.\n         ; if fits\n           then if null ref_vars\n                then return (Just (z_wrp_tys, []))\n                else do { let -- To be concrete matches, matches have to\n                              -- be more than just an invented type variable.\n                              fvSet = fvVarSet fvs\n                              notAbstract :: TcType -> Bool\n                              notAbstract t = case getTyVar_maybe t of\n                                                Just tv -> tv `elemVarSet` fvSet\n                                                _ -> True\n                              allConcrete = all notAbstract z_wrp_tys\n                        ; z_vars  <- zonkTcTyVars ref_vars\n                        ; let z_mtvs = mapMaybe tcGetTyVar_maybe z_vars\n                        ; allFilled <- not <$> anyM isFlexiTyVar z_mtvs\n                        ; allowAbstract <- goptM Opt_AbstractRefHoleFits\n                        ; if allowAbstract || (allFilled && allConcrete )\n                          then return $ Just (z_wrp_tys, z_vars)\n                          else return Nothing }\n           else return Nothing }\n     where fvs = mkFVs ref_vars `unionFV` hole_fvs `unionFV` tyCoFVsOfType ty\n\n\nsubsDiscardMsg :: SDoc\nsubsDiscardMsg =\n    text \"(Some hole fits suppressed;\" <+>\n    text \"use -fmax-valid-hole-fits=N\" <+>\n    text \"or -fno-max-valid-hole-fits)\"\n\nrefSubsDiscardMsg :: SDoc\nrefSubsDiscardMsg =\n    text \"(Some refinement hole fits suppressed;\" <+>\n    text \"use -fmax-refinement-hole-fits=N\" <+>\n    text \"or -fno-max-refinement-hole-fits)\"\n\n\n-- | Checks whether a MetaTyVar is flexible or not.\nisFlexiTyVar :: TcTyVar -> TcM Bool\nisFlexiTyVar tv | isMetaTyVar tv = isFlexi <$> readMetaTyVar tv\nisFlexiTyVar _ = return False\n\n-- | Takes a list of free variables and restores any Flexi type variables in\n-- free_vars after the action is run.\nwithoutUnification :: FV -> TcM a -> TcM a\nwithoutUnification free_vars action =\n  do { flexis <- filterM isFlexiTyVar fuvs\n     ; result <- action\n          -- Reset any mutated free variables\n     ; mapM_ restore flexis\n     ; return result }\n  where restore = flip writeTcRef Flexi . metaTyVarRef\n        fuvs = fvVarList free_vars\n\n-- | Reports whether first type (ty_a) subsumes the second type (ty_b),\n-- discarding any errors. Subsumption here means that the ty_b can fit into the\n-- ty_a, i.e. `tcSubsumes a b == True` if b is a subtype of a.\ntcSubsumes :: TcSigmaType -> TcSigmaType -> TcM Bool\ntcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit emptyBag [] ty_a ty_b\n\n\n-- | A tcSubsumes which takes into account relevant constraints, to fix trac\n-- #14273. This makes sure that when checking whether a type fits the hole,\n-- the type has to be subsumed by type of the hole as well as fulfill all\n-- constraints on the type of the hole.\n-- Note: The simplifier may perform unification, so make sure to restore any\n-- free type variables to avoid side-effects.\ntcCheckHoleFit :: Cts                   -- ^  Any relevant Cts to the hole.\n               -> [Implication]\n               -- ^ The nested implications of the hole with the innermost\n               -- implication first.\n               -> TcSigmaType           -- ^ The type of the hole.\n               -> TcSigmaType           -- ^ The type to check whether fits.\n               -> TcM (Bool, HsWrapper)\n               -- ^ Whether it was a match, and the wrapper from hole_ty to ty.\ntcCheckHoleFit _ _ hole_ty ty | hole_ty `eqType` ty\n    = return (True, idHsWrapper)\ntcCheckHoleFit relevantCts implics hole_ty ty = discardErrs $\n  do { -- We wrap the subtype constraint in the implications to pass along the\n       -- givens, and so we must ensure that any nested implications and skolems\n       -- end up with the correct level. The implications are ordered so that\n       -- the innermost (the one with the highest level) is first, so it\n       -- suffices to get the level of the first one (or the current level, if\n       -- there are no implications involved).\n       innermost_lvl <- case implics of\n                          [] -> getTcLevel\n                          -- imp is the innermost implication\n                          (imp:_) -> return (ic_tclvl imp)\n     ; (wrp, wanted) <- setTcLevel innermost_lvl $ captureConstraints $\n                          tcSubType_NC ExprSigCtxt ty hole_ty\n     ; traceTc \"Checking hole fit {\" empty\n     ; traceTc \"wanteds are: \" $ ppr wanted\n     ; if isEmptyWC wanted && isEmptyBag relevantCts\n       then traceTc \"}\" empty >> return (True, wrp)\n       else do { fresh_binds <- newTcEvBinds\n                -- The relevant constraints may contain HoleDests, so we must\n                -- take care to clone them as well (to avoid #15370).\n               ; cloned_relevants <- mapBagM cloneWanted relevantCts\n                 -- We wrap the WC in the nested implications, see\n                 -- Note [Nested Implications]\n               ; let outermost_first = reverse implics\n                     setWC = setWCAndBinds fresh_binds\n                    -- We add the cloned relevants to the wanteds generated by\n                    -- the call to tcSubType_NC, see Note [Relevant Constraints]\n                    -- There's no need to clone the wanteds, because they are\n                    -- freshly generated by `tcSubtype_NC`.\n                     w_rel_cts = addSimples wanted cloned_relevants\n                     w_givens = foldr setWC w_rel_cts outermost_first\n               ; traceTc \"w_givens are: \" $ ppr w_givens\n               ; rem <- runTcSDeriveds $ simpl_top w_givens\n               -- We don't want any insoluble or simple constraints left, but\n               -- solved implications are ok (and neccessary for e.g. undefined)\n               ; traceTc \"rems was:\" $ ppr rem\n               ; traceTc \"}\" empty\n               ; return (isSolvedWC rem, wrp) } }\n     where\n       setWCAndBinds :: EvBindsVar         -- Fresh ev binds var.\n                     -> Implication        -- The implication to put WC in.\n                     -> WantedConstraints  -- The WC constraints to put implic.\n                     -> WantedConstraints  -- The new constraints.\n       setWCAndBinds binds imp wc\n         = WC { wc_simple = emptyBag\n              , wc_impl = unitBag $ imp { ic_wanted = wc , ic_binds = binds } }\n", "num_lines": 1029}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1996-1998\n\n\nTcHsSyn: Specialisations of the @HsSyn@ syntax for the typechecker\n\nThis module is an extension of @HsSyn@ syntax, for use in the type\nchecker.\n-}\n\n{-# LANGUAGE CPP, TupleSections #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcHsSyn (\n        -- * Extracting types from HsSyn\n        hsLitType, hsLPatType, hsPatType,\n\n        -- * Other HsSyn functions\n        mkHsDictLet, mkHsApp,\n        mkHsAppTy, mkHsCaseAlt,\n        shortCutLit, hsOverLitName,\n        conLikeResTy,\n\n        -- * re-exported from TcMonad\n        TcId, TcIdSet,\n\n        -- * Zonking\n        -- | For a description of \"zonking\", see Note [What is zonking?]\n        -- in TcMType\n        zonkTopDecls, zonkTopExpr, zonkTopLExpr,\n        zonkTopBndrs,\n        ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv,\n        zonkTyVarBinders, zonkTyVarBindersX, zonkTyVarBinderX,\n        zonkTyBndrs, zonkTyBndrsX, zonkRecTyVarBndrs,\n        zonkTcTypeToType,  zonkTcTypeToTypeX,\n        zonkTcTypesToTypes, zonkTcTypesToTypesX,\n        zonkTyVarOcc,\n        zonkCoToCo,\n        zonkEvBinds, zonkTcEvBinds,\n        zonkTcMethInfoToMethInfoX,\n        lookupTyVarOcc\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport Id\nimport IdInfo\nimport TcRnMonad\nimport PrelNames\nimport BuildTyCl ( TcMethInfo, MethInfo )\nimport TcType\nimport TcMType\nimport TcEnv   ( tcLookupGlobalOnly )\nimport TcEvidence\nimport TysPrim\nimport TyCon\nimport TysWiredIn\nimport Type\nimport Coercion\nimport ConLike\nimport DataCon\nimport HscTypes\nimport Name\nimport NameEnv\nimport Var\nimport VarEnv\nimport DynFlags\nimport Literal\nimport BasicTypes\nimport Maybes\nimport SrcLoc\nimport Bag\nimport Outputable\nimport Util\nimport UniqFM\nimport CoreSyn\n\nimport {-# SOURCE #-} TcSplice (runTopSplice)\n\nimport Control.Monad\nimport Data.List  ( partition )\nimport Control.Arrow ( second )\n\n{-\n************************************************************************\n*                                                                      *\n       Extracting the type from HsSyn\n*                                                                      *\n************************************************************************\n\n-}\n\nhsLPatType :: OutPat GhcTc -> Type\nhsLPatType lpat = hsPatType (unLoc lpat)\n\nhsPatType :: Pat GhcTc -> Type\nhsPatType (ParPat _ pat)                = hsLPatType pat\nhsPatType (WildPat ty)                  = ty\nhsPatType (VarPat _ lvar)               = idType (unLoc lvar)\nhsPatType (BangPat _ pat)               = hsLPatType pat\nhsPatType (LazyPat _ pat)               = hsLPatType pat\nhsPatType (LitPat _ lit)                = hsLitType lit\nhsPatType (AsPat _ var _)               = idType (unLoc var)\nhsPatType (ViewPat ty _ _)              = ty\nhsPatType (ListPat (ListPatTc ty Nothing) _)      = mkListTy ty\nhsPatType (ListPat (ListPatTc _ (Just (ty,_))) _) = ty\nhsPatType (TuplePat tys _ bx)           = mkTupleTy bx tys\nhsPatType (SumPat tys _ _ _ )           = mkSumTy tys\nhsPatType (ConPatOut { pat_con = lcon\n                     , pat_arg_tys = tys })\n                                        = conLikeResTy (unLoc lcon) tys\nhsPatType (SigPat ty _ _)               = ty\nhsPatType (NPat ty _ _ _)               = ty\nhsPatType (NPlusKPat ty _ _ _ _ _)      = ty\nhsPatType (CoPat _ _ _ ty)              = ty\nhsPatType p                             = pprPanic \"hsPatType\" (ppr p)\n\nhsLitType :: HsLit (GhcPass p) -> TcType\nhsLitType (HsChar _ _)       = charTy\nhsLitType (HsCharPrim _ _)   = charPrimTy\nhsLitType (HsString _ _)     = stringTy\nhsLitType (HsStringPrim _ _) = addrPrimTy\nhsLitType (HsInt _ _)        = intTy\nhsLitType (HsIntPrim _ _)    = intPrimTy\nhsLitType (HsWordPrim _ _)   = wordPrimTy\nhsLitType (HsInt64Prim _ _)  = int64PrimTy\nhsLitType (HsWord64Prim _ _) = word64PrimTy\nhsLitType (HsInteger _ _ ty) = ty\nhsLitType (HsRat _ _ ty)     = ty\nhsLitType (HsFloatPrim _ _)  = floatPrimTy\nhsLitType (HsDoublePrim _ _) = doublePrimTy\nhsLitType (XLit p)           = pprPanic \"hsLitType\" (ppr p)\n\n-- Overloaded literals. Here mainly because it uses isIntTy etc\n\nshortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)\nshortCutLit dflags (HsIntegral int@(IL src neg i)) ty\n  | isIntTy ty  && inIntRange  dflags i = Just (HsLit noExt (HsInt noExt int))\n  | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim src i))\n  | isIntegerTy ty = Just (HsLit noExt (HsInteger src i ty))\n  | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit neg i)) ty\n        -- The 'otherwise' case is important\n        -- Consider (3 :: Float).  Syntactically it looks like an IntLit,\n        -- so we'll call shortCutIntLit, but of course it's a float\n        -- This can make a big difference for programs with a lot of\n        -- literals, compiled without -O\n\nshortCutLit _ (HsFractional f) ty\n  | isFloatTy ty  = Just (mkLit floatDataCon  (HsFloatPrim noExt f))\n  | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim noExt f))\n  | otherwise     = Nothing\n\nshortCutLit _ (HsIsString src s) ty\n  | isStringTy ty = Just (HsLit noExt (HsString src s))\n  | otherwise     = Nothing\n\nmkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc\nmkLit con lit = HsApp noExt (nlHsDataCon con) (nlHsLit lit)\n\n------------------------------\nhsOverLitName :: OverLitVal -> Name\n-- Get the canonical 'fromX' name for a particular OverLitVal\nhsOverLitName (HsIntegral {})   = fromIntegerName\nhsOverLitName (HsFractional {}) = fromRationalName\nhsOverLitName (HsIsString {})   = fromStringName\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}\n*                                                                      *\n************************************************************************\n\nThe rest of the zonking is done *after* typechecking.\nThe main zonking pass runs over the bindings\n\n a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc\n b) convert unbound TcTyVar to Void\n c) convert each TcId to an Id by zonking its type\n\nThe type variables are converted by binding mutable tyvars to immutable ones\nand then zonking as normal.\n\nThe Ids are converted by binding them in the normal Tc envt; that\nway we maintain sharing; eg an Id is zonked at its binding site and they\nall occurrences of that Id point to the common zonked copy\n\nIt's all pretty boring stuff, because HsSyn is such a large type, and\nthe environment manipulation is tiresome.\n-}\n\n-- Confused by zonking? See Note [What is zonking?] in TcMType.\n\n-- | See Note [The ZonkEnv]\n-- Confused by zonking? See Note [What is zonking?] in TcMType.\ndata ZonkEnv  -- See Note [The ZonkEnv]\n  = ZonkEnv { ze_flexi  :: ZonkFlexi\n            , ze_tv_env :: TyCoVarEnv TyCoVar\n            , ze_id_env :: IdEnv      Id\n            , ze_meta_tv_env :: TcRef (TyVarEnv Type) }\n\n{- Note [The ZonkEnv]\n~~~~~~~~~~~~~~~~~~~~~\n* ze_flexi :: ZonkFlexi says what to do with a\n  unification variable that is still un-unified.\n  See Note [Un-unified unification variables]\n\n* ze_tv_env :: TyCoVarEnv TyCoVar promotes sharing. At a binding site\n  of a tyvar or covar, we zonk the kind right away and add a mapping\n  to the env. This prevents re-zonking the kind at every\n  occurrence. But this is *just* an optimisation.\n\n* ze_id_env : IdEnv Id promotes sharing among Ids, by making all\n  occurrences of the Id point to a single zonked copy, built at the\n  binding site.\n\n  Unlike ze_tv_env, it is knot-tied: see extendIdZonkEnvRec.\n  In a mutually recusive group\n     rec { f = ...g...; g = ...f... }\n  we want the occurrence of g to point to the one zonked Id for g,\n  and the same for f.\n\n  Because it is knot-tied, we must be careful to consult it lazily.\n  Specifically, zonkIdOcc is not monadic.\n\n* ze_meta_tv_env: see Note [Sharing when zonking to Type]\n\n\nNotes:\n  * We must be careful never to put coercion variables (which are Ids,\n    after all) in the knot-tied ze_id_env, because coercions can\n    appear in types, and we sometimes inspect a zonked type in this\n    module.  [Question: where, precisely?]\n\n  * In zonkTyVarOcc we consult ze_tv_env in a monadic context,\n    a second reason that ze_tv_env can't be monadic.\n\n  * An obvious suggestion would be to have one VarEnv Var to\n    replace both ze_id_env and ze_tv_env, but that doesn't work\n    because of the knot-tying stuff mentioned above.\n\nNote [Un-unified unification variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat should we do if we find a Flexi unification variable?\nThere are three possibilities:\n\n* DefaultFlexi: this is the common case, in situations like\n     length @alpha ([] @alpha)\n  It really doesn't matter what type we choose for alpha.  But\n  we must choose a type!  We can't leae mutable unification\n  variables floating around: after typecheck is complete, every\n  type variable occurrence must have a bindign site.\n\n  So we default it to 'Any' of the right kind.\n\n  All this works for both type and kind variables (indeed\n  the two are the same thign).\n\n* SkolemiseFlexi: is a special case for the LHS of RULES.\n  See Note [Zonking the LHS of a RULE]\n\n* RuntimeUnkFlexi: is a special case for the GHCi debugger.\n  It's a way to have a variable that is not a mutuable\n  unification variable, but doesn't have a binding site\n  either.\n-}\n\ndata ZonkFlexi   -- See Note [Un-unified unification variables]\n  = DefaultFlexi    -- Default unbound unificaiton variables to Any\n  | SkolemiseFlexi  -- Skolemise unbound unification variables\n                    -- See Note [Zonking the LHS of a RULE]\n  | RuntimeUnkFlexi -- Used in the GHCi debugger\n\ninstance Outputable ZonkEnv where\n  ppr (ZonkEnv { ze_tv_env = tv_env\n               , ze_id_env = id_env })\n    = text \"ZE\" <+> braces (vcat\n         [ text \"ze_tv_env =\" <+> ppr tv_env\n         , text \"ze_id_env =\" <+> ppr id_env ])\n\n-- The EvBinds have to already be zonked, but that's usually the case.\nemptyZonkEnv :: TcM ZonkEnv\nemptyZonkEnv = mkEmptyZonkEnv DefaultFlexi\n\nmkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv\nmkEmptyZonkEnv flexi\n  = do { mtv_env_ref <- newTcRef emptyVarEnv\n       ; return (ZonkEnv { ze_flexi = flexi\n                         , ze_tv_env = emptyVarEnv\n                         , ze_id_env = emptyVarEnv\n                         , ze_meta_tv_env = mtv_env_ref }) }\n\ninitZonkEnv :: (ZonkEnv -> TcM b) -> TcM b\ninitZonkEnv thing_inside = do { ze <- mkEmptyZonkEnv DefaultFlexi\n                              ; thing_inside ze }\n\n-- | Extend the knot-tied environment.\nextendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv\nextendIdZonkEnvRec ze@(ZonkEnv { ze_id_env = id_env }) ids\n    -- NB: Don't look at the var to decide which env't to put it in. That\n    -- would end up knot-tying all the env'ts.\n  = ze { ze_id_env = extendVarEnvList id_env [(id,id) | id <- ids] }\n  -- Given coercion variables will actually end up here. That's OK though:\n  -- coercion variables are never looked up in the knot-tied env't, so zonking\n  -- them simply doesn't get optimised. No one gets hurt. An improvement (?)\n  -- would be to do SCC analysis in zonkEvBinds and then only knot-tie the\n  -- recursive groups. But perhaps the time it takes to do the analysis is\n  -- more than the savings.\n\nextendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv\nextendZonkEnv ze@(ZonkEnv { ze_tv_env = tyco_env, ze_id_env = id_env }) vars\n  = ze { ze_tv_env = extendVarEnvList tyco_env [(tv,tv) | tv <- tycovars]\n       , ze_id_env = extendVarEnvList id_env   [(id,id) | id <- ids] }\n  where\n    (tycovars, ids) = partition isTyCoVar vars\n\nextendIdZonkEnv1 :: ZonkEnv -> Var -> ZonkEnv\nextendIdZonkEnv1 ze@(ZonkEnv { ze_id_env = id_env }) id\n  = ze { ze_id_env = extendVarEnv id_env id id }\n\nextendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv\nextendTyZonkEnv1 ze@(ZonkEnv { ze_tv_env = ty_env }) tv\n  = ze { ze_tv_env = extendVarEnv ty_env tv tv }\n\nextendTyZonkEnvN :: ZonkEnv -> [(Name,TyVar)] -> ZonkEnv\nextendTyZonkEnvN ze@(ZonkEnv { ze_tv_env = ty_env }) pairs\n  = ze { ze_tv_env = foldl add ty_env pairs }\n  where\n    add env (name, tv) = extendVarEnv_Directly env (getUnique name) tv\n\nsetZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv\nsetZonkType ze flexi = ze { ze_flexi = flexi }\n\nzonkEnvIds :: ZonkEnv -> TypeEnv\nzonkEnvIds (ZonkEnv { ze_id_env = id_env})\n  = mkNameEnv [(getName id, AnId id) | id <- nonDetEltsUFM id_env]\n  -- It's OK to use nonDetEltsUFM here because we forget the ordering\n  -- immediately by creating a TypeEnv\n\nzonkLIdOcc :: ZonkEnv -> Located TcId -> Located Id\nzonkLIdOcc env = onHasSrcSpan (zonkIdOcc env)\n\nzonkIdOcc :: ZonkEnv -> TcId -> Id\n-- Ids defined in this module should be in the envt;\n-- ignore others.  (Actually, data constructors are also\n-- not LocalVars, even when locally defined, but that is fine.)\n-- (Also foreign-imported things aren't currently in the ZonkEnv;\n--  that's ok because they don't need zonking.)\n--\n-- Actually, Template Haskell works in 'chunks' of declarations, and\n-- an earlier chunk won't be in the 'env' that the zonking phase\n-- carries around.  Instead it'll be in the tcg_gbl_env, already fully\n-- zonked.  There's no point in looking it up there (except for error\n-- checking), and it's not conveniently to hand; hence the simple\n-- 'orElse' case in the LocalVar branch.\n--\n-- Even without template splices, in module Main, the checking of\n-- 'main' is done as a separate chunk.\nzonkIdOcc (ZonkEnv { ze_id_env = id_env}) id\n  | isLocalVar id = lookupVarEnv id_env id `orElse`\n                    id\n  | otherwise     = id\n\nzonkIdOccs :: ZonkEnv -> [TcId] -> [Id]\nzonkIdOccs env ids = map (zonkIdOcc env) ids\n\n-- zonkIdBndr is used *after* typechecking to get the Id's type\n-- to its final form.  The TyVarEnv give\nzonkIdBndr :: ZonkEnv -> TcId -> TcM Id\nzonkIdBndr env v\n  = do ty' <- zonkTcTypeToTypeX env (idType v)\n       ensureNotLevPoly ty'\n         (text \"In the type of binder\" <+> quotes (ppr v))\n\n       return (modifyIdInfo (`setLevityInfoWithType` ty') (setIdType v ty'))\n\nzonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]\nzonkIdBndrs env ids = mapM (zonkIdBndr env) ids\n\nzonkTopBndrs :: [TcId] -> TcM [Id]\nzonkTopBndrs ids = initZonkEnv $ \\ ze -> zonkIdBndrs ze ids\n\nzonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)\nzonkFieldOcc env (FieldOcc sel lbl)\n  = fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel\nzonkFieldOcc _ (XFieldOcc _) = panic \"zonkFieldOcc\"\n\nzonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])\nzonkEvBndrsX = mapAccumLM zonkEvBndrX\n\nzonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar)\n-- Works for dictionaries and coercions\nzonkEvBndrX env var\n  = do { var' <- zonkEvBndr env var\n       ; return (extendZonkEnv env [var'], var') }\n\nzonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar\n-- Works for dictionaries and coercions\n-- Does not extend the ZonkEnv\nzonkEvBndr env var\n  = do { let var_ty = varType var\n       ; ty <-\n           {-# SCC \"zonkEvBndr_zonkTcTypeToType\" #-}\n           zonkTcTypeToTypeX env var_ty\n       ; return (setVarType var ty) }\n\n{-\nzonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm\nzonkEvVarOcc env v\n  | isCoVar v\n  = EvCoercion <$> zonkCoVarOcc env v\n  | otherwise\n  = return (EvId $ zonkIdOcc env v)\n-}\n\nzonkCoreBndrX :: ZonkEnv -> Var -> TcM (ZonkEnv, Var)\nzonkCoreBndrX env v\n  | isId v = do { v' <- zonkIdBndr env v\n                ; return (extendIdZonkEnv1 env v', v') }\n  | otherwise = zonkTyBndrX env v\n\nzonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var])\nzonkCoreBndrsX = mapAccumLM zonkCoreBndrX\n\nzonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar])\nzonkTyBndrs tvs = initZonkEnv $ \\ze -> zonkTyBndrsX ze tvs\n\nzonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])\nzonkTyBndrsX = mapAccumLM zonkTyBndrX\n\nzonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)\n-- This guarantees to return a TyVar (not a TcTyVar)\n-- then we add it to the envt, so all occurrences are replaced\nzonkTyBndrX env tv\n  = ASSERT2( isImmutableTyVar tv, ppr tv <+> dcolon <+> ppr (tyVarKind tv) )\n    do { ki <- zonkTcTypeToTypeX env (tyVarKind tv)\n               -- Internal names tidy up better, for iface files.\n       ; let tv' = mkTyVar (tyVarName tv) ki\n       ; return (extendTyZonkEnv1 env tv', tv') }\n\nzonkTyVarBinders ::  [VarBndr TcTyVar vis]\n                 -> TcM (ZonkEnv, [VarBndr TyVar vis])\nzonkTyVarBinders tvbs = initZonkEnv $ \\ ze -> zonkTyVarBindersX ze tvbs\n\nzonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis]\n                             -> TcM (ZonkEnv, [VarBndr TyVar vis])\nzonkTyVarBindersX = mapAccumLM zonkTyVarBinderX\n\nzonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis\n                            -> TcM (ZonkEnv, VarBndr TyVar vis)\n-- Takes a TcTyVar and guarantees to return a TyVar\nzonkTyVarBinderX env (Bndr tv vis)\n  = do { (env', tv') <- zonkTyBndrX env tv\n       ; return (env', Bndr tv' vis) }\n\nzonkRecTyVarBndrs :: [Name] -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])\n-- This rather specialised function is used in exactly one place.\n-- See Note [Tricky scoping in generaliseTcTyCon] in TcTyClsDecls.\nzonkRecTyVarBndrs names tc_tvs\n  = initZonkEnv $ \\ ze ->\n    fixM $ \\ ~(_, rec_new_tvs) ->\n    do { let ze' = extendTyZonkEnvN ze $\n                   zipWithLazy (\\ tc_tv new_tv -> (getName tc_tv, new_tv))\n                               tc_tvs rec_new_tvs\n       ; new_tvs <- zipWithM (zonk_one ze') names tc_tvs\n       ; return (ze', new_tvs) }\n  where\n    zonk_one ze name tc_tv\n      = do { ki <- zonkTcTypeToTypeX ze (tyVarKind tc_tv)\n           ; return (mkTyVar name ki) }\n\nzonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)\nzonkTopExpr e = initZonkEnv $ \\ ze -> zonkExpr ze e\n\nzonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)\nzonkTopLExpr e = initZonkEnv $ \\ ze -> zonkLExpr ze e\n\nzonkTopDecls :: Bag EvBind\n             -> LHsBinds GhcTcId\n             -> [LRuleDecl GhcTcId] -> [LTcSpecPrag]\n             -> [LForeignDecl GhcTcId]\n             -> TcM (TypeEnv,\n                     Bag EvBind,\n                     LHsBinds GhcTc,\n                     [LForeignDecl GhcTc],\n                     [LTcSpecPrag],\n                     [LRuleDecl    GhcTc])\nzonkTopDecls ev_binds binds rules imp_specs fords\n  = do  { (env1, ev_binds') <- initZonkEnv $ \\ ze -> zonkEvBinds ze ev_binds\n        ; (env2, binds')    <- zonkRecMonoBinds env1 binds\n                        -- Top level is implicitly recursive\n        ; rules' <- zonkRules env2 rules\n        ; specs' <- zonkLTcSpecPrags env2 imp_specs\n        ; fords' <- zonkForeignExports env2 fords\n        ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules') }\n\n---------------------------------------------\nzonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId\n               -> TcM (ZonkEnv, HsLocalBinds GhcTc)\nzonkLocalBinds env (EmptyLocalBinds x)\n  = return (env, (EmptyLocalBinds x))\n\nzonkLocalBinds _ (HsValBinds _ (ValBinds {}))\n  = panic \"zonkLocalBinds\" -- Not in typechecker output\n\nzonkLocalBinds env (HsValBinds x (XValBindsLR (NValBinds binds sigs)))\n  = do  { (env1, new_binds) <- go env binds\n        ; return (env1, HsValBinds x (XValBindsLR (NValBinds new_binds sigs))) }\n  where\n    go env []\n      = return (env, [])\n    go env ((r,b):bs)\n      = do { (env1, b')  <- zonkRecMonoBinds env b\n           ; (env2, bs') <- go env1 bs\n           ; return (env2, (r,b'):bs') }\n\nzonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do\n    new_binds <- mapM (wrapLocM zonk_ip_bind) binds\n    let\n        env1 = extendIdZonkEnvRec env\n                 [ n | (dL->L _ (IPBind _ (Right n) _)) <- new_binds]\n    (env2, new_dict_binds) <- zonkTcEvBinds env1 dict_binds\n    return (env2, HsIPBinds x (IPBinds new_dict_binds new_binds))\n  where\n    zonk_ip_bind (IPBind x n e)\n        = do n' <- mapIPNameTc (zonkIdBndr env) n\n             e' <- zonkLExpr env e\n             return (IPBind x n' e')\n    zonk_ip_bind (XIPBind _) = panic \"zonkLocalBinds : XCIPBind\"\n\nzonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _))\n  = panic \"zonkLocalBinds\" -- Not in typechecker output\nzonkLocalBinds _ (XHsLocalBindsLR _)\n  = panic \"zonkLocalBinds\" -- Not in typechecker output\n\n---------------------------------------------\nzonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (ZonkEnv, LHsBinds GhcTc)\nzonkRecMonoBinds env binds\n = fixM (\\ ~(_, new_binds) -> do\n        { let env1 = extendIdZonkEnvRec env (collectHsBindsBinders new_binds)\n        ; binds' <- zonkMonoBinds env1 binds\n        ; return (env1, binds') })\n\n---------------------------------------------\nzonkMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (LHsBinds GhcTc)\nzonkMonoBinds env binds = mapBagM (zonk_lbind env) binds\n\nzonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc)\nzonk_lbind env = wrapLocM (zonk_bind env)\n\nzonk_bind :: ZonkEnv -> HsBind GhcTcId -> TcM (HsBind GhcTc)\nzonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss\n                            , pat_ext = NPatBindTc fvs ty})\n  = do  { (_env, new_pat) <- zonkPat env pat            -- Env already extended\n        ; new_grhss <- zonkGRHSs env zonkLExpr grhss\n        ; new_ty    <- zonkTcTypeToTypeX env ty\n        ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss\n                       , pat_ext = NPatBindTc fvs new_ty }) }\n\nzonk_bind env (VarBind { var_ext = x\n                       , var_id = var, var_rhs = expr, var_inline = inl })\n  = do { new_var  <- zonkIdBndr env var\n       ; new_expr <- zonkLExpr env expr\n       ; return (VarBind { var_ext = x\n                         , var_id = new_var\n                         , var_rhs = new_expr\n                         , var_inline = inl }) }\n\nzonk_bind env bind@(FunBind { fun_id = (dL->L loc var)\n                            , fun_matches = ms\n                            , fun_co_fn = co_fn })\n  = do { new_var <- zonkIdBndr env var\n       ; (env1, new_co_fn) <- zonkCoFn env co_fn\n       ; new_ms <- zonkMatchGroup env1 zonkLExpr ms\n       ; return (bind { fun_id = cL loc new_var\n                      , fun_matches = new_ms\n                      , fun_co_fn = new_co_fn }) }\n\nzonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs\n                        , abs_ev_binds = ev_binds\n                        , abs_exports = exports\n                        , abs_binds = val_binds\n                        , abs_sig = has_sig })\n  = ASSERT( all isImmutableTyVar tyvars )\n    do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars\n       ; (env1, new_evs) <- zonkEvBndrsX env0 evs\n       ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds\n       ; (new_val_bind, new_exports) <- fixM $ \\ ~(new_val_binds, _) ->\n         do { let env3 = extendIdZonkEnvRec env2 $\n                         collectHsBindsBinders new_val_binds\n            ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds\n            ; new_exports   <- mapM (zonk_export env3) exports\n            ; return (new_val_binds, new_exports) }\n       ; return (AbsBinds { abs_ext = noExt\n                          , abs_tvs = new_tyvars, abs_ev_vars = new_evs\n                          , abs_ev_binds = new_ev_binds\n                          , abs_exports = new_exports, abs_binds = new_val_bind\n                          , abs_sig = has_sig }) }\n  where\n    zonk_val_bind env lbind\n      | has_sig\n      , (dL->L loc bind@(FunBind { fun_id      = (dL->L mloc mono_id)\n                                 , fun_matches = ms\n                                 , fun_co_fn   = co_fn })) <- lbind\n      = do { new_mono_id <- updateVarTypeM (zonkTcTypeToTypeX env) mono_id\n                            -- Specifically /not/ zonkIdBndr; we do not\n                            -- want to complain about a levity-polymorphic binder\n           ; (env', new_co_fn) <- zonkCoFn env co_fn\n           ; new_ms            <- zonkMatchGroup env' zonkLExpr ms\n           ; return $ cL loc $\n             bind { fun_id      = cL mloc new_mono_id\n                  , fun_matches = new_ms\n                  , fun_co_fn   = new_co_fn } }\n      | otherwise\n      = zonk_lbind env lbind   -- The normal case\n\n    zonk_export env (ABE{ abe_ext = x\n                        , abe_wrap = wrap\n                        , abe_poly = poly_id\n                        , abe_mono = mono_id\n                        , abe_prags = prags })\n        = do new_poly_id <- zonkIdBndr env poly_id\n             (_, new_wrap) <- zonkCoFn env wrap\n             new_prags <- zonkSpecPrags env prags\n             return (ABE{ abe_ext = x\n                        , abe_wrap = new_wrap\n                        , abe_poly = new_poly_id\n                        , abe_mono = zonkIdOcc env mono_id\n                        , abe_prags = new_prags })\n    zonk_export _ (XABExport _) = panic \"zonk_bind: XABExport\"\n\nzonk_bind env (PatSynBind x bind@(PSB { psb_id = (dL->L loc id)\n                                      , psb_args = details\n                                      , psb_def = lpat\n                                      , psb_dir = dir }))\n  = do { id' <- zonkIdBndr env id\n       ; (env1, lpat') <- zonkPat env lpat\n       ; let details' = zonkPatSynDetails env1 details\n       ; (_env2, dir') <- zonkPatSynDir env1 dir\n       ; return $ PatSynBind x $\n                  bind { psb_id = cL loc id'\n                       , psb_args = details'\n                       , psb_def = lpat'\n                       , psb_dir = dir' } }\n\nzonk_bind _ (PatSynBind _ (XPatSynBind _)) = panic \"zonk_bind\"\nzonk_bind _ (XHsBindsLR _)                 = panic \"zonk_bind\"\n\nzonkPatSynDetails :: ZonkEnv\n                  -> HsPatSynDetails (Located TcId)\n                  -> HsPatSynDetails (Located Id)\nzonkPatSynDetails env (PrefixCon as)\n  = PrefixCon (map (zonkLIdOcc env) as)\nzonkPatSynDetails env (InfixCon a1 a2)\n  = InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2)\nzonkPatSynDetails env (RecCon flds)\n  = RecCon (map (fmap (zonkLIdOcc env)) flds)\n\nzonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTcId\n              -> TcM (ZonkEnv, HsPatSynDir GhcTc)\nzonkPatSynDir env Unidirectional        = return (env, Unidirectional)\nzonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional)\nzonkPatSynDir env (ExplicitBidirectional mg) = do\n    mg' <- zonkMatchGroup env zonkLExpr mg\n    return (env, ExplicitBidirectional mg')\n\nzonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags\nzonkSpecPrags _   IsDefaultMethod = return IsDefaultMethod\nzonkSpecPrags env (SpecPrags ps)  = do { ps' <- zonkLTcSpecPrags env ps\n                                       ; return (SpecPrags ps') }\n\nzonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]\nzonkLTcSpecPrags env ps\n  = mapM zonk_prag ps\n  where\n    zonk_prag (dL->L loc (SpecPrag id co_fn inl))\n        = do { (_, co_fn') <- zonkCoFn env co_fn\n             ; return (cL loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}\n*                                                                      *\n************************************************************************\n-}\n\nzonkMatchGroup :: ZonkEnv\n            -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))\n            -> MatchGroup GhcTcId (Located (body GhcTcId))\n            -> TcM (MatchGroup GhcTc (Located (body GhcTc)))\nzonkMatchGroup env zBody (MG { mg_alts = (dL->L l ms)\n                             , mg_ext = MatchGroupTc arg_tys res_ty\n                             , mg_origin = origin })\n  = do  { ms' <- mapM (zonkMatch env zBody) ms\n        ; arg_tys' <- zonkTcTypesToTypesX env arg_tys\n        ; res_ty'  <- zonkTcTypeToTypeX env res_ty\n        ; return (MG { mg_alts = cL l ms'\n                     , mg_ext = MatchGroupTc arg_tys' res_ty'\n                     , mg_origin = origin }) }\nzonkMatchGroup _ _ (XMatchGroup {}) = panic \"zonkMatchGroup\"\n\nzonkMatch :: ZonkEnv\n          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))\n          -> LMatch GhcTcId (Located (body GhcTcId))\n          -> TcM (LMatch GhcTc (Located (body GhcTc)))\nzonkMatch env zBody (dL->L loc match@(Match { m_pats = pats\n                                            , m_grhss = grhss }))\n  = do  { (env1, new_pats) <- zonkPats env pats\n        ; new_grhss <- zonkGRHSs env1 zBody grhss\n        ; return (cL loc (match { m_pats = new_pats, m_grhss = new_grhss })) }\nzonkMatch _ _ (dL->L  _ (XMatch _)) = panic \"zonkMatch\"\nzonkMatch _ _ _ = panic \"zonkMatch: Impossible Match\"\n                             -- due to #15884\n\n-------------------------------------------------------------------------\nzonkGRHSs :: ZonkEnv\n          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))\n          -> GRHSs GhcTcId (Located (body GhcTcId))\n          -> TcM (GRHSs GhcTc (Located (body GhcTc)))\n\nzonkGRHSs env zBody (GRHSs x grhss (dL->L l binds)) = do\n    (new_env, new_binds) <- zonkLocalBinds env binds\n    let\n        zonk_grhs (GRHS xx guarded rhs)\n          = do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded\n               new_rhs <- zBody env2 rhs\n               return (GRHS xx new_guarded new_rhs)\n        zonk_grhs (XGRHS _) = panic \"zonkGRHSs\"\n    new_grhss <- mapM (wrapLocM zonk_grhs) grhss\n    return (GRHSs x new_grhss (cL l new_binds))\nzonkGRHSs _ _ (XGRHSs _) = panic \"zonkGRHSs\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}\n*                                                                      *\n************************************************************************\n-}\n\nzonkLExprs :: ZonkEnv -> [LHsExpr GhcTcId] -> TcM [LHsExpr GhcTc]\nzonkLExpr  :: ZonkEnv -> LHsExpr GhcTcId   -> TcM (LHsExpr GhcTc)\nzonkExpr   :: ZonkEnv -> HsExpr GhcTcId    -> TcM (HsExpr GhcTc)\n\nzonkLExprs env exprs = mapM (zonkLExpr env) exprs\nzonkLExpr  env expr  = wrapLocM (zonkExpr env) expr\n\nzonkExpr env (HsVar x (dL->L l id))\n  = ASSERT2( isNothing (isDataConId_maybe id), ppr id )\n    return (HsVar x (cL l (zonkIdOcc env id)))\n\nzonkExpr _ e@(HsConLikeOut {}) = return e\n\nzonkExpr _ (HsIPVar x id)\n  = return (HsIPVar x id)\n\nzonkExpr _ e@HsOverLabel{} = return e\n\nzonkExpr env (HsLit x (HsRat e f ty))\n  = do new_ty <- zonkTcTypeToTypeX env ty\n       return (HsLit x (HsRat e f new_ty))\n\nzonkExpr _ (HsLit x lit)\n  = return (HsLit x lit)\n\nzonkExpr env (HsOverLit x lit)\n  = do  { lit' <- zonkOverLit env lit\n        ; return (HsOverLit x lit') }\n\nzonkExpr env (HsLam x matches)\n  = do new_matches <- zonkMatchGroup env zonkLExpr matches\n       return (HsLam x new_matches)\n\nzonkExpr env (HsLamCase x matches)\n  = do new_matches <- zonkMatchGroup env zonkLExpr matches\n       return (HsLamCase x new_matches)\n\nzonkExpr env (HsApp x e1 e2)\n  = do new_e1 <- zonkLExpr env e1\n       new_e2 <- zonkLExpr env e2\n       return (HsApp x new_e1 new_e2)\n\nzonkExpr env (HsAppType x e t)\n  = do new_e <- zonkLExpr env e\n       return (HsAppType x new_e t)\n       -- NB: the type is an HsType; can't zonk that!\n\nzonkExpr _ e@(HsRnBracketOut _ _ _)\n  = pprPanic \"zonkExpr: HsRnBracketOut\" (ppr e)\n\nzonkExpr env (HsTcBracketOut x body bs)\n  = do bs' <- mapM zonk_b bs\n       return (HsTcBracketOut x body bs')\n  where\n    zonk_b (PendingTcSplice n e) = do e' <- zonkLExpr env e\n                                      return (PendingTcSplice n e')\n\nzonkExpr env (HsSpliceE _ (HsSplicedT s)) =\n  runTopSplice s >>= zonkExpr env\n\nzonkExpr _ (HsSpliceE x s) = WARN( True, ppr s ) -- Should not happen\n                           return (HsSpliceE x s)\n\nzonkExpr env (OpApp fixity e1 op e2)\n  = do new_e1 <- zonkLExpr env e1\n       new_op <- zonkLExpr env op\n       new_e2 <- zonkLExpr env e2\n       return (OpApp fixity new_e1 new_op new_e2)\n\nzonkExpr env (NegApp x expr op)\n  = do (env', new_op) <- zonkSyntaxExpr env op\n       new_expr <- zonkLExpr env' expr\n       return (NegApp x new_expr new_op)\n\nzonkExpr env (HsPar x e)\n  = do new_e <- zonkLExpr env e\n       return (HsPar x new_e)\n\nzonkExpr env (SectionL x expr op)\n  = do new_expr <- zonkLExpr env expr\n       new_op   <- zonkLExpr env op\n       return (SectionL x new_expr new_op)\n\nzonkExpr env (SectionR x op expr)\n  = do new_op   <- zonkLExpr env op\n       new_expr <- zonkLExpr env expr\n       return (SectionR x new_op new_expr)\n\nzonkExpr env (ExplicitTuple x tup_args boxed)\n  = do { new_tup_args <- mapM zonk_tup_arg tup_args\n       ; return (ExplicitTuple x new_tup_args boxed) }\n  where\n    zonk_tup_arg (dL->L l (Present x e)) = do { e' <- zonkLExpr env e\n                                              ; return (cL l (Present x e')) }\n    zonk_tup_arg (dL->L l (Missing t)) = do { t' <- zonkTcTypeToTypeX env t\n                                            ; return (cL l (Missing t')) }\n    zonk_tup_arg (dL->L _ (XTupArg{})) = panic \"zonkExpr.XTupArg\"\n    zonk_tup_arg _ = panic \"zonk_tup_arg: Impossible Match\"\n                             -- due to #15884\n\n\nzonkExpr env (ExplicitSum args alt arity expr)\n  = do new_args <- mapM (zonkTcTypeToTypeX env) args\n       new_expr <- zonkLExpr env expr\n       return (ExplicitSum new_args alt arity new_expr)\n\nzonkExpr env (HsCase x expr ms)\n  = do new_expr <- zonkLExpr env expr\n       new_ms <- zonkMatchGroup env zonkLExpr ms\n       return (HsCase x new_expr new_ms)\n\nzonkExpr env (HsIf x Nothing e1 e2 e3)\n  = do new_e1 <- zonkLExpr env e1\n       new_e2 <- zonkLExpr env e2\n       new_e3 <- zonkLExpr env e3\n       return (HsIf x Nothing new_e1 new_e2 new_e3)\n\nzonkExpr env (HsIf x (Just fun) e1 e2 e3)\n  = do (env1, new_fun) <- zonkSyntaxExpr env fun\n       new_e1 <- zonkLExpr env1 e1\n       new_e2 <- zonkLExpr env1 e2\n       new_e3 <- zonkLExpr env1 e3\n       return (HsIf x (Just new_fun) new_e1 new_e2 new_e3)\n\nzonkExpr env (HsMultiIf ty alts)\n  = do { alts' <- mapM (wrapLocM zonk_alt) alts\n       ; ty'   <- zonkTcTypeToTypeX env ty\n       ; return $ HsMultiIf ty' alts' }\n  where zonk_alt (GRHS x guard expr)\n          = do { (env', guard') <- zonkStmts env zonkLExpr guard\n               ; expr'          <- zonkLExpr env' expr\n               ; return $ GRHS x guard' expr' }\n        zonk_alt (XGRHS _) = panic \"zonkExpr.HsMultiIf\"\n\nzonkExpr env (HsLet x (dL->L l binds) expr)\n  = do (new_env, new_binds) <- zonkLocalBinds env binds\n       new_expr <- zonkLExpr new_env expr\n       return (HsLet x (cL l new_binds) new_expr)\n\nzonkExpr env (HsDo ty do_or_lc (dL->L l stmts))\n  = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts\n       new_ty <- zonkTcTypeToTypeX env ty\n       return (HsDo new_ty do_or_lc (cL l new_stmts))\n\nzonkExpr env (ExplicitList ty wit exprs)\n  = do (env1, new_wit) <- zonkWit env wit\n       new_ty <- zonkTcTypeToTypeX env1 ty\n       new_exprs <- zonkLExprs env1 exprs\n       return (ExplicitList new_ty new_wit new_exprs)\n   where zonkWit env Nothing    = return (env, Nothing)\n         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln\n\nzonkExpr env expr@(RecordCon { rcon_ext = ext, rcon_flds = rbinds })\n  = do  { new_con_expr <- zonkExpr env (rcon_con_expr ext)\n        ; new_rbinds   <- zonkRecFields env rbinds\n        ; return (expr { rcon_ext  = ext { rcon_con_expr = new_con_expr }\n                       , rcon_flds = new_rbinds }) }\n\nzonkExpr env (RecordUpd { rupd_flds = rbinds\n                        , rupd_expr = expr\n                        , rupd_ext = RecordUpdTc\n                            { rupd_cons = cons, rupd_in_tys = in_tys\n                            , rupd_out_tys = out_tys, rupd_wrap = req_wrap }})\n  = do  { new_expr    <- zonkLExpr env expr\n        ; new_in_tys  <- mapM (zonkTcTypeToTypeX env) in_tys\n        ; new_out_tys <- mapM (zonkTcTypeToTypeX env) out_tys\n        ; new_rbinds  <- zonkRecUpdFields env rbinds\n        ; (_, new_recwrap) <- zonkCoFn env req_wrap\n        ; return (RecordUpd { rupd_expr = new_expr, rupd_flds =  new_rbinds\n                            , rupd_ext = RecordUpdTc\n                                { rupd_cons = cons, rupd_in_tys = new_in_tys\n                                , rupd_out_tys = new_out_tys\n                                , rupd_wrap = new_recwrap }}) }\n\nzonkExpr env (ExprWithTySig _ e ty)\n  = do { e' <- zonkLExpr env e\n       ; return (ExprWithTySig noExt e' ty) }\n\nzonkExpr env (ArithSeq expr wit info)\n  = do (env1, new_wit) <- zonkWit env wit\n       new_expr <- zonkExpr env expr\n       new_info <- zonkArithSeq env1 info\n       return (ArithSeq new_expr new_wit new_info)\n   where zonkWit env Nothing    = return (env, Nothing)\n         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln\n\nzonkExpr env (HsSCC x src lbl expr)\n  = do new_expr <- zonkLExpr env expr\n       return (HsSCC x src lbl new_expr)\n\nzonkExpr env (HsTickPragma x src info srcInfo expr)\n  = do new_expr <- zonkLExpr env expr\n       return (HsTickPragma x src info srcInfo new_expr)\n\n-- hdaume: core annotations\nzonkExpr env (HsCoreAnn x src lbl expr)\n  = do new_expr <- zonkLExpr env expr\n       return (HsCoreAnn x src lbl new_expr)\n\n-- arrow notation extensions\nzonkExpr env (HsProc x pat body)\n  = do  { (env1, new_pat) <- zonkPat env pat\n        ; new_body <- zonkCmdTop env1 body\n        ; return (HsProc x new_pat new_body) }\n\n-- StaticPointers extension\nzonkExpr env (HsStatic fvs expr)\n  = HsStatic fvs <$> zonkLExpr env expr\n\nzonkExpr env (HsWrap x co_fn expr)\n  = do (env1, new_co_fn) <- zonkCoFn env co_fn\n       new_expr <- zonkExpr env1 expr\n       return (HsWrap x new_co_fn new_expr)\n\nzonkExpr _ e@(HsUnboundVar {}) = return e\n\nzonkExpr _ expr = pprPanic \"zonkExpr\" (ppr expr)\n\n-------------------------------------------------------------------------\n{-\nNote [Skolems in zonkSyntaxExpr]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider rebindable syntax with something like\n\n  (>>=) :: (forall x. blah) -> (forall y. blah') -> blah''\n\nThe x and y become skolems that are in scope when type-checking the\narguments to the bind. This means that we must extend the ZonkEnv with\nthese skolems when zonking the arguments to the bind. But the skolems\nare different between the two arguments, and so we should theoretically\ncarry around different environments to use for the different arguments.\n\nHowever, this becomes a logistical nightmare, especially in dealing with\nthe more exotic Stmt forms. So, we simplify by making the critical\nassumption that the uniques of the skolems are different. (This assumption\nis justified by the use of newUnique in TcMType.instSkolTyCoVarX.)\nNow, we can safely just extend one environment.\n-}\n\n-- See Note [Skolems in zonkSyntaxExpr]\nzonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTcId\n               -> TcM (ZonkEnv, SyntaxExpr GhcTc)\nzonkSyntaxExpr env (SyntaxExpr { syn_expr      = expr\n                               , syn_arg_wraps = arg_wraps\n                               , syn_res_wrap  = res_wrap })\n  = do { (env0, res_wrap')  <- zonkCoFn env res_wrap\n       ; expr'              <- zonkExpr env0 expr\n       ; (env1, arg_wraps') <- mapAccumLM zonkCoFn env0 arg_wraps\n       ; return (env1, SyntaxExpr { syn_expr      = expr'\n                                  , syn_arg_wraps = arg_wraps'\n                                  , syn_res_wrap  = res_wrap' }) }\n\n-------------------------------------------------------------------------\n\nzonkLCmd  :: ZonkEnv -> LHsCmd GhcTcId   -> TcM (LHsCmd GhcTc)\nzonkCmd   :: ZonkEnv -> HsCmd GhcTcId    -> TcM (HsCmd GhcTc)\n\nzonkLCmd  env cmd  = wrapLocM (zonkCmd env) cmd\n\nzonkCmd env (HsCmdWrap x w cmd)\n  = do { (env1, w') <- zonkCoFn env w\n       ; cmd' <- zonkCmd env1 cmd\n       ; return (HsCmdWrap x w' cmd') }\nzonkCmd env (HsCmdArrApp ty e1 e2 ho rl)\n  = do new_e1 <- zonkLExpr env e1\n       new_e2 <- zonkLExpr env e2\n       new_ty <- zonkTcTypeToTypeX env ty\n       return (HsCmdArrApp new_ty new_e1 new_e2 ho rl)\n\nzonkCmd env (HsCmdArrForm x op f fixity args)\n  = do new_op <- zonkLExpr env op\n       new_args <- mapM (zonkCmdTop env) args\n       return (HsCmdArrForm x new_op f fixity new_args)\n\nzonkCmd env (HsCmdApp x c e)\n  = do new_c <- zonkLCmd env c\n       new_e <- zonkLExpr env e\n       return (HsCmdApp x new_c new_e)\n\nzonkCmd env (HsCmdLam x matches)\n  = do new_matches <- zonkMatchGroup env zonkLCmd matches\n       return (HsCmdLam x new_matches)\n\nzonkCmd env (HsCmdPar x c)\n  = do new_c <- zonkLCmd env c\n       return (HsCmdPar x new_c)\n\nzonkCmd env (HsCmdCase x expr ms)\n  = do new_expr <- zonkLExpr env expr\n       new_ms <- zonkMatchGroup env zonkLCmd ms\n       return (HsCmdCase x new_expr new_ms)\n\nzonkCmd env (HsCmdIf x eCond ePred cThen cElse)\n  = do { (env1, new_eCond) <- zonkWit env eCond\n       ; new_ePred <- zonkLExpr env1 ePred\n       ; new_cThen <- zonkLCmd env1 cThen\n       ; new_cElse <- zonkLCmd env1 cElse\n       ; return (HsCmdIf x new_eCond new_ePred new_cThen new_cElse) }\n  where\n    zonkWit env Nothing  = return (env, Nothing)\n    zonkWit env (Just w) = second Just <$> zonkSyntaxExpr env w\n\nzonkCmd env (HsCmdLet x (dL->L l binds) cmd)\n  = do (new_env, new_binds) <- zonkLocalBinds env binds\n       new_cmd <- zonkLCmd new_env cmd\n       return (HsCmdLet x (cL l new_binds) new_cmd)\n\nzonkCmd env (HsCmdDo ty (dL->L l stmts))\n  = do (_, new_stmts) <- zonkStmts env zonkLCmd stmts\n       new_ty <- zonkTcTypeToTypeX env ty\n       return (HsCmdDo new_ty (cL l new_stmts))\n\nzonkCmd _ (XCmd{}) = panic \"zonkCmd\"\n\n\n\nzonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTcId -> TcM (LHsCmdTop GhcTc)\nzonkCmdTop env cmd = wrapLocM (zonk_cmd_top env) cmd\n\nzonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTcId -> TcM (HsCmdTop GhcTc)\nzonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd)\n  = do new_cmd <- zonkLCmd env cmd\n       new_stack_tys <- zonkTcTypeToTypeX env stack_tys\n       new_ty <- zonkTcTypeToTypeX env ty\n       new_ids <- mapSndM (zonkExpr env) ids\n\n       MASSERT( isLiftedTypeKind (tcTypeKind new_stack_tys) )\n         -- desugarer assumes that this is not levity polymorphic...\n         -- but indeed it should always be lifted due to the typing\n         -- rules for arrows\n\n       return (HsCmdTop (CmdTopTc new_stack_tys new_ty new_ids) new_cmd)\nzonk_cmd_top _ (XCmdTop {}) = panic \"zonk_cmd_top\"\n\n-------------------------------------------------------------------------\nzonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)\nzonkCoFn env WpHole   = return (env, WpHole)\nzonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1\n                                    ; (env2, c2') <- zonkCoFn env1 c2\n                                    ; return (env2, WpCompose c1' c2') }\nzonkCoFn env (WpFun c1 c2 t1 d) = do { (env1, c1') <- zonkCoFn env c1\n                                     ; (env2, c2') <- zonkCoFn env1 c2\n                                     ; t1'         <- zonkTcTypeToTypeX env2 t1\n                                     ; return (env2, WpFun c1' c2' t1' d) }\nzonkCoFn env (WpCast co) = do { co' <- zonkCoToCo env co\n                              ; return (env, WpCast co') }\nzonkCoFn env (WpEvLam ev)   = do { (env', ev') <- zonkEvBndrX env ev\n                                 ; return (env', WpEvLam ev') }\nzonkCoFn env (WpEvApp arg)  = do { arg' <- zonkEvTerm env arg\n                                 ; return (env, WpEvApp arg') }\nzonkCoFn env (WpTyLam tv)   = ASSERT( isImmutableTyVar tv )\n                              do { (env', tv') <- zonkTyBndrX env tv\n                                 ; return (env', WpTyLam tv') }\nzonkCoFn env (WpTyApp ty)   = do { ty' <- zonkTcTypeToTypeX env ty\n                                 ; return (env, WpTyApp ty') }\nzonkCoFn env (WpLet bs)     = do { (env1, bs') <- zonkTcEvBinds env bs\n                                 ; return (env1, WpLet bs') }\n\n-------------------------------------------------------------------------\nzonkOverLit :: ZonkEnv -> HsOverLit GhcTcId -> TcM (HsOverLit GhcTc)\nzonkOverLit env lit@(OverLit {ol_ext = OverLitTc r ty, ol_witness = e })\n  = do  { ty' <- zonkTcTypeToTypeX env ty\n        ; e' <- zonkExpr env e\n        ; return (lit { ol_witness = e', ol_ext = OverLitTc r ty' }) }\n\nzonkOverLit _ XOverLit{} = panic \"zonkOverLit\"\n\n-------------------------------------------------------------------------\nzonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTcId -> TcM (ArithSeqInfo GhcTc)\n\nzonkArithSeq env (From e)\n  = do new_e <- zonkLExpr env e\n       return (From new_e)\n\nzonkArithSeq env (FromThen e1 e2)\n  = do new_e1 <- zonkLExpr env e1\n       new_e2 <- zonkLExpr env e2\n       return (FromThen new_e1 new_e2)\n\nzonkArithSeq env (FromTo e1 e2)\n  = do new_e1 <- zonkLExpr env e1\n       new_e2 <- zonkLExpr env e2\n       return (FromTo new_e1 new_e2)\n\nzonkArithSeq env (FromThenTo e1 e2 e3)\n  = do new_e1 <- zonkLExpr env e1\n       new_e2 <- zonkLExpr env e2\n       new_e3 <- zonkLExpr env e3\n       return (FromThenTo new_e1 new_e2 new_e3)\n\n\n-------------------------------------------------------------------------\nzonkStmts :: ZonkEnv\n          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))\n          -> [LStmt GhcTcId (Located (body GhcTcId))]\n          -> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])\nzonkStmts env _ []     = return (env, [])\nzonkStmts env zBody (s:ss) = do { (env1, s')  <- wrapLocSndM (zonkStmt env zBody) s\n                                ; (env2, ss') <- zonkStmts env1 zBody ss\n                                ; return (env2, s' : ss') }\n\nzonkStmt :: ZonkEnv\n         -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))\n         -> Stmt GhcTcId (Located (body GhcTcId))\n         -> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))\nzonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op)\n  = do { (env1, new_bind_op) <- zonkSyntaxExpr env bind_op\n       ; new_bind_ty <- zonkTcTypeToTypeX env1 bind_ty\n       ; new_stmts_w_bndrs <- mapM (zonk_branch env1) stmts_w_bndrs\n       ; let new_binders = [b | ParStmtBlock _ _ bs _ <- new_stmts_w_bndrs\n                              , b <- bs]\n             env2 = extendIdZonkEnvRec env1 new_binders\n       ; new_mzip <- zonkExpr env2 mzip_op\n       ; return (env2\n                , ParStmt new_bind_ty new_stmts_w_bndrs new_mzip new_bind_op)}\n  where\n    zonk_branch env1 (ParStmtBlock x stmts bndrs return_op)\n       = do { (env2, new_stmts)  <- zonkStmts env1 zonkLExpr stmts\n            ; (env3, new_return) <- zonkSyntaxExpr env2 return_op\n            ; return (ParStmtBlock x new_stmts (zonkIdOccs env3 bndrs)\n                                                                   new_return) }\n    zonk_branch _ (XParStmtBlock{}) = panic \"zonkStmt\"\n\nzonkStmt env zBody (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_ids = rvs\n                            , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id\n                            , recS_bind_fn = bind_id\n                            , recS_ext =\n                                       RecStmtTc { recS_bind_ty = bind_ty\n                                                 , recS_later_rets = later_rets\n                                                 , recS_rec_rets = rec_rets\n                                                 , recS_ret_ty = ret_ty} })\n  = do { (env1, new_bind_id) <- zonkSyntaxExpr env bind_id\n       ; (env2, new_mfix_id) <- zonkSyntaxExpr env1 mfix_id\n       ; (env3, new_ret_id)  <- zonkSyntaxExpr env2 ret_id\n       ; new_bind_ty <- zonkTcTypeToTypeX env3 bind_ty\n       ; new_rvs <- zonkIdBndrs env3 rvs\n       ; new_lvs <- zonkIdBndrs env3 lvs\n       ; new_ret_ty  <- zonkTcTypeToTypeX env3 ret_ty\n       ; let env4 = extendIdZonkEnvRec env3 new_rvs\n       ; (env5, new_segStmts) <- zonkStmts env4 zBody segStmts\n        -- Zonk the ret-expressions in an envt that\n        -- has the polymorphic bindings in the envt\n       ; new_later_rets <- mapM (zonkExpr env5) later_rets\n       ; new_rec_rets <- mapM (zonkExpr env5) rec_rets\n       ; return (extendIdZonkEnvRec env3 new_lvs,     -- Only the lvs are needed\n                 RecStmt { recS_stmts = new_segStmts, recS_later_ids = new_lvs\n                         , recS_rec_ids = new_rvs, recS_ret_fn = new_ret_id\n                         , recS_mfix_fn = new_mfix_id, recS_bind_fn = new_bind_id\n                         , recS_ext = RecStmtTc\n                             { recS_bind_ty = new_bind_ty\n                             , recS_later_rets = new_later_rets\n                             , recS_rec_rets = new_rec_rets\n                             , recS_ret_ty = new_ret_ty } }) }\n\nzonkStmt env zBody (BodyStmt ty body then_op guard_op)\n  = do (env1, new_then_op)  <- zonkSyntaxExpr env then_op\n       (env2, new_guard_op) <- zonkSyntaxExpr env1 guard_op\n       new_body <- zBody env2 body\n       new_ty   <- zonkTcTypeToTypeX env2 ty\n       return (env2, BodyStmt new_ty new_body new_then_op new_guard_op)\n\nzonkStmt env zBody (LastStmt x body noret ret_op)\n  = do (env1, new_ret) <- zonkSyntaxExpr env ret_op\n       new_body <- zBody env1 body\n       return (env, LastStmt x new_body noret new_ret)\n\nzonkStmt env _ (TransStmt { trS_stmts = stmts, trS_bndrs = binderMap\n                          , trS_by = by, trS_form = form, trS_using = using\n                          , trS_ret = return_op, trS_bind = bind_op\n                          , trS_ext = bind_arg_ty\n                          , trS_fmap = liftM_op })\n  = do {\n    ; (env1, bind_op') <- zonkSyntaxExpr env bind_op\n    ; bind_arg_ty' <- zonkTcTypeToTypeX env1 bind_arg_ty\n    ; (env2, stmts') <- zonkStmts env1 zonkLExpr stmts\n    ; by'        <- fmapMaybeM (zonkLExpr env2) by\n    ; using'     <- zonkLExpr env2 using\n\n    ; (env3, return_op') <- zonkSyntaxExpr env2 return_op\n    ; binderMap' <- mapM (zonkBinderMapEntry env3) binderMap\n    ; liftM_op'  <- zonkExpr env3 liftM_op\n    ; let env3' = extendIdZonkEnvRec env3 (map snd binderMap')\n    ; return (env3', TransStmt { trS_stmts = stmts', trS_bndrs = binderMap'\n                               , trS_by = by', trS_form = form, trS_using = using'\n                               , trS_ret = return_op', trS_bind = bind_op'\n                               , trS_ext = bind_arg_ty'\n                               , trS_fmap = liftM_op' }) }\n  where\n    zonkBinderMapEntry env  (oldBinder, newBinder) = do\n        let oldBinder' = zonkIdOcc env oldBinder\n        newBinder' <- zonkIdBndr env newBinder\n        return (oldBinder', newBinder')\n\nzonkStmt env _ (LetStmt x (dL->L l binds))\n  = do (env1, new_binds) <- zonkLocalBinds env binds\n       return (env1, LetStmt x (cL l new_binds))\n\nzonkStmt env zBody (BindStmt bind_ty pat body bind_op fail_op)\n  = do  { (env1, new_bind) <- zonkSyntaxExpr env bind_op\n        ; new_bind_ty <- zonkTcTypeToTypeX env1 bind_ty\n        ; new_body <- zBody env1 body\n        ; (env2, new_pat) <- zonkPat env1 pat\n        ; (_, new_fail) <- zonkSyntaxExpr env1 fail_op\n        ; return ( env2\n                 , BindStmt new_bind_ty new_pat new_body new_bind new_fail) }\n\n-- Scopes: join > ops (in reverse order) > pats (in forward order)\n--              > rest of stmts\nzonkStmt env _zBody (ApplicativeStmt body_ty args mb_join)\n  = do  { (env1, new_mb_join)   <- zonk_join env mb_join\n        ; (env2, new_args)      <- zonk_args env1 args\n        ; new_body_ty           <- zonkTcTypeToTypeX env2 body_ty\n        ; return (env2, ApplicativeStmt new_body_ty new_args new_mb_join) }\n  where\n    zonk_join env Nothing  = return (env, Nothing)\n    zonk_join env (Just j) = second Just <$> zonkSyntaxExpr env j\n\n    get_pat (_, ApplicativeArgOne _ pat _ _) = pat\n    get_pat (_, ApplicativeArgMany _ _ _ pat) = pat\n    get_pat (_, XApplicativeArg _) = panic \"zonkStmt\"\n\n    replace_pat pat (op, ApplicativeArgOne x _ a isBody)\n      = (op, ApplicativeArgOne x pat a isBody)\n    replace_pat pat (op, ApplicativeArgMany x a b _)\n      = (op, ApplicativeArgMany x a b pat)\n    replace_pat _ (_, XApplicativeArg _) = panic \"zonkStmt\"\n\n    zonk_args env args\n      = do { (env1, new_args_rev) <- zonk_args_rev env (reverse args)\n           ; (env2, new_pats)     <- zonkPats env1 (map get_pat args)\n           ; return (env2, zipWith replace_pat new_pats (reverse new_args_rev)) }\n\n     -- these need to go backward, because if any operators are higher-rank,\n     -- later operators may introduce skolems that are in scope for earlier\n     -- arguments\n    zonk_args_rev env ((op, arg) : args)\n      = do { (env1, new_op)         <- zonkSyntaxExpr env op\n           ; new_arg                <- zonk_arg env1 arg\n           ; (env2, new_args)       <- zonk_args_rev env1 args\n           ; return (env2, (new_op, new_arg) : new_args) }\n    zonk_args_rev env [] = return (env, [])\n\n    zonk_arg env (ApplicativeArgOne x pat expr isBody)\n      = do { new_expr <- zonkLExpr env expr\n           ; return (ApplicativeArgOne x pat new_expr isBody) }\n    zonk_arg env (ApplicativeArgMany x stmts ret pat)\n      = do { (env1, new_stmts) <- zonkStmts env zonkLExpr stmts\n           ; new_ret           <- zonkExpr env1 ret\n           ; return (ApplicativeArgMany x new_stmts new_ret pat) }\n    zonk_arg _ (XApplicativeArg _) = panic \"zonkStmt.XApplicativeArg\"\n\nzonkStmt _ _ (XStmtLR _) = panic \"zonkStmt\"\n\n-------------------------------------------------------------------------\nzonkRecFields :: ZonkEnv -> HsRecordBinds GhcTcId -> TcM (HsRecordBinds GhcTcId)\nzonkRecFields env (HsRecFields flds dd)\n  = do  { flds' <- mapM zonk_rbind flds\n        ; return (HsRecFields flds' dd) }\n  where\n    zonk_rbind (dL->L l fld)\n      = do { new_id   <- wrapLocM (zonkFieldOcc env) (hsRecFieldLbl fld)\n           ; new_expr <- zonkLExpr env (hsRecFieldArg fld)\n           ; return (cL l (fld { hsRecFieldLbl = new_id\n                              , hsRecFieldArg = new_expr })) }\n\nzonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTcId]\n                 -> TcM [LHsRecUpdField GhcTcId]\nzonkRecUpdFields env = mapM zonk_rbind\n  where\n    zonk_rbind (dL->L l fld)\n      = do { new_id   <- wrapLocM (zonkFieldOcc env) (hsRecUpdFieldOcc fld)\n           ; new_expr <- zonkLExpr env (hsRecFieldArg fld)\n           ; return (cL l (fld { hsRecFieldLbl = fmap ambiguousFieldOcc new_id\n                               , hsRecFieldArg = new_expr })) }\n\n-------------------------------------------------------------------------\nmapIPNameTc :: (a -> TcM b) -> Either (Located HsIPName) a\n            -> TcM (Either (Located HsIPName) b)\nmapIPNameTc _ (Left x)  = return (Left x)\nmapIPNameTc f (Right x) = do r <- f x\n                             return (Right r)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[BackSubst-Pats]{Patterns}\n*                                                                      *\n************************************************************************\n-}\n\nzonkPat :: ZonkEnv -> OutPat GhcTcId -> TcM (ZonkEnv, OutPat GhcTc)\n-- Extend the environment as we go, because it's possible for one\n-- pattern to bind something that is used in another (inside or\n-- to the right)\nzonkPat env pat = wrapLocSndM (zonk_pat env) pat\n\nzonk_pat :: ZonkEnv -> Pat GhcTcId -> TcM (ZonkEnv, Pat GhcTc)\nzonk_pat env (ParPat x p)\n  = do  { (env', p') <- zonkPat env p\n        ; return (env', ParPat x p') }\n\nzonk_pat env (WildPat ty)\n  = do  { ty' <- zonkTcTypeToTypeX env ty\n        ; ensureNotLevPoly ty'\n            (text \"In a wildcard pattern\")\n        ; return (env, WildPat ty') }\n\nzonk_pat env (VarPat x (dL->L l v))\n  = do  { v' <- zonkIdBndr env v\n        ; return (extendIdZonkEnv1 env v', VarPat x (cL l v')) }\n\nzonk_pat env (LazyPat x pat)\n  = do  { (env', pat') <- zonkPat env pat\n        ; return (env',  LazyPat x pat') }\n\nzonk_pat env (BangPat x pat)\n  = do  { (env', pat') <- zonkPat env pat\n        ; return (env',  BangPat x pat') }\n\nzonk_pat env (AsPat x (dL->L loc v) pat)\n  = do  { v' <- zonkIdBndr env v\n        ; (env', pat') <- zonkPat (extendIdZonkEnv1 env v') pat\n        ; return (env', AsPat x (cL loc v') pat') }\n\nzonk_pat env (ViewPat ty expr pat)\n  = do  { expr' <- zonkLExpr env expr\n        ; (env', pat') <- zonkPat env pat\n        ; ty' <- zonkTcTypeToTypeX env ty\n        ; return (env', ViewPat ty' expr' pat') }\n\nzonk_pat env (ListPat (ListPatTc ty Nothing) pats)\n  = do  { ty' <- zonkTcTypeToTypeX env ty\n        ; (env', pats') <- zonkPats env pats\n        ; return (env', ListPat (ListPatTc ty' Nothing) pats') }\n\nzonk_pat env (ListPat (ListPatTc ty (Just (ty2,wit))) pats)\n  = do  { (env', wit') <- zonkSyntaxExpr env wit\n        ; ty2' <- zonkTcTypeToTypeX env' ty2\n        ; ty' <- zonkTcTypeToTypeX env' ty\n        ; (env'', pats') <- zonkPats env' pats\n        ; return (env'', ListPat (ListPatTc ty' (Just (ty2',wit'))) pats') }\n\nzonk_pat env (TuplePat tys pats boxed)\n  = do  { tys' <- mapM (zonkTcTypeToTypeX env) tys\n        ; (env', pats') <- zonkPats env pats\n        ; return (env', TuplePat tys' pats' boxed) }\n\nzonk_pat env (SumPat tys pat alt arity )\n  = do  { tys' <- mapM (zonkTcTypeToTypeX env) tys\n        ; (env', pat') <- zonkPat env pat\n        ; return (env', SumPat tys' pat' alt arity) }\n\nzonk_pat env p@(ConPatOut { pat_arg_tys = tys\n                          , pat_tvs = tyvars\n                          , pat_dicts = evs\n                          , pat_binds = binds\n                          , pat_args = args\n                          , pat_wrap = wrapper\n                          , pat_con = (dL->L _ con) })\n  = ASSERT( all isImmutableTyVar tyvars )\n    do  { new_tys <- mapM (zonkTcTypeToTypeX env) tys\n\n          -- an unboxed tuple pattern (but only an unboxed tuple pattern)\n          -- might have levity-polymorphic arguments. Check for this badness.\n        ; case con of\n            RealDataCon dc\n              | isUnboxedTupleTyCon (dataConTyCon dc)\n              -> mapM_ (checkForLevPoly doc) (dropRuntimeRepArgs new_tys)\n            _ -> return ()\n\n        ; (env0, new_tyvars) <- zonkTyBndrsX env tyvars\n          -- Must zonk the existential variables, because their\n          -- /kind/ need potential zonking.\n          -- cf typecheck/should_compile/tc221.hs\n        ; (env1, new_evs) <- zonkEvBndrsX env0 evs\n        ; (env2, new_binds) <- zonkTcEvBinds env1 binds\n        ; (env3, new_wrapper) <- zonkCoFn env2 wrapper\n        ; (env', new_args) <- zonkConStuff env3 args\n        ; return (env', p { pat_arg_tys = new_tys,\n                            pat_tvs = new_tyvars,\n                            pat_dicts = new_evs,\n                            pat_binds = new_binds,\n                            pat_args = new_args,\n                            pat_wrap = new_wrapper}) }\n  where\n    doc = text \"In the type of an element of an unboxed tuple pattern:\" $$ ppr p\n\nzonk_pat env (LitPat x lit) = return (env, LitPat x lit)\n\nzonk_pat env (SigPat ty pat hs_ty)\n  = do  { ty' <- zonkTcTypeToTypeX env ty\n        ; (env', pat') <- zonkPat env pat\n        ; return (env', SigPat ty' pat' hs_ty) }\n\nzonk_pat env (NPat ty (dL->L l lit) mb_neg eq_expr)\n  = do  { (env1, eq_expr') <- zonkSyntaxExpr env eq_expr\n        ; (env2, mb_neg') <- case mb_neg of\n            Nothing -> return (env1, Nothing)\n            Just n  -> second Just <$> zonkSyntaxExpr env1 n\n\n        ; lit' <- zonkOverLit env2 lit\n        ; ty' <- zonkTcTypeToTypeX env2 ty\n        ; return (env2, NPat ty' (cL l lit') mb_neg' eq_expr') }\n\nzonk_pat env (NPlusKPat ty (dL->L loc n) (dL->L l lit1) lit2 e1 e2)\n  = do  { (env1, e1') <- zonkSyntaxExpr env  e1\n        ; (env2, e2') <- zonkSyntaxExpr env1 e2\n        ; n' <- zonkIdBndr env2 n\n        ; lit1' <- zonkOverLit env2 lit1\n        ; lit2' <- zonkOverLit env2 lit2\n        ; ty' <- zonkTcTypeToTypeX env2 ty\n        ; return (extendIdZonkEnv1 env2 n',\n                  NPlusKPat ty' (cL loc n') (cL l lit1') lit2' e1' e2') }\n\nzonk_pat env (CoPat x co_fn pat ty)\n  = do { (env', co_fn') <- zonkCoFn env co_fn\n       ; (env'', pat') <- zonkPat env' (noLoc pat)\n       ; ty' <- zonkTcTypeToTypeX env'' ty\n       ; return (env'', CoPat x co_fn' (unLoc pat') ty') }\n\nzonk_pat _ pat = pprPanic \"zonk_pat\" (ppr pat)\n\n---------------------------\nzonkConStuff :: ZonkEnv\n             -> HsConDetails (OutPat GhcTcId) (HsRecFields id (OutPat GhcTcId))\n             -> TcM (ZonkEnv,\n                    HsConDetails (OutPat GhcTc) (HsRecFields id (OutPat GhcTc)))\nzonkConStuff env (PrefixCon pats)\n  = do  { (env', pats') <- zonkPats env pats\n        ; return (env', PrefixCon pats') }\n\nzonkConStuff env (InfixCon p1 p2)\n  = do  { (env1, p1') <- zonkPat env  p1\n        ; (env', p2') <- zonkPat env1 p2\n        ; return (env', InfixCon p1' p2') }\n\nzonkConStuff env (RecCon (HsRecFields rpats dd))\n  = do  { (env', pats') <- zonkPats env (map (hsRecFieldArg . unLoc) rpats)\n        ; let rpats' = zipWith (\\(dL->L l rp) p' ->\n                                  cL l (rp { hsRecFieldArg = p' }))\n                               rpats pats'\n        ; return (env', RecCon (HsRecFields rpats' dd)) }\n        -- Field selectors have declared types; hence no zonking\n\n---------------------------\nzonkPats :: ZonkEnv -> [OutPat GhcTcId] -> TcM (ZonkEnv, [OutPat GhcTc])\nzonkPats env []         = return (env, [])\nzonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat\n                             ; (env', pats') <- zonkPats env1 pats\n                             ; return (env', pat':pats') }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[BackSubst-Foreign]{Foreign exports}\n*                                                                      *\n************************************************************************\n-}\n\nzonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTcId]\n                   -> TcM [LForeignDecl GhcTc]\nzonkForeignExports env ls = mapM (wrapLocM (zonkForeignExport env)) ls\n\nzonkForeignExport :: ZonkEnv -> ForeignDecl GhcTcId -> TcM (ForeignDecl GhcTc)\nzonkForeignExport env (ForeignExport { fd_name = i, fd_e_ext = co\n                                     , fd_fe = spec })\n  = return (ForeignExport { fd_name = zonkLIdOcc env i\n                          , fd_sig_ty = undefined, fd_e_ext = co\n                          , fd_fe = spec })\nzonkForeignExport _ for_imp\n  = return for_imp     -- Foreign imports don't need zonking\n\nzonkRules :: ZonkEnv -> [LRuleDecl GhcTcId] -> TcM [LRuleDecl GhcTc]\nzonkRules env rs = mapM (wrapLocM (zonkRule env)) rs\n\nzonkRule :: ZonkEnv -> RuleDecl GhcTcId -> TcM (RuleDecl GhcTc)\nzonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-}\n                          , rd_lhs = lhs\n                          , rd_rhs = rhs })\n  = do { (env_inside, new_tm_bndrs) <- mapAccumLM zonk_tm_bndr env tm_bndrs\n\n       ; let env_lhs = setZonkType env_inside SkolemiseFlexi\n              -- See Note [Zonking the LHS of a RULE]\n\n       ; new_lhs <- zonkLExpr env_lhs    lhs\n       ; new_rhs <- zonkLExpr env_inside rhs\n\n       ; return $ rule { rd_tmvs = new_tm_bndrs\n                       , rd_lhs  = new_lhs\n                       , rd_rhs  = new_rhs } }\n  where\n   zonk_tm_bndr env (dL->L l (RuleBndr x (dL->L loc v)))\n      = do { (env', v') <- zonk_it env v\n           ; return (env', cL l (RuleBndr x (cL loc v'))) }\n   zonk_tm_bndr _ (dL->L _ (RuleBndrSig {})) = panic \"zonk_tm_bndr RuleBndrSig\"\n   zonk_tm_bndr _ (dL->L _ (XRuleBndr {})) = panic \"zonk_tm_bndr XRuleBndr\"\n   zonk_tm_bndr _ _ = panic \"zonk_tm_bndr: Impossible Match\"\n                            -- due to #15884\n\n   zonk_it env v\n     | isId v     = do { v' <- zonkIdBndr env v\n                       ; return (extendIdZonkEnvRec env [v'], v') }\n     | otherwise  = ASSERT( isImmutableTyVar v)\n                    zonkTyBndrX env v\n                    -- DV: used to be return (env,v) but that is plain\n                    -- wrong because we may need to go inside the kind\n                    -- of v and zonk there!\nzonkRule _ (XRuleDecl _) = panic \"zonkRule\"\n\n{-\n************************************************************************\n*                                                                      *\n              Constraints and evidence\n*                                                                      *\n************************************************************************\n-}\n\nzonkEvTerm :: ZonkEnv -> EvTerm -> TcM EvTerm\nzonkEvTerm env (EvExpr e)\n  = EvExpr <$> zonkCoreExpr env e\nzonkEvTerm env (EvTypeable ty ev)\n  = EvTypeable <$> zonkTcTypeToTypeX env ty <*> zonkEvTypeable env ev\nzonkEvTerm env (EvFun { et_tvs = tvs, et_given = evs\n                      , et_binds = ev_binds, et_body = body_id })\n  = do { (env0, new_tvs) <- zonkTyBndrsX env tvs\n       ; (env1, new_evs) <- zonkEvBndrsX env0 evs\n       ; (env2, new_ev_binds) <- zonkTcEvBinds env1 ev_binds\n       ; let new_body_id = zonkIdOcc env2 body_id\n       ; return (EvFun { et_tvs = new_tvs, et_given = new_evs\n                       , et_binds = new_ev_binds, et_body = new_body_id }) }\n\nzonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr\nzonkCoreExpr env (Var v)\n    | isCoVar v\n    = Coercion <$> zonkCoVarOcc env v\n    | otherwise\n    = return (Var $ zonkIdOcc env v)\nzonkCoreExpr _ (Lit l)\n    = return $ Lit l\nzonkCoreExpr env (Coercion co)\n    = Coercion <$> zonkCoToCo env co\nzonkCoreExpr env (Type ty)\n    = Type <$> zonkTcTypeToTypeX env ty\n\nzonkCoreExpr env (Cast e co)\n    = Cast <$> zonkCoreExpr env e <*> zonkCoToCo env co\nzonkCoreExpr env (Tick t e)\n    = Tick t <$> zonkCoreExpr env e -- Do we need to zonk in ticks?\n\nzonkCoreExpr env (App e1 e2)\n    = App <$> zonkCoreExpr env e1 <*> zonkCoreExpr env e2\nzonkCoreExpr env (Lam v e)\n    = do { (env1, v') <- zonkCoreBndrX env v\n         ; Lam v' <$> zonkCoreExpr env1 e }\nzonkCoreExpr env (Let bind e)\n    = do (env1, bind') <- zonkCoreBind env bind\n         Let bind'<$> zonkCoreExpr env1 e\nzonkCoreExpr env (Case scrut b ty alts)\n    = do scrut' <- zonkCoreExpr env scrut\n         ty' <- zonkTcTypeToTypeX env ty\n         b' <- zonkIdBndr env b\n         let env1 = extendIdZonkEnv1 env b'\n         alts' <- mapM (zonkCoreAlt env1) alts\n         return $ Case scrut' b' ty' alts'\n\nzonkCoreAlt :: ZonkEnv -> CoreAlt -> TcM CoreAlt\nzonkCoreAlt env (dc, bndrs, rhs)\n    = do (env1, bndrs') <- zonkCoreBndrsX env bndrs\n         rhs' <- zonkCoreExpr env1 rhs\n         return $ (dc, bndrs', rhs')\n\nzonkCoreBind :: ZonkEnv -> CoreBind -> TcM (ZonkEnv, CoreBind)\nzonkCoreBind env (NonRec v e)\n    = do v' <- zonkIdBndr env v\n         e' <- zonkCoreExpr env e\n         let env1 = extendIdZonkEnv1 env v'\n         return (env1, NonRec v' e')\nzonkCoreBind env (Rec pairs)\n    = do (env1, pairs') <- fixM go\n         return (env1, Rec pairs')\n  where\n    go ~(_, new_pairs) = do\n         let env1 = extendIdZonkEnvRec env (map fst new_pairs)\n         pairs' <- mapM (zonkCorePair env1) pairs\n         return (env1, pairs')\n\nzonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr)\nzonkCorePair env (v,e) = (,) <$> zonkIdBndr env v <*> zonkCoreExpr env e\n\nzonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable\nzonkEvTypeable env (EvTypeableTyCon tycon e)\n  = do { e'  <- mapM (zonkEvTerm env) e\n       ; return $ EvTypeableTyCon tycon e' }\nzonkEvTypeable env (EvTypeableTyApp t1 t2)\n  = do { t1' <- zonkEvTerm env t1\n       ; t2' <- zonkEvTerm env t2\n       ; return (EvTypeableTyApp t1' t2') }\nzonkEvTypeable env (EvTypeableTrFun t1 t2)\n  = do { t1' <- zonkEvTerm env t1\n       ; t2' <- zonkEvTerm env t2\n       ; return (EvTypeableTrFun t1' t2') }\nzonkEvTypeable env (EvTypeableTyLit t1)\n  = do { t1' <- zonkEvTerm env t1\n       ; return (EvTypeableTyLit t1') }\n\nzonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])\nzonkTcEvBinds_s env bs = do { (env, bs') <- mapAccumLM zonk_tc_ev_binds env bs\n                            ; return (env, [EvBinds (unionManyBags bs')]) }\n\nzonkTcEvBinds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)\nzonkTcEvBinds env bs = do { (env', bs') <- zonk_tc_ev_binds env bs\n                          ; return (env', EvBinds bs') }\n\nzonk_tc_ev_binds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind)\nzonk_tc_ev_binds env (TcEvBinds var) = zonkEvBindsVar env var\nzonk_tc_ev_binds env (EvBinds bs)    = zonkEvBinds env bs\n\nzonkEvBindsVar :: ZonkEnv -> EvBindsVar -> TcM (ZonkEnv, Bag EvBind)\nzonkEvBindsVar env (EvBindsVar { ebv_binds = ref })\n  = do { bs <- readMutVar ref\n       ; zonkEvBinds env (evBindMapBinds bs) }\nzonkEvBindsVar env (CoEvBindsVar {}) = return (env, emptyBag)\n\nzonkEvBinds :: ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)\nzonkEvBinds env binds\n  = {-# SCC \"zonkEvBinds\" #-}\n    fixM (\\ ~( _, new_binds) -> do\n         { let env1 = extendIdZonkEnvRec env (collect_ev_bndrs new_binds)\n         ; binds' <- mapBagM (zonkEvBind env1) binds\n         ; return (env1, binds') })\n  where\n    collect_ev_bndrs :: Bag EvBind -> [EvVar]\n    collect_ev_bndrs = foldrBag add []\n    add (EvBind { eb_lhs = var }) vars = var : vars\n\nzonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind\nzonkEvBind env bind@(EvBind { eb_lhs = var, eb_rhs = term })\n  = do { var'  <- {-# SCC \"zonkEvBndr\" #-} zonkEvBndr env var\n\n         -- Optimise the common case of Refl coercions\n         -- See Note [Optimise coercion zonking]\n         -- This has a very big effect on some programs (eg Trac #5030)\n\n       ; term' <- case getEqPredTys_maybe (idType var') of\n           Just (r, ty1, ty2) | ty1 `eqType` ty2\n                  -> return (evCoercion (mkTcReflCo r ty1))\n           _other -> zonkEvTerm env term\n\n       ; return (bind { eb_lhs = var', eb_rhs = term' }) }\n\n{- Note [Optimise coercion zonking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen optimising evidence binds we may come across situations where\na coercion looks like\n      cv = ReflCo ty\nor    cv1 = cv2\nwhere the type 'ty' is big.  In such cases it is a waste of time to zonk both\n  * The variable on the LHS\n  * The coercion on the RHS\nRather, we can zonk the variable, and if its type is (ty ~ ty), we can just\nuse Refl on the right, ignoring the actual coercion on the RHS.\n\nThis can have a very big effect, because the constraint solver sometimes does go\nto a lot of effort to prove Refl!  (Eg when solving  10+3 = 10+3; cf Trac #5030)\n\n\n************************************************************************\n*                                                                      *\n                         Zonking types\n*                                                                      *\n************************************************************************\n-}\n\n{- Note [Sharing when zonking to Type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nProblem:\n\n    In TcMType.zonkTcTyVar, we short-circuit (Indirect ty) to\n    (Indirect zty), see Note [Sharing in zonking] in TcMType. But we\n    /can't/ do this when zonking a TcType to a Type (Trac #15552, esp\n    comment:3).  Suppose we have\n\n       alpha -> alpha\n         where\n            alpha is already unified:\n             alpha := T{tc-tycon} Int -> Int\n         and T is knot-tied\n\n    By \"knot-tied\" I mean that the occurrence of T is currently a TcTyCon,\n    but the global env contains a mapping \"T\" :-> T{knot-tied-tc}. See\n    Note [Type checking recursive type and class declarations] in\n    TcTyClsDecls.\n\n    Now we call zonkTcTypeToType on that (alpha -> alpha). If we follow\n    the same path as Note [Sharing in zonking] in TcMType, we'll\n    update alpha to\n       alpha := T{knot-tied-tc} Int -> Int\n\n    But alas, if we encounter alpha for a /second/ time, we end up\n    looking at T{knot-tied-tc} and fall into a black hole. The whole\n    point of zonkTcTypeToType is that it produces a type full of\n    knot-tied tycons, and you must not look at the result!!\n\n    To put it another way (zonkTcTypeToType . zonkTcTypeToType) is not\n    the same as zonkTcTypeToType. (If we distinguished TcType from\n    Type, this issue would have been a type error!)\n\nSolution: (see Trac #15552 for other variants)\n\n    One possible solution is simply not to do the short-circuiting.\n    That has less sharing, but maybe sharing is rare. And indeed,\n    that turns out to be viable from a perf point of view\n\n    But the code implements something a bit better\n\n    * ZonkEnv contains ze_meta_tv_env, which maps\n          from a MetaTyVar (unificaion variable)\n          to a Type (not a TcType)\n\n    * In zonkTyVarOcc, we check this map to see if we have zonked\n      this variable before. If so, use the previous answer; if not\n      zonk it, and extend the map.\n\n    * The map is of course stateful, held in a TcRef. (That is unlike\n      the treatment of lexically-scoped variables in ze_tv_env and\n      ze_id_env.)\n\n    Is the extra work worth it?  Some non-sytematic perf measurements\n    suggest that compiler allocation is reduced overall (by 0.5% or so)\n    but compile time really doesn't change.\n-}\n\nzonkTyVarOcc :: ZonkEnv -> TyVar -> TcM TcType\nzonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi\n                          , ze_tv_env = tv_env\n                          , ze_meta_tv_env = mtv_env_ref }) tv\n  | isTcTyVar tv\n  = case tcTyVarDetails tv of\n      SkolemTv {}    -> lookup_in_tv_env\n      RuntimeUnk {}  -> lookup_in_tv_env\n      MetaTv { mtv_ref = ref }\n        -> do { mtv_env <- readTcRef mtv_env_ref\n                -- See Note [Sharing when zonking to Type]\n              ; case lookupVarEnv mtv_env tv of\n                  Just ty -> return ty\n                  Nothing -> do { mtv_details <- readTcRef ref\n                                ; zonk_meta mtv_env ref mtv_details } }\n  | otherwise\n  = lookup_in_tv_env\n\n  where\n    lookup_in_tv_env    -- Look up in the env just as we do for Ids\n      = case lookupVarEnv tv_env tv of\n          Nothing  -> mkTyVarTy <$> updateTyVarKindM (zonkTcTypeToTypeX env) tv\n          Just tv' -> return (mkTyVarTy tv')\n\n    zonk_meta mtv_env ref Flexi\n      = do { kind <- zonkTcTypeToTypeX env (tyVarKind tv)\n           ; ty <- commitFlexi flexi tv kind\n           ; writeMetaTyVarRef tv ref ty  -- Belt and braces\n           ; finish_meta mtv_env ty }\n\n    zonk_meta mtv_env _ (Indirect ty)\n      = do { zty <- zonkTcTypeToTypeX env ty\n           ; finish_meta mtv_env zty }\n\n    finish_meta mtv_env ty\n      = do { let mtv_env' = extendVarEnv mtv_env tv ty\n           ; writeTcRef mtv_env_ref mtv_env'\n           ; return ty }\n\nlookupTyVarOcc :: ZonkEnv -> TcTyVar -> Maybe TyVar\nlookupTyVarOcc (ZonkEnv { ze_tv_env = tv_env }) tv\n  = lookupVarEnv tv_env tv\n\ncommitFlexi :: ZonkFlexi -> TcTyVar -> Kind -> TcM Type\n-- Only monadic so we can do tc-tracing\ncommitFlexi flexi tv zonked_kind\n  = case flexi of\n      SkolemiseFlexi  -> return (mkTyVarTy (mkTyVar name zonked_kind))\n\n      DefaultFlexi\n        | isRuntimeRepTy zonked_kind\n        -> do { traceTc \"Defaulting flexi tyvar to LiftedRep:\" (pprTyVar tv)\n              ; return liftedRepTy }\n        | otherwise\n        -> do { traceTc \"Defaulting flexi tyvar to Any:\" (pprTyVar tv)\n              ; return (anyTypeOfKind zonked_kind) }\n\n      RuntimeUnkFlexi\n        -> do { traceTc \"Defaulting flexi tyvar to RuntimeUnk:\" (pprTyVar tv)\n              ; return (mkTyVarTy (mkTcTyVar name zonked_kind RuntimeUnk)) }\n                        -- This is where RuntimeUnks are born:\n                        -- otherwise-unconstrained unification variables are\n                        -- turned into RuntimeUnks as they leave the\n                        -- typechecker's monad\n  where\n     name = tyVarName tv\n\nzonkCoVarOcc :: ZonkEnv -> CoVar -> TcM Coercion\nzonkCoVarOcc (ZonkEnv { ze_tv_env = tyco_env }) cv\n  | Just cv' <- lookupVarEnv tyco_env cv  -- don't look in the knot-tied env\n  = return $ mkCoVarCo cv'\n  | otherwise\n  = do { cv' <- zonkCoVar cv; return (mkCoVarCo cv') }\n\nzonkCoHole :: ZonkEnv -> CoercionHole -> TcM Coercion\nzonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })\n  = do { contents <- readTcRef ref\n       ; case contents of\n           Just co -> do { co' <- zonkCoToCo env co\n                         ; checkCoercionHole cv co' }\n\n              -- This next case should happen only in the presence of\n              -- (undeferred) type errors. Originally, I put in a panic\n              -- here, but that caused too many uses of `failIfErrsM`.\n           Nothing -> do { traceTc \"Zonking unfilled coercion hole\" (ppr hole)\n                         ; when debugIsOn $\n                           whenNoErrs $\n                           MASSERT2( False\n                                   , text \"Type-correct unfilled coercion hole\"\n                                     <+> ppr hole )\n                         ; cv' <- zonkCoVar cv\n                         ; return $ mkCoVarCo cv' } }\n                             -- This will be an out-of-scope variable, but keeping\n                             -- this as a coercion hole led to #15787\n\nzonk_tycomapper :: TyCoMapper ZonkEnv TcM\nzonk_tycomapper = TyCoMapper\n  { tcm_tyvar      = zonkTyVarOcc\n  , tcm_covar      = zonkCoVarOcc\n  , tcm_hole       = zonkCoHole\n  , tcm_tycobinder = \\env tv _vis -> zonkTyBndrX env tv\n  , tcm_tycon      = zonkTcTyConToTyCon }\n\n-- Zonk a TyCon by changing a TcTyCon to a regular TyCon\nzonkTcTyConToTyCon :: TcTyCon -> TcM TyCon\nzonkTcTyConToTyCon tc\n  | isTcTyCon tc = do { thing <- tcLookupGlobalOnly (getName tc)\n                      ; case thing of\n                          ATyCon real_tc -> return real_tc\n                          _              -> pprPanic \"zonkTcTyCon\" (ppr tc $$ ppr thing) }\n  | otherwise    = return tc -- it's already zonked\n\n-- Confused by zonking? See Note [What is zonking?] in TcMType.\nzonkTcTypeToType :: TcType -> TcM Type\nzonkTcTypeToType ty = initZonkEnv $ \\ ze -> zonkTcTypeToTypeX ze ty\n\nzonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type\nzonkTcTypeToTypeX = mapType zonk_tycomapper\n\nzonkTcTypesToTypes :: [TcType] -> TcM [Type]\nzonkTcTypesToTypes tys = initZonkEnv $ \\ ze -> zonkTcTypesToTypesX ze tys\n\nzonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type]\nzonkTcTypesToTypesX env tys = mapM (zonkTcTypeToTypeX env) tys\n\nzonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion\nzonkCoToCo = mapCoercion zonk_tycomapper\n\nzonkTcMethInfoToMethInfoX :: ZonkEnv -> TcMethInfo -> TcM MethInfo\nzonkTcMethInfoToMethInfoX ze (name, ty, gdm_spec)\n  = do { ty' <- zonkTcTypeToTypeX ze ty\n       ; gdm_spec' <- zonk_gdm gdm_spec\n       ; return (name, ty', gdm_spec') }\n  where\n    zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType))\n             -> TcM (Maybe (DefMethSpec (SrcSpan, Type)))\n    zonk_gdm Nothing = return Nothing\n    zonk_gdm (Just VanillaDM) = return (Just VanillaDM)\n    zonk_gdm (Just (GenericDM (loc, ty)))\n      = do { ty' <- zonkTcTypeToTypeX ze ty\n           ; return (Just (GenericDM (loc, ty'))) }\n\n---------------------------------------\n{- Note [Zonking the LHS of a RULE]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee also DsBinds Note [Free tyvars on rule LHS]\n\nWe need to gather the type variables mentioned on the LHS so we can\nquantify over them.  Example:\n  data T a = C\n\n  foo :: T a -> Int\n  foo C = 1\n\n  {-# RULES \"myrule\"  foo C = 1 #-}\n\nAfter type checking the LHS becomes (foo alpha (C alpha)) and we do\nnot want to zap the unbound meta-tyvar 'alpha' to Any, because that\nlimits the applicability of the rule.  Instead, we want to quantify\nover it!\n\nWe do this in two stages.\n\n* During zonking, we skolemise the TcTyVar 'alpha' to TyVar 'a'.  We\n  do this by using zonkTvSkolemising as the UnboundTyVarZonker in the\n  ZonkEnv.  (This is in fact the whole reason that the ZonkEnv has a\n  UnboundTyVarZonker.)\n\n* In DsBinds, we quantify over it.  See DsBinds\n  Note [Free tyvars on rule LHS]\n\nQuantifying here is awkward because (a) the data type is big and (b)\nfinding the free type vars of an expression is necessarily monadic\noperation. (consider /\\a -> f @ b, where b is side-effected to a)\n-}\n", "num_lines": 1955}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[TcMonoType]{Typechecking user-specified @MonoTypes@}\n-}\n\n{-# LANGUAGE CPP, TupleSections, MultiWayIf, RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcHsType (\n        -- Type signatures\n        kcHsSigType, tcClassSigType,\n        tcHsSigType, tcHsSigWcType,\n        tcHsPartialSigType,\n        funsSigCtxt, addSigCtxt, pprSigCtxt,\n\n        tcHsClsInstType,\n        tcHsDeriv, tcDerivStrategy,\n        tcHsTypeApp,\n        UserTypeCtxt(..),\n        bindImplicitTKBndrs_Tv, bindImplicitTKBndrs_Skol,\n            bindImplicitTKBndrs_Q_Tv, bindImplicitTKBndrs_Q_Skol,\n        bindExplicitTKBndrs_Tv, bindExplicitTKBndrs_Skol,\n            bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol,\n        ContextKind(..),\n\n                -- Type checking type and class decls\n        kcLookupTcTyCon, bindTyClTyVars,\n        etaExpandAlgTyCon, tcbVisibilities,\n\n          -- tyvars\n        zonkAndScopedSort,\n\n        -- Kind-checking types\n        -- No kind generalisation, no checkValidType\n        kcLHsQTyVars,\n        tcWildCardBinders,\n        tcHsLiftedType,   tcHsOpenType,\n        tcHsLiftedTypeNC, tcHsOpenTypeNC,\n        tcLHsType, tcLHsTypeUnsaturated, tcCheckLHsType,\n        tcHsMbContext, tcHsContext, tcLHsPredType, tcInferApps,\n        failIfEmitsConstraints,\n        solveEqualities, -- useful re-export\n\n        typeLevelMode, kindLevelMode,\n\n        kindGeneralize, checkExpectedKind_pp,\n\n        -- Sort-checking kinds\n        tcLHsKindSig, badKindSig,\n\n        -- Zonking and promoting\n        zonkPromoteType,\n\n        -- Pattern type signatures\n        tcHsPatSigType, tcPatSig,\n\n        -- Error messages\n        funAppCtxt, addTyConFlavCtxt\n   ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport TcRnMonad\nimport TcEvidence\nimport TcEnv\nimport TcMType\nimport TcValidity\nimport TcUnify\nimport TcIface\nimport TcSimplify\nimport TcHsSyn\nimport TyCoRep  ( Type(..) )\nimport TcErrors ( reportAllUnsolved )\nimport TcType\nimport Inst   ( tcInstInvisibleTyBinders, tcInstInvisibleTyBinder )\nimport TyCoRep( TyCoBinder(..) )  -- Used in etaExpandAlgTyCon\nimport Type\nimport TysPrim\nimport Coercion\nimport RdrName( lookupLocalRdrOcc )\nimport Var\nimport VarSet\nimport TyCon\nimport ConLike\nimport DataCon\nimport Class\nimport Name\nimport NameSet\nimport VarEnv\nimport TysWiredIn\nimport BasicTypes\nimport SrcLoc\nimport Constants ( mAX_CTUPLE_SIZE )\nimport ErrUtils( MsgDoc )\nimport Unique\nimport UniqSet\nimport Util\nimport UniqSupply\nimport Outputable\nimport FastString\nimport PrelNames hiding ( wildCardName )\nimport DynFlags ( WarningFlag (Opt_WarnPartialTypeSignatures) )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Maybes\nimport Data.List ( find )\nimport Control.Monad\n\n{-\n        ----------------------------\n                General notes\n        ----------------------------\n\nUnlike with expressions, type-checking types both does some checking and\ndesugars at the same time. This is necessary because we often want to perform\nequality checks on the types right away, and it would be incredibly painful\nto do this on un-desugared types. Luckily, desugared types are close enough\nto HsTypes to make the error messages sane.\n\nDuring type-checking, we perform as little validity checking as possible.\nGenerally, after type-checking, you will want to do validity checking, say\nwith TcValidity.checkValidType.\n\nValidity checking\n~~~~~~~~~~~~~~~~~\nSome of the validity check could in principle be done by the kind checker,\nbut not all:\n\n- During desugaring, we normalise by expanding type synonyms.  Only\n  after this step can we check things like type-synonym saturation\n  e.g.  type T k = k Int\n        type S a = a\n  Then (T S) is ok, because T is saturated; (T S) expands to (S Int);\n  and then S is saturated.  This is a GHC extension.\n\n- Similarly, also a GHC extension, we look through synonyms before complaining\n  about the form of a class or instance declaration\n\n- Ambiguity checks involve functional dependencies\n\nAlso, in a mutually recursive group of types, we can't look at the TyCon until we've\nfinished building the loop.  So to keep things simple, we postpone most validity\nchecking until step (3).\n\n%************************************************************************\n%*                                                                      *\n              Check types AND do validity checking\n*                                                                      *\n************************************************************************\n-}\n\nfunsSigCtxt :: [Located Name] -> UserTypeCtxt\n-- Returns FunSigCtxt, with no redundant-context-reporting,\n-- form a list of located names\nfunsSigCtxt (L _ name1 : _) = FunSigCtxt name1 False\nfunsSigCtxt []              = panic \"funSigCtxt\"\n\naddSigCtxt :: UserTypeCtxt -> LHsType GhcRn -> TcM a -> TcM a\naddSigCtxt ctxt hs_ty thing_inside\n  = setSrcSpan (getLoc hs_ty) $\n    addErrCtxt (pprSigCtxt ctxt hs_ty) $\n    thing_inside\n\npprSigCtxt :: UserTypeCtxt -> LHsType GhcRn -> SDoc\n-- (pprSigCtxt ctxt <extra> <type>)\n-- prints    In the type signature for 'f':\n--              f :: <type>\n-- The <extra> is either empty or \"the ambiguity check for\"\npprSigCtxt ctxt hs_ty\n  | Just n <- isSigMaybe ctxt\n  = hang (text \"In the type signature:\")\n       2 (pprPrefixOcc n <+> dcolon <+> ppr hs_ty)\n\n  | otherwise\n  = hang (text \"In\" <+> pprUserTypeCtxt ctxt <> colon)\n       2 (ppr hs_ty)\n\ntcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type\n-- This one is used when we have a LHsSigWcType, but in\n-- a place where wildcards aren't allowed. The renamer has\n-- already checked this, so we can simply ignore it.\ntcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty)\n\nkcHsSigType :: [Located Name] -> LHsSigType GhcRn -> TcM ()\nkcHsSigType names (HsIB { hsib_body = hs_ty\n                                  , hsib_ext = sig_vars })\n  = discardResult                        $\n    addSigCtxt (funsSigCtxt names) hs_ty $\n    bindImplicitTKBndrs_Skol sig_vars    $\n    tc_lhs_type typeLevelMode hs_ty liftedTypeKind\n\nkcHsSigType _ (XHsImplicitBndrs _) = panic \"kcHsSigType\"\n\ntcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM Type\n-- Does not do validity checking\ntcClassSigType skol_info names sig_ty\n  = addSigCtxt (funsSigCtxt names) (hsSigType sig_ty) $\n    tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind)\n       -- Do not zonk-to-Type, nor perform a validity check\n       -- We are in a knot with the class and associated types\n       -- Zonking and validity checking is done by tcClassDecl\n\ntcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type\n-- Does validity checking\n-- See Note [Recipe for checking a signature]\ntcHsSigType ctxt sig_ty\n  = addSigCtxt ctxt (hsSigType sig_ty) $\n    do { traceTc \"tcHsSigType {\" (ppr sig_ty)\n\n          -- Generalise here: see Note [Kind generalisation]\n       ; ty <- tc_hs_sig_type skol_info sig_ty\n                                      (expectedKindInCtxt ctxt)\n       ; ty <- zonkTcType ty\n\n       ; checkValidType ctxt ty\n       ; traceTc \"end tcHsSigType }\" (ppr ty)\n       ; return ty }\n  where\n    skol_info = SigTypeSkol ctxt\n\ntc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn\n               -> ContextKind -> TcM Type\n-- Kind-checks/desugars an 'LHsSigType',\n--   solve equalities,\n--   and then kind-generalizes.\n-- This will never emit constraints, as it uses solveEqualities interally.\n-- No validity checking or zonking\ntc_hs_sig_type skol_info hs_sig_type ctxt_kind\n  | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type\n  = do { (tc_lvl, (wanted, (spec_tkvs, ty)))\n              <- pushTcLevelM                           $\n                 solveLocalEqualitiesX \"tc_hs_sig_type\" $\n                 bindImplicitTKBndrs_Skol sig_vars      $\n                 do { kind <- newExpectedKind ctxt_kind\n                    ; tc_lhs_type typeLevelMode hs_ty kind }\n       -- Any remaining variables (unsolved in the solveLocalEqualities)\n       -- should be in the global tyvars, and therefore won't be quantified\n\n       ; spec_tkvs <- zonkAndScopedSort spec_tkvs\n       ; let ty1 = mkSpecForAllTys spec_tkvs ty\n       ; kvs <- kindGeneralizeLocal wanted ty1\n       ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs)\n                                  tc_lvl wanted\n\n       -- See Note [Fail fast if there are insoluble kind equalities]\n       --     in TcSimplify\n       ; when (insolubleWC wanted) failM\n\n       ; return (mkInvForAllTys kvs ty1) }\n\ntc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic \"tc_hs_sig_type\"\n\ntcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type\n-- tcTopLHsType is used for kind-checking top-level HsType where\n--   we want to fully solve /all/ equalities, and report errors\n-- Does zonking, but not validity checking because it's used\n--   for things (like deriving and instances) that aren't\n--   ordinary types\ntcTopLHsType hs_sig_type ctxt_kind\n  | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type\n  = do { traceTc \"tcTopLHsType {\" (ppr hs_ty)\n       ; (spec_tkvs, ty)\n              <- pushTcLevelM_                     $\n                 solveEqualities                   $\n                 bindImplicitTKBndrs_Skol sig_vars $\n                 do { kind <- newExpectedKind ctxt_kind\n                    ; tc_lhs_type typeLevelMode hs_ty kind }\n\n       ; spec_tkvs <- zonkAndScopedSort spec_tkvs\n       ; let ty1 = mkSpecForAllTys spec_tkvs ty\n       ; kvs <- kindGeneralize ty1\n       ; final_ty <- zonkTcTypeToType (mkInvForAllTys kvs ty1)\n       ; traceTc \"End tcTopLHsType }\" (vcat [ppr hs_ty, ppr final_ty])\n       ; return final_ty}\n\ntcTopLHsType (XHsImplicitBndrs _) _ = panic \"tcTopLHsType\"\n\n-----------------\ntcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], (Class, [Type], [Kind]))\n-- Like tcHsSigType, but for the ...deriving( C t1 ty2 ) clause\n-- Returns the C, [ty1, ty2, and the kinds of C's remaining arguments\n-- E.g.    class C (a::*) (b::k->k)\n--         data T a b = ... deriving( C Int )\n--    returns ([k], C, [k, Int], [k->k])\n-- Return values are fully zonked\ntcHsDeriv hs_ty\n  = do { ty <- checkNoErrs $  -- Avoid redundant error report\n                              -- with \"illegal deriving\", below\n               tcTopLHsType hs_ty AnyKind\n       ; let (tvs, pred)    = splitForAllTys ty\n             (kind_args, _) = splitFunTys (tcTypeKind pred)\n       ; case getClassPredTys_maybe pred of\n           Just (cls, tys) -> return (tvs, (cls, tys, kind_args))\n           Nothing -> failWithTc (text \"Illegal deriving item\" <+> quotes (ppr hs_ty)) }\n\n-- | Typecheck something within the context of a deriving strategy.\n-- This is of particular importance when the deriving strategy is @via@.\n-- For instance:\n--\n-- @\n-- deriving via (S a) instance C (T a)\n-- @\n--\n-- We need to typecheck @S a@, and moreover, we need to extend the tyvar\n-- environment with @a@ before typechecking @C (T a)@, since @S a@ quantified\n-- the type variable @a@.\ntcDerivStrategy\n  :: forall a.\n     Maybe (DerivStrategy GhcRn) -- ^ The deriving strategy\n  -> TcM ([TyVar], a) -- ^ The thing to typecheck within the context of the\n                      -- deriving strategy, which might quantify some type\n                      -- variables of its own.\n  -> TcM (Maybe (DerivStrategy GhcTc), [TyVar], a)\n     -- ^ The typechecked deriving strategy, all quantified tyvars, and\n     -- the payload of the typechecked thing.\ntcDerivStrategy mds thing_inside\n  = case mds of\n      Nothing -> boring_case Nothing\n      Just ds -> do (ds', tvs, thing) <- tc_deriv_strategy ds\n                    pure (Just ds', tvs, thing)\n  where\n    tc_deriv_strategy :: DerivStrategy GhcRn\n                      -> TcM (DerivStrategy GhcTc, [TyVar], a)\n    tc_deriv_strategy StockStrategy    = boring_case StockStrategy\n    tc_deriv_strategy AnyclassStrategy = boring_case AnyclassStrategy\n    tc_deriv_strategy NewtypeStrategy  = boring_case NewtypeStrategy\n    tc_deriv_strategy (ViaStrategy ty) = do\n      ty' <- checkNoErrs $\n             tcTopLHsType ty AnyKind\n      let (via_tvs, via_pred) = splitForAllTys ty'\n      tcExtendTyVarEnv via_tvs $ do\n        (thing_tvs, thing) <- thing_inside\n        pure (ViaStrategy via_pred, via_tvs ++ thing_tvs, thing)\n\n    boring_case :: mds -> TcM (mds, [TyVar], a)\n    boring_case mds = do\n      (thing_tvs, thing) <- thing_inside\n      pure (mds, thing_tvs, thing)\n\ntcHsClsInstType :: UserTypeCtxt    -- InstDeclCtxt or SpecInstCtxt\n                -> LHsSigType GhcRn\n                -> TcM Type\n-- Like tcHsSigType, but for a class instance declaration\ntcHsClsInstType user_ctxt hs_inst_ty\n  = setSrcSpan (getLoc (hsSigType hs_inst_ty)) $\n    do { -- Fail eagerly if tcTopLHsType fails.  We are at top level so\n         -- these constraints will never be solved later. And failing\n         -- eagerly avoids follow-on errors when checkValidInstance\n         -- sees an unsolved coercion hole\n         inst_ty <- checkNoErrs $\n                    tcTopLHsType hs_inst_ty (TheKind constraintKind)\n       ; checkValidInstance user_ctxt hs_inst_ty inst_ty\n       ; return inst_ty }\n\n----------------------------------------------\n-- | Type-check a visible type application\ntcHsTypeApp :: LHsWcType GhcRn -> Kind -> TcM Type\n-- See Note [Recipe for checking a signature] in TcHsType\ntcHsTypeApp wc_ty kind\n  | HsWC { hswc_ext = sig_wcs, hswc_body = hs_ty } <- wc_ty\n  = do { ty <- solveLocalEqualities \"tcHsTypeApp\" $\n               -- We are looking at a user-written type, very like a\n               -- signature so we want to solve its equalities right now\n               unsetWOptM Opt_WarnPartialTypeSignatures $\n               setXOptM LangExt.PartialTypeSignatures $\n               -- See Note [Wildcards in visible type application]\n               tcWildCardBinders sig_wcs $ \\ _ ->\n               tcCheckLHsType hs_ty kind\n       -- We must promote here. Ex:\n       --   f :: forall a. a\n       --   g = f @(forall b. Proxy b -> ()) @Int ...\n       -- After when processing the @Int, we'll have to check its kind\n       -- against the as-yet-unknown kind of b. This check causes an assertion\n       -- failure if we don't promote.\n       ; ty <- zonkPromoteType ty\n       ; checkValidType TypeAppCtxt ty\n       ; return ty }\ntcHsTypeApp (XHsWildCardBndrs _) _ = panic \"tcHsTypeApp\"\n\n{- Note [Wildcards in visible type application]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA HsWildCardBndrs's hswc_ext now only includes named wildcards, so any unnamed\nwildcards stay unchanged in hswc_body and when called in tcHsTypeApp, tcCheckLHsType\nwill call emitWildCardHoleConstraints on them. However, this would trigger\nerror/warning when an unnamed wildcard is passed in as a visible type argument,\nwhich we do not want because users should be able to write @_ to skip a instantiating\na type variable variable without fuss. The solution is to switch the\nPartialTypeSignatures flags here to let the typechecker know that it's checking\na '@_' and do not emit hole constraints on it.\nSee related Note [Wildcards in visible kind application]\nand Note [The wildcard story for types] in HsTypes.hs\n\n-}\n\n{-\n************************************************************************\n*                                                                      *\n            The main kind checker: no validity checks here\n*                                                                      *\n************************************************************************\n-}\n\n---------------------------\ntcHsOpenType, tcHsLiftedType,\n  tcHsOpenTypeNC, tcHsLiftedTypeNC :: LHsType GhcRn -> TcM TcType\n-- Used for type signatures\n-- Do not do validity checking\ntcHsOpenType ty   = addTypeCtxt ty $ tcHsOpenTypeNC ty\ntcHsLiftedType ty = addTypeCtxt ty $ tcHsLiftedTypeNC ty\n\ntcHsOpenTypeNC   ty = do { ek <- newOpenTypeKind\n                         ; tc_lhs_type typeLevelMode ty ek }\ntcHsLiftedTypeNC ty = tc_lhs_type typeLevelMode ty liftedTypeKind\n\n-- Like tcHsType, but takes an expected kind\ntcCheckLHsType :: LHsType GhcRn -> Kind -> TcM TcType\ntcCheckLHsType hs_ty exp_kind\n  = addTypeCtxt hs_ty $\n    tc_lhs_type typeLevelMode hs_ty exp_kind\n\ntcLHsType :: LHsType GhcRn -> TcM (TcType, TcKind)\n-- Called from outside: set the context\ntcLHsType ty = addTypeCtxt ty (tc_infer_lhs_type typeLevelMode ty)\n\n-- Like tcLHsType, but use it in a context where type synonyms and type families\n-- do not need to be saturated, like in a GHCi :kind call\ntcLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind)\ntcLHsTypeUnsaturated hs_ty\n  | Just (hs_fun_ty, hs_args) <- splitHsAppTys (unLoc hs_ty)\n  = addTypeCtxt hs_ty $\n    do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty\n       ; tcInferApps_nosat mode hs_fun_ty fun_ty hs_args }\n         -- Notice the 'nosat'; do not instantiate trailing\n         -- invisible arguments of a type family.\n         -- See Note [Dealing with :kind]\n\n  | otherwise\n  = addTypeCtxt hs_ty $\n    tc_infer_lhs_type mode hs_ty\n\n  where\n    mode = typeLevelMode\n\n{- Note [Dealing with :kind]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this GHCi command\n  ghci> type family F :: Either j k\n  ghci> :kind F\n  F :: forall {j,k}. Either j k\n\nWe will only get the 'forall' if we /refrain/ from saturating those\ninvisible binders. But generally we /do/ saturate those invisible\nbinders (see tcInferApps), and we want to do so for nested application\neven in GHCi.  Consider for example (Trac #16287)\n  ghci> type family F :: k\n  ghci> data T :: (forall k. k) -> Type\n  ghci> :kind T F\nWe want to reject this. It's just at the very top level that we want\nto switch off saturation.\n\nSo tcLHsTypeUnsaturated does a little special case for top level\napplications.  Actually the common case is a bare variable, as above.\n\n\n************************************************************************\n*                                                                      *\n      Type-checking modes\n*                                                                      *\n************************************************************************\n\nThe kind-checker is parameterised by a TcTyMode, which contains some\ninformation about where we're checking a type.\n\nThe renamer issues errors about what it can. All errors issued here must\nconcern things that the renamer can't handle.\n\n-}\n\n-- | Info about the context in which we're checking a type. Currently,\n-- differentiates only between types and kinds, but this will likely\n-- grow, at least to include the distinction between patterns and\n-- not-patterns.\n--\n-- To find out where the mode is used, search for 'mode_level'\ndata TcTyMode = TcTyMode { mode_level :: TypeOrKind }\n\ntypeLevelMode :: TcTyMode\ntypeLevelMode = TcTyMode { mode_level = TypeLevel }\n\nkindLevelMode :: TcTyMode\nkindLevelMode = TcTyMode { mode_level = KindLevel }\n\n-- switch to kind level\nkindLevel :: TcTyMode -> TcTyMode\nkindLevel mode = mode { mode_level = KindLevel }\n\ninstance Outputable TcTyMode where\n  ppr = ppr . mode_level\n\n{-\nNote [Bidirectional type checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn expressions, whenever we see a polymorphic identifier, say `id`, we are\nfree to instantiate it with metavariables, knowing that we can always\nre-generalize with type-lambdas when necessary. For example:\n\n  rank2 :: (forall a. a -> a) -> ()\n  x = rank2 id\n\nWhen checking the body of `x`, we can instantiate `id` with a metavariable.\nThen, when we're checking the application of `rank2`, we notice that we really\nneed a polymorphic `id`, and then re-generalize over the unconstrained\nmetavariable.\n\nIn types, however, we're not so lucky, because *we cannot re-generalize*!\nThere is no lambda. So, we must be careful only to instantiate at the last\npossible moment, when we're sure we're never going to want the lost polymorphism\nagain. This is done in calls to tcInstInvisibleTyBinders.\n\nTo implement this behavior, we use bidirectional type checking, where we\nexplicitly think about whether we know the kind of the type we're checking\nor not. Note that there is a difference between not knowing a kind and\nknowing a metavariable kind: the metavariables are TauTvs, and cannot become\nforall-quantified kinds. Previously (before dependent types), there were\nno higher-rank kinds, and so we could instantiate early and be sure that\nno types would have polymorphic kinds, and so we could always assume that\nthe kind of a type was a fresh metavariable. Not so anymore, thus the\nneed for two algorithms.\n\nFor HsType forms that can never be kind-polymorphic, we implement only the\n\"down\" direction, where we safely assume a metavariable kind. For HsType forms\nthat *can* be kind-polymorphic, we implement just the \"up\" (functions with\n\"infer\" in their name) version, as we gain nothing by also implementing the\n\"down\" version.\n\nNote [Future-proofing the type checker]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs discussed in Note [Bidirectional type checking], each HsType form is\nhandled in *either* tc_infer_hs_type *or* tc_hs_type. These functions\nare mutually recursive, so that either one can work for any type former.\nBut, we want to make sure that our pattern-matches are complete. So,\nwe have a bunch of repetitive code just so that we get warnings if we're\nmissing any patterns.\n\n-}\n\n------------------------------------------\n-- | Check and desugar a type, returning the core type and its\n-- possibly-polymorphic kind. Much like 'tcInferRho' at the expression\n-- level.\ntc_infer_lhs_type :: TcTyMode -> LHsType GhcRn -> TcM (TcType, TcKind)\ntc_infer_lhs_type mode (L span ty)\n  = setSrcSpan span $\n    tc_infer_hs_type mode ty\n\n---------------------------\n-- | Call 'tc_infer_hs_type' and check its result against an expected kind.\ntc_infer_hs_type_ek :: HasDebugCallStack => TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType\ntc_infer_hs_type_ek mode hs_ty ek\n  = do { (ty, k) <- tc_infer_hs_type mode hs_ty\n       ; checkExpectedKind hs_ty ty k ek }\n\n---------------------------\n-- | Infer the kind of a type and desugar. This is the \"up\" type-checker,\n-- as described in Note [Bidirectional type checking]\ntc_infer_hs_type :: TcTyMode -> HsType GhcRn -> TcM (TcType, TcKind)\n\ntc_infer_hs_type mode (HsParTy _ t)\n  = tc_infer_lhs_type mode t\n\ntc_infer_hs_type mode ty\n  | Just (hs_fun_ty, hs_args) <- splitHsAppTys ty\n  = do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty\n       ; tcInferApps mode hs_fun_ty fun_ty hs_args }\n\ntc_infer_hs_type mode (HsKindSig _ ty sig)\n  = do { sig' <- tcLHsKindSig KindSigCtxt sig\n                 -- We must typecheck the kind signature, and solve all\n                 -- its equalities etc; from this point on we may do\n                 -- things like instantiate its foralls, so it needs\n                 -- to be fully determined (Trac #14904)\n       ; traceTc \"tc_infer_hs_type:sig\" (ppr ty $$ ppr sig')\n       ; ty' <- tc_lhs_type mode ty sig'\n       ; return (ty', sig') }\n\n-- HsSpliced is an annotation produced by 'RnSplice.rnSpliceType' to communicate\n-- the splice location to the typechecker. Here we skip over it in order to have\n-- the same kind inferred for a given expression whether it was produced from\n-- splices or not.\n--\n-- See Note [Delaying modFinalizers in untyped splices].\ntc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)))\n  = tc_infer_hs_type mode ty\n\ntc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty\ntc_infer_hs_type _    (XHsType (NHsCoreTy ty))\n  = return (ty, tcTypeKind ty)\n\ntc_infer_hs_type _ (HsExplicitListTy _ _ tys)\n  | null tys  -- this is so that we can use visible kind application with '[]\n              -- e.g ... '[] @Bool\n  = return (mkTyConTy promotedNilDataCon,\n            mkSpecForAllTys [alphaTyVar] $ mkListTy alphaTy)\n\ntc_infer_hs_type mode other_ty\n  = do { kv <- newMetaKindVar\n       ; ty' <- tc_hs_type mode other_ty kv\n       ; return (ty', kv) }\n\n------------------------------------------\ntc_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType\ntc_lhs_type mode (L span ty) exp_kind\n  = setSrcSpan span $\n    tc_hs_type mode ty exp_kind\n\ntc_hs_type :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType\n-- See Note [Bidirectional type checking]\n\ntc_hs_type mode (HsParTy _ ty)   exp_kind = tc_lhs_type mode ty exp_kind\ntc_hs_type mode (HsDocTy _ ty _) exp_kind = tc_lhs_type mode ty exp_kind\ntc_hs_type _ ty@(HsBangTy _ bang _) _\n    -- While top-level bangs at this point are eliminated (eg !(Maybe Int)),\n    -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of\n    -- bangs are invalid, so fail. (#7210, #14761)\n    = do { let bangError err = failWith $\n                 text \"Unexpected\" <+> text err <+> text \"annotation:\" <+> ppr ty $$\n                 text err <+> text \"annotation cannot appear nested inside a type\"\n         ; case bang of\n             HsSrcBang _ SrcUnpack _           -> bangError \"UNPACK\"\n             HsSrcBang _ SrcNoUnpack _         -> bangError \"NOUNPACK\"\n             HsSrcBang _ NoSrcUnpack SrcLazy   -> bangError \"laziness\"\n             HsSrcBang _ _ _                   -> bangError \"strictness\" }\ntc_hs_type _ ty@(HsRecTy {})      _\n      -- Record types (which only show up temporarily in constructor\n      -- signatures) should have been removed by now\n    = failWithTc (text \"Record syntax is illegal here:\" <+> ppr ty)\n\n-- HsSpliced is an annotation produced by 'RnSplice.rnSpliceType'.\n-- Here we get rid of it and add the finalizers to the global environment\n-- while capturing the local environment.\n--\n-- See Note [Delaying modFinalizers in untyped splices].\ntc_hs_type mode (HsSpliceTy _ (HsSpliced _ mod_finalizers (HsSplicedTy ty)))\n           exp_kind\n  = do addModFinalizersWithLclEnv mod_finalizers\n       tc_hs_type mode ty exp_kind\n\n-- This should never happen; type splices are expanded by the renamer\ntc_hs_type _ ty@(HsSpliceTy {}) _exp_kind\n  = failWithTc (text \"Unexpected type splice:\" <+> ppr ty)\n\n---------- Functions and applications\ntc_hs_type mode (HsFunTy _ ty1 ty2) exp_kind\n  = tc_fun_type mode ty1 ty2 exp_kind\n\ntc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind\n  | op `hasKey` funTyConKey\n  = tc_fun_type mode ty1 ty2 exp_kind\n\n--------- Foralls\ntc_hs_type mode forall@(HsForAllTy { hst_fvf = fvf, hst_bndrs = hs_tvs\n                                   , hst_body = ty }) exp_kind\n  = do { (tclvl, wanted, (tvs', ty'))\n            <- pushLevelAndCaptureConstraints $\n               bindExplicitTKBndrs_Skol hs_tvs $\n               tc_lhs_type mode ty exp_kind\n    -- Do not kind-generalise here!  See Note [Kind generalisation]\n    -- Why exp_kind?  See Note [Body kind of HsForAllTy]\n       ; let argf        = case fvf of\n                             ForallVis   -> Required\n                             ForallInvis -> Specified\n             bndrs       = mkTyVarBinders argf tvs'\n             skol_info   = ForAllSkol (ppr forall)\n             m_telescope = Just (sep (map ppr hs_tvs))\n\n       ; emitResidualTvConstraint skol_info m_telescope tvs' tclvl wanted\n\n       ; return (mkForAllTys bndrs ty') }\n\ntc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind\n  | null (unLoc ctxt)\n  = tc_lhs_type mode rn_ty exp_kind\n\n  -- See Note [Body kind of a HsQualTy]\n  | tcIsConstraintKind exp_kind\n  = do { ctxt' <- tc_hs_context mode ctxt\n       ; ty'   <- tc_lhs_type mode rn_ty constraintKind\n       ; return (mkPhiTy ctxt' ty') }\n\n  | otherwise\n  = do { ctxt' <- tc_hs_context mode ctxt\n\n       ; ek <- newOpenTypeKind  -- The body kind (result of the function) can\n                                -- be TYPE r, for any r, hence newOpenTypeKind\n       ; ty' <- tc_lhs_type mode rn_ty ek\n       ; checkExpectedKind (unLoc rn_ty) (mkPhiTy ctxt' ty')\n                           liftedTypeKind exp_kind }\n\n--------- Lists, arrays, and tuples\ntc_hs_type mode rn_ty@(HsListTy _ elt_ty) exp_kind\n  = do { tau_ty <- tc_lhs_type mode elt_ty liftedTypeKind\n       ; checkWiredInTyCon listTyCon\n       ; checkExpectedKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind }\n\n-- See Note [Distinguishing tuple kinds] in HsTypes\n-- See Note [Inferring tuple kinds]\ntc_hs_type mode rn_ty@(HsTupleTy _ HsBoxedOrConstraintTuple hs_tys) exp_kind\n     -- (NB: not zonking before looking at exp_k, to avoid left-right bias)\n  | Just tup_sort <- tupKindSort_maybe exp_kind\n  = traceTc \"tc_hs_type tuple\" (ppr hs_tys) >>\n    tc_tuple rn_ty mode tup_sort hs_tys exp_kind\n  | otherwise\n  = do { traceTc \"tc_hs_type tuple 2\" (ppr hs_tys)\n       ; (tys, kinds) <- mapAndUnzipM (tc_infer_lhs_type mode) hs_tys\n       ; kinds <- mapM zonkTcType kinds\n           -- Infer each arg type separately, because errors can be\n           -- confusing if we give them a shared kind.  Eg Trac #7410\n           -- (Either Int, Int), we do not want to get an error saying\n           -- \"the second argument of a tuple should have kind *->*\"\n\n       ; let (arg_kind, tup_sort)\n               = case [ (k,s) | k <- kinds\n                              , Just s <- [tupKindSort_maybe k] ] of\n                    ((k,s) : _) -> (k,s)\n                    [] -> (liftedTypeKind, BoxedTuple)\n         -- In the [] case, it's not clear what the kind is, so guess *\n\n       ; tys' <- sequence [ setSrcSpan loc $\n                            checkExpectedKind hs_ty ty kind arg_kind\n                          | ((L loc hs_ty),ty,kind) <- zip3 hs_tys tys kinds ]\n\n       ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind }\n\n\ntc_hs_type mode rn_ty@(HsTupleTy _ hs_tup_sort tys) exp_kind\n  = tc_tuple rn_ty mode tup_sort tys exp_kind\n  where\n    tup_sort = case hs_tup_sort of  -- Fourth case dealt with above\n                  HsUnboxedTuple    -> UnboxedTuple\n                  HsBoxedTuple      -> BoxedTuple\n                  HsConstraintTuple -> ConstraintTuple\n                  _                 -> panic \"tc_hs_type HsTupleTy\"\n\ntc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind\n  = do { let arity = length hs_tys\n       ; arg_kinds <- mapM (\\_ -> newOpenTypeKind) hs_tys\n       ; tau_tys   <- zipWithM (tc_lhs_type mode) hs_tys arg_kinds\n       ; let arg_reps = map kindRep arg_kinds\n             arg_tys  = arg_reps ++ tau_tys\n             sum_ty   = mkTyConApp (sumTyCon arity) arg_tys\n             sum_kind = unboxedSumKind arg_reps\n       ; checkExpectedKind rn_ty sum_ty sum_kind exp_kind\n       }\n\n--------- Promoted lists and tuples\ntc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind\n  = do { tks <- mapM (tc_infer_lhs_type mode) tys\n       ; (taus', kind) <- unifyKinds tys tks\n       ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus')\n       ; checkExpectedKind rn_ty ty (mkListTy kind) exp_kind }\n  where\n    mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b]\n    mk_nil  k     = mkTyConApp (promoteDataCon nilDataCon) [k]\n\ntc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind\n  -- using newMetaKindVar means that we force instantiations of any polykinded\n  -- types. At first, I just used tc_infer_lhs_type, but that led to #11255.\n  = do { ks   <- replicateM arity newMetaKindVar\n       ; taus <- zipWithM (tc_lhs_type mode) tys ks\n       ; let kind_con   = tupleTyCon           Boxed arity\n             ty_con     = promotedTupleDataCon Boxed arity\n             tup_k      = mkTyConApp kind_con ks\n       ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind }\n  where\n    arity = length tys\n\n--------- Constraint types\ntc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind\n  = do { MASSERT( isTypeLevel (mode_level mode) )\n       ; ty' <- tc_lhs_type mode ty liftedTypeKind\n       ; let n' = mkStrLitTy $ hsIPNameFS n\n       ; ipClass <- tcLookupClass ipClassName\n       ; checkExpectedKind rn_ty (mkClassPred ipClass [n',ty'])\n                           constraintKind exp_kind }\n\ntc_hs_type _ rn_ty@(HsStarTy _ _) exp_kind\n  -- Desugaring 'HsStarTy' to 'Data.Kind.Type' here means that we don't have to\n  -- handle it in 'coreView' and 'tcView'.\n  = checkExpectedKind rn_ty liftedTypeKind liftedTypeKind exp_kind\n\n--------- Literals\ntc_hs_type _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind\n  = do { checkWiredInTyCon typeNatKindCon\n       ; checkExpectedKind rn_ty (mkNumLitTy n) typeNatKind exp_kind }\n\ntc_hs_type _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind\n  = do { checkWiredInTyCon typeSymbolKindCon\n       ; checkExpectedKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind }\n\n--------- Potentially kind-polymorphic types: call the \"up\" checker\n-- See Note [Future-proofing the type checker]\ntc_hs_type mode ty@(HsTyVar {})            ek = tc_infer_hs_type_ek mode ty ek\ntc_hs_type mode ty@(HsAppTy {})            ek = tc_infer_hs_type_ek mode ty ek\ntc_hs_type mode ty@(HsAppKindTy{})         ek = tc_infer_hs_type_ek mode ty ek\ntc_hs_type mode ty@(HsOpTy {})             ek = tc_infer_hs_type_ek mode ty ek\ntc_hs_type mode ty@(HsKindSig {})          ek = tc_infer_hs_type_ek mode ty ek\ntc_hs_type mode ty@(XHsType (NHsCoreTy{})) ek = tc_infer_hs_type_ek mode ty ek\ntc_hs_type _    wc@(HsWildCardTy _)        ek = tcWildCardOcc wc ek\n\n------------------------------------------\ntc_fun_type :: TcTyMode -> LHsType GhcRn -> LHsType GhcRn -> TcKind\n            -> TcM TcType\ntc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of\n  TypeLevel ->\n    do { arg_k <- newOpenTypeKind\n       ; res_k <- newOpenTypeKind\n       ; ty1' <- tc_lhs_type mode ty1 arg_k\n       ; ty2' <- tc_lhs_type mode ty2 res_k\n       ; checkExpectedKind (HsFunTy noExt ty1 ty2) (mkVisFunTy ty1' ty2')\n                           liftedTypeKind exp_kind }\n  KindLevel ->  -- no representation polymorphism in kinds. yet.\n    do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind\n       ; ty2' <- tc_lhs_type mode ty2 liftedTypeKind\n       ; checkExpectedKind (HsFunTy noExt ty1 ty2) (mkVisFunTy ty1' ty2')\n                           liftedTypeKind exp_kind }\n\n---------------------------\ntcWildCardOcc :: HsType GhcRn -> Kind -> TcM TcType\ntcWildCardOcc wc exp_kind\n  = do { wc_tv <- newWildTyVar\n          -- The wildcard's kind should be an un-filled-in meta tyvar\n       ; loc <- getSrcSpanM\n       ; uniq <- newUnique\n       ; let name = mkInternalName uniq (mkTyVarOcc \"_\") loc\n       ; part_tysig <- xoptM LangExt.PartialTypeSignatures\n       ; warning <- woptM Opt_WarnPartialTypeSignatures\n       -- See Note [Wildcards in visible kind application]\n       ; unless (part_tysig && not warning)\n             (emitWildCardHoleConstraints [(name,wc_tv)])\n       ; checkExpectedKind wc (mkTyVarTy wc_tv)\n                           (tyVarKind wc_tv) exp_kind }\n\n{- Note [Wildcards in visible kind application]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are cases where users might want to pass in a wildcard as a visible kind\nargument, for instance:\n\ndata T :: forall k1 k2. k1 \u00e2\u2020\u2019 k2 \u00e2\u2020\u2019 Type where\n  MkT :: T a b\nx :: T @_ @Nat False n\nx = MkT\n\nSo we should allow '@_' without emitting any hole constraints, and\nregardless of whether PartialTypeSignatures is enabled or not. But how would\nthe typechecker know which '_' is being used in VKA and which is not when it\ncalls emitWildCardHoleConstraints in tcHsPartialSigType on all HsWildCardBndrs?\nThe solution then is to neither rename nor include unnamed wildcards in HsWildCardBndrs,\nbut instead give every unnamed wildcard a fresh wild tyvar in tcWildCardOcc.\nAnd whenever we see a '@', we automatically turn on PartialTypeSignatures and\nturn off hole constraint warnings, and never call emitWildCardHoleConstraints\nunder these conditions.\nSee related Note [Wildcards in visible type application] here and\nNote [The wildcard story for types] in HsTypes.hs\n\n-}\n\n{- *********************************************************************\n*                                                                      *\n                Tuples\n*                                                                      *\n********************************************************************* -}\n\n---------------------------\ntupKindSort_maybe :: TcKind -> Maybe TupleSort\ntupKindSort_maybe k\n  | Just (k', _) <- splitCastTy_maybe k = tupKindSort_maybe k'\n  | Just k'      <- tcView k            = tupKindSort_maybe k'\n  | tcIsConstraintKind k = Just ConstraintTuple\n  | tcIsLiftedTypeKind k   = Just BoxedTuple\n  | otherwise            = Nothing\n\ntc_tuple :: HsType GhcRn -> TcTyMode -> TupleSort -> [LHsType GhcRn] -> TcKind -> TcM TcType\ntc_tuple rn_ty mode tup_sort tys exp_kind\n  = do { arg_kinds <- case tup_sort of\n           BoxedTuple      -> return (nOfThem arity liftedTypeKind)\n           UnboxedTuple    -> mapM (\\_ -> newOpenTypeKind) tys\n           ConstraintTuple -> return (nOfThem arity constraintKind)\n       ; tau_tys <- zipWithM (tc_lhs_type mode) tys arg_kinds\n       ; finish_tuple rn_ty tup_sort tau_tys arg_kinds exp_kind }\n  where\n    arity   = length tys\n\nfinish_tuple :: HsType GhcRn\n             -> TupleSort\n             -> [TcType]    -- ^ argument types\n             -> [TcKind]    -- ^ of these kinds\n             -> TcKind      -- ^ expected kind of the whole tuple\n             -> TcM TcType\nfinish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind\n  = do { traceTc \"finish_tuple\" (ppr res_kind $$ ppr tau_kinds $$ ppr exp_kind)\n       ; let arg_tys  = case tup_sort of\n                   -- See also Note [Unboxed tuple RuntimeRep vars] in TyCon\n                 UnboxedTuple    -> tau_reps ++ tau_tys\n                 BoxedTuple      -> tau_tys\n                 ConstraintTuple -> tau_tys\n       ; tycon <- case tup_sort of\n           ConstraintTuple\n             | arity > mAX_CTUPLE_SIZE\n                         -> failWith (bigConstraintTuple arity)\n             | otherwise -> tcLookupTyCon (cTupleTyConName arity)\n           BoxedTuple    -> do { let tc = tupleTyCon Boxed arity\n                               ; checkWiredInTyCon tc\n                               ; return tc }\n           UnboxedTuple  -> return (tupleTyCon Unboxed arity)\n       ; checkExpectedKind rn_ty (mkTyConApp tycon arg_tys) res_kind exp_kind }\n  where\n    arity = length tau_tys\n    tau_reps = map kindRep tau_kinds\n    res_kind = case tup_sort of\n                 UnboxedTuple    -> unboxedTupleKind tau_reps\n                 BoxedTuple      -> liftedTypeKind\n                 ConstraintTuple -> constraintKind\n\nbigConstraintTuple :: Arity -> MsgDoc\nbigConstraintTuple arity\n  = hang (text \"Constraint tuple arity too large:\" <+> int arity\n          <+> parens (text \"max arity =\" <+> int mAX_CTUPLE_SIZE))\n       2 (text \"Instead, use a nested tuple\")\n\n\n{- *********************************************************************\n*                                                                      *\n                Type applications\n*                                                                      *\n********************************************************************* -}\n\nsplitHsAppTys :: HsType GhcRn -> Maybe (LHsType GhcRn, [LHsTypeArg GhcRn])\nsplitHsAppTys hs_ty\n  | is_app hs_ty = Just (go (noLoc hs_ty) [])\n  | otherwise    = Nothing\n  where\n    is_app :: HsType GhcRn -> Bool\n    is_app (HsAppKindTy {})        = True\n    is_app (HsAppTy {})            = True\n    is_app (HsOpTy _ _ (L _ op) _) = not (op `hasKey` funTyConKey)\n      -- I'm not sure why this funTyConKey test is necessary\n      -- Can it even happen?  Perhaps for   t1 `(->)` t2\n      -- but then maybe it's ok to treat that like a normal\n      -- application rather than using the special rule for HsFunTy\n    is_app (HsTyVar {})            = True\n    is_app (HsParTy _ (L _ ty))    = is_app ty\n    is_app _                       = False\n\n    go (L _  (HsAppTy _ f a))      as = go f (HsValArg a : as)\n    go (L _  (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as)\n    go (L sp (HsParTy _ f))        as = go f (HsArgPar sp : as)\n    go (L _  (HsOpTy _ l op@(L sp _) r)) as\n      = ( L sp (HsTyVar noExt NotPromoted op)\n        , HsValArg l : HsValArg r : as )\n    go f as = (f, as)\n\n---------------------------\ntcInferAppHead :: TcTyMode -> LHsType GhcRn -> TcM (TcType, TcKind)\n-- Version of tc_infer_lhs_type specialised for the head of an\n-- application. In particular, for a HsTyVar (which includes type\n-- constructors, it does not zoom off into tcInferApps and family\n-- saturation\ntcInferAppHead mode (L _ (HsTyVar _ _ (L _ tv)))\n  = tcTyVar mode tv\ntcInferAppHead mode ty\n  = tc_infer_lhs_type mode ty\n\n---------------------------\n-- | Apply a type of a given kind to a list of arguments. This instantiates\n-- invisible parameters as necessary. Always consumes all the arguments,\n-- using matchExpectedFunKind as necessary.\n-- This takes an optional @VarEnv Kind@ which maps kind variables to kinds.-\n-- These kinds should be used to instantiate invisible kind variables;\n-- they come from an enclosing class for an associated type/data family.\n--\n-- tcInferApps also arranges to saturate any trailing invisible arguments\n--   of a type-family application, which is usually the right thing to do\n-- tcInferApps_nosat does not do this saturation; it is used only\n--   by \":kind\" in GHCi\ntcInferApps, tcInferApps_nosat\n    :: TcTyMode\n    -> LHsType GhcRn        -- ^ Function (for printing only)\n    -> TcType               -- ^ Function\n    -> [LHsTypeArg GhcRn]   -- ^ Args\n    -> TcM (TcType, TcKind) -- ^ (f args, args, result kind)\ntcInferApps mode hs_ty fun hs_args\n  = do { (f_args, res_k) <- tcInferApps_nosat mode hs_ty fun hs_args\n       ; saturateFamApp f_args res_k }\n\ntcInferApps_nosat mode orig_hs_ty fun orig_hs_args\n  = do { traceTc \"tcInferApps {\" (ppr orig_hs_ty $$ ppr orig_hs_args)\n       ; (f_args, res_k) <- go_init 1 fun orig_hs_args\n       ; traceTc \"tcInferApps }\" (ppr f_args <+> dcolon <+> ppr res_k)\n       ; return (f_args, res_k) }\n  where\n\n    -- go_init just initialises the auxiliary\n    -- arguments of the 'go' loop\n    go_init n fun all_args\n      = go n fun empty_subst fun_ki all_args\n      where\n        fun_ki = tcTypeKind fun\n           -- We do (tcTypeKind fun) here, even though the caller\n           -- knows the function kind, to absolutely guarantee\n           -- INVARIANT for 'go'\n           -- Note that in a typical application (F t1 t2 t3),\n           -- the 'fun' is just a TyCon, so tcTypeKind is fast\n\n        empty_subst = mkEmptyTCvSubst $ mkInScopeSet $\n                      tyCoVarsOfType fun_ki\n\n    go :: Int             -- The # of the next argument\n       -> TcType          -- Function applied to some args\n       -> TCvSubst        -- Applies to function kind\n       -> TcKind          -- Function kind\n       -> [LHsTypeArg GhcRn]    -- Un-type-checked args\n       -> TcM (TcType, TcKind)  -- Result type and its kind\n    -- INVARIANT: in any call (go n fun subst fun_ki args)\n    --               tcTypeKind fun  =  subst(fun_ki)\n    -- So the 'subst' and 'fun_ki' arguments are simply\n    -- there to avoid repeatedly calling tcTypeKind.\n    --\n    -- Reason for INVARIANT: to support the Purely Kinded Type Invariant\n    -- it's important that if fun_ki has a forall, then so does\n    -- (tcTypeKind fun), because the next thing we are going to do\n    -- is apply 'fun' to an argument type.\n\n    -- Dispatch on all_args first, for performance reasons\n    go n fun subst fun_ki all_args = case (all_args, tcSplitPiTy_maybe fun_ki) of\n\n      ---------------- No user-written args left. We're done!\n      ([], _) -> return (fun, substTy subst fun_ki)\n\n      ---------------- HsArgPar: We don't care about parens here\n      (HsArgPar _ : args, _) -> go n fun subst fun_ki args\n\n      ---------------- HsTypeArg: a kind application (fun @ki)\n      (HsTypeArg _ hs_ki_arg : hs_args, Just (ki_binder, inner_ki)) ->\n        case ki_binder of\n\n        -- FunTy with PredTy on LHS, or ForAllTy with Inferred\n        Named (Bndr _ Inferred) -> instantiate ki_binder inner_ki\n        Anon InvisArg _         -> instantiate ki_binder inner_ki\n\n        Named (Bndr _ Specified) ->  -- Visible kind application\n          do { traceTc \"tcInferApps (vis kind app)\"\n                       (vcat [ ppr ki_binder, ppr hs_ki_arg\n                             , ppr (tyBinderType ki_binder)\n                             , ppr subst ])\n\n             ; let exp_kind = substTy subst $ tyBinderType ki_binder\n\n             ; ki_arg <- addErrCtxt (funAppCtxt orig_hs_ty hs_ki_arg n) $\n                         unsetWOptM Opt_WarnPartialTypeSignatures $\n                         setXOptM LangExt.PartialTypeSignatures $\n                             -- Urgh!  see Note [Wildcards in visible kind application]\n                             -- ToDo: must kill this ridiculous messing with DynFlags\n                         tc_lhs_type (kindLevel mode) hs_ki_arg exp_kind\n\n             ; traceTc \"tcInferApps (vis kind app)\" (ppr exp_kind)\n             ; (subst', fun') <- mkAppTyM subst fun ki_binder ki_arg\n             ; go (n+1) fun' subst' inner_ki hs_args }\n\n        -- Attempted visible kind application (fun @ki), but fun_ki is\n        --   forall k -> blah   or   k1 -> k2\n        -- So we need a normal application.  Error.\n        _ -> ty_app_err hs_ki_arg $ substTy subst fun_ki\n\n      -- No binder; try applying the substitution, or fail if that's not possible\n      (HsTypeArg _ ki_arg : _, Nothing) -> try_again_after_substing_or $\n                                           ty_app_err ki_arg substed_fun_ki\n\n      ---------------- HsValArg: a nomal argument (fun ty)\n      (HsValArg arg : args, Just (ki_binder, inner_ki))\n        -- next binder is invisible; need to instantiate it\n        | isInvisibleBinder ki_binder   -- FunTy with InvisArg on LHS;\n                                        -- or ForAllTy with Inferred or Specified\n         -> instantiate ki_binder inner_ki\n\n        -- \"normal\" case\n        | otherwise\n         -> do { traceTc \"tcInferApps (vis normal app)\"\n                          (vcat [ ppr ki_binder\n                                , ppr arg\n                                , ppr (tyBinderType ki_binder)\n                                , ppr subst ])\n                ; let exp_kind = substTy subst $ tyBinderType ki_binder\n                ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $\n                          tc_lhs_type mode arg exp_kind\n                ; traceTc \"tcInferApps (vis normal app) 2\" (ppr exp_kind)\n                ; (subst', fun') <- mkAppTyM subst fun ki_binder arg'\n                ; go (n+1) fun' subst' inner_ki args }\n\n          -- no binder; try applying the substitution, or infer another arrow in fun kind\n      (HsValArg _ : _, Nothing)\n        -> try_again_after_substing_or $\n           do { let arrows_needed = n_initial_val_args all_args\n              ; co <- matchExpectedFunKind hs_ty arrows_needed substed_fun_ki\n\n              ; fun' <- zonkTcType (fun `mkTcCastTy` co)\n                     -- This zonk is essential, to expose the fruits\n                     -- of matchExpectedFunKind to the 'go' loop\n\n              ; traceTc \"tcInferApps (no binder)\" $\n                   vcat [ ppr fun <+> dcolon <+> ppr fun_ki\n                        , ppr arrows_needed\n                        , ppr co\n                        , ppr fun' <+> dcolon <+> ppr (tcTypeKind fun')]\n              ; go_init n fun' all_args }\n                -- Use go_init to establish go's INVARIANT\n      where\n        instantiate ki_binder inner_ki\n          = do { traceTc \"tcInferApps (need to instantiate)\"\n                         (vcat [ ppr ki_binder, ppr subst])\n               ; (subst', arg') <- tcInstInvisibleTyBinder subst ki_binder\n               ; go n (mkAppTy fun arg') subst' inner_ki all_args }\n                 -- Because tcInvisibleTyBinder instantiate ki_binder,\n                 -- the kind of arg' will have the same shape as the kind\n                 -- of ki_binder.  So we don't need mkAppTyM here.\n\n        try_again_after_substing_or fallthrough\n          | not (isEmptyTCvSubst subst)\n          = go n fun zapped_subst substed_fun_ki all_args\n          | otherwise\n          = fallthrough\n\n        zapped_subst   = zapTCvSubst subst\n        substed_fun_ki = substTy subst fun_ki\n        hs_ty          = appTypeToArg orig_hs_ty (take (n-1) orig_hs_args)\n\n    n_initial_val_args :: [HsArg tm ty] -> Arity\n    -- Count how many leading HsValArgs we have\n    n_initial_val_args (HsValArg {} : args) = 1 + n_initial_val_args args\n    n_initial_val_args (HsArgPar {} : args) = n_initial_val_args args\n    n_initial_val_args _                    = 0\n\n    ty_app_err arg ty\n      = failWith $ text \"Cannot apply function of kind\" <+> quotes (ppr ty)\n                $$ text \"to visible kind argument\" <+> quotes (ppr arg)\n\n\nmkAppTyM :: TCvSubst\n         -> TcType -> TyCoBinder    -- fun, plus its top-level binder\n         -> TcType                  -- arg\n         -> TcM (TCvSubst, TcType)  -- Extended subst, plus (fun arg)\n-- Precondition: the application (fun arg) is well-kinded after zonking\n--               That is, the application makes sense\n--\n-- Precondition: for (mkAppTyM subst fun bndr arg)\n--       tcTypeKind fun  =  Pi bndr. body\n--  That is, fun always has a ForAllTy or FunTy at the top\n--           and 'bndr' is fun's pi-binder\n--\n-- Postcondition: if fun and arg satisfy (PKTI), the purely-kinded type\n--                invariant, then so does the result type (fun arg)\n--\n-- We do not require that\n--    tcTypeKind arg = tyVarKind (binderVar bndr)\n-- This must be true after zonking (precondition 1), but it's not\n-- required for the (PKTI).\nmkAppTyM subst fun ki_binder arg\n  | -- See Note [mkAppTyM]: Nasty case 2\n    TyConApp tc args <- fun\n  , isTypeSynonymTyCon tc\n  , args `lengthIs` (tyConArity tc - 1)\n  , any isTrickyTvBinder (tyConTyVars tc) -- We could cache this in the synonym\n  = do { arg'  <- zonkTcType  arg\n       ; args' <- zonkTcTypes args\n       ; let subst' = case ki_binder of\n                        Anon {}           -> subst\n                        Named (Bndr tv _) -> extendTvSubstAndInScope subst tv arg'\n       ; return (subst', mkTyConApp tc (args' ++ [arg'])) }\n\n\nmkAppTyM subst fun (Anon {}) arg\n   = return (subst, mk_app_ty fun arg)\n\nmkAppTyM subst fun (Named (Bndr tv _)) arg\n  = do { arg' <- if isTrickyTvBinder tv\n                 then -- See Note [mkAppTyM]: Nasty case 1\n                      zonkTcType arg\n                 else return     arg\n       ; return ( extendTvSubstAndInScope subst tv arg'\n                , mk_app_ty fun arg' ) }\n\nmk_app_ty :: TcType -> TcType -> TcType\n-- This function just adds an ASSERT for mkAppTyM's precondition\nmk_app_ty fun arg\n  = ASSERT2( isPiTy fun_kind\n           ,  ppr fun <+> dcolon <+> ppr fun_kind $$ ppr arg )\n    mkAppTy fun arg\n  where\n    fun_kind = tcTypeKind fun\n\nisTrickyTvBinder :: TcTyVar -> Bool\n-- NB: isTrickyTvBinder is just an optimisation\n-- It would be absolutely sound to return True always\nisTrickyTvBinder tv = isPiTy (tyVarKind tv)\n\n{- Note [The Purely Kinded Type Invariant (PKTI)]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDuring type inference, we maintain this invariant\n\n (PKTI) It is legal to call 'tcTypeKind' on any Type ty,\n        on any sub-term of ty, /without/ zonking ty\n\n        Moreover, any such returned kind\n        will itself satisfy (PKTI)\n\nBy \"legal to call tcTypeKind\" we mean \"tcTypeKind will not crash\".\nThe way in which tcTypeKind can crash is in applications\n    (a t1 t2 .. tn)\nif 'a' is a type variable whose kind doesn't have enough arrows\nor foralls.  (The crash is in piResultTys.)\n\nThe loop in tcInferApps has to be very careful to maintain the (PKTI).\nFor example, suppose\n    kappa is a unification variable\n    We have already unified kappa := Type\n      yielding    co :: Refl (Type -> Type)\n    a :: kappa\nthen consider the type\n    (a Int)\nIf we call tcTypeKind on that, we'll crash, because the (un-zonked)\nkind of 'a' is just kappa, not an arrow kind.  So we must zonk first.\n\nSo the type inference engine is very careful when building applications.\nThis happens in tcInferApps. Suppose we are kind-checking the type (a Int),\nwhere (a :: kappa).  Then in tcInferApps we'll run out of binders on\na's kind, so we'll call matchExpectedFunKind, and unify\n   kappa := kappa1 -> kappa2,  with evidence co :: kappa ~ (kappa1 ~ kappa2)\nAt this point we must zonk the function type to expose the arrrow, so\nthat (a Int) will satisfy (PKTI).\n\nThe absence of this caused Trac #14174 and #14520.\n\nThe calls to mkAppTyM is the other place we are very careful.\n\nNote [mkAppTyM]\n~~~~~~~~~~~~~~~\nmkAppTyM is trying to guaranteed the Purely Kinded Type Invariant\n(PKTI) for its result type (fun arg).  There are two ways it can go wrong:\n\n* Nasty case 1: forall types (polykinds/T14174a)\n    T :: forall (p :: *->*). p Int -> p Bool\n  Now kind-check (T x), where x::kappa.\n  Well, T and x both satisfy the PKTI, but\n     T x :: x Int -> x Bool\n  and (x Int) does /not/ satisfy the PKTI.\n\n* Nasty case 2: type synonyms\n    type S f a = f a\n  Even though (S ff aa) would satisfy the (PKTI) if S was a data type\n  (i.e. nasty case 1 is dealt with), it might still not satisfy (PKTI)\n  if S is a type synonym, because the /expansion/ of (S ff aa) is\n  (ff aa), and /that/ does not satisfy (PKTI).  E.g. perhaps\n  (ff :: kappa), where 'kappa' has already been unified with (*->*).\n\n  We check for nasty case 2 on the final argument of a type synonym.\n\nNotice that in both cases the trickiness only happens if the\nbound variable has a pi-type.  Hence isTrickyTvBinder.\n-}\n\n\nsaturateFamApp :: TcType -> TcKind -> TcM (TcType, TcKind)\n-- Precondition for (saturateFamApp ty kind):\n--     tcTypeKind ty = kind\n--\n-- If 'ty' is an unsaturated family application wtih trailing\n-- invisible arguments, instanttiate them.\n-- See Note [saturateFamApp]\n\nsaturateFamApp ty kind\n  | Just (tc, args) <- tcSplitTyConApp_maybe ty\n  , mustBeSaturated tc\n  , let n_to_inst = tyConArity tc - length args\n  = do { (extra_args, ki') <- tcInstInvisibleTyBinders n_to_inst kind\n       ; return (ty `mkTcAppTys` extra_args, ki') }\n  | otherwise\n  = return (ty, kind)\n\n{- Note [saturateFamApp]\n~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   type family F :: Either j k\n   type instance F @Type = Right Maybe\n   type instance F @Type = Right Either```\n\nThen F :: forall {j,k}. Either j k\n\nThe two type instances do a visible kind application that instantiates\n'j' but not 'k'.  But we want to end up with instances that look like\n  type instance F @Type @(*->*) = Right @Type @(*->*) Maybe\n\nso that F has arity 2.  We must instantiate that trailing invisible\nbinder. In general, Invisible binders precede Specified and Required,\nso this is only going to bite for apparently-nullary families.\n\nNote that\n  type family F2 :: forall k. k -> *\nis quite different and really does have arity 0.\n\nIt's not just type instances where we need to saturate those\nunsaturated arguments: see #11246.  Hence doing this in tcInferApps.\n-}\n\nappTypeToArg :: LHsType GhcRn -> [LHsTypeArg GhcRn] -> LHsType GhcRn\nappTypeToArg f []                       = f\nappTypeToArg f (HsValArg arg    : args) = appTypeToArg (mkHsAppTy f arg) args\nappTypeToArg f (HsArgPar _      : args) = appTypeToArg f                 args\nappTypeToArg f (HsTypeArg l arg : args)\n  = appTypeToArg (mkHsAppKindTy l f arg) args\n\n\n{- *********************************************************************\n*                                                                      *\n                checkExpectedKind\n*                                                                      *\n********************************************************************* -}\n\n-- | This instantiates invisible arguments for the type being checked if it must\n-- be saturated and is not yet saturated. It then calls and uses the result\n-- from checkExpectedKindX to build the final type\ncheckExpectedKind :: HasDebugCallStack\n                  => HsType GhcRn       -- ^ type we're checking (for printing)\n                  -> TcType             -- ^ type we're checking\n                  -> TcKind             -- ^ the known kind of that type\n                  -> TcKind             -- ^ the expected kind\n                  -> TcM TcType\n-- Just a convenience wrapper to save calls to 'ppr'\ncheckExpectedKind hs_ty ty act exp\n  = checkExpectedKind_pp (ppr hs_ty) ty act exp\n\ncheckExpectedKind_pp :: HasDebugCallStack\n                     => SDoc               -- ^ The thing we are checking\n                     -> TcType             -- ^ type we're checking\n                     -> TcKind             -- ^ the known kind of that type\n                     -> TcKind             -- ^ the expected kind\n                     -> TcM TcType\ncheckExpectedKind_pp pp_hs_ty ty act_kind exp_kind\n  = do { traceTc \"checkExpectedKind\" (ppr ty $$ ppr act_kind)\n\n       ; (new_args, act_kind') <- tcInstInvisibleTyBinders n_to_inst act_kind\n\n       ; let origin = TypeEqOrigin { uo_actual   = act_kind'\n                                   , uo_expected = exp_kind\n                                   , uo_thing    = Just pp_hs_ty\n                                   , uo_visible  = True } -- the hs_ty is visible\n\n       ; traceTc \"checkExpectedKindX\" $\n         vcat [ pp_hs_ty\n              , text \"act_kind':\" <+> ppr act_kind'\n              , text \"exp_kind:\" <+> ppr exp_kind ]\n\n       ; let res_ty = ty `mkTcAppTys` new_args\n\n       ; if act_kind' `tcEqType` exp_kind\n         then return res_ty  -- This is very common\n         else do { co_k <- uType KindLevel origin act_kind' exp_kind\n                 ; traceTc \"checkExpectedKind\" (vcat [ ppr act_kind\n                                                     , ppr exp_kind\n                                                     , ppr co_k ])\n                ; return (res_ty `mkTcCastTy` co_k) } }\n    where\n      -- We need to make sure that both kinds have the same number of implicit\n      -- foralls out front. If the actual kind has more, instantiate accordingly.\n      -- Otherwise, just pass the type & kind through: the errors are caught\n      -- in unifyType.\n      n_exp_invis_bndrs = invisibleTyBndrCount exp_kind\n      n_act_invis_bndrs = invisibleTyBndrCount act_kind\n      n_to_inst         = n_act_invis_bndrs - n_exp_invis_bndrs\n\n\n---------------------------\ntcHsMbContext :: Maybe (LHsContext GhcRn) -> TcM [PredType]\ntcHsMbContext Nothing    = return []\ntcHsMbContext (Just cxt) = tcHsContext cxt\n\ntcHsContext :: LHsContext GhcRn -> TcM [PredType]\ntcHsContext = tc_hs_context typeLevelMode\n\ntcLHsPredType :: LHsType GhcRn -> TcM PredType\ntcLHsPredType = tc_lhs_pred typeLevelMode\n\ntc_hs_context :: TcTyMode -> LHsContext GhcRn -> TcM [PredType]\ntc_hs_context mode ctxt = mapM (tc_lhs_pred mode) (unLoc ctxt)\n\ntc_lhs_pred :: TcTyMode -> LHsType GhcRn -> TcM PredType\ntc_lhs_pred mode pred = tc_lhs_type mode pred constraintKind\n\n---------------------------\ntcTyVar :: TcTyMode -> Name -> TcM (TcType, TcKind)\n-- See Note [Type checking recursive type and class declarations]\n-- in TcTyClsDecls\ntcTyVar mode name         -- Could be a tyvar, a tycon, or a datacon\n  = do { traceTc \"lk1\" (ppr name)\n       ; thing <- tcLookup name\n       ; case thing of\n           ATyVar _ tv -> return (mkTyVarTy tv, tyVarKind tv)\n\n           ATcTyCon tc_tc\n             -> do { -- See Note [GADT kind self-reference]\n                     unless (isTypeLevel (mode_level mode))\n                            (promotionErr name TyConPE)\n                   ; check_tc tc_tc\n                   ; return (mkTyConTy tc_tc, tyConKind tc_tc) }\n\n           AGlobal (ATyCon tc)\n             -> do { check_tc tc\n                   ; return (mkTyConTy tc, tyConKind tc) }\n\n           AGlobal (AConLike (RealDataCon dc))\n             -> do { data_kinds <- xoptM LangExt.DataKinds\n                   ; unless (data_kinds || specialPromotedDc dc) $\n                       promotionErr name NoDataKindsDC\n                   ; when (isFamInstTyCon (dataConTyCon dc)) $\n                       -- see Trac #15245\n                       promotionErr name FamDataConPE\n                   ; let (_, _, _, theta, _, _) = dataConFullSig dc\n                   ; traceTc \"tcTyVar\" (ppr dc <+> ppr theta $$ ppr (dc_theta_illegal_constraint theta))\n                   ; case dc_theta_illegal_constraint theta of\n                       Just pred -> promotionErr name $\n                                    ConstrainedDataConPE pred\n                       Nothing   -> pure ()\n                   ; let tc = promoteDataCon dc\n                   ; return (mkTyConApp tc [], tyConKind tc) }\n\n           APromotionErr err -> promotionErr name err\n\n           _  -> wrongThingErr \"type\" thing name }\n  where\n    check_tc :: TyCon -> TcM ()\n    check_tc tc = do { data_kinds   <- xoptM LangExt.DataKinds\n                     ; unless (isTypeLevel (mode_level mode) ||\n                               data_kinds ||\n                               isKindTyCon tc) $\n                       promotionErr name NoDataKindsTC }\n\n    -- We cannot promote a data constructor with a context that contains\n    -- constraints other than equalities, so error if we find one.\n    -- See Note [Constraints in kinds] in TyCoRep\n    dc_theta_illegal_constraint :: ThetaType -> Maybe PredType\n    dc_theta_illegal_constraint = find (not . isEqPred)\n\n{-\nNote [GADT kind self-reference]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA promoted type cannot be used in the body of that type's declaration.\nTrac #11554 shows this example, which made GHC loop:\n\n  import Data.Kind\n  data P (x :: k) = Q\n  data A :: Type where\n    B :: forall (a :: A). P a -> A\n\nIn order to check the constructor B, we need to have the promoted type A, but in\norder to get that promoted type, B must first be checked. To prevent looping, a\nTyConPE promotion error is given when tcTyVar checks an ATcTyCon in kind mode.\nAny ATcTyCon is a TyCon being defined in the current recursive group (see data\ntype decl for TcTyThing), and all such TyCons are illegal in kinds.\n\nTrac #11962 proposes checking the head of a data declaration separately from\nits constructors. This would allow the example above to pass.\n\nNote [Body kind of a HsForAllTy]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe body of a forall is usually a type, but in principle\nthere's no reason to prohibit *unlifted* types.\nIn fact, GHC can itself construct a function with an\nunboxed tuple inside a for-all (via CPR analysis; see\ntypecheck/should_compile/tc170).\n\nMoreover in instance heads we get forall-types with\nkind Constraint.\n\nIt's tempting to check that the body kind is either * or #. But this is\nwrong. For example:\n\n  class C a b\n  newtype N = Mk Foo deriving (C a)\n\nWe're doing newtype-deriving for C. But notice how `a` isn't in scope in\nthe predicate `C a`. So we quantify, yielding `forall a. C a` even though\n`C a` has kind `* -> Constraint`. The `forall a. C a` is a bit cheeky, but\nconvenient. Bottom line: don't check for * or # here.\n\nNote [Body kind of a HsQualTy]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf ctxt is non-empty, the HsQualTy really is a /function/, so the\nkind of the result really is '*', and in that case the kind of the\nbody-type can be lifted or unlifted.\n\nHowever, consider\n    instance Eq a => Eq [a] where ...\nor\n    f :: (Eq a => Eq [a]) => blah\nHere both body-kind of the HsQualTy is Constraint rather than *.\nRather crudely we tell the difference by looking at exp_kind. It's\nvery convenient to typecheck instance types like any other HsSigType.\n\nAdmittedly the '(Eq a => Eq [a]) => blah' case is erroneous, but it's\nbetter to reject in checkValidType.  If we say that the body kind\nshould be '*' we risk getting TWO error messages, one saying that Eq\n[a] doens't have kind '*', and one saying that we need a Constraint to\nthe left of the outer (=>).\n\nHow do we figure out the right body kind?  Well, it's a bit of a\nkludge: I just look at the expected kind.  If it's Constraint, we\nmust be in this instance situation context. It's a kludge because it\nwouldn't work if any unification was involved to compute that result\nkind -- but it isn't.  (The true way might be to use the 'mode'\nparameter, but that seemed like a sledgehammer to crack a nut.)\n\nNote [Inferring tuple kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGive a tuple type (a,b,c), which the parser labels as HsBoxedOrConstraintTuple,\nwe try to figure out whether it's a tuple of kind * or Constraint.\n  Step 1: look at the expected kind\n  Step 2: infer argument kinds\n\nIf after Step 2 it's not clear from the arguments that it's\nConstraint, then it must be *.  Once having decided that we re-check\nthe arguments to give good error messages in\n  e.g.  (Maybe, Maybe)\n\nNote that we will still fail to infer the correct kind in this case:\n\n  type T a = ((a,a), D a)\n  type family D :: Constraint -> Constraint\n\nWhile kind checking T, we do not yet know the kind of D, so we will default the\nkind of T to * -> *. It works if we annotate `a` with kind `Constraint`.\n\nNote [Desugaring types]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe type desugarer is phase 2 of dealing with HsTypes.  Specifically:\n\n  * It transforms from HsType to Type\n\n  * It zonks any kinds.  The returned type should have no mutable kind\n    or type variables (hence returning Type not TcType):\n      - any unconstrained kind variables are defaulted to (Any *) just\n        as in TcHsSyn.\n      - there are no mutable type variables because we are\n        kind-checking a type\n    Reason: the returned type may be put in a TyCon or DataCon where\n    it will never subsequently be zonked.\n\nYou might worry about nested scopes:\n        ..a:kappa in scope..\n            let f :: forall b. T '[a,b] -> Int\nIn this case, f's type could have a mutable kind variable kappa in it;\nand we might then default it to (Any *) when dealing with f's type\nsignature.  But we don't expect this to happen because we can't get a\nlexically scoped type variable with a mutable kind variable in it.  A\ndelicate point, this.  If it becomes an issue we might need to\ndistinguish top-level from nested uses.\n\nMoreover\n  * it cannot fail,\n  * it does no unifications\n  * it does no validity checking, except for structural matters, such as\n        (a) spurious ! annotations.\n        (b) a class used as a type\n\nNote [Kind of a type splice]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider these terms, each with TH type splice inside:\n     [| e1 :: Maybe $(..blah..) |]\n     [| e2 :: $(..blah..) |]\nWhen kind-checking the type signature, we'll kind-check the splice\n$(..blah..); we want to give it a kind that can fit in any context,\nas if $(..blah..) :: forall k. k.\n\nIn the e1 example, the context of the splice fixes kappa to *.  But\nin the e2 example, we'll desugar the type, zonking the kind unification\nvariables as we go.  When we encounter the unconstrained kappa, we\nwant to default it to '*', not to (Any *).\n\nHelp functions for type applications\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-}\n\naddTypeCtxt :: LHsType GhcRn -> TcM a -> TcM a\n        -- Wrap a context around only if we want to show that contexts.\n        -- Omit invisible ones and ones user's won't grok\naddTypeCtxt (L _ (HsWildCardTy _)) thing = thing   -- \"In the type '_'\" just isn't helpful.\naddTypeCtxt (L _ ty) thing\n  = addErrCtxt doc thing\n  where\n    doc = text \"In the type\" <+> quotes (ppr ty)\n\n{-\n************************************************************************\n*                                                                      *\n                Type-variable binders\n%*                                                                      *\n%************************************************************************\n\nNote [Dependent LHsQTyVars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe track (in the renamer) which explicitly bound variables in a\nLHsQTyVars are manifestly dependent; only precisely these variables\nmay be used within the LHsQTyVars. We must do this so that kcLHsQTyVars\ncan produce the right TyConBinders, and tell Anon vs. Required.\n\nExample   data T k1 (a:k1) (b:k2) c\n               = MkT (Proxy a) (Proxy b) (Proxy c)\n\nHere\n  (a:k1),(b:k2),(c:k3)\n       are Anon     (explicitly specified as a binder, not used\n                     in the kind of any other binder\n  k1   is Required  (explicitly specifed as a binder, but used\n                     in the kind of another binder i.e. dependently)\n  k2   is Specified (not explicitly bound, but used in the kind\n                     of another binder)\n  k3   in Inferred  (not lexically in scope at all, but inferred\n                     by kind inference)\nand\n  T :: forall {k3} k1. forall k3 -> k1 -> k2 -> k3 -> *\n\nSee Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]\nin TyCoRep.\n\nkcLHsQTyVars uses the hsq_dependent field to decide whether\nk1, a, b, c should be Required or Anon.\n\nEarlier, thought it would work simply to do a free-variable check\nduring kcLHsQTyVars, but this is bogus, because there may be\nunsolved equalities about. And we don't want to eagerly solve the\nequalities, because we may get further information after\nkcLHsQTyVars is called.  (Recall that kcLHsQTyVars is called\nonly from getInitialKind.)\nThis is what implements the rule that all variables intended to be\ndependent must be manifestly so.\n\nSidenote: It's quite possible that later, we'll consider (t -> s)\nas a degenerate case of some (pi (x :: t) -> s) and then this will\nall get more permissive.\n\nNote [Keeping scoped variables in order: Explicit]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the user writes `forall a b c. blah`, we bring a, b, and c into\nscope and then check blah. In the process of checking blah, we might\nlearn the kinds of a, b, and c, and these kinds might indicate that\nb depends on c, and thus that we should reject the user-written type.\n\nOne approach to doing this would be to bring each of a, b, and c into\nscope, one at a time, creating an implication constraint and\nbumping the TcLevel for each one. This would work, because the kind\nof, say, b would be untouchable when c is in scope (and the constraint\ncouldn't float out because c blocks it). However, it leads to terrible\nerror messages, complaining about skolem escape. While it is indeed\na problem of skolem escape, we can do better.\n\nInstead, our approach is to bring the block of variables into scope\nall at once, creating one implication constraint for the lot. The\nuser-written variables are skolems in the implication constraint. In\nTcSimplify.setImplicationStatus, we check to make sure that the ordering\nis correct, choosing ImplicationStatus IC_BadTelescope if they aren't.\nThen, in TcErrors, we report if there is a bad telescope. This way,\nwe can report a suggested ordering to the user if there is a problem.\n\nNote [Keeping scoped variables in order: Implicit]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the user implicitly quantifies over variables (say, in a type\nsignature), we need to come up with some ordering on these variables.\nThis is done by bumping the TcLevel, bringing the tyvars into scope,\nand then type-checking the thing_inside. The constraints are all\nwrapped in an implication, which is then solved. Finally, we can\nzonk all the binders and then order them with scopedSort.\n\nIt's critical to solve before zonking and ordering in order to uncover\nany unifications. You might worry that this eager solving could cause\ntrouble elsewhere. I don't think it will. Because it will solve only\nin an increased TcLevel, it can't unify anything that was mentioned\nelsewhere. Additionally, we require that the order of implicitly\nquantified variables is manifest by the scope of these variables, so\nwe're not going to learn more information later that will help order\nthese variables.\n\nNote [Recipe for checking a signature]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nChecking a user-written signature requires several steps:\n\n 1. Generate constraints.\n 2. Solve constraints.\n 3. Zonk.\n 4. Promote tyvars and/or kind-generalize.\n 5. Zonk.\n 6. Check validity.\n\nThere may be some surprises in here:\n\nStep 2 is necessary for two reasons: most signatures also bring\nimplicitly quantified variables into scope, and solving is necessary\nto get these in the right order (see Note [Keeping scoped variables in\norder: Implicit]). Additionally, solving is necessary in order to\nkind-generalize correctly.\n\nIn Step 4, we have to deal with the fact that metatyvars generated\nin the type may have a bumped TcLevel, because explicit foralls\nraise the TcLevel. To avoid these variables from ever being visible\nin the surrounding context, we must obey the following dictum:\n\n  Every metavariable in a type must either be\n    (A) promoted\n    (B) generalized, or\n    (C) zapped to Any\n\nIf a variable is generalized, then it becomes a skolem and no longer\nhas a proper TcLevel. (I'm ignoring the TcLevel on a skolem here, as\nit's not really in play here.) On the other hand, if it is not\ngeneralized (because we're not generalizing the construct -- e.g., pattern\nsig -- or because the metavars are constrained -- see kindGeneralizeLocal)\nwe need to promote to maintain (MetaTvInv) of Note [TcLevel and untouchable type variables]\nin TcType.\n\nFor more about (C), see Note [Naughty quantification candidates] in TcMType.\n\nAfter promoting/generalizing, we need to zonk *again* because both\npromoting and generalizing fill in metavariables.\n\nTo avoid the double-zonk, we do two things:\n 1. When we're not generalizing:\n    zonkPromoteType and friends zonk and promote at the same time.\n    Accordingly, the function does steps 3-5 all at once, preventing\n    the need for multiple traversals.\n\n 2. When we are generalizing:\n    kindGeneralize does not require a zonked type -- it zonks as it\n    gathers free variables. So this way effectively sidesteps step 3.\n-}\n\ntcWildCardBinders :: [Name]\n                  -> ([(Name, TcTyVar)] -> TcM a)\n                  -> TcM a\ntcWildCardBinders wc_names thing_inside\n  = do { wcs <- mapM (const newWildTyVar) wc_names\n       ; let wc_prs = wc_names `zip` wcs\n       ; tcExtendNameTyVarEnv wc_prs $\n         thing_inside wc_prs }\n\nnewWildTyVar :: TcM TcTyVar\n-- ^ New unification variable for a wildcard\nnewWildTyVar\n  = do { kind <- newMetaKindVar\n       ; uniq <- newUnique\n       ; details <- newMetaDetails TauTv\n       ; let name = mkSysTvName uniq (fsLit \"_\")\n             tyvar = (mkTcTyVar name kind details)\n       ; traceTc \"newWildTyVar\" (ppr tyvar)\n       ; return tyvar }\n\n{- *********************************************************************\n*                                                                      *\n             Kind inference for type declarations\n*                                                                      *\n********************************************************************* -}\n\n{- Note [The initial kind of a type constructor]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nkcLHsQTyVars is responsible for getting the initial kind of\na type constructor.\n\nIt has two cases:\n\n * The TyCon has a CUSK.  In that case, find the full, final,\n   poly-kinded kind of the TyCon.  It's very like a term-level\n   binding where we have a complete type signature for the\n   function.\n\n * It does not have a CUSK.  Find a monomorphic kind, with\n   unification variables in it; they will be generalised later.\n   It's very like a term-level binding where we do not have\n   a type signature (or, more accurately, where we have a\n   partial type signature), so we infer the type and generalise.\n-}\n\n\n------------------------------\n-- | Kind-check a 'LHsQTyVars'. If the decl under consideration has a complete,\n-- user-supplied kind signature (CUSK), generalise the result.\n-- Used in 'getInitialKind' (for tycon kinds and other kinds)\n-- and in kind-checking (but not for tycon kinds, which are checked with\n-- tcTyClDecls). See Note [CUSKs: complete user-supplied kind signatures]\n-- in HsDecls.\n--\n-- This function does not do telescope checking.\nkcLHsQTyVars :: Name              -- ^ of the thing being checked\n             -> TyConFlavour      -- ^ What sort of 'TyCon' is being checked\n             -> Bool              -- ^ True <=> the decl being checked has a CUSK\n             -> LHsQTyVars GhcRn\n             -> TcM Kind          -- ^ The result kind\n             -> TcM TcTyCon       -- ^ A suitably-kinded TcTyCon\nkcLHsQTyVars name flav cusk tvs thing_inside\n  | cusk      = kcLHsQTyVars_Cusk    name flav tvs thing_inside\n  | otherwise = kcLHsQTyVars_NonCusk name flav tvs thing_inside\n\n\nkcLHsQTyVars_Cusk, kcLHsQTyVars_NonCusk\n    :: Name              -- ^ of the thing being checked\n    -> TyConFlavour      -- ^ What sort of 'TyCon' is being checked\n    -> LHsQTyVars GhcRn\n    -> TcM Kind          -- ^ The result kind\n    -> TcM TcTyCon       -- ^ A suitably-kinded TcTyCon\n\n------------------------------\nkcLHsQTyVars_Cusk name flav\n              (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kv_ns\n                                           , hsq_dependent = dep_names }\n                      , hsq_explicit = hs_tvs }) thing_inside\n  -- CUSK case\n  -- See note [Required, Specified, and Inferred for types] in TcTyClsDecls\n  = addTyConFlavCtxt name flav $\n    do { (scoped_kvs, (tc_tvs, res_kind))\n           <- pushTcLevelM_                               $\n              solveEqualities                             $\n              bindImplicitTKBndrs_Q_Skol kv_ns            $\n              bindExplicitTKBndrs_Q_Skol ctxt_kind hs_tvs $\n              thing_inside\n\n           -- Now, because we're in a CUSK,\n           -- we quantify over the mentioned kind vars\n       ; let spec_req_tkvs = scoped_kvs ++ tc_tvs\n             all_kinds     = res_kind : map tyVarKind spec_req_tkvs\n\n       ; candidates <- candidateQTyVarsOfKinds all_kinds\n             -- 'candidates' are all the variables that we are going to\n             -- skolemise and then quantify over.  We do not include spec_req_tvs\n             -- because they are /already/ skolems\n\n       ; let inf_candidates = candidates `delCandidates` spec_req_tkvs\n\n       ; inferred <- quantifyTyVars emptyVarSet inf_candidates\n                     -- NB: 'inferred' comes back sorted in dependency order\n\n       ; scoped_kvs <- mapM zonkTyCoVarKind scoped_kvs\n       ; tc_tvs     <- mapM zonkTyCoVarKind tc_tvs\n       ; res_kind   <- zonkTcType           res_kind\n\n       ; let mentioned_kv_set = candidateKindVars candidates\n             specified        = scopedSort scoped_kvs\n                                -- NB: maintain the L-R order of scoped_kvs\n\n             final_tc_binders =  mkNamedTyConBinders Inferred  inferred\n                              ++ mkNamedTyConBinders Specified specified\n                              ++ map (mkRequiredTyConBinder mentioned_kv_set) tc_tvs\n\n             all_tv_prs = mkTyVarNamePairs (scoped_kvs ++ tc_tvs)\n             tycon = mkTcTyCon name final_tc_binders res_kind all_tv_prs\n                               True {- it is generalised -} flav\n         -- If the ordering from\n         -- Note [Required, Specified, and Inferred for types] in TcTyClsDecls\n         -- doesn't work, we catch it here, before an error cascade\n       ; checkTyConTelescope tycon\n\n       ; traceTc \"kcLHsQTyVars: cusk\" $\n         vcat [ text \"name\" <+> ppr name\n              , text \"kv_ns\" <+> ppr kv_ns\n              , text \"hs_tvs\" <+> ppr hs_tvs\n              , text \"dep_names\" <+> ppr dep_names\n              , text \"scoped_kvs\" <+> ppr scoped_kvs\n              , text \"tc_tvs\" <+> ppr tc_tvs\n              , text \"res_kind\" <+> ppr res_kind\n              , text \"candidates\" <+> ppr candidates\n              , text \"inferred\" <+> ppr inferred\n              , text \"specified\" <+> ppr specified\n              , text \"final_tc_binders\" <+> ppr final_tc_binders\n              , text \"mkTyConKind final_tc_bndrs res_kind\"\n                <+> ppr (mkTyConKind final_tc_binders res_kind)\n              , text \"all_tv_prs\" <+> ppr all_tv_prs ]\n\n       ; return tycon }\n  where\n    ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind\n              | otherwise            = AnyKind\n\nkcLHsQTyVars_Cusk _ _ (XLHsQTyVars _) _ = panic \"kcLHsQTyVars\"\n\n------------------------------\nkcLHsQTyVars_NonCusk name flav\n              (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kv_ns\n                                           , hsq_dependent = dep_names }\n                      , hsq_explicit = hs_tvs }) thing_inside\n  -- Non_CUSK case\n  -- See note [Required, Specified, and Inferred for types] in TcTyClsDecls\n  = do { (scoped_kvs, (tc_tvs, res_kind))\n           -- Why bindImplicitTKBndrs_Q_Tv which uses newTyVarTyVar?\n           -- See Note [Inferring kinds for type declarations] in TcTyClsDecls\n           <- bindImplicitTKBndrs_Q_Tv kv_ns            $\n              bindExplicitTKBndrs_Q_Tv ctxt_kind hs_tvs $\n              thing_inside\n              -- Why \"_Tv\" not \"_Skol\"? See third wrinkle in\n              -- Note [Inferring kinds for type declarations] in TcTyClsDecls,\n\n       ; let   -- NB: Don't add scoped_kvs to tyConTyVars, because they\n               -- might unify with kind vars in other types in a mutually\n               -- recursive group.\n               -- See Note [Inferring kinds for type declarations] in TcTyClsDecls\n             tc_binders = zipWith mk_tc_binder hs_tvs tc_tvs\n               -- Also, note that tc_binders has the tyvars from only the\n               -- user-written tyvarbinders. See S1 in Note [How TcTyCons work]\n               -- in TcTyClsDecls\n\n             all_tv_prs = (kv_ns                `zip` scoped_kvs) ++\n                          (hsLTyVarNames hs_tvs `zip` tc_tvs)\n               -- NB: bindIplicitTKBndrs_Q_Tv makes /freshly-named/ unification\n               --     variables, hence the need to zip here.  Ditto bindExplicit..\n               -- See TcMType Note [Unification variables need fresh Names]\n             tycon = mkTcTyCon name tc_binders res_kind all_tv_prs\n                               False -- not yet generalised\n                               flav\n\n       ; traceTc \"kcLHsQTyVars: not-cusk\" $\n         vcat [ ppr name, ppr kv_ns, ppr hs_tvs, ppr dep_names\n              , ppr scoped_kvs\n              , ppr tc_tvs, ppr (mkTyConKind tc_binders res_kind) ]\n       ; return tycon }\n  where\n    ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind\n              | otherwise            = AnyKind\n\n    mk_tc_binder :: LHsTyVarBndr GhcRn -> TyVar -> TyConBinder\n    -- See Note [Dependent LHsQTyVars]\n    mk_tc_binder hs_tv tv\n       | hsLTyVarName hs_tv `elemNameSet` dep_names\n       = mkNamedTyConBinder Required tv\n       | otherwise\n       = mkAnonTyConBinder VisArg tv\n\nkcLHsQTyVars_NonCusk _ _ (XLHsQTyVars _) _ = panic \"kcLHsQTyVars\"\n\n\n{- Note [Kind-checking tyvar binders for associated types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen kind-checking the type-variable binders for associated\n   data/newtype decls\n   family decls\nwe behave specially for type variables that are already in scope;\nthat is, bound by the enclosing class decl.  This is done in\nkcLHsQTyVarBndrs:\n  * The use of tcImplicitQTKBndrs\n  * The tcLookupLocal_maybe code in kc_hs_tv\n\nSee Note [Associated type tyvar names] in Class and\n    Note [TyVar binders for associated decls] in HsDecls\n\nWe must do the same for family instance decls, where the in-scope\nvariables may be bound by the enclosing class instance decl.\nHence the use of tcImplicitQTKBndrs in tcFamTyPatsAndGen.\n\nNote [Kind variable ordering for associated types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat should be the kind of `T` in the following example? (#15591)\n\n  class C (a :: Type) where\n    type T (x :: f a)\n\nAs per Note [Ordering of implicit variables] in RnTypes, we want to quantify\nthe kind variables in left-to-right order of first occurrence in order to\nsupport visible kind application. But we cannot perform this analysis on just\nT alone, since its variable `a` actually occurs /before/ `f` if you consider\nthe fact that `a` was previously bound by the parent class `C`. That is to say,\nthe kind of `T` should end up being:\n\n  T :: forall a f. f a -> Type\n\n(It wouldn't necessarily be /wrong/ if the kind ended up being, say,\nforall f a. f a -> Type, but that would not be as predictable for users of\nvisible kind application.)\n\nIn contrast, if `T` were redefined to be a top-level type family, like `T2`\nbelow:\n\n  type family T2 (x :: f (a :: Type))\n\nThen `a` first appears /after/ `f`, so the kind of `T2` should be:\n\n  T2 :: forall f a. f a -> Type\n\nIn order to make this distinction, we need to know (in kcLHsQTyVars) which\ntype variables have been bound by the parent class (if there is one). With\nthe class-bound variables in hand, we can ensure that we always quantify\nthese first.\n-}\n\n\n{- *********************************************************************\n*                                                                      *\n             Expected kinds\n*                                                                      *\n********************************************************************* -}\n\n-- | Describes the kind expected in a certain context.\ndata ContextKind = TheKind Kind   -- ^ a specific kind\n                 | AnyKind        -- ^ any kind will do\n                 | OpenKind       -- ^ something of the form @TYPE _@\n\n-----------------------\nnewExpectedKind :: ContextKind -> TcM Kind\nnewExpectedKind (TheKind k) = return k\nnewExpectedKind AnyKind     = newMetaKindVar\nnewExpectedKind OpenKind    = newOpenTypeKind\n\n-----------------------\nexpectedKindInCtxt :: UserTypeCtxt -> ContextKind\n-- Depending on the context, we might accept any kind (for instance, in a TH\n-- splice), or only certain kinds (like in type signatures).\nexpectedKindInCtxt (TySynCtxt _)   = AnyKind\nexpectedKindInCtxt ThBrackCtxt     = AnyKind\nexpectedKindInCtxt (GhciCtxt {})   = AnyKind\n-- The types in a 'default' decl can have varying kinds\n-- See Note [Extended defaults]\" in TcEnv\nexpectedKindInCtxt DefaultDeclCtxt     = AnyKind\nexpectedKindInCtxt TypeAppCtxt         = AnyKind\nexpectedKindInCtxt (ForSigCtxt _)      = TheKind liftedTypeKind\nexpectedKindInCtxt (InstDeclCtxt {})   = TheKind constraintKind\nexpectedKindInCtxt SpecInstCtxt        = TheKind constraintKind\nexpectedKindInCtxt _                   = OpenKind\n\n\n{- *********************************************************************\n*                                                                      *\n             Bringing type variables into scope\n*                                                                      *\n********************************************************************* -}\n\n--------------------------------------\n-- Implicit binders\n--------------------------------------\n\nbindImplicitTKBndrs_Skol, bindImplicitTKBndrs_Tv,\n  bindImplicitTKBndrs_Q_Skol, bindImplicitTKBndrs_Q_Tv\n  :: [Name] -> TcM a -> TcM ([TcTyVar], a)\nbindImplicitTKBndrs_Skol   = bindImplicitTKBndrsX newFlexiKindedSkolemTyVar\nbindImplicitTKBndrs_Tv     = bindImplicitTKBndrsX newFlexiKindedTyVarTyVar\nbindImplicitTKBndrs_Q_Skol = bindImplicitTKBndrsX (newImplicitTyVarQ newFlexiKindedSkolemTyVar)\nbindImplicitTKBndrs_Q_Tv   = bindImplicitTKBndrsX (newImplicitTyVarQ newFlexiKindedTyVarTyVar)\n\nbindImplicitTKBndrsX\n   :: (Name -> TcM TcTyVar) -- new_tv function\n   -> [Name]\n   -> TcM a\n   -> TcM ([TcTyVar], a)   -- Returned [TcTyVar] are in 1-1 correspondence\n                           -- with the passed in [Name]\nbindImplicitTKBndrsX new_tv tv_names thing_inside\n  = do { tkvs <- mapM new_tv tv_names\n       ; traceTc \"bindImplicitTKBndrs\" (ppr tv_names $$ ppr tkvs)\n       ; res <- tcExtendNameTyVarEnv (tv_names `zip` tkvs)\n                thing_inside\n       ; return (tkvs, res) }\n\nnewImplicitTyVarQ :: (Name -> TcM TcTyVar) ->  Name -> TcM TcTyVar\n-- Behave like new_tv, except that if the tyvar is in scope, use it\nnewImplicitTyVarQ new_tv name\n  = do { mb_tv <- tcLookupLcl_maybe name\n       ; case mb_tv of\n           Just (ATyVar _ tv) -> return tv\n           _ -> new_tv name }\n\nnewFlexiKindedTyVar :: (Name -> Kind -> TcM TyVar) -> Name -> TcM TyVar\nnewFlexiKindedTyVar new_tv name\n  = do { kind <- newMetaKindVar\n       ; new_tv name kind }\n\nnewFlexiKindedSkolemTyVar :: Name -> TcM TyVar\nnewFlexiKindedSkolemTyVar = newFlexiKindedTyVar newSkolemTyVar\n\nnewFlexiKindedTyVarTyVar :: Name -> TcM TyVar\nnewFlexiKindedTyVarTyVar = newFlexiKindedTyVar newTyVarTyVar\n   -- See Note [Unification variables need fresh Names] in TcMType\n\n--------------------------------------\n-- Explicit binders\n--------------------------------------\n\nbindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Tv\n    :: [LHsTyVarBndr GhcRn]\n    -> TcM a\n    -> TcM ([TcTyVar], a)\n\nbindExplicitTKBndrs_Skol = bindExplicitTKBndrsX (tcHsTyVarBndr newSkolemTyVar)\nbindExplicitTKBndrs_Tv   = bindExplicitTKBndrsX (tcHsTyVarBndr newTyVarTyVar)\n\nbindExplicitTKBndrs_Q_Skol, bindExplicitTKBndrs_Q_Tv\n    :: ContextKind\n    -> [LHsTyVarBndr GhcRn]\n    -> TcM a\n    -> TcM ([TcTyVar], a)\n\nbindExplicitTKBndrs_Q_Skol ctxt_kind = bindExplicitTKBndrsX (tcHsQTyVarBndr ctxt_kind newSkolemTyVar)\nbindExplicitTKBndrs_Q_Tv   ctxt_kind = bindExplicitTKBndrsX (tcHsQTyVarBndr ctxt_kind newTyVarTyVar)\n\n-- | Used during the \"kind-checking\" pass in TcTyClsDecls only,\n-- and even then only for data-con declarations.\nbindExplicitTKBndrsX\n    :: (HsTyVarBndr GhcRn -> TcM TcTyVar)\n    -> [LHsTyVarBndr GhcRn]\n    -> TcM a\n    -> TcM ([TcTyVar], a)  -- Returned [TcTyVar] are in 1-1 correspondence\n                           -- with the passed-in [LHsTyVarBndr]\nbindExplicitTKBndrsX tc_tv hs_tvs thing_inside\n  = do { traceTc \"bindExplicTKBndrs\" (ppr hs_tvs)\n       ; go hs_tvs }\n  where\n    go [] = do { res <- thing_inside\n               ; return ([], res) }\n    go (L _ hs_tv : hs_tvs)\n       = do { tv <- tc_tv hs_tv\n            -- Extend the environment as we go, in case a binder\n            -- is mentioned in the kind of a later binder\n            --   e.g. forall k (a::k). blah\n            -- NB: tv's Name may differ from hs_tv's\n            -- See TcMType Note [Unification variables need fresh Names]\n            ; (tvs,res) <- tcExtendNameTyVarEnv [(hsTyVarName hs_tv, tv)] $\n                           go hs_tvs\n            ; return (tv:tvs, res) }\n\n-----------------\ntcHsTyVarBndr :: (Name -> Kind -> TcM TyVar)\n              -> HsTyVarBndr GhcRn -> TcM TcTyVar\n-- Returned TcTyVar has the same name; no cloning\ntcHsTyVarBndr new_tv (UserTyVar _ (L _ tv_nm))\n  = do { kind <- newMetaKindVar\n       ; new_tv tv_nm kind }\ntcHsTyVarBndr new_tv (KindedTyVar _ (L _ tv_nm) lhs_kind)\n  = do { kind <- tcLHsKindSig (TyVarBndrKindCtxt tv_nm) lhs_kind\n       ; new_tv tv_nm kind }\ntcHsTyVarBndr _ (XTyVarBndr _) = panic \"tcHsTyVarBndr\"\n\n-----------------\ntcHsQTyVarBndr :: ContextKind\n               -> (Name -> Kind -> TcM TyVar)\n               -> HsTyVarBndr GhcRn -> TcM TcTyVar\n-- Just like tcHsTyVarBndr, but also\n--   - uses the in-scope TyVar from class, if it exists\n--   - takes a ContextKind to use for the no-sig case\ntcHsQTyVarBndr ctxt_kind new_tv (UserTyVar _ (L _ tv_nm))\n  = do { mb_tv <- tcLookupLcl_maybe tv_nm\n       ; case mb_tv of\n           Just (ATyVar _ tv) -> return tv\n           _ -> do { kind <- newExpectedKind ctxt_kind\n                   ; new_tv tv_nm kind } }\n\ntcHsQTyVarBndr _ new_tv (KindedTyVar _ (L _ tv_nm) lhs_kind)\n  = do { kind <- tcLHsKindSig (TyVarBndrKindCtxt tv_nm) lhs_kind\n       ; mb_tv <- tcLookupLcl_maybe tv_nm\n       ; case mb_tv of\n           Just (ATyVar _ tv)\n             -> do { discardResult $ unifyKind (Just hs_tv)\n                                        kind (tyVarKind tv)\n                       -- This unify rejects:\n                       --    class C (m :: * -> *) where\n                       --      type F (m :: *) = ...\n                   ; return tv }\n\n           _ -> new_tv tv_nm kind }\n  where\n    hs_tv = HsTyVar noExt NotPromoted (noLoc tv_nm)\n            -- Used for error messages only\n\ntcHsQTyVarBndr _ _ (XTyVarBndr _) = panic \"tcHsTyVarBndr\"\n\n\n--------------------------------------\n-- Binding type/class variables in the\n-- kind-checking and typechecking phases\n--------------------------------------\n\nbindTyClTyVars :: Name\n               -> ([TyConBinder] -> Kind -> TcM a) -> TcM a\n-- ^ Used for the type variables of a type or class decl\n-- in the \"kind checking\" and \"type checking\" pass,\n-- but not in the initial-kind run.\nbindTyClTyVars tycon_name thing_inside\n  = do { tycon <- kcLookupTcTyCon tycon_name\n       ; let scoped_prs = tcTyConScopedTyVars tycon\n             res_kind   = tyConResKind tycon\n             binders    = tyConBinders tycon\n       ; traceTc \"bindTyClTyVars\" (ppr tycon_name <+> ppr binders $$ ppr scoped_prs)\n       ; tcExtendNameTyVarEnv scoped_prs $\n         thing_inside binders res_kind }\n\n-- getInitialKind has made a suitably-shaped kind for the type or class\n-- Look it up in the local environment. This is used only for tycons\n-- that we're currently type-checking, so we're sure to find a TcTyCon.\nkcLookupTcTyCon :: Name -> TcM TcTyCon\nkcLookupTcTyCon nm\n  = do { tc_ty_thing <- tcLookup nm\n       ; return $ case tc_ty_thing of\n           ATcTyCon tc -> tc\n           _           -> pprPanic \"kcLookupTcTyCon\" (ppr tc_ty_thing) }\n\n\n{- *********************************************************************\n*                                                                      *\n             Kind generalisation\n*                                                                      *\n********************************************************************* -}\n\nzonkAndScopedSort :: [TcTyVar] -> TcM [TcTyVar]\nzonkAndScopedSort spec_tkvs\n  = do { spec_tkvs <- mapM zonkAndSkolemise spec_tkvs\n          -- Use zonkAndSkolemise because a skol_tv might be a TyVarTv\n\n       -- Do a stable topological sort, following\n       -- Note [Ordering of implicit variables] in RnTypes\n       ; return (scopedSort spec_tkvs) }\n\nkindGeneralize :: TcType -> TcM [KindVar]\n-- Quantify the free kind variables of a kind or type\n-- In the latter case the type is closed, so it has no free\n-- type variables.  So in both cases, all the free vars are kind vars\n-- Input needn't be zonked.\n-- NB: You must call solveEqualities or solveLocalEqualities before\n-- kind generalization\n--\n-- NB: this function is just a specialised version of\n--        kindGeneralizeLocal emptyWC kind_or_type\n--\nkindGeneralize kind_or_type\n  = do { kt <- zonkTcType kind_or_type\n       ; traceTc \"kindGeneralise1\" (ppr kt)\n       ; dvs <- candidateQTyVarsOfKind kind_or_type\n       ; gbl_tvs <- tcGetGlobalTyCoVars -- Already zonked\n       ; traceTc \"kindGeneralize\" (vcat [ ppr kind_or_type\n                                        , ppr dvs ])\n       ; quantifyTyVars gbl_tvs dvs }\n\n-- | This variant of 'kindGeneralize' refuses to generalize over any\n-- variables free in the given WantedConstraints. Instead, it promotes\n-- these variables into an outer TcLevel. See also\n-- Note [Promoting unification variables] in TcSimplify\nkindGeneralizeLocal :: WantedConstraints -> TcType -> TcM [KindVar]\nkindGeneralizeLocal wanted kind_or_type\n  = do {\n       -- This bit is very much like decideMonoTyVars in TcSimplify,\n       -- but constraints are so much simpler in kinds, it is much\n       -- easier here. (In particular, we never quantify over a\n       -- constraint in a type.)\n       ; constrained <- zonkTyCoVarsAndFV (tyCoVarsOfWC wanted)\n       ; (_, constrained) <- promoteTyVarSet constrained\n\n       ; gbl_tvs <- tcGetGlobalTyCoVars -- Already zonked\n       ; let mono_tvs = gbl_tvs `unionVarSet` constrained\n\n         -- use the \"Kind\" variant here, as any types we see\n         -- here will already have all type variables quantified;\n         -- thus, every free variable is really a kv, never a tv.\n       ; dvs <- candidateQTyVarsOfKind kind_or_type\n\n       ; traceTc \"kindGeneralizeLocal\" $\n         vcat [ text \"Wanted:\" <+> ppr wanted\n              , text \"Kind or type:\" <+> ppr kind_or_type\n              , text \"tcvs of wanted:\" <+> pprTyVars (nonDetEltsUniqSet (tyCoVarsOfWC wanted))\n              , text \"constrained:\" <+> pprTyVars (nonDetEltsUniqSet constrained)\n              , text \"mono_tvs:\" <+> pprTyVars (nonDetEltsUniqSet mono_tvs)\n              , text \"dvs:\" <+> ppr dvs ]\n\n       ; quantifyTyVars mono_tvs dvs }\n\n{- Note [Levels and generalisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  f x = e\nwith no type signature. We are currently at level i.\nWe must\n  * Push the level to level (i+1)\n  * Allocate a fresh alpha[i+1] for the result type\n  * Check that e :: alpha[i+1], gathering constraint WC\n  * Solve WC as far as possible\n  * Zonking the result type alpha[i+1], say to beta[i-1] -> gamma[i]\n  * Find the free variables with level > i, in this case gamma[i]\n  * Skolemise those free variables and quantify over them, giving\n       f :: forall g. beta[i-1] -> g\n  * Emit the residiual constraint wrapped in an implication for g,\n    thus   forall g. WC\n\nAll of this happens for types too.  Consider\n  f :: Int -> (forall a. Proxy a -> Int)\n\nNote [Kind generalisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe do kind generalisation only at the outer level of a type signature.\nFor example, consider\n  T :: forall k. k -> *\n  f :: (forall a. T a -> Int) -> Int\nWhen kind-checking f's type signature we generalise the kind at\nthe outermost level, thus:\n  f1 :: forall k. (forall (a:k). T k a -> Int) -> Int  -- YES!\nand *not* at the inner forall:\n  f2 :: (forall k. forall (a:k). T k a -> Int) -> Int  -- NO!\nReason: same as for HM inference on value level declarations,\nwe want to infer the most general type.  The f2 type signature\nwould be *less applicable* than f1, because it requires a more\npolymorphic argument.\n\nNB: There are no explicit kind variables written in f's signature.\nWhen there are, the renamer adds these kind variables to the list of\nvariables bound by the forall, so you can indeed have a type that's\nhigher-rank in its kind. But only by explicit request.\n\nNote [Kinds of quantified type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ntcTyVarBndrsGen quantifies over a specified list of type variables,\n*and* over the kind variables mentioned in the kinds of those tyvars.\n\nNote that we must zonk those kinds (obviously) but less obviously, we\nmust return type variables whose kinds are zonked too. Example\n    (a :: k7)  where  k7 := k9 -> k9\nWe must return\n    [k9, a:k9->k9]\nand NOT\n    [k9, a:k7]\nReason: we're going to turn this into a for-all type,\n   forall k9. forall (a:k7). blah\nwhich the type checker will then instantiate, and instantiate does not\nlook through unification variables!\n\nHence using zonked_kinds when forming tvs'.\n\n-}\n\n-----------------------------------\netaExpandAlgTyCon :: [TyConBinder]\n                  -> Kind\n                  -> TcM ([TyConBinder], Kind)\n-- GADT decls can have a (perhaps partial) kind signature\n--      e.g.  data T a :: * -> * -> * where ...\n-- This function makes up suitable (kinded) TyConBinders for the\n-- argument kinds.  E.g. in this case it might return\n--   ([b::*, c::*], *)\n-- Never emits constraints.\n-- It's a little trickier than you might think: see\n-- Note [TyConBinders for the result kind signature of a data type]\netaExpandAlgTyCon tc_bndrs kind\n  = do  { loc     <- getSrcSpanM\n        ; uniqs   <- newUniqueSupply\n        ; rdr_env <- getLocalRdrEnv\n        ; let new_occs = [ occ\n                         | str <- allNameStrings\n                         , let occ = mkOccName tvName str\n                         , isNothing (lookupLocalRdrOcc rdr_env occ)\n                         -- Note [Avoid name clashes for associated data types]\n                         , not (occ `elem` lhs_occs) ]\n              new_uniqs = uniqsFromSupply uniqs\n              subst = mkEmptyTCvSubst (mkInScopeSet (mkVarSet lhs_tvs))\n        ; return (go loc new_occs new_uniqs subst [] kind) }\n  where\n    lhs_tvs  = map binderVar tc_bndrs\n    lhs_occs = map getOccName lhs_tvs\n\n    go loc occs uniqs subst acc kind\n      = case splitPiTy_maybe kind of\n          Nothing -> (reverse acc, substTy subst kind)\n\n          Just (Anon _ arg, kind')\n            -> go loc occs' uniqs' subst' (tcb : acc) kind'\n            where\n              arg'   = substTy subst arg\n              tv     = mkTyVar (mkInternalName uniq occ loc) arg'\n              subst' = extendTCvInScope subst tv\n              tcb    = Bndr tv (AnonTCB VisArg)\n              (uniq:uniqs') = uniqs\n              (occ:occs')   = occs\n\n          Just (Named (Bndr tv vis), kind')\n            -> go loc occs uniqs subst' (tcb : acc) kind'\n            where\n              (subst', tv') = substTyVarBndr subst tv\n              tcb = Bndr tv' (NamedTCB vis)\n\nbadKindSig :: Bool -> Kind -> SDoc\nbadKindSig check_for_type kind\n = hang (sep [ text \"Kind signature on data type declaration has non-*\"\n             , (if check_for_type then empty else text \"and non-variable\") <+>\n               text \"return kind\" ])\n        2 (ppr kind)\n\ntcbVisibilities :: TyCon -> [Type] -> [TyConBndrVis]\n-- Result is in 1-1 correpondence with orig_args\ntcbVisibilities tc orig_args\n  = go (tyConKind tc) init_subst orig_args\n  where\n    init_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfTypes orig_args))\n    go _ _ []\n      = []\n\n    go fun_kind subst all_args@(arg : args)\n      | Just (tcb, inner_kind) <- splitPiTy_maybe fun_kind\n      = case tcb of\n          Anon af _           -> AnonTCB af   : go inner_kind subst  args\n          Named (Bndr tv vis) -> NamedTCB vis : go inner_kind subst' args\n                 where\n                    subst' = extendTCvSubst subst tv arg\n\n      | not (isEmptyTCvSubst subst)\n      = go (substTy subst fun_kind) init_subst all_args\n\n      | otherwise\n      = pprPanic \"addTcbVisibilities\" (ppr tc <+> ppr orig_args)\n\n\n{- Note [TyConBinders for the result kind signature of a data type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven\n  data T (a::*) :: * -> forall k. k -> *\nwe want to generate the extra TyConBinders for T, so we finally get\n  (a::*) (b::*) (k::*) (c::k)\nThe function etaExpandAlgTyCon generates these extra TyConBinders from\nthe result kind signature.\n\nWe need to take care to give the TyConBinders\n  (a) OccNames that are fresh (because the TyConBinders of a TyCon\n      must have distinct OccNames\n\n  (b) Uniques that are fresh (obviously)\n\nFor (a) we need to avoid clashes with the tyvars declared by\nthe user before the \"::\"; in the above example that is 'a'.\nAnd also see Note [Avoid name clashes for associated data types].\n\nFor (b) suppose we have\n   data T :: forall k. k -> forall k. k -> *\nwhere the two k's are identical even up to their uniques.  Surprisingly,\nthis can happen: see Trac #14515.\n\nIt's reasonably easy to solve all this; just run down the list with a\nsubstitution; hence the recursive 'go' function.  But it has to be\ndone.\n\nNote [Avoid name clashes for associated data types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider    class C a b where\n               data D b :: * -> *\nWhen typechecking the decl for D, we'll invent an extra type variable\nfor D, to fill out its kind.  Ideally we don't want this type variable\nto be 'a', because when pretty printing we'll get\n            class C a b where\n               data D b a0\n(NB: the tidying happens in the conversion to IfaceSyn, which happens\nas part of pretty-printing a TyThing.)\n\nThat's why we look in the LocalRdrEnv to see what's in scope. This is\nimportant only to get nice-looking output when doing \":info C\" in GHCi.\nIt isn't essential for correctness.\n\n\n************************************************************************\n*                                                                      *\n             Partial signatures\n*                                                                      *\n************************************************************************\n\n-}\n\ntcHsPartialSigType\n  :: UserTypeCtxt\n  -> LHsSigWcType GhcRn       -- The type signature\n  -> TcM ( [(Name, TcTyVar)]  -- Wildcards\n         , Maybe TcType       -- Extra-constraints wildcard\n         , [Name]             -- Original tyvar names, in correspondence with ...\n         , [TcTyVar]          -- ... Implicitly and explicitly bound type variables\n         , TcThetaType        -- Theta part\n         , TcType )           -- Tau part\n-- See Note [Recipe for checking a signature]\ntcHsPartialSigType ctxt sig_ty\n  | HsWC { hswc_ext  = sig_wcs,         hswc_body = ib_ty } <- sig_ty\n  , HsIB { hsib_ext = implicit_hs_tvs\n         , hsib_body = hs_ty } <- ib_ty\n  , (explicit_hs_tvs, L _ hs_ctxt, hs_tau) <- splitLHsSigmaTy hs_ty\n  = addSigCtxt ctxt hs_ty $\n    do { (implicit_tvs, (explicit_tvs, (wcs, wcx, theta, tau)))\n            <- solveLocalEqualities \"tcHsPatSigTypes\"      $\n               tcWildCardBinders sig_wcs $ \\ wcs ->\n               bindImplicitTKBndrs_Tv implicit_hs_tvs       $\n               bindExplicitTKBndrs_Tv explicit_hs_tvs       $\n               do {   -- Instantiate the type-class context; but if there\n                      -- is an extra-constraints wildcard, just discard it here\n                    (theta, wcx) <- tcPartialContext hs_ctxt\n\n                  ; tau <- tcHsOpenType hs_tau\n\n                  ; return (wcs, wcx, theta, tau) }\n\n         -- We must return these separately, because all the zonking below\n         -- might change the name of a TyVarTv. This, in turn, causes trouble\n         -- in partial type signatures that bind scoped type variables, as\n         -- we bring the wrong name into scope in the function body.\n         -- Test case: partial-sigs/should_compile/LocalDefinitionBug\n       ; let tv_names = implicit_hs_tvs ++ hsLTyVarNames explicit_hs_tvs\n\n       -- Spit out the wildcards (including the extra-constraints one)\n       -- as \"hole\" constraints, so that they'll be reported if necessary\n       -- See Note [Extra-constraint holes in partial type signatures]\n       ; emitWildCardHoleConstraints wcs\n\n         -- The TyVarTvs created above will sometimes have too high a TcLevel\n         -- (note that they are generated *after* bumping the level in\n         -- the tc{Im,Ex}plicitTKBndrsSig functions. Bumping the level\n         -- is still important here, because the kinds of these variables\n         -- do indeed need to have the higher level, so they can unify\n         -- with other local type variables. But, now that we've type-checked\n         -- everything (and solved equalities in the tcImplicit call)\n         -- we need to promote the TyVarTvs so we don't violate the TcLevel\n         -- invariant\n       ; implicit_tvs <- zonkAndScopedSort implicit_tvs\n       ; explicit_tvs <- mapM zonkAndSkolemise explicit_tvs\n       ; theta        <- mapM zonkTcType theta\n       ; tau          <- zonkTcType tau\n\n       ; let all_tvs = implicit_tvs ++ explicit_tvs\n\n       ; checkValidType ctxt (mkSpecForAllTys all_tvs $ mkPhiTy theta tau)\n\n       ; traceTc \"tcHsPartialSigType\" (ppr all_tvs)\n       ; return (wcs, wcx, tv_names, all_tvs, theta, tau) }\n\ntcHsPartialSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic \"tcHsPartialSigType\"\ntcHsPartialSigType _ (XHsWildCardBndrs _) = panic \"tcHsPartialSigType\"\n\ntcPartialContext :: HsContext GhcRn -> TcM (TcThetaType, Maybe TcType)\ntcPartialContext hs_theta\n  | Just (hs_theta1, hs_ctxt_last) <- snocView hs_theta\n  , L _ wc@(HsWildCardTy _) <- ignoreParens hs_ctxt_last\n  = do { wc_tv_ty <- tcWildCardOcc wc constraintKind\n       ; theta <- mapM tcLHsPredType hs_theta1\n       ; return (theta, Just wc_tv_ty) }\n  | otherwise\n  = do { theta <- mapM tcLHsPredType hs_theta\n       ; return (theta, Nothing) }\n\n{- Note [Extra-constraint holes in partial type signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  f :: (_) => a -> a\n  f x = ...\n\n* The renamer leaves '_' untouched.\n\n* Then, in tcHsPartialSigType, we make a new hole TcTyVar, in\n  tcWildCardBinders.\n\n* TcBinds.chooseInferredQuantifiers fills in that hole TcTyVar\n  with the inferred constraints, e.g. (Eq a, Show a)\n\n* TcErrors.mkHoleError finally reports the error.\n\nAn annoying difficulty happens if there are more than 62 inferred\nconstraints. Then we need to fill in the TcTyVar with (say) a 70-tuple.\nWhere do we find the TyCon?  For good reasons we only have constraint\ntuples up to 62 (see Note [How tuples work] in TysWiredIn).  So how\ncan we make a 70-tuple?  This was the root cause of Trac #14217.\n\nIt's incredibly tiresome, because we only need this type to fill\nin the hole, to communicate to the error reporting machinery.  Nothing\nmore.  So I use a HACK:\n\n* I make an /ordinary/ tuple of the constraints, in\n  TcBinds.chooseInferredQuantifiers. This is ill-kinded because\n  ordinary tuples can't contain constraints, but it works fine. And for\n  ordinary tuples we don't have the same limit as for constraint\n  tuples (which need selectors and an assocated class).\n\n* Because it is ill-kinded, it trips an assert in writeMetaTyVar,\n  so now I disable the assertion if we are writing a type of\n  kind Constraint.  (That seldom/never normally happens so we aren't\n  losing much.)\n\nResult works fine, but it may eventually bite us.\n\n\n************************************************************************\n*                                                                      *\n      Pattern signatures (i.e signatures that occur in patterns)\n*                                                                      *\n********************************************************************* -}\n\ntcHsPatSigType :: UserTypeCtxt\n               -> LHsSigWcType GhcRn          -- The type signature\n               -> TcM ( [(Name, TcTyVar)]     -- Wildcards\n                      , [(Name, TcTyVar)]     -- The new bit of type environment, binding\n                                              -- the scoped type variables\n                      , TcType)       -- The type\n-- Used for type-checking type signatures in\n-- (a) patterns           e.g  f (x::Int) = e\n-- (b) RULE forall bndrs  e.g. forall (x::Int). f x = x\n--\n-- This may emit constraints\n-- See Note [Recipe for checking a signature]\ntcHsPatSigType ctxt sig_ty\n  | HsWC { hswc_ext = sig_wcs,   hswc_body = ib_ty } <- sig_ty\n  , HsIB { hsib_ext = sig_ns\n         , hsib_body = hs_ty } <- ib_ty\n  = addSigCtxt ctxt hs_ty $\n    do { sig_tkv_prs <- mapM new_implicit_tv sig_ns\n       ; (wcs, sig_ty)\n            <- solveLocalEqualities \"tcHsPatSigType\" $\n                 -- Always solve local equalities if possible,\n                 -- else casts get in the way of deep skolemisation\n                 -- (Trac #16033)\n               tcWildCardBinders sig_wcs        $ \\ wcs ->\n               tcExtendNameTyVarEnv sig_tkv_prs $\n               do { sig_ty <- tcHsOpenType hs_ty\n                  ; return (wcs, sig_ty) }\n\n        ; emitWildCardHoleConstraints wcs\n\n          -- sig_ty might have tyvars that are at a higher TcLevel (if hs_ty\n          -- contains a forall). Promote these.\n          -- Ex: f (x :: forall a. Proxy a -> ()) = ... x ...\n          -- When we instantiate x, we have to compare the kind of the argument\n          -- to a's kind, which will be a metavariable.\n        ; sig_ty <- zonkPromoteType sig_ty\n        ; checkValidType ctxt sig_ty\n\n        ; traceTc \"tcHsPatSigType\" (ppr sig_tkv_prs)\n        ; return (wcs, sig_tkv_prs, sig_ty) }\n  where\n    new_implicit_tv name\n      = do { kind <- newMetaKindVar\n           ; tv   <- case ctxt of\n                       RuleSigCtxt {} -> newSkolemTyVar name kind\n                       _              -> newPatSigTyVar name kind\n                       -- See Note [Pattern signature binders]\n             -- NB: tv's Name may be fresh (in the case of newPatSigTyVar)\n           ; return (name, tv) }\n\ntcHsPatSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic \"tcHsPatSigType\"\ntcHsPatSigType _ (XHsWildCardBndrs _)          = panic \"tcHsPatSigType\"\n\ntcPatSig :: Bool                    -- True <=> pattern binding\n         -> LHsSigWcType GhcRn\n         -> ExpSigmaType\n         -> TcM (TcType,            -- The type to use for \"inside\" the signature\n                 [(Name,TcTyVar)],  -- The new bit of type environment, binding\n                                    -- the scoped type variables\n                 [(Name,TcTyVar)],  -- The wildcards\n                 HsWrapper)         -- Coercion due to unification with actual ty\n                                    -- Of shape:  res_ty ~ sig_ty\ntcPatSig in_pat_bind sig res_ty\n = do  { (sig_wcs, sig_tvs, sig_ty) <- tcHsPatSigType PatSigCtxt sig\n        -- sig_tvs are the type variables free in 'sig',\n        -- and not already in scope. These are the ones\n        -- that should be brought into scope\n\n        ; if null sig_tvs then do {\n                -- Just do the subsumption check and return\n                  wrap <- addErrCtxtM (mk_msg sig_ty) $\n                          tcSubTypeET PatSigOrigin PatSigCtxt res_ty sig_ty\n                ; return (sig_ty, [], sig_wcs, wrap)\n        } else do\n                -- Type signature binds at least one scoped type variable\n\n                -- A pattern binding cannot bind scoped type variables\n                -- It is more convenient to make the test here\n                -- than in the renamer\n        { when in_pat_bind (addErr (patBindSigErr sig_tvs))\n\n                -- Check that all newly-in-scope tyvars are in fact\n                -- constrained by the pattern.  This catches tiresome\n                -- cases like\n                --      type T a = Int\n                --      f :: Int -> Int\n                --      f (x :: T a) = ...\n                -- Here 'a' doesn't get a binding.  Sigh\n        ; let bad_tvs = filterOut (`elemVarSet` exactTyCoVarsOfType sig_ty)\n                                  (tyCoVarsOfTypeList sig_ty)\n        ; checkTc (null bad_tvs) (badPatTyVarTvs sig_ty bad_tvs)\n\n        -- Now do a subsumption check of the pattern signature against res_ty\n        ; wrap <- addErrCtxtM (mk_msg sig_ty) $\n                  tcSubTypeET PatSigOrigin PatSigCtxt res_ty sig_ty\n\n        -- Phew!\n        ; return (sig_ty, sig_tvs, sig_wcs, wrap)\n        } }\n  where\n    mk_msg sig_ty tidy_env\n       = do { (tidy_env, sig_ty) <- zonkTidyTcType tidy_env sig_ty\n            ; res_ty <- readExpType res_ty   -- should be filled in by now\n            ; (tidy_env, res_ty) <- zonkTidyTcType tidy_env res_ty\n            ; let msg = vcat [ hang (text \"When checking that the pattern signature:\")\n                                  4 (ppr sig_ty)\n                             , nest 2 (hang (text \"fits the type of its context:\")\n                                          2 (ppr res_ty)) ]\n            ; return (tidy_env, msg) }\n\npatBindSigErr :: [(Name,TcTyVar)] -> SDoc\npatBindSigErr sig_tvs\n  = hang (text \"You cannot bind scoped type variable\" <> plural sig_tvs\n          <+> pprQuotedList (map fst sig_tvs))\n       2 (text \"in a pattern binding signature\")\n\n{- Note [Pattern signature binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee also Note [Type variables in the type environment] in TcRnTypes.\nConsider\n\n  data T where\n    MkT :: forall a. a -> (a -> Int) -> T\n\n  f :: T -> ...\n  f (MkT x (f :: b -> c)) = <blah>\n\nHere\n * The pattern (MkT p1 p2) creates a *skolem* type variable 'a_sk',\n   It must be a skolem so that that it retains its identity, and\n   TcErrors.getSkolemInfo can thereby find the binding site for the skolem.\n\n * The type signature pattern (f :: b -> c) makes freshs meta-tyvars\n   beta and gamma (TauTvs), and binds \"b\" :-> beta, \"c\" :-> gamma in the\n   environment\n\n * Then unification makes beta := a_sk, gamma := Int\n   That's why we must make beta and gamma a MetaTv,\n   not a SkolemTv, so that it can unify to a_sk (or Int, respectively).\n\n * Finally, in '<blah>' we have the envt \"b\" :-> beta, \"c\" :-> gamma,\n   so we return the pairs (\"b\" :-> beta, \"c\" :-> gamma) from tcHsPatSigType,\n\nAnother example (Trac #13881):\n   fl :: forall (l :: [a]). Sing l -> Sing l\n   fl (SNil :: Sing (l :: [y])) = SNil\nWhen we reach the pattern signature, 'l' is in scope from the\nouter 'forall':\n   \"a\" :-> a_sk :: *\n   \"l\" :-> l_sk :: [a_sk]\nWe make up a fresh meta-TauTv, y_sig, for 'y', and kind-check\nthe pattern signature\n   Sing (l :: [y])\nThat unifies y_sig := a_sk.  We return from tcHsPatSigType with\nthe pair (\"y\" :-> y_sig).\n\nFor RULE binders, though, things are a bit different (yuk).\n  RULE \"foo\" forall (x::a) (y::[a]).  f x y = ...\nHere this really is the binding site of the type variable so we'd like\nto use a skolem, so that we get a complaint if we unify two of them\ntogether.  Hence the new_tv function in tcHsPatSigType.\n\n\n************************************************************************\n*                                                                      *\n        Checking kinds\n*                                                                      *\n************************************************************************\n\n-}\n\nunifyKinds :: [LHsType GhcRn] -> [(TcType, TcKind)] -> TcM ([TcType], TcKind)\nunifyKinds rn_tys act_kinds\n  = do { kind <- newMetaKindVar\n       ; let check rn_ty (ty, act_kind)\n               = checkExpectedKind (unLoc rn_ty) ty act_kind kind\n       ; tys' <- zipWithM check rn_tys act_kinds\n       ; return (tys', kind) }\n\n{-\n************************************************************************\n*                                                                      *\n    Promotion\n*                                                                      *\n************************************************************************\n-}\n\n-- | Whenever a type is about to be added to the environment, it's necessary\n-- to make sure that any free meta-tyvars in the type are promoted to the\n-- current TcLevel. (They might be at a higher level due to the level-bumping\n-- in tcExplicitTKBndrs, for example.) This function both zonks *and*\n-- promotes. Why at the same time? See Note [Recipe for checking a signature]\nzonkPromoteType :: TcType -> TcM TcType\nzonkPromoteType = mapType zonkPromoteMapper ()\n\n-- cf. TcMType.zonkTcTypeMapper\nzonkPromoteMapper :: TyCoMapper () TcM\nzonkPromoteMapper = TyCoMapper { tcm_tyvar    = const zonkPromoteTcTyVar\n                               , tcm_covar    = const covar\n                               , tcm_hole     = const hole\n                               , tcm_tycobinder = const tybinder\n                               , tcm_tycon    = return }\n  where\n    covar cv\n      = mkCoVarCo <$> zonkPromoteTyCoVarKind cv\n\n    hole :: CoercionHole -> TcM Coercion\n    hole h\n      = do { contents <- unpackCoercionHole_maybe h\n           ; case contents of\n               Just co -> do { co <- zonkPromoteCoercion co\n                             ; checkCoercionHole cv co }\n               Nothing -> do { cv' <- zonkPromoteTyCoVarKind cv\n                             ; return $ mkHoleCo (setCoHoleCoVar h cv') } }\n      where\n        cv = coHoleCoVar h\n\n    tybinder :: TyVar -> ArgFlag -> TcM ((), TyVar)\n    tybinder tv _flag = ((), ) <$> zonkPromoteTyCoVarKind tv\n\nzonkPromoteTcTyVar :: TyCoVar -> TcM TcType\nzonkPromoteTcTyVar tv\n  | isMetaTyVar tv\n  = do { let ref = metaTyVarRef tv\n       ; contents <- readTcRef ref\n       ; case contents of\n           Flexi -> do { (_, promoted_tv) <- promoteTyVar tv\n                       ; mkTyVarTy <$> zonkPromoteTyCoVarKind promoted_tv }\n           Indirect ty -> zonkPromoteType ty }\n\n  | isTcTyVar tv && isSkolemTyVar tv  -- NB: isSkolemTyVar says \"True\" to pure TyVars\n  = do { tc_lvl <- getTcLevel\n       ; mkTyVarTy <$> zonkPromoteTyCoVarKind (promoteSkolem tc_lvl tv) }\n\n  | otherwise\n  = mkTyVarTy <$> zonkPromoteTyCoVarKind tv\n\nzonkPromoteTyCoVarKind :: TyCoVar -> TcM TyCoVar\nzonkPromoteTyCoVarKind = updateTyVarKindM zonkPromoteType\n\nzonkPromoteCoercion :: Coercion -> TcM Coercion\nzonkPromoteCoercion = mapCoercion zonkPromoteMapper ()\n\n{-\n************************************************************************\n*                                                                      *\n        Sort checking kinds\n*                                                                      *\n************************************************************************\n\ntcLHsKindSig converts a user-written kind to an internal, sort-checked kind.\nIt does sort checking and desugaring at the same time, in one single pass.\n-}\n\ntcLHsKindSig :: UserTypeCtxt -> LHsKind GhcRn -> TcM Kind\ntcLHsKindSig ctxt hs_kind\n-- See  Note [Recipe for checking a signature] in TcHsType\n-- Result is zonked\n  = do { kind <- solveLocalEqualities \"tcLHsKindSig\" $\n                 tc_lhs_kind kindLevelMode hs_kind\n       ; traceTc \"tcLHsKindSig\" (ppr hs_kind $$ ppr kind)\n       -- No generalization, so we must promote\n       ; kind <- zonkPromoteType kind\n         -- This zonk is very important in the case of higher rank kinds\n         -- E.g. Trac #13879    f :: forall (p :: forall z (y::z). <blah>).\n         --                          <more blah>\n         --      When instantiating p's kind at occurrences of p in <more blah>\n         --      it's crucial that the kind we instantiate is fully zonked,\n         --      else we may fail to substitute properly\n\n       ; checkValidType ctxt kind\n       ; traceTc \"tcLHsKindSig2\" (ppr kind)\n       ; return kind }\n\ntc_lhs_kind :: TcTyMode -> LHsKind GhcRn -> TcM Kind\ntc_lhs_kind mode k\n  = addErrCtxt (text \"In the kind\" <+> quotes (ppr k)) $\n    tc_lhs_type (kindLevel mode) k liftedTypeKind\n\npromotionErr :: Name -> PromotionErr -> TcM a\npromotionErr name err\n  = failWithTc (hang (pprPECategory err <+> quotes (ppr name) <+> text \"cannot be used here\")\n                   2 (parens reason))\n  where\n    reason = case err of\n               ConstrainedDataConPE pred\n                              -> text \"it has an unpromotable context\"\n                                 <+> quotes (ppr pred)\n               FamDataConPE   -> text \"it comes from a data family instance\"\n               NoDataKindsTC  -> text \"perhaps you intended to use DataKinds\"\n               NoDataKindsDC  -> text \"perhaps you intended to use DataKinds\"\n               PatSynPE       -> text \"pattern synonyms cannot be promoted\"\n               _ -> text \"it is defined and used in the same recursive group\"\n\n{-\n************************************************************************\n*                                                                      *\n                Scoped type variables\n*                                                                      *\n************************************************************************\n-}\n\nbadPatTyVarTvs :: TcType -> [TyVar] -> SDoc\nbadPatTyVarTvs sig_ty bad_tvs\n  = vcat [ fsep [text \"The type variable\" <> plural bad_tvs,\n                 quotes (pprWithCommas ppr bad_tvs),\n                 text \"should be bound by the pattern signature\" <+> quotes (ppr sig_ty),\n                 text \"but are actually discarded by a type synonym\" ]\n         , text \"To fix this, expand the type synonym\"\n         , text \"[Note: I hope to lift this restriction in due course]\" ]\n\n{-\n************************************************************************\n*                                                                      *\n          Error messages and such\n*                                                                      *\n************************************************************************\n-}\n\n\n-- | If the inner action emits constraints, report them as errors and fail;\n-- otherwise, propagates the return value. Useful as a wrapper around\n-- 'tcImplicitTKBndrs', which uses solveLocalEqualities, when there won't be\n-- another chance to solve constraints\nfailIfEmitsConstraints :: TcM a -> TcM a\nfailIfEmitsConstraints thing_inside\n  = checkNoErrs $  -- We say that we fail if there are constraints!\n                   -- c.f same checkNoErrs in solveEqualities\n    do { (res, lie) <- captureConstraints thing_inside\n       ; reportAllUnsolved lie\n       ; return res\n       }\n\n-- | Make an appropriate message for an error in a function argument.\n-- Used for both expressions and types.\nfunAppCtxt :: (Outputable fun, Outputable arg) => fun -> arg -> Int -> SDoc\nfunAppCtxt fun arg arg_no\n  = hang (hsep [ text \"In the\", speakNth arg_no, ptext (sLit \"argument of\"),\n                    quotes (ppr fun) <> text \", namely\"])\n       2 (quotes (ppr arg))\n\n-- | Add a \"In the data declaration for T\" or some such.\naddTyConFlavCtxt :: Name -> TyConFlavour -> TcM a -> TcM a\naddTyConFlavCtxt name flav\n  = addErrCtxt $ hsep [ text \"In the\", ppr flav\n                      , text \"declaration for\", quotes (ppr name) ]\n", "num_lines": 2941}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nTcInstDecls: Typechecking instance declarations\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcInstDcls ( tcInstDecls1, tcInstDeclsDeriv, tcInstDecls2 ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport TcBinds\nimport TcTyClsDecls\nimport TcTyDecls ( addTyConsToGblEnv )\nimport TcClassDcl( tcClassDecl2, tcATDefault,\n                   HsSigFun, mkHsSigFun, badMethodErr,\n                   findMethodBind, instantiateMethod )\nimport TcSigs\nimport TcRnMonad\nimport TcValidity\nimport TcHsSyn\nimport TcMType\nimport TcType\nimport BuildTyCl\nimport Inst\nimport ClsInst( AssocInstInfo(..), isNotAssociated )\nimport InstEnv\nimport FamInst\nimport FamInstEnv\nimport TcDeriv\nimport TcEnv\nimport TcHsType\nimport TcUnify\nimport CoreSyn    ( Expr(..), mkApps, mkVarApps, mkLams )\nimport MkCore     ( nO_METHOD_BINDING_ERROR_ID )\nimport CoreUnfold ( mkInlineUnfoldingWithArity, mkDFunUnfolding )\nimport Type\nimport TcEvidence\nimport TyCon\nimport CoAxiom\nimport DataCon\nimport ConLike\nimport Class\nimport Var\nimport VarEnv\nimport VarSet\nimport Bag\nimport BasicTypes\nimport DynFlags\nimport ErrUtils\nimport FastString\nimport Id\nimport ListSetOps\nimport Name\nimport NameSet\nimport Outputable\nimport SrcLoc\nimport Util\nimport BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Maybes\nimport Data.List( mapAccumL )\n\n\n{-\nTypechecking instance declarations is done in two passes. The first\npass, made by @tcInstDecls1@, collects information to be used in the\nsecond pass.\n\nThis pre-processed info includes the as-yet-unprocessed bindings\ninside the instance declaration.  These are type-checked in the second\npass, when the class-instance envs and GVE contain all the info from\nall the instance and value decls.  Indeed that's the reason we need\ntwo passes over the instance decls.\n\n\nNote [How instance declarations are translated]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere is how we translate instance declarations into Core\n\nRunning example:\n        class C a where\n           op1, op2 :: Ix b => a -> b -> b\n           op2 = <dm-rhs>\n\n        instance C a => C [a]\n           {-# INLINE [2] op1 #-}\n           op1 = <rhs>\n===>\n        -- Method selectors\n        op1,op2 :: forall a. C a => forall b. Ix b => a -> b -> b\n        op1 = ...\n        op2 = ...\n\n        -- Default methods get the 'self' dictionary as argument\n        -- so they can call other methods at the same type\n        -- Default methods get the same type as their method selector\n        $dmop2 :: forall a. C a => forall b. Ix b => a -> b -> b\n        $dmop2 = /\\a. \\(d:C a). /\\b. \\(d2: Ix b). <dm-rhs>\n               -- NB: type variables 'a' and 'b' are *both* in scope in <dm-rhs>\n               -- Note [Tricky type variable scoping]\n\n        -- A top-level definition for each instance method\n        -- Here op1_i, op2_i are the \"instance method Ids\"\n        -- The INLINE pragma comes from the user pragma\n        {-# INLINE [2] op1_i #-}  -- From the instance decl bindings\n        op1_i, op2_i :: forall a. C a => forall b. Ix b => [a] -> b -> b\n        op1_i = /\\a. \\(d:C a).\n               let this :: C [a]\n                   this = df_i a d\n                     -- Note [Subtle interaction of recursion and overlap]\n\n                   local_op1 :: forall b. Ix b => [a] -> b -> b\n                   local_op1 = <rhs>\n                     -- Source code; run the type checker on this\n                     -- NB: Type variable 'a' (but not 'b') is in scope in <rhs>\n                     -- Note [Tricky type variable scoping]\n\n               in local_op1 a d\n\n        op2_i = /\\a \\d:C a. $dmop2 [a] (df_i a d)\n\n        -- The dictionary function itself\n        {-# NOINLINE CONLIKE df_i #-}   -- Never inline dictionary functions\n        df_i :: forall a. C a -> C [a]\n        df_i = /\\a. \\d:C a. MkC (op1_i a d) (op2_i a d)\n                -- But see Note [Default methods in instances]\n                -- We can't apply the type checker to the default-method call\n\n        -- Use a RULE to short-circuit applications of the class ops\n        {-# RULE \"op1@C[a]\" forall a, d:C a.\n                            op1 [a] (df_i d) = op1_i a d #-}\n\nNote [Instances and loop breakers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Note that df_i may be mutually recursive with both op1_i and op2_i.\n  It's crucial that df_i is not chosen as the loop breaker, even\n  though op1_i has a (user-specified) INLINE pragma.\n\n* Instead the idea is to inline df_i into op1_i, which may then select\n  methods from the MkC record, and thereby break the recursion with\n  df_i, leaving a *self*-recursive op1_i.  (If op1_i doesn't call op at\n  the same type, it won't mention df_i, so there won't be recursion in\n  the first place.)\n\n* If op1_i is marked INLINE by the user there's a danger that we won't\n  inline df_i in it, and that in turn means that (since it'll be a\n  loop-breaker because df_i isn't), op1_i will ironically never be\n  inlined.  But this is OK: the recursion breaking happens by way of\n  a RULE (the magic ClassOp rule above), and RULES work inside InlineRule\n  unfoldings. See Note [RULEs enabled in SimplGently] in SimplUtils\n\nNote [ClassOp/DFun selection]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOne thing we see a lot is stuff like\n    op2 (df d1 d2)\nwhere 'op2' is a ClassOp and 'df' is DFun.  Now, we could inline *both*\n'op2' and 'df' to get\n     case (MkD ($cop1 d1 d2) ($cop2 d1 d2) ... of\n       MkD _ op2 _ _ _ -> op2\nAnd that will reduce to ($cop2 d1 d2) which is what we wanted.\n\nBut it's tricky to make this work in practice, because it requires us to\ninline both 'op2' and 'df'.  But neither is keen to inline without having\nseen the other's result; and it's very easy to get code bloat (from the\nbig intermediate) if you inline a bit too much.\n\nInstead we use a cunning trick.\n * We arrange that 'df' and 'op2' NEVER inline.\n\n * We arrange that 'df' is ALWAYS defined in the sylised form\n      df d1 d2 = MkD ($cop1 d1 d2) ($cop2 d1 d2) ...\n\n * We give 'df' a magical unfolding (DFunUnfolding [$cop1, $cop2, ..])\n   that lists its methods.\n\n * We make CoreUnfold.exprIsConApp_maybe spot a DFunUnfolding and return\n   a suitable constructor application -- inlining df \"on the fly\" as it\n   were.\n\n * ClassOp rules: We give the ClassOp 'op2' a BuiltinRule that\n   extracts the right piece iff its argument satisfies\n   exprIsConApp_maybe.  This is done in MkId mkDictSelId\n\n * We make 'df' CONLIKE, so that shared uses still match; eg\n      let d = df d1 d2\n      in ...(op2 d)...(op1 d)...\n\nNote [Single-method classes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the class has just one method (or, more accurately, just one element\nof {superclasses + methods}), then we use a different strategy.\n\n   class C a where op :: a -> a\n   instance C a => C [a] where op = <blah>\n\nWe translate the class decl into a newtype, which just gives a\ntop-level axiom. The \"constructor\" MkC expands to a cast, as does the\nclass-op selector.\n\n   axiom Co:C a :: C a ~ (a->a)\n\n   op :: forall a. C a -> (a -> a)\n   op a d = d |> (Co:C a)\n\n   MkC :: forall a. (a->a) -> C a\n   MkC = /\\a.\\op. op |> (sym Co:C a)\n\nThe clever RULE stuff doesn't work now, because ($df a d) isn't\na constructor application, so exprIsConApp_maybe won't return\nJust <blah>.\n\nInstead, we simply rely on the fact that casts are cheap:\n\n   $df :: forall a. C a => C [a]\n   {-# INLINE df #-}  -- NB: INLINE this\n   $df = /\\a. \\d. MkC [a] ($cop_list a d)\n       = $cop_list |> forall a. C a -> (sym (Co:C [a]))\n\n   $cop_list :: forall a. C a => [a] -> [a]\n   $cop_list = <blah>\n\nSo if we see\n   (op ($df a d))\nwe'll inline 'op' and '$df', since both are simply casts, and\ngood things happen.\n\nWhy do we use this different strategy?  Because otherwise we\nend up with non-inlined dictionaries that look like\n    $df = $cop |> blah\nwhich adds an extra indirection to every use, which seems stupid.  See\nTrac #4138 for an example (although the regression reported there\nwasn't due to the indirection).\n\nThere is an awkward wrinkle though: we want to be very\ncareful when we have\n    instance C a => C [a] where\n      {-# INLINE op #-}\n      op = ...\nthen we'll get an INLINE pragma on $cop_list but it's important that\n$cop_list only inlines when it's applied to *two* arguments (the\ndictionary and the list argument).  So we must not eta-expand $df\nabove.  We ensure that this doesn't happen by putting an INLINE\npragma on the dfun itself; after all, it ends up being just a cast.\n\nThere is one more dark corner to the INLINE story, even more deeply\nburied.  Consider this (Trac #3772):\n\n    class DeepSeq a => C a where\n      gen :: Int -> a\n\n    instance C a => C [a] where\n      gen n = ...\n\n    class DeepSeq a where\n      deepSeq :: a -> b -> b\n\n    instance DeepSeq a => DeepSeq [a] where\n      {-# INLINE deepSeq #-}\n      deepSeq xs b = foldr deepSeq b xs\n\nThat gives rise to these defns:\n\n    $cdeepSeq :: DeepSeq a -> [a] -> b -> b\n    -- User INLINE( 3 args )!\n    $cdeepSeq a (d:DS a) b (x:[a]) (y:b) = ...\n\n    $fDeepSeq[] :: DeepSeq a -> DeepSeq [a]\n    -- DFun (with auto INLINE pragma)\n    $fDeepSeq[] a d = $cdeepSeq a d |> blah\n\n    $cp1 a d :: C a => DeepSep [a]\n    -- We don't want to eta-expand this, lest\n    -- $cdeepSeq gets inlined in it!\n    $cp1 a d = $fDeepSep[] a (scsel a d)\n\n    $fC[] :: C a => C [a]\n    -- Ordinary DFun\n    $fC[] a d = MkC ($cp1 a d) ($cgen a d)\n\nHere $cp1 is the code that generates the superclass for C [a].  The\nissue is this: we must not eta-expand $cp1 either, or else $fDeepSeq[]\nand then $cdeepSeq will inline there, which is definitely wrong.  Like\non the dfun, we solve this by adding an INLINE pragma to $cp1.\n\nNote [Subtle interaction of recursion and overlap]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n  class C a where { op1,op2 :: a -> a }\n  instance C a => C [a] where\n    op1 x = op2 x ++ op2 x\n    op2 x = ...\n  instance C [Int] where\n    ...\n\nWhen type-checking the C [a] instance, we need a C [a] dictionary (for\nthe call of op2).  If we look up in the instance environment, we find\nan overlap.  And in *general* the right thing is to complain (see Note\n[Overlapping instances] in InstEnv).  But in *this* case it's wrong to\ncomplain, because we just want to delegate to the op2 of this same\ninstance.\n\nWhy is this justified?  Because we generate a (C [a]) constraint in\na context in which 'a' cannot be instantiated to anything that matches\nother overlapping instances, or else we would not be executing this\nversion of op1 in the first place.\n\nIt might even be a bit disguised:\n\n  nullFail :: C [a] => [a] -> [a]\n  nullFail x = op2 x ++ op2 x\n\n  instance C a => C [a] where\n    op1 x = nullFail x\n\nPrecisely this is used in package 'regex-base', module Context.hs.\nSee the overlapping instances for RegexContext, and the fact that they\ncall 'nullFail' just like the example above.  The DoCon package also\ndoes the same thing; it shows up in module Fraction.hs.\n\nConclusion: when typechecking the methods in a C [a] instance, we want to\ntreat the 'a' as an *existential* type variable, in the sense described\nby Note [Binding when looking up instances].  That is why isOverlappableTyVar\nresponds True to an InstSkol, which is the kind of skolem we use in\ntcInstDecl2.\n\n\nNote [Tricky type variable scoping]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn our example\n        class C a where\n           op1, op2 :: Ix b => a -> b -> b\n           op2 = <dm-rhs>\n\n        instance C a => C [a]\n           {-# INLINE [2] op1 #-}\n           op1 = <rhs>\n\nnote that 'a' and 'b' are *both* in scope in <dm-rhs>, but only 'a' is\nin scope in <rhs>.  In particular, we must make sure that 'b' is in\nscope when typechecking <dm-rhs>.  This is achieved by subFunTys,\nwhich brings appropriate tyvars into scope. This happens for both\n<dm-rhs> and for <rhs>, but that doesn't matter: the *renamer* will have\ncomplained if 'b' is mentioned in <rhs>.\n\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Extracting instance decls}\n*                                                                      *\n************************************************************************\n\nGather up the instance declarations from their various sources\n-}\n\ntcInstDecls1    -- Deal with both source-code and imported instance decls\n   :: [LInstDecl GhcRn]         -- Source code instance decls\n   -> TcM (TcGblEnv,            -- The full inst env\n           [InstInfo GhcRn],    -- Source-code instance decls to process;\n                                -- contains all dfuns for this module\n           [DerivInfo])         -- From data family instances\n\ntcInstDecls1 inst_decls\n  = do {    -- Do class and family instance declarations\n       ; stuff <- mapAndRecoverM tcLocalInstDecl inst_decls\n\n       ; let (local_infos_s, fam_insts_s, datafam_deriv_infos) = unzip3 stuff\n             fam_insts   = concat fam_insts_s\n             local_infos = concat local_infos_s\n\n       ; gbl_env <- addClsInsts local_infos $\n                    addFamInsts fam_insts   $\n                    getGblEnv\n\n       ; return ( gbl_env\n                , local_infos\n                , concat datafam_deriv_infos ) }\n\n-- | Use DerivInfo for data family instances (produced by tcInstDecls1),\n--   datatype declarations (TyClDecl), and standalone deriving declarations\n--   (DerivDecl) to check and process all derived class instances.\ntcInstDeclsDeriv\n  :: [DerivInfo]\n  -> [LTyClDecl GhcRn]\n  -> [LDerivDecl GhcRn]\n  -> TcM (TcGblEnv, [InstInfo GhcRn], HsValBinds GhcRn)\ntcInstDeclsDeriv datafam_deriv_infos tyclds derivds\n  = do th_stage <- getStage -- See Note [Deriving inside TH brackets]\n       if isBrackStage th_stage\n       then do { gbl_env <- getGblEnv\n               ; return (gbl_env, bagToList emptyBag, emptyValBindsOut) }\n       else do { data_deriv_infos <- mkDerivInfos tyclds\n               ; let deriv_infos = datafam_deriv_infos ++ data_deriv_infos\n               ; (tcg_env, info_bag, valbinds) <- tcDeriving deriv_infos derivds\n               ; return (tcg_env, bagToList info_bag, valbinds) }\n\naddClsInsts :: [InstInfo GhcRn] -> TcM a -> TcM a\naddClsInsts infos thing_inside\n  = tcExtendLocalInstEnv (map iSpec infos) thing_inside\n\naddFamInsts :: [FamInst] -> TcM a -> TcM a\n-- Extend (a) the family instance envt\n--        (b) the type envt with stuff from data type decls\naddFamInsts fam_insts thing_inside\n  = tcExtendLocalFamInstEnv fam_insts $\n    tcExtendGlobalEnv axioms          $\n    do { traceTc \"addFamInsts\" (pprFamInsts fam_insts)\n       ; gbl_env <- addTyConsToGblEnv data_rep_tycons\n                    -- Does not add its axiom; that comes\n                    -- from adding the 'axioms' above\n       ; setGblEnv gbl_env thing_inside }\n  where\n    axioms = map (ACoAxiom . toBranchedAxiom . famInstAxiom) fam_insts\n    data_rep_tycons = famInstsRepTyCons fam_insts\n      -- The representation tycons for 'data instances' declarations\n\n{-\nNote [Deriving inside TH brackets]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven a declaration bracket\n  [d| data T = A | B deriving( Show ) |]\n\nthere is really no point in generating the derived code for deriving(\nShow) and then type-checking it. This will happen at the call site\nanyway, and the type check should never fail!  Moreover (Trac #6005)\nthe scoping of the generated code inside the bracket does not seem to\nwork out.\n\nThe easy solution is simply not to generate the derived instances at\nall.  (A less brutal solution would be to generate them with no\nbindings.)  This will become moot when we shift to the new TH plan, so\nthe brutal solution will do.\n-}\n\ntcLocalInstDecl :: LInstDecl GhcRn\n                -> TcM ([InstInfo GhcRn], [FamInst], [DerivInfo])\n        -- A source-file instance declaration\n        -- Type-check all the stuff before the \"where\"\n        --\n        -- We check for respectable instance type, and context\ntcLocalInstDecl (L loc (TyFamInstD { tfid_inst = decl }))\n  = do { fam_inst <- tcTyFamInstDecl NotAssociated (L loc decl)\n       ; return ([], [fam_inst], []) }\n\ntcLocalInstDecl (L loc (DataFamInstD { dfid_inst = decl }))\n  = do { (fam_inst, m_deriv_info) <- tcDataFamInstDecl NotAssociated (L loc decl)\n       ; return ([], [fam_inst], maybeToList m_deriv_info) }\n\ntcLocalInstDecl (L loc (ClsInstD { cid_inst = decl }))\n  = do { (insts, fam_insts, deriv_infos) <- tcClsInstDecl (L loc decl)\n       ; return (insts, fam_insts, deriv_infos) }\n\ntcLocalInstDecl (L _ (XInstDecl _)) = panic \"tcLocalInstDecl\"\n\ntcClsInstDecl :: LClsInstDecl GhcRn\n              -> TcM ([InstInfo GhcRn], [FamInst], [DerivInfo])\n-- The returned DerivInfos are for any associated data families\ntcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds\n                                  , cid_sigs = uprags, cid_tyfam_insts = ats\n                                  , cid_overlap_mode = overlap_mode\n                                  , cid_datafam_insts = adts }))\n  = setSrcSpan loc                      $\n    addErrCtxt (instDeclCtxt1 hs_ty)  $\n    do  { traceTc \"tcLocalInstDecl\" (ppr hs_ty)\n        ; dfun_ty <- tcHsClsInstType (InstDeclCtxt False) hs_ty\n        ; let (tyvars, theta, clas, inst_tys) = tcSplitDFunTy dfun_ty\n             -- NB: tcHsClsInstType does checkValidInstance\n\n        ; (subst, skol_tvs) <- tcInstSkolTyVars tyvars\n        ; let tv_skol_prs = [ (tyVarName tv, skol_tv)\n                            | (tv, skol_tv) <- tyvars `zip` skol_tvs ]\n              n_inferred = countWhile ((== Inferred) . binderArgFlag) $\n                           fst $ splitForAllVarBndrs dfun_ty\n              visible_skol_tvs = drop n_inferred skol_tvs\n\n        ; traceTc \"tcLocalInstDecl 1\" (ppr dfun_ty $$ ppr (invisibleTyBndrCount dfun_ty) $$ ppr skol_tvs)\n\n        -- Next, process any associated types.\n        ; (datafam_stuff, tyfam_insts)\n             <- tcExtendNameTyVarEnv tv_skol_prs $\n                do  { let mini_env   = mkVarEnv (classTyVars clas `zip` substTys subst inst_tys)\n                          mini_subst = mkTvSubst (mkInScopeSet (mkVarSet skol_tvs)) mini_env\n                          mb_info    = InClsInst { ai_class = clas\n                                                 , ai_tyvars = visible_skol_tvs\n                                                 , ai_inst_env = mini_env }\n                    ; df_stuff  <- mapAndRecoverM (tcDataFamInstDecl mb_info) adts\n                    ; tf_insts1 <- mapAndRecoverM (tcTyFamInstDecl mb_info)   ats\n\n                      -- Check for missing associated types and build them\n                      -- from their defaults (if available)\n                    ; tf_insts2 <- mapM (tcATDefault loc mini_subst defined_ats)\n                                        (classATItems clas)\n\n                    ; return (df_stuff, tf_insts1 ++ concat tf_insts2) }\n\n\n        -- Finally, construct the Core representation of the instance.\n        -- (This no longer includes the associated types.)\n        ; dfun_name <- newDFunName clas inst_tys (getLoc (hsSigType hs_ty))\n                -- Dfun location is that of instance *header*\n\n        ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name\n                              tyvars theta clas inst_tys\n\n        ; let inst_binds = InstBindings\n                             { ib_binds = binds\n                             , ib_tyvars = map Var.varName tyvars -- Scope over bindings\n                             , ib_pragmas = uprags\n                             , ib_extensions = []\n                             , ib_derived = False }\n              inst_info = InstInfo { iSpec  = ispec, iBinds = inst_binds }\n\n              (datafam_insts, m_deriv_infos) = unzip datafam_stuff\n              deriv_infos                    = catMaybes m_deriv_infos\n              all_insts                      = tyfam_insts ++ datafam_insts\n\n         -- In hs-boot files there should be no bindings\n        ; is_boot <- tcIsHsBootOrSig\n        ; let no_binds = isEmptyLHsBinds binds && null uprags\n        ; failIfTc (is_boot && not no_binds) badBootDeclErr\n\n        ; return ( [inst_info], all_insts, deriv_infos ) }\n  where\n    defined_ats = mkNameSet (map (tyFamInstDeclName . unLoc) ats)\n                  `unionNameSet`\n                  mkNameSet (map (unLoc . feqn_tycon\n                                        . hsib_body\n                                        . dfid_eqn\n                                        . unLoc) adts)\n\ntcClsInstDecl (L _ (XClsInstDecl _)) = panic \"tcClsInstDecl\"\n\n{-\n************************************************************************\n*                                                                      *\n               Type family instances\n*                                                                      *\n************************************************************************\n\nFamily instances are somewhat of a hybrid.  They are processed together with\nclass instance heads, but can contain data constructors and hence they share a\nlot of kinding and type checking code with ordinary algebraic data types (and\nGADTs).\n-}\n\ntcTyFamInstDecl :: AssocInstInfo\n                -> LTyFamInstDecl GhcRn -> TcM FamInst\n  -- \"type instance\"\n  -- See Note [Associated type instances]\ntcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn }))\n  = setSrcSpan loc           $\n    tcAddTyFamInstCtxt decl  $\n    do { let fam_lname = feqn_tycon (hsib_body eqn)\n       ; fam_tc <- tcLookupLocatedTyCon fam_lname\n       ; tcFamInstDeclChecks mb_clsinfo fam_tc\n\n         -- (0) Check it's an open type family\n       ; checkTc (isTypeFamilyTyCon fam_tc)     (wrongKindOfFamily fam_tc)\n       ; checkTc (isOpenTypeFamilyTyCon fam_tc) (notOpenFamily fam_tc)\n\n         -- (1) do the work of verifying the synonym group\n       ; co_ax_branch <- tcTyFamInstEqn fam_tc mb_clsinfo\n                                        (L (getLoc fam_lname) eqn)\n\n\n         -- (2) check for validity\n       ; checkConsistentFamInst mb_clsinfo fam_tc co_ax_branch\n       ; checkValidCoAxBranch fam_tc co_ax_branch\n\n         -- (3) construct coercion axiom\n       ; rep_tc_name <- newFamInstAxiomName fam_lname [coAxBranchLHS co_ax_branch]\n       ; let axiom = mkUnbranchedCoAxiom rep_tc_name fam_tc co_ax_branch\n       ; newFamInst SynFamilyInst axiom }\n\n\n---------------------\ntcFamInstDeclChecks :: AssocInstInfo -> TyCon -> TcM ()\n-- Used for both type and data families\ntcFamInstDeclChecks mb_clsinfo fam_tc\n  = do { -- Type family instances require -XTypeFamilies\n         -- and can't (currently) be in an hs-boot file\n       ; traceTc \"tcFamInstDecl\" (ppr fam_tc)\n       ; type_families <- xoptM LangExt.TypeFamilies\n       ; is_boot       <- tcIsHsBootOrSig   -- Are we compiling an hs-boot file?\n       ; checkTc type_families $ badFamInstDecl fam_tc\n       ; checkTc (not is_boot) $ badBootFamInstDeclErr\n\n       -- Check that it is a family TyCon, and that\n       -- oplevel type instances are not for associated types.\n       ; checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)\n\n       ; when (isNotAssociated mb_clsinfo &&   -- Not in a class decl\n               isTyConAssoc fam_tc)            -- but an associated type\n              (addErr $ assocInClassErr fam_tc)\n       }\n\n{- Note [Associated type instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe allow this:\n  class C a where\n    type T x a\n  instance C Int where\n    type T (S y) Int = y\n    type T Z     Int = Char\n\nNote that\n  a) The variable 'x' is not bound by the class decl\n  b) 'x' is instantiated to a non-type-variable in the instance\n  c) There are several type instance decls for T in the instance\n\nAll this is fine.  Of course, you can't give any *more* instances\nfor (T ty Int) elsewhere, because it's an *associated* type.\n\n\n************************************************************************\n*                                                                      *\n               Data family instances\n*                                                                      *\n************************************************************************\n\nFor some reason data family instances are a lot more complicated\nthan type family instances\n-}\n\ntcDataFamInstDecl :: AssocInstInfo\n                  -> LDataFamInstDecl GhcRn -> TcM (FamInst, Maybe DerivInfo)\n  -- \"newtype instance\" and \"data instance\"\ntcDataFamInstDecl mb_clsinfo\n    (L loc decl@(DataFamInstDecl { dfid_eqn = HsIB { hsib_ext = imp_vars\n                                                   , hsib_body =\n      FamEqn { feqn_bndrs  = mb_bndrs\n             , feqn_pats   = hs_pats\n             , feqn_tycon  = lfam_name@(L _ fam_name)\n             , feqn_fixity = fixity\n             , feqn_rhs    = HsDataDefn { dd_ND      = new_or_data\n                                        , dd_cType   = cType\n                                        , dd_ctxt    = hs_ctxt\n                                        , dd_cons    = hs_cons\n                                        , dd_kindSig = m_ksig\n                                        , dd_derivs  = derivs } }}}))\n  = setSrcSpan loc             $\n    tcAddDataFamInstCtxt decl  $\n    do { fam_tc <- tcLookupLocatedTyCon lfam_name\n\n       ; tcFamInstDeclChecks mb_clsinfo fam_tc\n\n       -- Check that the family declaration is for the right kind\n       ; checkTc (isDataFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)\n       ; gadt_syntax <- dataDeclChecks fam_name new_or_data hs_ctxt hs_cons\n          -- Do /not/ check that the number of patterns = tyConArity fam_tc\n          -- See [Arity of data families] in FamInstEnv\n\n       ; (qtvs, pats, res_kind, stupid_theta)\n             <- tcDataFamHeader mb_clsinfo fam_tc imp_vars mb_bndrs\n                                fixity hs_ctxt hs_pats m_ksig hs_cons\n\n       -- Eta-reduce the axiom if possible\n       -- Quite tricky: see Note [Eta-reduction for data families]\n       ; let (eta_pats, eta_tcbs) = eta_reduce fam_tc pats\n             eta_tvs       = map binderVar eta_tcbs\n             post_eta_qtvs = filterOut (`elem` eta_tvs) qtvs\n\n             full_tcbs = mkTyConBindersPreferAnon post_eta_qtvs\n                            (tyCoVarsOfType (mkSpecForAllTys eta_tvs res_kind))\n                         ++ eta_tcbs\n                 -- Put the eta-removed tyvars at the end\n                 -- Remember, qtvs is in arbitrary order, except kind vars are\n                 -- first, so there is no reason to suppose that the eta_tvs\n                 -- (obtained from the pats) are at the end (Trac #11148)\n\n       -- Eta-expand the representation tycon until it has reult kind *\n       -- See also Note [Arity of data families] in FamInstEnv\n       -- NB: we can do this after eta-reducing the axiom, because if\n       --     we did it before the \"extra\" tvs from etaExpandAlgTyCon\n       --     would always be eta-reduced\n       ; (extra_tcbs, final_res_kind) <- etaExpandAlgTyCon full_tcbs res_kind\n       ; checkTc (tcIsLiftedTypeKind final_res_kind) (badKindSig True res_kind)\n       ; let extra_pats  = map (mkTyVarTy . binderVar) extra_tcbs\n             all_pats    = pats `chkAppend` extra_pats\n             orig_res_ty = mkTyConApp fam_tc all_pats\n             ty_binders  = full_tcbs `chkAppend` extra_tcbs\n\n       ; traceTc \"tcDataFamInstDecl\" $\n         vcat [ text \"Fam tycon:\" <+> ppr fam_tc\n              , text \"Pats:\" <+> ppr pats\n              , text \"visibliities:\" <+> ppr (tcbVisibilities fam_tc pats)\n              , text \"all_pats:\" <+> ppr all_pats\n              , text \"ty_binders\" <+> ppr ty_binders\n              , text \"fam_tc_binders:\" <+> ppr (tyConBinders fam_tc)\n              , text \"eta_pats\" <+> ppr eta_pats\n              , text \"eta_tcbs\" <+> ppr eta_tcbs ]\n\n       ; (rep_tc, axiom) <- fixM $ \\ ~(rec_rep_tc, _) ->\n           do { data_cons <- tcExtendTyVarEnv qtvs $\n                             -- For H98 decls, the tyvars scope\n                             -- over the data constructors\n                             tcConDecls rec_rep_tc ty_binders orig_res_ty hs_cons\n\n              ; rep_tc_name <- newFamInstTyConName lfam_name pats\n              ; axiom_name  <- newFamInstAxiomName lfam_name [pats]\n              ; tc_rhs <- case new_or_data of\n                     DataType -> return (mkDataTyConRhs data_cons)\n                     NewType  -> ASSERT( not (null data_cons) )\n                                 mkNewTyConRhs rep_tc_name rec_rep_tc (head data_cons)\n\n              ; let axiom  = mkSingleCoAxiom Representational axiom_name\n                                 post_eta_qtvs eta_tvs [] fam_tc eta_pats\n                                 (mkTyConApp rep_tc (mkTyVarTys post_eta_qtvs))\n                    parent = DataFamInstTyCon axiom fam_tc all_pats\n\n                      -- NB: Use the full ty_binders from the pats. See bullet toward\n                      -- the end of Note [Data type families] in TyCon\n                    rep_tc   = mkAlgTyCon rep_tc_name\n                                          ty_binders liftedTypeKind\n                                          (map (const Nominal) ty_binders)\n                                          (fmap unLoc cType) stupid_theta\n                                          tc_rhs parent\n                                          gadt_syntax\n                 -- We always assume that indexed types are recursive.  Why?\n                 -- (1) Due to their open nature, we can never be sure that a\n                 -- further instance might not introduce a new recursive\n                 -- dependency.  (2) They are always valid loop breakers as\n                 -- they involve a coercion.\n              ; return (rep_tc, axiom) }\n\n       -- Remember to check validity; no recursion to worry about here\n       -- Check that left-hand sides are ok (mono-types, no type families,\n       -- consistent instantiations, etc)\n       ; let ax_branch = coAxiomSingleBranch axiom\n       ; checkConsistentFamInst mb_clsinfo fam_tc ax_branch\n       ; checkValidCoAxBranch fam_tc ax_branch\n       ; checkValidTyCon rep_tc\n\n       ; let m_deriv_info = case derivs of\n               L _ []    -> Nothing\n               L _ preds ->\n                 Just $ DerivInfo { di_rep_tc  = rep_tc\n                                  , di_clauses = preds\n                                  , di_ctxt    = tcMkDataFamInstCtxt decl }\n\n       ; fam_inst <- newFamInst (DataFamilyInst rep_tc) axiom\n       ; return (fam_inst, m_deriv_info) }\n  where\n    eta_reduce :: TyCon -> [Type] -> ([Type], [TyConBinder])\n    -- See Note [Eta reduction for data families] in FamInstEnv\n    -- Splits the incoming patterns into two: the [TyVar]\n    -- are the patterns that can be eta-reduced away.\n    -- e.g.     T [a] Int a d c   ==>  (T [a] Int a, [d,c])\n    --\n    -- NB: quadratic algorithm, but types are small here\n    eta_reduce fam_tc pats\n        = go (reverse (zip3 pats fvs_s vis_s)) []\n        where\n          vis_s :: [TyConBndrVis]\n          vis_s = tcbVisibilities fam_tc pats\n\n          fvs_s :: [TyCoVarSet]  -- 1-1 correspondence with pats\n                                 -- Each elt is the free vars of all /earlier/ pats\n          (_, fvs_s) = mapAccumL add_fvs emptyVarSet pats\n          add_fvs fvs pat = (fvs `unionVarSet` tyCoVarsOfType pat, fvs)\n\n    go ((pat, fvs_to_the_left, tcb_vis):pats) etad_tvs\n      | Just tv <- getTyVar_maybe pat\n      , not (tv `elemVarSet` fvs_to_the_left)\n      = go pats (Bndr tv tcb_vis : etad_tvs)\n    go pats etad_tvs = (reverse (map fstOf3 pats), etad_tvs)\n\ntcDataFamInstDecl _ _ = panic \"tcDataFamInstDecl\"\n\n-----------------------\ntcDataFamHeader :: AssocInstInfo -> TyCon -> [Name] -> Maybe [LHsTyVarBndr GhcRn]\n                -> LexicalFixity -> LHsContext GhcRn\n                -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> [LConDecl GhcRn]\n                -> TcM ([TyVar], [Type], Kind, ThetaType)\n-- The \"header\" is the part other than the data constructors themselves\n-- e.g.  data instance D [a] :: * -> * where ...\n-- Here the \"header\" is the bit before the \"where\"\ntcDataFamHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity hs_ctxt hs_pats m_ksig hs_cons\n  = do { (imp_tvs, (exp_tvs, (stupid_theta, lhs_ty, res_kind)))\n            <- pushTcLevelM_                                $\n               solveEqualities                              $\n               bindImplicitTKBndrs_Q_Skol imp_vars          $\n               bindExplicitTKBndrs_Q_Skol AnyKind exp_bndrs $\n               do { stupid_theta <- tcHsContext hs_ctxt\n                  ; (lhs_ty, lhs_kind) <- tcFamTyPats fam_tc hs_pats\n\n                  -- Ensure that the instance is consistent\n                  -- with its parent class\n                  ; addConsistencyConstraints mb_clsinfo lhs_ty\n\n                  -- Add constraints from the data constructors\n                  ; mapM_ (wrapLocM_ kcConDecl) hs_cons\n\n                  -- Add constraints from the result signature\n                  ; res_kind <- tc_kind_sig m_ksig\n                  ; lhs_ty <- checkExpectedKind_pp pp_lhs lhs_ty lhs_kind res_kind\n                  ; return (stupid_theta, lhs_ty, res_kind) }\n\n       -- See TcTyClsDecls Note [Generalising in tcFamTyPatsGuts]\n       -- This code (and the stuff immediately above) is very similar\n       -- to that in tcFamTyInstEqnGuts.  Maybe we should abstract the\n       -- common code; but for the moment I concluded that it's\n       -- clearer to duplicate it.  Still, if you fix a bug here,\n       -- check there too!\n       ; let scoped_tvs = imp_tvs ++ exp_tvs\n       ; dvs  <- candidateQTyVarsOfTypes (lhs_ty : mkTyVarTys scoped_tvs)\n       ; qtvs <- quantifyTyVars emptyVarSet dvs\n\n       -- Zonk the patterns etc into the Type world\n       ; (ze, qtvs)   <- zonkTyBndrs qtvs\n       ; lhs_ty       <- zonkTcTypeToTypeX ze lhs_ty\n       ; res_kind     <- zonkTcTypeToTypeX ze res_kind\n       ; stupid_theta <- zonkTcTypesToTypesX ze stupid_theta\n\n       -- Check that type patterns match the class instance head\n       ; let pats = unravelFamInstPats lhs_ty\n       ; return (qtvs, pats, res_kind, stupid_theta) }\n  where\n    fam_name  = tyConName fam_tc\n    data_ctxt = DataKindCtxt fam_name\n    pp_lhs    = pprHsFamInstLHS fam_name mb_bndrs hs_pats fixity hs_ctxt\n    exp_bndrs = mb_bndrs `orElse` []\n\n    -- See Note [Result kind signature for a data family instance]\n    tc_kind_sig Nothing\n      = return liftedTypeKind\n    tc_kind_sig (Just hs_kind)\n      = do { sig_kind <- tcLHsKindSig data_ctxt hs_kind\n           ; let (tvs, inner_kind) = tcSplitForAllTys sig_kind\n           ; lvl <- getTcLevel\n           ; (subst, _tvs') <- tcInstSkolTyVarsAt lvl False emptyTCvSubst tvs\n             -- Perhaps surprisingly, we don't need the skolemised tvs themselves\n           ; return (substTy subst inner_kind) }\n\n{- Note [Result kind signature for a data family instance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe expected type might have a forall at the type. Normally, we\ncan't skolemise in kinds because we don't have type-level lambda.\nBut here, we're at the top-level of an instance declaration, so\nwe actually have a place to put the regeneralised variables.\nThus: skolemise away. cf. Inst.deeplySkolemise and TcUnify.tcSkolemise\nExamples in indexed-types/should_compile/T12369\n\nNote [Eta-reduction for data families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   data D :: * -> * -> * -> * -> *\n\n   data instance D [(a,b)] p q :: * -> * where\n      D1 :: blah1\n      D2 :: blah2\n\nThen we'll generate a representation data type\n  data Drep a b p q z where\n      D1 :: blah1\n      D2 :: blah2\n\nand an axiom to connect them\n  axiom AxDrep forall a b p q z. D [(a,b]] p q z = Drep a b p q z\n\nexcept that we'll eta-reduce the axiom to\n  axiom AxDrep forall a b. D [(a,b]] = Drep a b\nThere are several fiddly subtleties lurking here\n\n* The representation tycon Drep is parameerised over the free\n  variables of the pattern, in no particular order. So there is no\n  guarantee that 'p' and 'q' will come last in Drep's parameters, and\n  in the right order.  So, if the /patterns/ of the family insatance\n  are eta-redcible, we re-order Drep's parameters to put the\n  eta-reduced type variables last.\n\n* Although we eta-reduce the axiom, we eta-/expand/ the representation\n  tycon Drep.  The kind of D says it takses four arguments, but the\n  data instance header only supplies three.  But the AlgTyCOn for Drep\n  itself must have enough TyConBinders so that its result kind is Type.\n  So, with etaExpandAlgTyCon we make up some extra TyConBinders\n\n* The result kind in the instance might be a polykind, like this:\n     data family DP a :: forall k. k -> *\n     data instance DP [b] :: forall k1 k2. (k1,k2) -> *\n\n  So in type-checking the LHS (DP Int) we need to check that it is\n  more polymorphic than the signature.  To do that we must skolemise\n  the siganture and istantiate the call of DP.  So we end up with\n     data instance DP [b] @(k1,k2) (z :: (k1,k2)) where\n\n  Note that we must parameterise the representation tycon DPrep over\n  'k1' and 'k2', as well as 'b'.\n\n  The skolemise bit is done in tc_kind_sig, while the instantiate bit\n  is done by tcFamTyPats.\n\n* Very fiddly point.  When we eta-reduce to\n     axiom AxDrep forall a b. D [(a,b]] = Drep a b\n\n  we want the kind of (D [(a,b)]) to be the same as the kind of\n  (Drep a b).  This ensures that applying the axiom doesn't change the\n  kind.  Why is that hard?  Because the kind of (Drep a b) depends on\n  the TyConBndrVis on Drep's arguments. In particular do we have\n    (forall (k::*). blah) or (* -> blah)?\n\n  We must match whatever D does!  In Trac #15817 we had\n      data family X a :: forall k. * -> *   -- Note: a forall that is not used\n      data instance X Int b = MkX\n\n  So the data instance is really\n      data istance X Int @k b = MkX\n\n  The axiom will look like\n      axiom    X Int = Xrep\n\n  and it's important that XRep :: forall k * -> *, following X.\n\n  To achieve this we get the TyConBndrVis flags from tcbVisibilities,\n  and use those flags for any eta-reduced arguments.  Sigh.\n\n* The final turn of the knife is that tcbVisibilities is itself\n  tricky to sort out.  Consider\n      data family D k :: k\n  Then consider D (forall k2. k2 -> k2) Type Type\n  The visibilty flags on an application of D may affected by the arguments\n  themselves.  Heavy sigh.  But not truly hard; that's what tcbVisibilities\n  does.\n\n-}\n\n\n{- *********************************************************************\n*                                                                      *\n      Class instance declarations, pass 2\n*                                                                      *\n********************************************************************* -}\n\ntcInstDecls2 :: [LTyClDecl GhcRn] -> [InstInfo GhcRn]\n             -> TcM (LHsBinds GhcTc)\n-- (a) From each class declaration,\n--      generate any default-method bindings\n-- (b) From each instance decl\n--      generate the dfun binding\n\ntcInstDecls2 tycl_decls inst_decls\n  = do  { -- (a) Default methods from class decls\n          let class_decls = filter (isClassDecl . unLoc) tycl_decls\n        ; dm_binds_s <- mapM tcClassDecl2 class_decls\n        ; let dm_binds = unionManyBags dm_binds_s\n\n          -- (b) instance declarations\n        ; let dm_ids = collectHsBindsBinders dm_binds\n              -- Add the default method Ids (again)\n              -- (they were arready added in TcTyDecls.tcAddImplicits)\n              -- See Note [Default methods in the type environment]\n        ; inst_binds_s <- tcExtendGlobalValEnv dm_ids $\n                          mapM tcInstDecl2 inst_decls\n\n          -- Done\n        ; return (dm_binds `unionBags` unionManyBags inst_binds_s) }\n\n{- Note [Default methods in the type environment]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe default method Ids are already in the type environment (see Note\n[Default method Ids and Template Haskell] in TcTyDcls), BUT they\ndon't have their InlinePragmas yet.  Usually that would not matter,\nbecause the simplifier propagates information from binding site to\nuse.  But, unusually, when compiling instance decls we *copy* the\nINLINE pragma from the default method to the method for that\nparticular operation (see Note [INLINE and default methods] below).\n\nSo right here in tcInstDecls2 we must re-extend the type envt with\nthe default method Ids replete with their INLINE pragmas.  Urk.\n-}\n\ntcInstDecl2 :: InstInfo GhcRn -> TcM (LHsBinds GhcTc)\n            -- Returns a binding for the dfun\ntcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })\n  = recoverM (return emptyLHsBinds)             $\n    setSrcSpan loc                              $\n    addErrCtxt (instDeclCtxt2 (idType dfun_id)) $\n    do {  -- Instantiate the instance decl with skolem constants\n       ; (inst_tyvars, dfun_theta, inst_head) <- tcSkolDFunType dfun_id\n       ; dfun_ev_vars <- newEvVars dfun_theta\n                     -- We instantiate the dfun_id with superSkolems.\n                     -- See Note [Subtle interaction of recursion and overlap]\n                     -- and Note [Binding when looking up instances]\n\n       ; let (clas, inst_tys) = tcSplitDFunHead inst_head\n             (class_tyvars, sc_theta, _, op_items) = classBigSig clas\n             sc_theta' = substTheta (zipTvSubst class_tyvars inst_tys) sc_theta\n\n       ; traceTc \"tcInstDecl2\" (vcat [ppr inst_tyvars, ppr inst_tys, ppr dfun_theta, ppr sc_theta'])\n\n                      -- Deal with 'SPECIALISE instance' pragmas\n                      -- See Note [SPECIALISE instance pragmas]\n       ; spec_inst_info@(spec_inst_prags,_) <- tcSpecInstPrags dfun_id ibinds\n\n         -- Typecheck superclasses and methods\n         -- See Note [Typechecking plan for instance declarations]\n       ; dfun_ev_binds_var <- newTcEvBinds\n       ; let dfun_ev_binds = TcEvBinds dfun_ev_binds_var\n       ; (tclvl, (sc_meth_ids, sc_meth_binds, sc_meth_implics))\n             <- pushTcLevelM $\n                do { (sc_ids, sc_binds, sc_implics)\n                        <- tcSuperClasses dfun_id clas inst_tyvars dfun_ev_vars\n                                          inst_tys dfun_ev_binds\n                                          sc_theta'\n\n                      -- Typecheck the methods\n                   ; (meth_ids, meth_binds, meth_implics)\n                        <- tcMethods dfun_id clas inst_tyvars dfun_ev_vars\n                                     inst_tys dfun_ev_binds spec_inst_info\n                                     op_items ibinds\n\n                   ; return ( sc_ids     ++          meth_ids\n                            , sc_binds   `unionBags` meth_binds\n                            , sc_implics `unionBags` meth_implics ) }\n\n       ; imp <- newImplication\n       ; emitImplication $\n         imp { ic_tclvl  = tclvl\n             , ic_skols  = inst_tyvars\n             , ic_given  = dfun_ev_vars\n             , ic_wanted = mkImplicWC sc_meth_implics\n             , ic_binds  = dfun_ev_binds_var\n             , ic_info   = InstSkol }\n\n       -- Create the result bindings\n       ; self_dict <- newDict clas inst_tys\n       ; let class_tc      = classTyCon clas\n             [dict_constr] = tyConDataCons class_tc\n             dict_bind     = mkVarBind self_dict (L loc con_app_args)\n\n                     -- We don't produce a binding for the dict_constr; instead we\n                     -- rely on the simplifier to unfold this saturated application\n                     -- We do this rather than generate an HsCon directly, because\n                     -- it means that the special cases (e.g. dictionary with only one\n                     -- member) are dealt with by the common MkId.mkDataConWrapId\n                     -- code rather than needing to be repeated here.\n                     --    con_app_tys  = MkD ty1 ty2\n                     --    con_app_scs  = MkD ty1 ty2 sc1 sc2\n                     --    con_app_args = MkD ty1 ty2 sc1 sc2 op1 op2\n             con_app_tys  = mkHsWrap (mkWpTyApps inst_tys)\n                                  (HsConLikeOut noExt (RealDataCon dict_constr))\n                       -- NB: We *can* have covars in inst_tys, in the case of\n                       -- promoted GADT constructors.\n\n             con_app_args = foldl' app_to_meth con_app_tys sc_meth_ids\n\n             app_to_meth :: HsExpr GhcTc -> Id -> HsExpr GhcTc\n             app_to_meth fun meth_id = HsApp noExt (L loc fun)\n                                            (L loc (wrapId arg_wrapper meth_id))\n\n             inst_tv_tys = mkTyVarTys inst_tyvars\n             arg_wrapper = mkWpEvVarApps dfun_ev_vars <.> mkWpTyApps inst_tv_tys\n\n             is_newtype = isNewTyCon class_tc\n             dfun_id_w_prags = addDFunPrags dfun_id sc_meth_ids\n             dfun_spec_prags\n                | is_newtype = SpecPrags []\n                | otherwise  = SpecPrags spec_inst_prags\n                    -- Newtype dfuns just inline unconditionally,\n                    -- so don't attempt to specialise them\n\n             export = ABE { abe_ext  = noExt\n                          , abe_wrap = idHsWrapper\n                          , abe_poly = dfun_id_w_prags\n                          , abe_mono = self_dict\n                          , abe_prags = dfun_spec_prags }\n                          -- NB: see Note [SPECIALISE instance pragmas]\n             main_bind = AbsBinds { abs_ext = noExt\n                                  , abs_tvs = inst_tyvars\n                                  , abs_ev_vars = dfun_ev_vars\n                                  , abs_exports = [export]\n                                  , abs_ev_binds = []\n                                  , abs_binds = unitBag dict_bind\n                                  , abs_sig = True }\n\n       ; return (unitBag (L loc main_bind) `unionBags` sc_meth_binds)\n       }\n where\n   dfun_id = instanceDFunId ispec\n   loc     = getSrcSpan dfun_id\n\naddDFunPrags :: DFunId -> [Id] -> DFunId\n-- DFuns need a special Unfolding and InlinePrag\n--    See Note [ClassOp/DFun selection]\n--    and Note [Single-method classes]\n-- It's easiest to create those unfoldings right here, where\n-- have all the pieces in hand, even though we are messing with\n-- Core at this point, which the typechecker doesn't usually do\n-- However we take care to build the unfolding using the TyVars from\n-- the DFunId rather than from the skolem pieces that the typechecker\n-- is messing with.\naddDFunPrags dfun_id sc_meth_ids\n | is_newtype\n  = dfun_id `setIdUnfolding`  mkInlineUnfoldingWithArity 0 con_app\n            `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 }\n | otherwise\n = dfun_id `setIdUnfolding`  mkDFunUnfolding dfun_bndrs dict_con dict_args\n           `setInlinePragma` dfunInlinePragma\n where\n   con_app    = mkLams dfun_bndrs $\n                mkApps (Var (dataConWrapId dict_con)) dict_args\n                 -- mkApps is OK because of the checkForLevPoly call in checkValidClass\n                 -- See Note [Levity polymorphism checking] in DsMonad\n   dict_args  = map Type inst_tys ++\n                [mkVarApps (Var id) dfun_bndrs | id <- sc_meth_ids]\n\n   (dfun_tvs, dfun_theta, clas, inst_tys) = tcSplitDFunTy (idType dfun_id)\n   ev_ids      = mkTemplateLocalsNum 1                    dfun_theta\n   dfun_bndrs  = dfun_tvs ++ ev_ids\n   clas_tc     = classTyCon clas\n   [dict_con]  = tyConDataCons clas_tc\n   is_newtype  = isNewTyCon clas_tc\n\nwrapId :: HsWrapper -> IdP (GhcPass id) -> HsExpr (GhcPass id)\nwrapId wrapper id = mkHsWrap wrapper (HsVar noExt (noLoc id))\n\n{- Note [Typechecking plan for instance declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor instance declarations we generate the following bindings and implication\nconstraints.  Example:\n\n   instance Ord a => Ord [a] where compare = <compare-rhs>\n\ngenerates this:\n\n   Bindings:\n      -- Method bindings\n      $ccompare :: forall a. Ord a => a -> a -> Ordering\n      $ccompare = /\\a \\(d:Ord a). let <meth-ev-binds> in ...\n\n      -- Superclass bindings\n      $cp1Ord :: forall a. Ord a => Eq [a]\n      $cp1Ord = /\\a \\(d:Ord a). let <sc-ev-binds>\n               in dfEqList (dw :: Eq a)\n\n   Constraints:\n      forall a. Ord a =>\n                -- Method constraint\n             (forall. (empty) => <constraints from compare-rhs>)\n                -- Superclass constraint\n          /\\ (forall. (empty) => dw :: Eq a)\n\nNotice that\n\n * Per-meth/sc implication.  There is one inner implication per\n   superclass or method, with no skolem variables or givens.  The only\n   reason for this one is to gather the evidence bindings privately\n   for this superclass or method.  This implication is generated\n   by checkInstConstraints.\n\n * Overall instance implication. There is an overall enclosing\n   implication for the whole instance declaration, with the expected\n   skolems and givens.  We need this to get the correct \"redundant\n   constraint\" warnings, gathering all the uses from all the methods\n   and superclasses.  See TcSimplify Note [Tracking redundant\n   constraints]\n\n * The given constraints in the outer implication may generate\n   evidence, notably by superclass selection.  Since the method and\n   superclass bindings are top-level, we want that evidence copied\n   into *every* method or superclass definition.  (Some of it will\n   be usused in some, but dead-code elimination will drop it.)\n\n   We achieve this by putting the evidence variable for the overall\n   instance implication into the AbsBinds for each method/superclass.\n   Hence the 'dfun_ev_binds' passed into tcMethods and tcSuperClasses.\n   (And that in turn is why the abs_ev_binds field of AbBinds is a\n   [TcEvBinds] rather than simply TcEvBinds.\n\n   This is a bit of a hack, but works very nicely in practice.\n\n * Note that if a method has a locally-polymorphic binding, there will\n   be yet another implication for that, generated by tcPolyCheck\n   in tcMethodBody. E.g.\n          class C a where\n            foo :: forall b. Ord b => blah\n\n\n************************************************************************\n*                                                                      *\n      Type-checking superclasses\n*                                                                      *\n************************************************************************\n-}\n\ntcSuperClasses :: DFunId -> Class -> [TcTyVar] -> [EvVar] -> [TcType]\n               -> TcEvBinds\n               -> TcThetaType\n               -> TcM ([EvVar], LHsBinds GhcTc, Bag Implication)\n-- Make a new top-level function binding for each superclass,\n-- something like\n--    $Ordp1 :: forall a. Ord a => Eq [a]\n--    $Ordp1 = /\\a \\(d:Ord a). dfunEqList a (sc_sel d)\n--\n-- See Note [Recursive superclasses] for why this is so hard!\n-- In effect, we build a special-purpose solver for the first step\n-- of solving each superclass constraint\ntcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds sc_theta\n  = do { (ids, binds, implics) <- mapAndUnzip3M tc_super (zip sc_theta [fIRST_TAG..])\n       ; return (ids, listToBag binds, listToBag implics) }\n  where\n    loc = getSrcSpan dfun_id\n    size = sizeTypes inst_tys\n    tc_super (sc_pred, n)\n      = do { (sc_implic, ev_binds_var, sc_ev_tm)\n                <- checkInstConstraints $ emitWanted (ScOrigin size) sc_pred\n\n           ; sc_top_name  <- newName (mkSuperDictAuxOcc n (getOccName cls))\n           ; sc_ev_id     <- newEvVar sc_pred\n           ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id sc_ev_tm\n           ; let sc_top_ty = mkInvForAllTys tyvars $\n                             mkPhiTy (map idType dfun_evs) sc_pred\n                 sc_top_id = mkLocalId sc_top_name sc_top_ty\n                 export = ABE { abe_ext  = noExt\n                              , abe_wrap = idHsWrapper\n                              , abe_poly = sc_top_id\n                              , abe_mono = sc_ev_id\n                              , abe_prags = noSpecPrags }\n                 local_ev_binds = TcEvBinds ev_binds_var\n                 bind = AbsBinds { abs_ext      = noExt\n                                 , abs_tvs      = tyvars\n                                 , abs_ev_vars  = dfun_evs\n                                 , abs_exports  = [export]\n                                 , abs_ev_binds = [dfun_ev_binds, local_ev_binds]\n                                 , abs_binds    = emptyBag\n                                 , abs_sig      = False }\n           ; return (sc_top_id, L loc bind, sc_implic) }\n\n-------------------\ncheckInstConstraints :: TcM result\n                     -> TcM (Implication, EvBindsVar, result)\n-- See Note [Typechecking plan for instance declarations]\ncheckInstConstraints thing_inside\n  = do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints  $\n                                    thing_inside\n\n       ; ev_binds_var <- newTcEvBinds\n       ; implic <- newImplication\n       ; let implic' = implic { ic_tclvl  = tclvl\n                              , ic_wanted = wanted\n                              , ic_binds  = ev_binds_var\n                              , ic_info   = InstSkol }\n\n       ; return (implic', ev_binds_var, result) }\n\n{-\nNote [Recursive superclasses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee Trac #3731, #4809, #5751, #5913, #6117, #6161, which all\ndescribe somewhat more complicated situations, but ones\nencountered in practice.\n\nSee also tests tcrun020, tcrun021, tcrun033, and Trac #11427.\n\n----- THE PROBLEM --------\nThe problem is that it is all too easy to create a class whose\nsuperclass is bottom when it should not be.\n\nConsider the following (extreme) situation:\n        class C a => D a where ...\n        instance D [a] => D [a] where ...   (dfunD)\n        instance C [a] => C [a] where ...   (dfunC)\nAlthough this looks wrong (assume D [a] to prove D [a]), it is only a\nmore extreme case of what happens with recursive dictionaries, and it\ncan, just about, make sense because the methods do some work before\nrecursing.\n\nTo implement the dfunD we must generate code for the superclass C [a],\nwhich we had better not get by superclass selection from the supplied\nargument:\n       dfunD :: forall a. D [a] -> D [a]\n       dfunD = \\d::D [a] -> MkD (scsel d) ..\n\nOtherwise if we later encounter a situation where\nwe have a [Wanted] dw::D [a] we might solve it thus:\n     dw := dfunD dw\nWhich is all fine except that now ** the superclass C is bottom **!\n\nThe instance we want is:\n       dfunD :: forall a. D [a] -> D [a]\n       dfunD = \\d::D [a] -> MkD (dfunC (scsel d)) ...\n\n----- THE SOLUTION --------\nThe basic solution is simple: be very careful about using superclass\nselection to generate a superclass witness in a dictionary function\ndefinition.  More precisely:\n\n  Superclass Invariant: in every class dictionary,\n                        every superclass dictionary field\n                        is non-bottom\n\nTo achieve the Superclass Invariant, in a dfun definition we can\ngenerate a guaranteed-non-bottom superclass witness from:\n  (sc1) one of the dictionary arguments itself (all non-bottom)\n  (sc2) an immediate superclass of a smaller dictionary\n  (sc3) a call of a dfun (always returns a dictionary constructor)\n\nThe tricky case is (sc2).  We proceed by induction on the size of\nthe (type of) the dictionary, defined by TcValidity.sizeTypes.\nLet's suppose we are building a dictionary of size 3, and\nsuppose the Superclass Invariant holds of smaller dictionaries.\nThen if we have a smaller dictionary, its immediate superclasses\nwill be non-bottom by induction.\n\nWhat does \"we have a smaller dictionary\" mean?  It might be\none of the arguments of the instance, or one of its superclasses.\nHere is an example, taken from CmmExpr:\n       class Ord r => UserOfRegs r a where ...\n(i1)   instance UserOfRegs r a => UserOfRegs r (Maybe a) where\n(i2)   instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where\n\nFor (i1) we can get the (Ord r) superclass by selection from (UserOfRegs r a),\nsince it is smaller than the thing we are building (UserOfRegs r (Maybe a).\n\nBut for (i2) that isn't the case, so we must add an explicit, and\nperhaps surprising, (Ord r) argument to the instance declaration.\n\nHere's another example from Trac #6161:\n\n       class       Super a => Duper a  where ...\n       class Duper (Fam a) => Foo a    where ...\n(i3)   instance Foo a => Duper (Fam a) where ...\n(i4)   instance              Foo Float where ...\n\nIt would be horribly wrong to define\n   dfDuperFam :: Foo a -> Duper (Fam a)  -- from (i3)\n   dfDuperFam d = MkDuper (sc_sel1 (sc_sel2 d)) ...\n\n   dfFooFloat :: Foo Float               -- from (i4)\n   dfFooFloat = MkFoo (dfDuperFam dfFooFloat) ...\n\nNow the Super superclass of Duper is definitely bottom!\n\nThis won't happen because when processing (i3) we can use the\nsuperclasses of (Foo a), which is smaller, namely Duper (Fam a).  But\nthat is *not* smaller than the target so we can't take *its*\nsuperclasses.  As a result the program is rightly rejected, unless you\nadd (Super (Fam a)) to the context of (i3).\n\nNote [Solving superclass constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHow do we ensure that every superclass witness is generated by\none of (sc1) (sc2) or (sc3) in Note [Recursive superclasses].\nAnswer:\n\n  * Superclass \"wanted\" constraints have CtOrigin of (ScOrigin size)\n    where 'size' is the size of the instance declaration. e.g.\n          class C a => D a where...\n          instance blah => D [a] where ...\n    The wanted superclass constraint for C [a] has origin\n    ScOrigin size, where size = size( D [a] ).\n\n  * (sc1) When we rewrite such a wanted constraint, it retains its\n    origin.  But if we apply an instance declaration, we can set the\n    origin to (ScOrigin infinity), thus lifting any restrictions by\n    making prohibitedSuperClassSolve return False.\n\n  * (sc2) ScOrigin wanted constraints can't be solved from a\n    superclass selection, except at a smaller type.  This test is\n    implemented by TcInteract.prohibitedSuperClassSolve\n\n  * The \"given\" constraints of an instance decl have CtOrigin\n    GivenOrigin InstSkol.\n\n  * When we make a superclass selection from InstSkol we use\n    a SkolemInfo of (InstSC size), where 'size' is the size of\n    the constraint whose superclass we are taking.  A similarly\n    when taking the superclass of an InstSC.  This is implemented\n    in TcCanonical.newSCWorkFromFlavored\n\nNote [Silent superclass arguments] (historical interest only)\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNB1: this note describes our *old* solution to the\n     recursive-superclass problem. I'm keeping the Note\n     for now, just as institutional memory.\n     However, the code for silent superclass arguments\n     was removed in late Dec 2014\n\nNB2: the silent-superclass solution introduced new problems\n     of its own, in the form of instance overlap.  Tests\n     SilentParametersOverlapping, T5051, and T7862 are examples\n\nNB3: the silent-superclass solution also generated tons of\n     extra dictionaries.  For example, in monad-transformer\n     code, when constructing a Monad dictionary you had to pass\n     an Applicative dictionary; and to construct that you neede\n     a Functor dictionary. Yet these extra dictionaries were\n     often never used.  Test T3064 compiled *far* faster after\n     silent superclasses were eliminated.\n\nOur solution to this problem \"silent superclass arguments\".  We pass\nto each dfun some ``silent superclass arguments\u00e2\u20ac\u2122\u00e2\u20ac\u2122, which are the\nimmediate superclasses of the dictionary we are trying to\nconstruct. In our example:\n       dfun :: forall a. C [a] -> D [a] -> D [a]\n       dfun = \\(dc::C [a]) (dd::D [a]) -> DOrd dc ...\nNotice the extra (dc :: C [a]) argument compared to the previous version.\n\nThis gives us:\n\n     -----------------------------------------------------------\n     DFun Superclass Invariant\n     ~~~~~~~~~~~~~~~~~~~~~~~~\n     In the body of a DFun, every superclass argument to the\n     returned dictionary is\n       either   * one of the arguments of the DFun,\n       or       * constant, bound at top level\n     -----------------------------------------------------------\n\nThis net effect is that it is safe to treat a dfun application as\nwrapping a dictionary constructor around its arguments (in particular,\na dfun never picks superclasses from the arguments under the\ndictionary constructor). No superclass is hidden inside a dfun\napplication.\n\nThe extra arguments required to satisfy the DFun Superclass Invariant\nalways come first, and are called the \"silent\" arguments.  You can\nfind out how many silent arguments there are using Id.dfunNSilent;\nand then you can just drop that number of arguments to see the ones\nthat were in the original instance declaration.\n\nDFun types are built (only) by MkId.mkDictFunId, so that is where we\ndecide what silent arguments are to be added.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n      Type-checking an instance method\n*                                                                      *\n************************************************************************\n\ntcMethod\n- Make the method bindings, as a [(NonRec, HsBinds)], one per method\n- Remembering to use fresh Name (the instance method Name) as the binder\n- Bring the instance method Ids into scope, for the benefit of tcInstSig\n- Use sig_fn mapping instance method Name -> instance tyvars\n- Ditto prag_fn\n- Use tcValBinds to do the checking\n-}\n\ntcMethods :: DFunId -> Class\n          -> [TcTyVar] -> [EvVar]\n          -> [TcType]\n          -> TcEvBinds\n          -> ([Located TcSpecPrag], TcPragEnv)\n          -> [ClassOpItem]\n          -> InstBindings GhcRn\n          -> TcM ([Id], LHsBinds GhcTc, Bag Implication)\n        -- The returned inst_meth_ids all have types starting\n        --      forall tvs. theta => ...\ntcMethods dfun_id clas tyvars dfun_ev_vars inst_tys\n                  dfun_ev_binds (spec_inst_prags, prag_fn) op_items\n                  (InstBindings { ib_binds      = binds\n                                , ib_tyvars     = lexical_tvs\n                                , ib_pragmas    = sigs\n                                , ib_extensions = exts\n                                , ib_derived    = is_derived })\n  = tcExtendNameTyVarEnv (lexical_tvs `zip` tyvars) $\n       -- The lexical_tvs scope over the 'where' part\n    do { traceTc \"tcInstMeth\" (ppr sigs $$ ppr binds)\n       ; checkMinimalDefinition\n       ; checkMethBindMembership\n       ; (ids, binds, mb_implics) <- set_exts exts $\n                                     unset_warnings_deriving $\n                                     mapAndUnzip3M tc_item op_items\n       ; return (ids, listToBag binds, listToBag (catMaybes mb_implics)) }\n  where\n    set_exts :: [LangExt.Extension] -> TcM a -> TcM a\n    set_exts es thing = foldr setXOptM thing es\n\n    -- See Note [Avoid -Winaccessible-code when deriving]\n    unset_warnings_deriving :: TcM a -> TcM a\n    unset_warnings_deriving\n      | is_derived = unsetWOptM Opt_WarnInaccessibleCode\n      | otherwise  = id\n\n    hs_sig_fn = mkHsSigFun sigs\n    inst_loc  = getSrcSpan dfun_id\n\n    ----------------------\n    tc_item :: ClassOpItem -> TcM (Id, LHsBind GhcTc, Maybe Implication)\n    tc_item (sel_id, dm_info)\n      | Just (user_bind, bndr_loc, prags) <- findMethodBind (idName sel_id) binds prag_fn\n      = tcMethodBody clas tyvars dfun_ev_vars inst_tys\n                              dfun_ev_binds is_derived hs_sig_fn\n                              spec_inst_prags prags\n                              sel_id user_bind bndr_loc\n      | otherwise\n      = do { traceTc \"tc_def\" (ppr sel_id)\n           ; tc_default sel_id dm_info }\n\n    ----------------------\n    tc_default :: Id -> DefMethInfo\n               -> TcM (TcId, LHsBind GhcTc, Maybe Implication)\n\n    tc_default sel_id (Just (dm_name, _))\n      = do { (meth_bind, inline_prags) <- mkDefMethBind clas inst_tys sel_id dm_name\n           ; tcMethodBody clas tyvars dfun_ev_vars inst_tys\n                          dfun_ev_binds is_derived hs_sig_fn\n                          spec_inst_prags inline_prags\n                          sel_id meth_bind inst_loc }\n\n    tc_default sel_id Nothing     -- No default method at all\n      = do { traceTc \"tc_def: warn\" (ppr sel_id)\n           ; (meth_id, _) <- mkMethIds clas tyvars dfun_ev_vars\n                                       inst_tys sel_id\n           ; dflags <- getDynFlags\n           ; let meth_bind = mkVarBind meth_id $\n                             mkLHsWrap lam_wrapper (error_rhs dflags)\n           ; return (meth_id, meth_bind, Nothing) }\n      where\n        error_rhs dflags = L inst_loc $ HsApp noExt error_fun (error_msg dflags)\n        error_fun    = L inst_loc $\n                       wrapId (mkWpTyApps\n                                [ getRuntimeRep meth_tau, meth_tau])\n                              nO_METHOD_BINDING_ERROR_ID\n        error_msg dflags = L inst_loc (HsLit noExt (HsStringPrim NoSourceText\n                                              (unsafeMkByteString (error_string dflags))))\n        meth_tau     = funResultTy (piResultTys (idType sel_id) inst_tys)\n        error_string dflags = showSDoc dflags\n                              (hcat [ppr inst_loc, vbar, ppr sel_id ])\n        lam_wrapper  = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars\n\n    ----------------------\n    -- Check if one of the minimal complete definitions is satisfied\n    checkMinimalDefinition\n      = whenIsJust (isUnsatisfied methodExists (classMinimalDef clas)) $\n        warnUnsatisfiedMinimalDefinition\n\n    methodExists meth = isJust (findMethodBind meth binds prag_fn)\n\n    ----------------------\n    -- Check if any method bindings do not correspond to the class.\n    -- See Note [Mismatched class methods and associated type families].\n    checkMethBindMembership\n      = mapM_ (addErrTc . badMethodErr clas) mismatched_meths\n      where\n        bind_nms         = map unLoc $ collectMethodBinders binds\n        cls_meth_nms     = map (idName . fst) op_items\n        mismatched_meths = bind_nms `minusList` cls_meth_nms\n\n{-\nNote [Mismatched class methods and associated type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's entirely possible for someone to put methods or associated type family\ninstances inside of a class in which it doesn't belong. For instance, we'd\nwant to fail if someone wrote this:\n\n  instance Eq () where\n    type Rep () = Maybe\n    compare = undefined\n\nSince neither the type family `Rep` nor the method `compare` belong to the\nclass `Eq`. Normally, this is caught in the renamer when resolving RdrNames,\nsince that would discover that the parent class `Eq` is incorrect.\n\nHowever, there is a scenario in which the renamer could fail to catch this:\nif the instance was generated through Template Haskell, as in #12387. In that\ncase, Template Haskell will provide fully resolved names (e.g.,\n`GHC.Classes.compare`), so the renamer won't notice the sleight-of-hand going\non. For this reason, we also put an extra validity check for this in the\ntypechecker as a last resort.\n\nNote [Avoid -Winaccessible-code when deriving]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-Winaccessible-code can be particularly noisy when deriving instances for\nGADTs. Consider the following example (adapted from #8128):\n\n  data T a where\n    MkT1 :: Int -> T Int\n    MkT2 :: T Bool\n    MkT3 :: T Bool\n  deriving instance Eq (T a)\n  deriving instance Ord (T a)\n\nIn the derived Ord instance, GHC will generate the following code:\n\n  instance Ord (T a) where\n    compare x y\n      = case x of\n          MkT2\n            -> case y of\n                 MkT1 {} -> GT\n                 MkT2    -> EQ\n                 _       -> LT\n          ...\n\nHowever, that MkT1 is unreachable, since the type indices for MkT1 and MkT2\ndiffer, so if -Winaccessible-code is enabled, then deriving this instance will\nresult in unwelcome warnings.\n\nOne conceivable approach to fixing this issue would be to change `deriving Ord`\nsuch that it becomes smarter about not generating unreachable cases. This,\nhowever, would be a highly nontrivial refactor, as we'd have to propagate\nthrough typing information everywhere in the algorithm that generates Ord\ninstances in order to determine which cases were unreachable. This seems like\na lot of work for minimal gain, so we have opted not to go for this approach.\n\nInstead, we take the much simpler approach of always disabling\n-Winaccessible-code for derived code. To accomplish this, we do the following:\n\n1. In tcMethods (which typechecks method bindings), disable\n   -Winaccessible-code.\n2. When creating Implications during typechecking, record the Env\n   (through ic_env) at the time of creation. Since the Env also stores\n   DynFlags, this will remember that -Winaccessible-code was disabled over\n   the scope of that implication.\n3. After typechecking comes error reporting, where GHC must decide how to\n   report inaccessible code to the user, on an Implication-by-Implication\n   basis. If an Implication's DynFlags indicate that -Winaccessible-code was\n   disabled, then don't bother reporting it. That's it!\n-}\n\n------------------------\ntcMethodBody :: Class -> [TcTyVar] -> [EvVar] -> [TcType]\n             -> TcEvBinds -> Bool\n             -> HsSigFun\n             -> [LTcSpecPrag] -> [LSig GhcRn]\n             -> Id -> LHsBind GhcRn -> SrcSpan\n             -> TcM (TcId, LHsBind GhcTc, Maybe Implication)\ntcMethodBody clas tyvars dfun_ev_vars inst_tys\n                     dfun_ev_binds is_derived\n                     sig_fn spec_inst_prags prags\n                     sel_id (L bind_loc meth_bind) bndr_loc\n  = add_meth_ctxt $\n    do { traceTc \"tcMethodBody\" (ppr sel_id <+> ppr (idType sel_id) $$ ppr bndr_loc)\n       ; (global_meth_id, local_meth_id) <- setSrcSpan bndr_loc $\n                                            mkMethIds clas tyvars dfun_ev_vars\n                                                      inst_tys sel_id\n\n       ; let lm_bind = meth_bind { fun_id = L bndr_loc (idName local_meth_id) }\n                       -- Substitute the local_meth_name for the binder\n                       -- NB: the binding is always a FunBind\n\n            -- taking instance signature into account might change the type of\n            -- the local_meth_id\n       ; (meth_implic, ev_binds_var, tc_bind)\n             <- checkInstConstraints $\n                tcMethodBodyHelp sig_fn sel_id local_meth_id (L bind_loc lm_bind)\n\n       ; global_meth_id <- addInlinePrags global_meth_id prags\n       ; spec_prags     <- tcSpecPrags global_meth_id prags\n\n        ; let specs  = mk_meth_spec_prags global_meth_id spec_inst_prags spec_prags\n              export = ABE { abe_ext   = noExt\n                           , abe_poly  = global_meth_id\n                           , abe_mono  = local_meth_id\n                           , abe_wrap  = idHsWrapper\n                           , abe_prags = specs }\n\n              local_ev_binds = TcEvBinds ev_binds_var\n              full_bind = AbsBinds { abs_ext      = noExt\n                                   , abs_tvs      = tyvars\n                                   , abs_ev_vars  = dfun_ev_vars\n                                   , abs_exports  = [export]\n                                   , abs_ev_binds = [dfun_ev_binds, local_ev_binds]\n                                   , abs_binds    = tc_bind\n                                   , abs_sig      = True }\n\n        ; return (global_meth_id, L bind_loc full_bind, Just meth_implic) }\n  where\n        -- For instance decls that come from deriving clauses\n        -- we want to print out the full source code if there's an error\n        -- because otherwise the user won't see the code at all\n    add_meth_ctxt thing\n      | is_derived = addLandmarkErrCtxt (derivBindCtxt sel_id clas inst_tys) thing\n      | otherwise  = thing\n\ntcMethodBodyHelp :: HsSigFun -> Id -> TcId\n                 -> LHsBind GhcRn -> TcM (LHsBinds GhcTcId)\ntcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind\n  | Just hs_sig_ty <- hs_sig_fn sel_name\n              -- There is a signature in the instance\n              -- See Note [Instance method signatures]\n  = do { let ctxt = FunSigCtxt sel_name True\n       ; (sig_ty, hs_wrap)\n             <- setSrcSpan (getLoc (hsSigType hs_sig_ty)) $\n                do { inst_sigs <- xoptM LangExt.InstanceSigs\n                   ; checkTc inst_sigs (misplacedInstSig sel_name hs_sig_ty)\n                   ; sig_ty  <- tcHsSigType (FunSigCtxt sel_name False) hs_sig_ty\n                   ; let local_meth_ty = idType local_meth_id\n                   ; hs_wrap <- addErrCtxtM (methSigCtxt sel_name sig_ty local_meth_ty) $\n                                tcSubType_NC ctxt sig_ty local_meth_ty\n                   ; return (sig_ty, hs_wrap) }\n\n       ; inner_meth_name <- newName (nameOccName sel_name)\n       ; let inner_meth_id  = mkLocalId inner_meth_name sig_ty\n             inner_meth_sig = CompleteSig { sig_bndr = inner_meth_id\n                                          , sig_ctxt = ctxt\n                                          , sig_loc  = getLoc (hsSigType hs_sig_ty) }\n\n\n       ; (tc_bind, [inner_id]) <- tcPolyCheck no_prag_fn inner_meth_sig meth_bind\n\n       ; let export = ABE { abe_ext   = noExt\n                          , abe_poly  = local_meth_id\n                          , abe_mono  = inner_id\n                          , abe_wrap  = hs_wrap\n                          , abe_prags = noSpecPrags }\n\n       ; return (unitBag $ L (getLoc meth_bind) $\n                 AbsBinds { abs_ext = noExt, abs_tvs = [], abs_ev_vars = []\n                          , abs_exports = [export]\n                          , abs_binds = tc_bind, abs_ev_binds = []\n                          , abs_sig = True }) }\n\n  | otherwise  -- No instance signature\n  = do { let ctxt = FunSigCtxt sel_name False\n                    -- False <=> don't report redundant constraints\n                    -- The signature is not under the users control!\n             tc_sig = completeSigFromId ctxt local_meth_id\n              -- Absent a type sig, there are no new scoped type variables here\n              -- Only the ones from the instance decl itself, which are already\n              -- in scope.  Example:\n              --      class C a where { op :: forall b. Eq b => ... }\n              --      instance C [c] where { op = <rhs> }\n              -- In <rhs>, 'c' is scope but 'b' is not!\n\n       ; (tc_bind, _) <- tcPolyCheck no_prag_fn tc_sig meth_bind\n       ; return tc_bind }\n\n  where\n    sel_name   = idName sel_id\n    no_prag_fn = emptyPragEnv   -- No pragmas for local_meth_id;\n                                -- they are all for meth_id\n\n\n------------------------\nmkMethIds :: Class -> [TcTyVar] -> [EvVar]\n          -> [TcType] -> Id -> TcM (TcId, TcId)\n             -- returns (poly_id, local_id), but ignoring any instance signature\n             -- See Note [Instance method signatures]\nmkMethIds clas tyvars dfun_ev_vars inst_tys sel_id\n  = do  { poly_meth_name  <- newName (mkClassOpAuxOcc sel_occ)\n        ; local_meth_name <- newName sel_occ\n                  -- Base the local_meth_name on the selector name, because\n                  -- type errors from tcMethodBody come from here\n        ; let poly_meth_id  = mkLocalId poly_meth_name  poly_meth_ty\n              local_meth_id = mkLocalId local_meth_name local_meth_ty\n\n        ; return (poly_meth_id, local_meth_id) }\n  where\n    sel_name      = idName sel_id\n    sel_occ       = nameOccName sel_name\n    local_meth_ty = instantiateMethod clas sel_id inst_tys\n    poly_meth_ty  = mkSpecSigmaTy tyvars theta local_meth_ty\n    theta         = map idType dfun_ev_vars\n\nmethSigCtxt :: Name -> TcType -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)\nmethSigCtxt sel_name sig_ty meth_ty env0\n  = do { (env1, sig_ty)  <- zonkTidyTcType env0 sig_ty\n       ; (env2, meth_ty) <- zonkTidyTcType env1 meth_ty\n       ; let msg = hang (text \"When checking that instance signature for\" <+> quotes (ppr sel_name))\n                      2 (vcat [ text \"is more general than its signature in the class\"\n                              , text \"Instance sig:\" <+> ppr sig_ty\n                              , text \"   Class sig:\" <+> ppr meth_ty ])\n       ; return (env2, msg) }\n\nmisplacedInstSig :: Name -> LHsSigType GhcRn -> SDoc\nmisplacedInstSig name hs_ty\n  = vcat [ hang (text \"Illegal type signature in instance declaration:\")\n              2 (hang (pprPrefixName name)\n                    2 (dcolon <+> ppr hs_ty))\n         , text \"(Use InstanceSigs to allow this)\" ]\n\n{- Note [Instance method signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWith -XInstanceSigs we allow the user to supply a signature for the\nmethod in an instance declaration.  Here is an artificial example:\n\n       data T a = MkT a\n       instance Ord a => Ord (T a) where\n         (>) :: forall b. b -> b -> Bool\n         (>) = error \"You can't compare Ts\"\n\nThe instance signature can be *more* polymorphic than the instantiated\nclass method (in this case: Age -> Age -> Bool), but it cannot be less\npolymorphic.  Moreover, if a signature is given, the implementation\ncode should match the signature, and type variables bound in the\nsingature should scope over the method body.\n\nWe achieve this by building a TcSigInfo for the method, whether or not\nthere is an instance method signature, and using that to typecheck\nthe declaration (in tcMethodBody).  That means, conveniently,\nthat the type variables bound in the signature will scope over the body.\n\nWhat about the check that the instance method signature is more\npolymorphic than the instantiated class method type?  We just do a\ntcSubType call in tcMethodBodyHelp, and generate a nested AbsBind, like\nthis (for the example above\n\n AbsBind { abs_tvs = [a], abs_ev_vars = [d:Ord a]\n         , abs_exports\n             = ABExport { (>) :: forall a. Ord a => T a -> T a -> Bool\n                        , gr_lcl :: T a -> T a -> Bool }\n         , abs_binds\n             = AbsBind { abs_tvs = [], abs_ev_vars = []\n                       , abs_exports = ABExport { gr_lcl :: T a -> T a -> Bool\n                                                , gr_inner :: forall b. b -> b -> Bool }\n                       , abs_binds = AbsBind { abs_tvs = [b], abs_ev_vars = []\n                                             , ..etc.. }\n               } }\n\nWow!  Three nested AbsBinds!\n * The outer one abstracts over the tyvars and dicts for the instance\n * The middle one is only present if there is an instance signature,\n   and does the impedance matching for that signature\n * The inner one is for the method binding itself against either the\n   signature from the class, or the instance signature.\n-}\n\n----------------------\nmk_meth_spec_prags :: Id -> [LTcSpecPrag] -> [LTcSpecPrag] -> TcSpecPrags\n        -- Adapt the 'SPECIALISE instance' pragmas to work for this method Id\n        -- There are two sources:\n        --   * spec_prags_for_me: {-# SPECIALISE op :: <blah> #-}\n        --   * spec_prags_from_inst: derived from {-# SPECIALISE instance :: <blah> #-}\n        --     These ones have the dfun inside, but [perhaps surprisingly]\n        --     the correct wrapper.\n        -- See Note [Handling SPECIALISE pragmas] in TcBinds\nmk_meth_spec_prags meth_id spec_inst_prags spec_prags_for_me\n  = SpecPrags (spec_prags_for_me ++ spec_prags_from_inst)\n  where\n    spec_prags_from_inst\n       | isInlinePragma (idInlinePragma meth_id)\n       = []  -- Do not inherit SPECIALISE from the instance if the\n             -- method is marked INLINE, because then it'll be inlined\n             -- and the specialisation would do nothing. (Indeed it'll provoke\n             -- a warning from the desugarer\n       | otherwise\n       = [ L inst_loc (SpecPrag meth_id wrap inl)\n         | L inst_loc (SpecPrag _       wrap inl) <- spec_inst_prags]\n\n\nmkDefMethBind :: Class -> [Type] -> Id -> Name\n              -> TcM (LHsBind GhcRn, [LSig GhcRn])\n-- The is a default method (vanailla or generic) defined in the class\n-- So make a binding   op = $dmop @t1 @t2\n-- where $dmop is the name of the default method in the class,\n-- and t1,t2 are the instance types.\n-- See Note [Default methods in instances] for why we use\n-- visible type application here\nmkDefMethBind clas inst_tys sel_id dm_name\n  = do  { dflags <- getDynFlags\n        ; dm_id <- tcLookupId dm_name\n        ; let inline_prag = idInlinePragma dm_id\n              inline_prags | isAnyInlinePragma inline_prag\n                           = [noLoc (InlineSig noExt fn inline_prag)]\n                           | otherwise\n                           = []\n                 -- Copy the inline pragma (if any) from the default method\n                 -- to this version. Note [INLINE and default methods]\n\n              fn   = noLoc (idName sel_id)\n              visible_inst_tys = [ ty | (tcb, ty) <- tyConBinders (classTyCon clas) `zip` inst_tys\n                                      , tyConBinderArgFlag tcb /= Inferred ]\n              rhs  = foldl' mk_vta (nlHsVar dm_name) visible_inst_tys\n              bind = noLoc $ mkTopFunBind Generated fn $\n                             [mkSimpleMatch (mkPrefixFunRhs fn) [] rhs]\n\n        ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv \"Filling in method body\"\n                   (vcat [ppr clas <+> ppr inst_tys,\n                          nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))\n\n       ; return (bind, inline_prags) }\n  where\n    mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn\n    mk_vta fun ty = noLoc (HsAppType noExt fun (mkEmptyWildCardBndrs $ nlHsParTy\n                                                $ noLoc $ XHsType $ NHsCoreTy ty))\n       -- NB: use visible type application\n       -- See Note [Default methods in instances]\n\n----------------------\nderivBindCtxt :: Id -> Class -> [Type ] -> SDoc\nderivBindCtxt sel_id clas tys\n   = vcat [ text \"When typechecking the code for\" <+> quotes (ppr sel_id)\n          , nest 2 (text \"in a derived instance for\"\n                    <+> quotes (pprClassPred clas tys) <> colon)\n          , nest 2 $ text \"To see the code I am typechecking, use -ddump-deriv\" ]\n\nwarnUnsatisfiedMinimalDefinition :: ClassMinimalDef -> TcM ()\nwarnUnsatisfiedMinimalDefinition mindef\n  = do { warn <- woptM Opt_WarnMissingMethods\n       ; warnTc (Reason Opt_WarnMissingMethods) warn message\n       }\n  where\n    message = vcat [text \"No explicit implementation for\"\n                   ,nest 2 $ pprBooleanFormulaNice mindef\n                   ]\n\n{-\nNote [Export helper functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe arrange to export the \"helper functions\" of an instance declaration,\nso that they are not subject to preInlineUnconditionally, even if their\nRHS is trivial.  Reason: they are mentioned in the DFunUnfolding of\nthe dict fun as Ids, not as CoreExprs, so we can't substitute a\nnon-variable for them.\n\nWe could change this by making DFunUnfoldings have CoreExprs, but it\nseems a bit simpler this way.\n\nNote [Default methods in instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n\n   class Baz v x where\n      foo :: x -> x\n      foo y = <blah>\n\n   instance Baz Int Int\n\nFrom the class decl we get\n\n   $dmfoo :: forall v x. Baz v x => x -> x\n   $dmfoo y = <blah>\n\nNotice that the type is ambiguous.  So we use Visible Type Application\nto disambiguate:\n\n   $dBazIntInt = MkBaz fooIntInt\n   fooIntInt = $dmfoo @Int @Int\n\nLacking VTA we'd get ambiguity errors involving the default method.  This applies\nequally to vanilla default methods (Trac #1061) and generic default methods\n(Trac #12220).\n\nHistorical note: before we had VTA we had to generate\npost-type-checked code, which took a lot more code, and didn't work for\ngeneric default methods.\n\nNote [INLINE and default methods]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDefault methods need special case.  They are supposed to behave rather like\nmacros.  For example\n\n  class Foo a where\n    op1, op2 :: Bool -> a -> a\n\n    {-# INLINE op1 #-}\n    op1 b x = op2 (not b) x\n\n  instance Foo Int where\n    -- op1 via default method\n    op2 b x = <blah>\n\nThe instance declaration should behave\n\n   just as if 'op1' had been defined with the\n   code, and INLINE pragma, from its original\n   definition.\n\nThat is, just as if you'd written\n\n  instance Foo Int where\n    op2 b x = <blah>\n\n    {-# INLINE op1 #-}\n    op1 b x = op2 (not b) x\n\nSo for the above example we generate:\n\n  {-# INLINE $dmop1 #-}\n  -- $dmop1 has an InlineCompulsory unfolding\n  $dmop1 d b x = op2 d (not b) x\n\n  $fFooInt = MkD $cop1 $cop2\n\n  {-# INLINE $cop1 #-}\n  $cop1 = $dmop1 $fFooInt\n\n  $cop2 = <blah>\n\nNote carefully:\n\n* We *copy* any INLINE pragma from the default method $dmop1 to the\n  instance $cop1.  Otherwise we'll just inline the former in the\n  latter and stop, which isn't what the user expected\n\n* Regardless of its pragma, we give the default method an\n  unfolding with an InlineCompulsory source. That means\n  that it'll be inlined at every use site, notably in\n  each instance declaration, such as $cop1.  This inlining\n  must happen even though\n    a) $dmop1 is not saturated in $cop1\n    b) $cop1 itself has an INLINE pragma\n\n  It's vital that $dmop1 *is* inlined in this way, to allow the mutual\n  recursion between $fooInt and $cop1 to be broken\n\n* To communicate the need for an InlineCompulsory to the desugarer\n  (which makes the Unfoldings), we use the IsDefaultMethod constructor\n  in TcSpecPrags.\n\n\n************************************************************************\n*                                                                      *\n        Specialise instance pragmas\n*                                                                      *\n************************************************************************\n\nNote [SPECIALISE instance pragmas]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n   instance (Ix a, Ix b) => Ix (a,b) where\n     {-# SPECIALISE instance Ix (Int,Int) #-}\n     range (x,y) = ...\n\nWe make a specialised version of the dictionary function, AND\nspecialised versions of each *method*.  Thus we should generate\nsomething like this:\n\n  $dfIxPair :: (Ix a, Ix b) => Ix (a,b)\n  {-# DFUN [$crangePair, ...] #-}\n  {-# SPECIALISE $dfIxPair :: Ix (Int,Int) #-}\n  $dfIxPair da db = Ix ($crangePair da db) (...other methods...)\n\n  $crange :: (Ix a, Ix b) -> ((a,b),(a,b)) -> [(a,b)]\n  {-# SPECIALISE $crange :: ((Int,Int),(Int,Int)) -> [(Int,Int)] #-}\n  $crange da db = <blah>\n\nThe SPECIALISE pragmas are acted upon by the desugarer, which generate\n\n  dii :: Ix Int\n  dii = ...\n\n  $s$dfIxPair :: Ix ((Int,Int),(Int,Int))\n  {-# DFUN [$crangePair di di, ...] #-}\n  $s$dfIxPair = Ix ($crangePair di di) (...)\n\n  {-# RULE forall (d1,d2:Ix Int). $dfIxPair Int Int d1 d2 = $s$dfIxPair #-}\n\n  $s$crangePair :: ((Int,Int),(Int,Int)) -> [(Int,Int)]\n  $c$crangePair = ...specialised RHS of $crangePair...\n\n  {-# RULE forall (d1,d2:Ix Int). $crangePair Int Int d1 d2 = $s$crangePair #-}\n\nNote that\n\n  * The specialised dictionary $s$dfIxPair is very much needed, in case we\n    call a function that takes a dictionary, but in a context where the\n    specialised dictionary can be used.  See Trac #7797.\n\n  * The ClassOp rule for 'range' works equally well on $s$dfIxPair, because\n    it still has a DFunUnfolding.  See Note [ClassOp/DFun selection]\n\n  * A call (range ($dfIxPair Int Int d1 d2)) might simplify two ways:\n       --> {ClassOp rule for range}     $crangePair Int Int d1 d2\n       --> {SPEC rule for $crangePair}  $s$crangePair\n    or thus:\n       --> {SPEC rule for $dfIxPair}    range $s$dfIxPair\n       --> {ClassOpRule for range}      $s$crangePair\n    It doesn't matter which way.\n\n  * We want to specialise the RHS of both $dfIxPair and $crangePair,\n    but the SAME HsWrapper will do for both!  We can call tcSpecPrag\n    just once, and pass the result (in spec_inst_info) to tcMethods.\n-}\n\ntcSpecInstPrags :: DFunId -> InstBindings GhcRn\n                -> TcM ([Located TcSpecPrag], TcPragEnv)\ntcSpecInstPrags dfun_id (InstBindings { ib_binds = binds, ib_pragmas = uprags })\n  = do { spec_inst_prags <- mapM (wrapLocM (tcSpecInst dfun_id)) $\n                            filter isSpecInstLSig uprags\n             -- The filter removes the pragmas for methods\n       ; return (spec_inst_prags, mkPragEnv uprags binds) }\n\n------------------------------\ntcSpecInst :: Id -> Sig GhcRn -> TcM TcSpecPrag\ntcSpecInst dfun_id prag@(SpecInstSig _ _ hs_ty)\n  = addErrCtxt (spec_ctxt prag) $\n    do  { spec_dfun_ty <- tcHsClsInstType SpecInstCtxt hs_ty\n        ; co_fn <- tcSpecWrapper SpecInstCtxt (idType dfun_id) spec_dfun_ty\n        ; return (SpecPrag dfun_id co_fn defaultInlinePragma) }\n  where\n    spec_ctxt prag = hang (text \"In the SPECIALISE pragma\") 2 (ppr prag)\n\ntcSpecInst _  _ = panic \"tcSpecInst\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Error messages}\n*                                                                      *\n************************************************************************\n-}\n\ninstDeclCtxt1 :: LHsSigType GhcRn -> SDoc\ninstDeclCtxt1 hs_inst_ty\n  = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty))\n\ninstDeclCtxt2 :: Type -> SDoc\ninstDeclCtxt2 dfun_ty\n  = inst_decl_ctxt (ppr (mkClassPred cls tys))\n  where\n    (_,_,cls,tys) = tcSplitDFunTy dfun_ty\n\ninst_decl_ctxt :: SDoc -> SDoc\ninst_decl_ctxt doc = hang (text \"In the instance declaration for\")\n                        2 (quotes doc)\n\nbadBootFamInstDeclErr :: SDoc\nbadBootFamInstDeclErr\n  = text \"Illegal family instance in hs-boot file\"\n\nnotFamily :: TyCon -> SDoc\nnotFamily tycon\n  = vcat [ text \"Illegal family instance for\" <+> quotes (ppr tycon)\n         , nest 2 $ parens (ppr tycon <+> text \"is not an indexed type family\")]\n\nassocInClassErr :: TyCon -> SDoc\nassocInClassErr name\n = text \"Associated type\" <+> quotes (ppr name) <+>\n   text \"must be inside a class instance\"\n\nbadFamInstDecl :: TyCon -> SDoc\nbadFamInstDecl tc_name\n  = vcat [ text \"Illegal family instance for\" <+>\n           quotes (ppr tc_name)\n         , nest 2 (parens $ text \"Use TypeFamilies to allow indexed type families\") ]\n\nnotOpenFamily :: TyCon -> SDoc\nnotOpenFamily tc\n  = text \"Illegal instance for closed family\" <+> quotes (ppr tc)\n", "num_lines": 2138}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule TcInteract (\n     solveSimpleGivens,   -- Solves [Ct]\n     solveSimpleWanteds,  -- Solves Cts\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\nimport BasicTypes ( SwapFlag(..), isSwapped,\n                    infinity, IntWithInf, intGtLimit )\nimport TcCanonical\nimport TcFlatten\nimport TcUnify( canSolveByUnification )\nimport VarSet\nimport Type\nimport InstEnv( DFunInstType )\nimport CoAxiom( sfInteractTop, sfInteractInert )\n\nimport Var\nimport TcType\nimport PrelNames ( coercibleTyConKey,\n                   heqTyConKey, eqTyConKey, ipClassKey )\nimport CoAxiom ( TypeEqn, CoAxiom(..), CoAxBranch(..), fromBranches )\nimport Class\nimport TyCon\nimport FunDeps\nimport FamInst\nimport ClsInst( InstanceWhat(..), safeOverlap )\nimport FamInstEnv\nimport Unify ( tcUnifyTyWithTFs, ruleMatchTyKiX )\n\nimport TcEvidence\nimport Outputable\n\nimport TcRnTypes\nimport TcSMonad\nimport Bag\nimport MonadUtils ( concatMapM, foldlM )\n\nimport CoreSyn\nimport Data.List( partition, deleteFirstsBy )\nimport SrcLoc\nimport VarEnv\n\nimport Control.Monad\nimport Maybes( isJust )\nimport Pair (Pair(..))\nimport Unique( hasKey )\nimport DynFlags\nimport Util\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad.Trans.Class\nimport Control.Monad.Trans.Maybe\n\n{-\n**********************************************************************\n*                                                                    *\n*                      Main Interaction Solver                       *\n*                                                                    *\n**********************************************************************\n\nNote [Basic Simplifier Plan]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n1. Pick an element from the WorkList if there exists one with depth\n   less than our context-stack depth.\n\n2. Run it down the 'stage' pipeline. Stages are:\n      - canonicalization\n      - inert reactions\n      - spontaneous reactions\n      - top-level intreactions\n   Each stage returns a StopOrContinue and may have sideffected\n   the inerts or worklist.\n\n   The threading of the stages is as follows:\n      - If (Stop) is returned by a stage then we start again from Step 1.\n      - If (ContinueWith ct) is returned by a stage, we feed 'ct' on to\n        the next stage in the pipeline.\n4. If the element has survived (i.e. ContinueWith x) the last stage\n   then we add him in the inerts and jump back to Step 1.\n\nIf in Step 1 no such element exists, we have exceeded our context-stack\ndepth and will simply fail.\n\nNote [Unflatten after solving the simple wanteds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe unflatten after solving the wc_simples of an implication, and before attempting\nto float. This means that\n\n * The fsk/fmv flatten-skolems only survive during solveSimples.  We don't\n   need to worry about them across successive passes over the constraint tree.\n   (E.g. we don't need the old ic_fsk field of an implication.\n\n * When floating an equality outwards, we don't need to worry about floating its\n   associated flattening constraints.\n\n * Another tricky case becomes easy: Trac #4935\n       type instance F True a b = a\n       type instance F False a b = b\n\n       [w] F c a b ~ gamma\n       (c ~ True) => a ~ gamma\n       (c ~ False) => b ~ gamma\n\n   Obviously this is soluble with gamma := F c a b, and unflattening\n   will do exactly that after solving the simple constraints and before\n   attempting the implications.  Before, when we were not unflattening,\n   we had to push Wanted funeqs in as new givens.  Yuk!\n\n   Another example that becomes easy: indexed_types/should_fail/T7786\n      [W] BuriedUnder sub k Empty ~ fsk\n      [W] Intersect fsk inv ~ s\n      [w] xxx[1] ~ s\n      [W] forall[2] . (xxx[1] ~ Empty)\n                   => Intersect (BuriedUnder sub k Empty) inv ~ Empty\n\nNote [Running plugins on unflattened wanteds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere is an annoying mismatch between solveSimpleGivens and\nsolveSimpleWanteds, because the latter needs to fiddle with the inert\nset, unflatten and zonk the wanteds.  It passes the zonked wanteds\nto runTcPluginsWanteds, which produces a replacement set of wanteds,\nsome additional insolubles and a flag indicating whether to go round\nthe loop again.  If so, prepareInertsForImplications is used to remove\nthe previous wanteds (which will still be in the inert set).  Note\nthat prepareInertsForImplications will discard the insolubles, so we\nmust keep track of them separately.\n-}\n\nsolveSimpleGivens :: [Ct] -> TcS ()\nsolveSimpleGivens givens\n  | null givens  -- Shortcut for common case\n  = return ()\n  | otherwise\n  = do { traceTcS \"solveSimpleGivens {\" (ppr givens)\n       ; go givens\n       ; traceTcS \"End solveSimpleGivens }\" empty }\n  where\n    go givens = do { solveSimples (listToBag givens)\n                   ; new_givens <- runTcPluginsGiven\n                   ; when (notNull new_givens) $\n                     go new_givens }\n\nsolveSimpleWanteds :: Cts -> TcS WantedConstraints\n-- NB: 'simples' may contain /derived/ equalities, floated\n--     out from a nested implication. So don't discard deriveds!\n-- The result is not necessarily zonked\nsolveSimpleWanteds simples\n  = do { traceTcS \"solveSimpleWanteds {\" (ppr simples)\n       ; dflags <- getDynFlags\n       ; (n,wc) <- go 1 (solverIterations dflags) (emptyWC { wc_simple = simples })\n       ; traceTcS \"solveSimpleWanteds end }\" $\n             vcat [ text \"iterations =\" <+> ppr n\n                  , text \"residual =\" <+> ppr wc ]\n       ; return wc }\n  where\n    go :: Int -> IntWithInf -> WantedConstraints -> TcS (Int, WantedConstraints)\n    go n limit wc\n      | n `intGtLimit` limit\n      = failTcS (hang (text \"solveSimpleWanteds: too many iterations\"\n                       <+> parens (text \"limit =\" <+> ppr limit))\n                    2 (vcat [ text \"Set limit with -fconstraint-solver-iterations=n; n=0 for no limit\"\n                            , text \"Simples =\" <+> ppr simples\n                            , text \"WC =\"      <+> ppr wc ]))\n\n     | isEmptyBag (wc_simple wc)\n     = return (n,wc)\n\n     | otherwise\n     = do { -- Solve\n            (unif_count, wc1) <- solve_simple_wanteds wc\n\n            -- Run plugins\n          ; (rerun_plugin, wc2) <- runTcPluginsWanted wc1\n             -- See Note [Running plugins on unflattened wanteds]\n\n          ; if unif_count == 0 && not rerun_plugin\n            then return (n, wc2)             -- Done\n            else do { traceTcS \"solveSimple going round again:\" $\n                      ppr unif_count $$ ppr rerun_plugin\n                    ; go (n+1) limit wc2 } }      -- Loop\n\n\nsolve_simple_wanteds :: WantedConstraints -> TcS (Int, WantedConstraints)\n-- Try solving these constraints\n-- Affects the unification state (of course) but not the inert set\n-- The result is not necessarily zonked\nsolve_simple_wanteds (WC { wc_simple = simples1, wc_impl = implics1 })\n  = nestTcS $\n    do { solveSimples simples1\n       ; (implics2, tv_eqs, fun_eqs, others) <- getUnsolvedInerts\n       ; (unif_count, unflattened_eqs) <- reportUnifications $\n                                          unflattenWanteds tv_eqs fun_eqs\n            -- See Note [Unflatten after solving the simple wanteds]\n       ; return ( unif_count\n                , WC { wc_simple = others `andCts` unflattened_eqs\n                     , wc_impl   = implics1 `unionBags` implics2 }) }\n\n{- Note [The solveSimpleWanteds loop]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSolving a bunch of simple constraints is done in a loop,\n(the 'go' loop of 'solveSimpleWanteds'):\n  1. Try to solve them; unflattening may lead to improvement that\n     was not exploitable during solving\n  2. Try the plugin\n  3. If step 1 did improvement during unflattening; or if the plugin\n     wants to run again, go back to step 1\n\nNon-obviously, improvement can also take place during\nthe unflattening that takes place in step (1). See TcFlatten,\nSee Note [Unflattening can force the solver to iterate]\n-}\n\n-- The main solver loop implements Note [Basic Simplifier Plan]\n---------------------------------------------------------------\nsolveSimples :: Cts -> TcS ()\n-- Returns the final InertSet in TcS\n-- Has no effect on work-list or residual-implications\n-- The constraints are initially examined in left-to-right order\n\nsolveSimples cts\n  = {-# SCC \"solveSimples\" #-}\n    do { updWorkListTcS (\\wl -> foldrBag extendWorkListCt wl cts)\n       ; solve_loop }\n  where\n    solve_loop\n      = {-# SCC \"solve_loop\" #-}\n        do { sel <- selectNextWorkItem\n           ; case sel of\n              Nothing -> return ()\n              Just ct -> do { runSolverPipeline thePipeline ct\n                            ; solve_loop } }\n\n-- | Extract the (inert) givens and invoke the plugins on them.\n-- Remove solved givens from the inert set and emit insolubles, but\n-- return new work produced so that 'solveSimpleGivens' can feed it back\n-- into the main solver.\nrunTcPluginsGiven :: TcS [Ct]\nrunTcPluginsGiven\n  = do { plugins <- getTcPlugins\n       ; if null plugins then return [] else\n    do { givens <- getInertGivens\n       ; if null givens then return [] else\n    do { p <- runTcPlugins plugins (givens,[],[])\n       ; let (solved_givens, _, _) = pluginSolvedCts p\n             insols                = pluginBadCts p\n       ; updInertCans (removeInertCts solved_givens)\n       ; updInertIrreds (\\irreds -> extendCtsList irreds insols)\n       ; return (pluginNewCts p) } } }\n\n-- | Given a bag of (flattened, zonked) wanteds, invoke the plugins on\n-- them and produce an updated bag of wanteds (possibly with some new\n-- work) and a bag of insolubles.  The boolean indicates whether\n-- 'solveSimpleWanteds' should feed the updated wanteds back into the\n-- main solver.\nrunTcPluginsWanted :: WantedConstraints -> TcS (Bool, WantedConstraints)\nrunTcPluginsWanted wc@(WC { wc_simple = simples1, wc_impl = implics1 })\n  | isEmptyBag simples1\n  = return (False, wc)\n  | otherwise\n  = do { plugins <- getTcPlugins\n       ; if null plugins then return (False, wc) else\n\n    do { given <- getInertGivens\n       ; simples1 <- zonkSimples simples1    -- Plugin requires zonked inputs\n       ; let (wanted, derived) = partition isWantedCt (bagToList simples1)\n       ; p <- runTcPlugins plugins (given, derived, wanted)\n       ; let (_, _,                solved_wanted)   = pluginSolvedCts p\n             (_, unsolved_derived, unsolved_wanted) = pluginInputCts p\n             new_wanted                             = pluginNewCts p\n             insols                                 = pluginBadCts p\n\n-- SLPJ: I'm deeply suspicious of this\n--       ; updInertCans (removeInertCts $ solved_givens ++ solved_deriveds)\n\n       ; mapM_ setEv solved_wanted\n       ; return ( notNull (pluginNewCts p)\n                , WC { wc_simple = listToBag new_wanted       `andCts`\n                                   listToBag unsolved_wanted  `andCts`\n                                   listToBag unsolved_derived `andCts`\n                                   listToBag insols\n                     , wc_impl   = implics1 } ) } }\n  where\n    setEv :: (EvTerm,Ct) -> TcS ()\n    setEv (ev,ct) = case ctEvidence ct of\n      CtWanted { ctev_dest = dest } -> setWantedEvTerm dest ev\n      _ -> panic \"runTcPluginsWanted.setEv: attempt to solve non-wanted!\"\n\n-- | A triple of (given, derived, wanted) constraints to pass to plugins\ntype SplitCts  = ([Ct], [Ct], [Ct])\n\n-- | A solved triple of constraints, with evidence for wanteds\ntype SolvedCts = ([Ct], [Ct], [(EvTerm,Ct)])\n\n-- | Represents collections of constraints generated by typechecker\n-- plugins\ndata TcPluginProgress = TcPluginProgress\n    { pluginInputCts  :: SplitCts\n      -- ^ Original inputs to the plugins with solved/bad constraints\n      -- removed, but otherwise unmodified\n    , pluginSolvedCts :: SolvedCts\n      -- ^ Constraints solved by plugins\n    , pluginBadCts    :: [Ct]\n      -- ^ Constraints reported as insoluble by plugins\n    , pluginNewCts    :: [Ct]\n      -- ^ New constraints emitted by plugins\n    }\n\ngetTcPlugins :: TcS [TcPluginSolver]\ngetTcPlugins = do { tcg_env <- getGblEnv; return (tcg_tc_plugins tcg_env) }\n\n-- | Starting from a triple of (given, derived, wanted) constraints,\n-- invoke each of the typechecker plugins in turn and return\n--\n--  * the remaining unmodified constraints,\n--  * constraints that have been solved,\n--  * constraints that are insoluble, and\n--  * new work.\n--\n-- Note that new work generated by one plugin will not be seen by\n-- other plugins on this pass (but the main constraint solver will be\n-- re-invoked and they will see it later).  There is no check that new\n-- work differs from the original constraints supplied to the plugin:\n-- the plugin itself should perform this check if necessary.\nrunTcPlugins :: [TcPluginSolver] -> SplitCts -> TcS TcPluginProgress\nrunTcPlugins plugins all_cts\n  = foldM do_plugin initialProgress plugins\n  where\n    do_plugin :: TcPluginProgress -> TcPluginSolver -> TcS TcPluginProgress\n    do_plugin p solver = do\n        result <- runTcPluginTcS (uncurry3 solver (pluginInputCts p))\n        return $ progress p result\n\n    progress :: TcPluginProgress -> TcPluginResult -> TcPluginProgress\n    progress p (TcPluginContradiction bad_cts) =\n       p { pluginInputCts = discard bad_cts (pluginInputCts p)\n         , pluginBadCts   = bad_cts ++ pluginBadCts p\n         }\n    progress p (TcPluginOk solved_cts new_cts) =\n      p { pluginInputCts  = discard (map snd solved_cts) (pluginInputCts p)\n        , pluginSolvedCts = add solved_cts (pluginSolvedCts p)\n        , pluginNewCts    = new_cts ++ pluginNewCts p\n        }\n\n    initialProgress = TcPluginProgress all_cts ([], [], []) [] []\n\n    discard :: [Ct] -> SplitCts -> SplitCts\n    discard cts (xs, ys, zs) =\n        (xs `without` cts, ys `without` cts, zs `without` cts)\n\n    without :: [Ct] -> [Ct] -> [Ct]\n    without = deleteFirstsBy eqCt\n\n    eqCt :: Ct -> Ct -> Bool\n    eqCt c c' = ctFlavour c == ctFlavour c'\n             && ctPred c `tcEqType` ctPred c'\n\n    add :: [(EvTerm,Ct)] -> SolvedCts -> SolvedCts\n    add xs scs = foldl' addOne scs xs\n\n    addOne :: SolvedCts -> (EvTerm,Ct) -> SolvedCts\n    addOne (givens, deriveds, wanteds) (ev,ct) = case ctEvidence ct of\n      CtGiven  {} -> (ct:givens, deriveds, wanteds)\n      CtDerived{} -> (givens, ct:deriveds, wanteds)\n      CtWanted {} -> (givens, deriveds, (ev,ct):wanteds)\n\n\ntype WorkItem = Ct\ntype SimplifierStage = WorkItem -> TcS (StopOrContinue Ct)\n\nrunSolverPipeline :: [(String,SimplifierStage)] -- The pipeline\n                  -> WorkItem                   -- The work item\n                  -> TcS ()\n-- Run this item down the pipeline, leaving behind new work and inerts\nrunSolverPipeline pipeline workItem\n  = do { wl <- getWorkList\n       ; inerts <- getTcSInerts\n       ; tclevel <- getTcLevel\n       ; traceTcS \"----------------------------- \" empty\n       ; traceTcS \"Start solver pipeline {\" $\n                  vcat [ text \"tclevel =\" <+> ppr tclevel\n                       , text \"work item =\" <+> ppr workItem\n                       , text \"inerts =\" <+> ppr inerts\n                       , text \"rest of worklist =\" <+> ppr wl ]\n\n       ; bumpStepCountTcS    -- One step for each constraint processed\n       ; final_res  <- run_pipeline pipeline (ContinueWith workItem)\n\n       ; case final_res of\n           Stop ev s       -> do { traceFireTcS ev s\n                                 ; traceTcS \"End solver pipeline (discharged) }\" empty\n                                 ; return () }\n           ContinueWith ct -> do { addInertCan ct\n                                 ; traceFireTcS (ctEvidence ct) (text \"Kept as inert\")\n                                 ; traceTcS \"End solver pipeline (kept as inert) }\" $\n                                            (text \"final_item =\" <+> ppr ct) }\n       }\n  where run_pipeline :: [(String,SimplifierStage)] -> StopOrContinue Ct\n                     -> TcS (StopOrContinue Ct)\n        run_pipeline [] res        = return res\n        run_pipeline _ (Stop ev s) = return (Stop ev s)\n        run_pipeline ((stg_name,stg):stgs) (ContinueWith ct)\n          = do { traceTcS (\"runStage \" ++ stg_name ++ \" {\")\n                          (text \"workitem   = \" <+> ppr ct)\n               ; res <- stg ct\n               ; traceTcS (\"end stage \" ++ stg_name ++ \" }\") empty\n               ; run_pipeline stgs res }\n\n{-\nExample 1:\n  Inert:   {c ~ d, F a ~ t, b ~ Int, a ~ ty} (all given)\n  Reagent: a ~ [b] (given)\n\nReact with (c~d)     ==> IR (ContinueWith (a~[b]))  True    []\nReact with (F a ~ t) ==> IR (ContinueWith (a~[b]))  False   [F [b] ~ t]\nReact with (b ~ Int) ==> IR (ContinueWith (a~[Int]) True    []\n\nExample 2:\n  Inert:  {c ~w d, F a ~g t, b ~w Int, a ~w ty}\n  Reagent: a ~w [b]\n\nReact with (c ~w d)   ==> IR (ContinueWith (a~[b]))  True    []\nReact with (F a ~g t) ==> IR (ContinueWith (a~[b]))  True    []    (can't rewrite given with wanted!)\netc.\n\nExample 3:\n  Inert:  {a ~ Int, F Int ~ b} (given)\n  Reagent: F a ~ b (wanted)\n\nReact with (a ~ Int)   ==> IR (ContinueWith (F Int ~ b)) True []\nReact with (F Int ~ b) ==> IR Stop True []    -- after substituting we re-canonicalize and get nothing\n-}\n\nthePipeline :: [(String,SimplifierStage)]\nthePipeline = [ (\"canonicalization\",        TcCanonical.canonicalize)\n              , (\"interact with inerts\",    interactWithInertsStage)\n              , (\"top-level reactions\",     topReactionsStage) ]\n\n{-\n*********************************************************************************\n*                                                                               *\n                       The interact-with-inert Stage\n*                                                                               *\n*********************************************************************************\n\nNote [The Solver Invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe always add Givens first.  So you might think that the solver has\nthe invariant\n\n   If the work-item is Given,\n   then the inert item must Given\n\nBut this isn't quite true.  Suppose we have,\n    c1: [W] beta ~ [alpha], c2 : [W] blah, c3 :[W] alpha ~ Int\nAfter processing the first two, we get\n     c1: [G] beta ~ [alpha], c2 : [W] blah\nNow, c3 does not interact with the given c1, so when we spontaneously\nsolve c3, we must re-react it with the inert set.  So we can attempt a\nreaction between inert c2 [W] and work-item c3 [G].\n\nIt *is* true that [Solver Invariant]\n   If the work-item is Given,\n   AND there is a reaction\n   then the inert item must Given\nor, equivalently,\n   If the work-item is Given,\n   and the inert item is Wanted/Derived\n   then there is no reaction\n-}\n\n-- Interaction result of  WorkItem <~> Ct\n\ninteractWithInertsStage :: WorkItem -> TcS (StopOrContinue Ct)\n-- Precondition: if the workitem is a CTyEqCan then it will not be able to\n-- react with anything at this stage.\n\ninteractWithInertsStage wi\n  = do { inerts <- getTcSInerts\n       ; let ics = inert_cans inerts\n       ; case wi of\n             CTyEqCan  {} -> interactTyVarEq ics wi\n             CFunEqCan {} -> interactFunEq   ics wi\n             CIrredCan {} -> interactIrred   ics wi\n             CDictCan  {} -> interactDict    ics wi\n             _ -> pprPanic \"interactWithInerts\" (ppr wi) }\n                -- CHoleCan are put straight into inert_frozen, so never get here\n                -- CNonCanonical have been canonicalised\n\ndata InteractResult\n   = KeepInert   -- Keep the inert item, and solve the work item from it\n                 -- (if the latter is Wanted; just discard it if not)\n   | KeepWork    -- Keep the work item, and solve the intert item from it\n\ninstance Outputable InteractResult where\n  ppr KeepInert = text \"keep inert\"\n  ppr KeepWork  = text \"keep work-item\"\n\nsolveOneFromTheOther :: CtEvidence  -- Inert\n                     -> CtEvidence  -- WorkItem\n                     -> TcS InteractResult\n-- Precondition:\n-- * inert and work item represent evidence for the /same/ predicate\n--\n-- We can always solve one from the other: even if both are wanted,\n-- although we don't rewrite wanteds with wanteds, we can combine\n-- two wanteds into one by solving one from the other\n\nsolveOneFromTheOther ev_i ev_w\n  | isDerived ev_w         -- Work item is Derived; just discard it\n  = return KeepInert\n\n  | isDerived ev_i     -- The inert item is Derived, we can just throw it away,\n  = return KeepWork    -- The ev_w is inert wrt earlier inert-set items,\n                       -- so it's safe to continue on from this point\n\n  | CtWanted { ctev_loc = loc_w } <- ev_w\n  , prohibitedSuperClassSolve (ctEvLoc ev_i) loc_w\n  = -- inert must be Given\n    do { traceTcS \"prohibitedClassSolve1\" (ppr ev_i $$ ppr ev_w)\n       ; return KeepWork }\n\n  | CtWanted {} <- ev_w\n       -- Inert is Given or Wanted\n  = return KeepInert\n\n  -- From here on the work-item is Given\n\n  | CtWanted { ctev_loc = loc_i } <- ev_i\n  , prohibitedSuperClassSolve (ctEvLoc ev_w) loc_i\n  = do { traceTcS \"prohibitedClassSolve2\" (ppr ev_i $$ ppr ev_w)\n       ; return KeepInert }      -- Just discard the un-usable Given\n                                 -- This never actually happens because\n                                 -- Givens get processed first\n\n  | CtWanted {} <- ev_i\n  = return KeepWork\n\n  -- From here on both are Given\n  -- See Note [Replacement vs keeping]\n\n  | lvl_i == lvl_w\n  = do { ev_binds_var <- getTcEvBindsVar\n       ; binds <- getTcEvBindsMap ev_binds_var\n       ; return (same_level_strategy binds) }\n\n  | otherwise   -- Both are Given, levels differ\n  = return different_level_strategy\n  where\n     pred  = ctEvPred ev_i\n     loc_i = ctEvLoc ev_i\n     loc_w = ctEvLoc ev_w\n     lvl_i = ctLocLevel loc_i\n     lvl_w = ctLocLevel loc_w\n     ev_id_i = ctEvEvId ev_i\n     ev_id_w = ctEvEvId ev_w\n\n     different_level_strategy  -- Both Given\n       | isIPPred pred, lvl_w > lvl_i = KeepWork\n       | lvl_w < lvl_i                = KeepWork\n       | otherwise                    = KeepInert\n\n     same_level_strategy binds -- Both Given\n       | GivenOrigin (InstSC s_i) <- ctLocOrigin loc_i\n       = case ctLocOrigin loc_w of\n            GivenOrigin (InstSC s_w) | s_w < s_i -> KeepWork\n                                     | otherwise -> KeepInert\n            _                                    -> KeepWork\n\n       | GivenOrigin (InstSC {}) <- ctLocOrigin loc_w\n       = KeepInert\n\n       | has_binding binds ev_id_w\n       , not (has_binding binds ev_id_i)\n       , not (ev_id_i `elemVarSet` findNeededEvVars binds (unitVarSet ev_id_w))\n       = KeepWork\n\n       | otherwise\n       = KeepInert\n\n     has_binding binds ev_id = isJust (lookupEvBind binds ev_id)\n\n{-\nNote [Replacement vs keeping]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we have two Given constraints both of type (C tys), say, which should\nwe keep?  More subtle than you might think!\n\n  * Constraints come from different levels (different_level_strategy)\n\n      - For implicit parameters we want to keep the innermost (deepest)\n        one, so that it overrides the outer one.\n        See Note [Shadowing of Implicit Parameters]\n\n      - For everything else, we want to keep the outermost one.  Reason: that\n        makes it more likely that the inner one will turn out to be unused,\n        and can be reported as redundant.  See Note [Tracking redundant constraints]\n        in TcSimplify.\n\n        It transpires that using the outermost one is reponsible for an\n        8% performance improvement in nofib cryptarithm2, compared to\n        just rolling the dice.  I didn't investigate why.\n\n  * Constraints coming from the same level (i.e. same implication)\n\n       (a) Always get rid of InstSC ones if possible, since they are less\n           useful for solving.  If both are InstSC, choose the one with\n           the smallest TypeSize\n           See Note [Solving superclass constraints] in TcInstDcls\n\n       (b) Keep the one that has a non-trivial evidence binding.\n              Example:  f :: (Eq a, Ord a) => blah\n              then we may find [G] d3 :: Eq a\n                               [G] d2 :: Eq a\n                with bindings  d3 = sc_sel (d1::Ord a)\n            We want to discard d2 in favour of the superclass selection from\n            the Ord dictionary.\n            Why? See Note [Tracking redundant constraints] in TcSimplify again.\n\n       (c) But don't do (b) if the evidence binding depends transitively on the\n           one without a binding.  Example (with RecursiveSuperClasses)\n              class C a => D a\n              class D a => C a\n           Inert:     d1 :: C a, d2 :: D a\n           Binds:     d3 = sc_sel d2, d2 = sc_sel d1\n           Work item: d3 :: C a\n           Then it'd be ridiculous to replace d1 with d3 in the inert set!\n           Hence the findNeedEvVars test.  See Trac #14774.\n\n  * Finally, when there is still a choice, use KeepInert rather than\n    KeepWork, for two reasons:\n      - to avoid unnecessary munging of the inert set.\n      - to cut off superclass loops; see Note [Superclass loops] in TcCanonical\n\nDoing the depth-check for implicit parameters, rather than making the work item\nalways override, is important.  Consider\n\n    data T a where { T1 :: (?x::Int) => T Int; T2 :: T a }\n\n    f :: (?x::a) => T a -> Int\n    f T1 = ?x\n    f T2 = 3\n\nWe have a [G] (?x::a) in the inert set, and at the pattern match on T1 we add\ntwo new givens in the work-list:  [G] (?x::Int)\n                                  [G] (a ~ Int)\nNow consider these steps\n  - process a~Int, kicking out (?x::a)\n  - process (?x::Int), the inner given, adding to inert set\n  - process (?x::a), the outer given, overriding the inner given\nWrong!  The depth-check ensures that the inner implicit parameter wins.\n(Actually I think that the order in which the work-list is processed means\nthat this chain of events won't happen, but that's very fragile.)\n\n*********************************************************************************\n*                                                                               *\n                   interactIrred\n*                                                                               *\n*********************************************************************************\n\nNote [Multiple matching irreds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nYou might think that it's impossible to have multiple irreds all match the\nwork item; after all, interactIrred looks for matches and solves one from the\nother. However, note that interacting insoluble, non-droppable irreds does not\ndo this matching. We thus might end up with several insoluble, non-droppable,\nmatching irreds in the inert set. When another irred comes along that we have\nnot yet labeled insoluble, we can find multiple matches. These multiple matches\ncause no harm, but it would be wrong to ASSERT that they aren't there (as we\nonce had done). This problem can be tickled by typecheck/should_compile/holes.\n\n-}\n\n-- Two pieces of irreducible evidence: if their types are *exactly identical*\n-- we can rewrite them. We can never improve using this:\n-- if we want ty1 :: Constraint and have ty2 :: Constraint it clearly does not\n-- mean that (ty1 ~ ty2)\ninteractIrred :: InertCans -> Ct -> TcS (StopOrContinue Ct)\n\ninteractIrred inerts workItem@(CIrredCan { cc_ev = ev_w, cc_insol = insoluble })\n  | insoluble  -- For insolubles, don't allow the constaint to be dropped\n               -- which can happen with solveOneFromTheOther, so that\n               -- we get distinct error messages with -fdefer-type-errors\n               -- See Note [Do not add duplicate derived insolubles]\n  , not (isDroppableCt workItem)\n  = continueWith workItem\n\n  | let (matching_irreds, others) = findMatchingIrreds (inert_irreds inerts) ev_w\n  , ((ct_i, swap) : _rest) <- bagToList matching_irreds\n        -- See Note [Multiple matching irreds]\n  , let ev_i = ctEvidence ct_i\n  = do { what_next <- solveOneFromTheOther ev_i ev_w\n       ; traceTcS \"iteractIrred\" (ppr workItem $$ ppr what_next $$ ppr ct_i)\n       ; case what_next of\n            KeepInert -> do { setEvBindIfWanted ev_w (swap_me swap ev_i)\n                            ; return (Stop ev_w (text \"Irred equal\" <+> parens (ppr what_next))) }\n            KeepWork ->  do { setEvBindIfWanted ev_i (swap_me swap ev_w)\n                            ; updInertIrreds (\\_ -> others)\n                            ; continueWith workItem } }\n\n  | otherwise\n  = continueWith workItem\n\n  where\n    swap_me :: SwapFlag -> CtEvidence -> EvTerm\n    swap_me swap ev\n      = case swap of\n           NotSwapped -> ctEvTerm ev\n           IsSwapped  -> evCoercion (mkTcSymCo (evTermCoercion (ctEvTerm ev)))\n\ninteractIrred _ wi = pprPanic \"interactIrred\" (ppr wi)\n\nfindMatchingIrreds :: Cts -> CtEvidence -> (Bag (Ct, SwapFlag), Bag Ct)\nfindMatchingIrreds irreds ev\n  | EqPred eq_rel1 lty1 rty1 <- classifyPredType pred\n    -- See Note [Solving irreducible equalities]\n  = partitionBagWith (match_eq eq_rel1 lty1 rty1) irreds\n  | otherwise\n  = partitionBagWith match_non_eq irreds\n  where\n    pred = ctEvPred ev\n    match_non_eq ct\n      | ctPred ct `tcEqTypeNoKindCheck` pred = Left (ct, NotSwapped)\n      | otherwise                            = Right ct\n\n    match_eq eq_rel1 lty1 rty1 ct\n      | EqPred eq_rel2 lty2 rty2 <- classifyPredType (ctPred ct)\n      , eq_rel1 == eq_rel2\n      , Just swap <- match_eq_help lty1 rty1 lty2 rty2\n      = Left (ct, swap)\n      | otherwise\n      = Right ct\n\n    match_eq_help lty1 rty1 lty2 rty2\n      | lty1 `tcEqTypeNoKindCheck` lty2, rty1 `tcEqTypeNoKindCheck` rty2\n      = Just NotSwapped\n      | lty1 `tcEqTypeNoKindCheck` rty2, rty1 `tcEqTypeNoKindCheck` lty2\n      = Just IsSwapped\n      | otherwise\n      = Nothing\n\n{- Note [Solving irreducible equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #14333)\n  [G] a b ~R# c d\n  [W] c d ~R# a b\nClearly we should be able to solve this! Even though the constraints are\nnot decomposable. We solve this when looking up the work-item in the\nirreducible constraints to look for an identical one.  When doing this\nlookup, findMatchingIrreds spots the equality case, and matches either\nway around. It has to return a swap-flag so we can generate evidence\nthat is the right way round too.\n\nNote [Do not add duplicate derived insolubles]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn general we *must* add an insoluble (Int ~ Bool) even if there is\none such there already, because they may come from distinct call\nsites.  Not only do we want an error message for each, but with\n-fdefer-type-errors we must generate evidence for each.  But for\n*derived* insolubles, we only want to report each one once.  Why?\n\n(a) A constraint (C r s t) where r -> s, say, may generate the same fundep\n    equality many times, as the original constraint is successively rewritten.\n\n(b) Ditto the successive iterations of the main solver itself, as it traverses\n    the constraint tree. See example below.\n\nAlso for *given* insolubles we may get repeated errors, as we\nrepeatedly traverse the constraint tree.  These are relatively rare\nanyway, so removing duplicates seems ok.  (Alternatively we could take\nthe SrcLoc into account.)\n\nNote that the test does not need to be particularly efficient because\nit is only used if the program has a type error anyway.\n\nExample of (b): assume a top-level class and instance declaration:\n\n  class D a b | a -> b\n  instance D [a] [a]\n\nAssume we have started with an implication:\n\n  forall c. Eq c => { wc_simple = D [c] c [W] }\n\nwhich we have simplified to:\n\n  forall c. Eq c => { wc_simple = D [c] c [W]\n                                  (c ~ [c]) [D] }\n\nFor some reason, e.g. because we floated an equality somewhere else,\nwe might try to re-solve this implication. If we do not do a\ndropDerivedWC, then we will end up trying to solve the following\nconstraints the second time:\n\n  (D [c] c) [W]\n  (c ~ [c]) [D]\n\nwhich will result in two Deriveds to end up in the insoluble set:\n\n  wc_simple   = D [c] c [W]\n               (c ~ [c]) [D], (c ~ [c]) [D]\n-}\n\n{-\n*********************************************************************************\n*                                                                               *\n                   interactDict\n*                                                                               *\n*********************************************************************************\n\nNote [Shortcut solving]\n~~~~~~~~~~~~~~~~~~~~~~~\nWhen we interact a [W] constraint with a [G] constraint that solves it, there is\na possibility that we could produce better code if instead we solved from a\ntop-level instance declaration (See #12791, #5835). For example:\n\n    class M a b where m :: a -> b\n\n    type C a b = (Num a, M a b)\n\n    f :: C Int b => b -> Int -> Int\n    f _ x = x + 1\n\nThe body of `f` requires a [W] `Num Int` instance. We could solve this\nconstraint from the givens because we have `C Int b` and that provides us a\nsolution for `Num Int`. This would let us produce core like the following\n(with -O2):\n\n    f :: forall b. C Int b => b -> Int -> Int\n    f = \\ (@ b) ($d(%,%) :: C Int b) _ (eta1 :: Int) ->\n        + @ Int\n          (GHC.Classes.$p1(%,%) @ (Num Int) @ (M Int b) $d(%,%))\n          eta1\n          A.f1\n\nThis is bad! We could do /much/ better if we solved [W] `Num Int` directly\nfrom the instance that we have in scope:\n\n    f :: forall b. C Int b => b -> Int -> Int\n    f = \\ (@ b) _ _ (x :: Int) ->\n        case x of { GHC.Types.I# x1 -> GHC.Types.I# (GHC.Prim.+# x1 1#) }\n\n** NB: It is important to emphasize that all this is purely an optimization:\n** exactly the same programs should typecheck with or without this\n** procedure.\n\nSolving fully\n~~~~~~~~~~~~~\nThere is a reason why the solver does not simply try to solve such\nconstraints with top-level instances. If the solver finds a relevant\ninstance declaration in scope, that instance may require a context\nthat can't be solved for. A good example of this is:\n\n    f :: Ord [a] => ...\n    f x = ..Need Eq [a]...\n\nIf we have instance `Eq a => Eq [a]` in scope and we tried to use it, we would\nbe left with the obligation to solve the constraint Eq a, which we cannot. So we\nmust be conservative in our attempt to use an instance declaration to solve the\n[W] constraint we're interested in.\n\nOur rule is that we try to solve all of the instance's subgoals\nrecursively all at once. Precisely: We only attempt to solve\nconstraints of the form `C1, ... Cm => C t1 ... t n`, where all the Ci\nare themselves class constraints of the form `C1', ... Cm' => C' t1'\n... tn'` and we only succeed if the entire tree of constraints is\nsolvable from instances.\n\nAn example that succeeds:\n\n    class Eq a => C a b | b -> a where\n      m :: b -> a\n\n    f :: C [Int] b => b -> Bool\n    f x = m x == []\n\nWe solve for `Eq [Int]`, which requires `Eq Int`, which we also have. This\nproduces the following core:\n\n    f :: forall b. C [Int] b => b -> Bool\n    f = \\ (@ b) ($dC :: C [Int] b) (x :: b) ->\n        GHC.Classes.$fEq[]_$s$c==\n          (m @ [Int] @ b $dC x) (GHC.Types.[] @ Int)\n\nAn example that fails:\n\n    class Eq a => C a b | b -> a where\n      m :: b -> a\n\n    f :: C [a] b => b -> Bool\n    f x = m x == []\n\nWhich, because solving `Eq [a]` demands `Eq a` which we cannot solve, produces:\n\n    f :: forall a b. C [a] b => b -> Bool\n    f = \\ (@ a) (@ b) ($dC :: C [a] b) (eta :: b) ->\n        ==\n          @ [a]\n          (A.$p1C @ [a] @ b $dC)\n          (m @ [a] @ b $dC eta)\n          (GHC.Types.[] @ a)\n\nNote [Shortcut solving: type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have (Trac #13943)\n  class Take (n :: Nat) where ...\n  instance {-# OVERLAPPING #-}                    Take 0 where ..\n  instance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where ..\n\nAnd we have [W] Take 3.  That only matches one instance so we get\n[W] Take (3-1).  Really we should now flatten to reduce the (3-1) to 2, and\nso on -- but that is reproducing yet more of the solver.  Sigh.  For now,\nwe just give up (remember all this is just an optimisation).\n\nBut we must not just naively try to lookup (Take (3-1)) in the\nInstEnv, or it'll (wrongly) appear not to match (Take 0) and get a\nunique match on the (Take n) instance.  That leads immediately to an\ninfinite loop.  Hence the check that 'preds' have no type families\n(isTyFamFree).\n\nNote [Shortcut solving: incoherence]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis optimization relies on coherence of dictionaries to be correct. When we\ncannot assume coherence because of IncoherentInstances then this optimization\ncan change the behavior of the user's code.\n\nThe following four modules produce a program whose output would change depending\non whether we apply this optimization when IncoherentInstances is in effect:\n\n#########\n    {-# LANGUAGE MultiParamTypeClasses #-}\n    module A where\n\n    class A a where\n      int :: a -> Int\n\n    class A a => C a b where\n      m :: b -> a -> a\n\n#########\n    {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n    module B where\n\n    import A\n\n    instance A a where\n      int _ = 1\n\n    instance C a [b] where\n      m _ = id\n\n#########\n    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}\n    {-# LANGUAGE IncoherentInstances #-}\n    module C where\n\n    import A\n\n    instance A Int where\n      int _ = 2\n\n    instance C Int [Int] where\n      m _ = id\n\n    intC :: C Int a => a -> Int -> Int\n    intC _ x = int x\n\n#########\n    module Main where\n\n    import A\n    import B\n    import C\n\n    main :: IO ()\n    main = print (intC [] (0::Int))\n\nThe output of `main` if we avoid the optimization under the effect of\nIncoherentInstances is `1`. If we were to do the optimization, the output of\n`main` would be `2`.\n\nNote [Shortcut try_solve_from_instance]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe workhorse of the short-cut solver is\n    try_solve_from_instance :: (EvBindMap, DictMap CtEvidence)\n                            -> CtEvidence       -- Solve this\n                            -> MaybeT TcS (EvBindMap, DictMap CtEvidence)\nNote that:\n\n* The CtEvidence is the goal to be solved\n\n* The MaybeT anages early failure if we find a subgoal that\n  cannot be solved from instances.\n\n* The (EvBindMap, DictMap CtEvidence) is an accumulating purely-functional\n  state that allows try_solve_from_instance to augmennt the evidence\n  bindings and inert_solved_dicts as it goes.\n\n  If it succeeds, we commit all these bindings and solved dicts to the\n  main TcS InertSet.  If not, we abandon it all entirely.\n\nPassing along the solved_dicts important for two reasons:\n\n* We need to be able to handle recursive super classes. The\n  solved_dicts state  ensures that we remember what we have already\n  tried to solve to avoid looping.\n\n* As Trac #15164 showed, it can be important to exploit sharing between\n  goals. E.g. To solve G we may need G1 and G2. To solve G1 we may need H;\n  and to solve G2 we may need H. If we don't spot this sharing we may\n  solve H twice; and if this pattern repeats we may get exponentially bad\n  behaviour.\n-}\n\ninteractDict :: InertCans -> Ct -> TcS (StopOrContinue Ct)\ninteractDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs = tys })\n  | Just ev_i <- lookupInertDict inerts (ctEvLoc ev_w) cls tys\n  = -- There is a matching dictionary in the inert set\n    do { -- First to try to solve it /completely/ from top level instances\n         -- See Note [Shortcut solving]\n         dflags <- getDynFlags\n       ; short_cut_worked <- shortCutSolver dflags ev_w ev_i\n       ; if short_cut_worked\n         then stopWith ev_w \"interactDict/solved from instance\"\n         else\n\n    do { -- Ths short-cut solver didn't fire, so we\n         -- solve ev_w from the matching inert ev_i we found\n         what_next <- solveOneFromTheOther ev_i ev_w\n       ; traceTcS \"lookupInertDict\" (ppr what_next)\n       ; case what_next of\n           KeepInert -> do { setEvBindIfWanted ev_w (ctEvTerm ev_i)\n                           ; return $ Stop ev_w (text \"Dict equal\" <+> parens (ppr what_next)) }\n           KeepWork  -> do { setEvBindIfWanted ev_i (ctEvTerm ev_w)\n                           ; updInertDicts $ \\ ds -> delDict ds cls tys\n                           ; continueWith workItem } } }\n\n  | cls `hasKey` ipClassKey\n  , isGiven ev_w\n  = interactGivenIP inerts workItem\n\n  | otherwise\n  = do { addFunDepWork inerts ev_w cls\n       ; continueWith workItem  }\n\ninteractDict _ wi = pprPanic \"interactDict\" (ppr wi)\n\n-- See Note [Shortcut solving]\nshortCutSolver :: DynFlags\n               -> CtEvidence -- Work item\n               -> CtEvidence -- Inert we want to try to replace\n               -> TcS Bool   -- True <=> success\nshortCutSolver dflags ev_w ev_i\n  | isWanted ev_w\n && isGiven ev_i\n -- We are about to solve a [W] constraint from a [G] constraint. We take\n -- a moment to see if we can get a better solution using an instance.\n -- Note that we only do this for the sake of performance. Exactly the same\n -- programs should typecheck regardless of whether we take this step or\n -- not. See Note [Shortcut solving]\n\n && not (xopt LangExt.IncoherentInstances dflags)\n -- If IncoherentInstances is on then we cannot rely on coherence of proofs\n -- in order to justify this optimization: The proof provided by the\n -- [G] constraint's superclass may be different from the top-level proof.\n -- See Note [Shortcut solving: incoherence]\n\n && gopt Opt_SolveConstantDicts dflags\n -- Enabled by the -fsolve-constant-dicts flag\n  = do { ev_binds_var <- getTcEvBindsVar\n       ; ev_binds <- ASSERT2( not (isCoEvBindsVar ev_binds_var ), ppr ev_w )\n                     getTcEvBindsMap ev_binds_var\n       ; solved_dicts <- getSolvedDicts\n\n       ; mb_stuff <- runMaybeT $ try_solve_from_instance\n                                   (ev_binds, solved_dicts) ev_w\n\n       ; case mb_stuff of\n           Nothing -> return False\n           Just (ev_binds', solved_dicts')\n              -> do { setTcEvBindsMap ev_binds_var ev_binds'\n                    ; setSolvedDicts solved_dicts'\n                    ; return True } }\n\n  | otherwise\n  = return False\n  where\n    -- This `CtLoc` is used only to check the well-staged condition of any\n    -- candidate DFun. Our subgoals all have the same stage as our root\n    -- [W] constraint so it is safe to use this while solving them.\n    loc_w = ctEvLoc ev_w\n\n    try_solve_from_instance   -- See Note [Shortcut try_solve_from_instance]\n      :: (EvBindMap, DictMap CtEvidence) -> CtEvidence\n      -> MaybeT TcS (EvBindMap, DictMap CtEvidence)\n    try_solve_from_instance (ev_binds, solved_dicts) ev\n      | let pred = ctEvPred ev\n            loc  = ctEvLoc  ev\n      , ClassPred cls tys <- classifyPredType pred\n      = do { inst_res <- lift $ matchGlobalInst dflags True cls tys\n           ; case inst_res of\n               OneInst { cir_new_theta = preds\n                       , cir_mk_ev     = mk_ev\n                       , cir_what      = what }\n                 | safeOverlap what\n                 , all isTyFamFree preds  -- Note [Shortcut solving: type families]\n                 -> do { let solved_dicts' = addDict solved_dicts cls tys ev\n                             -- solved_dicts': it is important that we add our goal\n                             -- to the cache before we solve! Otherwise we may end\n                             -- up in a loop while solving recursive dictionaries.\n\n                       ; lift $ traceTcS \"shortCutSolver: found instance\" (ppr preds)\n                       ; loc' <- lift $ checkInstanceOK loc what pred\n\n                       ; evc_vs <- mapM (new_wanted_cached loc' solved_dicts') preds\n                                  -- Emit work for subgoals but use our local cache\n                                  -- so we can solve recursive dictionaries.\n\n                       ; let ev_tm     = mk_ev (map getEvExpr evc_vs)\n                             ev_binds' = extendEvBinds ev_binds $\n                                         mkWantedEvBind (ctEvEvId ev) ev_tm\n\n                       ; foldlM try_solve_from_instance\n                                (ev_binds', solved_dicts')\n                                (freshGoals evc_vs) }\n\n               _ -> mzero }\n      | otherwise = mzero\n\n\n    -- Use a local cache of solved dicts while emitting EvVars for new work\n    -- We bail out of the entire computation if we need to emit an EvVar for\n    -- a subgoal that isn't a ClassPred.\n    new_wanted_cached :: CtLoc -> DictMap CtEvidence -> TcPredType -> MaybeT TcS MaybeNew\n    new_wanted_cached loc cache pty\n      | ClassPred cls tys <- classifyPredType pty\n      = lift $ case findDict cache loc_w cls tys of\n          Just ctev -> return $ Cached (ctEvExpr ctev)\n          Nothing   -> Fresh <$> newWantedNC loc pty\n      | otherwise = mzero\n\naddFunDepWork :: InertCans -> CtEvidence -> Class -> TcS ()\n-- Add derived constraints from type-class functional dependencies.\naddFunDepWork inerts work_ev cls\n  | isImprovable work_ev\n  = mapBagM_ add_fds (findDictsByClass (inert_dicts inerts) cls)\n               -- No need to check flavour; fundeps work between\n               -- any pair of constraints, regardless of flavour\n               -- Importantly we don't throw workitem back in the\n               -- worklist because this can cause loops (see #5236)\n  | otherwise\n  = return ()\n  where\n    work_pred = ctEvPred work_ev\n    work_loc  = ctEvLoc work_ev\n\n    add_fds inert_ct\n      | isImprovable inert_ev\n      = do { traceTcS \"addFunDepWork\" (vcat\n                [ ppr work_ev\n                , pprCtLoc work_loc, ppr (isGivenLoc work_loc)\n                , pprCtLoc inert_loc, ppr (isGivenLoc inert_loc)\n                , pprCtLoc derived_loc, ppr (isGivenLoc derived_loc) ]) ;\n\n        emitFunDepDeriveds $\n        improveFromAnother derived_loc inert_pred work_pred\n               -- We don't really rewrite tys2, see below _rewritten_tys2, so that's ok\n               -- NB: We do create FDs for given to report insoluble equations that arise\n               -- from pairs of Givens, and also because of floating when we approximate\n               -- implications. The relevant test is: typecheck/should_fail/FDsFromGivens.hs\n        }\n      | otherwise\n      = return ()\n      where\n        inert_ev   = ctEvidence inert_ct\n        inert_pred = ctEvPred inert_ev\n        inert_loc  = ctEvLoc inert_ev\n        derived_loc = work_loc { ctl_depth  = ctl_depth work_loc `maxSubGoalDepth`\n                                              ctl_depth inert_loc\n                               , ctl_origin = FunDepOrigin1 work_pred  work_loc\n                                                            inert_pred inert_loc }\n\n{-\n**********************************************************************\n*                                                                    *\n                   Implicit parameters\n*                                                                    *\n**********************************************************************\n-}\n\ninteractGivenIP :: InertCans -> Ct -> TcS (StopOrContinue Ct)\n-- Work item is Given (?x:ty)\n-- See Note [Shadowing of Implicit Parameters]\ninteractGivenIP inerts workItem@(CDictCan { cc_ev = ev, cc_class = cls\n                                          , cc_tyargs = tys@(ip_str:_) })\n  = do { updInertCans $ \\cans -> cans { inert_dicts = addDict filtered_dicts cls tys workItem }\n       ; stopWith ev \"Given IP\" }\n  where\n    dicts           = inert_dicts inerts\n    ip_dicts        = findDictsByClass dicts cls\n    other_ip_dicts  = filterBag (not . is_this_ip) ip_dicts\n    filtered_dicts  = addDictsByClass dicts cls other_ip_dicts\n\n    -- Pick out any Given constraints for the same implicit parameter\n    is_this_ip (CDictCan { cc_ev = ev, cc_tyargs = ip_str':_ })\n       = isGiven ev && ip_str `tcEqType` ip_str'\n    is_this_ip _ = False\n\ninteractGivenIP _ wi = pprPanic \"interactGivenIP\" (ppr wi)\n\n{- Note [Shadowing of Implicit Parameters]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following example:\n\nf :: (?x :: Char) => Char\nf = let ?x = 'a' in ?x\n\nThe \"let ?x = ...\" generates an implication constraint of the form:\n\n?x :: Char => ?x :: Char\n\nFurthermore, the signature for `f` also generates an implication\nconstraint, so we end up with the following nested implication:\n\n?x :: Char => (?x :: Char => ?x :: Char)\n\nNote that the wanted (?x :: Char) constraint may be solved in\ntwo incompatible ways:  either by using the parameter from the\nsignature, or by using the local definition.  Our intention is\nthat the local definition should \"shadow\" the parameter of the\nsignature, and we implement this as follows: when we add a new\n*given* implicit parameter to the inert set, it replaces any existing\ngivens for the same implicit parameter.\n\nSimilarly, consider\n   f :: (?x::a) => Bool -> a\n\n   g v = let ?x::Int = 3\n         in (f v, let ?x::Bool = True in f v)\n\nThis should probably be well typed, with\n   g :: Bool -> (Int, Bool)\n\nSo the inner binding for ?x::Bool *overrides* the outer one.\n\nAll this works for the normal cases but it has an odd side effect in\nsome pathological programs like this:\n-- This is accepted, the second parameter shadows\nf1 :: (?x :: Int, ?x :: Char) => Char\nf1 = ?x\n\n-- This is rejected, the second parameter shadows\nf2 :: (?x :: Int, ?x :: Char) => Int\nf2 = ?x\n\nBoth of these are actually wrong:  when we try to use either one,\nwe'll get two incompatible wanted constraints (?x :: Int, ?x :: Char),\nwhich would lead to an error.\n\nI can think of two ways to fix this:\n\n  1. Simply disallow multiple constraints for the same implicit\n    parameter---this is never useful, and it can be detected completely\n    syntactically.\n\n  2. Move the shadowing machinery to the location where we nest\n     implications, and add some code here that will produce an\n     error if we get multiple givens for the same implicit parameter.\n\n\n**********************************************************************\n*                                                                    *\n                   interactFunEq\n*                                                                    *\n**********************************************************************\n-}\n\ninteractFunEq :: InertCans -> Ct -> TcS (StopOrContinue Ct)\n-- Try interacting the work item with the inert set\ninteractFunEq inerts work_item@(CFunEqCan { cc_ev = ev, cc_fun = tc\n                                          , cc_tyargs = args, cc_fsk = fsk })\n  | Just inert_ct@(CFunEqCan { cc_ev = ev_i\n                             , cc_fsk = fsk_i })\n         <- findFunEq (inert_funeqs inerts) tc args\n  , pr@(swap_flag, upgrade_flag) <- ev_i `funEqCanDischarge` ev\n  = do { traceTcS \"reactFunEq (rewrite inert item):\" $\n         vcat [ text \"work_item =\" <+> ppr work_item\n              , text \"inertItem=\" <+> ppr ev_i\n              , text \"(swap_flag, upgrade)\" <+> ppr pr ]\n       ; if isSwapped swap_flag\n         then do {   -- Rewrite inert using work-item\n                   let work_item' | upgrade_flag = upgradeWanted work_item\n                                  | otherwise    = work_item\n                 ; updInertFunEqs $ \\ feqs -> insertFunEq feqs tc args work_item'\n                      -- Do the updInertFunEqs before the reactFunEq, so that\n                      -- we don't kick out the inertItem as well as consuming it!\n                 ; reactFunEq ev fsk ev_i fsk_i\n                 ; stopWith ev \"Work item rewrites inert\" }\n         else do {   -- Rewrite work-item using inert\n                 ; when upgrade_flag $\n                   updInertFunEqs $ \\ feqs -> insertFunEq feqs tc args\n                                                 (upgradeWanted inert_ct)\n                 ; reactFunEq ev_i fsk_i ev fsk\n                 ; stopWith ev \"Inert rewrites work item\" } }\n\n  | otherwise   -- Try improvement\n  = do { improveLocalFunEqs ev inerts tc args fsk\n       ; continueWith work_item }\n\ninteractFunEq _ work_item = pprPanic \"interactFunEq\" (ppr work_item)\n\nupgradeWanted :: Ct -> Ct\n-- We are combining a [W] F tys ~ fmv1 and [D] F tys ~ fmv2\n-- so upgrade the [W] to [WD] before putting it in the inert set\nupgradeWanted ct = ct { cc_ev = upgrade_ev (cc_ev ct) }\n  where\n    upgrade_ev ev = ASSERT2( isWanted ev, ppr ct )\n                    ev { ctev_nosh = WDeriv }\n\nimproveLocalFunEqs :: CtEvidence -> InertCans -> TyCon -> [TcType] -> TcTyVar\n                   -> TcS ()\n-- Generate derived improvement equalities, by comparing\n-- the current work item with inert CFunEqs\n-- E.g.   x + y ~ z,   x + y' ~ z   =>   [D] y ~ y'\n--\n-- See Note [FunDep and implicit parameter reactions]\nimproveLocalFunEqs work_ev inerts fam_tc args fsk\n  | isGiven work_ev -- See Note [No FunEq improvement for Givens]\n    || not (isImprovable work_ev)\n  = return ()\n\n  | not (null improvement_eqns)\n  = do { traceTcS \"interactFunEq improvements: \" $\n         vcat [ text \"Eqns:\" <+> ppr improvement_eqns\n              , text \"Candidates:\" <+> ppr funeqs_for_tc\n              , text \"Inert eqs:\" <+> ppr ieqs ]\n       ; emitFunDepDeriveds improvement_eqns }\n\n  | otherwise\n  = return ()\n\n  where\n    ieqs          = inert_eqs inerts\n    funeqs        = inert_funeqs inerts\n    funeqs_for_tc = findFunEqsByTyCon funeqs fam_tc\n    rhs           = lookupFlattenTyVar ieqs fsk\n    work_loc      = ctEvLoc work_ev\n    work_pred     = ctEvPred work_ev\n    fam_inj_info  = tyConInjectivityInfo fam_tc\n\n    --------------------\n    improvement_eqns :: [FunDepEqn CtLoc]\n    improvement_eqns\n      | Just ops <- isBuiltInSynFamTyCon_maybe fam_tc\n      =    -- Try built-in families, notably for arithmethic\n         concatMap (do_one_built_in ops) funeqs_for_tc\n\n      | Injective injective_args <- fam_inj_info\n      =    -- Try improvement from type families with injectivity annotations\n        concatMap (do_one_injective injective_args) funeqs_for_tc\n\n      | otherwise\n      = []\n\n    --------------------\n    do_one_built_in ops (CFunEqCan { cc_tyargs = iargs, cc_fsk = ifsk, cc_ev = inert_ev })\n      = mk_fd_eqns inert_ev (sfInteractInert ops args rhs iargs\n                                             (lookupFlattenTyVar ieqs ifsk))\n\n    do_one_built_in _ _ = pprPanic \"interactFunEq 1\" (ppr fam_tc)\n\n    --------------------\n    -- See Note [Type inference for type families with injectivity]\n    do_one_injective inj_args (CFunEqCan { cc_tyargs = inert_args\n                                         , cc_fsk = ifsk, cc_ev = inert_ev })\n      | isImprovable inert_ev\n      , rhs `tcEqType` lookupFlattenTyVar ieqs ifsk\n      = mk_fd_eqns inert_ev $\n            [ Pair arg iarg\n            | (arg, iarg, True) <- zip3 args inert_args inj_args ]\n      | otherwise\n      = []\n\n    do_one_injective _ _ = pprPanic \"interactFunEq 2\" (ppr fam_tc)\n\n    --------------------\n    mk_fd_eqns :: CtEvidence -> [TypeEqn] -> [FunDepEqn CtLoc]\n    mk_fd_eqns inert_ev eqns\n      | null eqns  = []\n      | otherwise  = [ FDEqn { fd_qtvs = [], fd_eqs = eqns\n                             , fd_pred1 = work_pred\n                             , fd_pred2 = ctEvPred inert_ev\n                             , fd_loc   = loc } ]\n      where\n        inert_loc = ctEvLoc inert_ev\n        loc = inert_loc { ctl_depth = ctl_depth inert_loc `maxSubGoalDepth`\n                                      ctl_depth work_loc }\n\n-------------\nreactFunEq :: CtEvidence -> TcTyVar    -- From this  :: F args1 ~ fsk1\n           -> CtEvidence -> TcTyVar    -- Solve this :: F args2 ~ fsk2\n           -> TcS ()\nreactFunEq from_this fsk1 solve_this fsk2\n  = do { traceTcS \"reactFunEq\"\n            (vcat [ppr from_this, ppr fsk1, ppr solve_this, ppr fsk2])\n       ; dischargeFunEq solve_this fsk2 (ctEvCoercion from_this) (mkTyVarTy fsk1)\n       ; traceTcS \"reactFunEq done\" (ppr from_this $$ ppr fsk1 $$\n                                     ppr solve_this $$ ppr fsk2) }\n\n{- Note [Type inference for type families with injectivity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have a type family with an injectivity annotation:\n    type family F a b = r | r -> b\n\nThen if we have two CFunEqCan constraints for F with the same RHS\n   F s1 t1 ~ rhs\n   F s2 t2 ~ rhs\nthen we can use the injectivity to get a new Derived constraint on\nthe injective argument\n  [D] t1 ~ t2\n\nThat in turn can help GHC solve constraints that would otherwise require\nguessing.  For example, consider the ambiguity check for\n   f :: F Int b -> Int\nWe get the constraint\n   [W] F Int b ~ F Int beta\nwhere beta is a unification variable.  Injectivity lets us pick beta ~ b.\n\nInjectivity information is also used at the call sites. For example:\n   g = f True\ngives rise to\n   [W] F Int b ~ Bool\nfrom which we can derive b.  This requires looking at the defining equations of\na type family, ie. finding equation with a matching RHS (Bool in this example)\nand infering values of type variables (b in this example) from the LHS patterns\nof the matching equation.  For closed type families we have to perform\nadditional apartness check for the selected equation to check that the selected\nis guaranteed to fire for given LHS arguments.\n\nThese new constraints are simply *Derived* constraints; they have no evidence.\nWe could go further and offer evidence from decomposing injective type-function\napplications, but that would require new evidence forms, and an extension to\nFC, so we don't do that right now (Dec 14).\n\nSee also Note [Injective type families] in TyCon\n\n\nNote [Cache-caused loops]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is very dangerous to cache a rewritten wanted family equation as 'solved' in our\nsolved cache (which is the default behaviour or xCtEvidence), because the interaction\nmay not be contributing towards a solution. Here is an example:\n\nInitial inert set:\n  [W] g1 : F a ~ beta1\nWork item:\n  [W] g2 : F a ~ beta2\nThe work item will react with the inert yielding the _same_ inert set plus:\n    (i)   Will set g2 := g1 `cast` g3\n    (ii)  Will add to our solved cache that [S] g2 : F a ~ beta2\n    (iii) Will emit [W] g3 : beta1 ~ beta2\nNow, the g3 work item will be spontaneously solved to [G] g3 : beta1 ~ beta2\nand then it will react the item in the inert ([W] g1 : F a ~ beta1). So it\nwill set\n      g1 := g ; sym g3\nand what is g? Well it would ideally be a new goal of type (F a ~ beta2) but\nremember that we have this in our solved cache, and it is ... g2! In short we\ncreated the evidence loop:\n\n        g2 := g1 ; g3\n        g3 := refl\n        g1 := g2 ; sym g3\n\nTo avoid this situation we do not cache as solved any workitems (or inert)\nwhich did not really made a 'step' towards proving some goal. Solved's are\njust an optimization so we don't lose anything in terms of completeness of\nsolving.\n\n\nNote [Efficient Orientation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we are interacting two FunEqCans with the same LHS:\n          (inert)  ci :: (F ty ~ xi_i)\n          (work)   cw :: (F ty ~ xi_w)\nWe prefer to keep the inert (else we pass the work item on down\nthe pipeline, which is a bit silly).  If we keep the inert, we\nwill (a) discharge 'cw'\n     (b) produce a new equality work-item (xi_w ~ xi_i)\nNotice the orientation (xi_w ~ xi_i) NOT (xi_i ~ xi_w):\n    new_work :: xi_w ~ xi_i\n    cw := ci ; sym new_work\nWhy?  Consider the simplest case when xi1 is a type variable.  If\nwe generate xi1~xi2, porcessing that constraint will kick out 'ci'.\nIf we generate xi2~xi1, there is less chance of that happening.\nOf course it can and should still happen if xi1=a, xi1=Int, say.\nBut we want to avoid it happening needlessly.\n\nSimilarly, if we *can't* keep the inert item (because inert is Wanted,\nand work is Given, say), we prefer to orient the new equality (xi_i ~\nxi_w).\n\nNote [Carefully solve the right CFunEqCan]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n   ---- OLD COMMENT, NOW NOT NEEDED\n   ---- because we now allow multiple\n   ---- wanted FunEqs with the same head\nConsider the constraints\n  c1 :: F Int ~ a      -- Arising from an application line 5\n  c2 :: F Int ~ Bool   -- Arising from an application line 10\nSuppose that 'a' is a unification variable, arising only from\nflattening.  So there is no error on line 5; it's just a flattening\nvariable.  But there is (or might be) an error on line 10.\n\nTwo ways to combine them, leaving either (Plan A)\n  c1 :: F Int ~ a      -- Arising from an application line 5\n  c3 :: a ~ Bool       -- Arising from an application line 10\nor (Plan B)\n  c2 :: F Int ~ Bool   -- Arising from an application line 10\n  c4 :: a ~ Bool       -- Arising from an application line 5\n\nPlan A will unify c3, leaving c1 :: F Int ~ Bool as an error\non the *totally innocent* line 5.  An example is test SimpleFail16\nwhere the expected/actual message comes out backwards if we use\nthe wrong plan.\n\nThe second is the right thing to do.  Hence the isMetaTyVarTy\ntest when solving pairwise CFunEqCan.\n\n\n**********************************************************************\n*                                                                    *\n                   interactTyVarEq\n*                                                                    *\n**********************************************************************\n-}\n\ninertsCanDischarge :: InertCans -> TcTyVar -> TcType -> CtFlavourRole\n                   -> Maybe ( CtEvidence  -- The evidence for the inert\n                            , SwapFlag    -- Whether we need mkSymCo\n                            , Bool)       -- True <=> keep a [D] version\n                                          --          of the [WD] constraint\ninertsCanDischarge inerts tv rhs fr\n  | (ev_i : _) <- [ ev_i | CTyEqCan { cc_ev = ev_i, cc_rhs = rhs_i\n                                    , cc_eq_rel = eq_rel }\n                             <- findTyEqs inerts tv\n                         , (ctEvFlavour ev_i, eq_rel) `eqCanDischargeFR` fr\n                         , rhs_i `tcEqType` rhs ]\n  =  -- Inert:     a ~ ty\n     -- Work item: a ~ ty\n    Just (ev_i, NotSwapped, keep_deriv ev_i)\n\n  | Just tv_rhs <- getTyVar_maybe rhs\n  , (ev_i : _) <- [ ev_i | CTyEqCan { cc_ev = ev_i, cc_rhs = rhs_i\n                                    , cc_eq_rel = eq_rel }\n                             <- findTyEqs inerts tv_rhs\n                         , (ctEvFlavour ev_i, eq_rel) `eqCanDischargeFR` fr\n                         , rhs_i `tcEqType` mkTyVarTy tv ]\n  =  -- Inert:     a ~ b\n     -- Work item: b ~ a\n     Just (ev_i, IsSwapped, keep_deriv ev_i)\n\n  | otherwise\n  = Nothing\n\n  where\n    keep_deriv ev_i\n      | Wanted WOnly  <- ctEvFlavour ev_i  -- inert is [W]\n      , (Wanted WDeriv, _) <- fr           -- work item is [WD]\n      = True   -- Keep a derived verison of the work item\n      | otherwise\n      = False  -- Work item is fully discharged\n\ninteractTyVarEq :: InertCans -> Ct -> TcS (StopOrContinue Ct)\n-- CTyEqCans are always consumed, so always returns Stop\ninteractTyVarEq inerts workItem@(CTyEqCan { cc_tyvar = tv\n                                          , cc_rhs = rhs\n                                          , cc_ev = ev\n                                          , cc_eq_rel = eq_rel })\n  | Just (ev_i, swapped, keep_deriv)\n       <- inertsCanDischarge inerts tv rhs (ctEvFlavour ev, eq_rel)\n  = do { setEvBindIfWanted ev $\n         evCoercion (maybeSym swapped $\n                     tcDowngradeRole (eqRelRole eq_rel)\n                                     (ctEvRole ev_i)\n                                     (ctEvCoercion ev_i))\n\n       ; let deriv_ev = CtDerived { ctev_pred = ctEvPred ev\n                                  , ctev_loc  = ctEvLoc  ev }\n       ; when keep_deriv $\n         emitWork [workItem { cc_ev = deriv_ev }]\n         -- As a Derived it might not be fully rewritten,\n         -- so we emit it as new work\n\n       ; stopWith ev \"Solved from inert\" }\n\n  | ReprEq <- eq_rel   -- See Note [Do not unify representational equalities]\n  = do { traceTcS \"Not unifying representational equality\" (ppr workItem)\n       ; continueWith workItem }\n\n  | isGiven ev         -- See Note [Touchables and givens]\n  = continueWith workItem\n\n  | otherwise\n  = do { tclvl <- getTcLevel\n       ; if canSolveByUnification tclvl tv rhs\n         then do { solveByUnification ev tv rhs\n                 ; n_kicked <- kickOutAfterUnification tv\n                 ; return (Stop ev (text \"Solved by unification\" <+> pprKicked n_kicked)) }\n\n         else continueWith workItem }\n\ninteractTyVarEq _ wi = pprPanic \"interactTyVarEq\" (ppr wi)\n\nsolveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS ()\n-- Solve with the identity coercion\n-- Precondition: kind(xi) equals kind(tv)\n-- Precondition: CtEvidence is Wanted or Derived\n-- Precondition: CtEvidence is nominal\n-- Returns: workItem where\n--        workItem = the new Given constraint\n--\n-- NB: No need for an occurs check here, because solveByUnification always\n--     arises from a CTyEqCan, a *canonical* constraint.  Its invariants\n--     say that in (a ~ xi), the type variable a does not appear in xi.\n--     See TcRnTypes.Ct invariants.\n--\n-- Post: tv is unified (by side effect) with xi;\n--       we often write tv := xi\nsolveByUnification wd tv xi\n  = do { let tv_ty = mkTyVarTy tv\n       ; traceTcS \"Sneaky unification:\" $\n                       vcat [text \"Unifies:\" <+> ppr tv <+> text \":=\" <+> ppr xi,\n                             text \"Coercion:\" <+> pprEq tv_ty xi,\n                             text \"Left Kind is:\" <+> ppr (tcTypeKind tv_ty),\n                             text \"Right Kind is:\" <+> ppr (tcTypeKind xi) ]\n\n       ; unifyTyVar tv xi\n       ; setEvBindIfWanted wd (evCoercion (mkTcNomReflCo xi)) }\n\n{- Note [Avoid double unifications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe spontaneous solver has to return a given which mentions the unified unification\nvariable *on the left* of the equality. Here is what happens if not:\n  Original wanted:  (a ~ alpha),  (alpha ~ Int)\nWe spontaneously solve the first wanted, without changing the order!\n      given : a ~ alpha      [having unified alpha := a]\nNow the second wanted comes along, but he cannot rewrite the given, so we simply continue.\nAt the end we spontaneously solve that guy, *reunifying*  [alpha := Int]\n\nWe avoid this problem by orienting the resulting given so that the unification\nvariable is on the left.  [Note that alternatively we could attempt to\nenforce this at canonicalization]\n\nSee also Note [No touchables as FunEq RHS] in TcSMonad; avoiding\ndouble unifications is the main reason we disallow touchable\nunification variables as RHS of type family equations: F xis ~ alpha.\n\nNote [Do not unify representational equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider   [W] alpha ~R# b\nwhere alpha is touchable. Should we unify alpha := b?\n\nCertainly not!  Unifying forces alpha and be to be the same; but they\nonly need to be representationally equal types.\n\nFor example, we might have another constraint [W] alpha ~# N b\nwhere\n  newtype N b = MkN b\nand we want to get alpha := N b.\n\nSee also Trac #15144, which was caused by unifying a representational\nequality (in the unflattener).\n\n\n************************************************************************\n*                                                                      *\n*          Functional dependencies, instantiation of equations\n*                                                                      *\n************************************************************************\n\nWhen we spot an equality arising from a functional dependency,\nwe now use that equality (a \"wanted\") to rewrite the work-item\nconstraint right away.  This avoids two dangers\n\n Danger 1: If we send the original constraint on down the pipeline\n           it may react with an instance declaration, and in delicate\n           situations (when a Given overlaps with an instance) that\n           may produce new insoluble goals: see Trac #4952\n\n Danger 2: If we don't rewrite the constraint, it may re-react\n           with the same thing later, and produce the same equality\n           again --> termination worries.\n\nTo achieve this required some refactoring of FunDeps.hs (nicer\nnow!).\n\nNote [FunDep and implicit parameter reactions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCurrently, our story of interacting two dictionaries (or a dictionary\nand top-level instances) for functional dependencies, and implicit\nparameters, is that we simply produce new Derived equalities.  So for example\n\n        class D a b | a -> b where ...\n    Inert:\n        d1 :g D Int Bool\n    WorkItem:\n        d2 :w D Int alpha\n\n    We generate the extra work item\n        cv :d alpha ~ Bool\n    where 'cv' is currently unused.  However, this new item can perhaps be\n    spontaneously solved to become given and react with d2,\n    discharging it in favour of a new constraint d2' thus:\n        d2' :w D Int Bool\n        d2 := d2' |> D Int cv\n    Now d2' can be discharged from d1\n\nWe could be more aggressive and try to *immediately* solve the dictionary\nusing those extra equalities, but that requires those equalities to carry\nevidence and derived do not carry evidence.\n\nIf that were the case with the same inert set and work item we might dischard\nd2 directly:\n\n        cv :w alpha ~ Bool\n        d2 := d1 |> D Int cv\n\nBut in general it's a bit painful to figure out the necessary coercion,\nso we just take the first approach. Here is a better example. Consider:\n    class C a b c | a -> b\nAnd:\n     [Given]  d1 : C T Int Char\n     [Wanted] d2 : C T beta Int\nIn this case, it's *not even possible* to solve the wanted immediately.\nSo we should simply output the functional dependency and add this guy\n[but NOT its superclasses] back in the worklist. Even worse:\n     [Given] d1 : C T Int beta\n     [Wanted] d2: C T beta Int\nThen it is solvable, but its very hard to detect this on the spot.\n\nIt's exactly the same with implicit parameters, except that the\n\"aggressive\" approach would be much easier to implement.\n\nNote [Weird fundeps]\n~~~~~~~~~~~~~~~~~~~~\nConsider   class Het a b | a -> b where\n              het :: m (f c) -> a -> m b\n\n           class GHet (a :: * -> *) (b :: * -> *) | a -> b\n           instance            GHet (K a) (K [a])\n           instance Het a b => GHet (K a) (K b)\n\nThe two instances don't actually conflict on their fundeps,\nalthough it's pretty strange.  So they are both accepted. Now\ntry   [W] GHet (K Int) (K Bool)\nThis triggers fundeps from both instance decls;\n      [D] K Bool ~ K [a]\n      [D] K Bool ~ K beta\nAnd there's a risk of complaining about Bool ~ [a].  But in fact\nthe Wanted matches the second instance, so we never get as far\nas the fundeps.\n\nTrac #7875 is a case in point.\n-}\n\nemitFunDepDeriveds :: [FunDepEqn CtLoc] -> TcS ()\n-- See Note [FunDep and implicit parameter reactions]\nemitFunDepDeriveds fd_eqns\n  = mapM_ do_one_FDEqn fd_eqns\n  where\n    do_one_FDEqn (FDEqn { fd_qtvs = tvs, fd_eqs = eqs, fd_loc = loc })\n     | null tvs  -- Common shortcut\n     = do { traceTcS \"emitFunDepDeriveds 1\" (ppr (ctl_depth loc) $$ ppr eqs $$ ppr (isGivenLoc loc))\n          ; mapM_ (unifyDerived loc Nominal) eqs }\n     | otherwise\n     = do { traceTcS \"emitFunDepDeriveds 2\" (ppr (ctl_depth loc) $$ ppr tvs $$ ppr eqs)\n          ; subst <- instFlexi tvs  -- Takes account of kind substitution\n          ; mapM_ (do_one_eq loc subst) eqs }\n\n    do_one_eq loc subst (Pair ty1 ty2)\n       = unifyDerived loc Nominal $\n         Pair (Type.substTyUnchecked subst ty1) (Type.substTyUnchecked subst ty2)\n\n{-\n**********************************************************************\n*                                                                    *\n                       The top-reaction Stage\n*                                                                    *\n**********************************************************************\n-}\n\ntopReactionsStage :: WorkItem -> TcS (StopOrContinue Ct)\n-- The work item does not react with the inert set,\n-- so try interaction with top-level instances. Note:\ntopReactionsStage work_item\n  = do { traceTcS \"doTopReact\" (ppr work_item)\n       ; case work_item of\n           CDictCan {}  -> do { inerts <- getTcSInerts\n                              ; doTopReactDict inerts work_item }\n           CFunEqCan {} -> doTopReactFunEq work_item\n           CIrredCan {} -> doTopReactOther work_item\n           CTyEqCan {}  -> doTopReactOther work_item\n           _  -> -- Any other work item does not react with any top-level equations\n                 continueWith work_item  }\n\n\n--------------------\ndoTopReactOther :: Ct -> TcS (StopOrContinue Ct)\n-- Try local quantified constraints for\n--     CTyEqCan  e.g.  (a ~# ty)\n-- and CIrredCan e.g.  (c a)\n--\n-- Why equalities? See TcCanonical\n-- Note [Equality superclasses in quantified constraints]\ndoTopReactOther work_item\n  | isGiven ev\n  = continueWith work_item\n\n  | EqPred eq_rel t1 t2 <- classifyPredType pred\n  = -- See Note [Looking up primitive equalities in quantified constraints]\n    case boxEqPred eq_rel t1 t2 of\n      Nothing -> continueWith work_item\n      Just (cls, tys)\n        -> do { res <- matchLocalInst (mkClassPred cls tys) loc\n              ; case res of\n                  OneInst { cir_mk_ev = mk_ev }\n                    -> chooseInstance work_item\n                           (res { cir_mk_ev = mk_eq_ev cls tys mk_ev })\n                    where\n                  _ -> continueWith work_item }\n\n  | otherwise\n  = do { res <- matchLocalInst pred loc\n       ; case res of\n           OneInst {} -> chooseInstance work_item res\n           _          -> continueWith work_item }\n  where\n    ev = ctEvidence work_item\n    loc  = ctEvLoc ev\n    pred = ctEvPred ev\n\n    mk_eq_ev cls tys mk_ev evs\n      = case (mk_ev evs) of\n          EvExpr e -> EvExpr (Var sc_id `mkTyApps` tys `App` e)\n          ev       -> pprPanic \"mk_eq_ev\" (ppr ev)\n      where\n        [sc_id] = classSCSelIds cls\n\n{- Note [Looking up primitive equalities in quantified constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor equalities (a ~# b) look up (a ~ b), and then do a superclass\nselection. This avoids having to support quantified constraints whose\nkind is not Constraint, such as (forall a. F a ~# b)\n\nSee\n * Note [Evidence for quantified constraints] in Type\n * Note [Equality superclasses in quantified constraints]\n   in TcCanonical\n-}\n\n--------------------\ndoTopReactFunEq :: Ct -> TcS (StopOrContinue Ct)\ndoTopReactFunEq work_item@(CFunEqCan { cc_ev = old_ev, cc_fun = fam_tc\n                                     , cc_tyargs = args, cc_fsk = fsk })\n\n  | fsk `elemVarSet` tyCoVarsOfTypes args\n  = no_reduction    -- See Note [FunEq occurs-check principle]\n\n  | otherwise  -- Note [Reduction for Derived CFunEqCans]\n  = do { match_res <- matchFam fam_tc args\n                           -- Look up in top-level instances, or built-in axiom\n                           -- See Note [MATCHING-SYNONYMS]\n       ; case match_res of\n           Nothing         -> no_reduction\n           Just match_info -> reduce_top_fun_eq old_ev fsk match_info }\n  where\n    no_reduction\n      = do { improveTopFunEqs old_ev fam_tc args fsk\n           ; continueWith work_item }\n\ndoTopReactFunEq w = pprPanic \"doTopReactFunEq\" (ppr w)\n\nreduce_top_fun_eq :: CtEvidence -> TcTyVar -> (TcCoercion, TcType)\n                  -> TcS (StopOrContinue Ct)\n-- We have found an applicable top-level axiom: use it to reduce\n-- Precondition: fsk is not free in rhs_ty\nreduce_top_fun_eq old_ev fsk (ax_co, rhs_ty)\n  | not (isDerived old_ev)  -- Precondition of shortCutReduction\n  , Just (tc, tc_args) <- tcSplitTyConApp_maybe rhs_ty\n  , isTypeFamilyTyCon tc\n  , tc_args `lengthIs` tyConArity tc    -- Short-cut\n  = -- RHS is another type-family application\n    -- Try shortcut; see Note [Top-level reductions for type functions]\n    do { shortCutReduction old_ev fsk ax_co tc tc_args\n       ; stopWith old_ev \"Fun/Top (shortcut)\" }\n\n  | otherwise\n  = ASSERT2( not (fsk `elemVarSet` tyCoVarsOfType rhs_ty)\n           , ppr old_ev $$ ppr rhs_ty )\n           -- Guaranteed by Note [FunEq occurs-check principle]\n    do { dischargeFunEq old_ev fsk ax_co rhs_ty\n       ; traceTcS \"doTopReactFunEq\" $\n         vcat [ text \"old_ev:\" <+> ppr old_ev\n              , nest 2 (text \":=\") <+> ppr ax_co ]\n       ; stopWith old_ev \"Fun/Top\" }\n\nimproveTopFunEqs :: CtEvidence -> TyCon -> [TcType] -> TcTyVar -> TcS ()\n-- See Note [FunDep and implicit parameter reactions]\nimproveTopFunEqs ev fam_tc args fsk\n  | isGiven ev            -- See Note [No FunEq improvement for Givens]\n    || not (isImprovable ev)\n  = return ()\n\n  | otherwise\n  = do { ieqs <- getInertEqs\n       ; fam_envs <- getFamInstEnvs\n       ; eqns <- improve_top_fun_eqs fam_envs fam_tc args\n                                    (lookupFlattenTyVar ieqs fsk)\n       ; traceTcS \"improveTopFunEqs\" (vcat [ ppr fam_tc <+> ppr args <+> ppr fsk\n                                          , ppr eqns ])\n       ; mapM_ (unifyDerived loc Nominal) eqns }\n  where\n    loc = ctEvLoc ev  -- ToDo: this location is wrong; it should be FunDepOrigin2\n                      -- See Trac #14778\n\nimprove_top_fun_eqs :: FamInstEnvs\n                    -> TyCon -> [TcType] -> TcType\n                    -> TcS [TypeEqn]\nimprove_top_fun_eqs fam_envs fam_tc args rhs_ty\n  | Just ops <- isBuiltInSynFamTyCon_maybe fam_tc\n  = return (sfInteractTop ops args rhs_ty)\n\n  -- see Note [Type inference for type families with injectivity]\n  | isOpenTypeFamilyTyCon fam_tc\n  , Injective injective_args <- tyConInjectivityInfo fam_tc\n  , let fam_insts = lookupFamInstEnvByTyCon fam_envs fam_tc\n  = -- it is possible to have several compatible equations in an open type\n    -- family but we only want to derive equalities from one such equation.\n    do { let improvs = buildImprovementData fam_insts\n                           fi_tvs fi_tys fi_rhs (const Nothing)\n\n       ; traceTcS \"improve_top_fun_eqs2\" (ppr improvs)\n       ; concatMapM (injImproveEqns injective_args) $\n         take 1 improvs }\n\n  | Just ax <- isClosedSynFamilyTyConWithAxiom_maybe fam_tc\n  , Injective injective_args <- tyConInjectivityInfo fam_tc\n  = concatMapM (injImproveEqns injective_args) $\n    buildImprovementData (fromBranches (co_ax_branches ax))\n                         cab_tvs cab_lhs cab_rhs Just\n\n  | otherwise\n  = return []\n\n  where\n      buildImprovementData\n          :: [a]                     -- axioms for a TF (FamInst or CoAxBranch)\n          -> (a -> [TyVar])          -- get bound tyvars of an axiom\n          -> (a -> [Type])           -- get LHS of an axiom\n          -> (a -> Type)             -- get RHS of an axiom\n          -> (a -> Maybe CoAxBranch) -- Just => apartness check required\n          -> [( [Type], TCvSubst, [TyVar], Maybe CoAxBranch )]\n             -- Result:\n             -- ( [arguments of a matching axiom]\n             -- , RHS-unifying substitution\n             -- , axiom variables without substitution\n             -- , Maybe matching axiom [Nothing - open TF, Just - closed TF ] )\n      buildImprovementData axioms axiomTVs axiomLHS axiomRHS wrap =\n          [ (ax_args, subst, unsubstTvs, wrap axiom)\n          | axiom <- axioms\n          , let ax_args = axiomLHS axiom\n                ax_rhs  = axiomRHS axiom\n                ax_tvs  = axiomTVs axiom\n          , Just subst <- [tcUnifyTyWithTFs False ax_rhs rhs_ty]\n          , let notInSubst tv = not (tv `elemVarEnv` getTvSubstEnv subst)\n                unsubstTvs    = filter (notInSubst <&&> isTyVar) ax_tvs ]\n                   -- The order of unsubstTvs is important; it must be\n                   -- in telescope order e.g. (k:*) (a:k)\n\n      injImproveEqns :: [Bool]\n                     -> ([Type], TCvSubst, [TyCoVar], Maybe CoAxBranch)\n                     -> TcS [TypeEqn]\n      injImproveEqns inj_args (ax_args, subst, unsubstTvs, cabr)\n        = do { subst <- instFlexiX subst unsubstTvs\n                  -- If the current substitution bind [k -> *], and\n                  -- one of the un-substituted tyvars is (a::k), we'd better\n                  -- be sure to apply the current substitution to a's kind.\n                  -- Hence instFlexiX.   Trac #13135 was an example.\n\n             ; return [ Pair (substTyUnchecked subst ax_arg) arg\n                        -- NB: the ax_arg part is on the left\n                        -- see Note [Improvement orientation]\n                      | case cabr of\n                          Just cabr' -> apartnessCheck (substTys subst ax_args) cabr'\n                          _          -> True\n                      , (ax_arg, arg, True) <- zip3 ax_args args inj_args ] }\n\n\nshortCutReduction :: CtEvidence -> TcTyVar -> TcCoercion\n                  -> TyCon -> [TcType] -> TcS ()\n-- See Note [Top-level reductions for type functions]\n-- Previously, we flattened the tc_args here, but there's no need to do so.\n-- And, if we did, this function would have all the complication of\n-- TcCanonical.canCFunEqCan. See Note [canCFunEqCan]\nshortCutReduction old_ev fsk ax_co fam_tc tc_args\n  = ASSERT( ctEvEqRel old_ev == NomEq)\n               -- ax_co :: F args ~ G tc_args\n               -- old_ev :: F args ~ fsk\n    do { new_ev <- case ctEvFlavour old_ev of\n           Given -> newGivenEvVar deeper_loc\n                         ( mkPrimEqPred (mkTyConApp fam_tc tc_args) (mkTyVarTy fsk)\n                         , evCoercion (mkTcSymCo ax_co\n                                       `mkTcTransCo` ctEvCoercion old_ev) )\n\n           Wanted {} ->\n             do { (new_ev, new_co) <- newWantedEq deeper_loc Nominal\n                                        (mkTyConApp fam_tc tc_args) (mkTyVarTy fsk)\n                ; setWantedEq (ctev_dest old_ev) $ ax_co `mkTcTransCo` new_co\n                ; return new_ev }\n\n           Derived -> pprPanic \"shortCutReduction\" (ppr old_ev)\n\n       ; let new_ct = CFunEqCan { cc_ev = new_ev, cc_fun = fam_tc\n                                , cc_tyargs = tc_args, cc_fsk = fsk }\n       ; updWorkListTcS (extendWorkListFunEq new_ct) }\n  where\n    deeper_loc = bumpCtLocDepth (ctEvLoc old_ev)\n\n{- Note [Top-level reductions for type functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nc.f. Note [The flattening story] in TcFlatten\n\nSuppose we have a CFunEqCan  F tys ~ fmv/fsk, and a matching axiom.\nHere is what we do, in four cases:\n\n* Wanteds: general firing rule\n    (work item) [W]        x : F tys ~ fmv\n    instantiate axiom: ax_co : F tys ~ rhs\n\n   Then:\n      Discharge   fmv := rhs\n      Discharge   x := ax_co ; sym x2\n   This is *the* way that fmv's get unified; even though they are\n   \"untouchable\".\n\n   NB: Given Note [FunEq occurs-check principle], fmv does not appear\n   in tys, and hence does not appear in the instantiated RHS.  So\n   the unification can't make an infinite type.\n\n* Wanteds: short cut firing rule\n  Applies when the RHS of the axiom is another type-function application\n      (work item)        [W] x : F tys ~ fmv\n      instantiate axiom: ax_co : F tys ~ G rhs_tys\n\n  It would be a waste to create yet another fmv for (G rhs_tys).\n  Instead (shortCutReduction):\n      - Flatten rhs_tys (cos : rhs_tys ~ rhs_xis)\n      - Add G rhs_xis ~ fmv to flat cache  (note: the same old fmv)\n      - New canonical wanted   [W] x2 : G rhs_xis ~ fmv  (CFunEqCan)\n      - Discharge x := ax_co ; G cos ; x2\n\n* Givens: general firing rule\n      (work item)        [G] g : F tys ~ fsk\n      instantiate axiom: ax_co : F tys ~ rhs\n\n   Now add non-canonical given (since rhs is not flat)\n      [G] (sym g ; ax_co) : fsk ~ rhs  (Non-canonical)\n\n* Givens: short cut firing rule\n  Applies when the RHS of the axiom is another type-function application\n      (work item)        [G] g : F tys ~ fsk\n      instantiate axiom: ax_co : F tys ~ G rhs_tys\n\n  It would be a waste to create yet another fsk for (G rhs_tys).\n  Instead (shortCutReduction):\n     - Flatten rhs_tys: flat_cos : tys ~ flat_tys\n     - Add new Canonical given\n          [G] (sym (G flat_cos) ; co ; g) : G flat_tys ~ fsk   (CFunEqCan)\n\nNote [FunEq occurs-check principle]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nI have spent a lot of time finding a good way to deal with\nCFunEqCan constraints like\n    F (fuv, a) ~ fuv\nwhere flatten-skolem occurs on the LHS.  Now in principle we\nmight may progress by doing a reduction, but in practice its\nhard to find examples where it is useful, and easy to find examples\nwhere we fall into an infinite reduction loop.  A rule that works\nvery well is this:\n\n  *** FunEq occurs-check principle ***\n\n      Do not reduce a CFunEqCan\n          F tys ~ fsk\n      if fsk appears free in tys\n      Instead we treat it as stuck.\n\nExamples:\n\n* Trac #5837 has [G] a ~ TF (a,Int), with an instance\n    type instance TF (a,b) = (TF a, TF b)\n  This readily loops when solving givens.  But with the FunEq occurs\n  check principle, it rapidly gets stuck which is fine.\n\n* Trac #12444 is a good example, explained in comment:2.  We have\n    type instance F (Succ x) = Succ (F x)\n    [W] alpha ~ Succ (F alpha)\n  If we allow the reduction to happen, we get an infinite loop\n\nNote [Cached solved FunEqs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen trying to solve, say (FunExpensive big-type ~ ty), it's important\nto see if we have reduced (FunExpensive big-type) before, lest we\nsimply repeat it.  Hence the lookup in inert_solved_funeqs.  Moreover\nwe must use `funEqCanDischarge` because both uses might (say) be Wanteds,\nand we *still* want to save the re-computation.\n\nNote [MATCHING-SYNONYMS]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWhen trying to match a dictionary (D tau) to a top-level instance, or a\ntype family equation (F taus_1 ~ tau_2) to a top-level family instance,\nwe do *not* need to expand type synonyms because the matcher will do that for us.\n\nNote [Improvement orientation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA very delicate point is the orientation of derived equalities\narising from injectivity improvement (Trac #12522).  Suppse we have\n  type family F x = t | t -> x\n  type instance F (a, Int) = (Int, G a)\nwhere G is injective; and wanted constraints\n\n  [W] TF (alpha, beta) ~ fuv\n  [W] fuv ~ (Int, <some type>)\n\nThe injectivity will give rise to derived constraints\n\n  [D] gamma1 ~ alpha\n  [D] Int ~ beta\n\nThe fresh unification variable gamma1 comes from the fact that we\ncan only do \"partial improvement\" here; see Section 5.2 of\n\"Injective type families for Haskell\" (HS'15).\n\nNow, it's very important to orient the equations this way round,\nso that the fresh unification variable will be eliminated in\nfavour of alpha.  If we instead had\n   [D] alpha ~ gamma1\nthen we would unify alpha := gamma1; and kick out the wanted\nconstraint.  But when we grough it back in, it'd look like\n   [W] TF (gamma1, beta) ~ fuv\nand exactly the same thing would happen again!  Infinite loop.\n\nThis all seems fragile, and it might seem more robust to avoid\nintroducing gamma1 in the first place, in the case where the\nactual argument (alpha, beta) partly matches the improvement\ntemplate.  But that's a bit tricky, esp when we remember that the\nkinds much match too; so it's easier to let the normal machinery\nhandle it.  Instead we are careful to orient the new derived\nequality with the template on the left.  Delicate, but it works.\n\nNote [No FunEq improvement for Givens]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't do improvements (injectivity etc) for Givens. Why?\n\n* It generates Derived constraints on skolems, which don't do us\n  much good, except perhaps identify inaccessible branches.\n  (They'd be perfectly valid though.)\n\n* For type-nat stuff the derived constraints include type families;\n  e.g.  (a < b), (b < c) ==> a < c If we generate a Derived for this,\n  we'll generate a Derived/Wanted CFunEqCan; and, since the same\n  InertCans (after solving Givens) are used for each iteration, that\n  massively confused the unflattening step (TcFlatten.unflatten).\n\n  In fact it led to some infinite loops:\n     indexed-types/should_compile/T10806\n     indexed-types/should_compile/T10507\n     polykinds/T10742\n\nNote [Reduction for Derived CFunEqCans]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nYou may wonder if it's important to use top-level instances to\nsimplify [D] CFunEqCan's.  But it is.  Here's an example (T10226).\n\n   type instance F    Int = Int\n   type instance FInv Int = Int\n\nSuppose we have to solve\n    [WD] FInv (F alpha) ~ alpha\n    [WD] F alpha ~ Int\n\n  --> flatten\n    [WD] F alpha ~ fuv0\n    [WD] FInv fuv0 ~ fuv1  -- (A)\n    [WD] fuv1 ~ alpha\n    [WD] fuv0 ~ Int        -- (B)\n\n  --> Rewwrite (A) with (B), splitting it\n    [WD] F alpha ~ fuv0\n    [W] FInv fuv0 ~ fuv1\n    [D] FInv Int ~ fuv1    -- (C)\n    [WD] fuv1 ~ alpha\n    [WD] fuv0 ~ Int\n\n  --> Reduce (C) with top-level instance\n      **** This is the key step ***\n    [WD] F alpha ~ fuv0\n    [W] FInv fuv0 ~ fuv1\n    [D] fuv1 ~ Int        -- (D)\n    [WD] fuv1 ~ alpha     -- (E)\n    [WD] fuv0 ~ Int\n\n  --> Rewrite (D) with (E)\n    [WD] F alpha ~ fuv0\n    [W] FInv fuv0 ~ fuv1\n    [D] alpha ~ Int       -- (F)\n    [WD] fuv1 ~ alpha\n    [WD] fuv0 ~ Int\n\n  --> unify (F)  alpha := Int, and that solves it\n\nAnother example is indexed-types/should_compile/T10634\n-}\n\n{- *******************************************************************\n*                                                                    *\n         Top-level reaction for class constraints (CDictCan)\n*                                                                    *\n**********************************************************************-}\n\ndoTopReactDict :: InertSet -> Ct -> TcS (StopOrContinue Ct)\n-- Try to use type-class instance declarations to simplify the constraint\ndoTopReactDict inerts work_item@(CDictCan { cc_ev = ev, cc_class = cls\n                                          , cc_tyargs = xis })\n  | isGiven ev   -- Never use instances for Given constraints\n  = do { try_fundep_improvement\n       ; continueWith work_item }\n\n  | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis   -- Cached\n  = do { setEvBindIfWanted ev (ctEvTerm solved_ev)\n       ; stopWith ev \"Dict/Top (cached)\" }\n\n  | otherwise  -- Wanted or Derived, but not cached\n   = do { dflags <- getDynFlags\n        ; lkup_res <- matchClassInst dflags inerts cls xis dict_loc\n        ; case lkup_res of\n               OneInst { cir_what = what }\n                  -> do { unless (safeOverlap what) $\n                          insertSafeOverlapFailureTcS work_item\n                        ; when (isWanted ev) $ addSolvedDict ev cls xis\n                        ; chooseInstance work_item lkup_res }\n               _  ->  -- NoInstance or NotSure\n                     do { when (isImprovable ev) $\n                          try_fundep_improvement\n                        ; continueWith work_item } }\n   where\n     dict_pred   = mkClassPred cls xis\n     dict_loc    = ctEvLoc ev\n     dict_origin = ctLocOrigin dict_loc\n\n     -- We didn't solve it; so try functional dependencies with\n     -- the instance environment, and return\n     -- See also Note [Weird fundeps]\n     try_fundep_improvement\n        = do { traceTcS \"try_fundeps\" (ppr work_item)\n             ; instEnvs <- getInstEnvs\n             ; emitFunDepDeriveds $\n               improveFromInstEnv instEnvs mk_ct_loc dict_pred }\n\n     mk_ct_loc :: PredType   -- From instance decl\n               -> SrcSpan    -- also from instance deol\n               -> CtLoc\n     mk_ct_loc inst_pred inst_loc\n       = dict_loc { ctl_origin = FunDepOrigin2 dict_pred dict_origin\n                                               inst_pred inst_loc }\n\ndoTopReactDict _ w = pprPanic \"doTopReactDict\" (ppr w)\n\n\nchooseInstance :: Ct -> ClsInstResult -> TcS (StopOrContinue Ct)\nchooseInstance work_item\n               (OneInst { cir_new_theta = theta\n                        , cir_what      = what\n                        , cir_mk_ev     = mk_ev })\n  = do { traceTcS \"doTopReact/found instance for\" $ ppr ev\n       ; deeper_loc <- checkInstanceOK loc what pred\n       ; if isDerived ev then finish_derived deeper_loc theta\n                         else finish_wanted  deeper_loc theta mk_ev }\n  where\n     ev         = ctEvidence work_item\n     pred       = ctEvPred ev\n     loc        = ctEvLoc ev\n\n     finish_wanted :: CtLoc -> [TcPredType]\n                   -> ([EvExpr] -> EvTerm) -> TcS (StopOrContinue Ct)\n      -- Precondition: evidence term matches the predicate workItem\n     finish_wanted loc theta mk_ev\n        = do { evb <- getTcEvBindsVar\n             ; if isCoEvBindsVar evb\n               then -- See Note [Instances in no-evidence implications]\n                    continueWith work_item\n               else\n          do { evc_vars <- mapM (newWanted loc) theta\n             ; setEvBindIfWanted ev (mk_ev (map getEvExpr evc_vars))\n             ; emitWorkNC (freshGoals evc_vars)\n             ; stopWith ev \"Dict/Top (solved wanted)\" } }\n\n     finish_derived loc theta\n       = -- Use type-class instances for Deriveds, in the hope\n         -- of generating some improvements\n         -- C.f. Example 3 of Note [The improvement story]\n         -- It's easy because no evidence is involved\n         do { emitNewDeriveds loc theta\n            ; traceTcS \"finish_derived\" (ppr (ctl_depth loc))\n            ; stopWith ev \"Dict/Top (solved derived)\" }\n\nchooseInstance work_item lookup_res\n  = pprPanic \"chooseInstance\" (ppr work_item $$ ppr lookup_res)\n\ncheckInstanceOK :: CtLoc -> InstanceWhat -> TcPredType -> TcS CtLoc\n-- Check that it's OK to use this insstance:\n--    (a) the use is well staged in the Template Haskell sense\n--    (b) we have not recursed too deep\n-- Returns the CtLoc to used for sub-goals\ncheckInstanceOK loc what pred\n  = do { checkWellStagedDFun loc what pred\n       ; checkReductionDepth deeper_loc pred\n       ; return deeper_loc }\n  where\n     deeper_loc = zap_origin (bumpCtLocDepth loc)\n     origin     = ctLocOrigin loc\n\n     zap_origin loc  -- After applying an instance we can set ScOrigin to\n                     -- infinity, so that prohibitedSuperClassSolve never fires\n       | ScOrigin {} <- origin\n       = setCtLocOrigin loc (ScOrigin infinity)\n       | otherwise\n       = loc\n\n{- Note [Instances in no-evidence implications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn Trac #15290 we had\n  [G] forall p q. Coercible p q => Coercible (m p) (m q))\n  [W] forall <no-ev> a. m (Int, IntStateT m a)\n                          ~R#\n                        m (Int, StateT Int m a)\n\nThe Given is an ordinary quantified constraint; the Wanted is an implication\nequality that arises from\n  [W] (forall a. t1) ~R# (forall a. t2)\n\nBut because the (t1 ~R# t2) is solved \"inside a type\" (under that forall a)\nwe can't generate any term evidence.  So we can't actually use that\nlovely quantified constraint.  Alas!\n\nThis test arranges to ignore the instance-based solution under these\n(rare) circumstances.   It's sad, but I  really don't see what else we can do.\n-}\n\n\nmatchClassInst :: DynFlags -> InertSet\n               -> Class -> [Type]\n               -> CtLoc -> TcS ClsInstResult\nmatchClassInst dflags inerts clas tys loc\n-- First check whether there is an in-scope Given that could\n-- match this constraint.  In that case, do not use any instance\n-- whether top level, or local quantified constraints.\n-- ee Note [Instance and Given overlap]\n  | not (xopt LangExt.IncoherentInstances dflags)\n  , not (naturallyCoherentClass clas)\n  , let matchable_givens = matchableGivens loc pred inerts\n  , not (isEmptyBag matchable_givens)\n  = do { traceTcS \"Delaying instance application\" $\n           vcat [ text \"Work item=\" <+> pprClassPred clas tys\n                , text \"Potential matching givens:\" <+> ppr matchable_givens ]\n       ; return NotSure }\n\n  | otherwise\n  = do { traceTcS \"matchClassInst\" $ text \"pred =\" <+> ppr pred <+> char '{'\n       ; local_res <- matchLocalInst pred loc\n       ; case local_res of\n           OneInst {} ->  -- See Note [Local instances and incoherence]\n                do { traceTcS \"} matchClassInst local match\" $ ppr local_res\n                   ; return local_res }\n\n           NotSure -> -- In the NotSure case for local instances\n                      -- we don't want to try global instances\n                do { traceTcS \"} matchClassInst local not sure\" empty\n                   ; return local_res }\n\n           NoInstance  -- No local instances, so try global ones\n              -> do { global_res <- matchGlobalInst dflags False clas tys\n                    ; traceTcS \"} matchClassInst global result\" $ ppr global_res\n                    ; return global_res } }\n  where\n    pred = mkClassPred clas tys\n\n-- | If a class is \"naturally coherent\", then we needn't worry at all, in any\n-- way, about overlapping/incoherent instances. Just solve the thing!\n-- See Note [Naturally coherent classes]\n-- See also Note [The equality class story] in TysPrim.\nnaturallyCoherentClass :: Class -> Bool\nnaturallyCoherentClass cls\n  = isCTupleClass cls\n    || cls `hasKey` heqTyConKey\n    || cls `hasKey` eqTyConKey\n    || cls `hasKey` coercibleTyConKey\n\n\n{- Note [Instance and Given overlap]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nExample, from the OutsideIn(X) paper:\n       instance P x => Q [x]\n       instance (x ~ y) => R y [x]\n\n       wob :: forall a b. (Q [b], R b a) => a -> Int\n\n       g :: forall a. Q [a] => [a] -> Int\n       g x = wob x\n\nFrom 'g' we get the impliation constraint:\n            forall a. Q [a] => (Q [beta], R beta [a])\nIf we react (Q [beta]) with its top-level axiom, we end up with a\n(P beta), which we have no way of discharging. On the other hand,\nif we react R beta [a] with the top-level we get  (beta ~ a), which\nis solvable and can help us rewrite (Q [beta]) to (Q [a]) which is\nnow solvable by the given Q [a].\n\nThe partial solution is that:\n  In matchClassInst (and thus in topReact), we return a matching\n  instance only when there is no Given in the inerts which is\n  unifiable to this particular dictionary.\n\n  We treat any meta-tyvar as \"unifiable\" for this purpose,\n  *including* untouchable ones.  But not skolems like 'a' in\n  the implication constraint above.\n\nThe end effect is that, much as we do for overlapping instances, we\ndelay choosing a class instance if there is a possibility of another\ninstance OR a given to match our constraint later on. This fixes\nTrac #4981 and #5002.\n\nOther notes:\n\n* The check is done *first*, so that it also covers classes\n  with built-in instance solving, such as\n     - constraint tuples\n     - natural numbers\n     - Typeable\n\n* Flatten-skolems: we do not treat a flatten-skolem as unifiable\n  for this purpose.\n  E.g.   f :: Eq (F a) => [a] -> [a]\n         f xs = ....(xs==xs).....\n  Here we get [W] Eq [a], and we don't want to refrain from solving\n  it because of the given (Eq (F a)) constraint!\n\n* The given-overlap problem is arguably not easy to appear in practice\n  due to our aggressive prioritization of equality solving over other\n  constraints, but it is possible. I've added a test case in\n  typecheck/should-compile/GivenOverlapping.hs\n\n* Another \"live\" example is Trac #10195; another is #10177.\n\n* We ignore the overlap problem if -XIncoherentInstances is in force:\n  see Trac #6002 for a worked-out example where this makes a\n  difference.\n\n* Moreover notice that our goals here are different than the goals of\n  the top-level overlapping checks. There we are interested in\n  validating the following principle:\n\n      If we inline a function f at a site where the same global\n      instance environment is available as the instance environment at\n      the definition site of f then we should get the same behaviour.\n\n  But for the Given Overlap check our goal is just related to completeness of\n  constraint solving.\n\n* The solution is only a partial one.  Consider the above example with\n       g :: forall a. Q [a] => [a] -> Int\n       g x = let v = wob x\n             in v\n  and suppose we have -XNoMonoLocalBinds, so that we attempt to find the most\n  general type for 'v'.  When generalising v's type we'll simplify its\n  Q [alpha] constraint, but we don't have Q [a] in the 'givens', so we\n  will use the instance declaration after all. Trac #11948 was a case\n  in point.\n\nAll of this is disgustingly delicate, so to discourage people from writing\nsimplifiable class givens, we warn about signatures that contain them;\nsee TcValidity Note [Simplifiable given constraints].\n\nNote [Naturally coherent classes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA few built-in classes are \"naturally coherent\".  This term means that\nthe \"instance\" for the class is bidirectional with its superclass(es).\nFor example, consider (~~), which behaves as if it was defined like\nthis:\n  class a ~# b => a ~~ b\n  instance a ~# b => a ~~ b\n(See Note [The equality types story] in TysPrim.)\n\nFaced with [W] t1 ~~ t2, it's always OK to reduce it to [W] t1 ~# t2,\nwithout worrying about Note [Instance and Given overlap].  Why?  Because\nif we had [G] s1 ~~ s2, then we'd get the superclass [G] s1 ~# s2, and\nso the reduction of the [W] constraint does not risk losing any solutions.\n\nOn the other hand, it can be fatal to /fail/ to reduce such\nequalities, on the grounds of Note [Instance and Given overlap],\nbecause many good things flow from [W] t1 ~# t2.\n\nThe same reasoning applies to\n\n* (~~)        heqTyCOn\n* (~)         eqTyCon\n* Coercible   coercibleTyCon\n\nAnd less obviously to:\n\n* Tuple classes.  For reasons described in TcSMonad\n  Note [Tuples hiding implicit parameters], we may have a constraint\n     [W] (?x::Int, C a)\n  with an exactly-matching Given constraint.  We must decompose this\n  tuple and solve the components separately, otherwise we won't solve\n  it at all!  It is perfectly safe to decompose it, because again the\n  superclasses invert the instance;  e.g.\n      class (c1, c2) => (% c1, c2 %)\n      instance (c1, c2) => (% c1, c2 %)\n  Example in Trac #14218\n\nExammples: T5853, T10432, T5315, T9222, T2627b, T3028b\n\nPS: the term \"naturally coherent\" doesn't really seem helpful.\nPerhaps \"invertible\" or something?  I left it for now though.\n\nNote [Local instances and incoherence]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   f :: forall b c. (Eq b, forall a. Eq a => Eq (c a))\n                 => c b -> Bool\n   f x = x==x\n\nWe get [W] Eq (c b), and we must use the local instance to solve it.\n\nBUT that wanted also unifies with the top-level Eq [a] instance,\nand Eq (Maybe a) etc.  We want the local instance to \"win\", otherwise\nwe can't solve the wanted at all.  So we mark it as Incohherent.\nAccording to Note [Rules for instance lookup] in InstEnv, that'll\nmake it win even if there are other instances that unify.\n\nMoreover this is not a hack!  The evidence for this local instance\nwill be constructed by GHC at a call site... from the very instances\nthat unify with it here.  It is not like an incoherent user-written\ninstance which might have utterly different behaviour.\n\nConsdider  f :: Eq a => blah.  If we have [W] Eq a, we certainly\nget it from the Eq a context, without worrying that there are\nlots of top-level instances that unify with [W] Eq a!  We'll use\nthose instances to build evidence to pass to f. That's just the\nnullary case of what's happening here.\n-}\n\nmatchLocalInst :: TcPredType -> CtLoc -> TcS ClsInstResult\n-- Look up the predicate in Given quantified constraints,\n-- which are effectively just local instance declarations.\nmatchLocalInst pred loc\n  = do { ics <- getInertCans\n       ; case match_local_inst (inert_insts ics) of\n           ([], False) -> return NoInstance\n           ([(dfun_ev, inst_tys)], unifs)\n             | not unifs\n             -> do { let dfun_id = ctEvEvId dfun_ev\n                   ; (tys, theta) <- instDFunType dfun_id inst_tys\n                   ; return $ OneInst { cir_new_theta = theta\n                                      , cir_mk_ev     = evDFunApp dfun_id tys\n                                      , cir_what      = LocalInstance } }\n           _ -> return NotSure }\n  where\n    pred_tv_set = tyCoVarsOfType pred\n\n    match_local_inst :: [QCInst]\n                     -> ( [(CtEvidence, [DFunInstType])]\n                        , Bool )      -- True <=> Some unify but do not match\n    match_local_inst []\n      = ([], False)\n    match_local_inst (qci@(QCI { qci_tvs = qtvs, qci_pred = qpred\n                               , qci_ev = ev })\n                     : qcis)\n      | let in_scope = mkInScopeSet (qtv_set `unionVarSet` pred_tv_set)\n      , Just tv_subst <- ruleMatchTyKiX qtv_set (mkRnEnv2 in_scope)\n                                        emptyTvSubstEnv qpred pred\n      , let match = (ev, map (lookupVarEnv tv_subst) qtvs)\n      = (match:matches, unif)\n\n      | otherwise\n      = ASSERT2( disjointVarSet qtv_set (tyCoVarsOfType pred)\n               , ppr qci $$ ppr pred )\n            -- ASSERT: unification relies on the\n            -- quantified variables being fresh\n        (matches, unif || this_unif)\n      where\n        qtv_set = mkVarSet qtvs\n        this_unif = mightMatchLater qpred (ctEvLoc ev) pred loc\n        (matches, unif) = match_local_inst qcis\n\n", "num_lines": 2610}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nTcMatches: Typecheck some @Matches@\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcMatches ( tcMatchesFun, tcGRHS, tcGRHSsPat, tcMatchesCase, tcMatchLambda,\n                   TcMatchCtxt(..), TcStmtChecker, TcExprStmtChecker, TcCmdStmtChecker,\n                   tcStmts, tcStmtsAndThen, tcDoStmts, tcBody,\n                   tcDoStmt, tcGuardStmt\n       ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   TcExpr( tcSyntaxOp, tcInferSigmaNC, tcInferSigma\n                              , tcCheckId, tcMonoExpr, tcMonoExprNC, tcPolyExpr )\n\nimport BasicTypes (LexicalFixity(..))\nimport HsSyn\nimport TcRnMonad\nimport TcEnv\nimport TcPat\nimport TcMType\nimport TcType\nimport TcBinds\nimport TcUnify\nimport Name\nimport TysWiredIn\nimport Id\nimport TyCon\nimport TysPrim\nimport TcEvidence\nimport Outputable\nimport Util\nimport SrcLoc\nimport DynFlags\nimport PrelNames (monadFailClassName)\nimport qualified GHC.LanguageExtensions as LangExt\n\n-- Create chunkified tuple tybes for monad comprehensions\nimport MkCore\n\nimport Control.Monad\nimport Control.Arrow ( second )\n\n#include \"HsVersions.h\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{tcMatchesFun, tcMatchesCase}\n*                                                                      *\n************************************************************************\n\n@tcMatchesFun@ typechecks a @[Match]@ list which occurs in a\n@FunMonoBind@.  The second argument is the name of the function, which\nis used in error messages.  It checks that all the equations have the\nsame number of arguments before using @tcMatches@ to do the work.\n\nNote [Polymorphic expected type for tcMatchesFun]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ntcMatchesFun may be given a *sigma* (polymorphic) type\nso it must be prepared to use tcSkolemise to skolemise it.\nSee Note [sig_tau may be polymorphic] in TcPat.\n-}\n\ntcMatchesFun :: Located Name\n             -> MatchGroup GhcRn (LHsExpr GhcRn)\n             -> ExpRhoType     -- Expected type of function\n             -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))\n                                -- Returns type of body\ntcMatchesFun fn@(L _ fun_name) matches exp_ty\n  = do  {  -- Check that they all have the same no of arguments\n           -- Location is in the monad, set the caller so that\n           -- any inter-equation error messages get some vaguely\n           -- sensible location.        Note: we have to do this odd\n           -- ann-grabbing, because we don't always have annotations in\n           -- hand when we call tcMatchesFun...\n          traceTc \"tcMatchesFun\" (ppr fun_name $$ ppr exp_ty)\n        ; checkArgs fun_name matches\n\n        ; (wrap_gen, (wrap_fun, group))\n            <- tcSkolemiseET (FunSigCtxt fun_name True) exp_ty $ \\ exp_rho ->\n                  -- Note [Polymorphic expected type for tcMatchesFun]\n               do { (matches', wrap_fun)\n                       <- matchExpectedFunTys herald arity exp_rho $\n                          \\ pat_tys rhs_ty ->\n                          tcMatches match_ctxt pat_tys rhs_ty matches\n                  ; return (wrap_fun, matches') }\n        ; return (wrap_gen <.> wrap_fun, group) }\n  where\n    arity = matchGroupArity matches\n    herald = text \"The equation(s) for\"\n             <+> quotes (ppr fun_name) <+> text \"have\"\n    what = FunRhs { mc_fun = fn, mc_fixity = Prefix, mc_strictness = strictness }\n    match_ctxt = MC { mc_what = what, mc_body = tcBody }\n    strictness\n      | [L _ match] <- unLoc $ mg_alts matches\n      , FunRhs{ mc_strictness = SrcStrict } <- m_ctxt match\n      = SrcStrict\n      | otherwise\n      = NoSrcStrict\n\n{-\n@tcMatchesCase@ doesn't do the argument-count check because the\nparser guarantees that each equation has exactly one argument.\n-}\n\ntcMatchesCase :: (Outputable (body GhcRn)) =>\n                TcMatchCtxt body                        -- Case context\n             -> TcSigmaType                             -- Type of scrutinee\n             -> MatchGroup GhcRn (Located (body GhcRn)) -- The case alternatives\n             -> ExpRhoType                    -- Type of whole case expressions\n             -> TcM (MatchGroup GhcTcId (Located (body GhcTcId)))\n                -- Translated alternatives\n                -- wrapper goes from MatchGroup's ty to expected ty\n\ntcMatchesCase ctxt scrut_ty matches res_ty\n  = tcMatches ctxt [mkCheckExpType scrut_ty] res_ty matches\n\ntcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in TcUnify\n              -> TcMatchCtxt HsExpr\n              -> MatchGroup GhcRn (LHsExpr GhcRn)\n              -> ExpRhoType   -- deeply skolemised\n              -> TcM (MatchGroup GhcTcId (LHsExpr GhcTcId), HsWrapper)\ntcMatchLambda herald match_ctxt match res_ty\n  = matchExpectedFunTys herald n_pats res_ty $ \\ pat_tys rhs_ty ->\n    tcMatches match_ctxt pat_tys rhs_ty match\n  where\n    n_pats | isEmptyMatchGroup match = 1   -- must be lambda-case\n           | otherwise               = matchGroupArity match\n\n-- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.\n\ntcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn) -> TcRhoType\n           -> TcM (GRHSs GhcTcId (LHsExpr GhcTcId))\n-- Used for pattern bindings\ntcGRHSsPat grhss res_ty = tcGRHSs match_ctxt grhss (mkCheckExpType res_ty)\n  where\n    match_ctxt = MC { mc_what = PatBindRhs,\n                      mc_body = tcBody }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{tcMatch}\n*                                                                      *\n************************************************************************\n\nNote [Case branches must never infer a non-tau type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n  case ... of\n    ... -> \\(x :: forall a. a -> a) -> x\n    ... -> \\y -> y\n\nShould that type-check? The problem is that, if we check the second branch\nfirst, then we'll get a type (b -> b) for the branches, which won't unify\nwith the polytype in the first branch. If we check the first branch first,\nthen everything is OK. This order-dependency is terrible. So we want only\nproper tau-types in branches (unless a sigma-type is pushed down).\nThis is what expTypeToType ensures: it replaces an Infer with a fresh\ntau-type.\n\nAn even trickier case looks like\n\n  f x True  = x undefined\n  f x False = x ()\n\nHere, we see that the arguments must also be non-Infer. Thus, we must\nuse expTypeToType on the output of matchExpectedFunTys, not the input.\n\nBut we make a special case for a one-branch case. This is so that\n\n  f = \\(x :: forall a. a -> a) -> x\n\nstill gets assigned a polytype.\n-}\n\n-- | When the MatchGroup has multiple RHSs, convert an Infer ExpType in the\n-- expected type into TauTvs.\n-- See Note [Case branches must never infer a non-tau type]\ntauifyMultipleMatches :: [LMatch id body]\n                      -> [ExpType] -> TcM [ExpType]\ntauifyMultipleMatches group exp_tys\n  | isSingletonMatchGroup group = return exp_tys\n  | otherwise                   = mapM tauifyExpType exp_tys\n  -- NB: In the empty-match case, this ensures we fill in the ExpType\n\n-- | Type-check a MatchGroup.\ntcMatches :: (Outputable (body GhcRn)) => TcMatchCtxt body\n          -> [ExpSigmaType]      -- Expected pattern types\n          -> ExpRhoType          -- Expected result-type of the Match.\n          -> MatchGroup GhcRn (Located (body GhcRn))\n          -> TcM (MatchGroup GhcTcId (Located (body GhcTcId)))\n\ndata TcMatchCtxt body   -- c.f. TcStmtCtxt, also in this module\n  = MC { mc_what :: HsMatchContext Name,  -- What kind of thing this is\n         mc_body :: Located (body GhcRn)         -- Type checker for a body of\n                                                -- an alternative\n                 -> ExpRhoType\n                 -> TcM (Located (body GhcTcId)) }\n\ntcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches\n                                  , mg_origin = origin })\n  = do { rhs_ty:pat_tys <- tauifyMultipleMatches matches (rhs_ty:pat_tys)\n            -- See Note [Case branches must never infer a non-tau type]\n\n       ; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches\n       ; pat_tys  <- mapM readExpType pat_tys\n       ; rhs_ty   <- readExpType rhs_ty\n       ; return (MG { mg_alts = L l matches'\n                    , mg_ext = MatchGroupTc pat_tys rhs_ty\n                    , mg_origin = origin }) }\ntcMatches _ _ _ (XMatchGroup {}) = panic \"tcMatches\"\n\n-------------\ntcMatch :: (Outputable (body GhcRn)) => TcMatchCtxt body\n        -> [ExpSigmaType]        -- Expected pattern types\n        -> ExpRhoType            -- Expected result-type of the Match.\n        -> LMatch GhcRn (Located (body GhcRn))\n        -> TcM (LMatch GhcTcId (Located (body GhcTcId)))\n\ntcMatch ctxt pat_tys rhs_ty match\n  = wrapLocM (tc_match ctxt pat_tys rhs_ty) match\n  where\n    tc_match ctxt pat_tys rhs_ty\n             match@(Match { m_pats = pats, m_grhss = grhss })\n      = add_match_ctxt match $\n        do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $\n                                tcGRHSs ctxt grhss rhs_ty\n           ; return (Match { m_ext = noExt\n                           , m_ctxt = mc_what ctxt, m_pats = pats'\n                           , m_grhss = grhss' }) }\n    tc_match  _ _ _ (XMatch _) = panic \"tcMatch\"\n\n        -- For (\\x -> e), tcExpr has already said \"In the expression \\x->e\"\n        -- so we don't want to add \"In the lambda abstraction \\x->e\"\n    add_match_ctxt match thing_inside\n        = case mc_what ctxt of\n            LambdaExpr -> thing_inside\n            _          -> addErrCtxt (pprMatchInCtxt match) thing_inside\n\n-------------\ntcGRHSs :: TcMatchCtxt body -> GRHSs GhcRn (Located (body GhcRn)) -> ExpRhoType\n        -> TcM (GRHSs GhcTcId (Located (body GhcTcId)))\n\n-- Notice that we pass in the full res_ty, so that we get\n-- good inference from simple things like\n--      f = \\(x::forall a.a->a) -> <stuff>\n-- We used to force it to be a monotype when there was more than one guard\n-- but we don't need to do that any more\n\ntcGRHSs ctxt (GRHSs _ grhss (L l binds)) res_ty\n  = do  { (binds', grhss')\n            <- tcLocalBinds binds $\n               mapM (wrapLocM (tcGRHS ctxt res_ty)) grhss\n\n        ; return (GRHSs noExt grhss' (L l binds')) }\ntcGRHSs _ (XGRHSs _) _ = panic \"tcGRHSs\"\n\n-------------\ntcGRHS :: TcMatchCtxt body -> ExpRhoType -> GRHS GhcRn (Located (body GhcRn))\n       -> TcM (GRHS GhcTcId (Located (body GhcTcId)))\n\ntcGRHS ctxt res_ty (GRHS _ guards rhs)\n  = do  { (guards', rhs')\n            <- tcStmtsAndThen stmt_ctxt tcGuardStmt guards res_ty $\n               mc_body ctxt rhs\n        ; return (GRHS noExt guards' rhs') }\n  where\n    stmt_ctxt  = PatGuard (mc_what ctxt)\ntcGRHS _ _ (XGRHS _) = panic \"tcGRHS\"\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{@tcDoStmts@ typechecks a {\\em list} of do statements}\n*                                                                      *\n************************************************************************\n-}\n\ntcDoStmts :: HsStmtContext Name\n          -> Located [LStmt GhcRn (LHsExpr GhcRn)]\n          -> ExpRhoType\n          -> TcM (HsExpr GhcTcId)          -- Returns a HsDo\ntcDoStmts ListComp (L l stmts) res_ty\n  = do  { res_ty <- expTypeToType res_ty\n        ; (co, elt_ty) <- matchExpectedListTy res_ty\n        ; let list_ty = mkListTy elt_ty\n        ; stmts' <- tcStmts ListComp (tcLcStmt listTyCon) stmts\n                            (mkCheckExpType elt_ty)\n        ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) }\n\ntcDoStmts DoExpr (L l stmts) res_ty\n  = do  { stmts' <- tcStmts DoExpr tcDoStmt stmts res_ty\n        ; res_ty <- readExpType res_ty\n        ; return (HsDo res_ty DoExpr (L l stmts')) }\n\ntcDoStmts MDoExpr (L l stmts) res_ty\n  = do  { stmts' <- tcStmts MDoExpr tcDoStmt stmts res_ty\n        ; res_ty <- readExpType res_ty\n        ; return (HsDo res_ty MDoExpr (L l stmts')) }\n\ntcDoStmts MonadComp (L l stmts) res_ty\n  = do  { stmts' <- tcStmts MonadComp tcMcStmt stmts res_ty\n        ; res_ty <- readExpType res_ty\n        ; return (HsDo res_ty MonadComp (L l stmts')) }\n\ntcDoStmts ctxt _ _ = pprPanic \"tcDoStmts\" (pprStmtContext ctxt)\n\ntcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTcId)\ntcBody body res_ty\n  = do  { traceTc \"tcBody\" (ppr res_ty)\n        ; tcMonoExpr body res_ty\n        }\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{tcStmts}\n*                                                                      *\n************************************************************************\n-}\n\ntype TcExprStmtChecker = TcStmtChecker HsExpr ExpRhoType\ntype TcCmdStmtChecker  = TcStmtChecker HsCmd  TcRhoType\n\ntype TcStmtChecker body rho_type\n  =  forall thing. HsStmtContext Name\n                -> Stmt GhcRn (Located (body GhcRn))\n                -> rho_type                 -- Result type for comprehension\n                -> (rho_type -> TcM thing)  -- Checker for what follows the stmt\n                -> TcM (Stmt GhcTcId (Located (body GhcTcId)), thing)\n\ntcStmts :: (Outputable (body GhcRn)) => HsStmtContext Name\n        -> TcStmtChecker body rho_type   -- NB: higher-rank type\n        -> [LStmt GhcRn (Located (body GhcRn))]\n        -> rho_type\n        -> TcM [LStmt GhcTcId (Located (body GhcTcId))]\ntcStmts ctxt stmt_chk stmts res_ty\n  = do { (stmts', _) <- tcStmtsAndThen ctxt stmt_chk stmts res_ty $\n                        const (return ())\n       ; return stmts' }\n\ntcStmtsAndThen :: (Outputable (body GhcRn)) => HsStmtContext Name\n               -> TcStmtChecker body rho_type    -- NB: higher-rank type\n               -> [LStmt GhcRn (Located (body GhcRn))]\n               -> rho_type\n               -> (rho_type -> TcM thing)\n               -> TcM ([LStmt GhcTcId (Located (body GhcTcId))], thing)\n\n-- Note the higher-rank type.  stmt_chk is applied at different\n-- types in the equations for tcStmts\n\ntcStmtsAndThen _ _ [] res_ty thing_inside\n  = do  { thing <- thing_inside res_ty\n        ; return ([], thing) }\n\n-- LetStmts are handled uniformly, regardless of context\ntcStmtsAndThen ctxt stmt_chk (L loc (LetStmt x (L l binds)) : stmts)\n                                                             res_ty thing_inside\n  = do  { (binds', (stmts',thing)) <- tcLocalBinds binds $\n              tcStmtsAndThen ctxt stmt_chk stmts res_ty thing_inside\n        ; return (L loc (LetStmt x (L l binds')) : stmts', thing) }\n\n-- Don't set the error context for an ApplicativeStmt.  It ought to be\n-- possible to do this with a popErrCtxt in the tcStmt case for\n-- ApplicativeStmt, but it did someting strange and broke a test (ado002).\ntcStmtsAndThen ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside\n  | ApplicativeStmt{} <- stmt\n  = do  { (stmt', (stmts', thing)) <-\n             stmt_chk ctxt stmt res_ty $ \\ res_ty' ->\n               tcStmtsAndThen ctxt stmt_chk stmts res_ty'  $\n                 thing_inside\n        ; return (L loc stmt' : stmts', thing) }\n\n  -- For the vanilla case, handle the location-setting part\n  | otherwise\n  = do  { (stmt', (stmts', thing)) <-\n                setSrcSpan loc                              $\n                addErrCtxt (pprStmtInCtxt ctxt stmt)        $\n                stmt_chk ctxt stmt res_ty                   $ \\ res_ty' ->\n                popErrCtxt                                  $\n                tcStmtsAndThen ctxt stmt_chk stmts res_ty'  $\n                thing_inside\n        ; return (L loc stmt' : stmts', thing) }\n\n---------------------------------------------------\n--              Pattern guards\n---------------------------------------------------\n\ntcGuardStmt :: TcExprStmtChecker\ntcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside\n  = do  { guard' <- tcMonoExpr guard (mkCheckExpType boolTy)\n        ; thing  <- thing_inside res_ty\n        ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) }\n\ntcGuardStmt ctxt (BindStmt _ pat rhs _ _) res_ty thing_inside\n  = do  { (rhs', rhs_ty) <- tcInferSigmaNC rhs\n                                   -- Stmt has a context already\n        ; (pat', thing)  <- tcPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs)\n                                    pat (mkCheckExpType rhs_ty) $\n                            thing_inside res_ty\n        ; return (mkTcBindStmt pat' rhs', thing) }\n\ntcGuardStmt _ stmt _ _\n  = pprPanic \"tcGuardStmt: unexpected Stmt\" (ppr stmt)\n\n\n---------------------------------------------------\n--           List comprehensions\n--               (no rebindable syntax)\n---------------------------------------------------\n\n-- Dealt with separately, rather than by tcMcStmt, because\n--   a) We have special desugaring rules for list comprehensions,\n--      which avoid creating intermediate lists.  They in turn\n--      assume that the bind/return operations are the regular\n--      polymorphic ones, and in particular don't have any\n--      coercion matching stuff in them.  It's hard to avoid the\n--      potential for non-trivial coercions in tcMcStmt\n\ntcLcStmt :: TyCon       -- The list type constructor ([])\n         -> TcExprStmtChecker\n\ntcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside\n  = do { body' <- tcMonoExprNC body elt_ty\n       ; thing <- thing_inside (panic \"tcLcStmt: thing_inside\")\n       ; return (LastStmt x body' noret noSyntaxExpr, thing) }\n\n-- A generator, pat <- rhs\ntcLcStmt m_tc ctxt (BindStmt _ pat rhs _ _) elt_ty thing_inside\n = do   { pat_ty <- newFlexiTyVarTy liftedTypeKind\n        ; rhs'   <- tcMonoExpr rhs (mkCheckExpType $ mkTyConApp m_tc [pat_ty])\n        ; (pat', thing)  <- tcPat (StmtCtxt ctxt) pat (mkCheckExpType pat_ty) $\n                            thing_inside elt_ty\n        ; return (mkTcBindStmt pat' rhs', thing) }\n\n-- A boolean guard\ntcLcStmt _ _ (BodyStmt _ rhs _ _) elt_ty thing_inside\n  = do  { rhs'  <- tcMonoExpr rhs (mkCheckExpType boolTy)\n        ; thing <- thing_inside elt_ty\n        ; return (BodyStmt boolTy rhs' noSyntaxExpr noSyntaxExpr, thing) }\n\n-- ParStmt: See notes with tcMcStmt\ntcLcStmt m_tc ctxt (ParStmt _ bndr_stmts_s _ _) elt_ty thing_inside\n  = do  { (pairs', thing) <- loop bndr_stmts_s\n        ; return (ParStmt unitTy pairs' noExpr noSyntaxExpr, thing) }\n  where\n    -- loop :: [([LStmt GhcRn], [GhcRn])]\n    --      -> TcM ([([LStmt GhcTcId], [GhcTcId])], thing)\n    loop [] = do { thing <- thing_inside elt_ty\n                 ; return ([], thing) }         -- matching in the branches\n\n    loop (ParStmtBlock x stmts names _ : pairs)\n      = do { (stmts', (ids, pairs', thing))\n                <- tcStmtsAndThen ctxt (tcLcStmt m_tc) stmts elt_ty $ \\ _elt_ty' ->\n                   do { ids <- tcLookupLocalIds names\n                      ; (pairs', thing) <- loop pairs\n                      ; return (ids, pairs', thing) }\n           ; return ( ParStmtBlock x stmts' ids noSyntaxExpr : pairs', thing ) }\n    loop (XParStmtBlock{}:_) = panic \"tcLcStmt\"\n\ntcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts\n                              , trS_bndrs =  bindersMap\n                              , trS_by = by, trS_using = using }) elt_ty thing_inside\n  = do { let (bndr_names, n_bndr_names) = unzip bindersMap\n             unused_ty = pprPanic \"tcLcStmt: inner ty\" (ppr bindersMap)\n             -- The inner 'stmts' lack a LastStmt, so the element type\n             --  passed in to tcStmtsAndThen is never looked at\n       ; (stmts', (bndr_ids, by'))\n            <- tcStmtsAndThen (TransStmtCtxt ctxt) (tcLcStmt m_tc) stmts unused_ty $ \\_ -> do\n               { by' <- traverse tcInferSigma by\n               ; bndr_ids <- tcLookupLocalIds bndr_names\n               ; return (bndr_ids, by') }\n\n       ; let m_app ty = mkTyConApp m_tc [ty]\n\n       --------------- Typecheck the 'using' function -------------\n       -- using :: ((a,b,c)->t) -> m (a,b,c) -> m (a,b,c)m      (ThenForm)\n       --       :: ((a,b,c)->t) -> m (a,b,c) -> m (m (a,b,c)))  (GroupForm)\n\n         -- n_app :: Type -> Type   -- Wraps a 'ty' into '[ty]' for GroupForm\n       ; let n_app = case form of\n                       ThenForm -> (\\ty -> ty)\n                       _        -> m_app\n\n             by_arrow :: Type -> Type     -- Wraps 'ty' to '(a->t) -> ty' if the By is present\n             by_arrow = case by' of\n                          Nothing       -> \\ty -> ty\n                          Just (_,e_ty) -> \\ty -> (alphaTy `mkVisFunTy` e_ty) `mkVisFunTy` ty\n\n             tup_ty        = mkBigCoreVarTupTy bndr_ids\n             poly_arg_ty   = m_app alphaTy\n             poly_res_ty   = m_app (n_app alphaTy)\n             using_poly_ty = mkInvForAllTy alphaTyVar $\n                             by_arrow $\n                             poly_arg_ty `mkVisFunTy` poly_res_ty\n\n       ; using' <- tcPolyExpr using using_poly_ty\n       ; let final_using = fmap (mkHsWrap (WpTyApp tup_ty)) using'\n\n             -- 'stmts' returns a result of type (m1_ty tuple_ty),\n             -- typically something like [(Int,Bool,Int)]\n             -- We don't know what tuple_ty is yet, so we use a variable\n       ; let mk_n_bndr :: Name -> TcId -> TcId\n             mk_n_bndr n_bndr_name bndr_id = mkLocalIdOrCoVar n_bndr_name (n_app (idType bndr_id))\n\n             -- Ensure that every old binder of type `b` is linked up with its\n             -- new binder which should have type `n b`\n             -- See Note [GroupStmt binder map] in HsExpr\n             n_bndr_ids  = zipWith mk_n_bndr n_bndr_names bndr_ids\n             bindersMap' = bndr_ids `zip` n_bndr_ids\n\n       -- Type check the thing in the environment with\n       -- these new binders and return the result\n       ; thing <- tcExtendIdEnv n_bndr_ids (thing_inside elt_ty)\n\n       ; return (TransStmt { trS_stmts = stmts', trS_bndrs = bindersMap'\n                           , trS_by = fmap fst by', trS_using = final_using\n                           , trS_ret = noSyntaxExpr\n                           , trS_bind = noSyntaxExpr\n                           , trS_fmap = noExpr\n                           , trS_ext = unitTy\n                           , trS_form = form }, thing) }\n\ntcLcStmt _ _ stmt _ _\n  = pprPanic \"tcLcStmt: unexpected Stmt\" (ppr stmt)\n\n\n---------------------------------------------------\n--           Monad comprehensions\n--        (supports rebindable syntax)\n---------------------------------------------------\n\ntcMcStmt :: TcExprStmtChecker\n\ntcMcStmt _ (LastStmt x body noret return_op) res_ty thing_inside\n  = do  { (body', return_op')\n            <- tcSyntaxOp MCompOrigin return_op [SynRho] res_ty $\n               \\ [a_ty] ->\n               tcMonoExprNC body (mkCheckExpType a_ty)\n        ; thing      <- thing_inside (panic \"tcMcStmt: thing_inside\")\n        ; return (LastStmt x body' noret return_op', thing) }\n\n-- Generators for monad comprehensions ( pat <- rhs )\n--\n--   [ body | q <- gen ]  ->  gen :: m a\n--                            q   ::   a\n--\n\ntcMcStmt ctxt (BindStmt _ pat rhs bind_op fail_op) res_ty thing_inside\n           -- (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty\n  = do  { ((rhs', pat', thing, new_res_ty), bind_op')\n            <- tcSyntaxOp MCompOrigin bind_op\n                          [SynRho, SynFun SynAny SynRho] res_ty $\n               \\ [rhs_ty, pat_ty, new_res_ty] ->\n               do { rhs' <- tcMonoExprNC rhs (mkCheckExpType rhs_ty)\n                  ; (pat', thing) <- tcPat (StmtCtxt ctxt) pat\n                                           (mkCheckExpType pat_ty) $\n                                     thing_inside (mkCheckExpType new_res_ty)\n                  ; return (rhs', pat', thing, new_res_ty) }\n\n        -- If (but only if) the pattern can fail, typecheck the 'fail' operator\n        ; fail_op' <- tcMonadFailOp (MCompPatOrigin pat) pat' fail_op new_res_ty\n\n        ; return (BindStmt new_res_ty pat' rhs' bind_op' fail_op', thing) }\n\n-- Boolean expressions.\n--\n--   [ body | stmts, expr ]  ->  expr :: m Bool\n--\ntcMcStmt _ (BodyStmt _ rhs then_op guard_op) res_ty thing_inside\n  = do  { -- Deal with rebindable syntax:\n          --    guard_op :: test_ty -> rhs_ty\n          --    then_op  :: rhs_ty -> new_res_ty -> res_ty\n          -- Where test_ty is, for example, Bool\n        ; ((thing, rhs', rhs_ty, guard_op'), then_op')\n            <- tcSyntaxOp MCompOrigin then_op [SynRho, SynRho] res_ty $\n               \\ [rhs_ty, new_res_ty] ->\n               do { (rhs', guard_op')\n                      <- tcSyntaxOp MCompOrigin guard_op [SynAny]\n                                    (mkCheckExpType rhs_ty) $\n                         \\ [test_ty] ->\n                         tcMonoExpr rhs (mkCheckExpType test_ty)\n                  ; thing <- thing_inside (mkCheckExpType new_res_ty)\n                  ; return (thing, rhs', rhs_ty, guard_op') }\n        ; return (BodyStmt rhs_ty rhs' then_op' guard_op', thing) }\n\n-- Grouping statements\n--\n--   [ body | stmts, then group by e using f ]\n--     ->  e :: t\n--         f :: forall a. (a -> t) -> m a -> m (m a)\n--   [ body | stmts, then group using f ]\n--     ->  f :: forall a. m a -> m (m a)\n\n-- We type [ body | (stmts, group by e using f), ... ]\n--     f <optional by> [ (a,b,c) | stmts ] >>= \\(a,b,c) -> ...body....\n--\n-- We type the functions as follows:\n--     f <optional by> :: m1 (a,b,c) -> m2 (a,b,c)              (ThenForm)\n--                     :: m1 (a,b,c) -> m2 (n (a,b,c))          (GroupForm)\n--     (>>=) :: m2 (a,b,c)     -> ((a,b,c)   -> res) -> res     (ThenForm)\n--           :: m2 (n (a,b,c)) -> (n (a,b,c) -> res) -> res     (GroupForm)\n--\ntcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap\n                         , trS_by = by, trS_using = using, trS_form = form\n                         , trS_ret = return_op, trS_bind = bind_op\n                         , trS_fmap = fmap_op }) res_ty thing_inside\n  = do { let star_star_kind = liftedTypeKind `mkVisFunTy` liftedTypeKind\n       ; m1_ty   <- newFlexiTyVarTy star_star_kind\n       ; m2_ty   <- newFlexiTyVarTy star_star_kind\n       ; tup_ty  <- newFlexiTyVarTy liftedTypeKind\n       ; by_e_ty <- newFlexiTyVarTy liftedTypeKind  -- The type of the 'by' expression (if any)\n\n         -- n_app :: Type -> Type   -- Wraps a 'ty' into '(n ty)' for GroupForm\n       ; n_app <- case form of\n                    ThenForm -> return (\\ty -> ty)\n                    _        -> do { n_ty <- newFlexiTyVarTy star_star_kind\n                                   ; return (n_ty `mkAppTy`) }\n       ; let by_arrow :: Type -> Type\n             -- (by_arrow res) produces ((alpha->e_ty) -> res)     ('by' present)\n             --                          or res                    ('by' absent)\n             by_arrow = case by of\n                          Nothing -> \\res -> res\n                          Just {} -> \\res -> (alphaTy `mkVisFunTy` by_e_ty) `mkVisFunTy` res\n\n             poly_arg_ty  = m1_ty `mkAppTy` alphaTy\n             using_arg_ty = m1_ty `mkAppTy` tup_ty\n             poly_res_ty  = m2_ty `mkAppTy` n_app alphaTy\n             using_res_ty = m2_ty `mkAppTy` n_app tup_ty\n             using_poly_ty = mkInvForAllTy alphaTyVar $\n                             by_arrow $\n                             poly_arg_ty `mkVisFunTy` poly_res_ty\n\n             -- 'stmts' returns a result of type (m1_ty tuple_ty),\n             -- typically something like [(Int,Bool,Int)]\n             -- We don't know what tuple_ty is yet, so we use a variable\n       ; let (bndr_names, n_bndr_names) = unzip bindersMap\n       ; (stmts', (bndr_ids, by', return_op')) <-\n            tcStmtsAndThen (TransStmtCtxt ctxt) tcMcStmt stmts\n                           (mkCheckExpType using_arg_ty) $ \\res_ty' -> do\n                { by' <- case by of\n                           Nothing -> return Nothing\n                           Just e  -> do { e' <- tcMonoExpr e\n                                                   (mkCheckExpType by_e_ty)\n                                         ; return (Just e') }\n\n                -- Find the Ids (and hence types) of all old binders\n                ; bndr_ids <- tcLookupLocalIds bndr_names\n\n                -- 'return' is only used for the binders, so we know its type.\n                --   return :: (a,b,c,..) -> m (a,b,c,..)\n                ; (_, return_op') <- tcSyntaxOp MCompOrigin return_op\n                                       [synKnownType (mkBigCoreVarTupTy bndr_ids)]\n                                       res_ty' $ \\ _ -> return ()\n\n                ; return (bndr_ids, by', return_op') }\n\n       --------------- Typecheck the 'bind' function -------------\n       -- (>>=) :: m2 (n (a,b,c)) -> ( n (a,b,c) -> new_res_ty ) -> res_ty\n       ; new_res_ty <- newFlexiTyVarTy liftedTypeKind\n       ; (_, bind_op')  <- tcSyntaxOp MCompOrigin bind_op\n                             [ synKnownType using_res_ty\n                             , synKnownType (n_app tup_ty `mkVisFunTy` new_res_ty) ]\n                             res_ty $ \\ _ -> return ()\n\n       --------------- Typecheck the 'fmap' function -------------\n       ; fmap_op' <- case form of\n                       ThenForm -> return noExpr\n                       _ -> fmap unLoc . tcPolyExpr (noLoc fmap_op) $\n                            mkInvForAllTy alphaTyVar $\n                            mkInvForAllTy betaTyVar  $\n                            (alphaTy `mkVisFunTy` betaTy)\n                            `mkVisFunTy` (n_app alphaTy)\n                            `mkVisFunTy` (n_app betaTy)\n\n       --------------- Typecheck the 'using' function -------------\n       -- using :: ((a,b,c)->t) -> m1 (a,b,c) -> m2 (n (a,b,c))\n\n       ; using' <- tcPolyExpr using using_poly_ty\n       ; let final_using = fmap (mkHsWrap (WpTyApp tup_ty)) using'\n\n       --------------- Bulding the bindersMap ----------------\n       ; let mk_n_bndr :: Name -> TcId -> TcId\n             mk_n_bndr n_bndr_name bndr_id = mkLocalIdOrCoVar n_bndr_name (n_app (idType bndr_id))\n\n             -- Ensure that every old binder of type `b` is linked up with its\n             -- new binder which should have type `n b`\n             -- See Note [GroupStmt binder map] in HsExpr\n             n_bndr_ids = zipWith mk_n_bndr n_bndr_names bndr_ids\n             bindersMap' = bndr_ids `zip` n_bndr_ids\n\n       -- Type check the thing in the environment with\n       -- these new binders and return the result\n       ; thing <- tcExtendIdEnv n_bndr_ids $\n                  thing_inside (mkCheckExpType new_res_ty)\n\n       ; return (TransStmt { trS_stmts = stmts', trS_bndrs = bindersMap'\n                           , trS_by = by', trS_using = final_using\n                           , trS_ret = return_op', trS_bind = bind_op'\n                           , trS_ext = n_app tup_ty\n                           , trS_fmap = fmap_op', trS_form = form }, thing) }\n\n-- A parallel set of comprehensions\n--      [ (g x, h x) | ... ; let g v = ...\n--                   | ... ; let h v = ... ]\n--\n-- It's possible that g,h are overloaded, so we need to feed the LIE from the\n-- (g x, h x) up through both lots of bindings (so we get the bindLocalMethods).\n-- Similarly if we had an existential pattern match:\n--\n--      data T = forall a. Show a => C a\n--\n--      [ (show x, show y) | ... ; C x <- ...\n--                         | ... ; C y <- ... ]\n--\n-- Then we need the LIE from (show x, show y) to be simplified against\n-- the bindings for x and y.\n--\n-- It's difficult to do this in parallel, so we rely on the renamer to\n-- ensure that g,h and x,y don't duplicate, and simply grow the environment.\n-- So the binders of the first parallel group will be in scope in the second\n-- group.  But that's fine; there's no shadowing to worry about.\n--\n-- Note: The `mzip` function will get typechecked via:\n--\n--   ParStmt [st1::t1, st2::t2, st3::t3]\n--\n--   mzip :: m st1\n--        -> (m st2 -> m st3 -> m (st2, st3))   -- recursive call\n--        -> m (st1, (st2, st3))\n--\ntcMcStmt ctxt (ParStmt _ bndr_stmts_s mzip_op bind_op) res_ty thing_inside\n  = do { let star_star_kind = liftedTypeKind `mkVisFunTy` liftedTypeKind\n       ; m_ty   <- newFlexiTyVarTy star_star_kind\n\n       ; let mzip_ty  = mkInvForAllTys [alphaTyVar, betaTyVar] $\n                        (m_ty `mkAppTy` alphaTy)\n                        `mkVisFunTy`\n                        (m_ty `mkAppTy` betaTy)\n                        `mkVisFunTy`\n                        (m_ty `mkAppTy` mkBoxedTupleTy [alphaTy, betaTy])\n       ; mzip_op' <- unLoc `fmap` tcPolyExpr (noLoc mzip_op) mzip_ty\n\n        -- type dummies since we don't know all binder types yet\n       ; id_tys_s <- (mapM . mapM) (const (newFlexiTyVarTy liftedTypeKind))\n                       [ names | ParStmtBlock _ _ names _ <- bndr_stmts_s ]\n\n       -- Typecheck bind:\n       ; let tup_tys  = [ mkBigCoreTupTy id_tys | id_tys <- id_tys_s ]\n             tuple_ty = mk_tuple_ty tup_tys\n\n       ; (((blocks', thing), inner_res_ty), bind_op')\n           <- tcSyntaxOp MCompOrigin bind_op\n                         [ synKnownType (m_ty `mkAppTy` tuple_ty)\n                         , SynFun (synKnownType tuple_ty) SynRho ] res_ty $\n              \\ [inner_res_ty] ->\n              do { stuff <- loop m_ty (mkCheckExpType inner_res_ty)\n                                 tup_tys bndr_stmts_s\n                 ; return (stuff, inner_res_ty) }\n\n       ; return (ParStmt inner_res_ty blocks' mzip_op' bind_op', thing) }\n\n  where\n    mk_tuple_ty tys = foldr1 (\\tn tm -> mkBoxedTupleTy [tn, tm]) tys\n\n       -- loop :: Type                                  -- m_ty\n       --      -> ExpRhoType                            -- inner_res_ty\n       --      -> [TcType]                              -- tup_tys\n       --      -> [ParStmtBlock Name]\n       --      -> TcM ([([LStmt GhcTcId], [GhcTcId])], thing)\n    loop _ inner_res_ty [] [] = do { thing <- thing_inside inner_res_ty\n                                   ; return ([], thing) }\n                                   -- matching in the branches\n\n    loop m_ty inner_res_ty (tup_ty_in : tup_tys_in)\n                           (ParStmtBlock x stmts names return_op : pairs)\n      = do { let m_tup_ty = m_ty `mkAppTy` tup_ty_in\n           ; (stmts', (ids, return_op', pairs', thing))\n                <- tcStmtsAndThen ctxt tcMcStmt stmts (mkCheckExpType m_tup_ty) $\n                   \\m_tup_ty' ->\n                   do { ids <- tcLookupLocalIds names\n                      ; let tup_ty = mkBigCoreVarTupTy ids\n                      ; (_, return_op') <-\n                          tcSyntaxOp MCompOrigin return_op\n                                     [synKnownType tup_ty] m_tup_ty' $\n                                     \\ _ -> return ()\n                      ; (pairs', thing) <- loop m_ty inner_res_ty tup_tys_in pairs\n                      ; return (ids, return_op', pairs', thing) }\n           ; return (ParStmtBlock x stmts' ids return_op' : pairs', thing) }\n    loop _ _ _ _ = panic \"tcMcStmt.loop\"\n\ntcMcStmt _ stmt _ _\n  = pprPanic \"tcMcStmt: unexpected Stmt\" (ppr stmt)\n\n\n---------------------------------------------------\n--           Do-notation\n--        (supports rebindable syntax)\n---------------------------------------------------\n\ntcDoStmt :: TcExprStmtChecker\n\ntcDoStmt _ (LastStmt x body noret _) res_ty thing_inside\n  = do { body' <- tcMonoExprNC body res_ty\n       ; thing <- thing_inside (panic \"tcDoStmt: thing_inside\")\n       ; return (LastStmt x body' noret noSyntaxExpr, thing) }\n\ntcDoStmt ctxt (BindStmt _ pat rhs bind_op fail_op) res_ty thing_inside\n  = do  {       -- Deal with rebindable syntax:\n                --       (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty\n                -- This level of generality is needed for using do-notation\n                -- in full generality; see Trac #1537\n\n          ((rhs', pat', new_res_ty, thing), bind_op')\n            <- tcSyntaxOp DoOrigin bind_op [SynRho, SynFun SynAny SynRho] res_ty $\n                \\ [rhs_ty, pat_ty, new_res_ty] ->\n                do { rhs' <- tcMonoExprNC rhs (mkCheckExpType rhs_ty)\n                   ; (pat', thing) <- tcPat (StmtCtxt ctxt) pat\n                                            (mkCheckExpType pat_ty) $\n                                      thing_inside (mkCheckExpType new_res_ty)\n                   ; return (rhs', pat', new_res_ty, thing) }\n\n        -- If (but only if) the pattern can fail, typecheck the 'fail' operator\n        ; fail_op' <- tcMonadFailOp (DoPatOrigin pat) pat' fail_op new_res_ty\n\n        ; return (BindStmt new_res_ty pat' rhs' bind_op' fail_op', thing) }\n\ntcDoStmt ctxt (ApplicativeStmt _ pairs mb_join) res_ty thing_inside\n  = do  { let tc_app_stmts ty = tcApplicativeStmts ctxt pairs ty $\n                                thing_inside . mkCheckExpType\n        ; ((pairs', body_ty, thing), mb_join') <- case mb_join of\n            Nothing -> (, Nothing) <$> tc_app_stmts res_ty\n            Just join_op ->\n              second Just <$>\n              (tcSyntaxOp DoOrigin join_op [SynRho] res_ty $\n               \\ [rhs_ty] -> tc_app_stmts (mkCheckExpType rhs_ty))\n\n        ; return (ApplicativeStmt body_ty pairs' mb_join', thing) }\n\ntcDoStmt _ (BodyStmt _ rhs then_op _) res_ty thing_inside\n  = do  {       -- Deal with rebindable syntax;\n                --   (>>) :: rhs_ty -> new_res_ty -> res_ty\n        ; ((rhs', rhs_ty, thing), then_op')\n            <- tcSyntaxOp DoOrigin then_op [SynRho, SynRho] res_ty $\n               \\ [rhs_ty, new_res_ty] ->\n               do { rhs' <- tcMonoExprNC rhs (mkCheckExpType rhs_ty)\n                  ; thing <- thing_inside (mkCheckExpType new_res_ty)\n                  ; return (rhs', rhs_ty, thing) }\n        ; return (BodyStmt rhs_ty rhs' then_op' noSyntaxExpr, thing) }\n\ntcDoStmt ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names\n                       , recS_rec_ids = rec_names, recS_ret_fn = ret_op\n                       , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op })\n         res_ty thing_inside\n  = do  { let tup_names = rec_names ++ filterOut (`elem` rec_names) later_names\n        ; tup_elt_tys <- newFlexiTyVarTys (length tup_names) liftedTypeKind\n        ; let tup_ids = zipWith mkLocalId tup_names tup_elt_tys\n              tup_ty  = mkBigCoreTupTy tup_elt_tys\n\n        ; tcExtendIdEnv tup_ids $ do\n        { ((stmts', (ret_op', tup_rets)), stmts_ty)\n                <- tcInferInst $ \\ exp_ty ->\n                   tcStmtsAndThen ctxt tcDoStmt stmts exp_ty $ \\ inner_res_ty ->\n                   do { tup_rets <- zipWithM tcCheckId tup_names\n                                      (map mkCheckExpType tup_elt_tys)\n                             -- Unify the types of the \"final\" Ids (which may\n                             -- be polymorphic) with those of \"knot-tied\" Ids\n                      ; (_, ret_op')\n                          <- tcSyntaxOp DoOrigin ret_op [synKnownType tup_ty]\n                                        inner_res_ty $ \\_ -> return ()\n                      ; return (ret_op', tup_rets) }\n\n        ; ((_, mfix_op'), mfix_res_ty)\n            <- tcInferInst $ \\ exp_ty ->\n               tcSyntaxOp DoOrigin mfix_op\n                          [synKnownType (mkVisFunTy tup_ty stmts_ty)] exp_ty $\n               \\ _ -> return ()\n\n        ; ((thing, new_res_ty), bind_op')\n            <- tcSyntaxOp DoOrigin bind_op\n                          [ synKnownType mfix_res_ty\n                          , synKnownType tup_ty `SynFun` SynRho ]\n                          res_ty $\n               \\ [new_res_ty] ->\n               do { thing <- thing_inside (mkCheckExpType new_res_ty)\n                  ; return (thing, new_res_ty) }\n\n        ; let rec_ids = takeList rec_names tup_ids\n        ; later_ids <- tcLookupLocalIds later_names\n        ; traceTc \"tcdo\" $ vcat [ppr rec_ids <+> ppr (map idType rec_ids),\n                                 ppr later_ids <+> ppr (map idType later_ids)]\n        ; return (RecStmt { recS_stmts = stmts', recS_later_ids = later_ids\n                          , recS_rec_ids = rec_ids, recS_ret_fn = ret_op'\n                          , recS_mfix_fn = mfix_op', recS_bind_fn = bind_op'\n                          , recS_ext = RecStmtTc\n                            { recS_bind_ty = new_res_ty\n                            , recS_later_rets = []\n                            , recS_rec_rets = tup_rets\n                            , recS_ret_ty = stmts_ty} }, thing)\n        }}\n\ntcDoStmt _ stmt _ _\n  = pprPanic \"tcDoStmt: unexpected Stmt\" (ppr stmt)\n\n\n\n---------------------------------------------------\n-- MonadFail Proposal warnings\n---------------------------------------------------\n\n-- The idea behind issuing MonadFail warnings is that we add them whenever a\n-- failable pattern is encountered. However, instead of throwing a type error\n-- when the constraint cannot be satisfied, we only issue a warning in\n-- TcErrors.hs.\n\ntcMonadFailOp :: CtOrigin\n              -> LPat GhcTcId\n              -> SyntaxExpr GhcRn    -- The fail op\n              -> TcType              -- Type of the whole do-expression\n              -> TcRn (SyntaxExpr GhcTcId)  -- Typechecked fail op\n-- Get a 'fail' operator expression, to use if the pattern\n-- match fails. If the pattern is irrefutatable, just return\n-- noSyntaxExpr; it won't be used\ntcMonadFailOp orig pat fail_op res_ty\n  | isIrrefutableHsPat pat\n  = return noSyntaxExpr\n\n  | otherwise\n  = do { -- Issue MonadFail warnings\n         rebindableSyntax <- xoptM LangExt.RebindableSyntax\n       ; desugarFlag      <- xoptM LangExt.MonadFailDesugaring\n       ; missingWarning   <- woptM Opt_WarnMissingMonadFailInstances\n       ; if | rebindableSyntax && desugarFlag && missingWarning\n              -> warnRebindableClash pat\n            | not desugarFlag && missingWarning\n              -> emitMonadFailConstraint pat res_ty\n            | otherwise\n              -> return ()\n\n        -- Get the fail op itself\n        ; snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy]\n                             (mkCheckExpType res_ty) $ \\_ -> return ()) }\n\nemitMonadFailConstraint :: LPat GhcTcId -> TcType -> TcRn ()\nemitMonadFailConstraint pat res_ty\n  = do { -- We expect res_ty to be of form (monad_ty arg_ty)\n         (_co, (monad_ty, _arg_ty)) <- matchExpectedAppTy res_ty\n\n         -- Emit (MonadFail m), but ignore the evidence; it's\n         -- just there to generate a warning\n       ; monadFailClass <- tcLookupClass monadFailClassName\n       ; _ <- emitWanted (FailablePattern pat)\n                         (mkClassPred monadFailClass [monad_ty])\n       ; return () }\n\nwarnRebindableClash :: LPat GhcTcId -> TcRn ()\nwarnRebindableClash pattern = addWarnAt\n    (Reason Opt_WarnMissingMonadFailInstances)\n    (getLoc pattern)\n    (text \"The failable pattern\" <+> quotes (ppr pattern)\n     $$\n     nest 2 (text \"is used together with -XRebindableSyntax.\"\n             <+> text \"If this is intentional,\"\n             $$\n             text \"compile with -Wno-missing-monadfail-instances.\"))\n\n{-\nNote [Treat rebindable syntax first]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen typechecking\n        do { bar; ... } :: IO ()\nwe want to typecheck 'bar' in the knowledge that it should be an IO thing,\npushing info from the context into the RHS.  To do this, we check the\nrebindable syntax first, and push that information into (tcMonoExprNC rhs).\nOtherwise the error shows up when checking the rebindable syntax, and\nthe expected/inferred stuff is back to front (see Trac #3613).\n\nNote [typechecking ApplicativeStmt]\n\njoin ((\\pat1 ... patn -> body) <$> e1 <*> ... <*> en)\n\nfresh type variables:\n   pat_ty_1..pat_ty_n\n   exp_ty_1..exp_ty_n\n   t_1..t_(n-1)\n\nbody  :: body_ty\n(\\pat1 ... patn -> body) :: pat_ty_1 -> ... -> pat_ty_n -> body_ty\npat_i :: pat_ty_i\ne_i   :: exp_ty_i\n<$>   :: (pat_ty_1 -> ... -> pat_ty_n -> body_ty) -> exp_ty_1 -> t_1\n<*>_i :: t_(i-1) -> exp_ty_i -> t_i\njoin :: tn -> res_ty\n-}\n\ntcApplicativeStmts\n  :: HsStmtContext Name\n  -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]\n  -> ExpRhoType                         -- rhs_ty\n  -> (TcRhoType -> TcM t)               -- thing_inside\n  -> TcM ([(SyntaxExpr GhcTcId, ApplicativeArg GhcTcId)], Type, t)\n\ntcApplicativeStmts ctxt pairs rhs_ty thing_inside\n = do { body_ty <- newFlexiTyVarTy liftedTypeKind\n      ; let arity = length pairs\n      ; ts <- replicateM (arity-1) $ newInferExpTypeInst\n      ; exp_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind\n      ; pat_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind\n      ; let fun_ty = mkVisFunTys pat_tys body_ty\n\n       -- NB. do the <$>,<*> operators first, we don't want type errors here\n       --     i.e. goOps before goArgs\n       -- See Note [Treat rebindable syntax first]\n      ; let (ops, args) = unzip pairs\n      ; ops' <- goOps fun_ty (zip3 ops (ts ++ [rhs_ty]) exp_tys)\n\n      -- Typecheck each ApplicativeArg separately\n      -- See Note [ApplicativeDo and constraints]\n      ; args' <- mapM goArg (zip3 args pat_tys exp_tys)\n\n      -- Bring into scope all the things bound by the args,\n      -- and typecheck the thing_inside\n      -- See Note [ApplicativeDo and constraints]\n      ; res <- tcExtendIdEnv (concatMap get_arg_bndrs args') $\n               thing_inside body_ty\n\n      ; return (zip ops' args', body_ty, res) }\n  where\n    goOps _ [] = return []\n    goOps t_left ((op,t_i,exp_ty) : ops)\n      = do { (_, op')\n               <- tcSyntaxOp DoOrigin op\n                             [synKnownType t_left, synKnownType exp_ty] t_i $\n                   \\ _ -> return ()\n           ; t_i <- readExpType t_i\n           ; ops' <- goOps t_i ops\n           ; return (op' : ops') }\n\n    goArg :: (ApplicativeArg GhcRn, Type, Type)\n          -> TcM (ApplicativeArg GhcTcId)\n\n    goArg (ApplicativeArgOne x pat rhs isBody, pat_ty, exp_ty)\n      = setSrcSpan (combineSrcSpans (getLoc pat) (getLoc rhs)) $\n        addErrCtxt (pprStmtInCtxt ctxt (mkBindStmt pat rhs))   $\n        do { rhs' <- tcMonoExprNC rhs (mkCheckExpType exp_ty)\n           ; (pat', _) <- tcPat (StmtCtxt ctxt) pat (mkCheckExpType pat_ty) $\n                          return ()\n           ; return (ApplicativeArgOne x pat' rhs' isBody) }\n\n    goArg (ApplicativeArgMany x stmts ret pat, pat_ty, exp_ty)\n      = do { (stmts', (ret',pat')) <-\n                tcStmtsAndThen ctxt tcDoStmt stmts (mkCheckExpType exp_ty) $\n                \\res_ty  -> do\n                  { L _ ret' <- tcMonoExprNC (noLoc ret) res_ty\n                  ; (pat', _) <- tcPat (StmtCtxt ctxt) pat (mkCheckExpType pat_ty) $\n                                 return ()\n                  ; return (ret', pat')\n                  }\n           ; return (ApplicativeArgMany x stmts' ret' pat') }\n\n    goArg (XApplicativeArg _, _, _) = panic \"tcApplicativeStmts\"\n\n    get_arg_bndrs :: ApplicativeArg GhcTcId -> [Id]\n    get_arg_bndrs (ApplicativeArgOne _ pat _ _)  = collectPatBinders pat\n    get_arg_bndrs (ApplicativeArgMany _ _ _ pat) = collectPatBinders pat\n    get_arg_bndrs (XApplicativeArg _)            = panic \"tcApplicativeStmts\"\n\n\n{- Note [ApplicativeDo and constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAn applicative-do is supposed to take place in parallel, so\nconstraints bound in one arm can't possibly be available in another\n(Trac #13242).  Our current rule is this (more details and discussion\non the ticket). Consider\n\n   ...stmts...\n   ApplicativeStmts [arg1, arg2, ... argN]\n   ...more stmts...\n\nwhere argi :: ApplicativeArg. Each 'argi' itself contains one or more Stmts.\nNow, we say that:\n\n* Constraints required by the argi can be solved from\n  constraint bound by ...stmts...\n\n* Constraints and existentials bound by the argi are not available\n  to solve constraints required either by argj (where i /= j),\n  or by ...more stmts....\n\n* Within the stmts of each 'argi' individually, however, constraints bound\n  by earlier stmts can be used to solve later ones.\n\nTo achieve this, we just typecheck each 'argi' separately, bring all\nthe variables they bind into scope, and typecheck the thing_inside.\n\n************************************************************************\n*                                                                      *\n\\subsection{Errors and contexts}\n*                                                                      *\n************************************************************************\n\n@sameNoOfArgs@ takes a @[RenamedMatch]@ and decides whether the same\nnumber of args are used in each equation.\n-}\n\ncheckArgs :: Name -> MatchGroup GhcRn body -> TcM ()\ncheckArgs _ (MG { mg_alts = L _ [] })\n    = return ()\ncheckArgs fun (MG { mg_alts = L _ (match1:matches) })\n    | null bad_matches\n    = return ()\n    | otherwise\n    = failWithTc (vcat [ text \"Equations for\" <+> quotes (ppr fun) <+>\n                         text \"have different numbers of arguments\"\n                       , nest 2 (ppr (getLoc match1))\n                       , nest 2 (ppr (getLoc (head bad_matches)))])\n  where\n    n_args1 = args_in_match match1\n    bad_matches = [m | m <- matches, args_in_match m /= n_args1]\n\n    args_in_match :: LMatch GhcRn body -> Int\n    args_in_match (L _ (Match { m_pats = pats })) = length pats\n    args_in_match (L _ (XMatch _)) = panic \"checkArgs\"\ncheckArgs _ (XMatchGroup{}) = panic \"checkArgs\"\n", "num_lines": 1139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nMonadic type operations\n\nThis module contains monadic operations over types that contain\nmutable type variables.\n-}\n\n{-# LANGUAGE CPP, TupleSections, MultiWayIf #-}\n\nmodule TcMType (\n  TcTyVar, TcKind, TcType, TcTauType, TcThetaType, TcTyVarSet,\n\n  --------------------------------\n  -- Creating new mutable type variables\n  newFlexiTyVar,\n  newFlexiTyVarTy,              -- Kind -> TcM TcType\n  newFlexiTyVarTys,             -- Int -> Kind -> TcM [TcType]\n  newOpenFlexiTyVarTy, newOpenTypeKind,\n  newMetaKindVar, newMetaKindVars, newMetaTyVarTyAtLevel,\n  cloneMetaTyVar,\n  newFmvTyVar, newFskTyVar,\n\n  readMetaTyVar, writeMetaTyVar, writeMetaTyVarRef,\n  newMetaDetails, isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar,\n\n  --------------------------------\n  -- Expected types\n  ExpType(..), ExpSigmaType, ExpRhoType,\n  mkCheckExpType,\n  newInferExpType, newInferExpTypeInst, newInferExpTypeNoInst,\n  readExpType, readExpType_maybe,\n  expTypeToType, checkingExpType_maybe, checkingExpType,\n  tauifyExpType, inferResultToType,\n\n  --------------------------------\n  -- Creating new evidence variables\n  newEvVar, newEvVars, newDict,\n  newWanted, newWanteds, newHoleCt, cloneWanted, cloneWC,\n  emitWanted, emitWantedEq, emitWantedEvVar, emitWantedEvVars,\n  emitDerivedEqs,\n  newTcEvBinds, newNoTcEvBinds, addTcEvBind,\n\n  newCoercionHole, fillCoercionHole, isFilledCoercionHole,\n  unpackCoercionHole, unpackCoercionHole_maybe,\n  checkCoercionHole,\n\n  --------------------------------\n  -- Instantiation\n  newMetaTyVars, newMetaTyVarX, newMetaTyVarsX,\n  newMetaTyVarTyVars, newMetaTyVarTyVarX,\n  newTyVarTyVar, newPatSigTyVar, newSkolemTyVar, newWildCardX,\n  tcInstType,\n  tcInstSkolTyVars, tcInstSkolTyVarsX, tcInstSkolTyVarsAt,\n  tcSkolDFunType, tcSuperSkolTyVars, tcInstSuperSkolTyVarsX,\n\n  freshenTyVarBndrs, freshenCoVarBndrsX,\n\n  --------------------------------\n  -- Zonking and tidying\n  zonkTidyTcType, zonkTidyTcTypes, zonkTidyOrigin,\n  tidyEvVar, tidyCt, tidySkolemInfo,\n    zonkTcTyVar, zonkTcTyVars,\n  zonkTcTyVarToTyVar, zonkTyVarTyVarPairs,\n  zonkTyCoVarsAndFV, zonkTcTypeAndFV,\n  zonkTyCoVarsAndFVList,\n  candidateQTyVarsOfType,  candidateQTyVarsOfKind,\n  candidateQTyVarsOfTypes, candidateQTyVarsOfKinds,\n  CandidatesQTvs(..), delCandidates, candidateKindVars,\n  zonkAndSkolemise, skolemiseQuantifiedTyVar,\n  defaultTyVar, quantifyTyVars,\n  zonkTcType, zonkTcTypes, zonkCo,\n  zonkTyCoVarKind,\n\n  zonkEvVar, zonkWC, zonkSimples,\n  zonkId, zonkCoVar,\n  zonkCt, zonkSkolemInfo,\n\n  tcGetGlobalTyCoVars,\n\n  ------------------------------\n  -- Levity polymorphism\n  ensureNotLevPoly, checkForLevPoly, checkForLevPolyX, formatLevPolyErr\n  ) where\n\n#include \"HsVersions.h\"\n\n-- friends:\nimport GhcPrelude\n\nimport TyCoRep\nimport TcType\nimport Type\nimport TyCon\nimport Coercion\nimport Class\nimport Var\n\n-- others:\nimport TcRnMonad        -- TcType, amongst others\nimport TcEvidence\nimport Id\nimport Name\nimport VarSet\nimport TysWiredIn\nimport TysPrim\nimport VarEnv\nimport NameEnv\nimport PrelNames\nimport Util\nimport Outputable\nimport FastString\nimport Bag\nimport Pair\nimport UniqSet\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Maybes\nimport Data.List        ( mapAccumL )\nimport Control.Arrow    ( second )\nimport qualified Data.Semigroup as Semi\n\n{-\n************************************************************************\n*                                                                      *\n        Kind variables\n*                                                                      *\n************************************************************************\n-}\n\nmkKindName :: Unique -> Name\nmkKindName unique = mkSystemName unique kind_var_occ\n\nkind_var_occ :: OccName -- Just one for all MetaKindVars\n                        -- They may be jiggled by tidying\nkind_var_occ = mkOccName tvName \"k\"\n\nnewMetaKindVar :: TcM TcKind\nnewMetaKindVar\n  = do { details <- newMetaDetails TauTv\n       ; uniq <- newUnique\n       ; let kv = mkTcTyVar (mkKindName uniq) liftedTypeKind details\n       ; traceTc \"newMetaKindVar\" (ppr kv)\n       ; return (mkTyVarTy kv) }\n\nnewMetaKindVars :: Int -> TcM [TcKind]\nnewMetaKindVars n = mapM (\\ _ -> newMetaKindVar) (nOfThem n ())\n\n{-\n************************************************************************\n*                                                                      *\n     Evidence variables; range over constraints we can abstract over\n*                                                                      *\n************************************************************************\n-}\n\nnewEvVars :: TcThetaType -> TcM [EvVar]\nnewEvVars theta = mapM newEvVar theta\n\n--------------\n\nnewEvVar :: TcPredType -> TcRnIf gbl lcl EvVar\n-- Creates new *rigid* variables for predicates\nnewEvVar ty = do { name <- newSysName (predTypeOccName ty)\n                 ; return (mkLocalIdOrCoVar name ty) }\n\nnewWanted :: CtOrigin -> Maybe TypeOrKind -> PredType -> TcM CtEvidence\n-- Deals with both equality and non-equality predicates\nnewWanted orig t_or_k pty\n  = do loc <- getCtLocM orig t_or_k\n       d <- if isEqPrimPred pty then HoleDest  <$> newCoercionHole pty\n                                else EvVarDest <$> newEvVar pty\n       return $ CtWanted { ctev_dest = d\n                         , ctev_pred = pty\n                         , ctev_nosh = WDeriv\n                         , ctev_loc = loc }\n\nnewWanteds :: CtOrigin -> ThetaType -> TcM [CtEvidence]\nnewWanteds orig = mapM (newWanted orig Nothing)\n\n-- | Create a new 'CHoleCan' 'Ct'.\nnewHoleCt :: Hole -> Id -> Type -> TcM Ct\nnewHoleCt hole ev ty = do\n  loc <- getCtLocM HoleOrigin Nothing\n  pure $ CHoleCan { cc_ev = CtWanted { ctev_pred = ty\n                                     , ctev_dest = EvVarDest ev\n                                     , ctev_nosh = WDeriv\n                                     , ctev_loc  = loc }\n                  , cc_hole = hole }\n\n----------------------------------------------\n-- Cloning constraints\n----------------------------------------------\n\ncloneWanted :: Ct -> TcM Ct\ncloneWanted ct\n  | ev@(CtWanted { ctev_dest = HoleDest {}, ctev_pred = pty }) <- ctEvidence ct\n  = do { co_hole <- newCoercionHole pty\n       ; return (mkNonCanonical (ev { ctev_dest = HoleDest co_hole })) }\n  | otherwise\n  = return ct\n\ncloneWC :: WantedConstraints -> TcM WantedConstraints\n-- Clone all the evidence bindings in\n--   a) the ic_bind field of any implications\n--   b) the CoercionHoles of any wanted constraints\n-- so that solving the WantedConstraints will not have any visible side\n-- effect, /except/ from causing unifications\ncloneWC wc@(WC { wc_simple = simples, wc_impl = implics })\n  = do { simples' <- mapBagM cloneWanted simples\n       ; implics' <- mapBagM cloneImplication implics\n       ; return (wc { wc_simple = simples', wc_impl = implics' }) }\n\ncloneImplication :: Implication -> TcM Implication\ncloneImplication implic@(Implic { ic_binds = binds, ic_wanted = inner_wanted })\n  = do { binds'        <- cloneEvBindsVar binds\n       ; inner_wanted' <- cloneWC inner_wanted\n       ; return (implic { ic_binds = binds', ic_wanted = inner_wanted' }) }\n\n----------------------------------------------\n-- Emitting constraints\n----------------------------------------------\n\n-- | Emits a new Wanted. Deals with both equalities and non-equalities.\nemitWanted :: CtOrigin -> TcPredType -> TcM EvTerm\nemitWanted origin pty\n  = do { ev <- newWanted origin Nothing pty\n       ; emitSimple $ mkNonCanonical ev\n       ; return $ ctEvTerm ev }\n\nemitDerivedEqs :: CtOrigin -> [(TcType,TcType)] -> TcM ()\n-- Emit some new derived nominal equalities\nemitDerivedEqs origin pairs\n  | null pairs\n  = return ()\n  | otherwise\n  = do { loc <- getCtLocM origin Nothing\n       ; emitSimples (listToBag (map (mk_one loc) pairs)) }\n  where\n    mk_one loc (ty1, ty2)\n       = mkNonCanonical $\n         CtDerived { ctev_pred = mkPrimEqPred ty1 ty2\n                   , ctev_loc = loc }\n\n-- | Emits a new equality constraint\nemitWantedEq :: CtOrigin -> TypeOrKind -> Role -> TcType -> TcType -> TcM Coercion\nemitWantedEq origin t_or_k role ty1 ty2\n  = do { hole <- newCoercionHole pty\n       ; loc <- getCtLocM origin (Just t_or_k)\n       ; emitSimple $ mkNonCanonical $\n         CtWanted { ctev_pred = pty, ctev_dest = HoleDest hole\n                  , ctev_nosh = WDeriv, ctev_loc = loc }\n       ; return (HoleCo hole) }\n  where\n    pty = mkPrimEqPredRole role ty1 ty2\n\n-- | Creates a new EvVar and immediately emits it as a Wanted.\n-- No equality predicates here.\nemitWantedEvVar :: CtOrigin -> TcPredType -> TcM EvVar\nemitWantedEvVar origin ty\n  = do { new_cv <- newEvVar ty\n       ; loc <- getCtLocM origin Nothing\n       ; let ctev = CtWanted { ctev_dest = EvVarDest new_cv\n                             , ctev_pred = ty\n                             , ctev_nosh = WDeriv\n                             , ctev_loc  = loc }\n       ; emitSimple $ mkNonCanonical ctev\n       ; return new_cv }\n\nemitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar]\nemitWantedEvVars orig = mapM (emitWantedEvVar orig)\n\nnewDict :: Class -> [TcType] -> TcM DictId\nnewDict cls tys\n  = do { name <- newSysName (mkDictOcc (getOccName cls))\n       ; return (mkLocalId name (mkClassPred cls tys)) }\n\npredTypeOccName :: PredType -> OccName\npredTypeOccName ty = case classifyPredType ty of\n    ClassPred cls _ -> mkDictOcc (getOccName cls)\n    EqPred {}       -> mkVarOccFS (fsLit \"co\")\n    IrredPred {}    -> mkVarOccFS (fsLit \"irred\")\n    ForAllPred {}   -> mkVarOccFS (fsLit \"df\")\n\n{-\n************************************************************************\n*                                                                      *\n        Coercion holes\n*                                                                      *\n************************************************************************\n-}\n\nnewCoercionHole :: TcPredType -> TcM CoercionHole\nnewCoercionHole pred_ty\n  = do { co_var <- newEvVar pred_ty\n       ; traceTc \"New coercion hole:\" (ppr co_var)\n       ; ref <- newMutVar Nothing\n       ; return $ CoercionHole { ch_co_var = co_var, ch_ref = ref } }\n\n-- | Put a value in a coercion hole\nfillCoercionHole :: CoercionHole -> Coercion -> TcM ()\nfillCoercionHole (CoercionHole { ch_ref = ref, ch_co_var = cv }) co\n  = do {\n#if defined(DEBUG)\n       ; cts <- readTcRef ref\n       ; whenIsJust cts $ \\old_co ->\n         pprPanic \"Filling a filled coercion hole\" (ppr cv $$ ppr co $$ ppr old_co)\n#endif\n       ; traceTc \"Filling coercion hole\" (ppr cv <+> text \":=\" <+> ppr co)\n       ; writeTcRef ref (Just co) }\n\n-- | Is a coercion hole filled in?\nisFilledCoercionHole :: CoercionHole -> TcM Bool\nisFilledCoercionHole (CoercionHole { ch_ref = ref }) = isJust <$> readTcRef ref\n\n-- | Retrieve the contents of a coercion hole. Panics if the hole\n-- is unfilled\nunpackCoercionHole :: CoercionHole -> TcM Coercion\nunpackCoercionHole hole\n  = do { contents <- unpackCoercionHole_maybe hole\n       ; case contents of\n           Just co -> return co\n           Nothing -> pprPanic \"Unfilled coercion hole\" (ppr hole) }\n\n-- | Retrieve the contents of a coercion hole, if it is filled\nunpackCoercionHole_maybe :: CoercionHole -> TcM (Maybe Coercion)\nunpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref\n\n-- | Check that a coercion is appropriate for filling a hole. (The hole\n-- itself is needed only for printing.\n-- Always returns the checked coercion, but this return value is necessary\n-- so that the input coercion is forced only when the output is forced.\ncheckCoercionHole :: CoVar -> Coercion -> TcM Coercion\ncheckCoercionHole cv co\n  | debugIsOn\n  = do { cv_ty <- zonkTcType (varType cv)\n                  -- co is already zonked, but cv might not be\n       ; return $\n         ASSERT2( ok cv_ty\n                , (text \"Bad coercion hole\" <+>\n                   ppr cv <> colon <+> vcat [ ppr t1, ppr t2, ppr role\n                                            , ppr cv_ty ]) )\n         co }\n  | otherwise\n  = return co\n\n  where\n    (Pair t1 t2, role) = coercionKindRole co\n    ok cv_ty | EqPred cv_rel cv_t1 cv_t2 <- classifyPredType cv_ty\n             =  t1 `eqType` cv_t1\n             && t2 `eqType` cv_t2\n             && role == eqRelRole cv_rel\n             | otherwise\n             = False\n\n{-\n************************************************************************\n*\n    Expected types\n*\n************************************************************************\n\nNote [ExpType]\n~~~~~~~~~~~~~~\n\nAn ExpType is used as the \"expected type\" when type-checking an expression.\nAn ExpType can hold a \"hole\" that can be filled in by the type-checker.\nThis allows us to have one tcExpr that works in both checking mode and\nsynthesis mode (that is, bidirectional type-checking). Previously, this\nwas achieved by using ordinary unification variables, but we don't need\nor want that generality. (For example, #11397 was caused by doing the\nwrong thing with unification variables.) Instead, we observe that these\nholes should\n\n1. never be nested\n2. never appear as the type of a variable\n3. be used linearly (never be duplicated)\n\nBy defining ExpType, separately from Type, we can achieve goals 1 and 2\nstatically.\n\nSee also [wiki:Typechecking]\n\nNote [TcLevel of ExpType]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n  data G a where\n    MkG :: G Bool\n\n  foo MkG = True\n\nThis is a classic untouchable-variable / ambiguous GADT return type\nscenario. But, with ExpTypes, we'll be inferring the type of the RHS.\nAnd, because there is only one branch of the case, we won't trigger\nNote [Case branches must never infer a non-tau type] of TcMatches.\nWe thus must track a TcLevel in an Inferring ExpType. If we try to\nfill the ExpType and find that the TcLevels don't work out, we\nfill the ExpType with a tau-tv at the low TcLevel, hopefully to\nbe worked out later by some means. This is triggered in\ntest gadt/gadt-escape1.\n\n-}\n\n-- actual data definition is in TcType\n\n-- | Make an 'ExpType' suitable for inferring a type of kind * or #.\nnewInferExpTypeNoInst :: TcM ExpSigmaType\nnewInferExpTypeNoInst = newInferExpType False\n\nnewInferExpTypeInst :: TcM ExpRhoType\nnewInferExpTypeInst = newInferExpType True\n\nnewInferExpType :: Bool -> TcM ExpType\nnewInferExpType inst\n  = do { u <- newUnique\n       ; tclvl <- getTcLevel\n       ; traceTc \"newOpenInferExpType\" (ppr u <+> ppr inst <+> ppr tclvl)\n       ; ref <- newMutVar Nothing\n       ; return (Infer (IR { ir_uniq = u, ir_lvl = tclvl\n                           , ir_ref = ref, ir_inst = inst })) }\n\n-- | Extract a type out of an ExpType, if one exists. But one should always\n-- exist. Unless you're quite sure you know what you're doing.\nreadExpType_maybe :: ExpType -> TcM (Maybe TcType)\nreadExpType_maybe (Check ty)                   = return (Just ty)\nreadExpType_maybe (Infer (IR { ir_ref = ref})) = readMutVar ref\n\n-- | Extract a type out of an ExpType. Otherwise, panics.\nreadExpType :: ExpType -> TcM TcType\nreadExpType exp_ty\n  = do { mb_ty <- readExpType_maybe exp_ty\n       ; case mb_ty of\n           Just ty -> return ty\n           Nothing -> pprPanic \"Unknown expected type\" (ppr exp_ty) }\n\n-- | Returns the expected type when in checking mode.\ncheckingExpType_maybe :: ExpType -> Maybe TcType\ncheckingExpType_maybe (Check ty) = Just ty\ncheckingExpType_maybe _          = Nothing\n\n-- | Returns the expected type when in checking mode. Panics if in inference\n-- mode.\ncheckingExpType :: String -> ExpType -> TcType\ncheckingExpType _   (Check ty) = ty\ncheckingExpType err et         = pprPanic \"checkingExpType\" (text err $$ ppr et)\n\ntauifyExpType :: ExpType -> TcM ExpType\n-- ^ Turn a (Infer hole) type into a (Check alpha),\n-- where alpha is a fresh unification variable\ntauifyExpType (Check ty)      = return (Check ty)  -- No-op for (Check ty)\ntauifyExpType (Infer inf_res) = do { ty <- inferResultToType inf_res\n                                   ; return (Check ty) }\n\n-- | Extracts the expected type if there is one, or generates a new\n-- TauTv if there isn't.\nexpTypeToType :: ExpType -> TcM TcType\nexpTypeToType (Check ty)      = return ty\nexpTypeToType (Infer inf_res) = inferResultToType inf_res\n\ninferResultToType :: InferResult -> TcM Type\ninferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl\n                      , ir_ref = ref })\n  = do { rr  <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy\n       ; tau <- newMetaTyVarTyAtLevel tc_lvl (tYPE rr)\n             -- See Note [TcLevel of ExpType]\n       ; writeMutVar ref (Just tau)\n       ; traceTc \"Forcing ExpType to be monomorphic:\"\n                 (ppr u <+> text \":=\" <+> ppr tau)\n       ; return tau }\n\n\n{- *********************************************************************\n*                                                                      *\n        SkolemTvs (immutable)\n*                                                                      *\n********************************************************************* -}\n\ntcInstType :: ([TyVar] -> TcM (TCvSubst, [TcTyVar]))\n                   -- ^ How to instantiate the type variables\n           -> Id                                            -- ^ Type to instantiate\n           -> TcM ([(Name, TcTyVar)], TcThetaType, TcType)  -- ^ Result\n                -- (type vars, preds (incl equalities), rho)\ntcInstType inst_tyvars id\n  = case tcSplitForAllTys (idType id) of\n        ([],    rho) -> let     -- There may be overloading despite no type variables;\n                                --      (?x :: Int) => Int -> Int\n                                (theta, tau) = tcSplitPhiTy rho\n                            in\n                            return ([], theta, tau)\n\n        (tyvars, rho) -> do { (subst, tyvars') <- inst_tyvars tyvars\n                            ; let (theta, tau) = tcSplitPhiTy (substTyAddInScope subst rho)\n                                  tv_prs       = map tyVarName tyvars `zip` tyvars'\n                            ; return (tv_prs, theta, tau) }\n\ntcSkolDFunType :: DFunId -> TcM ([TcTyVar], TcThetaType, TcType)\n-- Instantiate a type signature with skolem constants.\n-- We could give them fresh names, but no need to do so\ntcSkolDFunType dfun\n  = do { (tv_prs, theta, tau) <- tcInstType tcInstSuperSkolTyVars dfun\n       ; return (map snd tv_prs, theta, tau) }\n\ntcSuperSkolTyVars :: [TyVar] -> (TCvSubst, [TcTyVar])\n-- Make skolem constants, but do *not* give them new names, as above\n-- Moreover, make them \"super skolems\"; see comments with superSkolemTv\n-- see Note [Kind substitution when instantiating]\n-- Precondition: tyvars should be ordered by scoping\ntcSuperSkolTyVars = mapAccumL tcSuperSkolTyVar emptyTCvSubst\n\ntcSuperSkolTyVar :: TCvSubst -> TyVar -> (TCvSubst, TcTyVar)\ntcSuperSkolTyVar subst tv\n  = (extendTvSubstWithClone subst tv new_tv, new_tv)\n  where\n    kind   = substTyUnchecked subst (tyVarKind tv)\n    new_tv = mkTcTyVar (tyVarName tv) kind superSkolemTv\n\n-- | Given a list of @['TyVar']@, skolemize the type variables,\n-- returning a substitution mapping the original tyvars to the\n-- skolems, and the list of newly bound skolems.\ntcInstSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])\n-- See Note [Skolemising type variables]\ntcInstSkolTyVars = tcInstSkolTyVarsX emptyTCvSubst\n\ntcInstSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])\n-- See Note [Skolemising type variables]\ntcInstSkolTyVarsX = tcInstSkolTyVarsPushLevel False\n\ntcInstSuperSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])\n-- See Note [Skolemising type variables]\ntcInstSuperSkolTyVars = tcInstSuperSkolTyVarsX emptyTCvSubst\n\ntcInstSuperSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])\n-- See Note [Skolemising type variables]\ntcInstSuperSkolTyVarsX subst = tcInstSkolTyVarsPushLevel True subst\n\ntcInstSkolTyVarsPushLevel :: Bool -> TCvSubst -> [TyVar]\n                          -> TcM (TCvSubst, [TcTyVar])\n-- Skolemise one level deeper, hence pushTcLevel\n-- See Note [Skolemising type variables]\ntcInstSkolTyVarsPushLevel overlappable subst tvs\n  = do { tc_lvl <- getTcLevel\n       ; let pushed_lvl = pushTcLevel tc_lvl\n       ; tcInstSkolTyVarsAt pushed_lvl overlappable subst tvs }\n\ntcInstSkolTyVarsAt :: TcLevel -> Bool\n                   -> TCvSubst -> [TyVar]\n                   -> TcM (TCvSubst, [TcTyVar])\ntcInstSkolTyVarsAt lvl overlappable subst tvs\n  = freshenTyCoVarsX new_skol_tv subst tvs\n  where\n    details = SkolemTv lvl overlappable\n    new_skol_tv name kind = mkTcTyVar name kind details\n\n------------------\nfreshenTyVarBndrs :: [TyVar] -> TcM (TCvSubst, [TyVar])\n-- ^ Give fresh uniques to a bunch of TyVars, but they stay\n--   as TyVars, rather than becoming TcTyVars\n-- Used in FamInst.newFamInst, and Inst.newClsInst\nfreshenTyVarBndrs = freshenTyCoVars mkTyVar\n\nfreshenCoVarBndrsX :: TCvSubst -> [CoVar] -> TcM (TCvSubst, [CoVar])\n-- ^ Give fresh uniques to a bunch of CoVars\n-- Used in FamInst.newFamInst\nfreshenCoVarBndrsX subst = freshenTyCoVarsX mkCoVar subst\n\n------------------\nfreshenTyCoVars :: (Name -> Kind -> TyCoVar)\n                -> [TyVar] -> TcM (TCvSubst, [TyCoVar])\nfreshenTyCoVars mk_tcv = freshenTyCoVarsX mk_tcv emptyTCvSubst\n\nfreshenTyCoVarsX :: (Name -> Kind -> TyCoVar)\n                 -> TCvSubst -> [TyCoVar]\n                 -> TcM (TCvSubst, [TyCoVar])\nfreshenTyCoVarsX mk_tcv = mapAccumLM (freshenTyCoVarX mk_tcv)\n\nfreshenTyCoVarX :: (Name -> Kind -> TyCoVar)\n                -> TCvSubst -> TyCoVar -> TcM (TCvSubst, TyCoVar)\n-- This a complete freshening operation:\n-- the skolems have a fresh unique, and a location from the monad\n-- See Note [Skolemising type variables]\nfreshenTyCoVarX mk_tcv subst tycovar\n  = do { loc  <- getSrcSpanM\n       ; uniq <- newUnique\n       ; let old_name = tyVarName tycovar\n             new_name = mkInternalName uniq (getOccName old_name) loc\n             new_kind = substTyUnchecked subst (tyVarKind tycovar)\n             new_tcv  = mk_tcv new_name new_kind\n             subst1   = extendTCvSubstWithClone subst tycovar new_tcv\n       ; return (subst1, new_tcv) }\n\n{- Note [Skolemising type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe tcInstSkolTyVars family of functions instantiate a list of TyVars\nto fresh skolem TcTyVars. Important notes:\n\na) Level allocation. We generally skolemise /before/ calling\n   pushLevelAndCaptureConstraints.  So we want their level to the level\n   of the soon-to-be-created implication, which has a level ONE HIGHER\n   than the current level.  Hence the pushTcLevel.  It feels like a\n   slight hack.\n\nb) The [TyVar] should be ordered (kind vars first)\n   See Note [Kind substitution when instantiating]\n\nc) It's a complete freshening operation: the skolems have a fresh\n   unique, and a location from the monad\n\nd) The resulting skolems are\n        non-overlappable for tcInstSkolTyVars,\n   but overlappable for tcInstSuperSkolTyVars\n   See TcDerivInfer Note [Overlap and deriving] for an example\n   of where this matters.\n\nNote [Kind substitution when instantiating]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we instantiate a bunch of kind and type variables, first we\nexpect them to be topologically sorted.\nThen we have to instantiate the kind variables, build a substitution\nfrom old variables to the new variables, then instantiate the type\nvariables substituting the original kind.\n\nExemple: If we want to instantiate\n  [(k1 :: *), (k2 :: *), (a :: k1 -> k2), (b :: k1)]\nwe want\n  [(?k1 :: *), (?k2 :: *), (?a :: ?k1 -> ?k2), (?b :: ?k1)]\ninstead of the buggous\n  [(?k1 :: *), (?k2 :: *), (?a :: k1 -> k2), (?b :: k1)]\n\n\n************************************************************************\n*                                                                      *\n        MetaTvs (meta type variables; mutable)\n*                                                                      *\n************************************************************************\n-}\n\n{-\nNote [TyVarTv]\n~~~~~~~~~~~~\n\nA TyVarTv can unify with type *variables* only, including other TyVarTvs and\nskolems. Sometimes, they can unify with type variables that the user would\nrather keep distinct; see #11203 for an example.  So, any client of this\nfunction needs to either allow the TyVarTvs to unify with each other or check\nthat they don't (say, with a call to findDubTyVarTvs).\n\nBefore #15050 this (under the name SigTv) was used for ScopedTypeVariables in\npatterns, to make sure these type variables only refer to other type variables,\nbut this restriction was dropped, and ScopedTypeVariables can now refer to full\ntypes (GHC Proposal 29).\n\nThe remaining uses of newTyVarTyVars are\n* In kind signatures, see\n  TcTyClsDecls Note [Inferring kinds for type declarations]\n           and Note [Kind checking for GADTs]\n* In partial type signatures, see Note [Quantified variables in partial type signatures]\n-}\n\nnewMetaTyVarName :: FastString -> TcM Name\n-- Makes a /System/ Name, which is eagerly eliminated by\n-- the unifier; see TcUnify.nicer_to_update_tv1, and\n-- TcCanonical.canEqTyVarTyVar (nicer_to_update_tv2)\nnewMetaTyVarName str\n  = do { uniq <- newUnique\n       ; return (mkSystemName uniq (mkTyVarOccFS str)) }\n\ncloneMetaTyVarName :: Name -> TcM Name\ncloneMetaTyVarName name\n  = do { uniq <- newUnique\n       ; return (mkSystemName uniq (nameOccName name)) }\n         -- See Note [Name of an instantiated type variable]\n\n{- Note [Name of an instantiated type variable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAt the moment we give a unification variable a System Name, which\ninfluences the way it is tidied; see TypeRep.tidyTyVarBndr.\n\nNote [Unification variables need fresh Names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhenever we allocate a unification variable (MetaTyVar) we give\nit a fresh name.   Trac #16221 is a very tricky case that illustrates\nwhy this is important:\n\n   data SameKind :: k -> k -> *\n   data T0 a = forall k2 (b :: k2). MkT0 (SameKind a b) !Int\n\nWhen kind-checking T0, we give (a :: kappa1). Then, in kcConDecl\nwe allocate a unification variable kappa2 for k2, and then we\nend up unifying kappa1 := kappa2 (because of the (SameKind a b).\n\nNow we generalise over kappa2; but if kappa2's Name is k2,\nwe'll end up giving T0 the kind forall k2. k2 -> *.  Nothing\ndirectly wrong with that but when we typecheck the data constrautor\nwe end up giving it the type\n  MkT0 :: forall k1 (a :: k1) k2 (b :: k2).\n          SameKind @k2 a b -> Int -> T0 @{k2} a\nwhich is bogus.  The result type should be T0 @{k1} a.\n\nAnd there no reason /not/ to clone the Name when making a\nunification variable.  So that's what we do.\n-}\n\nnewAnonMetaTyVar :: MetaInfo -> Kind -> TcM TcTyVar\n-- Make a new meta tyvar out of thin air\nnewAnonMetaTyVar meta_info kind\n  = do  { let s = case meta_info of\n                        TauTv       -> fsLit \"t\"\n                        FlatMetaTv  -> fsLit \"fmv\"\n                        FlatSkolTv  -> fsLit \"fsk\"\n                        TyVarTv      -> fsLit \"a\"\n        ; name    <- newMetaTyVarName s\n        ; details <- newMetaDetails meta_info\n        ; let tyvar = mkTcTyVar name kind details\n        ; traceTc \"newAnonMetaTyVar\" (ppr tyvar)\n        ; return tyvar }\n\n-- makes a new skolem tv\nnewSkolemTyVar :: Name -> Kind -> TcM TcTyVar\nnewSkolemTyVar name kind\n  = do { lvl <- getTcLevel\n       ; return (mkTcTyVar name kind (SkolemTv lvl False)) }\n\nnewTyVarTyVar :: Name -> Kind -> TcM TcTyVar\n-- See Note [TyVarTv]\n-- See Note [Unification variables need fresh Names]\nnewTyVarTyVar name kind\n  = do { details <- newMetaDetails TyVarTv\n       ; uniq <- newUnique\n       ; let name' = name `setNameUnique` uniq\n             tyvar = mkTcTyVar name' kind details\n         -- Don't use cloneMetaTyVar, which makes a SystemName\n         -- We want to keep the original more user-friendly Name\n         -- In practical terms that means that in error messages,\n         -- when the Name is tidied we get 'a' rather than 'a0'\n       ; traceTc \"newTyVarTyVar\" (ppr tyvar)\n       ; return tyvar }\n\nnewPatSigTyVar :: Name -> Kind -> TcM TcTyVar\nnewPatSigTyVar name kind\n  = do { details <- newMetaDetails TauTv\n       ; uniq <- newUnique\n       ; let name' = name `setNameUnique` uniq\n             tyvar = mkTcTyVar name' kind details\n         -- Don't use cloneMetaTyVar;\n         -- same reasoning as in newTyVarTyVar\n       ; traceTc \"newPatSigTyVar\" (ppr tyvar)\n       ; return tyvar }\n\ncloneAnonMetaTyVar :: MetaInfo -> TyVar -> TcKind -> TcM TcTyVar\n-- Make a fresh MetaTyVar, basing the name\n-- on that of the supplied TyVar\ncloneAnonMetaTyVar info tv kind\n  = do  { details <- newMetaDetails info\n        ; name    <- cloneMetaTyVarName (tyVarName tv)\n        ; let tyvar = mkTcTyVar name kind details\n        ; traceTc \"cloneAnonMetaTyVar\" (ppr tyvar)\n        ; return tyvar }\n\nnewFskTyVar :: TcType -> TcM TcTyVar\nnewFskTyVar fam_ty\n  = do { details <- newMetaDetails FlatSkolTv\n       ; name <- newMetaTyVarName (fsLit \"fsk\")\n       ; return (mkTcTyVar name (tcTypeKind fam_ty) details) }\n\nnewFmvTyVar :: TcType -> TcM TcTyVar\n-- Very like newMetaTyVar, except sets mtv_tclvl to one less\n-- so that the fmv is untouchable.\nnewFmvTyVar fam_ty\n  = do { details <- newMetaDetails FlatMetaTv\n       ; name <- newMetaTyVarName (fsLit \"s\")\n       ; return (mkTcTyVar name (tcTypeKind fam_ty) details) }\n\nnewMetaDetails :: MetaInfo -> TcM TcTyVarDetails\nnewMetaDetails info\n  = do { ref <- newMutVar Flexi\n       ; tclvl <- getTcLevel\n       ; return (MetaTv { mtv_info = info\n                        , mtv_ref = ref\n                        , mtv_tclvl = tclvl }) }\n\ncloneMetaTyVar :: TcTyVar -> TcM TcTyVar\ncloneMetaTyVar tv\n  = ASSERT( isTcTyVar tv )\n    do  { ref  <- newMutVar Flexi\n        ; name' <- cloneMetaTyVarName (tyVarName tv)\n        ; let details' = case tcTyVarDetails tv of\n                           details@(MetaTv {}) -> details { mtv_ref = ref }\n                           _ -> pprPanic \"cloneMetaTyVar\" (ppr tv)\n              tyvar = mkTcTyVar name' (tyVarKind tv) details'\n        ; traceTc \"cloneMetaTyVar\" (ppr tyvar)\n        ; return tyvar }\n\n-- Works for both type and kind variables\nreadMetaTyVar :: TyVar -> TcM MetaDetails\nreadMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )\n                      readMutVar (metaTyVarRef tyvar)\n\nisFilledMetaTyVar_maybe :: TcTyVar -> TcM (Maybe Type)\nisFilledMetaTyVar_maybe tv\n | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv\n = do { cts <- readTcRef ref\n      ; case cts of\n          Indirect ty -> return (Just ty)\n          Flexi       -> return Nothing }\n | otherwise\n = return Nothing\n\nisFilledMetaTyVar :: TyVar -> TcM Bool\n-- True of a filled-in (Indirect) meta type variable\nisFilledMetaTyVar tv = isJust <$> isFilledMetaTyVar_maybe tv\n\nisUnfilledMetaTyVar :: TyVar -> TcM Bool\n-- True of a un-filled-in (Flexi) meta type variable\n-- NB: Not the opposite of isFilledMetaTyVar\nisUnfilledMetaTyVar tv\n  | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv\n  = do  { details <- readMutVar ref\n        ; return (isFlexi details) }\n  | otherwise = return False\n\n--------------------\n-- Works with both type and kind variables\nwriteMetaTyVar :: TcTyVar -> TcType -> TcM ()\n-- Write into a currently-empty MetaTyVar\n\nwriteMetaTyVar tyvar ty\n  | not debugIsOn\n  = writeMetaTyVarRef tyvar (metaTyVarRef tyvar) ty\n\n-- Everything from here on only happens if DEBUG is on\n  | not (isTcTyVar tyvar)\n  = WARN( True, text \"Writing to non-tc tyvar\" <+> ppr tyvar )\n    return ()\n\n  | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar\n  = writeMetaTyVarRef tyvar ref ty\n\n  | otherwise\n  = WARN( True, text \"Writing to non-meta tyvar\" <+> ppr tyvar )\n    return ()\n\n--------------------\nwriteMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()\n-- Here the tyvar is for error checking only;\n-- the ref cell must be for the same tyvar\nwriteMetaTyVarRef tyvar ref ty\n  | not debugIsOn\n  = do { traceTc \"writeMetaTyVar\" (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)\n                                   <+> text \":=\" <+> ppr ty)\n       ; writeTcRef ref (Indirect ty) }\n\n  -- Everything from here on only happens if DEBUG is on\n  | otherwise\n  = do { meta_details <- readMutVar ref;\n       -- Zonk kinds to allow the error check to work\n       ; zonked_tv_kind <- zonkTcType tv_kind\n       ; zonked_ty_kind <- zonkTcType ty_kind\n       ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind\n                          || tcEqKind zonked_ty_kind zonked_tv_kind\n             -- Hack alert! tcIsConstraintKind: see TcHsType\n             -- Note [Extra-constraint holes in partial type signatures]\n\n             kind_msg = hang (text \"Ill-kinded update to meta tyvar\")\n                           2 (    ppr tyvar <+> text \"::\" <+> (ppr tv_kind $$ ppr zonked_tv_kind)\n                              <+> text \":=\"\n                              <+> ppr ty <+> text \"::\" <+> (ppr zonked_ty_kind) )\n\n       ; traceTc \"writeMetaTyVar\" (ppr tyvar <+> text \":=\" <+> ppr ty)\n\n       -- Check for double updates\n       ; MASSERT2( isFlexi meta_details, double_upd_msg meta_details )\n\n       -- Check for level OK\n       -- See Note [Level check when unifying]\n       ; MASSERT2( level_check_ok, level_check_msg )\n\n       -- Check Kinds ok\n       ; MASSERT2( kind_check_ok, kind_msg )\n\n       -- Do the write\n       ; writeMutVar ref (Indirect ty) }\n  where\n    tv_kind = tyVarKind tyvar\n    ty_kind = tcTypeKind ty\n\n    tv_lvl = tcTyVarLevel tyvar\n    ty_lvl = tcTypeLevel ty\n\n    level_check_ok  = not (ty_lvl `strictlyDeeperThan` tv_lvl)\n    level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty\n\n    double_upd_msg details = hang (text \"Double update of meta tyvar\")\n                                2 (ppr tyvar $$ ppr details)\n\n{- Note [Level check when unifying]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen unifying\n     alpha:lvl := ty\nwe expect that the TcLevel of 'ty' will be <= lvl.\nHowever, during unflatting we do\n     fuv:l := ty:(l+1)\nwhich is usually wrong; hence the check isFmmvTyVar in level_check_ok.\nSee Note [TcLevel assignment] in TcType.\n-}\n\n{-\n% Generating fresh variables for pattern match check\n-}\n\n\n{-\n************************************************************************\n*                                                                      *\n        MetaTvs: TauTvs\n*                                                                      *\n************************************************************************\n\nNote [Never need to instantiate coercion variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWith coercion variables sloshing around in types, it might seem that we\nsometimes need to instantiate coercion variables. This would be problematic,\nbecause coercion variables inhabit unboxed equality (~#), and the constraint\nsolver thinks in terms only of boxed equality (~). The solution is that\nwe never need to instantiate coercion variables in the first place.\n\nThe tyvars that we need to instantiate come from the types of functions,\ndata constructors, and patterns. These will never be quantified over\ncoercion variables, except for the special case of the promoted Eq#. But,\nthat can't ever appear in user code, so we're safe!\n-}\n\n\nnewFlexiTyVar :: Kind -> TcM TcTyVar\nnewFlexiTyVar kind = newAnonMetaTyVar TauTv kind\n\nnewFlexiTyVarTy :: Kind -> TcM TcType\nnewFlexiTyVarTy kind = do\n    tc_tyvar <- newFlexiTyVar kind\n    return (mkTyVarTy tc_tyvar)\n\nnewFlexiTyVarTys :: Int -> Kind -> TcM [TcType]\nnewFlexiTyVarTys n kind = mapM newFlexiTyVarTy (nOfThem n kind)\n\nnewOpenTypeKind :: TcM TcKind\nnewOpenTypeKind\n  = do { rr <- newFlexiTyVarTy runtimeRepTy\n       ; return (tYPE rr) }\n\n-- | Create a tyvar that can be a lifted or unlifted type.\n-- Returns alpha :: TYPE kappa, where both alpha and kappa are fresh\nnewOpenFlexiTyVarTy :: TcM TcType\nnewOpenFlexiTyVarTy\n  = do { kind <- newOpenTypeKind\n       ; newFlexiTyVarTy kind }\n\nnewMetaTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])\n-- Instantiate with META type variables\n-- Note that this works for a sequence of kind, type, and coercion variables\n-- variables.  Eg    [ (k:*), (a:k->k) ]\n--             Gives [ (k7:*), (a8:k7->k7) ]\nnewMetaTyVars = newMetaTyVarsX emptyTCvSubst\n    -- emptyTCvSubst has an empty in-scope set, but that's fine here\n    -- Since the tyvars are freshly made, they cannot possibly be\n    -- captured by any existing for-alls.\n\nnewMetaTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])\n-- Just like newMetaTyVars, but start with an existing substitution.\nnewMetaTyVarsX subst = mapAccumLM newMetaTyVarX subst\n\nnewMetaTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)\n-- Make a new unification variable tyvar whose Name and Kind come from\n-- an existing TyVar. We substitute kind variables in the kind.\nnewMetaTyVarX subst tyvar = new_meta_tv_x TauTv subst tyvar\n\nnewMetaTyVarTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])\nnewMetaTyVarTyVars = mapAccumLM newMetaTyVarTyVarX emptyTCvSubst\n\nnewMetaTyVarTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)\n-- Just like newMetaTyVarX, but make a TyVarTv\nnewMetaTyVarTyVarX subst tyvar = new_meta_tv_x TyVarTv subst tyvar\n\nnewWildCardX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)\nnewWildCardX subst tv\n  = do { new_tv <- newAnonMetaTyVar TauTv (substTy subst (tyVarKind tv))\n       ; return (extendTvSubstWithClone subst tv new_tv, new_tv) }\n\nnew_meta_tv_x :: MetaInfo -> TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)\nnew_meta_tv_x info subst tv\n  = do  { new_tv <- cloneAnonMetaTyVar info tv substd_kind\n        ; let subst1 = extendTvSubstWithClone subst tv new_tv\n        ; return (subst1, new_tv) }\n  where\n    substd_kind = substTyUnchecked subst (tyVarKind tv)\n      -- NOTE: Trac #12549 is fixed so we could use\n      -- substTy here, but the tc_infer_args problem\n      -- is not yet fixed so leaving as unchecked for now.\n      -- OLD NOTE:\n      -- Unchecked because we call newMetaTyVarX from\n      -- tcInstTyBinder, which is called from tcInferApps\n      -- which does not yet take enough trouble to ensure\n      -- the in-scope set is right; e.g. Trac #12785 trips\n      -- if we use substTy here\n\nnewMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType\nnewMetaTyVarTyAtLevel tc_lvl kind\n  = do  { ref  <- newMutVar Flexi\n        ; name <- newMetaTyVarName (fsLit \"p\")\n        ; let details = MetaTv { mtv_info  = TauTv\n                               , mtv_ref   = ref\n                               , mtv_tclvl = tc_lvl }\n        ; return (mkTyVarTy (mkTcTyVar name kind details)) }\n\n{- *********************************************************************\n*                                                                      *\n          Finding variables to quantify over\n*                                                                      *\n********************************************************************* -}\n\n{- Note [Dependent type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn Haskell type inference we quantify over type variables; but we only\nquantify over /kind/ variables when -XPolyKinds is on.  Without -XPolyKinds\nwe default the kind variables to *.\n\nSo, to support this defaulting, and only for that reason, when\ncollecting the free vars of a type, prior to quantifying, we must keep\nthe type and kind variables separate.\n\nBut what does that mean in a system where kind variables /are/ type\nvariables? It's a fairly arbitrary distinction based on how the\nvariables appear:\n\n  - \"Kind variables\" appear in the kind of some other free variable\n\n     These are the ones we default to * if -XPolyKinds is off\n\n  - \"Type variables\" are all free vars that are not kind variables\n\nE.g.  In the type    T k (a::k)\n      'k' is a kind variable, because it occurs in the kind of 'a',\n          even though it also appears at \"top level\" of the type\n      'a' is a type variable, because it doesn't\n\nWe gather these variables using a CandidatesQTvs record:\n  DV { dv_kvs: Variables free in the kind of a free type variable\n               or of a forall-bound type variable\n     , dv_tvs: Variables sytactically free in the type }\n\nSo:  dv_kvs            are the kind variables of the type\n     (dv_tvs - dv_kvs) are the type variable of the type\n\nNote that\n\n* A variable can occur in both.\n      T k (x::k)    The first occurrence of k makes it\n                    show up in dv_tvs, the second in dv_kvs\n\n* We include any coercion variables in the \"dependent\",\n  \"kind-variable\" set because we never quantify over them.\n\n* The \"kind variables\" might depend on each other; e.g\n     (k1 :: k2), (k2 :: *)\n  The \"type variables\" do not depend on each other; if\n  one did, it'd be classified as a kind variable!\n\nNote [CandidatesQTvs determinism and order]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Determinism: when we quantify over type variables we decide the\n  order in which they appear in the final type. Because the order of\n  type variables in the type can end up in the interface file and\n  affects some optimizations like worker-wrapper, we want this order to\n  be deterministic.\n\n  To achieve that we use deterministic sets of variables that can be\n  converted to lists in a deterministic order. For more information\n  about deterministic sets see Note [Deterministic UniqFM] in UniqDFM.\n\n* Order: as well as being deterministic, we use an\n  accumulating-parameter style for candidateQTyVarsOfType so that we\n  add variables one at a time, left to right.  That means we tend to\n  produce the variables in left-to-right order.  This is just to make\n  it bit more predicatable for the programmer.\n\nNote [Naughty quantification candidates]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (#14880, dependent/should_compile/T14880-2), suppose\nwe are trying to generalise this type:\n\n  forall arg. ... (alpha[tau]:arg) ...\n\nWe have a metavariable alpha whose kind mentions a skolem variable\nboudn inside the very type we are generalising.\nThis can arise while type-checking a user-written type signature\n(see the test case for the full code).\n\nWe cannot generalise over alpha!  That would produce a type like\n  forall {a :: arg}. forall arg. ...blah...\nThe fact that alpha's kind mentions arg renders it completely\nineligible for generaliation.\n\nHowever, we are not going to learn any new constraints on alpha,\nbecause its kind isn't even in scope in the outer context.  So alpha\nis entirely unconstrained.\n\nWhat then should we do with alpha?  During generalization, every\nmetavariable is either (A) promoted, (B) generalized, or (C) zapped\n(according again to Note [Recipe for checking a signature] in\nTcHsType).\n\n * We can't generalise it.\n * We can't promote it, because its kind prevents that\n * We can't simply leave it be, because this type is about to\n   go into the typing environment (as the type of some let-bound\n   variable, say), and then chaos erupts when we try to instantiate.\n\nSo, we zap it, eagerly, to Any. We don't have to do this eager zapping\nin terms (say, in `length []`) because terms are never re-examined before\nthe final zonk (which zaps any lingering metavariables to Any).\n\nWe do this eager zapping in candidateQTyVars, which always precedes\ngeneralisation, because at that moment we have a clear picture of\nwhat skolems are in scope.\n\n-}\n\ndata CandidatesQTvs\n  -- See Note [Dependent type variables]\n  -- See Note [CandidatesQTvs determinism and order]\n  --\n  -- Invariants:\n  --   * All variables stored here are MetaTvs. No exceptions.\n  --   * All variables are fully zonked, including their kinds\n  --\n  = DV { dv_kvs :: DTyVarSet    -- \"kind\" metavariables (dependent)\n       , dv_tvs :: DTyVarSet    -- \"type\" metavariables (non-dependent)\n         -- A variable may appear in both sets\n         -- E.g.   T k (x::k)    The first occurrence of k makes it\n         --                      show up in dv_tvs, the second in dv_kvs\n         -- See Note [Dependent type variables]\n\n       , dv_cvs :: CoVarSet\n         -- These are covars. We will *not* quantify over these, but\n         -- we must make sure also not to quantify over any cv's kinds,\n         -- so we include them here as further direction for quantifyTyVars\n    }\n\ninstance Semi.Semigroup CandidatesQTvs where\n   (DV { dv_kvs = kv1, dv_tvs = tv1, dv_cvs = cv1 })\n     <> (DV { dv_kvs = kv2, dv_tvs = tv2, dv_cvs = cv2 })\n          = DV { dv_kvs = kv1 `unionDVarSet` kv2\n               , dv_tvs = tv1 `unionDVarSet` tv2\n               , dv_cvs = cv1 `unionVarSet` cv2 }\n\ninstance Monoid CandidatesQTvs where\n   mempty = DV { dv_kvs = emptyDVarSet, dv_tvs = emptyDVarSet, dv_cvs = emptyVarSet }\n   mappend = (Semi.<>)\n\ninstance Outputable CandidatesQTvs where\n  ppr (DV {dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs })\n    = text \"DV\" <+> braces (pprWithCommas id [ text \"dv_kvs =\" <+> ppr kvs\n                                             , text \"dv_tvs =\" <+> ppr tvs\n                                             , text \"dv_cvs =\" <+> ppr cvs ])\n\n\ncandidateKindVars :: CandidatesQTvs -> TyVarSet\ncandidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs)\n\n-- | Gathers free variables to use as quantification candidates (in\n-- 'quantifyTyVars'). This might output the same var\n-- in both sets, if it's used in both a type and a kind.\n-- See Note [CandidatesQTvs determinism and order]\n-- See Note [Dependent type variables]\ncandidateQTyVarsOfType :: TcType       -- not necessarily zonked\n                       -> TcM CandidatesQTvs\ncandidateQTyVarsOfType ty = collect_cand_qtvs False emptyVarSet mempty ty\n\n-- | Like 'splitDepVarsOfType', but over a list of types\ncandidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs\ncandidateQTyVarsOfTypes tys = foldlM (collect_cand_qtvs False emptyVarSet) mempty tys\n\n-- | Like 'candidateQTyVarsOfType', but consider every free variable\n-- to be dependent. This is appropriate when generalizing a *kind*,\n-- instead of a type. (That way, -XNoPolyKinds will default the variables\n-- to Type.)\ncandidateQTyVarsOfKind :: TcKind       -- Not necessarily zonked\n                       -> TcM CandidatesQTvs\ncandidateQTyVarsOfKind ty = collect_cand_qtvs True emptyVarSet mempty ty\n\ncandidateQTyVarsOfKinds :: [TcKind]    -- Not necessarily zonked\n                       -> TcM CandidatesQTvs\ncandidateQTyVarsOfKinds tys = foldM (collect_cand_qtvs True emptyVarSet) mempty tys\n\ndelCandidates :: CandidatesQTvs -> [Var] -> CandidatesQTvs\ndelCandidates (DV { dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs }) vars\n  = DV { dv_kvs = kvs `delDVarSetList` vars\n       , dv_tvs = tvs `delDVarSetList` vars\n       , dv_cvs = cvs `delVarSetList`  vars }\n\ncollect_cand_qtvs\n  :: Bool            -- True <=> consider every fv in Type to be dependent\n  -> VarSet          -- Bound variables (both locally bound and globally bound)\n  -> CandidatesQTvs  -- Accumulating parameter\n  -> Type            -- Not necessarily zonked\n  -> TcM CandidatesQTvs\n\n-- Key points:\n--   * Looks through meta-tyvars as it goes;\n--     no need to zonk in advance\n--\n--   * Needs to be monadic anyway, because it does the zap-naughty\n--     stuff; see Note [Naughty quantification candidates]\n--\n--   * Returns fully-zonked CandidateQTvs, including their kinds\n--     so that subsequent dependency analysis (to build a well\n--     scoped telescope) works correctly\n\ncollect_cand_qtvs is_dep bound dvs ty\n  = go dvs ty\n  where\n    is_bound tv = tv `elemVarSet` bound\n\n    -----------------\n    go :: CandidatesQTvs -> TcType -> TcM CandidatesQTvs\n    -- Uses accumulating-parameter style\n    go dv (AppTy t1 t2)     = foldlM go dv [t1, t2]\n    go dv (TyConApp _ tys)  = foldlM go dv tys\n    go dv (FunTy _ arg res) = foldlM go dv [arg, res]\n    go dv (LitTy {})        = return dv\n    go dv (CastTy ty co)    = do dv1 <- go dv ty\n                                 collect_cand_qtvs_co bound dv1 co\n    go dv (CoercionTy co)   = collect_cand_qtvs_co bound dv co\n\n    go dv (TyVarTy tv)\n      | is_bound tv = return dv\n      | otherwise   = do { m_contents <- isFilledMetaTyVar_maybe tv\n                         ; case m_contents of\n                             Just ind_ty -> go dv ind_ty\n                             Nothing     -> go_tv dv tv }\n\n    go dv (ForAllTy (Bndr tv _) ty)\n      = do { dv1 <- collect_cand_qtvs True bound dv (tyVarKind tv)\n           ; collect_cand_qtvs is_dep (bound `extendVarSet` tv) dv1 ty }\n\n    -----------------\n    go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv\n      | tv `elemDVarSet` kvs = return dv  -- We have met this tyvar aleady\n      | not is_dep\n      , tv `elemDVarSet` tvs = return dv  -- We have met this tyvar aleady\n      | otherwise\n      = do { tv_kind <- zonkTcType (tyVarKind tv)\n                 -- This zonk is annoying, but it is necessary, both to\n                 -- ensure that the collected candidates have zonked kinds\n                 -- (Trac #15795) and to make the naughty check\n                 -- (which comes next) works correctly\n           ; if intersectsVarSet bound (tyCoVarsOfType tv_kind)\n\n             then -- See Note [Naughty quantification candidates]\n                  do { traceTc \"Zapping naughty quantifier\" (pprTyVar tv)\n                     ; writeMetaTyVar tv (anyTypeOfKind tv_kind)\n                     ; collect_cand_qtvs True bound dv tv_kind }\n\n             else do { let tv' = tv `setTyVarKind` tv_kind\n                           dv' | is_dep    = dv { dv_kvs = kvs `extendDVarSet` tv' }\n                               | otherwise = dv { dv_tvs = tvs `extendDVarSet` tv' }\n                               -- See Note [Order of accumulation]\n                     ; collect_cand_qtvs True emptyVarSet dv' tv_kind } }\n\ncollect_cand_qtvs_co :: VarSet -- bound variables\n                     -> CandidatesQTvs -> Coercion\n                     -> TcM CandidatesQTvs\ncollect_cand_qtvs_co bound = go_co\n  where\n    go_co dv (Refl ty)             = collect_cand_qtvs True bound dv ty\n    go_co dv (GRefl _ ty mco)      = do dv1 <- collect_cand_qtvs True bound dv ty\n                                        go_mco dv1 mco\n    go_co dv (TyConAppCo _ _ cos)  = foldlM go_co dv cos\n    go_co dv (AppCo co1 co2)       = foldlM go_co dv [co1, co2]\n    go_co dv (FunCo _ co1 co2)     = foldlM go_co dv [co1, co2]\n    go_co dv (AxiomInstCo _ _ cos) = foldlM go_co dv cos\n    go_co dv (AxiomRuleCo _ cos)   = foldlM go_co dv cos\n    go_co dv (UnivCo prov _ t1 t2) = do dv1 <- go_prov dv prov\n                                        dv2 <- collect_cand_qtvs True bound dv1 t1\n                                        collect_cand_qtvs True bound dv2 t2\n    go_co dv (SymCo co)            = go_co dv co\n    go_co dv (TransCo co1 co2)     = foldlM go_co dv [co1, co2]\n    go_co dv (NthCo _ _ co)        = go_co dv co\n    go_co dv (LRCo _ co)           = go_co dv co\n    go_co dv (InstCo co1 co2)      = foldlM go_co dv [co1, co2]\n    go_co dv (KindCo co)           = go_co dv co\n    go_co dv (SubCo co)            = go_co dv co\n\n    go_co dv (HoleCo hole) = do m_co <- unpackCoercionHole_maybe hole\n                                case m_co of\n                                  Just co -> go_co dv co\n                                  Nothing -> go_cv dv (coHoleCoVar hole)\n\n    go_co dv (CoVarCo cv) = go_cv dv cv\n\n    go_co dv (ForAllCo tcv kind_co co)\n      = do { dv1 <- go_co dv kind_co\n           ; collect_cand_qtvs_co (bound `extendVarSet` tcv) dv1 co }\n\n    go_mco dv MRefl    = return dv\n    go_mco dv (MCo co) = go_co dv co\n\n    go_prov dv UnsafeCoerceProv    = return dv\n    go_prov dv (PhantomProv co)    = go_co dv co\n    go_prov dv (ProofIrrelProv co) = go_co dv co\n    go_prov dv (PluginProv _)      = return dv\n\n    go_cv :: CandidatesQTvs -> CoVar -> TcM CandidatesQTvs\n    go_cv dv@(DV { dv_cvs = cvs }) cv\n      | is_bound cv         = return dv\n      | cv `elemVarSet` cvs = return dv\n      | otherwise           = collect_cand_qtvs True emptyVarSet\n                                    (dv { dv_cvs = cvs `extendVarSet` cv })\n                                    (idType cv)\n\n    is_bound tv = tv `elemVarSet` bound\n\n{- Note [Order of accumulation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nYou might be tempted (like I was) to use unitDVarSet and mappend\nrather than extendDVarSet.  However, the union algorithm for\ndeterministic sets depends on (roughly) the size of the sets. The\nelements from the smaller set end up to the right of the elements from\nthe larger one. When sets are equal, the left-hand argument to\n`mappend` goes to the right of the right-hand argument.\n\nIn our case, if we use unitDVarSet and mappend, we learn that the free\nvariables of (a -> b -> c -> d) are [b, a, c, d], and we then quantify\nover them in that order. (The a comes after the b because we union the\nsingleton sets as ({a} `mappend` {b}), producing {b, a}. Thereafter,\nthe size criterion works to our advantage.) This is just annoying to\nusers, so I use `extendDVarSet`, which unambiguously puts the new\nelement to the right.\n\nNote that the unitDVarSet/mappend implementation would not be wrong\nagainst any specification -- just suboptimal and confounding to users.\n-}\n\n{- *********************************************************************\n*                                                                      *\n             Quantification\n*                                                                      *\n************************************************************************\n\nNote [quantifyTyVars]\n~~~~~~~~~~~~~~~~~~~~~\nquantifyTyVars is given the free vars of a type that we\nare about to wrap in a forall.\n\nIt takes these free type/kind variables (partitioned into dependent and\nnon-dependent variables) and\n  1. Zonks them and remove globals and covars\n  2. Extends kvs1 with free kind vars in the kinds of tvs (removing globals)\n  3. Calls skolemiseQuantifiedTyVar on each\n\nStep (2) is often unimportant, because the kind variable is often\nalso free in the type.  Eg\n     Typeable k (a::k)\nhas free vars {k,a}.  But the type (see Trac #7916)\n    (f::k->*) (a::k)\nhas free vars {f,a}, but we must add 'k' as well! Hence step (2).\n\n* This function distinguishes between dependent and non-dependent\n  variables only to keep correct defaulting behavior with -XNoPolyKinds.\n  With -XPolyKinds, it treats both classes of variables identically.\n\n* quantifyTyVars never quantifies over\n    - a coercion variable (or any tv mentioned in the kind of a covar)\n    - a runtime-rep variable\n\nNote [quantifyTyVars determinism]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe results of quantifyTyVars are wrapped in a forall and can end up in the\ninterface file. One such example is inferred type signatures. They also affect\nthe results of optimizations, for example worker-wrapper. This means that to\nget deterministic builds quantifyTyVars needs to be deterministic.\n\nTo achieve this CandidatesQTvs is backed by deterministic sets which allows them\nto be later converted to a list in a deterministic order.\n\nFor more information about deterministic sets see\nNote [Deterministic UniqFM] in UniqDFM.\n-}\n\nquantifyTyVars\n  :: TcTyCoVarSet     -- Global tvs; already zonked\n  -> CandidatesQTvs   -- See Note [Dependent type variables]\n                      -- Already zonked\n  -> TcM [TcTyVar]\n-- See Note [quantifyTyVars]\n-- Can be given a mixture of TcTyVars and TyVars, in the case of\n--   associated type declarations. Also accepts covars, but *never* returns any.\nquantifyTyVars gbl_tvs\n               dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs, dv_cvs = covars })\n  = do { outer_tclvl <- getTcLevel\n       ; traceTc \"quantifyTyVars 1\" (vcat [ppr outer_tclvl, ppr dvs, ppr gbl_tvs])\n       ; let co_tvs = closeOverKinds covars\n             mono_tvs = gbl_tvs `unionVarSet` co_tvs\n              -- NB: All variables in the kind of a covar must not be\n              -- quantified over, as we don't quantify over the covar.\n\n             dep_kvs = dVarSetElemsWellScoped $\n                       dep_tkvs `dVarSetMinusVarSet` mono_tvs\n                       -- dVarSetElemsWellScoped: put the kind variables into\n                       --    well-scoped order.\n                       --    E.g.  [k, (a::k)] not the other way roud\n\n             nondep_tvs = dVarSetElems $\n                          (nondep_tkvs `minusDVarSet` dep_tkvs)\n                           `dVarSetMinusVarSet` mono_tvs\n                 -- See Note [Dependent type variables]\n                 -- The `minus` dep_tkvs removes any kind-level vars\n                 --    e.g. T k (a::k)   Since k appear in a kind it'll\n                 --    be in dv_kvs, and is dependent. So remove it from\n                 --    dv_tvs which will also contain k\n                 -- No worry about dependent covars here;\n                 --    they are all in dep_tkvs\n                 -- NB kinds of tvs are zonked by zonkTyCoVarsAndFV\n\n       -- This block uses level numbers to decide what to quantify\n       -- and emits a warning if the two methods do not give the same answer\n       ; let dep_kvs2    = dVarSetElemsWellScoped $\n                           filterDVarSet (quantifiableTv outer_tclvl) dep_tkvs\n             nondep_tvs2 = filter (quantifiableTv outer_tclvl) $\n                           dVarSetElems (nondep_tkvs `minusDVarSet` dep_tkvs)\n\n             all_ok = dep_kvs == dep_kvs2 && nondep_tvs == nondep_tvs2\n             bad_msg = hang (text \"Quantification by level numbers would fail\")\n                          2 (vcat [ text \"Outer level =\" <+> ppr outer_tclvl\n                                  , text \"dep_tkvs =\"    <+> ppr dep_tkvs\n                                  , text \"co_vars =\"     <+> vcat [ ppr cv <+> dcolon <+> ppr (varType cv)\n                                                                  | cv <- nonDetEltsUniqSet covars ]\n                                  , text \"co_tvs =\"      <+> ppr co_tvs\n                                  , text \"dep_kvs =\"     <+> ppr dep_kvs\n                                  , text \"dep_kvs2 =\"    <+> ppr dep_kvs2\n                                  , text \"nondep_tvs =\"  <+> ppr nondep_tvs\n                                  , text \"nondep_tvs2 =\" <+> ppr nondep_tvs2 ])\n       ; WARN( not all_ok, bad_msg ) return ()\n\n             -- In the non-PolyKinds case, default the kind variables\n             -- to *, and zonk the tyvars as usual.  Notice that this\n             -- may make quantifyTyVars return a shorter list\n             -- than it was passed, but that's ok\n       ; poly_kinds  <- xoptM LangExt.PolyKinds\n       ; dep_kvs'    <- mapMaybeM (zonk_quant (not poly_kinds)) dep_kvs\n       ; nondep_tvs' <- mapMaybeM (zonk_quant False)            nondep_tvs\n       ; let final_qtvs = dep_kvs' ++ nondep_tvs'\n           -- Because of the order, any kind variables\n           -- mentioned in the kinds of the nondep_tvs'\n           -- now refer to the dep_kvs'\n\n       ; traceTc \"quantifyTyVars 2\"\n           (vcat [ text \"globals:\"    <+> ppr gbl_tvs\n                 , text \"mono_tvs:\"   <+> ppr mono_tvs\n                 , text \"nondep:\"     <+> pprTyVars nondep_tvs\n                 , text \"dep:\"        <+> pprTyVars dep_kvs\n                 , text \"dep_kvs'\"    <+> pprTyVars dep_kvs'\n                 , text \"nondep_tvs'\" <+> pprTyVars nondep_tvs' ])\n\n       -- We should never quantify over coercion variables; check this\n       ; let co_vars = filter isCoVar final_qtvs\n       ; MASSERT2( null co_vars, ppr co_vars )\n\n       ; return final_qtvs }\n  where\n    -- zonk_quant returns a tyvar if it should be quantified over;\n    -- otherwise, it returns Nothing. The latter case happens for\n    --    * Kind variables, with -XNoPolyKinds: don't quantify over these\n    --    * RuntimeRep variables: we never quantify over these\n    zonk_quant default_kind tkv\n      | not (isTyVar tkv)\n      = return Nothing   -- this can happen for a covar that's associated with\n                         -- a coercion hole. Test case: typecheck/should_compile/T2494\n\n      | not (isTcTyVar tkv)  -- I don't think this can ever happen.\n                             -- Hence the assert\n      = ASSERT2( False, text \"quantifying over a TyVar\" <+> ppr tkv)\n        return (Just tkv)\n\n      | otherwise\n      = do { deflt_done <- defaultTyVar default_kind tkv\n           ; case deflt_done of\n               True  -> return Nothing\n               False -> do { tv <- skolemiseQuantifiedTyVar tkv\n                           ; return (Just tv) } }\n\nquantifiableTv :: TcLevel   -- Level of the context, outside the quantification\n               -> TcTyVar\n               -> Bool\nquantifiableTv outer_tclvl tcv\n  | isTcTyVar tcv  -- Might be a CoVar; change this when gather covars separtely\n  = tcTyVarLevel tcv > outer_tclvl\n  | otherwise\n  = False\n\nzonkAndSkolemise :: TcTyCoVar -> TcM TcTyCoVar\n-- A tyvar binder is never a unification variable (TauTv),\n-- rather it is always a skolem. It *might* be a TyVarTv.\n-- (Because non-CUSK type declarations use TyVarTvs.)\n-- Regardless, it may have a kind that has not yet been zonked,\n-- and may include kind unification variables.\nzonkAndSkolemise tyvar\n  | isTyVarTyVar tyvar\n     -- We want to preserve the binding location of the original TyVarTv.\n     -- This is important for error messages. If we don't do this, then\n     -- we get bad locations in, e.g., typecheck/should_fail/T2688\n  = do { zonked_tyvar <- zonkTcTyVarToTyVar tyvar\n       ; skolemiseQuantifiedTyVar zonked_tyvar }\n\n  | otherwise\n  = ASSERT2( isImmutableTyVar tyvar || isCoVar tyvar, pprTyVar tyvar )\n    zonkTyCoVarKind tyvar\n\nskolemiseQuantifiedTyVar :: TcTyVar -> TcM TcTyVar\n-- The quantified type variables often include meta type variables\n-- we want to freeze them into ordinary type variables\n-- The meta tyvar is updated to point to the new skolem TyVar.  Now any\n-- bound occurrences of the original type variable will get zonked to\n-- the immutable version.\n--\n-- We leave skolem TyVars alone; they are immutable.\n--\n-- This function is called on both kind and type variables,\n-- but kind variables *only* if PolyKinds is on.\n\nskolemiseQuantifiedTyVar tv\n  = case tcTyVarDetails tv of\n      SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv)\n                        ; return (setTyVarKind tv kind) }\n        -- It might be a skolem type variable,\n        -- for example from a user type signature\n\n      MetaTv {} -> skolemiseUnboundMetaTyVar tv\n\n      _other -> pprPanic \"skolemiseQuantifiedTyVar\" (ppr tv) -- RuntimeUnk\n\ndefaultTyVar :: Bool      -- True <=> please default this kind variable to *\n             -> TcTyVar   -- If it's a MetaTyVar then it is unbound\n             -> TcM Bool  -- True <=> defaulted away altogether\n\ndefaultTyVar default_kind tv\n  | not (isMetaTyVar tv)\n  = return False\n\n  | isTyVarTyVar tv\n    -- Do not default TyVarTvs. Doing so would violate the invariants\n    -- on TyVarTvs; see Note [Signature skolems] in TcType.\n    -- Trac #13343 is an example; #14555 is another\n    -- See Note [Inferring kinds for type declarations] in TcTyClsDecls\n  = return False\n\n\n  | isRuntimeRepVar tv  -- Do not quantify over a RuntimeRep var\n                        -- unless it is a TyVarTv, handled earlier\n  = do { traceTc \"Defaulting a RuntimeRep var to LiftedRep\" (ppr tv)\n       ; writeMetaTyVar tv liftedRepTy\n       ; return True }\n\n  | default_kind            -- -XNoPolyKinds and this is a kind var\n  = default_kind_var tv     -- so default it to * if possible\n\n  | otherwise\n  = return False\n\n  where\n    default_kind_var :: TyVar -> TcM Bool\n       -- defaultKindVar is used exclusively with -XNoPolyKinds\n       -- See Note [Defaulting with -XNoPolyKinds]\n       -- It takes an (unconstrained) meta tyvar and defaults it.\n       -- Works only on vars of type *; for other kinds, it issues an error.\n    default_kind_var kv\n      | isLiftedTypeKind (tyVarKind kv)\n      = do { traceTc \"Defaulting a kind var to *\" (ppr kv)\n           ; writeMetaTyVar kv liftedTypeKind\n           ; return True }\n      | otherwise\n      = do { addErr (vcat [ text \"Cannot default kind variable\" <+> quotes (ppr kv')\n                          , text \"of kind:\" <+> ppr (tyVarKind kv')\n                          , text \"Perhaps enable PolyKinds or add a kind signature\" ])\n           -- We failed to default it, so return False to say so.\n           -- Hence, it'll get skolemised.  That might seem odd, but we must either\n           -- promote, skolemise, or zap-to-Any, to satisfy TcHsType\n           --    Note [Recipe for checking a signature]\n           -- Otherwise we get level-number assertion failures. It doesn't matter much\n           -- because we are in an error siutation anyway.\n           ; return False\n        }\n      where\n        (_, kv') = tidyOpenTyCoVar emptyTidyEnv kv\n\nskolemiseUnboundMetaTyVar :: TcTyVar -> TcM TyVar\n-- We have a Meta tyvar with a ref-cell inside it\n-- Skolemise it, so that we are totally out of Meta-tyvar-land\n-- We create a skolem TcTyVar, not a regular TyVar\n--   See Note [Zonking to Skolem]\nskolemiseUnboundMetaTyVar tv\n  = ASSERT2( isMetaTyVar tv, ppr tv )\n    do  { when debugIsOn (check_empty tv)\n        ; span <- getSrcSpanM    -- Get the location from \"here\"\n                                 -- ie where we are generalising\n        ; kind <- zonkTcType (tyVarKind tv)\n        ; let uniq        = getUnique tv\n                -- NB: Use same Unique as original tyvar. This is\n                -- convenient in reading dumps, but is otherwise inessential.\n\n              tv_name     = getOccName tv\n              final_name  = mkInternalName uniq tv_name span\n              final_tv    = mkTcTyVar final_name kind details\n\n        ; traceTc \"Skolemising\" (ppr tv <+> text \":=\" <+> ppr final_tv)\n        ; writeMetaTyVar tv (mkTyVarTy final_tv)\n        ; return final_tv }\n\n  where\n    details = SkolemTv (metaTyVarTcLevel tv) False\n    check_empty tv       -- [Sept 04] Check for non-empty.\n      = when debugIsOn $  -- See note [Silly Type Synonym]\n        do { cts <- readMetaTyVar tv\n           ; case cts of\n               Flexi       -> return ()\n               Indirect ty -> WARN( True, ppr tv $$ ppr ty )\n                              return () }\n\n{- Note [Defaulting with -XNoPolyKinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n  data Compose f g a = Mk (f (g a))\n\nWe infer\n\n  Compose :: forall k1 k2. (k2 -> *) -> (k1 -> k2) -> k1 -> *\n  Mk :: forall k1 k2 (f :: k2 -> *) (g :: k1 -> k2) (a :: k1).\n        f (g a) -> Compose k1 k2 f g a\n\nNow, in another module, we have -XNoPolyKinds -XDataKinds in effect.\nWhat does 'Mk mean? Pre GHC-8.0 with -XNoPolyKinds,\nwe just defaulted all kind variables to *. But that's no good here,\nbecause the kind variables in 'Mk aren't of kind *, so defaulting to *\nis ill-kinded.\n\nAfter some debate on #11334, we decided to issue an error in this case.\nThe code is in defaultKindVar.\n\nNote [What is a meta variable?]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA \"meta type-variable\", also know as a \"unification variable\" is a placeholder\nintroduced by the typechecker for an as-yet-unknown monotype.\n\nFor example, when we see a call `reverse (f xs)`, we know that we calling\n    reverse :: forall a. [a] -> [a]\nSo we know that the argument `f xs` must be a \"list of something\". But what is\nthe \"something\"? We don't know until we explore the `f xs` a bit more. So we set\nout what we do know at the call of `reverse` by instantiate its type with a fresh\nmeta tyvar, `alpha` say. So now the type of the argument `f xs`, and of the\nresult, is `[alpha]`. The unification variable `alpha` stands for the\nas-yet-unknown type of the elements of the list.\n\nAs type inference progresses we may learn more about `alpha`. For example, suppose\n`f` has the type\n    f :: forall b. b -> [Maybe b]\nThen we instantiate `f`'s type with another fresh unification variable, say\n`beta`; and equate `f`'s result type with reverse's argument type, thus\n`[alpha] ~ [Maybe beta]`.\n\nNow we can solve this equality to learn that `alpha ~ Maybe beta`, so we've\nrefined our knowledge about `alpha`. And so on.\n\nIf you found this Note useful, you may also want to have a look at\nSection 5 of \"Practical type inference for higher rank types\" (Peyton Jones,\nVytiniotis, Weirich and Shields. J. Functional Programming. 2011).\n\nNote [What is zonking?]\n~~~~~~~~~~~~~~~~~~~~~~~\nGHC relies heavily on mutability in the typechecker for efficient operation.\nFor this reason, throughout much of the type checking process meta type\nvariables (the MetaTv constructor of TcTyVarDetails) are represented by mutable\nvariables (known as TcRefs).\n\nZonking is the process of ripping out these mutable variables and replacing them\nwith a real Type. This involves traversing the entire type expression, but the\ninteresting part of replacing the mutable variables occurs in zonkTyVarOcc.\n\nThere are two ways to zonk a Type:\n\n * zonkTcTypeToType, which is intended to be used at the end of type-checking\n   for the final zonk. It has to deal with unfilled metavars, either by filling\n   it with a value like Any or failing (determined by the UnboundTyVarZonker\n   used).\n\n * zonkTcType, which will happily ignore unfilled metavars. This is the\n   appropriate function to use while in the middle of type-checking.\n\nNote [Zonking to Skolem]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWe used to zonk quantified type variables to regular TyVars.  However, this\nleads to problems.  Consider this program from the regression test suite:\n\n  eval :: Int -> String -> String -> String\n  eval 0 root actual = evalRHS 0 root actual\n\n  evalRHS :: Int -> a\n  evalRHS 0 root actual = eval 0 root actual\n\nIt leads to the deferral of an equality (wrapped in an implication constraint)\n\n  forall a. () => ((String -> String -> String) ~ a)\n\nwhich is propagated up to the toplevel (see TcSimplify.tcSimplifyInferCheck).\nIn the meantime `a' is zonked and quantified to form `evalRHS's signature.\nThis has the *side effect* of also zonking the `a' in the deferred equality\n(which at this point is being handed around wrapped in an implication\nconstraint).\n\nFinally, the equality (with the zonked `a') will be handed back to the\nsimplifier by TcRnDriver.tcRnSrcDecls calling TcSimplify.tcSimplifyTop.\nIf we zonk `a' with a regular type variable, we will have this regular type\nvariable now floating around in the simplifier, which in many places assumes to\nonly see proper TcTyVars.\n\nWe can avoid this problem by zonking with a skolem.  The skolem is rigid\n(which we require for a quantified variable), but is still a TcTyVar that the\nsimplifier knows how to deal with.\n\nNote [Silly Type Synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n        type C u a = u  -- Note 'a' unused\n\n        foo :: (forall a. C u a -> C u a) -> u\n        foo x = ...\n\n        bar :: Num u => u\n        bar = foo (\\t -> t + t)\n\n* From the (\\t -> t+t) we get type  {Num d} =>  d -> d\n  where d is fresh.\n\n* Now unify with type of foo's arg, and we get:\n        {Num (C d a)} =>  C d a -> C d a\n  where a is fresh.\n\n* Now abstract over the 'a', but float out the Num (C d a) constraint\n  because it does not 'really' mention a.  (see exactTyVarsOfType)\n  The arg to foo becomes\n        \\/\\a -> \\t -> t+t\n\n* So we get a dict binding for Num (C d a), which is zonked to give\n        a = ()\n  [Note Sept 04: now that we are zonking quantified type variables\n  on construction, the 'a' will be frozen as a regular tyvar on\n  quantification, so the floated dict will still have type (C d a).\n  Which renders this whole note moot; happily!]\n\n* Then the \\/\\a abstraction has a zonked 'a' in it.\n\nAll very silly.   I think its harmless to ignore the problem.  We'll end up with\na \\/\\a in the final result but all the occurrences of a will be zonked to ()\n\n************************************************************************\n*                                                                      *\n              Zonking types\n*                                                                      *\n************************************************************************\n\n-}\n\n-- | @tcGetGlobalTyCoVars@ returns a fully-zonked set of *scoped* tyvars free in\n-- the environment. To improve subsequent calls to the same function it writes\n-- the zonked set back into the environment. Note that this returns all\n-- variables free in anything (term-level or type-level) in scope. We thus\n-- don't have to worry about clashes with things that are not in scope, because\n-- if they are reachable, then they'll be returned here.\n-- NB: This is closed over kinds, so it can return unification variables mentioned\n-- in the kinds of in-scope tyvars.\ntcGetGlobalTyCoVars :: TcM TcTyVarSet\ntcGetGlobalTyCoVars\n  = do { (TcLclEnv {tcl_tyvars = gtv_var}) <- getLclEnv\n       ; gbl_tvs  <- readMutVar gtv_var\n       ; gbl_tvs' <- zonkTyCoVarsAndFV gbl_tvs\n       ; writeMutVar gtv_var gbl_tvs'\n       ; return gbl_tvs' }\n\nzonkTcTypeAndFV :: TcType -> TcM DTyCoVarSet\n-- Zonk a type and take its free variables\n-- With kind polymorphism it can be essential to zonk *first*\n-- so that we find the right set of free variables.  Eg\n--    forall k1. forall (a:k2). a\n-- where k2:=k1 is in the substitution.  We don't want\n-- k2 to look free in this type!\nzonkTcTypeAndFV ty\n  = tyCoVarsOfTypeDSet <$> zonkTcType ty\n\nzonkTyCoVar :: TyCoVar -> TcM TcType\n-- Works on TyVars and TcTyVars\nzonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv\n               | isTyVar   tv = mkTyVarTy <$> zonkTyCoVarKind tv\n               | otherwise    = ASSERT2( isCoVar tv, ppr tv )\n                                mkCoercionTy . mkCoVarCo <$> zonkTyCoVarKind tv\n   -- Hackily, when typechecking type and class decls\n   -- we have TyVars in scope added (only) in\n   -- TcHsType.bindTyClTyVars, but it seems\n   -- painful to make them into TcTyVars there\n\nzonkTyCoVarsAndFV :: TyCoVarSet -> TcM TyCoVarSet\nzonkTyCoVarsAndFV tycovars\n  = tyCoVarsOfTypes <$> mapM zonkTyCoVar (nonDetEltsUniqSet tycovars)\n  -- It's OK to use nonDetEltsUniqSet here because we immediately forget about\n  -- the ordering by turning it into a nondeterministic set and the order\n  -- of zonking doesn't matter for determinism.\n\n-- Takes a list of TyCoVars, zonks them and returns a\n-- deterministically ordered list of their free variables.\nzonkTyCoVarsAndFVList :: [TyCoVar] -> TcM [TyCoVar]\nzonkTyCoVarsAndFVList tycovars\n  = tyCoVarsOfTypesList <$> mapM zonkTyCoVar tycovars\n\nzonkTcTyVars :: [TcTyVar] -> TcM [TcType]\nzonkTcTyVars tyvars = mapM zonkTcTyVar tyvars\n\n-----------------  Types\nzonkTyCoVarKind :: TyCoVar -> TcM TyCoVar\nzonkTyCoVarKind tv = do { kind' <- zonkTcType (tyVarKind tv)\n                        ; return (setTyVarKind tv kind') }\n\nzonkTcTypes :: [TcType] -> TcM [TcType]\nzonkTcTypes tys = mapM zonkTcType tys\n\n{-\n************************************************************************\n*                                                                      *\n              Zonking constraints\n*                                                                      *\n************************************************************************\n-}\n\nzonkImplication :: Implication -> TcM Implication\nzonkImplication implic@(Implic { ic_skols  = skols\n                               , ic_given  = given\n                               , ic_wanted = wanted\n                               , ic_info   = info })\n  = do { skols'  <- mapM zonkTyCoVarKind skols  -- Need to zonk their kinds!\n                                                -- as Trac #7230 showed\n       ; given'  <- mapM zonkEvVar given\n       ; info'   <- zonkSkolemInfo info\n       ; wanted' <- zonkWCRec wanted\n       ; return (implic { ic_skols  = skols'\n                        , ic_given  = given'\n                        , ic_wanted = wanted'\n                        , ic_info   = info' }) }\n\nzonkEvVar :: EvVar -> TcM EvVar\nzonkEvVar var = do { ty' <- zonkTcType (varType var)\n                   ; return (setVarType var ty') }\n\n\nzonkWC :: WantedConstraints -> TcM WantedConstraints\nzonkWC wc = zonkWCRec wc\n\nzonkWCRec :: WantedConstraints -> TcM WantedConstraints\nzonkWCRec (WC { wc_simple = simple, wc_impl = implic })\n  = do { simple' <- zonkSimples simple\n       ; implic' <- mapBagM zonkImplication implic\n       ; return (WC { wc_simple = simple', wc_impl = implic' }) }\n\nzonkSimples :: Cts -> TcM Cts\nzonkSimples cts = do { cts' <- mapBagM zonkCt' cts\n                     ; traceTc \"zonkSimples done:\" (ppr cts')\n                     ; return cts' }\n\nzonkCt' :: Ct -> TcM Ct\nzonkCt' ct = zonkCt ct\n\n{- Note [zonkCt behaviour]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nzonkCt tries to maintain the canonical form of a Ct.  For example,\n  - a CDictCan should stay a CDictCan;\n  - a CTyEqCan should stay a CTyEqCan (if the LHS stays as a variable.).\n  - a CHoleCan should stay a CHoleCan\n  - a CIrredCan should stay a CIrredCan with its cc_insol flag intact\n\nWhy?, for example:\n- For CDictCan, the @TcSimplify.expandSuperClasses@ step, which runs after the\n  simple wanted and plugin loop, looks for @CDictCan@s. If a plugin is in use,\n  constraints are zonked before being passed to the plugin. This means if we\n  don't preserve a canonical form, @expandSuperClasses@ fails to expand\n  superclasses. This is what happened in Trac #11525.\n\n- For CHoleCan, once we forget that it's a hole, we can never recover that info.\n\n- For CIrredCan we want to see if a constraint is insoluble with insolubleWC\n\nNB: we do not expect to see any CFunEqCans, because zonkCt is only\ncalled on unflattened constraints.\n\nNB: Constraints are always re-flattened etc by the canonicaliser in\n@TcCanonical@ even if they come in as CDictCan. Only canonical constraints that\nare actually in the inert set carry all the guarantees. So it is okay if zonkCt\ncreates e.g. a CDictCan where the cc_tyars are /not/ function free.\n-}\n\nzonkCt :: Ct -> TcM Ct\nzonkCt ct@(CHoleCan { cc_ev = ev })\n  = do { ev' <- zonkCtEvidence ev\n       ; return $ ct { cc_ev = ev' } }\n\nzonkCt ct@(CDictCan { cc_ev = ev, cc_tyargs = args })\n  = do { ev'   <- zonkCtEvidence ev\n       ; args' <- mapM zonkTcType args\n       ; return $ ct { cc_ev = ev', cc_tyargs = args' } }\n\nzonkCt ct@(CTyEqCan { cc_ev = ev, cc_tyvar = tv, cc_rhs = rhs })\n  = do { ev'    <- zonkCtEvidence ev\n       ; tv_ty' <- zonkTcTyVar tv\n       ; case getTyVar_maybe tv_ty' of\n           Just tv' -> do { rhs' <- zonkTcType rhs\n                          ; return ct { cc_ev    = ev'\n                                      , cc_tyvar = tv'\n                                      , cc_rhs   = rhs' } }\n           Nothing  -> return (mkNonCanonical ev') }\n\nzonkCt ct@(CIrredCan { cc_ev = ev }) -- Preserve the cc_insol flag\n  = do { ev' <- zonkCtEvidence ev\n       ; return (ct { cc_ev = ev' }) }\n\nzonkCt ct\n  = ASSERT( not (isCFunEqCan ct) )\n  -- We do not expect to see any CFunEqCans, because zonkCt is only called on\n  -- unflattened constraints.\n    do { fl' <- zonkCtEvidence (ctEvidence ct)\n       ; return (mkNonCanonical fl') }\n\nzonkCtEvidence :: CtEvidence -> TcM CtEvidence\nzonkCtEvidence ctev@(CtGiven { ctev_pred = pred })\n  = do { pred' <- zonkTcType pred\n       ; return (ctev { ctev_pred = pred'}) }\nzonkCtEvidence ctev@(CtWanted { ctev_pred = pred, ctev_dest = dest })\n  = do { pred' <- zonkTcType pred\n       ; let dest' = case dest of\n                       EvVarDest ev -> EvVarDest $ setVarType ev pred'\n                         -- necessary in simplifyInfer\n                       HoleDest h   -> HoleDest h\n       ; return (ctev { ctev_pred = pred', ctev_dest = dest' }) }\nzonkCtEvidence ctev@(CtDerived { ctev_pred = pred })\n  = do { pred' <- zonkTcType pred\n       ; return (ctev { ctev_pred = pred' }) }\n\nzonkSkolemInfo :: SkolemInfo -> TcM SkolemInfo\nzonkSkolemInfo (SigSkol cx ty tv_prs)  = do { ty' <- zonkTcType ty\n                                            ; return (SigSkol cx ty' tv_prs) }\nzonkSkolemInfo (InferSkol ntys) = do { ntys' <- mapM do_one ntys\n                                     ; return (InferSkol ntys') }\n  where\n    do_one (n, ty) = do { ty' <- zonkTcType ty; return (n, ty') }\nzonkSkolemInfo skol_info = return skol_info\n\n{-\n%************************************************************************\n%*                                                                      *\n\\subsection{Zonking -- the main work-horses: zonkTcType, zonkTcTyVar}\n*                                                                      *\n*              For internal use only!                                  *\n*                                                                      *\n************************************************************************\n\n-}\n\n-- zonkId is used *during* typechecking just to zonk the Id's type\nzonkId :: TcId -> TcM TcId\nzonkId id\n  = do { ty' <- zonkTcType (idType id)\n       ; return (Id.setIdType id ty') }\n\nzonkCoVar :: CoVar -> TcM CoVar\nzonkCoVar = zonkId\n\n-- | A suitable TyCoMapper for zonking a type during type-checking,\n-- before all metavars are filled in.\nzonkTcTypeMapper :: TyCoMapper () TcM\nzonkTcTypeMapper = TyCoMapper\n  { tcm_tyvar = const zonkTcTyVar\n  , tcm_covar = const (\\cv -> mkCoVarCo <$> zonkTyCoVarKind cv)\n  , tcm_hole  = hole\n  , tcm_tycobinder = \\_env tv _vis -> ((), ) <$> zonkTyCoVarKind tv\n  , tcm_tycon      = zonkTcTyCon }\n  where\n    hole :: () -> CoercionHole -> TcM Coercion\n    hole _ hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })\n      = do { contents <- readTcRef ref\n           ; case contents of\n               Just co -> do { co' <- zonkCo co\n                             ; checkCoercionHole cv co' }\n               Nothing -> do { cv' <- zonkCoVar cv\n                             ; return $ HoleCo (hole { ch_co_var = cv' }) } }\n\nzonkTcTyCon :: TcTyCon -> TcM TcTyCon\n-- Only called on TcTyCons\n-- A non-poly TcTyCon may have unification\n-- variables that need zonking, but poly ones cannot\nzonkTcTyCon tc\n | tcTyConIsPoly tc = return tc\n | otherwise        = do { tck' <- zonkTcType (tyConKind tc)\n                         ; return (setTcTyConKind tc tck') }\n\n-- For unbound, mutable tyvars, zonkType uses the function given to it\n-- For tyvars bound at a for-all, zonkType zonks them to an immutable\n--      type variable and zonks the kind too\nzonkTcType :: TcType -> TcM TcType\nzonkTcType = mapType zonkTcTypeMapper ()\n\n-- | \"Zonk\" a coercion -- really, just zonk any types in the coercion\nzonkCo :: Coercion -> TcM Coercion\nzonkCo = mapCoercion zonkTcTypeMapper ()\n\nzonkTcTyVar :: TcTyVar -> TcM TcType\n-- Simply look through all Flexis\nzonkTcTyVar tv\n  | isTcTyVar tv\n  = case tcTyVarDetails tv of\n      SkolemTv {}   -> zonk_kind_and_return\n      RuntimeUnk {} -> zonk_kind_and_return\n      MetaTv { mtv_ref = ref }\n         -> do { cts <- readMutVar ref\n               ; case cts of\n                    Flexi       -> zonk_kind_and_return\n                    Indirect ty -> do { zty <- zonkTcType ty\n                                      ; writeTcRef ref (Indirect zty)\n                                        -- See Note [Sharing in zonking]\n                                      ; return zty } }\n\n  | otherwise -- coercion variable\n  = zonk_kind_and_return\n  where\n    zonk_kind_and_return = do { z_tv <- zonkTyCoVarKind tv\n                              ; return (mkTyVarTy z_tv) }\n\n-- Variant that assumes that any result of zonking is still a TyVar.\n-- Should be used only on skolems and TyVarTvs\nzonkTcTyVarToTyVar :: HasDebugCallStack => TcTyVar -> TcM TcTyVar\nzonkTcTyVarToTyVar tv\n  = do { ty <- zonkTcTyVar tv\n       ; let tv' = case tcGetTyVar_maybe ty of\n                     Just tv' -> tv'\n                     Nothing  -> pprPanic \"zonkTcTyVarToTyVar\"\n                                          (ppr tv $$ ppr ty)\n       ; return tv' }\n\nzonkTyVarTyVarPairs :: [(Name,TcTyVar)] -> TcM [(Name,TcTyVar)]\nzonkTyVarTyVarPairs prs\n  = mapM do_one prs\n  where\n    do_one (nm, tv) = do { tv' <- zonkTcTyVarToTyVar tv\n                         ; return (nm, tv') }\n\n{- Note [Sharing in zonking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n   alpha :-> beta :-> gamma :-> ty\nwhere the \":->\" means that the unification variable has been\nfilled in with Indirect. Then when zonking alpha, it'd be nice\nto short-circuit beta too, so we end up with\n   alpha :-> zty\n   beta  :-> zty\n   gamma :-> zty\nwhere zty is the zonked version of ty.  That way, if we come across\nbeta later, we'll have less work to do.  (And indeed the same for\nalpha.)\n\nThis is easily achieved: just overwrite (Indirect ty) with (Indirect\nzty).  Non-systematic perf comparisons suggest that this is a modest\nwin.\n\nBut c.f Note [Sharing when zonking to Type] in TcHsSyn.\n\n%************************************************************************\n%*                                                                      *\n                 Tidying\n*                                                                      *\n************************************************************************\n-}\n\nzonkTidyTcType :: TidyEnv -> TcType -> TcM (TidyEnv, TcType)\nzonkTidyTcType env ty = do { ty' <- zonkTcType ty\n                           ; return (tidyOpenType env ty') }\n\nzonkTidyTcTypes :: TidyEnv -> [TcType] -> TcM (TidyEnv, [TcType])\nzonkTidyTcTypes = zonkTidyTcTypes' []\n  where zonkTidyTcTypes' zs env [] = return (env, reverse zs)\n        zonkTidyTcTypes' zs env (ty:tys)\n          = do { (env', ty') <- zonkTidyTcType env ty\n               ; zonkTidyTcTypes' (ty':zs) env' tys }\n\nzonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin)\nzonkTidyOrigin env (GivenOrigin skol_info)\n  = do { skol_info1 <- zonkSkolemInfo skol_info\n       ; let skol_info2 = tidySkolemInfo env skol_info1\n       ; return (env, GivenOrigin skol_info2) }\nzonkTidyOrigin env orig@(TypeEqOrigin { uo_actual   = act\n                                      , uo_expected = exp })\n  = do { (env1, act') <- zonkTidyTcType env  act\n       ; (env2, exp') <- zonkTidyTcType env1 exp\n       ; return ( env2, orig { uo_actual   = act'\n                             , uo_expected = exp' }) }\nzonkTidyOrigin env (KindEqOrigin ty1 m_ty2 orig t_or_k)\n  = do { (env1, ty1')   <- zonkTidyTcType env  ty1\n       ; (env2, m_ty2') <- case m_ty2 of\n                             Just ty2 -> second Just <$> zonkTidyTcType env1 ty2\n                             Nothing  -> return (env1, Nothing)\n       ; (env3, orig')  <- zonkTidyOrigin env2 orig\n       ; return (env3, KindEqOrigin ty1' m_ty2' orig' t_or_k) }\nzonkTidyOrigin env (FunDepOrigin1 p1 l1 p2 l2)\n  = do { (env1, p1') <- zonkTidyTcType env  p1\n       ; (env2, p2') <- zonkTidyTcType env1 p2\n       ; return (env2, FunDepOrigin1 p1' l1 p2' l2) }\nzonkTidyOrigin env (FunDepOrigin2 p1 o1 p2 l2)\n  = do { (env1, p1') <- zonkTidyTcType env  p1\n       ; (env2, p2') <- zonkTidyTcType env1 p2\n       ; (env3, o1') <- zonkTidyOrigin env2 o1\n       ; return (env3, FunDepOrigin2 p1' o1' p2' l2) }\nzonkTidyOrigin env orig = return (env, orig)\n\n----------------\ntidyCt :: TidyEnv -> Ct -> Ct\n-- Used only in error reporting\n-- Also converts it to non-canonical\ntidyCt env ct\n  = case ct of\n     CHoleCan { cc_ev = ev }\n       -> ct { cc_ev = tidy_ev env ev }\n     _ -> mkNonCanonical (tidy_ev env (ctEvidence ct))\n  where\n    tidy_ev :: TidyEnv -> CtEvidence -> CtEvidence\n     -- NB: we do not tidy the ctev_evar field because we don't\n     --     show it in error messages\n    tidy_ev env ctev@(CtGiven { ctev_pred = pred })\n      = ctev { ctev_pred = tidyType env pred }\n    tidy_ev env ctev@(CtWanted { ctev_pred = pred })\n      = ctev { ctev_pred = tidyType env pred }\n    tidy_ev env ctev@(CtDerived { ctev_pred = pred })\n      = ctev { ctev_pred = tidyType env pred }\n\n----------------\ntidyEvVar :: TidyEnv -> EvVar -> EvVar\ntidyEvVar env var = setVarType var (tidyType env (varType var))\n\n----------------\ntidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo\ntidySkolemInfo env (DerivSkol ty)         = DerivSkol (tidyType env ty)\ntidySkolemInfo env (SigSkol cx ty tv_prs) = tidySigSkol env cx ty tv_prs\ntidySkolemInfo env (InferSkol ids)        = InferSkol (mapSnd (tidyType env) ids)\ntidySkolemInfo env (UnifyForAllSkol ty)   = UnifyForAllSkol (tidyType env ty)\ntidySkolemInfo _   info                   = info\n\ntidySigSkol :: TidyEnv -> UserTypeCtxt\n            -> TcType -> [(Name,TcTyVar)] -> SkolemInfo\n-- We need to take special care when tidying SigSkol\n-- See Note [SigSkol SkolemInfo] in TcRnTypes\ntidySigSkol env cx ty tv_prs\n  = SigSkol cx (tidy_ty env ty) tv_prs'\n  where\n    tv_prs' = mapSnd (tidyTyCoVarOcc env) tv_prs\n    inst_env = mkNameEnv tv_prs'\n\n    tidy_ty env (ForAllTy (Bndr tv vis) ty)\n      = ForAllTy (Bndr tv' vis) (tidy_ty env' ty)\n      where\n        (env', tv') = tidy_tv_bndr env tv\n\n    tidy_ty env ty@(FunTy _ arg res)\n      = ty { ft_arg = tidyType env arg, ft_res = tidy_ty env res }\n\n    tidy_ty env ty = tidyType env ty\n\n    tidy_tv_bndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)\n    tidy_tv_bndr env@(occ_env, subst) tv\n      | Just tv' <- lookupNameEnv inst_env (tyVarName tv)\n      = ((occ_env, extendVarEnv subst tv tv'), tv')\n\n      | otherwise\n      = tidyVarBndr env tv\n\n-------------------------------------------------------------------------\n{-\n%************************************************************************\n%*                                                                      *\n             Levity polymorphism checks\n*                                                                      *\n************************************************************************\n\nSee Note [Levity polymorphism checking] in DsMonad\n\n-}\n\n-- | According to the rules around representation polymorphism\n-- (see https://ghc.haskell.org/trac/ghc/wiki/NoSubKinds), no binder\n-- can have a representation-polymorphic type. This check ensures\n-- that we respect this rule. It is a bit regrettable that this error\n-- occurs in zonking, after which we should have reported all errors.\n-- But it's hard to see where else to do it, because this can be discovered\n-- only after all solving is done. And, perhaps most importantly, this\n-- isn't really a compositional property of a type system, so it's\n-- not a terrible surprise that the check has to go in an awkward spot.\nensureNotLevPoly :: Type  -- its zonked type\n                 -> SDoc  -- where this happened\n                 -> TcM ()\nensureNotLevPoly ty doc\n  = whenNoErrs $   -- sometimes we end up zonking bogus definitions of type\n                   -- forall a. a. See, for example, test ghci/scripts/T9140\n    checkForLevPoly doc ty\n\n  -- See Note [Levity polymorphism checking] in DsMonad\ncheckForLevPoly :: SDoc -> Type -> TcM ()\ncheckForLevPoly = checkForLevPolyX addErr\n\ncheckForLevPolyX :: Monad m\n                 => (SDoc -> m ())  -- how to report an error\n                 -> SDoc -> Type -> m ()\ncheckForLevPolyX add_err extra ty\n  | isTypeLevPoly ty\n  = add_err (formatLevPolyErr ty $$ extra)\n  | otherwise\n  = return ()\n\nformatLevPolyErr :: Type  -- levity-polymorphic type\n                 -> SDoc\nformatLevPolyErr ty\n  = hang (text \"A levity-polymorphic type is not allowed here:\")\n       2 (vcat [ text \"Type:\" <+> pprWithTYPE tidy_ty\n               , text \"Kind:\" <+> pprWithTYPE tidy_ki ])\n  where\n    (tidy_env, tidy_ty) = tidyOpenType emptyTidyEnv ty\n    tidy_ki             = tidyType tidy_env (tcTypeKind ty)\n", "num_lines": 2241}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nTcPat: Typechecking patterns\n-}\n\n{-# LANGUAGE CPP, RankNTypes, TupleSections #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcPat ( tcLetPat, newLetBndr, LetBndrSpec(..)\n             , tcPat, tcPat_O, tcPats\n             , addDataConStupidTheta, badFieldCon, polyPatSig ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-}   TcExpr( tcSyntaxOp, tcSyntaxOpGen, tcInferSigma )\n\nimport HsSyn\nimport TcHsSyn\nimport TcSigs( TcPragEnv, lookupPragEnv, addInlinePrags )\nimport TcRnMonad\nimport Inst\nimport Id\nimport Var\nimport Name\nimport RdrName\nimport TcEnv\nimport TcMType\nimport TcValidity( arityErr )\nimport Type ( pprTyVars )\nimport TcType\nimport TcUnify\nimport TcHsType\nimport TysWiredIn\nimport TcEvidence\nimport TyCon\nimport DataCon\nimport PatSyn\nimport ConLike\nimport PrelNames\nimport BasicTypes hiding (SuccessFlag(..))\nimport DynFlags\nimport SrcLoc\nimport VarSet\nimport Util\nimport Outputable\nimport qualified GHC.LanguageExtensions as LangExt\nimport Control.Arrow  ( second )\nimport ListSetOps ( getNth )\n\n{-\n************************************************************************\n*                                                                      *\n                External interface\n*                                                                      *\n************************************************************************\n-}\n\ntcLetPat :: (Name -> Maybe TcId)\n         -> LetBndrSpec\n         -> LPat GhcRn -> ExpSigmaType\n         -> TcM a\n         -> TcM (LPat GhcTcId, a)\ntcLetPat sig_fn no_gen pat pat_ty thing_inside\n  = do { bind_lvl <- getTcLevel\n       ; let ctxt = LetPat { pc_lvl    = bind_lvl\n                           , pc_sig_fn = sig_fn\n                           , pc_new    = no_gen }\n             penv = PE { pe_lazy = True\n                       , pe_ctxt = ctxt\n                       , pe_orig = PatOrigin }\n\n       ; tc_lpat pat pat_ty penv thing_inside }\n\n-----------------\ntcPats :: HsMatchContext Name\n       -> [LPat GhcRn]            -- Patterns,\n       -> [ExpSigmaType]         --   and their types\n       -> TcM a                  --   and the checker for the body\n       -> TcM ([LPat GhcTcId], a)\n\n-- This is the externally-callable wrapper function\n-- Typecheck the patterns, extend the environment to bind the variables,\n-- do the thing inside, use any existentially-bound dictionaries to\n-- discharge parts of the returning LIE, and deal with pattern type\n-- signatures\n\n--   1. Initialise the PatState\n--   2. Check the patterns\n--   3. Check the body\n--   4. Check that no existentials escape\n\ntcPats ctxt pats pat_tys thing_inside\n  = tc_lpats penv pats pat_tys thing_inside\n  where\n    penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt, pe_orig = PatOrigin }\n\ntcPat :: HsMatchContext Name\n      -> LPat GhcRn -> ExpSigmaType\n      -> TcM a                     -- Checker for body\n      -> TcM (LPat GhcTcId, a)\ntcPat ctxt = tcPat_O ctxt PatOrigin\n\n-- | A variant of 'tcPat' that takes a custom origin\ntcPat_O :: HsMatchContext Name\n        -> CtOrigin              -- ^ origin to use if the type needs inst'ing\n        -> LPat GhcRn -> ExpSigmaType\n        -> TcM a                 -- Checker for body\n        -> TcM (LPat GhcTcId, a)\ntcPat_O ctxt orig pat pat_ty thing_inside\n  = tc_lpat pat pat_ty penv thing_inside\n  where\n    penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt, pe_orig = orig }\n\n\n{-\n************************************************************************\n*                                                                      *\n                PatEnv, PatCtxt, LetBndrSpec\n*                                                                      *\n************************************************************************\n-}\n\ndata PatEnv\n  = PE { pe_lazy :: Bool        -- True <=> lazy context, so no existentials allowed\n       , pe_ctxt :: PatCtxt     -- Context in which the whole pattern appears\n       , pe_orig :: CtOrigin    -- origin to use if the pat_ty needs inst'ing\n       }\n\ndata PatCtxt\n  = LamPat   -- Used for lambdas, case etc\n       (HsMatchContext Name)\n\n  | LetPat   -- Used only for let(rec) pattern bindings\n             -- See Note [Typing patterns in pattern bindings]\n       { pc_lvl    :: TcLevel\n                   -- Level of the binding group\n\n       , pc_sig_fn :: Name -> Maybe TcId\n                   -- Tells the expected type\n                   -- for binders with a signature\n\n       , pc_new :: LetBndrSpec\n                -- How to make a new binder\n       }        -- for binders without signatures\n\ndata LetBndrSpec\n  = LetLclBndr            -- We are going to generalise, and wrap in an AbsBinds\n                          -- so clone a fresh binder for the local monomorphic Id\n\n  | LetGblBndr TcPragEnv  -- Generalisation plan is NoGen, so there isn't going\n                          -- to be an AbsBinds; So we must bind the global version\n                          -- of the binder right away.\n                          -- And here is the inline-pragma information\n\ninstance Outputable LetBndrSpec where\n  ppr LetLclBndr      = text \"LetLclBndr\"\n  ppr (LetGblBndr {}) = text \"LetGblBndr\"\n\nmakeLazy :: PatEnv -> PatEnv\nmakeLazy penv = penv { pe_lazy = True }\n\ninPatBind :: PatEnv -> Bool\ninPatBind (PE { pe_ctxt = LetPat {} }) = True\ninPatBind (PE { pe_ctxt = LamPat {} }) = False\n\n{- *********************************************************************\n*                                                                      *\n                Binders\n*                                                                      *\n********************************************************************* -}\n\ntcPatBndr :: PatEnv -> Name -> ExpSigmaType -> TcM (HsWrapper, TcId)\n-- (coi, xp) = tcPatBndr penv x pat_ty\n-- Then coi : pat_ty ~ typeof(xp)\n--\ntcPatBndr penv@(PE { pe_ctxt = LetPat { pc_lvl    = bind_lvl\n                                      , pc_sig_fn = sig_fn\n                                      , pc_new    = no_gen } })\n          bndr_name exp_pat_ty\n  -- For the LetPat cases, see\n  -- Note [Typechecking pattern bindings] in TcBinds\n\n  | Just bndr_id <- sig_fn bndr_name   -- There is a signature\n  = do { wrap <- tcSubTypePat penv exp_pat_ty (idType bndr_id)\n           -- See Note [Subsumption check at pattern variables]\n       ; traceTc \"tcPatBndr(sig)\" (ppr bndr_id $$ ppr (idType bndr_id) $$ ppr exp_pat_ty)\n       ; return (wrap, bndr_id) }\n\n  | otherwise                          -- No signature\n  = do { (co, bndr_ty) <- case exp_pat_ty of\n             Check pat_ty    -> promoteTcType bind_lvl pat_ty\n             Infer infer_res -> ASSERT( bind_lvl == ir_lvl infer_res )\n                                -- If we were under a constructor that bumped\n                                -- the level, we'd be in checking mode\n                                do { bndr_ty <- inferResultToType infer_res\n                                   ; return (mkTcNomReflCo bndr_ty, bndr_ty) }\n       ; bndr_id <- newLetBndr no_gen bndr_name bndr_ty\n       ; traceTc \"tcPatBndr(nosig)\" (vcat [ ppr bind_lvl\n                                          , ppr exp_pat_ty, ppr bndr_ty, ppr co\n                                          , ppr bndr_id ])\n       ; return (mkWpCastN co, bndr_id) }\n\ntcPatBndr _ bndr_name pat_ty\n  = do { pat_ty <- expTypeToType pat_ty\n       ; traceTc \"tcPatBndr(not let)\" (ppr bndr_name $$ ppr pat_ty)\n       ; return (idHsWrapper, mkLocalId bndr_name pat_ty) }\n               -- Whether or not there is a sig is irrelevant,\n               -- as this is local\n\nnewLetBndr :: LetBndrSpec -> Name -> TcType -> TcM TcId\n-- Make up a suitable Id for the pattern-binder.\n-- See Note [Typechecking pattern bindings], item (4) in TcBinds\n--\n-- In the polymorphic case when we are going to generalise\n--    (plan InferGen, no_gen = LetLclBndr), generate a \"monomorphic version\"\n--    of the Id; the original name will be bound to the polymorphic version\n--    by the AbsBinds\n-- In the monomorphic case when we are not going to generalise\n--    (plan NoGen, no_gen = LetGblBndr) there is no AbsBinds,\n--    and we use the original name directly\nnewLetBndr LetLclBndr name ty\n  = do { mono_name <- cloneLocalName name\n       ; return (mkLocalId mono_name ty) }\nnewLetBndr (LetGblBndr prags) name ty\n  = addInlinePrags (mkLocalId name ty) (lookupPragEnv prags name)\n\ntcSubTypePat :: PatEnv -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper\n-- tcSubTypeET with the UserTypeCtxt specialised to GenSigCtxt\n-- Used when typechecking patterns\ntcSubTypePat penv t1 t2 = tcSubTypeET (pe_orig penv) GenSigCtxt t1 t2\n\n{- Note [Subsumption check at pattern variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we come across a variable with a type signature, we need to do a\nsubsumption, not equality, check against the context type.  e.g.\n\n    data T = MkT (forall a. a->a)\n      f :: forall b. [b]->[b]\n      MkT f = blah\n\nSince 'blah' returns a value of type T, its payload is a polymorphic\nfunction of type (forall a. a->a).  And that's enough to bind the\nless-polymorphic function 'f', but we need some impedance matching\nto witness the instantiation.\n\n\n************************************************************************\n*                                                                      *\n                The main worker functions\n*                                                                      *\n************************************************************************\n\nNote [Nesting]\n~~~~~~~~~~~~~~\ntcPat takes a \"thing inside\" over which the pattern scopes.  This is partly\nso that tcPat can extend the environment for the thing_inside, but also\nso that constraints arising in the thing_inside can be discharged by the\npattern.\n\nThis does not work so well for the ErrCtxt carried by the monad: we don't\nwant the error-context for the pattern to scope over the RHS.\nHence the getErrCtxt/setErrCtxt stuff in tcMultiple\n-}\n\n--------------------\ntype Checker inp out =  forall r.\n                          inp\n                       -> PatEnv\n                       -> TcM r\n                       -> TcM (out, r)\n\ntcMultiple :: Checker inp out -> Checker [inp] [out]\ntcMultiple tc_pat args penv thing_inside\n  = do  { err_ctxt <- getErrCtxt\n        ; let loop _ []\n                = do { res <- thing_inside\n                     ; return ([], res) }\n\n              loop penv (arg:args)\n                = do { (p', (ps', res))\n                                <- tc_pat arg penv $\n                                   setErrCtxt err_ctxt $\n                                   loop penv args\n                -- setErrCtxt: restore context before doing the next pattern\n                -- See note [Nesting] above\n\n                     ; return (p':ps', res) }\n\n        ; loop penv args }\n\n--------------------\ntc_lpat :: LPat GhcRn\n        -> ExpSigmaType\n        -> PatEnv\n        -> TcM a\n        -> TcM (LPat GhcTcId, a)\ntc_lpat (dL->L span pat) pat_ty penv thing_inside\n  = setSrcSpan span $\n    do  { (pat', res) <- maybeWrapPatCtxt pat (tc_pat penv pat pat_ty)\n                                          thing_inside\n        ; return (cL span pat', res) }\n\ntc_lpats :: PatEnv\n         -> [LPat GhcRn] -> [ExpSigmaType]\n         -> TcM a\n         -> TcM ([LPat GhcTcId], a)\ntc_lpats penv pats tys thing_inside\n  = ASSERT2( equalLength pats tys, ppr pats $$ ppr tys )\n    tcMultiple (\\(p,t) -> tc_lpat p t)\n                (zipEqual \"tc_lpats\" pats tys)\n                penv thing_inside\n\n--------------------\ntc_pat  :: PatEnv\n        -> Pat GhcRn\n        -> ExpSigmaType  -- Fully refined result type\n        -> TcM a                -- Thing inside\n        -> TcM (Pat GhcTcId,    -- Translated pattern\n                a)              -- Result of thing inside\n\ntc_pat penv (VarPat x (dL->L l name)) pat_ty thing_inside\n  = do  { (wrap, id) <- tcPatBndr penv name pat_ty\n        ; res <- tcExtendIdEnv1 name id thing_inside\n        ; pat_ty <- readExpType pat_ty\n        ; return (mkHsWrapPat wrap (VarPat x (cL l id)) pat_ty, res) }\n\ntc_pat penv (ParPat x pat) pat_ty thing_inside\n  = do  { (pat', res) <- tc_lpat pat pat_ty penv thing_inside\n        ; return (ParPat x pat', res) }\n\ntc_pat penv (BangPat x pat) pat_ty thing_inside\n  = do  { (pat', res) <- tc_lpat pat pat_ty penv thing_inside\n        ; return (BangPat x pat', res) }\n\ntc_pat penv (LazyPat x pat) pat_ty thing_inside\n  = do  { (pat', (res, pat_ct))\n                <- tc_lpat pat pat_ty (makeLazy penv) $\n                   captureConstraints thing_inside\n                -- Ignore refined penv', revert to penv\n\n        ; emitConstraints pat_ct\n        -- captureConstraints/extendConstraints:\n        --   see Note [Hopping the LIE in lazy patterns]\n\n        -- Check that the expected pattern type is itself lifted\n        ; pat_ty <- readExpType pat_ty\n        ; _ <- unifyType Nothing (tcTypeKind pat_ty) liftedTypeKind\n\n        ; return (LazyPat x pat', res) }\n\ntc_pat _ (WildPat _) pat_ty thing_inside\n  = do  { res <- thing_inside\n        ; pat_ty <- expTypeToType pat_ty\n        ; return (WildPat pat_ty, res) }\n\ntc_pat penv (AsPat x (dL->L nm_loc name) pat) pat_ty thing_inside\n  = do  { (wrap, bndr_id) <- setSrcSpan nm_loc (tcPatBndr penv name pat_ty)\n        ; (pat', res) <- tcExtendIdEnv1 name bndr_id $\n                         tc_lpat pat (mkCheckExpType $ idType bndr_id)\n                                 penv thing_inside\n            -- NB: if we do inference on:\n            --          \\ (y@(x::forall a. a->a)) = e\n            -- we'll fail.  The as-pattern infers a monotype for 'y', which then\n            -- fails to unify with the polymorphic type for 'x'.  This could\n            -- perhaps be fixed, but only with a bit more work.\n            --\n            -- If you fix it, don't forget the bindInstsOfPatIds!\n        ; pat_ty <- readExpType pat_ty\n        ; return (mkHsWrapPat wrap (AsPat x (cL nm_loc bndr_id) pat') pat_ty,\n                  res) }\n\ntc_pat penv (ViewPat _ expr pat) overall_pat_ty thing_inside\n  = do  {\n         -- Expr must have type `forall a1...aN. OPT' -> B`\n         -- where overall_pat_ty is an instance of OPT'.\n        ; (expr',expr'_inferred) <- tcInferSigma expr\n\n         -- expression must be a function\n        ; let expr_orig = lexprCtOrigin expr\n              herald    = text \"A view pattern expression expects\"\n        ; (expr_wrap1, [inf_arg_ty], inf_res_ty)\n            <- matchActualFunTys herald expr_orig (Just (unLoc expr)) 1 expr'_inferred\n            -- expr_wrap1 :: expr'_inferred \"->\" (inf_arg_ty -> inf_res_ty)\n\n         -- check that overall pattern is more polymorphic than arg type\n        ; expr_wrap2 <- tcSubTypePat penv overall_pat_ty inf_arg_ty\n            -- expr_wrap2 :: overall_pat_ty \"->\" inf_arg_ty\n\n         -- pattern must have inf_res_ty\n        ; (pat', res) <- tc_lpat pat (mkCheckExpType inf_res_ty) penv thing_inside\n\n        ; overall_pat_ty <- readExpType overall_pat_ty\n        ; let expr_wrap2' = mkWpFun expr_wrap2 idHsWrapper\n                                    overall_pat_ty inf_res_ty doc\n               -- expr_wrap2' :: (inf_arg_ty -> inf_res_ty) \"->\"\n               --                (overall_pat_ty -> inf_res_ty)\n              expr_wrap = expr_wrap2' <.> expr_wrap1\n              doc = text \"When checking the view pattern function:\" <+> (ppr expr)\n        ; return (ViewPat overall_pat_ty (mkLHsWrap expr_wrap expr') pat', res)}\n\n-- Type signatures in patterns\n-- See Note [Pattern coercions] below\ntc_pat penv (SigPat _ pat sig_ty) pat_ty thing_inside\n  = do  { (inner_ty, tv_binds, wcs, wrap) <- tcPatSig (inPatBind penv)\n                                                            sig_ty pat_ty\n                -- Using tcExtendNameTyVarEnv is appropriate here\n                -- because we're not really bringing fresh tyvars into scope.\n                -- We're *naming* existing tyvars. Note that it is OK for a tyvar\n                -- from an outer scope to mention one of these tyvars in its kind.\n        ; (pat', res) <- tcExtendNameTyVarEnv wcs      $\n                         tcExtendNameTyVarEnv tv_binds $\n                         tc_lpat pat (mkCheckExpType inner_ty) penv thing_inside\n        ; pat_ty <- readExpType pat_ty\n        ; return (mkHsWrapPat wrap (SigPat inner_ty pat' sig_ty) pat_ty, res) }\n\n------------------------\n-- Lists, tuples, arrays\ntc_pat penv (ListPat Nothing pats) pat_ty thing_inside\n  = do  { (coi, elt_ty) <- matchExpectedPatTy matchExpectedListTy penv pat_ty\n        ; (pats', res) <- tcMultiple (\\p -> tc_lpat p (mkCheckExpType elt_ty))\n                                     pats penv thing_inside\n        ; pat_ty <- readExpType pat_ty\n        ; return (mkHsWrapPat coi\n                         (ListPat (ListPatTc elt_ty Nothing) pats') pat_ty, res)\n}\n\ntc_pat penv (ListPat (Just e) pats) pat_ty thing_inside\n  = do  { tau_pat_ty <- expTypeToType pat_ty\n        ; ((pats', res, elt_ty), e')\n            <- tcSyntaxOpGen ListOrigin e [SynType (mkCheckExpType tau_pat_ty)]\n                                          SynList $\n                 \\ [elt_ty] ->\n                 do { (pats', res) <- tcMultiple (\\p -> tc_lpat p (mkCheckExpType elt_ty))\n                                                 pats penv thing_inside\n                    ; return (pats', res, elt_ty) }\n        ; return (ListPat (ListPatTc elt_ty (Just (tau_pat_ty,e'))) pats', res)\n}\n\ntc_pat penv (TuplePat _ pats boxity) pat_ty thing_inside\n  = do  { let arity = length pats\n              tc = tupleTyCon boxity arity\n        ; (coi, arg_tys) <- matchExpectedPatTy (matchExpectedTyConApp tc)\n                                               penv pat_ty\n                     -- Unboxed tuples have RuntimeRep vars, which we discard:\n                     -- See Note [Unboxed tuple RuntimeRep vars] in TyCon\n        ; let con_arg_tys = case boxity of Unboxed -> drop arity arg_tys\n                                           Boxed   -> arg_tys\n        ; (pats', res) <- tc_lpats penv pats (map mkCheckExpType con_arg_tys)\n                                   thing_inside\n\n        ; dflags <- getDynFlags\n\n        -- Under flag control turn a pattern (x,y,z) into ~(x,y,z)\n        -- so that we can experiment with lazy tuple-matching.\n        -- This is a pretty odd place to make the switch, but\n        -- it was easy to do.\n        ; let\n              unmangled_result = TuplePat con_arg_tys pats' boxity\n                                 -- pat_ty /= pat_ty iff coi /= IdCo\n              possibly_mangled_result\n                | gopt Opt_IrrefutableTuples dflags &&\n                  isBoxed boxity      = LazyPat noExt (noLoc unmangled_result)\n                | otherwise           = unmangled_result\n\n        ; pat_ty <- readExpType pat_ty\n        ; ASSERT( con_arg_tys `equalLength` pats ) -- Syntactically enforced\n          return (mkHsWrapPat coi possibly_mangled_result pat_ty, res)\n        }\n\ntc_pat penv (SumPat _ pat alt arity ) pat_ty thing_inside\n  = do  { let tc = sumTyCon arity\n        ; (coi, arg_tys) <- matchExpectedPatTy (matchExpectedTyConApp tc)\n                                               penv pat_ty\n        ; -- Drop levity vars, we don't care about them here\n          let con_arg_tys = drop arity arg_tys\n        ; (pat', res) <- tc_lpat pat (mkCheckExpType (con_arg_tys `getNth` (alt - 1)))\n                                 penv thing_inside\n        ; pat_ty <- readExpType pat_ty\n        ; return (mkHsWrapPat coi (SumPat con_arg_tys pat' alt arity) pat_ty\n                 , res)\n        }\n\n------------------------\n-- Data constructors\ntc_pat penv (ConPatIn con arg_pats) pat_ty thing_inside\n  = tcConPat penv con pat_ty arg_pats thing_inside\n\n------------------------\n-- Literal patterns\ntc_pat penv (LitPat x simple_lit) pat_ty thing_inside\n  = do  { let lit_ty = hsLitType simple_lit\n        ; wrap   <- tcSubTypePat penv pat_ty lit_ty\n        ; res    <- thing_inside\n        ; pat_ty <- readExpType pat_ty\n        ; return ( mkHsWrapPat wrap (LitPat x (convertLit simple_lit)) pat_ty\n                 , res) }\n\n------------------------\n-- Overloaded patterns: n, and n+k\n\n-- In the case of a negative literal (the more complicated case),\n-- we get\n--\n--   case v of (-5) -> blah\n--\n-- becoming\n--\n--   if v == (negate (fromInteger 5)) then blah else ...\n--\n-- There are two bits of rebindable syntax:\n--   (==)   :: pat_ty -> neg_lit_ty -> Bool\n--   negate :: lit_ty -> neg_lit_ty\n-- where lit_ty is the type of the overloaded literal 5.\n--\n-- When there is no negation, neg_lit_ty and lit_ty are the same\ntc_pat _ (NPat _ (dL->L l over_lit) mb_neg eq) pat_ty thing_inside\n  = do  { let orig = LiteralOrigin over_lit\n        ; ((lit', mb_neg'), eq')\n            <- tcSyntaxOp orig eq [SynType pat_ty, SynAny]\n                          (mkCheckExpType boolTy) $\n               \\ [neg_lit_ty] ->\n               let new_over_lit lit_ty = newOverloadedLit over_lit\n                                           (mkCheckExpType lit_ty)\n               in case mb_neg of\n                 Nothing  -> (, Nothing) <$> new_over_lit neg_lit_ty\n                 Just neg -> -- Negative literal\n                             -- The 'negate' is re-mappable syntax\n                   second Just <$>\n                   (tcSyntaxOp orig neg [SynRho] (mkCheckExpType neg_lit_ty) $\n                    \\ [lit_ty] -> new_over_lit lit_ty)\n\n        ; res <- thing_inside\n        ; pat_ty <- readExpType pat_ty\n        ; return (NPat pat_ty (cL l lit') mb_neg' eq', res) }\n\n{-\nNote [NPlusK patterns]\n~~~~~~~~~~~~~~~~~~~~~~\nFrom\n\n  case v of x + 5 -> blah\n\nwe get\n\n  if v >= 5 then (\\x -> blah) (v - 5) else ...\n\nThere are two bits of rebindable syntax:\n  (>=) :: pat_ty -> lit1_ty -> Bool\n  (-)  :: pat_ty -> lit2_ty -> var_ty\n\nlit1_ty and lit2_ty could conceivably be different.\nvar_ty is the type inferred for x, the variable in the pattern.\n\nIf the pushed-down pattern type isn't a tau-type, the two pat_ty's above\ncould conceivably be different specializations. But this is very much\nlike the situation in Note [Case branches must be taus] in TcMatches.\nSo we tauify the pat_ty before proceeding.\n\nNote that we need to type-check the literal twice, because it is used\ntwice, and may be used at different types. The second HsOverLit stored in the\nAST is used for the subtraction operation.\n-}\n\n-- See Note [NPlusK patterns]\ntc_pat penv (NPlusKPat _ (dL->L nm_loc name)\n               (dL->L loc lit) _ ge minus) pat_ty\n              thing_inside\n  = do  { pat_ty <- expTypeToType pat_ty\n        ; let orig = LiteralOrigin lit\n        ; (lit1', ge')\n            <- tcSyntaxOp orig ge [synKnownType pat_ty, SynRho]\n                                  (mkCheckExpType boolTy) $\n               \\ [lit1_ty] ->\n               newOverloadedLit lit (mkCheckExpType lit1_ty)\n        ; ((lit2', minus_wrap, bndr_id), minus')\n            <- tcSyntaxOpGen orig minus [synKnownType pat_ty, SynRho] SynAny $\n               \\ [lit2_ty, var_ty] ->\n               do { lit2' <- newOverloadedLit lit (mkCheckExpType lit2_ty)\n                  ; (wrap, bndr_id) <- setSrcSpan nm_loc $\n                                     tcPatBndr penv name (mkCheckExpType var_ty)\n                           -- co :: var_ty ~ idType bndr_id\n\n                           -- minus_wrap is applicable to minus'\n                  ; return (lit2', wrap, bndr_id) }\n\n        -- The Report says that n+k patterns must be in Integral\n        -- but it's silly to insist on this in the RebindableSyntax case\n        ; unlessM (xoptM LangExt.RebindableSyntax) $\n          do { icls <- tcLookupClass integralClassName\n             ; instStupidTheta orig [mkClassPred icls [pat_ty]] }\n\n        ; res <- tcExtendIdEnv1 name bndr_id thing_inside\n\n        ; let minus'' = minus' { syn_res_wrap =\n                                    minus_wrap <.> syn_res_wrap minus' }\n              pat' = NPlusKPat pat_ty (cL nm_loc bndr_id) (cL loc lit1') lit2'\n                               ge' minus''\n        ; return (pat', res) }\n\n-- HsSpliced is an annotation produced by 'RnSplice.rnSplicePat'.\n-- Here we get rid of it and add the finalizers to the global environment.\n--\n-- See Note [Delaying modFinalizers in untyped splices] in RnSplice.\ntc_pat penv (SplicePat _ (HsSpliced _ mod_finalizers (HsSplicedPat pat)))\n            pat_ty thing_inside\n  = do addModFinalizersWithLclEnv mod_finalizers\n       tc_pat penv pat pat_ty thing_inside\n\ntc_pat _ _other_pat _ _ = panic \"tc_pat\"        -- ConPatOut, SigPatOut\n\n\n{-\nNote [Hopping the LIE in lazy patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a lazy pattern, we must *not* discharge constraints from the RHS\nfrom dictionaries bound in the pattern.  E.g.\n        f ~(C x) = 3\nWe can't discharge the Num constraint from dictionaries bound by\nthe pattern C!\n\nSo we have to make the constraints from thing_inside \"hop around\"\nthe pattern.  Hence the captureConstraints and emitConstraints.\n\nThe same thing ensures that equality constraints in a lazy match\nare not made available in the RHS of the match. For example\n        data T a where { T1 :: Int -> T Int; ... }\n        f :: T a -> Int -> a\n        f ~(T1 i) y = y\nIt's obviously not sound to refine a to Int in the right\nhand side, because the argument might not match T1 at all!\n\nFinally, a lazy pattern should not bind any existential type variables\nbecause they won't be in scope when we do the desugaring\n\n\n************************************************************************\n*                                                                      *\n        Most of the work for constructors is here\n        (the rest is in the ConPatIn case of tc_pat)\n*                                                                      *\n************************************************************************\n\n[Pattern matching indexed data types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following declarations:\n\n  data family Map k :: * -> *\n  data instance Map (a, b) v = MapPair (Map a (Pair b v))\n\nand a case expression\n\n  case x :: Map (Int, c) w of MapPair m -> ...\n\nAs explained by [Wrappers for data instance tycons] in MkIds.hs, the\nworker/wrapper types for MapPair are\n\n  $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v\n  $wMapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v\n\nSo, the type of the scrutinee is Map (Int, c) w, but the tycon of MapPair is\n:R123Map, which means the straight use of boxySplitTyConApp would give a type\nerror.  Hence, the smart wrapper function boxySplitTyConAppWithFamily calls\nboxySplitTyConApp with the family tycon Map instead, which gives us the family\ntype list {(Int, c), w}.  To get the correct split for :R123Map, we need to\nunify the family type list {(Int, c), w} with the instance types {(a, b), v}\n(provided by tyConFamInst_maybe together with the family tycon).  This\nunification yields the substitution [a -> Int, b -> c, v -> w], which gives us\nthe split arguments for the representation tycon :R123Map as {Int, c, w}\n\nIn other words, boxySplitTyConAppWithFamily implicitly takes the coercion\n\n  Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}\n\nmoving between representation and family type into account.  To produce type\ncorrect Core, this coercion needs to be used to case the type of the scrutinee\nfrom the family to the representation type.  This is achieved by\nunwrapFamInstScrutinee using a CoPat around the result pattern.\n\nNow it might appear seem as if we could have used the previous GADT type\nrefinement infrastructure of refineAlt and friends instead of the explicit\nunification and CoPat generation.  However, that would be wrong.  Why?  The\nwhole point of GADT refinement is that the refinement is local to the case\nalternative.  In contrast, the substitution generated by the unification of\nthe family type list and instance types needs to be propagated to the outside.\nImagine that in the above example, the type of the scrutinee would have been\n(Map x w), then we would have unified {x, w} with {(a, b), v}, yielding the\nsubstitution [x -> (a, b), v -> w].  In contrast to GADT matching, the\ninstantiation of x with (a, b) must be global; ie, it must be valid in *all*\nalternatives of the case expression, whereas in the GADT case it might vary\nbetween alternatives.\n\nRIP GADT refinement: refinements have been replaced by the use of explicit\nequality constraints that are used in conjunction with implication constraints\nto express the local scope of GADT refinements.\n-}\n\n--      Running example:\n-- MkT :: forall a b c. (a~[b]) => b -> c -> T a\n--       with scrutinee of type (T ty)\n\ntcConPat :: PatEnv -> Located Name\n         -> ExpSigmaType           -- Type of the pattern\n         -> HsConPatDetails GhcRn -> TcM a\n         -> TcM (Pat GhcTcId, a)\ntcConPat penv con_lname@(dL->L _ con_name) pat_ty arg_pats thing_inside\n  = do  { con_like <- tcLookupConLike con_name\n        ; case con_like of\n            RealDataCon data_con -> tcDataConPat penv con_lname data_con\n                                                 pat_ty arg_pats thing_inside\n            PatSynCon pat_syn -> tcPatSynPat penv con_lname pat_syn\n                                             pat_ty arg_pats thing_inside\n        }\n\ntcDataConPat :: PatEnv -> Located Name -> DataCon\n             -> ExpSigmaType               -- Type of the pattern\n             -> HsConPatDetails GhcRn -> TcM a\n             -> TcM (Pat GhcTcId, a)\ntcDataConPat penv (dL->L con_span con_name) data_con pat_ty\n             arg_pats thing_inside\n  = do  { let tycon = dataConTyCon data_con\n                  -- For data families this is the representation tycon\n              (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _)\n                = dataConFullSig data_con\n              header = cL con_span (RealDataCon data_con)\n\n          -- Instantiate the constructor type variables [a->ty]\n          -- This may involve doing a family-instance coercion,\n          -- and building a wrapper\n        ; (wrap, ctxt_res_tys) <- matchExpectedConTy penv tycon pat_ty\n        ; pat_ty <- readExpType pat_ty\n\n          -- Add the stupid theta\n        ; setSrcSpan con_span $ addDataConStupidTheta data_con ctxt_res_tys\n\n        ; let all_arg_tys = eqSpecPreds eq_spec ++ theta ++ arg_tys\n        ; checkExistentials ex_tvs all_arg_tys penv\n\n        ; tenv <- instTyVarsWith PatOrigin univ_tvs ctxt_res_tys\n                  -- NB: Do not use zipTvSubst!  See Trac #14154\n                  -- We want to create a well-kinded substitution, so\n                  -- that the instantiated type is well-kinded\n\n        ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX tenv ex_tvs\n                     -- Get location from monad, not from ex_tvs\n\n        ; let -- pat_ty' = mkTyConApp tycon ctxt_res_tys\n              -- pat_ty' is type of the actual constructor application\n              -- pat_ty' /= pat_ty iff coi /= IdCo\n\n              arg_tys' = substTys tenv arg_tys\n\n        ; traceTc \"tcConPat\" (vcat [ ppr con_name\n                                   , pprTyVars univ_tvs\n                                   , pprTyVars ex_tvs\n                                   , ppr eq_spec\n                                   , ppr theta\n                                   , pprTyVars ex_tvs'\n                                   , ppr ctxt_res_tys\n                                   , ppr arg_tys'\n                                   , ppr arg_pats ])\n        ; if null ex_tvs && null eq_spec && null theta\n          then do { -- The common case; no class bindings etc\n                    -- (see Note [Arrows and patterns])\n                    (arg_pats', res) <- tcConArgs (RealDataCon data_con) arg_tys'\n                                                  arg_pats penv thing_inside\n                  ; let res_pat = ConPatOut { pat_con = header,\n                                              pat_tvs = [], pat_dicts = [],\n                                              pat_binds = emptyTcEvBinds,\n                                              pat_args = arg_pats',\n                                              pat_arg_tys = ctxt_res_tys,\n                                              pat_wrap = idHsWrapper }\n\n                  ; return (mkHsWrapPat wrap res_pat pat_ty, res) }\n\n          else do   -- The general case, with existential,\n                    -- and local equality constraints\n        { let theta'     = substTheta tenv (eqSpecPreds eq_spec ++ theta)\n                           -- order is *important* as we generate the list of\n                           -- dictionary binders from theta'\n              no_equalities = null eq_spec && not (any isEqPred theta)\n              skol_info = PatSkol (RealDataCon data_con) mc\n              mc = case pe_ctxt penv of\n                     LamPat mc -> mc\n                     LetPat {} -> PatBindRhs\n\n        ; gadts_on    <- xoptM LangExt.GADTs\n        ; families_on <- xoptM LangExt.TypeFamilies\n        ; checkTc (no_equalities || gadts_on || families_on)\n                  (text \"A pattern match on a GADT requires the\" <+>\n                   text \"GADTs or TypeFamilies language extension\")\n                  -- Trac #2905 decided that a *pattern-match* of a GADT\n                  -- should require the GADT language flag.\n                  -- Re TypeFamilies see also #7156\n\n        ; given <- newEvVars theta'\n        ; (ev_binds, (arg_pats', res))\n             <- checkConstraints skol_info ex_tvs' given $\n                tcConArgs (RealDataCon data_con) arg_tys' arg_pats penv thing_inside\n\n        ; let res_pat = ConPatOut { pat_con   = header,\n                                    pat_tvs   = ex_tvs',\n                                    pat_dicts = given,\n                                    pat_binds = ev_binds,\n                                    pat_args  = arg_pats',\n                                    pat_arg_tys = ctxt_res_tys,\n                                    pat_wrap  = idHsWrapper }\n        ; return (mkHsWrapPat wrap res_pat pat_ty, res)\n        } }\n\ntcPatSynPat :: PatEnv -> Located Name -> PatSyn\n            -> ExpSigmaType                -- Type of the pattern\n            -> HsConPatDetails GhcRn -> TcM a\n            -> TcM (Pat GhcTcId, a)\ntcPatSynPat penv (dL->L con_span _) pat_syn pat_ty arg_pats thing_inside\n  = do  { let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, ty) = patSynSig pat_syn\n\n        ; (subst, univ_tvs') <- newMetaTyVars univ_tvs\n\n        ; let all_arg_tys = ty : prov_theta ++ arg_tys\n        ; checkExistentials ex_tvs all_arg_tys penv\n        ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX subst ex_tvs\n        ; let ty'         = substTy tenv ty\n              arg_tys'    = substTys tenv arg_tys\n              prov_theta' = substTheta tenv prov_theta\n              req_theta'  = substTheta tenv req_theta\n\n        ; wrap <- tcSubTypePat penv pat_ty ty'\n        ; traceTc \"tcPatSynPat\" (ppr pat_syn $$\n                                 ppr pat_ty $$\n                                 ppr ty' $$\n                                 ppr ex_tvs' $$\n                                 ppr prov_theta' $$\n                                 ppr req_theta' $$\n                                 ppr arg_tys')\n\n        ; prov_dicts' <- newEvVars prov_theta'\n\n        ; let skol_info = case pe_ctxt penv of\n                            LamPat mc -> PatSkol (PatSynCon pat_syn) mc\n                            LetPat {} -> UnkSkol -- Doesn't matter\n\n        ; req_wrap <- instCall PatOrigin (mkTyVarTys univ_tvs') req_theta'\n        ; traceTc \"instCall\" (ppr req_wrap)\n\n        ; traceTc \"checkConstraints {\" Outputable.empty\n        ; (ev_binds, (arg_pats', res))\n             <- checkConstraints skol_info ex_tvs' prov_dicts' $\n                tcConArgs (PatSynCon pat_syn) arg_tys' arg_pats penv thing_inside\n\n        ; traceTc \"checkConstraints }\" (ppr ev_binds)\n        ; let res_pat = ConPatOut { pat_con   = cL con_span $ PatSynCon pat_syn,\n                                    pat_tvs   = ex_tvs',\n                                    pat_dicts = prov_dicts',\n                                    pat_binds = ev_binds,\n                                    pat_args  = arg_pats',\n                                    pat_arg_tys = mkTyVarTys univ_tvs',\n                                    pat_wrap  = req_wrap }\n        ; pat_ty <- readExpType pat_ty\n        ; return (mkHsWrapPat wrap res_pat pat_ty, res) }\n\n----------------------------\n-- | Convenient wrapper for calling a matchExpectedXXX function\nmatchExpectedPatTy :: (TcRhoType -> TcM (TcCoercionN, a))\n                    -> PatEnv -> ExpSigmaType -> TcM (HsWrapper, a)\n-- See Note [Matching polytyped patterns]\n-- Returns a wrapper : pat_ty ~R inner_ty\nmatchExpectedPatTy inner_match (PE { pe_orig = orig }) pat_ty\n  = do { pat_ty <- expTypeToType pat_ty\n       ; (wrap, pat_rho) <- topInstantiate orig pat_ty\n       ; (co, res) <- inner_match pat_rho\n       ; traceTc \"matchExpectedPatTy\" (ppr pat_ty $$ ppr wrap)\n       ; return (mkWpCastN (mkTcSymCo co) <.> wrap, res) }\n\n----------------------------\nmatchExpectedConTy :: PatEnv\n                   -> TyCon      -- The TyCon that this data\n                                 -- constructor actually returns\n                                 -- In the case of a data family this is\n                                 -- the /representation/ TyCon\n                   -> ExpSigmaType  -- The type of the pattern; in the case\n                                    -- of a data family this would mention\n                                    -- the /family/ TyCon\n                   -> TcM (HsWrapper, [TcSigmaType])\n-- See Note [Matching constructor patterns]\n-- Returns a wrapper : pat_ty \"->\" T ty1 ... tyn\nmatchExpectedConTy (PE { pe_orig = orig }) data_tc exp_pat_ty\n  | Just (fam_tc, fam_args, co_tc) <- tyConFamInstSig_maybe data_tc\n         -- Comments refer to Note [Matching constructor patterns]\n         -- co_tc :: forall a. T [a] ~ T7 a\n  = do { pat_ty <- expTypeToType exp_pat_ty\n       ; (wrap, pat_rho) <- topInstantiate orig pat_ty\n\n       ; (subst, tvs') <- newMetaTyVars (tyConTyVars data_tc)\n             -- tys = [ty1,ty2]\n\n       ; traceTc \"matchExpectedConTy\" (vcat [ppr data_tc,\n                                             ppr (tyConTyVars data_tc),\n                                             ppr fam_tc, ppr fam_args,\n                                             ppr exp_pat_ty,\n                                             ppr pat_ty,\n                                             ppr pat_rho, ppr wrap])\n       ; co1 <- unifyType Nothing (mkTyConApp fam_tc (substTys subst fam_args)) pat_rho\n             -- co1 : T (ty1,ty2) ~N pat_rho\n             -- could use tcSubType here... but it's the wrong way round\n             -- for actual vs. expected in error messages.\n\n       ; let tys' = mkTyVarTys tvs'\n             co2 = mkTcUnbranchedAxInstCo co_tc tys' []\n             -- co2 : T (ty1,ty2) ~R T7 ty1 ty2\n\n             full_co = mkTcSubCo (mkTcSymCo co1) `mkTcTransCo` co2\n             -- full_co :: pat_rho ~R T7 ty1 ty2\n\n       ; return ( mkWpCastR full_co <.> wrap, tys') }\n\n  | otherwise\n  = do { pat_ty <- expTypeToType exp_pat_ty\n       ; (wrap, pat_rho) <- topInstantiate orig pat_ty\n       ; (coi, tys) <- matchExpectedTyConApp data_tc pat_rho\n       ; return (mkWpCastN (mkTcSymCo coi) <.> wrap, tys) }\n\n{-\nNote [Matching constructor patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose (coi, tys) = matchExpectedConType data_tc pat_ty\n\n * In the simple case, pat_ty = tc tys\n\n * If pat_ty is a polytype, we want to instantiate it\n   This is like part of a subsumption check.  Eg\n      f :: (forall a. [a]) -> blah\n      f [] = blah\n\n * In a type family case, suppose we have\n          data family T a\n          data instance T (p,q) = A p | B q\n       Then we'll have internally generated\n              data T7 p q = A p | B q\n              axiom coT7 p q :: T (p,q) ~ T7 p q\n\n       So if pat_ty = T (ty1,ty2), we return (coi, [ty1,ty2]) such that\n           coi = coi2 . coi1 : T7 t ~ pat_ty\n           coi1 : T (ty1,ty2) ~ pat_ty\n           coi2 : T7 ty1 ty2 ~ T (ty1,ty2)\n\n   For families we do all this matching here, not in the unifier,\n   because we never want a whisper of the data_tycon to appear in\n   error messages; it's a purely internal thing\n-}\n\ntcConArgs :: ConLike -> [TcSigmaType]\n          -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc)\n\ntcConArgs con_like arg_tys (PrefixCon arg_pats) penv thing_inside\n  = do  { checkTc (con_arity == no_of_args)     -- Check correct arity\n                  (arityErr (text \"constructor\") con_like con_arity no_of_args)\n        ; let pats_w_tys = zipEqual \"tcConArgs\" arg_pats arg_tys\n        ; (arg_pats', res) <- tcMultiple tcConArg pats_w_tys\n                                              penv thing_inside\n        ; return (PrefixCon arg_pats', res) }\n  where\n    con_arity  = conLikeArity con_like\n    no_of_args = length arg_pats\n\ntcConArgs con_like arg_tys (InfixCon p1 p2) penv thing_inside\n  = do  { checkTc (con_arity == 2)      -- Check correct arity\n                  (arityErr (text \"constructor\") con_like con_arity 2)\n        ; let [arg_ty1,arg_ty2] = arg_tys       -- This can't fail after the arity check\n        ; ([p1',p2'], res) <- tcMultiple tcConArg [(p1,arg_ty1),(p2,arg_ty2)]\n                                              penv thing_inside\n        ; return (InfixCon p1' p2', res) }\n  where\n    con_arity  = conLikeArity con_like\n\ntcConArgs con_like arg_tys (RecCon (HsRecFields rpats dd)) penv thing_inside\n  = do  { (rpats', res) <- tcMultiple tc_field rpats penv thing_inside\n        ; return (RecCon (HsRecFields rpats' dd), res) }\n  where\n    tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn))\n                        (LHsRecField GhcTcId (LPat GhcTcId))\n    tc_field (dL->L l (HsRecField (dL->L loc\n                                    (FieldOcc sel (dL->L lr rdr))) pat pun))\n             penv thing_inside\n      = do { sel'   <- tcLookupId sel\n           ; pat_ty <- setSrcSpan loc $ find_field_ty sel\n                                          (occNameFS $ rdrNameOcc rdr)\n           ; (pat', res) <- tcConArg (pat, pat_ty) penv thing_inside\n           ; return (cL l (HsRecField (cL loc (FieldOcc sel' (cL lr rdr))) pat'\n                                                                    pun), res) }\n    tc_field (dL->L _ (HsRecField (dL->L _ (XFieldOcc _)) _ _)) _ _\n           = panic \"tcConArgs\"\n    tc_field _ _ _ = panic \"tc_field: Impossible Match\"\n                             -- due to #15884\n\n\n    find_field_ty :: Name -> FieldLabelString -> TcM TcType\n    find_field_ty sel lbl\n        = case [ty | (fl, ty) <- field_tys, flSelector fl == sel] of\n\n                -- No matching field; chances are this field label comes from some\n                -- other record type (or maybe none).  If this happens, just fail,\n                -- otherwise we get crashes later (Trac #8570), and similar:\n                --      f (R { foo = (a,b) }) = a+b\n                -- If foo isn't one of R's fields, we don't want to crash when\n                -- typechecking the \"a+b\".\n           [] -> failWith (badFieldCon con_like lbl)\n\n                -- The normal case, when the field comes from the right constructor\n           (pat_ty : extras) -> do\n                traceTc \"find_field\" (ppr pat_ty <+> ppr extras)\n                ASSERT( null extras ) (return pat_ty)\n\n    field_tys :: [(FieldLabel, TcType)]\n    field_tys = zip (conLikeFieldLabels con_like) arg_tys\n          -- Don't use zipEqual! If the constructor isn't really a record, then\n          -- dataConFieldLabels will be empty (and each field in the pattern\n          -- will generate an error below).\n\ntcConArg :: Checker (LPat GhcRn, TcSigmaType) (LPat GhcTc)\ntcConArg (arg_pat, arg_ty) penv thing_inside\n  = tc_lpat arg_pat (mkCheckExpType arg_ty) penv thing_inside\n\naddDataConStupidTheta :: DataCon -> [TcType] -> TcM ()\n-- Instantiate the \"stupid theta\" of the data con, and throw\n-- the constraints into the constraint set\naddDataConStupidTheta data_con inst_tys\n  | null stupid_theta = return ()\n  | otherwise         = instStupidTheta origin inst_theta\n  where\n    origin = OccurrenceOf (dataConName data_con)\n        -- The origin should always report \"occurrence of C\"\n        -- even when C occurs in a pattern\n    stupid_theta = dataConStupidTheta data_con\n    univ_tvs     = dataConUnivTyVars data_con\n    tenv = zipTvSubst univ_tvs (takeList univ_tvs inst_tys)\n         -- NB: inst_tys can be longer than the univ tyvars\n         --     because the constructor might have existentials\n    inst_theta = substTheta tenv stupid_theta\n\n{-\nNote [Arrows and patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n(Oct 07) Arrow notation has the odd property that it involves\n\"holes in the scope\". For example:\n  expr :: Arrow a => a () Int\n  expr = proc (y,z) -> do\n          x <- term -< y\n          expr' -< x\n\nHere the 'proc (y,z)' binding scopes over the arrow tails but not the\narrow body (e.g 'term').  As things stand (bogusly) all the\nconstraints from the proc body are gathered together, so constraints\nfrom 'term' will be seen by the tcPat for (y,z).  But we must *not*\nbind constraints from 'term' here, because the desugarer will not make\nthese bindings scope over 'term'.\n\nThe Right Thing is not to confuse these constraints together. But for\nnow the Easy Thing is to ensure that we do not have existential or\nGADT constraints in a 'proc', and to short-cut the constraint\nsimplification for such vanilla patterns so that it binds no\nconstraints. Hence the 'fast path' in tcConPat; but it's also a good\nplan for ordinary vanilla patterns to bypass the constraint\nsimplification step.\n\n************************************************************************\n*                                                                      *\n                Note [Pattern coercions]\n*                                                                      *\n************************************************************************\n\nIn principle, these program would be reasonable:\n\n        f :: (forall a. a->a) -> Int\n        f (x :: Int->Int) = x 3\n\n        g :: (forall a. [a]) -> Bool\n        g [] = True\n\nIn both cases, the function type signature restricts what arguments can be passed\nin a call (to polymorphic ones).  The pattern type signature then instantiates this\ntype.  For example, in the first case,  (forall a. a->a) <= Int -> Int, and we\ngenerate the translated term\n        f = \\x' :: (forall a. a->a).  let x = x' Int in x 3\n\nFrom a type-system point of view, this is perfectly fine, but it's *very* seldom useful.\nAnd it requires a significant amount of code to implement, because we need to decorate\nthe translated pattern with coercion functions (generated from the subsumption check\nby tcSub).\n\nSo for now I'm just insisting on type *equality* in patterns.  No subsumption.\n\nOld notes about desugaring, at a time when pattern coercions were handled:\n\nA SigPat is a type coercion and must be handled one at at time.  We can't\ncombine them unless the type of the pattern inside is identical, and we don't\nbother to check for that.  For example:\n\n        data T = T1 Int | T2 Bool\n        f :: (forall a. a -> a) -> T -> t\n        f (g::Int->Int)   (T1 i) = T1 (g i)\n        f (g::Bool->Bool) (T2 b) = T2 (g b)\n\nWe desugar this as follows:\n\n        f = \\ g::(forall a. a->a) t::T ->\n            let gi = g Int\n            in case t of { T1 i -> T1 (gi i)\n                           other ->\n            let gb = g Bool\n            in case t of { T2 b -> T2 (gb b)\n                           other -> fail }}\n\nNote that we do not treat the first column of patterns as a\ncolumn of variables, because the coerced variables (gi, gb)\nwould be of different types.  So we get rather grotty code.\nBut I don't think this is a common case, and if it was we could\ndoubtless improve it.\n\nMeanwhile, the strategy is:\n        * treat each SigPat coercion (always non-identity coercions)\n                as a separate block\n        * deal with the stuff inside, and then wrap a binding round\n                the result to bind the new variable (gi, gb, etc)\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Errors and contexts}\n*                                                                      *\n************************************************************************\n\nNote [Existential check]\n~~~~~~~~~~~~~~~~~~~~~~~~\nLazy patterns can't bind existentials.  They arise in two ways:\n  * Let bindings      let { C a b = e } in b\n  * Twiddle patterns  f ~(C a b) = e\nThe pe_lazy field of PatEnv says whether we are inside a lazy\npattern (perhaps deeply)\n\nSee also Note [Typechecking pattern bindings] in TcBinds\n-}\n\nmaybeWrapPatCtxt :: Pat GhcRn -> (TcM a -> TcM b) -> TcM a -> TcM b\n-- Not all patterns are worth pushing a context\nmaybeWrapPatCtxt pat tcm thing_inside\n  | not (worth_wrapping pat) = tcm thing_inside\n  | otherwise                = addErrCtxt msg $ tcm $ popErrCtxt thing_inside\n                               -- Remember to pop before doing thing_inside\n  where\n   worth_wrapping (VarPat {}) = False\n   worth_wrapping (ParPat {}) = False\n   worth_wrapping (AsPat {})  = False\n   worth_wrapping _           = True\n   msg = hang (text \"In the pattern:\") 2 (ppr pat)\n\n-----------------------------------------------\ncheckExistentials :: [TyVar]   -- existentials\n                  -> [Type]    -- argument types\n                  -> PatEnv -> TcM ()\n    -- See Note [Existential check]]\n    -- See Note [Arrows and patterns]\ncheckExistentials ex_tvs tys _\n  | all (not . (`elemVarSet` tyCoVarsOfTypes tys)) ex_tvs = return ()\ncheckExistentials _ _ (PE { pe_ctxt = LetPat {}})         = return ()\ncheckExistentials _ _ (PE { pe_ctxt = LamPat ProcExpr })  = failWithTc existentialProcPat\ncheckExistentials _ _ (PE { pe_lazy = True })             = failWithTc existentialLazyPat\ncheckExistentials _ _ _                                   = return ()\n\nexistentialLazyPat :: SDoc\nexistentialLazyPat\n  = hang (text \"An existential or GADT data constructor cannot be used\")\n       2 (text \"inside a lazy (~) pattern\")\n\nexistentialProcPat :: SDoc\nexistentialProcPat\n  = text \"Proc patterns cannot use existential or GADT data constructors\"\n\nbadFieldCon :: ConLike -> FieldLabelString -> SDoc\nbadFieldCon con field\n  = hsep [text \"Constructor\" <+> quotes (ppr con),\n          text \"does not have field\", quotes (ppr field)]\n\npolyPatSig :: TcType -> SDoc\npolyPatSig sig_ty\n  = hang (text \"Illegal polymorphic type signature in pattern:\")\n       2 (ppr sig_ty)\n", "num_lines": 1194}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[TcPatSyn]{Typechecking pattern synonym declarations}\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcPatSyn ( tcPatSynDecl, tcPatSynBuilderBind\n                , tcPatSynBuilderOcc, nonBidirectionalErr\n  ) where\n\nimport GhcPrelude\n\nimport HsSyn\nimport TcPat\nimport Type( tidyTyCoVarBinders, tidyTypes, tidyType )\nimport TcRnMonad\nimport TcSigs( emptyPragEnv, completeSigFromId )\nimport TcEnv\nimport TcMType\nimport TcHsSyn\nimport TysPrim\nimport Name\nimport SrcLoc\nimport PatSyn\nimport NameSet\nimport Panic\nimport Outputable\nimport FastString\nimport Var\nimport VarEnv( emptyTidyEnv, mkInScopeSet )\nimport Id\nimport IdInfo( RecSelParent(..), setLevityInfoWithType )\nimport TcBinds\nimport BasicTypes\nimport TcSimplify\nimport TcUnify\nimport Type( PredTree(..), EqRel(..), classifyPredType )\nimport TysWiredIn\nimport TcType\nimport TcEvidence\nimport BuildTyCl\nimport VarSet\nimport MkId\nimport TcTyDecls\nimport ConLike\nimport FieldLabel\nimport Bag\nimport Util\nimport ErrUtils\nimport Data.Maybe( mapMaybe )\nimport Control.Monad ( zipWithM )\nimport Data.List( partition )\n\n#include \"HsVersions.h\"\n\n{-\n************************************************************************\n*                                                                      *\n                    Type checking a pattern synonym\n*                                                                      *\n************************************************************************\n-}\n\ntcPatSynDecl :: PatSynBind GhcRn GhcRn\n             -> Maybe TcSigInfo\n             -> TcM (LHsBinds GhcTc, TcGblEnv)\ntcPatSynDecl psb mb_sig\n  = recoverM (recoverPSB psb) $\n    case mb_sig of\n      Nothing                 -> tcInferPatSynDecl psb\n      Just (TcPatSynSig tpsi) -> tcCheckPatSynDecl psb tpsi\n      _                       -> panic \"tcPatSynDecl\"\n\nrecoverPSB :: PatSynBind GhcRn GhcRn\n           -> TcM (LHsBinds GhcTc, TcGblEnv)\n-- See Note [Pattern synonym error recovery]\nrecoverPSB (PSB { psb_id = (dL->L _ name)\n                , psb_args = details })\n = do { matcher_name <- newImplicitBinder name mkMatcherOcc\n      ; let placeholder = AConLike $ PatSynCon $\n                          mk_placeholder matcher_name\n      ; gbl_env <- tcExtendGlobalEnv [placeholder] getGblEnv\n      ; return (emptyBag, gbl_env) }\n  where\n    (_arg_names, _rec_fields, is_infix) = collectPatSynArgInfo details\n    mk_placeholder matcher_name\n      = mkPatSyn name is_infix\n                        ([mkTyVarBinder Specified alphaTyVar], []) ([], [])\n                        [] -- Arg tys\n                        alphaTy\n                        (matcher_id, True) Nothing\n                        []  -- Field labels\n       where\n         -- The matcher_id is used only by the desugarer, so actually\n         -- and error-thunk would probably do just as well here.\n         matcher_id = mkLocalId matcher_name $\n                      mkSpecForAllTys [alphaTyVar] alphaTy\n\nrecoverPSB (XPatSynBind {}) = panic \"recoverPSB\"\n\n{- Note [Pattern synonym error recovery]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf type inference for a pattern synonym fails, we can't continue with\nthe rest of tc_patsyn_finish, because we may get knock-on errors, or\neven a crash.  E.g. from\n   pattern What = True :: Maybe\nwe get a kind error; and we must stop right away (Trac #15289).\n\nWe stop if there are /any/ unsolved constraints, not just insoluble\nones; because pattern synonyms are top-level things, we will never\nsolve them later if we can't solve them now.  And if we were to carry\non, tc_patsyn_finish does zonkTcTypeToType, which defaults any\nunsolved unificatdion variables to Any, which confuses the error\nreporting no end (Trac #15685).\n\nSo we use simplifyTop to completely solve the constraint, report\nany errors, throw an exception.\n\nEven in the event of such an error we can recover and carry on, just\nas we do for value bindings, provided we plug in placeholder for the\npattern synonym: see recoverPSB.  The goal of the placeholder is not\nto cause a raft of follow-on errors.  I've used the simplest thing for\nnow, but we might need to elaborate it a bit later.  (e.g.  I've given\nit zero args, which may cause knock-on errors if it is used in a\npattern.) But it'll do for now.\n\n-}\n\ntcInferPatSynDecl :: PatSynBind GhcRn GhcRn\n                  -> TcM (LHsBinds GhcTc, TcGblEnv)\ntcInferPatSynDecl (PSB { psb_id = lname@(dL->L _ name), psb_args = details\n                       , psb_def = lpat, psb_dir = dir })\n  = addPatSynCtxt lname $\n    do { traceTc \"tcInferPatSynDecl {\" $ ppr name\n\n       ; let (arg_names, rec_fields, is_infix) = collectPatSynArgInfo details\n       ; (tclvl, wanted, ((lpat', args), pat_ty))\n            <- pushLevelAndCaptureConstraints  $\n               tcInferNoInst                   $ \\ exp_ty ->\n               tcPat PatSyn lpat exp_ty        $\n               mapM tcLookupId arg_names\n\n       ; let (ex_tvs, prov_dicts) = tcCollectEx lpat'\n\n             named_taus = (name, pat_ty) : map mk_named_tau args\n             mk_named_tau arg\n               = (getName arg, mkSpecForAllTys ex_tvs (varType arg))\n               -- The mkSpecForAllTys is important (Trac #14552), albeit\n               -- slightly artifical (there is no variable with this funny type).\n               -- We do not want to quantify over variable (alpha::k)\n               -- that mention the existentially-bound type variables\n               -- ex_tvs in its kind k.\n               -- See Note [Type variables whose kind is captured]\n\n       ; (univ_tvs, req_dicts, ev_binds, residual, _)\n               <- simplifyInfer tclvl NoRestrictions [] named_taus wanted\n       ; top_ev_binds <- checkNoErrs (simplifyTop residual)\n       ; addTopEvBinds top_ev_binds $\n\n    do { prov_dicts <- mapM zonkId prov_dicts\n       ; let filtered_prov_dicts = mkMinimalBySCs evVarPred prov_dicts\n             -- Filtering: see Note [Remove redundant provided dicts]\n             (prov_theta, prov_evs)\n                 = unzip (mapMaybe mkProvEvidence filtered_prov_dicts)\n             req_theta = map evVarPred req_dicts\n\n       -- Report coercions that esacpe\n       -- See Note [Coercions that escape]\n       ; args <- mapM zonkId args\n       ; let bad_args = [ (arg, bad_cos) | arg <- args ++ prov_dicts\n                              , let bad_cos = filterDVarSet isId $\n                                              (tyCoVarsOfTypeDSet (idType arg))\n                              , not (isEmptyDVarSet bad_cos) ]\n       ; mapM_ dependentArgErr bad_args\n\n       ; traceTc \"tcInferPatSynDecl }\" $ (ppr name $$ ppr ex_tvs)\n       ; tc_patsyn_finish lname dir is_infix lpat'\n                          (mkTyVarBinders Inferred univ_tvs\n                            , req_theta,  ev_binds, req_dicts)\n                          (mkTyVarBinders Inferred ex_tvs\n                            , mkTyVarTys ex_tvs, prov_theta, prov_evs)\n                          (map nlHsVar args, map idType args)\n                          pat_ty rec_fields } }\ntcInferPatSynDecl (XPatSynBind _) = panic \"tcInferPatSynDecl\"\n\nmkProvEvidence :: EvId -> Maybe (PredType, EvTerm)\n-- See Note [Equality evidence in pattern synonyms]\nmkProvEvidence ev_id\n  | EqPred r ty1 ty2 <- classifyPredType pred\n  , let k1 = tcTypeKind ty1\n        k2 = tcTypeKind ty2\n        is_homo = k1 `tcEqType` k2\n        homo_tys   = [k1, ty1, ty2]\n        hetero_tys = [k1, k2, ty1, ty2]\n  = case r of\n      ReprEq | is_homo\n             -> Just ( mkClassPred coercibleClass    homo_tys\n                     , evDataConApp coercibleDataCon homo_tys eq_con_args )\n             | otherwise -> Nothing\n      NomEq  | is_homo\n             -> Just ( mkClassPred eqClass    homo_tys\n                     , evDataConApp eqDataCon homo_tys eq_con_args )\n             | otherwise\n             -> Just ( mkClassPred heqClass    hetero_tys\n                     , evDataConApp heqDataCon hetero_tys eq_con_args )\n\n  | otherwise\n  = Just (pred, EvExpr (evId ev_id))\n  where\n    pred = evVarPred ev_id\n    eq_con_args = [evId ev_id]\n\ndependentArgErr :: (Id, DTyCoVarSet) -> TcM ()\n-- See Note [Coercions that escape]\ndependentArgErr (arg, bad_cos)\n  = addErrTc $\n    vcat [ text \"Iceland Jack!  Iceland Jack! Stop torturing me!\"\n         , hang (text \"Pattern-bound variable\")\n              2 (ppr arg <+> dcolon <+> ppr (idType arg))\n         , nest 2 $\n           hang (text \"has a type that mentions pattern-bound coercion\"\n                 <> plural bad_co_list <> colon)\n              2 (pprWithCommas ppr bad_co_list)\n         , text \"Hint: use -fprint-explicit-coercions to see the coercions\"\n         , text \"Probable fix: add a pattern signature\" ]\n  where\n    bad_co_list = dVarSetElems bad_cos\n\n{- Note [Type variables whose kind is captured]\n~~-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data AST a = Sym [a]\n  class Prj s where { prj :: [a] -> Maybe (s a)\n  pattern P x <= Sym (prj -> Just x)\n\nHere we get a matcher with this type\n  $mP :: forall s a. Prj s => AST a -> (s a -> r) -> r -> r\n\nNo problem.  But note that 's' is not fixed by the type of the\npattern (AST a), nor is it existentially bound.  It's really only\nfixed by the type of the continuation.\n\nTrac #14552 showed that this can go wrong if the kind of 's' mentions\nexistentially bound variables.  We obviously can't make a type like\n  $mP :: forall (s::k->*) a. Prj s => AST a -> (forall k. s a -> r)\n                                   -> r -> r\nBut neither is 's' itself existentially bound, so the forall (s::k->*)\ncan't go in the inner forall either.  (What would the matcher apply\nthe continuation to?)\n\nSolution: do not quantiify over any unification variable whose kind\nmentions the existentials.  We can conveniently do that by making the\n\"taus\" passed to simplifyInfer look like\n   forall ex_tvs. arg_ty\n\nAfter that, Note [Naughty quantification candidates] in TcMType takes\nover, and zonks any such naughty variables to Any.\n\nNote [Remove redundant provided dicts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRecall that\n   HRefl :: forall k1 k2 (a1:k1) (a2:k2). (k1 ~ k2, a1 ~ a2)\n                                       => a1 :~~: a2\n(NB: technically the (k1~k2) existential dictionary is not necessary,\nbut it's there at the moment.)\n\nNow consider (Trac #14394):\n   pattern Foo = HRefl\nin a non-poly-kinded module.  We don't want to get\n    pattern Foo :: () => (* ~ *, b ~ a) => a :~~: b\nwith that redundant (* ~ *).  We'd like to remove it; hence the call to\nmkMinimalWithSCs.\n\nSimilarly consider\n  data S a where { MkS :: Ord a => a -> S a }\n  pattern Bam x y <- (MkS (x::a), MkS (y::a)))\n\nThe pattern (Bam x y) binds two (Ord a) dictionaries, but we only\nneed one.  Agian mkMimimalWithSCs removes the redundant one.\n\nNote [Equality evidence in pattern synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data X a where\n     MkX :: Eq a => [a] -> X (Maybe a)\n  pattern P x = MkG x\n\nThen there is a danger that GHC will infer\n  P :: forall a.  () =>\n       forall b. (a ~# Maybe b, Eq b) => [b] -> X a\n\nThe 'builder' for P, which is called in user-code, will then\nhave type\n  $bP :: forall a b. (a ~# Maybe b, Eq b) => [b] -> X a\n\nand that is bad because (a ~# Maybe b) is not a predicate type\n(see Note [Types for coercions, predicates, and evidence] in Type)\nand is not implicitly instantiated.\n\nSo in mkProvEvidence we lift (a ~# b) to (a ~ b).  Tiresome, and\nmarginally less efficient, if the builder/martcher are not inlined.\n\nSee also Note [Lift equality constaints when quantifying] in TcType\n\nNote [Coercions that escape]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTrac #14507 showed an example where the inferred type of the matcher\nfor the pattern synonym was somethign like\n   $mSO :: forall (r :: TYPE rep) kk (a :: k).\n           TypeRep k a\n           -> ((Bool ~ k) => TypeRep Bool (a |> co_a2sv) -> r)\n           -> (Void# -> r)\n           -> r\n\nWhat is that co_a2sv :: Bool ~# *??  It was bound (via a superclass\nselection) by the pattern being matched; and indeed it is implicit in\nthe context (Bool ~ k).  You could imagine trying to extract it like\nthis:\n   $mSO :: forall (r :: TYPE rep) kk (a :: k).\n           TypeRep k a\n           -> ( co :: ((Bool :: *) ~ (k :: *)) =>\n                  let co_a2sv = sc_sel co\n                  in TypeRep Bool (a |> co_a2sv) -> r)\n           -> (Void# -> r)\n           -> r\n\nBut we simply don't allow that in types.  Maybe one day but not now.\n\nHow to detect this situation?  We just look for free coercion variables\nin the types of any of the arguments to the matcher.  The error message\nis not very helpful, but at least we don't get a Lint error.\n-}\n\ntcCheckPatSynDecl :: PatSynBind GhcRn GhcRn\n                  -> TcPatSynInfo\n                  -> TcM (LHsBinds GhcTc, TcGblEnv)\ntcCheckPatSynDecl psb@PSB{ psb_id = lname@(dL->L _ name), psb_args = details\n                         , psb_def = lpat, psb_dir = dir }\n                  TPSI{ patsig_implicit_bndrs = implicit_tvs\n                      , patsig_univ_bndrs = explicit_univ_tvs, patsig_prov = prov_theta\n                      , patsig_ex_bndrs   = explicit_ex_tvs,   patsig_req  = req_theta\n                      , patsig_body_ty    = sig_body_ty }\n  = addPatSynCtxt lname $\n    do { let decl_arity = length arg_names\n             (arg_names, rec_fields, is_infix) = collectPatSynArgInfo details\n\n       ; traceTc \"tcCheckPatSynDecl\" $\n         vcat [ ppr implicit_tvs, ppr explicit_univ_tvs, ppr req_theta\n              , ppr explicit_ex_tvs, ppr prov_theta, ppr sig_body_ty ]\n\n       ; (arg_tys, pat_ty) <- case tcSplitFunTysN decl_arity sig_body_ty of\n                                 Right stuff  -> return stuff\n                                 Left missing -> wrongNumberOfParmsErr name decl_arity missing\n\n       -- Complain about:  pattern P :: () => forall x. x -> P x\n       -- The existential 'x' should not appear in the result type\n       -- Can't check this until we know P's arity\n       ; let bad_tvs = filter (`elemVarSet` tyCoVarsOfType pat_ty) explicit_ex_tvs\n       ; checkTc (null bad_tvs) $\n         hang (sep [ text \"The result type of the signature for\" <+> quotes (ppr name) <> comma\n                   , text \"namely\" <+> quotes (ppr pat_ty) ])\n            2 (text \"mentions existential type variable\" <> plural bad_tvs\n               <+> pprQuotedList bad_tvs)\n\n         -- See Note [The pattern-synonym signature splitting rule] in TcSigs\n       ; let univ_fvs = closeOverKinds $\n                        (tyCoVarsOfTypes (pat_ty : req_theta) `extendVarSetList` explicit_univ_tvs)\n             (extra_univ, extra_ex) = partition ((`elemVarSet` univ_fvs) . binderVar) implicit_tvs\n             univ_bndrs = extra_univ ++ mkTyVarBinders Specified explicit_univ_tvs\n             ex_bndrs   = extra_ex   ++ mkTyVarBinders Specified explicit_ex_tvs\n             univ_tvs   = binderVars univ_bndrs\n             ex_tvs     = binderVars ex_bndrs\n\n       -- Right!  Let's check the pattern against the signature\n       -- See Note [Checking against a pattern signature]\n       ; req_dicts <- newEvVars req_theta\n       ; (tclvl, wanted, (lpat', (ex_tvs', prov_dicts, args'))) <-\n           ASSERT2( equalLength arg_names arg_tys, ppr name $$ ppr arg_names $$ ppr arg_tys )\n           pushLevelAndCaptureConstraints            $\n           tcExtendTyVarEnv univ_tvs                 $\n           tcPat PatSyn lpat (mkCheckExpType pat_ty) $\n           do { let in_scope    = mkInScopeSet (mkVarSet univ_tvs)\n                    empty_subst = mkEmptyTCvSubst in_scope\n              ; (subst, ex_tvs') <- mapAccumLM newMetaTyVarX empty_subst ex_tvs\n                    -- newMetaTyVarX: see the \"Existential type variables\"\n                    -- part of Note [Checking against a pattern signature]\n              ; traceTc \"tcpatsyn1\" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs])\n              ; traceTc \"tcpatsyn2\" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs'])\n              ; let prov_theta' = substTheta subst prov_theta\n                  -- Add univ_tvs to the in_scope set to\n                  -- satisfy the substitution invariant. There's no need to\n                  -- add 'ex_tvs' as they are already in the domain of the\n                  -- substitution.\n                  -- See also Note [The substitution invariant] in TyCoRep.\n              ; prov_dicts <- mapM (emitWanted (ProvCtxtOrigin psb)) prov_theta'\n              ; args'      <- zipWithM (tc_arg subst) arg_names arg_tys\n              ; return (ex_tvs', prov_dicts, args') }\n\n       ; let skol_info = SigSkol (PatSynCtxt name) pat_ty []\n                         -- The type here is a bit bogus, but we do not print\n                         -- the type for PatSynCtxt, so it doesn't matter\n                         -- See TcRnTypes Note [Skolem info for pattern synonyms]\n       ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info univ_tvs req_dicts wanted\n\n       -- Solve the constraints now, because we are about to make a PatSyn,\n       -- which should not contain unification variables and the like (Trac #10997)\n       ; simplifyTopImplic implics\n\n       -- ToDo: in the bidirectional case, check that the ex_tvs' are all distinct\n       -- Otherwise we may get a type error when typechecking the builder,\n       -- when that should be impossible\n\n       ; traceTc \"tcCheckPatSynDecl }\" $ ppr name\n       ; tc_patsyn_finish lname dir is_infix lpat'\n                          (univ_bndrs, req_theta, ev_binds, req_dicts)\n                          (ex_bndrs, mkTyVarTys ex_tvs', prov_theta, prov_dicts)\n                          (args', arg_tys)\n                          pat_ty rec_fields }\n  where\n    tc_arg :: TCvSubst -> Name -> Type -> TcM (LHsExpr GhcTcId)\n    tc_arg subst arg_name arg_ty\n      = do {   -- Look up the variable actually bound by lpat\n               -- and check that it has the expected type\n             arg_id <- tcLookupId arg_name\n           ; wrap <- tcSubType_NC GenSigCtxt\n                                 (idType arg_id)\n                                 (substTyUnchecked subst arg_ty)\n                -- Why do we need tcSubType here?\n                -- See Note [Pattern synonyms and higher rank types]\n           ; return (mkLHsWrap wrap $ nlHsVar arg_id) }\ntcCheckPatSynDecl (XPatSynBind _) _ = panic \"tcCheckPatSynDecl\"\n\n{- [Pattern synonyms and higher rank types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data T = MkT (forall a. a->a)\n\n  pattern P :: (Int -> Int) -> T\n  pattern P x <- MkT x\n\nThis should work.  But in the matcher we must match against MkT, and then\ninstantiate its argument 'x', to get a function of type (Int -> Int).\nEquality is not enough!  Trac #13752 was an example.\n\n\nNote [The pattern-synonym signature splitting rule]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven a pattern signature, we must split\n     the kind-generalised variables, and\n     the implicitly-bound variables\ninto universal and existential.  The rule is this\n(see discussion on Trac #11224):\n\n     The universal tyvars are the ones mentioned in\n          - univ_tvs: the user-specified (forall'd) universals\n          - req_theta\n          - res_ty\n     The existential tyvars are all the rest\n\nFor example\n\n   pattern P :: () => b -> T a\n   pattern P x = ...\n\nHere 'a' is universal, and 'b' is existential.  But there is a wrinkle:\nhow do we split the arg_tys from req_ty?  Consider\n\n   pattern Q :: () => b -> S c -> T a\n   pattern Q x = ...\n\nThis is an odd example because Q has only one syntactic argument, and\nso presumably is defined by a view pattern matching a function.  But\nit can happen (Trac #11977, #12108).\n\nWe don't know Q's arity from the pattern signature, so we have to wait\nuntil we see the pattern declaration itself before deciding res_ty is,\nand hence which variables are existential and which are universal.\n\nAnd that in turn is why TcPatSynInfo has a separate field,\npatsig_implicit_bndrs, to capture the implicitly bound type variables,\nbecause we don't yet know how to split them up.\n\nIt's a slight compromise, because it means we don't really know the\npattern synonym's real signature until we see its declaration.  So,\nfor example, in hs-boot file, we may need to think what to do...\n(eg don't have any implicitly-bound variables).\n\n\nNote [Checking against a pattern signature]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen checking the actual supplied pattern against the pattern synonym\nsignature, we need to be quite careful.\n\n----- Provided constraints\nExample\n\n    data T a where\n      MkT :: Ord a => a -> T a\n\n    pattern P :: () => Eq a => a -> [T a]\n    pattern P x = [MkT x]\n\nWe must check that the (Eq a) that P claims to bind (and to\nmake available to matches against P), is derivable from the\nactual pattern.  For example:\n    f (P (x::a)) = ...here (Eq a) should be available...\nAnd yes, (Eq a) is derivable from the (Ord a) bound by P's rhs.\n\n----- Existential type variables\nUnusually, we instantiate the existential tyvars of the pattern with\n*meta* type variables.  For example\n\n    data S where\n      MkS :: Eq a => [a] -> S\n\n    pattern P :: () => Eq x => x -> S\n    pattern P x <- MkS x\n\nThe pattern synonym conceals from its client the fact that MkS has a\nlist inside it.  The client just thinks it's a type 'x'.  So we must\nunify x := [a] during type checking, and then use the instantiating type\n[a] (called ex_tys) when building the matcher.  In this case we'll get\n\n   $mP :: S -> (forall x. Ex x => x -> r) -> r -> r\n   $mP x k = case x of\n               MkS a (d:Eq a) (ys:[a]) -> let dl :: Eq [a]\n                                              dl = $dfunEqList d\n                                          in k [a] dl ys\n\nAll this applies when type-checking the /matching/ side of\na pattern synonym.  What about the /building/ side?\n\n* For Unidirectional, there is no builder\n\n* For ExplicitBidirectional, the builder is completely separate\n  code, typechecked in tcPatSynBuilderBind\n\n* For ImplicitBidirectional, the builder is still typechecked in\n  tcPatSynBuilderBind, by converting the pattern to an expression and\n  typechecking it.\n\n  At one point, for ImplicitBidirectional I used TyVarTvs (instead of\n  TauTvs) in tcCheckPatSynDecl.  But (a) strengthening the check here\n  is redundant since tcPatSynBuilderBind does the job, (b) it was\n  still incomplete (TyVarTvs can unify with each other), and (c) it\n  didn't even work (Trac #13441 was accepted with\n  ExplicitBidirectional, but rejected if expressed in\n  ImplicitBidirectional form.  Conclusion: trying to be too clever is\n  a bad idea.\n-}\n\ncollectPatSynArgInfo :: HsPatSynDetails (Located Name)\n                     -> ([Name], [Name], Bool)\ncollectPatSynArgInfo details =\n  case details of\n    PrefixCon names      -> (map unLoc names, [], False)\n    InfixCon name1 name2 -> (map unLoc [name1, name2], [], True)\n    RecCon names         -> (vars, sels, False)\n                         where\n                            (vars, sels) = unzip (map splitRecordPatSyn names)\n  where\n    splitRecordPatSyn :: RecordPatSynField (Located Name)\n                      -> (Name, Name)\n    splitRecordPatSyn (RecordPatSynField\n                       { recordPatSynPatVar     = (dL->L _ patVar)\n                       , recordPatSynSelectorId = (dL->L _ selId) })\n      = (patVar, selId)\n\naddPatSynCtxt :: Located Name -> TcM a -> TcM a\naddPatSynCtxt (dL->L loc name) thing_inside\n  = setSrcSpan loc $\n    addErrCtxt (text \"In the declaration for pattern synonym\"\n                <+> quotes (ppr name)) $\n    thing_inside\n\nwrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a\nwrongNumberOfParmsErr name decl_arity missing\n  = failWithTc $\n    hang (text \"Pattern synonym\" <+> quotes (ppr name) <+> ptext (sLit \"has\")\n          <+> speakNOf decl_arity (text \"argument\"))\n       2 (text \"but its type signature has\" <+> int missing <+> text \"fewer arrows\")\n\n-------------------------\n-- Shared by both tcInferPatSyn and tcCheckPatSyn\ntc_patsyn_finish :: Located Name      -- ^ PatSyn Name\n                 -> HsPatSynDir GhcRn -- ^ PatSyn type (Uni/Bidir/ExplicitBidir)\n                 -> Bool              -- ^ Whether infix\n                 -> LPat GhcTc        -- ^ Pattern of the PatSyn\n                 -> ([TcTyVarBinder], [PredType], TcEvBinds, [EvVar])\n                 -> ([TcTyVarBinder], [TcType], [PredType], [EvTerm])\n                 -> ([LHsExpr GhcTcId], [TcType])   -- ^ Pattern arguments and\n                                                    -- types\n                 -> TcType            -- ^ Pattern type\n                 -> [Name]            -- ^ Selector names\n                 -- ^ Whether fields, empty if not record PatSyn\n                 -> TcM (LHsBinds GhcTc, TcGblEnv)\ntc_patsyn_finish lname dir is_infix lpat'\n                 (univ_tvs, req_theta, req_ev_binds, req_dicts)\n                 (ex_tvs,   ex_tys,    prov_theta,   prov_dicts)\n                 (args, arg_tys)\n                 pat_ty field_labels\n  = do { -- Zonk everything.  We are about to build a final PatSyn\n         -- so there had better be no unification variables in there\n\n         (ze, univ_tvs') <- zonkTyVarBinders univ_tvs\n       ; req_theta'      <- zonkTcTypesToTypesX ze req_theta\n       ; (ze, ex_tvs')   <- zonkTyVarBindersX ze ex_tvs\n       ; prov_theta'     <- zonkTcTypesToTypesX ze prov_theta\n       ; pat_ty'         <- zonkTcTypeToTypeX ze pat_ty\n       ; arg_tys'        <- zonkTcTypesToTypesX ze arg_tys\n\n       ; let (env1, univ_tvs) = tidyTyCoVarBinders emptyTidyEnv univ_tvs'\n             (env2, ex_tvs)   = tidyTyCoVarBinders env1 ex_tvs'\n             req_theta  = tidyTypes env2 req_theta'\n             prov_theta = tidyTypes env2 prov_theta'\n             arg_tys    = tidyTypes env2 arg_tys'\n             pat_ty     = tidyType  env2 pat_ty'\n\n       ; traceTc \"tc_patsyn_finish {\" $\n           ppr (unLoc lname) $$ ppr (unLoc lpat') $$\n           ppr (univ_tvs, req_theta, req_ev_binds, req_dicts) $$\n           ppr (ex_tvs, prov_theta, prov_dicts) $$\n           ppr args $$\n           ppr arg_tys $$\n           ppr pat_ty\n\n       -- Make the 'matcher'\n       ; (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat'\n                                         (binderVars univ_tvs, req_theta, req_ev_binds, req_dicts)\n                                         (binderVars ex_tvs, ex_tys, prov_theta, prov_dicts)\n                                         (args, arg_tys)\n                                         pat_ty\n\n       -- Make the 'builder'\n       ; builder_id <- mkPatSynBuilderId dir lname\n                                         univ_tvs req_theta\n                                         ex_tvs   prov_theta\n                                         arg_tys pat_ty\n\n         -- TODO: Make this have the proper information\n       ; let mkFieldLabel name = FieldLabel { flLabel = occNameFS (nameOccName name)\n                                            , flIsOverloaded = False\n                                            , flSelector = name }\n             field_labels' = map mkFieldLabel field_labels\n\n\n       -- Make the PatSyn itself\n       ; let patSyn = mkPatSyn (unLoc lname) is_infix\n                        (univ_tvs, req_theta)\n                        (ex_tvs, prov_theta)\n                        arg_tys\n                        pat_ty\n                        matcher_id builder_id\n                        field_labels'\n\n       -- Selectors\n       ; let rn_rec_sel_binds = mkPatSynRecSelBinds patSyn (patSynFieldLabels patSyn)\n             tything = AConLike (PatSynCon patSyn)\n       ; tcg_env <- tcExtendGlobalEnv [tything] $\n                    tcRecSelBinds rn_rec_sel_binds\n\n       ; traceTc \"tc_patsyn_finish }\" empty\n       ; return (matcher_bind, tcg_env) }\n\n{-\n************************************************************************\n*                                                                      *\n         Constructing the \"matcher\" Id and its binding\n*                                                                      *\n************************************************************************\n-}\n\ntcPatSynMatcher :: Located Name\n                -> LPat GhcTc\n                -> ([TcTyVar], ThetaType, TcEvBinds, [EvVar])\n                -> ([TcTyVar], [TcType], ThetaType, [EvTerm])\n                -> ([LHsExpr GhcTcId], [TcType])\n                -> TcType\n                -> TcM ((Id, Bool), LHsBinds GhcTc)\n-- See Note [Matchers and builders for pattern synonyms] in PatSyn\ntcPatSynMatcher (dL->L loc name) lpat\n                (univ_tvs, req_theta, req_ev_binds, req_dicts)\n                (ex_tvs, ex_tys, prov_theta, prov_dicts)\n                (args, arg_tys) pat_ty\n  = do { rr_name <- newNameAt (mkTyVarOcc \"rep\") loc\n       ; tv_name <- newNameAt (mkTyVarOcc \"r\")   loc\n       ; let rr_tv  = mkTyVar rr_name runtimeRepTy\n             rr     = mkTyVarTy rr_tv\n             res_tv = mkTyVar tv_name (tYPE rr)\n             res_ty = mkTyVarTy res_tv\n             is_unlifted = null args && null prov_dicts\n             (cont_args, cont_arg_tys)\n               | is_unlifted = ([nlHsVar voidPrimId], [voidPrimTy])\n               | otherwise   = (args,                 arg_tys)\n             cont_ty = mkInfSigmaTy ex_tvs prov_theta $\n                       mkVisFunTys cont_arg_tys res_ty\n\n             fail_ty  = mkVisFunTy voidPrimTy res_ty\n\n       ; matcher_name <- newImplicitBinder name mkMatcherOcc\n       ; scrutinee    <- newSysLocalId (fsLit \"scrut\") pat_ty\n       ; cont         <- newSysLocalId (fsLit \"cont\")  cont_ty\n       ; fail         <- newSysLocalId (fsLit \"fail\")  fail_ty\n\n       ; let matcher_tau   = mkVisFunTys [pat_ty, cont_ty, fail_ty] res_ty\n             matcher_sigma = mkInfSigmaTy (rr_tv:res_tv:univ_tvs) req_theta matcher_tau\n             matcher_id    = mkExportedVanillaId matcher_name matcher_sigma\n                             -- See Note [Exported LocalIds] in Id\n\n             inst_wrap = mkWpEvApps prov_dicts <.> mkWpTyApps ex_tys\n             cont' = foldl' nlHsApp (mkLHsWrap inst_wrap (nlHsVar cont)) cont_args\n\n             fail' = nlHsApps fail [nlHsVar voidPrimId]\n\n             args = map nlVarPat [scrutinee, cont, fail]\n             lwpat = noLoc $ WildPat pat_ty\n             cases = if isIrrefutableHsPat lpat\n                     then [mkHsCaseAlt lpat  cont']\n                     else [mkHsCaseAlt lpat  cont',\n                           mkHsCaseAlt lwpat fail']\n             body = mkLHsWrap (mkWpLet req_ev_binds) $\n                    cL (getLoc lpat) $\n                    HsCase noExt (nlHsVar scrutinee) $\n                    MG{ mg_alts = cL (getLoc lpat) cases\n                      , mg_ext = MatchGroupTc [pat_ty] res_ty\n                      , mg_origin = Generated\n                      }\n             body' = noLoc $\n                     HsLam noExt $\n                     MG{ mg_alts = noLoc [mkSimpleMatch LambdaExpr\n                                                        args body]\n                       , mg_ext = MatchGroupTc [pat_ty, cont_ty, fail_ty] res_ty\n                       , mg_origin = Generated\n                       }\n             match = mkMatch (mkPrefixFunRhs (cL loc name)) []\n                             (mkHsLams (rr_tv:res_tv:univ_tvs)\n                                       req_dicts body')\n                             (noLoc (EmptyLocalBinds noExt))\n             mg :: MatchGroup GhcTc (LHsExpr GhcTc)\n             mg = MG{ mg_alts = cL (getLoc match) [match]\n                    , mg_ext = MatchGroupTc [] res_ty\n                    , mg_origin = Generated\n                    }\n\n       ; let bind = FunBind{ fun_ext = emptyNameSet\n                           , fun_id = cL loc matcher_id\n                           , fun_matches = mg\n                           , fun_co_fn = idHsWrapper\n                           , fun_tick = [] }\n             matcher_bind = unitBag (noLoc bind)\n\n       ; traceTc \"tcPatSynMatcher\" (ppr name $$ ppr (idType matcher_id))\n       ; traceTc \"tcPatSynMatcher\" (ppr matcher_bind)\n\n       ; return ((matcher_id, is_unlifted), matcher_bind) }\n\nmkPatSynRecSelBinds :: PatSyn\n                    -> [FieldLabel]  -- ^ Visible field labels\n                    -> [(Id, LHsBind GhcRn)]\nmkPatSynRecSelBinds ps fields\n  = [ mkOneRecordSelector [PatSynCon ps] (RecSelPatSyn ps) fld_lbl\n    | fld_lbl <- fields ]\n\nisUnidirectional :: HsPatSynDir a -> Bool\nisUnidirectional Unidirectional          = True\nisUnidirectional ImplicitBidirectional   = False\nisUnidirectional ExplicitBidirectional{} = False\n\n{-\n************************************************************************\n*                                                                      *\n         Constructing the \"builder\" Id\n*                                                                      *\n************************************************************************\n-}\n\nmkPatSynBuilderId :: HsPatSynDir a -> Located Name\n                  -> [TyVarBinder] -> ThetaType\n                  -> [TyVarBinder] -> ThetaType\n                  -> [Type] -> Type\n                  -> TcM (Maybe (Id, Bool))\nmkPatSynBuilderId dir (dL->L _ name)\n                  univ_bndrs req_theta ex_bndrs prov_theta\n                  arg_tys pat_ty\n  | isUnidirectional dir\n  = return Nothing\n  | otherwise\n  = do { builder_name <- newImplicitBinder name mkBuilderOcc\n       ; let theta          = req_theta ++ prov_theta\n             need_dummy_arg = isUnliftedType pat_ty && null arg_tys && null theta\n             builder_sigma  = add_void need_dummy_arg $\n                              mkForAllTys univ_bndrs $\n                              mkForAllTys ex_bndrs $\n                              mkPhiTy theta $\n                              mkVisFunTys arg_tys $\n                              pat_ty\n             builder_id     = mkExportedVanillaId builder_name builder_sigma\n              -- See Note [Exported LocalIds] in Id\n\n             builder_id'    = modifyIdInfo (`setLevityInfoWithType` pat_ty) builder_id\n\n       ; return (Just (builder_id', need_dummy_arg)) }\n  where\n\ntcPatSynBuilderBind :: PatSynBind GhcRn GhcRn\n                    -> TcM (LHsBinds GhcTc)\n-- See Note [Matchers and builders for pattern synonyms] in PatSyn\ntcPatSynBuilderBind (PSB { psb_id = (dL->L loc name)\n                         , psb_def = lpat\n                         , psb_dir = dir\n                         , psb_args = details })\n  | isUnidirectional dir\n  = return emptyBag\n\n  | Left why <- mb_match_group       -- Can't invert the pattern\n  = setSrcSpan (getLoc lpat) $ failWithTc $\n    vcat [ hang (text \"Invalid right-hand side of bidirectional pattern synonym\"\n                 <+> quotes (ppr name) <> colon)\n              2 why\n         , text \"RHS pattern:\" <+> ppr lpat ]\n\n  | Right match_group <- mb_match_group  -- Bidirectional\n  = do { patsyn <- tcLookupPatSyn name\n       ; case patSynBuilder patsyn of {\n           Nothing -> return emptyBag ;\n             -- This case happens if we found a type error in the\n             -- pattern synonym, recovered, and put a placeholder\n             -- with patSynBuilder=Nothing in the environment\n\n           Just (builder_id, need_dummy_arg) ->  -- Normal case\n    do { -- Bidirectional, so patSynBuilder returns Just\n         let match_group' | need_dummy_arg = add_dummy_arg match_group\n                          | otherwise      = match_group\n\n             bind = FunBind { fun_ext = placeHolderNamesTc\n                            , fun_id      = cL loc (idName builder_id)\n                            , fun_matches = match_group'\n                            , fun_co_fn   = idHsWrapper\n                            , fun_tick    = [] }\n\n             sig = completeSigFromId (PatSynCtxt name) builder_id\n\n       ; traceTc \"tcPatSynBuilderBind {\" $\n         ppr patsyn $$ ppr builder_id <+> dcolon <+> ppr (idType builder_id)\n       ; (builder_binds, _) <- tcPolyCheck emptyPragEnv sig (noLoc bind)\n       ; traceTc \"tcPatSynBuilderBind }\" $ ppr builder_binds\n       ; return builder_binds } } }\n\n  | otherwise = panic \"tcPatSynBuilderBind\"  -- Both cases dealt with\n  where\n    mb_match_group\n       = case dir of\n           ExplicitBidirectional explicit_mg -> Right explicit_mg\n           ImplicitBidirectional -> fmap mk_mg (tcPatToExpr name args lpat)\n           Unidirectional -> panic \"tcPatSynBuilderBind\"\n\n    mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)\n    mk_mg body = mkMatchGroup Generated [builder_match]\n          where\n            builder_args  = [cL loc (VarPat noExt (cL loc n))\n                            | (dL->L loc n) <- args]\n            builder_match = mkMatch (mkPrefixFunRhs (cL loc name))\n                                    builder_args body\n                                    (noLoc (EmptyLocalBinds noExt))\n\n    args = case details of\n              PrefixCon args     -> args\n              InfixCon arg1 arg2 -> [arg1, arg2]\n              RecCon args        -> map recordPatSynPatVar args\n\n    add_dummy_arg :: MatchGroup GhcRn (LHsExpr GhcRn)\n                  -> MatchGroup GhcRn (LHsExpr GhcRn)\n    add_dummy_arg mg@(MG { mg_alts =\n                           (dL->L l [dL->L loc\n                                           match@(Match { m_pats = pats })]) })\n      = mg { mg_alts = cL l [cL loc (match { m_pats = nlWildPatName : pats })] }\n    add_dummy_arg other_mg = pprPanic \"add_dummy_arg\" $\n                             pprMatches other_mg\ntcPatSynBuilderBind (XPatSynBind _) = panic \"tcPatSynBuilderBind\"\n\ntcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTcId, TcSigmaType)\n-- monadic only for failure\ntcPatSynBuilderOcc ps\n  | Just (builder_id, add_void_arg) <- builder\n  , let builder_expr = HsConLikeOut noExt (PatSynCon ps)\n        builder_ty   = idType builder_id\n  = return $\n    if add_void_arg\n    then ( builder_expr   -- still just return builder_expr; the void# arg is added\n                          -- by dsConLike in the desugarer\n         , tcFunResultTy builder_ty )\n    else (builder_expr, builder_ty)\n\n  | otherwise  -- Unidirectional\n  = nonBidirectionalErr name\n  where\n    name    = patSynName ps\n    builder = patSynBuilder ps\n\nadd_void :: Bool -> Type -> Type\nadd_void need_dummy_arg ty\n  | need_dummy_arg = mkVisFunTy voidPrimTy ty\n  | otherwise      = ty\n\ntcPatToExpr :: Name -> [Located Name] -> LPat GhcRn\n            -> Either MsgDoc (LHsExpr GhcRn)\n-- Given a /pattern/, return an /expression/ that builds a value\n-- that matches the pattern.  E.g. if the pattern is (Just [x]),\n-- the expression is (Just [x]).  They look the same, but the\n-- input uses constructors from HsPat and the output uses constructors\n-- from HsExpr.\n--\n-- Returns (Left r) if the pattern is not invertible, for reason r.\n-- See Note [Builder for a bidirectional pattern synonym]\ntcPatToExpr name args pat = go pat\n  where\n    lhsVars = mkNameSet (map unLoc args)\n\n    -- Make a prefix con for prefix and infix patterns for simplicity\n    mkPrefixConExpr :: Located Name -> [LPat GhcRn]\n                    -> Either MsgDoc (HsExpr GhcRn)\n    mkPrefixConExpr lcon@(dL->L loc _) pats\n      = do { exprs <- mapM go pats\n           ; return (foldl' (\\x y -> HsApp noExt (cL loc x) y)\n                            (HsVar noExt lcon) exprs) }\n\n    mkRecordConExpr :: Located Name -> HsRecFields GhcRn (LPat GhcRn)\n                    -> Either MsgDoc (HsExpr GhcRn)\n    mkRecordConExpr con fields\n      = do { exprFields <- mapM go fields\n           ; return (RecordCon noExt con exprFields) }\n\n    go :: LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)\n    go (dL->L loc p) = cL loc <$> go1 p\n\n    go1 :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)\n    go1 (ConPatIn con info)\n      = case info of\n          PrefixCon ps  -> mkPrefixConExpr con ps\n          InfixCon l r  -> mkPrefixConExpr con [l,r]\n          RecCon fields -> mkRecordConExpr con fields\n\n    go1 (SigPat _ pat _) = go1 (unLoc pat)\n        -- See Note [Type signatures and the builder expression]\n\n    go1 (VarPat _ (dL->L l var))\n        | var `elemNameSet` lhsVars\n        = return $ HsVar noExt (cL l var)\n        | otherwise\n        = Left (quotes (ppr var) <+> text \"is not bound by the LHS of the pattern synonym\")\n    go1 (ParPat _ pat)          = fmap (HsPar noExt) $ go pat\n    go1 p@(ListPat reb pats)\n      | Nothing <- reb = do { exprs <- mapM go pats\n                            ; return $ ExplicitList noExt Nothing exprs }\n      | otherwise                   = notInvertibleListPat p\n    go1 (TuplePat _ pats box)       = do { exprs <- mapM go pats\n                                         ; return $ ExplicitTuple noExt\n                                           (map (noLoc . (Present noExt)) exprs)\n                                                                           box }\n    go1 (SumPat _ pat alt arity)    = do { expr <- go1 (unLoc pat)\n                                         ; return $ ExplicitSum noExt alt arity\n                                                                   (noLoc expr)\n                                         }\n    go1 (LitPat _ lit)              = return $ HsLit noExt lit\n    go1 (NPat _ (dL->L _ n) mb_neg _)\n        | Just neg <- mb_neg        = return $ unLoc $ nlHsSyntaxApps neg\n                                                     [noLoc (HsOverLit noExt n)]\n        | otherwise                 = return $ HsOverLit noExt n\n    go1 (ConPatOut{})               = panic \"ConPatOut in output of renamer\"\n    go1 (CoPat{})                   = panic \"CoPat in output of renamer\"\n    go1 (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))\n                                    = go1 pat\n    go1 (SplicePat _ (HsSpliced{})) = panic \"Invalid splice variety\"\n    go1 (SplicePat _ (HsSplicedT{})) = panic \"Invalid splice variety\"\n\n    -- The following patterns are not invertible.\n    go1 p@(BangPat {})                       = notInvertible p -- #14112\n    go1 p@(LazyPat {})                       = notInvertible p\n    go1 p@(WildPat {})                       = notInvertible p\n    go1 p@(AsPat {})                         = notInvertible p\n    go1 p@(ViewPat {})                       = notInvertible p\n    go1 p@(NPlusKPat {})                     = notInvertible p\n    go1 p@(XPat {})                          = notInvertible p\n    go1 p@(SplicePat _ (HsTypedSplice {}))   = notInvertible p\n    go1 p@(SplicePat _ (HsUntypedSplice {})) = notInvertible p\n    go1 p@(SplicePat _ (HsQuasiQuote {}))    = notInvertible p\n    go1 p@(SplicePat _ (XSplice {}))         = notInvertible p\n\n    notInvertible p = Left (not_invertible_msg p)\n\n    not_invertible_msg p\n      =   text \"Pattern\" <+> quotes (ppr p) <+> text \"is not invertible\"\n      $+$ hang (text \"Suggestion: instead use an explicitly bidirectional\"\n                <+> text \"pattern synonym, e.g.\")\n             2 (hang (text \"pattern\" <+> pp_name <+> pp_args <+> larrow\n                      <+> ppr pat <+> text \"where\")\n                   2 (pp_name <+> pp_args <+> equals <+> text \"...\"))\n      where\n        pp_name = ppr name\n        pp_args = hsep (map ppr args)\n\n    -- We should really be able to invert list patterns, even when\n    -- rebindable syntax is on, but doing so involves a bit of\n    -- refactoring; see Trac #14380.  Until then we reject with a\n    -- helpful error message.\n    notInvertibleListPat p\n      = Left (vcat [ not_invertible_msg p\n                   , text \"Reason: rebindable syntax is on.\"\n                   , text \"This is fixable: add use-case to Trac #14380\" ])\n\n{- Note [Builder for a bidirectional pattern synonym]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor a bidirectional pattern synonym we need to produce an /expression/\nthat matches the supplied /pattern/, given values for the arguments\nof the pattern synonym.  For example\n  pattern F x y = (Just x, [y])\nThe 'builder' for F looks like\n  $builderF x y = (Just x, [y])\n\nWe can't always do this:\n * Some patterns aren't invertible; e.g. view patterns\n      pattern F x = (reverse -> x:_)\n\n * The RHS pattern might bind more variables than the pattern\n   synonym, so again we can't invert it\n      pattern F x = (x,y)\n\n * Ditto wildcards\n      pattern F x = (x,_)\n\n\nNote [Redundant constraints for builder]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe builder can have redundant constraints, which are awkard to eliminate.\nConsider\n   pattern P = Just 34\nTo match against this pattern we need (Eq a, Num a).  But to build\n(Just 34) we need only (Num a).  Fortunately instTcSigFromId sets\nsig_warn_redundant to False.\n\n************************************************************************\n*                                                                      *\n         Helper functions\n*                                                                      *\n************************************************************************\n\nNote [As-patterns in pattern synonym definitions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe rationale for rejecting as-patterns in pattern synonym definitions\nis that an as-pattern would introduce nonindependent pattern synonym\narguments, e.g. given a pattern synonym like:\n\n        pattern K x y = x@(Just y)\n\none could write a nonsensical function like\n\n        f (K Nothing x) = ...\n\nor\n        g (K (Just True) False) = ...\n\nNote [Type signatures and the builder expression]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   pattern L x = Left x :: Either [a] [b]\n\nIn tc{Infer/Check}PatSynDecl we will check that the pattern has the\nspecified type.  We check the pattern *as a pattern*, so the type\nsignature is a pattern signature, and so brings 'a' and 'b' into\nscope.  But we don't have a way to bind 'a, b' in the LHS, as we do\n'x', say.  Nevertheless, the sigature may be useful to constrain\nthe type.\n\nWhen making the binding for the *builder*, though, we don't want\n  $buildL x = Left x :: Either [a] [b]\nbecause that wil either mean (forall a b. Either [a] [b]), or we'll\nget a complaint that 'a' and 'b' are out of scope. (Actually the\nlatter; Trac #9867.)  No, the job of the signature is done, so when\nconverting the pattern to an expression (for the builder RHS) we\nsimply discard the signature.\n\nNote [Record PatSyn Desugaring]\n-------------------------------\nIt is important that prov_theta comes before req_theta as this ordering is used\nwhen desugaring record pattern synonym updates.\n\nAny change to this ordering should make sure to change deSugar/DsExpr.hs if you\nwant to avoid difficult to decipher core lint errors!\n -}\n\n\nnonBidirectionalErr :: Outputable name => name -> TcM a\nnonBidirectionalErr name = failWithTc $\n    text \"non-bidirectional pattern synonym\"\n    <+> quotes (ppr name) <+> text \"used in an expression\"\n\n-- Walk the whole pattern and for all ConPatOuts, collect the\n-- existentially-bound type variables and evidence binding variables.\n--\n-- These are used in computing the type of a pattern synonym and also\n-- in generating matcher functions, since success continuations need\n-- to be passed these pattern-bound evidences.\ntcCollectEx\n  :: LPat GhcTc\n  -> ( [TyVar]        -- Existentially-bound type variables\n                      -- in correctly-scoped order; e.g. [ k:*, x:k ]\n     , [EvVar] )      -- and evidence variables\n\ntcCollectEx pat = go pat\n  where\n    go :: LPat GhcTc -> ([TyVar], [EvVar])\n    go = go1 . unLoc\n\n    go1 :: Pat GhcTc -> ([TyVar], [EvVar])\n    go1 (LazyPat _ p)      = go p\n    go1 (AsPat _ _ p)      = go p\n    go1 (ParPat _ p)       = go p\n    go1 (BangPat _ p)      = go p\n    go1 (ListPat _ ps)     = mergeMany . map go $ ps\n    go1 (TuplePat _ ps _)  = mergeMany . map go $ ps\n    go1 (SumPat _ p _ _)   = go p\n    go1 (ViewPat _ _ p)    = go p\n    go1 con@ConPatOut{}    = merge (pat_tvs con, pat_dicts con) $\n                              goConDetails $ pat_args con\n    go1 (SigPat _ p _)     = go p\n    go1 (CoPat _ _ p _)    = go1 p\n    go1 (NPlusKPat _ n k _ geq subtract)\n      = pprPanic \"TODO: NPlusKPat\" $ ppr n $$ ppr k $$ ppr geq $$ ppr subtract\n    go1 _                   = empty\n\n    goConDetails :: HsConPatDetails GhcTc -> ([TyVar], [EvVar])\n    goConDetails (PrefixCon ps) = mergeMany . map go $ ps\n    goConDetails (InfixCon p1 p2) = go p1 `merge` go p2\n    goConDetails (RecCon HsRecFields{ rec_flds = flds })\n      = mergeMany . map goRecFd $ flds\n\n    goRecFd :: LHsRecField GhcTc (LPat GhcTc) -> ([TyVar], [EvVar])\n    goRecFd (dL->L _ HsRecField{ hsRecFieldArg = p }) = go p\n\n    merge (vs1, evs1) (vs2, evs2) = (vs1 ++ vs2, evs1 ++ evs2)\n    mergeMany = foldr merge empty\n    empty     = ([], [])\n", "num_lines": 1149}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n-- | This module provides an interface for typechecker plugins to\n-- access select functions of the 'TcM', principally those to do with\n-- reading parts of the state.\nmodule TcPluginM (\n#if defined(GHCI)\n        -- * Basic TcPluginM functionality\n        TcPluginM,\n        tcPluginIO,\n        tcPluginTrace,\n        unsafeTcPluginTcM,\n\n        -- * Finding Modules and Names\n        FindResult(..),\n        findImportedModule,\n        lookupOrig,\n\n        -- * Looking up Names in the typechecking environment\n        tcLookupGlobal,\n        tcLookupTyCon,\n        tcLookupDataCon,\n        tcLookupClass,\n        tcLookup,\n        tcLookupId,\n\n        -- * Getting the TcM state\n        getTopEnv,\n        getEnvs,\n        getInstEnvs,\n        getFamInstEnvs,\n        matchFam,\n\n        -- * Type variables\n        newUnique,\n        newFlexiTyVar,\n        isTouchableTcPluginM,\n\n        -- * Zonking\n        zonkTcType,\n        zonkCt,\n\n        -- * Creating constraints\n        newWanted,\n        newDerived,\n        newGiven,\n        newCoercionHole,\n\n        -- * Manipulating evidence bindings\n        newEvVar,\n        setEvBind,\n        getEvBindsTcPluginM\n#endif\n    ) where\n\n#if defined(GHCI)\nimport GhcPrelude\n\nimport qualified TcRnMonad as TcM\nimport qualified TcSMonad  as TcS\nimport qualified TcEnv     as TcM\nimport qualified TcMType   as TcM\nimport qualified FamInst   as TcM\nimport qualified IfaceEnv\nimport qualified Finder\n\nimport FamInstEnv ( FamInstEnv )\nimport TcRnMonad  ( TcGblEnv, TcLclEnv, Ct, CtLoc, TcPluginM\n                  , unsafeTcPluginTcM, getEvBindsTcPluginM\n                  , liftIO, traceTc )\nimport TcMType    ( TcTyVar, TcType )\nimport TcEnv      ( TcTyThing )\nimport TcEvidence ( TcCoercion, CoercionHole, EvTerm(..)\n                  , EvExpr, EvBind, mkGivenEvBind )\nimport TcRnTypes  ( CtEvidence(..) )\nimport Var        ( EvVar )\n\nimport Module\nimport Name\nimport TyCon\nimport DataCon\nimport Class\nimport HscTypes\nimport Outputable\nimport Type\nimport Id\nimport InstEnv\nimport FastString\nimport Unique\n\n\n-- | Perform some IO, typically to interact with an external tool.\ntcPluginIO :: IO a -> TcPluginM a\ntcPluginIO a = unsafeTcPluginTcM (liftIO a)\n\n-- | Output useful for debugging the compiler.\ntcPluginTrace :: String -> SDoc -> TcPluginM ()\ntcPluginTrace a b = unsafeTcPluginTcM (traceTc a b)\n\n\nfindImportedModule :: ModuleName -> Maybe FastString -> TcPluginM FindResult\nfindImportedModule mod_name mb_pkg = do\n    hsc_env <- getTopEnv\n    tcPluginIO $ Finder.findImportedModule hsc_env mod_name mb_pkg\n\nlookupOrig :: Module -> OccName -> TcPluginM Name\nlookupOrig mod = unsafeTcPluginTcM . IfaceEnv.lookupOrig mod\n\n\ntcLookupGlobal :: Name -> TcPluginM TyThing\ntcLookupGlobal = unsafeTcPluginTcM . TcM.tcLookupGlobal\n\ntcLookupTyCon :: Name -> TcPluginM TyCon\ntcLookupTyCon = unsafeTcPluginTcM . TcM.tcLookupTyCon\n\ntcLookupDataCon :: Name -> TcPluginM DataCon\ntcLookupDataCon = unsafeTcPluginTcM . TcM.tcLookupDataCon\n\ntcLookupClass :: Name -> TcPluginM Class\ntcLookupClass = unsafeTcPluginTcM . TcM.tcLookupClass\n\ntcLookup :: Name -> TcPluginM TcTyThing\ntcLookup = unsafeTcPluginTcM . TcM.tcLookup\n\ntcLookupId :: Name -> TcPluginM Id\ntcLookupId = unsafeTcPluginTcM . TcM.tcLookupId\n\n\ngetTopEnv :: TcPluginM HscEnv\ngetTopEnv = unsafeTcPluginTcM TcM.getTopEnv\n\ngetEnvs :: TcPluginM (TcGblEnv, TcLclEnv)\ngetEnvs = unsafeTcPluginTcM TcM.getEnvs\n\ngetInstEnvs :: TcPluginM InstEnvs\ngetInstEnvs = unsafeTcPluginTcM TcM.tcGetInstEnvs\n\ngetFamInstEnvs :: TcPluginM (FamInstEnv, FamInstEnv)\ngetFamInstEnvs = unsafeTcPluginTcM TcM.tcGetFamInstEnvs\n\nmatchFam :: TyCon -> [Type]\n         -> TcPluginM (Maybe (TcCoercion, TcType))\nmatchFam tycon args = unsafeTcPluginTcM $ TcS.matchFamTcM tycon args\n\nnewUnique :: TcPluginM Unique\nnewUnique = unsafeTcPluginTcM TcM.newUnique\n\nnewFlexiTyVar :: Kind -> TcPluginM TcTyVar\nnewFlexiTyVar = unsafeTcPluginTcM . TcM.newFlexiTyVar\n\nisTouchableTcPluginM :: TcTyVar -> TcPluginM Bool\nisTouchableTcPluginM = unsafeTcPluginTcM . TcM.isTouchableTcM\n\n-- Confused by zonking? See Note [What is zonking?] in TcMType.\nzonkTcType :: TcType -> TcPluginM TcType\nzonkTcType = unsafeTcPluginTcM . TcM.zonkTcType\n\nzonkCt :: Ct -> TcPluginM Ct\nzonkCt = unsafeTcPluginTcM . TcM.zonkCt\n\n\n-- | Create a new wanted constraint.\nnewWanted  :: CtLoc -> PredType -> TcPluginM CtEvidence\nnewWanted loc pty\n  = unsafeTcPluginTcM (TcM.newWanted (TcM.ctLocOrigin loc) Nothing pty)\n\n-- | Create a new derived constraint.\nnewDerived :: CtLoc -> PredType -> TcPluginM CtEvidence\nnewDerived loc pty = return CtDerived { ctev_pred = pty, ctev_loc = loc }\n\n-- | Create a new given constraint, with the supplied evidence.  This\n-- must not be invoked from 'tcPluginInit' or 'tcPluginStop', or it\n-- will panic.\nnewGiven :: CtLoc -> PredType -> EvExpr -> TcPluginM CtEvidence\nnewGiven loc pty evtm = do\n   new_ev <- newEvVar pty\n   setEvBind $ mkGivenEvBind new_ev (EvExpr evtm)\n   return CtGiven { ctev_pred = pty, ctev_evar = new_ev, ctev_loc = loc }\n\n-- | Create a fresh evidence variable.\nnewEvVar :: PredType -> TcPluginM EvVar\nnewEvVar = unsafeTcPluginTcM . TcM.newEvVar\n\n-- | Create a fresh coercion hole.\nnewCoercionHole :: PredType -> TcPluginM CoercionHole\nnewCoercionHole = unsafeTcPluginTcM . TcM.newCoercionHole\n\n-- | Bind an evidence variable.  This must not be invoked from\n-- 'tcPluginInit' or 'tcPluginStop', or it will panic.\nsetEvBind :: EvBind -> TcPluginM ()\nsetEvBind ev_bind = do\n    tc_evbinds <- getEvBindsTcPluginM\n    unsafeTcPluginTcM $ TcM.addTcEvBind tc_evbinds ev_bind\n#else\n-- this dummy import is needed as a consequence of NoImplicitPrelude\nimport GhcPrelude ()\n#endif\n", "num_lines": 197}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[TcRnDriver]{Typechecking a whole module}\n\nhttps://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeChecker\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE NondecreasingIndentation #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcRnDriver (\n        tcRnStmt, tcRnExpr, TcRnExprMode(..), tcRnType,\n        tcRnImportDecls,\n        tcRnLookupRdrName,\n        getModuleInterface,\n        tcRnDeclsi,\n        isGHCiMonad,\n        runTcInteractive,    -- Used by GHC API clients (Trac #8878)\n        tcRnLookupName,\n        tcRnGetInfo,\n        tcRnModule, tcRnModuleTcRnM,\n        tcTopSrcDecls,\n        rnTopSrcDecls,\n        checkBootDecl, checkHiBootIface',\n        findExtraSigImports,\n        implicitRequirements,\n        checkUnitId,\n        mergeSignatures,\n        tcRnMergeSignatures,\n        instantiateSignature,\n        tcRnInstantiateSignature,\n        loadUnqualIfaces,\n        -- More private...\n        badReexportedBootThing,\n        checkBootDeclM,\n        missingBootThing,\n        getRenamedStuff, RenamedStuff\n    ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TcSplice ( finishTH, runRemoteModFinalizers )\nimport RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )\nimport IfaceEnv( externaliseName )\nimport TcHsType\nimport TcValidity( checkValidType )\nimport TcMatches\nimport Inst( deeplyInstantiate )\nimport TcUnify( checkConstraints )\nimport RnTypes\nimport RnExpr\nimport RnUtils ( HsDocContext(..) )\nimport RnFixity ( lookupFixityRn )\nimport MkId\nimport TidyPgm    ( globaliseAndTidyId )\nimport TysWiredIn ( unitTy, mkListTy )\nimport Plugins\nimport DynFlags\nimport HsSyn\nimport IfaceSyn ( ShowSub(..), showToHeader )\nimport IfaceType( ShowForAllFlag(..) )\nimport PatSyn( pprPatSynType )\nimport PrelNames\nimport PrelInfo\nimport RdrName\nimport TcHsSyn\nimport TcExpr\nimport TcRnMonad\nimport TcRnExports\nimport TcEvidence\nimport qualified BooleanFormula as BF\nimport PprTyThing( pprTyThingInContext )\nimport CoreFVs( orphNamesOfFamInst )\nimport FamInst\nimport InstEnv\nimport FamInstEnv( FamInst, pprFamInst, famInstsRepTyCons\n                 , famInstEnvElts, extendFamInstEnvList, normaliseType )\nimport TcAnnotations\nimport TcBinds\nimport MkIface          ( coAxiomToIfaceDecl )\nimport HeaderInfo       ( mkPrelImports )\nimport TcDefaults\nimport TcEnv\nimport TcRules\nimport TcForeign\nimport TcInstDcls\nimport TcIface\nimport TcMType\nimport TcType\nimport TcSimplify\nimport TcTyClsDecls\nimport TcTypeable ( mkTypeableBinds )\nimport TcBackpack\nimport LoadIface\nimport RnNames\nimport RnEnv\nimport RnSource\nimport ErrUtils\nimport Id\nimport IdInfo( IdDetails(..) )\nimport VarEnv\nimport Module\nimport UniqFM\nimport Name\nimport NameEnv\nimport NameSet\nimport Avail\nimport TyCon\nimport SrcLoc\nimport HscTypes\nimport ListSetOps\nimport Outputable\nimport ConLike\nimport DataCon\nimport Type\nimport Class\nimport BasicTypes hiding( SuccessFlag(..) )\nimport CoAxiom\nimport Annotations\nimport Data.List ( sortBy, sort )\nimport Data.Ord\nimport FastString\nimport Maybes\nimport Util\nimport Bag\nimport Inst (tcGetInsts)\nimport qualified GHC.LanguageExtensions as LangExt\nimport Data.Data ( Data )\nimport HsDumpAst\nimport qualified Data.Set as S\n\nimport Control.DeepSeq\nimport Control.Monad\n\n#include \"HsVersions.h\"\n\n{-\n************************************************************************\n*                                                                      *\n        Typecheck and rename a module\n*                                                                      *\n************************************************************************\n-}\n\n-- | Top level entry point for typechecker and renamer\ntcRnModule :: HscEnv\n           -> ModSummary\n           -> Bool              -- True <=> save renamed syntax\n           -> HsParsedModule\n           -> IO (Messages, Maybe TcGblEnv)\n\ntcRnModule hsc_env mod_sum save_rn_syntax\n   parsedModule@HsParsedModule {hpm_module= (dL->L loc this_module)}\n | RealSrcSpan real_loc <- loc\n = withTiming (pure dflags)\n              (text \"Renamer/typechecker\"<+>brackets (ppr this_mod))\n              (const ()) $\n   initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $\n          withTcPlugins hsc_env $\n\n          tcRnModuleTcRnM hsc_env mod_sum parsedModule pair\n\n  | otherwise\n  = return ((emptyBag, unitBag err_msg), Nothing)\n\n  where\n    hsc_src = ms_hsc_src mod_sum\n    dflags = hsc_dflags hsc_env\n    err_msg = mkPlainErrMsg (hsc_dflags hsc_env) loc $\n              text \"Module does not have a RealSrcSpan:\" <+> ppr this_mod\n\n    this_pkg = thisPackage (hsc_dflags hsc_env)\n\n    pair :: (Module, SrcSpan)\n    pair@(this_mod,_)\n      | Just (dL->L mod_loc mod) <- hsmodName this_module\n      = (mkModule this_pkg mod, mod_loc)\n\n      | otherwise   -- 'module M where' is omitted\n      = (mAIN, srcLocSpan (srcSpanStart loc))\n\n\n\n\ntcRnModuleTcRnM :: HscEnv\n                -> ModSummary\n                -> HsParsedModule\n                -> (Module, SrcSpan)\n                -> TcRn TcGblEnv\n-- Factored out separately from tcRnModule so that a Core plugin can\n-- call the type checker directly\ntcRnModuleTcRnM hsc_env mod_sum\n                (HsParsedModule {\n                   hpm_module =\n                      (dL->L loc (HsModule maybe_mod export_ies\n                                       import_decls local_decls mod_deprec\n                                       maybe_doc_hdr)),\n                   hpm_src_files = src_files\n                })\n                (this_mod, prel_imp_loc)\n = setSrcSpan loc $\n   do { let { explicit_mod_hdr = isJust maybe_mod\n            ; hsc_src          = ms_hsc_src mod_sum }\n      ; -- Load the hi-boot interface for this module, if any\n        -- We do this now so that the boot_names can be passed\n        -- to tcTyAndClassDecls, because the boot_names are\n        -- automatically considered to be loop breakers\n        tcg_env <- getGblEnv\n      ; boot_info <- tcHiBootIface hsc_src this_mod\n      ; setGblEnv (tcg_env { tcg_self_boot = boot_info })\n        $ do\n        { -- Deal with imports; first add implicit prelude\n          implicit_prelude <- xoptM LangExt.ImplicitPrelude\n        ; let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc\n                               implicit_prelude import_decls }\n\n        ; whenWOptM Opt_WarnImplicitPrelude $\n             when (notNull prel_imports) $\n                addWarn (Reason Opt_WarnImplicitPrelude) (implicitPreludeWarn)\n\n        ; -- TODO This is a little skeevy; maybe handle a bit more directly\n          let { simplifyImport (dL->L _ idecl) =\n                  ( fmap sl_fs (ideclPkgQual idecl) , ideclName idecl)\n              }\n        ; raw_sig_imports <- liftIO\n                             $ findExtraSigImports hsc_env hsc_src\n                                 (moduleName this_mod)\n        ; raw_req_imports <- liftIO\n                             $ implicitRequirements hsc_env\n                                (map simplifyImport (prel_imports\n                                                     ++ import_decls))\n        ; let { mkImport (Nothing, dL->L _ mod_name) = noLoc\n                $ (simpleImportDecl mod_name)\n                  { ideclHiding = Just (False, noLoc [])}\n              ; mkImport _ = panic \"mkImport\" }\n        ; let { all_imports = prel_imports ++ import_decls\n                       ++ map mkImport (raw_sig_imports ++ raw_req_imports) }\n        ; -- OK now finally rename the imports\n          tcg_env <- {-# SCC \"tcRnImports\" #-}\n                     tcRnImports hsc_env all_imports\n\n        ; -- If the whole module is warned about or deprecated\n          -- (via mod_deprec) record that in tcg_warns. If we do thereby add\n          -- a WarnAll, it will override any subsequent deprecations added to tcg_warns\n          let { tcg_env1 = case mod_deprec of\n                             Just (dL->L _ txt) ->\n                               tcg_env {tcg_warns = WarnAll txt}\n                             Nothing            -> tcg_env\n              }\n        ; setGblEnv tcg_env1\n          $ do { -- Rename and type check the declarations\n                 traceRn \"rn1a\" empty\n               ; tcg_env <- if isHsBootOrSig hsc_src\n                            then tcRnHsBootDecls hsc_src local_decls\n                            else {-# SCC \"tcRnSrcDecls\" #-}\n                                 tcRnSrcDecls explicit_mod_hdr local_decls\n               ; setGblEnv tcg_env\n                 $ do { -- Process the export list\n                        traceRn \"rn4a: before exports\" empty\n                      ; tcg_env <- tcRnExports explicit_mod_hdr export_ies\n                                     tcg_env\n                      ; traceRn \"rn4b: after exports\" empty\n                      ; -- Check main is exported(must be after tcRnExports)\n                        checkMainExported tcg_env\n                      ; -- Compare hi-boot iface (if any) with the real thing\n                        -- Must be done after processing the exports\n                        tcg_env <- checkHiBootIface tcg_env boot_info\n                      ; -- The new type env is already available to stuff\n                        -- slurped from interface files, via\n                        -- TcEnv.setGlobalTypeEnv. It's important that this\n                        -- includes the stuff in checkHiBootIface,\n                        -- because the latter might add new bindings for\n                        -- boot_dfuns, which may be mentioned in imported\n                        -- unfoldings.\n\n                        -- Don't need to rename the Haddock documentation,\n                        -- it's not parsed by GHC anymore.\n                        tcg_env <- return (tcg_env\n                                           { tcg_doc_hdr = maybe_doc_hdr })\n                      ; -- Report unused names\n                        -- Do this /after/ typeinference, so that when reporting\n                        -- a function with no type signature we can give the\n                        -- inferred type\n                        reportUnusedNames export_ies tcg_env\n                      ; -- add extra source files to tcg_dependent_files\n                        addDependentFiles src_files\n                      ; tcg_env <- runTypecheckerPlugin mod_sum hsc_env tcg_env\n                      ; -- Dump output and return\n                        tcDump tcg_env\n                      ; return tcg_env }\n               }\n        }\n      }\n\nimplicitPreludeWarn :: SDoc\nimplicitPreludeWarn\n  = text \"Module `Prelude' implicitly imported\"\n\n{-\n************************************************************************\n*                                                                      *\n                Import declarations\n*                                                                      *\n************************************************************************\n-}\n\ntcRnImports :: HscEnv -> [LImportDecl GhcPs] -> TcM TcGblEnv\ntcRnImports hsc_env import_decls\n  = do  { (rn_imports, rdr_env, imports, hpc_info) <- rnImports import_decls ;\n\n        ; this_mod <- getModule\n        ; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)\n              ; dep_mods = imp_dep_mods imports\n\n                -- We want instance declarations from all home-package\n                -- modules below this one, including boot modules, except\n                -- ourselves.  The 'except ourselves' is so that we don't\n                -- get the instances from this module's hs-boot file.  This\n                -- filtering also ensures that we don't see instances from\n                -- modules batch (@--make@) compiled before this one, but\n                -- which are not below this one.\n              ; want_instances :: ModuleName -> Bool\n              ; want_instances mod = mod `elemUFM` dep_mods\n                                   && mod /= moduleName this_mod\n              ; (home_insts, home_fam_insts) = hptInstances hsc_env\n                                                            want_instances\n              } ;\n\n                -- Record boot-file info in the EPS, so that it's\n                -- visible to loadHiBootInterface in tcRnSrcDecls,\n                -- and any other incrementally-performed imports\n        ; updateEps_ (\\eps -> eps { eps_is_boot = dep_mods }) ;\n\n                -- Update the gbl env\n        ; updGblEnv ( \\ gbl ->\n            gbl {\n              tcg_rdr_env      = tcg_rdr_env gbl `plusGlobalRdrEnv` rdr_env,\n              tcg_imports      = tcg_imports gbl `plusImportAvails` imports,\n              tcg_rn_imports   = rn_imports,\n              tcg_inst_env     = extendInstEnvList (tcg_inst_env gbl) home_insts,\n              tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl)\n                                                      home_fam_insts,\n              tcg_hpc          = hpc_info\n            }) $ do {\n\n        ; traceRn \"rn1\" (ppr (imp_dep_mods imports))\n                -- Fail if there are any errors so far\n                -- The error printing (if needed) takes advantage\n                -- of the tcg_env we have now set\n--      ; traceIf (text \"rdr_env: \" <+> ppr rdr_env)\n        ; failIfErrsM\n\n                -- Load any orphan-module (including orphan family\n                -- instance-module) interfaces, so that their rules and\n                -- instance decls will be found.  But filter out a\n                -- self hs-boot: these instances will be checked when\n                -- we define them locally.\n                -- (We don't need to load non-orphan family instance\n                -- modules until we either try to use the instances they\n                -- define, or define our own family instances, at which\n                -- point we need to check them for consistency.)\n        ; loadModuleInterfaces (text \"Loading orphan modules\")\n                               (filter (/= this_mod) (imp_orphs imports))\n\n                -- Check type-family consistency between imports.\n                -- See Note [The type family instance consistency story]\n        ; traceRn \"rn1: checking family instance consistency {\" empty\n        ; let { dir_imp_mods = moduleEnvKeys\n                             . imp_mods\n                             $ imports }\n        ; checkFamInstConsistency dir_imp_mods\n        ; traceRn \"rn1: } checking family instance consistency\" empty\n\n        ; getGblEnv } }\n\n{-\n************************************************************************\n*                                                                      *\n        Type-checking the top level of a module\n*                                                                      *\n************************************************************************\n-}\n\ntcRnSrcDecls :: Bool  -- False => no 'module M(..) where' header at all\n             -> [LHsDecl GhcPs]               -- Declarations\n             -> TcM TcGblEnv\ntcRnSrcDecls explicit_mod_hdr decls\n = do { -- Do all the declarations\n      ; (tcg_env, tcl_env, lie) <- tc_rn_src_decls decls\n\n        -- Check for the 'main' declaration\n        -- Must do this inside the captureTopConstraints\n      ; (tcg_env, lie_main) <- setEnvs (tcg_env, tcl_env) $\n                               -- always set envs *before* captureTopConstraints\n                               captureTopConstraints $\n                               checkMain explicit_mod_hdr\n\n      ; setEnvs (tcg_env, tcl_env) $ do {\n\n             --         Simplify constraints\n             --\n             -- We do this after checkMain, so that we use the type info\n             -- that checkMain adds\n             --\n             -- We do it with both global and local env in scope:\n             --  * the global env exposes the instances to simplifyTop\n             --  * the local env exposes the local Ids to simplifyTop,\n             --    so that we get better error messages (monomorphism restriction)\n      ; new_ev_binds <- {-# SCC \"simplifyTop\" #-}\n                        simplifyTop (lie `andWC` lie_main)\n\n        -- Emit Typeable bindings\n      ; tcg_env <- mkTypeableBinds\n\n\n      ; traceTc \"Tc9\" empty\n\n      ; failIfErrsM     -- Don't zonk if there have been errors\n                        -- It's a waste of time; and we may get debug warnings\n                        -- about strangely-typed TyCons!\n      ; traceTc \"Tc10\" empty\n\n        -- Zonk the final code.  This must be done last.\n        -- Even simplifyTop may do some unification.\n        -- This pass also warns about missing type signatures\n      ; (bind_env, ev_binds', binds', fords', imp_specs', rules')\n            <- zonkTcGblEnv new_ev_binds tcg_env\n\n        -- Finalizers must run after constraints are simplified, or some types\n        -- might not be complete when using reify (see #12777).\n        -- and also after we zonk the first time because we run typed splices\n        -- in the zonker which gives rise to the finalisers.\n      ; (tcg_env_mf, _) <- setGblEnv (clearTcGblEnv tcg_env)\n                                     run_th_modfinalizers\n      ; finishTH\n      ; traceTc \"Tc11\" empty\n\n      ; -- zonk the new bindings arising from running the finalisers.\n        -- This won't give rise to any more finalisers as you can't nest\n        -- finalisers inside finalisers.\n      ; (bind_env_mf, ev_binds_mf, binds_mf, fords_mf, imp_specs_mf, rules_mf)\n            <- zonkTcGblEnv emptyBag tcg_env_mf\n\n\n      ; let { final_type_env = plusTypeEnv (tcg_type_env tcg_env)\n                                (plusTypeEnv bind_env_mf bind_env)\n            ; tcg_env' = tcg_env_mf\n                          { tcg_binds    = binds' `unionBags` binds_mf,\n                            tcg_ev_binds = ev_binds' `unionBags` ev_binds_mf ,\n                            tcg_imp_specs = imp_specs' ++ imp_specs_mf ,\n                            tcg_rules    = rules' ++ rules_mf ,\n                            tcg_fords    = fords' ++ fords_mf } } ;\n\n      ; setGlobalTypeEnv tcg_env' final_type_env\n\n   } }\n\nzonkTcGblEnv :: Bag EvBind -> TcGblEnv\n             -> TcM (TypeEnv, Bag EvBind, LHsBinds GhcTc,\n                       [LForeignDecl GhcTc], [LTcSpecPrag], [LRuleDecl GhcTc])\nzonkTcGblEnv new_ev_binds tcg_env =\n  let TcGblEnv {   tcg_binds     = binds,\n                   tcg_ev_binds  = cur_ev_binds,\n                   tcg_imp_specs = imp_specs,\n                   tcg_rules     = rules,\n                   tcg_fords     = fords } = tcg_env\n\n      all_ev_binds = cur_ev_binds `unionBags` new_ev_binds\n\n  in {-# SCC \"zonkTopDecls\" #-}\n      zonkTopDecls all_ev_binds binds rules imp_specs fords\n\n\n-- | Remove accumulated bindings, rules and so on from TcGblEnv\nclearTcGblEnv :: TcGblEnv -> TcGblEnv\nclearTcGblEnv tcg_env\n  = tcg_env { tcg_binds    = emptyBag,\n              tcg_ev_binds = emptyBag ,\n              tcg_imp_specs = [],\n              tcg_rules    = [],\n              tcg_fords    = [] }\n\n-- | Runs TH finalizers and renames and typechecks the top-level declarations\n-- that they could introduce.\nrun_th_modfinalizers :: TcM (TcGblEnv, TcLclEnv)\nrun_th_modfinalizers = do\n  th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv\n  th_modfinalizers <- readTcRef th_modfinalizers_var\n  if null th_modfinalizers\n  then getEnvs\n  else do\n    writeTcRef th_modfinalizers_var []\n    let run_finalizer (lcl_env, f) =\n            setLclEnv lcl_env (runRemoteModFinalizers f)\n\n    (_, lie_th) <- captureTopConstraints $ mapM_ run_finalizer th_modfinalizers\n      -- Finalizers can add top-level declarations with addTopDecls, so\n      -- we have to run tc_rn_src_decls to get them\n    (tcg_env, tcl_env, lie_top_decls) <- tc_rn_src_decls []\n    setEnvs (tcg_env, tcl_env) $ do\n      -- Subsequent rounds of finalizers run after any new constraints are\n      -- simplified, or some types might not be complete when using reify\n      -- (see #12777).\n      new_ev_binds <- {-# SCC \"simplifyTop2\" #-}\n                      simplifyTop (lie_th `andWC` lie_top_decls)\n      addTopEvBinds new_ev_binds run_th_modfinalizers\n        -- addTopDecls can add declarations which add new finalizers.\n\ntc_rn_src_decls :: [LHsDecl GhcPs]\n                -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)\n-- Loops around dealing with each top level inter-splice group\n-- in turn, until it's dealt with the entire module\n-- Never emits constraints; calls captureTopConstraints internally\ntc_rn_src_decls ds\n = {-# SCC \"tc_rn_src_decls\" #-}\n   do { (first_group, group_tail) <- findSplice ds\n                -- If ds is [] we get ([], Nothing)\n\n        -- Deal with decls up to, but not including, the first splice\n      ; (tcg_env, rn_decls) <- rnTopSrcDecls first_group\n                -- rnTopSrcDecls fails if there are any errors\n\n        -- Get TH-generated top-level declarations and make sure they don't\n        -- contain any splices since we don't handle that at the moment\n        --\n        -- The plumbing here is a bit odd: see Trac #10853\n      ; th_topdecls_var <- fmap tcg_th_topdecls getGblEnv\n      ; th_ds <- readTcRef th_topdecls_var\n      ; writeTcRef th_topdecls_var []\n\n      ; (tcg_env, rn_decls) <-\n            if null th_ds\n            then return (tcg_env, rn_decls)\n            else do { (th_group, th_group_tail) <- findSplice th_ds\n                    ; case th_group_tail of\n                        { Nothing -> return ()\n                        ; Just (SpliceDecl _ (dL->L loc _) _, _) ->\n                            setSrcSpan loc\n                            $ addErr (text\n                                (\"Declaration splices are not \"\n                                  ++ \"permitted inside top-level \"\n                                  ++ \"declarations added with addTopDecls\"))\n                        ; Just (XSpliceDecl _, _) -> panic \"tc_rn_src_decls\"\n                        }\n                      -- Rename TH-generated top-level declarations\n                    ; (tcg_env, th_rn_decls) <- setGblEnv tcg_env\n                        $ rnTopSrcDecls th_group\n\n                      -- Dump generated top-level declarations\n                    ; let msg = \"top-level declarations added with addTopDecls\"\n                    ; traceSplice\n                        $ SpliceInfo { spliceDescription = msg\n                                     , spliceIsDecl    = True\n                                     , spliceSource    = Nothing\n                                     , spliceGenerated = ppr th_rn_decls }\n                    ; return (tcg_env, appendGroups rn_decls th_rn_decls)\n                    }\n\n      -- Type check all declarations\n      -- NB: set the env **before** captureTopConstraints so that error messages\n      -- get reported w.r.t. the right GlobalRdrEnv. It is for this reason that\n      -- the captureTopConstraints must go here, not in tcRnSrcDecls.\n      ; ((tcg_env, tcl_env), lie1) <- setGblEnv tcg_env $\n                                      captureTopConstraints $\n                                      tcTopSrcDecls rn_decls\n\n        -- If there is no splice, we're nearly done\n      ; setEnvs (tcg_env, tcl_env) $\n        case group_tail of\n          { Nothing -> return (tcg_env, tcl_env, lie1)\n\n            -- If there's a splice, we must carry on\n          ; Just (SpliceDecl _ (dL->L loc splice) _, rest_ds) ->\n            do { recordTopLevelSpliceLoc loc\n\n                 -- Rename the splice expression, and get its supporting decls\n               ; (spliced_decls, splice_fvs) <- rnTopSpliceDecls splice\n\n                 -- Glue them on the front of the remaining decls and loop\n               ; (tcg_env, tcl_env, lie2) <-\n                   setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $\n                   tc_rn_src_decls (spliced_decls ++ rest_ds)\n\n               ; return (tcg_env, tcl_env, lie1 `andWC` lie2)\n               }\n          ; Just (XSpliceDecl _, _) -> panic \"tc_rn_src_decls\"\n          }\n      }\n\n{-\n************************************************************************\n*                                                                      *\n        Compiling hs-boot source files, and\n        comparing the hi-boot interface with the real thing\n*                                                                      *\n************************************************************************\n-}\n\ntcRnHsBootDecls :: HscSource -> [LHsDecl GhcPs] -> TcM TcGblEnv\ntcRnHsBootDecls hsc_src decls\n   = do { (first_group, group_tail) <- findSplice decls\n\n                -- Rename the declarations\n        ; (tcg_env, HsGroup { hs_tyclds = tycl_decls\n                            , hs_derivds = deriv_decls\n                            , hs_fords  = for_decls\n                            , hs_defds  = def_decls\n                            , hs_ruleds = rule_decls\n                            , hs_annds  = _\n                            , hs_valds\n                                 = XValBindsLR (NValBinds val_binds val_sigs) })\n              <- rnTopSrcDecls first_group\n        -- The empty list is for extra dependencies coming from .hs-boot files\n        -- See Note [Extra dependencies from .hs-boot files] in RnSource\n        ; (gbl_env, lie) <- setGblEnv tcg_env $ captureTopConstraints $ do {\n              -- NB: setGblEnv **before** captureTopConstraints so that\n              -- if the latter reports errors, it knows what's in scope\n\n                -- Check for illegal declarations\n        ; case group_tail of\n             Just (SpliceDecl _ d _, _) -> badBootDecl hsc_src \"splice\" d\n             Just (XSpliceDecl _, _) -> panic \"tcRnHsBootDecls\"\n             Nothing                  -> return ()\n        ; mapM_ (badBootDecl hsc_src \"foreign\") for_decls\n        ; mapM_ (badBootDecl hsc_src \"default\") def_decls\n        ; mapM_ (badBootDecl hsc_src \"rule\")    rule_decls\n\n                -- Typecheck type/class/instance decls\n        ; traceTc \"Tc2 (boot)\" empty\n        ; (tcg_env, inst_infos, _deriv_binds)\n             <- tcTyClsInstDecls tycl_decls deriv_decls val_binds\n        ; setGblEnv tcg_env     $ do {\n\n        -- Emit Typeable bindings\n        ; tcg_env <- mkTypeableBinds\n        ; setGblEnv tcg_env $ do {\n\n                -- Typecheck value declarations\n        ; traceTc \"Tc5\" empty\n        ; val_ids <- tcHsBootSigs val_binds val_sigs\n\n                -- Wrap up\n                -- No simplification or zonking to do\n        ; traceTc \"Tc7a\" empty\n        ; gbl_env <- getGblEnv\n\n                -- Make the final type-env\n                -- Include the dfun_ids so that their type sigs\n                -- are written into the interface file.\n        ; let { type_env0 = tcg_type_env gbl_env\n              ; type_env1 = extendTypeEnvWithIds type_env0 val_ids\n              ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids\n              ; dfun_ids = map iDFunId inst_infos\n              }\n\n        ; setGlobalTypeEnv gbl_env type_env2\n   }}}\n   ; traceTc \"boot\" (ppr lie); return gbl_env }\n\nbadBootDecl :: HscSource -> String -> Located decl -> TcM ()\nbadBootDecl hsc_src what (dL->L loc _)\n  = addErrAt loc (char 'A' <+> text what\n      <+> text \"declaration is not (currently) allowed in a\"\n      <+> (case hsc_src of\n            HsBootFile -> text \"hs-boot\"\n            HsigFile -> text \"hsig\"\n            _ -> panic \"badBootDecl: should be an hsig or hs-boot file\")\n      <+> text \"file\")\n\n{-\nOnce we've typechecked the body of the module, we want to compare what\nwe've found (gathered in a TypeEnv) with the hi-boot details (if any).\n-}\n\ncheckHiBootIface :: TcGblEnv -> SelfBootInfo -> TcM TcGblEnv\n-- Compare the hi-boot file for this module (if there is one)\n-- with the type environment we've just come up with\n-- In the common case where there is no hi-boot file, the list\n-- of boot_names is empty.\n\ncheckHiBootIface tcg_env boot_info\n  | NoSelfBoot <- boot_info  -- Common case\n  = return tcg_env\n\n  | HsBootFile <- tcg_src tcg_env   -- Current module is already a hs-boot file!\n  = return tcg_env\n\n  | SelfBoot { sb_mds = boot_details } <- boot_info\n  , TcGblEnv { tcg_binds    = binds\n             , tcg_insts    = local_insts\n             , tcg_type_env = local_type_env\n             , tcg_exports  = local_exports } <- tcg_env\n  = do  { -- This code is tricky, see Note [DFun knot-tying]\n        ; dfun_prs <- checkHiBootIface' local_insts local_type_env\n                                        local_exports boot_details\n\n        -- Now add the boot-dfun bindings  $fxblah = $fblah\n        -- to (a) the type envt, and (b) the top-level bindings\n        ; let boot_dfuns = map fst dfun_prs\n              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns\n              dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)\n                                     | (boot_dfun, dfun) <- dfun_prs ]\n              tcg_env_w_binds\n                = tcg_env { tcg_binds = binds `unionBags` dfun_binds }\n\n        ; type_env' `seq`\n             -- Why the seq?  Without, we will put a TypeEnv thunk in\n             -- tcg_type_env_var.  That thunk will eventually get\n             -- forced if we are typechecking interfaces, but that\n             -- is no good if we are trying to typecheck the very\n             -- DFun we were going to put in.\n             -- TODO: Maybe setGlobalTypeEnv should be strict.\n          setGlobalTypeEnv tcg_env_w_binds type_env' }\n\n  | otherwise = panic \"checkHiBootIface: unreachable code\"\n\n{- Note [DFun impedance matching]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe return a list of \"impedance-matching\" bindings for the dfuns\ndefined in the hs-boot file, such as\n          $fxEqT = $fEqT\nWe need these because the module and hi-boot file might differ in\nthe name it chose for the dfun: the name of a dfun is not\nuniquely determined by its type; there might be multiple dfuns\nwhich, individually, would map to the same name (in which case\nwe have to disambiguate them.)  There's no way for the hi file\nto know exactly what disambiguation to use... without looking\nat the hi-boot file itself.\n\nIn fact, the names will always differ because we always pick names\nprefixed with \"$fx\" for boot dfuns, and \"$f\" for real dfuns\n(so that this impedance matching is always possible).\n\nNote [DFun knot-tying]\n~~~~~~~~~~~~~~~~~~~~~~\nThe 'SelfBootInfo' that is fed into 'checkHiBootIface' comes from\ntypechecking the hi-boot file that we are presently implementing.\nSuppose we are typechecking the module A: when we typecheck the\nhi-boot file, whenever we see an identifier A.T, we knot-tie this\nidentifier to the *local* type environment (via if_rec_types.)  The\ncontract then is that we don't *look* at 'SelfBootInfo' until we've\nfinished typechecking the module and updated the type environment with\nthe new tycons and ids.\n\nThis most works well, but there is one problem: DFuns!  We do not want\nto look at the mb_insts of the ModDetails in SelfBootInfo, because a\ndfun in one of those ClsInsts is gotten (in TcIface.tcIfaceInst) by a\n(lazily evaluated) lookup in the if_rec_types.  We could extend the\ntype env, do a setGloblaTypeEnv etc; but that all seems very indirect.\nIt is much more directly simply to extract the DFunIds from the\nmd_types of the SelfBootInfo.\n\nSee Trac #4003, #16038 for why we need to take care here.\n-}\n\ncheckHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo]\n                  -> ModDetails -> TcM [(Id, Id)]\n-- Variant which doesn't require a full TcGblEnv; you could get the\n-- local components from another ModDetails.\ncheckHiBootIface'\n        local_insts local_type_env local_exports\n        (ModDetails { md_types = boot_type_env\n                    , md_fam_insts = boot_fam_insts\n                    , md_exports = boot_exports })\n  = do  { traceTc \"checkHiBootIface\" $ vcat\n             [ ppr boot_type_env, ppr boot_exports]\n\n                -- Check the exports of the boot module, one by one\n        ; mapM_ check_export boot_exports\n\n                -- Check for no family instances\n        ; unless (null boot_fam_insts) $\n            panic (\"TcRnDriver.checkHiBootIface: Cannot handle family \" ++\n                   \"instances in boot files yet...\")\n            -- FIXME: Why?  The actual comparison is not hard, but what would\n            --        be the equivalent to the dfun bindings returned for class\n            --        instances?  We can't easily equate tycons...\n\n                -- Check instance declarations\n                -- and generate an impedance-matching binding\n        ; mb_dfun_prs <- mapM check_cls_inst boot_dfuns\n\n        ; failIfErrsM\n\n        ; return (catMaybes mb_dfun_prs) }\n\n  where\n    boot_dfun_names = map idName boot_dfuns\n    boot_dfuns      = filter isDFunId $ typeEnvIds boot_type_env\n       -- NB: boot_dfuns is /not/ defined thus: map instanceDFunId md_insts\n       --     We don't want to look at md_insts!\n       --     Why not?  See Note [DFun knot-tying]\n\n    check_export boot_avail     -- boot_avail is exported by the boot iface\n      | name `elem` boot_dfun_names = return ()\n      | isWiredInName name          = return () -- No checking for wired-in names.  In particular,\n                                                -- 'error' is handled by a rather gross hack\n                                                -- (see comments in GHC.Err.hs-boot)\n\n        -- Check that the actual module exports the same thing\n      | not (null missing_names)\n      = addErrAt (nameSrcSpan (head missing_names))\n                 (missingBootThing True (head missing_names) \"exported by\")\n\n        -- If the boot module does not *define* the thing, we are done\n        -- (it simply re-exports it, and names match, so nothing further to do)\n      | isNothing mb_boot_thing = return ()\n\n        -- Check that the actual module also defines the thing, and\n        -- then compare the definitions\n      | Just real_thing <- lookupTypeEnv local_type_env name,\n        Just boot_thing <- mb_boot_thing\n      = checkBootDeclM True boot_thing real_thing\n\n      | otherwise\n      = addErrTc (missingBootThing True name \"defined in\")\n      where\n        name          = availName boot_avail\n        mb_boot_thing = lookupTypeEnv boot_type_env name\n        missing_names = case lookupNameEnv local_export_env name of\n                          Nothing    -> [name]\n                          Just avail -> availNames boot_avail `minusList` availNames avail\n\n    local_export_env :: NameEnv AvailInfo\n    local_export_env = availsToNameEnv local_exports\n\n    check_cls_inst :: DFunId -> TcM (Maybe (Id, Id))\n        -- Returns a pair of the boot dfun in terms of the equivalent\n        -- real dfun. Delicate (like checkBootDecl) because it depends\n        -- on the types lining up precisely even to the ordering of\n        -- the type variables in the foralls.\n    check_cls_inst boot_dfun\n      | (real_dfun : _) <- find_real_dfun boot_dfun\n      , let local_boot_dfun = Id.mkExportedVanillaId\n                                  (idName boot_dfun) (idType real_dfun)\n      = return (Just (local_boot_dfun, real_dfun))\n          -- Two tricky points here:\n          --\n          --  * The local_boot_fun should have a Name from the /boot-file/,\n          --    but type from the dfun defined in /this module/.\n          --    That ensures that the TyCon etc inside the type are\n          --    the ones defined in this module, not the ones gotten\n          --    from the hi-boot file, which may have a lot less info\n          --    (Trac #8743, comment:10).\n          --\n          --  * The DFunIds from boot_details are /GlobalIds/, because\n          --    they come from typechecking M.hi-boot.\n          --    But all bindings in this module should be for /LocalIds/,\n          --    otherwise dependency analysis fails (Trac #16038). This\n          --    is another reason for using mkExportedVanillaId, rather\n          --    that modifying boot_dfun, to make local_boot_fun.\n\n      | otherwise\n      = setSrcSpan (getLoc (getName boot_dfun)) $\n        do { traceTc \"check_cls_inst\" $ vcat\n                [ text \"local_insts\"  <+>\n                     vcat (map (ppr . idType . instanceDFunId) local_insts)\n                , text \"boot_dfun_ty\" <+> ppr (idType boot_dfun) ]\n\n           ; addErrTc (instMisMatch boot_dfun)\n           ; return Nothing }\n\n    find_real_dfun :: DFunId -> [DFunId]\n    find_real_dfun boot_dfun\n       = [dfun | inst <- local_insts\n               , let dfun = instanceDFunId inst\n               , idType dfun `eqType` boot_dfun_ty ]\n       where\n          boot_dfun_ty   = idType boot_dfun\n\n\n-- In general, to perform these checks we have to\n-- compare the TyThing from the .hi-boot file to the TyThing\n-- in the current source file.  We must be careful to allow alpha-renaming\n-- where appropriate, and also the boot declaration is allowed to omit\n-- constructors and class methods.\n--\n-- See rnfail055 for a good test of this stuff.\n\n-- | Compares two things for equivalence between boot-file and normal code,\n-- reporting an error if they don't match up.\ncheckBootDeclM :: Bool  -- ^ True <=> an hs-boot file (could also be a sig)\n               -> TyThing -> TyThing -> TcM ()\ncheckBootDeclM is_boot boot_thing real_thing\n  = whenIsJust (checkBootDecl is_boot boot_thing real_thing) $ \\ err ->\n       addErrAt span\n                (bootMisMatch is_boot err real_thing boot_thing)\n  where\n    -- Here we use the span of the boot thing or, if it doesn't have a sensible\n    -- span, that of the real thing,\n    span\n      | let span = nameSrcSpan (getName boot_thing)\n      , isGoodSrcSpan span\n      = span\n      | otherwise\n      = nameSrcSpan (getName real_thing)\n\n-- | Compares the two things for equivalence between boot-file and normal\n-- code. Returns @Nothing@ on success or @Just \"some helpful info for user\"@\n-- failure. If the difference will be apparent to the user, @Just empty@ is\n-- perfectly suitable.\ncheckBootDecl :: Bool -> TyThing -> TyThing -> Maybe SDoc\n\ncheckBootDecl _ (AnId id1) (AnId id2)\n  = ASSERT(id1 == id2)\n    check (idType id1 `eqType` idType id2)\n          (text \"The two types are different\")\n\ncheckBootDecl is_boot (ATyCon tc1) (ATyCon tc2)\n  = checkBootTyCon is_boot tc1 tc2\n\ncheckBootDecl _ (AConLike (RealDataCon dc1)) (AConLike (RealDataCon _))\n  = pprPanic \"checkBootDecl\" (ppr dc1)\n\ncheckBootDecl _ _ _ = Just empty -- probably shouldn't happen\n\n-- | Combines two potential error messages\nandThenCheck :: Maybe SDoc -> Maybe SDoc -> Maybe SDoc\nNothing `andThenCheck` msg     = msg\nmsg     `andThenCheck` Nothing = msg\nJust d1 `andThenCheck` Just d2 = Just (d1 $$ d2)\ninfixr 0 `andThenCheck`\n\n-- | If the test in the first parameter is True, succeed with @Nothing@;\n-- otherwise, return the provided check\ncheckUnless :: Bool -> Maybe SDoc -> Maybe SDoc\ncheckUnless True  _ = Nothing\ncheckUnless False k = k\n\n-- | Run the check provided for every pair of elements in the lists.\n-- The provided SDoc should name the element type, in the plural.\ncheckListBy :: (a -> a -> Maybe SDoc) -> [a] -> [a] -> SDoc\n            -> Maybe SDoc\ncheckListBy check_fun as bs whats = go [] as bs\n  where\n    herald = text \"The\" <+> whats <+> text \"do not match\"\n\n    go []   [] [] = Nothing\n    go docs [] [] = Just (hang (herald <> colon) 2 (vcat $ reverse docs))\n    go docs (x:xs) (y:ys) = case check_fun x y of\n      Just doc -> go (doc:docs) xs ys\n      Nothing  -> go docs       xs ys\n    go _    _  _ = Just (hang (herald <> colon)\n                            2 (text \"There are different numbers of\" <+> whats))\n\n-- | If the test in the first parameter is True, succeed with @Nothing@;\n-- otherwise, fail with the given SDoc.\ncheck :: Bool -> SDoc -> Maybe SDoc\ncheck True  _   = Nothing\ncheck False doc = Just doc\n\n-- | A more perspicuous name for @Nothing@, for @checkBootDecl@ and friends.\ncheckSuccess :: Maybe SDoc\ncheckSuccess = Nothing\n\n----------------\ncheckBootTyCon :: Bool -> TyCon -> TyCon -> Maybe SDoc\ncheckBootTyCon is_boot tc1 tc2\n  | not (eqType (tyConKind tc1) (tyConKind tc2))\n  = Just $ text \"The types have different kinds\"    -- First off, check the kind\n\n  | Just c1 <- tyConClass_maybe tc1\n  , Just c2 <- tyConClass_maybe tc2\n  , let (clas_tvs1, clas_fds1, sc_theta1, _, ats1, op_stuff1)\n          = classExtraBigSig c1\n        (clas_tvs2, clas_fds2, sc_theta2, _, ats2, op_stuff2)\n          = classExtraBigSig c2\n  , Just env <- eqVarBndrs emptyRnEnv2 clas_tvs1 clas_tvs2\n  = let\n       eqSig (id1, def_meth1) (id2, def_meth2)\n         = check (name1 == name2)\n                 (text \"The names\" <+> pname1 <+> text \"and\" <+> pname2 <+>\n                  text \"are different\") `andThenCheck`\n           check (eqTypeX env op_ty1 op_ty2)\n                 (text \"The types of\" <+> pname1 <+>\n                  text \"are different\") `andThenCheck`\n           if is_boot\n               then check (eqMaybeBy eqDM def_meth1 def_meth2)\n                          (text \"The default methods associated with\" <+> pname1 <+>\n                           text \"are different\")\n               else check (subDM op_ty1 def_meth1 def_meth2)\n                          (text \"The default methods associated with\" <+> pname1 <+>\n                           text \"are not compatible\")\n         where\n          name1 = idName id1\n          name2 = idName id2\n          pname1 = quotes (ppr name1)\n          pname2 = quotes (ppr name2)\n          (_, rho_ty1) = splitForAllTys (idType id1)\n          op_ty1 = funResultTy rho_ty1\n          (_, rho_ty2) = splitForAllTys (idType id2)\n          op_ty2 = funResultTy rho_ty2\n\n       eqAT (ATI tc1 def_ats1) (ATI tc2 def_ats2)\n         = checkBootTyCon is_boot tc1 tc2 `andThenCheck`\n           check (eqATDef def_ats1 def_ats2)\n                 (text \"The associated type defaults differ\")\n\n       eqDM (_, VanillaDM)    (_, VanillaDM)    = True\n       eqDM (_, GenericDM t1) (_, GenericDM t2) = eqTypeX env t1 t2\n       eqDM _ _ = False\n\n       -- NB: first argument is from hsig, second is from real impl.\n       -- Order of pattern matching matters.\n       subDM _ Nothing _ = True\n       subDM _ _ Nothing = False\n       -- If the hsig wrote:\n       --\n       --   f :: a -> a\n       --   default f :: a -> a\n       --\n       -- this should be validly implementable using an old-fashioned\n       -- vanilla default method.\n       subDM t1 (Just (_, GenericDM t2)) (Just (_, VanillaDM))\n        = eqTypeX env t1 t2\n       -- This case can occur when merging signatures\n       subDM t1 (Just (_, VanillaDM)) (Just (_, GenericDM t2))\n        = eqTypeX env t1 t2\n       subDM _ (Just (_, VanillaDM)) (Just (_, VanillaDM)) = True\n       subDM _ (Just (_, GenericDM t1)) (Just (_, GenericDM t2))\n        = eqTypeX env t1 t2\n\n       -- Ignore the location of the defaults\n       eqATDef Nothing             Nothing             = True\n       eqATDef (Just (ty1, _loc1)) (Just (ty2, _loc2)) = eqTypeX env ty1 ty2\n       eqATDef _ _ = False\n\n       eqFD (as1,bs1) (as2,bs2) =\n         eqListBy (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) &&\n         eqListBy (eqTypeX env) (mkTyVarTys bs1) (mkTyVarTys bs2)\n    in\n    checkRoles roles1 roles2 `andThenCheck`\n          -- Checks kind of class\n    check (eqListBy eqFD clas_fds1 clas_fds2)\n          (text \"The functional dependencies do not match\") `andThenCheck`\n    checkUnless (isAbstractTyCon tc1) $\n    check (eqListBy (eqTypeX env) sc_theta1 sc_theta2)\n          (text \"The class constraints do not match\") `andThenCheck`\n    checkListBy eqSig op_stuff1 op_stuff2 (text \"methods\") `andThenCheck`\n    checkListBy eqAT ats1 ats2 (text \"associated types\") `andThenCheck`\n    check (classMinimalDef c1 `BF.implies` classMinimalDef c2)\n        (text \"The MINIMAL pragmas are not compatible\")\n\n  | Just syn_rhs1 <- synTyConRhs_maybe tc1\n  , Just syn_rhs2 <- synTyConRhs_maybe tc2\n  , Just env <- eqVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2)\n  = ASSERT(tc1 == tc2)\n    checkRoles roles1 roles2 `andThenCheck`\n    check (eqTypeX env syn_rhs1 syn_rhs2) empty   -- nothing interesting to say\n  -- This allows abstract 'data T a' to be implemented using 'type T = ...'\n  -- and abstract 'class K a' to be implement using 'type K = ...'\n  -- See Note [Synonyms implement abstract data]\n  | not is_boot -- don't support for hs-boot yet\n  , isAbstractTyCon tc1\n  , Just (tvs, ty) <- synTyConDefn_maybe tc2\n  , Just (tc2', args) <- tcSplitTyConApp_maybe ty\n  = checkSynAbsData tvs ty tc2' args\n    -- TODO: When it's a synonym implementing a class, we really\n    -- should check if the fundeps are satisfied, but\n    -- there is not an obvious way to do this for a constraint synonym.\n    -- So for now, let it all through (it won't cause segfaults, anyway).\n    -- Tracked at #12704.\n\n  -- This allows abstract 'data T :: Nat' to be implemented using\n  -- 'type T = 42' Since the kinds already match (we have checked this\n  -- upfront) all we need to check is that the implementation 'type T\n  -- = ...' defined an actual literal.  See #15138 for the case this\n  -- handles.\n  | not is_boot\n  , isAbstractTyCon tc1\n  , Just (_,ty2) <- synTyConDefn_maybe tc2\n  , isJust (isLitTy ty2)\n  = Nothing\n\n  | Just fam_flav1 <- famTyConFlav_maybe tc1\n  , Just fam_flav2 <- famTyConFlav_maybe tc2\n  = ASSERT(tc1 == tc2)\n    let eqFamFlav OpenSynFamilyTyCon   OpenSynFamilyTyCon = True\n        eqFamFlav (DataFamilyTyCon {}) (DataFamilyTyCon {}) = True\n        -- This case only happens for hsig merging:\n        eqFamFlav AbstractClosedSynFamilyTyCon AbstractClosedSynFamilyTyCon = True\n        eqFamFlav AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) = True\n        eqFamFlav (ClosedSynFamilyTyCon {}) AbstractClosedSynFamilyTyCon = True\n        eqFamFlav (ClosedSynFamilyTyCon ax1) (ClosedSynFamilyTyCon ax2)\n            = eqClosedFamilyAx ax1 ax2\n        eqFamFlav (BuiltInSynFamTyCon {}) (BuiltInSynFamTyCon {}) = tc1 == tc2\n        eqFamFlav _ _ = False\n        injInfo1 = tyConInjectivityInfo tc1\n        injInfo2 = tyConInjectivityInfo tc2\n    in\n    -- check equality of roles, family flavours and injectivity annotations\n    -- (NB: Type family roles are always nominal. But the check is\n    -- harmless enough.)\n    checkRoles roles1 roles2 `andThenCheck`\n    check (eqFamFlav fam_flav1 fam_flav2)\n        (whenPprDebug $\n            text \"Family flavours\" <+> ppr fam_flav1 <+> text \"and\" <+> ppr fam_flav2 <+>\n            text \"do not match\") `andThenCheck`\n    check (injInfo1 == injInfo2) (text \"Injectivities do not match\")\n\n  | isAlgTyCon tc1 && isAlgTyCon tc2\n  , Just env <- eqVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2)\n  = ASSERT(tc1 == tc2)\n    checkRoles roles1 roles2 `andThenCheck`\n    check (eqListBy (eqTypeX env)\n                     (tyConStupidTheta tc1) (tyConStupidTheta tc2))\n          (text \"The datatype contexts do not match\") `andThenCheck`\n    eqAlgRhs tc1 (algTyConRhs tc1) (algTyConRhs tc2)\n\n  | otherwise = Just empty   -- two very different types -- should be obvious\n  where\n    roles1 = tyConRoles tc1 -- the abstract one\n    roles2 = tyConRoles tc2\n    roles_msg = text \"The roles do not match.\" $$\n                (text \"Roles on abstract types default to\" <+>\n                 quotes (text \"representational\") <+> text \"in boot files.\")\n\n    roles_subtype_msg = text \"The roles are not compatible:\" $$\n                        text \"Main module:\" <+> ppr roles2 $$\n                        text \"Hsig file:\" <+> ppr roles1\n\n    checkRoles r1 r2\n      | is_boot || isInjectiveTyCon tc1 Representational -- See Note [Role subtyping]\n      = check (r1 == r2) roles_msg\n      | otherwise = check (r2 `rolesSubtypeOf` r1) roles_subtype_msg\n\n    -- Note [Role subtyping]\n    -- ~~~~~~~~~~~~~~~~~~~~~\n    -- In the current formulation of roles, role subtyping is only OK if the\n    -- \"abstract\" TyCon was not representationally injective.  Among the most\n    -- notable examples of non representationally injective TyCons are abstract\n    -- data, which can be implemented via newtypes (which are not\n    -- representationally injective).  The key example is\n    -- in this example from #13140:\n    --\n    --      -- In an hsig file\n    --      data T a -- abstract!\n    --      type role T nominal\n    --\n    --      -- Elsewhere\n    --      foo :: Coercible (T a) (T b) => a -> b\n    --      foo x = x\n    --\n    -- We must NOT allow foo to typecheck, because if we instantiate\n    -- T with a concrete data type with a phantom role would cause\n    -- Coercible (T a) (T b) to be provable.  Fortunately, if T is not\n    -- representationally injective, we cannot make the inference that a ~N b if\n    -- T a ~R T b.\n    --\n    -- Unconditional role subtyping would be possible if we setup\n    -- an extra set of roles saying when we can project out coercions\n    -- (we call these proj-roles); then it would NOT be valid to instantiate T\n    -- with a data type at phantom since the proj-role subtyping check\n    -- would fail.  See #13140 for more details.\n    --\n    -- One consequence of this is we get no role subtyping for non-abstract\n    -- data types in signatures. Suppose you have:\n    --\n    --      signature A where\n    --          type role T nominal\n    --          data T a = MkT\n    --\n    -- If you write this, we'll treat T as injective, and make inferences\n    -- like T a ~R T b ==> a ~N b (mkNthCo).  But if we can\n    -- subsequently replace T with one at phantom role, we would then be able to\n    -- infer things like T Int ~R T Bool which is bad news.\n    --\n    -- We could allow role subtyping here if we didn't treat *any* data types\n    -- defined in signatures as injective.  But this would be a bit surprising,\n    -- replacing a data type in a module with one in a signature could cause\n    -- your code to stop typechecking (whereas if you made the type abstract,\n    -- it is more understandable that the type checker knows less).\n    --\n    -- It would have been best if this was purely a question of defaults\n    -- (i.e., a user could explicitly ask for one behavior or another) but\n    -- the current role system isn't expressive enough to do this.\n    -- Having explict proj-roles would solve this problem.\n\n    rolesSubtypeOf [] [] = True\n    -- NB: this relation is the OPPOSITE of the subroling relation\n    rolesSubtypeOf (x:xs) (y:ys) = x >= y && rolesSubtypeOf xs ys\n    rolesSubtypeOf _ _ = False\n\n    -- Note [Synonyms implement abstract data]\n    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    -- An abstract data type or class can be implemented using a type synonym,\n    -- but ONLY if the type synonym is nullary and has no type family\n    -- applications.  This arises from two properties of skolem abstract data:\n    --\n    --    For any T (with some number of paramaters),\n    --\n    --    1. T is a valid type (it is \"curryable\"), and\n    --\n    --    2. T is valid in an instance head (no type families).\n    --\n    -- See also 'HowAbstract' and Note [Skolem abstract data].\n\n    -- | Given @type T tvs = ty@, where @ty@ decomposes into @tc2' args@,\n    -- check that this synonym is an acceptable implementation of @tc1@.\n    -- See Note [Synonyms implement abstract data]\n    checkSynAbsData :: [TyVar] -> Type -> TyCon -> [Type] -> Maybe SDoc\n    checkSynAbsData tvs ty tc2' args =\n        check (null (tcTyFamInsts ty))\n              (text \"Illegal type family application in implementation of abstract data.\")\n                `andThenCheck`\n        check (null tvs)\n              (text \"Illegal parameterized type synonym in implementation of abstract data.\" $$\n               text \"(Try eta reducing your type synonym so that it is nullary.)\")\n                `andThenCheck`\n        -- Don't report roles errors unless the type synonym is nullary\n        checkUnless (not (null tvs)) $\n            ASSERT( null roles2 )\n            -- If we have something like:\n            --\n            --  signature H where\n            --      data T a\n            --  module H where\n            --      data K a b = ...\n            --      type T = K Int\n            --\n            -- we need to drop the first role of K when comparing!\n            checkRoles roles1 (drop (length args) (tyConRoles tc2'))\n{-\n        -- Hypothetically, if we were allow to non-nullary type synonyms, here\n        -- is how you would check the roles\n        if length tvs == length roles1\n            then checkRoles roles1 roles2\n            else case tcSplitTyConApp_maybe ty of\n                    Just (tc2', args) ->\n                        checkRoles roles1 (drop (length args) (tyConRoles tc2') ++ roles2)\n                    Nothing -> Just roles_msg\n-}\n\n    eqAlgRhs _ AbstractTyCon _rhs2\n      = checkSuccess -- rhs2 is guaranteed to be injective, since it's an AlgTyCon\n    eqAlgRhs _  tc1@DataTyCon{} tc2@DataTyCon{} =\n        checkListBy eqCon (data_cons tc1) (data_cons tc2) (text \"constructors\")\n    eqAlgRhs _  tc1@NewTyCon{} tc2@NewTyCon{} =\n        eqCon (data_con tc1) (data_con tc2)\n    eqAlgRhs _ _ _ = Just (text \"Cannot match a\" <+> quotes (text \"data\") <+>\n                           text \"definition with a\" <+> quotes (text \"newtype\") <+>\n                           text \"definition\")\n\n    eqCon c1 c2\n      =  check (name1 == name2)\n               (text \"The names\" <+> pname1 <+> text \"and\" <+> pname2 <+>\n                text \"differ\") `andThenCheck`\n         check (dataConIsInfix c1 == dataConIsInfix c2)\n               (text \"The fixities of\" <+> pname1 <+>\n                text \"differ\") `andThenCheck`\n         check (eqListBy eqHsBang (dataConImplBangs c1) (dataConImplBangs c2))\n               (text \"The strictness annotations for\" <+> pname1 <+>\n                text \"differ\") `andThenCheck`\n         check (map flSelector (dataConFieldLabels c1) == map flSelector (dataConFieldLabels c2))\n               (text \"The record label lists for\" <+> pname1 <+>\n                text \"differ\") `andThenCheck`\n         check (eqType (dataConUserType c1) (dataConUserType c2))\n               (text \"The types for\" <+> pname1 <+> text \"differ\")\n      where\n        name1 = dataConName c1\n        name2 = dataConName c2\n        pname1 = quotes (ppr name1)\n        pname2 = quotes (ppr name2)\n\n    eqClosedFamilyAx Nothing Nothing  = True\n    eqClosedFamilyAx Nothing (Just _) = False\n    eqClosedFamilyAx (Just _) Nothing = False\n    eqClosedFamilyAx (Just (CoAxiom { co_ax_branches = branches1 }))\n                     (Just (CoAxiom { co_ax_branches = branches2 }))\n      =  numBranches branches1 == numBranches branches2\n      && (and $ zipWith eqClosedFamilyBranch branch_list1 branch_list2)\n      where\n        branch_list1 = fromBranches branches1\n        branch_list2 = fromBranches branches2\n\n    eqClosedFamilyBranch (CoAxBranch { cab_tvs = tvs1, cab_cvs = cvs1\n                                     , cab_lhs = lhs1, cab_rhs = rhs1 })\n                         (CoAxBranch { cab_tvs = tvs2, cab_cvs = cvs2\n                                     , cab_lhs = lhs2, cab_rhs = rhs2 })\n      | Just env1 <- eqVarBndrs emptyRnEnv2 tvs1 tvs2\n      , Just env  <- eqVarBndrs env1        cvs1 cvs2\n      = eqListBy (eqTypeX env) lhs1 lhs2 &&\n        eqTypeX env rhs1 rhs2\n\n      | otherwise = False\n\nemptyRnEnv2 :: RnEnv2\nemptyRnEnv2 = mkRnEnv2 emptyInScopeSet\n\n----------------\nmissingBootThing :: Bool -> Name -> String -> SDoc\nmissingBootThing is_boot name what\n  = quotes (ppr name) <+> text \"is exported by the\"\n    <+> (if is_boot then text \"hs-boot\" else text \"hsig\")\n    <+> text \"file, but not\"\n    <+> text what <+> text \"the module\"\n\nbadReexportedBootThing :: DynFlags -> Bool -> Name -> Name -> SDoc\nbadReexportedBootThing dflags is_boot name name'\n  = withPprStyle (mkUserStyle dflags alwaysQualify AllTheWay) $ vcat\n        [ text \"The\" <+> (if is_boot then text \"hs-boot\" else text \"hsig\")\n           <+> text \"file (re)exports\" <+> quotes (ppr name)\n        , text \"but the implementing module exports a different identifier\" <+> quotes (ppr name')\n        ]\n\nbootMisMatch :: Bool -> SDoc -> TyThing -> TyThing -> SDoc\nbootMisMatch is_boot extra_info real_thing boot_thing\n  = pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc\n  where\n    to_doc\n      = pprTyThingInContext $ showToHeader { ss_forall =\n                                              if is_boot\n                                                then ShowForAllMust\n                                                else ShowForAllWhen }\n\n    real_doc = to_doc real_thing\n    boot_doc = to_doc boot_thing\n\n    pprBootMisMatch :: Bool -> SDoc -> TyThing -> SDoc -> SDoc -> SDoc\n    pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc\n      = vcat\n          [ ppr real_thing <+>\n            text \"has conflicting definitions in the module\",\n            text \"and its\" <+>\n              (if is_boot\n                then text \"hs-boot file\"\n                else text \"hsig file\"),\n            text \"Main module:\" <+> real_doc,\n              (if is_boot\n                then text \"Boot file:  \"\n                else text \"Hsig file: \")\n                <+> boot_doc,\n            extra_info\n          ]\n\ninstMisMatch :: DFunId -> SDoc\ninstMisMatch dfun\n  = hang (text \"instance\" <+> ppr (idType dfun))\n       2 (text \"is defined in the hs-boot file, but not in the module itself\")\n\n{-\n************************************************************************\n*                                                                      *\n        Type-checking the top level of a module (continued)\n*                                                                      *\n************************************************************************\n-}\n\nrnTopSrcDecls :: HsGroup GhcPs -> TcM (TcGblEnv, HsGroup GhcRn)\n-- Fails if there are any errors\nrnTopSrcDecls group\n = do { -- Rename the source decls\n        traceRn \"rn12\" empty ;\n        (tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls group ;\n        traceRn \"rn13\" empty ;\n        (tcg_env, rn_decls) <- runRenamerPlugin tcg_env rn_decls ;\n        traceRn \"rn13-plugin\" empty ;\n\n        -- save the renamed syntax, if we want it\n        let { tcg_env'\n                | Just grp <- tcg_rn_decls tcg_env\n                  = tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }\n                | otherwise\n                   = tcg_env };\n\n                -- Dump trace of renaming part\n        rnDump rn_decls ;\n        return (tcg_env', rn_decls)\n   }\n\ntcTopSrcDecls :: HsGroup GhcRn -> TcM (TcGblEnv, TcLclEnv)\ntcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,\n                         hs_derivds = deriv_decls,\n                         hs_fords  = foreign_decls,\n                         hs_defds  = default_decls,\n                         hs_annds  = annotation_decls,\n                         hs_ruleds = rule_decls,\n                         hs_valds  = hs_val_binds@(XValBindsLR\n                                              (NValBinds val_binds val_sigs)) })\n = do {         -- Type-check the type and class decls, and all imported decls\n                -- The latter come in via tycl_decls\n        traceTc \"Tc2 (src)\" empty ;\n\n                -- Source-language instances, including derivings,\n                -- and import the supporting declarations\n        traceTc \"Tc3\" empty ;\n        (tcg_env, inst_infos, XValBindsLR (NValBinds deriv_binds deriv_sigs))\n            <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ;\n\n        setGblEnv tcg_env       $ do {\n\n                -- Generate Applicative/Monad proposal (AMP) warnings\n        traceTc \"Tc3b\" empty ;\n\n                -- Generate Semigroup/Monoid warnings\n        traceTc \"Tc3c\" empty ;\n        tcSemigroupWarnings ;\n\n                -- Foreign import declarations next.\n        traceTc \"Tc4\" empty ;\n        (fi_ids, fi_decls, fi_gres) <- tcForeignImports foreign_decls ;\n        tcExtendGlobalValEnv fi_ids     $ do {\n\n                -- Default declarations\n        traceTc \"Tc4a\" empty ;\n        default_tys <- tcDefaults default_decls ;\n        updGblEnv (\\gbl -> gbl { tcg_default = default_tys }) $ do {\n\n                -- Value declarations next.\n                -- It is important that we check the top-level value bindings\n                -- before the GHC-generated derived bindings, since the latter\n                -- may be defined in terms of the former. (For instance,\n                -- the bindings produced in a Data instance.)\n        traceTc \"Tc5\" empty ;\n        tc_envs <- tcTopBinds val_binds val_sigs;\n        setEnvs tc_envs $ do {\n\n                -- Now GHC-generated derived bindings, generics, and selectors\n                -- Do not generate warnings from compiler-generated code;\n                -- hence the use of discardWarnings\n        tc_envs@(tcg_env, tcl_env)\n            <- discardWarnings (tcTopBinds deriv_binds deriv_sigs) ;\n        setEnvs tc_envs $ do {  -- Environment doesn't change now\n\n                -- Second pass over class and instance declarations,\n                -- now using the kind-checked decls\n        traceTc \"Tc6\" empty ;\n        inst_binds <- tcInstDecls2 (tyClGroupTyClDecls tycl_decls) inst_infos ;\n\n                -- Foreign exports\n        traceTc \"Tc7\" empty ;\n        (foe_binds, foe_decls, foe_gres) <- tcForeignExports foreign_decls ;\n\n                -- Annotations\n        annotations <- tcAnnotations annotation_decls ;\n\n                -- Rules\n        rules <- tcRules rule_decls ;\n\n                -- Wrap up\n        traceTc \"Tc7a\" empty ;\n        let { all_binds = inst_binds     `unionBags`\n                          foe_binds\n\n            ; fo_gres = fi_gres `unionBags` foe_gres\n            ; fo_fvs = foldrBag (\\gre fvs -> fvs `addOneFV` gre_name gre)\n                                emptyFVs fo_gres\n\n            ; sig_names = mkNameSet (collectHsValBinders hs_val_binds)\n                          `minusNameSet` getTypeSigNames val_sigs\n\n                -- Extend the GblEnv with the (as yet un-zonked)\n                -- bindings, rules, foreign decls\n            ; tcg_env' = tcg_env { tcg_binds   = tcg_binds tcg_env `unionBags` all_binds\n                                 , tcg_sigs    = tcg_sigs tcg_env `unionNameSet` sig_names\n                                 , tcg_rules   = tcg_rules tcg_env\n                                                      ++ flattenRuleDecls rules\n                                 , tcg_anns    = tcg_anns tcg_env ++ annotations\n                                 , tcg_ann_env = extendAnnEnvList (tcg_ann_env tcg_env) annotations\n                                 , tcg_fords   = tcg_fords tcg_env ++ foe_decls ++ fi_decls\n                                 , tcg_dus     = tcg_dus tcg_env `plusDU` usesOnly fo_fvs } } ;\n                                 -- tcg_dus: see Note [Newtype constructor usage in foreign declarations]\n\n        -- See Note [Newtype constructor usage in foreign declarations]\n        addUsedGREs (bagToList fo_gres) ;\n\n        return (tcg_env', tcl_env)\n    }}}}}}\n\ntcTopSrcDecls _ = panic \"tcTopSrcDecls: ValBindsIn\"\n\n\ntcSemigroupWarnings :: TcM ()\ntcSemigroupWarnings = do\n    traceTc \"tcSemigroupWarnings\" empty\n    let warnFlag = Opt_WarnSemigroup\n    tcPreludeClashWarn warnFlag sappendName\n    tcMissingParentClassWarn warnFlag monoidClassName semigroupClassName\n\n\n-- | Warn on local definitions of names that would clash with future Prelude\n-- elements.\n--\n--   A name clashes if the following criteria are met:\n--       1. It would is imported (unqualified) from Prelude\n--       2. It is locally defined in the current module\n--       3. It has the same literal name as the reference function\n--       4. It is not identical to the reference function\ntcPreludeClashWarn :: WarningFlag\n                   -> Name\n                   -> TcM ()\ntcPreludeClashWarn warnFlag name = do\n    { warn <- woptM warnFlag\n    ; when warn $ do\n    { traceTc \"tcPreludeClashWarn/wouldBeImported\" empty\n    -- Is the name imported (unqualified) from Prelude? (Point 4 above)\n    ; rnImports <- fmap (map unLoc . tcg_rn_imports) getGblEnv\n    -- (Note that this automatically handles -XNoImplicitPrelude, as Prelude\n    -- will not appear in rnImports automatically if it is set.)\n\n    -- Continue only the name is imported from Prelude\n    ; when (importedViaPrelude name rnImports) $ do\n      -- Handle 2.-4.\n    { rdrElts <- fmap (concat . occEnvElts . tcg_rdr_env) getGblEnv\n\n    ; let clashes :: GlobalRdrElt -> Bool\n          clashes x = isLocalDef && nameClashes && isNotInProperModule\n            where\n              isLocalDef = gre_lcl x == True\n              -- Names are identical ...\n              nameClashes = nameOccName (gre_name x) == nameOccName name\n              -- ... but not the actual definitions, because we don't want to\n              -- warn about a bad definition of e.g. <> in Data.Semigroup, which\n              -- is the (only) proper place where this should be defined\n              isNotInProperModule = gre_name x /= name\n\n          -- List of all offending definitions\n          clashingElts :: [GlobalRdrElt]\n          clashingElts = filter clashes rdrElts\n\n    ; traceTc \"tcPreludeClashWarn/prelude_functions\"\n                (hang (ppr name) 4 (sep [ppr clashingElts]))\n\n    ; let warn_msg x = addWarnAt (Reason warnFlag) (nameSrcSpan (gre_name x)) (hsep\n              [ text \"Local definition of\"\n              , (quotes . ppr . nameOccName . gre_name) x\n              , text \"clashes with a future Prelude name.\" ]\n              $$\n              text \"This will become an error in a future release.\" )\n    ; mapM_ warn_msg clashingElts\n    }}}\n\n  where\n\n    -- Is the given name imported via Prelude?\n    --\n    -- Possible scenarios:\n    --   a) Prelude is imported implicitly, issue warnings.\n    --   b) Prelude is imported explicitly, but without mentioning the name in\n    --      question. Issue no warnings.\n    --   c) Prelude is imported hiding the name in question. Issue no warnings.\n    --   d) Qualified import of Prelude, no warnings.\n    importedViaPrelude :: Name\n                       -> [ImportDecl GhcRn]\n                       -> Bool\n    importedViaPrelude name = any importViaPrelude\n      where\n        isPrelude :: ImportDecl GhcRn -> Bool\n        isPrelude imp = unLoc (ideclName imp) == pRELUDE_NAME\n\n        -- Implicit (Prelude) import?\n        isImplicit :: ImportDecl GhcRn -> Bool\n        isImplicit = ideclImplicit\n\n        -- Unqualified import?\n        isUnqualified :: ImportDecl GhcRn -> Bool\n        isUnqualified = not . ideclQualified\n\n        -- List of explicitly imported (or hidden) Names from a single import.\n        --   Nothing -> No explicit imports\n        --   Just (False, <names>) -> Explicit import list of <names>\n        --   Just (True , <names>) -> Explicit hiding of <names>\n        importListOf :: ImportDecl GhcRn -> Maybe (Bool, [Name])\n        importListOf = fmap toImportList . ideclHiding\n          where\n            toImportList (h, loc) = (h, map (ieName . unLoc) (unLoc loc))\n\n        isExplicit :: ImportDecl GhcRn -> Bool\n        isExplicit x = case importListOf x of\n            Nothing -> False\n            Just (False, explicit)\n                -> nameOccName name `elem`    map nameOccName explicit\n            Just (True, hidden)\n                -> nameOccName name `notElem` map nameOccName hidden\n\n        -- Check whether the given name would be imported (unqualified) from\n        -- an import declaration.\n        importViaPrelude :: ImportDecl GhcRn -> Bool\n        importViaPrelude x = isPrelude x\n                          && isUnqualified x\n                          && (isImplicit x || isExplicit x)\n\n\n-- Notation: is* is for classes the type is an instance of, should* for those\n--           that it should also be an instance of based on the corresponding\n--           is*.\ntcMissingParentClassWarn :: WarningFlag\n                         -> Name -- ^ Instances of this ...\n                         -> Name -- ^ should also be instances of this\n                         -> TcM ()\ntcMissingParentClassWarn warnFlag isName shouldName\n  = do { warn <- woptM warnFlag\n       ; when warn $ do\n       { traceTc \"tcMissingParentClassWarn\" empty\n       ; isClass'     <- tcLookupClass_maybe isName\n       ; shouldClass' <- tcLookupClass_maybe shouldName\n       ; case (isClass', shouldClass') of\n              (Just isClass, Just shouldClass) -> do\n                  { localInstances <- tcGetInsts\n                  ; let isInstance m = is_cls m == isClass\n                        isInsts = filter isInstance localInstances\n                  ; traceTc \"tcMissingParentClassWarn/isInsts\" (ppr isInsts)\n                  ; forM_ isInsts (checkShouldInst isClass shouldClass)\n                  }\n              (is',should') ->\n                  traceTc \"tcMissingParentClassWarn/notIsShould\"\n                          (hang (ppr isName <> text \"/\" <> ppr shouldName) 2 (\n                            (hsep [ quotes (text \"Is\"), text \"lookup for\"\n                                  , ppr isName\n                                  , text \"resulted in\", ppr is' ])\n                            $$\n                            (hsep [ quotes (text \"Should\"), text \"lookup for\"\n                                  , ppr shouldName\n                                  , text \"resulted in\", ppr should' ])))\n       }}\n  where\n    -- Check whether the desired superclass exists in a given environment.\n    checkShouldInst :: Class   -- ^ Class of existing instance\n                    -> Class   -- ^ Class there should be an instance of\n                    -> ClsInst -- ^ Existing instance\n                    -> TcM ()\n    checkShouldInst isClass shouldClass isInst\n      = do { instEnv <- tcGetInstEnvs\n           ; let (instanceMatches, shouldInsts, _)\n                    = lookupInstEnv False instEnv shouldClass (is_tys isInst)\n\n           ; traceTc \"tcMissingParentClassWarn/checkShouldInst\"\n                     (hang (ppr isInst) 4\n                         (sep [ppr instanceMatches, ppr shouldInsts]))\n\n           -- \"<location>: Warning: <type> is an instance of <is> but not\n           -- <should>\" e.g. \"Foo is an instance of Monad but not Applicative\"\n           ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst\n                 warnMsg (Just name:_) =\n                      addWarnAt (Reason warnFlag) instLoc $\n                           hsep [ (quotes . ppr . nameOccName) name\n                                , text \"is an instance of\"\n                                , (ppr . nameOccName . className) isClass\n                                , text \"but not\"\n                                , (ppr . nameOccName . className) shouldClass ]\n                                <> text \".\"\n                           $$\n                           hsep [ text \"This will become an error in\"\n                                , text \"a future release.\" ]\n                 warnMsg _ = pure ()\n           ; when (null shouldInsts && null instanceMatches) $\n                  warnMsg (is_tcs isInst)\n           }\n\n    tcLookupClass_maybe :: Name -> TcM (Maybe Class)\n    tcLookupClass_maybe name = tcLookupImported_maybe name >>= \\case\n        Succeeded (ATyCon tc) | cls@(Just _) <- tyConClass_maybe tc -> pure cls\n        _else -> pure Nothing\n\n\n---------------------------\ntcTyClsInstDecls :: [TyClGroup GhcRn]\n                 -> [LDerivDecl GhcRn]\n                 -> [(RecFlag, LHsBinds GhcRn)]\n                 -> TcM (TcGblEnv,            -- The full inst env\n                         [InstInfo GhcRn],    -- Source-code instance decls to\n                                              -- process; contains all dfuns for\n                                              -- this module\n                          HsValBinds GhcRn)   -- Supporting bindings for derived\n                                              -- instances\n\ntcTyClsInstDecls tycl_decls deriv_decls binds\n = tcAddDataFamConPlaceholders (tycl_decls >>= group_instds) $\n   tcAddPatSynPlaceholders (getPatSynBinds binds) $\n   do { (tcg_env, inst_info, datafam_deriv_info)\n          <- tcTyAndClassDecls tycl_decls ;\n      ; setGblEnv tcg_env $ do {\n          -- With the @TyClDecl@s and @InstDecl@s checked we're ready to\n          -- process the deriving clauses, including data family deriving\n          -- clauses discovered in @tcTyAndClassDecls@.\n          --\n          -- Careful to quit now in case there were instance errors, so that\n          -- the deriving errors don't pile up as well.\n          ; failIfErrsM\n          ; let tyclds = tycl_decls >>= group_tyclds\n          ; (tcg_env', inst_info', val_binds)\n              <- tcInstDeclsDeriv datafam_deriv_info tyclds deriv_decls\n          ; setGblEnv tcg_env' $ do {\n                failIfErrsM\n              ; pure (tcg_env', inst_info' ++ inst_info, val_binds)\n      }}}\n\n{- *********************************************************************\n*                                                                      *\n        Checking for 'main'\n*                                                                      *\n************************************************************************\n-}\n\ncheckMain :: Bool  -- False => no 'module M(..) where' header at all\n          -> TcM TcGblEnv\n-- If we are in module Main, check that 'main' is defined.\ncheckMain explicit_mod_hdr\n = do   { dflags  <- getDynFlags\n        ; tcg_env <- getGblEnv\n        ; check_main dflags tcg_env explicit_mod_hdr }\n\ncheck_main :: DynFlags -> TcGblEnv -> Bool -> TcM TcGblEnv\ncheck_main dflags tcg_env explicit_mod_hdr\n | mod /= main_mod\n = traceTc \"checkMain not\" (ppr main_mod <+> ppr mod) >>\n   return tcg_env\n\n | otherwise\n = do   { mb_main <- lookupGlobalOccRn_maybe main_fn\n                -- Check that 'main' is in scope\n                -- It might be imported from another module!\n        ; case mb_main of {\n             Nothing -> do { traceTc \"checkMain fail\" (ppr main_mod <+> ppr main_fn)\n                           ; complain_no_main\n                           ; return tcg_env } ;\n             Just main_name -> do\n\n        { traceTc \"checkMain found\" (ppr main_mod <+> ppr main_fn)\n        ; let loc       = srcLocSpan (getSrcLoc main_name)\n        ; ioTyCon <- tcLookupTyCon ioTyConName\n        ; res_ty <- newFlexiTyVarTy liftedTypeKind\n        ; let io_ty = mkTyConApp ioTyCon [res_ty]\n              skol_info = SigSkol (FunSigCtxt main_name False) io_ty []\n        ; (ev_binds, main_expr)\n               <- checkConstraints skol_info [] [] $\n                  addErrCtxt mainCtxt    $\n                  tcMonoExpr (cL loc (HsVar noExt (cL loc main_name)))\n                             (mkCheckExpType io_ty)\n\n                -- See Note [Root-main Id]\n                -- Construct the binding\n                --      :Main.main :: IO res_ty = runMainIO res_ty main\n        ; run_main_id <- tcLookupId runMainIOName\n        ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN\n                                   (mkVarOccFS (fsLit \"main\"))\n                                   (getSrcSpan main_name)\n              ; root_main_id = Id.mkExportedVanillaId root_main_name\n                                                      (mkTyConApp ioTyCon [res_ty])\n              ; co  = mkWpTyApps [res_ty]\n              -- The ev_binds of the `main` function may contain deferred\n              -- type error when type of `main` is not `IO a`. The `ev_binds`\n              -- must be put inside `runMainIO` to ensure the deferred type\n              -- error can be emitted correctly. See Trac #13838.\n              ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) $\n                        mkHsDictLet ev_binds main_expr\n              ; main_bind = mkVarBind root_main_id rhs }\n\n        ; return (tcg_env { tcg_main  = Just main_name,\n                            tcg_binds = tcg_binds tcg_env\n                                        `snocBag` main_bind,\n                            tcg_dus   = tcg_dus tcg_env\n                                        `plusDU` usesOnly (unitFV main_name)\n                        -- Record the use of 'main', so that we don't\n                        -- complain about it being defined but not used\n                 })\n    }}}\n  where\n    mod         = tcg_mod tcg_env\n    main_mod    = mainModIs dflags\n    main_fn     = getMainFun dflags\n    interactive = ghcLink dflags == LinkInMemory\n\n    complain_no_main = unless (interactive && not explicit_mod_hdr)\n                              (addErrTc noMainMsg)                  -- #12906\n        -- Without an explicit module header...\n          -- in interactive mode, don't worry about the absence of 'main'.\n          -- in other modes, add error message and go on with typechecking.\n\n    mainCtxt  = text \"When checking the type of the\" <+> pp_main_fn\n    noMainMsg = text \"The\" <+> pp_main_fn\n                <+> text \"is not defined in module\" <+> quotes (ppr main_mod)\n    pp_main_fn = ppMainFn main_fn\n\n-- | Get the unqualified name of the function to use as the \\\"main\\\" for the main module.\n-- Either returns the default name or the one configured on the command line with -main-is\ngetMainFun :: DynFlags -> RdrName\ngetMainFun dflags = case mainFunIs dflags of\n                      Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))\n                      Nothing -> main_RDR_Unqual\n\n-- If we are in module Main, check that 'main' is exported.\ncheckMainExported :: TcGblEnv -> TcM ()\ncheckMainExported tcg_env\n  = case tcg_main tcg_env of\n      Nothing -> return () -- not the main module\n      Just main_name ->\n         do { dflags <- getDynFlags\n            ; let main_mod = mainModIs dflags\n            ; when (ghcLink dflags /= LinkInMemory) $      -- #11647\n                checkTc (main_name `elem`\n                           concatMap availNames (tcg_exports tcg_env)) $\n                   text \"The\" <+> ppMainFn (nameRdrName main_name) <+>\n                   text \"is not exported by module\" <+> quotes (ppr main_mod) }\n\nppMainFn :: RdrName -> SDoc\nppMainFn main_fn\n  | rdrNameOcc main_fn == mainOcc\n  = text \"IO action\" <+> quotes (ppr main_fn)\n  | otherwise\n  = text \"main IO action\" <+> quotes (ppr main_fn)\n\nmainOcc :: OccName\nmainOcc = mkVarOccFS (fsLit \"main\")\n\n{-\nNote [Root-main Id]\n~~~~~~~~~~~~~~~~~~~\nThe function that the RTS invokes is always :Main.main, which we call\nroot_main_id.  (Because GHC allows the user to have a module not\ncalled Main as the main module, we can't rely on the main function\nbeing called \"Main.main\".  That's why root_main_id has a fixed module\n\":Main\".)\n\nThis is unusual: it's a LocalId whose Name has a Module from another\nmodule.  Tiresomely, we must filter it out again in MkIface, les we\nget two defns for 'main' in the interface file!\n\n\n*********************************************************\n*                                                       *\n                GHCi stuff\n*                                                       *\n*********************************************************\n-}\n\nrunTcInteractive :: HscEnv -> TcRn a -> IO (Messages, Maybe a)\n-- Initialise the tcg_inst_env with instances from all home modules.\n-- This mimics the more selective call to hptInstances in tcRnImports\nrunTcInteractive hsc_env thing_inside\n  = initTcInteractive hsc_env $ withTcPlugins hsc_env $\n    do { traceTc \"setInteractiveContext\" $\n            vcat [ text \"ic_tythings:\" <+> vcat (map ppr (ic_tythings icxt))\n                 , text \"ic_insts:\" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts)\n                 , text \"ic_rn_gbl_env (LocalDef)\" <+>\n                      vcat (map ppr [ local_gres | gres <- occEnvElts (ic_rn_gbl_env icxt)\n                                                 , let local_gres = filter isLocalGRE gres\n                                                 , not (null local_gres) ]) ]\n\n       ; let getOrphans m mb_pkg = fmap (\\iface -> mi_module iface\n                                          : dep_orphs (mi_deps iface))\n                                 (loadSrcInterface (text \"runTcInteractive\") m\n                                                   False mb_pkg)\n\n       ; !orphs <- fmap (force . concat) . forM (ic_imports icxt) $ \\i ->\n            case i of                   -- force above: see #15111\n                IIModule n -> getOrphans n Nothing\n                IIDecl i ->\n                  let mb_pkg = sl_fs <$> ideclPkgQual i in\n                  getOrphans (unLoc (ideclName i)) mb_pkg\n\n       ; let imports = emptyImportAvails {\n                            imp_orphs = orphs\n                        }\n\n       ; (gbl_env, lcl_env) <- getEnvs\n       ; let gbl_env' = gbl_env {\n                           tcg_rdr_env      = ic_rn_gbl_env icxt\n                         , tcg_type_env     = type_env\n                         , tcg_inst_env     = extendInstEnvList\n                                               (extendInstEnvList (tcg_inst_env gbl_env) ic_insts)\n                                               home_insts\n                         , tcg_fam_inst_env = extendFamInstEnvList\n                                               (extendFamInstEnvList (tcg_fam_inst_env gbl_env)\n                                                                     ic_finsts)\n                                               home_fam_insts\n                         , tcg_field_env    = mkNameEnv con_fields\n                              -- setting tcg_field_env is necessary\n                              -- to make RecordWildCards work (test: ghci049)\n                         , tcg_fix_env      = ic_fix_env icxt\n                         , tcg_default      = ic_default icxt\n                              -- must calculate imp_orphs of the ImportAvails\n                              -- so that instance visibility is done correctly\n                         , tcg_imports      = imports\n                         }\n\n       ; lcl_env' <- tcExtendLocalTypeEnv lcl_env lcl_ids\n       ; setEnvs (gbl_env', lcl_env') thing_inside }\n  where\n    (home_insts, home_fam_insts) = hptInstances hsc_env (\\_ -> True)\n\n    icxt                     = hsc_IC hsc_env\n    (ic_insts, ic_finsts)    = ic_instances icxt\n    (lcl_ids, top_ty_things) = partitionWith is_closed (ic_tythings icxt)\n\n    is_closed :: TyThing -> Either (Name, TcTyThing) TyThing\n    -- Put Ids with free type variables (always RuntimeUnks)\n    -- in the *local* type environment\n    -- See Note [Initialising the type environment for GHCi]\n    is_closed thing\n      | AnId id <- thing\n      , not (isTypeClosedLetBndr id)\n      = Left (idName id, ATcId { tct_id = id\n                               , tct_info = NotLetBound })\n      | otherwise\n      = Right thing\n\n    type_env1 = mkTypeEnvWithImplicits top_ty_things\n    type_env  = extendTypeEnvWithIds type_env1 (map instanceDFunId ic_insts)\n                -- Putting the dfuns in the type_env\n                -- is just to keep Core Lint happy\n\n    con_fields = [ (dataConName c, dataConFieldLabels c)\n                 | ATyCon t <- top_ty_things\n                 , c <- tyConDataCons t ]\n\n\n{- Note [Initialising the type environment for GHCi]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMost of the Ids in ic_things, defined by the user in 'let' stmts,\nhave closed types. E.g.\n   ghci> let foo x y = x && not y\n\nHowever the GHCi debugger creates top-level bindings for Ids whose\ntypes have free RuntimeUnk skolem variables, standing for unknown\ntypes.  If we don't register these free TyVars as global TyVars then\nthe typechecker will try to quantify over them and fall over in\nskolemiseQuantifiedTyVar. so we must add any free TyVars to the\ntypechecker's global TyVar set.  That is most conveniently by using\ntcExtendLocalTypeEnv, which automatically extends the global TyVar\nset.\n\nWe do this by splitting out the Ids with open types, using 'is_closed'\nto do the partition.  The top-level things go in the global TypeEnv;\nthe open, NotTopLevel, Ids, with free RuntimeUnk tyvars, go in the\nlocal TypeEnv.\n\nNote that we don't extend the local RdrEnv (tcl_rdr); all the in-scope\nthings are already in the interactive context's GlobalRdrEnv.\nExtending the local RdrEnv isn't terrible, but it means there is an\nentry for the same Name in both global and local RdrEnvs, and that\nlead to duplicate \"perhaps you meant...\" suggestions (e.g. T5564).\n\nWe don't bother with the tcl_th_bndrs environment either.\n-}\n\n-- | The returned [Id] is the list of new Ids bound by this statement. It can\n-- be used to extend the InteractiveContext via extendInteractiveContext.\n--\n-- The returned TypecheckedHsExpr is of type IO [ () ], a list of the bound\n-- values, coerced to ().\ntcRnStmt :: HscEnv -> GhciLStmt GhcPs\n         -> IO (Messages, Maybe ([Id], LHsExpr GhcTc, FixityEnv))\ntcRnStmt hsc_env rdr_stmt\n  = runTcInteractive hsc_env $ do {\n\n    -- The real work is done here\n    ((bound_ids, tc_expr), fix_env) <- tcUserStmt rdr_stmt ;\n    zonked_expr <- zonkTopLExpr tc_expr ;\n    zonked_ids  <- zonkTopBndrs bound_ids ;\n\n    failIfErrsM ;  -- we can't do the next step if there are levity polymorphism errors\n                   -- test case: ghci/scripts/T13202{,a}\n\n        -- None of the Ids should be of unboxed type, because we\n        -- cast them all to HValues in the end!\n    mapM_ bad_unboxed (filter (isUnliftedType . idType) zonked_ids) ;\n\n    traceTc \"tcs 1\" empty ;\n    this_mod <- getModule ;\n    global_ids <- mapM (externaliseAndTidyId this_mod) zonked_ids ;\n        -- Note [Interactively-bound Ids in GHCi] in HscTypes\n\n{- ---------------------------------------------\n   At one stage I removed any shadowed bindings from the type_env;\n   they are inaccessible but might, I suppose, cause a space leak if we leave them there.\n   However, with Template Haskell they aren't necessarily inaccessible.  Consider this\n   GHCi session\n         Prelude> let f n = n * 2 :: Int\n         Prelude> fName <- runQ [| f |]\n         Prelude> $(return $ AppE fName (LitE (IntegerL 7)))\n         14\n         Prelude> let f n = n * 3 :: Int\n         Prelude> $(return $ AppE fName (LitE (IntegerL 7)))\n   In the last line we use 'fName', which resolves to the *first* 'f'\n   in scope. If we delete it from the type env, GHCi crashes because\n   it doesn't expect that.\n\n   Hence this code is commented out\n\n-------------------------------------------------- -}\n\n    traceOptTcRn Opt_D_dump_tc\n        (vcat [text \"Bound Ids\" <+> pprWithCommas ppr global_ids,\n               text \"Typechecked expr\" <+> ppr zonked_expr]) ;\n\n    return (global_ids, zonked_expr, fix_env)\n    }\n  where\n    bad_unboxed id = addErr (sep [text \"GHCi can't bind a variable of unlifted type:\",\n                                  nest 2 (ppr id <+> dcolon <+> ppr (idType id))])\n\n{-\n--------------------------------------------------------------------------\n                Typechecking Stmts in GHCi\n\nHere is the grand plan, implemented in tcUserStmt\n\n        What you type                   The IO [HValue] that hscStmt returns\n        -------------                   ------------------------------------\n        let pat = expr          ==>     let pat = expr in return [coerce HVal x, coerce HVal y, ...]\n                                        bindings: [x,y,...]\n\n        pat <- expr             ==>     expr >>= \\ pat -> return [coerce HVal x, coerce HVal y, ...]\n                                        bindings: [x,y,...]\n\n        expr (of IO type)       ==>     expr >>= \\ it -> return [coerce HVal it]\n          [NB: result not printed]      bindings: [it]\n\n        expr (of non-IO type,   ==>     let it = expr in print it >> return [coerce HVal it]\n          result showable)              bindings: [it]\n\n        expr (of non-IO type,\n          result not showable)  ==>     error\n-}\n\n-- | A plan is an attempt to lift some code into the IO monad.\ntype PlanResult = ([Id], LHsExpr GhcTc)\ntype Plan = TcM PlanResult\n\n-- | Try the plans in order. If one fails (by raising an exn), try the next.\n-- If one succeeds, take it.\nrunPlans :: [Plan] -> TcM PlanResult\nrunPlans []     = panic \"runPlans\"\nrunPlans [p]    = p\nrunPlans (p:ps) = tryTcDiscardingErrs (runPlans ps) p\n\n-- | Typecheck (and 'lift') a stmt entered by the user in GHCi into the\n-- GHCi 'environment'.\n--\n-- By 'lift' and 'environment we mean that the code is changed to\n-- execute properly in an IO monad. See Note [Interactively-bound Ids\n-- in GHCi] in HscTypes for more details. We do this lifting by trying\n-- different ways ('plans') of lifting the code into the IO monad and\n-- type checking each plan until one succeeds.\ntcUserStmt :: GhciLStmt GhcPs -> TcM (PlanResult, FixityEnv)\n\n-- An expression typed at the prompt is treated very specially\ntcUserStmt (dL->L loc (BodyStmt _ expr _ _))\n  = do  { (rn_expr, fvs) <- checkNoErrs (rnLExpr expr)\n               -- Don't try to typecheck if the renamer fails!\n        ; ghciStep <- getGhciStepIO\n        ; uniq <- newUnique\n        ; interPrintName <- getInteractivePrintName\n        ; let fresh_it  = itName uniq loc\n              matches   = [mkMatch (mkPrefixFunRhs (cL loc fresh_it)) [] rn_expr\n                                   (noLoc emptyLocalBinds)]\n              -- [it = expr]\n              the_bind  = cL loc $ (mkTopFunBind FromSource\n                                     (cL loc fresh_it) matches)\n                                         { fun_ext = fvs }\n              -- Care here!  In GHCi the expression might have\n              -- free variables, and they in turn may have free type variables\n              -- (if we are at a breakpoint, say).  We must put those free vars\n\n              -- [let it = expr]\n              let_stmt  = cL loc $ LetStmt noExt $ noLoc $ HsValBinds noExt\n                           $ XValBindsLR\n                               (NValBinds [(NonRecursive,unitBag the_bind)] [])\n\n              -- [it <- e]\n              bind_stmt = cL loc $ BindStmt noExt\n                                       (cL loc (VarPat noExt (cL loc fresh_it)))\n                                       (nlHsApp ghciStep rn_expr)\n                                       (mkRnSyntaxExpr bindIOName)\n                                       noSyntaxExpr\n\n              -- [; print it]\n              print_it  = cL loc $ BodyStmt noExt\n                                           (nlHsApp (nlHsVar interPrintName)\n                                           (nlHsVar fresh_it))\n                                           (mkRnSyntaxExpr thenIOName)\n                                                  noSyntaxExpr\n\n              -- NewA\n              no_it_a = cL loc $ BodyStmt noExt (nlHsApps bindIOName\n                                       [rn_expr , nlHsVar interPrintName])\n                                       (mkRnSyntaxExpr thenIOName)\n                                       noSyntaxExpr\n\n              no_it_b = cL loc $ BodyStmt noExt (rn_expr)\n                                       (mkRnSyntaxExpr thenIOName)\n                                       noSyntaxExpr\n\n              no_it_c = cL loc $ BodyStmt noExt\n                                      (nlHsApp (nlHsVar interPrintName) rn_expr)\n                                      (mkRnSyntaxExpr thenIOName)\n                                      noSyntaxExpr\n\n              -- See Note [GHCi Plans]\n\n              it_plans = [\n                    -- Plan A\n                    do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it]\n                       ; it_ty <- zonkTcType (idType it_id)\n                       ; when (isUnitTy $ it_ty) failM\n                       ; return stuff },\n\n                        -- Plan B; a naked bind statement\n                    tcGhciStmts [bind_stmt],\n\n                        -- Plan C; check that the let-binding is typeable all by itself.\n                        -- If not, fail; if so, try to print it.\n                        -- The two-step process avoids getting two errors: one from\n                        -- the expression itself, and one from the 'print it' part\n                        -- This two-step story is very clunky, alas\n                    do { _ <- checkNoErrs (tcGhciStmts [let_stmt])\n                                --- checkNoErrs defeats the error recovery of let-bindings\n                       ; tcGhciStmts [let_stmt, print_it] } ]\n\n              -- Plans where we don't bind \"it\"\n              no_it_plans = [\n                    tcGhciStmts [no_it_a] ,\n                    tcGhciStmts [no_it_b] ,\n                    tcGhciStmts [no_it_c] ]\n\n        ; generate_it <- goptM Opt_NoIt\n\n        -- We disable `-fdefer-type-errors` in GHCi for naked expressions.\n        -- See Note [Deferred type errors in GHCi]\n\n        -- NB: The flag `-fdefer-type-errors` implies `-fdefer-type-holes`\n        -- and `-fdefer-out-of-scope-variables`. However the flag\n        -- `-fno-defer-type-errors` doesn't imply `-fdefer-type-holes` and\n        -- `-fno-defer-out-of-scope-variables`. Thus the later two flags\n        -- also need to be unset here.\n        ; plan <- unsetGOptM Opt_DeferTypeErrors $\n                  unsetGOptM Opt_DeferTypedHoles $\n                  unsetGOptM Opt_DeferOutOfScopeVariables $\n                    runPlans $ if generate_it\n                                 then no_it_plans\n                                 else it_plans\n\n        ; fix_env <- getFixityEnv\n        ; return (plan, fix_env) }\n\n{- Note [Deferred type errors in GHCi]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn GHCi, we ensure that type errors don't get deferred when type checking the\nnaked expressions. Deferring type errors here is unhelpful because the\nexpression gets evaluated right away anyway. It also would potentially emit\ntwo redundant type-error warnings, one from each plan.\n\nTrac #14963 reveals another bug that when deferred type errors is enabled\nin GHCi, any reference of imported/loaded variables (directly or indirectly)\nin interactively issued naked expressions will cause ghc panic. See more\ndetailed dicussion in Trac #14963.\n\nThe interactively issued declarations, statements, as well as the modules\nloaded into GHCi, are not affected. That means, for declaration, you could\nhave\n\n    Prelude> :set -fdefer-type-errors\n    Prelude> x :: IO (); x = putStrLn True\n    <interactive>:14:26: warning: [-Wdeferred-type-errors]\n        ? Couldn't match type \u00e2\u20ac\u02dcBool\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dc[Char]\u00e2\u20ac\u2122\n          Expected type: String\n            Actual type: Bool\n        ? In the first argument of \u00e2\u20ac\u02dcputStrLn\u00e2\u20ac\u2122, namely \u00e2\u20ac\u02dcTrue\u00e2\u20ac\u2122\n          In the expression: putStrLn True\n          In an equation for \u00e2\u20ac\u02dcx\u00e2\u20ac\u2122: x = putStrLn True\n\nBut for naked expressions, you will have\n\n    Prelude> :set -fdefer-type-errors\n    Prelude> putStrLn True\n    <interactive>:2:10: error:\n        ? Couldn't match type \u00e2\u20ac\u02dcBool\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dc[Char]\u00e2\u20ac\u2122\n          Expected type: String\n            Actual type: Bool\n        ? In the first argument of \u00e2\u20ac\u02dcputStrLn\u00e2\u20ac\u2122, namely \u00e2\u20ac\u02dcTrue\u00e2\u20ac\u2122\n          In the expression: putStrLn True\n          In an equation for \u00e2\u20ac\u02dcit\u00e2\u20ac\u2122: it = putStrLn True\n\n    Prelude> let x = putStrLn True\n    <interactive>:2:18: warning: [-Wdeferred-type-errors]\n        ? Couldn't match type \u00e2\u20ac\u02dcBool\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dc[Char]\u00e2\u20ac\u2122\n          Expected type: String\n            Actual type: Bool\n        ? In the first argument of \u00e2\u20ac\u02dcputStrLn\u00e2\u20ac\u2122, namely \u00e2\u20ac\u02dcTrue\u00e2\u20ac\u2122\n          In the expression: putStrLn True\n          In an equation for \u00e2\u20ac\u02dcx\u00e2\u20ac\u2122: x = putStrLn True\n-}\n\ntcUserStmt rdr_stmt@(dL->L loc _)\n  = do { (([rn_stmt], fix_env), fvs) <- checkNoErrs $\n           rnStmts GhciStmtCtxt rnLExpr [rdr_stmt] $ \\_ -> do\n             fix_env <- getFixityEnv\n             return (fix_env, emptyFVs)\n            -- Don't try to typecheck if the renamer fails!\n       ; traceRn \"tcRnStmt\" (vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs])\n       ; rnDump rn_stmt ;\n\n       ; ghciStep <- getGhciStepIO\n       ; let gi_stmt\n               | (dL->L loc (BindStmt ty pat expr op1 op2)) <- rn_stmt\n                     = cL loc $ BindStmt ty pat (nlHsApp ghciStep expr) op1 op2\n               | otherwise = rn_stmt\n\n       ; opt_pr_flag <- goptM Opt_PrintBindResult\n       ; let print_result_plan\n               | opt_pr_flag                         -- The flag says \"print result\"\n               , [v] <- collectLStmtBinders gi_stmt  -- One binder\n                           =  [mk_print_result_plan gi_stmt v]\n               | otherwise = []\n\n        -- The plans are:\n        --      [stmt; print v]         if one binder and not v::()\n        --      [stmt]                  otherwise\n       ; plan <- runPlans (print_result_plan ++ [tcGhciStmts [gi_stmt]])\n       ; return (plan, fix_env) }\n  where\n    mk_print_result_plan stmt v\n      = do { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]\n           ; v_ty <- zonkTcType (idType v_id)\n           ; when (isUnitTy v_ty || not (isTauTy v_ty)) failM\n           ; return stuff }\n      where\n        print_v  = cL loc $ BodyStmt noExt (nlHsApp (nlHsVar printName)\n                                    (nlHsVar v))\n                                    (mkRnSyntaxExpr thenIOName) noSyntaxExpr\n\n{-\nNote [GHCi Plans]\n~~~~~~~~~~~~~~~~~\nWhen a user types an expression in the repl we try to print it in three different\nways. Also, depending on whether -fno-it is set, we bind a variable called `it`\nwhich can be used to refer to the result of the expression subsequently in the repl.\n\nThe normal plans are :\n  A. [it <- e; print e]     but not if it::()\n  B. [it <- e]\n  C. [let it = e; print it]\n\nWhen -fno-it is set, the plans are:\n  A. [e >>= print]\n  B. [e]\n  C. [let it = e in print it]\n\nThe reason for -fno-it is explained in #14336. `it` can lead to the repl\nleaking memory as it is repeatedly queried.\n-}\n\n-- | Typecheck the statements given and then return the results of the\n-- statement in the form 'IO [()]'.\ntcGhciStmts :: [GhciLStmt GhcRn] -> TcM PlanResult\ntcGhciStmts stmts\n = do { ioTyCon <- tcLookupTyCon ioTyConName ;\n        ret_id  <- tcLookupId returnIOName ;            -- return @ IO\n        let {\n            ret_ty      = mkListTy unitTy ;\n            io_ret_ty   = mkTyConApp ioTyCon [ret_ty] ;\n            tc_io_stmts = tcStmtsAndThen GhciStmtCtxt tcDoStmt stmts\n                                         (mkCheckExpType io_ret_ty) ;\n            names = collectLStmtsBinders stmts ;\n         } ;\n\n        -- OK, we're ready to typecheck the stmts\n        traceTc \"TcRnDriver.tcGhciStmts: tc stmts\" empty ;\n        ((tc_stmts, ids), lie) <- captureTopConstraints $\n                                  tc_io_stmts $ \\ _ ->\n                                  mapM tcLookupId names  ;\n                        -- Look up the names right in the middle,\n                        -- where they will all be in scope\n\n        -- Simplify the context\n        traceTc \"TcRnDriver.tcGhciStmts: simplify ctxt\" empty ;\n        const_binds <- checkNoErrs (simplifyInteractive lie) ;\n                -- checkNoErrs ensures that the plan fails if context redn fails\n\n        traceTc \"TcRnDriver.tcGhciStmts: done\" empty ;\n        let {   -- mk_return builds the expression\n                --      returnIO @ [()] [coerce () x, ..,  coerce () z]\n                --\n                -- Despite the inconvenience of building the type applications etc,\n                -- this *has* to be done in type-annotated post-typecheck form\n                -- because we are going to return a list of *polymorphic* values\n                -- coerced to type (). If we built a *source* stmt\n                --      return [coerce x, ..., coerce z]\n                -- then the type checker would instantiate x..z, and we wouldn't\n                -- get their *polymorphic* values.  (And we'd get ambiguity errs\n                -- if they were overloaded, since they aren't applied to anything.)\n            ret_expr = nlHsApp (nlHsTyApp ret_id [ret_ty])\n                       (noLoc $ ExplicitList unitTy Nothing\n                                                            (map mk_item ids)) ;\n            mk_item id = let ty_args = [idType id, unitTy] in\n                         nlHsApp (nlHsTyApp unsafeCoerceId\n                                   (map getRuntimeRep ty_args ++ ty_args))\n                                 (nlHsVar id) ;\n            stmts = tc_stmts ++ [noLoc (mkLastStmt ret_expr)]\n        } ;\n        return (ids, mkHsDictLet (EvBinds const_binds) $\n                     noLoc (HsDo io_ret_ty GhciStmtCtxt (noLoc stmts)))\n    }\n\n-- | Generate a typed ghciStepIO expression (ghciStep :: Ty a -> IO a)\ngetGhciStepIO :: TcM (LHsExpr GhcRn)\ngetGhciStepIO = do\n    ghciTy <- getGHCiMonad\n    a_tv <- newName (mkTyVarOccFS (fsLit \"a\"))\n    let ghciM   = nlHsAppTy (nlHsTyVar ghciTy) (nlHsTyVar a_tv)\n        ioM     = nlHsAppTy (nlHsTyVar ioTyConName) (nlHsTyVar a_tv)\n\n        step_ty = noLoc $ HsForAllTy\n                     { hst_fvf = ForallInvis\n                     , hst_bndrs = [noLoc $ UserTyVar noExt (noLoc a_tv)]\n                     , hst_xforall = noExt\n                     , hst_body  = nlHsFunTy ghciM ioM }\n\n        stepTy :: LHsSigWcType GhcRn\n        stepTy = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs step_ty)\n\n    return (noLoc $ ExprWithTySig noExt (nlHsVar ghciStepIoMName) stepTy)\n\nisGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)\nisGHCiMonad hsc_env ty\n  = runTcInteractive hsc_env $ do\n        rdrEnv <- getGlobalRdrEnv\n        let occIO = lookupOccEnv rdrEnv (mkOccName tcName ty)\n        case occIO of\n            Just [n] -> do\n                let name = gre_name n\n                ghciClass <- tcLookupClass ghciIoClassName\n                userTyCon <- tcLookupTyCon name\n                let userTy = mkTyConApp userTyCon []\n                _ <- tcLookupInstance ghciClass [userTy]\n                return name\n\n            Just _  -> failWithTc $ text \"Ambiguous type!\"\n            Nothing -> failWithTc $ text (\"Can't find type:\" ++ ty)\n\n-- | How should we infer a type? See Note [TcRnExprMode]\ndata TcRnExprMode = TM_Inst    -- ^ Instantiate the type fully (:type)\n                  | TM_NoInst  -- ^ Do not instantiate the type (:type +v)\n                  | TM_Default -- ^ Default the type eagerly (:type +d)\n\n-- | tcRnExpr just finds the type of an expression\ntcRnExpr :: HscEnv\n         -> TcRnExprMode\n         -> LHsExpr GhcPs\n         -> IO (Messages, Maybe Type)\ntcRnExpr hsc_env mode rdr_expr\n  = runTcInteractive hsc_env $\n    do {\n\n    (rn_expr, _fvs) <- rnLExpr rdr_expr ;\n    failIfErrsM ;\n\n        -- Now typecheck the expression, and generalise its type\n        -- it might have a rank-2 type (e.g. :t runST)\n    uniq <- newUnique ;\n    let { fresh_it  = itName uniq (getLoc rdr_expr)\n        ; orig = lexprCtOrigin rn_expr } ;\n    (tclvl, lie, res_ty)\n          <- pushLevelAndCaptureConstraints $\n             do { (_tc_expr, expr_ty) <- tcInferSigma rn_expr\n                ; if inst\n                  then snd <$> deeplyInstantiate orig expr_ty\n                  else return expr_ty } ;\n\n    -- Generalise\n    (qtvs, dicts, _, residual, _)\n         <- simplifyInfer tclvl infer_mode\n                          []    {- No sig vars -}\n                          [(fresh_it, res_ty)]\n                          lie ;\n\n    -- Ignore the dictionary bindings\n    _ <- perhaps_disable_default_warnings $\n         simplifyInteractive residual ;\n\n    let { all_expr_ty = mkInvForAllTys qtvs $\n                        mkPhiTy (map idType dicts) res_ty } ;\n    ty <- zonkTcType all_expr_ty ;\n\n    -- We normalise type families, so that the type of an expression is the\n    -- same as of a bound expression (TcBinds.mkInferredPolyId). See Trac\n    -- #10321 for further discussion.\n    fam_envs <- tcGetFamInstEnvs ;\n    -- normaliseType returns a coercion which we discard, so the Role is\n    -- irrelevant\n    return (snd (normaliseType fam_envs Nominal ty))\n    }\n  where\n    -- See Note [TcRnExprMode]\n    (inst, infer_mode, perhaps_disable_default_warnings) = case mode of\n      TM_Inst    -> (True,  NoRestrictions, id)\n      TM_NoInst  -> (False, NoRestrictions, id)\n      TM_Default -> (True,  EagerDefaulting, unsetWOptM Opt_WarnTypeDefaults)\n\n--------------------------\ntcRnImportDecls :: HscEnv\n                -> [LImportDecl GhcPs]\n                -> IO (Messages, Maybe GlobalRdrEnv)\n-- Find the new chunk of GlobalRdrEnv created by this list of import\n-- decls.  In contract tcRnImports *extends* the TcGblEnv.\ntcRnImportDecls hsc_env import_decls\n =  runTcInteractive hsc_env $\n    do { gbl_env <- updGblEnv zap_rdr_env $\n                    tcRnImports hsc_env import_decls\n       ; return (tcg_rdr_env gbl_env) }\n  where\n    zap_rdr_env gbl_env = gbl_env { tcg_rdr_env = emptyGlobalRdrEnv }\n\n-- tcRnType just finds the kind of a type\ntcRnType :: HscEnv\n         -> Bool        -- Normalise the returned type\n         -> LHsType GhcPs\n         -> IO (Messages, Maybe (Type, Kind))\ntcRnType hsc_env normalise rdr_type\n  = runTcInteractive hsc_env $\n    setXOptM LangExt.PolyKinds $   -- See Note [Kind-generalise in tcRnType]\n    do { (HsWC { hswc_ext = wcs, hswc_body = rn_type }, _fvs)\n               <- rnHsWcType GHCiCtx (mkHsWildCardBndrs rdr_type)\n                  -- The type can have wild cards, but no implicit\n                  -- generalisation; e.g.   :kind (T _)\n       ; failIfErrsM\n\n        -- Now kind-check the type\n        -- It can have any rank or kind\n        -- First bring into scope any wildcards\n       ; traceTc \"tcRnType\" (vcat [ppr wcs, ppr rn_type])\n       ; ((ty, kind), lie)  <-\n                       captureConstraints $\n                       tcWildCardBinders wcs $ \\ wcs' ->\n                       do { emitWildCardHoleConstraints wcs'\n                          ; tcLHsTypeUnsaturated rn_type }\n       ; _ <- checkNoErrs (simplifyInteractive lie)\n\n       -- Do kind generalisation; see Note [Kind-generalise in tcRnType]\n       ; kind <- zonkTcType kind\n       ; kvs <- kindGeneralize kind\n       ; ty  <- zonkTcTypeToType ty\n\n       -- Do validity checking on type\n       ; checkValidType (GhciCtxt True) ty\n\n       ; ty' <- if normalise\n                then do { fam_envs <- tcGetFamInstEnvs\n                        ; let (_, ty')\n                                = normaliseType fam_envs Nominal ty\n                        ; return ty' }\n                else return ty ;\n\n       ; return (ty', mkInvForAllTys kvs (tcTypeKind ty')) }\n\n{- Note [TcRnExprMode]\n~~~~~~~~~~~~~~~~~~~~~~\nHow should we infer a type when a user asks for the type of an expression e\nat the GHCi prompt? We offer 3 different possibilities, described below. Each\nconsiders this example, with -fprint-explicit-foralls enabled:\n\n  foo :: forall a f b. (Show a, Num b, Foldable f) => a -> f b -> String\n  :type{,-spec,-def} foo @Int\n\n:type / TM_Inst\n\n  In this mode, we report the type that would be inferred if a variable\n  were assigned to expression e, without applying the monomorphism restriction.\n  This means we deeply instantiate the type and then regeneralize, as discussed\n  in #11376.\n\n  > :type foo @Int\n  forall {b} {f :: * -> *}. (Foldable f, Num b) => Int -> f b -> String\n\n  Note that the variables and constraints are reordered here, because this\n  is possible during regeneralization. Also note that the variables are\n  reported as Inferred instead of Specified.\n\n:type +v / TM_NoInst\n\n  This mode is for the benefit of users using TypeApplications. It does no\n  instantiation whatsoever, sometimes meaning that class constraints are not\n  solved.\n\n  > :type +v foo @Int\n  forall f b. (Show Int, Num b, Foldable f) => Int -> f b -> String\n\n  Note that Show Int is still reported, because the solver never got a chance\n  to see it.\n\n:type +d / TM_Default\n\n  This mode is for the benefit of users who wish to see instantiations of\n  generalized types, and in particular to instantiate Foldable and Traversable.\n  In this mode, any type variable that can be defaulted is defaulted. Because\n  GHCi uses -XExtendedDefaultRules, this means that Foldable and Traversable are\n  defaulted.\n\n  > :type +d foo @Int\n  Int -> [Integer] -> String\n\n  Note that this mode can sometimes lead to a type error, if a type variable is\n  used with a defaultable class but cannot actually be defaulted:\n\n  bar :: (Num a, Monoid a) => a -> a\n  > :type +d bar\n  ** error **\n\n  The error arises because GHC tries to default a but cannot find a concrete\n  type in the defaulting list that is both Num and Monoid. (If this list is\n  modified to include an element that is both Num and Monoid, the defaulting\n  would succeed, of course.)\n\nNote [Kind-generalise in tcRnType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe switch on PolyKinds when kind-checking a user type, so that we will\nkind-generalise the type, even when PolyKinds is not otherwise on.\nThis gives the right default behaviour at the GHCi prompt, where if\nyou say \":k T\", and T has a polymorphic kind, you'd like to see that\npolymorphism. Of course.  If T isn't kind-polymorphic you won't get\nanything unexpected, but the apparent *loss* of polymorphism, for\ntypes that you know are polymorphic, is quite surprising.  See Trac\n#7688 for a discussion.\n\nNote that the goal is to generalise the *kind of the type*, not\nthe type itself! Example:\n  ghci> data SameKind :: k -> k -> Type\n  ghci> :k SameKind _\n\nWe want to get `k -> Type`, not `Any -> Type`, which is what we would\nget without kind-generalisation. Note that `:k SameKind` is OK, as\nGHC will not instantiate SameKind here, and so we see its full kind\nof `forall k. k -> k -> Type`.\n\n************************************************************************\n*                                                                      *\n                 tcRnDeclsi\n*                                                                      *\n************************************************************************\n\ntcRnDeclsi exists to allow class, data, and other declarations in GHCi.\n-}\n\ntcRnDeclsi :: HscEnv\n           -> [LHsDecl GhcPs]\n           -> IO (Messages, Maybe TcGblEnv)\ntcRnDeclsi hsc_env local_decls\n  = runTcInteractive hsc_env $\n    tcRnSrcDecls False local_decls\n\nexternaliseAndTidyId :: Module -> Id -> TcM Id\nexternaliseAndTidyId this_mod id\n  = do { name' <- externaliseName this_mod (idName id)\n       ; return (globaliseAndTidyId (setIdName id name')) }\n\n\n{-\n************************************************************************\n*                                                                      *\n        More GHCi stuff, to do with browsing and getting info\n*                                                                      *\n************************************************************************\n-}\n\n-- | ASSUMES that the module is either in the 'HomePackageTable' or is\n-- a package module with an interface on disk.  If neither of these is\n-- true, then the result will be an error indicating the interface\n-- could not be found.\ngetModuleInterface :: HscEnv -> Module -> IO (Messages, Maybe ModIface)\ngetModuleInterface hsc_env mod\n  = runTcInteractive hsc_env $\n    loadModuleInterface (text \"getModuleInterface\") mod\n\ntcRnLookupRdrName :: HscEnv -> Located RdrName\n                  -> IO (Messages, Maybe [Name])\n-- ^ Find all the Names that this RdrName could mean, in GHCi\ntcRnLookupRdrName hsc_env (dL->L loc rdr_name)\n  = runTcInteractive hsc_env $\n    setSrcSpan loc           $\n    do {   -- If the identifier is a constructor (begins with an\n           -- upper-case letter), then we need to consider both\n           -- constructor and type class identifiers.\n         let rdr_names = dataTcOccs rdr_name\n       ; names_s <- mapM lookupInfoOccRn rdr_names\n       ; let names = concat names_s\n       ; when (null names) (addErrTc (text \"Not in scope:\" <+> quotes (ppr rdr_name)))\n       ; return names }\n\ntcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)\ntcRnLookupName hsc_env name\n  = runTcInteractive hsc_env $\n    tcRnLookupName' name\n\n-- To look up a name we have to look in the local environment (tcl_lcl)\n-- as well as the global environment, which is what tcLookup does.\n-- But we also want a TyThing, so we have to convert:\n\ntcRnLookupName' :: Name -> TcRn TyThing\ntcRnLookupName' name = do\n   tcthing <- tcLookup name\n   case tcthing of\n     AGlobal thing    -> return thing\n     ATcId{tct_id=id} -> return (AnId id)\n     _ -> panic \"tcRnLookupName'\"\n\ntcRnGetInfo :: HscEnv\n            -> Name\n            -> IO ( Messages\n                  , Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))\n\n-- Used to implement :info in GHCi\n--\n-- Look up a RdrName and return all the TyThings it might be\n-- A capitalised RdrName is given to us in the DataName namespace,\n-- but we want to treat it as *both* a data constructor\n--  *and* as a type or class constructor;\n-- hence the call to dataTcOccs, and we return up to two results\ntcRnGetInfo hsc_env name\n  = runTcInteractive hsc_env $\n    do { loadUnqualIfaces hsc_env (hsc_IC hsc_env)\n           -- Load the interface for all unqualified types and classes\n           -- That way we will find all the instance declarations\n           -- (Packages have not orphan modules, and we assume that\n           --  in the home package all relevant modules are loaded.)\n\n       ; thing  <- tcRnLookupName' name\n       ; fixity <- lookupFixityRn name\n       ; (cls_insts, fam_insts) <- lookupInsts thing\n       ; let info = lookupKnownNameInfo name\n       ; return (thing, fixity, cls_insts, fam_insts, info) }\n\n\n-- Lookup all class and family instances for a type constructor.\n--\n-- This function filters all instances in the type environment, so there\n-- is a lot of duplicated work if it is called many times in the same\n-- type environment. If this becomes a problem, the NameEnv computed\n-- in GHC.getNameToInstancesIndex could be cached in TcM and both functions\n-- could be changed to consult that index.\nlookupInsts :: TyThing -> TcM ([ClsInst],[FamInst])\nlookupInsts (ATyCon tc)\n  = do  { InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods } <- tcGetInstEnvs\n        ; (pkg_fie, home_fie) <- tcGetFamInstEnvs\n                -- Load all instances for all classes that are\n                -- in the type environment (which are all the ones\n                -- we've seen in any interface file so far)\n\n          -- Return only the instances relevant to the given thing, i.e.\n          -- the instances whose head contains the thing's name.\n        ; let cls_insts =\n                 [ ispec        -- Search all\n                 | ispec <- instEnvElts home_ie ++ instEnvElts pkg_ie\n                 , instIsVisible vis_mods ispec\n                 , tc_name `elemNameSet` orphNamesOfClsInst ispec ]\n        ; let fam_insts =\n                 [ fispec\n                 | fispec <- famInstEnvElts home_fie ++ famInstEnvElts pkg_fie\n                 , tc_name `elemNameSet` orphNamesOfFamInst fispec ]\n        ; return (cls_insts, fam_insts) }\n  where\n    tc_name     = tyConName tc\n\nlookupInsts _ = return ([],[])\n\nloadUnqualIfaces :: HscEnv -> InteractiveContext -> TcM ()\n-- Load the interface for everything that is in scope unqualified\n-- This is so that we can accurately report the instances for\n-- something\nloadUnqualIfaces hsc_env ictxt\n  = initIfaceTcRn $ do\n    mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))\n  where\n    this_pkg = thisPackage (hsc_dflags hsc_env)\n\n    unqual_mods = [ nameModule name\n                  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)\n                  , let name = gre_name gre\n                  , nameIsFromExternalPackage this_pkg name\n                  , isTcOcc (nameOccName name)   -- Types and classes only\n                  , unQualOK gre ]               -- In scope unqualified\n    doc = text \"Need interface for module whose export(s) are in scope unqualified\"\n\n\n\n{-\n************************************************************************\n*                                                                      *\n                Debugging output\n      This is what happens when you do -ddump-types\n*                                                                      *\n************************************************************************\n-}\n\nrnDump :: (Outputable a, Data a) => a -> TcRn ()\n-- Dump, with a banner, if -ddump-rn\nrnDump rn = do { traceOptTcRn Opt_D_dump_rn (mkDumpDoc \"Renamer\" (ppr rn)) }\n\ntcDump :: TcGblEnv -> TcRn ()\ntcDump env\n = do { dflags <- getDynFlags ;\n\n        -- Dump short output if -ddump-types or -ddump-tc\n        when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)\n          (traceTcRnForUser Opt_D_dump_types short_dump) ;\n\n        -- Dump bindings if -ddump-tc\n        traceOptTcRn Opt_D_dump_tc (mkDumpDoc \"Typechecker\" full_dump);\n\n        -- Dump bindings as an hsSyn AST if -ddump-tc-ast\n        traceOptTcRn Opt_D_dump_tc_ast (mkDumpDoc \"Typechecker\" ast_dump)\n   }\n  where\n    short_dump = pprTcGblEnv env\n    full_dump  = pprLHsBinds (tcg_binds env)\n        -- NB: foreign x-d's have undefined's in their types;\n        --     hence can't show the tc_fords\n    ast_dump = showAstData NoBlankSrcSpan (tcg_binds env)\n\n-- It's unpleasant having both pprModGuts and pprModDetails here\npprTcGblEnv :: TcGblEnv -> SDoc\npprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,\n                        tcg_insts     = insts,\n                        tcg_fam_insts = fam_insts,\n                        tcg_rules     = rules,\n                        tcg_imports   = imports })\n  = getPprDebug $ \\debug ->\n    vcat [ ppr_types debug type_env\n         , ppr_tycons debug fam_insts type_env\n         , ppr_datacons debug type_env\n         , ppr_patsyns type_env\n         , ppr_insts insts\n         , ppr_fam_insts fam_insts\n         , ppr_rules rules\n         , text \"Dependent modules:\" <+>\n                pprUFM (imp_dep_mods imports) (ppr . sort)\n         , text \"Dependent packages:\" <+>\n                ppr (S.toList $ imp_dep_pkgs imports)]\n  where         -- The use of sort is just to reduce unnecessary\n                -- wobbling in testsuite output\n\nppr_rules :: [LRuleDecl GhcTc] -> SDoc\nppr_rules rules\n  = ppUnless (null rules) $\n    hang (text \"RULES\")\n       2 (vcat (map ppr rules))\n\nppr_types :: Bool -> TypeEnv -> SDoc\nppr_types debug type_env\n  = ppr_things \"TYPE SIGNATURES\" ppr_sig\n             (sortBy (comparing getOccName) ids)\n  where\n    ids = [id | id <- typeEnvIds type_env, want_sig id]\n    want_sig id\n      | debug     = True\n      | otherwise = hasTopUserName id\n                    && case idDetails id of\n                         VanillaId    -> True\n                         RecSelId {}  -> True\n                         ClassOpId {} -> True\n                         FCallId {}   -> True\n                         _            -> False\n             -- Data cons (workers and wrappers), pattern synonyms,\n             -- etc are suppressed (unless -dppr-debug),\n             -- because they appear elsehwere\n\n    ppr_sig id = hang (ppr id <+> dcolon) 2 (ppr (tidyTopType (idType id)))\n\nppr_tycons :: Bool -> [FamInst] -> TypeEnv -> SDoc\nppr_tycons debug fam_insts type_env\n  = vcat [ ppr_things \"TYPE CONSTRUCTORS\" ppr_tc tycons\n         , ppr_things \"COERCION AXIOMS\" ppr_ax\n                      (typeEnvCoAxioms type_env) ]\n  where\n    fi_tycons = famInstsRepTyCons fam_insts\n\n    tycons = sortBy (comparing getOccName) $\n             [tycon | tycon <- typeEnvTyCons type_env\n                    , want_tycon tycon]\n             -- Sort by OccName to reduce unnecessary changes\n    want_tycon tycon | debug      = True\n                     | otherwise  = isExternalName (tyConName tycon) &&\n                                    not (tycon `elem` fi_tycons)\n    ppr_tc tc\n       = vcat [ hang (ppr (tyConFlavour tc) <+> ppr tc\n                      <> braces (ppr (tyConArity tc)) <+> dcolon)\n                   2 (ppr (tidyTopType (tyConKind tc)))\n              , nest 2 $\n                ppWhen show_roles $\n                text \"roles\" <+> (sep (map ppr roles)) ]\n       where\n         show_roles = debug || not (all (== boring_role) roles)\n         roles = tyConRoles tc\n         boring_role | isClassTyCon tc = Nominal\n                     | otherwise       = Representational\n            -- Matches the choice in IfaceSyn, calls to pprRoles\n\n    ppr_ax ax = ppr (coAxiomToIfaceDecl ax)\n      -- We go via IfaceDecl rather than using pprCoAxiom\n      -- This way we get the full axiom (both LHS and RHS) with\n      -- wildcard binders tidied to _1, _2, etc.\n\nppr_datacons :: Bool -> TypeEnv -> SDoc\nppr_datacons debug type_env\n  = ppr_things \"DATA CONSTRUCTORS\" ppr_dc wanted_dcs\n      -- The filter gets rid of class data constructors\n  where\n    ppr_dc dc = ppr dc <+> dcolon <+> ppr (dataConUserType dc)\n    all_dcs    = typeEnvDataCons type_env\n    wanted_dcs | debug     = all_dcs\n               | otherwise = filterOut is_cls_dc all_dcs\n    is_cls_dc dc = isClassTyCon (dataConTyCon dc)\n\nppr_patsyns :: TypeEnv -> SDoc\nppr_patsyns type_env\n  = ppr_things \"PATTERN SYNONYMS\" ppr_ps\n               (typeEnvPatSyns type_env)\n  where\n    ppr_ps ps = ppr ps <+> dcolon <+> pprPatSynType ps\n\nppr_insts :: [ClsInst] -> SDoc\nppr_insts ispecs\n  = ppr_things \"CLASS INSTANCES\" pprInstance ispecs\n\nppr_fam_insts :: [FamInst] -> SDoc\nppr_fam_insts fam_insts\n  = ppr_things \"FAMILY INSTANCES\" pprFamInst fam_insts\n\nppr_things :: String -> (a -> SDoc) -> [a] -> SDoc\nppr_things herald ppr_one things\n  | null things = empty\n  | otherwise   = text herald $$ nest 2 (vcat (map ppr_one things))\n\nhasTopUserName :: NamedThing x => x -> Bool\n-- A top-level thing whose name is not \"derived\"\n-- Thus excluding things like $tcX, from Typeable boilerplate\n-- and C:Coll from class-dictionary data constructors\nhasTopUserName x\n  = isExternalName name && not (isDerivedOccName (nameOccName name))\n  where\n    name = getName x\n\n{-\n********************************************************************************\n\nType Checker Plugins\n\n********************************************************************************\n-}\n\nwithTcPlugins :: HscEnv -> TcM a -> TcM a\nwithTcPlugins hsc_env m =\n  do let plugins = getTcPlugins (hsc_dflags hsc_env)\n     case plugins of\n       [] -> m  -- Common fast case\n       _  -> do ev_binds_var <- newTcEvBinds\n                (solvers,stops) <- unzip `fmap` mapM (startPlugin ev_binds_var) plugins\n                -- This ensures that tcPluginStop is called even if a type\n                -- error occurs during compilation (Fix of #10078)\n                eitherRes <- tryM $ do\n                  updGblEnv (\\e -> e { tcg_tc_plugins = solvers }) m\n                mapM_ (flip runTcPluginM ev_binds_var) stops\n                case eitherRes of\n                  Left _ -> failM\n                  Right res -> return res\n  where\n  startPlugin ev_binds_var (TcPlugin start solve stop) =\n    do s <- runTcPluginM start ev_binds_var\n       return (solve s, stop s)\n\ngetTcPlugins :: DynFlags -> [TcRnMonad.TcPlugin]\ngetTcPlugins dflags = catMaybes $ mapPlugins dflags (\\p args -> tcPlugin p args)\n\nrunRenamerPlugin :: TcGblEnv\n                 -> HsGroup GhcRn\n                 -> TcM (TcGblEnv, HsGroup GhcRn)\nrunRenamerPlugin gbl_env hs_group = do\n    dflags <- getDynFlags\n    withPlugins dflags\n      (\\p opts (e, g) -> ( mark_plugin_unsafe dflags >> renamedResultAction p opts e g))\n      (gbl_env, hs_group)\n\n\n-- XXX: should this really be a Maybe X?  Check under which circumstances this\n-- can become a Nothing and decide whether this should instead throw an\n-- exception/signal an error.\ntype RenamedStuff =\n        (Maybe (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],\n                Maybe LHsDocString))\n\n-- | Extract the renamed information from TcGblEnv.\ngetRenamedStuff :: TcGblEnv -> RenamedStuff\ngetRenamedStuff tc_result\n  = fmap (\\decls -> ( decls, tcg_rn_imports tc_result\n                    , tcg_rn_exports tc_result, tcg_doc_hdr tc_result ) )\n         (tcg_rn_decls tc_result)\n\nrunTypecheckerPlugin :: ModSummary -> HscEnv -> TcGblEnv -> TcM TcGblEnv\nrunTypecheckerPlugin sum hsc_env gbl_env = do\n    let dflags = hsc_dflags hsc_env\n    withPlugins dflags\n      (\\p opts env -> mark_plugin_unsafe dflags\n                        >> typeCheckResultAction p opts sum env)\n      gbl_env\n\nmark_plugin_unsafe :: DynFlags -> TcM ()\nmark_plugin_unsafe dflags = unless (gopt Opt_PluginTrustworthy dflags) $\n  recordUnsafeInfer pluginUnsafe\n  where\n    unsafeText = \"Use of plugins makes the module unsafe\"\n    pluginUnsafe = unitBag ( mkPlainWarnMsg dflags noSrcSpan\n                                   (Outputable.text unsafeText) )\n", "num_lines": 2912}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcRnExports (tcRnExports, exports_from_avail) where\n\nimport GhcPrelude\n\nimport HsSyn\nimport PrelNames\nimport RdrName\nimport TcRnMonad\nimport TcEnv\nimport TcType\nimport RnNames\nimport RnEnv\nimport RnUnbound ( reportUnboundName )\nimport ErrUtils\nimport Id\nimport IdInfo\nimport Module\nimport Name\nimport NameEnv\nimport NameSet\nimport Avail\nimport TyCon\nimport SrcLoc\nimport HscTypes\nimport Outputable\nimport ConLike\nimport DataCon\nimport PatSyn\nimport Maybes\nimport UniqSet\nimport Util (capitalise)\nimport FastString (fsLit)\n\nimport Control.Monad\nimport DynFlags\nimport RnHsDoc          ( rnHsDoc )\nimport RdrHsSyn        ( setRdrNameSpace )\nimport Data.Either      ( partitionEithers )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Export list processing}\n*                                                                      *\n************************************************************************\n\nProcessing the export list.\n\nYou might think that we should record things that appear in the export\nlist as ``occurrences'' (using @addOccurrenceName@), but you'd be\nwrong.  We do check (here) that they are in scope, but there is no\nneed to slurp in their actual declaration (which is what\n@addOccurrenceName@ forces).\n\nIndeed, doing so would big trouble when compiling @PrelBase@, because\nit re-exports @GHC@, which includes @takeMVar#@, whose type includes\n@ConcBase.StateAndSynchVar#@, and so on...\n\nNote [Exports of data families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose you see (Trac #5306)\n        module M where\n          import X( F )\n          data instance F Int = FInt\nWhat does M export?  AvailTC F [FInt]\n                  or AvailTC F [F,FInt]?\nThe former is strictly right because F isn't defined in this module.\nBut then you can never do an explicit import of M, thus\n    import M( F( FInt ) )\nbecause F isn't exported by M.  Nor can you import FInt alone from here\n    import M( FInt )\nbecause we don't have syntax to support that.  (It looks like an import of\nthe type FInt.)\n\nAt one point I implemented a compromise:\n  * When constructing exports with no export list, or with module M(\n    module M ), we add the parent to the exports as well.\n  * But not when you see module M( f ), even if f is a\n    class method with a parent.\n  * Nor when you see module M( module N ), with N /= M.\n\nBut the compromise seemed too much of a hack, so we backed it out.\nYou just have to use an explicit export list:\n    module M( F(..) ) where ...\n\nNote [Avails of associated data families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose you have (Trac #16077)\n\n    {-# LANGUAGE TypeFamilies #-}\n    module A (module A) where\n\n    class    C a  where { data T a }\n    instance C () where { data T () = D }\n\nBecause @A@ is exported explicitly, GHC tries to produce an export list\nfrom the @GlobalRdrEnv@. In this case, it pulls out the following:\n\n    [ C defined at A.hs:4:1\n    , T parent:C defined at A.hs:4:23\n    , D parent:T defined at A.hs:5:35 ]\n\nIf map these directly into avails, (via 'availFromGRE'), we get\n@[C{C;}, C{T;}, T{D;}]@, which eventually gets merged into @[C{C, T;}, T{D;}]@.\nThat's not right, because @T{D;}@ violates the AvailTC invariant: @T@ is\nexported, but it isn't the first entry in the avail!\n\nWe work around this issue by expanding GREs where the parent and child\nare both type constructors into two GRES.\n\n    T parent:C defined at A.hs:4:23\n\n      =>\n\n    [ T parent:C defined at A.hs:4:23\n    , T defined at A.hs:4:23 ]\n\nThen, we get  @[C{C;}, C{T;}, T{T;}, T{D;}]@, which eventually gets merged\ninto @[C{C, T;}, T{T, D;}]@ (which satsifies the AvailTC invariant).\n-}\n\ndata ExportAccum        -- The type of the accumulating parameter of\n                        -- the main worker function in rnExports\n     = ExportAccum\n        ExportOccMap           --  Tracks exported occurrence names\n        (UniqSet ModuleName)   --  Tracks (re-)exported module names\n\nemptyExportAccum :: ExportAccum\nemptyExportAccum = ExportAccum emptyOccEnv emptyUniqSet\n\naccumExports :: (ExportAccum -> x -> TcRn (Maybe (ExportAccum, y)))\n             -> [x]\n             -> TcRn [y]\naccumExports f = fmap (catMaybes . snd) . mapAccumLM f' emptyExportAccum\n  where f' acc x = do\n          m <- try_m (f acc x)\n          pure $ case m of\n            Right (Just (acc', y)) -> (acc', Just y)\n            _                      -> (acc, Nothing)\n\ntype ExportOccMap = OccEnv (Name, IE GhcPs)\n        -- Tracks what a particular exported OccName\n        --   in an export list refers to, and which item\n        --   it came from.  It's illegal to export two distinct things\n        --   that have the same occurrence name\n\ntcRnExports :: Bool       -- False => no 'module M(..) where' header at all\n          -> Maybe (Located [LIE GhcPs]) -- Nothing => no explicit export list\n          -> TcGblEnv\n          -> RnM TcGblEnv\n\n        -- Complains if two distinct exports have same OccName\n        -- Warns about identical exports.\n        -- Complains about exports items not in scope\n\ntcRnExports explicit_mod exports\n          tcg_env@TcGblEnv { tcg_mod     = this_mod,\n                              tcg_rdr_env = rdr_env,\n                              tcg_imports = imports,\n                              tcg_src     = hsc_src }\n = unsetWOptM Opt_WarnWarningsDeprecations $\n       -- Do not report deprecations arising from the export\n       -- list, to avoid bleating about re-exporting a deprecated\n       -- thing (especially via 'module Foo' export item)\n   do   {\n        -- In interactive mode, we behave as if he had\n        -- written \"module Main where ...\"\n        ; dflags <- getDynFlags\n        ; let is_main_mod = mainModIs dflags == this_mod\n        ; let default_main = case mainFunIs dflags of\n                 Just main_fun\n                     | is_main_mod -> mkUnqual varName (fsLit main_fun)\n                 _                 -> main_RDR_Unqual\n        ; let real_exports\n                 | explicit_mod = exports\n                 | ghcLink dflags == LinkInMemory = Nothing\n                 | otherwise\n                          = Just (noLoc [noLoc (IEVar noExt\n                                     (noLoc (IEName $ noLoc default_main)))])\n                        -- ToDo: the 'noLoc' here is unhelpful if 'main'\n                        --       turns out to be out of scope\n\n        ; let do_it = exports_from_avail real_exports rdr_env imports this_mod\n        ; (rn_exports, final_avails)\n            <- if hsc_src == HsigFile\n                then do (msgs, mb_r) <- tryTc do_it\n                        case mb_r of\n                            Just r  -> return r\n                            Nothing -> addMessages msgs >> failM\n                else checkNoErrs do_it\n        ; let final_ns     = availsToNameSetWithSelectors final_avails\n\n        ; traceRn \"rnExports: Exports:\" (ppr final_avails)\n\n        ; let new_tcg_env =\n                  tcg_env { tcg_exports    = final_avails,\n                             tcg_rn_exports = case tcg_rn_exports tcg_env of\n                                                Nothing -> Nothing\n                                                Just _  -> rn_exports,\n                            tcg_dus = tcg_dus tcg_env `plusDU`\n                                      usesOnly final_ns }\n        ; failIfErrsM\n        ; return new_tcg_env }\n\nexports_from_avail :: Maybe (Located [LIE GhcPs])\n                         -- ^ 'Nothing' means no explicit export list\n                   -> GlobalRdrEnv\n                   -> ImportAvails\n                         -- ^ Imported modules; this is used to test if a\n                         -- @module Foo@ export is valid (it's not valid\n                         -- if we didn't import @Foo@!)\n                   -> Module\n                   -> RnM (Maybe [(LIE GhcRn, Avails)], Avails)\n                         -- (Nothing, _) <=> no explicit export list\n                         -- if explicit export list is present it contains\n                         -- each renamed export item together with its exported\n                         -- names.\n\nexports_from_avail Nothing rdr_env _imports _this_mod\n   -- The same as (module M) where M is the current module name,\n   -- so that's how we handle it, except we also export the data family\n   -- when a data instance is exported.\n  = do {\n    ; warnMissingExportList <- woptM Opt_WarnMissingExportList\n    ; warnIfFlag Opt_WarnMissingExportList\n        warnMissingExportList\n        (missingModuleExportWarn $ moduleName _this_mod)\n    ; let avails =\n            map fix_faminst . gresToAvailInfo\n              . filter isLocalGRE . globalRdrEnvElts $ rdr_env\n    ; return (Nothing, avails) }\n  where\n    -- #11164: when we define a data instance\n    -- but not data family, re-export the family\n    -- Even though we don't check whether this is actually a data family\n    -- only data families can locally define subordinate things (`ns` here)\n    -- without locally defining (and instead importing) the parent (`n`)\n    fix_faminst (AvailTC n ns flds) =\n      let new_ns =\n            case ns of\n              [] -> [n]\n              (p:_) -> if p == n then ns else n:ns\n      in AvailTC n new_ns flds\n\n    fix_faminst avail = avail\n\n\nexports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod\n  = do ie_avails <- accumExports do_litem rdr_items\n       let final_exports = nubAvails (concat (map snd ie_avails)) -- Combine families\n       return (Just ie_avails, final_exports)\n  where\n    do_litem :: ExportAccum -> LIE GhcPs\n             -> RnM (Maybe (ExportAccum, (LIE GhcRn, Avails)))\n    do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)\n\n    -- Maps a parent to its in-scope children\n    kids_env :: NameEnv [GlobalRdrElt]\n    kids_env = mkChildEnv (globalRdrEnvElts rdr_env)\n\n    -- See Note [Avails of associated data families]\n    expand_tyty_gre :: GlobalRdrElt -> [GlobalRdrElt]\n    expand_tyty_gre (gre @ GRE { gre_name = me, gre_par = ParentIs p })\n      | isTyConName p, isTyConName me = [gre, gre{ gre_par = NoParent }]\n    expand_tyty_gre gre = [gre]\n\n    imported_modules = [ imv_name imv\n                       | xs <- moduleEnvElts $ imp_mods imports\n                       , imv <- importedByUser xs ]\n\n    exports_from_item :: ExportAccum -> LIE GhcPs\n                      -> RnM (Maybe (ExportAccum, (LIE GhcRn, Avails)))\n    exports_from_item (ExportAccum occs earlier_mods)\n                      (dL->L loc ie@(IEModuleContents _ lmod@(dL->L _ mod)))\n        | mod `elementOfUniqSet` earlier_mods    -- Duplicate export of M\n        = do { warnIfFlag Opt_WarnDuplicateExports True\n                          (dupModuleExport mod) ;\n               return Nothing }\n\n        | otherwise\n        = do { let { exportValid = (mod `elem` imported_modules)\n                                || (moduleName this_mod == mod)\n                   ; gre_prs     = pickGREsModExp mod (globalRdrEnvElts rdr_env)\n                   ; new_exports = [ availFromGRE gre'\n                                   | (gre, _) <- gre_prs\n                                   , gre' <- expand_tyty_gre gre ]\n                   ; all_gres    = foldr (\\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs\n                   ; mods        = addOneToUniqSet earlier_mods mod\n                   }\n\n             ; checkErr exportValid (moduleNotImported mod)\n             ; warnIfFlag Opt_WarnDodgyExports\n                          (exportValid && null gre_prs)\n                          (nullModuleExport mod)\n\n             ; traceRn \"efa\" (ppr mod $$ ppr all_gres)\n             ; addUsedGREs all_gres\n\n             ; occs' <- check_occs ie occs new_exports\n                      -- This check_occs not only finds conflicts\n                      -- between this item and others, but also\n                      -- internally within this item.  That is, if\n                      -- 'M.x' is in scope in several ways, we'll have\n                      -- several members of mod_avails with the same\n                      -- OccName.\n             ; traceRn \"export_mod\"\n                       (vcat [ ppr mod\n                             , ppr new_exports ])\n\n             ; return (Just ( ExportAccum occs' mods\n                            , ( cL loc (IEModuleContents noExt lmod)\n                              , new_exports))) }\n\n    exports_from_item acc@(ExportAccum occs mods) (dL->L loc ie)\n        | isDoc ie\n        = do new_ie <- lookup_doc_ie ie\n             return (Just (acc, (cL loc new_ie, [])))\n\n        | otherwise\n        = do (new_ie, avail) <- lookup_ie ie\n             if isUnboundName (ieName new_ie)\n                  then return Nothing    -- Avoid error cascade\n                  else do\n\n                    occs' <- check_occs ie occs [avail]\n\n                    return (Just ( ExportAccum occs' mods\n                                 , (cL loc new_ie, [avail])))\n\n    -------------\n    lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo)\n    lookup_ie (IEVar _ (dL->L l rdr))\n        = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr\n             return (IEVar noExt (cL l (replaceWrappedName rdr name)), avail)\n\n    lookup_ie (IEThingAbs _ (dL->L l rdr))\n        = do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr\n             return (IEThingAbs noExt (cL l (replaceWrappedName rdr name))\n                    , avail)\n\n    lookup_ie ie@(IEThingAll _ n')\n        = do\n            (n, avail, flds) <- lookup_ie_all ie n'\n            let name = unLoc n\n            return (IEThingAll noExt (replaceLWrappedName n' (unLoc n))\n                   , AvailTC name (name:avail) flds)\n\n\n    lookup_ie ie@(IEThingWith _ l wc sub_rdrs _)\n        = do\n            (lname, subs, avails, flds)\n              <- addExportErrCtxt ie $ lookup_ie_with l sub_rdrs\n            (_, all_avail, all_flds) <-\n              case wc of\n                NoIEWildcard -> return (lname, [], [])\n                IEWildcard _ -> lookup_ie_all ie l\n            let name = unLoc lname\n            return (IEThingWith noExt (replaceLWrappedName l name) wc subs\n                                (flds ++ (map noLoc all_flds)),\n                    AvailTC name (name : avails ++ all_avail)\n                                 (map unLoc flds ++ all_flds))\n\n\n    lookup_ie _ = panic \"lookup_ie\"    -- Other cases covered earlier\n\n\n    lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName]\n                   -> RnM (Located Name, [LIEWrappedName Name], [Name],\n                           [Located FieldLabel])\n    lookup_ie_with (dL->L l rdr) sub_rdrs\n        = do name <- lookupGlobalOccRn $ ieWrappedName rdr\n             (non_flds, flds) <- lookupChildrenExport name sub_rdrs\n             if isUnboundName name\n                then return (cL l name, [], [name], [])\n                else return (cL l name, non_flds\n                            , map (ieWrappedName . unLoc) non_flds\n                            , flds)\n\n    lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName\n                  -> RnM (Located Name, [Name], [FieldLabel])\n    lookup_ie_all ie (dL->L l rdr) =\n          do name <- lookupGlobalOccRn $ ieWrappedName rdr\n             let gres = findChildren kids_env name\n                 (non_flds, flds) = classifyGREs gres\n             addUsedKids (ieWrappedName rdr) gres\n             warnDodgyExports <- woptM Opt_WarnDodgyExports\n             when (null gres) $\n                  if isTyConName name\n                  then when warnDodgyExports $\n                           addWarn (Reason Opt_WarnDodgyExports)\n                                   (dodgyExportWarn name)\n                  else -- This occurs when you export T(..), but\n                       -- only import T abstractly, or T is a synonym.\n                       addErr (exportItemErr ie)\n             return (cL l name, non_flds, flds)\n\n    -------------\n    lookup_doc_ie :: IE GhcPs -> RnM (IE GhcRn)\n    lookup_doc_ie (IEGroup _ lev doc) = do rn_doc <- rnHsDoc doc\n                                           return (IEGroup noExt lev rn_doc)\n    lookup_doc_ie (IEDoc _ doc)       = do rn_doc <- rnHsDoc doc\n                                           return (IEDoc noExt rn_doc)\n    lookup_doc_ie (IEDocNamed _ str)  = return (IEDocNamed noExt str)\n    lookup_doc_ie _ = panic \"lookup_doc_ie\"    -- Other cases covered earlier\n\n    -- In an export item M.T(A,B,C), we want to treat the uses of\n    -- A,B,C as if they were M.A, M.B, M.C\n    -- Happily pickGREs does just the right thing\n    addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()\n    addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)\n\nclassifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])\nclassifyGREs = partitionEithers . map classifyGRE\n\nclassifyGRE :: GlobalRdrElt -> Either Name FieldLabel\nclassifyGRE gre = case gre_par gre of\n  FldParent _ Nothing -> Right (FieldLabel (occNameFS (nameOccName n)) False n)\n  FldParent _ (Just lbl) -> Right (FieldLabel lbl True n)\n  _                      -> Left  n\n  where\n    n = gre_name gre\n\nisDoc :: IE GhcPs -> Bool\nisDoc (IEDoc {})      = True\nisDoc (IEDocNamed {}) = True\nisDoc (IEGroup {})    = True\nisDoc _ = False\n\n-- Renaming and typechecking of exports happens after everything else has\n-- been typechecked.\n\n\n\n-- Renaming exports lists is a minefield. Five different things can appear in\n-- children export lists ( T(A, B, C) ).\n-- 1. Record selectors\n-- 2. Type constructors\n-- 3. Data constructors\n-- 4. Pattern Synonyms\n-- 5. Pattern Synonym Selectors\n--\n-- However, things get put into weird name spaces.\n-- 1. Some type constructors are parsed as variables (-.->) for example.\n-- 2. All data constructors are parsed as type constructors\n-- 3. When there is ambiguity, we default type constructors to data\n-- constructors and require the explicit `type` keyword for type\n-- constructors.\n--\n-- This function first establishes the possible namespaces that an\n-- identifier might be in (`choosePossibleNameSpaces`).\n--\n-- Then for each namespace in turn, tries to find the correct identifier\n-- there returning the first positive result or the first terminating\n-- error.\n--\n\n\n\nlookupChildrenExport :: Name -> [LIEWrappedName RdrName]\n                     -> RnM ([LIEWrappedName Name], [Located FieldLabel])\nlookupChildrenExport spec_parent rdr_items =\n  do\n    xs <- mapAndReportM doOne rdr_items\n    return $ partitionEithers xs\n    where\n        -- Pick out the possible namespaces in order of priority\n        -- This is a consequence of how the parser parses all\n        -- data constructors as type constructors.\n        choosePossibleNamespaces :: NameSpace -> [NameSpace]\n        choosePossibleNamespaces ns\n          | ns == varName = [varName, tcName]\n          | ns == tcName  = [dataName, tcName]\n          | otherwise = [ns]\n        -- Process an individual child\n        doOne :: LIEWrappedName RdrName\n              -> RnM (Either (LIEWrappedName Name) (Located FieldLabel))\n        doOne n = do\n\n          let bareName = (ieWrappedName . unLoc) n\n              lkup v = lookupSubBndrOcc_helper False True\n                        spec_parent (setRdrNameSpace bareName v)\n\n          name <-  combineChildLookupResult $ map lkup $\n                   choosePossibleNamespaces (rdrNameSpace bareName)\n          traceRn \"lookupChildrenExport\" (ppr name)\n          -- Default to data constructors for slightly better error\n          -- messages\n          let unboundName :: RdrName\n              unboundName = if rdrNameSpace bareName == varName\n                                then bareName\n                                else setRdrNameSpace bareName dataName\n\n          case name of\n            NameNotFound -> do { ub <- reportUnboundName unboundName\n                               ; let l = getLoc n\n                               ; return (Left (cL l (IEName (cL l ub))))}\n            FoundFL fls -> return $ Right (cL (getLoc n) fls)\n            FoundName par name -> do { checkPatSynParent spec_parent par name\n                                     ; return\n                                       $ Left (replaceLWrappedName n name) }\n            IncorrectParent p g td gs -> failWithDcErr p g td gs\n\n\n-- Note: [Typing Pattern Synonym Exports]\n-- It proved quite a challenge to precisely specify which pattern synonyms\n-- should be allowed to be bundled with which type constructors.\n-- In the end it was decided to be quite liberal in what we allow. Below is\n-- how Simon described the implementation.\n--\n-- \"Personally I think we should Keep It Simple.  All this talk of\n--  satisfiability makes me shiver.  I suggest this: allow T( P ) in all\n--   situations except where `P`'s type is ''visibly incompatible'' with\n--   `T`.\n--\n--    What does \"visibly incompatible\" mean?  `P` is visibly incompatible\n--    with\n--     `T` if\n--       * `P`'s type is of form `... -> S t1 t2`\n--       * `S` is a data/newtype constructor distinct from `T`\n--\n--  Nothing harmful happens if we allow `P` to be exported with\n--  a type it can't possibly be useful for, but specifying a tighter\n--  relationship is very awkward as you have discovered.\"\n--\n-- Note that this allows *any* pattern synonym to be bundled with any\n-- datatype type constructor. For example, the following pattern `P` can be\n-- bundled with any type.\n--\n-- ```\n-- pattern P :: (A ~ f) => f\n-- ```\n--\n-- So we provide basic type checking in order to help the user out, most\n-- pattern synonyms are defined with definite type constructors, but don't\n-- actually prevent a library author completely confusing their users if\n-- they want to.\n--\n-- So, we check for exactly four things\n-- 1. The name arises from a pattern synonym definition. (Either a pattern\n--    synonym constructor or a pattern synonym selector)\n-- 2. The pattern synonym is only bundled with a datatype or newtype.\n-- 3. Check that the head of the result type constructor is an actual type\n--    constructor and not a type variable. (See above example)\n-- 4. Is so, check that this type constructor is the same as the parent\n--    type constructor.\n--\n--\n-- Note: [Types of TyCon]\n--\n-- This check appears to be overlly complicated, Richard asked why it\n-- is not simply just `isAlgTyCon`. The answer for this is that\n-- a classTyCon is also an `AlgTyCon` which we explicitly want to disallow.\n-- (It is either a newtype or data depending on the number of methods)\n--\n\n-- | Given a resolved name in the children export list and a parent. Decide\n-- whether we are allowed to export the child with the parent.\n-- Invariant: gre_par == NoParent\n-- See note [Typing Pattern Synonym Exports]\ncheckPatSynParent :: Name    -- ^ Alleged parent type constructor\n                             -- User wrote T( P, Q )\n                  -> Parent  -- The parent of P we discovered\n                  -> Name    -- ^ Either a\n                             --   a) Pattern Synonym Constructor\n                             --   b) A pattern synonym selector\n                  -> TcM ()  -- Fails if wrong parent\ncheckPatSynParent _ (ParentIs {}) _\n  = return ()\n\ncheckPatSynParent _ (FldParent {}) _\n  = return ()\n\ncheckPatSynParent parent NoParent mpat_syn\n  | isUnboundName parent -- Avoid an error cascade\n  = return ()\n\n  | otherwise\n  = do { parent_ty_con <- tcLookupTyCon parent\n       ; mpat_syn_thing <- tcLookupGlobal mpat_syn\n\n        -- 1. Check that the Id was actually from a thing associated with patsyns\n       ; case mpat_syn_thing of\n            AnId i | isId i\n                   , RecSelId { sel_tycon = RecSelPatSyn p } <- idDetails i\n                   -> handle_pat_syn (selErr i) parent_ty_con p\n\n            AConLike (PatSynCon p) -> handle_pat_syn (psErr p) parent_ty_con p\n\n            _ -> failWithDcErr parent mpat_syn (ppr mpat_syn) [] }\n  where\n    psErr  = exportErrCtxt \"pattern synonym\"\n    selErr = exportErrCtxt \"pattern synonym record selector\"\n\n    assocClassErr :: SDoc\n    assocClassErr = text \"Pattern synonyms can be bundled only with datatypes.\"\n\n    handle_pat_syn :: SDoc\n                   -> TyCon      -- ^ Parent TyCon\n                   -> PatSyn     -- ^ Corresponding bundled PatSyn\n                                 --   and pretty printed origin\n                   -> TcM ()\n    handle_pat_syn doc ty_con pat_syn\n\n      -- 2. See note [Types of TyCon]\n      | not $ isTyConWithSrcDataCons ty_con\n      = addErrCtxt doc $ failWithTc assocClassErr\n\n      -- 3. Is the head a type variable?\n      | Nothing <- mtycon\n      = return ()\n      -- 4. Ok. Check they are actually the same type constructor.\n\n      | Just p_ty_con <- mtycon, p_ty_con /= ty_con\n      = addErrCtxt doc $ failWithTc typeMismatchError\n\n      -- 5. We passed!\n      | otherwise\n      = return ()\n\n      where\n        expected_res_ty = mkTyConApp ty_con (mkTyVarTys (tyConTyVars ty_con))\n        (_, _, _, _, _, res_ty) = patSynSig pat_syn\n        mtycon = fst <$> tcSplitTyConApp_maybe res_ty\n        typeMismatchError :: SDoc\n        typeMismatchError =\n          text \"Pattern synonyms can only be bundled with matching type constructors\"\n              $$ text \"Couldn't match expected type of\"\n              <+> quotes (ppr expected_res_ty)\n              <+> text \"with actual type of\"\n              <+> quotes (ppr res_ty)\n\n\n{-===========================================================================-}\ncheck_occs :: IE GhcPs -> ExportOccMap -> [AvailInfo]\n           -> RnM ExportOccMap\ncheck_occs ie occs avails\n  -- 'names' and 'fls' are the entities specified by 'ie'\n  = foldlM check occs names_with_occs\n  where\n    -- Each Name specified by 'ie', paired with the OccName used to\n    -- refer to it in the GlobalRdrEnv\n    -- (see Note [Representing fields in AvailInfo] in Avail).\n    --\n    -- We check for export clashes using the selector Name, but need\n    -- the field label OccName for presenting error messages.\n    names_with_occs = availsNamesWithOccs avails\n\n    check occs (name, occ)\n      = case lookupOccEnv occs name_occ of\n          Nothing -> return (extendOccEnv occs name_occ (name, ie))\n\n          Just (name', ie')\n            | name == name'   -- Duplicate export\n            -- But we don't want to warn if the same thing is exported\n            -- by two different module exports. See ticket #4478.\n            -> do { warnIfFlag Opt_WarnDuplicateExports\n                               (not (dupExport_ok name ie ie'))\n                               (dupExportWarn occ ie ie')\n                  ; return occs }\n\n            | otherwise    -- Same occ name but different names: an error\n            ->  do { global_env <- getGlobalRdrEnv ;\n                     addErr (exportClashErr global_env occ name' name ie' ie) ;\n                     return occs }\n      where\n        name_occ = nameOccName name\n\n\ndupExport_ok :: Name -> IE GhcPs -> IE GhcPs -> Bool\n-- The Name is exported by both IEs. Is that ok?\n-- \"No\"  iff the name is mentioned explicitly in both IEs\n--        or one of the IEs mentions the name *alone*\n-- \"Yes\" otherwise\n--\n-- Examples of \"no\":  module M( f, f )\n--                    module M( fmap, Functor(..) )\n--                    module M( module Data.List, head )\n--\n-- Example of \"yes\"\n--    module M( module A, module B ) where\n--        import A( f )\n--        import B( f )\n--\n-- Example of \"yes\" (Trac #2436)\n--    module M( C(..), T(..) ) where\n--         class C a where { data T a }\n--         instance C Int where { data T Int = TInt }\n--\n-- Example of \"yes\" (Trac #2436)\n--    module Foo ( T ) where\n--      data family T a\n--    module Bar ( T(..), module Foo ) where\n--        import Foo\n--        data instance T Int = TInt\n\ndupExport_ok n ie1 ie2\n  = not (  single ie1 || single ie2\n        || (explicit_in ie1 && explicit_in ie2) )\n  where\n    explicit_in (IEModuleContents {}) = False                   -- module M\n    explicit_in (IEThingAll _ r)\n      = nameOccName n == rdrNameOcc (ieWrappedName $ unLoc r)  -- T(..)\n    explicit_in _              = True\n\n    single IEVar {}      = True\n    single IEThingAbs {} = True\n    single _               = False\n\n\ndupModuleExport :: ModuleName -> SDoc\ndupModuleExport mod\n  = hsep [text \"Duplicate\",\n          quotes (text \"Module\" <+> ppr mod),\n          text \"in export list\"]\n\nmoduleNotImported :: ModuleName -> SDoc\nmoduleNotImported mod\n  = hsep [text \"The export item\",\n          quotes (text \"module\" <+> ppr mod),\n          text \"is not imported\"]\n\nnullModuleExport :: ModuleName -> SDoc\nnullModuleExport mod\n  = hsep [text \"The export item\",\n          quotes (text \"module\" <+> ppr mod),\n          text \"exports nothing\"]\n\nmissingModuleExportWarn :: ModuleName -> SDoc\nmissingModuleExportWarn mod\n  = hsep [text \"The export item\",\n          quotes (text \"module\" <+> ppr mod),\n          text \"is missing an export list\"]\n\n\ndodgyExportWarn :: Name -> SDoc\ndodgyExportWarn item\n  = dodgyMsg (text \"export\") item (dodgyMsgInsert item :: IE GhcRn)\n\nexportErrCtxt :: Outputable o => String -> o -> SDoc\nexportErrCtxt herald exp =\n  text \"In the\" <+> text (herald ++ \":\") <+> ppr exp\n\n\naddExportErrCtxt :: (OutputableBndrId (GhcPass p))\n                 => IE (GhcPass p) -> TcM a -> TcM a\naddExportErrCtxt ie = addErrCtxt exportCtxt\n  where\n    exportCtxt = text \"In the export:\" <+> ppr ie\n\nexportItemErr :: IE GhcPs -> SDoc\nexportItemErr export_item\n  = sep [ text \"The export item\" <+> quotes (ppr export_item),\n          text \"attempts to export constructors or class methods that are not visible here\" ]\n\n\ndupExportWarn :: OccName -> IE GhcPs -> IE GhcPs -> SDoc\ndupExportWarn occ_name ie1 ie2\n  = hsep [quotes (ppr occ_name),\n          text \"is exported by\", quotes (ppr ie1),\n          text \"and\",            quotes (ppr ie2)]\n\ndcErrMsg :: Name -> String -> SDoc -> [SDoc] -> SDoc\ndcErrMsg ty_con what_is thing parents =\n          text \"The type constructor\" <+> quotes (ppr ty_con)\n                <+> text \"is not the parent of the\" <+> text what_is\n                <+> quotes thing <> char '.'\n                $$ text (capitalise what_is)\n                <> text \"s can only be exported with their parent type constructor.\"\n                $$ (case parents of\n                      [] -> empty\n                      [_] -> text \"Parent:\"\n                      _  -> text \"Parents:\") <+> fsep (punctuate comma parents)\n\nfailWithDcErr :: Name -> Name -> SDoc -> [Name] -> TcM a\nfailWithDcErr parent thing thing_doc parents = do\n  ty_thing <- tcLookupGlobal thing\n  failWithTc $ dcErrMsg parent (tyThingCategory' ty_thing)\n                        thing_doc (map ppr parents)\n  where\n    tyThingCategory' :: TyThing -> String\n    tyThingCategory' (AnId i)\n      | isRecordSelector i = \"record selector\"\n    tyThingCategory' i = tyThingCategory i\n\n\nexportClashErr :: GlobalRdrEnv -> OccName\n               -> Name -> Name\n               -> IE GhcPs -> IE GhcPs\n               -> MsgDoc\nexportClashErr global_env occ name1 name2 ie1 ie2\n  = vcat [ text \"Conflicting exports for\" <+> quotes (ppr occ) <> colon\n         , ppr_export ie1' name1'\n         , ppr_export ie2' name2' ]\n  where\n    ppr_export ie name = nest 3 (hang (quotes (ppr ie) <+> text \"exports\" <+>\n                                       quotes (ppr_name name))\n                                    2 (pprNameProvenance (get_gre name)))\n\n    -- DuplicateRecordFields means that nameOccName might be a mangled\n    -- $sel-prefixed thing, in which case show the correct OccName alone\n    ppr_name name\n      | nameOccName name == occ = ppr name\n      | otherwise               = ppr occ\n\n    -- get_gre finds a GRE for the Name, so that we can show its provenance\n    get_gre name\n        = fromMaybe (pprPanic \"exportClashErr\" (ppr name))\n                    (lookupGRE_Name_OccName global_env name occ)\n    get_loc name = greSrcSpan (get_gre name)\n    (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2\n                                   then (name1, ie1, name2, ie2)\n                                   else (name2, ie2, name1, ie1)\n", "num_lines": 820}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n\n\nFunctions for working with the typechecker environment (setters, getters...).\n-}\n\n{-# LANGUAGE CPP, ExplicitForAll, FlexibleInstances, BangPatterns #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n{-# LANGUAGE ViewPatterns #-}\n\n\nmodule TcRnMonad(\n  -- * Initalisation\n  initTc, initTcWithGbl, initTcInteractive, initTcRnIf,\n\n  -- * Simple accessors\n  discardResult,\n  getTopEnv, updTopEnv, getGblEnv, updGblEnv,\n  setGblEnv, getLclEnv, updLclEnv, setLclEnv,\n  getEnvs, setEnvs,\n  xoptM, doptM, goptM, woptM,\n  setXOptM, unsetXOptM, unsetGOptM, unsetWOptM,\n  whenDOptM, whenGOptM, whenWOptM,\n  whenXOptM, unlessXOptM,\n  getGhcMode,\n  withDoDynamicToo,\n  getEpsVar,\n  getEps,\n  updateEps, updateEps_,\n  getHpt, getEpsAndHpt,\n\n  -- * Arrow scopes\n  newArrowScope, escapeArrowScope,\n\n  -- * Unique supply\n  newUnique, newUniqueSupply, newName, newNameAt, cloneLocalName,\n  newSysName, newSysLocalId, newSysLocalIds,\n\n  -- * Accessing input/output\n  newTcRef, readTcRef, writeTcRef, updTcRef,\n\n  -- * Debugging\n  traceTc, traceRn, traceOptTcRn, traceTcRn, traceTcRnForUser,\n  traceTcRnWithStyle,\n  getPrintUnqualified,\n  printForUserTcRn,\n  traceIf, traceHiDiffs, traceOptIf,\n  debugTc,\n\n  -- * Typechecker global environment\n  getIsGHCi, getGHCiMonad, getInteractivePrintName,\n  tcIsHsBootOrSig, tcIsHsig, tcSelfBootInfo, getGlobalRdrEnv,\n  getRdrEnvs, getImports,\n  getFixityEnv, extendFixityEnv, getRecFieldEnv,\n  getDeclaredDefaultTys,\n  addDependentFiles,\n\n  -- * Error management\n  getSrcSpanM, setSrcSpan, addLocM,\n  wrapLocM, wrapLocFstM, wrapLocSndM,wrapLocM_,\n  getErrsVar, setErrsVar,\n  addErr,\n  failWith, failAt,\n  addErrAt, addErrs,\n  checkErr,\n  addMessages,\n  discardWarnings,\n\n  -- * Shared error message stuff: renamer and typechecker\n  mkLongErrAt, mkErrDocAt, addLongErrAt, reportErrors, reportError,\n  reportWarning, recoverM, mapAndRecoverM, mapAndReportM, foldAndRecoverM,\n  try_m, tryTc,\n  askNoErrs, discardErrs, tryTcDiscardingErrs,\n  checkNoErrs, whenNoErrs,\n  ifErrsM, failIfErrsM,\n  checkTH, failTH,\n\n  -- * Context management for the type checker\n  getErrCtxt, setErrCtxt, addErrCtxt, addErrCtxtM, addLandmarkErrCtxt,\n  addLandmarkErrCtxtM, updCtxt, popErrCtxt, getCtLocM, setCtLocM,\n\n  -- * Error message generation (type checker)\n  addErrTc, addErrsTc,\n  addErrTcM, mkErrTcM, mkErrTc,\n  failWithTc, failWithTcM,\n  checkTc, checkTcM,\n  failIfTc, failIfTcM,\n  warnIfFlag, warnIf, warnTc, warnTcM,\n  addWarnTc, addWarnTcM, addWarn, addWarnAt, add_warn,\n  mkErrInfo,\n\n  -- * Type constraints\n  newTcEvBinds, newNoTcEvBinds, cloneEvBindsVar,\n  addTcEvBind, addTopEvBinds,\n  getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap,\n  chooseUniqueOccTc,\n  getConstraintVar, setConstraintVar,\n  emitConstraints, emitStaticConstraints, emitSimple, emitSimples,\n  emitImplication, emitImplications, emitInsoluble,\n  discardConstraints, captureConstraints, tryCaptureConstraints,\n  pushLevelAndCaptureConstraints,\n  pushTcLevelM_, pushTcLevelM, pushTcLevelsM,\n  getTcLevel, setTcLevel, isTouchableTcM,\n  getLclTypeEnv, setLclTypeEnv,\n  traceTcConstraints, emitWildCardHoleConstraints,\n\n  -- * Template Haskell context\n  recordThUse, recordThSpliceUse, recordTopLevelSpliceLoc,\n  getTopLevelSpliceLocs, keepAlive, getStage, getStageAndBindLevel, setStage,\n  addModFinalizersWithLclEnv,\n\n  -- * Safe Haskell context\n  recordUnsafeInfer, finalSafeMode, fixSafeInstances,\n\n  -- * Stuff for the renamer's local env\n  getLocalRdrEnv, setLocalRdrEnv,\n\n  -- * Stuff for interface decls\n  mkIfLclEnv,\n  initIfaceTcRn,\n  initIfaceCheck,\n  initIfaceLcl,\n  initIfaceLclWithSubst,\n  initIfaceLoad,\n  getIfModule,\n  failIfM,\n  forkM_maybe,\n  forkM,\n  setImplicitEnvM,\n\n  withException,\n\n  -- * Stuff for cost centres.\n  ContainsCostCentreState(..), getCCIndexM,\n\n  -- * Types etc.\n  module TcRnTypes,\n  module IOEnv\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnTypes        -- Re-export all\nimport IOEnv            -- Re-export all\nimport TcEvidence\n\nimport HsSyn hiding (LIE)\nimport HscTypes\nimport Module\nimport RdrName\nimport Name\nimport Type\n\nimport TcType\nimport InstEnv\nimport FamInstEnv\nimport PrelNames\n\nimport Id\nimport VarSet\nimport VarEnv\nimport ErrUtils\nimport SrcLoc\nimport NameEnv\nimport NameSet\nimport Bag\nimport Outputable\nimport UniqSupply\nimport DynFlags\nimport FastString\nimport Panic\nimport Util\nimport Annotations\nimport BasicTypes( TopLevelFlag )\nimport Maybes\nimport CostCentreState\n\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.IORef\nimport Control.Monad\nimport Data.Set ( Set )\nimport qualified Data.Set as Set\n\nimport {-# SOURCE #-} TcEnv    ( tcInitTidyEnv )\n\nimport qualified Data.Map as Map\n\n{-\n************************************************************************\n*                                                                      *\n                        initTc\n*                                                                      *\n************************************************************************\n-}\n\n-- | Setup the initial typechecking environment\ninitTc :: HscEnv\n       -> HscSource\n       -> Bool          -- True <=> retain renamed syntax trees\n       -> Module\n       -> RealSrcSpan\n       -> TcM r\n       -> IO (Messages, Maybe r)\n                -- Nothing => error thrown by the thing inside\n                -- (error messages should have been printed already)\n\ninitTc hsc_env hsc_src keep_rn_syntax mod loc do_this\n = do { keep_var     <- newIORef emptyNameSet ;\n        used_gre_var <- newIORef [] ;\n        th_var       <- newIORef False ;\n        th_splice_var<- newIORef False ;\n        th_locs_var  <- newIORef Set.empty ;\n        infer_var    <- newIORef (True, emptyBag) ;\n        dfun_n_var   <- newIORef emptyOccSet ;\n        type_env_var <- case hsc_type_env_var hsc_env of {\n                           Just (_mod, te_var) -> return te_var ;\n                           Nothing             -> newIORef emptyNameEnv } ;\n\n        dependent_files_var <- newIORef [] ;\n        static_wc_var       <- newIORef emptyWC ;\n        cc_st_var           <- newIORef newCostCentreState ;\n        th_topdecls_var      <- newIORef [] ;\n        th_foreign_files_var <- newIORef [] ;\n        th_topnames_var      <- newIORef emptyNameSet ;\n        th_modfinalizers_var <- newIORef [] ;\n        th_coreplugins_var <- newIORef [] ;\n        th_state_var         <- newIORef Map.empty ;\n        th_remote_state_var  <- newIORef Nothing ;\n        let {\n             dflags = hsc_dflags hsc_env ;\n\n             maybe_rn_syntax :: forall a. a -> Maybe a ;\n             maybe_rn_syntax empty_val\n                | dopt Opt_D_dump_rn_ast dflags = Just empty_val\n\n                | gopt Opt_WriteHie dflags       = Just empty_val\n\n                  -- We want to serialize the documentation in the .hi-files,\n                  -- and need to extract it from the renamed syntax first.\n                  -- See 'ExtractDocs.extractDocs'.\n                | gopt Opt_Haddock dflags       = Just empty_val\n\n                | keep_rn_syntax                = Just empty_val\n                | otherwise                     = Nothing ;\n\n             gbl_env = TcGblEnv {\n                tcg_th_topdecls      = th_topdecls_var,\n                tcg_th_foreign_files = th_foreign_files_var,\n                tcg_th_topnames      = th_topnames_var,\n                tcg_th_modfinalizers = th_modfinalizers_var,\n                tcg_th_coreplugins = th_coreplugins_var,\n                tcg_th_state         = th_state_var,\n                tcg_th_remote_state  = th_remote_state_var,\n\n                tcg_mod            = mod,\n                tcg_semantic_mod   =\n                    canonicalizeModuleIfHome dflags mod,\n                tcg_src            = hsc_src,\n                tcg_rdr_env        = emptyGlobalRdrEnv,\n                tcg_fix_env        = emptyNameEnv,\n                tcg_field_env      = emptyNameEnv,\n                tcg_default        = if moduleUnitId mod == primUnitId\n                                     then Just []  -- See Note [Default types]\n                                     else Nothing,\n                tcg_type_env       = emptyNameEnv,\n                tcg_type_env_var   = type_env_var,\n                tcg_inst_env       = emptyInstEnv,\n                tcg_fam_inst_env   = emptyFamInstEnv,\n                tcg_ann_env        = emptyAnnEnv,\n                tcg_th_used        = th_var,\n                tcg_th_splice_used = th_splice_var,\n                tcg_th_top_level_locs\n                                   = th_locs_var,\n                tcg_exports        = [],\n                tcg_imports        = emptyImportAvails,\n                tcg_used_gres     = used_gre_var,\n                tcg_dus            = emptyDUs,\n\n                tcg_rn_imports     = [],\n                tcg_rn_exports     =\n                    if hsc_src == HsigFile\n                        -- Always retain renamed syntax, so that we can give\n                        -- better errors.  (TODO: how?)\n                        then Just []\n                        else maybe_rn_syntax [],\n                tcg_rn_decls       = maybe_rn_syntax emptyRnGroup,\n                tcg_tr_module      = Nothing,\n                tcg_binds          = emptyLHsBinds,\n                tcg_imp_specs      = [],\n                tcg_sigs           = emptyNameSet,\n                tcg_ev_binds       = emptyBag,\n                tcg_warns          = NoWarnings,\n                tcg_anns           = [],\n                tcg_tcs            = [],\n                tcg_insts          = [],\n                tcg_fam_insts      = [],\n                tcg_rules          = [],\n                tcg_fords          = [],\n                tcg_patsyns        = [],\n                tcg_merged         = [],\n                tcg_dfun_n         = dfun_n_var,\n                tcg_keep           = keep_var,\n                tcg_doc_hdr        = Nothing,\n                tcg_hpc            = False,\n                tcg_main           = Nothing,\n                tcg_self_boot      = NoSelfBoot,\n                tcg_safeInfer      = infer_var,\n                tcg_dependent_files = dependent_files_var,\n                tcg_tc_plugins     = [],\n                tcg_top_loc        = loc,\n                tcg_static_wc      = static_wc_var,\n                tcg_complete_matches = [],\n                tcg_cc_st          = cc_st_var\n             } ;\n        } ;\n\n        -- OK, here's the business end!\n        initTcWithGbl hsc_env gbl_env loc do_this\n    }\n\n-- | Run a 'TcM' action in the context of an existing 'GblEnv'.\ninitTcWithGbl :: HscEnv\n              -> TcGblEnv\n              -> RealSrcSpan\n              -> TcM r\n              -> IO (Messages, Maybe r)\ninitTcWithGbl hsc_env gbl_env loc do_this\n = do { tvs_var      <- newIORef emptyVarSet\n      ; lie_var      <- newIORef emptyWC\n      ; errs_var     <- newIORef (emptyBag, emptyBag)\n      ; let lcl_env = TcLclEnv {\n                tcl_errs       = errs_var,\n                tcl_loc        = loc,     -- Should be over-ridden very soon!\n                tcl_ctxt       = [],\n                tcl_rdr        = emptyLocalRdrEnv,\n                tcl_th_ctxt    = topStage,\n                tcl_th_bndrs   = emptyNameEnv,\n                tcl_arrow_ctxt = NoArrowCtxt,\n                tcl_env        = emptyNameEnv,\n                tcl_bndrs      = [],\n                tcl_tyvars     = tvs_var,\n                tcl_lie        = lie_var,\n                tcl_tclvl      = topTcLevel\n                }\n\n      ; maybe_res <- initTcRnIf 'a' hsc_env gbl_env lcl_env $\n                     do { r <- tryM do_this\n                        ; case r of\n                          Right res -> return (Just res)\n                          Left _    -> return Nothing }\n\n      -- Check for unsolved constraints\n      -- If we succeed (maybe_res = Just r), there should be\n      -- no unsolved constraints.  But if we exit via an\n      -- exception (maybe_res = Nothing), we may have skipped\n      -- solving, so don't panic then (Trac #13466)\n      ; lie <- readIORef (tcl_lie lcl_env)\n      ; when (isJust maybe_res && not (isEmptyWC lie)) $\n        pprPanic \"initTc: unsolved constraints\" (ppr lie)\n\n        -- Collect any error messages\n      ; msgs <- readIORef (tcl_errs lcl_env)\n\n      ; let { final_res | errorsFound dflags msgs = Nothing\n                        | otherwise               = maybe_res }\n\n      ; return (msgs, final_res)\n      }\n  where dflags = hsc_dflags hsc_env\n\ninitTcInteractive :: HscEnv -> TcM a -> IO (Messages, Maybe a)\n-- Initialise the type checker monad for use in GHCi\ninitTcInteractive hsc_env thing_inside\n  = initTc hsc_env HsSrcFile False\n           (icInteractiveModule (hsc_IC hsc_env))\n           (realSrcLocSpan interactive_src_loc)\n           thing_inside\n  where\n    interactive_src_loc = mkRealSrcLoc (fsLit \"<interactive>\") 1 1\n\n{- Note [Default types]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe Integer type is simply not available in package ghc-prim (it is\ndeclared in integer-gmp).  So we set the defaulting types to (Just\n[]), meaning there are no default types, rather then Nothing, which\nmeans \"use the default default types of Integer, Double\".\n\nIf you don't do this, attempted defaulting in package ghc-prim causes\nan actual crash (attempting to look up the Integer type).\n\n\n************************************************************************\n*                                                                      *\n                Initialisation\n*                                                                      *\n************************************************************************\n-}\n\ninitTcRnIf :: Char              -- Tag for unique supply\n           -> HscEnv\n           -> gbl -> lcl\n           -> TcRnIf gbl lcl a\n           -> IO a\ninitTcRnIf uniq_tag hsc_env gbl_env lcl_env thing_inside\n   = do { us     <- mkSplitUniqSupply uniq_tag ;\n        ; us_var <- newIORef us ;\n\n        ; let { env = Env { env_top = hsc_env,\n                            env_us  = us_var,\n                            env_gbl = gbl_env,\n                            env_lcl = lcl_env} }\n\n        ; runIOEnv env thing_inside\n        }\n\n{-\n************************************************************************\n*                                                                      *\n                Simple accessors\n*                                                                      *\n************************************************************************\n-}\n\ndiscardResult :: TcM a -> TcM ()\ndiscardResult a = a >> return ()\n\ngetTopEnv :: TcRnIf gbl lcl HscEnv\ngetTopEnv = do { env <- getEnv; return (env_top env) }\n\nupdTopEnv :: (HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nupdTopEnv upd = updEnv (\\ env@(Env { env_top = top }) ->\n                          env { env_top = upd top })\n\ngetGblEnv :: TcRnIf gbl lcl gbl\ngetGblEnv = do { Env{..} <- getEnv; return env_gbl }\n\nupdGblEnv :: (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nupdGblEnv upd = updEnv (\\ env@(Env { env_gbl = gbl }) ->\n                          env { env_gbl = upd gbl })\n\nsetGblEnv :: gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nsetGblEnv gbl_env = updEnv (\\ env -> env { env_gbl = gbl_env })\n\ngetLclEnv :: TcRnIf gbl lcl lcl\ngetLclEnv = do { Env{..} <- getEnv; return env_lcl }\n\nupdLclEnv :: (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nupdLclEnv upd = updEnv (\\ env@(Env { env_lcl = lcl }) ->\n                          env { env_lcl = upd lcl })\n\nsetLclEnv :: lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a\nsetLclEnv lcl_env = updEnv (\\ env -> env { env_lcl = lcl_env })\n\ngetEnvs :: TcRnIf gbl lcl (gbl, lcl)\ngetEnvs = do { env <- getEnv; return (env_gbl env, env_lcl env) }\n\nsetEnvs :: (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a\nsetEnvs (gbl_env, lcl_env) = updEnv (\\ env -> env { env_gbl = gbl_env, env_lcl = lcl_env })\n\n-- Command-line flags\n\nxoptM :: LangExt.Extension -> TcRnIf gbl lcl Bool\nxoptM flag = do { dflags <- getDynFlags; return (xopt flag dflags) }\n\ndoptM :: DumpFlag -> TcRnIf gbl lcl Bool\ndoptM flag = do { dflags <- getDynFlags; return (dopt flag dflags) }\n\ngoptM :: GeneralFlag -> TcRnIf gbl lcl Bool\ngoptM flag = do { dflags <- getDynFlags; return (gopt flag dflags) }\n\nwoptM :: WarningFlag -> TcRnIf gbl lcl Bool\nwoptM flag = do { dflags <- getDynFlags; return (wopt flag dflags) }\n\nsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nsetXOptM flag =\n  updTopEnv (\\top -> top { hsc_dflags = xopt_set (hsc_dflags top) flag})\n\nunsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nunsetXOptM flag =\n  updTopEnv (\\top -> top { hsc_dflags = xopt_unset (hsc_dflags top) flag})\n\nunsetGOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nunsetGOptM flag =\n  updTopEnv (\\top -> top { hsc_dflags = gopt_unset (hsc_dflags top) flag})\n\nunsetWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nunsetWOptM flag =\n  updTopEnv (\\top -> top { hsc_dflags = wopt_unset (hsc_dflags top) flag})\n\n-- | Do it flag is true\nwhenDOptM :: DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()\nwhenDOptM flag thing_inside = do b <- doptM flag\n                                 when b thing_inside\n\nwhenGOptM :: GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()\nwhenGOptM flag thing_inside = do b <- goptM flag\n                                 when b thing_inside\n\nwhenWOptM :: WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()\nwhenWOptM flag thing_inside = do b <- woptM flag\n                                 when b thing_inside\n\nwhenXOptM :: LangExt.Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()\nwhenXOptM flag thing_inside = do b <- xoptM flag\n                                 when b thing_inside\n\nunlessXOptM :: LangExt.Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()\nunlessXOptM flag thing_inside = do b <- xoptM flag\n                                   unless b thing_inside\n\ngetGhcMode :: TcRnIf gbl lcl GhcMode\ngetGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) }\n\nwithDoDynamicToo :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a\nwithDoDynamicToo =\n  updTopEnv (\\top@(HscEnv { hsc_dflags = dflags }) ->\n              top { hsc_dflags = dynamicTooMkDynamicDynFlags dflags })\n\ngetEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState)\ngetEpsVar = do { env <- getTopEnv; return (hsc_EPS env) }\n\ngetEps :: TcRnIf gbl lcl ExternalPackageState\ngetEps = do { env <- getTopEnv; readMutVar (hsc_EPS env) }\n\n-- | Update the external package state.  Returns the second result of the\n-- modifier function.\n--\n-- This is an atomic operation and forces evaluation of the modified EPS in\n-- order to avoid space leaks.\nupdateEps :: (ExternalPackageState -> (ExternalPackageState, a))\n          -> TcRnIf gbl lcl a\nupdateEps upd_fn = do\n  traceIf (text \"updating EPS\")\n  eps_var <- getEpsVar\n  atomicUpdMutVar' eps_var upd_fn\n\n-- | Update the external package state.\n--\n-- This is an atomic operation and forces evaluation of the modified EPS in\n-- order to avoid space leaks.\nupdateEps_ :: (ExternalPackageState -> ExternalPackageState)\n           -> TcRnIf gbl lcl ()\nupdateEps_ upd_fn = do\n  traceIf (text \"updating EPS_\")\n  eps_var <- getEpsVar\n  atomicUpdMutVar' eps_var (\\eps -> (upd_fn eps, ()))\n\ngetHpt :: TcRnIf gbl lcl HomePackageTable\ngetHpt = do { env <- getTopEnv; return (hsc_HPT env) }\n\ngetEpsAndHpt :: TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)\ngetEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env)\n                  ; return (eps, hsc_HPT env) }\n\n-- | A convenient wrapper for taking a @MaybeErr MsgDoc a@ and throwing\n-- an exception if it is an error.\nwithException :: TcRnIf gbl lcl (MaybeErr MsgDoc a) -> TcRnIf gbl lcl a\nwithException do_this = do\n    r <- do_this\n    dflags <- getDynFlags\n    case r of\n        Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (showSDoc dflags err))\n        Succeeded result -> return result\n\n{-\n************************************************************************\n*                                                                      *\n                Arrow scopes\n*                                                                      *\n************************************************************************\n-}\n\nnewArrowScope :: TcM a -> TcM a\nnewArrowScope\n  = updLclEnv $ \\env -> env { tcl_arrow_ctxt = ArrowCtxt (tcl_rdr env) (tcl_lie env) }\n\n-- Return to the stored environment (from the enclosing proc)\nescapeArrowScope :: TcM a -> TcM a\nescapeArrowScope\n  = updLclEnv $ \\ env ->\n    case tcl_arrow_ctxt env of\n      NoArrowCtxt       -> env\n      ArrowCtxt rdr_env lie -> env { tcl_arrow_ctxt = NoArrowCtxt\n                                   , tcl_lie = lie\n                                   , tcl_rdr = rdr_env }\n\n{-\n************************************************************************\n*                                                                      *\n                Unique supply\n*                                                                      *\n************************************************************************\n-}\n\nnewUnique :: TcRnIf gbl lcl Unique\nnewUnique\n = do { env <- getEnv ;\n        let { u_var = env_us env } ;\n        us <- readMutVar u_var ;\n        case takeUniqFromSupply us of { (uniq, us') -> do {\n        writeMutVar u_var us' ;\n        return $! uniq }}}\n   -- NOTE 1: we strictly split the supply, to avoid the possibility of leaving\n   -- a chain of unevaluated supplies behind.\n   -- NOTE 2: we use the uniq in the supply from the MutVar directly, and\n   -- throw away one half of the new split supply.  This is safe because this\n   -- is the only place we use that unique.  Using the other half of the split\n   -- supply is safer, but slower.\n\nnewUniqueSupply :: TcRnIf gbl lcl UniqSupply\nnewUniqueSupply\n = do { env <- getEnv ;\n        let { u_var = env_us env } ;\n        us <- readMutVar u_var ;\n        case splitUniqSupply us of { (us1,us2) -> do {\n        writeMutVar u_var us1 ;\n        return us2 }}}\n\ncloneLocalName :: Name -> TcM Name\n-- Make a fresh Internal name with the same OccName and SrcSpan\ncloneLocalName name = newNameAt (nameOccName name) (nameSrcSpan name)\n\nnewName :: OccName -> TcM Name\nnewName occ = do { loc  <- getSrcSpanM\n                 ; newNameAt occ loc }\n\nnewNameAt :: OccName -> SrcSpan -> TcM Name\nnewNameAt occ span\n  = do { uniq <- newUnique\n       ; return (mkInternalName uniq occ span) }\n\nnewSysName :: OccName -> TcRnIf gbl lcl Name\nnewSysName occ\n  = do { uniq <- newUnique\n       ; return (mkSystemName uniq occ) }\n\nnewSysLocalId :: FastString -> TcType -> TcRnIf gbl lcl TcId\nnewSysLocalId fs ty\n  = do  { u <- newUnique\n        ; return (mkSysLocalOrCoVar fs u ty) }\n\nnewSysLocalIds :: FastString -> [TcType] -> TcRnIf gbl lcl [TcId]\nnewSysLocalIds fs tys\n  = do  { us <- newUniqueSupply\n        ; return (zipWith (mkSysLocalOrCoVar fs) (uniqsFromSupply us) tys) }\n\ninstance MonadUnique (IOEnv (Env gbl lcl)) where\n        getUniqueM = newUnique\n        getUniqueSupplyM = newUniqueSupply\n\n{-\n************************************************************************\n*                                                                      *\n                Accessing input/output\n*                                                                      *\n************************************************************************\n-}\n\nnewTcRef :: a -> TcRnIf gbl lcl (TcRef a)\nnewTcRef = newMutVar\n\nreadTcRef :: TcRef a -> TcRnIf gbl lcl a\nreadTcRef = readMutVar\n\nwriteTcRef :: TcRef a -> a -> TcRnIf gbl lcl ()\nwriteTcRef = writeMutVar\n\nupdTcRef :: TcRef a -> (a -> a) -> TcRnIf gbl lcl ()\n-- Returns ()\nupdTcRef ref fn = liftIO $ do { old <- readIORef ref\n                              ; writeIORef ref (fn old) }\n\n{-\n************************************************************************\n*                                                                      *\n                Debugging\n*                                                                      *\n************************************************************************\n-}\n\n\n-- Typechecker trace\ntraceTc :: String -> SDoc -> TcRn ()\ntraceTc =\n  labelledTraceOptTcRn Opt_D_dump_tc_trace\n\n-- Renamer Trace\ntraceRn :: String -> SDoc -> TcRn ()\ntraceRn =\n  labelledTraceOptTcRn Opt_D_dump_rn_trace\n\n-- | Trace when a certain flag is enabled. This is like `traceOptTcRn`\n-- but accepts a string as a label and formats the trace message uniformly.\nlabelledTraceOptTcRn :: DumpFlag -> String -> SDoc -> TcRn ()\nlabelledTraceOptTcRn flag herald doc = do\n   traceOptTcRn flag (formatTraceMsg herald doc)\n\nformatTraceMsg :: String -> SDoc -> SDoc\nformatTraceMsg herald doc = hang (text herald) 2 doc\n\n-- | Output a doc if the given 'DumpFlag' is set.\n--\n-- By default this logs to stdout\n-- However, if the `-ddump-to-file` flag is set,\n-- then this will dump output to a file\n--\n-- Just a wrapper for 'dumpSDoc'\ntraceOptTcRn :: DumpFlag -> SDoc -> TcRn ()\ntraceOptTcRn flag doc\n  = do { dflags <- getDynFlags\n       ; when (dopt flag dflags)\n              (traceTcRn flag doc)\n       }\n\n-- Certain tests (T3017, Roles3, T12763 etc.) expect part of the\n-- output generated by `-ddump-types` to be in 'PprUser' style. However,\n-- generally we want all other debugging output to use 'PprDump'\n-- style. 'traceTcRn' and 'traceTcRnForUser' help us accomplish this.\n\n-- | A wrapper around 'traceTcRnWithStyle' which uses 'PprDump' style.\ntraceTcRn :: DumpFlag -> SDoc -> TcRn ()\ntraceTcRn flag doc\n  = do { dflags  <- getDynFlags\n       ; printer <- getPrintUnqualified dflags\n       ; let dump_style = mkDumpStyle dflags printer\n       ; traceTcRnWithStyle dump_style dflags flag doc }\n\n-- | A wrapper around 'traceTcRnWithStyle' which uses 'PprUser' style.\ntraceTcRnForUser :: DumpFlag -> SDoc -> TcRn ()\n-- Used by 'TcRnDriver.tcDump'.\ntraceTcRnForUser flag doc\n  = do { dflags  <- getDynFlags\n       ; printer <- getPrintUnqualified dflags\n       ; let user_style = mkUserStyle dflags printer AllTheWay\n       ; traceTcRnWithStyle user_style dflags flag doc }\n\ntraceTcRnWithStyle :: PprStyle -> DynFlags -> DumpFlag -> SDoc -> TcRn ()\n-- ^ Unconditionally dump some trace output\n--\n-- The DumpFlag is used only to set the output filename\n-- for --dump-to-file, not to decide whether or not to output\n-- That part is done by the caller\ntraceTcRnWithStyle sty dflags flag doc\n  = do { real_doc <- prettyDoc dflags doc\n       ; liftIO $ dumpSDocWithStyle sty dflags flag \"\" real_doc }\n  where\n    -- Add current location if -dppr-debug\n    prettyDoc :: DynFlags -> SDoc -> TcRn SDoc\n    prettyDoc dflags doc = if hasPprDebug dflags\n       then do { loc  <- getSrcSpanM; return $ mkLocMessage SevOutput loc doc }\n       else return doc -- The full location is usually way too much\n\n\ngetPrintUnqualified :: DynFlags -> TcRn PrintUnqualified\ngetPrintUnqualified dflags\n  = do { rdr_env <- getGlobalRdrEnv\n       ; return $ mkPrintUnqualified dflags rdr_env }\n\n-- | Like logInfoTcRn, but for user consumption\nprintForUserTcRn :: SDoc -> TcRn ()\nprintForUserTcRn doc\n  = do { dflags <- getDynFlags\n       ; printer <- getPrintUnqualified dflags\n       ; liftIO (printOutputForUser dflags printer doc) }\n\n{-\ntraceIf and traceHiDiffs work in the TcRnIf monad, where no RdrEnv is\navailable.  Alas, they behave inconsistently with the other stuff;\ne.g. are unaffected by -dump-to-file.\n-}\n\ntraceIf, traceHiDiffs :: SDoc -> TcRnIf m n ()\ntraceIf      = traceOptIf Opt_D_dump_if_trace\ntraceHiDiffs = traceOptIf Opt_D_dump_hi_diffs\n\n\ntraceOptIf :: DumpFlag -> SDoc -> TcRnIf m n ()\ntraceOptIf flag doc\n  = whenDOptM flag $    -- No RdrEnv available, so qualify everything\n    do { dflags <- getDynFlags\n       ; liftIO (putMsg dflags doc) }\n\n{-\n************************************************************************\n*                                                                      *\n                Typechecker global environment\n*                                                                      *\n************************************************************************\n-}\n\ngetIsGHCi :: TcRn Bool\ngetIsGHCi = do { mod <- getModule\n               ; return (isInteractiveModule mod) }\n\ngetGHCiMonad :: TcRn Name\ngetGHCiMonad = do { hsc <- getTopEnv; return (ic_monad $ hsc_IC hsc) }\n\ngetInteractivePrintName :: TcRn Name\ngetInteractivePrintName = do { hsc <- getTopEnv; return (ic_int_print $ hsc_IC hsc) }\n\ntcIsHsBootOrSig :: TcRn Bool\ntcIsHsBootOrSig = do { env <- getGblEnv; return (isHsBootOrSig (tcg_src env)) }\n\ntcIsHsig :: TcRn Bool\ntcIsHsig = do { env <- getGblEnv; return (isHsigFile (tcg_src env)) }\n\ntcSelfBootInfo :: TcRn SelfBootInfo\ntcSelfBootInfo = do { env <- getGblEnv; return (tcg_self_boot env) }\n\ngetGlobalRdrEnv :: TcRn GlobalRdrEnv\ngetGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) }\n\ngetRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv)\ngetRdrEnvs = do { (gbl,lcl) <- getEnvs; return (tcg_rdr_env gbl, tcl_rdr lcl) }\n\ngetImports :: TcRn ImportAvails\ngetImports = do { env <- getGblEnv; return (tcg_imports env) }\n\ngetFixityEnv :: TcRn FixityEnv\ngetFixityEnv = do { env <- getGblEnv; return (tcg_fix_env env) }\n\nextendFixityEnv :: [(Name,FixItem)] -> RnM a -> RnM a\nextendFixityEnv new_bit\n  = updGblEnv (\\env@(TcGblEnv { tcg_fix_env = old_fix_env }) ->\n                env {tcg_fix_env = extendNameEnvList old_fix_env new_bit})\n\ngetRecFieldEnv :: TcRn RecFieldEnv\ngetRecFieldEnv = do { env <- getGblEnv; return (tcg_field_env env) }\n\ngetDeclaredDefaultTys :: TcRn (Maybe [Type])\ngetDeclaredDefaultTys = do { env <- getGblEnv; return (tcg_default env) }\n\naddDependentFiles :: [FilePath] -> TcRn ()\naddDependentFiles fs = do\n  ref <- fmap tcg_dependent_files getGblEnv\n  dep_files <- readTcRef ref\n  writeTcRef ref (fs ++ dep_files)\n\n{-\n************************************************************************\n*                                                                      *\n                Error management\n*                                                                      *\n************************************************************************\n-}\n\ngetSrcSpanM :: TcRn SrcSpan\n        -- Avoid clash with Name.getSrcLoc\ngetSrcSpanM = do { env <- getLclEnv; return (RealSrcSpan (tcl_loc env)) }\n\nsetSrcSpan :: SrcSpan -> TcRn a -> TcRn a\nsetSrcSpan (RealSrcSpan real_loc) thing_inside\n    = updLclEnv (\\env -> env { tcl_loc = real_loc }) thing_inside\n-- Don't overwrite useful info with useless:\nsetSrcSpan (UnhelpfulSpan _) thing_inside = thing_inside\n\naddLocM :: HasSrcSpan a => (SrcSpanLess a -> TcM b) -> a -> TcM b\naddLocM fn (dL->L loc a) = setSrcSpan loc $ fn a\n\nwrapLocM :: (HasSrcSpan a, HasSrcSpan b) =>\n            (SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b\n-- wrapLocM :: (a -> TcM b) -> Located a -> TcM (Located b)\nwrapLocM fn (dL->L loc a) = setSrcSpan loc $ do { b <- fn a\n                                                ; return (cL loc b) }\nwrapLocFstM :: (HasSrcSpan a, HasSrcSpan b) =>\n               (SrcSpanLess a -> TcM (SrcSpanLess b,c)) -> a -> TcM (b, c)\nwrapLocFstM fn (dL->L loc a) =\n  setSrcSpan loc $ do\n    (b,c) <- fn a\n    return (cL loc b, c)\n\nwrapLocSndM :: (HasSrcSpan a, HasSrcSpan c) =>\n               (SrcSpanLess a -> TcM (b, SrcSpanLess c)) -> a -> TcM (b, c)\nwrapLocSndM fn (dL->L loc a) =\n  setSrcSpan loc $ do\n    (b,c) <- fn a\n    return (b, cL loc c)\n\nwrapLocM_ :: HasSrcSpan a =>\n             (SrcSpanLess a -> TcM ()) -> a -> TcM ()\nwrapLocM_ fn (dL->L loc a) = setSrcSpan loc (fn a)\n\n-- Reporting errors\n\ngetErrsVar :: TcRn (TcRef Messages)\ngetErrsVar = do { env <- getLclEnv; return (tcl_errs env) }\n\nsetErrsVar :: TcRef Messages -> TcRn a -> TcRn a\nsetErrsVar v = updLclEnv (\\ env -> env { tcl_errs =  v })\n\naddErr :: MsgDoc -> TcRn ()\naddErr msg = do { loc <- getSrcSpanM; addErrAt loc msg }\n\nfailWith :: MsgDoc -> TcRn a\nfailWith msg = addErr msg >> failM\n\nfailAt :: SrcSpan -> MsgDoc -> TcRn a\nfailAt loc msg = addErrAt loc msg >> failM\n\naddErrAt :: SrcSpan -> MsgDoc -> TcRn ()\n-- addErrAt is mainly (exclusively?) used by the renamer, where\n-- tidying is not an issue, but it's all lazy so the extra\n-- work doesn't matter\naddErrAt loc msg = do { ctxt <- getErrCtxt\n                      ; tidy_env <- tcInitTidyEnv\n                      ; err_info <- mkErrInfo tidy_env ctxt\n                      ; addLongErrAt loc msg err_info }\n\naddErrs :: [(SrcSpan,MsgDoc)] -> TcRn ()\naddErrs msgs = mapM_ add msgs\n             where\n               add (loc,msg) = addErrAt loc msg\n\ncheckErr :: Bool -> MsgDoc -> TcRn ()\n-- Add the error if the bool is False\ncheckErr ok msg = unless ok (addErr msg)\n\naddMessages :: Messages -> TcRn ()\naddMessages msgs1\n  = do { errs_var <- getErrsVar ;\n         msgs0 <- readTcRef errs_var ;\n         writeTcRef errs_var (unionMessages msgs0 msgs1) }\n\ndiscardWarnings :: TcRn a -> TcRn a\n-- Ignore warnings inside the thing inside;\n-- used to ignore-unused-variable warnings inside derived code\ndiscardWarnings thing_inside\n  = do  { errs_var <- getErrsVar\n        ; (old_warns, _) <- readTcRef errs_var\n\n        ; result <- thing_inside\n\n        -- Revert warnings to old_warns\n        ; (_new_warns, new_errs) <- readTcRef errs_var\n        ; writeTcRef errs_var (old_warns, new_errs)\n\n        ; return result }\n\n{-\n************************************************************************\n*                                                                      *\n        Shared error message stuff: renamer and typechecker\n*                                                                      *\n************************************************************************\n-}\n\nmkLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ErrMsg\nmkLongErrAt loc msg extra\n  = do { dflags <- getDynFlags ;\n         printer <- getPrintUnqualified dflags ;\n         return $ mkLongErrMsg dflags loc printer msg extra }\n\nmkErrDocAt :: SrcSpan -> ErrDoc -> TcRn ErrMsg\nmkErrDocAt loc errDoc\n  = do { dflags <- getDynFlags ;\n         printer <- getPrintUnqualified dflags ;\n         return $ mkErrDoc dflags loc printer errDoc }\n\naddLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()\naddLongErrAt loc msg extra = mkLongErrAt loc msg extra >>= reportError\n\nreportErrors :: [ErrMsg] -> TcM ()\nreportErrors = mapM_ reportError\n\nreportError :: ErrMsg -> TcRn ()\nreportError err\n  = do { traceTc \"Adding error:\" (pprLocErrMsg err) ;\n         errs_var <- getErrsVar ;\n         (warns, errs) <- readTcRef errs_var ;\n         writeTcRef errs_var (warns, errs `snocBag` err) }\n\nreportWarning :: WarnReason -> ErrMsg -> TcRn ()\nreportWarning reason err\n  = do { let warn = makeIntoWarning reason err\n                    -- 'err' was built by mkLongErrMsg or something like that,\n                    -- so it's of error severity.  For a warning we downgrade\n                    -- its severity to SevWarning\n\n       ; traceTc \"Adding warning:\" (pprLocErrMsg warn)\n       ; errs_var <- getErrsVar\n       ; (warns, errs) <- readTcRef errs_var\n       ; writeTcRef errs_var (warns `snocBag` warn, errs) }\n\ntry_m :: TcRn r -> TcRn (Either IOEnvFailure r)\n-- Does tryM, with a debug-trace on failure\n-- If we do recover from an exception, /insoluble/ constraints\n-- (only) in 'thing' are are propagated\ntry_m thing\n  = do { (mb_r, lie) <- tryCaptureConstraints thing\n       ; emitConstraints lie\n\n       -- Debug trace\n       ; case mb_r of\n            Left exn -> traceTc \"tryTc/recoverM recovering from\" $\n                        (text (showException exn) $$ ppr lie)\n            Right {} -> return ()\n\n       ; return mb_r }\n\n-----------------------\nrecoverM :: TcRn r      -- Recovery action; do this if the main one fails\n         -> TcRn r      -- Main action: do this first;\n                        --  if it generates errors, propagate them all\n         -> TcRn r\n-- Errors in 'thing' are retained\n-- If we do recover from an exception, /insoluble/ constraints\n-- (only) in 'thing' are are propagated\nrecoverM recover thing\n  = do { mb_res <- try_m thing ;\n         case mb_res of\n           Left _    -> recover\n           Right res -> return res }\n\n\n-----------------------\n\n-- | Drop elements of the input that fail, so the result\n-- list can be shorter than the argument list\nmapAndRecoverM :: (a -> TcRn b) -> [a] -> TcRn [b]\nmapAndRecoverM f = mapMaybeM (fmap rightToMaybe . try_m . f)\n\n-- | The accumulator is not updated if the action fails\nfoldAndRecoverM :: (b -> a -> TcRn b) -> b -> [a] -> TcRn b\nfoldAndRecoverM _ acc []     = return acc\nfoldAndRecoverM f acc (x:xs) =\n                          do { mb_r <- try_m (f acc x)\n                             ; case mb_r of\n                                Left _  -> foldAndRecoverM f acc xs\n                                Right acc' -> foldAndRecoverM f acc' xs  }\n\n-- | Succeeds if applying the argument to all members of the lists succeeds,\n--   but nevertheless runs it on all arguments, to collect all errors.\nmapAndReportM :: (a -> TcRn b) -> [a] -> TcRn [b]\nmapAndReportM f xs = checkNoErrs (mapAndRecoverM f xs)\n\n-----------------------\ntryTc :: TcRn a -> TcRn (Messages, Maybe a)\n-- (tryTc m) executes m, and returns\n--      Just r,  if m succeeds (returning r)\n--      Nothing, if m fails\n-- It also returns all the errors and warnings accumulated by m\n-- It always succeeds (never raises an exception)\ntryTc thing_inside\n = do { errs_var <- newTcRef emptyMessages ;\n\n        res  <- try_m $  -- Be sure to catch exceptions, so that\n                         -- we guaranteed to read the messages out\n                         -- of that brand-new errs_var!\n                setErrsVar errs_var $\n                thing_inside ;\n\n        msgs <- readTcRef errs_var ;\n\n        return (msgs, case res of\n                        Left _    -> Nothing\n                        Right val -> Just val)\n        -- The exception is always the IOEnv built-in\n        -- in exception; see IOEnv.failM\n   }\n\n-----------------------\ndiscardErrs :: TcRn a -> TcRn a\n-- (discardErrs m) runs m,\n--   discarding all error messages and warnings generated by m\n-- If m fails, discardErrs fails, and vice versa\ndiscardErrs m\n = do { errs_var <- newTcRef emptyMessages\n      ; setErrsVar errs_var m }\n\n-----------------------\ntryTcDiscardingErrs :: TcM r -> TcM r -> TcM r\n-- (tryTcDiscardingErrs recover main) tries 'main';\n--      if 'main' succeeds with no error messages, it's the answer\n--      otherwise discard everything from 'main', including errors,\n--          and try 'recover' instead.\ntryTcDiscardingErrs recover main\n  = do  { (msgs, mb_res) <- tryTc main\n        ; dflags <- getDynFlags\n        ; case mb_res of\n            Just res | not (errorsFound dflags msgs)\n              -> -- 'main' succeeed with no error messages\n                 do { addMessages msgs  -- msgs might still have warnings\n                    ; return res }\n\n            _ -> -- 'main' failed, or produced an error message\n                 recover     -- Discard all errors and warnings entirely\n        }\n\n-----------------------\n-- (askNoErrs m) runs m\n-- If m fails,\n--    then (askNoErrs m) fails\n-- If m succeeds with result r,\n--    then (askNoErrs m) succeeds with result (r, b),\n--         where b is True iff m generated no errors\n-- Regardless of success or failure,\n--   propagate any errors/warnings generated by m\naskNoErrs :: TcRn a -> TcRn (a, Bool)\naskNoErrs m\n  = do { (msgs, mb_res) <- tryTc m\n       ; addMessages msgs  -- Always propagate errors\n       ; case mb_res of\n           Nothing  -> failM\n           Just res -> do { dflags <- getDynFlags\n                          ; let errs_found = errorsFound dflags msgs\n                          ; return (res, not errs_found) } }\n-----------------------\ncheckNoErrs :: TcM r -> TcM r\n-- (checkNoErrs m) succeeds iff m succeeds and generates no errors\n-- If m fails then (checkNoErrsTc m) fails.\n-- If m succeeds, it checks whether m generated any errors messages\n--      (it might have recovered internally)\n--      If so, it fails too.\n-- Regardless, any errors generated by m are propagated to the enclosing context.\ncheckNoErrs main\n  = do  { (res, no_errs) <- askNoErrs main\n        ; unless no_errs failM\n        ; return res }\n\n-----------------------\nwhenNoErrs :: TcM () -> TcM ()\nwhenNoErrs thing = ifErrsM (return ()) thing\n\nifErrsM :: TcRn r -> TcRn r -> TcRn r\n--      ifErrsM bale_out normal\n-- does 'bale_out' if there are errors in errors collection\n-- otherwise does 'normal'\nifErrsM bale_out normal\n = do { errs_var <- getErrsVar ;\n        msgs <- readTcRef errs_var ;\n        dflags <- getDynFlags ;\n        if errorsFound dflags msgs then\n           bale_out\n        else\n           normal }\n\nfailIfErrsM :: TcRn ()\n-- Useful to avoid error cascades\nfailIfErrsM = ifErrsM failM (return ())\n\ncheckTH :: a -> String -> TcRn ()\ncheckTH _ _ = return () -- OK\n\nfailTH :: Outputable a => a -> String -> TcRn x\nfailTH e what  -- Raise an error in a stage-1 compiler\n  = failWithTc (vcat [ hang (char 'A' <+> text what\n                             <+> text \"requires GHC with interpreter support:\")\n                          2 (ppr e)\n                     , text \"Perhaps you are using a stage-1 compiler?\" ])\n\n\n{- *********************************************************************\n*                                                                      *\n        Context management for the type checker\n*                                                                      *\n************************************************************************\n-}\n\ngetErrCtxt :: TcM [ErrCtxt]\ngetErrCtxt = do { env <- getLclEnv; return (tcl_ctxt env) }\n\nsetErrCtxt :: [ErrCtxt] -> TcM a -> TcM a\nsetErrCtxt ctxt = updLclEnv (\\ env -> env { tcl_ctxt = ctxt })\n\n-- | Add a fixed message to the error context. This message should not\n-- do any tidying.\naddErrCtxt :: MsgDoc -> TcM a -> TcM a\naddErrCtxt msg = addErrCtxtM (\\env -> return (env, msg))\n\n-- | Add a message to the error context. This message may do tidying.\naddErrCtxtM :: (TidyEnv -> TcM (TidyEnv, MsgDoc)) -> TcM a -> TcM a\naddErrCtxtM ctxt = updCtxt (\\ ctxts -> (False, ctxt) : ctxts)\n\n-- | Add a fixed landmark message to the error context. A landmark\n-- message is always sure to be reported, even if there is a lot of\n-- context. It also doesn't count toward the maximum number of contexts\n-- reported.\naddLandmarkErrCtxt :: MsgDoc -> TcM a -> TcM a\naddLandmarkErrCtxt msg = addLandmarkErrCtxtM (\\env -> return (env, msg))\n\n-- | Variant of 'addLandmarkErrCtxt' that allows for monadic operations\n-- and tidying.\naddLandmarkErrCtxtM :: (TidyEnv -> TcM (TidyEnv, MsgDoc)) -> TcM a -> TcM a\naddLandmarkErrCtxtM ctxt = updCtxt (\\ctxts -> (True, ctxt) : ctxts)\n\n-- Helper function for the above\nupdCtxt :: ([ErrCtxt] -> [ErrCtxt]) -> TcM a -> TcM a\nupdCtxt upd = updLclEnv (\\ env@(TcLclEnv { tcl_ctxt = ctxt }) ->\n                           env { tcl_ctxt = upd ctxt })\n\npopErrCtxt :: TcM a -> TcM a\npopErrCtxt = updCtxt (\\ msgs -> case msgs of { [] -> []; (_ : ms) -> ms })\n\ngetCtLocM :: CtOrigin -> Maybe TypeOrKind -> TcM CtLoc\ngetCtLocM origin t_or_k\n  = do { env <- getLclEnv\n       ; return (CtLoc { ctl_origin = origin\n                       , ctl_env    = env\n                       , ctl_t_or_k = t_or_k\n                       , ctl_depth  = initialSubGoalDepth }) }\n\nsetCtLocM :: CtLoc -> TcM a -> TcM a\n-- Set the SrcSpan and error context from the CtLoc\nsetCtLocM (CtLoc { ctl_env = lcl }) thing_inside\n  = updLclEnv (\\env -> env { tcl_loc   = tcl_loc lcl\n                           , tcl_bndrs = tcl_bndrs lcl\n                           , tcl_ctxt  = tcl_ctxt lcl })\n              thing_inside\n\n{-\n************************************************************************\n*                                                                      *\n             Error message generation (type checker)\n*                                                                      *\n************************************************************************\n\n    The addErrTc functions add an error message, but do not cause failure.\n    The 'M' variants pass a TidyEnv that has already been used to\n    tidy up the message; we then use it to tidy the context messages\n-}\n\naddErrTc :: MsgDoc -> TcM ()\naddErrTc err_msg = do { env0 <- tcInitTidyEnv\n                      ; addErrTcM (env0, err_msg) }\n\naddErrsTc :: [MsgDoc] -> TcM ()\naddErrsTc err_msgs = mapM_ addErrTc err_msgs\n\naddErrTcM :: (TidyEnv, MsgDoc) -> TcM ()\naddErrTcM (tidy_env, err_msg)\n  = do { ctxt <- getErrCtxt ;\n         loc  <- getSrcSpanM ;\n         add_err_tcm tidy_env err_msg loc ctxt }\n\n-- Return the error message, instead of reporting it straight away\nmkErrTcM :: (TidyEnv, MsgDoc) -> TcM ErrMsg\nmkErrTcM (tidy_env, err_msg)\n  = do { ctxt <- getErrCtxt ;\n         loc  <- getSrcSpanM ;\n         err_info <- mkErrInfo tidy_env ctxt ;\n         mkLongErrAt loc err_msg err_info }\n\nmkErrTc :: MsgDoc -> TcM ErrMsg\nmkErrTc msg = do { env0 <- tcInitTidyEnv\n                 ; mkErrTcM (env0, msg) }\n\n-- The failWith functions add an error message and cause failure\n\nfailWithTc :: MsgDoc -> TcM a               -- Add an error message and fail\nfailWithTc err_msg\n  = addErrTc err_msg >> failM\n\nfailWithTcM :: (TidyEnv, MsgDoc) -> TcM a   -- Add an error message and fail\nfailWithTcM local_and_msg\n  = addErrTcM local_and_msg >> failM\n\ncheckTc :: Bool -> MsgDoc -> TcM ()         -- Check that the boolean is true\ncheckTc True  _   = return ()\ncheckTc False err = failWithTc err\n\ncheckTcM :: Bool -> (TidyEnv, MsgDoc) -> TcM ()\ncheckTcM True  _   = return ()\ncheckTcM False err = failWithTcM err\n\nfailIfTc :: Bool -> MsgDoc -> TcM ()         -- Check that the boolean is false\nfailIfTc False _   = return ()\nfailIfTc True  err = failWithTc err\n\nfailIfTcM :: Bool -> (TidyEnv, MsgDoc) -> TcM ()\n   -- Check that the boolean is false\nfailIfTcM False _   = return ()\nfailIfTcM True  err = failWithTcM err\n\n\n--         Warnings have no 'M' variant, nor failure\n\n-- | Display a warning if a condition is met,\n--   and the warning is enabled\nwarnIfFlag :: WarningFlag -> Bool -> MsgDoc -> TcRn ()\nwarnIfFlag warn_flag is_bad msg\n  = do { warn_on <- woptM warn_flag\n       ; when (warn_on && is_bad) $\n         addWarn (Reason warn_flag) msg }\n\n-- | Display a warning if a condition is met.\nwarnIf :: Bool -> MsgDoc -> TcRn ()\nwarnIf is_bad msg\n  = when is_bad (addWarn NoReason msg)\n\n-- | Display a warning if a condition is met.\nwarnTc :: WarnReason -> Bool -> MsgDoc -> TcM ()\nwarnTc reason warn_if_true warn_msg\n  | warn_if_true = addWarnTc reason warn_msg\n  | otherwise    = return ()\n\n-- | Display a warning if a condition is met.\nwarnTcM :: WarnReason -> Bool -> (TidyEnv, MsgDoc) -> TcM ()\nwarnTcM reason warn_if_true warn_msg\n  | warn_if_true = addWarnTcM reason warn_msg\n  | otherwise    = return ()\n\n-- | Display a warning in the current context.\naddWarnTc :: WarnReason -> MsgDoc -> TcM ()\naddWarnTc reason msg\n = do { env0 <- tcInitTidyEnv ;\n      addWarnTcM reason (env0, msg) }\n\n-- | Display a warning in a given context.\naddWarnTcM :: WarnReason -> (TidyEnv, MsgDoc) -> TcM ()\naddWarnTcM reason (env0, msg)\n = do { ctxt <- getErrCtxt ;\n        err_info <- mkErrInfo env0 ctxt ;\n        add_warn reason msg err_info }\n\n-- | Display a warning for the current source location.\naddWarn :: WarnReason -> MsgDoc -> TcRn ()\naddWarn reason msg = add_warn reason msg Outputable.empty\n\n-- | Display a warning for a given source location.\naddWarnAt :: WarnReason -> SrcSpan -> MsgDoc -> TcRn ()\naddWarnAt reason loc msg = add_warn_at reason loc msg Outputable.empty\n\n-- | Display a warning, with an optional flag, for the current source\n-- location.\nadd_warn :: WarnReason -> MsgDoc -> MsgDoc -> TcRn ()\nadd_warn reason msg extra_info\n  = do { loc <- getSrcSpanM\n       ; add_warn_at reason loc msg extra_info }\n\n-- | Display a warning, with an optional flag, for a given location.\nadd_warn_at :: WarnReason -> SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()\nadd_warn_at reason loc msg extra_info\n  = do { dflags <- getDynFlags ;\n         printer <- getPrintUnqualified dflags ;\n         let { warn = mkLongWarnMsg dflags loc printer\n                                    msg extra_info } ;\n         reportWarning reason warn }\n\n\n{-\n-----------------------------------\n        Other helper functions\n-}\n\nadd_err_tcm :: TidyEnv -> MsgDoc -> SrcSpan\n            -> [ErrCtxt]\n            -> TcM ()\nadd_err_tcm tidy_env err_msg loc ctxt\n = do { err_info <- mkErrInfo tidy_env ctxt ;\n        addLongErrAt loc err_msg err_info }\n\nmkErrInfo :: TidyEnv -> [ErrCtxt] -> TcM SDoc\n-- Tidy the error info, trimming excessive contexts\nmkErrInfo env ctxts\n--  = do\n--       dbg <- hasPprDebug <$> getDynFlags\n--       if dbg                -- In -dppr-debug style the output\n--          then return empty  -- just becomes too voluminous\n--          else go dbg 0 env ctxts\n = go False 0 env ctxts\n where\n   go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM SDoc\n   go _ _ _   [] = return empty\n   go dbg n env ((is_landmark, ctxt) : ctxts)\n     | is_landmark || n < mAX_CONTEXTS -- Too verbose || dbg\n     = do { (env', msg) <- ctxt env\n          ; let n' = if is_landmark then n else n+1\n          ; rest <- go dbg n' env' ctxts\n          ; return (msg $$ rest) }\n     | otherwise\n     = go dbg n env ctxts\n\nmAX_CONTEXTS :: Int     -- No more than this number of non-landmark contexts\nmAX_CONTEXTS = 3\n\n-- debugTc is useful for monadic debugging code\n\ndebugTc :: TcM () -> TcM ()\ndebugTc thing\n | debugIsOn = thing\n | otherwise = return ()\n\n{-\n************************************************************************\n*                                                                      *\n             Type constraints\n*                                                                      *\n************************************************************************\n-}\n\naddTopEvBinds :: Bag EvBind -> TcM a -> TcM a\naddTopEvBinds new_ev_binds thing_inside\n  =updGblEnv upd_env thing_inside\n  where\n    upd_env tcg_env = tcg_env { tcg_ev_binds = tcg_ev_binds tcg_env\n                                               `unionBags` new_ev_binds }\n\nnewTcEvBinds :: TcM EvBindsVar\nnewTcEvBinds = do { binds_ref <- newTcRef emptyEvBindMap\n                  ; tcvs_ref  <- newTcRef emptyVarSet\n                  ; uniq <- newUnique\n                  ; traceTc \"newTcEvBinds\" (text \"unique =\" <+> ppr uniq)\n                  ; return (EvBindsVar { ebv_binds = binds_ref\n                                       , ebv_tcvs = tcvs_ref\n                                       , ebv_uniq = uniq }) }\n\n-- | Creates an EvBindsVar incapable of holding any bindings. It still\n-- tracks covar usages (see comments on ebv_tcvs in TcEvidence), thus\n-- must be made monadically\nnewNoTcEvBinds :: TcM EvBindsVar\nnewNoTcEvBinds\n  = do { tcvs_ref  <- newTcRef emptyVarSet\n       ; uniq <- newUnique\n       ; traceTc \"newNoTcEvBinds\" (text \"unique =\" <+> ppr uniq)\n       ; return (CoEvBindsVar { ebv_tcvs = tcvs_ref\n                              , ebv_uniq = uniq }) }\n\ncloneEvBindsVar :: EvBindsVar -> TcM EvBindsVar\n-- Clone the refs, so that any binding created when\n-- solving don't pollute the original\ncloneEvBindsVar ebv@(EvBindsVar {})\n  = do { binds_ref <- newTcRef emptyEvBindMap\n       ; tcvs_ref  <- newTcRef emptyVarSet\n       ; return (ebv { ebv_binds = binds_ref\n                     , ebv_tcvs = tcvs_ref }) }\ncloneEvBindsVar ebv@(CoEvBindsVar {})\n  = do { tcvs_ref  <- newTcRef emptyVarSet\n       ; return (ebv { ebv_tcvs = tcvs_ref }) }\n\ngetTcEvTyCoVars :: EvBindsVar -> TcM TyCoVarSet\ngetTcEvTyCoVars ev_binds_var\n  = readTcRef (ebv_tcvs ev_binds_var)\n\ngetTcEvBindsMap :: EvBindsVar -> TcM EvBindMap\ngetTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref })\n  = readTcRef ev_ref\ngetTcEvBindsMap (CoEvBindsVar {})\n  = return emptyEvBindMap\n\nsetTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcM ()\nsetTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref }) binds\n  = writeTcRef ev_ref binds\nsetTcEvBindsMap v@(CoEvBindsVar {}) ev_binds\n  | isEmptyEvBindMap ev_binds\n  = return ()\n  | otherwise\n  = pprPanic \"setTcEvBindsMap\" (ppr v $$ ppr ev_binds)\n\naddTcEvBind :: EvBindsVar -> EvBind -> TcM ()\n-- Add a binding to the TcEvBinds by side effect\naddTcEvBind (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u }) ev_bind\n  = do { traceTc \"addTcEvBind\" $ ppr u $$\n                                 ppr ev_bind\n       ; bnds <- readTcRef ev_ref\n       ; writeTcRef ev_ref (extendEvBinds bnds ev_bind) }\naddTcEvBind (CoEvBindsVar { ebv_uniq = u }) ev_bind\n  = pprPanic \"addTcEvBind CoEvBindsVar\" (ppr ev_bind $$ ppr u)\n\nchooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName\nchooseUniqueOccTc fn =\n  do { env <- getGblEnv\n     ; let dfun_n_var = tcg_dfun_n env\n     ; set <- readTcRef dfun_n_var\n     ; let occ = fn set\n     ; writeTcRef dfun_n_var (extendOccSet set occ)\n     ; return occ }\n\ngetConstraintVar :: TcM (TcRef WantedConstraints)\ngetConstraintVar = do { env <- getLclEnv; return (tcl_lie env) }\n\nsetConstraintVar :: TcRef WantedConstraints -> TcM a -> TcM a\nsetConstraintVar lie_var = updLclEnv (\\ env -> env { tcl_lie = lie_var })\n\nemitStaticConstraints :: WantedConstraints -> TcM ()\nemitStaticConstraints static_lie\n  = do { gbl_env <- getGblEnv\n       ; updTcRef (tcg_static_wc gbl_env) (`andWC` static_lie) }\n\nemitConstraints :: WantedConstraints -> TcM ()\nemitConstraints ct\n  | isEmptyWC ct\n  = return ()\n  | otherwise\n  = do { lie_var <- getConstraintVar ;\n         updTcRef lie_var (`andWC` ct) }\n\nemitSimple :: Ct -> TcM ()\nemitSimple ct\n  = do { lie_var <- getConstraintVar ;\n         updTcRef lie_var (`addSimples` unitBag ct) }\n\nemitSimples :: Cts -> TcM ()\nemitSimples cts\n  = do { lie_var <- getConstraintVar ;\n         updTcRef lie_var (`addSimples` cts) }\n\nemitImplication :: Implication -> TcM ()\nemitImplication ct\n  = do { lie_var <- getConstraintVar ;\n         updTcRef lie_var (`addImplics` unitBag ct) }\n\nemitImplications :: Bag Implication -> TcM ()\nemitImplications ct\n  = unless (isEmptyBag ct) $\n    do { lie_var <- getConstraintVar ;\n         updTcRef lie_var (`addImplics` ct) }\n\nemitInsoluble :: Ct -> TcM ()\nemitInsoluble ct\n  = do { traceTc \"emitInsoluble\" (ppr ct)\n       ; lie_var <- getConstraintVar\n       ; updTcRef lie_var (`addInsols` unitBag ct) }\n\nemitInsolubles :: Cts -> TcM ()\nemitInsolubles cts\n  | isEmptyBag cts = return ()\n  | otherwise      = do { traceTc \"emitInsolubles\" (ppr cts)\n                        ; lie_var <- getConstraintVar\n                        ; updTcRef lie_var (`addInsols` cts) }\n\n-- | Throw out any constraints emitted by the thing_inside\ndiscardConstraints :: TcM a -> TcM a\ndiscardConstraints thing_inside = fst <$> captureConstraints thing_inside\n\ntryCaptureConstraints :: TcM a -> TcM (Either IOEnvFailure a, WantedConstraints)\n-- (captureConstraints_maybe m) runs m,\n-- and returns the type constraints it generates\n-- It never throws an exception; instead if thing_inside fails,\n--   it returns Left exn and the /insoluble/ constraints\ntryCaptureConstraints thing_inside\n  = do { lie_var <- newTcRef emptyWC\n       ; mb_res <- tryM $\n                   updLclEnv (\\ env -> env { tcl_lie = lie_var }) $\n                   thing_inside\n       ; lie <- readTcRef lie_var\n\n       -- See Note [Constraints and errors]\n       ; let lie_to_keep = case mb_res of\n                             Left {}  -> insolublesOnly lie\n                             Right {} -> lie\n\n       ; return (mb_res, lie_to_keep) }\n\ncaptureConstraints :: TcM a -> TcM (a, WantedConstraints)\n-- (captureConstraints m) runs m, and returns the type constraints it generates\ncaptureConstraints thing_inside\n  = do { (mb_res, lie) <- tryCaptureConstraints thing_inside\n\n            -- See Note [Constraints and errors]\n            -- If the thing_inside threw an exception, emit the insoluble\n            -- constraints only (returned by tryCaptureConstraints)\n            -- so that they are not lost\n       ; case mb_res of\n           Left _    -> do { emitConstraints lie; failM }\n           Right res -> return (res, lie) }\n\n-- | The name says it all. The returned TcLevel is the *inner* TcLevel.\npushLevelAndCaptureConstraints :: TcM a -> TcM (TcLevel, WantedConstraints, a)\npushLevelAndCaptureConstraints thing_inside\n  = do { env <- getLclEnv\n       ; let tclvl' = pushTcLevel (tcl_tclvl env)\n       ; traceTc \"pushLevelAndCaptureConstraints {\" (ppr tclvl')\n       ; (res, lie) <- setLclEnv (env { tcl_tclvl = tclvl' }) $\n                       captureConstraints thing_inside\n       ; traceTc \"pushLevelAndCaptureConstraints }\" (ppr tclvl')\n       ; return (tclvl', lie, res) }\n\npushTcLevelM_ :: TcM a -> TcM a\npushTcLevelM_ x = updLclEnv (\\ env -> env { tcl_tclvl = pushTcLevel (tcl_tclvl env) }) x\n\npushTcLevelM :: TcM a -> TcM (TcLevel, a)\n-- See Note [TcLevel assignment] in TcType\npushTcLevelM thing_inside\n  = do { env <- getLclEnv\n       ; let tclvl' = pushTcLevel (tcl_tclvl env)\n       ; res <- setLclEnv (env { tcl_tclvl = tclvl' })\n                          thing_inside\n       ; return (tclvl', res) }\n\n-- Returns pushed TcLevel\npushTcLevelsM :: Int -> TcM a -> TcM (a, TcLevel)\npushTcLevelsM num_levels thing_inside\n  = do { env <- getLclEnv\n       ; let tclvl' = nTimes num_levels pushTcLevel (tcl_tclvl env)\n       ; res <- setLclEnv (env { tcl_tclvl = tclvl' }) $\n                thing_inside\n       ; return (res, tclvl') }\n\ngetTcLevel :: TcM TcLevel\ngetTcLevel = do { env <- getLclEnv\n                ; return (tcl_tclvl env) }\n\nsetTcLevel :: TcLevel -> TcM a -> TcM a\nsetTcLevel tclvl thing_inside\n  = updLclEnv (\\env -> env { tcl_tclvl = tclvl }) thing_inside\n\nisTouchableTcM :: TcTyVar -> TcM Bool\nisTouchableTcM tv\n  = do { lvl <- getTcLevel\n       ; return (isTouchableMetaTyVar lvl tv) }\n\ngetLclTypeEnv :: TcM TcTypeEnv\ngetLclTypeEnv = do { env <- getLclEnv; return (tcl_env env) }\n\nsetLclTypeEnv :: TcLclEnv -> TcM a -> TcM a\n-- Set the local type envt, but do *not* disturb other fields,\n-- notably the lie_var\nsetLclTypeEnv lcl_env thing_inside\n  = updLclEnv upd thing_inside\n  where\n    upd env = env { tcl_env = tcl_env lcl_env,\n                    tcl_tyvars = tcl_tyvars lcl_env }\n\ntraceTcConstraints :: String -> TcM ()\ntraceTcConstraints msg\n  = do { lie_var <- getConstraintVar\n       ; lie     <- readTcRef lie_var\n       ; traceOptTcRn Opt_D_dump_tc_trace $\n         hang (text (msg ++ \": LIE:\")) 2 (ppr lie)\n       }\n\nemitWildCardHoleConstraints :: [(Name, TcTyVar)] -> TcM ()\nemitWildCardHoleConstraints wcs\n  = do { ct_loc <- getCtLocM HoleOrigin Nothing\n       ; emitInsolubles $ listToBag $\n         map (do_one ct_loc) wcs }\n  where\n    do_one :: CtLoc -> (Name, TcTyVar) -> Ct\n    do_one ct_loc (name, tv)\n       = CHoleCan { cc_ev = CtDerived { ctev_pred = mkTyVarTy tv\n                                      , ctev_loc  = ct_loc' }\n                  , cc_hole = TypeHole (occName name) }\n       where\n         real_span = case nameSrcSpan name of\n                           RealSrcSpan span  -> span\n                           UnhelpfulSpan str -> pprPanic \"emitWildCardHoleConstraints\"\n                                                      (ppr name <+> quotes (ftext str))\n               -- Wildcards are defined locally, and so have RealSrcSpans\n         ct_loc' = setCtLocSpan ct_loc real_span\n\n{- Note [Constraints and errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this (Trac #12124):\n\n  foo :: Maybe Int\n  foo = return (case Left 3 of\n                  Left -> 1  -- Hard error here!\n                  _    -> 0)\n\nThe call to 'return' will generate a (Monad m) wanted constraint; but\nthen there'll be \"hard error\" (i.e. an exception in the TcM monad), from\nthe unsaturated Left constructor pattern.\n\nWe'll recover in tcPolyBinds, using recoverM.  But then the final\ntcSimplifyTop will see that (Monad m) constraint, with 'm' utterly\nun-filled-in, and will emit a misleading error message.\n\nThe underlying problem is that an exception interrupts the constraint\ngathering process. Bottom line: if we have an exception, it's best\nsimply to discard any gathered constraints.  Hence in 'try_m' we\ncapture the constraints in a fresh variable, and only emit them into\nthe surrounding context if we exit normally.  If an exception is\nraised, simply discard the collected constraints... we have a hard\nerror to report.  So this capture-the-emit dance isn't as stupid as it\nlooks :-).\n\nHowever suppose we throw an exception inside an invocation of\ncaptureConstraints, and discard all the constraints. Some of those\nconstraints might be \"variable out of scope\" Hole constraints, and that\nmight have been the actual original cause of the exception!  For\nexample (Trac #12529):\n   f = p @ Int\nHere 'p' is out of scope, so we get an insolube Hole constraint. But\nthe visible type application fails in the monad (thows an exception).\nWe must not discard the out-of-scope error.\n\nSo we /retain the insoluble constraints/ if there is an exception.\nHence:\n  - insolublesOnly in tryCaptureConstraints\n  - emitConstraints in the Left case of captureConstraints\n\nHover note that fresly-generated constraints like (Int ~ Bool), or\n((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as\ninsoluble.  The constraint solver does that.  So they'll be discarded.\nThat's probably ok; but see th/5358 as a not-so-good example:\n   t1 :: Int\n   t1 x = x   -- Manifestly wrong\n\n   foo = $(...raises exception...)\nWe report the exception, but not the bug in t1.  Oh well.  Possible\nsolution: make TcUnify.uType spot manifestly-insoluble constraints.\n\n\n************************************************************************\n*                                                                      *\n             Template Haskell context\n*                                                                      *\n************************************************************************\n-}\n\nrecordThUse :: TcM ()\nrecordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True }\n\nrecordThSpliceUse :: TcM ()\nrecordThSpliceUse = do { env <- getGblEnv; writeTcRef (tcg_th_splice_used env) True }\n\n-- | When generating an out-of-scope error message for a variable matching a\n-- binding in a later inter-splice group, the typechecker uses the splice\n-- locations to provide details in the message about the scope of that binding.\nrecordTopLevelSpliceLoc :: SrcSpan -> TcM ()\nrecordTopLevelSpliceLoc (RealSrcSpan real_loc)\n  = do { env <- getGblEnv\n       ; let locs_var = tcg_th_top_level_locs env\n       ; locs0 <- readTcRef locs_var\n       ; writeTcRef locs_var (Set.insert real_loc locs0) }\nrecordTopLevelSpliceLoc (UnhelpfulSpan _) = return ()\n\ngetTopLevelSpliceLocs :: TcM (Set RealSrcSpan)\ngetTopLevelSpliceLocs\n  = do { env <- getGblEnv\n       ; readTcRef (tcg_th_top_level_locs env) }\n\nkeepAlive :: Name -> TcRn ()     -- Record the name in the keep-alive set\nkeepAlive name\n  = do { env <- getGblEnv\n       ; traceRn \"keep alive\" (ppr name)\n       ; updTcRef (tcg_keep env) (`extendNameSet` name) }\n\ngetStage :: TcM ThStage\ngetStage = do { env <- getLclEnv; return (tcl_th_ctxt env) }\n\ngetStageAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, ThLevel, ThStage))\ngetStageAndBindLevel name\n  = do { env <- getLclEnv;\n       ; case lookupNameEnv (tcl_th_bndrs env) name of\n           Nothing                  -> return Nothing\n           Just (top_lvl, bind_lvl) -> return (Just (top_lvl, bind_lvl, tcl_th_ctxt env)) }\n\nsetStage :: ThStage -> TcM a -> TcRn a\nsetStage s = updLclEnv (\\ env -> env { tcl_th_ctxt = s })\n\n-- | Adds the given modFinalizers to the global environment and set them to use\n-- the current local environment.\naddModFinalizersWithLclEnv :: ThModFinalizers -> TcM ()\naddModFinalizersWithLclEnv mod_finalizers\n  = do lcl_env <- getLclEnv\n       th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv\n       updTcRef th_modfinalizers_var $ \\fins ->\n         (lcl_env, mod_finalizers) : fins\n\n{-\n************************************************************************\n*                                                                      *\n             Safe Haskell context\n*                                                                      *\n************************************************************************\n-}\n\n-- | Mark that safe inference has failed\n-- See Note [Safe Haskell Overlapping Instances Implementation]\n-- although this is used for more than just that failure case.\nrecordUnsafeInfer :: WarningMessages -> TcM ()\nrecordUnsafeInfer warns =\n    getGblEnv >>= \\env -> writeTcRef (tcg_safeInfer env) (False, warns)\n\n-- | Figure out the final correct safe haskell mode\nfinalSafeMode :: DynFlags -> TcGblEnv -> IO SafeHaskellMode\nfinalSafeMode dflags tcg_env = do\n    safeInf <- fst <$> readIORef (tcg_safeInfer tcg_env)\n    return $ case safeHaskell dflags of\n        Sf_None | safeInferOn dflags && safeInf -> Sf_Safe\n                | otherwise                     -> Sf_None\n        s -> s\n\n-- | Switch instances to safe instances if we're in Safe mode.\nfixSafeInstances :: SafeHaskellMode -> [ClsInst] -> [ClsInst]\nfixSafeInstances sfMode | sfMode /= Sf_Safe = id\nfixSafeInstances _ = map fixSafe\n  where fixSafe inst = let new_flag = (is_flag inst) { isSafeOverlap = True }\n                       in inst { is_flag = new_flag }\n\n{-\n************************************************************************\n*                                                                      *\n             Stuff for the renamer's local env\n*                                                                      *\n************************************************************************\n-}\n\ngetLocalRdrEnv :: RnM LocalRdrEnv\ngetLocalRdrEnv = do { env <- getLclEnv; return (tcl_rdr env) }\n\nsetLocalRdrEnv :: LocalRdrEnv -> RnM a -> RnM a\nsetLocalRdrEnv rdr_env thing_inside\n  = updLclEnv (\\env -> env {tcl_rdr = rdr_env}) thing_inside\n\n{-\n************************************************************************\n*                                                                      *\n             Stuff for interface decls\n*                                                                      *\n************************************************************************\n-}\n\nmkIfLclEnv :: Module -> SDoc -> Bool -> IfLclEnv\nmkIfLclEnv mod loc boot\n                   = IfLclEnv { if_mod     = mod,\n                                if_loc     = loc,\n                                if_boot    = boot,\n                                if_nsubst  = Nothing,\n                                if_implicits_env = Nothing,\n                                if_tv_env  = emptyFsEnv,\n                                if_id_env  = emptyFsEnv }\n\n-- | Run an 'IfG' (top-level interface monad) computation inside an existing\n-- 'TcRn' (typecheck-renaming monad) computation by initializing an 'IfGblEnv'\n-- based on 'TcGblEnv'.\ninitIfaceTcRn :: IfG a -> TcRn a\ninitIfaceTcRn thing_inside\n  = do  { tcg_env <- getGblEnv\n        ; dflags <- getDynFlags\n        ; let !mod = tcg_semantic_mod tcg_env\n              -- When we are instantiating a signature, we DEFINITELY\n              -- do not want to knot tie.\n              is_instantiate = unitIdIsDefinite (thisPackage dflags) &&\n                               not (null (thisUnitIdInsts dflags))\n        ; let { if_env = IfGblEnv {\n                            if_doc = text \"initIfaceTcRn\",\n                            if_rec_types =\n                                if is_instantiate\n                                    then Nothing\n                                    else Just (mod, get_type_env)\n                         }\n              ; get_type_env = readTcRef (tcg_type_env_var tcg_env) }\n        ; setEnvs (if_env, ()) thing_inside }\n\n-- Used when sucking in a ModIface into a ModDetails to put in\n-- the HPT.  Notably, unlike initIfaceCheck, this does NOT use\n-- hsc_type_env_var (since we're not actually going to typecheck,\n-- so this variable will never get updated!)\ninitIfaceLoad :: HscEnv -> IfG a -> IO a\ninitIfaceLoad hsc_env do_this\n = do let gbl_env = IfGblEnv {\n                        if_doc = text \"initIfaceLoad\",\n                        if_rec_types = Nothing\n                    }\n      initTcRnIf 'i' hsc_env gbl_env () do_this\n\ninitIfaceCheck :: SDoc -> HscEnv -> IfG a -> IO a\n-- Used when checking the up-to-date-ness of the old Iface\n-- Initialise the environment with no useful info at all\ninitIfaceCheck doc hsc_env do_this\n = do let rec_types = case hsc_type_env_var hsc_env of\n                         Just (mod,var) -> Just (mod, readTcRef var)\n                         Nothing        -> Nothing\n          gbl_env = IfGblEnv {\n                        if_doc = text \"initIfaceCheck\" <+> doc,\n                        if_rec_types = rec_types\n                    }\n      initTcRnIf 'i' hsc_env gbl_env () do_this\n\ninitIfaceLcl :: Module -> SDoc -> Bool -> IfL a -> IfM lcl a\ninitIfaceLcl mod loc_doc hi_boot_file thing_inside\n  = setLclEnv (mkIfLclEnv mod loc_doc hi_boot_file) thing_inside\n\n-- | Initialize interface typechecking, but with a 'NameShape'\n-- to apply when typechecking top-level 'OccName's (see\n-- 'lookupIfaceTop')\ninitIfaceLclWithSubst :: Module -> SDoc -> Bool -> NameShape -> IfL a -> IfM lcl a\ninitIfaceLclWithSubst mod loc_doc hi_boot_file nsubst thing_inside\n  = setLclEnv ((mkIfLclEnv mod loc_doc hi_boot_file) { if_nsubst = Just nsubst }) thing_inside\n\ngetIfModule :: IfL Module\ngetIfModule = do { env <- getLclEnv; return (if_mod env) }\n\n--------------------\nfailIfM :: MsgDoc -> IfL a\n-- The Iface monad doesn't have a place to accumulate errors, so we\n-- just fall over fast if one happens; it \"shouldn't happen\".\n-- We use IfL here so that we can get context info out of the local env\nfailIfM msg\n  = do  { env <- getLclEnv\n        ; let full_msg = (if_loc env <> colon) $$ nest 2 msg\n        ; dflags <- getDynFlags\n        ; liftIO (putLogMsg dflags NoReason SevFatal\n                   noSrcSpan (defaultErrStyle dflags) full_msg)\n        ; failM }\n\n--------------------\nforkM_maybe :: SDoc -> IfL a -> IfL (Maybe a)\n-- Run thing_inside in an interleaved thread.\n-- It shares everything with the parent thread, so this is DANGEROUS.\n--\n-- It returns Nothing if the computation fails\n--\n-- It's used for lazily type-checking interface\n-- signatures, which is pretty benign\n\nforkM_maybe doc thing_inside\n -- NB: Don't share the mutable env_us with the interleaved thread since env_us\n --     does not get updated atomically (e.g. in newUnique and newUniqueSupply).\n = do { child_us <- newUniqueSupply\n      ; child_env_us <- newMutVar child_us\n        -- see Note [Masking exceptions in forkM_maybe]\n      ; unsafeInterleaveM $ uninterruptibleMaskM_ $ updEnv (\\env -> env { env_us = child_env_us }) $\n        do { traceIf (text \"Starting fork {\" <+> doc)\n           ; mb_res <- tryM $\n                       updLclEnv (\\env -> env { if_loc = if_loc env $$ doc }) $\n                       thing_inside\n           ; case mb_res of\n                Right r  -> do  { traceIf (text \"} ending fork\" <+> doc)\n                                ; return (Just r) }\n                Left exn -> do {\n\n                    -- Bleat about errors in the forked thread, if -ddump-if-trace is on\n                    -- Otherwise we silently discard errors. Errors can legitimately\n                    -- happen when compiling interface signatures (see tcInterfaceSigs)\n                      whenDOptM Opt_D_dump_if_trace $ do\n                          dflags <- getDynFlags\n                          let msg = hang (text \"forkM failed:\" <+> doc)\n                                       2 (text (show exn))\n                          liftIO $ putLogMsg dflags\n                                             NoReason\n                                             SevFatal\n                                             noSrcSpan\n                                             (defaultErrStyle dflags)\n                                             msg\n\n                    ; traceIf (text \"} ending fork (badly)\" <+> doc)\n                    ; return Nothing }\n        }}\n\nforkM :: SDoc -> IfL a -> IfL a\nforkM doc thing_inside\n = do   { mb_res <- forkM_maybe doc thing_inside\n        ; return (case mb_res of\n                        Nothing -> pgmError \"Cannot continue after interface file error\"\n                                   -- pprPanic \"forkM\" doc\n                        Just r  -> r) }\n\nsetImplicitEnvM :: TypeEnv -> IfL a -> IfL a\nsetImplicitEnvM tenv m = updLclEnv (\\lcl -> lcl\n                                     { if_implicits_env = Just tenv }) m\n\n{-\nNote [Masking exceptions in forkM_maybe]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen using GHC-as-API it must be possible to interrupt snippets of code\nexecuted using runStmt (#1381). Since commit 02c4ab04 this is almost possible\nby throwing an asynchronous interrupt to the GHC thread. However, there is a\nsubtle problem: runStmt first typechecks the code before running it, and the\nexception might interrupt the type checker rather than the code. Moreover, the\ntypechecker might be inside an unsafeInterleaveIO (through forkM_maybe), and\nmore importantly might be inside an exception handler inside that\nunsafeInterleaveIO. If that is the case, the exception handler will rethrow the\nasynchronous exception as a synchronous exception, and the exception will end\nup as the value of the unsafeInterleaveIO thunk (see #8006 for a detailed\ndiscussion).  We don't currently know a general solution to this problem, but\nwe can use uninterruptibleMask_ to avoid the situation.\n-}\n\n-- | Environments which track 'CostCentreState'\nclass ContainsCostCentreState e where\n  extractCostCentreState :: e -> TcRef CostCentreState\n\ninstance ContainsCostCentreState TcGblEnv where\n  extractCostCentreState = tcg_cc_st\n\ninstance ContainsCostCentreState DsGblEnv where\n  extractCostCentreState = ds_cc_st\n\n-- | Get the next cost centre index associated with a given name.\ngetCCIndexM :: (ContainsCostCentreState gbl)\n            => FastString -> TcRnIf gbl lcl CostCentreIndex\ngetCCIndexM nm = do\n  env <- getGblEnv\n  let cc_st_ref = extractCostCentreState env\n  cc_st <- readTcRef cc_st_ref\n  let (idx, cc_st') = getCCIndex nm cc_st\n  writeTcRef cc_st_ref cc_st'\n  return idx\n", "num_lines": 1988}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006-2012\n(c) The GRASP Project, Glasgow University, 1992-2002\n\n\nVarious types used during typechecking, please see TcRnMonad as well for\noperations on these types. You probably want to import it, instead of this\nmodule.\n\nAll the monads exported here are built on top of the same IOEnv monad. The\nmonad functions like a Reader monad in the way it passes the environment\naround. This is done to allow the environment to be manipulated in a stack\nlike fashion when entering expressions... etc.\n\nFor state that is global and should be returned at the end (e.g not part\nof the stack mechanism), you should use a TcRef (= IORef) to store them.\n-}\n\n{-# LANGUAGE CPP, ExistentialQuantification, GeneralizedNewtypeDeriving,\n             ViewPatterns #-}\n\nmodule TcRnTypes(\n        TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module\n        TcRef,\n\n        -- The environment types\n        Env(..),\n        TcGblEnv(..), TcLclEnv(..),\n        IfGblEnv(..), IfLclEnv(..),\n        tcVisibleOrphanMods,\n\n        -- Frontend types (shouldn't really be here)\n        FrontendResult(..),\n\n        -- Renamer types\n        ErrCtxt, RecFieldEnv,\n        ImportAvails(..), emptyImportAvails, plusImportAvails,\n        WhereFrom(..), mkModDeps, modDepsElts,\n\n        -- Typechecker types\n        TcTypeEnv, TcBinderStack, TcBinder(..),\n        TcTyThing(..), PromotionErr(..),\n        IdBindingInfo(..), ClosedTypeId, RhsNames,\n        IsGroupClosed(..),\n        SelfBootInfo(..),\n        pprTcTyThingCategory, pprPECategory, CompleteMatch(..),\n\n        -- Desugaring types\n        DsM, DsLclEnv(..), DsGblEnv(..),\n        DsMetaEnv, DsMetaVal(..), CompleteMatchMap,\n        mkCompleteMatchMap, extendCompleteMatchMap,\n\n        -- Template Haskell\n        ThStage(..), SpliceType(..), PendingStuff(..),\n        topStage, topAnnStage, topSpliceStage,\n        ThLevel, impLevel, outerLevel, thLevel,\n        ForeignSrcLang(..),\n\n        -- Arrows\n        ArrowCtxt(..),\n\n        -- TcSigInfo\n        TcSigFun, TcSigInfo(..), TcIdSigInfo(..),\n        TcIdSigInst(..), TcPatSynInfo(..),\n        isPartialSig, hasCompleteSig,\n\n        -- QCInst\n        QCInst(..), isPendingScInst,\n\n        -- Canonical constraints\n        Xi, Ct(..), Cts, emptyCts, andCts, andManyCts, pprCts,\n        singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList,\n        isEmptyCts, isCTyEqCan, isCFunEqCan,\n        isPendingScDict, superClassesMightHelp, getPendingWantedScs,\n        isCDictCan_Maybe, isCFunEqCan_maybe,\n        isCNonCanonical, isWantedCt, isDerivedCt,\n        isGivenCt, isHoleCt, isOutOfScopeCt, isExprHoleCt, isTypeHoleCt,\n        isUserTypeErrorCt, getUserTypeErrorMsg,\n        ctEvidence, ctLoc, setCtLoc, ctPred, ctFlavour, ctEqRel, ctOrigin,\n        ctEvId, mkTcEqPredLikeEv,\n        mkNonCanonical, mkNonCanonicalCt, mkGivens,\n        mkIrredCt, mkInsolubleCt,\n        ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel,\n        ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId,\n        tyCoVarsOfCt, tyCoVarsOfCts,\n        tyCoVarsOfCtList, tyCoVarsOfCtsList,\n\n        WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,\n        isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC,\n        addInsols, insolublesOnly, addSimples, addImplics,\n        tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples,\n        tyCoVarsOfWCList, insolubleCt, insolubleEqCt,\n        isDroppableCt, insolubleImplic,\n        arisesFromGivens,\n\n        Implication(..), newImplication, implicationPrototype,\n        implicLclEnv, implicDynFlags,\n        ImplicStatus(..), isInsolubleStatus, isSolvedStatus,\n        SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,\n        bumpSubGoalDepth, subGoalDepthExceeded,\n        CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,\n        ctLocTypeOrKind_maybe,\n        ctLocDepth, bumpCtLocDepth, isGivenLoc,\n        setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,\n        CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,\n        isVisibleOrigin, toInvisibleOrigin,\n        TypeOrKind(..), isTypeLevel, isKindLevel,\n        pprCtOrigin, pprCtLoc,\n        pushErrCtxt, pushErrCtxtSameOrigin,\n\n\n        SkolemInfo(..), pprSigSkolInfo, pprSkolInfo,\n\n        CtEvidence(..), TcEvDest(..),\n        mkKindLoc, toKindLoc, mkGivenLoc,\n        isWanted, isGiven, isDerived, isGivenOrWDeriv,\n        ctEvRole,\n\n        wrapType, wrapTypeWithImplication,\n        removeBindingShadowing,\n\n        -- Constraint solver plugins\n        TcPlugin(..), TcPluginResult(..), TcPluginSolver,\n        TcPluginM, runTcPluginM, unsafeTcPluginTcM,\n        getEvBindsTcPluginM,\n\n        CtFlavour(..), ShadowInfo(..), ctEvFlavour,\n        CtFlavourRole, ctEvFlavourRole, ctFlavourRole,\n        eqCanRewrite, eqCanRewriteFR, eqMayRewriteFR,\n        eqCanDischargeFR,\n        funEqCanDischarge, funEqCanDischargeF,\n\n        -- Pretty printing\n        pprEvVarTheta,\n        pprEvVars, pprEvVarWithType,\n\n        -- Misc other types\n        TcId, TcIdSet,\n        Hole(..), holeOcc,\n        NameShape(..),\n\n        -- Role annotations\n        RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,\n        lookupRoleAnnot, getRoleAnnots,\n\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport CoreSyn\nimport HscTypes\nimport TcEvidence\nimport Type\nimport Class    ( Class )\nimport TyCon    ( TyCon, TyConFlavour, tyConKind )\nimport TyCoRep  ( coHoleCoVar )\nimport Coercion ( Coercion, mkHoleCo )\nimport ConLike  ( ConLike(..) )\nimport DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )\nimport PatSyn   ( PatSyn, pprPatSynType )\nimport Id       ( idType, idName )\nimport FieldLabel ( FieldLabel )\nimport TcType\nimport Annotations\nimport InstEnv\nimport FamInstEnv\nimport PmExpr\nimport IOEnv\nimport RdrName\nimport Name\nimport NameEnv\nimport NameSet\nimport Avail\nimport Var\nimport FV\nimport VarEnv\nimport Module\nimport SrcLoc\nimport VarSet\nimport ErrUtils\nimport UniqFM\nimport UniqSupply\nimport BasicTypes\nimport Bag\nimport DynFlags\nimport Outputable\nimport ListSetOps\nimport FastString\nimport qualified GHC.LanguageExtensions as LangExt\nimport Fingerprint\nimport Util\nimport PrelNames ( isUnboundName )\nimport CostCentreState\n\nimport Control.Monad (ap, liftM, msum)\nimport qualified Control.Monad.Fail as MonadFail\nimport Data.Set      ( Set )\nimport qualified Data.Set as S\n\nimport Data.List ( sort )\nimport Data.Map ( Map )\nimport Data.Dynamic  ( Dynamic )\nimport Data.Typeable ( TypeRep )\nimport Data.Maybe    ( mapMaybe )\nimport GHCi.Message\nimport GHCi.RemoteTypes\n\nimport qualified Language.Haskell.TH as TH\n\n-- | A 'NameShape' is a substitution on 'Name's that can be used\n-- to refine the identities of a hole while we are renaming interfaces\n-- (see 'RnModIface').  Specifically, a 'NameShape' for\n-- 'ns_module_name' @A@, defines a mapping from @{A.T}@\n-- (for some 'OccName' @T@) to some arbitrary other 'Name'.\n--\n-- The most intruiging thing about a 'NameShape', however, is\n-- how it's constructed.  A 'NameShape' is *implied* by the\n-- exported 'AvailInfo's of the implementor of an interface:\n-- if an implementor of signature @<H>@ exports @M.T@, you implicitly\n-- define a substitution from @{H.T}@ to @M.T@.  So a 'NameShape'\n-- is computed from the list of 'AvailInfo's that are exported\n-- by the implementation of a module, or successively merged\n-- together by the export lists of signatures which are joining\n-- together.\n--\n-- It's not the most obvious way to go about doing this, but it\n-- does seem to work!\n--\n-- NB: Can't boot this and put it in NameShape because then we\n-- start pulling in too many DynFlags things.\ndata NameShape = NameShape {\n        ns_mod_name :: ModuleName,\n        ns_exports :: [AvailInfo],\n        ns_map :: OccEnv Name\n    }\n\n\n{-\n************************************************************************\n*                                                                      *\n               Standard monad definition for TcRn\n    All the combinators for the monad can be found in TcRnMonad\n*                                                                      *\n************************************************************************\n\nThe monad itself has to be defined here, because it is mentioned by ErrCtxt\n-}\n\ntype TcRnIf a b = IOEnv (Env a b)\ntype TcRn       = TcRnIf TcGblEnv TcLclEnv    -- Type inference\ntype IfM lcl    = TcRnIf IfGblEnv lcl         -- Iface stuff\ntype IfG        = IfM ()                      --    Top level\ntype IfL        = IfM IfLclEnv                --    Nested\ntype DsM        = TcRnIf DsGblEnv DsLclEnv    -- Desugaring\n\n-- TcRn is the type-checking and renaming monad: the main monad that\n-- most type-checking takes place in.  The global environment is\n-- 'TcGblEnv', which tracks all of the top-level type-checking\n-- information we've accumulated while checking a module, while the\n-- local environment is 'TcLclEnv', which tracks local information as\n-- we move inside expressions.\n\n-- | Historical \"renaming monad\" (now it's just 'TcRn').\ntype RnM  = TcRn\n\n-- | Historical \"type-checking monad\" (now it's just 'TcRn').\ntype TcM  = TcRn\n\n-- We 'stack' these envs through the Reader like monad infrastructure\n-- as we move into an expression (although the change is focused in\n-- the lcl type).\ndata Env gbl lcl\n  = Env {\n        env_top  :: !HscEnv, -- Top-level stuff that never changes\n                             -- Includes all info about imported things\n                             -- BangPattern is to fix leak, see #15111\n\n        env_us   :: {-# UNPACK #-} !(IORef UniqSupply),\n                             -- Unique supply for local variables\n\n        env_gbl  :: gbl,     -- Info about things defined at the top level\n                             -- of the module being compiled\n\n        env_lcl  :: lcl      -- Nested stuff; changes as we go into\n    }\n\ninstance ContainsDynFlags (Env gbl lcl) where\n    extractDynFlags env = hsc_dflags (env_top env)\n\ninstance ContainsModule gbl => ContainsModule (Env gbl lcl) where\n    extractModule env = extractModule (env_gbl env)\n\n\n{-\n************************************************************************\n*                                                                      *\n                The interface environments\n              Used when dealing with IfaceDecls\n*                                                                      *\n************************************************************************\n-}\n\ndata IfGblEnv\n  = IfGblEnv {\n        -- Some information about where this environment came from;\n        -- useful for debugging.\n        if_doc :: SDoc,\n        -- The type environment for the module being compiled,\n        -- in case the interface refers back to it via a reference that\n        -- was originally a hi-boot file.\n        -- We need the module name so we can test when it's appropriate\n        -- to look in this env.\n        -- See Note [Tying the knot] in TcIface\n        if_rec_types :: Maybe (Module, IfG TypeEnv)\n                -- Allows a read effect, so it can be in a mutable\n                -- variable; c.f. handling the external package type env\n                -- Nothing => interactive stuff, no loops possible\n    }\n\ndata IfLclEnv\n  = IfLclEnv {\n        -- The module for the current IfaceDecl\n        -- So if we see   f = \\x -> x\n        -- it means M.f = \\x -> x, where M is the if_mod\n        -- NB: This is a semantic module, see\n        -- Note [Identity versus semantic module]\n        if_mod :: Module,\n\n        -- Whether or not the IfaceDecl came from a boot\n        -- file or not; we'll use this to choose between\n        -- NoUnfolding and BootUnfolding\n        if_boot :: Bool,\n\n        -- The field is used only for error reporting\n        -- if (say) there's a Lint error in it\n        if_loc :: SDoc,\n                -- Where the interface came from:\n                --      .hi file, or GHCi state, or ext core\n                -- plus which bit is currently being examined\n\n        if_nsubst :: Maybe NameShape,\n\n        -- This field is used to make sure \"implicit\" declarations\n        -- (anything that cannot be exported in mi_exports) get\n        -- wired up correctly in typecheckIfacesForMerging.  Most\n        -- of the time it's @Nothing@.  See Note [Resolving never-exported Names in TcIface]\n        -- in TcIface.\n        if_implicits_env :: Maybe TypeEnv,\n\n        if_tv_env  :: FastStringEnv TyVar,     -- Nested tyvar bindings\n        if_id_env  :: FastStringEnv Id         -- Nested id binding\n    }\n\n{-\n************************************************************************\n*                                                                      *\n                Desugarer monad\n*                                                                      *\n************************************************************************\n\nNow the mondo monad magic (yes, @DsM@ is a silly name)---carry around\na @UniqueSupply@ and some annotations, which\npresumably include source-file location information:\n-}\n\ndata DsGblEnv\n        = DsGblEnv\n        { ds_mod          :: Module             -- For SCC profiling\n        , ds_fam_inst_env :: FamInstEnv         -- Like tcg_fam_inst_env\n        , ds_unqual  :: PrintUnqualified\n        , ds_msgs    :: IORef Messages          -- Warning messages\n        , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global,\n                                                -- possibly-imported things\n        , ds_complete_matches :: CompleteMatchMap\n           -- Additional complete pattern matches\n        , ds_cc_st   :: IORef CostCentreState\n           -- Tracking indices for cost centre annotations\n        }\n\ninstance ContainsModule DsGblEnv where\n    extractModule = ds_mod\n\ndata DsLclEnv = DsLclEnv {\n        dsl_meta    :: DsMetaEnv,        -- Template Haskell bindings\n        dsl_loc     :: RealSrcSpan,      -- To put in pattern-matching error msgs\n\n        -- See Note [Note [Type and Term Equality Propagation] in Check.hs\n        -- These two fields are augmented as we walk inwards,\n        -- through each patttern match in turn\n        dsl_dicts   :: Bag EvVar,     -- Constraints from GADT pattern-matching\n        dsl_tm_cs   :: Bag SimpleEq,  -- Constraints form term-level pattern matching\n\n        dsl_pm_iter :: IORef Int  -- Number of iterations for pmcheck so far\n                                  -- We fail if this gets too big\n     }\n\n-- Inside [| |] brackets, the desugarer looks\n-- up variables in the DsMetaEnv\ntype DsMetaEnv = NameEnv DsMetaVal\n\ndata DsMetaVal\n   = DsBound Id         -- Bound by a pattern inside the [| |].\n                        -- Will be dynamically alpha renamed.\n                        -- The Id has type THSyntax.Var\n\n   | DsSplice (HsExpr GhcTc) -- These bindings are introduced by\n                             -- the PendingSplices on a HsBracketOut\n\n\n{-\n************************************************************************\n*                                                                      *\n                Global typechecker environment\n*                                                                      *\n************************************************************************\n-}\n\n-- | 'FrontendResult' describes the result of running the\n-- frontend of a Haskell module.  Usually, you'll get\n-- a 'FrontendTypecheck', since running the frontend involves\n-- typechecking a program, but for an hs-boot merge you'll\n-- just get a ModIface, since no actual typechecking occurred.\n--\n-- This data type really should be in HscTypes, but it needs\n-- to have a TcGblEnv which is only defined here.\ndata FrontendResult\n        = FrontendTypecheck TcGblEnv\n\n-- Note [Identity versus semantic module]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- When typechecking an hsig file, it is convenient to keep track\n-- of two different \"this module\" identifiers:\n--\n--      - The IDENTITY module is simply thisPackage + the module\n--        name; i.e. it uniquely *identifies* the interface file\n--        we're compiling.  For example, p[A=<A>]:A is an\n--        identity module identifying the requirement named A\n--        from library p.\n--\n--      - The SEMANTIC module, which is the actual module that\n--        this signature is intended to represent (e.g. if\n--        we have a identity module p[A=base:Data.IORef]:A,\n--        then the semantic module is base:Data.IORef)\n--\n-- Which one should you use?\n--\n--      - In the desugarer and later phases of compilation,\n--        identity and semantic modules coincide, since we never compile\n--        signatures (we just generate blank object files for\n--        hsig files.)\n--\n--        A corrolary of this is that the following invariant holds at any point\n--        past desugaring,\n--\n--            if I have a Module, this_mod, in hand representing the module\n--            currently being compiled,\n--            then moduleUnitId this_mod == thisPackage dflags\n--\n--      - For any code involving Names, we want semantic modules.\n--        See lookupIfaceTop in IfaceEnv, mkIface and addFingerprints\n--        in MkIface, and tcLookupGlobal in TcEnv\n--\n--      - When reading interfaces, we want the identity module to\n--        identify the specific interface we want (such interfaces\n--        should never be loaded into the EPS).  However, if a\n--        hole module <A> is requested, we look for A.hi\n--        in the home library we are compiling.  (See LoadIface.)\n--        Similarly, in RnNames we check for self-imports using\n--        identity modules, to allow signatures to import their implementor.\n--\n--      - For recompilation avoidance, you want the identity module,\n--        since that will actually say the specific interface you\n--        want to track (and recompile if it changes)\n\n-- | 'TcGblEnv' describes the top-level of the module at the\n-- point at which the typechecker is finished work.\n-- It is this structure that is handed on to the desugarer\n-- For state that needs to be updated during the typechecking\n-- phase and returned at end, use a 'TcRef' (= 'IORef').\ndata TcGblEnv\n  = TcGblEnv {\n        tcg_mod     :: Module,         -- ^ Module being compiled\n        tcg_semantic_mod :: Module,    -- ^ If a signature, the backing module\n            -- See also Note [Identity versus semantic module]\n        tcg_src     :: HscSource,\n          -- ^ What kind of module (regular Haskell, hs-boot, hsig)\n\n        tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming\n        tcg_default :: Maybe [Type],\n          -- ^ Types used for defaulting. @Nothing@ => no @default@ decl\n\n        tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module\n        tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module\n                                        -- See Note [The interactive package] in HscTypes\n\n        tcg_type_env :: TypeEnv,\n          -- ^ Global type env for the module we are compiling now.  All\n          -- TyCons and Classes (for this module) end up in here right away,\n          -- along with their derived constructors, selectors.\n          --\n          -- (Ids defined in this module start in the local envt, though they\n          --  move to the global envt during zonking)\n          --\n          -- NB: for what \"things in this module\" means, see\n          -- Note [The interactive package] in HscTypes\n\n        tcg_type_env_var :: TcRef TypeEnv,\n                -- Used only to initialise the interface-file\n                -- typechecker in initIfaceTcRn, so that it can see stuff\n                -- bound in this module when dealing with hi-boot recursions\n                -- Updated at intervals (e.g. after dealing with types and classes)\n\n        tcg_inst_env     :: !InstEnv,\n          -- ^ Instance envt for all /home-package/ modules;\n          -- Includes the dfuns in tcg_insts\n          -- NB. BangPattern is to fix a leak, see #15111\n        tcg_fam_inst_env :: !FamInstEnv, -- ^ Ditto for family instances\n          -- NB. BangPattern is to fix a leak, see #15111\n        tcg_ann_env      :: AnnEnv,     -- ^ And for annotations\n\n                -- Now a bunch of things about this module that are simply\n                -- accumulated, but never consulted until the end.\n                -- Nevertheless, it's convenient to accumulate them along\n                -- with the rest of the info from this module.\n        tcg_exports :: [AvailInfo],     -- ^ What is exported\n        tcg_imports :: ImportAvails,\n          -- ^ Information about what was imported from where, including\n          -- things bound in this module. Also store Safe Haskell info\n          -- here about transitive trusted package requirements.\n          --\n          -- There are not many uses of this field, so you can grep for\n          -- all them.\n          --\n          -- The ImportAvails records information about the following\n          -- things:\n          --\n          --    1. All of the modules you directly imported (tcRnImports)\n          --    2. The orphans (only!) of all imported modules in a GHCi\n          --       session (runTcInteractive)\n          --    3. The module that instantiated a signature\n          --    4. Each of the signatures that merged in\n          --\n          -- It is used in the following ways:\n          --    - imp_orphs is used to determine what orphan modules should be\n          --      visible in the context (tcVisibleOrphanMods)\n          --    - imp_finsts is used to determine what family instances should\n          --      be visible (tcExtendLocalFamInstEnv)\n          --    - To resolve the meaning of the export list of a module\n          --      (tcRnExports)\n          --    - imp_mods is used to compute usage info (mkIfaceTc, deSugar)\n          --    - imp_trust_own_pkg is used for Safe Haskell in interfaces\n          --      (mkIfaceTc, as well as in HscMain)\n          --    - To create the Dependencies field in interface (mkDependencies)\n\n        tcg_dus       :: DefUses,   -- ^ What is defined in this module and what is used.\n        tcg_used_gres :: TcRef [GlobalRdrElt],  -- ^ Records occurrences of imported entities\n          -- One entry for each occurrence; but may have different GREs for\n          -- the same Name See Note [Tracking unused binding and imports]\n\n        tcg_keep :: TcRef NameSet,\n          -- ^ Locally-defined top-level names to keep alive.\n          --\n          -- \"Keep alive\" means give them an Exported flag, so that the\n          -- simplifier does not discard them as dead code, and so that they\n          -- are exposed in the interface file (but not to export to the\n          -- user).\n          --\n          -- Some things, like dict-fun Ids and default-method Ids are \"born\"\n          -- with the Exported flag on, for exactly the above reason, but some\n          -- we only discover as we go.  Specifically:\n          --\n          --   * The to/from functions for generic data types\n          --\n          --   * Top-level variables appearing free in the RHS of an orphan\n          --     rule\n          --\n          --   * Top-level variables appearing free in a TH bracket\n\n        tcg_th_used :: TcRef Bool,\n          -- ^ @True@ <=> Template Haskell syntax used.\n          --\n          -- We need this so that we can generate a dependency on the\n          -- Template Haskell package, because the desugarer is going\n          -- to emit loads of references to TH symbols.  The reference\n          -- is implicit rather than explicit, so we have to zap a\n          -- mutable variable.\n\n        tcg_th_splice_used :: TcRef Bool,\n          -- ^ @True@ <=> A Template Haskell splice was used.\n          --\n          -- Splices disable recompilation avoidance (see #481)\n\n        tcg_th_top_level_locs :: TcRef (Set RealSrcSpan),\n          -- ^ Locations of the top-level splices; used for providing details on\n          -- scope in error messages for out-of-scope variables\n\n        tcg_dfun_n  :: TcRef OccSet,\n          -- ^ Allows us to choose unique DFun names.\n\n        tcg_merged :: [(Module, Fingerprint)],\n          -- ^ The requirements we merged with; we always have to recompile\n          -- if any of these changed.\n\n        -- The next fields accumulate the payload of the module\n        -- The binds, rules and foreign-decl fields are collected\n        -- initially in un-zonked form and are finally zonked in tcRnSrcDecls\n\n        tcg_rn_exports :: Maybe [(Located (IE GhcRn), Avails)],\n                -- Nothing <=> no explicit export list\n                -- Is always Nothing if we don't want to retain renamed\n                -- exports.\n                -- If present contains each renamed export list item\n                -- together with its exported names.\n\n        tcg_rn_imports :: [LImportDecl GhcRn],\n                -- Keep the renamed imports regardless.  They are not\n                -- voluminous and are needed if you want to report unused imports\n\n        tcg_rn_decls :: Maybe (HsGroup GhcRn),\n          -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed\n          -- decls.\n\n        tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile\n\n        tcg_th_topdecls :: TcRef [LHsDecl GhcPs],\n        -- ^ Top-level declarations from addTopDecls\n\n        tcg_th_foreign_files :: TcRef [(ForeignSrcLang, FilePath)],\n        -- ^ Foreign files emitted from TH.\n\n        tcg_th_topnames :: TcRef NameSet,\n        -- ^ Exact names bound in top-level declarations in tcg_th_topdecls\n\n        tcg_th_modfinalizers :: TcRef [(TcLclEnv, ThModFinalizers)],\n        -- ^ Template Haskell module finalizers.\n        --\n        -- They can use particular local environments.\n\n        tcg_th_coreplugins :: TcRef [String],\n        -- ^ Core plugins added by Template Haskell code.\n\n        tcg_th_state :: TcRef (Map TypeRep Dynamic),\n        tcg_th_remote_state :: TcRef (Maybe (ForeignRef (IORef QState))),\n        -- ^ Template Haskell state\n\n        tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings\n\n        -- Things defined in this module, or (in GHCi)\n        -- in the declarations for a single GHCi command.\n        -- For the latter, see Note [The interactive package] in HscTypes\n        tcg_tr_module :: Maybe Id,   -- Id for $trModule :: GHC.Types.Module\n                                             -- for which every module has a top-level defn\n                                             -- except in GHCi in which case we have Nothing\n        tcg_binds     :: LHsBinds GhcTc,     -- Value bindings in this module\n        tcg_sigs      :: NameSet,            -- ...Top-level names that *lack* a signature\n        tcg_imp_specs :: [LTcSpecPrag],      -- ...SPECIALISE prags for imported Ids\n        tcg_warns     :: Warnings,           -- ...Warnings and deprecations\n        tcg_anns      :: [Annotation],       -- ...Annotations\n        tcg_tcs       :: [TyCon],            -- ...TyCons and Classes\n        tcg_insts     :: [ClsInst],          -- ...Instances\n        tcg_fam_insts :: [FamInst],          -- ...Family instances\n        tcg_rules     :: [LRuleDecl GhcTc],  -- ...Rules\n        tcg_fords     :: [LForeignDecl GhcTc], -- ...Foreign import & exports\n        tcg_patsyns   :: [PatSyn],            -- ...Pattern synonyms\n\n        tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs\n        tcg_hpc       :: !AnyHpcUsage,       -- ^ @True@ if any part of the\n                                             --  prog uses hpc instrumentation.\n           -- NB. BangPattern is to fix a leak, see #15111\n\n        tcg_self_boot :: SelfBootInfo,       -- ^ Whether this module has a\n                                             -- corresponding hi-boot file\n\n        tcg_main      :: Maybe Name,         -- ^ The Name of the main\n                                             -- function, if this module is\n                                             -- the main module.\n\n        tcg_safeInfer :: TcRef (Bool, WarningMessages),\n        -- ^ Has the typechecker inferred this module as -XSafe (Safe Haskell)\n        -- See Note [Safe Haskell Overlapping Instances Implementation],\n        -- although this is used for more than just that failure case.\n\n        tcg_tc_plugins :: [TcPluginSolver],\n        -- ^ A list of user-defined plugins for the constraint solver.\n\n        tcg_top_loc :: RealSrcSpan,\n        -- ^ The RealSrcSpan this module came from\n\n        tcg_static_wc :: TcRef WantedConstraints,\n          -- ^ Wanted constraints of static forms.\n        -- See Note [Constraints in static forms].\n        tcg_complete_matches :: [CompleteMatch],\n\n        -- ^ Tracking indices for cost centre annotations\n        tcg_cc_st   :: TcRef CostCentreState\n    }\n\n-- NB: topModIdentity, not topModSemantic!\n-- Definition sites of orphan identities will be identity modules, not semantic\n-- modules.\n\n-- Note [Constraints in static forms]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- When a static form produces constraints like\n--\n-- f :: StaticPtr (Bool -> String)\n-- f = static show\n--\n-- we collect them in tcg_static_wc and resolve them at the end\n-- of type checking. They need to be resolved separately because\n-- we don't want to resolve them in the context of the enclosing\n-- expression. Consider\n--\n-- g :: Show a => StaticPtr (a -> String)\n-- g = static show\n--\n-- If the @Show a0@ constraint that the body of the static form produces was\n-- resolved in the context of the enclosing expression, then the body of the\n-- static form wouldn't be closed because the Show dictionary would come from\n-- g's context instead of coming from the top level.\n\ntcVisibleOrphanMods :: TcGblEnv -> ModuleSet\ntcVisibleOrphanMods tcg_env\n    = mkModuleSet (tcg_mod tcg_env : imp_orphs (tcg_imports tcg_env))\n\ninstance ContainsModule TcGblEnv where\n    extractModule env = tcg_semantic_mod env\n\ntype RecFieldEnv = NameEnv [FieldLabel]\n        -- Maps a constructor name *in this module*\n        -- to the fields for that constructor.\n        -- This is used when dealing with \"..\" notation in record\n        -- construction and pattern matching.\n        -- The FieldEnv deals *only* with constructors defined in *this*\n        -- module.  For imported modules, we get the same info from the\n        -- TypeEnv\n\ndata SelfBootInfo\n  = NoSelfBoot    -- No corresponding hi-boot file\n  | SelfBoot\n       { sb_mds :: ModDetails   -- There was a hi-boot file,\n       , sb_tcs :: NameSet }    -- defining these TyCons,\n-- What is sb_tcs used for?  See Note [Extra dependencies from .hs-boot files]\n-- in RnSource\n\n\n{- Note [Tracking unused binding and imports]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe gather two sorts of usage information\n\n * tcg_dus (defs/uses)\n      Records *defined* Names (local, top-level)\n          and *used*    Names (local or imported)\n\n      Used (a) to report \"defined but not used\"\n               (see RnNames.reportUnusedNames)\n           (b) to generate version-tracking usage info in interface\n               files (see MkIface.mkUsedNames)\n   This usage info is mainly gathered by the renamer's\n   gathering of free-variables\n\n * tcg_used_gres\n      Used only to report unused import declarations\n\n      Records each *occurrence* an *imported* (not locally-defined) entity.\n      The occurrence is recorded by keeping a GlobalRdrElt for it.\n      These is not the GRE that is in the GlobalRdrEnv; rather it\n      is recorded *after* the filtering done by pickGREs.  So it reflect\n      /how that occurrence is in scope/.   See Note [GRE filtering] in\n      RdrName.\n\n\n************************************************************************\n*                                                                      *\n                The local typechecker environment\n*                                                                      *\n************************************************************************\n\nNote [The Global-Env/Local-Env story]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDuring type checking, we keep in the tcg_type_env\n        * All types and classes\n        * All Ids derived from types and classes (constructors, selectors)\n\nAt the end of type checking, we zonk the local bindings,\nand as we do so we add to the tcg_type_env\n        * Locally defined top-level Ids\n\nWhy?  Because they are now Ids not TcIds.  This final GlobalEnv is\n        a) fed back (via the knot) to typechecking the\n           unfoldings of interface signatures\n        b) used in the ModDetails of this module\n-}\n\ndata TcLclEnv           -- Changes as we move inside an expression\n                        -- Discarded after typecheck/rename; not passed on to desugarer\n  = TcLclEnv {\n        tcl_loc        :: RealSrcSpan,     -- Source span\n        tcl_ctxt       :: [ErrCtxt],       -- Error context, innermost on top\n        tcl_tclvl      :: TcLevel,         -- Birthplace for new unification variables\n\n        tcl_th_ctxt    :: ThStage,         -- Template Haskell context\n        tcl_th_bndrs   :: ThBindEnv,       -- and binder info\n            -- The ThBindEnv records the TH binding level of in-scope Names\n            -- defined in this module (not imported)\n            -- We can't put this info in the TypeEnv because it's needed\n            -- (and extended) in the renamer, for untyed splices\n\n        tcl_arrow_ctxt :: ArrowCtxt,       -- Arrow-notation context\n\n        tcl_rdr :: LocalRdrEnv,         -- Local name envt\n                -- Maintained during renaming, of course, but also during\n                -- type checking, solely so that when renaming a Template-Haskell\n                -- splice we have the right environment for the renamer.\n                --\n                --   Does *not* include global name envt; may shadow it\n                --   Includes both ordinary variables and type variables;\n                --   they are kept distinct because tyvar have a different\n                --   occurrence constructor (Name.TvOcc)\n                -- We still need the unsullied global name env so that\n                --   we can look up record field names\n\n        tcl_env  :: TcTypeEnv,    -- The local type environment:\n                                  -- Ids and TyVars defined in this module\n\n        tcl_bndrs :: TcBinderStack,   -- Used for reporting relevant bindings,\n                                      -- and for tidying types\n\n        tcl_tyvars :: TcRef TcTyVarSet, -- The \"global tyvars\"\n                        -- Namely, the in-scope TyVars bound in tcl_env,\n                        -- plus the tyvars mentioned in the types of Ids bound\n                        -- in tcl_lenv.\n                        -- Why mutable? see notes with tcGetGlobalTyCoVars\n\n        tcl_lie  :: TcRef WantedConstraints,    -- Place to accumulate type constraints\n        tcl_errs :: TcRef Messages              -- Place to accumulate errors\n    }\n\ntype ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))\n        -- Monadic so that we have a chance\n        -- to deal with bound type variables just before error\n        -- message construction\n\n        -- Bool:  True <=> this is a landmark context; do not\n        --                 discard it when trimming for display\n\ntype TcTypeEnv = NameEnv TcTyThing\n\ntype ThBindEnv = NameEnv (TopLevelFlag, ThLevel)\n   -- Domain = all Ids bound in this module (ie not imported)\n   -- The TopLevelFlag tells if the binding is syntactically top level.\n   -- We need to know this, because the cross-stage persistence story allows\n   -- cross-stage at arbitrary types if the Id is bound at top level.\n   --\n   -- Nota bene: a ThLevel of 'outerLevel' is *not* the same as being\n   -- bound at top level!  See Note [Template Haskell levels] in TcSplice\n\n{- Note [Given Insts]\n   ~~~~~~~~~~~~~~~~~~\nBecause of GADTs, we have to pass inwards the Insts provided by type signatures\nand existential contexts. Consider\n        data T a where { T1 :: b -> b -> T [b] }\n        f :: Eq a => T a -> Bool\n        f (T1 x y) = [x]==[y]\n\nThe constructor T1 binds an existential variable 'b', and we need Eq [b].\nWell, we have it, because Eq a refines to Eq [b], but we can only spot that if we\npass it inwards.\n\n-}\n\n-- | Type alias for 'IORef'; the convention is we'll use this for mutable\n-- bits of data in 'TcGblEnv' which are updated during typechecking and\n-- returned at the end.\ntype TcRef a     = IORef a\n-- ToDo: when should I refer to it as a 'TcId' instead of an 'Id'?\ntype TcId        = Id\ntype TcIdSet     = IdSet\n\n---------------------------\n-- The TcBinderStack\n---------------------------\n\ntype TcBinderStack = [TcBinder]\n   -- This is a stack of locally-bound ids and tyvars,\n   --   innermost on top\n   -- Used only in error reporting (relevantBindings in TcError),\n   --   and in tidying\n   -- We can't use the tcl_env type environment, because it doesn't\n   --   keep track of the nesting order\n\ndata TcBinder\n  = TcIdBndr\n       TcId\n       TopLevelFlag    -- Tells whether the binding is syntactically top-level\n                       -- (The monomorphic Ids for a recursive group count\n                       --  as not-top-level for this purpose.)\n\n  | TcIdBndr_ExpType  -- Variant that allows the type to be specified as\n                      -- an ExpType\n       Name\n       ExpType\n       TopLevelFlag\n\n  | TcTvBndr          -- e.g.   case x of P (y::a) -> blah\n       Name           -- We bind the lexical name \"a\" to the type of y,\n       TyVar          -- which might be an utterly different (perhaps\n                      -- existential) tyvar\n\ninstance Outputable TcBinder where\n   ppr (TcIdBndr id top_lvl)           = ppr id <> brackets (ppr top_lvl)\n   ppr (TcIdBndr_ExpType id _ top_lvl) = ppr id <> brackets (ppr top_lvl)\n   ppr (TcTvBndr name tv)              = ppr name <+> ppr tv\n\ninstance HasOccName TcBinder where\n    occName (TcIdBndr id _)             = occName (idName id)\n    occName (TcIdBndr_ExpType name _ _) = occName name\n    occName (TcTvBndr name _)           = occName name\n\n-- fixes #12177\n-- Builds up a list of bindings whose OccName has not been seen before\n-- i.e., If    ys  = removeBindingShadowing xs\n-- then\n--  - ys is obtained from xs by deleting some elements\n--  - ys has no duplicate OccNames\n--  - The first duplicated OccName in xs is retained in ys\n-- Overloaded so that it can be used for both GlobalRdrElt in typed-hole\n-- substitutions and TcBinder when looking for relevant bindings.\nremoveBindingShadowing :: HasOccName a => [a] -> [a]\nremoveBindingShadowing bindings = reverse $ fst $ foldl\n    (\\(bindingAcc, seenNames) binding ->\n    if occName binding `elemOccSet` seenNames -- if we've seen it\n        then (bindingAcc, seenNames)              -- skip it\n        else (binding:bindingAcc, extendOccSet seenNames (occName binding)))\n    ([], emptyOccSet) bindings\n\n---------------------------\n-- Template Haskell stages and levels\n---------------------------\n\ndata SpliceType = Typed | Untyped\n\ndata ThStage    -- See Note [Template Haskell state diagram] in TcSplice\n  = Splice SpliceType -- Inside a top-level splice\n                      -- This code will be run *at compile time*;\n                      --   the result replaces the splice\n                      -- Binding level = 0\n\n  | RunSplice (TcRef [ForeignRef (TH.Q ())])\n      -- Set when running a splice, i.e. NOT when renaming or typechecking the\n      -- Haskell code for the splice. See Note [RunSplice ThLevel].\n      --\n      -- Contains a list of mod finalizers collected while executing the splice.\n      --\n      -- 'addModFinalizer' inserts finalizers here, and from here they are taken\n      -- to construct an @HsSpliced@ annotation for untyped splices. See Note\n      -- [Delaying modFinalizers in untyped splices] in \"RnSplice\".\n      --\n      -- For typed splices, the typechecker takes finalizers from here and\n      -- inserts them in the list of finalizers in the global environment.\n      --\n      -- See Note [Collecting modFinalizers in typed splices] in \"TcSplice\".\n\n  | Comp        -- Ordinary Haskell code\n                -- Binding level = 1\n\n  | Brack                       -- Inside brackets\n      ThStage                   --   Enclosing stage\n      PendingStuff\n\ndata PendingStuff\n  = RnPendingUntyped              -- Renaming the inside of an *untyped* bracket\n      (TcRef [PendingRnSplice])   -- Pending splices in here\n\n  | RnPendingTyped                -- Renaming the inside of a *typed* bracket\n\n  | TcPending                     -- Typechecking the inside of a typed bracket\n      (TcRef [PendingTcSplice])   --   Accumulate pending splices here\n      (TcRef WantedConstraints)   --     and type constraints here\n\ntopStage, topAnnStage, topSpliceStage :: ThStage\ntopStage       = Comp\ntopAnnStage    = Splice Untyped\ntopSpliceStage = Splice Untyped\n\ninstance Outputable ThStage where\n   ppr (Splice _)    = text \"Splice\"\n   ppr (RunSplice _) = text \"RunSplice\"\n   ppr Comp          = text \"Comp\"\n   ppr (Brack s _)   = text \"Brack\" <> parens (ppr s)\n\ntype ThLevel = Int\n    -- NB: see Note [Template Haskell levels] in TcSplice\n    -- Incremented when going inside a bracket,\n    -- decremented when going inside a splice\n    -- NB: ThLevel is one greater than the 'n' in Fig 2 of the\n    --     original \"Template meta-programming for Haskell\" paper\n\nimpLevel, outerLevel :: ThLevel\nimpLevel = 0    -- Imported things; they can be used inside a top level splice\nouterLevel = 1  -- Things defined outside brackets\n\nthLevel :: ThStage -> ThLevel\nthLevel (Splice _)    = 0\nthLevel (RunSplice _) =\n    -- See Note [RunSplice ThLevel].\n    panic \"thLevel: called when running a splice\"\nthLevel Comp          = 1\nthLevel (Brack s _)   = thLevel s + 1\n\n{- Node [RunSplice ThLevel]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe 'RunSplice' stage is set when executing a splice, and only when running a\nsplice. In particular it is not set when the splice is renamed or typechecked.\n\n'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert\nthe finalizer (see Note [Delaying modFinalizers in untyped splices]), and\n'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to\nset 'RunSplice' when renaming or typechecking the splice, where 'Splice', \n'Brack' or 'Comp' are used instead.\n\n-}\n\n---------------------------\n-- Arrow-notation context\n---------------------------\n\n{- Note [Escaping the arrow scope]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn arrow notation, a variable bound by a proc (or enclosed let/kappa)\nis not in scope to the left of an arrow tail (-<) or the head of (|..|).\nFor example\n\n        proc x -> (e1 -< e2)\n\nHere, x is not in scope in e1, but it is in scope in e2.  This can get\na bit complicated:\n\n        let x = 3 in\n        proc y -> (proc z -> e1) -< e2\n\nHere, x and z are in scope in e1, but y is not.\n\nWe implement this by\nrecording the environment when passing a proc (using newArrowScope),\nand returning to that (using escapeArrowScope) on the left of -< and the\nhead of (|..|).\n\nAll this can be dealt with by the *renamer*. But the type checker needs\nto be involved too.  Example (arrowfail001)\n  class Foo a where foo :: a -> ()\n  data Bar = forall a. Foo a => Bar a\n  get :: Bar -> ()\n  get = proc x -> case x of Bar a -> foo -< a\nHere the call of 'foo' gives rise to a (Foo a) constraint that should not\nbe captured by the pattern match on 'Bar'.  Rather it should join the\nconstraints from further out.  So we must capture the constraint bag\nfrom further out in the ArrowCtxt that we push inwards.\n-}\n\ndata ArrowCtxt   -- Note [Escaping the arrow scope]\n  = NoArrowCtxt\n  | ArrowCtxt LocalRdrEnv (TcRef WantedConstraints)\n\n\n---------------------------\n-- TcTyThing\n---------------------------\n\n-- | A typecheckable thing available in a local context.  Could be\n-- 'AGlobal' 'TyThing', but also lexically scoped variables, etc.\n-- See 'TcEnv' for how to retrieve a 'TyThing' given a 'Name'.\ndata TcTyThing\n  = AGlobal TyThing             -- Used only in the return type of a lookup\n\n  | ATcId           -- Ids defined in this module; may not be fully zonked\n      { tct_id   :: TcId\n      , tct_info :: IdBindingInfo   -- See Note [Meaning of IdBindingInfo]\n      }\n\n  | ATyVar  Name TcTyVar   -- See Note [Type variables in the type environment]\n\n  | ATcTyCon TyCon   -- Used temporarily, during kind checking, for the\n                     -- tycons and clases in this recursive group\n                     -- The TyCon is always a TcTyCon.  Its kind\n                     -- can be a mono-kind or a poly-kind; in TcTyClsDcls see\n                     -- Note [Type checking recursive type and class declarations]\n\n  | APromotionErr PromotionErr\n\ndata PromotionErr\n  = TyConPE          -- TyCon used in a kind before we are ready\n                     --     data T :: T -> * where ...\n  | ClassPE          -- Ditto Class\n\n  | FamDataConPE     -- Data constructor for a data family\n                     -- See Note [AFamDataCon: not promoting data family constructors]\n                     -- in TcEnv.\n  | ConstrainedDataConPE PredType\n                     -- Data constructor with a non-equality context\n                     -- See Note [Don't promote data constructors with\n                     --           non-equality contexts] in TcHsType\n  | PatSynPE         -- Pattern synonyms\n                     -- See Note [Don't promote pattern synonyms] in TcEnv\n\n  | RecDataConPE     -- Data constructor in a recursive loop\n                     -- See Note [Recursion and promoting data constructors] in TcTyClsDecls\n  | NoDataKindsTC    -- -XDataKinds not enabled (for a tycon)\n  | NoDataKindsDC    -- -XDataKinds not enabled (for a datacon)\n\ninstance Outputable TcTyThing where     -- Debugging only\n   ppr (AGlobal g)      = ppr g\n   ppr elt@(ATcId {})   = text \"Identifier\" <>\n                          brackets (ppr (tct_id elt) <> dcolon\n                                 <> ppr (varType (tct_id elt)) <> comma\n                                 <+> ppr (tct_info elt))\n   ppr (ATyVar n tv)    = text \"Type variable\" <+> quotes (ppr n) <+> equals <+> ppr tv\n                            <+> dcolon <+> ppr (varType tv)\n   ppr (ATcTyCon tc)    = text \"ATcTyCon\" <+> ppr tc <+> dcolon <+> ppr (tyConKind tc)\n   ppr (APromotionErr err) = text \"APromotionErr\" <+> ppr err\n\n-- | IdBindingInfo describes how an Id is bound.\n--\n-- It is used for the following purposes:\n-- a) for static forms in TcExpr.checkClosedInStaticForm and\n-- b) to figure out when a nested binding can be generalised,\n--    in TcBinds.decideGeneralisationPlan.\n--\ndata IdBindingInfo -- See Note [Meaning of IdBindingInfo and ClosedTypeId]\n    = NotLetBound\n    | ClosedLet\n    | NonClosedLet\n         RhsNames        -- Used for (static e) checks only\n         ClosedTypeId    -- Used for generalisation checks\n                         -- and for (static e) checks\n\n-- | IsGroupClosed describes a group of mutually-recursive bindings\ndata IsGroupClosed\n  = IsGroupClosed\n      (NameEnv RhsNames)  -- Free var info for the RHS of each binding in the goup\n                          -- Used only for (static e) checks\n\n      ClosedTypeId        -- True <=> all the free vars of the group are\n                          --          imported or ClosedLet or\n                          --          NonClosedLet with ClosedTypeId=True.\n                          --          In particular, no tyvars, no NotLetBound\n\ntype RhsNames = NameSet   -- Names of variables, mentioned on the RHS of\n                          -- a definition, that are not Global or ClosedLet\n\ntype ClosedTypeId = Bool\n  -- See Note [Meaning of IdBindingInfo and ClosedTypeId]\n\n{- Note [Meaning of IdBindingInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNotLetBound means that\n  the Id is not let-bound (e.g. it is bound in a\n  lambda-abstraction or in a case pattern)\n\nClosedLet means that\n   - The Id is let-bound,\n   - Any free term variables are also Global or ClosedLet\n   - Its type has no free variables (NB: a top-level binding subject\n     to the MR might have free vars in its type)\n   These ClosedLets can definitely be floated to top level; and we\n   may need to do so for static forms.\n\n   Property:   ClosedLet\n             is equivalent to\n               NonClosedLet emptyNameSet True\n\n(NonClosedLet (fvs::RhsNames) (cl::ClosedTypeId)) means that\n   - The Id is let-bound\n\n   - The fvs::RhsNames contains the free names of the RHS,\n     excluding Global and ClosedLet ones.\n\n   - For the ClosedTypeId field see Note [Bindings with closed types]\n\nFor (static e) to be valid, we need for every 'x' free in 'e',\nthat x's binding is floatable to the top level.  Specifically:\n   * x's RhsNames must be empty\n   * x's type has no free variables\nSee Note [Grand plan for static forms] in StaticPtrTable.hs.\nThis test is made in TcExpr.checkClosedInStaticForm.\nActually knowing x's RhsNames (rather than just its emptiness\nor otherwise) is just so we can produce better error messages\n\nNote [Bindings with closed types: ClosedTypeId]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n  f x = let g ys = map not ys\n        in ...\n\nCan we generalise 'g' under the OutsideIn algorithm?  Yes,\nbecause all g's free variables are top-level; that is they themselves\nhave no free type variables, and it is the type variables in the\nenvironment that makes things tricky for OutsideIn generalisation.\n\nHere's the invariant:\n   If an Id has ClosedTypeId=True (in its IdBindingInfo), then\n   the Id's type is /definitely/ closed (has no free type variables).\n   Specifically,\n       a) The Id's acutal type is closed (has no free tyvars)\n       b) Either the Id has a (closed) user-supplied type signature\n          or all its free variables are Global/ClosedLet\n             or NonClosedLet with ClosedTypeId=True.\n          In particular, none are NotLetBound.\n\nWhy is (b) needed?   Consider\n    \\x. (x :: Int, let y = x+1 in ...)\nInitially x::alpha.  If we happen to typecheck the 'let' before the\n(x::Int), y's type will have a free tyvar; but if the other way round\nit won't.  So we treat any let-bound variable with a free\nnon-let-bound variable as not ClosedTypeId, regardless of what the\nfree vars of its type actually are.\n\nBut if it has a signature, all is well:\n   \\x. ...(let { y::Int; y = x+1 } in\n           let { v = y+2 } in ...)...\nHere the signature on 'v' makes 'y' a ClosedTypeId, so we can\ngeneralise 'v'.\n\nNote that:\n\n  * A top-level binding may not have ClosedTypeId=True, if it suffers\n    from the MR\n\n  * A nested binding may be closed (eg 'g' in the example we started\n    with). Indeed, that's the point; whether a function is defined at\n    top level or nested is orthogonal to the question of whether or\n    not it is closed.\n\n  * A binding may be non-closed because it mentions a lexically scoped\n    *type variable*  Eg\n        f :: forall a. blah\n        f x = let g y = ...(y::a)...\n\nUnder OutsideIn we are free to generalise an Id all of whose free\nvariables have ClosedTypeId=True (or imported).  This is an extension\ncompared to the JFP paper on OutsideIn, which used \"top-level\" as a\nproxy for \"closed\".  (It's not a good proxy anyway -- the MR can make\na top-level binding with a free type variable.)\n\nNote [Type variables in the type environment]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe type environment has a binding for each lexically-scoped\ntype variable that is in scope.  For example\n\n  f :: forall a. a -> a\n  f x = (x :: a)\n\n  g1 :: [a] -> a\n  g1 (ys :: [b]) = head ys :: b\n\n  g2 :: [Int] -> Int\n  g2 (ys :: [c]) = head ys :: c\n\n* The forall'd variable 'a' in the signature scopes over f's RHS.\n\n* The pattern-bound type variable 'b' in 'g1' scopes over g1's\n  RHS; note that it is bound to a skolem 'a' which is not itself\n  lexically in scope.\n\n* The pattern-bound type variable 'c' in 'g2' is bound to\n  Int; that is, pattern-bound type variables can stand for\n  arbitrary types. (see\n    GHC proposal #128 \"Allow ScopedTypeVariables to refer to types\"\n    https://github.com/ghc-proposals/ghc-proposals/pull/128,\n  and the paper\n    \"Type variables in patterns\", Haskell Symposium 2018.\n\n\nThis is implemented by the constructor\n   ATyVar Name TcTyVar\nin the type environment.\n\n* The Name is the name of the original, lexically scoped type\n  variable\n\n* The TcTyVar is sometimes a skolem (like in 'f'), and sometimes\n  a unification variable (like in 'g1', 'g2').  We never zonk the\n  type environment so in the latter case it always stays as a\n  unification variable, although that variable may be later\n  unified with a type (such as Int in 'g2').\n-}\n\ninstance Outputable IdBindingInfo where\n  ppr NotLetBound = text \"NotLetBound\"\n  ppr ClosedLet = text \"TopLevelLet\"\n  ppr (NonClosedLet fvs closed_type) =\n    text \"TopLevelLet\" <+> ppr fvs <+> ppr closed_type\n\ninstance Outputable PromotionErr where\n  ppr ClassPE                     = text \"ClassPE\"\n  ppr TyConPE                     = text \"TyConPE\"\n  ppr PatSynPE                    = text \"PatSynPE\"\n  ppr FamDataConPE                = text \"FamDataConPE\"\n  ppr (ConstrainedDataConPE pred) = text \"ConstrainedDataConPE\"\n                                      <+> parens (ppr pred)\n  ppr RecDataConPE                = text \"RecDataConPE\"\n  ppr NoDataKindsTC               = text \"NoDataKindsTC\"\n  ppr NoDataKindsDC               = text \"NoDataKindsDC\"\n\npprTcTyThingCategory :: TcTyThing -> SDoc\npprTcTyThingCategory (AGlobal thing)    = pprTyThingCategory thing\npprTcTyThingCategory (ATyVar {})        = text \"Type variable\"\npprTcTyThingCategory (ATcId {})         = text \"Local identifier\"\npprTcTyThingCategory (ATcTyCon {})     = text \"Local tycon\"\npprTcTyThingCategory (APromotionErr pe) = pprPECategory pe\n\npprPECategory :: PromotionErr -> SDoc\npprPECategory ClassPE                = text \"Class\"\npprPECategory TyConPE                = text \"Type constructor\"\npprPECategory PatSynPE               = text \"Pattern synonym\"\npprPECategory FamDataConPE           = text \"Data constructor\"\npprPECategory ConstrainedDataConPE{} = text \"Data constructor\"\npprPECategory RecDataConPE           = text \"Data constructor\"\npprPECategory NoDataKindsTC          = text \"Type constructor\"\npprPECategory NoDataKindsDC          = text \"Data constructor\"\n\n{-\n************************************************************************\n*                                                                      *\n        Operations over ImportAvails\n*                                                                      *\n************************************************************************\n-}\n\n-- | 'ImportAvails' summarises what was imported from where, irrespective of\n-- whether the imported things are actually used or not.  It is used:\n--\n--  * when processing the export list,\n--\n--  * when constructing usage info for the interface file,\n--\n--  * to identify the list of directly imported modules for initialisation\n--    purposes and for optimised overlap checking of family instances,\n--\n--  * when figuring out what things are really unused\n--\ndata ImportAvails\n   = ImportAvails {\n        imp_mods :: ImportedMods,\n          --      = ModuleEnv [ImportedModsVal],\n          -- ^ Domain is all directly-imported modules\n          --\n          -- See the documentation on ImportedModsVal in HscTypes for the\n          -- meaning of the fields.\n          --\n          -- We need a full ModuleEnv rather than a ModuleNameEnv here,\n          -- because we might be importing modules of the same name from\n          -- different packages. (currently not the case, but might be in the\n          -- future).\n\n        imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),\n          -- ^ Home-package modules needed by the module being compiled\n          --\n          -- It doesn't matter whether any of these dependencies\n          -- are actually /used/ when compiling the module; they\n          -- are listed if they are below it at all.  For\n          -- example, suppose M imports A which imports X.  Then\n          -- compiling M might not need to consult X.hi, but X\n          -- is still listed in M's dependencies.\n\n        imp_dep_pkgs :: Set InstalledUnitId,\n          -- ^ Packages needed by the module being compiled, whether directly,\n          -- or via other modules in this package, or via modules imported\n          -- from other packages.\n\n        imp_trust_pkgs :: Set InstalledUnitId,\n          -- ^ This is strictly a subset of imp_dep_pkgs and records the\n          -- packages the current module needs to trust for Safe Haskell\n          -- compilation to succeed. A package is required to be trusted if\n          -- we are dependent on a trustworthy module in that package.\n          -- While perhaps making imp_dep_pkgs a tuple of (UnitId, Bool)\n          -- where True for the bool indicates the package is required to be\n          -- trusted is the more logical  design, doing so complicates a lot\n          -- of code not concerned with Safe Haskell.\n          -- See Note [RnNames . Tracking Trust Transitively]\n\n        imp_trust_own_pkg :: Bool,\n          -- ^ Do we require that our own package is trusted?\n          -- This is to handle efficiently the case where a Safe module imports\n          -- a Trustworthy module that resides in the same package as it.\n          -- See Note [RnNames . Trust Own Package]\n\n        imp_orphs :: [Module],\n          -- ^ Orphan modules below us in the import tree (and maybe including\n          -- us for imported modules)\n\n        imp_finsts :: [Module]\n          -- ^ Family instance modules below us in the import tree (and maybe\n          -- including us for imported modules)\n      }\n\nmkModDeps :: [(ModuleName, IsBootInterface)]\n          -> ModuleNameEnv (ModuleName, IsBootInterface)\nmkModDeps deps = foldl' add emptyUFM deps\n               where\n                 add env elt@(m,_) = addToUFM env m elt\n\nmodDepsElts\n  :: ModuleNameEnv (ModuleName, IsBootInterface)\n  -> [(ModuleName, IsBootInterface)]\nmodDepsElts = sort . nonDetEltsUFM\n  -- It's OK to use nonDetEltsUFM here because sorting by module names\n  -- restores determinism\n\nemptyImportAvails :: ImportAvails\nemptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,\n                                   imp_dep_mods      = emptyUFM,\n                                   imp_dep_pkgs      = S.empty,\n                                   imp_trust_pkgs    = S.empty,\n                                   imp_trust_own_pkg = False,\n                                   imp_orphs         = [],\n                                   imp_finsts        = [] }\n\n-- | Union two ImportAvails\n--\n-- This function is a key part of Import handling, basically\n-- for each import we create a separate ImportAvails structure\n-- and then union them all together with this function.\nplusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails\nplusImportAvails\n  (ImportAvails { imp_mods = mods1,\n                  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,\n                  imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,\n                  imp_orphs = orphs1, imp_finsts = finsts1 })\n  (ImportAvails { imp_mods = mods2,\n                  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,\n                  imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,\n                  imp_orphs = orphs2, imp_finsts = finsts2 })\n  = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,\n                   imp_dep_mods      = plusUFM_C plus_mod_dep dmods1 dmods2,\n                   imp_dep_pkgs      = dpkgs1 `S.union` dpkgs2,\n                   imp_trust_pkgs    = tpkgs1 `S.union` tpkgs2,\n                   imp_trust_own_pkg = tself1 || tself2,\n                   imp_orphs         = orphs1 `unionLists` orphs2,\n                   imp_finsts        = finsts1 `unionLists` finsts2 }\n  where\n    plus_mod_dep r1@(m1, boot1) r2@(m2, boot2)\n      | ASSERT2( m1 == m2, (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )\n        boot1 = r2\n      | otherwise = r1\n      -- If either side can \"see\" a non-hi-boot interface, use that\n      -- Reusing existing tuples saves 10% of allocations on test\n      -- perf/compiler/MultiLayerModules\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Where from}\n*                                                                      *\n************************************************************************\n\nThe @WhereFrom@ type controls where the renamer looks for an interface file\n-}\n\ndata WhereFrom\n  = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})\n  | ImportBySystem                      -- Non user import.\n  | ImportByPlugin                      -- Importing a plugin;\n                                        -- See Note [Care with plugin imports] in LoadIface\n\ninstance Outputable WhereFrom where\n  ppr (ImportByUser is_boot) | is_boot     = text \"{- SOURCE -}\"\n                             | otherwise   = empty\n  ppr ImportBySystem                       = text \"{- SYSTEM -}\"\n  ppr ImportByPlugin                       = text \"{- PLUGIN -}\"\n\n\n{- *********************************************************************\n*                                                                      *\n                Type signatures\n*                                                                      *\n********************************************************************* -}\n\n-- These data types need to be here only because\n-- TcSimplify uses them, and TcSimplify is fairly\n-- low down in the module hierarchy\n\ntype TcSigFun  = Name -> Maybe TcSigInfo\n\ndata TcSigInfo = TcIdSig     TcIdSigInfo\n               | TcPatSynSig TcPatSynInfo\n\ndata TcIdSigInfo   -- See Note [Complete and partial type signatures]\n  = CompleteSig    -- A complete signature with no wildcards,\n                   -- so the complete polymorphic type is known.\n      { sig_bndr :: TcId          -- The polymorphic Id with that type\n\n      , sig_ctxt :: UserTypeCtxt  -- In the case of type-class default methods,\n                                  -- the Name in the FunSigCtxt is not the same\n                                  -- as the TcId; the former is 'op', while the\n                                  -- latter is '$dmop' or some such\n\n      , sig_loc  :: SrcSpan       -- Location of the type signature\n      }\n\n  | PartialSig     -- A partial type signature (i.e. includes one or more\n                   -- wildcards). In this case it doesn't make sense to give\n                   -- the polymorphic Id, because we are going to /infer/ its\n                   -- type, so we can't make the polymorphic Id ab-initio\n      { psig_name  :: Name   -- Name of the function; used when report wildcards\n      , psig_hs_ty :: LHsSigWcType GhcRn  -- The original partial signature in\n                                          -- HsSyn form\n      , sig_ctxt   :: UserTypeCtxt\n      , sig_loc    :: SrcSpan            -- Location of the type signature\n      }\n\n\n{- Note [Complete and partial type signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA type signature is partial when it contains one or more wildcards\n(= type holes).  The wildcard can either be:\n* A (type) wildcard occurring in sig_theta or sig_tau. These are\n  stored in sig_wcs.\n      f :: Bool -> _\n      g :: Eq _a => _a -> _a -> Bool\n* Or an extra-constraints wildcard, stored in sig_cts:\n      h :: (Num a, _) => a -> a\n\nA type signature is a complete type signature when there are no\nwildcards in the type signature, i.e. iff sig_wcs is empty and\nsig_extra_cts is Nothing.\n-}\n\ndata TcIdSigInst\n  = TISI { sig_inst_sig :: TcIdSigInfo\n\n         , sig_inst_skols :: [(Name, TcTyVar)]\n               -- Instantiated type and kind variables, TyVarTvs\n               -- The Name is the Name that the renamer chose;\n               --   but the TcTyVar may come from instantiating\n               --   the type and hence have a different unique.\n               -- No need to keep track of whether they are truly lexically\n               --   scoped because the renamer has named them uniquely\n               -- See Note [Binding scoped type variables] in TcSigs\n\n         , sig_inst_theta  :: TcThetaType\n               -- Instantiated theta.  In the case of a\n               -- PartialSig, sig_theta does not include\n               -- the extra-constraints wildcard\n\n         , sig_inst_tau :: TcSigmaType   -- Instantiated tau\n               -- See Note [sig_inst_tau may be polymorphic]\n\n         -- Relevant for partial signature only\n         , sig_inst_wcs   :: [(Name, TcTyVar)]\n               -- Like sig_inst_skols, but for wildcards.  The named\n               -- wildcards scope over the binding, and hence their\n               -- Names may appear in type signatures in the binding\n\n         , sig_inst_wcx   :: Maybe TcType\n               -- Extra-constraints wildcard to fill in, if any\n               -- If this exists, it is surely of the form (meta_tv |> co)\n               -- (where the co might be reflexive). This is filled in\n               -- only from the return value of TcHsType.tcWildCardOcc\n         }\n\n{- Note [sig_inst_tau may be polymorphic]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNote that \"sig_inst_tau\" might actually be a polymorphic type,\nif the original function had a signature like\n   forall a. Eq a => forall b. Ord b => ....\nBut that's ok: tcMatchesFun (called by tcRhs) can deal with that\nIt happens, too!  See Note [Polymorphic methods] in TcClassDcl.\n\nNote [Wildcards in partial signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe wildcards in psig_wcs may stand for a type mentioning\nthe universally-quantified tyvars of psig_ty\n\nE.g.  f :: forall a. _ -> a\n      f x = x\nWe get sig_inst_skols = [a]\n       sig_inst_tau   = _22 -> a\n       sig_inst_wcs   = [_22]\nand _22 in the end is unified with the type 'a'\n\nMoreover the kind of a wildcard in sig_inst_wcs may mention\nthe universally-quantified tyvars sig_inst_skols\ne.g.   f :: t a -> t _\nHere we get\n   sig_inst_skols = [k:*, (t::k ->*), (a::k)]\n   sig_inst_tau   = t a -> t _22\n   sig_inst_wcs   = [ _22::k ]\n-}\n\ndata TcPatSynInfo\n  = TPSI {\n        patsig_name           :: Name,\n        patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Inferred) and\n                                                -- implicitly-bound type vars (Specified)\n          -- See Note [The pattern-synonym signature splitting rule] in TcPatSyn\n        patsig_univ_bndrs     :: [TyVar],       -- Bound by explicit user forall\n        patsig_req            :: TcThetaType,\n        patsig_ex_bndrs       :: [TyVar],       -- Bound by explicit user forall\n        patsig_prov           :: TcThetaType,\n        patsig_body_ty        :: TcSigmaType\n    }\n\ninstance Outputable TcSigInfo where\n  ppr (TcIdSig     idsi) = ppr idsi\n  ppr (TcPatSynSig tpsi) = text \"TcPatSynInfo\" <+> ppr tpsi\n\ninstance Outputable TcIdSigInfo where\n    ppr (CompleteSig { sig_bndr = bndr })\n        = ppr bndr <+> dcolon <+> ppr (idType bndr)\n    ppr (PartialSig { psig_name = name, psig_hs_ty = hs_ty })\n        = text \"psig\" <+> ppr name <+> dcolon <+> ppr hs_ty\n\ninstance Outputable TcIdSigInst where\n    ppr (TISI { sig_inst_sig = sig, sig_inst_skols = skols\n              , sig_inst_theta = theta, sig_inst_tau = tau })\n        = hang (ppr sig) 2 (vcat [ ppr skols, ppr theta <+> darrow <+> ppr tau ])\n\ninstance Outputable TcPatSynInfo where\n    ppr (TPSI{ patsig_name = name}) = ppr name\n\nisPartialSig :: TcIdSigInst -> Bool\nisPartialSig (TISI { sig_inst_sig = PartialSig {} }) = True\nisPartialSig _                                       = False\n\n-- | No signature or a partial signature\nhasCompleteSig :: TcSigFun -> Name -> Bool\nhasCompleteSig sig_fn name\n  = case sig_fn name of\n      Just (TcIdSig (CompleteSig {})) -> True\n      _                               -> False\n\n\n{-\n************************************************************************\n*                                                                      *\n*                       Canonical constraints                          *\n*                                                                      *\n*   These are the constraints the low-level simplifier works with      *\n*                                                                      *\n************************************************************************\n-}\n\n-- The syntax of xi (\u00ce\u00be) types:\n-- xi ::= a | T xis | xis -> xis | ... | forall a. tau\n-- Two important notes:\n--      (i) No type families, unless we are under a ForAll\n--      (ii) Note that xi types can contain unexpanded type synonyms;\n--           however, the (transitive) expansions of those type synonyms\n--           will not contain any type functions, unless we are under a ForAll.\n-- We enforce the structure of Xi types when we flatten (TcCanonical)\n\ntype Xi = Type       -- In many comments, \"xi\" ranges over Xi\n\ntype Cts = Bag Ct\n\ndata Ct\n  -- Atomic canonical constraints\n  = CDictCan {  -- e.g.  Num xi\n      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]\n\n      cc_class  :: Class,\n      cc_tyargs :: [Xi],   -- cc_tyargs are function-free, hence Xi\n\n      cc_pend_sc :: Bool   -- See Note [The superclass story] in TcCanonical\n                           -- True <=> (a) cc_class has superclasses\n                           --          (b) we have not (yet) added those\n                           --              superclasses as Givens\n    }\n\n  | CIrredCan {  -- These stand for yet-unusable predicates\n      cc_ev    :: CtEvidence,   -- See Note [Ct/evidence invariant]\n      cc_insol :: Bool   -- True  <=> definitely an error, can never be solved\n                         -- False <=> might be soluble\n\n        -- For the might-be-soluble case, the ctev_pred of the evidence is\n        -- of form   (tv xi1 xi2 ... xin)   with a tyvar at the head\n        --      or   (tv1 ~ ty2)   where the CTyEqCan  kind invariant fails\n        --      or   (F tys ~ ty)  where the CFunEqCan kind invariant fails\n        -- See Note [CIrredCan constraints]\n\n        -- The definitely-insoluble case is for things like\n        --    Int ~ Bool      tycons don't match\n        --    a ~ [a]         occurs check\n    }\n\n  | CTyEqCan {  -- tv ~ rhs\n       -- Invariants:\n       --   * See Note [Applying the inert substitution] in TcFlatten\n       --   * tv not in tvs(rhs)   (occurs check)\n       --   * If tv is a TauTv, then rhs has no foralls\n       --       (this avoids substituting a forall for the tyvar in other types)\n       --   * tcTypeKind ty `tcEqKind` tcTypeKind tv; Note [Ct kind invariant]\n       --   * rhs may have at most one top-level cast\n       --   * rhs (perhaps under the one cast) is not necessarily function-free,\n       --       but it has no top-level function.\n       --     E.g. a ~ [F b]  is fine\n       --     but  a ~ F b    is not\n       --   * If the equality is representational, rhs has no top-level newtype\n       --     See Note [No top-level newtypes on RHS of representational\n       --     equalities] in TcCanonical\n       --   * If rhs (perhaps under the cast) is also a tv, then it is oriented\n       --     to give best chance of\n       --     unification happening; eg if rhs is touchable then lhs is too\n      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]\n      cc_tyvar  :: TcTyVar,\n      cc_rhs    :: TcType,     -- Not necessarily function-free (hence not Xi)\n                               -- See invariants above\n\n      cc_eq_rel :: EqRel       -- INVARIANT: cc_eq_rel = ctEvEqRel cc_ev\n    }\n\n  | CFunEqCan {  -- F xis ~ fsk\n       -- Invariants:\n       --   * isTypeFamilyTyCon cc_fun\n       --   * tcTypeKind (F xis) = tyVarKind fsk; Note [Ct kind invariant]\n       --   * always Nominal role\n      cc_ev     :: CtEvidence,  -- See Note [Ct/evidence invariant]\n      cc_fun    :: TyCon,       -- A type function\n\n      cc_tyargs :: [Xi],        -- cc_tyargs are function-free (hence Xi)\n        -- Either under-saturated or exactly saturated\n        --    *never* over-saturated (because if so\n        --    we should have decomposed)\n\n      cc_fsk    :: TcTyVar  -- [G]  always a FlatSkolTv\n                            -- [W], [WD], or [D] always a FlatMetaTv\n        -- See Note [The flattening story] in TcFlatten\n    }\n\n  | CNonCanonical {        -- See Note [NonCanonical Semantics] in TcSMonad\n      cc_ev  :: CtEvidence\n    }\n\n  | CHoleCan {             -- See Note [Hole constraints]\n       -- Treated as an \"insoluble\" constraint\n       -- See Note [Insoluble constraints]\n      cc_ev   :: CtEvidence,\n      cc_hole :: Hole\n    }\n\n  | CQuantCan QCInst       -- A quantified constraint\n      -- NB: I expect to make more of the cases in Ct\n      --     look like this, with the payload in an\n      --     auxiliary type\n\n------------\ndata QCInst  -- A much simplified version of ClsInst\n             -- See Note [Quantified constraints] in TcCanonical\n  = QCI { qci_ev   :: CtEvidence -- Always of type forall tvs. context => ty\n                                 -- Always Given\n        , qci_tvs  :: [TcTyVar]  -- The tvs\n        , qci_pred :: TcPredType -- The ty\n        , qci_pend_sc :: Bool    -- Same as cc_pend_sc flag in CDictCan\n                                 -- Invariant: True => qci_pred is a ClassPred\n    }\n\ninstance Outputable QCInst where\n  ppr (QCI { qci_ev = ev }) = ppr ev\n\n------------\n-- | An expression or type hole\ndata Hole = ExprHole UnboundVar\n            -- ^ Either an out-of-scope variable or a \"true\" hole in an\n            -- expression (TypedHoles)\n          | TypeHole OccName\n            -- ^ A hole in a type (PartialTypeSignatures)\n\ninstance Outputable Hole where\n  ppr (ExprHole ub)  = ppr ub\n  ppr (TypeHole occ) = text \"TypeHole\" <> parens (ppr occ)\n\nholeOcc :: Hole -> OccName\nholeOcc (ExprHole uv)  = unboundVarOcc uv\nholeOcc (TypeHole occ) = occ\n\n{- Note [Hole constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nCHoleCan constraints are used for two kinds of holes,\ndistinguished by cc_hole:\n\n  * For holes in expressions (including variables not in scope)\n    e.g.   f x = g _ x\n\n  * For holes in type signatures\n    e.g.   f :: _ -> _\n           f x = [x,True]\n\nNote [CIrredCan constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCIrredCan constraints are used for constraints that are \"stuck\"\n   - we can't solve them (yet)\n   - we can't use them to solve other constraints\n   - but they may become soluble if we substitute for some\n     of the type variables in the constraint\n\nExample 1:  (c Int), where c :: * -> Constraint.  We can't do anything\n            with this yet, but if later c := Num, *then* we can solve it\n\nExample 2:  a ~ b, where a :: *, b :: k, where k is a kind variable\n            We don't want to use this to substitute 'b' for 'a', in case\n            'k' is subsequently unifed with (say) *->*, because then\n            we'd have ill-kinded types floating about.  Rather we want\n            to defer using the equality altogether until 'k' get resolved.\n\nNote [Ct/evidence invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf  ct :: Ct, then extra fields of 'ct' cache precisely the ctev_pred field\nof (cc_ev ct), and is fully rewritten wrt the substitution.   Eg for CDictCan,\n   ctev_pred (cc_ev ct) = (cc_class ct) (cc_tyargs ct)\nThis holds by construction; look at the unique place where CDictCan is\nbuilt (in TcCanonical).\n\nIn contrast, the type of the evidence *term* (ctev_dest / ctev_evar) in\nthe evidence may *not* be fully zonked; we are careful not to look at it\nduring constraint solving. See Note [Evidence field of CtEvidence].\n\nNote [Ct kind invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~\nCTyEqCan and CFunEqCan both require that the kind of the lhs matches the kind\nof the rhs. This is necessary because both constraints are used for substitutions\nduring solving. If the kinds differed, then the substitution would take a well-kinded\ntype to an ill-kinded one.\n\n-}\n\nmkNonCanonical :: CtEvidence -> Ct\nmkNonCanonical ev = CNonCanonical { cc_ev = ev }\n\nmkNonCanonicalCt :: Ct -> Ct\nmkNonCanonicalCt ct = CNonCanonical { cc_ev = cc_ev ct }\n\nmkIrredCt :: CtEvidence -> Ct\nmkIrredCt ev = CIrredCan { cc_ev = ev, cc_insol = False }\n\nmkInsolubleCt :: CtEvidence -> Ct\nmkInsolubleCt ev = CIrredCan { cc_ev = ev, cc_insol = True }\n\nmkGivens :: CtLoc -> [EvId] -> [Ct]\nmkGivens loc ev_ids\n  = map mk ev_ids\n  where\n    mk ev_id = mkNonCanonical (CtGiven { ctev_evar = ev_id\n                                       , ctev_pred = evVarPred ev_id\n                                       , ctev_loc = loc })\n\nctEvidence :: Ct -> CtEvidence\nctEvidence (CQuantCan (QCI { qci_ev = ev })) = ev\nctEvidence ct = cc_ev ct\n\nctLoc :: Ct -> CtLoc\nctLoc = ctEvLoc . ctEvidence\n\nsetCtLoc :: Ct -> CtLoc -> Ct\nsetCtLoc ct loc = ct { cc_ev = (cc_ev ct) { ctev_loc = loc } }\n\nctOrigin :: Ct -> CtOrigin\nctOrigin = ctLocOrigin . ctLoc\n\nctPred :: Ct -> PredType\n-- See Note [Ct/evidence invariant]\nctPred ct = ctEvPred (ctEvidence ct)\n\nctEvId :: Ct -> EvVar\n-- The evidence Id for this Ct\nctEvId ct = ctEvEvId (ctEvidence ct)\n\n-- | Makes a new equality predicate with the same role as the given\n-- evidence.\nmkTcEqPredLikeEv :: CtEvidence -> TcType -> TcType -> TcType\nmkTcEqPredLikeEv ev\n  = case predTypeEqRel pred of\n      NomEq  -> mkPrimEqPred\n      ReprEq -> mkReprPrimEqPred\n  where\n    pred = ctEvPred ev\n\n-- | Get the flavour of the given 'Ct'\nctFlavour :: Ct -> CtFlavour\nctFlavour = ctEvFlavour . ctEvidence\n\n-- | Get the equality relation for the given 'Ct'\nctEqRel :: Ct -> EqRel\nctEqRel = ctEvEqRel . ctEvidence\n\ninstance Outputable Ct where\n  ppr ct = ppr (ctEvidence ct) <+> parens pp_sort\n    where\n      pp_sort = case ct of\n         CTyEqCan {}      -> text \"CTyEqCan\"\n         CFunEqCan {}     -> text \"CFunEqCan\"\n         CNonCanonical {} -> text \"CNonCanonical\"\n         CDictCan { cc_pend_sc = pend_sc }\n            | pend_sc   -> text \"CDictCan(psc)\"\n            | otherwise -> text \"CDictCan\"\n         CIrredCan { cc_insol = insol }\n            | insol     -> text \"CIrredCan(insol)\"\n            | otherwise -> text \"CIrredCan(sol)\"\n         CHoleCan { cc_hole = hole } -> text \"CHoleCan:\" <+> ppr hole\n         CQuantCan (QCI { qci_pend_sc = pend_sc })\n            | pend_sc   -> text \"CQuantCan(psc)\"\n            | otherwise -> text \"CQuantCan\"\n\n{-\n************************************************************************\n*                                                                      *\n        Simple functions over evidence variables\n*                                                                      *\n************************************************************************\n-}\n\n---------------- Getting free tyvars -------------------------\n\n-- | Returns free variables of constraints as a non-deterministic set\ntyCoVarsOfCt :: Ct -> TcTyCoVarSet\ntyCoVarsOfCt = fvVarSet . tyCoFVsOfCt\n\n-- | Returns free variables of constraints as a deterministically ordered.\n-- list. See Note [Deterministic FV] in FV.\ntyCoVarsOfCtList :: Ct -> [TcTyCoVar]\ntyCoVarsOfCtList = fvVarList . tyCoFVsOfCt\n\n-- | Returns free variables of constraints as a composable FV computation.\n-- See Note [Deterministic FV] in FV.\ntyCoFVsOfCt :: Ct -> FV\ntyCoFVsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })\n  = tyCoFVsOfType xi `unionFV` FV.unitFV tv\n                     `unionFV` tyCoFVsOfType (tyVarKind tv)\ntyCoFVsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk })\n  = tyCoFVsOfTypes tys `unionFV` FV.unitFV fsk\n                       `unionFV` tyCoFVsOfType (tyVarKind fsk)\ntyCoFVsOfCt (CDictCan { cc_tyargs = tys }) = tyCoFVsOfTypes tys\ntyCoFVsOfCt ct = tyCoFVsOfType (ctPred ct)\n\n-- | Returns free variables of a bag of constraints as a non-deterministic\n-- set. See Note [Deterministic FV] in FV.\ntyCoVarsOfCts :: Cts -> TcTyCoVarSet\ntyCoVarsOfCts = fvVarSet . tyCoFVsOfCts\n\n-- | Returns free variables of a bag of constraints as a deterministically\n-- odered list. See Note [Deterministic FV] in FV.\ntyCoVarsOfCtsList :: Cts -> [TcTyCoVar]\ntyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts\n\n-- | Returns free variables of a bag of constraints as a composable FV\n-- computation. See Note [Deterministic FV] in FV.\ntyCoFVsOfCts :: Cts -> FV\ntyCoFVsOfCts = foldrBag (unionFV . tyCoFVsOfCt) emptyFV\n\n-- | Returns free variables of WantedConstraints as a non-deterministic\n-- set. See Note [Deterministic FV] in FV.\ntyCoVarsOfWC :: WantedConstraints -> TyCoVarSet\n-- Only called on *zonked* things, hence no need to worry about flatten-skolems\ntyCoVarsOfWC = fvVarSet . tyCoFVsOfWC\n\n-- | Returns free variables of WantedConstraints as a deterministically\n-- ordered list. See Note [Deterministic FV] in FV.\ntyCoVarsOfWCList :: WantedConstraints -> [TyCoVar]\n-- Only called on *zonked* things, hence no need to worry about flatten-skolems\ntyCoVarsOfWCList = fvVarList . tyCoFVsOfWC\n\n-- | Returns free variables of WantedConstraints as a composable FV\n-- computation. See Note [Deterministic FV] in FV.\ntyCoFVsOfWC :: WantedConstraints -> FV\n-- Only called on *zonked* things, hence no need to worry about flatten-skolems\ntyCoFVsOfWC (WC { wc_simple = simple, wc_impl = implic })\n  = tyCoFVsOfCts simple `unionFV`\n    tyCoFVsOfBag tyCoFVsOfImplic implic\n\n-- | Returns free variables of Implication as a composable FV computation.\n-- See Note [Deterministic FV] in FV.\ntyCoFVsOfImplic :: Implication -> FV\n-- Only called on *zonked* things, hence no need to worry about flatten-skolems\ntyCoFVsOfImplic (Implic { ic_skols = skols\n                        , ic_given = givens\n                        , ic_wanted = wanted })\n  | isEmptyWC wanted\n  = emptyFV\n  | otherwise\n  = tyCoFVsVarBndrs skols  $\n    tyCoFVsVarBndrs givens $\n    tyCoFVsOfWC wanted\n\ntyCoFVsOfBag :: (a -> FV) -> Bag a -> FV\ntyCoFVsOfBag tvs_of = foldrBag (unionFV . tvs_of) emptyFV\n\n---------------------------\ndropDerivedWC :: WantedConstraints -> WantedConstraints\n-- See Note [Dropping derived constraints]\ndropDerivedWC wc@(WC { wc_simple = simples })\n  = wc { wc_simple = dropDerivedSimples simples }\n    -- The wc_impl implications are already (recursively) filtered\n\n--------------------------\ndropDerivedSimples :: Cts -> Cts\n-- Drop all Derived constraints, but make [W] back into [WD],\n-- so that if we re-simplify these constraints we will get all\n-- the right derived constraints re-generated.  Forgetting this\n-- step led to #12936\ndropDerivedSimples simples = mapMaybeBag dropDerivedCt simples\n\ndropDerivedCt :: Ct -> Maybe Ct\ndropDerivedCt ct\n  = case ctEvFlavour ev of\n      Wanted WOnly -> Just (ct' { cc_ev = ev_wd })\n      Wanted _     -> Just ct'\n      _ | isDroppableCt ct -> Nothing\n        | otherwise        -> Just ct\n  where\n    ev    = ctEvidence ct\n    ev_wd = ev { ctev_nosh = WDeriv }\n    ct'   = setPendingScDict ct -- See Note [Resetting cc_pend_sc]\n\n{- Note [Resetting cc_pend_sc]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we discard Derived constraints, in dropDerivedSimples, we must\nset the cc_pend_sc flag to True, so that if we re-process this\nCDictCan we will re-generate its derived superclasses. Otherwise\nwe might miss some fundeps.  Trac #13662 showed this up.\n\nSee Note [The superclass story] in TcCanonical.\n-}\n\nisDroppableCt :: Ct -> Bool\nisDroppableCt ct\n  = isDerived ev && not keep_deriv\n    -- Drop only derived constraints, and then only if they\n    -- obey Note [Dropping derived constraints]\n  where\n    ev   = ctEvidence ct\n    loc  = ctEvLoc ev\n    orig = ctLocOrigin loc\n\n    keep_deriv\n      = case ct of\n          CHoleCan {} -> True\n          CIrredCan { cc_insol = insoluble }\n                      -> keep_eq insoluble\n          _           -> keep_eq False\n\n    keep_eq definitely_insoluble\n       | isGivenOrigin orig    -- Arising only from givens\n       = definitely_insoluble  -- Keep only definitely insoluble\n       | otherwise\n       = case orig of\n           KindEqOrigin {} -> True    -- See Note [Dropping derived constraints]\n\n           -- See Note [Dropping derived constraints]\n           -- For fundeps, drop wanted/wanted interactions\n           FunDepOrigin2 {} -> True   -- Top-level/Wanted\n           FunDepOrigin1 _ loc1 _ loc2\n             | g1 || g2  -> True  -- Given/Wanted errors: keep all\n             | otherwise -> False -- Wanted/Wanted errors: discard\n             where\n               g1 = isGivenLoc loc1\n               g2 = isGivenLoc loc2\n\n           _ -> False\n\narisesFromGivens :: Ct -> Bool\narisesFromGivens ct\n  = case ctEvidence ct of\n      CtGiven {}                   -> True\n      CtWanted {}                  -> False\n      CtDerived { ctev_loc = loc } -> isGivenLoc loc\n\nisGivenLoc :: CtLoc -> Bool\nisGivenLoc loc = isGivenOrigin (ctLocOrigin loc)\n\nisGivenOrigin :: CtOrigin -> Bool\nisGivenOrigin (GivenOrigin {})          = True\nisGivenOrigin (FunDepOrigin1 _ l1 _ l2) = isGivenLoc l1 && isGivenLoc l2\nisGivenOrigin (FunDepOrigin2 _ o1 _ _)  = isGivenOrigin o1\nisGivenOrigin _                         = False\n\n{- Note [Dropping derived constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn general we discard derived constraints at the end of constraint solving;\nsee dropDerivedWC.  For example\n\n * Superclasses: if we have an unsolved [W] (Ord a), we don't want to\n   complain about an unsolved [D] (Eq a) as well.\n\n * If we have [W] a ~ Int, [W] a ~ Bool, improvement will generate\n   [D] Int ~ Bool, and we don't want to report that because it's\n   incomprehensible. That is why we don't rewrite wanteds with wanteds!\n\nBut (tiresomely) we do keep *some* Derived constraints:\n\n * Type holes are derived constraints, because they have no evidence\n   and we want to keep them, so we get the error report\n\n * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with\n   KindEqOrigin, may arise from a type equality a ~ Int#, say.  See\n   Note [Equalities with incompatible kinds] in TcCanonical.\n   These need to be kept because the kind equalities might have different\n   source locations and hence different error messages.\n   E.g., test case dependent/should_fail/T11471\n\n * We keep most derived equalities arising from functional dependencies\n      - Given/Given interactions (subset of FunDepOrigin1):\n        The definitely-insoluble ones reflect unreachable code.\n\n        Others not-definitely-insoluble ones like [D] a ~ Int do not\n        reflect unreachable code; indeed if fundeps generated proofs, it'd\n        be a useful equality.  See Trac #14763.   So we discard them.\n\n      - Given/Wanted interacGiven or Wanted interacting with an\n        instance declaration (FunDepOrigin2)\n\n      - Given/Wanted interactions (FunDepOrigin1); see Trac #9612\n\n      - But for Wanted/Wanted interactions we do /not/ want to report an\n        error (Trac #13506).  Consider [W] C Int Int, [W] C Int Bool, with\n        a fundep on class C.  We don't want to report an insoluble Int~Bool;\n        c.f. \"wanteds do not rewrite wanteds\".\n\nTo distinguish these cases we use the CtOrigin.\n\nNB: we keep *all* derived insolubles under some circumstances:\n\n  * They are looked at by simplifyInfer, to decide whether to\n    generalise.  Example: [W] a ~ Int, [W] a ~ Bool\n    We get [D] Int ~ Bool, and indeed the constraints are insoluble,\n    and we want simplifyInfer to see that, even though we don't\n    ultimately want to generate an (inexplicable) error message from it\n\n\n************************************************************************\n*                                                                      *\n                    CtEvidence\n         The \"flavor\" of a canonical constraint\n*                                                                      *\n************************************************************************\n-}\n\nisWantedCt :: Ct -> Bool\nisWantedCt = isWanted . ctEvidence\n\nisGivenCt :: Ct -> Bool\nisGivenCt = isGiven . ctEvidence\n\nisDerivedCt :: Ct -> Bool\nisDerivedCt = isDerived . ctEvidence\n\nisCTyEqCan :: Ct -> Bool\nisCTyEqCan (CTyEqCan {})  = True\nisCTyEqCan (CFunEqCan {}) = False\nisCTyEqCan _              = False\n\nisCDictCan_Maybe :: Ct -> Maybe Class\nisCDictCan_Maybe (CDictCan {cc_class = cls })  = Just cls\nisCDictCan_Maybe _              = Nothing\n\nisCFunEqCan_maybe :: Ct -> Maybe (TyCon, [Type])\nisCFunEqCan_maybe (CFunEqCan { cc_fun = tc, cc_tyargs = xis }) = Just (tc, xis)\nisCFunEqCan_maybe _ = Nothing\n\nisCFunEqCan :: Ct -> Bool\nisCFunEqCan (CFunEqCan {}) = True\nisCFunEqCan _ = False\n\nisCNonCanonical :: Ct -> Bool\nisCNonCanonical (CNonCanonical {}) = True\nisCNonCanonical _ = False\n\nisHoleCt:: Ct -> Bool\nisHoleCt (CHoleCan {}) = True\nisHoleCt _ = False\n\nisOutOfScopeCt :: Ct -> Bool\n-- We treat expression holes representing out-of-scope variables a bit\n-- differently when it comes to error reporting\nisOutOfScopeCt (CHoleCan { cc_hole = ExprHole (OutOfScope {}) }) = True\nisOutOfScopeCt _ = False\n\nisExprHoleCt :: Ct -> Bool\nisExprHoleCt (CHoleCan { cc_hole = ExprHole {} }) = True\nisExprHoleCt _ = False\n\nisTypeHoleCt :: Ct -> Bool\nisTypeHoleCt (CHoleCan { cc_hole = TypeHole {} }) = True\nisTypeHoleCt _ = False\n\n\n{- Note [Custom type errors in constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen GHC reports a type-error about an unsolved-constraint, we check\nto see if the constraint contains any custom-type errors, and if so\nwe report them.  Here are some examples of constraints containing type\nerrors:\n\nTypeError msg           -- The actual constraint is a type error\n\nTypError msg ~ Int      -- Some type was supposed to be Int, but ended up\n                        -- being a type error instead\n\nEq (TypeError msg)      -- A class constraint is stuck due to a type error\n\nF (TypeError msg) ~ a   -- A type function failed to evaluate due to a type err\n\nIt is also possible to have constraints where the type error is nested deeper,\nfor example see #11990, and also:\n\nEq (F (TypeError msg))  -- Here the type error is nested under a type-function\n                        -- call, which failed to evaluate because of it,\n                        -- and so the `Eq` constraint was unsolved.\n                        -- This may happen when one function calls another\n                        -- and the called function produced a custom type error.\n-}\n\n-- | A constraint is considered to be a custom type error, if it contains\n-- custom type errors anywhere in it.\n-- See Note [Custom type errors in constraints]\ngetUserTypeErrorMsg :: Ct -> Maybe Type\ngetUserTypeErrorMsg ct = findUserTypeError (ctPred ct)\n  where\n  findUserTypeError t = msum ( userTypeError_maybe t\n                             : map findUserTypeError (subTys t)\n                             )\n\n  subTys t            = case splitAppTys t of\n                          (t,[]) ->\n                            case splitTyConApp_maybe t of\n                              Nothing     -> []\n                              Just (_,ts) -> ts\n                          (t,ts) -> t : ts\n\n\n\n\nisUserTypeErrorCt :: Ct -> Bool\nisUserTypeErrorCt ct = case getUserTypeErrorMsg ct of\n                         Just _ -> True\n                         _      -> False\n\nisPendingScDict :: Ct -> Maybe Ct\n-- Says whether this is a CDictCan with cc_pend_sc is True,\n-- AND if so flips the flag\nisPendingScDict ct@(CDictCan { cc_pend_sc = True })\n                  = Just (ct { cc_pend_sc = False })\nisPendingScDict _ = Nothing\n\nisPendingScInst :: QCInst -> Maybe QCInst\n-- Same as isPrendinScDict, but for QCInsts\nisPendingScInst qci@(QCI { qci_pend_sc = True })\n                  = Just (qci { qci_pend_sc = False })\nisPendingScInst _ = Nothing\n\nsetPendingScDict :: Ct -> Ct\n-- Set the cc_pend_sc flag to True\nsetPendingScDict ct@(CDictCan { cc_pend_sc = False })\n                    = ct { cc_pend_sc = True }\nsetPendingScDict ct = ct\n\nsuperClassesMightHelp :: WantedConstraints -> Bool\n-- ^ True if taking superclasses of givens, or of wanteds (to perhaps\n-- expose more equalities or functional dependencies) might help to\n-- solve this constraint.  See Note [When superclasses help]\nsuperClassesMightHelp (WC { wc_simple = simples, wc_impl = implics })\n  = anyBag might_help_ct simples || anyBag might_help_implic implics\n  where\n    might_help_implic ic\n       | IC_Unsolved <- ic_status ic = superClassesMightHelp (ic_wanted ic)\n       | otherwise                   = False\n\n    might_help_ct ct = isWantedCt ct && not (is_ip ct)\n\n    is_ip (CDictCan { cc_class = cls }) = isIPClass cls\n    is_ip _                             = False\n\ngetPendingWantedScs :: Cts -> ([Ct], Cts)\ngetPendingWantedScs simples\n  = mapAccumBagL get [] simples\n  where\n    get acc ct | Just ct' <- isPendingScDict ct\n               = (ct':acc, ct')\n               | otherwise\n               = (acc,     ct)\n\n{- Note [When superclasses help]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFirst read Note [The superclass story] in TcCanonical.\n\nWe expand superclasses and iterate only if there is at unsolved wanted\nfor which expansion of superclasses (e.g. from given constraints)\nmight actually help. The function superClassesMightHelp tells if\ndoing this superclass expansion might help solve this constraint.\nNote that\n\n  * We look inside implications; maybe it'll help to expand the Givens\n    at level 2 to help solve an unsolved Wanted buried inside an\n    implication.  E.g.\n        forall a. Ord a => forall b. [W] Eq a\n\n  * Superclasses help only for Wanted constraints.  Derived constraints\n    are not really \"unsolved\" and we certainly don't want them to\n    trigger superclass expansion. This was a good part of the loop\n    in  Trac #11523\n\n  * Even for Wanted constraints, we say \"no\" for implicit parameters.\n    we have [W] ?x::ty, expanding superclasses won't help:\n      - Superclasses can't be implicit parameters\n      - If we have a [G] ?x:ty2, then we'll have another unsolved\n        [D] ty ~ ty2 (from the functional dependency)\n        which will trigger superclass expansion.\n\n    It's a bit of a special case, but it's easy to do.  The runtime cost\n    is low because the unsolved set is usually empty anyway (errors\n    aside), and the first non-imlicit-parameter will terminate the search.\n\n    The special case is worth it (Trac #11480, comment:2) because it\n    applies to CallStack constraints, which aren't type errors. If we have\n       f :: (C a) => blah\n       f x = ...undefined...\n    we'll get a CallStack constraint.  If that's the only unsolved\n    constraint it'll eventually be solved by defaulting.  So we don't\n    want to emit warnings about hitting the simplifier's iteration\n    limit.  A CallStack constraint really isn't an unsolved\n    constraint; it can always be solved by defaulting.\n-}\n\nsingleCt :: Ct -> Cts\nsingleCt = unitBag\n\nandCts :: Cts -> Cts -> Cts\nandCts = unionBags\n\nlistToCts :: [Ct] -> Cts\nlistToCts = listToBag\n\nctsElts :: Cts -> [Ct]\nctsElts = bagToList\n\nconsCts :: Ct -> Cts -> Cts\nconsCts = consBag\n\nsnocCts :: Cts -> Ct -> Cts\nsnocCts = snocBag\n\nextendCtsList :: Cts -> [Ct] -> Cts\nextendCtsList cts xs | null xs   = cts\n                     | otherwise = cts `unionBags` listToBag xs\n\nandManyCts :: [Cts] -> Cts\nandManyCts = unionManyBags\n\nemptyCts :: Cts\nemptyCts = emptyBag\n\nisEmptyCts :: Cts -> Bool\nisEmptyCts = isEmptyBag\n\npprCts :: Cts -> SDoc\npprCts cts = vcat (map ppr (bagToList cts))\n\n{-\n************************************************************************\n*                                                                      *\n                Wanted constraints\n     These are forced to be in TcRnTypes because\n           TcLclEnv mentions WantedConstraints\n           WantedConstraint mentions CtLoc\n           CtLoc mentions ErrCtxt\n           ErrCtxt mentions TcM\n*                                                                      *\nv%************************************************************************\n-}\n\ndata WantedConstraints\n  = WC { wc_simple :: Cts              -- Unsolved constraints, all wanted\n       , wc_impl   :: Bag Implication\n    }\n\nemptyWC :: WantedConstraints\nemptyWC = WC { wc_simple = emptyBag, wc_impl = emptyBag }\n\nmkSimpleWC :: [CtEvidence] -> WantedConstraints\nmkSimpleWC cts\n  = WC { wc_simple = listToBag (map mkNonCanonical cts)\n       , wc_impl = emptyBag }\n\nmkImplicWC :: Bag Implication -> WantedConstraints\nmkImplicWC implic\n  = WC { wc_simple = emptyBag, wc_impl = implic }\n\nisEmptyWC :: WantedConstraints -> Bool\nisEmptyWC (WC { wc_simple = f, wc_impl = i })\n  = isEmptyBag f && isEmptyBag i\n\n\n-- | Checks whether a the given wanted constraints are solved, i.e.\n-- that there are no simple constraints left and all the implications\n-- are solved.\nisSolvedWC :: WantedConstraints -> Bool\nisSolvedWC WC {wc_simple = wc_simple, wc_impl = wc_impl} =\n  isEmptyBag wc_simple && allBag (isSolvedStatus . ic_status) wc_impl\n\nandWC :: WantedConstraints -> WantedConstraints -> WantedConstraints\nandWC (WC { wc_simple = f1, wc_impl = i1 })\n      (WC { wc_simple = f2, wc_impl = i2 })\n  = WC { wc_simple = f1 `unionBags` f2\n       , wc_impl   = i1 `unionBags` i2 }\n\nunionsWC :: [WantedConstraints] -> WantedConstraints\nunionsWC = foldr andWC emptyWC\n\naddSimples :: WantedConstraints -> Bag Ct -> WantedConstraints\naddSimples wc cts\n  = wc { wc_simple = wc_simple wc `unionBags` cts }\n    -- Consider: Put the new constraints at the front, so they get solved first\n\naddImplics :: WantedConstraints -> Bag Implication -> WantedConstraints\naddImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }\n\naddInsols :: WantedConstraints -> Bag Ct -> WantedConstraints\naddInsols wc cts\n  = wc { wc_simple = wc_simple wc `unionBags` cts }\n\ninsolublesOnly :: WantedConstraints -> WantedConstraints\n-- Keep only the definitely-insoluble constraints\ninsolublesOnly (WC { wc_simple = simples, wc_impl = implics })\n  = WC { wc_simple = filterBag insolubleCt simples\n       , wc_impl   = mapBag implic_insols_only implics }\n  where\n    implic_insols_only implic\n      = implic { ic_wanted = insolublesOnly (ic_wanted implic) }\n\nisSolvedStatus :: ImplicStatus -> Bool\nisSolvedStatus (IC_Solved {}) = True\nisSolvedStatus _              = False\n\nisInsolubleStatus :: ImplicStatus -> Bool\nisInsolubleStatus IC_Insoluble    = True\nisInsolubleStatus IC_BadTelescope = True\nisInsolubleStatus _               = False\n\ninsolubleImplic :: Implication -> Bool\ninsolubleImplic ic = isInsolubleStatus (ic_status ic)\n\ninsolubleWC :: WantedConstraints -> Bool\ninsolubleWC (WC { wc_impl = implics, wc_simple = simples })\n  =  anyBag insolubleCt simples\n  || anyBag insolubleImplic implics\n\ninsolubleCt :: Ct -> Bool\n-- Definitely insoluble, in particular /excluding/ type-hole constraints\n-- Namely: a) an equality constraint\n--         b) that is insoluble\n--         c) and does not arise from a Given\ninsolubleCt ct\n  | isHoleCt ct            = isOutOfScopeCt ct  -- See Note [Insoluble holes]\n  | not (insolubleEqCt ct) = False\n  | arisesFromGivens ct    = False              -- See Note [Given insolubles]\n  | otherwise              = True\n\ninsolubleEqCt :: Ct -> Bool\n-- Returns True of /equality/ constraints\n-- that are /definitely/ insoluble\n-- It won't detect some definite errors like\n--       F a ~ T (F a)\n-- where F is a type family, which actually has an occurs check\n--\n-- The function is tuned for application /after/ constraint solving\n--       i.e. assuming canonicalisation has been done\n-- E.g.  It'll reply True  for     a ~ [a]\n--               but False for   [a] ~ a\n-- and\n--                   True for  Int ~ F a Int\n--               but False for  Maybe Int ~ F a Int Int\n--               (where F is an arity-1 type function)\ninsolubleEqCt (CIrredCan { cc_insol = insol }) = insol\ninsolubleEqCt _                                = False\n\ninstance Outputable WantedConstraints where\n  ppr (WC {wc_simple = s, wc_impl = i})\n   = text \"WC\" <+> braces (vcat\n        [ ppr_bag (text \"wc_simple\") s\n        , ppr_bag (text \"wc_impl\") i ])\n\nppr_bag :: Outputable a => SDoc -> Bag a -> SDoc\nppr_bag doc bag\n | isEmptyBag bag = empty\n | otherwise      = hang (doc <+> equals)\n                       2 (foldrBag (($$) . ppr) empty bag)\n\n{- Note [Given insolubles]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #14325, comment:)\n    class (a~b) => C a b\n\n    foo :: C a c => a -> c\n    foo x = x\n\n    hm3 :: C (f b) b => b -> f b\n    hm3 x = foo x\n\nIn the RHS of hm3, from the [G] C (f b) b we get the insoluble\n[G] f b ~# b.  Then we also get an unsolved [W] C b (f b).\nResidual implication looks like\n    forall b. C (f b) b => [G] f b ~# b\n                           [W] C f (f b)\n\nWe do /not/ want to set the implication status to IC_Insoluble,\nbecause that'll suppress reports of [W] C b (f b).  But we\nmay not report the insoluble [G] f b ~# b either (see Note [Given errors]\nin TcErrors), so we may fail to report anything at all!  Yikes.\n\nThe same applies to Derived constraints that /arise from/ Givens.\nE.g.   f :: (C Int [a]) => blah\nwhere a fundep means we get\n       [D] Int ~ [a]\nBy the same reasoning we must not suppress other errors (Trac #15767)\n\nBottom line: insolubleWC (called in TcSimplify.setImplicationStatus)\n             should ignore givens even if they are insoluble.\n\nNote [Insoluble holes]\n~~~~~~~~~~~~~~~~~~~~~~\nHole constraints that ARE NOT treated as truly insoluble:\n  a) type holes, arising from PartialTypeSignatures,\n  b) \"true\" expression holes arising from TypedHoles\n\nAn \"expression hole\" or \"type hole\" constraint isn't really an error\nat all; it's a report saying \"_ :: Int\" here.  But an out-of-scope\nvariable masquerading as expression holes IS treated as truly\ninsoluble, so that it trumps other errors during error reporting.\nYuk!\n\n************************************************************************\n*                                                                      *\n                Implication constraints\n*                                                                      *\n************************************************************************\n-}\n\ndata Implication\n  = Implic {   -- Invariants for a tree of implications:\n               -- see TcType Note [TcLevel and untouchable type variables]\n\n      ic_tclvl :: TcLevel,       -- TcLevel of unification variables\n                                 -- allocated /inside/ this implication\n\n      ic_skols :: [TcTyVar],     -- Introduced skolems\n      ic_info  :: SkolemInfo,    -- See Note [Skolems in an implication]\n                                 -- See Note [Shadowing in a constraint]\n      ic_telescope :: Maybe SDoc,  -- User-written telescope, if there is one\n                                   -- The list of skolems is order-checked\n                                   -- if and only if this is a Just.\n                                   -- See Note [Keeping scoped variables in order: Explicit]\n                                   -- in TcHsType\n\n      ic_given  :: [EvVar],      -- Given evidence variables\n                                 --   (order does not matter)\n                                 -- See Invariant (GivenInv) in TcType\n\n      ic_no_eqs :: Bool,         -- True  <=> ic_givens have no equalities, for sure\n                                 -- False <=> ic_givens might have equalities\n\n      ic_env   :: Env TcGblEnv TcLclEnv,\n                                 -- Records the Env at the time of creation.\n                                 --\n                                 -- This is primarly needed for the enclosed\n                                 -- TcLclEnv, which gives the source location\n                                 -- and error context for the implication, and\n                                 -- hence for all the given evidence variables.\n                                 --\n                                 -- The enclosed DynFlags also influences error\n                                 -- reporting. See Note [Avoid\n                                 -- -Winaccessible-code when deriving] in\n                                 -- TcInstDcls.\n\n      ic_wanted :: WantedConstraints,  -- The wanteds\n                                       -- See Invariang (WantedInf) in TcType\n\n      ic_binds  :: EvBindsVar,    -- Points to the place to fill in the\n                                  -- abstraction and bindings.\n\n      -- The ic_need fields keep track of which Given evidence\n      -- is used by this implication or its children\n      -- NB: including stuff used by nested implications that have since\n      --     been discarded\n      ic_need_inner :: VarSet,    -- Includes all used Given evidence\n      ic_need_outer :: VarSet,    -- Includes only the free Given evidence\n                                  --  i.e. ic_need_inner after deleting\n                                  --       (a) givens (b) binders of ic_binds\n\n      ic_status   :: ImplicStatus\n    }\n\n-- | Create a new 'Implication' with as many sensible defaults for its fields\n-- as possible. Note that the 'ic_tclvl', 'ic_binds', and 'ic_info' fields do\n-- /not/ have sensible defaults, so they are initialized with lazy thunks that\n-- will 'panic' if forced, so one should take care to initialize these fields\n-- after creation.\n--\n-- This is monadic purely to look up the 'Env', which is used to initialize\n-- 'ic_env'.\nnewImplication :: TcM Implication\nnewImplication\n  = do env <- getEnv\n       return (implicationPrototype { ic_env = env })\n\nimplicationPrototype :: Implication\nimplicationPrototype\n   = Implic { -- These fields must be initialised\n              ic_tclvl      = panic \"newImplic:tclvl\"\n            , ic_binds      = panic \"newImplic:binds\"\n            , ic_info       = panic \"newImplic:info\"\n            , ic_env        = panic \"newImplic:env\"\n\n              -- The rest have sensible default values\n            , ic_skols      = []\n            , ic_telescope  = Nothing\n            , ic_given      = []\n            , ic_wanted     = emptyWC\n            , ic_no_eqs     = False\n            , ic_status     = IC_Unsolved\n            , ic_need_inner = emptyVarSet\n            , ic_need_outer = emptyVarSet }\n\n-- | Retrieve the enclosed 'TcLclEnv' from an 'Implication'.\nimplicLclEnv :: Implication -> TcLclEnv\nimplicLclEnv = env_lcl . ic_env\n\n-- | Retrieve the enclosed 'DynFlags' from an 'Implication'.\nimplicDynFlags :: Implication -> DynFlags\nimplicDynFlags = hsc_dflags . env_top . ic_env\n\ndata ImplicStatus\n  = IC_Solved     -- All wanteds in the tree are solved, all the way down\n       { ics_dead :: [EvVar] }  -- Subset of ic_given that are not needed\n         -- See Note [Tracking redundant constraints] in TcSimplify\n\n  | IC_Insoluble  -- At least one insoluble constraint in the tree\n\n  | IC_BadTelescope  -- solved, but the skolems in the telescope are out of\n                     -- dependency order\n\n  | IC_Unsolved   -- Neither of the above; might go either way\n\ninstance Outputable Implication where\n  ppr (Implic { ic_tclvl = tclvl, ic_skols = skols\n              , ic_given = given, ic_no_eqs = no_eqs\n              , ic_wanted = wanted, ic_status = status\n              , ic_binds = binds\n              , ic_need_inner = need_in, ic_need_outer = need_out\n              , ic_info = info })\n   = hang (text \"Implic\" <+> lbrace)\n        2 (sep [ text \"TcLevel =\" <+> ppr tclvl\n               , text \"Skolems =\" <+> pprTyVars skols\n               , text \"No-eqs =\" <+> ppr no_eqs\n               , text \"Status =\" <+> ppr status\n               , hang (text \"Given =\")  2 (pprEvVars given)\n               , hang (text \"Wanted =\") 2 (ppr wanted)\n               , text \"Binds =\" <+> ppr binds\n               , whenPprDebug (text \"Needed inner =\" <+> ppr need_in)\n               , whenPprDebug (text \"Needed outer =\" <+> ppr need_out)\n               , pprSkolInfo info ] <+> rbrace)\n\ninstance Outputable ImplicStatus where\n  ppr IC_Insoluble    = text \"Insoluble\"\n  ppr IC_BadTelescope = text \"Bad telescope\"\n  ppr IC_Unsolved     = text \"Unsolved\"\n  ppr (IC_Solved { ics_dead = dead })\n    = text \"Solved\" <+> (braces (text \"Dead givens =\" <+> ppr dead))\n\n{-\nNote [Needed evidence variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTh ic_need_evs field holds the free vars of ic_binds, and all the\nic_binds in nested implications.\n\n  * Main purpose: if one of the ic_givens is not mentioned in here, it\n    is redundant.\n\n  * solveImplication may drop an implication altogether if it has no\n    remaining 'wanteds'. But we still track the free vars of its\n    evidence binds, even though it has now disappeared.\n\nNote [Shadowing in a constraint]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe assume NO SHADOWING in a constraint.  Specifically\n * The unification variables are all implicitly quantified at top\n   level, and are all unique\n * The skolem variables bound in ic_skols are all freah when the\n   implication is created.\nSo we can safely substitute. For example, if we have\n   forall a.  a~Int => ...(forall b. ...a...)...\nwe can push the (a~Int) constraint inwards in the \"givens\" without\nworrying that 'b' might clash.\n\nNote [Skolems in an implication]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe skolems in an implication are not there to perform a skolem escape\ncheck.  That happens because all the environment variables are in the\nuntouchables, and therefore cannot be unified with anything at all,\nlet alone the skolems.\n\nInstead, ic_skols is used only when considering floating a constraint\noutside the implication in TcSimplify.floatEqualities or\nTcSimplify.approximateImplications\n\nNote [Insoluble constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSome of the errors that we get during canonicalization are best\nreported when all constraints have been simplified as much as\npossible. For instance, assume that during simplification the\nfollowing constraints arise:\n\n [Wanted]   F alpha ~  uf1\n [Wanted]   beta ~ uf1 beta\n\nWhen canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail\nwe will simply see a message:\n    'Can't construct the infinite type  beta ~ uf1 beta'\nand the user has no idea what the uf1 variable is.\n\nInstead our plan is that we will NOT fail immediately, but:\n    (1) Record the \"frozen\" error in the ic_insols field\n    (2) Isolate the offending constraint from the rest of the inerts\n    (3) Keep on simplifying/canonicalizing\n\nAt the end, we will hopefully have substituted uf1 := F alpha, and we\nwill be able to report a more informative error:\n    'Can't construct the infinite type beta ~ F alpha beta'\n\nInsoluble constraints *do* include Derived constraints. For example,\na functional dependency might give rise to [D] Int ~ Bool, and we must\nreport that.  If insolubles did not contain Deriveds, reportErrors would\nnever see it.\n\n\n************************************************************************\n*                                                                      *\n            Pretty printing\n*                                                                      *\n************************************************************************\n-}\n\npprEvVars :: [EvVar] -> SDoc    -- Print with their types\npprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)\n\npprEvVarTheta :: [EvVar] -> SDoc\npprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)\n\npprEvVarWithType :: EvVar -> SDoc\npprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)\n\n\n\n-- | Wraps the given type with the constraints (via ic_given) in the given\n-- implication, according to the variables mentioned (via ic_skols)\n-- in the implication, but taking care to only wrap those variables\n-- that are mentioned in the type or the implication.\nwrapTypeWithImplication :: Type -> Implication -> Type\nwrapTypeWithImplication ty impl = wrapType ty mentioned_skols givens\n    where givens = map idType $ ic_given impl\n          skols = ic_skols impl\n          freeVars = fvVarSet $ tyCoFVsOfTypes (ty:givens)\n          mentioned_skols = filter (`elemVarSet` freeVars) skols\n\nwrapType :: Type -> [TyVar] -> [PredType] -> Type\nwrapType ty skols givens = mkSpecForAllTys skols $ mkPhiTy givens ty\n\n\n{-\n************************************************************************\n*                                                                      *\n            CtEvidence\n*                                                                      *\n************************************************************************\n\nNote [Evidence field of CtEvidence]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDuring constraint solving we never look at the type of ctev_evar/ctev_dest;\ninstead we look at the ctev_pred field.  The evtm/evar field\nmay be un-zonked.\n\nNote [Bind new Givens immediately]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor Givens we make new EvVars and bind them immediately. Two main reasons:\n  * Gain sharing.  E.g. suppose we start with g :: C a b, where\n       class D a => C a b\n       class (E a, F a) => D a\n    If we generate all g's superclasses as separate EvTerms we might\n    get    selD1 (selC1 g) :: E a\n           selD2 (selC1 g) :: F a\n           selC1 g :: D a\n    which we could do more economically as:\n           g1 :: D a = selC1 g\n           g2 :: E a = selD1 g1\n           g3 :: F a = selD2 g1\n\n  * For *coercion* evidence we *must* bind each given:\n      class (a~b) => C a b where ....\n      f :: C a b => ....\n    Then in f's Givens we have g:(C a b) and the superclass sc(g,0):a~b.\n    But that superclass selector can't (yet) appear in a coercion\n    (see evTermCoercion), so the easy thing is to bind it to an Id.\n\nSo a Given has EvVar inside it rather than (as previously) an EvTerm.\n\n-}\n\n-- | A place for type-checking evidence to go after it is generated.\n-- Wanted equalities are always HoleDest; other wanteds are always\n-- EvVarDest.\ndata TcEvDest\n  = EvVarDest EvVar         -- ^ bind this var to the evidence\n              -- EvVarDest is always used for non-type-equalities\n              -- e.g. class constraints\n\n  | HoleDest  CoercionHole  -- ^ fill in this hole with the evidence\n              -- HoleDest is always used for type-equalities\n              -- See Note [Coercion holes] in TyCoRep\n\ndata CtEvidence\n  = CtGiven    -- Truly given, not depending on subgoals\n      { ctev_pred :: TcPredType      -- See Note [Ct/evidence invariant]\n      , ctev_evar :: EvVar           -- See Note [Evidence field of CtEvidence]\n      , ctev_loc  :: CtLoc }\n\n\n  | CtWanted   -- Wanted goal\n      { ctev_pred :: TcPredType     -- See Note [Ct/evidence invariant]\n      , ctev_dest :: TcEvDest\n      , ctev_nosh :: ShadowInfo     -- See Note [Constraint flavours]\n      , ctev_loc  :: CtLoc }\n\n  | CtDerived  -- A goal that we don't really have to solve and can't\n               -- immediately rewrite anything other than a derived\n               -- (there's no evidence!) but if we do manage to solve\n               -- it may help in solving other goals.\n      { ctev_pred :: TcPredType\n      , ctev_loc  :: CtLoc }\n\nctEvPred :: CtEvidence -> TcPredType\n-- The predicate of a flavor\nctEvPred = ctev_pred\n\nctEvLoc :: CtEvidence -> CtLoc\nctEvLoc = ctev_loc\n\nctEvOrigin :: CtEvidence -> CtOrigin\nctEvOrigin = ctLocOrigin . ctEvLoc\n\n-- | Get the equality relation relevant for a 'CtEvidence'\nctEvEqRel :: CtEvidence -> EqRel\nctEvEqRel = predTypeEqRel . ctEvPred\n\n-- | Get the role relevant for a 'CtEvidence'\nctEvRole :: CtEvidence -> Role\nctEvRole = eqRelRole . ctEvEqRel\n\nctEvTerm :: CtEvidence -> EvTerm\nctEvTerm ev = EvExpr (ctEvExpr ev)\n\nctEvExpr :: CtEvidence -> EvExpr\nctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ })\n            = Coercion $ ctEvCoercion ev\nctEvExpr ev = evId (ctEvEvId ev)\n\nctEvCoercion :: HasDebugCallStack => CtEvidence -> Coercion\nctEvCoercion (CtGiven { ctev_evar = ev_id })\n  = mkTcCoVarCo ev_id\nctEvCoercion (CtWanted { ctev_dest = dest })\n  | HoleDest hole <- dest\n  = -- ctEvCoercion is only called on type equalities\n    -- and they always have HoleDests\n    mkHoleCo hole\nctEvCoercion ev\n  = pprPanic \"ctEvCoercion\" (ppr ev)\n\nctEvEvId :: CtEvidence -> EvVar\nctEvEvId (CtWanted { ctev_dest = EvVarDest ev }) = ev\nctEvEvId (CtWanted { ctev_dest = HoleDest h })   = coHoleCoVar h\nctEvEvId (CtGiven  { ctev_evar = ev })           = ev\nctEvEvId ctev@(CtDerived {}) = pprPanic \"ctEvId:\" (ppr ctev)\n\ninstance Outputable TcEvDest where\n  ppr (HoleDest h)   = text \"hole\" <> ppr h\n  ppr (EvVarDest ev) = ppr ev\n\ninstance Outputable CtEvidence where\n  ppr ev = ppr (ctEvFlavour ev)\n           <+> pp_ev\n           <+> braces (ppr (ctl_depth (ctEvLoc ev))) <> dcolon\n                  -- Show the sub-goal depth too\n           <+> ppr (ctEvPred ev)\n    where\n      pp_ev = case ev of\n             CtGiven { ctev_evar = v } -> ppr v\n             CtWanted {ctev_dest = d } -> ppr d\n             CtDerived {}              -> text \"_\"\n\nisWanted :: CtEvidence -> Bool\nisWanted (CtWanted {}) = True\nisWanted _ = False\n\nisGiven :: CtEvidence -> Bool\nisGiven (CtGiven {})  = True\nisGiven _ = False\n\nisDerived :: CtEvidence -> Bool\nisDerived (CtDerived {}) = True\nisDerived _              = False\n\n{-\n%************************************************************************\n%*                                                                      *\n            CtFlavour\n%*                                                                      *\n%************************************************************************\n\nNote [Constraint flavours]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConstraints come in four flavours:\n\n* [G] Given: we have evidence\n\n* [W] Wanted WOnly: we want evidence\n\n* [D] Derived: any solution must satisfy this constraint, but\n      we don't need evidence for it.  Examples include:\n        - superclasses of [W] class constraints\n        - equalities arising from functional dependencies\n          or injectivity\n\n* [WD] Wanted WDeriv: a single constraint that represents\n                      both [W] and [D]\n  We keep them paired as one both for efficiency, and because\n  when we have a finite map  F tys -> CFunEqCan, it's inconvenient\n  to have two CFunEqCans in the range\n\nThe ctev_nosh field of a Wanted distinguishes between [W] and [WD]\n\nWanted constraints are born as [WD], but are split into [W] and its\n\"shadow\" [D] in TcSMonad.maybeEmitShadow.\n\nSee Note [The improvement story and derived shadows] in TcSMonad\n-}\n\ndata CtFlavour  -- See Note [Constraint flavours]\n  = Given\n  | Wanted ShadowInfo\n  | Derived\n  deriving Eq\n\ndata ShadowInfo\n  = WDeriv   -- [WD] This Wanted constraint has no Derived shadow,\n             -- so it behaves like a pair of a Wanted and a Derived\n  | WOnly    -- [W] It has a separate derived shadow\n             -- See Note [Derived shadows]\n  deriving( Eq )\n\nisGivenOrWDeriv :: CtFlavour -> Bool\nisGivenOrWDeriv Given           = True\nisGivenOrWDeriv (Wanted WDeriv) = True\nisGivenOrWDeriv _               = False\n\ninstance Outputable CtFlavour where\n  ppr Given           = text \"[G]\"\n  ppr (Wanted WDeriv) = text \"[WD]\"\n  ppr (Wanted WOnly)  = text \"[W]\"\n  ppr Derived         = text \"[D]\"\n\nctEvFlavour :: CtEvidence -> CtFlavour\nctEvFlavour (CtWanted { ctev_nosh = nosh }) = Wanted nosh\nctEvFlavour (CtGiven {})                    = Given\nctEvFlavour (CtDerived {})                  = Derived\n\n-- | Whether or not one 'Ct' can rewrite another is determined by its\n-- flavour and its equality relation. See also\n-- Note [Flavours with roles] in TcSMonad\ntype CtFlavourRole = (CtFlavour, EqRel)\n\n-- | Extract the flavour, role, and boxity from a 'CtEvidence'\nctEvFlavourRole :: CtEvidence -> CtFlavourRole\nctEvFlavourRole ev = (ctEvFlavour ev, ctEvEqRel ev)\n\n-- | Extract the flavour and role from a 'Ct'\nctFlavourRole :: Ct -> CtFlavourRole\n-- Uses short-cuts to role for special cases\nctFlavourRole (CDictCan { cc_ev = ev })\n  = (ctEvFlavour ev, NomEq)\nctFlavourRole (CTyEqCan { cc_ev = ev, cc_eq_rel = eq_rel })\n  = (ctEvFlavour ev, eq_rel)\nctFlavourRole (CFunEqCan { cc_ev = ev })\n  = (ctEvFlavour ev, NomEq)\nctFlavourRole (CHoleCan { cc_ev = ev })\n  = (ctEvFlavour ev, NomEq)  -- NomEq: CHoleCans can be rewritten by\n                             -- by nominal equalities but empahatically\n                             -- not by representational equalities\nctFlavourRole ct\n  = ctEvFlavourRole (ctEvidence ct)\n\n{- Note [eqCanRewrite]\n~~~~~~~~~~~~~~~~~~~~~~\n(eqCanRewrite ct1 ct2) holds if the constraint ct1 (a CTyEqCan of form\ntv ~ ty) can be used to rewrite ct2.  It must satisfy the properties of\na can-rewrite relation, see Definition [Can-rewrite relation] in\nTcSMonad.\n\nWith the solver handling Coercible constraints like equality constraints,\nthe rewrite conditions must take role into account, never allowing\na representational equality to rewrite a nominal one.\n\nNote [Wanteds do not rewrite Wanteds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't allow Wanteds to rewrite Wanteds, because that can give rise\nto very confusing type error messages.  A good example is Trac #8450.\nHere's another\n   f :: a -> Bool\n   f x = ( [x,'c'], [x,True] ) `seq` True\nHere we get\n  [W] a ~ Char\n  [W] a ~ Bool\nbut we do not want to complain about Bool ~ Char!\n\nNote [Deriveds do rewrite Deriveds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHowever we DO allow Deriveds to rewrite Deriveds, because that's how\nimprovement works; see Note [The improvement story] in TcInteract.\n\nHowever, for now at least I'm only letting (Derived,NomEq) rewrite\n(Derived,NomEq) and not doing anything for ReprEq.  If we have\n    eqCanRewriteFR (Derived, NomEq) (Derived, _)  = True\nthen we lose property R2 of Definition [Can-rewrite relation]\nin TcSMonad\n  R2.  If f1 >= f, and f2 >= f,\n       then either f1 >= f2 or f2 >= f1\nConsider f1 = (Given, ReprEq)\n         f2 = (Derived, NomEq)\n          f = (Derived, ReprEq)\n\nI thought maybe we could never get Derived ReprEq constraints, but\nwe can; straight from the Wanteds during improvement. And from a Derived\nReprEq we could conceivably get a Derived NomEq improvement (by decomposing\na type constructor with Nomninal role), and hence unify.\n-}\n\neqCanRewrite :: EqRel -> EqRel -> Bool\neqCanRewrite NomEq  _      = True\neqCanRewrite ReprEq ReprEq = True\neqCanRewrite ReprEq NomEq  = False\n\neqCanRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool\n-- Can fr1 actually rewrite fr2?\n-- Very important function!\n-- See Note [eqCanRewrite]\n-- See Note [Wanteds do not rewrite Wanteds]\n-- See Note [Deriveds do rewrite Deriveds]\neqCanRewriteFR (Given,         r1)    (_,       r2)    = eqCanRewrite r1 r2\neqCanRewriteFR (Wanted WDeriv, NomEq) (Derived, NomEq) = True\neqCanRewriteFR (Derived,       NomEq) (Derived, NomEq) = True\neqCanRewriteFR _                      _                = False\n\neqMayRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool\n-- Is it /possible/ that fr1 can rewrite fr2?\n-- This is used when deciding which inerts to kick out,\n-- at which time a [WD] inert may be split into [W] and [D]\neqMayRewriteFR (Wanted WDeriv, NomEq) (Wanted WDeriv, NomEq) = True\neqMayRewriteFR (Derived,       NomEq) (Wanted WDeriv, NomEq) = True\neqMayRewriteFR fr1 fr2 = eqCanRewriteFR fr1 fr2\n\n-----------------\n{- Note [funEqCanDischarge]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have two CFunEqCans with the same LHS:\n    (x1:F ts ~ f1) `funEqCanDischarge` (x2:F ts ~ f2)\nCan we drop x2 in favour of x1, either unifying\nf2 (if it's a flatten meta-var) or adding a new Given\n(f1 ~ f2), if x2 is a Given?\n\nAnswer: yes if funEqCanDischarge is true.\n-}\n\nfunEqCanDischarge\n  :: CtEvidence -> CtEvidence\n  -> ( SwapFlag   -- NotSwapped => lhs can discharge rhs\n                  -- Swapped    => rhs can discharge lhs\n     , Bool)      -- True <=> upgrade non-discharded one\n                  --          from [W] to [WD]\n-- See Note [funEqCanDischarge]\nfunEqCanDischarge ev1 ev2\n  = ASSERT2( ctEvEqRel ev1 == NomEq, ppr ev1 )\n    ASSERT2( ctEvEqRel ev2 == NomEq, ppr ev2 )\n    -- CFunEqCans are all Nominal, hence asserts\n    funEqCanDischargeF (ctEvFlavour ev1) (ctEvFlavour ev2)\n\nfunEqCanDischargeF :: CtFlavour -> CtFlavour -> (SwapFlag, Bool)\nfunEqCanDischargeF Given           _               = (NotSwapped, False)\nfunEqCanDischargeF _               Given           = (IsSwapped,  False)\nfunEqCanDischargeF (Wanted WDeriv) _               = (NotSwapped, False)\nfunEqCanDischargeF _               (Wanted WDeriv) = (IsSwapped,  True)\nfunEqCanDischargeF (Wanted WOnly)  (Wanted WOnly)  = (NotSwapped, False)\nfunEqCanDischargeF (Wanted WOnly)  Derived         = (NotSwapped, True)\nfunEqCanDischargeF Derived         (Wanted WOnly)  = (IsSwapped,  True)\nfunEqCanDischargeF Derived         Derived         = (NotSwapped, False)\n\n\n{- Note [eqCanDischarge]\n~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have two identical CTyEqCan equality constraints\n(i.e. both LHS and RHS are the same)\n      (x1:a~t) `eqCanDischarge` (xs:a~t)\nCan we just drop x2 in favour of x1?\n\nAnswer: yes if eqCanDischarge is true.\n\nNote that we do /not/ allow Wanted to discharge Derived.\nWe must keep both.  Why?  Because the Derived may rewrite\nother Deriveds in the model whereas the Wanted cannot.\n\nHowever a Wanted can certainly discharge an identical Wanted.  So\neqCanDischarge does /not/ define a can-rewrite relation in the\nsense of Definition [Can-rewrite relation] in TcSMonad.\n\nWe /do/ say that a [W] can discharge a [WD].  In evidence terms it\ncertainly can, and the /caller/ arranges that the otherwise-lost [D]\nis spat out as a new Derived.  -}\n\neqCanDischargeFR :: CtFlavourRole -> CtFlavourRole -> Bool\n-- See Note [eqCanDischarge]\neqCanDischargeFR (f1,r1) (f2, r2) =  eqCanRewrite r1 r2\n                                  && eqCanDischargeF f1 f2\n\neqCanDischargeF :: CtFlavour -> CtFlavour -> Bool\neqCanDischargeF Given   _                  = True\neqCanDischargeF (Wanted _)      (Wanted _) = True\neqCanDischargeF (Wanted WDeriv) Derived    = True\neqCanDischargeF Derived         Derived    = True\neqCanDischargeF _               _          = False\n\n\n{-\n************************************************************************\n*                                                                      *\n            SubGoalDepth\n*                                                                      *\n************************************************************************\n\nNote [SubGoalDepth]\n~~~~~~~~~~~~~~~~~~~\nThe 'SubGoalDepth' takes care of stopping the constraint solver from looping.\n\nThe counter starts at zero and increases. It includes dictionary constraints,\nequality simplification, and type family reduction. (Why combine these? Because\nit's actually quite easy to mistake one for another, in sufficiently involved\nscenarios, like ConstraintKinds.)\n\nThe flag -fcontext-stack=n (not very well named!) fixes the maximium\nlevel.\n\n* The counter includes the depth of type class instance declarations.  Example:\n     [W] d{7} : Eq [Int]\n  That is d's dictionary-constraint depth is 7.  If we use the instance\n     $dfEqList :: Eq a => Eq [a]\n  to simplify it, we get\n     d{7} = $dfEqList d'{8}\n  where d'{8} : Eq Int, and d' has depth 8.\n\n  For civilised (decidable) instance declarations, each increase of\n  depth removes a type constructor from the type, so the depth never\n  gets big; i.e. is bounded by the structural depth of the type.\n\n* The counter also increments when resolving\nequalities involving type functions. Example:\n  Assume we have a wanted at depth 7:\n    [W] d{7} : F () ~ a\n  If there is a type function equation \"F () = Int\", this would be rewritten to\n    [W] d{8} : Int ~ a\n  and remembered as having depth 8.\n\n  Again, without UndecidableInstances, this counter is bounded, but without it\n  can resolve things ad infinitum. Hence there is a maximum level.\n\n* Lastly, every time an equality is rewritten, the counter increases. Again,\n  rewriting an equality constraint normally makes progress, but it's possible\n  the \"progress\" is just the reduction of an infinitely-reducing type family.\n  Hence we need to track the rewrites.\n\nWhen compiling a program requires a greater depth, then GHC recommends turning\noff this check entirely by setting -freduction-depth=0. This is because the\nexact number that works is highly variable, and is likely to change even between\nminor releases. Because this check is solely to prevent infinite compilation\ntimes, it seems safe to disable it when a user has ascertained that their program\ndoesn't loop at the type level.\n\n-}\n\n-- | See Note [SubGoalDepth]\nnewtype SubGoalDepth = SubGoalDepth Int\n  deriving (Eq, Ord, Outputable)\n\ninitialSubGoalDepth :: SubGoalDepth\ninitialSubGoalDepth = SubGoalDepth 0\n\nbumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth\nbumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)\n\nmaxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth\nmaxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)\n\nsubGoalDepthExceeded :: DynFlags -> SubGoalDepth -> Bool\nsubGoalDepthExceeded dflags (SubGoalDepth d)\n  = mkIntWithInf d > reductionDepth dflags\n\n{-\n************************************************************************\n*                                                                      *\n            CtLoc\n*                                                                      *\n************************************************************************\n\nThe 'CtLoc' gives information about where a constraint came from.\nThis is important for decent error message reporting because\ndictionaries don't appear in the original source code.\ntype will evolve...\n\n-}\n\ndata CtLoc = CtLoc { ctl_origin :: CtOrigin\n                   , ctl_env    :: TcLclEnv\n                   , ctl_t_or_k :: Maybe TypeOrKind  -- OK if we're not sure\n                   , ctl_depth  :: !SubGoalDepth }\n\n  -- The TcLclEnv includes particularly\n  --    source location:  tcl_loc   :: RealSrcSpan\n  --    context:          tcl_ctxt  :: [ErrCtxt]\n  --    binder stack:     tcl_bndrs :: TcBinderStack\n  --    level:            tcl_tclvl :: TcLevel\n\nmkKindLoc :: TcType -> TcType   -- original *types* being compared\n          -> CtLoc -> CtLoc\nmkKindLoc s1 s2 loc = setCtLocOrigin (toKindLoc loc)\n                        (KindEqOrigin s1 (Just s2) (ctLocOrigin loc)\n                                      (ctLocTypeOrKind_maybe loc))\n\n-- | Take a CtLoc and moves it to the kind level\ntoKindLoc :: CtLoc -> CtLoc\ntoKindLoc loc = loc { ctl_t_or_k = Just KindLevel }\n\nmkGivenLoc :: TcLevel -> SkolemInfo -> TcLclEnv -> CtLoc\nmkGivenLoc tclvl skol_info env\n  = CtLoc { ctl_origin = GivenOrigin skol_info\n          , ctl_env    = env { tcl_tclvl = tclvl }\n          , ctl_t_or_k = Nothing    -- this only matters for error msgs\n          , ctl_depth  = initialSubGoalDepth }\n\nctLocEnv :: CtLoc -> TcLclEnv\nctLocEnv = ctl_env\n\nctLocLevel :: CtLoc -> TcLevel\nctLocLevel loc = tcl_tclvl (ctLocEnv loc)\n\nctLocDepth :: CtLoc -> SubGoalDepth\nctLocDepth = ctl_depth\n\nctLocOrigin :: CtLoc -> CtOrigin\nctLocOrigin = ctl_origin\n\nctLocSpan :: CtLoc -> RealSrcSpan\nctLocSpan (CtLoc { ctl_env = lcl}) = tcl_loc lcl\n\nctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind\nctLocTypeOrKind_maybe = ctl_t_or_k\n\nsetCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc\nsetCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (lcl { tcl_loc = loc })\n\nbumpCtLocDepth :: CtLoc -> CtLoc\nbumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }\n\nsetCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc\nsetCtLocOrigin ctl orig = ctl { ctl_origin = orig }\n\nupdateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc\nupdateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd\n  = ctl { ctl_origin = upd orig }\n\nsetCtLocEnv :: CtLoc -> TcLclEnv -> CtLoc\nsetCtLocEnv ctl env = ctl { ctl_env = env }\n\npushErrCtxt :: CtOrigin -> ErrCtxt -> CtLoc -> CtLoc\npushErrCtxt o err loc@(CtLoc { ctl_env = lcl })\n  = loc { ctl_origin = o, ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }\n\npushErrCtxtSameOrigin :: ErrCtxt -> CtLoc -> CtLoc\n-- Just add information w/o updating the origin!\npushErrCtxtSameOrigin err loc@(CtLoc { ctl_env = lcl })\n  = loc { ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }\n\n{-\n************************************************************************\n*                                                                      *\n                SkolemInfo\n*                                                                      *\n************************************************************************\n-}\n\n-- SkolemInfo gives the origin of *given* constraints\n--   a) type variables are skolemised\n--   b) an implication constraint is generated\ndata SkolemInfo\n  = SigSkol -- A skolem that is created by instantiating\n            -- a programmer-supplied type signature\n            -- Location of the binding site is on the TyVar\n            -- See Note [SigSkol SkolemInfo]\n       UserTypeCtxt        -- What sort of signature\n       TcType              -- Original type signature (before skolemisation)\n       [(Name,TcTyVar)]    -- Maps the original name of the skolemised tyvar\n                           -- to its instantiated version\n\n  | SigTypeSkol UserTypeCtxt\n                 -- like SigSkol, but when we're kind-checking the *type*\n                 -- hence, we have less info\n\n  | ForAllSkol SDoc     -- Bound by a user-written \"forall\".\n\n  | DerivSkol Type      -- Bound by a 'deriving' clause;\n                        -- the type is the instance we are trying to derive\n\n  | InstSkol            -- Bound at an instance decl\n  | InstSC TypeSize     -- A \"given\" constraint obtained by superclass selection.\n                        -- If (C ty1 .. tyn) is the largest class from\n                        --    which we made a superclass selection in the chain,\n                        --    then TypeSize = sizeTypes [ty1, .., tyn]\n                        -- See Note [Solving superclass constraints] in TcInstDcls\n\n  | FamInstSkol         -- Bound at a family instance decl\n  | PatSkol             -- An existential type variable bound by a pattern for\n      ConLike           -- a data constructor with an existential type.\n      (HsMatchContext Name)\n             -- e.g.   data T = forall a. Eq a => MkT a\n             --        f (MkT x) = ...\n             -- The pattern MkT x will allocate an existential type\n             -- variable for 'a'.\n\n  | ArrowSkol           -- An arrow form (see TcArrows)\n\n  | IPSkol [HsIPName]   -- Binding site of an implicit parameter\n\n  | RuleSkol RuleName   -- The LHS of a RULE\n\n  | InferSkol [(Name,TcType)]\n                        -- We have inferred a type for these (mutually-recursivive)\n                        -- polymorphic Ids, and are now checking that their RHS\n                        -- constraints are satisfied.\n\n  | BracketSkol         -- Template Haskell bracket\n\n  | UnifyForAllSkol     -- We are unifying two for-all types\n       TcType           -- The instantiated type *inside* the forall\n\n  | TyConSkol TyConFlavour Name  -- bound in a type declaration of the given flavour\n\n  | DataConSkol Name    -- bound as an existential in a Haskell98 datacon decl or\n                        -- as any variable in a GADT datacon decl\n\n  | ReifySkol           -- Bound during Template Haskell reification\n\n  | QuantCtxtSkol       -- Quantified context, e.g.\n                        --   f :: forall c. (forall a. c a => c [a]) => blah\n\n  | UnkSkol             -- Unhelpful info (until I improve it)\n\ninstance Outputable SkolemInfo where\n  ppr = pprSkolInfo\n\npprSkolInfo :: SkolemInfo -> SDoc\n-- Complete the sentence \"is a rigid type variable bound by...\"\npprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty\npprSkolInfo (SigTypeSkol cx)  = pprUserTypeCtxt cx\npprSkolInfo (ForAllSkol doc)  = quotes doc\npprSkolInfo (IPSkol ips)      = text \"the implicit-parameter binding\" <> plural ips <+> text \"for\"\n                                 <+> pprWithCommas ppr ips\npprSkolInfo (DerivSkol pred)  = text \"the deriving clause for\" <+> quotes (ppr pred)\npprSkolInfo InstSkol          = text \"the instance declaration\"\npprSkolInfo (InstSC n)        = text \"the instance declaration\" <> whenPprDebug (parens (ppr n))\npprSkolInfo FamInstSkol       = text \"a family instance declaration\"\npprSkolInfo BracketSkol       = text \"a Template Haskell bracket\"\npprSkolInfo (RuleSkol name)   = text \"the RULE\" <+> pprRuleName name\npprSkolInfo ArrowSkol         = text \"an arrow form\"\npprSkolInfo (PatSkol cl mc)   = sep [ pprPatSkolInfo cl\n                                    , text \"in\" <+> pprMatchContext mc ]\npprSkolInfo (InferSkol ids)   = hang (text \"the inferred type\" <> plural ids <+> text \"of\")\n                                   2 (vcat [ ppr name <+> dcolon <+> ppr ty\n                                                   | (name,ty) <- ids ])\npprSkolInfo (UnifyForAllSkol ty) = text \"the type\" <+> ppr ty\npprSkolInfo (TyConSkol flav name) = text \"the\" <+> ppr flav <+> text \"declaration for\" <+> quotes (ppr name)\npprSkolInfo (DataConSkol name)= text \"the data constructor\" <+> quotes (ppr name)\npprSkolInfo ReifySkol         = text \"the type being reified\"\n\npprSkolInfo (QuantCtxtSkol {}) = text \"a quantified context\"\n\n-- UnkSkol\n-- For type variables the others are dealt with by pprSkolTvBinding.\n-- For Insts, these cases should not happen\npprSkolInfo UnkSkol = WARN( True, text \"pprSkolInfo: UnkSkol\" ) text \"UnkSkol\"\n\npprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc\n-- The type is already tidied\npprSigSkolInfo ctxt ty\n  = case ctxt of\n       FunSigCtxt f _ -> vcat [ text \"the type signature for:\"\n                              , nest 2 (pprPrefixOcc f <+> dcolon <+> ppr ty) ]\n       PatSynCtxt {}  -> pprUserTypeCtxt ctxt  -- See Note [Skolem info for pattern synonyms]\n       _              -> vcat [ pprUserTypeCtxt ctxt <> colon\n                              , nest 2 (ppr ty) ]\n\npprPatSkolInfo :: ConLike -> SDoc\npprPatSkolInfo (RealDataCon dc)\n  = sep [ text \"a pattern with constructor:\"\n        , nest 2 $ ppr dc <+> dcolon\n          <+> pprType (dataConUserType dc) <> comma ]\n          -- pprType prints forall's regardless of -fprint-explicit-foralls\n          -- which is what we want here, since we might be saying\n          -- type variable 't' is bound by ...\n\npprPatSkolInfo (PatSynCon ps)\n  = sep [ text \"a pattern with pattern synonym:\"\n        , nest 2 $ ppr ps <+> dcolon\n                   <+> pprPatSynType ps <> comma ]\n\n{- Note [Skolem info for pattern synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor pattern synonym SkolemInfo we have\n   SigSkol (PatSynCtxt p) ty _\nbut the type 'ty' is not very helpful.  The full pattern-synonym type\nhas the provided and required pieces, which it is inconvenient to\nrecord and display here. So we simply don't display the type at all,\ncontenting outselves with just the name of the pattern synonym, which\nis fine.  We could do more, but it doesn't seem worth it.\n\nNote [SigSkol SkolemInfo]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we (deeply) skolemise a type\n   f :: forall a. a -> forall b. b -> a\nThen we'll instantiate [a :-> a', b :-> b'], and with the instantiated\n      a' -> b' -> a.\nBut when, in an error message, we report that \"b is a rigid type\nvariable bound by the type signature for f\", we want to show the foralls\nin the right place.  So we proceed as follows:\n\n* In SigSkol we record\n    - the original signature forall a. a -> forall b. b -> a\n    - the instantiation mapping [a :-> a', b :-> b']\n\n* Then when tidying in TcMType.tidySkolemInfo, we first tidy a' to\n  whatever it tidies to, say a''; and then we walk over the type\n  replacing the binder a by the tidied version a'', to give\n       forall a''. a'' -> forall b''. b'' -> a''\n  We need to do this under function arrows, to match what deeplySkolemise\n  does.\n\n* Typically a'' will have a nice pretty name like \"a\", but the point is\n  that the foral-bound variables of the signature we report line up with\n  the instantiated skolems lying  around in other types.\n\n\n************************************************************************\n*                                                                      *\n            CtOrigin\n*                                                                      *\n************************************************************************\n-}\n\ndata CtOrigin\n  = GivenOrigin SkolemInfo\n\n  -- All the others are for *wanted* constraints\n  | OccurrenceOf Name              -- Occurrence of an overloaded identifier\n  | OccurrenceOfRecSel RdrName     -- Occurrence of a record selector\n  | AppOrigin                      -- An application of some kind\n\n  | SpecPragOrigin UserTypeCtxt    -- Specialisation pragma for\n                                   -- function or instance\n\n  | TypeEqOrigin { uo_actual   :: TcType\n                 , uo_expected :: TcType\n                 , uo_thing    :: Maybe SDoc\n                       -- ^ The thing that has type \"actual\"\n                 , uo_visible  :: Bool\n                       -- ^ Is at least one of the three elements above visible?\n                       -- (Errors from the polymorphic subsumption check are considered\n                       -- visible.) Only used for prioritizing error messages.\n                 }\n\n  | KindEqOrigin  -- See Note [Equalities with incompatible kinds] in TcCanonical.\n      TcType (Maybe TcType)     -- A kind equality arising from unifying these two types\n      CtOrigin                  -- originally arising from this\n      (Maybe TypeOrKind)        -- the level of the eq this arises from\n\n  | IPOccOrigin  HsIPName       -- Occurrence of an implicit parameter\n  | OverLabelOrigin FastString  -- Occurrence of an overloaded label\n\n  | LiteralOrigin (HsOverLit GhcRn)     -- Occurrence of a literal\n  | NegateOrigin                        -- Occurrence of syntactic negation\n\n  | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc\n  | AssocFamPatOrigin   -- When matching the patterns of an associated\n                        -- family instance with that of its parent class\n  | SectionOrigin\n  | TupleOrigin         -- (..,..)\n  | ExprSigOrigin       -- e :: ty\n  | PatSigOrigin        -- p :: ty\n  | PatOrigin           -- Instantiating a polytyped pattern at a constructor\n  | ProvCtxtOrigin      -- The \"provided\" context of a pattern synonym signature\n        (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in\n                                 -- particular the name and the right-hand side\n  | RecordUpdOrigin\n  | ViewPatOrigin\n\n  | ScOrigin TypeSize   -- Typechecking superclasses of an instance declaration\n                        -- If the instance head is C ty1 .. tyn\n                        --    then TypeSize = sizeTypes [ty1, .., tyn]\n                        -- See Note [Solving superclass constraints] in TcInstDcls\n\n  | DerivClauseOrigin   -- Typechecking a deriving clause (as opposed to\n                        -- standalone deriving).\n  | DerivOriginDC DataCon Int Bool\n      -- Checking constraints arising from this data con and field index. The\n      -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if\n      -- standalong deriving (with a wildcard constraint) is being used. This\n      -- is used to inform error messages on how to recommended fixes (e.g., if\n      -- the argument is True, then don't recommend \"use standalone deriving\",\n      -- but rather \"fill in the wildcard constraint yourself\").\n      -- See Note [Inferring the instance context] in TcDerivInfer\n  | DerivOriginCoerce Id Type Type Bool\n                        -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from\n                        -- `ty1` to `ty2`.\n  | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for\n                          -- constraints coming from a wildcard constraint,\n                          -- e.g., deriving instance _ => Eq (Foo a)\n                          -- See Note [Inferring the instance context]\n                          -- in TcDerivInfer\n  | DefaultOrigin       -- Typechecking a default decl\n  | DoOrigin            -- Arising from a do expression\n  | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in\n                             -- a do expression\n  | MCompOrigin         -- Arising from a monad comprehension\n  | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a\n                                -- monad comprehension\n  | IfOrigin            -- Arising from an if statement\n  | ProcOrigin          -- Arising from a proc expression\n  | AnnOrigin           -- An annotation\n\n  | FunDepOrigin1       -- A functional dependency from combining\n        PredType CtLoc      -- This constraint arising from ...\n        PredType CtLoc      -- and this constraint arising from ...\n\n  | FunDepOrigin2       -- A functional dependency from combining\n        PredType CtOrigin   -- This constraint arising from ...\n        PredType SrcSpan    -- and this top-level instance\n        -- We only need a CtOrigin on the first, because the location\n        -- is pinned on the entire error message\n\n  | HoleOrigin\n  | UnboundOccurrenceOf OccName\n  | ListOrigin          -- An overloaded list\n  | StaticOrigin        -- A static form\n  | FailablePattern (LPat GhcTcId) -- A failable pattern in do-notation for the\n                                   -- MonadFail Proposal (MFP). Obsolete when\n                                   -- actual desugaring to MonadFail.fail is\n                                   -- live.\n  | Shouldn'tHappenOrigin String\n                            -- the user should never see this one,\n                            -- unless ImpredicativeTypes is on, where all\n                            -- bets are off\n  | InstProvidedOrigin Module ClsInst\n        -- Skolem variable arose when we were testing if an instance\n        -- is solvable or not.\n\n-- | Flag to see whether we're type-checking terms or kind-checking types\ndata TypeOrKind = TypeLevel | KindLevel\n  deriving Eq\n\ninstance Outputable TypeOrKind where\n  ppr TypeLevel = text \"TypeLevel\"\n  ppr KindLevel = text \"KindLevel\"\n\nisTypeLevel :: TypeOrKind -> Bool\nisTypeLevel TypeLevel = True\nisTypeLevel KindLevel = False\n\nisKindLevel :: TypeOrKind -> Bool\nisKindLevel TypeLevel = False\nisKindLevel KindLevel = True\n\n-- An origin is visible if the place where the constraint arises is manifest\n-- in user code. Currently, all origins are visible except for invisible\n-- TypeEqOrigins. This is used when choosing which error of\n-- several to report\nisVisibleOrigin :: CtOrigin -> Bool\nisVisibleOrigin (TypeEqOrigin { uo_visible = vis }) = vis\nisVisibleOrigin (KindEqOrigin _ _ sub_orig _)       = isVisibleOrigin sub_orig\nisVisibleOrigin _                                   = True\n\n-- Converts a visible origin to an invisible one, if possible. Currently,\n-- this works only for TypeEqOrigin\ntoInvisibleOrigin :: CtOrigin -> CtOrigin\ntoInvisibleOrigin orig@(TypeEqOrigin {}) = orig { uo_visible = False }\ntoInvisibleOrigin orig                   = orig\n\ninstance Outputable CtOrigin where\n  ppr = pprCtOrigin\n\nctoHerald :: SDoc\nctoHerald = text \"arising from\"\n\n-- | Extract a suitable CtOrigin from a HsExpr\nlexprCtOrigin :: LHsExpr GhcRn -> CtOrigin\nlexprCtOrigin (L _ e) = exprCtOrigin e\n\nexprCtOrigin :: HsExpr GhcRn -> CtOrigin\nexprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name\nexprCtOrigin (HsUnboundVar _ uv)  = UnboundOccurrenceOf (unboundVarOcc uv)\nexprCtOrigin (HsConLikeOut {})    = panic \"exprCtOrigin HsConLikeOut\"\nexprCtOrigin (HsRecFld _ f)    = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)\nexprCtOrigin (HsOverLabel _ _ l)  = OverLabelOrigin l\nexprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip\nexprCtOrigin (HsOverLit _ lit)    = LiteralOrigin lit\nexprCtOrigin (HsLit {})           = Shouldn'tHappenOrigin \"concrete literal\"\nexprCtOrigin (HsLam _ matches)    = matchesCtOrigin matches\nexprCtOrigin (HsLamCase _ ms)     = matchesCtOrigin ms\nexprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1\nexprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1\nexprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op\nexprCtOrigin (NegApp _ e _)       = lexprCtOrigin e\nexprCtOrigin (HsPar _ e)          = lexprCtOrigin e\nexprCtOrigin (SectionL _ _ _)     = SectionOrigin\nexprCtOrigin (SectionR _ _ _)     = SectionOrigin\nexprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin \"explicit tuple\"\nexprCtOrigin ExplicitSum{}        = Shouldn'tHappenOrigin \"explicit sum\"\nexprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches\nexprCtOrigin (HsIf _ (Just syn) _ _ _) = exprCtOrigin (syn_expr syn)\nexprCtOrigin (HsIf {})           = Shouldn'tHappenOrigin \"if expression\"\nexprCtOrigin (HsMultiIf _ rhs)   = lGRHSCtOrigin rhs\nexprCtOrigin (HsLet _ _ e)       = lexprCtOrigin e\nexprCtOrigin (HsDo {})           = DoOrigin\nexprCtOrigin (ExplicitList {})   = Shouldn'tHappenOrigin \"list\"\nexprCtOrigin (RecordCon {})      = Shouldn'tHappenOrigin \"record construction\"\nexprCtOrigin (RecordUpd {})      = Shouldn'tHappenOrigin \"record update\"\nexprCtOrigin (ExprWithTySig {})  = ExprSigOrigin\nexprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin \"arithmetic sequence\"\nexprCtOrigin (HsSCC _ _ _ e)     = lexprCtOrigin e\nexprCtOrigin (HsCoreAnn _ _ _ e) = lexprCtOrigin e\nexprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin \"TH bracket\"\nexprCtOrigin (HsRnBracketOut {})= Shouldn'tHappenOrigin \"HsRnBracketOut\"\nexprCtOrigin (HsTcBracketOut {})= panic \"exprCtOrigin HsTcBracketOut\"\nexprCtOrigin (HsSpliceE {})      = Shouldn'tHappenOrigin \"TH splice\"\nexprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin \"proc\"\nexprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin \"static expression\"\nexprCtOrigin (HsTick _ _ e)           = lexprCtOrigin e\nexprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e\nexprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e\nexprCtOrigin (EWildPat {})      = panic \"exprCtOrigin EWildPat\"\nexprCtOrigin (EAsPat {})        = panic \"exprCtOrigin EAsPat\"\nexprCtOrigin (EViewPat {})      = panic \"exprCtOrigin EViewPat\"\nexprCtOrigin (ELazyPat {})      = panic \"exprCtOrigin ELazyPat\"\nexprCtOrigin (HsWrap {})        = panic \"exprCtOrigin HsWrap\"\nexprCtOrigin (XExpr {})         = panic \"exprCtOrigin XExpr\"\n\n-- | Extract a suitable CtOrigin from a MatchGroup\nmatchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin\nmatchesCtOrigin (MG { mg_alts = alts })\n  | L _ [L _ match] <- alts\n  , Match { m_grhss = grhss } <- match\n  = grhssCtOrigin grhss\n\n  | otherwise\n  = Shouldn'tHappenOrigin \"multi-way match\"\nmatchesCtOrigin (XMatchGroup{}) = panic \"matchesCtOrigin\"\n\n-- | Extract a suitable CtOrigin from guarded RHSs\ngrhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin\ngrhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss\ngrhssCtOrigin (XGRHSs _) = panic \"grhssCtOrigin\"\n\n-- | Extract a suitable CtOrigin from a list of guarded RHSs\nlGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin\nlGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e\nlGRHSCtOrigin [L _ (XGRHS _)] = panic \"lGRHSCtOrigin\"\nlGRHSCtOrigin _ = Shouldn'tHappenOrigin \"multi-way GRHS\"\n\npprCtLoc :: CtLoc -> SDoc\n-- \"arising from ... at ...\"\n-- Not an instance of Outputable because of the \"arising from\" prefix\npprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})\n  = sep [ pprCtOrigin o\n        , text \"at\" <+> ppr (tcl_loc lcl)]\n\npprCtOrigin :: CtOrigin -> SDoc\n-- \"arising from ...\"\n-- Not an instance of Outputable because of the \"arising from\" prefix\npprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk\n\npprCtOrigin (SpecPragOrigin ctxt)\n  = case ctxt of\n       FunSigCtxt n _ -> text \"a SPECIALISE pragma for\" <+> quotes (ppr n)\n       SpecInstCtxt   -> text \"a SPECIALISE INSTANCE pragma\"\n       _              -> text \"a SPECIALISE pragma\"  -- Never happens I think\n\npprCtOrigin (FunDepOrigin1 pred1 loc1 pred2 loc2)\n  = hang (ctoHerald <+> text \"a functional dependency between constraints:\")\n       2 (vcat [ hang (quotes (ppr pred1)) 2 (pprCtLoc loc1)\n               , hang (quotes (ppr pred2)) 2 (pprCtLoc loc2) ])\n\npprCtOrigin (FunDepOrigin2 pred1 orig1 pred2 loc2)\n  = hang (ctoHerald <+> text \"a functional dependency between:\")\n       2 (vcat [ hang (text \"constraint\" <+> quotes (ppr pred1))\n                    2 (pprCtOrigin orig1 )\n               , hang (text \"instance\" <+> quotes (ppr pred2))\n                    2 (text \"at\" <+> ppr loc2) ])\n\npprCtOrigin (KindEqOrigin t1 (Just t2) _ _)\n  = hang (ctoHerald <+> text \"a kind equality arising from\")\n       2 (sep [ppr t1, char '~', ppr t2])\n\npprCtOrigin AssocFamPatOrigin\n  = text \"when matching a family LHS with its class instance head\"\n\npprCtOrigin (KindEqOrigin t1 Nothing _ _)\n  = hang (ctoHerald <+> text \"a kind equality when matching\")\n       2 (ppr t1)\n\npprCtOrigin (UnboundOccurrenceOf name)\n  = ctoHerald <+> text \"an undeclared identifier\" <+> quotes (ppr name)\n\npprCtOrigin (DerivOriginDC dc n _)\n  = hang (ctoHerald <+> text \"the\" <+> speakNth n\n          <+> text \"field of\" <+> quotes (ppr dc))\n       2 (parens (text \"type\" <+> quotes (ppr ty)))\n  where\n    ty = dataConOrigArgTys dc !! (n-1)\n\npprCtOrigin (DerivOriginCoerce meth ty1 ty2 _)\n  = hang (ctoHerald <+> text \"the coercion of the method\" <+> quotes (ppr meth))\n       2 (sep [ text \"from type\" <+> quotes (ppr ty1)\n              , nest 2 $ text \"to type\" <+> quotes (ppr ty2) ])\n\npprCtOrigin (DoPatOrigin pat)\n    = ctoHerald <+> text \"a do statement\"\n      $$\n      text \"with the failable pattern\" <+> quotes (ppr pat)\n\npprCtOrigin (MCompPatOrigin pat)\n    = ctoHerald <+> hsep [ text \"the failable pattern\"\n           , quotes (ppr pat)\n           , text \"in a statement in a monad comprehension\" ]\npprCtOrigin (FailablePattern pat)\n    = ctoHerald <+> text \"the failable pattern\" <+> quotes (ppr pat)\n      $$\n      text \"(this will become an error in a future GHC release)\"\n\npprCtOrigin (Shouldn'tHappenOrigin note)\n  = sdocWithDynFlags $ \\dflags ->\n    if xopt LangExt.ImpredicativeTypes dflags\n    then text \"a situation created by impredicative types\"\n    else\n    vcat [ text \"<< This should not appear in error messages. If you see this\"\n         , text \"in an error message, please report a bug mentioning\" <+> quotes (text note) <+> text \"at\"\n         , text \"https://ghc.haskell.org/trac/ghc/wiki/ReportABug >>\" ]\n\npprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) })\n  = hang (ctoHerald <+> text \"the \\\"provided\\\" constraints claimed by\")\n       2 (text \"the signature of\" <+> quotes (ppr name))\n\npprCtOrigin (InstProvidedOrigin mod cls_inst)\n  = vcat [ text \"arising when attempting to show that\"\n         , ppr cls_inst\n         , text \"is provided by\" <+> quotes (ppr mod)]\n\npprCtOrigin simple_origin\n  = ctoHerald <+> pprCtO simple_origin\n\n-- | Short one-liners\npprCtO :: CtOrigin -> SDoc\npprCtO (OccurrenceOf name)   = hsep [text \"a use of\", quotes (ppr name)]\npprCtO (OccurrenceOfRecSel name) = hsep [text \"a use of\", quotes (ppr name)]\npprCtO AppOrigin             = text \"an application\"\npprCtO (IPOccOrigin name)    = hsep [text \"a use of implicit parameter\", quotes (ppr name)]\npprCtO (OverLabelOrigin l)   = hsep [text \"the overloaded label\"\n                                    ,quotes (char '#' <> ppr l)]\npprCtO RecordUpdOrigin       = text \"a record update\"\npprCtO ExprSigOrigin         = text \"an expression type signature\"\npprCtO PatSigOrigin          = text \"a pattern type signature\"\npprCtO PatOrigin             = text \"a pattern\"\npprCtO ViewPatOrigin         = text \"a view pattern\"\npprCtO IfOrigin              = text \"an if expression\"\npprCtO (LiteralOrigin lit)   = hsep [text \"the literal\", quotes (ppr lit)]\npprCtO (ArithSeqOrigin seq)  = hsep [text \"the arithmetic sequence\", quotes (ppr seq)]\npprCtO SectionOrigin         = text \"an operator section\"\npprCtO AssocFamPatOrigin     = text \"the LHS of a famly instance\"\npprCtO TupleOrigin           = text \"a tuple\"\npprCtO NegateOrigin          = text \"a use of syntactic negation\"\npprCtO (ScOrigin n)          = text \"the superclasses of an instance declaration\"\n                               <> whenPprDebug (parens (ppr n))\npprCtO DerivClauseOrigin     = text \"the 'deriving' clause of a data type declaration\"\npprCtO StandAloneDerivOrigin = text \"a 'deriving' declaration\"\npprCtO DefaultOrigin         = text \"a 'default' declaration\"\npprCtO DoOrigin              = text \"a do statement\"\npprCtO MCompOrigin           = text \"a statement in a monad comprehension\"\npprCtO ProcOrigin            = text \"a proc expression\"\npprCtO (TypeEqOrigin t1 t2 _ _)= text \"a type equality\" <+> sep [ppr t1, char '~', ppr t2]\npprCtO AnnOrigin             = text \"an annotation\"\npprCtO HoleOrigin            = text \"a use of\" <+> quotes (text \"_\")\npprCtO ListOrigin            = text \"an overloaded list\"\npprCtO StaticOrigin          = text \"a static form\"\npprCtO _                     = panic \"pprCtOrigin\"\n\n{-\nConstraint Solver Plugins\n-------------------------\n-}\n\ntype TcPluginSolver = [Ct]    -- given\n                   -> [Ct]    -- derived\n                   -> [Ct]    -- wanted\n                   -> TcPluginM TcPluginResult\n\nnewtype TcPluginM a = TcPluginM (EvBindsVar -> TcM a)\n\ninstance Functor TcPluginM where\n  fmap = liftM\n\ninstance Applicative TcPluginM where\n  pure x = TcPluginM (const $ pure x)\n  (<*>) = ap\n\ninstance Monad TcPluginM where\n#if !MIN_VERSION_base(4,13,0)\n  fail = MonadFail.fail\n#endif\n  TcPluginM m >>= k =\n    TcPluginM (\\ ev -> do a <- m ev\n                          runTcPluginM (k a) ev)\n\ninstance MonadFail.MonadFail TcPluginM where\n  fail x   = TcPluginM (const $ fail x)\n\nrunTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a\nrunTcPluginM (TcPluginM m) = m\n\n-- | This function provides an escape for direct access to\n-- the 'TcM` monad.  It should not be used lightly, and\n-- the provided 'TcPluginM' API should be favoured instead.\nunsafeTcPluginTcM :: TcM a -> TcPluginM a\nunsafeTcPluginTcM = TcPluginM . const\n\n-- | Access the 'EvBindsVar' carried by the 'TcPluginM' during\n-- constraint solving.  Returns 'Nothing' if invoked during\n-- 'tcPluginInit' or 'tcPluginStop'.\ngetEvBindsTcPluginM :: TcPluginM EvBindsVar\ngetEvBindsTcPluginM = TcPluginM return\n\n\ndata TcPlugin = forall s. TcPlugin\n  { tcPluginInit  :: TcPluginM s\n    -- ^ Initialize plugin, when entering type-checker.\n\n  , tcPluginSolve :: s -> TcPluginSolver\n    -- ^ Solve some constraints.\n    -- TODO: WRITE MORE DETAILS ON HOW THIS WORKS.\n\n  , tcPluginStop  :: s -> TcPluginM ()\n   -- ^ Clean up after the plugin, when exiting the type-checker.\n  }\n\ndata TcPluginResult\n  = TcPluginContradiction [Ct]\n    -- ^ The plugin found a contradiction.\n    -- The returned constraints are removed from the inert set,\n    -- and recorded as insoluble.\n\n  | TcPluginOk [(EvTerm,Ct)] [Ct]\n    -- ^ The first field is for constraints that were solved.\n    -- These are removed from the inert set,\n    -- and the evidence for them is recorded.\n    -- The second field contains new work, that should be processed by\n    -- the constraint solver.\n\n{- *********************************************************************\n*                                                                      *\n                        Role annotations\n*                                                                      *\n********************************************************************* -}\n\ntype RoleAnnotEnv = NameEnv (LRoleAnnotDecl GhcRn)\n\nmkRoleAnnotEnv :: [LRoleAnnotDecl GhcRn] -> RoleAnnotEnv\nmkRoleAnnotEnv role_annot_decls\n = mkNameEnv [ (name, ra_decl)\n             | ra_decl <- role_annot_decls\n             , let name = roleAnnotDeclName (unLoc ra_decl)\n             , not (isUnboundName name) ]\n       -- Some of the role annots will be unbound;\n       -- we don't wish to include these\n\nemptyRoleAnnotEnv :: RoleAnnotEnv\nemptyRoleAnnotEnv = emptyNameEnv\n\nlookupRoleAnnot :: RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn)\nlookupRoleAnnot = lookupNameEnv\n\ngetRoleAnnots :: [Name] -> RoleAnnotEnv\n              -> ([LRoleAnnotDecl GhcRn], RoleAnnotEnv)\ngetRoleAnnots bndrs role_env\n  = ( mapMaybe (lookupRoleAnnot role_env) bndrs\n    , delListFromNameEnv role_env bndrs )\n", "num_lines": 3919}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\nTcRules: Typechecking transformation rules\n-}\n\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcRules ( tcRules ) where\n\nimport GhcPrelude\n\nimport HsSyn\nimport TcRnTypes\nimport TcRnMonad\nimport TcSimplify\nimport TcMType\nimport TcType\nimport TcHsType\nimport TcExpr\nimport TcEnv\nimport TcUnify( buildImplicationFor )\nimport TcEvidence( mkTcCoVarCo )\nimport Type\nimport TyCon( isTypeFamilyTyCon )\nimport Id\nimport Var( EvVar )\nimport VarSet\nimport BasicTypes       ( RuleName )\nimport SrcLoc\nimport Outputable\nimport FastString\nimport Bag\n\n{-\nNote [Typechecking rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWe *infer* the typ of the LHS, and use that type to *check* the type of\nthe RHS.  That means that higher-rank rules work reasonably well. Here's\nan example (test simplCore/should_compile/rule2.hs) produced by Roman:\n\n   foo :: (forall m. m a -> m b) -> m a -> m b\n   foo f = ...\n\n   bar :: (forall m. m a -> m a) -> m a -> m a\n   bar f = ...\n\n   {-# RULES \"foo/bar\" foo = bar #-}\n\nHe wanted the rule to typecheck.\n\nNote [TcLevel in type checking rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBringing type variables into scope naturally bumps the TcLevel. Thus, we type\ncheck the term-level binders in a bumped level, and we must accordingly bump\nthe level whenever these binders are in scope.\n-}\n\ntcRules :: [LRuleDecls GhcRn] -> TcM [LRuleDecls GhcTcId]\ntcRules decls = mapM (wrapLocM tcRuleDecls) decls\n\ntcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTcId)\ntcRuleDecls (HsRules { rds_src = src\n                     , rds_rules = decls })\n   = do { tc_decls <- mapM (wrapLocM tcRule) decls\n        ; return $ HsRules { rds_ext   = noExt\n                           , rds_src   = src\n                           , rds_rules = tc_decls } }\ntcRuleDecls (XRuleDecls _) = panic \"tcRuleDecls\"\n\ntcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTcId)\ntcRule (HsRule { rd_ext  = ext\n               , rd_name = rname@(L _ (_,name))\n               , rd_act  = act\n               , rd_tyvs = ty_bndrs\n               , rd_tmvs = tm_bndrs\n               , rd_lhs  = lhs\n               , rd_rhs  = rhs })\n  = addErrCtxt (ruleCtxt name)  $\n    do { traceTc \"---- Rule ------\" (pprFullRuleName rname)\n\n        -- Note [Typechecking rules]\n       ; (tc_lvl, stuff) <- pushTcLevelM $\n                            generateRuleConstraints ty_bndrs tm_bndrs lhs rhs\n\n       ; let (tv_bndrs, id_bndrs, lhs', lhs_wanted\n                                , rhs', rhs_wanted, rule_ty) = stuff\n\n       ; traceTc \"tcRule 1\" (vcat [ pprFullRuleName rname\n                                  , ppr lhs_wanted\n                                  , ppr rhs_wanted ])\n\n       ; (lhs_evs, residual_lhs_wanted)\n            <- simplifyRule name tc_lvl lhs_wanted rhs_wanted\n\n       -- SimplfyRule Plan, step 4\n       -- Now figure out what to quantify over\n       -- c.f. TcSimplify.simplifyInfer\n       -- We quantify over any tyvars free in *either* the rule\n       --  *or* the bound variables.  The latter is important.  Consider\n       --      ss (x,(y,z)) = (x,z)\n       --      RULE:  forall v. fst (ss v) = fst v\n       -- The type of the rhs of the rule is just a, but v::(a,(b,c))\n       --\n       -- We also need to get the completely-uconstrained tyvars of\n       -- the LHS, lest they otherwise get defaulted to Any; but we do that\n       -- during zonking (see TcHsSyn.zonkRule)\n\n       ; let tpl_ids = lhs_evs ++ id_bndrs\n       ; gbls  <- tcGetGlobalTyCoVars -- Even though top level, there might be top-level\n                                      -- monomorphic bindings from the MR; test tc111\n       ; forall_tkvs <- candidateQTyVarsOfTypes $\n                        map (mkSpecForAllTys tv_bndrs) $  -- don't quantify over lexical tyvars\n                        rule_ty : map idType tpl_ids\n       ; qtkvs <- quantifyTyVars gbls forall_tkvs\n       ; traceTc \"tcRule\" (vcat [ pprFullRuleName rname\n                                , ppr forall_tkvs\n                                , ppr qtkvs\n                                , ppr tv_bndrs\n                                , ppr rule_ty\n                                , vcat [ ppr id <+> dcolon <+> ppr (idType id) | id <- tpl_ids ]\n                  ])\n\n       -- SimplfyRule Plan, step 5\n       -- Simplify the LHS and RHS constraints:\n       -- For the LHS constraints we must solve the remaining constraints\n       -- (a) so that we report insoluble ones\n       -- (b) so that we bind any soluble ones\n       ; let all_qtkvs = qtkvs ++ tv_bndrs\n             skol_info = RuleSkol name\n       ; (lhs_implic, lhs_binds) <- buildImplicationFor tc_lvl skol_info all_qtkvs\n                                         lhs_evs residual_lhs_wanted\n       ; (rhs_implic, rhs_binds) <- buildImplicationFor tc_lvl skol_info all_qtkvs\n                                         lhs_evs rhs_wanted\n\n       ; emitImplications (lhs_implic `unionBags` rhs_implic)\n       ; return $ HsRule { rd_ext = ext\n                         , rd_name = rname\n                         , rd_act = act\n                         , rd_tyvs = ty_bndrs -- preserved for ppr-ing\n                         , rd_tmvs = map (noLoc . RuleBndr noExt . noLoc) (all_qtkvs ++ tpl_ids)\n                         , rd_lhs  = mkHsDictLet lhs_binds lhs'\n                         , rd_rhs  = mkHsDictLet rhs_binds rhs' } }\ntcRule (XRuleDecl _) = panic \"tcRule\"\n\ngenerateRuleConstraints :: Maybe [LHsTyVarBndr GhcRn] -> [LRuleBndr GhcRn]\n                        -> LHsExpr GhcRn -> LHsExpr GhcRn\n                        -> TcM ( [TyVar]\n                               , [TcId]\n                               , LHsExpr GhcTc, WantedConstraints\n                               , LHsExpr GhcTc, WantedConstraints\n                               , TcType )\ngenerateRuleConstraints ty_bndrs tm_bndrs lhs rhs\n  = do { ((tv_bndrs, id_bndrs), bndr_wanted) <- captureConstraints $\n                                                tcRuleBndrs ty_bndrs tm_bndrs\n              -- bndr_wanted constraints can include wildcard hole\n              -- constraints, which we should not forget about.\n              -- It may mention the skolem type variables bound by\n              -- the RULE.  c.f. Trac #10072\n\n       ; tcExtendTyVarEnv tv_bndrs $\n         tcExtendIdEnv    id_bndrs $\n    do { -- See Note [Solve order for RULES]\n         ((lhs', rule_ty), lhs_wanted) <- captureConstraints (tcInferRho lhs)\n       ; (rhs',            rhs_wanted) <- captureConstraints $\n                                          tcMonoExpr rhs (mkCheckExpType rule_ty)\n       ; let all_lhs_wanted = bndr_wanted `andWC` lhs_wanted\n       ; return (tv_bndrs, id_bndrs, lhs', all_lhs_wanted, rhs', rhs_wanted, rule_ty) } }\n\n-- See Note [TcLevel in type checking rules]\ntcRuleBndrs :: Maybe [LHsTyVarBndr GhcRn] -> [LRuleBndr GhcRn]\n            -> TcM ([TcTyVar], [Id])\ntcRuleBndrs (Just bndrs) xs\n  = do { (tys1,(tys2,tms)) <- bindExplicitTKBndrs_Skol bndrs $\n                              tcRuleTmBndrs xs\n       ; return (tys1 ++ tys2, tms) }\n\ntcRuleBndrs Nothing xs\n  = tcRuleTmBndrs xs\n\n-- See Note [TcLevel in type checking rules]\ntcRuleTmBndrs :: [LRuleBndr GhcRn] -> TcM ([TcTyVar],[Id])\ntcRuleTmBndrs [] = return ([],[])\ntcRuleTmBndrs (L _ (RuleBndr _ (L _ name)) : rule_bndrs)\n  = do  { ty <- newOpenFlexiTyVarTy\n        ; (tyvars, tmvars) <- tcRuleTmBndrs rule_bndrs\n        ; return (tyvars, mkLocalId name ty : tmvars) }\ntcRuleTmBndrs (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs)\n--  e.g         x :: a->a\n--  The tyvar 'a' is brought into scope first, just as if you'd written\n--              a::*, x :: a->a\n--  If there's an explicit forall, the renamer would have already reported an\n--   error for each out-of-scope type variable used\n  = do  { let ctxt = RuleSigCtxt name\n        ; (_ , tvs, id_ty) <- tcHsPatSigType ctxt rn_ty\n        ; let id  = mkLocalIdOrCoVar name id_ty\n                    -- See Note [Pattern signature binders] in TcHsType\n\n              -- The type variables scope over subsequent bindings; yuk\n        ; (tyvars, tmvars) <- tcExtendNameTyVarEnv tvs $\n                                   tcRuleTmBndrs rule_bndrs\n        ; return (map snd tvs ++ tyvars, id : tmvars) }\ntcRuleTmBndrs (L _ (XRuleBndr _) : _) = panic \"tcRuleTmBndrs\"\n\nruleCtxt :: FastString -> SDoc\nruleCtxt name = text \"When checking the transformation rule\" <+>\n                doubleQuotes (ftext name)\n\n\n{-\n*********************************************************************************\n*                                                                                 *\n              Constraint simplification for rules\n*                                                                                 *\n***********************************************************************************\n\nNote [The SimplifyRule Plan]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nExample.  Consider the following left-hand side of a rule\n        f (x == y) (y > z) = ...\nIf we typecheck this expression we get constraints\n        d1 :: Ord a, d2 :: Eq a\nWe do NOT want to \"simplify\" to the LHS\n        forall x::a, y::a, z::a, d1::Ord a.\n          f ((==) (eqFromOrd d1) x y) ((>) d1 y z) = ...\nInstead we want\n        forall x::a, y::a, z::a, d1::Ord a, d2::Eq a.\n          f ((==) d2 x y) ((>) d1 y z) = ...\n\nHere is another example:\n        fromIntegral :: (Integral a, Num b) => a -> b\n        {-# RULES \"foo\"  fromIntegral = id :: Int -> Int #-}\nIn the rule, a=b=Int, and Num Int is a superclass of Integral Int. But\nwe *dont* want to get\n        forall dIntegralInt.\n           fromIntegral Int Int dIntegralInt (scsel dIntegralInt) = id Int\nbecause the scsel will mess up RULE matching.  Instead we want\n        forall dIntegralInt, dNumInt.\n          fromIntegral Int Int dIntegralInt dNumInt = id Int\n\nEven if we have\n        g (x == y) (y == z) = ..\nwhere the two dictionaries are *identical*, we do NOT WANT\n        forall x::a, y::a, z::a, d1::Eq a\n          f ((==) d1 x y) ((>) d1 y z) = ...\nbecause that will only match if the dict args are (visibly) equal.\nInstead we want to quantify over the dictionaries separately.\n\nIn short, simplifyRuleLhs must *only* squash equalities, leaving\nall dicts unchanged, with absolutely no sharing.\n\nAlso note that we can't solve the LHS constraints in isolation:\nExample   foo :: Ord a => a -> a\n          foo_spec :: Int -> Int\n          {-# RULE \"foo\"  foo = foo_spec #-}\nHere, it's the RHS that fixes the type variable\n\nHOWEVER, under a nested implication things are different\nConsider\n  f :: (forall a. Eq a => a->a) -> Bool -> ...\n  {-# RULES \"foo\" forall (v::forall b. Eq b => b->b).\n       f b True = ...\n    #-}\nHere we *must* solve the wanted (Eq a) from the given (Eq a)\nresulting from skolemising the argument type of g.  So we\nrevert to SimplCheck when going under an implication.\n\n\n--------- So the SimplifyRule Plan is this -----------------------\n\n* Step 0: typecheck the LHS and RHS to get constraints from each\n\n* Step 1: Simplify the LHS and RHS constraints all together in one bag\n          We do this to discover all unification equalities\n\n* Step 2: Zonk the ORIGINAL (unsimplified) LHS constraints, to take\n          advantage of those unifications\n\n* Setp 3: Partition the LHS constraints into the ones we will\n          quantify over, and the others.\n          See Note [RULE quantification over equalities]\n\n* Step 4: Decide on the type variables to quantify over\n\n* Step 5: Simplify the LHS and RHS constraints separately, using the\n          quantified constraints as givens\n\nNote [Solve order for RULES]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn step 1 above, we need to be a bit careful about solve order.\nConsider\n   f :: Int -> T Int\n   type instance T Int = Bool\n\n   RULE f 3 = True\n\nFrom the RULE we get\n   lhs-constraints:  T Int ~ alpha\n   rhs-constraints:  Bool ~ alpha\nwhere 'alpha' is the type that connects the two.  If we glom them\nall together, and solve the RHS constraint first, we might solve\nwith alpha := Bool.  But then we'd end up with a RULE like\n\n    RULE: f 3 |> (co :: T Int ~ Bool) = True\n\nwhich is terrible.  We want\n\n    RULE: f 3 = True |> (sym co :: Bool ~ T Int)\n\nSo we are careful to solve the LHS constraints first, and *then* the\nRHS constraints.  Actually much of this is done by the on-the-fly\nconstraint solving, so the same order must be observed in\ntcRule.\n\n\nNote [RULE quantification over equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDeciding which equalities to quantify over is tricky:\n * We do not want to quantify over insoluble equalities (Int ~ Bool)\n    (a) because we prefer to report a LHS type error\n    (b) because if such things end up in 'givens' we get a bogus\n        \"inaccessible code\" error\n\n * But we do want to quantify over things like (a ~ F b), where\n   F is a type function.\n\nThe difficulty is that it's hard to tell what is insoluble!\nSo we see whether the simplification step yielded any type errors,\nand if so refrain from quantifying over *any* equalities.\n\nNote [Quantifying over coercion holes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEquality constraints from the LHS will emit coercion hole Wanteds.\nThese don't have a name, so we can't quantify over them directly.\nInstead, because we really do want to quantify here, invent a new\nEvVar for the coercion, fill the hole with the invented EvVar, and\nthen quantify over the EvVar. Not too tricky -- just some\nimpedance matching, really.\n\nNote [Simplify cloned constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAt this stage, we're simplifying constraints only for insolubility\nand for unification. Note that all the evidence is quickly discarded.\nWe use a clone of the real constraint. If we don't do this,\nthen RHS coercion-hole constraints get filled in, only to get filled\nin *again* when solving the implications emitted from tcRule. That's\nterrible, so we avoid the problem by cloning the constraints.\n\n-}\n\nsimplifyRule :: RuleName\n             -> TcLevel                 -- Level at which to solve the constraints\n             -> WantedConstraints       -- Constraints from LHS\n             -> WantedConstraints       -- Constraints from RHS\n             -> TcM ( [EvVar]               -- Quantify over these LHS vars\n                    , WantedConstraints)    -- Residual un-quantified LHS constraints\n-- See Note [The SimplifyRule Plan]\n-- NB: This consumes all simple constraints on the LHS, but not\n-- any LHS implication constraints.\nsimplifyRule name tc_lvl lhs_wanted rhs_wanted\n  = do {\n       -- Note [The SimplifyRule Plan] step 1\n       -- First solve the LHS and *then* solve the RHS\n       -- Crucially, this performs unifications\n       -- Why clone?  See Note [Simplify cloned constraints]\n       ; lhs_clone <- cloneWC lhs_wanted\n       ; rhs_clone <- cloneWC rhs_wanted\n       ; setTcLevel tc_lvl $\n         runTcSDeriveds    $\n         do { _ <- solveWanteds lhs_clone\n            ; _ <- solveWanteds rhs_clone\n                  -- Why do them separately?\n                  -- See Note [Solve order for RULES]\n            ; return () }\n\n       -- Note [The SimplifyRule Plan] step 2\n       ; lhs_wanted <- zonkWC lhs_wanted\n       ; let (quant_cts, residual_lhs_wanted) = getRuleQuantCts lhs_wanted\n\n       -- Note [The SimplifyRule Plan] step 3\n       ; quant_evs <- mapM mk_quant_ev (bagToList quant_cts)\n\n       ; traceTc \"simplifyRule\" $\n         vcat [ text \"LHS of rule\" <+> doubleQuotes (ftext name)\n              , text \"lhs_wanted\" <+> ppr lhs_wanted\n              , text \"rhs_wanted\" <+> ppr rhs_wanted\n              , text \"quant_cts\" <+> ppr quant_cts\n              , text \"residual_lhs_wanted\" <+> ppr residual_lhs_wanted\n              ]\n\n       ; return (quant_evs, residual_lhs_wanted) }\n\n  where\n    mk_quant_ev :: Ct -> TcM EvVar\n    mk_quant_ev ct\n      | CtWanted { ctev_dest = dest, ctev_pred = pred } <- ctEvidence ct\n      = case dest of\n          EvVarDest ev_id -> return ev_id\n          HoleDest hole   -> -- See Note [Quantifying over coercion holes]\n                             do { ev_id <- newEvVar pred\n                                ; fillCoercionHole hole (mkTcCoVarCo ev_id)\n                                ; return ev_id }\n    mk_quant_ev ct = pprPanic \"mk_quant_ev\" (ppr ct)\n\n\ngetRuleQuantCts :: WantedConstraints -> (Cts, WantedConstraints)\n-- Extract all the constraints we can quantify over,\n--   also returning the depleted WantedConstraints\n--\n-- NB: we must look inside implications, because with\n--     -fdefer-type-errors we generate implications rather eagerly;\n--     see TcUnify.implicationNeeded. Not doing so caused Trac #14732.\n--\n-- Unlike simplifyInfer, we don't leave the WantedConstraints unchanged,\n--   and attempt to solve them from the quantified constraints.  That\n--   nearly works, but fails for a constraint like (d :: Eq Int).\n--   We /do/ want to quantify over it, but the short-cut solver\n--   (see TcInteract Note [Shortcut solving]) ignores the quantified\n--   and instead solves from the top level.\n--\n--   So we must partition the WantedConstraints ourselves\n--   Not hard, but tiresome.\n\ngetRuleQuantCts wc\n  = float_wc emptyVarSet wc\n  where\n    float_wc :: TcTyCoVarSet -> WantedConstraints -> (Cts, WantedConstraints)\n    float_wc skol_tvs (WC { wc_simple = simples, wc_impl = implics })\n      = ( simple_yes `andCts` implic_yes\n        , WC { wc_simple = simple_no, wc_impl = implics_no })\n     where\n        (simple_yes, simple_no) = partitionBag (rule_quant_ct skol_tvs) simples\n        (implic_yes, implics_no) = mapAccumBagL (float_implic skol_tvs)\n                                                emptyBag implics\n\n    float_implic :: TcTyCoVarSet -> Cts -> Implication -> (Cts, Implication)\n    float_implic skol_tvs yes1 imp\n      = (yes1 `andCts` yes2, imp { ic_wanted = no })\n      where\n        (yes2, no) = float_wc new_skol_tvs (ic_wanted imp)\n        new_skol_tvs = skol_tvs `extendVarSetList` ic_skols imp\n\n    rule_quant_ct :: TcTyCoVarSet -> Ct -> Bool\n    rule_quant_ct skol_tvs ct\n      | EqPred _ t1 t2 <- classifyPredType (ctPred ct)\n      , not (ok_eq t1 t2)\n       = False        -- Note [RULE quantification over equalities]\n      | isHoleCt ct\n      = False         -- Don't quantify over type holes, obviously\n      | otherwise\n      = tyCoVarsOfCt ct `disjointVarSet` skol_tvs\n\n    ok_eq t1 t2\n       | t1 `tcEqType` t2 = False\n       | otherwise        = is_fun_app t1 || is_fun_app t2\n\n    is_fun_app ty   -- ty is of form (F tys) where F is a type function\n      = case tyConAppTyCon_maybe ty of\n          Just tc -> isTypeFamilyTyCon tc\n          Nothing -> False\n", "num_lines": 464}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006-2012\n(c) The GRASP Project, Glasgow University, 1992-2002\n\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcSigs(\n       TcSigInfo(..),\n       TcIdSigInfo(..), TcIdSigInst,\n       TcPatSynInfo(..),\n       TcSigFun,\n\n       isPartialSig, hasCompleteSig, tcIdSigName, tcSigInfoName,\n       completeSigPolyId_maybe,\n\n       tcTySigs, tcUserTypeSig, completeSigFromId,\n       tcInstSig,\n\n       TcPragEnv, emptyPragEnv, lookupPragEnv, extendPragEnv,\n       mkPragEnv, tcSpecPrags, tcSpecWrapper, tcImpPrags, addInlinePrags\n   ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport TcHsType\nimport TcRnTypes\nimport TcRnMonad\nimport TcType\nimport TcMType\nimport TcValidity ( checkValidType )\nimport TcUnify( tcSkolemise, unifyType )\nimport Inst( topInstantiate )\nimport TcEnv( tcLookupId )\nimport TcEvidence( HsWrapper, (<.>) )\nimport Type( mkTyVarBinders )\n\nimport DynFlags\nimport Var      ( TyVar, tyVarKind )\nimport Id       ( Id, idName, idType, idInlinePragma, setInlinePragma, mkLocalId )\nimport PrelNames( mkUnboundName )\nimport BasicTypes\nimport Bag( foldrBag )\nimport Module( getModule )\nimport Name\nimport NameEnv\nimport Outputable\nimport SrcLoc\nimport Util( singleton )\nimport Maybes( orElse )\nimport Data.Maybe( mapMaybe )\nimport Control.Monad( unless )\n\n\n{- -------------------------------------------------------------\n          Note [Overview of type signatures]\n----------------------------------------------------------------\nType signatures, including partial signatures, are jolly tricky,\nespecially on value bindings.  Here's an overview.\n\n    f :: forall a. [a] -> [a]\n    g :: forall b. _ -> b\n\n    f = ...g...\n    g = ...f...\n\n* HsSyn: a signature in a binding starts off as a TypeSig, in\n  type HsBinds.Sig\n\n* When starting a mutually recursive group, like f/g above, we\n  call tcTySig on each signature in the group.\n\n* tcTySig: Sig -> TcIdSigInfo\n  - For a /complete/ signature, like 'f' above, tcTySig kind-checks\n    the HsType, producing a Type, and wraps it in a CompleteSig, and\n    extend the type environment with this polymorphic 'f'.\n\n  - For a /partial/signature, like 'g' above, tcTySig does nothing\n    Instead it just wraps the pieces in a PartialSig, to be handled\n    later.\n\n* tcInstSig: TcIdSigInfo -> TcIdSigInst\n  In tcMonoBinds, when looking at an individual binding, we use\n  tcInstSig to instantiate the signature forall's in the signature,\n  and attribute that instantiated (monomorphic) type to the\n  binder.  You can see this in TcBinds.tcLhsId.\n\n  The instantiation does the obvious thing for complete signatures,\n  but for /partial/ signatures it starts from the HsSyn, so it\n  has to kind-check it etc: tcHsPartialSigType.  It's convenient\n  to do this at the same time as instantiation, because we can\n  make the wildcards into unification variables right away, raather\n  than somehow quantifying over them.  And the \"TcLevel\" of those\n  unification variables is correct because we are in tcMonoBinds.\n\n\nNote [Scoped tyvars]\n~~~~~~~~~~~~~~~~~~~~\nThe -XScopedTypeVariables flag brings lexically-scoped type variables\ninto scope for any explicitly forall-quantified type variables:\n        f :: forall a. a -> a\n        f x = e\nThen 'a' is in scope inside 'e'.\n\nHowever, we do *not* support this\n  - For pattern bindings e.g\n        f :: forall a. a->a\n        (f,g) = e\n\nNote [Binding scoped type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe type variables *brought into lexical scope* by a type signature\nmay be a subset of the *quantified type variables* of the signatures,\nfor two reasons:\n\n* With kind polymorphism a signature like\n    f :: forall f a. f a -> f a\n  may actually give rise to\n    f :: forall k. forall (f::k -> *) (a:k). f a -> f a\n  So the sig_tvs will be [k,f,a], but only f,a are scoped.\n  NB: the scoped ones are not necessarily the *inital* ones!\n\n* Even aside from kind polymorphism, there may be more instantiated\n  type variables than lexically-scoped ones.  For example:\n        type T a = forall b. b -> (a,b)\n        f :: forall c. T c\n  Here, the signature for f will have one scoped type variable, c,\n  but two instantiated type variables, c' and b'.\n\nHowever, all of this only applies to the renamer.  The typechecker\njust puts all of them into the type environment; any lexical-scope\nerrors were dealt with by the renamer.\n\n-}\n\n\n{- *********************************************************************\n*                                                                      *\n             Utility functions for TcSigInfo\n*                                                                      *\n********************************************************************* -}\n\ntcIdSigName :: TcIdSigInfo -> Name\ntcIdSigName (CompleteSig { sig_bndr = id }) = idName id\ntcIdSigName (PartialSig { psig_name = n })  = n\n\ntcSigInfoName :: TcSigInfo -> Name\ntcSigInfoName (TcIdSig     idsi) = tcIdSigName idsi\ntcSigInfoName (TcPatSynSig tpsi) = patsig_name tpsi\n\ncompleteSigPolyId_maybe :: TcSigInfo -> Maybe TcId\ncompleteSigPolyId_maybe sig\n  | TcIdSig sig_info <- sig\n  , CompleteSig { sig_bndr = id } <- sig_info = Just id\n  | otherwise                                 = Nothing\n\n\n{- *********************************************************************\n*                                                                      *\n               Typechecking user signatures\n*                                                                      *\n********************************************************************* -}\n\ntcTySigs :: [LSig GhcRn] -> TcM ([TcId], TcSigFun)\ntcTySigs hs_sigs\n  = checkNoErrs $   -- See Note [Fail eagerly on bad signatures]\n    do { ty_sigs_s <- mapAndRecoverM tcTySig hs_sigs\n       ; let ty_sigs  = concat ty_sigs_s\n             poly_ids = mapMaybe completeSigPolyId_maybe ty_sigs\n                        -- The returned [TcId] are the ones for which we have\n                        -- a complete type signature.\n                        -- See Note [Complete and partial type signatures]\n             env = mkNameEnv [(tcSigInfoName sig, sig) | sig <- ty_sigs]\n       ; return (poly_ids, lookupNameEnv env) }\n\ntcTySig :: LSig GhcRn -> TcM [TcSigInfo]\ntcTySig (L _ (IdSig _ id))\n  = do { let ctxt = FunSigCtxt (idName id) False\n                    -- False: do not report redundant constraints\n                    -- The user has no control over the signature!\n             sig = completeSigFromId ctxt id\n       ; return [TcIdSig sig] }\n\ntcTySig (L loc (TypeSig _ names sig_ty))\n  = setSrcSpan loc $\n    do { sigs <- sequence [ tcUserTypeSig loc sig_ty (Just name)\n                          | L _ name <- names ]\n       ; return (map TcIdSig sigs) }\n\ntcTySig (L loc (PatSynSig _ names sig_ty))\n  = setSrcSpan loc $\n    do { tpsigs <- sequence [ tcPatSynSig name sig_ty\n                            | L _ name <- names ]\n       ; return (map TcPatSynSig tpsigs) }\n\ntcTySig _ = return []\n\n\ntcUserTypeSig :: SrcSpan -> LHsSigWcType GhcRn -> Maybe Name\n              -> TcM TcIdSigInfo\n-- A function or expression type signature\n-- Returns a fully quantified type signature; even the wildcards\n-- are quantified with ordinary skolems that should be instantiated\n--\n-- The SrcSpan is what to declare as the binding site of the\n-- any skolems in the signature. For function signatures we\n-- use the whole `f :: ty' signature; for expression signatures\n-- just the type part.\n--\n-- Just n  => Function type signature       name :: type\n-- Nothing => Expression type signature   <expr> :: type\ntcUserTypeSig loc hs_sig_ty mb_name\n  | isCompleteHsSig hs_sig_ty\n  = do { sigma_ty <- tcHsSigWcType ctxt_F hs_sig_ty\n       ; traceTc \"tcuser\" (ppr sigma_ty)\n       ; return $\n         CompleteSig { sig_bndr  = mkLocalId name sigma_ty\n                     , sig_ctxt  = ctxt_T\n                     , sig_loc   = loc } }\n                       -- Location of the <type> in   f :: <type>\n\n  -- Partial sig with wildcards\n  | otherwise\n  = return (PartialSig { psig_name = name, psig_hs_ty = hs_sig_ty\n                       , sig_ctxt = ctxt_F, sig_loc = loc })\n  where\n    name   = case mb_name of\n               Just n  -> n\n               Nothing -> mkUnboundName (mkVarOcc \"<expression>\")\n    ctxt_F = case mb_name of\n               Just n  -> FunSigCtxt n False\n               Nothing -> ExprSigCtxt\n    ctxt_T = case mb_name of\n               Just n  -> FunSigCtxt n True\n               Nothing -> ExprSigCtxt\n\n\n\ncompleteSigFromId :: UserTypeCtxt -> Id -> TcIdSigInfo\n-- Used for instance methods and record selectors\ncompleteSigFromId ctxt id\n  = CompleteSig { sig_bndr = id\n                , sig_ctxt = ctxt\n                , sig_loc  = getSrcSpan id }\n\nisCompleteHsSig :: LHsSigWcType GhcRn -> Bool\n-- ^ If there are no wildcards, return a LHsSigType\nisCompleteHsSig (HsWC { hswc_ext  = wcs\n                      , hswc_body = HsIB { hsib_body = hs_ty } })\n   = null wcs && no_anon_wc hs_ty\nisCompleteHsSig (HsWC _ (XHsImplicitBndrs _)) = panic \"isCompleteHsSig\"\nisCompleteHsSig (XHsWildCardBndrs _) = panic \"isCompleteHsSig\"\n\nno_anon_wc :: LHsType GhcRn -> Bool\nno_anon_wc lty = go lty\n  where\n    go (L _ ty) = case ty of\n      HsWildCardTy _                 -> False\n      HsAppTy _ ty1 ty2              -> go ty1 && go ty2\n      HsAppKindTy _ ty ki            -> go ty && go ki\n      HsFunTy _ ty1 ty2              -> go ty1 && go ty2\n      HsListTy _ ty                  -> go ty\n      HsTupleTy _ _ tys              -> gos tys\n      HsSumTy _ tys                  -> gos tys\n      HsOpTy _ ty1 _ ty2             -> go ty1 && go ty2\n      HsParTy _ ty                   -> go ty\n      HsIParamTy _ _ ty              -> go ty\n      HsKindSig _ ty kind            -> go ty && go kind\n      HsDocTy _ ty _                 -> go ty\n      HsBangTy _ _ ty                -> go ty\n      HsRecTy _ flds                 -> gos $ map (cd_fld_type . unLoc) flds\n      HsExplicitListTy _ _ tys       -> gos tys\n      HsExplicitTupleTy _ tys        -> gos tys\n      HsForAllTy { hst_bndrs = bndrs\n                 , hst_body = ty } -> no_anon_wc_bndrs bndrs\n                                        && go ty\n      HsQualTy { hst_ctxt = L _ ctxt\n               , hst_body = ty }  -> gos ctxt && go ty\n      HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)) -> go $ L noSrcSpan ty\n      HsSpliceTy{} -> True\n      HsTyLit{} -> True\n      HsTyVar{} -> True\n      HsStarTy{} -> True\n      XHsType{} -> True      -- Core type, which does not have any wildcard\n\n    gos = all go\n\nno_anon_wc_bndrs :: [LHsTyVarBndr GhcRn] -> Bool\nno_anon_wc_bndrs ltvs = all (go . unLoc) ltvs\n  where\n    go (UserTyVar _ _)      = True\n    go (KindedTyVar _ _ ki) = no_anon_wc ki\n    go (XTyVarBndr{})       = panic \"no_anon_wc_bndrs\"\n\n{- Note [Fail eagerly on bad signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf a type signature is wrong, fail immediately:\n\n * the type sigs may bind type variables, so proceeding without them\n   can lead to a cascade of errors\n\n * the type signature might be ambiguous, in which case checking\n   the code against the signature will give a very similar error\n   to the ambiguity error.\n\nToDo: this means we fall over if any type sig\nis wrong (eg at the top level of the module),\nwhich is over-conservative\n-}\n\n{- *********************************************************************\n*                                                                      *\n        Type checking a pattern synonym signature\n*                                                                      *\n************************************************************************\n\nNote [Pattern synonym signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPattern synonym signatures are surprisingly tricky (see Trac #11224 for example).\nIn general they look like this:\n\n   pattern P :: forall univ_tvs. req_theta\n             => forall ex_tvs. prov_theta\n             => arg1 -> .. -> argn -> res_ty\n\nFor parsing and renaming we treat the signature as an ordinary LHsSigType.\n\nOnce we get to type checking, we decompose it into its parts, in tcPatSynSig.\n\n* Note that 'forall univ_tvs' and 'req_theta =>'\n        and 'forall ex_tvs'   and 'prov_theta =>'\n  are all optional.  We gather the pieces at the top of tcPatSynSig\n\n* Initially the implicitly-bound tyvars (added by the renamer) include both\n  universal and existential vars.\n\n* After we kind-check the pieces and convert to Types, we do kind generalisation.\n\nNote [solveEqualities in tcPatSynSig]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's important that we solve /all/ the equalities in a pattern\nsynonym signature, because we are going to zonk the signature to\na Type (not a TcType), in TcPatSyn.tc_patsyn_finish, and that\nfails if there are un-filled-in coercion variables mentioned\nin the type (Trac #15694).\n\nThe best thing is simply to use solveEqualities to solve all the\nequalites, rather than leaving them in the ambient constraints\nto be solved later.  Pattern synonyms are top-level, so there's\nno problem with completely solving them.\n\n(NB: this solveEqualities wraps newImplicitTKBndrs, which itself\ndoes a solveLocalEqualities; so solveEqualities isn't going to\nmake any further progress; it'll just report any unsolved ones,\nand fail, as it should.)\n-}\n\ntcPatSynSig :: Name -> LHsSigType GhcRn -> TcM TcPatSynInfo\n-- See Note [Pattern synonym signatures]\n-- See Note [Recipe for checking a signature] in TcHsType\ntcPatSynSig name sig_ty\n  | HsIB { hsib_ext = implicit_hs_tvs\n         , hsib_body = hs_ty }  <- sig_ty\n  , (univ_hs_tvs, hs_req,  hs_ty1)     <- splitLHsSigmaTyInvis hs_ty\n  , (ex_hs_tvs,   hs_prov, hs_body_ty) <- splitLHsSigmaTyInvis hs_ty1\n  = do {  traceTc \"tcPatSynSig 1\" (ppr sig_ty)\n       ; (implicit_tvs, (univ_tvs, (ex_tvs, (req, prov, body_ty))))\n           <- pushTcLevelM_   $\n              solveEqualities $ -- See Note [solveEqualities in tcPatSynSig]\n              bindImplicitTKBndrs_Skol implicit_hs_tvs $\n              bindExplicitTKBndrs_Skol univ_hs_tvs     $\n              bindExplicitTKBndrs_Skol ex_hs_tvs       $\n              do { req     <- tcHsContext hs_req\n                 ; prov    <- tcHsContext hs_prov\n                 ; body_ty <- tcHsOpenType hs_body_ty\n                     -- A (literal) pattern can be unlifted;\n                     -- e.g. pattern Zero <- 0#   (Trac #12094)\n                 ; return (req, prov, body_ty) }\n\n       ; let ungen_patsyn_ty = build_patsyn_type [] implicit_tvs univ_tvs\n                                                 req ex_tvs prov body_ty\n\n       -- Kind generalisation\n       ; kvs <- kindGeneralize ungen_patsyn_ty\n       ; traceTc \"tcPatSynSig\" (ppr ungen_patsyn_ty)\n\n       -- These are /signatures/ so we zonk to squeeze out any kind\n       -- unification variables.  Do this after kindGeneralize which may\n       -- default kind variables to *.\n       ; implicit_tvs <- zonkAndScopedSort implicit_tvs\n       ; univ_tvs     <- mapM zonkTyCoVarKind univ_tvs\n       ; ex_tvs       <- mapM zonkTyCoVarKind ex_tvs\n       ; req          <- zonkTcTypes req\n       ; prov         <- zonkTcTypes prov\n       ; body_ty      <- zonkTcType  body_ty\n\n       -- Skolems have TcLevels too, though they're used only for debugging.\n       -- If you don't do this, the debugging checks fail in TcPatSyn.\n       -- Test case: patsyn/should_compile/T13441\n{-\n       ; tclvl <- getTcLevel\n       ; let env0                  = mkEmptyTCvSubst $ mkInScopeSet $ mkVarSet kvs\n             (env1, implicit_tvs') = promoteSkolemsX tclvl env0 implicit_tvs\n             (env2, univ_tvs')     = promoteSkolemsX tclvl env1 univ_tvs\n             (env3, ex_tvs')       = promoteSkolemsX tclvl env2 ex_tvs\n             req'                  = substTys env3 req\n             prov'                 = substTys env3 prov\n             body_ty'              = substTy  env3 body_ty\n-}\n      ; let implicit_tvs' = implicit_tvs\n            univ_tvs'     = univ_tvs\n            ex_tvs'       = ex_tvs\n            req'          = req\n            prov'         = prov\n            body_ty'      = body_ty\n\n       -- Now do validity checking\n       ; checkValidType ctxt $\n         build_patsyn_type kvs implicit_tvs' univ_tvs' req' ex_tvs' prov' body_ty'\n\n       -- arguments become the types of binders. We thus cannot allow\n       -- levity polymorphism here\n       ; let (arg_tys, _) = tcSplitFunTys body_ty'\n       ; mapM_ (checkForLevPoly empty) arg_tys\n\n       ; traceTc \"tcTySig }\" $\n         vcat [ text \"implicit_tvs\" <+> ppr_tvs implicit_tvs'\n              , text \"kvs\" <+> ppr_tvs kvs\n              , text \"univ_tvs\" <+> ppr_tvs univ_tvs'\n              , text \"req\" <+> ppr req'\n              , text \"ex_tvs\" <+> ppr_tvs ex_tvs'\n              , text \"prov\" <+> ppr prov'\n              , text \"body_ty\" <+> ppr body_ty' ]\n       ; return (TPSI { patsig_name = name\n                      , patsig_implicit_bndrs = mkTyVarBinders Inferred  kvs ++\n                                                mkTyVarBinders Specified implicit_tvs'\n                      , patsig_univ_bndrs     = univ_tvs'\n                      , patsig_req            = req'\n                      , patsig_ex_bndrs       = ex_tvs'\n                      , patsig_prov           = prov'\n                      , patsig_body_ty        = body_ty' }) }\n  where\n    ctxt = PatSynCtxt name\n\n    build_patsyn_type kvs imp univ req ex prov body\n      = mkInvForAllTys kvs $\n        mkSpecForAllTys (imp ++ univ) $\n        mkPhiTy req $\n        mkSpecForAllTys ex $\n        mkPhiTy prov $\n        body\ntcPatSynSig _ (XHsImplicitBndrs _) = panic \"tcPatSynSig\"\n\nppr_tvs :: [TyVar] -> SDoc\nppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv)\n                           | tv <- tvs])\n\n\n{- *********************************************************************\n*                                                                      *\n               Instantiating user signatures\n*                                                                      *\n********************************************************************* -}\n\n\ntcInstSig :: TcIdSigInfo -> TcM TcIdSigInst\n-- Instantiate a type signature; only used with plan InferGen\ntcInstSig sig@(CompleteSig { sig_bndr = poly_id, sig_loc = loc })\n  = setSrcSpan loc $  -- Set the binding site of the tyvars\n    do { (tv_prs, theta, tau) <- tcInstType newMetaTyVarTyVars poly_id\n              -- See Note [Pattern bindings and complete signatures]\n\n       ; return (TISI { sig_inst_sig   = sig\n                      , sig_inst_skols = tv_prs\n                      , sig_inst_wcs   = []\n                      , sig_inst_wcx   = Nothing\n                      , sig_inst_theta = theta\n                      , sig_inst_tau   = tau }) }\n\ntcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty\n                             , sig_ctxt = ctxt\n                             , sig_loc = loc })\n  = setSrcSpan loc $  -- Set the binding site of the tyvars\n    do { traceTc \"Staring partial sig {\" (ppr hs_sig)\n       ; (wcs, wcx, tv_names, tvs, theta, tau) <- tcHsPartialSigType ctxt hs_ty\n\n        -- Clone the quantified tyvars\n        -- Reason: we might have    f, g :: forall a. a -> _ -> a\n        --         and we want it to behave exactly as if there were\n        --         two separate signatures.  Cloning here seems like\n        --         the easiest way to do so, and is very similar to\n        --         the tcInstType in the CompleteSig case\n        -- See Trac #14643\n       ; (subst, tvs') <- newMetaTyVarTyVars tvs\n                         -- Why newMetaTyVarTyVars?  See TcBinds\n                         -- Note [Quantified variables in partial type signatures]\n       ; let tv_prs = tv_names `zip` tvs'\n             inst_sig = TISI { sig_inst_sig   = hs_sig\n                             , sig_inst_skols = tv_prs\n                             , sig_inst_wcs   = wcs\n                             , sig_inst_wcx   = wcx\n                             , sig_inst_theta = substTys subst theta\n                             , sig_inst_tau   = substTy  subst tau }\n       ; traceTc \"End partial sig }\" (ppr inst_sig)\n       ; return inst_sig }\n\n\n{- Note [Pattern bindings and complete signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n      data T a = MkT a a\n      f :: forall a. a->a\n      g :: forall b. b->b\n      MkT f g = MkT (\\x->x) (\\y->y)\nHere we'll infer a type from the pattern of 'T a', but if we feed in\nthe signature types for f and g, we'll end up unifying 'a' and 'b'\n\nSo we instantiate f and g's signature with TyVarTv skolems\n(newMetaTyVarTyVars) that can unify with each other.  If too much\nunification takes place, we'll find out when we do the final\nimpedance-matching check in TcBinds.mkExport\n\nSee Note [Signature skolems] in TcType\n\nNone of this applies to a function binding with a complete\nsignature, which doesn't use tcInstSig.  See TcBinds.tcPolyCheck.\n-}\n\n{- *********************************************************************\n*                                                                      *\n                   Pragmas and PragEnv\n*                                                                      *\n********************************************************************* -}\n\ntype TcPragEnv = NameEnv [LSig GhcRn]\n\nemptyPragEnv :: TcPragEnv\nemptyPragEnv = emptyNameEnv\n\nlookupPragEnv :: TcPragEnv -> Name -> [LSig GhcRn]\nlookupPragEnv prag_fn n = lookupNameEnv prag_fn n `orElse` []\n\nextendPragEnv :: TcPragEnv -> (Name, LSig GhcRn) -> TcPragEnv\nextendPragEnv prag_fn (n, sig) = extendNameEnv_Acc (:) singleton prag_fn n sig\n\n---------------\nmkPragEnv :: [LSig GhcRn] -> LHsBinds GhcRn -> TcPragEnv\nmkPragEnv sigs binds\n  = foldl' extendPragEnv emptyNameEnv prs\n  where\n    prs = mapMaybe get_sig sigs\n\n    get_sig :: LSig GhcRn -> Maybe (Name, LSig GhcRn)\n    get_sig (L l (SpecSig x lnm@(L _ nm) ty inl))\n      = Just (nm, L l $ SpecSig   x lnm ty (add_arity nm inl))\n    get_sig (L l (InlineSig x lnm@(L _ nm) inl))\n      = Just (nm, L l $ InlineSig x lnm    (add_arity nm inl))\n    get_sig (L l (SCCFunSig x st lnm@(L _ nm) str))\n      = Just (nm, L l $ SCCFunSig x st lnm str)\n    get_sig _ = Nothing\n\n    add_arity n inl_prag   -- Adjust inl_sat field to match visible arity of function\n      | Inline <- inl_inline inl_prag\n        -- add arity only for real INLINE pragmas, not INLINABLE\n      = case lookupNameEnv ar_env n of\n          Just ar -> inl_prag { inl_sat = Just ar }\n          Nothing -> WARN( True, text \"mkPragEnv no arity\" <+> ppr n )\n                     -- There really should be a binding for every INLINE pragma\n                     inl_prag\n      | otherwise\n      = inl_prag\n\n    -- ar_env maps a local to the arity of its definition\n    ar_env :: NameEnv Arity\n    ar_env = foldrBag lhsBindArity emptyNameEnv binds\n\nlhsBindArity :: LHsBind GhcRn -> NameEnv Arity -> NameEnv Arity\nlhsBindArity (L _ (FunBind { fun_id = id, fun_matches = ms })) env\n  = extendNameEnv env (unLoc id) (matchGroupArity ms)\nlhsBindArity _ env = env        -- PatBind/VarBind\n\n\n-----------------\naddInlinePrags :: TcId -> [LSig GhcRn] -> TcM TcId\naddInlinePrags poly_id prags_for_me\n  | inl@(L _ prag) : inls <- inl_prags\n  = do { traceTc \"addInlinePrag\" (ppr poly_id $$ ppr prag)\n       ; unless (null inls) (warn_multiple_inlines inl inls)\n       ; return (poly_id `setInlinePragma` prag) }\n  | otherwise\n  = return poly_id\n  where\n    inl_prags = [L loc prag | L loc (InlineSig _ _ prag) <- prags_for_me]\n\n    warn_multiple_inlines _ [] = return ()\n\n    warn_multiple_inlines inl1@(L loc prag1) (inl2@(L _ prag2) : inls)\n       | inlinePragmaActivation prag1 == inlinePragmaActivation prag2\n       , noUserInlineSpec (inlinePragmaSpec prag1)\n       =    -- Tiresome: inl1 is put there by virtue of being in a hs-boot loop\n            -- and inl2 is a user NOINLINE pragma; we don't want to complain\n         warn_multiple_inlines inl2 inls\n       | otherwise\n       = setSrcSpan loc $\n         addWarnTc NoReason\n                     (hang (text \"Multiple INLINE pragmas for\" <+> ppr poly_id)\n                       2 (vcat (text \"Ignoring all but the first\"\n                                : map pp_inl (inl1:inl2:inls))))\n\n    pp_inl (L loc prag) = ppr prag <+> parens (ppr loc)\n\n\n{- *********************************************************************\n*                                                                      *\n                   SPECIALISE pragmas\n*                                                                      *\n************************************************************************\n\nNote [Handling SPECIALISE pragmas]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe basic idea is this:\n\n   foo :: Num a => a -> b -> a\n   {-# SPECIALISE foo :: Int -> b -> Int #-}\n\nWe check that\n   (forall a b. Num a => a -> b -> a)\n      is more polymorphic than\n   forall b. Int -> b -> Int\n(for which we could use tcSubType, but see below), generating a HsWrapper\nto connect the two, something like\n      wrap = /\\b. <hole> Int b dNumInt\nThis wrapper is put in the TcSpecPrag, in the ABExport record of\nthe AbsBinds.\n\n\n        f :: (Eq a, Ix b) => a -> b -> Bool\n        {-# SPECIALISE f :: (Ix p, Ix q) => Int -> (p,q) -> Bool #-}\n        f = <poly_rhs>\n\nFrom this the typechecker generates\n\n    AbsBinds [ab] [d1,d2] [([ab], f, f_mono, prags)] binds\n\n    SpecPrag (wrap_fn :: forall a b. (Eq a, Ix b) => XXX\n                      -> forall p q. (Ix p, Ix q) => XXX[ Int/a, (p,q)/b ])\n\nFrom these we generate:\n\n    Rule:       forall p, q, (dp:Ix p), (dq:Ix q).\n                    f Int (p,q) dInt ($dfInPair dp dq) = f_spec p q dp dq\n\n    Spec bind:  f_spec = wrap_fn <poly_rhs>\n\nNote that\n\n  * The LHS of the rule may mention dictionary *expressions* (eg\n    $dfIxPair dp dq), and that is essential because the dp, dq are\n    needed on the RHS.\n\n  * The RHS of f_spec, <poly_rhs> has a *copy* of 'binds', so that it\n    can fully specialise it.\n\n\n\nFrom the TcSpecPrag, in DsBinds we generate a binding for f_spec and a RULE:\n\n   f_spec :: Int -> b -> Int\n   f_spec = wrap<f rhs>\n\n   RULE: forall b (d:Num b). f b d = f_spec b\n\nThe RULE is generated by taking apart the HsWrapper, which is a little\ndelicate, but works.\n\nSome wrinkles\n\n1. We don't use full-on tcSubType, because that does co and contra\n   variance and that in turn will generate too complex a LHS for the\n   RULE.  So we use a single invocation of skolemise /\n   topInstantiate in tcSpecWrapper.  (Actually I think that even\n   the \"deeply\" stuff may be too much, because it introduces lambdas,\n   though I think it can be made to work without too much trouble.)\n\n2. We need to take care with type families (Trac #5821).  Consider\n      type instance F Int = Bool\n      f :: Num a => a -> F a\n      {-# SPECIALISE foo :: Int -> Bool #-}\n\n  We *could* try to generate an f_spec with precisely the declared type:\n      f_spec :: Int -> Bool\n      f_spec = <f rhs> Int dNumInt |> co\n\n      RULE: forall d. f Int d = f_spec |> sym co\n\n  but the 'co' and 'sym co' are (a) playing no useful role, and (b) are\n  hard to generate.  At all costs we must avoid this:\n      RULE: forall d. f Int d |> co = f_spec\n  because the LHS will never match (indeed it's rejected in\n  decomposeRuleLhs).\n\n  So we simply do this:\n    - Generate a constraint to check that the specialised type (after\n      skolemiseation) is equal to the instantiated function type.\n    - But *discard* the evidence (coercion) for that constraint,\n      so that we ultimately generate the simpler code\n          f_spec :: Int -> F Int\n          f_spec = <f rhs> Int dNumInt\n\n          RULE: forall d. f Int d = f_spec\n      You can see this discarding happening in\n\n3. Note that the HsWrapper can transform *any* function with the right\n   type prefix\n       forall ab. (Eq a, Ix b) => XXX\n   regardless of XXX.  It's sort of polymorphic in XXX.  This is\n   useful: we use the same wrapper to transform each of the class ops, as\n   well as the dict.  That's what goes on in TcInstDcls.mk_meth_spec_prags\n-}\n\ntcSpecPrags :: Id -> [LSig GhcRn]\n            -> TcM [LTcSpecPrag]\n-- Add INLINE and SPECIALSE pragmas\n--    INLINE prags are added to the (polymorphic) Id directly\n--    SPECIALISE prags are passed to the desugarer via TcSpecPrags\n-- Pre-condition: the poly_id is zonked\n-- Reason: required by tcSubExp\ntcSpecPrags poly_id prag_sigs\n  = do { traceTc \"tcSpecPrags\" (ppr poly_id <+> ppr spec_sigs)\n       ; unless (null bad_sigs) warn_discarded_sigs\n       ; pss <- mapAndRecoverM (wrapLocM (tcSpecPrag poly_id)) spec_sigs\n       ; return $ concatMap (\\(L l ps) -> map (L l) ps) pss }\n  where\n    spec_sigs = filter isSpecLSig prag_sigs\n    bad_sigs  = filter is_bad_sig prag_sigs\n    is_bad_sig s = not (isSpecLSig s || isInlineLSig s || isSCCFunSig s)\n\n    warn_discarded_sigs\n      = addWarnTc NoReason\n                  (hang (text \"Discarding unexpected pragmas for\" <+> ppr poly_id)\n                      2 (vcat (map (ppr . getLoc) bad_sigs)))\n\n--------------\ntcSpecPrag :: TcId -> Sig GhcRn -> TcM [TcSpecPrag]\ntcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl)\n-- See Note [Handling SPECIALISE pragmas]\n--\n-- The Name fun_name in the SpecSig may not be the same as that of the poly_id\n-- Example: SPECIALISE for a class method: the Name in the SpecSig is\n--          for the selector Id, but the poly_id is something like $cop\n-- However we want to use fun_name in the error message, since that is\n-- what the user wrote (Trac #8537)\n  = addErrCtxt (spec_ctxt prag) $\n    do  { warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl))\n                 (text \"SPECIALISE pragma for non-overloaded function\"\n                  <+> quotes (ppr fun_name))\n                  -- Note [SPECIALISE pragmas]\n        ; spec_prags <- mapM tc_one hs_tys\n        ; traceTc \"tcSpecPrag\" (ppr poly_id $$ nest 2 (vcat (map ppr spec_prags)))\n        ; return spec_prags }\n  where\n    name      = idName poly_id\n    poly_ty   = idType poly_id\n    spec_ctxt prag = hang (text \"In the SPECIALISE pragma\") 2 (ppr prag)\n\n    tc_one hs_ty\n      = do { spec_ty <- tcHsSigType   (FunSigCtxt name False) hs_ty\n           ; wrap    <- tcSpecWrapper (FunSigCtxt name True)  poly_ty spec_ty\n           ; return (SpecPrag poly_id wrap inl) }\n\ntcSpecPrag _ prag = pprPanic \"tcSpecPrag\" (ppr prag)\n\n--------------\ntcSpecWrapper :: UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper\n-- A simpler variant of tcSubType, used for SPECIALISE pragmas\n-- See Note [Handling SPECIALISE pragmas], wrinkle 1\ntcSpecWrapper ctxt poly_ty spec_ty\n  = do { (sk_wrap, inst_wrap)\n               <- tcSkolemise ctxt spec_ty $ \\ _ spec_tau ->\n                  do { (inst_wrap, tau) <- topInstantiate orig poly_ty\n                     ; _ <- unifyType Nothing spec_tau tau\n                            -- Deliberately ignore the evidence\n                            -- See Note [Handling SPECIALISE pragmas],\n                            --   wrinkle (2)\n                     ; return inst_wrap }\n       ; return (sk_wrap <.> inst_wrap) }\n  where\n    orig = SpecPragOrigin ctxt\n\n--------------\ntcImpPrags :: [LSig GhcRn] -> TcM [LTcSpecPrag]\n-- SPECIALISE pragmas for imported things\ntcImpPrags prags\n  = do { this_mod <- getModule\n       ; dflags <- getDynFlags\n       ; if (not_specialising dflags) then\n            return []\n         else do\n            { pss <- mapAndRecoverM (wrapLocM tcImpSpec)\n                     [L loc (name,prag)\n                             | (L loc prag@(SpecSig _ (L _ name) _ _)) <- prags\n                             , not (nameIsLocalOrFrom this_mod name) ]\n            ; return $ concatMap (\\(L l ps) -> map (L l) ps) pss } }\n  where\n    -- Ignore SPECIALISE pragmas for imported things\n    -- when we aren't specialising, or when we aren't generating\n    -- code.  The latter happens when Haddocking the base library;\n    -- we don't want complaints about lack of INLINABLE pragmas\n    not_specialising dflags\n      | not (gopt Opt_Specialise dflags) = True\n      | otherwise = case hscTarget dflags of\n                      HscNothing -> True\n                      HscInterpreted -> True\n                      _other         -> False\n\ntcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag]\ntcImpSpec (name, prag)\n = do { id <- tcLookupId name\n      ; unless (isAnyInlinePragma (idInlinePragma id))\n               (addWarnTc NoReason (impSpecErr name))\n      ; tcSpecPrag id prag }\n\nimpSpecErr :: Name -> SDoc\nimpSpecErr name\n  = hang (text \"You cannot SPECIALISE\" <+> quotes (ppr name))\n       2 (vcat [ text \"because its definition has no INLINE/INLINABLE pragma\"\n               , parens $ sep\n                   [ text \"or its defining module\" <+> quotes (ppr mod)\n                   , text \"was compiled without -O\"]])\n  where\n    mod = nameModule name\n", "num_lines": 837}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule TcSimplify(\n       simplifyInfer, InferMode(..),\n       growThetaTyVars,\n       simplifyAmbiguityCheck,\n       simplifyDefault,\n       simplifyTop, simplifyTopImplic,\n       simplifyInteractive,\n       solveEqualities, solveLocalEqualities, solveLocalEqualitiesX,\n       simplifyWantedsTcM,\n       tcCheckSatisfiability,\n       tcNormalise,\n\n       captureTopConstraints,\n\n       simpl_top,\n\n       promoteTyVar,\n       promoteTyVarSet,\n\n       -- For Rules we need these\n       solveWanteds, solveWantedsAndDrop,\n       approximateWC, runTcSDeriveds\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Bag\nimport Class         ( Class, classKey, classTyCon )\nimport DynFlags      ( WarningFlag ( Opt_WarnMonomorphism )\n                     , WarnReason ( Reason )\n                     , DynFlags( solverIterations ) )\nimport HsExpr        ( UnboundVar(..) )\nimport Id            ( idType, mkLocalId )\nimport Inst\nimport ListSetOps\nimport Name\nimport Outputable\nimport PrelInfo\nimport PrelNames\nimport RdrName       ( emptyGlobalRdrEnv )\nimport TcErrors\nimport TcEvidence\nimport TcInteract\nimport TcCanonical   ( makeSuperClasses, solveCallStack )\nimport TcMType   as TcM\nimport TcRnMonad as TcM\nimport TcSMonad  as TcS\nimport TcType\nimport TrieMap       () -- DV: for now\nimport Type\nimport TysWiredIn    ( liftedRepTy )\nimport Unify         ( tcMatchTyKi )\nimport Util\nimport Var\nimport VarSet\nimport UniqSet\nimport BasicTypes    ( IntWithInf, intGtLimit )\nimport ErrUtils      ( emptyMessages )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Data.Foldable      ( toList )\nimport Data.List          ( partition )\nimport Data.List.NonEmpty ( NonEmpty(..) )\nimport Maybes             ( isJust )\n\n{-\n*********************************************************************************\n*                                                                               *\n*                           External interface                                  *\n*                                                                               *\n*********************************************************************************\n-}\n\ncaptureTopConstraints :: TcM a -> TcM (a, WantedConstraints)\n-- (captureTopConstraints m) runs m, and returns the type constraints it\n-- generates plus the constraints produced by static forms inside.\n-- If it fails with an exception, it reports any insolubles\n-- (out of scope variables) before doing so\n-- NB: bring any environments into scope before calling this, so that\n-- the reportUnsolved has access to the most complete GlobalRdrEnv\ncaptureTopConstraints thing_inside\n  = do { static_wc_var <- TcM.newTcRef emptyWC ;\n       ; (mb_res, lie) <- TcM.updGblEnv (\\env -> env { tcg_static_wc = static_wc_var } ) $\n                          TcM.tryCaptureConstraints thing_inside\n       ; stWC <- TcM.readTcRef static_wc_var\n\n       -- See TcRnMonad Note [Constraints and errors]\n       -- If the thing_inside threw an exception, but generated some insoluble\n       -- constraints, report the latter before propagating the exception\n       -- Otherwise they will be lost altogether\n       ; case mb_res of\n           Right res -> return (res, lie `andWC` stWC)\n           Left {}   -> do { _ <- reportUnsolved lie; failM } }\n                -- This call to reportUnsolved is the reason\n                -- this function is here instead of TcRnMonad\n\nsimplifyTopImplic :: Bag Implication -> TcM ()\nsimplifyTopImplic implics\n  = do { empty_binds <- simplifyTop (mkImplicWC implics)\n\n       -- Since all the inputs are implications the returned bindings will be empty\n       ; MASSERT2( isEmptyBag empty_binds, ppr empty_binds )\n\n       ; return () }\n\nsimplifyTop :: WantedConstraints -> TcM (Bag EvBind)\n-- Simplify top-level constraints\n-- Usually these will be implications,\n-- but when there is nothing to quantify we don't wrap\n-- in a degenerate implication, so we do that here instead\nsimplifyTop wanteds\n  = do { traceTc \"simplifyTop {\" $ text \"wanted = \" <+> ppr wanteds\n       ; ((final_wc, unsafe_ol), binds1) <- runTcS $\n            do { final_wc <- simpl_top wanteds\n               ; unsafe_ol <- getSafeOverlapFailures\n               ; return (final_wc, unsafe_ol) }\n       ; traceTc \"End simplifyTop }\" empty\n\n       ; binds2 <- reportUnsolved final_wc\n\n       ; traceTc \"reportUnsolved (unsafe overlapping) {\" empty\n       ; unless (isEmptyCts unsafe_ol) $ do {\n           -- grab current error messages and clear, warnAllUnsolved will\n           -- update error messages which we'll grab and then restore saved\n           -- messages.\n           ; errs_var  <- getErrsVar\n           ; saved_msg <- TcM.readTcRef errs_var\n           ; TcM.writeTcRef errs_var emptyMessages\n\n           ; warnAllUnsolved $ WC { wc_simple = unsafe_ol\n                                  , wc_impl = emptyBag }\n\n           ; whyUnsafe <- fst <$> TcM.readTcRef errs_var\n           ; TcM.writeTcRef errs_var saved_msg\n           ; recordUnsafeInfer whyUnsafe\n           }\n       ; traceTc \"reportUnsolved (unsafe overlapping) }\" empty\n\n       ; return (evBindMapBinds binds1 `unionBags` binds2) }\n\n\n-- | Type-check a thing that emits only equality constraints, solving any\n-- constraints we can and re-emitting constraints that we can't. The thing_inside\n-- should generally bump the TcLevel to make sure that this run of the solver\n-- doesn't affect anything lying around.\nsolveLocalEqualities :: String -> TcM a -> TcM a\nsolveLocalEqualities callsite thing_inside\n  = do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside\n       ; emitConstraints wanted\n\n       -- See Note [Fail fast if there are insoluble kind equalities]\n       ; if insolubleWC wanted\n         then failM\n         else return res }\n\n{- Note [Fail fast if there are insoluble kind equalities]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRather like in simplifyInfer, fail fast if there is an insoluble\nconstraint.  Otherwise we'll just succeed in kind-checking a nonsense\ntype, with a cascade of follow-up errors.\n\nFor example polykinds/T12593, T15577, and many others.\n\nTake care to ensure that you emit the insoluble constraints before\nfailing, because they are what will ulimately lead to the error\nmesssage!\n-}\n\nsolveLocalEqualitiesX :: String -> TcM a -> TcM (WantedConstraints, a)\nsolveLocalEqualitiesX callsite thing_inside\n  = do { traceTc \"solveLocalEqualitiesX {\" (vcat [ text \"Called from\" <+> text callsite ])\n\n       ; (result, wanted) <- captureConstraints thing_inside\n\n       ; traceTc \"solveLocalEqualities: running solver\" (ppr wanted)\n       ; residual_wanted <- runTcSEqualities (solveWanteds wanted)\n\n       ; traceTc \"solveLocalEqualitiesX end }\" $\n         text \"residual_wanted =\" <+> ppr residual_wanted\n\n       ; return (residual_wanted, result) }\n\n-- | Type-check a thing that emits only equality constraints, then\n-- solve those constraints. Fails outright if there is trouble.\n-- Use this if you're not going to get another crack at solving\n-- (because, e.g., you're checking a datatype declaration)\nsolveEqualities :: TcM a -> TcM a\nsolveEqualities thing_inside\n  = checkNoErrs $  -- See Note [Fail fast on kind errors]\n    do { lvl <- TcM.getTcLevel\n       ; traceTc \"solveEqualities {\" (text \"level =\" <+> ppr lvl)\n\n       ; (result, wanted) <- captureConstraints thing_inside\n\n       ; traceTc \"solveEqualities: running solver\" $ text \"wanted = \" <+> ppr wanted\n       ; final_wc <- runTcSEqualities $ simpl_top wanted\n          -- NB: Use simpl_top here so that we potentially default RuntimeRep\n          -- vars to LiftedRep. This is needed to avoid #14991.\n\n       ; traceTc \"End solveEqualities }\" empty\n       ; reportAllUnsolved final_wc\n       ; return result }\n\n-- | Simplify top-level constraints, but without reporting any unsolved\n-- constraints nor unsafe overlapping.\nsimpl_top :: WantedConstraints -> TcS WantedConstraints\n    -- See Note [Top-level Defaulting Plan]\nsimpl_top wanteds\n  = do { wc_first_go <- nestTcS (solveWantedsAndDrop wanteds)\n                            -- This is where the main work happens\n       ; try_tyvar_defaulting wc_first_go }\n  where\n    try_tyvar_defaulting :: WantedConstraints -> TcS WantedConstraints\n    try_tyvar_defaulting wc\n      | isEmptyWC wc\n      = return wc\n      | otherwise\n      = do { free_tvs <- TcS.zonkTyCoVarsAndFVList (tyCoVarsOfWCList wc)\n           ; let meta_tvs = filter (isTyVar <&&> isMetaTyVar) free_tvs\n                   -- zonkTyCoVarsAndFV: the wc_first_go is not yet zonked\n                   -- filter isMetaTyVar: we might have runtime-skolems in GHCi,\n                   -- and we definitely don't want to try to assign to those!\n                   -- The isTyVar is needed to weed out coercion variables\n\n           ; defaulted <- mapM defaultTyVarTcS meta_tvs   -- Has unification side effects\n           ; if or defaulted\n             then do { wc_residual <- nestTcS (solveWanteds wc)\n                            -- See Note [Must simplify after defaulting]\n                     ; try_class_defaulting wc_residual }\n             else try_class_defaulting wc }     -- No defaulting took place\n\n    try_class_defaulting :: WantedConstraints -> TcS WantedConstraints\n    try_class_defaulting wc\n      | isEmptyWC wc\n      = return wc\n      | otherwise  -- See Note [When to do type-class defaulting]\n      = do { something_happened <- applyDefaultingRules wc\n                                   -- See Note [Top-level Defaulting Plan]\n           ; if something_happened\n             then do { wc_residual <- nestTcS (solveWantedsAndDrop wc)\n                     ; try_class_defaulting wc_residual }\n                  -- See Note [Overview of implicit CallStacks] in TcEvidence\n             else try_callstack_defaulting wc }\n\n    try_callstack_defaulting :: WantedConstraints -> TcS WantedConstraints\n    try_callstack_defaulting wc\n      | isEmptyWC wc\n      = return wc\n      | otherwise\n      = defaultCallStacks wc\n\n-- | Default any remaining @CallStack@ constraints to empty @CallStack@s.\ndefaultCallStacks :: WantedConstraints -> TcS WantedConstraints\n-- See Note [Overview of implicit CallStacks] in TcEvidence\ndefaultCallStacks wanteds\n  = do simples <- handle_simples (wc_simple wanteds)\n       mb_implics <- mapBagM handle_implic (wc_impl wanteds)\n       return (wanteds { wc_simple = simples\n                       , wc_impl = catBagMaybes mb_implics })\n\n  where\n\n  handle_simples simples\n    = catBagMaybes <$> mapBagM defaultCallStack simples\n\n  handle_implic :: Implication -> TcS (Maybe Implication)\n  -- The Maybe is because solving the CallStack constraint\n  -- may well allow us to discard the implication entirely\n  handle_implic implic\n    | isSolvedStatus (ic_status implic)\n    = return (Just implic)\n    | otherwise\n    = do { wanteds <- setEvBindsTcS (ic_binds implic) $\n                      -- defaultCallStack sets a binding, so\n                      -- we must set the correct binding group\n                      defaultCallStacks (ic_wanted implic)\n         ; setImplicationStatus (implic { ic_wanted = wanteds }) }\n\n  defaultCallStack ct\n    | ClassPred cls tys <- classifyPredType (ctPred ct)\n    , Just {} <- isCallStackPred cls tys\n    = do { solveCallStack (ctEvidence ct) EvCsEmpty\n         ; return Nothing }\n\n  defaultCallStack ct\n    = return (Just ct)\n\n\n{- Note [Fail fast on kind errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nsolveEqualities is used to solve kind equalities when kind-checking\nuser-written types. If solving fails we should fail outright, rather\nthan just accumulate an error message, for two reasons:\n\n  * A kind-bogus type signature may cause a cascade of knock-on\n    errors if we let it pass\n\n  * More seriously, we don't have a convenient term-level place to add\n    deferred bindings for unsolved kind-equality constraints, so we\n    don't build evidence bindings (by usine reportAllUnsolved). That\n    means that we'll be left with with a type that has coercion holes\n    in it, something like\n           <type> |> co-hole\n    where co-hole is not filled in.  Eeek!  That un-filled-in\n    hole actually causes GHC to crash with \"fvProv falls into a hole\"\n    See Trac #11563, #11520, #11516, #11399\n\nSo it's important to use 'checkNoErrs' here!\n\nNote [When to do type-class defaulting]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn GHC 7.6 and 7.8.2, we did type-class defaulting only if insolubleWC\nwas false, on the grounds that defaulting can't help solve insoluble\nconstraints.  But if we *don't* do defaulting we may report a whole\nlot of errors that would be solved by defaulting; these errors are\nquite spurious because fixing the single insoluble error means that\ndefaulting happens again, which makes all the other errors go away.\nThis is jolly confusing: Trac #9033.\n\nSo it seems better to always do type-class defaulting.\n\nHowever, always doing defaulting does mean that we'll do it in\nsituations like this (Trac #5934):\n   run :: (forall s. GenST s) -> Int\n   run = fromInteger 0\nWe don't unify the return type of fromInteger with the given function\ntype, because the latter involves foralls.  So we're left with\n    (Num alpha, alpha ~ (forall s. GenST s) -> Int)\nNow we do defaulting, get alpha := Integer, and report that we can't\nmatch Integer with (forall s. GenST s) -> Int.  That's not totally\nstupid, but perhaps a little strange.\n\nAnother potential alternative would be to suppress *all* non-insoluble\nerrors if there are *any* insoluble errors, anywhere, but that seems\ntoo drastic.\n\nNote [Must simplify after defaulting]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe may have a deeply buried constraint\n    (t:*) ~ (a:Open)\nwhich we couldn't solve because of the kind incompatibility, and 'a' is free.\nThen when we default 'a' we can solve the constraint.  And we want to do\nthat before starting in on type classes.  We MUST do it before reporting\nerrors, because it isn't an error!  Trac #7967 was due to this.\n\nNote [Top-level Defaulting Plan]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe have considered two design choices for where/when to apply defaulting.\n   (i) Do it in SimplCheck mode only /whenever/ you try to solve some\n       simple constraints, maybe deep inside the context of implications.\n       This used to be the case in GHC 7.4.1.\n   (ii) Do it in a tight loop at simplifyTop, once all other constraints have\n        finished. This is the current story.\n\nOption (i) had many disadvantages:\n   a) Firstly, it was deep inside the actual solver.\n   b) Secondly, it was dependent on the context (Infer a type signature,\n      or Check a type signature, or Interactive) since we did not want\n      to always start defaulting when inferring (though there is an exception to\n      this, see Note [Default while Inferring]).\n   c) It plainly did not work. Consider typecheck/should_compile/DfltProb2.hs:\n          f :: Int -> Bool\n          f x = const True (\\y -> let w :: a -> a\n                                      w a = const a (y+1)\n                                  in w y)\n      We will get an implication constraint (for beta the type of y):\n               [untch=beta] forall a. 0 => Num beta\n      which we really cannot default /while solving/ the implication, since beta is\n      untouchable.\n\nInstead our new defaulting story is to pull defaulting out of the solver loop and\ngo with option (ii), implemented at SimplifyTop. Namely:\n     - First, have a go at solving the residual constraint of the whole\n       program\n     - Try to approximate it with a simple constraint\n     - Figure out derived defaulting equations for that simple constraint\n     - Go round the loop again if you did manage to get some equations\n\nNow, that has to do with class defaulting. However there exists type variable /kind/\ndefaulting. Again this is done at the top-level and the plan is:\n     - At the top-level, once you had a go at solving the constraint, do\n       figure out /all/ the touchable unification variables of the wanted constraints.\n     - Apply defaulting to their kinds\n\nMore details in Note [DefaultTyVar].\n\nNote [Safe Haskell Overlapping Instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn Safe Haskell, we apply an extra restriction to overlapping instances. The\nmotive is to prevent untrusted code provided by a third-party, changing the\nbehavior of trusted code through type-classes. This is due to the global and\nimplicit nature of type-classes that can hide the source of the dictionary.\n\nAnother way to state this is: if a module M compiles without importing another\nmodule N, changing M to import N shouldn't change the behavior of M.\n\nOverlapping instances with type-classes can violate this principle. However,\noverlapping instances aren't always unsafe. They are just unsafe when the most\nselected dictionary comes from untrusted code (code compiled with -XSafe) and\noverlaps instances provided by other modules.\n\nIn particular, in Safe Haskell at a call site with overlapping instances, we\napply the following rule to determine if it is a 'unsafe' overlap:\n\n 1) Most specific instance, I1, defined in an `-XSafe` compiled module.\n 2) I1 is an orphan instance or a MPTC.\n 3) At least one overlapped instance, Ix, is both:\n    A) from a different module than I1\n    B) Ix is not marked `OVERLAPPABLE`\n\nThis is a slightly involved heuristic, but captures the situation of an\nimported module N changing the behavior of existing code. For example, if\ncondition (2) isn't violated, then the module author M must depend either on a\ntype-class or type defined in N.\n\nSecondly, when should these heuristics be enforced? We enforced them when the\ntype-class method call site is in a module marked `-XSafe` or `-XTrustworthy`.\nThis allows `-XUnsafe` modules to operate without restriction, and for Safe\nHaskell inferrence to infer modules with unsafe overlaps as unsafe.\n\nOne alternative design would be to also consider if an instance was imported as\na `safe` import or not and only apply the restriction to instances imported\nsafely. However, since instances are global and can be imported through more\nthan one path, this alternative doesn't work.\n\nNote [Safe Haskell Overlapping Instances Implementation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nHow is this implemented? It's complicated! So we'll step through it all:\n\n 1) `InstEnv.lookupInstEnv` -- Performs instance resolution, so this is where\n    we check if a particular type-class method call is safe or unsafe. We do this\n    through the return type, `ClsInstLookupResult`, where the last parameter is a\n    list of instances that are unsafe to overlap. When the method call is safe,\n    the list is null.\n\n 2) `TcInteract.matchClassInst` -- This module drives the instance resolution\n    / dictionary generation. The return type is `ClsInstResult`, which either\n    says no instance matched, or one found, and if it was a safe or unsafe\n    overlap.\n\n 3) `TcInteract.doTopReactDict` -- Takes a dictionary / class constraint and\n     tries to resolve it by calling (in part) `matchClassInst`. The resolving\n     mechanism has a work list (of constraints) that it process one at a time. If\n     the constraint can't be resolved, it's added to an inert set. When compiling\n     an `-XSafe` or `-XTrustworthy` module, we follow this approach as we know\n     compilation should fail. These are handled as normal constraint resolution\n     failures from here-on (see step 6).\n\n     Otherwise, we may be inferring safety (or using `-Wunsafe`), and\n     compilation should succeed, but print warnings and/or mark the compiled module\n     as `-XUnsafe`. In this case, we call `insertSafeOverlapFailureTcS` which adds\n     the unsafe (but resolved!) constraint to the `inert_safehask` field of\n     `InertCans`.\n\n 4) `TcSimplify.simplifyTop`:\n       * Call simpl_top, the top-level function for driving the simplifier for\n         constraint resolution.\n\n       * Once finished, call `getSafeOverlapFailures` to retrieve the\n         list of overlapping instances that were successfully resolved,\n         but unsafe. Remember, this is only applicable for generating warnings\n         (`-Wunsafe`) or inferring a module unsafe. `-XSafe` and `-XTrustworthy`\n         cause compilation failure by not resolving the unsafe constraint at all.\n\n       * For unresolved constraints (all types), call `TcErrors.reportUnsolved`,\n         while for resolved but unsafe overlapping dictionary constraints, call\n         `TcErrors.warnAllUnsolved`. Both functions convert constraints into a\n         warning message for the user.\n\n       * In the case of `warnAllUnsolved` for resolved, but unsafe\n         dictionary constraints, we collect the generated warning\n         message (pop it) and call `TcRnMonad.recordUnsafeInfer` to\n         mark the module we are compiling as unsafe, passing the\n         warning message along as the reason.\n\n 5) `TcErrors.*Unsolved` -- Generates error messages for constraints by\n    actually calling `InstEnv.lookupInstEnv` again! Yes, confusing, but all we\n    know is the constraint that is unresolved or unsafe. For dictionary, all we\n    know is that we need a dictionary of type C, but not what instances are\n    available and how they overlap. So we once again call `lookupInstEnv` to\n    figure that out so we can generate a helpful error message.\n\n 6) `TcRnMonad.recordUnsafeInfer` -- Save the unsafe result and reason in an\n      IORef called `tcg_safeInfer`.\n\n 7) `HscMain.tcRnModule'` -- Reads `tcg_safeInfer` after type-checking, calling\n    `HscMain.markUnsafeInfer` (passing the reason along) when safe-inferrence\n    failed.\n\nNote [No defaulting in the ambiguity check]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen simplifying constraints for the ambiguity check, we use\nsolveWantedsAndDrop, not simpl_top, so that we do no defaulting.\nTrac #11947 was an example:\n   f :: Num a => Int -> Int\nThis is ambiguous of course, but we don't want to default the\n(Num alpha) constraint to (Num Int)!  Doing so gives a defaulting\nwarning, but no error.\n-}\n\n------------------\nsimplifyAmbiguityCheck :: Type -> WantedConstraints -> TcM ()\nsimplifyAmbiguityCheck ty wanteds\n  = do { traceTc \"simplifyAmbiguityCheck {\" (text \"type = \" <+> ppr ty $$ text \"wanted = \" <+> ppr wanteds)\n       ; (final_wc, _) <- runTcS $ solveWantedsAndDrop wanteds\n             -- NB: no defaulting!  See Note [No defaulting in the ambiguity check]\n\n       ; traceTc \"End simplifyAmbiguityCheck }\" empty\n\n       -- Normally report all errors; but with -XAllowAmbiguousTypes\n       -- report only insoluble ones, since they represent genuinely\n       -- inaccessible code\n       ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes\n       ; traceTc \"reportUnsolved(ambig) {\" empty\n       ; unless (allow_ambiguous && not (insolubleWC final_wc))\n                (discardResult (reportUnsolved final_wc))\n       ; traceTc \"reportUnsolved(ambig) }\" empty\n\n       ; return () }\n\n------------------\nsimplifyInteractive :: WantedConstraints -> TcM (Bag EvBind)\nsimplifyInteractive wanteds\n  = traceTc \"simplifyInteractive\" empty >>\n    simplifyTop wanteds\n\n------------------\nsimplifyDefault :: ThetaType    -- Wanted; has no type variables in it\n                -> TcM ()       -- Succeeds if the constraint is soluble\nsimplifyDefault theta\n  = do { traceTc \"simplifyDefault\" empty\n       ; wanteds  <- newWanteds DefaultOrigin theta\n       ; unsolved <- runTcSDeriveds (solveWantedsAndDrop (mkSimpleWC wanteds))\n       ; reportAllUnsolved unsolved\n       ; return () }\n\n------------------\ntcCheckSatisfiability :: Bag EvVar -> TcM Bool\n-- Return True if satisfiable, False if definitely contradictory\ntcCheckSatisfiability given_ids\n  = do { lcl_env <- TcM.getLclEnv\n       ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env\n       ; (res, _ev_binds) <- runTcS $\n             do { traceTcS \"checkSatisfiability {\" (ppr given_ids)\n                ; let given_cts = mkGivens given_loc (bagToList given_ids)\n                     -- See Note [Superclasses and satisfiability]\n                ; solveSimpleGivens given_cts\n                ; insols <- getInertInsols\n                ; insols <- try_harder insols\n                ; traceTcS \"checkSatisfiability }\" (ppr insols)\n                ; return (isEmptyBag insols) }\n       ; return res }\n where\n    try_harder :: Cts -> TcS Cts\n    -- Maybe we have to search up the superclass chain to find\n    -- an unsatisfiable constraint.  Example: pmcheck/T3927b.\n    -- At the moment we try just once\n    try_harder insols\n      | not (isEmptyBag insols)   -- We've found that it's definitely unsatisfiable\n      = return insols             -- Hurrah -- stop now.\n      | otherwise\n      = do { pending_given <- getPendingGivenScs\n           ; new_given <- makeSuperClasses pending_given\n           ; solveSimpleGivens new_given\n           ; getInertInsols }\n\n-- | Normalise a type as much as possible using the given constraints.\n-- See @Note [tcNormalise]@.\ntcNormalise :: Bag EvVar -> Type -> TcM Type\ntcNormalise given_ids ty\n  = do { lcl_env <- TcM.getLclEnv\n       ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env\n       ; wanted_ct <- mk_wanted_ct\n       ; (res, _ev_binds) <- runTcS $\n             do { traceTcS \"tcNormalise {\" (ppr given_ids)\n                ; let given_cts = mkGivens given_loc (bagToList given_ids)\n                ; solveSimpleGivens given_cts\n                ; wcs <- solveSimpleWanteds (unitBag wanted_ct)\n                  -- It's an invariant that this wc_simple will always be\n                  -- a singleton Ct, since that's what we fed in as input.\n                ; let ty' = case bagToList (wc_simple wcs) of\n                              (ct:_) -> ctEvPred (ctEvidence ct)\n                              cts    -> pprPanic \"tcNormalise\" (ppr cts)\n                ; traceTcS \"tcNormalise }\" (ppr ty')\n                ; pure ty' }\n       ; return res }\n  where\n    mk_wanted_ct :: TcM Ct\n    mk_wanted_ct = do\n      let occ = mkVarOcc \"$tcNorm\"\n      name <- newSysName occ\n      let ev = mkLocalId name ty\n          hole = ExprHole $ OutOfScope occ emptyGlobalRdrEnv\n      newHoleCt hole ev ty\n\n{- Note [Superclasses and satisfiability]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nExpand superclasses before starting, because (Int ~ Bool), has\n(Int ~~ Bool) as a superclass, which in turn has (Int ~N# Bool)\nas a superclass, and it's the latter that is insoluble.  See\nNote [The equality types story] in TysPrim.\n\nIf we fail to prove unsatisfiability we (arbitrarily) try just once to\nfind superclasses, using try_harder.  Reason: we might have a type\nsignature\n   f :: F op (Implements push) => ..\nwhere F is a type function.  This happened in Trac #3972.\n\nWe could do more than once but we'd have to have /some/ limit: in the\nthe recursive case, we would go on forever in the common case where\nthe constraints /are/ satisfiable (Trac #10592 comment:12!).\n\nFor stratightforard situations without type functions the try_harder\nstep does nothing.\n\nNote [tcNormalise]\n~~~~~~~~~~~~~~~~~~\ntcNormalise is a rather atypical entrypoint to the constraint solver. Whereas\nmost invocations of the constraint solver are intended to simplify a set of\nconstraints or to decide if a particular set of constraints is satisfiable,\nthe purpose of tcNormalise is to take a type, plus some local constraints, and\nnormalise the type as much as possible with respect to those constraints.\n\nWhy is this useful? As one example, when coverage-checking an EmptyCase\nexpression, it's possible that the type of the scrutinee will only reduce\nif some local equalities are solved for. See \"Wrinkle: Local equalities\"\nin Note [Type normalisation for EmptyCase] in Check.\n\nTo accomplish its stated goal, tcNormalise first feeds the local constraints\ninto solveSimpleGivens, then stuffs the argument type in a CHoleCan, and feeds\nthat singleton Ct into solveSimpleWanteds, which reduces the type in the\nCHoleCan as much as possible with respect to the local given constraints. When\nsolveSimpleWanteds is finished, we dig out the type from the CHoleCan and\nreturn that.\n\n***********************************************************************************\n*                                                                                 *\n*                            Inference\n*                                                                                 *\n***********************************************************************************\n\nNote [Inferring the type of a let-bound variable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   f x = rhs\n\nTo infer f's type we do the following:\n * Gather the constraints for the RHS with ambient level *one more than*\n   the current one.  This is done by the call\n        pushLevelAndCaptureConstraints (tcMonoBinds...)\n   in TcBinds.tcPolyInfer\n\n * Call simplifyInfer to simplify the constraints and decide what to\n   quantify over. We pass in the level used for the RHS constraints,\n   here called rhs_tclvl.\n\nThis ensures that the implication constraint we generate, if any,\nhas a strictly-increased level compared to the ambient level outside\nthe let binding.\n\n-}\n\n-- | How should we choose which constraints to quantify over?\ndata InferMode = ApplyMR          -- ^ Apply the monomorphism restriction,\n                                  -- never quantifying over any constraints\n               | EagerDefaulting  -- ^ See Note [TcRnExprMode] in TcRnDriver,\n                                  -- the :type +d case; this mode refuses\n                                  -- to quantify over any defaultable constraint\n               | NoRestrictions   -- ^ Quantify over any constraint that\n                                  -- satisfies TcType.pickQuantifiablePreds\n\ninstance Outputable InferMode where\n  ppr ApplyMR         = text \"ApplyMR\"\n  ppr EagerDefaulting = text \"EagerDefaulting\"\n  ppr NoRestrictions  = text \"NoRestrictions\"\n\nsimplifyInfer :: TcLevel               -- Used when generating the constraints\n              -> InferMode\n              -> [TcIdSigInst]         -- Any signatures (possibly partial)\n              -> [(Name, TcTauType)]   -- Variables to be generalised,\n                                       -- and their tau-types\n              -> WantedConstraints\n              -> TcM ([TcTyVar],    -- Quantify over these type variables\n                      [EvVar],      -- ... and these constraints (fully zonked)\n                      TcEvBinds,    -- ... binding these evidence variables\n                      WantedConstraints, -- Redidual as-yet-unsolved constraints\n                      Bool)         -- True <=> the residual constraints are insoluble\n\nsimplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds\n  | isEmptyWC wanteds\n   = do { -- When quantifying, we want to preserve any order of variables as they\n          -- appear in partial signatures. cf. decideQuantifiedTyVars\n          let psig_tv_tys = [ mkTyVarTy tv | sig <- partial_sigs\n                                          , (_,tv) <- sig_inst_skols sig ]\n              psig_theta  = [ pred | sig <- partial_sigs\n                                   , pred <- sig_inst_theta sig ]\n\n       ; gbl_tvs <- tcGetGlobalTyCoVars\n       ; dep_vars <- candidateQTyVarsOfTypes (psig_tv_tys ++ psig_theta ++ map snd name_taus)\n       ; qtkvs <- quantifyTyVars gbl_tvs dep_vars\n       ; traceTc \"simplifyInfer: empty WC\" (ppr name_taus $$ ppr qtkvs)\n       ; return (qtkvs, [], emptyTcEvBinds, emptyWC, False) }\n\n  | otherwise\n  = do { traceTc \"simplifyInfer {\"  $ vcat\n             [ text \"sigs =\" <+> ppr sigs\n             , text \"binds =\" <+> ppr name_taus\n             , text \"rhs_tclvl =\" <+> ppr rhs_tclvl\n             , text \"infer_mode =\" <+> ppr infer_mode\n             , text \"(unzonked) wanted =\" <+> ppr wanteds\n             ]\n\n       ; let psig_theta = concatMap sig_inst_theta partial_sigs\n\n       -- First do full-blown solving\n       -- NB: we must gather up all the bindings from doing\n       -- this solving; hence (runTcSWithEvBinds ev_binds_var).\n       -- And note that since there are nested implications,\n       -- calling solveWanteds will side-effect their evidence\n       -- bindings, so we can't just revert to the input\n       -- constraint.\n\n       ; tc_env          <- TcM.getEnv\n       ; ev_binds_var    <- TcM.newTcEvBinds\n       ; psig_theta_vars <- mapM TcM.newEvVar psig_theta\n       ; wanted_transformed_incl_derivs\n            <- setTcLevel rhs_tclvl $\n               runTcSWithEvBinds ev_binds_var $\n               do { let loc         = mkGivenLoc rhs_tclvl UnkSkol $\n                                      env_lcl tc_env\n                        psig_givens = mkGivens loc psig_theta_vars\n                  ; _ <- solveSimpleGivens psig_givens\n                         -- See Note [Add signature contexts as givens]\n                  ; solveWanteds wanteds }\n\n       -- Find quant_pred_candidates, the predicates that\n       -- we'll consider quantifying over\n       -- NB1: wanted_transformed does not include anything provable from\n       --      the psig_theta; it's just the extra bit\n       -- NB2: We do not do any defaulting when inferring a type, this can lead\n       --      to less polymorphic types, see Note [Default while Inferring]\n       ; wanted_transformed_incl_derivs <- TcM.zonkWC wanted_transformed_incl_derivs\n       ; let definite_error = insolubleWC wanted_transformed_incl_derivs\n                              -- See Note [Quantification with errors]\n                              -- NB: must include derived errors in this test,\n                              --     hence \"incl_derivs\"\n             wanted_transformed = dropDerivedWC wanted_transformed_incl_derivs\n             quant_pred_candidates\n               | definite_error = []\n               | otherwise      = ctsPreds (approximateWC False wanted_transformed)\n\n       -- Decide what type variables and constraints to quantify\n       -- NB: quant_pred_candidates is already fully zonked\n       -- NB: bound_theta are constraints we want to quantify over,\n       --     including the psig_theta, which we always quantify over\n       -- NB: bound_theta are fully zonked\n       ; (qtvs, bound_theta, co_vars) <- decideQuantification infer_mode rhs_tclvl\n                                                     name_taus partial_sigs\n                                                     quant_pred_candidates\n       ; bound_theta_vars <- mapM TcM.newEvVar bound_theta\n\n       -- We must produce bindings for the psig_theta_vars, because we may have\n       -- used them in evidence bindings constructed by solveWanteds earlier\n       -- Easiest way to do this is to emit them as new Wanteds (Trac #14643)\n       ; ct_loc <- getCtLocM AnnOrigin Nothing\n       ; let psig_wanted = [ CtWanted { ctev_pred = idType psig_theta_var\n                                      , ctev_dest = EvVarDest psig_theta_var\n                                      , ctev_nosh = WDeriv\n                                      , ctev_loc  = ct_loc }\n                           | psig_theta_var <- psig_theta_vars ]\n\n       -- Now construct the residual constraint\n       ; residual_wanted <- mkResidualConstraints rhs_tclvl tc_env ev_binds_var\n                                 name_taus co_vars qtvs bound_theta_vars\n                                 (wanted_transformed `andWC` mkSimpleWC psig_wanted)\n\n         -- All done!\n       ; traceTc \"} simplifyInfer/produced residual implication for quantification\" $\n         vcat [ text \"quant_pred_candidates =\" <+> ppr quant_pred_candidates\n              , text \"psig_theta =\" <+> ppr psig_theta\n              , text \"bound_theta =\" <+> ppr bound_theta\n              , text \"qtvs =\"       <+> ppr qtvs\n              , text \"definite_error =\" <+> ppr definite_error ]\n\n       ; return ( qtvs, bound_theta_vars, TcEvBinds ev_binds_var\n                , residual_wanted, definite_error ) }\n         -- NB: bound_theta_vars must be fully zonked\n  where\n    partial_sigs = filter isPartialSig sigs\n\n--------------------\nmkResidualConstraints :: TcLevel -> Env TcGblEnv TcLclEnv -> EvBindsVar\n                      -> [(Name, TcTauType)]\n                      -> VarSet -> [TcTyVar] -> [EvVar]\n                      -> WantedConstraints -> TcM WantedConstraints\n-- Emit the remaining constraints from the RHS.\n-- See Note [Emitting the residual implication in simplifyInfer]\nmkResidualConstraints rhs_tclvl tc_env ev_binds_var\n                        name_taus co_vars qtvs full_theta_vars wanteds\n  | isEmptyWC wanteds\n  = return wanteds\n\n  | otherwise\n  = do { wanted_simple <- TcM.zonkSimples (wc_simple wanteds)\n       ; let (outer_simple, inner_simple) = partitionBag is_mono wanted_simple\n             is_mono ct = isWantedCt ct && ctEvId ct `elemVarSet` co_vars\n\n        ; _ <- promoteTyVarSet (tyCoVarsOfCts outer_simple)\n\n        ; let inner_wanted = wanteds { wc_simple = inner_simple }\n        ; return (WC { wc_simple = outer_simple\n                     , wc_impl   = mk_implic inner_wanted })}\n  where\n    mk_implic inner_wanted\n      | isEmptyWC inner_wanted\n      = emptyBag\n      | otherwise\n      = unitBag (implicationPrototype { ic_tclvl  = rhs_tclvl\n                                      , ic_skols  = qtvs\n                                      , ic_telescope = Nothing\n                                      , ic_given  = full_theta_vars\n                                      , ic_wanted = inner_wanted\n                                      , ic_binds  = ev_binds_var\n                                      , ic_no_eqs = False\n                                      , ic_info   = skol_info\n                                      , ic_env    = tc_env })\n\n    full_theta = map idType full_theta_vars\n    skol_info  = InferSkol [ (name, mkSigmaTy [] full_theta ty)\n                           | (name, ty) <- name_taus ]\n                 -- Don't add the quantified variables here, because\n                 -- they are also bound in ic_skols and we want them\n                 -- to be tidied uniformly\n\n--------------------\nctsPreds :: Cts -> [PredType]\nctsPreds cts = [ ctEvPred ev | ct <- bagToList cts\n                             , let ev = ctEvidence ct ]\n\n{- Note [Emitting the residual implication in simplifyInfer]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n   f = e\nwhere f's type is inferred to be something like (a, Proxy k (Int |> co))\nand we have an as-yet-unsolved, or perhaps insoluble, constraint\n   [W] co :: Type ~ k\nWe can't form types like (forall co. blah), so we can't generalise over\nthe coercion variable, and hence we can't generalise over things free in\nits kind, in the case 'k'.  But we can still generalise over 'a'.  So\nwe'll generalise to\n   f :: forall a. (a, Proxy k (Int |> co))\nNow we do NOT want to form the residual implication constraint\n   forall a. [W] co :: Type ~ k\nbecause then co's eventual binding (which will be a value binding if we\nuse -fdefer-type-errors) won't scope over the entire binding for 'f' (whose\ntype mentions 'co').  Instead, just as we don't generalise over 'co', we\nshould not bury its constraint inside the implication.  Instead, we must\nput it outside.\n\nThat is the reason for the partitionBag in emitResidualConstraints,\nwhich takes the CoVars free in the inferred type, and pulls their\nconstraints out.  (NB: this set of CoVars should be closed-over-kinds.)\n\nAll rather subtle; see Trac #14584.\n\nNote [Add signature contexts as givens]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this (Trac #11016):\n  f2 :: (?x :: Int) => _\n  f2 = ?x\nor this\n  f3 :: a ~ Bool => (a, _)\n  f3 = (True, False)\nor theis\n  f4 :: (Ord a, _) => a -> Bool\n  f4 x = x==x\n\nWe'll use plan InferGen because there are holes in the type.  But:\n * For f2 we want to have the (?x :: Int) constraint floating around\n   so that the functional dependencies kick in.  Otherwise the\n   occurrence of ?x on the RHS produces constraint (?x :: alpha), and\n   we won't unify alpha:=Int.\n * For f3 we want the (a ~ Bool) available to solve the wanted (a ~ Bool)\n   in the RHS\n * For f4 we want to use the (Ord a) in the signature to solve the Eq a\n   constraint.\n\nSolution: in simplifyInfer, just before simplifying the constraints\ngathered from the RHS, add Given constraints for the context of any\ntype signatures.\n\n************************************************************************\n*                                                                      *\n                Quantification\n*                                                                      *\n************************************************************************\n\nNote [Deciding quantification]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf the monomorphism restriction does not apply, then we quantify as follows:\n\n* Step 1. Take the global tyvars, and \"grow\" them using the equality\n  constraints\n     E.g.  if x:alpha is in the environment, and alpha ~ [beta] (which can\n          happen because alpha is untouchable here) then do not quantify over\n          beta, because alpha fixes beta, and beta is effectively free in\n          the environment too\n\n  We also account for the monomorphism restriction; if it applies,\n  add the free vars of all the constraints.\n\n  Result is mono_tvs; we will not quantify over these.\n\n* Step 2. Default any non-mono tyvars (i.e ones that are definitely\n  not going to become further constrained), and re-simplify the\n  candidate constraints.\n\n  Motivation for re-simplification (Trac #7857): imagine we have a\n  constraint (C (a->b)), where 'a :: TYPE l1' and 'b :: TYPE l2' are\n  not free in the envt, and instance forall (a::*) (b::*). (C a) => C\n  (a -> b) The instance doesn't match while l1,l2 are polymorphic, but\n  it will match when we default them to LiftedRep.\n\n  This is all very tiresome.\n\n* Step 3: decide which variables to quantify over, as follows:\n\n  - Take the free vars of the tau-type (zonked_tau_tvs) and \"grow\"\n    them using all the constraints.  These are tau_tvs_plus\n\n  - Use quantifyTyVars to quantify over (tau_tvs_plus - mono_tvs), being\n    careful to close over kinds, and to skolemise the quantified tyvars.\n    (This actually unifies each quantifies meta-tyvar with a fresh skolem.)\n\n  Result is qtvs.\n\n* Step 4: Filter the constraints using pickQuantifiablePreds and the\n  qtvs. We have to zonk the constraints first, so they \"see\" the\n  freshly created skolems.\n\n-}\n\ndecideQuantification\n  :: InferMode\n  -> TcLevel\n  -> [(Name, TcTauType)]   -- Variables to be generalised\n  -> [TcIdSigInst]         -- Partial type signatures (if any)\n  -> [PredType]            -- Candidate theta; already zonked\n  -> TcM ( [TcTyVar]       -- Quantify over these (skolems)\n         , [PredType]      -- and this context (fully zonked)\n         , VarSet)\n-- See Note [Deciding quantification]\ndecideQuantification infer_mode rhs_tclvl name_taus psigs candidates\n  = do { -- Step 1: find the mono_tvs\n       ; (mono_tvs, candidates, co_vars) <- decideMonoTyVars infer_mode\n                                              name_taus psigs candidates\n\n       -- Step 2: default any non-mono tyvars, and re-simplify\n       -- This step may do some unification, but result candidates is zonked\n       ; candidates <- defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates\n\n       -- Step 3: decide which kind/type variables to quantify over\n       ; qtvs <- decideQuantifiedTyVars mono_tvs name_taus psigs candidates\n\n       -- Step 4: choose which of the remaining candidate\n       --         predicates to actually quantify over\n       -- NB: decideQuantifiedTyVars turned some meta tyvars\n       -- into quantified skolems, so we have to zonk again\n       ; candidates <- TcM.zonkTcTypes candidates\n       ; psig_theta <- TcM.zonkTcTypes (concatMap sig_inst_theta psigs)\n       ; let quantifiable_candidates\n               = pickQuantifiablePreds (mkVarSet qtvs) candidates\n             -- NB: do /not/ run pickQuantifiablePreds over psig_theta,\n             -- because we always want to quantify over psig_theta, and not\n             -- drop any of them; e.g. CallStack constraints.  c.f Trac #14658\n\n             theta = mkMinimalBySCs id $  -- See Note [Minimize by Superclasses]\n                     (psig_theta ++ quantifiable_candidates)\n\n       ; traceTc \"decideQuantification\"\n           (vcat [ text \"infer_mode:\" <+> ppr infer_mode\n                 , text \"candidates:\" <+> ppr candidates\n                 , text \"psig_theta:\" <+> ppr psig_theta\n                 , text \"mono_tvs:\"   <+> ppr mono_tvs\n                 , text \"co_vars:\"    <+> ppr co_vars\n                 , text \"qtvs:\"       <+> ppr qtvs\n                 , text \"theta:\"      <+> ppr theta ])\n       ; return (qtvs, theta, co_vars) }\n\n------------------\ndecideMonoTyVars :: InferMode\n                 -> [(Name,TcType)]\n                 -> [TcIdSigInst]\n                 -> [PredType]\n                 -> TcM (TcTyCoVarSet, [PredType], CoVarSet)\n-- Decide which tyvars and covars cannot be generalised:\n--   (a) Free in the environment\n--   (b) Mentioned in a constraint we can't generalise\n--   (c) Connected by an equality to (a) or (b)\n-- Also return CoVars that appear free in the final quatified types\n--   we can't quantify over these, and we must make sure they are in scope\ndecideMonoTyVars infer_mode name_taus psigs candidates\n  = do { (no_quant, maybe_quant) <- pick infer_mode candidates\n\n       -- If possible, we quantify over partial-sig qtvs, so they are\n       -- not mono. Need to zonk them because they are meta-tyvar TyVarTvs\n       ; psig_qtvs <- mapM zonkTcTyVarToTyVar $\n                      concatMap (map snd . sig_inst_skols) psigs\n\n       ; psig_theta <- mapM TcM.zonkTcType $\n                       concatMap sig_inst_theta psigs\n\n       ; taus <- mapM (TcM.zonkTcType . snd) name_taus\n\n       ; mono_tvs0 <- tcGetGlobalTyCoVars\n       ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta\n\n             co_vars = coVarsOfTypes (psig_tys ++ taus)\n             co_var_tvs = closeOverKinds co_vars\n               -- The co_var_tvs are tvs mentioned in the types of covars or\n               -- coercion holes. We can't quantify over these covars, so we\n               -- must include the variable in their types in the mono_tvs.\n               -- E.g.  If we can't quantify over co :: k~Type, then we can't\n               --       quantify over k either!  Hence closeOverKinds\n\n             mono_tvs1 = mono_tvs0 `unionVarSet` co_var_tvs\n\n             eq_constraints = filter isEqPrimPred candidates\n             mono_tvs2      = growThetaTyVars eq_constraints mono_tvs1\n\n             constrained_tvs = (growThetaTyVars eq_constraints\n                                               (tyCoVarsOfTypes no_quant)\n                                `minusVarSet` mono_tvs2)\n                               `delVarSetList` psig_qtvs\n             -- constrained_tvs: the tyvars that we are not going to\n             -- quantify solely because of the moonomorphism restriction\n             --\n             -- (`minusVarSet` mono_tvs1`): a type variable is only\n             --   \"constrained\" (so that the MR bites) if it is not\n             --   free in the environment (Trac #13785)\n             --\n             -- (`delVarSetList` psig_qtvs): if the user has explicitly\n             --   asked for quantification, then that request \"wins\"\n             --   over the MR.  Note: do /not/ delete psig_qtvs from\n             --   mono_tvs1, because mono_tvs1 cannot under any circumstances\n             --   be quantified (Trac #14479); see\n             --   Note [Quantification and partial signatures], Wrinkle 3, 4\n\n             mono_tvs = mono_tvs2 `unionVarSet` constrained_tvs\n\n           -- Warn about the monomorphism restriction\n       ; warn_mono <- woptM Opt_WarnMonomorphism\n       ; when (case infer_mode of { ApplyMR -> warn_mono; _ -> False}) $\n         warnTc (Reason Opt_WarnMonomorphism)\n                (constrained_tvs `intersectsVarSet` tyCoVarsOfTypes taus)\n                mr_msg\n\n       ; traceTc \"decideMonoTyVars\" $ vcat\n           [ text \"mono_tvs0 =\" <+> ppr mono_tvs0\n           , text \"mono_tvs1 =\" <+> ppr mono_tvs1\n           , text \"no_quant =\" <+> ppr no_quant\n           , text \"maybe_quant =\" <+> ppr maybe_quant\n           , text \"eq_constraints =\" <+> ppr eq_constraints\n           , text \"mono_tvs =\" <+> ppr mono_tvs\n           , text \"co_vars =\" <+> ppr co_vars ]\n\n       ; return (mono_tvs, maybe_quant, co_vars) }\n  where\n    pick :: InferMode -> [PredType] -> TcM ([PredType], [PredType])\n    -- Split the candidates into ones we definitely\n    -- won't quantify, and ones that we might\n    pick NoRestrictions  cand = return ([], cand)\n    pick ApplyMR         cand = return (cand, [])\n    pick EagerDefaulting cand = do { os <- xoptM LangExt.OverloadedStrings\n                                   ; return (partition (is_int_ct os) cand) }\n\n    -- For EagerDefaulting, do not quantify over\n    -- over any interactive class constraint\n    is_int_ct ovl_strings pred\n      | Just (cls, _) <- getClassPredTys_maybe pred\n      = isInteractiveClass ovl_strings cls\n      | otherwise\n      = False\n\n    pp_bndrs = pprWithCommas (quotes . ppr . fst) name_taus\n    mr_msg =\n         hang (sep [ text \"The Monomorphism Restriction applies to the binding\"\n                     <> plural name_taus\n                   , text \"for\" <+> pp_bndrs ])\n            2 (hsep [ text \"Consider giving\"\n                    , text (if isSingleton name_taus then \"it\" else \"them\")\n                    , text \"a type signature\"])\n\n-------------------\ndefaultTyVarsAndSimplify :: TcLevel\n                         -> TyCoVarSet\n                         -> [PredType]          -- Assumed zonked\n                         -> TcM [PredType]      -- Guaranteed zonked\n-- Default any tyvar free in the constraints,\n-- and re-simplify in case the defaulting allows further simplification\ndefaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates\n  = do {  -- Promote any tyvars that we cannot generalise\n          -- See Note [Promote momomorphic tyvars]\n       ; traceTc \"decideMonoTyVars: promotion:\" (ppr mono_tvs)\n       ; (prom, _) <- promoteTyVarSet mono_tvs\n\n       -- Default any kind/levity vars\n       ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs}\n                <- candidateQTyVarsOfTypes candidates\n                -- any covars should already be handled by\n                -- the logic in decideMonoTyVars, which looks at\n                -- the constraints generated\n\n       ; poly_kinds  <- xoptM LangExt.PolyKinds\n       ; default_kvs <- mapM (default_one poly_kinds True)\n                             (dVarSetElems cand_kvs)\n       ; default_tvs <- mapM (default_one poly_kinds False)\n                             (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs))\n       ; let some_default = or default_kvs || or default_tvs\n\n       ; case () of\n           _ | some_default -> simplify_cand candidates\n             | prom         -> mapM TcM.zonkTcType candidates\n             | otherwise    -> return candidates\n       }\n  where\n    default_one poly_kinds is_kind_var tv\n      | not (isMetaTyVar tv)\n      = return False\n      | tv `elemVarSet` mono_tvs\n      = return False\n      | otherwise\n      = defaultTyVar (not poly_kinds && is_kind_var) tv\n\n    simplify_cand candidates\n      = do { clone_wanteds <- newWanteds DefaultOrigin candidates\n           ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $\n                                           simplifyWantedsTcM clone_wanteds\n              -- Discard evidence; simples is fully zonked\n\n           ; let new_candidates = ctsPreds simples\n           ; traceTc \"Simplified after defaulting\" $\n                      vcat [ text \"Before:\" <+> ppr candidates\n                           , text \"After:\"  <+> ppr new_candidates ]\n           ; return new_candidates }\n\n------------------\ndecideQuantifiedTyVars\n   :: TyCoVarSet        -- Monomorphic tyvars\n   -> [(Name,TcType)]   -- Annotated theta and (name,tau) pairs\n   -> [TcIdSigInst]     -- Partial signatures\n   -> [PredType]        -- Candidates, zonked\n   -> TcM [TyVar]\n-- Fix what tyvars we are going to quantify over, and quantify them\ndecideQuantifiedTyVars mono_tvs name_taus psigs candidates\n  = do {     -- Why psig_tys? We try to quantify over everything free in here\n             -- See Note [Quantification and partial signatures]\n             --     Wrinkles 2 and 3\n       ; psig_tv_tys <- mapM TcM.zonkTcTyVar [ tv | sig <- psigs\n                                                  , (_,tv) <- sig_inst_skols sig ]\n       ; psig_theta <- mapM TcM.zonkTcType [ pred | sig <- psigs\n                                                  , pred <- sig_inst_theta sig ]\n       ; tau_tys  <- mapM (TcM.zonkTcType . snd) name_taus\n       ; mono_tvs <- TcM.zonkTyCoVarsAndFV mono_tvs\n\n       ; let -- Try to quantify over variables free in these types\n             psig_tys = psig_tv_tys ++ psig_theta\n             seed_tys = psig_tys ++ tau_tys\n\n             -- Now \"grow\" those seeds to find ones reachable via 'candidates'\n             grown_tcvs = growThetaTyVars candidates (tyCoVarsOfTypes seed_tys)\n\n       -- Now we have to classify them into kind variables and type variables\n       -- (sigh) just for the benefit of -XNoPolyKinds; see quantifyTyVars\n       --\n       -- Keep the psig_tys first, so that candidateQTyVarsOfTypes produces\n       -- them in that order, so that the final qtvs quantifies in the same\n       -- order as the partial signatures do (Trac #13524)\n       ; dv@DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} <- candidateQTyVarsOfTypes $\n                                                         psig_tys ++ candidates ++ tau_tys\n       ; let pick     = (`dVarSetIntersectVarSet` grown_tcvs)\n             dvs_plus = dv { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs }\n\n       ; traceTc \"decideQuantifiedTyVars\" (vcat\n           [ text \"candidates =\" <+> ppr candidates\n           , text \"tau_tys =\" <+> ppr tau_tys\n           , text \"seed_tys =\" <+> ppr seed_tys\n           , text \"seed_tcvs =\" <+> ppr (tyCoVarsOfTypes seed_tys)\n           , text \"grown_tcvs =\" <+> ppr grown_tcvs\n           , text \"dvs =\" <+> ppr dvs_plus])\n\n       ; quantifyTyVars mono_tvs dvs_plus }\n\n------------------\ngrowThetaTyVars :: ThetaType -> TyCoVarSet -> TyCoVarSet\n-- See Note [Growing the tau-tvs using constraints]\ngrowThetaTyVars theta tcvs\n  | null theta = tcvs\n  | otherwise  = transCloVarSet mk_next seed_tcvs\n  where\n    seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips\n    (ips, non_ips) = partition isIPPred theta\n                         -- See Note [Inheriting implicit parameters] in TcType\n\n    mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones\n    mk_next so_far = foldr (grow_one so_far) emptyVarSet non_ips\n    grow_one so_far pred tcvs\n       | pred_tcvs `intersectsVarSet` so_far = tcvs `unionVarSet` pred_tcvs\n       | otherwise                           = tcvs\n       where\n         pred_tcvs = tyCoVarsOfType pred\n\n\n{- Note [Promote momomorphic tyvars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPromote any type variables that are free in the environment.  Eg\n   f :: forall qtvs. bound_theta => zonked_tau\nThe free vars of f's type become free in the envt, and hence will show\nup whenever 'f' is called.  They may currently at rhs_tclvl, but they\nhad better be unifiable at the outer_tclvl!  Example: envt mentions\nalpha[1]\n           tau_ty = beta[2] -> beta[2]\n           constraints = alpha ~ [beta]\nwe don't quantify over beta (since it is fixed by envt)\nso we must promote it!  The inferred type is just\n  f :: beta -> beta\n\nNB: promoteTyVar ignores coercion variables\n\nNote [Quantification and partial signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen choosing type variables to quantify, the basic plan is to\nquantify over all type variables that are\n * free in the tau_tvs, and\n * not forced to be monomorphic (mono_tvs),\n   for example by being free in the environment.\n\nHowever, in the case of a partial type signature, be doing inference\n*in the presence of a type signature*. For example:\n   f :: _ -> a\n   f x = ...\nor\n   g :: (Eq _a) => _b -> _b\nIn both cases we use plan InferGen, and hence call simplifyInfer.  But\nthose 'a' variables are skolems (actually TyVarTvs), and we should be\nsure to quantify over them.  This leads to several wrinkles:\n\n* Wrinkle 1.  In the case of a type error\n     f :: _ -> Maybe a\n     f x = True && x\n  The inferred type of 'f' is f :: Bool -> Bool, but there's a\n  left-over error of form (HoleCan (Maybe a ~ Bool)).  The error-reporting\n  machine expects to find a binding site for the skolem 'a', so we\n  add it to the quantified tyvars.\n\n* Wrinkle 2.  Consider the partial type signature\n     f :: (Eq _) => Int -> Int\n     f x = x\n  In normal cases that makes sense; e.g.\n     g :: Eq _a => _a -> _a\n     g x = x\n  where the signature makes the type less general than it could\n  be. But for 'f' we must therefore quantify over the user-annotated\n  constraints, to get\n     f :: forall a. Eq a => Int -> Int\n  (thereby correctly triggering an ambiguity error later).  If we don't\n  we'll end up with a strange open type\n     f :: Eq alpha => Int -> Int\n  which isn't ambiguous but is still very wrong.\n\n  Bottom line: Try to quantify over any variable free in psig_theta,\n  just like the tau-part of the type.\n\n* Wrinkle 3 (Trac #13482). Also consider\n    f :: forall a. _ => Int -> Int\n    f x = if (undefined :: a) == undefined then x else 0\n  Here we get an (Eq a) constraint, but it's not mentioned in the\n  psig_theta nor the type of 'f'.  But we still want to quantify\n  over 'a' even if the monomorphism restriction is on.\n\n* Wrinkle 4 (Trac #14479)\n    foo :: Num a => a -> a\n    foo xxx = g xxx\n      where\n        g :: forall b. Num b => _ -> b\n        g y = xxx + y\n\n  In the signature for 'g', we cannot quantify over 'b' because it turns out to\n  get unified with 'a', which is free in g's environment.  So we carefully\n  refrain from bogusly quantifying, in TcSimplify.decideMonoTyVars.  We\n  report the error later, in TcBinds.chooseInferredQuantifiers.\n\nNote [Growing the tau-tvs using constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(growThetaTyVars insts tvs) is the result of extending the set\n    of tyvars, tvs, using all conceivable links from pred\n\nE.g. tvs = {a}, preds = {H [a] b, K (b,Int) c, Eq e}\nThen growThetaTyVars preds tvs = {a,b,c}\n\nNotice that\n   growThetaTyVars is conservative       if v might be fixed by vs\n                                         => v `elem` grow(vs,C)\n\nNote [Quantification with errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we find that the RHS of the definition has some absolutely-insoluble\nconstraints (including especially \"variable not in scope\"), we\n\n* Abandon all attempts to find a context to quantify over,\n  and instead make the function fully-polymorphic in whatever\n  type we have found\n\n* Return a flag from simplifyInfer, indicating that we found an\n  insoluble constraint.  This flag is used to suppress the ambiguity\n  check for the inferred type, which may well be bogus, and which\n  tends to obscure the real error.  This fix feels a bit clunky,\n  but I failed to come up with anything better.\n\nReasons:\n    - Avoid downstream errors\n    - Do not perform an ambiguity test on a bogus type, which might well\n      fail spuriously, thereby obfuscating the original insoluble error.\n      Trac #14000 is an example\n\nI tried an alternative approach: simply failM, after emitting the\nresidual implication constraint; the exception will be caught in\nTcBinds.tcPolyBinds, which gives all the binders in the group the type\n(forall a. a).  But that didn't work with -fdefer-type-errors, because\nthe recovery from failM emits no code at all, so there is no function\nto run!   But -fdefer-type-errors aspires to produce a runnable program.\n\nNB that we must include *derived* errors in the check for insolubles.\nExample:\n    (a::*) ~ Int#\nWe get an insoluble derived error *~#, and we don't want to discard\nit before doing the isInsolubleWC test!  (Trac #8262)\n\nNote [Default while Inferring]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOur current plan is that defaulting only happens at simplifyTop and\nnot simplifyInfer.  This may lead to some insoluble deferred constraints.\nExample:\n\ninstance D g => C g Int b\n\nconstraint inferred = (forall b. 0 => C gamma alpha b) /\\ Num alpha\ntype inferred       = gamma -> gamma\n\nNow, if we try to default (alpha := Int) we will be able to refine the implication to\n  (forall b. 0 => C gamma Int b)\nwhich can then be simplified further to\n  (forall b. 0 => D gamma)\nFinally, we /can/ approximate this implication with (D gamma) and infer the quantified\ntype:  forall g. D g => g -> g\n\nInstead what will currently happen is that we will get a quantified type\n(forall g. g -> g) and an implication:\n       forall g. 0 => (forall b. 0 => C g alpha b) /\\ Num alpha\n\nWhich, even if the simplifyTop defaults (alpha := Int) we will still be left with an\nunsolvable implication:\n       forall g. 0 => (forall b. 0 => D g)\n\nThe concrete example would be:\n       h :: C g a s => g -> a -> ST s a\n       f (x::gamma) = (\\_ -> x) (runST (h x (undefined::alpha)) + 1)\n\nBut it is quite tedious to do defaulting and resolve the implication constraints, and\nwe have not observed code breaking because of the lack of defaulting in inference, so\nwe don't do it for now.\n\n\n\nNote [Minimize by Superclasses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we quantify over a constraint, in simplifyInfer we need to\nquantify over a constraint that is minimal in some sense: For\ninstance, if the final wanted constraint is (Eq alpha, Ord alpha),\nwe'd like to quantify over Ord alpha, because we can just get Eq alpha\nfrom superclass selection from Ord alpha. This minimization is what\nmkMinimalBySCs does. Then, simplifyInfer uses the minimal constraint\nto check the original wanted.\n\n\nNote [Avoid unnecessary constraint simplification]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    -------- NB NB NB (Jun 12) -------------\n    This note not longer applies; see the notes with Trac #4361.\n    But I'm leaving it in here so we remember the issue.)\n    ----------------------------------------\nWhen inferring the type of a let-binding, with simplifyInfer,\ntry to avoid unnecessarily simplifying class constraints.\nDoing so aids sharing, but it also helps with delicate\nsituations like\n\n   instance C t => C [t] where ..\n\n   f :: C [t] => ....\n   f x = let g y = ...(constraint C [t])...\n         in ...\nWhen inferring a type for 'g', we don't want to apply the\ninstance decl, because then we can't satisfy (C t).  So we\njust notice that g isn't quantified over 't' and partition\nthe constraints before simplifying.\n\nThis only half-works, but then let-generalisation only half-works.\n\n*********************************************************************************\n*                                                                                 *\n*                                 Main Simplifier                                 *\n*                                                                                 *\n***********************************************************************************\n\n-}\n\nsimplifyWantedsTcM :: [CtEvidence] -> TcM WantedConstraints\n-- Solve the specified Wanted constraints\n-- Discard the evidence binds\n-- Discards all Derived stuff in result\n-- Postcondition: fully zonked and unflattened constraints\nsimplifyWantedsTcM wanted\n  = do { traceTc \"simplifyWantedsTcM {\" (ppr wanted)\n       ; (result, _) <- runTcS (solveWantedsAndDrop (mkSimpleWC wanted))\n       ; result <- TcM.zonkWC result\n       ; traceTc \"simplifyWantedsTcM }\" (ppr result)\n       ; return result }\n\nsolveWantedsAndDrop :: WantedConstraints -> TcS WantedConstraints\n-- Since solveWanteds returns the residual WantedConstraints,\n-- it should always be called within a runTcS or something similar,\n-- Result is not zonked\nsolveWantedsAndDrop wanted\n  = do { wc <- solveWanteds wanted\n       ; return (dropDerivedWC wc) }\n\nsolveWanteds :: WantedConstraints -> TcS WantedConstraints\n-- so that the inert set doesn't mindlessly propagate.\n-- NB: wc_simples may be wanted /or/ derived now\nsolveWanteds wc@(WC { wc_simple = simples, wc_impl = implics })\n  = do { cur_lvl <- TcS.getTcLevel\n       ; traceTcS \"solveWanteds {\" $\n         vcat [ text \"Level =\" <+> ppr cur_lvl\n              , ppr wc ]\n\n       ; wc1 <- solveSimpleWanteds simples\n                -- Any insoluble constraints are in 'simples' and so get rewritten\n                -- See Note [Rewrite insolubles] in TcSMonad\n\n       ; (floated_eqs, implics2) <- solveNestedImplications $\n                                    implics `unionBags` wc_impl wc1\n\n       ; dflags   <- getDynFlags\n       ; final_wc <- simpl_loop 0 (solverIterations dflags) floated_eqs\n                                (wc1 { wc_impl = implics2 })\n\n       ; ev_binds_var <- getTcEvBindsVar\n       ; bb <- TcS.getTcEvBindsMap ev_binds_var\n       ; traceTcS \"solveWanteds }\" $\n                 vcat [ text \"final wc =\" <+> ppr final_wc\n                      , text \"current evbinds  =\" <+> ppr (evBindMapBinds bb) ]\n\n       ; return final_wc }\n\nsimpl_loop :: Int -> IntWithInf -> Cts\n           -> WantedConstraints -> TcS WantedConstraints\nsimpl_loop n limit floated_eqs wc@(WC { wc_simple = simples })\n  | n `intGtLimit` limit\n  = do { -- Add an error (not a warning) if we blow the limit,\n         -- Typically if we blow the limit we are going to report some other error\n         -- (an unsolved constraint), and we don't want that error to suppress\n         -- the iteration limit warning!\n         addErrTcS (hang (text \"solveWanteds: too many iterations\"\n                   <+> parens (text \"limit =\" <+> ppr limit))\n                2 (vcat [ text \"Unsolved:\" <+> ppr wc\n                        , ppUnless (isEmptyBag floated_eqs) $\n                          text \"Floated equalities:\" <+> ppr floated_eqs\n                        , text \"Set limit with -fconstraint-solver-iterations=n; n=0 for no limit\"\n                  ]))\n       ; return wc }\n\n  | not (isEmptyBag floated_eqs)\n  = simplify_again n limit True (wc { wc_simple = floated_eqs `unionBags` simples })\n            -- Put floated_eqs first so they get solved first\n            -- NB: the floated_eqs may include /derived/ equalities\n            -- arising from fundeps inside an implication\n\n  | superClassesMightHelp wc\n  = -- We still have unsolved goals, and apparently no way to solve them,\n    -- so try expanding superclasses at this level, both Given and Wanted\n    do { pending_given <- getPendingGivenScs\n       ; let (pending_wanted, simples1) = getPendingWantedScs simples\n       ; if null pending_given && null pending_wanted\n           then return wc  -- After all, superclasses did not help\n           else\n    do { new_given  <- makeSuperClasses pending_given\n       ; new_wanted <- makeSuperClasses pending_wanted\n       ; solveSimpleGivens new_given -- Add the new Givens to the inert set\n       ; simplify_again n limit (null pending_given)\n         wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } }\n\n  | otherwise\n  = return wc\n\nsimplify_again :: Int -> IntWithInf -> Bool\n               -> WantedConstraints -> TcS WantedConstraints\n-- We have definitely decided to have another go at solving\n-- the wanted constraints (we have tried at least once already\nsimplify_again n limit no_new_given_scs\n               wc@(WC { wc_simple = simples, wc_impl = implics })\n  = do { csTraceTcS $\n         text \"simpl_loop iteration=\" <> int n\n         <+> (parens $ hsep [ text \"no new given superclasses =\" <+> ppr no_new_given_scs <> comma\n                            , int (lengthBag simples) <+> text \"simples to solve\" ])\n       ; traceTcS \"simpl_loop: wc =\" (ppr wc)\n\n       ; (unifs1, wc1) <- reportUnifications $\n                          solveSimpleWanteds $\n                          simples\n\n       -- See Note [Cutting off simpl_loop]\n       -- We have already tried to solve the nested implications once\n       -- Try again only if we have unified some meta-variables\n       -- (which is a bit like adding more givens), or we have some\n       -- new Given superclasses\n       ; let new_implics = wc_impl wc1\n       ; if unifs1 == 0       &&\n            no_new_given_scs  &&\n            isEmptyBag new_implics\n\n           then -- Do not even try to solve the implications\n                simpl_loop (n+1) limit emptyBag (wc1 { wc_impl = implics })\n\n           else -- Try to solve the implications\n                do { (floated_eqs2, implics2) <- solveNestedImplications $\n                                                 implics `unionBags` new_implics\n                   ; simpl_loop (n+1) limit floated_eqs2 (wc1 { wc_impl = implics2 })\n    } }\n\nsolveNestedImplications :: Bag Implication\n                        -> TcS (Cts, Bag Implication)\n-- Precondition: the TcS inerts may contain unsolved simples which have\n-- to be converted to givens before we go inside a nested implication.\nsolveNestedImplications implics\n  | isEmptyBag implics\n  = return (emptyBag, emptyBag)\n  | otherwise\n  = do { traceTcS \"solveNestedImplications starting {\" empty\n       ; (floated_eqs_s, unsolved_implics) <- mapAndUnzipBagM solveImplication implics\n       ; let floated_eqs = concatBag floated_eqs_s\n\n       -- ... and we are back in the original TcS inerts\n       -- Notice that the original includes the _insoluble_simples so it was safe to ignore\n       -- them in the beginning of this function.\n       ; traceTcS \"solveNestedImplications end }\" $\n                  vcat [ text \"all floated_eqs =\"  <+> ppr floated_eqs\n                       , text \"unsolved_implics =\" <+> ppr unsolved_implics ]\n\n       ; return (floated_eqs, catBagMaybes unsolved_implics) }\n\nsolveImplication :: Implication    -- Wanted\n                 -> TcS (Cts,      -- All wanted or derived floated equalities: var = type\n                         Maybe Implication) -- Simplified implication (empty or singleton)\n-- Precondition: The TcS monad contains an empty worklist and given-only inerts\n-- which after trying to solve this implication we must restore to their original value\nsolveImplication imp@(Implic { ic_tclvl  = tclvl\n                             , ic_binds  = ev_binds_var\n                             , ic_skols  = skols\n                             , ic_given  = given_ids\n                             , ic_wanted = wanteds\n                             , ic_info   = info\n                             , ic_status = status })\n  | isSolvedStatus status\n  = return (emptyCts, Just imp)  -- Do nothing\n\n  | otherwise  -- Even for IC_Insoluble it is worth doing more work\n               -- The insoluble stuff might be in one sub-implication\n               -- and other unsolved goals in another; and we want to\n               -- solve the latter as much as possible\n  = do { inerts <- getTcSInerts\n       ; traceTcS \"solveImplication {\" (ppr imp $$ text \"Inerts\" <+> ppr inerts)\n\n       -- commented out; see `where` clause below\n       -- ; when debugIsOn check_tc_level\n\n         -- Solve the nested constraints\n       ; (no_given_eqs, given_insols, residual_wanted)\n            <- nestImplicTcS ev_binds_var tclvl $\n               do { let loc    = mkGivenLoc tclvl info (implicLclEnv imp)\n                        givens = mkGivens loc given_ids\n                  ; solveSimpleGivens givens\n\n                  ; residual_wanted <- solveWanteds wanteds\n                        -- solveWanteds, *not* solveWantedsAndDrop, because\n                        -- we want to retain derived equalities so we can float\n                        -- them out in floatEqualities\n\n                  ; (no_eqs, given_insols) <- getNoGivenEqs tclvl skols\n                        -- Call getNoGivenEqs /after/ solveWanteds, because\n                        -- solveWanteds can augment the givens, via expandSuperClasses,\n                        -- to reveal given superclass equalities\n\n                  ; return (no_eqs, given_insols, residual_wanted) }\n\n       ; (floated_eqs, residual_wanted)\n             <- floatEqualities skols given_ids ev_binds_var\n                                no_given_eqs residual_wanted\n\n       ; traceTcS \"solveImplication 2\"\n           (ppr given_insols $$ ppr residual_wanted)\n       ; let final_wanted = residual_wanted `addInsols` given_insols\n             -- Don't lose track of the insoluble givens,\n             -- which signal unreachable code; put them in ic_wanted\n\n       ; res_implic <- setImplicationStatus (imp { ic_no_eqs = no_given_eqs\n                                                 , ic_wanted = final_wanted })\n\n       ; evbinds <- TcS.getTcEvBindsMap ev_binds_var\n       ; tcvs    <- TcS.getTcEvTyCoVars ev_binds_var\n       ; traceTcS \"solveImplication end }\" $ vcat\n             [ text \"no_given_eqs =\" <+> ppr no_given_eqs\n             , text \"floated_eqs =\" <+> ppr floated_eqs\n             , text \"res_implic =\" <+> ppr res_implic\n             , text \"implication evbinds =\" <+> ppr (evBindMapBinds evbinds)\n             , text \"implication tvcs =\" <+> ppr tcvs ]\n\n       ; return (floated_eqs, res_implic) }\n\n  where\n    -- TcLevels must be strictly increasing (see (ImplicInv) in\n    -- Note [TcLevel and untouchable type variables] in TcType),\n    -- and in fact I thinkthey should always increase one level at a time.\n\n    -- Though sensible, this check causes lots of testsuite failures. It is\n    -- remaining commented out for now.\n    {-\n    check_tc_level = do { cur_lvl <- TcS.getTcLevel\n                        ; MASSERT2( tclvl == pushTcLevel cur_lvl , text \"Cur lvl =\" <+> ppr cur_lvl $$ text \"Imp lvl =\" <+> ppr tclvl ) }\n    -}\n\n----------------------\nsetImplicationStatus :: Implication -> TcS (Maybe Implication)\n-- Finalise the implication returned from solveImplication:\n--    * Set the ic_status field\n--    * Trim the ic_wanted field to remove Derived constraints\n-- Precondition: the ic_status field is not already IC_Solved\n-- Return Nothing if we can discard the implication altogether\nsetImplicationStatus implic@(Implic { ic_status     = status\n                                    , ic_info       = info\n                                    , ic_wanted     = wc\n                                    , ic_given      = givens })\n | ASSERT2( not (isSolvedStatus status ), ppr info )\n   -- Precondition: we only set the status if it is not already solved\n   not (isSolvedWC pruned_wc)\n = do { traceTcS \"setImplicationStatus(not-all-solved) {\" (ppr implic)\n\n      ; implic <- neededEvVars implic\n\n      ; let new_status | insolubleWC pruned_wc = IC_Insoluble\n                       | otherwise             = IC_Unsolved\n            new_implic = implic { ic_status = new_status\n                                , ic_wanted = pruned_wc }\n\n      ; traceTcS \"setImplicationStatus(not-all-solved) }\" (ppr new_implic)\n\n      ; return $ Just new_implic }\n\n | otherwise  -- Everything is solved\n              -- Set status to IC_Solved,\n              -- and compute the dead givens and outer needs\n              -- See Note [Tracking redundant constraints]\n = do { traceTcS \"setImplicationStatus(all-solved) {\" (ppr implic)\n\n      ; implic@(Implic { ic_need_inner = need_inner\n                       , ic_need_outer = need_outer }) <- neededEvVars implic\n\n      ; bad_telescope <- checkBadTelescope implic\n\n      ; let dead_givens | warnRedundantGivens info\n                        = filterOut (`elemVarSet` need_inner) givens\n                        | otherwise = []   -- None to report\n\n            discard_entire_implication  -- Can we discard the entire implication?\n              =  null dead_givens           -- No warning from this implication\n              && not bad_telescope\n              && isEmptyWC pruned_wc        -- No live children\n              && isEmptyVarSet need_outer   -- No needed vars to pass up to parent\n\n            final_status\n              | bad_telescope = IC_BadTelescope\n              | otherwise     = IC_Solved { ics_dead = dead_givens }\n            final_implic = implic { ic_status = final_status\n                                  , ic_wanted = pruned_wc }\n\n      ; traceTcS \"setImplicationStatus(all-solved) }\" $\n        vcat [ text \"discard:\" <+> ppr discard_entire_implication\n             , text \"new_implic:\" <+> ppr final_implic ]\n\n      ; return $ if discard_entire_implication\n                 then Nothing\n                 else Just final_implic }\n where\n   WC { wc_simple = simples, wc_impl = implics } = wc\n\n   pruned_simples = dropDerivedSimples simples\n   pruned_implics = filterBag keep_me implics\n   pruned_wc = WC { wc_simple = pruned_simples\n                  , wc_impl   = pruned_implics }\n\n   keep_me :: Implication -> Bool\n   keep_me ic\n     | IC_Solved { ics_dead = dead_givens } <- ic_status ic\n                          -- Fully solved\n     , null dead_givens   -- No redundant givens to report\n     , isEmptyBag (wc_impl (ic_wanted ic))\n           -- And no children that might have things to report\n     = False       -- Tnen we don't need to keep it\n     | otherwise\n     = True        -- Otherwise, keep it\n\ncheckBadTelescope :: Implication -> TcS Bool\n-- True <=> the skolems form a bad telescope\n-- See Note [Keeping scoped variables in order: Explicit] in TcHsType\ncheckBadTelescope (Implic { ic_telescope  = m_telescope\n                          , ic_skols      = skols })\n  | isJust m_telescope\n  = do{ skols <- mapM TcS.zonkTyCoVarKind skols\n      ; return (go emptyVarSet (reverse skols))}\n\n  | otherwise\n  = return False\n\n  where\n    go :: TyVarSet   -- skolems that appear *later* than the current ones\n       -> [TcTyVar]  -- ordered skolems, in reverse order\n       -> Bool       -- True <=> there is an out-of-order skolem\n    go _ [] = False\n    go later_skols (one_skol : earlier_skols)\n      | tyCoVarsOfType (tyVarKind one_skol) `intersectsVarSet` later_skols\n      = True\n      | otherwise\n      = go (later_skols `extendVarSet` one_skol) earlier_skols\n\nwarnRedundantGivens :: SkolemInfo -> Bool\nwarnRedundantGivens (SigSkol ctxt _ _)\n  = case ctxt of\n       FunSigCtxt _ warn_redundant -> warn_redundant\n       ExprSigCtxt                 -> True\n       _                           -> False\n\n  -- To think about: do we want to report redundant givens for\n  -- pattern synonyms, PatSynSigSkol? c.f Trac #9953, comment:21.\nwarnRedundantGivens (InstSkol {}) = True\nwarnRedundantGivens _             = False\n\nneededEvVars :: Implication -> TcS Implication\n-- Find all the evidence variables that are \"needed\",\n-- and delete dead evidence bindings\n--   See Note [Tracking redundant constraints]\n--   See Note [Delete dead Given evidence bindings]\n--\n--   - Start from initial_seeds (from nested implications)\n--\n--   - Add free vars of RHS of all Wanted evidence bindings\n--     and coercion variables accumulated in tcvs (all Wanted)\n--\n--   - Generate 'needed', the needed set of EvVars, by doing transitive\n--     closure through Given bindings\n--     e.g.   Needed {a,b}\n--            Given  a = sc_sel a2\n--            Then a2 is needed too\n--\n--   - Prune out all Given bindings that are not needed\n--\n--   - From the 'needed' set, delete ev_bndrs, the binders of the\n--     evidence bindings, to give the final needed variables\n--\nneededEvVars implic@(Implic { ic_given = givens\n                            , ic_binds = ev_binds_var\n                            , ic_wanted = WC { wc_impl = implics }\n                            , ic_need_inner = old_needs })\n = do { ev_binds <- TcS.getTcEvBindsMap ev_binds_var\n      ; tcvs     <- TcS.getTcEvTyCoVars ev_binds_var\n\n      ; let seeds1        = foldrBag add_implic_seeds old_needs implics\n            seeds2        = foldEvBindMap add_wanted seeds1 ev_binds\n            seeds3        = seeds2 `unionVarSet` tcvs\n            need_inner    = findNeededEvVars ev_binds seeds3\n            live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds\n            need_outer    = foldEvBindMap del_ev_bndr need_inner live_ev_binds\n                            `delVarSetList` givens\n\n      ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds\n           -- See Note [Delete dead Given evidence bindings]\n\n      ; traceTcS \"neededEvVars\" $\n        vcat [ text \"old_needs:\" <+> ppr old_needs\n             , text \"seeds3:\" <+> ppr seeds3\n             , text \"tcvs:\" <+> ppr tcvs\n             , text \"ev_binds:\" <+> ppr ev_binds\n             , text \"live_ev_binds:\" <+> ppr live_ev_binds ]\n\n      ; return (implic { ic_need_inner = need_inner\n                       , ic_need_outer = need_outer }) }\n where\n   add_implic_seeds (Implic { ic_need_outer = needs }) acc\n      = needs `unionVarSet` acc\n\n   needed_ev_bind needed (EvBind { eb_lhs = ev_var\n                                 , eb_is_given = is_given })\n     | is_given  = ev_var `elemVarSet` needed\n     | otherwise = True   -- Keep all wanted bindings\n\n   del_ev_bndr :: EvBind -> VarSet -> VarSet\n   del_ev_bndr (EvBind { eb_lhs = v }) needs = delVarSet needs v\n\n   add_wanted :: EvBind -> VarSet -> VarSet\n   add_wanted (EvBind { eb_is_given = is_given, eb_rhs = rhs }) needs\n     | is_given  = needs  -- Add the rhs vars of the Wanted bindings only\n     | otherwise = evVarsOfTerm rhs `unionVarSet` needs\n\n\n{- Note [Delete dead Given evidence bindings]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs a result of superclass expansion, we speculatively\ngenerate evidence bindings for Givens. E.g.\n   f :: (a ~ b) => a -> b -> Bool\n   f x y = ...\nWe'll have\n   [G] d1 :: (a~b)\nand we'll specuatively generate the evidence binding\n   [G] d2 :: (a ~# b) = sc_sel d\n\nNow d2 is available for solving.  But it may not be needed!  Usually\nsuch dead superclass selections will eventually be dropped as dead\ncode, but:\n\n * It won't always be dropped (Trac #13032).  In the case of an\n   unlifted-equality superclass like d2 above, we generate\n       case heq_sc d1 of d2 -> ...\n   and we can't (in general) drop that case exrpession in case\n   d1 is bottom.  So it's technically unsound to have added it\n   in the first place.\n\n * Simply generating all those extra superclasses can generate lots of\n   code that has to be zonked, only to be discarded later.  Better not\n   to generate it in the first place.\n\n   Moreover, if we simplify this implication more than once\n   (e.g. because we can't solve it completely on the first iteration\n   of simpl_looop), we'll generate all the same bindings AGAIN!\n\nEasy solution: take advantage of the work we are doing to track dead\n(unused) Givens, and use it to prune the Given bindings too.  This is\nall done by neededEvVars.\n\nThis led to a remarkable 25% overall compiler allocation decrease in\ntest T12227.\n\nBut we don't get to discard all redundant equality superclasses, alas;\nsee Trac #15205.\n\nNote [Tracking redundant constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWith Opt_WarnRedundantConstraints, GHC can report which\nconstraints of a type signature (or instance declaration) are\nredundant, and can be omitted.  Here is an overview of how it\nworks:\n\n----- What is a redundant constraint?\n\n* The things that can be redundant are precisely the Given\n  constraints of an implication.\n\n* A constraint can be redundant in two different ways:\n  a) It is implied by other givens.  E.g.\n       f :: (Eq a, Ord a)     => blah   -- Eq a unnecessary\n       g :: (Eq a, a~b, Eq b) => blah   -- Either Eq a or Eq b unnecessary\n  b) It is not needed by the Wanted constraints covered by the\n     implication E.g.\n       f :: Eq a => a -> Bool\n       f x = True  -- Equality not used\n\n*  To find (a), when we have two Given constraints,\n   we must be careful to drop the one that is a naked variable (if poss).\n   So if we have\n       f :: (Eq a, Ord a) => blah\n   then we may find [G] sc_sel (d1::Ord a) :: Eq a\n                    [G] d2 :: Eq a\n   We want to discard d2 in favour of the superclass selection from\n   the Ord dictionary.  This is done by TcInteract.solveOneFromTheOther\n   See Note [Replacement vs keeping].\n\n* To find (b) we need to know which evidence bindings are 'wanted';\n  hence the eb_is_given field on an EvBind.\n\n----- How tracking works\n\n* The ic_need fields of an Implic records in-scope (given) evidence\n  variables bound by the context, that were needed to solve this\n  implication (so far).  See the declaration of Implication.\n\n* When the constraint solver finishes solving all the wanteds in\n  an implication, it sets its status to IC_Solved\n\n  - The ics_dead field, of IC_Solved, records the subset of this\n    implication's ic_given that are redundant (not needed).\n\n* We compute which evidence variables are needed by an implication\n  in setImplicationStatus.  A variable is needed if\n    a) it is free in the RHS of a Wanted EvBind,\n    b) it is free in the RHS of an EvBind whose LHS is needed,\n    c) it is in the ics_need of a nested implication.\n\n* We need to be careful not to discard an implication\n  prematurely, even one that is fully solved, because we might\n  thereby forget which variables it needs, and hence wrongly\n  report a constraint as redundant.  But we can discard it once\n  its free vars have been incorporated into its parent; or if it\n  simply has no free vars. This careful discarding is also\n  handled in setImplicationStatus.\n\n----- Reporting redundant constraints\n\n* TcErrors does the actual warning, in warnRedundantConstraints.\n\n* We don't report redundant givens for *every* implication; only\n  for those which reply True to TcSimplify.warnRedundantGivens:\n\n   - For example, in a class declaration, the default method *can*\n     use the class constraint, but it certainly doesn't *have* to,\n     and we don't want to report an error there.\n\n   - More subtly, in a function definition\n       f :: (Ord a, Ord a, Ix a) => a -> a\n       f x = rhs\n     we do an ambiguity check on the type (which would find that one\n     of the Ord a constraints was redundant), and then we check that\n     the definition has that type (which might find that both are\n     redundant).  We don't want to report the same error twice, so we\n     disable it for the ambiguity check.  Hence using two different\n     FunSigCtxts, one with the warn-redundant field set True, and the\n     other set False in\n        - TcBinds.tcSpecPrag\n        - TcBinds.tcTySig\n\n  This decision is taken in setImplicationStatus, rather than TcErrors\n  so that we can discard implication constraints that we don't need.\n  So ics_dead consists only of the *reportable* redundant givens.\n\n----- Shortcomings\n\nConsider (see Trac #9939)\n    f2 :: (Eq a, Ord a) => a -> a -> Bool\n    -- Ord a redundant, but Eq a is reported\n    f2 x y = (x == y)\n\nWe report (Eq a) as redundant, whereas actually (Ord a) is.  But it's\nreally not easy to detect that!\n\n\nNote [Cutting off simpl_loop]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is very important not to iterate in simpl_loop unless there is a chance\nof progress.  Trac #8474 is a classic example:\n\n  * There's a deeply-nested chain of implication constraints.\n       ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int\n\n  * From the innermost one we get a [D] alpha ~ Int,\n    but alpha is untouchable until we get out to the outermost one\n\n  * We float [D] alpha~Int out (it is in floated_eqs), but since alpha\n    is untouchable, the solveInteract in simpl_loop makes no progress\n\n  * So there is no point in attempting to re-solve\n       ?yn:betan => [W] ?x:Int\n    via solveNestedImplications, because we'll just get the\n    same [D] again\n\n  * If we *do* re-solve, we'll get an ininite loop. It is cut off by\n    the fixed bound of 10, but solving the next takes 10*10*...*10 (ie\n    exponentially many) iterations!\n\nConclusion: we should call solveNestedImplications only if we did\nsome unification in solveSimpleWanteds; because that's the only way\nwe'll get more Givens (a unification is like adding a Given) to\nallow the implication to make progress.\n-}\n\npromoteTyVar :: TcTyVar -> TcM (Bool, TcTyVar)\n-- When we float a constraint out of an implication we must restore\n-- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in TcType\n-- Return True <=> we did some promotion\n-- Also returns either the original tyvar (no promotion) or the new one\n-- See Note [Promoting unification variables]\npromoteTyVar tv\n  = do { tclvl <- TcM.getTcLevel\n       ; if (isFloatedTouchableMetaTyVar tclvl tv)\n         then do { cloned_tv <- TcM.cloneMetaTyVar tv\n                 ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl\n                 ; TcM.writeMetaTyVar tv (mkTyVarTy rhs_tv)\n                 ; return (True, rhs_tv) }\n         else return (False, tv) }\n\n-- Returns whether or not *any* tyvar is defaulted\npromoteTyVarSet :: TcTyVarSet -> TcM (Bool, TcTyVarSet)\npromoteTyVarSet tvs\n  = do { (bools, tyvars) <- mapAndUnzipM promoteTyVar (nonDetEltsUniqSet tvs)\n           -- non-determinism is OK because order of promotion doesn't matter\n\n       ; return (or bools, mkVarSet tyvars) }\n\npromoteTyVarTcS :: TcTyVar  -> TcS ()\n-- When we float a constraint out of an implication we must restore\n-- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in TcType\n-- See Note [Promoting unification variables]\n-- We don't just call promoteTyVar because we want to use unifyTyVar,\n-- not writeMetaTyVar\npromoteTyVarTcS tv\n  = do { tclvl <- TcS.getTcLevel\n       ; when (isFloatedTouchableMetaTyVar tclvl tv) $\n         do { cloned_tv <- TcS.cloneMetaTyVar tv\n            ; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl\n            ; unifyTyVar tv (mkTyVarTy rhs_tv) } }\n\n-- | Like 'defaultTyVar', but in the TcS monad.\ndefaultTyVarTcS :: TcTyVar -> TcS Bool\ndefaultTyVarTcS the_tv\n  | isRuntimeRepVar the_tv\n  , not (isTyVarTyVar the_tv)\n    -- TyVarTvs should only be unified with a tyvar\n    -- never with a type; c.f. TcMType.defaultTyVar\n    -- and Note [Inferring kinds for type declarations] in TcTyClsDecls\n  = do { traceTcS \"defaultTyVarTcS RuntimeRep\" (ppr the_tv)\n       ; unifyTyVar the_tv liftedRepTy\n       ; return True }\n  | otherwise\n  = return False  -- the common case\n\napproximateWC :: Bool -> WantedConstraints -> Cts\n-- Postcondition: Wanted or Derived Cts\n-- See Note [ApproximateWC]\napproximateWC float_past_equalities wc\n  = float_wc emptyVarSet wc\n  where\n    float_wc :: TcTyCoVarSet -> WantedConstraints -> Cts\n    float_wc trapping_tvs (WC { wc_simple = simples, wc_impl = implics })\n      = filterBag (is_floatable trapping_tvs) simples `unionBags`\n        do_bag (float_implic trapping_tvs) implics\n      where\n\n    float_implic :: TcTyCoVarSet -> Implication -> Cts\n    float_implic trapping_tvs imp\n      | float_past_equalities || ic_no_eqs imp\n      = float_wc new_trapping_tvs (ic_wanted imp)\n      | otherwise   -- Take care with equalities\n      = emptyCts    -- See (1) under Note [ApproximateWC]\n      where\n        new_trapping_tvs = trapping_tvs `extendVarSetList` ic_skols imp\n\n    do_bag :: (a -> Bag c) -> Bag a -> Bag c\n    do_bag f = foldrBag (unionBags.f) emptyBag\n\n    is_floatable skol_tvs ct\n       | isGivenCt ct     = False\n       | isHoleCt ct      = False\n       | insolubleEqCt ct = False\n       | otherwise        = tyCoVarsOfCt ct `disjointVarSet` skol_tvs\n\n{- Note [ApproximateWC]\n~~~~~~~~~~~~~~~~~~~~~~~\napproximateWC takes a constraint, typically arising from the RHS of a\nlet-binding whose type we are *inferring*, and extracts from it some\n*simple* constraints that we might plausibly abstract over.  Of course\nthe top-level simple constraints are plausible, but we also float constraints\nout from inside, if they are not captured by skolems.\n\nThe same function is used when doing type-class defaulting (see the call\nto applyDefaultingRules) to extract constraints that that might be defaulted.\n\nThere is one caveat:\n\n1.  When infering most-general types (in simplifyInfer), we do *not*\n    float anything out if the implication binds equality constraints,\n    because that defeats the OutsideIn story.  Consider\n       data T a where\n         TInt :: T Int\n         MkT :: T a\n\n       f TInt = 3::Int\n\n    We get the implication (a ~ Int => res ~ Int), where so far we've decided\n      f :: T a -> res\n    We don't want to float (res~Int) out because then we'll infer\n      f :: T a -> Int\n    which is only on of the possible types. (GHC 7.6 accidentally *did*\n    float out of such implications, which meant it would happily infer\n    non-principal types.)\n\n   HOWEVER (Trac #12797) in findDefaultableGroups we are not worried about\n   the most-general type; and we /do/ want to float out of equalities.\n   Hence the boolean flag to approximateWC.\n\n------ Historical note -----------\nThere used to be a second caveat, driven by Trac #8155\n\n   2. We do not float out an inner constraint that shares a type variable\n      (transitively) with one that is trapped by a skolem.  Eg\n          forall a.  F a ~ beta, Integral beta\n      We don't want to float out (Integral beta).  Doing so would be bad\n      when defaulting, because then we'll default beta:=Integer, and that\n      makes the error message much worse; we'd get\n          Can't solve  F a ~ Integer\n      rather than\n          Can't solve  Integral (F a)\n\n      Moreover, floating out these \"contaminated\" constraints doesn't help\n      when generalising either. If we generalise over (Integral b), we still\n      can't solve the retained implication (forall a. F a ~ b).  Indeed,\n      arguably that too would be a harder error to understand.\n\nBut this transitive closure stuff gives rise to a complex rule for\nwhen defaulting actually happens, and one that was never documented.\nMoreover (Trac #12923), the more complex rule is sometimes NOT what\nyou want.  So I simply removed the extra code to implement the\ncontamination stuff.  There was zero effect on the testsuite (not even\n#8155).\n------ End of historical note -----------\n\n\nNote [DefaultTyVar]\n~~~~~~~~~~~~~~~~~~~\ndefaultTyVar is used on any un-instantiated meta type variables to\ndefault any RuntimeRep variables to LiftedRep.  This is important\nto ensure that instance declarations match.  For example consider\n\n     instance Show (a->b)\n     foo x = show (\\_ -> True)\n\nThen we'll get a constraint (Show (p ->q)) where p has kind (TYPE r),\nand that won't match the tcTypeKind (*) in the instance decl.  See tests\ntc217 and tc175.\n\nWe look only at touchable type variables. No further constraints\nare going to affect these type variables, so it's time to do it by\nhand.  However we aren't ready to default them fully to () or\nwhatever, because the type-class defaulting rules have yet to run.\n\nAn alternate implementation would be to emit a derived constraint setting\nthe RuntimeRep variable to LiftedRep, but this seems unnecessarily indirect.\n\nNote [Promote _and_ default when inferring]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we are inferring a type, we simplify the constraint, and then use\napproximateWC to produce a list of candidate constraints.  Then we MUST\n\n  a) Promote any meta-tyvars that have been floated out by\n     approximateWC, to restore invariant (WantedInv) described in\n     Note [TcLevel and untouchable type variables] in TcType.\n\n  b) Default the kind of any meta-tyvars that are not mentioned in\n     in the environment.\n\nTo see (b), suppose the constraint is (C ((a :: OpenKind) -> Int)), and we\nhave an instance (C ((x:*) -> Int)).  The instance doesn't match -- but it\nshould!  If we don't solve the constraint, we'll stupidly quantify over\n(C (a->Int)) and, worse, in doing so skolemiseQuantifiedTyVar will quantify over\n(b:*) instead of (a:OpenKind), which can lead to disaster; see Trac #7332.\nTrac #7641 is a simpler example.\n\nNote [Promoting unification variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we float an equality out of an implication we must \"promote\" free\nunification variables of the equality, in order to maintain Invariant\n(WantedInv) from Note [TcLevel and untouchable type variables] in\nTcType.  for the leftover implication.\n\nThis is absolutely necessary. Consider the following example. We start\nwith two implications and a class with a functional dependency.\n\n    class C x y | x -> y\n    instance C [a] [a]\n\n    (I1)      [untch=beta]forall b. 0 => F Int ~ [beta]\n    (I2)      [untch=beta]forall c. 0 => F Int ~ [[alpha]] /\\ C beta [c]\n\nWe float (F Int ~ [beta]) out of I1, and we float (F Int ~ [[alpha]]) out of I2.\nThey may react to yield that (beta := [alpha]) which can then be pushed inwards\nthe leftover of I2 to get (C [alpha] [a]) which, using the FunDep, will mean that\n(alpha := a). In the end we will have the skolem 'b' escaping in the untouchable\nbeta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs:\n\n    class C x y | x -> y where\n     op :: x -> y -> ()\n\n    instance C [a] [a]\n\n    type family F a :: *\n\n    h :: F Int -> ()\n    h = undefined\n\n    data TEx where\n      TEx :: a -> TEx\n\n    f (x::beta) =\n        let g1 :: forall b. b -> ()\n            g1 _ = h [x]\n            g2 z = case z of TEx y -> (h [[undefined]], op x [y])\n        in (g1 '3', g2 undefined)\n\n\n\n*********************************************************************************\n*                                                                               *\n*                          Floating equalities                                  *\n*                                                                               *\n*********************************************************************************\n\nNote [Float Equalities out of Implications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor ordinary pattern matches (including existentials) we float\nequalities out of implications, for instance:\n     data T where\n       MkT :: Eq a => a -> T\n     f x y = case x of MkT _ -> (y::Int)\nWe get the implication constraint (x::T) (y::alpha):\n     forall a. [untouchable=alpha] Eq a => alpha ~ Int\nWe want to float out the equality into a scope where alpha is no\nlonger untouchable, to solve the implication!\n\nBut we cannot float equalities out of implications whose givens may\nyield or contain equalities:\n\n      data T a where\n        T1 :: T Int\n        T2 :: T Bool\n        T3 :: T a\n\n      h :: T a -> a -> Int\n\n      f x y = case x of\n                T1 -> y::Int\n                T2 -> y::Bool\n                T3 -> h x y\n\nWe generate constraint, for (x::T alpha) and (y :: beta):\n   [untouchables = beta] (alpha ~ Int => beta ~ Int)   -- From 1st branch\n   [untouchables = beta] (alpha ~ Bool => beta ~ Bool) -- From 2nd branch\n   (alpha ~ beta)                                      -- From 3rd branch\n\nIf we float the equality (beta ~ Int) outside of the first implication and\nthe equality (beta ~ Bool) out of the second we get an insoluble constraint.\nBut if we just leave them inside the implications, we unify alpha := beta and\nsolve everything.\n\nPrinciple:\n    We do not want to float equalities out which may\n    need the given *evidence* to become soluble.\n\nConsequence: classes with functional dependencies don't matter (since there is\nno evidence for a fundep equality), but equality superclasses do matter (since\nthey carry evidence).\n-}\n\nfloatEqualities :: [TcTyVar] -> [EvId] -> EvBindsVar -> Bool\n                -> WantedConstraints\n                -> TcS (Cts, WantedConstraints)\n-- Main idea: see Note [Float Equalities out of Implications]\n--\n-- Precondition: the wc_simple of the incoming WantedConstraints are\n--               fully zonked, so that we can see their free variables\n--\n-- Postcondition: The returned floated constraints (Cts) are only\n--                Wanted or Derived\n--\n-- Also performs some unifications (via promoteTyVar), adding to\n-- monadically-carried ty_binds. These will be used when processing\n-- floated_eqs later\n--\n-- Subtleties: Note [Float equalities from under a skolem binding]\n--             Note [Skolem escape]\n--             Note [What prevents a constraint from floating]\nfloatEqualities skols given_ids ev_binds_var no_given_eqs\n                wanteds@(WC { wc_simple = simples })\n  | not no_given_eqs  -- There are some given equalities, so don't float\n  = return (emptyBag, wanteds)   -- Note [Float Equalities out of Implications]\n\n  | otherwise\n  = do { -- First zonk: the inert set (from whence they came) is fully\n         -- zonked, but unflattening may have filled in unification\n         -- variables, and we /must/ see them.  Otherwise we may float\n         -- constraints that mention the skolems!\n         simples <- TcS.zonkSimples simples\n       ; binds   <- TcS.getTcEvBindsMap ev_binds_var\n\n       -- Now we can pick the ones to float\n       -- The constraints are un-flattened and de-canonicalised\n       ; let (candidate_eqs, no_float_cts) = partitionBag is_float_eq_candidate simples\n\n             seed_skols = mkVarSet skols     `unionVarSet`\n                          mkVarSet given_ids `unionVarSet`\n                          foldrBag add_non_flt_ct emptyVarSet no_float_cts `unionVarSet`\n                          foldEvBindMap add_one_bind emptyVarSet binds\n             -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3)\n             -- Include the EvIds of any non-floating constraints\n\n             extended_skols = transCloVarSet (add_captured_ev_ids candidate_eqs) seed_skols\n                 -- extended_skols contains the EvIds of all the trapped constraints\n                 -- See Note [What prevents a constraint from floating] (3)\n\n             (flt_eqs, no_flt_eqs) = partitionBag (is_floatable extended_skols)\n                                                  candidate_eqs\n\n             remaining_simples = no_float_cts `andCts` no_flt_eqs\n\n       -- Promote any unification variables mentioned in the floated equalities\n       -- See Note [Promoting unification variables]\n       ; mapM_ promoteTyVarTcS (tyCoVarsOfCtsList flt_eqs)\n\n       ; traceTcS \"floatEqualities\" (vcat [ text \"Skols =\" <+> ppr skols\n                                          , text \"Extended skols =\" <+> ppr extended_skols\n                                          , text \"Simples =\" <+> ppr simples\n                                          , text \"Candidate eqs =\" <+> ppr candidate_eqs\n                                          , text \"Floated eqs =\" <+> ppr flt_eqs])\n       ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) }\n\n  where\n    add_one_bind :: EvBind -> VarSet -> VarSet\n    add_one_bind bind acc = extendVarSet acc (evBindVar bind)\n\n    add_non_flt_ct :: Ct -> VarSet -> VarSet\n    add_non_flt_ct ct acc | isDerivedCt ct = acc\n                          | otherwise      = extendVarSet acc (ctEvId ct)\n\n    is_floatable :: VarSet -> Ct -> Bool\n    is_floatable skols ct\n      | isDerivedCt ct = not (tyCoVarsOfCt ct `intersectsVarSet` skols)\n      | otherwise      = not (ctEvId ct `elemVarSet` skols)\n\n    add_captured_ev_ids :: Cts -> VarSet -> VarSet\n    add_captured_ev_ids cts skols = foldrBag extra_skol emptyVarSet cts\n       where\n         extra_skol ct acc\n           | isDerivedCt ct                           = acc\n           | tyCoVarsOfCt ct `intersectsVarSet` skols = extendVarSet acc (ctEvId ct)\n           | otherwise                                = acc\n\n    -- Identify which equalities are candidates for floating\n    -- Float out alpha ~ ty, or ty ~ alpha which might be unified outside\n    -- See Note [Which equalities to float]\n    is_float_eq_candidate ct\n      | pred <- ctPred ct\n      , EqPred NomEq ty1 ty2 <- classifyPredType pred\n      , tcTypeKind ty1 `tcEqType` tcTypeKind ty2\n      = case (tcGetTyVar_maybe ty1, tcGetTyVar_maybe ty2) of\n          (Just tv1, _) -> float_tv_eq_candidate tv1 ty2\n          (_, Just tv2) -> float_tv_eq_candidate tv2 ty1\n          _             -> False\n      | otherwise = False\n\n    float_tv_eq_candidate tv1 ty2  -- See Note [Which equalities to float]\n      =  isMetaTyVar tv1\n      && (not (isTyVarTyVar tv1) || isTyVarTy ty2)\n\n\n{- Note [Float equalities from under a skolem binding]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhich of the simple equalities can we float out?  Obviously, only\nones that don't mention the skolem-bound variables.  But that is\nover-eager. Consider\n   [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int\nThe second constraint doesn't mention 'a'.  But if we float it,\nwe'll promote gamma[2] to gamma'[1].  Now suppose that we learn that\nbeta := Bool, and F a Bool = a, and G Bool _ = Int.  Then we'll\nwe left with the constraint\n   [2] forall a. a ~ gamma'[1]\nwhich is insoluble because gamma became untouchable.\n\nSolution: float only constraints that stand a jolly good chance of\nbeing soluble simply by being floated, namely ones of form\n      a ~ ty\nwhere 'a' is a currently-untouchable unification variable, but may\nbecome touchable by being floated (perhaps by more than one level).\n\nWe had a very complicated rule previously, but this is nice and\nsimple.  (To see the notes, look at this Note in a version of\nTcSimplify prior to Oct 2014).\n\nNote [Which equalities to float]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhich equalities should we float?  We want to float ones where there\nis a decent chance that floating outwards will allow unification to\nhappen.  In particular, float out equalities that are:\n\n* Of form (alpha ~# ty) or (ty ~# alpha), where\n   * alpha is a meta-tyvar.\n   * And 'alpha' is not a TyVarTv with 'ty' being a non-tyvar.  In that\n     case, floating out won't help either, and it may affect grouping\n     of error messages.\n\n* Homogeneous (both sides have the same kind). Why only homogeneous?\n  Because heterogeneous equalities have derived kind equalities.\n  See Note [Equalities with incompatible kinds] in TcCanonical.\n  If we float out a hetero equality, then it will spit out the same\n  derived kind equality again, which might create duplicate error\n  messages.\n\n  Instead, we do float out the kind equality (if it's worth floating\n  out, as above). If/when we solve it, we'll be able to rewrite the\n  original hetero equality to be homogeneous, and then perhaps make\n  progress / float it out. The duplicate error message was spotted in\n  typecheck/should_fail/T7368.\n\n* Nominal.  No point in floating (alpha ~R# ty), because we do not\n  unify representational equalities even if alpha is touchable.\n  See Note [Do not unify representational equalities] in TcInteract.\n\nNote [Skolem escape]\n~~~~~~~~~~~~~~~~~~~~\nYou might worry about skolem escape with all this floating.\nFor example, consider\n    [2] forall a. (a ~ F beta[2] delta,\n                   Maybe beta[2] ~ gamma[1])\n\nThe (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and\nsolve with gamma := beta. But what if later delta:=Int, and\n  F b Int = b.\nThen we'd get a ~ beta[2], and solve to get beta:=a, and now the\nskolem has escaped!\n\nBut it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2]\nto beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be.\n\nNote [What prevents a constraint from floating]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhat /prevents/ a constraint from floating?  If it mentions one of the\n\"bound variables of the implication\".  What are they?\n\nThe \"bound variables of the implication\" are\n\n  1. The skolem type variables `ic_skols`\n\n  2. The \"given\" evidence variables `ic_given`.  Example:\n         forall a. (co :: t1 ~# t2) =>  [W] co2 : (a ~# b |> co)\n     Here 'co' is bound\n\n  3. The binders of all evidence bindings in `ic_binds`. Example\n         forall a. (d :: t1 ~ t2)\n            EvBinds { (co :: t1 ~# t2) = superclass-sel d }\n            => [W] co2 : (a ~# b |> co)\n     Here `co` is gotten by superclass selection from `d`, and the\n     wanted constraint co2 must not float.\n\n  4. And the evidence variable of any equality constraint (incl\n     Wanted ones) whose type mentions a bound variable.  Example:\n        forall k. [W] co1 :: t1 ~# t2 |> co2\n                  [W] co2 :: k ~# *\n     Here, since `k` is bound, so is `co2` and hence so is `co1`.\n\nHere (1,2,3) are handled by the \"seed_skols\" calculation, and\n(4) is done by the transCloVarSet call.\n\nThe possible dependence on givens, and evidence bindings, is more\nsubtle than we'd realised at first.  See Trac #14584.\n\n\n*********************************************************************************\n*                                                                               *\n*                          Defaulting and disambiguation                        *\n*                                                                               *\n*********************************************************************************\n-}\n\napplyDefaultingRules :: WantedConstraints -> TcS Bool\n-- True <=> I did some defaulting, by unifying a meta-tyvar\n-- Input WantedConstraints are not necessarily zonked\n\napplyDefaultingRules wanteds\n  | isEmptyWC wanteds\n  = return False\n  | otherwise\n  = do { info@(default_tys, _) <- getDefaultInfo\n       ; wanteds               <- TcS.zonkWC wanteds\n\n       ; let groups = findDefaultableGroups info wanteds\n\n       ; traceTcS \"applyDefaultingRules {\" $\n                  vcat [ text \"wanteds =\" <+> ppr wanteds\n                       , text \"groups  =\" <+> ppr groups\n                       , text \"info    =\" <+> ppr info ]\n\n       ; something_happeneds <- mapM (disambigGroup default_tys) groups\n\n       ; traceTcS \"applyDefaultingRules }\" (ppr something_happeneds)\n\n       ; return (or something_happeneds) }\n\nfindDefaultableGroups\n    :: ( [Type]\n       , (Bool,Bool) )     -- (Overloaded strings, extended default rules)\n    -> WantedConstraints   -- Unsolved (wanted or derived)\n    -> [(TyVar, [Ct])]\nfindDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds\n  | null default_tys\n  = []\n  | otherwise\n  = [ (tv, map fstOf3 group)\n    | group'@((_,_,tv) :| _) <- unary_groups\n    , let group = toList group'\n    , defaultable_tyvar tv\n    , defaultable_classes (map sndOf3 group) ]\n  where\n    simples                = approximateWC True wanteds\n    (unaries, non_unaries) = partitionWith find_unary (bagToList simples)\n    unary_groups           = equivClasses cmp_tv unaries\n\n    unary_groups :: [NonEmpty (Ct, Class, TcTyVar)] -- (C tv) constraints\n    unaries      :: [(Ct, Class, TcTyVar)]          -- (C tv) constraints\n    non_unaries  :: [Ct]                            -- and *other* constraints\n\n        -- Finds unary type-class constraints\n        -- But take account of polykinded classes like Typeable,\n        -- which may look like (Typeable * (a:*))   (Trac #8931)\n    find_unary :: Ct -> Either (Ct, Class, TyVar) Ct\n    find_unary cc\n        | Just (cls,tys)   <- getClassPredTys_maybe (ctPred cc)\n        , [ty] <- filterOutInvisibleTypes (classTyCon cls) tys\n              -- Ignore invisible arguments for this purpose\n        , Just tv <- tcGetTyVar_maybe ty\n        , isMetaTyVar tv  -- We might have runtime-skolems in GHCi, and\n                          -- we definitely don't want to try to assign to those!\n        = Left (cc, cls, tv)\n    find_unary cc = Right cc  -- Non unary or non dictionary\n\n    bad_tvs :: TcTyCoVarSet  -- TyVars mentioned by non-unaries\n    bad_tvs = mapUnionVarSet tyCoVarsOfCt non_unaries\n\n    cmp_tv (_,_,tv1) (_,_,tv2) = tv1 `compare` tv2\n\n    defaultable_tyvar :: TcTyVar -> Bool\n    defaultable_tyvar tv\n        = let b1 = isTyConableTyVar tv  -- Note [Avoiding spurious errors]\n              b2 = not (tv `elemVarSet` bad_tvs)\n          in b1 && (b2 || extended_defaults) -- Note [Multi-parameter defaults]\n\n    defaultable_classes :: [Class] -> Bool\n    defaultable_classes clss\n        | extended_defaults = any (isInteractiveClass ovl_strings) clss\n        | otherwise         = all is_std_class clss && (any (isNumClass ovl_strings) clss)\n\n    -- is_std_class adds IsString to the standard numeric classes,\n    -- when -foverloaded-strings is enabled\n    is_std_class cls = isStandardClass cls ||\n                       (ovl_strings && (cls `hasKey` isStringClassKey))\n\n------------------------------\ndisambigGroup :: [Type]            -- The default types\n              -> (TcTyVar, [Ct])   -- All classes of the form (C a)\n                                   --  sharing same type variable\n              -> TcS Bool   -- True <=> something happened, reflected in ty_binds\n\ndisambigGroup [] _\n  = return False\ndisambigGroup (default_ty:default_tys) group@(the_tv, wanteds)\n  = do { traceTcS \"disambigGroup {\" (vcat [ ppr default_ty, ppr the_tv, ppr wanteds ])\n       ; fake_ev_binds_var <- TcS.newTcEvBinds\n       ; tclvl             <- TcS.getTcLevel\n       ; success <- nestImplicTcS fake_ev_binds_var (pushTcLevel tclvl) try_group\n\n       ; if success then\n             -- Success: record the type variable binding, and return\n             do { unifyTyVar the_tv default_ty\n                ; wrapWarnTcS $ warnDefaulting wanteds default_ty\n                ; traceTcS \"disambigGroup succeeded }\" (ppr default_ty)\n                ; return True }\n         else\n             -- Failure: try with the next type\n             do { traceTcS \"disambigGroup failed, will try other default types }\"\n                           (ppr default_ty)\n                ; disambigGroup default_tys group } }\n  where\n    try_group\n      | Just subst <- mb_subst\n      = do { lcl_env <- TcS.getLclEnv\n           ; tc_lvl <- TcS.getTcLevel\n           ; let loc = mkGivenLoc tc_lvl UnkSkol lcl_env\n           ; wanted_evs <- mapM (newWantedEvVarNC loc . substTy subst . ctPred)\n                                wanteds\n           ; fmap isEmptyWC $\n             solveSimpleWanteds $ listToBag $\n             map mkNonCanonical wanted_evs }\n\n      | otherwise\n      = return False\n\n    the_ty   = mkTyVarTy the_tv\n    mb_subst = tcMatchTyKi the_ty default_ty\n      -- Make sure the kinds match too; hence this call to tcMatchTyKi\n      -- E.g. suppose the only constraint was (Typeable k (a::k))\n      -- With the addition of polykinded defaulting we also want to reject\n      -- ill-kinded defaulting attempts like (Eq []) or (Foldable Int) here.\n\n-- In interactive mode, or with -XExtendedDefaultRules,\n-- we default Show a to Show () to avoid graututious errors on \"show []\"\nisInteractiveClass :: Bool   -- -XOverloadedStrings?\n                   -> Class -> Bool\nisInteractiveClass ovl_strings cls\n    = isNumClass ovl_strings cls || (classKey cls `elem` interactiveClassKeys)\n\n    -- isNumClass adds IsString to the standard numeric classes,\n    -- when -foverloaded-strings is enabled\nisNumClass :: Bool   -- -XOverloadedStrings?\n           -> Class -> Bool\nisNumClass ovl_strings cls\n  = isNumericClass cls || (ovl_strings && (cls `hasKey` isStringClassKey))\n\n\n{-\nNote [Avoiding spurious errors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen doing the unification for defaulting, we check for skolem\ntype variables, and simply don't default them.  For example:\n   f = (*)      -- Monomorphic\n   g :: Num a => a -> a\n   g x = f x x\nHere, we get a complaint when checking the type signature for g,\nthat g isn't polymorphic enough; but then we get another one when\ndealing with the (Num a) context arising from f's definition;\nwe try to unify a with Int (to default it), but find that it's\nalready been unified with the rigid variable from g's type sig.\n\nNote [Multi-parameter defaults]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWith -XExtendedDefaultRules, we default only based on single-variable\nconstraints, but do not exclude from defaulting any type variables which also\nappear in multi-variable constraints. This means that the following will\ndefault properly:\n\n   default (Integer, Double)\n\n   class A b (c :: Symbol) where\n      a :: b -> Proxy c\n\n   instance A Integer c where a _ = Proxy\n\n   main = print (a 5 :: Proxy \"5\")\n\nNote that if we change the above instance (\"instance A Integer\") to\n\"instance A Double\", we get an error:\n\n   No instance for (A Integer \"5\")\n\nThis is because the first defaulted type (Integer) has successfully satisfied\nits single-parameter constraints (in this case Num).\n-}\n", "num_lines": 2664}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nTcSplice: Template Haskell splices\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE InstanceSigs #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\nmodule TcSplice(\n     tcSpliceExpr, tcTypedBracket, tcUntypedBracket,\n--     runQuasiQuoteExpr, runQuasiQuotePat,\n--     runQuasiQuoteDecl, runQuasiQuoteType,\n     runAnnotation,\n\n     runMetaE, runMetaP, runMetaT, runMetaD, runQuasi,\n     tcTopSpliceExpr, lookupThName_maybe,\n     defaultRunMeta, runMeta', runRemoteModFinalizers,\n     finishTH, runTopSplice\n      ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport Annotations\nimport Finder\nimport Name\nimport TcRnMonad\nimport TcType\n\nimport Outputable\nimport TcExpr\nimport SrcLoc\nimport THNames\nimport TcUnify\nimport TcEnv\nimport Coercion( etaExpandCoAxBranch )\nimport FileCleanup ( newTempName, TempFileLifetime(..) )\n\nimport Control.Monad\n\nimport GHCi.Message\nimport GHCi.RemoteTypes\nimport GHCi\nimport HscMain\n        -- These imports are the reason that TcSplice\n        -- is very high up the module hierarchy\nimport RnSplice( traceSplice, SpliceInfo(..))\nimport RdrName\nimport HscTypes\nimport Convert\nimport RnExpr\nimport RnEnv\nimport RnUtils ( HsDocContext(..) )\nimport RnFixity ( lookupFixityRn_help )\nimport RnTypes\nimport TcHsSyn\nimport TcSimplify\nimport Type\nimport NameSet\nimport TcMType\nimport TcHsType\nimport TcIface\nimport TyCoRep\nimport FamInst\nimport FamInstEnv\nimport InstEnv\nimport Inst\nimport NameEnv\nimport PrelNames\nimport TysWiredIn\nimport OccName\nimport Hooks\nimport Var\nimport Module\nimport LoadIface\nimport Class\nimport TyCon\nimport CoAxiom\nimport PatSyn\nimport ConLike\nimport DataCon\nimport TcEvidence( TcEvBinds(..) )\nimport Id\nimport IdInfo\nimport DsExpr\nimport DsMonad\nimport GHC.Serialized\nimport ErrUtils\nimport Util\nimport Unique\nimport VarSet\nimport Data.List        ( find )\nimport Data.Maybe\nimport FastString\nimport BasicTypes hiding( SuccessFlag(..) )\nimport Maybes( MaybeErr(..) )\nimport DynFlags\nimport Panic\nimport Lexeme\nimport qualified EnumSet\nimport Plugins\nimport Bag\n\nimport qualified Language.Haskell.TH as TH\n-- THSyntax gives access to internal functions and data types\nimport qualified Language.Haskell.TH.Syntax as TH\n\n-- Because GHC.Desugar might not be in the base library of the bootstrapping compiler\nimport GHC.Desugar      ( AnnotationWrapper(..) )\n\nimport Control.Exception\nimport Data.Binary\nimport Data.Binary.Get\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.Lazy as LB\nimport Data.Dynamic  ( fromDynamic, toDyn )\nimport qualified Data.Map as Map\nimport Data.Typeable ( typeOf, Typeable, TypeRep, typeRep )\nimport Data.Data (Data)\nimport Data.Proxy    ( Proxy (..) )\nimport GHC.Exts         ( unsafeCoerce# )\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Main interface + stubs for the non-GHCI case\n*                                                                      *\n************************************************************************\n-}\n\ntcTypedBracket   :: HsExpr GhcRn -> HsBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)\ntcUntypedBracket :: HsExpr GhcRn -> HsBracket GhcRn -> [PendingRnSplice] -> ExpRhoType\n                 -> TcM (HsExpr GhcTcId)\ntcSpliceExpr     :: HsSplice GhcRn  -> ExpRhoType -> TcM (HsExpr GhcTcId)\n        -- None of these functions add constraints to the LIE\n\n-- runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName)\n-- runQuasiQuotePat  :: HsQuasiQuote RdrName -> RnM (LPat RdrName)\n-- runQuasiQuoteType :: HsQuasiQuote RdrName -> RnM (LHsType RdrName)\n-- runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName]\n\nrunAnnotation     :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Quoting an expression}\n*                                                                      *\n************************************************************************\n-}\n\n-- See Note [How brackets and nested splices are handled]\n-- tcTypedBracket :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId)\ntcTypedBracket rn_expr brack@(TExpBr _ expr) res_ty\n  = addErrCtxt (quotationCtxtDoc brack) $\n    do { cur_stage <- getStage\n       ; ps_ref <- newMutVar []\n       ; lie_var <- getConstraintVar   -- Any constraints arising from nested splices\n                                       -- should get thrown into the constraint set\n                                       -- from outside the bracket\n\n       -- Typecheck expr to make sure it is valid,\n       -- Throw away the typechecked expression but return its type.\n       -- We'll typecheck it again when we splice it in somewhere\n       ; (_tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var)) $\n                                tcInferRhoNC expr\n                                -- NC for no context; tcBracket does that\n\n       ; meta_ty <- tcTExpTy expr_ty\n       ; ps' <- readMutVar ps_ref\n       ; texpco <- tcLookupId unsafeTExpCoerceName\n       ; tcWrapResultO (Shouldn'tHappenOrigin \"TExpBr\")\n                       rn_expr\n                       (unLoc (mkHsApp (nlHsTyApp texpco [expr_ty])\n                                      (noLoc (HsTcBracketOut noExt brack ps'))))\n                       meta_ty res_ty }\ntcTypedBracket _ other_brack _\n  = pprPanic \"tcTypedBracket\" (ppr other_brack)\n\n-- tcUntypedBracket :: HsBracket Name -> [PendingRnSplice] -> ExpRhoType -> TcM (HsExpr TcId)\ntcUntypedBracket rn_expr brack ps res_ty\n  = do { traceTc \"tc_bracket untyped\" (ppr brack $$ ppr ps)\n       ; ps' <- mapM tcPendingSplice ps\n       ; meta_ty <- tcBrackTy brack\n       ; traceTc \"tc_bracket done untyped\" (ppr meta_ty)\n       ; tcWrapResultO (Shouldn'tHappenOrigin \"untyped bracket\")\n                       rn_expr (HsTcBracketOut noExt brack ps') meta_ty res_ty }\n\n---------------\ntcBrackTy :: HsBracket GhcRn -> TcM TcType\ntcBrackTy (VarBr {})  = tcMetaTy nameTyConName\n                                           -- Result type is Var (not Q-monadic)\ntcBrackTy (ExpBr {})  = tcMetaTy expQTyConName  -- Result type is ExpQ (= Q Exp)\ntcBrackTy (TypBr {})  = tcMetaTy typeQTyConName -- Result type is Type (= Q Typ)\ntcBrackTy (DecBrG {}) = tcMetaTy decsQTyConName -- Result type is Q [Dec]\ntcBrackTy (PatBr {})  = tcMetaTy patQTyConName  -- Result type is PatQ (= Q Pat)\ntcBrackTy (DecBrL {})   = panic \"tcBrackTy: Unexpected DecBrL\"\ntcBrackTy (TExpBr {})   = panic \"tcUntypedBracket: Unexpected TExpBr\"\ntcBrackTy (XBracket {}) = panic \"tcUntypedBracket: Unexpected XBracket\"\n\n---------------\ntcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice\ntcPendingSplice (PendingRnSplice flavour splice_name expr)\n  = do { res_ty <- tcMetaTy meta_ty_name\n       ; expr' <- tcMonoExpr expr (mkCheckExpType res_ty)\n       ; return (PendingTcSplice splice_name expr') }\n  where\n     meta_ty_name = case flavour of\n                       UntypedExpSplice  -> expQTyConName\n                       UntypedPatSplice  -> patQTyConName\n                       UntypedTypeSplice -> typeQTyConName\n                       UntypedDeclSplice -> decsQTyConName\n\n---------------\n-- Takes a tau and returns the type Q (TExp tau)\ntcTExpTy :: TcType -> TcM TcType\ntcTExpTy exp_ty\n  = do { unless (isTauTy exp_ty) $ addErr (err_msg exp_ty)\n       ; q    <- tcLookupTyCon qTyConName\n       ; texp <- tcLookupTyCon tExpTyConName\n       ; return (mkTyConApp q [mkTyConApp texp [exp_ty]]) }\n  where\n    err_msg ty\n      = vcat [ text \"Illegal polytype:\" <+> ppr ty\n             , text \"The type of a Typed Template Haskell expression must\" <+>\n               text \"not have any quantification.\" ]\n\nquotationCtxtDoc :: HsBracket GhcRn -> SDoc\nquotationCtxtDoc br_body\n  = hang (text \"In the Template Haskell quotation\")\n         2 (ppr br_body)\n\n\n  -- The whole of the rest of the file is the else-branch (ie stage2 only)\n\n{-\nNote [How top-level splices are handled]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTop-level splices (those not inside a [| .. |] quotation bracket) are handled\nvery straightforwardly:\n\n  1. tcTopSpliceExpr: typecheck the body e of the splice $(e)\n\n  2. runMetaT: desugar, compile, run it, and convert result back to\n     HsSyn RdrName (of the appropriate flavour, eg HsType RdrName,\n     HsExpr RdrName etc)\n\n  3. treat the result as if that's what you saw in the first place\n     e.g for HsType, rename and kind-check\n         for HsExpr, rename and type-check\n\n     (The last step is different for decls, because they can *only* be\n      top-level: we return the result of step 2.)\n\nNote [How brackets and nested splices are handled]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNested splices (those inside a [| .. |] quotation bracket),\nare treated quite differently.\n\nRemember, there are two forms of bracket\n         typed   [|| e ||]\n   and untyped   [|  e  |]\n\nThe life cycle of a typed bracket:\n   * Starts as HsBracket\n\n   * When renaming:\n        * Set the ThStage to (Brack s RnPendingTyped)\n        * Rename the body\n        * Result is still a HsBracket\n\n   * When typechecking:\n        * Set the ThStage to (Brack s (TcPending ps_var lie_var))\n        * Typecheck the body, and throw away the elaborated result\n        * Nested splices (which must be typed) are typechecked, and\n          the results accumulated in ps_var; their constraints\n          accumulate in lie_var\n        * Result is a HsTcBracketOut rn_brack pending_splices\n          where rn_brack is the incoming renamed bracket\n\nThe life cycle of a un-typed bracket:\n   * Starts as HsBracket\n\n   * When renaming:\n        * Set the ThStage to (Brack s (RnPendingUntyped ps_var))\n        * Rename the body\n        * Nested splices (which must be untyped) are renamed, and the\n          results accumulated in ps_var\n        * Result is still (HsRnBracketOut rn_body pending_splices)\n\n   * When typechecking a HsRnBracketOut\n        * Typecheck the pending_splices individually\n        * Ignore the body of the bracket; just check that the context\n          expects a bracket of that type (e.g. a [p| pat |] bracket should\n          be in a context needing a (Q Pat)\n        * Result is a HsTcBracketOut rn_brack pending_splices\n          where rn_brack is the incoming renamed bracket\n\n\nIn both cases, desugaring happens like this:\n  * HsTcBracketOut is desugared by DsMeta.dsBracket.  It\n\n      a) Extends the ds_meta environment with the PendingSplices\n         attached to the bracket\n\n      b) Converts the quoted (HsExpr Name) to a CoreExpr that, when\n         run, will produce a suitable TH expression/type/decl.  This\n         is why we leave the *renamed* expression attached to the bracket:\n         the quoted expression should not be decorated with all the goop\n         added by the type checker\n\n  * Each splice carries a unique Name, called a \"splice point\", thus\n    ${n}(e).  The name is initialised to an (Unqual \"splice\") when the\n    splice is created; the renamer gives it a unique.\n\n  * When DsMeta (used to desugar the body of the bracket) comes across\n    a splice, it looks up the splice's Name, n, in the ds_meta envt,\n    to find an (HsExpr Id) that should be substituted for the splice;\n    it just desugars it to get a CoreExpr (DsMeta.repSplice).\n\nExample:\n    Source:       f = [| Just $(g 3) |]\n      The [| |] part is a HsBracket\n\n    Typechecked:  f = [| Just ${s7}(g 3) |]{s7 = g Int 3}\n      The [| |] part is a HsBracketOut, containing *renamed*\n        (not typechecked) expression\n      The \"s7\" is the \"splice point\"; the (g Int 3) part\n        is a typechecked expression\n\n    Desugared:    f = do { s7 <- g Int 3\n                         ; return (ConE \"Data.Maybe.Just\" s7) }\n\n\nNote [Template Haskell state diagram]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHere are the ThStages, s, their corresponding level numbers\n(the result of (thLevel s)), and their state transitions.\nThe top level of the program is stage Comp:\n\n     Start here\n         |\n         V\n      -----------     $      ------------   $\n      |  Comp   | ---------> |  Splice  | -----|\n      |   1     |            |    0     | <----|\n      -----------            ------------\n        ^     |                ^      |\n      $ |     | [||]         $ |      | [||]\n        |     v                |      v\n   --------------          ----------------\n   | Brack Comp |          | Brack Splice |\n   |     2      |          |      1       |\n   --------------          ----------------\n\n* Normal top-level declarations start in state Comp\n       (which has level 1).\n  Annotations start in state Splice, since they are\n       treated very like a splice (only without a '$')\n\n* Code compiled in state Splice (and only such code)\n  will be *run at compile time*, with the result replacing\n  the splice\n\n* The original paper used level -1 instead of 0, etc.\n\n* The original paper did not allow a splice within a\n  splice, but there is no reason not to. This is the\n  $ transition in the top right.\n\nNote [Template Haskell levels]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Imported things are impLevel (= 0)\n\n* However things at level 0 are not *necessarily* imported.\n      eg  $( \\b -> ... )   here b is bound at level 0\n\n* In GHCi, variables bound by a previous command are treated\n  as impLevel, because we have bytecode for them.\n\n* Variables are bound at the \"current level\"\n\n* The current level starts off at outerLevel (= 1)\n\n* The level is decremented by splicing $(..)\n               incremented by brackets [| |]\n               incremented by name-quoting 'f\n\nWhen a variable is used, we compare\n        bind:  binding level, and\n        use:   current level at usage site\n\n  Generally\n        bind > use      Always error (bound later than used)\n                        [| \\x -> $(f x) |]\n\n        bind = use      Always OK (bound same stage as used)\n                        [| \\x -> $(f [| x |]) |]\n\n        bind < use      Inside brackets, it depends\n                        Inside splice, OK\n                        Inside neither, OK\n\n  For (bind < use) inside brackets, there are three cases:\n    - Imported things   OK      f = [| map |]\n    - Top-level things  OK      g = [| f |]\n    - Non-top-level     Only if there is a liftable instance\n                                h = \\(x:Int) -> [| x |]\n\n  To track top-level-ness we use the ThBindEnv in TcLclEnv\n\n  For example:\n           f = ...\n           g1 = $(map ...)         is OK\n           g2 = $(f ...)           is not OK; because we havn't compiled f yet\n\n-}\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Splicing an expression}\n*                                                                      *\n************************************************************************\n-}\n\ntcSpliceExpr splice@(HsTypedSplice _ _ name expr) res_ty\n  = addErrCtxt (spliceCtxtDoc splice) $\n    setSrcSpan (getLoc expr)    $ do\n    { stage <- getStage\n    ; case stage of\n          Splice {}            -> tcTopSplice expr res_ty\n          Brack pop_stage pend -> tcNestedSplice pop_stage pend name expr res_ty\n          RunSplice _          ->\n            -- See Note [RunSplice ThLevel] in \"TcRnTypes\".\n            pprPanic (\"tcSpliceExpr: attempted to typecheck a splice when \" ++\n                      \"running another splice\") (ppr splice)\n          Comp                 -> tcTopSplice expr res_ty\n    }\ntcSpliceExpr splice _\n  = pprPanic \"tcSpliceExpr\" (ppr splice)\n\n{- Note [Collecting modFinalizers in typed splices]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n'qAddModFinalizer' of the @Quasi TcM@ instance adds finalizers in the local\nenvironment (see Note [Delaying modFinalizers in untyped splices] in\n\"RnSplice\"). Thus after executing the splice, we move the finalizers to the\nfinalizer list in the global environment and set them to use the current local\nenvironment (with 'addModFinalizersWithLclEnv').\n\n-}\n\ntcNestedSplice :: ThStage -> PendingStuff -> Name\n                -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)\n    -- See Note [How brackets and nested splices are handled]\n    -- A splice inside brackets\ntcNestedSplice pop_stage (TcPending ps_var lie_var) splice_name expr res_ty\n  = do { res_ty <- expTypeToType res_ty\n       ; meta_exp_ty <- tcTExpTy res_ty\n       ; expr' <- setStage pop_stage $\n                  setConstraintVar lie_var $\n                  tcMonoExpr expr (mkCheckExpType meta_exp_ty)\n       ; untypeq <- tcLookupId unTypeQName\n       ; let expr'' = mkHsApp (nlHsTyApp untypeq [res_ty]) expr'\n       ; ps <- readMutVar ps_var\n       ; writeMutVar ps_var (PendingTcSplice splice_name expr'' : ps)\n\n       -- The returned expression is ignored; it's in the pending splices\n       ; return (panic \"tcSpliceExpr\") }\n\ntcNestedSplice _ _ splice_name _ _\n  = pprPanic \"tcNestedSplice: rename stage found\" (ppr splice_name)\n\ntcTopSplice :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)\ntcTopSplice expr res_ty\n  = do { -- Typecheck the expression,\n         -- making sure it has type Q (T res_ty)\n         res_ty <- expTypeToType res_ty\n       ; meta_exp_ty <- tcTExpTy res_ty\n       ; q_expr <- tcTopSpliceExpr Typed $\n                          tcMonoExpr expr (mkCheckExpType meta_exp_ty)\n       ; lcl_env <- getLclEnv\n       ; let delayed_splice\n              = DelayedSplice lcl_env expr res_ty q_expr\n       ; return (HsSpliceE noExt (HsSplicedT delayed_splice))\n\n       }\n\n\n-- This is called in the zonker\n-- See Note [Running typed splices in the zonker]\nrunTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc)\nrunTopSplice (DelayedSplice lcl_env orig_expr res_ty q_expr)\n  = setLclEnv lcl_env $ do {\n         zonked_ty <- zonkTcType res_ty\n       ; zonked_q_expr <- zonkTopLExpr q_expr\n        -- See Note [Collecting modFinalizers in typed splices].\n       ; modfinalizers_ref <- newTcRef []\n         -- Run the expression\n       ; expr2 <- setStage (RunSplice modfinalizers_ref) $\n                    runMetaE zonked_q_expr\n       ; mod_finalizers <- readTcRef modfinalizers_ref\n       ; addModFinalizersWithLclEnv $ ThModFinalizers mod_finalizers\n       -- We use orig_expr here and not q_expr when tracing as a call to\n       -- unsafeTExpCoerce is added to the original expression by the\n       -- typechecker when typed quotes are type checked.\n       ; traceSplice (SpliceInfo { spliceDescription = \"expression\"\n                                 , spliceIsDecl      = False\n                                 , spliceSource      = Just orig_expr\n                                 , spliceGenerated   = ppr expr2 })\n        -- Rename and typecheck the spliced-in expression,\n        -- making sure it has type res_ty\n        -- These steps should never fail; this is a *typed* splice\n       ; (res, wcs) <-\n            captureConstraints $\n              addErrCtxt (spliceResultDoc zonked_q_expr) $ do\n                { (exp3, _fvs) <- rnLExpr expr2\n                ; tcMonoExpr exp3 (mkCheckExpType zonked_ty)}\n       ; ev <- simplifyTop wcs\n       ; return $ unLoc (mkHsDictLet (EvBinds ev) res)\n       }\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Error messages}\n*                                                                      *\n************************************************************************\n-}\n\nspliceCtxtDoc :: HsSplice GhcRn -> SDoc\nspliceCtxtDoc splice\n  = hang (text \"In the Template Haskell splice\")\n         2 (pprSplice splice)\n\nspliceResultDoc :: LHsExpr GhcTc -> SDoc\nspliceResultDoc expr\n  = sep [ text \"In the result of the splice:\"\n        , nest 2 (char '$' <> ppr expr)\n        , text \"To see what the splice expanded to, use -ddump-splices\"]\n\n-------------------\ntcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)\n-- Note [How top-level splices are handled]\n-- Type check an expression that is the body of a top-level splice\n--   (the caller will compile and run it)\n-- Note that set the level to Splice, regardless of the original level,\n-- before typechecking the expression.  For example:\n--      f x = $( ...$(g 3) ... )\n-- The recursive call to tcPolyExpr will simply expand the\n-- inner escape before dealing with the outer one\n\ntcTopSpliceExpr isTypedSplice tc_action\n  = checkNoErrs $  -- checkNoErrs: must not try to run the thing\n                   -- if the type checker fails!\n    unsetGOptM Opt_DeferTypeErrors $\n                   -- Don't defer type errors.  Not only are we\n                   -- going to run this code, but we do an unsafe\n                   -- coerce, so we get a seg-fault if, say we\n                   -- splice a type into a place where an expression\n                   -- is expected (Trac #7276)\n    setStage (Splice isTypedSplice) $\n    do {    -- Typecheck the expression\n         (expr', wanted) <- captureConstraints tc_action\n       ; const_binds     <- simplifyTop wanted\n\n          -- Zonk it and tie the knot of dictionary bindings\n       ; return $ mkHsDictLet (EvBinds const_binds) expr' }\n\n{-\n************************************************************************\n*                                                                      *\n        Annotations\n*                                                                      *\n************************************************************************\n-}\n\nrunAnnotation target expr = do\n    -- Find the classes we want instances for in order to call toAnnotationWrapper\n    loc <- getSrcSpanM\n    data_class <- tcLookupClass dataClassName\n    to_annotation_wrapper_id <- tcLookupId toAnnotationWrapperName\n\n    -- Check the instances we require live in another module (we want to execute it..)\n    -- and check identifiers live in other modules using TH stage checks. tcSimplifyStagedExpr\n    -- also resolves the LIE constraints to detect e.g. instance ambiguity\n    zonked_wrapped_expr' <- zonkTopLExpr =<< tcTopSpliceExpr Untyped (\n           do { (expr', expr_ty) <- tcInferRhoNC expr\n                -- We manually wrap the typechecked expression in a call to toAnnotationWrapper\n                -- By instantiating the call >here< it gets registered in the\n                -- LIE consulted by tcTopSpliceExpr\n                -- and hence ensures the appropriate dictionary is bound by const_binds\n              ; wrapper <- instCall AnnOrigin [expr_ty] [mkClassPred data_class [expr_ty]]\n              ; let specialised_to_annotation_wrapper_expr\n                      = L loc (mkHsWrap wrapper\n                                 (HsVar noExt (L loc to_annotation_wrapper_id)))\n              ; return (L loc (HsApp noExt\n                                specialised_to_annotation_wrapper_expr expr'))\n                                })\n\n    -- Run the appropriately wrapped expression to get the value of\n    -- the annotation and its dictionaries. The return value is of\n    -- type AnnotationWrapper by construction, so this conversion is\n    -- safe\n    serialized <- runMetaAW zonked_wrapped_expr'\n    return Annotation {\n               ann_target = target,\n               ann_value = serialized\n           }\n\nconvertAnnotationWrapper :: ForeignHValue -> TcM (Either MsgDoc Serialized)\nconvertAnnotationWrapper fhv = do\n  dflags <- getDynFlags\n  if gopt Opt_ExternalInterpreter dflags\n    then do\n      Right <$> runTH THAnnWrapper fhv\n    else do\n      annotation_wrapper <- liftIO $ wormhole dflags fhv\n      return $ Right $\n        case unsafeCoerce# annotation_wrapper of\n           AnnotationWrapper value | let serialized = toSerialized serializeWithData value ->\n               -- Got the value and dictionaries: build the serialized value and\n               -- call it a day. We ensure that we seq the entire serialized value\n               -- in order that any errors in the user-written code for the\n               -- annotation are exposed at this point.  This is also why we are\n               -- doing all this stuff inside the context of runMeta: it has the\n               -- facilities to deal with user error in a meta-level expression\n               seqSerialized serialized `seq` serialized\n\n-- | Force the contents of the Serialized value so weknow it doesn't contain any bottoms\nseqSerialized :: Serialized -> ()\nseqSerialized (Serialized the_type bytes) = the_type `seq` bytes `seqList` ()\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Running an expression}\n*                                                                      *\n************************************************************************\n-}\n\nrunQuasi :: TH.Q a -> TcM a\nrunQuasi act = TH.runQ act\n\nrunRemoteModFinalizers :: ThModFinalizers -> TcM ()\nrunRemoteModFinalizers (ThModFinalizers finRefs) = do\n  dflags <- getDynFlags\n  let withForeignRefs [] f = f []\n      withForeignRefs (x : xs) f = withForeignRef x $ \\r ->\n        withForeignRefs xs $ \\rs -> f (r : rs)\n  if gopt Opt_ExternalInterpreter dflags then do\n    hsc_env <- env_top <$> getEnv\n    withIServ hsc_env $ \\i -> do\n      tcg <- getGblEnv\n      th_state <- readTcRef (tcg_th_remote_state tcg)\n      case th_state of\n        Nothing -> return () -- TH was not started, nothing to do\n        Just fhv -> do\n          liftIO $ withForeignRef fhv $ \\st ->\n            withForeignRefs finRefs $ \\qrefs ->\n              writeIServ i (putMessage (RunModFinalizers st qrefs))\n          () <- runRemoteTH i []\n          readQResult i\n  else do\n    qs <- liftIO (withForeignRefs finRefs $ mapM localRef)\n    runQuasi $ sequence_ qs\n\nrunQResult\n  :: (a -> String)\n  -> (SrcSpan -> a -> b)\n  -> (ForeignHValue -> TcM a)\n  -> SrcSpan\n  -> ForeignHValue {- TH.Q a -}\n  -> TcM b\nrunQResult show_th f runQ expr_span hval\n  = do { th_result <- runQ hval\n       ; traceTc \"Got TH result:\" (text (show_th th_result))\n       ; return (f expr_span th_result) }\n\n\n-----------------\nrunMeta :: (MetaHook TcM -> LHsExpr GhcTc -> TcM hs_syn)\n        -> LHsExpr GhcTc\n        -> TcM hs_syn\nrunMeta unwrap e\n  = do { h <- getHooked runMetaHook defaultRunMeta\n       ; unwrap h e }\n\ndefaultRunMeta :: MetaHook TcM\ndefaultRunMeta (MetaE r)\n  = fmap r . runMeta' True ppr (runQResult TH.pprint convertToHsExpr runTHExp)\ndefaultRunMeta (MetaP r)\n  = fmap r . runMeta' True ppr (runQResult TH.pprint convertToPat runTHPat)\ndefaultRunMeta (MetaT r)\n  = fmap r . runMeta' True ppr (runQResult TH.pprint convertToHsType runTHType)\ndefaultRunMeta (MetaD r)\n  = fmap r . runMeta' True ppr (runQResult TH.pprint convertToHsDecls runTHDec)\ndefaultRunMeta (MetaAW r)\n  = fmap r . runMeta' False (const empty) (const convertAnnotationWrapper)\n    -- We turn off showing the code in meta-level exceptions because doing so exposes\n    -- the toAnnotationWrapper function that we slap around the user's code\n\n----------------\nrunMetaAW :: LHsExpr GhcTc         -- Of type AnnotationWrapper\n          -> TcM Serialized\nrunMetaAW = runMeta metaRequestAW\n\nrunMetaE :: LHsExpr GhcTc          -- Of type (Q Exp)\n         -> TcM (LHsExpr GhcPs)\nrunMetaE = runMeta metaRequestE\n\nrunMetaP :: LHsExpr GhcTc          -- Of type (Q Pat)\n         -> TcM (LPat GhcPs)\nrunMetaP = runMeta metaRequestP\n\nrunMetaT :: LHsExpr GhcTc          -- Of type (Q Type)\n         -> TcM (LHsType GhcPs)\nrunMetaT = runMeta metaRequestT\n\nrunMetaD :: LHsExpr GhcTc          -- Of type Q [Dec]\n         -> TcM [LHsDecl GhcPs]\nrunMetaD = runMeta metaRequestD\n\n---------------\nrunMeta' :: Bool                 -- Whether code should be printed in the exception message\n         -> (hs_syn -> SDoc)                                    -- how to print the code\n         -> (SrcSpan -> ForeignHValue -> TcM (Either MsgDoc hs_syn))        -- How to run x\n         -> LHsExpr GhcTc        -- Of type x; typically x = Q TH.Exp, or\n                                 --    something like that\n         -> TcM hs_syn           -- Of type t\nrunMeta' show_code ppr_hs run_and_convert expr\n  = do  { traceTc \"About to run\" (ppr expr)\n        ; recordThSpliceUse -- seems to be the best place to do this,\n                            -- we catch all kinds of splices and annotations.\n\n        -- Check that we've had no errors of any sort so far.\n        -- For example, if we found an error in an earlier defn f, but\n        -- recovered giving it type f :: forall a.a, it'd be very dodgy\n        -- to carry ont.  Mind you, the staging restrictions mean we won't\n        -- actually run f, but it still seems wrong. And, more concretely,\n        -- see Trac #5358 for an example that fell over when trying to\n        -- reify a function with a \"?\" kind in it.  (These don't occur\n        -- in type-correct programs.\n        ; failIfErrsM\n\n        -- run plugins\n        ; hsc_env <- getTopEnv\n        ; expr' <- withPlugins (hsc_dflags hsc_env) spliceRunAction expr\n\n        -- Desugar\n        ; ds_expr <- initDsTc (dsLExpr expr')\n        -- Compile and link it; might fail if linking fails\n        ; src_span <- getSrcSpanM\n        ; traceTc \"About to run (desugared)\" (ppr ds_expr)\n        ; either_hval <- tryM $ liftIO $\n                         HscMain.hscCompileCoreExpr hsc_env src_span ds_expr\n        ; case either_hval of {\n            Left exn   -> fail_with_exn \"compile and link\" exn ;\n            Right hval -> do\n\n        {       -- Coerce it to Q t, and run it\n\n                -- Running might fail if it throws an exception of any kind (hence tryAllM)\n                -- including, say, a pattern-match exception in the code we are running\n                --\n                -- We also do the TH -> HS syntax conversion inside the same\n                -- exception-cacthing thing so that if there are any lurking\n                -- exceptions in the data structure returned by hval, we'll\n                -- encounter them inside the try\n                --\n                -- See Note [Exceptions in TH]\n          let expr_span = getLoc expr\n        ; either_tval <- tryAllM $\n                         setSrcSpan expr_span $ -- Set the span so that qLocation can\n                                                -- see where this splice is\n             do { mb_result <- run_and_convert expr_span hval\n                ; case mb_result of\n                    Left err     -> failWithTc err\n                    Right result -> do { traceTc \"Got HsSyn result:\" (ppr_hs result)\n                                       ; return $! result } }\n\n        ; case either_tval of\n            Right v -> return v\n            Left se -> case fromException se of\n                         Just IOEnvFailure -> failM -- Error already in Tc monad\n                         _ -> fail_with_exn \"run\" se -- Exception\n        }}}\n  where\n    -- see Note [Concealed TH exceptions]\n    fail_with_exn :: Exception e => String -> e -> TcM a\n    fail_with_exn phase exn = do\n        exn_msg <- liftIO $ Panic.safeShowException exn\n        let msg = vcat [text \"Exception when trying to\" <+> text phase <+> text \"compile-time code:\",\n                        nest 2 (text exn_msg),\n                        if show_code then text \"Code:\" <+> ppr expr else empty]\n        failWithTc msg\n\n{-\nNote [Running typed splices in the zonker]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nSee #15471 for the full discussion.\n\nFor many years typed splices were run immediately after they were type checked\nhowever, this is too early as it means to zonk some type variables before\nthey can be unified with type variables in the surrounding context.\n\nFor example,\n\n```\nmodule A where\n\ntest_foo :: forall a . Q (TExp (a -> a))\ntest_foo = [|| id ||]\n\nmodule B where\n\nimport A\n\nqux = $$(test_foo)\n```\n\nWe would expect `qux` to have inferred type `forall a . a -> a` but if\nwe run the splices too early the unified variables are zonked to `Any`. The\ninferred type is the unusable `Any -> Any`.\n\nTo run the splice, we must compile `test_foo` all the way to byte code.\nBut at the moment when the type checker is looking at the splice, test_foo\nhas type `Q (TExp (alpha -> alpha))` and we\ncertainly can't compile code involving unification variables!\n\nWe could default `alpha` to `Any` but then we infer `qux :: Any -> Any`\nwhich definitely is not what we want.  Moreover, if we had\n  qux = [$$(test_foo), (\\x -> x +1::Int)]\nthen `alpha` would have to be `Int`.\n\nConclusion: we must defer taking decisions about `alpha` until the\ntypechecker is done; and *then* we can run the splice.  It's fine to do it\nlater, because we know it'll produce type-correct code.\n\nDeferring running the splice until later, in the zonker, means that the\nunification variables propagate upwards from the splice into the surrounding\ncontext and are unified correctly.\n\nThis is implemented by storing the arguments we need for running the splice\nin a `DelayedSplice`. In the zonker, the arguments are passed to\n`TcSplice.runTopSplice` and the expression inserted into the AST as normal.\n\n\n\nNote [Exceptions in TH]\n~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have something like this\n        $( f 4 )\nwhere\n        f :: Int -> Q [Dec]\n        f n | n>3       = fail \"Too many declarations\"\n            | otherwise = ...\n\nThe 'fail' is a user-generated failure, and should be displayed as a\nperfectly ordinary compiler error message, not a panic or anything\nlike that.  Here's how it's processed:\n\n  * 'fail' is the monad fail.  The monad instance for Q in TH.Syntax\n    effectively transforms (fail s) to\n        qReport True s >> fail\n    where 'qReport' comes from the Quasi class and fail from its monad\n    superclass.\n\n  * The TcM monad is an instance of Quasi (see TcSplice), and it implements\n    (qReport True s) by using addErr to add an error message to the bag of errors.\n    The 'fail' in TcM raises an IOEnvFailure exception\n\n * 'qReport' forces the message to ensure any exception hidden in unevaluated\n   thunk doesn't get into the bag of errors. Otherwise the following splice\n   will triger panic (Trac #8987):\n        $(fail undefined)\n   See also Note [Concealed TH exceptions]\n\n  * So, when running a splice, we catch all exceptions; then for\n        - an IOEnvFailure exception, we assume the error is already\n                in the error-bag (above)\n        - other errors, we add an error to the bag\n    and then fail\n\nNote [Concealed TH exceptions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen displaying the error message contained in an exception originated from TH\ncode, we need to make sure that the error message itself does not contain an\nexception.  For example, when executing the following splice:\n\n    $( error (\"foo \" ++ error \"bar\") )\n\nthe message for the outer exception is a thunk which will throw the inner\nexception when evaluated.\n\nFor this reason, we display the message of a TH exception using the\n'safeShowException' function, which recursively catches any exception thrown\nwhen showing an error message.\n\n\nTo call runQ in the Tc monad, we need to make TcM an instance of Quasi:\n-}\n\ninstance TH.Quasi TcM where\n  qNewName s = do { u <- newUnique\n                  ; let i = getKey u\n                  ; return (TH.mkNameU s i) }\n\n  -- 'msg' is forced to ensure exceptions don't escape,\n  -- see Note [Exceptions in TH]\n  qReport True msg  = seqList msg $ addErr  (text msg)\n  qReport False msg = seqList msg $ addWarn NoReason (text msg)\n\n  qLocation = do { m <- getModule\n                 ; l <- getSrcSpanM\n                 ; r <- case l of\n                        UnhelpfulSpan _ -> pprPanic \"qLocation: Unhelpful location\"\n                                                    (ppr l)\n                        RealSrcSpan s -> return s\n                 ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)\n                                  , TH.loc_module   = moduleNameString (moduleName m)\n                                  , TH.loc_package  = unitIdString (moduleUnitId m)\n                                  , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r)\n                                  , TH.loc_end = (srcSpanEndLine   r, srcSpanEndCol   r) }) }\n\n  qLookupName       = lookupName\n  qReify            = reify\n  qReifyFixity nm   = lookupThName nm >>= reifyFixity\n  qReifyInstances   = reifyInstances\n  qReifyRoles       = reifyRoles\n  qReifyAnnotations = reifyAnnotations\n  qReifyModule      = reifyModule\n  qReifyConStrictness nm = do { nm' <- lookupThName nm\n                              ; dc  <- tcLookupDataCon nm'\n                              ; let bangs = dataConImplBangs dc\n                              ; return (map reifyDecidedStrictness bangs) }\n\n        -- For qRecover, discard error messages if\n        -- the recovery action is chosen.  Otherwise\n        -- we'll only fail higher up.\n  qRecover recover main = tryTcDiscardingErrs recover main\n\n  qAddDependentFile fp = do\n    ref <- fmap tcg_dependent_files getGblEnv\n    dep_files <- readTcRef ref\n    writeTcRef ref (fp:dep_files)\n\n  qAddTempFile suffix = do\n    dflags <- getDynFlags\n    liftIO $ newTempName dflags TFL_GhcSession suffix\n\n  qAddTopDecls thds = do\n      l <- getSrcSpanM\n      let either_hval = convertToHsDecls l thds\n      ds <- case either_hval of\n              Left exn -> failWithTc $\n                hang (text \"Error in a declaration passed to addTopDecls:\")\n                   2 exn\n              Right ds -> return ds\n      mapM_ (checkTopDecl . unLoc) ds\n      th_topdecls_var <- fmap tcg_th_topdecls getGblEnv\n      updTcRef th_topdecls_var (\\topds -> ds ++ topds)\n    where\n      checkTopDecl :: HsDecl GhcPs -> TcM ()\n      checkTopDecl (ValD _ binds)\n        = mapM_ bindName (collectHsBindBinders binds)\n      checkTopDecl (SigD _ _)\n        = return ()\n      checkTopDecl (AnnD _ _)\n        = return ()\n      checkTopDecl (ForD _ (ForeignImport { fd_name = L _ name }))\n        = bindName name\n      checkTopDecl _\n        = addErr $ text \"Only function, value, annotation, and foreign import declarations may be added with addTopDecl\"\n\n      bindName :: RdrName -> TcM ()\n      bindName (Exact n)\n        = do { th_topnames_var <- fmap tcg_th_topnames getGblEnv\n             ; updTcRef th_topnames_var (\\ns -> extendNameSet ns n)\n             }\n\n      bindName name =\n          addErr $\n          hang (text \"The binder\" <+> quotes (ppr name) <+> ptext (sLit \"is not a NameU.\"))\n             2 (text \"Probable cause: you used mkName instead of newName to generate a binding.\")\n\n  qAddForeignFilePath lang fp = do\n    var <- fmap tcg_th_foreign_files getGblEnv\n    updTcRef var ((lang, fp) :)\n\n  qAddModFinalizer fin = do\n      r <- liftIO $ mkRemoteRef fin\n      fref <- liftIO $ mkForeignRef r (freeRemoteRef r)\n      addModFinalizerRef fref\n\n  qAddCorePlugin plugin = do\n      hsc_env <- env_top <$> getEnv\n      r <- liftIO $ findHomeModule hsc_env (mkModuleName plugin)\n      let err = hang\n            (text \"addCorePlugin: invalid plugin module \"\n               <+> text (show plugin)\n            )\n            2\n            (text \"Plugins in the current package can't be specified.\")\n      case r of\n        Found {} -> addErr err\n        FoundMultiple {} -> addErr err\n        _ -> return ()\n      th_coreplugins_var <- tcg_th_coreplugins <$> getGblEnv\n      updTcRef th_coreplugins_var (plugin:)\n\n  qGetQ :: forall a. Typeable a => TcM (Maybe a)\n  qGetQ = do\n      th_state_var <- fmap tcg_th_state getGblEnv\n      th_state <- readTcRef th_state_var\n      -- See #10596 for why we use a scoped type variable here.\n      return (Map.lookup (typeRep (Proxy :: Proxy a)) th_state >>= fromDynamic)\n\n  qPutQ x = do\n      th_state_var <- fmap tcg_th_state getGblEnv\n      updTcRef th_state_var (\\m -> Map.insert (typeOf x) (toDyn x) m)\n\n  qIsExtEnabled = xoptM\n\n  qExtsEnabled =\n    EnumSet.toList . extensionFlags . hsc_dflags <$> getTopEnv\n\n-- | Adds a mod finalizer reference to the local environment.\naddModFinalizerRef :: ForeignRef (TH.Q ()) -> TcM ()\naddModFinalizerRef finRef = do\n    th_stage <- getStage\n    case th_stage of\n      RunSplice th_modfinalizers_var -> updTcRef th_modfinalizers_var (finRef :)\n      -- This case happens only if a splice is executed and the caller does\n      -- not set the 'ThStage' to 'RunSplice' to collect finalizers.\n      -- See Note [Delaying modFinalizers in untyped splices] in RnSplice.\n      _ ->\n        pprPanic \"addModFinalizer was called when no finalizers were collected\"\n                 (ppr th_stage)\n\n-- | Releases the external interpreter state.\nfinishTH :: TcM ()\nfinishTH = do\n  dflags <- getDynFlags\n  when (gopt Opt_ExternalInterpreter dflags) $ do\n    tcg <- getGblEnv\n    writeTcRef (tcg_th_remote_state tcg) Nothing\n\nrunTHExp :: ForeignHValue -> TcM TH.Exp\nrunTHExp = runTH THExp\n\nrunTHPat :: ForeignHValue -> TcM TH.Pat\nrunTHPat = runTH THPat\n\nrunTHType :: ForeignHValue -> TcM TH.Type\nrunTHType = runTH THType\n\nrunTHDec :: ForeignHValue -> TcM [TH.Dec]\nrunTHDec = runTH THDec\n\nrunTH :: Binary a => THResultType -> ForeignHValue -> TcM a\nrunTH ty fhv = do\n  hsc_env <- env_top <$> getEnv\n  dflags <- getDynFlags\n  if not (gopt Opt_ExternalInterpreter dflags)\n    then do\n       -- Run it in the local TcM\n      hv <- liftIO $ wormhole dflags fhv\n      r <- runQuasi (unsafeCoerce# hv :: TH.Q a)\n      return r\n    else\n      -- Run it on the server.  For an overview of how TH works with\n      -- Remote GHCi, see Note [Remote Template Haskell] in\n      -- libraries/ghci/GHCi/TH.hs.\n      withIServ hsc_env $ \\i -> do\n        rstate <- getTHState i\n        loc <- TH.qLocation\n        liftIO $\n          withForeignRef rstate $ \\state_hv ->\n          withForeignRef fhv $ \\q_hv ->\n            writeIServ i (putMessage (RunTH state_hv q_hv ty (Just loc)))\n        runRemoteTH i []\n        bs <- readQResult i\n        return $! runGet get (LB.fromStrict bs)\n\n\n-- | communicate with a remotely-running TH computation until it finishes.\n-- See Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.\nrunRemoteTH\n  :: IServ\n  -> [Messages]   --  saved from nested calls to qRecover\n  -> TcM ()\nrunRemoteTH iserv recovers = do\n  THMsg msg <- liftIO $ readIServ iserv getTHMessage\n  case msg of\n    RunTHDone -> return ()\n    StartRecover -> do -- Note [TH recover with -fexternal-interpreter]\n      v <- getErrsVar\n      msgs <- readTcRef v\n      writeTcRef v emptyMessages\n      runRemoteTH iserv (msgs : recovers)\n    EndRecover caught_error -> do\n      let (prev_msgs@(prev_warns,prev_errs), rest) = case recovers of\n             [] -> panic \"EndRecover\"\n             a : b -> (a,b)\n      v <- getErrsVar\n      (warn_msgs,_) <- readTcRef v\n      -- keep the warnings only if there were no errors\n      writeTcRef v $ if caught_error\n        then prev_msgs\n        else (prev_warns `unionBags` warn_msgs, prev_errs)\n      runRemoteTH iserv rest\n    _other -> do\n      r <- handleTHMessage msg\n      liftIO $ writeIServ iserv (put r)\n      runRemoteTH iserv recovers\n\n-- | Read a value of type QResult from the iserv\nreadQResult :: Binary a => IServ -> TcM a\nreadQResult i = do\n  qr <- liftIO $ readIServ i get\n  case qr of\n    QDone a -> return a\n    QException str -> liftIO $ throwIO (ErrorCall str)\n    QFail str -> fail str\n\n{- Note [TH recover with -fexternal-interpreter]\n\nRecover is slightly tricky to implement.\n\nThe meaning of \"recover a b\" is\n - Do a\n   - If it finished with no errors, then keep the warnings it generated\n   - If it failed, discard any messages it generated, and do b\n\nNote that \"failed\" here can mean either\n  (1) threw an exception (failTc)\n  (2) generated an error message (addErrTcM)\n\nThe messages are managed by GHC in the TcM monad, whereas the\nexception-handling is done in the ghc-iserv process, so we have to\ncoordinate between the two.\n\nOn the server:\n  - emit a StartRecover message\n  - run \"a; FailIfErrs\" inside a try\n  - emit an (EndRecover x) message, where x = True if \"a; FailIfErrs\" failed\n  - if \"a; FailIfErrs\" failed, run \"b\"\n\nBack in GHC, when we receive:\n\n  FailIfErrrs\n    failTc if there are any error messages (= failIfErrsM)\n  StartRecover\n    save the current messages and start with an empty set.\n  EndRecover caught_error\n    Restore the previous messages,\n    and merge in the new messages if caught_error is false.\n-}\n\n-- | Retrieve (or create, if it hasn't been created already), the\n-- remote TH state.  The TH state is a remote reference to an IORef\n-- QState living on the server, and we have to pass this to each RunTH\n-- call we make.\n--\n-- The TH state is stored in tcg_th_remote_state in the TcGblEnv.\n--\ngetTHState :: IServ -> TcM (ForeignRef (IORef QState))\ngetTHState i = do\n  tcg <- getGblEnv\n  th_state <- readTcRef (tcg_th_remote_state tcg)\n  case th_state of\n    Just rhv -> return rhv\n    Nothing -> do\n      hsc_env <- env_top <$> getEnv\n      fhv <- liftIO $ mkFinalizedHValue hsc_env =<< iservCall i StartTH\n      writeTcRef (tcg_th_remote_state tcg) (Just fhv)\n      return fhv\n\nwrapTHResult :: TcM a -> TcM (THResult a)\nwrapTHResult tcm = do\n  e <- tryM tcm   -- only catch 'fail', treat everything else as catastrophic\n  case e of\n    Left e -> return (THException (show e))\n    Right a -> return (THComplete a)\n\nhandleTHMessage :: THMessage a -> TcM a\nhandleTHMessage msg = case msg of\n  NewName a -> wrapTHResult $ TH.qNewName a\n  Report b str -> wrapTHResult $ TH.qReport b str\n  LookupName b str -> wrapTHResult $ TH.qLookupName b str\n  Reify n -> wrapTHResult $ TH.qReify n\n  ReifyFixity n -> wrapTHResult $ TH.qReifyFixity n\n  ReifyInstances n ts -> wrapTHResult $ TH.qReifyInstances n ts\n  ReifyRoles n -> wrapTHResult $ TH.qReifyRoles n\n  ReifyAnnotations lookup tyrep ->\n    wrapTHResult $ (map B.pack <$> getAnnotationsByTypeRep lookup tyrep)\n  ReifyModule m -> wrapTHResult $ TH.qReifyModule m\n  ReifyConStrictness nm -> wrapTHResult $ TH.qReifyConStrictness nm\n  AddDependentFile f -> wrapTHResult $ TH.qAddDependentFile f\n  AddTempFile s -> wrapTHResult $ TH.qAddTempFile s\n  AddModFinalizer r -> do\n    hsc_env <- env_top <$> getEnv\n    wrapTHResult $ liftIO (mkFinalizedHValue hsc_env r) >>= addModFinalizerRef\n  AddCorePlugin str -> wrapTHResult $ TH.qAddCorePlugin str\n  AddTopDecls decs -> wrapTHResult $ TH.qAddTopDecls decs\n  AddForeignFilePath lang str -> wrapTHResult $ TH.qAddForeignFilePath lang str\n  IsExtEnabled ext -> wrapTHResult $ TH.qIsExtEnabled ext\n  ExtsEnabled -> wrapTHResult $ TH.qExtsEnabled\n  FailIfErrs -> wrapTHResult failIfErrsM\n  _ -> panic (\"handleTHMessage: unexpected message \" ++ show msg)\n\ngetAnnotationsByTypeRep :: TH.AnnLookup -> TypeRep -> TcM [[Word8]]\ngetAnnotationsByTypeRep th_name tyrep\n  = do { name <- lookupThAnnLookup th_name\n       ; topEnv <- getTopEnv\n       ; epsHptAnns <- liftIO $ prepareAnnotations topEnv Nothing\n       ; tcg <- getGblEnv\n       ; let selectedEpsHptAnns = findAnnsByTypeRep epsHptAnns name tyrep\n       ; let selectedTcgAnns = findAnnsByTypeRep (tcg_ann_env tcg) name tyrep\n       ; return (selectedEpsHptAnns ++ selectedTcgAnns) }\n\n{-\n************************************************************************\n*                                                                      *\n            Instance Testing\n*                                                                      *\n************************************************************************\n-}\n\nreifyInstances :: TH.Name -> [TH.Type] -> TcM [TH.Dec]\nreifyInstances th_nm th_tys\n   = addErrCtxt (text \"In the argument of reifyInstances:\"\n                 <+> ppr_th th_nm <+> sep (map ppr_th th_tys)) $\n     do { loc <- getSrcSpanM\n        ; rdr_ty <- cvt loc (mkThAppTs (TH.ConT th_nm) th_tys)\n          -- #9262 says to bring vars into scope, like in HsForAllTy case\n          -- of rnHsTyKi\n        ; let tv_rdrs = extractHsTyRdrTyVars rdr_ty\n          -- Rename  to HsType Name\n        ; ((tv_names, rn_ty), _fvs)\n            <- checkNoErrs $ -- If there are out-of-scope Names here, then we\n                             -- must error before proceeding to typecheck the\n                             -- renamed type, as that will result in GHC\n                             -- internal errors (#13837).\n               bindLRdrNames tv_rdrs $ \\ tv_names ->\n               do { (rn_ty, fvs) <- rnLHsType doc rdr_ty\n                  ; return ((tv_names, rn_ty), fvs) }\n        ; (_tvs, ty)\n            <- pushTcLevelM_   $\n               solveEqualities $ -- Avoid error cascade if there are unsolved\n               bindImplicitTKBndrs_Skol tv_names $\n               fst <$> tcLHsType rn_ty\n        ; ty <- zonkTcTypeToType ty\n                -- Substitute out the meta type variables\n                -- In particular, the type might have kind\n                -- variables inside it (Trac #7477)\n\n        ; traceTc \"reifyInstances\" (ppr ty $$ ppr (tcTypeKind ty))\n        ; case splitTyConApp_maybe ty of   -- This expands any type synonyms\n            Just (tc, tys)                 -- See Trac #7910\n               | Just cls <- tyConClass_maybe tc\n               -> do { inst_envs <- tcGetInstEnvs\n                     ; let (matches, unifies, _) = lookupInstEnv False inst_envs cls tys\n                     ; traceTc \"reifyInstances1\" (ppr matches)\n                     ; reifyClassInstances cls (map fst matches ++ unifies) }\n               | isOpenFamilyTyCon tc\n               -> do { inst_envs <- tcGetFamInstEnvs\n                     ; let matches = lookupFamInstEnv inst_envs tc tys\n                     ; traceTc \"reifyInstances2\" (ppr matches)\n                     ; reifyFamilyInstances tc (map fim_instance matches) }\n            _  -> bale_out (hang (text \"reifyInstances:\" <+> quotes (ppr ty))\n                               2 (text \"is not a class constraint or type family application\")) }\n  where\n    doc = ClassInstanceCtx\n    bale_out msg = failWithTc msg\n\n    cvt :: SrcSpan -> TH.Type -> TcM (LHsType GhcPs)\n    cvt loc th_ty = case convertToHsType loc th_ty of\n                      Left msg -> failWithTc msg\n                      Right ty -> return ty\n\n{-\n************************************************************************\n*                                                                      *\n                        Reification\n*                                                                      *\n************************************************************************\n-}\n\nlookupName :: Bool      -- True  <=> type namespace\n                        -- False <=> value namespace\n           -> String -> TcM (Maybe TH.Name)\nlookupName is_type_name s\n  = do { lcl_env <- getLocalRdrEnv\n       ; case lookupLocalRdrEnv lcl_env rdr_name of\n           Just n  -> return (Just (reifyName n))\n           Nothing -> do { mb_nm <- lookupGlobalOccRn_maybe rdr_name\n                         ; return (fmap reifyName mb_nm) } }\n  where\n    th_name = TH.mkName s       -- Parses M.x into a base of 'x' and a module of 'M'\n\n    occ_fs :: FastString\n    occ_fs = mkFastString (TH.nameBase th_name)\n\n    occ :: OccName\n    occ | is_type_name\n        = if isLexVarSym occ_fs || isLexCon occ_fs\n                             then mkTcOccFS    occ_fs\n                             else mkTyVarOccFS occ_fs\n        | otherwise\n        = if isLexCon occ_fs then mkDataOccFS occ_fs\n                             else mkVarOccFS  occ_fs\n\n    rdr_name = case TH.nameModule th_name of\n                 Nothing  -> mkRdrUnqual occ\n                 Just mod -> mkRdrQual (mkModuleName mod) occ\n\ngetThing :: TH.Name -> TcM TcTyThing\ngetThing th_name\n  = do  { name <- lookupThName th_name\n        ; traceIf (text \"reify\" <+> text (show th_name) <+> brackets (ppr_ns th_name) <+> ppr name)\n        ; tcLookupTh name }\n        -- ToDo: this tcLookup could fail, which would give a\n        --       rather unhelpful error message\n  where\n    ppr_ns (TH.Name _ (TH.NameG TH.DataName  _pkg _mod)) = text \"data\"\n    ppr_ns (TH.Name _ (TH.NameG TH.TcClsName _pkg _mod)) = text \"tc\"\n    ppr_ns (TH.Name _ (TH.NameG TH.VarName   _pkg _mod)) = text \"var\"\n    ppr_ns _ = panic \"reify/ppr_ns\"\n\nreify :: TH.Name -> TcM TH.Info\nreify th_name\n  = do  { traceTc \"reify 1\" (text (TH.showName th_name))\n        ; thing <- getThing th_name\n        ; traceTc \"reify 2\" (ppr thing)\n        ; reifyThing thing }\n\nlookupThName :: TH.Name -> TcM Name\nlookupThName th_name = do\n    mb_name <- lookupThName_maybe th_name\n    case mb_name of\n        Nothing   -> failWithTc (notInScope th_name)\n        Just name -> return name\n\nlookupThName_maybe :: TH.Name -> TcM (Maybe Name)\nlookupThName_maybe th_name\n  =  do { names <- mapMaybeM lookup (thRdrNameGuesses th_name)\n          -- Pick the first that works\n          -- E.g. reify (mkName \"A\") will pick the class A in preference to the data constructor A\n        ; return (listToMaybe names) }\n  where\n    lookup rdr_name\n        = do {  -- Repeat much of lookupOccRn, because we want\n                -- to report errors in a TH-relevant way\n             ; rdr_env <- getLocalRdrEnv\n             ; case lookupLocalRdrEnv rdr_env rdr_name of\n                 Just name -> return (Just name)\n                 Nothing   -> lookupGlobalOccRn_maybe rdr_name }\n\ntcLookupTh :: Name -> TcM TcTyThing\n-- This is a specialised version of TcEnv.tcLookup; specialised mainly in that\n-- it gives a reify-related error message on failure, whereas in the normal\n-- tcLookup, failure is a bug.\ntcLookupTh name\n  = do  { (gbl_env, lcl_env) <- getEnvs\n        ; case lookupNameEnv (tcl_env lcl_env) name of {\n                Just thing -> return thing;\n                Nothing    ->\n\n          case lookupNameEnv (tcg_type_env gbl_env) name of {\n                Just thing -> return (AGlobal thing);\n                Nothing    ->\n\n          -- EZY: I don't think this choice matters, no TH in signatures!\n          if nameIsLocalOrFrom (tcg_semantic_mod gbl_env) name\n          then  -- It's defined in this module\n                failWithTc (notInEnv name)\n\n          else\n     do { mb_thing <- tcLookupImported_maybe name\n        ; case mb_thing of\n            Succeeded thing -> return (AGlobal thing)\n            Failed msg      -> failWithTc msg\n    }}}}\n\nnotInScope :: TH.Name -> SDoc\nnotInScope th_name = quotes (text (TH.pprint th_name)) <+>\n                     text \"is not in scope at a reify\"\n        -- Ugh! Rather an indirect way to display the name\n\nnotInEnv :: Name -> SDoc\nnotInEnv name = quotes (ppr name) <+>\n                     text \"is not in the type environment at a reify\"\n\n------------------------------\nreifyRoles :: TH.Name -> TcM [TH.Role]\nreifyRoles th_name\n  = do { thing <- getThing th_name\n       ; case thing of\n           AGlobal (ATyCon tc) -> return (map reify_role (tyConRoles tc))\n           _ -> failWithTc (text \"No roles associated with\" <+> (ppr thing))\n       }\n  where\n    reify_role Nominal          = TH.NominalR\n    reify_role Representational = TH.RepresentationalR\n    reify_role Phantom          = TH.PhantomR\n\n------------------------------\nreifyThing :: TcTyThing -> TcM TH.Info\n-- The only reason this is monadic is for error reporting,\n-- which in turn is mainly for the case when TH can't express\n-- some random GHC extension\n\nreifyThing (AGlobal (AnId id))\n  = do  { ty <- reifyType (idType id)\n        ; let v = reifyName id\n        ; case idDetails id of\n            ClassOpId cls -> return (TH.ClassOpI v ty (reifyName cls))\n            RecSelId{sel_tycon=RecSelData tc}\n                          -> return (TH.VarI (reifySelector id tc) ty Nothing)\n            _             -> return (TH.VarI     v ty Nothing)\n    }\n\nreifyThing (AGlobal (ATyCon tc))   = reifyTyCon tc\nreifyThing (AGlobal (AConLike (RealDataCon dc)))\n  = do  { let name = dataConName dc\n        ; ty <- reifyType (idType (dataConWrapId dc))\n        ; return (TH.DataConI (reifyName name) ty\n                              (reifyName (dataConOrigTyCon dc)))\n        }\n\nreifyThing (AGlobal (AConLike (PatSynCon ps)))\n  = do { let name = reifyName ps\n       ; ty <- reifyPatSynType (patSynSig ps)\n       ; return (TH.PatSynI name ty) }\n\nreifyThing (ATcId {tct_id = id})\n  = do  { ty1 <- zonkTcType (idType id) -- Make use of all the info we have, even\n                                        -- though it may be incomplete\n        ; ty2 <- reifyType ty1\n        ; return (TH.VarI (reifyName id) ty2 Nothing) }\n\nreifyThing (ATyVar tv tv1)\n  = do { ty1 <- zonkTcTyVar tv1\n       ; ty2 <- reifyType ty1\n       ; return (TH.TyVarI (reifyName tv) ty2) }\n\nreifyThing thing = pprPanic \"reifyThing\" (pprTcTyThingCategory thing)\n\n-------------------------------------------\nreifyAxBranch :: TyCon -> CoAxBranch -> TcM TH.TySynEqn\nreifyAxBranch fam_tc (CoAxBranch { cab_tvs = tvs\n                                 , cab_lhs = lhs\n                                 , cab_rhs = rhs })\n            -- remove kind patterns (#8884)\n  = do { tvs' <- reifyTyVarsToMaybe tvs\n       ; let lhs_types_only = filterOutInvisibleTypes fam_tc lhs\n       ; lhs' <- reifyTypes lhs_types_only\n       ; annot_th_lhs <- zipWith3M annotThType (mkIsPolyTvs fam_tvs)\n                                   lhs_types_only lhs'\n       ; let lhs_type = mkThAppTs (TH.ConT $ reifyName fam_tc) annot_th_lhs\n       ; rhs'  <- reifyType rhs\n       ; return (TH.TySynEqn tvs' lhs_type rhs') }\n  where\n    fam_tvs = tyConVisibleTyVars fam_tc\n\nreifyTyCon :: TyCon -> TcM TH.Info\nreifyTyCon tc\n  | Just cls <- tyConClass_maybe tc\n  = reifyClass cls\n\n  | isFunTyCon tc\n  = return (TH.PrimTyConI (reifyName tc) 2                False)\n\n  | isPrimTyCon tc\n  = return (TH.PrimTyConI (reifyName tc) (length (tyConVisibleTyVars tc))\n                          (isUnliftedTyCon tc))\n\n  | isTypeFamilyTyCon tc\n  = do { let tvs      = tyConTyVars tc\n             res_kind = tyConResKind tc\n             resVar   = famTcResVar tc\n\n       ; kind' <- reifyKind res_kind\n       ; let (resultSig, injectivity) =\n                 case resVar of\n                   Nothing   -> (TH.KindSig kind', Nothing)\n                   Just name ->\n                     let thName   = reifyName name\n                         injAnnot = tyConInjectivityInfo tc\n                         sig = TH.TyVarSig (TH.KindedTV thName kind')\n                         inj = case injAnnot of\n                                 NotInjective -> Nothing\n                                 Injective ms ->\n                                     Just (TH.InjectivityAnn thName injRHS)\n                                   where\n                                     injRHS = map (reifyName . tyVarName)\n                                                  (filterByList ms tvs)\n                     in (sig, inj)\n       ; tvs' <- reifyTyVars (tyConVisibleTyVars tc)\n       ; let tfHead =\n               TH.TypeFamilyHead (reifyName tc) tvs' resultSig injectivity\n       ; if isOpenTypeFamilyTyCon tc\n         then do { fam_envs <- tcGetFamInstEnvs\n                 ; instances <- reifyFamilyInstances tc\n                                  (familyInstances fam_envs tc)\n                 ; return (TH.FamilyI (TH.OpenTypeFamilyD tfHead) instances) }\n         else do { eqns <-\n                     case isClosedSynFamilyTyConWithAxiom_maybe tc of\n                       Just ax -> mapM (reifyAxBranch tc) $\n                                  fromBranches $ coAxiomBranches ax\n                       Nothing -> return []\n                 ; return (TH.FamilyI (TH.ClosedTypeFamilyD tfHead eqns)\n                      []) } }\n\n  | isDataFamilyTyCon tc\n  = do { let res_kind = tyConResKind tc\n\n       ; kind' <- fmap Just (reifyKind res_kind)\n\n       ; tvs' <- reifyTyVars (tyConVisibleTyVars tc)\n       ; fam_envs <- tcGetFamInstEnvs\n       ; instances <- reifyFamilyInstances tc (familyInstances fam_envs tc)\n       ; return (TH.FamilyI\n                       (TH.DataFamilyD (reifyName tc) tvs' kind') instances) }\n\n  | Just (_, rhs) <- synTyConDefn_maybe tc  -- Vanilla type synonym\n  = do { rhs' <- reifyType rhs\n       ; tvs' <- reifyTyVars (tyConVisibleTyVars tc)\n       ; return (TH.TyConI\n                   (TH.TySynD (reifyName tc) tvs' rhs'))\n       }\n\n  | otherwise\n  = do  { cxt <- reifyCxt (tyConStupidTheta tc)\n        ; let tvs      = tyConTyVars tc\n              dataCons = tyConDataCons tc\n              isGadt   = isGadtSyntaxTyCon tc\n        ; cons <- mapM (reifyDataCon isGadt (mkTyVarTys tvs)) dataCons\n        ; r_tvs <- reifyTyVars (tyConVisibleTyVars tc)\n        ; let name = reifyName tc\n              deriv = []        -- Don't know about deriving\n              decl | isNewTyCon tc =\n                       TH.NewtypeD cxt name r_tvs Nothing (head cons) deriv\n                   | otherwise     =\n                       TH.DataD    cxt name r_tvs Nothing       cons  deriv\n        ; return (TH.TyConI decl) }\n\nreifyDataCon :: Bool -> [Type] -> DataCon -> TcM TH.Con\nreifyDataCon isGadtDataCon tys dc\n  = do { let -- used for H98 data constructors\n             (ex_tvs, theta, arg_tys)\n                 = dataConInstSig dc tys\n             -- used for GADTs data constructors\n             g_user_tvs' = dataConUserTyVars dc\n             (g_univ_tvs, _, g_eq_spec, g_theta', g_arg_tys', g_res_ty')\n                 = dataConFullSig dc\n             (srcUnpks, srcStricts)\n                 = mapAndUnzip reifySourceBang (dataConSrcBangs dc)\n             dcdBangs  = zipWith TH.Bang srcUnpks srcStricts\n             fields    = dataConFieldLabels dc\n             name      = reifyName dc\n             -- Universal tvs present in eq_spec need to be filtered out, as\n             -- they will not appear anywhere in the type.\n             eq_spec_tvs = mkVarSet (map eqSpecTyVar g_eq_spec)\n\n       ; (univ_subst, _)\n              -- See Note [Freshen reified GADT constructors' universal tyvars]\n           <- freshenTyVarBndrs $\n              filterOut (`elemVarSet` eq_spec_tvs) g_univ_tvs\n       ; let (tvb_subst, g_user_tvs) = substTyVarBndrs univ_subst g_user_tvs'\n             g_theta   = substTys tvb_subst g_theta'\n             g_arg_tys = substTys tvb_subst g_arg_tys'\n             g_res_ty  = substTy  tvb_subst g_res_ty'\n\n       ; r_arg_tys <- reifyTypes (if isGadtDataCon then g_arg_tys else arg_tys)\n\n       ; main_con <-\n           if | not (null fields) && not isGadtDataCon ->\n                  return $ TH.RecC name (zip3 (map reifyFieldLabel fields)\n                                         dcdBangs r_arg_tys)\n              | not (null fields) -> do\n                  { res_ty <- reifyType g_res_ty\n                  ; return $ TH.RecGadtC [name]\n                                     (zip3 (map (reifyName . flSelector) fields)\n                                      dcdBangs r_arg_tys) res_ty }\n                -- We need to check not isGadtDataCon here because GADT\n                -- constructors can be declared infix.\n                -- See Note [Infix GADT constructors] in TcTyClsDecls.\n              | dataConIsInfix dc && not isGadtDataCon ->\n                  ASSERT( arg_tys `lengthIs` 2 ) do\n                  { let [r_a1, r_a2] = r_arg_tys\n                        [s1,   s2]   = dcdBangs\n                  ; return $ TH.InfixC (s1,r_a1) name (s2,r_a2) }\n              | isGadtDataCon -> do\n                  { res_ty <- reifyType g_res_ty\n                  ; return $ TH.GadtC [name] (dcdBangs `zip` r_arg_tys) res_ty }\n              | otherwise ->\n                  return $ TH.NormalC name (dcdBangs `zip` r_arg_tys)\n\n       ; let (ex_tvs', theta') | isGadtDataCon = (g_user_tvs, g_theta)\n                               | otherwise     = ASSERT( all isTyVar ex_tvs )\n                                                 -- no covars for haskell syntax\n                                                 (ex_tvs, theta)\n             ret_con | null ex_tvs' && null theta' = return main_con\n                     | otherwise                   = do\n                         { cxt <- reifyCxt theta'\n                         ; ex_tvs'' <- reifyTyVars ex_tvs'\n                         ; return (TH.ForallC ex_tvs'' cxt main_con) }\n       ; ASSERT( arg_tys `equalLength` dcdBangs )\n         ret_con }\n\n{-\nNote [Freshen reified GADT constructors' universal tyvars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose one were to reify this GADT:\n\n  data a :~: b where\n    Refl :: forall a b. (a ~ b) => a :~: b\n\nWe ought to be careful here about the uniques we give to the occurrences of `a`\nand `b` in this definition. That is because in the original DataCon, all uses\nof `a` and `b` have the same unique, since `a` and `b` are both universally\nquantified type variables--that is, they are used in both the (:~:) tycon as\nwell as in the constructor type signature. But when we turn the DataCon\ndefinition into the reified one, the `a` and `b` in the constructor type\nsignature becomes differently scoped than the `a` and `b` in `data a :~: b`.\n\nWhile it wouldn't technically be *wrong* per se to re-use the same uniques for\n`a` and `b` across these two different scopes, it's somewhat annoying for end\nusers of Template Haskell, since they wouldn't be able to rely on the\nassumption that all TH names have globally distinct uniques (#13885). For this\nreason, we freshen the universally quantified tyvars that go into the reified\nGADT constructor type signature to give them distinct uniques from their\ncounterparts in the tycon.\n-}\n\n------------------------------\nreifyClass :: Class -> TcM TH.Info\nreifyClass cls\n  = do  { cxt <- reifyCxt theta\n        ; inst_envs <- tcGetInstEnvs\n        ; insts <- reifyClassInstances cls (InstEnv.classInstances inst_envs cls)\n        ; assocTys <- concatMapM reifyAT ats\n        ; ops <- concatMapM reify_op op_stuff\n        ; tvs' <- reifyTyVars (tyConVisibleTyVars (classTyCon cls))\n        ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' (assocTys ++ ops)\n        ; return (TH.ClassI dec insts) }\n  where\n    (_, fds, theta, _, ats, op_stuff) = classExtraBigSig cls\n    fds' = map reifyFunDep fds\n    reify_op (op, def_meth)\n      = do { let (_, _, ty) = tcSplitMethodTy (idType op)\n               -- Use tcSplitMethodTy to get rid of the extraneous class\n               -- variables and predicates at the beginning of op's type\n               -- (see #15551).\n           ; ty' <- reifyType ty\n           ; let nm' = reifyName op\n           ; case def_meth of\n                Just (_, GenericDM gdm_ty) ->\n                  do { gdm_ty' <- reifyType gdm_ty\n                     ; return [TH.SigD nm' ty', TH.DefaultSigD nm' gdm_ty'] }\n                _ -> return [TH.SigD nm' ty'] }\n\n    reifyAT :: ClassATItem -> TcM [TH.Dec]\n    reifyAT (ATI tycon def) = do\n      tycon' <- reifyTyCon tycon\n      case tycon' of\n        TH.FamilyI dec _ -> do\n          let (tyName, tyArgs) = tfNames dec\n          (dec :) <$> maybe (return [])\n                            (fmap (:[]) . reifyDefImpl tyName tyArgs . fst)\n                            def\n        _ -> pprPanic \"reifyAT\" (text (show tycon'))\n\n    reifyDefImpl :: TH.Name -> [TH.Name] -> Type -> TcM TH.Dec\n    reifyDefImpl n args ty =\n      TH.TySynInstD . TH.TySynEqn Nothing (mkThAppTs (TH.ConT n) (map TH.VarT args))\n                                  <$> reifyType ty\n\n    tfNames :: TH.Dec -> (TH.Name, [TH.Name])\n    tfNames (TH.OpenTypeFamilyD (TH.TypeFamilyHead n args _ _))\n      = (n, map bndrName args)\n    tfNames d = pprPanic \"tfNames\" (text (show d))\n\n    bndrName :: TH.TyVarBndr -> TH.Name\n    bndrName (TH.PlainTV n)    = n\n    bndrName (TH.KindedTV n _) = n\n\n------------------------------\n-- | Annotate (with TH.SigT) a type if the first parameter is True\n-- and if the type contains a free variable.\n-- This is used to annotate type patterns for poly-kinded tyvars in\n-- reifying class and type instances. See #8953 and th/T8953.\nannotThType :: Bool   -- True <=> annotate\n            -> TyCoRep.Type -> TH.Type -> TcM TH.Type\n  -- tiny optimization: if the type is annotated, don't annotate again.\nannotThType _    _  th_ty@(TH.SigT {}) = return th_ty\nannotThType True ty th_ty\n  | not $ isEmptyVarSet $ filterVarSet isTyVar $ tyCoVarsOfType ty\n  = do { let ki = tcTypeKind ty\n       ; th_ki <- reifyKind ki\n       ; return (TH.SigT th_ty th_ki) }\nannotThType _    _ th_ty = return th_ty\n\n-- | For every type variable in the input,\n-- report whether or not the tv is poly-kinded. This is used to eventually\n-- feed into 'annotThType'.\nmkIsPolyTvs :: [TyVar] -> [Bool]\nmkIsPolyTvs = map is_poly_tv\n  where\n    is_poly_tv tv = not $\n                    isEmptyVarSet $\n                    filterVarSet isTyVar $\n                    tyCoVarsOfType $\n                    tyVarKind tv\n\n------------------------------\nreifyClassInstances :: Class -> [ClsInst] -> TcM [TH.Dec]\nreifyClassInstances cls insts\n  = mapM (reifyClassInstance (mkIsPolyTvs tvs)) insts\n  where\n    tvs = tyConVisibleTyVars (classTyCon cls)\n\nreifyClassInstance :: [Bool]  -- True <=> the corresponding tv is poly-kinded\n                              -- includes only *visible* tvs\n                   -> ClsInst -> TcM TH.Dec\nreifyClassInstance is_poly_tvs i\n  = do { cxt <- reifyCxt theta\n       ; let vis_types = filterOutInvisibleTypes cls_tc types\n       ; thtypes <- reifyTypes vis_types\n       ; annot_thtypes <- zipWith3M annotThType is_poly_tvs vis_types thtypes\n       ; let head_ty = mkThAppTs (TH.ConT (reifyName cls)) annot_thtypes\n       ; return $ (TH.InstanceD over cxt head_ty []) }\n  where\n     (_tvs, theta, cls, types) = tcSplitDFunTy (idType dfun)\n     cls_tc   = classTyCon cls\n     dfun     = instanceDFunId i\n     over     = case overlapMode (is_flag i) of\n                  NoOverlap _     -> Nothing\n                  Overlappable _  -> Just TH.Overlappable\n                  Overlapping _   -> Just TH.Overlapping\n                  Overlaps _      -> Just TH.Overlaps\n                  Incoherent _    -> Just TH.Incoherent\n\n------------------------------\nreifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec]\nreifyFamilyInstances fam_tc fam_insts\n  = mapM (reifyFamilyInstance (mkIsPolyTvs fam_tvs)) fam_insts\n  where\n    fam_tvs = tyConVisibleTyVars fam_tc\n\nreifyFamilyInstance :: [Bool] -- True <=> the corresponding tv is poly-kinded\n                              -- includes only *visible* tvs\n                    -> FamInst -> TcM TH.Dec\nreifyFamilyInstance is_poly_tvs (FamInst { fi_flavor = flavor\n                                         , fi_axiom = ax\n                                         , fi_fam = fam })\n  | let fam_tc = coAxiomTyCon ax\n        branch = coAxiomSingleBranch ax\n  , CoAxBranch { cab_tvs = tvs, cab_lhs = lhs, cab_rhs = rhs } <- branch\n  = case flavor of\n      SynFamilyInst ->\n               -- remove kind patterns (#8884)\n        do { th_tvs <- reifyTyVarsToMaybe tvs\n           ; let lhs_types_only = filterOutInvisibleTypes fam_tc lhs\n           ; th_lhs <- reifyTypes lhs_types_only\n           ; annot_th_lhs <- zipWith3M annotThType is_poly_tvs lhs_types_only\n                                                   th_lhs\n           ; let lhs_type = mkThAppTs (TH.ConT $ reifyName fam) annot_th_lhs\n           ; th_rhs <- reifyType rhs\n           ; return (TH.TySynInstD (TH.TySynEqn th_tvs lhs_type th_rhs)) }\n\n      DataFamilyInst rep_tc ->\n        do { let -- eta-expand lhs types, because sometimes data/newtype\n                 -- instances are eta-reduced; See Trac #9692\n                 -- See Note [Eta reduction for data families] in FamInstEnv\n                 (ee_tvs, ee_lhs, _) = etaExpandCoAxBranch branch\n                 fam'     = reifyName fam\n                 dataCons = tyConDataCons rep_tc\n                 isGadt   = isGadtSyntaxTyCon rep_tc\n           ; th_tvs <- reifyTyVarsToMaybe ee_tvs\n           ; cons <- mapM (reifyDataCon isGadt (mkTyVarTys ee_tvs)) dataCons\n           ; let types_only = filterOutInvisibleTypes fam_tc ee_lhs\n           ; th_tys <- reifyTypes types_only\n           ; annot_th_tys <- zipWith3M annotThType is_poly_tvs types_only th_tys\n           ; let lhs_type = mkThAppTs (TH.ConT fam') annot_th_tys\n           ; return $\n               if isNewTyCon rep_tc\n               then TH.NewtypeInstD [] th_tvs lhs_type Nothing (head cons) []\n               else TH.DataInstD    [] th_tvs lhs_type Nothing       cons  []\n           }\n\n------------------------------\nreifyType :: TyCoRep.Type -> TcM TH.Type\n-- Monadic only because of failure\nreifyType ty                | tcIsLiftedTypeKind ty = return TH.StarT\n  -- Make sure to use tcIsLiftedTypeKind here, since we don't want to confuse it\n  -- with Constraint (#14869).\nreifyType ty@(ForAllTy (Bndr _ argf) _)\n                            = reify_for_all argf ty\nreifyType (LitTy t)         = do { r <- reifyTyLit t; return (TH.LitT r) }\nreifyType (TyVarTy tv)      = return (TH.VarT (reifyName tv))\nreifyType (TyConApp tc tys) = reify_tc_app tc tys   -- Do not expand type synonyms here\nreifyType ty@(AppTy {})     = do\n  let (ty_head, ty_args) = splitAppTys ty\n  ty_head' <- reifyType ty_head\n  ty_args' <- reifyTypes (filter_out_invisible_args ty_head ty_args)\n  pure $ mkThAppTs ty_head' ty_args'\n  where\n    -- Make sure to filter out any invisible arguments. For instance, if you\n    -- reify the following:\n    --\n    --   newtype T (f :: forall a. a -> Type) = MkT (f Bool)\n    --\n    -- Then you should receive back `f Bool`, not `f Type Bool`, since the\n    -- `Type` argument is invisible (#15792).\n    filter_out_invisible_args :: Type -> [Type] -> [Type]\n    filter_out_invisible_args ty_head ty_args =\n      filterByList (map isVisibleArgFlag $ appTyArgFlags ty_head ty_args)\n                   ty_args\nreifyType ty@(FunTy { ft_af = af, ft_arg = t1, ft_res = t2 })\n  | InvisArg <- af = reify_for_all Inferred ty  -- Types like ((?x::Int) => Char -> Char)\n  | otherwise      = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) }\nreifyType (CastTy t _)      = reifyType t -- Casts are ignored in TH\nreifyType ty@(CoercionTy {})= noTH (sLit \"coercions in types\") (ppr ty)\n\nreify_for_all :: TyCoRep.ArgFlag -> TyCoRep.Type -> TcM TH.Type\n-- Arg of reify_for_all is always ForAllTy or a predicate FunTy\nreify_for_all argf ty = do\n  tvs' <- reifyTyVars tvs\n  case argToForallVisFlag argf of\n    ForallVis   -> do phi' <- reifyType phi\n                      pure $ TH.ForallVisT tvs' phi'\n    ForallInvis -> do let (cxt, tau) = tcSplitPhiTy phi\n                      cxt' <- reifyCxt cxt\n                      tau' <- reifyType tau\n                      pure $ TH.ForallT tvs' cxt' tau'\n  where\n    (tvs, phi) = tcSplitForAllTysSameVis argf ty\n\nreifyTyLit :: TyCoRep.TyLit -> TcM TH.TyLit\nreifyTyLit (NumTyLit n) = return (TH.NumTyLit n)\nreifyTyLit (StrTyLit s) = return (TH.StrTyLit (unpackFS s))\n\nreifyTypes :: [Type] -> TcM [TH.Type]\nreifyTypes = mapM reifyType\n\nreifyPatSynType\n  :: ([TyVar], ThetaType, [TyVar], ThetaType, [Type], Type) -> TcM TH.Type\n-- reifies a pattern synonym's type and returns its *complete* type\n-- signature; see NOTE [Pattern synonym signatures and Template\n-- Haskell]\nreifyPatSynType (univTyVars, req, exTyVars, prov, argTys, resTy)\n  = do { univTyVars' <- reifyTyVars univTyVars\n       ; req'        <- reifyCxt req\n       ; exTyVars'   <- reifyTyVars exTyVars\n       ; prov'       <- reifyCxt prov\n       ; tau'        <- reifyType (mkVisFunTys argTys resTy)\n       ; return $ TH.ForallT univTyVars' req'\n                $ TH.ForallT exTyVars' prov' tau' }\n\nreifyKind :: Kind -> TcM TH.Kind\nreifyKind = reifyType\n\nreifyCxt :: [PredType] -> TcM [TH.Pred]\nreifyCxt   = mapM reifyType\n\nreifyFunDep :: ([TyVar], [TyVar]) -> TH.FunDep\nreifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)\n\nreifyTyVars :: [TyVar] -> TcM [TH.TyVarBndr]\nreifyTyVars tvs = mapM reify_tv tvs\n  where\n    -- even if the kind is *, we need to include a kind annotation,\n    -- in case a poly-kind would be inferred without the annotation.\n    -- See #8953 or test th/T8953\n    reify_tv tv = TH.KindedTV name <$> reifyKind kind\n      where\n        kind = tyVarKind tv\n        name = reifyName tv\n\nreifyTyVarsToMaybe :: [TyVar] -> TcM (Maybe [TH.TyVarBndr])\nreifyTyVarsToMaybe []  = pure Nothing\nreifyTyVarsToMaybe tys = Just <$> reifyTyVars tys\n\nreify_tc_app :: TyCon -> [Type.Type] -> TcM TH.Type\nreify_tc_app tc tys\n  = do { tys' <- reifyTypes (filterOutInvisibleTypes tc tys)\n       ; maybe_sig_t (mkThAppTs r_tc tys') }\n  where\n    arity       = tyConArity tc\n\n    r_tc | isUnboxedSumTyCon tc           = TH.UnboxedSumT (arity `div` 2)\n         | isUnboxedTupleTyCon tc         = TH.UnboxedTupleT (arity `div` 2)\n         | isPromotedTupleTyCon tc        = TH.PromotedTupleT (arity `div` 2)\n             -- See Note [Unboxed tuple RuntimeRep vars] in TyCon\n         | isTupleTyCon tc                = if isPromotedDataCon tc\n                                            then TH.PromotedTupleT arity\n                                            else TH.TupleT arity\n         | tc `hasKey` constraintKindTyConKey\n                                          = TH.ConstraintT\n         | tc `hasKey` funTyConKey        = TH.ArrowT\n         | tc `hasKey` listTyConKey       = TH.ListT\n         | tc `hasKey` nilDataConKey      = TH.PromotedNilT\n         | tc `hasKey` consDataConKey     = TH.PromotedConsT\n         | tc `hasKey` heqTyConKey        = TH.EqualityT\n         | tc `hasKey` eqPrimTyConKey     = TH.EqualityT\n         | tc `hasKey` eqReprPrimTyConKey = TH.ConT (reifyName coercibleTyCon)\n         | isPromotedDataCon tc           = TH.PromotedT (reifyName tc)\n         | otherwise                      = TH.ConT (reifyName tc)\n\n    -- See Note [When does a tycon application need an explicit kind\n    -- signature?] in TyCoRep\n    maybe_sig_t th_type\n      | tyConAppNeedsKindSig\n          False -- We don't reify types using visible kind applications, so\n                -- don't count specified binders as contributing towards\n                -- injective positions in the kind of the tycon.\n          tc (length tys)\n      = do { let full_kind = tcTypeKind (mkTyConApp tc tys)\n           ; th_full_kind <- reifyKind full_kind\n           ; return (TH.SigT th_type th_full_kind) }\n      | otherwise\n      = return th_type\n\n------------------------------\nreifyName :: NamedThing n => n -> TH.Name\nreifyName thing\n  | isExternalName name = mk_varg pkg_str mod_str occ_str\n  | otherwise           = TH.mkNameU occ_str (getKey (getUnique name))\n        -- Many of the things we reify have local bindings, and\n        -- NameL's aren't supposed to appear in binding positions, so\n        -- we use NameU.  When/if we start to reify nested things, that\n        -- have free variables, we may need to generate NameL's for them.\n  where\n    name    = getName thing\n    mod     = ASSERT( isExternalName name ) nameModule name\n    pkg_str = unitIdString (moduleUnitId mod)\n    mod_str = moduleNameString (moduleName mod)\n    occ_str = occNameString occ\n    occ     = nameOccName name\n    mk_varg | OccName.isDataOcc occ = TH.mkNameG_d\n            | OccName.isVarOcc  occ = TH.mkNameG_v\n            | OccName.isTcOcc   occ = TH.mkNameG_tc\n            | otherwise             = pprPanic \"reifyName\" (ppr name)\n\n-- See Note [Reifying field labels]\nreifyFieldLabel :: FieldLabel -> TH.Name\nreifyFieldLabel fl\n  | flIsOverloaded fl\n              = TH.Name (TH.mkOccName occ_str) (TH.NameQ (TH.mkModName mod_str))\n  | otherwise = TH.mkNameG_v pkg_str mod_str occ_str\n  where\n    name    = flSelector fl\n    mod     = ASSERT( isExternalName name ) nameModule name\n    pkg_str = unitIdString (moduleUnitId mod)\n    mod_str = moduleNameString (moduleName mod)\n    occ_str = unpackFS (flLabel fl)\n\nreifySelector :: Id -> TyCon -> TH.Name\nreifySelector id tc\n  = case find ((idName id ==) . flSelector) (tyConFieldLabels tc) of\n      Just fl -> reifyFieldLabel fl\n      Nothing -> pprPanic \"reifySelector: missing field\" (ppr id $$ ppr tc)\n\n------------------------------\nreifyFixity :: Name -> TcM (Maybe TH.Fixity)\nreifyFixity name\n  = do { (found, fix) <- lookupFixityRn_help name\n       ; return (if found then Just (conv_fix fix) else Nothing) }\n    where\n      conv_fix (BasicTypes.Fixity _ i d) = TH.Fixity i (conv_dir d)\n      conv_dir BasicTypes.InfixR = TH.InfixR\n      conv_dir BasicTypes.InfixL = TH.InfixL\n      conv_dir BasicTypes.InfixN = TH.InfixN\n\nreifyUnpackedness :: DataCon.SrcUnpackedness -> TH.SourceUnpackedness\nreifyUnpackedness NoSrcUnpack = TH.NoSourceUnpackedness\nreifyUnpackedness SrcNoUnpack = TH.SourceNoUnpack\nreifyUnpackedness SrcUnpack   = TH.SourceUnpack\n\nreifyStrictness :: DataCon.SrcStrictness -> TH.SourceStrictness\nreifyStrictness NoSrcStrict = TH.NoSourceStrictness\nreifyStrictness SrcStrict   = TH.SourceStrict\nreifyStrictness SrcLazy     = TH.SourceLazy\n\nreifySourceBang :: DataCon.HsSrcBang\n                -> (TH.SourceUnpackedness, TH.SourceStrictness)\nreifySourceBang (HsSrcBang _ u s) = (reifyUnpackedness u, reifyStrictness s)\n\nreifyDecidedStrictness :: DataCon.HsImplBang -> TH.DecidedStrictness\nreifyDecidedStrictness HsLazy     = TH.DecidedLazy\nreifyDecidedStrictness HsStrict   = TH.DecidedStrict\nreifyDecidedStrictness HsUnpack{} = TH.DecidedUnpack\n\n------------------------------\nlookupThAnnLookup :: TH.AnnLookup -> TcM CoreAnnTarget\nlookupThAnnLookup (TH.AnnLookupName th_nm) = fmap NamedTarget (lookupThName th_nm)\nlookupThAnnLookup (TH.AnnLookupModule (TH.Module pn mn))\n  = return $ ModuleTarget $\n    mkModule (stringToUnitId $ TH.pkgString pn) (mkModuleName $ TH.modString mn)\n\nreifyAnnotations :: Data a => TH.AnnLookup -> TcM [a]\nreifyAnnotations th_name\n  = do { name <- lookupThAnnLookup th_name\n       ; topEnv <- getTopEnv\n       ; epsHptAnns <- liftIO $ prepareAnnotations topEnv Nothing\n       ; tcg <- getGblEnv\n       ; let selectedEpsHptAnns = findAnns deserializeWithData epsHptAnns name\n       ; let selectedTcgAnns = findAnns deserializeWithData (tcg_ann_env tcg) name\n       ; return (selectedEpsHptAnns ++ selectedTcgAnns) }\n\n------------------------------\nmodToTHMod :: Module -> TH.Module\nmodToTHMod m = TH.Module (TH.PkgName $ unitIdString  $ moduleUnitId m)\n                         (TH.ModName $ moduleNameString $ moduleName m)\n\nreifyModule :: TH.Module -> TcM TH.ModuleInfo\nreifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do\n  this_mod <- getModule\n  let reifMod = mkModule (stringToUnitId pkgString) (mkModuleName mString)\n  if (reifMod == this_mod) then reifyThisModule else reifyFromIface reifMod\n    where\n      reifyThisModule = do\n        usages <- fmap (map modToTHMod . moduleEnvKeys . imp_mods) getImports\n        return $ TH.ModuleInfo usages\n\n      reifyFromIface reifMod = do\n        iface <- loadInterfaceForModule (text \"reifying module from TH for\" <+> ppr reifMod) reifMod\n        let usages = [modToTHMod m | usage <- mi_usages iface,\n                                     Just m <- [usageToModule (moduleUnitId reifMod) usage] ]\n        return $ TH.ModuleInfo usages\n\n      usageToModule :: UnitId -> Usage -> Maybe Module\n      usageToModule _ (UsageFile {}) = Nothing\n      usageToModule this_pkg (UsageHomeModule { usg_mod_name = mn }) = Just $ mkModule this_pkg mn\n      usageToModule _ (UsagePackageModule { usg_mod = m }) = Just m\n      usageToModule _ (UsageMergedRequirement { usg_mod = m }) = Just m\n\n------------------------------\nmkThAppTs :: TH.Type -> [TH.Type] -> TH.Type\nmkThAppTs fun_ty arg_tys = foldl' TH.AppT fun_ty arg_tys\n\nnoTH :: PtrString -> SDoc -> TcM a\nnoTH s d = failWithTc (hsep [text \"Can't represent\" <+> ptext s <+>\n                                text \"in Template Haskell:\",\n                             nest 2 d])\n\nppr_th :: TH.Ppr a => a -> SDoc\nppr_th x = text (TH.pprint x)\n\n{-\nNote [Reifying field labels]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen reifying a datatype declared with DuplicateRecordFields enabled, we want\nthe reified names of the fields to be labels rather than selector functions.\nThat is, we want (reify ''T) and (reify 'foo) to produce\n\n    data T = MkT { foo :: Int }\n    foo :: T -> Int\n\nrather than\n\n    data T = MkT { $sel:foo:MkT :: Int }\n    $sel:foo:MkT :: T -> Int\n\nbecause otherwise TH code that uses the field names as strings will silently do\nthe wrong thing.  Thus we use the field label (e.g. foo) as the OccName, rather\nthan the selector (e.g. $sel:foo:MkT).  Since the Orig name M.foo isn't in the\nenvironment, NameG can't be used to represent such fields.  Instead,\nreifyFieldLabel uses NameQ.\n\nHowever, this means that extracting the field name from the output of reify, and\ntrying to reify it again, may fail with an ambiguity error if there are multiple\nsuch fields defined in the module (see the test case\noverloadedrecflds/should_fail/T11103.hs).  The \"proper\" fix requires changes to\nthe TH AST to make it able to represent duplicate record fields.\n-}\n", "num_lines": 2097}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1996-1998\n\n\nTcTyClsDecls: Typecheck type and class declarations\n-}\n\n{-# LANGUAGE CPP, TupleSections, MultiWayIf #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcTyClsDecls (\n        tcTyAndClassDecls,\n\n        -- Functions used by TcInstDcls to check\n        -- data/type family instance declarations\n        kcConDecl, tcConDecls, dataDeclChecks, checkValidTyCon,\n        tcFamTyPats, tcTyFamInstEqn,\n        tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt,\n        unravelFamInstPats, addConsistencyConstraints,\n        wrongKindOfFamily\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport HscTypes\nimport BuildTyCl\nimport TcRnMonad\nimport TcEnv\nimport TcValidity\nimport TcHsSyn\nimport TcTyDecls\nimport TcClassDcl\nimport {-# SOURCE #-} TcInstDcls( tcInstDecls1 )\nimport TcDeriv (DerivInfo)\nimport TcHsType\nimport ClsInst( AssocInstInfo(..) )\nimport TcMType\nimport TysWiredIn ( unitTy, makeRecoveryTyCon )\nimport TcType\nimport RnEnv( lookupConstructorFields )\nimport FamInst\nimport FamInstEnv\nimport Coercion\nimport Type\nimport TyCoRep   -- for checkValidRoles\nimport Class\nimport CoAxiom\nimport TyCon\nimport DataCon\nimport Id\nimport Var\nimport VarEnv\nimport VarSet\nimport Module\nimport Name\nimport NameSet\nimport NameEnv\nimport Outputable\nimport Maybes\nimport Unify\nimport Util\nimport SrcLoc\nimport ListSetOps\nimport DynFlags\nimport Unique\nimport ConLike( ConLike(..) )\nimport BasicTypes\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Data.List\nimport Data.List.NonEmpty ( NonEmpty(..) )\nimport qualified Data.Set as Set\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Type checking for type and class declarations}\n*                                                                      *\n************************************************************************\n\nNote [Grouping of type and class declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ntcTyAndClassDecls is called on a list of `TyClGroup`s. Each group is a strongly\nconnected component of mutually dependent types and classes. We kind check and\ntype check each group separately to enhance kind polymorphism. Take the\nfollowing example:\n\n  type Id a = a\n  data X = X (Id Int)\n\nIf we were to kind check the two declarations together, we would give Id the\nkind * -> *, since we apply it to an Int in the definition of X. But we can do\nbetter than that, since Id really is kind polymorphic, and should get kind\nforall (k::*). k -> k. Since it does not depend on anything else, it can be\nkind-checked by itself, hence getting the most general kind. We then kind check\nX, which works fine because we then know the polymorphic kind of Id, and simply\ninstantiate k to *.\n\nNote [Check role annotations in a second pass]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nRole inference potentially depends on the types of all of the datacons declared\nin a mutually recursive group. The validity of a role annotation, in turn,\ndepends on the result of role inference. Because the types of datacons might\nbe ill-formed (see #7175 and Note [Checking GADT return types]) we must check\n*all* the tycons in a group for validity before checking *any* of the roles.\nThus, we take two passes over the resulting tycons, first checking for general\nvalidity and then checking for valid role annotations.\n-}\n\ntcTyAndClassDecls :: [TyClGroup GhcRn]      -- Mutually-recursive groups in\n                                            -- dependency order\n                  -> TcM ( TcGblEnv         -- Input env extended by types and\n                                            -- classes\n                                            -- and their implicit Ids,DataCons\n                         , [InstInfo GhcRn] -- Source-code instance decls info\n                         , [DerivInfo]      -- data family deriving info\n                         )\n-- Fails if there are any errors\ntcTyAndClassDecls tyclds_s\n  -- The code recovers internally, but if anything gave rise to\n  -- an error we'd better stop now, to avoid a cascade\n  -- Type check each group in dependency order folding the global env\n  = checkNoErrs $ fold_env [] [] tyclds_s\n  where\n    fold_env :: [InstInfo GhcRn]\n             -> [DerivInfo]\n             -> [TyClGroup GhcRn]\n             -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo])\n    fold_env inst_info deriv_info []\n      = do { gbl_env <- getGblEnv\n           ; return (gbl_env, inst_info, deriv_info) }\n    fold_env inst_info deriv_info (tyclds:tyclds_s)\n      = do { (tcg_env, inst_info', deriv_info') <- tcTyClGroup tyclds\n           ; setGblEnv tcg_env $\n               -- remaining groups are typechecked in the extended global env.\n             fold_env (inst_info' ++ inst_info)\n                      (deriv_info' ++ deriv_info)\n                      tyclds_s }\n\ntcTyClGroup :: TyClGroup GhcRn\n            -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo])\n-- Typecheck one strongly-connected component of type, class, and instance decls\n-- See Note [TyClGroups and dependency analysis] in HsDecls\ntcTyClGroup (TyClGroup { group_tyclds = tyclds\n                       , group_roles  = roles\n                       , group_instds = instds })\n  = do { let role_annots = mkRoleAnnotEnv roles\n\n           -- Step 1: Typecheck the type/class declarations\n       ; traceTc \"---- tcTyClGroup ---- {\" empty\n       ; traceTc \"Decls for\" (ppr (map (tcdName . unLoc) tyclds))\n       ; tyclss <- tcTyClDecls tyclds role_annots\n\n           -- Step 1.5: Make sure we don't have any type synonym cycles\n       ; traceTc \"Starting synonym cycle check\" (ppr tyclss)\n       ; this_uid <- fmap thisPackage getDynFlags\n       ; checkSynCycles this_uid tyclss tyclds\n       ; traceTc \"Done synonym cycle check\" (ppr tyclss)\n\n           -- Step 2: Perform the validity check on those types/classes\n           -- We can do this now because we are done with the recursive knot\n           -- Do it before Step 3 (adding implicit things) because the latter\n           -- expects well-formed TyCons\n       ; traceTc \"Starting validity check\" (ppr tyclss)\n       ; tyclss <- concatMapM checkValidTyCl tyclss\n       ; traceTc \"Done validity check\" (ppr tyclss)\n       ; mapM_ (recoverM (return ()) . checkValidRoleAnnots role_annots) tyclss\n           -- See Note [Check role annotations in a second pass]\n\n       ; traceTc \"---- end tcTyClGroup ---- }\" empty\n\n           -- Step 3: Add the implicit things;\n           -- we want them in the environment because\n           -- they may be mentioned in interface files\n       ; gbl_env <- addTyConsToGblEnv tyclss\n\n           -- Step 4: check instance declarations\n       ; setGblEnv gbl_env $\n         tcInstDecls1 instds }\n\ntcTyClGroup (XTyClGroup _) = panic \"tcTyClGroup\"\n\ntcTyClDecls :: [LTyClDecl GhcRn] -> RoleAnnotEnv -> TcM [TyCon]\ntcTyClDecls tyclds role_annots\n  = tcExtendKindEnv promotion_err_env $   --- See Note [Type environment evolution]\n    do {    -- Step 1: kind-check this group and returns the final\n            -- (possibly-polymorphic) kind of each TyCon and Class\n            -- See Note [Kind checking for type and class decls]\n         tc_tycons <- kcTyClGroup tyclds\n       ; traceTc \"tcTyAndCl generalized kinds\" (vcat (map ppr_tc_tycon tc_tycons))\n\n            -- Step 2: type-check all groups together, returning\n            -- the final TyCons and Classes\n            --\n            -- NB: We have to be careful here to NOT eagerly unfold\n            -- type synonyms, as we have not tested for type synonym\n            -- loops yet and could fall into a black hole.\n       ; fixM $ \\ ~rec_tyclss -> do\n           { tcg_env <- getGblEnv\n           ; let roles = inferRoles (tcg_src tcg_env) role_annots rec_tyclss\n\n                 -- Populate environment with knot-tied ATyCon for TyCons\n                 -- NB: if the decls mention any ill-staged data cons\n                 -- (see Note [Recursion and promoting data constructors])\n                 -- we will have failed already in kcTyClGroup, so no worries here\n           ; tcExtendRecEnv (zipRecTyClss tc_tycons rec_tyclss) $\n\n                 -- Also extend the local type envt with bindings giving\n                 -- a TcTyCon for each each knot-tied TyCon or Class\n                 -- See Note [Type checking recursive type and class declarations]\n                 -- and Note [Type environment evolution]\n             tcExtendKindEnvWithTyCons tc_tycons $\n\n                 -- Kind and type check declarations for this group\n               mapM (tcTyClDecl roles) tyclds\n           } }\n  where\n    promotion_err_env = mkPromotionErrorEnv tyclds\n    ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma\n                                  , ppr (tyConBinders tc) <> comma\n                                  , ppr (tyConResKind tc)\n                                  , ppr (isTcTyCon tc) ])\n\nzipRecTyClss :: [TcTyCon]\n             -> [TyCon]           -- Knot-tied\n             -> [(Name,TyThing)]\n-- Build a name-TyThing mapping for the TyCons bound by decls\n-- being careful not to look at the knot-tied [TyThing]\n-- The TyThings in the result list must have a visible ATyCon,\n-- because typechecking types (in, say, tcTyClDecl) looks at\n-- this outer constructor\nzipRecTyClss tc_tycons rec_tycons\n  = [ (name, ATyCon (get name)) | tc_tycon <- tc_tycons, let name = getName tc_tycon ]\n  where\n    rec_tc_env :: NameEnv TyCon\n    rec_tc_env = foldr add_tc emptyNameEnv rec_tycons\n\n    add_tc :: TyCon -> NameEnv TyCon -> NameEnv TyCon\n    add_tc tc env = foldr add_one_tc env (tc : tyConATs tc)\n\n    add_one_tc :: TyCon -> NameEnv TyCon -> NameEnv TyCon\n    add_one_tc tc env = extendNameEnv env (tyConName tc) tc\n\n    get name = case lookupNameEnv rec_tc_env name of\n                 Just tc -> tc\n                 other   -> pprPanic \"zipRecTyClss\" (ppr name <+> ppr other)\n\n{-\n************************************************************************\n*                                                                      *\n                Kind checking\n*                                                                      *\n************************************************************************\n\nNote [Kind checking for type and class decls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nKind checking is done thus:\n\n   1. Make up a kind variable for each parameter of the declarations,\n      and extend the kind environment (which is in the TcLclEnv)\n\n   2. Kind check the declarations\n\nWe need to kind check all types in the mutually recursive group\nbefore we know the kind of the type variables.  For example:\n\n  class C a where\n     op :: D b => a -> b -> b\n\n  class D c where\n     bop :: (Monad c) => ...\n\nHere, the kind of the locally-polymorphic type variable \"b\"\ndepends on *all the uses of class D*.  For example, the use of\nMonad c in bop's type signature means that D must have kind Type->Type.\n\nNote: we don't treat type synonyms specially (we used to, in the past);\nin particular, even if we have a type synonym cycle, we still kind check\nit normally, and test for cycles later (checkSynCycles).  The reason\nwe can get away with this is because we have more systematic TYPE r\ninference, which means that we can do unification between kinds that\naren't lifted (this historically was not true.)\n\nThe downside of not directly reading off the kinds off the RHS of\ntype synonyms in topological order is that we don't transparently\nsupport making synonyms of types with higher-rank kinds.  But\nyou can always specify a CUSK directly to make this work out.\nSee tc269 for an example.\n\nNote [Skip decls with CUSKs in kcLTyClDecl]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n    data T (a :: *) = MkT (S a)   -- Has CUSK\n    data S a = MkS (T Int) (S a)  -- No CUSK\n\nVia getInitialKinds we get\n  T :: * -> *\n  S :: kappa -> *\n\nThen we call kcTyClDecl on each decl in the group, to constrain the\nkind unification variables.  BUT we /skip/ the RHS of any decl with\na CUSK.  Here we skip the RHS of T, so we eventually get\n  S :: forall k. k -> *\n\nThis gets us more polymorphism than we would otherwise get, similar\n(but implemented strangely differently from) the treatment of type\nsignatures in value declarations.\n\nOpen type families\n~~~~~~~~~~~~~~~~~~\nThis treatment of type synonyms only applies to Haskell 98-style synonyms.\nGeneral type functions can be recursive, and hence, appear in `alg_decls'.\n\nThe kind of an open type family is solely determinded by its kind signature;\nhence, only kind signatures participate in the construction of the initial\nkind environment (as constructed by `getInitialKind'). In fact, we ignore\ninstances of families altogether in the following. However, we need to include\nthe kinds of *associated* families into the construction of the initial kind\nenvironment. (This is handled by `allDecls').\n\nSee also Note [Kind checking recursive type and class declarations]\n\nNote [How TcTyCons work]\n~~~~~~~~~~~~~~~~~~~~~~~~\nTcTyCons are used for two distinct purposes\n\n1.  When recovering from a type error in a type declaration,\n    we want to put the erroneous TyCon in the environment in a\n    way that won't lead to more errors.  We use a TcTyCon for this;\n    see makeRecoveryTyCon.\n\n2.  When checking a type/class declaration (in module TcTyClsDecls), we come\n    upon knowledge of the eventual tycon in bits and pieces.\n\n      S1) First, we use getInitialKinds to look over the user-provided\n          kind signature of a tycon (including, for example, the number\n          of parameters written to the tycon) to get an initial shape of\n          the tycon's kind.  We record that shape in a TcTyCon.\n\n          For CUSK tycons, the TcTyCon has the final, generalised kind.\n          For non-CUSK tycons, the TcTyCon has as its tyConBinders only\n          the explicit arguments given -- no kind variables, etc.\n\n      S2) Then, using these initial kinds, we kind-check the body of the\n          tycon (class methods, data constructors, etc.), filling in the\n          metavariables in the tycon's initial kind.\n\n      S3) We then generalize to get the (non-CUSK) tycon's final, fixed\n          kind. Finally, once this has happened for all tycons in a\n          mutually recursive group, we can desugar the lot.\n\n    For convenience, we store partially-known tycons in TcTyCons, which\n    might store meta-variables. These TcTyCons are stored in the local\n    environment in TcTyClsDecls, until the real full TyCons can be created\n    during desugaring. A desugared program should never have a TcTyCon.\n\n3.  In a TcTyCon, everything is zonked after the kind-checking pass (S2).\n\n4.  tyConScopedTyVars.  A challenging piece in all of this is that we\n    end up taking three separate passes over every declaration:\n      - one in getInitialKind (this pass look only at the head, not the body)\n      - one in kcTyClDecls (to kind-check the body)\n      - a final one in tcTyClDecls (to desugar)\n\n    In the latter two passes, we need to connect the user-written type\n    variables in an LHsQTyVars with the variables in the tycon's\n    inferred kind. Because the tycon might not have a CUSK, this\n    matching up is, in general, quite hard to do.  (Look through the\n    git history between Dec 2015 and Apr 2016 for\n    TcHsType.splitTelescopeTvs!)\n\n    Instead of trying, we just store the list of type variables to\n    bring into scope, in the tyConScopedTyVars field of the TcTyCon.\n    These tyvars are brought into scope in TcHsType.bindTyClTyVars.\n\n    In a TcTyCon, why is tyConScopedTyVars :: [(Name,TcTyVar)] rather\n    than just [TcTyVar]?  Consider these mutually-recursive decls\n       data T (a :: k1) b = MkT (S a b)\n       data S (c :: k2) d = MkS (T c d)\n    We start with k1 bound to kappa1, and k2 to kappa2; so initially\n    in the (Name,TcTyVar) pairs the Name is that of the TcTyVar. But\n    then kappa1 and kappa2 get unified; so after the zonking in\n    'generalise' in 'kcTyClGroup' the Name and TcTyVar may differ.\n\nSee also Note [Type checking recursive type and class declarations].\n\nNote [Type environment evolution]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs we typecheck a group of declarations the type environment evolves.\nConsider for example:\n  data B (a :: Type) = MkB (Proxy 'MkB)\n\nWe do the following steps:\n\n  1. Start of tcTyClDecls: use mkPromotionErrorEnv to initialise the\n     type env with promotion errors\n            B   :-> TyConPE\n            MkB :-> DataConPE\n\n  2. kcTyCLGruup\n      - Do getInitialKinds, which will signal a promotion\n        error if B is used in any of the kinds needed to initialse\n        B's kind (e.g. (a :: Type)) here\n\n      - Extend the type env with these initial kinds (monomorphic for\n        decls that lack a CUSK)\n            B :-> TcTyCon <initial kind>\n        (thereby overriding the B :-> TyConPE binding)\n        and do kcLTyClDecl on each decl to get equality constraints on\n        all those inital kinds\n\n      - Generalise the inital kind, making a poly-kinded TcTyCon\n\n  3. Back in tcTyDecls, extend the envt with bindings of the poly-kinded\n     TcTyCons, again overriding the promotion-error bindings.\n\n     But note that the data constructor promotion errors are still in place\n     so that (in our example) a use of MkB will sitll be signalled as\n     an error.\n\n  4. Typecheck the decls.\n\n  5. In tcTyClGroup, extend the envt with bindings for TyCon and DataCons\n\n\nNote [Missed opportunity to retain higher-rank kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn 'kcTyClGroup', there is a missed opportunity to make kind\ninference work in a few more cases.  The idea is analogous\nto Note [Single function non-recursive binding special-case]:\n\n     * If we have an SCC with a single decl, which is non-recursive,\n       instead of creating a unification variable representing the\n       kind of the decl and unifying it with the rhs, we can just\n       read the type directly of the rhs.\n\n     * Furthermore, we can update our SCC analysis to ignore\n       dependencies on declarations which have CUSKs: we don't\n       have to kind-check these all at once, since we can use\n       the CUSK to initialize the kind environment.\n\nUnfortunately this requires reworking a bit of the code in\n'kcLTyClDecl' so I've decided to punt unless someone shouts about it.\n\nNote [Don't process associated types in kcLHsQTyVars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nPreviously, we processed associated types in the thing_inside in kcLHsQTyVars,\nbut this was wrong -- we want to do ATs sepearately.\nThe consequence for not doing it this way is #15142:\n\n  class ListTuple (tuple :: Type) (as :: [(k, Type)]) where\n    type ListToTuple as :: Type\n\nWe assign k a kind kappa[1]. When checking the tuple (k, Type), we try to unify\nkappa ~ Type, but this gets deferred because we bumped the TcLevel as we bring\n`tuple` into scope. Thus, when we check ListToTuple, kappa[1] still hasn't\nunified with Type. And then, when we generalize the kind of ListToTuple (which\nindeed has a CUSK, according to the rules), we skolemize the free metavariable\nkappa. Note that we wouldn't skolemize kappa when generalizing the kind of ListTuple,\nbecause the solveEqualities in kcLHsQTyVars is at TcLevel 1 and so kappa[1]\nwill unify with Type.\n\nBottom line: as associated types should have no effect on a CUSK enclosing class,\nwe move processing them to a separate action, run after the outer kind has\nbeen generalized.\n\n-}\n\nkcTyClGroup :: [LTyClDecl GhcRn] -> TcM [TcTyCon]\n\n-- Kind check this group, kind generalize, and return the resulting local env\n-- This binds the TyCons and Classes of the group, but not the DataCons\n-- See Note [Kind checking for type and class decls]\n-- and Note [Inferring kinds for type declarations]\nkcTyClGroup decls\n  = do  { mod <- getModule\n        ; traceTc \"---- kcTyClGroup ---- {\"\n                  (text \"module\" <+> ppr mod $$ vcat (map ppr decls))\n\n          -- Kind checking;\n          --    1. Bind kind variables for decls\n          --    2. Kind-check decls\n          --    3. Generalise the inferred kinds\n          -- See Note [Kind checking for type and class decls]\n\n        ; let (cusk_decls, no_cusk_decls)\n                 = partition (hsDeclHasCusk . unLoc) decls\n\n        ; poly_cusk_tcs <- getInitialKinds True cusk_decls\n\n        ; mono_tcs\n            <- tcExtendKindEnvWithTyCons poly_cusk_tcs $\n               pushTcLevelM_   $  -- We are going to kind-generalise, so\n                                  -- unification variables in here must\n                                  -- be one level in\n               solveEqualities $\n               do {  -- Step 1: Bind kind variables for all decls\n                    mono_tcs <- getInitialKinds False no_cusk_decls\n\n                  ; traceTc \"kcTyClGroup: initial kinds\" $\n                    ppr_tc_kinds mono_tcs\n\n                    -- Step 2: Set extended envt, kind-check the decls\n                    -- NB: the environment extension overrides the tycon\n                    --     promotion-errors bindings\n                    --     See Note [Type environment evolution]\n                  ; tcExtendKindEnvWithTyCons mono_tcs $\n                    mapM_ kcLTyClDecl no_cusk_decls\n\n                  ; return mono_tcs }\n\n        -- Step 3: generalisation\n        -- Finally, go through each tycon and give it its final kind,\n        -- with all the required, specified, and inferred variables\n        -- in order.\n        ; poly_no_cusk_tcs <- mapAndReportM generaliseTcTyCon mono_tcs\n\n        ; let poly_tcs = poly_cusk_tcs ++ poly_no_cusk_tcs\n        ; traceTc \"---- kcTyClGroup end ---- }\" (ppr_tc_kinds poly_tcs)\n        ; return poly_tcs }\n\n  where\n    ppr_tc_kinds tcs = vcat (map pp_tc tcs)\n    pp_tc tc = ppr (tyConName tc) <+> dcolon <+> ppr (tyConKind tc)\n\ngeneraliseTcTyCon :: TcTyCon -> TcM TcTyCon\ngeneraliseTcTyCon tc\n  -- See Note [Required, Specified, and Inferred for types]\n  = setSrcSpan (getSrcSpan tc) $\n    addTyConCtxt tc $\n    do { let tc_name      = tyConName tc\n             tc_res_kind  = tyConResKind tc\n             spec_req_prs = tcTyConScopedTyVars tc\n\n             (spec_req_names, spec_req_tvs) = unzip spec_req_prs\n             -- NB: spec_req_tvs includes both Specified and Required\n             -- Running example in Note [Inferring kinds for type declarations]\n             --    spec_req_prs = [ (\"k1\",kk1), (\"a\", (aa::kk1))\n             --                   , (\"k2\",kk2), (\"x\", (xx::kk2))]\n             -- where \"k1\" dnotes the Name k1, and kk1, aa, etc are MetaTyVarss,\n             -- specifically TyVarTvs\n\n       -- Step 0: zonk and skolemise the Specified and Required binders\n       -- It's essential that they are skolems, not MetaTyVars,\n       -- for Step 3 to work right\n       ; spec_req_tvs <- mapM zonkAndSkolemise spec_req_tvs\n             -- Running example, where kk1 := kk2, so we get\n             --   [kk2,kk2]\n\n       -- Step 1: Check for duplicates\n       -- E.g. data SameKind (a::k) (b::k)\n       --      data T (a::k1) (b::k2) = MkT (SameKind a b)\n       -- Here k1 and k2 start as TyVarTvs, and get unified with each other\n       -- If this happens, things get very confused later, so fail fast\n       ; checkDuplicateTyConBinders spec_req_names spec_req_tvs\n\n       -- Step 2a: find all the Inferred variables we want to quantify over\n       -- NB: candidateQTyVarsOfKinds zonks as it goes\n       ; dvs1 <- candidateQTyVarsOfKinds $\n                (tc_res_kind : map tyVarKind spec_req_tvs)\n       ; let dvs2 = dvs1 `delCandidates` spec_req_tvs\n\n       -- Step 2b: quantify, mainly meaning skolemise the free variables\n       -- Returned 'inferred' are scope-sorted and skolemised\n       ; inferred <- quantifyTyVars emptyVarSet dvs2\n\n       -- Step 3a: rename all the Specified and Required tyvars back to\n       -- TyVars with their oroginal user-specified name.  Example\n       --     class C a_r23 where ....\n       -- By this point we have scoped_prs = [(a_r23, a_r89[TyVarTv])]\n       -- We return with the TyVar a_r23[TyVar],\n       --    and ze mapping a_r89 :-> a_r23[TyVar]\n       ; traceTc \"generaliseTcTyCon: before zonkRec\"\n           (vcat [ text \"spec_req_tvs =\" <+> pprTyVars spec_req_tvs\n                 , text \"inferred =\" <+> pprTyVars inferred ])\n       ; (ze, final_spec_req_tvs) <- zonkRecTyVarBndrs spec_req_names spec_req_tvs\n           -- So ze maps from the tyvars that have ended up\n\n       -- Step 3b: Apply that mapping to the other variables\n       -- (remember they all started as TyVarTvs).\n       -- They have been skolemised by quantifyTyVars.\n       ; (ze, inferred) <- zonkTyBndrsX ze inferred\n       ; tc_res_kind    <- zonkTcTypeToTypeX ze tc_res_kind\n\n       ; traceTc \"generaliseTcTyCon: post zonk\" $\n         vcat [ text \"tycon =\" <+> ppr tc\n              , text \"inferred =\" <+> pprTyVars inferred\n              , text \"ze =\" <+> ppr ze\n              , text \"spec_req_prs =\" <+> ppr spec_req_prs\n              , text \"spec_req_tvs =\" <+> pprTyVars spec_req_tvs\n              , text \"final_spec_req_tvs =\" <+> pprTyVars final_spec_req_tvs ]\n\n       -- Step 4: Find the Specified and Inferred variables\n       -- NB: spec_req_tvs = spec_tvs ++ req_tvs\n       --     And req_tvs is 1-1 with tyConTyVars\n       --     See Note [Scoped tyvars in a TcTyCon] in TyCon\n       ; let n_spec        = length final_spec_req_tvs - tyConArity tc\n             (spec_tvs, req_tvs) = splitAt n_spec final_spec_req_tvs\n             specified     = scopedSort spec_tvs\n                             -- NB: maintain the L-R order of scoped_tvs\n\n       -- Step 5: Make the TyConBinders.\n             to_user tv     = lookupTyVarOcc ze tv `orElse` tv\n             dep_fv_set     = mapVarSet to_user (candidateKindVars dvs1)\n             inferred_tcbs  = mkNamedTyConBinders Inferred inferred\n             specified_tcbs = mkNamedTyConBinders Specified specified\n             required_tcbs  = map (mkRequiredTyConBinder dep_fv_set) req_tvs\n\n       -- Step 6: Assemble the final list.\n             final_tcbs = concat [ inferred_tcbs\n                                 , specified_tcbs\n                                 , required_tcbs ]\n\n       -- Step 7: Make the result TcTyCon\n             tycon = mkTcTyCon tc_name final_tcbs tc_res_kind\n                            (mkTyVarNamePairs final_spec_req_tvs)\n                            True {- it's generalised now -}\n                            (tyConFlavour tc)\n\n       ; traceTc \"generaliseTcTyCon done\" $\n         vcat [ text \"tycon =\" <+> ppr tc\n              , text \"tc_res_kind =\" <+> ppr tc_res_kind\n              , text \"dep_fv_set =\" <+> ppr dep_fv_set\n              , text \"final_spec_req_tvs =\" <+> pprTyVars final_spec_req_tvs\n              , text \"inferred =\" <+> pprTyVars inferred\n              , text \"specified =\" <+> pprTyVars specified\n              , text \"required_tcbs =\" <+> ppr required_tcbs\n              , text \"final_tcbs =\" <+> ppr final_tcbs ]\n\n       -- Step 8: Check for validity.\n       -- We do this here because we're about to put the tycon into the\n       -- the environment, and we don't want anything malformed there\n       ; checkTyConTelescope tycon\n\n       ; return tycon }\n\ncheckDuplicateTyConBinders :: [Name] -> [TcTyVar] -> TcM ()\ncheckDuplicateTyConBinders spec_req_names spec_req_tvs\n  | null dups = return ()\n  | otherwise = mapM_ report_dup dups >> failM\n  where\n    dups :: [(Name,Name)]\n    dups = findDupTyVarTvs $ spec_req_names `zip` spec_req_tvs\n\n    report_dup (n1, n2)\n      = setSrcSpan (getSrcSpan n2) $\n        addErrTc (text \"Couldn't match\" <+> quotes (ppr n1)\n                        <+> text \"with\" <+> quotes (ppr n2))\n\n{- Note [Required, Specified, and Inferred for types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEach forall'd type variable in a type or kind is one of\n\n  * Required: an argument must be provided at every call site\n\n  * Specified: the argument can be inferred at call sites, but\n    may be instantiated with visible type/kind application\n\n  * Inferred: the must be inferred at call sites; it\n    is unavailable for use with visible type/kind application.\n\nWhy have Inferred at all? Because we just can't make user-facing\npromises about the ordering of some variables. These might swizzle\naround even between minor released. By forbidding visible type\napplication, we ensure users aren't caught unawares.\n\nGo read Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.\n\nThe question for this Note is this:\n   given a TyClDecl, how are its quantified type variables classified?\nMuch of the debate is memorialized in #15743.\n\nHere is our design choice. When inferring the ordering of variables\nfor a TyCl declaration (that is, for those variables that he user\nhas not specified the order with an explicit `forall`), we use the\nfollowing order:\n\n 1. Inferred variables\n 2. Specified variables; in the left-to-right order in which\n    the user wrote them, modified by scopedSort (see below)\n    to put them in depdendency order.\n 3. Required variables before a top-level ::\n 4. All variables after a top-level ::\n\nIf this ordering does not make a valid telescope, we reject the definition.\n\nExample:\n  data SameKind :: k -> k -> *\n  data Bad a (c :: Proxy b) (d :: Proxy a) (x :: SameKind b d)\n\nFor Bad:\n  - a, c, d, x are Required; they are explicitly listed by the user\n    as the positional arguments of Bad\n  - b is Specified; it appears explicitly in a kind signature\n  - k, the kind of a, is Inferred; it is not mentioned explicitly at all\n\nPutting variables in the order Inferred, Specified, Required\ngives us this telescope:\n  Inferred:  k\n  Specified: b : Proxy a\n  Required : (a : k) (c : Proxy b) (d : Proxy a) (x : SameKind b d)\n\nBut this order is ill-scoped, because b's kind mentions a, which occurs\nafter b in the telescope. So we reject Bad.\n\nAssociated types\n~~~~~~~~~~~~~~~~\nFor associated types everything above is determined by the\nassociated-type declaration alone, ignoring the class header.\nHere is an example (Trac #15592)\n  class C (a :: k) b where\n    type F (x :: b a)\n\nIn the kind of C, 'k' is Specified.  But what about F?\nIn the kind of F,\n\n * Should k be Inferred or Specified?  It's Specified for C,\n   but not mentioned in F's declaration.\n\n * In which order should the Specified variables a and b occur?\n   It's clearly 'a' then 'b' in C's declaration, but the L-R ordering\n   in F's declaration is 'b' then 'a'.\n\nIn both cases we make the choice by looking at F's declaration alone,\nso it gets the kind\n   F :: forall {k}. forall b a. b a -> Type\n\nHow it works\n~~~~~~~~~~~~\nThese design choices are implemented by two completely different code\npaths for\n\n  * Declarations with a complete user-specified kind signature (CUSK)\n    Handed by the CUSK case of kcLHsQTyVars.\n\n  * Declarations without a CUSK are handled by kcTyClDecl; see\n    Note [Inferring kinds for type declarations].\n\nNote that neither code path worries about point (4) above, as this\nis nicely handled by not mangling the res_kind. (Mangling res_kinds is done\n*after* all this stuff, in tcDataDefn's call to etaExpandAlgTyCon.)\n\nWe can tell Inferred apart from Specified by looking at the scoped\ntyvars; Specified are always included there.\n\nDesign alternatives\n~~~~~~~~~~~~~~~~~~~\n* For associated types we considered putting the class variables\n  before the local variables, in a nod to the treatment for class\n  methods. But it got too compilicated; see Trac #15592, comment:21ff.\n\n* We rigidly require the ordering above, even though we could be much more\n  permissive. Relevant musings are at\n  https://ghc.haskell.org/trac/ghc/ticket/15743#comment:7\n  The bottom line conclusion is that, if the user wants a different ordering,\n  then can specify it themselves, and it is better to be predictable and dumb\n  than clever and capricious.\n\n  I (Richard) conjecture we could be fully permissive, allowing all classes\n  of variables to intermix. We would have to augment ScopedSort to refuse to\n  reorder Required variables (or check that it wouldn't have). But this would\n  allow more programs. See #15743 for examples. Interestingly, Idris seems\n  to allow this intermixing. The intermixing would be fully specified, in that\n  we can be sure that inference wouldn't change between versions. However,\n  would users be able to predict it? That I cannot answer.\n\nTest cases (and tickets) relevant to these design decisions\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  T15591*\n  T15592*\n  T15743*\n\nNote [Inferring kinds for type declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis note deals with /inference/ for type declarations\nthat do not have a CUSK.  Consider\n  data T (a :: k1) k2 (x :: k2) = MkT (S a k2 x)\n  data S (b :: k3) k4 (y :: k4) = MkS (T b k4 y)\n\nWe do kind inference as follows:\n\n* Step 1: getInitialKinds, and in particular kcLHsQTyVars_NonCusk.\n  Make a unification variable for each of the Required and Specified\n  type varialbes in the header.\n\n  Record the connection between the Names the user wrote and the\n  fresh unification variables in the tcTyConScopedTyVars field\n  of the TcTyCon we are making\n      [ (a,  aa)\n      , (k1, kk1)\n      , (k2, kk2)\n      , (x,  xx) ]\n  (I'm using the convention that double letter like 'aa' or 'kk'\n  mean a unification variable.)\n\n  These unification variables\n    - Are TyVarTvs: that is, unification variables that can\n      unify only with other type variables.\n      See Note [Signature skolems] in TcType\n\n    - Have complete fresh Names; see TcMType\n      Note [Unification variables need fresh Names]\n\n  Assign initial monomorophic kinds to S, T\n          S :: kk1 -> * -> kk2 -> *\n          T :: kk3 -> * -> kk4 -> *\n\n* Step 2: kcTyClDecl. Extend the environment with a TcTyCon for S and\n  T, with these monomophic kinds.  Now kind-check the declarations,\n  and solve the resulting equalities.  The goal here is to discover\n  constraints on all these unification variables.\n\n  Here we find that kk1 := kk3, and kk2 := kk4.\n\n  This is why we can't use skolems for kk1 etc; they have to\n  unify with each other.\n\n* Step 3: generaliseTcTyCon. Generalise each TyCon in turn.\n  We find the free variables of the kind, skolemise them,\n  sort them out into Inferred/Required/Specified (see the above\n  Note [Required, Specified, and Inferred for types]),\n  and perform some validity checks.\n\n  This makes the utterly-final TyConBinders for the TyCon.\n\n  All this is very similar at the level of terms: see TcBinds\n  Note [Quantified variables in partial type signatures]\n\n  But there some tricky corners: Note [Tricky scoping in generaliseTcTyCon]\n\n* Step 4.  Extend the type environment with a TcTyCon for S and T, now\n  with their utterly-final polymorphic kinds (needed for recursive\n  occurrences of S, T).  Now typecheck the declarations, and build the\n  final AlgTyCOn for S and T resp.\n\nThe first three steps are in kcTyClGroup; the fourth is in\ntcTyClDecls.\n\nThere are some wrinkles\n\n* Do not default TyVarTvs.  We always want to kind-generalise over\n  TyVarTvs, and /not/ default them to Type. By definition a TyVarTv is\n  not allowed to unify with a type; it must stand for a type\n  variable. Hence the check in TcSimplify.defaultTyVarTcS, and\n  TcMType.defaultTyVar.  Here's another example (Trac #14555):\n     data Exp :: [TYPE rep] -> TYPE rep -> Type where\n        Lam :: Exp (a:xs) b -> Exp xs (a -> b)\n  We want to kind-generalise over the 'rep' variable.\n  Trac #14563 is another example.\n\n* Duplicate type variables. Consider Trac #11203\n    data SameKind :: k -> k -> *\n    data Q (a :: k1) (b :: k2) c = MkQ (SameKind a b)\n  Here we will unify k1 with k2, but this time doing so is an error,\n  because k1 and k2 are bound in the same declaration.\n\n  We spot this during validity checking (findDupTyVarTvs),\n  in generaliseTcTyCon.\n\n* Required arguments.  Even the Required arguments should be made\n  into TyVarTvs, not skolems.  Consider\n    data T k (a :: k)\n  Here, k is a Required, dependent variable. For uniformity, it is helpful\n  to have k be a TyVarTv, in parallel with other dependent variables.\n\n* Duplicate skolemisation is expected.  When generalising in Step 3,\n  we may find that one of the variables we want to quantify has\n  already been skolemised.  For example, suppose we have already\n  generalise S. When we come to T we'll find that kk1 (now the same as\n  kk3) has already been skolemised.\n\n  That's fine -- but it means that\n    a) when collecting quantification candidates, in\n       candidateQTyVarsOfKind, we must collect skolems\n    b) quantifyTyVars should be a no-op on such a skolem\n\nNote [Tricky scoping in generaliseTcTyCon]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider Trac #16342\n  class C (a::ka) x where\n    cop :: D a x => x -> Proxy a -> Proxy a\n    cop _ x = x :: Proxy (a::ka)\n\n  class D (b::kb) y where\n    dop :: C b y => y -> Proxy b -> Proxy b\n    dop _ x = x :: Proxy (b::kb)\n\nC and D are mutually recursive, by the time we get to\ngeneraliseTcTyCon we'll have unified kka := kkb.\n\nBut when typechecking the default declarations for 'cop' and 'dop' in\ntcDlassDecl2 we need {a, ka} and {b, kb} respectively to be in scope.\nBut at that point all we have is the utterly-final Class itself.\n\nConclusion: the classTyVars of a class must have the same Mame as\nthat originally assigned by the user.  In our example, C must have\nclassTyVars {a, ka, x} while D has classTyVars {a, kb, y}.  Despite\nthe fact that kka and kkb got unified!\n\nWe achieve this sleight of hand in generaliseTcTyCon, using\nthe specialised function zonkRecTyVarBndrs.  We make the call\n   zonkRecTyVarBndrs [ka,a,x] [kkb,aa,xxx]\nwhere the [ka,a,x] are the Names originally assigned by the user, and\n[kkb,aa,xx] are the corresponding (post-zonking, skolemised) TcTyVars.\nzonkRecTyVarBndrs builds a recursive ZonkEnv that binds\n   kkb :-> (ka :: <zonked kind of kkb>)\n   aa  :-> (a  :: <konked kind of aa>)\n   etc\nThat is, it maps each skolemised TcTyVars to the utterly-final\nTyVar to put in the class, with its correct user-specified name.\nWhen generalising D we'll do the same thing, but the ZonkEnv will map\n   kkb :-> (kb :: <zonked kind of kkb>)\n   bb  :-> (b  :: <konked kind of bb>)\n   etc\nNote that 'kkb' again appears in the domain of the mapping, but this\ntime mapped to 'kb'.  That's how C and D end up with differently-named\nfinal TyVars despite the fact that we unified kka:=kkb\n\nzonkRecTyVarBndrs we need to do knot-tying because of the need to\napply this same substitution to the kind of each.  -}\n\n--------------\ntcExtendKindEnvWithTyCons :: [TcTyCon] -> TcM a -> TcM a\ntcExtendKindEnvWithTyCons tcs\n  = tcExtendKindEnvList [ (tyConName tc, ATcTyCon tc) | tc <- tcs ]\n\n--------------\nmkPromotionErrorEnv :: [LTyClDecl GhcRn] -> TcTypeEnv\n-- Maps each tycon/datacon to a suitable promotion error\n--    tc :-> APromotionErr TyConPE\n--    dc :-> APromotionErr RecDataConPE\n--    See Note [Recursion and promoting data constructors]\n\nmkPromotionErrorEnv decls\n  = foldr (plusNameEnv . mk_prom_err_env . unLoc)\n          emptyNameEnv decls\n\nmk_prom_err_env :: TyClDecl GhcRn -> TcTypeEnv\nmk_prom_err_env (ClassDecl { tcdLName = L _ nm, tcdATs = ats })\n  = unitNameEnv nm (APromotionErr ClassPE)\n    `plusNameEnv`\n    mkNameEnv [ (name, APromotionErr TyConPE)\n              | (dL->L _ (FamilyDecl { fdLName = (dL->L _ name) })) <- ats ]\n\nmk_prom_err_env (DataDecl { tcdLName = (dL->L _ name)\n                          , tcdDataDefn = HsDataDefn { dd_cons = cons } })\n  = unitNameEnv name (APromotionErr TyConPE)\n    `plusNameEnv`\n    mkNameEnv [ (con, APromotionErr RecDataConPE)\n              | (dL->L _ con') <- cons\n              , (dL->L _ con)  <- getConNames con' ]\n\nmk_prom_err_env decl\n  = unitNameEnv (tcdName decl) (APromotionErr TyConPE)\n    -- Works for family declarations too\n\n--------------\ngetInitialKinds :: Bool -> [LTyClDecl GhcRn] -> TcM [TcTyCon]\n-- Returns a TcTyCon for each TyCon bound by the decls,\n-- each with its initial kind\n\ngetInitialKinds cusk decls\n  = do { traceTc \"getInitialKinds {\" empty\n       ; tcs <- concatMapM (addLocM (getInitialKind cusk)) decls\n       ; traceTc \"getInitialKinds done }\" empty\n       ; return tcs }\n\ngetInitialKind :: Bool -> TyClDecl GhcRn -> TcM [TcTyCon]\n-- Allocate a fresh kind variable for each TyCon and Class\n-- For each tycon, return a TcTyCon with kind k\n-- where k is the kind of tc, derived from the LHS\n--         of the definition (and probably including\n--         kind unification variables)\n--      Example: data T a b = ...\n--      return (T, kv1 -> kv2 -> kv3)\n--\n-- This pass deals with (ie incorporates into the kind it produces)\n--   * The kind signatures on type-variable binders\n--   * The result kinds signature on a TyClDecl\n--\n-- No family instances are passed to getInitialKinds\n\ngetInitialKind cusk\n    (ClassDecl { tcdLName = dL->L _ name\n               , tcdTyVars = ktvs\n               , tcdATs = ats })\n  = do { tycon <- kcLHsQTyVars name ClassFlavour cusk ktvs $\n                  return constraintKind\n       ; let parent_tv_prs = tcTyConScopedTyVars tycon\n            -- See Note [Don't process associated types in kcLHsQTyVars]\n       ; inner_tcs <- tcExtendNameTyVarEnv parent_tv_prs $\n                      getFamDeclInitialKinds cusk (Just tycon) ats\n       ; return (tycon : inner_tcs) }\n\ngetInitialKind cusk\n    (DataDecl { tcdLName = dL->L _ name\n              , tcdTyVars = ktvs\n              , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig\n                                         , dd_ND = new_or_data } })\n  = do  { let flav = newOrDataToFlavour new_or_data\n        ; tc <- kcLHsQTyVars name flav cusk ktvs $\n                case m_sig of\n                   Just ksig -> tcLHsKindSig (DataKindCtxt name) ksig\n                   Nothing   -> return liftedTypeKind\n        ; return [tc] }\n\ngetInitialKind cusk (FamDecl { tcdFam = decl })\n  = do { tc <- getFamDeclInitialKind cusk Nothing decl\n       ; return [tc] }\n\ngetInitialKind cusk (SynDecl { tcdLName = dL->L _ name\n                             , tcdTyVars = ktvs\n                             , tcdRhs = rhs })\n  = do  { tycon <- kcLHsQTyVars name TypeSynonymFlavour cusk ktvs $\n                   case kind_annotation rhs of\n                     Just ksig -> tcLHsKindSig (TySynKindCtxt name) ksig\n                     Nothing   -> newMetaKindVar\n        ; return [tycon] }\n  where\n    -- Keep this synchronized with 'hsDeclHasCusk'.\n    kind_annotation (dL->L _ ty) = case ty of\n        HsParTy _ lty     -> kind_annotation lty\n        HsKindSig _ _ k   -> Just k\n        _                 -> Nothing\n\ngetInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn _)) = panic \"getInitialKind\"\ngetInitialKind _ (XTyClDecl _) = panic \"getInitialKind\"\n\n---------------------------------\ngetFamDeclInitialKinds\n  :: Bool        -- ^ True <=> cusk\n  -> Maybe TyCon -- ^ Just cls <=> this is an associated family of class cls\n  -> [LFamilyDecl GhcRn]\n  -> TcM [TcTyCon]\ngetFamDeclInitialKinds cusk mb_parent_tycon decls\n  = mapM (addLocM (getFamDeclInitialKind cusk mb_parent_tycon)) decls\n\ngetFamDeclInitialKind\n  :: Bool        -- ^ True <=> cusk\n  -> Maybe TyCon -- ^ Just cls <=> this is an associated family of class cls\n  -> FamilyDecl GhcRn\n  -> TcM TcTyCon\ngetFamDeclInitialKind parent_cusk mb_parent_tycon\n    decl@(FamilyDecl { fdLName     = (dL->L _ name)\n                     , fdTyVars    = ktvs\n                     , fdResultSig = (dL->L _ resultSig)\n                     , fdInfo      = info })\n  = kcLHsQTyVars name flav fam_cusk ktvs $\n    case resultSig of\n      KindSig _ ki                              -> tcLHsKindSig ctxt ki\n      TyVarSig _ (dL->L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki\n      _ -- open type families have * return kind by default\n        | tcFlavourIsOpen flav              -> return liftedTypeKind\n               -- closed type families have their return kind inferred\n               -- by default\n        | otherwise                         -> newMetaKindVar\n  where\n    assoc_with_no_cusk = isJust mb_parent_tycon && not parent_cusk\n    fam_cusk = famDeclHasCusk assoc_with_no_cusk decl\n    flav = case info of\n      DataFamily         -> DataFamilyFlavour mb_parent_tycon\n      OpenTypeFamily     -> OpenTypeFamilyFlavour mb_parent_tycon\n      ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon )\n                            ClosedTypeFamilyFlavour\n    ctxt  = TyFamResKindCtxt name\ngetFamDeclInitialKind _ _ (XFamilyDecl _) = panic \"getFamDeclInitialKind\"\n\n------------------------------------------------------------------------\nkcLTyClDecl :: LTyClDecl GhcRn -> TcM ()\n  -- See Note [Kind checking for type and class decls]\nkcLTyClDecl (dL->L loc decl)\n  = setSrcSpan loc $\n    tcAddDeclCtxt decl $\n    do { traceTc \"kcTyClDecl {\" (ppr tc_name)\n       ; kcTyClDecl decl\n       ; traceTc \"kcTyClDecl done }\" (ppr tc_name) }\n  where\n    tc_name = tyClDeclLName decl\n\nkcTyClDecl :: TyClDecl GhcRn -> TcM ()\n-- This function is used solely for its side effect on kind variables\n-- NB kind signatures on the type variables and\n--    result kind signature have already been dealt with\n--    by getInitialKind, so we can ignore them here.\n\nkcTyClDecl (DataDecl { tcdLName    = (dL->L _ name)\n                     , tcdDataDefn = defn })\n  | HsDataDefn { dd_cons = cons@((dL->L _ (ConDeclGADT {})) : _)\n               , dd_ctxt = (dL->L _ []) } <- defn\n  = mapM_ (wrapLocM_ kcConDecl) cons\n    -- hs_tvs and dd_kindSig already dealt with in getInitialKind\n    -- This must be a GADT-style decl,\n    --        (see invariants of DataDefn declaration)\n    -- so (a) we don't need to bring the hs_tvs into scope, because the\n    --        ConDecls bind all their own variables\n    --    (b) dd_ctxt is not allowed for GADT-style decls, so we can ignore it\n\n  | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } <- defn\n  = bindTyClTyVars name $ \\ _ _ ->\n    do  { _ <- tcHsContext ctxt\n        ; mapM_ (wrapLocM_ kcConDecl) cons }\n\nkcTyClDecl (SynDecl { tcdLName = dL->L _ name, tcdRhs = rhs })\n  = bindTyClTyVars name $ \\ _ res_kind ->\n    discardResult $ tcCheckLHsType rhs res_kind\n        -- NB: check against the result kind that we allocated\n        -- in getInitialKinds.\n\nkcTyClDecl (ClassDecl { tcdLName = (dL->L _ name)\n                      , tcdCtxt = ctxt, tcdSigs = sigs })\n  = bindTyClTyVars name $ \\ _ _ ->\n    do  { _ <- tcHsContext ctxt\n        ; mapM_ (wrapLocM_ kc_sig) sigs }\n  where\n    kc_sig (ClassOpSig _ _ nms op_ty) = kcHsSigType nms op_ty\n    kc_sig _                          = return ()\n\nkcTyClDecl (FamDecl _ (FamilyDecl { fdLName  = (dL->L _ fam_tc_name)\n                                  , fdInfo   = fd_info }))\n-- closed type families look at their equations, but other families don't\n-- do anything here\n  = case fd_info of\n      ClosedTypeFamily (Just eqns) ->\n        do { fam_tc <- kcLookupTcTyCon fam_tc_name\n           ; mapM_ (kcTyFamInstEqn fam_tc) eqns }\n      _ -> return ()\nkcTyClDecl (FamDecl _ (XFamilyDecl _))              = panic \"kcTyClDecl\"\nkcTyClDecl (DataDecl _ _ _ _ (XHsDataDefn _)) = panic \"kcTyClDecl\"\nkcTyClDecl (XTyClDecl _)                            = panic \"kcTyClDecl\"\n\n-------------------\nkcConDecl :: ConDecl GhcRn -> TcM ()\nkcConDecl (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs\n                      , con_mb_cxt = ex_ctxt, con_args = args })\n  = addErrCtxt (dataConCtxtName [name]) $\n    discardResult                   $\n    bindExplicitTKBndrs_Tv ex_tvs $\n    do { _ <- tcHsMbContext ex_ctxt\n       ; traceTc \"kcConDecl {\" (ppr name $$ ppr args)\n       ; mapM_ (tcHsOpenType . getBangType) (hsConDeclArgTys args)\n       ; traceTc \"kcConDecl }\" (ppr name)\n       }\n              -- We don't need to check the telescope here, because that's\n              -- done in tcConDecl\n\nkcConDecl (ConDeclGADT { con_names = names\n                       , con_qvars = qtvs, con_mb_cxt = cxt\n                       , con_args = args, con_res_ty = res_ty })\n  | HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = implicit_tkv_nms }\n           , hsq_explicit = explicit_tkv_nms } <- qtvs\n  = -- Even though the data constructor's type is closed, we\n    -- must still kind-check the type, because that may influence\n    -- the inferred kind of the /type/ constructor.  Example:\n    --    data T f a where\n    --      MkT :: f a -> T f a\n    -- If we don't look at MkT we won't get the correct kind\n    -- for the type constructor T\n    addErrCtxt (dataConCtxtName names) $\n    discardResult $\n    bindImplicitTKBndrs_Tv implicit_tkv_nms $\n    bindExplicitTKBndrs_Tv explicit_tkv_nms $\n        -- Why \"_Tv\"?  See Note [Kind-checking for GADTs]\n    do { _ <- tcHsMbContext cxt\n       ; mapM_ (tcHsOpenType . getBangType) (hsConDeclArgTys args)\n       ; _ <- tcHsOpenType res_ty\n       ; return () }\nkcConDecl (XConDecl _) = panic \"kcConDecl\"\nkcConDecl (ConDeclGADT _ _ _ (XLHsQTyVars _) _ _ _ _) = panic \"kcConDecl\"\n\n{-\nNote [Recursion and promoting data constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't want to allow promotion in a strongly connected component\nwhen kind checking.\n\nConsider:\n  data T f = K (f (K Any))\n\nWhen kind checking the `data T' declaration the local env contains the\nmappings:\n  T -> ATcTyCon <some initial kind>\n  K -> APromotionErr\n\nAPromotionErr is only used for DataCons, and only used during type checking\nin tcTyClGroup.\n\nNote [Kind-checking for GADTs]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n  data Proxy a where\n    MkProxy1 :: forall k (b :: k). Proxy b\n    MkProxy2 :: forall j (c :: j). Proxy c\n\nIt seems reasonable that this should be accepted. But something very strange\nis going on here: when we're kind-checking this declaration, we need to unify\nthe kind of `a` with k and j -- even though k and j's scopes are local to the type of\nMkProxy{1,2}. The best approach we've come up with is to use TyVarTvs during\nthe kind-checking pass. First off, note that it's OK if the kind-checking pass\nis too permissive: we'll snag the problems in the type-checking pass later.\n(This extra permissiveness might happen with something like\n\n  data SameKind :: k -> k -> Type\n  data Bad a where\n    MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b)\n\nwhich would be accepted if k1 and k2 were TyVarTvs. This is correctly rejected\nin the second pass, though. Test case: polykinds/TyVarTvKinds3)\nRecall that the kind-checking pass exists solely to collect constraints\non the kinds and to power unification.\n\nTo achieve the use of TyVarTvs, we must be careful to use specialized functions\nthat produce TyVarTvs, not ordinary skolems. This is why we need\nkcExplicitTKBndrs and kcImplicitTKBndrs in TcHsType, separate from their\ntc... variants.\n\nThe drawback of this approach is sometimes it will accept a definition that\na (hypothetical) declarative specification would likely reject. As a general\nrule, we don't want to allow polymorphic recursion without a CUSK. Indeed,\nthe whole point of CUSKs is to allow polymorphic recursion. Yet, the TyVarTvs\napproach allows a limited form of polymorphic recursion *without* a CUSK.\n\nTo wit:\n  data T a = forall k (b :: k). MkT (T b) Int\n  (test case: dependent/should_compile/T14066a)\n\nNote that this is polymorphically recursive, with the recursive occurrence\nof T used at a kind other than a's kind. The approach outlined here accepts\nthis definition, because this kind is still a kind variable (and so the\nTyVarTvs unify). Stepping back, I (Richard) have a hard time envisioning a\nway to describe exactly what declarations will be accepted and which will\nbe rejected (without a CUSK). However, the accepted definitions are indeed\nwell-kinded and any rejected definitions would be accepted with a CUSK,\nand so this wrinkle need not cause anyone to lose sleep.\n\n************************************************************************\n*                                                                      *\n\\subsection{Type checking}\n*                                                                      *\n************************************************************************\n\nNote [Type checking recursive type and class declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAt this point we have completed *kind-checking* of a mutually\nrecursive group of type/class decls (done in kcTyClGroup). However,\nwe discarded the kind-checked types (eg RHSs of data type decls);\nnote that kcTyClDecl returns ().  There are two reasons:\n\n  * It's convenient, because we don't have to rebuild a\n    kinded HsDecl (a fairly elaborate type)\n\n  * It's necessary, because after kind-generalisation, the\n    TyCons/Classes may now be kind-polymorphic, and hence need\n    to be given kind arguments.\n\nExample:\n       data T f a = MkT (f a) (T f a)\nDuring kind-checking, we give T the kind T :: k1 -> k2 -> *\nand figure out constraints on k1, k2 etc. Then we generalise\nto get   T :: forall k. (k->*) -> k -> *\nSo now the (T f a) in the RHS must be elaborated to (T k f a).\n\nHowever, during tcTyClDecl of T (above) we will be in a recursive\n\"knot\". So we aren't allowed to look at the TyCon T itself; we are only\nallowed to put it (lazily) in the returned structures.  But when\nkind-checking the RHS of T's decl, we *do* need to know T's kind (so\nthat we can correctly elaboarate (T k f a).  How can we get T's kind\nwithout looking at T?  Delicate answer: during tcTyClDecl, we extend\n\n  *Global* env with T -> ATyCon (the (not yet built) final TyCon for T)\n  *Local*  env with T -> ATcTyCon (TcTyCon with the polymorphic kind of T)\n\nThen:\n\n  * During TcHsType.tcTyVar we look in the *local* env, to get the\n    fully-known, not knot-tied TcTyCon for T.\n\n  * Then, in TcHsSyn.zonkTcTypeToType (and zonkTcTyCon in particular)\n    we look in the *global* env to get the TyCon.\n\nThis fancy footwork (with two bindings for T) is only necessary for the\nTyCons or Classes of this recursive group.  Earlier, finished groups,\nlive in the global env only.\n\nSee also Note [Kind checking recursive type and class declarations]\n\nNote [Kind checking recursive type and class declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBefore we can type-check the decls, we must kind check them. This\nis done by establishing an \"initial kind\", which is a rather uninformed\nguess at a tycon's kind (by counting arguments, mainly) and then\nusing this initial kind for recursive occurrences.\n\nThe initial kind is stored in exactly the same way during\nkind-checking as it is during type-checking (Note [Type checking\nrecursive type and class declarations]): in the *local* environment,\nwith ATcTyCon. But we still must store *something* in the *global*\nenvironment. Even though we discard the result of kind-checking, we\nsometimes need to produce error messages. These error messages will\nwant to refer to the tycons being checked, except that they don't\nexist yet, and it would be Terribly Annoying to get the error messages\nto refer back to HsSyn. So we create a TcTyCon and put it in the\nglobal env. This tycon can print out its name and knows its kind, but\nany other action taken on it will panic. Note that TcTyCons are *not*\nknot-tied, unlike the rather valid but knot-tied ones that occur\nduring type-checking.\n\nNote [Declarations for wired-in things]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor wired-in things we simply ignore the declaration\nand take the wired-in information.  That avoids complications.\ne.g. the need to make the data constructor worker name for\n     a constraint tuple match the wired-in one\n-}\n\ntcTyClDecl :: RolesInfo -> LTyClDecl GhcRn -> TcM TyCon\ntcTyClDecl roles_info (dL->L loc decl)\n  | Just thing <- wiredInNameTyThing_maybe (tcdName decl)\n  = case thing of -- See Note [Declarations for wired-in things]\n      ATyCon tc -> return tc\n      _ -> pprPanic \"tcTyClDecl\" (ppr thing)\n\n  | otherwise\n  = setSrcSpan loc $ tcAddDeclCtxt decl $\n    do { traceTc \"---- tcTyClDecl ---- {\" (ppr decl)\n       ; tc <- tcTyClDecl1 Nothing roles_info decl\n       ; traceTc \"---- tcTyClDecl end ---- }\" (ppr tc)\n       ; return tc }\n\n  -- \"type family\" declarations\ntcTyClDecl1 :: Maybe Class -> RolesInfo -> TyClDecl GhcRn -> TcM TyCon\ntcTyClDecl1 parent _roles_info (FamDecl { tcdFam = fd })\n  = tcFamDecl1 parent fd\n\n  -- \"type\" synonym declaration\ntcTyClDecl1 _parent roles_info\n            (SynDecl { tcdLName = (dL->L _ tc_name)\n                     , tcdRhs   = rhs })\n  = ASSERT( isNothing _parent )\n    bindTyClTyVars tc_name $ \\ binders res_kind ->\n    tcTySynRhs roles_info tc_name binders res_kind rhs\n\n  -- \"data/newtype\" declaration\ntcTyClDecl1 _parent roles_info\n            (DataDecl { tcdLName = (dL->L _ tc_name)\n                      , tcdDataDefn = defn })\n  = ASSERT( isNothing _parent )\n    bindTyClTyVars tc_name $ \\ tycon_binders res_kind ->\n    tcDataDefn roles_info tc_name tycon_binders res_kind defn\n\ntcTyClDecl1 _parent roles_info\n            (ClassDecl { tcdLName = (dL->L _ class_name)\n                       , tcdCtxt = hs_ctxt\n                       , tcdMeths = meths\n                       , tcdFDs = fundeps\n                       , tcdSigs = sigs\n                       , tcdATs = ats\n                       , tcdATDefs = at_defs })\n  = ASSERT( isNothing _parent )\n    do { clas <- tcClassDecl1 roles_info class_name hs_ctxt\n                              meths fundeps sigs ats at_defs\n       ; return (classTyCon clas) }\n\ntcTyClDecl1 _ _ (XTyClDecl _) = panic \"tcTyClDecl1\"\n\n\n{- *********************************************************************\n*                                                                      *\n          Class declarations\n*                                                                      *\n********************************************************************* -}\n\ntcClassDecl1 :: RolesInfo -> Name -> LHsContext GhcRn\n             -> LHsBinds GhcRn -> [LHsFunDep GhcRn] -> [LSig GhcRn]\n             -> [LFamilyDecl GhcRn] -> [LTyFamDefltEqn GhcRn]\n             -> TcM Class\ntcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs\n  = fixM $ \\ clas ->\n    -- We need the knot because 'clas' is passed into tcClassATs\n    bindTyClTyVars class_name $ \\ binders res_kind ->\n    do { MASSERT2( tcIsConstraintKind res_kind\n                 , ppr class_name $$ ppr res_kind )\n       ; traceTc \"tcClassDecl 1\" (ppr class_name $$ ppr binders)\n       ; let tycon_name = class_name        -- We use the same name\n             roles = roles_info tycon_name  -- for TyCon and Class\n\n       ; (ctxt, fds, sig_stuff, at_stuff)\n            <- pushTcLevelM_   $\n               solveEqualities $\n               do { ctxt <- tcHsContext hs_ctxt\n                  ; fds  <- mapM (addLocM tc_fundep) fundeps\n                  ; sig_stuff <- tcClassSigs class_name sigs meths\n                  ; at_stuff  <- tcClassATs class_name clas ats at_defs\n                  ; return (ctxt, fds, sig_stuff, at_stuff) }\n\n       -- The solveEqualities will report errors for any\n       -- unsolved equalities, so these zonks should not encounter\n       -- any unfilled coercion variables unless there is such an error\n       -- The zonk also squeeze out the TcTyCons, and converts\n       -- Skolems to tyvars.\n       ; ze        <- emptyZonkEnv\n       ; ctxt      <- zonkTcTypesToTypesX ze ctxt\n       ; sig_stuff <- mapM (zonkTcMethInfoToMethInfoX ze) sig_stuff\n         -- ToDo: do we need to zonk at_stuff?\n\n       -- TODO: Allow us to distinguish between abstract class,\n       -- and concrete class with no methods (maybe by\n       -- specifying a trailing where or not\n\n       ; mindef <- tcClassMinimalDef class_name sigs sig_stuff\n       ; is_boot <- tcIsHsBootOrSig\n       ; let body | is_boot, null ctxt, null at_stuff, null sig_stuff\n                  = Nothing\n                  | otherwise\n                  = Just (ctxt, at_stuff, sig_stuff, mindef)\n\n       ; clas <- buildClass class_name binders roles fds body\n       ; traceTc \"tcClassDecl\" (ppr fundeps $$ ppr binders $$\n                                ppr fds)\n       ; return clas }\n  where\n    tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM (tcLookupTyVar . unLoc) tvs1 ;\n                                ; tvs2' <- mapM (tcLookupTyVar . unLoc) tvs2 ;\n                                ; return (tvs1', tvs2') }\n\n\n{- Note [Associated type defaults]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe following is an example of associated type defaults:\n             class C a where\n               data D a\n\n               type F a b :: *\n               type F a b = [a]        -- Default\n\nNote that we can get default definitions only for type families, not data\nfamilies.\n-}\n\ntcClassATs :: Name                   -- The class name (not knot-tied)\n           -> Class                  -- The class parent of this associated type\n           -> [LFamilyDecl GhcRn]    -- Associated types.\n           -> [LTyFamDefltEqn GhcRn] -- Associated type defaults.\n           -> TcM [ClassATItem]\ntcClassATs class_name cls ats at_defs\n  = do {  -- Complain about associated type defaults for non associated-types\n         sequence_ [ failWithTc (badATErr class_name n)\n                   | n <- map at_def_tycon at_defs\n                   , not (n `elemNameSet` at_names) ]\n       ; mapM tc_at ats }\n  where\n    at_def_tycon :: LTyFamDefltEqn GhcRn -> Name\n    at_def_tycon (dL->L _ eqn) = unLoc (feqn_tycon eqn)\n\n    at_fam_name :: LFamilyDecl GhcRn -> Name\n    at_fam_name (dL->L _ decl) = unLoc (fdLName decl)\n\n    at_names = mkNameSet (map at_fam_name ats)\n\n    at_defs_map :: NameEnv [LTyFamDefltEqn GhcRn]\n    -- Maps an AT in 'ats' to a list of all its default defs in 'at_defs'\n    at_defs_map = foldr (\\at_def nenv -> extendNameEnv_C (++) nenv\n                                          (at_def_tycon at_def) [at_def])\n                        emptyNameEnv at_defs\n\n    tc_at at = do { fam_tc <- addLocM (tcFamDecl1 (Just cls)) at\n                  ; let at_defs = lookupNameEnv at_defs_map (at_fam_name at)\n                                  `orElse` []\n                  ; atd <- tcDefaultAssocDecl fam_tc at_defs\n                  ; return (ATI fam_tc atd) }\n\n-------------------------\ntcDefaultAssocDecl :: TyCon                    -- ^ Family TyCon (not knot-tied)\n                   -> [LTyFamDefltEqn GhcRn]        -- ^ Defaults\n                   -> TcM (Maybe (KnotTied Type, SrcSpan))   -- ^ Type checked RHS\ntcDefaultAssocDecl _ []\n  = return Nothing  -- No default declaration\n\ntcDefaultAssocDecl _ (d1:_:_)\n  = failWithTc (text \"More than one default declaration for\"\n                <+> ppr (feqn_tycon (unLoc d1)))\n\ntcDefaultAssocDecl fam_tc [dL->L loc (FamEqn { feqn_tycon = L _ tc_name\n                                             , feqn_pats = hs_tvs\n                                             , feqn_rhs = hs_rhs_ty })]\n  | HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = imp_vars}\n           , hsq_explicit = exp_vars } <- hs_tvs\n  = -- See Note [Type-checking default assoc decls]\n    setSrcSpan loc $\n    tcAddFamInstCtxt (text \"default type instance\") tc_name $\n    do { traceTc \"tcDefaultAssocDecl\" (ppr tc_name)\n       ; let fam_tc_name = tyConName fam_tc\n             fam_arity = length (tyConVisibleTyVars fam_tc)\n\n       -- Kind of family check\n       ; ASSERT( fam_tc_name == tc_name )\n         checkTc (isTypeFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)\n\n       -- Arity check\n       ; checkTc (exp_vars `lengthIs` fam_arity)\n                 (wrongNumberOfParmsErr fam_arity)\n\n       -- Typecheck RHS\n       ; let hs_pats = map (HsValArg . hsLTyVarBndrToType) exp_vars\n\n          -- NB: Use tcFamTyPats, not bindTyClTyVars. The latter expects to get\n          -- the LHsQTyVars used for declaring a tycon, but the names here\n          -- are different.\n\n          -- You might think we should pass in some AssocInstInfo, as we're looking\n          -- at an associated type. But this would be wrong, because an associated\n          -- type default LHS can mention *different* type variables than the\n          -- enclosing class. So it's treated more as a freestanding beast.\n       ; (qtvs, pats, rhs_ty) <- tcTyFamInstEqnGuts fam_tc NotAssociated\n                                                    imp_vars exp_vars\n                                                    hs_pats hs_rhs_ty\n\n         -- See Note [Type-checking default assoc decls]\n       ; traceTc \"tcDefault\" (vcat [ppr (tyConTyVars fam_tc), ppr qtvs, ppr pats])\n       ; case tcMatchTys pats (mkTyVarTys (tyConTyVars fam_tc)) of\n           Just subst -> return (Just (substTyUnchecked subst rhs_ty, loc) )\n           Nothing    -> failWithTc (defaultAssocKindErr fam_tc)\n           -- We check for well-formedness and validity later,\n           -- in checkValidClass\n     }\ntcDefaultAssocDecl _ [dL->L _ (XFamEqn _)] = panic \"tcDefaultAssocDecl\"\ntcDefaultAssocDecl _ [dL->L _ (FamEqn _ _ _ (XLHsQTyVars _) _ _)]\n  = panic \"tcDefaultAssocDecl\"\ntcDefaultAssocDecl _ [_]\n  = panic \"tcDefaultAssocDecl: Impossible Match\" -- due to #15884\n\n\n{- Note [Type-checking default assoc decls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this default declaration for an associated type\n\n   class C a where\n      type F (a :: k) b :: *\n      type F x y = Proxy x -> y\n\nNote that the class variable 'a' doesn't scope over the default assoc\ndecl (rather oddly I think), and (less oddly) neither does the second\nargument 'b' of the associated type 'F', or the kind variable 'k'.\nInstead, the default decl is treated more like a top-level type\ninstance.\n\nHowever we store the default rhs (Proxy x -> y) in F's TyCon, using\nF's own type variables, so we need to convert it to (Proxy a -> b).\nWe do this by calling tcMatchTys to match them up.  This also ensures\nthat x's kind matches a's and similarly for y and b.  The error\nmessage isn't great, mind you.  (Trac #11361 was caused by not doing a\nproper tcMatchTys here.)\n\nRecall also that the left-hand side of an associated type family\ndefault is always just variables -- no tycons here. Accordingly,\nthe patterns used in the tcMatchTys won't actually be knot-tied,\neven though we're in the knot. This is too delicate for my taste,\nbut it works.\n\n-}\n\n{- *********************************************************************\n*                                                                      *\n          Type family declarations\n*                                                                      *\n********************************************************************* -}\n\ntcFamDecl1 :: Maybe Class -> FamilyDecl GhcRn -> TcM TyCon\ntcFamDecl1 parent (FamilyDecl { fdInfo = fam_info\n                              , fdLName = tc_lname@(dL->L _ tc_name)\n                              , fdResultSig = (dL->L _ sig)\n                              , fdInjectivityAnn = inj })\n  | DataFamily <- fam_info\n  = bindTyClTyVars tc_name $ \\ binders res_kind -> do\n  { traceTc \"data family:\" (ppr tc_name)\n  ; checkFamFlag tc_name\n\n  -- Check that the result kind is OK\n  -- We allow things like\n  --   data family T (a :: Type) :: forall k. k -> Type\n  -- We treat T as having arity 1, but result kind forall k. k -> Type\n  -- But we want to check that the result kind finishes in\n  --   Type or a kind-variable\n  -- For the latter, consider\n  --   data family D a :: forall k. Type -> k\n  ; let (_, final_res_kind) = splitPiTys res_kind\n  ; checkTc (tcIsLiftedTypeKind final_res_kind\n             || isJust (tcGetCastedTyVar_maybe final_res_kind))\n            (badKindSig False res_kind)\n\n  ; tc_rep_name <- newTyConRepName tc_name\n  ; let tycon = mkFamilyTyCon tc_name binders\n                              res_kind\n                              (resultVariableName sig)\n                              (DataFamilyTyCon tc_rep_name)\n                              parent NotInjective\n  ; return tycon }\n\n  | OpenTypeFamily <- fam_info\n  = bindTyClTyVars tc_name $ \\ binders res_kind -> do\n  { traceTc \"open type family:\" (ppr tc_name)\n  ; checkFamFlag tc_name\n  ; inj' <- tcInjectivity binders inj\n  ; let tycon = mkFamilyTyCon tc_name binders res_kind\n                               (resultVariableName sig) OpenSynFamilyTyCon\n                               parent inj'\n  ; return tycon }\n\n  | ClosedTypeFamily mb_eqns <- fam_info\n  = -- Closed type families are a little tricky, because they contain the definition\n    -- of both the type family and the equations for a CoAxiom.\n    do { traceTc \"Closed type family:\" (ppr tc_name)\n         -- the variables in the header scope only over the injectivity\n         -- declaration but this is not involved here\n       ; (inj', binders, res_kind)\n            <- bindTyClTyVars tc_name $ \\ binders res_kind ->\n               do { inj' <- tcInjectivity binders inj\n                  ; return (inj', binders, res_kind) }\n\n       ; checkFamFlag tc_name -- make sure we have -XTypeFamilies\n\n         -- If Nothing, this is an abstract family in a hs-boot file;\n         -- but eqns might be empty in the Just case as well\n       ; case mb_eqns of\n           Nothing   ->\n               return $ mkFamilyTyCon tc_name binders res_kind\n                                      (resultVariableName sig)\n                                      AbstractClosedSynFamilyTyCon parent\n                                      inj'\n           Just eqns -> do {\n\n         -- Process the equations, creating CoAxBranches\n       ; let tc_fam_tc = mkTcTyCon tc_name binders res_kind\n                                   [] False {- this doesn't matter here -}\n                                   ClosedTypeFamilyFlavour\n\n       ; branches <- mapAndReportM (tcTyFamInstEqn tc_fam_tc NotAssociated) eqns\n         -- Do not attempt to drop equations dominated by earlier\n         -- ones here; in the case of mutual recursion with a data\n         -- type, we get a knot-tying failure.  Instead we check\n         -- for this afterwards, in TcValidity.checkValidCoAxiom\n         -- Example: tc265\n\n         -- Create a CoAxiom, with the correct src location.\n       ; co_ax_name <- newFamInstAxiomName tc_lname []\n\n       ; let mb_co_ax\n              | null eqns = Nothing   -- mkBranchedCoAxiom fails on empty list\n              | otherwise = Just (mkBranchedCoAxiom co_ax_name fam_tc branches)\n\n             fam_tc = mkFamilyTyCon tc_name binders res_kind (resultVariableName sig)\n                      (ClosedSynFamilyTyCon mb_co_ax) parent inj'\n\n         -- We check for instance validity later, when doing validity\n         -- checking for the tycon. Exception: checking equations\n         -- overlap done by dropDominatedAxioms\n       ; return fam_tc } }\n\n  | otherwise = panic \"tcFamInst1\"  -- Silence pattern-exhaustiveness checker\ntcFamDecl1 _ (XFamilyDecl _) = panic \"tcFamDecl1\"\n\n-- | Maybe return a list of Bools that say whether a type family was declared\n-- injective in the corresponding type arguments. Length of the list is equal to\n-- the number of arguments (including implicit kind/coercion arguments).\n-- True on position\n-- N means that a function is injective in its Nth argument. False means it is\n-- not.\ntcInjectivity :: [TyConBinder] -> Maybe (LInjectivityAnn GhcRn)\n              -> TcM Injectivity\ntcInjectivity _ Nothing\n  = return NotInjective\n\n  -- User provided an injectivity annotation, so for each tyvar argument we\n  -- check whether a type family was declared injective in that argument. We\n  -- return a list of Bools, where True means that corresponding type variable\n  -- was mentioned in lInjNames (type family is injective in that argument) and\n  -- False means that it was not mentioned in lInjNames (type family is not\n  -- injective in that type variable). We also extend injectivity information to\n  -- kind variables, so if a user declares:\n  --\n  --   type family F (a :: k1) (b :: k2) = (r :: k3) | r -> a\n  --\n  -- then we mark both `a` and `k1` as injective.\n  -- NB: the return kind is considered to be *input* argument to a type family.\n  -- Since injectivity allows to infer input arguments from the result in theory\n  -- we should always mark the result kind variable (`k3` in this example) as\n  -- injective.  The reason is that result type has always an assigned kind and\n  -- therefore we can always infer the result kind if we know the result type.\n  -- But this does not seem to be useful in any way so we don't do it.  (Another\n  -- reason is that the implementation would not be straightforward.)\ntcInjectivity tcbs (Just (dL->L loc (InjectivityAnn _ lInjNames)))\n  = setSrcSpan loc $\n    do { let tvs = binderVars tcbs\n       ; dflags <- getDynFlags\n       ; checkTc (xopt LangExt.TypeFamilyDependencies dflags)\n                 (text \"Illegal injectivity annotation\" $$\n                  text \"Use TypeFamilyDependencies to allow this\")\n       ; inj_tvs <- mapM (tcLookupTyVar . unLoc) lInjNames\n       ; inj_tvs <- mapM zonkTcTyVarToTyVar inj_tvs -- zonk the kinds\n       ; let inj_ktvs = filterVarSet isTyVar $  -- no injective coercion vars\n                        closeOverKinds (mkVarSet inj_tvs)\n       ; let inj_bools = map (`elemVarSet` inj_ktvs) tvs\n       ; traceTc \"tcInjectivity\" (vcat [ ppr tvs, ppr lInjNames, ppr inj_tvs\n                                       , ppr inj_ktvs, ppr inj_bools ])\n       ; return $ Injective inj_bools }\n\ntcTySynRhs :: RolesInfo\n           -> Name\n           -> [TyConBinder] -> Kind\n           -> LHsType GhcRn -> TcM TyCon\ntcTySynRhs roles_info tc_name binders res_kind hs_ty\n  = do { env <- getLclEnv\n       ; traceTc \"tc-syn\" (ppr tc_name $$ ppr (tcl_env env))\n       ; rhs_ty <- pushTcLevelM_   $\n                   solveEqualities $\n                   tcCheckLHsType hs_ty res_kind\n       ; rhs_ty <- zonkTcTypeToType rhs_ty\n       ; let roles = roles_info tc_name\n             tycon = buildSynTyCon tc_name binders res_kind roles rhs_ty\n       ; return tycon }\n\ntcDataDefn :: RolesInfo -> Name\n           -> [TyConBinder] -> Kind\n           -> HsDataDefn GhcRn -> TcM TyCon\n  -- NB: not used for newtype/data instances (whether associated or not)\ntcDataDefn roles_info\n           tc_name tycon_binders res_kind\n           (HsDataDefn { dd_ND = new_or_data, dd_cType = cType\n                       , dd_ctxt = ctxt\n                       , dd_kindSig = mb_ksig  -- Already in tc's kind\n                                               -- via getInitialKinds\n                       , dd_cons = cons })\n =  do { gadt_syntax <- dataDeclChecks tc_name new_or_data ctxt cons\n\n       ; tcg_env <- getGblEnv\n       ; (extra_bndrs, final_res_kind) <- etaExpandAlgTyCon tycon_binders res_kind\n\n       ; let hsc_src = tcg_src tcg_env\n       ; unless (mk_permissive_kind hsc_src cons) $\n         checkTc (tcIsLiftedTypeKind final_res_kind) (badKindSig True res_kind)\n\n       ; stupid_tc_theta <- pushTcLevelM_ $ solveEqualities $ tcHsContext ctxt\n       ; stupid_theta    <- zonkTcTypesToTypes stupid_tc_theta\n       ; kind_signatures <- xoptM LangExt.KindSignatures\n\n             -- Check that we don't use kind signatures without Glasgow extensions\n       ; when (isJust mb_ksig) $\n         checkTc (kind_signatures) (badSigTyDecl tc_name)\n\n       ; tycon <- fixM $ \\ tycon -> do\n             { let final_bndrs = tycon_binders `chkAppend` extra_bndrs\n                   res_ty      = mkTyConApp tycon (mkTyVarTys (binderVars final_bndrs))\n                   roles       = roles_info tc_name\n\n             ; data_cons <- tcConDecls tycon final_bndrs res_ty cons\n             ; tc_rhs    <- mk_tc_rhs hsc_src tycon data_cons\n             ; tc_rep_nm <- newTyConRepName tc_name\n             ; return (mkAlgTyCon tc_name\n                                  final_bndrs\n                                  final_res_kind\n                                  roles\n                                  (fmap unLoc cType)\n                                  stupid_theta tc_rhs\n                                  (VanillaAlgTyCon tc_rep_nm)\n                                  gadt_syntax) }\n       ; traceTc \"tcDataDefn\" (ppr tc_name $$ ppr tycon_binders $$ ppr extra_bndrs)\n       ; return tycon }\n  where\n    -- Abstract data types in hsig files can have arbitrary kinds,\n    -- because they may be implemented by type synonyms\n    -- (which themselves can have arbitrary kinds, not just *)\n    mk_permissive_kind HsigFile [] = True\n    mk_permissive_kind _ _ = False\n\n    -- In hs-boot, a 'data' declaration with no constructors\n    -- indicates a nominally distinct abstract data type.\n    mk_tc_rhs HsBootFile _ []\n      = return AbstractTyCon\n\n    mk_tc_rhs HsigFile _ [] -- ditto\n      = return AbstractTyCon\n\n    mk_tc_rhs _ tycon data_cons\n      = case new_or_data of\n          DataType -> return (mkDataTyConRhs data_cons)\n          NewType  -> ASSERT( not (null data_cons) )\n                      mkNewTyConRhs tc_name tycon (head data_cons)\ntcDataDefn _ _ _ _ (XHsDataDefn _) = panic \"tcDataDefn\"\n\n\n-------------------------\nkcTyFamInstEqn :: TcTyCon -> LTyFamInstEqn GhcRn -> TcM ()\n-- Used for the equations of a closed type family only\n-- Not used for data/type instances\nkcTyFamInstEqn tc_fam_tc\n    (dL->L loc (HsIB { hsib_ext = imp_vars\n                     , hsib_body = FamEqn { feqn_tycon = dL->L _ eqn_tc_name\n                                          , feqn_bndrs = mb_expl_bndrs\n                                          , feqn_pats  = hs_pats\n                                          , feqn_rhs   = hs_rhs_ty }}))\n  = setSrcSpan loc $\n    do { traceTc \"kcTyFamInstEqn\" (vcat\n           [ text \"tc_name =\"    <+> ppr eqn_tc_name\n           , text \"fam_tc =\"     <+> ppr tc_fam_tc <+> dcolon <+> ppr (tyConKind tc_fam_tc)\n           , text \"hsib_vars =\"  <+> ppr imp_vars\n           , text \"feqn_bndrs =\" <+> ppr mb_expl_bndrs\n           , text \"feqn_pats =\"  <+> ppr hs_pats ])\n          -- this check reports an arity error instead of a kind error; easier for user\n       ; let vis_pats = numVisibleArgs hs_pats\n       ; checkTc (vis_pats == vis_arity) $\n                  wrongNumberOfParmsErr vis_arity\n       ; discardResult $\n         bindImplicitTKBndrs_Q_Tv imp_vars $\n         bindExplicitTKBndrs_Q_Tv AnyKind (mb_expl_bndrs `orElse` []) $\n         do { (_fam_app, res_kind) <- tcFamTyPats tc_fam_tc hs_pats\n            ; tcCheckLHsType hs_rhs_ty res_kind }\n             -- Why \"_Tv\" here?  Consider (Trac #14066\n             --  type family Bar x y where\n             --      Bar (x :: a) (y :: b) = Int\n             --      Bar (x :: c) (y :: d) = Bool\n             -- During kind-checkig, a,b,c,d should be TyVarTvs and unify appropriately\n    }\n  where\n    vis_arity = length (tyConVisibleTyVars tc_fam_tc)\n\nkcTyFamInstEqn _ (dL->L _ (XHsImplicitBndrs _)) = panic \"kcTyFamInstEqn\"\nkcTyFamInstEqn _ (dL->L _ (HsIB _ (XFamEqn _))) = panic \"kcTyFamInstEqn\"\nkcTyFamInstEqn _ _ = panic \"kcTyFamInstEqn: Impossible Match\" -- due to #15884\n\n\n--------------------------\ntcTyFamInstEqn :: TcTyCon -> AssocInstInfo -> LTyFamInstEqn GhcRn\n               -> TcM (KnotTied CoAxBranch)\n-- Needs to be here, not in TcInstDcls, because closed families\n-- (typechecked here) have TyFamInstEqns\n\ntcTyFamInstEqn fam_tc mb_clsinfo\n    (dL->L loc (HsIB { hsib_ext = imp_vars\n                 , hsib_body = FamEqn { feqn_tycon  = L _ eqn_tc_name\n                                      , feqn_bndrs  = mb_expl_bndrs\n                                      , feqn_pats   = hs_pats\n                                      , feqn_rhs    = hs_rhs_ty }}))\n  = ASSERT( getName fam_tc == eqn_tc_name )\n    setSrcSpan loc $\n    do {\n       -- First, check the arity of visible arguments\n       -- If we wait until validity checking, we'll get kind errors\n       -- below when an arity error will be much easier to understand.\n       ; let vis_arity = length (tyConVisibleTyVars fam_tc)\n             vis_pats  = numVisibleArgs hs_pats\n       ; checkTc (vis_pats == vis_arity) $\n         wrongNumberOfParmsErr vis_arity\n\n       ; (qtvs, pats, rhs_ty) <- tcTyFamInstEqnGuts fam_tc mb_clsinfo\n                                      imp_vars (mb_expl_bndrs `orElse` [])\n                                      hs_pats hs_rhs_ty\n\n       -- Don't print results they may be knot-tied\n       -- (tcFamInstEqnGuts zonks to Type)\n       ; return (mkCoAxBranch qtvs [] [] pats rhs_ty\n                              (map (const Nominal) qtvs)\n                              loc) }\n\ntcTyFamInstEqn _ _ _ = panic \"tcTyFamInstEqn\"\n\n{-\nKind check type patterns and kind annotate the embedded type variables.\n     type instance F [a] = rhs\n\n * Here we check that a type instance matches its kind signature, but we do\n   not check whether there is a pattern for each type index; the latter\n   check is only required for type synonym instances.\n\nNote [Instantiating a family tycon]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's possible that kind-checking the result of a family tycon applied to\nits patterns will instantiate the tycon further. For example, we might\nhave\n\n  type family F :: k where\n    F = Int\n    F = Maybe\n\nAfter checking (F :: forall k. k) (with no visible patterns), we still need\nto instantiate the k. With data family instances, this problem can be even\nmore intricate, due to Note [Arity of data families] in FamInstEnv. See\nindexed-types/should_compile/T12369 for an example.\n\nSo, the kind-checker must return the new skolems and args (that is, Type\nor (Type -> Type) for the equations above) and the instantiated kind.\n\nNote [Generalising in tcFamTyPatsGuts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have something like\n  type instance forall (a::k) b. F t1 t2 = rhs\n\nThen  imp_vars = [k], exp_bndrs = [a::k, b]\n\nWe want to quantify over\n  * k, a, and b  (all user-specified)\n  * and any inferred free kind vars from\n      - the kinds of k, a, b\n      - the types t1, t2\n\nHowever, unlike a type signature like\n  f :: forall (a::k). blah\n\nwe do /not/ care about the Inferred/Specified designation\nor order for the final quantified tyvars.  Type-family\ninstances are not invoked directly in Haskell source code,\nso visible type application etc plays no role.\n\nSo, the simple thing is\n   - gather candiates from [k, a, b] and pats\n   - quantify over them\n\nHence the sligtly mysterious call:\n    candidateQTyVarsOfTypes (pats ++ mkTyVarTys scoped_tvs)\n\nSimple, neat, but a little non-obvious!\n-}\n\n--------------------------\ntcTyFamInstEqnGuts :: TyCon -> AssocInstInfo\n                   -> [Name] -> [LHsTyVarBndr GhcRn]  -- Implicit and explicicit binder\n                   -> HsTyPats GhcRn                  -- Patterns\n                   -> LHsType GhcRn                   -- RHS\n                   -> TcM ([TyVar], [TcType], TcType)      -- (tyvars, pats, rhs)\n-- Used only for type families, not data families\ntcTyFamInstEqnGuts fam_tc mb_clsinfo imp_vars exp_bndrs hs_pats hs_rhs_ty\n  = do { traceTc \"tcTyFamInstEqnGuts {\" (vcat [ ppr fam_tc <+> ppr hs_pats ])\n\n       -- By now, for type families (but not data families) we should\n       -- have checked that the number of patterns matches tyConArity\n\n       -- This code is closely related to the code\n       -- in TcHsType.kcLHsQTyVars_Cusk\n       ; (imp_tvs, (exp_tvs, (lhs_ty, rhs_ty)))\n               <- pushTcLevelM_                                $\n                  solveEqualities                              $\n                  bindImplicitTKBndrs_Q_Skol imp_vars          $\n                  bindExplicitTKBndrs_Q_Skol AnyKind exp_bndrs $\n                  do { (lhs_ty, rhs_kind) <- tcFamTyPats fam_tc hs_pats\n                       -- Ensure that the instance is consistent with its\n                       -- parent class (#16008)\n                     ; addConsistencyConstraints mb_clsinfo lhs_ty\n                     ; rhs_ty <- tcCheckLHsType hs_rhs_ty rhs_kind\n                     ; return (lhs_ty, rhs_ty) }\n\n       -- See Note [Generalising in tcFamTyPatsGuts]\n       -- This code (and the stuff immediately above) is very similar\n       -- to that in tcDataFamHeader.  Maybe we should abstract the\n       -- common code; but for the moment I concluded that it's\n       -- clearer to duplicate it.  Still, if you fix a bug here,\n       -- check there too!\n       ; let scoped_tvs = imp_tvs ++ exp_tvs\n       ; dvs  <- candidateQTyVarsOfTypes (lhs_ty : mkTyVarTys scoped_tvs)\n       ; qtvs <- quantifyTyVars emptyVarSet dvs\n\n       ; (ze, qtvs) <- zonkTyBndrs qtvs\n       ; lhs_ty     <- zonkTcTypeToTypeX ze lhs_ty\n       ; rhs_ty     <- zonkTcTypeToTypeX ze rhs_ty\n\n       ; let pats = unravelFamInstPats lhs_ty\n             -- Note that we do this after solveEqualities\n             -- so that any strange coercions inside lhs_ty\n             -- have been solved before we attempt to unravel it\n       ; traceTc \"tcTyFamInstEqnGuts }\" (ppr fam_tc <+> pprTyVars qtvs)\n       ; return (qtvs, pats, rhs_ty) }\n\n-----------------\ntcFamTyPats :: TyCon\n            -> HsTyPats GhcRn                -- Patterns\n            -> TcM (TcType, TcKind)          -- (lhs_type, lhs_kind)\n-- Used for both type and data families\ntcFamTyPats fam_tc hs_pats\n  = do { traceTc \"tcFamTyPats {\" $\n         vcat [ ppr fam_tc, text \"arity:\" <+> ppr fam_arity ]\n\n       ; let fun_ty = mkTyConApp fam_tc []\n\n       ; (fam_app, res_kind) <- unsetWOptM Opt_WarnPartialTypeSignatures $\n                                setXOptM LangExt.PartialTypeSignatures $\n                                -- See Note [Wildcards in family instances] in\n                                -- RnSource.hs\n                                tcInferApps typeLevelMode lhs_fun fun_ty hs_pats\n\n       ; traceTc \"End tcFamTyPats }\" $\n         vcat [ ppr fam_tc, text \"res_kind:\" <+> ppr res_kind ]\n\n       ; return (fam_app, res_kind) }\n  where\n    fam_name  = tyConName fam_tc\n    fam_arity = tyConArity fam_tc\n    lhs_fun   = noLoc (HsTyVar noExt NotPromoted (noLoc fam_name))\n\nunravelFamInstPats :: TcType -> [TcType]\n-- Decompose fam_app to get the argument patterns\n--\n-- We expect fam_app to look like (F t1 .. tn)\n-- tcInferApps is capable of returning ((F ty1 |> co) ty2),\n-- but that can't happen here because we already checked the\n-- arity of F matches the number of pattern\nunravelFamInstPats fam_app\n  = case splitTyConApp_maybe fam_app of\n      Just (_, pats) -> pats\n      Nothing        -> WARN( True, bad_lhs fam_app ) []\n        -- The Nothing case cannot happen for type families, because\n        -- we don't call unravelFamInstPats until we've solved the\n        -- equalities.  For data families I wasn't quite as convinced\n        -- so I've let it as a warning rather than a panic.\n  where\n    bad_lhs fam_app\n      = hang (text \"Ill-typed LHS of family instance\")\n           2 (debugPprType fam_app)\n\naddConsistencyConstraints :: AssocInstInfo -> TcType -> TcM ()\n-- In the corresponding positions of the class and type-family,\n-- ensure the the family argument is the same as the class argument\n--   E.g    class C a b c d where\n--             F c x y a :: Type\n-- Here the first  arg of F should be the same as the third of C\n--  and the fourth arg of F should be the same as the first of C\n--\n-- We emit /Derived/ constraints (a bit like fundeps) to encourage\n-- unification to happen, but without actually reporting errors.\n-- If, despite the efforts, corresponding positions do not match,\n-- checkConsistentFamInst will complain\naddConsistencyConstraints mb_clsinfo fam_app\n  | InClsInst { ai_inst_env = inst_env } <- mb_clsinfo\n  , Just (fam_tc, pats) <- tcSplitTyConApp_maybe fam_app\n  = do { let eqs = [ (cls_ty, pat)\n                   | (fam_tc_tv, pat) <- tyConTyVars fam_tc `zip` pats\n                   , Just cls_ty <- [lookupVarEnv inst_env fam_tc_tv] ]\n       ; traceTc \"addConsistencyConstraints\" (ppr eqs)\n       ; emitDerivedEqs AssocFamPatOrigin eqs }\n    -- Improve inference\n    -- Any mis-match is reports by checkConsistentFamInst\n  | otherwise\n  = return ()\n\n{- Note [Constraints in patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNB: This isn't the whole story. See comment in tcFamTyPats.\n\nAt first glance, it seems there is a complicated story to tell in tcFamTyPats\naround constraint solving. After all, type family patterns can now do\nGADT pattern-matching, which is jolly complicated. But, there's a key fact\nwhich makes this all simple: everything is at top level! There cannot\nbe untouchable type variables. There can't be weird interaction between\ncase branches. There can't be global skolems.\n\nThis means that the semantics of type-level GADT matching is a little\ndifferent than term level. If we have\n\n  data G a where\n    MkGBool :: G Bool\n\nAnd then\n\n  type family F (a :: G k) :: k\n  type instance F MkGBool = True\n\nwe get\n\n  axF : F Bool (MkGBool <Bool>) ~ True\n\nSimple! No casting on the RHS, because we can affect the kind parameter\nto F.\n\nIf we ever introduce local type families, this all gets a lot more\ncomplicated, and will end up looking awfully like term-level GADT\npattern-matching.\n\n\n** The new story **\n\nHere is really what we want:\n\nThe matcher really can't deal with covars in arbitrary spots in coercions.\nBut it can deal with covars that are arguments to GADT data constructors.\nSo we somehow want to allow covars only in precisely those spots, then use\nthem as givens when checking the RHS. TODO (RAE): Implement plan.\n\n\nNote [Quantifying over family patterns]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need to quantify over two different lots of kind variables:\n\nFirst, the ones that come from the kinds of the tyvar args of\ntcTyVarBndrsKindGen, as usual\n  data family Dist a\n\n  -- Proxy :: forall k. k -> *\n  data instance Dist (Proxy a) = DP\n  -- Generates  data DistProxy = DP\n  --            ax8 k (a::k) :: Dist * (Proxy k a) ~ DistProxy k a\n  -- The 'k' comes from the tcTyVarBndrsKindGen (a::k)\n\nSecond, the ones that come from the kind argument of the type family\nwhich we pick up using the (tyCoVarsOfTypes typats) in the result of\nthe thing_inside of tcHsTyvarBndrsGen.\n  -- Any :: forall k. k\n  data instance Dist Any = DA\n  -- Generates  data DistAny k = DA\n  --            ax7 k :: Dist k (Any k) ~ DistAny k\n  -- The 'k' comes from kindGeneralizeKinds (Any k)\n\nNote [Quantified kind variables of a family pattern]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider   type family KindFam (p :: k1) (q :: k1)\n           data T :: Maybe k1 -> k2 -> *\n           type instance KindFam (a :: Maybe k) b = T a b -> Int\nThe HsBSig for the family patterns will be ([k], [a])\n\nThen in the family instance we want to\n  * Bring into scope [ \"k\" -> k:*, \"a\" -> a:k ]\n  * Kind-check the RHS\n  * Quantify the type instance over k and k', as well as a,b, thus\n       type instance [k, k', a:Maybe k, b:k']\n                     KindFam (Maybe k) k' a b = T k k' a b -> Int\n\nNotice that in the third step we quantify over all the visibly-mentioned\ntype variables (a,b), but also over the implicitly mentioned kind variables\n(k, k').  In this case one is bound explicitly but often there will be\nnone. The role of the kind signature (a :: Maybe k) is to add a constraint\nthat 'a' must have that kind, and to bring 'k' into scope.\n\n\n\n************************************************************************\n*                                                                      *\n               Data types\n*                                                                      *\n************************************************************************\n-}\n\ndataDeclChecks :: Name -> NewOrData\n               -> LHsContext GhcRn -> [LConDecl GhcRn]\n               -> TcM Bool\ndataDeclChecks tc_name new_or_data (L _ stupid_theta) cons\n  = do {   -- Check that we don't use GADT syntax in H98 world\n         gadtSyntax_ok <- xoptM LangExt.GADTSyntax\n       ; let gadt_syntax = consUseGadtSyntax cons\n       ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name)\n\n           -- Check that the stupid theta is empty for a GADT-style declaration\n       ; checkTc (null stupid_theta || not gadt_syntax) (badStupidTheta tc_name)\n\n         -- Check that a newtype has exactly one constructor\n         -- Do this before checking for empty data decls, so that\n         -- we don't suggest -XEmptyDataDecls for newtypes\n       ; checkTc (new_or_data == DataType || isSingleton cons)\n                (newtypeConError tc_name (length cons))\n\n         -- Check that there's at least one condecl,\n         -- or else we're reading an hs-boot file, or -XEmptyDataDecls\n       ; empty_data_decls <- xoptM LangExt.EmptyDataDecls\n       ; is_boot <- tcIsHsBootOrSig  -- Are we compiling an hs-boot file?\n       ; checkTc (not (null cons) || empty_data_decls || is_boot)\n                 (emptyConDeclsErr tc_name)\n       ; return gadt_syntax }\n\n\n-----------------------------------\nconsUseGadtSyntax :: [LConDecl a] -> Bool\nconsUseGadtSyntax ((dL->L _ (ConDeclGADT {})) : _) = True\nconsUseGadtSyntax _                                = False\n                 -- All constructors have same shape\n\n-----------------------------------\ntcConDecls :: KnotTied TyCon -> [KnotTied TyConBinder] -> KnotTied Type\n           -> [LConDecl GhcRn] -> TcM [DataCon]\n  -- Why both the tycon tyvars and binders? Because the tyvars\n  -- have all the names and the binders have the visibilities.\ntcConDecls rep_tycon tmpl_bndrs res_tmpl\n  = concatMapM $ addLocM $\n    tcConDecl rep_tycon (mkTyConTagMap rep_tycon) tmpl_bndrs res_tmpl\n    -- It's important that we pay for tag allocation here, once per TyCon,\n    -- See Note [Constructor tag allocation], fixes #14657\n\ntcConDecl :: KnotTied TyCon          -- Representation tycon. Knot-tied!\n          -> NameEnv ConTag\n          -> [KnotTied TyConBinder] -> KnotTied Type\n                 -- Return type template (with its template tyvars)\n                 --    (tvs, T tys), where T is the family TyCon\n          -> ConDecl GhcRn\n          -> TcM [DataCon]\n\ntcConDecl rep_tycon tag_map tmpl_bndrs res_tmpl\n          (ConDeclH98 { con_name = name\n                      , con_ex_tvs = explicit_tkv_nms\n                      , con_mb_cxt = hs_ctxt\n                      , con_args = hs_args })\n  = addErrCtxt (dataConCtxtName [name]) $\n    do { -- NB: the tyvars from the declaration header are in scope\n\n         -- Get hold of the existential type variables\n         -- e.g. data T a = forall k (b::k) f. MkT a (f b)\n         -- Here tmpl_bndrs = {a}\n         --      hs_qvars = HsQTvs { hsq_implicit = {k}\n         --                        , hsq_explicit = {f,b} }\n\n       ; traceTc \"tcConDecl 1\" (vcat [ ppr name, ppr explicit_tkv_nms ])\n\n       ; (exp_tvs, (ctxt, arg_tys, field_lbls, stricts))\n           <- pushTcLevelM_                             $\n              solveEqualities                           $\n              bindExplicitTKBndrs_Skol explicit_tkv_nms $\n              do { ctxt <- tcHsMbContext hs_ctxt\n                 ; btys <- tcConArgs hs_args\n                 ; field_lbls <- lookupConstructorFields (unLoc name)\n                 ; let (arg_tys, stricts) = unzip btys\n                 ; return (ctxt, arg_tys, field_lbls, stricts)\n                 }\n\n         -- exp_tvs have explicit, user-written binding sites\n         -- the kvs below are those kind variables entirely unmentioned by the user\n         --   and discovered only by generalization\n\n       ; kvs <- kindGeneralize (mkSpecForAllTys (binderVars tmpl_bndrs) $\n                                mkSpecForAllTys exp_tvs $\n                                mkPhiTy ctxt $\n                                mkVisFunTys arg_tys $\n                                unitTy)\n                 -- That type is a lie, of course. (It shouldn't end in ()!)\n                 -- And we could construct a proper result type from the info\n                 -- at hand. But the result would mention only the tmpl_tvs,\n                 -- and so it just creates more work to do it right. Really,\n                 -- we're only doing this to find the right kind variables to\n                 -- quantify over, and this type is fine for that purpose.\n\n             -- Zonk to Types\n       ; (ze, qkvs)      <- zonkTyBndrs kvs\n       ; (ze, user_qtvs) <- zonkTyBndrsX ze exp_tvs\n       ; arg_tys         <- zonkTcTypesToTypesX ze arg_tys\n       ; ctxt            <- zonkTcTypesToTypesX ze ctxt\n\n       ; fam_envs <- tcGetFamInstEnvs\n\n       -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here\n       ; traceTc \"tcConDecl 2\" (ppr name $$ ppr field_lbls)\n       ; let\n           univ_tvbs = tyConTyVarBinders tmpl_bndrs\n           univ_tvs  = binderVars univ_tvbs\n           ex_tvbs   = mkTyVarBinders Inferred qkvs ++\n                       mkTyVarBinders Specified user_qtvs\n           ex_tvs    = qkvs ++ user_qtvs\n           -- For H98 datatypes, the user-written tyvar binders are precisely\n           -- the universals followed by the existentials.\n           -- See Note [DataCon user type variable binders] in DataCon.\n           user_tvbs = univ_tvbs ++ ex_tvbs\n           buildOneDataCon (dL->L _ name) = do\n             { is_infix <- tcConIsInfixH98 name hs_args\n             ; rep_nm   <- newTyConRepName name\n\n             ; buildDataCon fam_envs name is_infix rep_nm\n                            stricts Nothing field_lbls\n                            univ_tvs ex_tvs user_tvbs\n                            [{- no eq_preds -}] ctxt arg_tys\n                            res_tmpl rep_tycon tag_map\n                  -- NB:  we put data_tc, the type constructor gotten from the\n                  --      constructor type signature into the data constructor;\n                  --      that way checkValidDataCon can complain if it's wrong.\n             }\n       ; traceTc \"tcConDecl 2\" (ppr name)\n       ; mapM buildOneDataCon [name]\n       }\n\ntcConDecl rep_tycon tag_map tmpl_bndrs res_tmpl\n          (ConDeclGADT { con_names = names\n                       , con_qvars = qtvs\n                       , con_mb_cxt = cxt, con_args = hs_args\n                       , con_res_ty = hs_res_ty })\n  | HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = implicit_tkv_nms }\n           , hsq_explicit = explicit_tkv_nms } <- qtvs\n  = addErrCtxt (dataConCtxtName names) $\n    do { traceTc \"tcConDecl 1 gadt\" (ppr names)\n       ; let ((dL->L _ name) : _) = names\n\n       ; (imp_tvs, (exp_tvs, (ctxt, arg_tys, res_ty, field_lbls, stricts)))\n           <- pushTcLevelM_    $  -- We are going to generalise\n              solveEqualities  $  -- We won't get another crack, and we don't\n                                  -- want an error cascade\n              bindImplicitTKBndrs_Skol implicit_tkv_nms $\n              bindExplicitTKBndrs_Skol explicit_tkv_nms $\n              do { ctxt <- tcHsMbContext cxt\n                 ; btys <- tcConArgs hs_args\n                 ; res_ty <- tcHsLiftedType hs_res_ty\n                 ; field_lbls <- lookupConstructorFields name\n                 ; let (arg_tys, stricts) = unzip btys\n                 ; return (ctxt, arg_tys, res_ty, field_lbls, stricts)\n                 }\n       ; imp_tvs <- zonkAndScopedSort imp_tvs\n       ; let user_tvs = imp_tvs ++ exp_tvs\n\n       ; tkvs <- kindGeneralize (mkSpecForAllTys user_tvs $\n                                 mkPhiTy ctxt $\n                                 mkVisFunTys arg_tys $\n                                 res_ty)\n\n             -- Zonk to Types\n       ; (ze, tkvs)     <- zonkTyBndrs tkvs\n       ; (ze, user_tvs) <- zonkTyBndrsX ze user_tvs\n       ; arg_tys <- zonkTcTypesToTypesX ze arg_tys\n       ; ctxt    <- zonkTcTypesToTypesX ze ctxt\n       ; res_ty  <- zonkTcTypeToTypeX   ze res_ty\n\n       ; let (univ_tvs, ex_tvs, tkvs', user_tvs', eq_preds, arg_subst)\n               = rejigConRes tmpl_bndrs res_tmpl tkvs user_tvs res_ty\n             -- NB: this is a /lazy/ binding, so we pass six thunks to\n             --     buildDataCon without yet forcing the guards in rejigConRes\n             -- See Note [Checking GADT return types]\n\n             -- Compute the user-written tyvar binders. These have the same\n             -- tyvars as univ_tvs/ex_tvs, but perhaps in a different order.\n             -- See Note [DataCon user type variable binders] in DataCon.\n             tkv_bndrs      = mkTyVarBinders Inferred  tkvs'\n             user_tv_bndrs  = mkTyVarBinders Specified user_tvs'\n             all_user_bndrs = tkv_bndrs ++ user_tv_bndrs\n\n             ctxt'      = substTys arg_subst ctxt\n             arg_tys'   = substTys arg_subst arg_tys\n             res_ty'    = substTy  arg_subst res_ty\n\n\n       ; fam_envs <- tcGetFamInstEnvs\n\n       -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here\n       ; traceTc \"tcConDecl 2\" (ppr names $$ ppr field_lbls)\n       ; let\n           buildOneDataCon (dL->L _ name) = do\n             { is_infix <- tcConIsInfixGADT name hs_args\n             ; rep_nm   <- newTyConRepName name\n\n             ; buildDataCon fam_envs name is_infix\n                            rep_nm\n                            stricts Nothing field_lbls\n                            univ_tvs ex_tvs all_user_bndrs eq_preds\n                            ctxt' arg_tys' res_ty' rep_tycon tag_map\n                  -- NB:  we put data_tc, the type constructor gotten from the\n                  --      constructor type signature into the data constructor;\n                  --      that way checkValidDataCon can complain if it's wrong.\n             }\n       ; traceTc \"tcConDecl 2\" (ppr names)\n       ; mapM buildOneDataCon names\n       }\ntcConDecl _ _ _ _ (ConDeclGADT _ _ _ (XLHsQTyVars _) _ _ _ _)\n  = panic \"tcConDecl\"\ntcConDecl _ _ _ _ (XConDecl _) = panic \"tcConDecl\"\n\ntcConIsInfixH98 :: Name\n             -> HsConDetails (LHsType GhcRn) (Located [LConDeclField GhcRn])\n             -> TcM Bool\ntcConIsInfixH98 _   details\n  = case details of\n           InfixCon {}  -> return True\n           _            -> return False\n\ntcConIsInfixGADT :: Name\n             -> HsConDetails (LHsType GhcRn) (Located [LConDeclField GhcRn])\n             -> TcM Bool\ntcConIsInfixGADT con details\n  = case details of\n           InfixCon {}  -> return True\n           RecCon {}    -> return False\n           PrefixCon arg_tys           -- See Note [Infix GADT constructors]\n               | isSymOcc (getOccName con)\n               , [_ty1,_ty2] <- arg_tys\n                  -> do { fix_env <- getFixityEnv\n                        ; return (con `elemNameEnv` fix_env) }\n               | otherwise -> return False\n\ntcConArgs :: HsConDeclDetails GhcRn\n          -> TcM [(TcType, HsSrcBang)]\ntcConArgs (PrefixCon btys)\n  = mapM tcConArg btys\ntcConArgs (InfixCon bty1 bty2)\n  = do { bty1' <- tcConArg bty1\n       ; bty2' <- tcConArg bty2\n       ; return [bty1', bty2'] }\ntcConArgs (RecCon fields)\n  = mapM tcConArg btys\n  where\n    -- We need a one-to-one mapping from field_names to btys\n    combined = map (\\(dL->L _ f) -> (cd_fld_names f,cd_fld_type f))\n                   (unLoc fields)\n    explode (ns,ty) = zip ns (repeat ty)\n    exploded = concatMap explode combined\n    (_,btys) = unzip exploded\n\n\ntcConArg :: LHsType GhcRn -> TcM (TcType, HsSrcBang)\ntcConArg bty\n  = do  { traceTc \"tcConArg 1\" (ppr bty)\n        ; arg_ty <- tcHsOpenType (getBangType bty)\n             -- Newtypes can't have unboxed types, but we check\n             -- that in checkValidDataCon; this tcConArg stuff\n             -- doesn't happen for GADT-style declarations\n        ; traceTc \"tcConArg 2\" (ppr bty)\n        ; return (arg_ty, getBangStrictness bty) }\n\n{-\nNote [Infix GADT constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe do not currently have syntax to declare an infix constructor in GADT syntax,\nbut it makes a (small) difference to the Show instance.  So as a slightly\nad-hoc solution, we regard a GADT data constructor as infix if\n  a) it is an operator symbol\n  b) it has two arguments\n  c) there is a fixity declaration for it\nFor example:\n   infix 6 (:--:)\n   data T a where\n     (:--:) :: t1 -> t2 -> T Int\n\n\nNote [Checking GADT return types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere is a delicacy around checking the return types of a datacon. The\ncentral problem is dealing with a declaration like\n\n  data T a where\n    MkT :: T a -> Q a\n\nNote that the return type of MkT is totally bogus. When creating the T\ntycon, we also need to create the MkT datacon, which must have a \"rejigged\"\nreturn type. That is, the MkT datacon's type must be transformed to have\na uniform return type with explicit coercions for GADT-like type parameters.\nThis rejigging is what rejigConRes does. The problem is, though, that checking\nthat the return type is appropriate is much easier when done over *Type*,\nnot *HsType*, and doing a call to tcMatchTy will loop because T isn't fully\ndefined yet.\n\nSo, we want to make rejigConRes lazy and then check the validity of\nthe return type in checkValidDataCon.  To do this we /always/ return a\n6-tuple from rejigConRes (so that we can compute the return type from it, which\ncheckValidDataCon needs), but the first three fields may be bogus if\nthe return type isn't valid (the last equation for rejigConRes).\n\nThis is better than an earlier solution which reduced the number of\nerrors reported in one pass.  See Trac #7175, and #10836.\n-}\n\n-- Example\n--   data instance T (b,c) where\n--      TI :: forall e. e -> T (e,e)\n--\n-- The representation tycon looks like this:\n--   data :R7T b c where\n--      TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1\n-- In this case orig_res_ty = T (e,e)\n\nrejigConRes :: [KnotTied TyConBinder] -> KnotTied Type    -- Template for result type; e.g.\n                                  -- data instance T [a] b c ...\n                                  --      gives template ([a,b,c], T [a] b c)\n                                  -- Type must be of kind *!\n            -> [TyVar]            -- The constructor's inferred type variables\n            -> [TyVar]            -- The constructor's user-written, specified\n                                  -- type variables\n            -> KnotTied Type      -- res_ty type must be of kind *\n            -> ([TyVar],          -- Universal\n                [TyVar],          -- Existential (distinct OccNames from univs)\n                [TyVar],          -- The constructor's rejigged, user-written,\n                                  -- inferred type variables\n                [TyVar],          -- The constructor's rejigged, user-written,\n                                  -- specified type variables\n                [EqSpec],      -- Equality predicates\n                TCvSubst)      -- Substitution to apply to argument types\n        -- We don't check that the TyCon given in the ResTy is\n        -- the same as the parent tycon, because checkValidDataCon will do it\n-- NB: All arguments may potentially be knot-tied\nrejigConRes tmpl_bndrs res_tmpl dc_inferred_tvs dc_specified_tvs res_ty\n        -- E.g.  data T [a] b c where\n        --         MkT :: forall x y z. T [(x,y)] z z\n        -- The {a,b,c} are the tmpl_tvs, and the {x,y,z} are the dc_tvs\n        --     (NB: unlike the H98 case, the dc_tvs are not all existential)\n        -- Then we generate\n        --      Univ tyvars     Eq-spec\n        --          a              a~(x,y)\n        --          b              b~z\n        --          z\n        -- Existentials are the leftover type vars: [x,y]\n        -- The user-written type variables are what is listed in the forall:\n        --   [x, y, z] (all specified). We must rejig these as well.\n        --   See Note [DataCon user type variable binders] in DataCon.\n        -- So we return ( [a,b,z], [x,y]\n        --              , [], [x,y,z]\n        --              , [a~(x,y),b~z], <arg-subst> )\n  | Just subst <- ASSERT( isLiftedTypeKind (tcTypeKind res_ty) )\n                  ASSERT( isLiftedTypeKind (tcTypeKind res_tmpl) )\n                  tcMatchTy res_tmpl res_ty\n  = let (univ_tvs, raw_eqs, kind_subst) = mkGADTVars tmpl_tvs dc_tvs subst\n        raw_ex_tvs = dc_tvs `minusList` univ_tvs\n        (arg_subst, substed_ex_tvs) = substTyVarBndrs kind_subst raw_ex_tvs\n\n        -- After rejigging the existential tyvars, the resulting substitution\n        -- gives us exactly what we need to rejig the user-written tyvars,\n        -- since the dcUserTyVarBinders invariant guarantees that the\n        -- substitution has *all* the tyvars in its domain.\n        -- See Note [DataCon user type variable binders] in DataCon.\n        subst_user_tvs = map (getTyVar \"rejigConRes\" . substTyVar arg_subst)\n        substed_inferred_tvs  = subst_user_tvs dc_inferred_tvs\n        substed_specified_tvs = subst_user_tvs dc_specified_tvs\n\n        substed_eqs = map (substEqSpec arg_subst) raw_eqs\n    in\n    (univ_tvs, substed_ex_tvs, substed_inferred_tvs, substed_specified_tvs,\n     substed_eqs, arg_subst)\n\n  | otherwise\n        -- If the return type of the data constructor doesn't match the parent\n        -- type constructor, or the arity is wrong, the tcMatchTy will fail\n        --    e.g   data T a b where\n        --            T1 :: Maybe a   -- Wrong tycon\n        --            T2 :: T [a]     -- Wrong arity\n        -- We are detect that later, in checkValidDataCon, but meanwhile\n        -- we must do *something*, not just crash.  So we do something simple\n        -- albeit bogus, relying on checkValidDataCon to check the\n        --  bad-result-type error before seeing that the other fields look odd\n        -- See Note [Checking GADT return types]\n  = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, dc_inferred_tvs, dc_specified_tvs,\n     [], emptyTCvSubst)\n  where\n    dc_tvs   = dc_inferred_tvs ++ dc_specified_tvs\n    tmpl_tvs = binderVars tmpl_bndrs\n\n{- Note [mkGADTVars]\n~~~~~~~~~~~~~~~~~~~~\nRunning example:\n\ndata T (k1 :: *) (k2 :: *) (a :: k2) (b :: k2) where\n  MkT :: forall (x1 : *) (y :: x1) (z :: *).\n         T x1 * (Proxy (y :: x1), z) z\n\nWe need the rejigged type to be\n\n  MkT :: forall (x1 :: *) (k2 :: *) (a :: k2) (b :: k2).\n         forall (y :: x1) (z :: *).\n         (k2 ~ *, a ~ (Proxy x1 y, z), b ~ z)\n      => T x1 k2 a b\n\nYou might naively expect that z should become a universal tyvar,\nnot an existential. (After all, x1 becomes a universal tyvar.)\nBut z has kind * while b has kind k2, so the return type\n   T x1 k2 a z\nis ill-kinded.  Another way to say it is this: the universal\ntyvars must have exactly the same kinds as the tyConTyVars.\n\nSo we need an existential tyvar and a heterogeneous equality\nconstraint. (The b ~ z is a bit redundant with the k2 ~ * that\ncomes before in that b ~ z implies k2 ~ *. I'm sure we could do\nsome analysis that could eliminate k2 ~ *. But we don't do this\nyet.)\n\nThe data con signature has already been fully kind-checked.\nThe return type\n\n  T x1 * (Proxy (y :: x1), z) z\nbecomes\n  qtkvs    = [x1 :: *, y :: x1, z :: *]\n  res_tmpl = T x1 * (Proxy x1 y, z) z\n\nWe start off by matching (T k1 k2 a b) with (T x1 * (Proxy x1 y, z) z). We\nknow this match will succeed because of the validity check (actually done\nlater, but laziness saves us -- see Note [Checking GADT return types]).\nThus, we get\n\n  subst := { k1 |-> x1, k2 |-> *, a |-> (Proxy x1 y, z), b |-> z }\n\nNow, we need to figure out what the GADT equalities should be. In this case,\nwe *don't* want (k1 ~ x1) to be a GADT equality: it should just be a\nrenaming. The others should be GADT equalities. We also need to make\nsure that the universally-quantified variables of the datacon match up\nwith the tyvars of the tycon, as required for Core context well-formedness.\n(This last bit is why we have to rejig at all!)\n\n`choose` walks down the tycon tyvars, figuring out what to do with each one.\nIt carries two substitutions:\n  - t_sub's domain is *template* or *tycon* tyvars, mapping them to variables\n    mentioned in the datacon signature.\n  - r_sub's domain is *result* tyvars, names written by the programmer in\n    the datacon signature. The final rejigged type will use these names, but\n    the subst is still needed because sometimes the printed name of these variables\n    is different. (See choose_tv_name, below.)\n\nBefore explaining the details of `choose`, let's just look at its operation\non our example:\n\n  choose [] [] {} {} [k1, k2, a, b]\n  -->          -- first branch of `case` statement\n  choose\n    univs:    [x1 :: *]\n    eq_spec:  []\n    t_sub:    {k1 |-> x1}\n    r_sub:    {x1 |-> x1}\n    t_tvs:    [k2, a, b]\n  -->          -- second branch of `case` statement\n  choose\n    univs:    [k2 :: *, x1 :: *]\n    eq_spec:  [k2 ~ *]\n    t_sub:    {k1 |-> x1, k2 |-> k2}\n    r_sub:    {x1 |-> x1}\n    t_tvs:    [a, b]\n  -->          -- second branch of `case` statement\n  choose\n    univs:    [a :: k2, k2 :: *, x1 :: *]\n    eq_spec:  [ a ~ (Proxy x1 y, z)\n              , k2 ~ * ]\n    t_sub:    {k1 |-> x1, k2 |-> k2, a |-> a}\n    r_sub:    {x1 |-> x1}\n    t_tvs:    [b]\n  -->          -- second branch of `case` statement\n  choose\n    univs:    [b :: k2, a :: k2, k2 :: *, x1 :: *]\n    eq_spec:  [ b ~ z\n              , a ~ (Proxy x1 y, z)\n              , k2 ~ * ]\n    t_sub:    {k1 |-> x1, k2 |-> k2, a |-> a, b |-> z}\n    r_sub:    {x1 |-> x1}\n    t_tvs:    []\n  -->          -- end of recursion\n  ( [x1 :: *, k2 :: *, a :: k2, b :: k2]\n  , [k2 ~ *, a ~ (Proxy x1 y, z), b ~ z]\n  , {x1 |-> x1} )\n\n`choose` looks up each tycon tyvar in the matching (it *must* be matched!).\n\n* If it finds a bare result tyvar (the first branch of the `case`\n  statement), it checks to make sure that the result tyvar isn't yet\n  in the list of univ_tvs.  If it is in that list, then we have a\n  repeated variable in the return type, and we in fact need a GADT\n  equality.\n\n* It then checks to make sure that the kind of the result tyvar\n  matches the kind of the template tyvar. This check is what forces\n  `z` to be existential, as it should be, explained above.\n\n* Assuming no repeated variables or kind-changing, we wish to use the\n  variable name given in the datacon signature (that is, `x1` not\n  `k1`), not the tycon signature (which may have been made up by\n  GHC). So, we add a mapping from the tycon tyvar to the result tyvar\n  to t_sub.\n\n* If we discover that a mapping in `subst` gives us a non-tyvar (the\n  second branch of the `case` statement), then we have a GADT equality\n  to create.  We create a fresh equality, but we don't extend any\n  substitutions. The template variable substitution is meant for use\n  in universal tyvar kinds, and these shouldn't be affected by any\n  GADT equalities.\n\nThis whole algorithm is quite delicate, indeed. I (Richard E.) see two ways\nof simplifying it:\n\n1) The first branch of the `case` statement is really an optimization, used\nin order to get fewer GADT equalities. It might be possible to make a GADT\nequality for *every* univ. tyvar, even if the equality is trivial, and then\neither deal with the bigger type or somehow reduce it later.\n\n2) This algorithm strives to use the names for type variables as specified\nby the user in the datacon signature. If we always used the tycon tyvar\nnames, for example, this would be simplified. This change would almost\ncertainly degrade error messages a bit, though.\n-}\n\n-- ^ From information about a source datacon definition, extract out\n-- what the universal variables and the GADT equalities should be.\n-- See Note [mkGADTVars].\nmkGADTVars :: [TyVar]    -- ^ The tycon vars\n           -> [TyVar]    -- ^ The datacon vars\n           -> TCvSubst   -- ^ The matching between the template result type\n                         -- and the actual result type\n           -> ( [TyVar]\n              , [EqSpec]\n              , TCvSubst ) -- ^ The univ. variables, the GADT equalities,\n                           -- and a subst to apply to the GADT equalities\n                           -- and existentials.\nmkGADTVars tmpl_tvs dc_tvs subst\n  = choose [] [] empty_subst empty_subst tmpl_tvs\n  where\n    in_scope = mkInScopeSet (mkVarSet tmpl_tvs `unionVarSet` mkVarSet dc_tvs)\n               `unionInScope` getTCvInScope subst\n    empty_subst = mkEmptyTCvSubst in_scope\n\n    choose :: [TyVar]           -- accumulator of univ tvs, reversed\n           -> [EqSpec]          -- accumulator of GADT equalities, reversed\n           -> TCvSubst          -- template substitution\n           -> TCvSubst          -- res. substitution\n           -> [TyVar]           -- template tvs (the univ tvs passed in)\n           -> ( [TyVar]         -- the univ_tvs\n              , [EqSpec]        -- GADT equalities\n              , TCvSubst )       -- a substitution to fix kinds in ex_tvs\n\n    choose univs eqs _t_sub r_sub []\n      = (reverse univs, reverse eqs, r_sub)\n    choose univs eqs t_sub r_sub (t_tv:t_tvs)\n      | Just r_ty <- lookupTyVar subst t_tv\n      = case getTyVar_maybe r_ty of\n          Just r_tv\n            |  not (r_tv `elem` univs)\n            ,  tyVarKind r_tv `eqType` (substTy t_sub (tyVarKind t_tv))\n            -> -- simple, well-kinded variable substitution.\n               choose (r_tv:univs) eqs\n                      (extendTvSubst t_sub t_tv r_ty')\n                      (extendTvSubst r_sub r_tv r_ty')\n                      t_tvs\n            where\n              r_tv1  = setTyVarName r_tv (choose_tv_name r_tv t_tv)\n              r_ty'  = mkTyVarTy r_tv1\n\n               -- Not a simple substitution: make an equality predicate\n          _ -> choose (t_tv':univs) (mkEqSpec t_tv' r_ty : eqs)\n                      (extendTvSubst t_sub t_tv (mkTyVarTy t_tv'))\n                         -- We've updated the kind of t_tv,\n                         -- so add it to t_sub (Trac #14162)\n                      r_sub t_tvs\n            where\n              t_tv' = updateTyVarKind (substTy t_sub) t_tv\n\n      | otherwise\n      = pprPanic \"mkGADTVars\" (ppr tmpl_tvs $$ ppr subst)\n\n      -- choose an appropriate name for a univ tyvar.\n      -- This *must* preserve the Unique of the result tv, so that we\n      -- can detect repeated variables. It prefers user-specified names\n      -- over system names. A result variable with a system name can\n      -- happen with GHC-generated implicit kind variables.\n    choose_tv_name :: TyVar -> TyVar -> Name\n    choose_tv_name r_tv t_tv\n      | isSystemName r_tv_name\n      = setNameUnique t_tv_name (getUnique r_tv_name)\n\n      | otherwise\n      = r_tv_name\n\n      where\n        r_tv_name = getName r_tv\n        t_tv_name = getName t_tv\n\n{-\nNote [Substitution in template variables kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\ndata G (a :: Maybe k) where\n  MkG :: G Nothing\n\nWith explicit kind variables\n\ndata G k (a :: Maybe k) where\n  MkG :: G k1 (Nothing k1)\n\nNote how k1 is distinct from k. So, when we match the template\n`G k a` against `G k1 (Nothing k1)`, we get a subst\n[ k |-> k1, a |-> Nothing k1 ]. Even though this subst has two\nmappings, we surely don't want to add (k, k1) to the list of\nGADT equalities -- that would be overly complex and would create\nmore untouchable variables than we need. So, when figuring out\nwhich tyvars are GADT-like and which aren't (the fundamental\njob of `choose`), we want to treat `k` as *not* GADT-like.\nInstead, we wish to substitute in `a`'s kind, to get (a :: Maybe k1)\ninstead of (a :: Maybe k). This is the reason for dealing\nwith a substitution in here.\n\nHowever, we do not *always* want to substitute. Consider\n\ndata H (a :: k) where\n  MkH :: H Int\n\nWith explicit kind variables:\n\ndata H k (a :: k) where\n  MkH :: H * Int\n\nHere, we have a kind-indexed GADT. The subst in question is\n[ k |-> *, a |-> Int ]. Now, we *don't* want to substitute in `a`'s\nkind, because that would give a constructor with the type\n\nMkH :: forall (k :: *) (a :: *). (k ~ *) -> (a ~ Int) -> H k a\n\nThe problem here is that a's kind is wrong -- it needs to be k, not *!\nSo, if the matching for a variable is anything but another bare variable,\nwe drop the mapping from the substitution before proceeding. This\nwas not an issue before kind-indexed GADTs because this case could\nnever happen.\n\n************************************************************************\n*                                                                      *\n                Validity checking\n*                                                                      *\n************************************************************************\n\nValidity checking is done once the mutually-recursive knot has been\ntied, so we can look at things freely.\n-}\n\ncheckValidTyCl :: TyCon -> TcM [TyCon]\n-- The returned list is either a singleton (if valid)\n-- or a list of \"fake tycons\" (if not); the fake tycons\n-- include any implicits, like promoted data constructors\n-- See Note [Recover from validity error]\ncheckValidTyCl tc\n  = setSrcSpan (getSrcSpan tc) $\n    addTyConCtxt tc            $\n    recoverM recovery_code     $\n    do { traceTc \"Starting validity for tycon\" (ppr tc)\n       ; checkValidTyCon tc\n       ; traceTc \"Done validity for tycon\" (ppr tc)\n       ; return [tc] }\n  where\n    recovery_code -- See Note [Recover from validity error]\n      = do { traceTc \"Aborted validity for tycon\" (ppr tc)\n           ; return (concatMap mk_fake_tc $\n                     ATyCon tc : implicitTyConThings tc) }\n\n    mk_fake_tc (ATyCon tc)\n      | isClassTyCon tc = [tc]   -- Ugh! Note [Recover from validity error]\n      | otherwise       = [makeRecoveryTyCon tc]\n    mk_fake_tc (AConLike (RealDataCon dc))\n                        = [makeRecoveryTyCon (promoteDataCon dc)]\n    mk_fake_tc _        = []\n\n{- Note [Recover from validity error]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe recover from a validity error in a type or class, which allows us\nto report multiple validity errors. In the failure case we return a\nTyCon of the right kind, but with no interesting behaviour\n(makeRecoveryTyCon). Why?  Suppose we have\n   type T a = Fun\nwhere Fun is a type family of arity 1.  The RHS is invalid, but we\nwant to go on checking validity of subsequent type declarations.\nSo we replace T with an abstract TyCon which will do no harm.\nSee indexed-types/should_fail/BadSock and Trac #10896\n\nSome notes:\n\n* We must make fakes for promoted DataCons too. Consider (Trac #15215)\n      data T a = MkT ...\n      data S a = ...T...MkT....\n  If there is an error in the definition of 'T' we add a \"fake type\n  constructor\" to the type environment, so that we can continue to\n  typecheck 'S'.  But we /were not/ adding a fake anything for 'MkT'\n  and so there was an internal error when we met 'MkT' in the body of\n  'S'.\n\n* Painfully, we *don't* want to do this for classes.\n  Consider tcfail041:\n     class (?x::Int) => C a where ...\n     instance C Int\n  The class is invalid because of the superclass constraint.  But\n  we still want it to look like a /class/, else the instance bleats\n  that the instance is mal-formed because it hasn't got a class in\n  the head.\n\n  This is really bogus; now we have in scope a Class that is invalid\n  in some way, with unknown downstream consequences.  A better\n  alterantive might be to make a fake class TyCon.  A job for another day.\n-}\n\n-------------------------\n-- For data types declared with record syntax, we require\n-- that each constructor that has a field 'f'\n--      (a) has the same result type\n--      (b) has the same type for 'f'\n-- module alpha conversion of the quantified type variables\n-- of the constructor.\n--\n-- Note that we allow existentials to match because the\n-- fields can never meet. E.g\n--      data T where\n--        T1 { f1 :: b, f2 :: a, f3 ::Int } :: T\n--        T2 { f1 :: c, f2 :: c, f3 ::Int } :: T\n-- Here we do not complain about f1,f2 because they are existential\n\ncheckValidTyCon :: TyCon -> TcM ()\ncheckValidTyCon tc\n  | isPrimTyCon tc   -- Happens when Haddock'ing GHC.Prim\n  = return ()\n\n  | otherwise\n  = do { traceTc \"checkValidTyCon\" (ppr tc $$ ppr (tyConClass_maybe tc))\n       ; if | Just cl <- tyConClass_maybe tc\n              -> checkValidClass cl\n\n            | Just syn_rhs <- synTyConRhs_maybe tc\n              -> do { checkValidType syn_ctxt syn_rhs\n                    ; checkTySynRhs syn_ctxt syn_rhs }\n\n            | Just fam_flav <- famTyConFlav_maybe tc\n              -> case fam_flav of\n               { ClosedSynFamilyTyCon (Just ax)\n                   -> tcAddClosedTypeFamilyDeclCtxt tc $\n                      checkValidCoAxiom ax\n               ; ClosedSynFamilyTyCon Nothing   -> return ()\n               ; AbstractClosedSynFamilyTyCon ->\n                 do { hsBoot <- tcIsHsBootOrSig\n                    ; checkTc hsBoot $\n                      text \"You may define an abstract closed type family\" $$\n                      text \"only in a .hs-boot file\" }\n               ; DataFamilyTyCon {}           -> return ()\n               ; OpenSynFamilyTyCon           -> return ()\n               ; BuiltInSynFamTyCon _         -> return () }\n\n             | otherwise -> do\n               { -- Check the context on the data decl\n                 traceTc \"cvtc1\" (ppr tc)\n               ; checkValidTheta (DataTyCtxt name) (tyConStupidTheta tc)\n\n               ; traceTc \"cvtc2\" (ppr tc)\n\n               ; dflags          <- getDynFlags\n               ; existential_ok  <- xoptM LangExt.ExistentialQuantification\n               ; gadt_ok         <- xoptM LangExt.GADTs\n               ; let ex_ok = existential_ok || gadt_ok\n                     -- Data cons can have existential context\n               ; mapM_ (checkValidDataCon dflags ex_ok tc) data_cons\n               ; mapM_ (checkPartialRecordField data_cons) (tyConFieldLabels tc)\n\n                -- Check that fields with the same name share a type\n               ; mapM_ check_fields groups }}\n  where\n    syn_ctxt  = TySynCtxt name\n    name      = tyConName tc\n    data_cons = tyConDataCons tc\n\n    groups = equivClasses cmp_fld (concatMap get_fields data_cons)\n    cmp_fld (f1,_) (f2,_) = flLabel f1 `compare` flLabel f2\n    get_fields con = dataConFieldLabels con `zip` repeat con\n        -- dataConFieldLabels may return the empty list, which is fine\n\n    -- See Note [GADT record selectors] in TcTyDecls\n    -- We must check (a) that the named field has the same\n    --                   type in each constructor\n    --               (b) that those constructors have the same result type\n    --\n    -- However, the constructors may have differently named type variable\n    -- and (worse) we don't know how the correspond to each other.  E.g.\n    --     C1 :: forall a b. { f :: a, g :: b } -> T a b\n    --     C2 :: forall d c. { f :: c, g :: c } -> T c d\n    --\n    -- So what we do is to ust Unify.tcMatchTys to compare the first candidate's\n    -- result type against other candidates' types BOTH WAYS ROUND.\n    -- If they magically agrees, take the substitution and\n    -- apply them to the latter ones, and see if they match perfectly.\n    check_fields ((label, con1) :| other_fields)\n        -- These fields all have the same name, but are from\n        -- different constructors in the data type\n        = recoverM (return ()) $ mapM_ checkOne other_fields\n                -- Check that all the fields in the group have the same type\n                -- NB: this check assumes that all the constructors of a given\n                -- data type use the same type variables\n        where\n        (_, _, _, res1) = dataConSig con1\n        fty1 = dataConFieldType con1 lbl\n        lbl = flLabel label\n\n        checkOne (_, con2)    -- Do it both ways to ensure they are structurally identical\n            = do { checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2\n                 ; checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }\n            where\n                (_, _, _, res2) = dataConSig con2\n                fty2 = dataConFieldType con2 lbl\n\ncheckPartialRecordField :: [DataCon] -> FieldLabel -> TcM ()\n-- Checks the partial record field selector, and warns.\n-- See Note [Checking partial record field]\ncheckPartialRecordField all_cons fld\n  = setSrcSpan loc $\n      warnIfFlag Opt_WarnPartialFields\n        (not is_exhaustive && not (startsWithUnderscore occ_name))\n        (sep [text \"Use of partial record field selector\" <> colon,\n              nest 2 $ quotes (ppr occ_name)])\n  where\n    sel_name = flSelector fld\n    loc    = getSrcSpan sel_name\n    occ_name = getOccName sel_name\n\n    (cons_with_field, cons_without_field) = partition has_field all_cons\n    has_field con = fld `elem` (dataConFieldLabels con)\n    is_exhaustive = all (dataConCannotMatch inst_tys) cons_without_field\n\n    con1 = ASSERT( not (null cons_with_field) ) head cons_with_field\n    (univ_tvs, _, eq_spec, _, _, _) = dataConFullSig con1\n    eq_subst = mkTvSubstPrs (map eqSpecPair eq_spec)\n    inst_tys = substTyVars eq_subst univ_tvs\n\ncheckFieldCompat :: FieldLabelString -> DataCon -> DataCon\n                 -> Type -> Type -> Type -> Type -> TcM ()\ncheckFieldCompat fld con1 con2 res1 res2 fty1 fty2\n  = do  { checkTc (isJust mb_subst1) (resultTypeMisMatch fld con1 con2)\n        ; checkTc (isJust mb_subst2) (fieldTypeMisMatch fld con1 con2) }\n  where\n    mb_subst1 = tcMatchTy res1 res2\n    mb_subst2 = tcMatchTyX (expectJust \"checkFieldCompat\" mb_subst1) fty1 fty2\n\n-------------------------------\ncheckValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM ()\ncheckValidDataCon dflags existential_ok tc con\n  = setSrcSpan (getSrcSpan con)  $\n    addErrCtxt (dataConCtxt con) $\n    do  { -- Check that the return type of the data constructor\n          -- matches the type constructor; eg reject this:\n          --   data T a where { MkT :: Bogus a }\n          -- It's important to do this first:\n          --  see Note [Checking GADT return types]\n          --  and c.f. Note [Check role annotations in a second pass]\n          let tc_tvs      = tyConTyVars tc\n              res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs)\n              orig_res_ty = dataConOrigResTy con\n        ; traceTc \"checkValidDataCon\" (vcat\n              [ ppr con, ppr tc, ppr tc_tvs\n              , ppr res_ty_tmpl <+> dcolon <+> ppr (tcTypeKind res_ty_tmpl)\n              , ppr orig_res_ty <+> dcolon <+> ppr (tcTypeKind orig_res_ty)])\n\n\n        ; checkTc (isJust (tcMatchTy res_ty_tmpl\n                                     orig_res_ty))\n                  (badDataConTyCon con res_ty_tmpl orig_res_ty)\n            -- Note that checkTc aborts if it finds an error. This is\n            -- critical to avoid panicking when we call dataConUserType\n            -- on an un-rejiggable datacon!\n\n        ; traceTc \"checkValidDataCon 2\" (ppr (dataConUserType con))\n\n          -- Check that the result type is a *monotype*\n          --  e.g. reject this:   MkT :: T (forall a. a->a)\n          -- Reason: it's really the argument of an equality constraint\n        ; checkValidMonoType orig_res_ty\n\n          -- Check all argument types for validity\n        ; checkValidType ctxt (dataConUserType con)\n        ; mapM_ (checkForLevPoly empty)\n                (dataConOrigArgTys con)\n\n          -- Extra checks for newtype data constructors\n        ; when (isNewTyCon tc) (checkNewDataCon con)\n\n          -- Check that existentials are allowed if they are used\n        ; checkTc (existential_ok || isVanillaDataCon con)\n                  (badExistential con)\n\n          -- Check that UNPACK pragmas and bangs work out\n          -- E.g.  reject   data T = MkT {-# UNPACK #-} Int     -- No \"!\"\n          --                data T = MkT {-# UNPACK #-} !a      -- Can't unpack\n        ; zipWith3M_ check_bang (dataConSrcBangs con) (dataConImplBangs con) [1..]\n\n          -- Check the dcUserTyVarBinders invariant\n          -- See Note [DataCon user type variable binders] in DataCon\n          -- checked here because we sometimes build invalid DataCons before\n          -- erroring above here\n        ; when debugIsOn $\n          do { let (univs, exs, eq_spec, _, _, _) = dataConFullSig con\n                   user_tvs                       = dataConUserTyVars con\n                   user_tvbs_invariant\n                     =    Set.fromList (filterEqSpec eq_spec univs ++ exs)\n                       == Set.fromList user_tvs\n             ; WARN( not user_tvbs_invariant\n                       , vcat ([ ppr con\n                               , ppr univs\n                               , ppr exs\n                               , ppr eq_spec\n                               , ppr user_tvs ])) return () }\n\n        ; traceTc \"Done validity of data con\" $\n          vcat [ ppr con\n               , text \"Datacon user type:\" <+> ppr (dataConUserType con)\n               , text \"Datacon rep type:\" <+> ppr (dataConRepType con)\n               , text \"Rep typcon binders:\" <+> ppr (tyConBinders (dataConTyCon con))\n               , case tyConFamInst_maybe (dataConTyCon con) of\n                   Nothing -> text \"not family\"\n                   Just (f, _) -> ppr (tyConBinders f) ]\n    }\n  where\n    ctxt = ConArgCtxt (dataConName con)\n\n    check_bang :: HsSrcBang -> HsImplBang -> Int -> TcM ()\n    check_bang (HsSrcBang _ _ SrcLazy) _ n\n      | not (xopt LangExt.StrictData dflags)\n      = addErrTc\n          (bad_bang n (text \"Lazy annotation (~) without StrictData\"))\n    check_bang (HsSrcBang _ want_unpack strict_mark) rep_bang n\n      | isSrcUnpacked want_unpack, not is_strict\n      = addWarnTc NoReason (bad_bang n (text \"UNPACK pragma lacks '!'\"))\n      | isSrcUnpacked want_unpack\n      , case rep_bang of { HsUnpack {} -> False; _ -> True }\n      -- If not optimising, we don't unpack (rep_bang is never\n      -- HsUnpack), so don't complain!  This happens, e.g., in Haddock.\n      -- See dataConSrcToImplBang.\n      , not (gopt Opt_OmitInterfacePragmas dflags)\n      -- When typechecking an indefinite package in Backpack, we\n      -- may attempt to UNPACK an abstract type.  The test here will\n      -- conclude that this is unusable, but it might become usable\n      -- when we actually fill in the abstract type.  As such, don't\n      -- warn in this case (it gives users the wrong idea about whether\n      -- or not UNPACK on abstract types is supported; it is!)\n      , unitIdIsDefinite (thisPackage dflags)\n      = addWarnTc NoReason (bad_bang n (text \"Ignoring unusable UNPACK pragma\"))\n      where\n        is_strict = case strict_mark of\n                      NoSrcStrict -> xopt LangExt.StrictData dflags\n                      bang        -> isSrcStrict bang\n\n    check_bang _ _ _\n      = return ()\n\n    bad_bang n herald\n      = hang herald 2 (text \"on the\" <+> speakNth n\n                       <+> text \"argument of\" <+> quotes (ppr con))\n-------------------------------\ncheckNewDataCon :: DataCon -> TcM ()\n-- Further checks for the data constructor of a newtype\ncheckNewDataCon con\n  = do  { checkTc (isSingleton arg_tys) (newtypeFieldErr con (length arg_tys))\n              -- One argument\n\n        ; checkTc (not (isUnliftedType arg_ty1)) $\n          text \"A newtype cannot have an unlifted argument type\"\n\n        ; check_con (null eq_spec) $\n          text \"A newtype constructor must have a return type of form T a1 ... an\"\n                -- Return type is (T a b c)\n\n        ; check_con (null theta) $\n          text \"A newtype constructor cannot have a context in its type\"\n\n        ; check_con (null ex_tvs) $\n          text \"A newtype constructor cannot have existential type variables\"\n                -- No existentials\n\n        ; checkTc (all ok_bang (dataConSrcBangs con))\n                  (newtypeStrictError con)\n                -- No strictness annotations\n    }\n  where\n    (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty)\n      = dataConFullSig con\n    check_con what msg\n       = checkTc what (msg $$ ppr con <+> dcolon <+> ppr (dataConUserType con))\n\n    (arg_ty1 : _) = arg_tys\n\n    ok_bang (HsSrcBang _ _ SrcStrict) = False\n    ok_bang (HsSrcBang _ _ SrcLazy)   = False\n    ok_bang _                         = True\n\n-------------------------------\ncheckValidClass :: Class -> TcM ()\ncheckValidClass cls\n  = do  { constrained_class_methods <- xoptM LangExt.ConstrainedClassMethods\n        ; multi_param_type_classes  <- xoptM LangExt.MultiParamTypeClasses\n        ; nullary_type_classes      <- xoptM LangExt.NullaryTypeClasses\n        ; fundep_classes            <- xoptM LangExt.FunctionalDependencies\n        ; undecidable_super_classes <- xoptM LangExt.UndecidableSuperClasses\n\n        -- Check that the class is unary, unless multiparameter type classes\n        -- are enabled; also recognize deprecated nullary type classes\n        -- extension (subsumed by multiparameter type classes, Trac #8993)\n        ; checkTc (multi_param_type_classes || cls_arity == 1 ||\n                    (nullary_type_classes && cls_arity == 0))\n                  (classArityErr cls_arity cls)\n        ; checkTc (fundep_classes || null fundeps) (classFunDepsErr cls)\n\n        -- Check the super-classes\n        ; checkValidTheta (ClassSCCtxt (className cls)) theta\n\n          -- Now check for cyclic superclasses\n          -- If there are superclass cycles, checkClassCycleErrs bails.\n        ; unless undecidable_super_classes $\n          case checkClassCycles cls of\n             Just err -> setSrcSpan (getSrcSpan cls) $\n                         addErrTc err\n             Nothing  -> return ()\n\n        -- Check the class operations.\n        -- But only if there have been no earlier errors\n        -- See Note [Abort when superclass cycle is detected]\n        ; whenNoErrs $\n          mapM_ (check_op constrained_class_methods) op_stuff\n\n        -- Check the associated type defaults are well-formed and instantiated\n        ; mapM_ check_at at_stuff  }\n  where\n    (tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls\n    cls_arity = length (tyConVisibleTyVars (classTyCon cls))\n       -- Ignore invisible variables\n    cls_tv_set = mkVarSet tyvars\n\n    check_op constrained_class_methods (sel_id, dm)\n      = setSrcSpan (getSrcSpan sel_id) $\n        addErrCtxt (classOpCtxt sel_id op_ty) $ do\n        { traceTc \"class op type\" (ppr op_ty)\n        ; checkValidType ctxt op_ty\n                -- This implements the ambiguity check, among other things\n                -- Example: tc223\n                --   class Error e => Game b mv e | b -> mv e where\n                --      newBoard :: MonadState b m => m ()\n                -- Here, MonadState has a fundep m->b, so newBoard is fine\n\n           -- a method cannot be levity polymorphic, as we have to store the\n           -- method in a dictionary\n           -- example of what this prevents:\n           --   class BoundedX (a :: TYPE r) where minBound :: a\n           -- See Note [Levity polymorphism checking] in DsMonad\n        ; checkForLevPoly empty tau1\n\n        ; unless constrained_class_methods $\n          mapM_ check_constraint (tail (cls_pred:op_theta))\n\n        ; check_dm ctxt sel_id cls_pred tau2 dm\n        }\n        where\n          ctxt    = FunSigCtxt op_name True -- Report redundant class constraints\n          op_name = idName sel_id\n          op_ty   = idType sel_id\n          (_,cls_pred,tau1) = tcSplitMethodTy op_ty\n          -- See Note [Splitting nested sigma types in class type signatures]\n          (_,op_theta,tau2) = tcSplitNestedSigmaTys tau1\n\n          check_constraint :: TcPredType -> TcM ()\n          check_constraint pred -- See Note [Class method constraints]\n            = when (not (isEmptyVarSet pred_tvs) &&\n                    pred_tvs `subVarSet` cls_tv_set)\n                   (addErrTc (badMethPred sel_id pred))\n            where\n              pred_tvs = tyCoVarsOfType pred\n\n    check_at (ATI fam_tc m_dflt_rhs)\n      = do { checkTc (cls_arity == 0 || any (`elemVarSet` cls_tv_set) fam_tvs)\n                     (noClassTyVarErr cls fam_tc)\n                        -- Check that the associated type mentions at least\n                        -- one of the class type variables\n                        -- The check is disabled for nullary type classes,\n                        -- since there is no possible ambiguity (Trac #10020)\n\n             -- Check that any default declarations for associated types are valid\n           ; whenIsJust m_dflt_rhs $ \\ (rhs, loc) ->\n             setSrcSpan loc $\n             tcAddFamInstCtxt (text \"default type instance\") (getName fam_tc) $\n             checkValidTyFamEqn fam_tc fam_tvs (mkTyVarTys fam_tvs) rhs }\n        where\n          fam_tvs = tyConTyVars fam_tc\n\n    check_dm :: UserTypeCtxt -> Id -> PredType -> Type -> DefMethInfo -> TcM ()\n    -- Check validity of the /top-level/ generic-default type\n    -- E.g for   class C a where\n    --             default op :: forall b. (a~b) => blah\n    -- we do not want to do an ambiguity check on a type with\n    -- a free TyVar 'a' (Trac #11608).  See TcType\n    -- Note [TyVars and TcTyVars during type checking] in TcType\n    -- Hence the mkDefaultMethodType to close the type.\n    check_dm ctxt sel_id vanilla_cls_pred vanilla_tau\n             (Just (dm_name, dm_spec@(GenericDM dm_ty)))\n      = setSrcSpan (getSrcSpan dm_name) $ do\n            -- We have carefully set the SrcSpan on the generic\n            -- default-method Name to be that of the generic\n            -- default type signature\n\n          -- First, we check that that the method's default type signature\n          -- aligns with the non-default type signature.\n          -- See Note [Default method type signatures must align]\n          let cls_pred = mkClassPred cls $ mkTyVarTys $ classTyVars cls\n              -- Note that the second field of this tuple contains the context\n              -- of the default type signature, making it apparent that we\n              -- ignore method contexts completely when validity-checking\n              -- default type signatures. See the end of\n              -- Note [Default method type signatures must align]\n              -- to learn why this is OK.\n              --\n              -- See also\n              -- Note [Splitting nested sigma types in class type signatures]\n              -- for an explanation of why we don't use tcSplitSigmaTy here.\n              (_, _, dm_tau) = tcSplitNestedSigmaTys dm_ty\n\n              -- Given this class definition:\n              --\n              --  class C a b where\n              --    op         :: forall p q. (Ord a, D p q)\n              --               => a -> b -> p -> (a, b)\n              --    default op :: forall r s. E r\n              --               => a -> b -> s -> (a, b)\n              --\n              -- We want to match up two types of the form:\n              --\n              --   Vanilla type sig: C aa bb => aa -> bb -> p -> (aa, bb)\n              --   Default type sig: C a  b  => a  -> b  -> s -> (a,  b)\n              --\n              -- Notice that the two type signatures can be quantified over\n              -- different class type variables! Therefore, it's important that\n              -- we include the class predicate parts to match up a with aa and\n              -- b with bb.\n              vanilla_phi_ty = mkPhiTy [vanilla_cls_pred] vanilla_tau\n              dm_phi_ty      = mkPhiTy [cls_pred] dm_tau\n\n          traceTc \"check_dm\" $ vcat\n              [ text \"vanilla_phi_ty\" <+> ppr vanilla_phi_ty\n              , text \"dm_phi_ty\"      <+> ppr dm_phi_ty ]\n\n          -- Actually checking that the types align is done with a call to\n          -- tcMatchTys. We need to get a match in both directions to rule\n          -- out degenerate cases like these:\n          --\n          --  class Foo a where\n          --    foo1         :: a -> b\n          --    default foo1 :: a -> Int\n          --\n          --    foo2         :: a -> Int\n          --    default foo2 :: a -> b\n          unless (isJust $ tcMatchTys [dm_phi_ty, vanilla_phi_ty]\n                                      [vanilla_phi_ty, dm_phi_ty]) $ addErrTc $\n               hang (text \"The default type signature for\"\n                     <+> ppr sel_id <> colon)\n                 2 (ppr dm_ty)\n            $$ (text \"does not match its corresponding\"\n                <+> text \"non-default type signature\")\n\n          -- Now do an ambiguity check on the default type signature.\n          checkValidType ctxt (mkDefaultMethodType cls sel_id dm_spec)\n    check_dm _ _ _ _ _ = return ()\n\ncheckFamFlag :: Name -> TcM ()\n-- Check that we don't use families without -XTypeFamilies\n-- The parser won't even parse them, but I suppose a GHC API\n-- client might have a go!\ncheckFamFlag tc_name\n  = do { idx_tys <- xoptM LangExt.TypeFamilies\n       ; checkTc idx_tys err_msg }\n  where\n    err_msg = hang (text \"Illegal family declaration for\" <+> quotes (ppr tc_name))\n                 2 (text \"Enable TypeFamilies to allow indexed type families\")\n\n{- Note [Class method constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHaskell 2010 is supposed to reject\n  class C a where\n    op :: Eq a => a -> a\nwhere the method type constrains only the class variable(s).  (The extension\n-XConstrainedClassMethods switches off this check.)  But regardless\nwe should not reject\n  class C a where\n    op :: (?x::Int) => a -> a\nas pointed out in Trac #11793. So the test here rejects the program if\n  * -XConstrainedClassMethods is off\n  * the tyvars of the constraint are non-empty\n  * all the tyvars are class tyvars, none are locally quantified\n\nNote [Abort when superclass cycle is detected]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe must avoid doing the ambiguity check for the methods (in\ncheckValidClass.check_op) when there are already errors accumulated.\nThis is because one of the errors may be a superclass cycle, and\nsuperclass cycles cause canonicalization to loop. Here is a\nrepresentative example:\n\n  class D a => C a where\n    meth :: D a => ()\n  class C a => D a\n\nThis fixes Trac #9415, #9739\n\nNote [Default method type signatures must align]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC enforces the invariant that a class method's default type signature\nmust \"align\" with that of the method's non-default type signature, as per\nGHC Trac #12918. For instance, if you have:\n\n  class Foo a where\n    bar :: forall b. Context => a -> b\n\nThen a default type signature for bar must be alpha equivalent to\n(forall b. a -> b). That is, the types must be the same modulo differences in\ncontexts. So the following would be acceptable default type signatures:\n\n    default bar :: forall b. Context1 => a -> b\n    default bar :: forall x. Context2 => a -> x\n\nBut the following are NOT acceptable default type signatures:\n\n    default bar :: forall b. b -> a\n    default bar :: forall x. x\n    default bar :: a -> Int\n\nNote that a is bound by the class declaration for Foo itself, so it is\nnot allowed to differ in the default type signature.\n\nThe default type signature (default bar :: a -> Int) deserves special mention,\nsince (a -> Int) is a straightforward instantiation of (forall b. a -> b). To\nwrite this, you need to declare the default type signature like so:\n\n    default bar :: forall b. (b ~ Int). a -> b\n\nAs noted in #12918, there are several reasons to do this:\n\n1. It would make no sense to have a type that was flat-out incompatible with\n   the non-default type signature. For instance, if you had:\n\n     class Foo a where\n       bar :: a -> Int\n       default bar :: a -> Bool\n\n   Then that would always fail in an instance declaration. So this check\n   nips such cases in the bud before they have the chance to produce\n   confusing error messages.\n\n2. Internally, GHC uses TypeApplications to instantiate the default method in\n   an instance. See Note [Default methods in instances] in TcInstDcls.\n   Thus, GHC needs to know exactly what the universally quantified type\n   variables are, and when instantiated that way, the default method's type\n   must match the expected type.\n\n3. Aesthetically, by only allowing the default type signature to differ in its\n   context, we are making it more explicit the ways in which the default type\n   signature is less polymorphic than the non-default type signature.\n\nYou might be wondering: why are the contexts allowed to be different, but not\nthe rest of the type signature? That's because default implementations often\nrely on assumptions that the more general, non-default type signatures do not.\nFor instance, in the Enum class declaration:\n\n    class Enum a where\n      enum :: [a]\n      default enum :: (Generic a, GEnum (Rep a)) => [a]\n      enum = map to genum\n\n    class GEnum f where\n      genum :: [f a]\n\nThe default implementation for enum only works for types that are instances of\nGeneric, and for which their generic Rep type is an instance of GEnum. But\nclearly enum doesn't _have_ to use this implementation, so naturally, the\ncontext for enum is allowed to be different to accomodate this. As a result,\nwhen we validity-check default type signatures, we ignore contexts completely.\n\nNote that when checking whether two type signatures match, we must take care to\nsplit as many foralls as it takes to retrieve the tau types we which to check.\nSee Note [Splitting nested sigma types in class type signatures].\n\nNote [Splitting nested sigma types in class type signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this type synonym and class definition:\n\n  type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t\n\n  class Each s t a b where\n    each         ::                                      Traversal s t a b\n    default each :: (Traversable g, s ~ g a, t ~ g b) => Traversal s t a b\n\nIt might seem obvious that the tau types in both type signatures for `each`\nare the same, but actually getting GHC to conclude this is surprisingly tricky.\nThat is because in general, the form of a class method's non-default type\nsignature is:\n\n  forall a. C a => forall d. D d => E a b\n\nAnd the general form of a default type signature is:\n\n  forall f. F f => E a f -- The variable `a` comes from the class\n\nSo it you want to get the tau types in each type signature, you might find it\nreasonable to call tcSplitSigmaTy twice on the non-default type signature, and\ncall it once on the default type signature. For most classes and methods, this\nwill work, but Each is a bit of an exceptional case. The way `each` is written,\nit doesn't quantify any additional type variables besides those of the Each\nclass itself, so the non-default type signature for `each` is actually this:\n\n  forall s t a b. Each s t a b => Traversal s t a b\n\nNotice that there _appears_ to only be one forall. But there's actually another\nforall lurking in the Traversal type synonym, so if you call tcSplitSigmaTy\ntwice, you'll also go under the forall in Traversal! That is, you'll end up\nwith:\n\n  (a -> f b) -> s -> f t\n\nA problem arises because you only call tcSplitSigmaTy once on the default type\nsignature for `each`, which gives you\n\n  Traversal s t a b\n\nOr, equivalently:\n\n  forall f. Applicative f => (a -> f b) -> s -> f t\n\nThis is _not_ the same thing as (a -> f b) -> s -> f t! So now tcMatchTy will\nsay that the tau types for `each` are not equal.\n\nA solution to this problem is to use tcSplitNestedSigmaTys instead of\ntcSplitSigmaTy. tcSplitNestedSigmaTys will always split any foralls that it\nsees until it can't go any further, so if you called it on the default type\nsignature for `each`, it would return (a -> f b) -> s -> f t like we desired.\n\nNote [Checking partial record field]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThis check checks the partial record field selector, and warns (Trac #7169).\n\nFor example:\n\n  data T a = A { m1 :: a, m2 :: a } | B { m1 :: a }\n\nThe function 'm2' is partial record field, and will fail when it is applied to\n'B'. The warning identifies such partial fields. The check is performed at the\ndeclaration of T, not at the call-sites of m2.\n\nThe warning can be suppressed by prefixing the field-name with an underscore.\nFor example:\n\n  data T a = A { m1 :: a, _m2 :: a } | B { m1 :: a }\n\n************************************************************************\n*                                                                      *\n                Checking role validity\n*                                                                      *\n************************************************************************\n-}\n\ncheckValidRoleAnnots :: RoleAnnotEnv -> TyCon -> TcM ()\ncheckValidRoleAnnots role_annots tc\n  | isTypeSynonymTyCon tc = check_no_roles\n  | isFamilyTyCon tc      = check_no_roles\n  | isAlgTyCon tc         = check_roles\n  | otherwise             = return ()\n  where\n    -- Role annotations are given only on *explicit* variables,\n    -- but a tycon stores roles for all variables.\n    -- So, we drop the implicit roles (which are all Nominal, anyway).\n    name                   = tyConName tc\n    roles                  = tyConRoles tc\n    (vis_roles, vis_vars)  = unzip $ mapMaybe pick_vis $\n                             zip roles (tyConBinders tc)\n    role_annot_decl_maybe  = lookupRoleAnnot role_annots name\n\n    pick_vis :: (Role, TyConBinder) -> Maybe (Role, TyVar)\n    pick_vis (role, tvb)\n      | isVisibleTyConBinder tvb = Just (role, binderVar tvb)\n      | otherwise                = Nothing\n\n    check_roles\n      = whenIsJust role_annot_decl_maybe $\n          \\decl@(dL->L loc (RoleAnnotDecl _ _ the_role_annots)) ->\n          addRoleAnnotCtxt name $\n          setSrcSpan loc $ do\n          { role_annots_ok <- xoptM LangExt.RoleAnnotations\n          ; checkTc role_annots_ok $ needXRoleAnnotations tc\n          ; checkTc (vis_vars `equalLength` the_role_annots)\n                    (wrongNumberOfRoles vis_vars decl)\n          ; _ <- zipWith3M checkRoleAnnot vis_vars the_role_annots vis_roles\n          -- Representational or phantom roles for class parameters\n          -- quickly lead to incoherence. So, we require\n          -- IncoherentInstances to have them. See #8773, #14292\n          ; incoherent_roles_ok <- xoptM LangExt.IncoherentInstances\n          ; checkTc (  incoherent_roles_ok\n                    || (not $ isClassTyCon tc)\n                    || (all (== Nominal) vis_roles))\n                    incoherentRoles\n\n          ; lint <- goptM Opt_DoCoreLinting\n          ; when lint $ checkValidRoles tc }\n\n    check_no_roles\n      = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl\n\ncheckRoleAnnot :: TyVar -> Located (Maybe Role) -> Role -> TcM ()\ncheckRoleAnnot _  (dL->L _ Nothing)   _  = return ()\ncheckRoleAnnot tv (dL->L _ (Just r1)) r2\n  = when (r1 /= r2) $\n    addErrTc $ badRoleAnnot (tyVarName tv) r1 r2\ncheckRoleAnnot _ _ _ = panic \"checkRoleAnnot: Impossible Match\" -- due to #15884\n\n-- This is a double-check on the role inference algorithm. It is only run when\n-- -dcore-lint is enabled. See Note [Role inference] in TcTyDecls\ncheckValidRoles :: TyCon -> TcM ()\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in CoreLint\ncheckValidRoles tc\n  | isAlgTyCon tc\n    -- tyConDataCons returns an empty list for data families\n  = mapM_ check_dc_roles (tyConDataCons tc)\n  | Just rhs <- synTyConRhs_maybe tc\n  = check_ty_roles (zipVarEnv (tyConTyVars tc) (tyConRoles tc)) Representational rhs\n  | otherwise\n  = return ()\n  where\n    check_dc_roles datacon\n      = do { traceTc \"check_dc_roles\" (ppr datacon <+> ppr (tyConRoles tc))\n           ; mapM_ (check_ty_roles role_env Representational) $\n                    eqSpecPreds eq_spec ++ theta ++ arg_tys }\n                    -- See Note [Role-checking data constructor arguments] in TcTyDecls\n      where\n        (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty)\n          = dataConFullSig datacon\n        univ_roles = zipVarEnv univ_tvs (tyConRoles tc)\n              -- zipVarEnv uses zipEqual, but we don't want that for ex_tvs\n        ex_roles   = mkVarEnv (map (, Nominal) ex_tvs)\n        role_env   = univ_roles `plusVarEnv` ex_roles\n\n    check_ty_roles env role ty\n      | Just ty' <- coreView ty -- #14101\n      = check_ty_roles env role ty'\n\n    check_ty_roles env role (TyVarTy tv)\n      = case lookupVarEnv env tv of\n          Just role' -> unless (role' `ltRole` role || role' == role) $\n                        report_error $ text \"type variable\" <+> quotes (ppr tv) <+>\n                                       text \"cannot have role\" <+> ppr role <+>\n                                       text \"because it was assigned role\" <+> ppr role'\n          Nothing    -> report_error $ text \"type variable\" <+> quotes (ppr tv) <+>\n                                       text \"missing in environment\"\n\n    check_ty_roles env Representational (TyConApp tc tys)\n      = let roles' = tyConRoles tc in\n        zipWithM_ (maybe_check_ty_roles env) roles' tys\n\n    check_ty_roles env Nominal (TyConApp _ tys)\n      = mapM_ (check_ty_roles env Nominal) tys\n\n    check_ty_roles _   Phantom ty@(TyConApp {})\n      = pprPanic \"check_ty_roles\" (ppr ty)\n\n    check_ty_roles env role (AppTy ty1 ty2)\n      =  check_ty_roles env role    ty1\n      >> check_ty_roles env Nominal ty2\n\n    check_ty_roles env role (FunTy _ ty1 ty2)\n      =  check_ty_roles env role ty1\n      >> check_ty_roles env role ty2\n\n    check_ty_roles env role (ForAllTy (Bndr tv _) ty)\n      =  check_ty_roles env Nominal (tyVarKind tv)\n      >> check_ty_roles (extendVarEnv env tv Nominal) role ty\n\n    check_ty_roles _   _    (LitTy {}) = return ()\n\n    check_ty_roles env role (CastTy t _)\n      = check_ty_roles env role t\n\n    check_ty_roles _   role (CoercionTy co)\n      = unless (role == Phantom) $\n        report_error $ text \"coercion\" <+> ppr co <+> text \"has bad role\" <+> ppr role\n\n    maybe_check_ty_roles env role ty\n      = when (role == Nominal || role == Representational) $\n        check_ty_roles env role ty\n\n    report_error doc\n      = addErrTc $ vcat [text \"Internal error in role inference:\",\n                         doc,\n                         text \"Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\"]\n\n{-\n************************************************************************\n*                                                                      *\n                Error messages\n*                                                                      *\n************************************************************************\n-}\n\ntcAddTyFamInstCtxt :: TyFamInstDecl GhcRn -> TcM a -> TcM a\ntcAddTyFamInstCtxt decl\n  = tcAddFamInstCtxt (text \"type instance\") (tyFamInstDeclName decl)\n\ntcMkDataFamInstCtxt :: DataFamInstDecl GhcRn -> SDoc\ntcMkDataFamInstCtxt decl@(DataFamInstDecl { dfid_eqn =\n                            HsIB { hsib_body = eqn }})\n  = tcMkFamInstCtxt (pprDataFamInstFlavour decl <+> text \"instance\")\n                    (unLoc (feqn_tycon eqn))\ntcMkDataFamInstCtxt (DataFamInstDecl (XHsImplicitBndrs _))\n  = panic \"tcMkDataFamInstCtxt\"\n\ntcAddDataFamInstCtxt :: DataFamInstDecl GhcRn -> TcM a -> TcM a\ntcAddDataFamInstCtxt decl\n  = addErrCtxt (tcMkDataFamInstCtxt decl)\n\ntcMkFamInstCtxt :: SDoc -> Name -> SDoc\ntcMkFamInstCtxt flavour tycon\n  = hsep [ text \"In the\" <+> flavour <+> text \"declaration for\"\n         , quotes (ppr tycon) ]\n\ntcAddFamInstCtxt :: SDoc -> Name -> TcM a -> TcM a\ntcAddFamInstCtxt flavour tycon thing_inside\n  = addErrCtxt (tcMkFamInstCtxt flavour tycon) thing_inside\n\ntcAddClosedTypeFamilyDeclCtxt :: TyCon -> TcM a -> TcM a\ntcAddClosedTypeFamilyDeclCtxt tc\n  = addErrCtxt ctxt\n  where\n    ctxt = text \"In the equations for closed type family\" <+>\n           quotes (ppr tc)\n\nresultTypeMisMatch :: FieldLabelString -> DataCon -> DataCon -> SDoc\nresultTypeMisMatch field_name con1 con2\n  = vcat [sep [text \"Constructors\" <+> ppr con1 <+> text \"and\" <+> ppr con2,\n                text \"have a common field\" <+> quotes (ppr field_name) <> comma],\n          nest 2 $ text \"but have different result types\"]\n\nfieldTypeMisMatch :: FieldLabelString -> DataCon -> DataCon -> SDoc\nfieldTypeMisMatch field_name con1 con2\n  = sep [text \"Constructors\" <+> ppr con1 <+> text \"and\" <+> ppr con2,\n         text \"give different types for field\", quotes (ppr field_name)]\n\ndataConCtxtName :: [Located Name] -> SDoc\ndataConCtxtName [con]\n   = text \"In the definition of data constructor\" <+> quotes (ppr con)\ndataConCtxtName con\n   = text \"In the definition of data constructors\" <+> interpp'SP con\n\ndataConCtxt :: Outputable a => a -> SDoc\ndataConCtxt con = text \"In the definition of data constructor\" <+> quotes (ppr con)\n\nclassOpCtxt :: Var -> Type -> SDoc\nclassOpCtxt sel_id tau = sep [text \"When checking the class method:\",\n                              nest 2 (pprPrefixOcc sel_id <+> dcolon <+> ppr tau)]\n\nclassArityErr :: Int -> Class -> SDoc\nclassArityErr n cls\n    | n == 0 = mkErr \"No\" \"no-parameter\"\n    | otherwise = mkErr \"Too many\" \"multi-parameter\"\n  where\n    mkErr howMany allowWhat =\n        vcat [text (howMany ++ \" parameters for class\") <+> quotes (ppr cls),\n              parens (text (\"Enable MultiParamTypeClasses to allow \"\n                                    ++ allowWhat ++ \" classes\"))]\n\nclassFunDepsErr :: Class -> SDoc\nclassFunDepsErr cls\n  = vcat [text \"Fundeps in class\" <+> quotes (ppr cls),\n          parens (text \"Enable FunctionalDependencies to allow fundeps\")]\n\nbadMethPred :: Id -> TcPredType -> SDoc\nbadMethPred sel_id pred\n  = vcat [ hang (text \"Constraint\" <+> quotes (ppr pred)\n                 <+> text \"in the type of\" <+> quotes (ppr sel_id))\n              2 (text \"constrains only the class type variables\")\n         , text \"Enable ConstrainedClassMethods to allow it\" ]\n\nnoClassTyVarErr :: Class -> TyCon -> SDoc\nnoClassTyVarErr clas fam_tc\n  = sep [ text \"The associated type\" <+> quotes (ppr fam_tc)\n        , text \"mentions none of the type or kind variables of the class\" <+>\n                quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))]\n\nbadDataConTyCon :: DataCon -> Type -> Type -> SDoc\nbadDataConTyCon data_con res_ty_tmpl actual_res_ty\n  | ASSERT( all isTyVar actual_ex_tvs )\n    tcIsForAllTy actual_res_ty\n  = nested_foralls_contexts_suggestion\n  | isJust (tcSplitPredFunTy_maybe actual_res_ty)\n  = nested_foralls_contexts_suggestion\n  | otherwise\n  = hang (text \"Data constructor\" <+> quotes (ppr data_con) <+>\n                text \"returns type\" <+> quotes (ppr actual_res_ty))\n       2 (text \"instead of an instance of its parent type\" <+> quotes (ppr res_ty_tmpl))\n  where\n    -- This suggestion is useful for suggesting how to correct code like what\n    -- was reported in Trac #12087:\n    --\n    --   data F a where\n    --     MkF :: Ord a => Eq a => a -> F a\n    --\n    -- Although nested foralls or contexts are allowed in function type\n    -- signatures, it is much more difficult to engineer GADT constructor type\n    -- signatures to allow something similar, so we error in the latter case.\n    -- Nevertheless, we can at least suggest how a user might reshuffle their\n    -- exotic GADT constructor type signature so that GHC will accept.\n    nested_foralls_contexts_suggestion =\n      text \"GADT constructor type signature cannot contain nested\"\n      <+> quotes forAllLit <> text \"s or contexts\"\n      $+$ hang (text \"Suggestion: instead use this type signature:\")\n             2 (ppr (dataConName data_con) <+> dcolon <+> ppr suggested_ty)\n\n    -- To construct a type that GHC would accept (suggested_ty), we:\n    --\n    -- 1) Find the existentially quantified type variables and the class\n    --    predicates from the datacon. (NB: We don't need the universally\n    --    quantified type variables, since rejigConRes won't substitute them in\n    --    the result type if it fails, as in this scenario.)\n    -- 2) Split apart the return type (which is headed by a forall or a\n    --    context) using tcSplitNestedSigmaTys, collecting the type variables\n    --    and class predicates we find, as well as the rho type lurking\n    --    underneath the nested foralls and contexts.\n    -- 3) Smash together the type variables and class predicates from 1) and\n    --    2), and prepend them to the rho type from 2).\n    actual_ex_tvs = dataConExTyCoVars data_con\n    actual_theta  = dataConTheta data_con\n    (actual_res_tvs, actual_res_theta, actual_res_rho)\n      = tcSplitNestedSigmaTys actual_res_ty\n    suggested_ty = mkSpecForAllTys (actual_ex_tvs ++ actual_res_tvs) $\n                   mkPhiTy (actual_theta ++ actual_res_theta)\n                   actual_res_rho\n\nbadGadtDecl :: Name -> SDoc\nbadGadtDecl tc_name\n  = vcat [ text \"Illegal generalised algebraic data declaration for\" <+> quotes (ppr tc_name)\n         , nest 2 (parens $ text \"Enable the GADTs extension to allow this\") ]\n\nbadExistential :: DataCon -> SDoc\nbadExistential con\n  = hang (text \"Data constructor\" <+> quotes (ppr con) <+>\n                text \"has existential type variables, a context, or a specialised result type\")\n       2 (vcat [ ppr con <+> dcolon <+> ppr (dataConUserType con)\n               , parens $ text \"Enable ExistentialQuantification or GADTs to allow this\" ])\n\nbadStupidTheta :: Name -> SDoc\nbadStupidTheta tc_name\n  = text \"A data type declared in GADT style cannot have a context:\" <+> quotes (ppr tc_name)\n\nnewtypeConError :: Name -> Int -> SDoc\nnewtypeConError tycon n\n  = sep [text \"A newtype must have exactly one constructor,\",\n         nest 2 $ text \"but\" <+> quotes (ppr tycon) <+> text \"has\" <+> speakN n ]\n\nnewtypeStrictError :: DataCon -> SDoc\nnewtypeStrictError con\n  = sep [text \"A newtype constructor cannot have a strictness annotation,\",\n         nest 2 $ text \"but\" <+> quotes (ppr con) <+> text \"does\"]\n\nnewtypeFieldErr :: DataCon -> Int -> SDoc\nnewtypeFieldErr con_name n_flds\n  = sep [text \"The constructor of a newtype must have exactly one field\",\n         nest 2 $ text \"but\" <+> quotes (ppr con_name) <+> text \"has\" <+> speakN n_flds]\n\nbadSigTyDecl :: Name -> SDoc\nbadSigTyDecl tc_name\n  = vcat [ text \"Illegal kind signature\" <+>\n           quotes (ppr tc_name)\n         , nest 2 (parens $ text \"Use KindSignatures to allow kind signatures\") ]\n\nemptyConDeclsErr :: Name -> SDoc\nemptyConDeclsErr tycon\n  = sep [quotes (ppr tycon) <+> text \"has no constructors\",\n         nest 2 $ text \"(EmptyDataDecls permits this)\"]\n\nwrongKindOfFamily :: TyCon -> SDoc\nwrongKindOfFamily family\n  = text \"Wrong category of family instance; declaration was for a\"\n    <+> kindOfFamily\n  where\n    kindOfFamily | isTypeFamilyTyCon family = text \"type family\"\n                 | isDataFamilyTyCon family = text \"data family\"\n                 | otherwise = pprPanic \"wrongKindOfFamily\" (ppr family)\n\n-- | Produce an error for oversaturated type family equations with too many\n-- required arguments.\n-- See Note [Oversaturated type family equations] in TcValidity.\nwrongNumberOfParmsErr :: Arity -> SDoc\nwrongNumberOfParmsErr max_args\n  = text \"Number of parameters must match family declaration; expected\"\n    <+> ppr max_args\n\ndefaultAssocKindErr :: TyCon -> SDoc\ndefaultAssocKindErr fam_tc\n  = text \"Kind mis-match on LHS of default declaration for\"\n    <+> quotes (ppr fam_tc)\n\nbadRoleAnnot :: Name -> Role -> Role -> SDoc\nbadRoleAnnot var annot inferred\n  = hang (text \"Role mismatch on variable\" <+> ppr var <> colon)\n       2 (sep [ text \"Annotation says\", ppr annot\n              , text \"but role\", ppr inferred\n              , text \"is required\" ])\n\nwrongNumberOfRoles :: [a] -> LRoleAnnotDecl GhcRn -> SDoc\nwrongNumberOfRoles tyvars d@(dL->L _ (RoleAnnotDecl _ _ annots))\n  = hang (text \"Wrong number of roles listed in role annotation;\" $$\n          text \"Expected\" <+> (ppr $ length tyvars) <> comma <+>\n          text \"got\" <+> (ppr $ length annots) <> colon)\n       2 (ppr d)\nwrongNumberOfRoles _ (dL->L _ (XRoleAnnotDecl _)) = panic \"wrongNumberOfRoles\"\nwrongNumberOfRoles _ _ = panic \"wrongNumberOfRoles: Impossible Match\"\n                         -- due to #15884\n\n\nillegalRoleAnnotDecl :: LRoleAnnotDecl GhcRn -> TcM ()\nillegalRoleAnnotDecl (dL->L loc (RoleAnnotDecl _ tycon _))\n  = setErrCtxt [] $\n    setSrcSpan loc $\n    addErrTc (text \"Illegal role annotation for\" <+> ppr tycon <> char ';' $$\n              text \"they are allowed only for datatypes and classes.\")\nillegalRoleAnnotDecl (dL->L _ (XRoleAnnotDecl _)) = panic \"illegalRoleAnnotDecl\"\nillegalRoleAnnotDecl _ = panic \"illegalRoleAnnotDecl: Impossible Match\"\n                         -- due to #15884\n\nneedXRoleAnnotations :: TyCon -> SDoc\nneedXRoleAnnotations tc\n  = text \"Illegal role annotation for\" <+> ppr tc <> char ';' $$\n    text \"did you intend to use RoleAnnotations?\"\n\nincoherentRoles :: SDoc\nincoherentRoles = (text \"Roles other than\" <+> quotes (text \"nominal\") <+>\n                   text \"for class parameters can lead to incoherence.\") $$\n                  (text \"Use IncoherentInstances to allow this; bad role found\")\n\naddTyConCtxt :: TyCon -> TcM a -> TcM a\naddTyConCtxt tc = addTyConFlavCtxt name flav\n  where\n    name = getName tc\n    flav = tyConFlavour tc\n\naddRoleAnnotCtxt :: Name -> TcM a -> TcM a\naddRoleAnnotCtxt name\n  = addErrCtxt $\n    text \"while checking a role annotation for\" <+> quotes (ppr name)\n", "num_lines": 3909}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1999\n\n\nAnalysis functions over data types.  Specifically, detecting recursive types.\n\nThis stuff is only used for source-code decls; it's recorded in interface\nfiles for imported data types.\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule TcTyDecls(\n        RolesInfo,\n        inferRoles,\n        checkSynCycles,\n        checkClassCycles,\n\n        -- * Implicits\n        addTyConsToGblEnv, mkDefaultMethodType,\n\n        -- * Record selectors\n        tcRecSelBinds, mkRecSelBinds, mkOneRecordSelector\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcRnMonad\nimport TcEnv\nimport TcBinds( tcValBinds, addTypecheckedBinds )\nimport TyCoRep( Type(..), Coercion(..), MCoercion(..), UnivCoProvenance(..) )\nimport TcType\nimport TysWiredIn( unitTy )\nimport MkCore( rEC_SEL_ERROR_ID )\nimport HsSyn\nimport Class\nimport Type\nimport HscTypes\nimport TyCon\nimport ConLike\nimport DataCon\nimport Name\nimport NameEnv\nimport NameSet hiding (unitFV)\nimport RdrName ( mkVarUnqual )\nimport Id\nimport IdInfo\nimport VarEnv\nimport VarSet\nimport Coercion ( ltRole )\nimport BasicTypes\nimport SrcLoc\nimport Unique ( mkBuiltinUnique )\nimport Outputable\nimport Util\nimport Maybes\nimport Bag\nimport FastString\nimport FV\nimport Module\n\nimport Control.Monad\n\n{-\n************************************************************************\n*                                                                      *\n        Cycles in type synonym declarations\n*                                                                      *\n************************************************************************\n-}\n\nsynonymTyConsOfType :: Type -> [TyCon]\n-- Does not look through type synonyms at all\n-- Return a list of synonym tycons\n-- Keep this synchronized with 'expandTypeSynonyms'\nsynonymTyConsOfType ty\n  = nameEnvElts (go ty)\n  where\n     go :: Type -> NameEnv TyCon  -- The NameEnv does duplicate elim\n     go (TyConApp tc tys) = go_tc tc `plusNameEnv` go_s tys\n     go (LitTy _)         = emptyNameEnv\n     go (TyVarTy _)       = emptyNameEnv\n     go (AppTy a b)       = go a `plusNameEnv` go b\n     go (FunTy _ a b)     = go a `plusNameEnv` go b\n     go (ForAllTy _ ty)   = go ty\n     go (CastTy ty co)    = go ty `plusNameEnv` go_co co\n     go (CoercionTy co)   = go_co co\n\n     -- Note [TyCon cycles through coercions?!]\n     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n     -- Although, in principle, it's possible for a type synonym loop\n     -- could go through a coercion (since a coercion can refer to\n     -- a TyCon or Type), it doesn't seem possible to actually construct\n     -- a Haskell program which tickles this case.  Here is an example\n     -- program which causes a coercion:\n     --\n     --   type family Star where\n     --       Star = Type\n     --\n     --   data T :: Star -> Type\n     --   data S :: forall (a :: Type). T a -> Type\n     --\n     -- Here, the application 'T a' must first coerce a :: Type to a :: Star,\n     -- witnessed by the type family.  But if we now try to make Type refer\n     -- to a type synonym which in turn refers to Star, we'll run into\n     -- trouble: we're trying to define and use the type constructor\n     -- in the same recursive group.  Possibly this restriction will be\n     -- lifted in the future but for now, this code is \"just for completeness\n     -- sake\".\n     go_mco MRefl    = emptyNameEnv\n     go_mco (MCo co) = go_co co\n\n     go_co (Refl ty)              = go ty\n     go_co (GRefl _ ty mco)       = go ty `plusNameEnv` go_mco mco\n     go_co (TyConAppCo _ tc cs)   = go_tc tc `plusNameEnv` go_co_s cs\n     go_co (AppCo co co')         = go_co co `plusNameEnv` go_co co'\n     go_co (ForAllCo _ co co')    = go_co co `plusNameEnv` go_co co'\n     go_co (FunCo _ co co')       = go_co co `plusNameEnv` go_co co'\n     go_co (CoVarCo _)            = emptyNameEnv\n     go_co (HoleCo {})            = emptyNameEnv\n     go_co (AxiomInstCo _ _ cs)   = go_co_s cs\n     go_co (UnivCo p _ ty ty')    = go_prov p `plusNameEnv` go ty `plusNameEnv` go ty'\n     go_co (SymCo co)             = go_co co\n     go_co (TransCo co co')       = go_co co `plusNameEnv` go_co co'\n     go_co (NthCo _ _ co)         = go_co co\n     go_co (LRCo _ co)            = go_co co\n     go_co (InstCo co co')        = go_co co `plusNameEnv` go_co co'\n     go_co (KindCo co)            = go_co co\n     go_co (SubCo co)             = go_co co\n     go_co (AxiomRuleCo _ cs)     = go_co_s cs\n\n     go_prov UnsafeCoerceProv     = emptyNameEnv\n     go_prov (PhantomProv co)     = go_co co\n     go_prov (ProofIrrelProv co)  = go_co co\n     go_prov (PluginProv _)       = emptyNameEnv\n\n     go_tc tc | isTypeSynonymTyCon tc = unitNameEnv (tyConName tc) tc\n              | otherwise             = emptyNameEnv\n     go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys\n     go_co_s cos = foldr (plusNameEnv . go_co) emptyNameEnv cos\n\n-- | A monad for type synonym cycle checking, which keeps\n-- track of the TyCons which are known to be acyclic, or\n-- a failure message reporting that a cycle was found.\nnewtype SynCycleM a = SynCycleM {\n    runSynCycleM :: SynCycleState -> Either (SrcSpan, SDoc) (a, SynCycleState) }\n\ntype SynCycleState = NameSet\n\ninstance Functor SynCycleM where\n    fmap = liftM\n\ninstance Applicative SynCycleM where\n    pure x = SynCycleM $ \\state -> Right (x, state)\n    (<*>) = ap\n\ninstance Monad SynCycleM where\n    m >>= f = SynCycleM $ \\state ->\n        case runSynCycleM m state of\n            Right (x, state') ->\n                runSynCycleM (f x) state'\n            Left err -> Left err\n\nfailSynCycleM :: SrcSpan -> SDoc -> SynCycleM ()\nfailSynCycleM loc err = SynCycleM $ \\_ -> Left (loc, err)\n\n-- | Test if a 'Name' is acyclic, short-circuiting if we've\n-- seen it already.\ncheckNameIsAcyclic :: Name -> SynCycleM () -> SynCycleM ()\ncheckNameIsAcyclic n m = SynCycleM $ \\s ->\n    if n `elemNameSet` s\n        then Right ((), s) -- short circuit\n        else case runSynCycleM m s of\n                Right ((), s') -> Right ((), extendNameSet s' n)\n                Left err -> Left err\n\n-- | Checks if any of the passed in 'TyCon's have cycles.\n-- Takes the 'UnitId' of the home package (as we can avoid\n-- checking those TyCons: cycles never go through foreign packages) and\n-- the corresponding @LTyClDecl Name@ for each 'TyCon', so we\n-- can give better error messages.\ncheckSynCycles :: UnitId -> [TyCon] -> [LTyClDecl GhcRn] -> TcM ()\ncheckSynCycles this_uid tcs tyclds = do\n    case runSynCycleM (mapM_ (go emptyNameSet []) tcs) emptyNameSet of\n        Left (loc, err) -> setSrcSpan loc $ failWithTc err\n        Right _  -> return ()\n  where\n    -- Try our best to print the LTyClDecl for locally defined things\n    lcl_decls = mkNameEnv (zip (map tyConName tcs) tyclds)\n\n    -- Short circuit if we've already seen this Name and concluded\n    -- it was acyclic.\n    go :: NameSet -> [TyCon] -> TyCon -> SynCycleM ()\n    go so_far seen_tcs tc =\n        checkNameIsAcyclic (tyConName tc) $ go' so_far seen_tcs tc\n\n    -- Expand type synonyms, complaining if you find the same\n    -- type synonym a second time.\n    go' :: NameSet -> [TyCon] -> TyCon -> SynCycleM ()\n    go' so_far seen_tcs tc\n        | n `elemNameSet` so_far\n            = failSynCycleM (getSrcSpan (head seen_tcs)) $\n                  sep [ text \"Cycle in type synonym declarations:\"\n                      , nest 2 (vcat (map ppr_decl seen_tcs)) ]\n        -- Optimization: we don't allow cycles through external packages,\n        -- so once we find a non-local name we are guaranteed to not\n        -- have a cycle.\n        --\n        -- This won't hold once we get recursive packages with Backpack,\n        -- but for now it's fine.\n        | not (isHoleModule mod ||\n               moduleUnitId mod == this_uid ||\n               isInteractiveModule mod)\n            = return ()\n        | Just ty <- synTyConRhs_maybe tc =\n            go_ty (extendNameSet so_far (tyConName tc)) (tc:seen_tcs) ty\n        | otherwise = return ()\n      where\n        n = tyConName tc\n        mod = nameModule n\n        ppr_decl tc =\n          case lookupNameEnv lcl_decls n of\n            Just (dL->L loc decl) -> ppr loc <> colon <+> ppr decl\n            Nothing -> ppr (getSrcSpan n) <> colon <+> ppr n\n                       <+> text \"from external module\"\n         where\n          n = tyConName tc\n\n    go_ty :: NameSet -> [TyCon] -> Type -> SynCycleM ()\n    go_ty so_far seen_tcs ty =\n        mapM_ (go so_far seen_tcs) (synonymTyConsOfType ty)\n\n{- Note [Superclass cycle check]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe superclass cycle check for C decides if we can statically\nguarantee that expanding C's superclass cycles transitively is\nguaranteed to terminate.  This is a Haskell98 requirement,\nbut one that we lift with -XUndecidableSuperClasses.\n\nThe worry is that a superclass cycle could make the type checker loop.\nMore precisely, with a constraint (Given or Wanted)\n    C ty1 .. tyn\none approach is to instantiate all of C's superclasses, transitively.\nWe can only do so if that set is finite.\n\nThis potential loop occurs only through superclasses.  This, for\nexample, is fine\n  class C a where\n    op :: C b => a -> b -> b\neven though C's full definition uses C.\n\nMaking the check static also makes it conservative.  Eg\n  type family F a\n  class F a => C a\nHere an instance of (F a) might mention C:\n  type instance F [a] = C a\nand now we'd have a loop.\n\nThe static check works like this, starting with C\n  * Look at C's superclass predicates\n  * If any is a type-function application,\n    or is headed by a type variable, fail\n  * If any has C at the head, fail\n  * If any has a type class D at the head,\n    make the same test with D\n\nA tricky point is: what if there is a type variable at the head?\nConsider this:\n   class f (C f) => C f\n   class c       => Id c\nand now expand superclasses for constraint (C Id):\n     C Id\n --> Id (C Id)\n --> C Id\n --> ....\nEach step expands superclasses one layer, and clearly does not terminate.\n-}\n\ncheckClassCycles :: Class -> Maybe SDoc\n-- Nothing  <=> ok\n-- Just err <=> possible cycle error\ncheckClassCycles cls\n  = do { (definite_cycle, err) <- go (unitNameSet (getName cls))\n                                     cls (mkTyVarTys (classTyVars cls))\n       ; let herald | definite_cycle = text \"Superclass cycle for\"\n                    | otherwise      = text \"Potential superclass cycle for\"\n       ; return (vcat [ herald <+> quotes (ppr cls)\n                      , nest 2 err, hint]) }\n  where\n    hint = text \"Use UndecidableSuperClasses to accept this\"\n\n    -- Expand superclasses starting with (C a b), complaining\n    -- if you find the same class a second time, or a type function\n    -- or predicate headed by a type variable\n    --\n    -- NB: this code duplicates TcType.transSuperClasses, but\n    --     with more error message generation clobber\n    -- Make sure the two stay in sync.\n    go :: NameSet -> Class -> [Type] -> Maybe (Bool, SDoc)\n    go so_far cls tys = firstJusts $\n                        map (go_pred so_far) $\n                        immSuperClasses cls tys\n\n    go_pred :: NameSet -> PredType -> Maybe (Bool, SDoc)\n       -- Nothing <=> ok\n       -- Just (True, err)  <=> definite cycle\n       -- Just (False, err) <=> possible cycle\n    go_pred so_far pred  -- NB: tcSplitTyConApp looks through synonyms\n       | Just (tc, tys) <- tcSplitTyConApp_maybe pred\n       = go_tc so_far pred tc tys\n       | hasTyVarHead pred\n       = Just (False, hang (text \"one of whose superclass constraints is headed by a type variable:\")\n                         2 (quotes (ppr pred)))\n       | otherwise\n       = Nothing\n\n    go_tc :: NameSet -> PredType -> TyCon -> [Type] -> Maybe (Bool, SDoc)\n    go_tc so_far pred tc tys\n      | isFamilyTyCon tc\n      = Just (False, hang (text \"one of whose superclass constraints is headed by a type family:\")\n                        2 (quotes (ppr pred)))\n      | Just cls <- tyConClass_maybe tc\n      = go_cls so_far cls tys\n      | otherwise   -- Equality predicate, for example\n      = Nothing\n\n    go_cls :: NameSet -> Class -> [Type] -> Maybe (Bool, SDoc)\n    go_cls so_far cls tys\n       | cls_nm `elemNameSet` so_far\n       = Just (True, text \"one of whose superclasses is\" <+> quotes (ppr cls))\n       | isCTupleClass cls\n       = go so_far cls tys\n       | otherwise\n       = do { (b,err) <- go  (so_far `extendNameSet` cls_nm) cls tys\n          ; return (b, text \"one of whose superclasses is\" <+> quotes (ppr cls)\n                       $$ err) }\n       where\n         cls_nm = getName cls\n\n{-\n************************************************************************\n*                                                                      *\n        Role inference\n*                                                                      *\n************************************************************************\n\nNote [Role inference]\n~~~~~~~~~~~~~~~~~~~~~\nThe role inference algorithm datatype definitions to infer the roles on the\nparameters. Although these roles are stored in the tycons, we can perform this\nalgorithm on the built tycons, as long as we don't peek at an as-yet-unknown\nroles field! Ah, the magic of laziness.\n\nFirst, we choose appropriate initial roles. For families and classes, roles\n(including initial roles) are N. For datatypes, we start with the role in the\nrole annotation (if any), or otherwise use Phantom. This is done in\ninitialRoleEnv1.\n\nThe function irGroup then propagates role information until it reaches a\nfixpoint, preferring N over (R or P) and R over P. To aid in this, we have a\nmonad RoleM, which is a combination reader and state monad. In its state are\nthe current RoleEnv, which gets updated by role propagation, and an update\nbit, which we use to know whether or not we've reached the fixpoint. The\nenvironment of RoleM contains the tycon whose parameters we are inferring, and\na VarEnv from parameters to their positions, so we can update the RoleEnv.\nBetween tycons, this reader information is missing; it is added by\naddRoleInferenceInfo.\n\nThere are two kinds of tycons to consider: algebraic ones (excluding classes)\nand type synonyms. (Remember, families don't participate -- all their parameters\nare N.) An algebraic tycon processes each of its datacons, in turn. Note that\na datacon's universally quantified parameters might be different from the parent\ntycon's parameters, so we use the datacon's univ parameters in the mapping from\nvars to positions. Note also that we don't want to infer roles for existentials\n(they're all at N, too), so we put them in the set of local variables. As an\noptimisation, we skip any tycons whose roles are already all Nominal, as there\nnowhere else for them to go. For synonyms, we just analyse their right-hand sides.\n\nirType walks through a type, looking for uses of a variable of interest and\npropagating role information. Because anything used under a phantom position\nis at phantom and anything used under a nominal position is at nominal, the\nirType function can assume that anything it sees is at representational. (The\nother possibilities are pruned when they're encountered.)\n\nThe rest of the code is just plumbing.\n\nHow do we know that this algorithm is correct? It should meet the following\nspecification:\n\nLet Z be a role context -- a mapping from variables to roles. The following\nrules define the property (Z |- t : r), where t is a type and r is a role:\n\nZ(a) = r'        r' <= r\n------------------------- RCVar\nZ |- a : r\n\n---------- RCConst\nZ |- T : r               -- T is a type constructor\n\nZ |- t1 : r\nZ |- t2 : N\n-------------- RCApp\nZ |- t1 t2 : r\n\nforall i<=n. (r_i is R or N) implies Z |- t_i : r_i\nroles(T) = r_1 .. r_n\n---------------------------------------------------- RCDApp\nZ |- T t_1 .. t_n : R\n\nZ, a:N |- t : r\n---------------------- RCAll\nZ |- forall a:k.t : r\n\n\nWe also have the following rules:\n\nFor all datacon_i in type T, where a_1 .. a_n are universally quantified\nand b_1 .. b_m are existentially quantified, and the arguments are t_1 .. t_p,\nthen if forall j<=p, a_1 : r_1 .. a_n : r_n, b_1 : N .. b_m : N |- t_j : R,\nthen roles(T) = r_1 .. r_n\n\nroles(->) = R, R\nroles(~#) = N, N\n\nWith -dcore-lint on, the output of this algorithm is checked in checkValidRoles,\ncalled from checkValidTycon.\n\nNote [Role-checking data constructor arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  data T a where\n    MkT :: Eq b => F a -> (a->a) -> T (G a)\n\nThen we want to check the roles at which 'a' is used\nin MkT's type.  We want to work on the user-written type,\nso we need to take into account\n  * the arguments:   (F a) and (a->a)\n  * the context:     C a b\n  * the result type: (G a)   -- this is in the eq_spec\n\n\nNote [Coercions in role inference]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIs (t |> co1) representationally equal to (t |> co2)? Of course they are! Changing\nthe kind of a type is totally irrelevant to the representation of that type. So,\nwe want to totally ignore coercions when doing role inference. This includes omitting\nany type variables that appear in nominal positions but only within coercions.\n-}\n\ntype RolesInfo = Name -> [Role]\n\ntype RoleEnv = NameEnv [Role]        -- from tycon names to roles\n\n-- This, and any of the functions it calls, must *not* look at the roles\n-- field of a tycon we are inferring roles about!\n-- See Note [Role inference]\ninferRoles :: HscSource -> RoleAnnotEnv -> [TyCon] -> Name -> [Role]\ninferRoles hsc_src annots tycons\n  = let role_env  = initialRoleEnv hsc_src annots tycons\n        role_env' = irGroup role_env tycons in\n    \\name -> case lookupNameEnv role_env' name of\n      Just roles -> roles\n      Nothing    -> pprPanic \"inferRoles\" (ppr name)\n\ninitialRoleEnv :: HscSource -> RoleAnnotEnv -> [TyCon] -> RoleEnv\ninitialRoleEnv hsc_src annots = extendNameEnvList emptyNameEnv .\n                                map (initialRoleEnv1 hsc_src annots)\n\ninitialRoleEnv1 :: HscSource -> RoleAnnotEnv -> TyCon -> (Name, [Role])\ninitialRoleEnv1 hsc_src annots_env tc\n  | isFamilyTyCon tc      = (name, map (const Nominal) bndrs)\n  | isAlgTyCon tc         = (name, default_roles)\n  | isTypeSynonymTyCon tc = (name, default_roles)\n  | otherwise             = pprPanic \"initialRoleEnv1\" (ppr tc)\n  where name         = tyConName tc\n        bndrs        = tyConBinders tc\n        argflags     = map tyConBinderArgFlag bndrs\n        num_exps     = count isVisibleArgFlag argflags\n\n          -- if the number of annotations in the role annotation decl\n          -- is wrong, just ignore it. We check this in the validity check.\n        role_annots\n          = case lookupRoleAnnot annots_env name of\n              Just (dL->L _ (RoleAnnotDecl _ _ annots))\n                | annots `lengthIs` num_exps -> map unLoc annots\n              _                              -> replicate num_exps Nothing\n        default_roles = build_default_roles argflags role_annots\n\n        build_default_roles (argf : argfs) (m_annot : ras)\n          | isVisibleArgFlag argf\n          = (m_annot `orElse` default_role) : build_default_roles argfs ras\n        build_default_roles (_argf : argfs) ras\n          = Nominal : build_default_roles argfs ras\n        build_default_roles [] [] = []\n        build_default_roles _ _ = pprPanic \"initialRoleEnv1 (2)\"\n                                           (vcat [ppr tc, ppr role_annots])\n\n        default_role\n          | isClassTyCon tc               = Nominal\n          -- Note [Default roles for abstract TyCons in hs-boot/hsig]\n          | HsBootFile <- hsc_src\n          , isAbstractTyCon tc            = Representational\n          | HsigFile   <- hsc_src\n          , isAbstractTyCon tc            = Nominal\n          | otherwise                     = Phantom\n\n-- Note [Default roles for abstract TyCons in hs-boot/hsig]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- What should the default role for an abstract TyCon be?\n--\n-- Originally, we inferred phantom role for abstract TyCons\n-- in hs-boot files, because the type variables were never used.\n--\n-- This was silly, because the role of the abstract TyCon\n-- was required to match the implementation, and the roles of\n-- data types are almost never phantom.  Thus, in ticket #9204,\n-- the default was changed so be representational (the most common case).  If\n-- the implementing data type was actually nominal, you'd get an easy\n-- to understand error, and add the role annotation yourself.\n--\n-- Then Backpack was added, and with it we added role *subtyping*\n-- the matching judgment: if an abstract TyCon has a nominal\n-- parameter, it's OK to implement it with a representational\n-- parameter.  But now, the representational default is not a good\n-- one, because you should *only* request representational if\n-- you're planning to do coercions. To be maximally flexible\n-- with what data types you will accept, you want the default\n-- for hsig files is nominal.  We don't allow role subtyping\n-- with hs-boot files (it's good practice to give an exactly\n-- accurate role here, because any types that use the abstract\n-- type will propagate the role information.)\n\nirGroup :: RoleEnv -> [TyCon] -> RoleEnv\nirGroup env tcs\n  = let (env', update) = runRoleM env $ mapM_ irTyCon tcs in\n    if update\n    then irGroup env' tcs\n    else env'\n\nirTyCon :: TyCon -> RoleM ()\nirTyCon tc\n  | isAlgTyCon tc\n  = do { old_roles <- lookupRoles tc\n       ; unless (all (== Nominal) old_roles) $  -- also catches data families,\n                                                -- which don't want or need role inference\n         irTcTyVars tc $\n         do { mapM_ (irType emptyVarSet) (tyConStupidTheta tc)  -- See #8958\n            ; whenIsJust (tyConClass_maybe tc) irClass\n            ; mapM_ irDataCon (visibleDataCons $ algTyConRhs tc) }}\n\n  | Just ty <- synTyConRhs_maybe tc\n  = irTcTyVars tc $\n    irType emptyVarSet ty\n\n  | otherwise\n  = return ()\n\n-- any type variable used in an associated type must be Nominal\nirClass :: Class -> RoleM ()\nirClass cls\n  = mapM_ ir_at (classATs cls)\n  where\n    cls_tvs    = classTyVars cls\n    cls_tv_set = mkVarSet cls_tvs\n\n    ir_at at_tc\n      = mapM_ (updateRole Nominal) nvars\n      where nvars = filter (`elemVarSet` cls_tv_set) $ tyConTyVars at_tc\n\n-- See Note [Role inference]\nirDataCon :: DataCon -> RoleM ()\nirDataCon datacon\n  = setRoleInferenceVars univ_tvs $\n    irExTyVars ex_tvs $ \\ ex_var_set ->\n    mapM_ (irType ex_var_set)\n          (map tyVarKind ex_tvs ++ eqSpecPreds eq_spec ++ theta ++ arg_tys)\n      -- See Note [Role-checking data constructor arguments]\n  where\n    (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty)\n      = dataConFullSig datacon\n\nirType :: VarSet -> Type -> RoleM ()\nirType = go\n  where\n    go lcls ty                 | Just ty' <- coreView ty -- #14101\n                               = go lcls ty'\n    go lcls (TyVarTy tv)       = unless (tv `elemVarSet` lcls) $\n                                 updateRole Representational tv\n    go lcls (AppTy t1 t2)      = go lcls t1 >> markNominal lcls t2\n    go lcls (TyConApp tc tys)  = do { roles <- lookupRolesX tc\n                                    ; zipWithM_ (go_app lcls) roles tys }\n    go lcls (ForAllTy tvb ty)  = do { let tv = binderVar tvb\n                                          lcls' = extendVarSet lcls tv\n                                    ; markNominal lcls (tyVarKind tv)\n                                    ; go lcls' ty }\n    go lcls (FunTy _ arg res)  = go lcls arg >> go lcls res\n    go _    (LitTy {})         = return ()\n      -- See Note [Coercions in role inference]\n    go lcls (CastTy ty _)      = go lcls ty\n    go _    (CoercionTy _)     = return ()\n\n    go_app _ Phantom _ = return ()                 -- nothing to do here\n    go_app lcls Nominal ty = markNominal lcls ty  -- all vars below here are N\n    go_app lcls Representational ty = go lcls ty\n\nirTcTyVars :: TyCon -> RoleM a -> RoleM a\nirTcTyVars tc thing\n  = setRoleInferenceTc (tyConName tc) $ go (tyConTyVars tc)\n  where\n    go []       = thing\n    go (tv:tvs) = do { markNominal emptyVarSet (tyVarKind tv)\n                     ; addRoleInferenceVar tv $ go tvs }\n\nirExTyVars :: [TyVar] -> (TyVarSet -> RoleM a) -> RoleM a\nirExTyVars orig_tvs thing = go emptyVarSet orig_tvs\n  where\n    go lcls []       = thing lcls\n    go lcls (tv:tvs) = do { markNominal lcls (tyVarKind tv)\n                          ; go (extendVarSet lcls tv) tvs }\n\nmarkNominal :: TyVarSet   -- local variables\n            -> Type -> RoleM ()\nmarkNominal lcls ty = let nvars = fvVarList (FV.delFVs lcls $ get_ty_vars ty) in\n                      mapM_ (updateRole Nominal) nvars\n  where\n     -- get_ty_vars gets all the tyvars (no covars!) from a type *without*\n     -- recurring into coercions. Recall: coercions are totally ignored during\n     -- role inference. See [Coercions in role inference]\n    get_ty_vars :: Type -> FV\n    get_ty_vars (TyVarTy tv)      = unitFV tv\n    get_ty_vars (AppTy t1 t2)     = get_ty_vars t1 `unionFV` get_ty_vars t2\n    get_ty_vars (FunTy _ t1 t2)   = get_ty_vars t1 `unionFV` get_ty_vars t2\n    get_ty_vars (TyConApp _ tys)  = mapUnionFV get_ty_vars tys\n    get_ty_vars (ForAllTy tvb ty) = tyCoFVsBndr tvb (get_ty_vars ty)\n    get_ty_vars (LitTy {})        = emptyFV\n    get_ty_vars (CastTy ty _)     = get_ty_vars ty\n    get_ty_vars (CoercionTy _)    = emptyFV\n\n-- like lookupRoles, but with Nominal tags at the end for oversaturated TyConApps\nlookupRolesX :: TyCon -> RoleM [Role]\nlookupRolesX tc\n  = do { roles <- lookupRoles tc\n       ; return $ roles ++ repeat Nominal }\n\n-- gets the roles either from the environment or the tycon\nlookupRoles :: TyCon -> RoleM [Role]\nlookupRoles tc\n  = do { env <- getRoleEnv\n       ; case lookupNameEnv env (tyConName tc) of\n           Just roles -> return roles\n           Nothing    -> return $ tyConRoles tc }\n\n-- tries to update a role; won't ever update a role \"downwards\"\nupdateRole :: Role -> TyVar -> RoleM ()\nupdateRole role tv\n  = do { var_ns <- getVarNs\n       ; name <- getTyConName\n       ; case lookupVarEnv var_ns tv of\n           Nothing -> pprPanic \"updateRole\" (ppr name $$ ppr tv $$ ppr var_ns)\n           Just n  -> updateRoleEnv name n role }\n\n-- the state in the RoleM monad\ndata RoleInferenceState = RIS { role_env  :: RoleEnv\n                              , update    :: Bool }\n\n-- the environment in the RoleM monad\ntype VarPositions = VarEnv Int\n\n-- See [Role inference]\nnewtype RoleM a = RM { unRM :: Maybe Name -- of the tycon\n                            -> VarPositions\n                            -> Int          -- size of VarPositions\n                            -> RoleInferenceState\n                            -> (a, RoleInferenceState) }\n\ninstance Functor RoleM where\n    fmap = liftM\n\ninstance Applicative RoleM where\n    pure x = RM $ \\_ _ _ state -> (x, state)\n    (<*>) = ap\n\ninstance Monad RoleM where\n  a >>= f  = RM $ \\m_info vps nvps state ->\n                  let (a', state') = unRM a m_info vps nvps state in\n                  unRM (f a') m_info vps nvps state'\n\nrunRoleM :: RoleEnv -> RoleM () -> (RoleEnv, Bool)\nrunRoleM env thing = (env', update)\n  where RIS { role_env = env', update = update }\n          = snd $ unRM thing Nothing emptyVarEnv 0 state\n        state = RIS { role_env  = env\n                    , update    = False }\n\nsetRoleInferenceTc :: Name -> RoleM a -> RoleM a\nsetRoleInferenceTc name thing = RM $ \\m_name vps nvps state ->\n                                ASSERT( isNothing m_name )\n                                ASSERT( isEmptyVarEnv vps )\n                                ASSERT( nvps == 0 )\n                                unRM thing (Just name) vps nvps state\n\naddRoleInferenceVar :: TyVar -> RoleM a -> RoleM a\naddRoleInferenceVar tv thing\n  = RM $ \\m_name vps nvps state ->\n    ASSERT( isJust m_name )\n    unRM thing m_name (extendVarEnv vps tv nvps) (nvps+1) state\n\nsetRoleInferenceVars :: [TyVar] -> RoleM a -> RoleM a\nsetRoleInferenceVars tvs thing\n  = RM $ \\m_name _vps _nvps state ->\n    ASSERT( isJust m_name )\n    unRM thing m_name (mkVarEnv (zip tvs [0..])) (panic \"setRoleInferenceVars\")\n         state\n\ngetRoleEnv :: RoleM RoleEnv\ngetRoleEnv = RM $ \\_ _ _ state@(RIS { role_env = env }) -> (env, state)\n\ngetVarNs :: RoleM VarPositions\ngetVarNs = RM $ \\_ vps _ state -> (vps, state)\n\ngetTyConName :: RoleM Name\ngetTyConName = RM $ \\m_name _ _ state ->\n                    case m_name of\n                      Nothing   -> panic \"getTyConName\"\n                      Just name -> (name, state)\n\nupdateRoleEnv :: Name -> Int -> Role -> RoleM ()\nupdateRoleEnv name n role\n  = RM $ \\_ _ _ state@(RIS { role_env = role_env }) -> ((),\n         case lookupNameEnv role_env name of\n           Nothing -> pprPanic \"updateRoleEnv\" (ppr name)\n           Just roles -> let (before, old_role : after) = splitAt n roles in\n                         if role `ltRole` old_role\n                         then let roles' = before ++ role : after\n                                  role_env' = extendNameEnv role_env name roles' in\n                              RIS { role_env = role_env', update = True }\n                         else state )\n\n\n{- *********************************************************************\n*                                                                      *\n                Building implicits\n*                                                                      *\n********************************************************************* -}\n\naddTyConsToGblEnv :: [TyCon] -> TcM TcGblEnv\n-- Given a [TyCon], add to the TcGblEnv\n--   * extend the TypeEnv with the tycons\n--   * extend the TypeEnv with their implicitTyThings\n--   * extend the TypeEnv with any default method Ids\n--   * add bindings for record selectors\naddTyConsToGblEnv tyclss\n  = tcExtendTyConEnv tyclss                    $\n    tcExtendGlobalEnvImplicit implicit_things  $\n    tcExtendGlobalValEnv def_meth_ids          $\n    do { traceTc \"tcAddTyCons\" $ vcat\n            [ text \"tycons\" <+> ppr tyclss\n            , text \"implicits\" <+> ppr implicit_things ]\n       ; gbl_env <- tcRecSelBinds (mkRecSelBinds tyclss)\n       ; return gbl_env }\n where\n   implicit_things = concatMap implicitTyConThings tyclss\n   def_meth_ids    = mkDefaultMethodIds tyclss\n\nmkDefaultMethodIds :: [TyCon] -> [Id]\n-- We want to put the default-method Ids (both vanilla and generic)\n-- into the type environment so that they are found when we typecheck\n-- the filled-in default methods of each instance declaration\n-- See Note [Default method Ids and Template Haskell]\nmkDefaultMethodIds tycons\n  = [ mkExportedVanillaId dm_name (mkDefaultMethodType cls sel_id dm_spec)\n    | tc <- tycons\n    , Just cls <- [tyConClass_maybe tc]\n    , (sel_id, Just (dm_name, dm_spec)) <- classOpItems cls ]\n\nmkDefaultMethodType :: Class -> Id -> DefMethSpec Type -> Type\n-- Returns the top-level type of the default method\nmkDefaultMethodType _ sel_id VanillaDM        = idType sel_id\nmkDefaultMethodType cls _   (GenericDM dm_ty) = mkSigmaTy tv_bndrs [pred] dm_ty\n   where\n     pred      = mkClassPred cls (mkTyVarTys (binderVars cls_bndrs))\n     cls_bndrs = tyConBinders (classTyCon cls)\n     tv_bndrs  = tyConTyVarBinders cls_bndrs\n     -- NB: the Class doesn't have TyConBinders; we reach into its\n     --     TyCon to get those.  We /do/ need the TyConBinders because\n     --     we need the correct visibility: these default methods are\n     --     used in code generated by the fill-in for missing\n     --     methods in instances (TcInstDcls.mkDefMethBind), and\n     --     then typechecked.  So we need the right visibilty info\n     --     (Trac #13998)\n\n{-\n************************************************************************\n*                                                                      *\n                Building record selectors\n*                                                                      *\n************************************************************************\n-}\n\n{-\nNote [Default method Ids and Template Haskell]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this (Trac #4169):\n   class Numeric a where\n     fromIntegerNum :: a\n     fromIntegerNum = ...\n\n   ast :: Q [Dec]\n   ast = [d| instance Numeric Int |]\n\nWhen we typecheck 'ast' we have done the first pass over the class decl\n(in tcTyClDecls), but we have not yet typechecked the default-method\ndeclarations (because they can mention value declarations).  So we\nmust bring the default method Ids into scope first (so they can be seen\nwhen typechecking the [d| .. |] quote, and typecheck them later.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                Building record selectors\n*                                                                      *\n************************************************************************\n-}\n\ntcRecSelBinds :: [(Id, LHsBind GhcRn)] -> TcM TcGblEnv\ntcRecSelBinds sel_bind_prs\n  = tcExtendGlobalValEnv [sel_id | (dL->L _ (IdSig _ sel_id)) <- sigs] $\n    do { (rec_sel_binds, tcg_env) <- discardWarnings $\n                                     tcValBinds TopLevel binds sigs getGblEnv\n       ; return (tcg_env `addTypecheckedBinds` map snd rec_sel_binds) }\n  where\n    sigs = [ cL loc (IdSig noExt sel_id)   | (sel_id, _) <- sel_bind_prs\n                                          , let loc = getSrcSpan sel_id ]\n    binds = [(NonRecursive, unitBag bind) | (_, bind) <- sel_bind_prs]\n\nmkRecSelBinds :: [TyCon] -> [(Id, LHsBind GhcRn)]\n-- NB We produce *un-typechecked* bindings, rather like 'deriving'\n--    This makes life easier, because the later type checking will add\n--    all necessary type abstractions and applications\nmkRecSelBinds tycons\n  = map mkRecSelBind [ (tc,fld) | tc <- tycons\n                                , fld <- tyConFieldLabels tc ]\n\nmkRecSelBind :: (TyCon, FieldLabel) -> (Id, LHsBind GhcRn)\nmkRecSelBind (tycon, fl)\n  = mkOneRecordSelector all_cons (RecSelData tycon) fl\n  where\n    all_cons = map RealDataCon (tyConDataCons tycon)\n\nmkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel\n                    -> (Id, LHsBind GhcRn)\nmkOneRecordSelector all_cons idDetails fl\n  = (sel_id, cL loc sel_bind)\n  where\n    loc      = getSrcSpan sel_name\n    lbl      = flLabel fl\n    sel_name = flSelector fl\n\n    sel_id = mkExportedLocalId rec_details sel_name sel_ty\n    rec_details = RecSelId { sel_tycon = idDetails, sel_naughty = is_naughty }\n\n    -- Find a representative constructor, con1\n    cons_w_field = conLikesWithFields all_cons [lbl]\n    con1 = ASSERT( not (null cons_w_field) ) head cons_w_field\n\n    -- Selector type; Note [Polymorphic selectors]\n    field_ty   = conLikeFieldType con1 lbl\n    data_tvs   = tyCoVarsOfTypesWellScoped inst_tys\n    data_tv_set= mkVarSet data_tvs\n    is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set)\n    (field_tvs, field_theta, field_tau) = tcSplitSigmaTy field_ty\n    sel_ty | is_naughty = unitTy  -- See Note [Naughty record selectors]\n           | otherwise  = mkSpecForAllTys data_tvs          $\n                          mkPhiTy (conLikeStupidTheta con1) $   -- Urgh!\n                          mkVisFunTy data_ty                $\n                          mkSpecForAllTys field_tvs         $\n                          mkPhiTy field_theta               $\n                          -- req_theta is empty for normal DataCon\n                          mkPhiTy req_theta                 $\n                          field_tau\n\n    -- Make the binding: sel (C2 { fld = x }) = x\n    --                   sel (C7 { fld = x }) = x\n    --    where cons_w_field = [C2,C7]\n    sel_bind = mkTopFunBind Generated sel_lname alts\n      where\n        alts | is_naughty = [mkSimpleMatch (mkPrefixFunRhs sel_lname)\n                                           [] unit_rhs]\n             | otherwise =  map mk_match cons_w_field ++ deflt\n    mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname)\n                                 [cL loc (mk_sel_pat con)]\n                                 (cL loc (HsVar noExt (cL loc field_var)))\n    mk_sel_pat con = ConPatIn (cL loc (getName con)) (RecCon rec_fields)\n    rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }\n    rec_field  = noLoc (HsRecField\n                        { hsRecFieldLbl\n                           = cL loc (FieldOcc sel_name\n                                     (cL loc $ mkVarUnqual lbl))\n                        , hsRecFieldArg\n                           = cL loc (VarPat noExt (cL loc field_var))\n                        , hsRecPun = False })\n    sel_lname = cL loc sel_name\n    field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc\n\n    -- Add catch-all default case unless the case is exhaustive\n    -- We do this explicitly so that we get a nice error message that\n    -- mentions this particular record selector\n    deflt | all dealt_with all_cons = []\n          | otherwise = [mkSimpleMatch CaseAlt\n                            [cL loc (WildPat noExt)]\n                            (mkHsApp (cL loc (HsVar noExt\n                                         (cL loc (getName rEC_SEL_ERROR_ID))))\n                                     (cL loc (HsLit noExt msg_lit)))]\n\n        -- Do not add a default case unless there are unmatched\n        -- constructors.  We must take account of GADTs, else we\n        -- get overlap warning messages from the pattern-match checker\n        -- NB: we need to pass type args for the *representation* TyCon\n        --     to dataConCannotMatch, hence the calculation of inst_tys\n        --     This matters in data families\n        --              data instance T Int a where\n        --                 A :: { fld :: Int } -> T Int Bool\n        --                 B :: { fld :: Int } -> T Int Char\n    dealt_with :: ConLike -> Bool\n    dealt_with (PatSynCon _) = False -- We can't predict overlap\n    dealt_with con@(RealDataCon dc) =\n      con `elem` cons_w_field || dataConCannotMatch inst_tys dc\n\n    (univ_tvs, _, eq_spec, _, req_theta, _, data_ty) = conLikeFullSig con1\n\n    eq_subst = mkTvSubstPrs (map eqSpecPair eq_spec)\n    inst_tys = substTyVars eq_subst univ_tvs\n\n    unit_rhs = mkLHsTupleExpr []\n    msg_lit = HsStringPrim NoSourceText (bytesFS lbl)\n\n{-\nNote [Polymorphic selectors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe take care to build the type of a polymorphic selector in the right\norder, so that visible type application works.\n\n  data Ord a => T a = MkT { field :: forall b. (Num a, Show b) => (a, b) }\n\nWe want\n\n  field :: forall a. Ord a => T a -> forall b. (Num a, Show b) => (a, b)\n\nNote [Naughty record selectors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA \"naughty\" field is one for which we can't define a record\nselector, because an existential type variable would escape.  For example:\n        data T = forall a. MkT { x,y::a }\nWe obviously can't define\n        x (MkT v _) = v\nNevertheless we *do* put a RecSelId into the type environment\nso that if the user tries to use 'x' as a selector we can bleat\nhelpfully, rather than saying unhelpfully that 'x' is not in scope.\nHence the sel_naughty flag, to identify record selectors that don't really exist.\n\nIn general, a field is \"naughty\" if its type mentions a type variable that\nisn't in the result type of the constructor.  Note that this *allows*\nGADT record selectors (Note [GADT record selectors]) whose types may look\nlike     sel :: T [a] -> a\n\nFor naughty selectors we make a dummy binding\n   sel = ()\nso that the later type-check will add them to the environment, and they'll be\nexported.  The function is never called, because the typechecker spots the\nsel_naughty field.\n\nNote [GADT record selectors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor GADTs, we require that all constructors with a common field 'f' have the same\nresult type (modulo alpha conversion).  [Checked in TcTyClsDecls.checkValidTyCon]\nE.g.\n        data T where\n          T1 { f :: Maybe a } :: T [a]\n          T2 { f :: Maybe a, y :: b  } :: T [a]\n          T3 :: T Int\n\nand now the selector takes that result type as its argument:\n   f :: forall a. T [a] -> Maybe a\n\nDetails: the \"real\" types of T1,T2 are:\n   T1 :: forall r a.   (r~[a]) => a -> T r\n   T2 :: forall r a b. (r~[a]) => a -> b -> T r\n\nSo the selector loooks like this:\n   f :: forall a. T [a] -> Maybe a\n   f (a:*) (t:T [a])\n     = case t of\n         T1 c   (g:[a]~[c]) (v:Maybe c)       -> v `cast` Maybe (right (sym g))\n         T2 c d (g:[a]~[c]) (v:Maybe c) (w:d) -> v `cast` Maybe (right (sym g))\n         T3 -> error \"T3 does not have field f\"\n\nNote the forall'd tyvars of the selector are just the free tyvars\nof the result type; there may be other tyvars in the constructor's\ntype (e.g. 'b' in T2).\n\nNote the need for casts in the result!\n\nNote [Selector running example]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's OK to combine GADTs and type families.  Here's a running example:\n\n        data instance T [a] where\n          T1 { fld :: b } :: T [Maybe b]\n\nThe representation type looks like this\n        data :R7T a where\n          T1 { fld :: b } :: :R7T (Maybe b)\n\nand there's coercion from the family type to the representation type\n        :CoR7T a :: T [a] ~ :R7T a\n\nThe selector we want for fld looks like this:\n\n        fld :: forall b. T [Maybe b] -> b\n        fld = /\\b. \\(d::T [Maybe b]).\n              case d `cast` :CoR7T (Maybe b) of\n                T1 (x::b) -> x\n\nThe scrutinee of the case has type :R7T (Maybe b), which can be\ngotten by appying the eq_spec to the univ_tvs of the data con.\n\n-}\n", "num_lines": 1034}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[TcType]{Types used in the typechecker}\n\nThis module provides the Type interface for front-end parts of the\ncompiler.  These parts\n\n        * treat \"source types\" as opaque:\n                newtypes, and predicates are meaningful.\n        * look through usage types\n\nThe \"tc\" prefix is for \"TypeChecker\", because the type checker\nis the principal client.\n-}\n\n{-# LANGUAGE CPP, ScopedTypeVariables, MultiWayIf, FlexibleContexts #-}\n\nmodule TcType (\n  --------------------------------\n  -- Types\n  TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,\n  TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,\n  TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcTyCon,\n  KnotTied,\n\n  ExpType(..), InferResult(..), ExpSigmaType, ExpRhoType, mkCheckExpType,\n\n  SyntaxOpType(..), synKnownType, mkSynFunTys,\n\n  -- TcLevel\n  TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel,\n  strictlyDeeperThan, sameDepthAs,\n  tcTypeLevel, tcTyVarLevel, maxTcLevel,\n  promoteSkolem, promoteSkolemX, promoteSkolemsX,\n  --------------------------------\n  -- MetaDetails\n  UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,\n  TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,\n  MetaDetails(Flexi, Indirect), MetaInfo(..),\n  isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy, isTyVarTy,\n  tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar,  isTyConableTyVar,\n  isFskTyVar, isFmvTyVar, isFlattenTyVar,\n  isAmbiguousTyVar, metaTyVarRef, metaTyVarInfo,\n  isFlexi, isIndirect, isRuntimeUnkSkol,\n  metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe,\n  isTouchableMetaTyVar,\n  isFloatedTouchableMetaTyVar,\n  findDupTyVarTvs, mkTyVarNamePairs,\n\n  --------------------------------\n  -- Builders\n  mkPhiTy, mkInfSigmaTy, mkSpecSigmaTy, mkSigmaTy,\n  mkTcAppTy, mkTcAppTys, mkTcCastTy,\n\n  --------------------------------\n  -- Splitters\n  -- These are important because they do not look through newtypes\n  getTyVar,\n  tcSplitForAllTy_maybe,\n  tcSplitForAllTys, tcSplitForAllTysSameVis,\n  tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllVarBndrs,\n  tcSplitPhiTy, tcSplitPredFunTy_maybe,\n  tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcFunResultTyN,\n  tcSplitFunTysN,\n  tcSplitTyConApp, tcSplitTyConApp_maybe,\n  tcTyConAppTyCon, tcTyConAppTyCon_maybe, tcTyConAppArgs,\n  tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcRepSplitAppTy_maybe,\n  tcRepGetNumAppTys,\n  tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar, nextRole,\n  tcSplitSigmaTy, tcSplitNestedSigmaTys, tcDeepSplitSigmaTy_maybe,\n\n  ---------------------------------\n  -- Predicates.\n  -- Again, newtypes are opaque\n  eqType, eqTypes, nonDetCmpType, nonDetCmpTypes, eqTypeX,\n  pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, tcEqTypeVis,\n  isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy,\n  isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,\n  isIntegerTy, isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred,\n  hasIPPred, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,\n  isPredTy, isTyVarClassPred, isTyVarHead, isInsolubleOccursCheck,\n  checkValidClsArgs, hasTyVarHead,\n  isRigidTy,\n\n  ---------------------------------\n  -- Misc type manipulators\n\n  deNoteType,\n  orphNamesOfType, orphNamesOfCo,\n  orphNamesOfTypes, orphNamesOfCoCon,\n  getDFunTyKey, evVarPred,\n\n  ---------------------------------\n  -- Predicate types\n  mkMinimalBySCs, transSuperClasses,\n  pickQuantifiablePreds, pickCapturedPreds,\n  immSuperClasses, boxEqPred,\n  isImprovementPred,\n\n  -- * Finding type instances\n  tcTyFamInsts, tcTyFamInstsAndVis, tcTyConAppTyFamInstsAndVis, isTyFamFree,\n\n  -- * Finding \"exact\" (non-dead) type variables\n  exactTyCoVarsOfType, exactTyCoVarsOfTypes,\n  anyRewritableTyVar,\n\n  ---------------------------------\n  -- Foreign import and export\n  isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool\n  isFFIImportResultTy, -- :: DynFlags -> Type -> Bool\n  isFFIExportResultTy, -- :: Type -> Bool\n  isFFIExternalTy,     -- :: Type -> Bool\n  isFFIDynTy,          -- :: Type -> Type -> Bool\n  isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool\n  isFFIPrimResultTy,   -- :: DynFlags -> Type -> Bool\n  isFFILabelTy,        -- :: Type -> Bool\n  isFFITy,             -- :: Type -> Bool\n  isFunPtrTy,          -- :: Type -> Bool\n  tcSplitIOType_maybe, -- :: Type -> Maybe Type\n\n  --------------------------------\n  -- Rexported from Kind\n  Kind, tcTypeKind,\n  liftedTypeKind,\n  constraintKind,\n  isLiftedTypeKind, isUnliftedTypeKind, classifiesTypeWithValues,\n\n  --------------------------------\n  -- Rexported from Type\n  Type, PredType, ThetaType, TyCoBinder,\n  ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),\n\n  mkForAllTy, mkForAllTys, mkTyCoInvForAllTys, mkSpecForAllTys, mkTyCoInvForAllTy,\n  mkInvForAllTy, mkInvForAllTys,\n  mkVisFunTy, mkVisFunTys, mkInvisFunTy, mkInvisFunTys,\n  mkTyConApp, mkAppTy, mkAppTys,\n  mkTyConTy, mkTyVarTy, mkTyVarTys,\n  mkTyCoVarTy, mkTyCoVarTys,\n\n  isClassPred, isEqPrimPred, isIPPred, isEqPred, isEqPredClass,\n  mkClassPred,\n  isDictLikeTy,\n  tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy,\n  isRuntimeRepVar, isKindLevPoly,\n  isVisibleBinder, isInvisibleBinder,\n\n  -- Type substitutions\n  TCvSubst(..),         -- Representation visible to a few friends\n  TvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,\n  zipTvSubst,\n  mkTvSubstPrs, notElemTCvSubst, unionTCvSubst,\n  getTvSubstEnv, setTvSubstEnv, getTCvInScope, extendTCvInScope,\n  extendTCvInScopeList, extendTCvInScopeSet, extendTvSubstAndInScope,\n  Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr,\n  Type.extendTvSubst,\n  isInScope, mkTCvSubst, mkTvSubst, zipTyEnv, zipCoEnv,\n  Type.substTy, substTys, substTyWith, substTyWithCoVars,\n  substTyAddInScope,\n  substTyUnchecked, substTysUnchecked, substThetaUnchecked,\n  substTyWithUnchecked,\n  substCoUnchecked, substCoWithUnchecked,\n  substTheta,\n\n  isUnliftedType,       -- Source types are always lifted\n  isUnboxedTupleType,   -- Ditto\n  isPrimitiveType,\n\n  tcView, coreView,\n\n  tyCoVarsOfType, tyCoVarsOfTypes, closeOverKinds,\n  tyCoFVsOfType, tyCoFVsOfTypes,\n  tyCoVarsOfTypeDSet, tyCoVarsOfTypesDSet, closeOverKindsDSet,\n  tyCoVarsOfTypeList, tyCoVarsOfTypesList,\n  noFreeVarsOfType,\n\n  --------------------------------\n  pprKind, pprParendKind, pprSigmaType,\n  pprType, pprParendType, pprTypeApp, pprTyThingCategory, tyThingCategory,\n  pprTheta, pprParendTheta, pprThetaArrowTy, pprClassPred,\n  pprTCvBndr, pprTCvBndrs,\n\n  TypeSize, sizeType, sizeTypes, scopedSort,\n\n  ---------------------------------\n  -- argument visibility\n  tcTyConVisibilities, isNextTyConArgVisible, isNextArgVisible\n\n  ) where\n\n#include \"HsVersions.h\"\n\n-- friends:\nimport GhcPrelude\n\nimport Kind\nimport TyCoRep\nimport Class\nimport Var\nimport ForeignCall\nimport VarSet\nimport Coercion\nimport Type\nimport RepType\nimport TyCon\n\n-- others:\nimport DynFlags\nimport CoreFVs\nimport Name -- hiding (varName)\n            -- We use this to make dictionaries for type literals.\n            -- Perhaps there's a better way to do this?\nimport NameSet\nimport VarEnv\nimport PrelNames\nimport TysWiredIn( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey\n                 , listTyCon, constraintKind )\nimport BasicTypes\nimport Util\nimport Maybes\nimport ListSetOps ( getNth, findDupsEq )\nimport Outputable\nimport FastString\nimport ErrUtils( Validity(..), MsgDoc, isValid )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Data.List  ( mapAccumL )\n-- import Data.Functor.Identity( Identity(..) )\nimport Data.IORef\nimport Data.List.NonEmpty( NonEmpty(..) )\n\n{-\n************************************************************************\n*                                                                      *\n              Types\n*                                                                      *\n************************************************************************\n\nThe type checker divides the generic Type world into the\nfollowing more structured beasts:\n\nsigma ::= forall tyvars. phi\n        -- A sigma type is a qualified type\n        --\n        -- Note that even if 'tyvars' is empty, theta\n        -- may not be: e.g.   (?x::Int) => Int\n\n        -- Note that 'sigma' is in prenex form:\n        -- all the foralls are at the front.\n        -- A 'phi' type has no foralls to the right of\n        -- an arrow\n\nphi :: theta => rho\n\nrho ::= sigma -> rho\n     |  tau\n\n-- A 'tau' type has no quantification anywhere\n-- Note that the args of a type constructor must be taus\ntau ::= tyvar\n     |  tycon tau_1 .. tau_n\n     |  tau_1 tau_2\n     |  tau_1 -> tau_2\n\n-- In all cases, a (saturated) type synonym application is legal,\n-- provided it expands to the required form.\n\nNote [TcTyVars and TyVars in the typechecker]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe typechecker uses a lot of type variables with special properties,\nnotably being a unification variable with a mutable reference.  These\nuse the 'TcTyVar' variant of Var.Var.\n\nNote, though, that a /bound/ type variable can (and probably should)\nbe a TyVar.  E.g\n    forall a. a -> a\nHere 'a' is really just a deBruijn-number; it certainly does not have\na signficant TcLevel (as every TcTyVar does).  So a forall-bound type\nvariable should be TyVars; and hence a TyVar can appear free in a TcType.\n\nThe type checker and constraint solver can also encounter /free/ type\nvariables that use the 'TyVar' variant of Var.Var, for a couple of\nreasons:\n\n  - When typechecking a class decl, say\n       class C (a :: k) where\n          foo :: T a -> Int\n    We have first kind-check the header; fix k and (a:k) to be\n    TyVars, bring 'k' and 'a' into scope, and kind check the\n    signature for 'foo'.  In doing so we call solveEqualities to\n    solve any kind equalities in foo's signature.  So the solver\n    may see free occurrences of 'k'.\n\n    See calls to tcExtendTyVarEnv for other places that ordinary\n    TyVars are bought into scope, and hence may show up in the types\n    and kinds generated by TcHsType.\n\n  - The pattern-match overlap checker calls the constraint solver,\n    long afer TcTyVars have been zonked away\n\nIt's convenient to simply treat these TyVars as skolem constants,\nwhich of course they are.  We give them a level number of \"outermost\",\nso they behave as global constants.  Specifically:\n\n* Var.tcTyVarDetails succeeds on a TyVar, returning\n  vanillaSkolemTv, as well as on a TcTyVar.\n\n* tcIsTcTyVar returns True for both TyVar and TcTyVar variants\n  of Var.Var.  The \"tc\" prefix means \"a type variable that can be\n  encountered by the typechecker\".\n\nThis is a bit of a change from an earlier era when we remoselessly\ninsisted on real TcTyVars in the type checker.  But that seems\nunnecessary (for skolems, TyVars are fine) and it's now very hard\nto guarantee, with the advent of kind equalities.\n\nNote [Coercion variables in free variable lists]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are several places in the GHC codebase where functions like\ntyCoVarsOfType, tyCoVarsOfCt, et al. are used to compute the free type\nvariables of a type. The \"Co\" part of these functions' names shouldn't be\ndismissed, as it is entirely possible that they will include coercion variables\nin addition to type variables! As a result, there are some places in TcType\nwhere we must take care to check that a variable is a _type_ variable (using\nisTyVar) before calling tcTyVarDetails--a partial function that is not defined\nfor coercion variables--on the variable. Failing to do so led to\nGHC Trac #12785.\n-}\n\n-- See Note [TcTyVars and TyVars in the typechecker]\ntype TcCoVar = CoVar    -- Used only during type inference\ntype TcType = Type      -- A TcType can have mutable type variables\ntype TcTyCoVar = Var    -- Either a TcTyVar or a CoVar\n        -- Invariant on ForAllTy in TcTypes:\n        --      forall a. T\n        -- a cannot occur inside a MutTyVar in T; that is,\n        -- T is \"flattened\" before quantifying over a\n\ntype TcTyVarBinder   = TyVarBinder\ntype TcTyCon         = TyCon   -- these can be the TcTyCon constructor\n\n-- These types do not have boxy type variables in them\ntype TcPredType     = PredType\ntype TcThetaType    = ThetaType\ntype TcSigmaType    = TcType\ntype TcRhoType      = TcType  -- Note [TcRhoType]\ntype TcTauType      = TcType\ntype TcKind         = Kind\ntype TcTyVarSet     = TyVarSet\ntype TcTyCoVarSet   = TyCoVarSet\ntype TcDTyVarSet    = DTyVarSet\ntype TcDTyCoVarSet  = DTyCoVarSet\n\n{- *********************************************************************\n*                                                                      *\n          ExpType: an \"expected type\" in the type checker\n*                                                                      *\n********************************************************************* -}\n\n-- | An expected type to check against during type-checking.\n-- See Note [ExpType] in TcMType, where you'll also find manipulators.\ndata ExpType = Check TcType\n             | Infer !InferResult\n\ndata InferResult\n  = IR { ir_uniq :: Unique  -- For debugging only\n\n       , ir_lvl  :: TcLevel -- See Note [TcLevel of ExpType] in TcMType\n\n       , ir_inst :: Bool\n         -- True <=> deeply instantiate before returning\n         --           i.e. return a RhoType\n         -- False <=> do not instantiate before returning\n         --           i.e. return a SigmaType\n         -- See Note [Deep instantiation of InferResult] in TcUnify\n\n       , ir_ref  :: IORef (Maybe TcType) }\n         -- The type that fills in this hole should be a Type,\n         -- that is, its kind should be (TYPE rr) for some rr\n\ntype ExpSigmaType = ExpType\ntype ExpRhoType   = ExpType\n\ninstance Outputable ExpType where\n  ppr (Check ty) = text \"Check\" <> braces (ppr ty)\n  ppr (Infer ir) = ppr ir\n\ninstance Outputable InferResult where\n  ppr (IR { ir_uniq = u, ir_lvl = lvl\n          , ir_inst = inst })\n    = text \"Infer\" <> braces (ppr u <> comma <> ppr lvl <+> ppr inst)\n\n-- | Make an 'ExpType' suitable for checking.\nmkCheckExpType :: TcType -> ExpType\nmkCheckExpType = Check\n\n\n{- *********************************************************************\n*                                                                      *\n          SyntaxOpType\n*                                                                      *\n********************************************************************* -}\n\n-- | What to expect for an argument to a rebindable-syntax operator.\n-- Quite like 'Type', but allows for holes to be filled in by tcSyntaxOp.\n-- The callback called from tcSyntaxOp gets a list of types; the meaning\n-- of these types is determined by a left-to-right depth-first traversal\n-- of the 'SyntaxOpType' tree. So if you pass in\n--\n-- > SynAny `SynFun` (SynList `SynFun` SynType Int) `SynFun` SynAny\n--\n-- you'll get three types back: one for the first 'SynAny', the /element/\n-- type of the list, and one for the last 'SynAny'. You don't get anything\n-- for the 'SynType', because you've said positively that it should be an\n-- Int, and so it shall be.\n--\n-- This is defined here to avoid defining it in TcExpr.hs-boot.\ndata SyntaxOpType\n  = SynAny     -- ^ Any type\n  | SynRho     -- ^ A rho type, deeply skolemised or instantiated as appropriate\n  | SynList    -- ^ A list type. You get back the element type of the list\n  | SynFun SyntaxOpType SyntaxOpType\n               -- ^ A function.\n  | SynType ExpType   -- ^ A known type.\ninfixr 0 `SynFun`\n\n-- | Like 'SynType' but accepts a regular TcType\nsynKnownType :: TcType -> SyntaxOpType\nsynKnownType = SynType . mkCheckExpType\n\n-- | Like 'mkFunTys' but for 'SyntaxOpType'\nmkSynFunTys :: [SyntaxOpType] -> ExpType -> SyntaxOpType\nmkSynFunTys arg_tys res_ty = foldr SynFun (SynType res_ty) arg_tys\n\n\n{-\nNote [TcRhoType]\n~~~~~~~~~~~~~~~~\nA TcRhoType has no foralls or contexts at the top, or to the right of an arrow\n  YES    (forall a. a->a) -> Int\n  NO     forall a. a ->  Int\n  NO     Eq a => a -> a\n  NO     Int -> forall a. a -> Int\n\n\n************************************************************************\n*                                                                      *\n        TyVarDetails, MetaDetails, MetaInfo\n*                                                                      *\n************************************************************************\n\nTyVarDetails gives extra info about type variables, used during type\nchecking.  It's attached to mutable type variables only.\nIt's knot-tied back to Var.hs.  There is no reason in principle\nwhy Var.hs shouldn't actually have the definition, but it \"belongs\" here.\n\nNote [Signature skolems]\n~~~~~~~~~~~~~~~~~~~~~~~~\nA TyVarTv is a specialised variant of TauTv, with the following invarints:\n\n    * A TyVarTv can be unified only with a TyVar,\n      not with any other type\n\n    * Its MetaDetails, if filled in, will always be another TyVarTv\n      or a SkolemTv\n\nTyVarTvs are only distinguished to improve error messages.\nConsider this\n\n  data T (a:k1) = MkT (S a)\n  data S (b:k2) = MkS (T b)\n\nWhen doing kind inference on {S,T} we don't want *skolems* for k1,k2,\nbecause they end up unifying; we want those TyVarTvs again.\n\n\nNote [TyVars and TcTyVars during type checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe Var type has constructors TyVar and TcTyVar.  They are used\nas follows:\n\n* TcTyVar: used /only/ during type checking.  Should never appear\n  afterwards.  May contain a mutable field, in the MetaTv case.\n\n* TyVar: is never seen by the constraint solver, except locally\n  inside a type like (forall a. [a] ->[a]), where 'a' is a TyVar.\n  We instantiate these with TcTyVars before exposing the type\n  to the constraint solver.\n\nI have swithered about the latter invariant, excluding TyVars from the\nconstraint solver.  It's not strictly essential, and indeed\n(historically but still there) Var.tcTyVarDetails returns\nvanillaSkolemTv for a TyVar.\n\nBut ultimately I want to seeparate Type from TcType, and in that case\nwe would need to enforce the separation.\n-}\n\n-- A TyVarDetails is inside a TyVar\n-- See Note [TyVars and TcTyVars]\ndata TcTyVarDetails\n  = SkolemTv      -- A skolem\n       TcLevel    -- Level of the implication that binds it\n                  -- See TcUnify Note [Deeper level on the left] for\n                  --     how this level number is used\n       Bool       -- True <=> this skolem type variable can be overlapped\n                  --          when looking up instances\n                  -- See Note [Binding when looking up instances] in InstEnv\n\n  | RuntimeUnk    -- Stands for an as-yet-unknown type in the GHCi\n                  -- interactive context\n\n  | MetaTv { mtv_info  :: MetaInfo\n           , mtv_ref   :: IORef MetaDetails\n           , mtv_tclvl :: TcLevel }  -- See Note [TcLevel and untouchable type variables]\n\nvanillaSkolemTv, superSkolemTv :: TcTyVarDetails\n-- See Note [Binding when looking up instances] in InstEnv\nvanillaSkolemTv = SkolemTv topTcLevel False  -- Might be instantiated\nsuperSkolemTv   = SkolemTv topTcLevel True   -- Treat this as a completely distinct type\n                  -- The choice of level number here is a bit dodgy, but\n                  -- topTcLevel works in the places that vanillaSkolemTv is used\n\n-----------------------------\ndata MetaDetails\n  = Flexi  -- Flexi type variables unify to become Indirects\n  | Indirect TcType\n\ndata MetaInfo\n   = TauTv         -- This MetaTv is an ordinary unification variable\n                   -- A TauTv is always filled in with a tau-type, which\n                   -- never contains any ForAlls.\n\n   | TyVarTv       -- A variant of TauTv, except that it should not be\n                   --   unified with a type, only with a type variable\n                   -- See Note [Signature skolems]\n\n   | FlatMetaTv    -- A flatten meta-tyvar\n                   -- It is a meta-tyvar, but it is always untouchable, with level 0\n                   -- See Note [The flattening story] in TcFlatten\n\n   | FlatSkolTv    -- A flatten skolem tyvar\n                   -- Just like FlatMetaTv, but is comletely \"owned\" by\n                   --   its Given CFunEqCan.\n                   -- It is filled in /only/ by unflattenGivens\n                   -- See Note [The flattening story] in TcFlatten\n\ninstance Outputable MetaDetails where\n  ppr Flexi         = text \"Flexi\"\n  ppr (Indirect ty) = text \"Indirect\" <+> ppr ty\n\npprTcTyVarDetails :: TcTyVarDetails -> SDoc\n-- For debugging\npprTcTyVarDetails (RuntimeUnk {})      = text \"rt\"\npprTcTyVarDetails (SkolemTv lvl True)  = text \"ssk\" <> colon <> ppr lvl\npprTcTyVarDetails (SkolemTv lvl False) = text \"sk\"  <> colon <> ppr lvl\npprTcTyVarDetails (MetaTv { mtv_info = info, mtv_tclvl = tclvl })\n  = pp_info <> colon <> ppr tclvl\n  where\n    pp_info = case info of\n                TauTv      -> text \"tau\"\n                TyVarTv    -> text \"tyv\"\n                FlatMetaTv -> text \"fmv\"\n                FlatSkolTv -> text \"fsk\"\n\n\n{- *********************************************************************\n*                                                                      *\n          UserTypeCtxt\n*                                                                      *\n********************************************************************* -}\n\n-------------------------------------\n-- UserTypeCtxt describes the origin of the polymorphic type\n-- in the places where we need an expression to have that type\n\ndata UserTypeCtxt\n  = FunSigCtxt      -- Function type signature, when checking the type\n                    -- Also used for types in SPECIALISE pragmas\n       Name              -- Name of the function\n       Bool              -- True <=> report redundant constraints\n                            -- This is usually True, but False for\n                            --   * Record selectors (not important here)\n                            --   * Class and instance methods.  Here\n                            --     the code may legitimately be more\n                            --     polymorphic than the signature\n                            --     generated from the class\n                            --     declaration\n\n  | InfSigCtxt Name     -- Inferred type for function\n  | ExprSigCtxt         -- Expression type signature\n  | KindSigCtxt         -- Kind signature\n  | TypeAppCtxt         -- Visible type application\n  | ConArgCtxt Name     -- Data constructor argument\n  | TySynCtxt Name      -- RHS of a type synonym decl\n  | PatSynCtxt Name     -- Type sig for a pattern synonym\n  | PatSigCtxt          -- Type sig in pattern\n                        --   eg  f (x::t) = ...\n                        --   or  (x::t, y) = e\n  | RuleSigCtxt Name    -- LHS of a RULE forall\n                        --    RULE \"foo\" forall (x :: a -> a). f (Just x) = ...\n  | ResSigCtxt          -- Result type sig\n                        --      f x :: t = ....\n  | ForSigCtxt Name     -- Foreign import or export signature\n  | DefaultDeclCtxt     -- Types in a default declaration\n  | InstDeclCtxt Bool   -- An instance declaration\n                        --    True:  stand-alone deriving\n                        --    False: vanilla instance declaration\n  | SpecInstCtxt        -- SPECIALISE instance pragma\n  | ThBrackCtxt         -- Template Haskell type brackets [t| ... |]\n  | GenSigCtxt          -- Higher-rank or impredicative situations\n                        -- e.g. (f e) where f has a higher-rank type\n                        -- We might want to elaborate this\n  | GhciCtxt Bool       -- GHCi command :kind <type>\n                        -- The Bool indicates if we are checking the outermost\n                        -- type application.\n                        -- See Note [Unsaturated type synonyms in GHCi] in\n                        -- TcValidity.\n\n  | ClassSCCtxt Name    -- Superclasses of a class\n  | SigmaCtxt           -- Theta part of a normal for-all type\n                        --      f :: <S> => a -> a\n  | DataTyCtxt Name     -- The \"stupid theta\" part of a data decl\n                        --      data <S> => T a = MkT a\n  | DerivClauseCtxt     -- A 'deriving' clause\n  | TyVarBndrKindCtxt Name  -- The kind of a type variable being bound\n  | DataKindCtxt Name   -- The kind of a data/newtype (instance)\n  | TySynKindCtxt Name  -- The kind of the RHS of a type synonym\n  | TyFamResKindCtxt Name   -- The result kind of a type family\n\n{-\n-- Notes re TySynCtxt\n-- We allow type synonyms that aren't types; e.g.  type List = []\n--\n-- If the RHS mentions tyvars that aren't in scope, we'll\n-- quantify over them:\n--      e.g.    type T = a->a\n-- will become  type T = forall a. a->a\n--\n-- With gla-exts that's right, but for H98 we should complain.\n-}\n\n\npprUserTypeCtxt :: UserTypeCtxt -> SDoc\npprUserTypeCtxt (FunSigCtxt n _)  = text \"the type signature for\" <+> quotes (ppr n)\npprUserTypeCtxt (InfSigCtxt n)    = text \"the inferred type for\" <+> quotes (ppr n)\npprUserTypeCtxt (RuleSigCtxt n)   = text \"a RULE for\" <+> quotes (ppr n)\npprUserTypeCtxt ExprSigCtxt       = text \"an expression type signature\"\npprUserTypeCtxt KindSigCtxt       = text \"a kind signature\"\npprUserTypeCtxt TypeAppCtxt       = text \"a type argument\"\npprUserTypeCtxt (ConArgCtxt c)    = text \"the type of the constructor\" <+> quotes (ppr c)\npprUserTypeCtxt (TySynCtxt c)     = text \"the RHS of the type synonym\" <+> quotes (ppr c)\npprUserTypeCtxt ThBrackCtxt       = text \"a Template Haskell quotation [t|...|]\"\npprUserTypeCtxt PatSigCtxt        = text \"a pattern type signature\"\npprUserTypeCtxt ResSigCtxt        = text \"a result type signature\"\npprUserTypeCtxt (ForSigCtxt n)    = text \"the foreign declaration for\" <+> quotes (ppr n)\npprUserTypeCtxt DefaultDeclCtxt   = text \"a type in a `default' declaration\"\npprUserTypeCtxt (InstDeclCtxt False) = text \"an instance declaration\"\npprUserTypeCtxt (InstDeclCtxt True)  = text \"a stand-alone deriving instance declaration\"\npprUserTypeCtxt SpecInstCtxt      = text \"a SPECIALISE instance pragma\"\npprUserTypeCtxt GenSigCtxt        = text \"a type expected by the context\"\npprUserTypeCtxt (GhciCtxt {})     = text \"a type in a GHCi command\"\npprUserTypeCtxt (ClassSCCtxt c)   = text \"the super-classes of class\" <+> quotes (ppr c)\npprUserTypeCtxt SigmaCtxt         = text \"the context of a polymorphic type\"\npprUserTypeCtxt (DataTyCtxt tc)   = text \"the context of the data type declaration for\" <+> quotes (ppr tc)\npprUserTypeCtxt (PatSynCtxt n)    = text \"the signature for pattern synonym\" <+> quotes (ppr n)\npprUserTypeCtxt (DerivClauseCtxt) = text \"a `deriving' clause\"\npprUserTypeCtxt (TyVarBndrKindCtxt n) = text \"the kind annotation on the type variable\" <+> quotes (ppr n)\npprUserTypeCtxt (DataKindCtxt n)  = text \"the kind annotation on the declaration for\" <+> quotes (ppr n)\npprUserTypeCtxt (TySynKindCtxt n) = text \"the kind annotation on the declaration for\" <+> quotes (ppr n)\npprUserTypeCtxt (TyFamResKindCtxt n) = text \"the result kind for\" <+> quotes (ppr n)\n\nisSigMaybe :: UserTypeCtxt -> Maybe Name\nisSigMaybe (FunSigCtxt n _) = Just n\nisSigMaybe (ConArgCtxt n)   = Just n\nisSigMaybe (ForSigCtxt n)   = Just n\nisSigMaybe (PatSynCtxt n)   = Just n\nisSigMaybe _                = Nothing\n\n\n{- *********************************************************************\n*                                                                      *\n                Untoucable type variables\n*                                                                      *\n********************************************************************* -}\n\nnewtype TcLevel = TcLevel Int deriving( Eq, Ord )\n  -- See Note [TcLevel and untouchable type variables] for what this Int is\n  -- See also Note [TcLevel assignment]\n\n{-\nNote [TcLevel and untouchable type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Each unification variable (MetaTv)\n  and each Implication\n  has a level number (of type TcLevel)\n\n* INVARIANTS.  In a tree of Implications,\n\n    (ImplicInv) The level number (ic_tclvl) of an Implication is\n                STRICTLY GREATER THAN that of its parent\n\n    (SkolInv)   The level number of the skolems (ic_skols) of an\n                Implication is equal to the level of the implication\n                itself (ic_tclvl)\n\n    (GivenInv)  The level number of a unification variable appearing\n                in the 'ic_given' of an implication I should be\n                STRICTLY LESS THAN the ic_tclvl of I\n\n    (WantedInv) The level number of a unification variable appearing\n                in the 'ic_wanted' of an implication I should be\n                LESS THAN OR EQUAL TO the ic_tclvl of I\n                See Note [WantedInv]\n\n* A unification variable is *touchable* if its level number\n  is EQUAL TO that of its immediate parent implication,\n  and it is a TauTv or TyVarTv (but /not/ FlatMetaTv or FlatSkolTv)\n\nNote [WantedInv]\n~~~~~~~~~~~~~~~~\nWhy is WantedInv important?  Consider this implication, where\nthe constraint (C alpha[3]) disobeys WantedInv:\n\n   forall[2] a. blah => (C alpha[3])\n                        (forall[3] b. alpha[3] ~ b)\n\nWe can unify alpha:=b in the inner implication, because 'alpha' is\ntouchable; but then 'b' has excaped its scope into the outer implication.\n\nNote [Skolem escape prevention]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe only unify touchable unification variables.  Because of\n(WantedInv), there can be no occurrences of the variable further out,\nso the unification can't cause the skolems to escape. Example:\n     data T = forall a. MkT a (a->Int)\n     f x (MkT v f) = length [v,x]\nWe decide (x::alpha), and generate an implication like\n      [1]forall a. (a ~ alpha[0])\nBut we must not unify alpha:=a, because the skolem would escape.\n\nFor the cases where we DO want to unify, we rely on floating the\nequality.   Example (with same T)\n     g x (MkT v f) = x && True\nWe decide (x::alpha), and generate an implication like\n      [1]forall a. (Bool ~ alpha[0])\nWe do NOT unify directly, bur rather float out (if the constraint\ndoes not mention 'a') to get\n      (Bool ~ alpha[0]) /\\ [1]forall a.()\nand NOW we can unify alpha.\n\nThe same idea of only unifying touchables solves another problem.\nSuppose we had\n   (F Int ~ uf[0])  /\\  [1](forall a. C a => F Int ~ beta[1])\nIn this example, beta is touchable inside the implication. The\nfirst solveSimpleWanteds step leaves 'uf' un-unified. Then we move inside\nthe implication where a new constraint\n       uf  ~  beta\nemerges. If we (wrongly) spontaneously solved it to get uf := beta,\nthe whole implication disappears but when we pop out again we are left with\n(F Int ~ uf) which will be unified by our final zonking stage and\nuf will get unified *once more* to (F Int).\n\nNote [TcLevel assignment]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWe arrange the TcLevels like this\n\n   0   Top level\n   1   First-level implication constraints\n   2   Second-level implication constraints\n   ...etc...\n-}\n\nmaxTcLevel :: TcLevel -> TcLevel -> TcLevel\nmaxTcLevel (TcLevel a) (TcLevel b) = TcLevel (a `max` b)\n\ntopTcLevel :: TcLevel\n-- See Note [TcLevel assignment]\ntopTcLevel = TcLevel 0   -- 0 = outermost level\n\nisTopTcLevel :: TcLevel -> Bool\nisTopTcLevel (TcLevel 0) = True\nisTopTcLevel _           = False\n\npushTcLevel :: TcLevel -> TcLevel\n-- See Note [TcLevel assignment]\npushTcLevel (TcLevel us) = TcLevel (us + 1)\n\nstrictlyDeeperThan :: TcLevel -> TcLevel -> Bool\nstrictlyDeeperThan (TcLevel tv_tclvl) (TcLevel ctxt_tclvl)\n  = tv_tclvl > ctxt_tclvl\n\nsameDepthAs :: TcLevel -> TcLevel -> Bool\nsameDepthAs (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)\n  = ctxt_tclvl == tv_tclvl   -- NB: invariant ctxt_tclvl >= tv_tclvl\n                             --     So <= would be equivalent\n\ncheckTcLevelInvariant :: TcLevel -> TcLevel -> Bool\n-- Checks (WantedInv) from Note [TcLevel and untouchable type variables]\ncheckTcLevelInvariant (TcLevel ctxt_tclvl) (TcLevel tv_tclvl)\n  = ctxt_tclvl >= tv_tclvl\n\ntcTyVarLevel :: TcTyVar -> TcLevel\ntcTyVarLevel tv\n  = ASSERT2( tcIsTcTyVar tv, ppr tv )\n    case tcTyVarDetails tv of\n          MetaTv { mtv_tclvl = tv_lvl } -> tv_lvl\n          SkolemTv tv_lvl _             -> tv_lvl\n          RuntimeUnk                    -> topTcLevel\n\n\ntcTypeLevel :: TcType -> TcLevel\n-- Max level of any free var of the type\ntcTypeLevel ty\n  = foldDVarSet add topTcLevel (tyCoVarsOfTypeDSet ty)\n  where\n    add v lvl\n      | isTcTyVar v = lvl `maxTcLevel` tcTyVarLevel v\n      | otherwise = lvl\n\ninstance Outputable TcLevel where\n  ppr (TcLevel us) = ppr us\n\npromoteSkolem :: TcLevel -> TcTyVar -> TcTyVar\npromoteSkolem tclvl skol\n  | tclvl < tcTyVarLevel skol\n  = ASSERT( isTcTyVar skol && isSkolemTyVar skol )\n    setTcTyVarDetails skol (SkolemTv tclvl (isOverlappableTyVar skol))\n\n  | otherwise\n  = skol\n\n-- | Change the TcLevel in a skolem, extending a substitution\npromoteSkolemX :: TcLevel -> TCvSubst -> TcTyVar -> (TCvSubst, TcTyVar)\npromoteSkolemX tclvl subst skol\n  = ASSERT( isTcTyVar skol && isSkolemTyVar skol )\n    (new_subst, new_skol)\n  where\n    new_skol\n      | tclvl < tcTyVarLevel skol\n      = setTcTyVarDetails (updateTyVarKind (substTy subst) skol)\n                          (SkolemTv tclvl (isOverlappableTyVar skol))\n      | otherwise\n      = updateTyVarKind (substTy subst) skol\n    new_subst = extendTvSubstWithClone subst skol new_skol\n\npromoteSkolemsX :: TcLevel -> TCvSubst -> [TcTyVar] -> (TCvSubst, [TcTyVar])\npromoteSkolemsX tclvl = mapAccumL (promoteSkolemX tclvl)\n\n{- *********************************************************************\n*                                                                      *\n    Finding type family instances\n*                                                                      *\n************************************************************************\n-}\n\n-- | Finds outermost type-family applications occurring in a type,\n-- after expanding synonyms.  In the list (F, tys) that is returned\n-- we guarantee that tys matches F's arity.  For example, given\n--    type family F a :: * -> *    (arity 1)\n-- calling tcTyFamInsts on (Maybe (F Int Bool) will return\n--     (F, [Int]), not (F, [Int,Bool])\n--\n-- This is important for its use in deciding termination of type\n-- instances (see Trac #11581).  E.g.\n--    type instance G [Int] = ...(F Int <big type>)...\n-- we don't need to take <big type> into account when asking if\n-- the calls on the RHS are smaller than the LHS\ntcTyFamInsts :: Type -> [(TyCon, [Type])]\ntcTyFamInsts = map (\\(_,b,c) -> (b,c)) . tcTyFamInstsAndVis\n\n-- | Like 'tcTyFamInsts', except that the output records whether the\n-- type family and its arguments occur as an /invisible/ argument in\n-- some type application. This information is useful because it helps GHC know\n-- when to turn on @-fprint-explicit-kinds@ during error reporting so that\n-- users can actually see the type family being mentioned.\n--\n-- As an example, consider:\n--\n-- @\n-- class C a\n-- data T (a :: k)\n-- type family F a :: k\n-- instance C (T @(F Int) (F Bool))\n-- @\n--\n-- There are two occurrences of the type family `F` in that `C` instance, so\n-- @'tcTyFamInstsAndVis' (C (T \\@(F Int) (F Bool)))@ will return:\n--\n-- @\n-- [ ('True',  F, [Int])\n-- , ('False', F, [Bool]) ]\n-- @\n--\n-- @F Int@ is paired with 'True' since it appears as an /invisible/ argument\n-- to @C@, whereas @F Bool@ is paired with 'False' since it appears an a\n-- /visible/ argument to @C@.\n--\n-- See also @Note [Kind arguments in error messages]@ in \"TcErrors\".\ntcTyFamInstsAndVis :: Type -> [(Bool, TyCon, [Type])]\ntcTyFamInstsAndVis = tcTyFamInstsAndVisX False\n\ntcTyFamInstsAndVisX\n  :: Bool -- ^ Is this an invisible argument to some type application?\n  -> Type -> [(Bool, TyCon, [Type])]\ntcTyFamInstsAndVisX = go\n  where\n    go is_invis_arg ty\n      | Just exp_ty <- tcView ty       = go is_invis_arg exp_ty\n    go _ (TyVarTy _)                   = []\n    go is_invis_arg (TyConApp tc tys)\n      | isTypeFamilyTyCon tc\n      = [(is_invis_arg, tc, take (tyConArity tc) tys)]\n      | otherwise\n      = tcTyConAppTyFamInstsAndVisX is_invis_arg tc tys\n    go _            (LitTy {})         = []\n    go is_invis_arg (ForAllTy bndr ty) = go is_invis_arg (binderType bndr)\n                                         ++ go is_invis_arg ty\n    go is_invis_arg (FunTy _ ty1 ty2)  = go is_invis_arg ty1\n                                         ++ go is_invis_arg ty2\n    go is_invis_arg ty@(AppTy _ _)     =\n      let (ty_head, ty_args) = splitAppTys ty\n          ty_arg_flags       = appTyArgFlags ty_head ty_args\n      in go is_invis_arg ty_head\n         ++ concat (zipWith (\\flag -> go (isInvisibleArgFlag flag))\n                            ty_arg_flags ty_args)\n    go is_invis_arg (CastTy ty _)      = go is_invis_arg ty\n    go _            (CoercionTy _)     = [] -- don't count tyfams in coercions,\n                                            -- as they never get normalized,\n                                            -- anyway\n\n-- | In an application of a 'TyCon' to some arguments, find the outermost\n-- occurrences of type family applications within the arguments. This function\n-- will not consider the 'TyCon' itself when checking for type family\n-- applications.\n--\n-- See 'tcTyFamInstsAndVis' for more details on how this works (as this\n-- function is called inside of 'tcTyFamInstsAndVis').\ntcTyConAppTyFamInstsAndVis :: TyCon -> [Type] -> [(Bool, TyCon, [Type])]\ntcTyConAppTyFamInstsAndVis = tcTyConAppTyFamInstsAndVisX False\n\ntcTyConAppTyFamInstsAndVisX\n  :: Bool -- ^ Is this an invisible argument to some type application?\n  -> TyCon -> [Type] -> [(Bool, TyCon, [Type])]\ntcTyConAppTyFamInstsAndVisX is_invis_arg tc tys =\n  let (invis_tys, vis_tys) = partitionInvisibleTypes tc tys\n  in concat $ map (tcTyFamInstsAndVisX True)         invis_tys\n           ++ map (tcTyFamInstsAndVisX is_invis_arg) vis_tys\n\nisTyFamFree :: Type -> Bool\n-- ^ Check that a type does not contain any type family applications.\nisTyFamFree = null . tcTyFamInsts\n\n{-\n************************************************************************\n*                                                                      *\n          The \"exact\" free variables of a type\n*                                                                      *\n************************************************************************\n\nNote [Silly type synonym]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n  type T a = Int\nWhat are the free tyvars of (T x)?  Empty, of course!\n\nexactTyCoVarsOfType is used by the type checker to figure out exactly\nwhich type variables are mentioned in a type.  It only matters\noccasionally -- see the calls to exactTyCoVarsOfType.\n\nHistorical note: years and years ago this function was used during\ngeneralisation -- see Trac #1813.  But that code has long since died.\n-}\n\nexactTyCoVarsOfType :: Type -> TyCoVarSet\n-- Find the free type variables (of any kind)\n-- but *expand* type synonyms.  See Note [Silly type synonym] above.\nexactTyCoVarsOfType ty\n  = go ty\n  where\n    go ty | Just ty' <- tcView ty = go ty'  -- This is the key line\n    go (TyVarTy tv)         = goVar tv\n    go (TyConApp _ tys)     = exactTyCoVarsOfTypes tys\n    go (LitTy {})           = emptyVarSet\n    go (AppTy fun arg)      = go fun `unionVarSet` go arg\n    go (FunTy _ arg res)    = go arg `unionVarSet` go res\n    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderType bndr)\n    go (CastTy ty co)       = go ty `unionVarSet` goCo co\n    go (CoercionTy co)      = goCo co\n\n    goMCo MRefl    = emptyVarSet\n    goMCo (MCo co) = goCo co\n\n    goCo (Refl ty)            = go ty\n    goCo (GRefl _ ty mco)     = go ty `unionVarSet` goMCo mco\n    goCo (TyConAppCo _ _ args)= goCos args\n    goCo (AppCo co arg)     = goCo co `unionVarSet` goCo arg\n    goCo (ForAllCo tv k_co co)\n      = goCo co `delVarSet` tv `unionVarSet` goCo k_co\n    goCo (FunCo _ co1 co2)   = goCo co1 `unionVarSet` goCo co2\n    goCo (CoVarCo v)         = goVar v\n    goCo (HoleCo h)          = goVar (coHoleCoVar h)\n    goCo (AxiomInstCo _ _ args) = goCos args\n    goCo (UnivCo p _ t1 t2)  = goProv p `unionVarSet` go t1 `unionVarSet` go t2\n    goCo (SymCo co)          = goCo co\n    goCo (TransCo co1 co2)   = goCo co1 `unionVarSet` goCo co2\n    goCo (NthCo _ _ co)      = goCo co\n    goCo (LRCo _ co)         = goCo co\n    goCo (InstCo co arg)     = goCo co `unionVarSet` goCo arg\n    goCo (KindCo co)         = goCo co\n    goCo (SubCo co)          = goCo co\n    goCo (AxiomRuleCo _ c)   = goCos c\n\n    goCos cos = foldr (unionVarSet . goCo) emptyVarSet cos\n\n    goProv UnsafeCoerceProv     = emptyVarSet\n    goProv (PhantomProv kco)    = goCo kco\n    goProv (ProofIrrelProv kco) = goCo kco\n    goProv (PluginProv _)       = emptyVarSet\n\n    goVar v = unitVarSet v `unionVarSet` go (varType v)\n\nexactTyCoVarsOfTypes :: [Type] -> TyVarSet\nexactTyCoVarsOfTypes tys = mapUnionVarSet exactTyCoVarsOfType tys\n\nanyRewritableTyVar :: Bool    -- Ignore casts and coercions\n                   -> EqRel   -- Ambient role\n                   -> (EqRel -> TcTyVar -> Bool)\n                   -> TcType -> Bool\n-- (anyRewritableTyVar ignore_cos pred ty) returns True\n--    if the 'pred' returns True of any free TyVar in 'ty'\n-- Do not look inside casts and coercions if 'ignore_cos' is True\n-- See Note [anyRewritableTyVar must be role-aware]\nanyRewritableTyVar ignore_cos role pred ty\n  = go role emptyVarSet ty\n  where\n    go_tv rl bvs tv | tv `elemVarSet` bvs = False\n                    | otherwise           = pred rl tv\n\n    go rl bvs (TyVarTy tv)       = go_tv rl bvs tv\n    go _ _     (LitTy {})        = False\n    go rl bvs (TyConApp tc tys)  = go_tc rl bvs tc tys\n    go rl bvs (AppTy fun arg)    = go rl bvs fun || go NomEq bvs arg\n    go rl bvs (FunTy _ arg res)  = go rl bvs arg || go rl bvs res\n    go rl bvs (ForAllTy tv ty)   = go rl (bvs `extendVarSet` binderVar tv) ty\n    go rl bvs (CastTy ty co)     = go rl bvs ty || go_co rl bvs co\n    go rl bvs (CoercionTy co)    = go_co rl bvs co  -- ToDo: check\n\n    go_tc NomEq  bvs _  tys = any (go NomEq bvs) tys\n    go_tc ReprEq bvs tc tys = any (go_arg bvs)\n                              (tyConRolesRepresentational tc `zip` tys)\n\n    go_arg bvs (Nominal,          ty) = go NomEq  bvs ty\n    go_arg bvs (Representational, ty) = go ReprEq bvs ty\n    go_arg _   (Phantom,          _)  = False  -- We never rewrite with phantoms\n\n    go_co rl bvs co\n      | ignore_cos = False\n      | otherwise  = anyVarSet (go_tv rl bvs) (tyCoVarsOfCo co)\n      -- We don't have an equivalent of anyRewritableTyVar for coercions\n      -- (at least not yet) so take the free vars and test them\n\n{- Note [anyRewritableTyVar must be role-aware]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nanyRewritableTyVar is used during kick-out from the inert set,\nto decide if, given a new equality (a ~ ty), we should kick out\na constraint C.  Rather than gather free variables and see if 'a'\nis among them, we instead pass in a predicate; this is just efficiency.\n\nMoreover, consider\n  work item:   [G] a ~R f b\n  inert item:  [G] b ~R f a\nWe use anyRewritableTyVar to decide whether to kick out the inert item,\non the grounds that the work item might rewrite it. Well, 'a' is certainly\nfree in [G] b ~R f a.  But because the role of a type variable ('f' in\nthis case) is nominal, the work item can't actually rewrite the inert item.\nMoreover, if we were to kick out the inert item the exact same situation\nwould re-occur and we end up with an infinite loop in which each kicks\nout the other (Trac #14363).\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                Predicates\n*                                                                      *\n************************************************************************\n-}\n\ntcIsTcTyVar :: TcTyVar -> Bool\n-- See Note [TcTyVars and TyVars in the typechecker]\ntcIsTcTyVar tv = isTyVar tv\n\nisTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool\nisTouchableMetaTyVar ctxt_tclvl tv\n  | isTyVar tv -- See Note [Coercion variables in free variable lists]\n  , MetaTv { mtv_tclvl = tv_tclvl, mtv_info = info } <- tcTyVarDetails tv\n  , not (isFlattenInfo info)\n  = ASSERT2( checkTcLevelInvariant ctxt_tclvl tv_tclvl,\n             ppr tv $$ ppr tv_tclvl $$ ppr ctxt_tclvl )\n    tv_tclvl `sameDepthAs` ctxt_tclvl\n\n  | otherwise = False\n\nisFloatedTouchableMetaTyVar :: TcLevel -> TcTyVar -> Bool\nisFloatedTouchableMetaTyVar ctxt_tclvl tv\n  | isTyVar tv -- See Note [Coercion variables in free variable lists]\n  , MetaTv { mtv_tclvl = tv_tclvl, mtv_info = info } <- tcTyVarDetails tv\n  , not (isFlattenInfo info)\n  = tv_tclvl `strictlyDeeperThan` ctxt_tclvl\n\n  | otherwise = False\n\nisImmutableTyVar :: TyVar -> Bool\nisImmutableTyVar tv = isSkolemTyVar tv\n\nisTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,\n  isMetaTyVar, isAmbiguousTyVar,\n  isFmvTyVar, isFskTyVar, isFlattenTyVar :: TcTyVar -> Bool\n\nisTyConableTyVar tv\n        -- True of a meta-type variable that can be filled in\n        -- with a type constructor application; in particular,\n        -- not a TyVarTv\n  | isTyVar tv -- See Note [Coercion variables in free variable lists]\n  = case tcTyVarDetails tv of\n        MetaTv { mtv_info = TyVarTv } -> False\n        _                             -> True\n  | otherwise = True\n\nisFmvTyVar tv\n  = ASSERT2( tcIsTcTyVar tv, ppr tv )\n    case tcTyVarDetails tv of\n        MetaTv { mtv_info = FlatMetaTv } -> True\n        _                                -> False\n\nisFskTyVar tv\n  = ASSERT2( tcIsTcTyVar tv, ppr tv )\n    case tcTyVarDetails tv of\n        MetaTv { mtv_info = FlatSkolTv } -> True\n        _                                -> False\n\n-- | True of both given and wanted flatten-skolems (fmv and fsk)\nisFlattenTyVar tv\n  = ASSERT2( tcIsTcTyVar tv, ppr tv )\n    case tcTyVarDetails tv of\n        MetaTv { mtv_info = info } -> isFlattenInfo info\n        _                          -> False\n\nisSkolemTyVar tv\n  = ASSERT2( tcIsTcTyVar tv, ppr tv )\n    case tcTyVarDetails tv of\n        MetaTv {} -> False\n        _other    -> True\n\nisOverlappableTyVar tv\n  | isTyVar tv -- See Note [Coercion variables in free variable lists]\n  = case tcTyVarDetails tv of\n        SkolemTv _ overlappable -> overlappable\n        _                       -> False\n  | otherwise = False\n\nisMetaTyVar tv\n  | isTyVar tv -- See Note [Coercion variables in free variable lists]\n  = case tcTyVarDetails tv of\n        MetaTv {} -> True\n        _         -> False\n  | otherwise = False\n\n-- isAmbiguousTyVar is used only when reporting type errors\n-- It picks out variables that are unbound, namely meta\n-- type variables and the RuntimUnk variables created by\n-- RtClosureInspect.zonkRTTIType.  These are \"ambiguous\" in\n-- the sense that they stand for an as-yet-unknown type\nisAmbiguousTyVar tv\n  | isTyVar tv -- See Note [Coercion variables in free variable lists]\n  = case tcTyVarDetails tv of\n        MetaTv {}     -> True\n        RuntimeUnk {} -> True\n        _             -> False\n  | otherwise = False\n\nisMetaTyVarTy :: TcType -> Bool\nisMetaTyVarTy (TyVarTy tv) = isMetaTyVar tv\nisMetaTyVarTy _            = False\n\nmetaTyVarInfo :: TcTyVar -> MetaInfo\nmetaTyVarInfo tv\n  = case tcTyVarDetails tv of\n      MetaTv { mtv_info = info } -> info\n      _ -> pprPanic \"metaTyVarInfo\" (ppr tv)\n\nisFlattenInfo :: MetaInfo -> Bool\nisFlattenInfo FlatMetaTv = True\nisFlattenInfo FlatSkolTv = True\nisFlattenInfo _          = False\n\nmetaTyVarTcLevel :: TcTyVar -> TcLevel\nmetaTyVarTcLevel tv\n  = case tcTyVarDetails tv of\n      MetaTv { mtv_tclvl = tclvl } -> tclvl\n      _ -> pprPanic \"metaTyVarTcLevel\" (ppr tv)\n\nmetaTyVarTcLevel_maybe :: TcTyVar -> Maybe TcLevel\nmetaTyVarTcLevel_maybe tv\n  = case tcTyVarDetails tv of\n      MetaTv { mtv_tclvl = tclvl } -> Just tclvl\n      _                            -> Nothing\n\nmetaTyVarRef :: TyVar -> IORef MetaDetails\nmetaTyVarRef tv\n  = case tcTyVarDetails tv of\n        MetaTv { mtv_ref = ref } -> ref\n        _ -> pprPanic \"metaTyVarRef\" (ppr tv)\n\nsetMetaTyVarTcLevel :: TcTyVar -> TcLevel -> TcTyVar\nsetMetaTyVarTcLevel tv tclvl\n  = case tcTyVarDetails tv of\n      details@(MetaTv {}) -> setTcTyVarDetails tv (details { mtv_tclvl = tclvl })\n      _ -> pprPanic \"metaTyVarTcLevel\" (ppr tv)\n\nisTyVarTyVar :: Var -> Bool\nisTyVarTyVar tv\n  = case tcTyVarDetails tv of\n        MetaTv { mtv_info = TyVarTv } -> True\n        _                             -> False\n\nisFlexi, isIndirect :: MetaDetails -> Bool\nisFlexi Flexi = True\nisFlexi _     = False\n\nisIndirect (Indirect _) = True\nisIndirect _            = False\n\nisRuntimeUnkSkol :: TyVar -> Bool\n-- Called only in TcErrors; see Note [Runtime skolems] there\nisRuntimeUnkSkol x\n  | RuntimeUnk <- tcTyVarDetails x = True\n  | otherwise                      = False\n\nmkTyVarNamePairs :: [TyVar] -> [(Name,TyVar)]\n-- Just pair each TyVar with its own name\nmkTyVarNamePairs tvs = [(tyVarName tv, tv) | tv <- tvs]\n\nfindDupTyVarTvs :: [(Name,TcTyVar)] -> [(Name,Name)]\n-- If we have [...(x1,tv)...(x2,tv)...]\n-- return (x1,x2) in the result list\nfindDupTyVarTvs prs\n  = concatMap mk_result_prs $\n    findDupsEq eq_snd prs\n  where\n    eq_snd (_,tv1) (_,tv2) = tv1 == tv2\n    mk_result_prs ((n1,_) :| xs) = map (\\(n2,_) -> (n1,n2)) xs\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Tau, sigma and rho}\n*                                                                      *\n************************************************************************\n-}\n\nmkSigmaTy :: [TyCoVarBinder] -> [PredType] -> Type -> Type\nmkSigmaTy bndrs theta tau = mkForAllTys bndrs (mkPhiTy theta tau)\n\n-- | Make a sigma ty where all type variables are 'Inferred'. That is,\n-- they cannot be used with visible type application.\nmkInfSigmaTy :: [TyCoVar] -> [PredType] -> Type -> Type\nmkInfSigmaTy tyvars theta ty = mkSigmaTy (mkTyCoVarBinders Inferred tyvars) theta ty\n\n-- | Make a sigma ty where all type variables are \"specified\". That is,\n-- they can be used with visible type application\nmkSpecSigmaTy :: [TyVar] -> [PredType] -> Type -> Type\nmkSpecSigmaTy tyvars preds ty = mkSigmaTy (mkTyCoVarBinders Specified tyvars) preds ty\n\nmkPhiTy :: [PredType] -> Type -> Type\nmkPhiTy = mkInvisFunTys\n\n---------------\ngetDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to\n                                -- construct a dictionary function name\ngetDFunTyKey ty | Just ty' <- coreView ty = getDFunTyKey ty'\ngetDFunTyKey (TyVarTy tv)            = getOccName tv\ngetDFunTyKey (TyConApp tc _)         = getOccName tc\ngetDFunTyKey (LitTy x)               = getDFunTyLitKey x\ngetDFunTyKey (AppTy fun _)           = getDFunTyKey fun\ngetDFunTyKey (FunTy {})              = getOccName funTyCon\ngetDFunTyKey (ForAllTy _ t)          = getDFunTyKey t\ngetDFunTyKey (CastTy ty _)           = getDFunTyKey ty\ngetDFunTyKey t@(CoercionTy _)        = pprPanic \"getDFunTyKey\" (ppr t)\n\ngetDFunTyLitKey :: TyLit -> OccName\ngetDFunTyLitKey (NumTyLit n) = mkOccName Name.varName (show n)\ngetDFunTyLitKey (StrTyLit n) = mkOccName Name.varName (show n)  -- hm\n\n{- *********************************************************************\n*                                                                      *\n           Building types\n*                                                                      *\n********************************************************************* -}\n\n-- ToDo: I think we need Tc versions of these\n-- Reason: mkCastTy checks isReflexiveCastTy, which checks\n--         for equality; and that has a different answer\n--         depending on whether or not Type = Constraint\n\nmkTcAppTys :: Type -> [Type] -> Type\nmkTcAppTys = mkAppTys\n\nmkTcAppTy :: Type -> Type -> Type\nmkTcAppTy = mkAppTy\n\nmkTcCastTy :: Type -> Coercion -> Type\nmkTcCastTy = mkCastTy   -- Do we need a tc version of mkCastTy?\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Expanding and splitting}\n*                                                                      *\n************************************************************************\n\nThese tcSplit functions are like their non-Tc analogues, but\n        *) they do not look through newtypes\n\nHowever, they are non-monadic and do not follow through mutable type\nvariables.  It's up to you to make sure this doesn't matter.\n-}\n\n-- | Splits a forall type into a list of 'TyBinder's and the inner type.\n-- Always succeeds, even if it returns an empty list.\ntcSplitPiTys :: Type -> ([TyBinder], Type)\ntcSplitPiTys ty\n  = ASSERT( all isTyBinder (fst sty) ) sty\n  where sty = splitPiTys ty\n\n-- | Splits a type into a TyBinder and a body, if possible. Panics otherwise\ntcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)\ntcSplitPiTy_maybe ty\n  = ASSERT( isMaybeTyBinder sty ) sty\n  where\n    sty = splitPiTy_maybe ty\n    isMaybeTyBinder (Just (t,_)) = isTyBinder t\n    isMaybeTyBinder _            = True\n\ntcSplitForAllTy_maybe :: Type -> Maybe (TyVarBinder, Type)\ntcSplitForAllTy_maybe ty | Just ty' <- tcView ty = tcSplitForAllTy_maybe ty'\ntcSplitForAllTy_maybe (ForAllTy tv ty) = ASSERT( isTyVarBinder tv ) Just (tv, ty)\ntcSplitForAllTy_maybe _                = Nothing\n\n-- | Like 'tcSplitPiTys', but splits off only named binders,\n-- returning just the tycovars.\ntcSplitForAllTys :: Type -> ([TyVar], Type)\ntcSplitForAllTys ty\n  = ASSERT( all isTyVar (fst sty) ) sty\n  where sty = splitForAllTys ty\n\n-- | Like 'tcSplitForAllTys', but only splits a 'ForAllTy' if\n-- @'sameVis' argf supplied_argf@ is 'True', where @argf@ is the visibility\n-- of the @ForAllTy@'s binder and @supplied_argf@ is the visibility provided\n-- as an argument to this function.\ntcSplitForAllTysSameVis :: ArgFlag -> Type -> ([TyVar], Type)\ntcSplitForAllTysSameVis supplied_argf ty = ASSERT( all isTyVar (fst sty) ) sty\n  where sty = splitForAllTysSameVis supplied_argf ty\n\n-- | Like 'tcSplitForAllTys', but splits off only named binders.\ntcSplitForAllVarBndrs :: Type -> ([TyVarBinder], Type)\ntcSplitForAllVarBndrs ty = ASSERT( all isTyVarBinder (fst sty)) sty\n  where sty = splitForAllVarBndrs ty\n\n-- | Is this a ForAllTy with a named binder?\ntcIsForAllTy :: Type -> Bool\ntcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'\ntcIsForAllTy (ForAllTy {}) = True\ntcIsForAllTy _             = False\n\ntcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)\n-- Split off the first predicate argument from a type\ntcSplitPredFunTy_maybe ty\n  | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'\ntcSplitPredFunTy_maybe (FunTy { ft_af = InvisArg\n                              , ft_arg = arg, ft_res = res })\n  = Just (arg, res)\ntcSplitPredFunTy_maybe _\n  = Nothing\n\ntcSplitPhiTy :: Type -> (ThetaType, Type)\ntcSplitPhiTy ty\n  = split ty []\n  where\n    split ty ts\n      = case tcSplitPredFunTy_maybe ty of\n          Just (pred, ty) -> split ty (pred:ts)\n          Nothing         -> (reverse ts, ty)\n\n-- | Split a sigma type into its parts.\ntcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)\ntcSplitSigmaTy ty = case tcSplitForAllTys ty of\n                        (tvs, rho) -> case tcSplitPhiTy rho of\n                                        (theta, tau) -> (tvs, theta, tau)\n\n-- | Split a sigma type into its parts, going underneath as many @ForAllTy@s\n-- as possible. For example, given this type synonym:\n--\n-- @\n-- type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t\n-- @\n--\n-- if you called @tcSplitSigmaTy@ on this type:\n--\n-- @\n-- forall s t a b. Each s t a b => Traversal s t a b\n-- @\n--\n-- then it would return @([s,t,a,b], [Each s t a b], Traversal s t a b)@. But\n-- if you instead called @tcSplitNestedSigmaTys@ on the type, it would return\n-- @([s,t,a,b,f], [Each s t a b, Applicative f], (a -> f b) -> s -> f t)@.\ntcSplitNestedSigmaTys :: Type -> ([TyVar], ThetaType, Type)\n-- NB: This is basically a pure version of deeplyInstantiate (from Inst) that\n-- doesn't compute an HsWrapper.\ntcSplitNestedSigmaTys ty\n    -- If there's a forall, split it apart and try splitting the rho type\n    -- underneath it.\n  | Just (arg_tys, tvs1, theta1, rho1) <- tcDeepSplitSigmaTy_maybe ty\n  = let (tvs2, theta2, rho2) = tcSplitNestedSigmaTys rho1\n    in (tvs1 ++ tvs2, theta1 ++ theta2, mkVisFunTys arg_tys rho2)\n    -- If there's no forall, we're done.\n  | otherwise = ([], [], ty)\n\n-----------------------\ntcDeepSplitSigmaTy_maybe\n  :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType)\n-- Looks for a *non-trivial* quantified type, under zero or more function arrows\n-- By \"non-trivial\" we mean either tyvars or constraints are non-empty\n\ntcDeepSplitSigmaTy_maybe ty\n  | Just (arg_ty, res_ty)           <- tcSplitFunTy_maybe ty\n  , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty\n  = Just (arg_ty:arg_tys, tvs, theta, rho)\n\n  | (tvs, theta, rho) <- tcSplitSigmaTy ty\n  , not (null tvs && null theta)\n  = Just ([], tvs, theta, rho)\n\n  | otherwise = Nothing\n\n-----------------------\ntcTyConAppTyCon :: Type -> TyCon\ntcTyConAppTyCon ty\n  = case tcTyConAppTyCon_maybe ty of\n      Just tc -> tc\n      Nothing -> pprPanic \"tcTyConAppTyCon\" (pprType ty)\n\n-- | Like 'tcRepSplitTyConApp_maybe', but only returns the 'TyCon'.\ntcTyConAppTyCon_maybe :: Type -> Maybe TyCon\ntcTyConAppTyCon_maybe ty\n  | Just ty' <- tcView ty = tcTyConAppTyCon_maybe ty'\ntcTyConAppTyCon_maybe (TyConApp tc _)\n  = Just tc\ntcTyConAppTyCon_maybe (FunTy { ft_af = VisArg })\n  = Just funTyCon  -- (=>) is /not/ a TyCon in its own right\n                   -- C.f. tcRepSplitAppTy_maybe\ntcTyConAppTyCon_maybe _\n  = Nothing\n\ntcTyConAppArgs :: Type -> [Type]\ntcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of\n                        Just (_, args) -> args\n                        Nothing        -> pprPanic \"tcTyConAppArgs\" (pprType ty)\n\ntcSplitTyConApp :: Type -> (TyCon, [Type])\ntcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of\n                        Just stuff -> stuff\n                        Nothing    -> pprPanic \"tcSplitTyConApp\" (pprType ty)\n\n-----------------------\ntcSplitFunTys :: Type -> ([Type], Type)\ntcSplitFunTys ty = case tcSplitFunTy_maybe ty of\n                        Nothing        -> ([], ty)\n                        Just (arg,res) -> (arg:args, res')\n                                       where\n                                          (args,res') = tcSplitFunTys res\n\ntcSplitFunTy_maybe :: Type -> Maybe (Type, Type)\ntcSplitFunTy_maybe ty\n  | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'\ntcSplitFunTy_maybe (FunTy { ft_af = af, ft_arg = arg, ft_res = res })\n  | VisArg <- af = Just (arg, res)\ntcSplitFunTy_maybe _ = Nothing\n        -- Note the VisArg guard\n        -- Consider     (?x::Int) => Bool\n        -- We don't want to treat this as a function type!\n        -- A concrete example is test tc230:\n        --      f :: () -> (?p :: ()) => () -> ()\n        --\n        --      g = f () ()\n\ntcSplitFunTysN :: Arity                      -- n: Number of desired args\n               -> TcRhoType\n               -> Either Arity               -- Number of missing arrows\n                        ([TcSigmaType],      -- Arg types (always N types)\n                         TcSigmaType)        -- The rest of the type\n-- ^ Split off exactly the specified number argument types\n-- Returns\n--  (Left m) if there are 'm' missing arrows in the type\n--  (Right (tys,res)) if the type looks like t1 -> ... -> tn -> res\ntcSplitFunTysN n ty\n | n == 0\n = Right ([], ty)\n | Just (arg,res) <- tcSplitFunTy_maybe ty\n = case tcSplitFunTysN (n-1) res of\n     Left m            -> Left m\n     Right (args,body) -> Right (arg:args, body)\n | otherwise\n = Left n\n\ntcSplitFunTy :: Type -> (Type, Type)\ntcSplitFunTy  ty = expectJust \"tcSplitFunTy\" (tcSplitFunTy_maybe ty)\n\ntcFunArgTy :: Type -> Type\ntcFunArgTy    ty = fst (tcSplitFunTy ty)\n\ntcFunResultTy :: Type -> Type\ntcFunResultTy ty = snd (tcSplitFunTy ty)\n\n-- | Strips off n *visible* arguments and returns the resulting type\ntcFunResultTyN :: HasDebugCallStack => Arity -> Type -> Type\ntcFunResultTyN n ty\n  | Right (_, res_ty) <- tcSplitFunTysN n ty\n  = res_ty\n  | otherwise\n  = pprPanic \"tcFunResultTyN\" (ppr n <+> ppr ty)\n\n-----------------------\ntcSplitAppTy_maybe :: Type -> Maybe (Type, Type)\ntcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'\ntcSplitAppTy_maybe ty = tcRepSplitAppTy_maybe ty\n\ntcSplitAppTy :: Type -> (Type, Type)\ntcSplitAppTy ty = case tcSplitAppTy_maybe ty of\n                    Just stuff -> stuff\n                    Nothing    -> pprPanic \"tcSplitAppTy\" (pprType ty)\n\ntcSplitAppTys :: Type -> (Type, [Type])\ntcSplitAppTys ty\n  = go ty []\n  where\n    go ty args = case tcSplitAppTy_maybe ty of\n                   Just (ty', arg) -> go ty' (arg:args)\n                   Nothing         -> (ty,args)\n\n-- | Returns the number of arguments in the given type, without\n-- looking through synonyms. This is used only for error reporting.\n-- We don't look through synonyms because of #11313.\ntcRepGetNumAppTys :: Type -> Arity\ntcRepGetNumAppTys = length . snd . repSplitAppTys\n\n-----------------------\n-- | If the type is a tyvar, possibly under a cast, returns it, along\n-- with the coercion. Thus, the co is :: kind tv ~N kind type\ntcGetCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)\ntcGetCastedTyVar_maybe ty | Just ty' <- tcView ty = tcGetCastedTyVar_maybe ty'\ntcGetCastedTyVar_maybe (CastTy (TyVarTy tv) co) = Just (tv, co)\ntcGetCastedTyVar_maybe (TyVarTy tv)             = Just (tv, mkNomReflCo (tyVarKind tv))\ntcGetCastedTyVar_maybe _                        = Nothing\n\ntcGetTyVar_maybe :: Type -> Maybe TyVar\ntcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'\ntcGetTyVar_maybe (TyVarTy tv)   = Just tv\ntcGetTyVar_maybe _              = Nothing\n\ntcGetTyVar :: String -> Type -> TyVar\ntcGetTyVar msg ty\n  = case tcGetTyVar_maybe ty of\n     Just tv -> tv\n     Nothing -> pprPanic msg (ppr ty)\n\ntcIsTyVarTy :: Type -> Bool\ntcIsTyVarTy ty | Just ty' <- tcView ty = tcIsTyVarTy ty'\ntcIsTyVarTy (CastTy ty _) = tcIsTyVarTy ty  -- look through casts, as\n                                            -- this is only used for\n                                            -- e.g., FlexibleContexts\ntcIsTyVarTy (TyVarTy _)   = True\ntcIsTyVarTy _             = False\n\n-----------------------\ntcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])\n-- Split the type of a dictionary function\n-- We don't use tcSplitSigmaTy,  because a DFun may (with NDP)\n-- have non-Pred arguments, such as\n--     df :: forall m. (forall b. Eq b => Eq (m b)) -> C m\n--\n-- Also NB splitFunTys, not tcSplitFunTys;\n-- the latter specifically stops at PredTy arguments,\n-- and we don't want to do that here\ntcSplitDFunTy ty\n  = case tcSplitForAllTys ty   of { (tvs, rho)    ->\n    case splitFunTys rho       of { (theta, tau)  ->\n    case tcSplitDFunHead tau   of { (clas, tys)   ->\n    (tvs, theta, clas, tys) }}}\n\ntcSplitDFunHead :: Type -> (Class, [Type])\ntcSplitDFunHead = getClassPredTys\n\ntcSplitMethodTy :: Type -> ([TyVar], PredType, Type)\n-- A class method (selector) always has a type like\n--   forall as. C as => blah\n-- So if the class looks like\n--   class C a where\n--     op :: forall b. (Eq a, Ix b) => a -> b\n-- the class method type looks like\n--  op :: forall a. C a => forall b. (Eq a, Ix b) => a -> b\n--\n-- tcSplitMethodTy just peels off the outer forall and\n-- that first predicate\ntcSplitMethodTy ty\n  | (sel_tyvars,sel_rho) <- tcSplitForAllTys ty\n  , Just (first_pred, local_meth_ty) <- tcSplitPredFunTy_maybe sel_rho\n  = (sel_tyvars, first_pred, local_meth_ty)\n  | otherwise\n  = pprPanic \"tcSplitMethodTy\" (ppr ty)\n\n\n{- *********************************************************************\n*                                                                      *\n            Type equalities\n*                                                                      *\n********************************************************************* -}\n\ntcEqKind :: HasDebugCallStack => TcKind -> TcKind -> Bool\ntcEqKind = tcEqType\n\ntcEqType :: HasDebugCallStack => TcType -> TcType -> Bool\n-- tcEqType is a proper implements the same Note [Non-trivial definitional\n-- equality] (in TyCoRep) as `eqType`, but Type.eqType believes (* ==\n-- Constraint), and that is NOT what we want in the type checker!\ntcEqType ty1 ty2\n  =  tc_eq_type False False ki1 ki2\n  && tc_eq_type False False ty1 ty2\n  where\n    ki1 = tcTypeKind ty1\n    ki2 = tcTypeKind ty2\n\n-- | Just like 'tcEqType', but will return True for types of different kinds\n-- as long as their non-coercion structure is identical.\ntcEqTypeNoKindCheck :: TcType -> TcType -> Bool\ntcEqTypeNoKindCheck ty1 ty2\n  = tc_eq_type False False ty1 ty2\n\n-- | Like 'tcEqType', but returns True if the /visible/ part of the types\n-- are equal, even if they are really unequal (in the invisible bits)\ntcEqTypeVis :: TcType -> TcType -> Bool\ntcEqTypeVis ty1 ty2 = tc_eq_type False True ty1 ty2\n\n-- | Like 'pickyEqTypeVis', but returns a Bool for convenience\npickyEqType :: TcType -> TcType -> Bool\n-- Check when two types _look_ the same, _including_ synonyms.\n-- So (pickyEqType String [Char]) returns False\n-- This ignores kinds and coercions, because this is used only for printing.\npickyEqType ty1 ty2 = tc_eq_type True False ty1 ty2\n\n\n\n-- | Real worker for 'tcEqType'. No kind check!\ntc_eq_type :: Bool          -- ^ True <=> do not expand type synonyms\n           -> Bool          -- ^ True <=> compare visible args only\n           -> Type -> Type\n           -> Bool\n-- Flags False, False is the usual setting for tc_eq_type\ntc_eq_type keep_syns vis_only orig_ty1 orig_ty2\n  = go orig_env orig_ty1 orig_ty2\n  where\n    go :: RnEnv2 -> Type -> Type -> Bool\n    go env t1 t2 | not keep_syns, Just t1' <- tcView t1 = go env t1' t2\n    go env t1 t2 | not keep_syns, Just t2' <- tcView t2 = go env t1 t2'\n\n    go env (TyVarTy tv1) (TyVarTy tv2)\n      = rnOccL env tv1 == rnOccR env tv2\n\n    go _   (LitTy lit1) (LitTy lit2)\n      = lit1 == lit2\n\n    go env (ForAllTy (Bndr tv1 vis1) ty1)\n           (ForAllTy (Bndr tv2 vis2) ty2)\n      =  vis1 == vis2\n      && (vis_only || go env (varType tv1) (varType tv2))\n      && go (rnBndr2 env tv1 tv2) ty1 ty2\n\n    -- Make sure we handle all FunTy cases since falling through to the\n    -- AppTy case means that tcRepSplitAppTy_maybe may see an unzonked\n    -- kind variable, which causes things to blow up.\n    go env (FunTy _ arg1 res1) (FunTy _ arg2 res2)\n      = go env arg1 arg2 && go env res1 res2\n    go env ty (FunTy _ arg res) = eqFunTy env arg res ty\n    go env (FunTy _ arg res) ty = eqFunTy env arg res ty\n\n      -- See Note [Equality on AppTys] in Type\n    go env (AppTy s1 t1)        ty2\n      | Just (s2, t2) <- tcRepSplitAppTy_maybe ty2\n      = go env s1 s2 && go env t1 t2\n    go env ty1                  (AppTy s2 t2)\n      | Just (s1, t1) <- tcRepSplitAppTy_maybe ty1\n      = go env s1 s2 && go env t1 t2\n\n    go env (TyConApp tc1 ts1)   (TyConApp tc2 ts2)\n      = tc1 == tc2 && gos env (tc_vis tc1) ts1 ts2\n\n    go env (CastTy t1 _)   t2              = go env t1 t2\n    go env t1              (CastTy t2 _)   = go env t1 t2\n    go _   (CoercionTy {}) (CoercionTy {}) = True\n\n    go _ _ _ = False\n\n    gos _   _         []       []      = True\n    gos env (ig:igs) (t1:ts1) (t2:ts2) = (ig || go env t1 t2)\n                                      && gos env igs ts1 ts2\n    gos _ _ _ _ = False\n\n    tc_vis :: TyCon -> [Bool]  -- True for the fields we should ignore\n    tc_vis tc | vis_only  = inviss ++ repeat False    -- Ignore invisibles\n              | otherwise = repeat False              -- Ignore nothing\n       -- The repeat False is necessary because tycons\n       -- can legitimately be oversaturated\n      where\n        bndrs = tyConBinders tc\n        inviss  = map isInvisibleTyConBinder bndrs\n\n    orig_env = mkRnEnv2 $ mkInScopeSet $ tyCoVarsOfTypes [orig_ty1, orig_ty2]\n\n    -- @eqFunTy arg res ty@ is True when @ty@ equals @FunTy arg res@. This is\n    -- sometimes hard to know directly because @ty@ might have some casts\n    -- obscuring the FunTy. And 'splitAppTy' is difficult because we can't\n    -- always extract a RuntimeRep (see Note [xyz]) if the kind of the arg or\n    -- res is unzonked/unflattened. Thus this function, which handles this\n    -- corner case.\n    eqFunTy :: RnEnv2 -> Type -> Type -> Type -> Bool\n               -- Last arg is /not/ FunTy\n    eqFunTy env arg res ty@(AppTy{}) = get_args ty []\n      where\n        get_args :: Type -> [Type] -> Bool\n        get_args (AppTy f x)       args = get_args f (x:args)\n        get_args (CastTy t _)      args = get_args t args\n        get_args (TyConApp tc tys) args\n          | tc == funTyCon\n          , [_, _, arg', res'] <- tys ++ args\n          = go env arg arg' && go env res res'\n        get_args _ _    = False\n    eqFunTy _ _ _ _     = False\n\n{- *********************************************************************\n*                                                                      *\n                       Predicate types\n*                                                                      *\n************************************************************************\n\nDeconstructors and tests on predicate types\n\nNote [Kind polymorphic type classes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    class C f where...   -- C :: forall k. k -> Constraint\n    g :: forall (f::*). C f => f -> f\n\nHere the (C f) in the signature is really (C * f), and we\ndon't want to complain that the * isn't a type variable!\n-}\n\nisTyVarClassPred :: PredType -> Bool\nisTyVarClassPred ty = case getClassPredTys_maybe ty of\n    Just (_, tys) -> all isTyVarTy tys\n    _             -> False\n\n-------------------------\ncheckValidClsArgs :: Bool -> Class -> [KindOrType] -> Bool\n-- If the Bool is True (flexible contexts), return True (i.e. ok)\n-- Otherwise, check that the type (not kind) args are all headed by a tyvar\n--   E.g. (Eq a) accepted, (Eq (f a)) accepted, but (Eq Int) rejected\n-- This function is here rather than in TcValidity because it is\n-- called from TcSimplify, which itself is imported by TcValidity\ncheckValidClsArgs flexible_contexts cls kts\n  | flexible_contexts = True\n  | otherwise         = all hasTyVarHead tys\n  where\n    tys = filterOutInvisibleTypes (classTyCon cls) kts\n\nhasTyVarHead :: Type -> Bool\n-- Returns true of (a t1 .. tn), where 'a' is a type variable\nhasTyVarHead ty                 -- Haskell 98 allows predicates of form\n  | tcIsTyVarTy ty = True       --      C (a ty1 .. tyn)\n  | otherwise                   -- where a is a type variable\n  = case tcSplitAppTy_maybe ty of\n       Just (ty, _) -> hasTyVarHead ty\n       Nothing      -> False\n\nevVarPred :: EvVar -> PredType\nevVarPred var\n  = ASSERT2( isEvVarType var_ty, ppr var <+> dcolon <+> ppr var_ty )\n    var_ty\n where\n    var_ty = varType var\n\n------------------\n-- | When inferring types, should we quantify over a given predicate?\n-- Generally true of classes; generally false of equality constraints.\n-- Equality constraints that mention quantified type variables and\n-- implicit variables complicate the story. See Notes\n-- [Inheriting implicit parameters] and [Quantifying over equality constraints]\npickQuantifiablePreds\n  :: TyVarSet           -- Quantifying over these\n  -> TcThetaType        -- Proposed constraints to quantify\n  -> TcThetaType        -- A subset that we can actually quantify\n-- This function decides whether a particular constraint should be\n-- quantified over, given the type variables that are being quantified\npickQuantifiablePreds qtvs theta\n  = let flex_ctxt = True in  -- Quantify over non-tyvar constraints, even without\n                             -- -XFlexibleContexts: see Trac #10608, #10351\n         -- flex_ctxt <- xoptM Opt_FlexibleContexts\n    mapMaybe (pick_me flex_ctxt) theta\n  where\n    pick_me flex_ctxt pred\n      = case classifyPredType pred of\n\n          ClassPred cls tys\n            | Just {} <- isCallStackPred cls tys\n              -- NEVER infer a CallStack constraint.  Otherwise we let\n              -- the constraints bubble up to be solved from the outer\n              -- context, or be defaulted when we reach the top-level.\n              -- See Note [Overview of implicit CallStacks]\n            -> Nothing\n\n            | isIPClass cls\n            -> Just pred -- See note [Inheriting implicit parameters]\n\n            | pick_cls_pred flex_ctxt cls tys\n            -> Just pred\n\n          EqPred eq_rel ty1 ty2\n            | quantify_equality eq_rel ty1 ty2\n            , Just (cls, tys) <- boxEqPred eq_rel ty1 ty2\n              -- boxEqPred: See Note [Lift equality constaints when quantifying]\n            , pick_cls_pred flex_ctxt cls tys\n            -> Just (mkClassPred cls tys)\n\n          IrredPred ty\n            | tyCoVarsOfType ty `intersectsVarSet` qtvs\n            -> Just pred\n\n          _ -> Nothing\n\n\n    pick_cls_pred flex_ctxt cls tys\n      = tyCoVarsOfTypes tys `intersectsVarSet` qtvs\n        && (checkValidClsArgs flex_ctxt cls tys)\n           -- Only quantify over predicates that checkValidType\n           -- will pass!  See Trac #10351.\n\n    -- See Note [Quantifying over equality constraints]\n    quantify_equality NomEq  ty1 ty2 = quant_fun ty1 || quant_fun ty2\n    quantify_equality ReprEq _   _   = True\n\n    quant_fun ty\n      = case tcSplitTyConApp_maybe ty of\n          Just (tc, tys) | isTypeFamilyTyCon tc\n                         -> tyCoVarsOfTypes tys `intersectsVarSet` qtvs\n          _ -> False\n\nboxEqPred :: EqRel -> Type -> Type -> Maybe (Class, [Type])\n-- Given (t1 ~# t2) or (t1 ~R# t2) return the boxed version\n--       (t1 ~ t2)  or (t1 `Coercible` t2)\nboxEqPred eq_rel ty1 ty2\n  = case eq_rel of\n      NomEq  | homo_kind -> Just (eqClass,        [k1,     ty1, ty2])\n             | otherwise -> Just (heqClass,       [k1, k2, ty1, ty2])\n      ReprEq | homo_kind -> Just (coercibleClass, [k1,     ty1, ty2])\n             | otherwise -> Nothing -- Sigh: we do not have hererogeneous Coercible\n                                    --       so we can't abstract over it\n                                    -- Nothing fundamental: we could add it\n where\n   k1 = tcTypeKind ty1\n   k2 = tcTypeKind ty2\n   homo_kind = k1 `tcEqType` k2\n\npickCapturedPreds\n  :: TyVarSet           -- Quantifying over these\n  -> TcThetaType        -- Proposed constraints to quantify\n  -> TcThetaType        -- A subset that we can actually quantify\n-- A simpler version of pickQuantifiablePreds, used to winnow down\n-- the inferred constraints of a group of bindings, into those for\n-- one particular identifier\npickCapturedPreds qtvs theta\n  = filter captured theta\n  where\n    captured pred = isIPPred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs)\n\n\n-- Superclasses\n\ntype PredWithSCs a = (PredType, [PredType], a)\n\nmkMinimalBySCs :: forall a. (a -> PredType) -> [a] -> [a]\n-- Remove predicates that\n--\n--   - are the same as another predicate\n--\n--   - can be deduced from another by superclasses,\n--\n--   - are a reflexive equality (e.g  * ~ *)\n--     (see Note [Remove redundant provided dicts] in TcPatSyn)\n--\n-- The result is a subset of the input.\n-- The 'a' is just paired up with the PredType;\n--   typically it might be a dictionary Id\nmkMinimalBySCs get_pred xs = go preds_with_scs []\n where\n   preds_with_scs :: [PredWithSCs a]\n   preds_with_scs = [ (pred, pred : transSuperClasses pred, x)\n                    | x <- xs\n                    , let pred = get_pred x ]\n\n   go :: [PredWithSCs a]   -- Work list\n      -> [PredWithSCs a]   -- Accumulating result\n      -> [a]\n   go [] min_preds\n     = reverse (map thdOf3 min_preds)\n       -- The 'reverse' isn't strictly necessary, but it\n       -- means that the results are returned in the same\n       -- order as the input, which is generally saner\n   go (work_item@(p,_,_) : work_list) min_preds\n     | EqPred _ t1 t2 <- classifyPredType p\n     , t1 `tcEqType` t2   -- See TcPatSyn\n                          -- Note [Remove redundant provided dicts]\n     = go work_list min_preds\n     | p `in_cloud` work_list || p `in_cloud` min_preds\n     = go work_list min_preds\n     | otherwise\n     = go work_list (work_item : min_preds)\n\n   in_cloud :: PredType -> [PredWithSCs a] -> Bool\n   in_cloud p ps = or [ p `tcEqType` p' | (_, scs, _) <- ps, p' <- scs ]\n\ntransSuperClasses :: PredType -> [PredType]\n-- (transSuperClasses p) returns (p's superclasses) not including p\n-- Stop if you encounter the same class again\n-- See Note [Expanding superclasses]\ntransSuperClasses p\n  = go emptyNameSet p\n  where\n    go :: NameSet -> PredType -> [PredType]\n    go rec_clss p\n       | ClassPred cls tys <- classifyPredType p\n       , let cls_nm = className cls\n       , not (cls_nm `elemNameSet` rec_clss)\n       , let rec_clss' | isCTupleClass cls = rec_clss\n                       | otherwise         = rec_clss `extendNameSet` cls_nm\n       = [ p' | sc <- immSuperClasses cls tys\n              , p'  <- sc : go rec_clss' sc ]\n       | otherwise\n       = []\n\nimmSuperClasses :: Class -> [Type] -> [PredType]\nimmSuperClasses cls tys\n  = substTheta (zipTvSubst tyvars tys) sc_theta\n  where\n    (tyvars,sc_theta,_,_) = classBigSig cls\n\nisImprovementPred :: PredType -> Bool\n-- Either it's an equality, or has some functional dependency\nisImprovementPred ty\n  = case classifyPredType ty of\n      EqPred NomEq t1 t2 -> not (t1 `tcEqType` t2)\n      EqPred ReprEq _ _  -> False\n      ClassPred cls _    -> classHasFds cls\n      IrredPred {}       -> True -- Might have equalities after reduction?\n      ForAllPred {}      -> False\n\n-- | Is the equality\n--        a ~r ...a....\n-- definitely insoluble or not?\n--      a ~r Maybe a      -- Definitely insoluble\n--      a ~N ...(F a)...  -- Not definitely insoluble\n--                        -- Perhaps (F a) reduces to Int\n--      a ~R ...(N a)...  -- Not definitely insoluble\n--                        -- Perhaps newtype N a = MkN Int\n-- See Note [Occurs check error] in\n-- TcCanonical for the motivation for this function.\nisInsolubleOccursCheck :: EqRel -> TcTyVar -> TcType -> Bool\nisInsolubleOccursCheck eq_rel tv ty\n  = go ty\n  where\n    go ty | Just ty' <- tcView ty = go ty'\n    go (TyVarTy tv') = tv == tv' || go (tyVarKind tv')\n    go (LitTy {})    = False\n    go (AppTy t1 t2) = case eq_rel of  -- See Note [AppTy and ReprEq]\n                         NomEq  -> go t1 || go t2\n                         ReprEq -> go t1\n    go (FunTy _ t1 t2) = go t1 || go t2\n    go (ForAllTy (Bndr tv' _) inner_ty)\n      | tv' == tv = False\n      | otherwise = go (varType tv') || go inner_ty\n    go (CastTy ty _)  = go ty   -- ToDo: what about the coercion\n    go (CoercionTy _) = False   -- ToDo: what about the coercion\n    go (TyConApp tc tys)\n      | isGenerativeTyCon tc role = any go tys\n      | otherwise                 = any go (drop (tyConArity tc) tys)\n         -- (a ~ F b a), where F has arity 1,\n         -- has an insoluble occurs check\n\n    role = eqRelRole eq_rel\n\n{- Note [Expanding superclasses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we expand superclasses, we use the following algorithm:\n\nexpand( so_far, pred ) returns the transitive superclasses of pred,\n                               not including pred itself\n 1. If pred is not a class constraint, return empty set\n       Otherwise pred = C ts\n 2. If C is in so_far, return empty set (breaks loops)\n 3. Find the immediate superclasses constraints of (C ts)\n 4. For each such sc_pred, return (sc_pred : expand( so_far+C, D ss )\n\nNotice that\n\n * With normal Haskell-98 classes, the loop-detector will never bite,\n   so we'll get all the superclasses.\n\n * Since there is only a finite number of distinct classes, expansion\n   must terminate.\n\n * The loop breaking is a bit conservative. Notably, a tuple class\n   could contain many times without threatening termination:\n      (Eq a, (Ord a, Ix a))\n   And this is try of any class that we can statically guarantee\n   as non-recursive (in some sense).  For now, we just make a special\n   case for tuples.  Something better would be cool.\n\nSee also TcTyDecls.checkClassCycles.\n\nNote [Lift equality constaints when quantifying]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe can't quantify over a constraint (t1 ~# t2) because that isn't a\npredicate type; see Note [Types for coercions, predicates, and evidence]\nin Type.hs.\n\nSo we have to 'lift' it to (t1 ~ t2).  Similarly (~R#) must be lifted\nto Coercible.\n\nThis tiresome lifting is the reason that pick_me (in\npickQuantifiablePreds) returns a Maybe rather than a Bool.\n\nNote [Quantifying over equality constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nShould we quantify over an equality constraint (s ~ t)?  In general, we don't.\nDoing so may simply postpone a type error from the function definition site to\nits call site.  (At worst, imagine (Int ~ Bool)).\n\nHowever, consider this\n         forall a. (F [a] ~ Int) => blah\nShould we quantify over the (F [a] ~ Int)?  Perhaps yes, because at the call\nsite we will know 'a', and perhaps we have instance  F [Bool] = Int.\nSo we *do* quantify over a type-family equality where the arguments mention\nthe quantified variables.\n\nNote [Inheriting implicit parameters]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this:\n\n        f x = (x::Int) + ?y\n\nwhere f is *not* a top-level binding.\nFrom the RHS of f we'll get the constraint (?y::Int).\nThere are two types we might infer for f:\n\n        f :: Int -> Int\n\n(so we get ?y from the context of f's definition), or\n\n        f :: (?y::Int) => Int -> Int\n\nAt first you might think the first was better, because then\n?y behaves like a free variable of the definition, rather than\nhaving to be passed at each call site.  But of course, the WHOLE\nIDEA is that ?y should be passed at each call site (that's what\ndynamic binding means) so we'd better infer the second.\n\nBOTTOM LINE: when *inferring types* you must quantify over implicit\nparameters, *even if* they don't mention the bound type variables.\nReason: because implicit parameters, uniquely, have local instance\ndeclarations. See pickQuantifiablePreds.\n\nNote [Quantifying over equality constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nShould we quantify over an equality constraint (s ~ t)?  In general, we don't.\nDoing so may simply postpone a type error from the function definition site to\nits call site.  (At worst, imagine (Int ~ Bool)).\n\nHowever, consider this\n         forall a. (F [a] ~ Int) => blah\nShould we quantify over the (F [a] ~ Int).  Perhaps yes, because at the call\nsite we will know 'a', and perhaps we have instance  F [Bool] = Int.\nSo we *do* quantify over a type-family equality where the arguments mention\nthe quantified variables.\n\n************************************************************************\n*                                                                      *\n      Classifying types\n*                                                                      *\n************************************************************************\n-}\n\nisSigmaTy :: TcType -> Bool\n-- isSigmaTy returns true of any qualified type.  It doesn't\n-- *necessarily* have any foralls.  E.g\n--        f :: (?x::Int) => Int -> Int\nisSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'\nisSigmaTy (ForAllTy {})                = True\nisSigmaTy (FunTy { ft_af = InvisArg }) = True\nisSigmaTy _                            = False\n\nisRhoTy :: TcType -> Bool   -- True of TcRhoTypes; see Note [TcRhoType]\nisRhoTy ty | Just ty' <- tcView ty = isRhoTy ty'\nisRhoTy (ForAllTy {})                          = False\nisRhoTy (FunTy { ft_af = VisArg, ft_res = r }) = isRhoTy r\nisRhoTy _                                      = True\n\n-- | Like 'isRhoTy', but also says 'True' for 'Infer' types\nisRhoExpTy :: ExpType -> Bool\nisRhoExpTy (Check ty) = isRhoTy ty\nisRhoExpTy (Infer {}) = True\n\nisOverloadedTy :: Type -> Bool\n-- Yes for a type of a function that might require evidence-passing\n-- Used only by bindLocalMethods\nisOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'\nisOverloadedTy (ForAllTy _  ty)             = isOverloadedTy ty\nisOverloadedTy (FunTy { ft_af = InvisArg }) = True\nisOverloadedTy _                            = False\n\nisFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,\n    isUnitTy, isCharTy, isAnyTy :: Type -> Bool\nisFloatTy      = is_tc floatTyConKey\nisDoubleTy     = is_tc doubleTyConKey\nisIntegerTy    = is_tc integerTyConKey\nisIntTy        = is_tc intTyConKey\nisWordTy       = is_tc wordTyConKey\nisBoolTy       = is_tc boolTyConKey\nisUnitTy       = is_tc unitTyConKey\nisCharTy       = is_tc charTyConKey\nisAnyTy        = is_tc anyTyConKey\n\n-- | Does a type represent a floating-point number?\nisFloatingTy :: Type -> Bool\nisFloatingTy ty = isFloatTy ty || isDoubleTy ty\n\n-- | Is a type 'String'?\nisStringTy :: Type -> Bool\nisStringTy ty\n  = case tcSplitTyConApp_maybe ty of\n      Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty\n      _                   -> False\n\n-- | Is a type a 'CallStack'?\nisCallStackTy :: Type -> Bool\nisCallStackTy ty\n  | Just tc <- tyConAppTyCon_maybe ty\n  = tc `hasKey` callStackTyConKey\n  | otherwise\n  = False\n\n-- | Is a 'PredType' a 'CallStack' implicit parameter?\n--\n-- If so, return the name of the parameter.\nisCallStackPred :: Class -> [Type] -> Maybe FastString\nisCallStackPred cls tys\n  | [ty1, ty2] <- tys\n  , isIPClass cls\n  , isCallStackTy ty2\n  = isStrLitTy ty1\n  | otherwise\n  = Nothing\n\nhasIPPred :: PredType -> Bool\nhasIPPred pred\n  = case classifyPredType pred of\n      ClassPred cls tys\n        | isIPClass     cls -> True\n        | isCTupleClass cls -> any hasIPPred tys\n      _other -> False\n\nis_tc :: Unique -> Type -> Bool\n-- Newtypes are opaque to this\nis_tc uniq ty = case tcSplitTyConApp_maybe ty of\n                        Just (tc, _) -> uniq == getUnique tc\n                        Nothing      -> False\n\n-- | Does the given tyvar appear at the head of a chain of applications\n--     (a t1 ... tn)\nisTyVarHead :: TcTyVar -> TcType -> Bool\nisTyVarHead tv (TyVarTy tv')   = tv == tv'\nisTyVarHead tv (AppTy fun _)   = isTyVarHead tv fun\nisTyVarHead tv (CastTy ty _)   = isTyVarHead tv ty\nisTyVarHead _ (TyConApp {})    = False\nisTyVarHead _  (LitTy {})      = False\nisTyVarHead _  (ForAllTy {})   = False\nisTyVarHead _  (FunTy {})      = False\nisTyVarHead _  (CoercionTy {}) = False\n\n\n{- Note [AppTy and ReprEq]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider   a ~R# b a\n           a ~R# a b\n\nThe former is /not/ a definite error; we might instantiate 'b' with Id\n   newtype Id a = MkId a\nbut the latter /is/ a definite error.\n\nOn the other hand, with nominal equality, both are definite errors\n-}\n\nisRigidTy :: TcType -> Bool\nisRigidTy ty\n  | Just (tc,_) <- tcSplitTyConApp_maybe ty = isGenerativeTyCon tc Nominal\n  | Just {} <- tcSplitAppTy_maybe ty        = True\n  | isForAllTy ty                           = True\n  | otherwise                               = False\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Misc}\n*                                                                      *\n************************************************************************\n\nNote [Visible type application]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC implements a generalisation of the algorithm described in the\n\"Visible Type Application\" paper (available from\nhttp://www.cis.upenn.edu/~sweirich/publications.html). A key part\nof that algorithm is to distinguish user-specified variables from inferred\nvariables. For example, the following should typecheck:\n\n  f :: forall a b. a -> b -> b\n  f = const id\n\n  g = const id\n\n  x = f @Int @Bool 5 False\n  y = g 5 @Bool False\n\nThe idea is that we wish to allow visible type application when we are\ninstantiating a specified, fixed variable. In practice, specified, fixed\nvariables are either written in a type signature (or\nannotation), OR are imported from another module. (We could do better here,\nfor example by doing SCC analysis on parts of a module and considering any\ntype from outside one's SCC to be fully specified, but this is very confusing to\nusers. The simple rule above is much more straightforward and predictable.)\n\nSo, both of f's quantified variables are specified and may be instantiated.\nBut g has no type signature, so only id's variable is specified (because id\nis imported). We write the type of g as forall {a}. a -> forall b. b -> b.\nNote that the a is in braces, meaning it cannot be instantiated with\nvisible type application.\n\nTracking specified vs. inferred variables is done conveniently by a field\nin TyBinder.\n\n-}\n\ndeNoteType :: Type -> Type\n-- Remove all *outermost* type synonyms and other notes\ndeNoteType ty | Just ty' <- coreView ty = deNoteType ty'\ndeNoteType ty = ty\n\n{-\nFind the free tycons and classes of a type.  This is used in the front\nend of the compiler.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TysWiredIn-ext-type]{External types}\n*                                                                      *\n************************************************************************\n\nThe compiler's foreign function interface supports the passing of a\nrestricted set of types as arguments and results (the restricting factor\nbeing the )\n-}\n\ntcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)\n-- (tcSplitIOType_maybe t) returns Just (IO,t',co)\n--              if co : t ~ IO t'\n--              returns Nothing otherwise\ntcSplitIOType_maybe ty\n  = case tcSplitTyConApp_maybe ty of\n        Just (io_tycon, [io_res_ty])\n         | io_tycon `hasKey` ioTyConKey ->\n            Just (io_tycon, io_res_ty)\n        _ ->\n            Nothing\n\nisFFITy :: Type -> Bool\n-- True for any TyCon that can possibly be an arg or result of an FFI call\nisFFITy ty = isValid (checkRepTyCon legalFFITyCon ty)\n\nisFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity\n-- Checks for valid argument type for a 'foreign import'\nisFFIArgumentTy dflags safety ty\n   = checkRepTyCon (legalOutgoingTyCon dflags safety) ty\n\nisFFIExternalTy :: Type -> Validity\n-- Types that are allowed as arguments of a 'foreign export'\nisFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty\n\nisFFIImportResultTy :: DynFlags -> Type -> Validity\nisFFIImportResultTy dflags ty\n  = checkRepTyCon (legalFIResultTyCon dflags) ty\n\nisFFIExportResultTy :: Type -> Validity\nisFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty\n\nisFFIDynTy :: Type -> Type -> Validity\n-- The type in a foreign import dynamic must be Ptr, FunPtr, or a newtype of\n-- either, and the wrapped function type must be equal to the given type.\n-- We assume that all types have been run through normaliseFfiType, so we don't\n-- need to worry about expanding newtypes here.\nisFFIDynTy expected ty\n    -- Note [Foreign import dynamic]\n    -- In the example below, expected would be 'CInt -> IO ()', while ty would\n    -- be 'FunPtr (CDouble -> IO ())'.\n    | Just (tc, [ty']) <- splitTyConApp_maybe ty\n    , tyConUnique tc `elem` [ptrTyConKey, funPtrTyConKey]\n    , eqType ty' expected\n    = IsValid\n    | otherwise\n    = NotValid (vcat [ text \"Expected: Ptr/FunPtr\" <+> pprParendType expected <> comma\n                     , text \"  Actual:\" <+> ppr ty ])\n\nisFFILabelTy :: Type -> Validity\n-- The type of a foreign label must be Ptr, FunPtr, or a newtype of either.\nisFFILabelTy ty = checkRepTyCon ok ty\n  where\n    ok tc | tc `hasKey` funPtrTyConKey || tc `hasKey` ptrTyConKey\n          = IsValid\n          | otherwise\n          = NotValid (text \"A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)\")\n\nisFFIPrimArgumentTy :: DynFlags -> Type -> Validity\n-- Checks for valid argument type for a 'foreign import prim'\n-- Currently they must all be simple unlifted types, or the well-known type\n-- Any, which can be used to pass the address to a Haskell object on the heap to\n-- the foreign function.\nisFFIPrimArgumentTy dflags ty\n  | isAnyTy ty = IsValid\n  | otherwise  = checkRepTyCon (legalFIPrimArgTyCon dflags) ty\n\nisFFIPrimResultTy :: DynFlags -> Type -> Validity\n-- Checks for valid result type for a 'foreign import prim' Currently\n-- it must be an unlifted type, including unboxed tuples, unboxed\n-- sums, or the well-known type Any.\nisFFIPrimResultTy dflags ty\n  | isAnyTy ty = IsValid\n  | otherwise = checkRepTyCon (legalFIPrimResultTyCon dflags) ty\n\nisFunPtrTy :: Type -> Bool\nisFunPtrTy ty\n  | Just (tc, [_]) <- splitTyConApp_maybe ty\n  = tc `hasKey` funPtrTyConKey\n  | otherwise\n  = False\n\n-- normaliseFfiType gets run before checkRepTyCon, so we don't\n-- need to worry about looking through newtypes or type functions\n-- here; that's already been taken care of.\ncheckRepTyCon :: (TyCon -> Validity) -> Type -> Validity\ncheckRepTyCon check_tc ty\n  = case splitTyConApp_maybe ty of\n      Just (tc, tys)\n        | isNewTyCon tc -> NotValid (hang msg 2 (mk_nt_reason tc tys $$ nt_fix))\n        | otherwise     -> case check_tc tc of\n                             IsValid        -> IsValid\n                             NotValid extra -> NotValid (msg $$ extra)\n      Nothing -> NotValid (quotes (ppr ty) <+> text \"is not a data type\")\n  where\n    msg = quotes (ppr ty) <+> text \"cannot be marshalled in a foreign call\"\n    mk_nt_reason tc tys\n      | null tys  = text \"because its data constructor is not in scope\"\n      | otherwise = text \"because the data constructor for\"\n                    <+> quotes (ppr tc) <+> text \"is not in scope\"\n    nt_fix = text \"Possible fix: import the data constructor to bring it into scope\"\n\n{-\nNote [Foreign import dynamic]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA dynamic stub must be of the form 'FunPtr ft -> ft' where ft is any foreign\ntype.  Similarly, a wrapper stub must be of the form 'ft -> IO (FunPtr ft)'.\n\nWe use isFFIDynTy to check whether a signature is well-formed. For example,\ngiven a (illegal) declaration like:\n\nforeign import ccall \"dynamic\"\n  foo :: FunPtr (CDouble -> IO ()) -> CInt -> IO ()\n\nisFFIDynTy will compare the 'FunPtr' type 'CDouble -> IO ()' with the curried\nresult type 'CInt -> IO ()', and return False, as they are not equal.\n\n\n----------------------------------------------\nThese chaps do the work; they are not exported\n----------------------------------------------\n-}\n\nlegalFEArgTyCon :: TyCon -> Validity\nlegalFEArgTyCon tc\n  -- It's illegal to make foreign exports that take unboxed\n  -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000\n  = boxedMarshalableTyCon tc\n\nlegalFIResultTyCon :: DynFlags -> TyCon -> Validity\nlegalFIResultTyCon dflags tc\n  | tc == unitTyCon         = IsValid\n  | otherwise               = marshalableTyCon dflags tc\n\nlegalFEResultTyCon :: TyCon -> Validity\nlegalFEResultTyCon tc\n  | tc == unitTyCon         = IsValid\n  | otherwise               = boxedMarshalableTyCon tc\n\nlegalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Validity\n-- Checks validity of types going from Haskell -> external world\nlegalOutgoingTyCon dflags _ tc\n  = marshalableTyCon dflags tc\n\nlegalFFITyCon :: TyCon -> Validity\n-- True for any TyCon that can possibly be an arg or result of an FFI call\nlegalFFITyCon tc\n  | isUnliftedTyCon tc = IsValid\n  | tc == unitTyCon    = IsValid\n  | otherwise          = boxedMarshalableTyCon tc\n\nmarshalableTyCon :: DynFlags -> TyCon -> Validity\nmarshalableTyCon dflags tc\n  | isUnliftedTyCon tc\n  , not (isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc)\n  , not (null (tyConPrimRep tc)) -- Note [Marshalling void]\n  = validIfUnliftedFFITypes dflags\n  | otherwise\n  = boxedMarshalableTyCon tc\n\nboxedMarshalableTyCon :: TyCon -> Validity\nboxedMarshalableTyCon tc\n   | getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey\n                         , int32TyConKey, int64TyConKey\n                         , wordTyConKey, word8TyConKey, word16TyConKey\n                         , word32TyConKey, word64TyConKey\n                         , floatTyConKey, doubleTyConKey\n                         , ptrTyConKey, funPtrTyConKey\n                         , charTyConKey\n                         , stablePtrTyConKey\n                         , boolTyConKey\n                         ]\n  = IsValid\n\n  | otherwise = NotValid empty\n\nlegalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity\n-- Check args of 'foreign import prim', only allow simple unlifted types.\n-- Strictly speaking it is unnecessary to ban unboxed tuples and sums here since\n-- currently they're of the wrong kind to use in function args anyway.\nlegalFIPrimArgTyCon dflags tc\n  | isUnliftedTyCon tc\n  , not (isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc)\n  = validIfUnliftedFFITypes dflags\n  | otherwise\n  = NotValid unlifted_only\n\nlegalFIPrimResultTyCon :: DynFlags -> TyCon -> Validity\n-- Check result type of 'foreign import prim'. Allow simple unlifted\n-- types and also unboxed tuple and sum result types.\nlegalFIPrimResultTyCon dflags tc\n  | isUnliftedTyCon tc\n  , isUnboxedTupleTyCon tc || isUnboxedSumTyCon tc\n     || not (null (tyConPrimRep tc))   -- Note [Marshalling void]\n  = validIfUnliftedFFITypes dflags\n\n  | otherwise\n  = NotValid unlifted_only\n\nunlifted_only :: MsgDoc\nunlifted_only = text \"foreign import prim only accepts simple unlifted types\"\n\nvalidIfUnliftedFFITypes :: DynFlags -> Validity\nvalidIfUnliftedFFITypes dflags\n  | xopt LangExt.UnliftedFFITypes dflags =  IsValid\n  | otherwise = NotValid (text \"To marshal unlifted types, use UnliftedFFITypes\")\n\n{-\nNote [Marshalling void]\n~~~~~~~~~~~~~~~~~~~~~~~\nWe don't treat State# (whose PrimRep is VoidRep) as marshalable.\nIn turn that means you can't write\n        foreign import foo :: Int -> State# RealWorld\n\nReason: the back end falls over with panic \"primRepHint:VoidRep\";\n        and there is no compelling reason to permit it\n-}\n\n{-\n************************************************************************\n*                                                                      *\n        The \"Paterson size\" of a type\n*                                                                      *\n************************************************************************\n-}\n\n{-\nNote [Paterson conditions on PredTypes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe are considering whether *class* constraints terminate\n(see Note [Paterson conditions]). Precisely, the Paterson conditions\nwould have us check that \"the constraint has fewer constructors and variables\n(taken together and counting repetitions) than the head.\".\n\nHowever, we can be a bit more refined by looking at which kind of constraint\nthis actually is. There are two main tricks:\n\n 1. It seems like it should be OK not to count the tuple type constructor\n    for a PredType like (Show a, Eq a) :: Constraint, since we don't\n    count the \"implicit\" tuple in the ThetaType itself.\n\n    In fact, the Paterson test just checks *each component* of the top level\n    ThetaType against the size bound, one at a time. By analogy, it should be\n    OK to return the size of the *largest* tuple component as the size of the\n    whole tuple.\n\n 2. Once we get into an implicit parameter or equality we\n    can't get back to a class constraint, so it's safe\n    to say \"size 0\".  See Trac #4200.\n\nNB: we don't want to detect PredTypes in sizeType (and then call\nsizePred on them), or we might get an infinite loop if that PredType\nis irreducible. See Trac #5581.\n-}\n\ntype TypeSize = IntWithInf\n\nsizeType :: Type -> TypeSize\n-- Size of a type: the number of variables and constructors\n-- Ignore kinds altogether\nsizeType = go\n  where\n    go ty | Just exp_ty <- tcView ty = go exp_ty\n    go (TyVarTy {})              = 1\n    go (TyConApp tc tys)\n      | isTypeFamilyTyCon tc     = infinity  -- Type-family applications can\n                                             -- expand to any arbitrary size\n      | otherwise                = sizeTypes (filterOutInvisibleTypes tc tys) + 1\n                                   -- Why filter out invisible args?  I suppose any\n                                   -- size ordering is sound, but why is this better?\n                                   -- I came across this when investigating #14010.\n    go (LitTy {})                = 1\n    go (FunTy _ arg res)         = go arg + go res + 1\n    go (AppTy fun arg)           = go fun + go arg\n    go (ForAllTy (Bndr tv vis) ty)\n        | isVisibleArgFlag vis   = go (tyVarKind tv) + go ty + 1\n        | otherwise              = go ty + 1\n    go (CastTy ty _)             = go ty\n    go (CoercionTy {})           = 0\n\nsizeTypes :: [Type] -> TypeSize\nsizeTypes tys = sum (map sizeType tys)\n\n-----------------------------------------------------------------------------------\n-----------------------------------------------------------------------------------\n-----------------------\n-- | For every arg a tycon can take, the returned list says True if the argument\n-- is taken visibly, and False otherwise. Ends with an infinite tail of Trues to\n-- allow for oversaturation.\ntcTyConVisibilities :: TyCon -> [Bool]\ntcTyConVisibilities tc = tc_binder_viss ++ tc_return_kind_viss ++ repeat True\n  where\n    tc_binder_viss      = map isVisibleTyConBinder (tyConBinders tc)\n    tc_return_kind_viss = map isVisibleBinder (fst $ tcSplitPiTys (tyConResKind tc))\n\n-- | If the tycon is applied to the types, is the next argument visible?\nisNextTyConArgVisible :: TyCon -> [Type] -> Bool\nisNextTyConArgVisible tc tys\n  = tcTyConVisibilities tc `getNth` length tys\n\n-- | Should this type be applied to a visible argument?\nisNextArgVisible :: TcType -> Bool\nisNextArgVisible ty\n  | Just (bndr, _) <- tcSplitPiTy_maybe ty = isVisibleBinder bndr\n  | otherwise                              = True\n    -- this second case might happen if, say, we have an unzonked TauTv.\n    -- But TauTvs can't range over types that take invisible arguments\n", "num_lines": 2600}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1999\n-}\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule TcTypeable(mkTypeableBinds) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BasicTypes ( Boxity(..), neverInlinePragma, SourceText(..) )\nimport TcBinds( addTypecheckedBinds )\nimport IfaceEnv( newGlobalBinder )\nimport TyCoRep( Type(..), TyLit(..) )\nimport TcEnv\nimport TcEvidence ( mkWpTyApps )\nimport TcRnMonad\nimport HscTypes ( lookupId )\nimport PrelNames\nimport TysPrim ( primTyCons )\nimport TysWiredIn ( tupleTyCon, sumTyCon, runtimeRepTyCon\n                  , vecCountTyCon, vecElemTyCon\n                  , nilDataCon, consDataCon )\nimport Name\nimport Id\nimport Type\nimport TyCon\nimport DataCon\nimport Module\nimport HsSyn\nimport DynFlags\nimport Bag\nimport Var ( VarBndr(..) )\nimport CoreMap\nimport Constants\nimport Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints)\nimport Outputable\nimport FastString ( FastString, mkFastString, fsLit )\n\nimport Control.Monad.Trans.State\nimport Control.Monad.Trans.Class (lift)\nimport Data.Maybe ( isJust )\nimport Data.Word( Word64 )\n\n{- Note [Grand plan for Typeable]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe overall plan is this:\n\n1. Generate a binding for each module p:M\n   (done in TcTypeable by mkModIdBindings)\n       M.$trModule :: GHC.Types.Module\n       M.$trModule = Module \"p\" \"M\"\n   (\"tr\" is short for \"type representation\"; see GHC.Types)\n\n   We might want to add the filename too.\n   This can be used for the lightweight stack-tracing stuff too\n\n   Record the Name M.$trModule in the tcg_tr_module field of TcGblEnv\n\n2. Generate a binding for every data type declaration T in module M,\n       M.$tcT :: GHC.Types.TyCon\n       M.$tcT = TyCon ...fingerprint info...\n                      $trModule\n                      \"T\"\n                      0#\n                      kind_rep\n\n   Here 0# is the number of arguments expected by the tycon to fully determine\n   its kind. kind_rep is a value of type GHC.Types.KindRep, which gives a\n   recipe for computing the kind of an instantiation of the tycon (see\n   Note [Representing TyCon kinds: KindRep] later in this file for details).\n\n   We define (in TyCon)\n\n        type TyConRepName = Name\n\n   to use for these M.$tcT \"tycon rep names\". Note that these must be\n   treated as \"never exported\" names by Backpack (see\n   Note [Handling never-exported TyThings under Backpack]). Consequently\n   they get slightly special treatment in RnModIface.rnIfaceDecl.\n\n3. Record the TyConRepName in T's TyCon, including for promoted\n   data and type constructors, and kinds like * and #.\n\n   The TyConRepName is not an \"implicit Id\".  It's more like a record\n   selector: the TyCon knows its name but you have to go to the\n   interface file to find its type, value, etc\n\n4. Solve Typeable constraints.  This is done by a custom Typeable solver,\n   currently in TcInteract, that use M.$tcT so solve (Typeable T).\n\nThere are many wrinkles:\n\n* The timing of when we produce this bindings is rather important: they must be\n  defined after the rest of the module has been typechecked since we need to be\n  able to lookup Module and TyCon in the type environment and we may be\n  currently compiling GHC.Types (where they are defined).\n\n* GHC.Prim doesn't have any associated object code, so we need to put the\n  representations for types defined in this module elsewhere. We chose this\n  place to be GHC.Types. TcTypeable.mkPrimTypeableBinds is responsible for\n  injecting the bindings for the GHC.Prim representions when compiling\n  GHC.Types.\n\n* TyCon.tyConRepModOcc is responsible for determining where to find\n  the representation binding for a given type. This is where we handle\n  the special case for GHC.Prim.\n\n* To save space and reduce dependencies, we need use quite low-level\n  representations for TyCon and Module.  See GHC.Types\n  Note [Runtime representation of modules and tycons]\n\n* The KindReps can unfortunately get quite large. Moreover, the simplifier will\n  float out various pieces of them, resulting in numerous top-level bindings.\n  Consequently we mark the KindRep bindings as noinline, ensuring that the\n  float-outs don't make it into the interface file. This is important since\n  there is generally little benefit to inlining KindReps and they would\n  otherwise strongly affect compiler performance.\n\n* In general there are lots of things of kind *, * -> *, and * -> * -> *. To\n  reduce the number of bindings we need to produce, we generate their KindReps\n  once in GHC.Types. These are referred to as \"built-in\" KindReps below.\n\n* Even though KindReps aren't inlined, this scheme still has more of an effect on\n  compilation time than I'd like. This is especially true in the case of\n  families of type constructors (e.g. tuples and unboxed sums). The problem is\n  particularly bad in the case of sums, since each arity-N tycon brings with it\n  N promoted datacons, each with a KindRep whose size also scales with N.\n  Consequently we currently simply don't allow sums to be Typeable.\n\n  In general we might consider moving some or all of this generation logic back\n  to the solver since the performance hit we take in doing this at\n  type-definition time is non-trivial and Typeable isn't very widely used. This\n  is discussed in #13261.\n\n-}\n\n-- | Generate the Typeable bindings for a module. This is the only\n-- entry-point of this module and is invoked by the typechecker driver in\n-- 'tcRnSrcDecls'.\n--\n-- See Note [Grand plan for Typeable] in TcTypeable.\nmkTypeableBinds :: TcM TcGblEnv\nmkTypeableBinds\n  = do { -- Create a binding for $trModule.\n         -- Do this before processing any data type declarations,\n         -- which need tcg_tr_module to be initialised\n       ; tcg_env <- mkModIdBindings\n         -- Now we can generate the TyCon representations...\n         -- First we handle the primitive TyCons if we are compiling GHC.Types\n       ; (tcg_env, prim_todos) <- setGblEnv tcg_env mkPrimTypeableTodos\n\n         -- Then we produce bindings for the user-defined types in this module.\n       ; setGblEnv tcg_env $\n    do { mod <- getModule\n       ; let tycons = filter needs_typeable_binds (tcg_tcs tcg_env)\n             mod_id = case tcg_tr_module tcg_env of  -- Should be set by now\n                        Just mod_id -> mod_id\n                        Nothing     -> pprPanic \"tcMkTypeableBinds\" (ppr tycons)\n       ; traceTc \"mkTypeableBinds\" (ppr tycons)\n       ; this_mod_todos <- todoForTyCons mod mod_id tycons\n       ; mkTypeRepTodoBinds (this_mod_todos : prim_todos)\n       } }\n  where\n    needs_typeable_binds tc\n      | tc `elem` [runtimeRepTyCon, vecCountTyCon, vecElemTyCon]\n      = False\n      | otherwise =\n          isAlgTyCon tc\n       || isDataFamilyTyCon tc\n       || isClassTyCon tc\n\n\n{- *********************************************************************\n*                                                                      *\n            Building top-level binding for $trModule\n*                                                                      *\n********************************************************************* -}\n\nmkModIdBindings :: TcM TcGblEnv\nmkModIdBindings\n  = do { mod <- getModule\n       ; loc <- getSrcSpanM\n       ; mod_nm        <- newGlobalBinder mod (mkVarOcc \"$trModule\") loc\n       ; trModuleTyCon <- tcLookupTyCon trModuleTyConName\n       ; let mod_id = mkExportedVanillaId mod_nm (mkTyConApp trModuleTyCon [])\n       ; mod_bind      <- mkVarBind mod_id <$> mkModIdRHS mod\n\n       ; tcg_env <- tcExtendGlobalValEnv [mod_id] getGblEnv\n       ; return (tcg_env { tcg_tr_module = Just mod_id }\n                 `addTypecheckedBinds` [unitBag mod_bind]) }\n\nmkModIdRHS :: Module -> TcM (LHsExpr GhcTc)\nmkModIdRHS mod\n  = do { trModuleDataCon <- tcLookupDataCon trModuleDataConName\n       ; trNameLit <- mkTrNameLit\n       ; return $ nlHsDataCon trModuleDataCon\n                  `nlHsApp` trNameLit (unitIdFS (moduleUnitId mod))\n                  `nlHsApp` trNameLit (moduleNameFS (moduleName mod))\n       }\n\n{- *********************************************************************\n*                                                                      *\n                Building type-representation bindings\n*                                                                      *\n********************************************************************* -}\n\n-- | Information we need about a 'TyCon' to generate its representation. We\n-- carry the 'Id' in order to share it between the generation of the @TyCon@ and\n-- @KindRep@ bindings.\ndata TypeableTyCon\n    = TypeableTyCon\n      { tycon        :: !TyCon\n      , tycon_rep_id :: !Id\n      }\n\n-- | A group of 'TyCon's in need of type-rep bindings.\ndata TypeRepTodo\n    = TypeRepTodo\n      { mod_rep_expr    :: LHsExpr GhcTc    -- ^ Module's typerep binding\n      , pkg_fingerprint :: !Fingerprint     -- ^ Package name fingerprint\n      , mod_fingerprint :: !Fingerprint     -- ^ Module name fingerprint\n      , todo_tycons     :: [TypeableTyCon]\n        -- ^ The 'TyCon's in need of bindings kinds\n      }\n    | ExportedKindRepsTodo [(Kind, Id)]\n      -- ^ Build exported 'KindRep' bindings for the given set of kinds.\n\ntodoForTyCons :: Module -> Id -> [TyCon] -> TcM TypeRepTodo\ntodoForTyCons mod mod_id tycons = do\n    trTyConTy <- mkTyConTy <$> tcLookupTyCon trTyConTyConName\n    let mk_rep_id :: TyConRepName -> Id\n        mk_rep_id rep_name = mkExportedVanillaId rep_name trTyConTy\n\n    let typeable_tycons :: [TypeableTyCon]\n        typeable_tycons =\n            [ TypeableTyCon { tycon = tc''\n                            , tycon_rep_id = mk_rep_id rep_name\n                            }\n            | tc     <- tycons\n            , tc'    <- tc : tyConATs tc\n              -- We need type representations for any associated types\n            , let promoted = map promoteDataCon (tyConDataCons tc')\n            , tc''   <- tc' : promoted\n              -- Don't make bindings for data-family instance tycons.\n              -- Do, however, make them for their promoted datacon (see #13915).\n            , not $ isFamInstTyCon tc''\n            , Just rep_name <- pure $ tyConRepName_maybe tc''\n            , typeIsTypeable $ dropForAlls $ tyConKind tc''\n            ]\n    return TypeRepTodo { mod_rep_expr    = nlHsVar mod_id\n                       , pkg_fingerprint = pkg_fpr\n                       , mod_fingerprint = mod_fpr\n                       , todo_tycons     = typeable_tycons\n                       }\n  where\n    mod_fpr = fingerprintString $ moduleNameString $ moduleName mod\n    pkg_fpr = fingerprintString $ unitIdString $ moduleUnitId mod\n\ntodoForExportedKindReps :: [(Kind, Name)] -> TcM TypeRepTodo\ntodoForExportedKindReps kinds = do\n    trKindRepTy <- mkTyConTy <$> tcLookupTyCon kindRepTyConName\n    let mkId (k, name) = (k, mkExportedVanillaId name trKindRepTy)\n    return $ ExportedKindRepsTodo $ map mkId kinds\n\n-- | Generate TyCon bindings for a set of type constructors\nmkTypeRepTodoBinds :: [TypeRepTodo] -> TcM TcGblEnv\nmkTypeRepTodoBinds [] = getGblEnv\nmkTypeRepTodoBinds todos\n  = do { stuff <- collect_stuff\n\n         -- First extend the type environment with all of the bindings\n         -- which we are going to produce since we may need to refer to them\n         -- while generating kind representations (namely, when we want to\n         -- represent a TyConApp in a kind, we must be able to look up the\n         -- TyCon associated with the applied type constructor).\n       ; let produced_bndrs :: [Id]\n             produced_bndrs = [ tycon_rep_id\n                              | todo@(TypeRepTodo{}) <- todos\n                              , TypeableTyCon {..} <- todo_tycons todo\n                              ] ++\n                              [ rep_id\n                              | ExportedKindRepsTodo kinds <- todos\n                              , (_, rep_id) <- kinds\n                              ]\n       ; gbl_env <- tcExtendGlobalValEnv produced_bndrs getGblEnv\n\n       ; let mk_binds :: TypeRepTodo -> KindRepM [LHsBinds GhcTc]\n             mk_binds todo@(TypeRepTodo {}) =\n                 mapM (mkTyConRepBinds stuff todo) (todo_tycons todo)\n             mk_binds (ExportedKindRepsTodo kinds) =\n                 mkExportedKindReps stuff kinds >> return []\n\n       ; (gbl_env, binds) <- setGblEnv gbl_env\n                             $ runKindRepM (mapM mk_binds todos)\n       ; return $ gbl_env `addTypecheckedBinds` concat binds }\n\n-- | Generate bindings for the type representation of a wired-in 'TyCon's\n-- defined by the virtual \"GHC.Prim\" module. This is where we inject the\n-- representation bindings for these primitive types into \"GHC.Types\"\n--\n-- See Note [Grand plan for Typeable] in this module.\nmkPrimTypeableTodos :: TcM (TcGblEnv, [TypeRepTodo])\nmkPrimTypeableTodos\n  = do { mod <- getModule\n       ; if mod == gHC_TYPES\n           then do { -- Build Module binding for GHC.Prim\n                     trModuleTyCon <- tcLookupTyCon trModuleTyConName\n                   ; let ghc_prim_module_id =\n                             mkExportedVanillaId trGhcPrimModuleName\n                                                 (mkTyConTy trModuleTyCon)\n\n                   ; ghc_prim_module_bind <- mkVarBind ghc_prim_module_id\n                                             <$> mkModIdRHS gHC_PRIM\n\n                     -- Extend our environment with above\n                   ; gbl_env <- tcExtendGlobalValEnv [ghc_prim_module_id]\n                                                     getGblEnv\n                   ; let gbl_env' = gbl_env `addTypecheckedBinds`\n                                    [unitBag ghc_prim_module_bind]\n\n                     -- Build TypeRepTodos for built-in KindReps\n                   ; todo1 <- todoForExportedKindReps builtInKindReps\n                     -- Build TypeRepTodos for types in GHC.Prim\n                   ; todo2 <- todoForTyCons gHC_PRIM ghc_prim_module_id\n                                            ghcPrimTypeableTyCons\n                   ; return ( gbl_env' , [todo1, todo2])\n                   }\n           else do gbl_env <- getGblEnv\n                   return (gbl_env, [])\n       }\n\n-- | This is the list of primitive 'TyCon's for which we must generate bindings\n-- in \"GHC.Types\". This should include all types defined in \"GHC.Prim\".\n--\n-- The majority of the types we need here are contained in 'primTyCons'.\n-- However, not all of them: in particular unboxed tuples are absent since we\n-- don't want to include them in the original name cache. See\n-- Note [Built-in syntax and the OrigNameCache] in IfaceEnv for more.\nghcPrimTypeableTyCons :: [TyCon]\nghcPrimTypeableTyCons = concat\n    [ [ runtimeRepTyCon, vecCountTyCon, vecElemTyCon, funTyCon ]\n    , map (tupleTyCon Unboxed) [0..mAX_TUPLE_SIZE]\n    , map sumTyCon [2..mAX_SUM_SIZE]\n    , primTyCons\n    ]\n\ndata TypeableStuff\n    = Stuff { dflags         :: DynFlags\n            , trTyConDataCon :: DataCon         -- ^ of @TyCon@\n            , trNameLit      :: FastString -> LHsExpr GhcTc\n                                                -- ^ To construct @TrName@s\n              -- The various TyCon and DataCons of KindRep\n            , kindRepTyCon           :: TyCon\n            , kindRepTyConAppDataCon :: DataCon\n            , kindRepVarDataCon      :: DataCon\n            , kindRepAppDataCon      :: DataCon\n            , kindRepFunDataCon      :: DataCon\n            , kindRepTYPEDataCon     :: DataCon\n            , kindRepTypeLitSDataCon :: DataCon\n            , typeLitSymbolDataCon   :: DataCon\n            , typeLitNatDataCon      :: DataCon\n            }\n\n-- | Collect various tidbits which we'll need to generate TyCon representations.\ncollect_stuff :: TcM TypeableStuff\ncollect_stuff = do\n    dflags <- getDynFlags\n    trTyConDataCon         <- tcLookupDataCon trTyConDataConName\n    kindRepTyCon           <- tcLookupTyCon   kindRepTyConName\n    kindRepTyConAppDataCon <- tcLookupDataCon kindRepTyConAppDataConName\n    kindRepVarDataCon      <- tcLookupDataCon kindRepVarDataConName\n    kindRepAppDataCon      <- tcLookupDataCon kindRepAppDataConName\n    kindRepFunDataCon      <- tcLookupDataCon kindRepFunDataConName\n    kindRepTYPEDataCon     <- tcLookupDataCon kindRepTYPEDataConName\n    kindRepTypeLitSDataCon <- tcLookupDataCon kindRepTypeLitSDataConName\n    typeLitSymbolDataCon   <- tcLookupDataCon typeLitSymbolDataConName\n    typeLitNatDataCon      <- tcLookupDataCon typeLitNatDataConName\n    trNameLit              <- mkTrNameLit\n    return Stuff {..}\n\n-- | Lookup the necessary pieces to construct the @trNameLit@. We do this so we\n-- can save the work of repeating lookups when constructing many TyCon\n-- representations.\nmkTrNameLit :: TcM (FastString -> LHsExpr GhcTc)\nmkTrNameLit = do\n    trNameSDataCon <- tcLookupDataCon trNameSDataConName\n    let trNameLit :: FastString -> LHsExpr GhcTc\n        trNameLit fs = nlHsPar $ nlHsDataCon trNameSDataCon\n                       `nlHsApp` nlHsLit (mkHsStringPrimLit fs)\n    return trNameLit\n\n-- | Make Typeable bindings for the given 'TyCon'.\nmkTyConRepBinds :: TypeableStuff -> TypeRepTodo\n                -> TypeableTyCon -> KindRepM (LHsBinds GhcTc)\nmkTyConRepBinds stuff todo (TypeableTyCon {..})\n  = do -- Make a KindRep\n       let (bndrs, kind) = splitForAllVarBndrs (tyConKind tycon)\n       liftTc $ traceTc \"mkTyConKindRepBinds\"\n                        (ppr tycon $$ ppr (tyConKind tycon) $$ ppr kind)\n       let ctx = mkDeBruijnContext (map binderVar bndrs)\n       kind_rep <- getKindRep stuff ctx kind\n\n       -- Make the TyCon binding\n       let tycon_rep_rhs = mkTyConRepTyConRHS stuff todo tycon kind_rep\n           tycon_rep_bind = mkVarBind tycon_rep_id tycon_rep_rhs\n       return $ unitBag tycon_rep_bind\n\n-- | Here is where we define the set of Typeable types. These exclude type\n-- families and polytypes.\ntyConIsTypeable :: TyCon -> Bool\ntyConIsTypeable tc =\n       isJust (tyConRepName_maybe tc)\n    && typeIsTypeable (dropForAlls $ tyConKind tc)\n      -- Ensure that the kind of the TyCon, with its initial foralls removed,\n      -- is representable (e.g. has no higher-rank polymorphism or type\n      -- synonyms).\n\n-- | Is a particular 'Type' representable by @Typeable@? Here we look for\n-- polytypes and types containing casts (which may be, for instance, a type\n-- family).\ntypeIsTypeable :: Type -> Bool\n-- We handle types of the form (TYPE rep) specifically to avoid\n-- looping on (tyConIsTypeable RuntimeRep)\ntypeIsTypeable ty\n  | Just ty' <- coreView ty         = typeIsTypeable ty'\ntypeIsTypeable ty\n  | isJust (kindRep_maybe ty)       = True\ntypeIsTypeable (TyVarTy _)          = True\ntypeIsTypeable (AppTy a b)          = typeIsTypeable a && typeIsTypeable b\ntypeIsTypeable (FunTy _ a b)        = typeIsTypeable a && typeIsTypeable b\ntypeIsTypeable (TyConApp tc args)   = tyConIsTypeable tc\n                                   && all typeIsTypeable args\ntypeIsTypeable (ForAllTy{})         = False\ntypeIsTypeable (LitTy _)            = True\ntypeIsTypeable (CastTy{})           = False\ntypeIsTypeable (CoercionTy{})       = False\n\n-- | Maps kinds to 'KindRep' bindings. This binding may either be defined in\n-- some other module (in which case the @Maybe (LHsExpr Id@ will be 'Nothing')\n-- or a binding which we generated in the current module (in which case it will\n-- be 'Just' the RHS of the binding).\ntype KindRepEnv = TypeMap (Id, Maybe (LHsExpr GhcTc))\n\n-- | A monad within which we will generate 'KindRep's. Here we keep an\n-- environment containing 'KindRep's which we've already generated so we can\n-- re-use them opportunistically.\nnewtype KindRepM a = KindRepM { unKindRepM :: StateT KindRepEnv TcRn a }\n                   deriving (Functor, Applicative, Monad)\n\nliftTc :: TcRn a -> KindRepM a\nliftTc = KindRepM . lift\n\n-- | We generate @KindRep@s for a few common kinds in @GHC.Types@ so that they\n-- can be reused across modules.\nbuiltInKindReps :: [(Kind, Name)]\nbuiltInKindReps =\n    [ (star, starKindRepName)\n    , (mkVisFunTy star star, starArrStarKindRepName)\n    , (mkVisFunTys [star, star] star, starArrStarArrStarKindRepName)\n    ]\n  where\n    star = liftedTypeKind\n\ninitialKindRepEnv :: TcRn KindRepEnv\ninitialKindRepEnv = foldlM add_kind_rep emptyTypeMap builtInKindReps\n  where\n    add_kind_rep acc (k,n) = do\n        id <- tcLookupId n\n        return $! extendTypeMap acc k (id, Nothing)\n\n-- | Performed while compiling \"GHC.Types\" to generate the built-in 'KindRep's.\nmkExportedKindReps :: TypeableStuff\n                   -> [(Kind, Id)]  -- ^ the kinds to generate bindings for\n                   -> KindRepM ()\nmkExportedKindReps stuff = mapM_ kindrep_binding\n  where\n    empty_scope = mkDeBruijnContext []\n\n    kindrep_binding :: (Kind, Id) -> KindRepM ()\n    kindrep_binding (kind, rep_bndr) = do\n        -- We build the binding manually here instead of using mkKindRepRhs\n        -- since the latter would find the built-in 'KindRep's in the\n        -- 'KindRepEnv' (by virtue of being in 'initialKindRepEnv').\n        rhs <- mkKindRepRhs stuff empty_scope kind\n        addKindRepBind empty_scope kind rep_bndr rhs\n\naddKindRepBind :: CmEnv -> Kind -> Id -> LHsExpr GhcTc -> KindRepM ()\naddKindRepBind in_scope k bndr rhs =\n    KindRepM $ modify' $\n    \\env -> extendTypeMapWithScope env in_scope k (bndr, Just rhs)\n\n-- | Run a 'KindRepM' and add the produced 'KindRep's to the typechecking\n-- environment.\nrunKindRepM :: KindRepM a -> TcRn (TcGblEnv, a)\nrunKindRepM (KindRepM action) = do\n    kindRepEnv <- initialKindRepEnv\n    (res, reps_env) <- runStateT action kindRepEnv\n    let rep_binds = foldTypeMap to_bind_pair [] reps_env\n        to_bind_pair (bndr, Just rhs) rest = (bndr, rhs) : rest\n        to_bind_pair (_, Nothing) rest = rest\n    tcg_env <- tcExtendGlobalValEnv (map fst rep_binds) getGblEnv\n    let binds = map (uncurry mkVarBind) rep_binds\n        tcg_env' = tcg_env `addTypecheckedBinds` [listToBag binds]\n    return (tcg_env', res)\n\n-- | Produce or find a 'KindRep' for the given kind.\ngetKindRep :: TypeableStuff -> CmEnv  -- ^ in-scope kind variables\n           -> Kind   -- ^ the kind we want a 'KindRep' for\n           -> KindRepM (LHsExpr GhcTc)\ngetKindRep stuff@(Stuff {..}) in_scope = go\n  where\n    go :: Kind -> KindRepM (LHsExpr GhcTc)\n    go = KindRepM . StateT . go'\n\n    go' :: Kind -> KindRepEnv -> TcRn (LHsExpr GhcTc, KindRepEnv)\n    go' k env\n        -- Look through type synonyms\n      | Just k' <- tcView k = go' k' env\n\n        -- We've already generated the needed KindRep\n      | Just (id, _) <- lookupTypeMapWithScope env in_scope k\n      = return (nlHsVar id, env)\n\n        -- We need to construct a new KindRep binding\n      | otherwise\n      = do -- Place a NOINLINE pragma on KindReps since they tend to be quite\n           -- large and bloat interface files.\n           rep_bndr <- (`setInlinePragma` neverInlinePragma)\n                   <$> newSysLocalId (fsLit \"$krep\") (mkTyConTy kindRepTyCon)\n\n           -- do we need to tie a knot here?\n           flip runStateT env $ unKindRepM $ do\n               rhs <- mkKindRepRhs stuff in_scope k\n               addKindRepBind in_scope k rep_bndr rhs\n               return $ nlHsVar rep_bndr\n\n-- | Construct the right-hand-side of the 'KindRep' for the given 'Kind' and\n-- in-scope kind variable set.\nmkKindRepRhs :: TypeableStuff\n             -> CmEnv       -- ^ in-scope kind variables\n             -> Kind        -- ^ the kind we want a 'KindRep' for\n             -> KindRepM (LHsExpr GhcTc) -- ^ RHS expression\nmkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep\n  where\n    new_kind_rep k\n        -- We handle (TYPE LiftedRep) etc separately to make it\n        -- clear to consumers (e.g. serializers) that there is\n        -- a loop here (as TYPE :: RuntimeRep -> TYPE 'LiftedRep)\n      | not (tcIsConstraintKind k)\n              -- Typeable respects the Constraint/Type distinction\n              -- so do not follow the special case here\n      , Just arg <- kindRep_maybe k\n      , Just (tc, []) <- splitTyConApp_maybe arg\n      , Just dc <- isPromotedDataCon_maybe tc\n      = return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon dc\n\n    new_kind_rep (TyVarTy v)\n      | Just idx <- lookupCME in_scope v\n      = return $ nlHsDataCon kindRepVarDataCon\n                 `nlHsApp` nlHsIntLit (fromIntegral idx)\n      | otherwise\n      = pprPanic \"mkTyConKindRepBinds.go(tyvar)\" (ppr v)\n\n    new_kind_rep (AppTy t1 t2)\n      = do rep1 <- getKindRep stuff in_scope t1\n           rep2 <- getKindRep stuff in_scope t2\n           return $ nlHsDataCon kindRepAppDataCon\n                    `nlHsApp` rep1 `nlHsApp` rep2\n\n    new_kind_rep k@(TyConApp tc tys)\n      | Just rep_name <- tyConRepName_maybe tc\n      = do rep_id <- liftTc $ lookupId rep_name\n           tys' <- mapM (getKindRep stuff in_scope) tys\n           return $ nlHsDataCon kindRepTyConAppDataCon\n                    `nlHsApp` nlHsVar rep_id\n                    `nlHsApp` mkList (mkTyConTy kindRepTyCon) tys'\n      | otherwise\n      = pprPanic \"mkTyConKindRepBinds(TyConApp)\" (ppr tc $$ ppr k)\n\n    new_kind_rep (ForAllTy (Bndr var _) ty)\n      = pprPanic \"mkTyConKindRepBinds(ForAllTy)\" (ppr var $$ ppr ty)\n\n    new_kind_rep (FunTy _ t1 t2)\n      = do rep1 <- getKindRep stuff in_scope t1\n           rep2 <- getKindRep stuff in_scope t2\n           return $ nlHsDataCon kindRepFunDataCon\n                    `nlHsApp` rep1 `nlHsApp` rep2\n\n    new_kind_rep (LitTy (NumTyLit n))\n      = return $ nlHsDataCon kindRepTypeLitSDataCon\n                 `nlHsApp` nlHsDataCon typeLitNatDataCon\n                 `nlHsApp` nlHsLit (mkHsStringPrimLit $ mkFastString $ show n)\n\n    new_kind_rep (LitTy (StrTyLit s))\n      = return $ nlHsDataCon kindRepTypeLitSDataCon\n                 `nlHsApp` nlHsDataCon typeLitSymbolDataCon\n                 `nlHsApp` nlHsLit (mkHsStringPrimLit $ mkFastString $ show s)\n\n    new_kind_rep (CastTy ty co)\n      = pprPanic \"mkTyConKindRepBinds.go(cast)\" (ppr ty $$ ppr co)\n\n    new_kind_rep (CoercionTy co)\n      = pprPanic \"mkTyConKindRepBinds.go(coercion)\" (ppr co)\n\n-- | Produce the right-hand-side of a @TyCon@ representation.\nmkTyConRepTyConRHS :: TypeableStuff -> TypeRepTodo\n                   -> TyCon      -- ^ the 'TyCon' we are producing a binding for\n                   -> LHsExpr GhcTc -- ^ its 'KindRep'\n                   -> LHsExpr GhcTc\nmkTyConRepTyConRHS (Stuff {..}) todo tycon kind_rep\n  =           nlHsDataCon trTyConDataCon\n    `nlHsApp` nlHsLit (word64 dflags high)\n    `nlHsApp` nlHsLit (word64 dflags low)\n    `nlHsApp` mod_rep_expr todo\n    `nlHsApp` trNameLit (mkFastString tycon_str)\n    `nlHsApp` nlHsLit (int n_kind_vars)\n    `nlHsApp` kind_rep\n  where\n    n_kind_vars = length $ filter isNamedTyConBinder (tyConBinders tycon)\n    tycon_str = add_tick (occNameString (getOccName tycon))\n    add_tick s | isPromotedDataCon tycon = '\\'' : s\n               | otherwise               = s\n\n    -- This must match the computation done in\n    -- Data.Typeable.Internal.mkTyConFingerprint.\n    Fingerprint high low = fingerprintFingerprints [ pkg_fingerprint todo\n                                                   , mod_fingerprint todo\n                                                   , fingerprintString tycon_str\n                                                   ]\n\n    int :: Int -> HsLit GhcTc\n    int n = HsIntPrim (SourceText $ show n) (toInteger n)\n\nword64 :: DynFlags -> Word64 -> HsLit GhcTc\nword64 dflags n\n  | wORD_SIZE dflags == 4 = HsWord64Prim NoSourceText (toInteger n)\n  | otherwise             = HsWordPrim   NoSourceText (toInteger n)\n\n{-\nNote [Representing TyCon kinds: KindRep]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOne of the operations supported by Typeable is typeRepKind,\n\n    typeRepKind :: TypeRep (a :: k) -> TypeRep k\n\nImplementing this is a bit tricky for poly-kinded types like\n\n    data Proxy (a :: k) :: Type\n    -- Proxy :: forall k. k -> Type\n\nThe TypeRep encoding of `Proxy Type Int` looks like this:\n\n    $tcProxy :: GHC.Types.TyCon\n    $trInt   :: TypeRep Int\n    TrType   :: TypeRep Type\n\n    $trProxyType :: TypeRep (Proxy Type :: Type -> Type)\n    $trProxyType = TrTyCon $tcProxy\n                           [TrType]  -- kind variable instantiation\n                           (tyConKind $tcProxy [TrType]) -- The TypeRep of\n                                                         -- Type -> Type\n\n    $trProxy :: TypeRep (Proxy Type Int)\n    $trProxy = TrApp $trProxyType $trInt TrType\n\n    $tkProxy :: GHC.Types.KindRep\n    $tkProxy = KindRepFun (KindRepVar 0)\n                          (KindRepTyConApp (KindRepTYPE LiftedRep) [])\n\nNote how $trProxyType cannot use 'TrApp', because TypeRep cannot represent\npolymorphic types.  So instead\n\n * $trProxyType uses 'TrTyCon' to apply Proxy to (the representations)\n   of all its kind arguments. We can't represent a tycon that is\n   applied to only some of its kind arguments.\n\n * In $tcProxy, the GHC.Types.TyCon structure for Proxy, we store a\n   GHC.Types.KindRep, which represents the polymorphic kind of Proxy\n       Proxy :: forall k. k->Type\n\n * A KindRep is just a recipe that we can instantiate with the\n   argument kinds, using Data.Typeable.Internal.tyConKind and\n   store in the relevant 'TypeRep' constructor.\n\n   Data.Typeable.Internal.typeRepKind looks up the stored kinds.\n\n * In a KindRep, the kind variables are represented by 0-indexed\n   de Bruijn numbers:\n\n    type KindBndr = Int   -- de Bruijn index\n\n    data KindRep = KindRepTyConApp TyCon [KindRep]\n                 | KindRepVar !KindBndr\n                 | KindRepApp KindRep KindRep\n                 | KindRepFun KindRep KindRep\n                 ...\n-}\n\nmkList :: Type -> [LHsExpr GhcTc] -> LHsExpr GhcTc\nmkList ty = foldr consApp (nilExpr ty)\n  where\n    cons = consExpr ty\n    consApp :: LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc\n    consApp x xs = cons `nlHsApp` x `nlHsApp` xs\n\n    nilExpr :: Type -> LHsExpr GhcTc\n    nilExpr ty = mkLHsWrap (mkWpTyApps [ty]) (nlHsDataCon nilDataCon)\n\n    consExpr :: Type -> LHsExpr GhcTc\n    consExpr ty = mkLHsWrap (mkWpTyApps [ty]) (nlHsDataCon consDataCon)\n", "num_lines": 718}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\n\nmodule TcTypeNats\n  ( typeNatTyCons\n  , typeNatCoAxiomRules\n  , BuiltInSynFamily(..)\n\n    -- If you define a new built-in type family, make sure to export its TyCon\n    -- from here as well.\n    -- See Note [Adding built-in type families]\n  , typeNatAddTyCon\n  , typeNatMulTyCon\n  , typeNatExpTyCon\n  , typeNatLeqTyCon\n  , typeNatSubTyCon\n  , typeNatDivTyCon\n  , typeNatModTyCon\n  , typeNatLogTyCon\n  , typeNatCmpTyCon\n  , typeSymbolCmpTyCon\n  , typeSymbolAppendTyCon\n  ) where\n\nimport GhcPrelude\n\nimport Type\nimport Pair\nimport TcType     ( TcType, tcEqType )\nimport TyCon      ( TyCon, FamTyConFlav(..), mkFamilyTyCon\n                  , Injectivity(..) )\nimport Coercion   ( Role(..) )\nimport TcRnTypes  ( Xi )\nimport CoAxiom    ( CoAxiomRule(..), BuiltInSynFamily(..), TypeEqn )\nimport Name       ( Name, BuiltInSyntax(..) )\nimport TysWiredIn\nimport TysPrim    ( mkTemplateAnonTyConBinders )\nimport PrelNames  ( gHC_TYPELITS\n                  , gHC_TYPENATS\n                  , typeNatAddTyFamNameKey\n                  , typeNatMulTyFamNameKey\n                  , typeNatExpTyFamNameKey\n                  , typeNatLeqTyFamNameKey\n                  , typeNatSubTyFamNameKey\n                  , typeNatDivTyFamNameKey\n                  , typeNatModTyFamNameKey\n                  , typeNatLogTyFamNameKey\n                  , typeNatCmpTyFamNameKey\n                  , typeSymbolCmpTyFamNameKey\n                  , typeSymbolAppendFamNameKey\n                  )\nimport FastString ( FastString\n                  , fsLit, nilFS, nullFS, unpackFS, mkFastString, appendFS\n                  )\nimport qualified Data.Map as Map\nimport Data.Maybe ( isJust )\nimport Control.Monad ( guard )\nimport Data.List  ( isPrefixOf, isSuffixOf )\n\n{-\nNote [Type-level literals]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are currently two forms of type-level literals: natural numbers, and\nsymbols (even though this module is named TcTypeNats, it covers both).\n\nType-level literals are supported by CoAxiomRules (conditional axioms), which\npower the built-in type families (see Note [Adding built-in type families]).\nCurrently, all built-in type families are for the express purpose of supporting\ntype-level literals.\n\nSee also the Wiki page:\n\n    https://ghc.haskell.org/trac/ghc/wiki/TypeNats\n\nNote [Adding built-in type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are a few steps to adding a built-in type family:\n\n* Adding a unique for the type family TyCon\n\n  These go in PrelNames. It will likely be of the form\n  @myTyFamNameKey = mkPreludeTyConUnique xyz@, where @xyz@ is a number that\n  has not been chosen before in PrelNames. There are several examples already\n  in PrelNames\u00e2\u20ac\u201dsee, for instance, typeNatAddTyFamNameKey.\n\n* Adding the type family TyCon itself\n\n  This goes in TcTypeNats. There are plenty of examples of how to define\n  these\u00e2\u20ac\u201dsee, for instance, typeNatAddTyCon.\n\n  Once your TyCon has been defined, be sure to:\n\n  - Export it from TcTypeNats. (Not doing so caused #14632.)\n  - Include it in the typeNatTyCons list, defined in TcTypeNats.\n\n* Exposing associated type family axioms\n\n  When defining the type family TyCon, you will need to define an axiom for\n  the type family in general (see, for instance, axAddDef), and perhaps other\n  auxiliary axioms for special cases of the type family (see, for instance,\n  axAdd0L and axAdd0R).\n\n  After you have defined all of these axioms, be sure to include them in the\n  typeNatCoAxiomRules list, defined in TcTypeNats.\n  (Not doing so caused #14934.)\n\n* Define the type family somewhere\n\n  Finally, you will need to define the type family somewhere, likely in @base@.\n  Currently, all of the built-in type families are defined in GHC.TypeLits or\n  GHC.TypeNats, so those are likely candidates.\n\n  Since the behavior of your built-in type family is specified in TcTypeNats,\n  you should give an open type family definition with no instances, like so:\n\n    type family MyTypeFam (m :: Nat) (n :: Nat) :: Nat\n\n  Changing the argument and result kinds as appropriate.\n\n* Update the relevant test cases\n\n  The GHC test suite will likely need to be updated after you add your built-in\n  type family. For instance:\n\n  - The T9181 test prints the :browse contents of GHC.TypeLits, so if you added\n    a test there, the expected output of T9181 will need to change.\n  - The TcTypeNatSimple and TcTypeSymbolSimple tests have compile-time unit\n    tests, as well as TcTypeNatSimpleRun and TcTypeSymbolSimpleRun, which have\n    runtime unit tests. Consider adding further unit tests to those if your\n    built-in type family deals with Nats or Symbols, respectively.\n-}\n\n{-------------------------------------------------------------------------------\nBuilt-in type constructors for functions on type-level nats\n-}\n\n-- The list of built-in type family TyCons that GHC uses.\n-- If you define a built-in type family, make sure to add it to this list.\n-- See Note [Adding built-in type families]\ntypeNatTyCons :: [TyCon]\ntypeNatTyCons =\n  [ typeNatAddTyCon\n  , typeNatMulTyCon\n  , typeNatExpTyCon\n  , typeNatLeqTyCon\n  , typeNatSubTyCon\n  , typeNatDivTyCon\n  , typeNatModTyCon\n  , typeNatLogTyCon\n  , typeNatCmpTyCon\n  , typeSymbolCmpTyCon\n  , typeSymbolAppendTyCon\n  ]\n\ntypeNatAddTyCon :: TyCon\ntypeNatAddTyCon = mkTypeNatFunTyCon2 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamAdd\n    , sfInteractTop   = interactTopAdd\n    , sfInteractInert = interactInertAdd\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"+\")\n            typeNatAddTyFamNameKey typeNatAddTyCon\n\ntypeNatSubTyCon :: TyCon\ntypeNatSubTyCon = mkTypeNatFunTyCon2 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamSub\n    , sfInteractTop   = interactTopSub\n    , sfInteractInert = interactInertSub\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"-\")\n            typeNatSubTyFamNameKey typeNatSubTyCon\n\ntypeNatMulTyCon :: TyCon\ntypeNatMulTyCon = mkTypeNatFunTyCon2 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamMul\n    , sfInteractTop   = interactTopMul\n    , sfInteractInert = interactInertMul\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"*\")\n            typeNatMulTyFamNameKey typeNatMulTyCon\n\ntypeNatDivTyCon :: TyCon\ntypeNatDivTyCon = mkTypeNatFunTyCon2 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamDiv\n    , sfInteractTop   = interactTopDiv\n    , sfInteractInert = interactInertDiv\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"Div\")\n            typeNatDivTyFamNameKey typeNatDivTyCon\n\ntypeNatModTyCon :: TyCon\ntypeNatModTyCon = mkTypeNatFunTyCon2 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamMod\n    , sfInteractTop   = interactTopMod\n    , sfInteractInert = interactInertMod\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"Mod\")\n            typeNatModTyFamNameKey typeNatModTyCon\n\n\n\n\n\ntypeNatExpTyCon :: TyCon\ntypeNatExpTyCon = mkTypeNatFunTyCon2 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamExp\n    , sfInteractTop   = interactTopExp\n    , sfInteractInert = interactInertExp\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"^\")\n                typeNatExpTyFamNameKey typeNatExpTyCon\n\ntypeNatLogTyCon :: TyCon\ntypeNatLogTyCon = mkTypeNatFunTyCon1 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamLog\n    , sfInteractTop   = interactTopLog\n    , sfInteractInert = interactInertLog\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"Log2\")\n            typeNatLogTyFamNameKey typeNatLogTyCon\n\n\n\ntypeNatLeqTyCon :: TyCon\ntypeNatLeqTyCon =\n  mkFamilyTyCon name\n    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])\n    boolTy\n    Nothing\n    (BuiltInSynFamTyCon ops)\n    Nothing\n    NotInjective\n\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"<=?\")\n                typeNatLeqTyFamNameKey typeNatLeqTyCon\n  ops = BuiltInSynFamily\n    { sfMatchFam      = matchFamLeq\n    , sfInteractTop   = interactTopLeq\n    , sfInteractInert = interactInertLeq\n    }\n\ntypeNatCmpTyCon :: TyCon\ntypeNatCmpTyCon =\n  mkFamilyTyCon name\n    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])\n    orderingKind\n    Nothing\n    (BuiltInSynFamTyCon ops)\n    Nothing\n    NotInjective\n\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit \"CmpNat\")\n                typeNatCmpTyFamNameKey typeNatCmpTyCon\n  ops = BuiltInSynFamily\n    { sfMatchFam      = matchFamCmpNat\n    , sfInteractTop   = interactTopCmpNat\n    , sfInteractInert = \\_ _ _ _ -> []\n    }\n\ntypeSymbolCmpTyCon :: TyCon\ntypeSymbolCmpTyCon =\n  mkFamilyTyCon name\n    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])\n    orderingKind\n    Nothing\n    (BuiltInSynFamTyCon ops)\n    Nothing\n    NotInjective\n\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit \"CmpSymbol\")\n                typeSymbolCmpTyFamNameKey typeSymbolCmpTyCon\n  ops = BuiltInSynFamily\n    { sfMatchFam      = matchFamCmpSymbol\n    , sfInteractTop   = interactTopCmpSymbol\n    , sfInteractInert = \\_ _ _ _ -> []\n    }\n\ntypeSymbolAppendTyCon :: TyCon\ntypeSymbolAppendTyCon = mkTypeSymbolFunTyCon2 name\n  BuiltInSynFamily\n    { sfMatchFam      = matchFamAppendSymbol\n    , sfInteractTop   = interactTopAppendSymbol\n    , sfInteractInert = interactInertAppendSymbol\n    }\n  where\n  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit \"AppendSymbol\")\n                typeSymbolAppendFamNameKey typeSymbolAppendTyCon\n\n\n\n-- Make a unary built-in constructor of kind: Nat -> Nat\nmkTypeNatFunTyCon1 :: Name -> BuiltInSynFamily -> TyCon\nmkTypeNatFunTyCon1 op tcb =\n  mkFamilyTyCon op\n    (mkTemplateAnonTyConBinders [ typeNatKind ])\n    typeNatKind\n    Nothing\n    (BuiltInSynFamTyCon tcb)\n    Nothing\n    NotInjective\n\n\n-- Make a binary built-in constructor of kind: Nat -> Nat -> Nat\nmkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon\nmkTypeNatFunTyCon2 op tcb =\n  mkFamilyTyCon op\n    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])\n    typeNatKind\n    Nothing\n    (BuiltInSynFamTyCon tcb)\n    Nothing\n    NotInjective\n\n-- Make a binary built-in constructor of kind: Symbol -> Symbol -> Symbol\nmkTypeSymbolFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon\nmkTypeSymbolFunTyCon2 op tcb =\n  mkFamilyTyCon op\n    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])\n    typeSymbolKind\n    Nothing\n    (BuiltInSynFamTyCon tcb)\n    Nothing\n    NotInjective\n\n\n{-------------------------------------------------------------------------------\nBuilt-in rules axioms\n-------------------------------------------------------------------------------}\n\n-- If you add additional rules, please remember to add them to\n-- `typeNatCoAxiomRules` also.\n-- See Note [Adding built-in type families]\naxAddDef\n  , axMulDef\n  , axExpDef\n  , axLeqDef\n  , axCmpNatDef\n  , axCmpSymbolDef\n  , axAppendSymbolDef\n  , axAdd0L\n  , axAdd0R\n  , axMul0L\n  , axMul0R\n  , axMul1L\n  , axMul1R\n  , axExp1L\n  , axExp0R\n  , axExp1R\n  , axLeqRefl\n  , axCmpNatRefl\n  , axCmpSymbolRefl\n  , axLeq0L\n  , axSubDef\n  , axSub0R\n  , axAppendSymbol0R\n  , axAppendSymbol0L\n  , axDivDef\n  , axDiv1\n  , axModDef\n  , axMod1\n  , axLogDef\n  :: CoAxiomRule\n\naxAddDef = mkBinAxiom \"AddDef\" typeNatAddTyCon $\n              \\x y -> Just $ num (x + y)\n\naxMulDef = mkBinAxiom \"MulDef\" typeNatMulTyCon $\n              \\x y -> Just $ num (x * y)\n\naxExpDef = mkBinAxiom \"ExpDef\" typeNatExpTyCon $\n              \\x y -> Just $ num (x ^ y)\n\naxLeqDef = mkBinAxiom \"LeqDef\" typeNatLeqTyCon $\n              \\x y -> Just $ bool (x <= y)\n\naxCmpNatDef   = mkBinAxiom \"CmpNatDef\" typeNatCmpTyCon\n              $ \\x y -> Just $ ordering (compare x y)\n\naxCmpSymbolDef =\n  CoAxiomRule\n    { coaxrName      = fsLit \"CmpSymbolDef\"\n    , coaxrAsmpRoles = [Nominal, Nominal]\n    , coaxrRole      = Nominal\n    , coaxrProves    = \\cs ->\n        do [Pair s1 s2, Pair t1 t2] <- return cs\n           s2' <- isStrLitTy s2\n           t2' <- isStrLitTy t2\n           return (mkTyConApp typeSymbolCmpTyCon [s1,t1] ===\n                   ordering (compare s2' t2')) }\n\naxAppendSymbolDef = CoAxiomRule\n    { coaxrName      = fsLit \"AppendSymbolDef\"\n    , coaxrAsmpRoles = [Nominal, Nominal]\n    , coaxrRole      = Nominal\n    , coaxrProves    = \\cs ->\n        do [Pair s1 s2, Pair t1 t2] <- return cs\n           s2' <- isStrLitTy s2\n           t2' <- isStrLitTy t2\n           let z = mkStrLitTy (appendFS s2' t2')\n           return (mkTyConApp typeSymbolAppendTyCon [s1, t1] === z)\n    }\n\naxSubDef = mkBinAxiom \"SubDef\" typeNatSubTyCon $\n              \\x y -> fmap num (minus x y)\n\naxDivDef = mkBinAxiom \"DivDef\" typeNatDivTyCon $\n              \\x y -> do guard (y /= 0)\n                         return (num (div x y))\n\naxModDef = mkBinAxiom \"ModDef\" typeNatModTyCon $\n              \\x y -> do guard (y /= 0)\n                         return (num (mod x y))\n\naxLogDef = mkUnAxiom \"LogDef\" typeNatLogTyCon $\n              \\x -> do (a,_) <- genLog x 2\n                       return (num a)\n\naxAdd0L     = mkAxiom1 \"Add0L\"    $ \\(Pair s t) -> (num 0 .+. s) === t\naxAdd0R     = mkAxiom1 \"Add0R\"    $ \\(Pair s t) -> (s .+. num 0) === t\naxSub0R     = mkAxiom1 \"Sub0R\"    $ \\(Pair s t) -> (s .-. num 0) === t\naxMul0L     = mkAxiom1 \"Mul0L\"    $ \\(Pair s _) -> (num 0 .*. s) === num 0\naxMul0R     = mkAxiom1 \"Mul0R\"    $ \\(Pair s _) -> (s .*. num 0) === num 0\naxMul1L     = mkAxiom1 \"Mul1L\"    $ \\(Pair s t) -> (num 1 .*. s) === t\naxMul1R     = mkAxiom1 \"Mul1R\"    $ \\(Pair s t) -> (s .*. num 1) === t\naxDiv1      = mkAxiom1 \"Div1\"     $ \\(Pair s t) -> (tDiv s (num 1) === t)\naxMod1      = mkAxiom1 \"Mod1\"     $ \\(Pair s _) -> (tMod s (num 1) === num 0)\n                                    -- XXX: Shouldn't we check that _ is 0?\naxExp1L     = mkAxiom1 \"Exp1L\"    $ \\(Pair s _) -> (num 1 .^. s) === num 1\naxExp0R     = mkAxiom1 \"Exp0R\"    $ \\(Pair s _) -> (s .^. num 0) === num 1\naxExp1R     = mkAxiom1 \"Exp1R\"    $ \\(Pair s t) -> (s .^. num 1) === t\naxLeqRefl   = mkAxiom1 \"LeqRefl\"  $ \\(Pair s _) -> (s <== s) === bool True\naxCmpNatRefl    = mkAxiom1 \"CmpNatRefl\"\n                $ \\(Pair s _) -> (cmpNat s s) === ordering EQ\naxCmpSymbolRefl = mkAxiom1 \"CmpSymbolRefl\"\n                $ \\(Pair s _) -> (cmpSymbol s s) === ordering EQ\naxLeq0L     = mkAxiom1 \"Leq0L\"    $ \\(Pair s _) -> (num 0 <== s) === bool True\naxAppendSymbol0R  = mkAxiom1 \"Concat0R\"\n            $ \\(Pair s t) -> (mkStrLitTy nilFS `appendSymbol` s) === t\naxAppendSymbol0L  = mkAxiom1 \"Concat0L\"\n            $ \\(Pair s t) -> (s `appendSymbol` mkStrLitTy nilFS) === t\n\n-- The list of built-in type family axioms that GHC uses.\n-- If you define new axioms, make sure to include them in this list.\n-- See Note [Adding built-in type families]\ntypeNatCoAxiomRules :: Map.Map FastString CoAxiomRule\ntypeNatCoAxiomRules = Map.fromList $ map (\\x -> (coaxrName x, x))\n  [ axAddDef\n  , axMulDef\n  , axExpDef\n  , axLeqDef\n  , axCmpNatDef\n  , axCmpSymbolDef\n  , axAppendSymbolDef\n  , axAdd0L\n  , axAdd0R\n  , axMul0L\n  , axMul0R\n  , axMul1L\n  , axMul1R\n  , axExp1L\n  , axExp0R\n  , axExp1R\n  , axLeqRefl\n  , axCmpNatRefl\n  , axCmpSymbolRefl\n  , axLeq0L\n  , axSubDef\n  , axSub0R\n  , axAppendSymbol0R\n  , axAppendSymbol0L\n  , axDivDef\n  , axDiv1\n  , axModDef\n  , axMod1\n  , axLogDef\n  ]\n\n\n\n{-------------------------------------------------------------------------------\nVarious utilities for making axioms and types\n-------------------------------------------------------------------------------}\n\n(.+.) :: Type -> Type -> Type\ns .+. t = mkTyConApp typeNatAddTyCon [s,t]\n\n(.-.) :: Type -> Type -> Type\ns .-. t = mkTyConApp typeNatSubTyCon [s,t]\n\n(.*.) :: Type -> Type -> Type\ns .*. t = mkTyConApp typeNatMulTyCon [s,t]\n\ntDiv :: Type -> Type -> Type\ntDiv s t = mkTyConApp typeNatDivTyCon [s,t]\n\ntMod :: Type -> Type -> Type\ntMod s t = mkTyConApp typeNatModTyCon [s,t]\n\n(.^.) :: Type -> Type -> Type\ns .^. t = mkTyConApp typeNatExpTyCon [s,t]\n\n(<==) :: Type -> Type -> Type\ns <== t = mkTyConApp typeNatLeqTyCon [s,t]\n\ncmpNat :: Type -> Type -> Type\ncmpNat s t = mkTyConApp typeNatCmpTyCon [s,t]\n\ncmpSymbol :: Type -> Type -> Type\ncmpSymbol s t = mkTyConApp typeSymbolCmpTyCon [s,t]\n\nappendSymbol :: Type -> Type -> Type\nappendSymbol s t = mkTyConApp typeSymbolAppendTyCon [s, t]\n\n(===) :: Type -> Type -> Pair Type\nx === y = Pair x y\n\nnum :: Integer -> Type\nnum = mkNumLitTy\n\nbool :: Bool -> Type\nbool b = if b then mkTyConApp promotedTrueDataCon []\n              else mkTyConApp promotedFalseDataCon []\n\nisBoolLitTy :: Type -> Maybe Bool\nisBoolLitTy tc =\n  do (tc,[]) <- splitTyConApp_maybe tc\n     case () of\n       _ | tc == promotedFalseDataCon -> return False\n         | tc == promotedTrueDataCon  -> return True\n         | otherwise                   -> Nothing\n\norderingKind :: Kind\norderingKind = mkTyConApp orderingTyCon []\n\nordering :: Ordering -> Type\nordering o =\n  case o of\n    LT -> mkTyConApp promotedLTDataCon []\n    EQ -> mkTyConApp promotedEQDataCon []\n    GT -> mkTyConApp promotedGTDataCon []\n\nisOrderingLitTy :: Type -> Maybe Ordering\nisOrderingLitTy tc =\n  do (tc1,[]) <- splitTyConApp_maybe tc\n     case () of\n       _ | tc1 == promotedLTDataCon -> return LT\n         | tc1 == promotedEQDataCon -> return EQ\n         | tc1 == promotedGTDataCon -> return GT\n         | otherwise                -> Nothing\n\nknown :: (Integer -> Bool) -> TcType -> Bool\nknown p x = case isNumLitTy x of\n              Just a  -> p a\n              Nothing -> False\n\n\nmkUnAxiom :: String -> TyCon -> (Integer -> Maybe Type) -> CoAxiomRule\nmkUnAxiom str tc f =\n  CoAxiomRule\n    { coaxrName      = fsLit str\n    , coaxrAsmpRoles = [Nominal]\n    , coaxrRole      = Nominal\n    , coaxrProves    = \\cs ->\n        do [Pair s1 s2] <- return cs\n           s2' <- isNumLitTy s2\n           z   <- f s2'\n           return (mkTyConApp tc [s1] === z)\n    }\n\n\n\n-- For the definitional axioms\nmkBinAxiom :: String -> TyCon ->\n              (Integer -> Integer -> Maybe Type) -> CoAxiomRule\nmkBinAxiom str tc f =\n  CoAxiomRule\n    { coaxrName      = fsLit str\n    , coaxrAsmpRoles = [Nominal, Nominal]\n    , coaxrRole      = Nominal\n    , coaxrProves    = \\cs ->\n        do [Pair s1 s2, Pair t1 t2] <- return cs\n           s2' <- isNumLitTy s2\n           t2' <- isNumLitTy t2\n           z   <- f s2' t2'\n           return (mkTyConApp tc [s1,t1] === z)\n    }\n\n\n\nmkAxiom1 :: String -> (TypeEqn -> TypeEqn) -> CoAxiomRule\nmkAxiom1 str f =\n  CoAxiomRule\n    { coaxrName      = fsLit str\n    , coaxrAsmpRoles = [Nominal]\n    , coaxrRole      = Nominal\n    , coaxrProves    = \\case [eqn] -> Just (f eqn)\n                             _     -> Nothing\n    }\n\n\n{-------------------------------------------------------------------------------\nEvaluation\n-------------------------------------------------------------------------------}\n\nmatchFamAdd :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamAdd [s,t]\n  | Just 0 <- mbX = Just (axAdd0L, [t], t)\n  | Just 0 <- mbY = Just (axAdd0R, [s], s)\n  | Just x <- mbX, Just y <- mbY =\n    Just (axAddDef, [s,t], num (x + y))\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamAdd _ = Nothing\n\nmatchFamSub :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamSub [s,t]\n  | Just 0 <- mbY = Just (axSub0R, [s], s)\n  | Just x <- mbX, Just y <- mbY, Just z <- minus x y =\n    Just (axSubDef, [s,t], num z)\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamSub _ = Nothing\n\nmatchFamMul :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamMul [s,t]\n  | Just 0 <- mbX = Just (axMul0L, [t], num 0)\n  | Just 0 <- mbY = Just (axMul0R, [s], num 0)\n  | Just 1 <- mbX = Just (axMul1L, [t], t)\n  | Just 1 <- mbY = Just (axMul1R, [s], s)\n  | Just x <- mbX, Just y <- mbY =\n    Just (axMulDef, [s,t], num (x * y))\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamMul _ = Nothing\n\nmatchFamDiv :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamDiv [s,t]\n  | Just 1 <- mbY = Just (axDiv1, [s], s)\n  | Just x <- mbX, Just y <- mbY, y /= 0 = Just (axDivDef, [s,t], num (div x y))\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamDiv _ = Nothing\n\nmatchFamMod :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamMod [s,t]\n  | Just 1 <- mbY = Just (axMod1, [s], num 0)\n  | Just x <- mbX, Just y <- mbY, y /= 0 = Just (axModDef, [s,t], num (mod x y))\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamMod _ = Nothing\n\n\n\nmatchFamExp :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamExp [s,t]\n  | Just 0 <- mbY = Just (axExp0R, [s], num 1)\n  | Just 1 <- mbX = Just (axExp1L, [t], num 1)\n  | Just 1 <- mbY = Just (axExp1R, [s], s)\n  | Just x <- mbX, Just y <- mbY =\n    Just (axExpDef, [s,t], num (x ^ y))\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamExp _ = Nothing\n\nmatchFamLog :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamLog [s]\n  | Just x <- mbX, Just (n,_) <- genLog x 2 = Just (axLogDef, [s], num n)\n  where mbX = isNumLitTy s\nmatchFamLog _ = Nothing\n\n\nmatchFamLeq :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamLeq [s,t]\n  | Just 0 <- mbX = Just (axLeq0L, [t], bool True)\n  | Just x <- mbX, Just y <- mbY =\n    Just (axLeqDef, [s,t], bool (x <= y))\n  | tcEqType s t  = Just (axLeqRefl, [s], bool True)\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamLeq _ = Nothing\n\nmatchFamCmpNat :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamCmpNat [s,t]\n  | Just x <- mbX, Just y <- mbY =\n    Just (axCmpNatDef, [s,t], ordering (compare x y))\n  | tcEqType s t = Just (axCmpNatRefl, [s], ordering EQ)\n  where mbX = isNumLitTy s\n        mbY = isNumLitTy t\nmatchFamCmpNat _ = Nothing\n\nmatchFamCmpSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamCmpSymbol [s,t]\n  | Just x <- mbX, Just y <- mbY =\n    Just (axCmpSymbolDef, [s,t], ordering (compare x y))\n  | tcEqType s t = Just (axCmpSymbolRefl, [s], ordering EQ)\n  where mbX = isStrLitTy s\n        mbY = isStrLitTy t\nmatchFamCmpSymbol _ = Nothing\n\nmatchFamAppendSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\nmatchFamAppendSymbol [s,t]\n  | Just x <- mbX, nullFS x = Just (axAppendSymbol0R, [t], t)\n  | Just y <- mbY, nullFS y = Just (axAppendSymbol0L, [s], s)\n  | Just x <- mbX, Just y <- mbY =\n    Just (axAppendSymbolDef, [s,t], mkStrLitTy (appendFS x y))\n  where\n  mbX = isStrLitTy s\n  mbY = isStrLitTy t\nmatchFamAppendSymbol _ = Nothing\n\n{-------------------------------------------------------------------------------\nInteract with axioms\n-------------------------------------------------------------------------------}\n\ninteractTopAdd :: [Xi] -> Xi -> [Pair Type]\ninteractTopAdd [s,t] r\n  | Just 0 <- mbZ = [ s === num 0, t === num 0 ]                          -- (s + t ~ 0) => (s ~ 0, t ~ 0)\n  | Just x <- mbX, Just z <- mbZ, Just y <- minus z x = [t === num y]     -- (5 + t ~ 8) => (t ~ 3)\n  | Just y <- mbY, Just z <- mbZ, Just x <- minus z y = [s === num x]     -- (s + 5 ~ 8) => (s ~ 3)\n  where\n  mbX = isNumLitTy s\n  mbY = isNumLitTy t\n  mbZ = isNumLitTy r\ninteractTopAdd _ _ = []\n\n{-\nNote [Weakened interaction rule for subtraction]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nA simpler interaction here might be:\n\n  `s - t ~ r` --> `t + r ~ s`\n\nThis would enable us to reuse all the code for addition.\nUnfortunately, this works a little too well at the moment.\nConsider the following example:\n\n    0 - 5 ~ r --> 5 + r ~ 0 --> (5 = 0, r = 0)\n\nThis (correctly) spots that the constraint cannot be solved.\n\nHowever, this may be a problem if the constraint did not\nneed to be solved in the first place!  Consider the following example:\n\nf :: Proxy (If (5 <=? 0) (0 - 5) (5 - 0)) -> Proxy 5\nf = id\n\nCurrently, GHC is strict while evaluating functions, so this does not\nwork, because even though the `If` should evaluate to `5 - 0`, we\nalso evaluate the \"then\" branch which generates the constraint `0 - 5 ~ r`,\nwhich fails.\n\nSo, for the time being, we only add an improvement when the RHS is a constant,\nwhich happens to work OK for the moment, although clearly we need to do\nsomething more general.\n-}\ninteractTopSub :: [Xi] -> Xi -> [Pair Type]\ninteractTopSub [s,t] r\n  | Just z <- mbZ = [ s === (num z .+. t) ]         -- (s - t ~ 5) => (5 + t ~ s)\n  where\n  mbZ = isNumLitTy r\ninteractTopSub _ _ = []\n\n\n\n\n\ninteractTopMul :: [Xi] -> Xi -> [Pair Type]\ninteractTopMul [s,t] r\n  | Just 1 <- mbZ = [ s === num 1, t === num 1 ]                        -- (s * t ~ 1)  => (s ~ 1, t ~ 1)\n  | Just x <- mbX, Just z <- mbZ, Just y <- divide z x = [t === num y]  -- (3 * t ~ 15) => (t ~ 5)\n  | Just y <- mbY, Just z <- mbZ, Just x <- divide z y = [s === num x]  -- (s * 3 ~ 15) => (s ~ 5)\n  where\n  mbX = isNumLitTy s\n  mbY = isNumLitTy t\n  mbZ = isNumLitTy r\ninteractTopMul _ _ = []\n\ninteractTopDiv :: [Xi] -> Xi -> [Pair Type]\ninteractTopDiv _ _ = []   -- I can't think of anything...\n\ninteractTopMod :: [Xi] -> Xi -> [Pair Type]\ninteractTopMod _ _ = []   -- I can't think of anything...\n\ninteractTopExp :: [Xi] -> Xi -> [Pair Type]\ninteractTopExp [s,t] r\n  | Just 0 <- mbZ = [ s === num 0 ]                                       -- (s ^ t ~ 0) => (s ~ 0)\n  | Just x <- mbX, Just z <- mbZ, Just y <- logExact  z x = [t === num y] -- (2 ^ t ~ 8) => (t ~ 3)\n  | Just y <- mbY, Just z <- mbZ, Just x <- rootExact z y = [s === num x] -- (s ^ 2 ~ 9) => (s ~ 3)\n  where\n  mbX = isNumLitTy s\n  mbY = isNumLitTy t\n  mbZ = isNumLitTy r\ninteractTopExp _ _ = []\n\ninteractTopLog :: [Xi] -> Xi -> [Pair Type]\ninteractTopLog _ _ = []   -- I can't think of anything...\n\n\n\ninteractTopLeq :: [Xi] -> Xi -> [Pair Type]\ninteractTopLeq [s,t] r\n  | Just 0 <- mbY, Just True <- mbZ = [ s === num 0 ]                     -- (s <= 0) => (s ~ 0)\n  where\n  mbY = isNumLitTy t\n  mbZ = isBoolLitTy r\ninteractTopLeq _ _ = []\n\ninteractTopCmpNat :: [Xi] -> Xi -> [Pair Type]\ninteractTopCmpNat [s,t] r\n  | Just EQ <- isOrderingLitTy r = [ s === t ]\ninteractTopCmpNat _ _ = []\n\ninteractTopCmpSymbol :: [Xi] -> Xi -> [Pair Type]\ninteractTopCmpSymbol [s,t] r\n  | Just EQ <- isOrderingLitTy r = [ s === t ]\ninteractTopCmpSymbol _ _ = []\n\ninteractTopAppendSymbol :: [Xi] -> Xi -> [Pair Type]\ninteractTopAppendSymbol [s,t] r\n  -- (AppendSymbol a b ~ \"\") => (a ~ \"\", b ~ \"\")\n  | Just z <- mbZ, nullFS z =\n    [s === mkStrLitTy nilFS, t === mkStrLitTy nilFS ]\n\n  -- (AppendSymbol \"foo\" b ~ \"foobar\") => (b ~ \"bar\")\n  | Just x <- fmap unpackFS mbX, Just z <- fmap unpackFS mbZ, x `isPrefixOf` z =\n    [ t === mkStrLitTy (mkFastString $ drop (length x) z) ]\n\n  -- (AppendSymbol f \"bar\" ~ \"foobar\") => (f ~ \"foo\")\n  | Just y <- fmap unpackFS mbY, Just z <- fmap unpackFS mbZ, y `isSuffixOf` z =\n    [ t === mkStrLitTy (mkFastString $ take (length z - length y) z) ]\n\n  where\n  mbX = isStrLitTy s\n  mbY = isStrLitTy t\n  mbZ = isStrLitTy r\n\ninteractTopAppendSymbol _ _ = []\n\n{-------------------------------------------------------------------------------\nInteraction with inerts\n-------------------------------------------------------------------------------}\n\ninteractInertAdd :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertAdd [x1,y1] z1 [x2,y2] z2\n  | sameZ && tcEqType x1 x2         = [ y1 === y2 ]\n  | sameZ && tcEqType y1 y2         = [ x1 === x2 ]\n  where sameZ = tcEqType z1 z2\ninteractInertAdd _ _ _ _ = []\n\ninteractInertSub :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertSub [x1,y1] z1 [x2,y2] z2\n  | sameZ && tcEqType x1 x2         = [ y1 === y2 ]\n  | sameZ && tcEqType y1 y2         = [ x1 === x2 ]\n  where sameZ = tcEqType z1 z2\ninteractInertSub _ _ _ _ = []\n\ninteractInertMul :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertMul [x1,y1] z1 [x2,y2] z2\n  | sameZ && known (/= 0) x1 && tcEqType x1 x2 = [ y1 === y2 ]\n  | sameZ && known (/= 0) y1 && tcEqType y1 y2 = [ x1 === x2 ]\n  where sameZ   = tcEqType z1 z2\n\ninteractInertMul _ _ _ _ = []\n\ninteractInertDiv :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertDiv _ _ _ _ = []\n\ninteractInertMod :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertMod _ _ _ _ = []\n\ninteractInertExp :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertExp [x1,y1] z1 [x2,y2] z2\n  | sameZ && known (> 1) x1 && tcEqType x1 x2 = [ y1 === y2 ]\n  | sameZ && known (> 0) y1 && tcEqType y1 y2 = [ x1 === x2 ]\n  where sameZ = tcEqType z1 z2\n\ninteractInertExp _ _ _ _ = []\n\ninteractInertLog :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertLog _ _ _ _ = []\n\n\ninteractInertLeq :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertLeq [x1,y1] z1 [x2,y2] z2\n  | bothTrue && tcEqType x1 y2 && tcEqType y1 x2 = [ x1 === y1 ]\n  | bothTrue && tcEqType y1 x2                 = [ (x1 <== y2) === bool True ]\n  | bothTrue && tcEqType y2 x1                 = [ (x2 <== y1) === bool True ]\n  where bothTrue = isJust $ do True <- isBoolLitTy z1\n                               True <- isBoolLitTy z2\n                               return ()\n\ninteractInertLeq _ _ _ _ = []\n\n\ninteractInertAppendSymbol :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type]\ninteractInertAppendSymbol [x1,y1] z1 [x2,y2] z2\n  | sameZ && tcEqType x1 x2         = [ y1 === y2 ]\n  | sameZ && tcEqType y1 y2         = [ x1 === x2 ]\n  where sameZ = tcEqType z1 z2\ninteractInertAppendSymbol _ _ _ _ = []\n\n\n\n{- -----------------------------------------------------------------------------\nThese inverse functions are used for simplifying propositions using\nconcrete natural numbers.\n----------------------------------------------------------------------------- -}\n\n-- | Subtract two natural numbers.\nminus :: Integer -> Integer -> Maybe Integer\nminus x y = if x >= y then Just (x - y) else Nothing\n\n-- | Compute the exact logarithm of a natural number.\n-- The logarithm base is the second argument.\nlogExact :: Integer -> Integer -> Maybe Integer\nlogExact x y = do (z,True) <- genLog x y\n                  return z\n\n\n-- | Divide two natural numbers.\ndivide :: Integer -> Integer -> Maybe Integer\ndivide _ 0  = Nothing\ndivide x y  = case divMod x y of\n                (a,0) -> Just a\n                _     -> Nothing\n\n-- | Compute the exact root of a natural number.\n-- The second argument specifies which root we are computing.\nrootExact :: Integer -> Integer -> Maybe Integer\nrootExact x y = do (z,True) <- genRoot x y\n                   return z\n\n\n\n{- | Compute the n-th root of a natural number, rounded down to\nthe closest natural number.  The boolean indicates if the result\nis exact (i.e., True means no rounding was done, False means rounded down).\nThe second argument specifies which root we are computing. -}\ngenRoot :: Integer -> Integer -> Maybe (Integer, Bool)\ngenRoot _  0    = Nothing\ngenRoot x0 1    = Just (x0, True)\ngenRoot x0 root = Just (search 0 (x0+1))\n  where\n  search from to = let x = from + div (to - from) 2\n                       a = x ^ root\n                   in case compare a x0 of\n                        EQ              -> (x, True)\n                        LT | x /= from  -> search x to\n                           | otherwise  -> (from, False)\n                        GT | x /= to    -> search from x\n                           | otherwise  -> (from, False)\n\n{- | Compute the logarithm of a number in the given base, rounded down to the\nclosest integer.  The boolean indicates if we the result is exact\n(i.e., True means no rounding happened, False means we rounded down).\nThe logarithm base is the second argument. -}\ngenLog :: Integer -> Integer -> Maybe (Integer, Bool)\ngenLog x 0    = if x == 1 then Just (0, True) else Nothing\ngenLog _ 1    = Nothing\ngenLog 0 _    = Nothing\ngenLog x base = Just (exactLoop 0 x)\n  where\n  exactLoop s i\n    | i == 1     = (s,True)\n    | i < base   = (s,False)\n    | otherwise  =\n        let s1 = s + 1\n        in s1 `seq` case divMod i base of\n                      (j,r)\n                        | r == 0    -> exactLoop s1 j\n                        | otherwise -> (underLoop s1 j, False)\n\n  underLoop s i\n    | i < base  = s\n    | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i base)\n", "num_lines": 993}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nType subsumption and unification\n-}\n\n{-# LANGUAGE CPP, MultiWayIf, TupleSections, ScopedTypeVariables #-}\n\nmodule TcUnify (\n  -- Full-blown subsumption\n  tcWrapResult, tcWrapResultO, tcSkolemise, tcSkolemiseET,\n  tcSubTypeHR, tcSubTypeO, tcSubType_NC, tcSubTypeDS,\n  tcSubTypeDS_NC_O, tcSubTypeET,\n  checkConstraints, checkTvConstraints,\n  buildImplicationFor, emitResidualTvConstraint,\n\n  -- Various unifications\n  unifyType, unifyKind,\n  uType, promoteTcType,\n  swapOverTyVars, canSolveByUnification,\n\n  --------------------------------\n  -- Holes\n  tcInferInst, tcInferNoInst,\n  matchExpectedListTy,\n  matchExpectedTyConApp,\n  matchExpectedAppTy,\n  matchExpectedFunTys,\n  matchActualFunTys, matchActualFunTysPart,\n  matchExpectedFunKind,\n\n  metaTyVarUpdateOK, occCheckForErrors, OccCheckResult(..)\n\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport HsSyn\nimport TyCoRep\nimport TcMType\nimport TcRnMonad\nimport TcType\nimport Type\nimport Coercion\nimport TcEvidence\nimport Name( isSystemName )\nimport Inst\nimport TyCon\nimport TysWiredIn\nimport TysPrim( tYPE )\nimport Var\nimport VarSet\nimport VarEnv\nimport ErrUtils\nimport DynFlags\nimport BasicTypes\nimport Bag\nimport Util\nimport qualified GHC.LanguageExtensions as LangExt\nimport Outputable\n\nimport Control.Monad\nimport Control.Arrow ( second )\n\n{-\n************************************************************************\n*                                                                      *\n             matchExpected functions\n*                                                                      *\n************************************************************************\n\nNote [Herald for matchExpectedFunTys]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe 'herald' always looks like:\n   \"The equation(s) for 'f' have\"\n   \"The abstraction (\\x.e) takes\"\n   \"The section (+ x) expects\"\n   \"The function 'f' is applied to\"\n\nThis is used to construct a message of form\n\n   The abstraction `\\Just 1 -> ...' takes two arguments\n   but its type `Maybe a -> a' has only one\n\n   The equation(s) for `f' have two arguments\n   but its type `Maybe a -> a' has only one\n\n   The section `(f 3)' requires 'f' to take two arguments\n   but its type `Int -> Int' has only one\n\n   The function 'f' is applied to two arguments\n   but its type `Int -> Int' has only one\n\nWhen visible type applications (e.g., `f @Int 1 2`, as in #13902) enter the\npicture, we have a choice in deciding whether to count the type applications as\nproper arguments:\n\n   The function 'f' is applied to one visible type argument\n     and two value arguments\n   but its type `forall a. a -> a` has only one visible type argument\n     and one value argument\n\nOr whether to include the type applications as part of the herald itself:\n\n   The expression 'f @Int' is applied to two arguments\n   but its type `Int -> Int` has only one\n\nThe latter is easier to implement and is arguably easier to understand, so we\nchoose to implement that option.\n\nNote [matchExpectedFunTys]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nmatchExpectedFunTys checks that a sigma has the form\nof an n-ary function.  It passes the decomposed type to the\nthing_inside, and returns a wrapper to coerce between the two types\n\nIt's used wherever a language construct must have a functional type,\nnamely:\n        A lambda expression\n        A function definition\n     An operator section\n\nThis function must be written CPS'd because it needs to fill in the\nExpTypes produced for arguments before it can fill in the ExpType\npassed in.\n\n-}\n\n-- Use this one when you have an \"expected\" type.\nmatchExpectedFunTys :: forall a.\n                       SDoc   -- See Note [Herald for matchExpectedFunTys]\n                    -> Arity\n                    -> ExpRhoType  -- deeply skolemised\n                    -> ([ExpSigmaType] -> ExpRhoType -> TcM a)\n                          -- must fill in these ExpTypes here\n                    -> TcM (a, HsWrapper)\n-- If    matchExpectedFunTys n ty = (_, wrap)\n-- then  wrap : (t1 -> ... -> tn -> ty_r) ~> ty,\n--   where [t1, ..., tn], ty_r are passed to the thing_inside\nmatchExpectedFunTys herald arity orig_ty thing_inside\n  = case orig_ty of\n      Check ty -> go [] arity ty\n      _        -> defer [] arity orig_ty\n  where\n    go acc_arg_tys 0 ty\n      = do { result <- thing_inside (reverse acc_arg_tys) (mkCheckExpType ty)\n           ; return (result, idHsWrapper) }\n\n    go acc_arg_tys n ty\n      | Just ty' <- tcView ty = go acc_arg_tys n ty'\n\n    go acc_arg_tys n (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty })\n      = ASSERT( af == VisArg )\n        do { (result, wrap_res) <- go (mkCheckExpType arg_ty : acc_arg_tys)\n                                      (n-1) res_ty\n           ; return ( result\n                    , mkWpFun idHsWrapper wrap_res arg_ty res_ty doc ) }\n      where\n        doc = text \"When inferring the argument type of a function with type\" <+>\n              quotes (ppr orig_ty)\n\n    go acc_arg_tys n ty@(TyVarTy tv)\n      | isMetaTyVar tv\n      = do { cts <- readMetaTyVar tv\n           ; case cts of\n               Indirect ty' -> go acc_arg_tys n ty'\n               Flexi        -> defer acc_arg_tys n (mkCheckExpType ty) }\n\n       -- In all other cases we bale out into ordinary unification\n       -- However unlike the meta-tyvar case, we are sure that the\n       -- number of arguments doesn't match arity of the original\n       -- type, so we can add a bit more context to the error message\n       -- (cf Trac #7869).\n       --\n       -- It is not always an error, because specialized type may have\n       -- different arity, for example:\n       --\n       -- > f1 = f2 'a'\n       -- > f2 :: Monad m => m Bool\n       -- > f2 = undefined\n       --\n       -- But in that case we add specialized type into error context\n       -- anyway, because it may be useful. See also Trac #9605.\n    go acc_arg_tys n ty = addErrCtxtM mk_ctxt $\n                          defer acc_arg_tys n (mkCheckExpType ty)\n\n    ------------\n    defer :: [ExpSigmaType] -> Arity -> ExpRhoType -> TcM (a, HsWrapper)\n    defer acc_arg_tys n fun_ty\n      = do { more_arg_tys <- replicateM n newInferExpTypeNoInst\n           ; res_ty       <- newInferExpTypeInst\n           ; result       <- thing_inside (reverse acc_arg_tys ++ more_arg_tys) res_ty\n           ; more_arg_tys <- mapM readExpType more_arg_tys\n           ; res_ty       <- readExpType res_ty\n           ; let unif_fun_ty = mkVisFunTys more_arg_tys res_ty\n           ; wrap <- tcSubTypeDS AppOrigin GenSigCtxt unif_fun_ty fun_ty\n                         -- Not a good origin at all :-(\n           ; return (result, wrap) }\n\n    ------------\n    mk_ctxt :: TidyEnv -> TcM (TidyEnv, MsgDoc)\n    mk_ctxt env = do { (env', ty) <- zonkTidyTcType env orig_tc_ty\n                     ; let (args, _) = tcSplitFunTys ty\n                           n_actual = length args\n                           (env'', orig_ty') = tidyOpenType env' orig_tc_ty\n                     ; return ( env''\n                              , mk_fun_tys_msg orig_ty' ty n_actual arity herald) }\n      where\n        orig_tc_ty = checkingExpType \"matchExpectedFunTys\" orig_ty\n            -- this is safe b/c we're called from \"go\"\n\n-- Like 'matchExpectedFunTys', but used when you have an \"actual\" type,\n-- for example in function application\nmatchActualFunTys :: SDoc   -- See Note [Herald for matchExpectedFunTys]\n                  -> CtOrigin\n                  -> Maybe (HsExpr GhcRn)   -- the thing with type TcSigmaType\n                  -> Arity\n                  -> TcSigmaType\n                  -> TcM (HsWrapper, [TcSigmaType], TcSigmaType)\n-- If    matchActualFunTys n ty = (wrap, [t1,..,tn], ty_r)\n-- then  wrap : ty ~> (t1 -> ... -> tn -> ty_r)\nmatchActualFunTys herald ct_orig mb_thing arity ty\n  = matchActualFunTysPart herald ct_orig mb_thing arity ty [] arity\n\n-- | Variant of 'matchActualFunTys' that works when supplied only part\n-- (that is, to the right of some arrows) of the full function type\nmatchActualFunTysPart :: SDoc -- See Note [Herald for matchExpectedFunTys]\n                      -> CtOrigin\n                      -> Maybe (HsExpr GhcRn)  -- the thing with type TcSigmaType\n                      -> Arity\n                      -> TcSigmaType\n                      -> [TcSigmaType] -- reversed args. See (*) below.\n                      -> Arity   -- overall arity of the function, for errs\n                      -> TcM (HsWrapper, [TcSigmaType], TcSigmaType)\nmatchActualFunTysPart herald ct_orig mb_thing arity orig_ty\n                      orig_old_args full_arity\n  = go arity orig_old_args orig_ty\n-- Does not allocate unnecessary meta variables: if the input already is\n-- a function, we just take it apart.  Not only is this efficient,\n-- it's important for higher rank: the argument might be of form\n--              (forall a. ty) -> other\n-- If allocated (fresh-meta-var1 -> fresh-meta-var2) and unified, we'd\n-- hide the forall inside a meta-variable\n\n-- (*) Sometimes it's necessary to call matchActualFunTys with only part\n-- (that is, to the right of some arrows) of the type of the function in\n-- question. (See TcExpr.tcArgs.) This argument is the reversed list of\n-- arguments already seen (that is, not part of the TcSigmaType passed\n-- in elsewhere).\n\n  where\n    -- This function has a bizarre mechanic: it accumulates arguments on\n    -- the way down and also builds an argument list on the way up. Why:\n    -- 1. The returns args list and the accumulated args list might be different.\n    --    The accumulated args include all the arg types for the function,\n    --    including those from before this function was called. The returned\n    --    list should include only those arguments produced by this call of\n    --    matchActualFunTys\n    --\n    -- 2. The HsWrapper can be built only on the way up. It seems (more)\n    --    bizarre to build the HsWrapper but not the arg_tys.\n    --\n    -- Refactoring is welcome.\n    go :: Arity\n       -> [TcSigmaType] -- accumulator of arguments (reversed)\n       -> TcSigmaType   -- the remainder of the type as we're processing\n       -> TcM (HsWrapper, [TcSigmaType], TcSigmaType)\n    go 0 _ ty = return (idHsWrapper, [], ty)\n\n    go n acc_args ty\n      | not (null tvs && null theta)\n      = do { (wrap1, rho) <- topInstantiate ct_orig ty\n           ; (wrap2, arg_tys, res_ty) <- go n acc_args rho\n           ; return (wrap2 <.> wrap1, arg_tys, res_ty) }\n      where\n        (tvs, theta, _) = tcSplitSigmaTy ty\n\n    go n acc_args ty\n      | Just ty' <- tcView ty = go n acc_args ty'\n\n    go n acc_args (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty })\n      = ASSERT( af == VisArg )\n        do { (wrap_res, tys, ty_r) <- go (n-1) (arg_ty : acc_args) res_ty\n           ; return ( mkWpFun idHsWrapper wrap_res arg_ty ty_r doc\n                    , arg_ty : tys, ty_r ) }\n      where\n        doc = text \"When inferring the argument type of a function with type\" <+>\n              quotes (ppr orig_ty)\n\n    go n acc_args ty@(TyVarTy tv)\n      | isMetaTyVar tv\n      = do { cts <- readMetaTyVar tv\n           ; case cts of\n               Indirect ty' -> go n acc_args ty'\n               Flexi        -> defer n ty }\n\n       -- In all other cases we bale out into ordinary unification\n       -- However unlike the meta-tyvar case, we are sure that the\n       -- number of arguments doesn't match arity of the original\n       -- type, so we can add a bit more context to the error message\n       -- (cf Trac #7869).\n       --\n       -- It is not always an error, because specialized type may have\n       -- different arity, for example:\n       --\n       -- > f1 = f2 'a'\n       -- > f2 :: Monad m => m Bool\n       -- > f2 = undefined\n       --\n       -- But in that case we add specialized type into error context\n       -- anyway, because it may be useful. See also Trac #9605.\n    go n acc_args ty = addErrCtxtM (mk_ctxt (reverse acc_args) ty) $\n                       defer n ty\n\n    ------------\n    defer n fun_ty\n      = do { arg_tys <- replicateM n newOpenFlexiTyVarTy\n           ; res_ty  <- newOpenFlexiTyVarTy\n           ; let unif_fun_ty = mkVisFunTys arg_tys res_ty\n           ; co <- unifyType mb_thing fun_ty unif_fun_ty\n           ; return (mkWpCastN co, arg_tys, res_ty) }\n\n    ------------\n    mk_ctxt :: [TcSigmaType] -> TcSigmaType -> TidyEnv -> TcM (TidyEnv, MsgDoc)\n    mk_ctxt arg_tys res_ty env\n      = do { let ty = mkVisFunTys arg_tys res_ty\n           ; (env1, zonked) <- zonkTidyTcType env ty\n                   -- zonking might change # of args\n           ; let (zonked_args, _) = tcSplitFunTys zonked\n                 n_actual         = length zonked_args\n                 (env2, unzonked) = tidyOpenType env1 ty\n           ; return ( env2\n                    , mk_fun_tys_msg unzonked zonked n_actual full_arity herald) }\n\nmk_fun_tys_msg :: TcType  -- the full type passed in (unzonked)\n               -> TcType  -- the full type passed in (zonked)\n               -> Arity   -- the # of args found\n               -> Arity   -- the # of args wanted\n               -> SDoc    -- overall herald\n               -> SDoc\nmk_fun_tys_msg full_ty ty n_args full_arity herald\n  = herald <+> speakNOf full_arity (text \"argument\") <> comma $$\n    if n_args == full_arity\n      then text \"its type is\" <+> quotes (pprType full_ty) <>\n           comma $$\n           text \"it is specialized to\" <+> quotes (pprType ty)\n      else sep [text \"but its type\" <+> quotes (pprType ty),\n                if n_args == 0 then text \"has none\"\n                else text \"has only\" <+> speakN n_args]\n\n----------------------\nmatchExpectedListTy :: TcRhoType -> TcM (TcCoercionN, TcRhoType)\n-- Special case for lists\nmatchExpectedListTy exp_ty\n = do { (co, [elt_ty]) <- matchExpectedTyConApp listTyCon exp_ty\n      ; return (co, elt_ty) }\n\n---------------------\nmatchExpectedTyConApp :: TyCon                -- T :: forall kv1 ... kvm. k1 -> ... -> kn -> *\n                      -> TcRhoType            -- orig_ty\n                      -> TcM (TcCoercionN,    -- T k1 k2 k3 a b c ~N orig_ty\n                              [TcSigmaType])  -- Element types, k1 k2 k3 a b c\n\n-- It's used for wired-in tycons, so we call checkWiredInTyCon\n-- Precondition: never called with FunTyCon\n-- Precondition: input type :: *\n-- Postcondition: (T k1 k2 k3 a b c) is well-kinded\n\nmatchExpectedTyConApp tc orig_ty\n  = ASSERT(tc /= funTyCon) go orig_ty\n  where\n    go ty\n       | Just ty' <- tcView ty\n       = go ty'\n\n    go ty@(TyConApp tycon args)\n       | tc == tycon  -- Common case\n       = return (mkTcNomReflCo ty, args)\n\n    go (TyVarTy tv)\n       | isMetaTyVar tv\n       = do { cts <- readMetaTyVar tv\n            ; case cts of\n                Indirect ty -> go ty\n                Flexi       -> defer }\n\n    go _ = defer\n\n    -- If the common case does not occur, instantiate a template\n    -- T k1 .. kn t1 .. tm, and unify with the original type\n    -- Doing it this way ensures that the types we return are\n    -- kind-compatible with T.  For example, suppose we have\n    --       matchExpectedTyConApp T (f Maybe)\n    -- where data T a = MkT a\n    -- Then we don't want to instantiate T's data constructors with\n    --    (a::*) ~ Maybe\n    -- because that'll make types that are utterly ill-kinded.\n    -- This happened in Trac #7368\n    defer\n      = do { (_, arg_tvs) <- newMetaTyVars (tyConTyVars tc)\n           ; traceTc \"matchExpectedTyConApp\" (ppr tc $$ ppr (tyConTyVars tc) $$ ppr arg_tvs)\n           ; let args = mkTyVarTys arg_tvs\n                 tc_template = mkTyConApp tc args\n           ; co <- unifyType Nothing tc_template orig_ty\n           ; return (co, args) }\n\n----------------------\nmatchExpectedAppTy :: TcRhoType                         -- orig_ty\n                   -> TcM (TcCoercion,                   -- m a ~N orig_ty\n                           (TcSigmaType, TcSigmaType))  -- Returns m, a\n-- If the incoming type is a mutable type variable of kind k, then\n-- matchExpectedAppTy returns a new type variable (m: * -> k); note the *.\n\nmatchExpectedAppTy orig_ty\n  = go orig_ty\n  where\n    go ty\n      | Just ty' <- tcView ty = go ty'\n\n      | Just (fun_ty, arg_ty) <- tcSplitAppTy_maybe ty\n      = return (mkTcNomReflCo orig_ty, (fun_ty, arg_ty))\n\n    go (TyVarTy tv)\n      | isMetaTyVar tv\n      = do { cts <- readMetaTyVar tv\n           ; case cts of\n               Indirect ty -> go ty\n               Flexi       -> defer }\n\n    go _ = defer\n\n    -- Defer splitting by generating an equality constraint\n    defer\n      = do { ty1 <- newFlexiTyVarTy kind1\n           ; ty2 <- newFlexiTyVarTy kind2\n           ; co <- unifyType Nothing (mkAppTy ty1 ty2) orig_ty\n           ; return (co, (ty1, ty2)) }\n\n    orig_kind = tcTypeKind orig_ty\n    kind1 = mkVisFunTy liftedTypeKind orig_kind\n    kind2 = liftedTypeKind    -- m :: * -> k\n                              -- arg type :: *\n\n{-\n************************************************************************\n*                                                                      *\n                Subsumption checking\n*                                                                      *\n************************************************************************\n\nNote [Subsumption checking: tcSubType]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAll the tcSubType calls have the form\n                tcSubType actual_ty expected_ty\nwhich checks\n                actual_ty <= expected_ty\n\nThat is, that a value of type actual_ty is acceptable in\na place expecting a value of type expected_ty.  I.e. that\n\n    actual ty   is more polymorphic than   expected_ty\n\nIt returns a coercion function\n        co_fn :: actual_ty ~ expected_ty\nwhich takes an HsExpr of type actual_ty into one of type\nexpected_ty.\n\nThese functions do not actually check for subsumption. They check if\nexpected_ty is an appropriate annotation to use for something of type\nactual_ty. This difference matters when thinking about visible type\napplication. For example,\n\n   forall a. a -> forall b. b -> b\n      DOES NOT SUBSUME\n   forall a b. a -> b -> b\n\nbecause the type arguments appear in a different order. (Neither does\nit work the other way around.) BUT, these types are appropriate annotations\nfor one another. Because the user directs annotations, it's OK if some\narguments shuffle around -- after all, it's what the user wants.\nBottom line: none of this changes with visible type application.\n\nThere are a number of wrinkles (below).\n\nNotice that Wrinkle 1 and 2 both require eta-expansion, which technically\nmay increase termination.  We just put up with this, in exchange for getting\nmore predictable type inference.\n\nWrinkle 1: Note [Deep skolemisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want   (forall a. Int -> a -> a)  <=  (Int -> forall a. a->a)\n(see section 4.6 of \"Practical type inference for higher rank types\")\nSo we must deeply-skolemise the RHS before we instantiate the LHS.\n\nThat is why tc_sub_type starts with a call to tcSkolemise (which does the\ndeep skolemisation), and then calls the DS variant (which assumes\nthat expected_ty is deeply skolemised)\n\nWrinkle 2: Note [Co/contra-variance of subsumption checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider  g :: (Int -> Int) -> Int\n  f1 :: (forall a. a -> a) -> Int\n  f1 = g\n\n  f2 :: (forall a. a -> a) -> Int\n  f2 x = g x\nf2 will typecheck, and it would be odd/fragile if f1 did not.\nBut f1 will only typecheck if we have that\n    (Int->Int) -> Int  <=  (forall a. a->a) -> Int\nAnd that is only true if we do the full co/contravariant thing\nin the subsumption check.  That happens in the FunTy case of\ntcSubTypeDS_NC_O, and is the sole reason for the WpFun form of\nHsWrapper.\n\nAnother powerful reason for doing this co/contra stuff is visible\nin Trac #9569, involving instantiation of constraint variables,\nand again involving eta-expansion.\n\nWrinkle 3: Note [Higher rank types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider tc150:\n  f y = \\ (x::forall a. a->a). blah\nThe following happens:\n* We will infer the type of the RHS, ie with a res_ty = alpha.\n* Then the lambda will split  alpha := beta -> gamma.\n* And then we'll check tcSubType IsSwapped beta (forall a. a->a)\n\nSo it's important that we unify beta := forall a. a->a, rather than\nskolemising the type.\n-}\n\n\n-- | Call this variant when you are in a higher-rank situation and\n-- you know the right-hand type is deeply skolemised.\ntcSubTypeHR :: CtOrigin               -- ^ of the actual type\n            -> Maybe (HsExpr GhcRn)   -- ^ If present, it has type ty_actual\n            -> TcSigmaType -> ExpRhoType -> TcM HsWrapper\ntcSubTypeHR orig = tcSubTypeDS_NC_O orig GenSigCtxt\n\n------------------------\ntcSubTypeET :: CtOrigin -> UserTypeCtxt\n            -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper\n-- If wrap = tc_sub_type_et t1 t2\n--    => wrap :: t1 ~> t2\ntcSubTypeET orig ctxt (Check ty_actual) ty_expected\n  = tc_sub_tc_type eq_orig orig ctxt ty_actual ty_expected\n  where\n    eq_orig = TypeEqOrigin { uo_actual   = ty_expected\n                           , uo_expected = ty_actual\n                           , uo_thing    = Nothing\n                           , uo_visible  = True }\n\ntcSubTypeET _ _ (Infer inf_res) ty_expected\n  = ASSERT2( not (ir_inst inf_res), ppr inf_res $$ ppr ty_expected )\n      -- An (Infer inf_res) ExpSigmaType passed into tcSubTypeET never\n      -- has the ir_inst field set.  Reason: in patterns (which is what\n      -- tcSubTypeET is used for) do not aggressively instantiate\n    do { co <- fill_infer_result ty_expected inf_res\n               -- Since ir_inst is false, we can skip fillInferResult\n               -- and go straight to fill_infer_result\n\n       ; return (mkWpCastN (mkTcSymCo co)) }\n\n------------------------\ntcSubTypeO :: CtOrigin      -- ^ of the actual type\n           -> UserTypeCtxt  -- ^ of the expected type\n           -> TcSigmaType\n           -> ExpRhoType\n           -> TcM HsWrapper\ntcSubTypeO orig ctxt ty_actual ty_expected\n  = addSubTypeCtxt ty_actual ty_expected $\n    do { traceTc \"tcSubTypeDS_O\" (vcat [ pprCtOrigin orig\n                                       , pprUserTypeCtxt ctxt\n                                       , ppr ty_actual\n                                       , ppr ty_expected ])\n       ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected }\n\naddSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a\naddSubTypeCtxt ty_actual ty_expected thing_inside\n | isRhoTy ty_actual        -- If there is no polymorphism involved, the\n , isRhoExpTy ty_expected   -- TypeEqOrigin stuff (added by the _NC functions)\n = thing_inside             -- gives enough context by itself\n | otherwise\n = addErrCtxtM mk_msg thing_inside\n  where\n    mk_msg tidy_env\n      = do { (tidy_env, ty_actual)   <- zonkTidyTcType tidy_env ty_actual\n                   -- might not be filled if we're debugging. ugh.\n           ; mb_ty_expected          <- readExpType_maybe ty_expected\n           ; (tidy_env, ty_expected) <- case mb_ty_expected of\n                                          Just ty -> second mkCheckExpType <$>\n                                                     zonkTidyTcType tidy_env ty\n                                          Nothing -> return (tidy_env, ty_expected)\n           ; ty_expected             <- readExpType ty_expected\n           ; (tidy_env, ty_expected) <- zonkTidyTcType tidy_env ty_expected\n           ; let msg = vcat [ hang (text \"When checking that:\")\n                                 4 (ppr ty_actual)\n                            , nest 2 (hang (text \"is more polymorphic than:\")\n                                         2 (ppr ty_expected)) ]\n           ; return (tidy_env, msg) }\n\n---------------\n-- The \"_NC\" variants do not add a typechecker-error context;\n-- the caller is assumed to do that\n\ntcSubType_NC :: UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper\n-- Checks that actual <= expected\n-- Returns HsWrapper :: actual ~ expected\ntcSubType_NC ctxt ty_actual ty_expected\n  = do { traceTc \"tcSubType_NC\" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])\n       ; tc_sub_tc_type origin origin ctxt ty_actual ty_expected }\n  where\n    origin = TypeEqOrigin { uo_actual   = ty_actual\n                          , uo_expected = ty_expected\n                          , uo_thing    = Nothing\n                          , uo_visible  = True }\n\ntcSubTypeDS :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> ExpRhoType -> TcM HsWrapper\n-- Just like tcSubType, but with the additional precondition that\n-- ty_expected is deeply skolemised (hence \"DS\")\ntcSubTypeDS orig ctxt ty_actual ty_expected\n  = addSubTypeCtxt ty_actual ty_expected $\n    do { traceTc \"tcSubTypeDS_NC\" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])\n       ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected }\n\ntcSubTypeDS_NC_O :: CtOrigin   -- origin used for instantiation only\n                 -> UserTypeCtxt\n                 -> Maybe (HsExpr GhcRn)\n                 -> TcSigmaType -> ExpRhoType -> TcM HsWrapper\n-- Just like tcSubType, but with the additional precondition that\n-- ty_expected is deeply skolemised\ntcSubTypeDS_NC_O inst_orig ctxt m_thing ty_actual ty_expected\n  = case ty_expected of\n      Infer inf_res -> fillInferResult inst_orig ty_actual inf_res\n      Check ty      -> tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty\n         where\n           eq_orig = TypeEqOrigin { uo_actual = ty_actual, uo_expected = ty\n                                  , uo_thing  = ppr <$> m_thing\n                                  , uo_visible = True }\n\n---------------\ntc_sub_tc_type :: CtOrigin   -- used when calling uType\n               -> CtOrigin   -- used when instantiating\n               -> UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper\n-- If wrap = tc_sub_type t1 t2\n--    => wrap :: t1 ~> t2\ntc_sub_tc_type eq_orig inst_orig ctxt ty_actual ty_expected\n  | definitely_poly ty_expected      -- See Note [Don't skolemise unnecessarily]\n  , not (possibly_poly ty_actual)\n  = do { traceTc \"tc_sub_tc_type (drop to equality)\" $\n         vcat [ text \"ty_actual   =\" <+> ppr ty_actual\n              , text \"ty_expected =\" <+> ppr ty_expected ]\n       ; mkWpCastN <$>\n         uType TypeLevel eq_orig ty_actual ty_expected }\n\n  | otherwise   -- This is the general case\n  = do { traceTc \"tc_sub_tc_type (general case)\" $\n         vcat [ text \"ty_actual   =\" <+> ppr ty_actual\n              , text \"ty_expected =\" <+> ppr ty_expected ]\n       ; (sk_wrap, inner_wrap) <- tcSkolemise ctxt ty_expected $\n                                                   \\ _ sk_rho ->\n                                  tc_sub_type_ds eq_orig inst_orig ctxt\n                                                 ty_actual sk_rho\n       ; return (sk_wrap <.> inner_wrap) }\n  where\n    possibly_poly ty\n      | isForAllTy ty                        = True\n      | Just (_, res) <- splitFunTy_maybe ty = possibly_poly res\n      | otherwise                            = False\n      -- NB *not* tcSplitFunTy, because here we want\n      -- to decompose type-class arguments too\n\n    definitely_poly ty\n      | (tvs, theta, tau) <- tcSplitSigmaTy ty\n      , (tv:_) <- tvs\n      , null theta\n      , isInsolubleOccursCheck NomEq tv tau\n      = True\n      | otherwise\n      = False\n\n{- Note [Don't skolemise unnecessarily]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we are trying to solve\n    (Char->Char) <= (forall a. a->a)\nWe could skolemise the 'forall a', and then complain\nthat (Char ~ a) is insoluble; but that's a pretty obscure\nerror.  It's better to say that\n    (Char->Char) ~ (forall a. a->a)\nfails.\n\nSo roughly:\n * if the ty_expected has an outermost forall\n      (i.e. skolemisation is the next thing we'd do)\n * and the ty_actual has no top-level polymorphism (but looking deeply)\nthen we can revert to simple equality.  But we need to be careful.\nThese examples are all fine:\n\n * (Char -> forall a. a->a) <= (forall a. Char -> a -> a)\n      Polymorphism is buried in ty_actual\n\n * (Char->Char) <= (forall a. Char -> Char)\n      ty_expected isn't really polymorphic\n\n * (Char->Char) <= (forall a. (a~Char) => a -> a)\n      ty_expected isn't really polymorphic\n\n * (Char->Char) <= (forall a. F [a] Char -> Char)\n                   where type instance F [x] t = t\n     ty_expected isn't really polymorphic\n\nIf we prematurely go to equality we'll reject a program we should\naccept (e.g. Trac #13752).  So the test (which is only to improve\nerror message) is very conservative:\n * ty_actual is /definitely/ monomorphic\n * ty_expected is /definitely/ polymorphic\n-}\n\n---------------\ntc_sub_type_ds :: CtOrigin    -- used when calling uType\n               -> CtOrigin    -- used when instantiating\n               -> UserTypeCtxt -> TcSigmaType -> TcRhoType -> TcM HsWrapper\n-- If wrap = tc_sub_type_ds t1 t2\n--    => wrap :: t1 ~> t2\n-- Here is where the work actually happens!\n-- Precondition: ty_expected is deeply skolemised\ntc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected\n  = do { traceTc \"tc_sub_type_ds\" $\n         vcat [ text \"ty_actual   =\" <+> ppr ty_actual\n              , text \"ty_expected =\" <+> ppr ty_expected ]\n       ; go ty_actual ty_expected }\n  where\n    go ty_a ty_e | Just ty_a' <- tcView ty_a = go ty_a' ty_e\n                 | Just ty_e' <- tcView ty_e = go ty_a  ty_e'\n\n    go (TyVarTy tv_a) ty_e\n      = do { lookup_res <- lookupTcTyVar tv_a\n           ; case lookup_res of\n               Filled ty_a' ->\n                 do { traceTc \"tcSubTypeDS_NC_O following filled act meta-tyvar:\"\n                        (ppr tv_a <+> text \"-->\" <+> ppr ty_a')\n                    ; tc_sub_type_ds eq_orig inst_orig ctxt ty_a' ty_e }\n               Unfilled _   -> unify }\n\n    -- Historical note (Sept 16): there was a case here for\n    --    go ty_a (TyVarTy alpha)\n    -- which, in the impredicative case unified  alpha := ty_a\n    -- where th_a is a polytype.  Not only is this probably bogus (we\n    -- simply do not have decent story for impredicative types), but it\n    -- caused Trac #12616 because (also bizarrely) 'deriving' code had\n    -- -XImpredicativeTypes on.  I deleted the entire case.\n\n    go (FunTy { ft_af = VisArg, ft_arg = act_arg, ft_res = act_res })\n       (FunTy { ft_af = VisArg, ft_arg = exp_arg, ft_res = exp_res })\n      = -- See Note [Co/contra-variance of subsumption checking]\n        do { res_wrap <- tc_sub_type_ds eq_orig inst_orig  ctxt       act_res exp_res\n           ; arg_wrap <- tc_sub_tc_type eq_orig given_orig GenSigCtxt exp_arg act_arg\n                         -- GenSigCtxt: See Note [Setting the argument context]\n           ; return (mkWpFun arg_wrap res_wrap exp_arg exp_res doc) }\n               -- arg_wrap :: exp_arg ~> act_arg\n               -- res_wrap :: act-res ~> exp_res\n      where\n        given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg [])\n        doc = text \"When checking that\" <+> quotes (ppr ty_actual) <+>\n              text \"is more polymorphic than\" <+> quotes (ppr ty_expected)\n\n    go ty_a ty_e\n      | let (tvs, theta, _) = tcSplitSigmaTy ty_a\n      , not (null tvs && null theta)\n      = do { (in_wrap, in_rho) <- topInstantiate inst_orig ty_a\n           ; body_wrap <- tc_sub_type_ds\n                            (eq_orig { uo_actual = in_rho\n                                     , uo_expected = ty_expected })\n                            inst_orig ctxt in_rho ty_e\n           ; return (body_wrap <.> in_wrap) }\n\n      | otherwise   -- Revert to unification\n      = inst_and_unify\n         -- It's still possible that ty_actual has nested foralls. Instantiate\n         -- these, as there's no way unification will succeed with them in.\n         -- See typecheck/should_compile/T11305 for an example of when this\n         -- is important. The problem is that we're checking something like\n         --  a -> forall b. b -> b     <=   alpha beta gamma\n         -- where we end up with alpha := (->)\n\n    inst_and_unify = do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual\n\n                           -- If we haven't recurred through an arrow, then\n                           -- the eq_orig will list ty_actual. In this case,\n                           -- we want to update the origin to reflect the\n                           -- instantiation. If we *have* recurred through\n                           -- an arrow, it's better not to update.\n                        ; let eq_orig' = case eq_orig of\n                                TypeEqOrigin { uo_actual   = orig_ty_actual }\n                                  |  orig_ty_actual `tcEqType` ty_actual\n                                  ,  not (isIdHsWrapper wrap)\n                                  -> eq_orig { uo_actual = rho_a }\n                                _ -> eq_orig\n\n                        ; cow <- uType TypeLevel eq_orig' rho_a ty_expected\n                        ; return (mkWpCastN cow <.> wrap) }\n\n\n     -- use versions without synonyms expanded\n    unify = mkWpCastN <$> uType TypeLevel eq_orig ty_actual ty_expected\n\n{- Note [Settting the argument context]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider we are doing the ambiguity check for the (bogus)\n  f :: (forall a b. C b => a -> a) -> Int\n\nWe'll call\n   tcSubType ((forall a b. C b => a->a) -> Int )\n             ((forall a b. C b => a->a) -> Int )\n\nwith a UserTypeCtxt of (FunSigCtxt \"f\").  Then we'll do the co/contra thing\non the argument type of the (->) -- and at that point we want to switch\nto a UserTypeCtxt of GenSigCtxt.  Why?\n\n* Error messages.  If we stick with FunSigCtxt we get errors like\n     * Could not deduce: C b\n       from the context: C b0\n        bound by the type signature for:\n            f :: forall a b. C b => a->a\n  But of course f does not have that type signature!\n  Example tests: T10508, T7220a, Simple14\n\n* Implications. We may decide to build an implication for the whole\n  ambiguity check, but we don't need one for each level within it,\n  and TcUnify.alwaysBuildImplication checks the UserTypeCtxt.\n  See Note [When to build an implication]\n-}\n\n-----------------\n-- needs both un-type-checked (for origins) and type-checked (for wrapping)\n-- expressions\ntcWrapResult :: HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType\n             -> TcM (HsExpr GhcTcId)\ntcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr\n\n-- | Sometimes we don't have a @HsExpr Name@ to hand, and this is more\n-- convenient.\ntcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType\n               -> TcM (HsExpr GhcTcId)\ntcWrapResultO orig rn_expr expr actual_ty res_ty\n  = do { traceTc \"tcWrapResult\" (vcat [ text \"Actual:  \" <+> ppr actual_ty\n                                      , text \"Expected:\" <+> ppr res_ty ])\n       ; cow <- tcSubTypeDS_NC_O orig GenSigCtxt\n                                 (Just rn_expr) actual_ty res_ty\n       ; return (mkHsWrap cow expr) }\n\n\n{- **********************************************************************\n%*                                                                      *\n            ExpType functions: tcInfer, fillInferResult\n%*                                                                      *\n%********************************************************************* -}\n\n-- | Infer a type using a fresh ExpType\n-- See also Note [ExpType] in TcMType\n-- Does not attempt to instantiate the inferred type\ntcInferNoInst :: (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType)\ntcInferNoInst = tcInfer False\n\ntcInferInst :: (ExpRhoType -> TcM a) -> TcM (a, TcRhoType)\ntcInferInst = tcInfer True\n\ntcInfer :: Bool -> (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType)\ntcInfer instantiate tc_check\n  = do { res_ty <- newInferExpType instantiate\n       ; result <- tc_check res_ty\n       ; res_ty <- readExpType res_ty\n       ; return (result, res_ty) }\n\nfillInferResult :: CtOrigin -> TcType -> InferResult -> TcM HsWrapper\n-- If wrap = fillInferResult t1 t2\n--    => wrap :: t1 ~> t2\n-- See Note [Deep instantiation of InferResult]\nfillInferResult orig ty inf_res@(IR { ir_inst = instantiate_me })\n  | instantiate_me\n  = do { (wrap, rho) <- deeplyInstantiate orig ty\n       ; co <- fill_infer_result rho inf_res\n       ; return (mkWpCastN co <.> wrap) }\n\n  | otherwise\n  = do { co <- fill_infer_result ty inf_res\n       ; return (mkWpCastN co) }\n\nfill_infer_result :: TcType -> InferResult -> TcM TcCoercionN\n-- If wrap = fill_infer_result t1 t2\n--    => wrap :: t1 ~> t2\nfill_infer_result orig_ty (IR { ir_uniq = u, ir_lvl = res_lvl\n                            , ir_ref = ref })\n  = do { (ty_co, ty_to_fill_with) <- promoteTcType res_lvl orig_ty\n\n       ; traceTc \"Filling ExpType\" $\n         ppr u <+> text \":=\" <+> ppr ty_to_fill_with\n\n       ; when debugIsOn (check_hole ty_to_fill_with)\n\n       ; writeTcRef ref (Just ty_to_fill_with)\n\n       ; return ty_co }\n  where\n    check_hole ty   -- Debug check only\n      = do { let ty_lvl = tcTypeLevel ty\n           ; MASSERT2( not (ty_lvl `strictlyDeeperThan` res_lvl),\n                       ppr u $$ ppr res_lvl $$ ppr ty_lvl $$\n                       ppr ty <+> dcolon <+> ppr (tcTypeKind ty) $$ ppr orig_ty )\n           ; cts <- readTcRef ref\n           ; case cts of\n               Just already_there -> pprPanic \"writeExpType\"\n                                       (vcat [ ppr u\n                                             , ppr ty\n                                             , ppr already_there ])\n               Nothing -> return () }\n\n{- Note [Deep instantiation of InferResult]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn some cases we want to deeply instantiate before filling in\nan InferResult, and in some cases not.  That's why InferReult\nhas the ir_inst flag.\n\n* ir_inst = True: deeply instantiate\n\n  Consider\n    f x = (*)\n  We want to instantiate the type of (*) before returning, else we\n  will infer the type\n    f :: forall {a}. a -> forall b. Num b => b -> b -> b\n  This is surely confusing for users.\n\n  And worse, the monomorphism restriction won't work properly. The MR is\n  dealt with in simplifyInfer, and simplifyInfer has no way of\n  instantiating. This could perhaps be worked around, but it may be\n  hard to know even when instantiation should happen.\n\n  Another reason.  Consider\n       f :: (?x :: Int) => a -> a\n       g y = let ?x = 3::Int in f\n  Here want to instantiate f's type so that the ?x::Int constraint\n  gets discharged by the enclosing implicit-parameter binding.\n\n* ir_inst = False: do not instantiate\n\n  Consider this (which uses visible type application):\n\n    (let { f :: forall a. a -> a; f x = x } in f) @Int\n\n  We'll call TcExpr.tcInferFun to infer the type of the (let .. in f)\n  And we don't want to instantite the type of 'f' when we reach it,\n  else the outer visible type application won't work\n-}\n\n{- *********************************************************************\n*                                                                      *\n              Promoting types\n*                                                                      *\n********************************************************************* -}\n\npromoteTcType :: TcLevel -> TcType -> TcM (TcCoercion, TcType)\n-- See Note [Promoting a type]\n-- promoteTcType level ty = (co, ty')\n--   * Returns ty'  whose max level is just 'level'\n--             and  whose kind is ~# to the kind of 'ty'\n--             and  whose kind has form TYPE rr\n--   * and co :: ty ~ ty'\n--   * and emits constraints to justify the coercion\npromoteTcType dest_lvl ty\n  = do { cur_lvl <- getTcLevel\n       ; if (cur_lvl `sameDepthAs` dest_lvl)\n         then dont_promote_it\n         else promote_it }\n  where\n    promote_it :: TcM (TcCoercion, TcType)\n    promote_it  -- Emit a constraint  (alpha :: TYPE rr) ~ ty\n                -- where alpha and rr are fresh and from level dest_lvl\n      = do { rr      <- newMetaTyVarTyAtLevel dest_lvl runtimeRepTy\n           ; prom_ty <- newMetaTyVarTyAtLevel dest_lvl (tYPE rr)\n           ; let eq_orig = TypeEqOrigin { uo_actual   = ty\n                                        , uo_expected = prom_ty\n                                        , uo_thing    = Nothing\n                                        , uo_visible  = False }\n\n           ; co <- emitWantedEq eq_orig TypeLevel Nominal ty prom_ty\n           ; return (co, prom_ty) }\n\n    dont_promote_it :: TcM (TcCoercion, TcType)\n    dont_promote_it  -- Check that ty :: TYPE rr, for some (fresh) rr\n      = do { res_kind <- newOpenTypeKind\n           ; let ty_kind = tcTypeKind ty\n                 kind_orig = TypeEqOrigin { uo_actual   = ty_kind\n                                          , uo_expected = res_kind\n                                          , uo_thing    = Nothing\n                                          , uo_visible  = False }\n           ; ki_co <- uType KindLevel kind_orig (tcTypeKind ty) res_kind\n           ; let co = mkTcGReflRightCo Nominal ty ki_co\n           ; return (co, ty `mkCastTy` ki_co) }\n\n{- Note [Promoting a type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider (Trac #12427)\n\n  data T where\n    MkT :: (Int -> Int) -> a -> T\n\n  h y = case y of MkT v w -> v\n\nWe'll infer the RHS type with an expected type ExpType of\n  (IR { ir_lvl = l, ir_ref = ref, ... )\nwhere 'l' is the TcLevel of the RHS of 'h'.  Then the MkT pattern\nmatch will increase the level, so we'll end up in tcSubType, trying to\nunify the type of v,\n  v :: Int -> Int\nwith the expected type.  But this attempt takes place at level (l+1),\nrightly so, since v's type could have mentioned existential variables,\n(like w's does) and we want to catch that.\n\nSo we\n  - create a new meta-var alpha[l+1]\n  - fill in the InferRes ref cell 'ref' with alpha\n  - emit an equality constraint, thus\n        [W] alpha[l+1] ~ (Int -> Int)\n\nThat constraint will float outwards, as it should, unless v's\ntype mentions a skolem-captured variable.\n\nThis approach fails if v has a higher rank type; see\nNote [Promotion and higher rank types]\n\n\nNote [Promotion and higher rank types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf v had a higher-rank type, say v :: (forall a. a->a) -> Int,\nthen we'd emit an equality\n        [W] alpha[l+1] ~ ((forall a. a->a) -> Int)\nwhich will sadly fail because we can't unify a unification variable\nwith a polytype.  But there is nothing really wrong with the program\nhere.\n\nWe could just about solve this by \"promote the type\" of v, to expose\nits polymorphic \"shape\" while still leaving constraints that will\nprevent existential escape.  But we must be careful!  Exposing\nthe \"shape\" of the type is precisely what we must NOT do under\na GADT pattern match!  So in this case we might promote the type\nto\n        (forall a. a->a) -> alpha[l+1]\nand emit the constraint\n        [W] alpha[l+1] ~ Int\nNow the promoted type can fill the ref cell, while the emitted\nequality can float or not, according to the usual rules.\n\nBut that's not quite right!  We are exposing the arrow! We could\ndeal with that too:\n        (forall a. mu[l+1] a a) -> alpha[l+1]\nwith constraints\n        [W] alpha[l+1] ~ Int\n        [W] mu[l+1] ~ (->)\nHere we abstract over the '->' inside the forall, in case that\nis subject to an equality constraint from a GADT match.\n\nNote that we kept the outer (->) because that's part of\nthe polymorphic \"shape\".  And because of impredicativity,\nGADT matches can't give equalities that affect polymorphic\nshape.\n\nThis reasoning just seems too complicated, so I decided not\nto do it.  These higher-rank notes are just here to record\nthe thinking.\n-}\n\n{- *********************************************************************\n*                                                                      *\n                    Generalisation\n*                                                                      *\n********************************************************************* -}\n\n-- | Take an \"expected type\" and strip off quantifiers to expose the\n-- type underneath, binding the new skolems for the @thing_inside@.\n-- The returned 'HsWrapper' has type @specific_ty -> expected_ty@.\ntcSkolemise :: UserTypeCtxt -> TcSigmaType\n            -> ([TcTyVar] -> TcType -> TcM result)\n         -- ^ These are only ever used for scoped type variables.\n            -> TcM (HsWrapper, result)\n        -- ^ The expression has type: spec_ty -> expected_ty\n\ntcSkolemise ctxt expected_ty thing_inside\n   -- We expect expected_ty to be a forall-type\n   -- If not, the call is a no-op\n  = do  { traceTc \"tcSkolemise\" Outputable.empty\n        ; (wrap, tv_prs, given, rho') <- deeplySkolemise expected_ty\n\n        ; lvl <- getTcLevel\n        ; when debugIsOn $\n              traceTc \"tcSkolemise\" $ vcat [\n                ppr lvl,\n                text \"expected_ty\" <+> ppr expected_ty,\n                text \"inst tyvars\" <+> ppr tv_prs,\n                text \"given\"       <+> ppr given,\n                text \"inst type\"   <+> ppr rho' ]\n\n        -- Generally we must check that the \"forall_tvs\" havn't been constrained\n        -- The interesting bit here is that we must include the free variables\n        -- of the expected_ty.  Here's an example:\n        --       runST (newVar True)\n        -- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool))\n        -- for (newVar True), with s fresh.  Then we unify with the runST's arg type\n        -- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool.\n        -- So now s' isn't unconstrained because it's linked to a.\n        --\n        -- However [Oct 10] now that the untouchables are a range of\n        -- TcTyVars, all this is handled automatically with no need for\n        -- extra faffing around\n\n        ; let tvs' = map snd tv_prs\n              skol_info = SigSkol ctxt expected_ty tv_prs\n\n        ; (ev_binds, result) <- checkConstraints skol_info tvs' given $\n                                thing_inside tvs' rho'\n\n        ; return (wrap <.> mkWpLet ev_binds, result) }\n          -- The ev_binds returned by checkConstraints is very\n          -- often empty, in which case mkWpLet is a no-op\n\n-- | Variant of 'tcSkolemise' that takes an ExpType\ntcSkolemiseET :: UserTypeCtxt -> ExpSigmaType\n              -> (ExpRhoType -> TcM result)\n              -> TcM (HsWrapper, result)\ntcSkolemiseET _ et@(Infer {}) thing_inside\n  = (idHsWrapper, ) <$> thing_inside et\ntcSkolemiseET ctxt (Check ty) thing_inside\n  = tcSkolemise ctxt ty $ \\_ -> thing_inside . mkCheckExpType\n\ncheckConstraints :: SkolemInfo\n                 -> [TcTyVar]           -- Skolems\n                 -> [EvVar]             -- Given\n                 -> TcM result\n                 -> TcM (TcEvBinds, result)\n\ncheckConstraints skol_info skol_tvs given thing_inside\n  = do { implication_needed <- implicationNeeded skol_info skol_tvs given\n\n       ; if implication_needed\n         then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside\n                 ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted\n                 ; traceTc \"checkConstraints\" (ppr tclvl $$ ppr skol_tvs)\n                 ; emitImplications implics\n                 ; return (ev_binds, result) }\n\n         else -- Fast path.  We check every function argument with\n              -- tcPolyExpr, which uses tcSkolemise and hence checkConstraints.\n              -- So this fast path is well-exercised\n              do { res <- thing_inside\n                 ; return (emptyTcEvBinds, res) } }\n\ncheckTvConstraints :: SkolemInfo\n                   -> Maybe SDoc  -- User-written telescope, if present\n                   -> TcM ([TcTyVar], result)\n                   -> TcM ([TcTyVar], result)\n\ncheckTvConstraints skol_info m_telescope thing_inside\n  = do { (tclvl, wanted, (skol_tvs, result))\n             <- pushLevelAndCaptureConstraints thing_inside\n\n       ; emitResidualTvConstraint skol_info m_telescope\n                                  skol_tvs tclvl wanted\n\n       ; return (skol_tvs, result) }\n\nemitResidualTvConstraint :: SkolemInfo -> Maybe SDoc -> [TcTyVar]\n                         -> TcLevel -> WantedConstraints -> TcM ()\nemitResidualTvConstraint skol_info m_telescope skol_tvs tclvl wanted\n  | isEmptyWC wanted\n  = return ()\n  | otherwise\n  = do { ev_binds <- newNoTcEvBinds\n       ; implic   <- newImplication\n       ; emitImplication $\n         implic { ic_tclvl     = tclvl\n                , ic_skols     = skol_tvs\n                , ic_no_eqs    = True\n                , ic_telescope = m_telescope\n                , ic_wanted    = wanted\n                , ic_binds     = ev_binds\n                , ic_info      = skol_info } }\n\nimplicationNeeded :: SkolemInfo -> [TcTyVar] -> [EvVar] -> TcM Bool\n-- See Note [When to build an implication]\nimplicationNeeded skol_info skol_tvs given\n  | null skol_tvs\n  , null given\n  , not (alwaysBuildImplication skol_info)\n  = -- Empty skolems and givens\n    do { tc_lvl <- getTcLevel\n       ; if not (isTopTcLevel tc_lvl)  -- No implication needed if we are\n         then return False             -- already inside an implication\n         else\n    do { dflags <- getDynFlags       -- If any deferral can happen,\n                                     -- we must build an implication\n       ; return (gopt Opt_DeferTypeErrors dflags ||\n                 gopt Opt_DeferTypedHoles dflags ||\n                 gopt Opt_DeferOutOfScopeVariables dflags) } }\n\n  | otherwise     -- Non-empty skolems or givens\n  = return True   -- Definitely need an implication\n\nalwaysBuildImplication :: SkolemInfo -> Bool\n-- See Note [When to build an implication]\nalwaysBuildImplication _ = False\n\n{-  Commmented out for now while I figure out about error messages.\n    See Trac #14185\n\nalwaysBuildImplication (SigSkol ctxt _ _)\n  = case ctxt of\n      FunSigCtxt {} -> True  -- RHS of a binding with a signature\n      _             -> False\nalwaysBuildImplication (RuleSkol {})      = True\nalwaysBuildImplication (InstSkol {})      = True\nalwaysBuildImplication (FamInstSkol {})   = True\nalwaysBuildImplication _                  = False\n-}\n\nbuildImplicationFor :: TcLevel -> SkolemInfo -> [TcTyVar]\n                   -> [EvVar] -> WantedConstraints\n                   -> TcM (Bag Implication, TcEvBinds)\nbuildImplicationFor tclvl skol_info skol_tvs given wanted\n  | isEmptyWC wanted && null given\n             -- Optimisation : if there are no wanteds, and no givens\n             -- don't generate an implication at all.\n             -- Reason for the (null given): we don't want to lose\n             -- the \"inaccessible alternative\" error check\n  = return (emptyBag, emptyTcEvBinds)\n\n  | otherwise\n  = ASSERT2( all (isSkolemTyVar <||> isTyVarTyVar) skol_tvs, ppr skol_tvs )\n      -- Why allow TyVarTvs? Because implicitly declared kind variables in\n      -- non-CUSK type declarations are TyVarTvs, and we need to bring them\n      -- into scope as a skolem in an implication. This is OK, though,\n      -- because TyVarTvs will always remain tyvars, even after unification.\n    do { ev_binds_var <- newTcEvBinds\n       ; implic <- newImplication\n       ; let implic' = implic { ic_tclvl  = tclvl\n                              , ic_skols  = skol_tvs\n                              , ic_given  = given\n                              , ic_wanted = wanted\n                              , ic_binds  = ev_binds_var\n                              , ic_info   = skol_info }\n\n       ; return (unitBag implic', TcEvBinds ev_binds_var) }\n\n{- Note [When to build an implication]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have some 'skolems' and some 'givens', and we are\nconsidering whether to wrap the constraints in their scope into an\nimplication.  We must /always/ so if either 'skolems' or 'givens' are\nnon-empty.  But what if both are empty?  You might think we could\nalways drop the implication.  Other things being equal, the fewer\nimplications the better.  Less clutter and overhead.  But we must\ntake care:\n\n* If we have an unsolved [W] g :: a ~# b, and -fdefer-type-errors,\n  we'll make a /term-level/ evidence binding for 'g = error \"blah\"'.\n  We must have an EvBindsVar those bindings!, otherwise they end up as\n  top-level unlifted bindings, which are verboten. This only matters\n  at top level, so we check for that\n  See also Note [Deferred errors for coercion holes] in TcErrors.\n  cf Trac #14149 for an example of what goes wrong.\n\n* If you have\n     f :: Int;  f = f_blah\n     g :: Bool; g = g_blah\n  If we don't build an implication for f or g (no tyvars, no givens),\n  the constraints for f_blah and g_blah are solved together.  And that\n  can yield /very/ confusing error messages, because we can get\n      [W] C Int b1    -- from f_blah\n      [W] C Int b2    -- from g_blan\n  and fundpes can yield [D] b1 ~ b2, even though the two functions have\n  literally nothing to do with each other.  Trac #14185 is an example.\n  Building an implication keeps them separage.\n-}\n\n{-\n************************************************************************\n*                                                                      *\n                Boxy unification\n*                                                                      *\n************************************************************************\n\nThe exported functions are all defined as versions of some\nnon-exported generic functions.\n-}\n\nunifyType :: Maybe (HsExpr GhcRn)   -- ^ If present, has type 'ty1'\n          -> TcTauType -> TcTauType -> TcM TcCoercionN\n-- Actual and expected types\n-- Returns a coercion : ty1 ~ ty2\nunifyType thing ty1 ty2 = traceTc \"utype\" (ppr ty1 $$ ppr ty2 $$ ppr thing) >>\n                          uType TypeLevel origin ty1 ty2\n  where\n    origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2\n                          , uo_thing  = ppr <$> thing\n                          , uo_visible = True } -- always called from a visible context\n\nunifyKind :: Maybe (HsType GhcRn) -> TcKind -> TcKind -> TcM CoercionN\nunifyKind thing ty1 ty2 = traceTc \"ukind\" (ppr ty1 $$ ppr ty2 $$ ppr thing) >>\n                          uType KindLevel origin ty1 ty2\n  where origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2\n                              , uo_thing  = ppr <$> thing\n                              , uo_visible = True } -- also always from a visible context\n\n---------------\n\n{-\n%************************************************************************\n%*                                                                      *\n                 uType and friends\n%*                                                                      *\n%************************************************************************\n\nuType is the heart of the unifier.\n-}\n\nuType, uType_defer\n  :: TypeOrKind\n  -> CtOrigin\n  -> TcType    -- ty1 is the *actual* type\n  -> TcType    -- ty2 is the *expected* type\n  -> TcM CoercionN\n\n--------------\n-- It is always safe to defer unification to the main constraint solver\n-- See Note [Deferred unification]\nuType_defer t_or_k origin ty1 ty2\n  = do { co <- emitWantedEq origin t_or_k Nominal ty1 ty2\n\n       -- Error trace only\n       -- NB. do *not* call mkErrInfo unless tracing is on,\n       --     because it is hugely expensive (#5631)\n       ; whenDOptM Opt_D_dump_tc_trace $ do\n            { ctxt <- getErrCtxt\n            ; doc <- mkErrInfo emptyTidyEnv ctxt\n            ; traceTc \"utype_defer\" (vcat [ debugPprType ty1\n                                          , debugPprType ty2\n                                          , pprCtOrigin origin\n                                          , doc])\n            ; traceTc \"utype_defer2\" (ppr co)\n            }\n       ; return co }\n\n--------------\nuType t_or_k origin orig_ty1 orig_ty2\n  = do { tclvl <- getTcLevel\n       ; traceTc \"u_tys\" $ vcat\n              [ text \"tclvl\" <+> ppr tclvl\n              , sep [ ppr orig_ty1, text \"~\", ppr orig_ty2]\n              , pprCtOrigin origin]\n       ; co <- go orig_ty1 orig_ty2\n       ; if isReflCo co\n            then traceTc \"u_tys yields no coercion\" Outputable.empty\n            else traceTc \"u_tys yields coercion:\" (ppr co)\n       ; return co }\n  where\n    go :: TcType -> TcType -> TcM CoercionN\n        -- The arguments to 'go' are always semantically identical\n        -- to orig_ty{1,2} except for looking through type synonyms\n\n     -- Unwrap casts before looking for variables. This way, we can easily\n     -- recognize (t |> co) ~ (t |> co), which is nice. Previously, we\n     -- didn't do it this way, and then the unification above was deferred.\n    go (CastTy t1 co1) t2\n      = do { co_tys <- uType t_or_k origin t1 t2\n           ; return (mkCoherenceLeftCo Nominal t1 co1 co_tys) }\n\n    go t1 (CastTy t2 co2)\n      = do { co_tys <- uType t_or_k origin t1 t2\n           ; return (mkCoherenceRightCo Nominal t2 co2 co_tys) }\n\n        -- Variables; go for uVar\n        -- Note that we pass in *original* (before synonym expansion),\n        -- so that type variables tend to get filled in with\n        -- the most informative version of the type\n    go (TyVarTy tv1) ty2\n      = do { lookup_res <- lookupTcTyVar tv1\n           ; case lookup_res of\n               Filled ty1   -> do { traceTc \"found filled tyvar\" (ppr tv1 <+> text \":->\" <+> ppr ty1)\n                                  ; go ty1 ty2 }\n               Unfilled _ -> uUnfilledVar origin t_or_k NotSwapped tv1 ty2 }\n    go ty1 (TyVarTy tv2)\n      = do { lookup_res <- lookupTcTyVar tv2\n           ; case lookup_res of\n               Filled ty2   -> do { traceTc \"found filled tyvar\" (ppr tv2 <+> text \":->\" <+> ppr ty2)\n                                  ; go ty1 ty2 }\n               Unfilled _ -> uUnfilledVar origin t_or_k IsSwapped tv2 ty1 }\n\n      -- See Note [Expanding synonyms during unification]\n    go ty1@(TyConApp tc1 []) (TyConApp tc2 [])\n      | tc1 == tc2\n      = return $ mkNomReflCo ty1\n\n        -- See Note [Expanding synonyms during unification]\n        --\n        -- Also NB that we recurse to 'go' so that we don't push a\n        -- new item on the origin stack. As a result if we have\n        --   type Foo = Int\n        -- and we try to unify  Foo ~ Bool\n        -- we'll end up saying \"can't match Foo with Bool\"\n        -- rather than \"can't match \"Int with Bool\".  See Trac #4535.\n    go ty1 ty2\n      | Just ty1' <- tcView ty1 = go ty1' ty2\n      | Just ty2' <- tcView ty2 = go ty1  ty2'\n\n        -- Functions (or predicate functions) just check the two parts\n    go (FunTy _ fun1 arg1) (FunTy _ fun2 arg2)\n      = do { co_l <- uType t_or_k origin fun1 fun2\n           ; co_r <- uType t_or_k origin arg1 arg2\n           ; return $ mkFunCo Nominal co_l co_r }\n\n        -- Always defer if a type synonym family (type function)\n        -- is involved.  (Data families behave rigidly.)\n    go ty1@(TyConApp tc1 _) ty2\n      | isTypeFamilyTyCon tc1 = defer ty1 ty2\n    go ty1 ty2@(TyConApp tc2 _)\n      | isTypeFamilyTyCon tc2 = defer ty1 ty2\n\n    go (TyConApp tc1 tys1) (TyConApp tc2 tys2)\n      -- See Note [Mismatched type lists and application decomposition]\n      | tc1 == tc2, equalLength tys1 tys2\n      = ASSERT2( isGenerativeTyCon tc1 Nominal, ppr tc1 )\n        do { cos <- zipWith3M (uType t_or_k) origins' tys1 tys2\n           ; return $ mkTyConAppCo Nominal tc1 cos }\n      where\n        origins' = map (\\is_vis -> if is_vis then origin else toInvisibleOrigin origin)\n                       (tcTyConVisibilities tc1)\n\n    go (LitTy m) ty@(LitTy n)\n      | m == n\n      = return $ mkNomReflCo ty\n\n        -- See Note [Care with type applications]\n        -- Do not decompose FunTy against App;\n        -- it's often a type error, so leave it for the constraint solver\n    go (AppTy s1 t1) (AppTy s2 t2)\n      = go_app (isNextArgVisible s1) s1 t1 s2 t2\n\n    go (AppTy s1 t1) (TyConApp tc2 ts2)\n      | Just (ts2', t2') <- snocView ts2\n      = ASSERT( not (mustBeSaturated tc2) )\n        go_app (isNextTyConArgVisible tc2 ts2') s1 t1 (TyConApp tc2 ts2') t2'\n\n    go (TyConApp tc1 ts1) (AppTy s2 t2)\n      | Just (ts1', t1') <- snocView ts1\n      = ASSERT( not (mustBeSaturated tc1) )\n        go_app (isNextTyConArgVisible tc1 ts1') (TyConApp tc1 ts1') t1' s2 t2\n\n    go (CoercionTy co1) (CoercionTy co2)\n      = do { let ty1 = coercionType co1\n                 ty2 = coercionType co2\n           ; kco <- uType KindLevel\n                          (KindEqOrigin orig_ty1 (Just orig_ty2) origin\n                                        (Just t_or_k))\n                          ty1 ty2\n           ; return $ mkProofIrrelCo Nominal kco co1 co2 }\n\n        -- Anything else fails\n        -- E.g. unifying for-all types, which is relative unusual\n    go ty1 ty2 = defer ty1 ty2\n\n    ------------------\n    defer ty1 ty2   -- See Note [Check for equality before deferring]\n      | ty1 `tcEqType` ty2 = return (mkNomReflCo ty1)\n      | otherwise          = uType_defer t_or_k origin ty1 ty2\n\n    ------------------\n    go_app vis s1 t1 s2 t2\n      = do { co_s <- uType t_or_k origin s1 s2\n           ; let arg_origin\n                   | vis       = origin\n                   | otherwise = toInvisibleOrigin origin\n           ; co_t <- uType t_or_k arg_origin t1 t2\n           ; return $ mkAppCo co_s co_t }\n\n{- Note [Check for equality before deferring]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nParticularly in ambiguity checks we can get equalities like (ty ~ ty).\nIf ty involves a type function we may defer, which isn't very sensible.\nAn egregious example of this was in test T9872a, which has a type signature\n       Proxy :: Proxy (Solutions Cubes)\nDoing the ambiguity check on this signature generates the equality\n   Solutions Cubes ~ Solutions Cubes\nand currently the constraint solver normalises both sides at vast cost.\nThis little short-cut in 'defer' helps quite a bit.\n\nNote [Care with type applications]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNote: type applications need a bit of care!\nThey can match FunTy and TyConApp, so use splitAppTy_maybe\nNB: we've already dealt with type variables and Notes,\nso if one type is an App the other one jolly well better be too\n\nNote [Mismatched type lists and application decomposition]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen we find two TyConApps, you might think that the argument lists\nare guaranteed equal length.  But they aren't. Consider matching\n        w (T x) ~ Foo (T x y)\nWe do match (w ~ Foo) first, but in some circumstances we simply create\na deferred constraint; and then go ahead and match (T x ~ T x y).\nThis came up in Trac #3950.\n\nSo either\n   (a) either we must check for identical argument kinds\n       when decomposing applications,\n\n   (b) or we must be prepared for ill-kinded unification sub-problems\n\nCurrently we adopt (b) since it seems more robust -- no need to maintain\na global invariant.\n\nNote [Expanding synonyms during unification]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe expand synonyms during unification, but:\n * We expand *after* the variable case so that we tend to unify\n   variables with un-expanded type synonym. This just makes it\n   more likely that the inferred types will mention type synonyms\n   understandable to the user\n\n * Similarly, we expand *after* the CastTy case, just in case the\n   CastTy wraps a variable.\n\n * We expand *before* the TyConApp case.  For example, if we have\n      type Phantom a = Int\n   and are unifying\n      Phantom Int ~ Phantom Char\n   it is *wrong* to unify Int and Char.\n\n * The problem case immediately above can happen only with arguments\n   to the tycon. So we check for nullary tycons *before* expanding.\n   This is particularly helpful when checking (* ~ *), because * is\n   now a type synonym.\n\nNote [Deferred Unification]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe may encounter a unification ty1 ~ ty2 that cannot be performed syntactically,\nand yet its consistency is undetermined. Previously, there was no way to still\nmake it consistent. So a mismatch error was issued.\n\nNow these unifications are deferred until constraint simplification, where type\nfamily instances and given equations may (or may not) establish the consistency.\nDeferred unifications are of the form\n                F ... ~ ...\nor              x ~ ...\nwhere F is a type function and x is a type variable.\nE.g.\n        id :: x ~ y => x -> y\n        id e = e\n\ninvolves the unification x = y. It is deferred until we bring into account the\ncontext x ~ y to establish that it holds.\n\nIf available, we defer original types (rather than those where closed type\nsynonyms have already been expanded via tcCoreView).  This is, as usual, to\nimprove error messages.\n\n\n************************************************************************\n*                                                                      *\n                 uVar and friends\n*                                                                      *\n************************************************************************\n\n@uVar@ is called when at least one of the types being unified is a\nvariable.  It does {\\em not} assume that the variable is a fixed point\nof the substitution; rather, notice that @uVar@ (defined below) nips\nback into @uTys@ if it turns out that the variable is already bound.\n-}\n\n----------\nuUnfilledVar :: CtOrigin\n             -> TypeOrKind\n             -> SwapFlag\n             -> TcTyVar        -- Tyvar 1\n             -> TcTauType      -- Type 2\n             -> TcM Coercion\n-- \"Unfilled\" means that the variable is definitely not a filled-in meta tyvar\n--            It might be a skolem, or untouchable, or meta\n\nuUnfilledVar origin t_or_k swapped tv1 ty2\n  = do { ty2 <- zonkTcType ty2\n             -- Zonk to expose things to the\n             -- occurs check, and so that if ty2\n             -- looks like a type variable then it\n             -- /is/ a type variable\n       ; uUnfilledVar1 origin t_or_k swapped tv1 ty2 }\n\n----------\nuUnfilledVar1 :: CtOrigin\n              -> TypeOrKind\n              -> SwapFlag\n              -> TcTyVar        -- Tyvar 1\n              -> TcTauType      -- Type 2, zonked\n              -> TcM Coercion\nuUnfilledVar1 origin t_or_k swapped tv1 ty2\n  | Just tv2 <- tcGetTyVar_maybe ty2\n  = go tv2\n\n  | otherwise\n  = uUnfilledVar2 origin t_or_k swapped tv1 ty2\n\n  where\n    -- 'go' handles the case where both are\n    -- tyvars so we might want to swap\n    go tv2 | tv1 == tv2  -- Same type variable => no-op\n           = return (mkNomReflCo (mkTyVarTy tv1))\n\n           | swapOverTyVars tv1 tv2   -- Distinct type variables\n           = uUnfilledVar2 origin t_or_k (flipSwap swapped)\n                           tv2 (mkTyVarTy tv1)\n\n           | otherwise\n           = uUnfilledVar2 origin t_or_k swapped tv1 ty2\n\n----------\nuUnfilledVar2 :: CtOrigin\n              -> TypeOrKind\n              -> SwapFlag\n              -> TcTyVar        -- Tyvar 1\n              -> TcTauType      -- Type 2, zonked\n              -> TcM Coercion\nuUnfilledVar2 origin t_or_k swapped tv1 ty2\n  = do { dflags  <- getDynFlags\n       ; cur_lvl <- getTcLevel\n       ; go dflags cur_lvl }\n  where\n    go dflags cur_lvl\n      | canSolveByUnification cur_lvl tv1 ty2\n      , Just ty2' <- metaTyVarUpdateOK dflags tv1 ty2\n      = do { co_k <- uType KindLevel kind_origin (tcTypeKind ty2') (tyVarKind tv1)\n           ; traceTc \"uUnfilledVar2 ok\" $\n             vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1)\n                  , ppr ty2 <+> dcolon <+> ppr (tcTypeKind  ty2)\n                  , ppr (isTcReflCo co_k), ppr co_k ]\n\n           ; if isTcReflCo co_k  -- only proceed if the kinds matched.\n\n             then do { writeMetaTyVar tv1 ty2'\n                     ; return (mkTcNomReflCo ty2') }\n\n             else defer } -- This cannot be solved now.  See TcCanonical\n                          -- Note [Equalities with incompatible kinds]\n\n      | otherwise\n      = do { traceTc \"uUnfilledVar2 not ok\" (ppr tv1 $$ ppr ty2)\n               -- Occurs check or an untouchable: just defer\n               -- NB: occurs check isn't necessarily fatal:\n               --     eg tv1 occured in type family parameter\n            ; defer }\n\n    ty1 = mkTyVarTy tv1\n    kind_origin = KindEqOrigin ty1 (Just ty2) origin (Just t_or_k)\n\n    defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2\n\nswapOverTyVars :: TcTyVar -> TcTyVar -> Bool\nswapOverTyVars tv1 tv2\n  -- Level comparison: see Note [TyVar/TyVar orientation]\n  | lvl1 `strictlyDeeperThan` lvl2 = False\n  | lvl2 `strictlyDeeperThan` lvl1 = True\n\n  -- Priority: see Note [TyVar/TyVar orientation]\n  | pri1 > pri2 = False\n  | pri2 > pri1 = True\n\n  -- Names: see Note [TyVar/TyVar orientation]\n  | isSystemName tv2_name, not (isSystemName tv1_name) = True\n\n  | otherwise = False\n\n  where\n    lvl1 = tcTyVarLevel tv1\n    lvl2 = tcTyVarLevel tv2\n    pri1 = lhsPriority tv1\n    pri2 = lhsPriority tv2\n    tv1_name = Var.varName tv1\n    tv2_name = Var.varName tv2\n\n\nlhsPriority :: TcTyVar -> Int\n-- Higher => more important to be on the LHS\n-- See Note [TyVar/TyVar orientation]\nlhsPriority tv\n  = ASSERT2( isTyVar tv, ppr tv)\n    case tcTyVarDetails tv of\n      RuntimeUnk  -> 0\n      SkolemTv {} -> 0\n      MetaTv { mtv_info = info } -> case info of\n                                     FlatSkolTv -> 1\n                                     TyVarTv    -> 2\n                                     TauTv      -> 3\n                                     FlatMetaTv -> 4\n{- Note [TyVar/TyVar orientation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven (a ~ b), should we orient the CTyEqCan as (a~b) or (b~a)?\nThis is a surprisingly tricky question!\n\nFirst note: only swap if you have to!\n   See Note [Avoid unnecessary swaps]\n\nSo we look for a positive reason to swap, using a three-step test:\n\n* Level comparison. If 'a' has deeper level than 'b',\n  put 'a' on the left.  See Note [Deeper level on the left]\n\n* Priority.  If the levels are the same, look at what kind of\n  type variable it is, using 'lhsPriority'\n\n  - FlatMetaTv: Always put on the left.\n    See Note [Fmv Orientation Invariant]\n    NB: FlatMetaTvs always have the current level, never an\n        outer one.  So nothing can be deeper than a FlatMetaTv\n\n\n  - TyVarTv/TauTv: if we have  tyv_tv ~ tau_tv, put tau_tv\n                   on the left because there are fewer\n                   restrictions on updating TauTvs\n\n  - TyVarTv/TauTv:  put on the left either\n     a) Because it's touchable and can be unified, or\n     b) Even if it's not touchable, TcSimplify.floatEqualities\n        looks for meta tyvars on the left\n\n  - FlatSkolTv: Put on the left in preference to a SkolemTv\n                See Note [Eliminate flat-skols]\n\n* Names. If the level and priority comparisons are all\n  equal, try to eliminate a TyVars with a System Name in\n  favour of ones with a Name derived from a user type signature\n\n* Age.  At one point in the past we tried to break any remaining\n  ties by eliminating the younger type variable, based on their\n  Uniques.  See Note [Eliminate younger unification variables]\n  (which also explains why we don't do this any more)\n\nNote [Deeper level on the left]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe most important thing is that we want to put tyvars with\nthe deepest level on the left.  The reason to do so differs for\nWanteds and Givens, but either way, deepest wins!  Simple.\n\n* Wanteds.  Putting the deepest variable on the left maximise the\n  chances that it's a touchable meta-tyvar which can be solved.\n\n* Givens. Suppose we have something like\n     forall a[2]. b[1] ~ a[2] => beta[1] ~ a[2]\n\n  If we orient the Given a[2] on the left, we'll rewrite the Wanted to\n  (beta[1] ~ b[1]), and that can float out of the implication.\n  Otherwise it can't.  By putting the deepest variable on the left\n  we maximise our changes of eliminating skolem capture.\n\n  See also TcSMonad Note [Let-bound skolems] for another reason\n  to orient with the deepest skolem on the left.\n\n  IMPORTANT NOTE: this test does a level-number comparison on\n  skolems, so it's important that skolems have (accurate) level\n  numbers.\n\nSee Trac #15009 for an further analysis of why \"deepest on the left\"\nis a good plan.\n\nNote [Fmv Orientation Invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n   * We always orient a constraint\n        fmv ~ alpha\n     with fmv on the left, even if alpha is\n     a touchable unification variable\n\nReason: doing it the other way round would unify alpha:=fmv, but that\nreally doesn't add any info to alpha.  But a later constraint alpha ~\nInt might unlock everything.  Comment:9 of #12526 gives a detailed\nexample.\n\nWARNING: I've gone to and fro on this one several times.\nI'm now pretty sure that unifying alpha:=fmv is a bad idea!\nSo orienting with fmvs on the left is a good thing.\n\nThis example comes from IndTypesPerfMerge. (Others include\nT10226, T10009.)\n    From the ambiguity check for\n      f :: (F a ~ a) => a\n    we get:\n          [G] F a ~ a\n          [WD] F alpha ~ alpha, alpha ~ a\n\n    From Givens we get\n          [G] F a ~ fsk, fsk ~ a\n\n    Now if we flatten we get\n          [WD] alpha ~ fmv, F alpha ~ fmv, alpha ~ a\n\n    Now, if we unified alpha := fmv, we'd get\n          [WD] F fmv ~ fmv, [WD] fmv ~ a\n    And now we are stuck.\n\nSo instead the Fmv Orientation Invariant puts the fmv on the\nleft, giving\n      [WD] fmv ~ alpha, [WD] F alpha ~ fmv, [WD] alpha ~ a\n\n    Now we get alpha:=a, and everything works out\n\nNote [Eliminate flat-skols]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have  [G] Num (F [a])\nthen we flatten to\n     [G] Num fsk\n     [G] F [a] ~ fsk\nwhere fsk is a flatten-skolem (FlatSkolTv). Suppose we have\n      type instance F [a] = a\nthen we'll reduce the second constraint to\n     [G] a ~ fsk\nand then replace all uses of 'a' with fsk.  That's bad because\nin error messages instead of saying 'a' we'll say (F [a]).  In all\nplaces, including those where the programmer wrote 'a' in the first\nplace.  Very confusing!  See Trac #7862.\n\nSolution: re-orient a~fsk to fsk~a, so that we preferentially eliminate\nthe fsk.\n\nNote [Avoid unnecessary swaps]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we swap without actually improving matters, we can get an infinite loop.\nConsider\n    work item:  a ~ b\n   inert item:  b ~ c\nWe canonicalise the work-item to (a ~ c).  If we then swap it before\nadding to the inert set, we'll add (c ~ a), and therefore kick out the\ninert guy, so we get\n   new work item:  b ~ c\n   inert item:     c ~ a\nAnd now the cycle just repeats\n\nNote [Eliminate younger unification variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGiven a choice of unifying\n     alpha := beta   or   beta := alpha\nwe try, if possible, to eliminate the \"younger\" one, as determined\nby `ltUnique`.  Reason: the younger one is less likely to appear free in\nan existing inert constraint, and hence we are less likely to be forced\ninto kicking out and rewriting inert constraints.\n\nThis is a performance optimisation only.  It turns out to fix\nTrac #14723 all by itself, but clearly not reliably so!\n\nIt's simple to implement (see nicer_to_update_tv2 in swapOverTyVars).\nBut, to my surprise, it didn't seem to make any significant difference\nto the compiler's performance, so I didn't take it any further.  Still\nit seemed to too nice to discard altogether, so I'm leaving these\nnotes.  SLPJ Jan 18.\n-}\n\n-- @trySpontaneousSolve wi@ solves equalities where one side is a\n-- touchable unification variable.\n-- Returns True <=> spontaneous solve happened\ncanSolveByUnification :: TcLevel -> TcTyVar -> TcType -> Bool\ncanSolveByUnification tclvl tv xi\n  | isTouchableMetaTyVar tclvl tv\n  = case metaTyVarInfo tv of\n      TyVarTv -> is_tyvar xi\n      _       -> True\n\n  | otherwise    -- Untouchable\n  = False\n  where\n    is_tyvar xi\n      = case tcGetTyVar_maybe xi of\n          Nothing -> False\n          Just tv -> case tcTyVarDetails tv of\n                       MetaTv { mtv_info = info }\n                                   -> case info of\n                                        TyVarTv -> True\n                                        _       -> False\n                       SkolemTv {} -> True\n                       RuntimeUnk  -> True\n\n{- Note [Prevent unification with type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe prevent unification with type families because of an uneasy compromise.\nIt's perfectly sound to unify with type families, and it even improves the\nerror messages in the testsuite. It also modestly improves performance, at\nleast in some cases. But it's disastrous for test case perf/compiler/T3064.\nHere is the problem: Suppose we have (F ty) where we also have [G] F ty ~ a.\nWhat do we do? Do we reduce F? Or do we use the given? Hard to know what's\nbest. GHC reduces. This is a disaster for T3064, where the type's size\nspirals out of control during reduction. (We're not helped by the fact that\nthe flattener re-flattens all the arguments every time around.) If we prevent\nunification with type families, then the solver happens to use the equality\nbefore expanding the type family.\n\nIt would be lovely in the future to revisit this problem and remove this\nextra, unnecessary check. But we retain it for now as it seems to work\nbetter in practice.\n\nNote [Refactoring hazard: checkTauTvUpdate]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nI (Richard E.) have a sad story about refactoring this code, retained here\nto prevent others (or a future me!) from falling into the same traps.\n\nIt all started with #11407, which was caused by the fact that the TyVarTy\ncase of defer_me didn't look in the kind. But it seemed reasonable to\nsimply remove the defer_me check instead.\n\nIt referred to two Notes (since removed) that were out of date, and the\nfast_check code in occurCheckExpand seemed to do just about the same thing as\ndefer_me. The one piece that defer_me did that wasn't repeated by\noccurCheckExpand was the type-family check. (See Note [Prevent unification\nwith type families].) So I checked the result of occurCheckExpand for any\ntype family occurrences and deferred if there were any. This was done\nin commit e9bf7bb5cc9fb3f87dd05111aa23da76b86a8967 .\n\nThis approach turned out not to be performant, because the expanded\ntype was bigger than the original type, and tyConsOfType (needed to\nsee if there are any type family occurrences) looks through type\nsynonyms. So it then struck me that we could dispense with the\ndefer_me check entirely. This simplified the code nicely, and it cut\nthe allocations in T5030 by half. But, as documented in Note [Prevent\nunification with type families], this destroyed performance in\nT3064. Regardless, I missed this regression and the change was\ncommitted as 3f5d1a13f112f34d992f6b74656d64d95a3f506d .\n\nBottom lines:\n * defer_me is back, but now fixed w.r.t. #11407.\n * Tread carefully before you start to refactor here. There can be\n   lots of hard-to-predict consequences.\n\nNote [Type synonyms and the occur check]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGenerally speaking we try to update a variable with type synonyms not\nexpanded, which improves later error messages, unless looking\ninside a type synonym may help resolve a spurious occurs check\nerror. Consider:\n          type A a = ()\n\n          f :: (A a -> a -> ()) -> ()\n          f = \\ _ -> ()\n\n          x :: ()\n          x = f (\\ x p -> p x)\n\nWe will eventually get a constraint of the form t ~ A t. The ok function above will\nproperly expand the type (A t) to just (), which is ok to be unified with t. If we had\nunified with the original type A t, we would lead the type checker into an infinite loop.\n\nHence, if the occurs check fails for a type synonym application, then (and *only* then),\nthe ok function expands the synonym to detect opportunities for occurs check success using\nthe underlying definition of the type synonym.\n\nThe same applies later on in the constraint interaction code; see TcInteract,\nfunction @occ_check_ok@.\n\nNote [Non-TcTyVars in TcUnify]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBecause the same code is now shared between unifying types and unifying\nkinds, we sometimes will see proper TyVars floating around the unifier.\nExample (from test case polykinds/PolyKinds12):\n\n    type family Apply (f :: k1 -> k2) (x :: k1) :: k2\n    type instance Apply g y = g y\n\nWhen checking the instance declaration, we first *kind-check* the LHS\nand RHS, discovering that the instance really should be\n\n    type instance Apply k3 k4 (g :: k3 -> k4) (y :: k3) = g y\n\nDuring this kind-checking, all the tyvars will be TcTyVars. Then, however,\nas a second pass, we desugar the RHS (which is done in functions prefixed\nwith \"tc\" in TcTyClsDecls\"). By this time, all the kind-vars are proper\nTyVars, not TcTyVars, get some kind unification must happen.\n\nThus, we always check if a TyVar is a TcTyVar before asking if it's a\nmeta-tyvar.\n\nThis used to not be necessary for type-checking (that is, before * :: *)\nbecause expressions get desugared via an algorithm separate from\ntype-checking (with wrappers, etc.). Types get desugared very differently,\ncausing this wibble in behavior seen here.\n-}\n\ndata LookupTyVarResult  -- The result of a lookupTcTyVar call\n  = Unfilled TcTyVarDetails     -- SkolemTv or virgin MetaTv\n  | Filled   TcType\n\nlookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult\nlookupTcTyVar tyvar\n  | MetaTv { mtv_ref = ref } <- details\n  = do { meta_details <- readMutVar ref\n       ; case meta_details of\n           Indirect ty -> return (Filled ty)\n           Flexi -> do { is_touchable <- isTouchableTcM tyvar\n                             -- Note [Unifying untouchables]\n                       ; if is_touchable then\n                            return (Unfilled details)\n                         else\n                            return (Unfilled vanillaSkolemTv) } }\n  | otherwise\n  = return (Unfilled details)\n  where\n    details = tcTyVarDetails tyvar\n\n{-\nNote [Unifying untouchables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe treat an untouchable type variable as if it was a skolem.  That\nensures it won't unify with anything.  It's a slight hack, because\nwe return a made-up TcTyVarDetails, but I think it works smoothly.\n-}\n\n-- | Breaks apart a function kind into its pieces.\nmatchExpectedFunKind\n  :: Outputable fun\n  => fun             -- ^ type, only for errors\n  -> Arity           -- ^ n: number of desired arrows\n  -> TcKind          -- ^ fun_ kind\n  -> TcM Coercion    -- ^ co :: fun_kind ~ (arg1 -> ... -> argn -> res)\n\nmatchExpectedFunKind hs_ty n k = go n k\n  where\n    go 0 k = return (mkNomReflCo k)\n\n    go n k | Just k' <- tcView k = go n k'\n\n    go n k@(TyVarTy kvar)\n      | isMetaTyVar kvar\n      = do { maybe_kind <- readMetaTyVar kvar\n           ; case maybe_kind of\n                Indirect fun_kind -> go n fun_kind\n                Flexi ->             defer n k }\n\n    go n (FunTy _ arg res)\n      = do { co <- go (n-1) res\n           ; return (mkTcFunCo Nominal (mkTcNomReflCo arg) co) }\n\n    go n other\n     = defer n other\n\n    defer n k\n      = do { arg_kinds <- newMetaKindVars n\n           ; res_kind  <- newMetaKindVar\n           ; let new_fun = mkVisFunTys arg_kinds res_kind\n                 origin  = TypeEqOrigin { uo_actual   = k\n                                        , uo_expected = new_fun\n                                        , uo_thing    = Just (ppr hs_ty)\n                                        , uo_visible  = True\n                                        }\n           ; uType KindLevel origin k new_fun }\n\n{- *********************************************************************\n*                                                                      *\n                 Occurrence checking\n*                                                                      *\n********************************************************************* -}\n\n\n{-  Note [Occurrence checking: look inside kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we are considering unifying\n   (alpha :: *)  ~  Int -> (beta :: alpha -> alpha)\nThis may be an error (what is that alpha doing inside beta's kind?),\nbut we must not make the mistake of actually unifying or we'll\nbuild an infinite data structure.  So when looking for occurrences\nof alpha in the rhs, we must look in the kinds of type variables\nthat occur there.\n\nNB: we may be able to remove the problem via expansion; see\n    Note [Occurs check expansion].  So we have to try that.\n\nNote [Checking for foralls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nUnless we have -XImpredicativeTypes (which is a totally unsupported\nfeature), we do not want to unify\n    alpha ~ (forall a. a->a) -> Int\nSo we look for foralls hidden inside the type, and it's convenient\nto do that at the same time as the occurs check (which looks for\noccurrences of alpha).\n\nHowever, it's not just a question of looking for foralls /anywhere/!\nConsider\n   (alpha :: forall k. k->*)  ~  (beta :: forall k. k->*)\nThis is legal; e.g. dependent/should_compile/T11635.\n\nWe don't want to reject it because of the forall in beta's kind,\nbut (see Note [Occurrence checking: look inside kinds]) we do\nneed to look in beta's kind.  So we carry a flag saying if a 'forall'\nis OK, and sitch the flag on when stepping inside a kind.\n\nWhy is it OK?  Why does it not count as impredicative polymorphism?\nThe reason foralls are bad is because we reply on \"seeing\" foralls\nwhen doing implicit instantiation.  But the forall inside the kind is\nfine.  We'll generate a kind equality constraint\n  (forall k. k->*) ~ (forall k. k->*)\nto check that the kinds of lhs and rhs are compatible.  If alpha's\nkind had instead been\n  (alpha :: kappa)\nthen this kind equality would rightly complain about unifying kappa\nwith (forall k. k->*)\n\n-}\n\ndata OccCheckResult a\n  = OC_OK a\n  | OC_Bad     -- Forall or type family\n  | OC_Occurs\n\ninstance Functor OccCheckResult where\n      fmap = liftM\n\ninstance Applicative OccCheckResult where\n      pure = OC_OK\n      (<*>) = ap\n\ninstance Monad OccCheckResult where\n  OC_OK x    >>= k = k x\n  OC_Bad     >>= _ = OC_Bad\n  OC_Occurs  >>= _ = OC_Occurs\n\noccCheckForErrors :: DynFlags -> TcTyVar -> Type -> OccCheckResult ()\n-- Just for error-message generation; so we return OccCheckResult\n-- so the caller can report the right kind of error\n-- Check whether\n--   a) the given variable occurs in the given type.\n--   b) there is a forall in the type (unless we have -XImpredicativeTypes)\noccCheckForErrors dflags tv ty\n  = case preCheck dflags True tv ty of\n      OC_OK _   -> OC_OK ()\n      OC_Bad    -> OC_Bad\n      OC_Occurs -> case occCheckExpand [tv] ty of\n                     Nothing -> OC_Occurs\n                     Just _  -> OC_OK ()\n\n----------------\nmetaTyVarUpdateOK :: DynFlags\n                  -> TcTyVar             -- tv :: k1\n                  -> TcType              -- ty :: k2\n                  -> Maybe TcType        -- possibly-expanded ty\n-- (metaTyFVarUpdateOK tv ty)\n-- We are about to update the meta-tyvar tv with ty\n-- Check (a) that tv doesn't occur in ty (occurs check)\n--       (b) that ty does not have any foralls\n--           (in the impredicative case), or type functions\n--\n-- We have two possible outcomes:\n-- (1) Return the type to update the type variable with,\n--        [we know the update is ok]\n-- (2) Return Nothing,\n--        [the update might be dodgy]\n--\n-- Note that \"Nothing\" does not mean \"definite error\".  For example\n--   type family F a\n--   type instance F Int = Int\n-- consider\n--   a ~ F a\n-- This is perfectly reasonable, if we later get a ~ Int.  For now, though,\n-- we return Nothing, leaving it to the later constraint simplifier to\n-- sort matters out.\n--\n-- See Note [Refactoring hazard: checkTauTvUpdate]\n\nmetaTyVarUpdateOK dflags tv ty\n  = case preCheck dflags False tv ty of\n         -- False <=> type families not ok\n         -- See Note [Prevent unification with type families]\n      OC_OK _   -> Just ty\n      OC_Bad    -> Nothing  -- forall or type function\n      OC_Occurs -> occCheckExpand [tv] ty\n\npreCheck :: DynFlags -> Bool -> TcTyVar -> TcType -> OccCheckResult ()\n-- A quick check for\n--   (a) a forall type (unless -XImpredivativeTypes)\n--   (b) a type family\n--   (c) an occurrence of the type variable (occurs check)\n--\n-- For (a) and (b) we check only the top level of the type, NOT\n-- inside the kinds of variables it mentions.  But for (c) we do\n-- look in the kinds of course.\n\npreCheck dflags ty_fam_ok tv ty\n  = fast_check ty\n  where\n    details          = tcTyVarDetails tv\n    impredicative_ok = canUnifyWithPolyType dflags details\n\n    ok :: OccCheckResult ()\n    ok = OC_OK ()\n\n    fast_check :: TcType -> OccCheckResult ()\n    fast_check (TyVarTy tv')\n      | tv == tv' = OC_Occurs\n      | otherwise = fast_check_occ (tyVarKind tv')\n           -- See Note [Occurrence checking: look inside kinds]\n\n    fast_check (TyConApp tc tys)\n      | bad_tc tc              = OC_Bad\n      | otherwise              = mapM fast_check tys >> ok\n    fast_check (LitTy {})      = ok\n    fast_check (FunTy _ a r)   = fast_check a   >> fast_check r\n    fast_check (AppTy fun arg) = fast_check fun >> fast_check arg\n    fast_check (CastTy ty co)  = fast_check ty  >> fast_check_co co\n    fast_check (CoercionTy co) = fast_check_co co\n    fast_check (ForAllTy (Bndr tv' _) ty)\n       | not impredicative_ok = OC_Bad\n       | tv == tv'            = ok\n       | otherwise = do { fast_check_occ (tyVarKind tv')\n                        ; fast_check_occ ty }\n       -- Under a forall we look only for occurrences of\n       -- the type variable\n\n     -- For kinds, we only do an occurs check; we do not worry\n     -- about type families or foralls\n     -- See Note [Checking for foralls]\n    fast_check_occ k | tv `elemVarSet` tyCoVarsOfType k = OC_Occurs\n                     | otherwise                        = ok\n\n     -- For coercions, we are only doing an occurs check here;\n     -- no bother about impredicativity in coercions, as they're\n     -- inferred\n    fast_check_co co | tv `elemVarSet` tyCoVarsOfCo co = OC_Occurs\n                     | otherwise                       = ok\n\n    bad_tc :: TyCon -> Bool\n    bad_tc tc\n      | not (impredicative_ok || isTauTyCon tc)     = True\n      | not (ty_fam_ok        || isFamFreeTyCon tc) = True\n      | otherwise                                   = False\n\ncanUnifyWithPolyType :: DynFlags -> TcTyVarDetails -> Bool\ncanUnifyWithPolyType dflags details\n  = case details of\n      MetaTv { mtv_info = TyVarTv }    -> False\n      MetaTv { mtv_info = TauTv }      -> xopt LangExt.ImpredicativeTypes dflags\n      _other                           -> True\n          -- We can have non-meta tyvars in given constraints\n", "num_lines": 2244}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE CPP, TupleSections, ViewPatterns #-}\n\nmodule TcValidity (\n  Rank, UserTypeCtxt(..), checkValidType, checkValidMonoType,\n  checkValidTheta,\n  checkValidInstance, checkValidInstHead, validDerivPred,\n  checkTySynRhs,\n  checkValidCoAxiom, checkValidCoAxBranch,\n  checkValidTyFamEqn, checkConsistentFamInst,\n  badATErr, arityErr,\n  checkTyConTelescope,\n  allDistinctTyVars\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Maybes\n\n-- friends:\nimport TcUnify    ( tcSubType_NC )\nimport TcSimplify ( simplifyAmbiguityCheck )\nimport ClsInst    ( matchGlobalInst, ClsInstResult(..), InstanceWhat(..), AssocInstInfo(..) )\nimport TyCoRep\nimport TcType hiding ( sizeType, sizeTypes )\nimport TysWiredIn ( heqTyConName, eqTyConName, coercibleTyConName )\nimport PrelNames\nimport Type\nimport Unify      ( tcMatchTyX_BM, BindFlag(..) )\nimport Coercion\nimport CoAxiom\nimport Class\nimport TyCon\n\n-- others:\nimport IfaceType( pprIfaceType, pprIfaceTypeApp )\nimport ToIface  ( toIfaceTyCon, toIfaceTcArgs, toIfaceType )\nimport HsSyn            -- HsType\nimport TcRnMonad        -- TcType, amongst others\nimport TcEnv       ( tcInitTidyEnv, tcInitOpenTidyEnv )\nimport FunDeps\nimport FamInstEnv  ( isDominatedBy, injectiveBranches,\n                     InjectivityCheckResult(..) )\nimport FamInst     ( makeInjectivityErrors )\nimport Name\nimport VarEnv\nimport VarSet\nimport Var         ( VarBndr(..), mkTyVar )\nimport Id          ( idType, idName )\nimport FV\nimport ErrUtils\nimport DynFlags\nimport Util\nimport ListSetOps\nimport SrcLoc\nimport Outputable\nimport Unique      ( mkAlphaTyVarUnique )\nimport Bag         ( emptyBag )\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad\nimport Data.Foldable\nimport Data.List        ( (\\\\), nub )\nimport qualified Data.List.NonEmpty as NE\n\n{-\n************************************************************************\n*                                                                      *\n          Checking for ambiguity\n*                                                                      *\n************************************************************************\n\nNote [The ambiguity check for type signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ncheckAmbiguity is a check on *user-supplied type signatures*.  It is\n*purely* there to report functions that cannot possibly be called.  So for\nexample we want to reject:\n   f :: C a => Int\nThe idea is there can be no legal calls to 'f' because every call will\ngive rise to an ambiguous constraint.  We could soundly omit the\nambiguity check on type signatures entirely, at the expense of\ndelaying ambiguity errors to call sites.  Indeed, the flag\n-XAllowAmbiguousTypes switches off the ambiguity check.\n\nWhat about things like this:\n   class D a b | a -> b where ..\n   h :: D Int b => Int\nThe Int may well fix 'b' at the call site, so that signature should\nnot be rejected.  Moreover, using *visible* fundeps is too\nconservative.  Consider\n   class X a b where ...\n   class D a b | a -> b where ...\n   instance D a b => X [a] b where...\n   h :: X a b => a -> a\nHere h's type looks ambiguous in 'b', but here's a legal call:\n   ...(h [True])...\nThat gives rise to a (X [Bool] beta) constraint, and using the\ninstance means we need (D Bool beta) and that fixes 'beta' via D's\nfundep!\n\nBehind all these special cases there is a simple guiding principle.\nConsider\n\n  f :: <type>\n  f = ...blah...\n\n  g :: <type>\n  g = f\n\nYou would think that the definition of g would surely typecheck!\nAfter all f has exactly the same type, and g=f. But in fact f's type\nis instantiated and the instantiated constraints are solved against\nthe originals, so in the case an ambiguous type it won't work.\nConsider our earlier example f :: C a => Int.  Then in g's definition,\nwe'll instantiate to (C alpha) and try to deduce (C alpha) from (C a),\nand fail.\n\nSo in fact we use this as our *definition* of ambiguity.  We use a\nvery similar test for *inferred* types, to ensure that they are\nunambiguous. See Note [Impedance matching] in TcBinds.\n\nThis test is very conveniently implemented by calling\n    tcSubType <type> <type>\nThis neatly takes account of the functional dependecy stuff above,\nand implicit parameter (see Note [Implicit parameters and ambiguity]).\nAnd this is what checkAmbiguity does.\n\nWhat about this, though?\n   g :: C [a] => Int\nIs every call to 'g' ambiguous?  After all, we might have\n   instance C [a] where ...\nat the call site.  So maybe that type is ok!  Indeed even f's\nquintessentially ambiguous type might, just possibly be callable:\nwith -XFlexibleInstances we could have\n  instance C a where ...\nand now a call could be legal after all!  Well, we'll reject this\nunless the instance is available *here*.\n\nNote [When to call checkAmbiguity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe call checkAmbiguity\n   (a) on user-specified type signatures\n   (b) in checkValidType\n\nConncerning (b), you might wonder about nested foralls.  What about\n    f :: forall b. (forall a. Eq a => b) -> b\nThe nested forall is ambiguous.  Originally we called checkAmbiguity\nin the forall case of check_type, but that had two bad consequences:\n  * We got two error messages about (Eq b) in a nested forall like this:\n       g :: forall a. Eq a => forall b. Eq b => a -> a\n  * If we try to check for ambiguity of a nested forall like\n    (forall a. Eq a => b), the implication constraint doesn't bind\n    all the skolems, which results in \"No skolem info\" in error\n    messages (see Trac #10432).\n\nTo avoid this, we call checkAmbiguity once, at the top, in checkValidType.\n(I'm still a bit worried about unbound skolems when the type mentions\nin-scope type variables.)\n\nIn fact, because of the co/contra-variance implemented in tcSubType,\nthis *does* catch function f above. too.\n\nConcerning (a) the ambiguity check is only used for *user* types, not\nfor types coming from inteface files.  The latter can legitimately\nhave ambiguous types. Example\n\n   class S a where s :: a -> (Int,Int)\n   instance S Char where s _ = (1,1)\n   f:: S a => [a] -> Int -> (Int,Int)\n   f (_::[a]) x = (a*x,b)\n        where (a,b) = s (undefined::a)\n\nHere the worker for f gets the type\n        fw :: forall a. S a => Int -> (# Int, Int #)\n\n\nNote [Implicit parameters and ambiguity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOnly a *class* predicate can give rise to ambiguity\nAn *implicit parameter* cannot.  For example:\n        foo :: (?x :: [a]) => Int\n        foo = length ?x\nis fine.  The call site will supply a particular 'x'\n\nFurthermore, the type variables fixed by an implicit parameter\npropagate to the others.  E.g.\n        foo :: (Show a, ?x::[a]) => Int\n        foo = show (?x++?x)\nThe type of foo looks ambiguous.  But it isn't, because at a call site\nwe might have\n        let ?x = 5::Int in foo\nand all is well.  In effect, implicit parameters are, well, parameters,\nso we can take their type variables into account as part of the\n\"tau-tvs\" stuff.  This is done in the function 'FunDeps.grow'.\n-}\n\ncheckAmbiguity :: UserTypeCtxt -> Type -> TcM ()\ncheckAmbiguity ctxt ty\n  | wantAmbiguityCheck ctxt\n  = do { traceTc \"Ambiguity check for\" (ppr ty)\n         -- Solve the constraints eagerly because an ambiguous type\n         -- can cause a cascade of further errors.  Since the free\n         -- tyvars are skolemised, we can safely use tcSimplifyTop\n       ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes\n       ; (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $\n                            captureConstraints $\n                            tcSubType_NC ctxt ty ty\n       ; simplifyAmbiguityCheck ty wanted\n\n       ; traceTc \"Done ambiguity check for\" (ppr ty) }\n\n  | otherwise\n  = return ()\n where\n   mk_msg allow_ambiguous\n     = vcat [ text \"In the ambiguity check for\" <+> what\n            , ppUnless allow_ambiguous ambig_msg ]\n   ambig_msg = text \"To defer the ambiguity check to use sites, enable AllowAmbiguousTypes\"\n   what | Just n <- isSigMaybe ctxt = quotes (ppr n)\n        | otherwise                 = pprUserTypeCtxt ctxt\n\nwantAmbiguityCheck :: UserTypeCtxt -> Bool\nwantAmbiguityCheck ctxt\n  = case ctxt of  -- See Note [When we don't check for ambiguity]\n      GhciCtxt {}  -> False\n      TySynCtxt {} -> False\n      TypeAppCtxt  -> False\n      _            -> True\n\ncheckUserTypeError :: Type -> TcM ()\n-- Check to see if the type signature mentions \"TypeError blah\"\n-- anywhere in it, and fail if so.\n--\n-- Very unsatisfactorily (Trac #11144) we need to tidy the type\n-- because it may have come from an /inferred/ signature, not a\n-- user-supplied one.  This is really only a half-baked fix;\n-- the other errors in checkValidType don't do tidying, and so\n-- may give bad error messages when given an inferred type.\ncheckUserTypeError = check\n  where\n  check ty\n    | Just msg     <- userTypeError_maybe ty  = fail_with msg\n    | Just (_,ts)  <- splitTyConApp_maybe ty  = mapM_ check ts\n    | Just (t1,t2) <- splitAppTy_maybe ty     = check t1 >> check t2\n    | Just (_,t1)  <- splitForAllTy_maybe ty  = check t1\n    | otherwise                               = return ()\n\n  fail_with msg = do { env0 <- tcInitTidyEnv\n                     ; let (env1, tidy_msg) = tidyOpenType env0 msg\n                     ; failWithTcM (env1, pprUserTypeErrorTy tidy_msg) }\n\n\n{- Note [When we don't check for ambiguity]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a few places we do not want to check a user-specified type for ambiguity\n\n* GhciCtxt: Allow ambiguous types in GHCi's :kind command\n  E.g.   type family T a :: *  -- T :: forall k. k -> *\n  Then :k T should work in GHCi, not complain that\n  (T k) is ambiguous!\n\n* TySynCtxt: type T a b = C a b => blah\n  It may be that when we /use/ T, we'll give an 'a' or 'b' that somehow\n  cure the ambiguity.  So we defer the ambiguity check to the use site.\n\n  There is also an implementation reason (Trac #11608).  In the RHS of\n  a type synonym we don't (currently) instantiate 'a' and 'b' with\n  TcTyVars before calling checkValidType, so we get asertion failures\n  from doing an ambiguity check on a type with TyVars in it.  Fixing this\n  would not be hard, but let's wait till there's a reason.\n\n* TypeAppCtxt: visible type application\n     f @ty\n  No need to check ty for ambiguity\n\n\n************************************************************************\n*                                                                      *\n          Checking validity of a user-defined type\n*                                                                      *\n************************************************************************\n\nWhen dealing with a user-written type, we first translate it from an HsType\nto a Type, performing kind checking, and then check various things that should\nbe true about it.  We don't want to perform these checks at the same time\nas the initial translation because (a) they are unnecessary for interface-file\ntypes and (b) when checking a mutually recursive group of type and class decls,\nwe can't \"look\" at the tycons/classes yet.  Also, the checks are rather\ndiverse, and used to really mess up the other code.\n\nOne thing we check for is 'rank'.\n\n        Rank 0:         monotypes (no foralls)\n        Rank 1:         foralls at the front only, Rank 0 inside\n        Rank 2:         foralls at the front, Rank 1 on left of fn arrow,\n\n        basic ::= tyvar | T basic ... basic\n\n        r2  ::= forall tvs. cxt => r2a\n        r2a ::= r1 -> r2a | basic\n        r1  ::= forall tvs. cxt => r0\n        r0  ::= r0 -> r0 | basic\n\nAnother thing is to check that type synonyms are saturated.\nThis might not necessarily show up in kind checking.\n        type A i = i\n        data T k = MkT (k Int)\n        f :: T A        -- BAD!\n-}\n\ncheckValidType :: UserTypeCtxt -> Type -> TcM ()\n-- Checks that a user-written type is valid for the given context\n-- Assumes argument is fully zonked\n-- Not used for instance decls; checkValidInstance instead\ncheckValidType ctxt ty\n  = do { traceTc \"checkValidType\" (ppr ty <+> text \"::\" <+> ppr (tcTypeKind ty))\n       ; rankn_flag  <- xoptM LangExt.RankNTypes\n       ; impred_flag <- xoptM LangExt.ImpredicativeTypes\n       ; let gen_rank :: Rank -> Rank\n             gen_rank r | rankn_flag = ArbitraryRank\n                        | otherwise  = r\n\n             rank1 = gen_rank r1\n             rank0 = gen_rank r0\n\n             r0 = rankZeroMonoType\n             r1 = LimitedRank True r0\n\n             rank\n               = case ctxt of\n                 DefaultDeclCtxt-> MustBeMonoType\n                 ResSigCtxt     -> MustBeMonoType\n                 PatSigCtxt     -> rank0\n                 RuleSigCtxt _  -> rank1\n                 TySynCtxt _    -> rank0\n\n                 ExprSigCtxt    -> rank1\n                 KindSigCtxt    -> rank1\n                 TypeAppCtxt | impred_flag -> ArbitraryRank\n                             | otherwise   -> tyConArgMonoType\n                    -- Normally, ImpredicativeTypes is handled in check_arg_type,\n                    -- but visible type applications don't go through there.\n                    -- So we do this check here.\n\n                 FunSigCtxt {}  -> rank1\n                 InfSigCtxt _   -> ArbitraryRank        -- Inferred type\n                 ConArgCtxt _   -> rank1 -- We are given the type of the entire\n                                         -- constructor, hence rank 1\n                 PatSynCtxt _   -> rank1\n\n                 ForSigCtxt _   -> rank1\n                 SpecInstCtxt   -> rank1\n                 ThBrackCtxt    -> rank1\n                 GhciCtxt {}    -> ArbitraryRank\n\n                 TyVarBndrKindCtxt _ -> rank0\n                 DataKindCtxt _      -> rank1\n                 TySynKindCtxt _     -> rank1\n                 TyFamResKindCtxt _  -> rank1\n\n                 _              -> panic \"checkValidType\"\n                                          -- Can't happen; not used for *user* sigs\n\n       ; env <- tcInitOpenTidyEnv (tyCoVarsOfTypeList ty)\n       ; expand <- initialExpandMode\n       ; let ve = ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt\n                             , ve_rank = rank, ve_expand = expand }\n\n       -- Check the internal validity of the type itself\n       -- Fail if bad things happen, else we misleading\n       -- (and more complicated) errors in checkAmbiguity\n       ; checkNoErrs $\n         do { check_type ve ty\n            ; checkUserTypeError ty\n            ; traceTc \"done ct\" (ppr ty) }\n\n       -- Check for ambiguous types.  See Note [When to call checkAmbiguity]\n       -- NB: this will happen even for monotypes, but that should be cheap;\n       --     and there may be nested foralls for the subtype test to examine\n       ; checkAmbiguity ctxt ty\n\n       ; traceTc \"checkValidType done\" (ppr ty <+> text \"::\" <+> ppr (tcTypeKind ty)) }\n\ncheckValidMonoType :: Type -> TcM ()\n-- Assumes argument is fully zonked\ncheckValidMonoType ty\n  = do { env <- tcInitOpenTidyEnv (tyCoVarsOfTypeList ty)\n       ; expand <- initialExpandMode\n       ; let ve = ValidityEnv{ ve_tidy_env = env, ve_ctxt = SigmaCtxt\n                             , ve_rank = MustBeMonoType, ve_expand = expand }\n       ; check_type ve ty }\n\ncheckTySynRhs :: UserTypeCtxt -> TcType -> TcM ()\ncheckTySynRhs ctxt ty\n  | tcReturnsConstraintKind actual_kind\n  = do { ck <- xoptM LangExt.ConstraintKinds\n       ; if ck\n         then  when (tcIsConstraintKind actual_kind)\n                    (do { dflags <- getDynFlags\n                        ; expand <- initialExpandMode\n                        ; check_pred_ty emptyTidyEnv dflags ctxt expand ty })\n         else addErrTcM (constraintSynErr emptyTidyEnv actual_kind) }\n\n  | otherwise\n  = return ()\n  where\n    actual_kind = tcTypeKind ty\n\n{-\nNote [Higher rank types]\n~~~~~~~~~~~~~~~~~~~~~~~~\nTechnically\n            Int -> forall a. a->a\nis still a rank-1 type, but it's not Haskell 98 (Trac #5957).  So the\nvalidity checker allow a forall after an arrow only if we allow it\nbefore -- that is, with Rank2Types or RankNTypes\n-}\n\ndata Rank = ArbitraryRank         -- Any rank ok\n\n          | LimitedRank   -- Note [Higher rank types]\n                 Bool     -- Forall ok at top\n                 Rank     -- Use for function arguments\n\n          | MonoType SDoc   -- Monotype, with a suggestion of how it could be a polytype\n\n          | MustBeMonoType  -- Monotype regardless of flags\n\ninstance Outputable Rank where\n  ppr ArbitraryRank  = text \"ArbitraryRank\"\n  ppr (LimitedRank top_forall_ok r)\n                     = text \"LimitedRank\" <+> ppr top_forall_ok\n                                          <+> parens (ppr r)\n  ppr (MonoType msg) = text \"MonoType\" <+> parens msg\n  ppr MustBeMonoType = text \"MustBeMonoType\"\n\nrankZeroMonoType, tyConArgMonoType, synArgMonoType, constraintMonoType :: Rank\nrankZeroMonoType   = MonoType (text \"Perhaps you intended to use RankNTypes\")\ntyConArgMonoType   = MonoType (text \"GHC doesn't yet support impredicative polymorphism\")\nsynArgMonoType     = MonoType (text \"Perhaps you intended to use LiberalTypeSynonyms\")\nconstraintMonoType = MonoType (vcat [ text \"A constraint must be a monotype\"\n                                    , text \"Perhaps you intended to use QuantifiedConstraints\" ])\n\nfunArgResRank :: Rank -> (Rank, Rank)             -- Function argument and result\nfunArgResRank (LimitedRank _ arg_rank) = (arg_rank, LimitedRank (forAllAllowed arg_rank) arg_rank)\nfunArgResRank other_rank               = (other_rank, other_rank)\n\nforAllAllowed :: Rank -> Bool\nforAllAllowed ArbitraryRank             = True\nforAllAllowed (LimitedRank forall_ok _) = forall_ok\nforAllAllowed _                         = False\n\nallConstraintsAllowed :: UserTypeCtxt -> Bool\n-- We don't allow arbitrary constraints in kinds\nallConstraintsAllowed (TyVarBndrKindCtxt {}) = False\nallConstraintsAllowed (DataKindCtxt {})      = False\nallConstraintsAllowed (TySynKindCtxt {})     = False\nallConstraintsAllowed (TyFamResKindCtxt {})  = False\nallConstraintsAllowed _ = True\n\n-- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the\n-- context for the type of a term, where visible, dependent quantification is\n-- currently disallowed.\n--\n-- An example of something that is unambiguously the type of a term is the\n-- @forall a -> a -> a@ in @foo :: forall a -> a -> a@. On the other hand, the\n-- same type in @type family Foo :: forall a -> a -> a@ is unambiguously the\n-- kind of a type, not the type of a term, so it is permitted.\n--\n-- For more examples, see\n-- @testsuite/tests/dependent/should_compile/T16326_Compile*.hs@ (for places\n-- where VDQ is permitted) and\n-- @testsuite/tests/dependent/should_fail/T16326_Fail*.hs@ (for places where\n-- VDQ is disallowed).\nvdqAllowed :: UserTypeCtxt -> Bool\n-- Currently allowed in the kinds of types...\nvdqAllowed (KindSigCtxt {}) = True\nvdqAllowed (TySynCtxt {}) = True\nvdqAllowed (ThBrackCtxt {}) = True\nvdqAllowed (GhciCtxt {}) = True\nvdqAllowed (TyVarBndrKindCtxt {}) = True\nvdqAllowed (DataKindCtxt {}) = True\nvdqAllowed (TySynKindCtxt {}) = True\nvdqAllowed (TyFamResKindCtxt {}) = True\n-- ...but not in the types of terms.\nvdqAllowed (ConArgCtxt {}) = False\n  -- We could envision allowing VDQ in data constructor types so long as the\n  -- constructor is only ever used at the type level, but for now, GHC adopts\n  -- the stance that VDQ is never allowed in data constructor types.\nvdqAllowed (FunSigCtxt {}) = False\nvdqAllowed (InfSigCtxt {}) = False\nvdqAllowed (ExprSigCtxt {}) = False\nvdqAllowed (TypeAppCtxt {}) = False\nvdqAllowed (PatSynCtxt {}) = False\nvdqAllowed (PatSigCtxt {}) = False\nvdqAllowed (RuleSigCtxt {}) = False\nvdqAllowed (ResSigCtxt {}) = False\nvdqAllowed (ForSigCtxt {}) = False\nvdqAllowed (DefaultDeclCtxt {}) = False\n-- We count class constraints as \"types of terms\". All of the cases below deal\n-- with class constraints.\nvdqAllowed (InstDeclCtxt {}) = False\nvdqAllowed (SpecInstCtxt {}) = False\nvdqAllowed (GenSigCtxt {}) = False\nvdqAllowed (ClassSCCtxt {}) = False\nvdqAllowed (SigmaCtxt {}) = False\nvdqAllowed (DataTyCtxt {}) = False\nvdqAllowed (DerivClauseCtxt {}) = False\n\n{-\nNote [Correctness and performance of type synonym validity checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the type A arg1 arg2, where A is a type synonym. How should we check\nthis type for validity? We have three distinct choices, corresponding to the\nthree constructors of ExpandMode:\n\n1. Expand the application of A, and check the resulting type (`Expand`).\n2. Don't expand the application of A. Only check the arguments (`NoExpand`).\n3. Check the arguments *and* check the expanded type (`Both`).\n\nIt's tempting to think that we could always just pick choice (3), but this\nresults in serious performance issues when checking a type like in the\nsignature for `f` below:\n\n  type S = ...\n  f :: S (S (S (S (S (S ....(S Int)...))))\n\nWhen checking the type of `f`, we'll check the outer `S` application with and\nwithout expansion, and in *each* of those checks, we'll check the next `S`\napplication with and without expansion... the result is exponential blowup! So\nclearly we don't want to use `Both` 100% of the time.\n\nOn the other hand, neither is it correct to use exclusively `Expand` or\nexclusively `NoExpand` 100% of the time:\n\n* If one always expands, then one can miss erroneous programs like the one in\n  the `tcfail129` test case:\n\n    type Foo a = String -> Maybe a\n    type Bar m = m Int\n    blah = undefined :: Bar Foo\n\n  If we expand `Bar Foo` immediately, we'll miss the fact that the `Foo` type\n  synonyms is unsaturated.\n* If one never expands and only checks the arguments, then one can miss\n  erroneous programs like the one in Trac #16059:\n\n    type Foo b = Eq b => b\n    f :: forall b (a :: Foo b). Int\n\n  The kind of `a` contains a constraint, which is illegal, but this will only\n  be caught if `Foo b` is expanded.\n\nTherefore, it's impossible to have these validity checks be simultaneously\ncorrect and performant if one sticks exclusively to a single `ExpandMode`. In\nthat case, the solution is to vary the `ExpandMode`s! In more detail:\n\n1. When we start validity checking, we start with `Expand` if\n   LiberalTypeSynonyms is enabled (see Note [Liberal type synonyms] for why we\n   do this), and we start with `Both` otherwise. The `initialExpandMode`\n   function is responsible for this.\n2. When expanding an application of a type synonym (in `check_syn_tc_app`), we\n   determine which things to check based on the current `ExpandMode` argument.\n   Importantly, if the current mode is `Both`, then we check the arguments in\n   `NoExpand` mode and check the expanded type in `Both` mode.\n\n   Switching to `NoExpand` when checking the arguments is vital to avoid\n   exponential blowup. One consequence of this choice is that if you have\n   the following type synonym in one module (with RankNTypes enabled):\n\n     {-# LANGUAGE RankNTypes #-}\n     module A where\n     type A = forall a. a\n\n   And you define the following in a separate module *without* RankNTypes\n   enabled:\n\n     module B where\n\n     import A\n\n     type Const a b = a\n     f :: Const Int A -> Int\n\n   Then `f` will be accepted, even though `A` (which is technically a rank-n\n   type) appears in its type. We view this as an acceptable compromise, since\n   `A` never appears in the type of `f` post-expansion. If `A` _did_ appear in\n   a type post-expansion, such as in the following variant:\n\n     g :: Const A A -> Int\n\n   Then that would be rejected unless RankNTypes were enabled.\n-}\n\n-- | When validity-checking an application of a type synonym, should we\n-- check the arguments, check the expanded type, or both?\n-- See Note [Correctness and performance of type synonym validity checking]\ndata ExpandMode\n  = Expand   -- ^ Only check the expanded type.\n  | NoExpand -- ^ Only check the arguments.\n  | Both     -- ^ Check both the arguments and the expanded type.\n\ninstance Outputable ExpandMode where\n  ppr e = text $ case e of\n                   Expand   -> \"Expand\"\n                   NoExpand -> \"NoExpand\"\n                   Both     -> \"Both\"\n\n-- | If @LiberalTypeSynonyms@ is enabled, we start in 'Expand' mode for the\n-- reasons explained in @Note [Liberal type synonyms]@. Otherwise, we start\n-- in 'Both' mode.\ninitialExpandMode :: TcM ExpandMode\ninitialExpandMode = do\n  liberal_flag <- xoptM LangExt.LiberalTypeSynonyms\n  pure $ if liberal_flag then Expand else Both\n\n-- | Information about a type being validity-checked.\ndata ValidityEnv = ValidityEnv\n  { ve_tidy_env :: TidyEnv\n  , ve_ctxt     :: UserTypeCtxt\n  , ve_rank     :: Rank\n  , ve_expand   :: ExpandMode }\n\ninstance Outputable ValidityEnv where\n  ppr (ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt\n                  , ve_rank = rank, ve_expand = expand }) =\n    hang (text \"ValidityEnv\")\n       2 (vcat [ text \"ve_tidy_env\" <+> ppr env\n               , text \"ve_ctxt\"     <+> pprUserTypeCtxt ctxt\n               , text \"ve_rank\"     <+> ppr rank\n               , text \"ve_expand\"   <+> ppr expand ])\n\n----------------------------------------\ncheck_type :: ValidityEnv -> Type -> TcM ()\n-- The args say what the *type context* requires, independent\n-- of *flag* settings.  You test the flag settings at usage sites.\n--\n-- Rank is allowed rank for function args\n-- Rank 0 means no for-alls anywhere\n\ncheck_type _ (TyVarTy _) = return ()\n\ncheck_type ve (AppTy ty1 ty2)\n  = do  { check_type ve ty1\n        ; check_arg_type False ve ty2 }\n\ncheck_type ve ty@(TyConApp tc tys)\n  | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc\n  = check_syn_tc_app ve ty tc tys\n  | isUnboxedTupleTyCon tc = check_ubx_tuple ve ty tys\n  | otherwise              = mapM_ (check_arg_type False ve) tys\n\ncheck_type _ (LitTy {}) = return ()\n\ncheck_type ve (CastTy ty _) = check_type ve ty\n\n-- Check for rank-n types, such as (forall x. x -> x) or (Show x => x).\n--\n-- Critically, this case must come *after* the case for TyConApp.\n-- See Note [Liberal type synonyms].\ncheck_type ve@(ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt\n                          , ve_rank = rank, ve_expand = expand }) ty\n  | not (null tvbs && null theta)\n  = do  { traceTc \"check_type\" (ppr ty $$ ppr (forAllAllowed rank))\n        ; checkTcM (forAllAllowed rank) (forAllTyErr env rank ty)\n                -- Reject e.g. (Maybe (?x::Int => Int)),\n                -- with a decent error message\n\n        ; checkConstraintsOK ve theta ty\n                -- Reject forall (a :: Eq b => b). blah\n                -- In a kind signature we don't allow constraints\n\n        ; checkTcM (all (isInvisibleArgFlag . binderArgFlag) tvbs\n                         || vdqAllowed ctxt)\n                   (illegalVDQTyErr env ty)\n                -- Reject visible, dependent quantification in the type of a\n                -- term (e.g., `f :: forall a -> a -> Maybe a`)\n\n        ; check_valid_theta env' SigmaCtxt expand theta\n                -- Allow     type T = ?x::Int => Int -> Int\n                -- but not   type T = ?x::Int\n\n        ; check_type (ve{ve_tidy_env = env'}) tau\n                -- Allow foralls to right of arrow\n\n        ; checkEscapingKind env' tvbs' theta tau }\n  where\n    (tvbs, phi)   = tcSplitForAllVarBndrs ty\n    (theta, tau)  = tcSplitPhiTy phi\n    (env', tvbs') = tidyTyCoVarBinders env tvbs\n\ncheck_type (ve@ValidityEnv{ve_rank = rank}) (FunTy _ arg_ty res_ty)\n  = do  { check_type (ve{ve_rank = arg_rank}) arg_ty\n        ; check_type (ve{ve_rank = res_rank}) res_ty }\n  where\n    (arg_rank, res_rank) = funArgResRank rank\n\ncheck_type _ ty = pprPanic \"check_type\" (ppr ty)\n\n----------------------------------------\ncheck_syn_tc_app :: ValidityEnv\n                 -> KindOrType -> TyCon -> [KindOrType] -> TcM ()\n-- Used for type synonyms and type synonym families,\n-- which must be saturated,\n-- but not data families, which need not be saturated\ncheck_syn_tc_app (ve@ValidityEnv{ ve_ctxt = ctxt, ve_expand = expand })\n                 ty tc tys\n  | tys `lengthAtLeast` tc_arity   -- Saturated\n       -- Check that the synonym has enough args\n       -- This applies equally to open and closed synonyms\n       -- It's OK to have an *over-applied* type synonym\n       --      data Tree a b = ...\n       --      type Foo a = Tree [a]\n       --      f :: Foo a b -> ...\n  = case expand of\n      _ |  isTypeFamilyTyCon tc\n        -> check_args_only expand\n      -- See Note [Correctness and performance of type synonym validity\n      --           checking]\n      Expand   -> check_expansion_only expand\n      NoExpand -> check_args_only expand\n      Both     -> check_args_only NoExpand *> check_expansion_only Both\n\n  | GhciCtxt True <- ctxt  -- Accept outermost under-saturated type synonym or\n                           -- type family constructors in GHCi :kind commands.\n                           -- See Note [Unsaturated type synonyms in GHCi]\n  = check_args_only expand\n\n  | otherwise\n  = failWithTc (tyConArityErr tc tys)\n  where\n    tc_arity  = tyConArity tc\n\n    check_arg :: ExpandMode -> KindOrType -> TcM ()\n    check_arg expand =\n      check_arg_type (isTypeSynonymTyCon tc) (ve{ve_expand = expand})\n\n    check_args_only, check_expansion_only :: ExpandMode -> TcM ()\n    check_args_only expand = mapM_ (check_arg expand) tys\n\n    check_expansion_only expand\n      = ASSERT2( isTypeSynonymTyCon tc, ppr tc )\n        case tcView ty of\n         Just ty' -> let err_ctxt = text \"In the expansion of type synonym\"\n                                    <+> quotes (ppr tc)\n                     in addErrCtxt err_ctxt $\n                        check_type (ve{ve_expand = expand}) ty'\n         Nothing  -> pprPanic \"check_syn_tc_app\" (ppr ty)\n\n{-\nNote [Unsaturated type synonyms in GHCi]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGenerally speaking, GHC disallows unsaturated uses of type synonyms or type\nfamilies. For instance, if one defines `type Const a b = a`, then GHC will not\npermit using `Const` unless it is applied to (at least) two arguments. There is\nan exception to this rule, however: GHCi's :kind command. For instance, it\nis quite common to look up the kind of a type constructor like so:\n\n  \u00ce\u00bb> :kind Const\n  Const :: j -> k -> j\n  \u00ce\u00bb> :kind Const Int\n  Const Int :: k -> Type\n\nStrictly speaking, the two uses of `Const` above are unsaturated, but this\nis an extremely benign (and useful) example of unsaturation, so we allow it\nhere as a special case.\n\nThat being said, we do not allow unsaturation carte blanche in GHCi. Otherwise,\nthis GHCi interaction would be possible:\n\n  \u00ce\u00bb> newtype Fix f = MkFix (f (Fix f))\n  \u00ce\u00bb> type Id a = a\n  \u00ce\u00bb> :kind Fix Id\n  Fix Id :: Type\n\nThis is rather dodgy, so we move to disallow this. We only permit unsaturated\nsynonyms in GHCi if they are *top-level*\u00e2\u20ac\u201dthat is, if the synonym is the\noutermost type being applied. This allows `Const` and `Const Int` in the\nfirst example, but not `Fix Id` in the second example, as `Id` is not the\noutermost type being applied (`Fix` is).\n\nWe track this outermost property in the GhciCtxt constructor of UserTypeCtxt.\nA field of True in GhciCtxt indicates that we're in an outermost position. Any\ntime we invoke `check_arg` to check the validity of an argument, we switch the\nfield to False.\n-}\n\n----------------------------------------\ncheck_ubx_tuple :: ValidityEnv -> KindOrType -> [KindOrType] -> TcM ()\ncheck_ubx_tuple (ve@ValidityEnv{ve_tidy_env = env}) ty tys\n  = do  { ub_tuples_allowed <- xoptM LangExt.UnboxedTuples\n        ; checkTcM ub_tuples_allowed (ubxArgTyErr env ty)\n\n        ; impred <- xoptM LangExt.ImpredicativeTypes\n        ; let rank' = if impred then ArbitraryRank else tyConArgMonoType\n                -- c.f. check_arg_type\n                -- However, args are allowed to be unlifted, or\n                -- more unboxed tuples, so can't use check_arg_ty\n        ; mapM_ (check_type (ve{ve_rank = rank'})) tys }\n\n----------------------------------------\ncheck_arg_type\n  :: Bool -- ^ Is this the argument to a type synonym?\n  -> ValidityEnv -> KindOrType -> TcM ()\n-- The sort of type that can instantiate a type variable,\n-- or be the argument of a type constructor.\n-- Not an unboxed tuple, but now *can* be a forall (since impredicativity)\n-- Other unboxed types are very occasionally allowed as type\n-- arguments depending on the kind of the type constructor\n--\n-- For example, we want to reject things like:\n--\n--      instance Ord a => Ord (forall s. T s a)\n-- and\n--      g :: T s (forall b.b)\n--\n-- NB: unboxed tuples can have polymorphic or unboxed args.\n--     This happens in the workers for functions returning\n--     product types with polymorphic components.\n--     But not in user code.\n-- Anyway, they are dealt with by a special case in check_tau_type\n\ncheck_arg_type _ _ (CoercionTy {}) = return ()\n\ncheck_arg_type type_syn (ve@ValidityEnv{ve_ctxt = ctxt, ve_rank = rank}) ty\n  = do  { impred <- xoptM LangExt.ImpredicativeTypes\n        ; let rank' = case rank of          -- Predictive => must be monotype\n                        -- Rank-n arguments to type synonyms are OK, provided\n                        -- that LiberalTypeSynonyms is enabled.\n                        _ | type_syn       -> synArgMonoType\n                        MustBeMonoType     -> MustBeMonoType  -- Monotype, regardless\n                        _other | impred    -> ArbitraryRank\n                               | otherwise -> tyConArgMonoType\n                        -- Make sure that MustBeMonoType is propagated,\n                        -- so that we don't suggest -XImpredicativeTypes in\n                        --    (Ord (forall a.a)) => a -> a\n                        -- and so that if it Must be a monotype, we check that it is!\n              ctxt' :: UserTypeCtxt\n              ctxt'\n                | GhciCtxt _ <- ctxt = GhciCtxt False\n                    -- When checking an argument, set the field of GhciCtxt to\n                    -- False to indicate that we are no longer in an outermost\n                    -- position (and thus unsaturated synonyms are no longer\n                    -- allowed).\n                    -- See Note [Unsaturated type synonyms in GHCi]\n                | otherwise          = ctxt\n\n        ; check_type (ve{ve_ctxt = ctxt', ve_rank = rank'}) ty }\n\n----------------------------------------\nforAllTyErr :: TidyEnv -> Rank -> Type -> (TidyEnv, SDoc)\nforAllTyErr env rank ty\n   = ( env\n     , vcat [ hang herald 2 (ppr_tidy env ty)\n            , suggestion ] )\n  where\n    (tvs, _theta, _tau) = tcSplitSigmaTy ty\n    herald | null tvs  = text \"Illegal qualified type:\"\n           | otherwise = text \"Illegal polymorphic type:\"\n    suggestion = case rank of\n                   LimitedRank {} -> text \"Perhaps you intended to use RankNTypes\"\n                   MonoType d     -> d\n                   _              -> Outputable.empty -- Polytype is always illegal\n\n-- | Reject type variables that would escape their escape through a kind.\n-- See @Note [Type variables escaping through kinds]@.\ncheckEscapingKind :: TidyEnv -> [TyVarBinder] -> ThetaType -> Type -> TcM ()\ncheckEscapingKind env tvbs theta tau =\n  case occCheckExpand (binderVars tvbs) phi_kind of\n    -- Ensure that none of the tvs occur in the kind of the forall\n    -- /after/ expanding type synonyms.\n    -- See Note [Phantom type variables in kinds] in Type\n    Nothing -> failWithTcM $ forAllEscapeErr env tvbs theta tau tau_kind\n    Just _  -> pure ()\n  where\n    tau_kind              = tcTypeKind tau\n    phi_kind | null theta = tau_kind\n             | otherwise  = liftedTypeKind\n        -- If there are any constraints, the kind is *. (#11405)\n\nforAllEscapeErr :: TidyEnv -> [TyVarBinder] -> ThetaType -> Type -> Kind\n                -> (TidyEnv, SDoc)\nforAllEscapeErr env tvbs theta tau tau_kind\n  = ( env\n    , vcat [ hang (text \"Quantified type's kind mentions quantified type variable\")\n                2 (text \"type:\" <+> quotes (ppr (mkSigmaTy tvbs theta tau)))\n                -- NB: Don't tidy this type since the tvbs were already tidied\n                -- previously, and re-tidying them will make the names of type\n                -- variables different from tau_kind.\n           , hang (text \"where the body of the forall has this kind:\")\n                2 (quotes (ppr_tidy env tau_kind)) ] )\n\n{-\nNote [Type variables escaping through kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider:\n\n  type family T (r :: RuntimeRep) :: TYPE r\n  foo :: forall r. T r\n\nSomething smells funny about the type of `foo`. If you spell out the kind\nexplicitly, it becomes clearer from where the smell originates:\n\n  foo :: ((forall r. T r) :: TYPE r)\n\nThe type variable `r` appears in the result kind, which escapes the scope of\nits binding site! This is not desirable, so we establish a validity check\n(`checkEscapingKind`) to catch any type variables that might escape through\nkinds in this way.\n-}\n\nubxArgTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)\nubxArgTyErr env ty\n  = ( env, vcat [ sep [ text \"Illegal unboxed tuple type as function argument:\"\n                      , ppr_tidy env ty ]\n                , text \"Perhaps you intended to use UnboxedTuples\" ] )\n\ncheckConstraintsOK :: ValidityEnv -> ThetaType -> Type -> TcM ()\ncheckConstraintsOK ve theta ty\n  | null theta                         = return ()\n  | allConstraintsAllowed (ve_ctxt ve) = return ()\n  | otherwise\n  = -- We are in a kind, where we allow only equality predicates\n    -- See Note [Constraints in kinds] in TyCoRep, and Trac #16263\n    checkTcM (all isEqPred theta) $\n    constraintTyErr (ve_tidy_env ve) ty\n\nconstraintTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)\nconstraintTyErr env ty\n  = (env, text \"Illegal constraint in a kind:\" <+> ppr_tidy env ty)\n\n-- | Reject a use of visible, dependent quantification in the type of a term.\nillegalVDQTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)\nillegalVDQTyErr env ty =\n  (env, vcat\n  [ hang (text \"Illegal visible, dependent quantification\" <+>\n          text \"in the type of a term:\")\n       2 (ppr_tidy env ty)\n  , text \"(GHC does not yet support this)\" ] )\n\n{-\nNote [Liberal type synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf -XLiberalTypeSynonyms is on, expand closed type synonyms *before*\ndoing validity checking.  This allows us to instantiate a synonym defn\nwith a for-all type, or with a partially-applied type synonym.\n        e.g.   type T a b = a\n               type S m   = m ()\n               f :: S (T Int)\nHere, T is partially applied, so it's illegal in H98.  But if you\nexpand S first, then T we get just\n               f :: Int\nwhich is fine.\n\nIMPORTANT: suppose T is a type synonym.  Then we must do validity\nchecking on an appliation (T ty1 ty2)\n\n        *either* before expansion (i.e. check ty1, ty2)\n        *or* after expansion (i.e. expand T ty1 ty2, and then check)\n        BUT NOT BOTH\n\nIf we do both, we get exponential behaviour!!\n\n  data TIACons1 i r c = c i ::: r c\n  type TIACons2 t x = TIACons1 t (TIACons1 t x)\n  type TIACons3 t x = TIACons2 t (TIACons1 t x)\n  type TIACons4 t x = TIACons2 t (TIACons2 t x)\n  type TIACons7 t x = TIACons4 t (TIACons3 t x)\n\nThe order in which you do validity checking is also somewhat delicate. Consider\nthe `check_type` function, which drives the validity checking for unsaturated\nuses of type synonyms. There is a special case for rank-n types, such as\n(forall x. x -> x) or (Show x => x), since those require at least one language\nextension to use. It used to be the case that this case came before every other\ncase, but this can lead to bugs. Imagine you have this scenario (from #15954):\n\n  type A a = Int\n  type B (a :: Type -> Type) = forall x. x -> x\n  type C = B A\n\nIf the rank-n case came first, then in the process of checking for `forall`s\nor contexts, we would expand away `B A` to `forall x. x -> x`. This is because\nthe functions that split apart `forall`s/contexts\n(tcSplitForAllVarBndrs/tcSplitPhiTy) expand type synonyms! If `B A` is expanded\naway to `forall x. x -> x` before the actually validity checks occur, we will\nhave completely obfuscated the fact that we had an unsaturated application of\nthe `A` type synonym.\n\nWe have since learned from our mistakes and now put this rank-n case /after/\nthe case for TyConApp, which ensures that an unsaturated `A` TyConApp will be\ncaught properly. But be careful! We can't make the rank-n case /last/ either,\nas the FunTy case must came after the rank-n case. Otherwise, something like\n(Eq a => Int) would be treated as a function type (FunTy), which just\nwouldn't do.\n\n************************************************************************\n*                                                                      *\n\\subsection{Checking a theta or source type}\n*                                                                      *\n************************************************************************\n\nNote [Implicit parameters in instance decls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nImplicit parameters _only_ allowed in type signatures; not in instance\ndecls, superclasses etc. The reason for not allowing implicit params in\ninstances is a bit subtle.  If we allowed\n  instance (?x::Int, Eq a) => Foo [a] where ...\nthen when we saw\n     (e :: (?x::Int) => t)\nit would be unclear how to discharge all the potential uses of the ?x\nin e.  For example, a constraint Foo [Int] might come out of e, and\napplying the instance decl would show up two uses of ?x.  Trac #8912.\n-}\n\ncheckValidTheta :: UserTypeCtxt -> ThetaType -> TcM ()\n-- Assumes argument is fully zonked\ncheckValidTheta ctxt theta\n  = addErrCtxtM (checkThetaCtxt ctxt theta) $\n    do { env <- tcInitOpenTidyEnv (tyCoVarsOfTypesList theta)\n       ; expand <- initialExpandMode\n       ; check_valid_theta env ctxt expand theta }\n\n-------------------------\ncheck_valid_theta :: TidyEnv -> UserTypeCtxt -> ExpandMode\n                  -> [PredType] -> TcM ()\ncheck_valid_theta _ _ _ []\n  = return ()\ncheck_valid_theta env ctxt expand theta\n  = do { dflags <- getDynFlags\n       ; warnTcM (Reason Opt_WarnDuplicateConstraints)\n                 (wopt Opt_WarnDuplicateConstraints dflags && notNull dups)\n                 (dupPredWarn env dups)\n       ; traceTc \"check_valid_theta\" (ppr theta)\n       ; mapM_ (check_pred_ty env dflags ctxt expand) theta }\n  where\n    (_,dups) = removeDups nonDetCmpType theta\n    -- It's OK to use nonDetCmpType because dups only appears in the\n    -- warning\n\n-------------------------\n{- Note [Validity checking for constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe look through constraint synonyms so that we can see the underlying\nconstraint(s).  For example\n   type Foo = ?x::Int\n   instance Foo => C T\nWe should reject the instance because it has an implicit parameter in\nthe context.\n\nBut we record, in 'under_syn', whether we have looked under a synonym\nto avoid requiring language extensions at the use site.  Main example\n(Trac #9838):\n\n   {-# LANGUAGE ConstraintKinds #-}\n   module A where\n      type EqShow a = (Eq a, Show a)\n\n   module B where\n      import A\n      foo :: EqShow a => a -> String\n\nWe don't want to require ConstraintKinds in module B.\n-}\n\ncheck_pred_ty :: TidyEnv -> DynFlags -> UserTypeCtxt -> ExpandMode\n              -> PredType -> TcM ()\n-- Check the validity of a predicate in a signature\n-- See Note [Validity checking for constraints]\ncheck_pred_ty env dflags ctxt expand pred\n  = do { check_type ve pred\n       ; check_pred_help False env dflags ctxt pred }\n  where\n    rank | xopt LangExt.QuantifiedConstraints dflags\n         = ArbitraryRank\n         | otherwise\n         = constraintMonoType\n\n    ve :: ValidityEnv\n    ve = ValidityEnv{ ve_tidy_env = env\n                    , ve_ctxt     = SigmaCtxt\n                    , ve_rank     = rank\n                    , ve_expand   = expand }\n\ncheck_pred_help :: Bool    -- True <=> under a type synonym\n                -> TidyEnv\n                -> DynFlags -> UserTypeCtxt\n                -> PredType -> TcM ()\ncheck_pred_help under_syn env dflags ctxt pred\n  | Just pred' <- tcView pred  -- Switch on under_syn when going under a\n                                 -- synonym (Trac #9838, yuk)\n  = check_pred_help True env dflags ctxt pred'\n\n  | otherwise  -- A bit like classifyPredType, but not the same\n               -- E.g. we treat (~) like (~#); and we look inside tuples\n  = case classifyPredType pred of\n      ClassPred cls tys\n        | isCTupleClass cls   -> check_tuple_pred under_syn env dflags ctxt pred tys\n        | otherwise           -> check_class_pred env dflags ctxt pred cls tys\n\n      EqPred NomEq _ _  -> -- a ~# b\n                           check_eq_pred env dflags pred\n\n      EqPred ReprEq _ _ -> -- Ugh!  When inferring types we may get\n                           -- f :: (a ~R# b) => blha\n                           -- And we want to treat that like (Coercible a b)\n                           -- We should probably check argument shapes, but we\n                           -- didn't do so before, so I'm leaving it for now\n                           return ()\n\n      ForAllPred _ theta head -> check_quant_pred env dflags ctxt pred theta head\n      IrredPred {}            -> check_irred_pred under_syn env dflags ctxt pred\n\ncheck_eq_pred :: TidyEnv -> DynFlags -> PredType -> TcM ()\ncheck_eq_pred env dflags pred\n  =         -- Equational constraints are valid in all contexts if type\n            -- families are permitted\n    checkTcM (xopt LangExt.TypeFamilies dflags\n              || xopt LangExt.GADTs dflags)\n             (eqPredTyErr env pred)\n\ncheck_quant_pred :: TidyEnv -> DynFlags -> UserTypeCtxt\n                 -> PredType -> ThetaType -> PredType -> TcM ()\ncheck_quant_pred env dflags _ctxt pred theta head_pred\n  = addErrCtxt (text \"In the quantified constraint\" <+> quotes (ppr pred)) $\n    do { -- Check the instance head\n         case classifyPredType head_pred of\n            ClassPred cls tys -> checkValidInstHead SigmaCtxt cls tys\n                                 -- SigmaCtxt tells checkValidInstHead that\n                                 -- this is the head of a quantified constraint\n            IrredPred {}      | hasTyVarHead head_pred\n                              -> return ()\n            _                 -> failWithTcM (badQuantHeadErr env pred)\n\n         -- Check for termination\n       ; unless (xopt LangExt.UndecidableInstances dflags) $\n         checkInstTermination theta head_pred\n    }\n\ncheck_tuple_pred :: Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> [PredType] -> TcM ()\ncheck_tuple_pred under_syn env dflags ctxt pred ts\n  = do { -- See Note [ConstraintKinds in predicates]\n         checkTcM (under_syn || xopt LangExt.ConstraintKinds dflags)\n                  (predTupleErr env pred)\n       ; mapM_ (check_pred_help under_syn env dflags ctxt) ts }\n    -- This case will not normally be executed because without\n    -- -XConstraintKinds tuple types are only kind-checked as *\n\ncheck_irred_pred :: Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> TcM ()\ncheck_irred_pred under_syn env dflags ctxt pred\n    -- The predicate looks like (X t1 t2) or (x t1 t2) :: Constraint\n    -- where X is a type function\n  = do { -- If it looks like (x t1 t2), require ConstraintKinds\n         --   see Note [ConstraintKinds in predicates]\n         -- But (X t1 t2) is always ok because we just require ConstraintKinds\n         -- at the definition site (Trac #9838)\n        failIfTcM (not under_syn && not (xopt LangExt.ConstraintKinds dflags)\n                                && hasTyVarHead pred)\n                  (predIrredErr env pred)\n\n         -- Make sure it is OK to have an irred pred in this context\n         -- See Note [Irreducible predicates in superclasses]\n       ; failIfTcM (is_superclass ctxt\n                    && not (xopt LangExt.UndecidableInstances dflags)\n                    && has_tyfun_head pred)\n                   (predSuperClassErr env pred) }\n  where\n    is_superclass ctxt = case ctxt of { ClassSCCtxt _ -> True; _ -> False }\n    has_tyfun_head ty\n      = case tcSplitTyConApp_maybe ty of\n          Just (tc, _) -> isTypeFamilyTyCon tc\n          Nothing      -> False\n\n{- Note [ConstraintKinds in predicates]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDon't check for -XConstraintKinds under a type synonym, because that\nwas done at the type synonym definition site; see Trac #9838\ne.g.   module A where\n          type C a = (Eq a, Ix a)   -- Needs -XConstraintKinds\n       module B where\n          import A\n          f :: C a => a -> a        -- Does *not* need -XConstraintKinds\n\nNote [Irreducible predicates in superclasses]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAllowing type-family calls in class superclasses is somewhat dangerous\nbecause we can write:\n\n type family Fooish x :: * -> Constraint\n type instance Fooish () = Foo\n class Fooish () a => Foo a where\n\nThis will cause the constraint simplifier to loop because every time we canonicalise a\n(Foo a) class constraint we add a (Fooish () a) constraint which will be immediately\nsolved to add+canonicalise another (Foo a) constraint.  -}\n\n-------------------------\ncheck_class_pred :: TidyEnv -> DynFlags -> UserTypeCtxt\n                 -> PredType -> Class -> [TcType] -> TcM ()\ncheck_class_pred env dflags ctxt pred cls tys\n  |  isEqPredClass cls    -- (~) and (~~) are classified as classes,\n                          -- but here we want to treat them as equalities\n  = -- pprTrace \"check_class\" (ppr cls) $\n    check_eq_pred env dflags pred\n\n  | isIPClass cls\n  = do { check_arity\n       ; checkTcM (okIPCtxt ctxt) (badIPPred env pred) }\n\n  | otherwise     -- Includes Coercible\n  = do { check_arity\n       ; checkSimplifiableClassConstraint env dflags ctxt cls tys\n       ; checkTcM arg_tys_ok (predTyVarErr env pred) }\n  where\n    check_arity = checkTc (tys `lengthIs` classArity cls)\n                          (tyConArityErr (classTyCon cls) tys)\n\n    -- Check the arguments of a class constraint\n    flexible_contexts = xopt LangExt.FlexibleContexts     dflags\n    undecidable_ok    = xopt LangExt.UndecidableInstances dflags\n    arg_tys_ok = case ctxt of\n        SpecInstCtxt -> True    -- {-# SPECIALISE instance Eq (T Int) #-} is fine\n        InstDeclCtxt {} -> checkValidClsArgs (flexible_contexts || undecidable_ok) cls tys\n                                -- Further checks on head and theta\n                                -- in checkInstTermination\n        _               -> checkValidClsArgs flexible_contexts cls tys\n\ncheckSimplifiableClassConstraint :: TidyEnv -> DynFlags -> UserTypeCtxt\n                                 -> Class -> [TcType] -> TcM ()\n-- See Note [Simplifiable given constraints]\ncheckSimplifiableClassConstraint env dflags ctxt cls tys\n  | not (wopt Opt_WarnSimplifiableClassConstraints dflags)\n  = return ()\n  | xopt LangExt.MonoLocalBinds dflags\n  = return ()\n\n  | DataTyCtxt {} <- ctxt   -- Don't do this check for the \"stupid theta\"\n  = return ()               -- of a data type declaration\n\n  | cls `hasKey` coercibleTyConKey\n  = return ()   -- Oddly, we treat (Coercible t1 t2) as unconditionally OK\n                -- matchGlobalInst will reply \"yes\" because we can reduce\n                -- (Coercible a b) to (a ~R# b)\n\n  | otherwise\n  = do { result <- matchGlobalInst dflags False cls tys\n       ; case result of\n           OneInst { cir_what = what }\n              -> addWarnTc (Reason Opt_WarnSimplifiableClassConstraints)\n                                   (simplifiable_constraint_warn what)\n           _          -> return () }\n  where\n    pred = mkClassPred cls tys\n\n    simplifiable_constraint_warn :: InstanceWhat -> SDoc\n    simplifiable_constraint_warn what\n     = vcat [ hang (text \"The constraint\" <+> quotes (ppr (tidyType env pred))\n                    <+> text \"matches\")\n                 2 (ppr_what what)\n            , hang (text \"This makes type inference for inner bindings fragile;\")\n                 2 (text \"either use MonoLocalBinds, or simplify it using the instance\") ]\n\n    ppr_what BuiltinInstance = text \"a built-in instance\"\n    ppr_what LocalInstance   = text \"a locally-quantified instance\"\n    ppr_what (TopLevInstance { iw_dfun_id = dfun })\n      = hang (text \"instance\" <+> pprSigmaType (idType dfun))\n           2 (text \"--\" <+> pprDefinedAt (idName dfun))\n\n\n{- Note [Simplifiable given constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA type signature like\n   f :: Eq [(a,b)] => a -> b\nis very fragile, for reasons described at length in TcInteract\nNote [Instance and Given overlap].  As that Note discusses, for the\nmost part the clever stuff in TcInteract means that we don't use a\ntop-level instance if a local Given might fire, so there is no\nfragility. But if we /infer/ the type of a local let-binding, things\ncan go wrong (Trac #11948 is an example, discussed in the Note).\n\nSo this warning is switched on only if we have NoMonoLocalBinds; in\nthat case the warning discourages users from writing simplifiable\nclass constraints.\n\nThe warning only fires if the constraint in the signature\nmatches the top-level instances in only one way, and with no\nunifiers -- that is, under the same circumstances that\nTcInteract.matchInstEnv fires an interaction with the top\nlevel instances.  For example (Trac #13526), consider\n\n  instance {-# OVERLAPPABLE #-} Eq (T a) where ...\n  instance                   Eq (T Char) where ..\n  f :: Eq (T a) => ...\n\nWe don't want to complain about this, even though the context\n(Eq (T a)) matches an instance, because the user may be\ndeliberately deferring the choice so that the Eq (T Char)\nhas a chance to fire when 'f' is called.  And the fragility\nonly matters when there's a risk that the instance might\nfire instead of the local 'given'; and there is no such\nrisk in this case.  Just use the same rules as for instance\nfiring!\n-}\n\n-------------------------\nokIPCtxt :: UserTypeCtxt -> Bool\n  -- See Note [Implicit parameters in instance decls]\nokIPCtxt (FunSigCtxt {})        = True\nokIPCtxt (InfSigCtxt {})        = True\nokIPCtxt ExprSigCtxt            = True\nokIPCtxt TypeAppCtxt            = True\nokIPCtxt PatSigCtxt             = True\nokIPCtxt ResSigCtxt             = True\nokIPCtxt GenSigCtxt             = True\nokIPCtxt (ConArgCtxt {})        = True\nokIPCtxt (ForSigCtxt {})        = True  -- ??\nokIPCtxt ThBrackCtxt            = True\nokIPCtxt (GhciCtxt {})          = True\nokIPCtxt SigmaCtxt              = True\nokIPCtxt (DataTyCtxt {})        = True\nokIPCtxt (PatSynCtxt {})        = True\nokIPCtxt (TySynCtxt {})         = True   -- e.g.   type Blah = ?x::Int\n                                         -- Trac #11466\n\nokIPCtxt (KindSigCtxt {})       = False\nokIPCtxt (ClassSCCtxt {})       = False\nokIPCtxt (InstDeclCtxt {})      = False\nokIPCtxt (SpecInstCtxt {})      = False\nokIPCtxt (RuleSigCtxt {})       = False\nokIPCtxt DefaultDeclCtxt        = False\nokIPCtxt DerivClauseCtxt        = False\nokIPCtxt (TyVarBndrKindCtxt {}) = False\nokIPCtxt (DataKindCtxt {})      = False\nokIPCtxt (TySynKindCtxt {})     = False\nokIPCtxt (TyFamResKindCtxt {})  = False\n\n{-\nNote [Kind polymorphic type classes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMultiParam check:\n\n    class C f where...   -- C :: forall k. k -> Constraint\n    instance C Maybe where...\n\n  The dictionary gets type [C * Maybe] even if it's not a MultiParam\n  type class.\n\nFlexibility check:\n\n    class C f where...   -- C :: forall k. k -> Constraint\n    data D a = D a\n    instance C D where\n\n  The dictionary gets type [C * (D *)]. IA0_TODO it should be\n  generalized actually.\n-}\n\ncheckThetaCtxt :: UserTypeCtxt -> ThetaType -> TidyEnv -> TcM (TidyEnv, SDoc)\ncheckThetaCtxt ctxt theta env\n  = return ( env\n           , vcat [ text \"In the context:\" <+> pprTheta (tidyTypes env theta)\n                  , text \"While checking\" <+> pprUserTypeCtxt ctxt ] )\n\neqPredTyErr, predTupleErr, predIrredErr,\n   predSuperClassErr, badQuantHeadErr :: TidyEnv -> PredType -> (TidyEnv, SDoc)\nbadQuantHeadErr env pred\n  = ( env\n    , hang (text \"Quantified predicate must have a class or type variable head:\")\n         2 (ppr_tidy env pred) )\neqPredTyErr  env pred\n  = ( env\n    , text \"Illegal equational constraint\" <+> ppr_tidy env pred $$\n      parens (text \"Use GADTs or TypeFamilies to permit this\") )\npredTupleErr env pred\n  = ( env\n    , hang (text \"Illegal tuple constraint:\" <+> ppr_tidy env pred)\n         2 (parens constraintKindsMsg) )\npredIrredErr env pred\n  = ( env\n    , hang (text \"Illegal constraint:\" <+> ppr_tidy env pred)\n         2 (parens constraintKindsMsg) )\npredSuperClassErr env pred\n  = ( env\n    , hang (text \"Illegal constraint\" <+> quotes (ppr_tidy env pred)\n            <+> text \"in a superclass context\")\n         2 (parens undecidableMsg) )\n\npredTyVarErr :: TidyEnv -> PredType -> (TidyEnv, SDoc)\npredTyVarErr env pred\n  = (env\n    , vcat [ hang (text \"Non type-variable argument\")\n                2 (text \"in the constraint:\" <+> ppr_tidy env pred)\n           , parens (text \"Use FlexibleContexts to permit this\") ])\n\nbadIPPred :: TidyEnv -> PredType -> (TidyEnv, SDoc)\nbadIPPred env pred\n  = ( env\n    , text \"Illegal implicit parameter\" <+> quotes (ppr_tidy env pred) )\n\nconstraintSynErr :: TidyEnv -> Type -> (TidyEnv, SDoc)\nconstraintSynErr env kind\n  = ( env\n    , hang (text \"Illegal constraint synonym of kind:\" <+> quotes (ppr_tidy env kind))\n         2 (parens constraintKindsMsg) )\n\ndupPredWarn :: TidyEnv -> [NE.NonEmpty PredType] -> (TidyEnv, SDoc)\ndupPredWarn env dups\n  = ( env\n    , text \"Duplicate constraint\" <> plural primaryDups <> text \":\"\n      <+> pprWithCommas (ppr_tidy env) primaryDups )\n  where\n    primaryDups = map NE.head dups\n\ntyConArityErr :: TyCon -> [TcType] -> SDoc\n-- For type-constructor arity errors, be careful to report\n-- the number of /visible/ arguments required and supplied,\n-- ignoring the /invisible/ arguments, which the user does not see.\n-- (e.g. Trac #10516)\ntyConArityErr tc tks\n  = arityErr (ppr (tyConFlavour tc)) (tyConName tc)\n             tc_type_arity tc_type_args\n  where\n    vis_tks = filterOutInvisibleTypes tc tks\n\n    -- tc_type_arity = number of *type* args expected\n    -- tc_type_args  = number of *type* args encountered\n    tc_type_arity = count isVisibleTyConBinder (tyConBinders tc)\n    tc_type_args  = length vis_tks\n\narityErr :: Outputable a => SDoc -> a -> Int -> Int -> SDoc\narityErr what name n m\n  = hsep [ text \"The\" <+> what, quotes (ppr name), text \"should have\",\n           n_arguments <> comma, text \"but has been given\",\n           if m==0 then text \"none\" else int m]\n    where\n        n_arguments | n == 0 = text \"no arguments\"\n                    | n == 1 = text \"1 argument\"\n                    | True   = hsep [int n, text \"arguments\"]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Checking for a decent instance head type}\n*                                                                      *\n************************************************************************\n\n@checkValidInstHead@ checks the type {\\em and} its syntactic constraints:\nit must normally look like: @instance Foo (Tycon a b c ...) ...@\n\nThe exceptions to this syntactic checking: (1)~if the @GlasgowExts@\nflag is on, or (2)~the instance is imported (they must have been\ncompiled elsewhere). In these cases, we let them go through anyway.\n\nWe can also have instances for functions: @instance Foo (a -> b) ...@.\n-}\n\ncheckValidInstHead :: UserTypeCtxt -> Class -> [Type] -> TcM ()\ncheckValidInstHead ctxt clas cls_args\n  = do { dflags   <- getDynFlags\n       ; is_boot  <- tcIsHsBootOrSig\n       ; is_sig   <- tcIsHsig\n       ; check_valid_inst_head dflags is_boot is_sig ctxt clas cls_args\n       }\n\n{-\n\nNote [Instances of built-in classes in signature files]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nUser defined instances for KnownNat, KnownSymbol and Typeable are\ndisallowed -- they are generated when needed by GHC itself on-the-fly.\n\nHowever, if they occur in a Backpack signature file, they have an\nentirely different meaning. Suppose in M.hsig we see\n\n  signature M where\n    data T :: Nat\n    instance KnownNat T\n\nThat says that any module satisfying M.hsig must provide a KnownNat\ninstance for T.  We absolultely need that instance when compiling a\nmodule that imports M.hsig: see Trac #15379 and\nNote [Fabricating Evidence for Literals in Backpack] in ClsInst.\n\nHence, checkValidInstHead accepts a user-written instance declaration\nin hsig files, where `is_sig` is True.\n\n-}\n\ncheck_valid_inst_head :: DynFlags -> Bool -> Bool\n                      -> UserTypeCtxt -> Class -> [Type] -> TcM ()\n-- Wow!  There are a surprising number of ad-hoc special cases here.\ncheck_valid_inst_head dflags is_boot is_sig ctxt clas cls_args\n\n  -- If not in an hs-boot file, abstract classes cannot have instances\n  | isAbstractClass clas\n  , not is_boot\n  = failWithTc abstract_class_msg\n\n  -- For Typeable, don't complain about instances for\n  -- standalone deriving; they are no-ops, and we warn about\n  -- it in TcDeriv.deriveStandalone.\n  | clas_nm == typeableClassName\n  , not is_sig\n    -- Note [Instances of built-in classes in signature files]\n  , hand_written_bindings\n  = failWithTc rejected_class_msg\n\n  -- Handwritten instances of KnownNat/KnownSymbol class\n  -- are always forbidden (#12837)\n  | clas_nm `elem` [ knownNatClassName, knownSymbolClassName ]\n  , not is_sig\n    -- Note [Instances of built-in classes in signature files]\n  , hand_written_bindings\n  = failWithTc rejected_class_msg\n\n  -- For the most part we don't allow\n  -- instances for (~), (~~), or Coercible;\n  -- but we DO want to allow them in quantified constraints:\n  --   f :: (forall a b. Coercible a b => Coercible (m a) (m b)) => ...m...\n  | clas_nm `elem` [ heqTyConName, eqTyConName, coercibleTyConName ]\n  , not quantified_constraint\n  = failWithTc rejected_class_msg\n\n  -- Check for hand-written Generic instances (disallowed in Safe Haskell)\n  | clas_nm `elem` genericClassNames\n  , hand_written_bindings\n  =  do { failIfTc (safeLanguageOn dflags) gen_inst_err\n        ; when (safeInferOn dflags) (recordUnsafeInfer emptyBag) }\n\n  | clas_nm == hasFieldClassName\n  = checkHasFieldInst clas cls_args\n\n  | isCTupleClass clas\n  = failWithTc tuple_class_msg\n\n  -- Check language restrictions on the args to the class\n  | check_h98_arg_shape\n  , Just msg <- mb_ty_args_msg\n  = failWithTc (instTypeErr clas cls_args msg)\n\n  | otherwise\n  = checkValidTypePats (classTyCon clas) cls_args\n  where\n    clas_nm = getName clas\n    ty_args = filterOutInvisibleTypes (classTyCon clas) cls_args\n\n    hand_written_bindings\n        = case ctxt of\n            InstDeclCtxt stand_alone -> not stand_alone\n            SpecInstCtxt             -> False\n            DerivClauseCtxt          -> False\n            _                        -> True\n\n    check_h98_arg_shape = case ctxt of\n                            SpecInstCtxt    -> False\n                            DerivClauseCtxt -> False\n                            SigmaCtxt       -> False\n                            _               -> True\n        -- SigmaCtxt: once we are in quantified-constraint land, we\n        -- aren't so picky about enforcing H98-language restrictions\n        -- E.g. we want to allow a head like Coercible (m a) (m b)\n\n\n    -- When we are looking at the head of a quantified constraint,\n    -- check_quant_pred sets ctxt to SigmaCtxt\n    quantified_constraint = case ctxt of\n                              SigmaCtxt -> True\n                              _         -> False\n\n    head_type_synonym_msg = parens (\n                text \"All instance types must be of the form (T t1 ... tn)\" $$\n                text \"where T is not a synonym.\" $$\n                text \"Use TypeSynonymInstances if you want to disable this.\")\n\n    head_type_args_tyvars_msg = parens (vcat [\n                text \"All instance types must be of the form (T a1 ... an)\",\n                text \"where a1 ... an are *distinct type variables*,\",\n                text \"and each type variable appears at most once in the instance head.\",\n                text \"Use FlexibleInstances if you want to disable this.\"])\n\n    head_one_type_msg = parens $\n                        text \"Only one type can be given in an instance head.\" $$\n                        text \"Use MultiParamTypeClasses if you want to allow more, or zero.\"\n\n    rejected_class_msg = text \"Class\" <+> quotes (ppr clas_nm)\n                         <+> text \"does not support user-specified instances\"\n    tuple_class_msg    = text \"You can't specify an instance for a tuple constraint\"\n\n    gen_inst_err = rejected_class_msg $$ nest 2 (text \"(in Safe Haskell)\")\n\n    abstract_class_msg = text \"Cannot define instance for abstract class\"\n                         <+> quotes (ppr clas_nm)\n\n    mb_ty_args_msg\n      | not (xopt LangExt.TypeSynonymInstances dflags)\n      , not (all tcInstHeadTyNotSynonym ty_args)\n      = Just head_type_synonym_msg\n\n      | not (xopt LangExt.FlexibleInstances dflags)\n      , not (all tcInstHeadTyAppAllTyVars ty_args)\n      = Just head_type_args_tyvars_msg\n\n      | length ty_args /= 1\n      , not (xopt LangExt.MultiParamTypeClasses dflags)\n      , not (xopt LangExt.NullaryTypeClasses dflags && null ty_args)\n      = Just head_one_type_msg\n\n      | otherwise\n      = Nothing\n\ntcInstHeadTyNotSynonym :: Type -> Bool\n-- Used in Haskell-98 mode, for the argument types of an instance head\n-- These must not be type synonyms, but everywhere else type synonyms\n-- are transparent, so we need a special function here\ntcInstHeadTyNotSynonym ty\n  = case ty of  -- Do not use splitTyConApp,\n                -- because that expands synonyms!\n        TyConApp tc _ -> not (isTypeSynonymTyCon tc)\n        _ -> True\n\ntcInstHeadTyAppAllTyVars :: Type -> Bool\n-- Used in Haskell-98 mode, for the argument types of an instance head\n-- These must be a constructor applied to type variable arguments\n-- or a type-level literal.\n-- But we allow kind instantiations.\ntcInstHeadTyAppAllTyVars ty\n  | Just (tc, tys) <- tcSplitTyConApp_maybe (dropCasts ty)\n  = ok (filterOutInvisibleTypes tc tys)  -- avoid kinds\n  | LitTy _ <- ty = True  -- accept type literals (Trac #13833)\n  | otherwise\n  = False\n  where\n        -- Check that all the types are type variables,\n        -- and that each is distinct\n    ok tys = equalLength tvs tys && hasNoDups tvs\n           where\n             tvs = mapMaybe tcGetTyVar_maybe tys\n\ndropCasts :: Type -> Type\n-- See Note [Casts during validity checking]\n-- This function can turn a well-kinded type into an ill-kinded\n-- one, so I've kept it local to this module\n-- To consider: drop only HoleCo casts\ndropCasts (CastTy ty _)       = dropCasts ty\ndropCasts (AppTy t1 t2)       = mkAppTy (dropCasts t1) (dropCasts t2)\ndropCasts ty@(FunTy _ t1 t2)  = ty { ft_arg = dropCasts t1, ft_res = dropCasts t2 }\ndropCasts (TyConApp tc tys)   = mkTyConApp tc (map dropCasts tys)\ndropCasts (ForAllTy b ty)     = ForAllTy (dropCastsB b) (dropCasts ty)\ndropCasts ty                  = ty  -- LitTy, TyVarTy, CoercionTy\n\ndropCastsB :: TyVarBinder -> TyVarBinder\ndropCastsB b = b   -- Don't bother in the kind of a forall\n\ninstTypeErr :: Class -> [Type] -> SDoc -> SDoc\ninstTypeErr cls tys msg\n  = hang (hang (text \"Illegal instance declaration for\")\n             2 (quotes (pprClassPred cls tys)))\n       2 msg\n\n-- | See Note [Validity checking of HasField instances]\ncheckHasFieldInst :: Class -> [Type] -> TcM ()\ncheckHasFieldInst cls tys@[_k_ty, x_ty, r_ty, _a_ty] =\n  case splitTyConApp_maybe r_ty of\n    Nothing -> whoops (text \"Record data type must be specified\")\n    Just (tc, _)\n      | isFamilyTyCon tc\n                  -> whoops (text \"Record data type may not be a data family\")\n      | otherwise -> case isStrLitTy x_ty of\n       Just lbl\n         | isJust (lookupTyConFieldLabel lbl tc)\n                     -> whoops (ppr tc <+> text \"already has a field\"\n                                       <+> quotes (ppr lbl))\n         | otherwise -> return ()\n       Nothing\n         | null (tyConFieldLabels tc) -> return ()\n         | otherwise -> whoops (ppr tc <+> text \"has fields\")\n  where\n    whoops = addErrTc . instTypeErr cls tys\ncheckHasFieldInst _ tys = pprPanic \"checkHasFieldInst\" (ppr tys)\n\n{- Note [Casts during validity checking]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the (bogus)\n     instance Eq Char#\nWe elaborate to  'Eq (Char# |> UnivCo(hole))'  where the hole is an\ninsoluble equality constraint for * ~ #.  We'll report the insoluble\nconstraint separately, but we don't want to *also* complain that Eq is\nnot applied to a type constructor.  So we look gaily look through\nCastTys here.\n\nAnother example:  Eq (Either a).  Then we actually get a cast in\nthe middle:\n   Eq ((Either |> g) a)\n\n\nNote [Validity checking of HasField instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe HasField class has magic constraint solving behaviour (see Note\n[HasField instances] in TcInteract).  However, we permit users to\ndeclare their own instances, provided they do not clash with the\nbuilt-in behaviour.  In particular, we forbid:\n\n  1. `HasField _ r _` where r is a variable\n\n  2. `HasField _ (T ...) _` if T is a data family\n     (because it might have fields introduced later)\n\n  3. `HasField x (T ...) _` where x is a variable,\n      if T has any fields at all\n\n  4. `HasField \"foo\" (T ...) _` if T has a \"foo\" field\n\nThe usual functional dependency checks also apply.\n\n\nNote [Valid 'deriving' predicate]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nvalidDerivPred checks for OK 'deriving' context.  See Note [Exotic\nderived instance contexts] in TcDeriv.  However the predicate is\nhere because it uses sizeTypes, fvTypes.\n\nIt checks for three things\n\n  * No repeated variables (hasNoDups fvs)\n\n  * No type constructors.  This is done by comparing\n        sizeTypes tys == length (fvTypes tys)\n    sizeTypes counts variables and constructors; fvTypes returns variables.\n    So if they are the same, there must be no constructors.  But there\n    might be applications thus (f (g x)).\n\n    Note that tys only includes the visible arguments of the class type\n    constructor. Including the non-visible arguments can cause the following,\n    perfectly valid instance to be rejected:\n       class Category (cat :: k -> k -> *) where ...\n       newtype T (c :: * -> * -> *) a b = MkT (c a b)\n       instance Category c => Category (T c) where ...\n    since the first argument to Category is a non-visible *, which sizeTypes\n    would count as a constructor! See Trac #11833.\n\n  * Also check for a bizarre corner case, when the derived instance decl\n    would look like\n       instance C a b => D (T a) where ...\n    Note that 'b' isn't a parameter of T.  This gives rise to all sorts of\n    problems; in particular, it's hard to compare solutions for equality\n    when finding the fixpoint, and that means the inferContext loop does\n    not converge.  See Trac #5287.\n\nNote [Equality class instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe can't have users writing instances for the equality classes. But we\nstill need to be able to write instances for them ourselves. So we allow\ninstances only in the defining module.\n\n-}\n\nvalidDerivPred :: TyVarSet -> PredType -> Bool\n-- See Note [Valid 'deriving' predicate]\nvalidDerivPred tv_set pred\n  = case classifyPredType pred of\n       ClassPred cls tys -> cls `hasKey` typeableClassKey\n                -- Typeable constraints are bigger than they appear due\n                -- to kind polymorphism, but that's OK\n                       || check_tys cls tys\n       EqPred {}       -> False  -- reject equality constraints\n       _               -> True   -- Non-class predicates are ok\n  where\n    check_tys cls tys\n              = hasNoDups fvs\n                   -- use sizePred to ignore implicit args\n                && lengthIs fvs (sizePred pred)\n                && all (`elemVarSet` tv_set) fvs\n      where tys' = filterOutInvisibleTypes (classTyCon cls) tys\n            fvs  = fvTypes tys'\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Checking instance for termination}\n*                                                                      *\n************************************************************************\n-}\n\n{- Note [Instances and constraint synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCurrently, we don't allow instances for constraint synonyms at all.\nConsider these (Trac #13267):\n  type C1 a = Show (a -> Bool)\n  instance C1 Int where    -- I1\n    show _ = \"ur\"\n\nThis elicits \"show is not a (visible) method of class C1\", which isn't\na great message. But it comes from the renamer, so it's hard to improve.\n\nThis needs a bit more care:\n  type C2 a = (Show a, Show Int)\n  instance C2 Int           -- I2\n\nIf we use (splitTyConApp_maybe tau) in checkValidInstance to decompose\nthe instance head, we'll expand the synonym on fly, and it'll look like\n  instance (%,%) (Show Int, Show Int)\nand we /really/ don't want that.  So we carefully do /not/ expand\nsynonyms, by matching on TyConApp directly.\n-}\n\ncheckValidInstance :: UserTypeCtxt -> LHsSigType GhcRn -> Type -> TcM ()\ncheckValidInstance ctxt hs_type ty\n  | not is_tc_app\n  = failWithTc (hang (text \"Instance head is not headed by a class:\")\n                   2 ( ppr tau))\n\n  | isNothing mb_cls\n  = failWithTc (vcat [ text \"Illegal instance for a\" <+> ppr (tyConFlavour tc)\n                     , text \"A class instance must be for a class\" ])\n\n  | not arity_ok\n  = failWithTc (text \"Arity mis-match in instance head\")\n\n  | otherwise\n  = do  { setSrcSpan head_loc $\n          checkValidInstHead ctxt clas inst_tys\n\n        ; traceTc \"checkValidInstance {\" (ppr ty)\n\n        ; env0 <- tcInitTidyEnv\n        ; expand <- initialExpandMode\n        ; check_valid_theta env0 ctxt expand theta\n\n        -- The Termination and Coverate Conditions\n        -- Check that instance inference will terminate (if we care)\n        -- For Haskell 98 this will already have been done by checkValidTheta,\n        -- but as we may be using other extensions we need to check.\n        --\n        -- Note that the Termination Condition is *more conservative* than\n        -- the checkAmbiguity test we do on other type signatures\n        --   e.g.  Bar a => Bar Int is ambiguous, but it also fails\n        --   the termination condition, because 'a' appears more often\n        --   in the constraint than in the head\n        ; undecidable_ok <- xoptM LangExt.UndecidableInstances\n        ; if undecidable_ok\n          then checkAmbiguity ctxt ty\n          else checkInstTermination theta tau\n\n        ; traceTc \"cvi 2\" (ppr ty)\n\n        ; case (checkInstCoverage undecidable_ok clas theta inst_tys) of\n            IsValid      -> return ()   -- Check succeeded\n            NotValid msg -> addErrTc (instTypeErr clas inst_tys msg)\n\n        ; traceTc \"End checkValidInstance }\" empty\n\n        ; return () }\n  where\n    (_tvs, theta, tau)   = tcSplitSigmaTy ty\n    is_tc_app            = case tau of { TyConApp {} -> True; _ -> False }\n    TyConApp tc inst_tys = tau   -- See Note [Instances and constraint synonyms]\n    mb_cls               = tyConClass_maybe tc\n    Just clas            = mb_cls\n    arity_ok             = inst_tys `lengthIs` classArity clas\n\n        -- The location of the \"head\" of the instance\n    head_loc = getLoc (getLHsInstDeclHead hs_type)\n\n{-\nNote [Paterson conditions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nTermination test: the so-called \"Paterson conditions\" (see Section 5 of\n\"Understanding functional dependencies via Constraint Handling Rules,\nJFP Jan 2007).\n\nWe check that each assertion in the context satisfies:\n (1) no variable has more occurrences in the assertion than in the head, and\n (2) the assertion has fewer constructors and variables (taken together\n     and counting repetitions) than the head.\nThis is only needed with -fglasgow-exts, as Haskell 98 restrictions\n(which have already been checked) guarantee termination.\n\nThe underlying idea is that\n\n    for any ground substitution, each assertion in the\n    context has fewer type constructors than the head.\n-}\n\ncheckInstTermination :: ThetaType -> TcPredType -> TcM ()\n-- See Note [Paterson conditions]\ncheckInstTermination theta head_pred\n  = check_preds emptyVarSet theta\n  where\n   head_fvs  = fvType head_pred\n   head_size = sizeType head_pred\n\n   check_preds :: VarSet -> [PredType] -> TcM ()\n   check_preds foralld_tvs preds = mapM_ (check foralld_tvs) preds\n\n   check :: VarSet -> PredType -> TcM ()\n   check foralld_tvs pred\n     = case classifyPredType pred of\n         EqPred {}    -> return ()  -- See Trac #4200.\n         IrredPred {} -> check2 foralld_tvs pred (sizeType pred)\n         ClassPred cls tys\n           | isTerminatingClass cls\n           -> return ()\n\n           | isCTupleClass cls  -- Look inside tuple predicates; Trac #8359\n           -> check_preds foralld_tvs tys\n\n           | otherwise          -- Other ClassPreds\n           -> check2 foralld_tvs pred bogus_size\n           where\n              bogus_size = 1 + sizeTypes (filterOutInvisibleTypes (classTyCon cls) tys)\n                               -- See Note [Invisible arguments and termination]\n\n         ForAllPred tvs _ head_pred'\n           -> check (foralld_tvs `extendVarSetList` binderVars tvs) head_pred'\n              -- Termination of the quantified predicate itself is checked\n              -- when the predicates are individually checked for validity\n\n   check2 foralld_tvs pred pred_size\n     | not (null bad_tvs)     = failWithTc (noMoreMsg bad_tvs what (ppr head_pred))\n     | not (isTyFamFree pred) = failWithTc (nestedMsg what)\n     | pred_size >= head_size = failWithTc (smallerMsg what (ppr head_pred))\n     | otherwise              = return ()\n     -- isTyFamFree: see Note [Type families in instance contexts]\n     where\n        what    = text \"constraint\" <+> quotes (ppr pred)\n        bad_tvs = filterOut (`elemVarSet` foralld_tvs) (fvType pred)\n                  \\\\ head_fvs\n\nsmallerMsg :: SDoc -> SDoc -> SDoc\nsmallerMsg what inst_head\n  = vcat [ hang (text \"The\" <+> what)\n              2 (sep [ text \"is no smaller than\"\n                     , text \"the instance head\" <+> quotes inst_head ])\n         , parens undecidableMsg ]\n\nnoMoreMsg :: [TcTyVar] -> SDoc -> SDoc -> SDoc\nnoMoreMsg tvs what inst_head\n  = vcat [ hang (text \"Variable\" <> plural tvs1 <+> quotes (pprWithCommas ppr tvs1)\n                <+> occurs <+> text \"more often\")\n              2 (sep [ text \"in the\" <+> what\n                     , text \"than in the instance head\" <+> quotes inst_head ])\n         , parens undecidableMsg ]\n  where\n   tvs1   = nub tvs\n   occurs = if isSingleton tvs1 then text \"occurs\"\n                               else text \"occur\"\n\nundecidableMsg, constraintKindsMsg :: SDoc\nundecidableMsg     = text \"Use UndecidableInstances to permit this\"\nconstraintKindsMsg = text \"Use ConstraintKinds to permit this\"\n\n{- Note [Type families in instance contexts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAre these OK?\n  type family F a\n  instance F a    => C (Maybe [a]) where ...\n  intance C (F a) => C [[[a]]]     where ...\n\nNo: the type family in the instance head might blow up to an\narbitrarily large type, depending on how 'a' is instantiated.\nSo we require UndecidableInstances if we have a type family\nin the instance head.  Trac #15172.\n\nNote [Invisible arguments and termination]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen checking the \u00e2\u20ac\u2039Paterson conditions for termination an instance\ndeclaration, we check for the number of \"constructors and variables\"\nin the instance head and constraints. Question: Do we look at\n\n * All the arguments, visible or invisible?\n * Just the visible arguments?\n\nI think both will ensure termination, provided we are consistent.\nCurrently we are /not/ consistent, which is really a bug.  It's\ndescribed in Trac #15177, which contains a number of examples.\nThe suspicious bits are the calls to filterOutInvisibleTypes.\n-}\n\n\n{-\n************************************************************************\n*                                                                      *\n        Checking type instance well-formedness and termination\n*                                                                      *\n************************************************************************\n-}\n\ncheckValidCoAxiom :: CoAxiom Branched -> TcM ()\ncheckValidCoAxiom ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches })\n  = do { mapM_ (checkValidCoAxBranch fam_tc) branch_list\n       ; foldlM_ check_branch_compat [] branch_list }\n  where\n    branch_list = fromBranches branches\n    injectivity = tyConInjectivityInfo fam_tc\n\n    check_branch_compat :: [CoAxBranch]    -- previous branches in reverse order\n                        -> CoAxBranch      -- current branch\n                        -> TcM [CoAxBranch]-- current branch : previous branches\n    -- Check for\n    --   (a) this branch is dominated by previous ones\n    --   (b) failure of injectivity\n    check_branch_compat prev_branches cur_branch\n      | cur_branch `isDominatedBy` prev_branches\n      = do { addWarnAt NoReason (coAxBranchSpan cur_branch) $\n             inaccessibleCoAxBranch fam_tc cur_branch\n           ; return prev_branches }\n      | otherwise\n      = do { check_injectivity prev_branches cur_branch\n           ; return (cur_branch : prev_branches) }\n\n     -- Injectivity check: check whether a new (CoAxBranch) can extend\n     -- already checked equations without violating injectivity\n     -- annotation supplied by the user.\n     -- See Note [Verifying injectivity annotation] in FamInstEnv\n    check_injectivity prev_branches cur_branch\n      | Injective inj <- injectivity\n      = do { let conflicts =\n                     fst $ foldl' (gather_conflicts inj prev_branches cur_branch)\n                                 ([], 0) prev_branches\n           ; mapM_ (\\(err, span) -> setSrcSpan span $ addErr err)\n                   (makeInjectivityErrors ax cur_branch inj conflicts) }\n      | otherwise\n      = return ()\n\n    gather_conflicts inj prev_branches cur_branch (acc, n) branch\n               -- n is 0-based index of branch in prev_branches\n      = case injectiveBranches inj cur_branch branch of\n          InjectivityUnified ax1 ax2\n            | ax1 `isDominatedBy` (replace_br prev_branches n ax2)\n                -> (acc, n + 1)\n            | otherwise\n                -> (branch : acc, n + 1)\n          InjectivityAccepted -> (acc, n + 1)\n\n    -- Replace n-th element in the list. Assumes 0-based indexing.\n    replace_br :: [CoAxBranch] -> Int -> CoAxBranch -> [CoAxBranch]\n    replace_br brs n br = take n brs ++ [br] ++ drop (n+1) brs\n\n\n-- Check that a \"type instance\" is well-formed (which includes decidability\n-- unless -XUndecidableInstances is given).\n--\ncheckValidCoAxBranch :: TyCon -> CoAxBranch -> TcM ()\ncheckValidCoAxBranch fam_tc\n                    (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs\n                                , cab_lhs = typats\n                                , cab_rhs = rhs, cab_loc = loc })\n  = setSrcSpan loc $\n    checkValidTyFamEqn fam_tc (tvs++cvs) typats rhs\n\n-- | Do validity checks on a type family equation, including consistency\n-- with any enclosing class instance head, termination, and lack of\n-- polytypes.\ncheckValidTyFamEqn :: TyCon   -- ^ of the type family\n                   -> [Var]   -- ^ Bound variables in the equation\n                   -> [Type]  -- ^ Type patterns\n                   -> Type    -- ^ Rhs\n                   -> TcM ()\ncheckValidTyFamEqn fam_tc qvs typats rhs\n  = do { checkValidTypePats fam_tc typats\n\n         -- Check for things used on the right but not bound on the left\n       ; checkFamPatBinders fam_tc qvs typats rhs\n\n         -- Check for oversaturated visible kind arguments in a type family\n         -- equation.\n         -- See Note [Oversaturated type family equations]\n       ; when (isTypeFamilyTyCon fam_tc) $\n           case drop (tyConArity fam_tc) typats of\n             [] -> pure ()\n             spec_arg:_ ->\n               addErr $ text \"Illegal oversaturated visible kind argument:\"\n                    <+> quotes (char '@' <> pprParendType spec_arg)\n\n         -- The argument patterns, and RHS, are all boxed tau types\n         -- E.g  Reject type family F (a :: k1) :: k2\n         --             type instance F (forall a. a->a) = ...\n         --             type instance F Int#             = ...\n         --             type instance F Int              = forall a. a->a\n         --             type instance F Int              = Int#\n         -- See Trac #9357\n       ; checkValidMonoType rhs\n\n         -- We have a decidable instance unless otherwise permitted\n       ; undecidable_ok <- xoptM LangExt.UndecidableInstances\n       ; traceTc \"checkVTFE\" (ppr fam_tc $$ ppr rhs $$ ppr (tcTyFamInsts rhs))\n       ; unless undecidable_ok $\n         mapM_ addErrTc (checkFamInstRhs fam_tc typats (tcTyFamInsts rhs)) }\n\n-- Make sure that each type family application is\n--   (1) strictly smaller than the lhs,\n--   (2) mentions no type variable more often than the lhs, and\n--   (3) does not contain any further type family instances.\n--\ncheckFamInstRhs :: TyCon -> [Type]         -- LHS\n                -> [(TyCon, [Type])]       -- type family calls in RHS\n                -> [MsgDoc]\ncheckFamInstRhs lhs_tc lhs_tys famInsts\n  = mapMaybe check famInsts\n  where\n   lhs_size  = sizeTyConAppArgs lhs_tc lhs_tys\n   inst_head = pprType (TyConApp lhs_tc lhs_tys)\n   lhs_fvs   = fvTypes lhs_tys\n   check (tc, tys)\n      | not (all isTyFamFree tys) = Just (nestedMsg what)\n      | not (null bad_tvs)        = Just (noMoreMsg bad_tvs what inst_head)\n      | lhs_size <= fam_app_size  = Just (smallerMsg what inst_head)\n      | otherwise                 = Nothing\n      where\n        what = text \"type family application\"\n               <+> quotes (pprType (TyConApp tc tys))\n        fam_app_size = sizeTyConAppArgs tc tys\n        bad_tvs      = fvTypes tys \\\\ lhs_fvs\n                       -- The (\\\\) is list difference; e.g.\n                       --   [a,b,a,a] \\\\ [a,a] = [b,a]\n                       -- So we are counting repetitions\n\n-----------------\ncheckFamPatBinders :: TyCon\n                   -> [TcTyVar]   -- Bound on LHS of family instance\n                   -> [TcType]    -- LHS patterns\n                   -> Type        -- RHS\n                   -> TcM ()\n-- We do these binder checks now, in tcFamTyPatsAndGen, rather\n-- than later, in checkValidFamEqn, for two reasons:\n--   - We have the implicitly and explicitly\n--     bound type variables conveniently to hand\n--   - If implicit variables are out of scope it may\n--     cause a crash; notably in tcConDecl in tcDataFamInstDecl\ncheckFamPatBinders fam_tc qtvs pats rhs\n  = do { traceTc \"checkFamPatBinders\" $\n         vcat [ debugPprType (mkTyConApp fam_tc pats)\n              , ppr (mkTyConApp fam_tc pats)\n              , text \"qtvs:\" <+> ppr qtvs\n              , text \"rhs_tvs:\" <+> ppr (fvVarSet rhs_fvs)\n              , text \"pat_tvs:\" <+> ppr pat_tvs\n              , text \"exact_pat_tvs:\" <+> ppr exact_pat_tvs ]\n\n         -- Check for implicitly-bound tyvars, mentioned on the\n         -- RHS but not bound on the LHS\n         --    data T            = MkT (forall (a::k). blah)\n         --    data family D Int = MkD (forall (a::k). blah)\n         -- In both cases, 'k' is not bound on the LHS, but is used on the RHS\n         -- We catch the former in kcLHsQTyVars, and the latter right here\n         -- See Note [Check type-family instance binders]\n       ; check_tvs bad_rhs_tvs (text \"mentioned in the RHS\")\n                               (text \"bound on the LHS of\")\n\n         -- Check for explicitly forall'd variable that is not bound on LHS\n         --    data instance forall a.  T Int = MkT Int\n         -- See Note [Unused explicitly bound variables in a family pattern]\n         -- See Note [Check type-family instance binders]\n       ; check_tvs bad_qtvs (text \"bound by a forall\")\n                            (text \"used in\")\n       }\n  where\n    pat_tvs       = tyCoVarsOfTypes pats\n    exact_pat_tvs = exactTyCoVarsOfTypes pats\n    rhs_fvs       = tyCoFVsOfType rhs\n    used_tvs      = pat_tvs `unionVarSet` fvVarSet rhs_fvs\n    bad_qtvs      = filterOut (`elemVarSet` used_tvs) qtvs\n                    -- Bound but not used at all\n    bad_rhs_tvs   = filterOut (`elemVarSet` exact_pat_tvs) (fvVarList rhs_fvs)\n                    -- Used on RHS but not bound on LHS\n    dodgy_tvs     = pat_tvs `minusVarSet` exact_pat_tvs\n\n    check_tvs tvs what what2\n      = unless (null tvs) $ addErrAt (getSrcSpan (head tvs)) $\n        hang (text \"Type variable\" <> plural tvs <+> pprQuotedList tvs\n              <+> isOrAre tvs <+> what <> comma)\n           2 (vcat [ text \"but not\" <+> what2 <+> text \"the family instance\"\n                   , mk_extra tvs ])\n\n    -- mk_extra: Trac #7536: give a decent error message for\n    --         type T a = Int\n    --         type instance F (T a) = a\n    mk_extra tvs = ppWhen (any (`elemVarSet` dodgy_tvs) tvs) $\n                   hang (text \"The real LHS (expanding synonyms) is:\")\n                      2 (pprTypeApp fam_tc (map expandTypeSynonyms pats))\n\n\n-- | Checks that a list of type patterns is valid in a matching (LHS)\n-- position of a class instances or type/data family instance.\n--\n-- Specifically:\n--    * All monotypes\n--    * No type-family applications\ncheckValidTypePats :: TyCon -> [Type] -> TcM ()\ncheckValidTypePats tc pat_ty_args\n  = do { -- Check that each of pat_ty_args is a monotype.\n         -- One could imagine generalising to allow\n         --      instance C (forall a. a->a)\n         -- but we don't know what all the consequences might be.\n         traverse_ checkValidMonoType pat_ty_args\n\n       -- Ensure that no type family applications occur a type pattern\n       ; case tcTyConAppTyFamInstsAndVis tc pat_ty_args of\n            [] -> pure ()\n            ((tf_is_invis_arg, tf_tc, tf_args):_) -> failWithTc $\n               ty_fam_inst_illegal_err tf_is_invis_arg\n                                       (mkTyConApp tf_tc tf_args) }\n  where\n    inst_ty = mkTyConApp tc pat_ty_args\n\n    ty_fam_inst_illegal_err :: Bool -> Type -> SDoc\n    ty_fam_inst_illegal_err invis_arg ty\n      = pprWithExplicitKindsWhen invis_arg $\n        hang (text \"Illegal type synonym family application\"\n                <+> quotes (ppr ty) <+> text \"in instance\" <> colon)\n           2 (ppr inst_ty)\n\n-- Error messages\n\ninaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc\ninaccessibleCoAxBranch fam_tc cur_branch\n  = text \"Type family instance equation is overlapped:\" $$\n    nest 2 (pprCoAxBranchUser fam_tc cur_branch)\n\nnestedMsg :: SDoc -> SDoc\nnestedMsg what\n  = sep [ text \"Illegal nested\" <+> what\n        , parens undecidableMsg ]\n\nbadATErr :: Name -> Name -> SDoc\nbadATErr clas op\n  = hsep [text \"Class\", quotes (ppr clas),\n          text \"does not have an associated type\", quotes (ppr op)]\n\n\n-------------------------\ncheckConsistentFamInst :: AssocInstInfo\n                       -> TyCon     -- ^ Family tycon\n                       -> CoAxBranch\n                       -> TcM ()\n-- See Note [Checking consistent instantiation]\n\ncheckConsistentFamInst NotAssociated _ _\n  = return ()\n\ncheckConsistentFamInst (InClsInst { ai_class = clas\n                                  , ai_tyvars = inst_tvs\n                                  , ai_inst_env = mini_env })\n                       fam_tc branch\n  = do { traceTc \"checkConsistentFamInst\" (vcat [ ppr inst_tvs\n                                                , ppr arg_triples\n                                                , ppr mini_env\n                                                , ppr ax_tvs\n                                                , ppr ax_arg_tys\n                                                , ppr arg_triples ])\n       -- Check that the associated type indeed comes from this class\n       -- See [Mismatched class methods and associated type families]\n       -- in TcInstDecls.\n       ; checkTc (Just (classTyCon clas) == tyConAssoc_maybe fam_tc)\n                 (badATErr (className clas) (tyConName fam_tc))\n\n       ; check_match arg_triples\n       }\n  where\n    (ax_tvs, ax_arg_tys, _) = etaExpandCoAxBranch branch\n\n    arg_triples :: [(Type,Type, ArgFlag)]\n    arg_triples = [ (cls_arg_ty, at_arg_ty, vis)\n                  | (fam_tc_tv, vis, at_arg_ty)\n                       <- zip3 (tyConTyVars fam_tc)\n                               (tyConArgFlags fam_tc ax_arg_tys)\n                               ax_arg_tys\n                  , Just cls_arg_ty <- [lookupVarEnv mini_env fam_tc_tv] ]\n\n    pp_wrong_at_arg vis\n      = pprWithExplicitKindsWhen (isInvisibleArgFlag vis) $\n        vcat [ text \"Type indexes must match class instance head\"\n             , text \"Expected:\" <+> pp_expected_ty\n             , text \"  Actual:\" <+> pp_actual_ty ]\n\n    -- Fiddling around to arrange that wildcards unconditionally print as \"_\"\n    -- We only need to print the LHS, not the RHS at all\n    -- See Note [Printing conflicts with class header]\n    (tidy_env1, _) = tidyVarBndrs emptyTidyEnv inst_tvs\n    (tidy_env2, _) = tidyCoAxBndrsForUser tidy_env1 (ax_tvs \\\\ inst_tvs)\n\n    pp_expected_ty = pprIfaceTypeApp topPrec (toIfaceTyCon fam_tc) $\n                     toIfaceTcArgs fam_tc $\n                     [ case lookupVarEnv mini_env at_tv of\n                         Just cls_arg_ty -> tidyType tidy_env2 cls_arg_ty\n                         Nothing         -> mk_wildcard at_tv\n                     | at_tv <- tyConTyVars fam_tc ]\n\n    pp_actual_ty = pprIfaceTypeApp topPrec (toIfaceTyCon fam_tc) $\n                   toIfaceTcArgs fam_tc $\n                   tidyTypes tidy_env2 ax_arg_tys\n\n    mk_wildcard at_tv = mkTyVarTy (mkTyVar tv_name (tyVarKind at_tv))\n    tv_name = mkInternalName (mkAlphaTyVarUnique 1) (mkTyVarOcc \"_\") noSrcSpan\n\n    -- For check_match, bind_me, see\n    -- Note [Matching in the consistent-instantation check]\n    check_match :: [(Type,Type,ArgFlag)] -> TcM ()\n    check_match triples = go emptyTCvSubst emptyTCvSubst triples\n\n    go _ _ [] = return ()\n    go lr_subst rl_subst ((ty1,ty2,vis):triples)\n      | Just lr_subst1 <- tcMatchTyX_BM bind_me lr_subst ty1 ty2\n      , Just rl_subst1 <- tcMatchTyX_BM bind_me rl_subst ty2 ty1\n      = go lr_subst1 rl_subst1 triples\n      | otherwise\n      = addErrTc (pp_wrong_at_arg vis)\n\n    -- The /scoped/ type variables from the class-instance header\n    -- should not be alpha-renamed.  Inferred ones can be.\n    no_bind_set = mkVarSet inst_tvs\n    bind_me tv | tv `elemVarSet` no_bind_set = Skolem\n               | otherwise                   = BindMe\n\n\n{- Note [Check type-family instance binders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn a type family instance, we require (of course), type variables\nused on the RHS are matched on the LHS. This is checked by\ncheckFamPatBinders.  Here is an interesting example:\n\n    type family   T :: k\n    type instance T = (Nothing :: Maybe a)\n\nUpon a cursory glance, it may appear that the kind variable `a` is\nfree-floating above, since there are no (visible) LHS patterns in\n`T`. However, there is an *invisible* pattern due to the return kind,\nso inside of GHC, the instance looks closer to this:\n\n    type family T @k :: k\n    type instance T @(Maybe a) = (Nothing :: Maybe a)\n\nHere, we can see that `a` really is bound by a LHS type pattern, so `a` is in\nfact not unbound. Contrast that with this example (Trac #13985)\n\n    type instance T = Proxy (Nothing :: Maybe a)\n\nThis would looks like this inside of GHC:\n\n    type instance T @(*) = Proxy (Nothing :: Maybe a)\n\nSo this time, `a` is neither bound by a visible nor invisible type pattern on\nthe LHS, so it would be reported as free-floating.\n\nFinally, here's one more brain-teaser (from #9574). In the example below:\n\n    class Funct f where\n      type Codomain f :: *\n    instance Funct ('KProxy :: KProxy o) where\n      type Codomain 'KProxy = NatTr (Proxy :: o -> *)\n\nAs it turns out, `o` is not free-floating in this example. That is because `o`\nbound by the kind signature of the LHS type pattern 'KProxy. To make this more\nobvious, one can also write the instance like so:\n\n    instance Funct ('KProxy :: KProxy o) where\n      type Codomain ('KProxy :: KProxy o) = NatTr (Proxy :: o -> *)\n\n\nNote [Matching in the consistent-instantation check]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMatching the class-instance header to family-instance tyvars is\ntricker than it sounds.  Consider (Trac #13972)\n    class C (a :: k) where\n      type T k :: Type\n    instance C Left where\n      type T (a -> Either a b) = Int\n\nHere there are no lexically-scoped variables from (C Left).\nYet the real class-instance header is   C @(p -> Either @p @q)) (Left @p @q)\nwhile the type-family instance is       T (a -> Either @a @b)\nSo we allow alpha-renaming of variables that don't come\nfrom the class-instance header.\n\nWe track the lexically-scoped type variables from the\nclass-instance header in ai_tyvars.\n\nHere's another example (Trac #14045a)\n    class C (a :: k) where\n      data S (a :: k)\n    instance C (z :: Bool) where\n      data S :: Bool -> Type where\n\nAgain, there is no lexical connection, but we will get\n   class-instance header:   C @Bool (z::Bool)\n   family instance          S @Bool (a::Bool)\n\nWhen looking for mis-matches, we check left-to-right,\nkinds first.  If we look at types first, we'll fail to\nsuggest -fprint-explicit-kinds for a mis-match with\n      T @k    vs    T @Type\nsomewhere deep inside the type\n\nNote [Checking consistent instantiation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee Trac #11450 for background discussion on this check.\n\n  class C a b where\n    type T a x b\n\nWith this class decl, if we have an instance decl\n  instance C ty1 ty2 where ...\nthen the type instance must look like\n     type T ty1 v ty2 = ...\nwith exactly 'ty1' for 'a', 'ty2' for 'b', and some type 'v' for 'x'.\nFor example:\n\n  instance C [p] Int\n    type T [p] y Int = (p,y,y)\n\nNote that\n\n* We used to allow completely different bound variables in the\n  associated type instance; e.g.\n    instance C [p] Int\n      type T [q] y Int = ...\n  But from GHC 8.2 onwards, we don't.  It's much simpler this way.\n  See Trac #11450.\n\n* When the class variable isn't used on the RHS of the type instance,\n  it's tempting to allow wildcards, thus\n    instance C [p] Int\n      type T [_] y Int = (y,y)\n  But it's awkward to do the test, and it doesn't work if the\n  variable is repeated:\n    instance C (p,p) Int\n      type T (_,_) y Int = (y,y)\n  Even though 'p' is not used on the RHS, we still need to use 'p'\n  on the LHS to establish the repeated pattern.  So to keep it simple\n  we just require equality.\n\n* For variables in associated type families that are not bound by the class\n  itself, we do _not_ check if they are over-specific. In other words,\n  it's perfectly acceptable to have an instance like this:\n\n    instance C [p] Int where\n      type T [p] (Maybe x) Int = x\n\n  While the first and third arguments to T are required to be exactly [p] and\n  Int, respectively, since they are bound by C, the second argument is allowed\n  to be more specific than just a type variable. Furthermore, it is permissible\n  to define multiple equations for T that differ only in the non-class-bound\n  argument:\n\n    instance C [p] Int where\n      type T [p] (Maybe x)    Int = x\n      type T [p] (Either x y) Int = x -> y\n\n  We once considered requiring that non-class-bound variables in associated\n  type family instances be instantiated with distinct type variables. However,\n  that requirement proved too restrictive in practice, as there were examples\n  of extremely simple associated type family instances that this check would\n  reject, and fixing them required tiresome boilerplate in the form of\n  auxiliary type families. For instance, you would have to define the above\n  example as:\n\n    instance C [p] Int where\n      type T [p] x Int = CAux x\n\n    type family CAux x where\n      CAux (Maybe x)    = x\n      CAux (Either x y) = x -> y\n\n  We decided that this restriction wasn't buying us much, so we opted not\n  to pursue that design (see also GHC Trac #13398).\n\nImplementation\n  * Form the mini-envt from the class type variables a,b\n    to the instance decl types [p],Int:   [a->[p], b->Int]\n\n  * Look at the tyvars a,x,b of the type family constructor T\n    (it shares tyvars with the class C)\n\n  * Apply the mini-evnt to them, and check that the result is\n    consistent with the instance types [p] y Int. (where y can be any type, as\n    it is not scoped over the class type variables.\n\nWe make all the instance type variables scope over the\ntype instances, of course, which picks up non-obvious kinds.  Eg\n   class Foo (a :: k) where\n      type F a\n   instance Foo (b :: k -> k) where\n      type F b = Int\nHere the instance is kind-indexed and really looks like\n      type F (k->k) (b::k->k) = Int\nBut if the 'b' didn't scope, we would make F's instance too\npoly-kinded.\n\nNote [Printing conflicts with class header]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's remarkably painful to give a decent error message for conflicts\nwith the class header.  Consider\n   clase C b where\n     type F a b c\n   instance C [b] where\n     type F x Int _ _ = ...\n\nHere we want to report a conflict between\n    Expected: F _ [b] _\n    Actual:   F x Int _ _\n\nBut if the type instance shadows the class variable like this\n(rename/should_fail/T15828):\n   instance C [b] where\n     type forall b. F x (Tree b) _ _ = ...\n\nthen we must use a fresh variable name\n    Expected: F _ [b] _\n    Actual:   F x [b1] _ _\n\nNotice that:\n  - We want to print an underscore in the \"Expected\" type in\n    positions where the class header has no influence over the\n    parameter.  Hence the fancy footwork in pp_expected_ty\n\n  - Although the binders in the axiom are aready tidy, we must\n    re-tidy them to get a fresh variable name when we shadow\n\n  - The (ax_tvs \\\\ inst_tvs) is to avoid tidying one of the\n    class-instance variables a second time, from 'a' to 'a1' say.\n    Remember, the ax_tvs of the axiom share identity with the\n    class-instance variables, inst_tvs..\n\n  - We use tidyCoAxBndrsForUser to get underscores rather than\n    _1, _2, etc in the axiom tyvars; see the definition of\n    tidyCoAxBndrsForUser\n\nThis all seems absurdly complicated.\n\nNote [Unused explicitly bound variables in a family pattern]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhy is 'unusedExplicitForAllErr' not just a warning?\n\nConsider the following examples:\n\n  type instance F a = Maybe b\n  type instance forall b. F a = Bool\n  type instance forall b. F a = Maybe b\n\nIn every case, b is a type variable not determined by the LHS pattern. The\nfirst is caught by the renamer, but we catch the last two here. Perhaps one\ncould argue that the second should be accepted, albeit with a warning, but\nconsider the fact that in a type family instance, there is no way to interact\nwith such a varable. At least with @x :: forall a. Int@ we can use visibile\ntype application, like @x \\@Bool 1@. (Of course it does nothing, but it is\npermissible.) In the type family case, the only sensible explanation is that\nthe user has made a mistake -- thus we throw an error.\n\nNote [Oversaturated type family equations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nType family tycons have very rigid arities. We want to reject something like\nthis:\n\n  type family Foo :: Type -> Type where\n    Foo x = ...\n\nBecause Foo has arity zero (i.e., it doesn't bind anything to the left of the\ndouble colon), we want to disallow any equation for Foo that has more than zero\narguments, such as `Foo x = ...`. The algorithm here is pretty simple: if an\nequation has more arguments than the arity of the type family, reject.\n\nThings get trickier when visible kind application enters the picture. Consider\nthe following example:\n\n  type family Bar (x :: j) :: forall k. Either j k where\n    Bar 5 @Symbol = ...\n\nThe arity of Bar is two, since it binds two variables, `j` and `x`. But even\nthough Bar's equation has two arguments, it's still invalid. Imagine the same\nequation in Core:\n\n    Bar Nat 5 Symbol = ...\n\nHere, it becomes apparent that Bar is actually taking /three/ arguments! So\nwe can't just rely on a simple counting argument to reject\n`Bar 5 @Symbol = ...`, since it only has two user-written arguments.\nMoreover, there's one explicit argument (5) and one visible kind argument\n(@Symbol), which matches up perfectly with the fact that Bar has one required\nbinder (x) and one specified binder (j), so that's not a valid way to detect\noversaturation either.\n\nTo solve this problem in a robust way, we do the following:\n\n1. When kind-checking, we count the number of user-written *required*\n   arguments and check if there is an equal number of required tycon binders.\n   If not, reject. (See `wrongNumberOfParmsErr` in TcTyClsDecls.)\n\n   We perform this step during kind-checking, not during validity checking,\n   since we can give better error messages if we catch it early.\n2. When validity checking, take all of the (Core) type patterns from on\n   equation, drop the first n of them (where n is the arity of the type family\n   tycon), and check if there are any types leftover. If so, reject.\n\n   Why does this work? We know that after dropping the first n type patterns,\n   none of the leftover types can be required arguments, since step (1) would\n   have already caught that. Moreover, the only places where visible kind\n   applications should be allowed are in the first n types, since those are the\n   only arguments that can correspond to binding forms. Therefore, the\n   remaining arguments must correspond to oversaturated uses of visible kind\n   applications, which are precisely what we want to reject.\n\nNote that we only perform this check for type families, and not for data\nfamilies. This is because it is perfectly acceptable to oversaturate data\nfamily instance equations: see Note [Arity of data families] in FamInstEnv.\n\n************************************************************************\n*                                                                      *\n   Telescope checking\n*                                                                      *\n************************************************************************\n\nNote [Bad TyCon telescopes]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNow that we can mix type and kind variables, there are an awful lot of\nways to shoot yourself in the foot. Here are some.\n\n  data SameKind :: k -> k -> *   -- just to force unification\n\n1.  data T1 a k (b :: k) (x :: SameKind a b)\n\nThe problem here is that we discover that a and b should have the same\nkind. But this kind mentions k, which is bound *after* a.\n(Testcase: dependent/should_fail/BadTelescope)\n\n2.  data T2 a (c :: Proxy b) (d :: Proxy a) (x :: SameKind b d)\n\nNote that b is not bound. Yet its kind mentions a. Because we have\na nice rule that all implicitly bound variables come before others,\nthis is bogus.\n\nTo catch these errors, we call checkTyConTelescope during kind-checking\ndatatype declarations.  This checks for\n\n* Ill-scoped binders. From (1) and (2) above we can get putative\n  kinds like\n       T1 :: forall (a:k) (k:*) (b:k). SameKind a b -> *\n  where 'k' is mentioned a's kind before k is bound\n\n  This is easy to check for: just look for\n  out-of-scope variables in the kind\n\n* We should arguably also check for ambiguous binders\n  but we don't.  See Note [Ambiguous kind vars].\n\nSee also\n  * Note [Required, Specified, and Inferred for types] in TcTyClsDecls.\n  * Note [Keeping scoped variables in order: Explicit] discusses how\n    this check works for `forall x y z.` written in a type.\n\nNote [Ambiguous kind vars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe used to be concerned about ambiguous binders. Suppose we have the kind\n     S1 :: forall k -> * -> *\n     S2 :: forall k. * -> *\nHere S1 is OK, because k is Required, and at a use of S1 we will\nsee (S1 *) or (S1 (*->*)) or whatever.\n\nBut S2 is /not/ OK because 'k' is Specfied (and hence invisible) and\nwe have no way (ever) to figure out how 'k' should be instantiated.\nFor example if we see (S2 Int), that tells us nothing about k's\ninstantiation.  (In this case we'll instantiate it to Any, but that\nseems wrong.)  This is really the same test as we make for ambiguous\ntype in term type signatures.\n\nNow, it's impossible for a Specified variable not to occur\nat all in the kind -- after all, it is Specified so it must have\noccurred.  (It /used/ to be possible; see tests T13983 and T7873.  But\nwith the advent of the forall-or-nothing rule for kind variables,\nthose strange cases went away.)\n\nBut one might worry about\n    type v k = *\n    S3 :: forall k. V k -> *\nwhich appears to mention 'k' but doesn't really.  Or\n    S4 :: forall k. F k -> *\nwhere F is a type function.  But we simply don't check for\nthose cases of ambiguity, yet anyway.  The worst that can happen\nis ambiguity at the call sites.\n\nHistorical note: this test used to be called reportFloatingKvs.\n-}\n\n-- | Check a list of binders to see if they make a valid telescope.\n-- See Note [Bad TyCon telescopes]\ntype TelescopeAcc\n      = ( TyVarSet   -- Bound earlier in the telescope\n        , Bool       -- At least one binder occurred (in a kind) before\n                     -- it was bound in the telescope.  E.g.\n        )            --    T :: forall (a::k) k. blah\n\ncheckTyConTelescope :: TyCon -> TcM ()\ncheckTyConTelescope tc\n  | bad_scope\n  = -- See \"Ill-scoped binders\" in Note [Bad TyCon telescopes]\n    addErr $\n    vcat [ hang (text \"The kind of\" <+> quotes (ppr tc) <+> text \"is ill-scoped\")\n              2 pp_tc_kind\n         , extra\n         , hang (text \"Perhaps try this order instead:\")\n              2 (pprTyVars sorted_tvs) ]\n\n  | otherwise\n  = return ()\n  where\n    tcbs = tyConBinders tc\n    tvs  = binderVars tcbs\n    sorted_tvs = scopedSort tvs\n\n    (_, bad_scope) = foldl add_one (emptyVarSet, False) tcbs\n\n    add_one :: TelescopeAcc -> TyConBinder -> TelescopeAcc\n    add_one (bound, bad_scope) tcb\n      = ( bound `extendVarSet` tv\n        , bad_scope || not (isEmptyVarSet (fkvs `minusVarSet` bound)) )\n      where\n        tv = binderVar tcb\n        fkvs = tyCoVarsOfType (tyVarKind tv)\n\n    inferred_tvs  = [ binderVar tcb\n                    | tcb <- tcbs, Inferred == tyConBinderArgFlag tcb ]\n    specified_tvs = [ binderVar tcb\n                    | tcb <- tcbs, Specified == tyConBinderArgFlag tcb ]\n\n    pp_inf  = parens (text \"namely:\" <+> pprTyVars inferred_tvs)\n    pp_spec = parens (text \"namely:\" <+> pprTyVars specified_tvs)\n\n    pp_tc_kind = text \"Inferred kind:\" <+> ppr tc <+> dcolon <+> ppr_untidy (tyConKind tc)\n    ppr_untidy ty = pprIfaceType (toIfaceType ty)\n      -- We need ppr_untidy here because pprType will tidy the type, which\n      -- will turn the bogus kind we are trying to report\n      --     T :: forall (a::k) k (b::k) -> blah\n      -- into a misleadingly sanitised version\n      --     T :: forall (a::k) k1 (b::k1) -> blah\n\n    extra\n      | null inferred_tvs && null specified_tvs\n      = empty\n      | null inferred_tvs\n      = hang (text \"NB: Specified variables\")\n           2 (sep [pp_spec, text \"always come first\"])\n      | null specified_tvs\n      = hang (text \"NB: Inferred variables\")\n           2 (sep [pp_inf, text \"always come first\"])\n      | otherwise\n      = hang (text \"NB: Inferred variables\")\n           2 (vcat [ sep [ pp_inf, text \"always come first\"]\n                   , sep [text \"then Specified variables\", pp_spec]])\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Auxiliary functions}\n*                                                                      *\n************************************************************************\n-}\n\n-- Free variables of a type, retaining repetitions, and expanding synonyms\n-- This ignores coercions, as coercions aren't user-written\nfvType :: Type -> [TyCoVar]\nfvType ty | Just exp_ty <- tcView ty = fvType exp_ty\nfvType (TyVarTy tv)          = [tv]\nfvType (TyConApp _ tys)      = fvTypes tys\nfvType (LitTy {})            = []\nfvType (AppTy fun arg)       = fvType fun ++ fvType arg\nfvType (FunTy _ arg res)     = fvType arg ++ fvType res\nfvType (ForAllTy (Bndr tv _) ty)\n  = fvType (tyVarKind tv) ++\n    filter (/= tv) (fvType ty)\nfvType (CastTy ty _)         = fvType ty\nfvType (CoercionTy {})       = []\n\nfvTypes :: [Type] -> [TyVar]\nfvTypes tys                = concat (map fvType tys)\n\nsizeType :: Type -> Int\n-- Size of a type: the number of variables and constructors\nsizeType ty | Just exp_ty <- tcView ty = sizeType exp_ty\nsizeType (TyVarTy {})      = 1\nsizeType (TyConApp tc tys) = 1 + sizeTyConAppArgs tc tys\nsizeType (LitTy {})        = 1\nsizeType (AppTy fun arg)   = sizeType fun + sizeType arg\nsizeType (FunTy _ arg res) = sizeType arg + sizeType res + 1\nsizeType (ForAllTy _ ty)   = sizeType ty\nsizeType (CastTy ty _)     = sizeType ty\nsizeType (CoercionTy _)    = 0\n\nsizeTypes :: [Type] -> Int\nsizeTypes = foldr ((+) . sizeType) 0\n\nsizeTyConAppArgs :: TyCon -> [Type] -> Int\nsizeTyConAppArgs _tc tys = sizeTypes tys -- (filterOutInvisibleTypes tc tys)\n                           -- See Note [Invisible arguments and termination]\n\n-- Size of a predicate\n--\n-- We are considering whether class constraints terminate.\n-- Equality constraints and constraints for the implicit\n-- parameter class always terminate so it is safe to say \"size 0\".\n-- See Trac #4200.\nsizePred :: PredType -> Int\nsizePred ty = goClass ty\n  where\n    goClass p = go (classifyPredType p)\n\n    go (ClassPred cls tys')\n      | isTerminatingClass cls = 0\n      | otherwise = sizeTypes (filterOutInvisibleTypes (classTyCon cls) tys')\n                    -- The filtering looks bogus\n                    -- See Note [Invisible arguments and termination]\n    go (EqPred {})           = 0\n    go (IrredPred ty)        = sizeType ty\n    go (ForAllPred _ _ pred) = goClass pred\n\n-- | When this says \"True\", ignore this class constraint during\n-- a termination check\nisTerminatingClass :: Class -> Bool\nisTerminatingClass cls\n  = isIPClass cls    -- Implicit parameter constraints always terminate because\n                     -- there are no instances for them --- they are only solved\n                     -- by \"local instances\" in expressions\n    || isEqPredClass cls\n    || cls `hasKey` typeableClassKey\n    || cls `hasKey` coercibleTyConKey\n\n-- | Tidy before printing a type\nppr_tidy :: TidyEnv -> Type -> SDoc\nppr_tidy env ty = pprType (tidyType env ty)\n\nallDistinctTyVars :: TyVarSet -> [KindOrType] -> Bool\n-- (allDistinctTyVars tvs tys) returns True if tys are\n-- a) all tyvars\n-- b) all distinct\n-- c) disjoint from tvs\nallDistinctTyVars _    [] = True\nallDistinctTyVars tkvs (ty : tys)\n  = case getTyVar_maybe ty of\n      Nothing -> False\n      Just tv | tv `elemVarSet` tkvs -> False\n              | otherwise -> allDistinctTyVars (tkvs `extendVarSet` tv) tys\n", "num_lines": 2846}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n--\n-- The @Class@ datatype\n\n{-# LANGUAGE CPP #-}\n\nmodule Class (\n        Class,\n        ClassOpItem,\n        ClassATItem(..),\n        ClassMinimalDef,\n        DefMethInfo, pprDefMethInfo,\n\n        FunDep, pprFundeps, pprFunDep,\n\n        mkClass, mkAbstractClass, classTyVars, classArity,\n        classKey, className, classATs, classATItems, classTyCon, classMethods,\n        classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta,\n        classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds,\n        isAbstractClass,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TyCon     ( TyCon )\nimport {-# SOURCE #-} TyCoRep   ( Type, PredType, pprType )\nimport Var\nimport Name\nimport BasicTypes\nimport Unique\nimport Util\nimport SrcLoc\nimport Outputable\nimport BooleanFormula (BooleanFormula, mkTrue)\n\nimport qualified Data.Data as Data\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Class-basic]{@Class@: basic definition}\n*                                                                      *\n************************************************************************\n\nA @Class@ corresponds to a Greek kappa in the static semantics:\n-}\n\ndata Class\n  = Class {\n        classTyCon :: TyCon,    -- The data type constructor for\n                                -- dictionaries of this class\n                                -- See Note [ATyCon for classes] in TyCoRep\n\n        className :: Name,              -- Just the cached name of the TyCon\n        classKey  :: Unique,            -- Cached unique of TyCon\n\n        classTyVars  :: [TyVar],        -- The class kind and type variables;\n                                        -- identical to those of the TyCon\n           -- If you want visibility info, look at the classTyCon\n           -- This field is redundant because it's duplicated in the\n           -- classTyCon, but classTyVars is used quite often, so maybe\n           -- it's a bit faster to cache it here\n\n        classFunDeps :: [FunDep TyVar],  -- The functional dependencies\n\n        classBody :: ClassBody -- Superclasses, ATs, methods\n\n     }\n\n--  | e.g.\n--\n-- >  class C a b c | a b -> c, a c -> b where...\n--\n--  Here fun-deps are [([a,b],[c]), ([a,c],[b])]\n--\n--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'',\n\n-- For details on above see note [Api annotations] in ApiAnnotation\ntype FunDep a = ([a],[a])\n\ntype ClassOpItem = (Id, DefMethInfo)\n        -- Selector function; contains unfolding\n        -- Default-method info\n\ntype DefMethInfo = Maybe (Name, DefMethSpec Type)\n   -- Nothing                    No default method\n   -- Just ($dm, VanillaDM)      A polymorphic default method, name $dm\n   -- Just ($gm, GenericDM ty)   A generic default method, name $gm, type ty\n   --                              The generic dm type is *not* quantified\n   --                              over the class variables; ie has the\n   --                              class variables free\n\ndata ClassATItem\n  = ATI TyCon         -- See Note [Associated type tyvar names]\n        (Maybe (Type, SrcSpan))\n                      -- Default associated type (if any) from this template\n                      -- Note [Associated type defaults]\n\ntype ClassMinimalDef = BooleanFormula Name -- Required methods\n\ndata ClassBody\n  = AbstractClass\n  | ConcreteClass {\n        -- Superclasses: eg: (F a ~ b, F b ~ G a, Eq a, Show b)\n        -- We need value-level selectors for both the dictionary\n        -- superclasses and the equality superclasses\n        cls_sc_theta :: [PredType],     -- Immediate superclasses,\n        cls_sc_sel_ids :: [Id],          -- Selector functions to extract the\n                                        --   superclasses from a\n                                        --   dictionary of this class\n        -- Associated types\n        cls_ats :: [ClassATItem],  -- Associated type families\n\n        -- Class operations (methods, not superclasses)\n        cls_ops :: [ClassOpItem],  -- Ordered by tag\n\n        -- Minimal complete definition\n        cls_min_def :: ClassMinimalDef\n    }\n    -- TODO: maybe super classes should be allowed in abstract class definitions\n\nclassMinimalDef :: Class -> ClassMinimalDef\nclassMinimalDef Class{ classBody = ConcreteClass{ cls_min_def = d } } = d\nclassMinimalDef _ = mkTrue -- TODO: make sure this is the right direction\n\n{-\nNote [Associated type defaults]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe following is an example of associated type defaults:\n   class C a where\n     data D a r\n\n     type F x a b :: *\n     type F p q r = (p,q)->r    -- Default\n\nNote that\n\n * The TyCons for the associated types *share type variables* with the\n   class, so that we can tell which argument positions should be\n   instantiated in an instance decl.  (The first for 'D', the second\n   for 'F'.)\n\n * We can have default definitions only for *type* families,\n   not data families\n\n * In the default decl, the \"patterns\" should all be type variables,\n   but (in the source language) they don't need to be the same as in\n   the 'type' decl signature or the class.  It's more like a\n   free-standing 'type instance' declaration.\n\n * HOWEVER, in the internal ClassATItem we rename the RHS to match the\n   tyConTyVars of the family TyCon.  So in the example above we'd get\n   a ClassATItem of\n        ATI F ((x,a) -> b)\n   So the tyConTyVars of the family TyCon bind the free vars of\n   the default Type rhs\n\nThe @mkClass@ function fills in the indirect superclasses.\n\nThe SrcSpan is for the entire original declaration.\n-}\n\nmkClass :: Name -> [TyVar]\n        -> [FunDep TyVar]\n        -> [PredType] -> [Id]\n        -> [ClassATItem]\n        -> [ClassOpItem]\n        -> ClassMinimalDef\n        -> TyCon\n        -> Class\n\nmkClass cls_name tyvars fds super_classes superdict_sels at_stuff\n        op_stuff mindef tycon\n  = Class { classKey     = nameUnique cls_name,\n            className    = cls_name,\n                -- NB:  tyConName tycon = cls_name,\n                -- But it takes a module loop to assert it here\n            classTyVars  = tyvars,\n            classFunDeps = fds,\n            classBody = ConcreteClass {\n                    cls_sc_theta = super_classes,\n                    cls_sc_sel_ids = superdict_sels,\n                    cls_ats  = at_stuff,\n                    cls_ops  = op_stuff,\n                    cls_min_def = mindef\n                },\n            classTyCon   = tycon }\n\nmkAbstractClass :: Name -> [TyVar]\n        -> [FunDep TyVar]\n        -> TyCon\n        -> Class\n\nmkAbstractClass cls_name tyvars fds tycon\n  = Class { classKey     = nameUnique cls_name,\n            className    = cls_name,\n                -- NB:  tyConName tycon = cls_name,\n                -- But it takes a module loop to assert it here\n            classTyVars  = tyvars,\n            classFunDeps = fds,\n            classBody = AbstractClass,\n            classTyCon   = tycon }\n\n{-\nNote [Associated type tyvar names]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe TyCon of an associated type should use the same variable names as its\nparent class. Thus\n    class C a b where\n      type F b x a :: *\nWe make F use the same Name for 'a' as C does, and similary 'b'.\n\nThe reason for this is when checking instances it's easier to match\nthem up, to ensure they match.  Eg\n    instance C Int [d] where\n      type F [d] x Int = ....\nwe should make sure that the first and third args match the instance\nheader.\n\nHaving the same variables for class and tycon is also used in checkValidRoles\n(in TcTyClsDecls) when checking a class's roles.\n\n\n************************************************************************\n*                                                                      *\n\\subsection[Class-selectors]{@Class@: simple selectors}\n*                                                                      *\n************************************************************************\n\nThe rest of these functions are just simple selectors.\n-}\n\nclassArity :: Class -> Arity\nclassArity clas = length (classTyVars clas)\n        -- Could memoise this\n\nclassAllSelIds :: Class -> [Id]\n-- Both superclass-dictionary and method selectors\nclassAllSelIds c@(Class { classBody = ConcreteClass { cls_sc_sel_ids = sc_sels }})\n  = sc_sels ++ classMethods c\nclassAllSelIds c = ASSERT( null (classMethods c) ) []\n\nclassSCSelIds :: Class -> [Id]\n-- Both superclass-dictionary and method selectors\nclassSCSelIds (Class { classBody = ConcreteClass { cls_sc_sel_ids = sc_sels }})\n  = sc_sels\nclassSCSelIds c = ASSERT( null (classMethods c) ) []\n\nclassSCSelId :: Class -> Int -> Id\n-- Get the n'th superclass selector Id\n-- where n is 0-indexed, and counts\n--    *all* superclasses including equalities\nclassSCSelId (Class { classBody = ConcreteClass { cls_sc_sel_ids = sc_sels } }) n\n  = ASSERT( n >= 0 && lengthExceeds sc_sels n )\n    sc_sels !! n\nclassSCSelId c n = pprPanic \"classSCSelId\" (ppr c <+> ppr n)\n\nclassMethods :: Class -> [Id]\nclassMethods (Class { classBody = ConcreteClass { cls_ops = op_stuff } })\n  = [op_sel | (op_sel, _) <- op_stuff]\nclassMethods _ = []\n\nclassOpItems :: Class -> [ClassOpItem]\nclassOpItems (Class { classBody = ConcreteClass { cls_ops = op_stuff }})\n  = op_stuff\nclassOpItems _ = []\n\nclassATs :: Class -> [TyCon]\nclassATs (Class { classBody = ConcreteClass { cls_ats = at_stuff } })\n  = [tc | ATI tc _ <- at_stuff]\nclassATs _ = []\n\nclassATItems :: Class -> [ClassATItem]\nclassATItems (Class { classBody = ConcreteClass { cls_ats = at_stuff }})\n  = at_stuff\nclassATItems _ = []\n\nclassSCTheta :: Class -> [PredType]\nclassSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }})\n  = theta_stuff\nclassSCTheta _ = []\n\nclassTvsFds :: Class -> ([TyVar], [FunDep TyVar])\nclassTvsFds c = (classTyVars c, classFunDeps c)\n\nclassHasFds :: Class -> Bool\nclassHasFds (Class { classFunDeps = fds }) = not (null fds)\n\nclassBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem])\nclassBigSig (Class {classTyVars = tyvars,\n                    classBody = AbstractClass})\n  = (tyvars, [], [], [])\nclassBigSig (Class {classTyVars = tyvars,\n                    classBody = ConcreteClass {\n                        cls_sc_theta = sc_theta,\n                        cls_sc_sel_ids = sc_sels,\n                        cls_ops  = op_stuff\n                    }})\n  = (tyvars, sc_theta, sc_sels, op_stuff)\n\nclassExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [ClassATItem], [ClassOpItem])\nclassExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,\n                         classBody = AbstractClass})\n  = (tyvars, fundeps, [], [], [], [])\nclassExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,\n                         classBody = ConcreteClass {\n                             cls_sc_theta = sc_theta, cls_sc_sel_ids = sc_sels,\n                             cls_ats = ats, cls_ops = op_stuff\n                         }})\n  = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)\n\nisAbstractClass :: Class -> Bool\nisAbstractClass Class{ classBody = AbstractClass } = True\nisAbstractClass _ = False\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Class-instances]{Instance declarations for @Class@}\n*                                                                      *\n************************************************************************\n\nWe compare @Classes@ by their keys (which include @Uniques@).\n-}\n\ninstance Eq Class where\n    c1 == c2 = classKey c1 == classKey c2\n    c1 /= c2 = classKey c1 /= classKey c2\n\ninstance Uniquable Class where\n    getUnique c = classKey c\n\ninstance NamedThing Class where\n    getName clas = className clas\n\ninstance Outputable Class where\n    ppr c = ppr (getName c)\n\npprDefMethInfo :: DefMethInfo -> SDoc\npprDefMethInfo Nothing                  = empty   -- No default method\npprDefMethInfo (Just (n, VanillaDM))    = text \"Default method\" <+> ppr n\npprDefMethInfo (Just (n, GenericDM ty)) = text \"Generic default method\"\n                                          <+> ppr n <+> dcolon <+> pprType ty\n\npprFundeps :: Outputable a => [FunDep a] -> SDoc\npprFundeps []  = empty\npprFundeps fds = hsep (vbar : punctuate comma (map pprFunDep fds))\n\npprFunDep :: Outputable a => FunDep a -> SDoc\npprFunDep (us, vs) = hsep [interppSP us, arrow, interppSP vs]\n\ninstance Data.Data Class where\n    -- don't traverse?\n    toConstr _   = abstractConstr \"Class\"\n    gunfold _ _  = error \"gunfold\"\n    dataTypeOf _ = mkNoRepType \"Class\"\n", "num_lines": 360}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2012\n\n{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, GADTs, KindSignatures,\n             ScopedTypeVariables, StandaloneDeriving, RoleAnnotations #-}\n\n-- | Module for coercion axioms, used to represent type family instances\n-- and newtypes\n\nmodule CoAxiom (\n       BranchFlag, Branched, Unbranched, BranchIndex, Branches(..),\n       manyBranches, unbranched,\n       fromBranches, numBranches,\n       mapAccumBranches,\n\n       CoAxiom(..), CoAxBranch(..),\n\n       toBranchedAxiom, toUnbranchedAxiom,\n       coAxiomName, coAxiomArity, coAxiomBranches,\n       coAxiomTyCon, isImplicitCoAxiom, coAxiomNumPats,\n       coAxiomNthBranch, coAxiomSingleBranch_maybe, coAxiomRole,\n       coAxiomSingleBranch, coAxBranchTyVars, coAxBranchCoVars,\n       coAxBranchRoles,\n       coAxBranchLHS, coAxBranchRHS, coAxBranchSpan, coAxBranchIncomps,\n       placeHolderIncomps,\n\n       Role(..), fsFromRole,\n\n       CoAxiomRule(..), TypeEqn,\n       BuiltInSynFamily(..), trivialBuiltInFamily\n       ) where\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TyCoRep ( Type, pprType )\nimport {-# SOURCE #-} TyCon ( TyCon )\nimport Outputable\nimport FastString\nimport Name\nimport Unique\nimport Var\nimport Util\nimport Binary\nimport Pair\nimport BasicTypes\nimport Data.Typeable ( Typeable )\nimport SrcLoc\nimport qualified Data.Data as Data\nimport Data.Array\nimport Data.List ( mapAccumL )\n\n#include \"HsVersions.h\"\n\n{-\nNote [Coercion axiom branches]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn order to allow closed type families, an axiom needs to contain an\nordered list of alternatives, called branches. The kind of the coercion built\nfrom an axiom is determined by which index is used when building the coercion\nfrom the axiom.\n\nFor example, consider the axiom derived from the following declaration:\n\ntype family F a where\n  F [Int] = Bool\n  F [a]   = Double\n  F (a b) = Char\n\nThis will give rise to this axiom:\n\naxF :: {                                         F [Int] ~ Bool\n       ; forall (a :: *).                        F [a]   ~ Double\n       ; forall (k :: *) (a :: k -> *) (b :: k). F (a b) ~ Char\n       }\n\nThe axiom is used with the AxiomInstCo constructor of Coercion. If we wish\nto have a coercion showing that F (Maybe Int) ~ Char, it will look like\n\naxF[2] <*> <Maybe> <Int> :: F (Maybe Int) ~ Char\n-- or, written using concrete-ish syntax --\nAxiomInstCo axF 2 [Refl *, Refl Maybe, Refl Int]\n\nNote that the index is 0-based.\n\nFor type-checking, it is also necessary to check that no previous pattern\ncan unify with the supplied arguments. After all, it is possible that some\nof the type arguments are lambda-bound type variables whose instantiation may\ncause an earlier match among the branches. We wish to prohibit this behavior,\nso the type checker rules out the choice of a branch where a previous branch\ncan unify. See also [Apartness] in FamInstEnv.hs.\n\nFor example, the following is malformed, where 'a' is a lambda-bound type\nvariable:\n\naxF[2] <*> <a> <Bool> :: F (a Bool) ~ Char\n\nWhy? Because a might be instantiated with [], meaning that branch 1 should\napply, not branch 2. This is a vital consistency check; without it, we could\nderive Int ~ Bool, and that is a Bad Thing.\n\nNote [Branched axioms]\n~~~~~~~~~~~~~~~~~~~~~~\nAlthough a CoAxiom has the capacity to store many branches, in certain cases,\nwe want only one. These cases are in data/newtype family instances, newtype\ncoercions, and type family instances.\nFurthermore, these unbranched axioms are used in a\nvariety of places throughout GHC, and it would difficult to generalize all of\nthat code to deal with branched axioms, especially when the code can be sure\nof the fact that an axiom is indeed a singleton. At the same time, it seems\ndangerous to assume singlehood in various places through GHC.\n\nThe solution to this is to label a CoAxiom with a phantom type variable\ndeclaring whether it is known to be a singleton or not. The branches\nare stored using a special datatype, declared below, that ensures that the\ntype variable is accurate.\n\n************************************************************************\n*                                                                      *\n                    Branches\n*                                                                      *\n************************************************************************\n-}\n\ntype BranchIndex = Int  -- The index of the branch in the list of branches\n                        -- Counting from zero\n\n-- promoted data type\ndata BranchFlag = Branched | Unbranched\ntype Branched = 'Branched\ntype Unbranched = 'Unbranched\n-- By using type synonyms for the promoted constructors, we avoid needing\n-- DataKinds and the promotion quote in client modules. This also means that\n-- we don't need to export the term-level constructors, which should never be used.\n\nnewtype Branches (br :: BranchFlag)\n  = MkBranches { unMkBranches :: Array BranchIndex CoAxBranch }\ntype role Branches nominal\n\nmanyBranches :: [CoAxBranch] -> Branches Branched\nmanyBranches brs = ASSERT( snd bnds >= fst bnds )\n                   MkBranches (listArray bnds brs)\n  where\n    bnds = (0, length brs - 1)\n\nunbranched :: CoAxBranch -> Branches Unbranched\nunbranched br = MkBranches (listArray (0, 0) [br])\n\ntoBranched :: Branches br -> Branches Branched\ntoBranched = MkBranches . unMkBranches\n\ntoUnbranched :: Branches br -> Branches Unbranched\ntoUnbranched (MkBranches arr) = ASSERT( bounds arr == (0,0) )\n                                MkBranches arr\n\nfromBranches :: Branches br -> [CoAxBranch]\nfromBranches = elems . unMkBranches\n\nbranchesNth :: Branches br -> BranchIndex -> CoAxBranch\nbranchesNth (MkBranches arr) n = arr ! n\n\nnumBranches :: Branches br -> Int\nnumBranches (MkBranches arr) = snd (bounds arr) + 1\n\n-- | The @[CoAxBranch]@ passed into the mapping function is a list of\n-- all previous branches, reversed\nmapAccumBranches :: ([CoAxBranch] -> CoAxBranch -> CoAxBranch)\n                  -> Branches br -> Branches br\nmapAccumBranches f (MkBranches arr)\n  = MkBranches (listArray (bounds arr) (snd $ mapAccumL go [] (elems arr)))\n  where\n    go :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch)\n    go prev_branches cur_branch = ( cur_branch : prev_branches\n                                  , f prev_branches cur_branch )\n\n\n{-\n************************************************************************\n*                                                                      *\n                    Coercion axioms\n*                                                                      *\n************************************************************************\n\nNote [Storing compatibility]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDuring axiom application, we need to be aware of which branches are compatible\nwith which others. The full explanation is in Note [Compatibility] in\nFamInstEnv. (The code is placed there to avoid a dependency from CoAxiom on\nthe unification algorithm.) Although we could theoretically compute\ncompatibility on the fly, this is silly, so we store it in a CoAxiom.\n\nSpecifically, each branch refers to all other branches with which it is\nincompatible. This list might well be empty, and it will always be for the\nfirst branch of any axiom.\n\nCoAxBranches that do not (yet) belong to a CoAxiom should have a panic thunk\nstored in cab_incomps. The incompatibilities are properly a property of the\naxiom as a whole, and they are computed only when the final axiom is built.\n\nDuring serialization, the list is converted into a list of the indices\nof the branches.\n-}\n\n-- | A 'CoAxiom' is a \\\"coercion constructor\\\", i.e. a named equality axiom.\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata CoAxiom br\n  = CoAxiom                   -- Type equality axiom.\n    { co_ax_unique   :: Unique        -- Unique identifier\n    , co_ax_name     :: Name          -- Name for pretty-printing\n    , co_ax_role     :: Role          -- Role of the axiom's equality\n    , co_ax_tc       :: TyCon         -- The head of the LHS patterns\n                                      -- e.g.  the newtype or family tycon\n    , co_ax_branches :: Branches br   -- The branches that form this axiom\n    , co_ax_implicit :: Bool          -- True <=> the axiom is \"implicit\"\n                                      -- See Note [Implicit axioms]\n         -- INVARIANT: co_ax_implicit == True implies length co_ax_branches == 1.\n    }\n\ndata CoAxBranch\n  = CoAxBranch\n    { cab_loc      :: SrcSpan       -- Location of the defining equation\n                                    -- See Note [CoAxiom locations]\n    , cab_tvs      :: [TyVar]       -- Bound type variables; not necessarily fresh\n    , cab_eta_tvs  :: [TyVar]       -- Eta-reduced tyvars\n                                    -- See Note [CoAxBranch type variables]\n                                    -- cab_tvs and cab_lhs may be eta-reduded; see\n                                    -- Note [Eta reduction for data families]\n    , cab_cvs      :: [CoVar]       -- Bound coercion variables\n                                    -- Always empty, for now.\n                                    -- See Note [Constraints in patterns]\n                                    -- in TcTyClsDecls\n    , cab_roles    :: [Role]        -- See Note [CoAxBranch roles]\n    , cab_lhs      :: [Type]        -- Type patterns to match against\n                                    -- See Note [CoAxiom saturation]\n    , cab_rhs      :: Type          -- Right-hand side of the equality\n    , cab_incomps  :: [CoAxBranch]  -- The previous incompatible branches\n                                    -- See Note [Storing compatibility]\n    }\n  deriving Data.Data\n\ntoBranchedAxiom :: CoAxiom br -> CoAxiom Branched\ntoBranchedAxiom (CoAxiom unique name role tc branches implicit)\n  = CoAxiom unique name role tc (toBranched branches) implicit\n\ntoUnbranchedAxiom :: CoAxiom br -> CoAxiom Unbranched\ntoUnbranchedAxiom (CoAxiom unique name role tc branches implicit)\n  = CoAxiom unique name role tc (toUnbranched branches) implicit\n\ncoAxiomNumPats :: CoAxiom br -> Int\ncoAxiomNumPats = length . coAxBranchLHS . (flip coAxiomNthBranch 0)\n\ncoAxiomNthBranch :: CoAxiom br -> BranchIndex -> CoAxBranch\ncoAxiomNthBranch (CoAxiom { co_ax_branches = bs }) index\n  = branchesNth bs index\n\ncoAxiomArity :: CoAxiom br -> BranchIndex -> Arity\ncoAxiomArity ax index\n  = length tvs + length cvs\n  where\n    CoAxBranch { cab_tvs = tvs, cab_cvs = cvs } = coAxiomNthBranch ax index\n\ncoAxiomName :: CoAxiom br -> Name\ncoAxiomName = co_ax_name\n\ncoAxiomRole :: CoAxiom br -> Role\ncoAxiomRole = co_ax_role\n\ncoAxiomBranches :: CoAxiom br -> Branches br\ncoAxiomBranches = co_ax_branches\n\ncoAxiomSingleBranch_maybe :: CoAxiom br -> Maybe CoAxBranch\ncoAxiomSingleBranch_maybe (CoAxiom { co_ax_branches = MkBranches arr })\n  | snd (bounds arr) == 0\n  = Just $ arr ! 0\n  | otherwise\n  = Nothing\n\ncoAxiomSingleBranch :: CoAxiom Unbranched -> CoAxBranch\ncoAxiomSingleBranch (CoAxiom { co_ax_branches = MkBranches arr })\n  = arr ! 0\n\ncoAxiomTyCon :: CoAxiom br -> TyCon\ncoAxiomTyCon = co_ax_tc\n\ncoAxBranchTyVars :: CoAxBranch -> [TyVar]\ncoAxBranchTyVars = cab_tvs\n\ncoAxBranchCoVars :: CoAxBranch -> [CoVar]\ncoAxBranchCoVars = cab_cvs\n\ncoAxBranchLHS :: CoAxBranch -> [Type]\ncoAxBranchLHS = cab_lhs\n\ncoAxBranchRHS :: CoAxBranch -> Type\ncoAxBranchRHS = cab_rhs\n\ncoAxBranchRoles :: CoAxBranch -> [Role]\ncoAxBranchRoles = cab_roles\n\ncoAxBranchSpan :: CoAxBranch -> SrcSpan\ncoAxBranchSpan = cab_loc\n\nisImplicitCoAxiom :: CoAxiom br -> Bool\nisImplicitCoAxiom = co_ax_implicit\n\ncoAxBranchIncomps :: CoAxBranch -> [CoAxBranch]\ncoAxBranchIncomps = cab_incomps\n\n-- See Note [Compatibility checking] in FamInstEnv\nplaceHolderIncomps :: [CoAxBranch]\nplaceHolderIncomps = panic \"placeHolderIncomps\"\n\n{- Note [CoAxiom saturation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* When co\n\nNote [CoAxBranch type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn the case of a CoAxBranch of an associated type-family instance,\nwe use the *same* type variables (where possible) as the\nenclosing class or instance.  Consider\n\n  instance C Int [z] where\n     type F Int [z] = ...   -- Second param must be [z]\n\nIn the CoAxBranch in the instance decl (F Int [z]) we use the\nsame 'z', so that it's easy to check that that type is the same\nas that in the instance header.\n\nSo, unlike FamInsts, there is no expectation that the cab_tvs\nare fresh wrt each other, or any other CoAxBranch.\n\nNote [CoAxBranch roles]\n~~~~~~~~~~~~~~~~~~~~~~~\nConsider this code:\n\n  newtype Age = MkAge Int\n  newtype Wrap a = MkWrap a\n\n  convert :: Wrap Age -> Int\n  convert (MkWrap (MkAge i)) = i\n\nWe want this to compile to:\n\n  NTCo:Wrap :: forall a. Wrap a ~R a\n  NTCo:Age  :: Age ~R Int\n  convert = \\x -> x |> (NTCo:Wrap[0] NTCo:Age[0])\n\nBut, note that NTCo:Age is at role R. Thus, we need to be able to pass\ncoercions at role R into axioms. However, we don't *always* want to be able to\ndo this, as it would be disastrous with type families. The solution is to\nannotate the arguments to the axiom with roles, much like we annotate tycon\ntyvars. Where do these roles get set? Newtype axioms inherit their roles from\nthe newtype tycon; family axioms are all at role N.\n\nNote [CoAxiom locations]\n~~~~~~~~~~~~~~~~~~~~~~~~\nThe source location of a CoAxiom is stored in two places in the\ndatatype tree.\n  * The first is in the location info buried in the Name of the\n    CoAxiom. This span includes all of the branches of a branched\n    CoAxiom.\n  * The second is in the cab_loc fields of the CoAxBranches.\n\nIn the case of a single branch, we can extract the source location of\nthe branch from the name of the CoAxiom. In other cases, we need an\nexplicit SrcSpan to correctly store the location of the equation\ngiving rise to the FamInstBranch.\n\nNote [Implicit axioms]\n~~~~~~~~~~~~~~~~~~~~~~\nSee also Note [Implicit TyThings] in HscTypes\n* A CoAxiom arising from data/type family instances is not \"implicit\".\n  That is, it has its own IfaceAxiom declaration in an interface file\n\n* The CoAxiom arising from a newtype declaration *is* \"implicit\".\n  That is, it does not have its own IfaceAxiom declaration in an\n  interface file; instead the CoAxiom is generated by type-checking\n  the newtype declaration\n\nNote [Eta reduction for data families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider this\n   data family T a b :: *\n   newtype instance T Int a = MkT (IO a) deriving( Monad )\nWe'd like this to work.\n\nFrom the 'newtype instance' you might think we'd get:\n   newtype TInt a = MkT (IO a)\n   axiom ax1 a :: T Int a ~ TInt a   -- The newtype-instance part\n   axiom ax2 a :: TInt a ~ IO a      -- The newtype part\n\nBut now what can we do?  We have this problem\n   Given:   d  :: Monad IO\n   Wanted:  d' :: Monad (T Int) = d |> ????\nWhat coercion can we use for the ???\n\nSolution: eta-reduce both axioms, thus:\n   axiom ax1 :: T Int ~ TInt\n   axiom ax2 :: TInt ~ IO\nNow\n   d' = d |> Monad (sym (ax2 ; ax1))\n\n----- Bottom line ------\n\nFor a CoAxBranch for a data family instance with representation\nTyCon rep_tc:\n\n  - cab_tvs (of its CoAxiom) may be shorter\n    than tyConTyVars of rep_tc.\n\n  - cab_lhs may be shorter than tyConArity of the family tycon\n       i.e. LHS is unsaturated\n\n  - cab_rhs will be (rep_tc cab_tvs)\n       i.e. RHS is un-saturated\n\n  - This eta reduction happens for data instances as well\n    as newtype instances. Here we want to eta-reduce the data family axiom.\n\n  - This eta-reduction is done in TcInstDcls.tcDataFamInstDecl.\n\nBut for a /type/ family\n  - cab_lhs has the exact arity of the family tycon\n\nThere are certain situations (e.g., pretty-printing) where it is necessary to\ndeal with eta-expanded data family instances. For these situations, the\ncab_eta_tvs field records the stuff that has been eta-reduced away.\nSo if we have\n    axiom forall a b. F [a->b] = D b a\nand cab_eta_tvs is [p,q], then the original user-written definition\nlooked like\n    axiom forall a b p q. F [a->b] p q = D b a p q\n(See #9692, #14179, and #15845 for examples of what can go wrong if\nwe don't eta-expand when showing things to the user.)\n\n(See also Note [Newtype eta] in TyCon.  This is notionally separate\nand deals with the axiom connecting a newtype with its representation\ntype; but it too is eta-reduced.)\n-}\n\ninstance Eq (CoAxiom br) where\n    a == b = getUnique a == getUnique b\n    a /= b = getUnique a /= getUnique b\n\ninstance Uniquable (CoAxiom br) where\n    getUnique = co_ax_unique\n\ninstance Outputable (CoAxiom br) where\n    ppr = ppr . getName\n\ninstance NamedThing (CoAxiom br) where\n    getName = co_ax_name\n\ninstance Typeable br => Data.Data (CoAxiom br) where\n    -- don't traverse?\n    toConstr _   = abstractConstr \"CoAxiom\"\n    gunfold _ _  = error \"gunfold\"\n    dataTypeOf _ = mkNoRepType \"CoAxiom\"\n\ninstance Outputable CoAxBranch where\n  ppr (CoAxBranch { cab_loc = loc\n                  , cab_lhs = lhs\n                  , cab_rhs = rhs }) =\n    text \"CoAxBranch\" <+> parens (ppr loc) <> colon\n      <+> brackets (fsep (punctuate comma (map pprType lhs)))\n      <+> text \"=>\" <+> pprType rhs\n\n{-\n************************************************************************\n*                                                                      *\n                    Roles\n*                                                                      *\n************************************************************************\n\nRoles are defined here to avoid circular dependencies.\n-}\n\n-- See Note [Roles] in Coercion\n-- defined here to avoid cyclic dependency with Coercion\n--\n-- Order of constructors matters: the Ord instance coincides with the *super*typing\n-- relation on roles.\ndata Role = Nominal | Representational | Phantom\n  deriving (Eq, Ord, Data.Data)\n\n-- These names are slurped into the parser code. Changing these strings\n-- will change the **surface syntax** that GHC accepts! If you want to\n-- change only the pretty-printing, do some replumbing. See\n-- mkRoleAnnotDecl in RdrHsSyn\nfsFromRole :: Role -> FastString\nfsFromRole Nominal          = fsLit \"nominal\"\nfsFromRole Representational = fsLit \"representational\"\nfsFromRole Phantom          = fsLit \"phantom\"\n\ninstance Outputable Role where\n  ppr = ftext . fsFromRole\n\ninstance Binary Role where\n  put_ bh Nominal          = putByte bh 1\n  put_ bh Representational = putByte bh 2\n  put_ bh Phantom          = putByte bh 3\n\n  get bh = do tag <- getByte bh\n              case tag of 1 -> return Nominal\n                          2 -> return Representational\n                          3 -> return Phantom\n                          _ -> panic (\"get Role \" ++ show tag)\n\n{-\n************************************************************************\n*                                                                      *\n                    CoAxiomRule\n              Rules for building Evidence\n*                                                                      *\n************************************************************************\n\nConditional axioms.  The general idea is that a `CoAxiomRule` looks like this:\n\n    forall as. (r1 ~ r2, s1 ~ s2) => t1 ~ t2\n\nMy intention is to reuse these for both (~) and (~#).\nThe short-term plan is to use this datatype to represent the type-nat axioms.\nIn the longer run, it may be good to unify this and `CoAxiom`,\nas `CoAxiom` is the special case when there are no assumptions.\n-}\n\n-- | A more explicit representation for `t1 ~ t2`.\ntype TypeEqn = Pair Type\n\n-- | For now, we work only with nominal equality.\ndata CoAxiomRule = CoAxiomRule\n  { coaxrName      :: FastString\n  , coaxrAsmpRoles :: [Role]    -- roles of parameter equations\n  , coaxrRole      :: Role      -- role of resulting equation\n  , coaxrProves    :: [TypeEqn] -> Maybe TypeEqn\n        -- ^ coaxrProves returns @Nothing@ when it doesn't like\n        -- the supplied arguments.  When this happens in a coercion\n        -- that means that the coercion is ill-formed, and Core Lint\n        -- checks for that.\n  }\n\ninstance Data.Data CoAxiomRule where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"CoAxiomRule\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"CoAxiomRule\"\n\ninstance Uniquable CoAxiomRule where\n  getUnique = getUnique . coaxrName\n\ninstance Eq CoAxiomRule where\n  x == y = coaxrName x == coaxrName y\n\ninstance Ord CoAxiomRule where\n  compare x y = compare (coaxrName x) (coaxrName y)\n\ninstance Outputable CoAxiomRule where\n  ppr = ppr . coaxrName\n\n\n-- Type checking of built-in families\ndata BuiltInSynFamily = BuiltInSynFamily\n  { sfMatchFam      :: [Type] -> Maybe (CoAxiomRule, [Type], Type)\n  , sfInteractTop   :: [Type] -> Type -> [TypeEqn]\n  , sfInteractInert :: [Type] -> Type ->\n                       [Type] -> Type -> [TypeEqn]\n  }\n\n-- Provides default implementations that do nothing.\ntrivialBuiltInFamily :: BuiltInSynFamily\ntrivialBuiltInFamily = BuiltInSynFamily\n  { sfMatchFam      = \\_ -> Nothing\n  , sfInteractTop   = \\_ _ -> []\n  , sfInteractInert = \\_ _ _ _ -> []\n  }\n", "num_lines": 577}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n-}\n\n{-# LANGUAGE RankNTypes, CPP, MultiWayIf, FlexibleContexts, BangPatterns,\n             ScopedTypeVariables #-}\n\n-- | Module for (a) type kinds and (b) type coercions,\n-- as used in System FC. See 'CoreSyn.Expr' for\n-- more on System FC and how coercions fit into it.\n--\nmodule Coercion (\n        -- * Main data type\n        Coercion, CoercionN, CoercionR, CoercionP, MCoercion(..), MCoercionR,\n        UnivCoProvenance, CoercionHole(..), coHoleCoVar, setCoHoleCoVar,\n        LeftOrRight(..),\n        Var, CoVar, TyCoVar,\n        Role(..), ltRole,\n\n        -- ** Functions over coercions\n        coVarTypes, coVarKind, coVarKindsTypesRole, coVarRole,\n        coercionType, coercionKind, coercionKinds,\n        mkCoercionType,\n        coercionRole, coercionKindRole,\n\n        -- ** Constructing coercions\n        mkGReflCo, mkReflCo, mkRepReflCo, mkNomReflCo,\n        mkCoVarCo, mkCoVarCos,\n        mkAxInstCo, mkUnbranchedAxInstCo,\n        mkAxInstRHS, mkUnbranchedAxInstRHS,\n        mkAxInstLHS, mkUnbranchedAxInstLHS,\n        mkPiCo, mkPiCos, mkCoCast,\n        mkSymCo, mkTransCo, mkTransMCo,\n        mkNthCo, nthCoRole, mkLRCo,\n        mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo,\n        mkForAllCo, mkForAllCos, mkHomoForAllCos,\n        mkPhantomCo,\n        mkUnsafeCo, mkHoleCo, mkUnivCo, mkSubCo,\n        mkAxiomInstCo, mkProofIrrelCo,\n        downgradeRole, maybeSubCo, mkAxiomRuleCo,\n        mkGReflRightCo, mkGReflLeftCo, mkCoherenceLeftCo, mkCoherenceRightCo,\n        mkKindCo, castCoercionKind, castCoercionKindI,\n\n        mkHeteroCoercionType,\n\n        -- ** Decomposition\n        instNewTyCon_maybe,\n\n        NormaliseStepper, NormaliseStepResult(..), composeSteppers,\n        mapStepResult, unwrapNewTypeStepper,\n        topNormaliseNewType_maybe, topNormaliseTypeX,\n\n        decomposeCo, decomposeFunCo, decomposePiCos, getCoVar_maybe,\n        splitTyConAppCo_maybe,\n        splitAppCo_maybe,\n        splitFunCo_maybe,\n        splitForAllCo_maybe,\n        splitForAllCo_ty_maybe, splitForAllCo_co_maybe,\n\n        nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe,\n\n        pickLR,\n\n        isGReflCo, isReflCo, isReflCo_maybe, isGReflCo_maybe, isReflexiveCo, isReflexiveCo_maybe,\n        isReflCoVar_maybe,\n\n        -- ** Coercion variables\n        mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique,\n        isCoVar_maybe,\n\n        -- ** Free variables\n        tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo,\n        tyCoFVsOfCo, tyCoFVsOfCos, tyCoVarsOfCoDSet,\n        coercionSize,\n\n        -- ** Substitution\n        CvSubstEnv, emptyCvSubstEnv,\n        lookupCoVar,\n        substCo, substCos, substCoVar, substCoVars, substCoWith,\n        substCoVarBndr,\n        extendTvSubstAndInScope, getCvSubstEnv,\n\n        -- ** Lifting\n        liftCoSubst, liftCoSubstTyVar, liftCoSubstWith, liftCoSubstWithEx,\n        emptyLiftingContext, extendLiftingContext, extendLiftingContextAndInScope,\n        liftCoSubstVarBndrUsing, isMappedByLC,\n\n        mkSubstLiftingContext, zapLiftingContext,\n        substForAllCoBndrUsingLC, lcTCvSubst, lcInScopeSet,\n\n        LiftCoEnv, LiftingContext(..), liftEnvSubstLeft, liftEnvSubstRight,\n        substRightCo, substLeftCo, swapLiftCoEnv, lcSubstLeft, lcSubstRight,\n\n        -- ** Comparison\n        eqCoercion, eqCoercionX,\n\n        -- ** Forcing evaluation of coercions\n        seqCo,\n\n        -- * Pretty-printing\n        pprCo, pprParendCo,\n        pprCoAxiom, pprCoAxBranch, pprCoAxBranchLHS,\n        pprCoAxBranchUser, tidyCoAxBndrsForUser,\n        etaExpandCoAxBranch,\n\n        -- * Tidying\n        tidyCo, tidyCos,\n\n        -- * Other\n        promoteCoercion, buildCoercion,\n\n        simplifyArgsWorker\n       ) where\n\n#include \"HsVersions.h\"\n\nimport {-# SOURCE #-} ToIface (toIfaceTyCon, tidyToIfaceTcArgs)\n\nimport GhcPrelude\n\nimport IfaceType\nimport TyCoRep\nimport Type\nimport TyCon\nimport CoAxiom\nimport Var\nimport VarEnv\nimport VarSet\nimport Name hiding ( varName )\nimport Util\nimport BasicTypes\nimport Outputable\nimport Unique\nimport Pair\nimport SrcLoc\nimport PrelNames\nimport TysPrim          ( eqPhantPrimTyCon )\nimport ListSetOps\nimport Maybes\nimport UniqFM\n\nimport Control.Monad (foldM, zipWithM)\nimport Data.Function ( on )\nimport Data.Char( isDigit )\n\n{-\n%************************************************************************\n%*                                                                      *\n     -- The coercion arguments always *precisely* saturate\n     -- arity of (that branch of) the CoAxiom.  If there are\n     -- any left over, we use AppCo.  See\n     -- See [Coercion axioms applied to coercions] in TyCoRep\n\n\\subsection{Coercion variables}\n%*                                                                      *\n%************************************************************************\n-}\n\ncoVarName :: CoVar -> Name\ncoVarName = varName\n\nsetCoVarUnique :: CoVar -> Unique -> CoVar\nsetCoVarUnique = setVarUnique\n\nsetCoVarName :: CoVar -> Name -> CoVar\nsetCoVarName   = setVarName\n\n{-\n%************************************************************************\n%*                                                                      *\n                   Pretty-printing CoAxioms\n%*                                                                      *\n%************************************************************************\n\nDefined here to avoid module loops. CoAxiom is loaded very early on.\n\n-}\n\netaExpandCoAxBranch :: CoAxBranch -> ([TyVar], [Type], Type)\n-- Return the (tvs,lhs,rhs) after eta-expanding,\n-- to the way in which the axiom was originally written\n-- See Note [Eta reduction for data families] in CoAxiom\netaExpandCoAxBranch (CoAxBranch { cab_tvs = tvs\n                                , cab_eta_tvs = eta_tvs\n                                , cab_lhs = lhs\n                                , cab_rhs = rhs })\n  -- ToDo: what about eta_cvs?\n  = (tvs ++ eta_tvs, lhs ++ eta_tys, mkAppTys rhs eta_tys)\n where\n    eta_tys = mkTyVarTys eta_tvs\n\npprCoAxiom :: CoAxiom br -> SDoc\n-- Used in debug-printing only\npprCoAxiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches })\n  = hang (text \"axiom\" <+> ppr ax <+> dcolon)\n       2 (vcat (map (pprCoAxBranchUser tc) (fromBranches branches)))\n\npprCoAxBranchUser :: TyCon -> CoAxBranch -> SDoc\n-- Used when printing injectivity errors (FamInst.makeInjectivityErrors)\n-- and inaccessible branches (TcValidity.inaccessibleCoAxBranch)\n-- This happens in error messages: don't print the RHS of a data\n--   family axiom, which is meaningless to a user\npprCoAxBranchUser tc br\n  | isDataFamilyTyCon tc = pprCoAxBranchLHS tc br\n  | otherwise            = pprCoAxBranch    tc br\n\npprCoAxBranchLHS :: TyCon -> CoAxBranch -> SDoc\n-- Print the family-instance equation when reporting\n--   a conflict between equations (FamInst.conflictInstErr)\n-- For type families the RHS is important; for data families not so.\n--   Indeed for data families the RHS is a mysterious internal\n--   type constructor, so we suppress it (Trac #14179)\n-- See FamInstEnv Note [Family instance overlap conflicts]\npprCoAxBranchLHS = ppr_co_ax_branch pp_rhs\n  where\n    pp_rhs _ _ = empty\n\npprCoAxBranch :: TyCon -> CoAxBranch -> SDoc\npprCoAxBranch = ppr_co_ax_branch ppr_rhs\n  where\n    ppr_rhs env rhs = equals <+> pprPrecTypeX env topPrec rhs\n\nppr_co_ax_branch :: (TidyEnv -> Type -> SDoc)\n                 -> TyCon -> CoAxBranch -> SDoc\nppr_co_ax_branch ppr_rhs fam_tc branch\n  = foldr1 (flip hangNotEmpty 2)\n    [ pprUserForAll (mkTyCoVarBinders Inferred bndrs')\n         -- See Note [Printing foralls in type family instances] in IfaceType\n    , pp_lhs <+> ppr_rhs tidy_env ee_rhs\n    , text \"-- Defined\" <+> pp_loc ]\n  where\n    loc = coAxBranchSpan branch\n    pp_loc | isGoodSrcSpan loc = text \"at\" <+> ppr (srcSpanStart loc)\n           | otherwise         = text \"in\" <+> ppr loc\n\n    -- Eta-expand LHS and RHS types, because sometimes data family\n    -- instances are eta-reduced.\n    -- See Note [Eta reduction for data families] in FamInstEnv.\n    (ee_tvs, ee_lhs, ee_rhs) = etaExpandCoAxBranch branch\n\n    pp_lhs = pprIfaceTypeApp topPrec (toIfaceTyCon fam_tc)\n                             (tidyToIfaceTcArgs tidy_env fam_tc ee_lhs)\n\n    (tidy_env, bndrs') = tidyCoAxBndrsForUser emptyTidyEnv ee_tvs\n\ntidyCoAxBndrsForUser :: TidyEnv -> [Var] -> (TidyEnv, [Var])\n-- Tidy wildcards \"_1\", \"_2\" to \"_\", and do not return them\n-- in the list of binders to be printed\n-- This is so that in error messages we see\n--     forall a. F _ [a] _ = ...\n-- rather than\n--     forall a _1 _2. F _1 [a] _2 = ...\n--\n-- This is a rather disgusting function\ntidyCoAxBndrsForUser init_env tcvs\n  = (tidy_env, reverse tidy_bndrs)\n  where\n    (tidy_env, tidy_bndrs) = foldl tidy_one (init_env, []) tcvs\n\n    tidy_one (env@(occ_env, subst), rev_bndrs') bndr\n      | is_wildcard bndr = (env_wild, rev_bndrs')\n      | otherwise        = (env',     bndr' : rev_bndrs')\n      where\n        (env', bndr') = tidyVarBndr env bndr\n        env_wild = (occ_env, extendVarEnv subst bndr wild_bndr)\n        wild_bndr = setVarName bndr $\n                    tidyNameOcc (varName bndr) (mkTyVarOcc \"_\")\n                    -- Tidy the binder to \"_\"\n\n    is_wildcard :: Var -> Bool\n    is_wildcard tv = case occNameString (getOccName tv) of\n                       ('_' : rest) -> all isDigit rest\n                       _            -> False\n\n{-\n%************************************************************************\n%*                                                                      *\n        Destructing coercions\n%*                                                                      *\n%************************************************************************\n\nNote [Function coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nRemember that\n  (->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> TYPE LiftedRep\n\nHence\n  FunCo r co1 co2 :: (s1->t1) ~r (s2->t2)\nis short for\n  TyConAppCo (->) co_rep1 co_rep2 co1 co2\nwhere co_rep1, co_rep2 are the coercions on the representations.\n-}\n\n\n-- | This breaks a 'Coercion' with type @T A B C ~ T D E F@ into\n-- a list of 'Coercion's of kinds @A ~ D@, @B ~ E@ and @E ~ F@. Hence:\n--\n-- > decomposeCo 3 c [r1, r2, r3] = [nth r1 0 c, nth r2 1 c, nth r3 2 c]\ndecomposeCo :: Arity -> Coercion\n            -> [Role]  -- the roles of the output coercions\n                       -- this must have at least as many\n                       -- entries as the Arity provided\n            -> [Coercion]\ndecomposeCo arity co rs\n  = [mkNthCo r n co | (n,r) <- [0..(arity-1)] `zip` rs ]\n           -- Remember, Nth is zero-indexed\n\ndecomposeFunCo :: HasDebugCallStack\n               => Role      -- Role of the input coercion\n               -> Coercion  -- Input coercion\n               -> (Coercion, Coercion)\n-- Expects co :: (s1 -> t1) ~ (s2 -> t2)\n-- Returns (co1 :: s1~s2, co2 :: t1~t2)\n-- See Note [Function coercions] for the \"2\" and \"3\"\ndecomposeFunCo r co = ASSERT2( all_ok, ppr co )\n                      (mkNthCo r 2 co, mkNthCo r 3 co)\n  where\n    Pair s1t1 s2t2 = coercionKind co\n    all_ok = isFunTy s1t1 && isFunTy s2t2\n\n{- Note [Pushing a coercion into a pi-type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have this:\n    (f |> co) t1 .. tn\nThen we want to push the coercion into the arguments, so as to make\nprogress. For example of why you might want to do so, see Note\n[Respecting definitional equality] in TyCoRep.\n\nThis is done by decomposePiCos.  Specifically, if\n    decomposePiCos co [t1,..,tn] = ([co1,...,cok], cor)\nthen\n    (f |> co) t1 .. tn   =   (f (t1 |> co1) ... (tk |> cok)) |> cor) t(k+1) ... tn\n\nNotes:\n\n* k can be smaller than n! That is decomposePiCos can return *fewer*\n  coercions than there are arguments (ie k < n), if the kind provided\n  doesn't have enough binders.\n\n* If there is a type error, we might see\n       (f |> co) t1\n  where co :: (forall a. ty) ~ (ty1 -> ty2)\n  Here 'co' is insoluble, but we don't want to crash in decoposePiCos.\n  So decomposePiCos carefully tests both sides of the coercion to check\n  they are both foralls or both arrows.  Not doing this caused Trac #15343.\n-}\n\ndecomposePiCos :: HasDebugCallStack\n               => CoercionN -> Pair Type  -- Coercion and its kind\n               -> [Type]\n               -> ([CoercionN], CoercionN)\n-- See Note [Pushing a coercion into a pi-type]\ndecomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args\n  = go [] (orig_subst,orig_k1) orig_co (orig_subst,orig_k2) orig_args\n  where\n    orig_subst = mkEmptyTCvSubst $ mkInScopeSet $\n                 tyCoVarsOfTypes orig_args `unionVarSet` tyCoVarsOfCo orig_co\n\n    go :: [CoercionN]      -- accumulator for argument coercions, reversed\n       -> (TCvSubst,Kind)  -- Lhs kind of coercion\n       -> CoercionN        -- coercion originally applied to the function\n       -> (TCvSubst,Kind)  -- Rhs kind of coercion\n       -> [Type]           -- Arguments to that function\n       -> ([CoercionN], Coercion)\n    -- Invariant:  co :: subst1(k2) ~ subst2(k2)\n\n    go acc_arg_cos (subst1,k1) co (subst2,k2) (ty:tys)\n      | Just (a, t1) <- splitForAllTy_maybe k1\n      , Just (b, t2) <- splitForAllTy_maybe k2\n        -- know     co :: (forall a:s1.t1) ~ (forall b:s2.t2)\n        --    function :: forall a:s1.t1   (the function is not passed to decomposePiCos)\n        --           a :: s1\n        --           b :: s2\n        --          ty :: s2\n        -- need arg_co :: s2 ~ s1\n        --      res_co :: t1[ty |> arg_co / a] ~ t2[ty / b]\n      = let arg_co  = mkNthCo Nominal 0 (mkSymCo co)\n            res_co  = mkInstCo co (mkGReflLeftCo Nominal ty arg_co)\n            subst1' = extendTCvSubst subst1 a (ty `CastTy` arg_co)\n            subst2' = extendTCvSubst subst2 b ty\n        in\n        go (arg_co : acc_arg_cos) (subst1', t1) res_co (subst2', t2) tys\n\n      | Just (_s1, t1) <- splitFunTy_maybe k1\n      , Just (_s2, t2) <- splitFunTy_maybe k2\n        -- know     co :: (s1 -> t1) ~ (s2 -> t2)\n        --    function :: s1 -> t1\n        --          ty :: s2\n        -- need arg_co :: s2 ~ s1\n        --      res_co :: t1 ~ t2\n      = let (sym_arg_co, res_co) = decomposeFunCo Nominal co\n            arg_co               = mkSymCo sym_arg_co\n        in\n        go (arg_co : acc_arg_cos) (subst1,t1) res_co (subst2,t2) tys\n\n      | not (isEmptyTCvSubst subst1) || not (isEmptyTCvSubst subst2)\n      = go acc_arg_cos (zapTCvSubst subst1, substTy subst1 k1)\n                       co\n                       (zapTCvSubst subst2, substTy subst1 k2)\n                       (ty:tys)\n\n      -- tys might not be empty, if the left-hand type of the original coercion\n      -- didn't have enough binders\n    go acc_arg_cos _ki1 co _ki2 _tys = (reverse acc_arg_cos, co)\n\n-- | Attempts to obtain the type variable underlying a 'Coercion'\ngetCoVar_maybe :: Coercion -> Maybe CoVar\ngetCoVar_maybe (CoVarCo cv) = Just cv\ngetCoVar_maybe _            = Nothing\n\n-- | Attempts to tease a coercion apart into a type constructor and the application\n-- of a number of coercion arguments to that constructor\nsplitTyConAppCo_maybe :: Coercion -> Maybe (TyCon, [Coercion])\nsplitTyConAppCo_maybe co\n  | Just (ty, r) <- isReflCo_maybe co\n  = do { (tc, tys) <- splitTyConApp_maybe ty\n       ; let args = zipWith mkReflCo (tyConRolesX r tc) tys\n       ; return (tc, args) }\nsplitTyConAppCo_maybe (TyConAppCo _ tc cos) = Just (tc, cos)\nsplitTyConAppCo_maybe (FunCo _ arg res)     = Just (funTyCon, cos)\n  where cos = [mkRuntimeRepCo arg, mkRuntimeRepCo res, arg, res]\nsplitTyConAppCo_maybe _                     = Nothing\n\n-- first result has role equal to input; third result is Nominal\nsplitAppCo_maybe :: Coercion -> Maybe (Coercion, Coercion)\n-- ^ Attempt to take a coercion application apart.\nsplitAppCo_maybe (AppCo co arg) = Just (co, arg)\nsplitAppCo_maybe (TyConAppCo r tc args)\n  | args `lengthExceeds` tyConArity tc\n  , Just (args', arg') <- snocView args\n  = Just ( mkTyConAppCo r tc args', arg' )\n\n  | not (mustBeSaturated tc)\n    -- Never create unsaturated type family apps!\n  , Just (args', arg') <- snocView args\n  , Just arg'' <- setNominalRole_maybe (nthRole r tc (length args')) arg'\n  = Just ( mkTyConAppCo r tc args', arg'' )\n       -- Use mkTyConAppCo to preserve the invariant\n       --  that identity coercions are always represented by Refl\n\nsplitAppCo_maybe co\n  | Just (ty, r) <- isReflCo_maybe co\n  , Just (ty1, ty2) <- splitAppTy_maybe ty\n  = Just (mkReflCo r ty1, mkNomReflCo ty2)\nsplitAppCo_maybe _ = Nothing\n\nsplitFunCo_maybe :: Coercion -> Maybe (Coercion, Coercion)\nsplitFunCo_maybe (FunCo _ arg res) = Just (arg, res)\nsplitFunCo_maybe _ = Nothing\n\nsplitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, Coercion, Coercion)\nsplitForAllCo_maybe (ForAllCo tv k_co co) = Just (tv, k_co, co)\nsplitForAllCo_maybe _                     = Nothing\n\n-- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder\nsplitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)\nsplitForAllCo_ty_maybe (ForAllCo tv k_co co)\n  | isTyVar tv = Just (tv, k_co, co)\nsplitForAllCo_ty_maybe _ = Nothing\n\n-- | Like 'splitForAllCo_maybe', but only returns Just for covar binder\nsplitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion)\nsplitForAllCo_co_maybe (ForAllCo cv k_co co)\n  | isCoVar cv = Just (cv, k_co, co)\nsplitForAllCo_co_maybe _ = Nothing\n\n-------------------------------------------------------\n-- and some coercion kind stuff\n\ncoVarTypes :: HasDebugCallStack => CoVar -> Pair Type\ncoVarTypes cv\n  | (_, _, ty1, ty2, _) <- coVarKindsTypesRole cv\n  = Pair ty1 ty2\n\ncoVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind,Kind,Type,Type,Role)\ncoVarKindsTypesRole cv\n | Just (tc, [k1,k2,ty1,ty2]) <- splitTyConApp_maybe (varType cv)\n = let role\n         | tc `hasKey` eqPrimTyConKey     = Nominal\n         | tc `hasKey` eqReprPrimTyConKey = Representational\n         | otherwise                      = panic \"coVarKindsTypesRole\"\n   in (k1,k2,ty1,ty2,role)\n | otherwise = pprPanic \"coVarKindsTypesRole, non coercion variable\"\n                        (ppr cv $$ ppr (varType cv))\n\ncoVarKind :: CoVar -> Type\ncoVarKind cv\n  = ASSERT( isCoVar cv )\n    varType cv\n\ncoVarRole :: CoVar -> Role\ncoVarRole cv\n  | tc `hasKey` eqPrimTyConKey\n  = Nominal\n  | tc `hasKey` eqReprPrimTyConKey\n  = Representational\n  | otherwise\n  = pprPanic \"coVarRole: unknown tycon\" (ppr cv <+> dcolon <+> ppr (varType cv))\n\n  where\n    tc = case tyConAppTyCon_maybe (varType cv) of\n           Just tc0 -> tc0\n           Nothing  -> pprPanic \"coVarRole: not tyconapp\" (ppr cv)\n\n-- | Makes a coercion type from two types: the types whose equality\n-- is proven by the relevant 'Coercion'\nmkCoercionType :: Role -> Type -> Type -> Type\nmkCoercionType Nominal          = mkPrimEqPred\nmkCoercionType Representational = mkReprPrimEqPred\nmkCoercionType Phantom          = \\ty1 ty2 ->\n  let ki1 = typeKind ty1\n      ki2 = typeKind ty2\n  in\n  TyConApp eqPhantPrimTyCon [ki1, ki2, ty1, ty2]\n\nmkHeteroCoercionType :: Role -> Kind -> Kind -> Type -> Type -> Type\nmkHeteroCoercionType Nominal          = mkHeteroPrimEqPred\nmkHeteroCoercionType Representational = mkHeteroReprPrimEqPred\nmkHeteroCoercionType Phantom          = panic \"mkHeteroCoercionType\"\n\n-- | Given a coercion @co1 :: (a :: TYPE r1) ~ (b :: TYPE r2)@,\n-- produce a coercion @rep_co :: r1 ~ r2@.\nmkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion\nmkRuntimeRepCo co\n  = mkNthCo Nominal 0 kind_co\n  where\n    kind_co = mkKindCo co  -- kind_co :: TYPE r1 ~ TYPE r2\n                           -- (up to silliness with Constraint)\n\nisReflCoVar_maybe :: Var -> Maybe Coercion\n-- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t)\n-- Works on all kinds of Vars, not just CoVars\nisReflCoVar_maybe cv\n  | isCoVar cv\n  , Pair ty1 ty2 <- coVarTypes cv\n  , ty1 `eqType` ty2\n  = Just (mkReflCo (coVarRole cv) ty1)\n  | otherwise\n  = Nothing\n\n-- | Tests if this coercion is obviously a generalized reflexive coercion.\n-- Guaranteed to work very quickly.\nisGReflCo :: Coercion -> Bool\nisGReflCo (GRefl{}) = True\nisGReflCo (Refl{})  = True -- Refl ty == GRefl N ty MRefl\nisGReflCo _         = False\n\n-- | Tests if this MCoercion is obviously generalized reflexive\n-- Guaranteed to work very quickly.\nisGReflMCo :: MCoercion -> Bool\nisGReflMCo MRefl = True\nisGReflMCo (MCo co) | isGReflCo co = True\nisGReflMCo _ = False\n\n-- | Tests if this coercion is obviously reflexive. Guaranteed to work\n-- very quickly. Sometimes a coercion can be reflexive, but not obviously\n-- so. c.f. 'isReflexiveCo'\nisReflCo :: Coercion -> Bool\nisReflCo (Refl{}) = True\nisReflCo (GRefl _ _ mco) | isGReflMCo mco = True\nisReflCo _ = False\n\n-- | Returns the type coerced if this coercion is a generalized reflexive\n-- coercion. Guaranteed to work very quickly.\nisGReflCo_maybe :: Coercion -> Maybe (Type, Role)\nisGReflCo_maybe (GRefl r ty _) = Just (ty, r)\nisGReflCo_maybe (Refl ty)      = Just (ty, Nominal)\nisGReflCo_maybe _ = Nothing\n\n-- | Returns the type coerced if this coercion is reflexive. Guaranteed\n-- to work very quickly. Sometimes a coercion can be reflexive, but not\n-- obviously so. c.f. 'isReflexiveCo_maybe'\nisReflCo_maybe :: Coercion -> Maybe (Type, Role)\nisReflCo_maybe (Refl ty) = Just (ty, Nominal)\nisReflCo_maybe (GRefl r ty mco) | isGReflMCo mco = Just (ty, r)\nisReflCo_maybe _ = Nothing\n\n-- | Slowly checks if the coercion is reflexive. Don't call this in a loop,\n-- as it walks over the entire coercion.\nisReflexiveCo :: Coercion -> Bool\nisReflexiveCo = isJust . isReflexiveCo_maybe\n\n-- | Extracts the coerced type from a reflexive coercion. This potentially\n-- walks over the entire coercion, so avoid doing this in a loop.\nisReflexiveCo_maybe :: Coercion -> Maybe (Type, Role)\nisReflexiveCo_maybe (Refl ty) = Just (ty, Nominal)\nisReflexiveCo_maybe (GRefl r ty mco) | isGReflMCo mco = Just (ty, r)\nisReflexiveCo_maybe co\n  | ty1 `eqType` ty2\n  = Just (ty1, r)\n  | otherwise\n  = Nothing\n  where (Pair ty1 ty2, r) = coercionKindRole co\n\n{-\n%************************************************************************\n%*                                                                      *\n            Building coercions\n%*                                                                      *\n%************************************************************************\n\nThese \"smart constructors\" maintain the invariants listed in the definition\nof Coercion, and they perform very basic optimizations.\n\nNote [Role twiddling functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThere are a plethora of functions for twiddling roles:\n\nmkSubCo: Requires a nominal input coercion and always produces a\nrepresentational output. This is used when you (the programmer) are sure you\nknow exactly that role you have and what you want.\n\ndowngradeRole_maybe: This function takes both the input role and the output role\nas parameters. (The *output* role comes first!) It can only *downgrade* a\nrole -- that is, change it from N to R or P, or from R to P. This one-way\nbehavior is why there is the \"_maybe\". If an upgrade is requested, this\nfunction produces Nothing. This is used when you need to change the role of a\ncoercion, but you're not sure (as you're writing the code) of which roles are\ninvolved.\n\nThis function could have been written using coercionRole to ascertain the role\nof the input. But, that function is recursive, and the caller of downgradeRole_maybe\noften knows the input role. So, this is more efficient.\n\ndowngradeRole: This is just like downgradeRole_maybe, but it panics if the\nconversion isn't a downgrade.\n\nsetNominalRole_maybe: This is the only function that can *upgrade* a coercion.\nThe result (if it exists) is always Nominal. The input can be at any role. It\nworks on a \"best effort\" basis, as it should never be strictly necessary to\nupgrade a coercion during compilation. It is currently only used within GHC in\nsplitAppCo_maybe. In order to be a proper inverse of mkAppCo, the second\ncoercion that splitAppCo_maybe returns must be nominal. But, it's conceivable\nthat splitAppCo_maybe is operating over a TyConAppCo that uses a\nrepresentational coercion. Hence the need for setNominalRole_maybe.\nsplitAppCo_maybe, in turn, is used only within coercion optimization -- thus,\nit is not absolutely critical that setNominalRole_maybe be complete.\n\nNote that setNominalRole_maybe will never upgrade a phantom UnivCo. Phantom\nUnivCos are perfectly type-safe, whereas representational and nominal ones are\nnot. Indeed, `unsafeCoerce` is implemented via a representational UnivCo.\n(Nominal ones are no worse than representational ones, so this function *will*\nchange a UnivCo Representational to a UnivCo Nominal.)\n\nConal Elliott also came across a need for this function while working with the\nGHC API, as he was decomposing Core casts. The Core casts use representational\ncoercions, as they must, but his use case required nominal coercions (he was\nbuilding a GADT). So, that's why this function is exported from this module.\n\nOne might ask: shouldn't downgradeRole_maybe just use setNominalRole_maybe as\nappropriate? I (Richard E.) have decided not to do this, because upgrading a\nrole is bizarre and a caller should have to ask for this behavior explicitly.\n\n-}\n\n-- | Make a generalized reflexive coercion\nmkGReflCo :: Role -> Type -> MCoercionN -> Coercion\nmkGReflCo r ty mco\n  | isGReflMCo mco = if r == Nominal then Refl ty\n                     else GRefl r ty MRefl\n  | otherwise    = GRefl r ty mco\n\n-- | Make a reflexive coercion\nmkReflCo :: Role -> Type -> Coercion\nmkReflCo Nominal ty = Refl ty\nmkReflCo r       ty = GRefl r ty MRefl\n\n-- | Make a representational reflexive coercion\nmkRepReflCo :: Type -> Coercion\nmkRepReflCo ty = GRefl Representational ty MRefl\n\n-- | Make a nominal reflexive coercion\nmkNomReflCo :: Type -> Coercion\nmkNomReflCo = Refl\n\n-- | Apply a type constructor to a list of coercions. It is the\n-- caller's responsibility to get the roles correct on argument coercions.\nmkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion\nmkTyConAppCo r tc cos\n  | tc `hasKey` funTyConKey\n  , [_rep1, _rep2, co1, co2] <- cos   -- See Note [Function coercions]\n  = -- (a :: TYPE ra) -> (b :: TYPE rb)  ~  (c :: TYPE rc) -> (d :: TYPE rd)\n    -- rep1 :: ra  ~  rc        rep2 :: rb  ~  rd\n    -- co1  :: a   ~  c         co2  :: b   ~  d\n    mkFunCo r co1 co2\n\n               -- Expand type synonyms\n  | Just (tv_co_prs, rhs_ty, leftover_cos) <- expandSynTyCon_maybe tc cos\n  = mkAppCos (liftCoSubst r (mkLiftingContext tv_co_prs) rhs_ty) leftover_cos\n\n  | Just tys_roles <- traverse isReflCo_maybe cos\n  = mkReflCo r (mkTyConApp tc (map fst tys_roles))\n  -- See Note [Refl invariant]\n\n  | otherwise = TyConAppCo r tc cos\n\n-- | Build a function 'Coercion' from two other 'Coercion's. That is,\n-- given @co1 :: a ~ b@ and @co2 :: x ~ y@ produce @co :: (a -> x) ~ (b -> y)@.\nmkFunCo :: Role -> Coercion -> Coercion -> Coercion\nmkFunCo r co1 co2\n    -- See Note [Refl invariant]\n  | Just (ty1, _) <- isReflCo_maybe co1\n  , Just (ty2, _) <- isReflCo_maybe co2\n  = mkReflCo r (mkVisFunTy ty1 ty2)\n  | otherwise = FunCo r co1 co2\n\n-- | Apply a 'Coercion' to another 'Coercion'.\n-- The second coercion must be Nominal, unless the first is Phantom.\n-- If the first is Phantom, then the second can be either Phantom or Nominal.\nmkAppCo :: Coercion     -- ^ :: t1 ~r t2\n        -> Coercion     -- ^ :: s1 ~N s2, where s1 :: k1, s2 :: k2\n        -> Coercion     -- ^ :: t1 s1 ~r t2 s2\nmkAppCo co arg\n  | Just (ty1, r) <- isReflCo_maybe co\n  , Just (ty2, _) <- isReflCo_maybe arg\n  = mkReflCo r (mkAppTy ty1 ty2)\n\n  | Just (ty1, r) <- isReflCo_maybe co\n  , Just (tc, tys) <- splitTyConApp_maybe ty1\n    -- Expand type synonyms; a TyConAppCo can't have a type synonym (Trac #9102)\n  = mkTyConAppCo r tc (zip_roles (tyConRolesX r tc) tys)\n  where\n    zip_roles (r1:_)  []            = [downgradeRole r1 Nominal arg]\n    zip_roles (r1:rs) (ty1:tys)     = mkReflCo r1 ty1 : zip_roles rs tys\n    zip_roles _       _             = panic \"zip_roles\" -- but the roles are infinite...\n\nmkAppCo (TyConAppCo r tc args) arg\n  = case r of\n      Nominal          -> mkTyConAppCo Nominal tc (args ++ [arg])\n      Representational -> mkTyConAppCo Representational tc (args ++ [arg'])\n        where new_role = (tyConRolesRepresentational tc) !! (length args)\n              arg'     = downgradeRole new_role Nominal arg\n      Phantom          -> mkTyConAppCo Phantom tc (args ++ [toPhantomCo arg])\nmkAppCo co arg = AppCo co  arg\n-- Note, mkAppCo is careful to maintain invariants regarding\n-- where Refl constructors appear; see the comments in the definition\n-- of Coercion and the Note [Refl invariant] in TyCoRep.\n\n-- | Applies multiple 'Coercion's to another 'Coercion', from left to right.\n-- See also 'mkAppCo'.\nmkAppCos :: Coercion\n         -> [Coercion]\n         -> Coercion\nmkAppCos co1 cos = foldl' mkAppCo co1 cos\n\n{- Note [Unused coercion variable in ForAllCo]\n\nSee Note [Unused coercion variable in ForAllTy] in TyCoRep for the motivation for\nchecking coercion variable in types.\nTo lift the design choice to (ForAllCo cv kind_co body_co), we have two options:\n\n(1) In mkForAllCo, we check whether cv is a coercion variable\n    and whether it is not used in body_co. If so we construct a FunCo.\n(2) We don't do this check in mkForAllCo.\n    In coercionKind, we use mkTyCoForAllTy to perform the check and construct\n    a FunTy when necessary.\n\nWe chose (2) for two reasons:\n\n* for a coercion, all that matters is its kind, So ForAllCo or FunCo does not\n  make a difference.\n* even if cv occurs in body_co, it is possible that cv does not occur in the kind\n  of body_co. Therefore the check in coercionKind is inevitable.\n\nThe last wrinkle is that there are restrictions around the use of the cv in the\ncoercion, as described in Section 5.8.5.2 of Richard's thesis. The idea is that\nwe cannot prove that the type system is consistent with unrestricted use of this\ncv; the consistency proof uses an untyped rewrite relation that works over types\nwith all coercions and casts removed. So, we can allow the cv to appear only in\npositions that are erased. As an approximation of this (and keeping close to the\npublished theory), we currently allow the cv only within the type in a Refl node\nand under a GRefl node (including in the Coercion stored in a GRefl). It's\npossible other places are OK, too, but this is a safe approximation.\n\nSadly, with heterogeneous equality, this restriction might be able to be violated;\nRichard's thesis is unable to prove that it isn't. Specifically, the liftCoSubst\nfunction might create an invalid coercion. Because a violation of the\nrestriction might lead to a program that \"goes wrong\", it is checked all the time,\neven in a production compiler and without -dcore-list. We *have* proved that the\nproblem does not occur with homogeneous equality, so this check can be dropped\nonce ~# is made to be homogeneous.\n-}\n\n\n-- | Make a Coercion from a tycovar, a kind coercion, and a body coercion.\n-- The kind of the tycovar should be the left-hand kind of the kind coercion.\n-- See Note [Unused coercion variable in ForAllCo]\nmkForAllCo :: TyCoVar -> CoercionN -> Coercion -> Coercion\nmkForAllCo v kind_co co\n  | ASSERT( varType v `eqType` (pFst $ coercionKind kind_co)) True\n  , ASSERT( isTyVar v || almostDevoidCoVarOfCo v co) True\n  , Just (ty, r) <- isReflCo_maybe co\n  , isGReflCo kind_co\n  = mkReflCo r (mkTyCoInvForAllTy v ty)\n  | otherwise\n  = ForAllCo v kind_co co\n\n-- | Like 'mkForAllCo', but the inner coercion shouldn't be an obvious\n-- reflexive coercion. For example, it is guaranteed in 'mkForAllCos'.\n-- The kind of the tycovar should be the left-hand kind of the kind coercion.\nmkForAllCo_NoRefl :: TyCoVar -> CoercionN -> Coercion -> Coercion\nmkForAllCo_NoRefl v kind_co co\n  | ASSERT( varType v `eqType` (pFst $ coercionKind kind_co)) True\n  , ASSERT( isTyVar v || almostDevoidCoVarOfCo v co) True\n  , ASSERT( not (isReflCo co)) True\n  , isCoVar v\n  , not (v `elemVarSet` tyCoVarsOfCo co)\n  = FunCo (coercionRole co) kind_co co\n  | otherwise\n  = ForAllCo v kind_co co\n\n-- | Make nested ForAllCos\nmkForAllCos :: [(TyCoVar, CoercionN)] -> Coercion -> Coercion\nmkForAllCos bndrs co\n  | Just (ty, r ) <- isReflCo_maybe co\n  = let (refls_rev'd, non_refls_rev'd) = span (isReflCo . snd) (reverse bndrs) in\n    foldl' (flip $ uncurry mkForAllCo_NoRefl)\n           (mkReflCo r (mkTyCoInvForAllTys (reverse (map fst refls_rev'd)) ty))\n           non_refls_rev'd\n  | otherwise\n  = foldr (uncurry mkForAllCo_NoRefl) co bndrs\n\n-- | Make a Coercion quantified over a type/coercion variable;\n-- the variable has the same type in both sides of the coercion\nmkHomoForAllCos :: [TyCoVar] -> Coercion -> Coercion\nmkHomoForAllCos vs co\n  | Just (ty, r) <- isReflCo_maybe co\n  = mkReflCo r (mkTyCoInvForAllTys vs ty)\n  | otherwise\n  = mkHomoForAllCos_NoRefl vs co\n\n-- | Like 'mkHomoForAllCos', but the inner coercion shouldn't be an obvious\n-- reflexive coercion. For example, it is guaranteed in 'mkHomoForAllCos'.\nmkHomoForAllCos_NoRefl :: [TyCoVar] -> Coercion -> Coercion\nmkHomoForAllCos_NoRefl vs orig_co\n  = ASSERT( not (isReflCo orig_co))\n    foldr go orig_co vs\n  where\n    go v co = mkForAllCo_NoRefl v (mkNomReflCo (varType v)) co\n\nmkCoVarCo :: CoVar -> Coercion\n-- cv :: s ~# t\n-- See Note [mkCoVarCo]\nmkCoVarCo cv = CoVarCo cv\n\nmkCoVarCos :: [CoVar] -> [Coercion]\nmkCoVarCos = map mkCoVarCo\n\n{- Note [mkCoVarCo]\n~~~~~~~~~~~~~~~~~~~\nIn the past, mkCoVarCo optimised (c :: t~t) to (Refl t).  That is\nvalid (although see Note [Unbound RULE binders] in Rules), but\nit's a relatively expensive test and perhaps better done in\noptCoercion.  Not a big deal either way.\n-}\n\n-- | Extract a covar, if possible. This check is dirty. Be ashamed\n-- of yourself. (It's dirty because it cares about the structure of\n-- a coercion, which is morally reprehensible.)\nisCoVar_maybe :: Coercion -> Maybe CoVar\nisCoVar_maybe (CoVarCo cv) = Just cv\nisCoVar_maybe _            = Nothing\n\nmkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion]\n           -> Coercion\n-- mkAxInstCo can legitimately be called over-staturated;\n-- i.e. with more type arguments than the coercion requires\nmkAxInstCo role ax index tys cos\n  | arity == n_tys = downgradeRole role ax_role $\n                     mkAxiomInstCo ax_br index (rtys `chkAppend` cos)\n  | otherwise      = ASSERT( arity < n_tys )\n                     downgradeRole role ax_role $\n                     mkAppCos (mkAxiomInstCo ax_br index\n                                             (ax_args `chkAppend` cos))\n                              leftover_args\n  where\n    n_tys         = length tys\n    ax_br         = toBranchedAxiom ax\n    branch        = coAxiomNthBranch ax_br index\n    tvs           = coAxBranchTyVars branch\n    arity         = length tvs\n    arg_roles     = coAxBranchRoles branch\n    rtys          = zipWith mkReflCo (arg_roles ++ repeat Nominal) tys\n    (ax_args, leftover_args)\n                  = splitAt arity rtys\n    ax_role       = coAxiomRole ax\n\n-- worker function\nmkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion\nmkAxiomInstCo ax index args\n  = ASSERT( args `lengthIs` coAxiomArity ax index )\n    AxiomInstCo ax index args\n\n-- to be used only with unbranched axioms\nmkUnbranchedAxInstCo :: Role -> CoAxiom Unbranched\n                     -> [Type] -> [Coercion] -> Coercion\nmkUnbranchedAxInstCo role ax tys cos\n  = mkAxInstCo role ax 0 tys cos\n\nmkAxInstRHS :: CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Type\n-- Instantiate the axiom with specified types,\n-- returning the instantiated RHS\n-- A companion to mkAxInstCo:\n--    mkAxInstRhs ax index tys = snd (coercionKind (mkAxInstCo ax index tys))\nmkAxInstRHS ax index tys cos\n  = ASSERT( tvs `equalLength` tys1 )\n    mkAppTys rhs' tys2\n  where\n    branch       = coAxiomNthBranch ax index\n    tvs          = coAxBranchTyVars branch\n    cvs          = coAxBranchCoVars branch\n    (tys1, tys2) = splitAtList tvs tys\n    rhs'         = substTyWith tvs tys1 $\n                   substTyWithCoVars cvs cos $\n                   coAxBranchRHS branch\n\nmkUnbranchedAxInstRHS :: CoAxiom Unbranched -> [Type] -> [Coercion] -> Type\nmkUnbranchedAxInstRHS ax = mkAxInstRHS ax 0\n\n-- | Return the left-hand type of the axiom, when the axiom is instantiated\n-- at the types given.\nmkAxInstLHS :: CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Type\nmkAxInstLHS ax index tys cos\n  = ASSERT( tvs `equalLength` tys1 )\n    mkTyConApp fam_tc (lhs_tys `chkAppend` tys2)\n  where\n    branch       = coAxiomNthBranch ax index\n    tvs          = coAxBranchTyVars branch\n    cvs          = coAxBranchCoVars branch\n    (tys1, tys2) = splitAtList tvs tys\n    lhs_tys      = substTysWith tvs tys1 $\n                   substTysWithCoVars cvs cos $\n                   coAxBranchLHS branch\n    fam_tc       = coAxiomTyCon ax\n\n-- | Instantiate the left-hand side of an unbranched axiom\nmkUnbranchedAxInstLHS :: CoAxiom Unbranched -> [Type] -> [Coercion] -> Type\nmkUnbranchedAxInstLHS ax = mkAxInstLHS ax 0\n\n-- | Manufacture an unsafe coercion from thin air.\n--   Currently (May 14) this is used only to implement the\n--   @unsafeCoerce#@ primitive.  Optimise by pushing\n--   down through type constructors.\nmkUnsafeCo :: Role -> Type -> Type -> Coercion\nmkUnsafeCo role ty1 ty2\n  = mkUnivCo UnsafeCoerceProv role ty1 ty2\n\n-- | Make a coercion from a coercion hole\nmkHoleCo :: CoercionHole -> Coercion\nmkHoleCo h = HoleCo h\n\n-- | Make a universal coercion between two arbitrary types.\nmkUnivCo :: UnivCoProvenance\n         -> Role       -- ^ role of the built coercion, \"r\"\n         -> Type       -- ^ t1 :: k1\n         -> Type       -- ^ t2 :: k2\n         -> Coercion   -- ^ :: t1 ~r t2\nmkUnivCo prov role ty1 ty2\n  | ty1 `eqType` ty2 = mkReflCo role ty1\n  | otherwise        = UnivCo prov role ty1 ty2\n\n-- | Create a symmetric version of the given 'Coercion' that asserts\n--   equality between the same types but in the other \"direction\", so\n--   a kind of @t1 ~ t2@ becomes the kind @t2 ~ t1@.\nmkSymCo :: Coercion -> Coercion\n\n-- Do a few simple optimizations, but don't bother pushing occurrences\n-- of symmetry to the leaves; the optimizer will take care of that.\nmkSymCo co | isReflCo co          = co\nmkSymCo    (SymCo co)             = co\nmkSymCo    (SubCo (SymCo co))     = SubCo co\nmkSymCo co                        = SymCo co\n\n-- | Create a new 'Coercion' by composing the two given 'Coercion's transitively.\n--   (co1 ; co2)\nmkTransCo :: Coercion -> Coercion -> Coercion\nmkTransCo co1 co2 | isReflCo co1 = co2\n                  | isReflCo co2 = co1\nmkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2))\n  = GRefl r t1 (MCo $ mkTransCo co1 co2)\nmkTransCo co1 co2                 = TransCo co1 co2\n\n-- | Compose two MCoercions via transitivity\nmkTransMCo :: MCoercion -> MCoercion -> MCoercion\nmkTransMCo MRefl     co2       = co2\nmkTransMCo co1       MRefl     = co1\nmkTransMCo (MCo co1) (MCo co2) = MCo (mkTransCo co1 co2)\n\nmkNthCo :: HasDebugCallStack\n        => Role  -- The role of the coercion you're creating\n        -> Int   -- Zero-indexed\n        -> Coercion\n        -> Coercion\nmkNthCo r n co\n  = ASSERT2( good_call, bad_call_msg )\n    go r n co\n  where\n    Pair ty1 ty2 = coercionKind co\n\n    go r 0 co\n      | Just (ty, _) <- isReflCo_maybe co\n      , Just (tv, _) <- splitForAllTy_maybe ty\n      = -- works for both tyvar and covar\n        ASSERT( r == Nominal )\n        mkNomReflCo (varType tv)\n\n    go r n co\n      | Just (ty, r0) <- isReflCo_maybe co\n      , let tc = tyConAppTyCon ty\n      = ASSERT2( ok_tc_app ty n, ppr n $$ ppr ty )\n        ASSERT( nthRole r0 tc n == r )\n        mkReflCo r (tyConAppArgN n ty)\n      where ok_tc_app :: Type -> Int -> Bool\n            ok_tc_app ty n\n              | Just (_, tys) <- splitTyConApp_maybe ty\n              = tys `lengthExceeds` n\n              | isForAllTy ty  -- nth:0 pulls out a kind coercion from a hetero forall\n              = n == 0\n              | otherwise\n              = False\n\n    go r 0 (ForAllCo _ kind_co _)\n      = ASSERT( r == Nominal )\n        kind_co\n      -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2)\n      -- then (nth 0 co :: k1 ~N k2)\n      -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2)\n      -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4))\n\n    go r n co@(FunCo r0 arg res)\n      -- See Note [Function coercions]\n      -- If FunCo _ arg_co res_co ::   (s1:TYPE sk1 -> s2:TYPE sk2)\n      --                             ~ (t1:TYPE tk1 -> t2:TYPE tk2)\n      -- Then we want to behave as if co was\n      --    TyConAppCo argk_co resk_co arg_co res_co\n      -- where\n      --    argk_co :: sk1 ~ tk1  =  mkNthCo 0 (mkKindCo arg_co)\n      --    resk_co :: sk2 ~ tk2  =  mkNthCo 0 (mkKindCo res_co)\n      --                             i.e. mkRuntimeRepCo\n      = case n of\n          0 -> ASSERT( r == Nominal ) mkRuntimeRepCo arg\n          1 -> ASSERT( r == Nominal ) mkRuntimeRepCo res\n          2 -> ASSERT( r == r0 )      arg\n          3 -> ASSERT( r == r0 )      res\n          _ -> pprPanic \"mkNthCo(FunCo)\" (ppr n $$ ppr co)\n\n    go r n (TyConAppCo r0 tc arg_cos) = ASSERT2( r == nthRole r0 tc n\n                                                    , (vcat [ ppr tc\n                                                            , ppr arg_cos\n                                                            , ppr r0\n                                                            , ppr n\n                                                            , ppr r ]) )\n                                             arg_cos `getNth` n\n\n    go r n co =\n      NthCo r n co\n\n    -- Assertion checking\n    bad_call_msg = vcat [ text \"Coercion =\" <+> ppr co\n                        , text \"LHS ty =\" <+> ppr ty1\n                        , text \"RHS ty =\" <+> ppr ty2\n                        , text \"n =\" <+> ppr n, text \"r =\" <+> ppr r\n                        , text \"coercion role =\" <+> ppr (coercionRole co) ]\n    good_call\n      -- If the Coercion passed in is between forall-types, then the Int must\n      -- be 0 and the role must be Nominal.\n      | Just (_tv1, _) <- splitForAllTy_maybe ty1\n      , Just (_tv2, _) <- splitForAllTy_maybe ty2\n      = n == 0 && r == Nominal\n\n      -- If the Coercion passed in is between T tys and T tys', then the Int\n      -- must be less than the length of tys/tys' (which must be the same\n      -- lengths).\n      --\n      -- If the role of the Coercion is nominal, then the role passed in must\n      -- be nominal. If the role of the Coercion is representational, then the\n      -- role passed in must be tyConRolesRepresentational T !! n. If the role\n      -- of the Coercion is Phantom, then the role passed in must be Phantom.\n      --\n      -- See also Note [NthCo Cached Roles] if you're wondering why it's\n      -- blaringly obvious that we should be *computing* this role instead of\n      -- passing it in.\n      | Just (tc1, tys1) <- splitTyConApp_maybe ty1\n      , Just (tc2, tys2) <- splitTyConApp_maybe ty2\n      , tc1 == tc2\n      = let len1 = length tys1\n            len2 = length tys2\n            good_role = case coercionRole co of\n                          Nominal -> r == Nominal\n                          Representational -> r == (tyConRolesRepresentational tc1 !! n)\n                          Phantom -> r == Phantom\n        in len1 == len2 && n < len1 && good_role\n\n      | otherwise\n      = True\n\n\n\n-- | If you're about to call @mkNthCo r n co@, then @r@ should be\n-- whatever @nthCoRole n co@ returns.\nnthCoRole :: Int -> Coercion -> Role\nnthCoRole n co\n  | Just (tc, _) <- splitTyConApp_maybe lty\n  = nthRole r tc n\n\n  | Just _ <- splitForAllTy_maybe lty\n  = Nominal\n\n  | otherwise\n  = pprPanic \"nthCoRole\" (ppr co)\n\n  where\n    (Pair lty _, r) = coercionKindRole co\n\nmkLRCo :: LeftOrRight -> Coercion -> Coercion\nmkLRCo lr co\n  | Just (ty, eq) <- isReflCo_maybe co\n  = mkReflCo eq (pickLR lr (splitAppTy ty))\n  | otherwise\n  = LRCo lr co\n\n-- | Instantiates a 'Coercion'.\nmkInstCo :: Coercion -> Coercion -> Coercion\nmkInstCo (ForAllCo tcv _kind_co body_co) co\n  | Just (arg, _) <- isReflCo_maybe co\n      -- works for both tyvar and covar\n  = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co\nmkInstCo co arg = InstCo co arg\n\n-- | Given @ty :: k1@, @co :: k1 ~ k2@,\n-- produces @co' :: ty ~r (ty |> co)@\nmkGReflRightCo :: Role -> Type -> CoercionN -> Coercion\nmkGReflRightCo r ty co\n  | isGReflCo co = mkReflCo r ty\n    -- the kinds of @k1@ and @k2@ are the same, thus @isGReflCo@\n    -- instead of @isReflCo@\n  | otherwise = GRefl r ty (MCo co)\n\n-- | Given @ty :: k1@, @co :: k1 ~ k2@,\n-- produces @co' :: (ty |> co) ~r ty@\nmkGReflLeftCo :: Role -> Type -> CoercionN -> Coercion\nmkGReflLeftCo r ty co\n  | isGReflCo co = mkReflCo r ty\n    -- the kinds of @k1@ and @k2@ are the same, thus @isGReflCo@\n    -- instead of @isReflCo@\n  | otherwise    = mkSymCo $ GRefl r ty (MCo co)\n\n-- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty ~r ty'@,\n-- produces @co' :: (ty |> co) ~r ty'\n-- It is not only a utility function, but it saves allocation when co\n-- is a GRefl coercion.\nmkCoherenceLeftCo :: Role -> Type -> CoercionN -> Coercion -> Coercion\nmkCoherenceLeftCo r ty co co2\n  | isGReflCo co = co2\n  | otherwise = (mkSymCo $ GRefl r ty (MCo co)) `mkTransCo` co2\n\n-- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty' ~r ty@,\n-- produces @co' :: ty' ~r (ty |> co)\n-- It is not only a utility function, but it saves allocation when co\n-- is a GRefl coercion.\nmkCoherenceRightCo :: Role -> Type -> CoercionN -> Coercion -> Coercion\nmkCoherenceRightCo r ty co co2\n  | isGReflCo co = co2\n  | otherwise = co2 `mkTransCo` GRefl r ty (MCo co)\n\n-- | Given @co :: (a :: k) ~ (b :: k')@ produce @co' :: k ~ k'@.\nmkKindCo :: Coercion -> Coercion\nmkKindCo co | Just (ty, _) <- isReflCo_maybe co = Refl (typeKind ty)\nmkKindCo (GRefl _ _ (MCo co)) = co\nmkKindCo (UnivCo (PhantomProv h) _ _ _)    = h\nmkKindCo (UnivCo (ProofIrrelProv h) _ _ _) = h\nmkKindCo co\n  | Pair ty1 ty2 <- coercionKind co\n       -- generally, calling coercionKind during coercion creation is a bad idea,\n       -- as it can lead to exponential behavior. But, we don't have nested mkKindCos,\n       -- so it's OK here.\n  , let tk1 = typeKind ty1\n        tk2 = typeKind ty2\n  , tk1 `eqType` tk2\n  = Refl tk1\n  | otherwise\n  = KindCo co\n\nmkSubCo :: Coercion -> Coercion\n-- Input coercion is Nominal, result is Representational\n-- see also Note [Role twiddling functions]\nmkSubCo (Refl ty) = GRefl Representational ty MRefl\nmkSubCo (GRefl Nominal ty co) = GRefl Representational ty co\nmkSubCo (TyConAppCo Nominal tc cos)\n  = TyConAppCo Representational tc (applyRoles tc cos)\nmkSubCo (FunCo Nominal arg res)\n  = FunCo Representational\n          (downgradeRole Representational Nominal arg)\n          (downgradeRole Representational Nominal res)\nmkSubCo co = ASSERT2( coercionRole co == Nominal, ppr co <+> ppr (coercionRole co) )\n             SubCo co\n\n-- | Changes a role, but only a downgrade. See Note [Role twiddling functions]\ndowngradeRole_maybe :: Role   -- ^ desired role\n                    -> Role   -- ^ current role\n                    -> Coercion -> Maybe Coercion\n-- In (downgradeRole_maybe dr cr co) it's a precondition that\n--                                   cr = coercionRole co\n\ndowngradeRole_maybe Nominal          Nominal          co = Just co\ndowngradeRole_maybe Nominal          _                _  = Nothing\n\ndowngradeRole_maybe Representational Nominal          co = Just (mkSubCo co)\ndowngradeRole_maybe Representational Representational co = Just co\ndowngradeRole_maybe Representational Phantom          _  = Nothing\n\ndowngradeRole_maybe Phantom          Phantom          co = Just co\ndowngradeRole_maybe Phantom          _                co = Just (toPhantomCo co)\n\n-- | Like 'downgradeRole_maybe', but panics if the change isn't a downgrade.\n-- See Note [Role twiddling functions]\ndowngradeRole :: Role  -- desired role\n              -> Role  -- current role\n              -> Coercion -> Coercion\ndowngradeRole r1 r2 co\n  = case downgradeRole_maybe r1 r2 co of\n      Just co' -> co'\n      Nothing  -> pprPanic \"downgradeRole\" (ppr co)\n\n-- | If the EqRel is ReprEq, makes a SubCo; otherwise, does nothing.\n-- Note that the input coercion should always be nominal.\nmaybeSubCo :: EqRel -> Coercion -> Coercion\nmaybeSubCo NomEq  = id\nmaybeSubCo ReprEq = mkSubCo\n\n\nmkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion\nmkAxiomRuleCo = AxiomRuleCo\n\n-- | Make a \"coercion between coercions\".\nmkProofIrrelCo :: Role       -- ^ role of the created coercion, \"r\"\n               -> Coercion   -- ^ :: phi1 ~N phi2\n               -> Coercion   -- ^ g1 :: phi1\n               -> Coercion   -- ^ g2 :: phi2\n               -> Coercion   -- ^ :: g1 ~r g2\n\n-- if the two coercion prove the same fact, I just don't care what\n-- the individual coercions are.\nmkProofIrrelCo r co g  _ | isGReflCo co  = mkReflCo r (mkCoercionTy g)\n  -- kco is a kind coercion, thus @isGReflCo@ rather than @isReflCo@\nmkProofIrrelCo r kco        g1 g2 = mkUnivCo (ProofIrrelProv kco) r\n                                             (mkCoercionTy g1) (mkCoercionTy g2)\n\n{-\n%************************************************************************\n%*                                                                      *\n   Roles\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | Converts a coercion to be nominal, if possible.\n-- See Note [Role twiddling functions]\nsetNominalRole_maybe :: Role -- of input coercion\n                     -> Coercion -> Maybe Coercion\nsetNominalRole_maybe r co\n  | r == Nominal = Just co\n  | otherwise = setNominalRole_maybe_helper co\n  where\n    setNominalRole_maybe_helper (SubCo co)  = Just co\n    setNominalRole_maybe_helper co@(Refl _) = Just co\n    setNominalRole_maybe_helper (GRefl _ ty co) = Just $ GRefl Nominal ty co\n    setNominalRole_maybe_helper (TyConAppCo Representational tc cos)\n      = do { cos' <- zipWithM setNominalRole_maybe (tyConRolesX Representational tc) cos\n           ; return $ TyConAppCo Nominal tc cos' }\n    setNominalRole_maybe_helper (FunCo Representational co1 co2)\n      = do { co1' <- setNominalRole_maybe Representational co1\n           ; co2' <- setNominalRole_maybe Representational co2\n           ; return $ FunCo Nominal co1' co2'\n           }\n    setNominalRole_maybe_helper (SymCo co)\n      = SymCo <$> setNominalRole_maybe_helper co\n    setNominalRole_maybe_helper (TransCo co1 co2)\n      = TransCo <$> setNominalRole_maybe_helper co1 <*> setNominalRole_maybe_helper co2\n    setNominalRole_maybe_helper (AppCo co1 co2)\n      = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2\n    setNominalRole_maybe_helper (ForAllCo tv kind_co co)\n      = ForAllCo tv kind_co <$> setNominalRole_maybe_helper co\n    setNominalRole_maybe_helper (NthCo _r n co)\n      -- NB, this case recurses via setNominalRole_maybe, not\n      -- setNominalRole_maybe_helper!\n      = NthCo Nominal n <$> setNominalRole_maybe (coercionRole co) co\n    setNominalRole_maybe_helper (InstCo co arg)\n      = InstCo <$> setNominalRole_maybe_helper co <*> pure arg\n    setNominalRole_maybe_helper (UnivCo prov _ co1 co2)\n      | case prov of UnsafeCoerceProv -> True   -- it's always unsafe\n                     PhantomProv _    -> False  -- should always be phantom\n                     ProofIrrelProv _ -> True   -- it's always safe\n                     PluginProv _     -> False  -- who knows? This choice is conservative.\n      = Just $ UnivCo prov Nominal co1 co2\n    setNominalRole_maybe_helper _ = Nothing\n\n-- | Make a phantom coercion between two types. The coercion passed\n-- in must be a nominal coercion between the kinds of the\n-- types.\nmkPhantomCo :: Coercion -> Type -> Type -> Coercion\nmkPhantomCo h t1 t2\n  = mkUnivCo (PhantomProv h) Phantom t1 t2\n\n-- takes any coercion and turns it into a Phantom coercion\ntoPhantomCo :: Coercion -> Coercion\ntoPhantomCo co\n  = mkPhantomCo (mkKindCo co) ty1 ty2\n  where Pair ty1 ty2 = coercionKind co\n\n-- Convert args to a TyConAppCo Nominal to the same TyConAppCo Representational\napplyRoles :: TyCon -> [Coercion] -> [Coercion]\napplyRoles tc cos\n  = zipWith (\\r -> downgradeRole r Nominal) (tyConRolesRepresentational tc) cos\n\n-- the Role parameter is the Role of the TyConAppCo\n-- defined here because this is intimately concerned with the implementation\n-- of TyConAppCo\n-- Always returns an infinite list (with a infinite tail of Nominal)\ntyConRolesX :: Role -> TyCon -> [Role]\ntyConRolesX Representational tc = tyConRolesRepresentational tc\ntyConRolesX role             _  = repeat role\n\n-- Returns the roles of the parameters of a tycon, with an infinite tail\n-- of Nominal\ntyConRolesRepresentational :: TyCon -> [Role]\ntyConRolesRepresentational tc = tyConRoles tc ++ repeat Nominal\n\nnthRole :: Role -> TyCon -> Int -> Role\nnthRole Nominal _ _ = Nominal\nnthRole Phantom _ _ = Phantom\nnthRole Representational tc n\n  = (tyConRolesRepresentational tc) `getNth` n\n\nltRole :: Role -> Role -> Bool\n-- Is one role \"less\" than another?\n--     Nominal < Representational < Phantom\nltRole Phantom          _       = False\nltRole Representational Phantom = True\nltRole Representational _       = False\nltRole Nominal          Nominal = False\nltRole Nominal          _       = True\n\n-------------------------------\n\n-- | like mkKindCo, but aggressively & recursively optimizes to avoid using\n-- a KindCo constructor. The output role is nominal.\npromoteCoercion :: Coercion -> CoercionN\n\n-- First cases handles anything that should yield refl.\npromoteCoercion co = case co of\n\n    _ | ki1 `eqType` ki2\n      -> mkNomReflCo (typeKind ty1)\n     -- no later branch should return refl\n     --    The ASSERT( False )s throughout\n     -- are these cases explicitly, but they should never fire.\n\n    Refl _ -> ASSERT( False )\n              mkNomReflCo ki1\n\n    GRefl _ _ MRefl -> ASSERT( False )\n                       mkNomReflCo ki1\n\n    GRefl _ _ (MCo co) -> co\n\n    TyConAppCo _ tc args\n      | Just co' <- instCoercions (mkNomReflCo (tyConKind tc)) args\n      -> co'\n      | otherwise\n      -> mkKindCo co\n\n    AppCo co1 arg\n      | Just co' <- instCoercion (coercionKind (mkKindCo co1))\n                                 (promoteCoercion co1) arg\n      -> co'\n      | otherwise\n      -> mkKindCo co\n\n    ForAllCo tv _ g\n      | isTyVar tv\n      -> promoteCoercion g\n\n    ForAllCo _ _ _\n      -> ASSERT( False )\n         mkNomReflCo liftedTypeKind\n      -- See Note [Weird typing rule for ForAllTy] in Type\n\n    FunCo _ _ _\n      -> ASSERT( False )\n         mkNomReflCo liftedTypeKind\n\n    CoVarCo {}     -> mkKindCo co\n    HoleCo {}      -> mkKindCo co\n    AxiomInstCo {} -> mkKindCo co\n    AxiomRuleCo {} -> mkKindCo co\n\n    UnivCo UnsafeCoerceProv _ t1 t2   -> mkUnsafeCo Nominal (typeKind t1) (typeKind t2)\n    UnivCo (PhantomProv kco) _ _ _    -> kco\n    UnivCo (ProofIrrelProv kco) _ _ _ -> kco\n    UnivCo (PluginProv _) _ _ _       -> mkKindCo co\n\n    SymCo g\n      -> mkSymCo (promoteCoercion g)\n\n    TransCo co1 co2\n      -> mkTransCo (promoteCoercion co1) (promoteCoercion co2)\n\n    NthCo _ n co1\n      | Just (_, args) <- splitTyConAppCo_maybe co1\n      , args `lengthExceeds` n\n      -> promoteCoercion (args !! n)\n\n      | Just _ <- splitForAllCo_maybe co\n      , n == 0\n      -> ASSERT( False ) mkNomReflCo liftedTypeKind\n\n      | otherwise\n      -> mkKindCo co\n\n    LRCo lr co1\n      | Just (lco, rco) <- splitAppCo_maybe co1\n      -> case lr of\n           CLeft  -> promoteCoercion lco\n           CRight -> promoteCoercion rco\n\n      | otherwise\n      -> mkKindCo co\n\n    InstCo g _\n      | isForAllTy_ty ty1\n      -> ASSERT( isForAllTy_ty ty2 )\n         promoteCoercion g\n      | otherwise\n      -> ASSERT( False)\n         mkNomReflCo liftedTypeKind\n           -- See Note [Weird typing rule for ForAllTy] in Type\n\n    KindCo _\n      -> ASSERT( False )\n         mkNomReflCo liftedTypeKind\n\n    SubCo g\n      -> promoteCoercion g\n\n  where\n    Pair ty1 ty2 = coercionKind co\n    ki1 = typeKind ty1\n    ki2 = typeKind ty2\n\n-- | say @g = promoteCoercion h@. Then, @instCoercion g w@ yields @Just g'@,\n-- where @g' = promoteCoercion (h w)@.\n-- fails if this is not possible, if @g@ coerces between a forall and an ->\n-- or if second parameter has a representational role and can't be used\n-- with an InstCo.\ninstCoercion :: Pair Type -- g :: lty ~ rty\n             -> CoercionN  -- ^  must be nominal\n             -> Coercion\n             -> Maybe CoercionN\ninstCoercion (Pair lty rty) g w\n  | (isForAllTy_ty lty && isForAllTy_ty rty)\n  || (isForAllTy_co lty && isForAllTy_co rty)\n  , Just w' <- setNominalRole_maybe (coercionRole w) w\n    -- g :: (forall t1. t2) ~ (forall t1. t3)\n    -- w :: s1 ~ s2\n    -- returns mkInstCo g w' :: t2 [t1 |-> s1 ] ~ t3 [t1 |-> s2]\n  = Just $ mkInstCo g w'\n  | isFunTy lty && isFunTy rty\n    -- g :: (t1 -> t2) ~ (t3 -> t4)\n    -- returns t2 ~ t4\n  = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->)\n  | otherwise -- one forall, one funty...\n  = Nothing\n\n-- | Repeated use of 'instCoercion'\ninstCoercions :: CoercionN -> [Coercion] -> Maybe CoercionN\ninstCoercions g ws\n  = let arg_ty_pairs = map coercionKind ws in\n    snd <$> foldM go (coercionKind g, g) (zip arg_ty_pairs ws)\n  where\n    go :: (Pair Type, Coercion) -> (Pair Type, Coercion)\n       -> Maybe (Pair Type, Coercion)\n    go (g_tys, g) (w_tys, w)\n      = do { g' <- instCoercion g_tys g w\n           ; return (piResultTy <$> g_tys <*> w_tys, g') }\n\n-- | Creates a new coercion with both of its types casted by different casts\n-- @castCoercionKind g r t1 t2 h1 h2@, where @g :: t1 ~r t2@,\n-- has type @(t1 |> h1) ~r (t2 |> h2)@.\n-- @h1@ and @h2@ must be nominal.\ncastCoercionKind :: Coercion -> Role -> Type -> Type\n                 -> CoercionN -> CoercionN -> Coercion\ncastCoercionKind g r t1 t2 h1 h2\n  = mkCoherenceRightCo r t2 h2 (mkCoherenceLeftCo r t1 h1 g)\n\n-- | Creates a new coercion with both of its types casted by different casts\n-- @castCoercionKind g h1 h2@, where @g :: t1 ~r t2@,\n-- has type @(t1 |> h1) ~r (t2 |> h2)@.\n-- @h1@ and @h2@ must be nominal.\n-- It calls @coercionKindRole@, so it's quite inefficient (which 'I' stands for)\n-- Use @castCoercionKind@ instead if @t1@, @t2@, and @r@ are known beforehand.\ncastCoercionKindI :: Coercion -> CoercionN -> CoercionN -> Coercion\ncastCoercionKindI g h1 h2\n  = mkCoherenceRightCo r t2 h2 (mkCoherenceLeftCo r t1 h1 g)\n  where (Pair t1 t2, r) = coercionKindRole g\n\n-- See note [Newtype coercions] in TyCon\n\nmkPiCos :: Role -> [Var] -> Coercion -> Coercion\nmkPiCos r vs co = foldr (mkPiCo r) co vs\n\n-- | Make a forall 'Coercion', where both types related by the coercion\n-- are quantified over the same variable.\nmkPiCo  :: Role -> Var -> Coercion -> Coercion\nmkPiCo r v co | isTyVar v = mkHomoForAllCos [v] co\n              | isCoVar v = ASSERT( not (v `elemVarSet` tyCoVarsOfCo co) )\n                  -- We didn't call mkForAllCo here because if v does not appear\n                  -- in co, the argement coercion will be nominal. But here we\n                  -- want it to be r. It is only called in 'mkPiCos', which is\n                  -- only used in SimplUtils, where we are sure for\n                  -- now (Aug 2018) v won't occur in co.\n                            mkFunCo r (mkReflCo r (varType v)) co\n              | otherwise = mkFunCo r (mkReflCo r (varType v)) co\n\n-- mkCoCast (c :: s1 ~?r t1) (g :: (s1 ~?r t1) ~#R (s2 ~?r t2)) :: s2 ~?r t2\n-- The first coercion might be lifted or unlifted; thus the ~? above\n-- Lifted and unlifted equalities take different numbers of arguments,\n-- so we have to make sure to supply the right parameter to decomposeCo.\n-- Also, note that the role of the first coercion is the same as the role of\n-- the equalities related by the second coercion. The second coercion is\n-- itself always representational.\nmkCoCast :: Coercion -> CoercionR -> Coercion\nmkCoCast c g\n  | (g2:g1:_) <- reverse co_list\n  = mkSymCo g1 `mkTransCo` c `mkTransCo` g2\n\n  | otherwise\n  = pprPanic \"mkCoCast\" (ppr g $$ ppr (coercionKind g))\n  where\n    -- g  :: (s1 ~# t1) ~# (s2 ~# t2)\n    -- g1 :: s1 ~# s2\n    -- g2 :: t1 ~# t2\n    (tc, _) = splitTyConApp (pFst $ coercionKind g)\n    co_list = decomposeCo (tyConArity tc) g (tyConRolesRepresentational tc)\n\n{-\n%************************************************************************\n%*                                                                      *\n            Newtypes\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | If @co :: T ts ~ rep_ty@ then:\n--\n-- > instNewTyCon_maybe T ts = Just (rep_ty, co)\n--\n-- Checks for a newtype, and for being saturated\ninstNewTyCon_maybe :: TyCon -> [Type] -> Maybe (Type, Coercion)\ninstNewTyCon_maybe tc tys\n  | Just (tvs, ty, co_tc) <- unwrapNewTyConEtad_maybe tc  -- Check for newtype\n  , tvs `leLength` tys                                    -- Check saturated enough\n  = Just (applyTysX tvs ty tys, mkUnbranchedAxInstCo Representational co_tc tys [])\n  | otherwise\n  = Nothing\n\n{-\n************************************************************************\n*                                                                      *\n         Type normalisation\n*                                                                      *\n************************************************************************\n-}\n\n-- | A function to check if we can reduce a type by one step. Used\n-- with 'topNormaliseTypeX'.\ntype NormaliseStepper ev = RecTcChecker\n                         -> TyCon     -- tc\n                         -> [Type]    -- tys\n                         -> NormaliseStepResult ev\n\n-- | The result of stepping in a normalisation function.\n-- See 'topNormaliseTypeX'.\ndata NormaliseStepResult ev\n  = NS_Done   -- ^ Nothing more to do\n  | NS_Abort  -- ^ Utter failure. The outer function should fail too.\n  | NS_Step RecTcChecker Type ev    -- ^ We stepped, yielding new bits;\n                                    -- ^ ev is evidence;\n                                    -- Usually a co :: old type ~ new type\n\nmapStepResult :: (ev1 -> ev2)\n              -> NormaliseStepResult ev1 -> NormaliseStepResult ev2\nmapStepResult f (NS_Step rec_nts ty ev) = NS_Step rec_nts ty (f ev)\nmapStepResult _ NS_Done                 = NS_Done\nmapStepResult _ NS_Abort                = NS_Abort\n\n-- | Try one stepper and then try the next, if the first doesn't make\n-- progress.\n-- So if it returns NS_Done, it means that both steppers are satisfied\ncomposeSteppers :: NormaliseStepper ev -> NormaliseStepper ev\n                -> NormaliseStepper ev\ncomposeSteppers step1 step2 rec_nts tc tys\n  = case step1 rec_nts tc tys of\n      success@(NS_Step {}) -> success\n      NS_Done              -> step2 rec_nts tc tys\n      NS_Abort             -> NS_Abort\n\n-- | A 'NormaliseStepper' that unwraps newtypes, careful not to fall into\n-- a loop. If it would fall into a loop, it produces 'NS_Abort'.\nunwrapNewTypeStepper :: NormaliseStepper Coercion\nunwrapNewTypeStepper rec_nts tc tys\n  | Just (ty', co) <- instNewTyCon_maybe tc tys\n  = case checkRecTc rec_nts tc of\n      Just rec_nts' -> NS_Step rec_nts' ty' co\n      Nothing       -> NS_Abort\n\n  | otherwise\n  = NS_Done\n\n-- | A general function for normalising the top-level of a type. It continues\n-- to use the provided 'NormaliseStepper' until that function fails, and then\n-- this function returns. The roles of the coercions produced by the\n-- 'NormaliseStepper' must all be the same, which is the role returned from\n-- the call to 'topNormaliseTypeX'.\n--\n-- Typically ev is Coercion.\n--\n-- If topNormaliseTypeX step plus ty = Just (ev, ty')\n-- then ty ~ev1~ t1 ~ev2~ t2 ... ~evn~ ty'\n-- and ev = ev1 `plus` ev2 `plus` ... `plus` evn\n-- If it returns Nothing then no newtype unwrapping could happen\ntopNormaliseTypeX :: NormaliseStepper ev -> (ev -> ev -> ev)\n                  -> Type -> Maybe (ev, Type)\ntopNormaliseTypeX stepper plus ty\n | Just (tc, tys) <- splitTyConApp_maybe ty\n , NS_Step rec_nts ty' ev <- stepper initRecTc tc tys\n = go rec_nts ev ty'\n | otherwise\n = Nothing\n where\n    go rec_nts ev ty\n      | Just (tc, tys) <- splitTyConApp_maybe ty\n      = case stepper rec_nts tc tys of\n          NS_Step rec_nts' ty' ev' -> go rec_nts' (ev `plus` ev') ty'\n          NS_Done  -> Just (ev, ty)\n          NS_Abort -> Nothing\n\n      | otherwise\n      = Just (ev, ty)\n\ntopNormaliseNewType_maybe :: Type -> Maybe (Coercion, Type)\n-- ^ Sometimes we want to look through a @newtype@ and get its associated coercion.\n-- This function strips off @newtype@ layers enough to reveal something that isn't\n-- a @newtype@.  Specifically, here's the invariant:\n--\n-- > topNormaliseNewType_maybe rec_nts ty = Just (co, ty')\n--\n-- then (a)  @co : ty0 ~ ty'@.\n--      (b)  ty' is not a newtype.\n--\n-- The function returns @Nothing@ for non-@newtypes@,\n-- or unsaturated applications\n--\n-- This function does *not* look through type families, because it has no access to\n-- the type family environment. If you do have that at hand, consider to use\n-- topNormaliseType_maybe, which should be a drop-in replacement for\n-- topNormaliseNewType_maybe\n-- If topNormliseNewType_maybe ty = Just (co, ty'), then co : ty ~R ty'\ntopNormaliseNewType_maybe ty\n  = topNormaliseTypeX unwrapNewTypeStepper mkTransCo ty\n\n{-\n%************************************************************************\n%*                                                                      *\n                   Comparison of coercions\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | Syntactic equality of coercions\neqCoercion :: Coercion -> Coercion -> Bool\neqCoercion = eqType `on` coercionType\n\n-- | Compare two 'Coercion's, with respect to an RnEnv2\neqCoercionX :: RnEnv2 -> Coercion -> Coercion -> Bool\neqCoercionX env = eqTypeX env `on` coercionType\n\n{-\n%************************************************************************\n%*                                                                      *\n                   \"Lifting\" substitution\n           [(TyCoVar,Coercion)] -> Type -> Coercion\n%*                                                                      *\n%************************************************************************\n\nNote [Lifting coercions over types: liftCoSubst]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe KPUSH rule deals with this situation\n   data T a = K (a -> Maybe a)\n   g :: T t1 ~ T t2\n   x :: t1 -> Maybe t1\n\n   case (K @t1 x) |> g of\n     K (y:t2 -> Maybe t2) -> rhs\n\nWe want to push the coercion inside the constructor application.\nSo we do this\n\n   g' :: t1~t2  =  Nth 0 g\n\n   case K @t2 (x |> g' -> Maybe g') of\n     K (y:t2 -> Maybe t2) -> rhs\n\nThe crucial operation is that we\n  * take the type of K's argument: a -> Maybe a\n  * and substitute g' for a\nthus giving *coercion*.  This is what liftCoSubst does.\n\nIn the presence of kind coercions, this is a bit\nof a hairy operation. So, we refer you to the paper introducing kind coercions,\navailable at www.cis.upenn.edu/~sweirich/papers/fckinds-extended.pdf\n\nNote [extendLiftingContextEx]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider we have datatype\n  K :: \\/k. \\/a::k. P -> T k  -- P be some type\n  g :: T k1 ~ T k2\n\n  case (K @k1 @t1 x) |> g of\n    K y -> rhs\n\nWe want to push the coercion inside the constructor application.\nWe first get the coercion mapped by the universal type variable k:\n   lc = k |-> Nth 0 g :: k1~k2\n\nHere, the important point is that the kind of a is coerced, and P might be\ndependent on the existential type variable a.\nThus we first get the coercion of a's kind\n   g2 = liftCoSubst lc k :: k1 ~ k2\n\nThen we store a new mapping into the lifting context\n   lc2 = a |-> (t1 ~ t1 |> g2), lc\n\nSo later when we can correctly deal with the argument type P\n   liftCoSubst lc2 P :: P [k|->k1][a|->t1] ~ P[k|->k2][a |-> (t1|>g2)]\n\nThis is exactly what extendLiftingContextEx does.\n* For each (tyvar:k, ty) pair, we product the mapping\n    tyvar |-> (ty ~ ty |> (liftCoSubst lc k))\n* For each (covar:s1~s2, ty) pair, we produce the mapping\n    covar |-> (co ~ co')\n    co' = Sym (liftCoSubst lc s1) ;; covar ;; liftCoSubst lc s2 :: s1'~s2'\n\nThis follows the lifting context extension definition in the\n\"FC with Explicit Kind Equality\" paper.\n-}\n\n-- ----------------------------------------------------\n-- See Note [Lifting coercions over types: liftCoSubst]\n-- ----------------------------------------------------\n\ndata LiftingContext = LC TCvSubst LiftCoEnv\n  -- in optCoercion, we need to lift when optimizing InstCo.\n  -- See Note [Optimising InstCo] in OptCoercion\n  -- We thus propagate the substitution from OptCoercion here.\n\ninstance Outputable LiftingContext where\n  ppr (LC _ env) = hang (text \"LiftingContext:\") 2 (ppr env)\n\ntype LiftCoEnv = VarEnv Coercion\n     -- Maps *type variables* to *coercions*.\n     -- That's the whole point of this function!\n     -- Also maps coercion variables to ProofIrrelCos.\n\n-- like liftCoSubstWith, but allows for existentially-bound types as well\nliftCoSubstWithEx :: Role          -- desired role for output coercion\n                  -> [TyVar]       -- universally quantified tyvars\n                  -> [Coercion]    -- coercions to substitute for those\n                  -> [TyCoVar]     -- existentially quantified tycovars\n                  -> [Type]        -- types and coercions to be bound to ex vars\n                  -> (Type -> Coercion, [Type]) -- (lifting function, converted ex args)\nliftCoSubstWithEx role univs omegas exs rhos\n  = let theta = mkLiftingContext (zipEqual \"liftCoSubstWithExU\" univs omegas)\n        psi   = extendLiftingContextEx theta (zipEqual \"liftCoSubstWithExX\" exs rhos)\n    in (ty_co_subst psi role, substTys (lcSubstRight psi) (mkTyCoVarTys exs))\n\nliftCoSubstWith :: Role -> [TyCoVar] -> [Coercion] -> Type -> Coercion\nliftCoSubstWith r tvs cos ty\n  = liftCoSubst r (mkLiftingContext $ zipEqual \"liftCoSubstWith\" tvs cos) ty\n\n-- | @liftCoSubst role lc ty@ produces a coercion (at role @role@)\n-- that coerces between @lc_left(ty)@ and @lc_right(ty)@, where\n-- @lc_left@ is a substitution mapping type variables to the left-hand\n-- types of the mapped coercions in @lc@, and similar for @lc_right@.\nliftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion\nliftCoSubst r lc@(LC subst env) ty\n  | isEmptyVarEnv env = mkReflCo r (substTy subst ty)\n  | otherwise         = ty_co_subst lc r ty\n\nemptyLiftingContext :: InScopeSet -> LiftingContext\nemptyLiftingContext in_scope = LC (mkEmptyTCvSubst in_scope) emptyVarEnv\n\nmkLiftingContext :: [(TyCoVar,Coercion)] -> LiftingContext\nmkLiftingContext pairs\n  = LC (mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfCos (map snd pairs))\n       (mkVarEnv pairs)\n\nmkSubstLiftingContext :: TCvSubst -> LiftingContext\nmkSubstLiftingContext subst = LC subst emptyVarEnv\n\n-- | Extend a lifting context with a new mapping.\nextendLiftingContext :: LiftingContext  -- ^ original LC\n                     -> TyCoVar         -- ^ new variable to map...\n                     -> Coercion        -- ^ ...to this lifted version\n                     -> LiftingContext\n    -- mappings to reflexive coercions are just substitutions\nextendLiftingContext (LC subst env) tv arg\n  | Just (ty, _) <- isReflCo_maybe arg\n  = LC (extendTCvSubst subst tv ty) env\n  | otherwise\n  = LC subst (extendVarEnv env tv arg)\n\n-- | Extend a lifting context with a new mapping, and extend the in-scope set\nextendLiftingContextAndInScope :: LiftingContext  -- ^ Original LC\n                               -> TyCoVar         -- ^ new variable to map...\n                               -> Coercion        -- ^ to this coercion\n                               -> LiftingContext\nextendLiftingContextAndInScope (LC subst env) tv co\n  = extendLiftingContext (LC (extendTCvInScopeSet subst (tyCoVarsOfCo co)) env) tv co\n\n-- | Extend a lifting context with existential-variable bindings.\n-- See Note [extendLiftingContextEx]\nextendLiftingContextEx :: LiftingContext    -- ^ original lifting context\n                       -> [(TyCoVar,Type)]  -- ^ ex. var / value pairs\n                       -> LiftingContext\n-- Note that this is more involved than extendLiftingContext. That function\n-- takes a coercion to extend with, so it's assumed that the caller has taken\n-- into account any of the kind-changing stuff worried about here.\nextendLiftingContextEx lc [] = lc\nextendLiftingContextEx lc@(LC subst env) ((v,ty):rest)\n-- This function adds bindings for *Nominal* coercions. Why? Because it\n-- works with existentially bound variables, which are considered to have\n-- nominal roles.\n  | isTyVar v\n  = let lc' = LC (subst `extendTCvInScopeSet` tyCoVarsOfType ty)\n                 (extendVarEnv env v $\n                  mkGReflRightCo Nominal\n                                 ty\n                                 (ty_co_subst lc Nominal (tyVarKind v)))\n    in extendLiftingContextEx lc' rest\n  | CoercionTy co <- ty\n  = -- co      :: s1 ~r s2\n    -- lift_s1 :: s1 ~r s1'\n    -- lift_s2 :: s2 ~r s2'\n    -- kco     :: (s1 ~r s2) ~N (s1' ~r s2')\n    ASSERT( isCoVar v )\n    let (_, _, s1, s2, r) = coVarKindsTypesRole v\n        lift_s1 = ty_co_subst lc r s1\n        lift_s2 = ty_co_subst lc r s2\n        kco     = mkTyConAppCo Nominal (equalityTyCon r)\n                               [ mkKindCo lift_s1, mkKindCo lift_s2\n                               , lift_s1         , lift_s2          ]\n        lc'     = LC (subst `extendTCvInScopeSet` tyCoVarsOfCo co)\n                     (extendVarEnv env v\n                        (mkProofIrrelCo Nominal kco co $\n                          (mkSymCo lift_s1) `mkTransCo` co `mkTransCo` lift_s2))\n    in extendLiftingContextEx lc' rest\n  | otherwise\n  = pprPanic \"extendLiftingContextEx\" (ppr v <+> text \"|->\" <+> ppr ty)\n\n\n-- | Erase the environments in a lifting context\nzapLiftingContext :: LiftingContext -> LiftingContext\nzapLiftingContext (LC subst _) = LC (zapTCvSubst subst) emptyVarEnv\n\n-- | Like 'substForAllCoBndr', but works on a lifting context\nsubstForAllCoBndrUsingLC :: Bool\n                            -> (Coercion -> Coercion)\n                            -> LiftingContext -> TyCoVar -> Coercion\n                            -> (LiftingContext, TyCoVar, Coercion)\nsubstForAllCoBndrUsingLC sym sco (LC subst lc_env) tv co\n  = (LC subst' lc_env, tv', co')\n  where\n    (subst', tv', co') = substForAllCoBndrUsing sym sco subst tv co\n\n-- | The \\\"lifting\\\" operation which substitutes coercions for type\n--   variables in a type to produce a coercion.\n--\n--   For the inverse operation, see 'liftCoMatch'\nty_co_subst :: LiftingContext -> Role -> Type -> Coercion\nty_co_subst lc role ty\n  = go role ty\n  where\n    go :: Role -> Type -> Coercion\n    go r ty                | Just ty' <- coreView ty\n                           = go r ty'\n    go Phantom ty          = lift_phantom ty\n    go r (TyVarTy tv)      = expectJust \"ty_co_subst bad roles\" $\n                             liftCoSubstTyVar lc r tv\n    go r (AppTy ty1 ty2)   = mkAppCo (go r ty1) (go Nominal ty2)\n    go r (TyConApp tc tys) = mkTyConAppCo r tc (zipWith go (tyConRolesX r tc) tys)\n    go r (FunTy _ ty1 ty2) = mkFunCo r (go r ty1) (go r ty2)\n    go r t@(ForAllTy (Bndr v _) ty)\n       = let (lc', v', h) = liftCoSubstVarBndr lc v\n             body_co = ty_co_subst lc' r ty in\n         if isTyVar v' || almostDevoidCoVarOfCo v' body_co\n           -- Lifting a ForAllTy over a coercion variable could fail as ForAllCo\n           -- imposes an extra restriction on where a covar can appear. See last\n           -- wrinkle in Note [Unused coercion variable in ForAllCo].\n           -- We specifically check for this and panic because we know that\n           -- there's a hole in the type system here, and we'd rather panic than\n           -- fall into it.\n         then mkForAllCo v' h body_co\n         else pprPanic \"ty_co_subst: covar is not almost devoid\" (ppr t)\n    go r ty@(LitTy {})     = ASSERT( r == Nominal )\n                             mkNomReflCo ty\n    go r (CastTy ty co)    = castCoercionKindI (go r ty) (substLeftCo lc co)\n                                                         (substRightCo lc co)\n    go r (CoercionTy co)   = mkProofIrrelCo r kco (substLeftCo lc co)\n                                                  (substRightCo lc co)\n      where kco = go Nominal (coercionType co)\n\n    lift_phantom ty = mkPhantomCo (go Nominal (typeKind ty))\n                                  (substTy (lcSubstLeft  lc) ty)\n                                  (substTy (lcSubstRight lc) ty)\n\n{-\nNote [liftCoSubstTyVar]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nThis function can fail if a coercion in the environment is of too low a role.\n\nliftCoSubstTyVar is called from two places: in liftCoSubst (naturally), and\nalso in matchAxiom in OptCoercion. From liftCoSubst, the so-called lifting\nlemma guarantees that the roles work out. If we fail in this\ncase, we really should panic -- something is deeply wrong. But, in matchAxiom,\nfailing is fine. matchAxiom is trying to find a set of coercions\nthat match, but it may fail, and this is healthy behavior.\n-}\n\n-- See Note [liftCoSubstTyVar]\nliftCoSubstTyVar :: LiftingContext -> Role -> TyVar -> Maybe Coercion\nliftCoSubstTyVar (LC subst env) r v\n  | Just co_arg <- lookupVarEnv env v\n  = downgradeRole_maybe r (coercionRole co_arg) co_arg\n\n  | otherwise\n  = Just $ mkReflCo r (substTyVar subst v)\n\n{- Note [liftCoSubstVarBndr]\n\ncallback:\n  We want 'liftCoSubstVarBndrUsing' to be general enough to be reused in\n  FamInstEnv, therefore the input arg 'fun' returns a pair with polymophic type\n  in snd.\n  However in 'liftCoSubstVarBndr', we don't need the snd, so we use unit and\n  ignore the fourth component of the return value.\n\nliftCoSubstTyVarBndrUsing:\n  Given\n    forall tv:k. t\n  We want to get\n    forall (tv:k1) (kind_co :: k1 ~ k2) body_co\n\n  We lift the kind k to get the kind_co\n    kind_co = ty_co_subst k :: k1 ~ k2\n\n  Now in the LiftingContext, we add the new mapping\n    tv |-> (tv :: k1) ~ ((tv |> kind_co) :: k2)\n\nliftCoSubstCoVarBndrUsing:\n  Given\n    forall cv:(s1 ~ s2). t\n  We want to get\n    forall (cv:s1'~s2') (kind_co :: (s1'~s2') ~ (t1 ~ t2)) body_co\n\n  We lift s1 and s2 respectively to get\n    eta1 :: s1' ~ t1\n    eta2 :: s2' ~ t2\n  And\n    kind_co = TyConAppCo Nominal (~#) eta1 eta2\n\n  Now in the liftingContext, we add the new mapping\n    cv |-> (cv :: s1' ~ s2') ~ ((sym eta1;cv;eta2) :: t1 ~ t2)\n-}\n\n-- See Note [liftCoSubstVarBndr]\nliftCoSubstVarBndr :: LiftingContext -> TyCoVar\n                   -> (LiftingContext, TyCoVar, Coercion)\nliftCoSubstVarBndr lc tv\n  = let (lc', tv', h, _) = liftCoSubstVarBndrUsing callback lc tv in\n    (lc', tv', h)\n  where\n    callback lc' ty' = (ty_co_subst lc' Nominal ty', ())\n\n-- the callback must produce a nominal coercion\nliftCoSubstVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))\n                           -> LiftingContext -> TyCoVar\n                           -> (LiftingContext, TyCoVar, CoercionN, a)\nliftCoSubstVarBndrUsing fun lc old_var\n  | isTyVar old_var\n  = liftCoSubstTyVarBndrUsing fun lc old_var\n  | otherwise\n  = liftCoSubstCoVarBndrUsing fun lc old_var\n\n-- Works for tyvar binder\nliftCoSubstTyVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))\n                           -> LiftingContext -> TyVar\n                           -> (LiftingContext, TyVar, CoercionN, a)\nliftCoSubstTyVarBndrUsing fun lc@(LC subst cenv) old_var\n  = ASSERT( isTyVar old_var )\n    ( LC (subst `extendTCvInScope` new_var) new_cenv\n    , new_var, eta, stuff )\n  where\n    old_kind     = tyVarKind old_var\n    (eta, stuff) = fun lc old_kind\n    Pair k1 _    = coercionKind eta\n    new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)\n\n    lifted   = mkGReflRightCo Nominal (TyVarTy new_var) eta\n               -- :: new_var ~ new_var |> eta\n    new_cenv = extendVarEnv cenv old_var lifted\n\n-- Works for covar binder\nliftCoSubstCoVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))\n                           -> LiftingContext -> CoVar\n                           -> (LiftingContext, CoVar, CoercionN, a)\nliftCoSubstCoVarBndrUsing fun lc@(LC subst cenv) old_var\n  = ASSERT( isCoVar old_var )\n    ( LC (subst `extendTCvInScope` new_var) new_cenv\n    , new_var, kind_co, stuff )\n  where\n    old_kind     = coVarKind old_var\n    (eta, stuff) = fun lc old_kind\n    Pair k1 _    = coercionKind eta\n    new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)\n\n    -- old_var :: s1  ~r s2\n    -- eta     :: (s1' ~r s2') ~N (t1 ~r t2)\n    -- eta1    :: s1' ~r t1\n    -- eta2    :: s2' ~r t2\n    -- co1     :: s1' ~r s2'\n    -- co2     :: t1  ~r t2\n    -- kind_co :: (s1' ~r s2') ~N (t1 ~r t2)\n    -- lifted  :: co1 ~N co2\n\n    role   = coVarRole old_var\n    eta'   = downgradeRole role Nominal eta\n    eta1   = mkNthCo role 2 eta'\n    eta2   = mkNthCo role 3 eta'\n\n    co1     = mkCoVarCo new_var\n    co2     = mkSymCo eta1 `mkTransCo` co1 `mkTransCo` eta2\n    kind_co = mkTyConAppCo Nominal (equalityTyCon role)\n                           [ mkKindCo co1, mkKindCo co2\n                           , co1         , co2          ]\n    lifted  = mkProofIrrelCo Nominal kind_co co1 co2\n\n    new_cenv = extendVarEnv cenv old_var lifted\n\n-- | Is a var in the domain of a lifting context?\nisMappedByLC :: TyCoVar -> LiftingContext -> Bool\nisMappedByLC tv (LC _ env) = tv `elemVarEnv` env\n\n-- If [a |-> g] is in the substitution and g :: t1 ~ t2, substitute a for t1\n-- If [a |-> (g1, g2)] is in the substitution, substitute a for g1\nsubstLeftCo :: LiftingContext -> Coercion -> Coercion\nsubstLeftCo lc co\n  = substCo (lcSubstLeft lc) co\n\n-- Ditto, but for t2 and g2\nsubstRightCo :: LiftingContext -> Coercion -> Coercion\nsubstRightCo lc co\n  = substCo (lcSubstRight lc) co\n\n-- | Apply \"sym\" to all coercions in a 'LiftCoEnv'\nswapLiftCoEnv :: LiftCoEnv -> LiftCoEnv\nswapLiftCoEnv = mapVarEnv mkSymCo\n\nlcSubstLeft :: LiftingContext -> TCvSubst\nlcSubstLeft (LC subst lc_env) = liftEnvSubstLeft subst lc_env\n\nlcSubstRight :: LiftingContext -> TCvSubst\nlcSubstRight (LC subst lc_env) = liftEnvSubstRight subst lc_env\n\nliftEnvSubstLeft :: TCvSubst -> LiftCoEnv -> TCvSubst\nliftEnvSubstLeft = liftEnvSubst pFst\n\nliftEnvSubstRight :: TCvSubst -> LiftCoEnv -> TCvSubst\nliftEnvSubstRight = liftEnvSubst pSnd\n\nliftEnvSubst :: (forall a. Pair a -> a) -> TCvSubst -> LiftCoEnv -> TCvSubst\nliftEnvSubst selector subst lc_env\n  = composeTCvSubst (TCvSubst emptyInScopeSet tenv cenv) subst\n  where\n    pairs            = nonDetUFMToList lc_env\n                       -- It's OK to use nonDetUFMToList here because we\n                       -- immediately forget the ordering by creating\n                       -- a VarEnv\n    (tpairs, cpairs) = partitionWith ty_or_co pairs\n    tenv             = mkVarEnv_Directly tpairs\n    cenv             = mkVarEnv_Directly cpairs\n\n    ty_or_co :: (Unique, Coercion) -> Either (Unique, Type) (Unique, Coercion)\n    ty_or_co (u, co)\n      | Just equality_co <- isCoercionTy_maybe equality_ty\n      = Right (u, equality_co)\n      | otherwise\n      = Left (u, equality_ty)\n      where\n        equality_ty = selector (coercionKind co)\n\n-- | Extract the underlying substitution from the LiftingContext\nlcTCvSubst :: LiftingContext -> TCvSubst\nlcTCvSubst (LC subst _) = subst\n\n-- | Get the 'InScopeSet' from a 'LiftingContext'\nlcInScopeSet :: LiftingContext -> InScopeSet\nlcInScopeSet (LC subst _) = getTCvInScope subst\n\n{-\n%************************************************************************\n%*                                                                      *\n            Sequencing on coercions\n%*                                                                      *\n%************************************************************************\n-}\n\nseqMCo :: MCoercion -> ()\nseqMCo MRefl    = ()\nseqMCo (MCo co) = seqCo co\n\nseqCo :: Coercion -> ()\nseqCo (Refl ty)                 = seqType ty\nseqCo (GRefl r ty mco)          = r `seq` seqType ty `seq` seqMCo mco\nseqCo (TyConAppCo r tc cos)     = r `seq` tc `seq` seqCos cos\nseqCo (AppCo co1 co2)           = seqCo co1 `seq` seqCo co2\nseqCo (ForAllCo tv k co)        = seqType (varType tv) `seq` seqCo k\n                                                       `seq` seqCo co\nseqCo (FunCo r co1 co2)         = r `seq` seqCo co1 `seq` seqCo co2\nseqCo (CoVarCo cv)              = cv `seq` ()\nseqCo (HoleCo h)                = coHoleCoVar h `seq` ()\nseqCo (AxiomInstCo con ind cos) = con `seq` ind `seq` seqCos cos\nseqCo (UnivCo p r t1 t2)\n  = seqProv p `seq` r `seq` seqType t1 `seq` seqType t2\nseqCo (SymCo co)                = seqCo co\nseqCo (TransCo co1 co2)         = seqCo co1 `seq` seqCo co2\nseqCo (NthCo r n co)            = r `seq` n `seq` seqCo co\nseqCo (LRCo lr co)              = lr `seq` seqCo co\nseqCo (InstCo co arg)           = seqCo co `seq` seqCo arg\nseqCo (KindCo co)               = seqCo co\nseqCo (SubCo co)                = seqCo co\nseqCo (AxiomRuleCo _ cs)        = seqCos cs\n\nseqProv :: UnivCoProvenance -> ()\nseqProv UnsafeCoerceProv    = ()\nseqProv (PhantomProv co)    = seqCo co\nseqProv (ProofIrrelProv co) = seqCo co\nseqProv (PluginProv _)      = ()\n\nseqCos :: [Coercion] -> ()\nseqCos []       = ()\nseqCos (co:cos) = seqCo co `seq` seqCos cos\n\n{-\n%************************************************************************\n%*                                                                      *\n             The kind of a type, and of a coercion\n%*                                                                      *\n%************************************************************************\n-}\n\ncoercionType :: Coercion -> Type\ncoercionType co = case coercionKindRole co of\n  (Pair ty1 ty2, r) -> mkCoercionType r ty1 ty2\n\n------------------\n-- | If it is the case that\n--\n-- > c :: (t1 ~ t2)\n--\n-- i.e. the kind of @c@ relates @t1@ and @t2@, then @coercionKind c = Pair t1 t2@.\n\ncoercionKind :: Coercion -> Pair Type\ncoercionKind co =\n  go co\n  where\n    go (Refl ty) = Pair ty ty\n    go (GRefl _ ty MRefl) = Pair ty ty\n    go (GRefl _ ty (MCo co1)) = Pair ty (mkCastTy ty co1)\n    go (TyConAppCo _ tc cos)= mkTyConApp tc <$> (sequenceA $ map go cos)\n    go (AppCo co1 co2)      = mkAppTy <$> go co1 <*> go co2\n    go co@(ForAllCo tv1 k_co co1) -- works for both tyvar and covar\n       | isGReflCo k_co           = mkTyCoInvForAllTy tv1 <$> go co1\n         -- kind_co always has kind @Type@, thus @isGReflCo@\n       | otherwise                = go_forall empty_subst co\n       where\n         empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfCo co)\n    go (FunCo _ co1 co2)    = mkVisFunTy <$> go co1 <*> go co2\n    go (CoVarCo cv)         = coVarTypes cv\n    go (HoleCo h)           = coVarTypes (coHoleCoVar h)\n    go (AxiomInstCo ax ind cos)\n      | CoAxBranch { cab_tvs = tvs, cab_cvs = cvs\n                   , cab_lhs = lhs, cab_rhs = rhs } <- coAxiomNthBranch ax ind\n      , let Pair tycos1 tycos2 = sequenceA (map go cos)\n            (tys1, cotys1) = splitAtList tvs tycos1\n            (tys2, cotys2) = splitAtList tvs tycos2\n            cos1           = map stripCoercionTy cotys1\n            cos2           = map stripCoercionTy cotys2\n      = ASSERT( cos `equalLength` (tvs ++ cvs) )\n                  -- Invariant of AxiomInstCo: cos should\n                  -- exactly saturate the axiom branch\n        Pair (substTyWith tvs tys1 $\n              substTyWithCoVars cvs cos1 $\n              mkTyConApp (coAxiomTyCon ax) lhs)\n             (substTyWith tvs tys2 $\n              substTyWithCoVars cvs cos2 rhs)\n    go (UnivCo _ _ ty1 ty2)   = Pair ty1 ty2\n    go (SymCo co)             = swap $ go co\n    go (TransCo co1 co2)      = Pair (pFst $ go co1) (pSnd $ go co2)\n    go g@(NthCo _ d co)\n      | Just argss <- traverse tyConAppArgs_maybe tys\n      = ASSERT( and $ (`lengthExceeds` d) <$> argss )\n        (`getNth` d) <$> argss\n\n      | d == 0\n      , Just splits <- traverse splitForAllTy_maybe tys\n      = (tyVarKind . fst) <$> splits\n\n      | otherwise\n      = pprPanic \"coercionKind\" (ppr g)\n      where\n        tys = go co\n    go (LRCo lr co)         = (pickLR lr . splitAppTy) <$> go co\n    go (InstCo aco arg)     = go_app aco [arg]\n    go (KindCo co)          = typeKind <$> go co\n    go (SubCo co)           = go co\n    go (AxiomRuleCo ax cos) = expectJust \"coercionKind\" $\n                              coaxrProves ax (map go cos)\n\n    go_app :: Coercion -> [Coercion] -> Pair Type\n    -- Collect up all the arguments and apply all at once\n    -- See Note [Nested InstCos]\n    go_app (InstCo co arg) args = go_app co (arg:args)\n    go_app co              args = piResultTys <$> go co <*> (sequenceA $ map go args)\n\n    go_forall subst (ForAllCo tv1 k_co co)\n      -- See Note [Nested ForAllCos]\n      | isTyVar tv1\n      = mkInvForAllTy <$> Pair tv1 tv2 <*> go_forall subst' co\n      where\n        Pair _ k2 = go k_co\n        tv2       = setTyVarKind tv1 (substTy subst k2)\n        subst' | isGReflCo k_co = extendTCvInScope subst tv1\n                 -- kind_co always has kind @Type@, thus @isGReflCo@\n               | otherwise      = extendTvSubst (extendTCvInScope subst tv2) tv1 $\n                                  TyVarTy tv2 `mkCastTy` mkSymCo k_co\n    go_forall subst (ForAllCo cv1 k_co co)\n      | isCoVar cv1\n      = mkTyCoInvForAllTy <$> Pair cv1 cv2 <*> go_forall subst' co\n      where\n        Pair _ k2 = go k_co\n        r         = coVarRole cv1\n        eta1      = mkNthCo r 2 (downgradeRole r Nominal k_co)\n        eta2      = mkNthCo r 3 (downgradeRole r Nominal k_co)\n\n        -- k_co :: (t1 ~r t2) ~N (s1 ~r s2)\n        -- k1    = t1 ~r t2\n        -- k2    = s1 ~r s2\n        -- cv1  :: t1 ~r t2\n        -- cv2  :: s1 ~r s2\n        -- eta1 :: t1 ~r s1\n        -- eta2 :: t2 ~r s2\n        -- n_subst  = (eta1 ; cv2 ; sym eta2) :: t1 ~r t2\n\n        cv2     = setVarType cv1 (substTy subst k2)\n        n_subst = eta1 `mkTransCo` (mkCoVarCo cv2) `mkTransCo` (mkSymCo eta2)\n        subst'  | isReflCo k_co = extendTCvInScope subst cv1\n                | otherwise     = extendCvSubst (extendTCvInScope subst cv2)\n                                                cv1 n_subst\n\n    go_forall subst other_co\n      -- when other_co is not a ForAllCo\n      = substTy subst `pLiftSnd` go other_co\n\n{-\n\nNote [Nested ForAllCos]\n~~~~~~~~~~~~~~~~~~~~~~~\n\nSuppose we need `coercionKind (ForAllCo a1 (ForAllCo a2 ... (ForAllCo an\nco)...) )`.   We do not want to perform `n` single-type-variable\nsubstitutions over the kind of `co`; rather we want to do one substitution\nwhich substitutes for all of `a1`, `a2` ... simultaneously.  If we do one\nat a time we get the performance hole reported in Trac #11735.\n\nSolution: gather up the type variables for nested `ForAllCos`, and\nsubstitute for them all at once.  Remarkably, for Trac #11735 this single\nchange reduces /total/ compile time by a factor of more than ten.\n\n-}\n\n-- | Apply 'coercionKind' to multiple 'Coercion's\ncoercionKinds :: [Coercion] -> Pair [Type]\ncoercionKinds tys = sequenceA $ map coercionKind tys\n\n-- | Get a coercion's kind and role.\ncoercionKindRole :: Coercion -> (Pair Type, Role)\ncoercionKindRole co = (coercionKind co, coercionRole co)\n\n-- | Retrieve the role from a coercion.\ncoercionRole :: Coercion -> Role\ncoercionRole = go\n  where\n    go (Refl _) = Nominal\n    go (GRefl r _ _) = r\n    go (TyConAppCo r _ _) = r\n    go (AppCo co1 _) = go co1\n    go (ForAllCo _ _ co) = go co\n    go (FunCo r _ _) = r\n    go (CoVarCo cv) = coVarRole cv\n    go (HoleCo h)   = coVarRole (coHoleCoVar h)\n    go (AxiomInstCo ax _ _) = coAxiomRole ax\n    go (UnivCo _ r _ _)  = r\n    go (SymCo co) = go co\n    go (TransCo co1 _co2) = go co1\n    go (NthCo r _d _co) = r\n    go (LRCo {}) = Nominal\n    go (InstCo co _) = go co\n    go (KindCo {}) = Nominal\n    go (SubCo _) = Representational\n    go (AxiomRuleCo ax _) = coaxrRole ax\n\n{-\nNote [Nested InstCos]\n~~~~~~~~~~~~~~~~~~~~~\nIn Trac #5631 we found that 70% of the entire compilation time was\nbeing spent in coercionKind!  The reason was that we had\n   (g @ ty1 @ ty2 .. @ ty100)    -- The \"@s\" are InstCos\nwhere\n   g :: forall a1 a2 .. a100. phi\nIf we deal with the InstCos one at a time, we'll do this:\n   1.  Find the kind of (g @ ty1 .. @ ty99) : forall a100. phi'\n   2.  Substitute phi'[ ty100/a100 ], a single tyvar->type subst\nBut this is a *quadratic* algorithm, and the blew up Trac #5631.\nSo it's very important to do the substitution simultaneously;\ncf Type.piResultTys (which in fact we call here).\n\n-}\n\n-- | Assuming that two types are the same, ignoring coercions, find\n-- a nominal coercion between the types. This is useful when optimizing\n-- transitivity over coercion applications, where splitting two\n-- AppCos might yield different kinds. See Note [EtaAppCo] in OptCoercion.\nbuildCoercion :: Type -> Type -> CoercionN\nbuildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2\n  where\n    go ty1 ty2 | Just ty1' <- coreView ty1 = go ty1' ty2\n               | Just ty2' <- coreView ty2 = go ty1 ty2'\n\n    go (CastTy ty1 co) ty2\n      = let co' = go ty1 ty2\n            r = coercionRole co'\n        in  mkCoherenceLeftCo r ty1 co co'\n\n    go ty1 (CastTy ty2 co)\n      = let co' = go ty1 ty2\n            r = coercionRole co'\n        in  mkCoherenceRightCo r ty2 co co'\n\n    go ty1@(TyVarTy tv1) _tyvarty\n      = ASSERT( case _tyvarty of\n                  { TyVarTy tv2 -> tv1 == tv2\n                  ; _           -> False      } )\n        mkNomReflCo ty1\n\n    go (FunTy { ft_arg = arg1, ft_res = res1 })\n       (FunTy { ft_arg = arg2, ft_res = res2 })\n      = mkFunCo Nominal (go arg1 arg2) (go res1 res2)\n\n    go (TyConApp tc1 args1) (TyConApp tc2 args2)\n      = ASSERT( tc1 == tc2 )\n        mkTyConAppCo Nominal tc1 (zipWith go args1 args2)\n\n    go (AppTy ty1a ty1b) ty2\n      | Just (ty2a, ty2b) <- repSplitAppTy_maybe ty2\n      = mkAppCo (go ty1a ty2a) (go ty1b ty2b)\n\n    go ty1 (AppTy ty2a ty2b)\n      | Just (ty1a, ty1b) <- repSplitAppTy_maybe ty1\n      = mkAppCo (go ty1a ty2a) (go ty1b ty2b)\n\n    go (ForAllTy (Bndr tv1 _flag1) ty1) (ForAllTy (Bndr tv2 _flag2) ty2)\n      | isTyVar tv1\n      = ASSERT( isTyVar tv2 )\n        mkForAllCo tv1 kind_co (go ty1 ty2')\n      where kind_co  = go (tyVarKind tv1) (tyVarKind tv2)\n            in_scope = mkInScopeSet $ tyCoVarsOfType ty2 `unionVarSet` tyCoVarsOfCo kind_co\n            ty2'     = substTyWithInScope in_scope [tv2]\n                         [mkTyVarTy tv1 `mkCastTy` kind_co]\n                         ty2\n\n    go (ForAllTy (Bndr cv1 _flag1) ty1) (ForAllTy (Bndr cv2 _flag2) ty2)\n      = ASSERT( isCoVar cv1 && isCoVar cv2 )\n        mkForAllCo cv1 kind_co (go ty1 ty2')\n      where s1 = varType cv1\n            s2 = varType cv2\n            kind_co = go s1 s2\n\n            -- s1 = t1 ~r t2\n            -- s2 = t3 ~r t4\n            -- kind_co :: (t1 ~r t2) ~N (t3 ~r t4)\n            -- eta1 :: t1 ~r t3\n            -- eta2 :: t2 ~r t4\n\n            r    = coVarRole cv1\n            kind_co' = downgradeRole r Nominal kind_co\n            eta1 = mkNthCo r 2 kind_co'\n            eta2 = mkNthCo r 3 kind_co'\n\n            subst = mkEmptyTCvSubst $ mkInScopeSet $\n                      tyCoVarsOfType ty2 `unionVarSet` tyCoVarsOfCo kind_co\n            ty2'  = substTy (extendCvSubst subst cv2 $ mkSymCo eta1 `mkTransCo`\n                                                       mkCoVarCo cv1 `mkTransCo`\n                                                       eta2)\n                            ty2\n\n    go ty1@(LitTy lit1) _lit2\n      = ASSERT( case _lit2 of\n                  { LitTy lit2 -> lit1 == lit2\n                  ; _          -> False        } )\n        mkNomReflCo ty1\n\n    go (CoercionTy co1) (CoercionTy co2)\n      = mkProofIrrelCo Nominal kind_co co1 co2\n      where\n        kind_co = go (coercionType co1) (coercionType co2)\n\n    go ty1 ty2\n      = pprPanic \"buildKindCoercion\" (vcat [ ppr orig_ty1, ppr orig_ty2\n                                           , ppr ty1, ppr ty2 ])\n\n{-\n%************************************************************************\n%*                                                                      *\n       Simplifying types\n%*                                                                      *\n%************************************************************************\n\nThe function below morally belongs in TcFlatten, but it is used also in\nFamInstEnv, and so lives here.\n\nNote [simplifyArgsWorker]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nInvariant (F2) of Note [Flattening] says that flattening is homogeneous.\nThis causes some trouble when flattening a function applied to a telescope\nof arguments, perhaps with dependency. For example, suppose\n\n  type family F :: forall (j :: Type) (k :: Type). Maybe j -> Either j k -> Bool -> [k]\n\nand we wish to flatten the args of (with kind applications explicit)\n\n  F a b (Just a c) (Right a b d) False\n\nwhere all variables are skolems and\n\n  a :: Type\n  b :: Type\n  c :: a\n  d :: k\n\n  [G] aco :: a ~ fa\n  [G] bco :: b ~ fb\n  [G] cco :: c ~ fc\n  [G] dco :: d ~ fd\n\nThe first step is to flatten all the arguments. This is done before calling\nsimplifyArgsWorker. We start from\n\n  a\n  b\n  Just a c\n  Right a b d\n  False\n\nand get\n\n  (fa,                             co1 :: fa ~ a)\n  (fb,                             co2 :: fb ~ b)\n  (Just fa (fc |> aco) |> co6,     co3 :: (Just fa (fc |> aco) |> co6) ~ (Just a c))\n  (Right fa fb (fd |> bco) |> co7, co4 :: (Right fa fb (fd |> bco) |> co7) ~ (Right a b d))\n  (False,                          co5 :: False ~ False)\n\nwhere\n  co6 :: Maybe fa ~ Maybe a\n  co7 :: Either fa fb ~ Either a b\n\nWe now process the flattened args in left-to-right order. The first two args\nneed no further processing. But now consider the third argument. Let f3 = the flattened\nresult, Just fa (fc |> aco) |> co6.\nThis f3 flattened argument has kind (Maybe a), due to\n(F2). And yet, when we build the application (F fa fb ...), we need this\nargument to have kind (Maybe fa), not (Maybe a). We must cast this argument.\nThe coercion to use is\ndetermined by the kind of F: we see in F's kind that the third argument has\nkind Maybe j. Critically, we also know that the argument corresponding to j\n(in our example, a) flattened with a coercion co1. We can thus know the\ncoercion needed for the 3rd argument is (Maybe (sym co1)), thus building\n(f3 |> Maybe (sym co1))\n\nMore generally, we must use the Lifting Lemma, as implemented in\nCoercion.liftCoSubst. As we work left-to-right, any variable that is a\ndependent parameter (j and k, in our example) gets mapped in a lifting context\nto the coercion that is output from flattening the corresponding argument (co1\nand co2, in our example). Then, after flattening later arguments, we lift the\nkind of these arguments in the lifting context that we've be building up.\nThis coercion is then used to keep the result of flattening well-kinded.\n\nWorking through our example, this is what happens:\n\n  1. Extend the (empty) LC with [j |-> co1]. No new casting must be done,\n     because the binder associated with the first argument has a closed type (no\n     variables).\n\n  2. Extend the LC with [k |-> co2]. No casting to do.\n\n  3. Lifting the kind (Maybe j) with our LC\n     yields co8 :: Maybe fa ~ Maybe a. Use (f3 |> sym co8) as the argument to\n     F.\n\n  4. Lifting the kind (Either j k) with our LC\n     yields co9 :: Either fa fb ~ Either a b. Use (f4 |> sym co9) as the 4th\n     argument to F, where f4 is the flattened form of argument 4, written above.\n\n  5. We lift Bool with our LC, getting <Bool>;\n     casting has no effect.\n\nWe're now almost done, but the new application (F fa fb (f3 |> sym co8) (f4 > sym co9) False)\nhas the wrong kind. Its kind is [fb], instead of the original [b].\nSo we must use our LC one last time to lift the result kind [k],\ngetting res_co :: [fb] ~ [b], and we cast our result.\n\nAccordingly, the final result is\n\n  F fa fb (Just fa (fc |> aco) |> Maybe (sym aco) |> sym (Maybe (sym aco)))\n          (Right fa fb (fd |> bco) |> Either (sym aco) (sym bco) |> sym (Either (sym aco) (sym bco)))\n          False\n            |> [sym bco]\n\nThe res_co (in this case, [sym bco])\nis returned as the third return value from simplifyArgsWorker.\n\nNote [Last case in simplifyArgsWorker]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn writing simplifyArgsWorker's `go`, we know here that args cannot be empty,\nbecause that case is first. We've run out of\nbinders. But perhaps inner_ki is a tyvar that has been instantiated with a\n\u00ce\u00a0-type.\n\nHere is an example.\n\n  a :: forall (k :: Type). k -> k\n  type family Star\n  Proxy :: forall j. j -> Type\n  axStar :: Star ~ Type\n  type family NoWay :: Bool\n  axNoWay :: NoWay ~ False\n  bo :: Type\n  [G] bc :: bo ~ Bool   (in inert set)\n\n  co :: (forall j. j -> Type) ~ (forall (j :: Star). (j |> axStar) -> Star)\n  co = forall (j :: sym axStar). (<j> -> sym axStar)\n\n  We are flattening:\n  a (forall (j :: Star). (j |> axStar) -> Star)   -- 1\n    (Proxy |> co)                                 -- 2\n    (bo |> sym axStar)                            -- 3\n    (NoWay |> sym bc)                             -- 4\n      :: Star\n\nFirst, we flatten all the arguments (before simplifyArgsWorker), like so:\n\n    (forall j. j -> Type, co1 :: (forall j. j -> Type) ~\n                                 (forall (j :: Star). (j |> axStar) -> Star))  -- 1\n    (Proxy |> co,         co2 :: (Proxy |> co) ~ (Proxy |> co))                -- 2\n    (Bool |> sym axStar,  co3 :: (Bool |> sym axStar) ~ (bo |> sym axStar))    -- 3\n    (False |> sym bc,     co4 :: (False |> sym bc) ~ (NoWay |> sym bc))        -- 4\n\nThen we do the process described in Note [simplifyArgsWorker].\n\n1. Lifting Type (the kind of the first arg) gives us a reflexive coercion, so we\n   don't use it. But we do build a lifting context [k -> co1] (where co1 is a\n   result of flattening an argument, written above).\n\n2. Lifting k gives us co1, so the second argument becomes (Proxy |> co |> sym co1).\n   This is not a dependent argument, so we don't extend the lifting context.\n\nNow we need to deal with argument (3). After flattening, should we tack on a homogenizing\ncoercion? The way we normally tell is to lift the kind of the binder.\nBut here, the remainder of the kind of `a` that we're left with\nafter processing two arguments is just `k`.\n\nThe way forward is look up k in the lifting context, getting co1. If we're at\nall well-typed, co1 will be a coercion between \u00ce\u00a0-types, with at least one binder.\nSo, let's\ndecompose co1 with decomposePiCos. This decomposition needs arguments to use\nto instantiate any kind parameters. Look at the type of co1. If we just\ndecomposed it, we would end up with coercions whose types include j, which is\nout of scope here. Accordingly, decomposePiCos takes a list of types whose\nkinds are the *right-hand* types in the decomposed coercion. (See comments on\ndecomposePiCos.) Because the flattened types have unflattened kinds (because\nflattening is homogeneous), passing the list of flattened types to decomposePiCos\njust won't do: later arguments' kinds won't be as expected. So we need to get\nthe *unflattened* types to pass to decomposePiCos. We can do this easily enough\nby taking the kind of the argument coercions, passed in originally.\n\n(Alternative 1: We could re-engineer decomposePiCos to deal with this situation.\nBut that function is already gnarly, and taking the right-hand types is correct\nat its other call sites, which are much more common than this one.)\n\n(Alternative 2: We could avoid calling decomposePiCos entirely, integrating its\nbehavior into simplifyArgsWorker. This would work, I think, but then all of the\ncomplication of decomposePiCos would end up layered on top of all the complication\nhere. Please, no.)\n\n(Alternative 3: We could pass the unflattened arguments into simplifyArgsWorker\nso that we don't have to recreate them. But that would complicate the interface\nof this function to handle a very dark, dark corner case. Better to keep our\ndemons to ourselves here instead of exposing them to callers. This decision is\neasily reversed if there is ever any performance trouble due to the call of\ncoercionKind.)\n\nSo we now call\n\n  decomposePiCos co1\n                 (Pair (forall j. j -> Type) (forall (j :: Star). (j |> axStar) -> Star))\n                 [bo |> sym axStar, NoWay |> sym bc]\n\nto get\n\n  co5 :: Star ~ Type\n  co6 :: (j |> axStar) ~ (j |> co5), substituted to\n                              (bo |> sym axStar |> axStar) ~ (bo |> sym axStar |> co5)\n                           == bo ~ bo\n  res_co :: Type ~ Star\n\nWe then use these casts on (the flattened) (3) and (4) to get\n\n  (Bool |> sym axStar |> co5 :: Type)   -- (C3)\n  (False |> sym bc |> co6    :: bo)     -- (C4)\n\nWe can simplify to\n\n  Bool                        -- (C3)\n  (False |> sym bc :: bo)     -- (C4)\n\nOf course, we still must do the processing in Note [simplifyArgsWorker] to finish\nthe job. We thus want to recur. Our new function kind is the left-hand type of\nco1 (gotten, recall, by lifting the variable k that was the return kind of the\noriginal function). Why the left-hand type (as opposed to the right-hand type)?\nBecause we have casted all the arguments according to decomposePiCos, which gets\nus from the right-hand type to the left-hand one. We thus recur with that new\nfunction kind, zapping our lifting context, because we have essentially applied\nit.\n\nThis recursive call returns ([Bool, False], [...], Refl). The Bool and False\nare the correct arguments we wish to return. But we must be careful about the\nresult coercion: our new, flattened application will have kind Type, but we\nwant to make sure that the result coercion casts this back to Star. (Why?\nBecause we started with an application of kind Star, and flattening is homogeneous.)\n\nSo, we have to twiddle the result coercion appropriately.\n\nLet's check whether this is well-typed. We know\n\n  a :: forall (k :: Type). k -> k\n\n  a (forall j. j -> Type) :: (forall j. j -> Type) -> forall j. j -> Type\n\n  a (forall j. j -> Type)\n    Proxy\n      :: forall j. j -> Type\n\n  a (forall j. j -> Type)\n    Proxy\n    Bool\n      :: Bool -> Type\n\n  a (forall j. j -> Type)\n    Proxy\n    Bool\n    False\n      :: Type\n\n  a (forall j. j -> Type)\n    Proxy\n    Bool\n    False\n     |> res_co\n     :: Star\n\nas desired.\n\nWhew.\n\n-}\n\n\n-- This is shared between the flattener and the normaliser in FamInstEnv.\n-- See Note [simplifyArgsWorker]\n{-# INLINE simplifyArgsWorker #-}\nsimplifyArgsWorker :: [TyCoBinder] -> Kind\n                       -- the binders & result kind (not a \u00ce\u00a0-type) of the function applied to the args\n                       -- list of binders can be shorter or longer than the list of args\n                   -> TyCoVarSet   -- free vars of the args\n                   -> [Role]   -- list of roles, r\n                   -> [(Type, Coercion)] -- flattened type arguments, arg\n                                         -- each comes with the coercion used to flatten it,\n                                         -- with co :: flattened_type ~ original_type\n                   -> ([Type], [Coercion], CoercionN)\n-- Returns (xis, cos, res_co), where each co :: xi ~ arg,\n-- and res_co :: kind (f xis) ~ kind (f tys), where f is the function applied to the args\n-- Precondition: if f :: forall bndrs. inner_ki (where bndrs and inner_ki are passed in),\n-- then (f orig_tys) is well kinded. Note that (f flattened_tys) might *not* be well-kinded.\n-- Massaging the flattened_tys in order to make (f flattened_tys) well-kinded is what this\n-- function is all about. That is, (f xis), where xis are the returned arguments, *is*\n-- well kinded.\nsimplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs\n                   orig_roles orig_simplified_args\n  = go [] [] orig_lc orig_ki_binders orig_inner_ki orig_roles orig_simplified_args\n  where\n    orig_lc = emptyLiftingContext $ mkInScopeSet $ orig_fvs\n\n    go :: [Type]      -- Xis accumulator, in reverse order\n       -> [Coercion]  -- Coercions accumulator, in reverse order\n                      -- These are in 1-to-1 correspondence\n       -> LiftingContext  -- mapping from tyvars to flattening coercions\n       -> [TyCoBinder]    -- Unsubsted binders of function's kind\n       -> Kind        -- Unsubsted result kind of function (not a Pi-type)\n       -> [Role]      -- Roles at which to flatten these ...\n       -> [(Type, Coercion)]  -- flattened arguments, with their flattening coercions\n       -> ([Type], [Coercion], CoercionN)\n    go acc_xis acc_cos lc binders inner_ki _ []\n      = (reverse acc_xis, reverse acc_cos, kind_co)\n      where\n        final_kind = mkPiTys binders inner_ki\n        kind_co = liftCoSubst Nominal lc final_kind\n\n    go acc_xis acc_cos lc (binder:binders) inner_ki (role:roles) ((xi,co):args)\n      = -- By Note [Flattening] in TcFlatten invariant (F2),\n         -- tcTypeKind(xi) = tcTypeKind(ty). But, it's possible that xi will be\n         -- used as an argument to a function whose kind is different, if\n         -- earlier arguments have been flattened to new types. We thus\n         -- need a coercion (kind_co :: old_kind ~ new_kind).\n         --\n         -- The bangs here have been observed to improve performance\n         -- significantly in optimized builds.\n         let kind_co = mkSymCo $\n               liftCoSubst Nominal lc (tyCoBinderType binder)\n             !casted_xi = xi `mkCastTy` kind_co\n             casted_co =  mkCoherenceLeftCo role xi kind_co co\n\n         -- now, extend the lifting context with the new binding\n             !new_lc | Just tv <- tyCoBinderVar_maybe binder\n                     = extendLiftingContextAndInScope lc tv casted_co\n                     | otherwise\n                     = lc\n         in\n         go (casted_xi : acc_xis)\n            (casted_co : acc_cos)\n            new_lc\n            binders\n            inner_ki\n            roles\n            args\n\n\n      -- See Note [Last case in simplifyArgsWorker]\n    go acc_xis acc_cos lc [] inner_ki roles args\n      | Just k   <- getTyVar_maybe inner_ki\n      , Just co1 <- liftCoSubstTyVar lc Nominal k\n      = let co1_kind              = coercionKind co1\n            unflattened_tys       = map (pSnd . coercionKind . snd) args\n            (arg_cos, res_co)     = decomposePiCos co1 co1_kind unflattened_tys\n            casted_args           = ASSERT2( equalLength args arg_cos\n                                           , ppr args $$ ppr arg_cos )\n                                    [ (casted_xi, casted_co)\n                                    | ((xi, co), arg_co, role) <- zip3 args arg_cos roles\n                                    , let casted_xi = xi `mkCastTy` arg_co\n                                          casted_co = mkCoherenceLeftCo role xi arg_co co ]\n               -- In general decomposePiCos can return fewer cos than tys,\n               -- but not here; because we're well typed, there will be enough\n               -- binders. Note that decomposePiCos does substitutions, so even\n               -- if the original substitution results in something ending with\n               -- ... -> k, that k will be substituted to perhaps reveal more\n               -- binders.\n            zapped_lc             = zapLiftingContext lc\n            Pair flattened_kind _ = co1_kind\n            (bndrs, new_inner)    = splitPiTys flattened_kind\n\n            (xis_out, cos_out, res_co_out)\n              = go acc_xis acc_cos zapped_lc bndrs new_inner roles casted_args\n        in\n        (xis_out, cos_out, res_co_out `mkTransCo` res_co)\n\n    go _ _ _ _ _ _ _ = panic\n        \"simplifyArgsWorker wandered into deeper water than usual\"\n           -- This debug information is commented out because leaving it in\n           -- causes a ~2% increase in allocations in T9872d.\n           -- That's independent of the analagous case in flatten_args_fast\n           -- in TcFlatten:\n           -- each of these causes a 2% increase on its own, so commenting them\n           -- both out gives a 4% decrease in T9872d.\n           {-\n\n             (vcat [ppr orig_binders,\n                    ppr orig_inner_ki,\n                    ppr (take 10 orig_roles), -- often infinite!\n                    ppr orig_tys])\n           -}\n", "num_lines": 2821}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n--\n-- FamInstEnv: Type checked family instance declarations\n\n{-# LANGUAGE CPP, GADTs, ScopedTypeVariables, BangPatterns, TupleSections #-}\n\nmodule FamInstEnv (\n        FamInst(..), FamFlavor(..), famInstAxiom, famInstTyCon, famInstRHS,\n        famInstsRepTyCons, famInstRepTyCon_maybe, dataFamInstRepTyCon,\n        pprFamInst, pprFamInsts,\n        mkImportedFamInst,\n\n        FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs,\n        extendFamInstEnv, extendFamInstEnvList,\n        famInstEnvElts, famInstEnvSize, familyInstances,\n\n        -- * CoAxioms\n        mkCoAxBranch, mkBranchedCoAxiom, mkUnbranchedCoAxiom, mkSingleCoAxiom,\n        mkNewTypeCoAxiom,\n\n        FamInstMatch(..),\n        lookupFamInstEnv, lookupFamInstEnvConflicts, lookupFamInstEnvByTyCon,\n\n        isDominatedBy, apartnessCheck,\n\n        -- Injectivity\n        InjectivityCheckResult(..),\n        lookupFamInstEnvInjectivityConflicts, injectiveBranches,\n\n        -- Normalisation\n        topNormaliseType, topNormaliseType_maybe,\n        normaliseType, normaliseTcApp, normaliseTcArgs,\n        reduceTyFamApp_maybe,\n\n        -- Flattening\n        flattenTys\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Unify\nimport Type\nimport TyCoRep\nimport TyCon\nimport Coercion\nimport CoAxiom\nimport VarSet\nimport VarEnv\nimport Name\nimport PrelNames ( eqPrimTyConKey )\nimport UniqDFM\nimport Outputable\nimport Maybes\nimport CoreMap\nimport Unique\nimport Util\nimport Var\nimport Pair\nimport SrcLoc\nimport FastString\nimport Control.Monad\nimport Data.List( mapAccumL )\nimport Data.Array( Array, assocs )\n\n{-\n************************************************************************\n*                                                                      *\n          Type checked family instance heads\n*                                                                      *\n************************************************************************\n\nNote [FamInsts and CoAxioms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* CoAxioms and FamInsts are just like\n  DFunIds  and ClsInsts\n\n* A CoAxiom is a System-FC thing: it can relate any two types\n\n* A FamInst is a Haskell source-language thing, corresponding\n  to a type/data family instance declaration.\n    - The FamInst contains a CoAxiom, which is the evidence\n      for the instance\n\n    - The LHS of the CoAxiom is always of form F ty1 .. tyn\n      where F is a type family\n-}\n\ndata FamInst  -- See Note [FamInsts and CoAxioms]\n  = FamInst { fi_axiom  :: CoAxiom Unbranched -- The new coercion axiom\n                                              -- introduced by this family\n                                              -- instance\n                 -- INVARIANT: apart from freshening (see below)\n                 --    fi_tvs = cab_tvs of the (single) axiom branch\n                 --    fi_cvs = cab_cvs ...ditto...\n                 --    fi_tys = cab_lhs ...ditto...\n                 --    fi_rhs = cab_rhs ...ditto...\n\n            , fi_flavor :: FamFlavor\n\n            -- Everything below here is a redundant,\n            -- cached version of the two things above\n            -- except that the TyVars are freshened\n            , fi_fam   :: Name          -- Family name\n\n                -- Used for \"rough matching\"; same idea as for class instances\n                -- See Note [Rough-match field] in InstEnv\n            , fi_tcs   :: [Maybe Name]  -- Top of type args\n                -- INVARIANT: fi_tcs = roughMatchTcs fi_tys\n\n            -- Used for \"proper matching\"; ditto\n            , fi_tvs :: [TyVar]      -- Template tyvars for full match\n            , fi_cvs :: [CoVar]      -- Template covars for full match\n                 -- Like ClsInsts, these variables are always fresh\n                 -- See Note [Template tyvars are fresh] in InstEnv\n\n            , fi_tys    :: [Type]       --   The LHS type patterns\n            -- May be eta-reduced; see Note [Eta reduction for data families]\n\n            , fi_rhs :: Type         --   the RHS, with its freshened vars\n            }\n\ndata FamFlavor\n  = SynFamilyInst         -- A synonym family\n  | DataFamilyInst TyCon  -- A data family, with its representation TyCon\n\n{-\nNote [Arity of data families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nData family instances might legitimately be over- or under-saturated.\n\nUnder-saturation has two potential causes:\n U1) Eta reduction. See Note [Eta reduction for data families].\n U2) When the user has specified a return kind instead of written out patterns.\n     Example:\n\n       data family Sing (a :: k)\n       data instance Sing :: Bool -> Type\n\n     The data family tycon Sing has an arity of 2, the k and the a. But\n     the data instance has only one pattern, Bool (standing in for k).\n     This instance is equivalent to `data instance Sing (a :: Bool)`, but\n     without the last pattern, we have an under-saturated data family instance.\n     On its own, this example is not compelling enough to add support for\n     under-saturation, but U1 makes this feature more compelling.\n\nOver-saturation is also possible:\n  O1) If the data family's return kind is a type variable (see also #12369),\n      an instance might legitimately have more arguments than the family.\n      Example:\n\n        data family Fix :: (Type -> k) -> k\n        data instance Fix f = MkFix1 (f (Fix f))\n        data instance Fix f x = MkFix2 (f (Fix f x) x)\n\n      In the first instance here, the k in the data family kind is chosen to\n      be Type. In the second, it's (Type -> Type).\n\n      However, we require that any over-saturation is eta-reducible. That is,\n      we require that any extra patterns be bare unrepeated type variables;\n      see Note [Eta reduction for data families]. Accordingly, the FamInst\n      is never over-saturated.\n\nWhy can we allow such flexibility for data families but not for type families?\nBecause data families can be decomposed -- that is, they are generative and\ninjective. A Type family is neither and so always must be applied to all its\narguments.\n-}\n\n-- Obtain the axiom of a family instance\nfamInstAxiom :: FamInst -> CoAxiom Unbranched\nfamInstAxiom = fi_axiom\n\n-- Split the left-hand side of the FamInst\nfamInstSplitLHS :: FamInst -> (TyCon, [Type])\nfamInstSplitLHS (FamInst { fi_axiom = axiom, fi_tys = lhs })\n  = (coAxiomTyCon axiom, lhs)\n\n-- Get the RHS of the FamInst\nfamInstRHS :: FamInst -> Type\nfamInstRHS = fi_rhs\n\n-- Get the family TyCon of the FamInst\nfamInstTyCon :: FamInst -> TyCon\nfamInstTyCon = coAxiomTyCon . famInstAxiom\n\n-- Return the representation TyCons introduced by data family instances, if any\nfamInstsRepTyCons :: [FamInst] -> [TyCon]\nfamInstsRepTyCons fis = [tc | FamInst { fi_flavor = DataFamilyInst tc } <- fis]\n\n-- Extracts the TyCon for this *data* (or newtype) instance\nfamInstRepTyCon_maybe :: FamInst -> Maybe TyCon\nfamInstRepTyCon_maybe fi\n  = case fi_flavor fi of\n       DataFamilyInst tycon -> Just tycon\n       SynFamilyInst        -> Nothing\n\ndataFamInstRepTyCon :: FamInst -> TyCon\ndataFamInstRepTyCon fi\n  = case fi_flavor fi of\n       DataFamilyInst tycon -> tycon\n       SynFamilyInst        -> pprPanic \"dataFamInstRepTyCon\" (ppr fi)\n\n{-\n************************************************************************\n*                                                                      *\n        Pretty printing\n*                                                                      *\n************************************************************************\n-}\n\ninstance NamedThing FamInst where\n   getName = coAxiomName . fi_axiom\n\ninstance Outputable FamInst where\n   ppr = pprFamInst\n\npprFamInst :: FamInst -> SDoc\n-- Prints the FamInst as a family instance declaration\n-- NB: This function, FamInstEnv.pprFamInst, is used only for internal,\n--     debug printing. See PprTyThing.pprFamInst for printing for the user\npprFamInst (FamInst { fi_flavor = flavor, fi_axiom = ax\n                    , fi_tvs = tvs, fi_tys = tys, fi_rhs = rhs })\n  = hang (ppr_tc_sort <+> text \"instance\"\n             <+> pprCoAxBranchUser (coAxiomTyCon ax) (coAxiomSingleBranch ax))\n       2 (whenPprDebug debug_stuff)\n  where\n    ppr_tc_sort = case flavor of\n                     SynFamilyInst             -> text \"type\"\n                     DataFamilyInst tycon\n                       | isDataTyCon     tycon -> text \"data\"\n                       | isNewTyCon      tycon -> text \"newtype\"\n                       | isAbstractTyCon tycon -> text \"data\"\n                       | otherwise             -> text \"WEIRD\" <+> ppr tycon\n\n    debug_stuff = vcat [ text \"Coercion axiom:\" <+> ppr ax\n                       , text \"Tvs:\" <+> ppr tvs\n                       , text \"LHS:\" <+> ppr tys\n                       , text \"RHS:\" <+> ppr rhs ]\n\npprFamInsts :: [FamInst] -> SDoc\npprFamInsts finsts = vcat (map pprFamInst finsts)\n\n{-\nNote [Lazy axiom match]\n~~~~~~~~~~~~~~~~~~~~~~~\nIt is Vitally Important that mkImportedFamInst is *lazy* in its axiom\nparameter. The axiom is loaded lazily, via a forkM, in TcIface. Sometime\nlater, mkImportedFamInst is called using that axiom. However, the axiom\nmay itself depend on entities which are not yet loaded as of the time\nof the mkImportedFamInst. Thus, if mkImportedFamInst eagerly looks at the\naxiom, a dependency loop spontaneously appears and GHC hangs. The solution\nis simply for mkImportedFamInst never, ever to look inside of the axiom\nuntil everything else is good and ready to do so. We can assume that this\nreadiness has been achieved when some other code pulls on the axiom in the\nFamInst. Thus, we pattern match on the axiom lazily (in the where clause,\nnot in the parameter list) and we assert the consistency of names there\nalso.\n-}\n\n-- Make a family instance representation from the information found in an\n-- interface file.  In particular, we get the rough match info from the iface\n-- (instead of computing it here).\nmkImportedFamInst :: Name               -- Name of the family\n                  -> [Maybe Name]       -- Rough match info\n                  -> CoAxiom Unbranched -- Axiom introduced\n                  -> FamInst            -- Resulting family instance\nmkImportedFamInst fam mb_tcs axiom\n  = FamInst {\n      fi_fam    = fam,\n      fi_tcs    = mb_tcs,\n      fi_tvs    = tvs,\n      fi_cvs    = cvs,\n      fi_tys    = tys,\n      fi_rhs    = rhs,\n      fi_axiom  = axiom,\n      fi_flavor = flavor }\n  where\n     -- See Note [Lazy axiom match]\n     ~(CoAxBranch { cab_lhs = tys\n                  , cab_tvs = tvs\n                  , cab_cvs = cvs\n                  , cab_rhs = rhs }) = coAxiomSingleBranch axiom\n\n         -- Derive the flavor for an imported FamInst rather disgustingly\n         -- Maybe we should store it in the IfaceFamInst?\n     flavor = case splitTyConApp_maybe rhs of\n                Just (tc, _)\n                  | Just ax' <- tyConFamilyCoercion_maybe tc\n                  , ax' == axiom\n                  -> DataFamilyInst tc\n                _ -> SynFamilyInst\n\n{-\n************************************************************************\n*                                                                      *\n                FamInstEnv\n*                                                                      *\n************************************************************************\n\nNote [FamInstEnv]\n~~~~~~~~~~~~~~~~~\nA FamInstEnv maps a family name to the list of known instances for that family.\n\nThe same FamInstEnv includes both 'data family' and 'type family' instances.\nType families are reduced during type inference, but not data families;\nthe user explains when to use a data family instance by using constructors\nand pattern matching.\n\nNevertheless it is still useful to have data families in the FamInstEnv:\n\n - For finding overlaps and conflicts\n\n - For finding the representation type...see FamInstEnv.topNormaliseType\n   and its call site in Simplify\n\n - In standalone deriving instance Eq (T [Int]) we need to find the\n   representation type for T [Int]\n\nNote [Varying number of patterns for data family axioms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor data families, the number of patterns may vary between instances.\nFor example\n   data family T a b\n   data instance T Int a = T1 a | T2\n   data instance T Bool [a] = T3 a\n\nThen we get a data type for each instance, and an axiom:\n   data TInt a = T1 a | T2\n   data TBoolList a = T3 a\n\n   axiom ax7   :: T Int ~ TInt   -- Eta-reduced\n   axiom ax8 a :: T Bool [a] ~ TBoolList a\n\nThese two axioms for T, one with one pattern, one with two;\nsee Note [Eta reduction for data families]\n\nNote [FamInstEnv determinism]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe turn FamInstEnvs into a list in some places that don't directly affect\nthe ABI. That happens in family consistency checks and when producing output\nfor `:info`. Unfortunately that nondeterminism is nonlocal and it's hard\nto tell what it affects without following a chain of functions. It's also\neasy to accidentally make that nondeterminism affect the ABI. Furthermore\nthe envs should be relatively small, so it should be free to use deterministic\nmaps here. Testing with nofib and validate detected no difference between\nUniqFM and UniqDFM.\nSee Note [Deterministic UniqFM].\n-}\n\ntype FamInstEnv = UniqDFM FamilyInstEnv  -- Maps a family to its instances\n     -- See Note [FamInstEnv]\n     -- See Note [FamInstEnv determinism]\n\ntype FamInstEnvs = (FamInstEnv, FamInstEnv)\n     -- External package inst-env, Home-package inst-env\n\nnewtype FamilyInstEnv\n  = FamIE [FamInst]     -- The instances for a particular family, in any order\n\ninstance Outputable FamilyInstEnv where\n  ppr (FamIE fs) = text \"FamIE\" <+> vcat (map ppr fs)\n\n-- INVARIANTS:\n--  * The fs_tvs are distinct in each FamInst\n--      of a range value of the map (so we can safely unify them)\n\nemptyFamInstEnvs :: (FamInstEnv, FamInstEnv)\nemptyFamInstEnvs = (emptyFamInstEnv, emptyFamInstEnv)\n\nemptyFamInstEnv :: FamInstEnv\nemptyFamInstEnv = emptyUDFM\n\nfamInstEnvElts :: FamInstEnv -> [FamInst]\nfamInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts]\n  -- See Note [FamInstEnv determinism]\n\nfamInstEnvSize :: FamInstEnv -> Int\nfamInstEnvSize = nonDetFoldUDFM (\\(FamIE elt) sum -> sum + length elt) 0\n  -- It's OK to use nonDetFoldUDFM here since we're just computing the\n  -- size.\n\nfamilyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]\nfamilyInstances (pkg_fie, home_fie) fam\n  = get home_fie ++ get pkg_fie\n  where\n    get env = case lookupUDFM env fam of\n                Just (FamIE insts) -> insts\n                Nothing                      -> []\n\nextendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv\nextendFamInstEnvList inst_env fis = foldl' extendFamInstEnv inst_env fis\n\nextendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv\nextendFamInstEnv inst_env\n                 ins_item@(FamInst {fi_fam = cls_nm})\n  = addToUDFM_C add inst_env cls_nm (FamIE [ins_item])\n  where\n    add (FamIE items) _ = FamIE (ins_item:items)\n\n{-\n************************************************************************\n*                                                                      *\n                Compatibility\n*                                                                      *\n************************************************************************\n\nNote [Apartness]\n~~~~~~~~~~~~~~~~\nIn dealing with closed type families, we must be able to check that one type\nwill never reduce to another. This check is called /apartness/. The check\nis always between a target (which may be an arbitrary type) and a pattern.\nHere is how we do it:\n\napart(target, pattern) = not (unify(flatten(target), pattern))\n\nwhere flatten (implemented in flattenTys, below) converts all type-family\napplications into fresh variables. (See Note [Flattening].)\n\nNote [Compatibility]\n~~~~~~~~~~~~~~~~~~~~\nTwo patterns are /compatible/ if either of the following conditions hold:\n1) The patterns are apart.\n2) The patterns unify with a substitution S, and their right hand sides\nequal under that substitution.\n\nFor open type families, only compatible instances are allowed. For closed\ntype families, the story is slightly more complicated. Consider the following:\n\ntype family F a where\n  F Int = Bool\n  F a   = Int\n\ng :: Show a => a -> F a\ng x = length (show x)\n\nShould that type-check? No. We need to allow for the possibility that 'a'\nmight be Int and therefore 'F a' should be Bool. We can simplify 'F a' to Int\nonly when we can be sure that 'a' is not Int.\n\nTo achieve this, after finding a possible match within the equations, we have to\ngo back to all previous equations and check that, under the\nsubstitution induced by the match, other branches are surely apart. (See\nNote [Apartness].) This is similar to what happens with class\ninstance selection, when we need to guarantee that there is only a match and\nno unifiers. The exact algorithm is different here because the\npotentially-overlapping group is closed.\n\nAs another example, consider this:\n\ntype family G x where\n  G Int = Bool\n  G a   = Double\n\ntype family H y\n-- no instances\n\nNow, we want to simplify (G (H Char)). We can't, because (H Char) might later\nsimplify to be Int. So, (G (H Char)) is stuck, for now.\n\nWhile everything above is quite sound, it isn't as expressive as we'd like.\nConsider this:\n\ntype family J a where\n  J Int = Int\n  J a   = a\n\nCan we simplify (J b) to b? Sure we can. Yes, the first equation matches if\nb is instantiated with Int, but the RHSs coincide there, so it's all OK.\n\nSo, the rule is this: when looking up a branch in a closed type family, we\nfind a branch that matches the target, but then we make sure that the target\nis apart from every previous *incompatible* branch. We don't check the\nbranches that are compatible with the matching branch, because they are either\nirrelevant (clause 1 of compatible) or benign (clause 2 of compatible).\n\nNote [Compatibility of eta-reduced axioms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn newtype instances of data families we eta-reduce the axioms,\nSee Note [Eta reduction for data families] in FamInstEnv. This means that\nwe sometimes need to test compatibility of two axioms that were eta-reduced to\ndifferent degrees, e.g.:\n\n\ndata family D a b c\nnewtype instance D a Int c = DInt (Maybe a)\n  -- D a Int ~ Maybe\n  -- lhs = [a, Int]\nnewtype instance D Bool Int Char = DIntChar Float\n  -- D Bool Int Char ~ Float\n  -- lhs = [Bool, Int, Char]\n\nThese are obviously incompatible. We could detect this by saturating\n(eta-expanding) the shorter LHS with fresh tyvars until the lists are of\nequal length, but instead we can just remove the tail of the longer list, as\nthose types will simply unify with the freshly introduced tyvars.\n\nBy doing this, in case the LHS are unifiable, the yielded substitution won't\nmention the tyvars that appear in the tail we dropped off, and we might try\nto test equality RHSes of different kinds, but that's fine since this case\noccurs only for data families, where the RHS is a unique tycon and the equality\nfails anyway.\n-}\n\n-- See Note [Compatibility]\ncompatibleBranches :: CoAxBranch -> CoAxBranch -> Bool\ncompatibleBranches (CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 })\n                   (CoAxBranch { cab_lhs = lhs2, cab_rhs = rhs2 })\n  = let (commonlhs1, commonlhs2) = zipAndUnzip lhs1 lhs2\n             -- See Note [Compatibility of eta-reduced axioms]\n    in case tcUnifyTysFG (const BindMe) commonlhs1 commonlhs2 of\n      SurelyApart -> True\n      Unifiable subst\n        | Type.substTyAddInScope subst rhs1 `eqType`\n          Type.substTyAddInScope subst rhs2\n        -> True\n      _ -> False\n\n-- | Result of testing two type family equations for injectiviy.\ndata InjectivityCheckResult\n   = InjectivityAccepted\n    -- ^ Either RHSs are distinct or unification of RHSs leads to unification of\n    -- LHSs\n   | InjectivityUnified CoAxBranch CoAxBranch\n    -- ^ RHSs unify but LHSs don't unify under that substitution.  Relevant for\n    -- closed type families where equation after unification might be\n    -- overlpapped (in which case it is OK if they don't unify).  Constructor\n    -- stores axioms after unification.\n\n-- | Check whether two type family axioms don't violate injectivity annotation.\ninjectiveBranches :: [Bool] -> CoAxBranch -> CoAxBranch\n                  -> InjectivityCheckResult\ninjectiveBranches injectivity\n                  ax1@(CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 })\n                  ax2@(CoAxBranch { cab_lhs = lhs2, cab_rhs = rhs2 })\n  -- See Note [Verifying injectivity annotation]. This function implements first\n  -- check described there.\n  = let getInjArgs  = filterByList injectivity\n    in case tcUnifyTyWithTFs True rhs1 rhs2 of -- True = two-way pre-unification\n       Nothing -> InjectivityAccepted -- RHS are different, so equations are\n                                      -- injective.\n       Just subst -> -- RHS unify under a substitution\n        let lhs1Subst = Type.substTys subst (getInjArgs lhs1)\n            lhs2Subst = Type.substTys subst (getInjArgs lhs2)\n        -- If LHSs are equal under the substitution used for RHSs then this pair\n        -- of equations does not violate injectivity annotation. If LHSs are not\n        -- equal under that substitution then this pair of equations violates\n        -- injectivity annotation, but for closed type families it still might\n        -- be the case that one LHS after substitution is unreachable.\n        in if eqTypes lhs1Subst lhs2Subst\n           then InjectivityAccepted\n           else InjectivityUnified ( ax1 { cab_lhs = Type.substTys subst lhs1\n                                         , cab_rhs = Type.substTy  subst rhs1 })\n                                   ( ax2 { cab_lhs = Type.substTys subst lhs2\n                                         , cab_rhs = Type.substTy  subst rhs2 })\n\n-- takes a CoAxiom with unknown branch incompatibilities and computes\n-- the compatibilities\n-- See Note [Storing compatibility] in CoAxiom\ncomputeAxiomIncomps :: [CoAxBranch] -> [CoAxBranch]\ncomputeAxiomIncomps branches\n  = snd (mapAccumL go [] branches)\n  where\n    go :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch)\n    go prev_brs cur_br\n       = (cur_br : prev_brs, new_br)\n       where\n         new_br = cur_br { cab_incomps = mk_incomps prev_brs cur_br }\n\n    mk_incomps :: [CoAxBranch] -> CoAxBranch -> [CoAxBranch]\n    mk_incomps prev_brs cur_br\n       = filter (not . compatibleBranches cur_br) prev_brs\n\n{-\n************************************************************************\n*                                                                      *\n           Constructing axioms\n    These functions are here because tidyType / tcUnifyTysFG\n    are not available in CoAxiom\n\n    Also computeAxiomIncomps is too sophisticated for CoAxiom\n*                                                                      *\n************************************************************************\n\nNote [Tidy axioms when we build them]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLike types and classes, we build axioms fully quantified over all\ntheir variables, and tidy them when we build them. For example,\nwe print out axioms and don't want to print stuff like\n    F k k a b = ...\nInstead we must tidy those kind variables.  See Trac #7524.\n\nWe could instead tidy when we print, but that makes it harder to get\nthings like injectivity errors to come out right. Danger of\n     Type family equation violates injectivity annotation.\n     Kind variable \u00e2\u20ac\u02dck\u00e2\u20ac\u2122 cannot be inferred from the right-hand side.\n     In the type family equation:\n        PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2\n\nNote [Always number wildcard types in CoAxBranch]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following example (from the DataFamilyInstanceLHS test case):\n\n  data family Sing (a :: k)\n  data instance Sing (_ :: MyKind) where\n      SingA :: Sing A\n      SingB :: Sing B\n\nIf we're not careful during tidying, then when this program is compiled with\n-ddump-types, we'll get the following information:\n\n  COERCION AXIOMS\n    axiom DataFamilyInstanceLHS.D:R:SingMyKind_0 ::\n      Sing _ = DataFamilyInstanceLHS.R:SingMyKind_ _\n\nIt's misleading to have a wildcard type appearing on the RHS like\nthat. To avoid this issue, when building a CoAxiom (which is what eventually\ngets printed above), we tidy all the variables in an env that already contains\n'_'. Thus, any variable named '_' will be renamed, giving us the nicer output\nhere:\n\n  COERCION AXIOMS\n    axiom DataFamilyInstanceLHS.D:R:SingMyKind_0 ::\n      Sing _1 = DataFamilyInstanceLHS.R:SingMyKind_ _1\n\nWhich is at least legal syntax.\n\nSee also Note [CoAxBranch type variables] in CoAxiom; note that we\nare tidying (changing OccNames only), not freshening, in accordance with\nthat Note.\n-}\n\n-- all axiom roles are Nominal, as this is only used with type families\nmkCoAxBranch :: [TyVar] -- original, possibly stale, tyvars\n             -> [TyVar] -- Extra eta tyvars\n             -> [CoVar] -- possibly stale covars\n             -> [Type]  -- LHS patterns\n             -> Type    -- RHS\n             -> [Role]\n             -> SrcSpan\n             -> CoAxBranch\nmkCoAxBranch tvs eta_tvs cvs lhs rhs roles loc\n  = CoAxBranch { cab_tvs     = tvs'\n               , cab_eta_tvs = eta_tvs'\n               , cab_cvs     = cvs'\n               , cab_lhs     = tidyTypes env lhs\n               , cab_roles   = roles\n               , cab_rhs     = tidyType env rhs\n               , cab_loc     = loc\n               , cab_incomps = placeHolderIncomps }\n  where\n    (env1, tvs')     = tidyVarBndrs init_tidy_env tvs\n    (env2, eta_tvs') = tidyVarBndrs env1          eta_tvs\n    (env,  cvs')     = tidyVarBndrs env2          cvs\n    -- See Note [Tidy axioms when we build them]\n    -- See also Note [CoAxBranch type variables] in CoAxiom\n\n    init_occ_env = initTidyOccEnv [mkTyVarOcc \"_\"]\n    init_tidy_env = mkEmptyTidyEnv init_occ_env\n    -- See Note [Always number wildcard types in CoAxBranch]\n\n-- all of the following code is here to avoid mutual dependencies with\n-- Coercion\nmkBranchedCoAxiom :: Name -> TyCon -> [CoAxBranch] -> CoAxiom Branched\nmkBranchedCoAxiom ax_name fam_tc branches\n  = CoAxiom { co_ax_unique   = nameUnique ax_name\n            , co_ax_name     = ax_name\n            , co_ax_tc       = fam_tc\n            , co_ax_role     = Nominal\n            , co_ax_implicit = False\n            , co_ax_branches = manyBranches (computeAxiomIncomps branches) }\n\nmkUnbranchedCoAxiom :: Name -> TyCon -> CoAxBranch -> CoAxiom Unbranched\nmkUnbranchedCoAxiom ax_name fam_tc branch\n  = CoAxiom { co_ax_unique   = nameUnique ax_name\n            , co_ax_name     = ax_name\n            , co_ax_tc       = fam_tc\n            , co_ax_role     = Nominal\n            , co_ax_implicit = False\n            , co_ax_branches = unbranched (branch { cab_incomps = [] }) }\n\nmkSingleCoAxiom :: Role -> Name\n                -> [TyVar] -> [TyVar] -> [CoVar]\n                -> TyCon -> [Type] -> Type\n                -> CoAxiom Unbranched\n-- Make a single-branch CoAxiom, incluidng making the branch itself\n-- Used for both type family (Nominal) and data family (Representational)\n-- axioms, hence passing in the Role\nmkSingleCoAxiom role ax_name tvs eta_tvs cvs fam_tc lhs_tys rhs_ty\n  = CoAxiom { co_ax_unique   = nameUnique ax_name\n            , co_ax_name     = ax_name\n            , co_ax_tc       = fam_tc\n            , co_ax_role     = role\n            , co_ax_implicit = False\n            , co_ax_branches = unbranched (branch { cab_incomps = [] }) }\n  where\n    branch = mkCoAxBranch tvs eta_tvs cvs lhs_tys rhs_ty\n                          (map (const Nominal) tvs)\n                          (getSrcSpan ax_name)\n\n-- | Create a coercion constructor (axiom) suitable for the given\n--   newtype 'TyCon'. The 'Name' should be that of a new coercion\n--   'CoAxiom', the 'TyVar's the arguments expected by the @newtype@ and\n--   the type the appropriate right hand side of the @newtype@, with\n--   the free variables a subset of those 'TyVar's.\nmkNewTypeCoAxiom :: Name -> TyCon -> [TyVar] -> [Role] -> Type -> CoAxiom Unbranched\nmkNewTypeCoAxiom name tycon tvs roles rhs_ty\n  = CoAxiom { co_ax_unique   = nameUnique name\n            , co_ax_name     = name\n            , co_ax_implicit = True  -- See Note [Implicit axioms] in TyCon\n            , co_ax_role     = Representational\n            , co_ax_tc       = tycon\n            , co_ax_branches = unbranched (branch { cab_incomps = [] }) }\n  where\n    branch = mkCoAxBranch tvs [] [] (mkTyVarTys tvs) rhs_ty\n                          roles (getSrcSpan name)\n\n{-\n************************************************************************\n*                                                                      *\n                Looking up a family instance\n*                                                                      *\n************************************************************************\n\n@lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.\nMultiple matches are only possible in case of type families (not data\nfamilies), and then, it doesn't matter which match we choose (as the\ninstances are guaranteed confluent).\n\nWe return the matching family instances and the type instance at which it\nmatches.  For example, if we lookup 'T [Int]' and have a family instance\n\n  data instance T [a] = ..\n\ndesugared to\n\n  data :R42T a = ..\n  coe :Co:R42T a :: T [a] ~ :R42T a\n\nwe return the matching instance '(FamInst{.., fi_tycon = :R42T}, Int)'.\n-}\n\n-- when matching a type family application, we get a FamInst,\n-- and the list of types the axiom should be applied to\ndata FamInstMatch = FamInstMatch { fim_instance :: FamInst\n                                 , fim_tys      :: [Type]\n                                 , fim_cos      :: [Coercion]\n                                 }\n  -- See Note [Over-saturated matches]\n\ninstance Outputable FamInstMatch where\n  ppr (FamInstMatch { fim_instance = inst\n                    , fim_tys      = tys\n                    , fim_cos      = cos })\n    = text \"match with\" <+> parens (ppr inst) <+> ppr tys <+> ppr cos\n\nlookupFamInstEnvByTyCon :: FamInstEnvs -> TyCon -> [FamInst]\nlookupFamInstEnvByTyCon (pkg_ie, home_ie) fam_tc\n  = get pkg_ie ++ get home_ie\n  where\n    get ie = case lookupUDFM ie fam_tc of\n               Nothing          -> []\n               Just (FamIE fis) -> fis\n\nlookupFamInstEnv\n    :: FamInstEnvs\n    -> TyCon -> [Type]          -- What we are looking for\n    -> [FamInstMatch]           -- Successful matches\n-- Precondition: the tycon is saturated (or over-saturated)\n\nlookupFamInstEnv\n   = lookup_fam_inst_env match\n   where\n     match _ _ tpl_tys tys = tcMatchTys tpl_tys tys\n\nlookupFamInstEnvConflicts\n    :: FamInstEnvs\n    -> FamInst          -- Putative new instance\n    -> [FamInstMatch]   -- Conflicting matches (don't look at the fim_tys field)\n-- E.g. when we are about to add\n--    f : type instance F [a] = a->a\n-- we do (lookupFamInstConflicts f [b])\n-- to find conflicting matches\n--\n-- Precondition: the tycon is saturated (or over-saturated)\n\nlookupFamInstEnvConflicts envs fam_inst@(FamInst { fi_axiom = new_axiom })\n  = lookup_fam_inst_env my_unify envs fam tys\n  where\n    (fam, tys) = famInstSplitLHS fam_inst\n        -- In example above,   fam tys' = F [b]\n\n    my_unify (FamInst { fi_axiom = old_axiom }) tpl_tvs tpl_tys _\n       = ASSERT2( tyCoVarsOfTypes tys `disjointVarSet` tpl_tvs,\n                  (ppr fam <+> ppr tys) $$\n                  (ppr tpl_tvs <+> ppr tpl_tys) )\n                -- Unification will break badly if the variables overlap\n                -- They shouldn't because we allocate separate uniques for them\n         if compatibleBranches (coAxiomSingleBranch old_axiom) new_branch\n           then Nothing\n           else Just noSubst\n      -- Note [Family instance overlap conflicts]\n\n    noSubst = panic \"lookupFamInstEnvConflicts noSubst\"\n    new_branch = coAxiomSingleBranch new_axiom\n\n--------------------------------------------------------------------------------\n--                 Type family injectivity checking bits                      --\n--------------------------------------------------------------------------------\n\n{- Note [Verifying injectivity annotation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nInjectivity means that the RHS of a type family uniquely determines the LHS (see\nNote [Type inference for type families with injectivity]).  User informs about\ninjectivity using an injectivity annotation and it is GHC's task to verify that\nthat annotation is correct wrt. to type family equations. Whenever we see a new\nequation of a type family we need to make sure that adding this equation to\nalready known equations of a type family does not violate injectivity annotation\nsupplied by the user (see Note [Injectivity annotation]).  Of course if the type\nfamily has no injectivity annotation then no check is required.  But if a type\nfamily has injectivity annotation we need to make sure that the following\nconditions hold:\n\n1. For each pair of *different* equations of a type family, one of the following\n   conditions holds:\n\n   A:  RHSs are different.\n\n   B1: OPEN TYPE FAMILIES: If the RHSs can be unified under some substitution\n       then it must be possible to unify the LHSs under the same substitution.\n       Example:\n\n          type family FunnyId a = r | r -> a\n          type instance FunnyId Int = Int\n          type instance FunnyId a = a\n\n       RHSs of these two equations unify under [ a |-> Int ] substitution.\n       Under this substitution LHSs are equal therefore these equations don't\n       violate injectivity annotation.\n\n   B2: CLOSED TYPE FAMILIES: If the RHSs can be unified under some\n       substitution then either the LHSs unify under the same substitution or\n       the LHS of the latter equation is overlapped by earlier equations.\n       Example 1:\n\n          type family SwapIntChar a = r | r -> a where\n              SwapIntChar Int  = Char\n              SwapIntChar Char = Int\n              SwapIntChar a    = a\n\n       Say we are checking the last two equations. RHSs unify under [ a |->\n       Int ] substitution but LHSs don't. So we apply the substitution to LHS\n       of last equation and check whether it is overlapped by any of previous\n       equations. Since it is overlapped by the first equation we conclude\n       that pair of last two equations does not violate injectivity\n       annotation.\n\n   A special case of B is when RHSs unify with an empty substitution ie. they\n   are identical.\n\n   If any of the above two conditions holds we conclude that the pair of\n   equations does not violate injectivity annotation. But if we find a pair\n   of equations where neither of the above holds we report that this pair\n   violates injectivity annotation because for a given RHS we don't have a\n   unique LHS. (Note that (B) actually implies (A).)\n\n   Note that we only take into account these LHS patterns that were declared\n   as injective.\n\n2. If a RHS of a type family equation is a bare type variable then\n   all LHS variables (including implicit kind variables) also have to be bare.\n   In other words, this has to be a sole equation of that type family and it has\n   to cover all possible patterns.  So for example this definition will be\n   rejected:\n\n      type family W1 a = r | r -> a\n      type instance W1 [a] = a\n\n   If it were accepted we could call `W1 [W1 Int]`, which would reduce to\n   `W1 Int` and then by injectivity we could conclude that `[W1 Int] ~ Int`,\n   which is bogus.\n\n3. If a RHS of a type family equation is a type family application then the type\n   family is rejected as not injective.\n\n4. If a LHS type variable that is declared as injective is not mentioned on\n   injective position in the RHS then the type family is rejected as not\n   injective.  \"Injective position\" means either an argument to a type\n   constructor or argument to a type family on injective position.\n\nSee also Note [Injective type families] in TyCon\n-}\n\n\n-- | Check whether an open type family equation can be added to already existing\n-- instance environment without causing conflicts with supplied injectivity\n-- annotations.  Returns list of conflicting axioms (type instance\n-- declarations).\nlookupFamInstEnvInjectivityConflicts\n    :: [Bool]         -- injectivity annotation for this type family instance\n                      -- INVARIANT: list contains at least one True value\n    ->  FamInstEnvs   -- all type instances seens so far\n    ->  FamInst       -- new type instance that we're checking\n    -> [CoAxBranch]   -- conflicting instance declarations\nlookupFamInstEnvInjectivityConflicts injList (pkg_ie, home_ie)\n                             fam_inst@(FamInst { fi_axiom = new_axiom })\n  -- See Note [Verifying injectivity annotation]. This function implements\n  -- check (1.B1) for open type families described there.\n  = lookup_inj_fam_conflicts home_ie ++ lookup_inj_fam_conflicts pkg_ie\n    where\n      fam        = famInstTyCon fam_inst\n      new_branch = coAxiomSingleBranch new_axiom\n\n      -- filtering function used by `lookup_inj_fam_conflicts` to check whether\n      -- a pair of equations conflicts with the injectivity annotation.\n      isInjConflict (FamInst { fi_axiom = old_axiom })\n          | InjectivityAccepted <-\n            injectiveBranches injList (coAxiomSingleBranch old_axiom) new_branch\n          = False -- no conflict\n          | otherwise = True\n\n      lookup_inj_fam_conflicts ie\n          | isOpenFamilyTyCon fam, Just (FamIE insts) <- lookupUDFM ie fam\n          = map (coAxiomSingleBranch . fi_axiom) $\n            filter isInjConflict insts\n          | otherwise = []\n\n\n--------------------------------------------------------------------------------\n--                    Type family overlap checking bits                       --\n--------------------------------------------------------------------------------\n\n{-\nNote [Family instance overlap conflicts]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n- In the case of data family instances, any overlap is fundamentally a\n  conflict (as these instances imply injective type mappings).\n\n- In the case of type family instances, overlap is admitted as long as\n  the right-hand sides of the overlapping rules coincide under the\n  overlap substitution.  eg\n       type instance F a Int = a\n       type instance F Int b = b\n  These two overlap on (F Int Int) but then both RHSs are Int,\n  so all is well. We require that they are syntactically equal;\n  anything else would be difficult to test for at this stage.\n-}\n\n------------------------------------------------------------\n-- Might be a one-way match or a unifier\ntype MatchFun =  FamInst                -- The FamInst template\n              -> TyVarSet -> [Type]     --   fi_tvs, fi_tys of that FamInst\n              -> [Type]                 -- Target to match against\n              -> Maybe TCvSubst\n\nlookup_fam_inst_env'          -- The worker, local to this module\n    :: MatchFun\n    -> FamInstEnv\n    -> TyCon -> [Type]        -- What we are looking for\n    -> [FamInstMatch]\nlookup_fam_inst_env' match_fun ie fam match_tys\n  | isOpenFamilyTyCon fam\n  , Just (FamIE insts) <- lookupUDFM ie fam\n  = find insts    -- The common case\n  | otherwise = []\n  where\n\n    find [] = []\n    find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs, fi_cvs = tpl_cvs\n                        , fi_tys = tpl_tys }) : rest)\n        -- Fast check for no match, uses the \"rough match\" fields\n      | instanceCantMatch rough_tcs mb_tcs\n      = find rest\n\n        -- Proper check\n      | Just subst <- match_fun item (mkVarSet tpl_tvs) tpl_tys match_tys1\n      = (FamInstMatch { fim_instance = item\n                      , fim_tys      = substTyVars subst tpl_tvs `chkAppend` match_tys2\n                      , fim_cos      = ASSERT( all (isJust . lookupCoVar subst) tpl_cvs )\n                                       substCoVars subst tpl_cvs\n                      })\n        : find rest\n\n        -- No match => try next\n      | otherwise\n      = find rest\n      where\n        (rough_tcs, match_tys1, match_tys2) = split_tys tpl_tys\n\n      -- Precondition: the tycon is saturated (or over-saturated)\n\n    -- Deal with over-saturation\n    -- See Note [Over-saturated matches]\n    split_tys tpl_tys\n      | isTypeFamilyTyCon fam\n      = pre_rough_split_tys\n\n      | otherwise\n      = let (match_tys1, match_tys2) = splitAtList tpl_tys match_tys\n            rough_tcs = roughMatchTcs match_tys1\n        in (rough_tcs, match_tys1, match_tys2)\n\n    (pre_match_tys1, pre_match_tys2) = splitAt (tyConArity fam) match_tys\n    pre_rough_split_tys\n      = (roughMatchTcs pre_match_tys1, pre_match_tys1, pre_match_tys2)\n\nlookup_fam_inst_env           -- The worker, local to this module\n    :: MatchFun\n    -> FamInstEnvs\n    -> TyCon -> [Type]        -- What we are looking for\n    -> [FamInstMatch]         -- Successful matches\n\n-- Precondition: the tycon is saturated (or over-saturated)\n\nlookup_fam_inst_env match_fun (pkg_ie, home_ie) fam tys\n  =  lookup_fam_inst_env' match_fun home_ie fam tys\n  ++ lookup_fam_inst_env' match_fun pkg_ie  fam tys\n\n{-\nNote [Over-saturated matches]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's ok to look up an over-saturated type constructor.  E.g.\n     type family F a :: * -> *\n     type instance F (a,b) = Either (a->b)\n\nThe type instance gives rise to a newtype TyCon (at a higher kind\nwhich you can't do in Haskell!):\n     newtype FPair a b = FP (Either (a->b))\n\nThen looking up (F (Int,Bool) Char) will return a FamInstMatch\n     (FPair, [Int,Bool,Char])\nThe \"extra\" type argument [Char] just stays on the end.\n\nWe handle data families and type families separately here:\n\n * For type families, all instances of a type family must have the\n   same arity, so we can precompute the split between the match_tys\n   and the overflow tys. This is done in pre_rough_split_tys.\n\n * For data family instances, though, we need to re-split for each\n   instance, because the breakdown might be different for each\n   instance.  Why?  Because of eta reduction; see\n   Note [Eta reduction for data families].\n-}\n\n-- checks if one LHS is dominated by a list of other branches\n-- in other words, if an application would match the first LHS, it is guaranteed\n-- to match at least one of the others. The RHSs are ignored.\n-- This algorithm is conservative:\n--   True -> the LHS is definitely covered by the others\n--   False -> no information\n-- It is currently (Oct 2012) used only for generating errors for\n-- inaccessible branches. If these errors go unreported, no harm done.\n-- This is defined here to avoid a dependency from CoAxiom to Unify\nisDominatedBy :: CoAxBranch -> [CoAxBranch] -> Bool\nisDominatedBy branch branches\n  = or $ map match branches\n    where\n      lhs = coAxBranchLHS branch\n      match (CoAxBranch { cab_lhs = tys })\n        = isJust $ tcMatchTys tys lhs\n\n{-\n************************************************************************\n*                                                                      *\n                Choosing an axiom application\n*                                                                      *\n************************************************************************\n\nThe lookupFamInstEnv function does a nice job for *open* type families,\nbut we also need to handle closed ones when normalising a type:\n-}\n\nreduceTyFamApp_maybe :: FamInstEnvs\n                     -> Role              -- Desired role of result coercion\n                     -> TyCon -> [Type]\n                     -> Maybe (Coercion, Type)\n-- Attempt to do a *one-step* reduction of a type-family application\n--    but *not* newtypes\n-- Works on type-synonym families always; data-families only if\n--     the role we seek is representational\n-- It does *not* normlise the type arguments first, so this may not\n--     go as far as you want. If you want normalised type arguments,\n--     use normaliseTcArgs first.\n--\n-- The TyCon can be oversaturated.\n-- Works on both open and closed families\n--\n-- Always returns a *homogeneous* coercion -- type family reductions are always\n-- homogeneous\nreduceTyFamApp_maybe envs role tc tys\n  | Phantom <- role\n  = Nothing\n\n  | case role of\n      Representational -> isOpenFamilyTyCon     tc\n      _                -> isOpenTypeFamilyTyCon tc\n       -- If we seek a representational coercion\n       -- (e.g. the call in topNormaliseType_maybe) then we can\n       -- unwrap data families as well as type-synonym families;\n       -- otherwise only type-synonym families\n  , FamInstMatch { fim_instance = FamInst { fi_axiom = ax }\n                 , fim_tys      = inst_tys\n                 , fim_cos      = inst_cos } : _ <- lookupFamInstEnv envs tc tys\n      -- NB: Allow multiple matches because of compatible overlap\n\n  = let co = mkUnbranchedAxInstCo role ax inst_tys inst_cos\n        ty = pSnd (coercionKind co)\n    in Just (co, ty)\n\n  | Just ax <- isClosedSynFamilyTyConWithAxiom_maybe tc\n  , Just (ind, inst_tys, inst_cos) <- chooseBranch ax tys\n  = let co = mkAxInstCo role ax ind inst_tys inst_cos\n        ty = pSnd (coercionKind co)\n    in Just (co, ty)\n\n  | Just ax           <- isBuiltInSynFamTyCon_maybe tc\n  , Just (coax,ts,ty) <- sfMatchFam ax tys\n  = let co = mkAxiomRuleCo coax (zipWith mkReflCo (coaxrAsmpRoles coax) ts)\n    in Just (co, ty)\n\n  | otherwise\n  = Nothing\n\n-- The axiom can be oversaturated. (Closed families only.)\nchooseBranch :: CoAxiom Branched -> [Type]\n             -> Maybe (BranchIndex, [Type], [Coercion])  -- found match, with args\nchooseBranch axiom tys\n  = do { let num_pats = coAxiomNumPats axiom\n             (target_tys, extra_tys) = splitAt num_pats tys\n             branches = coAxiomBranches axiom\n       ; (ind, inst_tys, inst_cos)\n           <- findBranch (unMkBranches branches) target_tys\n       ; return ( ind, inst_tys `chkAppend` extra_tys, inst_cos ) }\n\n-- The axiom must *not* be oversaturated\nfindBranch :: Array BranchIndex CoAxBranch\n           -> [Type]\n           -> Maybe (BranchIndex, [Type], [Coercion])\n    -- coercions relate requested types to returned axiom LHS at role N\nfindBranch branches target_tys\n  = foldr go Nothing (assocs branches)\n  where\n    go :: (BranchIndex, CoAxBranch)\n       -> Maybe (BranchIndex, [Type], [Coercion])\n       -> Maybe (BranchIndex, [Type], [Coercion])\n    go (index, branch) other\n      = let (CoAxBranch { cab_tvs = tpl_tvs, cab_cvs = tpl_cvs\n                        , cab_lhs = tpl_lhs\n                        , cab_incomps = incomps }) = branch\n            in_scope = mkInScopeSet (unionVarSets $\n                            map (tyCoVarsOfTypes . coAxBranchLHS) incomps)\n            -- See Note [Flattening] below\n            flattened_target = flattenTys in_scope target_tys\n        in case tcMatchTys tpl_lhs target_tys of\n        Just subst -- matching worked. now, check for apartness.\n          |  apartnessCheck flattened_target branch\n          -> -- matching worked & we're apart from all incompatible branches.\n             -- success\n             ASSERT( all (isJust . lookupCoVar subst) tpl_cvs )\n             Just (index, substTyVars subst tpl_tvs, substCoVars subst tpl_cvs)\n\n        -- failure. keep looking\n        _ -> other\n\n-- | Do an apartness check, as described in the \"Closed Type Families\" paper\n-- (POPL '14). This should be used when determining if an equation\n-- ('CoAxBranch') of a closed type family can be used to reduce a certain target\n-- type family application.\napartnessCheck :: [Type]     -- ^ /flattened/ target arguments. Make sure\n                             -- they're flattened! See Note [Flattening].\n                             -- (NB: This \"flat\" is a different\n                             -- \"flat\" than is used in TcFlatten.)\n               -> CoAxBranch -- ^ the candidate equation we wish to use\n                             -- Precondition: this matches the target\n               -> Bool       -- ^ True <=> equation can fire\napartnessCheck flattened_target (CoAxBranch { cab_incomps = incomps })\n  = all (isSurelyApart\n         . tcUnifyTysFG (const BindMe) flattened_target\n         . coAxBranchLHS) incomps\n  where\n    isSurelyApart SurelyApart = True\n    isSurelyApart _           = False\n\n{-\n************************************************************************\n*                                                                      *\n                Looking up a family instance\n*                                                                      *\n************************************************************************\n\nNote [Normalising types]\n~~~~~~~~~~~~~~~~~~~~~~~~\nThe topNormaliseType function removes all occurrences of type families\nand newtypes from the top-level structure of a type. normaliseTcApp does\nthe type family lookup and is fairly straightforward. normaliseType is\na little more involved.\n\nThe complication comes from the fact that a type family might be used in the\nkind of a variable bound in a forall. We wish to remove this type family\napplication, but that means coming up with a fresh variable (with the new\nkind). Thus, we need a substitution to be built up as we recur through the\ntype. However, an ordinary TCvSubst just won't do: when we hit a type variable\nwhose kind has changed during normalisation, we need both the new type\nvariable *and* the coercion. We could conjure up a new VarEnv with just this\nproperty, but a usable substitution environment already exists:\nLiftingContexts from the liftCoSubst family of functions, defined in Coercion.\nA LiftingContext maps a type variable to a coercion and a coercion variable to\na pair of coercions. Let's ignore coercion variables for now. Because the\ncoercion a type variable maps to contains the destination type (via\ncoercionKind), we don't need to store that destination type separately. Thus,\na LiftingContext has what we need: a map from type variables to (Coercion,\nType) pairs.\n\nWe also benefit because we can piggyback on the liftCoSubstVarBndr function to\ndeal with binders. However, I had to modify that function to work with this\napplication. Thus, we now have liftCoSubstVarBndrUsing, which takes\na function used to process the kind of the binder. We don't wish\nto lift the kind, but instead normalise it. So, we pass in a callback function\nthat processes the kind of the binder.\n\nAfter that brilliant explanation of all this, I'm sure you've forgotten the\ndangling reference to coercion variables. What do we do with those? Nothing at\nall. The point of normalising types is to remove type family applications, but\nthere's no sense in removing these from coercions. We would just get back a\nnew coercion witnessing the equality between the same types as the original\ncoercion. Because coercions are irrelevant anyway, there is no point in doing\nthis. So, whenever we encounter a coercion, we just say that it won't change.\nThat's what the CoercionTy case is doing within normalise_type.\n\nNote [Normalisation and type synonyms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe need to be a bit careful about normalising in the presence of type\nsynonyms (Trac #13035).  Suppose S is a type synonym, and we have\n   S t1 t2\nIf S is family-free (on its RHS) we can just normalise t1 and t2 and\nreconstruct (S t1' t2').   Expanding S could not reveal any new redexes\nbecause type families are saturated.\n\nBut if S has a type family on its RHS we expand /before/ normalising\nthe args t1, t2.  If we normalise t1, t2 first, we'll re-normalise them\nafter expansion, and that can lead to /exponential/ behavour; see Trac #13035.\n\nNotice, though, that expanding first can in principle duplicate t1,t2,\nwhich might contain redexes. I'm sure you could conjure up an exponential\ncase by that route too, but it hasn't happened in practice yet!\n-}\n\ntopNormaliseType :: FamInstEnvs -> Type -> Type\ntopNormaliseType env ty = case topNormaliseType_maybe env ty of\n                            Just (_co, ty') -> ty'\n                            Nothing         -> ty\n\ntopNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe (Coercion, Type)\n\n-- ^ Get rid of *outermost* (or toplevel)\n--      * type function redex\n--      * data family redex\n--      * newtypes\n-- returning an appropriate Representational coercion.  Specifically, if\n--   topNormaliseType_maybe env ty = Just (co, ty')\n-- then\n--   (a) co :: ty ~R ty'\n--   (b) ty' is not a newtype, and is not a type-family or data-family redex\n--\n-- However, ty' can be something like (Maybe (F ty)), where\n-- (F ty) is a redex.\n--\n-- Always operates homogeneously: the returned type has the same kind as the\n-- original type, and the returned coercion is always homogeneous.\ntopNormaliseType_maybe env ty\n  = do { ((co, mkind_co), nty) <- topNormaliseTypeX stepper combine ty\n       ; return $ case mkind_co of\n           MRefl       -> (co, nty)\n           MCo kind_co -> let nty_casted = nty `mkCastTy` mkSymCo kind_co\n                              final_co   = mkCoherenceRightCo Representational nty\n                                                              (mkSymCo kind_co) co\n                          in (final_co, nty_casted) }\n  where\n    stepper = unwrapNewTypeStepper' `composeSteppers` tyFamStepper\n\n    combine (c1, mc1) (c2, mc2) = (c1 `mkTransCo` c2, mc1 `mkTransMCo` mc2)\n\n    unwrapNewTypeStepper' :: NormaliseStepper (Coercion, MCoercionN)\n    unwrapNewTypeStepper' rec_nts tc tys\n      = mapStepResult (, MRefl) $ unwrapNewTypeStepper rec_nts tc tys\n\n      -- second coercion below is the kind coercion relating the original type's kind\n      -- to the normalised type's kind\n    tyFamStepper :: NormaliseStepper (Coercion, MCoercionN)\n    tyFamStepper rec_nts tc tys  -- Try to step a type/data family\n      = let (args_co, ntys, res_co) = normaliseTcArgs env Representational tc tys in\n        case reduceTyFamApp_maybe env Representational tc ntys of\n          Just (co, rhs) -> NS_Step rec_nts rhs (args_co `mkTransCo` co, MCo res_co)\n          _              -> NS_Done\n\n---------------\nnormaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type)\n-- See comments on normaliseType for the arguments of this function\nnormaliseTcApp env role tc tys\n  = initNormM env role (tyCoVarsOfTypes tys) $\n    normalise_tc_app tc tys\n\n-- See Note [Normalising types] about the LiftingContext\nnormalise_tc_app :: TyCon -> [Type] -> NormM (Coercion, Type)\nnormalise_tc_app tc tys\n  | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys\n  , not (isFamFreeTyCon tc)  -- Expand and try again\n  = -- A synonym with type families in the RHS\n    -- Expand and try again\n    -- See Note [Normalisation and type synonyms]\n    normalise_type (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')\n\n  | isFamilyTyCon tc\n  = -- A type-family application\n    do { env <- getEnv\n       ; role <- getRole\n       ; (args_co, ntys, res_co) <- normalise_tc_args tc tys\n       ; case reduceTyFamApp_maybe env role tc ntys of\n           Just (first_co, ty')\n             -> do { (rest_co,nty) <- normalise_type ty'\n                   ; return (assemble_result role nty\n                                             (args_co `mkTransCo` first_co `mkTransCo` rest_co)\n                                             res_co) }\n           _ -> -- No unique matching family instance exists;\n                -- we do not do anything\n                return (assemble_result role (mkTyConApp tc ntys) args_co res_co) }\n\n  | otherwise\n  = -- A synonym with no type families in the RHS; or data type etc\n    -- Just normalise the arguments and rebuild\n    do { (args_co, ntys, res_co) <- normalise_tc_args tc tys\n       ; role <- getRole\n       ; return (assemble_result role (mkTyConApp tc ntys) args_co res_co) }\n\n  where\n    assemble_result :: Role       -- r, ambient role in NormM monad\n                    -> Type       -- nty, result type, possibly of changed kind\n                    -> Coercion   -- orig_ty ~r nty, possibly heterogeneous\n                    -> CoercionN  -- typeKind(orig_ty) ~N typeKind(nty)\n                    -> (Coercion, Type)   -- (co :: orig_ty ~r nty_casted, nty_casted)\n                                          -- where nty_casted has same kind as orig_ty\n    assemble_result r nty orig_to_nty kind_co\n      = ( final_co, nty_old_kind )\n      where\n        nty_old_kind = nty `mkCastTy` mkSymCo kind_co\n        final_co     = mkCoherenceRightCo r nty (mkSymCo kind_co) orig_to_nty\n\n---------------\n-- | Normalise arguments to a tycon\nnormaliseTcArgs :: FamInstEnvs          -- ^ env't with family instances\n                -> Role                 -- ^ desired role of output coercion\n                -> TyCon                -- ^ tc\n                -> [Type]               -- ^ tys\n                -> (Coercion, [Type], CoercionN)\n                                        -- ^ co :: tc tys ~ tc new_tys\n                                        -- NB: co might not be homogeneous\n                                        -- last coercion :: kind(tc tys) ~ kind(tc new_tys)\nnormaliseTcArgs env role tc tys\n  = initNormM env role (tyCoVarsOfTypes tys) $\n    normalise_tc_args tc tys\n\nnormalise_tc_args :: TyCon -> [Type]             -- tc tys\n                  -> NormM (Coercion, [Type], CoercionN)\n                  -- (co, new_tys), where\n                  -- co :: tc tys ~ tc new_tys; might not be homogeneous\n                  -- res_co :: typeKind(tc tys) ~N typeKind(tc new_tys)\nnormalise_tc_args tc tys\n  = do { role <- getRole\n       ; (args_cos, nargs, res_co) <- normalise_args (tyConKind tc) (tyConRolesX role tc) tys\n       ; return (mkTyConAppCo role tc args_cos, nargs, res_co) }\n\n---------------\nnormaliseType :: FamInstEnvs\n              -> Role  -- desired role of coercion\n              -> Type -> (Coercion, Type)\nnormaliseType env role ty\n  = initNormM env role (tyCoVarsOfType ty) $ normalise_type ty\n\nnormalise_type :: Type                     -- old type\n               -> NormM (Coercion, Type)   -- (coercion, new type), where\n                                           -- co :: old-type ~ new_type\n-- Normalise the input type, by eliminating *all* type-function redexes\n-- but *not* newtypes (which are visible to the programmer)\n-- Returns with Refl if nothing happens\n-- Does nothing to newtypes\n-- The returned coercion *must* be *homogeneous*\n-- See Note [Normalising types]\n-- Try not to disturb type synonyms if possible\n\nnormalise_type ty\n  = go ty\n  where\n    go (TyConApp tc tys) = normalise_tc_app tc tys\n    go ty@(LitTy {})     = do { r <- getRole\n                              ; return (mkReflCo r ty, ty) }\n\n    go (AppTy ty1 ty2) = go_app_tys ty1 [ty2]\n\n    go ty@(FunTy { ft_arg = ty1, ft_res = ty2 })\n      = do { (co1, nty1) <- go ty1\n           ; (co2, nty2) <- go ty2\n           ; r <- getRole\n           ; return (mkFunCo r co1 co2, ty { ft_arg = nty1, ft_res = nty2 }) }\n    go (ForAllTy (Bndr tcvar vis) ty)\n      = do { (lc', tv', h, ki') <- normalise_var_bndr tcvar\n           ; (co, nty)          <- withLC lc' $ normalise_type ty\n           ; let tv2 = setTyVarKind tv' ki'\n           ; return (mkForAllCo tv' h co, ForAllTy (Bndr tv2 vis) nty) }\n    go (TyVarTy tv)    = normalise_tyvar tv\n    go (CastTy ty co)\n      = do { (nco, nty) <- go ty\n           ; lc <- getLC\n           ; let co' = substRightCo lc co\n           ; return (castCoercionKind nco Nominal ty nty co co'\n                    , mkCastTy nty co') }\n    go (CoercionTy co)\n      = do { lc <- getLC\n           ; r <- getRole\n           ; let right_co = substRightCo lc co\n           ; return ( mkProofIrrelCo r\n                         (liftCoSubst Nominal lc (coercionType co))\n                         co right_co\n                    , mkCoercionTy right_co ) }\n\n    go_app_tys :: Type   -- function\n               -> [Type] -- args\n               -> NormM (Coercion, Type)\n    -- cf. TcFlatten.flatten_app_ty_args\n    go_app_tys (AppTy ty1 ty2) tys = go_app_tys ty1 (ty2 : tys)\n    go_app_tys fun_ty arg_tys\n      = do { (fun_co, nfun) <- go fun_ty\n           ; case tcSplitTyConApp_maybe nfun of\n               Just (tc, xis) ->\n                 do { (second_co, nty) <- go (mkTyConApp tc (xis ++ arg_tys))\n                   -- flatten_app_ty_args avoids redundantly processing the xis,\n                   -- but that's a much more performance-sensitive function.\n                   -- This type normalisation is not called in a loop.\n                    ; return (mkAppCos fun_co (map mkNomReflCo arg_tys) `mkTransCo` second_co, nty) }\n               Nothing ->\n                 do { (args_cos, nargs, res_co) <- normalise_args (typeKind nfun)\n                                                                  (repeat Nominal)\n                                                                  arg_tys\n                    ; role <- getRole\n                    ; let nty = mkAppTys nfun nargs\n                          nco = mkAppCos fun_co args_cos\n                          nty_casted = nty `mkCastTy` mkSymCo res_co\n                          final_co = mkCoherenceRightCo role nty (mkSymCo res_co) nco\n                    ; return (final_co, nty_casted) } }\n\nnormalise_args :: Kind    -- of the function\n               -> [Role]  -- roles at which to normalise args\n               -> [Type]  -- args\n               -> NormM ([Coercion], [Type], Coercion)\n-- returns (cos, xis, res_co), where each xi is the normalised\n-- version of the corresponding type, each co is orig_arg ~ xi,\n-- and the res_co :: kind(f orig_args) ~ kind(f xis)\n-- NB: The xis might *not* have the same kinds as the input types,\n-- but the resulting application *will* be well-kinded\n-- cf. TcFlatten.flatten_args_slow\nnormalise_args fun_ki roles args\n  = do { normed_args <- zipWithM normalise1 roles args\n       ; let (xis, cos, res_co) = simplifyArgsWorker ki_binders inner_ki fvs roles normed_args\n       ; return (map mkSymCo cos, xis, mkSymCo res_co) }\n  where\n    (ki_binders, inner_ki) = splitPiTys fun_ki\n    fvs = tyCoVarsOfTypes args\n\n    -- flattener conventions are different from ours\n    impedance_match :: NormM (Coercion, Type) -> NormM (Type, Coercion)\n    impedance_match action = do { (co, ty) <- action\n                                ; return (ty, mkSymCo co) }\n\n    normalise1 role ty\n      = impedance_match $ withRole role $ normalise_type ty\n\nnormalise_tyvar :: TyVar -> NormM (Coercion, Type)\nnormalise_tyvar tv\n  = ASSERT( isTyVar tv )\n    do { lc <- getLC\n       ; r  <- getRole\n       ; return $ case liftCoSubstTyVar lc r tv of\n           Just co -> (co, pSnd $ coercionKind co)\n           Nothing -> (mkReflCo r ty, ty) }\n  where ty = mkTyVarTy tv\n\nnormalise_var_bndr :: TyCoVar -> NormM (LiftingContext, TyCoVar, Coercion, Kind)\nnormalise_var_bndr tcvar\n  -- works for both tvar and covar\n  = do { lc1 <- getLC\n       ; env <- getEnv\n       ; let callback lc ki = runNormM (normalise_type ki) env lc Nominal\n       ; return $ liftCoSubstVarBndrUsing callback lc1 tcvar }\n\n-- | a monad for the normalisation functions, reading 'FamInstEnvs',\n-- a 'LiftingContext', and a 'Role'.\nnewtype NormM a = NormM { runNormM ::\n                            FamInstEnvs -> LiftingContext -> Role -> a }\n\ninitNormM :: FamInstEnvs -> Role\n          -> TyCoVarSet   -- the in-scope variables\n          -> NormM a -> a\ninitNormM env role vars (NormM thing_inside)\n  = thing_inside env lc role\n  where\n    in_scope = mkInScopeSet vars\n    lc       = emptyLiftingContext in_scope\n\ngetRole :: NormM Role\ngetRole = NormM (\\ _ _ r -> r)\n\ngetLC :: NormM LiftingContext\ngetLC = NormM (\\ _ lc _ -> lc)\n\ngetEnv :: NormM FamInstEnvs\ngetEnv = NormM (\\ env _ _ -> env)\n\nwithRole :: Role -> NormM a -> NormM a\nwithRole r thing = NormM $ \\ envs lc _old_r -> runNormM thing envs lc r\n\nwithLC :: LiftingContext -> NormM a -> NormM a\nwithLC lc thing = NormM $ \\ envs _old_lc r -> runNormM thing envs lc r\n\ninstance Monad NormM where\n  ma >>= fmb = NormM $ \\env lc r ->\n               let a = runNormM ma env lc r in\n               runNormM (fmb a) env lc r\n\ninstance Functor NormM where\n  fmap = liftM\ninstance Applicative NormM where\n  pure x = NormM $ \\ _ _ _ -> x\n  (<*>)  = ap\n\n{-\n************************************************************************\n*                                                                      *\n              Flattening\n*                                                                      *\n************************************************************************\n\nNote [Flattening]\n~~~~~~~~~~~~~~~~~\nAs described in \"Closed type families with overlapping equations\"\nhttp://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-extended.pdf\nwe need to flatten core types before unifying them, when checking for \"surely-apart\"\nagainst earlier equations of a closed type family.\nFlattening means replacing all top-level uses of type functions with\nfresh variables, *taking care to preserve sharing*. That is, the type\n(Either (F a b) (F a b)) should flatten to (Either c c), never (Either\nc d).\n\nHere is a nice example of why it's all necessary:\n\n  type family F a b where\n    F Int Bool = Char\n    F a   b    = Double\n  type family G a         -- open, no instances\n\nHow do we reduce (F (G Float) (G Float))? The first equation clearly doesn't match,\nwhile the second equation does. But, before reducing, we must make sure that the\ntarget can never become (F Int Bool). Well, no matter what G Float becomes, it\ncertainly won't become *both* Int and Bool, so indeed we're safe reducing\n(F (G Float) (G Float)) to Double.\n\nThis is necessary not only to get more reductions (which we might be\nwilling to give up on), but for substitutivity. If we have (F x x), we\ncan see that (F x x) can reduce to Double. So, it had better be the\ncase that (F blah blah) can reduce to Double, no matter what (blah)\nis!  Flattening as done below ensures this.\n\nflattenTys is defined here because of module dependencies.\n-}\n\ndata FlattenEnv = FlattenEnv { fe_type_map :: TypeMap TyVar\n                             , fe_subst    :: TCvSubst }\n\nemptyFlattenEnv :: InScopeSet -> FlattenEnv\nemptyFlattenEnv in_scope\n  = FlattenEnv { fe_type_map = emptyTypeMap\n               , fe_subst    = mkEmptyTCvSubst in_scope }\n\n-- See Note [Flattening]\nflattenTys :: InScopeSet -> [Type] -> [Type]\nflattenTys in_scope tys = snd $ coreFlattenTys env tys\n  where\n    -- when we hit a type function, we replace it with a fresh variable\n    -- but, we need to make sure that this fresh variable isn't mentioned\n    -- *anywhere* in the types we're flattening, even if locally-bound in\n    -- a forall. That way, we can ensure consistency both within and outside\n    -- of that forall.\n    all_in_scope = in_scope `extendInScopeSetSet` allTyCoVarsInTys tys\n    env          = emptyFlattenEnv all_in_scope\n\ncoreFlattenTys :: FlattenEnv -> [Type] -> (FlattenEnv, [Type])\ncoreFlattenTys = go []\n  where\n    go rtys env []         = (env, reverse rtys)\n    go rtys env (ty : tys)\n      = let (env', ty') = coreFlattenTy env ty in\n        go (ty' : rtys) env' tys\n\ncoreFlattenTy :: FlattenEnv -> Type -> (FlattenEnv, Type)\ncoreFlattenTy = go\n  where\n    go env ty | Just ty' <- coreView ty = go env ty'\n\n    go env (TyVarTy tv)    = (env, substTyVar (fe_subst env) tv)\n    go env (AppTy ty1 ty2) = let (env1, ty1') = go env  ty1\n                                 (env2, ty2') = go env1 ty2 in\n                             (env2, AppTy ty1' ty2')\n    go env (TyConApp tc tys)\n         -- NB: Don't just check if isFamilyTyCon: this catches *data* families,\n         -- which are generative and thus can be preserved during flattening\n      | not (isGenerativeTyCon tc Nominal)\n      = let (env', tv) = coreFlattenTyFamApp env tc tys in\n        (env', mkTyVarTy tv)\n\n      | otherwise\n      = let (env', tys') = coreFlattenTys env tys in\n        (env', mkTyConApp tc tys')\n\n    go env ty@(FunTy { ft_arg = ty1, ft_res = ty2 })\n      = let (env1, ty1') = go env  ty1\n            (env2, ty2') = go env1 ty2 in\n        (env2, ty { ft_arg = ty1', ft_res = ty2' })\n\n    go env (ForAllTy (Bndr tv vis) ty)\n      = let (env1, tv') = coreFlattenVarBndr env tv\n            (env2, ty') = go env1 ty in\n        (env2, ForAllTy (Bndr tv' vis) ty')\n\n    go env ty@(LitTy {}) = (env, ty)\n\n    go env (CastTy ty co) = let (env1, ty') = go env ty\n                                (env2, co') = coreFlattenCo env1 co in\n                            (env2, CastTy ty' co')\n\n    go env (CoercionTy co) = let (env', co') = coreFlattenCo env co in\n                             (env', CoercionTy co')\n\n-- when flattening, we don't care about the contents of coercions.\n-- so, just return a fresh variable of the right (flattened) type\ncoreFlattenCo :: FlattenEnv -> Coercion -> (FlattenEnv, Coercion)\ncoreFlattenCo env co\n  = (env2, mkCoVarCo covar)\n  where\n    (env1, kind') = coreFlattenTy env (coercionType co)\n    fresh_name    = mkFlattenFreshCoName\n    subst1        = fe_subst env1\n    in_scope      = getTCvInScope subst1\n    covar         = uniqAway in_scope (mkCoVar fresh_name kind')\n    env2          = env1 { fe_subst = subst1 `extendTCvInScope` covar }\n\ncoreFlattenVarBndr :: FlattenEnv -> TyCoVar -> (FlattenEnv, TyCoVar)\ncoreFlattenVarBndr env tv\n  | kind' `eqType` kind\n  = ( env { fe_subst = extendTCvSubst old_subst tv (mkTyCoVarTy tv) }\n             -- override any previous binding for tv\n    , tv)\n\n  | otherwise\n  = let new_tv    = uniqAway (getTCvInScope old_subst) (setVarType tv kind')\n        new_subst = extendTCvSubstWithClone old_subst tv new_tv\n    in\n    (env' { fe_subst = new_subst }, new_tv)\n  where\n    kind          = varType tv\n    (env', kind') = coreFlattenTy env kind\n    old_subst     = fe_subst env\n\ncoreFlattenTyFamApp :: FlattenEnv\n                    -> TyCon         -- type family tycon\n                    -> [Type]        -- args\n                    -> (FlattenEnv, TyVar)\ncoreFlattenTyFamApp env fam_tc fam_args\n  = case lookupTypeMap type_map fam_ty of\n      Just tv -> (env, tv)\n              -- we need fresh variables here, but this is called far from\n              -- any good source of uniques. So, we just use the fam_tc's unique\n              -- and trust uniqAway to avoid clashes. Recall that the in_scope set\n              -- contains *all* tyvars, even locally bound ones elsewhere in the\n              -- overall type, so this really is fresh.\n      Nothing -> let tyvar_name = mkFlattenFreshTyName fam_tc\n                     tv = uniqAway (getTCvInScope subst) $\n                          mkTyVar tyvar_name (typeKind fam_ty)\n                     env' = env { fe_type_map = extendTypeMap type_map fam_ty tv\n                                , fe_subst = extendTCvInScope subst tv }\n                 in (env', tv)\n  where fam_ty   = mkTyConApp fam_tc fam_args\n        FlattenEnv { fe_type_map = type_map\n                   , fe_subst = subst } = env\n\n-- | Get the set of all type/coercion variables mentioned anywhere in the list\n-- of types. These variables are not necessarily free.\nallTyCoVarsInTys :: [Type] -> VarSet\nallTyCoVarsInTys []       = emptyVarSet\nallTyCoVarsInTys (ty:tys) = allTyCoVarsInTy ty `unionVarSet` allTyCoVarsInTys tys\n\n-- | Get the set of all type/coercion variables mentioned anywhere in a type.\nallTyCoVarsInTy :: Type -> VarSet\nallTyCoVarsInTy = go\n  where\n    go (TyVarTy tv)      = unitVarSet tv\n    go (TyConApp _ tys)  = allTyCoVarsInTys tys\n    go (AppTy ty1 ty2)   = (go ty1) `unionVarSet` (go ty2)\n    go (FunTy _ ty1 ty2) = (go ty1) `unionVarSet` (go ty2)\n    go (ForAllTy (Bndr tv _) ty) = unitVarSet tv     `unionVarSet`\n                                   go (tyVarKind tv) `unionVarSet`\n                                   go ty\n                                   -- Don't remove the tv from the set!\n    go (LitTy {})        = emptyVarSet\n    go (CastTy ty co)    = go ty `unionVarSet` go_co co\n    go (CoercionTy co)   = go_co co\n\n    go_mco MRefl    = emptyVarSet\n    go_mco (MCo co) = go_co co\n\n    go_co (Refl ty)             = go ty\n    go_co (GRefl _ ty mco)      = go ty `unionVarSet` go_mco mco\n    go_co (TyConAppCo _ _ args) = go_cos args\n    go_co (AppCo co arg)        = go_co co `unionVarSet` go_co arg\n    go_co (ForAllCo tv h co)\n      = unionVarSets [unitVarSet tv, go_co co, go_co h]\n    go_co (FunCo _ c1 c2)       = go_co c1 `unionVarSet` go_co c2\n    go_co (CoVarCo cv)          = unitVarSet cv\n    go_co (HoleCo h)            = unitVarSet (coHoleCoVar h)\n    go_co (AxiomInstCo _ _ cos) = go_cos cos\n    go_co (UnivCo p _ t1 t2)    = go_prov p `unionVarSet` go t1 `unionVarSet` go t2\n    go_co (SymCo co)            = go_co co\n    go_co (TransCo c1 c2)       = go_co c1 `unionVarSet` go_co c2\n    go_co (NthCo _ _ co)        = go_co co\n    go_co (LRCo _ co)           = go_co co\n    go_co (InstCo co arg)       = go_co co `unionVarSet` go_co arg\n    go_co (KindCo co)           = go_co co\n    go_co (SubCo co)            = go_co co\n    go_co (AxiomRuleCo _ cs)    = go_cos cs\n\n    go_cos = foldr (unionVarSet . go_co) emptyVarSet\n\n    go_prov UnsafeCoerceProv    = emptyVarSet\n    go_prov (PhantomProv co)    = go_co co\n    go_prov (ProofIrrelProv co) = go_co co\n    go_prov (PluginProv _)      = emptyVarSet\n\nmkFlattenFreshTyName :: Uniquable a => a -> Name\nmkFlattenFreshTyName unq\n  = mkSysTvName (getUnique unq) (fsLit \"flt\")\n\nmkFlattenFreshCoName :: Name\nmkFlattenFreshCoName\n  = mkSystemVarName (deriveUnique eqPrimTyConKey 71) (fsLit \"flc\")\n", "num_lines": 1755}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[InstEnv]{Utilities for typechecking instance declarations}\n\nThe bits common to TcInstDcls and TcDeriv.\n-}\n\n{-# LANGUAGE CPP, DeriveDataTypeable #-}\n\nmodule InstEnv (\n        DFunId, InstMatch, ClsInstLookupResult,\n        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,\n        ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances,\n        instanceHead, instanceSig, mkLocalInstance, mkImportedInstance,\n        instanceDFunId, tidyClsInstDFun, instanceRoughTcs,\n        fuzzyClsInstCmp, orphNamesOfClsInst,\n\n        InstEnvs(..), VisibleOrphanModules, InstEnv,\n        emptyInstEnv, extendInstEnv,\n        deleteFromInstEnv, deleteDFunFromInstEnv,\n        identicalClsInstHead,\n        extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts,\n        memberInstEnv,\n        instIsVisible,\n        classInstances, instanceBindFun,\n        instanceCantMatch, roughMatchTcs,\n        isOverlappable, isOverlapping, isIncoherent\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport TcType -- InstEnv is really part of the type checker,\n              -- and depends on TcType in many ways\nimport CoreSyn ( IsOrphan(..), isOrphan, chooseOrphanAnchor )\nimport Module\nimport Class\nimport Var\nimport VarSet\nimport Name\nimport NameSet\nimport Unify\nimport Outputable\nimport ErrUtils\nimport BasicTypes\nimport UniqDFM\nimport Util\nimport Id\nimport Data.Data        ( Data )\nimport Data.Maybe       ( isJust, isNothing )\n\n{-\n************************************************************************\n*                                                                      *\n           ClsInst: the data type for type-class instances\n*                                                                      *\n************************************************************************\n-}\n\n-- | A type-class instance. Note that there is some tricky laziness at work\n-- here. See Note [ClsInst laziness and the rough-match fields] for more\n-- details.\ndata ClsInst\n  = ClsInst {   -- Used for \"rough matching\"; see\n                -- Note [ClsInst laziness and the rough-match fields]\n                -- INVARIANT: is_tcs = roughMatchTcs is_tys\n               is_cls_nm :: Name        -- ^ Class name\n             , is_tcs  :: [Maybe Name]  -- ^ Top of type args\n\n               -- | @is_dfun_name = idName . is_dfun@.\n               --\n               -- We use 'is_dfun_name' for the visibility check,\n               -- 'instIsVisible', which needs to know the 'Module' which the\n               -- dictionary is defined in. However, we cannot use the 'Module'\n               -- attached to 'is_dfun' since doing so would mean we would\n               -- potentially pull in an entire interface file unnecessarily.\n               -- This was the cause of #12367.\n             , is_dfun_name :: Name\n\n                -- Used for \"proper matching\"; see Note [Proper-match fields]\n             , is_tvs  :: [TyVar]       -- Fresh template tyvars for full match\n                                        -- See Note [Template tyvars are fresh]\n             , is_cls  :: Class         -- The real class\n             , is_tys  :: [Type]        -- Full arg types (mentioning is_tvs)\n                -- INVARIANT: is_dfun Id has type\n                --      forall is_tvs. (...) => is_cls is_tys\n                -- (modulo alpha conversion)\n\n             , is_dfun :: DFunId -- See Note [Haddock assumptions]\n\n             , is_flag :: OverlapFlag   -- See detailed comments with\n                                        -- the decl of BasicTypes.OverlapFlag\n             , is_orphan :: IsOrphan\n    }\n  deriving Data\n\n-- | A fuzzy comparison function for class instances, intended for sorting\n-- instances before displaying them to the user.\nfuzzyClsInstCmp :: ClsInst -> ClsInst -> Ordering\nfuzzyClsInstCmp x y =\n    stableNameCmp (is_cls_nm x) (is_cls_nm y) `mappend`\n    mconcat (map cmp (zip (is_tcs x) (is_tcs y)))\n  where\n    cmp (Nothing, Nothing) = EQ\n    cmp (Nothing, Just _) = LT\n    cmp (Just _, Nothing) = GT\n    cmp (Just x, Just y) = stableNameCmp x y\n\nisOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool\nisOverlappable i = hasOverlappableFlag (overlapMode (is_flag i))\nisOverlapping  i = hasOverlappingFlag  (overlapMode (is_flag i))\nisIncoherent   i = hasIncoherentFlag   (overlapMode (is_flag i))\n\n{-\nNote [ClsInst laziness and the rough-match fields]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we load 'instance A.C B.T' from A.hi, but suppose that the type B.T is\notherwise unused in the program. Then it's stupid to load B.hi, the data type\ndeclaration for B.T -- and perhaps further instance declarations!\n\nWe avoid this as follows:\n\n* is_cls_nm, is_tcs, is_dfun_name are all Names. We can poke them to our heart's\n  content.\n\n* Proper-match fields. is_dfun, and its related fields is_tvs, is_cls, is_tys\n  contain TyVars, Class, Type, Class etc, and so are all lazy thunks. When we\n  poke any of these fields we'll typecheck the DFunId declaration, and hence\n  pull in interfaces that it refers to. See Note [Proper-match fields].\n\n* Rough-match fields. During instance lookup, we use the is_cls_nm :: Name and\n  is_tcs :: [Maybe Name] fields to perform a \"rough match\", *without* poking\n  inside the DFunId. The rough-match fields allow us to say \"definitely does not\n  match\", based only on Names.\n\n  This laziness is very important; see Trac #12367. Try hard to avoid pulling on\n  the structured fields unless you really need the instance.\n\n* Another place to watch is InstEnv.instIsVisible, which needs the module to\n  which the ClsInst belongs. We can get this from is_dfun_name.\n\n* In is_tcs,\n    Nothing  means that this type arg is a type variable\n\n    (Just n) means that this type arg is a\n                TyConApp with a type constructor of n.\n                This is always a real tycon, never a synonym!\n                (Two different synonyms might match, but two\n                different real tycons can't.)\n                NB: newtypes are not transparent, though!\n-}\n\n{-\nNote [Template tyvars are fresh]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe is_tvs field of a ClsInst has *completely fresh* tyvars.\nThat is, they are\n  * distinct from any other ClsInst\n  * distinct from any tyvars free in predicates that may\n    be looked up in the class instance environment\nReason for freshness: we use unification when checking for overlap\netc, and that requires the tyvars to be distinct.\n\nThe invariant is checked by the ASSERT in lookupInstEnv'.\n\nNote [Proper-match fields]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nThe is_tvs, is_cls, is_tys fields are simply cached values, pulled\nout (lazily) from the dfun id. They are cached here simply so\nthat we don't need to decompose the DFunId each time we want\nto match it.  The hope is that the rough-match fields mean\nthat we often never poke the proper-match fields.\n\nHowever, note that:\n * is_tvs must be a superset of the free vars of is_tys\n\n * is_tvs, is_tys may be alpha-renamed compared to the ones in\n   the dfun Id\n\nNote [Haddock assumptions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor normal user-written instances, Haddock relies on\n\n * the SrcSpan of\n * the Name of\n * the is_dfun of\n * an Instance\n\nbeing equal to\n\n  * the SrcSpan of\n  * the instance head type of\n  * the InstDecl used to construct the Instance.\n-}\n\ninstanceDFunId :: ClsInst -> DFunId\ninstanceDFunId = is_dfun\n\ntidyClsInstDFun :: (DFunId -> DFunId) -> ClsInst -> ClsInst\ntidyClsInstDFun tidy_dfun ispec\n  = ispec { is_dfun = tidy_dfun (is_dfun ispec) }\n\ninstanceRoughTcs :: ClsInst -> [Maybe Name]\ninstanceRoughTcs = is_tcs\n\n\ninstance NamedThing ClsInst where\n   getName ispec = getName (is_dfun ispec)\n\ninstance Outputable ClsInst where\n   ppr = pprInstance\n\npprInstance :: ClsInst -> SDoc\n-- Prints the ClsInst as an instance declaration\npprInstance ispec\n  = hang (pprInstanceHdr ispec)\n       2 (vcat [ text \"--\" <+> pprDefinedAt (getName ispec)\n               , whenPprDebug (ppr (is_dfun ispec)) ])\n\n-- * pprInstanceHdr is used in VStudio to populate the ClassView tree\npprInstanceHdr :: ClsInst -> SDoc\n-- Prints the ClsInst as an instance declaration\npprInstanceHdr (ClsInst { is_flag = flag, is_dfun = dfun })\n  = text \"instance\" <+> ppr flag <+> pprSigmaType (idType dfun)\n\npprInstances :: [ClsInst] -> SDoc\npprInstances ispecs = vcat (map pprInstance ispecs)\n\ninstanceHead :: ClsInst -> ([TyVar], Class, [Type])\n-- Returns the head, using the fresh tyavs from the ClsInst\ninstanceHead (ClsInst { is_tvs = tvs, is_tys = tys, is_dfun = dfun })\n   = (tvs, cls, tys)\n   where\n     (_, _, cls, _) = tcSplitDFunTy (idType dfun)\n\n-- | Collects the names of concrete types and type constructors that make\n-- up the head of a class instance. For instance, given `class Foo a b`:\n--\n-- `instance Foo (Either (Maybe Int) a) Bool` would yield\n--      [Either, Maybe, Int, Bool]\n--\n-- Used in the implementation of \":info\" in GHCi.\n--\n-- The 'tcSplitSigmaTy' is because of\n--      instance Foo a => Baz T where ...\n-- The decl is an orphan if Baz and T are both not locally defined,\n--      even if Foo *is* locally defined\norphNamesOfClsInst :: ClsInst -> NameSet\norphNamesOfClsInst (ClsInst { is_cls_nm = cls_nm, is_tys = tys })\n  = orphNamesOfTypes tys `unionNameSet` unitNameSet cls_nm\n\ninstanceSig :: ClsInst -> ([TyVar], [Type], Class, [Type])\n-- Decomposes the DFunId\ninstanceSig ispec = tcSplitDFunTy (idType (is_dfun ispec))\n\nmkLocalInstance :: DFunId -> OverlapFlag\n                -> [TyVar] -> Class -> [Type]\n                -> ClsInst\n-- Used for local instances, where we can safely pull on the DFunId.\n-- Consider using newClsInst instead; this will also warn if\n-- the instance is an orphan.\nmkLocalInstance dfun oflag tvs cls tys\n  = ClsInst { is_flag = oflag, is_dfun = dfun\n            , is_tvs = tvs\n            , is_dfun_name = dfun_name\n            , is_cls = cls, is_cls_nm = cls_name\n            , is_tys = tys, is_tcs = roughMatchTcs tys\n            , is_orphan = orph\n            }\n  where\n    cls_name = className cls\n    dfun_name = idName dfun\n    this_mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name\n    is_local name = nameIsLocalOrFrom this_mod name\n\n        -- Compute orphanhood.  See Note [Orphans] in InstEnv\n    (cls_tvs, fds) = classTvsFds cls\n    arg_names = [filterNameSet is_local (orphNamesOfType ty) | ty <- tys]\n\n    -- See Note [When exactly is an instance decl an orphan?]\n    orph | is_local cls_name = NotOrphan (nameOccName cls_name)\n         | all notOrphan mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns\n         | otherwise         = IsOrphan\n\n    notOrphan NotOrphan{} = True\n    notOrphan _ = False\n\n    mb_ns :: [IsOrphan]    -- One for each fundep; a locally-defined name\n                           -- that is not in the \"determined\" arguments\n    mb_ns | null fds   = [choose_one arg_names]\n          | otherwise  = map do_one fds\n    do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names\n                                            , not (tv `elem` rtvs)]\n\n    choose_one nss = chooseOrphanAnchor (unionNameSets nss)\n\nmkImportedInstance :: Name         -- ^ the name of the class\n                   -> [Maybe Name] -- ^ the types which the class was applied to\n                   -> Name         -- ^ the 'Name' of the dictionary binding\n                   -> DFunId       -- ^ the 'Id' of the dictionary.\n                   -> OverlapFlag  -- ^ may this instance overlap?\n                   -> IsOrphan     -- ^ is this instance an orphan?\n                   -> ClsInst\n-- Used for imported instances, where we get the rough-match stuff\n-- from the interface file\n-- The bound tyvars of the dfun are guaranteed fresh, because\n-- the dfun has been typechecked out of the same interface file\nmkImportedInstance cls_nm mb_tcs dfun_name dfun oflag orphan\n  = ClsInst { is_flag = oflag, is_dfun = dfun\n            , is_tvs = tvs, is_tys = tys\n            , is_dfun_name = dfun_name\n            , is_cls_nm = cls_nm, is_cls = cls, is_tcs = mb_tcs\n            , is_orphan = orphan }\n  where\n    (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)\n\n{-\nNote [When exactly is an instance decl an orphan?]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  (see MkIface.instanceToIfaceInst, which implements this)\nRoughly speaking, an instance is an orphan if its head (after the =>)\nmentions nothing defined in this module.\n\nFunctional dependencies complicate the situation though. Consider\n\n  module M where { class C a b | a -> b }\n\nand suppose we are compiling module X:\n\n  module X where\n        import M\n        data T = ...\n        instance C Int T where ...\n\nThis instance is an orphan, because when compiling a third module Y we\nmight get a constraint (C Int v), and we'd want to improve v to T.  So\nwe must make sure X's instances are loaded, even if we do not directly\nuse anything from X.\n\nMore precisely, an instance is an orphan iff\n\n  If there are no fundeps, then at least of the names in\n  the instance head is locally defined.\n\n  If there are fundeps, then for every fundep, at least one of the\n  names free in a *non-determined* part of the instance head is\n  defined in this module.\n\n(Note that these conditions hold trivially if the class is locally\ndefined.)\n\n\n************************************************************************\n*                                                                      *\n                InstEnv, ClsInstEnv\n*                                                                      *\n************************************************************************\n\nA @ClsInstEnv@ all the instances of that class.  The @Id@ inside a\nClsInstEnv mapping is the dfun for that instance.\n\nIf class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then\n\n        forall a b, C t1 t2 t3  can be constructed by dfun\n\nor, to put it another way, we have\n\n        instance (...) => C t1 t2 t3,  witnessed by dfun\n-}\n\n---------------------------------------------------\n{-\nNote [InstEnv determinism]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe turn InstEnvs into a list in some places that don't directly affect\nthe ABI. That happens when we create output for `:info`.\nUnfortunately that nondeterminism is nonlocal and it's hard to tell what it\naffects without following a chain of functions. It's also easy to accidentally\nmake that nondeterminism affect the ABI. Furthermore the envs should be\nrelatively small, so it should be free to use deterministic maps here.\nTesting with nofib and validate detected no difference between UniqFM and\nUniqDFM. See also Note [Deterministic UniqFM]\n-}\n\ntype InstEnv = UniqDFM ClsInstEnv      -- Maps Class to instances for that class\n  -- See Note [InstEnv determinism]\n\n-- | 'InstEnvs' represents the combination of the global type class instance\n-- environment, the local type class instance environment, and the set of\n-- transitively reachable orphan modules (according to what modules have been\n-- directly imported) used to test orphan instance visibility.\ndata InstEnvs = InstEnvs {\n        ie_global  :: InstEnv,               -- External-package instances\n        ie_local   :: InstEnv,               -- Home-package instances\n        ie_visible :: VisibleOrphanModules   -- Set of all orphan modules transitively\n                                             -- reachable from the module being compiled\n                                             -- See Note [Instance lookup and orphan instances]\n    }\n\n-- | Set of visible orphan modules, according to what modules have been directly\n-- imported.  This is based off of the dep_orphs field, which records\n-- transitively reachable orphan modules (modules that define orphan instances).\ntype VisibleOrphanModules = ModuleSet\n\nnewtype ClsInstEnv\n  = ClsIE [ClsInst]    -- The instances for a particular class, in any order\n\ninstance Outputable ClsInstEnv where\n  ppr (ClsIE is) = pprInstances is\n\n-- INVARIANTS:\n--  * The is_tvs are distinct in each ClsInst\n--      of a ClsInstEnv (so we can safely unify them)\n\n-- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:\n--      [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]\n-- The \"a\" in the pattern must be one of the forall'd variables in\n-- the dfun type.\n\nemptyInstEnv :: InstEnv\nemptyInstEnv = emptyUDFM\n\ninstEnvElts :: InstEnv -> [ClsInst]\ninstEnvElts ie = [elt | ClsIE elts <- eltsUDFM ie, elt <- elts]\n  -- See Note [InstEnv determinism]\n\n-- | Test if an instance is visible, by checking that its origin module\n-- is in 'VisibleOrphanModules'.\n-- See Note [Instance lookup and orphan instances]\ninstIsVisible :: VisibleOrphanModules -> ClsInst -> Bool\ninstIsVisible vis_mods ispec\n  -- NB: Instances from the interactive package always are visible. We can't\n  -- add interactive modules to the set since we keep creating new ones\n  -- as a GHCi session progresses.\n  = case nameModule_maybe (is_dfun_name ispec) of\n      Nothing -> True\n      Just mod | isInteractiveModule mod     -> True\n               | IsOrphan <- is_orphan ispec -> mod `elemModuleSet` vis_mods\n               | otherwise                   -> True\n\nclassInstances :: InstEnvs -> Class -> [ClsInst]\nclassInstances (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods }) cls\n  = get home_ie ++ get pkg_ie\n  where\n    get env = case lookupUDFM env cls of\n                Just (ClsIE insts) -> filter (instIsVisible vis_mods) insts\n                Nothing            -> []\n\n-- | Checks for an exact match of ClsInst in the instance environment.\n-- We use this when we do signature checking in TcRnDriver\nmemberInstEnv :: InstEnv -> ClsInst -> Bool\nmemberInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm } ) =\n    maybe False (\\(ClsIE items) -> any (identicalDFunType ins_item) items)\n          (lookupUDFM inst_env cls_nm)\n where\n  identicalDFunType cls1 cls2 =\n    eqType (varType (is_dfun cls1)) (varType (is_dfun cls2))\n\nextendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv\nextendInstEnvList inst_env ispecs = foldl' extendInstEnv inst_env ispecs\n\nextendInstEnv :: InstEnv -> ClsInst -> InstEnv\nextendInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })\n  = addToUDFM_C add inst_env cls_nm (ClsIE [ins_item])\n  where\n    add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts)\n\ndeleteFromInstEnv :: InstEnv -> ClsInst -> InstEnv\ndeleteFromInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })\n  = adjustUDFM adjust inst_env cls_nm\n  where\n    adjust (ClsIE items) = ClsIE (filterOut (identicalClsInstHead ins_item) items)\n\ndeleteDFunFromInstEnv :: InstEnv -> DFunId -> InstEnv\n-- Delete a specific instance fron an InstEnv\ndeleteDFunFromInstEnv inst_env dfun\n  = adjustUDFM adjust inst_env cls\n  where\n    (_, _, cls, _) = tcSplitDFunTy (idType dfun)\n    adjust (ClsIE items) = ClsIE (filterOut same_dfun items)\n    same_dfun (ClsInst { is_dfun = dfun' }) = dfun == dfun'\n\nidenticalClsInstHead :: ClsInst -> ClsInst -> Bool\n-- ^ True when when the instance heads are the same\n-- e.g.  both are   Eq [(a,b)]\n-- Used for overriding in GHCi\n-- Obviously should be insenstive to alpha-renaming\nidenticalClsInstHead (ClsInst { is_cls_nm = cls_nm1, is_tcs = rough1, is_tys = tys1 })\n                     (ClsInst { is_cls_nm = cls_nm2, is_tcs = rough2, is_tys = tys2 })\n  =  cls_nm1 == cls_nm2\n  && not (instanceCantMatch rough1 rough2)  -- Fast check for no match, uses the \"rough match\" fields\n  && isJust (tcMatchTys tys1 tys2)\n  && isJust (tcMatchTys tys2 tys1)\n\n{-\n************************************************************************\n*                                                                      *\n        Looking up an instance\n*                                                                      *\n************************************************************************\n\n@lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since\nthe env is kept ordered, the first match must be the only one.  The\nthing we are looking up can have an arbitrary \"flexi\" part.\n\nNote [Instance lookup and orphan instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we are compiling a module M, and we have a zillion packages\nloaded, and we are looking up an instance for C (T W).  If we find a\nmatch in module 'X' from package 'p', should be \"in scope\"; that is,\n\n  is p:X in the transitive closure of modules imported from M?\n\nThe difficulty is that the \"zillion packages\" might include ones loaded\nthrough earlier invocations of the GHC API, or earlier module loads in GHCi.\nThey might not be in the dependencies of M itself; and if not, the instances\nin them should not be visible.  Trac #2182, #8427.\n\nThere are two cases:\n  * If the instance is *not an orphan*, then module X defines C, T, or W.\n    And in order for those types to be involved in typechecking M, it\n    must be that X is in the transitive closure of M's imports.  So we\n    can use the instance.\n\n  * If the instance *is an orphan*, the above reasoning does not apply.\n    So we keep track of the set of orphan modules transitively below M;\n    this is the ie_visible field of InstEnvs, of type VisibleOrphanModules.\n\n    If module p:X is in this set, then we can use the instance, otherwise\n    we can't.\n\nNote [Rules for instance lookup]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThese functions implement the carefully-written rules in the user\nmanual section on \"overlapping instances\". At risk of duplication,\nhere are the rules.  If the rules change, change this text and the\nuser manual simultaneously.  The link may be this:\nhttp://www.haskell.org/ghc/docs/latest/html/users_guide/glasgow_exts.html#instance-overlap\n\nThe willingness to be overlapped or incoherent is a property of the\ninstance declaration itself, controlled as follows:\n\n * An instance is \"incoherent\"\n   if it has an INCOHERENT pragma, or\n   if it appears in a module compiled with -XIncoherentInstances.\n\n * An instance is \"overlappable\"\n   if it has an OVERLAPPABLE or OVERLAPS pragma, or\n   if it appears in a module compiled with -XOverlappingInstances, or\n   if the instance is incoherent.\n\n * An instance is \"overlapping\"\n   if it has an OVERLAPPING or OVERLAPS pragma, or\n   if it appears in a module compiled with -XOverlappingInstances, or\n   if the instance is incoherent.\n     compiled with -XOverlappingInstances.\n\nNow suppose that, in some client module, we are searching for an instance\nof the target constraint (C ty1 .. tyn). The search works like this.\n\n*  Find all instances `I` that *match* the target constraint; that is, the\n   target constraint is a substitution instance of `I`. These instance\n   declarations are the *candidates*.\n\n*  Eliminate any candidate `IX` for which both of the following hold:\n\n   -  There is another candidate `IY` that is strictly more specific; that\n      is, `IY` is a substitution instance of `IX` but not vice versa.\n\n   -  Either `IX` is *overlappable*, or `IY` is *overlapping*. (This\n      \"either/or\" design, rather than a \"both/and\" design, allow a\n      client to deliberately override an instance from a library,\n      without requiring a change to the library.)\n\n-  If exactly one non-incoherent candidate remains, select it. If all\n   remaining candidates are incoherent, select an arbitrary one.\n   Otherwise the search fails (i.e. when more than one surviving\n   candidate is not incoherent).\n\n-  If the selected candidate (from the previous step) is incoherent, the\n   search succeeds, returning that candidate.\n\n-  If not, find all instances that *unify* with the target constraint,\n   but do not *match* it. Such non-candidate instances might match when\n   the target constraint is further instantiated. If all of them are\n   incoherent, the search succeeds, returning the selected candidate; if\n   not, the search fails.\n\nNotice that these rules are not influenced by flag settings in the\nclient module, where the instances are *used*. These rules make it\npossible for a library author to design a library that relies on\noverlapping instances without the client having to know.\n\nNote [Overlapping instances]   (NB: these notes are quite old)\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOverlap is permitted, but only in such a way that one can make\na unique choice when looking up.  That is, overlap is only permitted if\none template matches the other, or vice versa.  So this is ok:\n\n  [a]  [Int]\n\nbut this is not\n\n  (Int,a)  (b,Int)\n\nIf overlap is permitted, the list is kept most specific first, so that\nthe first lookup is the right choice.\n\n\nFor now we just use association lists.\n\n\\subsection{Avoiding a problem with overlapping}\n\nConsider this little program:\n\n\\begin{pseudocode}\n     class C a        where c :: a\n     class C a => D a where d :: a\n\n     instance C Int where c = 17\n     instance D Int where d = 13\n\n     instance C a => C [a] where c = [c]\n     instance ({- C [a], -} D a) => D [a] where d = c\n\n     instance C [Int] where c = [37]\n\n     main = print (d :: [Int])\n\\end{pseudocode}\n\nWhat do you think `main' prints  (assuming we have overlapping instances, and\nall that turned on)?  Well, the instance for `D' at type `[a]' is defined to\nbe `c' at the same type, and we've got an instance of `C' at `[Int]', so the\nanswer is `[37]', right? (the generic `C [a]' instance shouldn't apply because\nthe `C [Int]' instance is more specific).\n\nGhc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That\nwas easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old\nhugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it\ndoesn't even compile!  What's going on!?\n\nWhat hugs complains about is the `D [a]' instance decl.\n\n\\begin{pseudocode}\n     ERROR \"mj.hs\" (line 10): Cannot build superclass instance\n     *** Instance            : D [a]\n     *** Context supplied    : D a\n     *** Required superclass : C [a]\n\\end{pseudocode}\n\nYou might wonder what hugs is complaining about.  It's saying that you\nneed to add `C [a]' to the context of the `D [a]' instance (as appears\nin comments).  But there's that `C [a]' instance decl one line above\nthat says that I can reduce the need for a `C [a]' instance to the\nneed for a `C a' instance, and in this case, I already have the\nnecessary `C a' instance (since we have `D a' explicitly in the\ncontext, and `C' is a superclass of `D').\n\nUnfortunately, the above reasoning indicates a premature commitment to the\ngeneric `C [a]' instance.  I.e., it prematurely rules out the more specific\ninstance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to\nadd the context that hugs suggests (uncomment the `C [a]'), effectively\ndeferring the decision about which instance to use.\n\nNow, interestingly enough, 4.04 has this same bug, but it's covered up\nin this case by a little known `optimization' that was disabled in\n4.06.  Ghc-4.04 silently inserts any missing superclass context into\nan instance declaration.  In this case, it silently inserts the `C\n[a]', and everything happens to work out.\n\n(See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for\n`Mark Jones', although Mark claims no credit for the `optimization' in\nquestion, and would rather it stopped being called the `Mark Jones\noptimization' ;-)\n\nSo, what's the fix?  I think hugs has it right.  Here's why.  Let's try\nsomething else out with ghc-4.04.  Let's add the following line:\n\n    d' :: D a => [a]\n    d' = c\n\nEveryone raise their hand who thinks that `d :: [Int]' should give a\ndifferent answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The\n`optimization' only applies to instance decls, not to regular\nbindings, giving inconsistent behavior.\n\nOld hugs had this same bug.  Here's how we fixed it: like GHC, the\nlist of instances for a given class is ordered, so that more specific\ninstances come before more generic ones.  For example, the instance\nlist for C might contain:\n    ..., C Int, ..., C a, ...\nWhen we go to look for a `C Int' instance we'll get that one first.\nBut what if we go looking for a `C b' (`b' is unconstrained)?  We'll\npass the `C Int' instance, and keep going.  But if `b' is\nunconstrained, then we don't know yet if the more specific instance\nwill eventually apply.  GHC keeps going, and matches on the generic `C\na'.  The fix is to, at each step, check to see if there's a reverse\nmatch, and if so, abort the search.  This prevents hugs from\nprematurely chosing a generic instance when a more specific one\nexists.\n\n--Jeff\n\nBUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in\nthis test.  Suppose the instance envt had\n    ..., forall a b. C a a b, ..., forall a b c. C a b c, ...\n(still most specific first)\nNow suppose we are looking for (C x y Int), where x and y are unconstrained.\n        C x y Int  doesn't match the template {a,b} C a a b\nbut neither does\n        C a a b  match the template {x,y} C x y Int\nBut still x and y might subsequently be unified so they *do* match.\n\nSimple story: unify, don't match.\n-}\n\ntype DFunInstType = Maybe Type\n        -- Just ty   => Instantiate with this type\n        -- Nothing   => Instantiate with any type of this tyvar's kind\n        -- See Note [DFunInstType: instantiating types]\n\ntype InstMatch = (ClsInst, [DFunInstType])\n\ntype ClsInstLookupResult\n     = ( [InstMatch]     -- Successful matches\n       , [ClsInst]       -- These don't match but do unify\n       , [InstMatch] )   -- Unsafe overlapped instances under Safe Haskell\n                         -- (see Note [Safe Haskell Overlapping Instances] in\n                         -- TcSimplify).\n\n{-\nNote [DFunInstType: instantiating types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nA successful match is a ClsInst, together with the types at which\n        the dfun_id in the ClsInst should be instantiated\nThe instantiating types are (Either TyVar Type)s because the dfun\nmight have some tyvars that *only* appear in arguments\n        dfun :: forall a b. C a b, Ord b => D [a]\nWhen we match this against D [ty], we return the instantiating types\n        [Just ty, Nothing]\nwhere the 'Nothing' indicates that 'b' can be freely instantiated.\n(The caller instantiates it to a flexi type variable, which will\n presumably later become fixed via functional dependencies.)\n-}\n\n-- |Look up an instance in the given instance environment. The given class application must match exactly\n-- one instance and the match may not contain any flexi type variables.  If the lookup is unsuccessful,\n-- yield 'Left errorMessage'.\nlookupUniqueInstEnv :: InstEnvs\n                    -> Class -> [Type]\n                    -> Either MsgDoc (ClsInst, [Type])\nlookupUniqueInstEnv instEnv cls tys\n  = case lookupInstEnv False instEnv cls tys of\n      ([(inst, inst_tys)], _, _)\n             | noFlexiVar -> Right (inst, inst_tys')\n             | otherwise  -> Left $ text \"flexible type variable:\" <+>\n                                    (ppr $ mkTyConApp (classTyCon cls) tys)\n             where\n               inst_tys'  = [ty | Just ty <- inst_tys]\n               noFlexiVar = all isJust inst_tys\n      _other -> Left $ text \"instance not found\" <+>\n                       (ppr $ mkTyConApp (classTyCon cls) tys)\n\nlookupInstEnv' :: InstEnv          -- InstEnv to look in\n               -> VisibleOrphanModules   -- But filter against this\n               -> Class -> [Type]  -- What we are looking for\n               -> ([InstMatch],    -- Successful matches\n                   [ClsInst])      -- These don't match but do unify\n                                   -- (no incoherent ones in here)\n-- The second component of the result pair happens when we look up\n--      Foo [a]\n-- in an InstEnv that has entries for\n--      Foo [Int]\n--      Foo [b]\n-- Then which we choose would depend on the way in which 'a'\n-- is instantiated.  So we report that Foo [b] is a match (mapping b->a)\n-- but Foo [Int] is a unifier.  This gives the caller a better chance of\n-- giving a suitable error message\n\nlookupInstEnv' ie vis_mods cls tys\n  = lookup ie\n  where\n    rough_tcs  = roughMatchTcs tys\n    all_tvs    = all isNothing rough_tcs\n\n    --------------\n    lookup env = case lookupUDFM env cls of\n                   Nothing -> ([],[])   -- No instances for this class\n                   Just (ClsIE insts) -> find [] [] insts\n\n    --------------\n    find ms us [] = (ms, us)\n    find ms us (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs\n                              , is_tys = tpl_tys }) : rest)\n      | not (instIsVisible vis_mods item)\n      = find ms us rest  -- See Note [Instance lookup and orphan instances]\n\n        -- Fast check for no match, uses the \"rough match\" fields\n      | instanceCantMatch rough_tcs mb_tcs\n      = find ms us rest\n\n      | Just subst <- tcMatchTys tpl_tys tys\n      = find ((item, map (lookupTyVar subst) tpl_tvs) : ms) us rest\n\n        -- Does not match, so next check whether the things unify\n        -- See Note [Overlapping instances]\n        -- Ignore ones that are incoherent: Note [Incoherent instances]\n      | isIncoherent item\n      = find ms us rest\n\n      | otherwise\n      = ASSERT2( tyCoVarsOfTypes tys `disjointVarSet` tpl_tv_set,\n                 (ppr cls <+> ppr tys <+> ppr all_tvs) $$\n                 (ppr tpl_tvs <+> ppr tpl_tys)\n                )\n                -- Unification will break badly if the variables overlap\n                -- They shouldn't because we allocate separate uniques for them\n                -- See Note [Template tyvars are fresh]\n        case tcUnifyTys instanceBindFun tpl_tys tys of\n            Just _   -> find ms (item:us) rest\n            Nothing  -> find ms us        rest\n      where\n        tpl_tv_set = mkVarSet tpl_tvs\n\n---------------\n-- This is the common way to call this function.\nlookupInstEnv :: Bool              -- Check Safe Haskell overlap restrictions\n              -> InstEnvs          -- External and home package inst-env\n              -> Class -> [Type]   -- What we are looking for\n              -> ClsInstLookupResult\n-- ^ See Note [Rules for instance lookup]\n-- ^ See Note [Safe Haskell Overlapping Instances] in TcSimplify\n-- ^ See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify\nlookupInstEnv check_overlap_safe\n              (InstEnvs { ie_global = pkg_ie\n                        , ie_local = home_ie\n                        , ie_visible = vis_mods })\n              cls\n              tys\n  = -- pprTrace \"lookupInstEnv\" (ppr cls <+> ppr tys $$ ppr home_ie) $\n    (final_matches, final_unifs, unsafe_overlapped)\n  where\n    (home_matches, home_unifs) = lookupInstEnv' home_ie vis_mods cls tys\n    (pkg_matches,  pkg_unifs)  = lookupInstEnv' pkg_ie  vis_mods cls tys\n    all_matches = home_matches ++ pkg_matches\n    all_unifs   = home_unifs   ++ pkg_unifs\n    final_matches = foldr insert_overlapping [] all_matches\n        -- Even if the unifs is non-empty (an error situation)\n        -- we still prune the matches, so that the error message isn't\n        -- misleading (complaining of multiple matches when some should be\n        -- overlapped away)\n\n    unsafe_overlapped\n       = case final_matches of\n           [match] -> check_safe match\n           _       -> []\n\n    -- If the selected match is incoherent, discard all unifiers\n    final_unifs = case final_matches of\n                    (m:_) | isIncoherent (fst m) -> []\n                    _                            -> all_unifs\n\n    -- NOTE [Safe Haskell isSafeOverlap]\n    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n    -- We restrict code compiled in 'Safe' mode from overriding code\n    -- compiled in any other mode. The rationale is that code compiled\n    -- in 'Safe' mode is code that is untrusted by the ghc user. So\n    -- we shouldn't let that code change the behaviour of code the\n    -- user didn't compile in 'Safe' mode since that's the code they\n    -- trust. So 'Safe' instances can only overlap instances from the\n    -- same module. A same instance origin policy for safe compiled\n    -- instances.\n    check_safe (inst,_)\n        = case check_overlap_safe && unsafeTopInstance inst of\n                -- make sure it only overlaps instances from the same module\n                True -> go [] all_matches\n                -- most specific is from a trusted location.\n                False -> []\n        where\n            go bad [] = bad\n            go bad (i@(x,_):unchecked) =\n                if inSameMod x || isOverlappable x\n                    then go bad unchecked\n                    else go (i:bad) unchecked\n\n            inSameMod b =\n                let na = getName $ getName inst\n                    la = isInternalName na\n                    nb = getName $ getName b\n                    lb = isInternalName nb\n                in (la && lb) || (nameModule na == nameModule nb)\n\n    -- We consider the most specific instance unsafe when it both:\n    --   (1) Comes from a module compiled as `Safe`\n    --   (2) Is an orphan instance, OR, an instance for a MPTC\n    unsafeTopInstance inst = isSafeOverlap (is_flag inst) &&\n        (isOrphan (is_orphan inst) || classArity (is_cls inst) > 1)\n\n---------------\ninsert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]\n-- ^ Add a new solution, knocking out strictly less specific ones\n-- See Note [Rules for instance lookup]\ninsert_overlapping new_item [] = [new_item]\ninsert_overlapping new_item@(new_inst,_) (old_item@(old_inst,_) : old_items)\n  | new_beats_old        -- New strictly overrides old\n  , not old_beats_new\n  , new_inst `can_override` old_inst\n  = insert_overlapping new_item old_items\n\n  | old_beats_new        -- Old strictly overrides new\n  , not new_beats_old\n  , old_inst `can_override` new_inst\n  = old_item : old_items\n\n  -- Discard incoherent instances; see Note [Incoherent instances]\n  | isIncoherent old_inst      -- Old is incoherent; discard it\n  = insert_overlapping new_item old_items\n  | isIncoherent new_inst      -- New is incoherent; discard it\n  = old_item : old_items\n\n  -- Equal or incomparable, and neither is incoherent; keep both\n  | otherwise\n  = old_item : insert_overlapping new_item old_items\n  where\n\n    new_beats_old = new_inst `more_specific_than` old_inst\n    old_beats_new = old_inst `more_specific_than` new_inst\n\n    -- `instB` can be instantiated to match `instA`\n    -- or the two are equal\n    instA `more_specific_than` instB\n      = isJust (tcMatchTys (is_tys instB) (is_tys instA))\n\n    instA `can_override` instB\n       = isOverlapping instA || isOverlappable instB\n       -- Overlap permitted if either the more specific instance\n       -- is marked as overlapping, or the more general one is\n       -- marked as overlappable.\n       -- Latest change described in: Trac #9242.\n       -- Previous change: Trac #3877, Dec 10.\n\n{-\nNote [Incoherent instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nFor some classes, the choice of a particular instance does not matter, any one\nis good. E.g. consider\n\n        class D a b where { opD :: a -> b -> String }\n        instance D Int b where ...\n        instance D a Int where ...\n\n        g (x::Int) = opD x x  -- Wanted: D Int Int\n\nFor such classes this should work (without having to add an \"instance D Int\nInt\", and using -XOverlappingInstances, which would then work). This is what\n-XIncoherentInstances is for: Telling GHC \"I don't care which instance you use;\nif you can use one, use it.\"\n\nShould this logic only work when *all* candidates have the incoherent flag, or\neven when all but one have it? The right choice is the latter, which can be\njustified by comparing the behaviour with how -XIncoherentInstances worked when\nit was only about the unify-check (note [Overlapping instances]):\n\nExample:\n        class C a b c where foo :: (a,b,c)\n        instance C [a] b Int\n        instance [incoherent] [Int] b c\n        instance [incoherent] C a Int c\nThanks to the incoherent flags,\n        [Wanted]  C [a] b Int\nworks: Only instance one matches, the others just unify, but are marked\nincoherent.\n\nSo I can write\n        (foo :: ([a],b,Int)) :: ([Int], Int, Int).\nbut if that works then I really want to be able to write\n        foo :: ([Int], Int, Int)\nas well. Now all three instances from above match. None is more specific than\nanother, so none is ruled out by the normal overlapping rules. One of them is\nnot incoherent, but we still want this to compile. Hence the\n\"all-but-one-logic\".\n\nThe implementation is in insert_overlapping, where we remove matching\nincoherent instances as long as there are others.\n\n\n\n************************************************************************\n*                                                                      *\n        Binding decisions\n*                                                                      *\n************************************************************************\n-}\n\ninstanceBindFun :: TyCoVar -> BindFlag\ninstanceBindFun tv | isOverlappableTyVar tv = Skolem\n                   | otherwise              = BindMe\n   -- Note [Binding when looking up instances]\n\n{-\nNote [Binding when looking up instances]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen looking up in the instance environment, or family-instance environment,\nwe are careful about multiple matches, as described above in\nNote [Overlapping instances]\n\nThe key_tys can contain skolem constants, and we can guarantee that those\nare never going to be instantiated to anything, so we should not involve\nthem in the unification test.  Example:\n        class Foo a where { op :: a -> Int }\n        instance Foo a => Foo [a]       -- NB overlap\n        instance Foo [Int]              -- NB overlap\n        data T = forall a. Foo a => MkT a\n        f :: T -> Int\n        f (MkT x) = op [x,x]\nThe op [x,x] means we need (Foo [a]).  Without the filterVarSet we'd\ncomplain, saying that the choice of instance depended on the instantiation\nof 'a'; but of course it isn't *going* to be instantiated.\n\nWe do this only for isOverlappableTyVar skolems.  For example we reject\n        g :: forall a => [a] -> Int\n        g x = op x\non the grounds that the correct instance depends on the instantiation of 'a'\n-}\n", "num_lines": 1028}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006-2012\n\n{-# LANGUAGE CPP #-}\nmodule Kind (\n        -- * Main data type\n        Kind,\n\n        -- ** Predicates on Kinds\n        isLiftedTypeKind, isUnliftedTypeKind,\n        isConstraintKindCon,\n\n        classifiesTypeWithValues,\n        isKindLevPoly\n       ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} Type    ( coreView )\n\nimport TyCoRep\nimport TyCon\nimport PrelNames\n\nimport Outputable\nimport Util\nimport Data.Maybe( isJust )\n\n{-\n************************************************************************\n*                                                                      *\n        Functions over Kinds\n*                                                                      *\n************************************************************************\n\nNote [Kind Constraint and kind Type]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe kind Constraint is the kind of classes and other type constraints.\nThe special thing about types of kind Constraint is that\n * They are displayed with double arrow:\n     f :: Ord a => a -> a\n * They are implicitly instantiated at call sites; so the type inference\n   engine inserts an extra argument of type (Ord a) at every call site\n   to f.\n\nHowever, once type inference is over, there is *no* distinction between\nConstraint and Type. Indeed we can have coercions between the two. Consider\n   class C a where\n     op :: a -> a\nFor this single-method class we may generate a newtype, which in turn\ngenerates an axiom witnessing\n    C a ~ (a -> a)\nso on the left we have Constraint, and on the right we have Type.\nSee Trac #7451.\n\nBottom line: although 'Type' and 'Constraint' are distinct TyCons, with\ndistinct uniques, they are treated as equal at all times except\nduring type inference.\n-}\n\nisConstraintKindCon :: TyCon -> Bool\nisConstraintKindCon tc = tyConUnique tc == constraintKindTyConKey\n\n-- | Tests whether the given kind (which should look like @TYPE x@)\n-- is something other than a constructor tree (that is, constructors at every node).\n-- E.g.  True of   TYPE k, TYPE (F Int)\n--       False of  TYPE 'LiftedRep\nisKindLevPoly :: Kind -> Bool\nisKindLevPoly k = ASSERT2( isLiftedTypeKind k || _is_type, ppr k )\n                    -- the isLiftedTypeKind check is necessary b/c of Constraint\n                  go k\n  where\n    go ty | Just ty' <- coreView ty = go ty'\n    go TyVarTy{}         = True\n    go AppTy{}           = True  -- it can't be a TyConApp\n    go (TyConApp tc tys) = isFamilyTyCon tc || any go tys\n    go ForAllTy{}        = True\n    go (FunTy _ t1 t2)   = go t1 || go t2\n    go LitTy{}           = False\n    go CastTy{}          = True\n    go CoercionTy{}      = True\n\n    _is_type = classifiesTypeWithValues k\n\n-----------------------------------------\n--              Subkinding\n-- The tc variants are used during type-checking, where ConstraintKind\n-- is distinct from all other kinds\n-- After type-checking (in core), Constraint and liftedTypeKind are\n-- indistinguishable\n\n-- | Does this classify a type allowed to have values? Responds True to things\n-- like *, #, TYPE Lifted, TYPE v, Constraint.\nclassifiesTypeWithValues :: Kind -> Bool\n-- ^ True of any sub-kind of OpenTypeKind\nclassifiesTypeWithValues k = isJust (kindRep_maybe k)\n", "num_lines": 98}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n\n{-# LANGUAGE CPP #-}\n\nmodule OptCoercion ( optCoercion, checkAxInstCo ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport DynFlags\nimport TyCoRep\nimport Coercion\nimport Type hiding( substTyVarBndr, substTy )\nimport TcType       ( exactTyCoVarsOfType )\nimport TyCon\nimport CoAxiom\nimport VarSet\nimport VarEnv\nimport Outputable\nimport FamInstEnv ( flattenTys )\nimport Pair\nimport ListSetOps ( getNth )\nimport Util\nimport Unify\nimport InstEnv\nimport Control.Monad   ( zipWithM )\n\n{-\n%************************************************************************\n%*                                                                      *\n                 Optimising coercions\n%*                                                                      *\n%************************************************************************\n\nNote [Optimising coercion optimisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nLooking up a coercion's role or kind is linear in the size of the\ncoercion. Thus, doing this repeatedly during the recursive descent\nof coercion optimisation is disastrous. We must be careful to avoid\ndoing this if at all possible.\n\nBecause it is generally easy to know a coercion's components' roles\nfrom the role of the outer coercion, we pass down the known role of\nthe input in the algorithm below. We also keep functions opt_co2\nand opt_co3 separate from opt_co4, so that the former two do Phantom\nchecks that opt_co4 can avoid. This is a big win because Phantom coercions\nrarely appear within non-phantom coercions -- only in some TyConAppCos\nand some AxiomInstCos. We handle these cases specially by calling\nopt_co2.\n\nNote [Optimising InstCo]\n~~~~~~~~~~~~~~~~~~~~~~~~\n(1) tv is a type variable\nWhen we have (InstCo (ForAllCo tv h g) g2), we want to optimise.\n\nLet's look at the typing rules.\n\nh : k1 ~ k2\ntv:k1 |- g : t1 ~ t2\n-----------------------------\nForAllCo tv h g : (all tv:k1.t1) ~ (all tv:k2.t2[tv |-> tv |> sym h])\n\ng1 : (all tv:k1.t1') ~ (all tv:k2.t2')\ng2 : s1 ~ s2\n--------------------\nInstCo g1 g2 : t1'[tv |-> s1] ~ t2'[tv |-> s2]\n\nWe thus want some coercion proving this:\n\n  (t1[tv |-> s1]) ~ (t2[tv |-> s2 |> sym h])\n\nIf we substitute the *type* tv for the *coercion*\n(g2 ; t2 ~ t2 |> sym h) in g, we'll get this result exactly.\nThis is bizarre,\nthough, because we're substituting a type variable with a coercion. However,\nthis operation already exists: it's called *lifting*, and defined in Coercion.\nWe just need to enhance the lifting operation to be able to deal with\nan ambient substitution, which is why a LiftingContext stores a TCvSubst.\n\n(2) cv is a coercion variable\nNow consider we have (InstCo (ForAllCo cv h g) g2), we want to optimise.\n\nh : (t1 ~r t2) ~N (t3 ~r t4)\ncv : t1 ~r t2 |- g : t1' ~r2 t2'\nn1 = nth r 2 (downgradeRole r N h) :: t1 ~r t3\nn2 = nth r 3 (downgradeRole r N h) :: t2 ~r t4\n------------------------------------------------\nForAllCo cv h g : (all cv:t1 ~r t2. t1') ~r2\n                  (all cv:t3 ~r t4. t2'[cv |-> n1 ; cv ; sym n2])\n\ng1 : (all cv:t1 ~r t2. t1') ~ (all cv: t3 ~r t4. t2')\ng2 : h1 ~N h2\nh1 : t1 ~r t2\nh2 : t3 ~r t4\n------------------------------------------------\nInstCo g1 g2 : t1'[cv |-> h1] ~ t2'[cv |-> h2]\n\nWe thus want some coercion proving this:\n\n  t1'[cv |-> h1] ~ t2'[cv |-> n1 ; h2; sym n2]\n\nSo we substitute the coercion variable c for the coercion\n(h1 ~N (n1; h2; sym n2)) in g.\n-}\n\noptCoercion :: DynFlags -> TCvSubst -> Coercion -> NormalCo\n-- ^ optCoercion applies a substitution to a coercion,\n--   *and* optimises it to reduce its size\noptCoercion dflags env co\n  | hasNoOptCoercion dflags = substCo env co\n  | otherwise               = optCoercion' env co\n\noptCoercion' :: TCvSubst -> Coercion -> NormalCo\noptCoercion' env co\n  | debugIsOn\n  = let out_co = opt_co1 lc False co\n        (Pair in_ty1  in_ty2,  in_role)  = coercionKindRole co\n        (Pair out_ty1 out_ty2, out_role) = coercionKindRole out_co\n    in\n    ASSERT2( substTy env in_ty1 `eqType` out_ty1 &&\n             substTy env in_ty2 `eqType` out_ty2 &&\n             in_role == out_role\n           , text \"optCoercion changed types!\"\n             $$ hang (text \"in_co:\") 2 (ppr co)\n             $$ hang (text \"in_ty1:\") 2 (ppr in_ty1)\n             $$ hang (text \"in_ty2:\") 2 (ppr in_ty2)\n             $$ hang (text \"out_co:\") 2 (ppr out_co)\n             $$ hang (text \"out_ty1:\") 2 (ppr out_ty1)\n             $$ hang (text \"out_ty2:\") 2 (ppr out_ty2)\n             $$ hang (text \"subst:\") 2 (ppr env) )\n    out_co\n\n  | otherwise         = opt_co1 lc False co\n  where\n    lc = mkSubstLiftingContext env\n\ntype NormalCo    = Coercion\n  -- Invariants:\n  --  * The substitution has been fully applied\n  --  * For trans coercions (co1 `trans` co2)\n  --       co1 is not a trans, and neither co1 nor co2 is identity\n\ntype NormalNonIdCo = NormalCo  -- Extra invariant: not the identity\n\n-- | Do we apply a @sym@ to the result?\ntype SymFlag = Bool\n\n-- | Do we force the result to be representational?\ntype ReprFlag = Bool\n\n-- | Optimize a coercion, making no assumptions. All coercions in\n-- the lifting context are already optimized (and sym'd if nec'y)\nopt_co1 :: LiftingContext\n        -> SymFlag\n        -> Coercion -> NormalCo\nopt_co1 env sym co = opt_co2 env sym (coercionRole co) co\n\n-- See Note [Optimising coercion optimisation]\n-- | Optimize a coercion, knowing the coercion's role. No other assumptions.\nopt_co2 :: LiftingContext\n        -> SymFlag\n        -> Role   -- ^ The role of the input coercion\n        -> Coercion -> NormalCo\nopt_co2 env sym Phantom co = opt_phantom env sym co\nopt_co2 env sym r       co = opt_co3 env sym Nothing r co\n\n-- See Note [Optimising coercion optimisation]\n-- | Optimize a coercion, knowing the coercion's non-Phantom role.\nopt_co3 :: LiftingContext -> SymFlag -> Maybe Role -> Role -> Coercion -> NormalCo\nopt_co3 env sym (Just Phantom)          _ co = opt_phantom env sym co\nopt_co3 env sym (Just Representational) r co = opt_co4_wrap env sym True  r co\n  -- if mrole is Just Nominal, that can't be a downgrade, so we can ignore\nopt_co3 env sym _                       r co = opt_co4_wrap env sym False r co\n\n-- See Note [Optimising coercion optimisation]\n-- | Optimize a non-phantom coercion.\nopt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag -> Role -> Coercion -> NormalCo\n\nopt_co4_wrap = opt_co4\n{-\nopt_co4_wrap env sym rep r co\n  = pprTrace \"opt_co4_wrap {\"\n    ( vcat [ text \"Sym:\" <+> ppr sym\n           , text \"Rep:\" <+> ppr rep\n           , text \"Role:\" <+> ppr r\n           , text \"Co:\" <+> ppr co ]) $\n    ASSERT( r == coercionRole co )\n    let result = opt_co4 env sym rep r co in\n    pprTrace \"opt_co4_wrap }\" (ppr co $$ text \"---\" $$ ppr result) $\n    result\n-}\n\nopt_co4 env _   rep r (Refl ty)\n  = ASSERT2( r == Nominal, text \"Expected role:\" <+> ppr r    $$\n                           text \"Found role:\" <+> ppr Nominal $$\n                           text \"Type:\" <+> ppr ty )\n    liftCoSubst (chooseRole rep r) env ty\n\nopt_co4 env _   rep r (GRefl _r ty MRefl)\n  = ASSERT2( r == _r, text \"Expected role:\" <+> ppr r $$\n                      text \"Found role:\" <+> ppr _r   $$\n                      text \"Type:\" <+> ppr ty )\n    liftCoSubst (chooseRole rep r) env ty\n\nopt_co4 env sym  rep r (GRefl _r ty (MCo co))\n  = ASSERT2( r == _r, text \"Expected role:\" <+> ppr r $$\n                      text \"Found role:\" <+> ppr _r   $$\n                      text \"Type:\" <+> ppr ty )\n    if isGReflCo co || isGReflCo co'\n    then liftCoSubst r' env ty\n    else wrapSym sym $ mkCoherenceRightCo r' ty' co' (liftCoSubst r' env ty)\n  where\n    r'  = chooseRole rep r\n    ty' = substTy (lcSubstLeft env) ty\n    co' = opt_co4 env False False Nominal co\n\nopt_co4 env sym rep r (SymCo co)  = opt_co4_wrap env (not sym) rep r co\n  -- surprisingly, we don't have to do anything to the env here. This is\n  -- because any \"lifting\" substitutions in the env are tied to ForAllCos,\n  -- which treat their left and right sides differently. We don't want to\n  -- exchange them.\n\nopt_co4 env sym rep r g@(TyConAppCo _r tc cos)\n  = ASSERT( r == _r )\n    case (rep, r) of\n      (True, Nominal) ->\n        mkTyConAppCo Representational tc\n                     (zipWith3 (opt_co3 env sym)\n                               (map Just (tyConRolesRepresentational tc))\n                               (repeat Nominal)\n                               cos)\n      (False, Nominal) ->\n        mkTyConAppCo Nominal tc (map (opt_co4_wrap env sym False Nominal) cos)\n      (_, Representational) ->\n                      -- must use opt_co2 here, because some roles may be P\n                      -- See Note [Optimising coercion optimisation]\n        mkTyConAppCo r tc (zipWith (opt_co2 env sym)\n                                   (tyConRolesRepresentational tc)  -- the current roles\n                                   cos)\n      (_, Phantom) -> pprPanic \"opt_co4 sees a phantom!\" (ppr g)\n\nopt_co4 env sym rep r (AppCo co1 co2)\n  = mkAppCo (opt_co4_wrap env sym rep r co1)\n            (opt_co4_wrap env sym False Nominal co2)\n\nopt_co4 env sym rep r (ForAllCo tv k_co co)\n  = case optForAllCoBndr env sym tv k_co of\n      (env', tv', k_co') -> mkForAllCo tv' k_co' $\n                            opt_co4_wrap env' sym rep r co\n     -- Use the \"mk\" functions to check for nested Refls\n\nopt_co4 env sym rep r (FunCo _r co1 co2)\n  = ASSERT( r == _r )\n    if rep\n    then mkFunCo Representational co1' co2'\n    else mkFunCo r co1' co2'\n  where\n    co1' = opt_co4_wrap env sym rep r co1\n    co2' = opt_co4_wrap env sym rep r co2\n\nopt_co4 env sym rep r (CoVarCo cv)\n  | Just co <- lookupCoVar (lcTCvSubst env) cv\n  = opt_co4_wrap (zapLiftingContext env) sym rep r co\n\n  | ty1 `eqType` ty2   -- See Note [Optimise CoVarCo to Refl]\n  = mkReflCo (chooseRole rep r) ty1\n\n  | otherwise\n  = ASSERT( isCoVar cv1 )\n    wrapRole rep r $ wrapSym sym $\n    CoVarCo cv1\n\n  where\n    Pair ty1 ty2 = coVarTypes cv1\n\n    cv1 = case lookupInScope (lcInScopeSet env) cv of\n             Just cv1 -> cv1\n             Nothing  -> WARN( True, text \"opt_co: not in scope:\"\n                                     <+> ppr cv $$ ppr env)\n                         cv\n          -- cv1 might have a substituted kind!\n\nopt_co4 _ _ _ _ (HoleCo h)\n  = pprPanic \"opt_univ fell into a hole\" (ppr h)\n\nopt_co4 env sym rep r (AxiomInstCo con ind cos)\n    -- Do *not* push sym inside top-level axioms\n    -- e.g. if g is a top-level axiom\n    --   g a : f a ~ a\n    -- then (sym (g ty)) /= g (sym ty) !!\n  = ASSERT( r == coAxiomRole con )\n    wrapRole rep (coAxiomRole con) $\n    wrapSym sym $\n                       -- some sub-cos might be P: use opt_co2\n                       -- See Note [Optimising coercion optimisation]\n    AxiomInstCo con ind (zipWith (opt_co2 env False)\n                                 (coAxBranchRoles (coAxiomNthBranch con ind))\n                                 cos)\n      -- Note that the_co does *not* have sym pushed into it\n\nopt_co4 env sym rep r (UnivCo prov _r t1 t2)\n  = ASSERT( r == _r )\n    opt_univ env sym prov (chooseRole rep r) t1 t2\n\nopt_co4 env sym rep r (TransCo co1 co2)\n                      -- sym (g `o` h) = sym h `o` sym g\n  | sym       = opt_trans in_scope co2' co1'\n  | otherwise = opt_trans in_scope co1' co2'\n  where\n    co1' = opt_co4_wrap env sym rep r co1\n    co2' = opt_co4_wrap env sym rep r co2\n    in_scope = lcInScopeSet env\n\nopt_co4 env _sym rep r (NthCo _r n co)\n  | Just (ty, _) <- isReflCo_maybe co\n  , Just (_tc, args) <- ASSERT( r == _r )\n                        splitTyConApp_maybe ty\n  = liftCoSubst (chooseRole rep r) env (args `getNth` n)\n  | Just (ty, _) <- isReflCo_maybe co\n  , n == 0\n  , Just (tv, _) <- splitForAllTy_maybe ty\n      -- works for both tyvar and covar\n  = liftCoSubst (chooseRole rep r) env (varType tv)\n\nopt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos))\n  = ASSERT( r == r1 )\n    opt_co4_wrap env sym rep r (cos `getNth` n)\n\nopt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _))\n      -- works for both tyvar and covar\n  = ASSERT( r == _r )\n    ASSERT( n == 0 )\n    opt_co4_wrap env sym rep Nominal eta\n\nopt_co4 env sym rep r (NthCo _r n co)\n  | TyConAppCo _ _ cos <- co'\n  , let nth_co = cos `getNth` n\n  = if rep && (r == Nominal)\n      -- keep propagating the SubCo\n    then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co\n    else nth_co\n\n  | ForAllCo _ eta _ <- co'\n  = if rep\n    then opt_co4_wrap (zapLiftingContext env) False True Nominal eta\n    else eta\n\n  | otherwise\n  = wrapRole rep r $ NthCo r n co'\n  where\n    co' = opt_co1 env sym co\n\nopt_co4 env sym rep r (LRCo lr co)\n  | Just pr_co <- splitAppCo_maybe co\n  = ASSERT( r == Nominal )\n    opt_co4_wrap env sym rep Nominal (pick_lr lr pr_co)\n  | Just pr_co <- splitAppCo_maybe co'\n  = ASSERT( r == Nominal )\n    if rep\n    then opt_co4_wrap (zapLiftingContext env) False True Nominal (pick_lr lr pr_co)\n    else pick_lr lr pr_co\n  | otherwise\n  = wrapRole rep Nominal $ LRCo lr co'\n  where\n    co' = opt_co4_wrap env sym False Nominal co\n\n    pick_lr CLeft  (l, _) = l\n    pick_lr CRight (_, r) = r\n\n-- See Note [Optimising InstCo]\nopt_co4 env sym rep r (InstCo co1 arg)\n    -- forall over type...\n  | Just (tv, kind_co, co_body) <- splitForAllCo_ty_maybe co1\n  = opt_co4_wrap (extendLiftingContext env tv\n                    (mkCoherenceRightCo Nominal t2 (mkSymCo kind_co) sym_arg))\n                   -- mkSymCo kind_co :: k1 ~ k2\n                   -- sym_arg :: (t1 :: k1) ~ (t2 :: k2)\n                   -- tv |-> (t1 :: k1) ~ (((t2 :: k2) |> (sym kind_co)) :: k1)\n                 sym rep r co_body\n\n    -- forall over coercion...\n  | Just (cv, kind_co, co_body) <- splitForAllCo_co_maybe co1\n  , CoercionTy h1 <- t1\n  , CoercionTy h2 <- t2\n  = let new_co = mk_new_co cv (opt_co4_wrap env sym False Nominal kind_co) h1 h2\n    in opt_co4_wrap (extendLiftingContext env cv new_co) sym rep r co_body\n\n    -- See if it is a forall after optimization\n    -- If so, do an inefficient one-variable substitution, then re-optimize\n\n    -- forall over type...\n  | Just (tv', kind_co', co_body') <- splitForAllCo_ty_maybe co1'\n  = opt_co4_wrap (extendLiftingContext (zapLiftingContext env) tv'\n                    (mkCoherenceRightCo Nominal t2' (mkSymCo kind_co') arg'))\n            False False r' co_body'\n\n    -- forall over coercion...\n  | Just (cv', kind_co', co_body') <- splitForAllCo_co_maybe co1'\n  , CoercionTy h1' <- t1'\n  , CoercionTy h2' <- t2'\n  = let new_co = mk_new_co cv' kind_co' h1' h2'\n    in opt_co4_wrap (extendLiftingContext (zapLiftingContext env) cv' new_co)\n                    False False r' co_body'\n\n  | otherwise = InstCo co1' arg'\n  where\n    co1'    = opt_co4_wrap env sym rep r co1\n    r'      = chooseRole rep r\n    arg'    = opt_co4_wrap env sym False Nominal arg\n    sym_arg = wrapSym sym arg'\n\n    -- Performance note: don't be alarmed by the two calls to coercionKind\n    -- here, as only one call to coercionKind is actually demanded per guard.\n    -- t1/t2 are used when checking if co1 is a forall, and t1'/t2' are used\n    -- when checking if co1' (i.e., co1 post-optimization) is a forall.\n    --\n    -- t1/t2 must come from sym_arg, not arg', since it's possible that arg'\n    -- might have an extra Sym at the front (after being optimized) that co1\n    -- lacks, so we need to use sym_arg to balance the number of Syms. (#15725)\n    Pair t1  t2  = coercionKind sym_arg\n    Pair t1' t2' = coercionKind arg'\n\n    mk_new_co cv kind_co h1 h2\n      = let -- h1 :: (t1 ~ t2)\n            -- h2 :: (t3 ~ t4)\n            -- kind_co :: (t1 ~ t2) ~ (t3 ~ t4)\n            -- n1 :: t1 ~ t3\n            -- n2 :: t2 ~ t4\n            -- new_co = (h1 :: t1 ~ t2) ~ ((n1;h2;sym n2) :: t1 ~ t2)\n            r2  = coVarRole cv\n            kind_co' = downgradeRole r2 Nominal kind_co\n            n1 = mkNthCo r2 2 kind_co'\n            n2 = mkNthCo r2 3 kind_co'\n         in mkProofIrrelCo Nominal (Refl (coercionType h1)) h1\n                           (n1 `mkTransCo` h2 `mkTransCo` (mkSymCo n2))\n\nopt_co4 env sym _rep r (KindCo co)\n  = ASSERT( r == Nominal )\n    let kco' = promoteCoercion co in\n    case kco' of\n      KindCo co' -> promoteCoercion (opt_co1 env sym co')\n      _          -> opt_co4_wrap env sym False Nominal kco'\n  -- This might be able to be optimized more to do the promotion\n  -- and substitution/optimization at the same time\n\nopt_co4 env sym _ r (SubCo co)\n  = ASSERT( r == Representational )\n    opt_co4_wrap env sym True Nominal co\n\n-- This could perhaps be optimized more.\nopt_co4 env sym rep r (AxiomRuleCo co cs)\n  = ASSERT( r == coaxrRole co )\n    wrapRole rep r $\n    wrapSym sym $\n    AxiomRuleCo co (zipWith (opt_co2 env False) (coaxrAsmpRoles co) cs)\n\n{- Note [Optimise CoVarCo to Refl]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have (c :: t~t) we can optimise it to Refl. That increases the\nchances of floating the Refl upwards; e.g. Maybe c --> Refl (Maybe t)\n\nWe do so here in optCoercion, not in mkCoVarCo; see Note [mkCoVarCo]\nin Coercion.\n-}\n\n-------------\n-- | Optimize a phantom coercion. The input coercion may not necessarily\n-- be a phantom, but the output sure will be.\nopt_phantom :: LiftingContext -> SymFlag -> Coercion -> NormalCo\nopt_phantom env sym co\n  = opt_univ env sym (PhantomProv (mkKindCo co)) Phantom ty1 ty2\n  where\n    Pair ty1 ty2 = coercionKind co\n\n{- Note [Differing kinds]\n   ~~~~~~~~~~~~~~~~~~~~~~\nThe two types may not have the same kind (although that would be very unusual).\nBut even if they have the same kind, and the same type constructor, the number\nof arguments in a `CoTyConApp` can differ. Consider\n\n  Any :: forall k. k\n\n  Any * Int                      :: *\n  Any (*->*) Maybe Int  :: *\n\nHence the need to compare argument lengths; see Trac #13658\n -}\n\nopt_univ :: LiftingContext -> SymFlag -> UnivCoProvenance -> Role\n         -> Type -> Type -> Coercion\nopt_univ env sym (PhantomProv h) _r ty1 ty2\n  | sym       = mkPhantomCo h' ty2' ty1'\n  | otherwise = mkPhantomCo h' ty1' ty2'\n  where\n    h' = opt_co4 env sym False Nominal h\n    ty1' = substTy (lcSubstLeft  env) ty1\n    ty2' = substTy (lcSubstRight env) ty2\n\nopt_univ env sym prov role oty1 oty2\n  | Just (tc1, tys1) <- splitTyConApp_maybe oty1\n  , Just (tc2, tys2) <- splitTyConApp_maybe oty2\n  , tc1 == tc2\n  , equalLength tys1 tys2 -- see Note [Differing kinds]\n      -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom);\n      -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps\n  = let roles    = tyConRolesX role tc1\n        arg_cos  = zipWith3 (mkUnivCo prov') roles tys1 tys2\n        arg_cos' = zipWith (opt_co4 env sym False) roles arg_cos\n    in\n    mkTyConAppCo role tc1 arg_cos'\n\n  -- can't optimize the AppTy case because we can't build the kind coercions.\n\n  | Just (tv1, ty1) <- splitForAllTy_ty_maybe oty1\n  , Just (tv2, ty2) <- splitForAllTy_ty_maybe oty2\n      -- NB: prov isn't interesting here either\n  = let k1   = tyVarKind tv1\n        k2   = tyVarKind tv2\n        eta  = mkUnivCo prov' Nominal k1 k2\n          -- eta gets opt'ed soon, but not yet.\n        ty2' = substTyWith [tv2] [TyVarTy tv1 `mkCastTy` eta] ty2\n\n        (env', tv1', eta') = optForAllCoBndr env sym tv1 eta\n    in\n    mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2')\n\n  | Just (cv1, ty1) <- splitForAllTy_co_maybe oty1\n  , Just (cv2, ty2) <- splitForAllTy_co_maybe oty2\n      -- NB: prov isn't interesting here either\n  = let k1    = varType cv1\n        k2    = varType cv2\n        r'    = coVarRole cv1\n        eta   = mkUnivCo prov' Nominal k1 k2\n        eta_d = downgradeRole r' Nominal eta\n          -- eta gets opt'ed soon, but not yet.\n        n_co  = (mkSymCo $ mkNthCo r' 2 eta_d) `mkTransCo`\n                (mkCoVarCo cv1) `mkTransCo`\n                (mkNthCo r' 3 eta_d)\n        ty2'  = substTyWithCoVars [cv2] [n_co] ty2\n\n        (env', cv1', eta') = optForAllCoBndr env sym cv1 eta\n    in\n    mkForAllCo cv1' eta' (opt_univ env' sym prov' role ty1 ty2')\n\n  | otherwise\n  = let ty1 = substTyUnchecked (lcSubstLeft  env) oty1\n        ty2 = substTyUnchecked (lcSubstRight env) oty2\n        (a, b) | sym       = (ty2, ty1)\n               | otherwise = (ty1, ty2)\n    in\n    mkUnivCo prov' role a b\n\n  where\n    prov' = case prov of\n      UnsafeCoerceProv   -> prov\n      PhantomProv kco    -> PhantomProv $ opt_co4_wrap env sym False Nominal kco\n      ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco\n      PluginProv _       -> prov\n\n-------------\nopt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo]\nopt_transList is = zipWith (opt_trans is)\n\nopt_trans :: InScopeSet -> NormalCo -> NormalCo -> NormalCo\nopt_trans is co1 co2\n  | isReflCo co1 = co2\n    -- optimize when co1 is a Refl Co\n  | otherwise    = opt_trans1 is co1 co2\n\nopt_trans1 :: InScopeSet -> NormalNonIdCo -> NormalCo -> NormalCo\n-- First arg is not the identity\nopt_trans1 is co1 co2\n  | isReflCo co2 = co1\n    -- optimize when co2 is a Refl Co\n  | otherwise    = opt_trans2 is co1 co2\n\nopt_trans2 :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> NormalCo\n-- Neither arg is the identity\nopt_trans2 is (TransCo co1a co1b) co2\n    -- Don't know whether the sub-coercions are the identity\n  = opt_trans is co1a (opt_trans is co1b co2)\n\nopt_trans2 is co1 co2\n  | Just co <- opt_trans_rule is co1 co2\n  = co\n\nopt_trans2 is co1 (TransCo co2a co2b)\n  | Just co1_2a <- opt_trans_rule is co1 co2a\n  = if isReflCo co1_2a\n    then co2b\n    else opt_trans1 is co1_2a co2b\n\nopt_trans2 _ co1 co2\n  = mkTransCo co1 co2\n\n------\n-- Optimize coercions with a top-level use of transitivity.\nopt_trans_rule :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo\n\nopt_trans_rule is in_co1@(GRefl r1 t1 (MCo co1)) in_co2@(GRefl r2 _ (MCo co2))\n  = ASSERT( r1 == r2 )\n    fireTransRule \"GRefl\" in_co1 in_co2 $\n    mkGReflRightCo r1 t1 (opt_trans is co1 co2)\n\n-- Push transitivity through matching destructors\nopt_trans_rule is in_co1@(NthCo r1 d1 co1) in_co2@(NthCo r2 d2 co2)\n  | d1 == d2\n  , coercionRole co1 == coercionRole co2\n  , co1 `compatible_co` co2\n  = ASSERT( r1 == r2 )\n    fireTransRule \"PushNth\" in_co1 in_co2 $\n    mkNthCo r1 d1 (opt_trans is co1 co2)\n\nopt_trans_rule is in_co1@(LRCo d1 co1) in_co2@(LRCo d2 co2)\n  | d1 == d2\n  , co1 `compatible_co` co2\n  = fireTransRule \"PushLR\" in_co1 in_co2 $\n    mkLRCo d1 (opt_trans is co1 co2)\n\n-- Push transitivity inside instantiation\nopt_trans_rule is in_co1@(InstCo co1 ty1) in_co2@(InstCo co2 ty2)\n  | ty1 `eqCoercion` ty2\n  , co1 `compatible_co` co2\n  = fireTransRule \"TrPushInst\" in_co1 in_co2 $\n    mkInstCo (opt_trans is co1 co2) ty1\n\nopt_trans_rule is in_co1@(UnivCo p1 r1 tyl1 _tyr1)\n                  in_co2@(UnivCo p2 r2 _tyl2 tyr2)\n  | Just prov' <- opt_trans_prov p1 p2\n  = ASSERT( r1 == r2 )\n    fireTransRule \"UnivCo\" in_co1 in_co2 $\n    mkUnivCo prov' r1 tyl1 tyr2\n  where\n    -- if the provenances are different, opt'ing will be very confusing\n    opt_trans_prov UnsafeCoerceProv      UnsafeCoerceProv      = Just UnsafeCoerceProv\n    opt_trans_prov (PhantomProv kco1)    (PhantomProv kco2)\n      = Just $ PhantomProv $ opt_trans is kco1 kco2\n    opt_trans_prov (ProofIrrelProv kco1) (ProofIrrelProv kco2)\n      = Just $ ProofIrrelProv $ opt_trans is kco1 kco2\n    opt_trans_prov (PluginProv str1)     (PluginProv str2)     | str1 == str2 = Just p1\n    opt_trans_prov _ _ = Nothing\n\n-- Push transitivity down through matching top-level constructors.\nopt_trans_rule is in_co1@(TyConAppCo r1 tc1 cos1) in_co2@(TyConAppCo r2 tc2 cos2)\n  | tc1 == tc2\n  = ASSERT( r1 == r2 )\n    fireTransRule \"PushTyConApp\" in_co1 in_co2 $\n    mkTyConAppCo r1 tc1 (opt_transList is cos1 cos2)\n\nopt_trans_rule is in_co1@(FunCo r1 co1a co1b) in_co2@(FunCo r2 co2a co2b)\n  = ASSERT( r1 == r2 )   -- Just like the TyConAppCo/TyConAppCo case\n    fireTransRule \"PushFun\" in_co1 in_co2 $\n    mkFunCo r1 (opt_trans is co1a co2a) (opt_trans is co1b co2b)\n\nopt_trans_rule is in_co1@(AppCo co1a co1b) in_co2@(AppCo co2a co2b)\n  -- Must call opt_trans_rule_app; see Note [EtaAppCo]\n  = opt_trans_rule_app is in_co1 in_co2 co1a [co1b] co2a [co2b]\n\n-- Eta rules\nopt_trans_rule is co1@(TyConAppCo r tc cos1) co2\n  | Just cos2 <- etaTyConAppCo_maybe tc co2\n  = ASSERT( cos1 `equalLength` cos2 )\n    fireTransRule \"EtaCompL\" co1 co2 $\n    mkTyConAppCo r tc (opt_transList is cos1 cos2)\n\nopt_trans_rule is co1 co2@(TyConAppCo r tc cos2)\n  | Just cos1 <- etaTyConAppCo_maybe tc co1\n  = ASSERT( cos1 `equalLength` cos2 )\n    fireTransRule \"EtaCompR\" co1 co2 $\n    mkTyConAppCo r tc (opt_transList is cos1 cos2)\n\nopt_trans_rule is co1@(AppCo co1a co1b) co2\n  | Just (co2a,co2b) <- etaAppCo_maybe co2\n  = opt_trans_rule_app is co1 co2 co1a [co1b] co2a [co2b]\n\nopt_trans_rule is co1 co2@(AppCo co2a co2b)\n  | Just (co1a,co1b) <- etaAppCo_maybe co1\n  = opt_trans_rule_app is co1 co2 co1a [co1b] co2a [co2b]\n\n-- Push transitivity inside forall\n-- forall over types.\nopt_trans_rule is co1 co2\n  | Just (tv1, eta1, r1) <- splitForAllCo_ty_maybe co1\n  , Just (tv2, eta2, r2) <- etaForAllCo_ty_maybe co2\n  = push_trans tv1 eta1 r1 tv2 eta2 r2\n\n  | Just (tv2, eta2, r2) <- splitForAllCo_ty_maybe co2\n  , Just (tv1, eta1, r1) <- etaForAllCo_ty_maybe co1\n  = push_trans tv1 eta1 r1 tv2 eta2 r2\n\n  where\n  push_trans tv1 eta1 r1 tv2 eta2 r2\n    -- Given:\n    --   co1 = /\\ tv1 : eta1. r1\n    --   co2 = /\\ tv2 : eta2. r2\n    -- Wanted:\n    --   /\\tv1 : (eta1;eta2).  (r1; r2[tv2 |-> tv1 |> eta1])\n    = fireTransRule \"EtaAllTy_ty\" co1 co2 $\n      mkForAllCo tv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2')\n    where\n      is' = is `extendInScopeSet` tv1\n      r2' = substCoWithUnchecked [tv2] [mkCastTy (TyVarTy tv1) eta1] r2\n\n-- Push transitivity inside forall\n-- forall over coercions.\nopt_trans_rule is co1 co2\n  | Just (cv1, eta1, r1) <- splitForAllCo_co_maybe co1\n  , Just (cv2, eta2, r2) <- etaForAllCo_co_maybe co2\n  = push_trans cv1 eta1 r1 cv2 eta2 r2\n\n  | Just (cv2, eta2, r2) <- splitForAllCo_co_maybe co2\n  , Just (cv1, eta1, r1) <- etaForAllCo_co_maybe co1\n  = push_trans cv1 eta1 r1 cv2 eta2 r2\n\n  where\n  push_trans cv1 eta1 r1 cv2 eta2 r2\n    -- Given:\n    --   co1 = /\\ cv1 : eta1. r1\n    --   co2 = /\\ cv2 : eta2. r2\n    -- Wanted:\n    --   n1 = nth 2 eta1\n    --   n2 = nth 3 eta1\n    --   nco = /\\ cv1 : (eta1;eta2). (r1; r2[cv2 |-> (sym n1);cv1;n2])\n    = fireTransRule \"EtaAllTy_co\" co1 co2 $\n      mkForAllCo cv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2')\n    where\n      is'  = is `extendInScopeSet` cv1\n      role = coVarRole cv1\n      eta1' = downgradeRole role Nominal eta1\n      n1   = mkNthCo role 2 eta1'\n      n2   = mkNthCo role 3 eta1'\n      r2'  = substCo (zipCvSubst [cv2] [(mkSymCo n1) `mkTransCo`\n                                        (mkCoVarCo cv1) `mkTransCo` n2])\n                    r2\n\n-- Push transitivity inside axioms\nopt_trans_rule is co1 co2\n\n  -- See Note [Why call checkAxInstCo during optimisation]\n  -- TrPushSymAxR\n  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe\n  , True <- sym\n  , Just cos2 <- matchAxiom sym con ind co2\n  , let newAxInst = AxiomInstCo con ind (opt_transList is (map mkSymCo cos2) cos1)\n  , Nothing <- checkAxInstCo newAxInst\n  = fireTransRule \"TrPushSymAxR\" co1 co2 $ SymCo newAxInst\n\n  -- TrPushAxR\n  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe\n  , False <- sym\n  , Just cos2 <- matchAxiom sym con ind co2\n  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)\n  , Nothing <- checkAxInstCo newAxInst\n  = fireTransRule \"TrPushAxR\" co1 co2 newAxInst\n\n  -- TrPushSymAxL\n  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe\n  , True <- sym\n  , Just cos1 <- matchAxiom (not sym) con ind co1\n  , let newAxInst = AxiomInstCo con ind (opt_transList is cos2 (map mkSymCo cos1))\n  , Nothing <- checkAxInstCo newAxInst\n  = fireTransRule \"TrPushSymAxL\" co1 co2 $ SymCo newAxInst\n\n  -- TrPushAxL\n  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe\n  , False <- sym\n  , Just cos1 <- matchAxiom (not sym) con ind co1\n  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)\n  , Nothing <- checkAxInstCo newAxInst\n  = fireTransRule \"TrPushAxL\" co1 co2 newAxInst\n\n  -- TrPushAxSym/TrPushSymAx\n  | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe\n  , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe\n  , con1 == con2\n  , ind1 == ind2\n  , sym1 == not sym2\n  , let branch = coAxiomNthBranch con1 ind1\n        qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch\n        lhs  = coAxNthLHS con1 ind1\n        rhs  = coAxBranchRHS branch\n        pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs)\n  , all (`elemVarSet` pivot_tvs) qtvs\n  = fireTransRule \"TrPushAxSym\" co1 co2 $\n    if sym2\n       -- TrPushAxSym\n    then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs\n       -- TrPushSymAx\n    else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs\n  where\n    co1_is_axiom_maybe = isAxiom_maybe co1\n    co2_is_axiom_maybe = isAxiom_maybe co2\n    role = coercionRole co1 -- should be the same as coercionRole co2!\n\nopt_trans_rule _ co1 co2        -- Identity rule\n  | (Pair ty1 _, r) <- coercionKindRole co1\n  , Pair _ ty2 <- coercionKind co2\n  , ty1 `eqType` ty2\n  = fireTransRule \"RedTypeDirRefl\" co1 co2 $\n    mkReflCo r ty2\n\nopt_trans_rule _ _ _ = Nothing\n\n-- See Note [EtaAppCo]\nopt_trans_rule_app :: InScopeSet\n                   -> Coercion   -- original left-hand coercion (printing only)\n                   -> Coercion   -- original right-hand coercion (printing only)\n                   -> Coercion   -- left-hand coercion \"function\"\n                   -> [Coercion] -- left-hand coercion \"args\"\n                   -> Coercion   -- right-hand coercion \"function\"\n                   -> [Coercion] -- right-hand coercion \"args\"\n                   -> Maybe Coercion\nopt_trans_rule_app is orig_co1 orig_co2 co1a co1bs co2a co2bs\n  | AppCo co1aa co1ab <- co1a\n  , Just (co2aa, co2ab) <- etaAppCo_maybe co2a\n  = opt_trans_rule_app is orig_co1 orig_co2 co1aa (co1ab:co1bs) co2aa (co2ab:co2bs)\n\n  | AppCo co2aa co2ab <- co2a\n  , Just (co1aa, co1ab) <- etaAppCo_maybe co1a\n  = opt_trans_rule_app is orig_co1 orig_co2 co1aa (co1ab:co1bs) co2aa (co2ab:co2bs)\n\n  | otherwise\n  = ASSERT( co1bs `equalLength` co2bs )\n    fireTransRule (\"EtaApps:\" ++ show (length co1bs)) orig_co1 orig_co2 $\n    let Pair _ rt1a = coercionKind co1a\n        (Pair lt2a _, rt2a) = coercionKindRole co2a\n\n        Pair _ rt1bs = traverse coercionKind co1bs\n        Pair lt2bs _ = traverse coercionKind co2bs\n        rt2bs = map coercionRole co2bs\n\n        kcoa = mkKindCo $ buildCoercion lt2a rt1a\n        kcobs = map mkKindCo $ zipWith buildCoercion lt2bs rt1bs\n\n        co2a'   = mkCoherenceLeftCo rt2a lt2a kcoa co2a\n        co2bs'  = zipWith3 mkGReflLeftCo rt2bs lt2bs kcobs\n        co2bs'' = zipWith mkTransCo co2bs' co2bs\n    in\n    mkAppCos (opt_trans is co1a co2a')\n             (zipWith (opt_trans is) co1bs co2bs'')\n\nfireTransRule :: String -> Coercion -> Coercion -> Coercion -> Maybe Coercion\nfireTransRule _rule _co1 _co2 res\n  = Just res\n\n{-\nNote [Conflict checking with AxiomInstCo]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider the following type family and axiom:\n\ntype family Equal (a :: k) (b :: k) :: Bool\ntype instance where\n  Equal a a = True\n  Equal a b = False\n--\nEqual :: forall k::*. k -> k -> Bool\naxEqual :: { forall k::*. forall a::k. Equal k a a ~ True\n           ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False }\n\nWe wish to disallow (axEqual[1] <*> <Int> <Int). (Recall that the index is\n0-based, so this is the second branch of the axiom.) The problem is that, on\nthe surface, it seems that (axEqual[1] <*> <Int> <Int>) :: (Equal * Int Int ~\nFalse) and that all is OK. But, all is not OK: we want to use the first branch\nof the axiom in this case, not the second. The problem is that the parameters\nof the first branch can unify with the supplied coercions, thus meaning that\nthe first branch should be taken. See also Note [Apartness] in\ntypes/FamInstEnv.hs.\n\nNote [Why call checkAxInstCo during optimisation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt is possible that otherwise-good-looking optimisations meet with disaster\nin the presence of axioms with multiple equations. Consider\n\ntype family Equal (a :: *) (b :: *) :: Bool where\n  Equal a a = True\n  Equal a b = False\ntype family Id (a :: *) :: * where\n  Id a = a\n\naxEq :: { [a::*].       Equal a a ~ True\n        ; [a::*, b::*]. Equal a b ~ False }\naxId :: [a::*]. Id a ~ a\n\nco1 = Equal (axId[0] Int) (axId[0] Bool)\n  :: Equal (Id Int) (Id Bool) ~  Equal Int Bool\nco2 = axEq[1] <Int> <Bool>\n  :: Equal Int Bool ~ False\n\nWe wish to optimise (co1 ; co2). We end up in rule TrPushAxL, noting that\nco2 is an axiom and that matchAxiom succeeds when looking at co1. But, what\nhappens when we push the coercions inside? We get\n\nco3 = axEq[1] (axId[0] Int) (axId[0] Bool)\n  :: Equal (Id Int) (Id Bool) ~ False\n\nwhich is bogus! This is because the type system isn't smart enough to know\nthat (Id Int) and (Id Bool) are Surely Apart, as they're headed by type\nfamilies. At the time of writing, I (Richard Eisenberg) couldn't think of\na way of detecting this any more efficient than just building the optimised\ncoercion and checking.\n\nNote [EtaAppCo]\n~~~~~~~~~~~~~~~\nSuppose we're trying to optimize (co1a co1b ; co2a co2b). Ideally, we'd\nlike to rewrite this to (co1a ; co2a) (co1b ; co2b). The problem is that\nthe resultant coercions might not be well kinded. Here is an example (things\nlabeled with x don't matter in this example):\n\n  k1 :: Type\n  k2 :: Type\n\n  a :: k1 -> Type\n  b :: k1\n\n  h :: k1 ~ k2\n\n  co1a :: x1 ~ (a |> (h -> <Type>)\n  co1b :: x2 ~ (b |> h)\n\n  co2a :: a ~ x3\n  co2b :: b ~ x4\n\nFirst, convince yourself of the following:\n\n  co1a co1b :: x1 x2 ~ (a |> (h -> <Type>)) (b |> h)\n  co2a co2b :: a b   ~ x3 x4\n\n  (a |> (h -> <Type>)) (b |> h) `eqType` a b\n\nThat last fact is due to Note [Non-trivial definitional equality] in TyCoRep,\nwhere we ignore coercions in types as long as two types' kinds are the same.\nIn our case, we meet this last condition, because\n\n  (a |> (h -> <Type>)) (b |> h) :: Type\n    and\n  a b :: Type\n\nSo the input coercion (co1a co1b ; co2a co2b) is well-formed. But the\nsuggested output coercions (co1a ; co2a) and (co1b ; co2b) are not -- the\nkinds don't match up.\n\nThe solution here is to twiddle the kinds in the output coercions. First, we\nneed to find coercions\n\n  ak :: kind(a |> (h -> <Type>)) ~ kind(a)\n  bk :: kind(b |> h)             ~ kind(b)\n\nThis can be done with mkKindCo and buildCoercion. The latter assumes two\ntypes are identical modulo casts and builds a coercion between them.\n\nThen, we build (co1a ; co2a |> sym ak) and (co1b ; co2b |> sym bk) as the\noutput coercions. These are well-kinded.\n\nAlso, note that all of this is done after accumulated any nested AppCo\nparameters. This step is to avoid quadratic behavior in calling coercionKind.\n\nThe problem described here was first found in dependent/should_compile/dynamic-paper.\n\n-}\n\n-- | Check to make sure that an AxInstCo is internally consistent.\n-- Returns the conflicting branch, if it exists\n-- See Note [Conflict checking with AxiomInstCo]\ncheckAxInstCo :: Coercion -> Maybe CoAxBranch\n-- defined here to avoid dependencies in Coercion\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in CoreLint\ncheckAxInstCo (AxiomInstCo ax ind cos)\n  = let branch       = coAxiomNthBranch ax ind\n        tvs          = coAxBranchTyVars branch\n        cvs          = coAxBranchCoVars branch\n        incomps      = coAxBranchIncomps branch\n        (tys, cotys) = splitAtList tvs (map (pFst . coercionKind) cos)\n        co_args      = map stripCoercionTy cotys\n        subst        = zipTvSubst tvs tys `composeTCvSubst`\n                       zipCvSubst cvs co_args\n        target   = Type.substTys subst (coAxBranchLHS branch)\n        in_scope = mkInScopeSet $\n                   unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps)\n        flattened_target = flattenTys in_scope target in\n    check_no_conflict flattened_target incomps\n  where\n    check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch\n    check_no_conflict _    [] = Nothing\n    check_no_conflict flat (b@CoAxBranch { cab_lhs = lhs_incomp } : rest)\n         -- See Note [Apartness] in FamInstEnv\n      | SurelyApart <- tcUnifyTysFG instanceBindFun flat lhs_incomp\n      = check_no_conflict flat rest\n      | otherwise\n      = Just b\ncheckAxInstCo _ = Nothing\n\n\n-----------\nwrapSym :: SymFlag -> Coercion -> Coercion\nwrapSym sym co | sym       = mkSymCo co\n               | otherwise = co\n\n-- | Conditionally set a role to be representational\nwrapRole :: ReprFlag\n         -> Role         -- ^ current role\n         -> Coercion -> Coercion\nwrapRole False _       = id\nwrapRole True  current = downgradeRole Representational current\n\n-- | If we require a representational role, return that. Otherwise,\n-- return the \"default\" role provided.\nchooseRole :: ReprFlag\n           -> Role    -- ^ \"default\" role\n           -> Role\nchooseRole True _ = Representational\nchooseRole _    r = r\n\n-----------\nisAxiom_maybe :: Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])\nisAxiom_maybe (SymCo co)\n  | Just (sym, con, ind, cos) <- isAxiom_maybe co\n  = Just (not sym, con, ind, cos)\nisAxiom_maybe (AxiomInstCo con ind cos)\n  = Just (False, con, ind, cos)\nisAxiom_maybe _ = Nothing\n\nmatchAxiom :: Bool -- True = match LHS, False = match RHS\n           -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]\nmatchAxiom sym ax@(CoAxiom { co_ax_tc = tc }) ind co\n  | CoAxBranch { cab_tvs = qtvs\n               , cab_cvs = []   -- can't infer these, so fail if there are any\n               , cab_roles = roles\n               , cab_lhs = lhs\n               , cab_rhs = rhs } <- coAxiomNthBranch ax ind\n  , Just subst <- liftCoMatch (mkVarSet qtvs)\n                              (if sym then (mkTyConApp tc lhs) else rhs)\n                              co\n  , all (`isMappedByLC` subst) qtvs\n  = zipWithM (liftCoSubstTyVar subst) roles qtvs\n\n  | otherwise\n  = Nothing\n\n-------------\ncompatible_co :: Coercion -> Coercion -> Bool\n-- Check whether (co1 . co2) will be well-kinded\ncompatible_co co1 co2\n  = x1 `eqType` x2\n  where\n    Pair _ x1 = coercionKind co1\n    Pair x2 _ = coercionKind co2\n\n-------------\n{-\netaForAllCo\n~~~~~~~~~~~~~~~~~\n(1) etaForAllCo_ty_maybe\nSuppose we have\n\n  g : all a1:k1.t1  ~  all a2:k2.t2\n\nbut g is *not* a ForAllCo. We want to eta-expand it. So, we do this:\n\n  g' = all a1:(ForAllKindCo g).(InstCo g (a1 ~ a1 |> ForAllKindCo g))\n\nCall the kind coercion h1 and the body coercion h2. We can see that\n\n  h2 : t1 ~ t2[a2 |-> (a1 |> h1)]\n\nAccording to the typing rule for ForAllCo, we get that\n\n  g' : all a1:k1.t1  ~  all a1:k2.(t2[a2 |-> (a1 |> h1)][a1 |-> a1 |> sym h1])\n\nor\n\n  g' : all a1:k1.t1  ~  all a1:k2.(t2[a2 |-> a1])\n\nas desired.\n\n(2) etaForAllCo_co_maybe\nSuppose we have\n\n  g : all c1:(s1~s2). t1 ~ all c2:(s3~s4). t2\n\nSimilarly, we do this\n\n  g' = all c1:h1. h2\n     : all c1:(s1~s2). t1 ~ all c1:(s3~s4). t2[c2 |-> (sym eta1;c1;eta2)]\n                                              [c1 |-> eta1;c1;sym eta2]\n\nHere,\n\n  h1   = mkNthCo Nominal 0 g :: (s1~s2)~(s3~s4)\n  eta1 = mkNthCo r 2 h1      :: (s1 ~ s3)\n  eta2 = mkNthCo r 3 h1      :: (s2 ~ s4)\n  h2   = mkInstCo g (cv1 ~ (sym eta1;c1;eta2))\n-}\netaForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)\n-- Try to make the coercion be of form (forall tv:kind_co. co)\netaForAllCo_ty_maybe co\n  | Just (tv, kind_co, r) <- splitForAllCo_ty_maybe co\n  = Just (tv, kind_co, r)\n\n  | Pair ty1 ty2  <- coercionKind co\n  , Just (tv1, _) <- splitForAllTy_ty_maybe ty1\n  , isForAllTy_ty ty2\n  , let kind_co = mkNthCo Nominal 0 co\n  = Just ( tv1, kind_co\n         , mkInstCo co (mkGReflRightCo Nominal (TyVarTy tv1) kind_co))\n\n  | otherwise\n  = Nothing\n\netaForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion)\n-- Try to make the coercion be of form (forall cv:kind_co. co)\netaForAllCo_co_maybe co\n  | Just (cv, kind_co, r) <- splitForAllCo_co_maybe co\n  = Just (cv, kind_co, r)\n\n  | Pair ty1 ty2  <- coercionKind co\n  , Just (cv1, _) <- splitForAllTy_co_maybe ty1\n  , isForAllTy_co ty2\n  = let kind_co  = mkNthCo Nominal 0 co\n        r        = coVarRole cv1\n        l_co     = mkCoVarCo cv1\n        kind_co' = downgradeRole r Nominal kind_co\n        r_co     = (mkSymCo (mkNthCo r 2 kind_co')) `mkTransCo`\n                   l_co `mkTransCo`\n                   (mkNthCo r 3 kind_co')\n    in Just ( cv1, kind_co\n            , mkInstCo co (mkProofIrrelCo Nominal kind_co l_co r_co))\n\n  | otherwise\n  = Nothing\n\netaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion)\n-- If possible, split a coercion\n--   g :: t1a t1b ~ t2a t2b\n-- into a pair of coercions (left g, right g)\netaAppCo_maybe co\n  | Just (co1,co2) <- splitAppCo_maybe co\n  = Just (co1,co2)\n  | (Pair ty1 ty2, Nominal) <- coercionKindRole co\n  , Just (_,t1) <- splitAppTy_maybe ty1\n  , Just (_,t2) <- splitAppTy_maybe ty2\n  , let isco1 = isCoercionTy t1\n  , let isco2 = isCoercionTy t2\n  , isco1 == isco2\n  = Just (LRCo CLeft co, LRCo CRight co)\n  | otherwise\n  = Nothing\n\netaTyConAppCo_maybe :: TyCon -> Coercion -> Maybe [Coercion]\n-- If possible, split a coercion\n--       g :: T s1 .. sn ~ T t1 .. tn\n-- into [ Nth 0 g :: s1~t1, ..., Nth (n-1) g :: sn~tn ]\netaTyConAppCo_maybe tc (TyConAppCo _ tc2 cos2)\n  = ASSERT( tc == tc2 ) Just cos2\n\netaTyConAppCo_maybe tc co\n  | not (mustBeSaturated tc)\n  , (Pair ty1 ty2, r) <- coercionKindRole co\n  , Just (tc1, tys1)  <- splitTyConApp_maybe ty1\n  , Just (tc2, tys2)  <- splitTyConApp_maybe ty2\n  , tc1 == tc2\n  , isInjectiveTyCon tc r  -- See Note [NthCo and newtypes] in TyCoRep\n  , let n = length tys1\n  , tys2 `lengthIs` n      -- This can fail in an erroneous progam\n                           -- E.g. T a ~# T a b\n                           -- Trac #14607\n  = ASSERT( tc == tc1 )\n    Just (decomposeCo n co (tyConRolesX r tc1))\n    -- NB: n might be <> tyConArity tc\n    -- e.g.   data family T a :: * -> *\n    --        g :: T a b ~ T c d\n\n  | otherwise\n  = Nothing\n\n{-\nNote [Eta for AppCo]\n~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n   g :: s1 t1 ~ s2 t2\n\nThen we can't necessarily make\n   left  g :: s1 ~ s2\n   right g :: t1 ~ t2\nbecause it's possible that\n   s1 :: * -> *         t1 :: *\n   s2 :: (*->*) -> *    t2 :: * -> *\nand in that case (left g) does not have the same\nkind on either side.\n\nIt's enough to check that\n  kind t1 = kind t2\nbecause if g is well-kinded then\n  kind (s1 t2) = kind (s2 t2)\nand these two imply\n  kind s1 = kind s2\n\n-}\n\noptForAllCoBndr :: LiftingContext -> Bool\n                -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion)\noptForAllCoBndr env sym\n  = substForAllCoBndrUsingLC sym (opt_co4_wrap env sym False Nominal) env\n", "num_lines": 1205}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nThe @TyCon@ datatype\n-}\n\n{-# LANGUAGE CPP, FlexibleInstances #-}\n\nmodule TyCon(\n        -- * Main TyCon data types\n        TyCon,\n        AlgTyConRhs(..), visibleDataCons,\n        AlgTyConFlav(..), isNoParent,\n        FamTyConFlav(..), Role(..), Injectivity(..),\n        RuntimeRepInfo(..), TyConFlavour(..),\n\n        -- * TyConBinder\n        TyConBinder, TyConBndrVis(..), TyConTyCoBinder,\n        mkNamedTyConBinder, mkNamedTyConBinders,\n        mkRequiredTyConBinder,\n        mkAnonTyConBinder, mkAnonTyConBinders,\n        tyConBinderArgFlag, tyConBndrVisArgFlag, isNamedTyConBinder,\n        isVisibleTyConBinder, isInvisibleTyConBinder,\n\n        -- ** Field labels\n        tyConFieldLabels, lookupTyConFieldLabel,\n\n        -- ** Constructing TyCons\n        mkAlgTyCon,\n        mkClassTyCon,\n        mkFunTyCon,\n        mkPrimTyCon,\n        mkKindTyCon,\n        mkLiftedPrimTyCon,\n        mkTupleTyCon,\n        mkSumTyCon,\n        mkDataTyConRhs,\n        mkSynonymTyCon,\n        mkFamilyTyCon,\n        mkPromotedDataCon,\n        mkTcTyCon,\n\n        -- ** Predicates on TyCons\n        isAlgTyCon, isVanillaAlgTyCon,\n        isClassTyCon, isFamInstTyCon,\n        isFunTyCon,\n        isPrimTyCon,\n        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,\n        isUnboxedSumTyCon, isPromotedTupleTyCon,\n        isTypeSynonymTyCon,\n        mustBeSaturated,\n        isPromotedDataCon, isPromotedDataCon_maybe,\n        isKindTyCon, isLiftedTypeKindTyConName,\n        isTauTyCon, isFamFreeTyCon,\n\n        isDataTyCon, isProductTyCon, isDataProductTyCon_maybe,\n        isDataSumTyCon_maybe,\n        isEnumerationTyCon,\n        isNewTyCon, isAbstractTyCon,\n        isFamilyTyCon, isOpenFamilyTyCon,\n        isTypeFamilyTyCon, isDataFamilyTyCon,\n        isOpenTypeFamilyTyCon, isClosedSynFamilyTyConWithAxiom_maybe,\n        tyConInjectivityInfo,\n        isBuiltInSynFamTyCon_maybe,\n        isUnliftedTyCon,\n        isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs,\n        isTyConAssoc, tyConAssoc_maybe, tyConFlavourAssoc_maybe,\n        isImplicitTyCon,\n        isTyConWithSrcDataCons,\n        isTcTyCon, setTcTyConKind,\n        isTcLevPoly,\n\n        -- ** Extracting information out of TyCons\n        tyConName,\n        tyConSkolem,\n        tyConKind,\n        tyConUnique,\n        tyConTyVars, tyConVisibleTyVars,\n        tyConCType, tyConCType_maybe,\n        tyConDataCons, tyConDataCons_maybe,\n        tyConSingleDataCon_maybe, tyConSingleDataCon,\n        tyConSingleAlgDataCon_maybe,\n        tyConFamilySize,\n        tyConStupidTheta,\n        tyConArity,\n        tyConRoles,\n        tyConFlavour,\n        tyConTuple_maybe, tyConClass_maybe, tyConATs,\n        tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,\n        tyConFamilyResVar_maybe,\n        synTyConDefn_maybe, synTyConRhs_maybe,\n        famTyConFlav_maybe, famTcResVar,\n        algTyConRhs,\n        newTyConRhs, newTyConEtadArity, newTyConEtadRhs,\n        unwrapNewTyCon_maybe, unwrapNewTyConEtad_maybe,\n        newTyConDataCon_maybe,\n        algTcFields,\n        tyConRuntimeRepInfo,\n        tyConBinders, tyConResKind, tyConTyVarBinders,\n        tcTyConScopedTyVars, tcTyConIsPoly,\n        mkTyConTagMap,\n\n        -- ** Manipulating TyCons\n        expandSynTyCon_maybe,\n        newTyConCo, newTyConCo_maybe,\n        pprPromotionQuote, mkTyConKind,\n\n        -- ** Predicated on TyConFlavours\n        tcFlavourIsOpen,\n\n        -- * Runtime type representation\n        TyConRepName, tyConRepName_maybe,\n        mkPrelTyConRepName,\n        tyConRepModOcc,\n\n        -- * Primitive representations of Types\n        PrimRep(..), PrimElemRep(..),\n        isVoidRep, isGcPtrRep,\n        primRepSizeB,\n        primElemRepSizeB,\n        primRepIsFloat,\n\n        -- * Recursion breaking\n        RecTcChecker, initRecTc, defaultRecTcMaxBound,\n        setRecTcMaxBound, checkRecTc\n\n) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} TyCoRep    ( Kind, Type, PredType, pprType, mkForAllTy, mkFunTy )\nimport {-# SOURCE #-} TysWiredIn ( runtimeRepTyCon, constraintKind\n                                 , vecCountTyCon, vecElemTyCon, liftedTypeKind )\nimport {-# SOURCE #-} DataCon    ( DataCon, dataConExTyCoVars, dataConFieldLabels\n                                 , dataConTyCon, dataConFullSig\n                                 , isUnboxedSumCon )\n\nimport Binary\nimport Var\nimport VarSet\nimport Class\nimport BasicTypes\nimport DynFlags\nimport ForeignCall\nimport Name\nimport NameEnv\nimport CoAxiom\nimport PrelNames\nimport Maybes\nimport Outputable\nimport FastStringEnv\nimport FieldLabel\nimport Constants\nimport Util\nimport Unique( tyConRepNameUnique, dataConTyRepNameUnique )\nimport UniqSet\nimport Module\n\nimport qualified Data.Data as Data\n\n{-\n-----------------------------------------------\n        Notes about type families\n-----------------------------------------------\n\nNote [Type synonym families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Type synonym families, also known as \"type functions\", map directly\n  onto the type functions in FC:\n\n        type family F a :: *\n        type instance F Int = Bool\n        ..etc...\n\n* Reply \"yes\" to isTypeFamilyTyCon, and isFamilyTyCon\n\n* From the user's point of view (F Int) and Bool are simply\n  equivalent types.\n\n* A Haskell 98 type synonym is a degenerate form of a type synonym\n  family.\n\n* Type functions can't appear in the LHS of a type function:\n        type instance F (F Int) = ...   -- BAD!\n\n* Translation of type family decl:\n        type family F a :: *\n  translates to\n    a FamilyTyCon 'F', whose FamTyConFlav is OpenSynFamilyTyCon\n\n        type family G a :: * where\n          G Int = Bool\n          G Bool = Char\n          G a = ()\n  translates to\n    a FamilyTyCon 'G', whose FamTyConFlav is ClosedSynFamilyTyCon, with the\n    appropriate CoAxiom representing the equations\n\nWe also support injective type families -- see Note [Injective type families]\n\nNote [Data type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSee also Note [Wrappers for data instance tycons] in MkId.hs\n\n* Data type families are declared thus\n        data family T a :: *\n        data instance T Int = T1 | T2 Bool\n\n  Here T is the \"family TyCon\".\n\n* Reply \"yes\" to isDataFamilyTyCon, and isFamilyTyCon\n\n* The user does not see any \"equivalent types\" as he did with type\n  synonym families.  He just sees constructors with types\n        T1 :: T Int\n        T2 :: Bool -> T Int\n\n* Here's the FC version of the above declarations:\n\n        data T a\n        data R:TInt = T1 | T2 Bool\n        axiom ax_ti : T Int ~R R:TInt\n\n  Note that this is a *representational* coercion\n  The R:TInt is the \"representation TyCons\".\n  It has an AlgTyConFlav of\n        DataFamInstTyCon T [Int] ax_ti\n\n* The axiom ax_ti may be eta-reduced; see\n  Note [Eta reduction for data families] in FamInstEnv\n\n* Data family instances may have a different arity than the data family.\n  See Note [Arity of data families] in FamInstEnv\n\n* The data constructor T2 has a wrapper (which is what the\n  source-level \"T2\" invokes):\n\n        $WT2 :: Bool -> T Int\n        $WT2 b = T2 b `cast` sym ax_ti\n\n* A data instance can declare a fully-fledged GADT:\n\n        data instance T (a,b) where\n          X1 :: T (Int,Bool)\n          X2 :: a -> b -> T (a,b)\n\n  Here's the FC version of the above declaration:\n\n        data R:TPair a b where\n          X1 :: R:TPair Int Bool\n          X2 :: a -> b -> R:TPair a b\n        axiom ax_pr :: T (a,b)  ~R  R:TPair a b\n\n        $WX1 :: forall a b. a -> b -> T (a,b)\n        $WX1 a b (x::a) (y::b) = X2 a b x y `cast` sym (ax_pr a b)\n\n  The R:TPair are the \"representation TyCons\".\n  We have a bit of work to do, to unpick the result types of the\n  data instance declaration for T (a,b), to get the result type in the\n  representation; e.g.  T (a,b) --> R:TPair a b\n\n  The representation TyCon R:TList, has an AlgTyConFlav of\n\n        DataFamInstTyCon T [(a,b)] ax_pr\n\n* Notice that T is NOT translated to a FC type function; it just\n  becomes a \"data type\" with no constructors, which can be coerced\n  into R:TInt, R:TPair by the axioms.  These axioms\n  axioms come into play when (and *only* when) you\n        - use a data constructor\n        - do pattern matching\n  Rather like newtype, in fact\n\n  As a result\n\n  - T behaves just like a data type so far as decomposition is concerned\n\n  - (T Int) is not implicitly converted to R:TInt during type inference.\n    Indeed the latter type is unknown to the programmer.\n\n  - There *is* an instance for (T Int) in the type-family instance\n    environment, but it is only used for overlap checking\n\n  - It's fine to have T in the LHS of a type function:\n    type instance F (T a) = [a]\n\n  It was this last point that confused me!  The big thing is that you\n  should not think of a data family T as a *type function* at all, not\n  even an injective one!  We can't allow even injective type functions\n  on the LHS of a type function:\n        type family injective G a :: *\n        type instance F (G Int) = Bool\n  is no good, even if G is injective, because consider\n        type instance G Int = Bool\n        type instance F Bool = Char\n\n  So a data type family is not an injective type function. It's just a\n  data type with some axioms that connect it to other data types.\n\n* The tyConTyVars of the representation tycon are the tyvars that the\n  user wrote in the patterns. This is important in TcDeriv, where we\n  bring these tyvars into scope before type-checking the deriving\n  clause. This fact is arranged for in TcInstDecls.tcDataFamInstDecl.\n\nNote [Associated families and their parent class]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n*Associated* families are just like *non-associated* families, except\nthat they have a famTcParent field of (Just cls_tc), which identifies the\nparent class.\n\nHowever there is an important sharing relationship between\n  * the tyConTyVars of the parent Class\n  * the tyConTyVars of the associated TyCon\n\n   class C a b where\n     data T p a\n     type F a q b\n\nHere the 'a' and 'b' are shared with the 'Class'; that is, they have\nthe same Unique.\n\nThis is important. In an instance declaration we expect\n  * all the shared variables to be instantiated the same way\n  * the non-shared variables of the associated type should not\n    be instantiated at all\n\n  instance C [x] (Tree y) where\n     data T p [x] = T1 x | T2 p\n     type F [x] q (Tree y) = (x,y,q)\n\nNote [TyCon Role signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nEvery tycon has a role signature, assigning a role to each of the tyConTyVars\n(or of equal length to the tyConArity, if there are no tyConTyVars). An\nexample demonstrates these best: say we have a tycon T, with parameters a at\nnominal, b at representational, and c at phantom. Then, to prove\nrepresentational equality between T a1 b1 c1 and T a2 b2 c2, we need to have\nnominal equality between a1 and a2, representational equality between b1 and\nb2, and nothing in particular (i.e., phantom equality) between c1 and c2. This\nmight happen, say, with the following declaration:\n\n  data T a b c where\n    MkT :: b -> T Int b c\n\nData and class tycons have their roles inferred (see inferRoles in TcTyDecls),\nas do vanilla synonym tycons. Family tycons have all parameters at role N,\nthough it is conceivable that we could relax this restriction. (->)'s and\ntuples' parameters are at role R. Each primitive tycon declares its roles;\nit's worth noting that (~#)'s parameters are at role N. Promoted data\nconstructors' type arguments are at role R. All kind arguments are at role\nN.\n\nNote [Unboxed tuple RuntimeRep vars]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe contents of an unboxed tuple may have any representation. Accordingly,\nthe kind of the unboxed tuple constructor is runtime-representation\npolymorphic. For example,\n\n   (#,#) :: forall (q :: RuntimeRep) (r :: RuntimeRep). TYPE q -> TYPE r -> #\n\nThese extra tyvars (v and w) cause some delicate processing around tuples,\nwhere we used to be able to assume that the tycon arity and the\ndatacon arity were the same.\n\nNote [Injective type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe allow injectivity annotations for type families (both open and closed):\n\n  type family F (a :: k) (b :: k) = r | r -> a\n  type family G a b = res | res -> a b where ...\n\nInjectivity information is stored in the `famTcInj` field of `FamilyTyCon`.\n`famTcInj` maybe stores a list of Bools, where each entry corresponds to a\nsingle element of `tyConTyVars` (both lists should have identical length). If no\ninjectivity annotation was provided `famTcInj` is Nothing. From this follows an\ninvariant that if `famTcInj` is a Just then at least one element in the list\nmust be True.\n\nSee also:\n * [Injectivity annotation] in HsDecls\n * [Renaming injectivity annotation] in RnSource\n * [Verifying injectivity annotation] in FamInstEnv\n * [Type inference for type families with injectivity] in TcInteract\n\n************************************************************************\n*                                                                      *\n                    TyConBinder, TyConTyCoBinder\n*                                                                      *\n************************************************************************\n-}\n\ntype TyConBinder = VarBndr TyVar TyConBndrVis\n\n-- In the whole definition of @data TyCon@, only @PromotedDataCon@ will really\n-- contain CoVar.\ntype TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis\n\ndata TyConBndrVis\n  = NamedTCB ArgFlag\n  | AnonTCB  AnonArgFlag\n\ninstance Outputable TyConBndrVis where\n  ppr (NamedTCB flag) = text \"NamedTCB\" <> ppr flag\n  ppr (AnonTCB af)    = text \"AnonTCB\"  <> ppr af\n\nmkAnonTyConBinder :: AnonArgFlag -> TyVar -> TyConBinder\nmkAnonTyConBinder af tv = ASSERT( isTyVar tv)\n                          Bndr tv (AnonTCB af)\n\nmkAnonTyConBinders :: AnonArgFlag -> [TyVar] -> [TyConBinder]\nmkAnonTyConBinders af tvs = map (mkAnonTyConBinder af) tvs\n\nmkNamedTyConBinder :: ArgFlag -> TyVar -> TyConBinder\n-- The odd argument order supports currying\nmkNamedTyConBinder vis tv = ASSERT( isTyVar tv )\n                            Bndr tv (NamedTCB vis)\n\nmkNamedTyConBinders :: ArgFlag -> [TyVar] -> [TyConBinder]\n-- The odd argument order supports currying\nmkNamedTyConBinders vis tvs = map (mkNamedTyConBinder vis) tvs\n\n-- | Make a Required TyConBinder. It chooses between NamedTCB and\n-- AnonTCB based on whether the tv is mentioned in the dependent set\nmkRequiredTyConBinder :: TyCoVarSet  -- these are used dependently\n                      -> TyVar\n                      -> TyConBinder\nmkRequiredTyConBinder dep_set tv\n  | tv `elemVarSet` dep_set = mkNamedTyConBinder Required tv\n  | otherwise               = mkAnonTyConBinder  VisArg   tv\n\ntyConBinderArgFlag :: TyConBinder -> ArgFlag\ntyConBinderArgFlag (Bndr _ vis) = tyConBndrVisArgFlag vis\n\ntyConBndrVisArgFlag :: TyConBndrVis -> ArgFlag\ntyConBndrVisArgFlag (NamedTCB vis)     = vis\ntyConBndrVisArgFlag (AnonTCB VisArg)   = Required\ntyConBndrVisArgFlag (AnonTCB InvisArg) = Inferred    -- See Note [AnonTCB InvisArg]\n\nisNamedTyConBinder :: TyConBinder -> Bool\n-- Identifies kind variables\n-- E.g. data T k (a:k) = blah\n-- Here 'k' is a NamedTCB, a variable used in the kind of other binders\nisNamedTyConBinder (Bndr _ (NamedTCB {})) = True\nisNamedTyConBinder _                      = False\n\nisVisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool\n-- Works for IfaceTyConBinder too\nisVisibleTyConBinder (Bndr _ tcb_vis) = isVisibleTcbVis tcb_vis\n\nisVisibleTcbVis :: TyConBndrVis -> Bool\nisVisibleTcbVis (NamedTCB vis)     = isVisibleArgFlag vis\nisVisibleTcbVis (AnonTCB VisArg)   = True\nisVisibleTcbVis (AnonTCB InvisArg) = False\n\nisInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool\n-- Works for IfaceTyConBinder too\nisInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb)\n\nmkTyConKind :: [TyConBinder] -> Kind -> Kind\nmkTyConKind bndrs res_kind = foldr mk res_kind bndrs\n  where\n    mk :: TyConBinder -> Kind -> Kind\n    mk (Bndr tv (AnonTCB af))   k = mkFunTy af (varType tv) k\n    mk (Bndr tv (NamedTCB vis)) k = mkForAllTy tv vis k\n\ntyConTyVarBinders :: [TyConBinder]   -- From the TyCon\n                  -> [TyVarBinder]   -- Suitable for the foralls of a term function\n-- See Note [Building TyVarBinders from TyConBinders]\ntyConTyVarBinders tc_bndrs\n = map mk_binder tc_bndrs\n where\n   mk_binder (Bndr tv tc_vis) = mkTyVarBinder vis tv\n      where\n        vis = case tc_vis of\n                AnonTCB VisArg    -> Specified\n                AnonTCB InvisArg  -> Inferred   -- See Note [AnonTCB InvisArg]\n                NamedTCB Required -> Specified\n                NamedTCB vis      -> vis\n\n-- Returns only tyvars, as covars are always inferred\ntyConVisibleTyVars :: TyCon -> [TyVar]\ntyConVisibleTyVars tc\n  = [ tv | Bndr tv vis <- tyConBinders tc\n         , isVisibleTcbVis vis ]\n\n{- Note [AnonTCB InivsArg]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt's pretty rare to have an (AnonTCB InvisArg) binder.  The\nonly way it can occur is in a PromotedDataCon whose\nkind has an equality constraint:\n  'MkT :: forall a b. (a~b) => blah\nSee Note [Constraints in kinds] in TyCoRep, and\nNote [Promoted data constructors] in this module.\n\nWhen mapping an (AnonTCB InvisArg) to an ArgFlag, in\ntyConBndrVisArgFlag, we use \"Inferred\" to mean \"the user cannot\nspecify this arguments, even with visible type/kind application;\ninstead the type checker must fill it in.\n\nWe map (AnonTCB VisArg) to Required, of course: the user must\nprovide it. It would be utterly wrong to do this for constraint\narguments, which is why AnonTCB must have the AnonArgFlag in\nthe first place.\n\nNote [Building TyVarBinders from TyConBinders]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe sometimes need to build the quantified type of a value from\nthe TyConBinders of a type or class.  For that we need not\nTyConBinders but TyVarBinders (used in forall-type)  E.g:\n\n *  From   data T a = MkT (Maybe a)\n    we are going to make a data constructor with type\n           MkT :: forall a. Maybe a -> T a\n    See the TyCoVarBinders passed to buildDataCon\n\n * From    class C a where { op :: a -> Maybe a }\n   we are going to make a default method\n           $dmop :: forall a. C a => a -> Maybe a\n   See the TyCoVarBinders passed to mkSigmaTy in mkDefaultMethodType\n\nBoth of these are user-callable.  (NB: default methods are not callable\ndirectly by the user but rather via the code generated by 'deriving',\nwhich uses visible type application; see mkDefMethBind.)\n\nSince they are user-callable we must get their type-argument visibility\ninformation right; and that info is in the TyConBinders.\nHere is an example:\n\n  data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> *\n\nThe TyCon has\n\n  tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ]\n\nThe TyConBinders for App line up with App's kind, given above.\n\nBut the DataCon MkApp has the type\n  MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b\n\nThat is, its TyCoVarBinders should be\n\n  dataConUnivTyVarBinders = [ Bndr (k:*)    Inferred\n                            , Bndr (a:k->*) Specified\n                            , Bndr (b:k)    Specified ]\n\nSo tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders:\n  - variable names from the TyConBinders\n  - but changing Anon/Required to Specified\n\nThe last part about Required->Specified comes from this:\n  data T k (a:k) b = MkT (a b)\nHere k is Required in T's kind, but we don't have Required binders in\nthe TyCoBinders for a term (see Note [No Required TyCoBinder in terms]\nin TyCoRep), so we change it to Specified when making MkT's TyCoBinders\n-}\n\n\n{- Note [The binders/kind/arity fields of a TyCon]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAll TyCons have this group of fields\n  tyConBinders   :: [TyConBinder/TyConTyCoBinder]\n  tyConResKind   :: Kind\n  tyConTyVars    :: [TyVar]   -- Cached = binderVars tyConBinders\n                              --   NB: Currently (Aug 2018), TyCons that own this\n                              --   field really only contain TyVars. So it is\n                              --   [TyVar] instead of [TyCoVar].\n  tyConKind      :: Kind      -- Cached = mkTyConKind tyConBinders tyConResKind\n  tyConArity     :: Arity     -- Cached = length tyConBinders\n\nThey fit together like so:\n\n* tyConBinders gives the telescope of type/coercion variables on the LHS of the\n  type declaration.  For example:\n\n    type App a (b :: k) = a b\n\n  tyConBinders = [ Bndr (k::*)   (NamedTCB Inferred)\n                 , Bndr (a:k->*) AnonTCB\n                 , Bndr (b:k)    AnonTCB ]\n\n  Note that that are three binders here, including the\n  kind variable k.\n\n* See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep\n  for what the visibility flag means.\n\n* Each TyConBinder tyConBinders has a TyVar (sometimes it is TyCoVar), and\n  that TyVar may scope over some other part of the TyCon's definition. Eg\n      type T a = a -> a\n  we have\n      tyConBinders = [ Bndr (a:*) AnonTCB ]\n      synTcRhs     = a -> a\n  So the 'a' scopes over the synTcRhs\n\n* From the tyConBinders and tyConResKind we can get the tyConKind\n  E.g for our App example:\n      App :: forall k. (k->*) -> k -> *\n\n  We get a 'forall' in the kind for each NamedTCB, and an arrow\n  for each AnonTCB\n\n  tyConKind is the full kind of the TyCon, not just the result kind\n\n* For type families, tyConArity is the arguments this TyCon must be\n  applied to, to be considered saturated.  Here we mean \"applied to in\n  the actual Type\", not surface syntax; i.e. including implicit kind\n  variables.  So it's just (length tyConBinders)\n\n* For an algebraic data type, or data instance, the tyConResKind is\n  always (TYPE r); that is, the tyConBinders are enough to saturate\n  the type constructor.  I'm not quite sure why we have this invariant,\n  but it's enforced by etaExpandAlgTyCon\n-}\n\ninstance Outputable tv => Outputable (VarBndr tv TyConBndrVis) where\n  ppr (Bndr v bi) = ppr_bi bi <+> parens (ppr v)\n    where\n      ppr_bi (AnonTCB VisArg)     = text \"anon-vis\"\n      ppr_bi (AnonTCB InvisArg)   = text \"anon-invis\"\n      ppr_bi (NamedTCB Required)  = text \"req\"\n      ppr_bi (NamedTCB Specified) = text \"spec\"\n      ppr_bi (NamedTCB Inferred)  = text \"inf\"\n\ninstance Binary TyConBndrVis where\n  put_ bh (AnonTCB af)   = do { putByte bh 0; put_ bh af }\n  put_ bh (NamedTCB vis) = do { putByte bh 1; put_ bh vis }\n\n  get bh = do { h <- getByte bh\n              ; case h of\n                  0 -> do { af  <- get bh; return (AnonTCB af) }\n                  _ -> do { vis <- get bh; return (NamedTCB vis) } }\n\n\n{- *********************************************************************\n*                                                                      *\n               The TyCon type\n*                                                                      *\n************************************************************************\n-}\n\n\n-- | TyCons represent type constructors. Type constructors are introduced by\n-- things such as:\n--\n-- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of\n--    kind @*@\n--\n-- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor\n--\n-- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor\n--    of kind @* -> *@\n--\n-- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor\n--    of kind @*@\n--\n-- This data type also encodes a number of primitive, built in type constructors\n-- such as those for function and tuple types.\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata TyCon\n  = -- | The function type constructor, @(->)@\n    FunTyCon {\n        tyConUnique :: Unique,   -- ^ A Unique of this TyCon. Invariant:\n                                 -- identical to Unique of Name stored in\n                                 -- tyConName field.\n\n        tyConName   :: Name,     -- ^ Name of the constructor\n\n        -- See Note [The binders/kind/arity fields of a TyCon]\n        tyConBinders :: [TyConBinder], -- ^ Full binders\n        tyConResKind :: Kind,             -- ^ Result kind\n        tyConKind    :: Kind,             -- ^ Kind of this TyCon\n        tyConArity   :: Arity,            -- ^ Arity\n\n        tcRepName :: TyConRepName\n    }\n\n  -- | Algebraic data types, from\n  --     - @data@ declarations\n  --     - @newtype@ declarations\n  --     - data instance declarations\n  --     - type instance declarations\n  --     - the TyCon generated by a class declaration\n  --     - boxed tuples\n  --     - unboxed tuples\n  --     - constraint tuples\n  -- All these constructors are lifted and boxed except unboxed tuples\n  -- which should have an 'UnboxedAlgTyCon' parent.\n  -- Data/newtype/type /families/ are handled by 'FamilyTyCon'.\n  -- See 'AlgTyConRhs' for more information.\n  | AlgTyCon {\n        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:\n                                 -- identical to Unique of Name stored in\n                                 -- tyConName field.\n\n        tyConName    :: Name,    -- ^ Name of the constructor\n\n        -- See Note [The binders/kind/arity fields of a TyCon]\n        tyConBinders :: [TyConBinder], -- ^ Full binders\n        tyConTyVars  :: [TyVar],          -- ^ TyVar binders\n        tyConResKind :: Kind,             -- ^ Result kind\n        tyConKind    :: Kind,             -- ^ Kind of this TyCon\n        tyConArity   :: Arity,            -- ^ Arity\n\n              -- The tyConTyVars scope over:\n              --\n              -- 1. The 'algTcStupidTheta'\n              -- 2. The cached types in algTyConRhs.NewTyCon\n              -- 3. The family instance types if present\n              --\n              -- Note that it does /not/ scope over the data\n              -- constructors.\n\n        tcRoles      :: [Role],  -- ^ The role for each type variable\n                                 -- This list has length = tyConArity\n                                 -- See also Note [TyCon Role signatures]\n\n        tyConCType   :: Maybe CType,-- ^ The C type that should be used\n                                    -- for this type when using the FFI\n                                    -- and CAPI\n\n        algTcGadtSyntax  :: Bool,   -- ^ Was the data type declared with GADT\n                                    -- syntax?  If so, that doesn't mean it's a\n                                    -- true GADT; only that the \"where\" form\n                                    -- was used.  This field is used only to\n                                    -- guide pretty-printing\n\n        algTcStupidTheta :: [PredType], -- ^ The \\\"stupid theta\\\" for the data\n                                        -- type (always empty for GADTs).  A\n                                        -- \\\"stupid theta\\\" is the context to\n                                        -- the left of an algebraic type\n                                        -- declaration, e.g. @Eq a@ in the\n                                        -- declaration @data Eq a => T a ...@.\n\n        algTcRhs    :: AlgTyConRhs, -- ^ Contains information about the\n                                    -- data constructors of the algebraic type\n\n        algTcFields :: FieldLabelEnv, -- ^ Maps a label to information\n                                      -- about the field\n\n        algTcParent :: AlgTyConFlav -- ^ Gives the class or family declaration\n                                       -- 'TyCon' for derived 'TyCon's representing\n                                       -- class or family instances, respectively.\n\n    }\n\n  -- | Represents type synonyms\n  | SynonymTyCon {\n        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:\n                                 -- identical to Unique of Name stored in\n                                 -- tyConName field.\n\n        tyConName    :: Name,    -- ^ Name of the constructor\n\n        -- See Note [The binders/kind/arity fields of a TyCon]\n        tyConBinders :: [TyConBinder], -- ^ Full binders\n        tyConTyVars  :: [TyVar],          -- ^ TyVar binders\n        tyConResKind :: Kind,             -- ^ Result kind\n        tyConKind    :: Kind,             -- ^ Kind of this TyCon\n        tyConArity   :: Arity,            -- ^ Arity\n             -- tyConTyVars scope over: synTcRhs\n\n        tcRoles      :: [Role],  -- ^ The role for each type variable\n                                 -- This list has length = tyConArity\n                                 -- See also Note [TyCon Role signatures]\n\n        synTcRhs     :: Type,    -- ^ Contains information about the expansion\n                                 -- of the synonym\n\n        synIsTau     :: Bool,   -- True <=> the RHS of this synonym does not\n                                 --          have any foralls, after expanding any\n                                 --          nested synonyms\n        synIsFamFree  :: Bool    -- True <=> the RHS of this synonym does not mention\n                                 --          any type synonym families (data families\n                                 --          are fine), again after expanding any\n                                 --          nested synonyms\n    }\n\n  -- | Represents families (both type and data)\n  -- Argument roles are all Nominal\n  | FamilyTyCon {\n        tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:\n                                 -- identical to Unique of Name stored in\n                                 -- tyConName field.\n\n        tyConName    :: Name,    -- ^ Name of the constructor\n\n        -- See Note [The binders/kind/arity fields of a TyCon]\n        tyConBinders :: [TyConBinder], -- ^ Full binders\n        tyConTyVars  :: [TyVar],          -- ^ TyVar binders\n        tyConResKind :: Kind,             -- ^ Result kind\n        tyConKind    :: Kind,             -- ^ Kind of this TyCon\n        tyConArity   :: Arity,            -- ^ Arity\n            -- tyConTyVars connect an associated family TyCon\n            -- with its parent class; see TcValidity.checkConsistentFamInst\n\n        famTcResVar  :: Maybe Name,   -- ^ Name of result type variable, used\n                                      -- for pretty-printing with --show-iface\n                                      -- and for reifying TyCon in Template\n                                      -- Haskell\n\n        famTcFlav    :: FamTyConFlav, -- ^ Type family flavour: open, closed,\n                                      -- abstract, built-in. See comments for\n                                      -- FamTyConFlav\n\n        famTcParent  :: Maybe TyCon,  -- ^ For *associated* type/data families\n                                      -- The class tycon in which the family is declared\n                                      -- See Note [Associated families and their parent class]\n\n        famTcInj     :: Injectivity   -- ^ is this a type family injective in\n                                      -- its type variables? Nothing if no\n                                      -- injectivity annotation was given\n    }\n\n  -- | Primitive types; cannot be defined in Haskell. This includes\n  -- the usual suspects (such as @Int#@) as well as foreign-imported\n  -- types and kinds (@*@, @#@, and @?@)\n  | PrimTyCon {\n        tyConUnique   :: Unique, -- ^ A Unique of this TyCon. Invariant:\n                                 -- identical to Unique of Name stored in\n                                 -- tyConName field.\n\n        tyConName     :: Name,   -- ^ Name of the constructor\n\n        -- See Note [The binders/kind/arity fields of a TyCon]\n        tyConBinders :: [TyConBinder], -- ^ Full binders\n        tyConResKind :: Kind,             -- ^ Result kind\n        tyConKind    :: Kind,             -- ^ Kind of this TyCon\n        tyConArity   :: Arity,            -- ^ Arity\n\n        tcRoles       :: [Role], -- ^ The role for each type variable\n                                 -- This list has length = tyConArity\n                                 -- See also Note [TyCon Role signatures]\n\n        isUnlifted   :: Bool,    -- ^ Most primitive tycons are unlifted (may\n                                 -- not contain bottom) but other are lifted,\n                                 -- e.g. @RealWorld@\n                                 -- Only relevant if tyConKind = *\n\n        primRepName :: Maybe TyConRepName   -- Only relevant for kind TyCons\n                                            -- i.e, *, #, ?\n    }\n\n  -- | Represents promoted data constructor.\n  | PromotedDataCon {          -- See Note [Promoted data constructors]\n        tyConUnique  :: Unique,     -- ^ Same Unique as the data constructor\n        tyConName    :: Name,       -- ^ Same Name as the data constructor\n\n        -- See Note [The binders/kind/arity fields of a TyCon]\n        tyConBinders :: [TyConTyCoBinder], -- ^ Full binders\n        tyConResKind :: Kind,             -- ^ Result kind\n        tyConKind    :: Kind,             -- ^ Kind of this TyCon\n        tyConArity   :: Arity,            -- ^ Arity\n\n        tcRoles       :: [Role],    -- ^ Roles: N for kind vars, R for type vars\n        dataCon       :: DataCon,   -- ^ Corresponding data constructor\n        tcRepName     :: TyConRepName,\n        promDcRepInfo :: RuntimeRepInfo  -- ^ See comments with 'RuntimeRepInfo'\n    }\n\n  -- | These exist only during type-checking. See Note [How TcTyCons work]\n  -- in TcTyClsDecls\n  | TcTyCon {\n        tyConUnique :: Unique,\n        tyConName   :: Name,\n\n        -- See Note [The binders/kind/arity fields of a TyCon]\n        tyConBinders :: [TyConBinder], -- ^ Full binders\n        tyConTyVars  :: [TyVar],       -- ^ TyVar binders\n        tyConResKind :: Kind,          -- ^ Result kind\n        tyConKind    :: Kind,          -- ^ Kind of this TyCon\n        tyConArity   :: Arity,         -- ^ Arity\n\n          -- NB: the TyConArity of a TcTyCon must match\n          -- the number of Required (positional, user-specified)\n          -- arguments to the type constructor; see the use\n          -- of tyConArity in generaliseTcTyCon\n\n        tcTyConScopedTyVars :: [(Name,TyVar)],\n          -- ^ Scoped tyvars over the tycon's body\n          -- See Note [Scoped tyvars in a TcTyCon]\n\n        tcTyConIsPoly     :: Bool, -- ^ Is this TcTyCon already generalized?\n\n        tcTyConFlavour :: TyConFlavour\n                           -- ^ What sort of 'TyCon' this represents.\n      }\n{- Note [Scoped tyvars in a TcTyCon]\n\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe tcTyConScopedTyVars field records the lexicial-binding connection\nbetween the original, user-specified Name (i.e. thing in scope) and\nthe TcTyVar that the Name is bound to.\n\nOrder *does* matter; the tcTyConScopedTyvars list consists of\n     specified_tvs ++ required_tvs\n\nwhere\n   * specified ones first\n   * required_tvs the same as tyConTyVars\n   * tyConArity = length required_tvs\n\nSee also Note [How TcTyCons work] in TcTyClsDecls\n-}\n\n-- | Represents right-hand-sides of 'TyCon's for algebraic types\ndata AlgTyConRhs\n\n    -- | Says that we know nothing about this data type, except that\n    -- it's represented by a pointer.  Used when we export a data type\n    -- abstractly into an .hi file.\n  = AbstractTyCon\n\n    -- | Information about those 'TyCon's derived from a @data@\n    -- declaration. This includes data types with no constructors at\n    -- all.\n  | DataTyCon {\n        data_cons :: [DataCon],\n                          -- ^ The data type constructors; can be empty if the\n                          --   user declares the type to have no constructors\n                          --\n                          -- INVARIANT: Kept in order of increasing 'DataCon'\n                          -- tag (see the tag assignment in mkTyConTagMap)\n        data_cons_size :: Int,\n                          -- ^ Cached value: length data_cons\n        is_enum :: Bool   -- ^ Cached value: is this an enumeration type?\n                          --   See Note [Enumeration types]\n    }\n\n  | TupleTyCon {                   -- A boxed, unboxed, or constraint tuple\n        data_con :: DataCon,       -- NB: it can be an *unboxed* tuple\n        tup_sort :: TupleSort      -- ^ Is this a boxed, unboxed or constraint\n                                   -- tuple?\n    }\n\n  -- | An unboxed sum type.\n  | SumTyCon {\n        data_cons :: [DataCon],\n        data_cons_size :: Int  -- ^ Cached value: length data_cons\n    }\n\n  -- | Information about those 'TyCon's derived from a @newtype@ declaration\n  | NewTyCon {\n        data_con :: DataCon,    -- ^ The unique constructor for the @newtype@.\n                                --   It has no existentials\n\n        nt_rhs :: Type,         -- ^ Cached value: the argument type of the\n                                -- constructor, which is just the representation\n                                -- type of the 'TyCon' (remember that @newtype@s\n                                -- do not exist at runtime so need a different\n                                -- representation type).\n                                --\n                                -- The free 'TyVar's of this type are the\n                                -- 'tyConTyVars' from the corresponding 'TyCon'\n\n        nt_etad_rhs :: ([TyVar], Type),\n                        -- ^ Same as the 'nt_rhs', but this time eta-reduced.\n                        -- Hence the list of 'TyVar's in this field may be\n                        -- shorter than the declared arity of the 'TyCon'.\n\n                        -- See Note [Newtype eta]\n        nt_co :: CoAxiom Unbranched\n                             -- The axiom coercion that creates the @newtype@\n                             -- from the representation 'Type'.\n\n                             -- See Note [Newtype coercions]\n                             -- Invariant: arity = #tvs in nt_etad_rhs;\n                             -- See Note [Newtype eta]\n                             -- Watch out!  If any newtypes become transparent\n                             -- again check Trac #1072.\n    }\n\nmkSumTyConRhs :: [DataCon] -> AlgTyConRhs\nmkSumTyConRhs data_cons = SumTyCon data_cons (length data_cons)\n\nmkDataTyConRhs :: [DataCon] -> AlgTyConRhs\nmkDataTyConRhs cons\n  = DataTyCon {\n        data_cons = cons,\n        data_cons_size = length cons,\n        is_enum = not (null cons) && all is_enum_con cons\n                  -- See Note [Enumeration types] in TyCon\n    }\n  where\n    is_enum_con con\n       | (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res)\n           <- dataConFullSig con\n       = null ex_tvs && null eq_spec && null theta && null arg_tys\n\n-- | Some promoted datacons signify extra info relevant to GHC. For example,\n-- the @IntRep@ constructor of @RuntimeRep@ corresponds to the 'IntRep'\n-- constructor of 'PrimRep'. This data structure allows us to store this\n-- information right in the 'TyCon'. The other approach would be to look\n-- up things like @RuntimeRep@'s @PrimRep@ by known-key every time.\ndata RuntimeRepInfo\n  = NoRRI       -- ^ an ordinary promoted data con\n  | RuntimeRep ([Type] -> [PrimRep])\n      -- ^ A constructor of @RuntimeRep@. The argument to the function should\n      -- be the list of arguments to the promoted datacon.\n  | VecCount Int         -- ^ A constructor of @VecCount@\n  | VecElem PrimElemRep  -- ^ A constructor of @VecElem@\n\n-- | Extract those 'DataCon's that we are able to learn about.  Note\n-- that visibility in this sense does not correspond to visibility in\n-- the context of any particular user program!\nvisibleDataCons :: AlgTyConRhs -> [DataCon]\nvisibleDataCons (AbstractTyCon {})            = []\nvisibleDataCons (DataTyCon{ data_cons = cs }) = cs\nvisibleDataCons (NewTyCon{ data_con = c })    = [c]\nvisibleDataCons (TupleTyCon{ data_con = c })  = [c]\nvisibleDataCons (SumTyCon{ data_cons = cs })  = cs\n\n-- ^ Both type classes as well as family instances imply implicit\n-- type constructors.  These implicit type constructors refer to their parent\n-- structure (ie, the class or family from which they derive) using a type of\n-- the following form.\ndata AlgTyConFlav\n  = -- | An ordinary type constructor has no parent.\n    VanillaAlgTyCon\n       TyConRepName\n\n    -- | An unboxed type constructor. The TyConRepName is a Maybe since we\n    -- currently don't allow unboxed sums to be Typeable since there are too\n    -- many of them. See #13276.\n  | UnboxedAlgTyCon\n       (Maybe TyConRepName)\n\n  -- | Type constructors representing a class dictionary.\n  -- See Note [ATyCon for classes] in TyCoRep\n  | ClassTyCon\n        Class           -- INVARIANT: the classTyCon of this Class is the\n                        -- current tycon\n        TyConRepName\n\n  -- | Type constructors representing an *instance* of a *data* family.\n  -- Parameters:\n  --\n  --  1) The type family in question\n  --\n  --  2) Instance types; free variables are the 'tyConTyVars'\n  --  of the current 'TyCon' (not the family one). INVARIANT:\n  --  the number of types matches the arity of the family 'TyCon'\n  --\n  --  3) A 'CoTyCon' identifying the representation\n  --  type with the type instance family\n  | DataFamInstTyCon          -- See Note [Data type families]\n        (CoAxiom Unbranched)  -- The coercion axiom.\n               -- A *Representational* coercion,\n               -- of kind   T ty1 ty2   ~R   R:T a b c\n               -- where T is the family TyCon,\n               -- and R:T is the representation TyCon (ie this one)\n               -- and a,b,c are the tyConTyVars of this TyCon\n               --\n               -- BUT may be eta-reduced; see FamInstEnv\n               --     Note [Eta reduction for data families]\n\n          -- Cached fields of the CoAxiom, but adjusted to\n          -- use the tyConTyVars of this TyCon\n        TyCon   -- The family TyCon\n        [Type]  -- Argument types (mentions the tyConTyVars of this TyCon)\n                -- No shorter in length than the tyConTyVars of the family TyCon\n                -- How could it be longer? See [Arity of data families] in FamInstEnv\n\n        -- E.g.  data instance T [a] = ...\n        -- gives a representation tycon:\n        --      data R:TList a = ...\n        --      axiom co a :: T [a] ~ R:TList a\n        -- with R:TList's algTcParent = DataFamInstTyCon T [a] co\n\ninstance Outputable AlgTyConFlav where\n    ppr (VanillaAlgTyCon {})        = text \"Vanilla ADT\"\n    ppr (UnboxedAlgTyCon {})        = text \"Unboxed ADT\"\n    ppr (ClassTyCon cls _)          = text \"Class parent\" <+> ppr cls\n    ppr (DataFamInstTyCon _ tc tys) = text \"Family parent (family instance)\"\n                                      <+> ppr tc <+> sep (map pprType tys)\n\n-- | Checks the invariants of a 'AlgTyConFlav' given the appropriate type class\n-- name, if any\nokParent :: Name -> AlgTyConFlav -> Bool\nokParent _       (VanillaAlgTyCon {})            = True\nokParent _       (UnboxedAlgTyCon {})            = True\nokParent tc_name (ClassTyCon cls _)              = tc_name == tyConName (classTyCon cls)\nokParent _       (DataFamInstTyCon _ fam_tc tys) = tys `lengthAtLeast` tyConArity fam_tc\n\nisNoParent :: AlgTyConFlav -> Bool\nisNoParent (VanillaAlgTyCon {}) = True\nisNoParent _                   = False\n\n--------------------\n\ndata Injectivity\n  = NotInjective\n  | Injective [Bool]   -- 1-1 with tyConTyVars (incl kind vars)\n  deriving( Eq )\n\n-- | Information pertaining to the expansion of a type synonym (@type@)\ndata FamTyConFlav\n  = -- | Represents an open type family without a fixed right hand\n    -- side.  Additional instances can appear at any time.\n    --\n    -- These are introduced by either a top level declaration:\n    --\n    -- > data family T a :: *\n    --\n    -- Or an associated data type declaration, within a class declaration:\n    --\n    -- > class C a b where\n    -- >   data T b :: *\n     DataFamilyTyCon\n       TyConRepName\n\n     -- | An open type synonym family  e.g. @type family F x y :: * -> *@\n   | OpenSynFamilyTyCon\n\n   -- | A closed type synonym family  e.g.\n   -- @type family F x where { F Int = Bool }@\n   | ClosedSynFamilyTyCon (Maybe (CoAxiom Branched))\n     -- See Note [Closed type families]\n\n   -- | A closed type synonym family declared in an hs-boot file with\n   -- type family F a where ..\n   | AbstractClosedSynFamilyTyCon\n\n   -- | Built-in type family used by the TypeNats solver\n   | BuiltInSynFamTyCon BuiltInSynFamily\n\ninstance Outputable FamTyConFlav where\n    ppr (DataFamilyTyCon n) = text \"data family\" <+> ppr n\n    ppr OpenSynFamilyTyCon = text \"open type family\"\n    ppr (ClosedSynFamilyTyCon Nothing) = text \"closed type family\"\n    ppr (ClosedSynFamilyTyCon (Just coax)) = text \"closed type family\" <+> ppr coax\n    ppr AbstractClosedSynFamilyTyCon = text \"abstract closed type family\"\n    ppr (BuiltInSynFamTyCon _) = text \"built-in type family\"\n\n{- Note [Closed type families]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* In an open type family you can add new instances later.  This is the\n  usual case.\n\n* In a closed type family you can only put equations where the family\n  is defined.\n\nA non-empty closed type family has a single axiom with multiple\nbranches, stored in the 'ClosedSynFamilyTyCon' constructor.  A closed\ntype family with no equations does not have an axiom, because there is\nnothing for the axiom to prove!\n\n\nNote [Promoted data constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAll data constructors can be promoted to become a type constructor,\nvia the PromotedDataCon alternative in TyCon.\n\n* The TyCon promoted from a DataCon has the *same* Name and Unique as\n  the DataCon.  Eg. If the data constructor Data.Maybe.Just(unique 78,\n  say) is promoted to a TyCon whose name is Data.Maybe.Just(unique 78)\n\n* We promote the *user* type of the DataCon.  Eg\n     data T = MkT {-# UNPACK #-} !(Bool, Bool)\n  The promoted kind is\n     'MkT :: (Bool,Bool) -> T\n  *not*\n     'MkT :: Bool -> Bool -> T\n\n* Similarly for GADTs:\n     data G a where\n       MkG :: forall b. b -> G [b]\n  The promoted data constructor has kind\n       'MkG :: forall b. b -> G [b]\n  *not*\n       'MkG :: forall a b. (a ~# [b]) => b -> G a\n\nNote [Enumeration types]\n~~~~~~~~~~~~~~~~~~~~~~~~\nWe define datatypes with no constructors to *not* be\nenumerations; this fixes trac #2578,  Otherwise we\nend up generating an empty table for\n  <mod>_<type>_closure_tbl\nwhich is used by tagToEnum# to map Int# to constructors\nin an enumeration. The empty table apparently upset\nthe linker.\n\nMoreover, all the data constructor must be enumerations, meaning\nthey have type  (forall abc. T a b c).  GADTs are not enumerations.\nFor example consider\n    data T a where\n      T1 :: T Int\n      T2 :: T Bool\n      T3 :: T a\nWhat would [T1 ..] be?  [T1,T3] :: T Int? Easiest thing is to exclude them.\nSee Trac #4528.\n\nNote [Newtype coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~\nThe NewTyCon field nt_co is a CoAxiom which is used for coercing from\nthe representation type of the newtype, to the newtype itself. For\nexample,\n\n   newtype T a = MkT (a -> a)\n\nthe NewTyCon for T will contain nt_co = CoT where CoT t : T t ~ t -> t.\n\nIn the case that the right hand side is a type application\nending with the same type variables as the left hand side, we\n\"eta-contract\" the coercion.  So if we had\n\n   newtype S a = MkT [a]\n\nthen we would generate the arity 0 axiom CoS : S ~ [].  The\nprimary reason we do this is to make newtype deriving cleaner.\n\nIn the paper we'd write\n        axiom CoT : (forall t. T t) ~ (forall t. [t])\nand then when we used CoT at a particular type, s, we'd say\n        CoT @ s\nwhich encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])\n\nNote [Newtype eta]\n~~~~~~~~~~~~~~~~~~\nConsider\n        newtype Parser a = MkParser (IO a) deriving Monad\nAre these two types equal (to Core)?\n        Monad Parser\n        Monad IO\nwhich we need to make the derived instance for Monad Parser.\n\nWell, yes.  But to see that easily we eta-reduce the RHS type of\nParser, in this case to ([], Froogle), so that even unsaturated applications\nof Parser will work right.  This eta reduction is done when the type\nconstructor is built, and cached in NewTyCon.\n\nHere's an example that I think showed up in practice\nSource code:\n        newtype T a = MkT [a]\n        newtype Foo m = MkFoo (forall a. m a -> Int)\n\n        w1 :: Foo []\n        w1 = ...\n\n        w2 :: Foo T\n        w2 = MkFoo (\\(MkT x) -> case w1 of MkFoo f -> f x)\n\nAfter desugaring, and discarding the data constructors for the newtypes,\nwe get:\n        w2 = w1 `cast` Foo CoT\nso the coercion tycon CoT must have\n        kind:    T ~ []\n and    arity:   0\n\nThis eta-reduction is implemented in BuildTyCl.mkNewTyConRhs.\n\n\n************************************************************************\n*                                                                      *\n                 TyConRepName\n*                                                                      *\n********************************************************************* -}\n\ntype TyConRepName = Name -- The Name of the top-level declaration\n                         --    $tcMaybe :: Data.Typeable.Internal.TyCon\n                         --    $tcMaybe = TyCon { tyConName = \"Maybe\", ... }\n\ntyConRepName_maybe :: TyCon -> Maybe TyConRepName\ntyConRepName_maybe (FunTyCon   { tcRepName = rep_nm })\n  = Just rep_nm\ntyConRepName_maybe (PrimTyCon  { primRepName = mb_rep_nm })\n  = mb_rep_nm\ntyConRepName_maybe (AlgTyCon { algTcParent = parent })\n  | VanillaAlgTyCon rep_nm <- parent = Just rep_nm\n  | ClassTyCon _ rep_nm    <- parent = Just rep_nm\n  | UnboxedAlgTyCon rep_nm <- parent = rep_nm\ntyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm })\n  = Just rep_nm\ntyConRepName_maybe (PromotedDataCon { dataCon = dc, tcRepName = rep_nm })\n  | isUnboxedSumCon dc   -- see #13276\n  = Nothing\n  | otherwise\n  = Just rep_nm\ntyConRepName_maybe _ = Nothing\n\n-- | Make a 'Name' for the 'Typeable' representation of the given wired-in type\nmkPrelTyConRepName :: Name -> TyConRepName\n-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.\nmkPrelTyConRepName tc_name  -- Prelude tc_name is always External,\n                            -- so nameModule will work\n  = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)\n  where\n    name_occ  = nameOccName tc_name\n    name_mod  = nameModule  tc_name\n    name_uniq = nameUnique  tc_name\n    rep_uniq | isTcOcc name_occ = tyConRepNameUnique   name_uniq\n             | otherwise        = dataConTyRepNameUnique name_uniq\n    (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ\n\n-- | The name (and defining module) for the Typeable representation (TyCon) of a\n-- type constructor.\n--\n-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.\ntyConRepModOcc :: Module -> OccName -> (Module, OccName)\ntyConRepModOcc tc_module tc_occ = (rep_module, mkTyConRepOcc tc_occ)\n  where\n    rep_module\n      | tc_module == gHC_PRIM = gHC_TYPES\n      | otherwise             = tc_module\n\n\n{- *********************************************************************\n*                                                                      *\n                 PrimRep\n*                                                                      *\n************************************************************************\n\nNote [rep swamp]\n\nGHC has a rich selection of types that represent \"primitive types\" of\none kind or another.  Each of them makes a different set of\ndistinctions, and mostly the differences are for good reasons,\nalthough it's probably true that we could merge some of these.\n\nRoughly in order of \"includes more information\":\n\n - A Width (cmm/CmmType) is simply a binary value with the specified\n   number of bits.  It may represent a signed or unsigned integer, a\n   floating-point value, or an address.\n\n    data Width = W8 | W16 | W32 | W64 | W80 | W128\n\n - Size, which is used in the native code generator, is Width +\n   floating point information.\n\n   data Size = II8 | II16 | II32 | II64 | FF32 | FF64 | FF80\n\n   it is necessary because e.g. the instruction to move a 64-bit float\n   on x86 (movsd) is different from the instruction to move a 64-bit\n   integer (movq), so the mov instruction is parameterised by Size.\n\n - CmmType wraps Width with more information: GC ptr, float, or\n   other value.\n\n    data CmmType = CmmType CmmCat Width\n\n    data CmmCat     -- \"Category\" (not exported)\n       = GcPtrCat   -- GC pointer\n       | BitsCat    -- Non-pointer\n       | FloatCat   -- Float\n\n   It is important to have GcPtr information in Cmm, since we generate\n   info tables containing pointerhood for the GC from this.  As for\n   why we have float (and not signed/unsigned) here, see Note [Signed\n   vs unsigned].\n\n - ArgRep makes only the distinctions necessary for the call and\n   return conventions of the STG machine.  It is essentially CmmType\n   + void.\n\n - PrimRep makes a few more distinctions than ArgRep: it divides\n   non-GC-pointers into signed/unsigned and addresses, information\n   that is necessary for passing these values to foreign functions.\n\nThere's another tension here: whether the type encodes its size in\nbytes, or whether its size depends on the machine word size.  Width\nand CmmType have the size built-in, whereas ArgRep and PrimRep do not.\n\nThis means to turn an ArgRep/PrimRep into a CmmType requires DynFlags.\n\nOn the other hand, CmmType includes some \"nonsense\" values, such as\nCmmType GcPtrCat W32 on a 64-bit machine.\n-}\n\n-- | A 'PrimRep' is an abstraction of a type.  It contains information that\n-- the code generator needs in order to pass arguments, return results,\n-- and store values of this type.\ndata PrimRep\n  = VoidRep\n  | LiftedRep\n  | UnliftedRep   -- ^ Unlifted pointer\n  | Int8Rep       -- ^ Signed, 8-bit value\n  | Int16Rep      -- ^ Signed, 16-bit value\n  | IntRep        -- ^ Signed, word-sized value\n  | WordRep       -- ^ Unsigned, word-sized value\n  | Int64Rep      -- ^ Signed, 64 bit value (with 32-bit words only)\n  | Word8Rep      -- ^ Unsigned, 8 bit value\n  | Word16Rep      -- ^ Unsigned, 16 bit value\n  | Word64Rep     -- ^ Unsigned, 64 bit value (with 32-bit words only)\n  | AddrRep       -- ^ A pointer, but /not/ to a Haskell value (use '(Un)liftedRep')\n  | FloatRep\n  | DoubleRep\n  | VecRep Int PrimElemRep  -- ^ A vector\n  deriving( Eq, Show )\n\ndata PrimElemRep\n  = Int8ElemRep\n  | Int16ElemRep\n  | Int32ElemRep\n  | Int64ElemRep\n  | Word8ElemRep\n  | Word16ElemRep\n  | Word32ElemRep\n  | Word64ElemRep\n  | FloatElemRep\n  | DoubleElemRep\n   deriving( Eq, Show )\n\ninstance Outputable PrimRep where\n  ppr r = text (show r)\n\ninstance Outputable PrimElemRep where\n  ppr r = text (show r)\n\nisVoidRep :: PrimRep -> Bool\nisVoidRep VoidRep = True\nisVoidRep _other  = False\n\nisGcPtrRep :: PrimRep -> Bool\nisGcPtrRep LiftedRep   = True\nisGcPtrRep UnliftedRep = True\nisGcPtrRep _           = False\n\n-- | The size of a 'PrimRep' in bytes.\n--\n-- This applies also when used in a constructor, where we allow packing the\n-- fields. For instance, in @data Foo = Foo Float# Float#@ the two fields will\n-- take only 8 bytes, which for 64-bit arch will be equal to 1 word.\n-- See also mkVirtHeapOffsetsWithPadding for details of how data fields are\n-- layed out.\nprimRepSizeB :: DynFlags -> PrimRep -> Int\nprimRepSizeB dflags IntRep           = wORD_SIZE dflags\nprimRepSizeB dflags WordRep          = wORD_SIZE dflags\nprimRepSizeB _      Int8Rep          = 1\nprimRepSizeB _      Int16Rep         = 2\nprimRepSizeB _      Int64Rep         = wORD64_SIZE\nprimRepSizeB _      Word8Rep         = 1\nprimRepSizeB _      Word16Rep        = 2\nprimRepSizeB _      Word64Rep        = wORD64_SIZE\nprimRepSizeB _      FloatRep         = fLOAT_SIZE\nprimRepSizeB dflags DoubleRep        = dOUBLE_SIZE dflags\nprimRepSizeB dflags AddrRep          = wORD_SIZE dflags\nprimRepSizeB dflags LiftedRep        = wORD_SIZE dflags\nprimRepSizeB dflags UnliftedRep      = wORD_SIZE dflags\nprimRepSizeB _      VoidRep          = 0\nprimRepSizeB _      (VecRep len rep) = len * primElemRepSizeB rep\n\nprimElemRepSizeB :: PrimElemRep -> Int\nprimElemRepSizeB Int8ElemRep   = 1\nprimElemRepSizeB Int16ElemRep  = 2\nprimElemRepSizeB Int32ElemRep  = 4\nprimElemRepSizeB Int64ElemRep  = 8\nprimElemRepSizeB Word8ElemRep  = 1\nprimElemRepSizeB Word16ElemRep = 2\nprimElemRepSizeB Word32ElemRep = 4\nprimElemRepSizeB Word64ElemRep = 8\nprimElemRepSizeB FloatElemRep  = 4\nprimElemRepSizeB DoubleElemRep = 8\n\n-- | Return if Rep stands for floating type,\n-- returns Nothing for vector types.\nprimRepIsFloat :: PrimRep -> Maybe Bool\nprimRepIsFloat  FloatRep     = Just True\nprimRepIsFloat  DoubleRep    = Just True\nprimRepIsFloat  (VecRep _ _) = Nothing\nprimRepIsFloat  _            = Just False\n\n\n{-\n************************************************************************\n*                                                                      *\n                             Field labels\n*                                                                      *\n************************************************************************\n-}\n\n-- | The labels for the fields of this particular 'TyCon'\ntyConFieldLabels :: TyCon -> [FieldLabel]\ntyConFieldLabels tc = dFsEnvElts $ tyConFieldLabelEnv tc\n\n-- | The labels for the fields of this particular 'TyCon'\ntyConFieldLabelEnv :: TyCon -> FieldLabelEnv\ntyConFieldLabelEnv tc\n  | isAlgTyCon tc = algTcFields tc\n  | otherwise     = emptyDFsEnv\n\n-- | Look up a field label belonging to this 'TyCon'\nlookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel\nlookupTyConFieldLabel lbl tc = lookupDFsEnv (tyConFieldLabelEnv tc) lbl\n\n-- | Make a map from strings to FieldLabels from all the data\n-- constructors of this algebraic tycon\nfieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv\nfieldsOfAlgTcRhs rhs = mkDFsEnv [ (flLabel fl, fl)\n                                | fl <- dataConsFields (visibleDataCons rhs) ]\n  where\n    -- Duplicates in this list will be removed by 'mkFsEnv'\n    dataConsFields dcs = concatMap dataConFieldLabels dcs\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{TyCon Construction}\n*                                                                      *\n************************************************************************\n\nNote: the TyCon constructors all take a Kind as one argument, even though\nthey could, in principle, work out their Kind from their other arguments.\nBut to do so they need functions from Types, and that makes a nasty\nmodule mutual-recursion.  And they aren't called from many places.\nSo we compromise, and move their Kind calculation to the call site.\n-}\n\n-- | Given the name of the function type constructor and it's kind, create the\n-- corresponding 'TyCon'. It is recommended to use 'TyCoRep.funTyCon' if you want\n-- this functionality\nmkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon\nmkFunTyCon name binders rep_nm\n  = FunTyCon {\n        tyConUnique  = nameUnique name,\n        tyConName    = name,\n        tyConBinders = binders,\n        tyConResKind = liftedTypeKind,\n        tyConKind    = mkTyConKind binders liftedTypeKind,\n        tyConArity   = length binders,\n        tcRepName    = rep_nm\n    }\n\n-- | This is the making of an algebraic 'TyCon'. Notably, you have to\n-- pass in the generic (in the -XGenerics sense) information about the\n-- type constructor - you can get hold of it easily (see Generics\n-- module)\nmkAlgTyCon :: Name\n           -> [TyConBinder]  -- ^ Binders of the 'TyCon'\n           -> Kind              -- ^ Result kind\n           -> [Role]            -- ^ The roles for each TyVar\n           -> Maybe CType       -- ^ The C type this type corresponds to\n                                --   when using the CAPI FFI\n           -> [PredType]        -- ^ Stupid theta: see 'algTcStupidTheta'\n           -> AlgTyConRhs       -- ^ Information about data constructors\n           -> AlgTyConFlav      -- ^ What flavour is it?\n                                -- (e.g. vanilla, type family)\n           -> Bool              -- ^ Was the 'TyCon' declared with GADT syntax?\n           -> TyCon\nmkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn\n  = AlgTyCon {\n        tyConName        = name,\n        tyConUnique      = nameUnique name,\n        tyConBinders     = binders,\n        tyConResKind     = res_kind,\n        tyConKind        = mkTyConKind binders res_kind,\n        tyConArity       = length binders,\n        tyConTyVars      = binderVars binders,\n        tcRoles          = roles,\n        tyConCType       = cType,\n        algTcStupidTheta = stupid,\n        algTcRhs         = rhs,\n        algTcFields      = fieldsOfAlgTcRhs rhs,\n        algTcParent      = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,\n        algTcGadtSyntax  = gadt_syn\n    }\n\n-- | Simpler specialization of 'mkAlgTyCon' for classes\nmkClassTyCon :: Name -> [TyConBinder]\n             -> [Role] -> AlgTyConRhs -> Class\n             -> Name -> TyCon\nmkClassTyCon name binders roles rhs clas tc_rep_name\n  = mkAlgTyCon name binders constraintKind roles Nothing [] rhs\n               (ClassTyCon clas tc_rep_name)\n               False\n\nmkTupleTyCon :: Name\n             -> [TyConBinder]\n             -> Kind    -- ^ Result kind of the 'TyCon'\n             -> Arity   -- ^ Arity of the tuple 'TyCon'\n             -> DataCon\n             -> TupleSort    -- ^ Whether the tuple is boxed or unboxed\n             -> AlgTyConFlav\n             -> TyCon\nmkTupleTyCon name binders res_kind arity con sort parent\n  = AlgTyCon {\n        tyConUnique      = nameUnique name,\n        tyConName        = name,\n        tyConBinders     = binders,\n        tyConTyVars      = binderVars binders,\n        tyConResKind     = res_kind,\n        tyConKind        = mkTyConKind binders res_kind,\n        tyConArity       = arity,\n        tcRoles          = replicate arity Representational,\n        tyConCType       = Nothing,\n        algTcGadtSyntax  = False,\n        algTcStupidTheta = [],\n        algTcRhs         = TupleTyCon { data_con = con,\n                                        tup_sort = sort },\n        algTcFields      = emptyDFsEnv,\n        algTcParent      = parent\n    }\n\nmkSumTyCon :: Name\n             -> [TyConBinder]\n             -> Kind    -- ^ Kind of the resulting 'TyCon'\n             -> Arity   -- ^ Arity of the sum\n             -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'\n             -> [DataCon]\n             -> AlgTyConFlav\n             -> TyCon\nmkSumTyCon name binders res_kind arity tyvars cons parent\n  = AlgTyCon {\n        tyConUnique      = nameUnique name,\n        tyConName        = name,\n        tyConBinders     = binders,\n        tyConTyVars      = tyvars,\n        tyConResKind     = res_kind,\n        tyConKind        = mkTyConKind binders res_kind,\n        tyConArity       = arity,\n        tcRoles          = replicate arity Representational,\n        tyConCType       = Nothing,\n        algTcGadtSyntax  = False,\n        algTcStupidTheta = [],\n        algTcRhs         = mkSumTyConRhs cons,\n        algTcFields      = emptyDFsEnv,\n        algTcParent      = parent\n    }\n\n-- | Makes a tycon suitable for use during type-checking. It stores\n-- a variety of details about the definition of the TyCon, but no\n-- right-hand side. It lives only during the type-checking of a\n-- mutually-recursive group of tycons; it is then zonked to a proper\n-- TyCon in zonkTcTyCon.\n-- See also Note [Kind checking recursive type and class declarations]\n-- in TcTyClsDecls.\nmkTcTyCon :: Name\n          -> [TyConBinder]\n          -> Kind                -- ^ /result/ kind only\n          -> [(Name,TcTyVar)]    -- ^ Scoped type variables;\n                                 -- see Note [How TcTyCons work] in TcTyClsDecls\n          -> Bool                -- ^ Is this TcTyCon generalised already?\n          -> TyConFlavour        -- ^ What sort of 'TyCon' this represents\n          -> TyCon\nmkTcTyCon name binders res_kind scoped_tvs poly flav\n  = TcTyCon { tyConUnique  = getUnique name\n            , tyConName    = name\n            , tyConTyVars  = binderVars binders\n            , tyConBinders = binders\n            , tyConResKind = res_kind\n            , tyConKind    = mkTyConKind binders res_kind\n            , tyConArity   = length binders\n            , tcTyConScopedTyVars = scoped_tvs\n            , tcTyConIsPoly       = poly\n            , tcTyConFlavour      = flav }\n\n-- | Create an unlifted primitive 'TyCon', such as @Int#@.\nmkPrimTyCon :: Name -> [TyConBinder]\n            -> Kind   -- ^ /result/ kind, never levity-polymorphic\n            -> [Role] -> TyCon\nmkPrimTyCon name binders res_kind roles\n  = mkPrimTyCon' name binders res_kind roles True (Just $ mkPrelTyConRepName name)\n\n-- | Kind constructors\nmkKindTyCon :: Name -> [TyConBinder]\n            -> Kind  -- ^ /result/ kind\n            -> [Role] -> Name -> TyCon\nmkKindTyCon name binders res_kind roles rep_nm\n  = tc\n  where\n    tc = mkPrimTyCon' name binders res_kind roles False (Just rep_nm)\n\n-- | Create a lifted primitive 'TyCon' such as @RealWorld@\nmkLiftedPrimTyCon :: Name -> [TyConBinder]\n                  -> Kind   -- ^ /result/ kind\n                  -> [Role] -> TyCon\nmkLiftedPrimTyCon name binders res_kind roles\n  = mkPrimTyCon' name binders res_kind roles False (Just rep_nm)\n  where rep_nm = mkPrelTyConRepName name\n\nmkPrimTyCon' :: Name -> [TyConBinder]\n             -> Kind    -- ^ /result/ kind, never levity-polymorphic\n                        -- (If you need a levity-polymorphic PrimTyCon, change\n                        --  isTcLevPoly.)\n             -> [Role]\n             -> Bool -> Maybe TyConRepName -> TyCon\nmkPrimTyCon' name binders res_kind roles is_unlifted rep_nm\n  = PrimTyCon {\n        tyConName    = name,\n        tyConUnique  = nameUnique name,\n        tyConBinders = binders,\n        tyConResKind = res_kind,\n        tyConKind    = mkTyConKind binders res_kind,\n        tyConArity   = length roles,\n        tcRoles      = roles,\n        isUnlifted   = is_unlifted,\n        primRepName  = rep_nm\n    }\n\n-- | Create a type synonym 'TyCon'\nmkSynonymTyCon :: Name -> [TyConBinder] -> Kind   -- ^ /result/ kind\n               -> [Role] -> Type -> Bool -> Bool -> TyCon\nmkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free\n  = SynonymTyCon {\n        tyConName    = name,\n        tyConUnique  = nameUnique name,\n        tyConBinders = binders,\n        tyConResKind = res_kind,\n        tyConKind    = mkTyConKind binders res_kind,\n        tyConArity   = length binders,\n        tyConTyVars  = binderVars binders,\n        tcRoles      = roles,\n        synTcRhs     = rhs,\n        synIsTau     = is_tau,\n        synIsFamFree = is_fam_free\n    }\n\n-- | Create a type family 'TyCon'\nmkFamilyTyCon :: Name -> [TyConBinder] -> Kind  -- ^ /result/ kind\n              -> Maybe Name -> FamTyConFlav\n              -> Maybe Class -> Injectivity -> TyCon\nmkFamilyTyCon name binders res_kind resVar flav parent inj\n  = FamilyTyCon\n      { tyConUnique  = nameUnique name\n      , tyConName    = name\n      , tyConBinders = binders\n      , tyConResKind = res_kind\n      , tyConKind    = mkTyConKind binders res_kind\n      , tyConArity   = length binders\n      , tyConTyVars  = binderVars binders\n      , famTcResVar  = resVar\n      , famTcFlav    = flav\n      , famTcParent  = classTyCon <$> parent\n      , famTcInj     = inj\n      }\n\n\n-- | Create a promoted data constructor 'TyCon'\n-- Somewhat dodgily, we give it the same Name\n-- as the data constructor itself; when we pretty-print\n-- the TyCon we add a quote; see the Outputable TyCon instance\nmkPromotedDataCon :: DataCon -> Name -> TyConRepName\n                  -> [TyConTyCoBinder] -> Kind -> [Role]\n                  -> RuntimeRepInfo -> TyCon\nmkPromotedDataCon con name rep_name binders res_kind roles rep_info\n  = PromotedDataCon {\n        tyConUnique   = nameUnique name,\n        tyConName     = name,\n        tyConArity    = length roles,\n        tcRoles       = roles,\n        tyConBinders  = binders,\n        tyConResKind  = res_kind,\n        tyConKind     = mkTyConKind binders res_kind,\n        dataCon       = con,\n        tcRepName     = rep_name,\n        promDcRepInfo = rep_info\n  }\n\nisFunTyCon :: TyCon -> Bool\nisFunTyCon (FunTyCon {}) = True\nisFunTyCon _             = False\n\n-- | Test if the 'TyCon' is algebraic but abstract (invisible data constructors)\nisAbstractTyCon :: TyCon -> Bool\nisAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True\nisAbstractTyCon _ = False\n\n-- | Does this 'TyCon' represent something that cannot be defined in Haskell?\nisPrimTyCon :: TyCon -> Bool\nisPrimTyCon (PrimTyCon {}) = True\nisPrimTyCon _              = False\n\n-- | Is this 'TyCon' unlifted (i.e. cannot contain bottom)? Note that this can\n-- only be true for primitive and unboxed-tuple 'TyCon's\nisUnliftedTyCon :: TyCon -> Bool\nisUnliftedTyCon (PrimTyCon  {isUnlifted = is_unlifted})\n  = is_unlifted\nisUnliftedTyCon (AlgTyCon { algTcRhs = rhs } )\n  | TupleTyCon { tup_sort = sort } <- rhs\n  = not (isBoxed (tupleSortBoxity sort))\nisUnliftedTyCon (AlgTyCon { algTcRhs = rhs } )\n  | SumTyCon {} <- rhs\n  = True\nisUnliftedTyCon _ = False\n\n-- | Returns @True@ if the supplied 'TyCon' resulted from either a\n-- @data@ or @newtype@ declaration\nisAlgTyCon :: TyCon -> Bool\nisAlgTyCon (AlgTyCon {})   = True\nisAlgTyCon _               = False\n\n-- | Returns @True@ for vanilla AlgTyCons -- that is, those created\n-- with a @data@ or @newtype@ declaration.\nisVanillaAlgTyCon :: TyCon -> Bool\nisVanillaAlgTyCon (AlgTyCon { algTcParent = VanillaAlgTyCon _ }) = True\nisVanillaAlgTyCon _                                              = False\n\nisDataTyCon :: TyCon -> Bool\n-- ^ Returns @True@ for data types that are /definitely/ represented by\n-- heap-allocated constructors.  These are scrutinised by Core-level\n-- @case@ expressions, and they get info tables allocated for them.\n--\n-- Generally, the function will be true for all @data@ types and false\n-- for @newtype@s, unboxed tuples, unboxed sums and type family\n-- 'TyCon's. But it is not guaranteed to return @True@ in all cases\n-- that it could.\n--\n-- NB: for a data type family, only the /instance/ 'TyCon's\n--     get an info table.  The family declaration 'TyCon' does not\nisDataTyCon (AlgTyCon {algTcRhs = rhs})\n  = case rhs of\n        TupleTyCon { tup_sort = sort }\n                           -> isBoxed (tupleSortBoxity sort)\n        SumTyCon {}        -> False\n        DataTyCon {}       -> True\n        NewTyCon {}        -> False\n        AbstractTyCon {}   -> False      -- We don't know, so return False\nisDataTyCon _ = False\n\n-- | 'isInjectiveTyCon' is true of 'TyCon's for which this property holds\n-- (where X is the role passed in):\n--   If (T a1 b1 c1) ~X (T a2 b2 c2), then (a1 ~X1 a2), (b1 ~X2 b2), and (c1 ~X3 c2)\n-- (where X1, X2, and X3, are the roles given by tyConRolesX tc X)\n-- See also Note [Decomposing equality] in TcCanonical\nisInjectiveTyCon :: TyCon -> Role -> Bool\nisInjectiveTyCon _                             Phantom          = False\nisInjectiveTyCon (FunTyCon {})                 _                = True\nisInjectiveTyCon (AlgTyCon {})                 Nominal          = True\nisInjectiveTyCon (AlgTyCon {algTcRhs = rhs})   Representational\n  = isGenInjAlgRhs rhs\nisInjectiveTyCon (SynonymTyCon {})             _                = False\nisInjectiveTyCon (FamilyTyCon { famTcFlav = DataFamilyTyCon _ })\n                                               Nominal          = True\nisInjectiveTyCon (FamilyTyCon { famTcInj = Injective inj }) Nominal = and inj\nisInjectiveTyCon (FamilyTyCon {})              _                = False\nisInjectiveTyCon (PrimTyCon {})                _                = True\nisInjectiveTyCon (PromotedDataCon {})          _                = True\nisInjectiveTyCon (TcTyCon {})                  _                = True\n  -- Reply True for TcTyCon to minimise knock on type errors\n  -- See Note [How TcTyCons work] item (1) in TcTyClsDecls\n\n-- | 'isGenerativeTyCon' is true of 'TyCon's for which this property holds\n-- (where X is the role passed in):\n--   If (T tys ~X t), then (t's head ~X T).\n-- See also Note [Decomposing equality] in TcCanonical\nisGenerativeTyCon :: TyCon -> Role -> Bool\nisGenerativeTyCon (FamilyTyCon { famTcFlav = DataFamilyTyCon _ }) Nominal = True\nisGenerativeTyCon (FamilyTyCon {}) _ = False\n  -- in all other cases, injectivity implies generativity\nisGenerativeTyCon tc               r = isInjectiveTyCon tc r\n\n-- | Is this an 'AlgTyConRhs' of a 'TyCon' that is generative and injective\n-- with respect to representational equality?\nisGenInjAlgRhs :: AlgTyConRhs -> Bool\nisGenInjAlgRhs (TupleTyCon {})          = True\nisGenInjAlgRhs (SumTyCon {})            = True\nisGenInjAlgRhs (DataTyCon {})           = True\nisGenInjAlgRhs (AbstractTyCon {})       = False\nisGenInjAlgRhs (NewTyCon {})            = False\n\n-- | Is this 'TyCon' that for a @newtype@\nisNewTyCon :: TyCon -> Bool\nisNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True\nisNewTyCon _                                   = False\n\n-- | Take a 'TyCon' apart into the 'TyVar's it scopes over, the 'Type' it\n-- expands into, and (possibly) a coercion from the representation type to the\n-- @newtype@.\n-- Returns @Nothing@ if this is not possible.\nunwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)\nunwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs,\n                                 algTcRhs = NewTyCon { nt_co = co,\n                                                       nt_rhs = rhs }})\n                           = Just (tvs, rhs, co)\nunwrapNewTyCon_maybe _     = Nothing\n\nunwrapNewTyConEtad_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)\nunwrapNewTyConEtad_maybe (AlgTyCon { algTcRhs = NewTyCon { nt_co = co,\n                                                           nt_etad_rhs = (tvs,rhs) }})\n                           = Just (tvs, rhs, co)\nunwrapNewTyConEtad_maybe _ = Nothing\n\nisProductTyCon :: TyCon -> Bool\n-- True of datatypes or newtypes that have\n--   one, non-existential, data constructor\n-- See Note [Product types]\nisProductTyCon tc@(AlgTyCon {})\n  = case algTcRhs tc of\n      TupleTyCon {} -> True\n      DataTyCon{ data_cons = [data_con] }\n                    -> null (dataConExTyCoVars data_con)\n      NewTyCon {}   -> True\n      _             -> False\nisProductTyCon _ = False\n\nisDataProductTyCon_maybe :: TyCon -> Maybe DataCon\n-- True of datatypes (not newtypes) with\n--   one, vanilla, data constructor\n-- See Note [Product types]\nisDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs })\n  = case rhs of\n       DataTyCon { data_cons = [con] }\n         | null (dataConExTyCoVars con)  -- non-existential\n         -> Just con\n       TupleTyCon { data_con = con }\n         -> Just con\n       _ -> Nothing\nisDataProductTyCon_maybe _ = Nothing\n\nisDataSumTyCon_maybe :: TyCon -> Maybe [DataCon]\nisDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs })\n  = case rhs of\n      DataTyCon { data_cons = cons }\n        | cons `lengthExceeds` 1\n        , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this?\n        -> Just cons\n      SumTyCon { data_cons = cons }\n        | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this?\n        -> Just cons\n      _ -> Nothing\nisDataSumTyCon_maybe _ = Nothing\n\n{- Note [Product types]\n~~~~~~~~~~~~~~~~~~~~~~~\nA product type is\n * A data type (not a newtype)\n * With one, boxed data constructor\n * That binds no existential type variables\n\nThe main point is that product types are amenable to unboxing for\n  * Strict function calls; we can transform\n        f (D a b) = e\n    to\n        fw a b = e\n    via the worker/wrapper transformation.  (Question: couldn't this\n    work for existentials too?)\n\n  * CPR for function results; we can transform\n        f x y = let ... in D a b\n    to\n        fw x y = let ... in (# a, b #)\n\nNote that the data constructor /can/ have evidence arguments: equality\nconstraints, type classes etc.  So it can be GADT.  These evidence\narguments are simply value arguments, and should not get in the way.\n-}\n\n\n-- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)?\nisTypeSynonymTyCon :: TyCon -> Bool\nisTypeSynonymTyCon (SynonymTyCon {}) = True\nisTypeSynonymTyCon _                 = False\n\nisTauTyCon :: TyCon -> Bool\nisTauTyCon (SynonymTyCon { synIsTau = is_tau }) = is_tau\nisTauTyCon _                                    = True\n\nisFamFreeTyCon :: TyCon -> Bool\nisFamFreeTyCon (SynonymTyCon { synIsFamFree = fam_free }) = fam_free\nisFamFreeTyCon (FamilyTyCon { famTcFlav = flav })         = isDataFamFlav flav\nisFamFreeTyCon _                                          = True\n\n-- As for newtypes, it is in some contexts important to distinguish between\n-- closed synonyms and synonym families, as synonym families have no unique\n-- right hand side to which a synonym family application can expand.\n--\n\n-- | True iff we can decompose (T a b c) into ((T a b) c)\n--   I.e. is it injective and generative w.r.t nominal equality?\n--   That is, if (T a b) ~N d e f, is it always the case that\n--            (T ~N d), (a ~N e) and (b ~N f)?\n-- Specifically NOT true of synonyms (open and otherwise)\n--\n-- It'd be unusual to call mustBeSaturated on a regular H98\n-- type synonym, because you should probably have expanded it first\n-- But regardless, it's not decomposable\nmustBeSaturated :: TyCon -> Bool\nmustBeSaturated = tcFlavourMustBeSaturated . tyConFlavour\n\n-- | Is this an algebraic 'TyCon' declared with the GADT syntax?\nisGadtSyntaxTyCon :: TyCon -> Bool\nisGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res\nisGadtSyntaxTyCon _                                    = False\n\n-- | Is this an algebraic 'TyCon' which is just an enumeration of values?\nisEnumerationTyCon :: TyCon -> Bool\n-- See Note [Enumeration types] in TyCon\nisEnumerationTyCon (AlgTyCon { tyConArity = arity, algTcRhs = rhs })\n  = case rhs of\n       DataTyCon { is_enum = res } -> res\n       TupleTyCon {}               -> arity == 0\n       _                           -> False\nisEnumerationTyCon _ = False\n\n-- | Is this a 'TyCon', synonym or otherwise, that defines a family?\nisFamilyTyCon :: TyCon -> Bool\nisFamilyTyCon (FamilyTyCon {}) = True\nisFamilyTyCon _                = False\n\n-- | Is this a 'TyCon', synonym or otherwise, that defines a family with\n-- instances?\nisOpenFamilyTyCon :: TyCon -> Bool\nisOpenFamilyTyCon (FamilyTyCon {famTcFlav = flav })\n  | OpenSynFamilyTyCon <- flav = True\n  | DataFamilyTyCon {} <- flav = True\nisOpenFamilyTyCon _            = False\n\n-- | Is this a synonym 'TyCon' that can have may have further instances appear?\nisTypeFamilyTyCon :: TyCon -> Bool\nisTypeFamilyTyCon (FamilyTyCon { famTcFlav = flav }) = not (isDataFamFlav flav)\nisTypeFamilyTyCon _                                  = False\n\n-- | Is this a synonym 'TyCon' that can have may have further instances appear?\nisDataFamilyTyCon :: TyCon -> Bool\nisDataFamilyTyCon (FamilyTyCon { famTcFlav = flav }) = isDataFamFlav flav\nisDataFamilyTyCon _                                  = False\n\n-- | Is this an open type family TyCon?\nisOpenTypeFamilyTyCon :: TyCon -> Bool\nisOpenTypeFamilyTyCon (FamilyTyCon {famTcFlav = OpenSynFamilyTyCon }) = True\nisOpenTypeFamilyTyCon _                                               = False\n\n-- | Is this a non-empty closed type family? Returns 'Nothing' for\n-- abstract or empty closed families.\nisClosedSynFamilyTyConWithAxiom_maybe :: TyCon -> Maybe (CoAxiom Branched)\nisClosedSynFamilyTyConWithAxiom_maybe\n  (FamilyTyCon {famTcFlav = ClosedSynFamilyTyCon mb}) = mb\nisClosedSynFamilyTyConWithAxiom_maybe _               = Nothing\n\n-- | @'tyConInjectivityInfo' tc@ returns @'Injective' is@ is @tc@ is an\n-- injective tycon (where @is@ states for which 'tyConBinders' @tc@ is\n-- injective), or 'NotInjective' otherwise.\ntyConInjectivityInfo :: TyCon -> Injectivity\ntyConInjectivityInfo tc\n  | FamilyTyCon { famTcInj = inj } <- tc\n  = inj\n  | isInjectiveTyCon tc Nominal\n  = Injective (replicate (tyConArity tc) True)\n  | otherwise\n  = NotInjective\n\nisBuiltInSynFamTyCon_maybe :: TyCon -> Maybe BuiltInSynFamily\nisBuiltInSynFamTyCon_maybe\n  (FamilyTyCon {famTcFlav = BuiltInSynFamTyCon ops }) = Just ops\nisBuiltInSynFamTyCon_maybe _                          = Nothing\n\nisDataFamFlav :: FamTyConFlav -> Bool\nisDataFamFlav (DataFamilyTyCon {}) = True   -- Data family\nisDataFamFlav _                    = False  -- Type synonym family\n\n-- | Is this TyCon for an associated type?\nisTyConAssoc :: TyCon -> Bool\nisTyConAssoc = isJust . tyConAssoc_maybe\n\n-- | Get the enclosing class TyCon (if there is one) for the given TyCon.\ntyConAssoc_maybe :: TyCon -> Maybe TyCon\ntyConAssoc_maybe = tyConFlavourAssoc_maybe . tyConFlavour\n\n-- | Get the enclosing class TyCon (if there is one) for the given TyConFlavour\ntyConFlavourAssoc_maybe :: TyConFlavour -> Maybe TyCon\ntyConFlavourAssoc_maybe (DataFamilyFlavour mb_parent)     = mb_parent\ntyConFlavourAssoc_maybe (OpenTypeFamilyFlavour mb_parent) = mb_parent\ntyConFlavourAssoc_maybe _                                 = Nothing\n\n-- The unit tycon didn't used to be classed as a tuple tycon\n-- but I thought that was silly so I've undone it\n-- If it can't be for some reason, it should be a AlgTyCon\nisTupleTyCon :: TyCon -> Bool\n-- ^ Does this 'TyCon' represent a tuple?\n--\n-- NB: when compiling @Data.Tuple@, the tycons won't reply @True@ to\n-- 'isTupleTyCon', because they are built as 'AlgTyCons'.  However they\n-- get spat into the interface file as tuple tycons, so I don't think\n-- it matters.\nisTupleTyCon (AlgTyCon { algTcRhs = TupleTyCon {} }) = True\nisTupleTyCon _ = False\n\ntyConTuple_maybe :: TyCon -> Maybe TupleSort\ntyConTuple_maybe (AlgTyCon { algTcRhs = rhs })\n  | TupleTyCon { tup_sort = sort} <- rhs = Just sort\ntyConTuple_maybe _                       = Nothing\n\n-- | Is this the 'TyCon' for an unboxed tuple?\nisUnboxedTupleTyCon :: TyCon -> Bool\nisUnboxedTupleTyCon (AlgTyCon { algTcRhs = rhs })\n  | TupleTyCon { tup_sort = sort } <- rhs\n  = not (isBoxed (tupleSortBoxity sort))\nisUnboxedTupleTyCon _ = False\n\n-- | Is this the 'TyCon' for a boxed tuple?\nisBoxedTupleTyCon :: TyCon -> Bool\nisBoxedTupleTyCon (AlgTyCon { algTcRhs = rhs })\n  | TupleTyCon { tup_sort = sort } <- rhs\n  = isBoxed (tupleSortBoxity sort)\nisBoxedTupleTyCon _ = False\n\n-- | Is this the 'TyCon' for an unboxed sum?\nisUnboxedSumTyCon :: TyCon -> Bool\nisUnboxedSumTyCon (AlgTyCon { algTcRhs = rhs })\n  | SumTyCon {} <- rhs\n  = True\nisUnboxedSumTyCon _ = False\n\n-- | Is this the 'TyCon' for a /promoted/ tuple?\nisPromotedTupleTyCon :: TyCon -> Bool\nisPromotedTupleTyCon tyCon\n  | Just dataCon <- isPromotedDataCon_maybe tyCon\n  , isTupleTyCon (dataConTyCon dataCon) = True\n  | otherwise                           = False\n\n-- | Is this a PromotedDataCon?\nisPromotedDataCon :: TyCon -> Bool\nisPromotedDataCon (PromotedDataCon {}) = True\nisPromotedDataCon _                    = False\n\n-- | Retrieves the promoted DataCon if this is a PromotedDataCon;\nisPromotedDataCon_maybe :: TyCon -> Maybe DataCon\nisPromotedDataCon_maybe (PromotedDataCon { dataCon = dc }) = Just dc\nisPromotedDataCon_maybe _ = Nothing\n\n-- | Is this tycon really meant for use at the kind level? That is,\n-- should it be permitted without -XDataKinds?\nisKindTyCon :: TyCon -> Bool\nisKindTyCon tc = getUnique tc `elementOfUniqSet` kindTyConKeys\n\n-- | These TyCons should be allowed at the kind level, even without\n-- -XDataKinds.\nkindTyConKeys :: UniqSet Unique\nkindTyConKeys = unionManyUniqSets\n  ( mkUniqSet [ liftedTypeKindTyConKey, constraintKindTyConKey, tYPETyConKey ]\n  : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon\n                                          , vecCountTyCon, vecElemTyCon ] )\n  where\n    tycon_with_datacons tc = getUnique tc : map getUnique (tyConDataCons tc)\n\nisLiftedTypeKindTyConName :: Name -> Bool\nisLiftedTypeKindTyConName = (`hasKey` liftedTypeKindTyConKey)\n\n-- | Identifies implicit tycons that, in particular, do not go into interface\n-- files (because they are implicitly reconstructed when the interface is\n-- read).\n--\n-- Note that:\n--\n-- * Associated families are implicit, as they are re-constructed from\n--   the class declaration in which they reside, and\n--\n-- * Family instances are /not/ implicit as they represent the instance body\n--   (similar to a @dfun@ does that for a class instance).\n--\n-- * Tuples are implicit iff they have a wired-in name\n--   (namely: boxed and unboxed tupeles are wired-in and implicit,\n--            but constraint tuples are not)\nisImplicitTyCon :: TyCon -> Bool\nisImplicitTyCon (FunTyCon {})        = True\nisImplicitTyCon (PrimTyCon {})       = True\nisImplicitTyCon (PromotedDataCon {}) = True\nisImplicitTyCon (AlgTyCon { algTcRhs = rhs, tyConName = name })\n  | TupleTyCon {} <- rhs             = isWiredInName name\n  | SumTyCon {} <- rhs               = True\n  | otherwise                        = False\nisImplicitTyCon (FamilyTyCon { famTcParent = parent }) = isJust parent\nisImplicitTyCon (SynonymTyCon {})    = False\nisImplicitTyCon (TcTyCon {})         = False\n\ntyConCType_maybe :: TyCon -> Maybe CType\ntyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc\ntyConCType_maybe _ = Nothing\n\n-- | Is this a TcTyCon? (That is, one only used during type-checking?)\nisTcTyCon :: TyCon -> Bool\nisTcTyCon (TcTyCon {}) = True\nisTcTyCon _            = False\n\nsetTcTyConKind :: TyCon -> Kind -> TyCon\n-- Update the Kind of a TcTyCon\n-- The new kind is always a zonked version of its previous\n-- kind, so we don't need to update any other fields.\n-- See Note [The Purely Kinded Invariant] in TcHsType\nsetTcTyConKind tc@(TcTyCon {}) kind = tc { tyConKind = kind }\nsetTcTyConKind tc              _    = pprPanic \"setTcTyConKind\" (ppr tc)\n\n-- | Could this TyCon ever be levity-polymorphic when fully applied?\n-- True is safe. False means we're sure. Does only a quick check\n-- based on the TyCon's category.\n-- Precondition: The fully-applied TyCon has kind (TYPE blah)\nisTcLevPoly :: TyCon -> Bool\nisTcLevPoly FunTyCon{}           = False\nisTcLevPoly (AlgTyCon { algTcParent = UnboxedAlgTyCon _ }) = True\nisTcLevPoly AlgTyCon{}           = False\nisTcLevPoly SynonymTyCon{}       = True\nisTcLevPoly FamilyTyCon{}        = True\nisTcLevPoly PrimTyCon{}          = False\nisTcLevPoly TcTyCon{}            = False\nisTcLevPoly tc@PromotedDataCon{} = pprPanic \"isTcLevPoly datacon\" (ppr tc)\n\n{-\n-----------------------------------------------\n--      Expand type-constructor applications\n-----------------------------------------------\n-}\n\nexpandSynTyCon_maybe\n        :: TyCon\n        -> [tyco]                 -- ^ Arguments to 'TyCon'\n        -> Maybe ([(TyVar,tyco)],\n                  Type,\n                  [tyco])         -- ^ Returns a 'TyVar' substitution, the body\n                                  -- type of the synonym (not yet substituted)\n                                  -- and any arguments remaining from the\n                                  -- application\n\n-- ^ Expand a type synonym application, if any\nexpandSynTyCon_maybe tc tys\n  | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc\n  = case tys `listLengthCmp` arity of\n        GT -> Just (tvs `zip` tys, rhs, drop arity tys)\n        EQ -> Just (tvs `zip` tys, rhs, [])\n        LT -> Nothing\n   | otherwise\n   = Nothing\n\n----------------\n\n-- | Check if the tycon actually refers to a proper `data` or `newtype`\n--  with user defined constructors rather than one from a class or other\n--  construction.\n\n-- NB: This is only used in TcRnExports.checkPatSynParent to determine if an\n-- exported tycon can have a pattern synonym bundled with it, e.g.,\n-- module Foo (TyCon(.., PatSyn)) where\nisTyConWithSrcDataCons :: TyCon -> Bool\nisTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) =\n  case rhs of\n    DataTyCon {}  -> isSrcParent\n    NewTyCon {}   -> isSrcParent\n    TupleTyCon {} -> isSrcParent\n    _ -> False\n  where\n    isSrcParent = isNoParent parent\nisTyConWithSrcDataCons (FamilyTyCon { famTcFlav = DataFamilyTyCon {} })\n                         = True -- #14058\nisTyConWithSrcDataCons _ = False\n\n\n-- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no\n-- constructors could be found\ntyConDataCons :: TyCon -> [DataCon]\n-- It's convenient for tyConDataCons to return the\n-- empty list for type synonyms etc\ntyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []\n\n-- | Determine the 'DataCon's originating from the given 'TyCon', if the 'TyCon'\n-- is the sort that can have any constructors (note: this does not include\n-- abstract algebraic types)\ntyConDataCons_maybe :: TyCon -> Maybe [DataCon]\ntyConDataCons_maybe (AlgTyCon {algTcRhs = rhs})\n  = case rhs of\n       DataTyCon { data_cons = cons } -> Just cons\n       NewTyCon { data_con = con }    -> Just [con]\n       TupleTyCon { data_con = con }  -> Just [con]\n       SumTyCon { data_cons = cons }  -> Just cons\n       _                              -> Nothing\ntyConDataCons_maybe _ = Nothing\n\n-- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@\n-- type with one alternative, a tuple type or a @newtype@ then that constructor\n-- is returned. If the 'TyCon' has more than one constructor, or represents a\n-- primitive or function type constructor then @Nothing@ is returned. In any\n-- other case, the function panics\ntyConSingleDataCon_maybe :: TyCon -> Maybe DataCon\ntyConSingleDataCon_maybe (AlgTyCon { algTcRhs = rhs })\n  = case rhs of\n      DataTyCon { data_cons = [c] } -> Just c\n      TupleTyCon { data_con = c }   -> Just c\n      NewTyCon { data_con = c }     -> Just c\n      _                             -> Nothing\ntyConSingleDataCon_maybe _           = Nothing\n\ntyConSingleDataCon :: TyCon -> DataCon\ntyConSingleDataCon tc\n  = case tyConSingleDataCon_maybe tc of\n      Just c  -> c\n      Nothing -> pprPanic \"tyConDataCon\" (ppr tc)\n\ntyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon\n-- Returns (Just con) for single-constructor\n-- *algebraic* data types *not* newtypes\ntyConSingleAlgDataCon_maybe (AlgTyCon { algTcRhs = rhs })\n  = case rhs of\n      DataTyCon { data_cons = [c] } -> Just c\n      TupleTyCon { data_con = c }   -> Just c\n      _                             -> Nothing\ntyConSingleAlgDataCon_maybe _        = Nothing\n\n-- | Determine the number of value constructors a 'TyCon' has. Panics if the\n-- 'TyCon' is not algebraic or a tuple\ntyConFamilySize  :: TyCon -> Int\ntyConFamilySize tc@(AlgTyCon { algTcRhs = rhs })\n  = case rhs of\n      DataTyCon { data_cons_size = size } -> size\n      NewTyCon {}                    -> 1\n      TupleTyCon {}                  -> 1\n      SumTyCon { data_cons_size = size }  -> size\n      _                              -> pprPanic \"tyConFamilySize 1\" (ppr tc)\ntyConFamilySize tc = pprPanic \"tyConFamilySize 2\" (ppr tc)\n\n-- | Extract an 'AlgTyConRhs' with information about data constructors from an\n-- algebraic or tuple 'TyCon'. Panics for any other sort of 'TyCon'\nalgTyConRhs :: TyCon -> AlgTyConRhs\nalgTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs\nalgTyConRhs other = pprPanic \"algTyConRhs\" (ppr other)\n\n-- | Extract type variable naming the result of injective type family\ntyConFamilyResVar_maybe :: TyCon -> Maybe Name\ntyConFamilyResVar_maybe (FamilyTyCon {famTcResVar = res}) = res\ntyConFamilyResVar_maybe _                                 = Nothing\n\n-- | Get the list of roles for the type parameters of a TyCon\ntyConRoles :: TyCon -> [Role]\n-- See also Note [TyCon Role signatures]\ntyConRoles tc\n  = case tc of\n    { FunTyCon {}                         -> [Nominal, Nominal, Representational, Representational]\n    ; AlgTyCon { tcRoles = roles }        -> roles\n    ; SynonymTyCon { tcRoles = roles }    -> roles\n    ; FamilyTyCon {}                      -> const_role Nominal\n    ; PrimTyCon { tcRoles = roles }       -> roles\n    ; PromotedDataCon { tcRoles = roles } -> roles\n    ; TcTyCon {}                          -> const_role Nominal\n    }\n  where\n    const_role r = replicate (tyConArity tc) r\n\n-- | Extract the bound type variables and type expansion of a type synonym\n-- 'TyCon'. Panics if the 'TyCon' is not a synonym\nnewTyConRhs :: TyCon -> ([TyVar], Type)\nnewTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }})\n    = (tvs, rhs)\nnewTyConRhs tycon = pprPanic \"newTyConRhs\" (ppr tycon)\n\n-- | The number of type parameters that need to be passed to a newtype to\n-- resolve it. May be less than in the definition if it can be eta-contracted.\nnewTyConEtadArity :: TyCon -> Int\nnewTyConEtadArity (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }})\n        = length (fst tvs_rhs)\nnewTyConEtadArity tycon = pprPanic \"newTyConEtadArity\" (ppr tycon)\n\n-- | Extract the bound type variables and type expansion of an eta-contracted\n-- type synonym 'TyCon'.  Panics if the 'TyCon' is not a synonym\nnewTyConEtadRhs :: TyCon -> ([TyVar], Type)\nnewTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs\nnewTyConEtadRhs tycon = pprPanic \"newTyConEtadRhs\" (ppr tycon)\n\n-- | Extracts the @newtype@ coercion from such a 'TyCon', which can be used to\n-- construct something with the @newtype@s type from its representation type\n-- (right hand side). If the supplied 'TyCon' is not a @newtype@, returns\n-- @Nothing@\nnewTyConCo_maybe :: TyCon -> Maybe (CoAxiom Unbranched)\nnewTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = Just co\nnewTyConCo_maybe _                                               = Nothing\n\nnewTyConCo :: TyCon -> CoAxiom Unbranched\nnewTyConCo tc = case newTyConCo_maybe tc of\n                 Just co -> co\n                 Nothing -> pprPanic \"newTyConCo\" (ppr tc)\n\nnewTyConDataCon_maybe :: TyCon -> Maybe DataCon\nnewTyConDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }}) = Just con\nnewTyConDataCon_maybe _ = Nothing\n\n-- | Find the \\\"stupid theta\\\" of the 'TyCon'. A \\\"stupid theta\\\" is the context\n-- to the left of an algebraic type declaration, e.g. @Eq a@ in the declaration\n-- @data Eq a => T a ...@\ntyConStupidTheta :: TyCon -> [PredType]\ntyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid\ntyConStupidTheta (FunTyCon {}) = []\ntyConStupidTheta tycon = pprPanic \"tyConStupidTheta\" (ppr tycon)\n\n-- | Extract the 'TyVar's bound by a vanilla type synonym\n-- and the corresponding (unsubstituted) right hand side.\nsynTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Type)\nsynTyConDefn_maybe (SynonymTyCon {tyConTyVars = tyvars, synTcRhs = ty})\n  = Just (tyvars, ty)\nsynTyConDefn_maybe _ = Nothing\n\n-- | Extract the information pertaining to the right hand side of a type synonym\n-- (@type@) declaration.\nsynTyConRhs_maybe :: TyCon -> Maybe Type\nsynTyConRhs_maybe (SynonymTyCon {synTcRhs = rhs}) = Just rhs\nsynTyConRhs_maybe _                               = Nothing\n\n-- | Extract the flavour of a type family (with all the extra information that\n-- it carries)\nfamTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav\nfamTyConFlav_maybe (FamilyTyCon {famTcFlav = flav}) = Just flav\nfamTyConFlav_maybe _                                = Nothing\n\n-- | Is this 'TyCon' that for a class instance?\nisClassTyCon :: TyCon -> Bool\nisClassTyCon (AlgTyCon {algTcParent = ClassTyCon {}}) = True\nisClassTyCon _                                        = False\n\n-- | If this 'TyCon' is that for a class instance, return the class it is for.\n-- Otherwise returns @Nothing@\ntyConClass_maybe :: TyCon -> Maybe Class\ntyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas _}) = Just clas\ntyConClass_maybe _                                            = Nothing\n\n-- | Return the associated types of the 'TyCon', if any\ntyConATs :: TyCon -> [TyCon]\ntyConATs (AlgTyCon {algTcParent = ClassTyCon clas _}) = classATs clas\ntyConATs _                                            = []\n\n----------------------------------------------------------------------------\n-- | Is this 'TyCon' that for a data family instance?\nisFamInstTyCon :: TyCon -> Bool\nisFamInstTyCon (AlgTyCon {algTcParent = DataFamInstTyCon {} })\n  = True\nisFamInstTyCon _ = False\n\ntyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)\ntyConFamInstSig_maybe (AlgTyCon {algTcParent = DataFamInstTyCon ax f ts })\n  = Just (f, ts, ax)\ntyConFamInstSig_maybe _ = Nothing\n\n-- | If this 'TyCon' is that of a data family instance, return the family in question\n-- and the instance types. Otherwise, return @Nothing@\ntyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])\ntyConFamInst_maybe (AlgTyCon {algTcParent = DataFamInstTyCon _ f ts })\n  = Just (f, ts)\ntyConFamInst_maybe _ = Nothing\n\n-- | If this 'TyCon' is that of a data family instance, return a 'TyCon' which\n-- represents a coercion identifying the representation type with the type\n-- instance family.  Otherwise, return @Nothing@\ntyConFamilyCoercion_maybe :: TyCon -> Maybe (CoAxiom Unbranched)\ntyConFamilyCoercion_maybe (AlgTyCon {algTcParent = DataFamInstTyCon ax _ _ })\n  = Just ax\ntyConFamilyCoercion_maybe _ = Nothing\n\n-- | Extract any 'RuntimeRepInfo' from this TyCon\ntyConRuntimeRepInfo :: TyCon -> RuntimeRepInfo\ntyConRuntimeRepInfo (PromotedDataCon { promDcRepInfo = rri }) = rri\ntyConRuntimeRepInfo _                                         = NoRRI\n  -- could panic in that second case. But Douglas Adams told me not to.\n\n{-\nNote [Constructor tag allocation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen typechecking we need to allocate constructor tags to constructors.\nThey are allocated based on the position in the data_cons field of TyCon,\nwith the first constructor getting fIRST_TAG.\n\nWe used to pay linear cost per constructor, with each constructor looking up\nits relative index in the constructor list. That was quadratic and prohibitive\nfor large data types with more than 10k constructors.\n\nThe current strategy is to build a NameEnv with a mapping from costructor's\nName to ConTag and pass it down to buildDataCon for efficient lookup.\n\nRelevant ticket: #14657\n-}\n\nmkTyConTagMap :: TyCon -> NameEnv ConTag\nmkTyConTagMap tycon =\n  mkNameEnv $ map getName (tyConDataCons tycon) `zip` [fIRST_TAG..]\n  -- See Note [Constructor tag allocation]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[TyCon-instances]{Instance declarations for @TyCon@}\n*                                                                      *\n************************************************************************\n\n@TyCon@s are compared by comparing their @Unique@s.\n-}\n\ninstance Eq TyCon where\n    a == b = getUnique a == getUnique b\n    a /= b = getUnique a /= getUnique b\n\ninstance Uniquable TyCon where\n    getUnique tc = tyConUnique tc\n\ninstance Outputable TyCon where\n  -- At the moment a promoted TyCon has the same Name as its\n  -- corresponding TyCon, so we add the quote to distinguish it here\n  ppr tc = pprPromotionQuote tc <> ppr (tyConName tc) <> pp_tc\n    where\n      pp_tc = getPprStyle $ \\sty -> if ((debugStyle sty || dumpStyle sty) && isTcTyCon tc)\n                                    then text \"[tc]\"\n                                    else empty\n\n-- | Paints a picture of what a 'TyCon' represents, in broad strokes.\n-- This is used towards more informative error messages.\ndata TyConFlavour\n  = ClassFlavour\n  | TupleFlavour Boxity\n  | SumFlavour\n  | DataTypeFlavour\n  | NewtypeFlavour\n  | AbstractTypeFlavour\n  | DataFamilyFlavour (Maybe TyCon)     -- Just tc <=> (tc == associated class)\n  | OpenTypeFamilyFlavour (Maybe TyCon) -- Just tc <=> (tc == associated class)\n  | ClosedTypeFamilyFlavour\n  | TypeSynonymFlavour\n  | BuiltInTypeFlavour -- ^ e.g., the @(->)@ 'TyCon'.\n  | PromotedDataConFlavour\n  deriving Eq\n\ninstance Outputable TyConFlavour where\n  ppr = text . go\n    where\n      go ClassFlavour = \"class\"\n      go (TupleFlavour boxed) | isBoxed boxed = \"tuple\"\n                              | otherwise     = \"unboxed tuple\"\n      go SumFlavour              = \"unboxed sum\"\n      go DataTypeFlavour         = \"data type\"\n      go NewtypeFlavour          = \"newtype\"\n      go AbstractTypeFlavour     = \"abstract type\"\n      go (DataFamilyFlavour (Just _))  = \"associated data family\"\n      go (DataFamilyFlavour Nothing)   = \"data family\"\n      go (OpenTypeFamilyFlavour (Just _)) = \"associated type family\"\n      go (OpenTypeFamilyFlavour Nothing)  = \"type family\"\n      go ClosedTypeFamilyFlavour = \"type family\"\n      go TypeSynonymFlavour      = \"type synonym\"\n      go BuiltInTypeFlavour      = \"built-in type\"\n      go PromotedDataConFlavour  = \"promoted data constructor\"\n\ntyConFlavour :: TyCon -> TyConFlavour\ntyConFlavour (AlgTyCon { algTcParent = parent, algTcRhs = rhs })\n  | ClassTyCon _ _ <- parent = ClassFlavour\n  | otherwise = case rhs of\n                  TupleTyCon { tup_sort = sort }\n                                     -> TupleFlavour (tupleSortBoxity sort)\n                  SumTyCon {}        -> SumFlavour\n                  DataTyCon {}       -> DataTypeFlavour\n                  NewTyCon {}        -> NewtypeFlavour\n                  AbstractTyCon {}   -> AbstractTypeFlavour\ntyConFlavour (FamilyTyCon { famTcFlav = flav, famTcParent = parent })\n  = case flav of\n      DataFamilyTyCon{}            -> DataFamilyFlavour parent\n      OpenSynFamilyTyCon           -> OpenTypeFamilyFlavour parent\n      ClosedSynFamilyTyCon{}       -> ClosedTypeFamilyFlavour\n      AbstractClosedSynFamilyTyCon -> ClosedTypeFamilyFlavour\n      BuiltInSynFamTyCon{}         -> ClosedTypeFamilyFlavour\ntyConFlavour (SynonymTyCon {})    = TypeSynonymFlavour\ntyConFlavour (FunTyCon {})        = BuiltInTypeFlavour\ntyConFlavour (PrimTyCon {})       = BuiltInTypeFlavour\ntyConFlavour (PromotedDataCon {}) = PromotedDataConFlavour\ntyConFlavour (TcTyCon { tcTyConFlavour = flav }) = flav\n\n-- | Can this flavour of 'TyCon' appear unsaturated?\ntcFlavourMustBeSaturated :: TyConFlavour -> Bool\ntcFlavourMustBeSaturated ClassFlavour            = False\ntcFlavourMustBeSaturated DataTypeFlavour         = False\ntcFlavourMustBeSaturated NewtypeFlavour          = False\ntcFlavourMustBeSaturated DataFamilyFlavour{}     = False\ntcFlavourMustBeSaturated TupleFlavour{}          = False\ntcFlavourMustBeSaturated SumFlavour              = False\ntcFlavourMustBeSaturated AbstractTypeFlavour     = False\ntcFlavourMustBeSaturated BuiltInTypeFlavour      = False\ntcFlavourMustBeSaturated PromotedDataConFlavour  = False\ntcFlavourMustBeSaturated TypeSynonymFlavour      = True\ntcFlavourMustBeSaturated OpenTypeFamilyFlavour{} = True\ntcFlavourMustBeSaturated ClosedTypeFamilyFlavour = True\n\n-- | Is this flavour of 'TyCon' an open type family or a data family?\ntcFlavourIsOpen :: TyConFlavour -> Bool\ntcFlavourIsOpen DataFamilyFlavour{}     = True\ntcFlavourIsOpen OpenTypeFamilyFlavour{} = True\ntcFlavourIsOpen ClosedTypeFamilyFlavour = False\ntcFlavourIsOpen ClassFlavour            = False\ntcFlavourIsOpen DataTypeFlavour         = False\ntcFlavourIsOpen NewtypeFlavour          = False\ntcFlavourIsOpen TupleFlavour{}          = False\ntcFlavourIsOpen SumFlavour              = False\ntcFlavourIsOpen AbstractTypeFlavour     = False\ntcFlavourIsOpen BuiltInTypeFlavour      = False\ntcFlavourIsOpen PromotedDataConFlavour  = False\ntcFlavourIsOpen TypeSynonymFlavour      = False\n\npprPromotionQuote :: TyCon -> SDoc\n-- Promoted data constructors already have a tick in their OccName\npprPromotionQuote tc\n  = case tc of\n      PromotedDataCon {} -> char '\\'' -- Always quote promoted DataCons in types\n      _                  -> empty\n\ninstance NamedThing TyCon where\n    getName = tyConName\n\ninstance Data.Data TyCon where\n    -- don't traverse?\n    toConstr _   = abstractConstr \"TyCon\"\n    gunfold _ _  = error \"gunfold\"\n    dataTypeOf _ = mkNoRepType \"TyCon\"\n\ninstance Binary Injectivity where\n    put_ bh NotInjective   = putByte bh 0\n    put_ bh (Injective xs) = putByte bh 1 >> put_ bh xs\n\n    get bh = do { h <- getByte bh\n                ; case h of\n                    0 -> return NotInjective\n                    _ -> do { xs <- get bh\n                            ; return (Injective xs) } }\n\n{-\n************************************************************************\n*                                                                      *\n           Walking over recursive TyCons\n*                                                                      *\n************************************************************************\n\nNote [Expanding newtypes and products]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen expanding a type to expose a data-type constructor, we need to be\ncareful about newtypes, lest we fall into an infinite loop. Here are\nthe key examples:\n\n  newtype Id  x = MkId x\n  newtype Fix f = MkFix (f (Fix f))\n  newtype T     = MkT (T -> T)\n\n  Type           Expansion\n --------------------------\n  T              T -> T\n  Fix Maybe      Maybe (Fix Maybe)\n  Id (Id Int)    Int\n  Fix Id         NO NO NO\n\nNotice that\n * We can expand T, even though it's recursive.\n * We can expand Id (Id Int), even though the Id shows up\n   twice at the outer level, because Id is non-recursive\n\nSo, when expanding, we keep track of when we've seen a recursive\nnewtype at outermost level; and bail out if we see it again.\n\nWe sometimes want to do the same for product types, so that the\nstrictness analyser doesn't unbox infinitely deeply.\n\nMore precisely, we keep a *count* of how many times we've seen it.\nThis is to account for\n   data instance T (a,b) = MkT (T a) (T b)\nThen (Trac #10482) if we have a type like\n        T (Int,(Int,(Int,(Int,Int))))\nwe can still unbox deeply enough during strictness analysis.\nWe have to treat T as potentially recursive, but it's still\ngood to be able to unwrap multiple layers.\n\nThe function that manages all this is checkRecTc.\n-}\n\ndata RecTcChecker = RC !Int (NameEnv Int)\n  -- The upper bound, and the number of times\n  -- we have encountered each TyCon\n\n-- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'.\ninitRecTc :: RecTcChecker\ninitRecTc = RC defaultRecTcMaxBound emptyNameEnv\n\n-- | The default upper bound (100) for the number of times a 'RecTcChecker' is\n-- allowed to encounter each 'TyCon'.\ndefaultRecTcMaxBound :: Int\ndefaultRecTcMaxBound = 100\n-- Should we have a flag for this?\n\n-- | Change the upper bound for the number of times a 'RecTcChecker' is allowed\n-- to encounter each 'TyCon'.\nsetRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker\nsetRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts\n\ncheckRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker\n-- Nothing      => Recursion detected\n-- Just rec_tcs => Keep going\ncheckRecTc (RC bound rec_nts) tc\n  = case lookupNameEnv rec_nts tc_name of\n      Just n | n >= bound -> Nothing\n             | otherwise  -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1)))\n      Nothing             -> Just (RC bound (extendNameEnv rec_nts tc_name 1))\n  where\n    tc_name = tyConName tc\n\n-- | Returns whether or not this 'TyCon' is definite, or a hole\n-- that may be filled in at some later point.  See Note [Skolem abstract data]\ntyConSkolem :: TyCon -> Bool\ntyConSkolem = isHoleName . tyConName\n\n-- Note [Skolem abstract data]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Skolem abstract data arises from data declarations in an hsig file.\n--\n-- The best analogy is to interpret the types declared in signature files as\n-- elaborating to universally quantified type variables; e.g.,\n--\n--    unit p where\n--        signature H where\n--            data T\n--            data S\n--        module M where\n--            import H\n--            f :: (T ~ S) => a -> b\n--            f x = x\n--\n-- elaborates as (with some fake structural types):\n--\n--    p :: forall t s. { f :: forall a b. t ~ s => a -> b }\n--    p = { f = \\x -> x } -- ill-typed\n--\n-- It is clear that inside p, t ~ s is not provable (and\n-- if we tried to write a function to cast t to s, that\n-- would not work), but if we call p @Int @Int, clearly Int ~ Int\n-- is provable.  The skolem variables are all distinct from\n-- one another, but we can't make assumptions like \"f is\n-- inaccessible\", because the skolem variables will get\n-- instantiated eventually!\n--\n-- Skolem abstractness can apply to \"non-abstract\" data as well):\n--\n--    unit p where\n--        signature H1 where\n--            data T = MkT\n--        signature H2 where\n--            data T = MkT\n--        module M where\n--            import qualified H1\n--            import qualified H2\n--            f :: (H1.T ~ H2.T) => a -> b\n--            f x = x\n--\n-- This is why the test is on the original name of the TyCon,\n-- not whether it is abstract or not.\n", "num_lines": 2733}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1998\n\\section[TyCoRep]{Type and Coercion - friends' interface}\n\nNote [The Type-related module hierarchy]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n  Class\n  CoAxiom\n  TyCon    imports Class, CoAxiom\n  TyCoRep  imports Class, CoAxiom, TyCon\n  TysPrim  imports TyCoRep ( including mkTyConTy )\n  Kind     imports TysPrim ( mainly for primitive kinds )\n  Type     imports Kind\n  Coercion imports Type\n-}\n\n-- We expose the relevant stuff from this module via the Type module\n{-# OPTIONS_HADDOCK not-home #-}\n{-# LANGUAGE CPP, DeriveDataTypeable, MultiWayIf, PatternSynonyms, BangPatterns #-}\n\nmodule TyCoRep (\n        TyThing(..), tyThingCategory, pprTyThingCategory, pprShortTyThing,\n\n        -- * Types\n        Type( TyVarTy, AppTy, TyConApp, ForAllTy\n            , LitTy, CastTy, CoercionTy\n            , FunTy, ft_arg, ft_res, ft_af\n            ),  -- Export the type synonym FunTy too\n\n        TyLit(..),\n        KindOrType, Kind,\n        KnotTied,\n        PredType, ThetaType,      -- Synonyms\n        ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),\n\n        -- * Coercions\n        Coercion(..),\n        UnivCoProvenance(..),\n        CoercionHole(..), coHoleCoVar, setCoHoleCoVar,\n        CoercionN, CoercionR, CoercionP, KindCoercion,\n        MCoercion(..), MCoercionR, MCoercionN,\n\n        -- * Functions over types\n        mkTyConTy, mkTyVarTy, mkTyVarTys,\n        mkTyCoVarTy, mkTyCoVarTys,\n        mkFunTy, mkVisFunTy, mkInvisFunTy, mkVisFunTys, mkInvisFunTys,\n        mkForAllTy, mkForAllTys,\n        mkPiTy, mkPiTys,\n\n        kindRep_maybe, kindRep,\n        isLiftedTypeKind, isUnliftedTypeKind,\n        isLiftedRuntimeRep, isUnliftedRuntimeRep,\n        isRuntimeRepTy, isRuntimeRepVar,\n        sameVis,\n\n        -- * Functions over binders\n        TyCoBinder(..), TyCoVarBinder, TyBinder,\n        binderVar, binderVars, binderType, binderArgFlag,\n        delBinderVar,\n        isInvisibleArgFlag, isVisibleArgFlag,\n        isInvisibleBinder, isVisibleBinder,\n        isTyBinder, isNamedBinder,\n\n        -- * Functions over coercions\n        pickLR,\n\n        -- * Pretty-printing\n        pprType, pprParendType, pprPrecType, pprPrecTypeX,\n        pprTypeApp, pprTCvBndr, pprTCvBndrs,\n        pprSigmaType,\n        pprTheta, pprParendTheta, pprForAll, pprUserForAll,\n        pprTyVar, pprTyVars,\n        pprThetaArrowTy, pprClassPred,\n        pprKind, pprParendKind, pprTyLit,\n        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,\n        pprDataCons, pprWithExplicitKindsWhen,\n\n        pprCo, pprParendCo,\n\n        debugPprType,\n\n        -- * Free variables\n        tyCoVarsOfType, tyCoVarsOfTypeDSet, tyCoVarsOfTypes, tyCoVarsOfTypesDSet,\n        tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,\n        tyCoFVsOfType, tyCoVarsOfTypeList,\n        tyCoFVsOfTypes, tyCoVarsOfTypesList,\n        coVarsOfType, coVarsOfTypes,\n        coVarsOfCo, coVarsOfCos,\n        tyCoVarsOfCo, tyCoVarsOfCos,\n        tyCoVarsOfCoDSet,\n        tyCoFVsOfCo, tyCoFVsOfCos,\n        tyCoVarsOfCoList, tyCoVarsOfProv,\n        almostDevoidCoVarOfCo,\n        injectiveVarsOfType, tyConAppNeedsKindSig,\n\n        noFreeVarsOfType, noFreeVarsOfCo,\n\n        -- * Substitutions\n        TCvSubst(..), TvSubstEnv, CvSubstEnv,\n        emptyTvSubstEnv, emptyCvSubstEnv, composeTCvSubstEnv, composeTCvSubst,\n        emptyTCvSubst, mkEmptyTCvSubst, isEmptyTCvSubst,\n        mkTCvSubst, mkTvSubst, mkCvSubst,\n        getTvSubstEnv,\n        getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs,\n        isInScope, notElemTCvSubst,\n        setTvSubstEnv, setCvSubstEnv, zapTCvSubst,\n        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,\n        extendTCvSubst, extendTCvSubstWithClone,\n        extendCvSubst, extendCvSubstWithClone,\n        extendTvSubst, extendTvSubstBinderAndInScope, extendTvSubstWithClone,\n        extendTvSubstList, extendTvSubstAndInScope,\n        extendTCvSubstList,\n        unionTCvSubst, zipTyEnv, zipCoEnv, mkTyCoInScopeSet,\n        zipTvSubst, zipCvSubst,\n        zipTCvSubst,\n        mkTvSubstPrs,\n\n        substTyWith, substTyWithCoVars, substTysWith, substTysWithCoVars,\n        substCoWith,\n        substTy, substTyAddInScope,\n        substTyUnchecked, substTysUnchecked, substThetaUnchecked,\n        substTyWithUnchecked,\n        substCoUnchecked, substCoWithUnchecked,\n        substTyWithInScope,\n        substTys, substTheta,\n        lookupTyVar,\n        substCo, substCos, substCoVar, substCoVars, lookupCoVar,\n        cloneTyVarBndr, cloneTyVarBndrs,\n        substVarBndr, substVarBndrs,\n        substTyVarBndr, substTyVarBndrs,\n        substCoVarBndr,\n        substTyVar, substTyVars, substTyCoVars,\n        substForAllCoBndr,\n        substVarBndrUsing, substForAllCoBndrUsing,\n        checkValidSubst, isValidTCvSubst,\n\n        -- * Tidying type related things up for printing\n        tidyType,      tidyTypes,\n        tidyOpenType,  tidyOpenTypes,\n        tidyOpenKind,\n        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars, avoidNameClashes,\n        tidyOpenTyCoVar, tidyOpenTyCoVars,\n        tidyTyCoVarOcc,\n        tidyTopType,\n        tidyKind,\n        tidyCo, tidyCos,\n        tidyTyCoVarBinder, tidyTyCoVarBinders,\n\n        -- * Sizes\n        typeSize, coercionSize, provSize\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} DataCon( dataConFullSig\n                             , dataConUserTyVarBinders\n                             , DataCon )\nimport {-# SOURCE #-} Type( isCoercionTy, mkAppTy, mkCastTy\n                          , tyCoVarsOfTypeWellScoped\n                          , tyCoVarsOfTypesWellScoped\n                          , scopedSort\n                          , coreView )\n   -- Transitively pulls in a LOT of stuff, better to break the loop\n\nimport {-# SOURCE #-} Coercion\nimport {-# SOURCE #-} ConLike ( ConLike(..), conLikeName )\nimport {-# SOURCE #-} ToIface( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr\n                             , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )\n\n-- friends:\nimport IfaceType\nimport Var\nimport VarEnv\nimport VarSet\nimport Name hiding ( varName )\nimport TyCon\nimport Class\nimport CoAxiom\nimport FV\n\n-- others\nimport BasicTypes ( LeftOrRight(..), PprPrec(..), topPrec, sigPrec, opPrec\n                  , funPrec, appPrec, maybeParen, pickLR )\nimport PrelNames\nimport Outputable\nimport DynFlags\nimport FastString\nimport Pair\nimport UniqSupply\nimport Util\nimport UniqFM\nimport UniqSet\n\n-- libraries\nimport qualified Data.Data as Data hiding ( TyCon )\nimport Data.List\nimport Data.IORef ( IORef )   -- for CoercionHole\n\n{-\n%************************************************************************\n%*                                                                      *\n                        TyThing\n%*                                                                      *\n%************************************************************************\n\nDespite the fact that DataCon has to be imported via a hi-boot route,\nthis module seems the right place for TyThing, because it's needed for\nfunTyCon and all the types in TysPrim.\n\nIt is also SOURCE-imported into Name.hs\n\n\nNote [ATyCon for classes]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nBoth classes and type constructors are represented in the type environment\nas ATyCon.  You can tell the difference, and get to the class, with\n   isClassTyCon :: TyCon -> Bool\n   tyConClass_maybe :: TyCon -> Maybe Class\nThe Class and its associated TyCon have the same Name.\n-}\n\n-- | A global typecheckable-thing, essentially anything that has a name.\n-- Not to be confused with a 'TcTyThing', which is also a typecheckable\n-- thing but in the *local* context.  See 'TcEnv' for how to retrieve\n-- a 'TyThing' given a 'Name'.\ndata TyThing\n  = AnId     Id\n  | AConLike ConLike\n  | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]\n  | ACoAxiom (CoAxiom Branched)\n\ninstance Outputable TyThing where\n  ppr = pprShortTyThing\n\ninstance NamedThing TyThing where       -- Can't put this with the type\n  getName (AnId id)     = getName id    -- decl, because the DataCon instance\n  getName (ATyCon tc)   = getName tc    -- isn't visible there\n  getName (ACoAxiom cc) = getName cc\n  getName (AConLike cl) = conLikeName cl\n\npprShortTyThing :: TyThing -> SDoc\n-- c.f. PprTyThing.pprTyThing, which prints all the details\npprShortTyThing thing\n  = pprTyThingCategory thing <+> quotes (ppr (getName thing))\n\npprTyThingCategory :: TyThing -> SDoc\npprTyThingCategory = text . capitalise . tyThingCategory\n\ntyThingCategory :: TyThing -> String\ntyThingCategory (ATyCon tc)\n  | isClassTyCon tc = \"class\"\n  | otherwise       = \"type constructor\"\ntyThingCategory (ACoAxiom _) = \"coercion axiom\"\ntyThingCategory (AnId   _)   = \"identifier\"\ntyThingCategory (AConLike (RealDataCon _)) = \"data constructor\"\ntyThingCategory (AConLike (PatSynCon _))  = \"pattern synonym\"\n\n\n{- **********************************************************************\n*                                                                       *\n                        Type\n*                                                                       *\n********************************************************************** -}\n\n-- | The key representation of types within the compiler\n\ntype KindOrType = Type -- See Note [Arguments to type constructors]\n\n-- | The key type representing kinds in the compiler.\ntype Kind = Type\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata Type\n  -- See Note [Non-trivial definitional equality]\n  = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)\n\n  | AppTy\n        Type\n        Type            -- ^ Type application to something other than a 'TyCon'. Parameters:\n                        --\n                        --  1) Function: must /not/ be a 'TyConApp' or 'CastTy',\n                        --     must be another 'AppTy', or 'TyVarTy'\n                        --     See Note [Respecting definitional equality] (EQ1) about the\n                        --     no 'CastTy' requirement\n                        --\n                        --  2) Argument type\n\n  | TyConApp\n        TyCon\n        [KindOrType]    -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.\n                        -- Invariant: saturated applications of 'FunTyCon' must\n                        -- use 'FunTy' and saturated synonyms must use their own\n                        -- constructors. However, /unsaturated/ 'FunTyCon's\n                        -- do appear as 'TyConApp's.\n                        -- Parameters:\n                        --\n                        -- 1) Type constructor being applied to.\n                        --\n                        -- 2) Type arguments. Might not have enough type arguments\n                        --    here to saturate the constructor.\n                        --    Even type synonyms are not necessarily saturated;\n                        --    for example unsaturated type synonyms\n                        --    can appear as the right hand side of a type synonym.\n\n  | ForAllTy\n        {-# UNPACK #-} !TyCoVarBinder\n        Type            -- ^ A \u00ce\u00a0 type.\n\n  | FunTy      -- ^ t1 -> t2   Very common, so an important special case\n                -- See Note [Function types]\n     { ft_af  :: AnonArgFlag  -- Is this (->) or (=>)?\n     , ft_arg :: Type           -- Argument type\n     , ft_res :: Type }         -- Result type\n\n  | LitTy TyLit     -- ^ Type literals are similar to type constructors.\n\n  | CastTy\n        Type\n        KindCoercion  -- ^ A kind cast. The coercion is always nominal.\n                      -- INVARIANT: The cast is never refl.\n                      -- INVARIANT: The Type is not a CastTy (use TransCo instead)\n                      -- See Note [Respecting definitional equality] (EQ2) and (EQ3)\n\n  | CoercionTy\n        Coercion    -- ^ Injection of a Coercion into a type\n                    -- This should only ever be used in the RHS of an AppTy,\n                    -- in the list of a TyConApp, when applying a promoted\n                    -- GADT data constructor\n\n  deriving Data.Data\n\n-- NOTE:  Other parts of the code assume that type literals do not contain\n-- types or type variables.\ndata TyLit\n  = NumTyLit Integer\n  | StrTyLit FastString\n  deriving (Eq, Ord, Data.Data)\n\n\n{- Note [Function types]\n~~~~~~~~~~~~~~~~~~~~~~~~\nFFunTy is the constructor for a function type.  Lots of things to say\nabout it!\n\n* FFunTy is the data constructor, meaning \"full function type\".\n\n* The function type constructor (->) has kind\n     (->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> Type LiftedRep\n  mkTyConApp ensure that we convert a saturated application\n    TyConApp (->) [r1,r2,t1,t2] into FunTy t1 t2\n  dropping the 'r1' and 'r2' arguments; they are easily recovered\n  from 't1' and 't2'.\n\n* The ft_af field says whether or not this is an invisible argument\n     VisArg:   t1 -> t2    Ordinary function type\n     InvisArg: t1 => t2    t1 is guaranteed to be a predicate type,\n                           i.e. t1 :: Constraint\n  See Note [Types for coercions, predicates, and evidence]\n\n  This visibility info makes no difference in Core; it matters\n  only when we regard the type as a Haskell source type.\n\n* FunTy is a (unidirectional) pattern synonym that allows\n  positional pattern matching (FunTy arg res), ignoring the\n  ArgFlag.\n-}\n\n{- -----------------------\n      Commented out until the pattern match\n      checker can handle it; see Trac #16185\n\n      For now we use the CPP macro #define FunTy FFunTy _\n      (see HsVersions.h) to allow pattern matching on a\n      (positional) FunTy constructor.\n\n{-# COMPLETE FunTy, TyVarTy, AppTy, TyConApp\n           , ForAllTy, LitTy, CastTy, CoercionTy :: Type #-}\n\n-- | 'FunTy' is a (uni-directional) pattern synonym for the common\n-- case where we want to match on the argument/result type, but\n-- ignoring the AnonArgFlag\npattern FunTy :: Type -> Type -> Type\npattern FunTy arg res <- FFunTy { ft_arg = arg, ft_res = res }\n\n       End of commented out block\n---------------------------------- -}\n\n{- Note [Types for coercions, predicates, and evidence]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe treat differently:\n\n  (a) Predicate types\n        Test: isPredTy\n        Binders: DictIds\n        Kind: Constraint\n        Examples: (Eq a), and (a ~ b)\n\n  (b) Coercion types are primitive, unboxed equalities\n        Test: isCoVarTy\n        Binders: CoVars (can appear in coercions)\n        Kind: TYPE (TupleRep [])\n        Examples: (t1 ~# t2) or (t1 ~R# t2)\n\n  (c) Evidence types is the type of evidence manipulated by\n      the type constraint solver.\n        Test: isEvVarType\n        Binders: EvVars\n        Kind: Constraint or TYPE (TupleRep [])\n        Examples: all coercion types and predicate types\n\nCoercion types and predicate types are mutually exclusive,\nbut evidence types are a superset of both.\n\nWhen treated as a user type,\n\n  - Predicates (of kind Constraint) are invisible and are\n    implicitly instantiated\n\n  - Coercion types, and non-pred evidence types (i.e. not\n    of kind Constrain), are just regular old types, are\n    visible, and are not implicitly instantiated.\n\nIn a FunTy { ft_af = InvisArg }, the argument type is always\na Predicate type.\n\nNote [Constraints in kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDo we allow a type constructor to have a kind like\n   S :: Eq a => a -> Type\n\nNo, we do not.  Doing so would mean would need a TyConApp like\n   S @k @(d :: Eq k) (ty :: k)\n and we have no way to build, or decompose, evidence like\n (d :: Eq k) at the type level.\n\nBut we admit one exception: equality.  We /do/ allow, say,\n   MkT :: (a ~ b) => a -> b -> Type a b\n\nWhy?  Because we can, without much difficulty.  Moreover\nwe can promote a GADT data constructor (see TyCon\nNote [Promoted data constructors]), like\n  data GT a b where\n    MkGT : a -> a -> GT a a\nso programmers might reasonably expect to be able to\npromote MkT as well.\n\nHow does this work?\n\n* In TcValidity.checkConstraintsOK we reject kinds that\n  have constraints other than (a~b) and (a~~b).\n\n* In Inst.tcInstInvisibleTyBinder we instantiate a call\n  of MkT by emitting\n     [W] co :: alpha ~# beta\n  and producing the elaborated term\n     MkT @alpha @beta (Eq# alpha beta co)\n  We don't generate a boxed \"Wanted\"; we generate only a\n  regular old /unboxed/ primitive-equality Wanted, and build\n  the box on the spot.\n\n* How can we get such a MkT?  By promoting a GADT-style data\n  constructor\n     data T a b where\n       MkT :: (a~b) => a -> b -> T a b\n  See DataCon.mkPromotedDataCon\n  and Note [Promoted data constructors] in TyCon\n\n* We support both homogeneous (~) and heterogeneous (~~)\n  equality.  (See Note [The equality types story]\n  in TysPrim for a primer on these equality types.)\n\n* How do we prevent a MkT having an illegal constraint like\n  Eq a?  We check for this at use-sites; see TcHsType.tcTyVar,\n  specifically dc_theta_illegal_constraint.\n\n* Notice that nothing special happens if\n    K :: (a ~# b) => blah\n  because (a ~# b) is not a predicate type, and is never\n  implicitly instantiated. (Mind you, it's not clear how you\n  could creates a type constructor with such a kind.) See\n  Note [Types for coercions, predicates, and evidence]\n\n* The existence of promoted MkT with an equality-constraint\n  argument is the (only) reason that the AnonTCB constructor\n  of TyConBndrVis carries an AnonArgFlag (VisArg/InvisArg).\n  For example, when we promote the data constructor\n     MkT :: forall a b. (a~b) => a -> b -> T a b\n  we get a PromotedDataCon with tyConBinders\n      Bndr (a :: Type)  (NamedTCB Inferred)\n      Bndr (b :: Type)  (NamedTCB Inferred)\n      Bndr (_ :: a ~ b) (AnonTCB InvisArg)\n      Bndr (_ :: a)     (AnonTCB VisArg))\n      Bndr (_ :: b)     (AnonTCB VisArg))\n\n* One might reasonably wonder who *unpacks* these boxes once they are\n  made. After all, there is no type-level `case` construct. The\n  surprising answer is that no one ever does. Instead, if a GADT\n  constructor is used on the left-hand side of a type family equation,\n  that occurrence forces GHC to unify the types in question. For\n  example:\n\n  data G a where\n    MkG :: G Bool\n\n  type family F (x :: G a) :: a where\n    F MkG = False\n\n  When checking the LHS `F MkG`, GHC sees the MkG constructor and then must\n  unify F's implicit parameter `a` with Bool. This succeeds, making the equation\n\n    F Bool (MkG @Bool <Bool>) = False\n\n  Note that we never need unpack the coercion. This is because type\n  family equations are *not* parametric in their kind variables. That\n  is, we could have just said\n\n  type family H (x :: G a) :: a where\n    H _ = False\n\n  The presence of False on the RHS also forces `a` to become Bool,\n  giving us\n\n    H Bool _ = False\n\n  The fact that any of this works stems from the lack of phase\n  separation between types and kinds (unlike the very present phase\n  separation between terms and types).\n\n  Once we have the ability to pattern-match on types below top-level,\n  this will no longer cut it, but it seems fine for now.\n\n\nNote [Arguments to type constructors]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBecause of kind polymorphism, in addition to type application we now\nhave kind instantiation. We reuse the same notations to do so.\n\nFor example:\n\n  Just (* -> *) Maybe\n  Right * Nat Zero\n\nare represented by:\n\n  TyConApp (PromotedDataCon Just) [* -> *, Maybe]\n  TyConApp (PromotedDataCon Right) [*, Nat, (PromotedDataCon Zero)]\n\nImportant note: Nat is used as a *kind* and not as a type. This can be\nconfusing, since type-level Nat and kind-level Nat are identical. We\nuse the kind of (PromotedDataCon Right) to know if its arguments are\nkinds or types.\n\nThis kind instantiation only happens in TyConApp currently.\n\nNote [Non-trivial definitional equality]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIs Int |> <*> the same as Int? YES! In order to reduce headaches,\nwe decide that any reflexive casts in types are just ignored.\n(Indeed they must be. See Note [Respecting definitional equality].)\nMore generally, the `eqType` function, which defines Core's type equality\nrelation, ignores casts and coercion arguments, as long as the\ntwo types have the same kind. This allows us to be a little sloppier\nin keeping track of coercions, which is a good thing. It also means\nthat eqType does not depend on eqCoercion, which is also a good thing.\n\nWhy is this sensible? That is, why is something different than \u00ce\u00b1-equivalence\nappropriate for the implementation of eqType?\n\nAnything smaller than ~ and homogeneous is an appropriate definition for\nequality. The type safety of FC depends only on ~. Let's say \u00ce\u00b7 : \u00cf\u201e ~ \u00cf\u0192. Any\nexpression of type \u00cf\u201e can be transmuted to one of type \u00cf\u0192 at any point by\ncasting. The same is true of expressions of type \u00cf\u0192. So in some sense, \u00cf\u201e and \u00cf\u0192\nare interchangeable.\n\nBut let's be more precise. If we examine the typing rules of FC (say, those in\nhttps://cs.brynmawr.edu/~rae/papers/2015/equalities/equalities.pdf)\nthere are several places where the same metavariable is used in two different\npremises to a rule. (For example, see Ty_App.) There is an implicit equality\ncheck here. What definition of equality should we use? By convention, we use\n\u00ce\u00b1-equivalence. Take any rule with one (or more) of these implicit equality\nchecks. Then there is an admissible rule that uses ~ instead of the implicit\ncheck, adding in casts as appropriate.\n\nThe only problem here is that ~ is heterogeneous. To make the kinds work out\nin the admissible rule that uses ~, it is necessary to homogenize the\ncoercions. That is, if we have \u00ce\u00b7 : (\u00cf\u201e : \u00ce\u00ba1) ~ (\u00cf\u0192 : \u00ce\u00ba2), then we don't use \u00ce\u00b7;\nwe use \u00ce\u00b7 |> kind \u00ce\u00b7, which is homogeneous.\n\nThe effect of this all is that eqType, the implementation of the implicit\nequality check, can use any homogeneous relation that is smaller than ~, as\nthose rules must also be admissible.\n\nA more drawn out argument around all of this is presented in Section 7.2 of\nRichard E's thesis (http://cs.brynmawr.edu/~rae/papers/2016/thesis/eisenberg-thesis.pdf).\n\nWhat would go wrong if we insisted on the casts matching? See the beginning of\nSection 8 in the unpublished paper above. Theoretically, nothing at all goes\nwrong. But in practical terms, getting the coercions right proved to be\nnightmarish. And types would explode: during kind-checking, we often produce\nreflexive kind coercions. When we try to cast by these, mkCastTy just discards\nthem. But if we used an eqType that distinguished between Int and Int |> <*>,\nthen we couldn't discard -- the output of kind-checking would be enormous,\nand we would need enormous casts with lots of CoherenceCo's to straighten\nthem out.\n\nWould anything go wrong if eqType respected type families? No, not at all. But\nthat makes eqType rather hard to implement.\n\nThus, the guideline for eqType is that it should be the largest\neasy-to-implement relation that is still smaller than ~ and homogeneous. The\nprecise choice of relation is somewhat incidental, as long as the smart\nconstructors and destructors in Type respect whatever relation is chosen.\n\nAnother helpful principle with eqType is this:\n\n (EQ) If (t1 `eqType` t2) then I can replace t1 by t2 anywhere.\n\nThis principle also tells us that eqType must relate only types with the\nsame kinds.\n\nNote [Respecting definitional equality]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nNote [Non-trivial definitional equality] introduces the property (EQ).\nHow is this upheld?\n\nAny function that pattern matches on all the constructors will have to\nconsider the possibility of CastTy. Presumably, those functions will handle\nCastTy appropriately and we'll be OK.\n\nMore dangerous are the splitXXX functions. Let's focus on splitTyConApp.\nWe don't want it to fail on (T a b c |> co). Happily, if we have\n  (T a b c |> co) `eqType` (T d e f)\nthen co must be reflexive. Why? eqType checks that the kinds are equal, as\nwell as checking that (a `eqType` d), (b `eqType` e), and (c `eqType` f).\nBy the kind check, we know that (T a b c |> co) and (T d e f) have the same\nkind. So the only way that co could be non-reflexive is for (T a b c) to have\na different kind than (T d e f). But because T's kind is closed (all tycon kinds\nare closed), the only way for this to happen is that one of the arguments has\nto differ, leading to a contradiction. Thus, co is reflexive.\n\nAccordingly, by eliminating reflexive casts, splitTyConApp need not worry\nabout outermost casts to uphold (EQ). Eliminating reflexive casts is done\nin mkCastTy.\n\nUnforunately, that's not the end of the story. Consider comparing\n  (T a b c)      =?       (T a b |> (co -> <Type>)) (c |> co)\nThese two types have the same kind (Type), but the left type is a TyConApp\nwhile the right type is not. To handle this case, we say that the right-hand\ntype is ill-formed, requiring an AppTy never to have a casted TyConApp\non its left. It is easy enough to pull around the coercions to maintain\nthis invariant, as done in Type.mkAppTy. In the example above, trying to\nform the right-hand type will instead yield (T a b (c |> co |> sym co) |> <Type>).\nBoth the casts there are reflexive and will be dropped. Huzzah.\n\nThis idea of pulling coercions to the right works for splitAppTy as well.\n\nHowever, there is one hiccup: it's possible that a coercion doesn't relate two\nPi-types. For example, if we have @type family Fun a b where Fun a b = a -> b@,\nthen we might have (T :: Fun Type Type) and (T |> axFun) Int. That axFun can't\nbe pulled to the right. But we don't need to pull it: (T |> axFun) Int is not\n`eqType` to any proper TyConApp -- thus, leaving it where it is doesn't violate\nour (EQ) property.\n\nLastly, in order to detect reflexive casts reliably, we must make sure not\nto have nested casts: we update (t |> co1 |> co2) to (t |> (co1 `TransCo` co2)).\n\nIn sum, in order to uphold (EQ), we need the following three invariants:\n\n  (EQ1) No decomposable CastTy to the left of an AppTy, where a decomposable\n        cast is one that relates either a FunTy to a FunTy or a\n        ForAllTy to a ForAllTy.\n  (EQ2) No reflexive casts in CastTy.\n  (EQ3) No nested CastTys.\n  (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body).\n        See Note [Weird typing rule for ForAllTy] in Type.\n\nThese invariants are all documented above, in the declaration for Type.\n\nNote [Unused coercion variable in ForAllTy]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n  \\(co:t1 ~ t2). e\n\nWhat type should we give to this expression?\n  (1) forall (co:t1 ~ t2) -> t\n  (2) (t1 ~ t2) -> t\n\nIf co is used in t, (1) should be the right choice.\nif co is not used in t, we would like to have (1) and (2) equivalent.\n\nHowever, we want to keep eqType simple and don't want eqType (1) (2) to return\nTrue in any case.\n\nWe decide to always construct (2) if co is not used in t.\n\nThus in mkLamType, we check whether the variable is a coercion\nvariable (of type (t1 ~# t2), and whether it is un-used in the\nbody. If so, it returns a FunTy instead of a ForAllTy.\n\nThere are cases we want to skip the check. For example, the check is\nunnecessary when it is known from the context that the input variable\nis a type variable.  In those cases, we use mkForAllTy.\n\n-}\n\n-- | A type labeled 'KnotTied' might have knot-tied tycons in it. See\n-- Note [Type checking recursive type and class declarations] in\n-- TcTyClsDecls\ntype KnotTied ty = ty\n\n{- **********************************************************************\n*                                                                       *\n                  TyCoBinder and ArgFlag\n*                                                                       *\n********************************************************************** -}\n\n-- | A 'TyCoBinder' represents an argument to a function. TyCoBinders can be\n-- dependent ('Named') or nondependent ('Anon'). They may also be visible or\n-- not. See Note [TyCoBinders]\ndata TyCoBinder\n  = Named TyCoVarBinder    -- A type-lambda binder\n  | Anon AnonArgFlag Type  -- A term-lambda binder. Type here can be CoercionTy.\n                           -- Visibility is determined by the AnonArgFlag\n  deriving Data.Data\n\n-- | 'TyBinder' is like 'TyCoBinder', but there can only be 'TyVarBinder'\n-- in the 'Named' field.\ntype TyBinder = TyCoBinder\n\n-- | Remove the binder's variable from the set, if the binder has\n-- a variable.\ndelBinderVar :: VarSet -> TyCoVarBinder -> VarSet\ndelBinderVar vars (Bndr tv _) = vars `delVarSet` tv\n\n-- | Does this binder bind an invisible argument?\nisInvisibleBinder :: TyCoBinder -> Bool\nisInvisibleBinder (Named (Bndr _ vis)) = isInvisibleArgFlag vis\nisInvisibleBinder (Anon InvisArg _)    = True\nisInvisibleBinder (Anon VisArg   _)    = False\n\n-- | Does this binder bind a visible argument?\nisVisibleBinder :: TyCoBinder -> Bool\nisVisibleBinder = not . isInvisibleBinder\n\nisNamedBinder :: TyCoBinder -> Bool\nisNamedBinder (Named {}) = True\nisNamedBinder (Anon {})  = False\n\n-- | If its a named binder, is the binder a tyvar?\n-- Returns True for nondependent binder.\n-- This check that we're really returning a *Ty*Binder (as opposed to a\n-- coercion binder). That way, if/when we allow coercion quantification\n-- in more places, we'll know we missed updating some function.\nisTyBinder :: TyCoBinder -> Bool\nisTyBinder (Named bnd) = isTyVarBinder bnd\nisTyBinder _ = True\n\n{- Note [TyCoBinders]\n~~~~~~~~~~~~~~~~~~~\nA ForAllTy contains a TyCoVarBinder.  But a type can be decomposed\nto a telescope consisting of a [TyCoBinder]\n\nA TyCoBinder represents the type of binders -- that is, the type of an\nargument to a Pi-type. GHC Core currently supports two different\nPi-types:\n\n * A non-dependent function type,\n   written with ->, e.g. ty1 -> ty2\n   represented as FunTy ty1 ty2. These are\n   lifted to Coercions with the corresponding FunCo.\n\n * A dependent compile-time-only polytype,\n   written with forall, e.g.  forall (a:*). ty\n   represented as ForAllTy (Bndr a v) ty\n\nBoth Pi-types classify terms/types that take an argument. In other\nwords, if `x` is either a function or a polytype, `x arg` makes sense\n(for an appropriate `arg`).\n\n\nNote [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* A ForAllTy (used for both types and kinds) contains a TyCoVarBinder.\n  Each TyCoVarBinder\n      Bndr a tvis\n  is equipped with tvis::ArgFlag, which says whether or not arguments\n  for this binder should be visible (explicit) in source Haskell.\n\n* A TyCon contains a list of TyConBinders.  Each TyConBinder\n      Bndr a cvis\n  is equipped with cvis::TyConBndrVis, which says whether or not type\n  and kind arguments for this TyCon should be visible (explicit) in\n  source Haskell.\n\nThis table summarises the visibility rules:\n---------------------------------------------------------------------------------------\n|                                                      Occurrences look like this\n|                             GHC displays type as     in Haskell source code\n|--------------------------------------------------------------------------------------\n| Bndr a tvis :: TyCoVarBinder, in the binder of ForAllTy for a term\n|  tvis :: ArgFlag\n|  tvis = Inferred:            f :: forall {a}. type    Arg not allowed:  f\n                               f :: forall {co}. type   Arg not allowed:  f\n|  tvis = Specified:           f :: forall a. type      Arg optional:     f  or  f @Int\n|  tvis = Required:            T :: forall k -> type    Arg required:     T *\n|    This last form is illegal in terms: See Note [No Required TyCoBinder in terms]\n|\n| Bndr k cvis :: TyConBinder, in the TyConBinders of a TyCon\n|  cvis :: TyConBndrVis\n|  cvis = AnonTCB:             T :: kind -> kind        Required:            T *\n|  cvis = NamedTCB Inferred:   T :: forall {k}. kind    Arg not allowed:     T\n|                              T :: forall {co}. kind   Arg not allowed:     T\n|  cvis = NamedTCB Specified:  T :: forall k. kind      Arg not allowed[1]:  T\n|  cvis = NamedTCB Required:   T :: forall k -> kind    Required:            T *\n---------------------------------------------------------------------------------------\n\n[1] In types, in the Specified case, it would make sense to allow\n    optional kind applications, thus (T @*), but we have not\n    yet implemented that\n\n---- In term declarations ----\n\n* Inferred.  Function defn, with no signature:  f1 x = x\n  We infer f1 :: forall {a}. a -> a, with 'a' Inferred\n  It's Inferred because it doesn't appear in any\n  user-written signature for f1\n\n* Specified.  Function defn, with signature (implicit forall):\n     f2 :: a -> a; f2 x = x\n  So f2 gets the type f2 :: forall a. a -> a, with 'a' Specified\n  even though 'a' is not bound in the source code by an explicit forall\n\n* Specified.  Function defn, with signature (explicit forall):\n     f3 :: forall a. a -> a; f3 x = x\n  So f3 gets the type f3 :: forall a. a -> a, with 'a' Specified\n\n* Inferred/Specified.  Function signature with inferred kind polymorphism.\n     f4 :: a b -> Int\n  So 'f4' gets the type f4 :: forall {k} (a:k->*) (b:k). a b -> Int\n  Here 'k' is Inferred (it's not mentioned in the type),\n  but 'a' and 'b' are Specified.\n\n* Specified.  Function signature with explicit kind polymorphism\n     f5 :: a (b :: k) -> Int\n  This time 'k' is Specified, because it is mentioned explicitly,\n  so we get f5 :: forall (k:*) (a:k->*) (b:k). a b -> Int\n\n* Similarly pattern synonyms:\n  Inferred - from inferred types (e.g. no pattern type signature)\n           - or from inferred kind polymorphism\n\n---- In type declarations ----\n\n* Inferred (k)\n     data T1 a b = MkT1 (a b)\n  Here T1's kind is  T1 :: forall {k:*}. (k->*) -> k -> *\n  The kind variable 'k' is Inferred, since it is not mentioned\n\n  Note that 'a' and 'b' correspond to /Anon/ TyCoBinders in T1's kind,\n  and Anon binders don't have a visibility flag. (Or you could think\n  of Anon having an implicit Required flag.)\n\n* Specified (k)\n     data T2 (a::k->*) b = MkT (a b)\n  Here T's kind is  T :: forall (k:*). (k->*) -> k -> *\n  The kind variable 'k' is Specified, since it is mentioned in\n  the signature.\n\n* Required (k)\n     data T k (a::k->*) b = MkT (a b)\n  Here T's kind is  T :: forall k:* -> (k->*) -> k -> *\n  The kind is Required, since it bound in a positional way in T's declaration\n  Every use of T must be explicitly applied to a kind\n\n* Inferred (k1), Specified (k)\n     data T a b (c :: k) = MkT (a b) (Proxy c)\n  Here T's kind is  T :: forall {k1:*} (k:*). (k1->*) -> k1 -> k -> *\n  So 'k' is Specified, because it appears explicitly,\n  but 'k1' is Inferred, because it does not\n\nGenerally, in the list of TyConBinders for a TyCon,\n\n* Inferred arguments always come first\n* Specified, Anon and Required can be mixed\n\ne.g.\n  data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where ...\n\nHere Foo's TyConBinders are\n   [Required 'a', Specified 'b', Anon]\nand its kind prints as\n   Foo :: forall a -> forall b. (a -> b -> Type) -> Type\n\nSee also Note [Required, Specified, and Inferred for types] in TcTyClsDecls\n\n---- Printing -----\n\n We print forall types with enough syntax to tell you their visibility\n flag.  But this is not source Haskell, and these types may not all\n be parsable.\n\n Specified: a list of Specified binders is written between `forall` and `.`:\n               const :: forall a b. a -> b -> a\n\n Inferred:  with -fprint-explicit-foralls, Inferred binders are written\n            in braces:\n               f :: forall {k} (a:k). S k a -> Int\n            Otherwise, they are printed like Specified binders.\n\n Required: binders are put between `forall` and `->`:\n              T :: forall k -> *\n\n---- Other points -----\n\n* In classic Haskell, all named binders (that is, the type variables in\n  a polymorphic function type f :: forall a. a -> a) have been Inferred.\n\n* Inferred variables correspond to \"generalized\" variables from the\n  Visible Type Applications paper (ESOP'16).\n\nNote [No Required TyCoBinder in terms]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe don't allow Required foralls for term variables, including pattern\nsynonyms and data constructors.  Why?  Because then an application\nwould need a /compulsory/ type argument (possibly without an \"@\"?),\nthus (f Int); and we don't have concrete syntax for that.\n\nWe could change this decision, but Required, Named TyCoBinders are rare\nanyway.  (Most are Anons.)\n\nHowever the type of a term can (just about) have a required quantifier;\nsee Note [Required quantifiers in the type of a term] in TcExpr.\n-}\n\n\n{- **********************************************************************\n*                                                                       *\n                        PredType\n*                                                                       *\n********************************************************************** -}\n\n\n-- | A type of the form @p@ of kind @Constraint@ represents a value whose type is\n-- the Haskell predicate @p@, where a predicate is what occurs before\n-- the @=>@ in a Haskell type.\n--\n-- We use 'PredType' as documentation to mark those types that we guarantee to have\n-- this kind.\n--\n-- It can be expanded into its representation, but:\n--\n-- * The type checker must treat it as opaque\n--\n-- * The rest of the compiler treats it as transparent\n--\n-- Consider these examples:\n--\n-- > f :: (Eq a) => a -> Int\n-- > g :: (?x :: Int -> Int) => a -> Int\n-- > h :: (r\\l) => {r} => {l::Int | r}\n--\n-- Here the @Eq a@ and @?x :: Int -> Int@ and @r\\l@ are all called \\\"predicates\\\"\ntype PredType = Type\n\n-- | A collection of 'PredType's\ntype ThetaType = [PredType]\n\n{-\n(We don't support TREX records yet, but the setup is designed\nto expand to allow them.)\n\nA Haskell qualified type, such as that for f,g,h above, is\nrepresented using\n        * a FunTy for the double arrow\n        * with a type of kind Constraint as the function argument\n\nThe predicate really does turn into a real extra argument to the\nfunction.  If the argument has type (p :: Constraint) then the predicate p is\nrepresented by evidence of type p.\n\n\n%************************************************************************\n%*                                                                      *\n            Simple constructors\n%*                                                                      *\n%************************************************************************\n\nThese functions are here so that they can be used by TysPrim,\nwhich in turn is imported by Type\n-}\n\nmkTyVarTy  :: TyVar   -> Type\nmkTyVarTy v = ASSERT2( isTyVar v, ppr v <+> dcolon <+> ppr (tyVarKind v) )\n              TyVarTy v\n\nmkTyVarTys :: [TyVar] -> [Type]\nmkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy\n\nmkTyCoVarTy :: TyCoVar -> Type\nmkTyCoVarTy v\n  | isTyVar v\n  = TyVarTy v\n  | otherwise\n  = CoercionTy (CoVarCo v)\n\nmkTyCoVarTys :: [TyCoVar] -> [Type]\nmkTyCoVarTys = map mkTyCoVarTy\n\ninfixr 3 `mkFunTy`, `mkVisFunTy`, `mkInvisFunTy`      -- Associates to the right\n\nmkFunTy :: AnonArgFlag -> Type -> Type -> Type\nmkFunTy af arg res = FunTy { ft_af = af, ft_arg = arg, ft_res = res }\n\nmkVisFunTy, mkInvisFunTy :: Type -> Type -> Type\nmkVisFunTy   = mkFunTy VisArg\nmkInvisFunTy = mkFunTy InvisArg\n\n-- | Make nested arrow types\nmkVisFunTys, mkInvisFunTys :: [Type] -> Type -> Type\nmkVisFunTys   tys ty = foldr mkVisFunTy   ty tys\nmkInvisFunTys tys ty = foldr mkInvisFunTy ty tys\n\n-- | Like 'mkTyCoForAllTy', but does not check the occurrence of the binder\n-- See Note [Unused coercion variable in ForAllTy]\nmkForAllTy :: TyCoVar -> ArgFlag -> Type -> Type\nmkForAllTy tv vis ty = ForAllTy (Bndr tv vis) ty\n\n-- | Wraps foralls over the type using the provided 'TyCoVar's from left to right\nmkForAllTys :: [TyCoVarBinder] -> Type -> Type\nmkForAllTys tyvars ty = foldr ForAllTy ty tyvars\n\nmkPiTy:: TyCoBinder -> Type -> Type\nmkPiTy (Anon af ty1) ty2        = FunTy { ft_af = af, ft_arg = ty1, ft_res = ty2 }\nmkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty\n\nmkPiTys :: [TyCoBinder] -> Type -> Type\nmkPiTys tbs ty = foldr mkPiTy ty tbs\n\n-- | Create the plain type constructor type which has been applied to no type arguments at all.\nmkTyConTy :: TyCon -> Type\nmkTyConTy tycon = TyConApp tycon []\n\n{-\nSome basic functions, put here to break loops eg with the pretty printer\n-}\n\n-- | Extract the RuntimeRep classifier of a type from its kind. For example,\n-- @kindRep * = LiftedRep@; Panics if this is not possible.\n-- Treats * and Constraint as the same\nkindRep :: HasDebugCallStack => Kind -> Type\nkindRep k = case kindRep_maybe k of\n              Just r  -> r\n              Nothing -> pprPanic \"kindRep\" (ppr k)\n\n-- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr.\n-- For example, @kindRep_maybe * = Just LiftedRep@\n-- Returns 'Nothing' if the kind is not of form (TYPE rr)\n-- Treats * and Constraint as the same\nkindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type\nkindRep_maybe kind\n  | Just kind' <- coreView kind = kindRep_maybe kind'\n  | TyConApp tc [arg] <- kind\n  , tc `hasKey` tYPETyConKey    = Just arg\n  | otherwise                   = Nothing\n\n-- | This version considers Constraint to be the same as *. Returns True\n-- if the argument is equivalent to Type/Constraint and False otherwise.\n-- See Note [Kind Constraint and kind Type]\nisLiftedTypeKind :: Kind -> Bool\nisLiftedTypeKind kind\n  = case kindRep_maybe kind of\n      Just rep -> isLiftedRuntimeRep rep\n      Nothing  -> False\n\n-- | Returns True if the kind classifies unlifted types and False otherwise.\n-- Note that this returns False for levity-polymorphic kinds, which may\n-- be specialized to a kind that classifies unlifted types.\nisUnliftedTypeKind :: Kind -> Bool\nisUnliftedTypeKind kind\n  = case kindRep_maybe kind of\n      Just rep -> isUnliftedRuntimeRep rep\n      Nothing  -> False\n\nisLiftedRuntimeRep :: Type -> Bool\n-- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep\n-- False of type variables (a :: RuntimeRep)\n--   and of other reps e.g. (IntRep :: RuntimeRep)\nisLiftedRuntimeRep rep\n  | Just rep' <- coreView rep          = isLiftedRuntimeRep rep'\n  | TyConApp rr_tc args <- rep\n  , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True\n  | otherwise                          = False\n\nisUnliftedRuntimeRep :: Type -> Bool\n-- True of definitely-unlifted RuntimeReps\n-- False of           (LiftedRep :: RuntimeRep)\n--   and of variables (a :: RuntimeRep)\nisUnliftedRuntimeRep rep\n  | Just rep' <- coreView rep = isUnliftedRuntimeRep rep'\n  | TyConApp rr_tc _ <- rep   -- NB: args might be non-empty\n                              --     e.g. TupleRep [r1, .., rn]\n  = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)\n        -- Avoid searching all the unlifted RuntimeRep type cons\n        -- In the RuntimeRep data type, only LiftedRep is lifted\n        -- But be careful of type families (F tys) :: RuntimeRep\n  | otherwise {- Variables, applications -}\n  = False\n\n-- | Is this the type 'RuntimeRep'?\nisRuntimeRepTy :: Type -> Bool\nisRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty'\nisRuntimeRepTy (TyConApp tc args)\n  | tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True\nisRuntimeRepTy _ = False\n\n-- | Is a tyvar of type 'RuntimeRep'?\nisRuntimeRepVar :: TyVar -> Bool\nisRuntimeRepVar = isRuntimeRepTy . tyVarKind\n\n{-\n%************************************************************************\n%*                                                                      *\n            Coercions\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | A 'Coercion' is concrete evidence of the equality/convertibility\n-- of two types.\n\n-- If you edit this type, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\ndata Coercion\n  -- Each constructor has a \"role signature\", indicating the way roles are\n  -- propagated through coercions.\n  --    -  P, N, and R stand for coercions of the given role\n  --    -  e stands for a coercion of a specific unknown role\n  --           (think \"role polymorphism\")\n  --    -  \"e\" stands for an explicit role parameter indicating role e.\n  --    -   _ stands for a parameter that is not a Role or Coercion.\n\n  -- These ones mirror the shape of types\n  = -- Refl :: _ -> N\n    Refl Type  -- See Note [Refl invariant]\n          -- Invariant: applications of (Refl T) to a bunch of identity coercions\n          --            always show up as Refl.\n          -- For example  (Refl T) (Refl a) (Refl b) shows up as (Refl (T a b)).\n\n          -- Applications of (Refl T) to some coercions, at least one of\n          -- which is NOT the identity, show up as TyConAppCo.\n          -- (They may not be fully saturated however.)\n          -- ConAppCo coercions (like all coercions other than Refl)\n          -- are NEVER the identity.\n\n          -- Use (GRefl Representational ty MRefl), not (SubCo (Refl ty))\n\n  -- GRefl :: \"e\" -> _ -> Maybe N -> e\n  -- See Note [Generalized reflexive coercion]\n  | GRefl Role Type MCoercionN  -- See Note [Refl invariant]\n          -- Use (Refl ty), not (GRefl Nominal ty MRefl)\n          -- Use (GRefl Representational _ _), not (SubCo (GRefl Nominal _ _))\n\n  -- These ones simply lift the correspondingly-named\n  -- Type constructors into Coercions\n\n  -- TyConAppCo :: \"e\" -> _ -> ?? -> e\n  -- See Note [TyConAppCo roles]\n  | TyConAppCo Role TyCon [Coercion]    -- lift TyConApp\n               -- The TyCon is never a synonym;\n               -- we expand synonyms eagerly\n               -- But it can be a type function\n\n  | AppCo Coercion CoercionN             -- lift AppTy\n          -- AppCo :: e -> N -> e\n\n  -- See Note [Forall coercions]\n  | ForAllCo TyCoVar KindCoercion Coercion\n         -- ForAllCo :: _ -> N -> e -> e\n\n  | FunCo Role Coercion Coercion         -- lift FunTy\n         -- FunCo :: \"e\" -> e -> e -> e\n         -- Note: why doesn't FunCo have a AnonArgFlag, like FunTy?\n         -- Because the AnonArgFlag has no impact on Core; it is only\n         -- there to guide implicit instantiation of Haskell source\n         -- types, and that is irrelevant for coercions, which are\n         -- Core-only.\n\n  -- These are special\n  | CoVarCo CoVar      -- :: _ -> (N or R)\n                       -- result role depends on the tycon of the variable's type\n\n    -- AxiomInstCo :: e -> _ -> [N] -> e\n  | AxiomInstCo (CoAxiom Branched) BranchIndex [Coercion]\n     -- See also [CoAxiom index]\n     -- The coercion arguments always *precisely* saturate\n     -- arity of (that branch of) the CoAxiom. If there are\n     -- any left over, we use AppCo.\n     -- See [Coercion axioms applied to coercions]\n\n  | AxiomRuleCo CoAxiomRule [Coercion]\n    -- AxiomRuleCo is very like AxiomInstCo, but for a CoAxiomRule\n    -- The number coercions should match exactly the expectations\n    -- of the CoAxiomRule (i.e., the rule is fully saturated).\n\n  | UnivCo UnivCoProvenance Role Type Type\n      -- :: _ -> \"e\" -> _ -> _ -> e\n\n  | SymCo Coercion             -- :: e -> e\n  | TransCo Coercion Coercion  -- :: e -> e -> e\n\n  | NthCo  Role Int Coercion     -- Zero-indexed; decomposes (T t0 ... tn)\n    -- :: \"e\" -> _ -> e0 -> e (inverse of TyConAppCo, see Note [TyConAppCo roles])\n    -- Using NthCo on a ForAllCo gives an N coercion always\n    -- See Note [NthCo and newtypes]\n    --\n    -- Invariant:  (NthCo r i co), it is always the case that r = role of (Nth i co)\n    -- That is: the role of the entire coercion is redundantly cached here.\n    -- See Note [NthCo Cached Roles]\n\n  | LRCo   LeftOrRight CoercionN     -- Decomposes (t_left t_right)\n    -- :: _ -> N -> N\n  | InstCo Coercion CoercionN\n    -- :: e -> N -> e\n    -- See Note [InstCo roles]\n\n  -- Extract a kind coercion from a (heterogeneous) type coercion\n  -- NB: all kind coercions are Nominal\n  | KindCo Coercion\n     -- :: e -> N\n\n  | SubCo CoercionN                  -- Turns a ~N into a ~R\n    -- :: N -> R\n\n  | HoleCo CoercionHole              -- ^ See Note [Coercion holes]\n                                     -- Only present during typechecking\n  deriving Data.Data\n\ntype CoercionN = Coercion       -- always nominal\ntype CoercionR = Coercion       -- always representational\ntype CoercionP = Coercion       -- always phantom\ntype KindCoercion = CoercionN   -- always nominal\n\n-- | A semantically more meaningful type to represent what may or may not be a\n-- useful 'Coercion'.\ndata MCoercion\n  = MRefl\n    -- A trivial Reflexivity coercion\n  | MCo Coercion\n    -- Other coercions\n  deriving Data.Data\ntype MCoercionR = MCoercion\ntype MCoercionN = MCoercion\n\ninstance Outputable MCoercion where\n  ppr MRefl    = text \"MRefl\"\n  ppr (MCo co) = text \"MCo\" <+> ppr co\n\n{-\nNote [Refl invariant]\n~~~~~~~~~~~~~~~~~~~~~\nInvariant 1:\n\nCoercions have the following invariant\n     Refl (similar for GRefl r ty MRefl) is always lifted as far as possible.\n\nYou might think that a consequencs is:\n     Every identity coercions has Refl at the root\n\nBut that's not quite true because of coercion variables.  Consider\n     g         where g :: Int~Int\n     Left h    where h :: Maybe Int ~ Maybe Int\netc.  So the consequence is only true of coercions that\nhave no coercion variables.\n\nNote [Generalized reflexive coercion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nGRefl is a generalized reflexive coercion (see Trac #15192). It wraps a kind\ncoercion, which might be reflexive (MRefl) or any coercion (MCo co). The typing\nrules for GRefl:\n\n  ty : k1\n  ------------------------------------\n  GRefl r ty MRefl: ty ~r ty\n\n  ty : k1       co :: k1 ~ k2\n  ------------------------------------\n  GRefl r ty (MCo co) : ty ~r ty |> co\n\nConsider we have\n\n   g1 :: s ~r t\n   s  :: k1\n   g2 :: k1 ~ k2\n\nand we want to construct a coercions co which has type\n\n   (s |> g2) ~r t\n\nWe can define\n\n   co = Sym (GRefl r s g2) ; g1\n\nIt is easy to see that\n\n   Refl == GRefl Nominal ty MRefl :: ty ~n ty\n\nA nominal reflexive coercion is quite common, so we keep the special form Refl to\nsave allocation.\n\nNote [Coercion axioms applied to coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe reason coercion axioms can be applied to coercions and not just\ntypes is to allow for better optimization.  There are some cases where\nwe need to be able to \"push transitivity inside\" an axiom in order to\nexpose further opportunities for optimization.\n\nFor example, suppose we have\n\n  C a : t[a] ~ F a\n  g   : b ~ c\n\nand we want to optimize\n\n  sym (C b) ; t[g] ; C c\n\nwhich has the kind\n\n  F b ~ F c\n\n(stopping through t[b] and t[c] along the way).\n\nWe'd like to optimize this to just F g -- but how?  The key is\nthat we need to allow axioms to be instantiated by *coercions*,\nnot just by types.  Then we can (in certain cases) push\ntransitivity inside the axiom instantiations, and then react\nopposite-polarity instantiations of the same axiom.  In this\ncase, e.g., we match t[g] against the LHS of (C c)'s kind, to\nobtain the substitution  a |-> g  (note this operation is sort\nof the dual of lifting!) and hence end up with\n\n  C g : t[b] ~ F c\n\nwhich indeed has the same kind as  t[g] ; C c.\n\nNow we have\n\n  sym (C b) ; C g\n\nwhich can be optimized to F g.\n\nNote [CoAxiom index]\n~~~~~~~~~~~~~~~~~~~~\nA CoAxiom has 1 or more branches. Each branch has contains a list\nof the free type variables in that branch, the LHS type patterns,\nand the RHS type for that branch. When we apply an axiom to a list\nof coercions, we must choose which branch of the axiom we wish to\nuse, as the different branches may have different numbers of free\ntype variables. (The number of type patterns is always the same\namong branches, but that doesn't quite concern us here.)\n\nThe Int in the AxiomInstCo constructor is the 0-indexed number\nof the chosen branch.\n\nNote [Forall coercions]\n~~~~~~~~~~~~~~~~~~~~~~~\nConstructing coercions between forall-types can be a bit tricky,\nbecause the kinds of the bound tyvars can be different.\n\nThe typing rule is:\n\n\n  kind_co : k1 ~ k2\n  tv1:k1 |- co : t1 ~ t2\n  -------------------------------------------------------------------\n  ForAllCo tv1 kind_co co : all tv1:k1. t1  ~\n                            all tv1:k2. (t2[tv1 |-> tv1 |> sym kind_co])\n\nFirst, the TyCoVar stored in a ForAllCo is really an optimisation: this field\nshould be a Name, as its kind is redundant. Thinking of the field as a Name\nis helpful in understanding what a ForAllCo means.\nThe kind of TyCoVar always matches the left-hand kind of the coercion.\n\nThe idea is that kind_co gives the two kinds of the tyvar. See how, in the\nconclusion, tv1 is assigned kind k1 on the left but kind k2 on the right.\n\nOf course, a type variable can't have different kinds at the same time. So,\nwe arbitrarily prefer the first kind when using tv1 in the inner coercion\nco, which shows that t1 equals t2.\n\nThe last wrinkle is that we need to fix the kinds in the conclusion. In\nt2, tv1 is assumed to have kind k1, but it has kind k2 in the conclusion of\nthe rule. So we do a kind-fixing substitution, replacing (tv1:k1) with\n(tv1:k2) |> sym kind_co. This substitution is slightly bizarre, because it\nmentions the same name with different kinds, but it *is* well-kinded, noting\nthat `(tv1:k2) |> sym kind_co` has kind k1.\n\nThis all really would work storing just a Name in the ForAllCo. But we can't\nadd Names to, e.g., VarSets, and there generally is just an impedance mismatch\nin a bunch of places. So we use tv1. When we need tv2, we can use\nsetTyVarKind.\n\nNote [Predicate coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n   g :: a~b\nHow can we coerce between types\n   ([c]~a) => [a] -> c\nand\n   ([c]~b) => [b] -> c\nwhere the equality predicate *itself* differs?\n\nAnswer: we simply treat (~) as an ordinary type constructor, so these\ntypes really look like\n\n   ((~) [c] a) -> [a] -> c\n   ((~) [c] b) -> [b] -> c\n\nSo the coercion between the two is obviously\n\n   ((~) [c] g) -> [g] -> c\n\nAnother way to see this to say that we simply collapse predicates to\ntheir representation type (see Type.coreView and Type.predTypeRep).\n\nThis collapse is done by mkPredCo; there is no PredCo constructor\nin Coercion.  This is important because we need Nth to work on\npredicates too:\n    Nth 1 ((~) [c] g) = g\nSee Simplify.simplCoercionF, which generates such selections.\n\nNote [Roles]\n~~~~~~~~~~~~\nRoles are a solution to the GeneralizedNewtypeDeriving problem, articulated\nin Trac #1496. The full story is in docs/core-spec/core-spec.pdf. Also, see\nhttp://ghc.haskell.org/trac/ghc/wiki/RolesImplementation\n\nHere is one way to phrase the problem:\n\nGiven:\nnewtype Age = MkAge Int\ntype family F x\ntype instance F Age = Bool\ntype instance F Int = Char\n\nThis compiles down to:\naxAge :: Age ~ Int\naxF1 :: F Age ~ Bool\naxF2 :: F Int ~ Char\n\nThen, we can make:\n(sym (axF1) ; F axAge ; axF2) :: Bool ~ Char\n\nYikes!\n\nThe solution is _roles_, as articulated in \"Generative Type Abstraction and\nType-level Computation\" (POPL 2010), available at\nhttp://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf\n\nThe specification for roles has evolved somewhat since that paper. For the\ncurrent full details, see the documentation in docs/core-spec. Here are some\nhighlights.\n\nWe label every equality with a notion of type equivalence, of which there are\nthree options: Nominal, Representational, and Phantom. A ground type is\nnominally equivalent only with itself. A newtype (which is considered a ground\ntype in Haskell) is representationally equivalent to its representation.\nAnything is \"phantomly\" equivalent to anything else. We use \"N\", \"R\", and \"P\"\nto denote the equivalences.\n\nThe axioms above would be:\naxAge :: Age ~R Int\naxF1 :: F Age ~N Bool\naxF2 :: F Age ~N Char\n\nThen, because transitivity applies only to coercions proving the same notion\nof equivalence, the above construction is impossible.\n\nHowever, there is still an escape hatch: we know that any two types that are\nnominally equivalent are representationally equivalent as well. This is what\nthe form SubCo proves -- it \"demotes\" a nominal equivalence into a\nrepresentational equivalence. So, it would seem the following is possible:\n\nsub (sym axF1) ; F axAge ; sub axF2 :: Bool ~R Char   -- WRONG\n\nWhat saves us here is that the arguments to a type function F, lifted into a\ncoercion, *must* prove nominal equivalence. So, (F axAge) is ill-formed, and\nwe are safe.\n\nRoles are attached to parameters to TyCons. When lifting a TyCon into a\ncoercion (through TyConAppCo), we need to ensure that the arguments to the\nTyCon respect their roles. For example:\n\ndata T a b = MkT a (F b)\n\nIf we know that a1 ~R a2, then we know (T a1 b) ~R (T a2 b). But, if we know\nthat b1 ~R b2, we know nothing about (T a b1) and (T a b2)! This is because\nthe type function F branches on b's *name*, not representation. So, we say\nthat 'a' has role Representational and 'b' has role Nominal. The third role,\nPhantom, is for parameters not used in the type's definition. Given the\nfollowing definition\n\ndata Q a = MkQ Int\n\nthe Phantom role allows us to say that (Q Bool) ~R (Q Char), because we\ncan construct the coercion Bool ~P Char (using UnivCo).\n\nSee the paper cited above for more examples and information.\n\nNote [TyConAppCo roles]\n~~~~~~~~~~~~~~~~~~~~~~~\nThe TyConAppCo constructor has a role parameter, indicating the role at\nwhich the coercion proves equality. The choice of this parameter affects\nthe required roles of the arguments of the TyConAppCo. To help explain\nit, assume the following definition:\n\n  type instance F Int = Bool   -- Axiom axF : F Int ~N Bool\n  newtype Age = MkAge Int      -- Axiom axAge : Age ~R Int\n  data Foo a = MkFoo a         -- Role on Foo's parameter is Representational\n\nTyConAppCo Nominal Foo axF : Foo (F Int) ~N Foo Bool\n  For (TyConAppCo Nominal) all arguments must have role Nominal. Why?\n  So that Foo Age ~N Foo Int does *not* hold.\n\nTyConAppCo Representational Foo (SubCo axF) : Foo (F Int) ~R Foo Bool\nTyConAppCo Representational Foo axAge       : Foo Age     ~R Foo Int\n  For (TyConAppCo Representational), all arguments must have the roles\n  corresponding to the result of tyConRoles on the TyCon. This is the\n  whole point of having roles on the TyCon to begin with. So, we can\n  have Foo Age ~R Foo Int, if Foo's parameter has role R.\n\n  If a Representational TyConAppCo is over-saturated (which is otherwise fine),\n  the spill-over arguments must all be at Nominal. This corresponds to the\n  behavior for AppCo.\n\nTyConAppCo Phantom Foo (UnivCo Phantom Int Bool) : Foo Int ~P Foo Bool\n  All arguments must have role Phantom. This one isn't strictly\n  necessary for soundness, but this choice removes ambiguity.\n\nThe rules here dictate the roles of the parameters to mkTyConAppCo\n(should be checked by Lint).\n\nNote [NthCo and newtypes]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n\n  newtype N a = MkN Int\n  type role N representational\n\nThis yields axiom\n\n  NTCo:N :: forall a. N a ~R Int\n\nWe can then build\n\n  co :: forall a b. N a ~R N b\n  co = NTCo:N a ; sym (NTCo:N b)\n\nfor any `a` and `b`. Because of the role annotation on N, if we use\nNthCo, we'll get out a representational coercion. That is:\n\n  NthCo r 0 co :: forall a b. a ~R b\n\nYikes! Clearly, this is terrible. The solution is simple: forbid\nNthCo to be used on newtypes if the internal coercion is representational.\n\nThis is not just some corner case discovered by a segfault somewhere;\nit was discovered in the proof of soundness of roles and described\nin the \"Safe Coercions\" paper (ICFP '14).\n\nNote [NthCo Cached Roles]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWhy do we cache the role of NthCo in the NthCo constructor?\nBecause computing role(Nth i co) involves figuring out that\n\n  co :: T tys1 ~ T tys2\n\nusing coercionKind, and finding (coercionRole co), and then looking\nat the tyConRoles of T. Avoiding bad asymptotic behaviour here means\nwe have to compute the kind and role of a coercion simultaneously,\nwhich makes the code complicated and inefficient.\n\nThis only happens for NthCo. Caching the role solves the problem, and\nallows coercionKind and coercionRole to be simple.\n\nSee Trac #11735\n\nNote [InstCo roles]\n~~~~~~~~~~~~~~~~~~~\nHere is (essentially) the typing rule for InstCo:\n\ng :: (forall a. t1) ~r (forall a. t2)\nw :: s1 ~N s2\n------------------------------- InstCo\nInstCo g w :: (t1 [a |-> s1]) ~r (t2 [a |-> s2])\n\nNote that the Coercion w *must* be nominal. This is necessary\nbecause the variable a might be used in a \"nominal position\"\n(that is, a place where role inference would require a nominal\nrole) in t1 or t2. If we allowed w to be representational, we\ncould get bogus equalities.\n\nA more nuanced treatment might be able to relax this condition\nsomewhat, by checking if t1 and/or t2 use their bound variables\nin nominal ways. If not, having w be representational is OK.\n\n\n%************************************************************************\n%*                                                                      *\n                UnivCoProvenance\n%*                                                                      *\n%************************************************************************\n\nA UnivCo is a coercion whose proof does not directly express its role\nand kind (indeed for some UnivCos, like UnsafeCoerceProv, there /is/\nno proof).\n\nThe different kinds of UnivCo are described by UnivCoProvenance.  Really\neach is entirely separate, but they all share the need to represent their\nrole and kind, which is done in the UnivCo constructor.\n\n-}\n\n-- | For simplicity, we have just one UnivCo that represents a coercion from\n-- some type to some other type, with (in general) no restrictions on the\n-- type. The UnivCoProvenance specifies more exactly what the coercion really\n-- is and why a program should (or shouldn't!) trust the coercion.\n-- It is reasonable to consider each constructor of 'UnivCoProvenance'\n-- as a totally independent coercion form; their only commonality is\n-- that they don't tell you what types they coercion between. (That info\n-- is in the 'UnivCo' constructor of 'Coercion'.\ndata UnivCoProvenance\n  = UnsafeCoerceProv   -- ^ From @unsafeCoerce#@. These are unsound.\n\n  | PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom\n                             -- roled coercions\n\n  | ProofIrrelProv KindCoercion  -- ^ From the fact that any two coercions are\n                                 --   considered equivalent. See Note [ProofIrrelProv].\n                                 -- Can be used in Nominal or Representational coercions\n\n  | PluginProv String  -- ^ From a plugin, which asserts that this coercion\n                       --   is sound. The string is for the use of the plugin.\n\n  deriving Data.Data\n\ninstance Outputable UnivCoProvenance where\n  ppr UnsafeCoerceProv   = text \"(unsafeCoerce#)\"\n  ppr (PhantomProv _)    = text \"(phantom)\"\n  ppr (ProofIrrelProv _) = text \"(proof irrel.)\"\n  ppr (PluginProv str)   = parens (text \"plugin\" <+> brackets (text str))\n\n-- | A coercion to be filled in by the type-checker. See Note [Coercion holes]\ndata CoercionHole\n  = CoercionHole { ch_co_var :: CoVar\n                       -- See Note [CoercionHoles and coercion free variables]\n\n                 , ch_ref    :: IORef (Maybe Coercion)\n                 }\n\ncoHoleCoVar :: CoercionHole -> CoVar\ncoHoleCoVar = ch_co_var\n\nsetCoHoleCoVar :: CoercionHole -> CoVar -> CoercionHole\nsetCoHoleCoVar h cv = h { ch_co_var = cv }\n\ninstance Data.Data CoercionHole where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"CoercionHole\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"CoercionHole\"\n\ninstance Outputable CoercionHole where\n  ppr (CoercionHole { ch_co_var = cv }) = braces (ppr cv)\n\n\n{- Note [Phantom coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n     data T a = T1 | T2\nThen we have\n     T s ~R T t\nfor any old s,t. The witness for this is (TyConAppCo T Rep co),\nwhere (co :: s ~P t) is a phantom coercion built with PhantomProv.\nThe role of the UnivCo is always Phantom.  The Coercion stored is the\n(nominal) kind coercion between the types\n   kind(s) ~N kind (t)\n\nNote [Coercion holes]\n~~~~~~~~~~~~~~~~~~~~~~~~\nDuring typechecking, constraint solving for type classes works by\n  - Generate an evidence Id,  d7 :: Num a\n  - Wrap it in a Wanted constraint, [W] d7 :: Num a\n  - Use the evidence Id where the evidence is needed\n  - Solve the constraint later\n  - When solved, add an enclosing let-binding  let d7 = .... in ....\n    which actually binds d7 to the (Num a) evidence\n\nFor equality constraints we use a different strategy.  See Note [The\nequality types story] in TysPrim for background on equality constraints.\n  - For /boxed/ equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just\n    like type classes above. (Indeed, boxed equality constraints *are* classes.)\n  - But for /unboxed/ equality constraints (t1 ~R# t2) and (t1 ~N# t2)\n    we use a different plan\n\nFor unboxed equalities:\n  - Generate a CoercionHole, a mutable variable just like a unification\n    variable\n  - Wrap the CoercionHole in a Wanted constraint; see TcRnTypes.TcEvDest\n  - Use the CoercionHole in a Coercion, via HoleCo\n  - Solve the constraint later\n  - When solved, fill in the CoercionHole by side effect, instead of\n    doing the let-binding thing\n\nThe main reason for all this is that there may be no good place to let-bind\nthe evidence for unboxed equalities:\n\n  - We emit constraints for kind coercions, to be used to cast a\n    type's kind. These coercions then must be used in types. Because\n    they might appear in a top-level type, there is no place to bind\n    these (unlifted) coercions in the usual way.\n\n  - A coercion for (forall a. t1) ~ (forall a. t2) will look like\n       forall a. (coercion for t1~t2)\n    But the coercion for (t1~t2) may mention 'a', and we don't have\n    let-bindings within coercions.  We could add them, but coercion\n    holes are easier.\n\n  - Moreover, nothing is lost from the lack of let-bindings. For\n    dicionaries want to achieve sharing to avoid recomoputing the\n    dictionary.  But coercions are entirely erased, so there's little\n    benefit to sharing. Indeed, even if we had a let-binding, we\n    always inline types and coercions at every use site and drop the\n    binding.\n\nOther notes about HoleCo:\n\n * INVARIANT: CoercionHole and HoleCo are used only during type checking,\n   and should never appear in Core. Just like unification variables; a Type\n   can contain a TcTyVar, but only during type checking. If, one day, we\n   use type-level information to separate out forms that can appear during\n   type-checking vs forms that can appear in core proper, holes in Core will\n   be ruled out.\n\n * See Note [CoercionHoles and coercion free variables]\n\n * Coercion holes can be compared for equality like other coercions:\n   by looking at the types coerced.\n\n\nNote [CoercionHoles and coercion free variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhy does a CoercionHole contain a CoVar, as well as reference to\nfill in?  Because we want to treat that CoVar as a free variable of\nthe coercion.  See Trac #14584, and Note [What prevents a\nconstraint from floating] in TcSimplify, item (4):\n\n        forall k. [W] co1 :: t1 ~# t2 |> co2\n                  [W] co2 :: k ~# *\n\nHere co2 is a CoercionHole. But we /must/ know that it is free in\nco1, because that's all that stops it floating outside the\nimplication.\n\n\nNote [ProofIrrelProv]\n~~~~~~~~~~~~~~~~~~~~~\nA ProofIrrelProv is a coercion between coercions. For example:\n\n  data G a where\n    MkG :: G Bool\n\nIn core, we get\n\n  G :: * -> *\n  MkG :: forall (a :: *). (a ~ Bool) -> G a\n\nNow, consider 'MkG -- that is, MkG used in a type -- and suppose we want\na proof that ('MkG a1 co1) ~ ('MkG a2 co2). This will have to be\n\n  TyConAppCo Nominal MkG [co3, co4]\n  where\n    co3 :: co1 ~ co2\n    co4 :: a1 ~ a2\n\nNote that\n  co1 :: a1 ~ Bool\n  co2 :: a2 ~ Bool\n\nHere,\n  co3 = UnivCo (ProofIrrelProv co5) Nominal (CoercionTy co1) (CoercionTy co2)\n  where\n    co5 :: (a1 ~ Bool) ~ (a2 ~ Bool)\n    co5 = TyConAppCo Nominal (~#) [<*>, <*>, co4, <Bool>]\n\n\n%************************************************************************\n%*                                                                      *\n                 Free variables of types and coercions\n%*                                                                      *\n%************************************************************************\n-}\n\n{- Note [Free variables of types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe family of functions tyCoVarsOfType, tyCoVarsOfTypes etc, returns\na VarSet that is closed over the types of its variables.  More precisely,\n  if    S = tyCoVarsOfType( t )\n  and   (a:k) is in S\n  then  tyCoVarsOftype( k ) is a subset of S\n\nExample: The tyCoVars of this ((a:* -> k) Int) is {a, k}.\n\nWe could /not/ close over the kinds of the variable occurrences, and\ninstead do so at call sites, but it seems that we always want to do\nso, so it's easiest to do it here.\n\nIt turns out that getting the free variables of types is performance critical,\nso we profiled several versions, exploring different implementation strategies.\n\n1. Baseline version: uses FV naively. Essentially:\n\n   tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty\n\n   This is not nice, because FV introduces some overhead to implement\n   determinism, and throught its \"interesting var\" function, neither of which\n   we need here, so they are a complete waste.\n\n2. UnionVarSet version: instead of reusing the FV-based code, we simply used\n   VarSets directly, trying to avoid the overhead of FV. E.g.:\n\n   -- FV version:\n   tyCoFVsOfType (AppTy fun arg)    a b c = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) a b c\n\n   -- UnionVarSet version:\n   tyCoVarsOfType (AppTy fun arg)    = (tyCoVarsOfType fun `unionVarSet` tyCoVarsOfType arg)\n\n   This looks deceptively similar, but while FV internally builds a list- and\n   set-generating function, the VarSet functions manipulate sets directly, and\n   the latter peforms a lot worse than the naive FV version.\n\n3. Accumulator-style VarSet version: this is what we use now. We do use VarSet\n   as our data structure, but delegate the actual work to a new\n   ty_co_vars_of_...  family of functions, which use accumulator style and the\n   \"in-scope set\" filter found in the internals of FV, but without the\n   determinism overhead.\n\nSee Trac #14880.\n\nNote [Closing over free variable kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\ntyCoVarsOfType and tyCoFVsOfType, while traversing a type, will also close over\nfree variable kinds. In previous GHC versions, this happened naively: whenever\nwe would encounter an occurrence of a free type variable, we would close over\nits kind. This, however is wrong for two reasons (see Trac #14880):\n\n1. Efficiency. If we have Proxy (a::k) -> Proxy (a::k) -> Proxy (a::k), then\n   we don't want to have to traverse k more than once.\n\n2. Correctness. Imagine we have forall k. b -> k, where b has\n   kind k, for some k bound in an outer scope. If we look at b's kind inside\n   the forall, we'll collect that k is free and then remove k from the set of\n   free variables. This is plain wrong. We must instead compute that b is free\n   and then conclude that b's kind is free.\n\nAn obvious first approach is to move the closing-over-kinds from the\noccurrences of a type variable to after finding the free vars - however, this\nturns out to introduce performance regressions, and isn't even entirely\ncorrect.\n\nIn fact, it isn't even important *when* we close over kinds; what matters is\nthat we handle each type var exactly once, and that we do it in the right\ncontext.\n\nSo the next approach we tried was to use the \"in-scope set\" part of FV or the\nequivalent argument in the accumulator-style `ty_co_vars_of_type` function, to\nsay \"don't bother with variables we have already closed over\". This should work\nfine in theory, but the code is complicated and doesn't perform well.\n\nBut there is a simpler way, which is implemented here. Consider the two points\nabove:\n\n1. Efficiency: we now have an accumulator, so the second time we encounter 'a',\n   we'll ignore it, certainly not looking at its kind - this is why\n   pre-checking set membership before inserting ends up not only being faster,\n   but also being correct.\n\n2. Correctness: we have an \"in-scope set\" (I think we should call it it a\n  \"bound-var set\"), specifying variables that are bound by a forall in the type\n  we are traversing; we simply ignore these variables, certainly not looking at\n  their kind.\n\nSo now consider:\n\n    forall k. b -> k\n\nwhere b :: k->Type is free; but of course, it's a different k! When looking at\nb -> k we'll have k in the bound-var set. So we'll ignore the k. But suppose\nthis is our first encounter with b; we want the free vars of its kind. But we\nwant to behave as if we took the free vars of its kind at the end; that is,\nwith no bound vars in scope.\n\nSo the solution is easy. The old code was this:\n\n  ty_co_vars_of_type (TyVarTy v) is acc\n    | v `elemVarSet` is  = acc\n    | v `elemVarSet` acc = acc\n    | otherwise          = ty_co_vars_of_type (tyVarKind v) is (extendVarSet acc v)\n\nNow all we need to do is take the free vars of tyVarKind v *with an empty\nbound-var set*, thus:\n\nty_co_vars_of_type (TyVarTy v) is acc\n  | v `elemVarSet` is  = acc\n  | v `elemVarSet` acc = acc\n  | otherwise          = ty_co_vars_of_type (tyVarKind v) emptyVarSet (extendVarSet acc v)\n                                                          ^^^^^^^^^^^\n\nAnd that's it.\n\n-}\n\ntyCoVarsOfType :: Type -> TyCoVarSet\n-- See Note [Free variables of types]\ntyCoVarsOfType ty = ty_co_vars_of_type ty emptyVarSet emptyVarSet\n\ntyCoVarsOfTypes :: [Type] -> TyCoVarSet\ntyCoVarsOfTypes tys = ty_co_vars_of_types tys emptyVarSet emptyVarSet\n\nty_co_vars_of_type :: Type -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet\nty_co_vars_of_type (TyVarTy v) is acc\n  | v `elemVarSet` is  = acc\n  | v `elemVarSet` acc = acc\n  | otherwise          = ty_co_vars_of_type (tyVarKind v)\n                            emptyVarSet  -- See Note [Closing over free variable kinds]\n                            (extendVarSet acc v)\n\nty_co_vars_of_type (TyConApp _ tys)   is acc = ty_co_vars_of_types tys is acc\nty_co_vars_of_type (LitTy {})         _  acc = acc\nty_co_vars_of_type (AppTy fun arg)    is acc = ty_co_vars_of_type fun is (ty_co_vars_of_type arg is acc)\nty_co_vars_of_type (FunTy _ arg res)  is acc = ty_co_vars_of_type arg is (ty_co_vars_of_type res is acc)\nty_co_vars_of_type (ForAllTy (Bndr tv _) ty) is acc = ty_co_vars_of_type (varType tv) is $\n                                                      ty_co_vars_of_type ty (extendVarSet is tv) acc\nty_co_vars_of_type (CastTy ty co)     is acc = ty_co_vars_of_type ty is (ty_co_vars_of_co co is acc)\nty_co_vars_of_type (CoercionTy co)    is acc = ty_co_vars_of_co co is acc\n\nty_co_vars_of_types :: [Type] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet\nty_co_vars_of_types []       _  acc = acc\nty_co_vars_of_types (ty:tys) is acc = ty_co_vars_of_type ty is (ty_co_vars_of_types tys is acc)\n\ntyCoVarsOfCo :: Coercion -> TyCoVarSet\n-- See Note [Free variables of types]\ntyCoVarsOfCo co = ty_co_vars_of_co co emptyVarSet emptyVarSet\n\ntyCoVarsOfCos :: [Coercion] -> TyCoVarSet\ntyCoVarsOfCos cos = ty_co_vars_of_cos cos emptyVarSet emptyVarSet\n\n\nty_co_vars_of_co :: Coercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet\nty_co_vars_of_co (Refl ty)            is acc = ty_co_vars_of_type ty is acc\nty_co_vars_of_co (GRefl _ ty mco)     is acc = ty_co_vars_of_type ty is $\n                                               ty_co_vars_of_mco mco is acc\nty_co_vars_of_co (TyConAppCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc\nty_co_vars_of_co (AppCo co arg)       is acc = ty_co_vars_of_co co is $\n                                               ty_co_vars_of_co arg is acc\nty_co_vars_of_co (ForAllCo tv kind_co co) is acc = ty_co_vars_of_co kind_co is $\n                                                   ty_co_vars_of_co co (extendVarSet is tv) acc\nty_co_vars_of_co (FunCo _ co1 co2)    is acc = ty_co_vars_of_co co1 is $\n                                               ty_co_vars_of_co co2 is acc\nty_co_vars_of_co (CoVarCo v)          is acc = ty_co_vars_of_co_var v is acc\nty_co_vars_of_co (HoleCo h)           is acc = ty_co_vars_of_co_var (coHoleCoVar h) is acc\n    -- See Note [CoercionHoles and coercion free variables]\nty_co_vars_of_co (AxiomInstCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc\nty_co_vars_of_co (UnivCo p _ t1 t2)    is acc = ty_co_vars_of_prov p is $\n                                                ty_co_vars_of_type t1 is $\n                                                ty_co_vars_of_type t2 is acc\nty_co_vars_of_co (SymCo co)          is acc = ty_co_vars_of_co co is acc\nty_co_vars_of_co (TransCo co1 co2)   is acc = ty_co_vars_of_co co1 is $\n                                              ty_co_vars_of_co co2 is acc\nty_co_vars_of_co (NthCo _ _ co)      is acc = ty_co_vars_of_co co is acc\nty_co_vars_of_co (LRCo _ co)         is acc = ty_co_vars_of_co co is acc\nty_co_vars_of_co (InstCo co arg)     is acc = ty_co_vars_of_co co is $\n                                              ty_co_vars_of_co arg is acc\nty_co_vars_of_co (KindCo co)         is acc = ty_co_vars_of_co co is acc\nty_co_vars_of_co (SubCo co)          is acc = ty_co_vars_of_co co is acc\nty_co_vars_of_co (AxiomRuleCo _ cs)  is acc = ty_co_vars_of_cos cs is acc\n\nty_co_vars_of_mco :: MCoercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet\nty_co_vars_of_mco MRefl    _is acc = acc\nty_co_vars_of_mco (MCo co) is  acc = ty_co_vars_of_co co is acc\n\nty_co_vars_of_co_var :: CoVar -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet\nty_co_vars_of_co_var v is acc\n  | v `elemVarSet` is  = acc\n  | v `elemVarSet` acc = acc\n  | otherwise          = ty_co_vars_of_type (varType v)\n                            emptyVarSet  -- See Note [Closing over free variable kinds]\n                            (extendVarSet acc v)\n\nty_co_vars_of_cos :: [Coercion] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet\nty_co_vars_of_cos []       _  acc = acc\nty_co_vars_of_cos (co:cos) is acc = ty_co_vars_of_co co is (ty_co_vars_of_cos cos is acc)\n\ntyCoVarsOfProv :: UnivCoProvenance -> TyCoVarSet\ntyCoVarsOfProv prov = ty_co_vars_of_prov prov emptyVarSet emptyVarSet\n\nty_co_vars_of_prov :: UnivCoProvenance -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet\nty_co_vars_of_prov (PhantomProv co)    is acc = ty_co_vars_of_co co is acc\nty_co_vars_of_prov (ProofIrrelProv co) is acc = ty_co_vars_of_co co is acc\nty_co_vars_of_prov UnsafeCoerceProv    _  acc = acc\nty_co_vars_of_prov (PluginProv _)      _  acc = acc\n\n-- | Generates an in-scope set from the free variables in a list of types\n-- and a list of coercions\nmkTyCoInScopeSet :: [Type] -> [Coercion] -> InScopeSet\nmkTyCoInScopeSet tys cos\n  = mkInScopeSet (ty_co_vars_of_types tys emptyVarSet $\n                  ty_co_vars_of_cos   cos emptyVarSet emptyVarSet)\n\n-- | `tyCoFVsOfType` that returns free variables of a type in a deterministic\n-- set. For explanation of why using `VarSet` is not deterministic see\n-- Note [Deterministic FV] in FV.\ntyCoVarsOfTypeDSet :: Type -> DTyCoVarSet\n-- See Note [Free variables of types]\ntyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty\n\n-- | `tyCoFVsOfType` that returns free variables of a type in deterministic\n-- order. For explanation of why using `VarSet` is not deterministic see\n-- Note [Deterministic FV] in FV.\ntyCoVarsOfTypeList :: Type -> [TyCoVar]\n-- See Note [Free variables of types]\ntyCoVarsOfTypeList ty = fvVarList $ tyCoFVsOfType ty\n\n-- | Returns free variables of types, including kind variables as\n-- a non-deterministic set. For type synonyms it does /not/ expand the\n-- synonym.\ntyCoVarsOfTypesSet :: TyVarEnv Type -> TyCoVarSet\n-- See Note [Free variables of types]\ntyCoVarsOfTypesSet tys = tyCoVarsOfTypes $ nonDetEltsUFM tys\n  -- It's OK to use nonDetEltsUFM here because we immediately forget the\n  -- ordering by returning a set\n\n-- | Returns free variables of types, including kind variables as\n-- a deterministic set. For type synonyms it does /not/ expand the\n-- synonym.\ntyCoVarsOfTypesDSet :: [Type] -> DTyCoVarSet\n-- See Note [Free variables of types]\ntyCoVarsOfTypesDSet tys = fvDVarSet $ tyCoFVsOfTypes tys\n\n-- | Returns free variables of types, including kind variables as\n-- a deterministically ordered list. For type synonyms it does /not/ expand the\n-- synonym.\ntyCoVarsOfTypesList :: [Type] -> [TyCoVar]\n-- See Note [Free variables of types]\ntyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys\n\n-- | The worker for `tyCoFVsOfType` and `tyCoFVsOfTypeList`.\n-- The previous implementation used `unionVarSet` which is O(n+m) and can\n-- make the function quadratic.\n-- It's exported, so that it can be composed with\n-- other functions that compute free variables.\n-- See Note [FV naming conventions] in FV.\n--\n-- Eta-expanded because that makes it run faster (apparently)\n-- See Note [FV eta expansion] in FV for explanation.\ntyCoFVsOfType :: Type -> FV\n-- See Note [Free variables of types]\ntyCoFVsOfType (TyVarTy v)        f bound_vars (acc_list, acc_set)\n  | not (f v) = (acc_list, acc_set)\n  | v `elemVarSet` bound_vars = (acc_list, acc_set)\n  | v `elemVarSet` acc_set = (acc_list, acc_set)\n  | otherwise = tyCoFVsOfType (tyVarKind v) f\n                               emptyVarSet   -- See Note [Closing over free variable kinds]\n                               (v:acc_list, extendVarSet acc_set v)\ntyCoFVsOfType (TyConApp _ tys)   f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc\ntyCoFVsOfType (LitTy {})         f bound_vars acc = emptyFV f bound_vars acc\ntyCoFVsOfType (AppTy fun arg)    f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc\ntyCoFVsOfType (FunTy _ arg res)  f bound_vars acc = (tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) f bound_vars acc\ntyCoFVsOfType (ForAllTy bndr ty) f bound_vars acc = tyCoFVsBndr bndr (tyCoFVsOfType ty)  f bound_vars acc\ntyCoFVsOfType (CastTy ty co)     f bound_vars acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfCo co) f bound_vars acc\ntyCoFVsOfType (CoercionTy co)    f bound_vars acc = tyCoFVsOfCo co f bound_vars acc\n\ntyCoFVsBndr :: TyCoVarBinder -> FV -> FV\n-- Free vars of (forall b. <thing with fvs>)\ntyCoFVsBndr (Bndr tv _) fvs = tyCoFVsVarBndr tv fvs\n\ntyCoFVsVarBndrs :: [Var] -> FV -> FV\ntyCoFVsVarBndrs vars fvs = foldr tyCoFVsVarBndr fvs vars\n\ntyCoFVsVarBndr :: Var -> FV -> FV\ntyCoFVsVarBndr var fvs\n  = tyCoFVsOfType (varType var)   -- Free vars of its type/kind\n    `unionFV` delFV var fvs       -- Delete it from the thing-inside\n\ntyCoFVsOfTypes :: [Type] -> FV\n-- See Note [Free variables of types]\ntyCoFVsOfTypes (ty:tys) fv_cand in_scope acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfTypes tys) fv_cand in_scope acc\ntyCoFVsOfTypes []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc\n\n-- | Get a deterministic set of the vars free in a coercion\ntyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet\n-- See Note [Free variables of types]\ntyCoVarsOfCoDSet co = fvDVarSet $ tyCoFVsOfCo co\n\ntyCoVarsOfCoList :: Coercion -> [TyCoVar]\n-- See Note [Free variables of types]\ntyCoVarsOfCoList co = fvVarList $ tyCoFVsOfCo co\n\ntyCoFVsOfMCo :: MCoercion -> FV\ntyCoFVsOfMCo MRefl    = emptyFV\ntyCoFVsOfMCo (MCo co) = tyCoFVsOfCo co\n\ntyCoVarsOfCosSet :: CoVarEnv Coercion -> TyCoVarSet\ntyCoVarsOfCosSet cos = tyCoVarsOfCos $ nonDetEltsUFM cos\n  -- It's OK to use nonDetEltsUFM here because we immediately forget the\n  -- ordering by returning a set\n\ntyCoFVsOfCo :: Coercion -> FV\n-- Extracts type and coercion variables from a coercion\n-- See Note [Free variables of types]\ntyCoFVsOfCo (Refl ty) fv_cand in_scope acc\n  = tyCoFVsOfType ty fv_cand in_scope acc\ntyCoFVsOfCo (GRefl _ ty mco) fv_cand in_scope acc\n  = (tyCoFVsOfType ty `unionFV` tyCoFVsOfMCo mco) fv_cand in_scope acc\ntyCoFVsOfCo (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc\ntyCoFVsOfCo (AppCo co arg) fv_cand in_scope acc\n  = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc\ntyCoFVsOfCo (ForAllCo tv kind_co co) fv_cand in_scope acc\n  = (tyCoFVsVarBndr tv (tyCoFVsOfCo co) `unionFV` tyCoFVsOfCo kind_co) fv_cand in_scope acc\ntyCoFVsOfCo (FunCo _ co1 co2)    fv_cand in_scope acc\n  = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc\ntyCoFVsOfCo (CoVarCo v) fv_cand in_scope acc\n  = tyCoFVsOfCoVar v fv_cand in_scope acc\ntyCoFVsOfCo (HoleCo h) fv_cand in_scope acc\n  = tyCoFVsOfCoVar (coHoleCoVar h) fv_cand in_scope acc\n    -- See Note [CoercionHoles and coercion free variables]\ntyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc\ntyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc\n  = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1\n                     `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc\ntyCoFVsOfCo (SymCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc\ntyCoFVsOfCo (TransCo co1 co2)   fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc\ntyCoFVsOfCo (NthCo _ _ co)      fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc\ntyCoFVsOfCo (LRCo _ co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc\ntyCoFVsOfCo (InstCo co arg)     fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc\ntyCoFVsOfCo (KindCo co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc\ntyCoFVsOfCo (SubCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc\ntyCoFVsOfCo (AxiomRuleCo _ cs)  fv_cand in_scope acc = tyCoFVsOfCos cs fv_cand in_scope acc\n\ntyCoFVsOfCoVar :: CoVar -> FV\ntyCoFVsOfCoVar v fv_cand in_scope acc\n  = (unitFV v `unionFV` tyCoFVsOfType (varType v)) fv_cand in_scope acc\n\ntyCoFVsOfProv :: UnivCoProvenance -> FV\ntyCoFVsOfProv UnsafeCoerceProv    fv_cand in_scope acc = emptyFV fv_cand in_scope acc\ntyCoFVsOfProv (PhantomProv co)    fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc\ntyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc\ntyCoFVsOfProv (PluginProv _)      fv_cand in_scope acc = emptyFV fv_cand in_scope acc\n\ntyCoFVsOfCos :: [Coercion] -> FV\ntyCoFVsOfCos []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc\ntyCoFVsOfCos (co:cos) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCos cos) fv_cand in_scope acc\n\n\n------------- Extracting the CoVars of a type or coercion -----------\n\n{-\n\nNote [CoVarsOfX and the InterestingVarFun]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe coVarsOfType, coVarsOfTypes, coVarsOfCo, and coVarsOfCos functions are\nimplemented in terms of the respective FV equivalents (tyCoFVsOf...), rather\nthan the VarSet-based flavors (tyCoVarsOf...), despite the performance\nconsiderations outlined in Note [Free variables of types].\n\nThis is because FV includes the InterestingVarFun, which is useful here,\nbecause we can cleverly use it to restrict our calculations to CoVars - this\nis what getCoVarSet achieves.\n\nSee Trac #14880.\n\n-}\n\ngetCoVarSet :: FV -> CoVarSet\ngetCoVarSet fv = snd (fv isCoVar emptyVarSet ([], emptyVarSet))\n\ncoVarsOfType :: Type -> CoVarSet\ncoVarsOfType ty = getCoVarSet (tyCoFVsOfType ty)\n\ncoVarsOfTypes :: [Type] -> TyCoVarSet\ncoVarsOfTypes tys = getCoVarSet (tyCoFVsOfTypes tys)\n\ncoVarsOfCo :: Coercion -> CoVarSet\ncoVarsOfCo co = getCoVarSet (tyCoFVsOfCo co)\n\ncoVarsOfCos :: [Coercion] -> CoVarSet\ncoVarsOfCos cos = getCoVarSet (tyCoFVsOfCos cos)\n\n----- Whether a covar is /Almost Devoid/ in a type or coercion ----\n\n-- | Given a covar and a coercion, returns True if covar is almost devoid in\n-- the coercion. That is, covar can only appear in Refl and GRefl.\n-- See last wrinkle in Note [Unused coercion variable in ForAllCo] in Coercion\nalmostDevoidCoVarOfCo :: CoVar -> Coercion -> Bool\nalmostDevoidCoVarOfCo cv co =\n  almost_devoid_co_var_of_co co cv\n\nalmost_devoid_co_var_of_co :: Coercion -> CoVar -> Bool\nalmost_devoid_co_var_of_co (Refl {}) _ = True   -- covar is allowed in Refl and\nalmost_devoid_co_var_of_co (GRefl {}) _ = True  -- GRefl, so we don't look into\n                                                -- the coercions\nalmost_devoid_co_var_of_co (TyConAppCo _ _ cos) cv\n  = almost_devoid_co_var_of_cos cos cv\nalmost_devoid_co_var_of_co (AppCo co arg) cv\n  = almost_devoid_co_var_of_co co cv\n  && almost_devoid_co_var_of_co arg cv\nalmost_devoid_co_var_of_co (ForAllCo v kind_co co) cv\n  = almost_devoid_co_var_of_co kind_co cv\n  && (v == cv || almost_devoid_co_var_of_co co cv)\nalmost_devoid_co_var_of_co (FunCo _ co1 co2) cv\n  = almost_devoid_co_var_of_co co1 cv\n  && almost_devoid_co_var_of_co co2 cv\nalmost_devoid_co_var_of_co (CoVarCo v) cv = v /= cv\nalmost_devoid_co_var_of_co (HoleCo h)  cv = (coHoleCoVar h) /= cv\nalmost_devoid_co_var_of_co (AxiomInstCo _ _ cos) cv\n  = almost_devoid_co_var_of_cos cos cv\nalmost_devoid_co_var_of_co (UnivCo p _ t1 t2) cv\n  = almost_devoid_co_var_of_prov p cv\n  && almost_devoid_co_var_of_type t1 cv\n  && almost_devoid_co_var_of_type t2 cv\nalmost_devoid_co_var_of_co (SymCo co) cv\n  = almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_co (TransCo co1 co2) cv\n  = almost_devoid_co_var_of_co co1 cv\n  && almost_devoid_co_var_of_co co2 cv\nalmost_devoid_co_var_of_co (NthCo _ _ co) cv\n  = almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_co (LRCo _ co) cv\n  = almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_co (InstCo co arg) cv\n  = almost_devoid_co_var_of_co co cv\n  && almost_devoid_co_var_of_co arg cv\nalmost_devoid_co_var_of_co (KindCo co) cv\n  = almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_co (SubCo co) cv\n  = almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_co (AxiomRuleCo _ cs) cv\n  = almost_devoid_co_var_of_cos cs cv\n\nalmost_devoid_co_var_of_cos :: [Coercion] -> CoVar -> Bool\nalmost_devoid_co_var_of_cos [] _ = True\nalmost_devoid_co_var_of_cos (co:cos) cv\n  = almost_devoid_co_var_of_co co cv\n  && almost_devoid_co_var_of_cos cos cv\n\nalmost_devoid_co_var_of_prov :: UnivCoProvenance -> CoVar -> Bool\nalmost_devoid_co_var_of_prov (PhantomProv co) cv\n  = almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_prov (ProofIrrelProv co) cv\n  = almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_prov UnsafeCoerceProv _ = True\nalmost_devoid_co_var_of_prov (PluginProv _) _ = True\n\nalmost_devoid_co_var_of_type :: Type -> CoVar -> Bool\nalmost_devoid_co_var_of_type (TyVarTy _) _ = True\nalmost_devoid_co_var_of_type (TyConApp _ tys) cv\n  = almost_devoid_co_var_of_types tys cv\nalmost_devoid_co_var_of_type (LitTy {}) _ = True\nalmost_devoid_co_var_of_type (AppTy fun arg) cv\n  = almost_devoid_co_var_of_type fun cv\n  && almost_devoid_co_var_of_type arg cv\nalmost_devoid_co_var_of_type (FunTy _ arg res) cv\n  = almost_devoid_co_var_of_type arg cv\n  && almost_devoid_co_var_of_type res cv\nalmost_devoid_co_var_of_type (ForAllTy (Bndr v _) ty) cv\n  = almost_devoid_co_var_of_type (varType v) cv\n  && (v == cv || almost_devoid_co_var_of_type ty cv)\nalmost_devoid_co_var_of_type (CastTy ty co) cv\n  = almost_devoid_co_var_of_type ty cv\n  && almost_devoid_co_var_of_co co cv\nalmost_devoid_co_var_of_type (CoercionTy co) cv\n  = almost_devoid_co_var_of_co co cv\n\nalmost_devoid_co_var_of_types :: [Type] -> CoVar -> Bool\nalmost_devoid_co_var_of_types [] _ = True\nalmost_devoid_co_var_of_types (ty:tys) cv\n  = almost_devoid_co_var_of_type ty cv\n  && almost_devoid_co_var_of_types tys cv\n\n------------- Injective free vars -----------------\n\n-- | Returns the free variables of a 'Type' that are in injective positions.\n-- For example, if @F@ is a non-injective type family, then:\n--\n-- @\n-- injectiveTyVarsOf( Either c (Maybe (a, F b c)) ) = {a,c}\n-- @\n--\n-- If @'injectiveVarsOfType' ty = itvs@, then knowing @ty@ fixes @itvs@.\n-- More formally, if\n-- @a@ is in @'injectiveVarsOfType' ty@\n-- and  @S1(ty) ~ S2(ty)@,\n-- then @S1(a)  ~ S2(a)@,\n-- where @S1@ and @S2@ are arbitrary substitutions.\n--\n-- See @Note [When does a tycon application need an explicit kind signature?]@.\ninjectiveVarsOfType :: Type -> FV\ninjectiveVarsOfType = go\n  where\n    go ty                 | Just ty' <- coreView ty\n                          = go ty'\n    go (TyVarTy v)        = unitFV v `unionFV` go (tyVarKind v)\n    go (AppTy f a)        = go f `unionFV` go a\n    go (FunTy _ ty1 ty2)  = go ty1 `unionFV` go ty2\n    go (TyConApp tc tys)  =\n      case tyConInjectivityInfo tc of\n        NotInjective  -> emptyFV\n        Injective inj -> mapUnionFV go $\n                         filterByList (inj ++ repeat True) tys\n                         -- Oversaturated arguments to a tycon are\n                         -- always injective, hence the repeat True\n    go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go ty\n    go LitTy{}           = emptyFV\n    go (CastTy ty _)     = go ty\n    go CoercionTy{}      = emptyFV\n\n-- | Does a 'TyCon' (that is applied to some number of arguments) need to be\n-- ascribed with an explicit kind signature to resolve ambiguity if rendered as\n-- a source-syntax type?\n-- (See @Note [When does a tycon application need an explicit kind signature?]@\n-- for a full explanation of what this function checks for.)\n\n-- Morally, this function ought to belong in TyCon.hs, not TyCoRep.hs, but\n-- accomplishing this requires a fair deal of futzing aruond with .hs-boot\n-- files.\ntyConAppNeedsKindSig\n  :: Bool  -- ^ Should specified binders count towards injective positions in\n           --   the kind of the TyCon? (If you're using visible kind\n           --   applications, then you want True here.\n  -> TyCon\n  -> Int   -- ^ The number of args the 'TyCon' is applied to.\n  -> Bool  -- ^ Does @T t_1 ... t_n@ need a kind signature? (Where @n@ is the\n           --   number of arguments)\ntyConAppNeedsKindSig spec_inj_pos tc n_args\n  | LT <- listLengthCmp tc_binders n_args\n  = False\n  | otherwise\n  = let (dropped_binders, remaining_binders)\n          = splitAt n_args tc_binders\n        result_kind  = mkTyConKind remaining_binders tc_res_kind\n        result_vars  = tyCoVarsOfType result_kind\n        dropped_vars = fvVarSet $\n                       mapUnionFV injective_vars_of_binder dropped_binders\n\n    in not (subVarSet result_vars dropped_vars)\n  where\n    tc_binders  = tyConBinders tc\n    tc_res_kind = tyConResKind tc\n\n    -- Returns the variables that would be fixed by knowing a TyConBinder. See\n    -- Note [When does a tycon application need an explicit kind signature?]\n    -- for a more detailed explanation of what this function does.\n    injective_vars_of_binder :: TyConBinder -> FV\n    injective_vars_of_binder (Bndr tv vis) =\n      case vis of\n        AnonTCB VisArg -> injectiveVarsOfType (varType tv)\n        NamedTCB argf  | source_of_injectivity argf\n                       -> unitFV tv `unionFV` injectiveVarsOfType (varType tv)\n        _              -> emptyFV\n\n    source_of_injectivity Required  = True\n    source_of_injectivity Specified = spec_inj_pos\n    source_of_injectivity Inferred  = False\n\n{-\nNote [When does a tycon application need an explicit kind signature?]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere are a couple of places in GHC where we convert Core Types into forms that\nmore closely resemble user-written syntax. These include:\n\n1. Template Haskell Type reification (see, for instance, TcSplice.reify_tc_app)\n2. Converting Types to LHsTypes (in HsUtils.typeToLHsType, or in Haddock)\n\nThis conversion presents a challenge: how do we ensure that the resulting type\nhas enough kind information so as not to be ambiguous? To better motivate this\nquestion, consider the following Core type:\n\n  -- Foo :: Type -> Type\n  type Foo = Proxy Type\n\nThere is nothing ambiguous about the RHS of Foo in Core. But if we were to,\nsay, reify it into a TH Type, then it's tempting to just drop the invisible\nType argument and simply return `Proxy`. But now we've lost crucial kind\ninformation: we don't know if we're dealing with `Proxy Type` or `Proxy Bool`\nor `Proxy Int` or something else! We've inadvertently introduced ambiguity.\n\nUnlike in other situations in GHC, we can't just turn on\n-fprint-explicit-kinds, as we need to produce something which has the same\nstructure as a source-syntax type. Moreover, we can't rely on visible kind\napplication, since the first kind argument to Proxy is inferred, not specified.\nOur solution is to annotate certain tycons with their kinds whenever they\nappear in applied form in order to resolve the ambiguity. For instance, we\nwould reify the RHS of Foo like so:\n\n  type Foo = (Proxy :: Type -> Type)\n\nWe need to devise an algorithm that determines precisely which tycons need\nthese explicit kind signatures. We certainly don't want to annotate _every_\ntycon with a kind signature, or else we might end up with horribly bloated\ntypes like the following:\n\n  (Either :: Type -> Type -> Type) (Int :: Type) (Char :: Type)\n\nWe only want to annotate tycons that absolutely require kind signatures in\norder to resolve some sort of ambiguity, and nothing more.\n\nSuppose we have a tycon application (T ty_1 ... ty_n). Why might this type\nrequire a kind signature? It might require it when we need to fill in any of\nT's omitted arguments. By \"omitted argument\", we mean one that is dropped when\nreifying ty_1 ... ty_n. Sometimes, the omitted arguments are inferred and\nspecified arguments (e.g., TH reification in TcSplice), and sometimes the\nomitted arguments are only the inferred ones (e.g., in HsUtils.typeToLHsType,\nwhich reifies specified arguments through visible kind application).\nRegardless, the key idea is that _some_ arguments are going to be omitted after\nreification, and the only mechanism we have at our disposal for filling them in\nis through explicit kind signatures.\n\nWhat do we mean by \"fill in\"? Let's consider this small example:\n\n  T :: forall {k}. Type -> (k -> Type) -> k\n\nMoreover, we have this application of T:\n\n  T @{j} Int aty\n\nWhen we reify this type, we omit the inferred argument @{j}. Is it fixed by the\nother (non-inferred) arguments? Yes! If we know the kind of (aty :: blah), then\nwe'll generate an equality constraint (kappa -> Type) and, assuming we can\nsolve it, that will fix `kappa`. (Here, `kappa` is the unification variable\nthat we instantiate `k` with.)\n\nTherefore, for any application of a tycon T to some arguments, the Question We\nMust Answer is:\n\n* Given the first n arguments of T, do the kinds of the non-omitted arguments\n  fill in the omitted arguments?\n\n(This is still a bit hand-wavey, but we'll refine this question incrementally\nas we explain more of the machinery underlying this process.)\n\nAnswering this question is precisely the role that the `injectiveVarsOfType`\nand `injective_vars_of_binder` functions exist to serve. If an omitted argument\n`a` appears in the set returned by `injectiveVarsOfType ty`, then knowing\n`ty` determines (i.e., fills in) `a`. (More on `injective_vars_of_binder` in a\nbit.)\n\nMore formally, if\n`a` is in `injectiveVarsOfType ty`\nand  S1(ty) ~ S2(ty),\nthen S1(a)  ~ S2(a),\nwhere S1 and S2 are arbitrary substitutions.\n\nFor example, is `F` is a non-injective type family, then\n\n  injectiveVarsOfType(Either c (Maybe (a, F b c))) = {a, c}\n\nNow that we know what this function does, here is a second attempt at the\nQuestion We Must Answer:\n\n* Given the first n arguments of T (ty_1 ... ty_n), consider the binders\n  of T that are instantiated by non-omitted arguments. Do the injective\n  variables of these binders fill in the remainder of T's kind?\n\nAlright, we're getting closer. Next, we need to clarify what the injective\nvariables of a tycon binder are. This the role that the\n`injective_vars_of_binder` function serves. Here is what this function does for\neach form of tycon binder:\n\n* Anonymous binders are injective positions. For example, in the promoted data\n  constructor '(:):\n\n    '(:) :: forall a. a -> [a] -> [a]\n\n  The second and third tyvar binders (of kinds `a` and `[a]`) are both\n  anonymous, so if we had '(:) 'True '[], then the kinds of 'True and\n  '[] would contribute to the kind of '(:) 'True '[]. Therefore,\n  injective_vars_of_binder(_ :: a) = injectiveVarsOfType(a) = {a}.\n  (Similarly, injective_vars_of_binder(_ :: [a]) = {a}.)\n* Named binders:\n  - Inferred binders are never injective positions. For example, in this data\n    type:\n\n      data Proxy a\n      Proxy :: forall {k}. k -> Type\n\n    If we had Proxy 'True, then the kind of 'True would not contribute to the\n    kind of Proxy 'True. Therefore,\n    injective_vars_of_binder(forall {k}. ...) = {}.\n  - Required binders are injective positions. For example, in this data type:\n\n      data Wurble k (a :: k) :: k\n      Wurble :: forall k -> k -> k\n\n  The first tyvar binder (of kind `forall k`) has required visibility, so if\n  we had Wurble (Maybe a) Nothing, then the kind of Maybe a would\n  contribute to the kind of Wurble (Maybe a) Nothing. Hence,\n  injective_vars_of_binder(forall a -> ...) = {a}.\n  - Specified binders /might/ be injective positions, depending on how you\n    approach things. Continuing the '(:) example:\n\n      '(:) :: forall a. a -> [a] -> [a]\n\n    Normally, the (forall a. ...) tyvar binder wouldn't contribute to the kind\n    of '(:) 'True '[], since it's not explicitly instantiated by the user. But\n    if visible kind application is enabled, then this is possible, since the\n    user can write '(:) @Bool 'True '[]. (In that case,\n    injective_vars_of_binder(forall a. ...) = {a}.)\n\n    There are some situations where using visible kind application is appropriate\n    (e.g., HsUtils.typeToLHsType) and others where it is not (e.g., TH\n    reification), so the `injective_vars_of_binder` function is parametrized by\n    a Bool which decides if specified binders should be counted towards\n    injective positions or not.\n\nNow that we've defined injective_vars_of_binder, we can refine the Question We\nMust Answer once more:\n\n* Given the first n arguments of T (ty_1 ... ty_n), consider the binders\n  of T that are instantiated by non-omitted arguments. For each such binder\n  b_i, take the union of all injective_vars_of_binder(b_i). Is this set a\n  superset of the free variables of the remainder of T's kind?\n\nIf the answer to this question is \"no\", then (T ty_1 ... ty_n) needs an\nexplicit kind signature, since T's kind has kind variables leftover that\naren't fixed by the non-omitted arguments.\n\nOne last sticking point: what does \"the remainder of T's kind\" mean? You might\nbe tempted to think that it corresponds to all of the arguments in the kind of\nT that would normally be instantiated by omitted arguments. But this isn't\nquite right, strictly speaking. Consider the following (silly) example:\n\n  S :: forall {k}. Type -> Type\n\nAnd suppose we have this application of S:\n\n  S Int Bool\n\nThe Int argument would be omitted, and\ninjective_vars_of_binder(_ :: Type) = {}. This is not a superset of {k}, which\nmight suggest that (S Bool) needs an explicit kind signature. But\n(S Bool :: Type) doesn't actually fix `k`! This is because the kind signature\nonly affects the /result/ of the application, not all of the individual\narguments. So adding a kind signature here won't make a difference. Therefore,\nthe fourth (and final) iteration of the Question We Must Answer is:\n\n* Given the first n arguments of T (ty_1 ... ty_n), consider the binders\n  of T that are instantiated by non-omitted arguments. For each such binder\n  b_i, take the union of all injective_vars_of_binder(b_i). Is this set a\n  superset of the free variables of the kind of (T ty_1 ... ty_n)?\n\nPhew, that was a lot of work!\n\nHow can be sure that this is correct? That is, how can we be sure that in the\nevent that we leave off a kind annotation, that one could infer the kind of the\ntycon application from its arguments? It's essentially a proof by induction: if\nwe can infer the kinds of every subtree of a type, then the whole tycon\napplication will have an inferrable kind--unless, of course, the remainder of\nthe tycon application's kind has uninstantiated kind variables.\n\nWhat happens if T is oversaturated? That is, if T's kind has fewer than n\narguments, in the case that the concrete application instantiates a result\nkind variable with an arrow kind? If we run out of arguments, we do not attach\na kind annotation. This should be a rare case, indeed. Here is an example:\n\n   data T1 :: k1 -> k2 -> *\n   data T2 :: k1 -> k2 -> *\n\n   type family G (a :: k) :: k\n   type instance G T1 = T2\n\n   type instance F Char = (G T1 Bool :: (* -> *) -> *)   -- F from above\n\nHere G's kind is (forall k. k -> k), and the desugared RHS of that last\ninstance of F is (G (* -> (* -> *) -> *) (T1 * (* -> *)) Bool). According to\nthe algorithm above, there are 3 arguments to G so we should peel off 3\narguments in G's kind. But G's kind has only two arguments. This is the\nrare special case, and we choose not to annotate the application of G with\na kind signature. After all, we needn't do this, since that instance would\nbe reified as:\n\n   type instance F Char = G (T1 :: * -> (* -> *) -> *) Bool\n\nSo the kind of G isn't ambiguous anymore due to the explicit kind annotation\non its argument. See #8953 and test th/T8953.\n-}\n\n------------- No free vars -----------------\n\n-- | Returns True if this type has no free variables. Should be the same as\n-- isEmptyVarSet . tyCoVarsOfType, but faster in the non-forall case.\nnoFreeVarsOfType :: Type -> Bool\nnoFreeVarsOfType (TyVarTy _)      = False\nnoFreeVarsOfType (AppTy t1 t2)    = noFreeVarsOfType t1 && noFreeVarsOfType t2\nnoFreeVarsOfType (TyConApp _ tys) = all noFreeVarsOfType tys\nnoFreeVarsOfType ty@(ForAllTy {}) = isEmptyVarSet (tyCoVarsOfType ty)\nnoFreeVarsOfType (FunTy _ t1 t2)  = noFreeVarsOfType t1 && noFreeVarsOfType t2\nnoFreeVarsOfType (LitTy _)        = True\nnoFreeVarsOfType (CastTy ty co)   = noFreeVarsOfType ty && noFreeVarsOfCo co\nnoFreeVarsOfType (CoercionTy co)  = noFreeVarsOfCo co\n\nnoFreeVarsOfMCo :: MCoercion -> Bool\nnoFreeVarsOfMCo MRefl    = True\nnoFreeVarsOfMCo (MCo co) = noFreeVarsOfCo co\n\nnoFreeVarsOfTypes :: [Type] -> Bool\nnoFreeVarsOfTypes = all noFreeVarsOfType\n\n-- | Returns True if this coercion has no free variables. Should be the same as\n-- isEmptyVarSet . tyCoVarsOfCo, but faster in the non-forall case.\nnoFreeVarsOfCo :: Coercion -> Bool\nnoFreeVarsOfCo (Refl ty)              = noFreeVarsOfType ty\nnoFreeVarsOfCo (GRefl _ ty co)        = noFreeVarsOfType ty && noFreeVarsOfMCo co\nnoFreeVarsOfCo (TyConAppCo _ _ args)  = all noFreeVarsOfCo args\nnoFreeVarsOfCo (AppCo c1 c2)          = noFreeVarsOfCo c1 && noFreeVarsOfCo c2\nnoFreeVarsOfCo co@(ForAllCo {})       = isEmptyVarSet (tyCoVarsOfCo co)\nnoFreeVarsOfCo (FunCo _ c1 c2)        = noFreeVarsOfCo c1 && noFreeVarsOfCo c2\nnoFreeVarsOfCo (CoVarCo _)            = False\nnoFreeVarsOfCo (HoleCo {})            = True    -- I'm unsure; probably never happens\nnoFreeVarsOfCo (AxiomInstCo _ _ args) = all noFreeVarsOfCo args\nnoFreeVarsOfCo (UnivCo p _ t1 t2)     = noFreeVarsOfProv p &&\n                                        noFreeVarsOfType t1 &&\n                                        noFreeVarsOfType t2\nnoFreeVarsOfCo (SymCo co)             = noFreeVarsOfCo co\nnoFreeVarsOfCo (TransCo co1 co2)      = noFreeVarsOfCo co1 && noFreeVarsOfCo co2\nnoFreeVarsOfCo (NthCo _ _ co)         = noFreeVarsOfCo co\nnoFreeVarsOfCo (LRCo _ co)            = noFreeVarsOfCo co\nnoFreeVarsOfCo (InstCo co1 co2)       = noFreeVarsOfCo co1 && noFreeVarsOfCo co2\nnoFreeVarsOfCo (KindCo co)            = noFreeVarsOfCo co\nnoFreeVarsOfCo (SubCo co)             = noFreeVarsOfCo co\nnoFreeVarsOfCo (AxiomRuleCo _ cs)     = all noFreeVarsOfCo cs\n\n-- | Returns True if this UnivCoProv has no free variables. Should be the same as\n-- isEmptyVarSet . tyCoVarsOfProv, but faster in the non-forall case.\nnoFreeVarsOfProv :: UnivCoProvenance -> Bool\nnoFreeVarsOfProv UnsafeCoerceProv    = True\nnoFreeVarsOfProv (PhantomProv co)    = noFreeVarsOfCo co\nnoFreeVarsOfProv (ProofIrrelProv co) = noFreeVarsOfCo co\nnoFreeVarsOfProv (PluginProv {})     = True\n\n{-\n%************************************************************************\n%*                                                                      *\n                        Substitutions\n      Data type defined here to avoid unnecessary mutual recursion\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | Type & coercion substitution\n--\n-- #tcvsubst_invariant#\n-- The following invariants must hold of a 'TCvSubst':\n--\n-- 1. The in-scope set is needed /only/ to\n-- guide the generation of fresh uniques\n--\n-- 2. In particular, the /kind/ of the type variables in\n-- the in-scope set is not relevant\n--\n-- 3. The substitution is only applied ONCE! This is because\n-- in general such application will not reach a fixed point.\ndata TCvSubst\n  = TCvSubst InScopeSet -- The in-scope type and kind variables\n             TvSubstEnv -- Substitutes both type and kind variables\n             CvSubstEnv -- Substitutes coercion variables\n        -- See Note [Substitutions apply only once]\n        -- and Note [Extending the TvSubstEnv]\n        -- and Note [Substituting types and coercions]\n        -- and Note [The substitution invariant]\n\n-- | A substitution of 'Type's for 'TyVar's\n--                 and 'Kind's for 'KindVar's\ntype TvSubstEnv = TyVarEnv Type\n  -- NB: A TvSubstEnv is used\n  --   both inside a TCvSubst (with the apply-once invariant\n  --        discussed in Note [Substitutions apply only once],\n  --   and  also independently in the middle of matching,\n  --        and unification (see Types.Unify).\n  -- So you have to look at the context to know if it's idempotent or\n  -- apply-once or whatever\n\n-- | A substitution of 'Coercion's for 'CoVar's\ntype CvSubstEnv = CoVarEnv Coercion\n\n{- Note [The substitution invariant]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen calling (substTy subst ty) it should be the case that\nthe in-scope set in the substitution is a superset of both:\n\n  (SIa) The free vars of the range of the substitution\n  (SIb) The free vars of ty minus the domain of the substitution\n\nThe same rules apply to other substitutions (notably CoreSubst.Subst)\n\n* Reason for (SIa). Consider\n      substTy [a :-> Maybe b] (forall b. b->a)\n  we must rename the forall b, to get\n      forall b2. b2 -> Maybe b\n  Making 'b' part of the in-scope set forces this renaming to\n  take place.\n\n* Reason for (SIb). Consider\n     substTy [a :-> Maybe b] (forall b. (a,b,x))\n  Then if we use the in-scope set {b}, satisfying (SIa), there is\n  a danger we will rename the forall'd variable to 'x' by mistake,\n  getting this:\n      forall x. (Maybe b, x, x)\n  Breaking (SIb) caused the bug from #11371.\n\nNote: if the free vars of the range of the substitution are freshly created,\nthen the problems of (SIa) can't happen, and so it would be sound to\nignore (SIa).\n\nNote [Substitutions apply only once]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe use TCvSubsts to instantiate things, and we might instantiate\n        forall a b. ty\nwith the types\n        [a, b], or [b, a].\nSo the substitution might go [a->b, b->a].  A similar situation arises in Core\nwhen we find a beta redex like\n        (/\\ a /\\ b -> e) b a\nThen we also end up with a substitution that permutes type variables. Other\nvariations happen to; for example [a -> (a, b)].\n\n        ********************************************************\n        *** So a substitution must be applied precisely once ***\n        ********************************************************\n\nA TCvSubst is not idempotent, but, unlike the non-idempotent substitution\nwe use during unifications, it must not be repeatedly applied.\n\nNote [Extending the TvSubstEnv]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSee #tcvsubst_invariant# for the invariants that must hold.\n\nThis invariant allows a short-cut when the subst envs are empty:\nif the TvSubstEnv and CvSubstEnv are empty --- i.e. (isEmptyTCvSubst subst)\nholds --- then (substTy subst ty) does nothing.\n\nFor example, consider:\n        (/\\a. /\\b:(a~Int). ...b..) Int\nWe substitute Int for 'a'.  The Unique of 'b' does not change, but\nnevertheless we add 'b' to the TvSubstEnv, because b's kind does change\n\nThis invariant has several crucial consequences:\n\n* In substVarBndr, we need extend the TvSubstEnv\n        - if the unique has changed\n        - or if the kind has changed\n\n* In substTyVar, we do not need to consult the in-scope set;\n  the TvSubstEnv is enough\n\n* In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty\n\nNote [Substituting types and coercions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTypes and coercions are mutually recursive, and either may have variables\n\"belonging\" to the other. Thus, every time we wish to substitute in a\ntype, we may also need to substitute in a coercion, and vice versa.\nHowever, the constructor used to create type variables is distinct from\nthat of coercion variables, so we carry two VarEnvs in a TCvSubst. Note\nthat it would be possible to use the CoercionTy constructor to combine\nthese environments, but that seems like a false economy.\n\nNote that the TvSubstEnv should *never* map a CoVar (built with the Id\nconstructor) and the CvSubstEnv should *never* map a TyVar. Furthermore,\nthe range of the TvSubstEnv should *never* include a type headed with\nCoercionTy.\n-}\n\nemptyTvSubstEnv :: TvSubstEnv\nemptyTvSubstEnv = emptyVarEnv\n\nemptyCvSubstEnv :: CvSubstEnv\nemptyCvSubstEnv = emptyVarEnv\n\ncomposeTCvSubstEnv :: InScopeSet\n                   -> (TvSubstEnv, CvSubstEnv)\n                   -> (TvSubstEnv, CvSubstEnv)\n                   -> (TvSubstEnv, CvSubstEnv)\n-- ^ @(compose env1 env2)(x)@ is @env1(env2(x))@; i.e. apply @env2@ then @env1@.\n-- It assumes that both are idempotent.\n-- Typically, @env1@ is the refinement to a base substitution @env2@\ncomposeTCvSubstEnv in_scope (tenv1, cenv1) (tenv2, cenv2)\n  = ( tenv1 `plusVarEnv` mapVarEnv (substTy subst1) tenv2\n    , cenv1 `plusVarEnv` mapVarEnv (substCo subst1) cenv2 )\n        -- First apply env1 to the range of env2\n        -- Then combine the two, making sure that env1 loses if\n        -- both bind the same variable; that's why env1 is the\n        --  *left* argument to plusVarEnv, because the right arg wins\n  where\n    subst1 = TCvSubst in_scope tenv1 cenv1\n\n-- | Composes two substitutions, applying the second one provided first,\n-- like in function composition.\ncomposeTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst\ncomposeTCvSubst (TCvSubst is1 tenv1 cenv1) (TCvSubst is2 tenv2 cenv2)\n  = TCvSubst is3 tenv3 cenv3\n  where\n    is3 = is1 `unionInScope` is2\n    (tenv3, cenv3) = composeTCvSubstEnv is3 (tenv1, cenv1) (tenv2, cenv2)\n\nemptyTCvSubst :: TCvSubst\nemptyTCvSubst = TCvSubst emptyInScopeSet emptyTvSubstEnv emptyCvSubstEnv\n\nmkEmptyTCvSubst :: InScopeSet -> TCvSubst\nmkEmptyTCvSubst is = TCvSubst is emptyTvSubstEnv emptyCvSubstEnv\n\nisEmptyTCvSubst :: TCvSubst -> Bool\n         -- See Note [Extending the TvSubstEnv]\nisEmptyTCvSubst (TCvSubst _ tenv cenv) = isEmptyVarEnv tenv && isEmptyVarEnv cenv\n\nmkTCvSubst :: InScopeSet -> (TvSubstEnv, CvSubstEnv) -> TCvSubst\nmkTCvSubst in_scope (tenv, cenv) = TCvSubst in_scope tenv cenv\n\nmkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst\n-- ^ Make a TCvSubst with specified tyvar subst and empty covar subst\nmkTvSubst in_scope tenv = TCvSubst in_scope tenv emptyCvSubstEnv\n\nmkCvSubst :: InScopeSet -> CvSubstEnv -> TCvSubst\n-- ^ Make a TCvSubst with specified covar subst and empty tyvar subst\nmkCvSubst in_scope cenv = TCvSubst in_scope emptyTvSubstEnv cenv\n\ngetTvSubstEnv :: TCvSubst -> TvSubstEnv\ngetTvSubstEnv (TCvSubst _ env _) = env\n\ngetCvSubstEnv :: TCvSubst -> CvSubstEnv\ngetCvSubstEnv (TCvSubst _ _ env) = env\n\ngetTCvInScope :: TCvSubst -> InScopeSet\ngetTCvInScope (TCvSubst in_scope _ _) = in_scope\n\n-- | Returns the free variables of the types in the range of a substitution as\n-- a non-deterministic set.\ngetTCvSubstRangeFVs :: TCvSubst -> VarSet\ngetTCvSubstRangeFVs (TCvSubst _ tenv cenv)\n    = unionVarSet tenvFVs cenvFVs\n  where\n    tenvFVs = tyCoVarsOfTypesSet tenv\n    cenvFVs = tyCoVarsOfCosSet cenv\n\nisInScope :: Var -> TCvSubst -> Bool\nisInScope v (TCvSubst in_scope _ _) = v `elemInScopeSet` in_scope\n\nnotElemTCvSubst :: Var -> TCvSubst -> Bool\nnotElemTCvSubst v (TCvSubst _ tenv cenv)\n  | isTyVar v\n  = not (v `elemVarEnv` tenv)\n  | otherwise\n  = not (v `elemVarEnv` cenv)\n\nsetTvSubstEnv :: TCvSubst -> TvSubstEnv -> TCvSubst\nsetTvSubstEnv (TCvSubst in_scope _ cenv) tenv = TCvSubst in_scope tenv cenv\n\nsetCvSubstEnv :: TCvSubst -> CvSubstEnv -> TCvSubst\nsetCvSubstEnv (TCvSubst in_scope tenv _) cenv = TCvSubst in_scope tenv cenv\n\nzapTCvSubst :: TCvSubst -> TCvSubst\nzapTCvSubst (TCvSubst in_scope _ _) = TCvSubst in_scope emptyVarEnv emptyVarEnv\n\nextendTCvInScope :: TCvSubst -> Var -> TCvSubst\nextendTCvInScope (TCvSubst in_scope tenv cenv) var\n  = TCvSubst (extendInScopeSet in_scope var) tenv cenv\n\nextendTCvInScopeList :: TCvSubst -> [Var] -> TCvSubst\nextendTCvInScopeList (TCvSubst in_scope tenv cenv) vars\n  = TCvSubst (extendInScopeSetList in_scope vars) tenv cenv\n\nextendTCvInScopeSet :: TCvSubst -> VarSet -> TCvSubst\nextendTCvInScopeSet (TCvSubst in_scope tenv cenv) vars\n  = TCvSubst (extendInScopeSetSet in_scope vars) tenv cenv\n\nextendTCvSubst :: TCvSubst -> TyCoVar -> Type -> TCvSubst\nextendTCvSubst subst v ty\n  | isTyVar v\n  = extendTvSubst subst v ty\n  | CoercionTy co <- ty\n  = extendCvSubst subst v co\n  | otherwise\n  = pprPanic \"extendTCvSubst\" (ppr v <+> text \"|->\" <+> ppr ty)\n\nextendTCvSubstWithClone :: TCvSubst -> TyCoVar -> TyCoVar -> TCvSubst\nextendTCvSubstWithClone subst tcv\n  | isTyVar tcv = extendTvSubstWithClone subst tcv\n  | otherwise   = extendCvSubstWithClone subst tcv\n\nextendTvSubst :: TCvSubst -> TyVar -> Type -> TCvSubst\nextendTvSubst (TCvSubst in_scope tenv cenv) tv ty\n  = TCvSubst in_scope (extendVarEnv tenv tv ty) cenv\n\nextendTvSubstBinderAndInScope :: TCvSubst -> TyCoBinder -> Type -> TCvSubst\nextendTvSubstBinderAndInScope subst (Named (Bndr v _)) ty\n  = ASSERT( isTyVar v )\n    extendTvSubstAndInScope subst v ty\nextendTvSubstBinderAndInScope subst (Anon {}) _\n  = subst\n\nextendTvSubstWithClone :: TCvSubst -> TyVar -> TyVar -> TCvSubst\n-- Adds a new tv -> tv mapping, /and/ extends the in-scope set\nextendTvSubstWithClone (TCvSubst in_scope tenv cenv) tv tv'\n  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)\n             (extendVarEnv tenv tv (mkTyVarTy tv'))\n             cenv\n  where\n    new_in_scope = tyCoVarsOfType (tyVarKind tv') `extendVarSet` tv'\n\nextendCvSubst :: TCvSubst -> CoVar -> Coercion -> TCvSubst\nextendCvSubst (TCvSubst in_scope tenv cenv) v co\n  = TCvSubst in_scope tenv (extendVarEnv cenv v co)\n\nextendCvSubstWithClone :: TCvSubst -> CoVar -> CoVar -> TCvSubst\nextendCvSubstWithClone (TCvSubst in_scope tenv cenv) cv cv'\n  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)\n             tenv\n             (extendVarEnv cenv cv (mkCoVarCo cv'))\n  where\n    new_in_scope = tyCoVarsOfType (varType cv') `extendVarSet` cv'\n\nextendTvSubstAndInScope :: TCvSubst -> TyVar -> Type -> TCvSubst\n-- Also extends the in-scope set\nextendTvSubstAndInScope (TCvSubst in_scope tenv cenv) tv ty\n  = TCvSubst (in_scope `extendInScopeSetSet` tyCoVarsOfType ty)\n             (extendVarEnv tenv tv ty)\n             cenv\n\nextendTvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst\nextendTvSubstList subst tvs tys\n  = foldl2 extendTvSubst subst tvs tys\n\nextendTCvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst\nextendTCvSubstList subst tvs tys\n  = foldl2 extendTCvSubst subst tvs tys\n\nunionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst\n-- Works when the ranges are disjoint\nunionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2)\n  = ASSERT( not (tenv1 `intersectsVarEnv` tenv2)\n         && not (cenv1 `intersectsVarEnv` cenv2) )\n    TCvSubst (in_scope1 `unionInScope` in_scope2)\n             (tenv1     `plusVarEnv`   tenv2)\n             (cenv1     `plusVarEnv`   cenv2)\n\n-- mkTvSubstPrs and zipTvSubst generate the in-scope set from\n-- the types given; but it's just a thunk so with a bit of luck\n-- it'll never be evaluated\n\n-- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming\n-- environment. No CoVars, please!\nzipTvSubst :: [TyVar] -> [Type] -> TCvSubst\nzipTvSubst tvs tys\n  | debugIsOn\n  , not (all isTyVar tvs) || neLength tvs tys\n  = pprTrace \"zipTvSubst\" (ppr tvs $$ ppr tys) emptyTCvSubst\n  | otherwise\n  = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv\n  where\n    tenv = zipTyEnv tvs tys\n\n-- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming\n-- environment.  No TyVars, please!\nzipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst\nzipCvSubst cvs cos\n  | debugIsOn\n  , not (all isCoVar cvs) || neLength cvs cos\n  = pprTrace \"zipCvSubst\" (ppr cvs $$ ppr cos) emptyTCvSubst\n  | otherwise\n  = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv\n  where\n    cenv = zipCoEnv cvs cos\n\nzipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst\nzipTCvSubst tcvs tys\n  | debugIsOn\n  , neLength tcvs tys\n  = pprTrace \"zipTCvSubst\" (ppr tcvs $$ ppr tys) emptyTCvSubst\n  | otherwise\n  = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys))\n  where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst\n        zip_tcvsubst (tv:tvs) (ty:tys) subst\n          = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty)\n        zip_tcvsubst _ _ subst = subst -- empty case\n\n-- | Generates the in-scope set for the 'TCvSubst' from the types in the\n-- incoming environment. No CoVars, please!\nmkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst\nmkTvSubstPrs prs =\n    ASSERT2( onlyTyVarsAndNoCoercionTy, text \"prs\" <+> ppr prs )\n    mkTvSubst in_scope tenv\n  where tenv = mkVarEnv prs\n        in_scope = mkInScopeSet $ tyCoVarsOfTypes $ map snd prs\n        onlyTyVarsAndNoCoercionTy =\n          and [ isTyVar tv && not (isCoercionTy ty)\n              | (tv, ty) <- prs ]\n\nzipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv\nzipTyEnv tyvars tys\n  = ASSERT( all (not . isCoercionTy) tys )\n    mkVarEnv (zipEqual \"zipTyEnv\" tyvars tys)\n        -- There used to be a special case for when\n        --      ty == TyVarTy tv\n        -- (a not-uncommon case) in which case the substitution was dropped.\n        -- But the type-tidier changes the print-name of a type variable without\n        -- changing the unique, and that led to a bug.   Why?  Pre-tidying, we had\n        -- a type {Foo t}, where Foo is a one-method class.  So Foo is really a newtype.\n        -- And it happened that t was the type variable of the class.  Post-tiding,\n        -- it got turned into {Foo t2}.  The ext-core printer expanded this using\n        -- sourceTypeRep, but that said \"Oh, t == t2\" because they have the same unique,\n        -- and so generated a rep type mentioning t not t2.\n        --\n        -- Simplest fix is to nuke the \"optimisation\"\n\nzipCoEnv :: [CoVar] -> [Coercion] -> CvSubstEnv\nzipCoEnv cvs cos = mkVarEnv (zipEqual \"zipCoEnv\" cvs cos)\n\ninstance Outputable TCvSubst where\n  ppr (TCvSubst ins tenv cenv)\n    = brackets $ sep[ text \"TCvSubst\",\n                      nest 2 (text \"In scope:\" <+> ppr ins),\n                      nest 2 (text \"Type env:\" <+> ppr tenv),\n                      nest 2 (text \"Co env:\" <+> ppr cenv) ]\n\n{-\n%************************************************************************\n%*                                                                      *\n                Performing type or kind substitutions\n%*                                                                      *\n%************************************************************************\n\nNote [Sym and ForAllCo]\n~~~~~~~~~~~~~~~~~~~~~~~\nIn OptCoercion, we try to push \"sym\" out to the leaves of a coercion. But,\nhow do we push sym into a ForAllCo? It's a little ugly.\n\nHere is the typing rule:\n\nh : k1 ~# k2\n(tv : k1) |- g : ty1 ~# ty2\n----------------------------\nForAllCo tv h g : (ForAllTy (tv : k1) ty1) ~#\n                  (ForAllTy (tv : k2) (ty2[tv |-> tv |> sym h]))\n\nHere is what we want:\n\nForAllCo tv h' g' : (ForAllTy (tv : k2) (ty2[tv |-> tv |> sym h])) ~#\n                    (ForAllTy (tv : k1) ty1)\n\n\nBecause the kinds of the type variables to the right of the colon are the kinds\ncoerced by h', we know (h' : k2 ~# k1). Thus, (h' = sym h).\n\nNow, we can rewrite ty1 to be (ty1[tv |-> tv |> sym h' |> h']). We thus want\n\nForAllCo tv h' g' :\n  (ForAllTy (tv : k2) (ty2[tv |-> tv |> h'])) ~#\n  (ForAllTy (tv : k1) (ty1[tv |-> tv |> h'][tv |-> tv |> sym h']))\n\nWe thus see that we want\n\ng' : ty2[tv |-> tv |> h'] ~# ty1[tv |-> tv |> h']\n\nand thus g' = sym (g[tv |-> tv |> h']).\n\nPutting it all together, we get this:\n\nsym (ForAllCo tv h g)\n==>\nForAllCo tv (sym h) (sym g[tv |-> tv |> sym h])\n\nNote [Substituting in a coercion hole]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIt seems highly suspicious to be substituting in a coercion that still\nhas coercion holes. Yet, this can happen in a situation like this:\n\n  f :: forall k. k :~: Type -> ()\n  f Refl = let x :: forall (a :: k). [a] -> ...\n               x = ...\n\nWhen we check x's type signature, we require that k ~ Type. We indeed\nknow this due to the Refl pattern match, but the eager unifier can't\nmake use of givens. So, when we're done looking at x's type, a coercion\nhole will remain. Then, when we're checking x's definition, we skolemise\nx's type (in order to, e.g., bring the scoped type variable `a` into scope).\nThis requires performing a substitution for the fresh skolem variables.\n\nThis subsitution needs to affect the kind of the coercion hole, too --\notherwise, the kind will have an out-of-scope variable in it. More problematically\nin practice (we won't actually notice the out-of-scope variable ever), skolems\nin the kind might have too high a level, triggering a failure to uphold the\ninvariant that no free variables in a type have a higher level than the\nambient level in the type checker. In the event of having free variables in the\nhole's kind, I'm pretty sure we'll always have an erroneous program, so we\ndon't need to worry what will happen when the hole gets filled in. After all,\na hole relating a locally-bound type variable will be unable to be solved. This\nis why it's OK not to look through the IORef of a coercion hole during\nsubstitution.\n\n-}\n\n-- | Type substitution, see 'zipTvSubst'\nsubstTyWith :: HasCallStack => [TyVar] -> [Type] -> Type -> Type\n-- Works only if the domain of the substitution is a\n-- superset of the type being substituted into\nsubstTyWith tvs tys = {-#SCC \"substTyWith\" #-}\n                      ASSERT( tvs `equalLength` tys )\n                      substTy (zipTvSubst tvs tys)\n\n-- | Type substitution, see 'zipTvSubst'. Disables sanity checks.\n-- The problems that the sanity checks in substTy catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substTyUnchecked to\n-- substTy and remove this function. Please don't use in new code.\nsubstTyWithUnchecked :: [TyVar] -> [Type] -> Type -> Type\nsubstTyWithUnchecked tvs tys\n  = ASSERT( tvs `equalLength` tys )\n    substTyUnchecked (zipTvSubst tvs tys)\n\n-- | Substitute tyvars within a type using a known 'InScopeSet'.\n-- Pre-condition: the 'in_scope' set should satisfy Note [The substitution\n-- invariant]; specifically it should include the free vars of 'tys',\n-- and of 'ty' minus the domain of the subst.\nsubstTyWithInScope :: InScopeSet -> [TyVar] -> [Type] -> Type -> Type\nsubstTyWithInScope in_scope tvs tys ty =\n  ASSERT( tvs `equalLength` tys )\n  substTy (mkTvSubst in_scope tenv) ty\n  where tenv = zipTyEnv tvs tys\n\n-- | Coercion substitution, see 'zipTvSubst'\nsubstCoWith :: HasCallStack => [TyVar] -> [Type] -> Coercion -> Coercion\nsubstCoWith tvs tys = ASSERT( tvs `equalLength` tys )\n                      substCo (zipTvSubst tvs tys)\n\n-- | Coercion substitution, see 'zipTvSubst'. Disables sanity checks.\n-- The problems that the sanity checks in substCo catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substCoUnchecked to\n-- substCo and remove this function. Please don't use in new code.\nsubstCoWithUnchecked :: [TyVar] -> [Type] -> Coercion -> Coercion\nsubstCoWithUnchecked tvs tys\n  = ASSERT( tvs `equalLength` tys )\n    substCoUnchecked (zipTvSubst tvs tys)\n\n\n\n-- | Substitute covars within a type\nsubstTyWithCoVars :: [CoVar] -> [Coercion] -> Type -> Type\nsubstTyWithCoVars cvs cos = substTy (zipCvSubst cvs cos)\n\n-- | Type substitution, see 'zipTvSubst'\nsubstTysWith :: [TyVar] -> [Type] -> [Type] -> [Type]\nsubstTysWith tvs tys = ASSERT( tvs `equalLength` tys )\n                       substTys (zipTvSubst tvs tys)\n\n-- | Type substitution, see 'zipTvSubst'\nsubstTysWithCoVars :: [CoVar] -> [Coercion] -> [Type] -> [Type]\nsubstTysWithCoVars cvs cos = ASSERT( cvs `equalLength` cos )\n                             substTys (zipCvSubst cvs cos)\n\n-- | Substitute within a 'Type' after adding the free variables of the type\n-- to the in-scope set. This is useful for the case when the free variables\n-- aren't already in the in-scope set or easily available.\n-- See also Note [The substitution invariant].\nsubstTyAddInScope :: TCvSubst -> Type -> Type\nsubstTyAddInScope subst ty =\n  substTy (extendTCvInScopeSet subst $ tyCoVarsOfType ty) ty\n\n-- | When calling `substTy` it should be the case that the in-scope set in\n-- the substitution is a superset of the free vars of the range of the\n-- substitution.\n-- See also Note [The substitution invariant].\nisValidTCvSubst :: TCvSubst -> Bool\nisValidTCvSubst (TCvSubst in_scope tenv cenv) =\n  (tenvFVs `varSetInScope` in_scope) &&\n  (cenvFVs `varSetInScope` in_scope)\n  where\n  tenvFVs = tyCoVarsOfTypesSet tenv\n  cenvFVs = tyCoVarsOfCosSet cenv\n\n-- | This checks if the substitution satisfies the invariant from\n-- Note [The substitution invariant].\ncheckValidSubst :: HasCallStack => TCvSubst -> [Type] -> [Coercion] -> a -> a\ncheckValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a\n-- TODO (RAE): Change back to ASSERT\n  = WARN( not (isValidTCvSubst subst),\n             text \"in_scope\" <+> ppr in_scope $$\n             text \"tenv\" <+> ppr tenv $$\n             text \"tenvFVs\" <+> ppr (tyCoVarsOfTypesSet tenv) $$\n             text \"cenv\" <+> ppr cenv $$\n             text \"cenvFVs\" <+> ppr (tyCoVarsOfCosSet cenv) $$\n             text \"tys\" <+> ppr tys $$\n             text \"cos\" <+> ppr cos )\n    WARN( not tysCosFVsInScope,\n             text \"in_scope\" <+> ppr in_scope $$\n             text \"tenv\" <+> ppr tenv $$\n             text \"cenv\" <+> ppr cenv $$\n             text \"tys\" <+> ppr tys $$\n             text \"cos\" <+> ppr cos $$\n             text \"needInScope\" <+> ppr needInScope )\n    a\n  where\n  substDomain = nonDetKeysUFM tenv ++ nonDetKeysUFM cenv\n    -- It's OK to use nonDetKeysUFM here, because we only use this list to\n    -- remove some elements from a set\n  needInScope = (tyCoVarsOfTypes tys `unionVarSet` tyCoVarsOfCos cos)\n                  `delListFromUniqSet_Directly` substDomain\n  tysCosFVsInScope = needInScope `varSetInScope` in_scope\n\n\n-- | Substitute within a 'Type'\n-- The substitution has to satisfy the invariants described in\n-- Note [The substitution invariant].\nsubstTy :: HasCallStack => TCvSubst -> Type  -> Type\nsubstTy subst ty\n  | isEmptyTCvSubst subst = ty\n  | otherwise             = checkValidSubst subst [ty] [] $\n                            subst_ty subst ty\n\n-- | Substitute within a 'Type' disabling the sanity checks.\n-- The problems that the sanity checks in substTy catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substTyUnchecked to\n-- substTy and remove this function. Please don't use in new code.\nsubstTyUnchecked :: TCvSubst -> Type -> Type\nsubstTyUnchecked subst ty\n                 | isEmptyTCvSubst subst = ty\n                 | otherwise             = subst_ty subst ty\n\n-- | Substitute within several 'Type's\n-- The substitution has to satisfy the invariants described in\n-- Note [The substitution invariant].\nsubstTys :: HasCallStack => TCvSubst -> [Type] -> [Type]\nsubstTys subst tys\n  | isEmptyTCvSubst subst = tys\n  | otherwise = checkValidSubst subst tys [] $ map (subst_ty subst) tys\n\n-- | Substitute within several 'Type's disabling the sanity checks.\n-- The problems that the sanity checks in substTys catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substTysUnchecked to\n-- substTys and remove this function. Please don't use in new code.\nsubstTysUnchecked :: TCvSubst -> [Type] -> [Type]\nsubstTysUnchecked subst tys\n                 | isEmptyTCvSubst subst = tys\n                 | otherwise             = map (subst_ty subst) tys\n\n-- | Substitute within a 'ThetaType'\n-- The substitution has to satisfy the invariants described in\n-- Note [The substitution invariant].\nsubstTheta :: HasCallStack => TCvSubst -> ThetaType -> ThetaType\nsubstTheta = substTys\n\n-- | Substitute within a 'ThetaType' disabling the sanity checks.\n-- The problems that the sanity checks in substTys catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substThetaUnchecked to\n-- substTheta and remove this function. Please don't use in new code.\nsubstThetaUnchecked :: TCvSubst -> ThetaType -> ThetaType\nsubstThetaUnchecked = substTysUnchecked\n\n\nsubst_ty :: TCvSubst -> Type -> Type\n-- subst_ty is the main workhorse for type substitution\n--\n-- Note that the in_scope set is poked only if we hit a forall\n-- so it may often never be fully computed\nsubst_ty subst ty\n   = go ty\n  where\n    go (TyVarTy tv)      = substTyVar subst tv\n    go (AppTy fun arg)   = mkAppTy (go fun) $! (go arg)\n                -- The mkAppTy smart constructor is important\n                -- we might be replacing (a Int), represented with App\n                -- by [Int], represented with TyConApp\n    go (TyConApp tc tys) = let args = map go tys\n                           in  args `seqList` TyConApp tc args\n    go ty@(FunTy { ft_arg = arg, ft_res = res })\n      = let !arg' = go arg\n            !res' = go res\n        in ty { ft_arg = arg', ft_res = res' }\n    go (ForAllTy (Bndr tv vis) ty)\n                         = case substVarBndrUnchecked subst tv of\n                             (subst', tv') ->\n                               (ForAllTy $! ((Bndr $! tv') vis)) $!\n                                            (subst_ty subst' ty)\n    go (LitTy n)         = LitTy $! n\n    go (CastTy ty co)    = (mkCastTy $! (go ty)) $! (subst_co subst co)\n    go (CoercionTy co)   = CoercionTy $! (subst_co subst co)\n\nsubstTyVar :: TCvSubst -> TyVar -> Type\nsubstTyVar (TCvSubst _ tenv _) tv\n  = ASSERT( isTyVar tv )\n    case lookupVarEnv tenv tv of\n      Just ty -> ty\n      Nothing -> TyVarTy tv\n\nsubstTyVars :: TCvSubst -> [TyVar] -> [Type]\nsubstTyVars subst = map $ substTyVar subst\n\nsubstTyCoVars :: TCvSubst -> [TyCoVar] -> [Type]\nsubstTyCoVars subst = map $ substTyCoVar subst\n\nsubstTyCoVar :: TCvSubst -> TyCoVar -> Type\nsubstTyCoVar subst tv\n  | isTyVar tv = substTyVar subst tv\n  | otherwise = CoercionTy $ substCoVar subst tv\n\nlookupTyVar :: TCvSubst -> TyVar  -> Maybe Type\n        -- See Note [Extending the TCvSubst]\nlookupTyVar (TCvSubst _ tenv _) tv\n  = ASSERT( isTyVar tv )\n    lookupVarEnv tenv tv\n\n-- | Substitute within a 'Coercion'\n-- The substitution has to satisfy the invariants described in\n-- Note [The substitution invariant].\nsubstCo :: HasCallStack => TCvSubst -> Coercion -> Coercion\nsubstCo subst co\n  | isEmptyTCvSubst subst = co\n  | otherwise = checkValidSubst subst [] [co] $ subst_co subst co\n\n-- | Substitute within a 'Coercion' disabling sanity checks.\n-- The problems that the sanity checks in substCo catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substCoUnchecked to\n-- substCo and remove this function. Please don't use in new code.\nsubstCoUnchecked :: TCvSubst -> Coercion -> Coercion\nsubstCoUnchecked subst co\n  | isEmptyTCvSubst subst = co\n  | otherwise = subst_co subst co\n\n-- | Substitute within several 'Coercion's\n-- The substitution has to satisfy the invariants described in\n-- Note [The substitution invariant].\nsubstCos :: HasCallStack => TCvSubst -> [Coercion] -> [Coercion]\nsubstCos subst cos\n  | isEmptyTCvSubst subst = cos\n  | otherwise = checkValidSubst subst [] cos $ map (subst_co subst) cos\n\nsubst_co :: TCvSubst -> Coercion -> Coercion\nsubst_co subst co\n  = go co\n  where\n    go_ty :: Type -> Type\n    go_ty = subst_ty subst\n\n    go_mco :: MCoercion -> MCoercion\n    go_mco MRefl    = MRefl\n    go_mco (MCo co) = MCo (go co)\n\n    go :: Coercion -> Coercion\n    go (Refl ty)             = mkNomReflCo $! (go_ty ty)\n    go (GRefl r ty mco)      = (mkGReflCo r $! (go_ty ty)) $! (go_mco mco)\n    go (TyConAppCo r tc args)= let args' = map go args\n                               in  args' `seqList` mkTyConAppCo r tc args'\n    go (AppCo co arg)        = (mkAppCo $! go co) $! go arg\n    go (ForAllCo tv kind_co co)\n      = case substForAllCoBndrUnchecked subst tv kind_co of\n         (subst', tv', kind_co') ->\n          ((mkForAllCo $! tv') $! kind_co') $! subst_co subst' co\n    go (FunCo r co1 co2)     = (mkFunCo r $! go co1) $! go co2\n    go (CoVarCo cv)          = substCoVar subst cv\n    go (AxiomInstCo con ind cos) = mkAxiomInstCo con ind $! map go cos\n    go (UnivCo p r t1 t2)    = (((mkUnivCo $! go_prov p) $! r) $!\n                                (go_ty t1)) $! (go_ty t2)\n    go (SymCo co)            = mkSymCo $! (go co)\n    go (TransCo co1 co2)     = (mkTransCo $! (go co1)) $! (go co2)\n    go (NthCo r d co)        = mkNthCo r d $! (go co)\n    go (LRCo lr co)          = mkLRCo lr $! (go co)\n    go (InstCo co arg)       = (mkInstCo $! (go co)) $! go arg\n    go (KindCo co)           = mkKindCo $! (go co)\n    go (SubCo co)            = mkSubCo $! (go co)\n    go (AxiomRuleCo c cs)    = let cs1 = map go cs\n                                in cs1 `seqList` AxiomRuleCo c cs1\n    go (HoleCo h)            = HoleCo $! go_hole h\n\n    go_prov UnsafeCoerceProv     = UnsafeCoerceProv\n    go_prov (PhantomProv kco)    = PhantomProv (go kco)\n    go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco)\n    go_prov p@(PluginProv _)     = p\n\n    -- See Note [Substituting in a coercion hole]\n    go_hole h@(CoercionHole { ch_co_var = cv })\n      = h { ch_co_var = updateVarType go_ty cv }\n\nsubstForAllCoBndr :: TCvSubst -> TyCoVar -> KindCoercion\n                  -> (TCvSubst, TyCoVar, Coercion)\nsubstForAllCoBndr subst\n  = substForAllCoBndrUsing False (substCo subst) subst\n\n-- | Like 'substForAllCoBndr', but disables sanity checks.\n-- The problems that the sanity checks in substCo catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substCoUnchecked to\n-- substCo and remove this function. Please don't use in new code.\nsubstForAllCoBndrUnchecked :: TCvSubst -> TyCoVar -> KindCoercion\n                           -> (TCvSubst, TyCoVar, Coercion)\nsubstForAllCoBndrUnchecked subst\n  = substForAllCoBndrUsing False (substCoUnchecked subst) subst\n\n-- See Note [Sym and ForAllCo]\nsubstForAllCoBndrUsing :: Bool  -- apply sym to binder?\n                       -> (Coercion -> Coercion)  -- transformation to kind co\n                       -> TCvSubst -> TyCoVar -> KindCoercion\n                       -> (TCvSubst, TyCoVar, KindCoercion)\nsubstForAllCoBndrUsing sym sco subst old_var\n  | isTyVar old_var = substForAllCoTyVarBndrUsing sym sco subst old_var\n  | otherwise       = substForAllCoCoVarBndrUsing sym sco subst old_var\n\nsubstForAllCoTyVarBndrUsing :: Bool  -- apply sym to binder?\n                            -> (Coercion -> Coercion)  -- transformation to kind co\n                            -> TCvSubst -> TyVar -> KindCoercion\n                            -> (TCvSubst, TyVar, KindCoercion)\nsubstForAllCoTyVarBndrUsing sym sco (TCvSubst in_scope tenv cenv) old_var old_kind_co\n  = ASSERT( isTyVar old_var )\n    ( TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv\n    , new_var, new_kind_co )\n  where\n    new_env | no_change && not sym = delVarEnv tenv old_var\n            | sym       = extendVarEnv tenv old_var $\n                          TyVarTy new_var `CastTy` new_kind_co\n            | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)\n\n    no_kind_change = noFreeVarsOfCo old_kind_co\n    no_change = no_kind_change && (new_var == old_var)\n\n    new_kind_co | no_kind_change = old_kind_co\n                | otherwise      = sco old_kind_co\n\n    Pair new_ki1 _ = coercionKind new_kind_co\n    -- We could do substitution to (tyVarKind old_var). We don't do so because\n    -- we already substituted new_kind_co, which contains the kind information\n    -- we want. We don't want to do substitution once more. Also, in most cases,\n    -- new_kind_co is a Refl, in which case coercionKind is really fast.\n\n    new_var  = uniqAway in_scope (setTyVarKind old_var new_ki1)\n\nsubstForAllCoCoVarBndrUsing :: Bool  -- apply sym to binder?\n                            -> (Coercion -> Coercion)  -- transformation to kind co\n                            -> TCvSubst -> CoVar -> KindCoercion\n                            -> (TCvSubst, CoVar, KindCoercion)\nsubstForAllCoCoVarBndrUsing sym sco (TCvSubst in_scope tenv cenv)\n                            old_var old_kind_co\n  = ASSERT( isCoVar old_var )\n    ( TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv\n    , new_var, new_kind_co )\n  where\n    new_cenv | no_change && not sym = delVarEnv cenv old_var\n             | otherwise = extendVarEnv cenv old_var (mkCoVarCo new_var)\n\n    no_kind_change = noFreeVarsOfCo old_kind_co\n    no_change = no_kind_change && (new_var == old_var)\n\n    new_kind_co | no_kind_change = old_kind_co\n                | otherwise      = sco old_kind_co\n\n    Pair h1 h2 = coercionKind new_kind_co\n\n    new_var       = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type\n    new_var_type  | sym       = h2\n                  | otherwise = h1\n\nsubstCoVar :: TCvSubst -> CoVar -> Coercion\nsubstCoVar (TCvSubst _ _ cenv) cv\n  = case lookupVarEnv cenv cv of\n      Just co -> co\n      Nothing -> CoVarCo cv\n\nsubstCoVars :: TCvSubst -> [CoVar] -> [Coercion]\nsubstCoVars subst cvs = map (substCoVar subst) cvs\n\nlookupCoVar :: TCvSubst -> Var -> Maybe Coercion\nlookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v\n\nsubstTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar)\nsubstTyVarBndr = substTyVarBndrUsing substTy\n\nsubstTyVarBndrs :: HasCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])\nsubstTyVarBndrs = mapAccumL substTyVarBndr\n\nsubstVarBndr :: HasCallStack => TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)\nsubstVarBndr = substVarBndrUsing substTy\n\nsubstVarBndrs :: HasCallStack => TCvSubst -> [TyCoVar] -> (TCvSubst, [TyCoVar])\nsubstVarBndrs = mapAccumL substVarBndr\n\nsubstCoVarBndr :: HasCallStack => TCvSubst -> CoVar -> (TCvSubst, CoVar)\nsubstCoVarBndr = substCoVarBndrUsing substTy\n\n-- | Like 'substVarBndr', but disables sanity checks.\n-- The problems that the sanity checks in substTy catch are described in\n-- Note [The substitution invariant].\n-- The goal of #11371 is to migrate all the calls of substTyUnchecked to\n-- substTy and remove this function. Please don't use in new code.\nsubstVarBndrUnchecked :: TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)\nsubstVarBndrUnchecked = substVarBndrUsing substTyUnchecked\n\nsubstVarBndrUsing :: (TCvSubst -> Type -> Type)\n                  -> TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)\nsubstVarBndrUsing subst_fn subst v\n  | isTyVar v = substTyVarBndrUsing subst_fn subst v\n  | otherwise = substCoVarBndrUsing subst_fn subst v\n\n-- | Substitute a tyvar in a binding position, returning an\n-- extended subst and a new tyvar.\n-- Use the supplied function to substitute in the kind\nsubstTyVarBndrUsing\n  :: (TCvSubst -> Type -> Type)  -- ^ Use this to substitute in the kind\n  -> TCvSubst -> TyVar -> (TCvSubst, TyVar)\nsubstTyVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var\n  = ASSERT2( _no_capture, pprTyVar old_var $$ pprTyVar new_var $$ ppr subst )\n    ASSERT( isTyVar old_var )\n    (TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv, new_var)\n  where\n    new_env | no_change = delVarEnv tenv old_var\n            | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)\n\n    _no_capture = not (new_var `elemVarSet` tyCoVarsOfTypesSet tenv)\n    -- Assertion check that we are not capturing something in the substitution\n\n    old_ki = tyVarKind old_var\n    no_kind_change = noFreeVarsOfType old_ki -- verify that kind is closed\n    no_change = no_kind_change && (new_var == old_var)\n        -- no_change means that the new_var is identical in\n        -- all respects to the old_var (same unique, same kind)\n        -- See Note [Extending the TCvSubst]\n        --\n        -- In that case we don't need to extend the substitution\n        -- to map old to new.  But instead we must zap any\n        -- current substitution for the variable. For example:\n        --      (\\x.e) with id_subst = [x |-> e']\n        -- Here we must simply zap the substitution for x\n\n    new_var | no_kind_change = uniqAway in_scope old_var\n            | otherwise = uniqAway in_scope $\n                          setTyVarKind old_var (subst_fn subst old_ki)\n        -- The uniqAway part makes sure the new variable is not already in scope\n\n-- | Substitute a covar in a binding position, returning an\n-- extended subst and a new covar.\n-- Use the supplied function to substitute in the kind\nsubstCoVarBndrUsing\n  :: (TCvSubst -> Type -> Type)\n  -> TCvSubst -> CoVar -> (TCvSubst, CoVar)\nsubstCoVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var\n  = ASSERT( isCoVar old_var )\n    (TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv, new_var)\n  where\n    new_co         = mkCoVarCo new_var\n    no_kind_change = noFreeVarsOfTypes [t1, t2]\n    no_change      = new_var == old_var && no_kind_change\n\n    new_cenv | no_change = delVarEnv cenv old_var\n             | otherwise = extendVarEnv cenv old_var new_co\n\n    new_var = uniqAway in_scope subst_old_var\n    subst_old_var = mkCoVar (varName old_var) new_var_type\n\n    (_, _, t1, t2, role) = coVarKindsTypesRole old_var\n    t1' = subst_fn subst t1\n    t2' = subst_fn subst t2\n    new_var_type = mkCoercionType role t1' t2'\n                  -- It's important to do the substitution for coercions,\n                  -- because they can have free type variables\n\ncloneTyVarBndr :: TCvSubst -> TyVar -> Unique -> (TCvSubst, TyVar)\ncloneTyVarBndr subst@(TCvSubst in_scope tv_env cv_env) tv uniq\n  = ASSERT2( isTyVar tv, ppr tv )   -- I think it's only called on TyVars\n    (TCvSubst (extendInScopeSet in_scope tv')\n              (extendVarEnv tv_env tv (mkTyVarTy tv')) cv_env, tv')\n  where\n    old_ki = tyVarKind tv\n    no_kind_change = noFreeVarsOfType old_ki -- verify that kind is closed\n\n    tv1 | no_kind_change = tv\n        | otherwise      = setTyVarKind tv (substTy subst old_ki)\n\n    tv' = setVarUnique tv1 uniq\n\ncloneTyVarBndrs :: TCvSubst -> [TyVar] -> UniqSupply -> (TCvSubst, [TyVar])\ncloneTyVarBndrs subst []     _usupply = (subst, [])\ncloneTyVarBndrs subst (t:ts)  usupply = (subst'', tv:tvs)\n  where\n    (uniq, usupply') = takeUniqFromSupply usupply\n    (subst' , tv )   = cloneTyVarBndr subst t uniq\n    (subst'', tvs)   = cloneTyVarBndrs subst' ts usupply'\n\n{-\n%************************************************************************\n%*                                                                      *\n                   Pretty-printing types\n\n       Defined very early because of debug printing in assertions\n%*                                                                      *\n%************************************************************************\n\n@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is\ndefined to use this.  @pprParendType@ is the same, except it puts\nparens around the type, except for the atomic cases.  @pprParendType@\nworks just by setting the initial context precedence very high.\n\nNote that any function which pretty-prints a @Type@ first converts the @Type@\nto an @IfaceType@. See Note [IfaceType and pretty-printing] in IfaceType.\n\nSee Note [Precedence in types] in BasicTypes.\n-}\n\n--------------------------------------------------------\n-- When pretty-printing types, we convert to IfaceType,\n--   and pretty-print that.\n-- See Note [Pretty printing via IfaceSyn] in PprTyThing\n--------------------------------------------------------\n\npprType, pprParendType :: Type -> SDoc\npprType       = pprPrecType topPrec\npprParendType = pprPrecType appPrec\n\npprPrecType :: PprPrec -> Type -> SDoc\npprPrecType = pprPrecTypeX emptyTidyEnv\n\npprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc\npprPrecTypeX env prec ty\n  = getPprStyle $ \\sty ->\n    if debugStyle sty           -- Use debugPprType when in\n    then debug_ppr_ty prec ty   -- when in debug-style\n    else pprPrecIfaceType prec (tidyToIfaceTypeStyX env ty sty)\n    -- NB: debug-style is used for -dppr-debug\n    --     dump-style  is used for -ddump-tc-trace etc\n\npprTyLit :: TyLit -> SDoc\npprTyLit = pprIfaceTyLit . toIfaceTyLit\n\npprKind, pprParendKind :: Kind -> SDoc\npprKind       = pprType\npprParendKind = pprParendType\n\ntidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType\ntidyToIfaceTypeStyX env ty sty\n  | userStyle sty = tidyToIfaceTypeX env ty\n  | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty\n     -- in latter case, don't tidy, as we'll be printing uniques.\n\ntidyToIfaceType :: Type -> IfaceType\ntidyToIfaceType = tidyToIfaceTypeX emptyTidyEnv\n\ntidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType\n-- It's vital to tidy before converting to an IfaceType\n-- or nested binders will become indistinguishable!\n--\n-- Also for the free type variables, tell toIfaceTypeX to\n-- leave them as IfaceFreeTyVar.  This is super-important\n-- for debug printing.\ntidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty)\n  where\n    env'      = tidyFreeTyCoVars env free_tcvs\n    free_tcvs = tyCoVarsOfTypeWellScoped ty\n\n------------\npprCo, pprParendCo :: Coercion -> SDoc\npprCo       co = getPprStyle $ \\ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty)\npprParendCo co = getPprStyle $ \\ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty)\n\ntidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion\ntidyToIfaceCoSty co sty\n  | userStyle sty = tidyToIfaceCo co\n  | otherwise     = toIfaceCoercionX (tyCoVarsOfCo co) co\n     -- in latter case, don't tidy, as we'll be printing uniques.\n\ntidyToIfaceCo :: Coercion -> IfaceCoercion\n-- It's vital to tidy before converting to an IfaceType\n-- or nested binders will become indistinguishable!\n--\n-- Also for the free type variables, tell toIfaceCoercionX to\n-- leave them as IfaceFreeCoVar.  This is super-important\n-- for debug printing.\ntidyToIfaceCo co = toIfaceCoercionX (mkVarSet free_tcvs) (tidyCo env co)\n  where\n    env       = tidyFreeTyCoVars emptyTidyEnv free_tcvs\n    free_tcvs = scopedSort $ tyCoVarsOfCoList co\n------------\npprClassPred :: Class -> [Type] -> SDoc\npprClassPred clas tys = pprTypeApp (classTyCon clas) tys\n\n------------\npprTheta :: ThetaType -> SDoc\npprTheta = pprIfaceContext topPrec . map tidyToIfaceType\n\npprParendTheta :: ThetaType -> SDoc\npprParendTheta = pprIfaceContext appPrec . map tidyToIfaceType\n\npprThetaArrowTy :: ThetaType -> SDoc\npprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType\n\n------------------\ninstance Outputable Type where\n    ppr ty = pprType ty\n\ninstance Outputable TyLit where\n   ppr = pprTyLit\n\n------------------\npprSigmaType :: Type -> SDoc\npprSigmaType = pprIfaceSigmaType ShowForAllWhen . tidyToIfaceType\n\npprForAll :: [TyCoVarBinder] -> SDoc\npprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)\n\n-- | Print a user-level forall; see Note [When to print foralls]\npprUserForAll :: [TyCoVarBinder] -> SDoc\npprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr\n\npprTCvBndrs :: [TyCoVarBinder] -> SDoc\npprTCvBndrs tvs = sep (map pprTCvBndr tvs)\n\npprTCvBndr :: TyCoVarBinder -> SDoc\npprTCvBndr = pprTyVar . binderVar\n\npprTyVars :: [TyVar] -> SDoc\npprTyVars tvs = sep (map pprTyVar tvs)\n\npprTyVar :: TyVar -> SDoc\n-- Print a type variable binder with its kind (but not if *)\n-- Here we do not go via IfaceType, because the duplication with\n-- pprIfaceTvBndr is minimal, and the loss of uniques etc in\n-- debug printing is disastrous\npprTyVar tv\n  | isLiftedTypeKind kind = ppr tv\n  | otherwise             = parens (ppr tv <+> dcolon <+> ppr kind)\n  where\n    kind = tyVarKind tv\n\ninstance Outputable TyCoBinder where\n  ppr (Anon af ty) = ppr af <+> ppr ty\n  ppr (Named (Bndr v Required))  = ppr v\n  ppr (Named (Bndr v Specified)) = char '@' <> ppr v\n  ppr (Named (Bndr v Inferred))  = braces (ppr v)\n\n-----------------\ninstance Outputable Coercion where -- defined here to avoid orphans\n  ppr = pprCo\n\ndebugPprType :: Type -> SDoc\n-- ^ debugPprType is a simple pretty printer that prints a type\n-- without going through IfaceType.  It does not format as prettily\n-- as the normal route, but it's much more direct, and that can\n-- be useful for debugging.  E.g. with -dppr-debug it prints the\n-- kind on type-variable /occurrences/ which the normal route\n-- fundamentally cannot do.\ndebugPprType ty = debug_ppr_ty topPrec ty\n\ndebug_ppr_ty :: PprPrec -> Type -> SDoc\ndebug_ppr_ty _ (LitTy l)\n  = ppr l\n\ndebug_ppr_ty _ (TyVarTy tv)\n  = ppr tv  -- With -dppr-debug we get (tv :: kind)\n\ndebug_ppr_ty prec (FunTy { ft_af = af, ft_arg = arg, ft_res = res })\n  = maybeParen prec funPrec $\n    sep [debug_ppr_ty funPrec arg, arrow <+> debug_ppr_ty prec res]\n  where\n    arrow = case af of\n              VisArg   -> text \"->\"\n              InvisArg -> text \"=>\"\n\ndebug_ppr_ty prec (TyConApp tc tys)\n  | null tys  = ppr tc\n  | otherwise = maybeParen prec appPrec $\n                hang (ppr tc) 2 (sep (map (debug_ppr_ty appPrec) tys))\n\ndebug_ppr_ty _ (AppTy t1 t2)\n  = hang (debug_ppr_ty appPrec t1)  -- Print parens so we see ((a b) c)\n       2 (debug_ppr_ty appPrec t2)  -- so that we can distinguish\n                                    -- TyConApp from AppTy\n\ndebug_ppr_ty prec (CastTy ty co)\n  = maybeParen prec topPrec $\n    hang (debug_ppr_ty topPrec ty)\n       2 (text \"|>\" <+> ppr co)\n\ndebug_ppr_ty _ (CoercionTy co)\n  = parens (text \"CO\" <+> ppr co)\n\ndebug_ppr_ty prec ty@(ForAllTy {})\n  | (tvs, body) <- split ty\n  = maybeParen prec funPrec $\n    hang (text \"forall\" <+> fsep (map ppr tvs) <> dot)\n         -- The (map ppr tvs) will print kind-annotated\n         -- tvs, because we are (usually) in debug-style\n       2 (ppr body)\n  where\n    split ty | ForAllTy tv ty' <- ty\n             , (tvs, body) <- split ty'\n             = (tv:tvs, body)\n             | otherwise\n             = ([], ty)\n\n{-\nNote [When to print foralls]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nMostly we want to print top-level foralls when (and only when) the user specifies\n-fprint-explicit-foralls.  But when kind polymorphism is at work, that suppresses\ntoo much information; see Trac #9018.\n\nSo I'm trying out this rule: print explicit foralls if\n  a) User specifies -fprint-explicit-foralls, or\n  b) Any of the quantified type variables has a kind\n     that mentions a kind variable\n\nThis catches common situations, such as a type siguature\n     f :: m a\nwhich means\n      f :: forall k. forall (m :: k->*) (a :: k). m a\nWe really want to see both the \"forall k\" and the kind signatures\non m and a.  The latter comes from pprTCvBndr.\n\nNote [Infix type variables]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWith TypeOperators you can say\n\n   f :: (a ~> b) -> b\n\nand the (~>) is considered a type variable.  However, the type\npretty-printer in this module will just see (a ~> b) as\n\n   App (App (TyVarTy \"~>\") (TyVarTy \"a\")) (TyVarTy \"b\")\n\nSo it'll print the type in prefix form.  To avoid confusion we must\nremember to parenthesise the operator, thus\n\n   (~>) a b -> b\n\nSee Trac #2766.\n-}\n\npprDataCons :: TyCon -> SDoc\npprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons\n  where\n    sepWithVBars [] = empty\n    sepWithVBars docs = sep (punctuate (space <> vbar) docs)\n\npprDataConWithArgs :: DataCon -> SDoc\npprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]\n  where\n    (_univ_tvs, _ex_tvs, _eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc\n    user_bndrs = dataConUserTyVarBinders dc\n    forAllDoc  = pprUserForAll user_bndrs\n    thetaDoc   = pprThetaArrowTy theta\n    argsDoc    = hsep (fmap pprParendType arg_tys)\n\n\npprTypeApp :: TyCon -> [Type] -> SDoc\npprTypeApp tc tys\n  = pprIfaceTypeApp topPrec (toIfaceTyCon tc)\n                            (toIfaceTcArgs tc tys)\n    -- TODO: toIfaceTcArgs seems rather wasteful here\n\n------------------\n-- | Display all kind information (with @-fprint-explicit-kinds@) when the\n-- provided 'Bool' argument is 'True'.\n-- See @Note [Kind arguments in error messages]@ in \"TcErrors\".\npprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc\npprWithExplicitKindsWhen b\n  = updSDocDynFlags $ \\dflags ->\n      if b then gopt_set dflags Opt_PrintExplicitKinds\n           else dflags\n\n{-\n%************************************************************************\n%*                                                                      *\n\\subsection{TidyType}\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | This tidies up a type for printing in an error message, or in\n-- an interface file.\n--\n-- It doesn't change the uniques at all, just the print names.\ntidyVarBndrs :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])\ntidyVarBndrs tidy_env tvs\n  = mapAccumL tidyVarBndr (avoidNameClashes tvs tidy_env) tvs\n\ntidyVarBndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)\ntidyVarBndr tidy_env@(occ_env, subst) var\n  = case tidyOccName occ_env (getHelpfulOccName var) of\n      (occ_env', occ') -> ((occ_env', subst'), var')\n        where\n          subst' = extendVarEnv subst var var'\n          var'   = setVarType (setVarName var name') type'\n          type'  = tidyType tidy_env (varType var)\n          name'  = tidyNameOcc name occ'\n          name   = varName var\n\navoidNameClashes :: [TyCoVar] -> TidyEnv -> TidyEnv\n-- Seed the occ_env with clashes among the names, see\n-- Note [Tidying multiple names at once] in OccName\navoidNameClashes tvs (occ_env, subst)\n  = (avoidClashesOccEnv occ_env occs, subst)\n  where\n    occs = map getHelpfulOccName tvs\n\ngetHelpfulOccName :: TyCoVar -> OccName\n-- A TcTyVar with a System Name is probably a\n-- unification variable; when we tidy them we give them a trailing\n-- \"0\" (or 1 etc) so that they don't take precedence for the\n-- un-modified name. Plus, indicating a unification variable in\n-- this way is a helpful clue for users\ngetHelpfulOccName tv\n  | isSystemName name, isTcTyVar tv\n  = mkTyVarOcc (occNameString occ ++ \"0\")\n  | otherwise\n  = occ\n  where\n   name = varName tv\n   occ  = getOccName name\n\ntidyTyCoVarBinder :: TidyEnv -> VarBndr TyCoVar vis\n                  -> (TidyEnv, VarBndr TyCoVar vis)\ntidyTyCoVarBinder tidy_env (Bndr tv vis)\n  = (tidy_env', Bndr tv' vis)\n  where\n    (tidy_env', tv') = tidyVarBndr tidy_env tv\n\ntidyTyCoVarBinders :: TidyEnv -> [VarBndr TyCoVar vis]\n                   -> (TidyEnv, [VarBndr TyCoVar vis])\ntidyTyCoVarBinders tidy_env tvbs\n  = mapAccumL tidyTyCoVarBinder\n              (avoidNameClashes (binderVars tvbs) tidy_env) tvbs\n\n---------------\ntidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv\n-- ^ Add the free 'TyVar's to the env in tidy form,\n-- so that we can tidy the type they are free in\ntidyFreeTyCoVars (full_occ_env, var_env) tyvars\n  = fst (tidyOpenTyCoVars (full_occ_env, var_env) tyvars)\n\n---------------\ntidyOpenTyCoVars :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])\ntidyOpenTyCoVars env tyvars = mapAccumL tidyOpenTyCoVar env tyvars\n\n---------------\ntidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)\n-- ^ Treat a new 'TyCoVar' as a binder, and give it a fresh tidy name\n-- using the environment if one has not already been allocated. See\n-- also 'tidyVarBndr'\ntidyOpenTyCoVar env@(_, subst) tyvar\n  = case lookupVarEnv subst tyvar of\n        Just tyvar' -> (env, tyvar')              -- Already substituted\n        Nothing     ->\n          let env' = tidyFreeTyCoVars env (tyCoVarsOfTypeList (tyVarKind tyvar))\n          in tidyVarBndr env' tyvar  -- Treat it as a binder\n\n---------------\ntidyTyCoVarOcc :: TidyEnv -> TyCoVar -> TyCoVar\ntidyTyCoVarOcc env@(_, subst) tv\n  = case lookupVarEnv subst tv of\n        Nothing  -> updateVarType (tidyType env) tv\n        Just tv' -> tv'\n\n---------------\ntidyTypes :: TidyEnv -> [Type] -> [Type]\ntidyTypes env tys = map (tidyType env) tys\n\n---------------\ntidyType :: TidyEnv -> Type -> Type\ntidyType _   (LitTy n)             = LitTy n\ntidyType env (TyVarTy tv)          = TyVarTy (tidyTyCoVarOcc env tv)\ntidyType env (TyConApp tycon tys)  = let args = tidyTypes env tys\n                                     in args `seqList` TyConApp tycon args\ntidyType env (AppTy fun arg)       = (AppTy $! (tidyType env fun)) $! (tidyType env arg)\ntidyType env ty@(FunTy _ arg res)  = let { !arg' = tidyType env arg\n                                         ; !res' = tidyType env res }\n                                     in ty { ft_arg = arg', ft_res = res' }\ntidyType env (ty@(ForAllTy{}))     = mkForAllTys' (zip tvs' vis) $! tidyType env' body_ty\n  where\n    (tvs, vis, body_ty) = splitForAllTys' ty\n    (env', tvs') = tidyVarBndrs env tvs\ntidyType env (CastTy ty co)       = (CastTy $! tidyType env ty) $! (tidyCo env co)\ntidyType env (CoercionTy co)      = CoercionTy $! (tidyCo env co)\n\n\n-- The following two functions differ from mkForAllTys and splitForAllTys in that\n-- they expect/preserve the ArgFlag argument. Thes belong to types/Type.hs, but\n-- how should they be named?\nmkForAllTys' :: [(TyCoVar, ArgFlag)] -> Type -> Type\nmkForAllTys' tvvs ty = foldr strictMkForAllTy ty tvvs\n  where\n    strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((Bndr $! tv) $! vis)) $! ty\n\nsplitForAllTys' :: Type -> ([TyCoVar], [ArgFlag], Type)\nsplitForAllTys' ty = go ty [] []\n  where\n    go (ForAllTy (Bndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss)\n    go ty                          tvs viss = (reverse tvs, reverse viss, ty)\n\n\n---------------\n-- | Grabs the free type variables, tidies them\n-- and then uses 'tidyType' to work over the type itself\ntidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])\ntidyOpenTypes env tys\n  = (env', tidyTypes (trimmed_occ_env, var_env) tys)\n  where\n    (env'@(_, var_env), tvs') = tidyOpenTyCoVars env $\n                                tyCoVarsOfTypesWellScoped tys\n    trimmed_occ_env = initTidyOccEnv (map getOccName tvs')\n      -- The idea here was that we restrict the new TidyEnv to the\n      -- _free_ vars of the types, so that we don't gratuitously rename\n      -- the _bound_ variables of the types.\n\n---------------\ntidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)\ntidyOpenType env ty = let (env', [ty']) = tidyOpenTypes env [ty] in\n                      (env', ty')\n\n---------------\n-- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)\ntidyTopType :: Type -> Type\ntidyTopType ty = tidyType emptyTidyEnv ty\n\n---------------\ntidyOpenKind :: TidyEnv -> Kind -> (TidyEnv, Kind)\ntidyOpenKind = tidyOpenType\n\ntidyKind :: TidyEnv -> Kind -> Kind\ntidyKind = tidyType\n\n----------------\ntidyCo :: TidyEnv -> Coercion -> Coercion\ntidyCo env@(_, subst) co\n  = go co\n  where\n    go_mco MRefl    = MRefl\n    go_mco (MCo co) = MCo (go co)\n\n    go (Refl ty)             = Refl (tidyType env ty)\n    go (GRefl r ty mco)      = GRefl r (tidyType env ty) $! go_mco mco\n    go (TyConAppCo r tc cos) = let args = map go cos\n                               in args `seqList` TyConAppCo r tc args\n    go (AppCo co1 co2)       = (AppCo $! go co1) $! go co2\n    go (ForAllCo tv h co)    = ((ForAllCo $! tvp) $! (go h)) $! (tidyCo envp co)\n                               where (envp, tvp) = tidyVarBndr env tv\n            -- the case above duplicates a bit of work in tidying h and the kind\n            -- of tv. But the alternative is to use coercionKind, which seems worse.\n    go (FunCo r co1 co2)     = (FunCo r $! go co1) $! go co2\n    go (CoVarCo cv)          = case lookupVarEnv subst cv of\n                                 Nothing  -> CoVarCo cv\n                                 Just cv' -> CoVarCo cv'\n    go (HoleCo h)            = HoleCo h\n    go (AxiomInstCo con ind cos) = let args = map go cos\n                               in  args `seqList` AxiomInstCo con ind args\n    go (UnivCo p r t1 t2)    = (((UnivCo $! (go_prov p)) $! r) $!\n                                tidyType env t1) $! tidyType env t2\n    go (SymCo co)            = SymCo $! go co\n    go (TransCo co1 co2)     = (TransCo $! go co1) $! go co2\n    go (NthCo r d co)        = NthCo r d $! go co\n    go (LRCo lr co)          = LRCo lr $! go co\n    go (InstCo co ty)        = (InstCo $! go co) $! go ty\n    go (KindCo co)           = KindCo $! go co\n    go (SubCo co)            = SubCo $! go co\n    go (AxiomRuleCo ax cos)  = let cos1 = tidyCos env cos\n                               in cos1 `seqList` AxiomRuleCo ax cos1\n\n    go_prov UnsafeCoerceProv    = UnsafeCoerceProv\n    go_prov (PhantomProv co)    = PhantomProv (go co)\n    go_prov (ProofIrrelProv co) = ProofIrrelProv (go co)\n    go_prov p@(PluginProv _)    = p\n\ntidyCos :: TidyEnv -> [Coercion] -> [Coercion]\ntidyCos env = map (tidyCo env)\n\n\n{- *********************************************************************\n*                                                                      *\n                   typeSize, coercionSize\n*                                                                      *\n********************************************************************* -}\n\n-- NB: We put typeSize/coercionSize here because they are mutually\n--     recursive, and have the CPR property.  If we have mutual\n--     recursion across a hi-boot file, we don't get the CPR property\n--     and these functions allocate a tremendous amount of rubbish.\n--     It's not critical (because typeSize is really only used in\n--     debug mode, but I tripped over an example (T5642) in which\n--     typeSize was one of the biggest single allocators in all of GHC.\n--     And it's easy to fix, so I did.\n\n-- NB: typeSize does not respect `eqType`, in that two types that\n--     are `eqType` may return different sizes. This is OK, because this\n--     function is used only in reporting, not decision-making.\n\ntypeSize :: Type -> Int\ntypeSize (LitTy {})                 = 1\ntypeSize (TyVarTy {})               = 1\ntypeSize (AppTy t1 t2)              = typeSize t1 + typeSize t2\ntypeSize (FunTy _ t1 t2)            = typeSize t1 + typeSize t2\ntypeSize (ForAllTy (Bndr tv _) t)   = typeSize (varType tv) + typeSize t\ntypeSize (TyConApp _ ts)            = 1 + sum (map typeSize ts)\ntypeSize (CastTy ty co)             = typeSize ty + coercionSize co\ntypeSize (CoercionTy co)            = coercionSize co\n\ncoercionSize :: Coercion -> Int\ncoercionSize (Refl ty)             = typeSize ty\ncoercionSize (GRefl _ ty MRefl)    = typeSize ty\ncoercionSize (GRefl _ ty (MCo co)) = 1 + typeSize ty + coercionSize co\ncoercionSize (TyConAppCo _ _ args) = 1 + sum (map coercionSize args)\ncoercionSize (AppCo co arg)      = coercionSize co + coercionSize arg\ncoercionSize (ForAllCo _ h co)   = 1 + coercionSize co + coercionSize h\ncoercionSize (FunCo _ co1 co2)   = 1 + coercionSize co1 + coercionSize co2\ncoercionSize (CoVarCo _)         = 1\ncoercionSize (HoleCo _)          = 1\ncoercionSize (AxiomInstCo _ _ args) = 1 + sum (map coercionSize args)\ncoercionSize (UnivCo p _ t1 t2)  = 1 + provSize p + typeSize t1 + typeSize t2\ncoercionSize (SymCo co)          = 1 + coercionSize co\ncoercionSize (TransCo co1 co2)   = 1 + coercionSize co1 + coercionSize co2\ncoercionSize (NthCo _ _ co)      = 1 + coercionSize co\ncoercionSize (LRCo  _ co)        = 1 + coercionSize co\ncoercionSize (InstCo co arg)     = 1 + coercionSize co + coercionSize arg\ncoercionSize (KindCo co)         = 1 + coercionSize co\ncoercionSize (SubCo co)          = 1 + coercionSize co\ncoercionSize (AxiomRuleCo _ cs)  = 1 + sum (map coercionSize cs)\n\nprovSize :: UnivCoProvenance -> Int\nprovSize UnsafeCoerceProv    = 1\nprovSize (PhantomProv co)    = 1 + coercionSize co\nprovSize (ProofIrrelProv co) = 1 + coercionSize co\nprovSize (PluginProv _)      = 1\n", "num_lines": 4144}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n-- (c) The GRASP/AQUA Project, Glasgow University, 1998\n--\n-- Type - public interface\n\n{-# LANGUAGE CPP, FlexibleContexts #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n-- | Main functions for manipulating types and type-related things\nmodule Type (\n        -- Note some of this is just re-exports from TyCon..\n\n        -- * Main data types representing Types\n        -- $type_classification\n\n        -- $representation_types\n        TyThing(..), Type, ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),\n        KindOrType, PredType, ThetaType,\n        Var, TyVar, isTyVar, TyCoVar, TyCoBinder, TyCoVarBinder, TyVarBinder,\n        KnotTied,\n\n        -- ** Constructing and deconstructing types\n        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe,\n        getCastedTyVar_maybe, tyVarKind, varType,\n\n        mkAppTy, mkAppTys, splitAppTy, splitAppTys, repSplitAppTys,\n        splitAppTy_maybe, repSplitAppTy_maybe, tcRepSplitAppTy_maybe,\n\n        mkVisFunTy, mkInvisFunTy, mkVisFunTys, mkInvisFunTys,\n        splitFunTy, splitFunTy_maybe,\n        splitFunTys, funResultTy, funArgTy,\n\n        mkTyConApp, mkTyConTy,\n        tyConAppTyCon_maybe, tyConAppTyConPicky_maybe,\n        tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,\n        splitTyConApp_maybe, splitTyConApp, tyConAppArgN, nextRole,\n        tcSplitTyConApp_maybe,\n        splitListTyConApp_maybe,\n        repSplitTyConApp_maybe,\n\n        mkForAllTy, mkForAllTys, mkTyCoInvForAllTys,\n        mkSpecForAllTy, mkSpecForAllTys,\n        mkVisForAllTys, mkTyCoInvForAllTy,\n        mkInvForAllTy, mkInvForAllTys,\n        splitForAllTys, splitForAllTysSameVis, splitForAllVarBndrs,\n        splitForAllTy_maybe, splitForAllTy,\n        splitForAllTy_ty_maybe, splitForAllTy_co_maybe,\n        splitPiTy_maybe, splitPiTy, splitPiTys,\n        mkTyConBindersPreferAnon,\n        mkPiTy, mkPiTys,\n        mkLamType, mkLamTypes,\n        piResultTy, piResultTys,\n        applyTysX, dropForAlls,\n\n        mkNumLitTy, isNumLitTy,\n        mkStrLitTy, isStrLitTy,\n        isLitTy,\n\n        getRuntimeRep_maybe, kindRep_maybe, kindRep,\n\n        mkCastTy, mkCoercionTy, splitCastTy_maybe,\n\n        userTypeError_maybe, pprUserTypeErrorTy,\n\n        coAxNthLHS,\n        stripCoercionTy, splitCoercionType_maybe,\n\n        splitPiTysInvisible, splitPiTysInvisibleN,\n        invisibleTyBndrCount,\n        filterOutInvisibleTypes, filterOutInferredTypes,\n        partitionInvisibleTypes, partitionInvisibles,\n        tyConArgFlags, appTyArgFlags,\n        synTyConResKind,\n\n        modifyJoinResTy, setJoinResTy,\n\n        -- Analyzing types\n        TyCoMapper(..), mapType, mapCoercion,\n\n        -- (Newtypes)\n        newTyConInstRhs,\n\n        -- Pred types\n        mkFamilyTyConApp,\n        isDictLikeTy,\n        mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole,\n        equalityTyCon,\n        mkHeteroPrimEqPred, mkHeteroReprPrimEqPred,\n        mkClassPred,\n        isClassPred, isEqPrimPred, isEqPred, isEqPredClass,\n        isIPPred, isIPPred_maybe, isIPTyCon, isIPClass,\n        isCTupleClass,\n\n        -- Deconstructing predicate types\n        PredTree(..), EqRel(..), eqRelRole, classifyPredType,\n        getClassPredTys, getClassPredTys_maybe,\n        getEqPredTys, getEqPredTys_maybe, getEqPredRole,\n        predTypeEqRel,\n\n        -- ** Binders\n        sameVis,\n        mkTyCoVarBinder, mkTyCoVarBinders,\n        mkTyVarBinders,\n        mkAnonBinder,\n        isAnonTyCoBinder,\n        binderVar, binderVars, binderType, binderArgFlag,\n        tyCoBinderType, tyCoBinderVar_maybe,\n        tyBinderType,\n        binderRelevantType_maybe,\n        isVisibleArgFlag, isInvisibleArgFlag, isVisibleBinder,\n        isInvisibleBinder, isNamedBinder,\n        tyConBindersTyCoBinders,\n\n        -- ** Common type constructors\n        funTyCon,\n\n        -- ** Predicates on types\n        isTyVarTy, isFunTy, isDictTy, isPredTy, isCoercionTy,\n        isCoercionTy_maybe, isForAllTy,\n        isForAllTy_ty, isForAllTy_co,\n        isPiTy, isTauTy, isFamFreeTy,\n        isCoVarType, isEvVarType,\n\n        isValidJoinPointType,\n\n        -- (Lifting and boxity)\n        isLiftedType_maybe, isUnliftedType, isUnboxedTupleType, isUnboxedSumType,\n        isAlgType, isDataFamilyAppType,\n        isPrimitiveType, isStrictType,\n        isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,\n        dropRuntimeRepArgs,\n        getRuntimeRep,\n\n        -- * Main data types representing Kinds\n        Kind,\n\n        -- ** Finding the kind of a type\n        typeKind, tcTypeKind, isTypeLevPoly, resultIsLevPoly,\n        tcIsLiftedTypeKind, tcIsConstraintKind, tcReturnsConstraintKind,\n\n        -- ** Common Kind\n        liftedTypeKind,\n\n        -- * Type free variables\n        tyCoFVsOfType, tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,\n        tyCoVarsOfType, tyCoVarsOfTypes,\n        tyCoVarsOfTypeDSet,\n        coVarsOfType,\n        coVarsOfTypes,\n        closeOverKindsDSet, closeOverKindsFV, closeOverKindsList,\n        closeOverKinds,\n\n        noFreeVarsOfType,\n        splitVisVarsOfType, splitVisVarsOfTypes,\n        expandTypeSynonyms,\n        typeSize, occCheckExpand,\n\n        -- * Well-scoped lists of variables\n        dVarSetElemsWellScoped, scopedSort, tyCoVarsOfTypeWellScoped,\n        tyCoVarsOfTypesWellScoped, tyCoVarsOfBindersWellScoped,\n\n        -- * Type comparison\n        eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX,\n        nonDetCmpTypesX, nonDetCmpTc,\n        eqVarBndrs,\n\n        -- * Forcing evaluation of types\n        seqType, seqTypes,\n\n        -- * Other views onto Types\n        coreView, tcView,\n\n        tyConsOfType,\n\n        -- * Main type substitution data types\n        TvSubstEnv,     -- Representation widely visible\n        TCvSubst(..),    -- Representation visible to a few friends\n\n        -- ** Manipulating type substitutions\n        emptyTvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,\n\n        mkTCvSubst, zipTvSubst, mkTvSubstPrs,\n        zipTCvSubst,\n        notElemTCvSubst,\n        getTvSubstEnv, setTvSubstEnv,\n        zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs,\n        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,\n        extendTCvSubst, extendCvSubst,\n        extendTvSubst, extendTvSubstBinderAndInScope,\n        extendTvSubstList, extendTvSubstAndInScope,\n        extendTCvSubstList,\n        extendTvSubstWithClone,\n        extendTCvSubstWithClone,\n        isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,\n        isEmptyTCvSubst, unionTCvSubst,\n\n        -- ** Performing substitution on types and kinds\n        substTy, substTys, substTyWith, substTysWith, substTheta,\n        substTyAddInScope,\n        substTyUnchecked, substTysUnchecked, substThetaUnchecked,\n        substTyWithUnchecked,\n        substCoUnchecked, substCoWithUnchecked,\n        substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars,\n        substVarBndr, substVarBndrs,\n        cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar,\n\n        -- * Pretty-printing\n        pprType, pprParendType, pprPrecType,\n        pprTypeApp, pprTyThingCategory, pprShortTyThing,\n        pprTCvBndr, pprTCvBndrs, pprForAll, pprUserForAll,\n        pprSigmaType, pprWithExplicitKindsWhen,\n        pprTheta, pprThetaArrowTy, pprClassPred,\n        pprKind, pprParendKind, pprSourceTyCon,\n        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,\n        pprTyVar, pprTyVars,\n        pprWithTYPE,\n\n        -- * Tidying type related things up for printing\n        tidyType,      tidyTypes,\n        tidyOpenType,  tidyOpenTypes,\n        tidyOpenKind,\n        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars,\n        tidyOpenTyCoVar, tidyOpenTyCoVars,\n        tidyTyCoVarOcc,\n        tidyTopType,\n        tidyKind,\n        tidyTyCoVarBinder, tidyTyCoVarBinders\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport BasicTypes\n\n-- We import the representation and primitive functions from TyCoRep.\n-- Many things are reexported, but not the representation!\n\nimport Kind\nimport TyCoRep\n\n-- friends:\nimport Var\nimport VarEnv\nimport VarSet\nimport UniqSet\n\nimport Class\nimport TyCon\nimport TysPrim\nimport {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind, unitTy\n                                 , typeSymbolKind, liftedTypeKind\n                                 , constraintKind )\nimport PrelNames\nimport CoAxiom\nimport {-# SOURCE #-} Coercion( mkNomReflCo, mkGReflCo, mkReflCo\n                              , mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo\n                              , mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo\n                              , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo\n                              , mkKindCo, mkSubCo, mkFunCo, mkAxiomInstCo\n                              , decomposePiCos, coercionKind, coercionType\n                              , isReflexiveCo, seqCo )\n\n-- others\nimport Util\nimport FV\nimport Outputable\nimport FastString\nimport Pair\nimport DynFlags  ( gopt_set, GeneralFlag(Opt_PrintExplicitRuntimeReps) )\nimport ListSetOps\nimport Unique ( nonDetCmpUnique )\n\nimport Maybes           ( orElse )\nimport Data.Maybe       ( isJust )\nimport Control.Monad    ( guard )\n\n-- $type_classification\n-- #type_classification#\n--\n-- Types are one of:\n--\n-- [Unboxed]            Iff its representation is other than a pointer\n--                      Unboxed types are also unlifted.\n--\n-- [Lifted]             Iff it has bottom as an element.\n--                      Closures always have lifted types: i.e. any\n--                      let-bound identifier in Core must have a lifted\n--                      type. Operationally, a lifted object is one that\n--                      can be entered.\n--                      Only lifted types may be unified with a type variable.\n--\n-- [Algebraic]          Iff it is a type with one or more constructors, whether\n--                      declared with @data@ or @newtype@.\n--                      An algebraic type is one that can be deconstructed\n--                      with a case expression. This is /not/ the same as\n--                      lifted types, because we also include unboxed\n--                      tuples in this classification.\n--\n-- [Data]               Iff it is a type declared with @data@, or a boxed tuple.\n--\n-- [Primitive]          Iff it is a built-in type that can't be expressed in Haskell.\n--\n-- Currently, all primitive types are unlifted, but that's not necessarily\n-- the case: for example, @Int@ could be primitive.\n--\n-- Some primitive types are unboxed, such as @Int#@, whereas some are boxed\n-- but unlifted (such as @ByteArray#@).  The only primitive types that we\n-- classify as algebraic are the unboxed tuples.\n--\n-- Some examples of type classifications that may make this a bit clearer are:\n--\n-- @\n-- Type          primitive       boxed           lifted          algebraic\n-- -----------------------------------------------------------------------------\n-- Int#          Yes             No              No              No\n-- ByteArray#    Yes             Yes             No              No\n-- (\\# a, b \\#)  Yes             No              No              Yes\n-- (\\# a | b \\#) Yes             No              No              Yes\n-- (  a, b  )    No              Yes             Yes             Yes\n-- [a]           No              Yes             Yes             Yes\n-- @\n\n-- $representation_types\n-- A /source type/ is a type that is a separate type as far as the type checker is\n-- concerned, but which has a more low-level representation as far as Core-to-Core\n-- passes and the rest of the back end is concerned.\n--\n-- You don't normally have to worry about this, as the utility functions in\n-- this module will automatically convert a source into a representation type\n-- if they are spotted, to the best of its abilities. If you don't want this\n-- to happen, use the equivalent functions from the \"TcType\" module.\n\n{-\n************************************************************************\n*                                                                      *\n                Type representation\n*                                                                      *\n************************************************************************\n\nNote [coreView vs tcView]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nSo far as the typechecker is concerned, 'Constraint' and 'TYPE\nLiftedRep' are distinct kinds.\n\nBut in Core these two are treated as identical.\n\nWe implement this by making 'coreView' convert 'Constraint' to 'TYPE\nLiftedRep' on the fly.  The function tcView (used in the type checker)\ndoes not do this.\n\nSee also Trac #11715, which tracks removing this inconsistency.\n\n-}\n\n-- | Gives the typechecker view of a type. This unwraps synonyms but\n-- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into\n-- TYPE LiftedRep. Returns Nothing if no unwrapping happens.\n-- See also Note [coreView vs tcView]\n{-# INLINE tcView #-}\ntcView :: Type -> Maybe Type\ntcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys\n  = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')\n               -- The free vars of 'rhs' should all be bound by 'tenv', so it's\n               -- ok to use 'substTy' here.\n               -- See also Note [The substitution invariant] in TyCoRep.\n               -- Its important to use mkAppTys, rather than (foldl AppTy),\n               -- because the function part might well return a\n               -- partially-applied type constructor; indeed, usually will!\ntcView _ = Nothing\n\n{-# INLINE coreView #-}\ncoreView :: Type -> Maybe Type\n-- ^ This function Strips off the /top layer only/ of a type synonym\n-- application (if any) its underlying representation type.\n-- Returns Nothing if there is nothing to look through.\n-- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep@.\n--\n-- By being non-recursive and inlined, this case analysis gets efficiently\n-- joined onto the case analysis that the caller is already doing\ncoreView ty@(TyConApp tc tys)\n  | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys\n  = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')\n    -- This equation is exactly like tcView\n\n  -- At the Core level, Constraint = Type\n  -- See Note [coreView vs tcView]\n  | isConstraintKindCon tc\n  = ASSERT2( null tys, ppr ty )\n    Just liftedTypeKind\n\ncoreView _ = Nothing\n\n-----------------------------------------------\nexpandTypeSynonyms :: Type -> Type\n-- ^ Expand out all type synonyms.  Actually, it'd suffice to expand out\n-- just the ones that discard type variables (e.g.  type Funny a = Int)\n-- But we don't know which those are currently, so we just expand all.\n--\n-- 'expandTypeSynonyms' only expands out type synonyms mentioned in the type,\n-- not in the kinds of any TyCon or TyVar mentioned in the type.\n--\n-- Keep this synchronized with 'synonymTyConsOfType'\nexpandTypeSynonyms ty\n  = go (mkEmptyTCvSubst in_scope) ty\n  where\n    in_scope = mkInScopeSet (tyCoVarsOfType ty)\n\n    go subst (TyConApp tc tys)\n      | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc expanded_tys\n      = let subst' = mkTvSubst in_scope (mkVarEnv tenv)\n            -- Make a fresh substitution; rhs has nothing to\n            -- do with anything that has happened so far\n            -- NB: if you make changes here, be sure to build an\n            --     /idempotent/ substitution, even in the nested case\n            --        type T a b = a -> b\n            --        type S x y = T y x\n            -- (Trac #11665)\n        in  mkAppTys (go subst' rhs) tys'\n      | otherwise\n      = TyConApp tc expanded_tys\n      where\n        expanded_tys = (map (go subst) tys)\n\n    go _     (LitTy l)     = LitTy l\n    go subst (TyVarTy tv)  = substTyVar subst tv\n    go subst (AppTy t1 t2) = mkAppTy (go subst t1) (go subst t2)\n    go subst ty@(FunTy _ arg res)\n      = ty { ft_arg = go subst arg, ft_res = go subst res }\n    go subst (ForAllTy (Bndr tv vis) t)\n      = let (subst', tv') = substVarBndrUsing go subst tv in\n        ForAllTy (Bndr tv' vis) (go subst' t)\n    go subst (CastTy ty co)  = mkCastTy (go subst ty) (go_co subst co)\n    go subst (CoercionTy co) = mkCoercionTy (go_co subst co)\n\n    go_mco _     MRefl    = MRefl\n    go_mco subst (MCo co) = MCo (go_co subst co)\n\n    go_co subst (Refl ty)\n      = mkNomReflCo (go subst ty)\n    go_co subst (GRefl r ty mco)\n      = mkGReflCo r (go subst ty) (go_mco subst mco)\n       -- NB: coercions are always expanded upon creation\n    go_co subst (TyConAppCo r tc args)\n      = mkTyConAppCo r tc (map (go_co subst) args)\n    go_co subst (AppCo co arg)\n      = mkAppCo (go_co subst co) (go_co subst arg)\n    go_co subst (ForAllCo tv kind_co co)\n      = let (subst', tv', kind_co') = go_cobndr subst tv kind_co in\n        mkForAllCo tv' kind_co' (go_co subst' co)\n    go_co subst (FunCo r co1 co2)\n      = mkFunCo r (go_co subst co1) (go_co subst co2)\n    go_co subst (CoVarCo cv)\n      = substCoVar subst cv\n    go_co subst (AxiomInstCo ax ind args)\n      = mkAxiomInstCo ax ind (map (go_co subst) args)\n    go_co subst (UnivCo p r t1 t2)\n      = mkUnivCo (go_prov subst p) r (go subst t1) (go subst t2)\n    go_co subst (SymCo co)\n      = mkSymCo (go_co subst co)\n    go_co subst (TransCo co1 co2)\n      = mkTransCo (go_co subst co1) (go_co subst co2)\n    go_co subst (NthCo r n co)\n      = mkNthCo r n (go_co subst co)\n    go_co subst (LRCo lr co)\n      = mkLRCo lr (go_co subst co)\n    go_co subst (InstCo co arg)\n      = mkInstCo (go_co subst co) (go_co subst arg)\n    go_co subst (KindCo co)\n      = mkKindCo (go_co subst co)\n    go_co subst (SubCo co)\n      = mkSubCo (go_co subst co)\n    go_co subst (AxiomRuleCo ax cs)\n      = AxiomRuleCo ax (map (go_co subst) cs)\n    go_co _ (HoleCo h)\n      = pprPanic \"expandTypeSynonyms hit a hole\" (ppr h)\n\n    go_prov _     UnsafeCoerceProv    = UnsafeCoerceProv\n    go_prov subst (PhantomProv co)    = PhantomProv (go_co subst co)\n    go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co)\n    go_prov _     p@(PluginProv _)    = p\n\n      -- the \"False\" and \"const\" are to accommodate the type of\n      -- substForAllCoBndrUsing, which is general enough to\n      -- handle coercion optimization (which sometimes swaps the\n      -- order of a coercion)\n    go_cobndr subst = substForAllCoBndrUsing False (go_co subst) subst\n\n{-\n************************************************************************\n*                                                                      *\n   Analyzing types\n*                                                                      *\n************************************************************************\n\nThese functions do a map-like operation over types, performing some operation\non all variables and binding sites. Primarily used for zonking.\n\nNote [Efficiency for mapCoercion ForAllCo case]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nAs noted in Note [Forall coercions] in TyCoRep, a ForAllCo is a bit redundant.\nIt stores a TyCoVar and a Coercion, where the kind of the TyCoVar always matches\nthe left-hand kind of the coercion. This is convenient lots of the time, but\nnot when mapping a function over a coercion.\n\nThe problem is that tcm_tybinder will affect the TyCoVar's kind and\nmapCoercion will affect the Coercion, and we hope that the results will be\nthe same. Even if they are the same (which should generally happen with\ncorrect algorithms), then there is an efficiency issue. In particular,\nthis problem seems to make what should be a linear algorithm into a potentially\nexponential one. But it's only going to be bad in the case where there's\nlots of foralls in the kinds of other foralls. Like this:\n\n  forall a : (forall b : (forall c : ...). ...). ...\n\nThis construction seems unlikely. So we'll do the inefficient, easy way\nfor now.\n\nNote [Specialising mappers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThese INLINABLE pragmas are indispensable. mapType/mapCoercion are used\nto implement zonking, and it's vital that they get specialised to the TcM\nmonad. This specialisation happens automatically (that is, without a\nSPECIALISE pragma) as long as the definitions are INLINABLE. For example,\nthis one change made a 20% allocation difference in perf/compiler/T5030.\n\n-}\n\n-- | This describes how a \"map\" operation over a type/coercion should behave\ndata TyCoMapper env m\n  = TyCoMapper\n      { tcm_tyvar :: env -> TyVar -> m Type\n      , tcm_covar :: env -> CoVar -> m Coercion\n      , tcm_hole  :: env -> CoercionHole -> m Coercion\n          -- ^ What to do with coercion holes.\n          -- See Note [Coercion holes] in TyCoRep.\n\n      , tcm_tycobinder :: env -> TyCoVar -> ArgFlag -> m (env, TyCoVar)\n          -- ^ The returned env is used in the extended scope\n\n      , tcm_tycon :: TyCon -> m TyCon\n          -- ^ This is used only for TcTyCons\n          -- a) To zonk TcTyCons\n          -- b) To turn TcTyCons into TyCons.\n          --    See Note [Type checking recursive type and class declarations]\n          --    in TcTyClsDecls\n      }\n\n{-# INLINABLE mapType #-}  -- See Note [Specialising mappers]\nmapType :: Monad m => TyCoMapper env m -> env -> Type -> m Type\nmapType mapper@(TyCoMapper { tcm_tyvar = tyvar\n                           , tcm_tycobinder = tycobinder\n                           , tcm_tycon = tycon })\n        env ty\n  = go ty\n  where\n    go (TyVarTy tv)    = tyvar env tv\n    go (AppTy t1 t2)   = mkAppTy <$> go t1 <*> go t2\n    go ty@(LitTy {})   = return ty\n    go (CastTy ty co)  = mkCastTy <$> go ty <*> mapCoercion mapper env co\n    go (CoercionTy co) = CoercionTy <$> mapCoercion mapper env co\n\n    go ty@(FunTy _ arg res)\n      = do { arg' <- go arg; res' <- go res\n           ; return (ty { ft_arg = arg', ft_res = res' }) }\n\n    go ty@(TyConApp tc tys)\n      | isTcTyCon tc\n      = do { tc' <- tycon tc\n           ; mkTyConApp tc' <$> mapM go tys }\n\n      -- Not a TcTyCon\n      | null tys    -- Avoid allocation in this very\n      = return ty   -- common case (E.g. Int, LiftedRep etc)\n\n      | otherwise\n      = mkTyConApp tc <$> mapM go tys\n\n    go (ForAllTy (Bndr tv vis) inner)\n      = do { (env', tv') <- tycobinder env tv vis\n           ; inner' <- mapType mapper env' inner\n           ; return $ ForAllTy (Bndr tv' vis) inner' }\n\n{-# INLINABLE mapCoercion #-}  -- See Note [Specialising mappers]\nmapCoercion :: Monad m\n            => TyCoMapper env m -> env -> Coercion -> m Coercion\nmapCoercion mapper@(TyCoMapper { tcm_covar = covar\n                               , tcm_hole = cohole\n                               , tcm_tycobinder = tycobinder\n                               , tcm_tycon = tycon })\n            env co\n  = go co\n  where\n    go_mco MRefl    = return MRefl\n    go_mco (MCo co) = MCo <$> (go co)\n\n    go (Refl ty) = Refl <$> mapType mapper env ty\n    go (GRefl r ty mco) = mkGReflCo r <$> mapType mapper env ty <*> (go_mco mco)\n    go (TyConAppCo r tc args)\n      = do { tc' <- if isTcTyCon tc\n                    then tycon tc\n                    else return tc\n           ; mkTyConAppCo r tc' <$> mapM go args }\n    go (AppCo c1 c2) = mkAppCo <$> go c1 <*> go c2\n    go (ForAllCo tv kind_co co)\n      = do { kind_co' <- go kind_co\n           ; (env', tv') <- tycobinder env tv Inferred\n           ; co' <- mapCoercion mapper env' co\n           ; return $ mkForAllCo tv' kind_co' co' }\n        -- See Note [Efficiency for mapCoercion ForAllCo case]\n    go (FunCo r c1 c2) = mkFunCo r <$> go c1 <*> go c2\n    go (CoVarCo cv) = covar env cv\n    go (AxiomInstCo ax i args)\n      = mkAxiomInstCo ax i <$> mapM go args\n    go (HoleCo hole) = cohole env hole\n    go (UnivCo p r t1 t2)\n      = mkUnivCo <$> go_prov p <*> pure r\n                 <*> mapType mapper env t1 <*> mapType mapper env t2\n    go (SymCo co) = mkSymCo <$> go co\n    go (TransCo c1 c2) = mkTransCo <$> go c1 <*> go c2\n    go (AxiomRuleCo r cos) = AxiomRuleCo r <$> mapM go cos\n    go (NthCo r i co)      = mkNthCo r i <$> go co\n    go (LRCo lr co)        = mkLRCo lr <$> go co\n    go (InstCo co arg)     = mkInstCo <$> go co <*> go arg\n    go (KindCo co)         = mkKindCo <$> go co\n    go (SubCo co)          = mkSubCo <$> go co\n\n    go_prov UnsafeCoerceProv    = return UnsafeCoerceProv\n    go_prov (PhantomProv co)    = PhantomProv <$> go co\n    go_prov (ProofIrrelProv co) = ProofIrrelProv <$> go co\n    go_prov p@(PluginProv _)    = return p\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Constructor-specific functions}\n*                                                                      *\n************************************************************************\n\n\n---------------------------------------------------------------------\n                                TyVarTy\n                                ~~~~~~~\n-}\n\n-- | Attempts to obtain the type variable underlying a 'Type', and panics with the\n-- given message if this is not a type variable type. See also 'getTyVar_maybe'\ngetTyVar :: String -> Type -> TyVar\ngetTyVar msg ty = case getTyVar_maybe ty of\n                    Just tv -> tv\n                    Nothing -> panic (\"getTyVar: \" ++ msg)\n\nisTyVarTy :: Type -> Bool\nisTyVarTy ty = isJust (getTyVar_maybe ty)\n\n-- | Attempts to obtain the type variable underlying a 'Type'\ngetTyVar_maybe :: Type -> Maybe TyVar\ngetTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'\n                  | otherwise               = repGetTyVar_maybe ty\n\n-- | If the type is a tyvar, possibly under a cast, returns it, along\n-- with the coercion. Thus, the co is :: kind tv ~N kind ty\ngetCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)\ngetCastedTyVar_maybe ty | Just ty' <- coreView ty = getCastedTyVar_maybe ty'\ngetCastedTyVar_maybe (CastTy (TyVarTy tv) co)     = Just (tv, co)\ngetCastedTyVar_maybe (TyVarTy tv)\n  = Just (tv, mkReflCo Nominal (tyVarKind tv))\ngetCastedTyVar_maybe _                            = Nothing\n\n-- | Attempts to obtain the type variable underlying a 'Type', without\n-- any expansion\nrepGetTyVar_maybe :: Type -> Maybe TyVar\nrepGetTyVar_maybe (TyVarTy tv) = Just tv\nrepGetTyVar_maybe _            = Nothing\n\n{-\n---------------------------------------------------------------------\n                                AppTy\n                                ~~~~~\nWe need to be pretty careful with AppTy to make sure we obey the\ninvariant that a TyConApp is always visibly so.  mkAppTy maintains the\ninvariant: use it.\n\nNote [Decomposing fat arrow c=>t]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCan we unify (a b) with (Eq a => ty)?   If we do so, we end up with\na partial application like ((=>) Eq a) which doesn't make sense in\nsource Haskell.  In contrast, we *can* unify (a b) with (t1 -> t2).\nHere's an example (Trac #9858) of how you might do it:\n   i :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep\n   i p = typeRep p\n\n   j = i (Proxy :: Proxy (Eq Int => Int))\nThe type (Proxy (Eq Int => Int)) is only accepted with -XImpredicativeTypes,\nbut suppose we want that.  But then in the call to 'i', we end\nup decomposing (Eq Int => Int), and we definitely don't want that.\n\nThis really only applies to the type checker; in Core, '=>' and '->'\nare the same, as are 'Constraint' and '*'.  But for now I've put\nthe test in repSplitAppTy_maybe, which applies throughout, because\nthe other calls to splitAppTy are in Unify, which is also used by\nthe type checker (e.g. when matching type-function equations).\n\n-}\n\n-- | Applies a type to another, as in e.g. @k a@\nmkAppTy :: Type -> Type -> Type\n  -- See Note [Respecting definitional equality], invariant (EQ1).\nmkAppTy (CastTy fun_ty co) arg_ty\n  | ([arg_co], res_co) <- decomposePiCos co (coercionKind co) [arg_ty]\n  = (fun_ty `mkAppTy` (arg_ty `mkCastTy` arg_co)) `mkCastTy` res_co\n\nmkAppTy (TyConApp tc tys) ty2 = mkTyConApp tc (tys ++ [ty2])\nmkAppTy ty1               ty2 = AppTy ty1 ty2\n        -- Note that the TyConApp could be an\n        -- under-saturated type synonym.  GHC allows that; e.g.\n        --      type Foo k = k a -> k a\n        --      type Id x = x\n        --      foo :: Foo Id -> Foo Id\n        --\n        -- Here Id is partially applied in the type sig for Foo,\n        -- but once the type synonyms are expanded all is well\n        --\n        -- Moreover in TcHsTypes.tcInferApps we build up a type\n        --   (T t1 t2 t3) one argument at a type, thus forming\n        --   (T t1), (T t1 t2), etc\n\nmkAppTys :: Type -> [Type] -> Type\nmkAppTys ty1                []   = ty1\nmkAppTys (CastTy fun_ty co) arg_tys  -- much more efficient then nested mkAppTy\n                                     -- Why do this? See (EQ1) of\n                                     -- Note [Respecting definitional equality]\n                                     -- in TyCoRep\n  = foldl' AppTy ((mkAppTys fun_ty casted_arg_tys) `mkCastTy` res_co) leftovers\n  where\n    (arg_cos, res_co) = decomposePiCos co (coercionKind co) arg_tys\n    (args_to_cast, leftovers) = splitAtList arg_cos arg_tys\n    casted_arg_tys = zipWith mkCastTy args_to_cast arg_cos\nmkAppTys (TyConApp tc tys1) tys2 = mkTyConApp tc (tys1 ++ tys2)\nmkAppTys ty1                tys2 = foldl' AppTy ty1 tys2\n\n-------------\nsplitAppTy_maybe :: Type -> Maybe (Type, Type)\n-- ^ Attempt to take a type application apart, whether it is a\n-- function, type constructor, or plain type application. Note\n-- that type family applications are NEVER unsaturated by this!\nsplitAppTy_maybe ty | Just ty' <- coreView ty\n                    = splitAppTy_maybe ty'\nsplitAppTy_maybe ty = repSplitAppTy_maybe ty\n\n-------------\nrepSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type)\n-- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that\n-- any Core view stuff is already done\nrepSplitAppTy_maybe (FunTy _ ty1 ty2)\n  = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)\n  where\n    rep1 = getRuntimeRep ty1\n    rep2 = getRuntimeRep ty2\n\nrepSplitAppTy_maybe (AppTy ty1 ty2)\n  = Just (ty1, ty2)\n\nrepSplitAppTy_maybe (TyConApp tc tys)\n  | not (mustBeSaturated tc) || tys `lengthExceeds` tyConArity tc\n  , Just (tys', ty') <- snocView tys\n  = Just (TyConApp tc tys', ty')    -- Never create unsaturated type family apps!\n\nrepSplitAppTy_maybe _other = Nothing\n\n-- This one doesn't break apart (c => t).\n-- See Note [Decomposing fat arrow c=>t]\n-- Defined here to avoid module loops between Unify and TcType.\ntcRepSplitAppTy_maybe :: Type -> Maybe (Type,Type)\n-- ^ Does the AppTy split as in 'tcSplitAppTy_maybe', but assumes that\n-- any coreView stuff is already done. Refuses to look through (c => t)\ntcRepSplitAppTy_maybe (FunTy { ft_af = af, ft_arg = ty1, ft_res = ty2 })\n  | InvisArg <- af\n  = Nothing  -- See Note [Decomposing fat arrow c=>t]\n\n  | otherwise\n  = Just (TyConApp funTyCon [rep1, rep2, ty1], ty2)\n  where\n    rep1 = getRuntimeRep ty1\n    rep2 = getRuntimeRep ty2\n\ntcRepSplitAppTy_maybe (AppTy ty1 ty2)    = Just (ty1, ty2)\ntcRepSplitAppTy_maybe (TyConApp tc tys)\n  | not (mustBeSaturated tc) || tys `lengthExceeds` tyConArity tc\n  , Just (tys', ty') <- snocView tys\n  = Just (TyConApp tc tys', ty')    -- Never create unsaturated type family apps!\ntcRepSplitAppTy_maybe _other = Nothing\n\n-------------\nsplitAppTy :: Type -> (Type, Type)\n-- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe',\n-- and panics if this is not possible\nsplitAppTy ty = case splitAppTy_maybe ty of\n                Just pr -> pr\n                Nothing -> panic \"splitAppTy\"\n\n-------------\nsplitAppTys :: Type -> (Type, [Type])\n-- ^ Recursively splits a type as far as is possible, leaving a residual\n-- type being applied to and the type arguments applied to it. Never fails,\n-- even if that means returning an empty list of type applications.\nsplitAppTys ty = split ty ty []\n  where\n    split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args\n    split _       (AppTy ty arg)        args = split ty ty (arg:args)\n    split _       (TyConApp tc tc_args) args\n      = let -- keep type families saturated\n            n | mustBeSaturated tc = tyConArity tc\n              | otherwise          = 0\n            (tc_args1, tc_args2) = splitAt n tc_args\n        in\n        (TyConApp tc tc_args1, tc_args2 ++ args)\n    split _   (FunTy _ ty1 ty2) args\n      = ASSERT( null args )\n        (TyConApp funTyCon [], [rep1, rep2, ty1, ty2])\n      where\n        rep1 = getRuntimeRep ty1\n        rep2 = getRuntimeRep ty2\n\n    split orig_ty _                     args  = (orig_ty, args)\n\n-- | Like 'splitAppTys', but doesn't look through type synonyms\nrepSplitAppTys :: HasDebugCallStack => Type -> (Type, [Type])\nrepSplitAppTys ty = split ty []\n  where\n    split (AppTy ty arg) args = split ty (arg:args)\n    split (TyConApp tc tc_args) args\n      = let n | mustBeSaturated tc = tyConArity tc\n              | otherwise          = 0\n            (tc_args1, tc_args2) = splitAt n tc_args\n        in\n        (TyConApp tc tc_args1, tc_args2 ++ args)\n    split (FunTy _ ty1 ty2) args\n      = ASSERT( null args )\n        (TyConApp funTyCon [], [rep1, rep2, ty1, ty2])\n      where\n        rep1 = getRuntimeRep ty1\n        rep2 = getRuntimeRep ty2\n\n    split ty args = (ty, args)\n\n{-\n                      LitTy\n                      ~~~~~\n-}\n\nmkNumLitTy :: Integer -> Type\nmkNumLitTy n = LitTy (NumTyLit n)\n\n-- | Is this a numeric literal. We also look through type synonyms.\nisNumLitTy :: Type -> Maybe Integer\nisNumLitTy ty | Just ty1 <- coreView ty = isNumLitTy ty1\nisNumLitTy (LitTy (NumTyLit n)) = Just n\nisNumLitTy _                    = Nothing\n\nmkStrLitTy :: FastString -> Type\nmkStrLitTy s = LitTy (StrTyLit s)\n\n-- | Is this a symbol literal. We also look through type synonyms.\nisStrLitTy :: Type -> Maybe FastString\nisStrLitTy ty | Just ty1 <- coreView ty = isStrLitTy ty1\nisStrLitTy (LitTy (StrTyLit s)) = Just s\nisStrLitTy _                    = Nothing\n\n-- | Is this a type literal (symbol or numeric).\nisLitTy :: Type -> Maybe TyLit\nisLitTy ty | Just ty1 <- coreView ty = isLitTy ty1\nisLitTy (LitTy l)                    = Just l\nisLitTy _                            = Nothing\n\n-- | Is this type a custom user error?\n-- If so, give us the kind and the error message.\nuserTypeError_maybe :: Type -> Maybe Type\nuserTypeError_maybe t\n  = do { (tc, _kind : msg : _) <- splitTyConApp_maybe t\n          -- There may be more than 2 arguments, if the type error is\n          -- used as a type constructor (e.g. at kind `Type -> Type`).\n\n       ; guard (tyConName tc == errorMessageTypeErrorFamName)\n       ; return msg }\n\n-- | Render a type corresponding to a user type error into a SDoc.\npprUserTypeErrorTy :: Type -> SDoc\npprUserTypeErrorTy ty =\n  case splitTyConApp_maybe ty of\n\n    -- Text \"Something\"\n    Just (tc,[txt])\n      | tyConName tc == typeErrorTextDataConName\n      , Just str <- isStrLitTy txt -> ftext str\n\n    -- ShowType t\n    Just (tc,[_k,t])\n      | tyConName tc == typeErrorShowTypeDataConName -> ppr t\n\n    -- t1 :<>: t2\n    Just (tc,[t1,t2])\n      | tyConName tc == typeErrorAppendDataConName ->\n        pprUserTypeErrorTy t1 <> pprUserTypeErrorTy t2\n\n    -- t1 :$$: t2\n    Just (tc,[t1,t2])\n      | tyConName tc == typeErrorVAppendDataConName ->\n        pprUserTypeErrorTy t1 $$ pprUserTypeErrorTy t2\n\n    -- An unevaluated type function\n    _ -> ppr ty\n\n\n\n\n{-\n---------------------------------------------------------------------\n                                FunTy\n                                ~~~~~\n\nNote [Representation of function types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nFunctions (e.g. Int -> Char) can be thought of as being applications\nof funTyCon (known in Haskell surface syntax as (->)),\n\n    (->) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                   (a :: TYPE r1) (b :: TYPE r2).\n            a -> b -> Type\n\nHowever, for efficiency's sake we represent saturated applications of (->)\nwith FunTy. For instance, the type,\n\n    (->) r1 r2 a b\n\nis equivalent to,\n\n    FunTy (Anon a) b\n\nNote how the RuntimeReps are implied in the FunTy representation. For this\nreason we must be careful when recontructing the TyConApp representation (see,\nfor instance, splitTyConApp_maybe).\n\nIn the compiler we maintain the invariant that all saturated applications of\n(->) are represented with FunTy.\n\nSee #11714.\n-}\n\nsplitFunTy :: Type -> (Type, Type)\n-- ^ Attempts to extract the argument and result types from a type, and\n-- panics if that is not possible. See also 'splitFunTy_maybe'\nsplitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'\nsplitFunTy (FunTy _ arg res) = (arg, res)\nsplitFunTy other             = pprPanic \"splitFunTy\" (ppr other)\n\nsplitFunTy_maybe :: Type -> Maybe (Type, Type)\n-- ^ Attempts to extract the argument and result types from a type\nsplitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'\nsplitFunTy_maybe (FunTy _ arg res) = Just (arg, res)\nsplitFunTy_maybe _                 = Nothing\n\nsplitFunTys :: Type -> ([Type], Type)\nsplitFunTys ty = split [] ty ty\n  where\n    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'\n    split args _       (FunTy _ arg res) = split (arg:args) res res\n    split args orig_ty _                 = (reverse args, orig_ty)\n\nfunResultTy :: Type -> Type\n-- ^ Extract the function result type and panic if that is not possible\nfunResultTy ty | Just ty' <- coreView ty = funResultTy ty'\nfunResultTy (FunTy { ft_res = res }) = res\nfunResultTy ty                       = pprPanic \"funResultTy\" (ppr ty)\n\nfunArgTy :: Type -> Type\n-- ^ Extract the function argument type and panic if that is not possible\nfunArgTy ty | Just ty' <- coreView ty = funArgTy ty'\nfunArgTy (FunTy { ft_arg = arg })    = arg\nfunArgTy ty                           = pprPanic \"funArgTy\" (ppr ty)\n\n-- ^ Just like 'piResultTys' but for a single argument\n-- Try not to iterate 'piResultTy', because it's inefficient to substitute\n-- one variable at a time; instead use 'piResultTys\"\npiResultTy :: HasDebugCallStack => Type -> Type ->  Type\npiResultTy ty arg = case piResultTy_maybe ty arg of\n                      Just res -> res\n                      Nothing  -> pprPanic \"piResultTy\" (ppr ty $$ ppr arg)\n\npiResultTy_maybe :: Type -> Type -> Maybe Type\n-- We don't need a 'tc' version, because\n-- this function behaves the same for Type and Constraint\npiResultTy_maybe ty arg\n  | Just ty' <- coreView ty = piResultTy_maybe ty' arg\n\n  | FunTy { ft_res = res } <- ty\n  = Just res\n\n  | ForAllTy (Bndr tv _) res <- ty\n  = let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $\n                      tyCoVarsOfTypes [arg,res]\n    in Just (substTy (extendTCvSubst empty_subst tv arg) res)\n\n  | otherwise\n  = Nothing\n\n-- | (piResultTys f_ty [ty1, .., tyn]) gives the type of (f ty1 .. tyn)\n--   where f :: f_ty\n-- 'piResultTys' is interesting because:\n--      1. 'f_ty' may have more for-alls than there are args\n--      2. Less obviously, it may have fewer for-alls\n-- For case 2. think of:\n--   piResultTys (forall a.a) [forall b.b, Int]\n-- This really can happen, but only (I think) in situations involving\n-- undefined.  For example:\n--       undefined :: forall a. a\n-- Term: undefined @(forall b. b->b) @Int\n-- This term should have type (Int -> Int), but notice that\n-- there are more type args than foralls in 'undefined's type.\n\n-- If you edit this function, you may need to update the GHC formalism\n-- See Note [GHC Formalism] in coreSyn/CoreLint.hs\n\n-- This is a heavily used function (e.g. from typeKind),\n-- so we pay attention to efficiency, especially in the special case\n-- where there are no for-alls so we are just dropping arrows from\n-- a function type/kind.\npiResultTys :: HasDebugCallStack => Type -> [Type] -> Type\npiResultTys ty [] = ty\npiResultTys ty orig_args@(arg:args)\n  | Just ty' <- coreView ty\n  = piResultTys ty' orig_args\n\n  | FunTy { ft_res = res } <- ty\n  = piResultTys res args\n\n  | ForAllTy (Bndr tv _) res <- ty\n  = go (extendTCvSubst init_subst tv arg) res args\n\n  | otherwise\n  = pprPanic \"piResultTys1\" (ppr ty $$ ppr orig_args)\n  where\n    init_subst = mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))\n\n    go :: TCvSubst -> Type -> [Type] -> Type\n    go subst ty [] = substTy subst ty\n\n    go subst ty all_args@(arg:args)\n      | Just ty' <- coreView ty\n      = go subst ty' all_args\n\n      | FunTy { ft_res = res } <- ty\n      = go subst res args\n\n      | ForAllTy (Bndr tv _) res <- ty\n      = go (extendTCvSubst subst tv arg) res args\n\n      | not (isEmptyTCvSubst subst)  -- See Note [Care with kind instantiation]\n      = go init_subst\n          (substTy subst ty)\n          all_args\n\n      | otherwise\n      = -- We have not run out of arguments, but the function doesn't\n        -- have the right kind to apply to them; so panic.\n        -- Without the explicit isEmptyVarEnv test, an ill-kinded type\n        -- would give an infniite loop, which is very unhelpful\n        -- c.f. Trac #15473\n        pprPanic \"piResultTys2\" (ppr ty $$ ppr orig_args $$ ppr all_args)\n\napplyTysX :: [TyVar] -> Type -> [Type] -> Type\n-- applyTyxX beta-reduces (/\\tvs. body_ty) arg_tys\n-- Assumes that (/\\tvs. body_ty) is closed\napplyTysX tvs body_ty arg_tys\n  = ASSERT2( arg_tys `lengthAtLeast` n_tvs, pp_stuff )\n    ASSERT2( tyCoVarsOfType body_ty `subVarSet` mkVarSet tvs, pp_stuff )\n    mkAppTys (substTyWith tvs (take n_tvs arg_tys) body_ty)\n             (drop n_tvs arg_tys)\n  where\n    pp_stuff = vcat [ppr tvs, ppr body_ty, ppr arg_tys]\n    n_tvs = length tvs\n\n\n\n{- Note [Care with kind instantiation]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we have\n  T :: forall k. k\nand we are finding the kind of\n  T (forall b. b -> b) * Int\nThen\n  T (forall b. b->b) :: k[ k :-> forall b. b->b]\n                     :: forall b. b -> b\nSo\n  T (forall b. b->b) * :: (b -> b)[ b :-> *]\n                       :: * -> *\n\nIn other words we must intantiate the forall!\n\nSimilarly (Trac #15428)\n   S :: forall k f. k -> f k\nand we are finding the kind of\n   S * (* ->) Int Bool\nWe have\n   S * (* ->) :: (k -> f k)[ k :-> *, f :-> (* ->)]\n              :: * -> * -> *\nSo again we must instantiate.\n\nThe same thing happens in ToIface.toIfaceAppArgsX.\n\n\n---------------------------------------------------------------------\n                                TyConApp\n                                ~~~~~~~~\n-}\n\n-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to\n-- its arguments.  Applies its arguments to the constructor from left to right.\nmkTyConApp :: TyCon -> [Type] -> Type\nmkTyConApp tycon tys\n  | isFunTyCon tycon\n  , [_rep1,_rep2,ty1,ty2] <- tys\n  = FunTy { ft_af = VisArg, ft_arg = ty1, ft_res = ty2 }\n    -- The FunTyCon (->) is always a visible one\n\n  | otherwise\n  = TyConApp tycon tys\n\n-- splitTyConApp \"looks through\" synonyms, because they don't\n-- mean a distinct type, but all other type-constructor applications\n-- including functions are returned as Just ..\n\n-- | Retrieve the tycon heading this type, if there is one. Does /not/\n-- look through synonyms.\ntyConAppTyConPicky_maybe :: Type -> Maybe TyCon\ntyConAppTyConPicky_maybe (TyConApp tc _) = Just tc\ntyConAppTyConPicky_maybe (FunTy {})      = Just funTyCon\ntyConAppTyConPicky_maybe _               = Nothing\n\n\n-- | The same as @fst . splitTyConApp@\ntyConAppTyCon_maybe :: Type -> Maybe TyCon\ntyConAppTyCon_maybe ty | Just ty' <- coreView ty = tyConAppTyCon_maybe ty'\ntyConAppTyCon_maybe (TyConApp tc _) = Just tc\ntyConAppTyCon_maybe (FunTy {})      = Just funTyCon\ntyConAppTyCon_maybe _               = Nothing\n\ntyConAppTyCon :: Type -> TyCon\ntyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic \"tyConAppTyCon\" (ppr ty)\n\n-- | The same as @snd . splitTyConApp@\ntyConAppArgs_maybe :: Type -> Maybe [Type]\ntyConAppArgs_maybe ty | Just ty' <- coreView ty = tyConAppArgs_maybe ty'\ntyConAppArgs_maybe (TyConApp _ tys) = Just tys\ntyConAppArgs_maybe (FunTy _ arg res)\n  | Just rep1 <- getRuntimeRep_maybe arg\n  , Just rep2 <- getRuntimeRep_maybe res\n  = Just [rep1, rep2, arg, res]\ntyConAppArgs_maybe _  = Nothing\n\ntyConAppArgs :: Type -> [Type]\ntyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic \"tyConAppArgs\" (ppr ty)\n\ntyConAppArgN :: Int -> Type -> Type\n-- Executing Nth\ntyConAppArgN n ty\n  = case tyConAppArgs_maybe ty of\n      Just tys -> ASSERT2( tys `lengthExceeds` n, ppr n <+> ppr tys ) tys `getNth` n\n      Nothing  -> pprPanic \"tyConAppArgN\" (ppr n <+> ppr ty)\n\n-- | Attempts to tease a type apart into a type constructor and the application\n-- of a number of arguments to that constructor. Panics if that is not possible.\n-- See also 'splitTyConApp_maybe'\nsplitTyConApp :: Type -> (TyCon, [Type])\nsplitTyConApp ty = case splitTyConApp_maybe ty of\n                   Just stuff -> stuff\n                   Nothing    -> pprPanic \"splitTyConApp\" (ppr ty)\n\n-- | Attempts to tease a type apart into a type constructor and the application\n-- of a number of arguments to that constructor\nsplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])\nsplitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'\nsplitTyConApp_maybe ty                           = repSplitTyConApp_maybe ty\n\n-------------------\nrepSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])\n-- ^ Like 'splitTyConApp_maybe', but doesn't look through synonyms. This\n-- assumes the synonyms have already been dealt with.\n--\n-- Moreover, for a FunTy, it only succeeds if the argument types\n-- have enough info to extract the runtime-rep arguments that\n-- the funTyCon requires.  This will usually be true;\n-- but may be temporarily false during canonicalization:\n--     see Note [FunTy and decomposing tycon applications] in TcCanonical\n--\nrepSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)\nrepSplitTyConApp_maybe (FunTy _ arg res)\n  | Just arg_rep <- getRuntimeRep_maybe arg\n  , Just res_rep <- getRuntimeRep_maybe res\n  = Just (funTyCon, [arg_rep, res_rep, arg, res])\nrepSplitTyConApp_maybe _ = Nothing\n\n-------------------\n-- | Attempts to tease a list type apart and gives the type of the elements if\n-- successful (looks through type synonyms)\nsplitListTyConApp_maybe :: Type -> Maybe Type\nsplitListTyConApp_maybe ty = case splitTyConApp_maybe ty of\n  Just (tc,[e]) | tc == listTyCon -> Just e\n  _other                          -> Nothing\n\nnextRole :: Type -> Role\nnextRole ty\n  | Just (tc, tys) <- splitTyConApp_maybe ty\n  , let num_tys = length tys\n  , num_tys < tyConArity tc\n  = tyConRoles tc `getNth` num_tys\n\n  | otherwise\n  = Nominal\n\nnewTyConInstRhs :: TyCon -> [Type] -> Type\n-- ^ Unwrap one 'layer' of newtype on a type constructor and its\n-- arguments, using an eta-reduced version of the @newtype@ if possible.\n-- This requires tys to have at least @newTyConInstArity tycon@ elements.\nnewTyConInstRhs tycon tys\n    = ASSERT2( tvs `leLength` tys, ppr tycon $$ ppr tys $$ ppr tvs )\n      applyTysX tvs rhs tys\n  where\n    (tvs, rhs) = newTyConEtadRhs tycon\n\n{-\n---------------------------------------------------------------------\n                           CastTy\n                           ~~~~~~\nA casted type has its *kind* casted into something new.\n-}\n\nsplitCastTy_maybe :: Type -> Maybe (Type, Coercion)\nsplitCastTy_maybe ty | Just ty' <- coreView ty = splitCastTy_maybe ty'\nsplitCastTy_maybe (CastTy ty co)               = Just (ty, co)\nsplitCastTy_maybe _                            = Nothing\n\n-- | Make a 'CastTy'. The Coercion must be nominal. Checks the\n-- Coercion for reflexivity, dropping it if it's reflexive.\n-- See Note [Respecting definitional equality] in TyCoRep\nmkCastTy :: Type -> Coercion -> Type\nmkCastTy ty co | isReflexiveCo co = ty  -- (EQ2) from the Note\n-- NB: Do the slow check here. This is important to keep the splitXXX\n-- functions working properly. Otherwise, we may end up with something\n-- like (((->) |> something_reflexive_but_not_obviously_so) biz baz)\n-- fails under splitFunTy_maybe. This happened with the cheaper check\n-- in test dependent/should_compile/dynamic-paper.\n\nmkCastTy (CastTy ty co1) co2\n  -- (EQ3) from the Note\n  = mkCastTy ty (co1 `mkTransCo` co2)\n      -- call mkCastTy again for the reflexivity check\n\nmkCastTy (ForAllTy (Bndr tv vis) inner_ty) co\n  -- (EQ4) from the Note\n  | isTyVar tv\n  , let fvs = tyCoVarsOfCo co\n  = -- have to make sure that pushing the co in doesn't capture the bound var!\n    if tv `elemVarSet` fvs\n    then let empty_subst = mkEmptyTCvSubst (mkInScopeSet fvs)\n             (subst, tv') = substVarBndr empty_subst tv\n         in ForAllTy (Bndr tv' vis) (substTy subst inner_ty `mkCastTy` co)\n    else ForAllTy (Bndr tv vis) (inner_ty `mkCastTy` co)\n\nmkCastTy ty co = CastTy ty co\n\ntyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder]\n-- Return the tyConBinders in TyCoBinder form\ntyConBindersTyCoBinders = map to_tyb\n  where\n    to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis)\n    to_tyb (Bndr tv (AnonTCB af))   = Anon af (varType tv)\n\n{-\n--------------------------------------------------------------------\n                            CoercionTy\n                            ~~~~~~~~~~\nCoercionTy allows us to inject coercions into types. A CoercionTy\nshould appear only in the right-hand side of an application.\n-}\n\nmkCoercionTy :: Coercion -> Type\nmkCoercionTy = CoercionTy\n\nisCoercionTy :: Type -> Bool\nisCoercionTy (CoercionTy _) = True\nisCoercionTy _              = False\n\nisCoercionTy_maybe :: Type -> Maybe Coercion\nisCoercionTy_maybe (CoercionTy co) = Just co\nisCoercionTy_maybe _               = Nothing\n\nstripCoercionTy :: Type -> Coercion\nstripCoercionTy (CoercionTy co) = co\nstripCoercionTy ty              = pprPanic \"stripCoercionTy\" (ppr ty)\n\n{-\n---------------------------------------------------------------------\n                                SynTy\n                                ~~~~~\n\nNotes on type synonyms\n~~~~~~~~~~~~~~~~~~~~~~\nThe various \"split\" functions (splitFunTy, splitRhoTy, splitForAllTy) try\nto return type synonyms wherever possible. Thus\n\n        type Foo a = a -> a\n\nwe want\n        splitFunTys (a -> Foo a) = ([a], Foo a)\nnot                                ([a], a -> a)\n\nThe reason is that we then get better (shorter) type signatures in\ninterfaces.  Notably this plays a role in tcTySigs in TcBinds.hs.\n\n\n---------------------------------------------------------------------\n                                ForAllTy\n                                ~~~~~~~~\n-}\n\n-- | Make a dependent forall over an 'Inferred' variable\nmkTyCoInvForAllTy :: TyCoVar -> Type -> Type\nmkTyCoInvForAllTy tv ty\n  | isCoVar tv\n  , not (tv `elemVarSet` tyCoVarsOfType ty)\n  = mkVisFunTy (varType tv) ty\n  | otherwise\n  = ForAllTy (Bndr tv Inferred) ty\n\n-- | Like 'mkTyCoInvForAllTy', but tv should be a tyvar\nmkInvForAllTy :: TyVar -> Type -> Type\nmkInvForAllTy tv ty = ASSERT( isTyVar tv )\n                      ForAllTy (Bndr tv Inferred) ty\n\n-- | Like 'mkForAllTys', but assumes all variables are dependent and\n-- 'Inferred', a common case\nmkTyCoInvForAllTys :: [TyCoVar] -> Type -> Type\nmkTyCoInvForAllTys tvs ty = foldr mkTyCoInvForAllTy ty tvs\n\n-- | Like 'mkTyCoInvForAllTys', but tvs should be a list of tyvar\nmkInvForAllTys :: [TyVar] -> Type -> Type\nmkInvForAllTys tvs ty = foldr mkInvForAllTy ty tvs\n\n-- | Like 'mkForAllTy', but assumes the variable is dependent and 'Specified',\n-- a common case\nmkSpecForAllTy :: TyVar -> Type -> Type\nmkSpecForAllTy tv ty = ASSERT( isTyVar tv )\n                       -- covar is always Inferred, so input should be tyvar\n                       ForAllTy (Bndr tv Specified) ty\n\n-- | Like 'mkForAllTys', but assumes all variables are dependent and\n-- 'Specified', a common case\nmkSpecForAllTys :: [TyVar] -> Type -> Type\nmkSpecForAllTys tvs ty = foldr mkSpecForAllTy ty tvs\n\n-- | Like mkForAllTys, but assumes all variables are dependent and visible\nmkVisForAllTys :: [TyVar] -> Type -> Type\nmkVisForAllTys tvs = ASSERT( all isTyVar tvs )\n                     -- covar is always Inferred, so all inputs should be tyvar\n                     mkForAllTys [ Bndr tv Required | tv <- tvs ]\n\nmkLamType  :: Var -> Type -> Type\n-- ^ Makes a @(->)@ type or an implicit forall type, depending\n-- on whether it is given a type variable or a term variable.\n-- This is used, for example, when producing the type of a lambda.\n-- Always uses Inferred binders.\nmkLamTypes :: [Var] -> Type -> Type\n-- ^ 'mkLamType' for multiple type or value arguments\n\nmkLamType v body_ty\n   | isTyVar v\n   = ForAllTy (Bndr v Inferred) body_ty\n\n   | isCoVar v\n   , v `elemVarSet` tyCoVarsOfType body_ty\n   = ForAllTy (Bndr v Required) body_ty\n\n   | isPredTy arg_ty  -- See Note [mkLamType: dictionary arguments]\n   = mkInvisFunTy arg_ty body_ty\n\n   | otherwise\n   = mkVisFunTy arg_ty body_ty\n   where\n     arg_ty = varType v\n\nmkLamTypes vs ty = foldr mkLamType ty vs\n\n{- Note [mkLamType: dictionary arguments]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIf we have (\\ (d :: Ord a). blah), we want to give it type\n           (Ord a => blah_ty)\nwith a fat arrow; that is, using mkInvisFunTy, not mkVisFunTy.\n\nWhy? After all, we are in Core, where (=>) and (->) behave the same.\nYes, but the /specialiser/ does treat dictionary arguments specially.\nSuppose we do w/w on 'foo' in module A, thus (Trac #11272, #6056)\n   foo :: Ord a => Int -> blah\n   foo a d x = case x of I# x' -> $wfoo @a d x'\n\n   $wfoo :: Ord a => Int# -> blah\n\nNow in module B we see (foo @Int dOrdInt).  The specialiser will\nspecialise this to $sfoo, where\n   $sfoo :: Int -> blah\n   $sfoo x = case x of I# x' -> $wfoo @Int dOrdInt x'\n\nNow we /must/ also specialise $wfoo!  But it wasn't user-written,\nand has a type built with mkLamTypes.\n\nConclusion: the easiest thing is to make mkLamType build\n            (c => ty)\nwhen the argument is a predicate type.  See TyCoRep\nNote [Types for coercions, predicates, and evidence]\n-}\n\n-- | Given a list of type-level vars and the free vars of a result kind,\n-- makes TyCoBinders, preferring anonymous binders\n-- if the variable is, in fact, not dependent.\n-- e.g.    mkTyConBindersPreferAnon [(k:*),(b:k),(c:k)] (k->k)\n-- We want (k:*) Named, (b:k) Anon, (c:k) Anon\n--\n-- All non-coercion binders are /visible/.\nmkTyConBindersPreferAnon :: [TyVar]      -- ^ binders\n                         -> TyCoVarSet   -- ^ free variables of result\n                         -> [TyConBinder]\nmkTyConBindersPreferAnon vars inner_tkvs = ASSERT( all isTyVar vars)\n                                           fst (go vars)\n  where\n    go :: [TyVar] -> ([TyConBinder], VarSet) -- also returns the free vars\n    go [] = ([], inner_tkvs)\n    go (v:vs) | v `elemVarSet` fvs\n              = ( Bndr v (NamedTCB Required) : binders\n                , fvs `delVarSet` v `unionVarSet` kind_vars )\n              | otherwise\n              = ( Bndr v (AnonTCB VisArg) : binders\n                , fvs `unionVarSet` kind_vars )\n      where\n        (binders, fvs) = go vs\n        kind_vars      = tyCoVarsOfType $ tyVarKind v\n\n-- | Take a ForAllTy apart, returning the list of tycovars and the result type.\n-- This always succeeds, even if it returns only an empty list. Note that the\n-- result type returned may have free variables that were bound by a forall.\nsplitForAllTys :: Type -> ([TyCoVar], Type)\nsplitForAllTys ty = split ty ty []\n  where\n    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs\n    split _       (ForAllTy (Bndr tv _) ty)    tvs = split ty ty (tv:tvs)\n    split orig_ty _                            tvs = (reverse tvs, orig_ty)\n\n-- | Like 'splitForAllTys', but only splits a 'ForAllTy' if\n-- @'sameVis' argf supplied_argf@ is 'True', where @argf@ is the visibility\n-- of the @ForAllTy@'s binder and @supplied_argf@ is the visibility provided\n-- as an argument to this function.\nsplitForAllTysSameVis :: ArgFlag -> Type -> ([TyCoVar], Type)\nsplitForAllTysSameVis supplied_argf ty = split ty ty []\n  where\n    split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs\n    split _       (ForAllTy (Bndr tv argf) ty) tvs\n      | argf `sameVis` supplied_argf               = split ty ty (tv:tvs)\n    split orig_ty _                            tvs = (reverse tvs, orig_ty)\n\n-- | Like splitForAllTys, but split only for tyvars.\n-- This always succeeds, even if it returns only an empty list. Note that the\n-- result type returned may have free variables that were bound by a forall.\nsplitTyVarForAllTys :: Type -> ([TyVar], Type)\nsplitTyVarForAllTys ty = split ty ty []\n  where\n    split orig_ty ty tvs | Just ty' <- coreView ty     = split orig_ty ty' tvs\n    split _ (ForAllTy (Bndr tv _) ty) tvs | isTyVar tv = split ty ty (tv:tvs)\n    split orig_ty _                   tvs              = (reverse tvs, orig_ty)\n\n-- | Checks whether this is a proper forall (with a named binder)\nisForAllTy :: Type -> Bool\nisForAllTy ty | Just ty' <- coreView ty = isForAllTy ty'\nisForAllTy (ForAllTy {}) = True\nisForAllTy _             = False\n\n-- | Like `isForAllTy`, but returns True only if it is a tyvar binder\nisForAllTy_ty :: Type -> Bool\nisForAllTy_ty ty | Just ty' <- coreView ty = isForAllTy_ty ty'\nisForAllTy_ty (ForAllTy (Bndr tv _) _) | isTyVar tv = True\nisForAllTy_ty _             = False\n\n-- | Like `isForAllTy`, but returns True only if it is a covar binder\nisForAllTy_co :: Type -> Bool\nisForAllTy_co ty | Just ty' <- coreView ty = isForAllTy_co ty'\nisForAllTy_co (ForAllTy (Bndr tv _) _) | isCoVar tv = True\nisForAllTy_co _             = False\n\n-- | Is this a function or forall?\nisPiTy :: Type -> Bool\nisPiTy ty | Just ty' <- coreView ty = isPiTy ty'\nisPiTy (ForAllTy {}) = True\nisPiTy (FunTy {})    = True\nisPiTy _             = False\n\n-- | Is this a function?\nisFunTy :: Type -> Bool\nisFunTy ty | Just ty' <- coreView ty = isFunTy ty'\nisFunTy (FunTy {}) = True\nisFunTy _          = False\n\n-- | Take a forall type apart, or panics if that is not possible.\nsplitForAllTy :: Type -> (TyCoVar, Type)\nsplitForAllTy ty\n  | Just answer <- splitForAllTy_maybe ty = answer\n  | otherwise                             = pprPanic \"splitForAllTy\" (ppr ty)\n\n-- | Drops all ForAllTys\ndropForAlls :: Type -> Type\ndropForAlls ty = go ty\n  where\n    go ty | Just ty' <- coreView ty = go ty'\n    go (ForAllTy _ res)            = go res\n    go res                         = res\n\n-- | Attempts to take a forall type apart, but only if it's a proper forall,\n-- with a named binder\nsplitForAllTy_maybe :: Type -> Maybe (TyCoVar, Type)\nsplitForAllTy_maybe ty = go ty\n  where\n    go ty | Just ty' <- coreView ty = go ty'\n    go (ForAllTy (Bndr tv _) ty)    = Just (tv, ty)\n    go _                            = Nothing\n\n-- | Like splitForAllTy_maybe, but only returns Just if it is a tyvar binder.\nsplitForAllTy_ty_maybe :: Type -> Maybe (TyCoVar, Type)\nsplitForAllTy_ty_maybe ty = go ty\n  where\n    go ty | Just ty' <- coreView ty = go ty'\n    go (ForAllTy (Bndr tv _) ty) | isTyVar tv = Just (tv, ty)\n    go _                            = Nothing\n\n-- | Like splitForAllTy_maybe, but only returns Just if it is a covar binder.\nsplitForAllTy_co_maybe :: Type -> Maybe (TyCoVar, Type)\nsplitForAllTy_co_maybe ty = go ty\n  where\n    go ty | Just ty' <- coreView ty = go ty'\n    go (ForAllTy (Bndr tv _) ty) | isCoVar tv = Just (tv, ty)\n    go _                            = Nothing\n\n-- | Attempts to take a forall type apart; works with proper foralls and\n-- functions\nsplitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type)\nsplitPiTy_maybe ty = go ty\n  where\n    go ty | Just ty' <- coreView ty = go ty'\n    go (ForAllTy bndr ty) = Just (Named bndr, ty)\n    go (FunTy { ft_af = af, ft_arg = arg, ft_res = res})\n                          = Just (Anon af arg, res)\n    go _                  = Nothing\n\n-- | Takes a forall type apart, or panics\nsplitPiTy :: Type -> (TyCoBinder, Type)\nsplitPiTy ty\n  | Just answer <- splitPiTy_maybe ty = answer\n  | otherwise                         = pprPanic \"splitPiTy\" (ppr ty)\n\n-- | Split off all TyCoBinders to a type, splitting both proper foralls\n-- and functions\nsplitPiTys :: Type -> ([TyCoBinder], Type)\nsplitPiTys ty = split ty ty []\n  where\n    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs\n    split _       (ForAllTy b res) bs = split res res (Named b  : bs)\n    split _       (FunTy { ft_af = af, ft_arg = arg, ft_res = res }) bs\n                                      = split res res (Anon af arg : bs)\n    split orig_ty _                bs = (reverse bs, orig_ty)\n\n-- | Like 'splitPiTys' but split off only /named/ binders\n--   and returns TyCoVarBinders rather than TyCoBinders\nsplitForAllVarBndrs :: Type -> ([TyCoVarBinder], Type)\nsplitForAllVarBndrs ty = split ty ty []\n  where\n    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs\n    split _       (ForAllTy b res) bs = split res res (b:bs)\n    split orig_ty _                bs = (reverse bs, orig_ty)\n{-# INLINE splitForAllVarBndrs #-}\n\ninvisibleTyBndrCount :: Type -> Int\n-- Returns the number of leading invisible forall'd binders in the type\n-- Includes invisible predicate arguments; e.g. for\n--    e.g.  forall {k}. (k ~ *) => k -> k\n-- returns 2 not 1\ninvisibleTyBndrCount ty = length (fst (splitPiTysInvisible ty))\n\n-- Like splitPiTys, but returns only *invisible* binders, including constraints\n-- Stops at the first visible binder\nsplitPiTysInvisible :: Type -> ([TyCoBinder], Type)\nsplitPiTysInvisible ty = split ty ty []\n   where\n    split orig_ty ty bs\n      | Just ty' <- coreView ty  = split orig_ty ty' bs\n    split _ (ForAllTy b res) bs\n      | Bndr _ vis <- b\n      , isInvisibleArgFlag vis   = split res res (Named b  : bs)\n    split _ (FunTy { ft_af = InvisArg, ft_arg = arg, ft_res = res })  bs\n                                 = split res res (Anon InvisArg arg : bs)\n    split orig_ty _          bs  = (reverse bs, orig_ty)\n\nsplitPiTysInvisibleN :: Int -> Type -> ([TyCoBinder], Type)\n-- Same as splitPiTysInvisible, but stop when\n--   - you have found 'n' TyCoBinders,\n--   - or you run out of invisible binders\nsplitPiTysInvisibleN n ty = split n ty ty []\n   where\n    split n orig_ty ty bs\n      | n == 0                  = (reverse bs, orig_ty)\n      | Just ty' <- coreView ty = split n orig_ty ty' bs\n      | ForAllTy b res <- ty\n      , Bndr _ vis <- b\n      , isInvisibleArgFlag vis  = split (n-1) res res (Named b  : bs)\n      | FunTy { ft_af = InvisArg, ft_arg = arg, ft_res = res } <- ty\n                                = split (n-1) res res (Anon InvisArg arg : bs)\n      | otherwise               = (reverse bs, orig_ty)\n\n-- | Given a 'TyCon' and a list of argument types, filter out any invisible\n-- (i.e., 'Inferred' or 'Specified') arguments.\nfilterOutInvisibleTypes :: TyCon -> [Type] -> [Type]\nfilterOutInvisibleTypes tc tys = snd $ partitionInvisibleTypes tc tys\n\n-- | Given a 'TyCon' and a list of argument types, filter out any 'Inferred'\n-- arguments.\nfilterOutInferredTypes :: TyCon -> [Type] -> [Type]\nfilterOutInferredTypes tc tys =\n  filterByList (map (/= Inferred) $ tyConArgFlags tc tys) tys\n\n-- | Given a 'TyCon' and a list of argument types, partition the arguments\n-- into:\n--\n-- 1. 'Inferred' or 'Specified' (i.e., invisible) arguments and\n--\n-- 2. 'Required' (i.e., visible) arguments\npartitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type])\npartitionInvisibleTypes tc tys =\n  partitionByList (map isInvisibleArgFlag $ tyConArgFlags tc tys) tys\n\n-- | Given a list of things paired with their visibilities, partition the\n-- things into (invisible things, visible things).\npartitionInvisibles :: [(a, ArgFlag)] -> ([a], [a])\npartitionInvisibles = partitionWith pick_invis\n  where\n    pick_invis :: (a, ArgFlag) -> Either a a\n    pick_invis (thing, vis) | isInvisibleArgFlag vis = Left thing\n                            | otherwise              = Right thing\n\n-- | Given a 'TyCon' and a list of argument types to which the 'TyCon' is\n-- applied, determine each argument's visibility\n-- ('Inferred', 'Specified', or 'Required').\n--\n-- Wrinkle: consider the following scenario:\n--\n-- > T :: forall k. k -> k\n-- > tyConArgFlags T [forall m. m -> m -> m, S, R, Q]\n--\n-- After substituting, we get\n--\n-- > T (forall m. m -> m -> m) :: (forall m. m -> m -> m) -> forall n. n -> n -> n\n--\n-- Thus, the first argument is invisible, @S@ is visible, @R@ is invisible again,\n-- and @Q@ is visible.\ntyConArgFlags :: TyCon -> [Type] -> [ArgFlag]\ntyConArgFlags tc = fun_kind_arg_flags (tyConKind tc)\n\n-- | Given a 'Type' and a list of argument types to which the 'Type' is\n-- applied, determine each argument's visibility\n-- ('Inferred', 'Specified', or 'Required').\n--\n-- Most of the time, the arguments will be 'Required', but not always. Consider\n-- @f :: forall a. a -> Type@. In @f Type Bool@, the first argument (@Type@) is\n-- 'Specified' and the second argument (@Bool@) is 'Required'. It is precisely\n-- this sort of higher-rank situation in which 'appTyArgFlags' comes in handy,\n-- since @f Type Bool@ would be represented in Core using 'AppTy's.\n-- (See also Trac #15792).\nappTyArgFlags :: Type -> [Type] -> [ArgFlag]\nappTyArgFlags ty = fun_kind_arg_flags (typeKind ty)\n\n-- | Given a function kind and a list of argument types (where each argument's\n-- kind aligns with the corresponding position in the argument kind), determine\n-- each argument's visibility ('Inferred', 'Specified', or 'Required').\nfun_kind_arg_flags :: Kind -> [Type] -> [ArgFlag]\nfun_kind_arg_flags = go emptyTCvSubst\n  where\n    go subst ki arg_tys\n      | Just ki' <- coreView ki = go subst ki' arg_tys\n    go _ _ [] = []\n    go subst (ForAllTy (Bndr tv argf) res_ki) (arg_ty:arg_tys)\n      = argf : go subst' res_ki arg_tys\n      where\n        subst' = extendTvSubst subst tv arg_ty\n    go subst (TyVarTy tv) arg_tys\n      | Just ki <- lookupTyVar subst tv = go subst ki arg_tys\n    go _ _ arg_tys = map (const Required) arg_tys\n                        -- something is ill-kinded. But this can happen\n                        -- when printing errors. Assume everything is Required.\n\n-- @isTauTy@ tests if a type has no foralls\nisTauTy :: Type -> Bool\nisTauTy ty | Just ty' <- coreView ty = isTauTy ty'\nisTauTy (TyVarTy _)           = True\nisTauTy (LitTy {})            = True\nisTauTy (TyConApp tc tys)     = all isTauTy tys && isTauTyCon tc\nisTauTy (AppTy a b)           = isTauTy a && isTauTy b\nisTauTy (FunTy _ a b)         = isTauTy a && isTauTy b\nisTauTy (ForAllTy {})         = False\nisTauTy (CastTy ty _)         = isTauTy ty\nisTauTy (CoercionTy _)        = False  -- Not sure about this\n\n{-\n%************************************************************************\n%*                                                                      *\n   TyCoBinders\n%*                                                                      *\n%************************************************************************\n-}\n\n-- | Make an anonymous binder\nmkAnonBinder :: AnonArgFlag -> Type -> TyCoBinder\nmkAnonBinder = Anon\n\n-- | Does this binder bind a variable that is /not/ erased? Returns\n-- 'True' for anonymous binders.\nisAnonTyCoBinder :: TyCoBinder -> Bool\nisAnonTyCoBinder (Named {}) = False\nisAnonTyCoBinder (Anon {})  = True\n\ntyCoBinderVar_maybe :: TyCoBinder -> Maybe TyCoVar\ntyCoBinderVar_maybe (Named tv) = Just $ binderVar tv\ntyCoBinderVar_maybe _          = Nothing\n\ntyCoBinderType :: TyCoBinder -> Type\n-- Barely used\ntyCoBinderType (Named tvb) = binderType tvb\ntyCoBinderType (Anon _ ty) = ty\n\ntyBinderType :: TyBinder -> Type\ntyBinderType (Named (Bndr tv _))\n  = ASSERT( isTyVar tv )\n    tyVarKind tv\ntyBinderType (Anon _ ty)   = ty\n\n-- | Extract a relevant type, if there is one.\nbinderRelevantType_maybe :: TyCoBinder -> Maybe Type\nbinderRelevantType_maybe (Named {})  = Nothing\nbinderRelevantType_maybe (Anon _ ty) = Just ty\n\n{-\n%************************************************************************\n%*                                                                      *\n                         Pred\n*                                                                      *\n************************************************************************\n\nPredicates on PredType\n\nNote [Evidence for quantified constraints]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe superclass mechanism in TcCanonical.makeSuperClasses risks\ntaking a quantified constraint like\n   (forall a. C a => a ~ b)\nand generate superclass evidence\n   (forall a. C a => a ~# b)\n\nThis is a funny thing: neither isPredTy nor isCoVarType are true\nof it.  So we are careful not to generate it in the first place:\nsee Note [Equality superclasses in quantified constraints]\nin TcCanonical.\n-}\n\n-- | Split a type constructor application into its type constructor and\n-- applied types. Note that this may fail in the case of a 'FunTy' with an\n-- argument of unknown kind 'FunTy' (e.g. @FunTy (a :: k) Int@. since the kind\n-- of @a@ isn't of the form @TYPE rep@). Consequently, you may need to zonk your\n-- type before using this function.\n--\n-- If you only need the 'TyCon', consider using 'tcTyConAppTyCon_maybe'.\ntcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type])\n-- Defined here to avoid module loops between Unify and TcType.\ntcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'\ntcSplitTyConApp_maybe ty                         = repSplitTyConApp_maybe ty\n\n-- tcIsConstraintKind stuf only makes sense in the typechecker\n-- After that Constraint = Type\n-- See Note [coreView vs tcView]\n-- Defined here because it is used in isPredTy and tcRepSplitAppTy_maybe (sigh)\ntcIsConstraintKind :: Kind -> Bool\ntcIsConstraintKind ty\n  | Just (tc, args) <- tcSplitTyConApp_maybe ty    -- Note: tcSplit here\n  , isConstraintKindCon tc\n  = ASSERT2( null args, ppr ty ) True\n\n  | otherwise\n  = False\n\n-- | Is this kind equivalent to @*@?\n--\n-- This considers 'Constraint' to be distinct from @*@. For a version that\n-- treats them as the same type, see 'isLiftedTypeKind'.\ntcIsLiftedTypeKind :: Kind -> Bool\ntcIsLiftedTypeKind ty\n  | Just (tc, [arg]) <- tcSplitTyConApp_maybe ty    -- Note: tcSplit here\n  , tc `hasKey` tYPETyConKey\n  = isLiftedRuntimeRep arg\n  | otherwise\n  = False\n\ntcReturnsConstraintKind :: Kind -> Bool\n-- True <=> the Kind ultimately returns a Constraint\n--   E.g.  * -> Constraint\n--         forall k. k -> Constraint\ntcReturnsConstraintKind kind\n  | Just kind' <- tcView kind = tcReturnsConstraintKind kind'\ntcReturnsConstraintKind (ForAllTy _ ty)         = tcReturnsConstraintKind ty\ntcReturnsConstraintKind (FunTy { ft_res = ty }) = tcReturnsConstraintKind ty\ntcReturnsConstraintKind (TyConApp tc _)         = isConstraintKindCon tc\ntcReturnsConstraintKind _                       = False\n\nisEvVarType :: Type -> Bool\n-- True of (a) predicates, of kind Constraint, such as (Eq a), and (a ~ b)\n--         (b) coercion types, such as (t1 ~# t2) or (t1 ~R# t2)\n-- See Note [Types for coercions, predicates, and evidence]\n-- See Note [Evidence for quantified constraints]\nisEvVarType ty = isCoVarType ty || isPredTy ty\n\n-- | Does this type classify a core (unlifted) Coercion?\n-- At either role nominal or representational\n--    (t1 ~# t2) or (t1 ~R# t2)\n-- See Note [Types for coercions, predicates, and evidence]\nisCoVarType :: Type -> Bool\nisCoVarType ty = isEqPrimPred ty\n\nisEqPredClass :: Class -> Bool\n-- True of (~) and (~~)\nisEqPredClass cls =  cls `hasKey` eqTyConKey\n                  || cls `hasKey` heqTyConKey\n\nisClassPred, isEqPred, isEqPrimPred, isIPPred :: PredType -> Bool\nisClassPred ty = case tyConAppTyCon_maybe ty of\n    Just tyCon | isClassTyCon tyCon -> True\n    _                               -> False\n\nisEqPred ty  -- True of (a ~ b) and (a ~~ b)\n             -- ToDo: should we check saturation?\n  | Just tc <- tyConAppTyCon_maybe ty\n  , Just cls <- tyConClass_maybe tc\n  = isEqPredClass cls\n  | otherwise\n  = False\n\nisEqPrimPred ty  -- True of (a ~# b) (a ~R# b)\n             -- ToDo: should we check saturation?\n  | Just tc <- tyConAppTyCon_maybe ty\n  = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey\n  | otherwise\n  = False\n\nisIPPred ty = case tyConAppTyCon_maybe ty of\n    Just tc -> isIPTyCon tc\n    _       -> False\n\nisIPTyCon :: TyCon -> Bool\nisIPTyCon tc = tc `hasKey` ipClassKey\n  -- Class and its corresponding TyCon have the same Unique\n\nisIPClass :: Class -> Bool\nisIPClass cls = cls `hasKey` ipClassKey\n\nisCTupleClass :: Class -> Bool\nisCTupleClass cls = isTupleTyCon (classTyCon cls)\n\nisIPPred_maybe :: Type -> Maybe (FastString, Type)\nisIPPred_maybe ty =\n  do (tc,[t1,t2]) <- splitTyConApp_maybe ty\n     guard (isIPTyCon tc)\n     x <- isStrLitTy t1\n     return (x,t2)\n\n{-\nMake PredTypes\n\n--------------------- Equality types ---------------------------------\n-}\n\n-- | Makes a lifted equality predicate at the given role\nmkPrimEqPredRole :: Role -> Type -> Type -> PredType\nmkPrimEqPredRole Nominal          = mkPrimEqPred\nmkPrimEqPredRole Representational = mkReprPrimEqPred\nmkPrimEqPredRole Phantom          = panic \"mkPrimEqPredRole phantom\"\n\n-- | Creates a primitive type equality predicate.\n-- Invariant: the types are not Coercions\nmkPrimEqPred :: Type -> Type -> Type\nmkPrimEqPred ty1 ty2\n  = TyConApp eqPrimTyCon [k1, k2, ty1, ty2]\n  where\n    k1 = typeKind ty1\n    k2 = typeKind ty2\n\n-- | Creates a primite type equality predicate with explicit kinds\nmkHeteroPrimEqPred :: Kind -> Kind -> Type -> Type -> Type\nmkHeteroPrimEqPred k1 k2 ty1 ty2 = TyConApp eqPrimTyCon [k1, k2, ty1, ty2]\n\n-- | Creates a primitive representational type equality predicate\n-- with explicit kinds\nmkHeteroReprPrimEqPred :: Kind -> Kind -> Type -> Type -> Type\nmkHeteroReprPrimEqPred k1 k2 ty1 ty2\n  = TyConApp eqReprPrimTyCon [k1, k2, ty1, ty2]\n\n-- | Try to split up a coercion type into the types that it coerces\nsplitCoercionType_maybe :: Type -> Maybe (Type, Type)\nsplitCoercionType_maybe ty\n  = do { (tc, [_, _, ty1, ty2]) <- splitTyConApp_maybe ty\n       ; guard $ tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey\n       ; return (ty1, ty2) }\n\nmkReprPrimEqPred :: Type -> Type -> Type\nmkReprPrimEqPred ty1  ty2\n  = TyConApp eqReprPrimTyCon [k1, k2, ty1, ty2]\n  where\n    k1 = typeKind ty1\n    k2 = typeKind ty2\n\nequalityTyCon :: Role -> TyCon\nequalityTyCon Nominal          = eqPrimTyCon\nequalityTyCon Representational = eqReprPrimTyCon\nequalityTyCon Phantom          = eqPhantPrimTyCon\n\n-- --------------------- Dictionary types ---------------------------------\n\nmkClassPred :: Class -> [Type] -> PredType\nmkClassPred clas tys = TyConApp (classTyCon clas) tys\n\nisDictTy :: Type -> Bool\nisDictTy = isClassPred\n\nisDictLikeTy :: Type -> Bool\n-- Note [Dictionary-like types]\nisDictLikeTy ty | Just ty' <- coreView ty = isDictLikeTy ty'\nisDictLikeTy ty = case splitTyConApp_maybe ty of\n        Just (tc, tys) | isClassTyCon tc -> True\n                       | isTupleTyCon tc -> all isDictLikeTy tys\n        _other                           -> False\n\n{- Note [Dictionary-like types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nBeing \"dictionary-like\" means either a dictionary type or a tuple thereof.\nIn GHC 6.10 we build implication constraints which construct such tuples,\nand if we land up with a binding\n    t :: (C [a], Eq [a])\n    t = blah\nthen we want to treat t as cheap under \"-fdicts-cheap\" for example.\n(Implication constraints are normally inlined, but sadly not if the\noccurrence is itself inside an INLINE function!  Until we revise the\nhandling of implication constraints, that is.)  This turned out to\nbe important in getting good arities in DPH code.  Example:\n\n    class C a\n    class D a where { foo :: a -> a }\n    instance C a => D (Maybe a) where { foo x = x }\n\n    bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)\n    {-# INLINE bar #-}\n    bar x y = (foo (Just x), foo (Just y))\n\nThen 'bar' should jolly well have arity 4 (two dicts, two args), but\nwe ended up with something like\n   bar = __inline_me__ (\\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...\n                                in \\x,y. <blah>)\n\nThis is all a bit ad-hoc; eg it relies on knowing that implication\nconstraints build tuples.\n\nToDo: it would be far easier just to use isPredTy.\n-}\n\n-- | A choice of equality relation. This is separate from the type 'Role'\n-- because 'Phantom' does not define a (non-trivial) equality relation.\ndata EqRel = NomEq | ReprEq\n  deriving (Eq, Ord)\n\ninstance Outputable EqRel where\n  ppr NomEq  = text \"nominal equality\"\n  ppr ReprEq = text \"representational equality\"\n\neqRelRole :: EqRel -> Role\neqRelRole NomEq  = Nominal\neqRelRole ReprEq = Representational\n\ndata PredTree\n  = ClassPred Class [Type]\n  | EqPred EqRel Type Type\n  | IrredPred PredType\n  | ForAllPred [TyCoVarBinder] [PredType] PredType\n     -- ForAllPred: see Note [Quantified constraints] in TcCanonical\n  -- NB: There is no TuplePred case\n  --     Tuple predicates like (Eq a, Ord b) are just treated\n  --     as ClassPred, as if we had a tuple class with two superclasses\n  --        class (c1, c2) => (%,%) c1 c2\n\nclassifyPredType :: PredType -> PredTree\nclassifyPredType ev_ty = case splitTyConApp_maybe ev_ty of\n    Just (tc, [_, _, ty1, ty2])\n      | tc `hasKey` eqReprPrimTyConKey -> EqPred ReprEq ty1 ty2\n      | tc `hasKey` eqPrimTyConKey     -> EqPred NomEq ty1 ty2\n\n    Just (tc, tys)\n      | Just clas <- tyConClass_maybe tc\n      -> ClassPred clas tys\n\n    _ | (tvs, rho) <- splitForAllVarBndrs ev_ty\n      , (theta, pred) <- splitFunTys rho\n      , not (null tvs && null theta)\n      -> ForAllPred tvs theta pred\n\n      | otherwise\n      -> IrredPred ev_ty\n\ngetClassPredTys :: HasDebugCallStack => PredType -> (Class, [Type])\ngetClassPredTys ty = case getClassPredTys_maybe ty of\n        Just (clas, tys) -> (clas, tys)\n        Nothing          -> pprPanic \"getClassPredTys\" (ppr ty)\n\ngetClassPredTys_maybe :: PredType -> Maybe (Class, [Type])\ngetClassPredTys_maybe ty = case splitTyConApp_maybe ty of\n        Just (tc, tys) | Just clas <- tyConClass_maybe tc -> Just (clas, tys)\n        _ -> Nothing\n\ngetEqPredTys :: PredType -> (Type, Type)\ngetEqPredTys ty\n  = case splitTyConApp_maybe ty of\n      Just (tc, [_, _, ty1, ty2])\n        |  tc `hasKey` eqPrimTyConKey\n        || tc `hasKey` eqReprPrimTyConKey\n        -> (ty1, ty2)\n      _ -> pprPanic \"getEqPredTys\" (ppr ty)\n\ngetEqPredTys_maybe :: PredType -> Maybe (Role, Type, Type)\ngetEqPredTys_maybe ty\n  = case splitTyConApp_maybe ty of\n      Just (tc, [_, _, ty1, ty2])\n        | tc `hasKey` eqPrimTyConKey     -> Just (Nominal, ty1, ty2)\n        | tc `hasKey` eqReprPrimTyConKey -> Just (Representational, ty1, ty2)\n      _ -> Nothing\n\ngetEqPredRole :: PredType -> Role\ngetEqPredRole ty = eqRelRole (predTypeEqRel ty)\n\n-- | Get the equality relation relevant for a pred type.\npredTypeEqRel :: PredType -> EqRel\npredTypeEqRel ty\n  | Just (tc, _) <- splitTyConApp_maybe ty\n  , tc `hasKey` eqReprPrimTyConKey\n  = ReprEq\n  | otherwise\n  = NomEq\n\n{-\n%************************************************************************\n%*                                                                      *\n         Well-scoped tyvars\n*                                                                      *\n************************************************************************\n\nNote [ScopedSort]\n~~~~~~~~~~~~~~~~~\nConsider\n\n  foo :: Proxy a -> Proxy (b :: k) -> Proxy (a :: k2) -> ()\n\nThis function type is implicitly generalised over [a, b, k, k2]. These\nvariables will be Specified; that is, they will be available for visible\ntype application. This is because they are written in the type signature\nby the user.\n\nHowever, we must ask: what order will they appear in? In cases without\ndependency, this is easy: we just use the lexical left-to-right ordering\nof first occurrence. With dependency, we cannot get off the hook so\neasily.\n\nWe thus state:\n\n * These variables appear in the order as given by ScopedSort, where\n   the input to ScopedSort is the left-to-right order of first occurrence.\n\nNote that this applies only to *implicit* quantification, without a\n`forall`. If the user writes a `forall`, then we just use the order given.\n\nScopedSort is defined thusly (as proposed in #15743):\n  * Work left-to-right through the input list, with a cursor.\n  * If variable v at the cursor is depended on by any earlier variable w,\n    move v immediately before the leftmost such w.\n\nINVARIANT: The prefix of variables before the cursor form a valid telescope.\n\nNote that ScopedSort makes sense only after type inference is done and all\ntypes/kinds are fully settled and zonked.\n\n-}\n\n-- | Do a topological sort on a list of tyvars,\n--   so that binders occur before occurrences\n-- E.g. given  [ a::k, k::*, b::k ]\n-- it'll return a well-scoped list [ k::*, a::k, b::k ]\n--\n-- This is a deterministic sorting operation\n-- (that is, doesn't depend on Uniques).\n--\n-- It is also meant to be stable: that is, variables should not\n-- be reordered unnecessarily. This is specified in Note [ScopedSort]\n-- See also Note [Ordering of implicit variables] in RnTypes\n\nscopedSort :: [TyCoVar] -> [TyCoVar]\nscopedSort = go [] []\n  where\n    go :: [TyCoVar] -- already sorted, in reverse order\n       -> [TyCoVarSet] -- each set contains all the variables which must be placed\n                       -- before the tv corresponding to the set; they are accumulations\n                       -- of the fvs in the sorted tvs' kinds\n\n                       -- This list is in 1-to-1 correspondence with the sorted tyvars\n                       -- INVARIANT:\n                       --   all (\\tl -> all (`subVarSet` head tl) (tail tl)) (tails fv_list)\n                       -- That is, each set in the list is a superset of all later sets.\n\n       -> [TyCoVar] -- yet to be sorted\n       -> [TyCoVar]\n    go acc _fv_list [] = reverse acc\n    go acc  fv_list (tv:tvs)\n      = go acc' fv_list' tvs\n      where\n        (acc', fv_list') = insert tv acc fv_list\n\n    insert :: TyCoVar       -- var to insert\n           -> [TyCoVar]     -- sorted list, in reverse order\n           -> [TyCoVarSet]  -- list of fvs, as above\n           -> ([TyCoVar], [TyCoVarSet])   -- augmented lists\n    insert tv []     []         = ([tv], [tyCoVarsOfType (tyVarKind tv)])\n    insert tv (a:as) (fvs:fvss)\n      | tv `elemVarSet` fvs\n      , (as', fvss') <- insert tv as fvss\n      = (a:as', fvs `unionVarSet` fv_tv : fvss')\n\n      | otherwise\n      = (tv:a:as, fvs `unionVarSet` fv_tv : fvs : fvss)\n      where\n        fv_tv = tyCoVarsOfType (tyVarKind tv)\n\n       -- lists not in correspondence\n    insert _ _ _ = panic \"scopedSort\"\n\n-- | Extract a well-scoped list of variables from a deterministic set of\n-- variables. The result is deterministic.\n-- NB: There used to exist varSetElemsWellScoped :: VarSet -> [Var] which\n-- took a non-deterministic set and produced a non-deterministic\n-- well-scoped list. If you care about the list being well-scoped you also\n-- most likely care about it being in deterministic order.\ndVarSetElemsWellScoped :: DVarSet -> [Var]\ndVarSetElemsWellScoped = scopedSort . dVarSetElems\n\n-- | Get the free vars of a type in scoped order\ntyCoVarsOfTypeWellScoped :: Type -> [TyVar]\ntyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList\n\n-- | Get the free vars of types in scoped order\ntyCoVarsOfTypesWellScoped :: [Type] -> [TyVar]\ntyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList\n\n-- | Given the suffix of a telescope, returns the prefix.\n-- Ex: given [(k :: j), (a :: Proxy k)], returns [(j :: *)].\ntyCoVarsOfBindersWellScoped :: [TyVar] -> [TyVar]\ntyCoVarsOfBindersWellScoped tvs\n  = tyCoVarsOfTypeWellScoped (mkInvForAllTys tvs unitTy)\n\n------------- Closing over kinds -----------------\n\n-- | Add the kind variables free in the kinds of the tyvars in the given set.\n-- Returns a non-deterministic set.\ncloseOverKinds :: TyVarSet -> TyVarSet\ncloseOverKinds = fvVarSet . closeOverKindsFV . nonDetEltsUniqSet\n  -- It's OK to use nonDetEltsUniqSet here because we immediately forget\n  -- about the ordering by returning a set.\n\n-- | Given a list of tyvars returns a deterministic FV computation that\n-- returns the given tyvars with the kind variables free in the kinds of the\n-- given tyvars.\ncloseOverKindsFV :: [TyVar] -> FV\ncloseOverKindsFV tvs =\n  mapUnionFV (tyCoFVsOfType . tyVarKind) tvs `unionFV` mkFVs tvs\n\n-- | Add the kind variables free in the kinds of the tyvars in the given set.\n-- Returns a deterministically ordered list.\ncloseOverKindsList :: [TyVar] -> [TyVar]\ncloseOverKindsList tvs = fvVarList $ closeOverKindsFV tvs\n\n-- | Add the kind variables free in the kinds of the tyvars in the given set.\n-- Returns a deterministic set.\ncloseOverKindsDSet :: DTyVarSet -> DTyVarSet\ncloseOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Type families}\n*                                                                      *\n************************************************************************\n-}\n\nmkFamilyTyConApp :: TyCon -> [Type] -> Type\n-- ^ Given a family instance TyCon and its arg types, return the\n-- corresponding family type.  E.g:\n--\n-- > data family T a\n-- > data instance T (Maybe b) = MkT b\n--\n-- Where the instance tycon is :RTL, so:\n--\n-- > mkFamilyTyConApp :RTL Int  =  T (Maybe Int)\nmkFamilyTyConApp tc tys\n  | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc\n  , let tvs = tyConTyVars tc\n        fam_subst = ASSERT2( tvs `equalLength` tys, ppr tc <+> ppr tys )\n                    zipTvSubst tvs tys\n  = mkTyConApp fam_tc (substTys fam_subst fam_tys)\n  | otherwise\n  = mkTyConApp tc tys\n\n-- | Get the type on the LHS of a coercion induced by a type/data\n-- family instance.\ncoAxNthLHS :: CoAxiom br -> Int -> Type\ncoAxNthLHS ax ind =\n  mkTyConApp (coAxiomTyCon ax) (coAxBranchLHS (coAxiomNthBranch ax ind))\n\n-- | Pretty prints a 'TyCon', using the family instance in case of a\n-- representation tycon.  For example:\n--\n-- > data T [a] = ...\n--\n-- In that case we want to print @T [a]@, where @T@ is the family 'TyCon'\npprSourceTyCon :: TyCon -> SDoc\npprSourceTyCon tycon\n  | Just (fam_tc, tys) <- tyConFamInst_maybe tycon\n  = ppr $ fam_tc `TyConApp` tys        -- can't be FunTyCon\n  | otherwise\n  = ppr tycon\n\nisFamFreeTy :: Type -> Bool\nisFamFreeTy ty | Just ty' <- coreView ty = isFamFreeTy ty'\nisFamFreeTy (TyVarTy _)       = True\nisFamFreeTy (LitTy {})        = True\nisFamFreeTy (TyConApp tc tys) = all isFamFreeTy tys && isFamFreeTyCon tc\nisFamFreeTy (AppTy a b)       = isFamFreeTy a && isFamFreeTy b\nisFamFreeTy (FunTy _ a b)     = isFamFreeTy a && isFamFreeTy b\nisFamFreeTy (ForAllTy _ ty)   = isFamFreeTy ty\nisFamFreeTy (CastTy ty _)     = isFamFreeTy ty\nisFamFreeTy (CoercionTy _)    = False  -- Not sure about this\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Liftedness}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Returns Just True if this type is surely lifted, Just False\n-- if it is surely unlifted, Nothing if we can't be sure (i.e., it is\n-- levity polymorphic), and panics if the kind does not have the shape\n-- TYPE r.\nisLiftedType_maybe :: HasDebugCallStack => Type -> Maybe Bool\nisLiftedType_maybe ty = go (getRuntimeRep ty)\n  where\n    go rr | Just rr' <- coreView rr = go rr'\n          | isLiftedRuntimeRep rr  = Just True\n          | TyConApp {} <- rr      = Just False  -- Everything else is unlifted\n          | otherwise              = Nothing     -- levity polymorphic\n\n-- | See \"Type#type_classification\" for what an unlifted type is.\n-- Panics on levity polymorphic types.\nisUnliftedType :: HasDebugCallStack => Type -> Bool\n        -- isUnliftedType returns True for forall'd unlifted types:\n        --      x :: forall a. Int#\n        -- I found bindings like these were getting floated to the top level.\n        -- They are pretty bogus types, mind you.  It would be better never to\n        -- construct them\nisUnliftedType ty\n  = not (isLiftedType_maybe ty `orElse`\n         pprPanic \"isUnliftedType\" (ppr ty <+> dcolon <+> ppr (typeKind ty)))\n\n-- | Is this a type of kind RuntimeRep? (e.g. LiftedRep)\nisRuntimeRepKindedTy :: Type -> Bool\nisRuntimeRepKindedTy = isRuntimeRepTy . typeKind\n\n-- | Drops prefix of RuntimeRep constructors in 'TyConApp's. Useful for e.g.\n-- dropping 'LiftedRep arguments of unboxed tuple TyCon applications:\n--\n--   dropRuntimeRepArgs [ 'LiftedRep, 'IntRep\n--                      , String, Int# ] == [String, Int#]\n--\ndropRuntimeRepArgs :: [Type] -> [Type]\ndropRuntimeRepArgs = dropWhile isRuntimeRepKindedTy\n\n-- | Extract the RuntimeRep classifier of a type. For instance,\n-- @getRuntimeRep_maybe Int = LiftedRep@. Returns 'Nothing' if this is not\n-- possible.\ngetRuntimeRep_maybe :: HasDebugCallStack\n                    => Type -> Maybe Type\ngetRuntimeRep_maybe = kindRep_maybe . typeKind\n\n-- | Extract the RuntimeRep classifier of a type. For instance,\n-- @getRuntimeRep_maybe Int = LiftedRep@. Panics if this is not possible.\ngetRuntimeRep :: HasDebugCallStack => Type -> Type\ngetRuntimeRep ty\n  = case getRuntimeRep_maybe ty of\n      Just r  -> r\n      Nothing -> pprPanic \"getRuntimeRep\" (ppr ty <+> dcolon <+> ppr (typeKind ty))\n\nisUnboxedTupleType :: Type -> Bool\nisUnboxedTupleType ty\n  = tyConAppTyCon (getRuntimeRep ty) `hasKey` tupleRepDataConKey\n  -- NB: Do not use typePrimRep, as that can't tell the difference between\n  -- unboxed tuples and unboxed sums\n\n\nisUnboxedSumType :: Type -> Bool\nisUnboxedSumType ty\n  = tyConAppTyCon (getRuntimeRep ty) `hasKey` sumRepDataConKey\n\n-- | See \"Type#type_classification\" for what an algebraic type is.\n-- Should only be applied to /types/, as opposed to e.g. partially\n-- saturated type constructors\nisAlgType :: Type -> Bool\nisAlgType ty\n  = case splitTyConApp_maybe ty of\n      Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )\n                            isAlgTyCon tc\n      _other             -> False\n\n-- | Check whether a type is a data family type\nisDataFamilyAppType :: Type -> Bool\nisDataFamilyAppType ty = case tyConAppTyCon_maybe ty of\n                           Just tc -> isDataFamilyTyCon tc\n                           _       -> False\n\n-- | Computes whether an argument (or let right hand side) should\n-- be computed strictly or lazily, based only on its type.\n-- Currently, it's just 'isUnliftedType'. Panics on levity-polymorphic types.\nisStrictType :: HasDebugCallStack => Type -> Bool\nisStrictType = isUnliftedType\n\nisPrimitiveType :: Type -> Bool\n-- ^ Returns true of types that are opaque to Haskell.\nisPrimitiveType ty = case splitTyConApp_maybe ty of\n                        Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )\n                                              isPrimTyCon tc\n                        _                  -> False\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Join points}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Determine whether a type could be the type of a join point of given total\n-- arity, according to the polymorphism rule. A join point cannot be polymorphic\n-- in its return type, since given\n--   join j @a @b x y z = e1 in e2,\n-- the types of e1 and e2 must be the same, and a and b are not in scope for e2.\n-- (See Note [The polymorphism rule of join points] in CoreSyn.) Returns False\n-- also if the type simply doesn't have enough arguments.\n--\n-- Note that we need to know how many arguments (type *and* value) the putative\n-- join point takes; for instance, if\n--   j :: forall a. a -> Int\n-- then j could be a binary join point returning an Int, but it could *not* be a\n-- unary join point returning a -> Int.\n--\n-- TODO: See Note [Excess polymorphism and join points]\nisValidJoinPointType :: JoinArity -> Type -> Bool\nisValidJoinPointType arity ty\n  = valid_under emptyVarSet arity ty\n  where\n    valid_under tvs arity ty\n      | arity == 0\n      = isEmptyVarSet (tvs `intersectVarSet` tyCoVarsOfType ty)\n      | Just (t, ty') <- splitForAllTy_maybe ty\n      = valid_under (tvs `extendVarSet` t) (arity-1) ty'\n      | Just (_, res_ty) <- splitFunTy_maybe ty\n      = valid_under tvs (arity-1) res_ty\n      | otherwise\n      = False\n\n{- Note [Excess polymorphism and join points]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn principle, if a function would be a join point except that it fails\nthe polymorphism rule (see Note [The polymorphism rule of join points] in\nCoreSyn), it can still be made a join point with some effort. This is because\nall tail calls must return the same type (they return to the same context!), and\nthus if the return type depends on an argument, that argument must always be the\nsame.\n\nFor instance, consider:\n\n  let f :: forall a. a -> Char -> [a]\n      f @a x c = ... f @a y 'a' ...\n  in ... f @Int 1 'b' ... f @Int 2 'c' ...\n\n(where the calls are tail calls). `f` fails the polymorphism rule because its\nreturn type is [a], where [a] is bound. But since the type argument is always\n'Int', we can rewrite it as:\n\n  let f' :: Int -> Char -> [Int]\n      f' x c = ... f' y 'a' ...\n  in ... f' 1 'b' ... f 2 'c' ...\n\nand now we can make f' a join point:\n\n  join f' :: Int -> Char -> [Int]\n       f' x c = ... jump f' y 'a' ...\n  in ... jump f' 1 'b' ... jump f' 2 'c' ...\n\nIt's not clear that this comes up often, however. TODO: Measure how often and\nadd this analysis if necessary.  See Trac #14620.\n\n\n************************************************************************\n*                                                                      *\n\\subsection{Sequencing on types}\n*                                                                      *\n************************************************************************\n-}\n\nseqType :: Type -> ()\nseqType (LitTy n)                   = n `seq` ()\nseqType (TyVarTy tv)                = tv `seq` ()\nseqType (AppTy t1 t2)               = seqType t1 `seq` seqType t2\nseqType (FunTy _ t1 t2)             = seqType t1 `seq` seqType t2\nseqType (TyConApp tc tys)           = tc `seq` seqTypes tys\nseqType (ForAllTy (Bndr tv _) ty)   = seqType (varType tv) `seq` seqType ty\nseqType (CastTy ty co)              = seqType ty `seq` seqCo co\nseqType (CoercionTy co)             = seqCo co\n\nseqTypes :: [Type] -> ()\nseqTypes []       = ()\nseqTypes (ty:tys) = seqType ty `seq` seqTypes tys\n\n{-\n************************************************************************\n*                                                                      *\n                Comparison for types\n        (We don't use instances so that we know where it happens)\n*                                                                      *\n************************************************************************\n\nNote [Equality on AppTys]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nIn our cast-ignoring equality, we want to say that the following two\nare equal:\n\n  (Maybe |> co) (Int |> co')   ~?       Maybe Int\n\nBut the left is an AppTy while the right is a TyConApp. The solution is\nto use repSplitAppTy_maybe to break up the TyConApp into its pieces and\nthen continue. Easy to do, but also easy to forget to do.\n\n-}\n\neqType :: Type -> Type -> Bool\n-- ^ Type equality on source types. Does not look through @newtypes@ or\n-- 'PredType's, but it does look through type synonyms.\n-- This first checks that the kinds of the types are equal and then\n-- checks whether the types are equal, ignoring casts and coercions.\n-- (The kind check is a recursive call, but since all kinds have type\n-- @Type@, there is no need to check the types of kinds.)\n-- See also Note [Non-trivial definitional equality] in TyCoRep.\neqType t1 t2 = isEqual $ nonDetCmpType t1 t2\n  -- It's OK to use nonDetCmpType here and eqType is deterministic,\n  -- nonDetCmpType does equality deterministically\n\n-- | Compare types with respect to a (presumably) non-empty 'RnEnv2'.\neqTypeX :: RnEnv2 -> Type -> Type -> Bool\neqTypeX env t1 t2 = isEqual $ nonDetCmpTypeX env t1 t2\n  -- It's OK to use nonDetCmpType here and eqTypeX is deterministic,\n  -- nonDetCmpTypeX does equality deterministically\n\n-- | Type equality on lists of types, looking through type synonyms\n-- but not newtypes.\neqTypes :: [Type] -> [Type] -> Bool\neqTypes tys1 tys2 = isEqual $ nonDetCmpTypes tys1 tys2\n  -- It's OK to use nonDetCmpType here and eqTypes is deterministic,\n  -- nonDetCmpTypes does equality deterministically\n\neqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2\n-- Check that the var lists are the same length\n-- and have matching kinds; if so, extend the RnEnv2\n-- Returns Nothing if they don't match\neqVarBndrs env [] []\n = Just env\neqVarBndrs env (tv1:tvs1) (tv2:tvs2)\n | eqTypeX env (varType tv1) (varType tv2)\n = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2\neqVarBndrs _ _ _= Nothing\n\n-- Now here comes the real worker\n\n{-\nNote [nonDetCmpType nondeterminism]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nnonDetCmpType is implemented in terms of nonDetCmpTypeX. nonDetCmpTypeX\nuses nonDetCmpTc which compares TyCons by their Unique value. Using Uniques for\nordering leads to nondeterminism. We hit the same problem in the TyVarTy case,\ncomparing type variables is nondeterministic, note the call to nonDetCmpVar in\nnonDetCmpTypeX.\nSee Note [Unique Determinism] for more details.\n-}\n\nnonDetCmpType :: Type -> Type -> Ordering\nnonDetCmpType t1 t2\n  -- we know k1 and k2 have the same kind, because they both have kind *.\n  = nonDetCmpTypeX rn_env t1 t2\n  where\n    rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes [t1, t2]))\n\nnonDetCmpTypes :: [Type] -> [Type] -> Ordering\nnonDetCmpTypes ts1 ts2 = nonDetCmpTypesX rn_env ts1 ts2\n  where\n    rn_env = mkRnEnv2 (mkInScopeSet (tyCoVarsOfTypes (ts1 ++ ts2)))\n\n-- | An ordering relation between two 'Type's (known below as @t1 :: k1@\n-- and @t2 :: k2@)\ndata TypeOrdering = TLT  -- ^ @t1 < t2@\n                  | TEQ  -- ^ @t1 ~ t2@ and there are no casts in either,\n                         -- therefore we can conclude @k1 ~ k2@\n                  | TEQX -- ^ @t1 ~ t2@ yet one of the types contains a cast so\n                         -- they may differ in kind.\n                  | TGT  -- ^ @t1 > t2@\n                  deriving (Eq, Ord, Enum, Bounded)\n\nnonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering  -- Main workhorse\n    -- See Note [Non-trivial definitional equality] in TyCoRep\nnonDetCmpTypeX env orig_t1 orig_t2 =\n    case go env orig_t1 orig_t2 of\n      -- If there are casts then we also need to do a comparison of the kinds of\n      -- the types being compared\n      TEQX          -> toOrdering $ go env k1 k2\n      ty_ordering   -> toOrdering ty_ordering\n  where\n    k1 = typeKind orig_t1\n    k2 = typeKind orig_t2\n\n    toOrdering :: TypeOrdering -> Ordering\n    toOrdering TLT  = LT\n    toOrdering TEQ  = EQ\n    toOrdering TEQX = EQ\n    toOrdering TGT  = GT\n\n    liftOrdering :: Ordering -> TypeOrdering\n    liftOrdering LT = TLT\n    liftOrdering EQ = TEQ\n    liftOrdering GT = TGT\n\n    thenCmpTy :: TypeOrdering -> TypeOrdering -> TypeOrdering\n    thenCmpTy TEQ  rel  = rel\n    thenCmpTy TEQX rel  = hasCast rel\n    thenCmpTy rel  _    = rel\n\n    hasCast :: TypeOrdering -> TypeOrdering\n    hasCast TEQ = TEQX\n    hasCast rel = rel\n\n    -- Returns both the resulting ordering relation between the two types\n    -- and whether either contains a cast.\n    go :: RnEnv2 -> Type -> Type -> TypeOrdering\n    go env t1 t2\n      | Just t1' <- coreView t1 = go env t1' t2\n      | Just t2' <- coreView t2 = go env t1 t2'\n\n    go env (TyVarTy tv1)       (TyVarTy tv2)\n      = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2\n    go env (ForAllTy (Bndr tv1 _) t1) (ForAllTy (Bndr tv2 _) t2)\n      = go env (varType tv1) (varType tv2)\n        `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2\n        -- See Note [Equality on AppTys]\n    go env (AppTy s1 t1) ty2\n      | Just (s2, t2) <- repSplitAppTy_maybe ty2\n      = go env s1 s2 `thenCmpTy` go env t1 t2\n    go env ty1 (AppTy s2 t2)\n      | Just (s1, t1) <- repSplitAppTy_maybe ty1\n      = go env s1 s2 `thenCmpTy` go env t1 t2\n    go env (FunTy _ s1 t1) (FunTy _ s2 t2)\n      = go env s1 s2 `thenCmpTy` go env t1 t2\n    go env (TyConApp tc1 tys1) (TyConApp tc2 tys2)\n      = liftOrdering (tc1 `nonDetCmpTc` tc2) `thenCmpTy` gos env tys1 tys2\n    go _   (LitTy l1)          (LitTy l2)          = liftOrdering (compare l1 l2)\n    go env (CastTy t1 _)       t2                  = hasCast $ go env t1 t2\n    go env t1                  (CastTy t2 _)       = hasCast $ go env t1 t2\n\n    go _   (CoercionTy {})     (CoercionTy {})     = TEQ\n\n        -- Deal with the rest: TyVarTy < CoercionTy < AppTy < LitTy < TyConApp < ForAllTy\n    go _ ty1 ty2\n      = liftOrdering $ (get_rank ty1) `compare` (get_rank ty2)\n      where get_rank :: Type -> Int\n            get_rank (CastTy {})\n              = pprPanic \"nonDetCmpTypeX.get_rank\" (ppr [ty1,ty2])\n            get_rank (TyVarTy {})    = 0\n            get_rank (CoercionTy {}) = 1\n            get_rank (AppTy {})      = 3\n            get_rank (LitTy {})      = 4\n            get_rank (TyConApp {})   = 5\n            get_rank (FunTy {})      = 6\n            get_rank (ForAllTy {})   = 7\n\n    gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering\n    gos _   []         []         = TEQ\n    gos _   []         _          = TLT\n    gos _   _          []         = TGT\n    gos env (ty1:tys1) (ty2:tys2) = go env ty1 ty2 `thenCmpTy` gos env tys1 tys2\n\n-------------\nnonDetCmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering\nnonDetCmpTypesX _   []        []        = EQ\nnonDetCmpTypesX env (t1:tys1) (t2:tys2) = nonDetCmpTypeX env t1 t2\n                                          `thenCmp`\n                                          nonDetCmpTypesX env tys1 tys2\nnonDetCmpTypesX _   []        _         = LT\nnonDetCmpTypesX _   _         []        = GT\n\n-------------\n-- | Compare two 'TyCon's. NB: This should /never/ see 'Constraint' (as\n-- recognized by Kind.isConstraintKindCon) which is considered a synonym for\n-- 'Type' in Core.\n-- See Note [Kind Constraint and kind Type] in Kind.\n-- See Note [nonDetCmpType nondeterminism]\nnonDetCmpTc :: TyCon -> TyCon -> Ordering\nnonDetCmpTc tc1 tc2\n  = ASSERT( not (isConstraintKindCon tc1) && not (isConstraintKindCon tc2) )\n    u1 `nonDetCmpUnique` u2\n  where\n    u1  = tyConUnique tc1\n    u2  = tyConUnique tc2\n\n{-\n************************************************************************\n*                                                                      *\n        The kind of a type\n*                                                                      *\n************************************************************************\n\nNote [typeKind vs tcTypeKind]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe have two functions to get the kind of a type\n\n  * typeKind   ignores  the distinction between Constraint and *\n  * tcTypeKind respects the distinction between Constraint and *\n\ntcTypeKind is used by the type inference engine, for which Constraint\nand * are different; after that we use typeKind.\n\nSee also Note [coreView vs tcView]\n\nNote [Kinding rules for types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nIn typeKind we consider Constraint and (TYPE LiftedRep) to be identical.\nWe then have\n\n         t1 : TYPE rep1\n         t2 : TYPE rep2\n   (FUN) ----------------\n         t1 -> t2 : Type\n\n         ty : TYPE rep\n         `a` is not free in rep\n(FORALL) -----------------------\n         forall a. ty : TYPE rep\n\nIn tcTypeKind we consider Constraint and (TYPE LiftedRep) to be distinct:\n\n          t1 : TYPE rep1\n          t2 : TYPE rep2\n    (FUN) ----------------\n          t1 -> t2 : Type\n\n          t1 : Constraint\n          t2 : TYPE rep\n  (PRED1) ----------------\n          t1 => t2 : Type\n\n          t1 : Constraint\n          t2 : Constraint\n  (PRED2) ---------------------\n          t1 => t2 : Constraint\n\n          ty : TYPE rep\n          `a` is not free in rep\n(FORALL1) -----------------------\n          forall a. ty : TYPE rep\n\n          ty : Constraint\n(FORALL2) -------------------------\n          forall a. ty : Constraint\n\nNote that:\n* The only way we distinguish '->' from '=>' is by the fact\n  that the argument is a PredTy.  Both are FunTys\n\nNote [Phantom type variables in kinds]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n  type K (r :: RuntimeRep) = Type   -- Note 'r' is unused\n  data T r :: K r                   -- T :: forall r -> K r\n  foo :: forall r. T r\n\nThe body of the forall in foo's type has kind (K r), and\nnormally it would make no sense to have\n   forall r. (ty :: K r)\nbecause the kind of the forall would escape the binding\nof 'r'.  But in this case it's fine because (K r) exapands\nto Type, so we expliclity /permit/ the type\n   forall r. T r\n\nTo accommodate such a type, in typeKind (forall a.ty) we use\noccCheckExpand to expand any type synonyms in the kind of 'ty'\nto eliminate 'a'.  See kinding rule (FORALL) in\nNote [Kinding rules for types]\n\nAnd in TcValidity.checkEscapingKind, we use also use\noccCheckExpand, for the same reason.\n-}\n\n-----------------------------\ntypeKind :: HasDebugCallStack => Type -> Kind\n-- No need to expand synonyms\ntypeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys\ntypeKind (LitTy l)         = typeLiteralKind l\ntypeKind (FunTy {})        = liftedTypeKind\ntypeKind (TyVarTy tyvar)   = tyVarKind tyvar\ntypeKind (CastTy _ty co)   = pSnd $ coercionKind co\ntypeKind (CoercionTy co)   = coercionType co\n\ntypeKind (AppTy fun arg)\n  = go fun [arg]\n  where\n    -- Accumulate the type arugments, so we can call piResultTys,\n    -- rather than a succession of calls to piResultTy (which is\n    -- asymptotically costly as the number of arguments increases)\n    go (AppTy fun arg) args = go fun (arg:args)\n    go fun             args = piResultTys (typeKind fun) args\n\ntypeKind ty@(ForAllTy {})\n  = case occCheckExpand tvs body_kind of\n      -- We must make sure tv does not occur in kind\n      -- As it is already out of scope!\n      -- See Note [Phantom type variables in kinds]\n      Just k' -> k'\n      Nothing -> pprPanic \"typeKind\"\n                  (ppr ty $$ ppr tvs $$ ppr body <+> dcolon <+> ppr body_kind)\n  where\n    (tvs, body) = splitTyVarForAllTys ty\n    body_kind   = typeKind body\n\n-----------------------------\ntcTypeKind :: HasDebugCallStack => Type -> Kind\n-- No need to expand synonyms\ntcTypeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys\ntcTypeKind (LitTy l)         = typeLiteralKind l\ntcTypeKind (TyVarTy tyvar)   = tyVarKind tyvar\ntcTypeKind (CastTy _ty co)   = pSnd $ coercionKind co\ntcTypeKind (CoercionTy co)   = coercionType co\n\ntcTypeKind (FunTy { ft_af = af, ft_res = res })\n  | InvisArg <- af\n  , tcIsConstraintKind (tcTypeKind res)\n  = constraintKind     -- Eq a => Ord a         :: Constraint\n  | otherwise          -- Eq a => a -> a        :: TYPE LiftedRep\n  = liftedTypeKind     -- Eq a => Array# Int    :: Type LiftedRep (not TYPE PtrRep)\n\ntcTypeKind (AppTy fun arg)\n  = go fun [arg]\n  where\n    -- Accumulate the type arugments, so we can call piResultTys,\n    -- rather than a succession of calls to piResultTy (which is\n    -- asymptotically costly as the number of arguments increases)\n    go (AppTy fun arg) args = go fun (arg:args)\n    go fun             args = piResultTys (tcTypeKind fun) args\n\ntcTypeKind ty@(ForAllTy {})\n  | tcIsConstraintKind body_kind\n  = constraintKind\n\n  | otherwise\n  = case occCheckExpand tvs body_kind of\n      -- We must make sure tv does not occur in kind\n      -- As it is already out of scope!\n      -- See Note [Phantom type variables in kinds]\n      Just k' -> k'\n      Nothing -> pprPanic \"tcTypeKind\"\n                  (ppr ty $$ ppr tvs $$ ppr body <+> dcolon <+> ppr body_kind)\n  where\n    (tvs, body) = splitTyVarForAllTys ty\n    body_kind = tcTypeKind body\n\n\nisPredTy :: HasDebugCallStack => Type -> Bool\n-- See Note [Types for coercions, predicates, and evidence]\nisPredTy ty = tcIsConstraintKind (tcTypeKind ty)\n\n--------------------------\ntypeLiteralKind :: TyLit -> Kind\ntypeLiteralKind (NumTyLit {}) = typeNatKind\ntypeLiteralKind (StrTyLit {}) = typeSymbolKind\n\n-- | Returns True if a type is levity polymorphic. Should be the same\n-- as (isKindLevPoly . typeKind) but much faster.\n-- Precondition: The type has kind (TYPE blah)\nisTypeLevPoly :: Type -> Bool\nisTypeLevPoly = go\n  where\n    go ty@(TyVarTy {})                           = check_kind ty\n    go ty@(AppTy {})                             = check_kind ty\n    go ty@(TyConApp tc _) | not (isTcLevPoly tc) = False\n                          | otherwise            = check_kind ty\n    go (ForAllTy _ ty)                           = go ty\n    go (FunTy {})                                = False\n    go (LitTy {})                                = False\n    go ty@(CastTy {})                            = check_kind ty\n    go ty@(CoercionTy {})                        = pprPanic \"isTypeLevPoly co\" (ppr ty)\n\n    check_kind = isKindLevPoly . typeKind\n\n-- | Looking past all pi-types, is the end result potentially levity polymorphic?\n-- Example: True for (forall r (a :: TYPE r). String -> a)\n-- Example: False for (forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). a -> b -> Type)\nresultIsLevPoly :: Type -> Bool\nresultIsLevPoly = isTypeLevPoly . snd . splitPiTys\n\n\n{- **********************************************************************\n*                                                                       *\n           Occurs check expansion\n%*                                                                      *\n%********************************************************************* -}\n\n{- Note [Occurs check expansion]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n(occurCheckExpand tv xi) expands synonyms in xi just enough to get rid\nof occurrences of tv outside type function arguments, if that is\npossible; otherwise, it returns Nothing.\n\nFor example, suppose we have\n  type F a b = [a]\nThen\n  occCheckExpand b (F Int b) = Just [Int]\nbut\n  occCheckExpand a (F a Int) = Nothing\n\nWe don't promise to do the absolute minimum amount of expanding\nnecessary, but we try not to do expansions we don't need to.  We\nprefer doing inner expansions first.  For example,\n  type F a b = (a, Int, a, [a])\n  type G b   = Char\nWe have\n  occCheckExpand b (F (G b)) = Just (F Char)\neven though we could also expand F to get rid of b.\n-}\n\noccCheckExpand :: [Var] -> Type -> Maybe Type\n-- See Note [Occurs check expansion]\n-- We may have needed to do some type synonym unfolding in order to\n-- get rid of the variable (or forall), so we also return the unfolded\n-- version of the type, which is guaranteed to be syntactically free\n-- of the given type variable.  If the type is already syntactically\n-- free of the variable, then the same type is returned.\noccCheckExpand vs_to_avoid ty\n  = go (mkVarSet vs_to_avoid, emptyVarEnv) ty\n  where\n    go :: (VarSet, VarEnv TyCoVar) -> Type -> Maybe Type\n          -- The VarSet is the set of variables we are trying to avoid\n          -- The VarEnv carries mappings necessary\n          -- because of kind expansion\n    go cxt@(as, env) (TyVarTy tv')\n      | tv' `elemVarSet` as               = Nothing\n      | Just tv'' <- lookupVarEnv env tv' = return (mkTyVarTy tv'')\n      | otherwise                         = do { tv'' <- go_var cxt tv'\n                                               ; return (mkTyVarTy tv'') }\n\n    go _   ty@(LitTy {}) = return ty\n    go cxt (AppTy ty1 ty2) = do { ty1' <- go cxt ty1\n                                ; ty2' <- go cxt ty2\n                                ; return (mkAppTy ty1' ty2') }\n    go cxt ty@(FunTy _ ty1 ty2)\n       = do { ty1' <- go cxt ty1\n            ; ty2' <- go cxt ty2\n            ; return (ty { ft_arg = ty1', ft_res = ty2' }) }\n    go cxt@(as, env) (ForAllTy (Bndr tv vis) body_ty)\n       = do { ki' <- go cxt (varType tv)\n            ; let tv' = setVarType tv ki'\n                  env' = extendVarEnv env tv tv'\n                  as'  = as `delVarSet` tv\n            ; body' <- go (as', env') body_ty\n            ; return (ForAllTy (Bndr tv' vis) body') }\n\n    -- For a type constructor application, first try expanding away the\n    -- offending variable from the arguments.  If that doesn't work, next\n    -- see if the type constructor is a type synonym, and if so, expand\n    -- it and try again.\n    go cxt ty@(TyConApp tc tys)\n      = case mapM (go cxt) tys of\n          Just tys' -> return (mkTyConApp tc tys')\n          Nothing | Just ty' <- tcView ty -> go cxt ty'\n                  | otherwise             -> Nothing\n                      -- Failing that, try to expand a synonym\n\n    go cxt (CastTy ty co) =  do { ty' <- go cxt ty\n                                ; co' <- go_co cxt co\n                                ; return (mkCastTy ty' co') }\n    go cxt (CoercionTy co) = do { co' <- go_co cxt co\n                                ; return (mkCoercionTy co') }\n\n    ------------------\n    go_var cxt v = do { k' <- go cxt (varType v)\n                      ; return (setVarType v k') }\n           -- Works for TyVar and CoVar\n           -- See Note [Occurrence checking: look inside kinds]\n\n    ------------------\n    go_mco _   MRefl = return MRefl\n    go_mco ctx (MCo co) = MCo <$> go_co ctx co\n\n    ------------------\n    go_co cxt (Refl ty)                 = do { ty' <- go cxt ty\n                                             ; return (mkNomReflCo ty') }\n    go_co cxt (GRefl r ty mco)          = do { mco' <- go_mco cxt mco\n                                             ; ty' <- go cxt ty\n                                             ; return (mkGReflCo r ty' mco') }\n      -- Note: Coercions do not contain type synonyms\n    go_co cxt (TyConAppCo r tc args)    = do { args' <- mapM (go_co cxt) args\n                                             ; return (mkTyConAppCo r tc args') }\n    go_co cxt (AppCo co arg)            = do { co' <- go_co cxt co\n                                             ; arg' <- go_co cxt arg\n                                             ; return (mkAppCo co' arg') }\n    go_co cxt@(as, env) (ForAllCo tv kind_co body_co)\n      = do { kind_co' <- go_co cxt kind_co\n           ; let tv' = setVarType tv $\n                       pFst (coercionKind kind_co')\n                 env' = extendVarEnv env tv tv'\n                 as'  = as `delVarSet` tv\n           ; body' <- go_co (as', env') body_co\n           ; return (ForAllCo tv' kind_co' body') }\n    go_co cxt (FunCo r co1 co2)         = do { co1' <- go_co cxt co1\n                                             ; co2' <- go_co cxt co2\n                                             ; return (mkFunCo r co1' co2') }\n    go_co cxt@(as,env) (CoVarCo c)\n      | c `elemVarSet` as               = Nothing\n      | Just c' <- lookupVarEnv env c   = return (mkCoVarCo c')\n      | otherwise                       = do { c' <- go_var cxt c\n                                             ; return (mkCoVarCo c') }\n    go_co cxt (HoleCo h)                = do { c' <- go_var cxt (ch_co_var h)\n                                             ; return (HoleCo (h { ch_co_var = c' })) }\n    go_co cxt (AxiomInstCo ax ind args) = do { args' <- mapM (go_co cxt) args\n                                             ; return (mkAxiomInstCo ax ind args') }\n    go_co cxt (UnivCo p r ty1 ty2)      = do { p' <- go_prov cxt p\n                                             ; ty1' <- go cxt ty1\n                                             ; ty2' <- go cxt ty2\n                                             ; return (mkUnivCo p' r ty1' ty2') }\n    go_co cxt (SymCo co)                = do { co' <- go_co cxt co\n                                             ; return (mkSymCo co') }\n    go_co cxt (TransCo co1 co2)         = do { co1' <- go_co cxt co1\n                                             ; co2' <- go_co cxt co2\n                                             ; return (mkTransCo co1' co2') }\n    go_co cxt (NthCo r n co)            = do { co' <- go_co cxt co\n                                             ; return (mkNthCo r n co') }\n    go_co cxt (LRCo lr co)              = do { co' <- go_co cxt co\n                                             ; return (mkLRCo lr co') }\n    go_co cxt (InstCo co arg)           = do { co' <- go_co cxt co\n                                             ; arg' <- go_co cxt arg\n                                             ; return (mkInstCo co' arg') }\n    go_co cxt (KindCo co)               = do { co' <- go_co cxt co\n                                             ; return (mkKindCo co') }\n    go_co cxt (SubCo co)                = do { co' <- go_co cxt co\n                                             ; return (mkSubCo co') }\n    go_co cxt (AxiomRuleCo ax cs)       = do { cs' <- mapM (go_co cxt) cs\n                                             ; return (mkAxiomRuleCo ax cs') }\n\n    ------------------\n    go_prov _   UnsafeCoerceProv    = return UnsafeCoerceProv\n    go_prov cxt (PhantomProv co)    = PhantomProv <$> go_co cxt co\n    go_prov cxt (ProofIrrelProv co) = ProofIrrelProv <$> go_co cxt co\n    go_prov _   p@(PluginProv _)    = return p\n\n\n{-\n%************************************************************************\n%*                                                                      *\n        Miscellaneous functions\n%*                                                                      *\n%************************************************************************\n\n-}\n-- | All type constructors occurring in the type; looking through type\n--   synonyms, but not newtypes.\n--  When it finds a Class, it returns the class TyCon.\ntyConsOfType :: Type -> UniqSet TyCon\ntyConsOfType ty\n  = go ty\n  where\n     go :: Type -> UniqSet TyCon  -- The UniqSet does duplicate elim\n     go ty | Just ty' <- coreView ty = go ty'\n     go (TyVarTy {})                = emptyUniqSet\n     go (LitTy {})                  = emptyUniqSet\n     go (TyConApp tc tys)           = go_tc tc `unionUniqSets` go_s tys\n     go (AppTy a b)                 = go a `unionUniqSets` go b\n     go (FunTy _ a b)               = go a `unionUniqSets` go b `unionUniqSets` go_tc funTyCon\n     go (ForAllTy (Bndr tv _) ty)   = go ty `unionUniqSets` go (varType tv)\n     go (CastTy ty co)              = go ty `unionUniqSets` go_co co\n     go (CoercionTy co)             = go_co co\n\n     go_co (Refl ty)               = go ty\n     go_co (GRefl _ ty mco)        = go ty `unionUniqSets` go_mco mco\n     go_co (TyConAppCo _ tc args)  = go_tc tc `unionUniqSets` go_cos args\n     go_co (AppCo co arg)          = go_co co `unionUniqSets` go_co arg\n     go_co (ForAllCo _ kind_co co) = go_co kind_co `unionUniqSets` go_co co\n     go_co (FunCo _ co1 co2)       = go_co co1 `unionUniqSets` go_co co2\n     go_co (AxiomInstCo ax _ args) = go_ax ax `unionUniqSets` go_cos args\n     go_co (UnivCo p _ t1 t2)      = go_prov p `unionUniqSets` go t1 `unionUniqSets` go t2\n     go_co (CoVarCo {})            = emptyUniqSet\n     go_co (HoleCo {})             = emptyUniqSet\n     go_co (SymCo co)              = go_co co\n     go_co (TransCo co1 co2)       = go_co co1 `unionUniqSets` go_co co2\n     go_co (NthCo _ _ co)          = go_co co\n     go_co (LRCo _ co)             = go_co co\n     go_co (InstCo co arg)         = go_co co `unionUniqSets` go_co arg\n     go_co (KindCo co)             = go_co co\n     go_co (SubCo co)              = go_co co\n     go_co (AxiomRuleCo _ cs)      = go_cos cs\n\n     go_mco MRefl    = emptyUniqSet\n     go_mco (MCo co) = go_co co\n\n     go_prov UnsafeCoerceProv    = emptyUniqSet\n     go_prov (PhantomProv co)    = go_co co\n     go_prov (ProofIrrelProv co) = go_co co\n     go_prov (PluginProv _)      = emptyUniqSet\n        -- this last case can happen from the tyConsOfType used from\n        -- checkTauTvUpdate\n\n     go_s tys     = foldr (unionUniqSets . go)     emptyUniqSet tys\n     go_cos cos   = foldr (unionUniqSets . go_co)  emptyUniqSet cos\n\n     go_tc tc = unitUniqSet tc\n     go_ax ax = go_tc $ coAxiomTyCon ax\n\n-- | Find the result 'Kind' of a type synonym,\n-- after applying it to its 'arity' number of type variables\n-- Actually this function works fine on data types too,\n-- but they'd always return '*', so we never need to ask\nsynTyConResKind :: TyCon -> Kind\nsynTyConResKind tycon = piResultTys (tyConKind tycon) (mkTyVarTys (tyConTyVars tycon))\n\n-- | Retrieve the free variables in this type, splitting them based\n-- on whether they are used visibly or invisibly. Invisible ones come\n-- first.\nsplitVisVarsOfType :: Type -> Pair TyCoVarSet\nsplitVisVarsOfType orig_ty = Pair invis_vars vis_vars\n  where\n    Pair invis_vars1 vis_vars = go orig_ty\n    invis_vars = invis_vars1 `minusVarSet` vis_vars\n\n    go (TyVarTy tv)      = Pair (tyCoVarsOfType $ tyVarKind tv) (unitVarSet tv)\n    go (AppTy t1 t2)     = go t1 `mappend` go t2\n    go (TyConApp tc tys) = go_tc tc tys\n    go (FunTy _ t1 t2)   = go t1 `mappend` go t2\n    go (ForAllTy (Bndr tv _) ty)\n      = ((`delVarSet` tv) <$> go ty) `mappend`\n        (invisible (tyCoVarsOfType $ varType tv))\n    go (LitTy {}) = mempty\n    go (CastTy ty co) = go ty `mappend` invisible (tyCoVarsOfCo co)\n    go (CoercionTy co) = invisible $ tyCoVarsOfCo co\n\n    invisible vs = Pair vs emptyVarSet\n\n    go_tc tc tys = let (invis, vis) = partitionInvisibleTypes tc tys in\n                   invisible (tyCoVarsOfTypes invis) `mappend` foldMap go vis\n\nsplitVisVarsOfTypes :: [Type] -> Pair TyCoVarSet\nsplitVisVarsOfTypes = foldMap splitVisVarsOfType\n\nmodifyJoinResTy :: Int            -- Number of binders to skip\n                -> (Type -> Type) -- Function to apply to result type\n                -> Type           -- Type of join point\n                -> Type           -- New type\n-- INVARIANT: If any of the first n binders are foralls, those tyvars cannot\n-- appear in the original result type. See isValidJoinPointType.\nmodifyJoinResTy orig_ar f orig_ty\n  = go orig_ar orig_ty\n  where\n    go 0 ty = f ty\n    go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty\n            = mkPiTy arg_bndr (go (n-1) res_ty)\n            | otherwise\n            = pprPanic \"modifyJoinResTy\" (ppr orig_ar <+> ppr orig_ty)\n\nsetJoinResTy :: Int  -- Number of binders to skip\n             -> Type -- New result type\n             -> Type -- Type of join point\n             -> Type -- New type\n-- INVARIANT: Same as for modifyJoinResTy\nsetJoinResTy ar new_res_ty ty\n  = modifyJoinResTy ar (const new_res_ty) ty\n\n\n{-\n%************************************************************************\n%*                                                                      *\n         Pretty-printing\n%*                                                                      *\n%************************************************************************\n\nMost pretty-printing is either in TyCoRep or IfaceType.\n\n-}\n\n-- | This variant preserves any use of TYPE in a type, effectively\n-- locally setting -fprint-explicit-runtime-reps.\npprWithTYPE :: Type -> SDoc\npprWithTYPE ty = updSDocDynFlags (flip gopt_set Opt_PrintExplicitRuntimeReps) $\n                 ppr ty\n", "num_lines": 3138}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Various utilities used in generating assembler.\n--\n-- These are used not only by the native code generator, but also by the\n-- \"DriverPipeline\".\nmodule AsmUtils\n    ( sectionType\n    ) where\n\nimport GhcPrelude\n\nimport Platform\nimport Outputable\n\n-- | Generate a section type (e.g. @\\@progbits@). See #13937.\nsectionType :: String -- ^ section type\n            -> SDoc   -- ^ pretty assembler fragment\nsectionType ty = sdocWithPlatform $ \\platform ->\n    case platformArch platform of\n      ArchARM{} -> char '%' <> text ty\n      _         -> char '@' <> text ty\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\nBag: an unordered collection with duplicates\n-}\n\n{-# LANGUAGE ScopedTypeVariables, CPP #-}\n\nmodule Bag (\n        Bag, -- abstract type\n\n        emptyBag, unitBag, unionBags, unionManyBags,\n        mapBag,\n        elemBag, lengthBag,\n        filterBag, partitionBag, partitionBagWith,\n        concatBag, catBagMaybes, foldBag, foldrBag, foldlBag,\n        isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag,\n        listToBag, bagToList, mapAccumBagL,\n        concatMapBag, concatMapBagPair, mapMaybeBag,\n        foldrBagM, foldlBagM, mapBagM, mapBagM_,\n        flatMapBagM, flatMapBagPairM,\n        mapAndUnzipBagM, mapAccumBagLM,\n        anyBagM, filterBagM\n    ) where\n\nimport GhcPrelude\n\nimport Outputable\nimport Util\n\nimport MonadUtils\nimport Control.Monad\nimport Data.Data\nimport Data.Maybe( mapMaybe )\nimport Data.List ( partition, mapAccumL )\nimport qualified Data.Foldable as Foldable\n\ninfixr 3 `consBag`\ninfixl 3 `snocBag`\n\ndata Bag a\n  = EmptyBag\n  | UnitBag a\n  | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty\n  | ListBag [a]             -- INVARIANT: the list is non-empty\n\nemptyBag :: Bag a\nemptyBag = EmptyBag\n\nunitBag :: a -> Bag a\nunitBag  = UnitBag\n\nlengthBag :: Bag a -> Int\nlengthBag EmptyBag        = 0\nlengthBag (UnitBag {})    = 1\nlengthBag (TwoBags b1 b2) = lengthBag b1 + lengthBag b2\nlengthBag (ListBag xs)    = length xs\n\nelemBag :: Eq a => a -> Bag a -> Bool\nelemBag _ EmptyBag        = False\nelemBag x (UnitBag y)     = x == y\nelemBag x (TwoBags b1 b2) = x `elemBag` b1 || x `elemBag` b2\nelemBag x (ListBag ys)    = any (x ==) ys\n\nunionManyBags :: [Bag a] -> Bag a\nunionManyBags xs = foldr unionBags EmptyBag xs\n\n-- This one is a bit stricter! The bag will get completely evaluated.\n\nunionBags :: Bag a -> Bag a -> Bag a\nunionBags EmptyBag b = b\nunionBags b EmptyBag = b\nunionBags b1 b2      = TwoBags b1 b2\n\nconsBag :: a -> Bag a -> Bag a\nsnocBag :: Bag a -> a -> Bag a\n\nconsBag elt bag = (unitBag elt) `unionBags` bag\nsnocBag bag elt = bag `unionBags` (unitBag elt)\n\nisEmptyBag :: Bag a -> Bool\nisEmptyBag EmptyBag = True\nisEmptyBag _        = False -- NB invariants\n\nisSingletonBag :: Bag a -> Bool\nisSingletonBag EmptyBag      = False\nisSingletonBag (UnitBag _)   = True\nisSingletonBag (TwoBags _ _) = False          -- Neither is empty\nisSingletonBag (ListBag xs)  = isSingleton xs\n\nfilterBag :: (a -> Bool) -> Bag a -> Bag a\nfilterBag _    EmptyBag = EmptyBag\nfilterBag pred b@(UnitBag val) = if pred val then b else EmptyBag\nfilterBag pred (TwoBags b1 b2) = sat1 `unionBags` sat2\n    where sat1 = filterBag pred b1\n          sat2 = filterBag pred b2\nfilterBag pred (ListBag vs)    = listToBag (filter pred vs)\n\nfilterBagM :: Monad m => (a -> m Bool) -> Bag a -> m (Bag a)\nfilterBagM _    EmptyBag = return EmptyBag\nfilterBagM pred b@(UnitBag val) = do\n  flag <- pred val\n  if flag then return b\n          else return EmptyBag\nfilterBagM pred (TwoBags b1 b2) = do\n  sat1 <- filterBagM pred b1\n  sat2 <- filterBagM pred b2\n  return (sat1 `unionBags` sat2)\nfilterBagM pred (ListBag vs) = do\n  sat <- filterM pred vs\n  return (listToBag sat)\n\nallBag :: (a -> Bool) -> Bag a -> Bool\nallBag _ EmptyBag        = True\nallBag p (UnitBag v)     = p v\nallBag p (TwoBags b1 b2) = allBag p b1 && allBag p b2\nallBag p (ListBag xs)    = all p xs\n\nanyBag :: (a -> Bool) -> Bag a -> Bool\nanyBag _ EmptyBag        = False\nanyBag p (UnitBag v)     = p v\nanyBag p (TwoBags b1 b2) = anyBag p b1 || anyBag p b2\nanyBag p (ListBag xs)    = any p xs\n\nanyBagM :: Monad m => (a -> m Bool) -> Bag a -> m Bool\nanyBagM _ EmptyBag        = return False\nanyBagM p (UnitBag v)     = p v\nanyBagM p (TwoBags b1 b2) = do flag <- anyBagM p b1\n                               if flag then return True\n                                       else anyBagM p b2\nanyBagM p (ListBag xs)    = anyM p xs\n\nconcatBag :: Bag (Bag a) -> Bag a\nconcatBag bss = foldrBag add emptyBag bss\n  where\n    add bs rs = bs `unionBags` rs\n\ncatBagMaybes :: Bag (Maybe a) -> Bag a\ncatBagMaybes bs = foldrBag add emptyBag bs\n  where\n    add Nothing rs = rs\n    add (Just x) rs = x `consBag` rs\n\npartitionBag :: (a -> Bool) -> Bag a -> (Bag a {- Satisfy predictate -},\n                                         Bag a {- Don't -})\npartitionBag _    EmptyBag = (EmptyBag, EmptyBag)\npartitionBag pred b@(UnitBag val)\n    = if pred val then (b, EmptyBag) else (EmptyBag, b)\npartitionBag pred (TwoBags b1 b2)\n    = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)\n  where (sat1, fail1) = partitionBag pred b1\n        (sat2, fail2) = partitionBag pred b2\npartitionBag pred (ListBag vs) = (listToBag sats, listToBag fails)\n  where (sats, fails) = partition pred vs\n\n\npartitionBagWith :: (a -> Either b c) -> Bag a\n                    -> (Bag b {- Left  -},\n                        Bag c {- Right -})\npartitionBagWith _    EmptyBag = (EmptyBag, EmptyBag)\npartitionBagWith pred (UnitBag val)\n    = case pred val of\n         Left a  -> (UnitBag a, EmptyBag)\n         Right b -> (EmptyBag, UnitBag b)\npartitionBagWith pred (TwoBags b1 b2)\n    = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)\n  where (sat1, fail1) = partitionBagWith pred b1\n        (sat2, fail2) = partitionBagWith pred b2\npartitionBagWith pred (ListBag vs) = (listToBag sats, listToBag fails)\n  where (sats, fails) = partitionWith pred vs\n\nfoldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative\n        -> (a -> r)      -- Replace UnitBag with this\n        -> r             -- Replace EmptyBag with this\n        -> Bag a\n        -> r\n\n{- Standard definition\nfoldBag t u e EmptyBag        = e\nfoldBag t u e (UnitBag x)     = u x\nfoldBag t u e (TwoBags b1 b2) = (foldBag t u e b1) `t` (foldBag t u e b2)\nfoldBag t u e (ListBag xs)    = foldr (t.u) e xs\n-}\n\n-- More tail-recursive definition, exploiting associativity of \"t\"\nfoldBag _ _ e EmptyBag        = e\nfoldBag t u e (UnitBag x)     = u x `t` e\nfoldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1\nfoldBag t u e (ListBag xs)    = foldr (t.u) e xs\n\nfoldrBag :: (a -> r -> r) -> r\n         -> Bag a\n         -> r\n\nfoldrBag _ z EmptyBag        = z\nfoldrBag k z (UnitBag x)     = k x z\nfoldrBag k z (TwoBags b1 b2) = foldrBag k (foldrBag k z b2) b1\nfoldrBag k z (ListBag xs)    = foldr k z xs\n\nfoldlBag :: (r -> a -> r) -> r\n         -> Bag a\n         -> r\n\nfoldlBag _ z EmptyBag        = z\nfoldlBag k z (UnitBag x)     = k z x\nfoldlBag k z (TwoBags b1 b2) = foldlBag k (foldlBag k z b1) b2\nfoldlBag k z (ListBag xs)    = foldl k z xs\n\nfoldrBagM :: (Monad m) => (a -> b -> m b) -> b -> Bag a -> m b\nfoldrBagM _ z EmptyBag        = return z\nfoldrBagM k z (UnitBag x)     = k x z\nfoldrBagM k z (TwoBags b1 b2) = do { z' <- foldrBagM k z b2; foldrBagM k z' b1 }\nfoldrBagM k z (ListBag xs)    = foldrM k z xs\n\nfoldlBagM :: (Monad m) => (b -> a -> m b) -> b -> Bag a -> m b\nfoldlBagM _ z EmptyBag        = return z\nfoldlBagM k z (UnitBag x)     = k z x\nfoldlBagM k z (TwoBags b1 b2) = do { z' <- foldlBagM k z b1; foldlBagM k z' b2 }\nfoldlBagM k z (ListBag xs)    = foldlM k z xs\n\nmapBag :: (a -> b) -> Bag a -> Bag b\nmapBag _ EmptyBag        = EmptyBag\nmapBag f (UnitBag x)     = UnitBag (f x)\nmapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2)\nmapBag f (ListBag xs)    = ListBag (map f xs)\n\nconcatMapBag :: (a -> Bag b) -> Bag a -> Bag b\nconcatMapBag _ EmptyBag        = EmptyBag\nconcatMapBag f (UnitBag x)     = f x\nconcatMapBag f (TwoBags b1 b2) = unionBags (concatMapBag f b1) (concatMapBag f b2)\nconcatMapBag f (ListBag xs)    = foldr (unionBags . f) emptyBag xs\n\nconcatMapBagPair :: (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)\nconcatMapBagPair _ EmptyBag        = (EmptyBag, EmptyBag)\nconcatMapBagPair f (UnitBag x)     = f x\nconcatMapBagPair f (TwoBags b1 b2) = (unionBags r1 r2, unionBags s1 s2)\n  where\n    (r1, s1) = concatMapBagPair f b1\n    (r2, s2) = concatMapBagPair f b2\nconcatMapBagPair f (ListBag xs)    = foldr go (emptyBag, emptyBag) xs\n  where\n    go a (s1, s2) = (unionBags r1 s1, unionBags r2 s2)\n      where\n        (r1, r2) = f a\n\nmapMaybeBag :: (a -> Maybe b) -> Bag a -> Bag b\nmapMaybeBag _ EmptyBag        = EmptyBag\nmapMaybeBag f (UnitBag x)     = case f x of\n                                  Nothing -> EmptyBag\n                                  Just y  -> UnitBag y\nmapMaybeBag f (TwoBags b1 b2) = unionBags (mapMaybeBag f b1) (mapMaybeBag f b2)\nmapMaybeBag f (ListBag xs)    = ListBag (mapMaybe f xs)\n\nmapBagM :: Monad m => (a -> m b) -> Bag a -> m (Bag b)\nmapBagM _ EmptyBag        = return EmptyBag\nmapBagM f (UnitBag x)     = do r <- f x\n                               return (UnitBag r)\nmapBagM f (TwoBags b1 b2) = do r1 <- mapBagM f b1\n                               r2 <- mapBagM f b2\n                               return (TwoBags r1 r2)\nmapBagM f (ListBag    xs) = do rs <- mapM f xs\n                               return (ListBag rs)\n\nmapBagM_ :: Monad m => (a -> m b) -> Bag a -> m ()\nmapBagM_ _ EmptyBag        = return ()\nmapBagM_ f (UnitBag x)     = f x >> return ()\nmapBagM_ f (TwoBags b1 b2) = mapBagM_ f b1 >> mapBagM_ f b2\nmapBagM_ f (ListBag    xs) = mapM_ f xs\n\nflatMapBagM :: Monad m => (a -> m (Bag b)) -> Bag a -> m (Bag b)\nflatMapBagM _ EmptyBag        = return EmptyBag\nflatMapBagM f (UnitBag x)     = f x\nflatMapBagM f (TwoBags b1 b2) = do r1 <- flatMapBagM f b1\n                                   r2 <- flatMapBagM f b2\n                                   return (r1 `unionBags` r2)\nflatMapBagM f (ListBag    xs) = foldrM k EmptyBag xs\n  where\n    k x b2 = do { b1 <- f x; return (b1 `unionBags` b2) }\n\nflatMapBagPairM :: Monad m => (a -> m (Bag b, Bag c)) -> Bag a -> m (Bag b, Bag c)\nflatMapBagPairM _ EmptyBag        = return (EmptyBag, EmptyBag)\nflatMapBagPairM f (UnitBag x)     = f x\nflatMapBagPairM f (TwoBags b1 b2) = do (r1,s1) <- flatMapBagPairM f b1\n                                       (r2,s2) <- flatMapBagPairM f b2\n                                       return (r1 `unionBags` r2, s1 `unionBags` s2)\nflatMapBagPairM f (ListBag    xs) = foldrM k (EmptyBag, EmptyBag) xs\n  where\n    k x (r2,s2) = do { (r1,s1) <- f x\n                     ; return (r1 `unionBags` r2, s1 `unionBags` s2) }\n\nmapAndUnzipBagM :: Monad m => (a -> m (b,c)) -> Bag a -> m (Bag b, Bag c)\nmapAndUnzipBagM _ EmptyBag        = return (EmptyBag, EmptyBag)\nmapAndUnzipBagM f (UnitBag x)     = do (r,s) <- f x\n                                       return (UnitBag r, UnitBag s)\nmapAndUnzipBagM f (TwoBags b1 b2) = do (r1,s1) <- mapAndUnzipBagM f b1\n                                       (r2,s2) <- mapAndUnzipBagM f b2\n                                       return (TwoBags r1 r2, TwoBags s1 s2)\nmapAndUnzipBagM f (ListBag xs)    = do ts <- mapM f xs\n                                       let (rs,ss) = unzip ts\n                                       return (ListBag rs, ListBag ss)\n\nmapAccumBagL ::(acc -> x -> (acc, y)) -- ^ combining function\n            -> acc                    -- ^ initial state\n            -> Bag x                  -- ^ inputs\n            -> (acc, Bag y)           -- ^ final state, outputs\nmapAccumBagL _ s EmptyBag        = (s, EmptyBag)\nmapAccumBagL f s (UnitBag x)     = let (s1, x1) = f s x in (s1, UnitBag x1)\nmapAccumBagL f s (TwoBags b1 b2) = let (s1, b1') = mapAccumBagL f s  b1\n                                       (s2, b2') = mapAccumBagL f s1 b2\n                                   in (s2, TwoBags b1' b2')\nmapAccumBagL f s (ListBag xs)    = let (s', xs') = mapAccumL f s xs\n                                   in (s', ListBag xs')\n\nmapAccumBagLM :: Monad m\n            => (acc -> x -> m (acc, y)) -- ^ combining function\n            -> acc                      -- ^ initial state\n            -> Bag x                    -- ^ inputs\n            -> m (acc, Bag y)           -- ^ final state, outputs\nmapAccumBagLM _ s EmptyBag        = return (s, EmptyBag)\nmapAccumBagLM f s (UnitBag x)     = do { (s1, x1) <- f s x; return (s1, UnitBag x1) }\nmapAccumBagLM f s (TwoBags b1 b2) = do { (s1, b1') <- mapAccumBagLM f s  b1\n                                       ; (s2, b2') <- mapAccumBagLM f s1 b2\n                                       ; return (s2, TwoBags b1' b2') }\nmapAccumBagLM f s (ListBag xs)    = do { (s', xs') <- mapAccumLM f s xs\n                                       ; return (s', ListBag xs') }\n\nlistToBag :: [a] -> Bag a\nlistToBag [] = EmptyBag\nlistToBag [x] = UnitBag x\nlistToBag vs = ListBag vs\n\nbagToList :: Bag a -> [a]\nbagToList b = foldrBag (:) [] b\n\ninstance (Outputable a) => Outputable (Bag a) where\n    ppr bag = braces (pprWithCommas ppr (bagToList bag))\n\ninstance Data a => Data (Bag a) where\n  gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly\n  toConstr _   = abstractConstr $ \"Bag(\"++show (typeOf (undefined::a))++\")\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"Bag\"\n  dataCast1 x  = gcast1 x\n\ninstance Functor Bag where\n    fmap = mapBag\n\ninstance Foldable.Foldable Bag where\n    foldr = foldrBag\n", "num_lines": 352}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiWayIf #-}\n\n{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}\n-- We always optimise this, otherwise performance of a non-optimised\n-- compiler is severely affected\n\n--\n-- (c) The University of Glasgow 2002-2006\n--\n-- Binary I/O library, with special tweaks for GHC\n--\n-- Based on the nhc98 Binary library, which is copyright\n-- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.\n-- Under the terms of the license for that software, we must tell you\n-- where you can obtain the original version of the Binary library, namely\n--     http://www.cs.york.ac.uk/fp/nhc98/\n\nmodule Binary\n  ( {-type-}  Bin,\n    {-class-} Binary(..),\n    {-type-}  BinHandle,\n    SymbolTable, Dictionary,\n\n   openBinMem,\n--   closeBin,\n\n   seekBin,\n   seekBy,\n   tellBin,\n   castBin,\n   isEOFBin,\n   withBinBuffer,\n\n   writeBinMem,\n   readBinMem,\n\n   putAt, getAt,\n\n   -- * For writing instances\n   putByte,\n   getByte,\n\n   -- * Lazy Binary I/O\n   lazyGet,\n   lazyPut,\n\n   -- * User data\n   UserData(..), getUserData, setUserData,\n   newReadState, newWriteState,\n   putDictionary, getDictionary, putFS,\n  ) where\n\n#include \"HsVersions.h\"\n\n-- The *host* architecture version:\n#include \"../includes/MachDeps.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} Name (Name)\nimport FastString\nimport Panic\nimport UniqFM\nimport FastMutInt\nimport Fingerprint\nimport BasicTypes\nimport SrcLoc\n\nimport Foreign\nimport Data.Array\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString.Internal as BS\nimport qualified Data.ByteString.Unsafe   as BS\nimport Data.IORef\nimport Data.Char                ( ord, chr )\nimport Data.Time\nimport Type.Reflection\nimport Type.Reflection.Unsafe\nimport Data.Kind (Type)\nimport GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..))\nimport Control.Monad            ( when )\nimport System.IO as IO\nimport System.IO.Unsafe         ( unsafeInterleaveIO )\nimport System.IO.Error          ( mkIOError, eofErrorType )\nimport GHC.Real                 ( Ratio(..) )\nimport GHC.Serialized\n\ntype BinArray = ForeignPtr Word8\n\n---------------------------------------------------------------\n-- BinHandle\n---------------------------------------------------------------\n\ndata BinHandle\n  = BinMem {                     -- binary data stored in an unboxed array\n     bh_usr :: UserData,         -- sigh, need parameterized modules :-)\n     _off_r :: !FastMutInt,      -- the current offset\n     _sz_r  :: !FastMutInt,      -- size of the array (cached)\n     _arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1))\n    }\n        -- XXX: should really store a \"high water mark\" for dumping out\n        -- the binary data to a file.\n\ngetUserData :: BinHandle -> UserData\ngetUserData bh = bh_usr bh\n\nsetUserData :: BinHandle -> UserData -> BinHandle\nsetUserData bh us = bh { bh_usr = us }\n\n-- | Get access to the underlying buffer.\n--\n-- It is quite important that no references to the 'ByteString' leak out of the\n-- continuation lest terrible things happen.\nwithBinBuffer :: BinHandle -> (ByteString -> IO a) -> IO a\nwithBinBuffer (BinMem _ ix_r _ arr_r) action = do\n  arr <- readIORef arr_r\n  ix <- readFastMutInt ix_r\n  withForeignPtr arr $ \\ptr ->\n    BS.unsafePackCStringLen (castPtr ptr, ix) >>= action\n\n\n---------------------------------------------------------------\n-- Bin\n---------------------------------------------------------------\n\nnewtype Bin a = BinPtr Int\n  deriving (Eq, Ord, Show, Bounded)\n\ncastBin :: Bin a -> Bin b\ncastBin (BinPtr i) = BinPtr i\n\n---------------------------------------------------------------\n-- class Binary\n---------------------------------------------------------------\n\nclass Binary a where\n    put_   :: BinHandle -> a -> IO ()\n    put    :: BinHandle -> a -> IO (Bin a)\n    get    :: BinHandle -> IO a\n\n    -- define one of put_, put.  Use of put_ is recommended because it\n    -- is more likely that tail-calls can kick in, and we rarely need the\n    -- position return value.\n    put_ bh a = do _ <- put bh a; return ()\n    put bh a  = do p <- tellBin bh; put_ bh a; return p\n\nputAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()\nputAt bh p x = do seekBin bh p; put_ bh x; return ()\n\ngetAt  :: Binary a => BinHandle -> Bin a -> IO a\ngetAt bh p = do seekBin bh p; get bh\n\nopenBinMem :: Int -> IO BinHandle\nopenBinMem size\n | size <= 0 = error \"Data.Binary.openBinMem: size must be >= 0\"\n | otherwise = do\n   arr <- mallocForeignPtrBytes size\n   arr_r <- newIORef arr\n   ix_r <- newFastMutInt\n   writeFastMutInt ix_r 0\n   sz_r <- newFastMutInt\n   writeFastMutInt sz_r size\n   return (BinMem noUserData ix_r sz_r arr_r)\n\ntellBin :: BinHandle -> IO (Bin a)\ntellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)\n\nseekBin :: BinHandle -> Bin a -> IO ()\nseekBin h@(BinMem _ ix_r sz_r _) (BinPtr p) = do\n  sz <- readFastMutInt sz_r\n  if (p >= sz)\n        then do expandBin h p; writeFastMutInt ix_r p\n        else writeFastMutInt ix_r p\n\nseekBy :: BinHandle -> Int -> IO ()\nseekBy h@(BinMem _ ix_r sz_r _) off = do\n  sz <- readFastMutInt sz_r\n  ix <- readFastMutInt ix_r\n  let ix' = ix + off\n  if (ix' >= sz)\n        then do expandBin h ix'; writeFastMutInt ix_r ix'\n        else writeFastMutInt ix_r ix'\n\nisEOFBin :: BinHandle -> IO Bool\nisEOFBin (BinMem _ ix_r sz_r _) = do\n  ix <- readFastMutInt ix_r\n  sz <- readFastMutInt sz_r\n  return (ix >= sz)\n\nwriteBinMem :: BinHandle -> FilePath -> IO ()\nwriteBinMem (BinMem _ ix_r _ arr_r) fn = do\n  h <- openBinaryFile fn WriteMode\n  arr <- readIORef arr_r\n  ix  <- readFastMutInt ix_r\n  withForeignPtr arr $ \\p -> hPutBuf h p ix\n  hClose h\n\nreadBinMem :: FilePath -> IO BinHandle\n-- Return a BinHandle with a totally undefined State\nreadBinMem filename = do\n  h <- openBinaryFile filename ReadMode\n  filesize' <- hFileSize h\n  let filesize = fromIntegral filesize'\n  arr <- mallocForeignPtrBytes filesize\n  count <- withForeignPtr arr $ \\p -> hGetBuf h p filesize\n  when (count /= filesize) $\n       error (\"Binary.readBinMem: only read \" ++ show count ++ \" bytes\")\n  hClose h\n  arr_r <- newIORef arr\n  ix_r <- newFastMutInt\n  writeFastMutInt ix_r 0\n  sz_r <- newFastMutInt\n  writeFastMutInt sz_r filesize\n  return (BinMem noUserData ix_r sz_r arr_r)\n\n-- expand the size of the array to include a specified offset\nexpandBin :: BinHandle -> Int -> IO ()\nexpandBin (BinMem _ _ sz_r arr_r) off = do\n   sz <- readFastMutInt sz_r\n   let sz' = head (dropWhile (<= off) (iterate (* 2) sz))\n   arr <- readIORef arr_r\n   arr' <- mallocForeignPtrBytes sz'\n   withForeignPtr arr $ \\old ->\n     withForeignPtr arr' $ \\new ->\n       copyBytes new old sz\n   writeFastMutInt sz_r sz'\n   writeIORef arr_r arr'\n\n-- -----------------------------------------------------------------------------\n-- Low-level reading/writing of bytes\n\nputPrim :: BinHandle -> Int -> (Ptr Word8 -> IO ()) -> IO ()\nputPrim h@(BinMem _ ix_r sz_r arr_r) size f = do\n  ix <- readFastMutInt ix_r\n  sz <- readFastMutInt sz_r\n  when (ix + size > sz) $\n    expandBin h (ix + size)\n  arr <- readIORef arr_r\n  withForeignPtr arr $ \\op -> f (op `plusPtr` ix)\n  writeFastMutInt ix_r (ix + size)\n\ngetPrim :: BinHandle -> Int -> (Ptr Word8 -> IO a) -> IO a\ngetPrim (BinMem _ ix_r sz_r arr_r) size f = do\n  ix <- readFastMutInt ix_r\n  sz <- readFastMutInt sz_r\n  when (ix + size > sz) $\n      ioError (mkIOError eofErrorType \"Data.Binary.getPrim\" Nothing Nothing)\n  arr <- readIORef arr_r\n  w <- withForeignPtr arr $ \\op -> f (op `plusPtr` ix)\n  writeFastMutInt ix_r (ix + size)\n  return w\n\nputWord8 :: BinHandle -> Word8 -> IO ()\nputWord8 h w = putPrim h 1 (\\op -> poke op w)\n\ngetWord8 :: BinHandle -> IO Word8\ngetWord8 h = getPrim h 1 peek\n\nputWord16 :: BinHandle -> Word16 -> IO ()\nputWord16 h w = putPrim h 2 (\\op -> do\n  pokeElemOff op 0 (fromIntegral (w `shiftR` 8))\n  pokeElemOff op 1 (fromIntegral (w .&. 0xFF))\n  )\n\ngetWord16 :: BinHandle -> IO Word16\ngetWord16 h = getPrim h 2 (\\op -> do\n  w0 <- fromIntegral <$> peekElemOff op 0\n  w1 <- fromIntegral <$> peekElemOff op 1\n  return $! w0 `shiftL` 8 .|. w1\n  )\n\nputWord32 :: BinHandle -> Word32 -> IO ()\nputWord32 h w = putPrim h 4 (\\op -> do\n  pokeElemOff op 0 (fromIntegral (w `shiftR` 24))\n  pokeElemOff op 1 (fromIntegral ((w `shiftR` 16) .&. 0xFF))\n  pokeElemOff op 2 (fromIntegral ((w `shiftR` 8) .&. 0xFF))\n  pokeElemOff op 3 (fromIntegral (w .&. 0xFF))\n  )\n\ngetWord32 :: BinHandle -> IO Word32\ngetWord32 h = getPrim h 4 (\\op -> do\n  w0 <- fromIntegral <$> peekElemOff op 0\n  w1 <- fromIntegral <$> peekElemOff op 1\n  w2 <- fromIntegral <$> peekElemOff op 2\n  w3 <- fromIntegral <$> peekElemOff op 3\n\n  return $! (w0 `shiftL` 24) .|.\n            (w1 `shiftL` 16) .|.\n            (w2 `shiftL` 8)  .|.\n            w3\n  )\n\nputWord64 :: BinHandle -> Word64 -> IO ()\nputWord64 h w = putPrim h 8 (\\op -> do\n  pokeElemOff op 0 (fromIntegral (w `shiftR` 56))\n  pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))\n  pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))\n  pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))\n  pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))\n  pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))\n  pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))\n  pokeElemOff op 7 (fromIntegral (w .&. 0xFF))\n  )\n\ngetWord64 :: BinHandle -> IO Word64\ngetWord64 h = getPrim h 8 (\\op -> do\n  w0 <- fromIntegral <$> peekElemOff op 0\n  w1 <- fromIntegral <$> peekElemOff op 1\n  w2 <- fromIntegral <$> peekElemOff op 2\n  w3 <- fromIntegral <$> peekElemOff op 3\n  w4 <- fromIntegral <$> peekElemOff op 4\n  w5 <- fromIntegral <$> peekElemOff op 5\n  w6 <- fromIntegral <$> peekElemOff op 6\n  w7 <- fromIntegral <$> peekElemOff op 7\n\n  return $! (w0 `shiftL` 56) .|.\n            (w1 `shiftL` 48) .|.\n            (w2 `shiftL` 40) .|.\n            (w3 `shiftL` 32) .|.\n            (w4 `shiftL` 24) .|.\n            (w5 `shiftL` 16) .|.\n            (w6 `shiftL` 8)  .|.\n            w7\n  )\n\nputByte :: BinHandle -> Word8 -> IO ()\nputByte bh w = putWord8 bh w\n\ngetByte :: BinHandle -> IO Word8\ngetByte h = getWord8 h\n\n-- -----------------------------------------------------------------------------\n-- Primitive Word writes\n\ninstance Binary Word8 where\n  put_ = putWord8\n  get  = getWord8\n\ninstance Binary Word16 where\n  put_ h w = putWord16 h w\n  get h = getWord16 h\n\ninstance Binary Word32 where\n  put_ h w = putWord32 h w\n  get h = getWord32 h\n\ninstance Binary Word64 where\n  put_ h w = putWord64 h w\n  get h = getWord64 h\n\n-- -----------------------------------------------------------------------------\n-- Primitive Int writes\n\ninstance Binary Int8 where\n  put_ h w = put_ h (fromIntegral w :: Word8)\n  get h    = do w <- get h; return $! (fromIntegral (w::Word8))\n\ninstance Binary Int16 where\n  put_ h w = put_ h (fromIntegral w :: Word16)\n  get h    = do w <- get h; return $! (fromIntegral (w::Word16))\n\ninstance Binary Int32 where\n  put_ h w = put_ h (fromIntegral w :: Word32)\n  get h    = do w <- get h; return $! (fromIntegral (w::Word32))\n\ninstance Binary Int64 where\n  put_ h w = put_ h (fromIntegral w :: Word64)\n  get h    = do w <- get h; return $! (fromIntegral (w::Word64))\n\n-- -----------------------------------------------------------------------------\n-- Instances for standard types\n\ninstance Binary () where\n    put_ _ () = return ()\n    get  _    = return ()\n\ninstance Binary Bool where\n    put_ bh b = putByte bh (fromIntegral (fromEnum b))\n    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))\n\ninstance Binary Char where\n    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)\n    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))\n\ninstance Binary Int where\n    put_ bh i = put_ bh (fromIntegral i :: Int64)\n    get  bh = do\n        x <- get bh\n        return $! (fromIntegral (x :: Int64))\n\ninstance Binary a => Binary [a] where\n    put_ bh l = do\n        let len = length l\n        if (len < 0xff)\n          then putByte bh (fromIntegral len :: Word8)\n          else do putByte bh 0xff; put_ bh (fromIntegral len :: Word32)\n        mapM_ (put_ bh) l\n    get bh = do\n        b <- getByte bh\n        len <- if b == 0xff\n                  then get bh\n                  else return (fromIntegral b :: Word32)\n        let loop 0 = return []\n            loop n = do a <- get bh; as <- loop (n-1); return (a:as)\n        loop len\n\ninstance (Ix a, Binary a, Binary b) => Binary (Array a b) where\n    put_ bh arr = do\n        put_ bh $ bounds arr\n        put_ bh $ elems arr\n    get bh = do\n        bounds <- get bh\n        xs <- get bh\n        return $ listArray bounds xs\n\ninstance (Binary a, Binary b) => Binary (a,b) where\n    put_ bh (a,b) = do put_ bh a; put_ bh b\n    get bh        = do a <- get bh\n                       b <- get bh\n                       return (a,b)\n\ninstance (Binary a, Binary b, Binary c) => Binary (a,b,c) where\n    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c\n    get bh          = do a <- get bh\n                         b <- get bh\n                         c <- get bh\n                         return (a,b,c)\n\ninstance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where\n    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d\n    get bh            = do a <- get bh\n                           b <- get bh\n                           c <- get bh\n                           d <- get bh\n                           return (a,b,c,d)\n\ninstance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d, e) where\n    put_ bh (a,b,c,d, e) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e;\n    get bh               = do a <- get bh\n                              b <- get bh\n                              c <- get bh\n                              d <- get bh\n                              e <- get bh\n                              return (a,b,c,d,e)\n\ninstance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d, e, f) where\n    put_ bh (a,b,c,d, e, f) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f;\n    get bh                  = do a <- get bh\n                                 b <- get bh\n                                 c <- get bh\n                                 d <- get bh\n                                 e <- get bh\n                                 f <- get bh\n                                 return (a,b,c,d,e,f)\n\ninstance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g) => Binary (a,b,c,d,e,f,g) where\n    put_ bh (a,b,c,d,e,f,g) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f; put_ bh g\n    get bh                  = do a <- get bh\n                                 b <- get bh\n                                 c <- get bh\n                                 d <- get bh\n                                 e <- get bh\n                                 f <- get bh\n                                 g <- get bh\n                                 return (a,b,c,d,e,f,g)\n\ninstance Binary a => Binary (Maybe a) where\n    put_ bh Nothing  = putByte bh 0\n    put_ bh (Just a) = do putByte bh 1; put_ bh a\n    get bh           = do h <- getWord8 bh\n                          case h of\n                            0 -> return Nothing\n                            _ -> do x <- get bh; return (Just x)\n\ninstance (Binary a, Binary b) => Binary (Either a b) where\n    put_ bh (Left  a) = do putByte bh 0; put_ bh a\n    put_ bh (Right b) = do putByte bh 1; put_ bh b\n    get bh            = do h <- getWord8 bh\n                           case h of\n                             0 -> do a <- get bh ; return (Left a)\n                             _ -> do b <- get bh ; return (Right b)\n\ninstance Binary UTCTime where\n    put_ bh u = do put_ bh (utctDay u)\n                   put_ bh (utctDayTime u)\n    get bh = do day <- get bh\n                dayTime <- get bh\n                return $ UTCTime { utctDay = day, utctDayTime = dayTime }\n\ninstance Binary Day where\n    put_ bh d = put_ bh (toModifiedJulianDay d)\n    get bh = do i <- get bh\n                return $ ModifiedJulianDay { toModifiedJulianDay = i }\n\ninstance Binary DiffTime where\n    put_ bh dt = put_ bh (toRational dt)\n    get bh = do r <- get bh\n                return $ fromRational r\n\n--to quote binary-0.3 on this code idea,\n--\n-- TODO  This instance is not architecture portable.  GMP stores numbers as\n-- arrays of machine sized words, so the byte format is not portable across\n-- architectures with different endianness and word size.\n--\n-- This makes it hard (impossible) to make an equivalent instance\n-- with code that is compilable with non-GHC.  Do we need any instance\n-- Binary Integer, and if so, does it have to be blazing fast?  Or can\n-- we just change this instance to be portable like the rest of the\n-- instances? (binary package has code to steal for that)\n--\n-- yes, we need Binary Integer and Binary Rational in basicTypes/Literal.hs\n\ninstance Binary Integer where\n    put_ bh i\n      | i >= lo32 && i <= hi32 = do\n          putWord8 bh 0\n          put_ bh (fromIntegral i :: Int32)\n      | otherwise = do\n          putWord8 bh 1\n          put_ bh (show i)\n      where\n        lo32 = fromIntegral (minBound :: Int32)\n        hi32 = fromIntegral (maxBound :: Int32)\n\n    get bh = do\n      int_kind <- getWord8 bh\n      case int_kind of\n        0 -> fromIntegral <$> (get bh :: IO Int32)\n        _ -> do str <- get bh\n                case reads str of\n                  [(i, \"\")] -> return i\n                  _ -> fail (\"Binary integer: got \" ++ show str)\n\n    {-\n    -- This code is currently commented out.\n    -- See https://ghc.haskell.org/trac/ghc/ticket/3379#comment:10 for\n    -- discussion.\n\n    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)\n    put_ bh (J# s# a#) = do\n        putByte bh 1\n        put_ bh (I# s#)\n        let sz# = sizeofByteArray# a#  -- in *bytes*\n        put_ bh (I# sz#)  -- in *bytes*\n        putByteArray bh a# sz#\n\n    get bh = do\n        b <- getByte bh\n        case b of\n          0 -> do (I# i#) <- get bh\n                  return (S# i#)\n          _ -> do (I# s#) <- get bh\n                  sz <- get bh\n                  (BA a#) <- getByteArray bh sz\n                  return (J# s# a#)\n\nputByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()\nputByteArray bh a s# = loop 0#\n  where loop n#\n           | n# ==# s# = return ()\n           | otherwise = do\n                putByte bh (indexByteArray a n#)\n                loop (n# +# 1#)\n\ngetByteArray :: BinHandle -> Int -> IO ByteArray\ngetByteArray bh (I# sz) = do\n  (MBA arr) <- newByteArray sz\n  let loop n\n           | n ==# sz = return ()\n           | otherwise = do\n                w <- getByte bh\n                writeByteArray arr n w\n                loop (n +# 1#)\n  loop 0#\n  freezeByteArray arr\n    -}\n\n{-\ndata ByteArray = BA ByteArray#\ndata MBA = MBA (MutableByteArray# RealWorld)\n\nnewByteArray :: Int# -> IO MBA\nnewByteArray sz = IO $ \\s ->\n  case newByteArray# sz s of { (# s, arr #) ->\n  (# s, MBA arr #) }\n\nfreezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray\nfreezeByteArray arr = IO $ \\s ->\n  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->\n  (# s, BA arr #) }\n\nwriteByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()\nwriteByteArray arr i (W8# w) = IO $ \\s ->\n  case writeWord8Array# arr i w s of { s ->\n  (# s, () #) }\n\nindexByteArray :: ByteArray# -> Int# -> Word8\nindexByteArray a# n# = W8# (indexWord8Array# a# n#)\n\n-}\ninstance (Binary a) => Binary (Ratio a) where\n    put_ bh (a :% b) = do put_ bh a; put_ bh b\n    get bh = do a <- get bh; b <- get bh; return (a :% b)\n\ninstance Binary (Bin a) where\n  put_ bh (BinPtr i) = put_ bh (fromIntegral i :: Int32)\n  get bh = do i <- get bh; return (BinPtr (fromIntegral (i :: Int32)))\n\n-- -----------------------------------------------------------------------------\n-- Instances for Data.Typeable stuff\n\ninstance Binary TyCon where\n    put_ bh tc = do\n        put_ bh (tyConPackage tc)\n        put_ bh (tyConModule tc)\n        put_ bh (tyConName tc)\n        put_ bh (tyConKindArgs tc)\n        put_ bh (tyConKindRep tc)\n    get bh =\n        mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh\n\ninstance Binary VecCount where\n    put_ bh = putByte bh . fromIntegral . fromEnum\n    get bh = toEnum . fromIntegral <$> getByte bh\n\ninstance Binary VecElem where\n    put_ bh = putByte bh . fromIntegral . fromEnum\n    get bh = toEnum . fromIntegral <$> getByte bh\n\ninstance Binary RuntimeRep where\n    put_ bh (VecRep a b)    = putByte bh 0 >> put_ bh a >> put_ bh b\n    put_ bh (TupleRep reps) = putByte bh 1 >> put_ bh reps\n    put_ bh (SumRep reps)   = putByte bh 2 >> put_ bh reps\n    put_ bh LiftedRep       = putByte bh 3\n    put_ bh UnliftedRep     = putByte bh 4\n    put_ bh IntRep          = putByte bh 5\n    put_ bh WordRep         = putByte bh 6\n    put_ bh Int64Rep        = putByte bh 7\n    put_ bh Word64Rep       = putByte bh 8\n    put_ bh AddrRep         = putByte bh 9\n    put_ bh FloatRep        = putByte bh 10\n    put_ bh DoubleRep       = putByte bh 11\n#if __GLASGOW_HASKELL__ >= 807\n    put_ bh Int8Rep         = putByte bh 12\n    put_ bh Word8Rep        = putByte bh 13\n    put_ bh Int16Rep        = putByte bh 14\n    put_ bh Word16Rep       = putByte bh 15\n#endif\n\n    get bh = do\n        tag <- getByte bh\n        case tag of\n          0  -> VecRep <$> get bh <*> get bh\n          1  -> TupleRep <$> get bh\n          2  -> SumRep <$> get bh\n          3  -> pure LiftedRep\n          4  -> pure UnliftedRep\n          5  -> pure IntRep\n          6  -> pure WordRep\n          7  -> pure Int64Rep\n          8  -> pure Word64Rep\n          9  -> pure AddrRep\n          10 -> pure FloatRep\n          11 -> pure DoubleRep\n#if __GLASGOW_HASKELL__ >= 807\n          12 -> pure Int8Rep\n          13 -> pure Word8Rep\n          14 -> pure Int16Rep\n          15 -> pure Word16Rep\n#endif\n          _  -> fail \"Binary.putRuntimeRep: invalid tag\"\n\ninstance Binary KindRep where\n    put_ bh (KindRepTyConApp tc k) = putByte bh 0 >> put_ bh tc >> put_ bh k\n    put_ bh (KindRepVar bndr) = putByte bh 1 >> put_ bh bndr\n    put_ bh (KindRepApp a b) = putByte bh 2 >> put_ bh a >> put_ bh b\n    put_ bh (KindRepFun a b) = putByte bh 3 >> put_ bh a >> put_ bh b\n    put_ bh (KindRepTYPE r) = putByte bh 4 >> put_ bh r\n    put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh r\n\n    get bh = do\n        tag <- getByte bh\n        case tag of\n          0 -> KindRepTyConApp <$> get bh <*> get bh\n          1 -> KindRepVar <$> get bh\n          2 -> KindRepApp <$> get bh <*> get bh\n          3 -> KindRepFun <$> get bh <*> get bh\n          4 -> KindRepTYPE <$> get bh\n          5 -> KindRepTypeLit <$> get bh <*> get bh\n          _ -> fail \"Binary.putKindRep: invalid tag\"\n\ninstance Binary TypeLitSort where\n    put_ bh TypeLitSymbol = putByte bh 0\n    put_ bh TypeLitNat = putByte bh 1\n    get bh = do\n        tag <- getByte bh\n        case tag of\n          0 -> pure TypeLitSymbol\n          1 -> pure TypeLitNat\n          _ -> fail \"Binary.putTypeLitSort: invalid tag\"\n\nputTypeRep :: BinHandle -> TypeRep a -> IO ()\n-- Special handling for TYPE, (->), and RuntimeRep due to recursive kind\n-- relations.\n-- See Note [Mutually recursive representations of primitive types]\nputTypeRep bh rep\n  | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type)\n  = put_ bh (0 :: Word8)\nputTypeRep bh (Con' con ks) = do\n    put_ bh (1 :: Word8)\n    put_ bh con\n    put_ bh ks\nputTypeRep bh (App f x) = do\n    put_ bh (2 :: Word8)\n    putTypeRep bh f\n    putTypeRep bh x\nputTypeRep bh (Fun arg res) = do\n    put_ bh (3 :: Word8)\n    putTypeRep bh arg\n    putTypeRep bh res\nputTypeRep _ _ = fail \"Binary.putTypeRep: Impossible\"\n\ngetSomeTypeRep :: BinHandle -> IO SomeTypeRep\ngetSomeTypeRep bh = do\n    tag <- get bh :: IO Word8\n    case tag of\n        0 -> return $ SomeTypeRep (typeRep :: TypeRep Type)\n        1 -> do con <- get bh :: IO TyCon\n                ks <- get bh :: IO [SomeTypeRep]\n                return $ SomeTypeRep $ mkTrCon con ks\n\n        2 -> do SomeTypeRep f <- getSomeTypeRep bh\n                SomeTypeRep x <- getSomeTypeRep bh\n                case typeRepKind f of\n                  Fun arg res ->\n                      case arg `eqTypeRep` typeRepKind x of\n                        Just HRefl ->\n                            case typeRepKind res `eqTypeRep` (typeRep :: TypeRep Type) of\n                              Just HRefl -> return $ SomeTypeRep $ mkTrApp f x\n                              _ -> failure \"Kind mismatch in type application\" []\n                        _ -> failure \"Kind mismatch in type application\"\n                             [ \"    Found argument of kind: \" ++ show (typeRepKind x)\n                             , \"    Where the constructor:  \" ++ show f\n                             , \"    Expects kind:           \" ++ show arg\n                             ]\n                  _ -> failure \"Applied non-arrow\"\n                       [ \"    Applied type: \" ++ show f\n                       , \"    To argument:  \" ++ show x\n                       ]\n        3 -> do SomeTypeRep arg <- getSomeTypeRep bh\n                SomeTypeRep res <- getSomeTypeRep bh\n                if\n                  | App argkcon _ <- typeRepKind arg\n                  , App reskcon _ <- typeRepKind res\n                  , Just HRefl <- argkcon `eqTypeRep` tYPErep\n                  , Just HRefl <- reskcon `eqTypeRep` tYPErep\n                  -> return $ SomeTypeRep $ Fun arg res\n                  | otherwise -> failure \"Kind mismatch\" []\n        _ -> failure \"Invalid SomeTypeRep\" []\n  where\n    tYPErep :: TypeRep TYPE\n    tYPErep = typeRep\n\n    failure description info =\n        fail $ unlines $ [ \"Binary.getSomeTypeRep: \"++description ]\n                      ++ map (\"    \"++) info\n\ninstance Typeable a => Binary (TypeRep (a :: k)) where\n    put_ = putTypeRep\n    get bh = do\n        SomeTypeRep rep <- getSomeTypeRep bh\n        case rep `eqTypeRep` expected of\n            Just HRefl -> pure rep\n            Nothing    -> fail $ unlines\n                               [ \"Binary: Type mismatch\"\n                               , \"    Deserialized type: \" ++ show rep\n                               , \"    Expected type:     \" ++ show expected\n                               ]\n     where expected = typeRep :: TypeRep a\n\ninstance Binary SomeTypeRep where\n    put_ bh (SomeTypeRep rep) = putTypeRep bh rep\n    get = getSomeTypeRep\n\n-- -----------------------------------------------------------------------------\n-- Lazy reading/writing\n\nlazyPut :: Binary a => BinHandle -> a -> IO ()\nlazyPut bh a = do\n    -- output the obj with a ptr to skip over it:\n    pre_a <- tellBin bh\n    put_ bh pre_a       -- save a slot for the ptr\n    put_ bh a           -- dump the object\n    q <- tellBin bh     -- q = ptr to after object\n    putAt bh pre_a q    -- fill in slot before a with ptr to q\n    seekBin bh q        -- finally carry on writing at q\n\nlazyGet :: Binary a => BinHandle -> IO a\nlazyGet bh = do\n    p <- get bh -- a BinPtr\n    p_a <- tellBin bh\n    a <- unsafeInterleaveIO $ do\n        -- NB: Use a fresh off_r variable in the child thread, for thread\n        -- safety.\n        off_r <- newFastMutInt\n        getAt bh { _off_r = off_r } p_a\n    seekBin bh p -- skip over the object for now\n    return a\n\n-- -----------------------------------------------------------------------------\n-- UserData\n-- -----------------------------------------------------------------------------\n\n-- | Information we keep around during interface file\n-- serialization/deserialization. Namely we keep the functions for serializing\n-- and deserializing 'Name's and 'FastString's. We do this because we actually\n-- use serialization in two distinct settings,\n--\n-- * When serializing interface files themselves\n--\n-- * When computing the fingerprint of an IfaceDecl (which we computing by\n--   hashing its Binary serialization)\n--\n-- These two settings have different needs while serializing Names:\n--\n-- * Names in interface files are serialized via a symbol table (see Note\n--   [Symbol table representation of names] in BinIface).\n--\n-- * During fingerprinting a binding Name is serialized as the OccName and a\n--   non-binding Name is serialized as the fingerprint of the thing they\n--   represent. See Note [Fingerprinting IfaceDecls] for further discussion.\n--\ndata UserData =\n   UserData {\n        -- for *deserialising* only:\n        ud_get_name :: BinHandle -> IO Name,\n        ud_get_fs   :: BinHandle -> IO FastString,\n\n        -- for *serialising* only:\n        ud_put_nonbinding_name :: BinHandle -> Name -> IO (),\n        -- ^ serialize a non-binding 'Name' (e.g. a reference to another\n        -- binding).\n        ud_put_binding_name :: BinHandle -> Name -> IO (),\n        -- ^ serialize a binding 'Name' (e.g. the name of an IfaceDecl)\n        ud_put_fs   :: BinHandle -> FastString -> IO ()\n   }\n\nnewReadState :: (BinHandle -> IO Name)   -- ^ how to deserialize 'Name's\n             -> (BinHandle -> IO FastString)\n             -> UserData\nnewReadState get_name get_fs\n  = UserData { ud_get_name = get_name,\n               ud_get_fs   = get_fs,\n               ud_put_nonbinding_name = undef \"put_nonbinding_name\",\n               ud_put_binding_name    = undef \"put_binding_name\",\n               ud_put_fs   = undef \"put_fs\"\n             }\n\nnewWriteState :: (BinHandle -> Name -> IO ())\n                 -- ^ how to serialize non-binding 'Name's\n              -> (BinHandle -> Name -> IO ())\n                 -- ^ how to serialize binding 'Name's\n              -> (BinHandle -> FastString -> IO ())\n              -> UserData\nnewWriteState put_nonbinding_name put_binding_name put_fs\n  = UserData { ud_get_name = undef \"get_name\",\n               ud_get_fs   = undef \"get_fs\",\n               ud_put_nonbinding_name = put_nonbinding_name,\n               ud_put_binding_name    = put_binding_name,\n               ud_put_fs   = put_fs\n             }\n\nnoUserData :: a\nnoUserData = undef \"UserData\"\n\nundef :: String -> a\nundef s = panic (\"Binary.UserData: no \" ++ s)\n\n---------------------------------------------------------\n-- The Dictionary\n---------------------------------------------------------\n\ntype Dictionary = Array Int FastString -- The dictionary\n                                       -- Should be 0-indexed\n\nputDictionary :: BinHandle -> Int -> UniqFM (Int,FastString) -> IO ()\nputDictionary bh sz dict = do\n  put_ bh sz\n  mapM_ (putFS bh) (elems (array (0,sz-1) (nonDetEltsUFM dict)))\n    -- It's OK to use nonDetEltsUFM here because the elements have indices\n    -- that array uses to create order\n\ngetDictionary :: BinHandle -> IO Dictionary\ngetDictionary bh = do\n  sz <- get bh\n  elems <- sequence (take sz (repeat (getFS bh)))\n  return (listArray (0,sz-1) elems)\n\n---------------------------------------------------------\n-- The Symbol Table\n---------------------------------------------------------\n\n-- On disk, the symbol table is an array of IfExtName, when\n-- reading it in we turn it into a SymbolTable.\n\ntype SymbolTable = Array Int Name\n\n---------------------------------------------------------\n-- Reading and writing FastStrings\n---------------------------------------------------------\n\nputFS :: BinHandle -> FastString -> IO ()\nputFS bh fs = putBS bh $ bytesFS fs\n\ngetFS :: BinHandle -> IO FastString\ngetFS bh = do\n  l  <- get bh :: IO Int\n  getPrim bh l (\\src -> pure $! mkFastStringBytes src l )\n\nputBS :: BinHandle -> ByteString -> IO ()\nputBS bh bs =\n  BS.unsafeUseAsCStringLen bs $ \\(ptr, l) -> do\n    put_ bh l\n    putPrim bh l (\\op -> BS.memcpy op (castPtr ptr) l)\n\ngetBS :: BinHandle -> IO ByteString\ngetBS bh = do\n  l <- get bh :: IO Int\n  BS.create l $ \\dest -> do\n    getPrim bh l (\\src -> BS.memcpy dest src l)\n\ninstance Binary ByteString where\n  put_ bh f = putBS bh f\n  get bh = getBS bh\n\ninstance Binary FastString where\n  put_ bh f =\n    case getUserData bh of\n        UserData { ud_put_fs = put_fs } -> put_fs bh f\n\n  get bh =\n    case getUserData bh of\n        UserData { ud_get_fs = get_fs } -> get_fs bh\n\n-- Here to avoid loop\ninstance Binary LeftOrRight where\n   put_ bh CLeft  = putByte bh 0\n   put_ bh CRight = putByte bh 1\n\n   get bh = do { h <- getByte bh\n               ; case h of\n                   0 -> return CLeft\n                   _ -> return CRight }\n\ninstance Binary PromotionFlag where\n   put_ bh NotPromoted = putByte bh 0\n   put_ bh IsPromoted  = putByte bh 1\n\n   get bh = do\n       n <- getByte bh\n       case n of\n         0 -> return NotPromoted\n         1 -> return IsPromoted\n         _ -> fail \"Binary(IsPromoted): fail)\"\n\ninstance Binary Fingerprint where\n  put_ h (Fingerprint w1 w2) = do put_ h w1; put_ h w2\n  get  h = do w1 <- get h; w2 <- get h; return (Fingerprint w1 w2)\n\ninstance Binary FunctionOrData where\n    put_ bh IsFunction = putByte bh 0\n    put_ bh IsData     = putByte bh 1\n    get bh = do\n        h <- getByte bh\n        case h of\n          0 -> return IsFunction\n          1 -> return IsData\n          _ -> panic \"Binary FunctionOrData\"\n\ninstance Binary TupleSort where\n    put_ bh BoxedTuple      = putByte bh 0\n    put_ bh UnboxedTuple    = putByte bh 1\n    put_ bh ConstraintTuple = putByte bh 2\n    get bh = do\n      h <- getByte bh\n      case h of\n        0 -> do return BoxedTuple\n        1 -> do return UnboxedTuple\n        _ -> do return ConstraintTuple\n\ninstance Binary Activation where\n    put_ bh NeverActive = do\n            putByte bh 0\n    put_ bh AlwaysActive = do\n            putByte bh 1\n    put_ bh (ActiveBefore src aa) = do\n            putByte bh 2\n            put_ bh src\n            put_ bh aa\n    put_ bh (ActiveAfter src ab) = do\n            putByte bh 3\n            put_ bh src\n            put_ bh ab\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return NeverActive\n              1 -> do return AlwaysActive\n              2 -> do src <- get bh\n                      aa <- get bh\n                      return (ActiveBefore src aa)\n              _ -> do src <- get bh\n                      ab <- get bh\n                      return (ActiveAfter src ab)\n\ninstance Binary InlinePragma where\n    put_ bh (InlinePragma s a b c d) = do\n            put_ bh s\n            put_ bh a\n            put_ bh b\n            put_ bh c\n            put_ bh d\n\n    get bh = do\n           s <- get bh\n           a <- get bh\n           b <- get bh\n           c <- get bh\n           d <- get bh\n           return (InlinePragma s a b c d)\n\ninstance Binary RuleMatchInfo where\n    put_ bh FunLike = putByte bh 0\n    put_ bh ConLike = putByte bh 1\n    get bh = do\n            h <- getByte bh\n            if h == 1 then return ConLike\n                      else return FunLike\n\ninstance Binary InlineSpec where\n    put_ bh NoUserInline    = putByte bh 0\n    put_ bh Inline          = putByte bh 1\n    put_ bh Inlinable       = putByte bh 2\n    put_ bh NoInline        = putByte bh 3\n\n    get bh = do h <- getByte bh\n                case h of\n                  0 -> return NoUserInline\n                  1 -> return Inline\n                  2 -> return Inlinable\n                  _ -> return NoInline\n\ninstance Binary RecFlag where\n    put_ bh Recursive = do\n            putByte bh 0\n    put_ bh NonRecursive = do\n            putByte bh 1\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return Recursive\n              _ -> do return NonRecursive\n\ninstance Binary OverlapMode where\n    put_ bh (NoOverlap    s) = putByte bh 0 >> put_ bh s\n    put_ bh (Overlaps     s) = putByte bh 1 >> put_ bh s\n    put_ bh (Incoherent   s) = putByte bh 2 >> put_ bh s\n    put_ bh (Overlapping  s) = putByte bh 3 >> put_ bh s\n    put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s\n    get bh = do\n        h <- getByte bh\n        case h of\n            0 -> (get bh) >>= \\s -> return $ NoOverlap s\n            1 -> (get bh) >>= \\s -> return $ Overlaps s\n            2 -> (get bh) >>= \\s -> return $ Incoherent s\n            3 -> (get bh) >>= \\s -> return $ Overlapping s\n            4 -> (get bh) >>= \\s -> return $ Overlappable s\n            _ -> panic (\"get OverlapMode\" ++ show h)\n\n\ninstance Binary OverlapFlag where\n    put_ bh flag = do put_ bh (overlapMode flag)\n                      put_ bh (isSafeOverlap flag)\n    get bh = do\n        h <- get bh\n        b <- get bh\n        return OverlapFlag { overlapMode = h, isSafeOverlap = b }\n\ninstance Binary FixityDirection where\n    put_ bh InfixL = do\n            putByte bh 0\n    put_ bh InfixR = do\n            putByte bh 1\n    put_ bh InfixN = do\n            putByte bh 2\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do return InfixL\n              1 -> do return InfixR\n              _ -> do return InfixN\n\ninstance Binary Fixity where\n    put_ bh (Fixity src aa ab) = do\n            put_ bh src\n            put_ bh aa\n            put_ bh ab\n    get bh = do\n          src <- get bh\n          aa <- get bh\n          ab <- get bh\n          return (Fixity src aa ab)\n\ninstance Binary WarningTxt where\n    put_ bh (WarningTxt s w) = do\n            putByte bh 0\n            put_ bh s\n            put_ bh w\n    put_ bh (DeprecatedTxt s d) = do\n            putByte bh 1\n            put_ bh s\n            put_ bh d\n\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do s <- get bh\n                      w <- get bh\n                      return (WarningTxt s w)\n              _ -> do s <- get bh\n                      d <- get bh\n                      return (DeprecatedTxt s d)\n\ninstance Binary StringLiteral where\n  put_ bh (StringLiteral st fs) = do\n            put_ bh st\n            put_ bh fs\n  get bh = do\n            st <- get bh\n            fs <- get bh\n            return (StringLiteral st fs)\n\ninstance Binary a => Binary (Located a) where\n    put_ bh (L l x) = do\n            put_ bh l\n            put_ bh x\n\n    get bh = do\n            l <- get bh\n            x <- get bh\n            return (L l x)\n\ninstance Binary RealSrcSpan where\n  put_ bh ss = do\n            put_ bh (srcSpanFile ss)\n            put_ bh (srcSpanStartLine ss)\n            put_ bh (srcSpanStartCol ss)\n            put_ bh (srcSpanEndLine ss)\n            put_ bh (srcSpanEndCol ss)\n\n  get bh = do\n            f <- get bh\n            sl <- get bh\n            sc <- get bh\n            el <- get bh\n            ec <- get bh\n            return (mkRealSrcSpan (mkRealSrcLoc f sl sc)\n                                  (mkRealSrcLoc f el ec))\n\ninstance Binary SrcSpan where\n  put_ bh (RealSrcSpan ss) = do\n          putByte bh 0\n          put_ bh ss\n\n  put_ bh (UnhelpfulSpan s) = do\n          putByte bh 1\n          put_ bh s\n\n  get bh = do\n          h <- getByte bh\n          case h of\n            0 -> do ss <- get bh\n                    return (RealSrcSpan ss)\n            _ -> do s <- get bh\n                    return (UnhelpfulSpan s)\n\ninstance Binary Serialized where\n    put_ bh (Serialized the_type bytes) = do\n        put_ bh the_type\n        put_ bh bytes\n    get bh = do\n        the_type <- get bh\n        bytes <- get bh\n        return (Serialized the_type bytes)\n\ninstance Binary SourceText where\n  put_ bh NoSourceText = putByte bh 0\n  put_ bh (SourceText s) = do\n        putByte bh 1\n        put_ bh s\n\n  get bh = do\n    h <- getByte bh\n    case h of\n      0 -> return NoSourceText\n      1 -> do\n        s <- get bh\n        return (SourceText s)\n      _ -> panic $ \"Binary SourceText:\" ++ show h\n", "num_lines": 1216}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,\n             DeriveTraversable #-}\n\n--------------------------------------------------------------------------------\n-- | Boolean formulas without quantifiers and without negation.\n-- Such a formula consists of variables, conjunctions (and), and disjunctions (or).\n--\n-- This module is used to represent minimal complete definitions for classes.\n--\nmodule BooleanFormula (\n        BooleanFormula(..), LBooleanFormula,\n        mkFalse, mkTrue, mkAnd, mkOr, mkVar,\n        isFalse, isTrue,\n        eval, simplify, isUnsatisfied,\n        implies, impliesAtom,\n        pprBooleanFormula, pprBooleanFormulaNice\n  ) where\n\nimport GhcPrelude\n\nimport Data.List ( nub, intersperse )\nimport Data.Data\n\nimport MonadUtils\nimport Outputable\nimport Binary\nimport SrcLoc\nimport Unique\nimport UniqSet\n\n----------------------------------------------------------------------\n-- Boolean formula type and smart constructors\n----------------------------------------------------------------------\n\ntype LBooleanFormula a = Located (BooleanFormula a)\n\ndata BooleanFormula a = Var a | And [LBooleanFormula a] | Or [LBooleanFormula a]\n                      | Parens (LBooleanFormula a)\n  deriving (Eq, Data, Functor, Foldable, Traversable)\n\nmkVar :: a -> BooleanFormula a\nmkVar = Var\n\nmkFalse, mkTrue :: BooleanFormula a\nmkFalse = Or []\nmkTrue = And []\n\n-- Convert a Bool to a BooleanFormula\nmkBool :: Bool -> BooleanFormula a\nmkBool False = mkFalse\nmkBool True  = mkTrue\n\n-- Make a conjunction, and try to simplify\nmkAnd :: Eq a => [LBooleanFormula a] -> BooleanFormula a\nmkAnd = maybe mkFalse (mkAnd' . nub) . concatMapM fromAnd\n  where\n  -- See Note [Simplification of BooleanFormulas]\n  fromAnd :: LBooleanFormula a -> Maybe [LBooleanFormula a]\n  fromAnd (L _ (And xs)) = Just xs\n     -- assume that xs are already simplified\n     -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs\n  fromAnd (L _ (Or [])) = Nothing\n     -- in case of False we bail out, And [..,mkFalse,..] == mkFalse\n  fromAnd x = Just [x]\n  mkAnd' [x] = unLoc x\n  mkAnd' xs = And xs\n\nmkOr :: Eq a => [LBooleanFormula a] -> BooleanFormula a\nmkOr = maybe mkTrue (mkOr' . nub) . concatMapM fromOr\n  where\n  -- See Note [Simplification of BooleanFormulas]\n  fromOr (L _ (Or xs)) = Just xs\n  fromOr (L _ (And [])) = Nothing\n  fromOr x = Just [x]\n  mkOr' [x] = unLoc x\n  mkOr' xs = Or xs\n\n\n{-\nNote [Simplification of BooleanFormulas]\n~~~~~~~~~~~~~~~~~~~~~~\nThe smart constructors (`mkAnd` and `mkOr`) do some attempt to simplify expressions. In particular,\n 1. Collapsing nested ands and ors, so\n     `(mkAnd [x, And [y,z]]`\n    is represented as\n     `And [x,y,z]`\n    Implemented by `fromAnd`/`fromOr`\n 2. Collapsing trivial ands and ors, so\n     `mkAnd [x]` becomes just `x`.\n    Implemented by mkAnd' / mkOr'\n 3. Conjunction with false, disjunction with true is simplified, i.e.\n     `mkAnd [mkFalse,x]` becomes `mkFalse`.\n 4. Common subexpression elimination:\n     `mkAnd [x,x,y]` is reduced to just `mkAnd [x,y]`.\n\nThis simplification is not exhaustive, in the sense that it will not produce\nthe smallest possible equivalent expression. For example,\n`Or [And [x,y], And [x]]` could be simplified to `And [x]`, but it currently\nis not. A general simplifier would need to use something like BDDs.\n\nThe reason behind the (crude) simplifier is to make for more user friendly\nerror messages. E.g. for the code\n  > class Foo a where\n  >     {-# MINIMAL bar, (foo, baq | foo, quux) #-}\n  > instance Foo Int where\n  >     bar = ...\n  >     baz = ...\n  >     quux = ...\nWe don't show a ridiculous error message like\n    Implement () and (either (`foo' and ()) or (`foo' and ()))\n-}\n\n----------------------------------------------------------------------\n-- Evaluation and simplification\n----------------------------------------------------------------------\n\nisFalse :: BooleanFormula a -> Bool\nisFalse (Or []) = True\nisFalse _ = False\n\nisTrue :: BooleanFormula a -> Bool\nisTrue (And []) = True\nisTrue _ = False\n\neval :: (a -> Bool) -> BooleanFormula a -> Bool\neval f (Var x)  = f x\neval f (And xs) = all (eval f . unLoc) xs\neval f (Or xs)  = any (eval f . unLoc) xs\neval f (Parens x) = eval f (unLoc x)\n\n-- Simplify a boolean formula.\n-- The argument function should give the truth of the atoms, or Nothing if undecided.\nsimplify :: Eq a => (a -> Maybe Bool) -> BooleanFormula a -> BooleanFormula a\nsimplify f (Var a) = case f a of\n  Nothing -> Var a\n  Just b  -> mkBool b\nsimplify f (And xs) = mkAnd (map (\\(L l x) -> L l (simplify f x)) xs)\nsimplify f (Or xs) = mkOr (map (\\(L l x) -> L l (simplify f x)) xs)\nsimplify f (Parens x) = simplify f (unLoc x)\n\n-- Test if a boolean formula is satisfied when the given values are assigned to the atoms\n-- if it is, returns Nothing\n-- if it is not, return (Just remainder)\nisUnsatisfied :: Eq a => (a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a)\nisUnsatisfied f bf\n    | isTrue bf' = Nothing\n    | otherwise  = Just bf'\n  where\n  f' x = if f x then Just True else Nothing\n  bf' = simplify f' bf\n\n-- prop_simplify:\n--   eval f x == True   <==>  isTrue  (simplify (Just . f) x)\n--   eval f x == False  <==>  isFalse (simplify (Just . f) x)\n\n-- If the boolean formula holds, does that mean that the given atom is always true?\nimpliesAtom :: Eq a => BooleanFormula a -> a -> Bool\nVar x  `impliesAtom` y = x == y\nAnd xs `impliesAtom` y = any (\\x -> (unLoc x) `impliesAtom` y) xs\n           -- we have all of xs, so one of them implying y is enough\nOr  xs `impliesAtom` y = all (\\x -> (unLoc x) `impliesAtom` y) xs\nParens x `impliesAtom` y = (unLoc x) `impliesAtom` y\n\nimplies :: Uniquable a => BooleanFormula a -> BooleanFormula a -> Bool\nimplies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2])\n  where\n    go :: Uniquable a => Clause a -> Clause a -> Bool\n    go l@Clause{ clauseExprs = hyp:hyps } r =\n        case hyp of\n            Var x | memberClauseAtoms x r -> True\n                  | otherwise -> go (extendClauseAtoms l x) { clauseExprs = hyps } r\n            Parens hyp' -> go l { clauseExprs = unLoc hyp':hyps }     r\n            And hyps'  -> go l { clauseExprs = map unLoc hyps' ++ hyps } r\n            Or hyps'   -> all (\\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps'\n    go l r@Clause{ clauseExprs = con:cons } =\n        case con of\n            Var x | memberClauseAtoms x l -> True\n                  | otherwise -> go l (extendClauseAtoms r x) { clauseExprs = cons }\n            Parens con' -> go l r { clauseExprs = unLoc con':cons }\n            And cons'   -> all (\\con' -> go l r { clauseExprs = unLoc con':cons }) cons'\n            Or cons'    -> go l r { clauseExprs = map unLoc cons' ++ cons }\n    go _ _ = False\n\n-- A small sequent calculus proof engine.\ndata Clause a = Clause {\n        clauseAtoms :: UniqSet a,\n        clauseExprs :: [BooleanFormula a]\n    }\nextendClauseAtoms :: Uniquable a => Clause a -> a -> Clause a\nextendClauseAtoms c x = c { clauseAtoms = addOneToUniqSet (clauseAtoms c) x }\n\nmemberClauseAtoms :: Uniquable a => a -> Clause a -> Bool\nmemberClauseAtoms x c = x `elementOfUniqSet` clauseAtoms c\n\n----------------------------------------------------------------------\n-- Pretty printing\n----------------------------------------------------------------------\n\n-- Pretty print a BooleanFormula,\n-- using the arguments as pretty printers for Var, And and Or respectively\npprBooleanFormula' :: (Rational -> a -> SDoc)\n                   -> (Rational -> [SDoc] -> SDoc)\n                   -> (Rational -> [SDoc] -> SDoc)\n                   -> Rational -> BooleanFormula a -> SDoc\npprBooleanFormula' pprVar pprAnd pprOr = go\n  where\n  go p (Var x)  = pprVar p x\n  go p (And []) = cparen (p > 0) $ empty\n  go p (And xs) = pprAnd p (map (go 3 . unLoc) xs)\n  go _ (Or  []) = keyword $ text \"FALSE\"\n  go p (Or  xs) = pprOr p (map (go 2 . unLoc) xs)\n  go p (Parens x) = go p (unLoc x)\n\n-- Pretty print in source syntax, \"a | b | c,d,e\"\npprBooleanFormula :: (Rational -> a -> SDoc) -> Rational -> BooleanFormula a -> SDoc\npprBooleanFormula pprVar = pprBooleanFormula' pprVar pprAnd pprOr\n  where\n  pprAnd p = cparen (p > 3) . fsep . punctuate comma\n  pprOr  p = cparen (p > 2) . fsep . intersperse vbar\n\n-- Pretty print human in readable format, \"either `a' or `b' or (`c', `d' and `e')\"?\npprBooleanFormulaNice :: Outputable a => BooleanFormula a -> SDoc\npprBooleanFormulaNice = pprBooleanFormula' pprVar pprAnd pprOr 0\n  where\n  pprVar _ = quotes . ppr\n  pprAnd p = cparen (p > 1) . pprAnd'\n  pprAnd' [] = empty\n  pprAnd' [x,y] = x <+> text \"and\" <+> y\n  pprAnd' xs@(_:_) = fsep (punctuate comma (init xs)) <> text \", and\" <+> last xs\n  pprOr p xs = cparen (p > 1) $ text \"either\" <+> sep (intersperse (text \"or\") xs)\n\ninstance (OutputableBndr a) => Outputable (BooleanFormula a) where\n  ppr = pprBooleanFormulaNormal\n\npprBooleanFormulaNormal :: (OutputableBndr a)\n                        => BooleanFormula a -> SDoc\npprBooleanFormulaNormal = go\n  where\n    go (Var x)    = pprPrefixOcc x\n    go (And xs)   = fsep $ punctuate comma (map (go . unLoc) xs)\n    go (Or [])    = keyword $ text \"FALSE\"\n    go (Or xs)    = fsep $ intersperse vbar (map (go . unLoc) xs)\n    go (Parens x) = parens (go $ unLoc x)\n\n\n----------------------------------------------------------------------\n-- Binary\n----------------------------------------------------------------------\n\ninstance Binary a => Binary (BooleanFormula a) where\n  put_ bh (Var x)    = putByte bh 0 >> put_ bh x\n  put_ bh (And xs)   = putByte bh 1 >> put_ bh xs\n  put_ bh (Or  xs)   = putByte bh 2 >> put_ bh xs\n  put_ bh (Parens x) = putByte bh 3 >> put_ bh x\n\n  get bh = do\n    h <- getByte bh\n    case h of\n      0 -> Var    <$> get bh\n      1 -> And    <$> get bh\n      2 -> Or     <$> get bh\n      _ -> Parens <$> get bh\n", "num_lines": 263}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\n-----------------------------------------------------------------------------\n--\n-- Fast write-buffered Handles\n--\n-- (c) The University of Glasgow 2005-2006\n--\n-- This is a simple abstraction over Handles that offers very fast write\n-- buffering, but without the thread safety that Handles provide.  It's used\n-- to save time in Pretty.printDoc.\n--\n-----------------------------------------------------------------------------\n\nmodule BufWrite (\n        BufHandle(..),\n        newBufHandle,\n        bPutChar,\n        bPutStr,\n        bPutFS,\n        bPutFZS,\n        bPutPtrString,\n        bPutReplicate,\n        bFlush,\n  ) where\n\nimport GhcPrelude\n\nimport FastString\nimport FastMutInt\n\nimport Control.Monad    ( when )\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString.Unsafe as BS\nimport Data.Char        ( ord )\nimport Foreign\nimport Foreign.C.String\nimport System.IO\n\n-- -----------------------------------------------------------------------------\n\ndata BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8)\n                           {-#UNPACK#-}!FastMutInt\n                           Handle\n\nnewBufHandle :: Handle -> IO BufHandle\nnewBufHandle hdl = do\n  ptr <- mallocBytes buf_size\n  r <- newFastMutInt\n  writeFastMutInt r 0\n  return (BufHandle ptr r hdl)\n\nbuf_size :: Int\nbuf_size = 8192\n\nbPutChar :: BufHandle -> Char -> IO ()\nbPutChar b@(BufHandle buf r hdl) !c = do\n  i <- readFastMutInt r\n  if (i >= buf_size)\n        then do hPutBuf hdl buf buf_size\n                writeFastMutInt r 0\n                bPutChar b c\n        else do pokeElemOff buf i (fromIntegral (ord c) :: Word8)\n                writeFastMutInt r (i+1)\n\nbPutStr :: BufHandle -> String -> IO ()\nbPutStr (BufHandle buf r hdl) !str = do\n  i <- readFastMutInt r\n  loop str i\n  where loop \"\" !i = do writeFastMutInt r i; return ()\n        loop (c:cs) !i\n           | i >= buf_size = do\n                hPutBuf hdl buf buf_size\n                loop (c:cs) 0\n           | otherwise = do\n                pokeElemOff buf i (fromIntegral (ord c))\n                loop cs (i+1)\n\nbPutFS :: BufHandle -> FastString -> IO ()\nbPutFS b fs = bPutBS b $ bytesFS fs\n\nbPutFZS :: BufHandle -> FastZString -> IO ()\nbPutFZS b fs = bPutBS b $ fastZStringToByteString fs\n\nbPutBS :: BufHandle -> ByteString -> IO ()\nbPutBS b bs = BS.unsafeUseAsCStringLen bs $ bPutCStringLen b\n\nbPutCStringLen :: BufHandle -> CStringLen -> IO ()\nbPutCStringLen b@(BufHandle buf r hdl) cstr@(ptr, len) = do\n  i <- readFastMutInt r\n  if (i + len) >= buf_size\n        then do hPutBuf hdl buf i\n                writeFastMutInt r 0\n                if (len >= buf_size)\n                    then hPutBuf hdl ptr len\n                    else bPutCStringLen b cstr\n        else do\n                copyBytes (buf `plusPtr` i) ptr len\n                writeFastMutInt r (i + len)\n\nbPutPtrString :: BufHandle -> PtrString -> IO ()\nbPutPtrString b@(BufHandle buf r hdl) l@(PtrString a len) = l `seq` do\n  i <- readFastMutInt r\n  if (i+len) >= buf_size\n        then do hPutBuf hdl buf i\n                writeFastMutInt r 0\n                if (len >= buf_size)\n                    then hPutBuf hdl a len\n                    else bPutPtrString b l\n        else do\n                copyBytes (buf `plusPtr` i) a len\n                writeFastMutInt r (i+len)\n\n-- | Replicate an 8-bit character\nbPutReplicate :: BufHandle -> Int -> Char -> IO ()\nbPutReplicate (BufHandle buf r hdl) len c = do\n  i <- readFastMutInt r\n  let oc = fromIntegral (ord c)\n  if (i+len) < buf_size\n    then do\n      fillBytes (buf `plusPtr` i) oc len\n      writeFastMutInt r (i+len)\n    else do\n      -- flush the current buffer\n      when (i /= 0) $ hPutBuf hdl buf i\n      if (len < buf_size)\n        then do\n          fillBytes buf oc len\n          writeFastMutInt r len\n        else do\n          -- fill a full buffer\n          fillBytes buf oc buf_size\n          -- flush it as many times as necessary\n          let go n | n >= buf_size = do\n                                       hPutBuf hdl buf buf_size\n                                       go (n-buf_size)\n                   | otherwise     = writeFastMutInt r n\n          go len\n\nbFlush :: BufHandle -> IO ()\nbFlush (BufHandle buf r hdl) = do\n  i <- readFastMutInt r\n  when (i > 0) $ hPutBuf hdl buf i\n  free buf\n  return ()\n", "num_lines": 146}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n\n{-# LANGUAGE CPP, ScopedTypeVariables, ViewPatterns #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule Digraph(\n        Graph, graphFromEdgedVerticesOrd, graphFromEdgedVerticesUniq,\n\n        SCC(..), Node(..), flattenSCC, flattenSCCs,\n        stronglyConnCompG,\n        topologicalSortG,\n        verticesG, edgesG, hasVertexG,\n        reachableG, reachablesG, transposeG,\n        emptyG,\n\n        findCycle,\n\n        -- For backwards compatibility with the simpler version of Digraph\n        stronglyConnCompFromEdgedVerticesOrd,\n        stronglyConnCompFromEdgedVerticesOrdR,\n        stronglyConnCompFromEdgedVerticesUniq,\n        stronglyConnCompFromEdgedVerticesUniqR,\n\n        -- Simple way to classify edges\n        EdgeType(..), classifyEdges\n    ) where\n\n#include \"HsVersions.h\"\n\n------------------------------------------------------------------------------\n-- A version of the graph algorithms described in:\n--\n-- ``Lazy Depth-First Search and Linear IntGraph Algorithms in Haskell''\n--   by David King and John Launchbury\n--\n-- Also included is some additional code for printing tree structures ...\n--\n-- If you ever find yourself in need of algorithms for classifying edges,\n-- or finding connected/biconnected components, consult the history; Sigbjorn\n-- Finne contributed some implementations in 1997, although we've since\n-- removed them since they were not used anywhere in GHC.\n------------------------------------------------------------------------------\n\n\nimport GhcPrelude\n\nimport Util        ( minWith, count )\nimport Outputable\nimport Maybes      ( expectJust )\n\n-- std interfaces\nimport Data.Maybe\nimport Data.Array\nimport Data.List hiding (transpose)\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\n\nimport qualified Data.Graph as G\nimport Data.Graph hiding (Graph, Edge, transposeG, reachable)\nimport Data.Tree\nimport Unique\nimport UniqFM\n\n{-\n************************************************************************\n*                                                                      *\n*      Graphs and Graph Construction\n*                                                                      *\n************************************************************************\n\nNote [Nodes, keys, vertices]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n * A 'node' is a big blob of client-stuff\n\n * Each 'node' has a unique (client) 'key', but the latter\n        is in Ord and has fast comparison\n\n * Digraph then maps each 'key' to a Vertex (Int) which is\n        arranged densely in 0.n\n-}\n\ndata Graph node = Graph {\n    gr_int_graph      :: IntGraph,\n    gr_vertex_to_node :: Vertex -> node,\n    gr_node_to_vertex :: node -> Maybe Vertex\n  }\n\ndata Edge node = Edge node node\n\n{-| Representation for nodes of the Graph.\n\n * The @payload@ is user data, just carried around in this module\n\n * The @key@ is the node identifier.\n   Key has an Ord instance for performance reasons.\n\n * The @[key]@ are the dependencies of the node;\n   it's ok to have extra keys in the dependencies that\n   are not the key of any Node in the graph\n-}\ndata Node key payload = DigraphNode {\n      node_payload :: payload, -- ^ User data\n      node_key :: key, -- ^ User defined node id\n      node_dependencies :: [key] -- ^ Dependencies/successors of the node\n  }\n\n\ninstance (Outputable a, Outputable b) => Outputable (Node  a b) where\n  ppr (DigraphNode a b c) = ppr (a, b, c)\n\nemptyGraph :: Graph a\nemptyGraph = Graph (array (1, 0) []) (error \"emptyGraph\") (const Nothing)\n\n-- See Note [Deterministic SCC]\ngraphFromEdgedVertices\n        :: ReduceFn key payload\n        -> [Node key payload]           -- The graph; its ok for the\n                                        -- out-list to contain keys which aren't\n                                        -- a vertex key, they are ignored\n        -> Graph (Node key payload)\ngraphFromEdgedVertices _reduceFn []            = emptyGraph\ngraphFromEdgedVertices reduceFn edged_vertices =\n  Graph graph vertex_fn (key_vertex . key_extractor)\n  where key_extractor = node_key\n        (bounds, vertex_fn, key_vertex, numbered_nodes) =\n          reduceFn edged_vertices key_extractor\n        graph = array bounds [ (v, sort $ mapMaybe key_vertex ks)\n                             | (v, (node_dependencies -> ks)) <- numbered_nodes]\n                -- We normalize outgoing edges by sorting on node order, so\n                -- that the result doesn't depend on the order of the edges\n\n-- See Note [Deterministic SCC]\n-- See Note [reduceNodesIntoVertices implementations]\ngraphFromEdgedVerticesOrd\n        :: Ord key\n        => [Node key payload]           -- The graph; its ok for the\n                                        -- out-list to contain keys which aren't\n                                        -- a vertex key, they are ignored\n        -> Graph (Node key payload)\ngraphFromEdgedVerticesOrd = graphFromEdgedVertices reduceNodesIntoVerticesOrd\n\n-- See Note [Deterministic SCC]\n-- See Note [reduceNodesIntoVertices implementations]\ngraphFromEdgedVerticesUniq\n        :: Uniquable key\n        => [Node key payload]           -- The graph; its ok for the\n                                        -- out-list to contain keys which aren't\n                                        -- a vertex key, they are ignored\n        -> Graph (Node key payload)\ngraphFromEdgedVerticesUniq = graphFromEdgedVertices reduceNodesIntoVerticesUniq\n\ntype ReduceFn key payload =\n  [Node key payload] -> (Node key payload -> key) ->\n    (Bounds, Vertex -> Node key payload\n    , key -> Maybe Vertex, [(Vertex, Node key payload)])\n\n{-\nNote [reduceNodesIntoVertices implementations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nreduceNodesIntoVertices is parameterized by the container type.\nThis is to accomodate key types that don't have an Ord instance\nand hence preclude the use of Data.Map. An example of such type\nwould be Unique, there's no way to implement Ord Unique\ndeterministically.\n\nFor such types, there's a version with a Uniquable constraint.\nThis leaves us with two versions of every function that depends on\nreduceNodesIntoVertices, one with Ord constraint and the other with\nUniquable constraint.\nFor example: graphFromEdgedVerticesOrd and graphFromEdgedVerticesUniq.\n\nThe Uniq version should be a tiny bit more efficient since it uses\nData.IntMap internally.\n-}\nreduceNodesIntoVertices\n  :: ([(key, Vertex)] -> m)\n  -> (key -> m -> Maybe Vertex)\n  -> ReduceFn key payload\nreduceNodesIntoVertices fromList lookup nodes key_extractor =\n  (bounds, (!) vertex_map, key_vertex, numbered_nodes)\n  where\n    max_v           = length nodes - 1\n    bounds          = (0, max_v) :: (Vertex, Vertex)\n\n    -- Keep the order intact to make the result depend on input order\n    -- instead of key order\n    numbered_nodes  = zip [0..] nodes\n    vertex_map      = array bounds numbered_nodes\n\n    key_map = fromList\n      [ (key_extractor node, v) | (v, node) <- numbered_nodes ]\n    key_vertex k = lookup k key_map\n\n-- See Note [reduceNodesIntoVertices implementations]\nreduceNodesIntoVerticesOrd :: Ord key => ReduceFn key payload\nreduceNodesIntoVerticesOrd = reduceNodesIntoVertices Map.fromList Map.lookup\n\n-- See Note [reduceNodesIntoVertices implementations]\nreduceNodesIntoVerticesUniq :: Uniquable key => ReduceFn key payload\nreduceNodesIntoVerticesUniq = reduceNodesIntoVertices listToUFM (flip lookupUFM)\n\n{-\n************************************************************************\n*                                                                      *\n*      SCC\n*                                                                      *\n************************************************************************\n-}\n\ntype WorkItem key payload\n  = (Node key payload,  -- Tip of the path\n     [payload])         -- Rest of the path;\n                        --  [a,b,c] means c depends on b, b depends on a\n\n-- | Find a reasonably short cycle a->b->c->a, in a strongly\n-- connected component.  The input nodes are presumed to be\n-- a SCC, so you can start anywhere.\nfindCycle :: forall payload key. Ord key\n          => [Node key payload]     -- The nodes.  The dependencies can\n                                    -- contain extra keys, which are ignored\n          -> Maybe [payload]        -- A cycle, starting with node\n                                    -- so each depends on the next\nfindCycle graph\n  = go Set.empty (new_work root_deps []) []\n  where\n    env :: Map.Map key (Node key payload)\n    env = Map.fromList [ (node_key node, node) | node <- graph ]\n\n    -- Find the node with fewest dependencies among the SCC modules\n    -- This is just a heuristic to find some plausible root module\n    root :: Node key payload\n    root = fst (minWith snd [ (node, count (`Map.member` env)\n                                           (node_dependencies node))\n                            | node <- graph ])\n    DigraphNode root_payload root_key root_deps = root\n\n\n    -- 'go' implements Dijkstra's algorithm, more or less\n    go :: Set.Set key   -- Visited\n       -> [WorkItem key payload]        -- Work list, items length n\n       -> [WorkItem key payload]        -- Work list, items length n+1\n       -> Maybe [payload]               -- Returned cycle\n       -- Invariant: in a call (go visited ps qs),\n       --            visited = union (map tail (ps ++ qs))\n\n    go _       [] [] = Nothing  -- No cycles\n    go visited [] qs = go visited qs []\n    go visited (((DigraphNode payload key deps), path) : ps) qs\n       | key == root_key           = Just (root_payload : reverse path)\n       | key `Set.member` visited  = go visited ps qs\n       | key `Map.notMember` env   = go visited ps qs\n       | otherwise                 = go (Set.insert key visited)\n                                        ps (new_qs ++ qs)\n       where\n         new_qs = new_work deps (payload : path)\n\n    new_work :: [key] -> [payload] -> [WorkItem key payload]\n    new_work deps path = [ (n, path) | Just n <- map (`Map.lookup` env) deps ]\n\n{-\n************************************************************************\n*                                                                      *\n*      Strongly Connected Component wrappers for Graph\n*                                                                      *\n************************************************************************\n\nNote: the components are returned topologically sorted: later components\ndepend on earlier ones, but not vice versa i.e. later components only have\nedges going from them to earlier ones.\n-}\n\n{-\nNote [Deterministic SCC]\n~~~~~~~~~~~~~~~~~~~~~~~~\nstronglyConnCompFromEdgedVerticesUniq,\nstronglyConnCompFromEdgedVerticesUniqR,\nstronglyConnCompFromEdgedVerticesOrd and\nstronglyConnCompFromEdgedVerticesOrdR\nprovide a following guarantee:\nGiven a deterministically ordered list of nodes it returns a deterministically\nordered list of strongly connected components, where the list of vertices\nin an SCC is also deterministically ordered.\nNote that the order of edges doesn't need to be deterministic for this to work.\nWe use the order of nodes to normalize the order of edges.\n-}\n\nstronglyConnCompG :: Graph node -> [SCC node]\nstronglyConnCompG graph = decodeSccs graph forest\n  where forest = {-# SCC \"Digraph.scc\" #-} scc (gr_int_graph graph)\n\ndecodeSccs :: Graph node -> Forest Vertex -> [SCC node]\ndecodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest\n  = map decode forest\n  where\n    decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v]\n                       | otherwise         = AcyclicSCC (vertex_fn v)\n    decode other = CyclicSCC (dec other [])\n      where dec (Node v ts) vs = vertex_fn v : foldr dec vs ts\n    mentions_itself v = v `elem` (graph ! v)\n\n\n-- The following two versions are provided for backwards compatibility:\n-- See Note [Deterministic SCC]\n-- See Note [reduceNodesIntoVertices implementations]\nstronglyConnCompFromEdgedVerticesOrd\n        :: Ord key\n        => [Node key payload]\n        -> [SCC payload]\nstronglyConnCompFromEdgedVerticesOrd\n  = map (fmap node_payload) . stronglyConnCompFromEdgedVerticesOrdR\n\n-- The following two versions are provided for backwards compatibility:\n-- See Note [Deterministic SCC]\n-- See Note [reduceNodesIntoVertices implementations]\nstronglyConnCompFromEdgedVerticesUniq\n        :: Uniquable key\n        => [Node key payload]\n        -> [SCC payload]\nstronglyConnCompFromEdgedVerticesUniq\n  = map (fmap node_payload) . stronglyConnCompFromEdgedVerticesUniqR\n\n-- The \"R\" interface is used when you expect to apply SCC to\n-- (some of) the result of SCC, so you don't want to lose the dependency info\n-- See Note [Deterministic SCC]\n-- See Note [reduceNodesIntoVertices implementations]\nstronglyConnCompFromEdgedVerticesOrdR\n        :: Ord key\n        => [Node key payload]\n        -> [SCC (Node key payload)]\nstronglyConnCompFromEdgedVerticesOrdR =\n  stronglyConnCompG . graphFromEdgedVertices reduceNodesIntoVerticesOrd\n\n-- The \"R\" interface is used when you expect to apply SCC to\n-- (some of) the result of SCC, so you don't want to lose the dependency info\n-- See Note [Deterministic SCC]\n-- See Note [reduceNodesIntoVertices implementations]\nstronglyConnCompFromEdgedVerticesUniqR\n        :: Uniquable key\n        => [Node key payload]\n        -> [SCC (Node key payload)]\nstronglyConnCompFromEdgedVerticesUniqR =\n  stronglyConnCompG . graphFromEdgedVertices reduceNodesIntoVerticesUniq\n\n{-\n************************************************************************\n*                                                                      *\n*      Misc wrappers for Graph\n*                                                                      *\n************************************************************************\n-}\n\ntopologicalSortG :: Graph node -> [node]\ntopologicalSortG graph = map (gr_vertex_to_node graph) result\n  where result = {-# SCC \"Digraph.topSort\" #-} topSort (gr_int_graph graph)\n\nreachableG :: Graph node -> node -> [node]\nreachableG graph from = map (gr_vertex_to_node graph) result\n  where from_vertex = expectJust \"reachableG\" (gr_node_to_vertex graph from)\n        result = {-# SCC \"Digraph.reachable\" #-} reachable (gr_int_graph graph) [from_vertex]\n\n-- | Given a list of roots return all reachable nodes.\nreachablesG :: Graph node -> [node] -> [node]\nreachablesG graph froms = map (gr_vertex_to_node graph) result\n  where result = {-# SCC \"Digraph.reachable\" #-}\n                 reachable (gr_int_graph graph) vs\n        vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ]\n\nhasVertexG :: Graph node -> node -> Bool\nhasVertexG graph node = isJust $ gr_node_to_vertex graph node\n\nverticesG :: Graph node -> [node]\nverticesG graph = map (gr_vertex_to_node graph) $ vertices (gr_int_graph graph)\n\nedgesG :: Graph node -> [Edge node]\nedgesG graph = map (\\(v1, v2) -> Edge (v2n v1) (v2n v2)) $ edges (gr_int_graph graph)\n  where v2n = gr_vertex_to_node graph\n\ntransposeG :: Graph node -> Graph node\ntransposeG graph = Graph (G.transposeG (gr_int_graph graph))\n                         (gr_vertex_to_node graph)\n                         (gr_node_to_vertex graph)\n\nemptyG :: Graph node -> Bool\nemptyG g = graphEmpty (gr_int_graph g)\n\n{-\n************************************************************************\n*                                                                      *\n*      Showing Graphs\n*                                                                      *\n************************************************************************\n-}\n\ninstance Outputable node => Outputable (Graph node) where\n    ppr graph = vcat [\n                  hang (text \"Vertices:\") 2 (vcat (map ppr $ verticesG graph)),\n                  hang (text \"Edges:\") 2 (vcat (map ppr $ edgesG graph))\n                ]\n\ninstance Outputable node => Outputable (Edge node) where\n    ppr (Edge from to) = ppr from <+> text \"->\" <+> ppr to\n\ngraphEmpty :: G.Graph -> Bool\ngraphEmpty g = lo > hi\n  where (lo, hi) = bounds g\n\n{-\n************************************************************************\n*                                                                      *\n*      IntGraphs\n*                                                                      *\n************************************************************************\n-}\n\ntype IntGraph = G.Graph\n\n{-\n------------------------------------------------------------\n-- Depth first search numbering\n------------------------------------------------------------\n-}\n\n-- Data.Tree has flatten for Tree, but nothing for Forest\npreorderF           :: Forest a -> [a]\npreorderF ts         = concat (map flatten ts)\n\n{-\n------------------------------------------------------------\n-- Finding reachable vertices\n------------------------------------------------------------\n-}\n\n-- This generalizes reachable which was found in Data.Graph\nreachable    :: IntGraph -> [Vertex] -> [Vertex]\nreachable g vs = preorderF (dfs g vs)\n\n{-\n************************************************************************\n*                                                                      *\n*                         Classify Edge Types\n*                                                                      *\n************************************************************************\n-}\n\n-- Remark: While we could generalize this algorithm this comes at a runtime\n-- cost and with no advantages. If you find yourself using this with graphs\n-- not easily represented using Int nodes please consider rewriting this\n-- using the more general Graph type.\n\n-- | Edge direction based on DFS Classification\ndata EdgeType\n  = Forward\n  | Cross\n  | Backward -- ^ Loop back towards the root node.\n             -- Eg backjumps in loops\n  | SelfLoop -- ^ v -> v\n   deriving (Eq,Ord)\n\ninstance Outputable EdgeType where\n  ppr Forward = text \"Forward\"\n  ppr Cross = text \"Cross\"\n  ppr Backward = text \"Backward\"\n  ppr SelfLoop = text \"SelfLoop\"\n\nnewtype Time = Time Int deriving (Eq,Ord,Num,Outputable)\n\n--Allow for specialzation\n{-# INLINEABLE classifyEdges #-}\n\n-- | Given a start vertex, a way to get successors from a node\n-- and a list of (directed) edges classify the types of edges.\nclassifyEdges :: forall key. Uniquable key => key -> (key -> [key])\n              -> [(key,key)] -> [((key, key), EdgeType)]\nclassifyEdges root getSucc edges =\n    --let uqe (from,to) = (getUnique from, getUnique to)\n    --in pprTrace \"Edges:\" (ppr $ map uqe edges) $\n    zip edges $ map classify edges\n  where\n    (_time, starts, ends) = addTimes (0,emptyUFM,emptyUFM) root\n    classify :: (key,key) -> EdgeType\n    classify (from,to)\n      | startFrom < startTo\n      , endFrom   > endTo\n      = Forward\n      | startFrom > startTo\n      , endFrom   < endTo\n      = Backward\n      | startFrom > startTo\n      , endFrom   > endTo\n      = Cross\n      | getUnique from == getUnique to\n      = SelfLoop\n      | otherwise\n      = pprPanic \"Failed to classify edge of Graph\"\n                 (ppr (getUnique from, getUnique to))\n\n      where\n        getTime event node\n          | Just time <- lookupUFM event node\n          = time\n          | otherwise\n          = pprPanic \"Failed to classify edge of CFG - not not timed\"\n            (text \"edges\" <> ppr (getUnique from, getUnique to)\n                          <+> ppr starts <+> ppr ends )\n        startFrom = getTime starts from\n        startTo   = getTime starts to\n        endFrom   = getTime ends   from\n        endTo     = getTime ends   to\n\n    addTimes :: (Time, UniqFM Time, UniqFM Time) -> key\n             -> (Time, UniqFM Time, UniqFM Time)\n    addTimes (time,starts,ends) n\n      --Dont reenter nodes\n      | elemUFM n starts\n      = (time,starts,ends)\n      | otherwise =\n        let\n          starts' = addToUFM starts n time\n          time' = time + 1\n          succs = getSucc n :: [key]\n          (time'',starts'',ends') = foldl' addTimes (time',starts',ends) succs\n          ends'' = addToUFM ends' n time''\n        in\n        (time'' + 1, starts'', ends'')\n", "num_lines": 525}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_GHC -O2 #-}\n-- We always optimise this, otherwise performance of a non-optimised\n-- compiler is severely affected\n\n-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 1997-2006\n--\n-- Character encodings\n--\n-- -----------------------------------------------------------------------------\n\nmodule Encoding (\n        -- * UTF-8\n        utf8DecodeChar#,\n        utf8PrevChar,\n        utf8CharStart,\n        utf8DecodeChar,\n        utf8DecodeByteString,\n        utf8DecodeStringLazy,\n        utf8EncodeChar,\n        utf8EncodeString,\n        utf8EncodedLength,\n        countUTF8Chars,\n\n        -- * Z-encoding\n        zEncodeString,\n        zDecodeString,\n\n        -- * Base62-encoding\n        toBase62,\n        toBase62Padded\n  ) where\n\nimport GhcPrelude\n\nimport Foreign\nimport Foreign.ForeignPtr.Unsafe\nimport Data.Char\nimport qualified Data.Char as Char\nimport Numeric\nimport GHC.IO\n\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString.Internal as BS\n\nimport GHC.Exts\n\n-- -----------------------------------------------------------------------------\n-- UTF-8\n\n-- We can't write the decoder as efficiently as we'd like without\n-- resorting to unboxed extensions, unfortunately.  I tried to write\n-- an IO version of this function, but GHC can't eliminate boxed\n-- results from an IO-returning function.\n--\n-- We assume we can ignore overflow when parsing a multibyte character here.\n-- To make this safe, we add extra sentinel bytes to unparsed UTF-8 sequences\n-- before decoding them (see StringBuffer.hs).\n\n{-# INLINE utf8DecodeChar# #-}\nutf8DecodeChar# :: Addr# -> (# Char#, Int# #)\nutf8DecodeChar# a# =\n  let !ch0 = word2Int# (indexWord8OffAddr# a# 0#) in\n  case () of\n    _ | isTrue# (ch0 <=# 0x7F#) -> (# chr# ch0, 1# #)\n\n      | isTrue# ((ch0 >=# 0xC0#) `andI#` (ch0 <=# 0xDF#)) ->\n        let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in\n        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else\n        (# chr# (((ch0 -# 0xC0#) `uncheckedIShiftL#` 6#) +#\n                  (ch1 -# 0x80#)),\n           2# #)\n\n      | isTrue# ((ch0 >=# 0xE0#) `andI#` (ch0 <=# 0xEF#)) ->\n        let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in\n        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else\n        let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in\n        if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else\n        (# chr# (((ch0 -# 0xE0#) `uncheckedIShiftL#` 12#) +#\n                 ((ch1 -# 0x80#) `uncheckedIShiftL#` 6#)  +#\n                  (ch2 -# 0x80#)),\n           3# #)\n\n     | isTrue# ((ch0 >=# 0xF0#) `andI#` (ch0 <=# 0xF8#)) ->\n        let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in\n        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else\n        let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in\n        if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else\n        let !ch3 = word2Int# (indexWord8OffAddr# a# 3#) in\n        if isTrue# ((ch3 <# 0x80#) `orI#` (ch3 >=# 0xC0#)) then fail 3# else\n        (# chr# (((ch0 -# 0xF0#) `uncheckedIShiftL#` 18#) +#\n                 ((ch1 -# 0x80#) `uncheckedIShiftL#` 12#) +#\n                 ((ch2 -# 0x80#) `uncheckedIShiftL#` 6#)  +#\n                  (ch3 -# 0x80#)),\n           4# #)\n\n      | otherwise -> fail 1#\n  where\n        -- all invalid sequences end up here:\n        fail :: Int# -> (# Char#, Int# #)\n        fail nBytes# = (# '\\0'#, nBytes# #)\n        -- '\\xFFFD' would be the usual replacement character, but\n        -- that's a valid symbol in Haskell, so will result in a\n        -- confusing parse error later on.  Instead we use '\\0' which\n        -- will signal a lexer error immediately.\n\nutf8DecodeChar :: Ptr Word8 -> (Char, Int)\nutf8DecodeChar (Ptr a#) =\n  case utf8DecodeChar# a# of (# c#, nBytes# #) -> ( C# c#, I# nBytes# )\n\n-- UTF-8 is cleverly designed so that we can always figure out where\n-- the start of the current character is, given any position in a\n-- stream.  This function finds the start of the previous character,\n-- assuming there *is* a previous character.\nutf8PrevChar :: Ptr Word8 -> IO (Ptr Word8)\nutf8PrevChar p = utf8CharStart (p `plusPtr` (-1))\n\nutf8CharStart :: Ptr Word8 -> IO (Ptr Word8)\nutf8CharStart p = go p\n where go p = do w <- peek p\n                 if w >= 0x80 && w < 0xC0\n                        then go (p `plusPtr` (-1))\n                        else return p\n\nutf8DecodeByteString :: ByteString -> [Char]\nutf8DecodeByteString (BS.PS ptr offset len)\n  = utf8DecodeStringLazy ptr offset len\n\nutf8DecodeStringLazy :: ForeignPtr Word8 -> Int -> Int -> [Char]\nutf8DecodeStringLazy fptr offset len\n  = unsafeDupablePerformIO $ unpack start\n  where\n    !start = unsafeForeignPtrToPtr fptr `plusPtr` offset\n    !end = start `plusPtr` len\n\n    unpack p\n        | p >= end  = touchForeignPtr fptr >> return []\n        | otherwise =\n            case utf8DecodeChar# (unPtr p) of\n                (# c#, nBytes# #) -> do\n                  rest <- unsafeDupableInterleaveIO $ unpack (p `plusPtr#` nBytes#)\n                  return (C# c# : rest)\n\ncountUTF8Chars :: Ptr Word8 -> Int -> IO Int\ncountUTF8Chars ptr len = go ptr 0\n  where\n        !end = ptr `plusPtr` len\n\n        go p !n\n           | p >= end = return n\n           | otherwise  = do\n                case utf8DecodeChar# (unPtr p) of\n                  (# _, nBytes# #) -> go (p `plusPtr#` nBytes#) (n+1)\n\nunPtr :: Ptr a -> Addr#\nunPtr (Ptr a) = a\n\nplusPtr# :: Ptr a -> Int# -> Ptr a\nplusPtr# ptr nBytes# = ptr `plusPtr` (I# nBytes#)\n\nutf8EncodeChar :: Char -> Ptr Word8 -> IO (Ptr Word8)\nutf8EncodeChar c ptr =\n  let x = ord c in\n  case () of\n    _ | x > 0 && x <= 0x007f -> do\n          poke ptr (fromIntegral x)\n          return (ptr `plusPtr` 1)\n        -- NB. '\\0' is encoded as '\\xC0\\x80', not '\\0'.  This is so that we\n        -- can have 0-terminated UTF-8 strings (see GHC.Base.unpackCStringUtf8).\n      | x <= 0x07ff -> do\n          poke ptr (fromIntegral (0xC0 .|. ((x `shiftR` 6) .&. 0x1F)))\n          pokeElemOff ptr 1 (fromIntegral (0x80 .|. (x .&. 0x3F)))\n          return (ptr `plusPtr` 2)\n      | x <= 0xffff -> do\n          poke ptr (fromIntegral (0xE0 .|. (x `shiftR` 12) .&. 0x0F))\n          pokeElemOff ptr 1 (fromIntegral (0x80 .|. (x `shiftR` 6) .&. 0x3F))\n          pokeElemOff ptr 2 (fromIntegral (0x80 .|. (x .&. 0x3F)))\n          return (ptr `plusPtr` 3)\n      | otherwise -> do\n          poke ptr (fromIntegral (0xF0 .|. (x `shiftR` 18)))\n          pokeElemOff ptr 1 (fromIntegral (0x80 .|. ((x `shiftR` 12) .&. 0x3F)))\n          pokeElemOff ptr 2 (fromIntegral (0x80 .|. ((x `shiftR` 6) .&. 0x3F)))\n          pokeElemOff ptr 3 (fromIntegral (0x80 .|. (x .&. 0x3F)))\n          return (ptr `plusPtr` 4)\n\nutf8EncodeString :: Ptr Word8 -> String -> IO ()\nutf8EncodeString ptr str = go ptr str\n  where go !_   []     = return ()\n        go ptr (c:cs) = do\n          ptr' <- utf8EncodeChar c ptr\n          go ptr' cs\n\nutf8EncodedLength :: String -> Int\nutf8EncodedLength str = go 0 str\n  where go !n [] = n\n        go n (c:cs)\n          | ord c > 0 && ord c <= 0x007f = go (n+1) cs\n          | ord c <= 0x07ff = go (n+2) cs\n          | ord c <= 0xffff = go (n+3) cs\n          | otherwise       = go (n+4) cs\n\n-- -----------------------------------------------------------------------------\n-- The Z-encoding\n\n{-\nThis is the main name-encoding and decoding function.  It encodes any\nstring into a string that is acceptable as a C name.  This is done\nright before we emit a symbol name into the compiled C or asm code.\nZ-encoding of strings is cached in the FastString interface, so we\nnever encode the same string more than once.\n\nThe basic encoding scheme is this.\n\n* Tuples (,,,) are coded as Z3T\n\n* Alphabetic characters (upper and lower) and digits\n        all translate to themselves;\n        except 'Z', which translates to 'ZZ'\n        and    'z', which translates to 'zz'\n  We need both so that we can preserve the variable/tycon distinction\n\n* Most other printable characters translate to 'zx' or 'Zx' for some\n        alphabetic character x\n\n* The others translate as 'znnnU' where 'nnn' is the decimal number\n        of the character\n\n        Before          After\n        --------------------------\n        Trak            Trak\n        foo_wib         foozuwib\n        >               zg\n        >1              zg1\n        foo#            foozh\n        foo##           foozhzh\n        foo##1          foozhzh1\n        fooZ            fooZZ\n        :+              ZCzp\n        ()              Z0T     0-tuple\n        (,,,,)          Z5T     5-tuple\n        (# #)           Z1H     unboxed 1-tuple (note the space)\n        (#,,,,#)        Z5H     unboxed 5-tuple\n                (NB: There is no Z1T nor Z0H.)\n-}\n\ntype UserString = String        -- As the user typed it\ntype EncodedString = String     -- Encoded form\n\n\nzEncodeString :: UserString -> EncodedString\nzEncodeString cs = case maybe_tuple cs of\n                Just n  -> n            -- Tuples go to Z2T etc\n                Nothing -> go cs\n          where\n                go []     = []\n                go (c:cs) = encode_digit_ch c ++ go' cs\n                go' []     = []\n                go' (c:cs) = encode_ch c ++ go' cs\n\nunencodedChar :: Char -> Bool   -- True for chars that don't need encoding\nunencodedChar 'Z' = False\nunencodedChar 'z' = False\nunencodedChar c   =  c >= 'a' && c <= 'z'\n                  || c >= 'A' && c <= 'Z'\n                  || c >= '0' && c <= '9'\n\n-- If a digit is at the start of a symbol then we need to encode it.\n-- Otherwise package names like 9pH-0.1 give linker errors.\nencode_digit_ch :: Char -> EncodedString\nencode_digit_ch c | c >= '0' && c <= '9' = encode_as_unicode_char c\nencode_digit_ch c | otherwise            = encode_ch c\n\nencode_ch :: Char -> EncodedString\nencode_ch c | unencodedChar c = [c]     -- Common case first\n\n-- Constructors\nencode_ch '('  = \"ZL\"   -- Needed for things like (,), and (->)\nencode_ch ')'  = \"ZR\"   -- For symmetry with (\nencode_ch '['  = \"ZM\"\nencode_ch ']'  = \"ZN\"\nencode_ch ':'  = \"ZC\"\nencode_ch 'Z'  = \"ZZ\"\n\n-- Variables\nencode_ch 'z'  = \"zz\"\nencode_ch '&'  = \"za\"\nencode_ch '|'  = \"zb\"\nencode_ch '^'  = \"zc\"\nencode_ch '$'  = \"zd\"\nencode_ch '='  = \"ze\"\nencode_ch '>'  = \"zg\"\nencode_ch '#'  = \"zh\"\nencode_ch '.'  = \"zi\"\nencode_ch '<'  = \"zl\"\nencode_ch '-'  = \"zm\"\nencode_ch '!'  = \"zn\"\nencode_ch '+'  = \"zp\"\nencode_ch '\\'' = \"zq\"\nencode_ch '\\\\' = \"zr\"\nencode_ch '/'  = \"zs\"\nencode_ch '*'  = \"zt\"\nencode_ch '_'  = \"zu\"\nencode_ch '%'  = \"zv\"\nencode_ch c    = encode_as_unicode_char c\n\nencode_as_unicode_char :: Char -> EncodedString\nencode_as_unicode_char c = 'z' : if isDigit (head hex_str) then hex_str\n                                                           else '0':hex_str\n  where hex_str = showHex (ord c) \"U\"\n  -- ToDo: we could improve the encoding here in various ways.\n  -- eg. strings of unicode characters come out as 'z1234Uz5678U', we\n  -- could remove the 'U' in the middle (the 'z' works as a separator).\n\nzDecodeString :: EncodedString -> UserString\nzDecodeString [] = []\nzDecodeString ('Z' : d : rest)\n  | isDigit d = decode_tuple   d rest\n  | otherwise = decode_upper   d : zDecodeString rest\nzDecodeString ('z' : d : rest)\n  | isDigit d = decode_num_esc d rest\n  | otherwise = decode_lower   d : zDecodeString rest\nzDecodeString (c   : rest) = c : zDecodeString rest\n\ndecode_upper, decode_lower :: Char -> Char\n\ndecode_upper 'L' = '('\ndecode_upper 'R' = ')'\ndecode_upper 'M' = '['\ndecode_upper 'N' = ']'\ndecode_upper 'C' = ':'\ndecode_upper 'Z' = 'Z'\ndecode_upper ch  = {-pprTrace \"decode_upper\" (char ch)-} ch\n\ndecode_lower 'z' = 'z'\ndecode_lower 'a' = '&'\ndecode_lower 'b' = '|'\ndecode_lower 'c' = '^'\ndecode_lower 'd' = '$'\ndecode_lower 'e' = '='\ndecode_lower 'g' = '>'\ndecode_lower 'h' = '#'\ndecode_lower 'i' = '.'\ndecode_lower 'l' = '<'\ndecode_lower 'm' = '-'\ndecode_lower 'n' = '!'\ndecode_lower 'p' = '+'\ndecode_lower 'q' = '\\''\ndecode_lower 'r' = '\\\\'\ndecode_lower 's' = '/'\ndecode_lower 't' = '*'\ndecode_lower 'u' = '_'\ndecode_lower 'v' = '%'\ndecode_lower ch  = {-pprTrace \"decode_lower\" (char ch)-} ch\n\n-- Characters not having a specific code are coded as z224U (in hex)\ndecode_num_esc :: Char -> EncodedString -> UserString\ndecode_num_esc d rest\n  = go (digitToInt d) rest\n  where\n    go n (c : rest) | isHexDigit c = go (16*n + digitToInt c) rest\n    go n ('U' : rest)           = chr n : zDecodeString rest\n    go n other = error (\"decode_num_esc: \" ++ show n ++  ' ':other)\n\ndecode_tuple :: Char -> EncodedString -> UserString\ndecode_tuple d rest\n  = go (digitToInt d) rest\n  where\n        -- NB. recurse back to zDecodeString after decoding the tuple, because\n        -- the tuple might be embedded in a longer name.\n    go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest\n    go 0 ('T':rest)     = \"()\" ++ zDecodeString rest\n    go n ('T':rest)     = '(' : replicate (n-1) ',' ++ \")\" ++ zDecodeString rest\n    go 1 ('H':rest)     = \"(# #)\" ++ zDecodeString rest\n    go n ('H':rest)     = '(' : '#' : replicate (n-1) ',' ++ \"#)\" ++ zDecodeString rest\n    go n other = error (\"decode_tuple: \" ++ show n ++ ' ':other)\n\n{-\nTuples are encoded as\n        Z3T or Z3H\nfor 3-tuples or unboxed 3-tuples respectively.  No other encoding starts\n        Z<digit>\n\n* \"(# #)\" is the tycon for an unboxed 1-tuple (not 0-tuple)\n  There are no unboxed 0-tuples.\n\n* \"()\" is the tycon for a boxed 0-tuple.\n  There are no boxed 1-tuples.\n-}\n\nmaybe_tuple :: UserString -> Maybe EncodedString\n\nmaybe_tuple \"(# #)\" = Just(\"Z1H\")\nmaybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of\n                                 (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) \"H\")\n                                 _                  -> Nothing\nmaybe_tuple \"()\" = Just(\"Z0T\")\nmaybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of\n                                 (n, ')' : _) -> Just ('Z' : shows (n+1) \"T\")\n                                 _            -> Nothing\nmaybe_tuple _                = Nothing\n\ncount_commas :: Int -> String -> (Int, String)\ncount_commas n (',' : cs) = count_commas (n+1) cs\ncount_commas n cs         = (n,cs)\n\n\n{-\n************************************************************************\n*                                                                      *\n                        Base 62\n*                                                                      *\n************************************************************************\n\nNote [Base 62 encoding 128-bit integers]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nInstead of base-62 encoding a single 128-bit integer\n(ceil(21.49) characters), we'll base-62 a pair of 64-bit integers\n(2 * ceil(10.75) characters).  Luckily for us, it's the same number of\ncharacters!\n-}\n\n--------------------------------------------------------------------------\n-- Base 62\n\n-- The base-62 code is based off of 'locators'\n-- ((c) Operational Dynamics Consulting, BSD3 licensed)\n\n-- | Size of a 64-bit word when written as a base-62 string\nword64Base62Len :: Int\nword64Base62Len = 11\n\n-- | Converts a 64-bit word into a base-62 string\ntoBase62Padded :: Word64 -> String\ntoBase62Padded w = pad ++ str\n  where\n    pad = replicate len '0'\n    len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)\n    str = toBase62 w\n\ntoBase62 :: Word64 -> String\ntoBase62 w = showIntAtBase 62 represent w \"\"\n  where\n    represent :: Int -> Char\n    represent x\n        | x < 10 = Char.chr (48 + x)\n        | x < 36 = Char.chr (65 + x - 10)\n        | x < 62 = Char.chr (97 + x - 36)\n        | otherwise = error \"represent (base 62): impossible!\"\n", "num_lines": 451}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | A tiny wrapper around 'IntSet.IntSet' for representing sets of 'Enum'\n-- things.\nmodule EnumSet\n    ( EnumSet\n    , member\n    , insert\n    , delete\n    , toList\n    , fromList\n    , empty\n    ) where\n\nimport GhcPrelude\n\nimport qualified Data.IntSet as IntSet\n\nnewtype EnumSet a = EnumSet IntSet.IntSet\n\nmember :: Enum a => a -> EnumSet a -> Bool\nmember x (EnumSet s) = IntSet.member (fromEnum x) s\n\ninsert :: Enum a => a -> EnumSet a -> EnumSet a\ninsert x (EnumSet s) = EnumSet $ IntSet.insert (fromEnum x) s\n\ndelete :: Enum a => a -> EnumSet a -> EnumSet a\ndelete x (EnumSet s) = EnumSet $ IntSet.delete (fromEnum x) s\n\ntoList :: Enum a => EnumSet a -> [a]\ntoList (EnumSet s) = map toEnum $ IntSet.toList s\n\nfromList :: Enum a => [a] -> EnumSet a\nfromList = EnumSet . IntSet.fromList . map fromEnum\n\nempty :: EnumSet a\nempty = EnumSet IntSet.empty\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-deprecations #-}\nmodule Exception\n    (\n    module Control.Exception,\n    module Exception\n    )\n    where\n\nimport GhcPrelude\n\nimport Control.Exception\nimport Control.Monad.IO.Class\n\ncatchIO :: IO a -> (IOException -> IO a) -> IO a\ncatchIO = Control.Exception.catch\n\nhandleIO :: (IOException -> IO a) -> IO a -> IO a\nhandleIO = flip catchIO\n\ntryIO :: IO a -> IO (Either IOException a)\ntryIO = try\n\n-- | A monad that can catch exceptions.  A minimal definition\n-- requires a definition of 'gcatch'.\n--\n-- Implementations on top of 'IO' should implement 'gmask' to\n-- eventually call the primitive 'Control.Exception.mask'.\n-- These are used for\n-- implementations that support asynchronous exceptions.  The default\n-- implementations of 'gbracket' and 'gfinally' use 'gmask'\n-- thus rarely require overriding.\n--\nclass MonadIO m => ExceptionMonad m where\n\n  -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary\n  -- exception handling monad instead of just 'IO'.\n  gcatch :: Exception e => m a -> (e -> m a) -> m a\n\n  -- | Generalised version of 'Control.Exception.mask_', allowing an arbitrary\n  -- exception handling monad instead of just 'IO'.\n  gmask :: ((m a -> m a) -> m b) -> m b\n\n  -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary\n  -- exception handling monad instead of just 'IO'.\n  gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c\n\n  -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary\n  -- exception handling monad instead of just 'IO'.\n  gfinally :: m a -> m b -> m a\n\n  gbracket before after thing =\n    gmask $ \\restore -> do\n      a <- before\n      r <- restore (thing a) `gonException` after a\n      _ <- after a\n      return r\n\n  a `gfinally` sequel =\n    gmask $ \\restore -> do\n      r <- restore a `gonException` sequel\n      _ <- sequel\n      return r\n\ninstance ExceptionMonad IO where\n  gcatch    = Control.Exception.catch\n  gmask f   = mask (\\x -> f x)\n\ngtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)\ngtry act = gcatch (act >>= \\a -> return (Right a))\n                  (\\e -> return (Left e))\n\n-- | Generalised version of 'Control.Exception.handle', allowing an arbitrary\n-- exception handling monad instead of just 'IO'.\nghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a\nghandle = flip gcatch\n\n-- | Always executes the first argument.  If this throws an exception the\n-- second argument is executed and the exception is raised again.\ngonException :: (ExceptionMonad m) => m a -> m b -> m a\ngonException ioA cleanup = ioA `gcatch` \\e ->\n                             do _ <- cleanup\n                                liftIO $ throwIO (e :: SomeException)\n\n", "num_lines": 84}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow, 2000-2006\n-}\n\n{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}\n\nmodule FastFunctions (\n    inlinePerformIO,\n  ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude ()\n\nimport GHC.Exts\nimport GHC.IO   (IO(..))\n\n-- Just like unsafeDupablePerformIO, but we inline it.\n{-# INLINE inlinePerformIO #-}\ninlinePerformIO :: IO a -> a\ninlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_GHC -O2 #-}\n-- We always optimise this, otherwise performance of a non-optimised\n-- compiler is severely affected\n--\n-- (c) The University of Glasgow 2002-2006\n--\n-- Unboxed mutable Ints\n\nmodule FastMutInt(\n        FastMutInt, newFastMutInt,\n        readFastMutInt, writeFastMutInt,\n\n        FastMutPtr, newFastMutPtr,\n        readFastMutPtr, writeFastMutPtr\n  ) where\n\nimport GhcPrelude\n\nimport Data.Bits\nimport GHC.Base\nimport GHC.Ptr\n\nnewFastMutInt :: IO FastMutInt\nreadFastMutInt :: FastMutInt -> IO Int\nwriteFastMutInt :: FastMutInt -> Int -> IO ()\n\nnewFastMutPtr :: IO FastMutPtr\nreadFastMutPtr :: FastMutPtr -> IO (Ptr a)\nwriteFastMutPtr :: FastMutPtr -> Ptr a -> IO ()\n\ndata FastMutInt = FastMutInt (MutableByteArray# RealWorld)\n\nnewFastMutInt = IO $ \\s ->\n  case newByteArray# size s of { (# s, arr #) ->\n  (# s, FastMutInt arr #) }\n  where !(I# size) = finiteBitSize (0 :: Int)\n\nreadFastMutInt (FastMutInt arr) = IO $ \\s ->\n  case readIntArray# arr 0# s of { (# s, i #) ->\n  (# s, I# i #) }\n\nwriteFastMutInt (FastMutInt arr) (I# i) = IO $ \\s ->\n  case writeIntArray# arr 0# i s of { s ->\n  (# s, () #) }\n\ndata FastMutPtr = FastMutPtr (MutableByteArray# RealWorld)\n\nnewFastMutPtr = IO $ \\s ->\n  case newByteArray# size s of { (# s, arr #) ->\n  (# s, FastMutPtr arr #) }\n  -- GHC assumes 'sizeof (Int) == sizeof (Ptr a)'\n  where !(I# size) = finiteBitSize (0 :: Int)\n\nreadFastMutPtr (FastMutPtr arr) = IO $ \\s ->\n  case readAddrArray# arr 0# s of { (# s, i #) ->\n  (# s, Ptr i #) }\n\nwriteFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \\s ->\n  case writeAddrArray# arr 0# i s of { s ->\n  (# s, () #) }\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow, 1997-2006\n\n{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples,\n    GeneralizedNewtypeDeriving #-}\n{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}\n-- We always optimise this, otherwise performance of a non-optimised\n-- compiler is severely affected\n\n-- |\n-- There are two principal string types used internally by GHC:\n--\n-- ['FastString']\n--\n--   * A compact, hash-consed, representation of character strings.\n--   * Comparison is O(1), and you can get a 'Unique.Unique' from them.\n--   * Generated by 'fsLit'.\n--   * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.\n--\n-- ['PtrString']\n--\n--   * Pointer and size of a Latin-1 encoded string.\n--   * Practically no operations.\n--   * Outputing them is fast.\n--   * Generated by 'sLit'.\n--   * Turn into 'Outputable.SDoc' with 'Outputable.ptext'\n--   * Requires manual memory management.\n--     Improper use may lead to memory leaks or dangling pointers.\n--   * It assumes Latin-1 as the encoding, therefore it cannot represent\n--     arbitrary Unicode strings.\n--\n-- Use 'PtrString' unless you want the facilities of 'FastString'.\nmodule FastString\n       (\n        -- * ByteString\n        bytesFS,            -- :: FastString -> ByteString\n        fastStringToByteString, -- = bytesFS (kept for haddock)\n        mkFastStringByteString,\n        fastZStringToByteString,\n        unsafeMkByteString,\n\n        -- * FastZString\n        FastZString,\n        hPutFZS,\n        zString,\n        lengthFZS,\n\n        -- * FastStrings\n        FastString(..),     -- not abstract, for now.\n\n        -- ** Construction\n        fsLit,\n        mkFastString,\n        mkFastStringBytes,\n        mkFastStringByteList,\n        mkFastStringForeignPtr,\n        mkFastString#,\n\n        -- ** Deconstruction\n        unpackFS,           -- :: FastString -> String\n\n        -- ** Encoding\n        zEncodeFS,\n\n        -- ** Operations\n        uniqueOfFS,\n        lengthFS,\n        nullFS,\n        appendFS,\n        headFS,\n        tailFS,\n        concatFS,\n        consFS,\n        nilFS,\n        isUnderscoreFS,\n\n        -- ** Outputing\n        hPutFS,\n\n        -- ** Internal\n        getFastStringTable,\n        hasZEncoding,\n\n        -- * PtrStrings\n        PtrString (..),\n\n        -- ** Construction\n        sLit,\n        mkPtrString#,\n        mkPtrString,\n\n        -- ** Deconstruction\n        unpackPtrString,\n\n        -- ** Operations\n        lengthPS\n       ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude as Prelude\n\nimport Encoding\nimport FastFunctions\nimport Panic\nimport Util\n\nimport Control.Concurrent.MVar\nimport Control.DeepSeq\nimport Control.Monad\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString          as BS\nimport qualified Data.ByteString.Char8    as BSC\nimport qualified Data.ByteString.Internal as BS\nimport qualified Data.ByteString.Unsafe   as BS\nimport Foreign.C\nimport GHC.Exts\nimport System.IO\nimport Data.Data\nimport Data.IORef\nimport Data.Maybe       ( isJust )\nimport Data.Char\nimport Data.Semigroup as Semi\n\nimport GHC.IO\n\nimport Foreign\n\n#if STAGE >= 2\nimport GHC.Conc.Sync    (sharedCAF)\n#endif\n\nimport GHC.Base         ( unpackCString#, unpackNBytes# )\n\n\n-- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'\nbytesFS :: FastString -> ByteString\nbytesFS f = fs_bs f\n\n{-# DEPRECATED fastStringToByteString \"Use `bytesFS` instead\" #-}\nfastStringToByteString :: FastString -> ByteString\nfastStringToByteString = bytesFS\n\nfastZStringToByteString :: FastZString -> ByteString\nfastZStringToByteString (FastZString bs) = bs\n\n-- This will drop information if any character > '\\xFF'\nunsafeMkByteString :: String -> ByteString\nunsafeMkByteString = BSC.pack\n\nhashFastString :: FastString -> Int\nhashFastString (FastString _ _ bs _)\n    = inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \\(ptr, len) ->\n      return $ hashStr (castPtr ptr) len\n\n-- -----------------------------------------------------------------------------\n\nnewtype FastZString = FastZString ByteString\n  deriving NFData\n\nhPutFZS :: Handle -> FastZString -> IO ()\nhPutFZS handle (FastZString bs) = BS.hPut handle bs\n\nzString :: FastZString -> String\nzString (FastZString bs) =\n    inlinePerformIO $ BS.unsafeUseAsCStringLen bs peekCAStringLen\n\nlengthFZS :: FastZString -> Int\nlengthFZS (FastZString bs) = BS.length bs\n\nmkFastZStringString :: String -> FastZString\nmkFastZStringString str = FastZString (BSC.pack str)\n\n-- -----------------------------------------------------------------------------\n\n{-|\nA 'FastString' is an array of bytes, hashed to support fast O(1)\ncomparison.  It is also associated with a character encoding, so that\nwe know how to convert a 'FastString' to the local encoding, or to the\nZ-encoding used by the compiler internally.\n\n'FastString's support a memoized conversion to the Z-encoding via zEncodeFS.\n-}\n\ndata FastString = FastString {\n      uniq    :: {-# UNPACK #-} !Int, -- unique id\n      n_chars :: {-# UNPACK #-} !Int, -- number of chars\n      fs_bs   :: {-# UNPACK #-} !ByteString,\n      fs_ref  :: {-# UNPACK #-} !(IORef (Maybe FastZString))\n  }\n\ninstance Eq FastString where\n  f1 == f2  =  uniq f1 == uniq f2\n\ninstance Ord FastString where\n    -- Compares lexicographically, not by unique\n    a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }\n    a <  b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }\n    a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }\n    a >  b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }\n    max x y | x >= y    =  x\n            | otherwise =  y\n    min x y | x <= y    =  x\n            | otherwise =  y\n    compare a b = cmpFS a b\n\ninstance IsString FastString where\n    fromString = fsLit\n\ninstance Semi.Semigroup FastString where\n    (<>) = appendFS\n\ninstance Monoid FastString where\n    mempty = nilFS\n    mappend = (Semi.<>)\n    mconcat = concatFS\n\ninstance Show FastString where\n   show fs = show (unpackFS fs)\n\ninstance Data FastString where\n  -- don't traverse?\n  toConstr _   = abstractConstr \"FastString\"\n  gunfold _ _  = error \"gunfold\"\n  dataTypeOf _ = mkNoRepType \"FastString\"\n\ncmpFS :: FastString -> FastString -> Ordering\ncmpFS f1@(FastString u1 _ _ _) f2@(FastString u2 _ _ _) =\n  if u1 == u2 then EQ else\n  compare (bytesFS f1) (bytesFS f2)\n\nforeign import ccall unsafe \"memcmp\"\n  memcmp :: Ptr a -> Ptr b -> Int -> IO Int\n\n-- -----------------------------------------------------------------------------\n-- Construction\n\n{-\nInternally, the compiler will maintain a fast string symbol table, providing\nsharing and fast comparison. Creation of new @FastString@s then covertly does a\nlookup, re-using the @FastString@ if there was a hit.\n\nThe design of the FastString hash table allows for lockless concurrent reads\nand updates to multiple buckets with low synchronization overhead.\n\nSee Note [Updating the FastString table] on how it's updated.\n-}\ndata FastStringTable = FastStringTable\n  {-# UNPACK #-} !(IORef Int) -- the unique ID counter shared with all buckets\n  (Array# (IORef FastStringTableSegment)) -- concurrent segments\n\ndata FastStringTableSegment = FastStringTableSegment\n  {-# UNPACK #-} !(MVar ()) -- the lock for write in each segment\n  {-# UNPACK #-} !(IORef Int) -- the number of elements\n  (MutableArray# RealWorld [FastString]) -- buckets in this segment\n\n{-\nFollowing parameters are determined based on:\n\n* Benchmark based on testsuite/tests/utils/should_run/T14854.hs\n* Stats of @echo :browse | ghc --interactive -dfaststring-stats >/dev/null@:\n  on 2018-10-24, we have 13920 entries.\n-}\nsegmentBits, numSegments, segmentMask, initialNumBuckets :: Int\nsegmentBits = 8\nnumSegments = 256   -- bit segmentBits\nsegmentMask = 0xff  -- bit segmentBits - 1\ninitialNumBuckets = 64\n\nhashToSegment# :: Int# -> Int#\nhashToSegment# hash# = hash# `andI#` segmentMask#\n  where\n    !(I# segmentMask#) = segmentMask\n\nhashToIndex# :: MutableArray# RealWorld [FastString] -> Int# -> Int#\nhashToIndex# buckets# hash# =\n  (hash# `uncheckedIShiftRL#` segmentBits#) `remInt#` size#\n  where\n    !(I# segmentBits#) = segmentBits\n    size# = sizeofMutableArray# buckets#\n\nmaybeResizeSegment :: IORef FastStringTableSegment -> IO FastStringTableSegment\nmaybeResizeSegment segmentRef = do\n  segment@(FastStringTableSegment lock counter old#) <- readIORef segmentRef\n  let oldSize# = sizeofMutableArray# old#\n      newSize# = oldSize# *# 2#\n  (I# n#) <- readIORef counter\n  if isTrue# (n# <# newSize#) -- maximum load of 1\n  then return segment\n  else do\n    resizedSegment@(FastStringTableSegment _ _ new#) <- IO $ \\s1# ->\n      case newArray# newSize# [] s1# of\n        (# s2#, arr# #) -> (# s2#, FastStringTableSegment lock counter arr# #)\n    forM_ [0 .. (I# oldSize#) - 1] $ \\(I# i#) -> do\n      fsList <- IO $ readArray# old# i#\n      forM_ fsList $ \\fs -> do\n        let -- Shall we store in hash value in FastString instead?\n            !(I# hash#) = hashFastString fs\n            idx# = hashToIndex# new# hash#\n        IO $ \\s1# ->\n          case readArray# new# idx# s1# of\n            (# s2#, bucket #) -> case writeArray# new# idx# (fs: bucket) s2# of\n              s3# -> (# s3#, () #)\n    writeIORef segmentRef resizedSegment\n    return resizedSegment\n\n{-# NOINLINE stringTable #-}\nstringTable :: FastStringTable\nstringTable = unsafePerformIO $ do\n  let !(I# numSegments#) = numSegments\n      !(I# initialNumBuckets#) = initialNumBuckets\n      loop a# i# s1#\n        | isTrue# (i# ==# numSegments#) = s1#\n        | otherwise = case newMVar () `unIO` s1# of\n            (# s2#, lock #) -> case newIORef 0 `unIO` s2# of\n              (# s3#, counter #) -> case newArray# initialNumBuckets# [] s3# of\n                (# s4#, buckets# #) -> case newIORef\n                    (FastStringTableSegment lock counter buckets#) `unIO` s4# of\n                  (# s5#, segment #) -> case writeArray# a# i# segment s5# of\n                    s6# -> loop a# (i# +# 1#) s6#\n  uid <- newIORef 603979776 -- ord '$' * 0x01000000\n  tab <- IO $ \\s1# ->\n    case newArray# numSegments# (panic \"string_table\") s1# of\n      (# s2#, arr# #) -> case loop arr# 0# s2# of\n        s3# -> case unsafeFreezeArray# arr# s3# of\n          (# s4#, segments# #) -> (# s4#, FastStringTable uid segments# #)\n\n  -- use the support wired into the RTS to share this CAF among all images of\n  -- libHSghc\n#if STAGE < 2\n  return tab\n#else\n  sharedCAF tab getOrSetLibHSghcFastStringTable\n\n-- from the RTS; thus we cannot use this mechanism when STAGE<2; the previous\n-- RTS might not have this symbol\nforeign import ccall unsafe \"getOrSetLibHSghcFastStringTable\"\n  getOrSetLibHSghcFastStringTable :: Ptr a -> IO (Ptr a)\n#endif\n\n{-\n\nWe include the FastString table in the `sharedCAF` mechanism because we'd like\nFastStrings created by a Core plugin to have the same uniques as corresponding\nstrings created by the host compiler itself.  For example, this allows plugins\nto lookup known names (eg `mkTcOcc \"MySpecialType\"`) in the GlobalRdrEnv or\neven re-invoke the parser.\n\nIn particular, the following little sanity test was failing in a plugin\nprototyping safe newtype-coercions: GHC.NT.Type.NT was imported, but could not\nbe looked up /by the plugin/.\n\n   let rdrName = mkModuleName \"GHC.NT.Type\" `mkRdrQual` mkTcOcc \"NT\"\n   putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts\n\n`mkTcOcc` involves the lookup (or creation) of a FastString.  Since the\nplugin's FastString.string_table is empty, constructing the RdrName also\nallocates new uniques for the FastStrings \"GHC.NT.Type\" and \"NT\".  These\nuniques are almost certainly unequal to the ones that the host compiler\noriginally assigned to those FastStrings.  Thus the lookup fails since the\ndomain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's\nunique.\n\nMaintaining synchronization of the two instances of this global is rather\ndifficult because of the uses of `unsafePerformIO` in this module.  Not\nsynchronizing them risks breaking the rather major invariant that two\nFastStrings with the same unique have the same string. Thus we use the\nlower-level `sharedCAF` mechanism that relies on Globals.c.\n\n-}\n\nmkFastString# :: Addr# -> FastString\nmkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr)\n  where ptr = Ptr a#\n\n{- Note [Updating the FastString table]\n\nWe use a concurrent hashtable which contains multiple segments, each hash value\nalways maps to the same segment. Read is lock-free, write to the a segment\nshould acquire a lock for that segment to avoid race condition, writes to\ndifferent segments are independent.\n\nThe procedure goes like this:\n\n1. Find out which segment to operate on based on the hash value\n2. Read the relevant bucket and perform a look up of the string.\n3. If it exists, return it.\n4. Otherwise grab a unique ID, create a new FastString and atomically attempt\n   to update the relevant segment with this FastString:\n\n   * Resize the segment by doubling the number of buckets when the number of\n     FastStrings in this segment grows beyond the threshold.\n   * Double check that the string is not in the bucket. Another thread may have\n     inserted it while we were creating our string.\n   * Return the existing FastString if it exists. The one we preemptively\n     created will get GCed.\n   * Otherwise, insert and return the string we created.\n-}\n\nmkFastStringWith :: (Int -> IO FastString) -> Ptr Word8 -> Int -> IO FastString\nmkFastStringWith mk_fs !ptr !len = do\n  FastStringTableSegment lock _ buckets# <- readIORef segmentRef\n  let idx# = hashToIndex# buckets# hash#\n  bucket <- IO $ readArray# buckets# idx#\n  res <- bucket_match bucket len ptr\n  case res of\n    Just found -> return found\n    Nothing -> do\n      -- The withMVar below is not dupable. It can lead to deadlock if it is\n      -- only run partially and putMVar is not called after takeMVar.\n      noDuplicate\n      n <- get_uid\n      new_fs <- mk_fs n\n      withMVar lock $ \\_ -> insert new_fs\n  where\n    !(FastStringTable uid segments#) = stringTable\n    get_uid = atomicModifyIORef' uid $ \\n -> (n+1,n)\n\n    !(I# hash#) = hashStr ptr len\n    (# segmentRef #) = indexArray# segments# (hashToSegment# hash#)\n    insert fs = do\n      FastStringTableSegment _ counter buckets# <- maybeResizeSegment segmentRef\n      let idx# = hashToIndex# buckets# hash#\n      bucket <- IO $ readArray# buckets# idx#\n      res <- bucket_match bucket len ptr\n      case res of\n        -- The FastString was added by another thread after previous read and\n        -- before we acquired the write lock.\n        Just found -> return found\n        Nothing -> do\n          IO $ \\s1# ->\n            case writeArray# buckets# idx# (fs: bucket) s1# of\n              s2# -> (# s2#, () #)\n          modifyIORef' counter succ\n          return fs\n\nbucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)\nbucket_match [] _ _ = return Nothing\nbucket_match (v@(FastString _ _ bs _):ls) len ptr\n      | len == BS.length bs = do\n         b <- BS.unsafeUseAsCString bs $ \\buf ->\n             cmpStringPrefix ptr (castPtr buf) len\n         if b then return (Just v)\n              else bucket_match ls len ptr\n      | otherwise =\n         bucket_match ls len ptr\n\nmkFastStringBytes :: Ptr Word8 -> Int -> FastString\nmkFastStringBytes !ptr !len =\n    -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is\n    -- idempotent.\n    unsafeDupablePerformIO $\n        mkFastStringWith (copyNewFastString ptr len) ptr len\n\n-- | Create a 'FastString' from an existing 'ForeignPtr'; the difference\n-- between this and 'mkFastStringBytes' is that we don't have to copy\n-- the bytes if the string is new to the table.\nmkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString\nmkFastStringForeignPtr ptr !fp len\n    = mkFastStringWith (mkNewFastString fp ptr len) ptr len\n\n-- | Create a 'FastString' from an existing 'ForeignPtr'; the difference\n-- between this and 'mkFastStringBytes' is that we don't have to copy\n-- the bytes if the string is new to the table.\nmkFastStringByteString :: ByteString -> FastString\nmkFastStringByteString bs =\n    inlinePerformIO $\n      BS.unsafeUseAsCStringLen bs $ \\(ptr, len) -> do\n        let ptr' = castPtr ptr\n        mkFastStringWith (mkNewFastStringByteString bs ptr' len) ptr' len\n\n-- | Creates a UTF-8 encoded 'FastString' from a 'String'\nmkFastString :: String -> FastString\nmkFastString str =\n  inlinePerformIO $ do\n    let l = utf8EncodedLength str\n    buf <- mallocForeignPtrBytes l\n    withForeignPtr buf $ \\ptr -> do\n      utf8EncodeString ptr str\n      mkFastStringForeignPtr ptr buf l\n\n-- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@\nmkFastStringByteList :: [Word8] -> FastString\nmkFastStringByteList str = mkFastStringByteString (BS.pack str)\n\n-- | Creates a Z-encoded 'FastString' from a 'String'\nmkZFastString :: String -> FastZString\nmkZFastString = mkFastZStringString\n\nmkNewFastString :: ForeignPtr Word8 -> Ptr Word8 -> Int -> Int\n                -> IO FastString\nmkNewFastString fp ptr len uid = do\n  ref <- newIORef Nothing\n  n_chars <- countUTF8Chars ptr len\n  return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)\n\nmkNewFastStringByteString :: ByteString -> Ptr Word8 -> Int -> Int\n                          -> IO FastString\nmkNewFastStringByteString bs ptr len uid = do\n  ref <- newIORef Nothing\n  n_chars <- countUTF8Chars ptr len\n  return (FastString uid n_chars bs ref)\n\ncopyNewFastString :: Ptr Word8 -> Int -> Int -> IO FastString\ncopyNewFastString ptr len uid = do\n  fp <- copyBytesToForeignPtr ptr len\n  ref <- newIORef Nothing\n  n_chars <- countUTF8Chars ptr len\n  return (FastString uid n_chars (BS.fromForeignPtr fp 0 len) ref)\n\ncopyBytesToForeignPtr :: Ptr Word8 -> Int -> IO (ForeignPtr Word8)\ncopyBytesToForeignPtr ptr len = do\n  fp <- mallocForeignPtrBytes len\n  withForeignPtr fp $ \\ptr' -> copyBytes ptr' ptr len\n  return fp\n\ncmpStringPrefix :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool\ncmpStringPrefix ptr1 ptr2 len =\n do r <- memcmp ptr1 ptr2 len\n    return (r == 0)\n\n\nhashStr  :: Ptr Word8 -> Int -> Int\n -- use the Addr to produce a hash value between 0 & m (inclusive)\nhashStr (Ptr a#) (I# len#) = loop 0# 0#\n   where\n    loop h n | isTrue# (n ==# len#) = I# h\n             | otherwise  = loop h2 (n +# 1#)\n          where\n            !c = ord# (indexCharOffAddr# a# n)\n            !h2 = (h *# 16777619#) `xorI#` c\n\n-- -----------------------------------------------------------------------------\n-- Operations\n\n-- | Returns the length of the 'FastString' in characters\nlengthFS :: FastString -> Int\nlengthFS f = n_chars f\n\n-- | Returns @True@ if this 'FastString' is not Z-encoded but already has\n-- a Z-encoding cached (used in producing stats).\nhasZEncoding :: FastString -> Bool\nhasZEncoding (FastString _ _ _ ref) =\n      inlinePerformIO $ do\n        m <- readIORef ref\n        return (isJust m)\n\n-- | Returns @True@ if the 'FastString' is empty\nnullFS :: FastString -> Bool\nnullFS f = BS.null (fs_bs f)\n\n-- | Unpacks and decodes the FastString\nunpackFS :: FastString -> String\nunpackFS (FastString _ _ bs _) = utf8DecodeByteString bs\n\n-- | Returns a Z-encoded version of a 'FastString'.  This might be the\n-- original, if it was already Z-encoded.  The first time this\n-- function is applied to a particular 'FastString', the results are\n-- memoized.\n--\nzEncodeFS :: FastString -> FastZString\nzEncodeFS fs@(FastString _ _ _ ref) =\n      inlinePerformIO $ do\n        m <- readIORef ref\n        case m of\n          Just zfs -> return zfs\n          Nothing -> do\n            atomicModifyIORef' ref $ \\m' -> case m' of\n              Nothing  -> let zfs = mkZFastString (zEncodeString (unpackFS fs))\n                          in (Just zfs, zfs)\n              Just zfs -> (m', zfs)\n\nappendFS :: FastString -> FastString -> FastString\nappendFS fs1 fs2 = mkFastStringByteString\n                 $ BS.append (bytesFS fs1) (bytesFS fs2)\n\nconcatFS :: [FastString] -> FastString\nconcatFS = mkFastStringByteString . BS.concat . map fs_bs\n\nheadFS :: FastString -> Char\nheadFS (FastString _ 0 _ _) = panic \"headFS: Empty FastString\"\nheadFS (FastString _ _ bs _) =\n  inlinePerformIO $ BS.unsafeUseAsCString bs $ \\ptr ->\n         return (fst (utf8DecodeChar (castPtr ptr)))\n\ntailFS :: FastString -> FastString\ntailFS (FastString _ 0 _ _) = panic \"tailFS: Empty FastString\"\ntailFS (FastString _ _ bs _) =\n    inlinePerformIO $ BS.unsafeUseAsCString bs $ \\ptr ->\n    do let (_, n) = utf8DecodeChar (castPtr ptr)\n       return $! mkFastStringByteString (BS.drop n bs)\n\nconsFS :: Char -> FastString -> FastString\nconsFS c fs = mkFastString (c : unpackFS fs)\n\nuniqueOfFS :: FastString -> Int\nuniqueOfFS (FastString u _ _ _) = u\n\nnilFS :: FastString\nnilFS = mkFastString \"\"\n\nisUnderscoreFS :: FastString -> Bool\nisUnderscoreFS fs = fs == fsLit \"_\"\n\n-- -----------------------------------------------------------------------------\n-- Stats\n\ngetFastStringTable :: IO [[[FastString]]]\ngetFastStringTable =\n  forM [0 .. numSegments - 1] $ \\(I# i#) -> do\n    let (# segmentRef #) = indexArray# segments# i#\n    FastStringTableSegment _ _ buckets# <- readIORef segmentRef\n    let bucketSize = I# (sizeofMutableArray# buckets#)\n    forM [0 .. bucketSize - 1] $ \\(I# j#) ->\n      IO $ readArray# buckets# j#\n  where\n    !(FastStringTable _ segments#) = stringTable\n\n-- -----------------------------------------------------------------------------\n-- Outputting 'FastString's\n\n-- |Outputs a 'FastString' with /no decoding at all/, that is, you\n-- get the actual bytes in the 'FastString' written to the 'Handle'.\nhPutFS :: Handle -> FastString -> IO ()\nhPutFS handle fs = BS.hPut handle $ bytesFS fs\n\n-- ToDo: we'll probably want an hPutFSLocal, or something, to output\n-- in the current locale's encoding (for error messages and suchlike).\n\n-- -----------------------------------------------------------------------------\n-- PtrStrings, here for convenience only.\n\n-- | A 'PtrString' is a pointer to some array of Latin-1 encoded chars.\ndata PtrString = PtrString !(Ptr Word8) !Int\n\n-- | Wrap an unboxed address into a 'PtrString'.\nmkPtrString# :: Addr# -> PtrString\nmkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#))\n\n-- | Encode a 'String' into a newly allocated 'PtrString' using Latin-1\n-- encoding.  The original string must not contain non-Latin-1 characters\n-- (above codepoint @0xff@).\n{-# INLINE mkPtrString #-}\nmkPtrString :: String -> PtrString\nmkPtrString s =\n -- we don't use `unsafeDupablePerformIO` here to avoid potential memory leaks\n -- and because someone might be using `eqAddr#` to check for string equality.\n unsafePerformIO (do\n   let len = length s\n   p <- mallocBytes len\n   let\n     loop :: Int -> String -> IO ()\n     loop !_ []    = return ()\n     loop n (c:cs) = do\n        pokeByteOff p n (fromIntegral (ord c) :: Word8)\n        loop (1+n) cs\n   loop 0 s\n   return (PtrString p len)\n )\n\n-- | Decode a 'PtrString' back into a 'String' using Latin-1 encoding.\n-- This does not free the memory associated with 'PtrString'.\nunpackPtrString :: PtrString -> String\nunpackPtrString (PtrString (Ptr p#) (I# n#)) = unpackNBytes# p# n#\n\n-- | Return the length of a 'PtrString'\nlengthPS :: PtrString -> Int\nlengthPS (PtrString _ n) = n\n\n-- -----------------------------------------------------------------------------\n-- under the carpet\n\nforeign import ccall unsafe \"strlen\"\n  ptrStrLength :: Ptr Word8 -> Int\n\n{-# NOINLINE sLit #-}\nsLit :: String -> PtrString\nsLit x  = mkPtrString x\n\n{-# NOINLINE fsLit #-}\nfsLit :: String -> FastString\nfsLit x = mkFastString x\n\n{-# RULES \"slit\"\n    forall x . sLit  (unpackCString# x) = mkPtrString#  x #-}\n{-# RULES \"fslit\"\n    forall x . fsLit (unpackCString# x) = mkFastString# x #-}\n", "num_lines": 687}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n%\n% (c) The University of Glasgow 2006\n% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n%\n\\section[FastStringEnv]{@FastStringEnv@: FastString environments}\n-}\n\nmodule FastStringEnv (\n        -- * FastString environments (maps)\n        FastStringEnv,\n\n        -- ** Manipulating these environments\n        mkFsEnv,\n        emptyFsEnv, unitFsEnv,\n        extendFsEnv_C, extendFsEnv_Acc, extendFsEnv,\n        extendFsEnvList, extendFsEnvList_C,\n        filterFsEnv,\n        plusFsEnv, plusFsEnv_C, alterFsEnv,\n        lookupFsEnv, lookupFsEnv_NF, delFromFsEnv, delListFromFsEnv,\n        elemFsEnv, mapFsEnv,\n\n        -- * Deterministic FastString environments (maps)\n        DFastStringEnv,\n\n        -- ** Manipulating these environments\n        mkDFsEnv, emptyDFsEnv, dFsEnvElts, lookupDFsEnv\n    ) where\n\nimport GhcPrelude\n\nimport UniqFM\nimport UniqDFM\nimport Maybes\nimport FastString\n\n\n-- | A non-deterministic set of FastStrings.\n-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not\n-- deterministic and why it matters. Use DFastStringEnv if the set eventually\n-- gets converted into a list or folded over in a way where the order\n-- changes the generated code.\ntype FastStringEnv a = UniqFM a  -- Domain is FastString\n\nemptyFsEnv         :: FastStringEnv a\nmkFsEnv            :: [(FastString,a)] -> FastStringEnv a\nalterFsEnv         :: (Maybe a-> Maybe a) -> FastStringEnv a -> FastString -> FastStringEnv a\nextendFsEnv_C      :: (a->a->a) -> FastStringEnv a -> FastString -> a -> FastStringEnv a\nextendFsEnv_Acc    :: (a->b->b) -> (a->b) -> FastStringEnv b -> FastString -> a -> FastStringEnv b\nextendFsEnv        :: FastStringEnv a -> FastString -> a -> FastStringEnv a\nplusFsEnv          :: FastStringEnv a -> FastStringEnv a -> FastStringEnv a\nplusFsEnv_C        :: (a->a->a) -> FastStringEnv a -> FastStringEnv a -> FastStringEnv a\nextendFsEnvList    :: FastStringEnv a -> [(FastString,a)] -> FastStringEnv a\nextendFsEnvList_C  :: (a->a->a) -> FastStringEnv a -> [(FastString,a)] -> FastStringEnv a\ndelFromFsEnv       :: FastStringEnv a -> FastString -> FastStringEnv a\ndelListFromFsEnv   :: FastStringEnv a -> [FastString] -> FastStringEnv a\nelemFsEnv          :: FastString -> FastStringEnv a -> Bool\nunitFsEnv          :: FastString -> a -> FastStringEnv a\nlookupFsEnv        :: FastStringEnv a -> FastString -> Maybe a\nlookupFsEnv_NF     :: FastStringEnv a -> FastString -> a\nfilterFsEnv        :: (elt -> Bool) -> FastStringEnv elt -> FastStringEnv elt\nmapFsEnv           :: (elt1 -> elt2) -> FastStringEnv elt1 -> FastStringEnv elt2\n\nemptyFsEnv                = emptyUFM\nunitFsEnv x y             = unitUFM x y\nextendFsEnv x y z         = addToUFM x y z\nextendFsEnvList x l       = addListToUFM x l\nlookupFsEnv x y           = lookupUFM x y\nalterFsEnv                = alterUFM\nmkFsEnv     l             = listToUFM l\nelemFsEnv x y             = elemUFM x y\nplusFsEnv x y             = plusUFM x y\nplusFsEnv_C f x y         = plusUFM_C f x y\nextendFsEnv_C f x y z     = addToUFM_C f x y z\nmapFsEnv f x              = mapUFM f x\nextendFsEnv_Acc x y z a b = addToUFM_Acc x y z a b\nextendFsEnvList_C x y z   = addListToUFM_C x y z\ndelFromFsEnv x y          = delFromUFM x y\ndelListFromFsEnv x y      = delListFromUFM x y\nfilterFsEnv x y           = filterUFM x y\n\nlookupFsEnv_NF env n = expectJust \"lookupFsEnv_NF\" (lookupFsEnv env n)\n\n-- Deterministic FastStringEnv\n-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need\n-- DFastStringEnv.\n\ntype DFastStringEnv a = UniqDFM a  -- Domain is FastString\n\nemptyDFsEnv :: DFastStringEnv a\nemptyDFsEnv = emptyUDFM\n\ndFsEnvElts :: DFastStringEnv a -> [a]\ndFsEnvElts = eltsUDFM\n\nmkDFsEnv :: [(FastString,a)] -> DFastStringEnv a\nmkDFsEnv l = listToUDFM l\n\nlookupDFsEnv :: DFastStringEnv a -> FastString -> Maybe a\nlookupDFsEnv = lookupUDFM\n", "num_lines": 101}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Some extra functions to extend Data.Map\n\nmodule FiniteMap (\n        insertList,\n        insertListWith,\n        deleteList,\n        foldRight, foldRightWithKey\n    ) where\n\nimport GhcPrelude\n\nimport Data.Map (Map)\nimport qualified Data.Map as Map\n\ninsertList :: Ord key => [(key,elt)] -> Map key elt -> Map key elt\ninsertList xs m = foldl' (\\m (k, v) -> Map.insert k v m) m xs\n\ninsertListWith :: Ord key\n               => (elt -> elt -> elt)\n               -> [(key,elt)]\n               -> Map key elt\n               -> Map key elt\ninsertListWith f xs m0 = foldl' (\\m (k, v) -> Map.insertWith f k v m) m0 xs\n\ndeleteList :: Ord key => [key] -> Map key elt -> Map key elt\ndeleteList ks m = foldl' (flip Map.delete) m ks\n\nfoldRight        :: (elt -> a -> a) -> a -> Map key elt -> a\nfoldRight        = Map.foldr\nfoldRightWithKey :: (key -> elt -> a -> a) -> a -> Map key elt -> a\nfoldRightWithKey = Map.foldrWithKey\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) Bartosz Nitka, Facebook 2015\n\nUtilities for efficiently and deterministically computing free variables.\n\n-}\n\n{-# LANGUAGE BangPatterns #-}\n\nmodule FV (\n        -- * Deterministic free vars computations\n        FV, InterestingVarFun,\n\n        -- * Running the computations\n        fvVarListVarSet, fvVarList, fvVarSet, fvDVarSet,\n\n        -- ** Manipulating those computations\n        unitFV,\n        emptyFV,\n        mkFVs,\n        unionFV,\n        unionsFV,\n        delFV,\n        delFVs,\n        filterFV,\n        mapUnionFV,\n    ) where\n\nimport GhcPrelude\n\nimport Var\nimport VarSet\n\n-- | Predicate on possible free variables: returns @True@ iff the variable is\n-- interesting\ntype InterestingVarFun = Var -> Bool\n\n-- Note [Deterministic FV]\n-- ~~~~~~~~~~~~~~~~~~~~~~~\n-- When computing free variables, the order in which you get them affects\n-- the results of floating and specialization. If you use UniqFM to collect\n-- them and then turn that into a list, you get them in nondeterministic\n-- order as described in Note [Deterministic UniqFM] in UniqDFM.\n\n-- A naive algorithm for free variables relies on merging sets of variables.\n-- Merging costs O(n+m) for UniqFM and for UniqDFM there's an additional log\n-- factor. It's cheaper to incrementally add to a list and use a set to check\n-- for duplicates.\ntype FV = InterestingVarFun\n             -- Used for filtering sets as we build them\n          -> VarSet\n             -- Locally bound variables\n          -> ([Var], VarSet)\n             -- List to preserve ordering and set to check for membership,\n             -- so that the list doesn't have duplicates\n             -- For explanation of why using `VarSet` is not deterministic see\n             -- Note [Deterministic UniqFM] in UniqDFM.\n          -> ([Var], VarSet)\n\n-- Note [FV naming conventions]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- To get the performance and determinism that FV provides, FV computations\n-- need to built up from smaller FV computations and then evaluated with\n-- one of `fvVarList`, `fvDVarSet`, `fvVarListVarSet`. That means the functions\n-- returning FV need to be exported.\n--\n-- The conventions are:\n--\n-- a) non-deterministic functions:\n--   * a function that returns VarSet\n--       e.g. `tyVarsOfType`\n-- b) deterministic functions:\n--   * a worker that returns FV\n--       e.g. `tyFVsOfType`\n--   * a function that returns [Var]\n--       e.g. `tyVarsOfTypeList`\n--   * a function that returns DVarSet\n--       e.g. `tyVarsOfTypeDSet`\n--\n-- Where tyVarsOfType, tyVarsOfTypeList, tyVarsOfTypeDSet are implemented\n-- in terms of the worker evaluated with fvVarSet, fvVarList, fvDVarSet\n-- respectively.\n\n-- | Run a free variable computation, returning a list of distinct free\n-- variables in deterministic order and a non-deterministic set containing\n-- those variables.\nfvVarListVarSet :: FV ->  ([Var], VarSet)\nfvVarListVarSet fv = fv (const True) emptyVarSet ([], emptyVarSet)\n\n-- | Run a free variable computation, returning a list of distinct free\n-- variables in deterministic order.\nfvVarList :: FV -> [Var]\nfvVarList = fst . fvVarListVarSet\n\n-- | Run a free variable computation, returning a deterministic set of free\n-- variables. Note that this is just a wrapper around the version that\n-- returns a deterministic list. If you need a list you should use\n-- `fvVarList`.\nfvDVarSet :: FV -> DVarSet\nfvDVarSet = mkDVarSet . fst . fvVarListVarSet\n\n-- | Run a free variable computation, returning a non-deterministic set of\n-- free variables. Don't use if the set will be later converted to a list\n-- and the order of that list will impact the generated code.\nfvVarSet :: FV -> VarSet\nfvVarSet = snd . fvVarListVarSet\n\n-- Note [FV eta expansion]\n-- ~~~~~~~~~~~~~~~~~~~~~~~\n-- Let's consider an eta-reduced implementation of freeVarsOf using FV:\n--\n-- freeVarsOf (App a b) = freeVarsOf a `unionFV` freeVarsOf b\n--\n-- If GHC doesn't eta-expand it, after inlining unionFV we end up with\n--\n-- freeVarsOf = \\x ->\n--   case x of\n--     App a b -> \\fv_cand in_scope acc ->\n--       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc\n--\n-- which has to create a thunk, resulting in more allocations.\n--\n-- On the other hand if it is eta-expanded:\n--\n-- freeVarsOf (App a b) fv_cand in_scope acc =\n--   (freeVarsOf a `unionFV` freeVarsOf b) fv_cand in_scope acc\n--\n-- after inlining unionFV we have:\n--\n-- freeVarsOf = \\x fv_cand in_scope acc ->\n--   case x of\n--     App a b ->\n--       freeVarsOf a fv_cand in_scope $! freeVarsOf b fv_cand in_scope $! acc\n--\n-- which saves allocations.\n--\n-- GHC when presented with knowledge about all the call sites, correctly\n-- eta-expands in this case. Unfortunately due to the fact that freeVarsOf gets\n-- exported to be composed with other functions, GHC doesn't have that\n-- information and has to be more conservative here.\n--\n-- Hence functions that get exported and return FV need to be manually\n-- eta-expanded. See also #11146.\n\n-- | Add a variable - when free, to the returned free variables.\n-- Ignores duplicates and respects the filtering function.\nunitFV :: Id -> FV\nunitFV var fv_cand in_scope acc@(have, haveSet)\n  | var `elemVarSet` in_scope = acc\n  | var `elemVarSet` haveSet = acc\n  | fv_cand var = (var:have, extendVarSet haveSet var)\n  | otherwise = acc\n{-# INLINE unitFV #-}\n\n-- | Return no free variables.\nemptyFV :: FV\nemptyFV _ _ acc = acc\n{-# INLINE emptyFV #-}\n\n-- | Union two free variable computations.\nunionFV :: FV -> FV -> FV\nunionFV fv1 fv2 fv_cand in_scope acc =\n  fv1 fv_cand in_scope $! fv2 fv_cand in_scope $! acc\n{-# INLINE unionFV #-}\n\n-- | Mark the variable as not free by putting it in scope.\ndelFV :: Var -> FV -> FV\ndelFV var fv fv_cand !in_scope acc =\n  fv fv_cand (extendVarSet in_scope var) acc\n{-# INLINE delFV #-}\n\n-- | Mark many free variables as not free.\ndelFVs :: VarSet -> FV -> FV\ndelFVs vars fv fv_cand !in_scope acc =\n  fv fv_cand (in_scope `unionVarSet` vars) acc\n{-# INLINE delFVs #-}\n\n-- | Filter a free variable computation.\nfilterFV :: InterestingVarFun -> FV -> FV\nfilterFV fv_cand2 fv fv_cand1 in_scope acc =\n  fv (\\v -> fv_cand1 v && fv_cand2 v) in_scope acc\n{-# INLINE filterFV #-}\n\n-- | Map a free variable computation over a list and union the results.\nmapUnionFV :: (a -> FV) -> [a] -> FV\nmapUnionFV _f [] _fv_cand _in_scope acc = acc\nmapUnionFV f (a:as) fv_cand in_scope acc =\n  mapUnionFV f as fv_cand in_scope $! f a fv_cand in_scope $! acc\n{-# INLINABLE mapUnionFV #-}\n\n-- | Union many free variable computations.\nunionsFV :: [FV] -> FV\nunionsFV fvs fv_cand in_scope acc = mapUnionFV id fvs fv_cand in_scope acc\n{-# INLINE unionsFV #-}\n\n-- | Add multiple variables - when free, to the returned free variables.\n-- Ignores duplicates and respects the filtering function.\nmkFVs :: [Var] -> FV\nmkFVs vars fv_cand in_scope acc =\n  mapUnionFV unitFV vars fv_cand in_scope acc\n{-# INLINE mkFVs #-}\n", "num_lines": 202}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- | Custom GHC \"Prelude\"\n--\n-- This module serves as a replacement for the \"Prelude\" module\n-- and abstracts over differences between the bootstrapping\n-- GHC version, and may also provide a common default vocabulary.\n\n-- Every module in GHC\n--   * Is compiled with -XNoImplicitPrelude\n--   * Explicitly imports GhcPrelude\n\nmodule GhcPrelude (module X) where\n\n-- We export the 'Semigroup' class but w/o the (<>) operator to avoid\n-- clashing with the (Outputable.<>) operator which is heavily used\n-- through GHC's code-base.\n\nimport Prelude as X hiding ((<>))\nimport Data.Foldable as X (foldl')\n\n{-\nNote [Why do we import Prelude here?]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe files ghc-boot-th.cabal, ghc-boot.cabal, ghci.cabal and\nghc-heap.cabal contain the directive default-extensions:\nNoImplicitPrelude. There are two motivations for this:\n  - Consistency with the compiler directory, which enables\n    NoImplicitPrelude;\n  - Allows loading the above dependent packages with ghc-in-ghci,\n    giving a smoother development experience when adding new\n    extensions.\n-}\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Types for the general graph colorer.\nmodule GraphBase (\n        Triv,\n        Graph (..),\n        initGraph,\n        graphMapModify,\n\n        Node  (..),     newNode,\n)\n\n\nwhere\n\nimport GhcPrelude\n\nimport UniqSet\nimport UniqFM\n\n\n-- | A fn to check if a node is trivially colorable\n--      For graphs who's color classes are disjoint then a node is 'trivially colorable'\n--      when it has less neighbors and exclusions than available colors for that node.\n--\n--      For graph's who's color classes overlap, ie some colors alias other colors, then\n--      this can be a bit more tricky. There is a general way to calculate this, but\n--      it's likely be too slow for use in the code. The coloring algorithm takes\n--      a canned function which can be optimised by the user to be specific to the\n--      specific graph being colored.\n--\n--      for details, see  \"A Generalised Algorithm for Graph-Coloring Register Allocation\"\n--                              Smith, Ramsey, Holloway - PLDI 2004.\n--\ntype Triv k cls color\n        =  cls                  -- the class of the node we're trying to color.\n        -> UniqSet k            -- the node's neighbors.\n        -> UniqSet color        -- the node's exclusions.\n        -> Bool\n\n\n-- | The Interference graph.\n--      There used to be more fields, but they were turfed out in a previous revision.\n--      maybe we'll want more later..\n--\ndata Graph k cls color\n        = Graph {\n        -- | All active nodes in the graph.\n          graphMap              :: UniqFM (Node k cls color)  }\n\n\n-- | An empty graph.\ninitGraph :: Graph k cls color\ninitGraph\n        = Graph\n        { graphMap              = emptyUFM }\n\n\n-- | Modify the finite map holding the nodes in the graph.\ngraphMapModify\n        :: (UniqFM (Node k cls color) -> UniqFM (Node k cls color))\n        -> Graph k cls color -> Graph k cls color\n\ngraphMapModify f graph\n        = graph { graphMap      = f (graphMap graph) }\n\n\n\n-- | Graph nodes.\n--      Represents a thing that can conflict with another thing.\n--      For the register allocater the nodes represent registers.\n--\ndata Node k cls color\n        = Node {\n        -- | A unique identifier for this node.\n          nodeId                :: k\n\n        -- | The class of this node,\n        --      determines the set of colors that can be used.\n        , nodeClass             :: cls\n\n        -- | The color of this node, if any.\n        , nodeColor             :: Maybe color\n\n        -- | Neighbors which must be colored differently to this node.\n        , nodeConflicts         :: UniqSet k\n\n        -- | Colors that cannot be used by this node.\n        , nodeExclusions        :: UniqSet color\n\n        -- | Colors that this node would prefer to be, in decending order.\n        , nodePreference        :: [color]\n\n        -- | Neighbors that this node would like to be colored the same as.\n        , nodeCoalesce          :: UniqSet k }\n\n\n-- | An empty node.\nnewNode :: k -> cls -> Node k cls color\nnewNode k cls\n        = Node\n        { nodeId                = k\n        , nodeClass             = cls\n        , nodeColor             = Nothing\n        , nodeConflicts         = emptyUniqSet\n        , nodeExclusions        = emptyUniqSet\n        , nodePreference        = []\n        , nodeCoalesce          = emptyUniqSet }\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Graph Coloring.\n--      This is a generic graph coloring library, abstracted over the type of\n--      the node keys, nodes and colors.\n--\n\nmodule GraphColor (\n        module GraphBase,\n        module GraphOps,\n        module GraphPpr,\n        colorGraph\n)\n\nwhere\n\nimport GhcPrelude\n\nimport GraphBase\nimport GraphOps\nimport GraphPpr\n\nimport Unique\nimport UniqFM\nimport UniqSet\nimport Outputable\n\nimport Data.Maybe\nimport Data.List\n\n\n-- | Try to color a graph with this set of colors.\n--      Uses Chaitin's algorithm to color the graph.\n--      The graph is scanned for nodes which are deamed 'trivially colorable'. These nodes\n--      are pushed onto a stack and removed from the graph.\n--      Once this process is complete the graph can be colored by removing nodes from\n--      the stack (ie in reverse order) and assigning them colors different to their neighbors.\n--\ncolorGraph\n        :: ( Uniquable  k, Uniquable cls,  Uniquable  color\n           , Eq cls, Ord k\n           , Outputable k, Outputable cls, Outputable color)\n        => Bool                         -- ^ whether to do iterative coalescing\n        -> Int                          -- ^ how many times we've tried to color this graph so far.\n        -> UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).\n        -> Triv   k cls color           -- ^ fn to decide whether a node is trivially colorable.\n        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.\n        -> Graph  k cls color           -- ^ the graph to color.\n\n        -> ( Graph k cls color          -- the colored graph.\n           , UniqSet k                  -- the set of nodes that we couldn't find a color for.\n           , UniqFM  k )                -- map of regs (r1 -> r2) that were coalesced\n                                        --       r1 should be replaced by r2 in the source\n\ncolorGraph iterative spinCount colors triv spill graph0\n = let\n        -- If we're not doing iterative coalescing then do an aggressive coalescing first time\n        --      around and then conservative coalescing for subsequent passes.\n        --\n        --      Aggressive coalescing is a quick way to get rid of many reg-reg moves. However, if\n        --      there is a lot of register pressure and we do it on every round then it can make the\n        --      graph less colorable and prevent the algorithm from converging in a sensible number\n        --      of cycles.\n        --\n        (graph_coalesced, kksCoalesce1)\n         = if iterative\n                then (graph0, [])\n                else if spinCount == 0\n                        then coalesceGraph True  triv graph0\n                        else coalesceGraph False triv graph0\n\n        -- run the scanner to slurp out all the trivially colorable nodes\n        --      (and do coalescing if iterative coalescing is enabled)\n        (ksTriv, ksProblems, kksCoalesce2)\n                = colorScan iterative triv spill graph_coalesced\n\n        -- If iterative coalescing is enabled, the scanner will coalesce the graph as does its business.\n        --      We need to apply all the coalescences found by the scanner to the original\n        --      graph before doing assignColors.\n        --\n        --      Because we've got the whole, non-pruned graph here we turn on aggressive coalecing\n        --      to force all the (conservative) coalescences found during scanning.\n        --\n        (graph_scan_coalesced, _)\n                = mapAccumL (coalesceNodes True triv) graph_coalesced kksCoalesce2\n\n        -- color the trivially colorable nodes\n        --      during scanning, keys of triv nodes were added to the front of the list as they were found\n        --      this colors them in the reverse order, as required by the algorithm.\n        (graph_triv, ksNoTriv)\n                = assignColors colors graph_scan_coalesced ksTriv\n\n        -- try and color the problem nodes\n        --      problem nodes are the ones that were left uncolored because they weren't triv.\n        --      theres a change we can color them here anyway.\n        (graph_prob, ksNoColor)\n                = assignColors colors graph_triv ksProblems\n\n        -- if the trivially colorable nodes didn't color then something is probably wrong\n        --      with the provided triv function.\n        --\n   in   if not $ null ksNoTriv\n         then   pprPanic \"colorGraph: trivially colorable nodes didn't color!\" -- empty\n                        (  empty\n                        $$ text \"ksTriv    = \" <> ppr ksTriv\n                        $$ text \"ksNoTriv  = \" <> ppr ksNoTriv\n                        $$ text \"colors    = \" <> ppr colors\n                        $$ empty\n                        $$ dotGraph (\\_ -> text \"white\") triv graph_triv)\n\n         else   ( graph_prob\n                , mkUniqSet ksNoColor   -- the nodes that didn't color (spills)\n                , if iterative\n                        then (listToUFM kksCoalesce2)\n                        else (listToUFM kksCoalesce1))\n\n\n-- | Scan through the conflict graph separating out trivially colorable and\n--      potentially uncolorable (problem) nodes.\n--\n--      Checking whether a node is trivially colorable or not is a reasonably expensive operation,\n--      so after a triv node is found and removed from the graph it's no good to return to the 'start'\n--      of the graph and recheck a bunch of nodes that will probably still be non-trivially colorable.\n--\n--      To ward against this, during each pass through the graph we collect up a list of triv nodes\n--      that were found, and only remove them once we've finished the pass. The more nodes we can delete\n--      at once the more likely it is that nodes we've already checked will become trivially colorable\n--      for the next pass.\n--\n--      TODO:   add work lists to finding triv nodes is easier.\n--              If we've just scanned the graph, and removed triv nodes, then the only\n--              nodes that we need to rescan are the ones we've removed edges from.\n\ncolorScan\n        :: ( Uniquable k, Uniquable cls, Uniquable color\n           , Ord k,       Eq cls\n           , Outputable k, Outputable cls)\n        => Bool                         -- ^ whether to do iterative coalescing\n        -> Triv k cls color             -- ^ fn to decide whether a node is trivially colorable\n        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.\n        -> Graph k cls color            -- ^ the graph to scan\n\n        -> ([k], [k], [(k, k)])         --  triv colorable nodes, problem nodes, pairs of nodes to coalesce\n\ncolorScan iterative triv spill graph\n        = colorScan_spin iterative triv spill graph [] [] []\n\ncolorScan_spin\n        :: ( Uniquable k, Uniquable cls, Uniquable color\n           , Ord k,       Eq cls\n           , Outputable k, Outputable cls)\n        => Bool\n        -> Triv k cls color\n        -> (Graph k cls color -> k)\n        -> Graph k cls color\n        -> [k]\n        -> [k]\n        -> [(k, k)]\n        -> ([k], [k], [(k, k)])\n\ncolorScan_spin iterative triv spill graph\n        ksTriv ksSpill kksCoalesce\n\n        -- if the graph is empty then we're done\n        | isNullUFM $ graphMap graph\n        = (ksTriv, ksSpill, reverse kksCoalesce)\n\n        -- Simplify:\n        --      Look for trivially colorable nodes.\n        --      If we can find some then remove them from the graph and go back for more.\n        --\n        | nsTrivFound@(_:_)\n                <-  scanGraph   (\\node -> triv  (nodeClass node) (nodeConflicts node) (nodeExclusions node)\n\n                                  -- for iterative coalescing we only want non-move related\n                                  --    nodes here\n                                  && (not iterative || isEmptyUniqSet (nodeCoalesce node)))\n                        $ graph\n\n        , ksTrivFound   <- map nodeId nsTrivFound\n        , graph2        <- foldr (\\k g -> let Just g' = delNode k g\n                                          in  g')\n                                graph ksTrivFound\n\n        = colorScan_spin iterative triv spill graph2\n                (ksTrivFound ++ ksTriv)\n                ksSpill\n                kksCoalesce\n\n        -- Coalesce:\n        --      If we're doing iterative coalescing and no triv nodes are available\n        --      then it's time for a coalescing pass.\n        | iterative\n        = case coalesceGraph False triv graph of\n\n                -- we were able to coalesce something\n                --      go back to Simplify and see if this frees up more nodes to be trivially colorable.\n                (graph2, kksCoalesceFound@(_:_))\n                 -> colorScan_spin iterative triv spill graph2\n                        ksTriv ksSpill (reverse kksCoalesceFound ++ kksCoalesce)\n\n                -- Freeze:\n                -- nothing could be coalesced (or was triv),\n                --      time to choose a node to freeze and give up on ever coalescing it.\n                (graph2, [])\n                 -> case freezeOneInGraph graph2 of\n\n                        -- we were able to freeze something\n                        --      hopefully this will free up something for Simplify\n                        (graph3, True)\n                         -> colorScan_spin iterative triv spill graph3\n                                ksTriv ksSpill kksCoalesce\n\n                        -- we couldn't find something to freeze either\n                        --      time for a spill\n                        (graph3, False)\n                         -> colorScan_spill iterative triv spill graph3\n                                ksTriv ksSpill kksCoalesce\n\n        -- spill time\n        | otherwise\n        = colorScan_spill iterative triv spill graph\n                ksTriv ksSpill kksCoalesce\n\n\n-- Select:\n-- we couldn't find any triv nodes or things to freeze or coalesce,\n--      and the graph isn't empty yet.. We'll have to choose a spill\n--      candidate and leave it uncolored.\n--\ncolorScan_spill\n        :: ( Uniquable k, Uniquable cls, Uniquable color\n           , Ord k,       Eq cls\n           , Outputable k, Outputable cls)\n        => Bool\n        -> Triv k cls color\n        -> (Graph k cls color -> k)\n        -> Graph k cls color\n        -> [k]\n        -> [k]\n        -> [(k, k)]\n        -> ([k], [k], [(k, k)])\n\ncolorScan_spill iterative triv spill graph\n        ksTriv ksSpill kksCoalesce\n\n = let  kSpill          = spill graph\n        Just graph'     = delNode kSpill graph\n   in   colorScan_spin iterative triv spill graph'\n                ksTriv (kSpill : ksSpill) kksCoalesce\n\n\n-- | Try to assign a color to all these nodes.\n\nassignColors\n        :: ( Uniquable k, Uniquable cls, Uniquable color\n           , Outputable cls)\n        => UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).\n        -> Graph k cls color            -- ^ the graph\n        -> [k]                          -- ^ nodes to assign a color to.\n        -> ( Graph k cls color          -- the colored graph\n           , [k])                       -- the nodes that didn't color.\n\nassignColors colors graph ks\n        = assignColors' colors graph [] ks\n\n where  assignColors' _ graph prob []\n                = (graph, prob)\n\n        assignColors' colors graph prob (k:ks)\n         = case assignColor colors k graph of\n\n                -- couldn't color this node\n                Nothing         -> assignColors' colors graph (k : prob) ks\n\n                -- this node colored ok, so do the rest\n                Just graph'     -> assignColors' colors graph' prob ks\n\n\n        assignColor colors u graph\n                | Just c        <- selectColor colors graph u\n                = Just (setColor u c graph)\n\n                | otherwise\n                = Nothing\n\n\n\n-- | Select a color for a certain node\n--      taking into account preferences, neighbors and exclusions.\n--      returns Nothing if no color can be assigned to this node.\n--\nselectColor\n        :: ( Uniquable k, Uniquable cls, Uniquable color\n           , Outputable cls)\n        => UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).\n        -> Graph k cls color            -- ^ the graph\n        -> k                            -- ^ key of the node to select a color for.\n        -> Maybe color\n\nselectColor colors graph u\n = let  -- lookup the node\n        Just node       = lookupNode graph u\n\n        -- lookup the available colors for the class of this node.\n        colors_avail\n         = case lookupUFM colors (nodeClass node) of\n                Nothing -> pprPanic \"selectColor: no colors available for class \" (ppr (nodeClass node))\n                Just cs -> cs\n\n        -- find colors we can't use because they're already being used\n        --      by a node that conflicts with this one.\n        Just nsConflicts\n                        = sequence\n                        $ map (lookupNode graph)\n                        $ nonDetEltsUniqSet\n                        $ nodeConflicts node\n                        -- See Note [Unique Determinism and code generation]\n\n        colors_conflict = mkUniqSet\n                        $ catMaybes\n                        $ map nodeColor nsConflicts\n\n        -- the prefs of our neighbors\n        colors_neighbor_prefs\n                        = mkUniqSet\n                        $ concat $ map nodePreference nsConflicts\n\n        -- colors that are still valid for us\n        colors_ok_ex    = minusUniqSet colors_avail (nodeExclusions node)\n        colors_ok       = minusUniqSet colors_ok_ex colors_conflict\n\n        -- the colors that we prefer, and are still ok\n        colors_ok_pref  = intersectUniqSets\n                                (mkUniqSet $ nodePreference node) colors_ok\n\n        -- the colors that we could choose while being nice to our neighbors\n        colors_ok_nice  = minusUniqSet\n                                colors_ok colors_neighbor_prefs\n\n        -- the best of all possible worlds..\n        colors_ok_pref_nice\n                        = intersectUniqSets\n                                colors_ok_nice colors_ok_pref\n\n        -- make the decision\n        chooseColor\n\n                -- everyone is happy, yay!\n                | not $ isEmptyUniqSet colors_ok_pref_nice\n                , c : _         <- filter (\\x -> elementOfUniqSet x colors_ok_pref_nice)\n                                        (nodePreference node)\n                = Just c\n\n                -- we've got one of our preferences\n                | not $ isEmptyUniqSet colors_ok_pref\n                , c : _         <- filter (\\x -> elementOfUniqSet x colors_ok_pref)\n                                        (nodePreference node)\n                = Just c\n\n                -- it wasn't a preference, but it was still ok\n                | not $ isEmptyUniqSet colors_ok\n                , c : _         <- nonDetEltsUniqSet colors_ok\n                -- See Note [Unique Determinism and code generation]\n                = Just c\n\n                -- no colors were available for us this time.\n                --      looks like we're going around the loop again..\n                | otherwise\n                = Nothing\n\n   in   chooseColor\n\n\n\n", "num_lines": 374}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Basic operations on graphs.\n--\n\nmodule GraphOps (\n        addNode,        delNode,        getNode,       lookupNode,     modNode,\n        size,\n        union,\n        addConflict,    delConflict,    addConflicts,\n        addCoalesce,    delCoalesce,\n        addExclusion,   addExclusions,\n        addPreference,\n        coalesceNodes,  coalesceGraph,\n        freezeNode,     freezeOneInGraph, freezeAllInGraph,\n        scanGraph,\n        setColor,\n        validateGraph,\n        slurpNodeConflictCount\n)\nwhere\n\nimport GhcPrelude\n\nimport GraphBase\n\nimport Outputable\nimport Unique\nimport UniqSet\nimport UniqFM\n\nimport Data.List        hiding (union)\nimport Data.Maybe\n\n-- | Lookup a node from the graph.\nlookupNode\n        :: Uniquable k\n        => Graph k cls color\n        -> k -> Maybe (Node  k cls color)\n\nlookupNode graph k\n        = lookupUFM (graphMap graph) k\n\n\n-- | Get a node from the graph, throwing an error if it's not there\ngetNode\n        :: Uniquable k\n        => Graph k cls color\n        -> k -> Node k cls color\n\ngetNode graph k\n = case lookupUFM (graphMap graph) k of\n        Just node       -> node\n        Nothing         -> panic \"ColorOps.getNode: not found\"\n\n\n-- | Add a node to the graph, linking up its edges\naddNode :: Uniquable k\n        => k -> Node k cls color\n        -> Graph k cls color -> Graph k cls color\n\naddNode k node graph\n = let\n        -- add back conflict edges from other nodes to this one\n        map_conflict =\n          nonDetFoldUniqSet\n            -- It's OK to use nonDetFoldUFM here because the\n            -- operation is commutative\n            (adjustUFM_C (\\n -> n { nodeConflicts =\n                                      addOneToUniqSet (nodeConflicts n) k}))\n            (graphMap graph)\n            (nodeConflicts node)\n\n        -- add back coalesce edges from other nodes to this one\n        map_coalesce =\n          nonDetFoldUniqSet\n            -- It's OK to use nonDetFoldUFM here because the\n            -- operation is commutative\n            (adjustUFM_C (\\n -> n { nodeCoalesce =\n                                      addOneToUniqSet (nodeCoalesce n) k}))\n            map_conflict\n            (nodeCoalesce node)\n\n  in    graph\n        { graphMap      = addToUFM map_coalesce k node}\n\n\n-- | Delete a node and all its edges from the graph.\ndelNode :: (Uniquable k)\n        => k -> Graph k cls color -> Maybe (Graph k cls color)\n\ndelNode k graph\n        | Just node     <- lookupNode graph k\n        = let   -- delete conflict edges from other nodes to this one.\n                graph1  = foldl' (\\g k1 -> let Just g' = delConflict k1 k g in g') graph\n                        $ nonDetEltsUniqSet (nodeConflicts node)\n\n                -- delete coalesce edge from other nodes to this one.\n                graph2  = foldl' (\\g k1 -> let Just g' = delCoalesce k1 k g in g') graph1\n                        $ nonDetEltsUniqSet (nodeCoalesce node)\n                        -- See Note [Unique Determinism and code generation]\n\n                -- delete the node\n                graph3  = graphMapModify (\\fm -> delFromUFM fm k) graph2\n\n          in    Just graph3\n\n        | otherwise\n        = Nothing\n\n\n-- | Modify a node in the graph.\n--      returns Nothing if the node isn't present.\n--\nmodNode :: Uniquable k\n        => (Node k cls color -> Node k cls color)\n        -> k -> Graph k cls color -> Maybe (Graph k cls color)\n\nmodNode f k graph\n = case lookupNode graph k of\n        Just Node{}\n         -> Just\n         $  graphMapModify\n                 (\\fm   -> let  Just node       = lookupUFM fm k\n                                node'           = f node\n                           in   addToUFM fm k node')\n                graph\n\n        Nothing -> Nothing\n\n\n-- | Get the size of the graph, O(n)\nsize    :: Graph k cls color -> Int\n\nsize graph\n        = sizeUFM $ graphMap graph\n\n\n-- | Union two graphs together.\nunion   :: Graph k cls color -> Graph k cls color -> Graph k cls color\n\nunion   graph1 graph2\n        = Graph\n        { graphMap              = plusUFM (graphMap graph1) (graphMap graph2) }\n\n\n-- | Add a conflict between nodes to the graph, creating the nodes required.\n--      Conflicts are virtual regs which need to be colored differently.\naddConflict\n        :: Uniquable k\n        => (k, cls) -> (k, cls)\n        -> Graph k cls color -> Graph k cls color\n\naddConflict (u1, c1) (u2, c2)\n = let  addNeighbor u c u'\n                = adjustWithDefaultUFM\n                        (\\node -> node { nodeConflicts = addOneToUniqSet (nodeConflicts node) u' })\n                        (newNode u c)  { nodeConflicts = unitUniqSet u' }\n                        u\n\n   in   graphMapModify\n        ( addNeighbor u1 c1 u2\n        . addNeighbor u2 c2 u1)\n\n\n-- | Delete a conflict edge. k1 -> k2\n--      returns Nothing if the node isn't in the graph\ndelConflict\n        :: Uniquable k\n        => k -> k\n        -> Graph k cls color -> Maybe (Graph k cls color)\n\ndelConflict k1 k2\n        = modNode\n                (\\node -> node { nodeConflicts = delOneFromUniqSet (nodeConflicts node) k2 })\n                k1\n\n\n-- | Add some conflicts to the graph, creating nodes if required.\n--      All the nodes in the set are taken to conflict with each other.\naddConflicts\n        :: Uniquable k\n        => UniqSet k -> (k -> cls)\n        -> Graph k cls color -> Graph k cls color\n\naddConflicts conflicts getClass\n\n        -- just a single node, but no conflicts, create the node anyway.\n        | (u : [])      <- nonDetEltsUniqSet conflicts\n        = graphMapModify\n        $ adjustWithDefaultUFM\n                id\n                (newNode u (getClass u))\n                u\n\n        | otherwise\n        = graphMapModify\n        $ \\fm -> foldl' (\\g u  -> addConflictSet1 u getClass conflicts g) fm\n                $ nonDetEltsUniqSet conflicts\n                -- See Note [Unique Determinism and code generation]\n\n\naddConflictSet1 :: Uniquable k\n                => k -> (k -> cls) -> UniqSet k\n                -> UniqFM (Node k cls color)\n                -> UniqFM (Node k cls color)\naddConflictSet1 u getClass set\n = case delOneFromUniqSet set u of\n    set' -> adjustWithDefaultUFM\n                (\\node -> node                  { nodeConflicts = unionUniqSets set' (nodeConflicts node) } )\n                (newNode u (getClass u))        { nodeConflicts = set' }\n                u\n\n\n-- | Add an exclusion to the graph, creating nodes if required.\n--      These are extra colors that the node cannot use.\naddExclusion\n        :: (Uniquable k, Uniquable color)\n        => k -> (k -> cls) -> color\n        -> Graph k cls color -> Graph k cls color\n\naddExclusion u getClass color\n        = graphMapModify\n        $ adjustWithDefaultUFM\n                (\\node -> node                  { nodeExclusions = addOneToUniqSet (nodeExclusions node) color })\n                (newNode u (getClass u))        { nodeExclusions = unitUniqSet color }\n                u\n\naddExclusions\n        :: (Uniquable k, Uniquable color)\n        => k -> (k -> cls) -> [color]\n        -> Graph k cls color -> Graph k cls color\n\naddExclusions u getClass colors graph\n        = foldr (addExclusion u getClass) graph colors\n\n\n-- | Add a coalescence edge to the graph, creating nodes if requried.\n--      It is considered adventageous to assign the same color to nodes in a coalesence.\naddCoalesce\n        :: Uniquable k\n        => (k, cls) -> (k, cls)\n        -> Graph k cls color -> Graph k cls color\n\naddCoalesce (u1, c1) (u2, c2)\n = let  addCoalesce u c u'\n         =      adjustWithDefaultUFM\n                        (\\node -> node { nodeCoalesce = addOneToUniqSet (nodeCoalesce node) u' })\n                        (newNode u c)  { nodeCoalesce = unitUniqSet u' }\n                        u\n\n   in   graphMapModify\n        ( addCoalesce u1 c1 u2\n        . addCoalesce u2 c2 u1)\n\n\n-- | Delete a coalescence edge (k1 -> k2) from the graph.\ndelCoalesce\n        :: Uniquable k\n        => k -> k\n        -> Graph k cls color    -> Maybe (Graph k cls color)\n\ndelCoalesce k1 k2\n        = modNode (\\node -> node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k2 })\n                k1\n\n\n-- | Add a color preference to the graph, creating nodes if required.\n--      The most recently added preference is the most prefered.\n--      The algorithm tries to assign a node it's prefered color if possible.\n--\naddPreference\n        :: Uniquable k\n        => (k, cls) -> color\n        -> Graph k cls color -> Graph k cls color\n\naddPreference (u, c) color\n        = graphMapModify\n        $ adjustWithDefaultUFM\n                (\\node -> node { nodePreference = color : (nodePreference node) })\n                (newNode u c)  { nodePreference = [color] }\n                u\n\n\n-- | Do aggressive coalescing on this graph.\n--      returns the new graph and the list of pairs of nodes that got coalesced together.\n--      for each pair, the resulting node will have the least key and be second in the pair.\n--\ncoalesceGraph\n        :: (Uniquable k, Ord k, Eq cls, Outputable k)\n        => Bool                 -- ^ If True, coalesce nodes even if this might make the graph\n                                --      less colorable (aggressive coalescing)\n        -> Triv k cls color\n        -> Graph k cls color\n        -> ( Graph k cls color\n           , [(k, k)])          -- pairs of nodes that were coalesced, in the order that the\n                                --      coalescing was applied.\n\ncoalesceGraph aggressive triv graph\n        = coalesceGraph' aggressive triv graph []\n\ncoalesceGraph'\n        :: (Uniquable k, Ord k, Eq cls, Outputable k)\n        => Bool\n        -> Triv k cls color\n        -> Graph k cls color\n        -> [(k, k)]\n        -> ( Graph k cls color\n           , [(k, k)])\ncoalesceGraph' aggressive triv graph kkPairsAcc\n = let\n        -- find all the nodes that have coalescence edges\n        cNodes  = filter (\\node -> not $ isEmptyUniqSet (nodeCoalesce node))\n                $ nonDetEltsUFM $ graphMap graph\n                -- See Note [Unique Determinism and code generation]\n\n        -- build a list of pairs of keys for node's we'll try and coalesce\n        --      every pair of nodes will appear twice in this list\n        --      ie [(k1, k2), (k2, k1) ... ]\n        --      This is ok, GrapOps.coalesceNodes handles this and it's convenient for\n        --      build a list of what nodes get coalesced together for later on.\n        --\n        cList   = [ (nodeId node1, k2)\n                        | node1 <- cNodes\n                        , k2    <- nonDetEltsUniqSet $ nodeCoalesce node1 ]\n                        -- See Note [Unique Determinism and code generation]\n\n        -- do the coalescing, returning the new graph and a list of pairs of keys\n        --      that got coalesced together.\n        (graph', mPairs)\n                = mapAccumL (coalesceNodes aggressive triv) graph cList\n\n        -- keep running until there are no more coalesces can be found\n   in   case catMaybes mPairs of\n         []     -> (graph', reverse kkPairsAcc)\n         pairs  -> coalesceGraph' aggressive triv graph' (reverse pairs ++ kkPairsAcc)\n\n\n-- | Coalesce this pair of nodes unconditionally \\/ aggressively.\n--      The resulting node is the one with the least key.\n--\n--      returns: Just    the pair of keys if the nodes were coalesced\n--                       the second element of the pair being the least one\n--\n--               Nothing if either of the nodes weren't in the graph\n\ncoalesceNodes\n        :: (Uniquable k, Ord k, Eq cls)\n        => Bool                 -- ^ If True, coalesce nodes even if this might make the graph\n                                --      less colorable (aggressive coalescing)\n        -> Triv  k cls color\n        -> Graph k cls color\n        -> (k, k)               -- ^ keys of the nodes to be coalesced\n        -> (Graph k cls color, Maybe (k, k))\n\ncoalesceNodes aggressive triv graph (k1, k2)\n        | (kMin, kMax)  <- if k1 < k2\n                                then (k1, k2)\n                                else (k2, k1)\n\n        -- the nodes being coalesced must be in the graph\n        , Just nMin     <- lookupNode graph kMin\n        , Just nMax     <- lookupNode graph kMax\n\n        -- can't coalesce conflicting modes\n        , not $ elementOfUniqSet kMin (nodeConflicts nMax)\n        , not $ elementOfUniqSet kMax (nodeConflicts nMin)\n\n        -- can't coalesce the same node\n        , nodeId nMin /= nodeId nMax\n\n        = coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax\n\n        -- don't do the coalescing after all\n        | otherwise\n        = (graph, Nothing)\n\ncoalesceNodes_merge\n        :: (Uniquable k, Eq cls)\n        => Bool\n        -> Triv  k cls color\n        -> Graph k cls color\n        -> k -> k\n        -> Node k cls color\n        -> Node k cls color\n        -> (Graph k cls color, Maybe (k, k))\n\ncoalesceNodes_merge aggressive triv graph kMin kMax nMin nMax\n\n        -- sanity checks\n        | nodeClass nMin /= nodeClass nMax\n        = error \"GraphOps.coalesceNodes: can't coalesce nodes of different classes.\"\n\n        | not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))\n        = error \"GraphOps.coalesceNodes: can't coalesce colored nodes.\"\n\n        ---\n        | otherwise\n        = let\n                -- the new node gets all the edges from its two components\n                node    =\n                 Node   { nodeId                = kMin\n                        , nodeClass             = nodeClass nMin\n                        , nodeColor             = Nothing\n\n                        -- nodes don't conflict with themselves..\n                        , nodeConflicts\n                                = (unionUniqSets (nodeConflicts nMin) (nodeConflicts nMax))\n                                        `delOneFromUniqSet` kMin\n                                        `delOneFromUniqSet` kMax\n\n                        , nodeExclusions        = unionUniqSets (nodeExclusions nMin) (nodeExclusions nMax)\n                        , nodePreference        = nodePreference nMin ++ nodePreference nMax\n\n                        -- nodes don't coalesce with themselves..\n                        , nodeCoalesce\n                                = (unionUniqSets (nodeCoalesce nMin) (nodeCoalesce nMax))\n                                        `delOneFromUniqSet` kMin\n                                        `delOneFromUniqSet` kMax\n                        }\n\n          in    coalesceNodes_check aggressive triv graph kMin kMax node\n\ncoalesceNodes_check\n        :: Uniquable k\n        => Bool\n        -> Triv  k cls color\n        -> Graph k cls color\n        -> k -> k\n        -> Node k cls color\n        -> (Graph k cls color, Maybe (k, k))\n\ncoalesceNodes_check aggressive triv graph kMin kMax node\n\n        -- Unless we're coalescing aggressively, if the result node is not trivially\n        --      colorable then don't do the coalescing.\n        | not aggressive\n        , not $ triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)\n        = (graph, Nothing)\n\n        | otherwise\n        = let -- delete the old nodes from the graph and add the new one\n                Just graph1     = delNode kMax graph\n                Just graph2     = delNode kMin graph1\n                graph3          = addNode kMin node graph2\n\n          in    (graph3, Just (kMax, kMin))\n\n\n-- | Freeze a node\n--      This is for the iterative coalescer.\n--      By freezing a node we give up on ever coalescing it.\n--      Move all its coalesce edges into the frozen set - and update\n--      back edges from other nodes.\n--\nfreezeNode\n        :: Uniquable k\n        => k                    -- ^ key of the node to freeze\n        -> Graph k cls color    -- ^ the graph\n        -> Graph k cls color    -- ^ graph with that node frozen\n\nfreezeNode k\n  = graphMapModify\n  $ \\fm ->\n    let -- freeze all the edges in the node to be frozen\n        Just node = lookupUFM fm k\n        node'   = node\n                { nodeCoalesce          = emptyUniqSet }\n\n        fm1     = addToUFM fm k node'\n\n        -- update back edges pointing to this node\n        freezeEdge k node\n         = if elementOfUniqSet k (nodeCoalesce node)\n                then node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k }\n                else node       -- panic \"GraphOps.freezeNode: edge to freeze wasn't in the coalesce set\"\n                                -- If the edge isn't actually in the coelesce set then just ignore it.\n\n        fm2     = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1\n                    -- It's OK to use nonDetFoldUFM here because the operation\n                    -- is commutative\n                        $ nodeCoalesce node\n\n    in  fm2\n\n\n-- | Freeze one node in the graph\n--      This if for the iterative coalescer.\n--      Look for a move related node of low degree and freeze it.\n--\n--      We probably don't need to scan the whole graph looking for the node of absolute\n--      lowest degree. Just sample the first few and choose the one with the lowest\n--      degree out of those. Also, we don't make any distinction between conflicts of different\n--      classes.. this is just a heuristic, after all.\n--\n--      IDEA:   freezing a node might free it up for Simplify.. would be good to check for triv\n--              right here, and add it to a worklist if known triv\\/non-move nodes.\n--\nfreezeOneInGraph\n        :: (Uniquable k)\n        => Graph k cls color\n        -> ( Graph k cls color          -- the new graph\n           , Bool )                     -- whether we found a node to freeze\n\nfreezeOneInGraph graph\n = let  compareNodeDegree n1 n2\n                = compare (sizeUniqSet $ nodeConflicts n1) (sizeUniqSet $ nodeConflicts n2)\n\n        candidates\n                = sortBy compareNodeDegree\n                $ take 5        -- 5 isn't special, it's just a small number.\n                $ scanGraph (\\node -> not $ isEmptyUniqSet (nodeCoalesce node)) graph\n\n   in   case candidates of\n\n         -- there wasn't anything available to freeze\n         []     -> (graph, False)\n\n         -- we found something to freeze\n         (n : _)\n          -> ( freezeNode (nodeId n) graph\n             , True)\n\n\n-- | Freeze all the nodes in the graph\n--      for debugging the iterative allocator.\n--\nfreezeAllInGraph\n        :: (Uniquable k)\n        => Graph k cls color\n        -> Graph k cls color\n\nfreezeAllInGraph graph\n        = foldr freezeNode graph\n                $ map nodeId\n                $ nonDetEltsUFM $ graphMap graph\n                -- See Note [Unique Determinism and code generation]\n\n\n-- | Find all the nodes in the graph that meet some criteria\n--\nscanGraph\n        :: (Node k cls color -> Bool)\n        -> Graph k cls color\n        -> [Node k cls color]\n\nscanGraph match graph\n        = filter match $ nonDetEltsUFM $ graphMap graph\n          -- See Note [Unique Determinism and code generation]\n\n\n-- | validate the internal structure of a graph\n--      all its edges should point to valid nodes\n--      If they don't then throw an error\n--\nvalidateGraph\n        :: (Uniquable k, Outputable k, Eq color)\n        => SDoc                         -- ^ extra debugging info to display on error\n        -> Bool                         -- ^ whether this graph is supposed to be colored.\n        -> Graph k cls color            -- ^ graph to validate\n        -> Graph k cls color            -- ^ validated graph\n\nvalidateGraph doc isColored graph\n\n        -- Check that all edges point to valid nodes.\n        | edges         <- unionManyUniqSets\n                                (  (map nodeConflicts       $ nonDetEltsUFM $ graphMap graph)\n                                ++ (map nodeCoalesce        $ nonDetEltsUFM $ graphMap graph))\n\n        , nodes         <- mkUniqSet $ map nodeId $ nonDetEltsUFM $ graphMap graph\n        , badEdges      <- minusUniqSet edges nodes\n        , not $ isEmptyUniqSet badEdges\n        = pprPanic \"GraphOps.validateGraph\"\n                (  text \"Graph has edges that point to non-existent nodes\"\n                $$ text \"  bad edges: \" <> pprUFM (getUniqSet badEdges) (vcat . map ppr)\n                $$ doc )\n\n        -- Check that no conflicting nodes have the same color\n        | badNodes      <- filter (not . (checkNode graph))\n                        $ nonDetEltsUFM $ graphMap graph\n                           -- See Note [Unique Determinism and code generation]\n        , not $ null badNodes\n        = pprPanic \"GraphOps.validateGraph\"\n                (  text \"Node has same color as one of it's conflicts\"\n                $$ text \"  bad nodes: \" <> hcat (map (ppr . nodeId) badNodes)\n                $$ doc)\n\n        -- If this is supposed to be a colored graph,\n        --      check that all nodes have a color.\n        | isColored\n        , badNodes      <- filter (\\n -> isNothing $ nodeColor n)\n                        $  nonDetEltsUFM $ graphMap graph\n        , not $ null badNodes\n        = pprPanic \"GraphOps.validateGraph\"\n                (  text \"Supposably colored graph has uncolored nodes.\"\n                $$ text \"  uncolored nodes: \" <> hcat (map (ppr . nodeId) badNodes)\n                $$ doc )\n\n\n        -- graph looks ok\n        | otherwise\n        = graph\n\n\n-- | If this node is colored, check that all the nodes which\n--      conflict with it have different colors.\ncheckNode\n        :: (Uniquable k, Eq color)\n        => Graph k cls color\n        -> Node  k cls color\n        -> Bool                 -- ^ True if this node is ok\n\ncheckNode graph node\n        | Just color            <- nodeColor node\n        , Just neighbors        <- sequence $ map (lookupNode graph)\n                                $  nonDetEltsUniqSet $ nodeConflicts node\n            -- See Note [Unique Determinism and code generation]\n\n        , neighbourColors       <- catMaybes $ map nodeColor neighbors\n        , elem color neighbourColors\n        = False\n\n        | otherwise\n        = True\n\n\n\n-- | Slurp out a map of how many nodes had a certain number of conflict neighbours\n\nslurpNodeConflictCount\n        :: Graph k cls color\n        -> UniqFM (Int, Int)    -- ^ (conflict neighbours, num nodes with that many conflicts)\n\nslurpNodeConflictCount graph\n        = addListToUFM_C\n                (\\(c1, n1) (_, n2) -> (c1, n1 + n2))\n                emptyUFM\n        $ map   (\\node\n                  -> let count  = sizeUniqSet $ nodeConflicts node\n                     in  (count, (count, 1)))\n        $ nonDetEltsUFM\n        -- See Note [Unique Determinism and code generation]\n        $ graphMap graph\n\n\n-- | Set the color of a certain node\nsetColor\n        :: Uniquable k\n        => k -> color\n        -> Graph k cls color -> Graph k cls color\n\nsetColor u color\n        = graphMapModify\n        $ adjustUFM_C\n                (\\n -> n { nodeColor = Just color })\n                u\n\n\n{-# INLINE adjustWithDefaultUFM #-}\nadjustWithDefaultUFM\n        :: Uniquable k\n        => (a -> a) -> a -> k\n        -> UniqFM a -> UniqFM a\n\nadjustWithDefaultUFM f def k map\n        = addToUFM_C\n                (\\old _ -> f old)\n                map\n                k def\n\n-- Argument order different from UniqFM's adjustUFM\n{-# INLINE adjustUFM_C #-}\nadjustUFM_C\n        :: Uniquable k\n        => (a -> a)\n        -> k -> UniqFM a -> UniqFM a\n\nadjustUFM_C f k map\n = case lookupUFM map k of\n        Nothing -> map\n        Just a  -> addToUFM map k (f a)\n\n", "num_lines": 681}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | Pretty printing of graphs.\n\nmodule GraphPpr (\n        dumpGraph,\n        dotGraph\n)\nwhere\n\nimport GhcPrelude\n\nimport GraphBase\n\nimport Outputable\nimport Unique\nimport UniqSet\nimport UniqFM\n\nimport Data.List\nimport Data.Maybe\n\n\n-- | Pretty print a graph in a somewhat human readable format.\ndumpGraph\n        :: (Outputable k, Outputable color)\n        => Graph k cls color -> SDoc\n\ndumpGraph graph\n        =  text \"Graph\"\n        $$ pprUFM (graphMap graph) (vcat . map dumpNode)\n\ndumpNode\n        :: (Outputable k, Outputable color)\n        => Node k cls color -> SDoc\n\ndumpNode node\n        =  text \"Node \" <> ppr (nodeId node)\n        $$ text \"conflicts \"\n                <> parens (int (sizeUniqSet $ nodeConflicts node))\n                <> text \" = \"\n                <> ppr (nodeConflicts node)\n\n        $$ text \"exclusions \"\n                <> parens (int (sizeUniqSet $ nodeExclusions node))\n                <> text \" = \"\n                <> ppr (nodeExclusions node)\n\n        $$ text \"coalesce \"\n                <> parens (int (sizeUniqSet $ nodeCoalesce node))\n                <> text \" = \"\n                <> ppr (nodeCoalesce node)\n\n        $$ space\n\n\n\n-- | Pretty print a graph in graphviz .dot format.\n--      Conflicts get solid edges.\n--      Coalescences get dashed edges.\ndotGraph\n        :: ( Uniquable k\n           , Outputable k, Outputable cls, Outputable color)\n        => (color -> SDoc)  -- ^ What graphviz color to use for each node color\n                            --  It's usually safe to return X11 style colors here,\n                            --  ie \"red\", \"green\" etc or a hex triplet #aaff55 etc\n        -> Triv k cls color\n        -> Graph k cls color -> SDoc\n\ndotGraph colorMap triv graph\n = let  nodes   = nonDetEltsUFM $ graphMap graph\n                  -- See Note [Unique Determinism and code generation]\n   in   vcat\n                (  [ text \"graph G {\" ]\n                ++ map (dotNode colorMap triv) nodes\n                ++ (catMaybes $ snd $ mapAccumL dotNodeEdges emptyUniqSet nodes)\n                ++ [ text \"}\"\n                   , space ])\n\n\ndotNode :: ( Outputable k, Outputable cls, Outputable color)\n        => (color -> SDoc)\n        -> Triv k cls color\n        -> Node k cls color -> SDoc\n\ndotNode colorMap triv node\n = let  name    = ppr $ nodeId node\n        cls     = ppr $ nodeClass node\n\n        excludes\n                = hcat $ punctuate space\n                $ map (\\n -> text \"-\" <> ppr n)\n                $ nonDetEltsUniqSet $ nodeExclusions node\n                -- See Note [Unique Determinism and code generation]\n\n        preferences\n                = hcat $ punctuate space\n                $ map (\\n -> text \"+\" <> ppr n)\n                $ nodePreference node\n\n        expref  = if and [isEmptyUniqSet (nodeExclusions node), null (nodePreference node)]\n                        then empty\n                        else text \"\\\\n\" <> (excludes <+> preferences)\n\n        -- if the node has been colored then show that,\n        --      otherwise indicate whether it looks trivially colorable.\n        color\n                | Just c        <- nodeColor node\n                = text \"\\\\n(\" <> ppr c <> text \")\"\n\n                | triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)\n                = text \"\\\\n(\" <> text \"triv\" <> text \")\"\n\n                | otherwise\n                = text \"\\\\n(\" <> text \"spill?\" <> text \")\"\n\n        label   =  name <> text \" :: \" <> cls\n                <> expref\n                <> color\n\n        pcolorC = case nodeColor node of\n                        Nothing -> text \"style=filled fillcolor=white\"\n                        Just c  -> text \"style=filled fillcolor=\" <> doubleQuotes (colorMap c)\n\n\n        pout    = text \"node [label=\" <> doubleQuotes label <> space <> pcolorC <> text \"]\"\n                <> space <> doubleQuotes name\n                <> text \";\"\n\n in     pout\n\n\n-- | Nodes in the graph are doubly linked, but we only want one edge for each\n--      conflict if the graphviz graph. Traverse over the graph, but make sure\n--      to only print the edges for each node once.\n\ndotNodeEdges\n        :: ( Uniquable k\n           , Outputable k)\n        => UniqSet k\n        -> Node k cls color\n        -> (UniqSet k, Maybe SDoc)\n\ndotNodeEdges visited node\n        | elementOfUniqSet (nodeId node) visited\n        = ( visited\n          , Nothing)\n\n        | otherwise\n        = let   dconflicts\n                        = map (dotEdgeConflict (nodeId node))\n                        $ nonDetEltsUniqSet\n                        -- See Note [Unique Determinism and code generation]\n                        $ minusUniqSet (nodeConflicts node) visited\n\n                dcoalesces\n                        = map (dotEdgeCoalesce (nodeId node))\n                        $ nonDetEltsUniqSet\n                        -- See Note [Unique Determinism and code generation]\n                        $ minusUniqSet (nodeCoalesce node) visited\n\n                out     =  vcat dconflicts\n                        $$ vcat dcoalesces\n\n          in    ( addOneToUniqSet visited (nodeId node)\n                , Just out)\n\n        where   dotEdgeConflict u1 u2\n                        = doubleQuotes (ppr u1) <> text \" -- \" <> doubleQuotes (ppr u2)\n                        <> text \";\"\n\n                dotEdgeCoalesce u1 u2\n                        = doubleQuotes (ppr u1) <> text \" -- \" <> doubleQuotes (ppr u2)\n                        <> space <> text \"[ style = dashed ];\"\n", "num_lines": 174}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n--\n-- (c) The University of Glasgow 2002-2006\n--\n-- The IO Monad with an environment\n--\n-- The environment is passed around as a Reader monad but\n-- as its in the IO monad, mutable references can be used\n-- for updating state.\n--\n\nmodule IOEnv (\n        IOEnv, -- Instance of Monad\n\n        -- Monad utilities\n        module MonadUtils,\n\n        -- Errors\n        failM, failWithM,\n        IOEnvFailure(..),\n\n        -- Getting at the environment\n        getEnv, setEnv, updEnv,\n\n        runIOEnv, unsafeInterleaveM, uninterruptibleMaskM_,\n        tryM, tryAllM, tryMostM, fixM,\n\n        -- I/O operations\n        IORef, newMutVar, readMutVar, writeMutVar, updMutVar,\n        atomicUpdMutVar, atomicUpdMutVar'\n  ) where\n\nimport GhcPrelude\n\nimport DynFlags\nimport Exception\nimport Module\nimport Panic\n\nimport Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef,\n                          atomicModifyIORef, atomicModifyIORef' )\nimport System.IO.Unsafe ( unsafeInterleaveIO )\nimport System.IO        ( fixIO )\nimport Control.Monad\nimport qualified Control.Monad.Fail as MonadFail\nimport MonadUtils\nimport Control.Applicative (Alternative(..))\n\n----------------------------------------------------------------------\n-- Defining the monad type\n----------------------------------------------------------------------\n\n\nnewtype IOEnv env a = IOEnv (env -> IO a)\n\nunIOEnv :: IOEnv env a -> (env -> IO a)\nunIOEnv (IOEnv m) = m\n\ninstance Monad (IOEnv m) where\n    (>>=)  = thenM\n    (>>)   = (*>)\n#if !MIN_VERSION_base(4,13,0)\n    fail   = MonadFail.fail\n#endif\n\ninstance MonadFail.MonadFail (IOEnv m) where\n    fail _ = failM -- Ignore the string\n\ninstance Applicative (IOEnv m) where\n    pure = returnM\n    IOEnv f <*> IOEnv x = IOEnv (\\ env -> f env <*> x env )\n    (*>) = thenM_\n\ninstance Functor (IOEnv m) where\n    fmap f (IOEnv m) = IOEnv (\\ env -> fmap f (m env))\n\nreturnM :: a -> IOEnv env a\nreturnM a = IOEnv (\\ _ -> return a)\n\nthenM :: IOEnv env a -> (a -> IOEnv env b) -> IOEnv env b\nthenM (IOEnv m) f = IOEnv (\\ env -> do { r <- m env ;\n                                         unIOEnv (f r) env })\n\nthenM_ :: IOEnv env a -> IOEnv env b -> IOEnv env b\nthenM_ (IOEnv m) f = IOEnv (\\ env -> do { _ <- m env ; unIOEnv f env })\n\nfailM :: IOEnv env a\nfailM = IOEnv (\\ _ -> throwIO IOEnvFailure)\n\nfailWithM :: String -> IOEnv env a\nfailWithM s = IOEnv (\\ _ -> ioError (userError s))\n\ndata IOEnvFailure = IOEnvFailure\n\ninstance Show IOEnvFailure where\n    show IOEnvFailure = \"IOEnv failure\"\n\ninstance Exception IOEnvFailure\n\ninstance ExceptionMonad (IOEnv a) where\n  gcatch act handle =\n      IOEnv $ \\s -> unIOEnv act s `gcatch` \\e -> unIOEnv (handle e) s\n  gmask f =\n      IOEnv $ \\s -> gmask $ \\io_restore ->\n                             let\n                                g_restore (IOEnv m) = IOEnv $ \\s -> io_restore (m s)\n                             in\n                                unIOEnv (f g_restore) s\n\ninstance ContainsDynFlags env => HasDynFlags (IOEnv env) where\n    getDynFlags = do env <- getEnv\n                     return $! extractDynFlags env\n\ninstance ContainsModule env => HasModule (IOEnv env) where\n    getModule = do env <- getEnv\n                   return $ extractModule env\n\n----------------------------------------------------------------------\n-- Fundamental combinators specific to the monad\n----------------------------------------------------------------------\n\n\n---------------------------\nrunIOEnv :: env -> IOEnv env a -> IO a\nrunIOEnv env (IOEnv m) = m env\n\n\n---------------------------\n{-# NOINLINE fixM #-}\n  -- Aargh!  Not inlining fixM alleviates a space leak problem.\n  -- Normally fixM is used with a lazy tuple match: if the optimiser is\n  -- shown the definition of fixM, it occasionally transforms the code\n  -- in such a way that the code generator doesn't spot the selector\n  -- thunks.  Sigh.\n\nfixM :: (a -> IOEnv env a) -> IOEnv env a\nfixM f = IOEnv (\\ env -> fixIO (\\ r -> unIOEnv (f r) env))\n\n\n---------------------------\ntryM :: IOEnv env r -> IOEnv env (Either IOEnvFailure r)\n-- Reflect UserError exceptions (only) into IOEnv monad\n-- Other exceptions are not caught; they are simply propagated as exns\n--\n-- The idea is that errors in the program being compiled will give rise\n-- to UserErrors.  But, say, pattern-match failures in GHC itself should\n-- not be caught here, else they'll be reported as errors in the program\n-- begin compiled!\ntryM (IOEnv thing) = IOEnv (\\ env -> tryIOEnvFailure (thing env))\n\ntryIOEnvFailure :: IO a -> IO (Either IOEnvFailure a)\ntryIOEnvFailure = try\n\n-- XXX We shouldn't be catching everything, e.g. timeouts\ntryAllM :: IOEnv env r -> IOEnv env (Either SomeException r)\n-- Catch *all* exceptions\n-- This is used when running a Template-Haskell splice, when\n-- even a pattern-match failure is a programmer error\ntryAllM (IOEnv thing) = IOEnv (\\ env -> try (thing env))\n\ntryMostM :: IOEnv env r -> IOEnv env (Either SomeException r)\ntryMostM (IOEnv thing) = IOEnv (\\ env -> tryMost (thing env))\n\n---------------------------\nunsafeInterleaveM :: IOEnv env a -> IOEnv env a\nunsafeInterleaveM (IOEnv m) = IOEnv (\\ env -> unsafeInterleaveIO (m env))\n\nuninterruptibleMaskM_ :: IOEnv env a -> IOEnv env a\nuninterruptibleMaskM_ (IOEnv m) = IOEnv (\\ env -> uninterruptibleMask_ (m env))\n\n----------------------------------------------------------------------\n-- Alternative/MonadPlus\n----------------------------------------------------------------------\n\ninstance Alternative (IOEnv env) where\n    empty   = IOEnv (const empty)\n    m <|> n = IOEnv (\\env -> unIOEnv m env <|> unIOEnv n env)\n\ninstance MonadPlus (IOEnv env)\n\n----------------------------------------------------------------------\n-- Accessing input/output\n----------------------------------------------------------------------\n\ninstance MonadIO (IOEnv env) where\n    liftIO io = IOEnv (\\ _ -> io)\n\nnewMutVar :: a -> IOEnv env (IORef a)\nnewMutVar val = liftIO (newIORef val)\n\nwriteMutVar :: IORef a -> a -> IOEnv env ()\nwriteMutVar var val = liftIO (writeIORef var val)\n\nreadMutVar :: IORef a -> IOEnv env a\nreadMutVar var = liftIO (readIORef var)\n\nupdMutVar :: IORef a -> (a -> a) -> IOEnv env ()\nupdMutVar var upd = liftIO (modifyIORef var upd)\n\n-- | Atomically update the reference.  Does not force the evaluation of the\n-- new variable contents.  For strict update, use 'atomicUpdMutVar''.\natomicUpdMutVar :: IORef a -> (a -> (a, b)) -> IOEnv env b\natomicUpdMutVar var upd = liftIO (atomicModifyIORef var upd)\n\n-- | Strict variant of 'atomicUpdMutVar'.\natomicUpdMutVar' :: IORef a -> (a -> (a, b)) -> IOEnv env b\natomicUpdMutVar' var upd = liftIO (atomicModifyIORef' var upd)\n\n----------------------------------------------------------------------\n-- Accessing the environment\n----------------------------------------------------------------------\n\ngetEnv :: IOEnv env env\n{-# INLINE getEnv #-}\ngetEnv = IOEnv (\\ env -> return env)\n\n-- | Perform a computation with a different environment\nsetEnv :: env' -> IOEnv env' a -> IOEnv env a\n{-# INLINE setEnv #-}\nsetEnv new_env (IOEnv m) = IOEnv (\\ _ -> m new_env)\n\n-- | Perform a computation with an altered environment\nupdEnv :: (env -> env') -> IOEnv env' a -> IOEnv env a\n{-# INLINE updEnv #-}\nupdEnv upd (IOEnv m) = IOEnv (\\ env -> m (upd env))\n", "num_lines": 226}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule Json where\n\nimport GhcPrelude\n\nimport Outputable\nimport Data.Char\nimport Numeric\n\n-- | Simple data type to represent JSON documents.\ndata JsonDoc where\n  JSNull :: JsonDoc\n  JSBool :: Bool -> JsonDoc\n  JSInt  :: Int  -> JsonDoc\n  JSString :: String -> JsonDoc\n  JSArray :: [JsonDoc] -> JsonDoc\n  JSObject :: [(String, JsonDoc)] -> JsonDoc\n\n\n-- This is simple and slow as it is only used for error reporting\nrenderJSON :: JsonDoc -> SDoc\nrenderJSON d =\n  case d of\n    JSNull -> text \"null\"\n    JSBool b -> text $ if b then \"true\" else \"false\"\n    JSInt    n -> ppr n\n    JSString s -> doubleQuotes $ text $ escapeJsonString s\n    JSArray as -> brackets $ pprList renderJSON as\n    JSObject fs -> braces $ pprList renderField fs\n  where\n    renderField :: (String, JsonDoc) -> SDoc\n    renderField (s, j) = doubleQuotes (text s) <>  colon <+> renderJSON j\n\n    pprList pp xs = hcat (punctuate comma (map pp xs))\n\nescapeJsonString :: String -> String\nescapeJsonString = concatMap escapeChar\n  where\n    escapeChar '\\b' = \"\\\\b\"\n    escapeChar '\\f' = \"\\\\f\"\n    escapeChar '\\n' = \"\\\\n\"\n    escapeChar '\\r' = \"\\\\r\"\n    escapeChar '\\t' = \"\\\\t\"\n    escapeChar '\"'  = \"\\\\\\\"\"\n    escapeChar '\\\\'  = \"\\\\\\\\\"\n    escapeChar c | isControl c || fromEnum c >= 0x7f  = uni_esc c\n    escapeChar c = [c]\n\n    uni_esc c = \"\\\\u\" ++ (pad 4 (showHex (fromEnum c) \"\"))\n\n    pad n cs  | len < n   = replicate (n-len) '0' ++ cs\n                          | otherwise = cs\n                                   where len = length cs\n\nclass ToJson a where\n  json :: a -> JsonDoc\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n\n\\section[ListSetOps]{Set-like operations on lists}\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule ListSetOps (\n        unionLists, minusList, deleteBys,\n\n        -- Association lists\n        Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,\n\n        -- Duplicate handling\n        hasNoDups, removeDups, findDupsEq,\n        equivClasses,\n\n        -- Indexing\n        getNth\n   ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Outputable\nimport Util\n\nimport Data.List\nimport qualified Data.List.NonEmpty as NE\nimport Data.List.NonEmpty (NonEmpty(..))\nimport qualified Data.Set as S\n\ngetNth :: Outputable a => [a] -> Int -> a\ngetNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs )\n             xs !! n\n\ndeleteBys :: (a -> a -> Bool) -> [a] -> [a] -> [a]\n-- (deleteBys eq xs ys) returns xs-ys, using the given equality function\n-- Just like 'Data.List.delete' but with an equality function\ndeleteBys eq xs ys = foldl' (flip (deleteBy eq)) xs ys\n\n{-\n************************************************************************\n*                                                                      *\n        Treating lists as sets\n        Assumes the lists contain no duplicates, but are unordered\n*                                                                      *\n************************************************************************\n-}\n\n\nunionLists :: (Outputable a, Eq a) => [a] -> [a] -> [a]\n-- Assumes that the arguments contain no duplicates\nunionLists xs ys\n  = WARN(lengthExceeds xs 100 || lengthExceeds ys 100, ppr xs $$ ppr ys)\n    [x | x <- xs, isn'tIn \"unionLists\" x ys] ++ ys\n\n-- | Calculate the set difference of two lists. This is\n-- /O((m + n) log n)/, where we subtract a list of /n/ elements\n-- from a list of /m/ elements.\n--\n-- Extremely short cases are handled specially:\n-- When /m/ or /n/ is 0, this takes /O(1)/ time. When /m/ is 1,\n-- it takes /O(n)/ time.\nminusList :: Ord a => [a] -> [a] -> [a]\n-- There's no point building a set to perform just one lookup, so we handle\n-- extremely short lists specially. It might actually be better to use\n-- an O(m*n) algorithm when m is a little longer (perhaps up to 4 or even 5).\n-- The tipping point will be somewhere in the area of where /m/ and /log n/\n-- become comparable, but we probably don't want to work too hard on this.\nminusList [] _ = []\nminusList xs@[x] ys\n  | x `elem` ys = []\n  | otherwise = xs\n-- Using an empty set or a singleton would also be silly, so let's not.\nminusList xs [] = xs\nminusList xs [y] = filter (/= y) xs\n-- When each list has at least two elements, we build a set from the\n-- second argument, allowing us to filter the first argument fairly\n-- efficiently.\nminusList xs ys = filter (`S.notMember` yss) xs\n  where\n    yss = S.fromList ys\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-assoc]{Association lists}\n*                                                                      *\n************************************************************************\n\nInefficient finite maps based on association lists and equality.\n-}\n\n-- A finite mapping based on equality and association lists\ntype Assoc a b = [(a,b)]\n\nassoc             :: (Eq a) => String -> Assoc a b -> a -> b\nassocDefault      :: (Eq a) => b -> Assoc a b -> a -> b\nassocUsing        :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b\nassocMaybe        :: (Eq a) => Assoc a b -> a -> Maybe b\nassocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b\n\nassocDefaultUsing _  deflt []             _   = deflt\nassocDefaultUsing eq deflt ((k,v) : rest) key\n  | k `eq` key = v\n  | otherwise  = assocDefaultUsing eq deflt rest key\n\nassoc crash_msg         list key = assocDefaultUsing (==) (panic (\"Failed in assoc: \" ++ crash_msg)) list key\nassocDefault deflt      list key = assocDefaultUsing (==) deflt list key\nassocUsing eq crash_msg list key = assocDefaultUsing eq (panic (\"Failed in assoc: \" ++ crash_msg)) list key\n\nassocMaybe alist key\n  = lookup alist\n  where\n    lookup []             = Nothing\n    lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-dups]{Duplicate-handling}\n*                                                                      *\n************************************************************************\n-}\n\nhasNoDups :: (Eq a) => [a] -> Bool\n\nhasNoDups xs = f [] xs\n  where\n    f _           []     = True\n    f seen_so_far (x:xs) = if x `is_elem` seen_so_far\n                           then False\n                           else f (x:seen_so_far) xs\n\n    is_elem = isIn \"hasNoDups\"\n\nequivClasses :: (a -> a -> Ordering) -- Comparison\n             -> [a]\n             -> [NonEmpty a]\n\nequivClasses _   []      = []\nequivClasses _   [stuff] = [stuff :| []]\nequivClasses cmp items   = NE.groupBy eq (sortBy cmp items)\n  where\n    eq a b = case cmp a b of { EQ -> True; _ -> False }\n\nremoveDups :: (a -> a -> Ordering) -- Comparison function\n           -> [a]\n           -> ([a],          -- List with no duplicates\n               [NonEmpty a]) -- List of duplicate groups.  One representative\n                             -- from each group appears in the first result\n\nremoveDups _   []  = ([], [])\nremoveDups _   [x] = ([x],[])\nremoveDups cmp xs\n  = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->\n    (xs', dups) }\n  where\n    collect_dups :: [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)\n    collect_dups dups_so_far (x :| [])     = (dups_so_far,      x)\n    collect_dups dups_so_far dups@(x :| _) = (dups:dups_so_far, x)\n\nfindDupsEq :: (a->a->Bool) -> [a] -> [NonEmpty a]\nfindDupsEq _  [] = []\nfindDupsEq eq (x:xs) | null eq_xs  = findDupsEq eq xs\n                     | otherwise   = (x :| eq_xs) : findDupsEq eq neq_xs\n    where (eq_xs, neq_xs) = partition (eq x) xs\n", "num_lines": 172}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE Rank2Types #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\n-------------------------------------------------------------------------\n-- |\n-- Module      : Control.Monad.Logic\n-- Copyright   : (c) Dan Doel\n-- License     : BSD3\n--\n-- Maintainer  : dan.doel@gmail.com\n-- Stability   : experimental\n-- Portability : non-portable (multi-parameter type classes)\n--\n-- A backtracking, logic programming monad.\n--\n--    Adapted from the paper\n--    /Backtracking, Interleaving, and Terminating\n--        Monad Transformers/, by\n--    Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry\n--    (<http://www.cs.rutgers.edu/~ccshan/logicprog/ListT-icfp2005.pdf>).\n-------------------------------------------------------------------------\n\nmodule ListT (\n    ListT(..),\n    runListT,\n    select,\n    fold\n  ) where\n\nimport GhcPrelude\n\nimport Control.Applicative\n\nimport Control.Monad\nimport Control.Monad.Fail as MonadFail\n\n-------------------------------------------------------------------------\n-- | A monad transformer for performing backtracking computations\n-- layered over another monad 'm'\nnewtype ListT m a =\n    ListT { unListT :: forall r. (a -> m r -> m r) -> m r -> m r }\n\nselect :: Monad m => [a] -> ListT m a\nselect xs = foldr (<|>) mzero (map pure xs)\n\nfold :: ListT m a -> (a -> m r -> m r) -> m r -> m r\nfold = runListT\n\n-------------------------------------------------------------------------\n-- | Runs a ListT computation with the specified initial success and\n-- failure continuations.\nrunListT :: ListT m a -> (a -> m r -> m r) -> m r -> m r\nrunListT = unListT\n\ninstance Functor (ListT f) where\n    fmap f lt = ListT $ \\sk fk -> unListT lt (sk . f) fk\n\ninstance Applicative (ListT f) where\n    pure a = ListT $ \\sk fk -> sk a fk\n    f <*> a = ListT $ \\sk fk -> unListT f (\\g fk' -> unListT a (sk . g) fk') fk\n\ninstance Alternative (ListT f) where\n    empty = ListT $ \\_ fk -> fk\n    f1 <|> f2 = ListT $ \\sk fk -> unListT f1 sk (unListT f2 sk fk)\n\ninstance Monad (ListT m) where\n    m >>= f = ListT $ \\sk fk -> unListT m (\\a fk' -> unListT (f a) sk fk') fk\n#if !MIN_VERSION_base(4,13,0)\n    fail = MonadFail.fail\n#endif\n\ninstance MonadFail.MonadFail (ListT m) where\n    fail _ = ListT $ \\_ fk -> fk\n\ninstance MonadPlus (ListT m) where\n    mzero = ListT $ \\_ fk -> fk\n    m1 `mplus` m2 = ListT $ \\sk fk -> unListT m1 sk (unListT m2 sk fk)\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE FlexibleContexts #-}\n\n{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\nmodule Maybes (\n        module Data.Maybe,\n\n        MaybeErr(..), -- Instance of Monad\n        failME, isSuccess,\n\n        orElse,\n        firstJust, firstJusts,\n        whenIsJust,\n        expectJust,\n        rightToMaybe,\n\n        -- * MaybeT\n        MaybeT(..), liftMaybeT, tryMaybeT\n    ) where\n\nimport GhcPrelude\n\nimport Control.Monad\nimport Control.Monad.Trans.Maybe\nimport Control.Exception (catch, SomeException(..))\nimport Data.Maybe\nimport Util (HasCallStack)\n\ninfixr 4 `orElse`\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Maybe type]{The @Maybe@ type}\n*                                                                      *\n************************************************************************\n-}\n\nfirstJust :: Maybe a -> Maybe a -> Maybe a\nfirstJust a b = firstJusts [a, b]\n\n-- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or\n-- @Nothing@ otherwise.\nfirstJusts :: [Maybe a] -> Maybe a\nfirstJusts = msum\n\nexpectJust :: HasCallStack => String -> Maybe a -> a\n{-# INLINE expectJust #-}\nexpectJust _   (Just x) = x\nexpectJust err Nothing  = error (\"expectJust \" ++ err)\n\nwhenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()\nwhenIsJust (Just x) f = f x\nwhenIsJust Nothing  _ = return ()\n\n-- | Flipped version of @fromMaybe@, useful for chaining.\norElse :: Maybe a -> a -> a\norElse = flip fromMaybe\n\nrightToMaybe :: Either a b -> Maybe b\nrightToMaybe (Left _)  = Nothing\nrightToMaybe (Right x) = Just x\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[MaybeT type]{The @MaybeT@ monad transformer}\n*                                                                      *\n************************************************************************\n-}\n\n-- We had our own MaybeT in the past. Now we reuse transformer's MaybeT\n\nliftMaybeT :: Monad m => m a -> MaybeT m a\nliftMaybeT act = MaybeT $ Just `liftM` act\n\n-- | Try performing an 'IO' action, failing on error.\ntryMaybeT :: IO a -> MaybeT IO a\ntryMaybeT action = MaybeT $ catch (Just `fmap` action) handler\n  where\n    handler (SomeException _) = return Nothing\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[MaybeErr type]{The @MaybeErr@ type}\n*                                                                      *\n************************************************************************\n-}\n\ndata MaybeErr err val = Succeeded val | Failed err\n\ninstance Functor (MaybeErr err) where\n  fmap = liftM\n\ninstance Applicative (MaybeErr err) where\n  pure  = Succeeded\n  (<*>) = ap\n\ninstance Monad (MaybeErr err) where\n  Succeeded v >>= k = k v\n  Failed e    >>= _ = Failed e\n\nisSuccess :: MaybeErr err val -> Bool\nisSuccess (Succeeded {}) = True\nisSuccess (Failed {})    = False\n\nfailME :: err -> MaybeErr err val\nfailME e = Failed e\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Utilities related to Monad and Applicative classes\n--   Mostly for backwards compatibility.\n\nmodule MonadUtils\n        ( Applicative(..)\n        , (<$>)\n\n        , MonadFix(..)\n        , MonadIO(..)\n\n        , liftIO1, liftIO2, liftIO3, liftIO4\n\n        , zipWith3M, zipWith3M_, zipWith4M, zipWithAndUnzipM\n        , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M, mapAndUnzip5M\n        , mapAccumLM\n        , mapSndM\n        , concatMapM\n        , mapMaybeM\n        , fmapMaybeM, fmapEitherM\n        , anyM, allM, orM\n        , foldlM, foldlM_, foldrM\n        , maybeMapM\n        , whenM, unlessM\n        , filterOutM\n        ) where\n\n-------------------------------------------------------------------------------\n-- Imports\n-------------------------------------------------------------------------------\n\nimport GhcPrelude\n\nimport Control.Applicative\nimport Control.Monad\nimport Control.Monad.Fix\nimport Control.Monad.IO.Class\nimport Data.Foldable (sequenceA_)\nimport Data.List (unzip4, unzip5, zipWith4)\n\n-------------------------------------------------------------------------------\n-- Lift combinators\n--  These are used throughout the compiler\n-------------------------------------------------------------------------------\n\n-- | Lift an 'IO' operation with 1 argument into another monad\nliftIO1 :: MonadIO m => (a -> IO b) -> a -> m b\nliftIO1 = (.) liftIO\n\n-- | Lift an 'IO' operation with 2 arguments into another monad\nliftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c\nliftIO2 = ((.).(.)) liftIO\n\n-- | Lift an 'IO' operation with 3 arguments into another monad\nliftIO3 :: MonadIO m => (a -> b -> c -> IO d) -> a -> b -> c -> m d\nliftIO3 = ((.).((.).(.))) liftIO\n\n-- | Lift an 'IO' operation with 4 arguments into another monad\nliftIO4 :: MonadIO m => (a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> m e\nliftIO4 = (((.).(.)).((.).(.))) liftIO\n\n-------------------------------------------------------------------------------\n-- Common functions\n--  These are used throughout the compiler\n-------------------------------------------------------------------------------\n\n{-\n\nNote [Inline @zipWithNM@ functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe inline principle for 'zipWith3M', 'zipWith4M' and 'zipWith3M_' is the same\nas for 'zipWithM' and 'zipWithM_' in \"Control.Monad\", see\nNote [Fusion for zipN/zipWithN] in GHC/List.hs for more details.\n\nThe 'zipWithM'/'zipWithM_' functions are inlined so that the `zipWith` and\n`sequenceA` functions with which they are defined have an opportunity to fuse.\n\nFurthermore, 'zipWith3M'/'zipWith4M' and 'zipWith3M_' have been explicitly\nrewritten in a non-recursive way similarly to 'zipWithM'/'zipWithM_', and for\nmore than just uniformity: after [D5241](https://phabricator.haskell.org/D5241)\nfor Trac ticket #14037, all @zipN@/@zipWithN@ functions fuse, meaning\n'zipWith3M'/'zipWIth4M' and 'zipWith3M_'@ now behave like 'zipWithM' and\n'zipWithM_', respectively, with regards to fusion.\n\nAs such, since there are not any differences between 2-ary 'zipWithM'/\n'zipWithM_' and their n-ary counterparts below aside from the number of\narguments, the `INLINE` pragma should be replicated in the @zipWithNM@\nfunctions below as well.\n\n-}\n\nzipWith3M :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]\n{-# INLINE zipWith3M #-}\n-- Inline so that fusion with 'zipWith3' and 'sequenceA' has a chance to fire.\n-- See Note [Inline @zipWithNM@ functions] above.\nzipWith3M f xs ys zs = sequenceA (zipWith3 f xs ys zs)\n\nzipWith3M_ :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m ()\n{-# INLINE zipWith3M_ #-}\n-- Inline so that fusion with 'zipWith4' and 'sequenceA' has a chance to fire.\n-- See  Note [Inline @zipWithNM@ functions] above.\nzipWith3M_ f xs ys zs = sequenceA_ (zipWith3 f xs ys zs)\n\nzipWith4M :: Monad m => (a -> b -> c -> d -> m e)\n          -> [a] -> [b] -> [c] -> [d] -> m [e]\n{-# INLINE zipWith4M #-}\n-- Inline so that fusion with 'zipWith5' and 'sequenceA' has a chance to fire.\n-- See  Note [Inline @zipWithNM@ functions] above.\nzipWith4M f xs ys ws zs = sequenceA (zipWith4 f xs ys ws zs)\n\nzipWithAndUnzipM :: Monad m\n                 => (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])\n{-# INLINABLE zipWithAndUnzipM #-}\n-- See Note [flatten_many performance] in TcFlatten for why this\n-- pragma is essential.\nzipWithAndUnzipM f (x:xs) (y:ys)\n  = do { (c, d) <- f x y\n       ; (cs, ds) <- zipWithAndUnzipM f xs ys\n       ; return (c:cs, d:ds) }\nzipWithAndUnzipM _ _ _ = return ([], [])\n\n{-\n\nNote [Inline @mapAndUnzipNM@ functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe inline principle is the same as 'mapAndUnzipM' in \"Control.Monad\".\nThe 'mapAndUnzipM' function is inlined so that the `unzip` and `traverse`\nfunctions with which it is defined have an opportunity to fuse, see\nNote [Inline @unzipN@ functions] in Data/OldList.hs for more details.\n\nFurthermore, the @mapAndUnzipNM@ functions have been explicitly rewritten in a\nnon-recursive way similarly to 'mapAndUnzipM', and for more than just\nuniformity: after [D5249](https://phabricator.haskell.org/D5249) for Trac\nticket #14037, all @unzipN@ functions fuse, meaning 'mapAndUnzip3M',\n'mapAndUnzip4M' and 'mapAndUnzip5M' now behave like 'mapAndUnzipM' with regards\nto fusion.\n\nAs such, since there are not any differences between 2-ary 'mapAndUnzipM' and\nits n-ary counterparts below aside from the number of arguments, the `INLINE`\npragma should be replicated in the @mapAndUnzipNM@ functions below as well.\n\n-}\n\n-- | mapAndUnzipM for triples\nmapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])\n{-# INLINE mapAndUnzip3M #-}\n-- Inline so that fusion with 'unzip3' and 'traverse' has a chance to fire.\n-- See Note [Inline @mapAndUnzipNM@ functions] above.\nmapAndUnzip3M f xs =  unzip3 <$> traverse f xs\n\nmapAndUnzip4M :: Monad m => (a -> m (b,c,d,e)) -> [a] -> m ([b],[c],[d],[e])\n{-# INLINE mapAndUnzip4M #-}\n-- Inline so that fusion with 'unzip4' and 'traverse' has a chance to fire.\n-- See Note [Inline @mapAndUnzipNM@ functions] above.\nmapAndUnzip4M f xs =  unzip4 <$> traverse f xs\n\nmapAndUnzip5M :: Monad m => (a -> m (b,c,d,e,f)) -> [a] -> m ([b],[c],[d],[e],[f])\n{-# INLINE mapAndUnzip5M #-}\n-- Inline so that fusion with 'unzip5' and 'traverse' has a chance to fire.\n-- See Note [Inline @mapAndUnzipNM@ functions] above.\nmapAndUnzip5M f xs =  unzip5 <$> traverse f xs\n\n-- | Monadic version of mapAccumL\nmapAccumLM :: Monad m\n            => (acc -> x -> m (acc, y)) -- ^ combining function\n            -> acc                      -- ^ initial state\n            -> [x]                      -- ^ inputs\n            -> m (acc, [y])             -- ^ final state, outputs\nmapAccumLM _ s []     = return (s, [])\nmapAccumLM f s (x:xs) = do\n    (s1, x')  <- f s x\n    (s2, xs') <- mapAccumLM f s1 xs\n    return    (s2, x' : xs')\n\n-- | Monadic version of mapSnd\nmapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]\nmapSndM _ []         = return []\nmapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }\n\n-- | Monadic version of concatMap\nconcatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]\nconcatMapM f xs = liftM concat (mapM f xs)\n\n-- | Applicative version of mapMaybe\nmapMaybeM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b]\nmapMaybeM f = foldr g (pure [])\n  where g a = liftA2 (maybe id (:)) (f a)\n\n-- | Monadic version of fmap\nfmapMaybeM :: (Monad m) => (a -> m b) -> Maybe a -> m (Maybe b)\nfmapMaybeM _ Nothing  = return Nothing\nfmapMaybeM f (Just x) = f x >>= (return . Just)\n\n-- | Monadic version of fmap\nfmapEitherM :: Monad m => (a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)\nfmapEitherM fl _ (Left  a) = fl a >>= (return . Left)\nfmapEitherM _ fr (Right b) = fr b >>= (return . Right)\n\n-- | Monadic version of 'any', aborts the computation at the first @True@ value\nanyM :: Monad m => (a -> m Bool) -> [a] -> m Bool\nanyM _ []     = return False\nanyM f (x:xs) = do b <- f x\n                   if b then return True\n                        else anyM f xs\n\n-- | Monad version of 'all', aborts the computation at the first @False@ value\nallM :: Monad m => (a -> m Bool) -> [a] -> m Bool\nallM _ []     = return True\nallM f (b:bs) = (f b) >>= (\\bv -> if bv then allM f bs else return False)\n\n-- | Monadic version of or\norM :: Monad m => m Bool -> m Bool -> m Bool\norM m1 m2 = m1 >>= \\x -> if x then return True else m2\n\n-- | Monadic version of foldl\nfoldlM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a\nfoldlM = foldM\n\n-- | Monadic version of foldl that discards its result\nfoldlM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()\nfoldlM_ = foldM_\n\n-- | Monadic version of foldr\nfoldrM        :: (Monad m) => (b -> a -> m a) -> a -> [b] -> m a\nfoldrM _ z []     = return z\nfoldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }\n\n-- | Monadic version of fmap specialised for Maybe\nmaybeMapM :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))\nmaybeMapM _ Nothing  = return Nothing\nmaybeMapM m (Just x) = liftM Just $ m x\n\n-- | Monadic version of @when@, taking the condition in the monad\nwhenM :: Monad m => m Bool -> m () -> m ()\nwhenM mb thing = do { b <- mb\n                    ; when b thing }\n\n-- | Monadic version of @unless@, taking the condition in the monad\nunlessM :: Monad m => m Bool -> m () -> m ()\nunlessM condM acc = do { cond <- condM\n                       ; unless cond acc }\n\n-- | Like 'filterM', only it reverses the sense of the test.\nfilterOutM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]\nfilterOutM p =\n  foldr (\\ x -> liftA2 (\\ flg -> if flg then id else (x:)) (p x)) (pure [])\n", "num_lines": 248}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1993-1998\n\n\nThis is useful, general stuff for the Native Code Generator.\n\nProvide trees (of instructions), so that lists of instructions\ncan be appended in linear time.\n-}\n\nmodule OrdList (\n        OrdList,\n        nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL,\n        headOL,\n        mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL, fromOLReverse\n) where\n\nimport GhcPrelude\n\nimport Outputable\n\nimport qualified Data.Semigroup as Semigroup\n\ninfixl 5  `appOL`\ninfixl 5  `snocOL`\ninfixr 5  `consOL`\n\ndata OrdList a\n  = None\n  | One a\n  | Many [a]          -- Invariant: non-empty\n  | Cons a (OrdList a)\n  | Snoc (OrdList a) a\n  | Two (OrdList a) -- Invariant: non-empty\n        (OrdList a) -- Invariant: non-empty\n\ninstance Outputable a => Outputable (OrdList a) where\n  ppr ol = ppr (fromOL ol)  -- Convert to list and print that\n\ninstance Semigroup (OrdList a) where\n  (<>) = appOL\n\ninstance Monoid (OrdList a) where\n  mempty = nilOL\n  mappend = (Semigroup.<>)\n  mconcat = concatOL\n\ninstance Functor OrdList where\n  fmap = mapOL\n\ninstance Foldable OrdList where\n  foldr = foldrOL\n\ninstance Traversable OrdList where\n  traverse f xs = toOL <$> traverse f (fromOL xs)\n\nnilOL    :: OrdList a\nisNilOL  :: OrdList a -> Bool\n\nunitOL   :: a           -> OrdList a\nsnocOL   :: OrdList a   -> a         -> OrdList a\nconsOL   :: a           -> OrdList a -> OrdList a\nappOL    :: OrdList a   -> OrdList a -> OrdList a\nconcatOL :: [OrdList a] -> OrdList a\nheadOL   :: OrdList a   -> a\nlastOL   :: OrdList a   -> a\n\n\nnilOL        = None\nunitOL as    = One as\nsnocOL as   b    = Snoc as b\nconsOL a    bs   = Cons a bs\nconcatOL aas = foldr appOL None aas\n\nheadOL None        = panic \"headOL\"\nheadOL (One a)     = a\nheadOL (Many as)   = head as\nheadOL (Cons a _)  = a\nheadOL (Snoc as _) = headOL as\nheadOL (Two as _)  = headOL as\n\nlastOL None        = panic \"lastOL\"\nlastOL (One a)     = a\nlastOL (Many as)   = last as\nlastOL (Cons _ as) = lastOL as\nlastOL (Snoc _ a)  = a\nlastOL (Two _ as)  = lastOL as\n\nisNilOL None = True\nisNilOL _    = False\n\nNone  `appOL` b     = b\na     `appOL` None  = a\nOne a `appOL` b     = Cons a b\na     `appOL` One b = Snoc a b\na     `appOL` b     = Two a b\n\nfromOL :: OrdList a -> [a]\nfromOL a = go a []\n  where go None       acc = acc\n        go (One a)    acc = a : acc\n        go (Cons a b) acc = a : go b acc\n        go (Snoc a b) acc = go a (b:acc)\n        go (Two a b)  acc = go a (go b acc)\n        go (Many xs)  acc = xs ++ acc\n\nfromOLReverse :: OrdList a -> [a]\nfromOLReverse a = go a []\n        -- acc is already in reverse order\n  where go :: OrdList a -> [a] -> [a]\n        go None       acc = acc\n        go (One a)    acc = a : acc\n        go (Cons a b) acc = go b (a : acc)\n        go (Snoc a b) acc = b : go a acc\n        go (Two a b)  acc = go b (go a acc)\n        go (Many xs)  acc = reverse xs ++ acc\n\nmapOL :: (a -> b) -> OrdList a -> OrdList b\nmapOL _ None = None\nmapOL f (One x) = One (f x)\nmapOL f (Cons x xs) = Cons (f x) (mapOL f xs)\nmapOL f (Snoc xs x) = Snoc (mapOL f xs) (f x)\nmapOL f (Two x y) = Two (mapOL f x) (mapOL f y)\nmapOL f (Many xs) = Many (map f xs)\n\nfoldrOL :: (a->b->b) -> b -> OrdList a -> b\nfoldrOL _ z None        = z\nfoldrOL k z (One x)     = k x z\nfoldrOL k z (Cons x xs) = k x (foldrOL k z xs)\nfoldrOL k z (Snoc xs x) = foldrOL k (k x z) xs\nfoldrOL k z (Two b1 b2) = foldrOL k (foldrOL k z b2) b1\nfoldrOL k z (Many xs)   = foldr k z xs\n\nfoldlOL :: (b->a->b) -> b -> OrdList a -> b\nfoldlOL _ z None        = z\nfoldlOL k z (One x)     = k z x\nfoldlOL k z (Cons x xs) = foldlOL k (k z x) xs\nfoldlOL k z (Snoc xs x) = k (foldlOL k z xs) x\nfoldlOL k z (Two b1 b2) = foldlOL k (foldlOL k z b1) b2\nfoldlOL k z (Many xs)   = foldl k z xs\n\ntoOL :: [a] -> OrdList a\ntoOL [] = None\ntoOL [x] = One x\ntoOL xs = Many xs\n\nreverseOL :: OrdList a -> OrdList a\nreverseOL None = None\nreverseOL (One x) = One x\nreverseOL (Cons a b) = Snoc (reverseOL b) a\nreverseOL (Snoc a b) = Cons b (reverseOL a)\nreverseOL (Two a b)  = Two (reverseOL b) (reverseOL a)\nreverseOL (Many xs)  = Many (reverse xs)\n", "num_lines": 155}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nA simple homogeneous pair type with useful Functor, Applicative, and\nTraversable instances.\n-}\n\n{-# LANGUAGE CPP #-}\n\nmodule Pair ( Pair(..), unPair, toPair, swap, pLiftFst, pLiftSnd ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Outputable\nimport qualified Data.Semigroup as Semi\n\ndata Pair a = Pair { pFst :: a, pSnd :: a }\n-- Note that Pair is a *unary* type constructor\n-- whereas (,) is binary\n\n-- The important thing about Pair is that it has a *homogeneous*\n-- Functor instance, so you can easily apply the same function\n-- to both components\ninstance Functor Pair where\n  fmap f (Pair x y) = Pair (f x) (f y)\n\ninstance Applicative Pair where\n  pure x = Pair x x\n  (Pair f g) <*> (Pair x y) = Pair (f x) (g y)\n\ninstance Foldable Pair where\n  foldMap f (Pair x y) = f x `mappend` f y\n\ninstance Traversable Pair where\n  traverse f (Pair x y) = Pair <$> f x <*> f y\n\ninstance Semi.Semigroup a => Semi.Semigroup (Pair a) where\n  Pair a1 b1 <> Pair a2 b2 =  Pair (a1 Semi.<> a2) (b1 Semi.<> b2)\n\ninstance (Semi.Semigroup a, Monoid a) => Monoid (Pair a) where\n  mempty = Pair mempty mempty\n  mappend = (Semi.<>)\n\ninstance Outputable a => Outputable (Pair a) where\n  ppr (Pair a b) = ppr a <+> char '~' <+> ppr b\n\nunPair :: Pair a -> (a,a)\nunPair (Pair x y) = (x,y)\n\ntoPair :: (a,a) -> Pair a\ntoPair (x,y) = Pair x y\n\nswap :: Pair a -> Pair a\nswap (Pair x y) = Pair y x\n\npLiftFst :: (a -> a) -> Pair a -> Pair a\npLiftFst f (Pair a b) = Pair (f a) b\n\npLiftSnd :: (a -> a) -> Pair a -> Pair a\npLiftSnd f (Pair a b) = Pair a (f b)\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP Project, Glasgow University, 1992-2000\n\nDefines basic functions for printing error messages.\n\nIt's hard to put these functions anywhere else without causing\nsome unnecessary loops in the module dependency graph.\n-}\n\n{-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-}\n\nmodule Panic (\n     GhcException(..), showGhcException,\n     throwGhcException, throwGhcExceptionIO,\n     handleGhcException,\n     progName,\n     pgmError,\n\n     panic, sorry, assertPanic, trace,\n     panicDoc, sorryDoc, pgmErrorDoc,\n\n     cmdLineError, cmdLineErrorIO,\n\n     Exception.Exception(..), showException, safeShowException,\n     try, tryMost, throwTo,\n\n     withSignalHandlers,\n) where\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport {-# SOURCE #-} Outputable (SDoc, showSDocUnsafe)\n\nimport Config\nimport Exception\n\nimport Control.Monad.IO.Class\nimport Control.Concurrent\nimport Debug.Trace        ( trace )\nimport System.IO.Unsafe\nimport System.Environment\n\n#if !defined(mingw32_HOST_OS)\nimport System.Posix.Signals as S\n#endif\n\n#if defined(mingw32_HOST_OS)\nimport GHC.ConsoleHandler as S\n#endif\n\nimport GHC.Stack\nimport System.Mem.Weak  ( deRefWeak )\n\n-- | GHC's own exception type\n--   error messages all take the form:\n--\n--  @\n--      <location>: <error>\n--  @\n--\n--   If the location is on the command line, or in GHC itself, then\n--   <location>=\"ghc\".  All of the error types below correspond to\n--   a <location> of \"ghc\", except for ProgramError (where the string is\n--  assumed to contain a location already, so we don't print one).\n\ndata GhcException\n  -- | Some other fatal signal (SIGHUP,SIGTERM)\n  = Signal Int\n\n  -- | Prints the short usage msg after the error\n  | UsageError   String\n\n  -- | A problem with the command line arguments, but don't print usage.\n  | CmdLineError String\n\n  -- | The 'impossible' happened.\n  | Panic        String\n  | PprPanic     String SDoc\n\n  -- | The user tickled something that's known not to work yet,\n  --   but we're not counting it as a bug.\n  | Sorry        String\n  | PprSorry     String SDoc\n\n  -- | An installation problem.\n  | InstallationError String\n\n  -- | An error in the user's code, probably.\n  | ProgramError    String\n  | PprProgramError String SDoc\n\ninstance Exception GhcException\n\ninstance Show GhcException where\n  showsPrec _ e@(ProgramError _) = showGhcException e\n  showsPrec _ e@(CmdLineError _) = showString \"<command line>: \" . showGhcException e\n  showsPrec _ e = showString progName . showString \": \" . showGhcException e\n\n\n-- | The name of this GHC.\nprogName :: String\nprogName = unsafePerformIO (getProgName)\n{-# NOINLINE progName #-}\n\n\n-- | Short usage information to display when we are given the wrong cmd line arguments.\nshort_usage :: String\nshort_usage = \"Usage: For basic information, try the `--help' option.\"\n\n\n-- | Show an exception as a string.\nshowException :: Exception e => e -> String\nshowException = show\n\n-- | Show an exception which can possibly throw other exceptions.\n-- Used when displaying exception thrown within TH code.\nsafeShowException :: Exception e => e -> IO String\nsafeShowException e = do\n    -- ensure the whole error message is evaluated inside try\n    r <- try (return $! forceList (showException e))\n    case r of\n        Right msg -> return msg\n        Left e' -> safeShowException (e' :: SomeException)\n    where\n        forceList [] = []\n        forceList xs@(x : xt) = x `seq` forceList xt `seq` xs\n\n-- | Append a description of the given exception to this string.\n--\n-- Note that this uses 'DynFlags.unsafeGlobalDynFlags', which may have some\n-- uninitialized fields if invoked before 'GHC.initGhcMonad' has been called.\n-- If the error message to be printed includes a pretty-printer document\n-- which forces one of these fields this call may bottom.\nshowGhcException :: GhcException -> ShowS\nshowGhcException exception\n = case exception of\n        UsageError str\n         -> showString str . showChar '\\n' . showString short_usage\n\n        CmdLineError str        -> showString str\n        PprProgramError str  sdoc  ->\n            showString str . showString \"\\n\\n\" .\n            showString (showSDocUnsafe sdoc)\n        ProgramError str        -> showString str\n        InstallationError str   -> showString str\n        Signal n                -> showString \"signal: \" . shows n\n\n        PprPanic  s sdoc ->\n            panicMsg $ showString s . showString \"\\n\\n\"\n                     . showString (showSDocUnsafe sdoc)\n        Panic s -> panicMsg (showString s)\n\n        PprSorry  s sdoc ->\n            sorryMsg $ showString s . showString \"\\n\\n\"\n                     . showString (showSDocUnsafe sdoc)\n        Sorry s -> sorryMsg (showString s)\n  where\n    sorryMsg :: ShowS -> ShowS\n    sorryMsg s =\n        showString \"sorry! (unimplemented feature or known bug)\\n\"\n      . showString (\"  (GHC version \" ++ cProjectVersion ++ \" for \" ++ TargetPlatform_NAME ++ \"):\\n\\t\")\n      . s . showString \"\\n\"\n\n    panicMsg :: ShowS -> ShowS\n    panicMsg s =\n        showString \"panic! (the 'impossible' happened)\\n\"\n      . showString (\"  (GHC version \" ++ cProjectVersion ++ \" for \" ++ TargetPlatform_NAME ++ \"):\\n\\t\")\n      . s . showString \"\\n\\n\"\n      . showString \"Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug\\n\"\n\n\nthrowGhcException :: GhcException -> a\nthrowGhcException = Exception.throw\n\nthrowGhcExceptionIO :: GhcException -> IO a\nthrowGhcExceptionIO = Exception.throwIO\n\nhandleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a\nhandleGhcException = ghandle\n\n\n-- | Panics and asserts.\npanic, sorry, pgmError :: String -> a\npanic    x = unsafeDupablePerformIO $ do\n   stack <- ccsToStrings =<< getCurrentCCS x\n   if null stack\n      then throwGhcException (Panic x)\n      else throwGhcException (Panic (x ++ '\\n' : renderStack stack))\n\nsorry    x = throwGhcException (Sorry x)\npgmError x = throwGhcException (ProgramError x)\n\npanicDoc, sorryDoc, pgmErrorDoc :: String -> SDoc -> a\npanicDoc    x doc = throwGhcException (PprPanic        x doc)\nsorryDoc    x doc = throwGhcException (PprSorry        x doc)\npgmErrorDoc x doc = throwGhcException (PprProgramError x doc)\n\ncmdLineError :: String -> a\ncmdLineError = unsafeDupablePerformIO . cmdLineErrorIO\n\ncmdLineErrorIO :: String -> IO a\ncmdLineErrorIO x = do\n  stack <- ccsToStrings =<< getCurrentCCS x\n  if null stack\n    then throwGhcException (CmdLineError x)\n    else throwGhcException (CmdLineError (x ++ '\\n' : renderStack stack))\n\n\n\n-- | Throw a failed assertion exception for a given filename and line number.\nassertPanic :: String -> Int -> a\nassertPanic file line =\n  Exception.throw (Exception.AssertionFailed\n           (\"ASSERT failed! file \" ++ file ++ \", line \" ++ show line))\n\n\n-- | Like try, but pass through UserInterrupt and Panic exceptions.\n--   Used when we want soft failures when reading interface files, for example.\n--   TODO: I'm not entirely sure if this is catching what we really want to catch\ntryMost :: IO a -> IO (Either SomeException a)\ntryMost action = do r <- try action\n                    case r of\n                        Left se ->\n                            case fromException se of\n                                -- Some GhcException's we rethrow,\n                                Just (Signal _)  -> throwIO se\n                                Just (Panic _)   -> throwIO se\n                                -- others we return\n                                Just _           -> return (Left se)\n                                Nothing ->\n                                    case fromException se of\n                                        -- All IOExceptions are returned\n                                        Just (_ :: IOException) ->\n                                            return (Left se)\n                                        -- Anything else is rethrown\n                                        Nothing -> throwIO se\n                        Right v -> return (Right v)\n\n-- | We use reference counting for signal handlers\n{-# NOINLINE signalHandlersRefCount #-}\n#if !defined(mingw32_HOST_OS)\nsignalHandlersRefCount :: MVar (Word, Maybe (S.Handler,S.Handler\n                                            ,S.Handler,S.Handler))\n#else\nsignalHandlersRefCount :: MVar (Word, Maybe S.Handler)\n#endif\nsignalHandlersRefCount = unsafePerformIO $ newMVar (0,Nothing)\n\n\n-- | Temporarily install standard signal handlers for catching ^C, which just\n-- throw an exception in the current thread.\nwithSignalHandlers :: (ExceptionMonad m, MonadIO m) => m a -> m a\nwithSignalHandlers act = do\n  main_thread <- liftIO myThreadId\n  wtid <- liftIO (mkWeakThreadId main_thread)\n\n  let\n      interrupt = do\n        r <- deRefWeak wtid\n        case r of\n          Nothing -> return ()\n          Just t  -> throwTo t UserInterrupt\n\n#if !defined(mingw32_HOST_OS)\n  let installHandlers = do\n        let installHandler' a b = installHandler a b Nothing\n        hdlQUIT <- installHandler' sigQUIT  (Catch interrupt)\n        hdlINT  <- installHandler' sigINT   (Catch interrupt)\n        -- see #3656; in the future we should install these automatically for\n        -- all Haskell programs in the same way that we install a ^C handler.\n        let fatal_signal n = throwTo main_thread (Signal (fromIntegral n))\n        hdlHUP  <- installHandler' sigHUP   (Catch (fatal_signal sigHUP))\n        hdlTERM <- installHandler' sigTERM  (Catch (fatal_signal sigTERM))\n        return (hdlQUIT,hdlINT,hdlHUP,hdlTERM)\n\n  let uninstallHandlers (hdlQUIT,hdlINT,hdlHUP,hdlTERM) = do\n        _ <- installHandler sigQUIT  hdlQUIT Nothing\n        _ <- installHandler sigINT   hdlINT  Nothing\n        _ <- installHandler sigHUP   hdlHUP  Nothing\n        _ <- installHandler sigTERM  hdlTERM Nothing\n        return ()\n#else\n  -- GHC 6.3+ has support for console events on Windows\n  -- NOTE: running GHCi under a bash shell for some reason requires\n  -- you to press Ctrl-Break rather than Ctrl-C to provoke\n  -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know\n  -- why --SDM 17/12/2004\n  let sig_handler ControlC = interrupt\n      sig_handler Break    = interrupt\n      sig_handler _        = return ()\n\n  let installHandlers   = installHandler (Catch sig_handler)\n  let uninstallHandlers = installHandler -- directly install the old handler\n#endif\n\n  -- install signal handlers if necessary\n  let mayInstallHandlers = liftIO $ modifyMVar_ signalHandlersRefCount $ \\case\n        (0,Nothing)     -> do\n          hdls <- installHandlers\n          return (1,Just hdls)\n        (c,oldHandlers) -> return (c+1,oldHandlers)\n\n  -- uninstall handlers if necessary\n  let mayUninstallHandlers = liftIO $ modifyMVar_ signalHandlersRefCount $ \\case\n        (1,Just hdls)   -> do\n          _ <- uninstallHandlers hdls\n          return (0,Nothing)\n        (c,oldHandlers) -> return (c-1,oldHandlers)\n\n  mayInstallHandlers\n  act `gfinally` mayUninstallHandlers\n", "num_lines": 314}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | A description of the platform we're compiling for.\n--\nmodule Platform (\n        Platform(..),\n        Arch(..),\n        OS(..),\n        ArmISA(..),\n        ArmISAExt(..),\n        ArmABI(..),\n        PPC_64ABI(..),\n\n        target32Bit,\n        isARM,\n        osElfTarget,\n        osMachOTarget,\n        osSubsectionsViaSymbols,\n        platformUsesFrameworks,\n)\n\nwhere\n\nimport GhcPrelude\n\n-- | Contains enough information for the native code generator to emit\n--      code for this platform.\ndata Platform\n        = Platform {\n              platformArch                     :: Arch,\n              platformOS                       :: OS,\n              -- Word size in bytes (i.e. normally 4 or 8,\n              -- for 32bit and 64bit platforms respectively)\n              platformWordSize                 :: {-# UNPACK #-} !Int,\n              platformUnregisterised           :: Bool,\n              platformHasGnuNonexecStack       :: Bool,\n              platformHasIdentDirective        :: Bool,\n              platformHasSubsectionsViaSymbols :: Bool,\n              platformIsCrossCompiling         :: Bool\n          }\n        deriving (Read, Show, Eq)\n\n\n-- | Architectures that the native code generator knows about.\n--      TODO: It might be nice to extend these constructors with information\n--      about what instruction set extensions an architecture might support.\n--\ndata Arch\n        = ArchUnknown\n        | ArchX86\n        | ArchX86_64\n        | ArchPPC\n        | ArchPPC_64\n          { ppc_64ABI :: PPC_64ABI\n          }\n        | ArchSPARC\n        | ArchSPARC64\n        | ArchARM\n          { armISA    :: ArmISA\n          , armISAExt :: [ArmISAExt]\n          , armABI    :: ArmABI\n          }\n        | ArchARM64\n        | ArchAlpha\n        | ArchMipseb\n        | ArchMipsel\n        | ArchJavaScript\n        deriving (Read, Show, Eq)\n\nisARM :: Arch -> Bool\nisARM (ArchARM {}) = True\nisARM ArchARM64    = True\nisARM _ = False\n\n-- | Operating systems that the native code generator knows about.\n--      Having OSUnknown should produce a sensible default, but no promises.\ndata OS\n        = OSUnknown\n        | OSLinux\n        | OSDarwin\n        | OSSolaris2\n        | OSMinGW32\n        | OSFreeBSD\n        | OSDragonFly\n        | OSOpenBSD\n        | OSNetBSD\n        | OSKFreeBSD\n        | OSHaiku\n        | OSQNXNTO\n        | OSAIX\n        | OSHurd\n        deriving (Read, Show, Eq)\n\n-- | ARM Instruction Set Architecture, Extensions and ABI\n--\ndata ArmISA\n    = ARMv5\n    | ARMv6\n    | ARMv7\n    deriving (Read, Show, Eq)\n\ndata ArmISAExt\n    = VFPv2\n    | VFPv3\n    | VFPv3D16\n    | NEON\n    | IWMMX2\n    deriving (Read, Show, Eq)\n\ndata ArmABI\n    = SOFT\n    | SOFTFP\n    | HARD\n    deriving (Read, Show, Eq)\n\n-- | PowerPC 64-bit ABI\n--\ndata PPC_64ABI\n    = ELF_V1\n    | ELF_V2\n    deriving (Read, Show, Eq)\n\n-- | This predicate tells us whether the platform is 32-bit.\ntarget32Bit :: Platform -> Bool\ntarget32Bit p = platformWordSize p == 4\n\n-- | This predicate tells us whether the OS supports ELF-like shared libraries.\nosElfTarget :: OS -> Bool\nosElfTarget OSLinux     = True\nosElfTarget OSFreeBSD   = True\nosElfTarget OSDragonFly = True\nosElfTarget OSOpenBSD   = True\nosElfTarget OSNetBSD    = True\nosElfTarget OSSolaris2  = True\nosElfTarget OSDarwin    = False\nosElfTarget OSMinGW32   = False\nosElfTarget OSKFreeBSD  = True\nosElfTarget OSHaiku     = True\nosElfTarget OSQNXNTO    = False\nosElfTarget OSAIX       = False\nosElfTarget OSHurd      = True\nosElfTarget OSUnknown   = False\n -- Defaulting to False is safe; it means don't rely on any\n -- ELF-specific functionality.  It is important to have a default for\n -- portability, otherwise we have to answer this question for every\n -- new platform we compile on (even unreg).\n\n-- | This predicate tells us whether the OS support Mach-O shared libraries.\nosMachOTarget :: OS -> Bool\nosMachOTarget OSDarwin = True\nosMachOTarget _ = False\n\nosUsesFrameworks :: OS -> Bool\nosUsesFrameworks OSDarwin = True\nosUsesFrameworks _        = False\n\nplatformUsesFrameworks :: Platform -> Bool\nplatformUsesFrameworks = osUsesFrameworks . platformOS\n\nosSubsectionsViaSymbols :: OS -> Bool\nosSubsectionsViaSymbols OSDarwin = True\nosSubsectionsViaSymbols _        = False\n\n", "num_lines": 163}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module PprColour where\nimport GhcPrelude\n\nimport Data.Maybe (fromMaybe)\nimport Util (OverridingBool(..), split)\nimport Data.Semigroup as Semi\n\n-- | A colour\\/style for use with 'coloured'.\nnewtype PprColour = PprColour { renderColour :: String }\n\ninstance Semi.Semigroup PprColour where\n  PprColour s1 <> PprColour s2 = PprColour (s1 <> s2)\n\n-- | Allow colours to be combined (e.g. bold + red);\n--   In case of conflict, right side takes precedence.\ninstance Monoid PprColour where\n  mempty = PprColour mempty\n  mappend = (<>)\n\nrenderColourAfresh :: PprColour -> String\nrenderColourAfresh c = renderColour (colReset `mappend` c)\n\ncolCustom :: String -> PprColour\ncolCustom \"\" = mempty\ncolCustom s  = PprColour (\"\\27[\" ++ s ++ \"m\")\n\ncolReset :: PprColour\ncolReset = colCustom \"0\"\n\ncolBold :: PprColour\ncolBold = colCustom \";1\"\n\ncolBlackFg :: PprColour\ncolBlackFg = colCustom \"30\"\n\ncolRedFg :: PprColour\ncolRedFg = colCustom \"31\"\n\ncolGreenFg :: PprColour\ncolGreenFg = colCustom \"32\"\n\ncolYellowFg :: PprColour\ncolYellowFg = colCustom \"33\"\n\ncolBlueFg :: PprColour\ncolBlueFg = colCustom \"34\"\n\ncolMagentaFg :: PprColour\ncolMagentaFg = colCustom \"35\"\n\ncolCyanFg :: PprColour\ncolCyanFg = colCustom \"36\"\n\ncolWhiteFg :: PprColour\ncolWhiteFg = colCustom \"37\"\n\ndata Scheme =\n  Scheme\n  { sHeader  :: PprColour\n  , sMessage :: PprColour\n  , sWarning :: PprColour\n  , sError   :: PprColour\n  , sFatal   :: PprColour\n  , sMargin  :: PprColour\n  }\n\ndefaultScheme :: Scheme\ndefaultScheme =\n  Scheme\n  { sHeader  = mempty\n  , sMessage = colBold\n  , sWarning = colBold `mappend` colMagentaFg\n  , sError   = colBold `mappend` colRedFg\n  , sFatal   = colBold `mappend` colRedFg\n  , sMargin  = colBold `mappend` colBlueFg\n  }\n\n-- | Parse the colour scheme from a string (presumably from the @GHC_COLORS@\n-- environment variable).\nparseScheme :: String -> (OverridingBool, Scheme) -> (OverridingBool, Scheme)\nparseScheme \"always\" (_, cs) = (Always, cs)\nparseScheme \"auto\"   (_, cs) = (Auto,   cs)\nparseScheme \"never\"  (_, cs) = (Never,  cs)\nparseScheme input    (b, cs) =\n  ( b\n  , Scheme\n    { sHeader  = fromMaybe (sHeader cs)  (lookup \"header\" table)\n    , sMessage = fromMaybe (sMessage cs) (lookup \"message\" table)\n    , sWarning = fromMaybe (sWarning cs) (lookup \"warning\" table)\n    , sError   = fromMaybe (sError cs)   (lookup \"error\"   table)\n    , sFatal   = fromMaybe (sFatal cs)   (lookup \"fatal\"   table)\n    , sMargin  = fromMaybe (sMargin cs)  (lookup \"margin\"  table)\n    }\n  )\n  where\n    table = do\n      w <- split ':' input\n      let (k, v') = break (== '=') w\n      case v' of\n        '=' : v -> return (k, colCustom v)\n        _ -> []\n", "num_lines": 102}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Pretty\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  David Terei <code@davidterei.com>\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- John Hughes's and Simon Peyton Jones's Pretty Printer Combinators\n--\n-- Based on /The Design of a Pretty-printing Library/\n-- in Advanced Functional Programming,\n-- Johan Jeuring and Erik Meijer (eds), LNCS 925\n-- <http://www.cs.chalmers.se/~rjmh/Papers/pretty.ps>\n--\n-----------------------------------------------------------------------------\n\n{-\nNote [Differences between libraries/pretty and compiler/utils/Pretty.hs]\n\nFor historical reasons, there are two different copies of `Pretty` in the GHC\nsource tree:\n * `libraries/pretty` is a submodule containing\n   https://github.com/haskell/pretty. This is the `pretty` library as released\n   on hackage. It is used by several other libraries in the GHC source tree\n   (e.g. template-haskell and Cabal).\n * `compiler/utils/Pretty.hs` (this module). It is used by GHC only.\n\nThere is an ongoing effort in https://github.com/haskell/pretty/issues/1 and\nhttps://ghc.haskell.org/trac/ghc/ticket/10735 to try to get rid of GHC's copy\nof Pretty.\n\nCurrently, GHC's copy of Pretty resembles pretty-1.1.2.0, with the following\nmajor differences:\n * GHC's copy uses `Faststring` for performance reasons.\n * GHC's copy has received a backported bugfix for #12227, which was\n   released as pretty-1.1.3.4 (\"Remove harmful $! forcing in beside\",\n   https://github.com/haskell/pretty/pull/35).\n\nOther differences are minor. Both copies define some extra functions and\ninstances not defined in the other copy. To see all differences, do this in a\nghc git tree:\n\n    $ cd libraries/pretty\n    $ git checkout v1.1.2.0\n    $ cd -\n    $ vimdiff compiler/utils/Pretty.hs \\\n              libraries/pretty/src/Text/PrettyPrint/HughesPJ.hs\n\nFor parity with `pretty-1.1.2.1`, the following two `pretty` commits would\nhave to be backported:\n  * \"Resolve foldr-strictness stack overflow bug\"\n    (307b8173f41cd776eae8f547267df6d72bff2d68)\n  * \"Special-case reduce for horiz/vert\"\n    (c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c)\nThis has not been done sofar, because these commits seem to cause more\nallocation in the compiler (see thomie's comments in\nhttps://github.com/haskell/pretty/pull/9).\n-}\n\nmodule Pretty (\n\n        -- * The document type\n        Doc, TextDetails(..),\n\n        -- * Constructing documents\n\n        -- ** Converting values into documents\n        char, text, ftext, ptext, ztext, sizedText, zeroWidthText,\n        int, integer, float, double, rational, hex,\n\n        -- ** Simple derived documents\n        semi, comma, colon, space, equals,\n        lparen, rparen, lbrack, rbrack, lbrace, rbrace,\n\n        -- ** Wrapping documents in delimiters\n        parens, brackets, braces, quotes, quote, doubleQuotes,\n        maybeParens,\n\n        -- ** Combining documents\n        empty,\n        (<>), (<+>), hcat, hsep,\n        ($$), ($+$), vcat,\n        sep, cat,\n        fsep, fcat,\n        nest,\n        hang, hangNotEmpty, punctuate,\n\n        -- * Predicates on documents\n        isEmpty,\n\n        -- * Rendering documents\n\n        -- ** Rendering with a particular style\n        Style(..),\n        style,\n        renderStyle,\n        Mode(..),\n\n        -- ** General rendering\n        fullRender, txtPrinter,\n\n        -- ** GHC-specific rendering\n        printDoc, printDoc_,\n        bufLeftRender -- performance hack\n\n  ) where\n\nimport GhcPrelude hiding (error)\n\nimport BufWrite\nimport FastString\nimport Panic\nimport System.IO\nimport Numeric (showHex)\n\n--for a RULES\nimport GHC.Base ( unpackCString#, unpackNBytes#, Int(..) )\nimport GHC.Ptr  ( Ptr(..) )\n\n-- Don't import Util( assertPanic ) because it makes a loop in the module structure\n\n\n-- ---------------------------------------------------------------------------\n-- The Doc calculus\n\n{-\nLaws for $$\n~~~~~~~~~~~\n<a1>    (x $$ y) $$ z   = x $$ (y $$ z)\n<a2>    empty $$ x      = x\n<a3>    x $$ empty      = x\n\n        ...ditto $+$...\n\nLaws for <>\n~~~~~~~~~~~\n<b1>    (x <> y) <> z   = x <> (y <> z)\n<b2>    empty <> x      = empty\n<b3>    x <> empty      = x\n\n        ...ditto <+>...\n\nLaws for text\n~~~~~~~~~~~~~\n<t1>    text s <> text t        = text (s++t)\n<t2>    text \"\" <> x            = x, if x non-empty\n\n** because of law n6, t2 only holds if x doesn't\n** start with `nest'.\n\n\nLaws for nest\n~~~~~~~~~~~~~\n<n1>    nest 0 x                = x\n<n2>    nest k (nest k' x)      = nest (k+k') x\n<n3>    nest k (x <> y)         = nest k x <> nest k y\n<n4>    nest k (x $$ y)         = nest k x $$ nest k y\n<n5>    nest k empty            = empty\n<n6>    x <> nest k y           = x <> y, if x non-empty\n\n** Note the side condition on <n6>!  It is this that\n** makes it OK for empty to be a left unit for <>.\n\nMiscellaneous\n~~~~~~~~~~~~~\n<m1>    (text s <> x) $$ y = text s <> ((text \"\" <> x) $$\n                                         nest (-length s) y)\n\n<m2>    (x $$ y) <> z = x $$ (y <> z)\n        if y non-empty\n\n\nLaws for list versions\n~~~~~~~~~~~~~~~~~~~~~~\n<l1>    sep (ps++[empty]++qs)   = sep (ps ++ qs)\n        ...ditto hsep, hcat, vcat, fill...\n\n<l2>    nest k (sep ps) = sep (map (nest k) ps)\n        ...ditto hsep, hcat, vcat, fill...\n\nLaws for oneLiner\n~~~~~~~~~~~~~~~~~\n<o1>    oneLiner (nest k p) = nest k (oneLiner p)\n<o2>    oneLiner (x <> y)   = oneLiner x <> oneLiner y\n\nYou might think that the following version of <m1> would\nbe neater:\n\n<3 NO>  (text s <> x) $$ y = text s <> ((empty <> x)) $$\n                                         nest (-length s) y)\n\nBut it doesn't work, for if x=empty, we would have\n\n        text s $$ y = text s <> (empty $$ nest (-length s) y)\n                    = text s <> nest (-length s) y\n-}\n\n-- ---------------------------------------------------------------------------\n-- Operator fixity\n\ninfixl 6 <>\ninfixl 6 <+>\ninfixl 5 $$, $+$\n\n\n-- ---------------------------------------------------------------------------\n-- The Doc data type\n\n-- | The abstract type of documents.\n-- A Doc represents a *set* of layouts. A Doc with\n-- no occurrences of Union or NoDoc represents just one layout.\ndata Doc\n  = Empty                                            -- empty\n  | NilAbove Doc                                     -- text \"\" $$ x\n  | TextBeside !TextDetails {-# UNPACK #-} !Int Doc  -- text s <> x\n  | Nest {-# UNPACK #-} !Int Doc                     -- nest k x\n  | Union Doc Doc                                    -- ul `union` ur\n  | NoDoc                                            -- The empty set of documents\n  | Beside Doc Bool Doc                              -- True <=> space between\n  | Above Doc Bool Doc                               -- True <=> never overlap\n\n{-\nHere are the invariants:\n\n1) The argument of NilAbove is never Empty. Therefore\n   a NilAbove occupies at least two lines.\n\n2) The argument of @TextBeside@ is never @Nest@.\n\n3) The layouts of the two arguments of @Union@ both flatten to the same\n   string.\n\n4) The arguments of @Union@ are either @TextBeside@, or @NilAbove@.\n\n5) A @NoDoc@ may only appear on the first line of the left argument of an\n   union. Therefore, the right argument of an union can never be equivalent\n   to the empty set (@NoDoc@).\n\n6) An empty document is always represented by @Empty@.  It can't be\n   hidden inside a @Nest@, or a @Union@ of two @Empty@s.\n\n7) The first line of every layout in the left argument of @Union@ is\n   longer than the first line of any layout in the right argument.\n   (1) ensures that the left argument has a first line.  In view of\n   (3), this invariant means that the right argument must have at\n   least two lines.\n\nNotice the difference between\n   * NoDoc (no documents)\n   * Empty (one empty document; no height and no width)\n   * text \"\" (a document containing the empty string;\n              one line high, but has no width)\n-}\n\n\n-- | RDoc is a \"reduced GDoc\", guaranteed not to have a top-level Above or Beside.\ntype RDoc = Doc\n\n-- | The TextDetails data type\n--\n-- A TextDetails represents a fragment of text that will be\n-- output at some point.\ndata TextDetails = Chr  {-# UNPACK #-} !Char -- ^ A single Char fragment\n                 | Str  String -- ^ A whole String fragment\n                 | PStr FastString                      -- a hashed string\n                 | ZStr FastZString                     -- a z-encoded string\n                 | LStr {-# UNPACK #-} !PtrString\n                   -- a '\\0'-terminated array of bytes\n                 | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char\n                   -- a repeated character (e.g., ' ')\n\ninstance Show Doc where\n  showsPrec _ doc cont = fullRender (mode style) (lineLength style)\n                                    (ribbonsPerLine style)\n                                    txtPrinter cont doc\n\n\n-- ---------------------------------------------------------------------------\n-- Values and Predicates on GDocs and TextDetails\n\n-- | A document of height and width 1, containing a literal character.\nchar :: Char -> Doc\nchar c = textBeside_ (Chr c) 1 Empty\n\n-- | A document of height 1 containing a literal string.\n-- 'text' satisfies the following laws:\n--\n-- * @'text' s '<>' 'text' t = 'text' (s'++'t)@\n--\n-- * @'text' \\\"\\\" '<>' x = x@, if @x@ non-empty\n--\n-- The side condition on the last law is necessary because @'text' \\\"\\\"@\n-- has height 1, while 'empty' has no height.\ntext :: String -> Doc\ntext s = textBeside_ (Str s) (length s) Empty\n{-# NOINLINE [0] text #-}   -- Give the RULE a chance to fire\n                            -- It must wait till after phase 1 when\n                            -- the unpackCString first is manifested\n\n-- RULE that turns (text \"abc\") into (ptext (A# \"abc\"#)) to avoid the\n-- intermediate packing/unpacking of the string.\n{-# RULES \"text/str\"\n    forall a. text (unpackCString# a)  = ptext (mkPtrString# a)\n  #-}\n{-# RULES \"text/unpackNBytes#\"\n    forall p n. text (unpackNBytes# p n) = ptext (PtrString (Ptr p) (I# n))\n  #-}\n\nftext :: FastString -> Doc\nftext s = textBeside_ (PStr s) (lengthFS s) Empty\n\nptext :: PtrString -> Doc\nptext s = textBeside_ (LStr s) (lengthPS s) Empty\n\nztext :: FastZString -> Doc\nztext s = textBeside_ (ZStr s) (lengthFZS s) Empty\n\n-- | Some text with any width. (@text s = sizedText (length s) s@)\nsizedText :: Int -> String -> Doc\nsizedText l s = textBeside_ (Str s) l Empty\n\n-- | Some text, but without any width. Use for non-printing text\n-- such as a HTML or Latex tags\nzeroWidthText :: String -> Doc\nzeroWidthText = sizedText 0\n\n-- | The empty document, with no height and no width.\n-- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere\n-- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.\nempty :: Doc\nempty = Empty\n\n-- | Returns 'True' if the document is empty\nisEmpty :: Doc -> Bool\nisEmpty Empty = True\nisEmpty _     = False\n\n{-\nQ: What is the reason for negative indentation (i.e. argument to indent\n   is < 0) ?\n\nA:\nThis indicates an error in the library client's code.\nIf we compose a <> b, and the first line of b is more indented than some\nother lines of b, the law <n6> (<> eats nests) may cause the pretty\nprinter to produce an invalid layout:\n\ndoc       |0123345\n------------------\nd1        |a...|\nd2        |...b|\n          |c...|\n\nd1<>d2    |ab..|\n         c|....|\n\nConsider a <> b, let `s' be the length of the last line of `a', `k' the\nindentation of the first line of b, and `k0' the indentation of the\nleft-most line b_i of b.\n\nThe produced layout will have negative indentation if `k - k0 > s', as\nthe first line of b will be put on the (s+1)th column, effectively\ntranslating b horizontally by (k-s). Now if the i^th line of b has an\nindentation k0 < (k-s), it is translated out-of-page, causing\n`negative indentation'.\n-}\n\n\nsemi   :: Doc -- ^ A ';' character\ncomma  :: Doc -- ^ A ',' character\ncolon  :: Doc -- ^ A ':' character\nspace  :: Doc -- ^ A space character\nequals :: Doc -- ^ A '=' character\nlparen :: Doc -- ^ A '(' character\nrparen :: Doc -- ^ A ')' character\nlbrack :: Doc -- ^ A '[' character\nrbrack :: Doc -- ^ A ']' character\nlbrace :: Doc -- ^ A '{' character\nrbrace :: Doc -- ^ A '}' character\nsemi   = char ';'\ncomma  = char ','\ncolon  = char ':'\nspace  = char ' '\nequals = char '='\nlparen = char '('\nrparen = char ')'\nlbrack = char '['\nrbrack = char ']'\nlbrace = char '{'\nrbrace = char '}'\n\nspaceText, nlText :: TextDetails\nspaceText = Chr ' '\nnlText    = Chr '\\n'\n\nint      :: Int      -> Doc -- ^ @int n = text (show n)@\ninteger  :: Integer  -> Doc -- ^ @integer n = text (show n)@\nfloat    :: Float    -> Doc -- ^ @float n = text (show n)@\ndouble   :: Double   -> Doc -- ^ @double n = text (show n)@\nrational :: Rational -> Doc -- ^ @rational n = text (show n)@\nhex      :: Integer  -> Doc -- ^ See Note [Print Hexadecimal Literals]\nint      n = text (show n)\ninteger  n = text (show n)\nfloat    n = text (show n)\ndouble   n = text (show n)\nrational n = text (show n)\nhex      n = text ('0' : 'x' : padded)\n    where\n    str = showHex n \"\"\n    strLen = max 1 (length str)\n    len = 2 ^ (ceiling (logBase 2 (fromIntegral strLen :: Double)) :: Int)\n    padded = replicate (len - strLen) '0' ++ str\n\nparens       :: Doc -> Doc -- ^ Wrap document in @(...)@\nbrackets     :: Doc -> Doc -- ^ Wrap document in @[...]@\nbraces       :: Doc -> Doc -- ^ Wrap document in @{...}@\nquotes       :: Doc -> Doc -- ^ Wrap document in @\\'...\\'@\nquote        :: Doc -> Doc\ndoubleQuotes :: Doc -> Doc -- ^ Wrap document in @\\\"...\\\"@\nquotes p       = char '`' <> p <> char '\\''\nquote p        = char '\\'' <> p\ndoubleQuotes p = char '\"' <> p <> char '\"'\nparens p       = char '(' <> p <> char ')'\nbrackets p     = char '[' <> p <> char ']'\nbraces p       = char '{' <> p <> char '}'\n\n{-\nNote [Print Hexadecimal Literals]\n\nRelevant discussions:\n * Phabricator: https://phabricator.haskell.org/D4465\n * GHC Trac: https://ghc.haskell.org/trac/ghc/ticket/14872\n\nThere is a flag `-dword-hex-literals` that causes literals of\ntype `Word#` or `Word64#` to be displayed in hexadecimal instead\nof decimal when dumping GHC core. It also affects the presentation\nof these in GHC's error messages. Additionally, the hexadecimal\nencoding of these numbers is zero-padded so that its length is\na power of two. As an example of what this does,\nconsider the following haskell file `Literals.hs`:\n\n    module Literals where\n\n    alpha :: Int\n    alpha = 100 + 200\n\n    beta :: Word -> Word\n    beta x = x + div maxBound 255 + div 0xFFFFFFFF 255 + 0x0202\n\nWe get the following dumped core when we compile on a 64-bit\nmachine with ghc -O2 -fforce-recomp -ddump-simpl -dsuppress-all\n-dhex-word-literals literals.hs:\n\n    ==================== Tidy Core ====================\n\n    ... omitted for brevity ...\n\n    -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}\n    alpha\n    alpha = I# 300#\n\n    -- RHS size: {terms: 12, types: 3, coercions: 0, joins: 0/0}\n    beta\n    beta\n      = \\ x_aYE ->\n          case x_aYE of { W# x#_a1v0 ->\n          W#\n            (plusWord#\n               (plusWord# (plusWord# x#_a1v0 0x0101010101010101##) 0x01010101##)\n               0x0202##)\n          }\n\nNotice that the word literals are in hexadecimals and that they have\nbeen padded with zeroes so that their lengths are 16, 8, and 4, respectively.\n\n-}\n\n-- | Apply 'parens' to 'Doc' if boolean is true.\nmaybeParens :: Bool -> Doc -> Doc\nmaybeParens False = id\nmaybeParens True = parens\n\n-- ---------------------------------------------------------------------------\n-- Structural operations on GDocs\n\n-- | Perform some simplification of a built up @GDoc@.\nreduceDoc :: Doc -> RDoc\nreduceDoc (Beside p g q) = p `seq` g `seq` (beside p g $! reduceDoc q)\nreduceDoc (Above  p g q) = p `seq` g `seq` (above  p g $! reduceDoc q)\nreduceDoc p              = p\n\n-- | List version of '<>'.\nhcat :: [Doc] -> Doc\nhcat = reduceAB . foldr (beside_' False) empty\n\n-- | List version of '<+>'.\nhsep :: [Doc] -> Doc\nhsep = reduceAB . foldr (beside_' True)  empty\n\n-- | List version of '$$'.\nvcat :: [Doc] -> Doc\nvcat = reduceAB . foldr (above_' False) empty\n\n-- | Nest (or indent) a document by a given number of positions\n-- (which may also be negative).  'nest' satisfies the laws:\n--\n-- * @'nest' 0 x = x@\n--\n-- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@\n--\n-- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@\n--\n-- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@\n--\n-- * @'nest' k 'empty' = 'empty'@\n--\n-- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty\n--\n-- The side condition on the last law is needed because\n-- 'empty' is a left identity for '<>'.\nnest :: Int -> Doc -> Doc\nnest k p = mkNest k (reduceDoc p)\n\n-- | @hang d1 n d2 = sep [d1, nest n d2]@\nhang :: Doc -> Int -> Doc -> Doc\nhang d1 n d2 = sep [d1, nest n d2]\n\n-- | Apply 'hang' to the arguments if the first 'Doc' is not empty.\nhangNotEmpty :: Doc -> Int -> Doc -> Doc\nhangNotEmpty d1 n d2 = if isEmpty d1\n                       then d2\n                       else hang d1 n d2\n\n-- | @punctuate p [d1, ... dn] = [d1 \\<> p, d2 \\<> p, ... dn-1 \\<> p, dn]@\npunctuate :: Doc -> [Doc] -> [Doc]\npunctuate _ []     = []\npunctuate p (x:xs) = go x xs\n                   where go y []     = [y]\n                         go y (z:zs) = (y <> p) : go z zs\n\n-- mkNest checks for Nest's invariant that it doesn't have an Empty inside it\nmkNest :: Int -> Doc -> Doc\nmkNest k _ | k `seq` False = undefined\nmkNest k (Nest k1 p)       = mkNest (k + k1) p\nmkNest _ NoDoc             = NoDoc\nmkNest _ Empty             = Empty\nmkNest 0 p                 = p\nmkNest k p                 = nest_ k p\n\n-- mkUnion checks for an empty document\nmkUnion :: Doc -> Doc -> Doc\nmkUnion Empty _ = Empty\nmkUnion p q     = p `union_` q\n\nbeside_' :: Bool -> Doc -> Doc -> Doc\nbeside_' _ p Empty = p\nbeside_' g p q     = Beside p g q\n\nabove_' :: Bool -> Doc -> Doc -> Doc\nabove_' _ p Empty = p\nabove_' g p q     = Above p g q\n\nreduceAB :: Doc -> Doc\nreduceAB (Above  Empty _ q) = q\nreduceAB (Beside Empty _ q) = q\nreduceAB doc                = doc\n\nnilAbove_ :: RDoc -> RDoc\nnilAbove_ = NilAbove\n\n-- Arg of a TextBeside is always an RDoc\ntextBeside_ :: TextDetails -> Int -> RDoc -> RDoc\ntextBeside_ = TextBeside\n\nnest_ :: Int -> RDoc -> RDoc\nnest_ = Nest\n\nunion_ :: RDoc -> RDoc -> RDoc\nunion_ = Union\n\n\n-- ---------------------------------------------------------------------------\n-- Vertical composition @$$@\n\n-- | Above, except that if the last line of the first argument stops\n-- at least one position before the first line of the second begins,\n-- these two lines are overlapped.  For example:\n--\n-- >    text \"hi\" $$ nest 5 (text \"there\")\n--\n-- lays out as\n--\n-- >    hi   there\n--\n-- rather than\n--\n-- >    hi\n-- >         there\n--\n-- '$$' is associative, with identity 'empty', and also satisfies\n--\n-- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.\n--\n($$) :: Doc -> Doc -> Doc\np $$  q = above_ p False q\n\n-- | Above, with no overlapping.\n-- '$+$' is associative, with identity 'empty'.\n($+$) :: Doc -> Doc -> Doc\np $+$ q = above_ p True q\n\nabove_ :: Doc -> Bool -> Doc -> Doc\nabove_ p _ Empty = p\nabove_ Empty _ q = q\nabove_ p g q     = Above p g q\n\nabove :: Doc -> Bool -> RDoc -> RDoc\nabove (Above p g1 q1)  g2 q2 = above p g1 (above q1 g2 q2)\nabove p@(Beside{})     g  q  = aboveNest (reduceDoc p) g 0 (reduceDoc q)\nabove p g q                  = aboveNest p             g 0 (reduceDoc q)\n\n-- Specification: aboveNest p g k q = p $g$ (nest k q)\naboveNest :: RDoc -> Bool -> Int -> RDoc -> RDoc\naboveNest _                   _ k _ | k `seq` False = undefined\naboveNest NoDoc               _ _ _ = NoDoc\naboveNest (p1 `Union` p2)     g k q = aboveNest p1 g k q `union_`\n                                      aboveNest p2 g k q\n\naboveNest Empty               _ k q = mkNest k q\naboveNest (Nest k1 p)         g k q = nest_ k1 (aboveNest p g (k - k1) q)\n                                  -- p can't be Empty, so no need for mkNest\n\naboveNest (NilAbove p)        g k q = nilAbove_ (aboveNest p g k q)\naboveNest (TextBeside s sl p) g k q = textBeside_ s sl rest\n                                    where\n                                      !k1  = k - sl\n                                      rest = case p of\n                                                Empty -> nilAboveNest g k1 q\n                                                _     -> aboveNest  p g k1 q\naboveNest (Above {})          _ _ _ = error \"aboveNest Above\"\naboveNest (Beside {})         _ _ _ = error \"aboveNest Beside\"\n\n-- Specification: text s <> nilaboveNest g k q\n--              = text s <> (text \"\" $g$ nest k q)\nnilAboveNest :: Bool -> Int -> RDoc -> RDoc\nnilAboveNest _ k _           | k `seq` False = undefined\nnilAboveNest _ _ Empty       = Empty\n                               -- Here's why the \"text s <>\" is in the spec!\nnilAboveNest g k (Nest k1 q) = nilAboveNest g (k + k1) q\nnilAboveNest g k q           | not g && k > 0      -- No newline if no overlap\n                             = textBeside_ (RStr k ' ') k q\n                             | otherwise           -- Put them really above\n                             = nilAbove_ (mkNest k q)\n\n\n-- ---------------------------------------------------------------------------\n-- Horizontal composition @<>@\n\n-- We intentionally avoid Data.Monoid.(<>) here due to interactions of\n-- Data.Monoid.(<>) and (<+>).  See\n-- http://www.haskell.org/pipermail/libraries/2011-November/017066.html\n\n-- | Beside.\n-- '<>' is associative, with identity 'empty'.\n(<>) :: Doc -> Doc -> Doc\np <>  q = beside_ p False q\n\n-- | Beside, separated by space, unless one of the arguments is 'empty'.\n-- '<+>' is associative, with identity 'empty'.\n(<+>) :: Doc -> Doc -> Doc\np <+> q = beside_ p True  q\n\nbeside_ :: Doc -> Bool -> Doc -> Doc\nbeside_ p _ Empty = p\nbeside_ Empty _ q = q\nbeside_ p g q     = Beside p g q\n\n-- Specification: beside g p q = p <g> q\nbeside :: Doc -> Bool -> RDoc -> RDoc\nbeside NoDoc               _ _   = NoDoc\nbeside (p1 `Union` p2)     g q   = beside p1 g q `union_` beside p2 g q\nbeside Empty               _ q   = q\nbeside (Nest k p)          g q   = nest_ k $! beside p g q\nbeside p@(Beside p1 g1 q1) g2 q2\n         | g1 == g2              = beside p1 g1 $! beside q1 g2 q2\n         | otherwise             = beside (reduceDoc p) g2 q2\nbeside p@(Above{})         g q   = let !d = reduceDoc p in beside d g q\nbeside (NilAbove p)        g q   = nilAbove_ $! beside p g q\nbeside (TextBeside s sl p) g q   = textBeside_ s sl rest\n                               where\n                                  rest = case p of\n                                           Empty -> nilBeside g q\n                                           _     -> beside p g q\n\n-- Specification: text \"\" <> nilBeside g p\n--              = text \"\" <g> p\nnilBeside :: Bool -> RDoc -> RDoc\nnilBeside _ Empty         = Empty -- Hence the text \"\" in the spec\nnilBeside g (Nest _ p)    = nilBeside g p\nnilBeside g p | g         = textBeside_ spaceText 1 p\n              | otherwise = p\n\n\n-- ---------------------------------------------------------------------------\n-- Separate, @sep@\n\n-- Specification: sep ps  = oneLiner (hsep ps)\n--                         `union`\n--                          vcat ps\n\n-- | Either 'hsep' or 'vcat'.\nsep  :: [Doc] -> Doc\nsep = sepX True   -- Separate with spaces\n\n-- | Either 'hcat' or 'vcat'.\ncat :: [Doc] -> Doc\ncat = sepX False  -- Don't\n\nsepX :: Bool -> [Doc] -> Doc\nsepX _ []     = empty\nsepX x (p:ps) = sep1 x (reduceDoc p) 0 ps\n\n\n-- Specification: sep1 g k ys = sep (x : map (nest k) ys)\n--                            = oneLiner (x <g> nest k (hsep ys))\n--                              `union` x $$ nest k (vcat ys)\nsep1 :: Bool -> RDoc -> Int -> [Doc] -> RDoc\nsep1 _ _                   k _  | k `seq` False = undefined\nsep1 _ NoDoc               _ _  = NoDoc\nsep1 g (p `Union` q)       k ys = sep1 g p k ys `union_`\n                                  aboveNest q False k (reduceDoc (vcat ys))\n\nsep1 g Empty               k ys = mkNest k (sepX g ys)\nsep1 g (Nest n p)          k ys = nest_ n (sep1 g p (k - n) ys)\n\nsep1 _ (NilAbove p)        k ys = nilAbove_\n                                  (aboveNest p False k (reduceDoc (vcat ys)))\nsep1 g (TextBeside s sl p) k ys = textBeside_ s sl (sepNB g p (k - sl) ys)\nsep1 _ (Above {})          _ _  = error \"sep1 Above\"\nsep1 _ (Beside {})         _ _  = error \"sep1 Beside\"\n\n-- Specification: sepNB p k ys = sep1 (text \"\" <> p) k ys\n-- Called when we have already found some text in the first item\n-- We have to eat up nests\nsepNB :: Bool -> Doc -> Int -> [Doc] -> Doc\nsepNB g (Nest _ p) k ys\n  = sepNB g p k ys -- Never triggered, because of invariant (2)\nsepNB g Empty k ys\n  = oneLiner (nilBeside g (reduceDoc rest)) `mkUnion`\n    -- XXX: TODO: PRETTY: Used to use True here (but GHC used False...)\n    nilAboveNest False k (reduceDoc (vcat ys))\n  where\n    rest | g         = hsep ys\n         | otherwise = hcat ys\nsepNB g p k ys\n  = sep1 g p k ys\n\n\n-- ---------------------------------------------------------------------------\n-- @fill@\n\n-- | \\\"Paragraph fill\\\" version of 'cat'.\nfcat :: [Doc] -> Doc\nfcat = fill False\n\n-- | \\\"Paragraph fill\\\" version of 'sep'.\nfsep :: [Doc] -> Doc\nfsep = fill True\n\n-- Specification:\n--\n-- fill g docs = fillIndent 0 docs\n--\n-- fillIndent k [] = []\n-- fillIndent k [p] = p\n-- fillIndent k (p1:p2:ps) =\n--    oneLiner p1 <g> fillIndent (k + length p1 + g ? 1 : 0)\n--                               (remove_nests (oneLiner p2) : ps)\n--     `Union`\n--    (p1 $*$ nest (-k) (fillIndent 0 ps))\n--\n-- $*$ is defined for layouts (not Docs) as\n-- layout1 $*$ layout2 | hasMoreThanOneLine layout1 = layout1 $$ layout2\n--                     | otherwise                  = layout1 $+$ layout2\n\nfill :: Bool -> [Doc] -> RDoc\nfill _ []     = empty\nfill g (p:ps) = fill1 g (reduceDoc p) 0 ps\n\nfill1 :: Bool -> RDoc -> Int -> [Doc] -> Doc\nfill1 _ _                   k _  | k `seq` False = undefined\nfill1 _ NoDoc               _ _  = NoDoc\nfill1 g (p `Union` q)       k ys = fill1 g p k ys `union_`\n                                   aboveNest q False k (fill g ys)\nfill1 g Empty               k ys = mkNest k (fill g ys)\nfill1 g (Nest n p)          k ys = nest_ n (fill1 g p (k - n) ys)\nfill1 g (NilAbove p)        k ys = nilAbove_ (aboveNest p False k (fill g ys))\nfill1 g (TextBeside s sl p) k ys = textBeside_ s sl (fillNB g p (k - sl) ys)\nfill1 _ (Above {})          _ _  = error \"fill1 Above\"\nfill1 _ (Beside {})         _ _  = error \"fill1 Beside\"\n\nfillNB :: Bool -> Doc -> Int -> [Doc] -> Doc\nfillNB _ _           k _  | k `seq` False = undefined\nfillNB g (Nest _ p)  k ys   = fillNB g p k ys\n                              -- Never triggered, because of invariant (2)\nfillNB _ Empty _ []         = Empty\nfillNB g Empty k (Empty:ys) = fillNB g Empty k ys\nfillNB g Empty k (y:ys)     = fillNBE g k y ys\nfillNB g p k ys             = fill1 g p k ys\n\n\nfillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc\nfillNBE g k y ys\n  = nilBeside g (fill1 g ((elideNest . oneLiner . reduceDoc) y) k' ys)\n    -- XXX: TODO: PRETTY: Used to use True here (but GHC used False...)\n    `mkUnion` nilAboveNest False k (fill g (y:ys))\n  where k' = if g then k - 1 else k\n\nelideNest :: Doc -> Doc\nelideNest (Nest _ d) = d\nelideNest d          = d\n\n-- ---------------------------------------------------------------------------\n-- Selecting the best layout\n\nbest :: Int   -- Line length\n     -> Int   -- Ribbon length\n     -> RDoc\n     -> RDoc  -- No unions in here!\nbest w0 r = get w0\n  where\n    get :: Int          -- (Remaining) width of line\n        -> Doc -> Doc\n    get w _ | w == 0 && False = undefined\n    get _ Empty               = Empty\n    get _ NoDoc               = NoDoc\n    get w (NilAbove p)        = nilAbove_ (get w p)\n    get w (TextBeside s sl p) = textBeside_ s sl (get1 w sl p)\n    get w (Nest k p)          = nest_ k (get (w - k) p)\n    get w (p `Union` q)       = nicest w r (get w p) (get w q)\n    get _ (Above {})          = error \"best get Above\"\n    get _ (Beside {})         = error \"best get Beside\"\n\n    get1 :: Int         -- (Remaining) width of line\n         -> Int         -- Amount of first line already eaten up\n         -> Doc         -- This is an argument to TextBeside => eat Nests\n         -> Doc         -- No unions in here!\n\n    get1 w _ _ | w == 0 && False  = undefined\n    get1 _ _  Empty               = Empty\n    get1 _ _  NoDoc               = NoDoc\n    get1 w sl (NilAbove p)        = nilAbove_ (get (w - sl) p)\n    get1 w sl (TextBeside t tl p) = textBeside_ t tl (get1 w (sl + tl) p)\n    get1 w sl (Nest _ p)          = get1 w sl p\n    get1 w sl (p `Union` q)       = nicest1 w r sl (get1 w sl p)\n                                                   (get1 w sl q)\n    get1 _ _  (Above {})          = error \"best get1 Above\"\n    get1 _ _  (Beside {})         = error \"best get1 Beside\"\n\nnicest :: Int -> Int -> Doc -> Doc -> Doc\nnicest !w !r = nicest1 w r 0\n\nnicest1 :: Int -> Int -> Int -> Doc -> Doc -> Doc\nnicest1 !w !r !sl p q | fits ((w `min` r) - sl) p = p\n                      | otherwise                 = q\n\nfits :: Int  -- Space available\n     -> Doc\n     -> Bool -- True if *first line* of Doc fits in space available\nfits n _ | n < 0           = False\nfits _ NoDoc               = False\nfits _ Empty               = True\nfits _ (NilAbove _)        = True\nfits n (TextBeside _ sl p) = fits (n - sl) p\nfits _ (Above {})          = error \"fits Above\"\nfits _ (Beside {})         = error \"fits Beside\"\nfits _ (Union {})          = error \"fits Union\"\nfits _ (Nest {})           = error \"fits Nest\"\n\n-- | @first@ returns its first argument if it is non-empty, otherwise its second.\nfirst :: Doc -> Doc -> Doc\nfirst p q | nonEmptySet p = p -- unused, because (get OneLineMode) is unused\n          | otherwise     = q\n\nnonEmptySet :: Doc -> Bool\nnonEmptySet NoDoc              = False\nnonEmptySet (_ `Union` _)      = True\nnonEmptySet Empty              = True\nnonEmptySet (NilAbove _)       = True\nnonEmptySet (TextBeside _ _ p) = nonEmptySet p\nnonEmptySet (Nest _ p)         = nonEmptySet p\nnonEmptySet (Above {})         = error \"nonEmptySet Above\"\nnonEmptySet (Beside {})        = error \"nonEmptySet Beside\"\n\n-- @oneLiner@ returns the one-line members of the given set of @GDoc@s.\noneLiner :: Doc -> Doc\noneLiner NoDoc               = NoDoc\noneLiner Empty               = Empty\noneLiner (NilAbove _)        = NoDoc\noneLiner (TextBeside s sl p) = textBeside_ s sl (oneLiner p)\noneLiner (Nest k p)          = nest_ k (oneLiner p)\noneLiner (p `Union` _)       = oneLiner p\noneLiner (Above {})          = error \"oneLiner Above\"\noneLiner (Beside {})         = error \"oneLiner Beside\"\n\n\n-- ---------------------------------------------------------------------------\n-- Rendering\n\n-- | A rendering style.\ndata Style\n  = Style { mode           :: Mode  -- ^ The rendering mode\n          , lineLength     :: Int   -- ^ Length of line, in chars\n          , ribbonsPerLine :: Float -- ^ Ratio of line length to ribbon length\n          }\n\n-- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@).\nstyle :: Style\nstyle = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode }\n\n-- | Rendering mode.\ndata Mode = PageMode     -- ^ Normal\n          | ZigZagMode   -- ^ With zig-zag cuts\n          | LeftMode     -- ^ No indentation, infinitely long lines\n          | OneLineMode  -- ^ All on one line\n\n-- | Render the @Doc@ to a String using the given @Style@.\nrenderStyle :: Style -> Doc -> String\nrenderStyle s = fullRender (mode s) (lineLength s) (ribbonsPerLine s)\n                txtPrinter \"\"\n\n-- | Default TextDetails printer\ntxtPrinter :: TextDetails -> String -> String\ntxtPrinter (Chr c)    s  = c:s\ntxtPrinter (Str s1)   s2 = s1 ++ s2\ntxtPrinter (PStr s1)  s2 = unpackFS s1 ++ s2\ntxtPrinter (ZStr s1)  s2 = zString s1 ++ s2\ntxtPrinter (LStr s1)  s2 = unpackPtrString s1 ++ s2\ntxtPrinter (RStr n c) s2 = replicate n c ++ s2\n\n-- | The general rendering interface.\nfullRender :: Mode                     -- ^ Rendering mode\n           -> Int                      -- ^ Line length\n           -> Float                    -- ^ Ribbons per line\n           -> (TextDetails -> a -> a)  -- ^ What to do with text\n           -> a                        -- ^ What to do at the end\n           -> Doc                      -- ^ The document\n           -> a                        -- ^ Result\nfullRender OneLineMode _ _ txt end doc\n  = easyDisplay spaceText (\\_ y -> y) txt end (reduceDoc doc)\nfullRender LeftMode    _ _ txt end doc\n  = easyDisplay nlText first txt end (reduceDoc doc)\n\nfullRender m lineLen ribbons txt rest doc\n  = display m lineLen ribbonLen txt rest doc'\n  where\n    doc' = best bestLineLen ribbonLen (reduceDoc doc)\n\n    bestLineLen, ribbonLen :: Int\n    ribbonLen   = round (fromIntegral lineLen / ribbons)\n    bestLineLen = case m of\n                      ZigZagMode -> maxBound\n                      _          -> lineLen\n\neasyDisplay :: TextDetails\n             -> (Doc -> Doc -> Doc)\n             -> (TextDetails -> a -> a)\n             -> a\n             -> Doc\n             -> a\neasyDisplay nlSpaceText choose txt end\n  = lay\n  where\n    lay NoDoc              = error \"easyDisplay: NoDoc\"\n    lay (Union p q)        = lay (choose p q)\n    lay (Nest _ p)         = lay p\n    lay Empty              = end\n    lay (NilAbove p)       = nlSpaceText `txt` lay p\n    lay (TextBeside s _ p) = s `txt` lay p\n    lay (Above {})         = error \"easyDisplay Above\"\n    lay (Beside {})        = error \"easyDisplay Beside\"\n\ndisplay :: Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a\ndisplay m !page_width !ribbon_width txt end doc\n  = case page_width - ribbon_width of { gap_width ->\n    case gap_width `quot` 2 of { shift ->\n    let\n        lay k _            | k `seq` False = undefined\n        lay k (Nest k1 p)  = lay (k + k1) p\n        lay _ Empty        = end\n        lay k (NilAbove p) = nlText `txt` lay k p\n        lay k (TextBeside s sl p)\n            = case m of\n                    ZigZagMode |  k >= gap_width\n                               -> nlText `txt` (\n                                  Str (replicate shift '/') `txt` (\n                                  nlText `txt`\n                                  lay1 (k - shift) s sl p ))\n\n                               |  k < 0\n                               -> nlText `txt` (\n                                  Str (replicate shift '\\\\') `txt` (\n                                  nlText `txt`\n                                  lay1 (k + shift) s sl p ))\n\n                    _ -> lay1 k s sl p\n        lay _ (Above {})   = error \"display lay Above\"\n        lay _ (Beside {})  = error \"display lay Beside\"\n        lay _ NoDoc        = error \"display lay NoDoc\"\n        lay _ (Union {})   = error \"display lay Union\"\n\n        lay1 !k s !sl p    = let !r = k + sl\n                             in indent k (s `txt` lay2 r p)\n\n        lay2 k _ | k `seq` False   = undefined\n        lay2 k (NilAbove p)        = nlText `txt` lay k p\n        lay2 k (TextBeside s sl p) = s `txt` lay2 (k + sl) p\n        lay2 k (Nest _ p)          = lay2 k p\n        lay2 _ Empty               = end\n        lay2 _ (Above {})          = error \"display lay2 Above\"\n        lay2 _ (Beside {})         = error \"display lay2 Beside\"\n        lay2 _ NoDoc               = error \"display lay2 NoDoc\"\n        lay2 _ (Union {})          = error \"display lay2 Union\"\n\n        indent !n r                = RStr n ' ' `txt` r\n    in\n    lay 0 doc\n    }}\n\nprintDoc :: Mode -> Int -> Handle -> Doc -> IO ()\n-- printDoc adds a newline to the end\nprintDoc mode cols hdl doc = printDoc_ mode cols hdl (doc $$ text \"\")\n\nprintDoc_ :: Mode -> Int -> Handle -> Doc -> IO ()\n-- printDoc_ does not add a newline at the end, so that\n-- successive calls can output stuff on the same line\n-- Rather like putStr vs putStrLn\nprintDoc_ LeftMode _ hdl doc\n  = do { printLeftRender hdl doc; hFlush hdl }\nprintDoc_ mode pprCols hdl doc\n  = do { fullRender mode pprCols 1.5 put done doc ;\n         hFlush hdl }\n  where\n    put (Chr c)    next = hPutChar hdl c >> next\n    put (Str s)    next = hPutStr  hdl s >> next\n    put (PStr s)   next = hPutStr  hdl (unpackFS s) >> next\n                          -- NB. not hPutFS, we want this to go through\n                          -- the I/O library's encoding layer. (#3398)\n    put (ZStr s)   next = hPutFZS  hdl s >> next\n    put (LStr s)   next = hPutPtrString hdl s >> next\n    put (RStr n c) next = hPutStr hdl (replicate n c) >> next\n\n    done = return () -- hPutChar hdl '\\n'\n\n  -- some versions of hPutBuf will barf if the length is zero\nhPutPtrString :: Handle -> PtrString -> IO ()\nhPutPtrString _handle (PtrString _ 0) = return ()\nhPutPtrString handle  (PtrString a l) = hPutBuf handle a l\n\n-- Printing output in LeftMode is performance critical: it's used when\n-- dumping C and assembly output, so we allow ourselves a few dirty\n-- hacks:\n--\n-- (1) we specialise fullRender for LeftMode with IO output.\n--\n-- (2) we add a layer of buffering on top of Handles.  Handles\n--     don't perform well with lots of hPutChars, which is mostly\n--     what we're doing here, because Handles have to be thread-safe\n--     and async exception-safe.  We only have a single thread and don't\n--     care about exceptions, so we add a layer of fast buffering\n--     over the Handle interface.\n\nprintLeftRender :: Handle -> Doc -> IO ()\nprintLeftRender hdl doc = do\n  b <- newBufHandle hdl\n  bufLeftRender b doc\n  bFlush b\n\nbufLeftRender :: BufHandle -> Doc -> IO ()\nbufLeftRender b doc = layLeft b (reduceDoc doc)\n\nlayLeft :: BufHandle -> Doc -> IO ()\nlayLeft b _ | b `seq` False  = undefined -- make it strict in b\nlayLeft _ NoDoc              = error \"layLeft: NoDoc\"\nlayLeft b (Union p q)        = layLeft b $! first p q\nlayLeft b (Nest _ p)         = layLeft b $! p\nlayLeft b Empty              = bPutChar b '\\n'\nlayLeft b (NilAbove p)       = p `seq` (bPutChar b '\\n' >> layLeft b p)\nlayLeft b (TextBeside s _ p) = s `seq` (put b s >> layLeft b p)\n where\n    put b _ | b `seq` False = undefined\n    put b (Chr c)    = bPutChar b c\n    put b (Str s)    = bPutStr  b s\n    put b (PStr s)   = bPutFS   b s\n    put b (ZStr s)   = bPutFZS  b s\n    put b (LStr s)   = bPutPtrString b s\n    put b (RStr n c) = bPutReplicate b n c\nlayLeft _ _                  = panic \"layLeft: Unhandled case\"\n\n-- Define error=panic, for easier comparison with libraries/pretty.\nerror :: String -> a\nerror = panic\n", "num_lines": 1109}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule State where\n\nimport GhcPrelude\n\nnewtype State s a = State { runState' :: s -> (# a, s #) }\n\ninstance Functor (State s) where\n    fmap f m  = State $ \\s -> case runState' m s of\n                              (# r, s' #) -> (# f r, s' #)\n\ninstance Applicative (State s) where\n   pure x   = State $ \\s -> (# x, s #)\n   m <*> n  = State $ \\s -> case runState' m s of\n                            (# f, s' #) -> case runState' n s' of\n                                           (# x, s'' #) -> (# f x, s'' #)\n\ninstance Monad (State s) where\n    m >>= n  = State $ \\s -> case runState' m s of\n                             (# r, s' #) -> runState' (n r) s'\n\nget :: State s s\nget = State $ \\s -> (# s, s #)\n\ngets :: (s -> a) -> State s a\ngets f = State $ \\s -> (# f s, s #)\n\nput :: s -> State s ()\nput s' = State $ \\_ -> (# (), s' #)\n\nmodify :: (s -> s) -> State s ()\nmodify f = State $ \\s -> (# (), f s #)\n\n\nevalState :: State s a -> s -> a\nevalState s i = case runState' s i of\n                (# a, _ #) -> a\n\n\nexecState :: State s a -> s -> s\nexecState s i = case runState' s i of\n                (# _, s' #) -> s'\n\n\nrunState :: State s a -> s -> (a, s)\nrunState s i = case runState' s i of\n               (# a, s' #) -> (a, s')\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- -----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2012\n--\n-- Monadic streams\n--\n-- -----------------------------------------------------------------------------\nmodule Stream (\n    Stream(..), yield, liftIO,\n    collect, fromList,\n    Stream.map, Stream.mapM, Stream.mapAccumL\n  ) where\n\nimport GhcPrelude\n\nimport Control.Monad\n\n-- |\n-- @Stream m a b@ is a computation in some Monad @m@ that delivers a sequence\n-- of elements of type @a@ followed by a result of type @b@.\n--\n-- More concretely, a value of type @Stream m a b@ can be run using @runStream@\n-- in the Monad @m@, and it delivers either\n--\n--  * the final result: @Left b@, or\n--  * @Right (a,str)@, where @a@ is the next element in the stream, and @str@\n--    is a computation to get the rest of the stream.\n--\n-- Stream is itself a Monad, and provides an operation 'yield' that\n-- produces a new element of the stream.  This makes it convenient to turn\n-- existing monadic computations into streams.\n--\n-- The idea is that Stream is useful for making a monadic computation\n-- that produces values from time to time.  This can be used for\n-- knitting together two complex monadic operations, so that the\n-- producer does not have to produce all its values before the\n-- consumer starts consuming them.  We make the producer into a\n-- Stream, and the consumer pulls on the stream each time it wants a\n-- new value.\n--\nnewtype Stream m a b = Stream { runStream :: m (Either b (a, Stream m a b)) }\n\ninstance Monad f => Functor (Stream f a) where\n  fmap = liftM\n\ninstance Monad m => Applicative (Stream m a) where\n  pure a = Stream (return (Left a))\n  (<*>) = ap\n\ninstance Monad m => Monad (Stream m a) where\n\n  Stream m >>= k = Stream $ do\n                r <- m\n                case r of\n                  Left b        -> runStream (k b)\n                  Right (a,str) -> return (Right (a, str >>= k))\n\nyield :: Monad m => a -> Stream m a ()\nyield a = Stream (return (Right (a, return ())))\n\nliftIO :: IO a -> Stream IO b a\nliftIO io = Stream $ io >>= return . Left\n\n-- | Turn a Stream into an ordinary list, by demanding all the elements.\ncollect :: Monad m => Stream m a () -> m [a]\ncollect str = go str []\n where\n  go str acc = do\n    r <- runStream str\n    case r of\n      Left () -> return (reverse acc)\n      Right (a, str') -> go str' (a:acc)\n\n-- | Turn a list into a 'Stream', by yielding each element in turn.\nfromList :: Monad m => [a] -> Stream m a ()\nfromList = mapM_ yield\n\n-- | Apply a function to each element of a 'Stream', lazily\nmap :: Monad m => (a -> b) -> Stream m a x -> Stream m b x\nmap f str = Stream $ do\n   r <- runStream str\n   case r of\n     Left x -> return (Left x)\n     Right (a, str') -> return (Right (f a, Stream.map f str'))\n\n-- | Apply a monadic operation to each element of a 'Stream', lazily\nmapM :: Monad m => (a -> m b) -> Stream m a x -> Stream m b x\nmapM f str = Stream $ do\n   r <- runStream str\n   case r of\n     Left x -> return (Left x)\n     Right (a, str') -> do\n        b <- f a\n        return (Right (b, Stream.mapM f str'))\n\n-- | analog of the list-based 'mapAccumL' on Streams.  This is a simple\n-- way to map over a Stream while carrying some state around.\nmapAccumL :: Monad m => (c -> a -> m (c,b)) -> c -> Stream m a ()\n          -> Stream m b c\nmapAccumL f c str = Stream $ do\n  r <- runStream str\n  case r of\n    Left  () -> return (Left c)\n    Right (a, str') -> do\n      (c',b) <- f c a\n      return (Right (b, mapAccumL f c' str'))\n", "num_lines": 107}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The University of Glasgow, 1997-2006\n\n\nBuffers for scanning string input stored in external arrays.\n-}\n\n{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_GHC -O2 #-}\n-- We always optimise this, otherwise performance of a non-optimised\n-- compiler is severely affected\n\nmodule StringBuffer\n       (\n        StringBuffer(..),\n        -- non-abstract for vs\\/HaskellService\n\n         -- * Creation\\/destruction\n        hGetStringBuffer,\n        hGetStringBufferBlock,\n        appendStringBuffers,\n        stringToStringBuffer,\n\n        -- * Inspection\n        nextChar,\n        currentChar,\n        prevChar,\n        atEnd,\n\n        -- * Moving and comparison\n        stepOn,\n        offsetBytes,\n        byteDiff,\n        atLine,\n\n        -- * Conversion\n        lexemeToString,\n        lexemeToFastString,\n        decodePrevNChars,\n\n         -- * Parsing integers\n        parseUnsignedInteger,\n       ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Encoding\nimport FastString\nimport FastFunctions\nimport Outputable\nimport Util\n\nimport Data.Maybe\nimport Control.Exception\nimport System.IO\nimport System.IO.Unsafe         ( unsafePerformIO )\nimport GHC.IO.Encoding.UTF8     ( mkUTF8 )\nimport GHC.IO.Encoding.Failure  ( CodingFailureMode(IgnoreCodingFailure) )\n\nimport GHC.Exts\n\nimport Foreign\n\n-- -----------------------------------------------------------------------------\n-- The StringBuffer type\n\n-- |A StringBuffer is an internal pointer to a sized chunk of bytes.\n-- The bytes are intended to be *immutable*.  There are pure\n-- operations to read the contents of a StringBuffer.\n--\n-- A StringBuffer may have a finalizer, depending on how it was\n-- obtained.\n--\ndata StringBuffer\n = StringBuffer {\n     buf :: {-# UNPACK #-} !(ForeignPtr Word8),\n     len :: {-# UNPACK #-} !Int,        -- length\n     cur :: {-# UNPACK #-} !Int         -- current pos\n  }\n  -- The buffer is assumed to be UTF-8 encoded, and furthermore\n  -- we add three @\\'\\\\0\\'@ bytes to the end as sentinels so that the\n  -- decoder doesn't have to check for overflow at every single byte\n  -- of a multibyte sequence.\n\ninstance Show StringBuffer where\n        showsPrec _ s = showString \"<stringbuffer(\"\n                      . shows (len s) . showString \",\" . shows (cur s)\n                      . showString \")>\"\n\n-- -----------------------------------------------------------------------------\n-- Creation / Destruction\n\n-- | Read a file into a 'StringBuffer'.  The resulting buffer is automatically\n-- managed by the garbage collector.\nhGetStringBuffer :: FilePath -> IO StringBuffer\nhGetStringBuffer fname = do\n   h <- openBinaryFile fname ReadMode\n   size_i <- hFileSize h\n   offset_i <- skipBOM h size_i 0  -- offset is 0 initially\n   let size = fromIntegral $ size_i - offset_i\n   buf <- mallocForeignPtrArray (size+3)\n   withForeignPtr buf $ \\ptr -> do\n     r <- if size == 0 then return 0 else hGetBuf h ptr size\n     hClose h\n     if (r /= size)\n        then ioError (userError \"short read of file\")\n        else newUTF8StringBuffer buf ptr size\n\nhGetStringBufferBlock :: Handle -> Int -> IO StringBuffer\nhGetStringBufferBlock handle wanted\n    = do size_i <- hFileSize handle\n         offset_i <- hTell handle >>= skipBOM handle size_i\n         let size = min wanted (fromIntegral $ size_i-offset_i)\n         buf <- mallocForeignPtrArray (size+3)\n         withForeignPtr buf $ \\ptr ->\n             do r <- if size == 0 then return 0 else hGetBuf handle ptr size\n                if r /= size\n                   then ioError (userError $ \"short read of file: \"++show(r,size,size_i,handle))\n                   else newUTF8StringBuffer buf ptr size\n\n-- | Skip the byte-order mark if there is one (see #1744 and #6016),\n-- and return the new position of the handle in bytes.\n--\n-- This is better than treating #FEFF as whitespace,\n-- because that would mess up layout.  We don't have a concept\n-- of zero-width whitespace in Haskell: all whitespace codepoints\n-- have a width of one column.\nskipBOM :: Handle -> Integer -> Integer -> IO Integer\nskipBOM h size offset =\n  -- Only skip BOM at the beginning of a file.\n  if size > 0 && offset == 0\n    then do\n      -- Validate assumption that handle is in binary mode.\n      ASSERTM( hGetEncoding h >>= return . isNothing )\n      -- Temporarily select utf8 encoding with error ignoring,\n      -- to make `hLookAhead` and `hGetChar` return full Unicode characters.\n      bracket_ (hSetEncoding h safeEncoding) (hSetBinaryMode h True) $ do\n        c <- hLookAhead h\n        if c == '\\xfeff'\n          then hGetChar h >> hTell h\n          else return offset\n    else return offset\n  where\n    safeEncoding = mkUTF8 IgnoreCodingFailure\n\nnewUTF8StringBuffer :: ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer\nnewUTF8StringBuffer buf ptr size = do\n  pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]\n  -- sentinels for UTF-8 decoding\n  return $ StringBuffer buf size 0\n\nappendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer\nappendStringBuffers sb1 sb2\n    = do newBuf <- mallocForeignPtrArray (size+3)\n         withForeignPtr newBuf $ \\ptr ->\n          withForeignPtr (buf sb1) $ \\sb1Ptr ->\n           withForeignPtr (buf sb2) $ \\sb2Ptr ->\n             do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len\n                copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len\n                pokeArray (ptr `advancePtr` size) [0,0,0]\n                return (StringBuffer newBuf size 0)\n    where sb1_len = calcLen sb1\n          sb2_len = calcLen sb2\n          calcLen sb = len sb - cur sb\n          size =  sb1_len + sb2_len\n\n-- | Encode a 'String' into a 'StringBuffer' as UTF-8.  The resulting buffer\n-- is automatically managed by the garbage collector.\nstringToStringBuffer :: String -> StringBuffer\nstringToStringBuffer str =\n unsafePerformIO $ do\n  let size = utf8EncodedLength str\n  buf <- mallocForeignPtrArray (size+3)\n  withForeignPtr buf $ \\ptr -> do\n    utf8EncodeString ptr str\n    pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]\n    -- sentinels for UTF-8 decoding\n  return (StringBuffer buf size 0)\n\n-- -----------------------------------------------------------------------------\n-- Grab a character\n\n-- | Return the first UTF-8 character of a nonempty 'StringBuffer' and as well\n-- the remaining portion (analogous to 'Data.List.uncons').  __Warning:__ The\n-- behavior is undefined if the 'StringBuffer' is empty.  The result shares\n-- the same buffer as the original.  Similar to 'utf8DecodeChar', if the\n-- character cannot be decoded as UTF-8, @\\'\\\\0\\'@ is returned.\n{-# INLINE nextChar #-}\nnextChar :: StringBuffer -> (Char,StringBuffer)\nnextChar (StringBuffer buf len (I# cur#)) =\n  -- Getting our fingers dirty a little here, but this is performance-critical\n  inlinePerformIO $ do\n    withForeignPtr buf $ \\(Ptr a#) -> do\n        case utf8DecodeChar# (a# `plusAddr#` cur#) of\n          (# c#, nBytes# #) ->\n             let cur' = I# (cur# +# nBytes#) in\n             return (C# c#, StringBuffer buf len cur')\n\n-- | Return the first UTF-8 character of a nonempty 'StringBuffer' (analogous\n-- to 'Data.List.head').  __Warning:__ The behavior is undefined if the\n-- 'StringBuffer' is empty.  Similar to 'utf8DecodeChar', if the character\n-- cannot be decoded as UTF-8, @\\'\\\\0\\'@ is returned.\ncurrentChar :: StringBuffer -> Char\ncurrentChar = fst . nextChar\n\nprevChar :: StringBuffer -> Char -> Char\nprevChar (StringBuffer _   _   0)   deflt = deflt\nprevChar (StringBuffer buf _   cur) _     =\n  inlinePerformIO $ do\n    withForeignPtr buf $ \\p -> do\n      p' <- utf8PrevChar (p `plusPtr` cur)\n      return (fst (utf8DecodeChar p'))\n\n-- -----------------------------------------------------------------------------\n-- Moving\n\n-- | Return a 'StringBuffer' with the first UTF-8 character removed (analogous\n-- to 'Data.List.tail').  __Warning:__ The behavior is undefined if the\n-- 'StringBuffer' is empty.  The result shares the same buffer as the\n-- original.\nstepOn :: StringBuffer -> StringBuffer\nstepOn s = snd (nextChar s)\n\n-- | Return a 'StringBuffer' with the first @n@ bytes removed.  __Warning:__\n-- If there aren't enough characters, the returned 'StringBuffer' will be\n-- invalid and any use of it may lead to undefined behavior.  The result\n-- shares the same buffer as the original.\noffsetBytes :: Int                      -- ^ @n@, the number of bytes\n            -> StringBuffer\n            -> StringBuffer\noffsetBytes i s = s { cur = cur s + i }\n\n-- | Compute the difference in offset between two 'StringBuffer's that share\n-- the same buffer.  __Warning:__ The behavior is undefined if the\n-- 'StringBuffer's use separate buffers.\nbyteDiff :: StringBuffer -> StringBuffer -> Int\nbyteDiff s1 s2 = cur s2 - cur s1\n\n-- | Check whether a 'StringBuffer' is empty (analogous to 'Data.List.null').\natEnd :: StringBuffer -> Bool\natEnd (StringBuffer _ l c) = l == c\n\n-- | Computes a 'StringBuffer' which points to the first character of the\n-- wanted line. Lines begin at 1.\natLine :: Int -> StringBuffer -> Maybe StringBuffer\natLine line sb@(StringBuffer buf len _) =\n  inlinePerformIO $\n    withForeignPtr buf $ \\p -> do\n      p' <- skipToLine line len p\n      if p' == nullPtr\n        then return Nothing\n        else\n          let\n            delta = p' `minusPtr` p\n          in return $ Just (sb { cur = delta\n                               , len = len - delta\n                               })\n\nskipToLine :: Int -> Int -> Ptr Word8 -> IO (Ptr Word8)\nskipToLine !line !len !op0 = go 1 op0\n  where\n    !opend = op0 `plusPtr` len\n\n    go !i_line !op\n      | op >= opend    = pure nullPtr\n      | i_line == line = pure op\n      | otherwise      = do\n          w <- peek op :: IO Word8\n          case w of\n            10 -> go (i_line + 1) (plusPtr op 1)\n            13 -> do\n              -- this is safe because a 'StringBuffer' is\n              -- guaranteed to have 3 bytes sentinel values.\n              w' <- peek (plusPtr op 1) :: IO Word8\n              case w' of\n                10 -> go (i_line + 1) (plusPtr op 2)\n                _  -> go (i_line + 1) (plusPtr op 1)\n            _  -> go i_line (plusPtr op 1)\n\n-- -----------------------------------------------------------------------------\n-- Conversion\n\n-- | Decode the first @n@ bytes of a 'StringBuffer' as UTF-8 into a 'String'.\n-- Similar to 'utf8DecodeChar', if the character cannot be decoded as UTF-8,\n-- they will be replaced with @\\'\\\\0\\'@.\nlexemeToString :: StringBuffer\n               -> Int                   -- ^ @n@, the number of bytes\n               -> String\nlexemeToString _ 0 = \"\"\nlexemeToString (StringBuffer buf _ cur) bytes =\n  utf8DecodeStringLazy buf cur bytes\n\nlexemeToFastString :: StringBuffer\n                   -> Int               -- ^ @n@, the number of bytes\n                   -> FastString\nlexemeToFastString _ 0 = nilFS\nlexemeToFastString (StringBuffer buf _ cur) len =\n   inlinePerformIO $\n     withForeignPtr buf $ \\ptr ->\n       return $! mkFastStringBytes (ptr `plusPtr` cur) len\n\n-- | Return the previous @n@ characters (or fewer if we are less than @n@\n-- characters into the buffer.\ndecodePrevNChars :: Int -> StringBuffer -> String\ndecodePrevNChars n (StringBuffer buf _ cur) =\n    inlinePerformIO $ withForeignPtr buf $ \\p0 ->\n      go p0 n \"\" (p0 `plusPtr` (cur - 1))\n  where\n    go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String\n    go buf0 n acc p | n == 0 || buf0 >= p = return acc\n    go buf0 n acc p = do\n        p' <- utf8PrevChar p\n        let (c,_) = utf8DecodeChar p'\n        go buf0 (n - 1) (c:acc) p'\n\n-- -----------------------------------------------------------------------------\n-- Parsing integer strings in various bases\nparseUnsignedInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer\nparseUnsignedInteger (StringBuffer buf _ cur) len radix char_to_int\n  = inlinePerformIO $ withForeignPtr buf $ \\ptr -> return $! let\n    go i x | i == len  = x\n           | otherwise = case fst (utf8DecodeChar (ptr `plusPtr` (cur + i))) of\n               '_'  -> go (i + 1) x    -- skip \"_\" (#14473)\n               char -> go (i + 1) (x * radix + toInteger (char_to_int char))\n  in go 0 0\n", "num_lines": 329}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The GRASP/AQUA Project, Glasgow University, 1992-1998\n-}\n\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule TrieMap(\n   -- * Maps over 'Maybe' values\n   MaybeMap,\n   -- * Maps over 'List' values\n   ListMap,\n   -- * Maps over 'Literal's\n   LiteralMap,\n   -- * 'TrieMap' class\n   TrieMap(..), insertTM, deleteTM,\n\n   -- * Things helpful for adding additional Instances.\n   (>.>), (|>), (|>>), XT,\n   foldMaybe,\n   -- * Map for leaf compression\n   GenMap,\n   lkG, xtG, mapG, fdG,\n   xtList, lkList\n\n ) where\n\nimport GhcPrelude\n\nimport Literal\nimport UniqDFM\nimport Unique( Unique )\n\nimport qualified Data.Map    as Map\nimport qualified Data.IntMap as IntMap\nimport Outputable\nimport Control.Monad( (>=>) )\n\n{-\nThis module implements TrieMaps, which are finite mappings\nwhose key is a structured value like a CoreExpr or Type.\n\nThis file implements tries over general data structures.\nImplementation for tries over Core Expressions/Types are\navailable in coreSyn/TrieMap.\n\nThe regular pattern for handling TrieMaps on data structures was first\ndescribed (to my knowledge) in Connelly and Morris's 1995 paper \"A\ngeneralization of the Trie Data Structure\"; there is also an accessible\ndescription of the idea in Okasaki's book \"Purely Functional Data\nStructures\", Section 10.3.2\n\n************************************************************************\n*                                                                      *\n                   The TrieMap class\n*                                                                      *\n************************************************************************\n-}\n\ntype XT a = Maybe a -> Maybe a  -- How to alter a non-existent elt (Nothing)\n                                --               or an existing elt (Just)\n\nclass TrieMap m where\n   type Key m :: *\n   emptyTM  :: m a\n   lookupTM :: forall b. Key m -> m b -> Maybe b\n   alterTM  :: forall b. Key m -> XT b -> m b -> m b\n   mapTM    :: (a->b) -> m a -> m b\n\n   foldTM   :: (a -> b -> b) -> m a -> b -> b\n      -- The unusual argument order here makes\n      -- it easy to compose calls to foldTM;\n      -- see for example fdE below\n\ninsertTM :: TrieMap m => Key m -> a -> m a -> m a\ninsertTM k v m = alterTM k (\\_ -> Just v) m\n\ndeleteTM :: TrieMap m => Key m -> m a -> m a\ndeleteTM k m = alterTM k (\\_ -> Nothing) m\n\n----------------------\n-- Recall that\n--   Control.Monad.(>=>) :: (a -> Maybe b) -> (b -> Maybe c) -> a -> Maybe c\n\n(>.>) :: (a -> b) -> (b -> c) -> a -> c\n-- Reverse function composition (do f first, then g)\ninfixr 1 >.>\n(f >.> g) x = g (f x)\ninfixr 1 |>, |>>\n\n(|>) :: a -> (a->b) -> b     -- Reverse application\nx |> f = f x\n\n----------------------\n(|>>) :: TrieMap m2\n      => (XT (m2 a) -> m1 (m2 a) -> m1 (m2 a))\n      -> (m2 a -> m2 a)\n      -> m1 (m2 a) -> m1 (m2 a)\n(|>>) f g = f (Just . g . deMaybe)\n\ndeMaybe :: TrieMap m => Maybe (m a) -> m a\ndeMaybe Nothing  = emptyTM\ndeMaybe (Just m) = m\n\n{-\n************************************************************************\n*                                                                      *\n                   IntMaps\n*                                                                      *\n************************************************************************\n-}\n\ninstance TrieMap IntMap.IntMap where\n  type Key IntMap.IntMap = Int\n  emptyTM = IntMap.empty\n  lookupTM k m = IntMap.lookup k m\n  alterTM = xtInt\n  foldTM k m z = IntMap.foldr k z m\n  mapTM f m = IntMap.map f m\n\nxtInt :: Int -> XT a -> IntMap.IntMap a -> IntMap.IntMap a\nxtInt k f m = IntMap.alter f k m\n\ninstance Ord k => TrieMap (Map.Map k) where\n  type Key (Map.Map k) = k\n  emptyTM = Map.empty\n  lookupTM = Map.lookup\n  alterTM k f m = Map.alter f k m\n  foldTM k m z = Map.foldr k z m\n  mapTM f m = Map.map f m\n\n\n{-\nNote [foldTM determinism]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nWe want foldTM to be deterministic, which is why we have an instance of\nTrieMap for UniqDFM, but not for UniqFM. Here's an example of some things that\ngo wrong if foldTM is nondeterministic. Consider:\n\n  f a b = return (a <> b)\n\nDepending on the order that the typechecker generates constraints you\nget either:\n\n  f :: (Monad m, Monoid a) => a -> a -> m a\n\nor:\n\n  f :: (Monoid a, Monad m) => a -> a -> m a\n\nThe generated code will be different after desugaring as the dictionaries\nwill be bound in different orders, leading to potential ABI incompatibility.\n\nOne way to solve this would be to notice that the typeclasses could be\nsorted alphabetically.\n\nUnfortunately that doesn't quite work with this example:\n\n  f a b = let x = a <> a; y = b <> b in x\n\nwhere you infer:\n\n  f :: (Monoid m, Monoid m1) => m1 -> m -> m1\n\nor:\n\n  f :: (Monoid m1, Monoid m) => m1 -> m -> m1\n\nHere you could decide to take the order of the type variables in the type\naccording to depth first traversal and use it to order the constraints.\n\nThe real trouble starts when the user enables incoherent instances and\nthe compiler has to make an arbitrary choice. Consider:\n\n  class T a b where\n    go :: a -> b -> String\n\n  instance (Show b) => T Int b where\n    go a b = show a ++ show b\n\n  instance (Show a) => T a Bool where\n    go a b = show a ++ show b\n\n  f = go 10 True\n\nGHC is free to choose either dictionary to implement f, but for the sake of\ndeterminism we'd like it to be consistent when compiling the same sources\nwith the same flags.\n\ninert_dicts :: DictMap is implemented with a TrieMap. In getUnsolvedInerts it\ngets converted to a bag of (Wanted) Cts using a fold. Then in\nsolve_simple_wanteds it's merged with other WantedConstraints. We want the\nconversion to a bag to be deterministic. For that purpose we use UniqDFM\ninstead of UniqFM to implement the TrieMap.\n\nSee Note [Deterministic UniqFM] in UniqDFM for more details on how it's made\ndeterministic.\n-}\n\ninstance TrieMap UniqDFM where\n  type Key UniqDFM = Unique\n  emptyTM = emptyUDFM\n  lookupTM k m = lookupUDFM m k\n  alterTM k f m = alterUDFM f m k\n  foldTM k m z = foldUDFM k z m\n  mapTM f m = mapUDFM f m\n\n{-\n************************************************************************\n*                                                                      *\n                   Maybes\n*                                                                      *\n************************************************************************\n\nIf              m is a map from k -> val\nthen (MaybeMap m) is a map from (Maybe k) -> val\n-}\n\ndata MaybeMap m a = MM { mm_nothing  :: Maybe a, mm_just :: m a }\n\ninstance TrieMap m => TrieMap (MaybeMap m) where\n   type Key (MaybeMap m) = Maybe (Key m)\n   emptyTM  = MM { mm_nothing = Nothing, mm_just = emptyTM }\n   lookupTM = lkMaybe lookupTM\n   alterTM  = xtMaybe alterTM\n   foldTM   = fdMaybe\n   mapTM    = mapMb\n\nmapMb :: TrieMap m => (a->b) -> MaybeMap m a -> MaybeMap m b\nmapMb f (MM { mm_nothing = mn, mm_just = mj })\n  = MM { mm_nothing = fmap f mn, mm_just = mapTM f mj }\n\nlkMaybe :: (forall b. k -> m b -> Maybe b)\n        -> Maybe k -> MaybeMap m a -> Maybe a\nlkMaybe _  Nothing  = mm_nothing\nlkMaybe lk (Just x) = mm_just >.> lk x\n\nxtMaybe :: (forall b. k -> XT b -> m b -> m b)\n        -> Maybe k -> XT a -> MaybeMap m a -> MaybeMap m a\nxtMaybe _  Nothing  f m = m { mm_nothing  = f (mm_nothing m) }\nxtMaybe tr (Just x) f m = m { mm_just = mm_just m |> tr x f }\n\nfdMaybe :: TrieMap m => (a -> b -> b) -> MaybeMap m a -> b -> b\nfdMaybe k m = foldMaybe k (mm_nothing m)\n            . foldTM k (mm_just m)\n\n{-\n************************************************************************\n*                                                                      *\n                   Lists\n*                                                                      *\n************************************************************************\n-}\n\ndata ListMap m a\n  = LM { lm_nil  :: Maybe a\n       , lm_cons :: m (ListMap m a) }\n\ninstance TrieMap m => TrieMap (ListMap m) where\n   type Key (ListMap m) = [Key m]\n   emptyTM  = LM { lm_nil = Nothing, lm_cons = emptyTM }\n   lookupTM = lkList lookupTM\n   alterTM  = xtList alterTM\n   foldTM   = fdList\n   mapTM    = mapList\n\ninstance (TrieMap m, Outputable a) => Outputable (ListMap m a) where\n  ppr m = text \"List elts\" <+> ppr (foldTM (:) m [])\n\nmapList :: TrieMap m => (a->b) -> ListMap m a -> ListMap m b\nmapList f (LM { lm_nil = mnil, lm_cons = mcons })\n  = LM { lm_nil = fmap f mnil, lm_cons = mapTM (mapTM f) mcons }\n\nlkList :: TrieMap m => (forall b. k -> m b -> Maybe b)\n        -> [k] -> ListMap m a -> Maybe a\nlkList _  []     = lm_nil\nlkList lk (x:xs) = lm_cons >.> lk x >=> lkList lk xs\n\nxtList :: TrieMap m => (forall b. k -> XT b -> m b -> m b)\n        -> [k] -> XT a -> ListMap m a -> ListMap m a\nxtList _  []     f m = m { lm_nil  = f (lm_nil m) }\nxtList tr (x:xs) f m = m { lm_cons = lm_cons m |> tr x |>> xtList tr xs f }\n\nfdList :: forall m a b. TrieMap m\n       => (a -> b -> b) -> ListMap m a -> b -> b\nfdList k m = foldMaybe k          (lm_nil m)\n           . foldTM    (fdList k) (lm_cons m)\n\nfoldMaybe :: (a -> b -> b) -> Maybe a -> b -> b\nfoldMaybe _ Nothing  b = b\nfoldMaybe k (Just a) b = k a b\n\n{-\n************************************************************************\n*                                                                      *\n                   Basic maps\n*                                                                      *\n************************************************************************\n-}\n\ntype LiteralMap  a = Map.Map Literal a\n\n{-\n************************************************************************\n*                                                                      *\n                   GenMap\n*                                                                      *\n************************************************************************\n\nNote [Compressed TrieMap]\n~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe GenMap constructor augments TrieMaps with leaf compression.  This helps\nsolve the performance problem detailed in #9960: suppose we have a handful\nH of entries in a TrieMap, each with a very large key, size K. If you fold over\nsuch a TrieMap you'd expect time O(H). That would certainly be true of an\nassociation list! But with TrieMap we actually have to navigate down a long\nsingleton structure to get to the elements, so it takes time O(K*H).  This\ncan really hurt on many type-level computation benchmarks:\nsee for example T9872d.\n\nThe point of a TrieMap is that you need to navigate to the point where only one\nkey remains, and then things should be fast.  So the point of a SingletonMap\nis that, once we are down to a single (key,value) pair, we stop and\njust use SingletonMap.\n\n'EmptyMap' provides an even more basic (but essential) optimization: if there is\nnothing in the map, don't bother building out the (possibly infinite) recursive\nTrieMap structure!\n\nCompressed triemaps are heavily used by CoreMap. So we have to mark some things\nas INLINEABLE to permit specialization.\n-}\n\ndata GenMap m a\n   = EmptyMap\n   | SingletonMap (Key m) a\n   | MultiMap (m a)\n\ninstance (Outputable a, Outputable (m a)) => Outputable (GenMap m a) where\n  ppr EmptyMap = text \"Empty map\"\n  ppr (SingletonMap _ v) = text \"Singleton map\" <+> ppr v\n  ppr (MultiMap m) = ppr m\n\n-- TODO undecidable instance\ninstance (Eq (Key m), TrieMap m) => TrieMap (GenMap m) where\n   type Key (GenMap m) = Key m\n   emptyTM  = EmptyMap\n   lookupTM = lkG\n   alterTM  = xtG\n   foldTM   = fdG\n   mapTM    = mapG\n\n--We want to be able to specialize these functions when defining eg\n--tries over (GenMap CoreExpr) which requires INLINEABLE\n\n{-# INLINEABLE lkG #-}\nlkG :: (Eq (Key m), TrieMap m) => Key m -> GenMap m a -> Maybe a\nlkG _ EmptyMap                         = Nothing\nlkG k (SingletonMap k' v') | k == k'   = Just v'\n                           | otherwise = Nothing\nlkG k (MultiMap m)                     = lookupTM k m\n\n{-# INLINEABLE xtG #-}\nxtG :: (Eq (Key m), TrieMap m) => Key m -> XT a -> GenMap m a -> GenMap m a\nxtG k f EmptyMap\n    = case f Nothing of\n        Just v  -> SingletonMap k v\n        Nothing -> EmptyMap\nxtG k f m@(SingletonMap k' v')\n    | k' == k\n    -- The new key matches the (single) key already in the tree.  Hence,\n    -- apply @f@ to @Just v'@ and build a singleton or empty map depending\n    -- on the 'Just'/'Nothing' response respectively.\n    = case f (Just v') of\n        Just v'' -> SingletonMap k' v''\n        Nothing  -> EmptyMap\n    | otherwise\n    -- We've hit a singleton tree for a different key than the one we are\n    -- searching for. Hence apply @f@ to @Nothing@. If result is @Nothing@ then\n    -- we can just return the old map. If not, we need a map with *two*\n    -- entries. The easiest way to do that is to insert two items into an empty\n    -- map of type @m a@.\n    = case f Nothing of\n        Nothing  -> m\n        Just v   -> emptyTM |> alterTM k' (const (Just v'))\n                           >.> alterTM k  (const (Just v))\n                           >.> MultiMap\nxtG k f (MultiMap m) = MultiMap (alterTM k f m)\n\n{-# INLINEABLE mapG #-}\nmapG :: TrieMap m => (a -> b) -> GenMap m a -> GenMap m b\nmapG _ EmptyMap = EmptyMap\nmapG f (SingletonMap k v) = SingletonMap k (f v)\nmapG f (MultiMap m) = MultiMap (mapTM f m)\n\n{-# INLINEABLE fdG #-}\nfdG :: TrieMap m => (a -> b -> b) -> GenMap m a -> b -> b\nfdG _ EmptyMap = \\z -> z\nfdG k (SingletonMap _ v) = \\z -> k v z\nfdG k (MultiMap m) = foldTM k m\n", "num_lines": 406}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) Bartosz Nitka, Facebook, 2015\n\nUniqDFM: Specialised deterministic finite maps, for things with @Uniques@.\n\nBasically, the things need to be in class @Uniquable@, and we use the\n@getUnique@ method to grab their @Uniques@.\n\nThis is very similar to @UniqFM@, the major difference being that the order of\nfolding is not dependent on @Unique@ ordering, giving determinism.\nCurrently the ordering is determined by insertion order.\n\nSee Note [Unique Determinism] in Unique for explanation why @Unique@ ordering\nis not deterministic.\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# OPTIONS_GHC -Wall #-}\n\nmodule UniqDFM (\n        -- * Unique-keyed deterministic mappings\n        UniqDFM,       -- abstract type\n\n        -- ** Manipulating those mappings\n        emptyUDFM,\n        unitUDFM,\n        addToUDFM,\n        addToUDFM_C,\n        addListToUDFM,\n        delFromUDFM,\n        delListFromUDFM,\n        adjustUDFM,\n        alterUDFM,\n        mapUDFM,\n        plusUDFM,\n        plusUDFM_C,\n        lookupUDFM, lookupUDFM_Directly,\n        elemUDFM,\n        foldUDFM,\n        eltsUDFM,\n        filterUDFM, filterUDFM_Directly,\n        isNullUDFM,\n        sizeUDFM,\n        intersectUDFM, udfmIntersectUFM,\n        intersectsUDFM,\n        disjointUDFM, disjointUdfmUfm,\n        equalKeysUDFM,\n        minusUDFM,\n        listToUDFM,\n        udfmMinusUFM,\n        partitionUDFM,\n        anyUDFM, allUDFM,\n        pprUniqDFM, pprUDFM,\n\n        udfmToList,\n        udfmToUfm,\n        nonDetFoldUDFM,\n        alwaysUnsafeUfmToUdfm,\n    ) where\n\nimport GhcPrelude\n\nimport Unique           ( Uniquable(..), Unique, getKey )\nimport Outputable\n\nimport qualified Data.IntMap as M\nimport Data.Data\nimport Data.Functor.Classes (Eq1 (..))\nimport Data.List (sortBy)\nimport Data.Function (on)\nimport qualified Data.Semigroup as Semi\nimport UniqFM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap)\n\n-- Note [Deterministic UniqFM]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- A @UniqDFM@ is just like @UniqFM@ with the following additional\n-- property: the function `udfmToList` returns the elements in some\n-- deterministic order not depending on the Unique key for those elements.\n--\n-- If the client of the map performs operations on the map in deterministic\n-- order then `udfmToList` returns them in deterministic order.\n--\n-- There is an implementation cost: each element is given a serial number\n-- as it is added, and `udfmToList` sorts it's result by this serial\n-- number. So you should only use `UniqDFM` if you need the deterministic\n-- property.\n--\n-- `foldUDFM` also preserves determinism.\n--\n-- Normal @UniqFM@ when you turn it into a list will use\n-- Data.IntMap.toList function that returns the elements in the order of\n-- the keys. The keys in @UniqFM@ are always @Uniques@, so you end up with\n-- with a list ordered by @Uniques@.\n-- The order of @Uniques@ is known to be not stable across rebuilds.\n-- See Note [Unique Determinism] in Unique.\n--\n--\n-- There's more than one way to implement this. The implementation here tags\n-- every value with the insertion time that can later be used to sort the\n-- values when asked to convert to a list.\n--\n-- An alternative would be to have\n--\n--   data UniqDFM ele = UDFM (M.IntMap ele) [ele]\n--\n-- where the list determines the order. This makes deletion tricky as we'd\n-- only accumulate elements in that list, but makes merging easier as you\n-- can just merge both structures independently.\n-- Deletion can probably be done in amortized fashion when the size of the\n-- list is twice the size of the set.\n\n-- | A type of values tagged with insertion time\ndata TaggedVal val =\n  TaggedVal\n    val\n    {-# UNPACK #-} !Int -- ^ insertion time\n  deriving Data\n\ntaggedFst :: TaggedVal val -> val\ntaggedFst (TaggedVal v _) = v\n\ntaggedSnd :: TaggedVal val -> Int\ntaggedSnd (TaggedVal _ i) = i\n\ninstance Eq val => Eq (TaggedVal val) where\n  (TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2\n\ninstance Functor TaggedVal where\n  fmap f (TaggedVal val i) = TaggedVal (f val) i\n\n-- | Type of unique deterministic finite maps\ndata UniqDFM ele =\n  UDFM\n    !(M.IntMap (TaggedVal ele)) -- A map where keys are Unique's values and\n                                -- values are tagged with insertion time.\n                                -- The invariant is that all the tags will\n                                -- be distinct within a single map\n    {-# UNPACK #-} !Int         -- Upper bound on the values' insertion\n                                -- time. See Note [Overflow on plusUDFM]\n  deriving (Data, Functor)\n\nemptyUDFM :: UniqDFM elt\nemptyUDFM = UDFM M.empty 0\n\nunitUDFM :: Uniquable key => key -> elt -> UniqDFM elt\nunitUDFM k v = UDFM (M.singleton (getKey $ getUnique k) (TaggedVal v 0)) 1\n\n-- The new binding always goes to the right of existing ones\naddToUDFM :: Uniquable key => UniqDFM elt -> key -> elt  -> UniqDFM elt\naddToUDFM m k v = addToUDFM_Directly m (getUnique k) v\n\n-- The new binding always goes to the right of existing ones\naddToUDFM_Directly :: UniqDFM elt -> Unique -> elt -> UniqDFM elt\naddToUDFM_Directly (UDFM m i) u v\n  = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)\n  where\n    tf (TaggedVal new_v _) (TaggedVal _ old_i) = TaggedVal new_v old_i\n      -- Keep the old tag, but insert the new value\n      -- This means that udfmToList typically returns elements\n      -- in the order of insertion, rather than the reverse\n\naddToUDFM_Directly_C\n  :: (elt -> elt -> elt)   -- old -> new -> result\n  -> UniqDFM elt\n  -> Unique -> elt\n  -> UniqDFM elt\naddToUDFM_Directly_C f (UDFM m i) u v\n  = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)\n    where\n      tf (TaggedVal new_v _) (TaggedVal old_v old_i)\n         = TaggedVal (f old_v new_v) old_i\n          -- Flip the arguments, because M.insertWith uses  (new->old->result)\n          --                         but f            needs (old->new->result)\n          -- Like addToUDFM_Directly, keep the old tag\n\naddToUDFM_C\n  :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result\n  -> UniqDFM elt -- old\n  -> key -> elt -- new\n  -> UniqDFM elt -- result\naddToUDFM_C f m k v = addToUDFM_Directly_C f m (getUnique k) v\n\naddListToUDFM :: Uniquable key => UniqDFM elt -> [(key,elt)] -> UniqDFM elt\naddListToUDFM = foldl' (\\m (k, v) -> addToUDFM m k v)\n\naddListToUDFM_Directly :: UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt\naddListToUDFM_Directly = foldl' (\\m (k, v) -> addToUDFM_Directly m k v)\n\naddListToUDFM_Directly_C\n  :: (elt -> elt -> elt) -> UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt\naddListToUDFM_Directly_C f = foldl' (\\m (k, v) -> addToUDFM_Directly_C f m k v)\n\ndelFromUDFM :: Uniquable key => UniqDFM elt -> key -> UniqDFM elt\ndelFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i\n\nplusUDFM_C :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt\nplusUDFM_C f udfml@(UDFM _ i) udfmr@(UDFM _ j)\n  -- we will use the upper bound on the tag as a proxy for the set size,\n  -- to insert the smaller one into the bigger one\n  | i > j = insertUDFMIntoLeft_C f udfml udfmr\n  | otherwise = insertUDFMIntoLeft_C f udfmr udfml\n\n-- Note [Overflow on plusUDFM]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- There are multiple ways of implementing plusUDFM.\n-- The main problem that needs to be solved is overlap on times of\n-- insertion between different keys in two maps.\n-- Consider:\n--\n-- A = fromList [(a, (x, 1))]\n-- B = fromList [(b, (y, 1))]\n--\n-- If you merge them naively you end up with:\n--\n-- C = fromList [(a, (x, 1)), (b, (y, 1))]\n--\n-- Which loses information about ordering and brings us back into\n-- non-deterministic world.\n--\n-- The solution I considered before would increment the tags on one of the\n-- sets by the upper bound of the other set. The problem with this approach\n-- is that you'll run out of tags for some merge patterns.\n-- Say you start with A with upper bound 1, you merge A with A to get A' and\n-- the upper bound becomes 2. You merge A' with A' and the upper bound\n-- doubles again. After 64 merges you overflow.\n-- This solution would have the same time complexity as plusUFM, namely O(n+m).\n--\n-- The solution I ended up with has time complexity of\n-- O(m log m + m * min (n+m, W)) where m is the smaller set.\n-- It simply inserts the elements of the smaller set into the larger\n-- set in the order that they were inserted into the smaller set. That's\n-- O(m log m) for extracting the elements from the smaller set in the\n-- insertion order and O(m * min(n+m, W)) to insert them into the bigger\n-- set.\n\nplusUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt\nplusUDFM udfml@(UDFM _ i) udfmr@(UDFM _ j)\n  -- we will use the upper bound on the tag as a proxy for the set size,\n  -- to insert the smaller one into the bigger one\n  | i > j = insertUDFMIntoLeft udfml udfmr\n  | otherwise = insertUDFMIntoLeft udfmr udfml\n\ninsertUDFMIntoLeft :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt\ninsertUDFMIntoLeft udfml udfmr = addListToUDFM_Directly udfml $ udfmToList udfmr\n\ninsertUDFMIntoLeft_C\n  :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt\ninsertUDFMIntoLeft_C f udfml udfmr =\n  addListToUDFM_Directly_C f udfml $ udfmToList udfmr\n\nlookupUDFM :: Uniquable key => UniqDFM elt -> key -> Maybe elt\nlookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m\n\nlookupUDFM_Directly :: UniqDFM elt -> Unique -> Maybe elt\nlookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m\n\nelemUDFM :: Uniquable key => key -> UniqDFM elt -> Bool\nelemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m\n\n-- | Performs a deterministic fold over the UniqDFM.\n-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).\nfoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a\nfoldUDFM k z m = foldr k z (eltsUDFM m)\n\n-- | Performs a nondeterministic fold over the UniqDFM.\n-- It's O(n), same as the corresponding function on `UniqFM`.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a\nnonDetFoldUDFM k z (UDFM m _i) = foldr k z $ map taggedFst $ M.elems m\n\neltsUDFM :: UniqDFM elt -> [elt]\neltsUDFM (UDFM m _i) =\n  map taggedFst $ sortBy (compare `on` taggedSnd) $ M.elems m\n\nfilterUDFM :: (elt -> Bool) -> UniqDFM elt -> UniqDFM elt\nfilterUDFM p (UDFM m i) = UDFM (M.filter (\\(TaggedVal v _) -> p v) m) i\n\nfilterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM elt -> UniqDFM elt\nfilterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i\n  where\n  p' k (TaggedVal v _) = p (getUnique k) v\n\n-- | Converts `UniqDFM` to a list, with elements in deterministic order.\n-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).\nudfmToList :: UniqDFM elt -> [(Unique, elt)]\nudfmToList (UDFM m _i) =\n  [ (getUnique k, taggedFst v)\n  | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ]\n\n-- Determines whether two 'UniqDFM's contain the same keys.\nequalKeysUDFM :: UniqDFM a -> UniqDFM b -> Bool\nequalKeysUDFM (UDFM m1 _) (UDFM m2 _) = liftEq (\\_ _ -> True) m1 m2\n\nisNullUDFM :: UniqDFM elt -> Bool\nisNullUDFM (UDFM m _) = M.null m\n\nsizeUDFM :: UniqDFM elt -> Int\nsizeUDFM (UDFM m _i) = M.size m\n\nintersectUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt\nintersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i\n  -- M.intersection is left biased, that means the result will only have\n  -- a subset of elements from the left set, so `i` is a good upper bound.\n\nudfmIntersectUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1\nudfmIntersectUFM (UDFM x i) y = UDFM (M.intersection x (ufmToIntMap y)) i\n  -- M.intersection is left biased, that means the result will only have\n  -- a subset of elements from the left set, so `i` is a good upper bound.\n\nintersectsUDFM :: UniqDFM elt -> UniqDFM elt -> Bool\nintersectsUDFM x y = isNullUDFM (x `intersectUDFM` y)\n\ndisjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool\ndisjointUDFM (UDFM x _i) (UDFM y _j) = M.null (M.intersection x y)\n\ndisjointUdfmUfm :: UniqDFM elt -> UniqFM elt2 -> Bool\ndisjointUdfmUfm (UDFM x _i) y = M.null (M.intersection x (ufmToIntMap y))\n\nminusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1\nminusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i\n  -- M.difference returns a subset of a left set, so `i` is a good upper\n  -- bound.\n\nudfmMinusUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1\nudfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i\n  -- M.difference returns a subset of a left set, so `i` is a good upper\n  -- bound.\n\n-- | Partition UniqDFM into two UniqDFMs according to the predicate\npartitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)\npartitionUDFM p (UDFM m i) =\n  case M.partition (p . taggedFst) m of\n    (left, right) -> (UDFM left i, UDFM right i)\n\n-- | Delete a list of elements from a UniqDFM\ndelListFromUDFM  :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt\ndelListFromUDFM = foldl' delFromUDFM\n\n-- | This allows for lossy conversion from UniqDFM to UniqFM\nudfmToUfm :: UniqDFM elt -> UniqFM elt\nudfmToUfm (UDFM m _i) =\n  listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m]\n\nlistToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt\nlistToUDFM = foldl' (\\m (k, v) -> addToUDFM m k v) emptyUDFM\n\nlistToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt\nlistToUDFM_Directly = foldl' (\\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM\n\n-- | Apply a function to a particular element\nadjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt\nadjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i\n\n-- | The expression (alterUDFM f k map) alters value x at k, or absence\n-- thereof. alterUDFM can be used to insert, delete, or update a value in\n-- UniqDFM. Use addToUDFM, delFromUDFM or adjustUDFM when possible, they are\n-- more efficient.\nalterUDFM\n  :: Uniquable key\n  => (Maybe elt -> Maybe elt)  -- How to adjust\n  -> UniqDFM elt               -- old\n  -> key                       -- new\n  -> UniqDFM elt               -- result\nalterUDFM f (UDFM m i) k =\n  UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)\n  where\n  alterf Nothing = inject $ f Nothing\n  alterf (Just (TaggedVal v _)) = inject $ f (Just v)\n  inject Nothing = Nothing\n  inject (Just v) = Just $ TaggedVal v i\n\n-- | Map a function over every value in a UniqDFM\nmapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2\nmapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i\n\nanyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool\nanyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m\n\nallUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool\nallUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m\n\ninstance Semi.Semigroup (UniqDFM a) where\n  (<>) = plusUDFM\n\ninstance Monoid (UniqDFM a) where\n  mempty = emptyUDFM\n  mappend = (Semi.<>)\n\n-- This should not be used in commited code, provided for convenience to\n-- make ad-hoc conversions when developing\nalwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt\nalwaysUnsafeUfmToUdfm = listToUDFM_Directly . nonDetUFMToList\n\n-- Output-ery\n\ninstance Outputable a => Outputable (UniqDFM a) where\n    ppr ufm = pprUniqDFM ppr ufm\n\npprUniqDFM :: (a -> SDoc) -> UniqDFM a -> SDoc\npprUniqDFM ppr_elt ufm\n  = brackets $ fsep $ punctuate comma $\n    [ ppr uq <+> text \":->\" <+> ppr_elt elt\n    | (uq, elt) <- udfmToList ufm ]\n\npprUDFM :: UniqDFM a    -- ^ The things to be pretty printed\n       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements\n       -> SDoc          -- ^ 'SDoc' where the things have been pretty\n                        -- printed\npprUDFM ufm pp = pp (eltsUDFM ufm)\n", "num_lines": 413}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) Bartosz Nitka, Facebook, 2015\n\n-- |\n-- Specialised deterministic sets, for things with @Uniques@\n--\n-- Based on 'UniqDFM's (as you would expect).\n-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need it.\n--\n-- Basically, the things need to be in class 'Uniquable'.\n\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule UniqDSet (\n        -- * Unique set type\n        UniqDSet,    -- type synonym for UniqFM a\n        getUniqDSet,\n        pprUniqDSet,\n\n        -- ** Manipulating these sets\n        delOneFromUniqDSet, delListFromUniqDSet,\n        emptyUniqDSet,\n        unitUniqDSet,\n        mkUniqDSet,\n        addOneToUniqDSet, addListToUniqDSet,\n        unionUniqDSets, unionManyUniqDSets,\n        minusUniqDSet, uniqDSetMinusUniqSet,\n        intersectUniqDSets, uniqDSetIntersectUniqSet,\n        foldUniqDSet,\n        elementOfUniqDSet,\n        filterUniqDSet,\n        sizeUniqDSet,\n        isEmptyUniqDSet,\n        lookupUniqDSet,\n        uniqDSetToList,\n        partitionUniqDSet,\n        mapUniqDSet\n    ) where\n\nimport GhcPrelude\n\nimport Outputable\nimport UniqDFM\nimport UniqSet\nimport Unique\n\nimport Data.Coerce\nimport Data.Data\nimport qualified Data.Semigroup as Semi\n\n-- See Note [UniqSet invariant] in UniqSet.hs for why we want a newtype here.\n-- Beyond preserving invariants, we may also want to 'override' typeclass\n-- instances.\n\nnewtype UniqDSet a = UniqDSet {getUniqDSet' :: UniqDFM a}\n                   deriving (Data, Semi.Semigroup, Monoid)\n\nemptyUniqDSet :: UniqDSet a\nemptyUniqDSet = UniqDSet emptyUDFM\n\nunitUniqDSet :: Uniquable a => a -> UniqDSet a\nunitUniqDSet x = UniqDSet (unitUDFM x x)\n\nmkUniqDSet :: Uniquable a => [a] -> UniqDSet a\nmkUniqDSet = foldl' addOneToUniqDSet emptyUniqDSet\n\n-- The new element always goes to the right of existing ones.\naddOneToUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a\naddOneToUniqDSet (UniqDSet set) x = UniqDSet (addToUDFM set x x)\n\naddListToUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a\naddListToUniqDSet = foldl' addOneToUniqDSet\n\ndelOneFromUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a\ndelOneFromUniqDSet (UniqDSet s) = UniqDSet . delFromUDFM s\n\ndelListFromUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a\ndelListFromUniqDSet (UniqDSet s) = UniqDSet . delListFromUDFM s\n\nunionUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a\nunionUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (plusUDFM s t)\n\nunionManyUniqDSets :: [UniqDSet a] -> UniqDSet a\nunionManyUniqDSets [] = emptyUniqDSet\nunionManyUniqDSets sets = foldr1 unionUniqDSets sets\n\nminusUniqDSet :: UniqDSet a -> UniqDSet a -> UniqDSet a\nminusUniqDSet (UniqDSet s) (UniqDSet t) = UniqDSet (minusUDFM s t)\n\nuniqDSetMinusUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a\nuniqDSetMinusUniqSet xs ys\n  = UniqDSet (udfmMinusUFM (getUniqDSet xs) (getUniqSet ys))\n\nintersectUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a\nintersectUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (intersectUDFM s t)\n\nuniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a\nuniqDSetIntersectUniqSet xs ys\n  = UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys))\n\nfoldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b\nfoldUniqDSet c n (UniqDSet s) = foldUDFM c n s\n\nelementOfUniqDSet :: Uniquable a => a -> UniqDSet a -> Bool\nelementOfUniqDSet k = elemUDFM k . getUniqDSet\n\nfilterUniqDSet :: (a -> Bool) -> UniqDSet a -> UniqDSet a\nfilterUniqDSet p (UniqDSet s) = UniqDSet (filterUDFM p s)\n\nsizeUniqDSet :: UniqDSet a -> Int\nsizeUniqDSet = sizeUDFM . getUniqDSet\n\nisEmptyUniqDSet :: UniqDSet a -> Bool\nisEmptyUniqDSet = isNullUDFM . getUniqDSet\n\nlookupUniqDSet :: Uniquable a => UniqDSet a -> a -> Maybe a\nlookupUniqDSet = lookupUDFM . getUniqDSet\n\nuniqDSetToList :: UniqDSet a -> [a]\nuniqDSetToList = eltsUDFM . getUniqDSet\n\npartitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a)\npartitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet\n\n-- See Note [UniqSet invariant] in UniqSet.hs\nmapUniqDSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b\nmapUniqDSet f = mkUniqDSet . map f . uniqDSetToList\n\n-- Two 'UniqDSet's are considered equal if they contain the same\n-- uniques.\ninstance Eq (UniqDSet a) where\n  UniqDSet a == UniqDSet b = equalKeysUDFM a b\n\ngetUniqDSet :: UniqDSet a -> UniqDFM a\ngetUniqDSet = getUniqDSet'\n\ninstance Outputable a => Outputable (UniqDSet a) where\n  ppr = pprUniqDSet ppr\n\npprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc\npprUniqDSet f = braces . pprWithCommas f . uniqDSetToList\n", "num_lines": 142}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1994-1998\n\n\nUniqFM: Specialised finite maps, for things with @Uniques@.\n\nBasically, the things need to be in class @Uniquable@, and we use the\n@getUnique@ method to grab their @Uniques@.\n\n(A similar thing to @UniqSet@, as opposed to @Set@.)\n\nThe interface is based on @FiniteMap@s, but the implementation uses\n@Data.IntMap@, which is both maintained and faster than the past\nimplementation (see commit log).\n\nThe @UniqFM@ interface maps directly to Data.IntMap, only\n``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased\nand ``addToUFM\\_C'' and ``Data.IntMap.insertWith'' differ in the order\nof arguments of combining function.\n-}\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# OPTIONS_GHC -Wall #-}\n\nmodule UniqFM (\n        -- * Unique-keyed mappings\n        UniqFM,       -- abstract type\n\n        -- ** Manipulating those mappings\n        emptyUFM,\n        unitUFM,\n        unitDirectlyUFM,\n        listToUFM,\n        listToUFM_Directly,\n        listToUFM_C,\n        addToUFM,addToUFM_C,addToUFM_Acc,\n        addListToUFM,addListToUFM_C,\n        addToUFM_Directly,\n        addListToUFM_Directly,\n        adjustUFM, alterUFM,\n        adjustUFM_Directly,\n        delFromUFM,\n        delFromUFM_Directly,\n        delListFromUFM,\n        delListFromUFM_Directly,\n        plusUFM,\n        plusUFM_C,\n        plusUFM_CD,\n        plusMaybeUFM_C,\n        plusUFMList,\n        minusUFM,\n        intersectUFM,\n        intersectUFM_C,\n        disjointUFM,\n        equalKeysUFM,\n        nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,\n        anyUFM, allUFM, seqEltsUFM,\n        mapUFM, mapUFM_Directly,\n        elemUFM, elemUFM_Directly,\n        filterUFM, filterUFM_Directly, partitionUFM,\n        sizeUFM,\n        isNullUFM,\n        lookupUFM, lookupUFM_Directly,\n        lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,\n        nonDetEltsUFM, eltsUFM, nonDetKeysUFM,\n        ufmToSet_Directly,\n        nonDetUFMToList, ufmToIntMap,\n        pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM\n    ) where\n\nimport GhcPrelude\n\nimport Unique           ( Uniquable(..), Unique, getKey )\nimport Outputable\n\nimport qualified Data.IntMap as M\nimport qualified Data.IntSet as S\nimport Data.Data\nimport qualified Data.Semigroup as Semi\nimport Data.Functor.Classes (Eq1 (..))\n\n\nnewtype UniqFM ele = UFM (M.IntMap ele)\n  deriving (Data, Eq, Functor)\n  -- We used to derive Traversable and Foldable, but they were nondeterministic\n  -- and not obvious at the call site. You can use explicit nonDetEltsUFM\n  -- and fold a list if needed.\n  -- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.\n\nemptyUFM :: UniqFM elt\nemptyUFM = UFM M.empty\n\nisNullUFM :: UniqFM elt -> Bool\nisNullUFM (UFM m) = M.null m\n\nunitUFM :: Uniquable key => key -> elt -> UniqFM elt\nunitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)\n\n-- when you've got the Unique already\nunitDirectlyUFM :: Unique -> elt -> UniqFM elt\nunitDirectlyUFM u v = UFM (M.singleton (getKey u) v)\n\nlistToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt\nlistToUFM = foldl' (\\m (k, v) -> addToUFM m k v) emptyUFM\n\nlistToUFM_Directly :: [(Unique, elt)] -> UniqFM elt\nlistToUFM_Directly = foldl' (\\m (u, v) -> addToUFM_Directly m u v) emptyUFM\n\nlistToUFM_C\n  :: Uniquable key\n  => (elt -> elt -> elt)\n  -> [(key, elt)]\n  -> UniqFM elt\nlistToUFM_C f = foldl' (\\m (k, v) -> addToUFM_C f m k v) emptyUFM\n\naddToUFM :: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt\naddToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)\n\naddListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt\naddListToUFM = foldl' (\\m (k, v) -> addToUFM m k v)\n\naddListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt\naddListToUFM_Directly = foldl' (\\m (k, v) -> addToUFM_Directly m k v)\n\naddToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt\naddToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)\n\naddToUFM_C\n  :: Uniquable key\n  => (elt -> elt -> elt)  -- old -> new -> result\n  -> UniqFM elt           -- old\n  -> key -> elt           -- new\n  -> UniqFM elt           -- result\n-- Arguments of combining function of M.insertWith and addToUFM_C are flipped.\naddToUFM_C f (UFM m) k v =\n  UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)\n\naddToUFM_Acc\n  :: Uniquable key\n  => (elt -> elts -> elts)  -- Add to existing\n  -> (elt -> elts)          -- New element\n  -> UniqFM elts            -- old\n  -> key -> elt             -- new\n  -> UniqFM elts            -- result\naddToUFM_Acc exi new (UFM m) k v =\n  UFM (M.insertWith (\\_new old -> exi v old) (getKey $ getUnique k) (new v) m)\n\nalterUFM\n  :: Uniquable key\n  => (Maybe elt -> Maybe elt)  -- How to adjust\n  -> UniqFM elt                -- old\n  -> key                       -- new\n  -> UniqFM elt                -- result\nalterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)\n\naddListToUFM_C\n  :: Uniquable key\n  => (elt -> elt -> elt)\n  -> UniqFM elt -> [(key,elt)]\n  -> UniqFM elt\naddListToUFM_C f = foldl' (\\m (k, v) -> addToUFM_C f m k v)\n\nadjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt\nadjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)\n\nadjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt\nadjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)\n\ndelFromUFM :: Uniquable key => UniqFM elt -> key    -> UniqFM elt\ndelFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)\n\ndelListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt\ndelListFromUFM = foldl' delFromUFM\n\ndelListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt\ndelListFromUFM_Directly = foldl' delFromUFM_Directly\n\ndelFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt\ndelFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)\n\n-- Bindings in right argument shadow those in the left\nplusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt\n-- M.union is left-biased, plusUFM should be right-biased.\nplusUFM (UFM x) (UFM y) = UFM (M.union y x)\n     -- Note (M.union y x), with arguments flipped\n     -- M.union is left-biased, plusUFM should be right-biased.\n\nplusUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt\nplusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)\n\n-- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the\n-- combinding function and `d1` resp. `d2` as the default value if\n-- there is no entry in `m1` reps. `m2`. The domain is the union of\n-- the domains of `m1` and `m2`.\n--\n-- Representative example:\n--\n-- @\n-- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42\n--    == {A: f 1 42, B: f 2 3, C: f 23 4 }\n-- @\nplusUFM_CD\n  :: (elt -> elt -> elt)\n  -> UniqFM elt  -- map X\n  -> elt         -- default for X\n  -> UniqFM elt  -- map Y\n  -> elt         -- default for Y\n  -> UniqFM elt\nplusUFM_CD f (UFM xm) dx (UFM ym) dy\n  = UFM $ M.mergeWithKey\n      (\\_ x y -> Just (x `f` y))\n      (M.map (\\x -> x `f` dy))\n      (M.map (\\y -> dx `f` y))\n      xm ym\n\nplusMaybeUFM_C :: (elt -> elt -> Maybe elt)\n               -> UniqFM elt -> UniqFM elt -> UniqFM elt\nplusMaybeUFM_C f (UFM xm) (UFM ym)\n    = UFM $ M.mergeWithKey\n        (\\_ x y -> x `f` y)\n        id\n        id\n        xm ym\n\nplusUFMList :: [UniqFM elt] -> UniqFM elt\nplusUFMList = foldl' plusUFM emptyUFM\n\nminusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1\nminusUFM (UFM x) (UFM y) = UFM (M.difference x y)\n\nintersectUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1\nintersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)\n\nintersectUFM_C\n  :: (elt1 -> elt2 -> elt3)\n  -> UniqFM elt1\n  -> UniqFM elt2\n  -> UniqFM elt3\nintersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)\n\ndisjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool\ndisjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)\n\nfoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a\nfoldUFM k z (UFM m) = M.foldr k z m\n\nmapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2\nmapUFM f (UFM m) = UFM (M.map f m)\n\nmapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2\nmapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)\n\nfilterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt\nfilterUFM p (UFM m) = UFM (M.filter p m)\n\nfilterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt\nfilterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)\n\npartitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)\npartitionUFM p (UFM m) =\n  case M.partition p m of\n    (left, right) -> (UFM left, UFM right)\n\nsizeUFM :: UniqFM elt -> Int\nsizeUFM (UFM m) = M.size m\n\nelemUFM :: Uniquable key => key -> UniqFM elt -> Bool\nelemUFM k (UFM m) = M.member (getKey $ getUnique k) m\n\nelemUFM_Directly :: Unique -> UniqFM elt -> Bool\nelemUFM_Directly u (UFM m) = M.member (getKey u) m\n\nlookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt\nlookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m\n\n-- when you've got the Unique already\nlookupUFM_Directly :: UniqFM elt -> Unique -> Maybe elt\nlookupUFM_Directly (UFM m) u = M.lookup (getKey u) m\n\nlookupWithDefaultUFM :: Uniquable key => UniqFM elt -> elt -> key -> elt\nlookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m\n\nlookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt\nlookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m\n\neltsUFM :: UniqFM elt -> [elt]\neltsUFM (UFM m) = M.elems m\n\nufmToSet_Directly :: UniqFM elt -> S.IntSet\nufmToSet_Directly (UFM m) = M.keysSet m\n\nanyUFM :: (elt -> Bool) -> UniqFM elt -> Bool\nanyUFM p (UFM m) = M.foldr ((||) . p) False m\n\nallUFM :: (elt -> Bool) -> UniqFM elt -> Bool\nallUFM p (UFM m) = M.foldr ((&&) . p) True m\n\nseqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> ()\nseqEltsUFM seqList = seqList . nonDetEltsUFM\n  -- It's OK to use nonDetEltsUFM here because the type guarantees that\n  -- the only interesting thing this function can do is to force the\n  -- elements.\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetEltsUFM :: UniqFM elt -> [elt]\nnonDetEltsUFM (UFM m) = M.elems m\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetKeysUFM :: UniqFM elt -> [Unique]\nnonDetKeysUFM (UFM m) = map getUnique $ M.keys m\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a\nnonDetFoldUFM k z (UFM m) = M.foldr k z m\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a\nnonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetUFMToList :: UniqFM elt -> [(Unique, elt)]\nnonDetUFMToList (UFM m) = map (\\(k, v) -> (getUnique k, v)) $ M.toList m\n\nufmToIntMap :: UniqFM elt -> M.IntMap elt\nufmToIntMap (UFM m) = m\n\n-- Determines whether two 'UniqFM's contain the same keys.\nequalKeysUFM :: UniqFM a -> UniqFM b -> Bool\nequalKeysUFM (UFM m1) (UFM m2) = liftEq (\\_ _ -> True) m1 m2\n\n-- Instances\n\ninstance Semi.Semigroup (UniqFM a) where\n  (<>) = plusUFM\n\ninstance Monoid (UniqFM a) where\n    mempty = emptyUFM\n    mappend = (Semi.<>)\n\n-- Output-ery\n\ninstance Outputable a => Outputable (UniqFM a) where\n    ppr ufm = pprUniqFM ppr ufm\n\npprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc\npprUniqFM ppr_elt ufm\n  = brackets $ fsep $ punctuate comma $\n    [ ppr uq <+> text \":->\" <+> ppr_elt elt\n    | (uq, elt) <- nonDetUFMToList ufm ]\n  -- It's OK to use nonDetUFMToList here because we only use it for\n  -- pretty-printing.\n\n-- | Pretty-print a non-deterministic set.\n-- The order of variables is non-deterministic and for pretty-printing that\n-- shouldn't be a problem.\n-- Having this function helps contain the non-determinism created with\n-- nonDetEltsUFM.\npprUFM :: UniqFM a      -- ^ The things to be pretty printed\n       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements\n       -> SDoc          -- ^ 'SDoc' where the things have been pretty\n                        -- printed\npprUFM ufm pp = pp (nonDetEltsUFM ufm)\n\n-- | Pretty-print a non-deterministic set.\n-- The order of variables is non-deterministic and for pretty-printing that\n-- shouldn't be a problem.\n-- Having this function helps contain the non-determinism created with\n-- nonDetUFMToList.\npprUFMWithKeys\n       :: UniqFM a                -- ^ The things to be pretty printed\n       -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements\n       -> SDoc                    -- ^ 'SDoc' where the things have been pretty\n                                  -- printed\npprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)\n\n-- | Determines the pluralisation suffix appropriate for the length of a set\n-- in the same way that plural from Outputable does for lists.\npluralUFM :: UniqFM a -> SDoc\npluralUFM ufm\n  | sizeUFM ufm == 1 = empty\n  | otherwise = char 's'\n", "num_lines": 394}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# OPTIONS_GHC -Wall #-}\n\n-- Like 'UniqFM', these are maps for keys which are Uniquable.\n-- Unlike 'UniqFM', these maps also remember their keys, which\n-- makes them a much better drop in replacement for 'Data.Map.Map'.\n--\n-- Key preservation is right-biased.\nmodule UniqMap (\n    UniqMap,\n    emptyUniqMap,\n    isNullUniqMap,\n    unitUniqMap,\n    listToUniqMap,\n    listToUniqMap_C,\n    addToUniqMap,\n    addListToUniqMap,\n    addToUniqMap_C,\n    addToUniqMap_Acc,\n    alterUniqMap,\n    addListToUniqMap_C,\n    adjustUniqMap,\n    delFromUniqMap,\n    delListFromUniqMap,\n    plusUniqMap,\n    plusUniqMap_C,\n    plusMaybeUniqMap_C,\n    plusUniqMapList,\n    minusUniqMap,\n    intersectUniqMap,\n    disjointUniqMap,\n    mapUniqMap,\n    filterUniqMap,\n    partitionUniqMap,\n    sizeUniqMap,\n    elemUniqMap,\n    lookupUniqMap,\n    lookupWithDefaultUniqMap,\n    anyUniqMap,\n    allUniqMap,\n    -- Non-deterministic functions omitted\n) where\n\nimport GhcPrelude\n\nimport UniqFM\n\nimport Unique\nimport Outputable\n\nimport Data.Semigroup as Semi ( Semigroup(..) )\nimport Data.Coerce\nimport Data.Maybe\nimport Data.Data\n\n-- | Maps indexed by 'Uniquable' keys\nnewtype UniqMap k a = UniqMap (UniqFM (k, a))\n    deriving (Data, Eq, Functor)\ntype role UniqMap nominal representational\n\ninstance Semigroup (UniqMap k a) where\n  (<>) = plusUniqMap\n\ninstance Monoid (UniqMap k a) where\n    mempty = emptyUniqMap\n    mappend = (Semi.<>)\n\ninstance (Outputable k, Outputable a) => Outputable (UniqMap k a) where\n    ppr (UniqMap m) =\n        brackets $ fsep $ punctuate comma $\n        [ ppr k <+> text \"->\" <+> ppr v\n        | (k, v) <- eltsUFM m ]\n\nliftC :: (a -> a -> a) -> (k, a) -> (k, a) -> (k, a)\nliftC f (_, v) (k', v') = (k', f v v')\n\nemptyUniqMap :: UniqMap k a\nemptyUniqMap = UniqMap emptyUFM\n\nisNullUniqMap :: UniqMap k a -> Bool\nisNullUniqMap (UniqMap m) = isNullUFM m\n\nunitUniqMap :: Uniquable k => k -> a -> UniqMap k a\nunitUniqMap k v = UniqMap (unitUFM k (k, v))\n\nlistToUniqMap :: Uniquable k => [(k,a)] -> UniqMap k a\nlistToUniqMap kvs = UniqMap (listToUFM [ (k,(k,v)) | (k,v) <- kvs])\n\nlistToUniqMap_C :: Uniquable k => (a -> a -> a) -> [(k,a)] -> UniqMap k a\nlistToUniqMap_C f kvs = UniqMap $\n    listToUFM_C (liftC f) [ (k,(k,v)) | (k,v) <- kvs]\n\naddToUniqMap :: Uniquable k => UniqMap k a -> k -> a -> UniqMap k a\naddToUniqMap (UniqMap m) k v = UniqMap $ addToUFM m k (k, v)\n\naddListToUniqMap :: Uniquable k => UniqMap k a -> [(k,a)] -> UniqMap k a\naddListToUniqMap (UniqMap m) kvs = UniqMap $\n    addListToUFM m [(k,(k,v)) | (k,v) <- kvs]\n\naddToUniqMap_C :: Uniquable k\n               => (a -> a -> a)\n               -> UniqMap k a\n               -> k\n               -> a\n               -> UniqMap k a\naddToUniqMap_C f (UniqMap m) k v = UniqMap $\n    addToUFM_C (liftC f) m k (k, v)\n\naddToUniqMap_Acc :: Uniquable k\n                 => (b -> a -> a)\n                 -> (b -> a)\n                 -> UniqMap k a\n                 -> k\n                 -> b\n                 -> UniqMap k a\naddToUniqMap_Acc exi new (UniqMap m) k0 v0 = UniqMap $\n    addToUFM_Acc (\\b (k, v) -> (k, exi b v))\n                 (\\b -> (k0, new b))\n                 m k0 v0\n\nalterUniqMap :: Uniquable k\n             => (Maybe a -> Maybe a)\n             -> UniqMap k a\n             -> k\n             -> UniqMap k a\nalterUniqMap f (UniqMap m) k = UniqMap $\n    alterUFM (fmap (k,) . f . fmap snd) m k\n\naddListToUniqMap_C\n    :: Uniquable k\n    => (a -> a -> a)\n    -> UniqMap k a\n    -> [(k, a)]\n    -> UniqMap k a\naddListToUniqMap_C f (UniqMap m) kvs = UniqMap $\n    addListToUFM_C (liftC f) m\n        [(k,(k,v)) | (k,v) <- kvs]\n\nadjustUniqMap\n    :: Uniquable k\n    => (a -> a)\n    -> UniqMap k a\n    -> k\n    -> UniqMap k a\nadjustUniqMap f (UniqMap m) k = UniqMap $\n    adjustUFM (\\(_,v) -> (k,f v)) m k\n\ndelFromUniqMap :: Uniquable k => UniqMap k a -> k -> UniqMap k a\ndelFromUniqMap (UniqMap m) k = UniqMap $ delFromUFM m k\n\ndelListFromUniqMap :: Uniquable k => UniqMap k a -> [k] -> UniqMap k a\ndelListFromUniqMap (UniqMap m) ks = UniqMap $ delListFromUFM m ks\n\nplusUniqMap :: UniqMap k a -> UniqMap k a -> UniqMap k a\nplusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ plusUFM m1 m2\n\nplusUniqMap_C :: (a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a\nplusUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $\n    plusUFM_C (liftC f) m1 m2\n\nplusMaybeUniqMap_C :: (a -> a -> Maybe a) -> UniqMap k a -> UniqMap k a -> UniqMap k a\nplusMaybeUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $\n    plusMaybeUFM_C (\\(_, v) (k', v') -> fmap (k',) (f v v')) m1 m2\n\nplusUniqMapList :: [UniqMap k a] -> UniqMap k a\nplusUniqMapList xs = UniqMap $ plusUFMList (coerce xs)\n\nminusUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a\nminusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ minusUFM m1 m2\n\nintersectUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a\nintersectUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ intersectUFM m1 m2\n\ndisjointUniqMap :: UniqMap k a -> UniqMap k b -> Bool\ndisjointUniqMap (UniqMap m1) (UniqMap m2) = disjointUFM m1 m2\n\nmapUniqMap :: (a -> b) -> UniqMap k a -> UniqMap k b\nmapUniqMap f (UniqMap m) = UniqMap $ mapUFM (fmap f) m -- (,) k instance\n\nfilterUniqMap :: (a -> Bool) -> UniqMap k a -> UniqMap k a\nfilterUniqMap f (UniqMap m) = UniqMap $ filterUFM (f . snd) m\n\npartitionUniqMap :: (a -> Bool) -> UniqMap k a -> (UniqMap k a, UniqMap k a)\npartitionUniqMap f (UniqMap m) =\n    coerce $ partitionUFM (f . snd) m\n\nsizeUniqMap :: UniqMap k a -> Int\nsizeUniqMap (UniqMap m) = sizeUFM m\n\nelemUniqMap :: Uniquable k => k -> UniqMap k a -> Bool\nelemUniqMap k (UniqMap m) = elemUFM k m\n\nlookupUniqMap :: Uniquable k => UniqMap k a -> k -> Maybe a\nlookupUniqMap (UniqMap m) k = fmap snd (lookupUFM m k)\n\nlookupWithDefaultUniqMap :: Uniquable k => UniqMap k a -> a -> k -> a\nlookupWithDefaultUniqMap (UniqMap m) a k = fromMaybe a (fmap snd (lookupUFM m k))\n\nanyUniqMap :: (a -> Bool) -> UniqMap k a -> Bool\nanyUniqMap f (UniqMap m) = anyUFM (f . snd) m\n\nallUniqMap :: (a -> Bool) -> UniqMap k a -> Bool\nallUniqMap f (UniqMap m) = allUFM (f . snd) m\n", "num_lines": 207}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n(c) The University of Glasgow 2006\n(c) The AQUA Project, Glasgow University, 1994-1998\n\n\\section[UniqSet]{Specialised sets, for things with @Uniques@}\n\nBased on @UniqFMs@ (as you would expect).\n\nBasically, the things need to be in class @Uniquable@.\n-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule UniqSet (\n        -- * Unique set type\n        UniqSet,    -- type synonym for UniqFM a\n        getUniqSet,\n        pprUniqSet,\n\n        -- ** Manipulating these sets\n        emptyUniqSet,\n        unitUniqSet,\n        mkUniqSet,\n        addOneToUniqSet, addListToUniqSet,\n        delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet,\n        delListFromUniqSet_Directly,\n        unionUniqSets, unionManyUniqSets,\n        minusUniqSet, uniqSetMinusUFM,\n        intersectUniqSets,\n        restrictUniqSetToUFM,\n        uniqSetAny, uniqSetAll,\n        elementOfUniqSet,\n        elemUniqSet_Directly,\n        filterUniqSet,\n        filterUniqSet_Directly,\n        sizeUniqSet,\n        isEmptyUniqSet,\n        lookupUniqSet,\n        lookupUniqSet_Directly,\n        partitionUniqSet,\n        mapUniqSet,\n        unsafeUFMToUniqSet,\n        nonDetEltsUniqSet,\n        nonDetKeysUniqSet,\n        nonDetFoldUniqSet,\n        nonDetFoldUniqSet_Directly\n    ) where\n\nimport GhcPrelude\n\nimport UniqFM\nimport Unique\nimport Data.Coerce\nimport Outputable\nimport Data.Data\nimport qualified Data.Semigroup as Semi\n\n-- Note [UniqSet invariant]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~\n-- UniqSet has the following invariant:\n--   The keys in the map are the uniques of the values\n-- It means that to implement mapUniqSet you have to update\n-- both the keys and the values.\n\nnewtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a}\n                  deriving (Data, Semi.Semigroup, Monoid)\n\nemptyUniqSet :: UniqSet a\nemptyUniqSet = UniqSet emptyUFM\n\nunitUniqSet :: Uniquable a => a -> UniqSet a\nunitUniqSet x = UniqSet $ unitUFM x x\n\nmkUniqSet :: Uniquable a => [a]  -> UniqSet a\nmkUniqSet = foldl' addOneToUniqSet emptyUniqSet\n\naddOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a\naddOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x)\n\naddListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a\naddListToUniqSet = foldl' addOneToUniqSet\n\ndelOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a\ndelOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a)\n\ndelOneFromUniqSet_Directly :: UniqSet a -> Unique -> UniqSet a\ndelOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u)\n\ndelListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a\ndelListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l)\n\ndelListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a\ndelListFromUniqSet_Directly (UniqSet s) l =\n    UniqSet (delListFromUFM_Directly s l)\n\nunionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a\nunionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t)\n\nunionManyUniqSets :: [UniqSet a] -> UniqSet a\nunionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet\n\nminusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a\nminusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t)\n\nintersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a\nintersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t)\n\nrestrictUniqSetToUFM :: UniqSet a -> UniqFM b -> UniqSet a\nrestrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)\n\nuniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a\nuniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t)\n\nelementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool\nelementOfUniqSet a (UniqSet s) = elemUFM a s\n\nelemUniqSet_Directly :: Unique -> UniqSet a -> Bool\nelemUniqSet_Directly a (UniqSet s) = elemUFM_Directly a s\n\nfilterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a\nfilterUniqSet p (UniqSet s) = UniqSet (filterUFM p s)\n\nfilterUniqSet_Directly :: (Unique -> elt -> Bool) -> UniqSet elt -> UniqSet elt\nfilterUniqSet_Directly f (UniqSet s) = UniqSet (filterUFM_Directly f s)\n\npartitionUniqSet :: (a -> Bool) -> UniqSet a -> (UniqSet a, UniqSet a)\npartitionUniqSet p (UniqSet s) = coerce (partitionUFM p s)\n\nuniqSetAny :: (a -> Bool) -> UniqSet a -> Bool\nuniqSetAny p (UniqSet s) = anyUFM p s\n\nuniqSetAll :: (a -> Bool) -> UniqSet a -> Bool\nuniqSetAll p (UniqSet s) = allUFM p s\n\nsizeUniqSet :: UniqSet a -> Int\nsizeUniqSet (UniqSet s) = sizeUFM s\n\nisEmptyUniqSet :: UniqSet a -> Bool\nisEmptyUniqSet (UniqSet s) = isNullUFM s\n\nlookupUniqSet :: Uniquable a => UniqSet b -> a -> Maybe b\nlookupUniqSet (UniqSet s) k = lookupUFM s k\n\nlookupUniqSet_Directly :: UniqSet a -> Unique -> Maybe a\nlookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetEltsUniqSet :: UniqSet elt -> [elt]\nnonDetEltsUniqSet = nonDetEltsUFM . getUniqSet'\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetKeysUniqSet :: UniqSet elt -> [Unique]\nnonDetKeysUniqSet = nonDetKeysUFM . getUniqSet'\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a\nnonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s\n\n-- See Note [Deterministic UniqFM] to learn about nondeterminism.\n-- If you use this please provide a justification why it doesn't introduce\n-- nondeterminism.\nnonDetFoldUniqSet_Directly:: (Unique -> elt -> a -> a) -> a -> UniqSet elt -> a\nnonDetFoldUniqSet_Directly f n (UniqSet s) = nonDetFoldUFM_Directly f n s\n\n-- See Note [UniqSet invariant]\nmapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b\nmapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet\n\n-- Two 'UniqSet's are considered equal if they contain the same\n-- uniques.\ninstance Eq (UniqSet a) where\n  UniqSet a == UniqSet b = equalKeysUFM a b\n\ngetUniqSet :: UniqSet a -> UniqFM a\ngetUniqSet = getUniqSet'\n\n-- | 'unsafeUFMToUniqSet' converts a @'UniqFM' a@ into a @'UniqSet' a@\n-- assuming, without checking, that it maps each 'Unique' to a value\n-- that has that 'Unique'. See Note [UniqSet invariant].\nunsafeUFMToUniqSet :: UniqFM a -> UniqSet a\nunsafeUFMToUniqSet = UniqSet\n\ninstance Outputable a => Outputable (UniqSet a) where\n    ppr = pprUniqSet ppr\n\npprUniqSet :: (a -> SDoc) -> UniqSet a -> SDoc\n-- It's OK to use nonDetUFMToList here because we only use it for\n-- pretty-printing.\npprUniqSet f = braces . pprWithCommas f . nonDetEltsUniqSet\n", "num_lines": 196}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nCopyright (c) 2014 Joachim Breitner\n\nA data structure for undirected graphs of variables\n(or in plain terms: Sets of unordered pairs of numbers)\n\n\nThis is very specifically tailored for the use in CallArity. In particular it\nstores the graph as a union of complete and complete bipartite graph, which\nwould be very expensive to store as sets of edges or as adjanceny lists.\n\nIt does not normalize the graphs. This means that g `unionUnVarGraph` g is\nequal to g, but twice as expensive and large.\n\n-}\nmodule UnVarGraph\n    ( UnVarSet\n    , emptyUnVarSet, mkUnVarSet, varEnvDom, unionUnVarSet, unionUnVarSets\n    , delUnVarSet\n    , elemUnVarSet, isEmptyUnVarSet\n    , UnVarGraph\n    , emptyUnVarGraph\n    , unionUnVarGraph, unionUnVarGraphs\n    , completeGraph, completeBipartiteGraph\n    , neighbors\n    , hasLoopAt\n    , delNode\n    ) where\n\nimport GhcPrelude\n\nimport Id\nimport VarEnv\nimport UniqFM\nimport Outputable\nimport Bag\nimport Unique\n\nimport qualified Data.IntSet as S\n\n-- We need a type for sets of variables (UnVarSet).\n-- We do not use VarSet, because for that we need to have the actual variable\n-- at hand, and we do not have that when we turn the domain of a VarEnv into a UnVarSet.\n-- Therefore, use a IntSet directly (which is likely also a bit more efficient).\n\n-- Set of uniques, i.e. for adjancet nodes\nnewtype UnVarSet = UnVarSet (S.IntSet)\n    deriving Eq\n\nk :: Var -> Int\nk v = getKey (getUnique v)\n\nemptyUnVarSet :: UnVarSet\nemptyUnVarSet = UnVarSet S.empty\n\nelemUnVarSet :: Var -> UnVarSet -> Bool\nelemUnVarSet v (UnVarSet s) = k v `S.member` s\n\n\nisEmptyUnVarSet :: UnVarSet -> Bool\nisEmptyUnVarSet (UnVarSet s) = S.null s\n\ndelUnVarSet :: UnVarSet -> Var -> UnVarSet\ndelUnVarSet (UnVarSet s) v = UnVarSet $ k v `S.delete` s\n\nmkUnVarSet :: [Var] -> UnVarSet\nmkUnVarSet vs = UnVarSet $ S.fromList $ map k vs\n\nvarEnvDom :: VarEnv a -> UnVarSet\nvarEnvDom ae = UnVarSet $ ufmToSet_Directly ae\n\nunionUnVarSet :: UnVarSet -> UnVarSet -> UnVarSet\nunionUnVarSet (UnVarSet set1) (UnVarSet set2) = UnVarSet (set1 `S.union` set2)\n\nunionUnVarSets :: [UnVarSet] -> UnVarSet\nunionUnVarSets = foldr unionUnVarSet emptyUnVarSet\n\ninstance Outputable UnVarSet where\n    ppr (UnVarSet s) = braces $\n        hcat $ punctuate comma [ ppr (getUnique i) | i <- S.toList s]\n\n\n-- The graph type. A list of complete bipartite graphs\ndata Gen = CBPG UnVarSet UnVarSet -- complete bipartite\n         | CG   UnVarSet          -- complete\nnewtype UnVarGraph = UnVarGraph (Bag Gen)\n\nemptyUnVarGraph :: UnVarGraph\nemptyUnVarGraph = UnVarGraph emptyBag\n\nunionUnVarGraph :: UnVarGraph -> UnVarGraph -> UnVarGraph\n{-\nPremature optimisation, it seems.\nunionUnVarGraph (UnVarGraph [CBPG s1 s2]) (UnVarGraph [CG s3, CG s4])\n    | s1 == s3 && s2 == s4\n    = pprTrace \"unionUnVarGraph fired\" empty $\n      completeGraph (s1 `unionUnVarSet` s2)\nunionUnVarGraph (UnVarGraph [CBPG s1 s2]) (UnVarGraph [CG s3, CG s4])\n    | s2 == s3 && s1 == s4\n    = pprTrace \"unionUnVarGraph fired2\" empty $\n      completeGraph (s1 `unionUnVarSet` s2)\n-}\nunionUnVarGraph (UnVarGraph g1) (UnVarGraph g2)\n    = -- pprTrace \"unionUnVarGraph\" (ppr (length g1, length g2)) $\n      UnVarGraph (g1 `unionBags` g2)\n\nunionUnVarGraphs :: [UnVarGraph] -> UnVarGraph\nunionUnVarGraphs = foldl' unionUnVarGraph emptyUnVarGraph\n\n-- completeBipartiteGraph A B = { {a,b} | a \u00e2\u02c6\u02c6 A, b \u00e2\u02c6\u02c6 B }\ncompleteBipartiteGraph :: UnVarSet -> UnVarSet -> UnVarGraph\ncompleteBipartiteGraph s1 s2 = prune $ UnVarGraph $ unitBag $ CBPG s1 s2\n\ncompleteGraph :: UnVarSet -> UnVarGraph\ncompleteGraph s = prune $ UnVarGraph $ unitBag $ CG s\n\nneighbors :: UnVarGraph -> Var -> UnVarSet\nneighbors (UnVarGraph g) v = unionUnVarSets $ concatMap go $ bagToList g\n  where go (CG s)       = (if v `elemUnVarSet` s then [s] else [])\n        go (CBPG s1 s2) = (if v `elemUnVarSet` s1 then [s2] else []) ++\n                          (if v `elemUnVarSet` s2 then [s1] else [])\n\n-- hasLoopAt G v <=> v--v \u00e2\u02c6\u02c6 G\nhasLoopAt :: UnVarGraph -> Var -> Bool\nhasLoopAt (UnVarGraph g) v = any go $ bagToList g\n  where go (CG s)       = v `elemUnVarSet` s\n        go (CBPG s1 s2) = v `elemUnVarSet` s1 && v `elemUnVarSet` s2\n\n\ndelNode :: UnVarGraph -> Var -> UnVarGraph\ndelNode (UnVarGraph g) v = prune $ UnVarGraph $ mapBag go g\n  where go (CG s)       = CG (s `delUnVarSet` v)\n        go (CBPG s1 s2) = CBPG (s1 `delUnVarSet` v) (s2 `delUnVarSet` v)\n\nprune :: UnVarGraph -> UnVarGraph\nprune (UnVarGraph g) = UnVarGraph $ filterBag go g\n  where go (CG s)       = not (isEmptyUnVarSet s)\n        go (CBPG s1 s2) = not (isEmptyUnVarSet s1) && not (isEmptyUnVarSet s2)\n\ninstance Outputable Gen where\n    ppr (CG s)       = ppr s  <> char '\u00c2\u00b2'\n    ppr (CBPG s1 s2) = ppr s1 <+> char 'x' <+> ppr s2\ninstance Outputable UnVarGraph where\n    ppr (UnVarGraph g) = ppr g\n", "num_lines": 146}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) The University of Glasgow 2006\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE TupleSections #-}\n\n-- | Highly random utility functions\n--\nmodule Util (\n        -- * Flags dependent on the compiler build\n        ghciSupported, debugIsOn, ncgDebugIsOn,\n        ghciTablesNextToCode,\n        isWindowsHost, isDarwinHost,\n\n        -- * General list processing\n        zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,\n        zipLazy, stretchZipWith, zipWithAndUnzip, zipAndUnzip,\n\n        zipWithLazy, zipWith3Lazy,\n\n        filterByList, filterByLists, partitionByList,\n\n        unzipWith,\n\n        mapFst, mapSnd, chkAppend,\n        mapAndUnzip, mapAndUnzip3, mapAccumL2,\n        nOfThem, filterOut, partitionWith,\n\n        dropWhileEndLE, spanEnd, last2, lastMaybe,\n\n        foldl1', foldl2, count, countWhile, all2,\n\n        lengthExceeds, lengthIs, lengthIsNot,\n        lengthAtLeast, lengthAtMost, lengthLessThan,\n        listLengthCmp, atLength,\n        equalLength, neLength, compareLength, leLength, ltLength,\n\n        isSingleton, only, singleton,\n        notNull, snocView,\n\n        isIn, isn'tIn,\n\n        chunkList,\n\n        changeLast,\n\n        -- * Tuples\n        fstOf3, sndOf3, thdOf3,\n        firstM, first3M, secondM,\n        fst3, snd3, third3,\n        uncurry3,\n        liftFst, liftSnd,\n\n        -- * List operations controlled by another list\n        takeList, dropList, splitAtList, split,\n        dropTail, capitalise,\n\n        -- * For loop\n        nTimes,\n\n        -- * Sorting\n        sortWith, minWith, nubSort, ordNub,\n\n        -- * Comparisons\n        isEqual, eqListBy, eqMaybeBy,\n        thenCmp, cmpList,\n        removeSpaces,\n        (<&&>), (<||>),\n\n        -- * Edit distance\n        fuzzyMatch, fuzzyLookup,\n\n        -- * Transitive closures\n        transitiveClosure,\n\n        -- * Strictness\n        seqList,\n\n        -- * Module names\n        looksLikeModuleName,\n        looksLikePackageName,\n\n        -- * Argument processing\n        getCmd, toCmdArgs, toArgs,\n\n        -- * Integers\n        exactLog2,\n\n        -- * Floating point\n        readRational,\n        readHexRational,\n\n        -- * read helpers\n        maybeRead, maybeReadFuzzy,\n\n        -- * IO-ish utilities\n        doesDirNameExist,\n        getModificationUTCTime,\n        modificationTimeIfExists,\n\n        global, consIORef, globalM,\n        sharedGlobal, sharedGlobalM,\n\n        -- * Filenames and paths\n        Suffix,\n        splitLongestPrefix,\n        escapeSpaces,\n        Direction(..), reslash,\n        makeRelativeTo,\n\n        -- * Utils for defining Data instances\n        abstractConstr, abstractDataType, mkNoRepType,\n\n        -- * Utils for printing C code\n        charToC,\n\n        -- * Hashing\n        hashString,\n\n        -- * Call stacks\n        HasCallStack,\n        HasDebugCallStack,\n\n        -- * Utils for flags\n        OverridingBool(..),\n        overrideWith,\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GhcPrelude\n\nimport Exception\nimport Panic\n\nimport Data.Data\nimport Data.IORef       ( IORef, newIORef, atomicModifyIORef' )\nimport System.IO.Unsafe ( unsafePerformIO )\nimport Data.List        hiding (group)\n\nimport GHC.Exts\nimport GHC.Stack (HasCallStack)\n\nimport Control.Applicative ( liftA2 )\nimport Control.Monad    ( liftM, guard )\nimport GHC.Conc.Sync ( sharedCAF )\nimport System.IO.Error as IO ( isDoesNotExistError )\nimport System.Directory ( doesDirectoryExist, getModificationTime )\nimport System.FilePath\n\nimport Data.Char        ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper\n                        , isHexDigit, digitToInt )\nimport Data.Int\nimport Data.Ratio       ( (%) )\nimport Data.Ord         ( comparing )\nimport Data.Bits\nimport Data.Word\nimport qualified Data.IntMap as IM\nimport qualified Data.Set as Set\n\nimport Data.Time\n\n#if defined(DEBUG)\nimport {-# SOURCE #-} Outputable ( warnPprTrace, text )\n#endif\n\ninfixr 9 `thenCmp`\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Is DEBUG on, are we on Windows, etc?}\n*                                                                      *\n************************************************************************\n\nThese booleans are global constants, set by CPP flags.  They allow us to\nrecompile a single module (this one) to change whether or not debug output\nappears. They sometimes let us avoid even running CPP elsewhere.\n\nIt's important that the flags are literal constants (True/False). Then,\nwith -0, tests of the flags in other modules will simplify to the correct\nbranch of the conditional, thereby dropping debug code altogether when\nthe flags are off.\n-}\n\nghciSupported :: Bool\n#if defined(GHCI)\nghciSupported = True\n#else\nghciSupported = False\n#endif\n\ndebugIsOn :: Bool\n#if defined(DEBUG)\ndebugIsOn = True\n#else\ndebugIsOn = False\n#endif\n\nncgDebugIsOn :: Bool\n#if defined(NCG_DEBUG)\nncgDebugIsOn = True\n#else\nncgDebugIsOn = False\n#endif\n\nghciTablesNextToCode :: Bool\n#if defined(GHCI_TABLES_NEXT_TO_CODE)\nghciTablesNextToCode = True\n#else\nghciTablesNextToCode = False\n#endif\n\nisWindowsHost :: Bool\n#if defined(mingw32_HOST_OS)\nisWindowsHost = True\n#else\nisWindowsHost = False\n#endif\n\nisDarwinHost :: Bool\n#if defined(darwin_HOST_OS)\nisDarwinHost = True\n#else\nisDarwinHost = False\n#endif\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{A for loop}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Compose a function with itself n times.  (nth rather than twice)\nnTimes :: Int -> (a -> a) -> (a -> a)\nnTimes 0 _ = id\nnTimes 1 f = f\nnTimes n f = f . nTimes (n-1) f\n\nfstOf3   :: (a,b,c) -> a\nsndOf3   :: (a,b,c) -> b\nthdOf3   :: (a,b,c) -> c\nfstOf3      (a,_,_) =  a\nsndOf3      (_,b,_) =  b\nthdOf3      (_,_,c) =  c\n\nfst3 :: (a -> d) -> (a, b, c) -> (d, b, c)\nfst3 f (a, b, c) = (f a, b, c)\n\nsnd3 :: (b -> d) -> (a, b, c) -> (a, d, c)\nsnd3 f (a, b, c) = (a, f b, c)\n\nthird3 :: (c -> d) -> (a, b, c) -> (a, b, d)\nthird3 f (a, b, c) = (a, b, f c)\n\nuncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d\nuncurry3 f (a, b, c) = f a b c\n\nliftFst :: (a -> b) -> (a, c) -> (b, c)\nliftFst f (a,c) = (f a, c)\n\nliftSnd :: (a -> b) -> (c, a) -> (c, b)\nliftSnd f (c,a) = (c, f a)\n\nfirstM :: Monad m => (a -> m c) -> (a, b) -> m (c, b)\nfirstM f (x, y) = liftM (\\x' -> (x', y)) (f x)\n\nfirst3M :: Monad m => (a -> m d) -> (a, b, c) -> m (d, b, c)\nfirst3M f (x, y, z) = liftM (\\x' -> (x', y, z)) (f x)\n\nsecondM :: Monad m => (b -> m c) -> (a, b) -> m (a, c)\nsecondM f (x, y) = (x,) <$> f y\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-lists]{General list processing}\n*                                                                      *\n************************************************************************\n-}\n\nfilterOut :: (a->Bool) -> [a] -> [a]\n-- ^ Like filter, only it reverses the sense of the test\nfilterOut _ [] = []\nfilterOut p (x:xs) | p x       = filterOut p xs\n                   | otherwise = x : filterOut p xs\n\npartitionWith :: (a -> Either b c) -> [a] -> ([b], [c])\n-- ^ Uses a function to determine which of two output lists an input element should join\npartitionWith _ [] = ([],[])\npartitionWith f (x:xs) = case f x of\n                         Left  b -> (b:bs, cs)\n                         Right c -> (bs, c:cs)\n    where (bs,cs) = partitionWith f xs\n\nchkAppend :: [a] -> [a] -> [a]\n-- Checks for the second argument being empty\n-- Used in situations where that situation is common\nchkAppend xs ys\n  | null ys   = xs\n  | otherwise = xs ++ ys\n\n{-\nA paranoid @zip@ (and some @zipWith@ friends) that checks the lists\nare of equal length.  Alastair Reid thinks this should only happen if\nDEBUGging on; hey, why not?\n-}\n\nzipEqual        :: String -> [a] -> [b] -> [(a,b)]\nzipWithEqual    :: String -> (a->b->c) -> [a]->[b]->[c]\nzipWith3Equal   :: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]\nzipWith4Equal   :: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]\n\n#if !defined(DEBUG)\nzipEqual      _ = zip\nzipWithEqual  _ = zipWith\nzipWith3Equal _ = zipWith3\nzipWith4Equal _ = zipWith4\n#else\nzipEqual _   []     []     = []\nzipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs\nzipEqual msg _      _      = panic (\"zipEqual: unequal lists:\"++msg)\n\nzipWithEqual msg z (a:as) (b:bs)=  z a b : zipWithEqual msg z as bs\nzipWithEqual _   _ [] []        =  []\nzipWithEqual msg _ _ _          =  panic (\"zipWithEqual: unequal lists:\"++msg)\n\nzipWith3Equal msg z (a:as) (b:bs) (c:cs)\n                                =  z a b c : zipWith3Equal msg z as bs cs\nzipWith3Equal _   _ [] []  []   =  []\nzipWith3Equal msg _ _  _   _    =  panic (\"zipWith3Equal: unequal lists:\"++msg)\n\nzipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)\n                                =  z a b c d : zipWith4Equal msg z as bs cs ds\nzipWith4Equal _   _ [] [] [] [] =  []\nzipWith4Equal msg _ _  _  _  _  =  panic (\"zipWith4Equal: unequal lists:\"++msg)\n#endif\n\n-- | 'zipLazy' is a kind of 'zip' that is lazy in the second list (observe the ~)\nzipLazy :: [a] -> [b] -> [(a,b)]\nzipLazy []     _       = []\nzipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys\n\n-- | 'zipWithLazy' is like 'zipWith' but is lazy in the second list.\n-- The length of the output is always the same as the length of the first\n-- list.\nzipWithLazy :: (a -> b -> c) -> [a] -> [b] -> [c]\nzipWithLazy _ []     _       = []\nzipWithLazy f (a:as) ~(b:bs) = f a b : zipWithLazy f as bs\n\n-- | 'zipWith3Lazy' is like 'zipWith3' but is lazy in the second and third lists.\n-- The length of the output is always the same as the length of the first\n-- list.\nzipWith3Lazy :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]\nzipWith3Lazy _ []     _       _       = []\nzipWith3Lazy f (a:as) ~(b:bs) ~(c:cs) = f a b c : zipWith3Lazy f as bs cs\n\n-- | 'filterByList' takes a list of Bools and a list of some elements and\n-- filters out these elements for which the corresponding value in the list of\n-- Bools is False. This function does not check whether the lists have equal\n-- length.\nfilterByList :: [Bool] -> [a] -> [a]\nfilterByList (True:bs)  (x:xs) = x : filterByList bs xs\nfilterByList (False:bs) (_:xs) =     filterByList bs xs\nfilterByList _          _      = []\n\n-- | 'filterByLists' takes a list of Bools and two lists as input, and\n-- outputs a new list consisting of elements from the last two input lists. For\n-- each Bool in the list, if it is 'True', then it takes an element from the\n-- former list. If it is 'False', it takes an element from the latter list.\n-- The elements taken correspond to the index of the Bool in its list.\n-- For example:\n--\n-- @\n-- filterByLists [True, False, True, False] \\\"abcd\\\" \\\"wxyz\\\" = \\\"axcz\\\"\n-- @\n--\n-- This function does not check whether the lists have equal length.\nfilterByLists :: [Bool] -> [a] -> [a] -> [a]\nfilterByLists (True:bs)  (x:xs) (_:ys) = x : filterByLists bs xs ys\nfilterByLists (False:bs) (_:xs) (y:ys) = y : filterByLists bs xs ys\nfilterByLists _          _      _      = []\n\n-- | 'partitionByList' takes a list of Bools and a list of some elements and\n-- partitions the list according to the list of Bools. Elements corresponding\n-- to 'True' go to the left; elements corresponding to 'False' go to the right.\n-- For example, @partitionByList [True, False, True] [1,2,3] == ([1,3], [2])@\n-- This function does not check whether the lists have equal\n-- length.\npartitionByList :: [Bool] -> [a] -> ([a], [a])\npartitionByList = go [] []\n  where\n    go trues falses (True  : bs) (x : xs) = go (x:trues) falses bs xs\n    go trues falses (False : bs) (x : xs) = go trues (x:falses) bs xs\n    go trues falses _ _ = (reverse trues, reverse falses)\n\nstretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]\n-- ^ @stretchZipWith p z f xs ys@ stretches @ys@ by inserting @z@ in\n-- the places where @p@ returns @True@\n\nstretchZipWith _ _ _ []     _ = []\nstretchZipWith p z f (x:xs) ys\n  | p x       = f x z : stretchZipWith p z f xs ys\n  | otherwise = case ys of\n                []     -> []\n                (y:ys) -> f x y : stretchZipWith p z f xs ys\n\nmapFst :: (a->c) -> [(a,b)] -> [(c,b)]\nmapSnd :: (b->c) -> [(a,b)] -> [(a,c)]\n\nmapFst f xys = [(f x, y) | (x,y) <- xys]\nmapSnd f xys = [(x, f y) | (x,y) <- xys]\n\nmapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])\n\nmapAndUnzip _ [] = ([], [])\nmapAndUnzip f (x:xs)\n  = let (r1,  r2)  = f x\n        (rs1, rs2) = mapAndUnzip f xs\n    in\n    (r1:rs1, r2:rs2)\n\nmapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])\n\nmapAndUnzip3 _ [] = ([], [], [])\nmapAndUnzip3 f (x:xs)\n  = let (r1,  r2,  r3)  = f x\n        (rs1, rs2, rs3) = mapAndUnzip3 f xs\n    in\n    (r1:rs1, r2:rs2, r3:rs3)\n\nzipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d])\nzipWithAndUnzip f (a:as) (b:bs)\n  = let (r1,  r2)  = f a b\n        (rs1, rs2) = zipWithAndUnzip f as bs\n    in\n    (r1:rs1, r2:rs2)\nzipWithAndUnzip _ _ _ = ([],[])\n\n-- | This has the effect of making the two lists have equal length by dropping\n-- the tail of the longer one.\nzipAndUnzip :: [a] -> [b] -> ([a],[b])\nzipAndUnzip (a:as) (b:bs)\n  = let (rs1, rs2) = zipAndUnzip as bs\n    in\n    (a:rs1, b:rs2)\nzipAndUnzip _ _ = ([],[])\n\nmapAccumL2 :: (s1 -> s2 -> a -> (s1, s2, b)) -> s1 -> s2 -> [a] -> (s1, s2, [b])\nmapAccumL2 f s1 s2 xs = (s1', s2', ys)\n  where ((s1', s2'), ys) = mapAccumL (\\(s1, s2) x -> case f s1 s2 x of\n                                                       (s1', s2', y) -> ((s1', s2'), y))\n                                     (s1, s2) xs\n\nnOfThem :: Int -> a -> [a]\nnOfThem n thing = replicate n thing\n\n-- | @atLength atLen atEnd ls n@ unravels list @ls@ to position @n@. Precisely:\n--\n-- @\n--  atLength atLenPred atEndPred ls n\n--   | n < 0         = atLenPred ls\n--   | length ls < n = atEndPred (n - length ls)\n--   | otherwise     = atLenPred (drop n ls)\n-- @\natLength :: ([a] -> b)   -- Called when length ls >= n, passed (drop n ls)\n                         --    NB: arg passed to this function may be []\n         -> b            -- Called when length ls <  n\n         -> [a]\n         -> Int\n         -> b\natLength atLenPred atEnd ls0 n0\n  | n0 < 0    = atLenPred ls0\n  | otherwise = go n0 ls0\n  where\n    -- go's first arg n >= 0\n    go 0 ls     = atLenPred ls\n    go _ []     = atEnd           -- n > 0 here\n    go n (_:xs) = go (n-1) xs\n\n-- Some special cases of atLength:\n\n-- | @(lengthExceeds xs n) = (length xs > n)@\nlengthExceeds :: [a] -> Int -> Bool\nlengthExceeds lst n\n  | n < 0\n  = True\n  | otherwise\n  = atLength notNull False lst n\n\n-- | @(lengthAtLeast xs n) = (length xs >= n)@\nlengthAtLeast :: [a] -> Int -> Bool\nlengthAtLeast = atLength (const True) False\n\n-- | @(lengthIs xs n) = (length xs == n)@\nlengthIs :: [a] -> Int -> Bool\nlengthIs lst n\n  | n < 0\n  = False\n  | otherwise\n  = atLength null False lst n\n\n-- | @(lengthIsNot xs n) = (length xs /= n)@\nlengthIsNot :: [a] -> Int -> Bool\nlengthIsNot lst n\n  | n < 0 = True\n  | otherwise = atLength notNull True lst n\n\n-- | @(lengthAtMost xs n) = (length xs <= n)@\nlengthAtMost :: [a] -> Int -> Bool\nlengthAtMost lst n\n  | n < 0\n  = False\n  | otherwise\n  = atLength null True lst n\n\n-- | @(lengthLessThan xs n) == (length xs < n)@\nlengthLessThan :: [a] -> Int -> Bool\nlengthLessThan = atLength (const False) True\n\nlistLengthCmp :: [a] -> Int -> Ordering\nlistLengthCmp = atLength atLen atEnd\n where\n  atEnd = LT    -- Not yet seen 'n' elts, so list length is < n.\n\n  atLen []     = EQ\n  atLen _      = GT\n\nequalLength :: [a] -> [b] -> Bool\n-- ^ True if length xs == length ys\nequalLength []     []     = True\nequalLength (_:xs) (_:ys) = equalLength xs ys\nequalLength _      _      = False\n\nneLength :: [a] -> [b] -> Bool\n-- ^ True if length xs /= length ys\nneLength []     []     = False\nneLength (_:xs) (_:ys) = neLength xs ys\nneLength _      _      = True\n\ncompareLength :: [a] -> [b] -> Ordering\ncompareLength []     []     = EQ\ncompareLength (_:xs) (_:ys) = compareLength xs ys\ncompareLength []     _      = LT\ncompareLength _      []     = GT\n\nleLength :: [a] -> [b] -> Bool\n-- ^ True if length xs <= length ys\nleLength xs ys = case compareLength xs ys of\n                   LT -> True\n                   EQ -> True\n                   GT -> False\n\nltLength :: [a] -> [b] -> Bool\n-- ^ True if length xs < length ys\nltLength xs ys = case compareLength xs ys of\n                   LT -> True\n                   EQ -> False\n                   GT -> False\n\n----------------------------\nsingleton :: a -> [a]\nsingleton x = [x]\n\nisSingleton :: [a] -> Bool\nisSingleton [_] = True\nisSingleton _   = False\n\nnotNull :: [a] -> Bool\nnotNull [] = False\nnotNull _  = True\n\nonly :: [a] -> a\n#if defined(DEBUG)\nonly [a] = a\n#else\nonly (a:_) = a\n#endif\nonly _ = panic \"Util: only\"\n\n-- Debugging/specialising versions of \\tr{elem} and \\tr{notElem}\n\nisIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool\n\n# ifndef DEBUG\nisIn    _msg x ys = x `elem` ys\nisn'tIn _msg x ys = x `notElem` ys\n\n# else /* DEBUG */\nisIn msg x ys\n  = elem100 0 x ys\n  where\n    elem100 :: Eq a => Int -> a -> [a] -> Bool\n    elem100 _ _ [] = False\n    elem100 i x (y:ys)\n      | i > 100 = WARN(True, text (\"Over-long elem in \" ++ msg)) (x `elem` (y:ys))\n      | otherwise = x == y || elem100 (i + 1) x ys\n\nisn'tIn msg x ys\n  = notElem100 0 x ys\n  where\n    notElem100 :: Eq a => Int -> a -> [a] -> Bool\n    notElem100 _ _ [] =  True\n    notElem100 i x (y:ys)\n      | i > 100 = WARN(True, text (\"Over-long notElem in \" ++ msg)) (x `notElem` (y:ys))\n      | otherwise = x /= y && notElem100 (i + 1) x ys\n# endif /* DEBUG */\n\n\n-- | Split a list into chunks of /n/ elements\nchunkList :: Int -> [a] -> [[a]]\nchunkList _ [] = []\nchunkList n xs = as : chunkList n bs where (as,bs) = splitAt n xs\n\n-- | Replace the last element of a list with another element.\nchangeLast :: [a] -> a -> [a]\nchangeLast []     _  = panic \"changeLast\"\nchangeLast [_]    x  = [x]\nchangeLast (x:xs) x' = x : changeLast xs x'\n\n{-\n************************************************************************\n*                                                                      *\n\\subsubsection{Sort utils}\n*                                                                      *\n************************************************************************\n-}\n\nminWith :: Ord b => (a -> b) -> [a] -> a\nminWith get_key xs = ASSERT( not (null xs) )\n                     head (sortWith get_key xs)\n\nnubSort :: Ord a => [a] -> [a]\nnubSort = Set.toAscList . Set.fromList\n\n-- | Remove duplicates but keep elements in order.\n--   O(n * log n)\nordNub :: Ord a => [a] -> [a]\nordNub xs\n  = go Set.empty xs\n  where\n    go _ [] = []\n    go s (x:xs)\n      | Set.member x s = go s xs\n      | otherwise = x : go (Set.insert x s) xs\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-transitive-closure]{Transitive closure}\n*                                                                      *\n************************************************************************\n\nThis algorithm for transitive closure is straightforward, albeit quadratic.\n-}\n\ntransitiveClosure :: (a -> [a])         -- Successor function\n                  -> (a -> a -> Bool)   -- Equality predicate\n                  -> [a]\n                  -> [a]                -- The transitive closure\n\ntransitiveClosure succ eq xs\n = go [] xs\n where\n   go done []                      = done\n   go done (x:xs) | x `is_in` done = go done xs\n                  | otherwise      = go (x:done) (succ x ++ xs)\n\n   _ `is_in` []                 = False\n   x `is_in` (y:ys) | eq x y    = True\n                    | otherwise = x `is_in` ys\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-accum]{Accumulating}\n*                                                                      *\n************************************************************************\n\nA combination of foldl with zip.  It works with equal length lists.\n-}\n\nfoldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc\nfoldl2 _ z [] [] = z\nfoldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs\nfoldl2 _ _ _      _      = panic \"Util: foldl2\"\n\nall2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool\n-- True if the lists are the same length, and\n-- all corresponding elements satisfy the predicate\nall2 _ []     []     = True\nall2 p (x:xs) (y:ys) = p x y && all2 p xs ys\nall2 _ _      _      = False\n\n-- Count the number of times a predicate is true\n\ncount :: (a -> Bool) -> [a] -> Int\ncount p = go 0\n  where go !n [] = n\n        go !n (x:xs) | p x       = go (n+1) xs\n                     | otherwise = go n xs\n\ncountWhile :: (a -> Bool) -> [a] -> Int\n-- Length of an /initial prefix/ of the list satsifying p\ncountWhile p = go 0\n  where go !n (x:xs) | p x = go (n+1) xs\n        go !n _            = n\n\n{-\n@splitAt@, @take@, and @drop@ but with length of another\nlist giving the break-off point:\n-}\n\ntakeList :: [b] -> [a] -> [a]\n-- (takeList as bs) trims bs to the be same length\n-- as as, unless as is longer in which case it's a no-op\ntakeList [] _ = []\ntakeList (_:xs) ls =\n   case ls of\n     [] -> []\n     (y:ys) -> y : takeList xs ys\n\ndropList :: [b] -> [a] -> [a]\ndropList [] xs    = xs\ndropList _  xs@[] = xs\ndropList (_:xs) (_:ys) = dropList xs ys\n\n\nsplitAtList :: [b] -> [a] -> ([a], [a])\nsplitAtList [] xs     = ([], xs)\nsplitAtList _ xs@[]   = (xs, xs)\nsplitAtList (_:xs) (y:ys) = (y:ys', ys'')\n    where\n      (ys', ys'') = splitAtList xs ys\n\n-- drop from the end of a list\ndropTail :: Int -> [a] -> [a]\n-- Specification: dropTail n = reverse . drop n . reverse\n-- Better implemention due to Joachim Breitner\n-- http://www.joachim-breitner.de/blog/archives/600-On-taking-the-last-n-elements-of-a-list.html\ndropTail n xs\n  = go (drop n xs) xs\n  where\n    go (_:ys) (x:xs) = x : go ys xs\n    go _      _      = []  -- Stop when ys runs out\n                           -- It'll always run out before xs does\n\n-- dropWhile from the end of a list. This is similar to Data.List.dropWhileEnd,\n-- but is lazy in the elements and strict in the spine. For reasonably short lists,\n-- such as path names and typical lines of text, dropWhileEndLE is generally\n-- faster than dropWhileEnd. Its advantage is magnified when the predicate is\n-- expensive--using dropWhileEndLE isSpace to strip the space off a line of text\n-- is generally much faster than using dropWhileEnd isSpace for that purpose.\n-- Specification: dropWhileEndLE p = reverse . dropWhile p . reverse\n-- Pay attention to the short-circuit (&&)! The order of its arguments is the only\n-- difference between dropWhileEnd and dropWhileEndLE.\ndropWhileEndLE :: (a -> Bool) -> [a] -> [a]\ndropWhileEndLE p = foldr (\\x r -> if null r && p x then [] else x:r) []\n\n-- | @spanEnd p l == reverse (span p (reverse l))@. The first list\n-- returns actually comes after the second list (when you look at the\n-- input list).\nspanEnd :: (a -> Bool) -> [a] -> ([a], [a])\nspanEnd p l = go l [] [] l\n  where go yes _rev_yes rev_no [] = (yes, reverse rev_no)\n        go yes rev_yes  rev_no (x:xs)\n          | p x       = go yes (x : rev_yes) rev_no                  xs\n          | otherwise = go xs  []            (x : rev_yes ++ rev_no) xs\n\n-- | Get the last two elements in a list. Partial!\n{-# INLINE last2 #-}\nlast2 :: [a] -> (a,a)\nlast2 = foldl' (\\(_,x2) x -> (x2,x)) (partialError,partialError)\n  where\n    partialError = panic \"last2 - list length less than two\"\n\nlastMaybe :: [a] -> Maybe a\nlastMaybe [] = Nothing\nlastMaybe xs = Just $ last xs\n\n-- | Split a list into its last element and the initial part of the list.\n-- @snocView xs = Just (init xs, last xs)@ for non-empty lists.\n-- @snocView xs = Nothing@ otherwise.\n-- Unless both parts of the result are guaranteed to be used\n-- prefer separate calls to @last@ + @init@.\n-- If you are guaranteed to use both, this will\n-- be more efficient.\nsnocView :: [a] -> Maybe ([a],a)\nsnocView [] = Nothing\nsnocView xs\n    | (xs,x) <- go xs\n    = Just (xs,x)\n  where\n    go :: [a] -> ([a],a)\n    go [x] = ([],x)\n    go (x:xs)\n        | !(xs',x') <- go xs\n        = (x:xs', x')\n    go [] = error \"impossible\"\n\nsplit :: Char -> String -> [String]\nsplit c s = case rest of\n                []     -> [chunk]\n                _:rest -> chunk : split c rest\n  where (chunk, rest) = break (==c) s\n\n-- | Convert a word to title case by capitalising the first letter\ncapitalise :: String -> String\ncapitalise [] = []\ncapitalise (c:cs) = toUpper c : cs\n\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-comparison]{Comparisons}\n*                                                                      *\n************************************************************************\n-}\n\nisEqual :: Ordering -> Bool\n-- Often used in (isEqual (a `compare` b))\nisEqual GT = False\nisEqual EQ = True\nisEqual LT = False\n\nthenCmp :: Ordering -> Ordering -> Ordering\n{-# INLINE thenCmp #-}\nthenCmp EQ       ordering = ordering\nthenCmp ordering _        = ordering\n\neqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool\neqListBy _  []     []     = True\neqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys\neqListBy _  _      _      = False\n\neqMaybeBy :: (a ->a->Bool) -> Maybe a -> Maybe a -> Bool\neqMaybeBy _  Nothing  Nothing  = True\neqMaybeBy eq (Just x) (Just y) = eq x y\neqMaybeBy _  _        _        = False\n\ncmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering\n    -- `cmpList' uses a user-specified comparer\n\ncmpList _   []     [] = EQ\ncmpList _   []     _  = LT\ncmpList _   _      [] = GT\ncmpList cmp (a:as) (b:bs)\n  = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }\n\nremoveSpaces :: String -> String\nremoveSpaces = dropWhileEndLE isSpace . dropWhile isSpace\n\n-- Boolean operators lifted to Applicative\n(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool\n(<&&>) = liftA2 (&&)\ninfixr 3 <&&> -- same as (&&)\n\n(<||>) :: Applicative f => f Bool -> f Bool -> f Bool\n(<||>) = liftA2 (||)\ninfixr 2 <||> -- same as (||)\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection{Edit distance}\n*                                                                      *\n************************************************************************\n-}\n\n-- | Find the \"restricted\" Damerau-Levenshtein edit distance between two strings.\n-- See: <http://en.wikipedia.org/wiki/Damerau-Levenshtein_distance>.\n-- Based on the algorithm presented in \"A Bit-Vector Algorithm for Computing\n-- Levenshtein and Damerau Edit Distances\" in PSC'02 (Heikki Hyyro).\n-- See http://www.cs.uta.fi/~helmu/pubs/psc02.pdf and\n--     http://www.cs.uta.fi/~helmu/pubs/PSCerr.html for an explanation\nrestrictedDamerauLevenshteinDistance :: String -> String -> Int\nrestrictedDamerauLevenshteinDistance str1 str2\n  = restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2\n  where\n    m = length str1\n    n = length str2\n\nrestrictedDamerauLevenshteinDistanceWithLengths\n  :: Int -> Int -> String -> String -> Int\nrestrictedDamerauLevenshteinDistanceWithLengths m n str1 str2\n  | m <= n\n  = if n <= 32 -- n must be larger so this check is sufficient\n    then restrictedDamerauLevenshteinDistance' (undefined :: Word32) m n str1 str2\n    else restrictedDamerauLevenshteinDistance' (undefined :: Integer) m n str1 str2\n\n  | otherwise\n  = if m <= 32 -- m must be larger so this check is sufficient\n    then restrictedDamerauLevenshteinDistance' (undefined :: Word32) n m str2 str1\n    else restrictedDamerauLevenshteinDistance' (undefined :: Integer) n m str2 str1\n\nrestrictedDamerauLevenshteinDistance'\n  :: (Bits bv, Num bv) => bv -> Int -> Int -> String -> String -> Int\nrestrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2\n  | [] <- str1 = n\n  | otherwise  = extractAnswer $\n                 foldl' (restrictedDamerauLevenshteinDistanceWorker\n                             (matchVectors str1) top_bit_mask vector_mask)\n                        (0, 0, m_ones, 0, m) str2\n  where\n    m_ones@vector_mask = (2 ^ m) - 1\n    top_bit_mask = (1 `shiftL` (m - 1)) `asTypeOf` _bv_dummy\n    extractAnswer (_, _, _, _, distance) = distance\n\nrestrictedDamerauLevenshteinDistanceWorker\n      :: (Bits bv, Num bv) => IM.IntMap bv -> bv -> bv\n      -> (bv, bv, bv, bv, Int) -> Char -> (bv, bv, bv, bv, Int)\nrestrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask\n                                           (pm, d0, vp, vn, distance) char2\n  = seq str1_mvs $ seq top_bit_mask $ seq vector_mask $\n    seq pm' $ seq d0' $ seq vp' $ seq vn' $\n    seq distance'' $ seq char2 $\n    (pm', d0', vp', vn', distance'')\n  where\n    pm' = IM.findWithDefault 0 (ord char2) str1_mvs\n\n    d0' = ((((sizedComplement vector_mask d0) .&. pm') `shiftL` 1) .&. pm)\n      .|. ((((pm' .&. vp) + vp) .&. vector_mask) `xor` vp) .|. pm' .|. vn\n          -- No need to mask the shiftL because of the restricted range of pm\n\n    hp' = vn .|. sizedComplement vector_mask (d0' .|. vp)\n    hn' = d0' .&. vp\n\n    hp'_shift = ((hp' `shiftL` 1) .|. 1) .&. vector_mask\n    hn'_shift = (hn' `shiftL` 1) .&. vector_mask\n    vp' = hn'_shift .|. sizedComplement vector_mask (d0' .|. hp'_shift)\n    vn' = d0' .&. hp'_shift\n\n    distance' = if hp' .&. top_bit_mask /= 0 then distance + 1 else distance\n    distance'' = if hn' .&. top_bit_mask /= 0 then distance' - 1 else distance'\n\nsizedComplement :: Bits bv => bv -> bv -> bv\nsizedComplement vector_mask vect = vector_mask `xor` vect\n\nmatchVectors :: (Bits bv, Num bv) => String -> IM.IntMap bv\nmatchVectors = snd . foldl' go (0 :: Int, IM.empty)\n  where\n    go (ix, im) char = let ix' = ix + 1\n                           im' = IM.insertWith (.|.) (ord char) (2 ^ ix) im\n                       in seq ix' $ seq im' $ (ix', im')\n\n{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'\n                      :: Word32 -> Int -> Int -> String -> String -> Int #-}\n{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'\n                      :: Integer -> Int -> Int -> String -> String -> Int #-}\n\n{-# SPECIALIZE restrictedDamerauLevenshteinDistanceWorker\n               :: IM.IntMap Word32 -> Word32 -> Word32\n               -> (Word32, Word32, Word32, Word32, Int)\n               -> Char -> (Word32, Word32, Word32, Word32, Int) #-}\n{-# SPECIALIZE restrictedDamerauLevenshteinDistanceWorker\n               :: IM.IntMap Integer -> Integer -> Integer\n               -> (Integer, Integer, Integer, Integer, Int)\n               -> Char -> (Integer, Integer, Integer, Integer, Int) #-}\n\n{-# SPECIALIZE INLINE sizedComplement :: Word32 -> Word32 -> Word32 #-}\n{-# SPECIALIZE INLINE sizedComplement :: Integer -> Integer -> Integer #-}\n\n{-# SPECIALIZE matchVectors :: String -> IM.IntMap Word32 #-}\n{-# SPECIALIZE matchVectors :: String -> IM.IntMap Integer #-}\n\nfuzzyMatch :: String -> [String] -> [String]\nfuzzyMatch key vals = fuzzyLookup key [(v,v) | v <- vals]\n\n-- | Search for possible matches to the users input in the given list,\n-- returning a small number of ranked results\nfuzzyLookup :: String -> [(String,a)] -> [a]\nfuzzyLookup user_entered possibilites\n  = map fst $ take mAX_RESULTS $ sortBy (comparing snd)\n    [ (poss_val, distance) | (poss_str, poss_val) <- possibilites\n                       , let distance = restrictedDamerauLevenshteinDistance\n                                            poss_str user_entered\n                       , distance <= fuzzy_threshold ]\n  where\n    -- Work out an approriate match threshold:\n    -- We report a candidate if its edit distance is <= the threshold,\n    -- The threshold is set to about a quarter of the # of characters the user entered\n    --   Length    Threshold\n    --     1         0          -- Don't suggest *any* candidates\n    --     2         1          -- for single-char identifiers\n    --     3         1\n    --     4         1\n    --     5         1\n    --     6         2\n    --\n    fuzzy_threshold = truncate $ fromIntegral (length user_entered + 2) / (4 :: Rational)\n    mAX_RESULTS = 3\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-pairs]{Pairs}\n*                                                                      *\n************************************************************************\n-}\n\nunzipWith :: (a -> b -> c) -> [(a, b)] -> [c]\nunzipWith f pairs = map ( \\ (a, b) -> f a b ) pairs\n\nseqList :: [a] -> b -> b\nseqList [] b = b\nseqList (x:xs) b = x `seq` seqList xs b\n\n\n{-\n************************************************************************\n*                                                                      *\n                        Globals and the RTS\n*                                                                      *\n************************************************************************\n\nWhen a plugin is loaded, it currently gets linked against a *newly\nloaded* copy of the GHC package. This would not be a problem, except\nthat the new copy has its own mutable state that is not shared with\nthat state that has already been initialized by the original GHC\npackage.\n\n(Note that if the GHC executable was dynamically linked this\nwouldn't be a problem, because we could share the GHC library it\nlinks to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)\n\nThe solution is to make use of @sharedCAF@ through @sharedGlobal@\nfor globals that are shared between multiple copies of ghc packages.\n-}\n\n-- Global variables:\n\nglobal :: a -> IORef a\nglobal a = unsafePerformIO (newIORef a)\n\nconsIORef :: IORef [a] -> a -> IO ()\nconsIORef var x = do\n  atomicModifyIORef' var (\\xs -> (x:xs,()))\n\nglobalM :: IO a -> IORef a\nglobalM ma = unsafePerformIO (ma >>= newIORef)\n\n-- Shared global variables:\n\nsharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a\nsharedGlobal a get_or_set = unsafePerformIO $\n  newIORef a >>= flip sharedCAF get_or_set\n\nsharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a\nsharedGlobalM ma get_or_set = unsafePerformIO $\n  ma >>= newIORef >>= flip sharedCAF get_or_set\n\n-- Module names:\n\nlooksLikeModuleName :: String -> Bool\nlooksLikeModuleName [] = False\nlooksLikeModuleName (c:cs) = isUpper c && go cs\n  where go [] = True\n        go ('.':cs) = looksLikeModuleName cs\n        go (c:cs)   = (isAlphaNum c || c == '_' || c == '\\'') && go cs\n\n-- Similar to 'parse' for Distribution.Package.PackageName,\n-- but we don't want to depend on Cabal.\nlooksLikePackageName :: String -> Bool\nlooksLikePackageName = all (all isAlphaNum <&&> not . (all isDigit)) . split '-'\n\n{-\nAkin to @Prelude.words@, but acts like the Bourne shell, treating\nquoted strings as Haskell Strings, and also parses Haskell [String]\nsyntax.\n-}\n\ngetCmd :: String -> Either String             -- Error\n                           (String, String) -- (Cmd, Rest)\ngetCmd s = case break isSpace $ dropWhile isSpace s of\n           ([], _) -> Left (\"Couldn't find command in \" ++ show s)\n           res -> Right res\n\ntoCmdArgs :: String -> Either String             -- Error\n                              (String, [String]) -- (Cmd, Args)\ntoCmdArgs s = case getCmd s of\n              Left err -> Left err\n              Right (cmd, s') -> case toArgs s' of\n                                 Left err -> Left err\n                                 Right args -> Right (cmd, args)\n\ntoArgs :: String -> Either String   -- Error\n                           [String] -- Args\ntoArgs str\n    = case dropWhile isSpace str of\n      s@('[':_) -> case reads s of\n                   [(args, spaces)]\n                    | all isSpace spaces ->\n                       Right args\n                   _ ->\n                       Left (\"Couldn't read \" ++ show str ++ \" as [String]\")\n      s -> toArgs' s\n where\n  toArgs' :: String -> Either String [String]\n  -- Remove outer quotes:\n  -- > toArgs' \"\\\"foo\\\" \\\"bar baz\\\"\"\n  -- Right [\"foo\", \"bar baz\"]\n  --\n  -- Keep inner quotes:\n  -- > toArgs' \"-DFOO=\\\"bar baz\\\"\"\n  -- Right [\"-DFOO=\\\"bar baz\\\"\"]\n  toArgs' s = case dropWhile isSpace s of\n              [] -> Right []\n              ('\"' : _) -> do\n                    -- readAsString removes outer quotes\n                    (arg, rest) <- readAsString s\n                    (arg:) `fmap` toArgs' rest\n              s' -> case break (isSpace <||> (== '\"')) s' of\n                    (argPart1, s''@('\"':_)) -> do\n                        (argPart2, rest) <- readAsString s''\n                        -- show argPart2 to keep inner quotes\n                        ((argPart1 ++ show argPart2):) `fmap` toArgs' rest\n                    (arg, s'') -> (arg:) `fmap` toArgs' s''\n\n  readAsString :: String -> Either String (String, String)\n  readAsString s = case reads s of\n                [(arg, rest)]\n                    -- rest must either be [] or start with a space\n                    | all isSpace (take 1 rest) ->\n                    Right (arg, rest)\n                _ ->\n                    Left (\"Couldn't read \" ++ show s ++ \" as String\")\n-----------------------------------------------------------------------------\n-- Integers\n\n-- This algorithm for determining the $\\log_2$ of exact powers of 2 comes\n-- from GCC.  It requires bit manipulation primitives, and we use GHC\n-- extensions.  Tough.\n\nexactLog2 :: Integer -> Maybe Integer\nexactLog2 x\n  = if (x <= 0 || x >= 2147483648) then\n       Nothing\n    else\n       if (x .&. (-x)) /= x then\n          Nothing\n       else\n          Just (pow2 x)\n  where\n    pow2 x | x == 1 = 0\n           | otherwise = 1 + pow2 (x `shiftR` 1)\n\n\n{-\n-- -----------------------------------------------------------------------------\n-- Floats\n-}\n\nreadRational__ :: ReadS Rational -- NB: doesn't handle leading \"-\"\nreadRational__ r = do\n     (n,d,s) <- readFix r\n     (k,t)   <- readExp s\n     return ((n%1)*10^^(k-d), t)\n where\n     readFix r = do\n        (ds,s)  <- lexDecDigits r\n        (ds',t) <- lexDotDigits s\n        return (read (ds++ds'), length ds', t)\n\n     readExp (e:s) | e `elem` \"eE\" = readExp' s\n     readExp s                     = return (0,s)\n\n     readExp' ('+':s) = readDec s\n     readExp' ('-':s) = do (k,t) <- readDec s\n                           return (-k,t)\n     readExp' s       = readDec s\n\n     readDec s = do\n        (ds,r) <- nonnull isDigit s\n        return (foldl1 (\\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],\n                r)\n\n     lexDecDigits = nonnull isDigit\n\n     lexDotDigits ('.':s) = return (span' isDigit s)\n     lexDotDigits s       = return (\"\",s)\n\n     nonnull p s = do (cs@(_:_),t) <- return (span' p s)\n                      return (cs,t)\n\n     span' _ xs@[]         =  (xs, xs)\n     span' p xs@(x:xs')\n               | x == '_'  = span' p xs'   -- skip \"_\" (#14473)\n               | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)\n               | otherwise =  ([],xs)\n\nreadRational :: String -> Rational -- NB: *does* handle a leading \"-\"\nreadRational top_s\n  = case top_s of\n      '-' : xs -> - (read_me xs)\n      xs       -> read_me xs\n  where\n    read_me s\n      = case (do { (x,\"\") <- readRational__ s ; return x }) of\n          [x] -> x\n          []  -> error (\"readRational: no parse:\"        ++ top_s)\n          _   -> error (\"readRational: ambiguous parse:\" ++ top_s)\n\n\nreadHexRational :: String -> Rational\nreadHexRational str =\n  case str of\n    '-' : xs -> - (readMe xs)\n    xs       -> readMe xs\n  where\n  readMe as =\n    case readHexRational__ as of\n      Just n -> n\n      _      -> error (\"readHexRational: no parse:\" ++ str)\n\n\nreadHexRational__ :: String -> Maybe Rational\nreadHexRational__ ('0' : x : rest)\n  | x == 'X' || x == 'x' =\n  do let (front,rest2) = span' isHexDigit rest\n     guard (not (null front))\n     let frontNum = steps 16 0 front\n     case rest2 of\n       '.' : rest3 ->\n          do let (back,rest4) = span' isHexDigit rest3\n             guard (not (null back))\n             let backNum = steps 16 frontNum back\n                 exp1    = -4 * length back\n             case rest4 of\n               p : ps | isExp p -> fmap (mk backNum . (+ exp1)) (getExp ps)\n               _ -> return (mk backNum exp1)\n       p : ps | isExp p -> fmap (mk frontNum) (getExp ps)\n       _ -> Nothing\n\n  where\n  isExp p = p == 'p' || p == 'P'\n\n  getExp ('+' : ds) = dec ds\n  getExp ('-' : ds) = fmap negate (dec ds)\n  getExp ds         = dec ds\n\n  mk :: Integer -> Int -> Rational\n  mk n e = fromInteger n * 2^^e\n\n  dec cs = case span' isDigit cs of\n             (ds,\"\") | not (null ds) -> Just (steps 10 0 ds)\n             _ -> Nothing\n\n  steps base n ds = foldl' (step base) n ds\n  step  base n d  = base * n + fromIntegral (digitToInt d)\n\n  span' _ xs@[]         =  (xs, xs)\n  span' p xs@(x:xs')\n            | x == '_'  = span' p xs'   -- skip \"_\"  (#14473)\n            | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)\n            | otherwise =  ([],xs)\n\nreadHexRational__ _ = Nothing\n\n\n\n\n-----------------------------------------------------------------------------\n-- read helpers\n\nmaybeRead :: Read a => String -> Maybe a\nmaybeRead str = case reads str of\n                [(x, \"\")] -> Just x\n                _         -> Nothing\n\nmaybeReadFuzzy :: Read a => String -> Maybe a\nmaybeReadFuzzy str = case reads str of\n                     [(x, s)]\n                      | all isSpace s ->\n                         Just x\n                     _ ->\n                         Nothing\n\n-----------------------------------------------------------------------------\n-- Verify that the 'dirname' portion of a FilePath exists.\n--\ndoesDirNameExist :: FilePath -> IO Bool\ndoesDirNameExist fpath = doesDirectoryExist (takeDirectory fpath)\n\n-----------------------------------------------------------------------------\n-- Backwards compatibility definition of getModificationTime\n\ngetModificationUTCTime :: FilePath -> IO UTCTime\ngetModificationUTCTime = getModificationTime\n\n-- --------------------------------------------------------------\n-- check existence & modification time at the same time\n\nmodificationTimeIfExists :: FilePath -> IO (Maybe UTCTime)\nmodificationTimeIfExists f = do\n  (do t <- getModificationUTCTime f; return (Just t))\n        `catchIO` \\e -> if isDoesNotExistError e\n                        then return Nothing\n                        else ioError e\n\n-- --------------------------------------------------------------\n-- split a string at the last character where 'pred' is True,\n-- returning a pair of strings. The first component holds the string\n-- up (but not including) the last character for which 'pred' returned\n-- True, the second whatever comes after (but also not including the\n-- last character).\n--\n-- If 'pred' returns False for all characters in the string, the original\n-- string is returned in the first component (and the second one is just\n-- empty).\nsplitLongestPrefix :: String -> (Char -> Bool) -> (String,String)\nsplitLongestPrefix str pred\n  | null r_pre = (str,           [])\n  | otherwise  = (reverse (tail r_pre), reverse r_suf)\n                           -- 'tail' drops the char satisfying 'pred'\n  where (r_suf, r_pre) = break pred (reverse str)\n\nescapeSpaces :: String -> String\nescapeSpaces = foldr (\\c s -> if isSpace c then '\\\\':c:s else c:s) \"\"\n\ntype Suffix = String\n\n--------------------------------------------------------------\n-- * Search path\n--------------------------------------------------------------\n\ndata Direction = Forwards | Backwards\n\nreslash :: Direction -> FilePath -> FilePath\nreslash d = f\n    where f ('/'  : xs) = slash : f xs\n          f ('\\\\' : xs) = slash : f xs\n          f (x    : xs) = x     : f xs\n          f \"\"          = \"\"\n          slash = case d of\n                  Forwards -> '/'\n                  Backwards -> '\\\\'\n\nmakeRelativeTo :: FilePath -> FilePath -> FilePath\nthis `makeRelativeTo` that = directory </> thisFilename\n    where (thisDirectory, thisFilename) = splitFileName this\n          thatDirectory = dropFileName that\n          directory = joinPath $ f (splitPath thisDirectory)\n                                   (splitPath thatDirectory)\n\n          f (x : xs) (y : ys)\n           | x == y = f xs ys\n          f xs ys = replicate (length ys) \"..\" ++ xs\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-Data]{Utils for defining Data instances}\n*                                                                      *\n************************************************************************\n\nThese functions helps us to define Data instances for abstract types.\n-}\n\nabstractConstr :: String -> Constr\nabstractConstr n = mkConstr (abstractDataType n) (\"{abstract:\"++n++\"}\") [] Prefix\n\nabstractDataType :: String -> DataType\nabstractDataType n = mkDataType n [abstractConstr n]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-C]{Utils for printing C code}\n*                                                                      *\n************************************************************************\n-}\n\ncharToC :: Word8 -> String\ncharToC w =\n  case chr (fromIntegral w) of\n        '\\\"' -> \"\\\\\\\"\"\n        '\\'' -> \"\\\\\\'\"\n        '\\\\' -> \"\\\\\\\\\"\n        c | c >= ' ' && c <= '~' -> [c]\n          | otherwise -> ['\\\\',\n                         chr (ord '0' + ord c `div` 64),\n                         chr (ord '0' + ord c `div` 8 `mod` 8),\n                         chr (ord '0' + ord c         `mod` 8)]\n\n{-\n************************************************************************\n*                                                                      *\n\\subsection[Utils-Hashing]{Utils for hashing}\n*                                                                      *\n************************************************************************\n-}\n\n-- | A sample hash function for Strings.  We keep multiplying by the\n-- golden ratio and adding.  The implementation is:\n--\n-- > hashString = foldl' f golden\n-- >   where f m c = fromIntegral (ord c) * magic + hashInt32 m\n-- >         magic = 0xdeadbeef\n--\n-- Where hashInt32 works just as hashInt shown above.\n--\n-- Knuth argues that repeated multiplication by the golden ratio\n-- will minimize gaps in the hash space, and thus it's a good choice\n-- for combining together multiple keys to form one.\n--\n-- Here we know that individual characters c are often small, and this\n-- produces frequent collisions if we use ord c alone.  A\n-- particular problem are the shorter low ASCII and ISO-8859-1\n-- character strings.  We pre-multiply by a magic twiddle factor to\n-- obtain a good distribution.  In fact, given the following test:\n--\n-- > testp :: Int32 -> Int\n-- > testp k = (n - ) . length . group . sort . map hs . take n $ ls\n-- >   where ls = [] : [c : l | l <- ls, c <- ['\\0'..'\\xff']]\n-- >         hs = foldl' f golden\n-- >         f m c = fromIntegral (ord c) * k + hashInt32 m\n-- >         n = 100000\n--\n-- We discover that testp magic = 0.\nhashString :: String -> Int32\nhashString = foldl' f golden\n   where f m c = fromIntegral (ord c) * magic + hashInt32 m\n         magic = fromIntegral (0xdeadbeef :: Word32)\n\ngolden :: Int32\ngolden = 1013904242 -- = round ((sqrt 5 - 1) * 2^32) :: Int32\n-- was -1640531527 = round ((sqrt 5 - 1) * 2^31) :: Int32\n-- but that has bad mulHi properties (even adding 2^32 to get its inverse)\n-- Whereas the above works well and contains no hash duplications for\n-- [-32767..65536]\n\n-- | A sample (and useful) hash function for Int32,\n-- implemented by extracting the uppermost 32 bits of the 64-bit\n-- result of multiplying by a 33-bit constant.  The constant is from\n-- Knuth, derived from the golden ratio:\n--\n-- > golden = round ((sqrt 5 - 1) * 2^32)\n--\n-- We get good key uniqueness on small inputs\n-- (a problem with previous versions):\n--  (length $ group $ sort $ map hashInt32 [-32767..65536]) == 65536 + 32768\n--\nhashInt32 :: Int32 -> Int32\nhashInt32 x = mulHi x golden + x\n\n-- hi 32 bits of a x-bit * 32 bit -> 64-bit multiply\nmulHi :: Int32 -> Int32 -> Int32\nmulHi a b = fromIntegral (r `shiftR` 32)\n   where r :: Int64\n         r = fromIntegral a * fromIntegral b\n\n-- | A call stack constraint, but only when 'isDebugOn'.\n#if defined(DEBUG)\ntype HasDebugCallStack = HasCallStack\n#else\ntype HasDebugCallStack = (() :: Constraint)\n#endif\n\ndata OverridingBool\n  = Auto\n  | Always\n  | Never\n  deriving Show\n\noverrideWith :: Bool -> OverridingBool -> Bool\noverrideWith b Auto   = b\noverrideWith _ Always = True\noverrideWith _ Never  = False\n", "num_lines": 1475}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule BuildInfo where\n\nimport Control.Monad.State\n\ntype BIMonad = StateT BuildInfo Maybe\n\ndata BuildInfo = BuildInfo {\n                     biThingVersionMap :: ThingVersionMap,\n                     biThingHashMap :: ThingHashMap,\n                     biMaybeWays :: Maybe Ways\n                 }\n    deriving Show\n\ntype ThingMap = [(String, String)]\n-- Mapping from thing (e.g. \"Cabal\") to version (e.g. \"1.10.0.0\")\ntype ThingVersionMap = ThingMap\n-- Mapping from thing (e.g. \"Cabal\") to ABI hash\n-- (e.g. \"e1f7c380581d61d42b0360d440cc35ed\")\ntype ThingHashMap = ThingMap\n-- The list of ways in the order the build system uses them, e.g.\n-- [\"v\", \"p\", \"dyn\"] => we have \".depend-v-p-dyn.haskell\" files\ntype Ways = [String]\n\nemptyBuildInfo :: Maybe Ways -> BuildInfo\nemptyBuildInfo mWays = BuildInfo {\n                           biThingVersionMap = [],\n                           biThingHashMap = [],\n                           biMaybeWays = mWays\n                       }\n\naddThingMap :: ThingMap -> String -> String -> Maybe ThingMap\naddThingMap mapping thing str\n = case lookup thing mapping of\n   Just str' ->\n       if str == str'\n       then Just mapping\n       else Nothing\n   Nothing ->\n       Just ((thing, str) : mapping)\n\ngetMaybeWays :: BIMonad (Maybe Ways)\ngetMaybeWays = do st <- get\n                  return $ biMaybeWays st\n\nhaveThingVersion :: String -> String -> BIMonad ()\nhaveThingVersion thing thingVersion\n = do st <- get\n      case addThingMap (biThingVersionMap st) thing thingVersion of\n          Nothing  -> fail \"Inconsistent version\"\n          Just tvm -> put $ st { biThingVersionMap = tvm }\n\nhaveThingHash :: String -> String -> BIMonad ()\nhaveThingHash thing thingHash\n = do st <- get\n      case addThingMap (biThingHashMap st) thing thingHash of\n          Nothing  -> fail \"Inconsistent hash\"\n          Just thm -> put $ st { biThingHashMap = thm }\n\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Change where\n\ndata FileChange = First  Change\n                | Second Change\n                | Change Change\n\ndata Change = DuplicateFile FilePath\n            | ExtraFile FilePath\n            | ExtraWay String\n            | ExtraThing String\n            | ThingVersionChanged String String String\n            | PermissionsChanged FilePath FilePath String String\n            | FileSizeChanged FilePath FilePath Integer Integer\n\nisSizeChange :: FileChange -> Bool\nisSizeChange (Change (FileSizeChanged {})) = True\nisSizeChange _ = False\n\npprFileChange :: FileChange -> String\npprFileChange (First  p) = \"First  \" ++ pprChange p\npprFileChange (Second p) = \"Second \" ++ pprChange p\npprFileChange (Change p) = \"Change \" ++ pprChange p\n\npprChange :: Change -> String\npprChange (DuplicateFile fp) = \"Duplicate file: \" ++ show fp\npprChange (ExtraFile fp) = \"Extra file: \" ++ show fp\npprChange (ExtraWay w) = \"Extra way: \" ++ show w\npprChange (ExtraThing t) = \"Extra thing: \" ++ show t\npprChange (ThingVersionChanged t v1 v2)\n    = \"Version changed for \" ++ show t ++ \":\\n\"\n   ++ \"    \" ++ v1 ++ \"  ->  \" ++ v2\npprChange (PermissionsChanged fp1 fp2 p1 p2)\n    = \"Permissions changed:\\n\"\n   ++ \"    \" ++ show fp1\n   ++ \"    \" ++ show fp2\n   ++ \"    \" ++ p1 ++ \"  ->  \" ++ p2\npprChange (FileSizeChanged fp1 fp2 s1 s2)\n    = \"Size changed:\\n\"\n   ++ \"    \" ++ show fp1 ++ \"\\n\"\n   ++ \"    \" ++ show fp2 ++ \"\\n\"\n   ++ \"    \" ++ show s1 ++ \"  ->  \" ++ show s2\n\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Control.Monad.State\nimport Data.Char\nimport Data.List\nimport System.Directory\nimport System.Environment\nimport System.FilePath\n\nimport BuildInfo\nimport FilenameDescr\nimport Change\nimport Utils\nimport Tar\n\n-- TODO:\n-- * Check installed trees too\n-- * Check hashbangs\n\nsizeChangeThresholds :: [(Integer,  -- Theshold only applies if one of\n                                    -- the files is at least this big\n                          Integer)] -- Size changed if the larger file's\n                                    -- size is at least this %age of the\n                                    -- smaller file's size\nsizeChangeThresholds = [(     1000, 150),\n                        (50 * 1000, 110)]\n\nmain :: IO ()\nmain = do args <- getArgs\n          (ignoreSizeChanges, p1, p2) <-\n              case args of\n              [p1, p2]                          -> return (False, p1, p2)\n              [\"--ignore-size-changes\", p1, p2] -> return (True,  p1, p2)\n              _ -> die [\"Bad args. Need 2 filepaths.\"]\n          doFileOrDirectory ignoreSizeChanges p1 p2\n\ndoFileOrDirectory :: Bool -> FilePath -> FilePath -> IO ()\ndoFileOrDirectory ignoreSizeChanges p1 p2\n = do b <- doesDirectoryExist p1\n      let doit = if b then doDirectory else doFile\n      doit ignoreSizeChanges p1 p2\n\ndoDirectory :: Bool -> FilePath -> FilePath -> IO ()\ndoDirectory ignoreSizeChanges p1 p2\n = do fs1 <- getDirectoryContents p1\n      fs2 <- getDirectoryContents p2\n      let isVersionChar c = isDigit c || c == '.'\n          mkFileInfo \".\" = return []\n          mkFileInfo \"..\" = return []\n          mkFileInfo fp@('g':'h':'c':'-':x:xs)\n           | isDigit x = return [((\"ghc-\", \"VERSION\", dropWhile isVersionChar xs), fp)]\n           | otherwise = die [\"No version number in \" ++ show fp]\n          mkFileInfo fp = do warn [\"Unrecognised filename \" ++ show fp]\n                             return []\n      fss1' <- mapM mkFileInfo fs1\n      fss2' <- mapM mkFileInfo fs2\n      let fs1' = sort $ concat fss1'\n          fs2' = sort $ concat fss2'\n\n          putBreak = putStrLn \"==========\"\n          extraFile d fp = do putBreak\n                              putStrLn (\"Extra file in \" ++ show d\n                                     ++ \": \" ++ show fp)\n          doFiles [] [] = do putBreak\n                             putStrLn \"Done.\"\n          doFiles ((_, fp) : xs) [] = do extraFile p1 fp\n                                         doFiles xs []\n          doFiles [] ((_, fp) : ys) = do extraFile p2 fp\n                                         doFiles [] ys\n          doFiles xs@((fpc1, fp1) : xs') ys@((fpc2, fp2) : ys')\n              = do case fpc1 `compare` fpc2 of\n                       EQ ->\n                           do putBreak\n                              putStrLn $ unwords [\"Doing\", show fp1, show fp2]\n                              doFile ignoreSizeChanges (p1 </> fp1)\n                                                       (p2 </> fp2)\n                              doFiles xs' ys'\n                       LT -> do extraFile p1 fp1\n                                doFiles xs' ys\n                       GT -> do extraFile p2 fp2\n                                doFiles xs ys'\n      doFiles fs1' fs2'\n\ndoFile :: Bool -> FilePath -> FilePath -> IO ()\ndoFile ignoreSizeChanges bd1 bd2\n = do tls1 <- readTarLines bd1\n      tls2 <- readTarLines bd2\n      let mWays1 = findWays tls1\n          mWays2 = findWays tls2\n      wayDifferences <- case (mWays1, mWays2) of\n                        (Nothing, Nothing) ->\n                            return []\n                        (Just ways1, Just ways2) ->\n                            return $ diffWays ways1 ways2\n                        _ ->\n                            die [\"One input has ways, but the other doesn't\"]\n      (content1, tvm1) <- dieOnErrors $ mkContents mWays1 tls1\n      (content2, tvm2) <- dieOnErrors $ mkContents mWays2 tls2\n      let sortedContent1 = sortByFst content1\n          sortedContent2 = sortByFst content2\n          (nubProbs1, nubbedContent1) = nubContents sortedContent1\n          (nubProbs2, nubbedContent2) = nubContents sortedContent2\n          differences = compareContent mWays1 nubbedContent1\n                                       mWays2 nubbedContent2\n          allProbs = map First nubProbs1 ++ map Second nubProbs2\n                  ++ diffThingVersionMap tvm1 tvm2\n                  ++ wayDifferences\n                  ++ differences\n          wantedProbs = if ignoreSizeChanges\n                        then filter (not . isSizeChange) allProbs\n                        else allProbs\n      mapM_ (putStrLn . pprFileChange) wantedProbs\n\n-- *nix bindists have ways.\n-- Windows \"bindists\", install trees, and testsuites don't.\nfindWays :: [TarLine] -> Maybe Ways\nfindWays tls = msum $ map f tls\n    where f tl = case re regex (tlFileName tl) of\n                 Just [dashedWays] -> Just (unSepList '-' dashedWays)\n                 _                 -> Nothing\n          regex = \"/libraries/base/dist-install/build/\\\\.depend-(.*)\\\\.haskell\"\n\ndiffWays :: Ways -> Ways -> [FileChange]\ndiffWays ws1 ws2 = f (sort ws1) (sort ws2)\n    where f [] [] = []\n          f xs [] = map (First  . ExtraWay) xs\n          f [] ys = map (Second . ExtraWay) ys\n          f xs@(x : xs') ys@(y : ys')\n              = case x `compare` y of\n                LT -> First  (ExtraWay x) : f xs' ys\n                GT -> Second (ExtraWay y) : f xs  ys'\n                EQ ->                       f xs' ys'\n\ndiffThingVersionMap :: ThingVersionMap -> ThingVersionMap -> [FileChange]\ndiffThingVersionMap tvm1 tvm2 = f (sortByFst tvm1) (sortByFst tvm2)\n    where f [] [] = []\n          f xs [] = map (First  . ExtraThing . fst) xs\n          f [] ys = map (Second . ExtraThing . fst) ys\n          f xs@((xt, xv) : xs') ys@((yt, yv) : ys')\n              = case xt `compare` yt of\n                LT -> First  (ExtraThing xt) : f xs' ys\n                GT -> Second (ExtraThing yt) : f xs  ys'\n                EQ -> let this = if xv == yv\n                                 then []\n                                 else [Change (ThingVersionChanged xt xv yv)]\n                      in this ++ f xs' ys'\n\nmkContents :: Maybe Ways -> [TarLine]\n           -> Either Errors ([(FilenameDescr, TarLine)], ThingVersionMap)\nmkContents mWays tls\n    = case runStateT (mapM f tls) (emptyBuildInfo mWays) of\n      Nothing -> Left [\"Can't happen: mkContents: Nothing\"]\n      Just (xs, finalBuildInfo) ->\n          case concat $ map (checkContent finalBuildInfo) xs of\n          []   -> Right (xs, biThingVersionMap finalBuildInfo)\n          errs -> Left errs\n    where f tl = do fnd <- mkFilePathDescr (tlFileName tl)\n                    return (fnd, tl)\n\nnubContents :: [(FilenameDescr, TarLine)]\n            -> ([Change], [(FilenameDescr, TarLine)])\nnubContents [] = ([], [])\nnubContents [x] = ([], [x])\nnubContents (x1@(fd1, tl1) : xs@((fd2, _) : _))\n | fd1 == fd2 = (DuplicateFile (tlFileName tl1) : ps, xs')\n | otherwise  = (ps, x1 : xs')\n    where (ps, xs') = nubContents xs\n\nmkFilePathDescr :: FilePath -> BIMonad FilenameDescr\nmkFilePathDescr fp\n | Just [ghcVersion, _, middle, filename]\n     <- re (\"^ghc-\" ++ versionRE ++ \"(/.*)?/([^/]*)$\") fp\n    = do haveThingVersion \"ghc\" ghcVersion\n         middle' <- mkMiddleDescr middle\n         filename' <- mkFileNameDescr filename\n         let fd = FP \"ghc-\" : VersionOf \"ghc\" : middle' ++ FP \"/\" : filename'\n         return $ normaliseDescr fd\n | otherwise = return [FP fp]\n\nmkMiddleDescr :: FilePath -> BIMonad FilenameDescr\nmkMiddleDescr middle\n -- haddock docs in a Windows installed tree\n | Just [thing, thingVersion, _, src]\n       <- re (\"^/doc/html/libraries/([^/]*)-\" ++ versionRE ++ \"(/src)?$\")\n             middle\n    = do haveThingVersion thing thingVersion\n         return [FP \"/doc/html/libraries/\",\n                 FP thing, FP \"-\", VersionOf thing, FP src]\n      `mplus` unchanged\n -- libraries in a Windows installed tree\n | Just [thing, thingVersion, _, rest]\n       <- re (\"^/lib/([^/]*)-\" ++ versionRE ++ \"(/.*)?$\")\n             middle\n    = do haveThingVersion thing thingVersion\n         return [FP \"/lib/\", FP thing, FP \"-\", VersionOf thing, FP rest]\n      `mplus` unchanged\n -- Windows in-tree gcc\n | Just [prefix, _, _, gccVersion, _, rest]\n       <- re (\"^(/mingw/(lib(exec)?/gcc/mingw32/|share/gcc-))\" ++ versionRE ++ \"(/.*)?$\")\n             middle\n    = do haveThingVersion \"gcc\" gccVersion\n         return [FP prefix, VersionOf \"gcc\", FP rest]\n      `mplus` unchanged\n | otherwise = unchanged\n    where unchanged = return [FP middle]\n\nmkFileNameDescr :: FilePath -> BIMonad FilenameDescr\nmkFileNameDescr filename\n | Just [prog, ghcVersion, _, exe]\n       <- re (\"^(ghc|ghci|ghcii|haddock)-\" ++ versionRE ++ \"(\\\\.exe|\\\\.sh|)$\")\n             filename\n    = do haveThingVersion \"ghc\" ghcVersion\n         return [FP prog, FP \"-\", VersionOf \"ghc\", FP exe]\n      `mplus` unchanged\n | Just [thing, thingVersion, _, ghcVersion, _, soDll]\n       <- re (\"^libHS(.*)-\" ++ versionRE ++ \"-ghc\" ++ versionRE ++ \"\\\\.(so|dll|dylib)$\")\n             filename\n    = do haveThingVersion \"ghc\" ghcVersion\n         haveThingVersion thing thingVersion\n         return [FP \"libHS\", FP thing, FP \"-\", VersionOf thing,\n                 FP \"-ghc\", VersionOf \"ghc\", FP \".\", FP soDll]\n      `mplus` unchanged\n | Just [way, thingVersion, _, soDll]\n       <- re (\"^libHSrts(_.*)?-ghc\" ++ versionRE ++ \"\\\\.(so|dll|dylib)$\")\n             filename\n    = do haveThingVersion \"ghc\" thingVersion\n         return [FP \"libHSrts\", FP way, FP \"-ghc\", VersionOf \"ghc\",\n                 FP \".\", FP soDll]\n      `mplus` unchanged\n | Just [thingVersion, _, soDll]\n       <- re (\"^libHSffi-ghc\" ++ versionRE ++ \"\\\\.(so|dll|dylib)$\")\n             filename\n    = do haveThingVersion \"ghc\" thingVersion\n         return [FP \"libHSffi-ghc\", VersionOf \"ghc\", FP \".\", FP soDll]\n      `mplus` unchanged\n | Just [thing, thingVersion, _, way]\n       <- re (\"^libHS(.*)-\" ++ versionRE ++ \"(_.*)?\\\\.a$\")\n             filename\n    = do haveThingVersion thing thingVersion\n         return [FP \"libHS\", FP thing, FP \"-\", VersionOf thing,\n                 FP way, FP \".a\"]\n      `mplus` unchanged\n | Just [thing, thingVersion, _]\n       <- re (\"^HS(.*)-\" ++ versionRE ++ \"\\\\.o$\")\n             filename\n    = do haveThingVersion thing thingVersion\n         return [FP \"HS\", FP thing, FP \"-\", VersionOf thing, FP \".o\"]\n      `mplus` unchanged\n | Just [thing, thingVersion, _, thingHash]\n       <- re (\"^(.*)-\" ++ versionRE ++ \"-([0-9a-f]{32})\\\\.conf$\")\n             filename\n    = do haveThingVersion thing thingVersion\n         haveThingHash    thing thingHash\n         return [FP thing, FP \"-\", VersionOf thing, FP \"-\", HashOf thing,\n                 FP \".conf\"]\n      `mplus` unchanged\n | Just [thingVersion, _]\n       <- re (\"^mingw32-gcc-\" ++ versionRE ++ \"\\\\.exe$\")\n             filename\n    = do haveThingVersion \"gcc\" thingVersion\n         return [FP \"mingw32-gcc-\", VersionOf \"gcc\", FP \".exe\"]\n      `mplus` unchanged\n | Just [dashedWays, depType]\n       <- re \"^\\\\.depend-(.*)\\\\.(haskell|c_asm)\"\n             filename\n    = do mWays <- getMaybeWays\n         if Just (unSepList '-' dashedWays) == mWays\n             then return [FP \".depend-\", Ways, FP \".\", FP depType]\n             else unchanged\n | otherwise = unchanged\n    where unchanged = return [FP filename]\n\ncompareContent :: Maybe Ways -> [(FilenameDescr, TarLine)]\n               -> Maybe Ways -> [(FilenameDescr, TarLine)]\n               -> [FileChange]\ncompareContent mWays1 xs1all mWays2 xs2all\n = f xs1all xs2all\n    where f [] [] = []\n          f xs [] = concatMap (mkExtraFile mWays1 mWays2 First  . tlFileName . snd) xs\n          f [] ys = concatMap (mkExtraFile mWays2 mWays1 Second . tlFileName . snd) ys\n          f xs1@((fd1, tl1) : xs1') xs2@((fd2, tl2) : xs2')\n           = case fd1 `compare` fd2 of\n             EQ -> map Change (compareTarLine tl1 tl2)\n                ++ f xs1' xs2'\n             LT -> mkExtraFile mWays1 mWays2 First  (tlFileName tl1)\n                ++ f xs1' xs2\n             GT -> mkExtraFile mWays2 mWays1 Second (tlFileName tl2)\n                ++ f xs1 xs2'\n          mkExtraFile mWaysMe mWaysThem mkFileChange filename\n              = case (findFileWay filename, mWaysMe, mWaysThem) of\n                (Just way, Just waysMe, Just waysThem)\n                 | (way `elem` waysMe) && not (way `elem` waysThem) -> []\n                _                  -> [mkFileChange (ExtraFile filename)]\n\nfindFileWay :: FilePath -> Maybe String\nfindFileWay fp\n | Just [way] <- re \"\\\\.([a-z_]+)_hi$\" fp\n    = Just way\n | Just [_, _, way] <- re (\"libHS.*-\" ++ versionRE ++ \"_([a-z_]+).a$\") fp\n    = Just way\n | otherwise = Nothing\n\ncompareTarLine :: TarLine -> TarLine -> [Change]\ncompareTarLine tl1 tl2\n    = [ PermissionsChanged fn1 fn2 perms1 perms2 | perms1 /= perms2 ]\n   ++ [ FileSizeChanged    fn1 fn2 size1  size2  | sizeChanged ]\n    where fn1 = tlFileName tl1\n          fn2 = tlFileName tl2\n          perms1 = tlPermissions tl1\n          perms2 = tlPermissions tl2\n          size1 = tlSize tl1\n          size2 = tlSize tl2\n          sizeMin = size1 `min` size2\n          sizeMax = size1 `max` size2\n          sizeChanged = any sizeChangeThresholdReached sizeChangeThresholds\n          sizeChangeThresholdReached (reqSize, percentage)\n              = (sizeMax >= reqSize)\n             && (((100 * sizeMax) `div` sizeMin) >= percentage)\n\nversionRE :: String\nversionRE = \"([0-9]+(\\\\.[0-9]+)*)\"\n\n", "num_lines": 323}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule FilenameDescr where\n\nimport Data.Char\nimport Data.Either\nimport Data.List\n\nimport BuildInfo\nimport Utils\nimport Tar\n\n-- We can't just compare plain filenames, because versions numbers of GHC\n-- and the libraries will vary. So we use FilenameDescr instead, which\n-- abstracts out the version numbers.\ntype FilenameDescr = [FilenameDescrBit]\ndata FilenameDescrBit = VersionOf String\n                      | HashOf String\n                      | FP String\n                      | Ways\n    deriving (Show, Eq, Ord)\n\nnormaliseDescr :: FilenameDescr -> FilenameDescr\nnormaliseDescr [] = []\nnormaliseDescr [x] = [x]\nnormaliseDescr (FP x1 : FP x2 : xs) = normaliseDescr (FP (x1 ++ x2) : xs)\nnormaliseDescr (x : xs) = x : normaliseDescr xs\n\n-- Sanity check that the FilenameDescr matches the filename in the tar line\ncheckContent :: BuildInfo -> (FilenameDescr, TarLine) -> Errors\ncheckContent buildInfo (fd, tl)\n = let fn = tlFileName tl\n   in case flattenFilenameDescr buildInfo fd of\n      Right fn' ->\n          if fn' == fn\n          then []\n          else if all isAscii fn\n               then [\"checkContent: Can't happen: filename mismatch: \"\n                  ++ show fn]\n               else [] -- Ugly kludge; don't worry too much if filepaths\n                       -- containing non-ASCII chars have gone wrong\n      Left errs ->\n          errs\n\nflattenFilenameDescr :: BuildInfo -> FilenameDescr\n                     -> Either Errors FilePath\nflattenFilenameDescr buildInfo fd = case partitionEithers (map f fd) of\n                                    ([], strs) -> Right (concat strs)\n                                    (errs, _) -> Left (concat errs)\n    where f (FP fp) = Right fp\n          f (VersionOf thing)\n           = case lookup thing (biThingVersionMap buildInfo) of\n             Just v -> Right v\n             Nothing -> Left [\"Can't happen: thing has no version in mapping\"]\n          f (HashOf thing)\n           = case lookup thing (biThingHashMap buildInfo) of\n             Just v -> Right v\n             Nothing -> Left [\"Can't happen: thing has no hash in mapping\"]\n          f Ways = case biMaybeWays buildInfo of\n                   Just ways -> Right $ intercalate \"-\" ways\n                   Nothing   -> Left [\"Can't happen: No ways, but Ways is used\"]\n\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Tar where\n\nimport Data.Either\nimport Data.List\nimport System.Exit\nimport System.Process\n\nimport Utils\n\nreadTarLines :: FilePath -> IO [TarLine]\nreadTarLines fp\n = do (ec, out, err) <- readProcessWithExitCode \"tar\" [\"-jtvf\", fp] \"\"\n      case (ec, err) of\n          (ExitSuccess, []) ->\n                  case parseTarLines fp out of\n                  Left  errs -> die errs\n                  Right tls  -> return tls\n          _ ->\n              die [\"Failed running tar -jtvf \" ++ show fp,\n                   \"Exit code: \" ++ show ec,\n                   \"Stderr: \" ++ show err]\n\nparseTarLines :: FilePath -> String -> Either Errors [TarLine]\nparseTarLines fp xs\n    = case partitionEithers (zipWith (parseTarLine fp) [1..] (lines xs)) of\n      ([],    tls) -> Right tls\n      (errss, _)   -> Left (intercalate [\"\"] errss)\n\ndata TarLine = TarLine {\n                   tlPermissions :: String,\n                   tlUser :: String,\n                   tlGroup :: String,\n                   tlSize :: Integer,\n                   tlDateTime :: String,\n                   tlFileName :: FilePath\n               }\n\nparseTarLine :: FilePath -> Int -> String -> Either Errors TarLine\nparseTarLine fp line str\n = case re \"^([^ ]+) ([^ ]+)/([^ ]+) +([0-9]+) ([^ ]+ [^ ]+) ([^ ]+)$\"\n           str of\n   Just [perms, user, grp, sizeStr, dateTime, filename] ->\n       case maybeRead sizeStr of\n       Just size ->\n           Right $ TarLine {\n                       tlPermissions = perms,\n                       tlUser        = user,\n                       tlGroup       = grp,\n                       tlSize        = size,\n                       tlDateTime    = dateTime,\n                       tlFileName    = filename\n                   }\n       _ -> error \"Can't happen: Can't parse size\"\n   _ ->\n       Left [\"In \" ++ show fp ++ \", at line \" ++ show line,\n             \"Tar line doesn't parse: \" ++ show str]\n\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Utils where\n\nimport Data.Function\nimport Data.List\nimport System.Exit\nimport System.IO\nimport Text.Regex.PCRE\n\ndie :: Errors -> IO a\ndie errs = do mapM_ (hPutStrLn stderr) errs\n              exitFailure\n\nwarn :: Errors -> IO ()\nwarn warnings = mapM_ (hPutStrLn stderr) warnings\n\ndieOnErrors :: Either Errors a -> IO a\ndieOnErrors (Left errs) = die errs\ndieOnErrors (Right x) = return x\n\ntype Errors = [String]\ntype Warnings = [String]\n\nmaybeRead :: Read a => String -> Maybe a\nmaybeRead str = case reads str of\n                [(x, \"\")] -> Just x\n                _ -> Nothing\n\nre :: String -> String -> Maybe [String]\nre r str = case matchM r' str :: Maybe (String, String, String, [String]) of\n           Just (_, _, _, ms) -> Just ms\n           Nothing -> Nothing\n    where r' = makeRegex r :: Regex\n\nunSepList :: Eq a => a -> [a] -> [[a]]\nunSepList x xs = case break (x ==) xs of\n                 (this, _ : xs') ->\n                     this : unSepList x xs'\n                 (this, []) ->\n                     [this]\n\nsortByFst :: Ord a => [(a, b)] -> [(a, b)]\nsortByFst = sortBy (compare `on` fst)\n\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections #-}\n{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}\n\n-----------------------------------------------------------------------------\n--\n-- GHC Driver program\n--\n-- (c) The University of Glasgow 2005\n--\n-----------------------------------------------------------------------------\n\nmodule Main (main) where\n\n-- The official GHC API\nimport qualified GHC\nimport GHC              ( -- DynFlags(..), HscTarget(..),\n                          -- GhcMode(..), GhcLink(..),\n                          Ghc, GhcMonad(..),\n                          LoadHowMuch(..) )\nimport CmdLineParser\n\n-- Implementations of the various modes (--show-iface, mkdependHS. etc.)\nimport LoadIface        ( showIface )\nimport HscMain          ( newHscEnv )\nimport DriverPipeline   ( oneShot, compileFile )\nimport DriverMkDepend   ( doMkDependHS )\nimport DriverBkp   ( doBackpack )\n#if defined(GHCI)\nimport GHCi.UI          ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )\n#endif\n\n-- Frontend plugins\n#if defined(GHCI)\nimport DynamicLoading   ( loadFrontendPlugin, initializePlugins  )\nimport Plugins\n#else\nimport DynamicLoading   ( pluginError )\n#endif\nimport Module           ( ModuleName )\n\n\n-- Various other random stuff that we need\nimport GHC.HandleEncoding\nimport Config\nimport Constants\nimport HscTypes\nimport Packages         ( pprPackages, pprPackagesSimple )\nimport DriverPhases\nimport BasicTypes       ( failed )\nimport DynFlags hiding (WarnReason(..))\nimport ErrUtils\nimport FastString\nimport Outputable\nimport SrcLoc\nimport Util\nimport Panic\nimport UniqSupply\nimport MonadUtils       ( liftIO )\n\n-- Imports for --abi-hash\nimport LoadIface           ( loadUserInterface )\nimport Module              ( mkModuleName )\nimport Finder              ( findImportedModule, cannotFindModule )\nimport TcRnMonad           ( initIfaceCheck )\nimport Binary              ( openBinMem, put_ )\nimport BinFingerprint      ( fingerprintBinMem )\n\n-- Standard Haskell libraries\nimport System.IO\nimport System.Environment\nimport System.Exit\nimport System.FilePath\nimport Control.Monad\nimport Data.Char\nimport Data.List\nimport Data.Maybe\nimport Prelude\n\n-----------------------------------------------------------------------------\n-- ToDo:\n\n-- time commands when run with -v\n-- user ways\n-- Win32 support: proper signal handling\n-- reading the package configuration file is too slow\n-- -K<size>\n\n-----------------------------------------------------------------------------\n-- GHC's command-line interface\n\nmain :: IO ()\nmain = do\n   initGCStatistics -- See Note [-Bsymbolic and hooks]\n   hSetBuffering stdout LineBuffering\n   hSetBuffering stderr LineBuffering\n\n   configureHandleEncoding\n   GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do\n    -- 1. extract the -B flag from the args\n    argv0 <- getArgs\n\n    let (minusB_args, argv1) = partition (\"-B\" `isPrefixOf`) argv0\n        mbMinusB | null minusB_args = Nothing\n                 | otherwise = Just (drop 2 (last minusB_args))\n\n    let argv2 = map (mkGeneralLocated \"on the commandline\") argv1\n\n    -- 2. Parse the \"mode\" flags (--make, --interactive etc.)\n    (mode, argv3, flagWarnings) <- parseModeFlags argv2\n\n    -- If all we want to do is something like showing the version number\n    -- then do it now, before we start a GHC session etc. This makes\n    -- getting basic information much more resilient.\n\n    -- In particular, if we wait until later before giving the version\n    -- number then bootstrapping gets confused, as it tries to find out\n    -- what version of GHC it's using before package.conf exists, so\n    -- starting the session fails.\n    case mode of\n        Left preStartupMode ->\n            do case preStartupMode of\n                   ShowSupportedExtensions   -> showSupportedExtensions\n                   ShowVersion               -> showVersion\n                   ShowNumVersion            -> putStrLn cProjectVersion\n                   ShowOptions isInteractive -> showOptions isInteractive\n        Right postStartupMode ->\n            -- start our GHC session\n            GHC.runGhc mbMinusB $ do\n\n            dflags <- GHC.getSessionDynFlags\n\n            case postStartupMode of\n                Left preLoadMode ->\n                    liftIO $ do\n                        case preLoadMode of\n                            ShowInfo               -> showInfo dflags\n                            ShowGhcUsage           -> showGhcUsage  dflags\n                            ShowGhciUsage          -> showGhciUsage dflags\n                            PrintWithDynFlags f    -> putStrLn (f dflags)\n                Right postLoadMode ->\n                    main' postLoadMode dflags argv3 flagWarnings\n\nmain' :: PostLoadMode -> DynFlags -> [Located String] -> [Warn]\n      -> Ghc ()\nmain' postLoadMode dflags0 args flagWarnings = do\n  -- set the default GhcMode, HscTarget and GhcLink.  The HscTarget\n  -- can be further adjusted on a module by module basis, using only\n  -- the -fvia-C and -fasm flags.  If the default HscTarget is not\n  -- HscC or HscAsm, -fvia-C and -fasm have no effect.\n  let dflt_target = hscTarget dflags0\n      (mode, lang, link)\n         = case postLoadMode of\n               DoInteractive   -> (CompManager, HscInterpreted, LinkInMemory)\n               DoEval _        -> (CompManager, HscInterpreted, LinkInMemory)\n               DoMake          -> (CompManager, dflt_target,    LinkBinary)\n               DoBackpack      -> (CompManager, dflt_target,    LinkBinary)\n               DoMkDependHS    -> (MkDepend,    dflt_target,    LinkBinary)\n               DoAbiHash       -> (OneShot,     dflt_target,    LinkBinary)\n               _               -> (OneShot,     dflt_target,    LinkBinary)\n\n  let dflags1 = dflags0{ ghcMode   = mode,\n                         hscTarget = lang,\n                         ghcLink   = link,\n                         verbosity = case postLoadMode of\n                                         DoEval _ -> 0\n                                         _other   -> 1\n                        }\n\n      -- turn on -fimplicit-import-qualified for GHCi now, so that it\n      -- can be overriden from the command-line\n      -- XXX: this should really be in the interactive DynFlags, but\n      -- we don't set that until later in interactiveUI\n      -- We also set -fignore-optim-changes and -fignore-hpc-changes,\n      -- which are program-level options. Again, this doesn't really\n      -- feel like the right place to handle this, but we don't have\n      -- a great story for the moment.\n      dflags2  | DoInteractive <- postLoadMode = def_ghci_flags\n               | DoEval _      <- postLoadMode = def_ghci_flags\n               | otherwise                     = dflags1\n        where def_ghci_flags = dflags1 `gopt_set` Opt_ImplicitImportQualified\n                                       `gopt_set` Opt_IgnoreOptimChanges\n                                       `gopt_set` Opt_IgnoreHpcChanges\n\n        -- The rest of the arguments are \"dynamic\"\n        -- Leftover ones are presumably files\n  (dflags3, fileish_args, dynamicFlagWarnings) <-\n      GHC.parseDynamicFlags dflags2 args\n\n  let dflags4 = case lang of\n                HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->\n                    let platform = targetPlatform dflags3\n                        dflags3a = updateWays $ dflags3 { ways = interpWays }\n                        dflags3b = foldl gopt_set dflags3a\n                                 $ concatMap (wayGeneralFlags platform)\n                                             interpWays\n                        dflags3c = foldl gopt_unset dflags3b\n                                 $ concatMap (wayUnsetGeneralFlags platform)\n                                             interpWays\n                    in dflags3c\n                _ ->\n                    dflags3\n\n  GHC.prettyPrintGhcErrors dflags4 $ do\n\n  let flagWarnings' = flagWarnings ++ dynamicFlagWarnings\n\n  handleSourceError (\\e -> do\n       GHC.printException e\n       liftIO $ exitWith (ExitFailure 1)) $ do\n         liftIO $ handleFlagWarnings dflags4 flagWarnings'\n\n  liftIO $ showBanner postLoadMode dflags4\n\n  let\n     -- To simplify the handling of filepaths, we normalise all filepaths right\n     -- away. Note the asymmetry of FilePath.normalise:\n     --    Linux:   p/q -> p/q; p\\q -> p\\q\n     --    Windows: p/q -> p\\q; p\\q -> p\\q\n     -- #12674: Filenames starting with a hypen get normalised from ./-foo.hs\n     -- to -foo.hs. We have to re-prepend the current directory.\n    normalise_hyp fp\n        | strt_dot_sl && \"-\" `isPrefixOf` nfp = cur_dir ++ nfp\n        | otherwise                           = nfp\n        where\n#if defined(mingw32_HOST_OS)\n          strt_dot_sl = \"./\" `isPrefixOf` fp || \".\\\\\" `isPrefixOf` fp\n#else\n          strt_dot_sl = \"./\" `isPrefixOf` fp\n#endif\n          cur_dir = '.' : [pathSeparator]\n          nfp = normalise fp\n    normal_fileish_paths = map (normalise_hyp . unLoc) fileish_args\n    (srcs, objs)         = partition_args normal_fileish_paths [] []\n\n    dflags5 = dflags4 { ldInputs = map (FileOption \"\") objs\n                                   ++ ldInputs dflags4 }\n\n  -- we've finished manipulating the DynFlags, update the session\n  _ <- GHC.setSessionDynFlags dflags5\n  dflags6 <- GHC.getSessionDynFlags\n  hsc_env <- GHC.getSession\n\n        ---------------- Display configuration -----------\n  case verbosity dflags6 of\n    v | v == 4 -> liftIO $ dumpPackagesSimple dflags6\n      | v >= 5 -> liftIO $ dumpPackages dflags6\n      | otherwise -> return ()\n\n  liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)\n        ---------------- Final sanity checking -----------\n  liftIO $ checkOptions postLoadMode dflags6 srcs objs\n\n  ---------------- Do the business -----------\n  handleSourceError (\\e -> do\n       GHC.printException e\n       liftIO $ exitWith (ExitFailure 1)) $ do\n    case postLoadMode of\n       ShowInterface f        -> liftIO $ doShowIface dflags6 f\n       DoMake                 -> doMake srcs\n       DoMkDependHS           -> doMkDependHS (map fst srcs)\n       StopBefore p           -> liftIO (oneShot hsc_env p srcs)\n       DoInteractive          -> ghciUI hsc_env dflags6 srcs Nothing\n       DoEval exprs           -> ghciUI hsc_env dflags6 srcs $ Just $\n                                   reverse exprs\n       DoAbiHash              -> abiHash (map fst srcs)\n       ShowPackages           -> liftIO $ showPackages dflags6\n       DoFrontend f           -> doFrontend f srcs\n       DoBackpack             -> doBackpack (map fst srcs)\n\n  liftIO $ dumpFinalStats dflags6\n\nghciUI :: HscEnv -> DynFlags -> [(FilePath, Maybe Phase)] -> Maybe [String]\n       -> Ghc ()\n#if !defined(GHCI)\nghciUI _ _ _ _ =\n  throwGhcException (CmdLineError \"not built for interactive use\")\n#else\nghciUI hsc_env dflags0 srcs maybe_expr = do\n  dflags1 <- liftIO (initializePlugins hsc_env dflags0)\n  _ <- GHC.setSessionDynFlags dflags1\n  interactiveUI defaultGhciSettings srcs maybe_expr\n#endif\n\n-- -----------------------------------------------------------------------------\n-- Splitting arguments into source files and object files.  This is where we\n-- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source\n-- file indicating the phase specified by the -x option in force, if any.\n\npartition_args :: [String] -> [(String, Maybe Phase)] -> [String]\n               -> ([(String, Maybe Phase)], [String])\npartition_args [] srcs objs = (reverse srcs, reverse objs)\npartition_args (\"-x\":suff:args) srcs objs\n  | \"none\" <- suff      = partition_args args srcs objs\n  | StopLn <- phase     = partition_args args srcs (slurp ++ objs)\n  | otherwise           = partition_args rest (these_srcs ++ srcs) objs\n        where phase = startPhase suff\n              (slurp,rest) = break (== \"-x\") args\n              these_srcs = zip slurp (repeat (Just phase))\npartition_args (arg:args) srcs objs\n  | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs\n  | otherwise               = partition_args args srcs (arg:objs)\n\n    {-\n      We split out the object files (.o, .dll) and add them\n      to ldInputs for use by the linker.\n\n      The following things should be considered compilation manager inputs:\n\n       - haskell source files (strings ending in .hs, .lhs or other\n         haskellish extension),\n\n       - module names (not forgetting hierarchical module names),\n\n       - things beginning with '-' are flags that were not recognised by\n         the flag parser, and we want them to generate errors later in\n         checkOptions, so we class them as source files (#5921)\n\n       - and finally we consider everything without an extension to be\n         a comp manager input, as shorthand for a .hs or .lhs filename.\n\n      Everything else is considered to be a linker object, and passed\n      straight through to the linker.\n    -}\nlooks_like_an_input :: String -> Bool\nlooks_like_an_input m =  isSourceFilename m\n                      || looksLikeModuleName m\n                      || \"-\" `isPrefixOf` m\n                      || not (hasExtension m)\n\n-- -----------------------------------------------------------------------------\n-- Option sanity checks\n\n-- | Ensure sanity of options.\n--\n-- Throws 'UsageError' or 'CmdLineError' if not.\ncheckOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> IO ()\n     -- Final sanity checking before kicking off a compilation (pipeline).\ncheckOptions mode dflags srcs objs = do\n     -- Complain about any unknown flags\n   let unknown_opts = [ f | (f@('-':_), _) <- srcs ]\n   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)\n\n   when (notNull (filter wayRTSOnly (ways dflags))\n         && isInterpretiveMode mode) $\n        hPutStrLn stderr (\"Warning: -debug, -threaded and -ticky are ignored by GHCi\")\n\n        -- -prof and --interactive are not a good combination\n   when ((filter (not . wayRTSOnly) (ways dflags) /= interpWays)\n         && isInterpretiveMode mode\n         && not (gopt Opt_ExternalInterpreter dflags)) $\n      do throwGhcException (UsageError\n              \"-fexternal-interpreter is required when using --interactive with a non-standard way (-prof, -static, or -dynamic).\")\n        -- -ohi sanity check\n   if (isJust (outputHi dflags) &&\n      (isCompManagerMode mode || srcs `lengthExceeds` 1))\n        then throwGhcException (UsageError \"-ohi can only be used when compiling a single source file\")\n        else do\n\n        -- -o sanity checking\n   if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)\n         && not (isLinkMode mode))\n        then throwGhcException (UsageError \"can't apply -o to multiple source files\")\n        else do\n\n   let not_linking = not (isLinkMode mode) || isNoLink (ghcLink dflags)\n\n   when (not_linking && not (null objs)) $\n        hPutStrLn stderr (\"Warning: the following files would be used as linker inputs, but linking is not being done: \" ++ unwords objs)\n\n        -- Check that there are some input files\n        -- (except in the interactive case)\n   if null srcs && (null objs || not_linking) && needsInputsMode mode\n        then throwGhcException (UsageError \"no input files\")\n        else do\n\n   case mode of\n      StopBefore HCc | hscTarget dflags /= HscC\n        -> throwGhcException $ UsageError $\n           \"the option -C is only available with an unregisterised GHC\"\n      _ -> return ()\n\n     -- Verify that output files point somewhere sensible.\n   verifyOutputFiles dflags\n\n-- Compiler output options\n\n-- Called to verify that the output files point somewhere valid.\n--\n-- The assumption is that the directory portion of these output\n-- options will have to exist by the time 'verifyOutputFiles'\n-- is invoked.\n--\n-- We create the directories for -odir, -hidir, -outputdir etc. ourselves if\n-- they don't exist, so don't check for those here (#2278).\nverifyOutputFiles :: DynFlags -> IO ()\nverifyOutputFiles dflags = do\n  let ofile = outputFile dflags\n  when (isJust ofile) $ do\n     let fn = fromJust ofile\n     flg <- doesDirNameExist fn\n     when (not flg) (nonExistentDir \"-o\" fn)\n  let ohi = outputHi dflags\n  when (isJust ohi) $ do\n     let hi = fromJust ohi\n     flg <- doesDirNameExist hi\n     when (not flg) (nonExistentDir \"-ohi\" hi)\n where\n   nonExistentDir flg dir =\n     throwGhcException (CmdLineError (\"error: directory portion of \" ++\n                             show dir ++ \" does not exist (used with \" ++\n                             show flg ++ \" option.)\"))\n\n-----------------------------------------------------------------------------\n-- GHC modes of operation\n\ntype Mode = Either PreStartupMode PostStartupMode\ntype PostStartupMode = Either PreLoadMode PostLoadMode\n\ndata PreStartupMode\n  = ShowVersion                          -- ghc -V/--version\n  | ShowNumVersion                       -- ghc --numeric-version\n  | ShowSupportedExtensions              -- ghc --supported-extensions\n  | ShowOptions Bool {- isInteractive -} -- ghc --show-options\n\nshowVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode\nshowVersionMode             = mkPreStartupMode ShowVersion\nshowNumVersionMode          = mkPreStartupMode ShowNumVersion\nshowSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions\nshowOptionsMode             = mkPreStartupMode (ShowOptions False)\n\nmkPreStartupMode :: PreStartupMode -> Mode\nmkPreStartupMode = Left\n\nisShowVersionMode :: Mode -> Bool\nisShowVersionMode (Left ShowVersion) = True\nisShowVersionMode _ = False\n\nisShowNumVersionMode :: Mode -> Bool\nisShowNumVersionMode (Left ShowNumVersion) = True\nisShowNumVersionMode _ = False\n\ndata PreLoadMode\n  = ShowGhcUsage                           -- ghc -?\n  | ShowGhciUsage                          -- ghci -?\n  | ShowInfo                               -- ghc --info\n  | PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo\n\nshowGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode\nshowGhcUsageMode = mkPreLoadMode ShowGhcUsage\nshowGhciUsageMode = mkPreLoadMode ShowGhciUsage\nshowInfoMode = mkPreLoadMode ShowInfo\n\nprintSetting :: String -> Mode\nprintSetting k = mkPreLoadMode (PrintWithDynFlags f)\n    where f dflags = fromMaybe (panic (\"Setting not found: \" ++ show k))\n                   $ lookup k (compilerInfo dflags)\n\nmkPreLoadMode :: PreLoadMode -> Mode\nmkPreLoadMode = Right . Left\n\nisShowGhcUsageMode :: Mode -> Bool\nisShowGhcUsageMode (Right (Left ShowGhcUsage)) = True\nisShowGhcUsageMode _ = False\n\nisShowGhciUsageMode :: Mode -> Bool\nisShowGhciUsageMode (Right (Left ShowGhciUsage)) = True\nisShowGhciUsageMode _ = False\n\ndata PostLoadMode\n  = ShowInterface FilePath  -- ghc --show-iface\n  | DoMkDependHS            -- ghc -M\n  | StopBefore Phase        -- ghc -E | -C | -S\n                            -- StopBefore StopLn is the default\n  | DoMake                  -- ghc --make\n  | DoBackpack              -- ghc --backpack foo.bkp\n  | DoInteractive           -- ghc --interactive\n  | DoEval [String]         -- ghc -e foo -e bar => DoEval [\"bar\", \"foo\"]\n  | DoAbiHash               -- ghc --abi-hash\n  | ShowPackages            -- ghc --show-packages\n  | DoFrontend ModuleName   -- ghc --frontend Plugin.Module\n\ndoMkDependHSMode, doMakeMode, doInteractiveMode,\n  doAbiHashMode, showPackagesMode :: Mode\ndoMkDependHSMode = mkPostLoadMode DoMkDependHS\ndoMakeMode = mkPostLoadMode DoMake\ndoInteractiveMode = mkPostLoadMode DoInteractive\ndoAbiHashMode = mkPostLoadMode DoAbiHash\nshowPackagesMode = mkPostLoadMode ShowPackages\n\nshowInterfaceMode :: FilePath -> Mode\nshowInterfaceMode fp = mkPostLoadMode (ShowInterface fp)\n\nstopBeforeMode :: Phase -> Mode\nstopBeforeMode phase = mkPostLoadMode (StopBefore phase)\n\ndoEvalMode :: String -> Mode\ndoEvalMode str = mkPostLoadMode (DoEval [str])\n\ndoFrontendMode :: String -> Mode\ndoFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))\n\ndoBackpackMode :: Mode\ndoBackpackMode = mkPostLoadMode DoBackpack\n\nmkPostLoadMode :: PostLoadMode -> Mode\nmkPostLoadMode = Right . Right\n\nisDoInteractiveMode :: Mode -> Bool\nisDoInteractiveMode (Right (Right DoInteractive)) = True\nisDoInteractiveMode _ = False\n\nisStopLnMode :: Mode -> Bool\nisStopLnMode (Right (Right (StopBefore StopLn))) = True\nisStopLnMode _ = False\n\nisDoMakeMode :: Mode -> Bool\nisDoMakeMode (Right (Right DoMake)) = True\nisDoMakeMode _ = False\n\nisDoEvalMode :: Mode -> Bool\nisDoEvalMode (Right (Right (DoEval _))) = True\nisDoEvalMode _ = False\n\n#if defined(GHCI)\nisInteractiveMode :: PostLoadMode -> Bool\nisInteractiveMode DoInteractive = True\nisInteractiveMode _             = False\n#endif\n\n-- isInterpretiveMode: byte-code compiler involved\nisInterpretiveMode :: PostLoadMode -> Bool\nisInterpretiveMode DoInteractive = True\nisInterpretiveMode (DoEval _)    = True\nisInterpretiveMode _             = False\n\nneedsInputsMode :: PostLoadMode -> Bool\nneedsInputsMode DoMkDependHS    = True\nneedsInputsMode (StopBefore _)  = True\nneedsInputsMode DoMake          = True\nneedsInputsMode _               = False\n\n-- True if we are going to attempt to link in this mode.\n-- (we might not actually link, depending on the GhcLink flag)\nisLinkMode :: PostLoadMode -> Bool\nisLinkMode (StopBefore StopLn) = True\nisLinkMode DoMake              = True\nisLinkMode DoInteractive       = True\nisLinkMode (DoEval _)          = True\nisLinkMode _                   = False\n\nisCompManagerMode :: PostLoadMode -> Bool\nisCompManagerMode DoMake        = True\nisCompManagerMode DoInteractive = True\nisCompManagerMode (DoEval _)    = True\nisCompManagerMode _             = False\n\n-- -----------------------------------------------------------------------------\n-- Parsing the mode flag\n\nparseModeFlags :: [Located String]\n               -> IO (Mode,\n                      [Located String],\n                      [Warn])\nparseModeFlags args = do\n  let ((leftover, errs1, warns), (mModeFlag, errs2, flags')) =\n          runCmdLine (processArgs mode_flags args)\n                     (Nothing, [], [])\n      mode = case mModeFlag of\n             Nothing     -> doMakeMode\n             Just (m, _) -> m\n\n  -- See Note [Handling errors when parsing commandline flags]\n  unless (null errs1 && null errs2) $ throwGhcException $ errorsToGhcException $\n      map ((\"on the commandline\", )) $ map (unLoc . errMsg) errs1 ++ errs2\n\n  return (mode, flags' ++ leftover, warns)\n\ntype ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])\n  -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)\n  -- so we collect the new ones and return them.\n\nmode_flags :: [Flag ModeM]\nmode_flags =\n  [  ------- help / version ----------------------------------------------\n    defFlag \"?\"                     (PassFlag (setMode showGhcUsageMode))\n  , defFlag \"-help\"                 (PassFlag (setMode showGhcUsageMode))\n  , defFlag \"V\"                     (PassFlag (setMode showVersionMode))\n  , defFlag \"-version\"              (PassFlag (setMode showVersionMode))\n  , defFlag \"-numeric-version\"      (PassFlag (setMode showNumVersionMode))\n  , defFlag \"-info\"                 (PassFlag (setMode showInfoMode))\n  , defFlag \"-show-options\"         (PassFlag (setMode showOptionsMode))\n  , defFlag \"-supported-languages\"  (PassFlag (setMode showSupportedExtensionsMode))\n  , defFlag \"-supported-extensions\" (PassFlag (setMode showSupportedExtensionsMode))\n  , defFlag \"-show-packages\"        (PassFlag (setMode showPackagesMode))\n  ] ++\n  [ defFlag k'                      (PassFlag (setMode (printSetting k)))\n  | k <- [\"Project version\",\n          \"Project Git commit id\",\n          \"Booter version\",\n          \"Stage\",\n          \"Build platform\",\n          \"Host platform\",\n          \"Target platform\",\n          \"Have interpreter\",\n          \"Object splitting supported\",\n          \"Have native code generator\",\n          \"Support SMP\",\n          \"Unregisterised\",\n          \"Tables next to code\",\n          \"RTS ways\",\n          \"Leading underscore\",\n          \"Debug on\",\n          \"LibDir\",\n          \"Global Package DB\",\n          \"C compiler flags\",\n          \"C compiler link flags\",\n          \"ld flags\"],\n    let k' = \"-print-\" ++ map (replaceSpace . toLower) k\n        replaceSpace ' ' = '-'\n        replaceSpace c   = c\n  ] ++\n      ------- interfaces ----------------------------------------------------\n  [ defFlag \"-show-iface\"  (HasArg (\\f -> setMode (showInterfaceMode f)\n                                               \"--show-iface\"))\n\n      ------- primary modes ------------------------------------------------\n  , defFlag \"c\"            (PassFlag (\\f -> do setMode (stopBeforeMode StopLn) f\n                                               addFlag \"-no-link\" f))\n  , defFlag \"M\"            (PassFlag (setMode doMkDependHSMode))\n  , defFlag \"E\"            (PassFlag (setMode (stopBeforeMode anyHsc)))\n  , defFlag \"C\"            (PassFlag (setMode (stopBeforeMode HCc)))\n  , defFlag \"S\"            (PassFlag (setMode (stopBeforeMode (As False))))\n  , defFlag \"-make\"        (PassFlag (setMode doMakeMode))\n  , defFlag \"-backpack\"    (PassFlag (setMode doBackpackMode))\n  , defFlag \"-interactive\" (PassFlag (setMode doInteractiveMode))\n  , defFlag \"-abi-hash\"    (PassFlag (setMode doAbiHashMode))\n  , defFlag \"e\"            (SepArg   (\\s -> setMode (doEvalMode s) \"-e\"))\n  , defFlag \"-frontend\"    (SepArg   (\\s -> setMode (doFrontendMode s) \"-frontend\"))\n  ]\n\nsetMode :: Mode -> String -> EwM ModeM ()\nsetMode newMode newFlag = liftEwM $ do\n    (mModeFlag, errs, flags') <- getCmdLineState\n    let (modeFlag', errs') =\n            case mModeFlag of\n            Nothing -> ((newMode, newFlag), errs)\n            Just (oldMode, oldFlag) ->\n                case (oldMode, newMode) of\n                    -- -c/--make are allowed together, and mean --make -no-link\n                    _ |  isStopLnMode oldMode && isDoMakeMode newMode\n                      || isStopLnMode newMode && isDoMakeMode oldMode ->\n                      ((doMakeMode, \"--make\"), [])\n\n                    -- If we have both --help and --interactive then we\n                    -- want showGhciUsage\n                    _ | isShowGhcUsageMode oldMode &&\n                        isDoInteractiveMode newMode ->\n                            ((showGhciUsageMode, oldFlag), [])\n                      | isShowGhcUsageMode newMode &&\n                        isDoInteractiveMode oldMode ->\n                            ((showGhciUsageMode, newFlag), [])\n\n                    -- If we have both -e and --interactive then -e always wins\n                    _ | isDoEvalMode oldMode &&\n                        isDoInteractiveMode newMode ->\n                            ((oldMode, oldFlag), [])\n                      | isDoEvalMode newMode &&\n                        isDoInteractiveMode oldMode ->\n                            ((newMode, newFlag), [])\n\n                    -- Otherwise, --help/--version/--numeric-version always win\n                      | isDominantFlag oldMode -> ((oldMode, oldFlag), [])\n                      | isDominantFlag newMode -> ((newMode, newFlag), [])\n                    -- We need to accumulate eval flags like \"-e foo -e bar\"\n                    (Right (Right (DoEval esOld)),\n                     Right (Right (DoEval [eNew]))) ->\n                        ((Right (Right (DoEval (eNew : esOld))), oldFlag),\n                         errs)\n                    -- Saying e.g. --interactive --interactive is OK\n                    _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)\n\n                    -- --interactive and --show-options are used together\n                    (Right (Right DoInteractive), Left (ShowOptions _)) ->\n                      ((Left (ShowOptions True),\n                        \"--interactive --show-options\"), errs)\n                    (Left (ShowOptions _), (Right (Right DoInteractive))) ->\n                      ((Left (ShowOptions True),\n                        \"--show-options --interactive\"), errs)\n                    -- Otherwise, complain\n                    _ -> let err = flagMismatchErr oldFlag newFlag\n                         in ((oldMode, oldFlag), err : errs)\n    putCmdLineState (Just modeFlag', errs', flags')\n  where isDominantFlag f = isShowGhcUsageMode   f ||\n                           isShowGhciUsageMode  f ||\n                           isShowVersionMode    f ||\n                           isShowNumVersionMode f\n\nflagMismatchErr :: String -> String -> String\nflagMismatchErr oldFlag newFlag\n    = \"cannot use `\" ++ oldFlag ++  \"' with `\" ++ newFlag ++ \"'\"\n\naddFlag :: String -> String -> EwM ModeM ()\naddFlag s flag = liftEwM $ do\n  (m, e, flags') <- getCmdLineState\n  putCmdLineState (m, e, mkGeneralLocated loc s : flags')\n    where loc = \"addFlag by \" ++ flag ++ \" on the commandline\"\n\n-- ----------------------------------------------------------------------------\n-- Run --make mode\n\ndoMake :: [(String,Maybe Phase)] -> Ghc ()\ndoMake srcs  = do\n    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs\n\n    hsc_env <- GHC.getSession\n\n    -- if we have no haskell sources from which to do a dependency\n    -- analysis, then just do one-shot compilation and/or linking.\n    -- This means that \"ghc Foo.o Bar.o -o baz\" links the program as\n    -- we expect.\n    if (null hs_srcs)\n       then liftIO (oneShot hsc_env StopLn srcs)\n       else do\n\n    o_files <- mapM (\\x -> liftIO $ compileFile hsc_env StopLn x)\n                 non_hs_srcs\n    dflags <- GHC.getSessionDynFlags\n    let dflags' = dflags { ldInputs = map (FileOption \"\") o_files\n                                      ++ ldInputs dflags }\n    _ <- GHC.setSessionDynFlags dflags'\n\n    targets <- mapM (uncurry GHC.guessTarget) hs_srcs\n    GHC.setTargets targets\n    ok_flag <- GHC.load LoadAllTargets\n\n    when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))\n    return ()\n\n\n-- ---------------------------------------------------------------------------\n-- --show-iface mode\n\ndoShowIface :: DynFlags -> FilePath -> IO ()\ndoShowIface dflags file = do\n  hsc_env <- newHscEnv dflags\n  showIface hsc_env file\n\n-- ---------------------------------------------------------------------------\n-- Various banners and verbosity output.\n\nshowBanner :: PostLoadMode -> DynFlags -> IO ()\nshowBanner _postLoadMode dflags = do\n   let verb = verbosity dflags\n\n#if defined(GHCI)\n   -- Show the GHCi banner\n   when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg\n#endif\n\n   -- Display details of the configuration in verbose mode\n   when (verb >= 2) $\n    do hPutStr stderr \"Glasgow Haskell Compiler, Version \"\n       hPutStr stderr cProjectVersion\n       hPutStr stderr \", stage \"\n       hPutStr stderr cStage\n       hPutStr stderr \" booted by GHC version \"\n       hPutStrLn stderr cBooterVersion\n\n-- We print out a Read-friendly string, but a prettier one than the\n-- Show instance gives us\nshowInfo :: DynFlags -> IO ()\nshowInfo dflags = do\n        let sq x = \" [\" ++ x ++ \"\\n ]\"\n        putStrLn $ sq $ intercalate \"\\n ,\" $ map show $ compilerInfo dflags\n\nshowSupportedExtensions :: IO ()\nshowSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions\n\nshowVersion :: IO ()\nshowVersion = putStrLn (cProjectName ++ \", version \" ++ cProjectVersion)\n\nshowOptions :: Bool -> IO ()\nshowOptions isInteractive = putStr (unlines availableOptions)\n    where\n      availableOptions = concat [\n        flagsForCompletion isInteractive,\n        map ('-':) (getFlagNames mode_flags)\n        ]\n      getFlagNames opts         = map flagName opts\n\nshowGhcUsage :: DynFlags -> IO ()\nshowGhcUsage = showUsage False\n\nshowGhciUsage :: DynFlags -> IO ()\nshowGhciUsage = showUsage True\n\nshowUsage :: Bool -> DynFlags -> IO ()\nshowUsage ghci dflags = do\n  let usage_path = if ghci then ghciUsagePath dflags\n                           else ghcUsagePath dflags\n  usage <- readFile usage_path\n  dump usage\n  where\n     dump \"\"          = return ()\n     dump ('$':'$':s) = putStr progName >> dump s\n     dump (c:s)       = putChar c >> dump s\n\ndumpFinalStats :: DynFlags -> IO ()\ndumpFinalStats dflags =\n  when (gopt Opt_D_faststring_stats dflags) $ dumpFastStringStats dflags\n\ndumpFastStringStats :: DynFlags -> IO ()\ndumpFastStringStats dflags = do\n  segments <- getFastStringTable\n  let buckets = concat segments\n      bucketsPerSegment = map length segments\n      entriesPerBucket = map length buckets\n      entries = sum entriesPerBucket\n      hasZ = sum $ map (length . filter hasZEncoding) buckets\n      msg = text \"FastString stats:\" $$ nest 4 (vcat\n        [ text \"segments:         \" <+> int (length segments)\n        , text \"buckets:          \" <+> int (sum bucketsPerSegment)\n        , text \"entries:          \" <+> int entries\n        , text \"largest segment:  \" <+> int (maximum bucketsPerSegment)\n        , text \"smallest segment: \" <+> int (minimum bucketsPerSegment)\n        , text \"longest bucket:   \" <+> int (maximum entriesPerBucket)\n        , text \"has z-encoding:   \" <+> (hasZ `pcntOf` entries)\n        ])\n        -- we usually get more \"has z-encoding\" than \"z-encoded\", because\n        -- when we z-encode a string it might hash to the exact same string,\n        -- which is not counted as \"z-encoded\".  Only strings whose\n        -- Z-encoding is different from the original string are counted in\n        -- the \"z-encoded\" total.\n  putMsg dflags msg\n  where\n   x `pcntOf` y = int ((x * 100) `quot` y) Outputable.<> char '%'\n\nshowPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO ()\nshowPackages       dflags = putStrLn (showSDoc dflags (pprPackages dflags))\ndumpPackages       dflags = putMsg dflags (pprPackages dflags)\ndumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags)\n\n-- -----------------------------------------------------------------------------\n-- Frontend plugin support\n\ndoFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()\n#if !defined(GHCI)\ndoFrontend modname _ = pluginError [modname]\n#else\ndoFrontend modname srcs = do\n    hsc_env <- getSession\n    frontend_plugin <- liftIO $ loadFrontendPlugin hsc_env modname\n    frontend frontend_plugin\n      (reverse $ frontendPluginOpts (hsc_dflags hsc_env)) srcs\n#endif\n\n-- -----------------------------------------------------------------------------\n-- ABI hash support\n\n{-\n        ghc --abi-hash Data.Foo System.Bar\n\nGenerates a combined hash of the ABI for modules Data.Foo and\nSystem.Bar.  The modules must already be compiled, and appropriate -i\noptions may be necessary in order to find the .hi files.\n\nThis is used by Cabal for generating the ComponentId for a\npackage.  The ComponentId must change when the visible ABI of\nthe package chagnes, so during registration Cabal calls ghc --abi-hash\nto get a hash of the package's ABI.\n-}\n\n-- | Print ABI hash of input modules.\n--\n-- The resulting hash is the MD5 of the GHC version used (Trac #5328,\n-- see 'hiVersion') and of the existing ABI hash from each module (see\n-- 'mi_mod_hash').\nabiHash :: [String] -- ^ List of module names\n        -> Ghc ()\nabiHash strs = do\n  hsc_env <- getSession\n  let dflags = hsc_dflags hsc_env\n\n  liftIO $ do\n\n  let find_it str = do\n         let modname = mkModuleName str\n         r <- findImportedModule hsc_env modname Nothing\n         case r of\n           Found _ m -> return m\n           _error    -> throwGhcException $ CmdLineError $ showSDoc dflags $\n                          cannotFindModule dflags modname r\n\n  mods <- mapM find_it strs\n\n  let get_iface modl = loadUserInterface False (text \"abiHash\") modl\n  ifaces <- initIfaceCheck (text \"abiHash\") hsc_env $ mapM get_iface mods\n\n  bh <- openBinMem (3*1024) -- just less than a block\n  put_ bh hiVersion\n    -- package hashes change when the compiler version changes (for now)\n    -- see #5328\n  mapM_ (put_ bh . mi_mod_hash) ifaces\n  f <- fingerprintBinMem bh\n\n  putStrLn (showPpr dflags f)\n\n-- -----------------------------------------------------------------------------\n-- Util\n\nunknownFlagsErr :: [String] -> a\nunknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs\n  where\n    oneError f =\n        \"unrecognised flag: \" ++ f ++ \"\\n\" ++\n        (case match f (nubSort allNonDeprecatedFlags) of\n            [] -> \"\"\n            suggs -> \"did you mean one of:\\n\" ++ unlines (map (\"  \" ++) suggs))\n    -- fixes #11789\n    -- If the flag contains '=',\n    -- this uses both the whole and the left side of '=' for comparing.\n    match f allFlags\n        | elem '=' f =\n              let (flagsWithEq, flagsWithoutEq) = partition (elem '=') allFlags\n                  fName = takeWhile (/= '=') f\n              in (fuzzyMatch f flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq)\n        | otherwise = fuzzyMatch f allFlags\n\n{- Note [-Bsymbolic and hooks]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-Bsymbolic is a flag that prevents the binding of references to global\nsymbols to symbols outside the shared library being compiled (see `man\nld`). When dynamically linking, we don't use -Bsymbolic on the RTS\npackage: that is because we want hooks to be overridden by the user,\nwe don't want to constrain them to the RTS package.\n\nUnfortunately this seems to have broken somehow on OS X: as a result,\ndefaultHooks (in hschooks.c) is not called, which does not initialize\nthe GC stats. As a result, this breaks things like `:set +s` in GHCi\n(#8754). As a hacky workaround, we instead call 'defaultHooks'\ndirectly to initalize the flags in the RTS.\n\nA byproduct of this, I believe, is that hooks are likely broken on OS\nX when dynamically linking. But this probably doesn't affect most\npeople since we're linking GHC dynamically, but most things themselves\nlink statically.\n-}\n\n-- If GHC_LOADED_INTO_GHCI is not set when GHC is loaded into GHCi, then\n-- running it causes an error like this:\n--\n-- Loading temp shared object failed:\n-- /tmp/ghc13836_0/libghc_1872.so: undefined symbol: initGCStatistics\n--\n-- Skipping the foreign call fixes this problem, and the outer GHCi\n-- should have already made this call anyway.\n#if defined(GHC_LOADED_INTO_GHCI)\ninitGCStatistics :: IO ()\ninitGCStatistics = return ()\n#else\nforeign import ccall safe \"initGCStatistics\"\n  initGCStatistics :: IO ()\n#endif\n", "num_lines": 964}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards, LambdaCase, MagicHash, UnboxedTuples #-}\nmodule GHCi.Leak\n  ( LeakIndicators\n  , getLeakIndicators\n  , checkLeakIndicators\n  ) where\n\nimport Control.Monad\nimport Data.Bits\nimport DynFlags ( sTargetPlatform )\nimport Foreign.Ptr (ptrToIntPtr, intPtrToPtr)\nimport GHC\nimport GHC.Exts (anyToAddr#)\nimport GHC.Ptr (Ptr (..))\nimport GHC.Types (IO (..))\nimport HscTypes\nimport Outputable\nimport Platform (target32Bit)\nimport Prelude\nimport System.Mem\nimport System.Mem.Weak\nimport UniqDFM\n\n-- Checking for space leaks in GHCi. See #15111, and the\n-- -fghci-leak-check flag.\n\ndata LeakIndicators = LeakIndicators [LeakModIndicators]\n\ndata LeakModIndicators = LeakModIndicators\n  { leakMod :: Weak HomeModInfo\n  , leakIface :: Weak ModIface\n  , leakDetails :: Weak ModDetails\n  , leakLinkable :: Maybe (Weak Linkable)\n  }\n\n-- | Grab weak references to some of the data structures representing\n-- the currently loaded modules.\ngetLeakIndicators :: HscEnv -> IO LeakIndicators\ngetLeakIndicators HscEnv{..} =\n  fmap LeakIndicators $\n    forM (eltsUDFM hsc_HPT) $ \\hmi@HomeModInfo{..} -> do\n      leakMod <- mkWeakPtr hmi Nothing\n      leakIface <- mkWeakPtr hm_iface Nothing\n      leakDetails <- mkWeakPtr hm_details Nothing\n      leakLinkable <- mapM (`mkWeakPtr` Nothing) hm_linkable\n      return $ LeakModIndicators{..}\n\n-- | Look at the LeakIndicators collected by an earlier call to\n-- `getLeakIndicators`, and print messasges if any of them are still\n-- alive.\ncheckLeakIndicators :: DynFlags -> LeakIndicators -> IO ()\ncheckLeakIndicators dflags (LeakIndicators leakmods)  = do\n  performGC\n  forM_ leakmods $ \\LeakModIndicators{..} -> do\n    deRefWeak leakMod >>= \\case\n      Nothing -> return ()\n      Just hmi ->\n        report (\"HomeModInfo for \" ++\n          showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)\n    deRefWeak leakIface >>= report \"ModIface\"\n    deRefWeak leakDetails >>= report \"ModDetails\"\n    forM_ leakLinkable $ \\l -> deRefWeak l >>= report \"Linkable\"\n where\n  report :: String -> Maybe a -> IO ()\n  report _ Nothing = return ()\n  report msg (Just a) = do\n    addr <- IO (\\s -> case anyToAddr# a s of\n                        (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ())\n    putStrLn (\"-fghci-leak-check: \" ++ msg ++ \" is still alive at \" ++\n              show (maskTagBits addr))\n\n  tagBits\n    | target32Bit (sTargetPlatform (settings dflags)) = 2\n    | otherwise = 3\n\n  maskTagBits :: Ptr a -> Ptr a\n  maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1))\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE NondecreasingIndentation #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE ViewPatterns #-}\n\n{-# OPTIONS -fno-cse #-}\n-- -fno-cse is needed for GLOBAL_VAR's to behave properly\n\n-----------------------------------------------------------------------------\n--\n-- GHC Interactive User Interface\n--\n-- (c) The GHC Team 2005-2006\n--\n-----------------------------------------------------------------------------\n\nmodule GHCi.UI (\n        interactiveUI,\n        GhciSettings(..),\n        defaultGhciSettings,\n        ghciCommands,\n        ghciWelcomeMsg\n    ) where\n\n#include \"HsVersions.h\"\n\n-- GHCi\nimport qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' )\nimport GHCi.UI.Monad hiding ( args, runStmt )\nimport GHCi.UI.Tags\nimport GHCi.UI.Info\nimport Debugger\n\n-- The GHC interface\nimport GHCi\nimport GHCi.RemoteTypes\nimport GHCi.BreakArray\nimport DynFlags\nimport ErrUtils hiding (traceCmd)\nimport Finder\nimport GhcMonad ( modifySession )\nimport qualified GHC\nimport GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),\n             TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,\n             GetDocsFailure(..),\n             getModuleGraph, handleSourceError )\nimport HscMain (hscParseDeclsWithLocation, hscParseStmtWithLocation)\nimport HsImpExp\nimport HsSyn\nimport HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,\n                  setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc )\nimport Module\nimport Name\nimport Packages ( trusted, getPackageDetails, getInstalledPackageDetails,\n                  listVisibleModuleNames, pprFlag )\nimport IfaceSyn ( showToHeader )\nimport PprTyThing\nimport PrelNames\nimport RdrName ( getGRE_NameQualifier_maybes, getRdrName )\nimport SrcLoc\nimport qualified Lexer\n\nimport StringBuffer\nimport Outputable hiding ( printForUser, printForUserPartWay )\n\nimport DynamicLoading ( initializePlugins )\n\n-- Other random utilities\nimport BasicTypes hiding ( isTopLevel )\nimport Config\nimport Digraph\nimport Encoding\nimport FastString\nimport Linker\nimport Maybes ( orElse, expectJust )\nimport NameSet\nimport Panic hiding ( showException )\nimport Util\nimport qualified GHC.LanguageExtensions as LangExt\nimport Bag (unitBag)\n\n-- Haskell Libraries\nimport System.Console.Haskeline as Haskeline\n\nimport Control.Applicative hiding (empty)\nimport Control.DeepSeq (deepseq)\nimport Control.Monad as Monad\nimport Control.Monad.IO.Class\nimport Control.Monad.Trans.Class\nimport Control.Monad.Trans.Except\n\nimport Data.Array\nimport qualified Data.ByteString.Char8 as BS\nimport Data.Char\nimport Data.Function\nimport Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )\nimport Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,\n                   partition, sort, sortBy )\nimport qualified Data.Set as S\nimport Data.Maybe\nimport Data.Map (Map)\nimport qualified Data.Map as M\nimport Data.Time.LocalTime ( getZonedTime )\nimport Data.Time.Format ( formatTime, defaultTimeLocale )\nimport Data.Version ( showVersion )\nimport Prelude hiding ((<>))\n\nimport Exception hiding (catch)\nimport Foreign hiding (void)\nimport GHC.Stack hiding (SrcLoc(..))\n\nimport System.Directory\nimport System.Environment\nimport System.Exit ( exitWith, ExitCode(..) )\nimport System.FilePath\nimport System.Info\nimport System.IO\nimport System.IO.Error\nimport System.IO.Unsafe ( unsafePerformIO )\nimport System.Process\nimport Text.Printf\nimport Text.Read ( readMaybe )\nimport Text.Read.Lex (isSymbolChar)\n\nimport Unsafe.Coerce\n\n#if !defined(mingw32_HOST_OS)\nimport System.Posix hiding ( getEnv )\n#else\nimport qualified System.Win32\n#endif\n\nimport GHC.IO.Exception ( IOErrorType(InvalidArgument) )\nimport GHC.IO.Handle ( hFlushAll )\nimport GHC.TopHandler ( topHandler )\n\nimport GHCi.Leak\n\n-----------------------------------------------------------------------------\n\ndata GhciSettings = GhciSettings {\n        availableCommands :: [Command],\n        shortHelpText     :: String,\n        fullHelpText      :: String,\n        defPrompt         :: PromptFunction,\n        defPromptCont     :: PromptFunction\n    }\n\ndefaultGhciSettings :: GhciSettings\ndefaultGhciSettings =\n    GhciSettings {\n        availableCommands = ghciCommands,\n        shortHelpText     = defShortHelpText,\n        defPrompt         = default_prompt,\n        defPromptCont     = default_prompt_cont,\n        fullHelpText      = defFullHelpText\n    }\n\nghciWelcomeMsg :: String\nghciWelcomeMsg = \"GHCi, version \" ++ cProjectVersion ++\n                 \": https://www.haskell.org/ghc/  :? for help\"\n\nghciCommands :: [Command]\nghciCommands = map mkCmd [\n  -- Hugs users are accustomed to :e, so make sure it doesn't overlap\n  (\"?\",         keepGoing help,                 noCompletion),\n  (\"add\",       keepGoingPaths addModule,       completeFilename),\n  (\"abandon\",   keepGoing abandonCmd,           noCompletion),\n  (\"break\",     keepGoing breakCmd,             completeIdentifier),\n  (\"back\",      keepGoing backCmd,              noCompletion),\n  (\"browse\",    keepGoing' (browseCmd False),   completeModule),\n  (\"browse!\",   keepGoing' (browseCmd True),    completeModule),\n  (\"cd\",        keepGoing' changeDirectory,     completeFilename),\n  (\"check\",     keepGoing' checkModule,         completeHomeModule),\n  (\"continue\",  keepGoing continueCmd,          noCompletion),\n  (\"cmd\",       keepGoing cmdCmd,               completeExpression),\n  (\"ctags\",     keepGoing createCTagsWithLineNumbersCmd, completeFilename),\n  (\"ctags!\",    keepGoing createCTagsWithRegExesCmd, completeFilename),\n  (\"def\",       keepGoing (defineMacro False),  completeExpression),\n  (\"def!\",      keepGoing (defineMacro True),   completeExpression),\n  (\"delete\",    keepGoing deleteCmd,            noCompletion),\n  (\"doc\",       keepGoing' docCmd,              completeIdentifier),\n  (\"edit\",      keepGoing' editFile,            completeFilename),\n  (\"etags\",     keepGoing createETagsFileCmd,   completeFilename),\n  (\"force\",     keepGoing forceCmd,             completeExpression),\n  (\"forward\",   keepGoing forwardCmd,           noCompletion),\n  (\"help\",      keepGoing help,                 noCompletion),\n  (\"history\",   keepGoing historyCmd,           noCompletion),\n  (\"info\",      keepGoing' (info False),        completeIdentifier),\n  (\"info!\",     keepGoing' (info True),         completeIdentifier),\n  (\"issafe\",    keepGoing' isSafeCmd,           completeModule),\n  (\"kind\",      keepGoing' (kindOfType False),  completeIdentifier),\n  (\"kind!\",     keepGoing' (kindOfType True),   completeIdentifier),\n  (\"load\",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),\n  (\"load!\",     keepGoingPaths loadModuleDefer, completeHomeModuleOrFile),\n  (\"list\",      keepGoing' listCmd,             noCompletion),\n  (\"module\",    keepGoing moduleCmd,            completeSetModule),\n  (\"main\",      keepGoing runMain,              completeFilename),\n  (\"print\",     keepGoing printCmd,             completeExpression),\n  (\"quit\",      quit,                           noCompletion),\n  (\"reload\",    keepGoing' reloadModule,        noCompletion),\n  (\"reload!\",   keepGoing' reloadModuleDefer,   noCompletion),\n  (\"run\",       keepGoing runRun,               completeFilename),\n  (\"script\",    keepGoing' scriptCmd,           completeFilename),\n  (\"set\",       keepGoing setCmd,               completeSetOptions),\n  (\"seti\",      keepGoing setiCmd,              completeSeti),\n  (\"show\",      keepGoing showCmd,              completeShowOptions),\n  (\"showi\",     keepGoing showiCmd,             completeShowiOptions),\n  (\"sprint\",    keepGoing sprintCmd,            completeExpression),\n  (\"step\",      keepGoing stepCmd,              completeIdentifier),\n  (\"steplocal\", keepGoing stepLocalCmd,         completeIdentifier),\n  (\"stepmodule\",keepGoing stepModuleCmd,        completeIdentifier),\n  (\"type\",      keepGoing' typeOfExpr,          completeExpression),\n  (\"trace\",     keepGoing traceCmd,             completeExpression),\n  (\"unadd\",     keepGoingPaths unAddModule,     completeFilename),\n  (\"undef\",     keepGoing undefineMacro,        completeMacro),\n  (\"unset\",     keepGoing unsetOptions,         completeSetOptions),\n  (\"where\",     keepGoing whereCmd,             noCompletion)\n  ] ++ map mkCmdHidden [ -- hidden commands\n  (\"all-types\", keepGoing' allTypesCmd),\n  (\"complete\",  keepGoing completeCmd),\n  (\"loc-at\",    keepGoing' locAtCmd),\n  (\"type-at\",   keepGoing' typeAtCmd),\n  (\"uses\",      keepGoing' usesCmd)\n  ]\n where\n  mkCmd (n,a,c) = Command { cmdName = n\n                          , cmdAction = a\n                          , cmdHidden = False\n                          , cmdCompletionFunc = c\n                          }\n\n  mkCmdHidden (n,a) = Command { cmdName = n\n                              , cmdAction = a\n                              , cmdHidden = True\n                              , cmdCompletionFunc = noCompletion\n                              }\n\n-- We initialize readline (in the interactiveUI function) to use\n-- word_break_chars as the default set of completion word break characters.\n-- This can be overridden for a particular command (for example, filename\n-- expansion shouldn't consider '/' to be a word break) by setting the third\n-- entry in the Command tuple above.\n--\n-- NOTE: in order for us to override the default correctly, any custom entry\n-- must be a SUBSET of word_break_chars.\nword_break_chars :: String\nword_break_chars = spaces ++ specials ++ symbols\n\nsymbols, specials, spaces :: String\nsymbols = \"!#$%&*+/<=>?@\\\\^|-~\"\nspecials = \"(),;[]`{}\"\nspaces = \" \\t\\n\"\n\nflagWordBreakChars :: String\nflagWordBreakChars = \" \\t\\n\"\n\n\nkeepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)\nkeepGoing a str = keepGoing' (lift . a) str\n\nkeepGoing' :: Monad m => (String -> m ()) -> String -> m Bool\nkeepGoing' a str = a str >> return False\n\nkeepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi Bool)\nkeepGoingPaths a str\n = do case toArgs str of\n          Left err -> liftIO $ hPutStrLn stderr err\n          Right args -> a args\n      return False\n\ndefShortHelpText :: String\ndefShortHelpText = \"use :? for help.\\n\"\n\ndefFullHelpText :: String\ndefFullHelpText =\n  \" Commands available from the prompt:\\n\" ++\n  \"\\n\" ++\n  \"   <statement>                 evaluate/run <statement>\\n\" ++\n  \"   :                           repeat last command\\n\" ++\n  \"   :{\\\\n ..lines.. \\\\n:}\\\\n       multiline command\\n\" ++\n  \"   :add [*]<module> ...        add module(s) to the current target set\\n\" ++\n  \"   :browse[!] [[*]<mod>]       display the names defined by module <mod>\\n\" ++\n  \"                               (!: more details; *: all top-level names)\\n\" ++\n  \"   :cd <dir>                   change directory to <dir>\\n\" ++\n  \"   :cmd <expr>                 run the commands returned by <expr>::IO String\\n\" ++\n  \"   :complete <dom> [<rng>] <s> list completions for partial input string\\n\" ++\n  \"   :ctags[!] [<file>]          create tags file <file> for Vi (default: \\\"tags\\\")\\n\" ++\n  \"                               (!: use regex instead of line number)\\n\" ++\n  \"   :def <cmd> <expr>           define command :<cmd> (later defined command has\\n\" ++\n  \"                               precedence, ::<cmd> is always a builtin command)\\n\" ++\n  \"   :doc <name>                 display docs for the given name (experimental)\\n\" ++\n  \"   :edit <file>                edit file\\n\" ++\n  \"   :edit                       edit last module\\n\" ++\n  \"   :etags [<file>]             create tags file <file> for Emacs (default: \\\"TAGS\\\")\\n\" ++\n  \"   :help, :?                   display this list of commands\\n\" ++\n  \"   :info[!] [<name> ...]       display information about the given names\\n\" ++\n  \"                               (!: do not filter instances)\\n\" ++\n  \"   :issafe [<mod>]             display safe haskell information of module <mod>\\n\" ++\n  \"   :kind[!] <type>             show the kind of <type>\\n\" ++\n  \"                               (!: also print the normalised type)\\n\" ++\n  \"   :load[!] [*]<module> ...    load module(s) and their dependents\\n\" ++\n  \"                               (!: defer type errors)\\n\" ++\n  \"   :main [<arguments> ...]     run the main function with the given arguments\\n\" ++\n  \"   :module [+/-] [*]<mod> ...  set the context for expression evaluation\\n\" ++\n  \"   :quit                       exit GHCi\\n\" ++\n  \"   :reload[!]                  reload the current module set\\n\" ++\n  \"                               (!: defer type errors)\\n\" ++\n  \"   :run function [<arguments> ...] run the function with the given arguments\\n\" ++\n  \"   :script <file>              run the script <file>\\n\" ++\n  \"   :type <expr>                show the type of <expr>\\n\" ++\n  \"   :type +d <expr>             show the type of <expr>, defaulting type variables\\n\" ++\n  \"   :type +v <expr>             show the type of <expr>, with its specified tyvars\\n\" ++\n  \"   :unadd <module> ...         remove module(s) from the current target set\\n\" ++\n  \"   :undef <cmd>                undefine user-defined command :<cmd>\\n\" ++\n  \"   :!<command>                 run the shell command <command>\\n\" ++\n  \"\\n\" ++\n  \" -- Commands for debugging:\\n\" ++\n  \"\\n\" ++\n  \"   :abandon                    at a breakpoint, abandon current computation\\n\" ++\n  \"   :back [<n>]                 go back in the history N steps (after :trace)\\n\" ++\n  \"   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\\n\" ++\n  \"   :break <name>               set a breakpoint on the specified function\\n\" ++\n  \"   :continue                   resume after a breakpoint\\n\" ++\n  \"   :delete <number>            delete the specified breakpoint\\n\" ++\n  \"   :delete *                   delete all breakpoints\\n\" ++\n  \"   :force <expr>               print <expr>, forcing unevaluated parts\\n\" ++\n  \"   :forward [<n>]              go forward in the history N step s(after :back)\\n\" ++\n  \"   :history [<n>]              after :trace, show the execution history\\n\" ++\n  \"   :list                       show the source code around current breakpoint\\n\" ++\n  \"   :list <identifier>          show the source code for <identifier>\\n\" ++\n  \"   :list [<module>] <line>     show the source code around line number <line>\\n\" ++\n  \"   :print [<name> ...]         show a value without forcing its computation\\n\" ++\n  \"   :sprint [<name> ...]        simplified version of :print\\n\" ++\n  \"   :step                       single-step after stopping at a breakpoint\\n\"++\n  \"   :step <expr>                single-step into <expr>\\n\"++\n  \"   :steplocal                  single-step within the current top-level binding\\n\"++\n  \"   :stepmodule                 single-step restricted to the current module\\n\"++\n  \"   :trace                      trace after stopping at a breakpoint\\n\"++\n  \"   :trace <expr>               evaluate <expr> with tracing on (see :history)\\n\"++\n\n  \"\\n\" ++\n  \" -- Commands for changing settings:\\n\" ++\n  \"\\n\" ++\n  \"   :set <option> ...           set options\\n\" ++\n  \"   :seti <option> ...          set options for interactive evaluation only\\n\" ++\n  \"   :set args <arg> ...         set the arguments returned by System.getArgs\\n\" ++\n  \"   :set prog <progname>        set the value returned by System.getProgName\\n\" ++\n  \"   :set prompt <prompt>        set the prompt used in GHCi\\n\" ++\n  \"   :set prompt-cont <prompt>   set the continuation prompt used in GHCi\\n\" ++\n  \"   :set prompt-function <expr> set the function to handle the prompt\\n\" ++\n  \"   :set prompt-cont-function <expr>\" ++\n                     \"set the function to handle the continuation prompt\\n\" ++\n  \"   :set editor <cmd>           set the command used for :edit\\n\" ++\n  \"   :set stop [<n>] <cmd>       set the command to run when a breakpoint is hit\\n\" ++\n  \"   :unset <option> ...         unset options\\n\" ++\n  \"\\n\" ++\n  \"  Options for ':set' and ':unset':\\n\" ++\n  \"\\n\" ++\n  \"    +m            allow multiline commands\\n\" ++\n  \"    +r            revert top-level expressions after each evaluation\\n\" ++\n  \"    +s            print timing/memory stats after each evaluation\\n\" ++\n  \"    +t            print type after evaluation\\n\" ++\n  \"    +c            collect type/location info after loading modules\\n\" ++\n  \"    -<flags>      most GHC command line flags can also be set here\\n\" ++\n  \"                         (eg. -v2, -XFlexibleInstances, etc.)\\n\" ++\n  \"                    for GHCi-specific flags, see User's Guide,\\n\"++\n  \"                    Flag reference, Interactive-mode options\\n\" ++\n  \"\\n\" ++\n  \" -- Commands for displaying information:\\n\" ++\n  \"\\n\" ++\n  \"   :show bindings              show the current bindings made at the prompt\\n\" ++\n  \"   :show breaks                show the active breakpoints\\n\" ++\n  \"   :show context               show the breakpoint context\\n\" ++\n  \"   :show imports               show the current imports\\n\" ++\n  \"   :show linker                show current linker state\\n\" ++\n  \"   :show modules               show the currently loaded modules\\n\" ++\n  \"   :show packages              show the currently active package flags\\n\" ++\n  \"   :show paths                 show the currently active search paths\\n\" ++\n  \"   :show language              show the currently active language flags\\n\" ++\n  \"   :show targets               show the current set of targets\\n\" ++\n  \"   :show <setting>             show value of <setting>, which is one of\\n\" ++\n  \"                                  [args, prog, editor, stop]\\n\" ++\n  \"   :showi language             show language flags for interactive evaluation\\n\" ++\n  \"\\n\"\n\nfindEditor :: IO String\nfindEditor = do\n  getEnv \"EDITOR\"\n    `catchIO` \\_ -> do\n#if defined(mingw32_HOST_OS)\n        win <- System.Win32.getWindowsDirectory\n        return (win </> \"notepad.exe\")\n#else\n        return \"\"\n#endif\n\ndefault_progname, default_stop :: String\ndefault_progname = \"<interactive>\"\ndefault_stop = \"\"\n\ndefault_prompt, default_prompt_cont :: PromptFunction\ndefault_prompt = generatePromptFunctionFromString \"%s> \"\ndefault_prompt_cont = generatePromptFunctionFromString \"%s| \"\n\ndefault_args :: [String]\ndefault_args = []\n\ninteractiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String]\n              -> Ghc ()\ninteractiveUI config srcs maybe_exprs = do\n   -- HACK! If we happen to get into an infinite loop (eg the user\n   -- types 'let x=x in x' at the prompt), then the thread will block\n   -- on a blackhole, and become unreachable during GC.  The GC will\n   -- detect that it is unreachable and send it the NonTermination\n   -- exception.  However, since the thread is unreachable, everything\n   -- it refers to might be finalized, including the standard Handles.\n   -- This sounds like a bug, but we don't have a good solution right\n   -- now.\n   _ <- liftIO $ newStablePtr stdin\n   _ <- liftIO $ newStablePtr stdout\n   _ <- liftIO $ newStablePtr stderr\n\n    -- Initialise buffering for the *interpreted* I/O system\n   (nobuffering, flush) <- initInterpBuffering\n\n   -- The initial set of DynFlags used for interactive evaluation is the same\n   -- as the global DynFlags, plus -XExtendedDefaultRules and\n   -- -XNoMonomorphismRestriction.\n   -- See note [Changing language extensions for interactive evaluation] #10857\n   dflags <- getDynFlags\n   let dflags' = (xopt_set_unlessExplSpec\n                      LangExt.ExtendedDefaultRules xopt_set)\n               . (xopt_set_unlessExplSpec\n                      LangExt.MonomorphismRestriction xopt_unset)\n               $ dflags\n   GHC.setInteractiveDynFlags dflags'\n\n   lastErrLocationsRef <- liftIO $ newIORef []\n   progDynFlags <- GHC.getProgramDynFlags\n   _ <- GHC.setProgramDynFlags $\n      -- Ensure we don't override the user's log action lest we break\n      -- -ddump-json (#14078)\n      progDynFlags { log_action = ghciLogAction (log_action progDynFlags)\n                                                lastErrLocationsRef }\n\n   when (isNothing maybe_exprs) $ do\n        -- Only for GHCi (not runghc and ghc -e):\n\n        -- Turn buffering off for the compiled program's stdout/stderr\n        turnOffBuffering_ nobuffering\n        -- Turn buffering off for GHCi's stdout\n        liftIO $ hFlush stdout\n        liftIO $ hSetBuffering stdout NoBuffering\n        -- We don't want the cmd line to buffer any input that might be\n        -- intended for the program, so unbuffer stdin.\n        liftIO $ hSetBuffering stdin NoBuffering\n        liftIO $ hSetBuffering stderr NoBuffering\n#if defined(mingw32_HOST_OS)\n        -- On Unix, stdin will use the locale encoding.  The IO library\n        -- doesn't do this on Windows (yet), so for now we use UTF-8,\n        -- for consistency with GHC 6.10 and to make the tests work.\n        liftIO $ hSetEncoding stdin utf8\n#endif\n\n   default_editor <- liftIO $ findEditor\n   eval_wrapper <- mkEvalWrapper default_progname default_args\n   let prelude_import = simpleImportDecl preludeModuleName\n   startGHCi (runGHCi srcs maybe_exprs)\n        GHCiState{ progname           = default_progname,\n                   args               = default_args,\n                   evalWrapper        = eval_wrapper,\n                   prompt             = defPrompt config,\n                   prompt_cont        = defPromptCont config,\n                   stop               = default_stop,\n                   editor             = default_editor,\n                   options            = [],\n                   -- We initialize line number as 0, not 1, because we use\n                   -- current line number while reporting errors which is\n                   -- incremented after reading a line.\n                   line_number        = 0,\n                   break_ctr          = 0,\n                   breaks             = [],\n                   tickarrays         = emptyModuleEnv,\n                   ghci_commands      = availableCommands config,\n                   ghci_macros        = [],\n                   last_command       = Nothing,\n                   cmd_wrapper        = (cmdSuccess =<<),\n                   cmdqueue           = [],\n                   remembered_ctx     = [],\n                   transient_ctx      = [],\n                   extra_imports      = [],\n                   prelude_imports    = [prelude_import],\n                   ghc_e              = isJust maybe_exprs,\n                   short_help         = shortHelpText config,\n                   long_help          = fullHelpText config,\n                   lastErrorLocations = lastErrLocationsRef,\n                   mod_infos          = M.empty,\n                   flushStdHandles    = flush,\n                   noBuffering        = nobuffering\n                 }\n\n   return ()\n\n{-\nNote [Changing language extensions for interactive evaluation]\n--------------------------------------------------------------\nGHCi maintains two sets of options:\n\n- The \"loading options\" apply when loading modules\n- The \"interactive options\" apply when evaluating expressions and commands\n    typed at the GHCi prompt.\n\nThe loading options are mostly created in ghc/Main.hs:main' from the command\nline flags. In the function ghc/GHCi/UI.hs:interactiveUI the loading options\nare copied to the interactive options.\n\nThese interactive options (but not the loading options!) are supplemented\nunconditionally by setting ExtendedDefaultRules ON and\nMonomorphismRestriction OFF. The unconditional setting of these options\neventually overwrite settings already specified at the command line.\n\nTherefore instead of unconditionally setting ExtendedDefaultRules and\nNoMonomorphismRestriction for the interactive options, we use the function\n'xopt_set_unlessExplSpec' to first check whether the extension has already\nspecified at the command line.\n\nThe ghci config file has not yet been processed.\n-}\n\nresetLastErrorLocations :: GhciMonad m => m ()\nresetLastErrorLocations = do\n    st <- getGHCiState\n    liftIO $ writeIORef (lastErrorLocations st) []\n\nghciLogAction :: LogAction -> IORef [(FastString, Int)] ->  LogAction\nghciLogAction old_log_action lastErrLocations\n              dflags flag severity srcSpan style msg = do\n    old_log_action dflags flag severity srcSpan style msg\n    case severity of\n        SevError -> case srcSpan of\n            RealSrcSpan rsp -> modifyIORef lastErrLocations\n                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])\n            _ -> return ()\n        _ -> return ()\n\nwithGhcAppData :: (FilePath -> IO a) -> IO a -> IO a\nwithGhcAppData right left = do\n    either_dir <- tryIO (getAppUserDataDirectory \"ghc\")\n    case either_dir of\n        Right dir ->\n            do createDirectoryIfMissing False dir `catchIO` \\_ -> return ()\n               right dir\n        _ -> left\n\nrunGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()\nrunGHCi paths maybe_exprs = do\n  dflags <- getDynFlags\n  let\n   ignore_dot_ghci = gopt Opt_IgnoreDotGhci dflags\n\n   current_dir = return (Just \".ghci\")\n\n   app_user_dir = liftIO $ withGhcAppData\n                    (\\dir -> return (Just (dir </> \"ghci.conf\")))\n                    (return Nothing)\n\n   home_dir = do\n    either_dir <- liftIO $ tryIO (getEnv \"HOME\")\n    case either_dir of\n      Right home -> return (Just (home </> \".ghci\"))\n      _ -> return Nothing\n\n   canonicalizePath' :: FilePath -> IO (Maybe FilePath)\n   canonicalizePath' fp = liftM Just (canonicalizePath fp)\n                `catchIO` \\_ -> return Nothing\n\n   sourceConfigFile :: FilePath -> GHCi ()\n   sourceConfigFile file = do\n     exists <- liftIO $ doesFileExist file\n     when exists $ do\n       either_hdl <- liftIO $ tryIO (openFile file ReadMode)\n       case either_hdl of\n         Left _e   -> return ()\n         -- NOTE: this assumes that runInputT won't affect the terminal;\n         -- can we assume this will always be the case?\n         -- This would be a good place for runFileInputT.\n         Right hdl ->\n             do runInputTWithPrefs defaultPrefs defaultSettings $\n                          runCommands $ fileLoop hdl\n                liftIO (hClose hdl `catchIO` \\_ -> return ())\n                -- Don't print a message if this is really ghc -e (#11478).\n                -- Also, let the user silence the message with -v0\n                -- (the default verbosity in GHCi is 1).\n                when (isNothing maybe_exprs && verbosity dflags > 0) $\n                  liftIO $ putStrLn (\"Loaded GHCi configuration from \" ++ file)\n\n  --\n\n  setGHCContextFromGHCiState\n\n  dot_cfgs <- if ignore_dot_ghci then return [] else do\n    dot_files <- catMaybes <$> sequence [ current_dir, app_user_dir, home_dir ]\n    liftIO $ filterM checkFileAndDirPerms dot_files\n  mdot_cfgs <- liftIO $ mapM canonicalizePath' dot_cfgs\n\n  let arg_cfgs = reverse $ ghciScripts dflags\n    -- -ghci-script are collected in reverse order\n    -- We don't require that a script explicitly added by -ghci-script\n    -- is owned by the current user. (#6017)\n  mapM_ sourceConfigFile $ nub $ (catMaybes mdot_cfgs) ++ arg_cfgs\n    -- nub, because we don't want to read .ghci twice if the CWD is $HOME.\n\n  -- Perform a :load for files given on the GHCi command line\n  -- When in -e mode, if the load fails then we want to stop\n  -- immediately rather than going on to evaluate the expression.\n  when (not (null paths)) $ do\n     ok <- ghciHandle (\\e -> do showException e; return Failed) $\n                -- TODO: this is a hack.\n                runInputTWithPrefs defaultPrefs defaultSettings $\n                    loadModule paths\n     when (isJust maybe_exprs && failed ok) $\n        liftIO (exitWith (ExitFailure 1))\n\n  installInteractivePrint (interactivePrint dflags) (isJust maybe_exprs)\n\n  -- if verbosity is greater than 0, or we are connected to a\n  -- terminal, display the prompt in the interactive loop.\n  is_tty <- liftIO (hIsTerminalDevice stdin)\n  let show_prompt = verbosity dflags > 0 || is_tty\n\n  -- reset line number\n  modifyGHCiState $ \\st -> st{line_number=0}\n\n  case maybe_exprs of\n        Nothing ->\n          do\n            -- enter the interactive loop\n            runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty\n        Just exprs -> do\n            -- just evaluate the expression we were given\n            enqueueCommands exprs\n            let hdle e = do st <- getGHCiState\n                            -- flush the interpreter's stdout/stderr on exit (#3890)\n                            flushInterpBuffers\n                            -- Jump through some hoops to get the\n                            -- current progname in the exception text:\n                            -- <progname>: <exception>\n                            liftIO $ withProgName (progname st)\n                                   $ topHandler e\n                                   -- this used to be topHandlerFastExit, see #2228\n            runInputTWithPrefs defaultPrefs defaultSettings $ do\n                -- make `ghc -e` exit nonzero on invalid input, see Trac #7962\n                _ <- runCommands' hdle\n                     (Just $ hdle (toException $ ExitFailure 1) >> return ())\n                     (return Nothing)\n                return ()\n\n  -- and finally, exit\n  liftIO $ when (verbosity dflags > 0) $ putStrLn \"Leaving GHCi.\"\n\nrunGHCiInput :: InputT GHCi a -> GHCi a\nrunGHCiInput f = do\n    dflags <- getDynFlags\n    let ghciHistory = gopt Opt_GhciHistory dflags\n    let localGhciHistory = gopt Opt_LocalGhciHistory dflags\n    currentDirectory <- liftIO $ getCurrentDirectory\n\n    histFile <- case (ghciHistory, localGhciHistory) of\n      (True, True) -> return (Just (currentDirectory </> \".ghci_history\"))\n      (True, _) -> liftIO $ withGhcAppData\n        (\\dir -> return (Just (dir </> \"ghci_history\"))) (return Nothing)\n      _ -> return Nothing\n\n    runInputT\n        (setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile})\n        f\n\n-- | How to get the next input line from the user\nnextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)\nnextInputLine show_prompt is_tty\n  | is_tty = do\n    prmpt <- if show_prompt then lift mkPrompt else return \"\"\n    r <- getInputLine prmpt\n    incrementLineNo\n    return r\n  | otherwise = do\n    when show_prompt $ lift mkPrompt >>= liftIO . putStr\n    fileLoop stdin\n\n-- NOTE: We only read .ghci files if they are owned by the current user,\n-- and aren't world writable (files owned by root are ok, see #9324).\n-- Otherwise, we could be accidentally running code planted by\n-- a malicious third party.\n\n-- Furthermore, We only read ./.ghci if . is owned by the current user\n-- and isn't writable by anyone else.  I think this is sufficient: we\n-- don't need to check .. and ../.. etc. because \".\"  always refers to\n-- the same directory while a process is running.\n\ncheckFileAndDirPerms :: FilePath -> IO Bool\ncheckFileAndDirPerms file = do\n  file_ok <- checkPerms file\n  -- Do not check dir perms when .ghci doesn't exist, otherwise GHCi will\n  -- print some confusing and useless warnings in some cases (e.g. in\n  -- travis). Note that we can't add a test for this, as all ghci tests should\n  -- run with -ignore-dot-ghci, which means we never get here.\n  if file_ok then checkPerms (getDirectory file) else return False\n  where\n  getDirectory f = case takeDirectory f of\n    \"\" -> \".\"\n    d -> d\n\ncheckPerms :: FilePath -> IO Bool\n#if defined(mingw32_HOST_OS)\ncheckPerms _ = return True\n#else\ncheckPerms file =\n  handleIO (\\_ -> return False) $ do\n    st <- getFileStatus file\n    me <- getRealUserID\n    let mode = System.Posix.fileMode st\n        ok = (fileOwner st == me || fileOwner st == 0) &&\n             groupWriteMode /= mode `intersectFileModes` groupWriteMode &&\n             otherWriteMode /= mode `intersectFileModes` otherWriteMode\n    unless ok $\n      -- #8248: Improving warning to include a possible fix.\n      putStrLn $ \"*** WARNING: \" ++ file ++\n                 \" is writable by someone else, IGNORING!\" ++\n                 \"\\nSuggested fix: execute 'chmod go-w \" ++ file ++ \"'\"\n    return ok\n#endif\n\nincrementLineNo :: GhciMonad m => m ()\nincrementLineNo = modifyGHCiState incLineNo\n  where\n    incLineNo st = st { line_number = line_number st + 1 }\n\nfileLoop :: GhciMonad m => Handle -> m (Maybe String)\nfileLoop hdl = do\n   l <- liftIO $ tryIO $ hGetLine hdl\n   case l of\n        Left e | isEOFError e              -> return Nothing\n               | -- as we share stdin with the program, the program\n                 -- might have already closed it, so we might get a\n                 -- handle-closed exception. We therefore catch that\n                 -- too.\n                 isIllegalOperation e      -> return Nothing\n               | InvalidArgument <- etype  -> return Nothing\n               | otherwise                 -> liftIO $ ioError e\n                where etype = ioeGetErrorType e\n                -- treat InvalidArgument in the same way as EOF:\n                -- this can happen if the user closed stdin, or\n                -- perhaps did getContents which closes stdin at\n                -- EOF.\n        Right l' -> do\n           incrementLineNo\n           return (Just l')\n\nformatCurrentTime :: String -> IO String\nformatCurrentTime format =\n  getZonedTime >>= return . (formatTime defaultTimeLocale format)\n\ngetUserName :: IO String\ngetUserName = do\n#if defined(mingw32_HOST_OS)\n  getEnv \"USERNAME\"\n    `catchIO` \\e -> do\n      putStrLn $ show e\n      return \"\"\n#else\n  getLoginName\n#endif\n\ngetInfoForPrompt :: GhciMonad m => m (SDoc, [String], Int)\ngetInfoForPrompt = do\n  st <- getGHCiState\n  imports <- GHC.getContext\n  resumes <- GHC.getResumeContext\n\n  context_bit <-\n        case resumes of\n            [] -> return empty\n            r:_ -> do\n                let ix = GHC.resumeHistoryIx r\n                if ix == 0\n                   then return (brackets (ppr (GHC.resumeSpan r)) <> space)\n                   else do\n                        let hist = GHC.resumeHistory r !! (ix-1)\n                        pan <- GHC.getHistorySpan hist\n                        return (brackets (ppr (negate ix) <> char ':'\n                                          <+> ppr pan) <> space)\n\n  let\n        dots | _:rs <- resumes, not (null rs) = text \"... \"\n             | otherwise = empty\n\n        rev_imports = reverse imports -- rightmost are the most recent\n\n        myIdeclName d | Just m <- ideclAs d = unLoc m\n                      | otherwise           = unLoc (ideclName d)\n\n        modules_names =\n             ['*':(moduleNameString m) | IIModule m <- rev_imports] ++\n             [moduleNameString (myIdeclName d) | IIDecl d <- rev_imports]\n        line = 1 + line_number st\n\n  return (dots <> context_bit, modules_names, line)\n\nparseCallEscape :: String -> (String, String)\nparseCallEscape s\n  | not (all isSpace beforeOpen) = (\"\", \"\")\n  | null sinceOpen               = (\"\", \"\")\n  | null sinceClosed             = (\"\", \"\")\n  | null cmd                     = (\"\", \"\")\n  | otherwise                    = (cmd, tail sinceClosed)\n  where\n    (beforeOpen, sinceOpen) = span (/='(') s\n    (cmd, sinceClosed) = span (/=')') (tail sinceOpen)\n\ncheckPromptStringForErrors :: String -> Maybe String\ncheckPromptStringForErrors ('%':'c':'a':'l':'l':xs) =\n  case parseCallEscape xs of\n    (\"\", \"\") -> Just (\"Incorrect %call syntax. \" ++\n                      \"Should be %call(a command and arguments).\")\n    (_, afterClosed) -> checkPromptStringForErrors afterClosed\ncheckPromptStringForErrors ('%':'%':xs) = checkPromptStringForErrors xs\ncheckPromptStringForErrors (_:xs) = checkPromptStringForErrors xs\ncheckPromptStringForErrors \"\" = Nothing\n\ngeneratePromptFunctionFromString :: String -> PromptFunction\ngeneratePromptFunctionFromString promptS modules_names line =\n        processString promptS\n  where\n        processString :: String -> GHCi SDoc\n        processString ('%':'s':xs) =\n            liftM2 (<>) (return modules_list) (processString xs)\n            where\n              modules_list = hsep $ map text modules_names\n        processString ('%':'l':xs) =\n            liftM2 (<>) (return $ ppr line) (processString xs)\n        processString ('%':'d':xs) =\n            liftM2 (<>) (liftM text formatted_time) (processString xs)\n            where\n              formatted_time = liftIO $ formatCurrentTime \"%a %b %d\"\n        processString ('%':'t':xs) =\n            liftM2 (<>) (liftM text formatted_time) (processString xs)\n            where\n              formatted_time = liftIO $ formatCurrentTime \"%H:%M:%S\"\n        processString ('%':'T':xs) = do\n            liftM2 (<>) (liftM text formatted_time) (processString xs)\n            where\n              formatted_time = liftIO $ formatCurrentTime \"%I:%M:%S\"\n        processString ('%':'@':xs) = do\n            liftM2 (<>) (liftM text formatted_time) (processString xs)\n            where\n              formatted_time = liftIO $ formatCurrentTime \"%I:%M %P\"\n        processString ('%':'A':xs) = do\n            liftM2 (<>) (liftM text formatted_time) (processString xs)\n            where\n              formatted_time = liftIO $ formatCurrentTime \"%H:%M\"\n        processString ('%':'u':xs) =\n            liftM2 (<>) (liftM text user_name) (processString xs)\n            where\n              user_name = liftIO $ getUserName\n        processString ('%':'w':xs) =\n            liftM2 (<>) (liftM text current_directory) (processString xs)\n            where\n              current_directory = liftIO $ getCurrentDirectory\n        processString ('%':'o':xs) =\n            liftM ((text os) <>) (processString xs)\n        processString ('%':'a':xs) =\n            liftM ((text arch) <>) (processString xs)\n        processString ('%':'N':xs) =\n            liftM ((text compilerName) <>) (processString xs)\n        processString ('%':'V':xs) =\n            liftM ((text $ showVersion compilerVersion) <>) (processString xs)\n        processString ('%':'c':'a':'l':'l':xs) = do\n            respond <- liftIO $ do\n                (code, out, err) <-\n                    readProcessWithExitCode\n                    (head list_words) (tail list_words) \"\"\n                    `catchIO` \\e -> return (ExitFailure 1, \"\", show e)\n                case code of\n                    ExitSuccess -> return out\n                    _ -> do\n                        hPutStrLn stderr err\n                        return \"\"\n            liftM ((text respond) <>) (processString afterClosed)\n            where\n              (cmd, afterClosed) = parseCallEscape xs\n              list_words = words cmd\n        processString ('%':'%':xs) =\n            liftM ((char '%') <>) (processString xs)\n        processString (x:xs) =\n            liftM (char x <>) (processString xs)\n        processString \"\" =\n            return empty\n\nmkPrompt :: GHCi String\nmkPrompt = do\n  st <- getGHCiState\n  dflags <- getDynFlags\n  (context, modules_names, line) <- getInfoForPrompt\n\n  prompt_string <- (prompt st) modules_names line\n  let prompt_doc = context <> prompt_string\n\n  return (showSDoc dflags prompt_doc)\n\nqueryQueue :: GhciMonad m => m (Maybe String)\nqueryQueue = do\n  st <- getGHCiState\n  case cmdqueue st of\n    []   -> return Nothing\n    c:cs -> do setGHCiState st{ cmdqueue = cs }\n               return (Just c)\n\n-- Reconfigurable pretty-printing Ticket #5461\ninstallInteractivePrint :: GHC.GhcMonad m => Maybe String -> Bool -> m ()\ninstallInteractivePrint Nothing _  = return ()\ninstallInteractivePrint (Just ipFun) exprmode = do\n  ok <- trySuccess $ do\n                names <- GHC.parseName ipFun\n                let name = case names of\n                             name':_ -> name'\n                             [] -> panic \"installInteractivePrint\"\n                modifySession (\\he -> let new_ic = setInteractivePrintName (hsc_IC he) name\n                                      in he{hsc_IC = new_ic})\n                return Succeeded\n\n  when (failed ok && exprmode) $ liftIO (exitWith (ExitFailure 1))\n\n-- | The main read-eval-print loop\nrunCommands :: InputT GHCi (Maybe String) -> InputT GHCi ()\nrunCommands gCmd = runCommands' handler Nothing gCmd >> return ()\n\nrunCommands' :: (SomeException -> GHCi Bool) -- ^ Exception handler\n             -> Maybe (GHCi ()) -- ^ Source error handler\n             -> InputT GHCi (Maybe String)\n             -> InputT GHCi (Maybe Bool)\n         -- We want to return () here, but have to return (Maybe Bool)\n         -- because gmask is not polymorphic enough: we want to use\n         -- unmask at two different types.\nrunCommands' eh sourceErrorHandler gCmd = gmask $ \\unmask -> do\n    b <- ghandle (\\e -> case fromException e of\n                          Just UserInterrupt -> return $ Just False\n                          _ -> case fromException e of\n                                 Just ghce ->\n                                   do liftIO (print (ghce :: GhcException))\n                                      return Nothing\n                                 _other ->\n                                   liftIO (Exception.throwIO e))\n            (unmask $ runOneCommand eh gCmd)\n    case b of\n      Nothing -> return Nothing\n      Just success -> do\n        unless success $ maybe (return ()) lift sourceErrorHandler\n        unmask $ runCommands' eh sourceErrorHandler gCmd\n\n-- | Evaluate a single line of user input (either :<command> or Haskell code).\n-- A result of Nothing means there was no more input to process.\n-- Otherwise the result is Just b where b is True if the command succeeded;\n-- this is relevant only to ghc -e, which will exit with status 1\n-- if the command was unsuccessful. GHCi will continue in either case.\nrunOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String)\n            -> InputT GHCi (Maybe Bool)\nrunOneCommand eh gCmd = do\n  -- run a previously queued command if there is one, otherwise get new\n  -- input from user\n  mb_cmd0 <- noSpace (lift queryQueue)\n  mb_cmd1 <- maybe (noSpace gCmd) (return . Just) mb_cmd0\n  case mb_cmd1 of\n    Nothing -> return Nothing\n    Just c  -> do\n      st <- getGHCiState\n      ghciHandle (\\e -> lift $ eh e >>= return . Just) $\n        handleSourceError printErrorAndFail $\n          cmd_wrapper st $ doCommand c\n               -- source error's are handled by runStmt\n               -- is the handler necessary here?\n  where\n    printErrorAndFail err = do\n        GHC.printException err\n        return $ Just False     -- Exit ghc -e, but not GHCi\n\n    noSpace q = q >>= maybe (return Nothing)\n                            (\\c -> case removeSpaces c of\n                                     \"\"   -> noSpace q\n                                     \":{\" -> multiLineCmd q\n                                     _    -> return (Just c) )\n    multiLineCmd q = do\n      st <- getGHCiState\n      let p = prompt st\n      setGHCiState st{ prompt = prompt_cont st }\n      mb_cmd <- collectCommand q \"\" `GHC.gfinally`\n                modifyGHCiState (\\st' -> st' { prompt = p })\n      return mb_cmd\n    -- we can't use removeSpaces for the sublines here, so\n    -- multiline commands are somewhat more brittle against\n    -- fileformat errors (such as \\r in dos input on unix),\n    -- we get rid of any extra spaces for the \":}\" test;\n    -- we also avoid silent failure if \":}\" is not found;\n    -- and since there is no (?) valid occurrence of \\r (as\n    -- opposed to its String representation, \"\\r\") inside a\n    -- ghci command, we replace any such with ' ' (argh:-(\n    collectCommand q c = q >>=\n      maybe (liftIO (ioError collectError))\n            (\\l->if removeSpaces l == \":}\"\n                 then return (Just c)\n                 else collectCommand q (c ++ \"\\n\" ++ map normSpace l))\n      where normSpace '\\r' = ' '\n            normSpace   x  = x\n    -- SDM (2007-11-07): is userError the one to use here?\n    collectError = userError \"unterminated multiline command :{ .. :}\"\n\n    -- | Handle a line of input\n    doCommand :: String -> InputT GHCi CommandResult\n\n    -- command\n    doCommand stmt | stmt'@(':' : cmd) <- removeSpaces stmt = do\n      (stats, result) <- runWithStats (const Nothing) $ specialCommand cmd\n      let processResult True = Nothing\n          processResult False = Just True\n      return $ CommandComplete stmt' (processResult <$> result) stats\n\n    -- haskell\n    doCommand stmt = do\n      -- if 'stmt' was entered via ':{' it will contain '\\n's\n      let stmt_nl_cnt = length [ () | '\\n' <- stmt ]\n      ml <- lift $ isOptionSet Multiline\n      if ml && stmt_nl_cnt == 0 -- don't trigger automatic multi-line mode for ':{'-multiline input\n        then do\n          fst_line_num <- line_number <$> getGHCiState\n          mb_stmt <- checkInputForLayout stmt gCmd\n          case mb_stmt of\n            Nothing -> return CommandIncomplete\n            Just ml_stmt -> do\n              -- temporarily compensate line-number for multi-line input\n              (stats, result) <- runAndPrintStats runAllocs $ lift $\n                runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion\n              return $\n                CommandComplete ml_stmt (Just . runSuccess <$> result) stats\n        else do -- single line input and :{ - multiline input\n          last_line_num <- line_number <$> getGHCiState\n          -- reconstruct first line num from last line num and stmt\n          let fst_line_num | stmt_nl_cnt > 0 = last_line_num - (stmt_nl_cnt2 + 1)\n                           | otherwise = last_line_num -- single line input\n              stmt_nl_cnt2 = length [ () | '\\n' <- stmt' ]\n              stmt' = dropLeadingWhiteLines stmt -- runStmt doesn't like leading empty lines\n          -- temporarily compensate line-number for multi-line input\n          (stats, result) <- runAndPrintStats runAllocs $ lift $\n            runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion\n          return $ CommandComplete stmt' (Just . runSuccess <$> result) stats\n\n    -- runStmt wrapper for temporarily overridden line-number\n    runStmtWithLineNum :: Int -> String -> SingleStep\n                       -> GHCi (Maybe GHC.ExecResult)\n    runStmtWithLineNum lnum stmt step = do\n        st0 <- getGHCiState\n        setGHCiState st0 { line_number = lnum }\n        result <- runStmt stmt step\n        -- restore original line_number\n        getGHCiState >>= \\st -> setGHCiState st { line_number = line_number st0 }\n        return result\n\n    -- note: this is subtly different from 'unlines . dropWhile (all isSpace) . lines'\n    dropLeadingWhiteLines s | (l0,'\\n':r) <- break (=='\\n') s\n                            , all isSpace l0 = dropLeadingWhiteLines r\n                            | otherwise = s\n\n\n-- #4316\n-- lex the input.  If there is an unclosed layout context, request input\ncheckInputForLayout\n  :: GhciMonad m => String -> m (Maybe String) -> m (Maybe String)\ncheckInputForLayout stmt getStmt = do\n   dflags' <- getDynFlags\n   let dflags = xopt_set dflags' LangExt.AlternativeLayoutRule\n   st0 <- getGHCiState\n   let buf'   =  stringToStringBuffer stmt\n       loc    = mkRealSrcLoc (fsLit (progname st0)) (line_number st0) 1\n       pstate = Lexer.mkPState dflags buf' loc\n   case Lexer.unP goToEnd pstate of\n     (Lexer.POk _ False) -> return $ Just stmt\n     _other              -> do\n       st1 <- getGHCiState\n       let p = prompt st1\n       setGHCiState st1{ prompt = prompt_cont st1 }\n       mb_stmt <- ghciHandle (\\ex -> case fromException ex of\n                            Just UserInterrupt -> return Nothing\n                            _ -> case fromException ex of\n                                 Just ghce ->\n                                   do liftIO (print (ghce :: GhcException))\n                                      return Nothing\n                                 _other -> liftIO (Exception.throwIO ex))\n                     getStmt\n       modifyGHCiState (\\st' -> st' { prompt = p })\n       -- the recursive call does not recycle parser state\n       -- as we use a new string buffer\n       case mb_stmt of\n         Nothing  -> return Nothing\n         Just str -> if str == \"\"\n           then return $ Just stmt\n           else do\n             checkInputForLayout (stmt++\"\\n\"++str) getStmt\n     where goToEnd = do\n             eof <- Lexer.nextIsEOF\n             if eof\n               then Lexer.activeContext\n               else Lexer.lexer False return >> goToEnd\n\nenqueueCommands :: GhciMonad m => [String] -> m ()\nenqueueCommands cmds = do\n  -- make sure we force any exceptions in the commands while we're\n  -- still inside the exception handler, otherwise bad things will\n  -- happen (see #10501)\n  cmds `deepseq` return ()\n  modifyGHCiState $ \\st -> st{ cmdqueue = cmds ++ cmdqueue st }\n\n-- | Entry point to execute some haskell code from user.\n-- The return value True indicates success, as in `runOneCommand`.\nrunStmt :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult)\nrunStmt input step = do\n  dflags <- GHC.getInteractiveDynFlags\n  -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`\n  -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The\n  -- declarations and statements are not affected.\n  -- See Note [Deferred type errors in GHCi] in typecheck/TcRnDriver.hs\n  st <- getGHCiState\n  let source = progname st\n  let line = line_number st\n\n  if | GHC.isStmt dflags input -> do\n         hsc_env <- GHC.getSession\n         mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input))\n         case mb_stmt of\n           Nothing ->\n             -- empty statement / comment\n             return (Just exec_complete)\n           Just stmt ->\n             run_stmt stmt\n\n     | GHC.isImport dflags input -> run_import\n\n     -- Every import declaration should be handled by `run_import`. As GHCi\n     -- in general only accepts one command at a time, we simply throw an\n     -- exception when the input contains multiple commands of which at least\n     -- one is an import command (see #10663).\n     | GHC.hasImport dflags input -> throwGhcException\n       (CmdLineError \"error: expecting a single import declaration\")\n\n     -- Otherwise assume a declaration (or a list of declarations)\n     -- Note: `GHC.isDecl` returns False on input like\n     -- `data Infix a b = a :@: b; infixl 4 :@:`\n     -- and should therefore not be used here.\n     | otherwise -> do\n         hsc_env <- GHC.getSession\n         decls <- liftIO (hscParseDeclsWithLocation hsc_env source line input)\n         run_decls decls\n  where\n    exec_complete = GHC.ExecComplete (Right []) 0\n\n    run_import = do\n      addImportToContext input\n      return (Just exec_complete)\n\n    run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult)\n    run_stmt stmt = do\n           m_result <- GhciMonad.runStmt stmt input step\n           case m_result of\n               Nothing     -> return Nothing\n               Just result -> Just <$> afterRunStmt (const True) result\n\n    -- `x = y` (a declaration) should be treated as `let x = y` (a statement).\n    -- The reason is because GHCi wasn't designed to support `x = y`, but then\n    -- b98ff3 (#7253) added support for it, except it did not do a good job and\n    -- caused problems like:\n    --\n    --  - not adding the binders defined this way in the necessary places caused\n    --    `x = y` to not work in some cases (#12091).\n    --  - some GHCi command crashed after `x = y` (#15721)\n    --  - warning generation did not work for `x = y` (#11606)\n    --  - because `x = y` is a declaration (instead of a statement) differences\n    --    in generated code caused confusion (#16089)\n    --\n    -- Instead of dealing with all these problems individually here we fix this\n    -- mess by just treating `x = y` as `let x = y`.\n    run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult)\n    -- Only turn `FunBind` and `VarBind` into statements, other bindings\n    -- (e.g. `PatBind`) need to stay as decls.\n    run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt l bind)\n    run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt l bind)\n    -- Note that any `x = y` declarations below will be run as declarations\n    -- instead of statements (e.g. `...; x = y; ...`)\n    run_decls decls = do\n      -- In the new IO library, read handles buffer data even if the Handle\n      -- is set to NoBuffering.  This causes problems for GHCi where there\n      -- are really two stdin Handles.  So we flush any bufferred data in\n      -- GHCi's stdin Handle here (only relevant if stdin is attached to\n      -- a file, otherwise the read buffer can't be flushed).\n      _ <- liftIO $ tryIO $ hFlushAll stdin\n      m_result <- GhciMonad.runDecls' decls\n      forM m_result $ \\result ->\n        afterRunStmt (const True) (GHC.ExecComplete (Right result) 0)\n\n    mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs\n    mk_stmt loc bind =\n      let l = L loc\n      in l (LetStmt noExt (l (HsValBinds noExt (ValBinds noExt (unitBag (l bind)) []))))\n\n-- | Clean up the GHCi environment after a statement has run\nafterRunStmt :: GhciMonad m\n             => (SrcSpan -> Bool) -> GHC.ExecResult -> m GHC.ExecResult\nafterRunStmt step_here run_result = do\n  resumes <- GHC.getResumeContext\n  case run_result of\n     GHC.ExecComplete{..} ->\n       case execResult of\n          Left ex -> liftIO $ Exception.throwIO ex\n          Right names -> do\n            show_types <- isOptionSet ShowType\n            when show_types $ printTypeOfNames names\n     GHC.ExecBreak names mb_info\n         | isNothing  mb_info ||\n           step_here (GHC.resumeSpan $ head resumes) -> do\n               mb_id_loc <- toBreakIdAndLocation mb_info\n               let bCmd = maybe \"\" ( \\(_,l) -> onBreakCmd l ) mb_id_loc\n               if (null bCmd)\n                 then printStoppedAtBreakInfo (head resumes) names\n                 else enqueueCommands [bCmd]\n               -- run the command set with \":set stop <cmd>\"\n               st <- getGHCiState\n               enqueueCommands [stop st]\n               return ()\n         | otherwise -> resume step_here GHC.SingleStep >>=\n                        afterRunStmt step_here >> return ()\n\n  flushInterpBuffers\n  withSignalHandlers $ do\n     b <- isOptionSet RevertCAFs\n     when b revertCAFs\n\n  return run_result\n\nrunSuccess :: Maybe GHC.ExecResult -> Bool\nrunSuccess run_result\n  | Just (GHC.ExecComplete { execResult = Right _ }) <- run_result = True\n  | otherwise = False\n\nrunAllocs :: Maybe GHC.ExecResult -> Maybe Integer\nrunAllocs m = do\n  res <- m\n  case res of\n    GHC.ExecComplete{..} -> Just (fromIntegral execAllocation)\n    _ -> Nothing\n\ntoBreakIdAndLocation :: GhciMonad m\n                     => Maybe GHC.BreakInfo -> m (Maybe (Int, BreakLocation))\ntoBreakIdAndLocation Nothing = return Nothing\ntoBreakIdAndLocation (Just inf) = do\n  let md = GHC.breakInfo_module inf\n      nm = GHC.breakInfo_number inf\n  st <- getGHCiState\n  return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st,\n                                  breakModule loc == md,\n                                  breakTick loc == nm ]\n\nprintStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()\nprintStoppedAtBreakInfo res names = do\n  printForUser $ pprStopped res\n  --  printTypeOfNames session names\n  let namesSorted = sortBy compareNames names\n  tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted\n  docs <- mapM pprTypeAndContents [i | AnId i <- tythings]\n  printForUserPartWay $ vcat docs\n\nprintTypeOfNames :: GHC.GhcMonad m => [Name] -> m ()\nprintTypeOfNames names\n = mapM_ (printTypeOfName ) $ sortBy compareNames names\n\ncompareNames :: Name -> Name -> Ordering\nn1 `compareNames` n2 = compareWith n1 `compare` compareWith n2\n    where compareWith n = (getOccString n, getSrcSpan n)\n\nprintTypeOfName :: GHC.GhcMonad m => Name -> m ()\nprintTypeOfName n\n   = do maybe_tything <- GHC.lookupName n\n        case maybe_tything of\n            Nothing    -> return ()\n            Just thing -> printTyThing thing\n\n\ndata MaybeCommand = GotCommand Command | BadCommand | NoLastCommand\n\n-- | Entry point for execution a ':<command>' input from user\nspecialCommand :: String -> InputT GHCi Bool\nspecialCommand ('!':str) = lift $ shellEscape (dropWhile isSpace str)\nspecialCommand str = do\n  let (cmd,rest) = break isSpace str\n  maybe_cmd <- lookupCommand cmd\n  htxt <- short_help <$> getGHCiState\n  case maybe_cmd of\n    GotCommand cmd -> (cmdAction cmd) (dropWhile isSpace rest)\n    BadCommand ->\n      do liftIO $ hPutStr stdout (\"unknown command ':\" ++ cmd ++ \"'\\n\"\n                           ++ htxt)\n         return False\n    NoLastCommand ->\n      do liftIO $ hPutStr stdout (\"there is no last command to perform\\n\"\n                           ++ htxt)\n         return False\n\nshellEscape :: MonadIO m => String -> m Bool\nshellEscape str = liftIO (system str >> return False)\n\nlookupCommand :: GhciMonad m => String -> m (MaybeCommand)\nlookupCommand \"\" = do\n  st <- getGHCiState\n  case last_command st of\n      Just c -> return $ GotCommand c\n      Nothing -> return NoLastCommand\nlookupCommand str = do\n  mc <- lookupCommand' str\n  modifyGHCiState (\\st -> st { last_command = mc })\n  return $ case mc of\n           Just c -> GotCommand c\n           Nothing -> BadCommand\n\nlookupCommand' :: GhciMonad m => String -> m (Maybe Command)\nlookupCommand' \":\" = return Nothing\nlookupCommand' str' = do\n  macros    <- ghci_macros <$> getGHCiState\n  ghci_cmds <- ghci_commands <$> getGHCiState\n\n  let ghci_cmds_nohide = filter (not . cmdHidden) ghci_cmds\n\n  let (str, xcmds) = case str' of\n          ':' : rest -> (rest, [])     -- \"::\" selects a builtin command\n          _          -> (str', macros) -- otherwise include macros in lookup\n\n      lookupExact  s = find $ (s ==)           . cmdName\n      lookupPrefix s = find $ (s `isPrefixOf`) . cmdName\n\n      -- hidden commands can only be matched exact\n      builtinPfxMatch = lookupPrefix str ghci_cmds_nohide\n\n  -- first, look for exact match (while preferring macros); then, look\n  -- for first prefix match (preferring builtins), *unless* a macro\n  -- overrides the builtin; see #8305 for motivation\n  return $ lookupExact str xcmds <|>\n           lookupExact str ghci_cmds <|>\n           (builtinPfxMatch >>= \\c -> lookupExact (cmdName c) xcmds) <|>\n           builtinPfxMatch <|>\n           lookupPrefix str xcmds\n\ngetCurrentBreakSpan :: GHC.GhcMonad m => m (Maybe SrcSpan)\ngetCurrentBreakSpan = do\n  resumes <- GHC.getResumeContext\n  case resumes of\n    [] -> return Nothing\n    (r:_) -> do\n        let ix = GHC.resumeHistoryIx r\n        if ix == 0\n           then return (Just (GHC.resumeSpan r))\n           else do\n                let hist = GHC.resumeHistory r !! (ix-1)\n                pan <- GHC.getHistorySpan hist\n                return (Just pan)\n\ngetCallStackAtCurrentBreakpoint :: GHC.GhcMonad m => m (Maybe [String])\ngetCallStackAtCurrentBreakpoint = do\n  resumes <- GHC.getResumeContext\n  case resumes of\n    [] -> return Nothing\n    (r:_) -> do\n       hsc_env <- GHC.getSession\n       Just <$> liftIO (costCentreStackInfo hsc_env (GHC.resumeCCS r))\n\ngetCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)\ngetCurrentBreakModule = do\n  resumes <- GHC.getResumeContext\n  case resumes of\n    [] -> return Nothing\n    (r:_) -> do\n        let ix = GHC.resumeHistoryIx r\n        if ix == 0\n           then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)\n           else do\n                let hist = GHC.resumeHistory r !! (ix-1)\n                return $ Just $ GHC.getHistoryModule  hist\n\n-----------------------------------------------------------------------------\n--\n-- Commands\n--\n-----------------------------------------------------------------------------\n\nnoArgs :: MonadIO m => m () -> String -> m ()\nnoArgs m \"\" = m\nnoArgs _ _  = liftIO $ putStrLn \"This command takes no arguments\"\n\nwithSandboxOnly :: GHC.GhcMonad m => String -> m () -> m ()\nwithSandboxOnly cmd this = do\n   dflags <- getDynFlags\n   if not (gopt Opt_GhciSandbox dflags)\n      then printForUser (text cmd <+>\n                         ptext (sLit \"is not supported with -fno-ghci-sandbox\"))\n      else this\n\n-----------------------------------------------------------------------------\n-- :help\n\nhelp :: GhciMonad m => String -> m ()\nhelp _ = do\n    txt <- long_help `fmap` getGHCiState\n    liftIO $ putStr txt\n\n-----------------------------------------------------------------------------\n-- :info\n\ninfo :: GHC.GhcMonad m => Bool -> String -> m ()\ninfo _ \"\" = throwGhcException (CmdLineError \"syntax: ':i <thing-you-want-info-about>'\")\ninfo allInfo s  = handleSourceError GHC.printException $ do\n    unqual <- GHC.getPrintUnqual\n    dflags <- getDynFlags\n    sdocs  <- mapM (infoThing allInfo) (words s)\n    mapM_ (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs\n\ninfoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc\ninfoThing allInfo str = do\n    names     <- GHC.parseName str\n    mb_stuffs <- mapM (GHC.getInfo allInfo) names\n    let filtered = filterOutChildren (\\(t,_f,_ci,_fi,_sd) -> t)\n                                     (catMaybes mb_stuffs)\n    return $ vcat (intersperse (text \"\") $ map pprInfo filtered)\n\n  -- Filter out names whose parent is also there Good\n  -- example is '[]', which is both a type and data\n  -- constructor in the same type\nfilterOutChildren :: (a -> TyThing) -> [a] -> [a]\nfilterOutChildren get_thing xs\n  = filterOut has_parent xs\n  where\n    all_names = mkNameSet (map (getName . get_thing) xs)\n    has_parent x = case tyThingParent_maybe (get_thing x) of\n                     Just p  -> getName p `elemNameSet` all_names\n                     Nothing -> False\n\npprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\npprInfo (thing, fixity, cls_insts, fam_insts, docs)\n  =  docs\n  $$ pprTyThingInContextLoc thing\n  $$ show_fixity\n  $$ vcat (map GHC.pprInstance cls_insts)\n  $$ vcat (map GHC.pprFamInst  fam_insts)\n  where\n    show_fixity\n        | fixity == GHC.defaultFixity = empty\n        | otherwise                   = ppr fixity <+> pprInfixName (GHC.getName thing)\n\n-----------------------------------------------------------------------------\n-- :main\n\nrunMain :: GhciMonad m => String -> m ()\nrunMain s = case toArgs s of\n            Left err   -> liftIO (hPutStrLn stderr err)\n            Right args ->\n                do dflags <- getDynFlags\n                   let main = fromMaybe \"main\" (mainFunIs dflags)\n                   -- Wrap the main function in 'void' to discard its value instead\n                   -- of printing it (#9086). See Haskell 2010 report Chapter 5.\n                   doWithArgs args $ \"Control.Monad.void (\" ++ main ++ \")\"\n\n-----------------------------------------------------------------------------\n-- :run\n\nrunRun :: GhciMonad m => String -> m ()\nrunRun s = case toCmdArgs s of\n           Left err          -> liftIO (hPutStrLn stderr err)\n           Right (cmd, args) -> doWithArgs args cmd\n\ndoWithArgs :: GhciMonad m => [String] -> String -> m ()\ndoWithArgs args cmd = enqueueCommands [\"System.Environment.withArgs \" ++\n                                       show args ++ \" (\" ++ cmd ++ \")\"]\n\n-----------------------------------------------------------------------------\n-- :cd\n\nchangeDirectory :: GhciMonad m => String -> m ()\nchangeDirectory \"\" = do\n  -- :cd on its own changes to the user's home directory\n  either_dir <- liftIO $ tryIO getHomeDirectory\n  case either_dir of\n     Left _e -> return ()\n     Right dir -> changeDirectory dir\nchangeDirectory dir = do\n  graph <- GHC.getModuleGraph\n  when (not (null $ GHC.mgModSummaries graph)) $\n        liftIO $ putStrLn \"Warning: changing directory causes all loaded modules to be unloaded,\\nbecause the search path has changed.\"\n  GHC.setTargets []\n  _ <- GHC.load LoadAllTargets\n  setContextAfterLoad False []\n  GHC.workingDirectoryChanged\n  dir' <- expandPath dir\n  liftIO $ setCurrentDirectory dir'\n  dflags <- getDynFlags\n  -- With -fexternal-interpreter, we have to change the directory of the subprocess too.\n  -- (this gives consistent behaviour with and without -fexternal-interpreter)\n  when (gopt Opt_ExternalInterpreter dflags) $ do\n    hsc_env <- GHC.getSession\n    fhv <- compileGHCiExpr $\n      \"System.Directory.setCurrentDirectory \" ++ show dir'\n    liftIO $ evalIO hsc_env fhv\n\ntrySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag\ntrySuccess act =\n    handleSourceError (\\e -> do GHC.printException e\n                                return Failed) $ do\n      act\n\n-----------------------------------------------------------------------------\n-- :edit\n\neditFile :: GhciMonad m => String -> m ()\neditFile str =\n  do file <- if null str then chooseEditFile else expandPath str\n     st <- getGHCiState\n     errs <- liftIO $ readIORef $ lastErrorLocations st\n     let cmd = editor st\n     when (null cmd)\n       $ throwGhcException (CmdLineError \"editor not set, use :set editor\")\n     lineOpt <- liftIO $ do\n         let sameFile p1 p2 = liftA2 (==) (canonicalizePath p1) (canonicalizePath p2)\n              `catchIO` (\\_ -> return False)\n\n         curFileErrs <- filterM (\\(f, _) -> unpackFS f `sameFile` file) errs\n         return $ case curFileErrs of\n             (_, line):_ -> \" +\" ++ show line\n             _ -> \"\"\n     let cmdArgs = ' ':(file ++ lineOpt)\n     code <- liftIO $ system (cmd ++ cmdArgs)\n\n     when (code == ExitSuccess)\n       $ reloadModule \"\"\n\n-- The user didn't specify a file so we pick one for them.\n-- Our strategy is to pick the first module that failed to load,\n-- or otherwise the first target.\n--\n-- XXX: Can we figure out what happened if the depndecy analysis fails\n--      (e.g., because the porgrammeer mistyped the name of a module)?\n-- XXX: Can we figure out the location of an error to pass to the editor?\n-- XXX: if we could figure out the list of errors that occured during the\n-- last load/reaload, then we could start the editor focused on the first\n-- of those.\nchooseEditFile :: GHC.GhcMonad m => m String\nchooseEditFile =\n  do let hasFailed x = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x\n\n     graph <- GHC.getModuleGraph\n     failed_graph <-\n       GHC.mkModuleGraph <$> filterM hasFailed (GHC.mgModSummaries graph)\n     let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing\n         pick xs  = case xs of\n                      x : _ -> GHC.ml_hs_file (GHC.ms_location x)\n                      _     -> Nothing\n\n     case pick (order failed_graph) of\n       Just file -> return file\n       Nothing   ->\n         do targets <- GHC.getTargets\n            case msum (map fromTarget targets) of\n              Just file -> return file\n              Nothing   -> throwGhcException (CmdLineError \"No files to edit.\")\n\n  where fromTarget (GHC.Target (GHC.TargetFile f _) _ _) = Just f\n        fromTarget _ = Nothing -- when would we get a module target?\n\n\n-----------------------------------------------------------------------------\n-- :def\n\ndefineMacro :: GhciMonad m => Bool{-overwrite-} -> String -> m ()\ndefineMacro _ (':':_) =\n  liftIO $ putStrLn \"macro name cannot start with a colon\"\ndefineMacro overwrite s = do\n  let (macro_name, definition) = break isSpace s\n  macros <- ghci_macros <$> getGHCiState\n  let defined = map cmdName macros\n  if null macro_name\n        then if null defined\n                then liftIO $ putStrLn \"no macros defined\"\n                else liftIO $ putStr (\"the following macros are defined:\\n\" ++\n                                      unlines defined)\n        else do\n  if (not overwrite && macro_name `elem` defined)\n        then throwGhcException (CmdLineError\n                (\"macro '\" ++ macro_name ++ \"' is already defined\"))\n        else do\n\n  -- compile the expression\n  handleSourceError GHC.printException $ do\n    step <- getGhciStepIO\n    expr <- GHC.parseExpr definition\n    -- > ghciStepIO . definition :: String -> IO String\n    let stringTy = nlHsTyVar stringTy_RDR\n        ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy\n        body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)\n                                   `mkHsApp` (nlHsPar expr)\n        tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)\n        new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig\n    hv <- GHC.compileParsedExprRemote new_expr\n\n    let newCmd = Command { cmdName = macro_name\n                         , cmdAction = lift . runMacro hv\n                         , cmdHidden = False\n                         , cmdCompletionFunc = noCompletion\n                         }\n\n    -- later defined macros have precedence\n    modifyGHCiState $ \\s ->\n        let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ]\n        in s { ghci_macros = newCmd : filtered }\n\nrunMacro\n  :: GhciMonad m\n  => GHC.ForeignHValue  -- String -> IO String\n  -> String\n  -> m Bool\nrunMacro fun s = do\n  hsc_env <- GHC.getSession\n  str <- liftIO $ evalStringToIOString hsc_env fun s\n  enqueueCommands (lines str)\n  return False\n\n\n-----------------------------------------------------------------------------\n-- :undef\n\nundefineMacro :: GhciMonad m => String -> m ()\nundefineMacro str = mapM_ undef (words str)\n where undef macro_name = do\n        cmds <- ghci_macros <$> getGHCiState\n        if (macro_name `notElem` map cmdName cmds)\n           then throwGhcException (CmdLineError\n                (\"macro '\" ++ macro_name ++ \"' is not defined\"))\n           else do\n            -- This is a tad racy but really, it's a shell\n            modifyGHCiState $ \\s ->\n                s { ghci_macros = filter ((/= macro_name) . cmdName)\n                                         (ghci_macros s) }\n\n\n-----------------------------------------------------------------------------\n-- :cmd\n\ncmdCmd :: GhciMonad m => String -> m ()\ncmdCmd str = handleSourceError GHC.printException $ do\n    step <- getGhciStepIO\n    expr <- GHC.parseExpr str\n    -- > ghciStepIO str :: IO String\n    let new_expr = step `mkHsApp` expr\n    hv <- GHC.compileParsedExprRemote new_expr\n\n    hsc_env <- GHC.getSession\n    cmds <- liftIO $ evalString hsc_env hv\n    enqueueCommands (lines cmds)\n\n-- | Generate a typed ghciStepIO expression\n-- @ghciStepIO :: Ty String -> IO String@.\ngetGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs)\ngetGhciStepIO = do\n  ghciTyConName <- GHC.getGHCiMonad\n  let stringTy = nlHsTyVar stringTy_RDR\n      ghciM = nlHsTyVar (getRdrName ghciTyConName) `nlHsAppTy` stringTy\n      ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy\n      body = nlHsVar (getRdrName ghciStepIoMName)\n      tySig = mkLHsSigWcType (ghciM `nlHsFunTy` ioM)\n  return $ noLoc $ ExprWithTySig noExt body tySig\n\n-----------------------------------------------------------------------------\n-- :check\n\ncheckModule :: GhciMonad m => String -> m ()\ncheckModule m = do\n  let modl = GHC.mkModuleName m\n  ok <- handleSourceError (\\e -> GHC.printException e >> return False) $ do\n          r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl\n          dflags <- getDynFlags\n          liftIO $ putStrLn $ showSDoc dflags $\n           case GHC.moduleInfo r of\n             cm | Just scope <- GHC.modInfoTopLevelScope cm ->\n                let\n                    (loc, glob) = ASSERT( all isExternalName scope )\n                                  partition ((== modl) . GHC.moduleName . GHC.nameModule) scope\n                in\n                        (text \"global names: \" <+> ppr glob) $$\n                        (text \"local  names: \" <+> ppr loc)\n             _ -> empty\n          return True\n  afterLoad (successIf ok) False\n\n-----------------------------------------------------------------------------\n-- :doc\n\ndocCmd :: GHC.GhcMonad m => String -> m ()\ndocCmd \"\" =\n  throwGhcException (CmdLineError \"syntax: ':doc <thing-you-want-docs-for>'\")\ndocCmd s  = do\n  -- TODO: Maybe also get module headers for module names\n  names <- GHC.parseName s\n  e_docss <- mapM GHC.getDocs names\n  sdocs <- mapM (either handleGetDocsFailure (pure . pprDocs)) e_docss\n  let sdocs' = vcat (intersperse (text \"\") sdocs)\n  unqual <- GHC.getPrintUnqual\n  dflags <- getDynFlags\n  (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs'\n\n-- TODO: also print arg docs.\npprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc\npprDocs (mb_decl_docs, _arg_docs) =\n  maybe\n    (text \"<has no documentation>\")\n    (text . unpackHDS)\n    mb_decl_docs\n\nhandleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc\nhandleGetDocsFailure no_docs = do\n  dflags <- getDynFlags\n  let msg = showPpr dflags no_docs\n  throwGhcException $ case no_docs of\n    NameHasNoModule {} -> Sorry msg\n    NoDocsInIface {} -> InstallationError msg\n    InteractiveName -> ProgramError msg\n\n-----------------------------------------------------------------------------\n-- :load, :add, :reload\n\n-- | Sets '-fdefer-type-errors' if 'defer' is true, executes 'load' and unsets\n-- '-fdefer-type-errors' again if it has not been set before.\nwrapDeferTypeErrors :: GHC.GhcMonad m => m a -> m a\nwrapDeferTypeErrors load =\n  gbracket\n    (do\n      -- Force originalFlags to avoid leaking the associated HscEnv\n      !originalFlags <- getDynFlags\n      void $ GHC.setProgramDynFlags $\n         setGeneralFlag' Opt_DeferTypeErrors originalFlags\n      return originalFlags)\n    (\\originalFlags -> void $ GHC.setProgramDynFlags originalFlags)\n    (\\_ -> load)\n\nloadModule :: GhciMonad m => [(FilePath, Maybe Phase)] -> m SuccessFlag\nloadModule fs = do\n  (_, result) <- runAndPrintStats (const Nothing) (loadModule' fs)\n  either (liftIO . Exception.throwIO) return result\n\n-- | @:load@ command\nloadModule_ :: GhciMonad m => [FilePath] -> m ()\nloadModule_ fs = void $ loadModule (zip fs (repeat Nothing))\n\nloadModuleDefer :: GhciMonad m => [FilePath] -> m ()\nloadModuleDefer = wrapDeferTypeErrors . loadModule_\n\nloadModule' :: GhciMonad m => [(FilePath, Maybe Phase)] -> m SuccessFlag\nloadModule' files = do\n  let (filenames, phases) = unzip files\n  exp_filenames <- mapM expandPath filenames\n  let files' = zip exp_filenames phases\n  targets <- mapM (uncurry GHC.guessTarget) files'\n\n  -- NOTE: we used to do the dependency anal first, so that if it\n  -- fails we didn't throw away the current set of modules.  This would\n  -- require some re-working of the GHC interface, so we'll leave it\n  -- as a ToDo for now.\n\n  hsc_env <- GHC.getSession\n\n  -- Grab references to the currently loaded modules so that we can\n  -- see if they leak.\n  let !dflags = hsc_dflags hsc_env\n  leak_indicators <- if gopt Opt_GhciLeakCheck dflags\n    then liftIO $ getLeakIndicators hsc_env\n    else return (panic \"no leak indicators\")\n\n  -- unload first\n  _ <- GHC.abandonAll\n  discardActiveBreakPoints\n  GHC.setTargets []\n  _ <- GHC.load LoadAllTargets\n\n  GHC.setTargets targets\n  success <- doLoadAndCollectInfo False LoadAllTargets\n  when (gopt Opt_GhciLeakCheck dflags) $\n    liftIO $ checkLeakIndicators dflags leak_indicators\n  return success\n\n-- | @:add@ command\naddModule :: GhciMonad m => [FilePath] -> m ()\naddModule files = do\n  revertCAFs -- always revert CAFs on load/add.\n  files' <- mapM expandPath files\n  targets <- mapM (\\m -> GHC.guessTarget m Nothing) files'\n  targets' <- filterM checkTarget targets\n  -- remove old targets with the same id; e.g. for :add *M\n  mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets' ]\n  mapM_ GHC.addTarget targets'\n  _ <- doLoadAndCollectInfo False LoadAllTargets\n  return ()\n  where\n    checkTarget :: GHC.GhcMonad m => Target -> m Bool\n    checkTarget (Target (TargetModule m) _ _) = checkTargetModule m\n    checkTarget (Target (TargetFile f _) _ _) = liftIO $ checkTargetFile f\n\n    checkTargetModule :: GHC.GhcMonad m => ModuleName -> m Bool\n    checkTargetModule m = do\n      hsc_env <- GHC.getSession\n      result <- liftIO $\n        Finder.findImportedModule hsc_env m (Just (fsLit \"this\"))\n      case result of\n        Found _ _ -> return True\n        _ -> (liftIO $ putStrLn $\n          \"Module \" ++ moduleNameString m ++ \" not found\") >> return False\n\n    checkTargetFile :: String -> IO Bool\n    checkTargetFile f = do\n      exists <- (doesFileExist f) :: IO Bool\n      unless exists $ putStrLn $ \"File \" ++ f ++ \" not found\"\n      return exists\n\n-- | @:unadd@ command\nunAddModule :: GhciMonad m => [FilePath] -> m ()\nunAddModule files = do\n  files' <- mapM expandPath files\n  targets <- mapM (\\m -> GHC.guessTarget m Nothing) files'\n  mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]\n  _ <- doLoadAndCollectInfo False LoadAllTargets\n  return ()\n\n-- | @:reload@ command\nreloadModule :: GhciMonad m => String -> m ()\nreloadModule m = void $ doLoadAndCollectInfo True loadTargets\n  where\n    loadTargets | null m    = LoadAllTargets\n                | otherwise = LoadUpTo (GHC.mkModuleName m)\n\nreloadModuleDefer :: GhciMonad m => String -> m ()\nreloadModuleDefer = wrapDeferTypeErrors . reloadModule\n\n-- | Load/compile targets and (optionally) collect module-info\n--\n-- This collects the necessary SrcSpan annotated type information (via\n-- 'collectInfo') required by the @:all-types@, @:loc-at@, @:type-at@,\n-- and @:uses@ commands.\n--\n-- Meta-info collection is not enabled by default and needs to be\n-- enabled explicitly via @:set +c@.  The reason is that collecting\n-- the type-information for all sub-spans can be quite expensive, and\n-- since those commands are designed to be used by editors and\n-- tooling, it's useless to collect this data for normal GHCi\n-- sessions.\ndoLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag\ndoLoadAndCollectInfo retain_context howmuch = do\n  doCollectInfo <- isOptionSet CollectInfo\n\n  doLoad retain_context howmuch >>= \\case\n    Succeeded | doCollectInfo -> do\n      mod_summaries <- GHC.mgModSummaries <$> getModuleGraph\n      loaded <- filterM GHC.isLoaded $ map GHC.ms_mod_name mod_summaries\n      v <- mod_infos <$> getGHCiState\n      !newInfos <- collectInfo v loaded\n      modifyGHCiState (\\st -> st { mod_infos = newInfos })\n      return Succeeded\n    flag -> return flag\n\ndoLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag\ndoLoad retain_context howmuch = do\n  -- turn off breakpoints before we load: we can't turn them off later, because\n  -- the ModBreaks will have gone away.\n  discardActiveBreakPoints\n\n  resetLastErrorLocations\n  -- Enable buffering stdout and stderr as we're compiling. Keeping these\n  -- handles unbuffered will just slow the compilation down, especially when\n  -- compiling in parallel.\n  gbracket (liftIO $ do hSetBuffering stdout LineBuffering\n                        hSetBuffering stderr LineBuffering)\n           (\\_ ->\n            liftIO $ do hSetBuffering stdout NoBuffering\n                        hSetBuffering stderr NoBuffering) $ \\_ -> do\n      ok <- trySuccess $ GHC.load howmuch\n      afterLoad ok retain_context\n      return ok\n\n\nafterLoad\n  :: GhciMonad m\n  => SuccessFlag\n  -> Bool   -- keep the remembered_ctx, as far as possible (:reload)\n  -> m ()\nafterLoad ok retain_context = do\n  revertCAFs  -- always revert CAFs on load.\n  discardTickArrays\n  loaded_mods <- getLoadedModules\n  modulesLoadedMsg ok loaded_mods\n  setContextAfterLoad retain_context loaded_mods\n\nsetContextAfterLoad :: GhciMonad m => Bool -> [GHC.ModSummary] -> m ()\nsetContextAfterLoad keep_ctxt [] = do\n  setContextKeepingPackageModules keep_ctxt []\nsetContextAfterLoad keep_ctxt ms = do\n  -- load a target if one is available, otherwise load the topmost module.\n  targets <- GHC.getTargets\n  case [ m | Just m <- map (findTarget ms) targets ] of\n        []    ->\n          let graph = GHC.mkModuleGraph ms\n              graph' = flattenSCCs (GHC.topSortModuleGraph True graph Nothing)\n          in load_this (last graph')\n        (m:_) ->\n          load_this m\n where\n   findTarget mds t\n    = case filter (`matches` t) mds of\n        []    -> Nothing\n        (m:_) -> Just m\n\n   summary `matches` Target (TargetModule m) _ _\n        = GHC.ms_mod_name summary == m\n   summary `matches` Target (TargetFile f _) _ _\n        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'\n   _ `matches` _\n        = False\n\n   load_this summary | m <- GHC.ms_mod summary = do\n        is_interp <- GHC.moduleIsInterpreted m\n        dflags <- getDynFlags\n        let star_ok = is_interp && not (safeLanguageOn dflags)\n              -- We import the module with a * iff\n              --   - it is interpreted, and\n              --   - -XSafe is off (it doesn't allow *-imports)\n        let new_ctx | star_ok   = [mkIIModule (GHC.moduleName m)]\n                    | otherwise = [mkIIDecl   (GHC.moduleName m)]\n        setContextKeepingPackageModules keep_ctxt new_ctx\n\n\n-- | Keep any package modules (except Prelude) when changing the context.\nsetContextKeepingPackageModules\n  :: GhciMonad m\n  => Bool                 -- True  <=> keep all of remembered_ctx\n                          -- False <=> just keep package imports\n  -> [InteractiveImport]  -- new context\n  -> m ()\nsetContextKeepingPackageModules keep_ctx trans_ctx = do\n\n  st <- getGHCiState\n  let rem_ctx = remembered_ctx st\n  new_rem_ctx <- if keep_ctx then return rem_ctx\n                             else keepPackageImports rem_ctx\n  setGHCiState st{ remembered_ctx = new_rem_ctx,\n                   transient_ctx  = filterSubsumed new_rem_ctx trans_ctx }\n  setGHCContextFromGHCiState\n\n-- | Filters a list of 'InteractiveImport', clearing out any home package\n-- imports so only imports from external packages are preserved.  ('IIModule'\n-- counts as a home package import, because we are only able to bring a\n-- full top-level into scope when the source is available.)\nkeepPackageImports\n  :: GHC.GhcMonad m => [InteractiveImport] -> m [InteractiveImport]\nkeepPackageImports = filterM is_pkg_import\n  where\n     is_pkg_import :: GHC.GhcMonad m => InteractiveImport -> m Bool\n     is_pkg_import (IIModule _) = return False\n     is_pkg_import (IIDecl d)\n         = do e <- gtry $ GHC.findModule mod_name (fmap sl_fs $ ideclPkgQual d)\n              case e :: Either SomeException Module of\n                Left _  -> return False\n                Right m -> return (not (isHomeModule m))\n        where\n          mod_name = unLoc (ideclName d)\n\n\nmodulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> m ()\nmodulesLoadedMsg ok mods = do\n  dflags <- getDynFlags\n  unqual <- GHC.getPrintUnqual\n\n  msg <- if gopt Opt_ShowLoadedModules dflags\n         then do\n               mod_names <- mapM mod_name mods\n               let mod_commas\n                     | null mods = text \"none.\"\n                     | otherwise = hsep (punctuate comma mod_names) <> text \".\"\n               return $ status <> text \", modules loaded:\" <+> mod_commas\n         else do\n               return $ status <> text \",\"\n                    <+> speakNOf (length mods) (text \"module\") <+> \"loaded.\"\n\n  when (verbosity dflags > 0) $\n     liftIO $ putStrLn $ showSDocForUser dflags unqual msg\n  where\n    status = case ok of\n                  Failed    -> text \"Failed\"\n                  Succeeded -> text \"Ok\"\n\n    mod_name mod = do\n        is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod\n        return $ if is_interpreted\n                 then ppr (GHC.ms_mod mod)\n                 else ppr (GHC.ms_mod mod)\n                      <+> parens (text $ normalise $ msObjFilePath mod)\n                      -- Fix #9887\n\n-- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors\n-- and printing 'throwE' strings to 'stderr'\nrunExceptGhcMonad :: GHC.GhcMonad m => ExceptT SDoc m () -> m ()\nrunExceptGhcMonad act = handleSourceError GHC.printException $\n                        either handleErr pure =<<\n                        runExceptT act\n  where\n    handleErr sdoc = do\n        dflags <- getDynFlags\n        liftIO . hPutStrLn stderr . showSDocForUser dflags alwaysQualify $ sdoc\n\n-- | Inverse of 'runExceptT' for \\\"pure\\\" computations\n-- (c.f. 'except' for 'Except')\nexceptT :: Applicative m => Either e a -> ExceptT e m a\nexceptT = ExceptT . pure\n\n-----------------------------------------------------------------------------\n-- | @:type@ command. See also Note [TcRnExprMode] in TcRnDriver.\n\ntypeOfExpr :: GHC.GhcMonad m => String -> m ()\ntypeOfExpr str = handleSourceError GHC.printException $ do\n    let (mode, expr_str) = case break isSpace str of\n          (\"+d\", rest) -> (GHC.TM_Default, dropWhile isSpace rest)\n          (\"+v\", rest) -> (GHC.TM_NoInst,  dropWhile isSpace rest)\n          _            -> (GHC.TM_Inst,    str)\n    ty <- GHC.exprType mode expr_str\n    printForUser $ sep [text expr_str, nest 2 (dcolon <+> pprTypeForUser ty)]\n\n-----------------------------------------------------------------------------\n-- | @:type-at@ command\n\ntypeAtCmd :: GhciMonad m => String -> m ()\ntypeAtCmd str = runExceptGhcMonad $ do\n    (span',sample) <- exceptT $ parseSpanArg str\n    infos      <- lift $ mod_infos <$> getGHCiState\n    (info, ty) <- findType infos span' sample\n    lift $ printForUserModInfo (modinfoInfo info)\n                               (sep [text sample,nest 2 (dcolon <+> ppr ty)])\n\n-----------------------------------------------------------------------------\n-- | @:uses@ command\n\nusesCmd :: GhciMonad m => String -> m ()\nusesCmd str = runExceptGhcMonad $ do\n    (span',sample) <- exceptT $ parseSpanArg str\n    infos  <- lift $ mod_infos <$> getGHCiState\n    uses   <- findNameUses infos span' sample\n    forM_ uses (liftIO . putStrLn . showSrcSpan)\n\n-----------------------------------------------------------------------------\n-- | @:loc-at@ command\n\nlocAtCmd :: GhciMonad m => String -> m ()\nlocAtCmd str = runExceptGhcMonad $ do\n    (span',sample) <- exceptT $ parseSpanArg str\n    infos    <- lift $ mod_infos <$> getGHCiState\n    (_,_,sp) <- findLoc infos span' sample\n    liftIO . putStrLn . showSrcSpan $ sp\n\n-----------------------------------------------------------------------------\n-- | @:all-types@ command\n\nallTypesCmd :: GhciMonad m => String -> m ()\nallTypesCmd _ = runExceptGhcMonad $ do\n    infos <- lift $ mod_infos <$> getGHCiState\n    forM_ (M.elems infos) $ \\mi ->\n        forM_ (modinfoSpans mi) (lift . printSpan)\n  where\n    printSpan span'\n      | Just ty <- spaninfoType span' = do\n        df <- getDynFlags\n        let tyInfo = unwords . words $\n                     showSDocForUser df alwaysQualify (pprTypeForUser ty)\n        liftIO . putStrLn $\n            showRealSrcSpan (spaninfoSrcSpan span') ++ \": \" ++ tyInfo\n      | otherwise = return ()\n\n-----------------------------------------------------------------------------\n-- Helpers for locAtCmd/typeAtCmd/usesCmd\n\n-- | Parse a span: <module-name/filepath> <sl> <sc> <el> <ec> <string>\nparseSpanArg :: String -> Either SDoc (RealSrcSpan,String)\nparseSpanArg s = do\n    (fp,s0) <- readAsString (skipWs s)\n    s0'     <- skipWs1 s0\n    (sl,s1) <- readAsInt s0'\n    s1'     <- skipWs1 s1\n    (sc,s2) <- readAsInt s1'\n    s2'     <- skipWs1 s2\n    (el,s3) <- readAsInt s2'\n    s3'     <- skipWs1 s3\n    (ec,s4) <- readAsInt s3'\n\n    trailer <- case s4 of\n        [] -> Right \"\"\n        _  -> skipWs1 s4\n\n    let fs    = mkFastString fp\n        span' = mkRealSrcSpan (mkRealSrcLoc fs sl sc)\n                              (mkRealSrcLoc fs el ec)\n\n    return (span',trailer)\n  where\n    readAsInt :: String -> Either SDoc (Int,String)\n    readAsInt \"\" = Left \"Premature end of string while expecting Int\"\n    readAsInt s0 = case reads s0 of\n        [s_rest] -> Right s_rest\n        _        -> Left (\"Couldn't read\" <+> text (show s0) <+> \"as Int\")\n\n    readAsString :: String -> Either SDoc (String,String)\n    readAsString s0\n      | '\"':_ <- s0 = case reads s0 of\n          [s_rest] -> Right s_rest\n          _        -> leftRes\n      | s_rest@(_:_,_) <- breakWs s0 = Right s_rest\n      | otherwise = leftRes\n      where\n        leftRes = Left (\"Couldn't read\" <+> text (show s0) <+> \"as String\")\n\n    skipWs1 :: String -> Either SDoc String\n    skipWs1 (c:cs) | isWs c = Right (skipWs cs)\n    skipWs1 s0 = Left (\"Expected whitespace in\" <+> text (show s0))\n\n    isWs    = (`elem` [' ','\\t'])\n    skipWs  = dropWhile isWs\n    breakWs = break isWs\n\n\n-- | Pretty-print \\\"real\\\" 'SrcSpan's as\n-- @<filename>:(<line>,<col>)-(<line-end>,<col-end>)@\n-- while simply unpacking 'UnhelpfulSpan's\nshowSrcSpan :: SrcSpan -> String\nshowSrcSpan (UnhelpfulSpan s)  = unpackFS s\nshowSrcSpan (RealSrcSpan spn)  = showRealSrcSpan spn\n\n-- | Variant of 'showSrcSpan' for 'RealSrcSpan's\nshowRealSrcSpan :: RealSrcSpan -> String\nshowRealSrcSpan spn = concat [ fp, \":(\", show sl, \",\", show sc\n                             , \")-(\", show el, \",\", show ec, \")\"\n                             ]\n  where\n    fp = unpackFS (srcSpanFile spn)\n    sl = srcSpanStartLine spn\n    sc = srcSpanStartCol  spn\n    el = srcSpanEndLine   spn\n    ec = srcSpanEndCol    spn\n\n-----------------------------------------------------------------------------\n-- | @:kind@ command\n\nkindOfType :: GHC.GhcMonad m => Bool -> String -> m ()\nkindOfType norm str = handleSourceError GHC.printException $ do\n    (ty, kind) <- GHC.typeKind norm str\n    printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser kind\n                        , ppWhen norm $ equals <+> pprTypeForUser ty ]\n\n-----------------------------------------------------------------------------\n-- :quit\n\nquit :: Monad m => String -> m Bool\nquit _ = return True\n\n\n-----------------------------------------------------------------------------\n-- :script\n\n-- running a script file #1363\n\nscriptCmd :: String -> InputT GHCi ()\nscriptCmd ws = do\n  case words ws of\n    [s]    -> runScript s\n    _      -> throwGhcException (CmdLineError \"syntax:  :script <filename>\")\n\nrunScript :: String    -- ^ filename\n           -> InputT GHCi ()\nrunScript filename = do\n  filename' <- expandPath filename\n  either_script <- liftIO $ tryIO (openFile filename' ReadMode)\n  case either_script of\n    Left _err    -> throwGhcException (CmdLineError $ \"IO error:  \\\"\"++filename++\"\\\" \"\n                      ++(ioeGetErrorString _err))\n    Right script -> do\n      st <- getGHCiState\n      let prog = progname st\n          line = line_number st\n      setGHCiState st{progname=filename',line_number=0}\n      scriptLoop script\n      liftIO $ hClose script\n      new_st <- getGHCiState\n      setGHCiState new_st{progname=prog,line_number=line}\n  where scriptLoop script = do\n          res <- runOneCommand handler $ fileLoop script\n          case res of\n            Nothing -> return ()\n            Just s  -> if s\n              then scriptLoop script\n              else return ()\n\n-----------------------------------------------------------------------------\n-- :issafe\n\n-- Displaying Safe Haskell properties of a module\n\nisSafeCmd :: GHC.GhcMonad m => String -> m ()\nisSafeCmd m =\n    case words m of\n        [s] | looksLikeModuleName s -> do\n            md <- lookupModule s\n            isSafeModule md\n        [] -> do md <- guessCurrentModule \"issafe\"\n                 isSafeModule md\n        _ -> throwGhcException (CmdLineError \"syntax:  :issafe <module>\")\n\nisSafeModule :: GHC.GhcMonad m => Module -> m ()\nisSafeModule m = do\n    mb_mod_info <- GHC.getModuleInfo m\n    when (isNothing mb_mod_info)\n         (throwGhcException $ CmdLineError $ \"unknown module: \" ++ mname)\n\n    dflags <- getDynFlags\n    let iface = GHC.modInfoIface $ fromJust mb_mod_info\n    when (isNothing iface)\n         (throwGhcException $ CmdLineError $ \"can't load interface file for module: \" ++\n                                    (GHC.moduleNameString $ GHC.moduleName m))\n\n    (msafe, pkgs) <- GHC.moduleTrustReqs m\n    let trust  = showPpr dflags $ getSafeMode $ GHC.mi_trust $ fromJust iface\n        pkg    = if packageTrusted dflags m then \"trusted\" else \"untrusted\"\n        (good, bad) = tallyPkgs dflags pkgs\n\n    -- print info to user...\n    liftIO $ putStrLn $ \"Trust type is (Module: \" ++ trust ++ \", Package: \" ++ pkg ++ \")\"\n    liftIO $ putStrLn $ \"Package Trust: \" ++ (if packageTrustOn dflags then \"On\" else \"Off\")\n    when (not $ S.null good)\n         (liftIO $ putStrLn $ \"Trusted package dependencies (trusted): \" ++\n                        (intercalate \", \" $ map (showPpr dflags) (S.toList good)))\n    case msafe && S.null bad of\n        True -> liftIO $ putStrLn $ mname ++ \" is trusted!\"\n        False -> do\n            when (not $ null bad)\n                 (liftIO $ putStrLn $ \"Trusted package dependencies (untrusted): \"\n                            ++ (intercalate \", \" $ map (showPpr dflags) (S.toList bad)))\n            liftIO $ putStrLn $ mname ++ \" is NOT trusted!\"\n\n  where\n    mname = GHC.moduleNameString $ GHC.moduleName m\n\n    packageTrusted dflags md\n        | thisPackage dflags == moduleUnitId md = True\n        | otherwise = trusted $ getPackageDetails dflags (moduleUnitId md)\n\n    tallyPkgs dflags deps | not (packageTrustOn dflags) = (S.empty, S.empty)\n                          | otherwise = S.partition part deps\n        where part pkg = trusted $ getInstalledPackageDetails dflags pkg\n\n-----------------------------------------------------------------------------\n-- :browse\n\n-- Browsing a module's contents\n\nbrowseCmd :: GHC.GhcMonad m => Bool -> String -> m ()\nbrowseCmd bang m =\n  case words m of\n    ['*':s] | looksLikeModuleName s -> do\n        md <- wantInterpretedModule s\n        browseModule bang md False\n    [s] | looksLikeModuleName s -> do\n        md <- lookupModule s\n        browseModule bang md True\n    [] -> do md <- guessCurrentModule (\"browse\" ++ if bang then \"!\" else \"\")\n             browseModule bang md True\n    _ -> throwGhcException (CmdLineError \"syntax:  :browse <module>\")\n\nguessCurrentModule :: GHC.GhcMonad m => String -> m Module\n-- Guess which module the user wants to browse.  Pick\n-- modules that are interpreted first.  The most\n-- recently-added module occurs last, it seems.\nguessCurrentModule cmd\n  = do imports <- GHC.getContext\n       when (null imports) $ throwGhcException $\n          CmdLineError (':' : cmd ++ \": no current module\")\n       case (head imports) of\n          IIModule m -> GHC.findModule m Nothing\n          IIDecl d   -> GHC.findModule (unLoc (ideclName d))\n                                       (fmap sl_fs $ ideclPkgQual d)\n\n-- without bang, show items in context of their parents and omit children\n-- with bang, show class methods and data constructors separately, and\n--            indicate import modules, to aid qualifying unqualified names\n-- with sorted, sort items alphabetically\nbrowseModule :: GHC.GhcMonad m => Bool -> Module -> Bool -> m ()\nbrowseModule bang modl exports_only = do\n  -- :browse reports qualifiers wrt current context\n  unqual <- GHC.getPrintUnqual\n\n  mb_mod_info <- GHC.getModuleInfo modl\n  case mb_mod_info of\n    Nothing -> throwGhcException (CmdLineError (\"unknown module: \" ++\n                                GHC.moduleNameString (GHC.moduleName modl)))\n    Just mod_info -> do\n        dflags <- getDynFlags\n        let names\n               | exports_only = GHC.modInfoExports mod_info\n               | otherwise    = GHC.modInfoTopLevelScope mod_info\n                                `orElse` []\n\n                -- sort alphabetically name, but putting locally-defined\n                -- identifiers first. We would like to improve this; see #1799.\n            sorted_names = loc_sort local ++ occ_sort external\n                where\n                (local,external) = ASSERT( all isExternalName names )\n                                   partition ((==modl) . nameModule) names\n                occ_sort = sortBy (compare `on` nameOccName)\n                -- try to sort by src location. If the first name in our list\n                -- has a good source location, then they all should.\n                loc_sort ns\n                      | n:_ <- ns, isGoodSrcSpan (nameSrcSpan n)\n                      = sortBy (compare `on` nameSrcSpan) ns\n                      | otherwise\n                      = occ_sort ns\n\n        mb_things <- mapM GHC.lookupName sorted_names\n        let filtered_things = filterOutChildren (\\t -> t) (catMaybes mb_things)\n\n        rdr_env <- GHC.getGRE\n\n        let things | bang      = catMaybes mb_things\n                   | otherwise = filtered_things\n            pretty | bang      = pprTyThing showToHeader\n                   | otherwise = pprTyThingInContext showToHeader\n\n            labels  [] = text \"-- not currently imported\"\n            labels  l  = text $ intercalate \"\\n\" $ map qualifier l\n\n            qualifier :: Maybe [ModuleName] -> String\n            qualifier  = maybe \"-- defined locally\"\n                             ((\"-- imported via \"++) . intercalate \", \"\n                               . map GHC.moduleNameString)\n            importInfo = RdrName.getGRE_NameQualifier_maybes rdr_env\n\n            modNames :: [[Maybe [ModuleName]]]\n            modNames   = map (importInfo . GHC.getName) things\n\n            -- annotate groups of imports with their import modules\n            -- the default ordering is somewhat arbitrary, so we group\n            -- by header and sort groups; the names themselves should\n            -- really come in order of source appearance.. (trac #1799)\n            annotate mts = concatMap (\\(m,ts)->labels m:ts)\n                         $ sortBy cmpQualifiers $ grp mts\n              where cmpQualifiers =\n                      compare `on` (map (fmap (map moduleNameFS)) . fst)\n            grp []            = []\n            grp mts@((m,_):_) = (m,map snd g) : grp ng\n              where (g,ng) = partition ((==m).fst) mts\n\n        let prettyThings, prettyThings' :: [SDoc]\n            prettyThings = map pretty things\n            prettyThings' | bang      = annotate $ zip modNames prettyThings\n                          | otherwise = prettyThings\n        liftIO $ putStrLn $ showSDocForUser dflags unqual (vcat prettyThings')\n        -- ToDo: modInfoInstances currently throws an exception for\n        -- package modules.  When it works, we can do this:\n        --        $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))\n\n\n-----------------------------------------------------------------------------\n-- :module\n\n-- Setting the module context.  For details on context handling see\n-- \"remembered_ctx\" and \"transient_ctx\" in GhciMonad.\n\nmoduleCmd :: GhciMonad m => String -> m ()\nmoduleCmd str\n  | all sensible strs = cmd\n  | otherwise = throwGhcException (CmdLineError \"syntax:  :module [+/-] [*]M1 ... [*]Mn\")\n  where\n    (cmd, strs) =\n        case str of\n          '+':stuff -> rest addModulesToContext   stuff\n          '-':stuff -> rest remModulesFromContext stuff\n          stuff     -> rest setContext            stuff\n\n    rest op stuff = (op as bs, stuffs)\n       where (as,bs) = partitionWith starred stuffs\n             stuffs  = words stuff\n\n    sensible ('*':m) = looksLikeModuleName m\n    sensible m       = looksLikeModuleName m\n\n    starred ('*':m) = Left  (GHC.mkModuleName m)\n    starred m       = Right (GHC.mkModuleName m)\n\n\n-- -----------------------------------------------------------------------------\n-- Four ways to manipulate the context:\n--   (a) :module +<stuff>:     addModulesToContext\n--   (b) :module -<stuff>:     remModulesFromContext\n--   (c) :module <stuff>:      setContext\n--   (d) import <module>...:   addImportToContext\n\naddModulesToContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()\naddModulesToContext starred unstarred = restoreContextOnFailure $ do\n   addModulesToContext_ starred unstarred\n\naddModulesToContext_ :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()\naddModulesToContext_ starred unstarred = do\n   mapM_ addII (map mkIIModule starred ++ map mkIIDecl unstarred)\n   setGHCContextFromGHCiState\n\nremModulesFromContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()\nremModulesFromContext  starred unstarred = do\n   -- we do *not* call restoreContextOnFailure here.  If the user\n   -- is trying to fix up a context that contains errors by removing\n   -- modules, we don't want GHC to silently put them back in again.\n   mapM_ rm (starred ++ unstarred)\n   setGHCContextFromGHCiState\n where\n   rm :: GhciMonad m => ModuleName -> m ()\n   rm str = do\n     m <- moduleName <$> lookupModuleName str\n     let filt = filter ((/=) m . iiModuleName)\n     modifyGHCiState $ \\st ->\n        st { remembered_ctx = filt (remembered_ctx st)\n           , transient_ctx  = filt (transient_ctx st) }\n\nsetContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()\nsetContext starred unstarred = restoreContextOnFailure $ do\n  modifyGHCiState $ \\st -> st { remembered_ctx = [], transient_ctx = [] }\n                                -- delete the transient context\n  addModulesToContext_ starred unstarred\n\naddImportToContext :: GhciMonad m => String -> m ()\naddImportToContext str = restoreContextOnFailure $ do\n  idecl <- GHC.parseImportDecl str\n  addII (IIDecl idecl)   -- #5836\n  setGHCContextFromGHCiState\n\n-- Util used by addImportToContext and addModulesToContext\naddII :: GhciMonad m => InteractiveImport -> m ()\naddII iidecl = do\n  checkAdd iidecl\n  modifyGHCiState $ \\st ->\n     st { remembered_ctx = addNotSubsumed iidecl (remembered_ctx st)\n        , transient_ctx = filter (not . (iidecl `iiSubsumes`))\n                                 (transient_ctx st)\n        }\n\n-- Sometimes we can't tell whether an import is valid or not until\n-- we finally call 'GHC.setContext'.  e.g.\n--\n--   import System.IO (foo)\n--\n-- will fail because System.IO does not export foo.  In this case we\n-- don't want to store the import in the context permanently, so we\n-- catch the failure from 'setGHCContextFromGHCiState' and set the\n-- context back to what it was.\n--\n-- See #6007\n--\nrestoreContextOnFailure :: GhciMonad m => m a -> m a\nrestoreContextOnFailure do_this = do\n  st <- getGHCiState\n  let rc = remembered_ctx st; tc = transient_ctx st\n  do_this `gonException` (modifyGHCiState $ \\st' ->\n     st' { remembered_ctx = rc, transient_ctx = tc })\n\n-- -----------------------------------------------------------------------------\n-- Validate a module that we want to add to the context\n\ncheckAdd :: GHC.GhcMonad m => InteractiveImport -> m ()\ncheckAdd ii = do\n  dflags <- getDynFlags\n  let safe = safeLanguageOn dflags\n  case ii of\n    IIModule modname\n       | safe -> throwGhcException $ CmdLineError \"can't use * imports with Safe Haskell\"\n       | otherwise -> wantInterpretedModuleName modname >> return ()\n\n    IIDecl d -> do\n       let modname = unLoc (ideclName d)\n           pkgqual = ideclPkgQual d\n       m <- GHC.lookupModule modname (fmap sl_fs pkgqual)\n       when safe $ do\n           t <- GHC.isModuleTrusted m\n           when (not t) $ throwGhcException $ ProgramError $ \"\"\n\n-- -----------------------------------------------------------------------------\n-- Update the GHC API's view of the context\n\n-- | Sets the GHC context from the GHCi state.  The GHC context is\n-- always set this way, we never modify it incrementally.\n--\n-- We ignore any imports for which the ModuleName does not currently\n-- exist.  This is so that the remembered_ctx can contain imports for\n-- modules that are not currently loaded, perhaps because we just did\n-- a :reload and encountered errors.\n--\n-- Prelude is added if not already present in the list.  Therefore to\n-- override the implicit Prelude import you can say 'import Prelude ()'\n-- at the prompt, just as in Haskell source.\n--\nsetGHCContextFromGHCiState :: GhciMonad m => m ()\nsetGHCContextFromGHCiState = do\n  st <- getGHCiState\n      -- re-use checkAdd to check whether the module is valid.  If the\n      -- module does not exist, we do *not* want to print an error\n      -- here, we just want to silently keep the module in the context\n      -- until such time as the module reappears again.  So we ignore\n      -- the actual exception thrown by checkAdd, using tryBool to\n      -- turn it into a Bool.\n  iidecls <- filterM (tryBool.checkAdd) (transient_ctx st ++ remembered_ctx st)\n\n  prel_iidecls <- getImplicitPreludeImports iidecls\n  valid_prel_iidecls <- filterM (tryBool . checkAdd) prel_iidecls\n\n  extra_imports <- filterM (tryBool . checkAdd) (map IIDecl (extra_imports st))\n\n  GHC.setContext $ iidecls ++ extra_imports ++ valid_prel_iidecls\n\n\ngetImplicitPreludeImports :: GhciMonad m\n                          => [InteractiveImport] -> m [InteractiveImport]\ngetImplicitPreludeImports iidecls = do\n  dflags <- GHC.getInteractiveDynFlags\n     -- allow :seti to override -XNoImplicitPrelude\n  st <- getGHCiState\n\n  -- We add the prelude imports if there are no *-imports, and we also\n  -- allow each prelude import to be subsumed by another explicit import\n  -- of the same module.  This means that you can override the prelude import\n  -- with \"import Prelude hiding (map)\", for example.\n  let prel_iidecls =\n         if xopt LangExt.ImplicitPrelude dflags && not (any isIIModule iidecls)\n            then [ IIDecl imp\n                 | imp <- prelude_imports st\n                 , not (any (sameImpModule imp) iidecls) ]\n            else []\n\n  return prel_iidecls\n\n-- -----------------------------------------------------------------------------\n-- Utils on InteractiveImport\n\nmkIIModule :: ModuleName -> InteractiveImport\nmkIIModule = IIModule\n\nmkIIDecl :: ModuleName -> InteractiveImport\nmkIIDecl = IIDecl . simpleImportDecl\n\niiModules :: [InteractiveImport] -> [ModuleName]\niiModules is = [m | IIModule m <- is]\n\nisIIModule :: InteractiveImport -> Bool\nisIIModule (IIModule _) = True\nisIIModule _ = False\n\niiModuleName :: InteractiveImport -> ModuleName\niiModuleName (IIModule m) = m\niiModuleName (IIDecl d)   = unLoc (ideclName d)\n\npreludeModuleName :: ModuleName\npreludeModuleName = GHC.mkModuleName \"Prelude\"\n\nsameImpModule :: ImportDecl GhcPs -> InteractiveImport -> Bool\nsameImpModule _ (IIModule _) = False -- we only care about imports here\nsameImpModule imp (IIDecl d) = unLoc (ideclName d) == unLoc (ideclName imp)\n\naddNotSubsumed :: InteractiveImport\n               -> [InteractiveImport] -> [InteractiveImport]\naddNotSubsumed i is\n  | any (`iiSubsumes` i) is = is\n  | otherwise               = i : filter (not . (i `iiSubsumes`)) is\n\n-- | @filterSubsumed is js@ returns the elements of @js@ not subsumed\n-- by any of @is@.\nfilterSubsumed :: [InteractiveImport] -> [InteractiveImport]\n               -> [InteractiveImport]\nfilterSubsumed is js = filter (\\j -> not (any (`iiSubsumes` j) is)) js\n\n-- | Returns True if the left import subsumes the right one.  Doesn't\n-- need to be 100% accurate, conservatively returning False is fine.\n-- (EXCEPT: (IIModule m) *must* subsume itself, otherwise a panic in\n-- plusProv will ensue (#5904))\n--\n-- Note that an IIModule does not necessarily subsume an IIDecl,\n-- because e.g. a module might export a name that is only available\n-- qualified within the module itself.\n--\n-- Note that 'import M' does not necessarily subsume 'import M(foo)',\n-- because M might not export foo and we want an error to be produced\n-- in that case.\n--\niiSubsumes :: InteractiveImport -> InteractiveImport -> Bool\niiSubsumes (IIModule m1) (IIModule m2) = m1==m2\niiSubsumes (IIDecl d1) (IIDecl d2)      -- A bit crude\n  =  unLoc (ideclName d1) == unLoc (ideclName d2)\n     && ideclAs d1 == ideclAs d2\n     && (not (ideclQualified d1) || ideclQualified d2)\n     && (ideclHiding d1 `hidingSubsumes` ideclHiding d2)\n  where\n     _                    `hidingSubsumes` Just (False,L _ []) = True\n     Just (False, L _ xs) `hidingSubsumes` Just (False,L _ ys)\n                                                           = all (`elem` xs) ys\n     h1                   `hidingSubsumes` h2              = h1 == h2\niiSubsumes _ _ = False\n\n\n----------------------------------------------------------------------------\n-- :set\n\n-- set options in the interpreter.  Syntax is exactly the same as the\n-- ghc command line, except that certain options aren't available (-C,\n-- -E etc.)\n--\n-- This is pretty fragile: most options won't work as expected.  ToDo:\n-- figure out which ones & disallow them.\n\nsetCmd :: GhciMonad m => String -> m ()\nsetCmd \"\"   = showOptions False\nsetCmd \"-a\" = showOptions True\nsetCmd str\n  = case getCmd str of\n    Right (\"args\",    rest) ->\n        case toArgs rest of\n            Left err -> liftIO (hPutStrLn stderr err)\n            Right args -> setArgs args\n    Right (\"prog\",    rest) ->\n        case toArgs rest of\n            Right [prog] -> setProg prog\n            _ -> liftIO (hPutStrLn stderr \"syntax: :set prog <progname>\")\n\n    Right (\"prompt\",           rest) ->\n        setPromptString setPrompt (dropWhile isSpace rest)\n                        \"syntax: set prompt <string>\"\n    Right (\"prompt-function\",  rest) ->\n        setPromptFunc setPrompt $ dropWhile isSpace rest\n    Right (\"prompt-cont\",          rest) ->\n        setPromptString setPromptCont (dropWhile isSpace rest)\n                        \"syntax: :set prompt-cont <string>\"\n    Right (\"prompt-cont-function\", rest) ->\n        setPromptFunc setPromptCont $ dropWhile isSpace rest\n\n    Right (\"editor\",  rest) -> setEditor  $ dropWhile isSpace rest\n    Right (\"stop\",    rest) -> setStop    $ dropWhile isSpace rest\n    _ -> case toArgs str of\n         Left err -> liftIO (hPutStrLn stderr err)\n         Right wds -> setOptions wds\n\nsetiCmd :: GhciMonad m => String -> m ()\nsetiCmd \"\"   = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags False\nsetiCmd \"-a\" = GHC.getInteractiveDynFlags >>= liftIO . showDynFlags True\nsetiCmd str  =\n  case toArgs str of\n    Left err -> liftIO (hPutStrLn stderr err)\n    Right wds -> newDynFlags True wds\n\nshowOptions :: GhciMonad m => Bool -> m ()\nshowOptions show_all\n  = do st <- getGHCiState\n       dflags <- getDynFlags\n       let opts = options st\n       liftIO $ putStrLn (showSDoc dflags (\n              text \"options currently set: \" <>\n              if null opts\n                   then text \"none.\"\n                   else hsep (map (\\o -> char '+' <> text (optToStr o)) opts)\n           ))\n       getDynFlags >>= liftIO . showDynFlags show_all\n\n\nshowDynFlags :: Bool -> DynFlags -> IO ()\nshowDynFlags show_all dflags = do\n  showLanguages' show_all dflags\n  putStrLn $ showSDoc dflags $\n     text \"GHCi-specific dynamic flag settings:\" $$\n         nest 2 (vcat (map (setting \"-f\" \"-fno-\" gopt) ghciFlags))\n  putStrLn $ showSDoc dflags $\n     text \"other dynamic, non-language, flag settings:\" $$\n         nest 2 (vcat (map (setting \"-f\" \"-fno-\" gopt) others))\n  putStrLn $ showSDoc dflags $\n     text \"warning settings:\" $$\n         nest 2 (vcat (map (setting \"-W\" \"-Wno-\" wopt) DynFlags.wWarningFlags))\n  where\n        setting prefix noPrefix test flag\n          | quiet     = empty\n          | is_on     = text prefix <> text name\n          | otherwise = text noPrefix <> text name\n          where name = flagSpecName flag\n                f = flagSpecFlag flag\n                is_on = test f dflags\n                quiet = not show_all && test f default_dflags == is_on\n\n        llvmConfig = (llvmTargets dflags, llvmPasses dflags)\n\n        default_dflags = defaultDynFlags (settings dflags) llvmConfig\n\n        (ghciFlags,others)  = partition (\\f -> flagSpecFlag f `elem` flgs)\n                                        DynFlags.fFlags\n        flgs = [ Opt_PrintExplicitForalls\n               , Opt_PrintExplicitKinds\n               , Opt_PrintUnicodeSyntax\n               , Opt_PrintBindResult\n               , Opt_BreakOnException\n               , Opt_BreakOnError\n               , Opt_PrintEvldWithShow\n               ]\n\nsetArgs, setOptions :: GhciMonad m => [String] -> m ()\nsetProg, setEditor, setStop :: GhciMonad m => String -> m ()\n\nsetArgs args = do\n  st <- getGHCiState\n  wrapper <- mkEvalWrapper (progname st) args\n  setGHCiState st { GhciMonad.args = args, evalWrapper = wrapper }\n\nsetProg prog = do\n  st <- getGHCiState\n  wrapper <- mkEvalWrapper prog (GhciMonad.args st)\n  setGHCiState st { progname = prog, evalWrapper = wrapper }\n\nsetEditor cmd = modifyGHCiState (\\st -> st { editor = cmd })\n\nsetStop str@(c:_) | isDigit c\n  = do let (nm_str,rest) = break (not.isDigit) str\n           nm = read nm_str\n       st <- getGHCiState\n       let old_breaks = breaks st\n       if all ((/= nm) . fst) old_breaks\n              then printForUser (text \"Breakpoint\" <+> ppr nm <+>\n                                 text \"does not exist\")\n              else do\n       let new_breaks = map fn old_breaks\n           fn (i,loc) | i == nm   = (i,loc { onBreakCmd = dropWhile isSpace rest })\n                      | otherwise = (i,loc)\n       setGHCiState st{ breaks = new_breaks }\nsetStop cmd = modifyGHCiState (\\st -> st { stop = cmd })\n\nsetPrompt :: GhciMonad m => PromptFunction -> m ()\nsetPrompt v = modifyGHCiState (\\st -> st {prompt = v})\n\nsetPromptCont :: GhciMonad m => PromptFunction -> m ()\nsetPromptCont v = modifyGHCiState (\\st -> st {prompt_cont = v})\n\nsetPromptFunc :: GHC.GhcMonad m => (PromptFunction -> m ()) -> String -> m ()\nsetPromptFunc fSetPrompt s = do\n    -- We explicitly annotate the type of the expression to ensure\n    -- that unsafeCoerce# is passed the exact type necessary rather\n    -- than a more general one\n    let exprStr = \"(\" ++ s ++ \") :: [String] -> Int -> IO String\"\n    (HValue funValue) <- GHC.compileExpr exprStr\n    fSetPrompt (convertToPromptFunction $ unsafeCoerce funValue)\n    where\n      convertToPromptFunction :: ([String] -> Int -> IO String)\n                              -> PromptFunction\n      convertToPromptFunction func = (\\mods line -> liftIO $\n                                       liftM text (func mods line))\n\nsetPromptString :: MonadIO m\n                => (PromptFunction -> m ()) -> String -> String -> m ()\nsetPromptString fSetPrompt value err = do\n  if null value\n    then liftIO $ hPutStrLn stderr $ err\n    else case value of\n           ('\\\"':_) ->\n             case reads value of\n               [(value', xs)] | all isSpace xs ->\n                 setParsedPromptString fSetPrompt value'\n               _ -> liftIO $ hPutStrLn stderr\n                             \"Can't parse prompt string. Use Haskell syntax.\"\n           _ ->\n             setParsedPromptString fSetPrompt value\n\nsetParsedPromptString :: MonadIO m\n                      => (PromptFunction -> m ()) ->  String -> m ()\nsetParsedPromptString fSetPrompt s = do\n  case (checkPromptStringForErrors s) of\n    Just err ->\n      liftIO $ hPutStrLn stderr err\n    Nothing ->\n      fSetPrompt $ generatePromptFunctionFromString s\n\nsetOptions wds =\n   do -- first, deal with the GHCi opts (+s, +t, etc.)\n      let (plus_opts, minus_opts)  = partitionWith isPlus wds\n      mapM_ setOpt plus_opts\n      -- then, dynamic flags\n      when (not (null minus_opts)) $ newDynFlags False minus_opts\n\nnewDynFlags :: GhciMonad m => Bool -> [String] -> m ()\nnewDynFlags interactive_only minus_opts = do\n      let lopts = map noLoc minus_opts\n\n      idflags0 <- GHC.getInteractiveDynFlags\n      (idflags1, leftovers, warns) <- GHC.parseDynamicFlags idflags0 lopts\n\n      liftIO $ handleFlagWarnings idflags1 warns\n      when (not $ null leftovers)\n           (throwGhcException . CmdLineError\n            $ \"Some flags have not been recognized: \"\n            ++ (concat . intersperse \", \" $ map unLoc leftovers))\n\n      when (interactive_only && packageFlagsChanged idflags1 idflags0) $ do\n          liftIO $ hPutStrLn stderr \"cannot set package flags with :seti; use :set\"\n      -- Load any new plugins\n      hsc_env0 <- GHC.getSession\n      idflags2 <- liftIO (initializePlugins hsc_env0 idflags1)\n      GHC.setInteractiveDynFlags idflags2\n      installInteractivePrint (interactivePrint idflags1) False\n\n      dflags0 <- getDynFlags\n\n      when (not interactive_only) $ do\n        (dflags1, _, _) <- liftIO $ GHC.parseDynamicFlags dflags0 lopts\n        new_pkgs <- GHC.setProgramDynFlags dflags1\n\n        -- if the package flags changed, reset the context and link\n        -- the new packages.\n        hsc_env <- GHC.getSession\n        let dflags2 = hsc_dflags hsc_env\n        when (packageFlagsChanged dflags2 dflags0) $ do\n          when (verbosity dflags2 > 0) $\n            liftIO . putStrLn $\n              \"package flags have changed, resetting and loading new packages...\"\n          GHC.setTargets []\n          _ <- GHC.load LoadAllTargets\n          liftIO $ linkPackages hsc_env new_pkgs\n          -- package flags changed, we can't re-use any of the old context\n          setContextAfterLoad False []\n          -- and copy the package state to the interactive DynFlags\n          idflags <- GHC.getInteractiveDynFlags\n          GHC.setInteractiveDynFlags\n              idflags{ pkgState = pkgState dflags2\n                     , pkgDatabase = pkgDatabase dflags2\n                     , packageFlags = packageFlags dflags2 }\n\n        let ld0length   = length $ ldInputs dflags0\n            fmrk0length = length $ cmdlineFrameworks dflags0\n\n            newLdInputs     = drop ld0length (ldInputs dflags2)\n            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)\n\n            hsc_env' = hsc_env { hsc_dflags =\n                         dflags2 { ldInputs = newLdInputs\n                                 , cmdlineFrameworks = newCLFrameworks } }\n\n        when (not (null newLdInputs && null newCLFrameworks)) $\n          liftIO $ linkCmdLineLibs hsc_env'\n\n      return ()\n\n\nunsetOptions :: GhciMonad m => String -> m ()\nunsetOptions str\n  =   -- first, deal with the GHCi opts (+s, +t, etc.)\n     let opts = words str\n         (minus_opts, rest1) = partition isMinus opts\n         (plus_opts, rest2)  = partitionWith isPlus rest1\n         (other_opts, rest3) = partition (`elem` map fst defaulters) rest2\n\n         defaulters =\n           [ (\"args\"   , setArgs default_args)\n           , (\"prog\"   , setProg default_progname)\n           , (\"prompt\"     , setPrompt default_prompt)\n           , (\"prompt-cont\", setPromptCont default_prompt_cont)\n           , (\"editor\" , liftIO findEditor >>= setEditor)\n           , (\"stop\"   , setStop default_stop)\n           ]\n\n         no_flag ('-':'f':rest) = return (\"-fno-\" ++ rest)\n         no_flag ('-':'X':rest) = return (\"-XNo\" ++ rest)\n         no_flag f = throwGhcException (ProgramError (\"don't know how to reverse \" ++ f))\n\n     in if (not (null rest3))\n           then liftIO (putStrLn (\"unknown option: '\" ++ head rest3 ++ \"'\"))\n           else do\n             mapM_ (fromJust.flip lookup defaulters) other_opts\n\n             mapM_ unsetOpt plus_opts\n\n             no_flags <- mapM no_flag minus_opts\n             when (not (null no_flags)) $ newDynFlags False no_flags\n\nisMinus :: String -> Bool\nisMinus ('-':_) = True\nisMinus _ = False\n\nisPlus :: String -> Either String String\nisPlus ('+':opt) = Left opt\nisPlus other     = Right other\n\nsetOpt, unsetOpt :: GhciMonad m => String -> m ()\n\nsetOpt str\n  = case strToGHCiOpt str of\n        Nothing -> liftIO (putStrLn (\"unknown option: '\" ++ str ++ \"'\"))\n        Just o  -> setOption o\n\nunsetOpt str\n  = case strToGHCiOpt str of\n        Nothing -> liftIO (putStrLn (\"unknown option: '\" ++ str ++ \"'\"))\n        Just o  -> unsetOption o\n\nstrToGHCiOpt :: String -> (Maybe GHCiOption)\nstrToGHCiOpt \"m\" = Just Multiline\nstrToGHCiOpt \"s\" = Just ShowTiming\nstrToGHCiOpt \"t\" = Just ShowType\nstrToGHCiOpt \"r\" = Just RevertCAFs\nstrToGHCiOpt \"c\" = Just CollectInfo\nstrToGHCiOpt _   = Nothing\n\noptToStr :: GHCiOption -> String\noptToStr Multiline  = \"m\"\noptToStr ShowTiming = \"s\"\noptToStr ShowType   = \"t\"\noptToStr RevertCAFs = \"r\"\noptToStr CollectInfo = \"c\"\n\n\n-- ---------------------------------------------------------------------------\n-- :show\n\nshowCmd :: forall m. GhciMonad m => String -> m ()\nshowCmd \"\"   = showOptions False\nshowCmd \"-a\" = showOptions True\nshowCmd str = do\n    st <- getGHCiState\n    dflags <- getDynFlags\n\n    let lookupCmd :: String -> Maybe (m ())\n        lookupCmd name = lookup name $ map (\\(_,b,c) -> (b,c)) cmds\n\n        -- (show in help?, command name, action)\n        action :: String -> m () -> (Bool, String, m ())\n        action name m = (True, name, m)\n\n        hidden :: String -> m () -> (Bool, String, m ())\n        hidden name m = (False, name, m)\n\n        cmds =\n            [ action \"args\"       $ liftIO $ putStrLn (show (GhciMonad.args st))\n            , action \"prog\"       $ liftIO $ putStrLn (show (progname st))\n            , action \"editor\"     $ liftIO $ putStrLn (show (editor st))\n            , action \"stop\"       $ liftIO $ putStrLn (show (stop st))\n            , action \"imports\"    $ showImports\n            , action \"modules\"    $ showModules\n            , action \"bindings\"   $ showBindings\n            , action \"linker\"     $ getDynFlags >>= liftIO . showLinkerState\n            , action \"breaks\"     $ showBkptTable\n            , action \"context\"    $ showContext\n            , action \"packages\"   $ showPackages\n            , action \"paths\"      $ showPaths\n            , action \"language\"   $ showLanguages\n            , hidden \"languages\"  $ showLanguages -- backwards compat\n            , hidden \"lang\"       $ showLanguages -- useful abbreviation\n            , action \"targets\"    $ showTargets\n            ]\n\n    case words str of\n      [w] | Just action <- lookupCmd w -> action\n\n      _ -> let helpCmds = [ text name | (True, name, _) <- cmds ]\n           in throwGhcException $ CmdLineError $ showSDoc dflags\n              $ hang (text \"syntax:\") 4\n              $ hang (text \":show\") 6\n              $ brackets (fsep $ punctuate (text \" |\") helpCmds)\n\nshowiCmd :: GHC.GhcMonad m => String -> m ()\nshowiCmd str = do\n  case words str of\n        [\"languages\"]  -> showiLanguages -- backwards compat\n        [\"language\"]   -> showiLanguages\n        [\"lang\"]       -> showiLanguages -- useful abbreviation\n        _ -> throwGhcException (CmdLineError (\"syntax:  :showi language\"))\n\nshowImports :: GhciMonad m => m ()\nshowImports = do\n  st <- getGHCiState\n  dflags <- getDynFlags\n  let rem_ctx   = reverse (remembered_ctx st)\n      trans_ctx = transient_ctx st\n\n      show_one (IIModule star_m)\n          = \":module +*\" ++ moduleNameString star_m\n      show_one (IIDecl imp) = showPpr dflags imp\n\n  prel_iidecls <- getImplicitPreludeImports (rem_ctx ++ trans_ctx)\n\n  let show_prel p = show_one p ++ \" -- implicit\"\n      show_extra p = show_one (IIDecl p) ++ \" -- fixed\"\n\n      trans_comment s = s ++ \" -- added automatically\" :: String\n  --\n  liftIO $ mapM_ putStrLn (map show_one rem_ctx ++\n                           map (trans_comment . show_one) trans_ctx ++\n                           map show_prel prel_iidecls ++\n                           map show_extra (extra_imports st))\n\nshowModules :: GHC.GhcMonad m => m ()\nshowModules = do\n  loaded_mods <- getLoadedModules\n        -- we want *loaded* modules only, see #1734\n  let show_one ms = do m <- GHC.showModule ms; liftIO (putStrLn m)\n  mapM_ show_one loaded_mods\n\ngetLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]\ngetLoadedModules = do\n  graph <- GHC.getModuleGraph\n  filterM (GHC.isLoaded . GHC.ms_mod_name) (GHC.mgModSummaries graph)\n\nshowBindings :: GHC.GhcMonad m => m ()\nshowBindings = do\n    bindings <- GHC.getBindings\n    (insts, finsts) <- GHC.getInsts\n    let idocs  = map GHC.pprInstanceHdr insts\n        fidocs = map GHC.pprFamInst finsts\n        binds = filter (not . isDerivedOccName . getOccName) bindings -- #12525\n        -- See Note [Filter bindings]\n    docs <- mapM makeDoc (reverse binds)\n                  -- reverse so the new ones come last\n    mapM_ printForUserPartWay (docs ++ idocs ++ fidocs)\n  where\n    makeDoc (AnId i) = pprTypeAndContents i\n    makeDoc tt = do\n        mb_stuff <- GHC.getInfo False (getName tt)\n        return $ maybe (text \"\") pprTT mb_stuff\n\n    pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\n    pprTT (thing, fixity, _cls_insts, _fam_insts, _docs)\n      = pprTyThing showToHeader thing\n        $$ show_fixity\n      where\n        show_fixity\n            | fixity == GHC.defaultFixity  = empty\n            | otherwise                    = ppr fixity <+> ppr (GHC.getName thing)\n\n\nprintTyThing :: GHC.GhcMonad m => TyThing -> m ()\nprintTyThing tyth = printForUser (pprTyThing showToHeader tyth)\n\n{-\nNote [Filter bindings]\n~~~~~~~~~~~~~~~~~~~~~~\n\nIf we don't filter the bindings returned by the function GHC.getBindings,\nthen the :show bindings command will also show unwanted bound names,\ninternally generated by GHC, eg:\n    $tcFoo :: GHC.Types.TyCon = _\n    $trModule :: GHC.Types.Module = _ .\n\nThe filter was introduced as a fix for Trac #12525 [1]. Comment:1 [2] to this\nticket contains an analysis of the situation and suggests the solution\nimplemented above.\n\nThe same filter was also implemented to fix Trac #11051 [3]. See the\nNote [What to show to users] in compiler/main/InteractiveEval.hs\n\n[1] https://ghc.haskell.org/trac/ghc/ticket/12525\n[2] https://ghc.haskell.org/trac/ghc/ticket/12525#comment:1\n[3] https://ghc.haskell.org/trac/ghc/ticket/11051\n-}\n\n\nshowBkptTable :: GhciMonad m => m ()\nshowBkptTable = do\n  st <- getGHCiState\n  printForUser $ prettyLocations (breaks st)\n\nshowContext :: GHC.GhcMonad m => m ()\nshowContext = do\n   resumes <- GHC.getResumeContext\n   printForUser $ vcat (map pp_resume (reverse resumes))\n  where\n   pp_resume res =\n        ptext (sLit \"--> \") <> text (GHC.resumeStmt res)\n        $$ nest 2 (pprStopped res)\n\npprStopped :: GHC.Resume -> SDoc\npprStopped res =\n  ptext (sLit \"Stopped in\")\n    <+> ((case mb_mod_name of\n           Nothing -> empty\n           Just mod_name -> text (moduleNameString mod_name) <> char '.')\n         <> text (GHC.resumeDecl res))\n    <> char ',' <+> ppr (GHC.resumeSpan res)\n where\n  mb_mod_name = moduleName <$> GHC.breakInfo_module <$> GHC.resumeBreakInfo res\n\nshowPackages :: GHC.GhcMonad m => m ()\nshowPackages = do\n  dflags <- getDynFlags\n  let pkg_flags = packageFlags dflags\n  liftIO $ putStrLn $ showSDoc dflags $\n    text (\"active package flags:\"++if null pkg_flags then \" none\" else \"\") $$\n      nest 2 (vcat (map pprFlag pkg_flags))\n\nshowPaths :: GHC.GhcMonad m => m ()\nshowPaths = do\n  dflags <- getDynFlags\n  liftIO $ do\n    cwd <- getCurrentDirectory\n    putStrLn $ showSDoc dflags $\n      text \"current working directory: \" $$\n        nest 2 (text cwd)\n    let ipaths = importPaths dflags\n    putStrLn $ showSDoc dflags $\n      text (\"module import search paths:\"++if null ipaths then \" none\" else \"\") $$\n        nest 2 (vcat (map text ipaths))\n\nshowLanguages :: GHC.GhcMonad m => m ()\nshowLanguages = getDynFlags >>= liftIO . showLanguages' False\n\nshowiLanguages :: GHC.GhcMonad m => m ()\nshowiLanguages = GHC.getInteractiveDynFlags >>= liftIO . showLanguages' False\n\nshowLanguages' :: Bool -> DynFlags -> IO ()\nshowLanguages' show_all dflags =\n  putStrLn $ showSDoc dflags $ vcat\n     [ text \"base language is: \" <>\n         case language dflags of\n           Nothing          -> text \"Haskell2010\"\n           Just Haskell98   -> text \"Haskell98\"\n           Just Haskell2010 -> text \"Haskell2010\"\n     , (if show_all then text \"all active language options:\"\n                    else text \"with the following modifiers:\") $$\n          nest 2 (vcat (map (setting xopt) DynFlags.xFlags))\n     ]\n  where\n   setting test flag\n          | quiet     = empty\n          | is_on     = text \"-X\" <> text name\n          | otherwise = text \"-XNo\" <> text name\n          where name = flagSpecName flag\n                f = flagSpecFlag flag\n                is_on = test f dflags\n                quiet = not show_all && test f default_dflags == is_on\n\n   llvmConfig = (llvmTargets dflags, llvmPasses dflags)\n\n   default_dflags =\n       defaultDynFlags (settings dflags) llvmConfig `lang_set`\n         case language dflags of\n           Nothing -> Just Haskell2010\n           other   -> other\n\nshowTargets :: GHC.GhcMonad m => m ()\nshowTargets = mapM_ showTarget =<< GHC.getTargets\n  where\n    showTarget :: GHC.GhcMonad m => Target -> m ()\n    showTarget (Target (TargetFile f _) _ _) = liftIO (putStrLn f)\n    showTarget (Target (TargetModule m) _ _) =\n      liftIO (putStrLn $ moduleNameString m)\n\n-- -----------------------------------------------------------------------------\n-- Completion\n\ncompleteCmd :: String -> GHCi ()\ncompleteCmd argLine0 = case parseLine argLine0 of\n    Just (\"repl\", resultRange, left) -> do\n        (unusedLine,compls) <- ghciCompleteWord (reverse left,\"\")\n        let compls' = takeRange resultRange compls\n        liftIO . putStrLn $ unwords [ show (length compls'), show (length compls), show (reverse unusedLine) ]\n        forM_ (takeRange resultRange compls) $ \\(Completion r _ _) -> do\n            liftIO $ print r\n    _ -> throwGhcException (CmdLineError \"Syntax: :complete repl [<range>] <quoted-string-to-complete>\")\n  where\n    parseLine argLine\n        | null argLine = Nothing\n        | null rest1   = Nothing\n        | otherwise    = (,,) dom <$> resRange <*> s\n      where\n        (dom, rest1) = breakSpace argLine\n        (rng, rest2) = breakSpace rest1\n        resRange | head rest1 == '\"' = parseRange \"\"\n                 | otherwise         = parseRange rng\n        s | head rest1 == '\"' = readMaybe rest1 :: Maybe String\n          | otherwise         = readMaybe rest2\n        breakSpace = fmap (dropWhile isSpace) . break isSpace\n\n    takeRange (lb,ub) = maybe id (drop . pred) lb . maybe id take ub\n\n    -- syntax: [n-][m] with semantics \"drop (n-1) . take m\"\n    parseRange :: String -> Maybe (Maybe Int,Maybe Int)\n    parseRange s = case span isDigit s of\n                   (_, \"\") ->\n                       -- upper limit only\n                       Just (Nothing, bndRead s)\n                   (s1, '-' : s2)\n                    | all isDigit s2 ->\n                       Just (bndRead s1, bndRead s2)\n                   _ ->\n                       Nothing\n      where\n        bndRead x = if null x then Nothing else Just (read x)\n\n\n\ncompleteGhciCommand, completeMacro, completeIdentifier, completeModule,\n    completeSetModule, completeSeti, completeShowiOptions,\n    completeHomeModule, completeSetOptions, completeShowOptions,\n    completeHomeModuleOrFile, completeExpression\n    :: GhciMonad m => CompletionFunc m\n\n-- | Provide completions for last word in a given string.\n--\n-- Takes a tuple of two strings.  First string is a reversed line to be\n-- completed.  Second string is likely unused, 'completeCmd' always passes an\n-- empty string as second item in tuple.\nghciCompleteWord :: CompletionFunc GHCi\nghciCompleteWord line@(left,_) = case firstWord of\n    -- If given string starts with `:` colon, and there is only one following\n    -- word then provide REPL command completions.  If there is more than one\n    -- word complete either filename or builtin ghci commands or macros.\n    ':':cmd     | null rest     -> completeGhciCommand line\n                | otherwise     -> do\n                        completion <- lookupCompletion cmd\n                        completion line\n    -- If given string starts with `import` keyword provide module name\n    -- completions\n    \"import\"    -> completeModule line\n    -- otherwise provide identifier completions\n    _           -> completeExpression line\n  where\n    (firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left\n    lookupCompletion ('!':_) = return completeFilename\n    lookupCompletion c = do\n        maybe_cmd <- lookupCommand' c\n        case maybe_cmd of\n            Just cmd -> return (cmdCompletionFunc cmd)\n            Nothing  -> return completeFilename\n\ncompleteGhciCommand = wrapCompleter \" \" $ \\w -> do\n  macros <- ghci_macros <$> getGHCiState\n  cmds   <- ghci_commands `fmap` getGHCiState\n  let macro_names = map (':':) . map cmdName $ macros\n  let command_names = map (':':) . map cmdName $ filter (not . cmdHidden) cmds\n  let{ candidates = case w of\n      ':' : ':' : _ -> map (':':) command_names\n      _ -> nub $ macro_names ++ command_names }\n  return $ filter (w `isPrefixOf`) candidates\n\ncompleteMacro = wrapIdentCompleter $ \\w -> do\n  cmds <- ghci_macros <$> getGHCiState\n  return (filter (w `isPrefixOf`) (map cmdName cmds))\n\ncompleteIdentifier line@(left, _) =\n  -- Note: `left` is a reversed input\n  case left of\n    (x:_) | isSymbolChar x -> wrapCompleter (specials ++ spaces) complete line\n    _                      -> wrapIdentCompleter complete line\n  where\n    complete w = do\n      rdrs <- GHC.getRdrNamesInScope\n      dflags <- GHC.getSessionDynFlags\n      return (filter (w `isPrefixOf`) (map (showPpr dflags) rdrs))\n\ncompleteModule = wrapIdentCompleter $ \\w -> do\n  dflags <- GHC.getSessionDynFlags\n  let pkg_mods = allVisibleModules dflags\n  loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules\n  return $ filter (w `isPrefixOf`)\n        $ map (showPpr dflags) $ loaded_mods ++ pkg_mods\n\ncompleteSetModule = wrapIdentCompleterWithModifier \"+-\" $ \\m w -> do\n  dflags <- GHC.getSessionDynFlags\n  modules <- case m of\n    Just '-' -> do\n      imports <- GHC.getContext\n      return $ map iiModuleName imports\n    _ -> do\n      let pkg_mods = allVisibleModules dflags\n      loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules\n      return $ loaded_mods ++ pkg_mods\n  return $ filter (w `isPrefixOf`) $ map (showPpr dflags) modules\n\ncompleteHomeModule = wrapIdentCompleter listHomeModules\n\nlistHomeModules :: GHC.GhcMonad m => String -> m [String]\nlistHomeModules w = do\n    g <- GHC.getModuleGraph\n    let home_mods = map GHC.ms_mod_name (GHC.mgModSummaries g)\n    dflags <- getDynFlags\n    return $ sort $ filter (w `isPrefixOf`)\n            $ map (showPpr dflags) home_mods\n\ncompleteSetOptions = wrapCompleter flagWordBreakChars $ \\w -> do\n  return (filter (w `isPrefixOf`) opts)\n    where opts = \"args\":\"prog\":\"prompt\":\"prompt-cont\":\"prompt-function\":\n                 \"prompt-cont-function\":\"editor\":\"stop\":flagList\n          flagList = map head $ group $ sort allNonDeprecatedFlags\n\ncompleteSeti = wrapCompleter flagWordBreakChars $ \\w -> do\n  return (filter (w `isPrefixOf`) flagList)\n    where flagList = map head $ group $ sort allNonDeprecatedFlags\n\ncompleteShowOptions = wrapCompleter flagWordBreakChars $ \\w -> do\n  return (filter (w `isPrefixOf`) opts)\n    where opts = [\"args\", \"prog\", \"editor\", \"stop\",\n                     \"modules\", \"bindings\", \"linker\", \"breaks\",\n                     \"context\", \"packages\", \"paths\", \"language\", \"imports\"]\n\ncompleteShowiOptions = wrapCompleter flagWordBreakChars $ \\w -> do\n  return (filter (w `isPrefixOf`) [\"language\"])\n\ncompleteHomeModuleOrFile = completeWord Nothing filenameWordBreakChars\n                $ unionComplete (fmap (map simpleCompletion) . listHomeModules)\n                            listFiles\n\nunionComplete :: Monad m => (a -> m [b]) -> (a -> m [b]) -> a -> m [b]\nunionComplete f1 f2 line = do\n  cs1 <- f1 line\n  cs2 <- f2 line\n  return (cs1 ++ cs2)\n\nwrapCompleter :: Monad m => String -> (String -> m [String]) -> CompletionFunc m\nwrapCompleter breakChars fun = completeWord Nothing breakChars\n    $ fmap (map simpleCompletion . nubSort) . fun\n\nwrapIdentCompleter :: Monad m => (String -> m [String]) -> CompletionFunc m\nwrapIdentCompleter = wrapCompleter word_break_chars\n\nwrapIdentCompleterWithModifier\n  :: Monad m\n  => String -> (Maybe Char -> String -> m [String]) -> CompletionFunc m\nwrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars\n    $ \\rest -> fmap (map simpleCompletion . nubSort) . fun (getModifier rest)\n where\n  getModifier = find (`elem` modifChars)\n\n-- | Return a list of visible module names for autocompletion.\n-- (NB: exposed != visible)\nallVisibleModules :: DynFlags -> [ModuleName]\nallVisibleModules dflags = listVisibleModuleNames dflags\n\ncompleteExpression = completeQuotedWord (Just '\\\\') \"\\\"\" listFiles\n                        completeIdentifier\n\n\n-- -----------------------------------------------------------------------------\n-- commands for debugger\n\nsprintCmd, printCmd, forceCmd :: GHC.GhcMonad m => String -> m ()\nsprintCmd = pprintClosureCommand False False\nprintCmd  = pprintClosureCommand True False\nforceCmd  = pprintClosureCommand False True\n\nstepCmd :: GhciMonad m => String -> m ()\nstepCmd arg = withSandboxOnly \":step\" $ step arg\n  where\n  step []         = doContinue (const True) GHC.SingleStep\n  step expression = runStmt expression GHC.SingleStep >> return ()\n\nstepLocalCmd :: GhciMonad m => String -> m ()\nstepLocalCmd arg = withSandboxOnly \":steplocal\" $ step arg\n  where\n  step expr\n   | not (null expr) = stepCmd expr\n   | otherwise = do\n      mb_span <- getCurrentBreakSpan\n      case mb_span of\n        Nothing  -> stepCmd []\n        Just loc -> do\n           md <- fromMaybe (panic \"stepLocalCmd\") <$> getCurrentBreakModule\n           current_toplevel_decl <- enclosingTickSpan md loc\n           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl) GHC.SingleStep\n\nstepModuleCmd :: GhciMonad m => String -> m ()\nstepModuleCmd arg = withSandboxOnly \":stepmodule\" $ step arg\n  where\n  step expr\n   | not (null expr) = stepCmd expr\n   | otherwise = do\n      mb_span <- getCurrentBreakSpan\n      case mb_span of\n        Nothing  -> stepCmd []\n        Just pan -> do\n           let f some_span = srcSpanFileName_maybe pan == srcSpanFileName_maybe some_span\n           doContinue f GHC.SingleStep\n\n-- | Returns the span of the largest tick containing the srcspan given\nenclosingTickSpan :: GhciMonad m => Module -> SrcSpan -> m RealSrcSpan\nenclosingTickSpan _ (UnhelpfulSpan _) = panic \"enclosingTickSpan UnhelpfulSpan\"\nenclosingTickSpan md (RealSrcSpan src) = do\n  ticks <- getTickArray md\n  let line = srcSpanStartLine src\n  ASSERT(inRange (bounds ticks) line) do\n  let enclosing_spans = [ pan | (_,pan) <- ticks ! line\n                               , realSrcSpanEnd pan >= realSrcSpanEnd src]\n  return . head . sortBy leftmostLargestRealSrcSpan $ enclosing_spans\n where\n\nleftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering\nleftmostLargestRealSrcSpan a b =\n  (realSrcSpanStart a `compare` realSrcSpanStart b)\n     `thenCmp`\n  (realSrcSpanEnd b `compare` realSrcSpanEnd a)\n\ntraceCmd :: GhciMonad m => String -> m ()\ntraceCmd arg\n  = withSandboxOnly \":trace\" $ tr arg\n  where\n  tr []         = doContinue (const True) GHC.RunAndLogSteps\n  tr expression = runStmt expression GHC.RunAndLogSteps >> return ()\n\ncontinueCmd :: GhciMonad m => String -> m ()\ncontinueCmd = noArgs $ withSandboxOnly \":continue\" $ doContinue (const True) GHC.RunToCompletion\n\ndoContinue :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> m ()\ndoContinue pre step = do\n  runResult <- resume pre step\n  _ <- afterRunStmt pre runResult\n  return ()\n\nabandonCmd :: GhciMonad m => String -> m ()\nabandonCmd = noArgs $ withSandboxOnly \":abandon\" $ do\n  b <- GHC.abandon -- the prompt will change to indicate the new context\n  when (not b) $ liftIO $ putStrLn \"There is no computation running.\"\n\ndeleteCmd :: GhciMonad m => String -> m ()\ndeleteCmd argLine = withSandboxOnly \":delete\" $ do\n   deleteSwitch $ words argLine\n   where\n   deleteSwitch :: GhciMonad m => [String] -> m ()\n   deleteSwitch [] =\n      liftIO $ putStrLn \"The delete command requires at least one argument.\"\n   -- delete all break points\n   deleteSwitch (\"*\":_rest) = discardActiveBreakPoints\n   deleteSwitch idents = do\n      mapM_ deleteOneBreak idents\n      where\n      deleteOneBreak :: GhciMonad m => String -> m ()\n      deleteOneBreak str\n         | all isDigit str = deleteBreak (read str)\n         | otherwise = return ()\n\nhistoryCmd :: GHC.GhcMonad m => String -> m ()\nhistoryCmd arg\n  | null arg        = history 20\n  | all isDigit arg = history (read arg)\n  | otherwise       = liftIO $ putStrLn \"Syntax:  :history [num]\"\n  where\n  history num = do\n    resumes <- GHC.getResumeContext\n    case resumes of\n      [] -> liftIO $ putStrLn \"Not stopped at a breakpoint\"\n      (r:_) -> do\n        let hist = GHC.resumeHistory r\n            (took,rest) = splitAt num hist\n        case hist of\n          [] -> liftIO $ putStrLn $\n                   \"Empty history. Perhaps you forgot to use :trace?\"\n          _  -> do\n                 pans <- mapM GHC.getHistorySpan took\n                 let nums  = map (printf \"-%-3d:\") [(1::Int)..]\n                     names = map GHC.historyEnclosingDecls took\n                 printForUser (vcat(zipWith3\n                                 (\\x y z -> x <+> y <+> z)\n                                 (map text nums)\n                                 (map (bold . hcat . punctuate colon . map text) names)\n                                 (map (parens . ppr) pans)))\n                 liftIO $ putStrLn $ if null rest then \"<end of history>\" else \"...\"\n\nbold :: SDoc -> SDoc\nbold c | do_bold   = text start_bold <> c <> text end_bold\n       | otherwise = c\n\nbackCmd :: GhciMonad m => String -> m ()\nbackCmd arg\n  | null arg        = back 1\n  | all isDigit arg = back (read arg)\n  | otherwise       = liftIO $ putStrLn \"Syntax:  :back [num]\"\n  where\n  back num = withSandboxOnly \":back\" $ do\n      (names, _, pan, _) <- GHC.back num\n      printForUser $ ptext (sLit \"Logged breakpoint at\") <+> ppr pan\n      printTypeOfNames names\n       -- run the command set with \":set stop <cmd>\"\n      st <- getGHCiState\n      enqueueCommands [stop st]\n\nforwardCmd :: GhciMonad m => String -> m ()\nforwardCmd arg\n  | null arg        = forward 1\n  | all isDigit arg = forward (read arg)\n  | otherwise       = liftIO $ putStrLn \"Syntax:  :back [num]\"\n  where\n  forward num = withSandboxOnly \":forward\" $ do\n      (names, ix, pan, _) <- GHC.forward num\n      printForUser $ (if (ix == 0)\n                        then ptext (sLit \"Stopped at\")\n                        else ptext (sLit \"Logged breakpoint at\")) <+> ppr pan\n      printTypeOfNames names\n       -- run the command set with \":set stop <cmd>\"\n      st <- getGHCiState\n      enqueueCommands [stop st]\n\n-- handle the \"break\" command\nbreakCmd :: GhciMonad m => String -> m ()\nbreakCmd argLine = withSandboxOnly \":break\" $ breakSwitch $ words argLine\n\nbreakSwitch :: GhciMonad m => [String] -> m ()\nbreakSwitch [] = do\n   liftIO $ putStrLn \"The break command requires at least one argument.\"\nbreakSwitch (arg1:rest)\n   | looksLikeModuleName arg1 && not (null rest) = do\n        md <- wantInterpretedModule arg1\n        breakByModule md rest\n   | all isDigit arg1 = do\n        imports <- GHC.getContext\n        case iiModules imports of\n           (mn : _) -> do\n              md <- lookupModuleName mn\n              breakByModuleLine md (read arg1) rest\n           [] -> do\n              liftIO $ putStrLn \"No modules are loaded with debugging support.\"\n   | otherwise = do -- try parsing it as an identifier\n        wantNameFromInterpretedModule noCanDo arg1 $ \\name -> do\n        maybe_info <- GHC.getModuleInfo (GHC.nameModule name)\n        case maybe_info of\n          Nothing -> noCanDo name (ptext (sLit \"cannot get module info\"))\n          Just minf ->\n               ASSERT( isExternalName name )\n                    findBreakAndSet (GHC.nameModule name) $\n                       findBreakForBind name (GHC.modInfoModBreaks minf)\n       where\n          noCanDo n why = printForUser $\n                text \"cannot set breakpoint on \" <> ppr n <> text \": \" <> why\n\nbreakByModule :: GhciMonad m => Module -> [String] -> m ()\nbreakByModule md (arg1:rest)\n   | all isDigit arg1 = do  -- looks like a line number\n        breakByModuleLine md (read arg1) rest\nbreakByModule _ _\n   = breakSyntax\n\nbreakByModuleLine :: GhciMonad m => Module -> Int -> [String] -> m ()\nbreakByModuleLine md line args\n   | [] <- args = findBreakAndSet md $ maybeToList . findBreakByLine line\n   | [col] <- args, all isDigit col =\n        findBreakAndSet md $ maybeToList . findBreakByCoord Nothing (line, read col)\n   | otherwise = breakSyntax\n\nbreakSyntax :: a\nbreakSyntax = throwGhcException (CmdLineError \"Syntax: :break [<mod>] <line> [<column>]\")\n\nfindBreakAndSet :: GhciMonad m\n                => Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()\nfindBreakAndSet md lookupTickTree = do\n   tickArray <- getTickArray md\n   (breakArray, _) <- getModBreak md\n   case lookupTickTree tickArray of\n      []  -> liftIO $ putStrLn $ \"No breakpoints found at that location.\"\n      some -> mapM_ (breakAt breakArray) some\n where\n   breakAt breakArray (tick, pan) = do\n         setBreakFlag True breakArray tick\n         (alreadySet, nm) <-\n               recordBreak $ BreakLocation\n                       { breakModule = md\n                       , breakLoc = RealSrcSpan pan\n                       , breakTick = tick\n                       , onBreakCmd = \"\"\n                       }\n         printForUser $\n            text \"Breakpoint \" <> ppr nm <>\n            if alreadySet\n               then text \" was already set at \" <> ppr pan\n               else text \" activated at \" <> ppr pan\n\n-- When a line number is specified, the current policy for choosing\n-- the best breakpoint is this:\n--    - the leftmost complete subexpression on the specified line, or\n--    - the leftmost subexpression starting on the specified line, or\n--    - the rightmost subexpression enclosing the specified line\n--\nfindBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,RealSrcSpan)\nfindBreakByLine line arr\n  | not (inRange (bounds arr) line) = Nothing\n  | otherwise =\n    listToMaybe (sortBy (leftmostLargestRealSrcSpan `on` snd)  comp)   `mplus`\n    listToMaybe (sortBy (compare `on` snd) incomp) `mplus`\n    listToMaybe (sortBy (flip compare `on` snd) ticks)\n  where\n        ticks = arr ! line\n\n        starts_here = [ (ix,pan) | (ix, pan) <- ticks,\n                        GHC.srcSpanStartLine pan == line ]\n\n        (comp, incomp) = partition ends_here starts_here\n            where ends_here (_,pan) = GHC.srcSpanEndLine pan == line\n\n-- The aim is to find the breakpoints for all the RHSs of the\n-- equations corresponding to a binding.  So we find all breakpoints\n-- for\n--   (a) this binder only (not a nested declaration)\n--   (b) that do not have an enclosing breakpoint\nfindBreakForBind :: Name -> GHC.ModBreaks -> TickArray\n                 -> [(BreakIndex,RealSrcSpan)]\nfindBreakForBind name modbreaks _ = filter (not . enclosed) ticks\n  where\n    ticks = [ (index, span)\n            | (index, [n]) <- assocs (GHC.modBreaks_decls modbreaks),\n              n == occNameString (nameOccName name),\n              RealSrcSpan span <- [GHC.modBreaks_locs modbreaks ! index] ]\n    enclosed (_,sp0) = any subspan ticks\n      where subspan (_,sp) = sp /= sp0 &&\n                         realSrcSpanStart sp <= realSrcSpanStart sp0 &&\n                         realSrcSpanEnd sp0 <= realSrcSpanEnd sp\n\nfindBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray\n                 -> Maybe (BreakIndex,RealSrcSpan)\nfindBreakByCoord mb_file (line, col) arr\n  | not (inRange (bounds arr) line) = Nothing\n  | otherwise =\n    listToMaybe (sortBy (flip compare `on` snd) contains ++\n                 sortBy (compare `on` snd) after_here)\n  where\n        ticks = arr ! line\n\n        -- the ticks that span this coordinate\n        contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan `spans` (line,col),\n                            is_correct_file pan ]\n\n        is_correct_file pan\n                 | Just f <- mb_file = GHC.srcSpanFile pan == f\n                 | otherwise         = True\n\n        after_here = [ tick | tick@(_,pan) <- ticks,\n                              GHC.srcSpanStartLine pan == line,\n                              GHC.srcSpanStartCol pan >= col ]\n\n-- For now, use ANSI bold on terminals that we know support it.\n-- Otherwise, we add a line of carets under the active expression instead.\n-- In particular, on Windows and when running the testsuite (which sets\n-- TERM to vt100 for other reasons) we get carets.\n-- We really ought to use a proper termcap/terminfo library.\ndo_bold :: Bool\ndo_bold = (`isPrefixOf` unsafePerformIO mTerm) `any` [\"xterm\", \"linux\"]\n    where mTerm = System.Environment.getEnv \"TERM\"\n                  `catchIO` \\_ -> return \"TERM not set\"\n\nstart_bold :: String\nstart_bold = \"\\ESC[1m\"\nend_bold :: String\nend_bold   = \"\\ESC[0m\"\n\n-----------------------------------------------------------------------------\n-- :where\n\nwhereCmd :: GHC.GhcMonad m => String -> m ()\nwhereCmd = noArgs $ do\n  mstrs <- getCallStackAtCurrentBreakpoint\n  case mstrs of\n    Nothing -> return ()\n    Just strs -> liftIO $ putStrLn (renderStack strs)\n\n-----------------------------------------------------------------------------\n-- :list\n\nlistCmd :: GhciMonad m => String -> m ()\nlistCmd \"\" = do\n   mb_span <- getCurrentBreakSpan\n   case mb_span of\n      Nothing ->\n          printForUser $ text \"Not stopped at a breakpoint; nothing to list\"\n      Just (RealSrcSpan pan) ->\n          listAround pan True\n      Just pan@(UnhelpfulSpan _) ->\n          do resumes <- GHC.getResumeContext\n             case resumes of\n                 [] -> panic \"No resumes\"\n                 (r:_) ->\n                     do let traceIt = case GHC.resumeHistory r of\n                                      [] -> text \"rerunning with :trace,\"\n                                      _ -> empty\n                            doWhat = traceIt <+> text \":back then :list\"\n                        printForUser (text \"Unable to list source for\" <+>\n                                      ppr pan\n                                   $$ text \"Try\" <+> doWhat)\nlistCmd str = list2 (words str)\n\nlist2 :: GhciMonad m => [String] -> m ()\nlist2 [arg] | all isDigit arg = do\n    imports <- GHC.getContext\n    case iiModules imports of\n        [] -> liftIO $ putStrLn \"No module to list\"\n        (mn : _) -> do\n          md <- lookupModuleName mn\n          listModuleLine md (read arg)\nlist2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do\n        md <- wantInterpretedModule arg1\n        listModuleLine md (read arg2)\nlist2 [arg] = do\n        wantNameFromInterpretedModule noCanDo arg $ \\name -> do\n        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)\n        case loc of\n            RealSrcLoc l ->\n               do tickArray <- ASSERT( isExternalName name )\n                               getTickArray (GHC.nameModule name)\n                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile l))\n                                        (GHC.srcLocLine l, GHC.srcLocCol l)\n                                        tickArray\n                  case mb_span of\n                    Nothing       -> listAround (realSrcLocSpan l) False\n                    Just (_, pan) -> listAround pan False\n            UnhelpfulLoc _ ->\n                  noCanDo name $ text \"can't find its location: \" <>\n                                 ppr loc\n    where\n        noCanDo n why = printForUser $\n            text \"cannot list source code for \" <> ppr n <> text \": \" <> why\nlist2  _other =\n        liftIO $ putStrLn \"syntax:  :list [<line> | <module> <line> | <identifier>]\"\n\nlistModuleLine :: GHC.GhcMonad m => Module -> Int -> m ()\nlistModuleLine modl line = do\n   graph <- GHC.getModuleGraph\n   let this = GHC.mgLookupModule graph modl\n   case this of\n     Nothing -> panic \"listModuleLine\"\n     Just summ -> do\n           let filename = expectJust \"listModuleLine\" (ml_hs_file (GHC.ms_location summ))\n               loc = mkRealSrcLoc (mkFastString (filename)) line 0\n           listAround (realSrcLocSpan loc) False\n\n-- | list a section of a source file around a particular SrcSpan.\n-- If the highlight flag is True, also highlight the span using\n-- start_bold\\/end_bold.\n\n-- GHC files are UTF-8, so we can implement this by:\n-- 1) read the file in as a BS and syntax highlight it as before\n-- 2) convert the BS to String using utf-string, and write it out.\n-- It would be better if we could convert directly between UTF-8 and the\n-- console encoding, of course.\nlistAround :: MonadIO m => RealSrcSpan -> Bool -> m ()\nlistAround pan do_highlight = do\n      contents <- liftIO $ BS.readFile (unpackFS file)\n      -- Drop carriage returns to avoid duplicates, see #9367.\n      let ls  = BS.split '\\n' $ BS.filter (/= '\\r') contents\n          ls' = take (line2 - line1 + 1 + pad_before + pad_after) $\n                        drop (line1 - 1 - pad_before) $ ls\n          fst_line = max 1 (line1 - pad_before)\n          line_nos = [ fst_line .. ]\n\n          highlighted | do_highlight = zipWith highlight line_nos ls'\n                      | otherwise    = [\\p -> BS.concat[p,l] | l <- ls']\n\n          bs_line_nos = [ BS.pack (show l ++ \"  \") | l <- line_nos ]\n          prefixed = zipWith ($) highlighted bs_line_nos\n          output   = BS.intercalate (BS.pack \"\\n\") prefixed\n\n      let utf8Decoded = utf8DecodeByteString output\n      liftIO $ putStrLn utf8Decoded\n  where\n        file  = GHC.srcSpanFile pan\n        line1 = GHC.srcSpanStartLine pan\n        col1  = GHC.srcSpanStartCol pan - 1\n        line2 = GHC.srcSpanEndLine pan\n        col2  = GHC.srcSpanEndCol pan - 1\n\n        pad_before | line1 == 1 = 0\n                   | otherwise  = 1\n        pad_after = 1\n\n        highlight | do_bold   = highlight_bold\n                  | otherwise = highlight_carets\n\n        highlight_bold no line prefix\n          | no == line1 && no == line2\n          = let (a,r) = BS.splitAt col1 line\n                (b,c) = BS.splitAt (col2-col1) r\n            in\n            BS.concat [prefix, a,BS.pack start_bold,b,BS.pack end_bold,c]\n          | no == line1\n          = let (a,b) = BS.splitAt col1 line in\n            BS.concat [prefix, a, BS.pack start_bold, b]\n          | no == line2\n          = let (a,b) = BS.splitAt col2 line in\n            BS.concat [prefix, a, BS.pack end_bold, b]\n          | otherwise   = BS.concat [prefix, line]\n\n        highlight_carets no line prefix\n          | no == line1 && no == line2\n          = BS.concat [prefix, line, nl, indent, BS.replicate col1 ' ',\n                                         BS.replicate (col2-col1) '^']\n          | no == line1\n          = BS.concat [indent, BS.replicate (col1 - 2) ' ', BS.pack \"vv\", nl,\n                                         prefix, line]\n          | no == line2\n          = BS.concat [prefix, line, nl, indent, BS.replicate col2 ' ',\n                                         BS.pack \"^^\"]\n          | otherwise   = BS.concat [prefix, line]\n         where\n           indent = BS.pack (\"  \" ++ replicate (length (show no)) ' ')\n           nl = BS.singleton '\\n'\n\n\n-- --------------------------------------------------------------------------\n-- Tick arrays\n\ngetTickArray :: GhciMonad m => Module -> m TickArray\ngetTickArray modl = do\n   st <- getGHCiState\n   let arrmap = tickarrays st\n   case lookupModuleEnv arrmap modl of\n      Just arr -> return arr\n      Nothing  -> do\n        (_breakArray, ticks) <- getModBreak modl\n        let arr = mkTickArray (assocs ticks)\n        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}\n        return arr\n\ndiscardTickArrays :: GhciMonad m => m ()\ndiscardTickArrays = modifyGHCiState (\\st -> st {tickarrays = emptyModuleEnv})\n\nmkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray\nmkTickArray ticks\n  = accumArray (flip (:)) [] (1, max_line)\n        [ (line, (nm,pan)) | (nm,RealSrcSpan pan) <- ticks, line <- srcSpanLines pan ]\n    where\n        max_line = foldr max 0 [ GHC.srcSpanEndLine sp | (_, RealSrcSpan sp) <- ticks ]\n        srcSpanLines pan = [ GHC.srcSpanStartLine pan ..  GHC.srcSpanEndLine pan ]\n\n-- don't reset the counter back to zero?\ndiscardActiveBreakPoints :: GhciMonad m => m ()\ndiscardActiveBreakPoints = do\n   st <- getGHCiState\n   mapM_ (turnOffBreak.snd) (breaks st)\n   setGHCiState $ st { breaks = [] }\n\ndeleteBreak :: GhciMonad m => Int -> m ()\ndeleteBreak identity = do\n   st <- getGHCiState\n   let oldLocations    = breaks st\n       (this,rest)     = partition (\\loc -> fst loc == identity) oldLocations\n   if null this\n      then printForUser (text \"Breakpoint\" <+> ppr identity <+>\n                         text \"does not exist\")\n      else do\n           mapM_ (turnOffBreak.snd) this\n           setGHCiState $ st { breaks = rest }\n\nturnOffBreak :: GHC.GhcMonad m => BreakLocation -> m ()\nturnOffBreak loc = do\n  (arr, _) <- getModBreak (breakModule loc)\n  hsc_env <- GHC.getSession\n  liftIO $ enableBreakpoint hsc_env arr (breakTick loc) False\n\ngetModBreak :: GHC.GhcMonad m\n            => Module -> m (ForeignRef BreakArray, Array Int SrcSpan)\ngetModBreak m = do\n   mod_info      <- fromMaybe (panic \"getModBreak\") <$> GHC.getModuleInfo m\n   let modBreaks  = GHC.modInfoModBreaks mod_info\n   let arr        = GHC.modBreaks_flags modBreaks\n   let ticks      = GHC.modBreaks_locs  modBreaks\n   return (arr, ticks)\n\nsetBreakFlag :: GHC.GhcMonad m => Bool -> ForeignRef BreakArray -> Int -> m ()\nsetBreakFlag toggle arr i = do\n  hsc_env <- GHC.getSession\n  liftIO $ enableBreakpoint hsc_env arr i toggle\n\n-- ---------------------------------------------------------------------------\n-- User code exception handling\n\n-- This is the exception handler for exceptions generated by the\n-- user's code and exceptions coming from children sessions;\n-- it normally just prints out the exception.  The\n-- handler must be recursive, in case showing the exception causes\n-- more exceptions to be raised.\n--\n-- Bugfix: if the user closed stdout or stderr, the flushing will fail,\n-- raising another exception.  We therefore don't put the recursive\n-- handler arond the flushing operation, so if stderr is closed\n-- GHCi will just die gracefully rather than going into an infinite loop.\nhandler :: GhciMonad m => SomeException -> m Bool\nhandler exception = do\n  flushInterpBuffers\n  withSignalHandlers $\n     ghciHandle handler (showException exception >> return False)\n\nshowException :: MonadIO m => SomeException -> m ()\nshowException se =\n  liftIO $ case fromException se of\n           -- omit the location for CmdLineError:\n           Just (CmdLineError s)    -> putException s\n           -- ditto:\n           Just other_ghc_ex        -> putException (show other_ghc_ex)\n           Nothing                  ->\n               case fromException se of\n               Just UserInterrupt -> putException \"Interrupted.\"\n               _                  -> putException (\"*** Exception: \" ++ show se)\n  where\n    putException = hPutStrLn stderr\n\n\n-----------------------------------------------------------------------------\n-- recursive exception handlers\n\n-- Don't forget to unblock async exceptions in the handler, or if we're\n-- in an exception loop (eg. let a = error a in a) the ^C exception\n-- may never be delivered.  Thanks to Marcin for pointing out the bug.\n\nghciHandle :: (HasDynFlags m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a\nghciHandle h m = gmask $ \\restore -> do\n                 -- Force dflags to avoid leaking the associated HscEnv\n                 !dflags <- getDynFlags\n                 gcatch (restore (GHC.prettyPrintGhcErrors dflags m)) $ \\e -> restore (h e)\n\nghciTry :: ExceptionMonad m => m a -> m (Either SomeException a)\nghciTry m = fmap Right m `gcatch` \\e -> return $ Left e\n\ntryBool :: ExceptionMonad m => m a -> m Bool\ntryBool m = do\n    r <- ghciTry m\n    case r of\n      Left _  -> return False\n      Right _ -> return True\n\n-- ----------------------------------------------------------------------------\n-- Utils\n\nlookupModule :: GHC.GhcMonad m => String -> m Module\nlookupModule mName = lookupModuleName (GHC.mkModuleName mName)\n\nlookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module\nlookupModuleName mName = GHC.lookupModule mName Nothing\n\nisHomeModule :: Module -> Bool\nisHomeModule m = GHC.moduleUnitId m == mainUnitId\n\n-- TODO: won't work if home dir is encoded.\n-- (changeDirectory may not work either in that case.)\nexpandPath :: MonadIO m => String -> m String\nexpandPath = liftIO . expandPathIO\n\nexpandPathIO :: String -> IO String\nexpandPathIO p =\n  case dropWhile isSpace p of\n   ('~':d) -> do\n        tilde <- getHomeDirectory -- will fail if HOME not defined\n        return (tilde ++ '/':d)\n   other ->\n        return other\n\nwantInterpretedModule :: GHC.GhcMonad m => String -> m Module\nwantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)\n\nwantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module\nwantInterpretedModuleName modname = do\n   modl <- lookupModuleName modname\n   let str = moduleNameString modname\n   dflags <- getDynFlags\n   when (GHC.moduleUnitId modl /= thisPackage dflags) $\n      throwGhcException (CmdLineError (\"module '\" ++ str ++ \"' is from another package;\\nthis command requires an interpreted module\"))\n   is_interpreted <- GHC.moduleIsInterpreted modl\n   when (not is_interpreted) $\n       throwGhcException (CmdLineError (\"module '\" ++ str ++ \"' is not interpreted; try \\':add *\" ++ str ++ \"' first\"))\n   return modl\n\nwantNameFromInterpretedModule :: GHC.GhcMonad m\n                              => (Name -> SDoc -> m ())\n                              -> String\n                              -> (Name -> m ())\n                              -> m ()\nwantNameFromInterpretedModule noCanDo str and_then =\n  handleSourceError GHC.printException $ do\n   names <- GHC.parseName str\n   case names of\n      []    -> return ()\n      (n:_) -> do\n            let modl = ASSERT( isExternalName n ) GHC.nameModule n\n            if not (GHC.isExternalName n)\n               then noCanDo n $ ppr n <>\n                                text \" is not defined in an interpreted module\"\n               else do\n            is_interpreted <- GHC.moduleIsInterpreted modl\n            if not is_interpreted\n               then noCanDo n $ text \"module \" <> ppr modl <>\n                                text \" is not interpreted\"\n               else and_then n\n", "num_lines": 4002}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase          #-}\n{-# LANGUAGE RankNTypes          #-}\n{-# LANGUAGE OverloadedStrings   #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE ViewPatterns        #-}\n\n-- | Get information on modules, expressions, and identifiers\nmodule GHCi.UI.Info\n    ( ModInfo(..)\n    , SpanInfo(..)\n    , spanInfoFromRealSrcSpan\n    , collectInfo\n    , findLoc\n    , findNameUses\n    , findType\n    , getModInfo\n    ) where\n\nimport           Control.Exception\nimport           Control.Monad\nimport           Control.Monad.Trans.Class\nimport           Control.Monad.Trans.Except\nimport           Control.Monad.Trans.Maybe\nimport           Data.Data\nimport           Data.Function\nimport           Data.List\nimport           Data.Map.Strict   (Map)\nimport qualified Data.Map.Strict   as M\nimport           Data.Maybe\nimport           Data.Time\nimport           Prelude           hiding (mod,(<>))\nimport           System.Directory\n\nimport qualified CoreUtils\nimport           Desugar\nimport           DynFlags (HasDynFlags(..))\nimport           FastString\nimport           GHC\nimport           GhcMonad\nimport           Name\nimport           NameSet\nimport           Outputable\nimport           SrcLoc\nimport           TcHsSyn\nimport           Var\n\n-- | Info about a module. This information is generated every time a\n-- module is loaded.\ndata ModInfo = ModInfo\n    { modinfoSummary    :: !ModSummary\n      -- ^ Summary generated by GHC. Can be used to access more\n      -- information about the module.\n    , modinfoSpans      :: [SpanInfo]\n      -- ^ Generated set of information about all spans in the\n      -- module that correspond to some kind of identifier for\n      -- which there will be type info and/or location info.\n    , modinfoInfo       :: !ModuleInfo\n      -- ^ Again, useful from GHC for accessing information\n      -- (exports, instances, scope) from a module.\n    , modinfoLastUpdate :: !UTCTime\n      -- ^ The timestamp of the file used to generate this record.\n    }\n\n-- | Type of some span of source code. Most of these fields are\n-- unboxed but Haddock doesn't show that.\ndata SpanInfo = SpanInfo\n    { spaninfoSrcSpan   :: {-# UNPACK #-} !RealSrcSpan\n      -- ^ The span we associate information with\n    , spaninfoType      :: !(Maybe Type)\n      -- ^ The 'Type' associated with the span\n    , spaninfoVar       :: !(Maybe Id)\n      -- ^ The actual 'Var' associated with the span, if\n      -- any. This can be useful for accessing a variety of\n      -- information about the identifier such as module,\n      -- locality, definition location, etc.\n    }\n\n-- | Test whether second span is contained in (or equal to) first span.\n-- This is basically 'containsSpan' for 'SpanInfo'\ncontainsSpanInfo :: SpanInfo -> SpanInfo -> Bool\ncontainsSpanInfo = containsSpan `on` spaninfoSrcSpan\n\n-- | Filter all 'SpanInfo' which are contained in 'SpanInfo'\nspaninfosWithin :: [SpanInfo] -> SpanInfo -> [SpanInfo]\nspaninfosWithin spans' si = filter (si `containsSpanInfo`) spans'\n\n-- | Construct a 'SpanInfo' from a 'RealSrcSpan' and optionally a\n-- 'Type' and an 'Id' (for 'spaninfoType' and 'spaninfoVar'\n-- respectively)\nspanInfoFromRealSrcSpan :: RealSrcSpan -> Maybe Type -> Maybe Id -> SpanInfo\nspanInfoFromRealSrcSpan spn mty mvar =\n    SpanInfo spn mty mvar\n\n-- | Convenience wrapper around 'spanInfoFromRealSrcSpan' which needs\n-- only a 'RealSrcSpan'\nspanInfoFromRealSrcSpan' :: RealSrcSpan -> SpanInfo\nspanInfoFromRealSrcSpan' s = spanInfoFromRealSrcSpan s Nothing Nothing\n\n-- | Convenience wrapper around 'srcSpanFile' which results in a 'FilePath'\nsrcSpanFilePath :: RealSrcSpan -> FilePath\nsrcSpanFilePath = unpackFS . srcSpanFile\n\n-- | Try to find the location of the given identifier at the given\n-- position in the module.\nfindLoc :: GhcMonad m\n        => Map ModuleName ModInfo\n        -> RealSrcSpan\n        -> String\n        -> ExceptT SDoc m (ModInfo,Name,SrcSpan)\nfindLoc infos span0 string = do\n    name  <- maybeToExceptT \"Couldn't guess that module name. Does it exist?\" $\n             guessModule infos (srcSpanFilePath span0)\n\n    info  <- maybeToExceptT \"No module info for current file! Try loading it?\" $\n             MaybeT $ pure $ M.lookup name infos\n\n    name' <- findName infos span0 info string\n\n    case getSrcSpan name' of\n        UnhelpfulSpan{} -> do\n            throwE (\"Found a name, but no location information.\" <+>\n                    \"The module is:\" <+>\n                    maybe \"<unknown>\" (ppr . moduleName)\n                          (nameModule_maybe name'))\n\n        span' -> return (info,name',span')\n\n-- | Find any uses of the given identifier in the codebase.\nfindNameUses :: (GhcMonad m)\n             => Map ModuleName ModInfo\n             -> RealSrcSpan\n             -> String\n             -> ExceptT SDoc m [SrcSpan]\nfindNameUses infos span0 string =\n    locToSpans <$> findLoc infos span0 string\n  where\n    locToSpans (modinfo,name',span') =\n        stripSurrounding (span' : map toSrcSpan spans)\n      where\n        toSrcSpan = RealSrcSpan . spaninfoSrcSpan\n        spans = filter ((== Just name') . fmap getName . spaninfoVar)\n                       (modinfoSpans modinfo)\n\n-- | Filter out redundant spans which surround/contain other spans.\nstripSurrounding :: [SrcSpan] -> [SrcSpan]\nstripSurrounding xs = filter (not . isRedundant) xs\n  where\n    isRedundant x = any (x `strictlyContains`) xs\n\n    (RealSrcSpan s1) `strictlyContains` (RealSrcSpan s2)\n         = s1 /= s2 && s1 `containsSpan` s2\n    _                `strictlyContains` _ = False\n\n-- | Try to resolve the name located at the given position, or\n-- otherwise resolve based on the current module's scope.\nfindName :: GhcMonad m\n         => Map ModuleName ModInfo\n         -> RealSrcSpan\n         -> ModInfo\n         -> String\n         -> ExceptT SDoc m Name\nfindName infos span0 mi string =\n    case resolveName (modinfoSpans mi) (spanInfoFromRealSrcSpan' span0) of\n      Nothing -> tryExternalModuleResolution\n      Just name ->\n        case getSrcSpan name of\n          UnhelpfulSpan {} -> tryExternalModuleResolution\n          RealSrcSpan   {} -> return (getName name)\n  where\n    tryExternalModuleResolution =\n      case find (matchName $ mkFastString string)\n                (fromMaybe [] (modInfoTopLevelScope (modinfoInfo mi))) of\n        Nothing -> throwE \"Couldn't resolve to any modules.\"\n        Just imported -> resolveNameFromModule infos imported\n\n    matchName :: FastString -> Name -> Bool\n    matchName str name =\n      str ==\n      occNameFS (getOccName name)\n\n-- | Try to resolve the name from another (loaded) module's exports.\nresolveNameFromModule :: GhcMonad m\n                      => Map ModuleName ModInfo\n                      -> Name\n                      -> ExceptT SDoc m Name\nresolveNameFromModule infos name = do\n     modL <- maybe (throwE $ \"No module for\" <+> ppr name) return $\n             nameModule_maybe name\n\n     info <- maybe (throwE (ppr (moduleUnitId modL) <> \":\" <>\n                            ppr modL)) return $\n             M.lookup (moduleName modL) infos\n\n     maybe (throwE \"No matching export in any local modules.\") return $\n         find (matchName name) (modInfoExports (modinfoInfo info))\n  where\n    matchName :: Name -> Name -> Bool\n    matchName x y = occNameFS (getOccName x) ==\n                    occNameFS (getOccName y)\n\n-- | Try to resolve the type display from the given span.\nresolveName :: [SpanInfo] -> SpanInfo -> Maybe Var\nresolveName spans' si = listToMaybe $ mapMaybe spaninfoVar $\n                        reverse spans' `spaninfosWithin` si\n\n-- | Try to find the type of the given span.\nfindType :: GhcMonad m\n         => Map ModuleName ModInfo\n         -> RealSrcSpan\n         -> String\n         -> ExceptT SDoc m (ModInfo, Type)\nfindType infos span0 string = do\n    name  <- maybeToExceptT \"Couldn't guess that module name. Does it exist?\" $\n             guessModule infos (srcSpanFilePath span0)\n\n    info  <- maybeToExceptT \"No module info for current file! Try loading it?\" $\n             MaybeT $ pure $ M.lookup name infos\n\n    case resolveType (modinfoSpans info) (spanInfoFromRealSrcSpan' span0) of\n        Nothing -> (,) info <$> lift (exprType TM_Inst string)\n        Just ty -> return (info, ty)\n  where\n    -- | Try to resolve the type display from the given span.\n    resolveType :: [SpanInfo] -> SpanInfo -> Maybe Type\n    resolveType spans' si = listToMaybe $ mapMaybe spaninfoType $\n                            reverse spans' `spaninfosWithin` si\n\n-- | Guess a module name from a file path.\nguessModule :: GhcMonad m\n            => Map ModuleName ModInfo -> FilePath -> MaybeT m ModuleName\nguessModule infos fp = do\n    target <- lift $ guessTarget fp Nothing\n    case targetId target of\n        TargetModule mn  -> return mn\n        TargetFile fp' _ -> guessModule' fp'\n  where\n    guessModule' :: GhcMonad m => FilePath -> MaybeT m ModuleName\n    guessModule' fp' = case findModByFp fp' of\n        Just mn -> return mn\n        Nothing -> do\n            fp'' <- liftIO (makeRelativeToCurrentDirectory fp')\n\n            target' <- lift $ guessTarget fp'' Nothing\n            case targetId target' of\n                TargetModule mn -> return mn\n                _               -> MaybeT . pure $ findModByFp fp''\n\n    findModByFp :: FilePath -> Maybe ModuleName\n    findModByFp fp' = fst <$> find ((Just fp' ==) . mifp) (M.toList infos)\n      where\n        mifp :: (ModuleName, ModInfo) -> Maybe FilePath\n        mifp = ml_hs_file . ms_location . modinfoSummary . snd\n\n\n-- | Collect type info data for the loaded modules.\ncollectInfo :: (GhcMonad m) => Map ModuleName ModInfo -> [ModuleName]\n               -> m (Map ModuleName ModInfo)\ncollectInfo ms loaded = do\n    df <- getDynFlags\n    liftIO (filterM cacheInvalid loaded) >>= \\case\n        [] -> return ms\n        invalidated -> do\n            liftIO (putStrLn (\"Collecting type info for \" ++\n                              show (length invalidated) ++\n                              \" module(s) ... \"))\n\n            foldM (go df) ms invalidated\n  where\n    go df m name = do { info <- getModInfo name; return (M.insert name info m) }\n                   `gcatch`\n                   (\\(e :: SomeException) -> do\n                         liftIO $ putStrLn\n                                $ showSDocForUser df alwaysQualify\n                                $ \"Error while getting type info from\" <+>\n                                  ppr name <> \":\" <+> text (show e)\n                         return m)\n\n    cacheInvalid name = case M.lookup name ms of\n        Nothing -> return True\n        Just mi -> do\n            let fp = srcFilePath (modinfoSummary mi)\n                last' = modinfoLastUpdate mi\n            current <- getModificationTime fp\n            exists <- doesFileExist fp\n            if exists\n                then return $ current /= last'\n                else return True\n\n-- | Get the source file path from a ModSummary.\n-- If the .hs file is missing, and the .o file exists,\n-- we return the .o file path.\nsrcFilePath :: ModSummary -> FilePath\nsrcFilePath modSum = fromMaybe obj_fp src_fp\n    where\n        src_fp = ml_hs_file ms_loc\n        obj_fp = ml_obj_file ms_loc\n        ms_loc = ms_location modSum\n\n-- | Get info about the module: summary, types, etc.\ngetModInfo :: (GhcMonad m) => ModuleName -> m ModInfo\ngetModInfo name = do\n    m <- getModSummary name\n    p <- parseModule m\n    typechecked <- typecheckModule p\n    allTypes <- processAllTypeCheckedModule typechecked\n    let i = tm_checked_module_info typechecked\n    ts <- liftIO $ getModificationTime $ srcFilePath m\n    return (ModInfo m allTypes i ts)\n\n-- | Get ALL source spans in the module.\nprocessAllTypeCheckedModule :: forall m . GhcMonad m => TypecheckedModule\n                            -> m [SpanInfo]\nprocessAllTypeCheckedModule tcm = do\n    bts <- mapM getTypeLHsBind $ listifyAllSpans tcs\n    ets <- mapM getTypeLHsExpr $ listifyAllSpans tcs\n    pts <- mapM getTypeLPat    $ listifyAllSpans tcs\n    return $ mapMaybe toSpanInfo\n           $ sortBy cmpSpan\n           $ catMaybes (bts ++ ets ++ pts)\n  where\n    tcs = tm_typechecked_source tcm\n\n    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsBind's\n    getTypeLHsBind :: LHsBind GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))\n    getTypeLHsBind (dL->L _spn FunBind{fun_id = pid,fun_matches = MG _ _ _})\n        = pure $ Just (Just (unLoc pid),getLoc pid,varType (unLoc pid))\n    getTypeLHsBind _ = pure Nothing\n\n    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LHsExpr's\n    getTypeLHsExpr :: LHsExpr GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))\n    getTypeLHsExpr e = do\n        hs_env  <- getSession\n        (_,mbe) <- liftIO $ deSugarExpr hs_env e\n        return $ fmap (\\expr -> (mid, getLoc e, CoreUtils.exprType expr)) mbe\n      where\n        mid :: Maybe Id\n        mid | HsVar _ (dL->L _ i) <- unwrapVar (unLoc e) = Just i\n            | otherwise                                  = Nothing\n\n        unwrapVar (HsWrap _ _ var) = var\n        unwrapVar e'               = e'\n\n    -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's\n    getTypeLPat :: LPat GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))\n    getTypeLPat (dL->L spn pat) =\n        pure (Just (getMaybeId pat,spn,hsPatType pat))\n      where\n        getMaybeId (VarPat _ (dL->L _ vid)) = Just vid\n        getMaybeId _                        = Nothing\n\n    -- | Get ALL source spans in the source.\n    listifyAllSpans :: (HasSrcSpan a , Typeable a) => TypecheckedSource -> [a]\n    listifyAllSpans = everythingAllSpans (++) [] ([] `mkQ` (\\x -> [x | p x]))\n      where\n        p (dL->L spn _) = isGoodSrcSpan spn\n\n    -- | Variant of @syb@'s @everything@ (which summarises all nodes\n    -- in top-down, left-to-right order) with a stop-condition on 'NameSet's\n    everythingAllSpans :: (r -> r -> r) -> r -> GenericQ r -> GenericQ r\n    everythingAllSpans k z f x\n      | (False `mkQ` (const True :: NameSet -> Bool)) x = z\n      | otherwise = foldl k (f x) (gmapQ (everythingAllSpans k z f) x)\n\n    cmpSpan (_,a,_) (_,b,_)\n      | a `isSubspanOf` b = LT\n      | b `isSubspanOf` a = GT\n      | otherwise         = EQ\n\n    -- | Pretty print the types into a 'SpanInfo'.\n    toSpanInfo :: (Maybe Id,SrcSpan,Type) -> Maybe SpanInfo\n    toSpanInfo (n,RealSrcSpan spn,typ)\n        = Just $ spanInfoFromRealSrcSpan spn (Just typ) n\n    toSpanInfo _ = Nothing\n\n-- helper stolen from @syb@ package\ntype GenericQ r = forall a. Data a => a -> r\n\nmkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r\n(r `mkQ` br) a = maybe r br (cast a)\n", "num_lines": 380}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, FlexibleInstances, UnboxedTuples, MagicHash #-}\n{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}\n-- -fno-cse is needed for GLOBAL_VAR's to behave properly\n\n-----------------------------------------------------------------------------\n--\n-- Monadery code used in InteractiveUI\n--\n-- (c) The GHC Team 2005-2006\n--\n-----------------------------------------------------------------------------\n\nmodule GHCi.UI.Monad (\n        GHCi(..), startGHCi,\n        GHCiState(..), GhciMonad(..),\n        GHCiOption(..), isOptionSet, setOption, unsetOption,\n        Command(..), CommandResult(..), cmdSuccess,\n        PromptFunction,\n        BreakLocation(..),\n        TickArray,\n        getDynFlags,\n\n        runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,\n        ActionStats(..), runAndPrintStats, runWithStats, printStats,\n\n        printForUserNeverQualify, printForUserModInfo,\n        printForUser, printForUserPartWay, prettyLocations,\n\n        compileGHCiExpr,\n        initInterpBuffering,\n        turnOffBuffering, turnOffBuffering_,\n        flushInterpBuffers,\n        mkEvalWrapper\n    ) where\n\n#include \"HsVersions.h\"\n\nimport GHCi.UI.Info (ModInfo)\nimport qualified GHC\nimport GhcMonad         hiding (liftIO)\nimport Outputable       hiding (printForUser, printForUserPartWay)\nimport qualified Outputable\nimport DynFlags\nimport FastString\nimport HscTypes\nimport SrcLoc\nimport Module\nimport GHCi\nimport GHCi.RemoteTypes\nimport HsSyn (ImportDecl, GhcPs, GhciLStmt, LHsDecl)\nimport Util\n\nimport Exception\nimport Numeric\nimport Data.Array\nimport Data.IORef\nimport Data.Time\nimport System.Environment\nimport System.IO\nimport Control.Monad\nimport Prelude hiding ((<>))\n\nimport System.Console.Haskeline (CompletionFunc, InputT)\nimport qualified System.Console.Haskeline as Haskeline\nimport Control.Monad.Trans.Class\nimport Control.Monad.IO.Class\nimport Data.Map.Strict (Map)\nimport qualified GHC.LanguageExtensions as LangExt\n\n-----------------------------------------------------------------------------\n-- GHCi monad\n\ndata GHCiState = GHCiState\n     {\n        progname       :: String,\n        args           :: [String],\n        evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@\n        prompt         :: PromptFunction,\n        prompt_cont    :: PromptFunction,\n        editor         :: String,\n        stop           :: String,\n        options        :: [GHCiOption],\n        line_number    :: !Int,         -- ^ input line\n        break_ctr      :: !Int,\n        breaks         :: ![(Int, BreakLocation)],\n        tickarrays     :: ModuleEnv TickArray,\n            -- ^ 'tickarrays' caches the 'TickArray' for loaded modules,\n            -- so that we don't rebuild it each time the user sets\n            -- a breakpoint.\n        ghci_commands  :: [Command],\n            -- ^ available ghci commands\n        ghci_macros    :: [Command],\n            -- ^ user-defined macros\n        last_command   :: Maybe Command,\n            -- ^ @:@ at the GHCi prompt repeats the last command, so we\n            -- remember it here\n        cmd_wrapper    :: InputT GHCi CommandResult -> InputT GHCi (Maybe Bool),\n            -- ^ The command wrapper is run for each command or statement.\n            -- The 'Bool' value denotes whether the command is successful and\n            -- 'Nothing' means to exit GHCi.\n        cmdqueue       :: [String],\n\n        remembered_ctx :: [InteractiveImport],\n            -- ^ The imports that the user has asked for, via import\n            -- declarations and :module commands.  This list is\n            -- persistent over :reloads (but any imports for modules\n            -- that are not loaded are temporarily ignored).  After a\n            -- :load, all the home-package imports are stripped from\n            -- this list.\n            --\n            -- See bugs #2049, #1873, #1360\n\n        transient_ctx  :: [InteractiveImport],\n            -- ^ An import added automatically after a :load, usually of\n            -- the most recently compiled module.  May be empty if\n            -- there are no modules loaded.  This list is replaced by\n            -- :load, :reload, and :add.  In between it may be modified\n            -- by :module.\n\n        extra_imports  :: [ImportDecl GhcPs],\n            -- ^ These are \"always-on\" imports, added to the\n            -- context regardless of what other imports we have.\n            -- This is useful for adding imports that are required\n            -- by setGHCiMonad.  Be careful adding things here:\n            -- you can create ambiguities if these imports overlap\n            -- with other things in scope.\n            --\n            -- NB. although this is not currently used by GHCi itself,\n            -- it was added to support other front-ends that are based\n            -- on the GHCi code.  Potentially we could also expose\n            -- this functionality via GHCi commands.\n\n        prelude_imports :: [ImportDecl GhcPs],\n            -- ^ These imports are added to the context when\n            -- -XImplicitPrelude is on and we don't have a *-module\n            -- in the context.  They can also be overridden by another\n            -- import for the same module, e.g.\n            -- \"import Prelude hiding (map)\"\n\n        ghc_e :: Bool, -- ^ True if this is 'ghc -e' (or runghc)\n\n        short_help :: String,\n            -- ^ help text to display to a user\n        long_help  :: String,\n        lastErrorLocations :: IORef [(FastString, Int)],\n\n        mod_infos  :: !(Map ModuleName ModInfo),\n\n        flushStdHandles :: ForeignHValue,\n            -- ^ @hFlush stdout; hFlush stderr@ in the interpreter\n        noBuffering :: ForeignHValue\n            -- ^ @hSetBuffering NoBuffering@ for stdin/stdout/stderr\n     }\n\ntype TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]\n\n-- | A GHCi command\ndata Command\n   = Command\n   { cmdName           :: String\n     -- ^ Name of GHCi command (e.g. \"exit\")\n   , cmdAction         :: String -> InputT GHCi Bool\n     -- ^ The 'Bool' value denotes whether to exit GHCi\n   , cmdHidden         :: Bool\n     -- ^ Commands which are excluded from default completion\n     -- and @:help@ summary. This is usually set for commands not\n     -- useful for interactive use but rather for IDEs.\n   , cmdCompletionFunc :: CompletionFunc GHCi\n     -- ^ 'CompletionFunc' for arguments\n   }\n\ndata CommandResult\n   = CommandComplete\n   { cmdInput :: String\n   , cmdResult :: Either SomeException (Maybe Bool)\n   , cmdStats :: ActionStats\n   }\n   | CommandIncomplete\n     -- ^ Unterminated multiline command\n   deriving Show\n\ncmdSuccess :: Haskeline.MonadException m => CommandResult -> m (Maybe Bool)\ncmdSuccess CommandComplete{ cmdResult = Left e } = liftIO $ throwIO e\ncmdSuccess CommandComplete{ cmdResult = Right r } = return r\ncmdSuccess CommandIncomplete = return $ Just True\n\ntype PromptFunction = [String]\n                   -> Int\n                   -> GHCi SDoc\n\ndata GHCiOption\n        = ShowTiming            -- show time/allocs after evaluation\n        | ShowType              -- show the type of expressions\n        | RevertCAFs            -- revert CAFs after every evaluation\n        | Multiline             -- use multiline commands\n        | CollectInfo           -- collect and cache information about\n                                -- modules after load\n        deriving Eq\n\ndata BreakLocation\n   = BreakLocation\n   { breakModule :: !GHC.Module\n   , breakLoc    :: !SrcSpan\n   , breakTick   :: {-# UNPACK #-} !Int\n   , onBreakCmd  :: String\n   }\n\ninstance Eq BreakLocation where\n  loc1 == loc2 = breakModule loc1 == breakModule loc2 &&\n                 breakTick loc1   == breakTick loc2\n\nprettyLocations :: [(Int, BreakLocation)] -> SDoc\nprettyLocations []   = text \"No active breakpoints.\"\nprettyLocations locs = vcat $ map (\\(i, loc) -> brackets (int i) <+> ppr loc) $ reverse $ locs\n\ninstance Outputable BreakLocation where\n   ppr loc = (ppr $ breakModule loc) <+> ppr (breakLoc loc) <+>\n                if null (onBreakCmd loc)\n                   then Outputable.empty\n                   else doubleQuotes (text (onBreakCmd loc))\n\nrecordBreak\n  :: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int)\nrecordBreak brkLoc = do\n   st <- getGHCiState\n   let oldActiveBreaks = breaks st\n   -- don't store the same break point twice\n   case [ nm | (nm, loc) <- oldActiveBreaks, loc == brkLoc ] of\n     (nm:_) -> return (True, nm)\n     [] -> do\n      let oldCounter = break_ctr st\n          newCounter = oldCounter + 1\n      setGHCiState $ st { break_ctr = newCounter,\n                          breaks = (oldCounter, brkLoc) : oldActiveBreaks\n                        }\n      return (False, oldCounter)\n\nnewtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> Ghc a }\n\nreflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a\nreflectGHCi (s, gs) m = unGhc (unGHCi m gs) s\n\nstartGHCi :: GHCi a -> GHCiState -> Ghc a\nstartGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref\n\ninstance Functor GHCi where\n    fmap = liftM\n\ninstance Applicative GHCi where\n    pure a = GHCi $ \\_ -> pure a\n    (<*>) = ap\n\ninstance Monad GHCi where\n  (GHCi m) >>= k  =  GHCi $ \\s -> m s >>= \\a -> unGHCi (k a) s\n\nclass GhcMonad m => GhciMonad m where\n  getGHCiState    :: m GHCiState\n  setGHCiState    :: GHCiState -> m ()\n  modifyGHCiState :: (GHCiState -> GHCiState) -> m ()\n  reifyGHCi       :: ((Session, IORef GHCiState) -> IO a) -> m a\n\ninstance GhciMonad GHCi where\n  getGHCiState      = GHCi $ \\r -> liftIO $ readIORef r\n  setGHCiState s    = GHCi $ \\r -> liftIO $ writeIORef r s\n  modifyGHCiState f = GHCi $ \\r -> liftIO $ modifyIORef r f\n  reifyGHCi f       = GHCi $ \\r -> reifyGhc $ \\s -> f (s, r)\n\ninstance GhciMonad (InputT GHCi) where\n  getGHCiState    = lift getGHCiState\n  setGHCiState    = lift . setGHCiState\n  modifyGHCiState = lift . modifyGHCiState\n  reifyGHCi       = lift . reifyGHCi\n\nliftGhc :: Ghc a -> GHCi a\nliftGhc m = GHCi $ \\_ -> m\n\ninstance MonadIO GHCi where\n  liftIO = liftGhc . liftIO\n\ninstance HasDynFlags GHCi where\n  getDynFlags = getSessionDynFlags\n\ninstance GhcMonad GHCi where\n  setSession s' = liftGhc $ setSession s'\n  getSession    = liftGhc $ getSession\n\ninstance HasDynFlags (InputT GHCi) where\n  getDynFlags = lift getDynFlags\n\ninstance GhcMonad (InputT GHCi) where\n  setSession = lift . setSession\n  getSession = lift getSession\n\ninstance ExceptionMonad GHCi where\n  gcatch m h = GHCi $ \\r -> unGHCi m r `gcatch` (\\e -> unGHCi (h e) r)\n  gmask f =\n      GHCi $ \\s -> gmask $ \\io_restore ->\n                             let\n                                g_restore (GHCi m) = GHCi $ \\s' -> io_restore (m s')\n                             in\n                                unGHCi (f g_restore) s\n\ninstance Haskeline.MonadException Ghc where\n  controlIO f = Ghc $ \\s -> Haskeline.controlIO $ \\(Haskeline.RunIO run) -> let\n                    run' = Haskeline.RunIO (fmap (Ghc . const) . run . flip unGhc s)\n                    in fmap (flip unGhc s) $ f run'\n\ninstance Haskeline.MonadException GHCi where\n  controlIO f = GHCi $ \\s -> Haskeline.controlIO $ \\(Haskeline.RunIO run) -> let\n                    run' = Haskeline.RunIO (fmap (GHCi . const) . run . flip unGHCi s)\n                    in fmap (flip unGHCi s) $ f run'\n\ninstance ExceptionMonad (InputT GHCi) where\n  gcatch = Haskeline.catch\n  gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_)\n\nisOptionSet :: GhciMonad m => GHCiOption -> m Bool\nisOptionSet opt\n = do st <- getGHCiState\n      return (opt `elem` options st)\n\nsetOption :: GhciMonad m => GHCiOption -> m ()\nsetOption opt\n = do st <- getGHCiState\n      setGHCiState (st{ options = opt : filter (/= opt) (options st) })\n\nunsetOption :: GhciMonad m => GHCiOption -> m ()\nunsetOption opt\n = do st <- getGHCiState\n      setGHCiState (st{ options = filter (/= opt) (options st) })\n\nprintForUserNeverQualify :: GhcMonad m => SDoc -> m ()\nprintForUserNeverQualify doc = do\n  dflags <- getDynFlags\n  liftIO $ Outputable.printForUser dflags stdout neverQualify doc\n\nprintForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()\nprintForUserModInfo info doc = do\n  dflags <- getDynFlags\n  mUnqual <- GHC.mkPrintUnqualifiedForModule info\n  unqual <- maybe GHC.getPrintUnqual return mUnqual\n  liftIO $ Outputable.printForUser dflags stdout unqual doc\n\nprintForUser :: GhcMonad m => SDoc -> m ()\nprintForUser doc = do\n  unqual <- GHC.getPrintUnqual\n  dflags <- getDynFlags\n  liftIO $ Outputable.printForUser dflags stdout unqual doc\n\nprintForUserPartWay :: GhcMonad m => SDoc -> m ()\nprintForUserPartWay doc = do\n  unqual <- GHC.getPrintUnqual\n  dflags <- getDynFlags\n  liftIO $ Outputable.printForUserPartWay dflags stdout (pprUserLength dflags) unqual doc\n\n-- | Run a single Haskell expression\nrunStmt\n  :: GhciMonad m\n  => GhciLStmt GhcPs -> String -> GHC.SingleStep -> m (Maybe GHC.ExecResult)\nrunStmt stmt stmt_text step = do\n  st <- getGHCiState\n  GHC.handleSourceError (\\e -> do GHC.printException e; return Nothing) $ do\n    let opts = GHC.execOptions\n                  { GHC.execSourceFile = progname st\n                  , GHC.execLineNumber = line_number st\n                  , GHC.execSingleStep = step\n                  , GHC.execWrap = \\fhv -> EvalApp (EvalThis (evalWrapper st))\n                                                   (EvalThis fhv) }\n    Just <$> GHC.execStmt' stmt stmt_text opts\n\nrunDecls :: GhciMonad m => String -> m (Maybe [GHC.Name])\nrunDecls decls = do\n  st <- getGHCiState\n  reifyGHCi $ \\x ->\n    withProgName (progname st) $\n    withArgs (args st) $\n      reflectGHCi x $ do\n        GHC.handleSourceError (\\e -> do GHC.printException e;\n                                        return Nothing) $ do\n          r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls\n          return (Just r)\n\nrunDecls' :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe [GHC.Name])\nrunDecls' decls = do\n  st <- getGHCiState\n  reifyGHCi $ \\x ->\n    withProgName (progname st) $\n    withArgs (args st) $\n    reflectGHCi x $\n      GHC.handleSourceError\n        (\\e -> do GHC.printException e;\n                  return Nothing)\n        (Just <$> GHC.runParsedDecls decls)\n\nresume :: GhciMonad m => (SrcSpan -> Bool) -> GHC.SingleStep -> m GHC.ExecResult\nresume canLogSpan step = do\n  st <- getGHCiState\n  reifyGHCi $ \\x ->\n    withProgName (progname st) $\n    withArgs (args st) $\n      reflectGHCi x $ do\n        GHC.resumeExec canLogSpan step\n\n-- --------------------------------------------------------------------------\n-- timing & statistics\n\ndata ActionStats = ActionStats\n  { actionAllocs :: Maybe Integer\n  , actionElapsedTime :: Double\n  } deriving Show\n\nrunAndPrintStats\n  :: GhciMonad m\n  => (a -> Maybe Integer)\n  -> m a\n  -> m (ActionStats, Either SomeException a)\nrunAndPrintStats getAllocs action = do\n  result <- runWithStats getAllocs action\n  case result of\n    (stats, Right{}) -> do\n      showTiming <- isOptionSet ShowTiming\n      when showTiming $ do\n        dflags  <- getDynFlags\n        liftIO $ printStats dflags stats\n    _ -> return ()\n  return result\n\nrunWithStats\n  :: ExceptionMonad m\n  => (a -> Maybe Integer) -> m a -> m (ActionStats, Either SomeException a)\nrunWithStats getAllocs action = do\n  t0 <- liftIO getCurrentTime\n  result <- gtry action\n  let allocs = either (const Nothing) getAllocs result\n  t1 <- liftIO getCurrentTime\n  let elapsedTime = realToFrac $ t1 `diffUTCTime` t0\n  return (ActionStats allocs elapsedTime, result)\n\nprintStats :: DynFlags -> ActionStats -> IO ()\nprintStats dflags ActionStats{actionAllocs = mallocs, actionElapsedTime = secs}\n   = do let secs_str = showFFloat (Just 2) secs\n        putStrLn (showSDoc dflags (\n                 parens (text (secs_str \"\") <+> text \"secs\" <> comma <+>\n                         case mallocs of\n                           Nothing -> empty\n                           Just allocs ->\n                             text (separateThousands allocs) <+> text \"bytes\")))\n  where\n    separateThousands n = reverse . sep . reverse . show $ n\n      where sep n'\n              | n' `lengthAtMost` 3 = n'\n              | otherwise           = take 3 n' ++ \",\" ++ sep (drop 3 n')\n\n-----------------------------------------------------------------------------\n-- reverting CAFs\n\nrevertCAFs :: GhciMonad m => m ()\nrevertCAFs = do\n  hsc_env <- GHC.getSession\n  liftIO $ iservCmd hsc_env RtsRevertCAFs\n  s <- getGHCiState\n  when (not (ghc_e s)) turnOffBuffering\n     -- Have to turn off buffering again, because we just\n     -- reverted stdout, stderr & stdin to their defaults.\n\n\n-----------------------------------------------------------------------------\n-- To flush buffers for the *interpreted* computation we need\n-- to refer to *its* stdout/stderr handles\n\n-- | Compile \"hFlush stdout; hFlush stderr\" once, so we can use it repeatedly\ninitInterpBuffering :: Ghc (ForeignHValue, ForeignHValue)\ninitInterpBuffering = do\n  nobuf <- compileGHCiExpr $\n   \"do { System.IO.hSetBuffering System.IO.stdin System.IO.NoBuffering; \" ++\n       \" System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering; \" ++\n       \" System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering }\"\n  flush <- compileGHCiExpr $\n   \"do { System.IO.hFlush System.IO.stdout; \" ++\n       \" System.IO.hFlush System.IO.stderr }\"\n  return (nobuf, flush)\n\n-- | Invoke \"hFlush stdout; hFlush stderr\" in the interpreter\nflushInterpBuffers :: GhciMonad m => m ()\nflushInterpBuffers = do\n  st <- getGHCiState\n  hsc_env <- GHC.getSession\n  liftIO $ evalIO hsc_env (flushStdHandles st)\n\n-- | Turn off buffering for stdin, stdout, and stderr in the interpreter\nturnOffBuffering :: GhciMonad m => m ()\nturnOffBuffering = do\n  st <- getGHCiState\n  turnOffBuffering_ (noBuffering st)\n\nturnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()\nturnOffBuffering_ fhv = do\n  hsc_env <- getSession\n  liftIO $ evalIO hsc_env fhv\n\nmkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue\nmkEvalWrapper progname args =\n  compileGHCiExpr $\n    \"\\\\m -> System.Environment.withProgName \" ++ show progname ++\n    \"(System.Environment.withArgs \" ++ show args ++ \" m)\"\n\ncompileGHCiExpr :: GhcMonad m => String -> m ForeignHValue\ncompileGHCiExpr expr =\n  withTempSession mkTempSession $ GHC.compileExprRemote expr\n  where\n    mkTempSession hsc_env = hsc_env\n      { hsc_dflags = (hsc_dflags hsc_env) {\n        -- Running GHCi's internal expression is incompatible with -XSafe.\n          -- We temporarily disable any Safe Haskell settings while running\n          -- GHCi internal expressions. (see #12509)\n        safeHaskell = Sf_None\n      }\n        -- RebindableSyntax can wreak havoc with GHCi in several ways\n          -- (see #13385 and #14342 for examples), so we temporarily\n          -- disable it too.\n          `xopt_unset` LangExt.RebindableSyntax\n          -- We heavily depend on -fimplicit-import-qualified to compile expr\n          -- with fully qualified names without imports.\n          `gopt_set` Opt_ImplicitImportQualified\n      }\n", "num_lines": 526}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n--\n-- GHCi's :ctags and :etags commands\n--\n-- (c) The GHC Team 2005-2007\n--\n-----------------------------------------------------------------------------\n\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\nmodule GHCi.UI.Tags (\n  createCTagsWithLineNumbersCmd,\n  createCTagsWithRegExesCmd,\n  createETagsFileCmd\n) where\n\nimport Exception\nimport GHC\nimport GHCi.UI.Monad\nimport Outputable\n\n-- ToDo: figure out whether we need these, and put something appropriate\n-- into the GHC API instead\nimport Name (nameOccName)\nimport OccName (pprOccName)\nimport ConLike\nimport MonadUtils\n\nimport Control.Monad\nimport Data.Function\nimport Data.List\nimport Data.Maybe\nimport Data.Ord\nimport DriverPhases\nimport Panic\nimport Prelude\nimport System.Directory\nimport System.IO\nimport System.IO.Error\n\n-----------------------------------------------------------------------------\n-- create tags file for currently loaded modules.\n\ncreateCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd,\n  createETagsFileCmd :: String -> GHCi ()\n\ncreateCTagsWithLineNumbersCmd \"\"   =\n  ghciCreateTagsFile CTagsWithLineNumbers \"tags\"\ncreateCTagsWithLineNumbersCmd file =\n  ghciCreateTagsFile CTagsWithLineNumbers file\n\ncreateCTagsWithRegExesCmd \"\"   =\n  ghciCreateTagsFile CTagsWithRegExes \"tags\"\ncreateCTagsWithRegExesCmd file =\n  ghciCreateTagsFile CTagsWithRegExes file\n\ncreateETagsFileCmd \"\"    = ghciCreateTagsFile ETags \"TAGS\"\ncreateETagsFileCmd file  = ghciCreateTagsFile ETags file\n\ndata TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes\n\nghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()\nghciCreateTagsFile kind file = do\n  createTagsFile kind file\n\n-- ToDo:\n--      - remove restriction that all modules must be interpreted\n--        (problem: we don't know source locations for entities unless\n--        we compiled the module.\n--\n--      - extract createTagsFile so it can be used from the command-line\n--        (probably need to fix first problem before this is useful).\n--\ncreateTagsFile :: TagsKind -> FilePath -> GHCi ()\ncreateTagsFile tagskind tagsFile = do\n  graph <- GHC.getModuleGraph\n  mtags <- mapM listModuleTags (map GHC.ms_mod $ GHC.mgModSummaries graph)\n  either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags\n  case either_res of\n    Left e  -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e\n    Right _ -> return ()\n\n\nlistModuleTags :: GHC.Module -> GHCi [TagInfo]\nlistModuleTags m = do\n  is_interpreted <- GHC.moduleIsInterpreted m\n  -- should we just skip these?\n  when (not is_interpreted) $\n    let mName = GHC.moduleNameString (GHC.moduleName m) in\n    throwGhcException (CmdLineError (\"module '\" ++ mName ++ \"' is not interpreted\"))\n  mbModInfo <- GHC.getModuleInfo m\n  case mbModInfo of\n    Nothing -> return []\n    Just mInfo -> do\n       dflags <- getDynFlags\n       mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo\n       let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual\n       let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo\n       let localNames = filter ((m==) . nameModule) names\n       mbTyThings <- mapM GHC.lookupName localNames\n       return $! [ tagInfo dflags unqual exported kind name realLoc\n                     | tyThing <- catMaybes mbTyThings\n                     , let name = getName tyThing\n                     , let exported = GHC.modInfoIsExportedName mInfo name\n                     , let kind = tyThing2TagKind tyThing\n                     , let loc = srcSpanStart (nameSrcSpan name)\n                     , RealSrcLoc realLoc <- [loc]\n                     ]\n\n  where\n    tyThing2TagKind (AnId _)                 = 'v'\n    tyThing2TagKind (AConLike RealDataCon{}) = 'd'\n    tyThing2TagKind (AConLike PatSynCon{})   = 'p'\n    tyThing2TagKind (ATyCon _)               = 't'\n    tyThing2TagKind (ACoAxiom _)             = 'x'\n\n\ndata TagInfo = TagInfo\n  { tagExported :: Bool -- is tag exported\n  , tagKind :: Char   -- tag kind\n  , tagName :: String -- tag name\n  , tagFile :: String -- file name\n  , tagLine :: Int    -- line number\n  , tagCol :: Int     -- column number\n  , tagSrcInfo :: Maybe (String,Integer)  -- source code line and char offset\n  }\n\n\n-- get tag info, for later translation into Vim or Emacs style\ntagInfo :: DynFlags -> PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc\n        -> TagInfo\ntagInfo dflags unqual exported kind name loc\n    = TagInfo exported kind\n        (showSDocForUser dflags unqual $ pprOccName (nameOccName name))\n        (showSDocForUser dflags unqual $ ftext (srcLocFile loc))\n        (srcLocLine loc) (srcLocCol loc) Nothing\n\n-- throw an exception when someone tries to overwrite existing source file (fix for #10989)\nwriteTagsSafely :: FilePath -> String -> IO ()\nwriteTagsSafely file str = do\n    dfe <- doesFileExist file\n    if dfe && isSourceFilename file\n        then throwGhcException (CmdLineError (file ++ \" is existing source file. \" ++\n             \"Please specify another file name to store tags data\"))\n        else writeFile file str\n\ncollateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())\n-- ctags style with the Ex expression being just the line number, Vim et al\ncollateAndWriteTags CTagsWithLineNumbers file tagInfos = do\n  let tags = unlines $ sort $ map showCTag tagInfos\n  tryIO (writeTagsSafely file tags)\n\n-- ctags style with the Ex expression being a regex searching the line, Vim et al\ncollateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al\n  tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos\n  let tags = unlines $ sort $ map showCTag $concat tagInfoGroups\n  tryIO (writeTagsSafely file tags)\n\ncollateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs\n  tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos\n  let tagGroups = map processGroup tagInfoGroups\n  tryIO (writeTagsSafely file $ concat tagGroups)\n\n  where\n    processGroup [] = throwGhcException (CmdLineError \"empty tag file group??\")\n    processGroup group@(tagInfo:_) =\n      let tags = unlines $ map showETag group in\n      \"\\x0c\\n\" ++ tagFile tagInfo ++ \",\" ++ show (length tags) ++ \"\\n\" ++ tags\n\n\nmakeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]\nmakeTagGroupsWithSrcInfo tagInfos = do\n  let groups = groupBy ((==) `on` tagFile) $ sortBy (comparing tagFile) tagInfos\n  mapM addTagSrcInfo groups\n\n  where\n    addTagSrcInfo [] = throwGhcException (CmdLineError \"empty tag file group??\")\n    addTagSrcInfo group@(tagInfo:_) = do\n      file <- readFile $tagFile tagInfo\n      let sortedGroup = sortBy (comparing tagLine) group\n      return $ perFile sortedGroup 1 0 $ lines file\n\n    perFile allTags@(tag:tags) cnt pos allLs@(l:ls)\n     | tagLine tag > cnt =\n         perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls\n     | tagLine tag == cnt =\n         tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs\n    perFile _ _ _ _ = []\n\n\n-- ctags format, for Vim et al\nshowCTag :: TagInfo -> String\nshowCTag ti =\n  tagName ti ++ \"\\t\" ++ tagFile ti ++ \"\\t\" ++ tagCmd ++ \";\\\"\\t\" ++\n    tagKind ti : ( if tagExported ti then \"\" else \"\\tfile:\" )\n\n  where\n    tagCmd =\n      case tagSrcInfo ti of\n        Nothing -> show $tagLine ti\n        Just (srcLine,_) -> \"/^\"++ foldr escapeSlashes [] srcLine ++\"$/\"\n\n      where\n        escapeSlashes '/' r = '\\\\' : '/' : r\n        escapeSlashes '\\\\' r = '\\\\' : '\\\\' : r\n        escapeSlashes c r = c : r\n\n\n-- etags format, for Emacs/XEmacs\nshowETag :: TagInfo -> String\nshowETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo,\n                  tagSrcInfo = Just (srcLine,charPos) }\n    =  take (colNo - 1) srcLine ++ tag\n    ++ \"\\x7f\" ++ tag\n    ++ \"\\x01\" ++ show lineNo\n    ++ \",\" ++ show charPos\nshowETag _ = throwGhcException (CmdLineError \"missing source file info in showETag\")\n", "num_lines": 217}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Base (\n    -- * General utilities\n    module Control.Applicative,\n    module Control.Monad.Extra,\n    module Data.List.Extra,\n    module Data.Maybe,\n    module Data.Semigroup,\n    module Hadrian.Utilities,\n\n    -- * Shake\n    module Development.Shake,\n    module Development.Shake.Classes,\n    module Development.Shake.FilePath,\n    module Development.Shake.Util,\n\n    -- * Basic data types\n    module Hadrian.Package,\n    module Stage,\n    module Way,\n\n    -- * Files\n    configH, ghcVersionH,\n\n    -- * Paths\n    hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,\n    generatedDir, generatedPath, stageBinPath, stageLibPath, templateHscPath,\n    ghcDeps, includesDependencies, haddockDeps, relativePackageDbPath,\n    packageDbPath, packageDbStamp, mingwStamp,\n    ) where\n\nimport Control.Applicative\nimport Control.Monad.Extra\nimport Control.Monad.Reader\nimport Data.List.Extra\nimport Data.Maybe\nimport Data.Semigroup\nimport Development.Shake hiding (unit, (*>), Normal)\nimport Development.Shake.Classes\nimport Development.Shake.FilePath\nimport Development.Shake.Util\nimport Hadrian.Oracles.DirectoryContents\nimport Hadrian.Utilities\nimport Hadrian.Package\n\nimport Stage\nimport Way\n\n-- | Hadrian lives in the 'hadrianPath' directory of the GHC tree.\nhadrianPath :: FilePath\nhadrianPath = \"hadrian\"\n\n-- TODO: Move this to build directory?\n-- | Path to system configuration files, such as 'configFile'.\nconfigPath :: FilePath\nconfigPath = hadrianPath -/- \"cfg\"\n\n-- | Path to the system configuration file generated by the @configure@ script.\nconfigFile :: FilePath\nconfigFile = configPath -/- \"system.config\"\n\n-- | Path to source files of the build system, e.g. this file is located at\n-- @sourcePath -/- \"Base.hs\"@. We use this to track some of the source files.\nsourcePath :: FilePath\nsourcePath = hadrianPath -/- \"src\"\n\n-- TODO: Change @mk/config.h@ to @shake-build/cfg/config.h@.\n-- | Path to the generated @mk/config.h@ file.\nconfigH :: FilePath\nconfigH = \"mk/config.h\"\n\nghcVersionH :: Action FilePath\nghcVersionH = generatedPath <&> (-/- \"ghcversion.h\")\n\n-- | The directory in 'buildRoot' containing the Shake database and other\n-- auxiliary files generated by Hadrian.\nshakeFilesDir :: FilePath\nshakeFilesDir = \"hadrian\"\n\n-- | The directory in 'buildRoot' containing generated source files that are not\n-- package-specific, e.g. @ghcplatform.h@.\ngeneratedDir :: FilePath\ngeneratedDir = \"generated\"\n\ngeneratedPath :: Action FilePath\ngeneratedPath = buildRoot <&> (-/- generatedDir)\n\n-- | Path to the package database for a given build stage, relative to the build\n-- root.\nrelativePackageDbPath :: Stage -> FilePath\nrelativePackageDbPath stage = stageString stage -/- \"lib/package.conf.d\"\n\n-- | Path to the package database used in a given 'Stage', including\n--   the build root.\npackageDbPath :: Stage -> Action FilePath\npackageDbPath stage = buildRoot <&> (-/- relativePackageDbPath stage)\n\n-- | We use a stamp file to track the existence of a package database.\npackageDbStamp :: FilePath\npackageDbStamp = \".stamp\"\n\n-- | @bin@ directory for the given 'Stage' (including the build root)\nstageBinPath :: Stage -> Action FilePath\nstageBinPath stage = buildRoot <&> (-/- stageString stage -/- \"bin\")\n\n-- | @lib@ directory for the given 'Stage' (including the build root)\nstageLibPath :: Stage -> Action FilePath\nstageLibPath stage = buildRoot <&> (-/- stageString stage -/- \"lib\")\n\n-- | Files the GHC binary depends on.\nghcDeps :: Stage -> Action [FilePath]\nghcDeps stage = mapM (\\f -> stageLibPath stage <&> (-/- f))\n    [ \"ghc-usage.txt\"\n    , \"ghci-usage.txt\"\n    , \"llvm-targets\"\n    , \"llvm-passes\"\n    , \"platformConstants\"\n    , \"settings\" ]\n\nincludesDependencies :: Action [FilePath]\nincludesDependencies = do\n    path <- generatedPath\n    return $ (path -/-) <$> [ \"ghcautoconf.h\", \"ghcplatform.h\", \"ghcversion.h\" ]\n\n-- | Files the `haddock` binary depends on\nhaddockDeps :: Stage -> Action [FilePath]\nhaddockDeps stage = do\n    let resdir = \"utils/haddock/haddock-api/resources\"\n    latexResources <- directoryContents matchAll (resdir -/- \"latex\")\n    htmlResources  <- directoryContents matchAll (resdir -/- \"html\")\n\n    haddockLib <- stageLibPath stage\n    return $ [ haddockLib -/- makeRelative resdir f\n             | f <- latexResources ++ htmlResources ]\n\n-- ref: utils/hsc2hs/ghc.mk\n-- | Path to 'hsc2hs' template.\ntemplateHscPath :: Stage -> Action FilePath\ntemplateHscPath stage = stageLibPath stage <&> (-/- \"template-hsc.h\")\n\n-- | We use this stamp file to track whether we've moved the mingw toolchain\n--   under the build root (to make it accessible to the GHCs we build on\n--   Windows). See \"Rules.Program\".\nmingwStamp :: FilePath\nmingwStamp = \"mingw\" -/- \".stamp\"\n", "num_lines": 145}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs #-}\nmodule Builder (\n    -- * Data types\n    ArMode (..), CcMode (..), ConfigurationInfo (..), GhcMode (..),\n    GhcPkgMode (..), HaddockMode (..), SphinxMode (..), TarMode (..),\n    Builder (..),\n\n    -- * Builder properties\n    builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder,\n    runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath,\n    builderEnvironment,\n\n    -- * Ad hoc builder invocation\n    applyPatch\n    ) where\n\nimport Development.Shake.Classes\nimport GHC.Generics\nimport qualified Hadrian.Builder as H\nimport Hadrian.Builder hiding (Builder)\nimport Hadrian.Builder.Ar\nimport Hadrian.Builder.Sphinx\nimport Hadrian.Builder.Tar\nimport Hadrian.Oracles.Path\nimport Hadrian.Oracles.TextFile\nimport Hadrian.Utilities\n\nimport Base\nimport Context\nimport Oracles.Flag\nimport Oracles.Setting\nimport Packages\n\n-- | C compiler can be used in two different modes:\n-- * Compile or preprocess a source file.\n-- * Extract source dependencies by passing @-MM@ command line argument.\ndata CcMode = CompileC | FindCDependencies deriving (Eq, Generic, Show)\n\ninstance Binary   CcMode\ninstance Hashable CcMode\ninstance NFData   CcMode\n\n-- | GHC can be used in four different modes:\n-- * Compile a Haskell source file.\n-- * Compile a C source file.\n-- * Extract source dependencies by passing @-M@ command line argument.\n-- * Link object files & static libraries into an executable.\ndata GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs\n    deriving (Eq, Generic, Show)\n\ninstance Binary   GhcMode\ninstance Hashable GhcMode\ninstance NFData   GhcMode\n\n-- | To configure a package we need two pieces of information, which we choose\n-- to record separately for convenience.\n--\n-- * Command line arguments to be passed to the setup script.\n--\n-- * Package configuration flags that enable/disable certain package features.\n--   Here is an example from \"Settings.Packages\":\n--\n--   > package rts\n--   >   ? builder (Cabal Flags)\n--   >   ? any (wayUnit Profiling) rtsWays\n--   >   ? arg \"profiling\"\n--\n--   This instructs package configuration functions (such as 'configurePackage')\n--   to enable the @profiling@ Cabal flag when processing @rts.cabal@ and\n--   building RTS with profiling information.\ndata ConfigurationInfo = Setup | Flags deriving (Eq, Generic, Show)\n\ninstance Binary   ConfigurationInfo\ninstance Hashable ConfigurationInfo\ninstance NFData   ConfigurationInfo\n\n-- TODO: Do we really need all these modes? Why do we need 'Dependencies'? We\n-- can extract dependencies using the Cabal library. Note: we used to also have\n-- the @Init@ mode for initialising a new package database but we've deleted it.\n-- | 'GhcPkg' can initialise a package database and register packages in it.\ndata GhcPkgMode = Copy         -- ^ Copy a package from one database to another.\n                | Dependencies -- ^ Compute package dependencies.\n                | Unregister   -- ^ Unregister a package.\n                | Update       -- ^ Update a package.\n                deriving (Eq, Generic, Show)\n\ninstance Binary   GhcPkgMode\ninstance Hashable GhcPkgMode\ninstance NFData   GhcPkgMode\n\n-- | Haddock can be used in two different modes:\n-- * Generate documentation for a single package\n-- * Generate an index page for a collection of packages\ndata HaddockMode = BuildPackage | BuildIndex deriving (Eq, Generic, Show)\n\ninstance Binary   HaddockMode\ninstance Hashable HaddockMode\ninstance NFData   HaddockMode\n\n-- | A 'Builder' is a (usually external) command invoked in a separate process\n-- via 'cmd'. Here are some examples:\n-- * 'Alex' is a lexical analyser generator that builds @Lexer.hs@ from @Lexer.x@.\n-- * 'Ghc' 'Stage0' is the bootstrapping Haskell compiler used in 'Stage0'.\n-- * 'Ghc' @StageN@ (N > 0) is the GHC built in stage (N - 1) and used in @StageN@.\n--\n-- The 'Cabal' builder is unusual in that it does not correspond to an external\n-- program but instead relies on the Cabal library for package configuration.\ndata Builder = Alex\n             | Ar ArMode Stage\n             | Autoreconf FilePath\n             | DeriveConstants\n             | Cabal ConfigurationInfo Stage\n             | Cc CcMode Stage\n             | Configure FilePath\n             | GenApply\n             | GenPrimopCode\n             | Ghc GhcMode Stage\n             | GhcPkg GhcPkgMode Stage\n             | Haddock HaddockMode\n             | Happy\n             | Hpc\n             | Hp2Ps\n             | HsCpp\n             | Hsc2Hs Stage\n             | Ld Stage\n             | Make FilePath\n             | Nm\n             | Objdump\n             | Patch\n             | Perl\n             | Python\n             | Ranlib\n             | RunTest\n             | Sphinx SphinxMode\n             | Tar TarMode\n             | Unlit\n             | Xelatex\n             deriving (Eq, Generic, Show)\n\ninstance Binary   Builder\ninstance Hashable Builder\ninstance NFData   Builder\n\n-- | Some builders are built by this very build system, in which case\n-- 'builderProvenance' returns the corresponding build 'Context' (which includes\n-- 'Stage' and GHC 'Package').\nbuilderProvenance :: Builder -> Maybe Context\nbuilderProvenance = \\case\n    DeriveConstants  -> context Stage0 deriveConstants\n    GenApply         -> context Stage0 genapply\n    GenPrimopCode    -> context Stage0 genprimopcode\n    Ghc _ Stage0     -> Nothing\n    Ghc _ stage      -> context (pred stage) ghc\n    GhcPkg _ Stage0  -> Nothing\n    GhcPkg _ s       -> context (pred s) ghcPkg\n    Haddock _        -> context Stage1 haddock\n    Hpc              -> context Stage1 hpcBin\n    Hp2Ps            -> context Stage0 hp2ps\n    Hsc2Hs _         -> context Stage0 hsc2hs\n    Unlit            -> context Stage0 unlit\n    _                -> Nothing\n  where\n    context s p = Just $ vanillaContext s p\n\ninstance H.Builder Builder where\n    builderPath :: Builder -> Action FilePath\n    builderPath builder = case builderProvenance builder of\n        Nothing      -> systemBuilderPath builder\n        Just context -> programPath context\n\n    runtimeDependencies :: Builder -> Action [FilePath]\n    runtimeDependencies = \\case\n        Autoreconf dir -> return [dir -/- \"configure.ac\"]\n        Configure  dir -> return [dir -/- \"configure\"]\n\n        Ghc _ Stage0 -> generatedGhcDependencies Stage0\n        Ghc _ stage -> do\n            root <- buildRoot\n            win <- windowsHost\n            touchyPath <- programPath (vanillaContext Stage0 touchy)\n            unlitPath  <- builderPath Unlit\n            ghcdeps <- ghcDeps stage\n            ghcgens <- generatedGhcDependencies stage\n            return $ [ unlitPath ]\n                  ++ ghcdeps\n                  ++ ghcgens\n                  ++ [ touchyPath | win ]\n                  ++ [ root -/- mingwStamp | win ]\n                     -- proxy for the entire mingw toolchain that\n                     -- we have in inplace/mingw initially, and then at\n                     -- root -/- mingw.\n\n        Hsc2Hs stage -> (\\p -> [p]) <$> templateHscPath stage\n        Make dir  -> return [dir -/- \"Makefile\"]\n        Haddock _ -> haddockDeps Stage1  -- Haddock currently runs in Stage1\n        _         -> return []\n\n    -- query the builder for some information.\n    -- contrast this with runBuilderWith, which returns @Action ()@\n    -- this returns the @stdout@ from running the builder.\n    -- For now this only implements asking @ghc-pkg@ about package\n    -- dependencies.\n    askBuilderWith :: Builder -> BuildInfo -> Action String\n    askBuilderWith builder BuildInfo {..} = case builder of\n        GhcPkg Dependencies _ -> do\n            let input  = fromSingleton msgIn buildInputs\n                msgIn  = \"[askBuilder] Exactly one input file expected.\"\n            needBuilder builder\n            path <- H.builderPath builder\n            need [path]\n            Stdout stdout <- cmd [path] [\"--no-user-package-db\", \"field\", input, \"depends\"]\n            return stdout\n        _ -> error $ \"Builder \" ++ show builder ++ \" can not be asked!\"\n\n    runBuilderWith :: Builder -> BuildInfo -> Action ()\n    runBuilderWith builder BuildInfo {..} = do\n        path <- builderPath builder\n        withResources buildResources $ do\n            verbosity <- getVerbosity\n            let input  = fromSingleton msgIn buildInputs\n                msgIn  = \"[runBuilderWith] Exactly one input file expected.\"\n                output = fromSingleton msgOut buildOutputs\n                msgOut = \"[runBuilderWith] Exactly one output file expected.\"\n                -- Suppress stdout depending on the Shake's verbosity setting.\n                echo = EchoStdout (verbosity >= Loud)\n                -- Capture stdout and write it to the output file.\n                captureStdout = do\n                    Stdout stdout <- cmd [path] buildArgs\n                    writeFileChanged output stdout\n            case builder of\n                Ar Pack _ -> do\n                    useTempFile <- flag ArSupportsAtFile\n                    if useTempFile then runAr                path buildArgs\n                                   else runArWithoutTempFile path buildArgs\n\n                Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs\n\n                Autoreconf dir -> cmd echo [Cwd dir] [path] buildArgs\n                Configure  dir -> do\n                    -- Inject /bin/bash into `libtool`, instead of /bin/sh,\n                    -- otherwise Windows breaks. TODO: Figure out why.\n                    bash <- bashPath\n                    let env = AddEnv \"CONFIG_SHELL\" bash\n                    cmd echo env [Cwd dir] [\"sh\", path] buildOptions buildArgs\n\n                HsCpp    -> captureStdout\n                GenApply -> captureStdout\n\n                GenPrimopCode -> do\n                    stdin <- readFile' input\n                    Stdout stdout <- cmd (Stdin stdin) [path] buildArgs\n                    writeFileChanged output stdout\n\n                Make dir -> cmd echo path [\"-C\", dir] buildArgs\n\n                Xelatex -> do\n                    unit $ cmd [Cwd output] [path]        buildArgs\n                    unit $ cmd [Cwd output] [path]        buildArgs\n                    unit $ cmd [Cwd output] [path]        buildArgs\n                    unit $ cmd [Cwd output] [\"makeindex\"] (input -<.> \"idx\")\n                    unit $ cmd [Cwd output] [path]        buildArgs\n                    unit $ cmd [Cwd output] [path]        buildArgs\n\n                GhcPkg Copy _ -> do\n                    Stdout pkgDesc <- cmd [path]\n                      [ \"--expand-pkgroot\"\n                      , \"--no-user-package-db\"\n                      , \"describe\"\n                      , input -- the package name\n                      ]\n                    cmd (Stdin pkgDesc) [path] (buildArgs ++ [\"-\"])\n\n                GhcPkg Unregister _ -> do\n                    Exit _ <- cmd echo [path] (buildArgs ++ [input])\n                    return ()\n\n                _  -> cmd echo [path] buildArgs\n\n-- TODO: Some builders are required only on certain platforms. For example,\n-- 'Objdump' is only required on OpenBSD and AIX. Add support for platform\n-- specific optional builders as soon as we can reliably test this feature.\n-- See https://github.com/snowleopard/hadrian/issues/211.\nisOptional :: Builder -> Bool\nisOptional = \\case\n    Objdump  -> True\n    _        -> False\n\n-- | Determine the location of a system 'Builder'.\nsystemBuilderPath :: Builder -> Action FilePath\nsystemBuilderPath builder = case builder of\n    Alex            -> fromKey \"alex\"\n    Ar _ Stage0     -> fromKey \"system-ar\"\n    Ar _ _          -> fromKey \"ar\"\n    Autoreconf _    -> stripExe =<< fromKey \"autoreconf\"\n    Cc  _  Stage0   -> fromKey \"system-cc\"\n    Cc  _  _        -> fromKey \"cc\"\n    -- We can't ask configure for the path to configure!\n    Configure _     -> return \"configure\"\n    Ghc _  Stage0   -> fromKey \"system-ghc\"\n    GhcPkg _ Stage0 -> fromKey \"system-ghc-pkg\"\n    Happy           -> fromKey \"happy\"\n    HsCpp           -> fromKey \"hs-cpp\"\n    Ld _            -> fromKey \"ld\"\n    Make _          -> fromKey \"make\"\n    Nm              -> fromKey \"nm\"\n    Objdump         -> fromKey \"objdump\"\n    Patch           -> fromKey \"patch\"\n    Perl            -> fromKey \"perl\"\n    Python          -> fromKey \"python\"\n    Ranlib          -> fromKey \"ranlib\"\n    RunTest         -> fromKey \"python\"\n    Sphinx _        -> fromKey \"sphinx-build\"\n    Tar _           -> fromKey \"tar\"\n    Xelatex         -> fromKey \"xelatex\"\n    _               -> error $ \"No entry for \" ++ show builder ++ inCfg\n  where\n    inCfg = \" in \" ++ quote configFile ++ \" file.\"\n    fromKey key = do\n        let unpack = fromMaybe . error $ \"Cannot find path to builder \"\n                ++ quote key ++ inCfg ++ \" Did you skip configure?\"\n        path <- unpack <$> lookupValue configFile key\n        if null path\n        then do\n            unless (isOptional builder) . error $ \"Non optional builder \"\n                ++ quote key ++ \" is not specified\" ++ inCfg\n            return \"\" -- TODO: Use a safe interface.\n        else do\n            win <- windowsHost\n            fullPath <- lookupInPath path\n            case (win, hasExtension fullPath) of\n                (False, _    ) -> return fullPath\n                (True , True ) -> fixAbsolutePathOnWindows fullPath\n                (True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe)\n\n    -- Without this function, on Windows we can observe a bad builder path\n    -- for 'autoreconf'. If the relevant system.config field is set to\n    -- /usr/bin/autoreconf in the file, the path that we read\n    -- is C:/msys64/usr/bin/autoreconf.exe. A standard msys2 set up happens\n    -- to have an executable named 'autoreconf' there, without the 'exe'\n    -- extension. Hence this function.\n    stripExe s = do\n        let sNoExt = dropExtension s\n        exists <- doesFileExist s\n        if exists then return s else return sNoExt\n\n\n-- | Was the path to a given system 'Builder' specified in configuration files?\nisSpecified :: Builder -> Action Bool\nisSpecified = fmap (not . null) . systemBuilderPath\n\n-- | Apply a patch by executing the 'Patch' builder in a given directory.\napplyPatch :: FilePath -> FilePath -> Action ()\napplyPatch dir patch = do\n    let file = dir -/- patch\n    needBuilder Patch\n    path <- builderPath Patch\n    putBuild $ \"| Apply patch \" ++ file\n    quietly $ cmd [Cwd dir, FileStdin file] [path, \"-p0\"]\n", "num_lines": 359}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CommandLine (\n    optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,\n    cmdProgressColour, cmdProgressInfo, cmdConfigure,\n    cmdDocsArgs, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs\n    ) where\n\nimport Data.Either\nimport qualified Data.HashMap.Strict as Map\nimport Data.List.Extra\nimport Development.Shake hiding (Normal)\nimport Flavour (DocTargets, DocTarget(..))\nimport Hadrian.Utilities hiding (buildRoot)\nimport System.Console.GetOpt\nimport System.Environment\n\nimport qualified Data.Set as Set\n\ndata TestSpeed = Slow | Average | Fast deriving (Show, Eq)\n\n-- | All arguments that can be passed to Hadrian via the command line.\ndata CommandLineArgs = CommandLineArgs\n    { configure      :: Bool\n    , flavour        :: Maybe String\n    , freeze1        :: Bool\n    , integerSimple  :: Bool\n    , progressColour :: UseColour\n    , progressInfo   :: ProgressInfo\n    , buildRoot      :: BuildRoot\n    , testArgs       :: TestArgs\n    , docTargets     :: DocTargets }\n    deriving (Eq, Show)\n\n-- | Default values for 'CommandLineArgs'.\ndefaultCommandLineArgs :: CommandLineArgs\ndefaultCommandLineArgs = CommandLineArgs\n    { configure      = False\n    , flavour        = Nothing\n    , freeze1        = False\n    , integerSimple  = False\n    , progressColour = Auto\n    , progressInfo   = Brief\n    , buildRoot      = BuildRoot \"_build\"\n    , testArgs       = defaultTestArgs\n    , docTargets     = Set.fromList [minBound..maxBound] }\n\n-- | These arguments are used by the `test` target.\ndata TestArgs = TestArgs\n    { testCompiler   :: String\n    , testConfigFile :: String\n    , testConfigs    :: [String]\n    , testJUnit      :: Maybe FilePath\n    , testOnly       :: [String]\n    , testOnlyPerf   :: Bool\n    , testSkipPerf   :: Bool\n    , testSpeed      :: TestSpeed\n    , testSummary    :: Maybe FilePath\n    , testVerbosity  :: Maybe String\n    , testWays       :: [String] }\n    deriving (Eq, Show)\n\n-- | Default value for `TestArgs`.\ndefaultTestArgs :: TestArgs\ndefaultTestArgs = TestArgs\n    { testCompiler   = \"stage2\"\n    , testConfigFile = \"testsuite/config/ghc\"\n    , testConfigs    = []\n    , testJUnit      = Nothing\n    , testOnly       = []\n    , testOnlyPerf   = False\n    , testSkipPerf   = False\n    , testSpeed      = Fast\n    , testSummary    = Nothing\n    , testVerbosity  = Nothing\n    , testWays       = [] }\n\nreadConfigure :: Either String (CommandLineArgs -> CommandLineArgs)\nreadConfigure = Right $ \\flags -> flags { configure = True }\n\nreadFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadFlavour ms = Right $ \\flags -> flags { flavour = lower <$> ms }\n\nreadBuildRoot :: Maybe FilePath -> Either String (CommandLineArgs -> CommandLineArgs)\nreadBuildRoot ms =\n    maybe (Left \"Cannot parse build-root\") (Right . set) (go =<< ms)\n  where\n    go :: String -> Maybe BuildRoot\n    go = Just . BuildRoot\n    set :: BuildRoot -> CommandLineArgs -> CommandLineArgs\n    set flag flags = flags { buildRoot = flag }\n\nreadFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)\nreadFreeze1 = Right $ \\flags -> flags { freeze1 = True }\n\nreadIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)\nreadIntegerSimple = Right $ \\flags -> flags { integerSimple = True }\n\nreadProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadProgressColour ms =\n    maybe (Left \"Cannot parse progress-colour\") (Right . set) (go =<< lower <$> ms)\n  where\n    go :: String -> Maybe UseColour\n    go \"never\"   = Just Never\n    go \"auto\"    = Just Auto\n    go \"always\"  = Just Always\n    go _         = Nothing\n    set :: UseColour -> CommandLineArgs -> CommandLineArgs\n    set flag flags = flags { progressColour = flag }\n\nreadProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadProgressInfo ms =\n    maybe (Left \"Cannot parse progress-info\") (Right . set) (go =<< lower <$> ms)\n  where\n    go :: String -> Maybe ProgressInfo\n    go \"none\"    = Just None\n    go \"brief\"   = Just Brief\n    go \"normal\"  = Just Normal\n    go \"unicorn\" = Just Unicorn\n    go _         = Nothing\n    set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs\n    set flag flags = flags { progressInfo = flag }\n\nreadTestCompiler :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestCompiler compiler = maybe (Left \"Cannot parse compiler\") (Right . set) compiler\n  where\n     set compiler  = \\flags -> flags { testArgs = (testArgs flags) { testCompiler = compiler } }\n\nreadTestConfig :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestConfig config =\n    case config of\n         Nothing -> Right id\n         Just conf -> Right $ \\flags ->\n                        let configs = conf : testConfigs (testArgs flags)\n                        in flags { testArgs = (testArgs flags) { testConfigs = configs } }\n\nreadTestConfigFile :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestConfigFile filepath =\n    maybe (Left \"Cannot parse test-speed\") (Right . set) filepath\n  where\n    set filepath flags =  flags { testArgs = (testArgs flags) { testConfigFile = filepath } }\n\nreadTestJUnit :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestJUnit filepath = Right $ \\flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }\n\nreadTestOnly :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestOnly tests = Right $ \\flags ->\n  flags { testArgs = (testArgs flags) { testOnly = tests' } }\n\n  where tests' = maybe [] words tests\n\nreadTestOnlyPerf :: Either String (CommandLineArgs -> CommandLineArgs)\nreadTestOnlyPerf = Right $ \\flags -> flags { testArgs = (testArgs flags) { testOnlyPerf = True } }\n\nreadTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)\nreadTestSkipPerf = Right $ \\flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }\n\nreadTestSpeed :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestSpeed ms =\n    maybe (Left \"Cannot parse test-speed\") (Right . set) (go =<< lower <$> ms)\n  where\n    go :: String -> Maybe TestSpeed\n    go \"fast\"    = Just Fast\n    go \"slow\"    = Just Slow\n    go \"average\" = Just Average\n    go _         = Nothing\n    set :: TestSpeed -> CommandLineArgs -> CommandLineArgs\n    set flag flags = flags { testArgs = (testArgs flags) {testSpeed = flag} }\n\nreadTestSummary :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestSummary filepath = Right $ \\flags -> flags { testArgs = (testArgs flags) { testJUnit = filepath } }\n\nreadTestVerbose :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestVerbose verbose = Right $ \\flags -> flags { testArgs = (testArgs flags) { testVerbosity = verbose } }\n\nreadTestWay :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadTestWay way =\n    case way of\n        Nothing -> Right id\n        Just way -> Right $ \\flags ->\n            let newWays = way : testWays (testArgs flags)\n            in flags { testArgs = (testArgs flags) {testWays = newWays} }\n\nreadDocsArg :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)\nreadDocsArg ms = maybe (Left \"Cannot parse docs argument\") (Right . set) (go =<< ms)\n\n  where\n    go :: String -> Maybe (DocTargets -> DocTargets)\n    go \"none\"           = Just (const Set.empty)\n    go \"no-haddocks\"    = Just (Set.delete Haddocks)\n    go \"no-sphinx-html\" = Just (Set.delete SphinxHTML)\n    go \"no-sphinx-pdfs\" = Just (Set.delete SphinxPDFs)\n    go \"no-sphinx-man\"  = Just (Set.delete SphinxMan)\n    go \"no-sphinx\"      = Just (Set.delete SphinxHTML\n                              . Set.delete SphinxPDFs\n                              . Set.delete SphinxMan)\n    go _                = Nothing\n\n    set :: (DocTargets -> DocTargets) -> CommandLineArgs -> CommandLineArgs\n    set tweakTargets flags = flags\n      { docTargets = tweakTargets (docTargets flags) }\n\n-- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.\noptDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]\noptDescrs =\n    [ Option ['c'] [\"configure\"] (NoArg readConfigure)\n      \"Run the boot and configure scripts (if you do not want to run them manually).\"\n    , Option ['o'] [\"build-root\"] (OptArg readBuildRoot \"BUILD_ROOT\")\n      \"Where to store build artifacts. (Default _build).\"\n    , Option [] [\"flavour\"] (OptArg readFlavour \"FLAVOUR\")\n      \"Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest).\"\n    , Option [] [\"freeze1\"] (NoArg readFreeze1)\n      \"Freeze Stage1 GHC.\"\n    , Option [] [\"integer-simple\"] (NoArg readIntegerSimple)\n      \"Build GHC with integer-simple library.\"\n    , Option [] [\"progress-colour\"] (OptArg readProgressColour \"MODE\")\n      \"Use colours in progress info (Never, Auto or Always).\"\n    , Option [] [\"progress-info\"] (OptArg readProgressInfo \"STYLE\")\n      \"Progress info style (None, Brief, Normal or Unicorn).\"\n    , Option [] [\"docs\"] (OptArg readDocsArg \"TARGET\")\n      \"Strip down docs targets (none, no-haddocks, no-sphinx[-{html, pdfs, man}].\"\n    , Option [] [\"test-compiler\"] (OptArg readTestCompiler \"TEST_COMPILER\")\n      \"Use given compiler [Default=stage2].\"\n    , Option [] [\"test-config-file\"] (OptArg readTestConfigFile \"CONFIG_FILE\")\n      \"configuration file for testsuite. Default=testsuite/config/ghc\"\n    , Option [] [\"config\"] (OptArg readTestConfig \"EXTRA_TEST_CONFIG\")\n      \"Configurations to run test, in key=value format.\"\n    , Option [] [\"summary-junit\"] (OptArg readTestJUnit \"TEST_SUMMARY_JUNIT\")\n      \"Output testsuite summary in JUnit format.\"\n    , Option [] [\"only\"] (OptArg readTestOnly \"TESTS\")\n      \"Test cases to run.\"\n    , Option [] [\"only-perf\"] (NoArg readTestOnlyPerf)\n      \"Only run performance tests.\"\n    , Option [] [\"skip-perf\"] (NoArg readTestSkipPerf)\n      \"Skip performance tests.\"\n    , Option [] [\"test-speed\"] (OptArg readTestSpeed \"SPEED\")\n      \"fast, slow or normal. Normal by default\"\n    , Option [] [\"summary\"] (OptArg readTestSummary \"TEST_SUMMARY\")\n      \"Where to output the test summary file.\"\n    , Option [] [\"test-verbose\"] (OptArg readTestVerbose \"TEST_VERBOSE\")\n      \"A verbosity value between 0 and 5. 0 is silent, 4 and higher activates extra output.\"\n    , Option [] [\"test-way\"] (OptArg readTestWay \"TEST_WAY\")\n      \"only run these ways\" ]\n\n-- | A type-indexed map containing Hadrian command line arguments to be passed\n-- to Shake via 'shakeExtra'.\ncmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)\ncmdLineArgsMap = do\n    (opts, _, _) <- getOpt Permute optDescrs <$> getArgs\n    let args = foldl (flip id) defaultCommandLineArgs (rights opts)\n    return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities\n           $ insertExtra (progressInfo   args) -- Accessed by Hadrian.Utilities\n           $ insertExtra (buildRoot      args) -- Accessed by Hadrian.Utilities\n           $ insertExtra (testArgs       args) -- Accessed by Settings.Builders.RunTest\n           $ insertExtra args Map.empty\n\ncmdLineArgs :: Action CommandLineArgs\ncmdLineArgs = userSetting defaultCommandLineArgs\n\ncmdConfigure :: Action Bool\ncmdConfigure = configure <$> cmdLineArgs\n\ncmdFlavour :: Action (Maybe String)\ncmdFlavour = flavour <$> cmdLineArgs\n\nlookupBuildRoot :: Map.HashMap TypeRep Dynamic -> BuildRoot\nlookupBuildRoot = buildRoot . lookupExtra defaultCommandLineArgs\n\nlookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool\nlookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs\n\ncmdIntegerSimple :: Action Bool\ncmdIntegerSimple = integerSimple <$> cmdLineArgs\n\ncmdProgressColour :: Action UseColour\ncmdProgressColour = progressColour <$> cmdLineArgs\n\ncmdProgressInfo :: Action ProgressInfo\ncmdProgressInfo = progressInfo <$> cmdLineArgs\n\ncmdDocsArgs :: Action DocTargets\ncmdDocsArgs = docTargets <$> cmdLineArgs\n", "num_lines": 281}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Context (\n    -- * Context\n    Context (..), vanillaContext, stageContext,\n\n    -- * Expressions\n    getStage, getPackage, getWay, getStagedSettingList, getBuildPath,\n\n    -- * Paths\n    contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,\n    pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath,\n    contextPath, getContextPath, libPath, distDir\n    ) where\n\nimport Base\nimport Context.Path\nimport Context.Type\nimport Hadrian.Expression\nimport Hadrian.Haskell.Cabal\nimport Oracles.Setting\n\n-- | Most targets are built only one way, hence the notion of 'vanillaContext'.\nvanillaContext :: Stage -> Package -> Context\nvanillaContext s p = Context s p vanilla\n\n-- | Partial context with undefined 'Package' field. Useful for 'Packages'\n-- expressions that only read the environment and current 'Stage'.\nstageContext :: Stage -> Context\nstageContext s = vanillaContext s $ error \"stageContext: package not set\"\n\n-- | Get the 'Stage' of the current 'Context'.\ngetStage :: Expr Context b Stage\ngetStage = stage <$> getContext\n\n-- | Get the 'Package' of the current 'Context'.\ngetPackage :: Expr Context b Package\ngetPackage = package <$> getContext\n\n-- | Get the 'Way' of the current 'Context'.\ngetWay :: Expr Context b Way\ngetWay = way <$> getContext\n\n-- | Get a list of configuration settings for the current stage.\ngetStagedSettingList :: (Stage -> SettingList) -> Args Context b\ngetStagedSettingList f = getSettingList . f =<< getStage\n\n-- | Path to the directory containg the final artifact in a given 'Context'.\nlibPath :: Context -> Action FilePath\nlibPath Context {..} = buildRoot <&> (-/- (stageString stage -/- \"lib\"))\n\n-- | Get the directory name for binary distribution files\n-- @<arch>-<os>-ghc-<version>@.\n--\n-- We preform some renaming to accomodate Cabal's slightly different naming\n-- conventions (see 'cabalOsString' and 'cabalArchString').\ndistDir :: Action FilePath\ndistDir = do\n    version        <- setting ProjectVersion\n    hostOs         <- cabalOsString <$> setting BuildOs\n    hostArch       <- cabalArchString <$> setting BuildArch\n    return $ hostArch ++ \"-\" ++ hostOs ++ \"-ghc-\" ++ version\n\npkgFile :: Context -> String -> String -> Action FilePath\npkgFile context@Context {..} prefix suffix = do\n    path <- buildPath context\n    pid  <- pkgIdentifier package\n    return $ path -/- prefix ++ pid ++ suffix\n\n-- | Path to inplace package configuration file of a given 'Context'.\npkgInplaceConfig :: Context -> Action FilePath\npkgInplaceConfig context = contextPath context <&> (-/- \"inplace-pkg-config\")\n\n-- | Path to the @setup-config@ of a given 'Context'.\npkgSetupConfigFile :: Context -> Action FilePath\npkgSetupConfigFile context = contextPath context <&> (-/- \"setup-config\")\n\n-- | Path to the haddock file of a given 'Context', e.g.:\n-- @_build/stage1/libraries/array/doc/html/array/array.haddock@.\npkgHaddockFile :: Context -> Action FilePath\npkgHaddockFile Context {..} = do\n    root <- buildRoot\n    let name = pkgName package\n    return $ root -/- \"docs/html/libraries\" -/- name -/- name <.> \"haddock\"\n\n-- | Path to the library file of a given 'Context', e.g.:\n-- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.\npkgLibraryFile :: Context -> Action FilePath\npkgLibraryFile context@Context {..} = do\n    extension <- libsuf way\n    pkgFile context \"libHS\" extension\n\n-- | Path to the GHCi library file of a given 'Context', e.g.:\n-- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.\npkgGhciLibraryFile :: Context -> Action FilePath\npkgGhciLibraryFile context@Context {..} = do\n    let extension = \"\" <.> osuf way\n    pkgFile context \"HS\" extension\n\n-- | Path to the configuration file of a given 'Context'.\npkgConfFile :: Context -> Action FilePath\npkgConfFile Context {..} = do\n    pid  <- pkgIdentifier package\n    dbPath <- packageDbPath stage\n    return $ dbPath -/- pid <.> \"conf\"\n\n-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'\n-- to its object file. For example:\n-- * \"Task.c\"                              -> \"_build/stage1/rts/Task.thr_o\"\n-- * \"_build/stage1/rts/cmm/AutoApply.cmm\" -> \"_build/stage1/rts/cmm/AutoApply.o\"\nobjectPath :: Context -> FilePath -> Action FilePath\nobjectPath context@Context {..} src = do\n    isGenerated <- isGeneratedSource src\n    path        <- buildPath context\n    let extension = drop 1 $ takeExtension src\n        obj       = src -<.> osuf way\n        result | isGenerated          = obj\n               | \"*hs*\" ?== extension = path -/- obj\n               | otherwise            = path -/- extension -/- obj\n    return result\n", "num_lines": 119}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Environment (setupEnvironment) where\n\nimport System.Environment\n\n-- | The build system invokes many external builders whose behaviour is\n-- influenced by the environment variables. We need to modify some of them\n-- for better robustness of the build system.\nsetupEnvironment :: IO ()\nsetupEnvironment = do\n    -- Cabal refuses to work when GHC_PACKAGE_PATH is set (e.g. by Stack)\n    unsetEnv \"GHC_PACKAGE_PATH\"\n\n    -- cabal new-exec sets GHC_ENVIRONMENT, it needs to be unset for GHC\n    -- invocations to work properly\n    unsetEnv \"GHC_ENVIRONMENT\"\n\n    -- in MinGW if PWD is set to a Windows \"C:\\\\\" style path then configure\n    -- `pwd` will return the Windows path, and then modifying $PATH will fail.\n    -- See https://github.com/snowleopard/hadrian/issues/189 for details.\n    unsetEnv \"PWD\"\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Expression (\n    -- * Expressions\n    Expr, Predicate, Args, Ways,\n\n    -- ** Construction and modification\n    expr, exprIO, arg, remove,\n\n    -- ** Predicates\n    (?), stage, stage0, stage1, stage2, notStage0, package, notPackage,\n    libraryPackage, builder, way, input, inputs, output, outputs,\n\n    -- ** Evaluation\n    interpret, interpretInContext,\n\n    -- * Convenient accessors\n    getBuildRoot, getContext, getOutputs, getInputs,\n    getInput, getOutput, getContextData,\n\n    -- * Re-exports\n    module Base,\n    module Builder,\n    module Context,\n    ) where\n\nimport Base\nimport Builder\nimport Context hiding (stage, package, way)\nimport Expression.Type\nimport Hadrian.Expression hiding (Expr, Predicate, Args)\nimport Hadrian.Haskell.Cabal.Type\nimport Hadrian.Oracles.Cabal\n\n-- | Get values from a configured cabal stage.\ngetContextData :: (ContextData -> a) -> Expr a\ngetContextData key = do\n    contextData <- expr . readContextData =<< getContext\n    return $ key contextData\n\n-- | Is the build currently in the provided stage?\nstage :: Stage -> Predicate\nstage s = (s ==) <$> getStage\n\n-- | Is a particular package being built?\npackage :: Package -> Predicate\npackage p = (p ==) <$> getPackage\n\n-- | This type class allows the user to construct both precise builder\n-- predicates, such as @builder (Ghc CompileHs Stage1)@, as well as predicates\n-- covering a set of similar builders. For example, @builder (Ghc CompileHs)@\n-- matches any stage, and @builder Ghc@ matches any stage and any GHC mode.\nclass BuilderPredicate a where\n    -- | Is a particular builder being used?\n    builder :: a -> Predicate\n\ninstance BuilderPredicate Builder where\n    builder b = (b ==) <$> getBuilder\n\ninstance BuilderPredicate a => BuilderPredicate (Stage -> a) where\n    builder f = builder . f =<< getStage\n\ninstance BuilderPredicate a => BuilderPredicate (CcMode -> a) where\n    builder f = do\n        b <- getBuilder\n        case b of\n            Cc  c _ -> builder (f c)\n            _       -> return False\n\ninstance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where\n    builder f = do\n        b <- getBuilder\n        case b of\n            Ghc c _ -> builder (f c)\n            _       -> return False\n\ninstance BuilderPredicate a => BuilderPredicate (FilePath -> a) where\n    builder f = do\n        b <- getBuilder\n        case b of\n            Configure path -> builder (f path)\n            _              -> return False\n\n-- | Is the current build 'Way' equal to a certain value?\nway :: Way -> Predicate\nway w = (w ==) <$> getWay\n\n-- | Is the build currently in stage 0?\nstage0 :: Predicate\nstage0 = stage Stage0\n\n-- | Is the build currently in stage 1?\nstage1 :: Predicate\nstage1 = stage Stage1\n\n-- | Is the build currently in stage 2?\nstage2 :: Predicate\nstage2 = stage Stage2\n\n-- | Is the build /not/ in stage 0 right now?\nnotStage0 :: Predicate\nnotStage0 = notM stage0\n\n-- | Is a certain package /not/ built right now?\nnotPackage :: Package -> Predicate\nnotPackage = notM . package\n\n-- | Is a library package currently being built?\nlibraryPackage :: Predicate\nlibraryPackage = isLibrary <$> getPackage\n", "num_lines": 109}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Flavour\n  ( Flavour (..), werror\n  , DocTargets, DocTarget(..)\n  ) where\n\nimport Expression\nimport Data.Set (Set)\n\n-- Please update doc/{flavours.md, user-settings.md} when changing this file.\n-- | 'Flavour' is a collection of build settings that fully define a GHC build.\n-- Note the following type semantics:\n-- * @Bool@: a plain Boolean flag whose value is known at compile time.\n-- * @Action Bool@: a flag whose value can depend on the build environment.\n-- * @Predicate@: a flag whose value can depend on the build environment and\n-- on the current build target.\ndata Flavour = Flavour {\n    -- | Flavour name, to select this flavour from command line.\n    name :: String,\n    -- | Use these command line arguments.\n    args :: Args,\n    -- | Build these packages.\n    packages :: Stage -> Action [Package],\n    -- | Either 'integerGmp' or 'integerSimple'.\n    integerLibrary :: Action Package,\n    -- | Build libraries these ways.\n    libraryWays :: Ways,\n    -- | Build RTS these ways.\n    rtsWays :: Ways,\n    -- | Build dynamic GHC programs.\n    dynamicGhcPrograms :: Action Bool,\n    -- | Enable GHCi debugger.\n    ghciWithDebugger :: Bool,\n    -- | Build profiled GHC.\n    ghcProfiled :: Bool,\n    -- | Build GHC with debug information.\n    ghcDebugged :: Bool,\n    -- | Whether to build docs and which ones\n    --   (haddocks, user manual, haddock manual)\n    ghcDocs :: Action DocTargets }\n\n-- | A set of documentation targets\ntype DocTargets = Set DocTarget\n\n-- | Documentation targets\n--\n--   While we can't reasonably expose settings or CLI options\n--   to selectively disable, say, base's haddocks, we can offer\n--   a less fine-grained choice:\n--\n--   - haddocks for libraries\n--   - non-haddock html pages (e.g GHC's user manual)\n--   - PDF documents (e.g haddock's manual)\n--   - man pages (GHC's)\n--\n--   The main goal being to have easy ways to do away with the need\n--   for e.g @sphinx-build@ or @xelatex@ and associated packages\n--   while still being able to build a(n almost) complete binary\n--   distribution.\ndata DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan\n  deriving (Eq, Ord, Show, Bounded, Enum)\n\n-- | Turn on -Werror for packages built with the stage1 compiler.\n-- It mimics the CI settings so is useful to turn on when developing.\nwerror :: Flavour -> Flavour\nwerror fl = fl { args = args fl <> (builder Ghc ? notStage0 ? arg \"-Werror\") }\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Development.Shake\nimport Hadrian.Expression\nimport Hadrian.Utilities\n\nimport qualified Base\nimport qualified CommandLine\nimport qualified Environment\nimport qualified Rules\nimport qualified Rules.Clean\nimport qualified Rules.Documentation\nimport qualified Rules.Nofib\nimport qualified Rules.SourceDist\nimport qualified Rules.Selftest\nimport qualified Rules.Test\nimport qualified UserSettings\n\nmain :: IO ()\nmain = do\n    -- Provide access to command line arguments and some user settings through\n    -- Shake's type-indexed map 'shakeExtra'.\n    argsMap <- CommandLine.cmdLineArgsMap\n    let extra = insertExtra UserSettings.buildProgressColour\n              $ insertExtra UserSettings.successColour\n              $ insertExtra (VerboseCommand UserSettings.verboseCommand) argsMap\n\n        BuildRoot buildRoot = CommandLine.lookupBuildRoot argsMap\n\n        rebuild = [ (RebuildLater, buildRoot -/- \"stage0//*\")\n                  | CommandLine.lookupFreeze1 argsMap ]\n\n        options :: ShakeOptions\n        options = shakeOptions\n            { shakeChange   = ChangeModtimeAndDigest\n            , shakeFiles    = buildRoot -/- Base.shakeFilesDir\n            , shakeProgress = progressSimple\n            , shakeRebuild  = rebuild\n            , shakeTimings  = True\n            , shakeExtra    = extra }\n\n        rules :: Rules ()\n        rules = do\n            Rules.buildRules\n            Rules.Documentation.documentationRules\n            Rules.Clean.cleanRules\n            Rules.Nofib.nofibRules\n            Rules.oracleRules\n            Rules.Selftest.selftestRules\n            Rules.SourceDist.sourceDistRules\n            Rules.Test.testRules\n            Rules.topLevelTargets\n\n    shakeArgsWith options CommandLine.optDescrs $ \\_ targets -> do\n        Environment.setupEnvironment\n        return . Just $ if null targets\n                        then rules\n                        else want targets >> withoutActions rules\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-missing-signatures #-}\nmodule Packages (\n    -- * GHC packages\n    array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr,\n    compareSizes, compiler, containers, deepseq, deriveConstants, directory,\n    filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact,\n    ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline,\n    hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi,\n    libiserv, mtl, parsec, pretty, primitive, process, rts, runGhc,\n    stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers,\n    unlit, unix, win32, xhtml, ghcPackages, isGhcPackage,\n\n    -- * Package information\n    programName, nonHsMainPackage, autogenPath, programPath, timeoutPath,\n    rtsContext, rtsBuildPath, libffiBuildPath, libffiLibraryName,\n    generatedGhcDependencies, ensureConfigured\n    ) where\n\nimport Hadrian.Package\nimport Hadrian.Utilities\n\nimport Base\nimport Context\nimport Oracles.Flag\nimport Oracles.Setting\n\n-- | These are all GHC packages we know about. Build rules will be generated for\n-- all of them. However, not all of these packages will be built. For example,\n-- package 'win32' is built only on Windows. @GHC.defaultPackages@ defines\n-- default conditions for building each package. Users can add their own\n-- packages and modify build default build conditions in \"UserSettings\".\nghcPackages :: [Package]\nghcPackages =\n    [ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations\n    , compareSizes, compiler, containers, deepseq, deriveConstants, directory\n    , filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact\n    , ghcHeap, ghci, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps\n    , hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl\n    , parsec, pretty, process, rts, runGhc, stm, templateHaskell\n    , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml\n    , timeout ]\n\n-- TODO: Optimise by switching to sets of packages.\nisGhcPackage :: Package -> Bool\nisGhcPackage = (`elem` ghcPackages)\n\n-- | Package definitions, see 'Package'.\narray               = lib  \"array\"\nbase                = lib  \"base\"\nbinary              = lib  \"binary\"\nbytestring          = lib  \"bytestring\"\ncabal               = lib  \"Cabal\"           `setPath` \"libraries/Cabal/Cabal\"\ncheckApiAnnotations = util \"check-api-annotations\"\ncheckPpr            = util \"check-ppr\"\ncompareSizes        = util \"compareSizes\"    `setPath` \"utils/compare_sizes\"\ncompiler            = top  \"ghc\"             `setPath` \"compiler\"\ncontainers          = lib  \"containers\"\ndeepseq             = lib  \"deepseq\"\nderiveConstants     = util \"deriveConstants\"\ndirectory           = lib  \"directory\"\nfilepath            = lib  \"filepath\"\ngenapply            = util \"genapply\"\ngenprimopcode       = util \"genprimopcode\"\nghc                 = prg  \"ghc-bin\"         `setPath` \"ghc\"\nghcBoot             = lib  \"ghc-boot\"\nghcBootTh           = lib  \"ghc-boot-th\"\nghcCompact          = lib  \"ghc-compact\"\nghcHeap             = lib  \"ghc-heap\"\nghci                = lib  \"ghci\"\nghcPkg              = util \"ghc-pkg\"\nghcPrim             = lib  \"ghc-prim\"\nhaddock             = util \"haddock\"\nhaskeline           = lib  \"haskeline\"\nhsc2hs              = util \"hsc2hs\"\nhp2ps               = util \"hp2ps\"\nhpc                 = lib  \"hpc\"\nhpcBin              = util \"hpc-bin\"         `setPath` \"utils/hpc\"\nintegerGmp          = lib  \"integer-gmp\"\nintegerSimple       = lib  \"integer-simple\"\niserv               = util \"iserv\"\nlibffi              = top  \"libffi\"\nlibiserv            = lib  \"libiserv\"\nmtl                 = lib  \"mtl\"\nparsec              = lib  \"parsec\"\npretty              = lib  \"pretty\"\nprimitive           = lib  \"primitive\"\nprocess             = lib  \"process\"\nrts                 = top  \"rts\"\nrunGhc              = util \"runghc\"\nstm                 = lib  \"stm\"\ntemplateHaskell     = lib  \"template-haskell\"\nterminfo            = lib  \"terminfo\"\ntext                = lib  \"text\"\ntime                = lib  \"time\"\ntimeout             = util \"timeout\"         `setPath` \"testsuite/timeout\"\ntouchy              = util \"touchy\"\ntransformers        = lib  \"transformers\"\nunlit               = util \"unlit\"\nunix                = lib  \"unix\"\nwin32               = lib  \"Win32\"\nxhtml               = lib  \"xhtml\"\n\n-- | Construct a library package, e.g. @array@.\nlib :: PackageName -> Package\nlib name = library name (\"libraries\" -/- name)\n\n-- | Construct a top-level library package, e.g. @compiler@.\ntop :: PackageName -> Package\ntop name = library name name\n\n-- | Construct a top-level program package, e.g. @ghc@.\nprg :: PackageName -> Package\nprg name = program name name\n\n-- | Construct a utility package, e.g. @haddock@.\nutil :: PackageName -> Package\nutil name = program name (\"utils\" -/- name)\n\n-- | Amend a package path if it doesn't conform to a typical pattern.\nsetPath :: Package -> FilePath -> Package\nsetPath pkg path = pkg { pkgPath = path }\n\n-- | Given a 'Context', compute the name of the program that is built in it\n-- assuming that the corresponding package's type is 'Program'. For example, GHC\n-- built in 'Stage0' is called @ghc-stage1@. If the given package is a\n-- 'Library', the function simply returns its name.\nprogramName :: Context -> Action String\nprogramName Context {..} = do\n    cross <- flag CrossCompiling\n    targetPlatform <- setting TargetPlatformFull\n    let prefix = if cross then targetPlatform ++ \"-\" else \"\"\n    -- TODO: Can we extract this information from Cabal files?\n    -- Alp: We could, but then the iserv package would have to\n    --      use Cabal conditionals + a 'profiling' flag\n    --      to declare the executable name, and I'm not sure\n    --      this is allowed (or desired for that matter).\n    return $ prefix ++ case package of\n                              p | p == ghc    -> \"ghc\"\n                                | p == hpcBin -> \"hpc\"\n                                | p == iserv  -> \"ghc-iserv\" ++ concat [\n                                    if wayUnit' `wayUnit` way\n                                        then suffix\n                                        else \"\"\n                                    | (wayUnit', suffix) <- [\n                                        (Profiling, \"-prof\"),\n                                        (Dynamic,   \"-dyn\")\n                                    ]]\n                              _ -> pkgName package\n\n-- | The 'FilePath' to a program executable in a given 'Context'.\nprogramPath :: Context -> Action FilePath\nprogramPath context@Context {..} = do\n    -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of\n    -- @bin@, which is likely just a historical accident that should be fixed.\n    -- See: https://github.com/snowleopard/hadrian/issues/570\n    -- Likewise for @iserv@ and @unlit@.\n    name <- programName context\n    path <- if package `elem` [iserv, touchy, unlit]\n              then stageLibPath stage <&> (-/- \"bin\")\n              else stageBinPath stage\n    return $ path -/- name <.> exe\n\n-- TODO: Move @timeout@ to the @util@ directory and build in a more standard\n-- location like other programs used only by the testsuite.\ntimeoutPath :: FilePath\ntimeoutPath = \"testsuite/timeout/install-inplace/bin/timeout\" <.> exe\n\n-- TODO: Can we extract this information from Cabal files?\n-- | Some program packages should not be linked with Haskell main function.\nnonHsMainPackage :: Package -> Bool\nnonHsMainPackage = (`elem` [ghc, hp2ps, iserv, touchy, unlit])\n\n-- TODO: Combine this with 'programName'.\n-- | Path to the @autogen@ directory generated by 'buildAutogenFiles'.\nautogenPath :: Context -> Action FilePath\nautogenPath context@Context {..}\n    | isLibrary package = autogen \"build\"\n    | package == ghc    = autogen \"build/ghc\"\n    | package == hpcBin = autogen \"build/hpc\"\n    | otherwise         = autogen $ \"build\" -/- pkgName package\n  where\n    autogen dir = contextPath context <&> (-/- dir -/- \"autogen\")\n\n-- | Make sure a given context has already been fully configured. The\n-- implementation simply calls 'need' on the context's @autogen/cabal_macros.h@\n-- file, which triggers 'configurePackage' and 'buildAutogenFiles'. Why this\n-- indirection? Going via @autogen/cabal_macros.h@ allows us to cache the\n-- configuration steps, i.e. not to repeat them if they have already been done.\nensureConfigured :: Context -> Action ()\nensureConfigured context = do\n    autogen <- autogenPath context\n    need [autogen -/- \"cabal_macros.h\"]\n\n-- | RTS is considered a Stage1 package. This determines RTS build directory.\nrtsContext :: Stage -> Context\nrtsContext stage = vanillaContext stage rts\n\n-- | Path to the RTS build directory.\nrtsBuildPath :: Stage -> Action FilePath\nrtsBuildPath stage = buildPath (rtsContext stage)\n\n-- | Build directory for in-tree 'libffi' library.\nlibffiBuildPath :: Stage -> Action FilePath\nlibffiBuildPath stage = buildPath $ Context\n    stage\n    libffi\n    (error \"libffiBuildPath: way not set.\")\n\n-- | Name of the 'libffi' library.\nlibffiLibraryName :: Action FilePath\nlibffiLibraryName = do\n    useSystemFfi <- flag UseSystemFfi\n    windows      <- windowsHost\n    return $ case (useSystemFfi, windows) of\n        (True , False) -> \"ffi\"\n        (False, False) -> \"Cffi\"\n        (_    , True ) -> \"Cffi-6\"\n\n-- | Generated header files required by GHC in runtime.\ngeneratedGhcDependencies :: Stage -> Action [FilePath]\ngeneratedGhcDependencies stage = do\n    let context = vanillaContext stage compiler\n    bh <- buildPath   context <&> (-/- \"ghc_boot_platform.h\")\n    ch <- contextPath context <&> (-/- \"ghc_boot_platform.h\")\n    is <- includesDependencies\n    return $ is ++ [bh, ch]\n", "num_lines": 227}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules (buildRules, oracleRules, packageTargets, topLevelTargets) where\n\nimport qualified Hadrian.Oracles.ArgsHash\nimport qualified Hadrian.Oracles.Cabal.Rules\nimport qualified Hadrian.Oracles.DirectoryContents\nimport qualified Hadrian.Oracles.Path\nimport qualified Hadrian.Oracles.TextFile\n\nimport Expression\nimport qualified Oracles.ModuleFiles\nimport Packages\nimport qualified Rules.BinaryDist\nimport qualified Rules.Compile\nimport qualified Rules.Configure\nimport qualified Rules.Dependencies\nimport qualified Rules.Documentation\nimport qualified Rules.Generate\nimport qualified Rules.Gmp\nimport qualified Rules.Libffi\nimport qualified Rules.Library\nimport qualified Rules.Program\nimport qualified Rules.Register\nimport qualified Rules.SimpleTargets\nimport Settings\nimport Target\nimport UserSettings\nimport Utilities\n\nallStages :: [Stage]\nallStages = [minBound .. maxBound]\n\n-- | This rule calls 'need' on all top-level build targets that Hadrian builds\n-- by default, respecting the 'finalStage' flag.\ntopLevelTargets :: Rules ()\ntopLevelTargets = action $ do\n    verbosity <- getVerbosity\n    forM_ [ Stage1 ..] $ \\stage -> do\n      when (verbosity >= Loud) $ do\n        (libraries, programs) <- partition isLibrary <$> stagePackages stage\n        libNames <- mapM (name stage) libraries\n        pgmNames <- mapM (name stage) programs\n        let stageHeader t ps =\n              \"| Building \" ++ show stage ++ \" \"\n                            ++ t ++ \": \" ++ intercalate \", \" ps\n        putNormal . unlines $\n            [ stageHeader \"libraries\" libNames\n            , stageHeader \"programs\" pgmNames ]\n    let buildStages = [ s | s <- [Stage0 ..], s < finalStage ]\n    targets <- concatForM buildStages $ \\stage -> do\n        packages <- stagePackages stage\n        mapM (path stage) packages\n    need targets\n  where\n    -- either the package database config file for libraries or\n    -- the programPath for programs. However this still does\n    -- not support multiple targets, where a cabal package has\n    -- a library /and/ a program.\n    path :: Stage -> Package -> Action FilePath\n    path stage pkg | isLibrary pkg = pkgConfFile (vanillaContext stage pkg)\n                   | otherwise     = programPath =<< programContext stage pkg\n    name :: Stage -> Package -> Action String\n    name stage pkg | isLibrary pkg = return (pkgName pkg)\n                   | otherwise     = programName (vanillaContext stage pkg)\n\n-- TODO: Get rid of the @includeGhciLib@ hack.\n-- | Return the list of targets associated with a given 'Stage' and 'Package'.\n-- By setting the Boolean parameter to False it is possible to exclude the GHCi\n-- library from the targets, and avoid configuring the package to determine\n-- whether GHCi library needs to be built for it. We typically want to set\n-- this parameter to True, however it is important to set it to False when\n-- computing 'topLevelTargets', as otherwise the whole build gets sequentialised\n-- because packages are configured in the order respecting their dependencies.\npackageTargets :: Bool -> Stage -> Package -> Action [FilePath]\npackageTargets includeGhciLib stage pkg = do\n    let context = vanillaContext stage pkg\n    activePackages <- stagePackages stage\n    if pkg `notElem` activePackages\n    then return [] -- Skip inactive packages.\n    else if isLibrary pkg\n        then do -- Collect all targets of a library package.\n            let pkgWays = if pkg == rts then getRtsWays else getLibraryWays\n            ways  <- interpretInContext context pkgWays\n            libs  <- mapM (pkgLibraryFile . Context stage pkg) ways\n            more  <- libraryTargets includeGhciLib context\n            setupConfig <- pkgSetupConfigFile context\n            return $ [setupConfig] ++ libs ++ more\n        else do -- The only target of a program package is the executable.\n            prgContext <- programContext stage pkg\n            prgPath    <- programPath prgContext\n            return [prgPath]\n\npackageRules :: Rules ()\npackageRules = do\n    -- We cannot register multiple GHC packages in parallel. Also we cannot run\n    -- GHC when the package database is being mutated by \"ghc-pkg\". This is a\n    -- classic concurrent read exclusive write (CREW) conflict.\n    let maxConcurrentReaders = 1000\n    packageDb <- newResource \"package-db\" maxConcurrentReaders\n    let readPackageDb  = [(packageDb, 1)]\n        writePackageDb = [(packageDb, maxConcurrentReaders)]\n\n    Rules.Compile.compilePackage readPackageDb\n    Rules.Dependencies.buildPackageDependencies readPackageDb\n    Rules.Documentation.buildPackageDocumentation\n    Rules.Program.buildProgramRules readPackageDb\n    Rules.Register.configurePackageRules\n\n    forM_ [Stage0 ..] (Rules.Register.registerPackageRules writePackageDb)\n\n    -- TODO: Can we get rid of this enumeration of contexts? Since we iterate\n    --       over it to generate all 4 types of rules below, all the time, we\n    --       might want to see whether the parse-and-extract approach of\n    --       Rules.Compile and Rules.Library could save us some time there.\n    let vanillaContexts = liftM2 vanillaContext allStages knownPackages\n\n    forM_ vanillaContexts Rules.Generate.generatePackageCode\n    Rules.SimpleTargets.simplePackageTargets\n\nbuildRules :: Rules ()\nbuildRules = do\n    Rules.BinaryDist.bindistRules\n    Rules.Configure.configureRules\n    Rules.Generate.copyRules\n    Rules.Generate.generateRules\n    Rules.Gmp.gmpRules\n    Rules.Libffi.libffiRules\n    Rules.Library.libraryRules\n    packageRules\n\noracleRules :: Rules ()\noracleRules = do\n    Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs\n    Hadrian.Oracles.Cabal.Rules.cabalOracle\n    Hadrian.Oracles.DirectoryContents.directoryContentsOracle\n    Hadrian.Oracles.Path.pathOracle\n    Hadrian.Oracles.TextFile.textFileOracle\n    Oracles.ModuleFiles.moduleFilesOracle\n", "num_lines": 138}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings (\n    getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,\n    findPackageByName, unsafeFindPackageByName, unsafeFindPackageByPath,\n    isLibrary, stagePackages, programContext, getIntegerPackage\n    ) where\n\nimport CommandLine\nimport Expression\nimport Flavour\nimport Packages\nimport UserSettings (userFlavours, userPackages, userDefaultFlavour)\n\nimport {-# SOURCE #-} Settings.Default\nimport Settings.Flavours.Development\nimport Settings.Flavours.Llvm\nimport Settings.Flavours.Performance\nimport Settings.Flavours.Profiled\nimport Settings.Flavours.Quick\nimport Settings.Flavours.Quickest\nimport Settings.Flavours.QuickCross\n\ngetArgs :: Args\ngetArgs = expr flavour >>= args\n\ngetLibraryWays :: Ways\ngetLibraryWays = expr flavour >>= libraryWays\n\ngetRtsWays :: Ways\ngetRtsWays = expr flavour >>= rtsWays\n\nstagePackages :: Stage -> Action [Package]\nstagePackages stage = do\n    f <- flavour\n    packages f stage\n\nhadrianFlavours :: [Flavour]\nhadrianFlavours =\n    [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2\n    , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour\n    , quickCrossFlavour\n    , performanceLlvmFlavour, profiledLlvmFlavour, quickLlvmFlavour ]\n\nflavour :: Action Flavour\nflavour = do\n    flavourName <- fromMaybe userDefaultFlavour <$> cmdFlavour\n    let unknownFlavour = error $ \"Unknown build flavour: \" ++ flavourName\n        flavours       = hadrianFlavours ++ userFlavours\n    return $ fromMaybe unknownFlavour $ find ((== flavourName) . name) flavours\n\ngetIntegerPackage :: Expr Package\ngetIntegerPackage = expr (integerLibrary =<< flavour)\n\n-- TODO: there is duplication and inconsistency between this and\n-- Rules.Program.getProgramContexts. There should only be one way to get a\n-- context / contexts for a given stage and package.\nprogramContext :: Stage -> Package -> Action Context\nprogramContext stage pkg = do\n    profiled <- ghcProfiled <$> flavour\n    dynGhcProgs <- dynamicGhcPrograms =<< flavour\n    return . Context stage pkg . wayFromUnits . concat $\n        [ [ Profiling  | pkg == ghc && profiled && stage > Stage0 ]\n        , [ Dynamic    | dynGhcProgs && stage > Stage0 ]\n        ]\n\n-- TODO: switch to Set Package as the order of packages should not matter?\n-- Otherwise we have to keep remembering to sort packages from time to time.\nknownPackages :: [Package]\nknownPackages = sort $ ghcPackages ++ userPackages\n\n-- TODO: Speed up? Switch to Set?\n-- Note: this is slow but we keep it simple as there are just ~50 packages\nfindPackageByName :: PackageName -> Maybe Package\nfindPackageByName name = find (\\pkg -> pkgName pkg == name) knownPackages\n\nunsafeFindPackageByName :: PackageName -> Package\nunsafeFindPackageByName name = fromMaybe (error msg) $ findPackageByName name\n  where\n    msg = \"unsafeFindPackageByName: No package with name \" ++ name\n\nunsafeFindPackageByPath :: FilePath -> Package\nunsafeFindPackageByPath path = err $ find (\\pkg -> pkgPath pkg == path) knownPackages\n  where\n    err = fromMaybe $ error (\"findPackageByPath: No package for path \" ++ path)\n", "num_lines": 84}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Stage (Stage (..), stageString) where\n\nimport Development.Shake.Classes\nimport GHC.Generics\n\n-- | A stage refers to a certain compiler in GHC's build process.\n--\n-- * Stage 0 is built with the bootstrapping compiler, i.e. the one already\n--   installed on the user's system. The compiler that is produced during\n--   stage 0 is called /stage 1 compiler/.\n--\n-- * Stage 1 is built using the stage 1 compiler and all GHC sources. The result\n--   is called /stage 2 compiler/ and it has all features of the new GHC.\n--\n-- * Stage 2 is built using the stage 2 compiler. The result is a compiler\n--   fully \"built by itself\", commonly referred to as /bootstrapping/.\n--\n-- * Stage 3 is built as a self test. The resulting compiler should have\n--   the same object code as the one built in stage 2, which is a good test\n--   for the compiler. Since it serves no other purpose than that, the stage 3\n--   build is usually omitted in the build process.\ndata Stage = Stage0 | Stage1 | Stage2 | Stage3\n    deriving (Show, Eq, Ord, Enum, Generic, Bounded)\n\ninstance Binary   Stage\ninstance Hashable Stage\ninstance NFData   Stage\n\n-- | Prettyprint a 'Stage'.\nstageString :: Stage -> String\nstageString stage = \"stage\" ++ show (fromEnum stage)\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Target (\n    Target, target, context, builder, inputs, outputs, trackArgument,\n    module Builder\n    ) where\n\nimport Data.Char\nimport Data.List.Extra\n\nimport qualified Hadrian.Target as H\nimport Hadrian.Target hiding (Target)\n\nimport Builder\nimport Context\n\ntype Target = H.Target Context Builder\n\n-- | Some arguments do not affect build results and therefore do not need to be\n-- tracked by the build system. A notable example is \"-jN\" that controls Make's\n-- parallelism. Given a 'Target' and an argument, this function should return\n-- 'True' only if the argument needs to be tracked.\ntrackArgument :: Target -> String -> Bool\ntrackArgument target arg = case builder target of\n    (Make _) -> not $ threadArg arg\n    _        -> True\n  where\n    threadArg s = dropWhileEnd isDigit s `elem` [\"-j\", \"MAKEFLAGS=-j\", \"THREADS=\"]\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- If you want to customise your build you should copy this file from\n-- hadrian/src/UserSettings.hs to hadrian/UserSettings.hs and edit your copy.\n-- If you don't copy the file your changes will be tracked by git and you can\n-- accidentally commit them.\n--\n-- See doc/user-settings.md for instructions, and src/Flavour.hs for auxiliary\n-- functions for manipulating flavours.\n-- Please update doc/user-settings.md when committing changes to this file.\nmodule UserSettings (\n    userFlavours, userPackages, userDefaultFlavour,\n    verboseCommand, buildProgressColour, successColour, finalStage\n    ) where\n\nimport Flavour\nimport Expression\nimport {-# SOURCE #-} Settings.Default\n\n-- See doc/user-settings.md for instructions.\n-- Please update doc/user-settings.md when committing changes to this file.\n\n-- | Name of the default flavour, i.e the one used when no --flavour=<name>\n--   argument is passed to Hadrian.\nuserDefaultFlavour :: String\nuserDefaultFlavour = \"default\"\n\n-- | User-defined build flavours. See 'userFlavour' as an example.\nuserFlavours :: [Flavour]\nuserFlavours = [userFlavour] -- Add more build flavours if need be.\n\n-- | This is an example user-defined build flavour. Feel free to modify it and\n-- use by passing @--flavour=user@ from the command line.\nuserFlavour :: Flavour\nuserFlavour = defaultFlavour { name = \"user\" } -- Modify other settings here.\n\n-- | Add user-defined packages. Note, this only lets Hadrian know about the\n-- existence of a new package; to actually build it you need to create a new\n-- build flavour, modifying the list of packages that are built by default.\nuserPackages :: [Package]\nuserPackages = []\n\n-- | Set to 'True' to print full command lines during the build process. Note:\n-- this is a 'Predicate', hence you can enable verbose output only for certain\n-- targets, e.g.: @verboseCommand = package ghcPrim@.\nverboseCommand :: Predicate\nverboseCommand = do\n    verbosity <- expr getVerbosity\n    return $ verbosity >= Loud\n\n-- | Set colour for build progress messages (e.g. executing a build command).\nbuildProgressColour :: BuildProgressColour\nbuildProgressColour = mkBuildProgressColour (Dull Magenta)\n\n-- | Set colour for success messages (e.g. a package is built successfully).\nsuccessColour :: SuccessColour\nsuccessColour = mkSuccessColour (Dull Green)\n\n-- | Stop after building the StageN compiler.\n-- For example, setting the 'finalStage' to 'Stage1' will just build the\n-- 'Stage1' compiler. Setting it to 'Stage3' will build the 'Stage3'\n-- compiler. Setting it to 'Stage0' will mean nothing gets built at all.\nfinalStage :: Stage\nfinalStage = Stage2\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Utilities (\n    build, buildWithResources, buildWithCmdOptions,\n    askWithResources,\n    runBuilder, runBuilderWith,\n    needLibrary, contextDependencies, stage1Dependencies, libraryTargets,\n    topsortPackages, cabalDependencies\n    ) where\n\nimport qualified Hadrian.Builder as H\nimport Hadrian.Haskell.Cabal\nimport Hadrian.Haskell.Cabal.Type\nimport Hadrian.Utilities\n\nimport Context\nimport Expression hiding (stage)\nimport Settings\nimport Target\n\nbuild :: Target -> Action ()\nbuild target = H.build target getArgs\n\nbuildWithResources :: [(Resource, Int)] -> Target -> Action ()\nbuildWithResources rs target = H.buildWithResources rs target getArgs\n\nbuildWithCmdOptions :: [CmdOption] -> Target -> Action ()\nbuildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs\n\naskWithResources :: [(Resource, Int)] -> Target -> Action String\naskWithResources rs target = H.askWithResources rs target getArgs\n\n-- TODO: Cache the computation.\n-- | Given a 'Context' this 'Action' looks up the package dependencies and wraps\n-- the results in appropriate contexts.\n-- To compute package dependencies we transitively scan Cabal files using\n-- 'pkgDependencies' defined in \"Hadrian.Haskell.Cabal\".\ncontextDependencies :: Context -> Action [Context]\ncontextDependencies Context {..} = do\n    depPkgs <- go [package]\n    return [ Context stage pkg way | pkg <- depPkgs, pkg /= package ]\n  where\n    go pkgs  = do\n        deps <- concatMapM step pkgs\n        let newPkgs = nubOrd $ sort (deps ++ pkgs)\n        if pkgs == newPkgs then return pkgs else go newPkgs\n    step pkg = do\n        deps   <- pkgDependencies pkg\n        active <- sort <$> stagePackages stage\n        return $ intersectOrd (compare . pkgName) active deps\n\ncabalDependencies :: Context -> Action [String]\ncabalDependencies ctx = interpretInContext ctx $ getContextData depIds\n\n-- | Lookup dependencies of a 'Package' in the @vanilla Stage1 context@.\nstage1Dependencies :: Package -> Action [Package]\nstage1Dependencies =\n    fmap (map Context.package) . contextDependencies . vanillaContext Stage1\n\n-- | Given a library 'Package' this action computes all of its targets. See\n-- 'packageTargets' for the explanation of the @includeGhciLib@ parameter.\nlibraryTargets :: Bool -> Context -> Action [FilePath]\nlibraryTargets includeGhciLib context@Context {..} = do\n    libFile  <- pkgLibraryFile     context\n    ghciLib  <- pkgGhciLibraryFile context\n    ghci     <- if includeGhciLib && not (wayUnit Dynamic way)\n                then interpretInContext context $ getContextData buildGhciLib\n                else return False\n    return $ [ libFile ] ++ [ ghciLib | ghci ]\n\n-- | Coarse-grain 'need': make sure all given libraries are fully built.\nneedLibrary :: [Context] -> Action ()\nneedLibrary cs = need =<< concatMapM (libraryTargets True) cs\n\n-- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344.\n-- | Topological sort of packages according to their dependencies.\ntopsortPackages :: [Package] -> Action [Package]\ntopsortPackages pkgs = do\n    elems <- mapM (\\p -> (p,) <$> stage1Dependencies p) pkgs\n    return $ map fst $ topSort elems\n  where\n    annotateInDeg es e =\n     (foldr (\\e' s -> if fst e' `elem` snd e then s + 1 else s) (0 :: Int) es, e)\n    topSort [] = []\n    topSort es =\n      let annotated = map (annotateInDeg es) es\n          inDegZero = map snd $ filter ((== 0). fst) annotated\n      in  inDegZero ++ topSort (es \\\\ inDegZero)\n", "num_lines": 87}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Way (\n    WayUnit (..), Way, wayUnit, addWayUnit, removeWayUnit, wayFromUnits, allWays,\n\n    vanilla, profiling, dynamic, profilingDynamic, threaded, debug, logging,\n    threadedDebug, threadedProfiling, threadedLogging, threadedDynamic,\n    threadedDebugProfiling, threadedDebugDynamic, threadedProfilingDynamic,\n    threadedLoggingDynamic, debugProfiling, debugDynamic, loggingDynamic,\n\n    wayPrefix, waySuffix, hisuf, osuf, hcsuf, obootsuf, hibootsuf, ssuf\n    ) where\n\nimport Way.Type\n\n-- | Build default _vanilla_ way.\nvanilla :: Way\nvanilla = wayFromUnits []\n\n-- | Build with profiling.\nprofiling :: Way\nprofiling = wayFromUnits [Profiling]\n\n-- | Build with dynamic linking.\ndynamic :: Way\ndynamic = wayFromUnits [Dynamic]\n\n-- | Build with profiling and dynamic linking.\nprofilingDynamic :: Way\nprofilingDynamic = wayFromUnits [Profiling, Dynamic]\n\n-- RTS only ways below. See compiler/main/DynFlags.hs.\n-- | Build RTS with event logging.\nlogging :: Way\nlogging = wayFromUnits [Logging]\n\n-- | Build multithreaded RTS.\nthreaded :: Way\nthreaded = wayFromUnits [Threaded]\n\n-- | Build RTS with debug information.\ndebug :: Way\ndebug = wayFromUnits [Debug]\n\n-- | Various combinations of RTS only ways.\nthreadedDebug, threadedProfiling, threadedLogging, threadedDynamic,\n    threadedDebugProfiling, threadedDebugDynamic, threadedProfilingDynamic,\n    threadedLoggingDynamic, debugProfiling, debugDynamic, loggingDynamic :: Way\nthreadedDebug            = wayFromUnits [Threaded, Debug]\nthreadedProfiling        = wayFromUnits [Threaded, Profiling]\nthreadedLogging          = wayFromUnits [Threaded, Logging]\nthreadedDynamic          = wayFromUnits [Threaded, Dynamic]\nthreadedDebugProfiling   = wayFromUnits [Threaded, Debug, Profiling]\nthreadedDebugDynamic     = wayFromUnits [Threaded, Debug, Dynamic]\nthreadedProfilingDynamic = wayFromUnits [Threaded, Profiling, Dynamic]\nthreadedLoggingDynamic   = wayFromUnits [Threaded, Logging, Dynamic]\ndebugProfiling           = wayFromUnits [Debug, Profiling]\ndebugDynamic             = wayFromUnits [Debug, Dynamic]\nloggingDynamic           = wayFromUnits [Logging, Dynamic]\n\n-- | All ways supported by the build system.\nallWays :: [Way]\nallWays =\n    [ vanilla, profiling, dynamic, profilingDynamic, threaded, debug, logging\n    , threadedDebug, threadedProfiling, threadedLogging, threadedDynamic\n    , threadedDebugProfiling, threadedDebugDynamic, threadedProfilingDynamic\n    , threadedLoggingDynamic, debugProfiling, debugDynamic, loggingDynamic ]\n\nwayPrefix :: Way -> String\nwayPrefix way | way == vanilla = \"\"\n              | otherwise      = show way ++ \"_\"\n\nwaySuffix :: Way -> String\nwaySuffix way | way == vanilla = \"\"\n              | otherwise      = \"_\" ++ show way\n\nosuf, ssuf, hisuf, hcsuf, obootsuf, hibootsuf :: Way -> String\nosuf      = (++ \"o\"      ) . wayPrefix\nssuf      = (++ \"s\"      ) . wayPrefix\nhisuf     = (++ \"hi\"     ) . wayPrefix\nhcsuf     = (++ \"hc\"     ) . wayPrefix\nobootsuf  = (++ \"o-boot\" ) . wayPrefix\nhibootsuf = (++ \"hi-boot\") . wayPrefix\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Context.Path where\n\nimport Base\nimport Context.Type\nimport Hadrian.Expression\n\n-- | The build directory of the current 'Stage'.\nstageDir :: Context -> FilePath\nstageDir Context {..} = stageString stage\n\n-- | The build path of the current 'Stage'.\nstagePath :: Context -> Action FilePath\nstagePath context = buildRoot <&> (-/- stageDir context)\n\n-- | The expression that evaluates to the build path of the current 'Stage'.\ngetStagePath :: Expr Context b FilePath\ngetStagePath = expr . stagePath =<< getContext\n\n-- | The directory in 'buildRoot' containing build artifacts of a given 'Context'.\ncontextDir :: Context -> FilePath\ncontextDir Context {..} = stageString stage -/- pkgPath package\n\n-- | The path to the directory in 'buildRoot' containing build artifacts of a\n-- given 'Context'.\ncontextPath :: Context -> Action FilePath\ncontextPath context = buildRoot <&> (-/- contextDir context)\n\n-- | The expression that evaluates to the path to the directory in 'buildRoot'\n-- containing build artifacts of a given 'Context'.\ngetContextPath :: Expr Context b FilePath\ngetContextPath = expr . contextPath =<< getContext\n\n-- | The directory in 'buildRoot' containing the object artifacts.\nbuildDir :: Context -> FilePath\nbuildDir context = contextDir context -/- \"build\"\n\n-- | Path to the directory containing build artifacts of a given 'Context'.\nbuildPath :: Context -> Action FilePath\nbuildPath context = buildRoot <&> (-/- buildDir context)\n\n-- | The expression that evaluates to the build path of the current 'Context'.\ngetBuildPath :: Expr Context b FilePath\ngetBuildPath = expr . buildPath =<< getContext\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Context.Type where\n\nimport Development.Shake.Classes\nimport GHC.Generics\nimport Hadrian.Package\n\nimport Stage\nimport Way.Type\n\n-- | Build context for a currently built 'Target'. We generate potentially\n-- different build rules for each 'Context'.\ndata Context = Context\n    { stage   :: Stage   -- ^ Currently build Stage\n    , package :: Package -- ^ Currently build Package\n    , way     :: Way     -- ^ Currently build Way (usually 'vanilla')\n    } deriving (Eq, Generic, Show)\n\ninstance Binary   Context\ninstance Hashable Context\ninstance NFData   Context\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Expression.Type where\n\nimport Context.Type\nimport Way.Type\n\nimport Builder\nimport qualified Hadrian.Expression as H\n\n-- | @Expr a@ is a computation that produces a value of type @Action a@ and can\n-- read parameters of the current build 'Target'.\ntype Expr a = H.Expr Context Builder a\n\n-- | The following expressions are used throughout the build system for\n-- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'\n-- and 'Packages'.\ntype Predicate = H.Predicate Context Builder\ntype Args      = H.Args      Context Builder\ntype Ways      = Expr [Way]\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Builder\n-- Copyright  : (c) Andrey Mokhov 2014-2017\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- A typical build system invokes several build tools, or /builders/, such as\n-- compilers, linkers, etc., some of which may be built by the build system\n-- itself. This module defines the 'Builder' type class and a few associated\n-- functions that can be used to invoke builders.\n-----------------------------------------------------------------------------\nmodule Hadrian.Builder (\n    Builder (..), BuildInfo (..), needBuilder, runBuilder,\n    runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions,\n    getBuilderPath, builderEnvironment, askWithResources\n    ) where\n\nimport Data.List\nimport Development.Shake\n\nimport Hadrian.Expression hiding (inputs, outputs)\nimport Hadrian.Oracles.ArgsHash\nimport Hadrian.Target\nimport Hadrian.Utilities\n\n-- | This data structure captures all information relevant to invoking a builder.\ndata BuildInfo = BuildInfo {\n    -- | Command line arguments.\n    buildArgs :: [String],\n    -- | Input files.\n    buildInputs :: [FilePath],\n    -- | Output files.\n    buildOutputs :: [FilePath],\n    -- | Options to be passed to Shake's 'cmd' function.\n    buildOptions :: [CmdOption],\n    -- | Resources to be aquired.\n    buildResources :: [(Resource, Int)] }\n\nclass ShakeValue b => Builder b where\n    -- | The path to a builder.\n    builderPath :: b -> Action FilePath\n\n    -- | Ask the builder for information.\n    -- E.g. ask @ghc-pkg@ for package dependencies\n    -- capture the @stdout@ result and return it.\n    askBuilderWith :: b -> BuildInfo -> Action String\n\n    -- | Runtime dependencies of a builder. For example, on Windows GHC requires\n    -- the utility @touchy.exe@ to be avilable on a specific path.\n    runtimeDependencies :: b -> Action [FilePath]\n    runtimeDependencies _ = return []\n\n    -- | Run a builder with a given 'BuildInfo'. Also see 'runBuilder'.\n    runBuilderWith :: b -> BuildInfo -> Action ()\n    runBuilderWith builder buildInfo = do\n        let args = buildArgs buildInfo\n        needBuilder builder\n        path <- builderPath builder\n        let msg = if null args then \"\" else \" (\" ++ intercalate \", \" args ++ \")\"\n        putBuild $ \"| Run \" ++ show builder ++ msg\n        quietly $ cmd (buildOptions buildInfo) [path] args\n\n-- | Make sure a builder and its runtime dependencies are up-to-date.\nneedBuilder :: Builder b => b -> Action ()\nneedBuilder builder = do\n    path <- builderPath builder\n    deps <- runtimeDependencies builder\n    need (path : deps)\n\n-- | Run a builder with a specified list of command line arguments, reading a\n-- list of input files and writing a list of output files. A lightweight version\n-- of 'runBuilderWith'.\nrunBuilder :: Builder b => b -> [String] -> [FilePath] -> [FilePath] -> Action ()\nrunBuilder = runBuilderWithCmdOptions []\n\n-- | Like 'runBuilder' but passes given options to Shake's 'cmd'.\nrunBuilderWithCmdOptions :: Builder b => [CmdOption] -> b -> [String] -> [FilePath] -> [FilePath] -> Action ()\nrunBuilderWithCmdOptions opts builder args inputs outputs =\n    runBuilderWith builder $ BuildInfo { buildArgs      = args\n                                       , buildInputs    = inputs\n                                       , buildOutputs   = outputs\n                                       , buildOptions   = opts\n                                       , buildResources = [] }\n\n-- | Build a 'Target' using the list of command line arguments computed from a\n-- given 'Args' expression. Force a rebuild if the argument list has changed\n-- since the last build.\nbuild :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action ()\nbuild = buildWith [] []\n\n-- | Like 'build' but acquires necessary resources.\nbuildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()\nbuildWithResources rs = buildWith rs []\n\naskWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action String\naskWithResources rs = askWith rs []\n\n-- | Like 'build' but passes given options to Shake's 'cmd'.\nbuildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action ()\nbuildWithCmdOptions = buildWith []\n\ndoWith :: (Builder b, ShakeValue c)\n       => (b -> BuildInfo -> Action a)\n       -> (Target c b -> Action ())\n       -> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a\ndoWith f info rs opts target args = do\n    needBuilder (builder target)\n    argList <- interpret target args\n    trackArgsHash target -- Rerun the rule if the hash of argList has changed.\n    info target\n    verbose <- interpret target verboseCommand\n    let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly\n    quietlyUnlessVerbose $ f (builder target) $\n        BuildInfo { buildArgs      = argList\n                  , buildInputs    = inputs target\n                  , buildOutputs   = outputs target\n                  , buildOptions   = opts\n                  , buildResources = rs }\n\nbuildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()\nbuildWith = doWith runBuilderWith runInfo\n\naskWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action String\naskWith = doWith askBuilderWith askInfo\n\n-- | Print out information about the command being executed.\nrunInfo :: Show b => Target c b -> Action ()\nrunInfo t = putProgressInfo =<< renderAction\n    (\"Run \" ++ show (builder t)) -- TODO: Bring back contextInfo.\n    (digest $ inputs  t)\n    (digest $ outputs t)\n  where\n    digest [] = \"none\"\n    digest [x] = x\n    digest (x:xs) = x ++ \" (and \" ++ show (length xs) ++ \" more)\"\n\naskInfo :: Show b => Target c b -> Action ()\naskInfo t = putProgressInfo =<< renderActionNoOutput\n    (\"Run \" ++ show (builder t)) -- TODO: Bring back contextInfo.\n    (digest $ inputs  t)\n  where\n    digest [] = \"none\"\n    digest [x] = x\n    digest (x:xs) = x ++ \" (and \" ++ show (length xs) ++ \" more)\"\n\n-- | Get the path to the current builder.\ngetBuilderPath :: Builder b => b -> Expr c b FilePath\ngetBuilderPath = expr . builderPath\n\n-- | Write a builder path into a given environment variable.\nbuilderEnvironment :: Builder b => String -> b -> Action CmdOption\nbuilderEnvironment variable builder = do\n    needBuilder builder\n    path <- builderPath builder\n    return $ AddEnv variable path\n", "num_lines": 158}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Hadrian.BuildPath where\n\nimport Base\n\nimport Data.Functor\nimport qualified Text.Parsec as Parsec\n\n-- | A path of the form\n--\n-- > <build root>/stage<N>/<path/to/pkg/from/ghc/root>/build/<something>\n--\n-- where @something@ describes a library or object file or ... to be built\n-- for the given package.\n--\n-- @a@, which represents that @something@, is instantiated with library-related\n-- data types in @Rules.Library@ and with object/interface files related types\n-- in @Rules.Compile@.\ndata BuildPath a = BuildPath FilePath -- ^ > <build root>/\n                             Stage    -- ^ > stage<N>/\n                             FilePath -- ^ > <path/to/pkg/from/ghc/root>/build/\n                             a        -- ^ > whatever comes after 'build/'\n    deriving (Eq, Show)\n\n-- | Parse a build path under the given build root.\nparseBuildPath\n    :: FilePath -- ^ build root\n    -> Parsec.Parsec String () a -- ^ what to parse after @build/@\n    -> Parsec.Parsec String () (BuildPath a)\nparseBuildPath root afterBuild = do\n    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')\n    stage <- parseStage\n    _ <- Parsec.char '/'\n    pkgpath <- Parsec.manyTill Parsec.anyChar\n        (Parsec.try $ Parsec.string \"/build/\")\n    a <- afterBuild\n    return (BuildPath root stage pkgpath a)\n\n-- To be kept in sync with Stage.hs's stageString function\n-- | Parse @\"stageX\"@ into a 'Stage'.\nparseStage :: Parsec.Parsec String () Stage\nparseStage = (Parsec.string \"stage\" *> Parsec.choice\n    [ Parsec.string (show n) $> toEnum n\n    | n <- map fromEnum [minBound .. maxBound :: Stage]\n    ]) Parsec.<?> \"stage string\"\n\n-- To be kept in sync with the show instances in 'Way.Type', until we perhaps\n-- use some bidirectional parsing/pretty printing approach or library.\n-- | Parse a way suffix, returning the argument when no suffix is found (the\n-- argument will be vanilla in most cases, but dynamic when we parse the way\n-- suffix out of a shared library file name).\nparseWaySuffix :: Way -> Parsec.Parsec String () Way\nparseWaySuffix w = Parsec.choice\n    [ Parsec.char '_' *>\n        (wayFromUnits <$> Parsec.sepBy1 parseWayUnit (Parsec.char '_'))\n    , pure w\n    ] Parsec.<?> \"way suffix (e.g _thr_p, or none for vanilla)\"\n\n-- | Same as 'parseWaySuffix', but for parsing e.g @thr_p_@\n--   instead of @_thr_p@, like 'parseWaySuffix' does.\n--\n--   This is used to parse paths to object files,\n--   in Rules.Compile.\nparseWayPrefix :: Way -> Parsec.Parsec String () Way\nparseWayPrefix w = Parsec.choice\n    [ wayFromUnits <$> Parsec.endBy1 parseWayUnit (Parsec.char '_')\n    , pure w\n    ] Parsec.<?> \"way prefix (e.g thr_p_, or none for vanilla)\"\n\nparseWayUnit :: Parsec.Parsec String () WayUnit\nparseWayUnit = Parsec.choice\n    [ Parsec.string \"thr\" *> pure Threaded\n    , Parsec.char   'd'   *>\n      (Parsec.choice [ Parsec.string \"ebug\" *> pure Debug\n                     , Parsec.string \"yn\"   *> pure Dynamic ])\n    , Parsec.char 'p'     *> pure Profiling\n    , Parsec.char 'l'     *> pure Logging\n    ] Parsec.<?> \"way unit (thr, debug, dyn, p, l)\"\n\n-- | Parse a @\"pkgname-pkgversion\"@ string into the package name and the\n-- integers that make up the package version.\nparsePkgId :: Parsec.Parsec String () (String, [Integer])\nparsePkgId = parsePkgId' \"\" Parsec.<?> \"package identifier (<name>-<version>)\"\n  where\n    parsePkgId' currName = do\n        s <- Parsec.many1 Parsec.alphaNum\n        _ <- Parsec.char '-'\n        let newName = if null currName then s else currName ++ \"-\" ++ s\n        Parsec.choice [ (newName,) <$> parsePkgVersion\n                      , parsePkgId' newName ]\n\n-- | Parse \".\"-separated integers that describe a package's version.\nparsePkgVersion :: Parsec.Parsec String () [Integer]\nparsePkgVersion = fmap reverse (parsePkgVersion' [])\n       Parsec.<?> \"package version\"\n  where\n    parsePkgVersion' xs = do\n        n <- parseNatural\n        Parsec.choice\n            [ Parsec.try\n                  (Parsec.lookAhead (Parsec.char '.' *>\n                                        (Parsec.letter <|> Parsec.char '_')\n                                    )\n                  )\n              $> (n:xs)\n            , Parsec.char '.' *> parsePkgVersion' (n:xs)\n            , pure $ (n:xs) ]\n\n-- | Parse a natural number.\nparseNatural :: Parsec.Parsec String () Integer\nparseNatural = (read <$> Parsec.many1 Parsec.digit) Parsec.<?> \"natural number\"\n\n-- | Runs the given parser against the given path, erroring out when the parser\n-- fails (because it shouldn't if the code from this module is correct).\nparsePath\n    :: Parsec.Parsec String () a -- ^ parser to run\n    -> String                    -- ^ string describing the input source\n    -> FilePath                  -- ^ path to parse\n    -> Action a\nparsePath p inp path = case Parsec.parse p inp path of\n    Left err -> fail $ \"Hadrian.BuildPath.parsePath: path=\"\n                    ++ path ++ \", error:\\n\" ++ show err\n    Right a  -> pure a\n", "num_lines": 123}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}\nmodule Hadrian.Expression (\n    -- * Expressions\n    Expr, Predicate, Args,\n\n    -- ** Construction and modification\n    expr, exprIO, arg, remove,\n\n    -- ** Predicates\n    (?), input, inputs, output, outputs, VerboseCommand (..), verboseCommand,\n\n    -- ** Evaluation\n    interpret, interpretInContext,\n\n    -- * Convenient accessors\n    getBuildRoot, getContext, getBuilder, getOutputs, getInputs, getInput, getOutput\n    ) where\n\nimport Control.Monad.Extra\nimport Control.Monad.Trans\nimport Control.Monad.Trans.Reader\nimport Development.Shake\nimport Development.Shake.Classes\n\nimport qualified Hadrian.Target as Target\nimport Hadrian.Target (Target, target)\nimport Hadrian.Utilities\n\n-- | 'Expr' @c b a@ is a computation that produces a value of type 'Action' @a@\n-- and can read parameters of the current build 'Target' @c b@.\nnewtype Expr c b a = Expr (ReaderT (Target c b) Action a)\n    deriving (Applicative, Functor, Monad)\n\ninstance Semigroup a => Semigroup (Expr c b a) where\n    Expr x <> Expr y = Expr $ (<>) <$> x <*> y\n\n-- TODO: The 'Semigroup a' constraint will at some point become redundant.\ninstance (Semigroup a, Monoid a) => Monoid (Expr c b a) where\n    mempty  = pure mempty\n    mappend = (<>)\n\n-- | Expressions that compute a Boolean value.\ntype Predicate c b = Expr c b Bool\n\n-- | Expressions that compute lists of arguments to be passed to builders.\ntype Args c b = Expr c b [String]\n\n-- | Lift actions independent from the current build 'Target' into the 'Expr'\n-- monad.\nexpr :: Action a -> Expr c b a\nexpr = Expr . lift\n\n-- | Lift IO computations independent from the current build 'Target' into the\n-- 'Expr' monad.\nexprIO :: IO a -> Expr c b a\nexprIO = Expr . liftIO\n\n-- | Remove given elements from a list expression.\nremove :: Eq a => [a] -> Expr c b [a] -> Expr c b [a]\nremove xs e = filter (`notElem` xs) <$> e\n\n-- | Add a single argument to 'Args'.\narg :: String -> Args c b\narg = pure . pure\n\n-- | Values that can be converted to a 'Predicate'.\nclass ToPredicate p c b where\n    toPredicate :: p -> Predicate c b\n\ninfixr 3 ?\n\n-- | Apply a predicate to an expression.\n(?) :: (Monoid a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a\np ? e = do\n    bool <- toPredicate p\n    if bool then e else mempty\n\ninstance ToPredicate Bool c b where\n    toPredicate = pure\n\ninstance ToPredicate p c b => ToPredicate (Action p) c b where\n    toPredicate = toPredicate . expr\n\ninstance (c ~ c', b ~ b', ToPredicate p c' b') => ToPredicate (Expr c b p) c' b' where\n    toPredicate p = toPredicate =<< p\n\n-- | Interpret a given expression according to the given 'Target'.\ninterpret :: Target c b -> Expr c b a -> Action a\ninterpret target (Expr e) = runReaderT e target\n\n-- | Interpret a given expression by looking only at the given 'Context'.\ninterpretInContext :: c -> Expr c b a -> Action a\ninterpretInContext c = interpret $ target c\n    (error \"contextOnlyTarget: builder not set\")\n    (error \"contextOnlyTarget: inputs not set\" )\n    (error \"contextOnlyTarget: outputs not set\")\n\n-- | Get the directory of build results.\ngetBuildRoot :: Expr c b FilePath\ngetBuildRoot = expr buildRoot\n\n-- | Get the current build 'Context'.\ngetContext :: Expr c b c\ngetContext = Expr $ asks Target.context\n\n-- | Get the 'Builder' for the current 'Target'.\ngetBuilder :: Expr c b b\ngetBuilder = Expr $ asks Target.builder\n\n-- | Get the input files of the current 'Target'.\ngetInputs :: Expr c b [FilePath]\ngetInputs = Expr $ asks Target.inputs\n\n-- | Run 'getInputs' and check that the result contains one input file only.\ngetInput :: (Show b, Show c) => Expr c b FilePath\ngetInput = Expr $ do\n    target <- ask\n    fromSingleton (\"Exactly one input file expected in \" ++ show target) <$>\n        asks Target.inputs\n\n-- | Get the files produced by the current 'Target'.\ngetOutputs :: Expr c b [FilePath]\ngetOutputs = Expr $ asks Target.outputs\n\n-- | Run 'getOutputs' and check that the result contains one output file only.\ngetOutput :: (Show b, Show c) => Expr c b FilePath\ngetOutput = Expr $ do\n    target <- ask\n    fromSingleton (\"Exactly one output file expected in \" ++ show target) <$>\n        asks Target.outputs\n\n-- | Does any of the input files match a given pattern?\ninput :: FilePattern -> Predicate c b\ninput f = any (f ?==) <$> getInputs\n\n-- | Does any of the input files match any of the given patterns?\ninputs :: [FilePattern] -> Predicate c b\ninputs = anyM input\n\n-- | Does any of the output files match a given pattern?\noutput :: FilePattern -> Predicate c b\noutput f = any (f ?==) <$> getOutputs\n\n-- | Does any of the output files match any of the given patterns?\noutputs :: [FilePattern] -> Predicate c b\noutputs = anyM output\n\nnewtype VerboseCommand c b = VerboseCommand { predicate :: Predicate c b }\n    deriving Typeable\n\nverboseCommand :: (ShakeValue c, ShakeValue b) => Predicate c b\nverboseCommand = predicate =<< expr (userSetting . VerboseCommand $ return False)\n", "num_lines": 153}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Package\n-- Copyright  : (c) Andrey Mokhov 2014-2017\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- A /package/ is a collection of files. We currently only support C and Haskell\n-- packages and treat a package as either a library or a program. The latter is\n-- a gross oversimplification as, for example, Haskell packages can be both.\n-- This works for now, but should be improved in future.\n-----------------------------------------------------------------------------\nmodule Hadrian.Package (\n    -- * Data types\n    Package (..), PackageName, PackageType,\n\n    -- * Construction and properties\n    library, program, dummyPackage, isLibrary, isProgram,\n\n    -- * Package directory structure\n    pkgCabalFile\n    ) where\n\nimport Development.Shake.Classes\nimport Development.Shake.FilePath\nimport GHC.Generics\n\nimport Hadrian.Utilities\n\n-- TODO: Make PackageType more precise.\n-- See https://github.com/snowleopard/hadrian/issues/12.\ndata PackageType = Library | Program deriving (Eq, Generic, Ord, Show)\n\ntype PackageName = String\n\n-- TODO: Consider turning Package into a GADT indexed with language and type.\ndata Package = Package {\n    -- | The package type. 'Library' and 'Program' packages are supported.\n    pkgType :: PackageType,\n    -- | The package name. We assume that all packages have different names,\n    -- hence two packages with the same name are considered equal.\n    pkgName :: PackageName,\n    -- | The path to the package source code relative to the root of the build\n    -- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the\n    -- @Cabal@ and @ghc-bin@ packages in GHC.\n    pkgPath :: FilePath\n    } deriving (Eq, Generic, Ord, Show)\n\n-- | Construct a library package.\nlibrary :: PackageName -> FilePath -> Package\nlibrary = Package Library\n\n-- | Construct a program package.\nprogram :: PackageName -> FilePath -> Package\nprogram = Package Program\n\n-- TODO: Remove this hack.\n-- | A dummy package that we never try to build but use when we need a 'Package'\n-- to construct a 'Context' but do not need to access the package field.\ndummyPackage :: Package\ndummyPackage = library \"dummy\" \"dummy/path/\"\n\n-- | Is this a library package?\nisLibrary :: Package -> Bool\nisLibrary (Package Library _ _) = True\nisLibrary _ = False\n\n-- | Is this a program package?\nisProgram :: Package -> Bool\nisProgram (Package Program _ _) = True\nisProgram _ = False\n\n-- | The path to the Cabal file of a Haskell package, e.g. @ghc/ghc-bin.cabal@.\npkgCabalFile :: Package -> FilePath\npkgCabalFile p = pkgPath p -/- pkgName p <.> \"cabal\"\n\ninstance Binary   PackageType\ninstance Hashable PackageType\ninstance NFData   PackageType\n\ninstance Binary   Package\ninstance Hashable Package\ninstance NFData   Package", "num_lines": 84}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Hadrian.Target (Target, target, context, builder, inputs, outputs) where\n\nimport Development.Shake.Classes\nimport GHC.Generics\n\n-- | Each invocation of a builder is fully described by a 'Target', which\n-- comprises a build context (type variable @c@), a builder (type variable @b@),\n-- a list of input files and a list of output files. For example:\n--\n-- @\n-- preludeTarget = Target (GHC.Context) (GHC.Builder)\n--     { context = Context Stage1 base profiling\n--     , builder = Ghc Stage1\n--     , inputs = [\"libraries/base/Prelude.hs\"]\n--     , outputs = [\"build/stage1/libraries/base/Prelude.p_o\"] }\n-- @\ndata Target c b = Target\n    { context :: c          -- ^ Current build context\n    , builder :: b          -- ^ Builder to be invoked\n    , inputs  :: [FilePath] -- ^ Input files for the builder\n    , outputs :: [FilePath] -- ^ Files to be produced\n    } deriving (Eq, Generic, Show)\n\ntarget :: c -> b -> [FilePath] -> [FilePath] -> Target c b\ntarget = Target\n\ninstance (Binary   c, Binary   b) => Binary   (Target c b)\ninstance (Hashable c, Hashable b) => Hashable (Target c b)\ninstance (NFData   c, NFData   b) => NFData   (Target c b)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Hadrian.Utilities (\n    -- * List manipulation\n    fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, chunksOfSize,\n\n    -- * String manipulation\n    quote, yesNo, parseYesNo, zeroOne,\n\n    -- * FilePath manipulation\n    unifyPath, (-/-), makeRelativeNoSysLink,\n\n    -- * Accessing Shake's type-indexed map\n    insertExtra, lookupExtra, userSetting,\n\n    -- * Paths\n    BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,\n\n    -- * File system operations\n    copyFile, copyFileUntracked, fixFile, makeExecutable, moveFile, removeFile,\n    createDirectory, copyDirectory, moveDirectory, removeDirectory,\n\n    -- * Diagnostic info\n    UseColour (..), Colour (..), ANSIColour (..), putColoured,\n    BuildProgressColour, mkBuildProgressColour, putBuild,\n    SuccessColour, mkSuccessColour, putSuccess,\n    ProgressInfo (..), putProgressInfo,\n    renderAction, renderActionNoOutput, renderProgram, renderLibrary, renderBox, renderUnicorn,\n\n    -- * Miscellaneous\n    (<&>), (%%>), cmdLineLengthLimit,\n\n    -- * Useful re-exports\n    Dynamic, fromDynamic, toDyn, TypeRep, typeOf\n    ) where\n\nimport Control.Monad.Extra\nimport Data.Char\nimport Data.Dynamic (Dynamic, fromDynamic, toDyn)\nimport Data.HashMap.Strict (HashMap)\nimport Data.List (isPrefixOf)\nimport Data.List.Extra\nimport Data.Maybe\nimport Data.Typeable (TypeRep, typeOf)\nimport Development.Shake hiding (Normal)\nimport Development.Shake.Classes\nimport Development.Shake.FilePath\nimport System.Environment (lookupEnv)\nimport System.Info.Extra\n\nimport qualified Control.Exception.Base as IO\nimport qualified Data.HashMap.Strict    as Map\nimport qualified System.Directory.Extra as IO\nimport qualified System.Info.Extra      as IO\nimport qualified System.IO              as IO\n\n-- | Extract a value from a singleton list, or terminate with an error message\n-- if the list does not contain exactly one value.\nfromSingleton :: String -> [a] -> a\nfromSingleton _   [res] = res\nfromSingleton msg _     = error msg\n\n-- | Find and replace all occurrences of a value in a list.\nreplaceEq :: Eq a => a -> a -> [a] -> [a]\nreplaceEq from to = map (\\cur -> if cur == from then to else cur)\n\n-- Explicit definition to avoid dependency on Data.List.Ordered\n-- | Difference of two ordered lists.\nminusOrd :: Ord a => [a] -> [a] -> [a]\nminusOrd [] _  = []\nminusOrd xs [] = xs\nminusOrd (x:xs) (y:ys) = case compare x y of\n    LT -> x : minusOrd xs (y:ys)\n    EQ ->     minusOrd xs ys\n    GT ->     minusOrd (x:xs) ys\n\n-- Explicit definition to avoid dependency on Data.List.Ordered. TODO: add tests\n-- | Intersection of two ordered lists by a predicate.\nintersectOrd :: (a -> b -> Ordering) -> [a] -> [b] -> [a]\nintersectOrd cmp = loop\n  where\n    loop [] _ = []\n    loop _ [] = []\n    loop (x:xs) (y:ys) = case cmp x y of\n        LT ->     loop xs (y:ys)\n        EQ -> x : loop xs (y:ys)\n        GT ->     loop (x:xs) ys\n\n-- | Lookup all elements of a given sorted list in a given sorted dictionary.\n-- @lookupAll list dict@ is equivalent to @map (flip lookup dict) list@ but has\n-- linear complexity O(|list| + |dist|) instead of quadratic O(|list| * |dict|).\n--\n-- > lookupAll [\"b\", \"c\"] [(\"a\", 1), (\"c\", 3), (\"d\", 4)] == [Nothing, Just 3]\n-- > list & dict are sorted: lookupAll list dict == map (flip lookup dict) list\nlookupAll :: Ord a => [a] -> [(a, b)] -> [Maybe b]\nlookupAll []     _      = []\nlookupAll (_:xs) []     = Nothing : lookupAll xs []\nlookupAll (x:xs) (y:ys) = case compare x (fst y) of\n    LT -> Nothing      : lookupAll xs (y:ys)\n    EQ -> Just (snd y) : lookupAll xs (y:ys)\n    GT -> lookupAll (x:xs) ys\n\n-- | @chunksOfSize size strings@ splits a given list of strings into chunks not\n-- exceeding the given @size@. If that is impossible, it uses singleton chunks.\nchunksOfSize :: Int -> [String] -> [[String]]\nchunksOfSize n = repeatedly f\n  where\n    f xs = splitAt (max 1 $ length $ takeWhile (<= n) $ scanl1 (+) $ map length xs) xs\n\n-- | Add single quotes around a string.\nquote :: String -> String\nquote s = \"'\" ++ s ++ \"'\"\n\n-- | Pretty-print a 'Bool' as a @\"YES\"@ or @\"NO\"@ string.\nyesNo :: Bool -> String\nyesNo True  = \"YES\"\nyesNo False = \"NO\"\n\n-- | Parse a 'Bool' from a @\"YES\"@ or @\"NO\"@ string. Returns @Nothing@ in case\n-- of a parse failure.\nparseYesNo :: String -> Maybe Bool\nparseYesNo \"YES\" = Just True\nparseYesNo \"NO\"  = Just False\nparseYesNo _     = Nothing\n\n-- | Pretty-print a 'Bool' as a @\"0\"@ or @\"1\"@ string\nzeroOne :: Bool -> String\nzeroOne False = \"0\"\nzeroOne True  = \"1\"\n\n-- | Normalise a path and convert all path separators to @/@, even on Windows.\nunifyPath :: FilePath -> FilePath\nunifyPath = toStandard . normaliseEx\n\n-- | Combine paths with a forward slash regardless of platform.\n(-/-) :: FilePath -> FilePath -> FilePath\n_  -/- b | isAbsolute b && not (isAbsolute $ tail b) = b\n\"\" -/- b = b\na  -/- b\n    | last a == '/' = a ++       b\n    | otherwise     = a ++ '/' : b\n\ninfixr 6 -/-\n\n-- | This is like Posix makeRelative, but assumes no sys links in the input\n-- paths. This allows the result to start with possibly many \"../\"s. Input\n-- paths must both be relative, or be on the same drive\nmakeRelativeNoSysLink :: FilePath -> FilePath  -> FilePath\nmakeRelativeNoSysLink a b\n    | aDrive == bDrive\n        = if aToB == []\n            then \".\"\n            else joinPath aToB\n    | otherwise\n        = error $ if isRelative a /= isRelative b\n            then \"Paths must both be relative or both be absolute, but got\"\n                    ++ \" \\\"\" ++ a      ++ \"\\\" and \\\"\" ++ b      ++ \"\\\"\"\n            else \"Paths are on different drives \"\n                    ++ \" \\\"\" ++ aDrive ++ \"\\\" and \\\"\" ++ bDrive ++ \"\\\"\"\n    where\n        (aDrive, aRelPath) = splitDrive a\n        (bDrive, bRelPath) = splitDrive b\n\n        aRelSplit = removeIndirections (splitPath aRelPath)\n        bRelSplit = removeIndirections (splitPath bRelPath)\n\n        -- Use removePrefix to get the relative paths relative to a new\n        -- base directory as high in the directory tree as possible.\n        (baseToA, baseToB) = removePrefix aRelSplit bRelSplit\n        aToBase = if isDirUp (head baseToA)\n                    -- if baseToA contains any '..' then there is no way to get\n                    -- a path from a to the base directory.\n                    -- E.g. if   baseToA == \"../u/v\"\n                    --      then aToBase == \"../../<UnknownDir>\"\n                    then error $ \"Impossible to find relatieve path from \"\n                                    ++ a ++ \" to \" ++ b\n                    else\"..\" <$ baseToA\n        aToB = aToBase ++ baseToB\n\n        -- removePrefix \"pre123\" \"prefix456\" == (\"123\", \"fix456\")\n        removePrefix :: Eq a => [a] -> [a] -> ([a], [a])\n        removePrefix as [] = (as, [])\n        removePrefix [] bs = ([], bs)\n        removePrefix (a:as) (b:bs)\n            | a == b    = removePrefix as bs\n            | otherwise = (a:as, b:bs)\n\n        -- Removes all '.', and tries to remove all '..'. In some cases '..'s\n        -- cannot be removes, but will all appear to the left.\n        -- e.g. removeIndirections \"../a/./b/../../../c\" == \"../../c\"\n        removeIndirections :: [String] -> [String]\n        removeIndirections [] = []\n        removeIndirections (x:xs)\n            -- Remove all '.'\n            | isDot   x = removeIndirections xs\n            -- Bubble all '..' to the left\n            | otherwise = case removeIndirections xs of\n                        []     -> [x]\n                        -- Only when x /= '..' and y == '..' do we need to\n                        -- bubble to the left. In that case they cancel out\n                        (y:ys) -> if not (isDirUp x) && isDirUp y\n                                    then ys\n                                    else x : y : ys\n\n        isDirUp \"..\" = True\n        isDirUp \"../\" = True\n        isDirUp _ = False\n\n        isDot \".\" = True\n        isDot \"./\" = True\n        isDot _ = False\n\n-- | Like Shake's '%>' but gives higher priority to longer patterns. Useful\n-- in situations when a family of build rules, e.g. @\"//*.a\"@ and @\"//*_p.a\"@\n-- can be matched by the same file, such as @library_p.a@. We break the tie\n-- by preferring longer matches, which correpond to longer patterns.\n(%%>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()\np %%> a = priority (fromIntegral (length p) + 1) $ p %> a\n\ninfix 1 %%>\n\n-- | Build command lines can get very long; for example, when building the Cabal\n-- library, they can reach 2MB! Some operating systems do not support command\n-- lines of such length, and this function can be used to obtain a reasonable\n-- approximation of the limit. On Windows, it is theoretically 32768 characters\n-- (since Windows 7). In practice we use 31000 to leave some breathing space for\n-- the builder path & name, auxiliary flags, and other overheads. On Mac OS X,\n-- ARG_MAX is 262144, yet when using @xargs@ on OSX this is reduced by over\n-- 20000. Hence, 200000 seems like a sensible limit. On other operating systems\n-- we currently use the 4194304 setting.\ncmdLineLengthLimit :: Int\ncmdLineLengthLimit | isWindows = 31000\n                   | isMac     = 200000\n                   | otherwise = 4194304\n\n-- | Insert a value into Shake's type-indexed map.\ninsertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic\ninsertExtra value = Map.insert (typeOf value) (toDyn value)\n\n-- | Lookup a value in Shake's type-indexed map.\nlookupExtra :: Typeable a => a -> Map.HashMap TypeRep Dynamic -> a\nlookupExtra defaultValue extra = fromMaybe defaultValue maybeValue\n  where\n    maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra\n\n-- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the\n-- setting is not found, return the provided default value instead.\nuserSetting :: Typeable a => a -> Action a\nuserSetting defaultValue = do\n    extra <- shakeExtra <$> getShakeOptions\n    return $ lookupExtra defaultValue extra\n\n-- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the\n-- setting is not found, return the provided default value instead.\nuserSettingRules :: Typeable a => a -> Rules a\nuserSettingRules defaultValue = do\n    extra <- shakeExtra <$> getShakeOptionsRules\n    return $ lookupExtra defaultValue extra\n\nnewtype BuildRoot = BuildRoot FilePath deriving (Typeable, Eq, Show)\n\n-- | All build results are put into the 'buildRoot' directory.\nbuildRoot :: Action FilePath\nbuildRoot = do\n    BuildRoot path <- userSetting (BuildRoot \"\")\n    return path\n\nbuildRootRules :: Rules FilePath\nbuildRootRules = do\n    BuildRoot path <- userSettingRules (BuildRoot \"\")\n    return path\n\n-- | A version of 'fmap' with flipped arguments. Useful for manipulating values\n-- in context, e.g. 'buildRoot', as in the example below.\n--\n-- @\n-- buildRoot <&> (-/- \"dir\") == fmap (-/- \"dir\") buildRoot\n-- @\n(<&>) :: Functor f => f a -> (a -> b) -> f b\n(<&>) = flip fmap\n\ninfixl 1 <&>\n\n-- | Given a 'FilePath' to a source file, return 'True' if it is generated.\n-- The current implementation simply assumes that a file is generated if it\n-- lives in the 'buildRoot' directory. Since most files are not generated the\n-- test is usually very fast.\nisGeneratedSource :: FilePath -> Action Bool\nisGeneratedSource file = buildRoot <&> (`isPrefixOf` file)\n\n-- | Copy a file tracking the source. Create the target directory if missing.\ncopyFile :: FilePath -> FilePath -> Action ()\ncopyFile source target = do\n    need [source] -- Guarantee the source is built before printing progress info.\n    let dir = takeDirectory target\n    liftIO $ IO.createDirectoryIfMissing True dir\n    putProgressInfo =<< renderAction \"Copy file\" source target\n    quietly $ copyFileChanged source target\n\n-- | Copy a file without tracking the source. Create the target directory if missing.\ncopyFileUntracked :: FilePath -> FilePath -> Action ()\ncopyFileUntracked source target = do\n    let dir = takeDirectory target\n    liftIO $ IO.createDirectoryIfMissing True dir\n    putProgressInfo =<< renderAction \"Copy file (untracked)\" source target\n    liftIO $ IO.copyFile source target\n\n-- | Transform a given file by applying a function to its contents.\nfixFile :: FilePath -> (String -> String) -> Action ()\nfixFile file f = do\n    putProgressInfo $ \"| Fix \" ++ file\n    contents <- liftIO $ IO.withFile file IO.ReadMode $ \\h -> do\n        old <- IO.hGetContents h\n        let new = f old\n        IO.evaluate $ rnf new\n        return new\n    liftIO $ writeFile file contents\n\n-- | Make a given file executable by running the @chmod +x@ command.\nmakeExecutable :: FilePath -> Action ()\nmakeExecutable file = do\n    putProgressInfo $ \"| Make \" ++ quote file ++ \" executable.\"\n    quietly $ cmd \"chmod +x \" [file]\n\n-- | Move a file. Note that we cannot track the source, because it is moved.\nmoveFile :: FilePath -> FilePath -> Action ()\nmoveFile source target = do\n    putProgressInfo =<< renderAction \"Move file\" source target\n    quietly $ cmd [\"mv\", source, target]\n\n-- | Remove a file that doesn't necessarily exist.\nremoveFile :: FilePath -> Action ()\nremoveFile file = do\n    putProgressInfo $ \"| Remove file \" ++ file\n    liftIO . whenM (IO.doesFileExist file) $ IO.removeFile file\n\n-- | Create a directory if it does not already exist.\ncreateDirectory :: FilePath -> Action ()\ncreateDirectory dir = do\n    putProgressInfo $ \"| Create directory \" ++ dir\n    liftIO $ IO.createDirectoryIfMissing True dir\n\n-- | Copy a directory. The contents of the source directory is untracked.\ncopyDirectory :: FilePath -> FilePath -> Action ()\ncopyDirectory source target = do\n    putProgressInfo =<< renderAction \"Copy directory\" source target\n    quietly $ cmd [\"cp\", \"-r\", source, target]\n\n-- | Move a directory. The contents of the source directory is untracked.\nmoveDirectory :: FilePath -> FilePath -> Action ()\nmoveDirectory source target = do\n    putProgressInfo =<< renderAction \"Move directory\" source target\n    quietly $ cmd [\"mv\", source, target]\n\n-- | Remove a directory that doesn't necessarily exist.\nremoveDirectory :: FilePath -> Action ()\nremoveDirectory dir = do\n    putProgressInfo $ \"| Remove directory \" ++ dir\n    liftIO . whenM (IO.doesDirectoryExist dir) $ IO.removeDirectoryRecursive dir\n\ndata UseColour = Never | Auto | Always deriving (Eq, Show, Typeable)\n\n-- | Terminal output colours\ndata Colour\n    = Dull ANSIColour   -- ^ 8-bit ANSI colours\n    | Vivid ANSIColour  -- ^ 16-bit vivid ANSI colours\n    | Extended String   -- ^ Extended 256-bit colours, manual code stored\n\n-- | ANSI terminal colours\ndata ANSIColour\n    = Black     -- ^ ANSI code: 30\n    | Red       -- ^ 31\n    | Green     -- ^ 32\n    | Yellow    -- ^ 33\n    | Blue      -- ^ 34\n    | Magenta   -- ^ 35\n    | Cyan      -- ^ 36\n    | White     -- ^ 37\n    | Reset     -- ^ 0\n\n-- | Convert ANSI colour names into their associated codes\ncolourCode :: ANSIColour -> String\ncolourCode Black = \"30\"\ncolourCode Red = \"31\"\ncolourCode Green = \"32\"\ncolourCode Yellow = \"33\"\ncolourCode Blue = \"34\"\ncolourCode Magenta = \"35\"\ncolourCode Cyan = \"36\"\ncolourCode White = \"37\"\ncolourCode Reset = \"0\"\n\n-- | Create the final ANSI code.\nmkColour :: Colour -> String\nmkColour (Dull c) = colourCode c\nmkColour (Vivid c) = colourCode c ++ \";1\"\nmkColour (Extended code) = \"38;5;\" ++ code\n\n-- | A more colourful version of Shake's 'putNormal'.\nputColoured :: String -> String -> Action ()\nputColoured code msg = do\n    useColour <- userSetting Never\n    supported <- liftIO $ (&&) <$> IO.hIsTerminalDevice IO.stdout\n                               <*> (not <$> isDumb)\n    let c Never  = False\n        c Auto   = supported || IO.isWindows -- Colours do work on Windows\n        c Always = True\n    if c useColour\n        then putNormal $ \"\\ESC[\" ++ code ++ \"m\" ++ msg ++ \"\\ESC[0m\"\n        else putNormal msg\n  where\n    isDumb = maybe False (== \"dumb\") <$> lookupEnv \"TERM\"\n\nnewtype BuildProgressColour = BuildProgressColour String\n    deriving Typeable\n\n-- | Generate an encoded colour for progress output from names.\nmkBuildProgressColour :: Colour -> BuildProgressColour\nmkBuildProgressColour c = BuildProgressColour $ mkColour c\n\n-- | Default 'BuildProgressColour'.\nmagenta :: BuildProgressColour\nmagenta = mkBuildProgressColour (Dull Magenta)\n\n-- | Print a build progress message (e.g. executing a build command).\nputBuild :: String -> Action ()\nputBuild msg = do\n    BuildProgressColour code <- userSetting magenta\n    putColoured code msg\n\nnewtype SuccessColour = SuccessColour String\n    deriving Typeable\n\n-- | Generate an encoded colour for successful output from names\nmkSuccessColour :: Colour -> SuccessColour\nmkSuccessColour c = SuccessColour $ mkColour c\n\n-- | Default 'SuccessColour'.\ngreen :: SuccessColour\ngreen = mkSuccessColour (Dull Green)\n\n-- | Print a success message (e.g. a package is built successfully).\nputSuccess :: String -> Action ()\nputSuccess msg = do\n    SuccessColour code <- userSetting green\n    putColoured code msg\n\ndata ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show, Typeable)\n\n-- | Version of 'putBuild' controlled by @--progress-info@ command line argument.\nputProgressInfo :: String -> Action ()\nputProgressInfo msg = do\n    progressInfo <- userSetting None\n    when (progressInfo /= None) $ putBuild msg\n\n-- | Render an action.\nrenderAction :: String -> FilePath -> FilePath -> Action String\nrenderAction what input output = do\n    progressInfo <- userSetting Brief\n    return $ case progressInfo of\n        None    -> \"\"\n        Brief   -> \"| \" ++ what ++ \": \" ++ i ++ \" => \" ++ o\n        Normal  -> renderBox [ what, \"     input: \" ++ i, \" => output: \" ++ o ]\n        Unicorn -> renderUnicorn [ what, \"     input: \" ++ i, \" => output: \" ++ o ]\n  where\n    i = unifyPath input\n    o = unifyPath output\n\n-- | Render an action.\nrenderActionNoOutput :: String -> FilePath -> Action String\nrenderActionNoOutput what input = do\n    progressInfo <- userSetting Brief\n    return $ case progressInfo of\n        None    -> \"\"\n        Brief   -> \"| \" ++ what ++ \": \" ++ i\n        Normal  -> renderBox [ what, \"     input: \" ++ i ]\n        Unicorn -> renderUnicorn [ what, \"     input: \" ++ i ]\n  where\n    i = unifyPath input\n\n-- | Render the successful build of a program.\nrenderProgram :: String -> String -> String -> String\nrenderProgram name bin synopsis = renderBox $\n    [ \"Successfully built program \" ++ name\n    , \"Executable: \" ++ bin ] ++\n    [ \"Program synopsis: \" ++ endWithADot synopsis | not (null synopsis) ]\n\n-- | Render the successful build of a library.\nrenderLibrary :: String -> String -> String -> String\nrenderLibrary name lib synopsis = renderBox $\n    [ \"Successfully built library \" ++ name\n    , \"Library: \" ++ lib ] ++\n    [ \"Library synopsis: \" ++ endWithADot synopsis | not (null synopsis) ]\n\nendWithADot :: String -> String\nendWithADot s = dropWhileEnd isPunctuation s ++ \".\"\n\n-- | Render the given set of lines in an ASCII box. The minimum width and\n-- whether to use Unicode symbols are hardcoded in the function's body.\n--\n-- >>> renderBox (words \"lorem ipsum\")\n-- /----------\\\n-- | lorem    |\n-- | ipsum    |\n-- \\----------/\nrenderBox :: [String] -> String\nrenderBox ls = tail $ concatMap ('\\n' :) (boxTop : map renderLine ls ++ [boxBot])\n  where\n    -- Minimum total width of the box in characters\n    minimumBoxWidth = 32\n\n    -- TODO: Make this setting configurable? Setting to True by default seems\n    -- to work poorly with many fonts.\n    useUnicode = False\n\n    -- Characters to draw the box\n    (dash, pipe, topLeft, topRight, botLeft, botRight, padding)\n        | useUnicode = ('\u00e2\u201d\u20ac', '\u00e2\u201d\u201a', '\u00e2\u2022\u00ad',  '\u00e2\u2022\u00ae', '\u00e2\u2022\u00b0', '\u00e2\u2022\u00af', ' ')\n        | otherwise  = ('-', '|', '/', '\\\\', '\\\\', '/', ' ')\n\n    -- Box width, taking minimum desired length and content into account.\n    -- The -4 is for the beginning and end pipe/padding symbols, as\n    -- in \"| xxx |\".\n    boxContentWidth = (minimumBoxWidth - 4) `max` maxContentLength\n      where\n        maxContentLength = maximum (map length ls)\n\n    renderLine l = concat\n        [ [pipe, padding]\n        , padToLengthWith boxContentWidth padding l\n        , [padding, pipe] ]\n      where\n        padToLengthWith n filler x = x ++ replicate (n - length x) filler\n\n    (boxTop, boxBot) = ( topLeft : dashes ++ [topRight]\n                       , botLeft : dashes ++ [botRight] )\n      where\n        -- +1 for each non-dash (= corner) char\n        dashes = replicate (boxContentWidth + 2) dash\n\n-- | Render the given set of lines next to our favorite unicorn Robert.\nrenderUnicorn :: [String] -> String\nrenderUnicorn ls =\n    unlines $ take (max (length ponyLines) (length boxLines)) $\n        zipWith (++) (ponyLines ++ repeat ponyPadding) (boxLines ++ repeat \"\")\n  where\n    ponyLines :: [String]\n    ponyLines = [ \"                   ,;,,;'\"\n                , \"                  ,;;'(    Robert the spitting unicorn\"\n                , \"       __       ,;;' ' \\\\   wants you to know\"\n                , \"     /'  '\\\\'~~'~' \\\\ /'\\\\.)  that a task      \"\n                , \"  ,;(      )    /  |.  /   just finished!   \"\n                , \" ,;' \\\\    /-.,,(   ) \\\\                      \"\n                , \" ^    ) /       ) / )|     Almost there!    \"\n                , \"      ||        ||  \\\\)                      \"\n                , \"      (_\\\\       (_\\\\                         \" ]\n    ponyPadding :: String\n    ponyPadding = \"                                            \"\n    boxLines :: [String]\n    boxLines = [\"\", \"\", \"\"] ++ (lines . renderBox $ ls)\n", "num_lines": 560}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Builder.Ar\n-- Copyright  : (c) Andrey Mokhov 2014-2017\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- Support for invoking the archiving utility @ar@. We take care not to exceed\n-- the limit on command line length, which differs across supported operating\n-- systems (see 'cmdLineLengthLimit'). We need to handle @ar@ in a special way\n-- because we sometimes archive __a lot__ of files (in the Cabal library, for\n-- example, command line length can reach 2MB!). To work around the limit on the\n-- command line length we pass the list of files to be archived via a temporary\n-- file (see 'runAr'), or alternatively, we split the argument list into chunks\n-- and call @ar@ multiple times, e.g. when passing arguments via a temporary\n-- file is not supported (see 'runArWithoutTempFile').\n-----------------------------------------------------------------------------\nmodule Hadrian.Builder.Ar (ArMode (..), args, runAr, runArWithoutTempFile) where\n\nimport Control.Monad\nimport Development.Shake\nimport Development.Shake.Classes\nimport GHC.Generics\nimport Hadrian.Expression\nimport Hadrian.Utilities\n\n-- | We support packing and unpacking archives with @ar@.\ndata ArMode = Pack | Unpack deriving (Eq, Generic, Show)\n\ninstance Binary   ArMode\ninstance Hashable ArMode\ninstance NFData   ArMode\n\n-- NOTE: Make sure to appropriately update 'arFlagsCount' when changing 'args'.\n-- | Default command line arguments for invoking the archiving utility @ar@.\nargs :: (ShakeValue c, ShakeValue b) => ArMode -> Args c b\nargs Pack   = mconcat [ arg \"q\", arg =<< getOutput, getInputs ]\nargs Unpack = mconcat [ arg \"x\", arg =<< getInput ]\n\n-- This count includes \"q\" and the output file argumentes in 'args'. This is\n-- only relevant for the 'Pack' @ar@ mode.\narFlagsCount :: Int\narFlagsCount = 2\n\n-- | Invoke @ar@ given a path to it and a list of arguments. The list of files\n-- to be archived is passed via a temporary file. Passing arguments via a\n-- temporary file is not supported by some versions of @ar@, in which case you\n-- should use 'runArWithoutTempFile' instead.\nrunAr :: FilePath -> [String] -> Action ()\nrunAr arPath argList = withTempFile $ \\tmp -> do\n    writeFile' tmp $ unwords fileArgs\n    cmd [arPath] flagArgs ('@' : tmp)\n  where\n    flagArgs = take arFlagsCount argList\n    fileArgs = drop arFlagsCount argList\n\n-- | Invoke @ar@ given a path to it and a list of arguments. Note that @ar@\n-- will be called multiple times if the list of files to be archived is too\n-- long and doesn't fit into the command line length limit. This function is\n-- typically much slower than 'runAr'.\nrunArWithoutTempFile :: FilePath -> [String] -> Action ()\nrunArWithoutTempFile arPath argList =\n    forM_ (chunksOfSize cmdLineLengthLimit fileArgs) $ \\argsChunk ->\n        unit . cmd [arPath] $ flagArgs ++ argsChunk\n  where\n    flagArgs = take arFlagsCount argList\n    fileArgs = drop arFlagsCount argList\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Builder.Sphinx\n-- Copyright  : (c) Andrey Mokhov 2014-2017\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- Support for invoking the documentation utility Sphinx.\n-----------------------------------------------------------------------------\nmodule Hadrian.Builder.Sphinx (SphinxMode (..), args) where\n\nimport Development.Shake\nimport Development.Shake.Classes\nimport GHC.Generics\nimport Hadrian.Expression\nimport Hadrian.Utilities\n\n-- | Sphinx can be used in three different modes to convert reStructuredText\n-- documents into HTML, LaTeX or Man pages.\ndata SphinxMode = Html | Latex | Man deriving (Eq, Generic, Show)\n\ninstance Binary   SphinxMode\ninstance Hashable SphinxMode\ninstance NFData   SphinxMode\n\n-- | Default command line arguments for invoking the archiving utility @tar@.\nargs :: (ShakeValue c, ShakeValue b) => SphinxMode -> Args c b\nargs mode = do\n    outPath <- getOutput\n    mconcat [ arg \"-b\", arg modeString\n            , arg \"-d\", arg $ outPath -/- (\".doctrees-\" ++ modeString)\n            , arg =<< getInput\n            , arg outPath ]\n  where\n    modeString = case mode of\n        Html  -> \"html\"\n        Latex -> \"latex\"\n        Man   -> \"man\"\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Builder.Tar\n-- Copyright  : (c) Andrey Mokhov 2014-2017\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- Support for invoking the archiving utility @tar@.\n-----------------------------------------------------------------------------\nmodule Hadrian.Builder.Tar (TarMode (..), args) where\n\nimport Development.Shake\nimport Development.Shake.Classes\nimport GHC.Generics\nimport Hadrian.Expression\nimport Oracles.Setting\n\n-- | Tar can be used to 'Create' an archive or 'Extract' from it.\ndata TarMode = Create | Extract deriving (Eq, Generic, Show)\n\ninstance Binary   TarMode\ninstance Hashable TarMode\ninstance NFData   TarMode\n\n\n-- | Default command line arguments for invoking the archiving utility @tar@.\nargs :: (ShakeValue c, ShakeValue b) => TarMode -> Args c b\nargs Create = mconcat\n    [ arg \"-c\"\n    , output \"//*.gz\"  ? arg \"--gzip\"\n    , output \"//*.bz2\" ? arg \"--bzip2\"\n    , output \"//*.xz\"  ? arg \"--xz\"\n    , arg \"-f\", arg =<< getOutput\n    , getInputs ]\nargs Extract = mconcat\n    [ arg \"-x\"\n    , windowsHost ? arg \"--force-local\"\n    , input \"*.gz\"  ? arg \"--gzip\"\n    , input \"*.bz2\" ? arg \"--bzip2\"\n    , input \"*.xz\"  ? arg \"--xz\"\n    , arg \"-f\", arg =<< getInput\n    , arg \"-C\", arg =<< getOutput ]\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Haskell.Cabal\n-- Copyright  : (c) Andrey Mokhov 2014-2018\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- Basic functionality for extracting Haskell package metadata stored in\n-- Cabal files.\n-----------------------------------------------------------------------------\nmodule Hadrian.Haskell.Cabal (\n    pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies,\n    pkgGenericDescription, cabalArchString, cabalOsString,\n    ) where\n\nimport Development.Shake\nimport Distribution.PackageDescription (GenericPackageDescription)\n\nimport Hadrian.Haskell.Cabal.Type\nimport Hadrian.Oracles.Cabal\nimport Hadrian.Package\n\n-- | Read a Cabal file and return the package version. The Cabal file is tracked.\npkgVersion :: Package -> Action String\npkgVersion = fmap version . readPackageData\n\n-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0@.\n-- The Cabal file is tracked.\npkgIdentifier :: Package -> Action String\npkgIdentifier package = do\n    cabal <- readPackageData package\n    return $ if null (version cabal)\n        then name cabal\n        else name cabal ++ \"-\" ++ version cabal\n\n-- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.\npkgSynopsis :: Package -> Action String\npkgSynopsis = fmap synopsis . readPackageData\n\n-- | Read a Cabal file and return the package description. The Cabal file is\n-- tracked.\npkgDescription :: Package -> Action String\npkgDescription = fmap description . readPackageData\n\n-- | Read a Cabal file and return the sorted list of the package dependencies.\n-- The current version does not take care of Cabal conditionals and therefore\n-- returns a crude overapproximation of actual dependencies. The Cabal file is\n-- tracked.\npkgDependencies :: Package -> Action [PackageName]\npkgDependencies = fmap (map pkgName . packageDependencies) . readPackageData\n\n-- | Read a Cabal file and return the 'GenericPackageDescription'. The Cabal\n-- file is tracked.\npkgGenericDescription :: Package -> Action GenericPackageDescription\npkgGenericDescription = fmap genericPackageDescription . readPackageData\n\n-- | Cabal's rendering of an architecture as used in its directory structure.\n--\n-- Inverse of 'Cabal.Distribution.Simple.GHC.ghcArchString'.\ncabalArchString :: String -> String\ncabalArchString \"powerpc\"   = \"ppc\"\ncabalArchString \"powerpc64\" = \"ppc64\"\ncabalArchString other       = other\n\n-- | Cabal's rendering of an OS as used in its directory structure.\n--\n-- Inverse of 'Cabal.Distribution.Simple.GHC.ghcOsString'.\ncabalOsString :: String -> String\ncabalOsString \"mingw32\"  = \"windows\"\ncabalOsString \"darwin\"   = \"osx\"\ncabalOsString \"solaris2\" = \"solaris\"\ncabalOsString other      = other\n", "num_lines": 74}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-deprecations #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Haskell.Cabal.Parse\n-- Copyright  : (c) Andrey Mokhov 2014-2017\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- Extracting Haskell package metadata stored in Cabal files.\n-----------------------------------------------------------------------------\nmodule Hadrian.Haskell.Cabal.Parse (\n    parsePackageData, resolveContextData, parseCabalPkgId, configurePackage,\n    buildAutogenFiles, copyPackage, registerPackage\n    ) where\n\nimport Data.Bifunctor\nimport Data.List.Extra\nimport Development.Shake\nimport qualified Distribution.ModuleName                       as C\nimport qualified Distribution.Package                          as C\nimport qualified Distribution.PackageDescription               as C\nimport qualified Distribution.PackageDescription.Configuration as C\nimport qualified Distribution.PackageDescription.Parsec        as C\nimport qualified Distribution.Simple.Compiler                  as C\nimport qualified Distribution.Simple.Program.Db                as C\nimport qualified Distribution.Simple                           as C\nimport qualified Distribution.Simple.Program.Builtin           as C\nimport qualified Distribution.Simple.Utils                     as C\nimport qualified Distribution.Simple.Program.Types             as C\nimport qualified Distribution.Simple.Configure                 as C (getPersistBuildConfig)\nimport qualified Distribution.Simple.Build                     as C\nimport qualified Distribution.Types.ComponentRequestedSpec     as C\nimport qualified Distribution.InstalledPackageInfo             as Installed\nimport qualified Distribution.Simple.PackageIndex              as C\nimport qualified Distribution.Text                             as C\nimport qualified Distribution.Types.LocalBuildInfo             as C\nimport qualified Distribution.Types.CondTree                   as C\nimport qualified Distribution.Types.MungedPackageId            as C\nimport qualified Distribution.Verbosity                        as C\nimport Hadrian.Expression\nimport Hadrian.Haskell.Cabal\nimport Hadrian.Haskell.Cabal.Type\nimport Hadrian.Oracles.Cabal\nimport Hadrian.Target\n\nimport Base\nimport Builder\nimport Context\nimport Flavour\nimport Packages\nimport Settings\n\n-- | Parse the Cabal file of a given 'Package'. This operation is cached by the\n-- \"Hadrian.Oracles.TextFile.readPackageData\" oracle.\nparsePackageData :: Package -> Action PackageData\nparsePackageData pkg = do\n    gpd <- liftIO $ C.readGenericPackageDescription C.verbose (pkgCabalFile pkg)\n    let pd      = C.packageDescription gpd\n        pkgId   = C.package pd\n        name    = C.unPackageName (C.pkgName pkgId)\n        version = C.display (C.pkgVersion pkgId)\n        libDeps = collectDeps (C.condLibrary gpd)\n        exeDeps = map (collectDeps . Just . snd) (C.condExecutables gpd)\n        allDeps = concat (libDeps : exeDeps)\n        sorted  = sort [ C.unPackageName p | C.Dependency p _ _ <- allDeps ]\n        deps    = nubOrd sorted \\\\ [name]\n        depPkgs = catMaybes $ map findPackageByName deps\n    return $ PackageData name version (C.synopsis pd) (C.description pd) depPkgs gpd\n  where\n    -- Collect an overapproximation of dependencies by ignoring conditionals\n    collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency]\n    collectDeps Nothing = []\n    collectDeps (Just (C.CondNode _ deps ifs)) = deps ++ concatMap f ifs\n      where\n        f (C.CondBranch _ t mt) = collectDeps (Just t) ++ collectDeps mt\n\n-- | Parse the package identifier from a Cabal file.\nparseCabalPkgId :: FilePath -> IO String\nparseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file\n\nbiModules :: C.PackageDescription -> (C.BuildInfo, [C.ModuleName], Maybe (C.ModuleName, String))\nbiModules pd = go [ comp | comp@(bi,_,_) <-\n                             (map libBiModules . maybeToList $ C.library pd) ++\n                             (map exeBiModules               $ C.executables pd)\n                         , C.buildable bi ]\n  where\n    libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib, Nothing)\n    exeBiModules exe = (C.buildInfo exe,\n                       -- If \"main-is: ...\" is not a .hs or .lhs file, do not\n                       -- inject \"Main\" into the modules.  This does not respect\n                       -- \"-main-is\" ghc-arguments! See Cabal's\n                       -- Distribution.Simple.GHC for the glory details.\n                       if takeExtension (C.modulePath exe) `elem` [\".hs\", \".lhs\"]\n                           then C.main : C.exeModules exe\n                                -- The module `Main` still need to be kept in `modules` of PD.\n                           else C.exeModules exe,\n                       Just (C.main, C.modulePath exe))\n    go []  = error \"No buildable component found.\"\n    go [x] = x\n    go _   = error \"Cannot handle more than one buildinfo yet.\"\n\n-- TODO: Track command line arguments and package configuration flags.\n-- | Configure a package using the Cabal library by collecting all the command\n-- line arguments (to be passed to the setup script) and package configuration\n-- flags. The function 'need's package database entries for the dependencies of\n-- the package the 'Context' points to.\nconfigurePackage :: Context -> Action ()\nconfigurePackage context@Context {..} = do\n    putProgressInfo $ \"| Configure package \" ++ quote (pkgName package)\n    gpd     <- pkgGenericDescription package\n    depPkgs <- packageDependencies <$> readPackageData package\n\n    -- Stage packages are those we have in this stage.\n    stagePkgs <- stagePackages stage\n    -- We'll need those packages in our package database.\n    deps <- sequence [ pkgConfFile (context { package = pkg })\n                     | pkg <- depPkgs, pkg `elem` stagePkgs ]\n    need deps\n\n    -- Figure out what hooks we need.\n    hooks <- case C.buildType (C.flattenPackageDescription gpd) of\n        C.Configure -> pure C.autoconfUserHooks\n        -- The 'time' package has a 'C.Custom' Setup.hs, but it's actually\n        -- 'C.Configure' plus a @./Setup test@ hook. However, Cabal is also\n        -- 'C.Custom', but doesn't have a configure script.\n        C.Custom -> do\n            configureExists <- doesFileExist $\n                replaceFileName (pkgCabalFile package) \"configure\"\n            pure $ if configureExists then C.autoconfUserHooks else C.simpleUserHooks\n        -- Not quite right, but good enough for us:\n        _ | package == rts ->\n            -- Don't try to do post configuration validation for 'rts'. This\n            -- will simply not work, due to the @ld-options@ and @Stg.h@.\n            pure $ C.simpleUserHooks { C.postConf = \\_ _ _ _ -> return () }\n          | otherwise -> pure C.simpleUserHooks\n\n    -- Compute the list of flags, and the Cabal configurartion arguments\n    flavourArgs <- args <$> flavour\n    flagList    <- interpret (target context (Cabal Flags stage) [] []) flavourArgs\n    argList     <- interpret (target context (Cabal Setup stage) [] []) flavourArgs\n    verbosity   <- getVerbosity\n    let v = if verbosity >= Loud then \"-v3\" else \"-v0\"\n    liftIO $ C.defaultMainWithHooksNoReadArgs hooks gpd\n        (argList ++ [\"--flags=\" ++ unwords flagList, v])\n\n    dir <- Context.buildPath context\n    files <- liftIO $ getDirectoryFilesIO \".\" [ dir -/- \"include\" <//> \"*\"\n                                              , dir -/- \"*.buildinfo\"\n                                              , dir -/- \"lib\" <//> \"*\"\n                                              , dir -/- \"config.*\" ]\n    produces files\n\n-- | Copy the 'Package' of a given 'Context' into the package database\n-- corresponding to the 'Stage' of the 'Context'.\ncopyPackage :: Context -> Action ()\ncopyPackage context@Context {..} = do\n    putProgressInfo $ \"| Copy package \" ++ quote (pkgName package)\n    gpd <- pkgGenericDescription package\n    ctxPath   <- Context.contextPath context\n    pkgDbPath <- packageDbPath stage\n    verbosity <- getVerbosity\n    let v = if verbosity >= Loud then \"-v3\" else \"-v0\"\n    liftIO $ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd\n        [ \"copy\", \"--builddir\", ctxPath, \"--target-package-db\", pkgDbPath, v ]\n\n-- | Register the 'Package' of a given 'Context' into the package database.\nregisterPackage :: Context -> Action ()\nregisterPackage context@Context {..} = do\n    putProgressInfo $ \"| Register package \" ++ quote (pkgName package)\n    ctxPath <- Context.contextPath context\n    gpd <- pkgGenericDescription package\n    verbosity <- getVerbosity\n    let v = if verbosity >= Loud then \"-v3\" else \"-v0\"\n    liftIO $ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd\n        [ \"register\", \"--builddir\", ctxPath, v ]\n\n-- | Parse the 'ContextData' of a given 'Context'.\nresolveContextData :: Context -> Action ContextData\nresolveContextData context@Context {..} = do\n    -- TODO: This is conceptually wrong!\n    -- We should use the gpd, the flagAssignment and compiler, hostPlatform, and\n    -- other information from the lbi. And then compute the finalised PD (flags,\n    -- satisfiable dependencies, platform, compiler info, deps, gpd).\n    --\n    -- let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (compilerInfo compiler) [] gpd\n    --\n    -- However when using the new-build path's this might change.\n\n    -- Read the package description from the Cabal file\n    gpd <- genericPackageDescription <$> readPackageData package\n\n    -- Configure the package with the GHC for this stage\n    (compiler, platform) <- configurePackageGHC package stage\n\n    flagList <- interpret (target context (Cabal Flags stage) [] []) =<< args <$> flavour\n    let flags = foldr addFlag mempty flagList\n          where\n            addFlag :: String -> C.FlagAssignment -> C.FlagAssignment\n            addFlag ('-':name) = C.insertFlagAssignment (C.mkFlagName name) False\n            addFlag ('+':name) = C.insertFlagAssignment (C.mkFlagName name) True\n            addFlag name       = C.insertFlagAssignment (C.mkFlagName name) True\n\n    let (Right (pd,_)) = C.finalizePD flags C.defaultComponentRequestedSpec\n                         (const True) platform (C.compilerInfo compiler) [] gpd\n\n    cPath <- Context.contextPath context\n    lbi <- liftIO $ C.getPersistBuildConfig cPath\n\n    -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path\n    -- from the local build info @lbi@.\n    pdi <- liftIO $ getHookedBuildInfo [pkgPath package, cPath -/- \"build\"]\n    let pd'  = C.updatePackageDescription pdi pd\n        lbi' = lbi { C.localPkgDescr = pd' }\n\n    -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations\n    -- See: https://github.com/snowleopard/hadrian/issues/548\n    let extDeps      = C.externalPackageDeps lbi'\n        deps         = map (C.display . snd) extDeps\n        depDirect    = map (fromMaybe (error \"resolveContextData: depDirect failed\")\n                     . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps\n        depIds       = map (C.display . Installed.installedUnitId) depDirect\n        Just ghcProg = C.lookupProgram C.ghcProgram (C.withPrograms lbi')\n        depPkgs      = C.topologicalOrder (packageHacks (C.installedPkgs lbi'))\n        forDeps f    = concatMap f depPkgs\n\n        -- Copied from Distribution.Simple.PreProcess.ppHsc2Hs\n        packageHacks = case C.compilerFlavor (C.compiler lbi') of\n            C.GHC | C.pkgName (C.package pd') /= (C.mkPackageName \"rts\") -> hackRtsPackage\n            _   -> id\n\n        -- TODO: Get rid of this hack.\n        -- We don't link in the actual Haskell libraries of our dependencies, so\n        -- the \"-u\" flags in @ldOptions@ of the @rts@ package mean linking fails\n        -- on OS X (its @ld@ is a tad stricter than GNU @ld@). Thus we remove\n        -- @ldOptions@ for the @rts@ package. With one exception (see below).\n        hackRtsPackage index | null (C.allPackages index) = index\n        -- ^ do not hack the empty index\n        hackRtsPackage index = case C.lookupPackageName index (C.mkPackageName \"rts\") of\n            [(_, [rts])] -> C.insert rts {\n                Installed.ldOptions   = [],\n                Installed.libraryDirs = filter (not . (\"gcc-lib\" `isSuffixOf`))\n                                               (Installed.libraryDirs rts)} index\n            -- GHC <= 6.12 had @$topdir/gcc-lib@ in their @library-dirs@ for the\n            -- 'rts' package, which causes problems when we try to use the\n            -- in-tree @mingw@, due to accidentally picking up the incompatible\n            -- libraries there. So we filter out @gcc-lib@ from the RTS's\n            -- @library-dirs@ here.\n            _ -> error \"No (or multiple) GHC rts package is registered!\"\n\n        (buildInfo, modules, mainIs) = biModules pd'\n\n      in return $ ContextData\n          { dependencies    = deps\n          , componentId     = C.localCompatPackageKey lbi'\n          , mainIs          = fmap (first C.display) mainIs\n          , modules         = map C.display modules\n          , otherModules    = map C.display $ C.otherModules buildInfo\n          , srcDirs         = C.hsSourceDirs buildInfo\n          , depIds          = depIds\n          , depNames        = map (C.display . C.mungedName . snd) extDeps\n          , includeDirs     = C.includeDirs     buildInfo\n          , includes        = C.includes        buildInfo\n          , installIncludes = C.installIncludes buildInfo\n          , extraLibs       = C.extraLibs       buildInfo\n          , extraLibDirs    = C.extraLibDirs    buildInfo\n          , asmSrcs         = C.asmSources      buildInfo\n          , cSrcs           = C.cSources        buildInfo\n          , cmmSrcs         = C.cmmSources      buildInfo\n          , hcOpts          = C.programDefaultArgs ghcProg\n              ++ C.hcOptions C.GHC buildInfo\n              ++ C.languageToFlags   (C.compiler lbi') (C.defaultLanguage buildInfo)\n              ++ C.extensionsToFlags (C.compiler lbi') (C.usedExtensions  buildInfo)\n              ++ C.programOverrideArgs ghcProg\n          , asmOpts            = C.asmOptions buildInfo\n          , ccOpts             = C.ccOptions  buildInfo\n          , cmmOpts            = C.cmmOptions buildInfo\n          , cppOpts            = C.cppOptions buildInfo\n          , ldOpts             = C.ldOptions  buildInfo\n          , depIncludeDirs     = forDeps Installed.includeDirs\n          , depCcOpts          = forDeps Installed.ccOptions\n          , depLdOpts          = forDeps Installed.ldOptions\n          , buildGhciLib       = C.withGHCiLib lbi'\n          , frameworks         = C.frameworks buildInfo\n          , packageDescription = pd' }\n\n-- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs@.\nbuildAutogenFiles :: Context -> Action ()\nbuildAutogenFiles context = do\n    cPath <- Context.contextPath context\n    setupConfig <- pkgSetupConfigFile context\n    need [setupConfig] -- This triggers 'configurePackage'\n    pd <- packageDescription <$> readContextData context\n    -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path\n    -- from the local build info @lbi@.\n    liftIO $ do\n        lbi <- C.getPersistBuildConfig cPath\n        C.initialBuildSteps cPath pd (lbi { C.localPkgDescr = pd }) C.silent\n\n-- | Look for a @.buildinfo@ in all of the specified directories, stopping on\n-- the first one we find.\ngetHookedBuildInfo :: [FilePath] -> IO C.HookedBuildInfo\ngetHookedBuildInfo [] = return C.emptyHookedBuildInfo\ngetHookedBuildInfo (baseDir:baseDirs) = do\n    maybeInfoFile <- C.findHookedPackageDesc baseDir\n    case maybeInfoFile of\n        Nothing       -> getHookedBuildInfo baseDirs\n        Just infoFile -> C.readHookedBuildInfo C.silent infoFile\n", "num_lines": 309}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Haskell.Cabal.Type\n-- Copyright  : (c) Andrey Mokhov 2014-2018\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- Data types for storing basic Haskell package metadata, such as package name,\n-- version and dependencies, extracted from a Cabal file.\n-----------------------------------------------------------------------------\nmodule Hadrian.Haskell.Cabal.Type where\n\nimport Development.Shake.Classes\nimport Distribution.PackageDescription\nimport GHC.Generics\n\nimport Hadrian.Package\n\n-- | Haskell package metadata extracted from a Cabal file without performing\n-- the resolution of package configuration flags and associated conditionals,\n-- which are build context specific. Note that 'packageDependencies' is an\n-- overappoximation of actual package dependencies; for example, both @unix@ and\n-- @win32@ packages may be included even if only one of them is required on the\n-- target OS. See 'ContextData' for metadata obtained after resolving package\n-- configuration flags and conditionals according to the current build context.\ndata PackageData = PackageData\n    { name                      :: PackageName\n    , version                   :: String\n    , synopsis                  :: String\n    , description               :: String\n    , packageDependencies       :: [Package]\n    , genericPackageDescription :: GenericPackageDescription\n    } deriving (Eq, Generic, Show, Typeable)\n\n-- | Haskell package metadata obtained after resolving package configuration\n-- flags and associated conditionals according to the current build context.\n-- See 'PackageData' for metadata that can be obtained without resolving package\n-- configuration flags and conditionals.\ndata ContextData = ContextData\n    { dependencies       :: [PackageName]\n    , componentId        :: String\n    , mainIs             :: Maybe (String, FilePath)  -- (\"Main\", filepath)\n    , modules            :: [String]\n    , otherModules       :: [String]\n    , srcDirs            :: [String]\n    , depIds             :: [String]\n    , depNames           :: [String]\n    , includeDirs        :: [String]\n    , includes           :: [String]\n    , installIncludes    :: [String]\n    , extraLibs          :: [String]\n    , extraLibDirs       :: [String]\n    , asmSrcs            :: [String]\n    , cSrcs              :: [String]\n    , cmmSrcs            :: [String]\n    , hcOpts             :: [String]\n    , asmOpts            :: [String]\n    , ccOpts             :: [String]\n    , cmmOpts            :: [String]\n    , cppOpts            :: [String]\n    , ldOpts             :: [String]\n    , depIncludeDirs     :: [String]\n    , depCcOpts          :: [String]\n    , depLdOpts          :: [String]\n    , buildGhciLib       :: Bool\n    , frameworks         :: [String]\n    , packageDescription :: PackageDescription\n    } deriving (Eq, Generic, Show, Typeable)\n\ninstance Binary   PackageData\ninstance Hashable PackageData where hashWithSalt salt = hashWithSalt salt . show\ninstance NFData   PackageData\n\ninstance Binary   ContextData\ninstance Hashable ContextData where hashWithSalt salt = hashWithSalt salt . show\ninstance NFData   ContextData\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Hadrian.Oracles.ArgsHash (\n    TrackArgument, trackAllArguments, trackArgsHash, argsHashOracle\n    ) where\n\nimport Control.Monad\nimport Development.Shake\nimport Development.Shake.Classes\n\nimport Hadrian.Expression hiding (inputs, outputs)\nimport Hadrian.Target\n\n-- | 'TrackArgument' is used to specify the arguments that should be tracked by\n-- the @ArgsHash@ oracle. The safest option is to track all arguments, but some\n-- arguments, such as @-jN@, do not change the build results, hence there is no\n-- need to initiate unnecessary rebuild if they are added to or removed from a\n-- command line. If all arguments should be tracked, use 'trackAllArguments'.\ntype TrackArgument c b = Target c b -> String -> Bool\n\n-- | Returns 'True' for all targets and arguments, hence can be used a safe\n-- default for 'argsHashOracle'.\ntrackAllArguments :: TrackArgument c b\ntrackAllArguments _ _ = True\n\n-- | Given a 'Target' this 'Action' determines the corresponding argument list\n-- and computes its hash. The resulting value is tracked in a Shake oracle,\n-- hence initiating rebuilds when the hash changes (a hash change indicates\n-- changes in the build command for the given target).\n-- Note: for efficiency we replace the list of input files with its hash to\n-- avoid storing long lists of source files passed to some builders (e.g. ar)\n-- in the Shake database. This optimisation is normally harmless, because\n-- argument list constructors are assumed not to examine target sources, but\n-- only append them to argument lists where appropriate.\ntrackArgsHash :: (ShakeValue c, ShakeValue b) => Target c b -> Action ()\ntrackArgsHash t = do\n    let hashedInputs  = [ show $ hash (inputs t) ]\n        hashedTarget = target (context t) (builder t) hashedInputs (outputs t)\n    void (askOracle $ ArgsHash hashedTarget :: Action Int)\n\nnewtype ArgsHash c b = ArgsHash (Target c b)\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult (ArgsHash c b) = Int\n\n-- | This oracle stores per-target argument list hashes in the Shake database,\n-- allowing the user to track them between builds using 'trackArgsHash' queries.\nargsHashOracle :: (ShakeValue c, ShakeValue b) => TrackArgument c b -> Args c b -> Rules ()\nargsHashOracle trackArgument args = void $\n    addOracle $ \\(ArgsHash target) -> do\n        argList <- interpret target args\n        let trackedArgList = filter (trackArgument target) argList\n        return $ hash trackedArgList\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Oracles.Cabal\n-- Copyright  : (c) Andrey Mokhov 2014-2018\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- This module defines oracles for reading and parsing Cabal files, as well as\n-- for configuring Haskell packages.\n-----------------------------------------------------------------------------\nmodule Hadrian.Oracles.Cabal (\n    readPackageData, readContextData, configurePackageGHC\n    ) where\n\nimport Development.Shake\nimport Distribution.Simple (Compiler)\nimport Distribution.System (Platform)\n\nimport Context.Type\nimport Hadrian.Haskell.Cabal.Type\nimport Hadrian.Oracles.Cabal.Type\nimport Hadrian.Package\nimport Stage\n\n-- | Read and parse a Cabal file, caching and tracking the result.\nreadPackageData :: Package -> Action PackageData\nreadPackageData = askOracle . PackageDataKey\n\n-- | Read and parse a Cabal file recording the obtained 'ContextData', caching\n-- and tracking the result. Note that unlike 'readPackageData' this function\n-- resolves all Cabal configuration flags and associated conditionals.\nreadContextData :: Context -> Action ContextData\nreadContextData = askOracle . ContextDataKey\n\n-- | Configure a 'Package' using the GHC corresponding to a given 'Stage',\n-- caching and tracking the result.\nconfigurePackageGHC :: Package -> Stage -> Action (Compiler, Platform)\nconfigurePackageGHC pkg stage = do\n    PackageConfiguration res <- askOracle $ PackageConfigurationKey (pkg, stage)\n    return res\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Hadrian.Oracles.DirectoryContents (\n    directoryContents, copyDirectoryContents, directoryContentsOracle, copyDirectoryContentsUntracked,\n    Match (..), matches, matchAll\n    ) where\n\nimport Control.Monad\nimport Development.Shake\nimport Development.Shake.Classes\nimport Development.Shake.FilePath\nimport GHC.Generics\n\nimport Hadrian.Utilities\n\nimport qualified System.Directory.Extra as IO\n\ndata Match = Test FilePattern | Not Match | And [Match] | Or [Match]\n    deriving (Generic, Eq, Show, Typeable)\n\ninstance Binary   Match\ninstance Hashable Match\ninstance NFData   Match\n\n-- | A 'Match' expression that always evaluates to 'True' (i.e. always matches).\nmatchAll :: Match\nmatchAll = And []\n\n-- | Check if a file name matches a given 'Match' expression.\nmatches :: Match -> FilePath -> Bool\nmatches (Test p) f = p ?== f\nmatches (Not  m) f = not $ matches m f\nmatches (And ms) f = all (`matches` f) ms\nmatches (Or  ms) f = any (`matches` f) ms\n\n-- | Given a 'Match' expression and a directory, recursively traverse it and all\n-- its subdirectories to find and return all matching contents.\ndirectoryContents :: Match -> FilePath -> Action [FilePath]\ndirectoryContents expr dir = askOracle $ DirectoryContents (expr, dir)\n\n-- | Copy the contents of the source directory that matches a given 'Match'\n-- expression into the target directory. The copied contents is tracked.\ncopyDirectoryContents :: Match -> FilePath -> FilePath -> Action ()\ncopyDirectoryContents expr source target = do\n    putProgressInfo =<< renderAction \"Copy directory contents\" source target\n    let cp file = copyFile file $ target -/- makeRelative source file\n    mapM_ cp =<< directoryContents expr source\n\n-- | Copy the contents of the source directory that matches a given 'Match'\n-- expression into the target directory. The copied contents is untracked.\ncopyDirectoryContentsUntracked :: Match -> FilePath -> FilePath -> Action ()\ncopyDirectoryContentsUntracked expr source target = do\n    putProgressInfo =<< renderAction \"Copy directory contents (untracked)\" source target\n    let cp file = copyFileUntracked file $ target -/- makeRelative source file\n    mapM_ cp =<< directoryContents expr source\n\nnewtype DirectoryContents = DirectoryContents (Match, FilePath)\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult DirectoryContents = [FilePath]\n\n-- | This oracle answers 'directoryContents' queries and tracks the results.\ndirectoryContentsOracle :: Rules ()\ndirectoryContentsOracle = void $\n    addOracle $ \\(DirectoryContents (expr, dir)) -> liftIO $ map unifyPath .\n        filter (matches expr) <$> IO.listFilesInside (return . matches expr) dir\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Hadrian.Oracles.Path (\n    lookupInPath, bashPath, fixAbsolutePathOnWindows, pathOracle\n    ) where\n\nimport Control.Monad\nimport Data.Maybe\nimport Data.Char\nimport Data.List.Extra\nimport Development.Shake\nimport Development.Shake.Classes\nimport Development.Shake.FilePath\nimport System.Directory\nimport System.Info.Extra\n\nimport Hadrian.Utilities\n\n-- | Lookup a specified 'FilePath' in the system @PATH@.\nlookupInPath :: FilePath -> Action FilePath\nlookupInPath name\n    | name == takeFileName name = askOracle $ LookupInPath name\n    | otherwise                 = return name\n\n-- | Lookup the path to the @bash@ interpreter.\nbashPath :: Action FilePath\nbashPath = lookupInPath \"bash\"\n\n-- | Fix an absolute path on Windows:\n-- * \"/c/\" => \"C:/\"\n-- * \"/usr/bin/tar.exe\" => \"C:/msys/usr/bin/tar.exe\"\nfixAbsolutePathOnWindows :: FilePath -> Action FilePath\nfixAbsolutePathOnWindows path =\n    if isWindows\n    then do\n        let (dir, file) = splitFileName path\n        winDir <- askOracle $ WindowsPath dir\n        return $ winDir -/- file\n    else\n        return path\n\nnewtype LookupInPath = LookupInPath String\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult LookupInPath = String\n\nnewtype WindowsPath = WindowsPath FilePath\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult WindowsPath = String\n\n-- | Oracles for looking up paths. These are slow and require caching.\npathOracle :: Rules ()\npathOracle = do\n    void $ addOracleCache $ \\(WindowsPath path) -> do\n        Stdout out <- quietly $ cmd [\"cygpath\", \"-m\", path]\n        let windowsPath = unifyPath $ dropWhileEnd isSpace out\n        putLoud $ \"| Windows path mapping: \" ++ path ++ \" => \" ++ windowsPath\n        return windowsPath\n\n    void $ addOracleCache $ \\(LookupInPath name) -> do\n        let unpack = fromMaybe . error $ \"Cannot find executable \" ++ quote name\n        path <- unifyPath . unpack <$> liftIO (findExecutable name)\n        putLoud $ \"| Executable found: \" ++ name ++ \" => \" ++ path\n        return path\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Oracles.TextFile\n-- Copyright  : (c) Andrey Mokhov 2014-2018\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- Read and parse text files, tracking their contents. This oracle can be used\n-- to read configuration or package metadata files and cache the parsing.\n-----------------------------------------------------------------------------\nmodule Hadrian.Oracles.TextFile (\n    lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues,\n    lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, textFileOracle\n    ) where\n\nimport Control.Monad\nimport qualified Data.HashMap.Strict as Map\nimport Data.Maybe\nimport Development.Shake\nimport Development.Shake.Classes\nimport Development.Shake.Config\n\nimport Hadrian.Utilities\n\n-- | Lookup a value in a text file, tracking the result. Each line of the file\n-- is expected to have @key = value@ format.\nlookupValue :: FilePath -> String -> Action (Maybe String)\nlookupValue file key = askOracle $ KeyValue (file, key)\n\n-- | Like 'lookupValue' but returns the empty string if the key is not found.\nlookupValueOrEmpty :: FilePath -> String -> Action String\nlookupValueOrEmpty file key = fromMaybe \"\" <$> lookupValue file key\n\n-- | Like 'lookupValue' but raises an error if the key is not found.\nlookupValueOrError :: FilePath -> String -> Action String\nlookupValueOrError file key = fromMaybe (error msg) <$> lookupValue file key\n  where\n    msg = \"Key \" ++ quote key ++ \" not found in file \" ++ quote file\n\n-- | Lookup a list of values in a text file, tracking the result. Each line of\n-- the file is expected to have @key value1 value2 ...@ format.\nlookupValues :: FilePath -> String -> Action (Maybe [String])\nlookupValues file key = askOracle $ KeyValues (file, key)\n\n-- | Like 'lookupValues' but returns the empty list if the key is not found.\nlookupValuesOrEmpty :: FilePath -> String -> Action [String]\nlookupValuesOrEmpty file key = fromMaybe [] <$> lookupValues file key\n\n-- | Like 'lookupValues' but raises an error if the key is not found.\nlookupValuesOrError :: FilePath -> String -> Action [String]\nlookupValuesOrError file key = fromMaybe (error msg) <$> lookupValues file key\n  where\n    msg = \"Key \" ++ quote key ++ \" not found in file \" ++ quote file\n\n-- | The 'Action' @lookupDependencies depFile file@ looks up dependencies of a\n-- @file@ in a (typically generated) dependency file @depFile@. The action\n-- returns a pair @(source, files)@, such that the @file@ can be produced by\n-- compiling @source@, which in turn also depends on a number of other @files@.\nlookupDependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])\nlookupDependencies depFile file = do\n    deps <- lookupValues depFile file\n    case deps of\n        Nothing -> error $ \"No dependencies found for file \" ++ quote file\n        Just [] -> error $ \"No source file found for file \" ++ quote file\n        Just (source : files) -> return (source, files)\n\nnewtype KeyValue = KeyValue (FilePath, String)\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult KeyValue = Maybe String\n\nnewtype KeyValues = KeyValues (FilePath, String)\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult KeyValues = Maybe [String]\n\n-- | These oracle rules are used to cache and track answers to the following\n-- queries, which are implemented by parsing text files:\n--\n-- 1) Looking up key-value pairs formatted as @key = value1 value2 ...@ that\n--    are often used in text configuration files. See functions 'lookupValue',\n--    'lookupValueOrEmpty', 'lookupValueOrError', 'lookupValues',\n--    'lookupValuesOrEmpty' and 'lookupValuesOrError'.\n--\n-- 2) Parsing Makefile dependecy files generated by commands like @gcc -MM@:\n--    see 'lookupDependencies'.\ntextFileOracle :: Rules ()\ntextFileOracle = do\n    kv <- newCache $ \\file -> do\n        need [file]\n        putLoud $ \"| KeyValue oracle: reading \" ++ quote file ++ \"...\"\n        liftIO $ readConfigFile file\n    void $ addOracleCache $ \\(KeyValue (file, key)) -> Map.lookup key <$> kv file\n\n    kvs <- newCache $ \\file -> do\n        need [file]\n        putLoud $ \"| KeyValues oracle: reading \" ++ quote file ++ \"...\"\n        contents <- map words <$> readFileLines file\n        return $ Map.fromList [ (key, values) | (key:values) <- contents ]\n    void $ addOracleCache $ \\(KeyValues (file, key)) -> Map.lookup key <$> kvs file\n", "num_lines": 101}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Oracles.Cabal.Rules\n-- Copyright  : (c) Andrey Mokhov 2014-2018\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- This module defines Shake rules corresponing to the /Cabal oracle/; see\n-- the module \"Hadrian.Oracles.Cabal\" for various supported queries.\n-----------------------------------------------------------------------------\nmodule Hadrian.Oracles.Cabal.Rules where\n\nimport Control.Monad\nimport Data.Maybe\nimport Development.Shake\nimport Distribution.Simple.GHC\nimport Distribution.Simple.Program.Db\nimport Distribution.Verbosity\n\nimport Builder\nimport Context\nimport Hadrian.Haskell.Cabal.Parse\nimport Hadrian.Oracles.Cabal.Type\nimport Hadrian.Package\nimport Hadrian.Utilities\n\n-- | These oracle rules are used to cache and track answers to the following\n-- queries, which are implemented via the Cabal library:\n--\n-- 1) 'Hadrian.Oracles.Cabal.readPackageData' that reads Cabal package data.\n--\n-- 2) 'Hadrian.Oracles.Cabal.readContextData' that reads 'Context'-dependent\n--    Cabal package data.\n--\n-- 3) 'Hadrian.Oracles.Cabal.configurePackageGHC' that configures a package.\ncabalOracle :: Rules ()\ncabalOracle = do\n    void $ addOracleCache $ \\(PackageDataKey package) -> do\n        let file = pkgCabalFile package\n        need [file]\n        putLoud $ \"| PackageData oracle: parsing \" ++ quote file ++ \"...\"\n        parsePackageData package\n\n    void $ addOracleCache $ \\(ContextDataKey context@Context {..}) -> do\n        putLoud $ \"| ContextData oracle: resolving data for \"\n               ++ quote (pkgName package) ++ \" (\" ++ show stage\n               ++ \", \" ++ show way ++ \")...\"\n        -- Calling 'need' on @setup-config@ triggers 'configurePackage'. Why\n        -- this indirection? Going via @setup-config@ allows us to cache the\n        -- configuration step, i.e. not to repeat it if it's already been done.\n        setupConfig <- pkgSetupConfigFile context\n        need [setupConfig]\n        resolveContextData context\n\n    void $ addOracleCache $ \\(PackageConfigurationKey (pkg, stage)) -> do\n        putLoud $ \"| PackageConfiguration oracle: configuring \"\n               ++ quote (pkgName pkg) ++ \" (\" ++ show stage ++ \")...\"\n        -- Configure the package with the GHC corresponding to the given stage\n        hcPath <- builderPath (Ghc CompileHs stage)\n        (compiler, maybePlatform, _pkgdb) <- liftIO $\n            configure silent (Just hcPath) Nothing emptyProgramDb\n        let platform = fromMaybe (error msg) maybePlatform\n            msg      = \"PackageConfiguration oracle: cannot detect platform\"\n        return $ PackageConfiguration (compiler, platform)\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module     : Hadrian.Oracles.Cabal.Type\n-- Copyright  : (c) Andrey Mokhov 2014-2018\n-- License    : MIT (see the file LICENSE)\n-- Maintainer : andrey.mokhov@gmail.com\n-- Stability  : experimental\n--\n-- This module defines the types of keys used by the /Cabal oracles/. See the\n-- module \"Hadrian.Oracles.Cabal\" for supported Cabal oracle queries, and the\n-- module \"Hadrian.Oracles.Cabal.Rules\" for the corresponing Shake rules.\n-----------------------------------------------------------------------------\nmodule Hadrian.Oracles.Cabal.Type where\n\nimport Development.Shake\nimport Development.Shake.Classes\nimport qualified Distribution.Simple as C\nimport qualified Distribution.System as C\n\nimport Context.Type\nimport Hadrian.Haskell.Cabal.Type\nimport Hadrian.Package\nimport Stage\n\n-- | This type of oracle key is used by 'Hadrian.Oracles.Cabal.readPackageData'\n-- to cache reading and parsing of 'Hadrian.Haskell.Cabal.Type.PackageData'.\nnewtype PackageDataKey = PackageDataKey Package\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult PackageDataKey = PackageData\n\n-- | This type of oracle key is used by 'Hadrian.Oracles.Cabal.readContextData'\n-- to cache reading and parsing of 'Hadrian.Haskell.Cabal.Type.ContextData'.\nnewtype ContextDataKey = ContextDataKey Context\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult ContextDataKey = ContextData\n\n-- TODO: Should @PackageConfiguration@ be simply @()@? Presumably the pair\n-- @(Compiler, Maybe Platform)@ is fully determined by the current build Stage.\n-- | The result of Cabal package configuration produced by the oracle\n-- 'Hadrian.Oracles.Cabal.configurePackageGHC'.\nnewtype PackageConfiguration = PackageConfiguration (C.Compiler, C.Platform)\n    deriving (Binary, Eq, Show, Typeable)\n\ninstance NFData PackageConfiguration where\n    rnf (PackageConfiguration (c, p)) =\n        rnf (C.compilerId c)                      `seq`\n        rnf (C.abiTagString $ C.compilerAbiTag c) `seq`\n        rnf (C.compilerCompat c)                  `seq`\n        rnf (C.compilerLanguages c)               `seq`\n        rnf (C.compilerExtensions c)              `seq`\n        rnf (C.compilerProperties c)              `seq`\n        rnf p\n\ninstance Hashable PackageConfiguration where\n    hashWithSalt _ = hash . show\n\n-- | This type of oracle key is used by 'Hadrian.Oracles.Cabal.configurePackageGHC'\n-- to cache configuration of a Cabal package.\nnewtype PackageConfigurationKey = PackageConfigurationKey (Package, Stage)\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult PackageConfigurationKey = PackageConfiguration\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Oracles.Flag (\n    Flag (..), flag, getFlag, platformSupportsSharedLibs, ghcWithSMP,\n    ghcWithNativeCodeGen\n    ) where\n\nimport Hadrian.Oracles.TextFile\nimport Hadrian.Expression\n\nimport Base\nimport Oracles.Setting\n\ndata Flag = ArSupportsAtFile\n          | CrossCompiling\n          | GccIsClang\n          | GhcUnregisterised\n          | GmpInTree\n          | GmpFrameworkPref\n          | LeadingUnderscore\n          | SolarisBrokenShld\n          | WithLibdw\n          | HaveLibMingwEx\n          | UseSystemFfi\n\n-- Note, if a flag is set to empty string we treat it as set to NO. This seems\n-- fragile, but some flags do behave like this, e.g. GccIsClang.\nflag :: Flag -> Action Bool\nflag f = do\n    let key = case f of\n            ArSupportsAtFile   -> \"ar-supports-at-file\"\n            CrossCompiling     -> \"cross-compiling\"\n            GccIsClang         -> \"gcc-is-clang\"\n            GhcUnregisterised  -> \"ghc-unregisterised\"\n            GmpInTree          -> \"intree-gmp\"\n            GmpFrameworkPref   -> \"gmp-framework-preferred\"\n            LeadingUnderscore  -> \"leading-underscore\"\n            SolarisBrokenShld  -> \"solaris-broken-shld\"\n            WithLibdw          -> \"with-libdw\"\n            HaveLibMingwEx     -> \"have-lib-mingw-ex\"\n            UseSystemFfi       -> \"use-system-ffi\"\n    value <- lookupValueOrError configFile key\n    when (value `notElem` [\"YES\", \"NO\", \"\"]) . error $ \"Configuration flag \"\n        ++ quote (key ++ \" = \" ++ value) ++ \" cannot be parsed.\"\n    return $ value == \"YES\"\n\n-- | Get a configuration setting.\ngetFlag :: Flag -> Expr c b Bool\ngetFlag = expr . flag\n\nplatformSupportsSharedLibs :: Action Bool\nplatformSupportsSharedLibs = do\n    badPlatform   <- anyTargetPlatform [ \"powerpc-unknown-linux\"\n                                       , \"x86_64-unknown-mingw32\"\n                                       , \"i386-unknown-mingw32\" ]\n    solaris       <- anyTargetPlatform [ \"i386-unknown-solaris2\" ]\n    solarisBroken <- flag SolarisBrokenShld\n    return $ not (badPlatform || solaris && solarisBroken)\n\nghcWithSMP :: Action Bool\nghcWithSMP = do\n    goodArch <- anyTargetArch [\"i386\", \"x86_64\", \"sparc\", \"powerpc\", \"arm\"]\n    ghcUnreg <- flag GhcUnregisterised\n    return $ goodArch && not ghcUnreg\n\nghcWithNativeCodeGen :: Action Bool\nghcWithNativeCodeGen = do\n    goodArch <- anyTargetArch [\"i386\", \"x86_64\", \"sparc\", \"powerpc\"]\n    badOs    <- anyTargetOs [\"ios\", \"aix\"]\n    ghcUnreg <- flag GhcUnregisterised\n    return $ goodArch && not badOs && not ghcUnreg\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Oracles.ModuleFiles (\n    decodeModule, encodeModule, findGenerator, hsSources, hsObjects,\n    moduleFilesOracle\n    ) where\n\nimport qualified Data.HashMap.Strict as Map\nimport Hadrian.Haskell.Cabal.Type as PD\n\nimport Base\nimport Builder\nimport Context\nimport Expression\nimport Packages\n\ntype ModuleName = String\n\nnewtype ModuleFiles = ModuleFiles (Stage, Package)\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult ModuleFiles = [Maybe FilePath]\n\nnewtype Generator = Generator (Stage, Package, FilePath)\n    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)\ntype instance RuleResult Generator = Maybe FilePath\n\n-- | We scan for the following Haskell source extensions when looking for module\n-- files. Note, we do not list \"*.(l)hs-boot\" files here, as they can never\n-- appear by themselves and always have accompanying \"*.(l)hs\" master files.\nhaskellExtensions :: [String]\nhaskellExtensions = [\".hs\", \".lhs\"]\n\n-- | Non-Haskell source extensions and corresponding builders.\notherExtensions :: Stage -> [(String, Builder)]\notherExtensions stage = [ (\".x\"  , Alex  )\n                        , (\".y\"  , Happy )\n                        , (\".ly\" , Happy )\n                        , (\".hsc\", Hsc2Hs stage) ]\n\n-- | We match the following file patterns when looking for module files.\nmoduleFilePatterns :: Stage -> [FilePattern]\nmoduleFilePatterns stage = map (\"*\" ++) $ haskellExtensions ++ map fst (otherExtensions stage)\n\n-- | Given a FilePath determine the corresponding builder.\ndetermineBuilder :: Stage -> FilePath -> Maybe Builder\ndetermineBuilder stage file = lookup (takeExtension file) (otherExtensions stage)\n\n-- | Given a non-empty module name extract the directory and file name, e.g.:\n--\n-- > decodeModule \"Data.Functor.Identity\" == (\"Data/Functor\", \"Identity\")\n-- > decodeModule \"Prelude\"               == (\"\", \"Prelude\")\ndecodeModule :: ModuleName -> (FilePath, String)\ndecodeModule moduleName = (intercalate \"/\" (init xs), last xs)\n  where\n    xs = words $ replaceEq '.' ' ' moduleName\n\n-- | Given the directory and file name find the corresponding module name, e.g.:\n--\n-- > encodeModule \"Data/Functor\" \"Identity.hs\" == \"Data.Functor.Identity\"\n-- > encodeModule \"\" \"Prelude\"                 == \"Prelude\"\n-- > uncurry encodeModule (decodeModule name)  == name\nencodeModule :: FilePath -> String -> ModuleName\nencodeModule dir file\n    | dir == \"\" =                                takeBaseName file\n    | otherwise = replaceEq '/' '.' dir ++ '.' : takeBaseName file\n\n-- | Find the generator for a given 'Context' and a source file. For example:\n-- findGenerator (Context Stage1 compiler vanilla)\n--               \"_build/stage1/compiler/build/Lexer.hs\"\n-- == Just (\"compiler/parser/Lexer.x\", Alex)\n-- findGenerator (Context Stage1 base vanilla)\n--               \"_build/stage1/base/build/Prelude.hs\"\n-- == Nothing\nfindGenerator :: Context -> FilePath -> Action (Maybe (FilePath, Builder))\nfindGenerator Context {..} file = do\n    maybeSource <- askOracle $ Generator (stage, package, file)\n    return $ do\n        source  <- maybeSource\n        builder <- determineBuilder stage source\n        return (source, builder)\n\n-- | Find all Haskell source files for a given 'Context'.\nhsSources :: Context -> Action [FilePath]\nhsSources context = do\n    let modFile (m, Nothing)\n            | \"Paths_\" `isPrefixOf` m = autogenFile context m\n            | otherwise               = generatedFile context m\n        modFile (m, Just file )\n            | takeExtension file `elem` haskellExtensions = return file\n            | otherwise = generatedFile context m\n    mapM modFile =<< contextFiles context\n\n-- | Find all Haskell object files for a given 'Context'. Note: this is a much\n-- simpler function compared to 'hsSources', because all object files live in\n-- the build directory regardless of whether they are generated or not.\nhsObjects :: Context -> Action [FilePath]\nhsObjects context = do\n    modules <- interpretInContext context (getContextData PD.modules)\n    mapM (objectPath context . moduleSource) modules\n\n-- | Generated module files live in the 'Context' specific build directory.\ngeneratedFile :: Context -> ModuleName -> Action FilePath\ngeneratedFile context moduleName = buildPath context <&> (-/- moduleSource moduleName)\n\n-- | Generated module files live in the 'Context' specific build directory.\nautogenFile :: Context -> ModuleName -> Action FilePath\nautogenFile context modName = autogenPath context <&> (-/- moduleSource modName)\n\n-- | Turn a module name (e.g. @Data.Functor@) to a path (e.g. @Data/Functor.hs@).\nmoduleSource :: ModuleName -> FilePath\nmoduleSource moduleName = replaceEq '.' '/' moduleName <.> \"hs\"\n\n-- | Module files for a given 'Context'.\ncontextFiles :: Context -> Action [(ModuleName, Maybe FilePath)]\ncontextFiles context@Context {..} = do\n    modules <- fmap sort . interpretInContext context $\n        getContextData PD.modules\n    zip modules <$> askOracle (ModuleFiles (stage, package))\n\n-- | This is an important oracle whose role is to find and cache module source\n-- files. It takes a 'Stage' and a 'Package', looks up corresponding source\n-- directories @dirs@ and a sorted list of module names @modules@, and for each\n-- module, e.g. @A.B.C@, returns a 'FilePath' of the form @dir/A/B/C.extension@,\n-- such that @dir@ belongs to @dirs@, and file @dir/A/B/C.extension@ exists, or\n-- 'Nothing' if there is no such file. If more than one matching file is found\n-- an error is raised. For example, for 'Stage1' and 'compiler', @dirs@ will\n-- contain [\"compiler/codeGen\", \"compiler/parser\"], and @modules@ will contain\n-- [\"CodeGen.Platform.ARM\", \"Config\", \"Lexer\"]; the oracle will produce a list\n-- containing [Just \"compiler/codeGen/CodeGen/Platform/ARM.hs\", Nothing,\n-- Just \"compiler/parser/Lexer.x\"]. The oracle ignores @.(l)hs-boot@ files.\nmoduleFilesOracle :: Rules ()\nmoduleFilesOracle = void $ do\n    void . addOracleCache $ \\(ModuleFiles (stage, package)) -> do\n        let context = vanillaContext stage package\n        ensureConfigured context\n        srcDirs <- interpretInContext context (getContextData PD.srcDirs)\n        mainIs  <- interpretInContext context (getContextData PD.mainIs)\n        let removeMain = case mainIs of\n                              Just (mod, _) -> delete mod\n                              Nothing       -> id\n        modules <- fmap sort $ interpretInContext context (getContextData PD.modules)\n        autogen <- autogenPath context\n        let dirs = autogen : map (pkgPath package -/-) srcDirs\n            -- Don't resolve the file path for module `Main` twice.\n            modDirFiles = groupSort $ map decodeModule $ removeMain modules\n        result <- concatForM dirs $ \\dir -> do\n            todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles\n            forM todo $ \\(mDir, mFiles) -> do\n                let fullDir = unifyPath $ dir -/- mDir\n                files <- getDirectoryFiles fullDir (moduleFilePatterns stage)\n                let cmp f = compare (dropExtension f)\n                    found = intersectOrd cmp files mFiles\n                return (map (fullDir -/-) found, mDir)\n\n        -- For a BuildInfo, it may be a library, which doesn't have the @Main@\n        -- module, or an executable, which must have the @Main@ module and the\n        -- file path of @Main@ module is indicated by the @main-is@ field in its\n        -- Cabal file.\n        --\n        -- For the Main module, the file name may not be @Main.hs@, unlike other\n        -- exposed modules. We could get the file path by the module name for\n        -- other exposed modules, but for @Main@ we must resolve the file path\n        -- via the @main-is@ field in the Cabal file.\n        mainpairs <- case mainIs of\n            Just (mod, filepath) ->\n                concatForM dirs $ \\dir -> do\n                    found <- doesFileExist (dir -/- filepath)\n                    return [(mod, unifyPath $ dir -/- filepath) | found]\n            Nothing -> return []\n\n        let pairs = sort $ mainpairs ++ [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]\n            multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ]\n        unless (null multi) $ do\n            let (m, f1, f2) = head multi\n            error $ \"Module \" ++ m ++ \" has more than one source file: \"\n                ++ f1 ++ \" and \" ++ f2 ++ \".\"\n        return $ lookupAll modules pairs\n\n    -- Optimisation: we discard Haskell files here, because they are never used\n    -- as generators, and hence would be discarded in 'findGenerator' anyway.\n    generators <- newCache $ \\(stage, package) -> do\n        let context = vanillaContext stage package\n        files <- contextFiles context\n        list  <- sequence [ (,src) <$> generatedFile context modName\n                          | (modName, Just src) <- files\n                          , takeExtension src `notElem` haskellExtensions ]\n        return $ Map.fromList list\n\n    addOracleCache $ \\(Generator (stage, package, file)) ->\n        Map.lookup file <$> generators (stage, package)\n", "num_lines": 190}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Oracles.Setting (\n    configFile, Setting (..), SettingList (..), setting, settingList, getSetting,\n    getSettingList,  anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,\n    ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,\n    ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost,\n    hostSupportsRPaths, topDirectory, libsuf\n    ) where\n\nimport Hadrian.Expression\nimport Hadrian.Oracles.TextFile\nimport Hadrian.Oracles.Path\n\nimport Base\n\n-- | Each 'Setting' comes from the file @hadrian/cfg/system.config@, generated\n-- by the @configure@ script from the input file @hadrian/cfg/system.config.in@.\n-- For example, the line\n--\n-- > target-os = mingw32\n--\n-- sets the value of the setting 'TargetOs'. The action 'setting' 'TargetOs'\n-- looks up the value of the setting and returns the string @\"mingw32\"@,\n-- tracking the result in the Shake database.\ndata Setting = BuildArch\n             | BuildOs\n             | BuildPlatform\n             | BuildVendor\n             | CcClangBackend\n             | CcLlvmBackend\n             | CursesLibDir\n             | DynamicExtension\n             | FfiIncludeDir\n             | FfiLibDir\n             | GhcMajorVersion\n             | GhcMinorVersion\n             | GhcPatchLevel\n             | GhcVersion\n             | GhcSourcePath\n             | GmpIncludeDir\n             | GmpLibDir\n             | HostArch\n             | HostOs\n             | HostPlatform\n             | HostVendor\n             | IconvIncludeDir\n             | IconvLibDir\n             | LlvmTarget\n             | ProjectGitCommitId\n             | ProjectName\n             | ProjectVersion\n             | ProjectVersionInt\n             | ProjectPatchLevel\n             | ProjectPatchLevel1\n             | ProjectPatchLevel2\n             | SystemGhc\n             | TargetArch\n             | TargetOs\n             | TargetPlatform\n             | TargetPlatformFull\n             | TargetVendor\n\n-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).\n-- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@,\n-- generated by the @configure@ script from the input file\n-- @hadrian/cfg/system.config.in@. For example, the line\n--\n-- > hs-cpp-args = -E -undef -traditional\n--\n-- sets the value of 'HsCppArgs'. The action 'settingList' 'HsCppArgs' looks up\n-- the value of the setting and returns the list of strings\n-- @[\"-E\", \"-undef\", \"-traditional\"]@, tracking the result in the Shake database.\ndata SettingList = ConfCcArgs Stage\n                 | ConfCppArgs Stage\n                 | ConfGccLinkerArgs Stage\n                 | ConfLdLinkerArgs Stage\n                 | HsCppArgs\n\n-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the\n-- result.\nsetting :: Setting -> Action String\nsetting key = lookupValueOrError configFile $ case key of\n    BuildArch          -> \"build-arch\"\n    BuildOs            -> \"build-os\"\n    BuildPlatform      -> \"build-platform\"\n    BuildVendor        -> \"build-vendor\"\n    CcClangBackend     -> \"cc-clang-backend\"\n    CcLlvmBackend      -> \"cc-llvm-backend\"\n    CursesLibDir       -> \"curses-lib-dir\"\n    DynamicExtension   -> \"dynamic-extension\"\n    FfiIncludeDir      -> \"ffi-include-dir\"\n    FfiLibDir          -> \"ffi-lib-dir\"\n    GhcMajorVersion    -> \"ghc-major-version\"\n    GhcMinorVersion    -> \"ghc-minor-version\"\n    GhcPatchLevel      -> \"ghc-patch-level\"\n    GhcVersion         -> \"ghc-version\"\n    GhcSourcePath      -> \"ghc-source-path\"\n    GmpIncludeDir      -> \"gmp-include-dir\"\n    GmpLibDir          -> \"gmp-lib-dir\"\n    HostArch           -> \"host-arch\"\n    HostOs             -> \"host-os\"\n    HostPlatform       -> \"host-platform\"\n    HostVendor         -> \"host-vendor\"\n    IconvIncludeDir    -> \"iconv-include-dir\"\n    IconvLibDir        -> \"iconv-lib-dir\"\n    LlvmTarget         -> \"llvm-target\"\n    ProjectGitCommitId -> \"project-git-commit-id\"\n    ProjectName        -> \"project-name\"\n    ProjectVersion     -> \"project-version\"\n    ProjectVersionInt  -> \"project-version-int\"\n    ProjectPatchLevel  -> \"project-patch-level\"\n    ProjectPatchLevel1 -> \"project-patch-level1\"\n    ProjectPatchLevel2 -> \"project-patch-level2\"\n    SystemGhc          -> \"system-ghc\"\n    TargetArch         -> \"target-arch\"\n    TargetOs           -> \"target-os\"\n    TargetPlatform     -> \"target-platform\"\n    TargetPlatformFull -> \"target-platform-full\"\n    TargetVendor       -> \"target-vendor\"\n\n-- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the\n-- result.\nsettingList :: SettingList -> Action [String]\nsettingList key = fmap words $ lookupValueOrError configFile $ case key of\n    ConfCcArgs        stage -> \"conf-cc-args-\"         ++ stageString stage\n    ConfCppArgs       stage -> \"conf-cpp-args-\"        ++ stageString stage\n    ConfGccLinkerArgs stage -> \"conf-gcc-linker-args-\" ++ stageString stage\n    ConfLdLinkerArgs  stage -> \"conf-ld-linker-args-\"  ++ stageString stage\n    HsCppArgs               -> \"hs-cpp-args\"\n\n-- | An expression that looks up the value of a 'Setting' in @cfg/system.config@,\n-- tracking the result.\ngetSetting :: Setting -> Expr c b String\ngetSetting = expr . setting\n\n-- | An expression that looks up the value of a 'SettingList' in\n-- @cfg/system.config@, tracking the result.\ngetSettingList :: SettingList -> Args c b\ngetSettingList = expr . settingList\n\n-- | Check whether the value of a 'Setting' matches one of the given strings.\nmatchSetting :: Setting -> [String] -> Action Bool\nmatchSetting key values = (`elem` values) <$> setting key\n\n-- | Check whether the target platform setting matches one of the given strings.\nanyTargetPlatform :: [String] -> Action Bool\nanyTargetPlatform = matchSetting TargetPlatformFull\n\n-- | Check whether the target OS setting matches one of the given strings.\nanyTargetOs :: [String] -> Action Bool\nanyTargetOs = matchSetting TargetOs\n\n-- | Check whether the target architecture setting matches one of the given\n-- strings.\nanyTargetArch :: [String] -> Action Bool\nanyTargetArch = matchSetting TargetArch\n\n-- | Check whether the host OS setting matches one of the given strings.\nanyHostOs :: [String] -> Action Bool\nanyHostOs = matchSetting HostOs\n\n-- | Check whether the host OS setting is set to @\"ios\"@.\niosHost :: Action Bool\niosHost = anyHostOs [\"ios\"]\n\n-- | Check whether the host OS setting is set to @\"darwin\"@.\nosxHost :: Action Bool\nosxHost = anyHostOs [\"darwin\"]\n\n-- | Check whether the host OS supports the @-rpath@ linker option when\n-- using dynamic linking.\n--\n-- TODO: Windows supports lazy binding (but GHC doesn't currently support\n--       dynamic way on Windows anyways).\nhostSupportsRPaths :: Action Bool\nhostSupportsRPaths = anyHostOs [\"linux\", \"darwin\", \"freebsd\"]\n\n-- | Check whether the host OS setting is set to @\"mingw32\"@ or @\"cygwin32\"@.\nwindowsHost :: Action Bool\nwindowsHost = anyHostOs [\"mingw32\", \"cygwin32\"]\n\n-- | Check whether the target supports GHCi.\nghcWithInterpreter :: Action Bool\nghcWithInterpreter = do\n    goodOs <- anyTargetOs [ \"mingw32\", \"cygwin32\", \"linux\", \"solaris2\"\n                          , \"freebsd\", \"dragonfly\", \"netbsd\", \"openbsd\"\n                          , \"darwin\", \"kfreebsdgnu\" ]\n    goodArch <- anyTargetArch [ \"i386\", \"x86_64\", \"powerpc\", \"sparc\"\n                              , \"sparc64\", \"arm\" ]\n    return $ goodOs && goodArch\n\n-- | Check whether the target architecture supports placing info tables next to\n-- code. See: https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects#TABLES_NEXT_TO_CODE.\nghcEnableTablesNextToCode :: Action Bool\nghcEnableTablesNextToCode = notM $ anyTargetArch [\"ia64\", \"powerpc64\", \"powerpc64le\"]\n\n-- | Check to use @libffi@ for adjustors.\nuseLibFFIForAdjustors :: Action Bool\nuseLibFFIForAdjustors = notM $ anyTargetArch [\"i386\", \"x86_64\"]\n\n-- | Canonicalised GHC version number, used for integer version comparisons. We\n-- expand 'GhcMinorVersion' to two digits by adding a leading zero if necessary.\nghcCanonVersion :: Action String\nghcCanonVersion = do\n    ghcMajorVersion <- setting GhcMajorVersion\n    ghcMinorVersion <- setting GhcMinorVersion\n    let leadingZero = [ '0' | length ghcMinorVersion == 1 ]\n    return $ ghcMajorVersion ++ leadingZero ++ ghcMinorVersion\n\n-- | Path to the GHC source tree.\ntopDirectory :: Action FilePath\ntopDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath\n\n-- | The file suffix used for libraries of a given build 'Way'. For example,\n-- @_p.a@ corresponds to a static profiled library, and @-ghc7.11.20141222.so@\n-- is a dynamic vanilly library. Why do we need GHC version number in the\n-- dynamic suffix? Here is a possible reason: dynamic libraries are placed in a\n-- single giant directory in the load path of the dynamic linker, and hence we\n-- must distinguish different versions of GHC. In contrast, static libraries\n-- live in their own per-package directory and hence do not need a unique\n-- filename. We also need to respect the system's dynamic extension, e.g. @.dll@\n-- or @.so@.\nlibsuf :: Way -> Action String\nlibsuf way\n    | not (wayUnit Dynamic way) = return (waySuffix way ++ \".a\") -- e.g., _p.a\n    | otherwise = do\n        extension <- setting DynamicExtension -- e.g., .dll or .so\n        version   <- setting ProjectVersion   -- e.g., 7.11.20141222\n        let suffix = waySuffix (removeWayUnit Dynamic way)\n        return (suffix ++ \"-ghc\" ++ version ++ extension)\n", "num_lines": 230}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | We create a file <root>/test/ghcconfig containing configuration of test\n-- | compiler. We need to search this file for required keys and setting\n-- | required for testsuite e.g. WORDSIZE, HOSTOS etc.\n\nmodule Oracles.TestSettings (TestSetting (..), testSetting, testRTSSettings) where\n\nimport Base\nimport Hadrian.Oracles.TextFile\n\ntestConfigFile :: Action FilePath\ntestConfigFile = buildRoot <&> (-/- \"test/ghcconfig\")\n\n-- | Test settings that are obtained from ghcconfig file.\ndata TestSetting = TestHostOS\n                 | TestWORDSIZE\n                 | TestTARGETPLATFORM\n                 | TestTargetOS_CPP\n                 | TestTargetARCH_CPP\n                 | TestGhcStage\n                 | TestGhcDebugged\n                 | TestGhcWithNativeCodeGen\n                 | TestGhcWithInterpreter\n                 | TestGhcUnregisterised\n                 | TestGhcWithSMP\n                 | TestGhcDynamicByDefault\n                 | TestGhcDynamic\n                 | TestGhcProfiled\n                 | TestAR\n                 | TestCLANG\n                 | TestLLC\n                 | TestTEST_CC\n                 | TestGhcPackageDbFlag\n                 | TestMinGhcVersion711\n                 | TestMinGhcVersion801\n                 deriving (Show)\n\n-- | Lookup a test setting in @ghcconfig@ file.\n-- | To obtain RTS ways supported in @ghcconfig@ file, use 'testRTSSettings'.\ntestSetting :: TestSetting -> Action String\ntestSetting key = do\n    file <- testConfigFile\n    lookupValueOrError file $ case key of\n        TestHostOS                -> \"HostOS\"\n        TestWORDSIZE              -> \"WORDSIZE\"\n        TestTARGETPLATFORM        -> \"TARGETPLATFORM\"\n        TestTargetOS_CPP          -> \"TargetOS_CPP\"\n        TestTargetARCH_CPP        -> \"TargetARCH_CPP\"\n        TestGhcStage              -> \"GhcStage\"\n        TestGhcDebugged           -> \"GhcDebugged\"\n        TestGhcWithNativeCodeGen  -> \"GhcWithNativeCodeGen\"\n        TestGhcWithInterpreter    -> \"GhcWithInterpreter\"\n        TestGhcUnregisterised     -> \"GhcUnregisterised\"\n        TestGhcWithSMP            -> \"GhcWithSMP\"\n        TestGhcDynamicByDefault   -> \"GhcDynamicByDefault\"\n        TestGhcDynamic            -> \"GhcDynamic\"\n        TestGhcProfiled           -> \"GhcProfiled\"\n        TestAR                    -> \"AR\"\n        TestCLANG                 -> \"CLANG\"\n        TestLLC                   -> \"LLC\"\n        TestTEST_CC               -> \"TEST_CC\"\n        TestGhcPackageDbFlag      -> \"GhcPackageDbFlag\"\n        TestMinGhcVersion711      -> \"MinGhcVersion711\"\n        TestMinGhcVersion801      -> \"MinGhcVersion801\"\n\n-- | Get the RTS ways of the test compiler\ntestRTSSettings :: Action [String]\ntestRTSSettings = do\n    file <- testConfigFile\n    words <$> lookupValueOrError file \"GhcRTSWays\"\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.BinaryDist where\n\nimport Hadrian.Haskell.Cabal\n\nimport Context\nimport Expression\nimport Oracles.Setting\nimport Packages\nimport Settings\nimport Target\nimport Utilities\n\n{-\nNote [Binary distributions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nHadrian produces binary distributions under:\n  <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>.tar.xz\n\nIt is generated by creating an archive from:\n  <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/\n\nIt does so by following the steps below.\n\n- make sure we have a complete stage 2 compiler + haddock\n\n- copy the bin and lib directories of the compiler we built:\n    <build root>/stage1/{bin, lib}\n  to\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/{bin, lib}\n\n- copy the generated docs (user guide, haddocks, etc):\n    <build root>/docs/\n  to\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/docs/\n\n- copy haddock (built by our stage2 compiler):\n    <build root>/stage2/bin/haddock\n  to\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/bin/haddock\n\n- use autoreconf to generate a `configure` script from\n  aclocal.m4 and distrib/configure.ac, that we move to:\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/configure\n\n- write a (fixed) Makefile capable of supporting 'make install' to:\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/Makefile\n\n- write some (fixed) supporting bash code for the wrapper scripts to:\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/wrappers/<program>\n\n  where <program> is the name of the executable that the bash file will\n  help wrapping.\n\n- copy supporting configure/make related files\n  (see @bindistInstallFiles@) to:\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/<file>\n\n- create a .tar.xz archive of the directory:\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>/\n  at\n    <build root>/bindist/ghc-<X>.<Y>.<Z>-<arch>-<os>.tar.xz\n\n\nNote [Wrapper scripts and binary distributions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nUsers of Linux, FreeBSD, Windows and OS X can unpack a\nbinary distribution produced by hadrian for their arch\nand OS and start using @bin/ghc@, @bin/ghc-pkg@ and so on\nright away, without even having to configure or install\nthe distribution. They would then be using the real executables\ndirectly, not through wrapper scripts.\n\nThis works because GHCs produced by hadrian on those systems\nare relocatable. This means that you can copy the @bin@ and @lib@\ndirs anywhere and GHC will keep working, as long as both\ndirectories sit next to each other. (This is achieved by having\nGHC look up its $libdir relatively to where the GHC executable\nresides.)\n\nIt is however still possible (and simple) to install a GHC\ndistribution that uses wrapper scripts. From the unpacked archive,\nyou can simply do:\n\n  ./configure --prefix=<path> [... other configure options ...]\n  make install\n\n-}\n\nbindistRules :: Rules ()\nbindistRules = do\n    root <- buildRootRules\n    phony \"binary-dist\" $ do\n        -- We 'need' all binaries and libraries\n        targets <- mapM pkgTarget =<< stagePackages Stage1\n        need targets\n\n        version        <- setting ProjectVersion\n        targetPlatform <- setting TargetPlatformFull\n        distDir        <- Context.distDir\n        rtsDir         <- pkgIdentifier rts\n        windows        <- windowsHost\n\n        let ghcBuildDir      = root -/- stageString Stage1\n            bindistFilesDir  = root -/- \"bindist\" -/- ghcVersionPretty\n            ghcVersionPretty = \"ghc-\" ++ version ++ \"-\" ++ targetPlatform\n            rtsIncludeDir    = ghcBuildDir -/- \"lib\" -/- distDir -/- rtsDir\n                               -/- \"include\"\n\n        -- We create the bindist directory at <root>/bindist/ghc-X.Y.Z-platform/\n        -- and populate it with Stage2 build results\n        createDirectory bindistFilesDir\n        copyDirectory (ghcBuildDir -/- \"bin\") bindistFilesDir\n        copyDirectory (ghcBuildDir -/- \"lib\") bindistFilesDir\n        copyDirectory (rtsIncludeDir)         bindistFilesDir\n        need [\"docs\"]\n        copyDirectory (root -/- \"docs\") bindistFilesDir\n        when windows $ do\n          copyDirectory (root -/- \"mingw\") bindistFilesDir\n          -- we use that opportunity to delete the .stamp file that we use\n          -- as a proxy for the whole mingw toolchain, there's no point in\n          -- shipping it\n          removeFile (bindistFilesDir -/- mingwStamp)\n\n        -- We copy the binary (<build root>/stage1/bin/haddock) to\n        -- the bindist's bindir (<build root>/bindist/ghc-.../bin/).\n        haddockPath <- programPath (vanillaContext Stage1 haddock)\n        copyFile haddockPath (bindistFilesDir -/- \"bin\" -/- \"haddock\")\n\n        -- We then 'need' all the files necessary to configure and install\n        -- (as in, './configure [...] && make install') this build on some\n        -- other machine.\n        need $ map (bindistFilesDir -/-)\n                   ([\"configure\", \"Makefile\"] ++ bindistInstallFiles)\n        need $ map ((bindistFilesDir -/- \"wrappers\") -/-) [\"check-api-annotations\"\n                   , \"check-ppr\", \"ghc\", \"ghc-iserv\", \"ghc-pkg\"\n                   , \"ghci-script\", \"ghci\", \"haddock\", \"hpc\", \"hp2ps\", \"hsc2hs\"\n                   , \"runghc\"]\n\n        -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz\n        tarPath <- builderPath (Tar Create)\n        cmd [Cwd $ root -/- \"bindist\"] tarPath\n            [ \"-c\", \"--xz\", \"-f\"\n            , ghcVersionPretty <.> \"tar.xz\"\n            , ghcVersionPretty ]\n\n    -- Prepare binary distribution configure script\n    -- (generated under <ghc root>/distrib/configure by 'autoreconf')\n    root -/- \"bindist\" -/- \"ghc-*\" -/- \"configure\" %> \\configurePath -> do\n        ghcRoot <- topDirectory\n        copyFile (ghcRoot -/- \"aclocal.m4\") (ghcRoot -/- \"distrib\" -/- \"aclocal.m4\")\n        buildWithCmdOptions [] $\n            target (vanillaContext Stage1 ghc) (Autoreconf $ ghcRoot -/- \"distrib\") [] []\n        -- We clean after ourselves, moving the configure script we generated in\n        -- our bindist dir\n        removeFile (ghcRoot -/- \"distrib\" -/- \"aclocal.m4\")\n        moveFile (ghcRoot -/- \"distrib\" -/- \"configure\") configurePath\n\n    -- Generate the Makefile that enables the \"make install\" part\n    root -/- \"bindist\" -/- \"ghc-*\" -/- \"Makefile\" %> \\makefilePath ->\n        writeFile' makefilePath bindistMakefile\n\n    root -/- \"bindist\" -/- \"ghc-*\" -/- \"wrappers/*\" %> \\wrapperPath ->\n        writeFile' wrapperPath $ wrapper (takeFileName wrapperPath)\n\n    -- Copy various configure-related files needed for a working\n    -- './configure [...] && make install' workflow\n    -- (see the list of files needed in the 'binary-dist' rule above, before\n    -- creating the archive).\n    forM_ bindistInstallFiles $ \\file ->\n        root -/- \"bindist\" -/- \"ghc-*\" -/- file %> \\dest -> do\n            ghcRoot <- topDirectory\n            copyFile (ghcRoot -/- fixup file) dest\n\n  where\n    fixup f | f `elem` [\"INSTALL\", \"README\"] = \"distrib\" -/- f\n            | otherwise                      = f\n\n-- | A list of files that allow us to support a simple\n-- @./configure [...] && make install@ workflow.\nbindistInstallFiles :: [FilePath]\nbindistInstallFiles =\n    [ \"config.sub\", \"config.guess\", \"install-sh\", \"mk\" -/- \"config.mk.in\"\n    , \"mk\" -/- \"install.mk.in\", \"mk\" -/- \"project.mk\", \"settings.in\", \"README\"\n    , \"INSTALL\" ]\n\n-- | This auxiliary function gives us a top-level 'Filepath' that we can 'need'\n-- for all libraries and programs that are needed for a complete build.\n-- For libraries, it returns the path to the @.conf@ file in the package\n-- database. For programs, it returns the path to the compiled executable.\npkgTarget :: Package -> Action FilePath\npkgTarget pkg\n    | isLibrary pkg = pkgConfFile (vanillaContext Stage1 pkg)\n    | otherwise     = programPath =<< programContext Stage1 pkg\n\n-- TODO: Augment this Makefile to match the various parameters that the current\n-- bindist scripts support.\n-- | A trivial Makefile that only takes @$prefix@ into account, and not e.g\n-- @$datadir@ (for docs) and other variables, yet.\nbindistMakefile :: String\nbindistMakefile = unlines\n    [ \"MAKEFLAGS += --no-builtin-rules\"\n    , \".SUFFIXES:\"\n    , \"\"\n    , \"include mk/install.mk\"\n    , \"include mk/config.mk\"\n    , \"\"\n    , \".PHONY: default\"\n    , \"default:\"\n    , \"\\t@echo 'Run \\\"make install\\\" to install'\"\n    , \"\\t@false\"\n    , \"\"\n    , \"#-----------------------------------------------------------------------\"\n    , \"# INSTALL RULES\"\n    , \"\"\n    , \"# Hacky function to check equality of two strings\"\n    , \"# TODO : find if a better function exists\"\n    , \"eq=$(and $(findstring $(1),$(2)),$(findstring $(2),$(1)))\"\n    , \"\"\n    , \"define installscript\"\n    , \"# $1 = package name\"\n    , \"# $2 = wrapper path\"\n    , \"# $3 = bindir\"\n    , \"# $4 = ghcbindir\"\n    , \"# $5 = Executable binary path\"\n    , \"# $6 = Library Directory\"\n    , \"# $7 = Docs Directory\"\n    , \"# $8 = Includes Directory\"\n    , \"# We are installing wrappers to programs by searching corresponding\"\n    , \"# wrappers. If wrapper is not found, we are attaching the common wrapper\"\n    , \"# to it. This implementation is a bit hacky and depends on consistency\"\n    , \"# of program names. For hadrian build this will work as programs have a\"\n    , \"# consistent naming procedure.\"\n    , \"\\trm -f '$2'\"\n    , \"\\t$(CREATE_SCRIPT) '$2'\"\n    , \"\\t@echo \\\"#!$(SHELL)\\\" >>  '$2'\"\n    , \"\\t@echo \\\"exedir=\\\\\\\"$4\\\\\\\"\\\" >> '$2'\"\n    , \"\\t@echo \\\"exeprog=\\\\\\\"$1\\\\\\\"\\\" >> '$2'\"\n    , \"\\t@echo \\\"executablename=\\\\\\\"$5\\\\\\\"\\\" >> '$2'\"\n    , \"\\t@echo \\\"bindir=\\\\\\\"$3\\\\\\\"\\\" >> '$2'\"\n    , \"\\t@echo \\\"libdir=\\\\\\\"$6\\\\\\\"\\\" >> '$2'\"\n    , \"\\t@echo \\\"docdir=\\\\\\\"$7\\\\\\\"\\\" >> '$2'\"\n    , \"\\t@echo \\\"includedir=\\\\\\\"$8\\\\\\\"\\\" >> '$2'\"\n    , \"\\t@echo \\\"\\\" >> '$2'\"\n    , \"\\tcat wrappers/$1 >> '$2'\"\n    , \"\\t$(EXECUTABLE_FILE) '$2' ;\"\n    , \"endef\"\n    , \"\"\n    , \"# Hacky function to patch up the 'haddock-interfaces' and 'haddock-html'\"\n    , \"# fields in the package .conf files\"\n    , \"define patchpackageconf\"\n    , \"# $1 = package name (ex: 'bytestring')\"\n    , \"# $2 = path to .conf file\"\n    , \"# $3 = Docs Directory\"\n    , \"\\tcat '$2' | sed 's|haddock-interfaces.*|haddock-interfaces: $3/html/libraries/$1/$1.haddock|' \\\\\"\n    , \"\\t         | sed 's|haddock-html.*|haddock-html: $3/html/libraries/$1|' \\\\\"\n    , \"\\t       > '$2.copy'\"\n    , \"\\tmv '$2.copy' '$2'\"\n    , \"endef\"\n    , \"\"\n    , \"# QUESTION : should we use shell commands?\"\n    , \"\"\n    , \"\"\n    , \".PHONY: install\"\n    , \"install: install_lib install_bin install_includes\"\n    , \"install: install_docs install_wrappers install_ghci\"\n    , \"install: install_mingw update_package_db\"\n    , \"\"\n    , \"ActualBinsDir=${ghclibdir}/bin\"\n    , \"WrapperBinsDir=${bindir}\"\n    , \"\"\n    , \"# We need to install binaries relative to libraries.\"\n    , \"BINARIES = $(wildcard ./bin/*)\"\n    , \"install_bin:\"\n    , \"\\t@echo \\\"Copying binaries to $(ActualBinsDir)\\\"\"\n    , \"\\t$(INSTALL_DIR) \\\"$(ActualBinsDir)\\\"\"\n    , \"\\tfor i in $(BINARIES); do \\\\\"\n    , \"\\t\\tcp -R $$i \\\"$(ActualBinsDir)\\\"; \\\\\"\n    , \"\\tdone\"\n    , \"\"\n    , \"install_ghci:\"\n    , \"\\t@echo \\\"Copying and installing ghci\\\"\"\n    , \"\\t$(CREATE_SCRIPT) '$(WrapperBinsDir)/ghci'\"\n    , \"\\t@echo \\\"#!$(SHELL)\\\" >>  '$(WrapperBinsDir)/ghci'\"\n    , \"\\tcat wrappers/ghci-script >> '$(WrapperBinsDir)/ghci'\"\n    , \"\\t$(EXECUTABLE_FILE) '$(WrapperBinsDir)/ghci'\"\n    , \"\"\n    , \"LIBRARIES = $(wildcard ./lib/*)\"\n    , \"install_lib:\"\n    , \"\\t@echo \\\"Copying libraries to $(libdir)\\\"\"\n    , \"\\t$(INSTALL_DIR) \\\"$(libdir)\\\"\"\n    , \"\\tfor i in $(LIBRARIES); do \\\\\"\n    , \"\\t\\tcp -R $$i \\\"$(libdir)/\\\"; \\\\\"\n    , \"\\tdone\"\n    , \"\"\n    , \"INCLUDES = $(wildcard ./include/*)\"\n    , \"install_includes:\"\n    , \"\\t@echo \\\"Copying libraries to $(includedir)\\\"\"\n    , \"\\t$(INSTALL_DIR) \\\"$(includedir)\\\"\"\n    , \"\\tfor i in $(INCLUDES); do \\\\\"\n    , \"\\t\\tcp -R $$i \\\"$(includedir)/\\\"; \\\\\"\n    , \"\\tdone\"\n    , \"\"\n    , \"DOCS = $(wildcard ./docs/*)\"\n    , \"install_docs:\"\n    , \"\\t@echo \\\"Copying libraries to $(docdir)\\\"\"\n    , \"\\t$(INSTALL_DIR) \\\"$(docdir)\\\"\"\n    , \"\\tfor i in $(DOCS); do \\\\\"\n    , \"\\t\\tcp -R $$i \\\"$(docdir)/\\\"; \\\\\"\n    , \"\\tdone\"\n    , \"\"\n    , \"BINARY_NAMES=$(shell ls ./wrappers/)\"\n    , \"install_wrappers:\"\n    , \"\\t@echo \\\"Installing Wrapper scripts\\\"\"\n    , \"\\t$(INSTALL_DIR) \\\"$(WrapperBinsDir)\\\"\"\n    , \"\\t$(foreach p, $(BINARY_NAMES),\\\\\"\n    , \"\\t\\t$(call installscript,$p,$(WrapperBinsDir)/$p,\" ++\n      \"$(WrapperBinsDir),$(ActualBinsDir),$(ActualBinsDir)/$p,\" ++\n      \"$(libdir),$(docdir),$(includedir)))\"\n    , \"\"\n    , \"PKG_CONFS = $(wildcard $(libdir)/package.conf.d/*)\"\n    , \"update_package_db:\"\n    , \"\\t@echo \\\"Updating the package DB\\\"\"\n    , \"\\t$(foreach p, $(PKG_CONFS),\\\\\"\n    , \"\\t\\t$(call patchpackageconf,\" ++\n      \"$(shell echo $(notdir $p) | sed 's/-\\\\([0-9]*[0-9]\\\\.\\\\)*conf//g'),\" ++\n      \"$p,$(docdir)))\"\n    , \"\\t'$(WrapperBinsDir)/ghc-pkg' recache\"\n    , \"\"\n    , \"# The 'foreach' that copies the mingw directory will only trigger a copy\"\n    , \"# when the wildcard matches, therefore only on Windows.\"\n    , \"MINGW = $(wildcard ./mingw)\"\n    , \"install_mingw:\"\n    , \"\\t@echo \\\"Installing MingGW\\\"\"\n    , \"\\t$(INSTALL_DIR) \\\"$(prefix)/mingw\\\"\"\n    , \"\\t$(foreach d, $(MINGW),\\\\\"\n    , \"\\t\\tcp -R ./mingw \\\"$(prefix)\\\")\"\n    , \"# END INSTALL\"\n    , \"# ----------------------------------------------------------------------\"\n    ]\n\nwrapper :: FilePath -> String\nwrapper \"ghc\"         = ghcWrapper\nwrapper \"ghc-pkg\"     = ghcPkgWrapper\nwrapper \"ghci\"        = ghciWrapper\nwrapper \"ghci-script\" = ghciScriptWrapper\nwrapper \"haddock\"     = haddockWrapper\nwrapper \"hsc2hs\"      = hsc2hsWrapper\nwrapper \"runghc\"      = runGhcWrapper\nwrapper _             = commonWrapper\n\n-- | Wrapper scripts for different programs. Common is default wrapper.\n\nghcWrapper :: String\nghcWrapper = \"exec \\\"$executablename\\\" -B\\\"$libdir\\\" ${1+\\\"$@\\\"}\\n\"\n\nghcPkgWrapper :: String\nghcPkgWrapper = unlines\n    [ \"PKGCONF=\\\"$libdir/package.conf.d\\\"\"\n    , \"exec \\\"$executablename\\\" --global-package-db \\\"$PKGCONF\\\" ${1+\\\"$@\\\"}\" ]\n\nghciWrapper :: String\nghciWrapper = \"exec \\\"$executablename\\\" --interactive \\\"$@\\\"\\n\"\n\nhaddockWrapper :: String\nhaddockWrapper = \"exec \\\"$executablename\\\" -B\\\"$libdir\\\" -l\\\"$libdir\\\" ${1+\\\"$@\\\"}\\n\"\n\ncommonWrapper :: String\ncommonWrapper = \"exec \\\"$executablename\\\" ${1+\\\"$@\\\"}\\n\"\n\nhsc2hsWrapper :: String\nhsc2hsWrapper = unlines\n    [ \"HSC2HS_EXTRA=\\\"--cflag=-fno-stack-protector --lflag=-fuse-ld=gold\\\"\"\n    , \"tflag=\\\"--template=$libdir/template-hsc.h\\\"\"\n    , \"Iflag=\\\"-I$includedir/\\\"\"\n    , \"for arg do\"\n    , \"    case \\\"$arg\\\" in\"\n    , \"# On OS X, we need to specify -m32 or -m64 in order to get gcc to\"\n    , \"# build binaries for the right target. We do that by putting it in\"\n    , \"# HSC2HS_EXTRA. When cabal runs hsc2hs, it passes a flag saying which\"\n    , \"# gcc to use, so if we set HSC2HS_EXTRA= then we don't get binaries\"\n    , \"# for the right platform. So for now we just don't set HSC2HS_EXTRA=\"\n    , \"# but we probably want to revisit how this works in the future.\"\n    , \"#        -c*)          HSC2HS_EXTRA=;;\"\n    , \"#        --cc=*)       HSC2HS_EXTRA=;;\"\n    , \"        -t*)          tflag=;;\"\n    , \"        --template=*) tflag=;;\"\n    , \"        --)           break;;\"\n    , \"    esac\"\n    , \"done\"\n    , \"exec \\\"$executablename\\\" ${tflag:+\\\"$tflag\\\"} $HSC2HS_EXTRA ${1+\\\"$@\\\"} \\\"$Iflag\\\"\" ]\n\nrunGhcWrapper :: String\nrunGhcWrapper = \"exec \\\"$executablename\\\" -f \\\"$exedir/ghc\\\" ${1+\\\"$@\\\"}\\n\"\n\n-- | We need to ship ghci executable, which basically just calls ghc with\n-- | --interactive flag.\nghciScriptWrapper :: String\nghciScriptWrapper = unlines\n    [ \"DIR=`dirname \\\"$0\\\"`\"\n    , \"executable=\\\"$DIR/ghc\\\"\"\n    , \"exec $executable --interactive \\\"$@\\\"\" ]\n\n-- | When not on Windows, we want to ship the 3 flavours of the iserv program\n--   in binary distributions. This isn't easily achievable by just asking for\n--   the package to be built, since here we're generating 3 different\n--   executables out of just one package, so we need to specify all 3 contexts\n--   explicitly and 'need' the result of building them.\nneedIservBins :: Action ()\nneedIservBins = do\n    windows <- windowsHost\n    when (not windows) $ do\n        rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays\n        need =<< traverse programPath\n                   [ Context Stage1 iserv w\n                   | w <- [vanilla, profiling, dynamic]\n                   , w `elem` rtsways\n                   ]\n", "num_lines": 420}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Clean (clean, cleanSourceTree, cleanRules) where\n\nimport qualified System.Directory as IO\nimport Base\n\nclean :: Action ()\nclean = do\n    putBuild \"| Removing Hadrian files...\"\n    cleanSourceTree\n    path <- buildRoot\n    putBuild $ \"| Remove directory \" ++ path ++ \" (after build completes)\"\n    runAfter $ IO.removeDirectoryRecursive path -- since we can't delete the Shake database while Shake is running\n    putSuccess \"| Done. \"\n\ncleanSourceTree :: Action ()\ncleanSourceTree = do\n    path <- buildRoot\n    forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString\n    removeDirectory \"sdistprep\"\n    cleanFsUtils\n\n-- Clean all temporary fs files copied by configure into the source folder\ncleanFsUtils :: Action ()\ncleanFsUtils = do\n    let dirs = [ \"utils/lndir/\"\n               , \"utils/unlit/\"\n               , \"rts/\"\n               , \"libraries/base/include/\"\n               , \"libraries/base/cbits/\"\n               ]\n    liftIO $ forM_ dirs (flip removeFiles [\"fs.*\"])\n\ncleanRules :: Rules ()\ncleanRules = \"clean\" ~> clean\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Compile (compilePackage) where\n\nimport Hadrian.BuildPath\nimport Hadrian.Oracles.TextFile\n\nimport Base\nimport Context\nimport Expression\nimport Rules.Generate\nimport Settings\nimport Target\nimport Utilities\n\nimport qualified Text.Parsec as Parsec\n\n-- * Rules for building objects and Haskell interface files\n\ncompilePackage :: [(Resource, Int)] -> Rules ()\ncompilePackage rs = do\n    root <- buildRootRules\n    -- We match all file paths that look like:\n    --   <root>/...stuffs.../build/...stuffs.../<something>.<suffix>\n    --\n    -- where:\n    --   - the '...stuffs...' bits can be one or more path components,\n    --   - the '<suffix>' part is a way prefix (e.g thr_p_, or nothing if\n    --     vanilla) followed by an object file extension, without the dot\n    --     (o, o-boot, hi, hi-boot),\n    --\n    -- and parse the information we need (stage, package path, ...) from\n    -- the path and figure out the suitable way to produce that object file.\n    objectFilesUnder root |%> \\path -> do\n        obj <- parsePath (parseBuildObject root) \"<object file path parser>\" path\n        compileObject rs path obj\n  where\n    objectFilesUnder r = [ r -/- (\"**/build/**/*\" ++ pat)\n                         | pat <- extensionPats ]\n\n    exts = [ \"o\", \"hi\", \"o-boot\", \"hi-boot\" ]\n    patternsFor e = [ \".\" ++ e, \".*_\" ++ e ]\n    extensionPats = concatMap patternsFor exts\n\n-- * Object file paths types and parsers\n\n{- We are using a non uniform representation that separates\n   object files produced from Haskell code and from other\n   languages, because the two \"groups\" have to be parsed\n   differently enough that this would complicated the parser\n   significantly.\n\n   Indeed, non-Haskell files can only produce .o (or .thr_o, ...)\n   files while Haskell modules can produce those as well as\n   interface files, both in -boot or non-boot variants.\n\n   Moreover, non-Haskell object files live under:\n     <root>/stage<N>/<path/to/pkg>/build/{c,cmm,s}/\n\n   while Haskell object/interface files live under:\n     <root>/stage<N>/<path/to/pkg>/build/\n\n   So the kind of object is partially determined by\n   whether we're in c/, cmm/ or s/ but also by the\n   object file's extension, in the case of a Haskell file.\n   This could have been addressed with some knot-tying but\n   Parsec's monad doesn't give us a MonadFix instance.\n\n   We therefore stick to treating those two type of object\n   files non uniformly.\n-}\n\n-- | Non Haskell source languages that we compile to get object files.\ndata SourceLang = Asm | C | Cmm deriving (Eq, Show)\n\nparseSourceLang :: Parsec.Parsec String () SourceLang\nparseSourceLang = Parsec.choice\n  [ Parsec.char 'c' *> Parsec.choice\n      [ Parsec.string \"mm\" *> pure Cmm\n      , pure C\n      ]\n  , Parsec.char 's' *> pure Asm\n  ]\n\ntype Basename = String\n\nparseBasename :: Parsec.Parsec String () Basename\nparseBasename = Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.char '.')\n\n-- | > <c|cmm|s>/<file>.<way prefix>_o\ndata NonHsObject = NonHsObject SourceLang Basename Way\n  deriving (Eq, Show)\n\nparseNonHsObject :: Parsec.Parsec String () NonHsObject\nparseNonHsObject = do\n    lang <- parseSourceLang\n    _ <- Parsec.char '/'\n    file <- parseBasename\n    way <- parseWayPrefix vanilla\n    _ <- Parsec.char 'o'\n    return (NonHsObject lang file way)\n\n-- | > <o|hi|o-boot|hi-boot>\ndata SuffixType = O | Hi | OBoot | HiBoot deriving (Eq, Show)\n\nparseSuffixType :: Parsec.Parsec String () SuffixType\nparseSuffixType = Parsec.choice\n  [ Parsec.char 'o' *> Parsec.choice\n      [ Parsec.string \"-boot\" *> pure OBoot\n      , pure O\n      ]\n  , Parsec.string \"hi\" *> Parsec.choice\n      [ Parsec.string \"-boot\" *> pure HiBoot\n      , pure Hi\n      ]\n  ]\n\n-- | > <way prefix>_<o|hi|o-boot|hi-boot>\ndata Extension = Extension Way SuffixType deriving (Eq, Show)\n\nparseExtension :: Parsec.Parsec String () Extension\nparseExtension = Extension <$> parseWayPrefix vanilla <*> parseSuffixType\n\n-- | > <file>.<way prefix>_<o|hi|o-boot|hi-boot>\ndata HsObject = HsObject Basename Extension deriving (Eq, Show)\n\nparseHsObject :: Parsec.Parsec String () HsObject\nparseHsObject = do\n    file <- parseBasename\n    ext <- parseExtension\n    return (HsObject file ext)\n\ndata Object = Hs HsObject | NonHs NonHsObject deriving (Eq, Show)\n\nparseObject :: Parsec.Parsec String () Object\nparseObject = Parsec.choice\n    [ NonHs <$> parseNonHsObject\n    , Hs    <$> parseHsObject ]\n\n-- * Toplevel parsers\n\nparseBuildObject :: FilePath -> Parsec.Parsec String () (BuildPath Object)\nparseBuildObject root = parseBuildPath root parseObject\n\n-- * Getting contexts from objects\n\nobjectContext :: BuildPath Object -> Context\nobjectContext (BuildPath _ stage pkgPath obj) =\n    Context stage (unsafeFindPackageByPath pkgPath) way\n  where\n    way = case obj of\n        NonHs (NonHsObject _lang _file w)         -> w\n        Hs    (HsObject _file (Extension w _suf)) -> w\n\n-- * Building an object\n\ncompileHsObject\n    :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action ()\ncompileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj =\n  case hsobj of\n    HsObject _basename (Extension way Hi    ) -> need [objpath -<.> osuf     way]\n    HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way]\n    HsObject _basename (Extension way suf) -> do\n        let ctx = objectContext b\n        ctxPath <- contextPath ctx\n        (src, deps) <- lookupDependencies (ctxPath -/- \".dependencies\") objpath\n        need (src:deps)\n        needLibrary =<< contextDependencies ctx\n        buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]\n        -- Andrey: It appears that the previous refactoring has broken\n        -- multiple-output build rules. Ideally, we should bring multiple-output\n        -- rules back, see: https://github.com/snowleopard/hadrian/issues/216.\n        -- As a temporary solution, I'm using Shake's new 'produces' feature to\n        -- record that this rule also produces a corresponding interface file.\n        let hi | suf == O     = objpath -<.> hisuf     way\n               | suf == OBoot = objpath -<.> hibootsuf way\n               | otherwise    = error \"Internal error: unknown Haskell object extension\"\n        produces [hi]\n\ncompileNonHsObject\n  :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject\n  -> Action ()\ncompileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj =\n  case nonhsobj of\n    NonHsObject lang _basename _way ->\n      go (builderFor lang) (toSrcFor lang)\n\n  where builderFor C = Ghc CompileCWithGhc\n        builderFor _ = Ghc CompileHs\n\n        toSrcFor Asm = obj2src \"S\"   (const False)\n        toSrcFor C   = obj2src \"c\"   (const False)\n        toSrcFor Cmm = obj2src \"cmm\" isGeneratedCmmFile\n\n        go builder tosrc = do\n            let ctx = objectContext b\n            src <- tosrc ctx objpath\n            need [src]\n            needDependencies ctx src (objpath <.> \"d\")\n            buildWithResources rs $ target ctx (builder stage) [src] [objpath]\n\ncompileObject\n  :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action ()\ncompileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) =\n  compileHsObject rs objpath b o\ncompileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) =\n  compileNonHsObject rs objpath b o\n\n-- * Helpers\n\n-- | Discover dependencies of a given source file by iteratively calling @gcc@\n-- in the @-MM -MG@ mode and building generated dependencies if they are missing\n-- until reaching a fixed point.\nneedDependencies :: Context -> FilePath -> FilePath -> Action ()\nneedDependencies context@Context {..} src depFile = discover\n  where\n    discover = do\n        build $ target context (Cc FindCDependencies stage) [src] [depFile]\n        deps <- parseFile depFile\n        -- Generated dependencies, if not yet built, will not be found and hence\n        -- will be referred to simply by their file names.\n        let notFound = filter (\\file -> file == takeFileName file) deps\n        -- We find the full paths to generated dependencies, so we can request\n        -- to build them by calling 'need'.\n        todo <- catMaybes <$> mapM (fullPathIfGenerated context) notFound\n\n        if null todo\n        then need deps -- The list of dependencies is final, need all\n        else do\n            need todo  -- Build newly discovered generated dependencies\n            discover   -- Continue the discovery process\n\n    parseFile :: FilePath -> Action [String]\n    parseFile file = do\n        input <- liftIO $ readFile file\n        case parseMakefile input of\n            [(_file, deps)] -> return deps\n            _               -> return []\n\n-- | Find a given 'FilePath' in the list of generated files in the given\n-- 'Context' and return its full path.\nfullPathIfGenerated :: Context -> FilePath -> Action (Maybe FilePath)\nfullPathIfGenerated context file = interpretInContext context $ do\n    generated <- generatedDependencies\n    return $ find ((== file) . takeFileName) generated\n\nobj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> Action FilePath\nobj2src extension isGenerated context@Context {..} obj\n    | isGenerated src = return src\n    | otherwise       = (pkgPath package ++) <$> suffix\n  where\n    src    = obj -<.> extension\n    suffix = do\n        path <- buildPath context\n        return $ fromMaybe (\"Cannot determine source for \" ++ obj)\n               $ stripPrefix (path -/- extension) src\n", "num_lines": 255}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Configure (configureRules) where\n\nimport Base\nimport Builder\nimport CommandLine\nimport Context\nimport Packages\nimport Target\nimport Utilities\n\nimport qualified System.Info.Extra as System\n\n-- TODO: Make this list complete.\n-- | Files generated by running the @configure@ script.\nconfigureResults :: [FilePath]\nconfigureResults =\n    [ configFile, \"settings\", configH, \"compiler/ghc.cabal\", \"rts/rts.cabal\"]\n\nconfigureRules :: Rules ()\nconfigureRules = do\n    configureResults &%> \\outs -> do\n        skip <- not <$> cmdConfigure\n        if skip\n        then unlessM (doesFileExist configFile) $\n            error $ \"Configuration file \" ++ configFile ++ \" is missing.\\n\"\n                ++ \"Run the configure script manually or let Hadrian run it \"\n                ++ \"automatically by passing the flag --configure.\"\n        else do\n            -- We cannot use windowsHost here due to a cyclic dependency.\n            when System.isWindows $ do\n                putBuild \"| Checking for Windows tarballs...\"\n                quietly $ cmd [\"bash\", \"mk/get-win32-tarballs.sh\", \"download\", System.arch]\n            let srcs    = map (<.> \"in\") outs\n                context = vanillaContext Stage0 compiler\n            need srcs\n            build $ target context (Configure \".\") srcs outs\n            -- TODO: This is fragile: we should remove this from behind the\n            -- @--configure@ flag and add a proper dependency tracking.\n            -- We need to copy the directory with unpacked Windows tarball to\n            -- the build directory, so that the built GHC has access to it.\n            -- See https://github.com/snowleopard/hadrian/issues/564.\n            when System.isWindows $ do\n                root <- buildRoot\n                copyDirectory \"inplace/mingw\" (root -/- \"mingw\")\n                mingwFiles <- liftIO $ getDirectoryFilesIO \".\" [root -/- \"mingw/**\"]\n                produces mingwFiles\n\n    [\"configure\", configH <.> \"in\"] &%> \\_ -> do\n        skip <- not <$> cmdConfigure\n        if skip\n        then unlessM (doesFileExist \"configure\") $\n            error $ \"The configure script is missing.\\nRun the boot script \"\n                ++ \"manually let Hadrian run it automatically by passing the \"\n                ++ \"flag --configure.\"\n        else do\n            need [\"configure.ac\"]\n            putBuild \"| Running boot...\"\n            verbosity <- getVerbosity\n            quietly $ cmd [EchoStdout (verbosity >= Loud)] \"python3 boot --hadrian\"\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Dependencies (buildPackageDependencies) where\n\nimport Data.Bifunctor\nimport Data.Function\n\nimport Base\nimport Context\nimport Expression\nimport Hadrian.BuildPath\nimport Oracles.ModuleFiles\nimport Rules.Generate\nimport Settings\nimport Target\nimport Utilities\n\nimport qualified Text.Parsec as Parsec\n\nbuildPackageDependencies :: [(Resource, Int)] -> Rules ()\nbuildPackageDependencies rs = do\n    root <- buildRootRules\n    root -/- \"**/.dependencies.mk\" %> \\mk -> do\n        DepMkFile stage pkgpath <- getDepMkFile root mk\n        let context = Context stage (unsafeFindPackageByPath pkgpath) vanilla\n        srcs <- hsSources context\n        gens <- interpretInContext context generatedDependencies\n        need (srcs ++ gens)\n        if null srcs\n        then writeFileChanged mk \"\"\n        else buildWithResources rs $ target context\n            (Ghc FindHsDependencies $ Context.stage context) srcs [mk]\n        removeFile $ mk <.> \"bak\"\n\n    root -/- \"**/.dependencies\" %> \\deps -> do\n        mkDeps <- readFile' (deps <.> \"mk\")\n        writeFileChanged deps . unlines\n                              . map (\\(src, deps) -> unwords $ src : deps)\n                              . map (bimap unifyPath (map unifyPath))\n                              . map (bimap head concat . unzip)\n                              . groupBy ((==) `on` fst)\n                              . sortBy (compare `on` fst)\n                              $ parseMakefile mkDeps\n\n\ndata DepMkFile = DepMkFile Stage FilePath deriving (Eq, Show)\n\nparseDepMkFile :: FilePath -> Parsec.Parsec String () DepMkFile\nparseDepMkFile root = do\n    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')\n    stage <- parseStage\n    _ <- Parsec.char '/'\n    pkgPath <- Parsec.manyTill Parsec.anyChar\n        (Parsec.try $ Parsec.string \"/.dependencies.mk\")\n    return (DepMkFile stage pkgPath)\n\ngetDepMkFile :: FilePath -> FilePath -> Action DepMkFile\ngetDepMkFile root = parsePath (parseDepMkFile root) \"<dependencies file>\"\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Documentation (\n    -- * Rules\n    buildPackageDocumentation, documentationRules,\n\n    -- * Utilities\n    haddockDependencies\n    ) where\n\nimport Hadrian.BuildPath\nimport Hadrian.Haskell.Cabal\nimport Hadrian.Haskell.Cabal.Type\n\nimport Rules.Generate (ghcPrimDependencies)\nimport Base\nimport Context\nimport Expression (getContextData, interpretInContext, (?), package)\nimport Flavour\nimport Oracles.ModuleFiles\nimport Packages\nimport Settings\nimport Target\nimport Utilities\n\nimport Data.List (union)\nimport qualified Data.Set    as Set\nimport qualified Text.Parsec as Parsec\n\ndocRoot :: FilePath\ndocRoot = \"docs\"\n\nhtmlRoot :: FilePath\nhtmlRoot = docRoot -/- \"html\"\n\npdfRoot :: FilePath\npdfRoot = docRoot -/- \"pdfs\"\n\narchiveRoot :: FilePath\narchiveRoot = docRoot -/- \"archives\"\n\nmanPageBuildPath :: FilePath\nmanPageBuildPath = \"docs/users_guide/build-man/ghc.1\"\n\n-- TODO: Get rid of this hack.\ndocContext :: Context\ndocContext = vanillaContext Stage2 (library \"Documentation\" \"docs\")\n\ndocPaths :: [FilePath]\ndocPaths = [\"libraries\", \"users_guide\", \"Haddock\"]\n\npathPdf :: FilePath -> FilePath\npathPdf path = pdfRoot -/- path <.> \".pdf\"\n\npathIndex :: FilePath -> FilePath\npathIndex path = htmlRoot -/- path -/- \"index.html\"\n\npathArchive :: FilePath -> FilePath\npathArchive path = archiveRoot -/- path <.> \"html.tar.xz\"\n\n-- TODO: Get rid of this hack.\npathPath :: FilePath -> FilePath\npathPath \"users_guide\" = \"docs/users_guide\"\npathPath \"Haddock\" = \"utils/haddock/doc\"\npathPath _ = \"\"\n\n-- | Build all documentation\ndocumentationRules :: Rules ()\ndocumentationRules = do\n    buildDocumentationArchives\n    buildHtmlDocumentation\n    buildManPage\n    buildPdfDocumentation\n\n    -- a phony rule that runs Haddock for \"Haskell Hierarchical Libraries\" and\n    -- the \"GHC-API\"\n    \"docs-haddock\" ~> do\n        root <- buildRoot\n        need [ root -/- pathIndex \"libraries\" ]\n\n    -- a phony rule that runs Haddock, builds the User's guide, builds\n    -- Haddock's manual, and builds man pages\n    \"docs\" ~> do\n        root <- buildRoot\n        doctargets <- ghcDocs =<< flavour\n        let html     = htmlRoot -/- \"index.html\" -- also implies \"docs-haddock\"\n            archives = map pathArchive docPaths\n            pdfs     = map pathPdf $ docPaths \\\\ [\"libraries\"]\n\n            targets = -- include PDFs unless --docs=no-sphinx[-pdf] is\n                      -- passed.\n                      concat [ pdfs | SphinxPDFs `Set.member` doctargets ]\n\n                      -- include manpage unless --docs=no-sphinx[-man] is given.\n                   ++ [ manPageBuildPath | SphinxMan `Set.member` doctargets ]\n\n                      -- include toplevel html target uness we neither want\n                      -- haddocks nor html pages produced by sphinx.\n                   ++ [ html | Set.size (doctargets `Set.intersection`\n                                         Set.fromList [Haddocks, SphinxHTML]\n                                        ) > 0 ]\n\n                      -- include archives for whatever targets remain from\n                      -- the --docs arguments we got.\n                   ++ [ ar\n                      | (ar, doc) <- zip archives docPaths\n                      , archiveTarget doc `Set.member` doctargets ]\n\n        need $ map (root -/-) targets\n\n    where archiveTarget \"libraries\"   = Haddocks\n          archiveTarget _             = SphinxHTML\n\n\n------------------------------------- HTML -------------------------------------\n\n-- | Build rules for HTML documentation.\nbuildHtmlDocumentation :: Rules ()\nbuildHtmlDocumentation = do\n    mapM_ buildSphinxHtml $ docPaths \\\\ [\"libraries\"]\n    buildLibraryDocumentation\n    root <- buildRootRules\n\n    root -/- htmlRoot -/- \"index.html\" %> \\file -> do\n        doctargets <- ghcDocs =<< flavour\n\n        -- We include the HTML output of haddock for libraries unless\n        -- told not to (e.g with --docs=no-haddocks). Likewise for\n        -- the HTML version of the users guide or the Haddock manual.\n        let targets = [ \"libraries\" | Haddocks `Set.member` doctargets ]\n                   ++ concat [ [\"users_guide\", \"Haddock\"]\n                             | SphinxHTML `Set.member` doctargets ]\n        need $ map ((root -/-) . pathIndex) targets\n\n        copyFileUntracked \"docs/index.html\" file\n\n-- | Compile a Sphinx ReStructured Text package to HTML.\nbuildSphinxHtml :: FilePath -> Rules ()\nbuildSphinxHtml path = do\n    root <- buildRootRules\n    root -/- htmlRoot -/- path -/- \"index.html\" %> \\file -> do\n        let dest = takeDirectory file\n        build $ target docContext (Sphinx Html) [pathPath path] [dest]\n\n------------------------------------ Haddock -----------------------------------\n\n-- | Build the haddocks for GHC's libraries.\nbuildLibraryDocumentation :: Rules ()\nbuildLibraryDocumentation = do\n    root <- buildRootRules\n\n    -- Building the \"Haskell Hierarchical Libraries\" index\n    root -/- htmlRoot -/- \"libraries/index.html\" %> \\file -> do\n        need [ \"libraries/prologue.txt\" ]\n\n        -- We want Haddocks for everything except `rts` to be built, but we\n        -- don't want the index to be polluted by stuff from `ghc`-the-library\n        -- (there will be a separate top-level link to those Haddocks).\n        haddocks <- allHaddocks\n        let neededDocs = filter (\\x -> takeFileName x /= \"rts.haddock\") haddocks\n            libDocs = filter (\\x -> takeFileName x /= \"ghc.haddock\") neededDocs\n\n        need neededDocs\n        build $ target docContext (Haddock BuildIndex) libDocs [file]\n\nallHaddocks :: Action [FilePath]\nallHaddocks = do\n    pkgs <- stagePackages Stage1\n    sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg\n             | pkg <- pkgs, isLibrary pkg, pkgName pkg /= \"rts\" ]\n\n-- Note: this build rule creates plenty of files, not just the .haddock one.\n-- All of them go into the 'docRoot' subdirectory. Pedantically tracking all\n-- built files in the Shake database seems fragile and unnecessary.\nbuildPackageDocumentation :: Rules ()\nbuildPackageDocumentation = do\n    root <- buildRootRules\n\n    -- Per-package haddocks\n    root -/- htmlRoot -/- \"libraries/*/haddock-prologue.txt\" %> \\file -> do\n        ctx <- pkgDocContext <$> getPkgDocTarget root file\n        -- This is how @ghc-cabal@ used to produces \"haddock-prologue.txt\" files.\n        syn  <- pkgSynopsis    (Context.package ctx)\n        desc <- pkgDescription (Context.package ctx)\n        let prologue = if null desc then syn else desc\n        liftIO $ writeFile file prologue\n\n    root -/- htmlRoot -/- \"libraries/*/*.haddock\" %> \\file -> do\n        context <- pkgDocContext <$> getPkgDocTarget root file\n        need [ takeDirectory file  -/- \"haddock-prologue.txt\"]\n        haddocks <- haddockDependencies context\n\n        -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just\n        -- for Haddock. We need to 'union' (instead of '++') to avoid passing\n        -- 'GHC.PrimopWrappers' (which unfortunately shows up in both\n        -- `generatedSrcs` and `vanillaSrcs`) to Haddock twice.\n        generatedSrcs <- interpretInContext context (Expression.package ghcPrim ? ghcPrimDependencies)\n        vanillaSrcs <- hsSources context\n        let srcs = vanillaSrcs `union` generatedSrcs\n\n        need $ srcs ++ haddocks\n\n        -- Build Haddock documentation\n        -- TODO: Pass the correct way from Rules via Context.\n        dynamicPrograms <- dynamicGhcPrograms =<< flavour\n        let haddockWay = if dynamicPrograms then dynamic else vanilla\n        build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file]\n\ndata PkgDocTarget = DotHaddock PackageName | HaddockPrologue PackageName\n  deriving (Eq, Show)\n\npkgDocContext :: PkgDocTarget -> Context\npkgDocContext target = Context Stage1 (unsafeFindPackageByName name) vanilla\n  where\n    name = case target of DotHaddock n      -> n\n                          HaddockPrologue n -> n\n\nparsePkgDocTarget :: FilePath -> Parsec.Parsec String () PkgDocTarget\nparsePkgDocTarget root = do\n  _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')\n  _ <- Parsec.string (htmlRoot ++ \"/\")\n  _ <- Parsec.string \"libraries/\"\n  pkgname <- Parsec.manyTill Parsec.anyChar (Parsec.char '/')\n  Parsec.choice\n    [ Parsec.try (Parsec.string \"haddock-prologue.txt\")\n        *> pure (HaddockPrologue pkgname)\n    , Parsec.string (pkgname <.> \"haddock\")\n        *> pure (DotHaddock pkgname)\n    ]\n\ngetPkgDocTarget :: FilePath -> FilePath -> Action PkgDocTarget\ngetPkgDocTarget root path =\n  parsePath (parsePkgDocTarget root) \"<doc target>\" path\n\n-------------------------------------- PDF -------------------------------------\n\n-- | Build all PDF documentation\nbuildPdfDocumentation :: Rules ()\nbuildPdfDocumentation = mapM_ buildSphinxPdf docPaths\n\n-- | Compile a Sphinx ReStructured Text package to LaTeX\nbuildSphinxPdf :: FilePath -> Rules ()\nbuildSphinxPdf path = do\n    root <- buildRootRules\n    root -/- pdfRoot -/- path <.> \"pdf\" %> \\file -> do\n        withTempDir $ \\dir -> do\n            build $ target docContext (Sphinx Latex) [pathPath path] [dir]\n            build $ target docContext Xelatex [path <.> \"tex\"] [dir]\n            copyFileUntracked (dir -/- path <.> \"pdf\") file\n\n------------------------------------ Archive -----------------------------------\n\n-- | Build documentation archives.\nbuildDocumentationArchives :: Rules ()\nbuildDocumentationArchives = mapM_ buildArchive docPaths\n\nbuildArchive :: FilePath -> Rules ()\nbuildArchive path = do\n    root <- buildRootRules\n    root -/- pathArchive path %> \\file -> do\n        root <- buildRoot\n        let src = root -/- pathIndex path\n        need [src]\n        build $ target docContext (Tar Create) [takeDirectory src] [file]\n\n-- | Build the man page.\nbuildManPage :: Rules ()\nbuildManPage = do\n    root <- buildRootRules\n    root -/- manPageBuildPath %> \\file -> do\n        need [\"docs/users_guide/ghc.rst\"]\n        withTempDir $ \\dir -> do\n            build $ target docContext (Sphinx Man) [\"docs/users_guide\"] [dir]\n            copyFileUntracked (dir -/- \"ghc.1\") file\n\n-- | Find the Haddock files for the dependencies of the current library.\nhaddockDependencies :: Context -> Action [FilePath]\nhaddockDependencies context = do\n    depNames <- interpretInContext context (getContextData depNames)\n    sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg\n             | Just depPkg <- map findPackageByName depNames, depPkg /= rts ]\n", "num_lines": 280}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Generate (\n    isGeneratedCmmFile, compilerDependencies, generatePackageCode,\n    generateRules, copyRules, generatedDependencies, generatedGhcDependencies,\n    ghcPrimDependencies\n    ) where\n\nimport Base\nimport Expression\nimport Flavour\nimport Oracles.Flag\nimport Oracles.ModuleFiles\nimport Oracles.Setting\nimport Packages\nimport Rules.Gmp\nimport Rules.Libffi\nimport Settings\nimport Target\nimport Utilities\n\n-- | Track this file to rebuild generated files whenever it changes.\ntrackGenerateHs :: Expr ()\ntrackGenerateHs = expr $ need [sourcePath -/- \"Rules/Generate.hs\"]\n\nprimopsSource :: FilePath\nprimopsSource = \"compiler/prelude/primops.txt.pp\"\n\nprimopsTxt :: Stage -> FilePath\nprimopsTxt stage = buildDir (vanillaContext stage compiler) -/- \"primops.txt\"\n\nisGeneratedCmmFile :: FilePath -> Bool\nisGeneratedCmmFile file = takeBaseName file == \"AutoApply\"\n\nghcPrimDependencies :: Expr [FilePath]\nghcPrimDependencies = do\n    stage <- getStage\n    path  <- expr $ buildPath (vanillaContext stage ghcPrim)\n    return [path -/- \"GHC/Prim.hs\", path -/- \"GHC/PrimopWrappers.hs\"]\n\nderivedConstantsDependencies :: [FilePath]\nderivedConstantsDependencies = fmap (generatedDir -/-)\n    [ \"DerivedConstants.h\"\n    , \"GHCConstantsHaskellExports.hs\"\n    , \"GHCConstantsHaskellType.hs\"\n    , \"GHCConstantsHaskellWrappers.hs\" ]\n\ncompilerDependencies :: Expr [FilePath]\ncompilerDependencies = do\n    root    <- getBuildRoot\n    stage   <- getStage\n    isGmp   <- (== integerGmp) <$> getIntegerPackage\n    ghcPath <- expr $ buildPath (vanillaContext stage compiler)\n    gmpPath <- expr gmpBuildPath\n    rtsPath <- expr (rtsBuildPath stage)\n    mconcat [ return ((root -/-) <$> derivedConstantsDependencies)\n            , notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH]\n            , notStage0 ? return ((rtsPath -/-) <$> libffiDependencies)\n            , return $ fmap (ghcPath -/-)\n                  [ \"primop-can-fail.hs-incl\"\n                  , \"primop-code-size.hs-incl\"\n                  , \"primop-commutable.hs-incl\"\n                  , \"primop-data-decl.hs-incl\"\n                  , \"primop-fixity.hs-incl\"\n                  , \"primop-has-side-effects.hs-incl\"\n                  , \"primop-list.hs-incl\"\n                  , \"primop-out-of-line.hs-incl\"\n                  , \"primop-primop-info.hs-incl\"\n                  , \"primop-strictness.hs-incl\"\n                  , \"primop-tag.hs-incl\"\n                  , \"primop-vector-tycons.hs-incl\"\n                  , \"primop-vector-tys-exports.hs-incl\"\n                  , \"primop-vector-tys.hs-incl\"\n                  , \"primop-vector-uniques.hs-incl\" ] ]\n\ngeneratedDependencies :: Expr [FilePath]\ngeneratedDependencies = do\n    root     <- getBuildRoot\n    stage    <- getStage\n    rtsPath  <- expr (rtsBuildPath stage)\n    includes <- expr includesDependencies\n    mconcat [ package compiler ? compilerDependencies\n            , package ghcPrim  ? ghcPrimDependencies\n            , package rts      ? return (fmap (rtsPath -/-) libffiDependencies\n                ++ includes\n                ++ fmap (root -/-) derivedConstantsDependencies)\n            , stage0 ? return includes ]\n\ngenerate :: FilePath -> Context -> Expr String -> Action ()\ngenerate file context expr = do\n    contents <- interpretInContext context expr\n    writeFileChanged file contents\n    putSuccess $ \"| Successfully generated \" ++ file ++ \".\"\n\ngeneratePackageCode :: Context -> Rules ()\ngeneratePackageCode context@(Context stage pkg _) = do\n    root <- buildRootRules\n    let dir         = buildDir context\n        generated f = (root -/- dir ++ \"//*.hs\") ?== f && not (\"//autogen/*\" ?== f)\n        go gen file = generate file context gen\n    generated ?> \\file -> do\n        let unpack = fromMaybe . error $ \"No generator for \" ++ file ++ \".\"\n        (src, builder) <- unpack <$> findGenerator context file\n        need [src]\n        build $ target context builder [src] [file]\n        let boot = src -<.> \"hs-boot\"\n        whenM (doesFileExist boot) $ do\n            let target = file -<.> \"hs-boot\"\n            copyFile boot target\n            produces [target]\n\n    priority 2.0 $ do\n        when (pkg == compiler) $ do\n            root <//> dir -/- \"Config.hs\" %> go generateConfigHs\n            root <//> dir -/- \"*.hs-incl\" %> genPrimopCode context\n        when (pkg == ghcPrim) $ do\n            root <//> dir -/- \"GHC/Prim.hs\" %> genPrimopCode context\n            root <//> dir -/- \"GHC/PrimopWrappers.hs\" %> genPrimopCode context\n        when (pkg == ghcPkg) $\n            root <//> dir -/- \"Version.hs\" %> go generateVersionHs\n\n    when (pkg == compiler) $ do\n        root -/- primopsTxt stage %> \\file -> do\n            includes <- includesDependencies\n            need $ [primopsSource] ++ includes\n            build $ target context HsCpp [primopsSource] [file]\n\n        root -/- stageString stage <//> \"ghc_boot_platform.h\" %>\n            go generateGhcBootPlatformH\n\n    when (pkg == rts) $ do\n        root <//> dir -/- \"cmm/AutoApply.cmm\" %> \\file ->\n            build $ target context GenApply [] [file]\n        -- TODO: This should be fixed properly, e.g. generated here on demand.\n        (root <//> dir -/- \"DerivedConstants.h\") <~ (buildRoot <&> (-/- generatedDir))\n        (root <//> dir -/- \"ghcautoconf.h\") <~ (buildRoot <&> (-/- generatedDir))\n        (root <//> dir -/- \"ghcplatform.h\") <~ (buildRoot <&> (-/- generatedDir))\n        (root <//> dir -/- \"ghcversion.h\") <~ (buildRoot <&> (-/- generatedDir))\n where\n    pattern <~ mdir = pattern %> \\file -> do\n        dir <- mdir\n        copyFile (dir -/- takeFileName file) file\n\ngenPrimopCode :: Context -> FilePath -> Action ()\ngenPrimopCode context@(Context stage _pkg _) file = do\n    root <- buildRoot\n    need [root -/- primopsTxt stage]\n    build $ target context GenPrimopCode [root -/- primopsTxt stage] [file]\n\ncopyRules :: Rules ()\ncopyRules = do\n    root <- buildRootRules\n    forM_ [Stage0 ..] $ \\stage -> do\n        let prefix = root -/- stageString stage -/- \"lib\"\n\n            infixl 1 <~\n            pattern <~ mdir = pattern %> \\file -> do\n                dir <- mdir\n                copyFile (dir -/- makeRelative prefix file) file\n\n        prefix -/- \"ghc-usage.txt\"     <~ return \"driver\"\n        prefix -/- \"ghci-usage.txt\"    <~ return \"driver\"\n        prefix -/- \"llvm-targets\"      <~ return \".\"\n        prefix -/- \"llvm-passes\"       <~ return \".\"\n        prefix -/- \"platformConstants\" <~ (buildRoot <&> (-/- generatedDir))\n        prefix -/- \"settings\"          <~ return \".\"\n        prefix -/- \"template-hsc.h\"    <~ return (pkgPath hsc2hs)\n\n        prefix -/- \"html//*\"           <~ return \"utils/haddock/haddock-api/resources\"\n        prefix -/- \"latex//*\"          <~ return \"utils/haddock/haddock-api/resources\"\n\ngenerateRules :: Rules ()\ngenerateRules = do\n    root <- buildRootRules\n    priority 2.0 $ (root -/- generatedDir -/- \"ghcautoconf.h\") <~ generateGhcAutoconfH\n    priority 2.0 $ (root -/- generatedDir -/- \"ghcplatform.h\") <~ generateGhcPlatformH\n    priority 2.0 $ (root -/- generatedDir -/-  \"ghcversion.h\") <~ generateGhcVersionH\n\n    -- TODO: simplify, get rid of fake rts context\n    root -/- generatedDir ++ \"//*\" %> \\file -> do\n        withTempDir $ \\dir -> build $\n            target (rtsContext Stage1) DeriveConstants [] [file, dir]\n  where\n    file <~ gen = file %> \\out -> generate out emptyTarget gen\n\n-- TODO: Use the Types, Luke! (drop partial function)\n-- We sometimes need to evaluate expressions that do not require knowing all\n-- information about the context. In this case, we don't want to know anything.\nemptyTarget :: Context\nemptyTarget = vanillaContext (error \"Rules.Generate.emptyTarget: unknown stage\")\n                             (error \"Rules.Generate.emptyTarget: unknown package\")\n\n-- Generators\n\n-- | Given a 'String' replace charaters '.' and '-' by underscores ('_') so that\n-- the resulting 'String' is a valid C preprocessor identifier.\ncppify :: String -> String\ncppify = replaceEq '-' '_' . replaceEq '.' '_'\n\n-- | Generate @ghcplatform.h@ header.\ngenerateGhcPlatformH :: Expr String\ngenerateGhcPlatformH = do\n    trackGenerateHs\n    hostPlatform   <- getSetting HostPlatform\n    hostArch       <- getSetting HostArch\n    hostOs         <- getSetting HostOs\n    hostVendor     <- getSetting HostVendor\n    targetPlatform <- getSetting TargetPlatform\n    targetArch     <- getSetting TargetArch\n    targetOs       <- getSetting TargetOs\n    targetVendor   <- getSetting TargetVendor\n    ghcUnreg       <- getFlag    GhcUnregisterised\n    return . unlines $\n        [ \"#ifndef __GHCPLATFORM_H__\"\n        , \"#define __GHCPLATFORM_H__\"\n        , \"\"\n        , \"#define BuildPlatform_TYPE  \" ++ cppify hostPlatform\n        , \"#define HostPlatform_TYPE   \" ++ cppify targetPlatform\n        , \"\"\n        , \"#define \" ++ cppify hostPlatform   ++ \"_BUILD 1\"\n        , \"#define \" ++ cppify targetPlatform ++ \"_HOST 1\"\n        , \"\"\n        , \"#define \" ++ hostArch   ++ \"_BUILD_ARCH 1\"\n        , \"#define \" ++ targetArch ++ \"_HOST_ARCH 1\"\n        , \"#define BUILD_ARCH \" ++ show hostArch\n        , \"#define HOST_ARCH \"  ++ show targetArch\n        , \"\"\n        , \"#define \" ++ hostOs   ++ \"_BUILD_OS 1\"\n        , \"#define \" ++ targetOs ++ \"_HOST_OS 1\"\n        , \"#define BUILD_OS \" ++ show hostOs\n        , \"#define HOST_OS \"  ++ show targetOs\n        , \"\"\n        , \"#define \" ++ hostVendor   ++ \"_BUILD_VENDOR 1\"\n        , \"#define \" ++ targetVendor ++ \"_HOST_VENDOR 1\"\n        , \"#define BUILD_VENDOR \" ++ show hostVendor\n        , \"#define HOST_VENDOR \"  ++ show targetVendor\n        , \"\"\n        , \"/* These TARGET macros are for backwards compatibility... DO NOT USE! */\"\n        , \"#define TargetPlatform_TYPE \" ++ cppify targetPlatform\n        , \"#define \" ++ cppify targetPlatform ++ \"_TARGET 1\"\n        , \"#define \" ++ targetArch ++ \"_TARGET_ARCH 1\"\n        , \"#define TARGET_ARCH \" ++ show targetArch\n        , \"#define \" ++ targetOs ++ \"_TARGET_OS 1\"\n        , \"#define TARGET_OS \" ++ show targetOs\n        , \"#define \" ++ targetVendor ++ \"_TARGET_VENDOR 1\" ]\n        ++\n        [ \"#define UnregisterisedCompiler 1\" | ghcUnreg ]\n        ++\n        [ \"\\n#endif /* __GHCPLATFORM_H__ */\" ]\n\n-- | Generate @Config.hs@ files.\ngenerateConfigHs :: Expr String\ngenerateConfigHs = do\n    trackGenerateHs\n    cProjectName        <- getSetting ProjectName\n    cProjectGitCommitId <- getSetting ProjectGitCommitId\n    cProjectVersion     <- getSetting ProjectVersion\n    cProjectVersionInt  <- getSetting ProjectVersionInt\n    cProjectPatchLevel  <- getSetting ProjectPatchLevel\n    cProjectPatchLevel1 <- getSetting ProjectPatchLevel1\n    cProjectPatchLevel2 <- getSetting ProjectPatchLevel2\n    cBooterVersion      <- getSetting GhcVersion\n    intLib              <- getIntegerPackage\n    debugged            <- ghcDebugged    <$> expr flavour\n    let cIntegerLibraryType\n            | intLib == integerGmp    = \"IntegerGMP\"\n            | intLib == integerSimple = \"IntegerSimple\"\n            | otherwise = error $ \"Unknown integer library: \" ++ pkgName intLib\n    cGhcWithInterpreter        <- expr $ yesNo <$> ghcWithInterpreter\n    cGhcWithNativeCodeGen      <- expr $ yesNo <$> ghcWithNativeCodeGen\n    cGhcWithSMP                <- expr $ yesNo <$> ghcWithSMP\n    cGhcEnableTablesNextToCode <- expr $ yesNo <$> ghcEnableTablesNextToCode\n    cLeadingUnderscore         <- expr $ yesNo <$> flag LeadingUnderscore\n    cGHC_UNLIT_PGM             <- fmap takeFileName $ getBuilderPath Unlit\n    cLibFFI                    <- expr useLibFFIForAdjustors\n    rtsWays                    <- getRtsWays\n    cGhcRtsWithLibdw           <- getFlag WithLibdw\n    let cGhcRTSWays = unwords $ map show rtsWays\n    return $ unlines\n        [ \"{-# LANGUAGE CPP #-}\"\n        , \"module Config where\"\n        , \"\"\n        , \"import GhcPrelude\"\n        , \"\"\n        , \"#include \\\"ghc_boot_platform.h\\\"\"\n        , \"\"\n        , \"data IntegerLibrary = IntegerGMP\"\n        , \"                    | IntegerSimple\"\n        , \"                    deriving Eq\"\n        , \"\"\n        , \"cBuildPlatformString :: String\"\n        , \"cBuildPlatformString = BuildPlatform_NAME\"\n        , \"cHostPlatformString :: String\"\n        , \"cHostPlatformString = HostPlatform_NAME\"\n        , \"cTargetPlatformString :: String\"\n        , \"cTargetPlatformString = TargetPlatform_NAME\"\n        , \"\"\n        , \"cProjectName          :: String\"\n        , \"cProjectName          = \" ++ show cProjectName\n        , \"cProjectGitCommitId   :: String\"\n        , \"cProjectGitCommitId   = \" ++ show cProjectGitCommitId\n        , \"cProjectVersion       :: String\"\n        , \"cProjectVersion       = \" ++ show cProjectVersion\n        , \"cProjectVersionInt    :: String\"\n        , \"cProjectVersionInt    = \" ++ show cProjectVersionInt\n        , \"cProjectPatchLevel    :: String\"\n        , \"cProjectPatchLevel    = \" ++ show cProjectPatchLevel\n        , \"cProjectPatchLevel1   :: String\"\n        , \"cProjectPatchLevel1   = \" ++ show cProjectPatchLevel1\n        , \"cProjectPatchLevel2   :: String\"\n        , \"cProjectPatchLevel2   = \" ++ show cProjectPatchLevel2\n        , \"cBooterVersion        :: String\"\n        , \"cBooterVersion        = \" ++ show cBooterVersion\n        , \"cStage                :: String\"\n        , \"cStage                = show (STAGE :: Int)\"\n        , \"cIntegerLibrary       :: String\"\n        , \"cIntegerLibrary       = \" ++ show (pkgName intLib)\n        , \"cIntegerLibraryType   :: IntegerLibrary\"\n        , \"cIntegerLibraryType   = \" ++ cIntegerLibraryType\n        , \"cGhcWithInterpreter   :: String\"\n        , \"cGhcWithInterpreter   = \" ++ show cGhcWithInterpreter\n        , \"cGhcWithNativeCodeGen :: String\"\n        , \"cGhcWithNativeCodeGen = \" ++ show cGhcWithNativeCodeGen\n        , \"cGhcWithSMP           :: String\"\n        , \"cGhcWithSMP           = \" ++ show cGhcWithSMP\n        , \"cGhcRTSWays           :: String\"\n        , \"cGhcRTSWays           = \" ++ show cGhcRTSWays\n        , \"cGhcEnableTablesNextToCode :: String\"\n        , \"cGhcEnableTablesNextToCode = \" ++ show cGhcEnableTablesNextToCode\n        , \"cLeadingUnderscore    :: String\"\n        , \"cLeadingUnderscore    = \" ++ show cLeadingUnderscore\n        , \"cGHC_UNLIT_PGM        :: String\"\n        , \"cGHC_UNLIT_PGM        = \" ++ show cGHC_UNLIT_PGM\n        , \"cLibFFI               :: Bool\"\n        , \"cLibFFI               = \" ++ show cLibFFI\n        , \"cGhcThreaded :: Bool\"\n        , \"cGhcThreaded = \" ++ show (any (wayUnit Threaded) rtsWays)\n        , \"cGhcDebugged :: Bool\"\n        , \"cGhcDebugged = \" ++ show debugged\n        , \"cGhcRtsWithLibdw :: Bool\"\n        , \"cGhcRtsWithLibdw = \" ++ show cGhcRtsWithLibdw ]\n\n-- | Generate @ghcautoconf.h@ header.\ngenerateGhcAutoconfH :: Expr String\ngenerateGhcAutoconfH = do\n    trackGenerateHs\n    configHContents  <- expr $ map undefinePackage <$> readFileLines configH\n    tablesNextToCode <- expr ghcEnableTablesNextToCode\n    ghcUnreg         <- getFlag    GhcUnregisterised\n    ccLlvmBackend    <- getSetting CcLlvmBackend\n    ccClangBackend   <- getSetting CcClangBackend\n    return . unlines $\n        [ \"#ifndef __GHCAUTOCONF_H__\"\n        , \"#define __GHCAUTOCONF_H__\" ]\n        ++ configHContents ++\n        [ \"\\n#define TABLES_NEXT_TO_CODE 1\" | tablesNextToCode && not ghcUnreg ]\n        ++\n        [ \"\\n#define llvm_CC_FLAVOR 1\"      | ccLlvmBackend == \"1\" ]\n        ++\n        [ \"\\n#define clang_CC_FLAVOR 1\"     | ccClangBackend == \"1\" ]\n        ++\n        [ \"#endif /* __GHCAUTOCONF_H__ */\" ]\n  where\n    undefinePackage s\n        | \"#define PACKAGE_\" `isPrefixOf` s\n            = \"/* #undef \" ++ takeWhile (/=' ') (drop 8 s) ++ \" */\"\n        | otherwise = s\n\n-- | Generate @ghc_boot_platform.h@ headers.\ngenerateGhcBootPlatformH :: Expr String\ngenerateGhcBootPlatformH = do\n    trackGenerateHs\n    stage <- getStage\n    let chooseSetting x y = getSetting $ if stage == Stage0 then x else y\n    buildPlatform  <- chooseSetting BuildPlatform HostPlatform\n    buildArch      <- chooseSetting BuildArch     HostArch\n    buildOs        <- chooseSetting BuildOs       HostOs\n    buildVendor    <- chooseSetting BuildVendor   HostVendor\n    hostPlatform   <- chooseSetting HostPlatform  TargetPlatform\n    hostArch       <- chooseSetting HostArch      TargetArch\n    hostOs         <- chooseSetting HostOs        TargetOs\n    hostVendor     <- chooseSetting HostVendor    TargetVendor\n    targetPlatform <- getSetting TargetPlatform\n    targetArch     <- getSetting TargetArch\n    llvmTarget     <- getSetting LlvmTarget\n    targetOs       <- getSetting TargetOs\n    targetVendor   <- getSetting TargetVendor\n    return $ unlines\n        [ \"#ifndef __PLATFORM_H__\"\n        , \"#define __PLATFORM_H__\"\n        , \"\"\n        , \"#define BuildPlatform_NAME  \" ++ show buildPlatform\n        , \"#define HostPlatform_NAME   \" ++ show hostPlatform\n        , \"#define TargetPlatform_NAME \" ++ show targetPlatform\n        , \"\"\n        , \"#define \" ++ cppify buildPlatform  ++ \"_BUILD 1\"\n        , \"#define \" ++ cppify hostPlatform   ++ \"_HOST 1\"\n        , \"#define \" ++ cppify targetPlatform ++ \"_TARGET 1\"\n        , \"\"\n        , \"#define \" ++ buildArch  ++ \"_BUILD_ARCH 1\"\n        , \"#define \" ++ hostArch   ++ \"_HOST_ARCH 1\"\n        , \"#define \" ++ targetArch ++ \"_TARGET_ARCH 1\"\n        , \"#define BUILD_ARCH \"  ++ show buildArch\n        , \"#define HOST_ARCH \"   ++ show hostArch\n        , \"#define TARGET_ARCH \" ++ show targetArch\n        , \"#define LLVM_TARGET \" ++ show llvmTarget\n        , \"\"\n        , \"#define \" ++ buildOs  ++ \"_BUILD_OS 1\"\n        , \"#define \" ++ hostOs   ++ \"_HOST_OS 1\"\n        , \"#define \" ++ targetOs ++ \"_TARGET_OS 1\"\n        , \"#define BUILD_OS \"  ++ show buildOs\n        , \"#define HOST_OS \"   ++ show hostOs\n        , \"#define TARGET_OS \" ++ show targetOs\n        , \"\"\n        , \"#define \" ++ buildVendor  ++ \"_BUILD_VENDOR 1\"\n        , \"#define \" ++ hostVendor   ++ \"_HOST_VENDOR 1\"\n        , \"#define \" ++ targetVendor ++ \"_TARGET_VENDOR  1\"\n        , \"#define BUILD_VENDOR \"  ++ show buildVendor\n        , \"#define HOST_VENDOR \"   ++ show hostVendor\n        , \"#define TARGET_VENDOR \" ++ show targetVendor\n        , \"\"\n        , \"#endif /* __PLATFORM_H__ */\" ]\n\n-- | Generate @ghcversion.h@ header.\ngenerateGhcVersionH :: Expr String\ngenerateGhcVersionH = do\n    trackGenerateHs\n    version     <- getSetting ProjectVersionInt\n    patchLevel1 <- getSetting ProjectPatchLevel1\n    patchLevel2 <- getSetting ProjectPatchLevel2\n    return . unlines $\n        [ \"#ifndef __GHCVERSION_H__\"\n        , \"#define __GHCVERSION_H__\"\n        , \"\"\n        , \"#ifndef __GLASGOW_HASKELL__\"\n        , \"# define __GLASGOW_HASKELL__ \" ++ version\n        , \"#endif\"\n        , \"\"]\n        ++\n        [ \"#define __GLASGOW_HASKELL_PATCHLEVEL1__ \" ++ patchLevel1 | patchLevel1 /= \"\" ]\n        ++\n        [ \"#define __GLASGOW_HASKELL_PATCHLEVEL2__ \" ++ patchLevel2 | patchLevel2 /= \"\" ]\n        ++\n        [ \"\"\n        , \"#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\\\\\"\n        , \"   ((ma)*100+(mi)) <  __GLASGOW_HASKELL__ || \\\\\"\n        , \"   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \\\\\"\n        , \"          && (pl1) <  __GLASGOW_HASKELL_PATCHLEVEL1__ || \\\\\"\n        , \"   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \\\\\"\n        , \"          && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \\\\\"\n        , \"          && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ )\"\n        , \"\"\n        , \"#endif /* __GHCVERSION_H__ */\" ]\n\n-- | Generate @Version.hs@ files.\ngenerateVersionHs :: Expr String\ngenerateVersionHs = do\n    trackGenerateHs\n    projectVersion <- getSetting ProjectVersion\n    targetOs       <- getSetting TargetOs\n    targetArch     <- getSetting TargetArch\n    return $ unlines\n        [ \"module Version where\"\n        , \"version, targetOS, targetARCH :: String\"\n        , \"version    = \" ++ show projectVersion\n        , \"targetOS   = \" ++ show targetOs\n        , \"targetARCH = \" ++ show targetArch ]\n", "num_lines": 466}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Gmp (gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH) where\n\nimport Base\nimport Context\nimport Oracles.Setting\nimport Packages\nimport Target\nimport Utilities\n\n-- | Build GMP library objects and return their paths.\ngmpObjects :: Action [FilePath]\ngmpObjects = do\n    gmpPath <- gmpBuildPath\n    need [gmpPath -/- gmpLibraryH]\n    -- The line below causes a Shake Lint failure on Windows, which forced us to\n    -- disable Lint by default. See more details here:\n    -- https://ghc.haskell.org/trac/ghc/ticket/15971.\n    map (unifyPath . (gmpPath -/-)) <$>\n        liftIO (getDirectoryFilesIO gmpPath [gmpObjectsDir -/- \"*.o\"])\n\ngmpBase :: FilePath\ngmpBase = pkgPath integerGmp -/- \"gmp\"\n\ngmpLibraryInTreeH :: FilePath\ngmpLibraryInTreeH = \"include/gmp.h\"\n\ngmpLibrary :: FilePath\ngmpLibrary = \".libs/libgmp.a\"\n\n-- | GMP is considered a Stage1 package. This determines GMP build directory.\ngmpContext :: Context\ngmpContext = vanillaContext Stage1 integerGmp\n\n-- TODO: Location of 'gmpBuildPath' is important: it should be outside any\n-- package build directory, as otherwise GMP's object files will match build\n-- patterns of 'compilePackage' rules. We could make 'compilePackage' rules\n-- more precise to avoid such spurious matching.\n-- | Build directory for in-tree GMP library.\ngmpBuildPath :: Action FilePath\ngmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- \"gmp\")\n\n-- | Like 'gmpBuildPath' but in the 'Rules' monad.\ngmpBuildPathRules :: Rules FilePath\ngmpBuildPathRules = buildRootRules <&> (-/- stageString (stage gmpContext) -/- \"gmp\")\n\n-- | GMP library header, relative to 'gmpBuildPath'.\ngmpLibraryH :: FilePath\ngmpLibraryH = \"include/ghc-gmp.h\"\n\n-- | Directory for GMP library object files, relative to 'gmpBuildPath'.\ngmpObjectsDir :: FilePath\ngmpObjectsDir = \"objs\"\n\nconfigureEnvironment :: Action [CmdOption]\nconfigureEnvironment = sequence [ builderEnvironment \"CC\" $ Cc CompileC Stage1\n                                , builderEnvironment \"AR\" (Ar Unpack Stage1)\n                                , builderEnvironment \"NM\" Nm ]\n\ngmpRules :: Rules ()\ngmpRules = do\n    -- Copy appropriate GMP header and object files\n    gmpPath <- gmpBuildPathRules\n    gmpPath -/- gmpLibraryH %> \\header -> do\n        windows  <- windowsHost\n        configMk <- readFile' =<< (buildPath gmpContext <&> (-/- \"config.mk\"))\n        if not windows && -- TODO: We don't use system GMP on Windows. Fix?\n           any (`isInfixOf` configMk) [ \"HaveFrameworkGMP = YES\", \"HaveLibGmp = YES\" ]\n        then do\n            putBuild \"| GMP library/framework detected and will be used\"\n            copyFile (gmpBase -/- \"ghc-gmp.h\") header\n        else do\n            putBuild \"| No GMP library/framework detected; in tree GMP will be built\"\n            need [gmpPath -/- gmpLibrary]\n            createDirectory (gmpPath -/- gmpObjectsDir)\n            top <- topDirectory\n            build $ target gmpContext (Ar Unpack Stage1)\n                [top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]\n            objs <- liftIO $ getDirectoryFilesIO \".\" [gmpPath -/- gmpObjectsDir -/- \"*\"]\n            produces objs\n            copyFileUntracked (gmpPath -/- \"gmp.h\") header\n\n    -- Build in-tree GMP library, prioritised so that it matches \"before\"\n    -- the generic @.a@ library rule in 'Rules.Library'.\n    priority 2.0 $ gmpPath -/- gmpLibrary %> \\lib -> do\n        build $ target gmpContext (Make gmpPath) [gmpPath -/- \"Makefile\"] [lib]\n        putSuccess \"| Successfully built custom library 'gmp'\"\n\n    gmpPath -/- gmpLibraryInTreeH %> copyFile (gmpPath -/- gmpLibraryH)\n\n    root <- buildRootRules\n    root -/- buildDir gmpContext -/- gmpLibraryH %>\n        copyFile (gmpPath -/- gmpLibraryH)\n\n    -- This file is created when 'integerGmp' is configured.\n    gmpPath -/- \"config.mk\" %> \\_ -> ensureConfigured gmpContext\n\n    -- Run GMP's configure script\n    gmpPath -/- \"Makefile\" %> \\mk -> do\n        env <- configureEnvironment\n        need [mk <.> \"in\"]\n        buildWithCmdOptions env $\n            target gmpContext (Configure gmpPath) [mk <.> \"in\"] [mk]\n\n    -- Extract in-tree GMP sources and apply patches\n    fmap (gmpPath -/-) [\"Makefile.in\", \"configure\"] &%> \\_ -> do\n        top <- topDirectory\n        removeDirectory gmpPath\n        -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is\n        -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.\n        -- That's because the doc/ directory contents are under the GFDL,\n        -- which causes problems for Debian.\n        tarball <- unifyPath . fromSingleton \"Exactly one GMP tarball is expected\"\n               <$> getDirectoryFiles top [gmpBase -/- \"gmp-tarballs/gmp*.tar.bz2\"]\n\n        withTempDir $ \\dir -> do\n            let tmp = unifyPath dir\n            need [top -/- tarball]\n            build $ target gmpContext (Tar Extract) [top -/- tarball] [tmp]\n\n            let patch     = gmpBase -/- \"gmpsrc.patch\"\n                patchName = takeFileName patch\n            copyFile patch $ tmp -/- patchName\n            applyPatch tmp patchName\n\n            let name    = dropExtension . dropExtension $ takeFileName tarball\n                unpack  = fromMaybe . error $ \"gmpRules: expected suffix \"\n                    ++ \"-nodoc (found: \" ++ name ++ \").\"\n                libName = unpack $ stripSuffix \"-nodoc\" name\n\n            moveDirectory (tmp -/- libName) gmpPath\n", "num_lines": 131}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Libffi (libffiRules, libffiDependencies, libffiName) where\n\nimport Hadrian.Utilities\n\nimport Packages\nimport Settings.Builders.Common\nimport Target\nimport Utilities\n\n{-\nNote [Hadrian: install libffi hack]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThere are 2 important steps in handling libffi's .a and .so files:\n\n  1. libffi's .a and .so|.dynlib|.dll files are copied from the libffi build dir\n  to the rts build dir. This is because libffi is ultimately bundled with the\n  rts package. Relevant code is in the libffiRules function.\n  2. The rts is \"installed\" via the hadrian/src/Hadrian/Haskell/Cabal/Parse.hs\n  copyPackage action. This uses the \"cabal copy\" command which (among other\n  things) attempts to copy the bundled .a and .so|.dynlib|.dll files from the\n  rts build dir to the install dir.\n\nThere is an issue in step 1. that the name of the shared library files is not\nknow untill after libffi is built. As a workaround, the rts package needs just\nthe libffiDependencies, and the corresponding rule (defined below in\nlibffiRules) does the extra work of installing the shared library files into the\nrts build directory after building libffi.\n-}\n\n-- | Context for @libffi@.\nlibffiContext :: Stage -> Action Context\nlibffiContext stage = do\n    ways <- interpretInContext\n            (Context stage libffi (error \"libffiContext: way not set\"))\n            getLibraryWays\n    return . Context stage libffi $ if any (wayUnit Dynamic) ways\n        then dynamic\n        else vanilla\n\n-- | The name of the (locally built) library\nlibffiName :: Expr String\nlibffiName = do\n    windows <- expr windowsHost\n    way <- getWay\n    return $ libffiName' windows (Dynamic `wayUnit` way)\n\n-- | The name of the (locally built) library\nlibffiName' :: Bool -> Bool -> String\nlibffiName' windows dynamic\n    = (if dynamic then \"\" else \"C\")\n    ++ (if windows then \"ffi-6\" else \"ffi\")\n\nlibffiDependencies :: [FilePath]\nlibffiDependencies = [\"ffi.h\", \"ffitarget.h\"]\n\nlibffiLibrary :: FilePath\nlibffiLibrary = \"inst/lib/libffi.a\"\n\nrtsLibffiLibrary :: Stage -> Way -> Action FilePath\nrtsLibffiLibrary stage way = do\n    name    <- libffiLibraryName\n    suf     <- libsuf way\n    rtsPath <- rtsBuildPath stage\n    return $ rtsPath -/- \"lib\" ++ name ++ suf\n\nfixLibffiMakefile :: FilePath -> String -> String\nfixLibffiMakefile top =\n      replace \"-MD\" \"-MMD\"\n    . replace \"@toolexeclibdir@\" \"$(libdir)\"\n    . replace \"@INSTALL@\" (\"$(subst ../install-sh,\" ++ top ++ \"/install-sh,@INSTALL@)\")\n\n-- TODO: check code duplication w.r.t. ConfCcArgs\nconfigureEnvironment :: Stage -> Action [CmdOption]\nconfigureEnvironment stage = do\n    context <- libffiContext stage\n    cFlags  <- interpretInContext context $ mconcat\n               [ cArgs\n               , getStagedSettingList ConfCcArgs ]\n    ldFlags <- interpretInContext context ldArgs\n    sequence [ builderEnvironment \"CC\" $ Cc CompileC stage\n             , builderEnvironment \"CXX\" $ Cc CompileC stage\n             , builderEnvironment \"LD\" (Ld stage)\n             , builderEnvironment \"AR\" (Ar Unpack stage)\n             , builderEnvironment \"NM\" Nm\n             , builderEnvironment \"RANLIB\" Ranlib\n             , return . AddEnv  \"CFLAGS\" $ unwords  cFlags ++ \" -w\"\n             , return . AddEnv \"LDFLAGS\" $ unwords ldFlags ++ \" -w\" ]\n\nlibffiRules :: Rules ()\nlibffiRules = forM_ [Stage1 ..] $ \\stage -> do\n    root <- buildRootRules\n    let path       = root -/- stageString stage\n        libffiPath = path -/- pkgName libffi -/- \"build\"\n        libffiOuts = [libffiPath -/- libffiLibrary] ++\n                     fmap ((path -/- \"rts/build\") -/-) libffiDependencies\n\n    -- We set a higher priority because this rule overlaps with the build rule\n    -- for static libraries 'Rules.Library.libraryRules'.\n    -- See [Hadrian: install libffi hack], this rule installs libffi into the\n    -- rts build path.\n    priority 2.0 $ libffiOuts &%> \\_ -> do\n        context <- libffiContext stage\n        useSystemFfi <- flag UseSystemFfi\n        rtsPath      <- rtsBuildPath stage\n        if useSystemFfi\n        then do\n            ffiIncludeDir <- setting FfiIncludeDir\n            putBuild \"| System supplied FFI library will be used\"\n            forM_ [\"ffi.h\", \"ffitarget.h\"] $ \\file ->\n                copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)\n            putSuccess \"| Successfully copied system FFI library header files\"\n        else do\n            build $ target context (Make libffiPath) [] []\n\n            -- Here we produce 'libffiDependencies'\n            headers <- liftIO $ getDirectoryFilesIO libffiPath [\"inst/include/*\"]\n            forM_ headers $ \\header -> do\n                let target = rtsPath -/- takeFileName header\n                copyFileUntracked (libffiPath -/- header) target\n                produces [target]\n\n            -- Find ways.\n            ways <- interpretInContext context\n                                       (getLibraryWays <> getRtsWays)\n            let (dynamicWays, staticWays) = partition (wayUnit Dynamic) ways\n\n            -- Install static libraries.\n            forM_ staticWays $ \\way -> do\n                rtsLib <- rtsLibffiLibrary stage way\n                copyFileUntracked (libffiPath -/- \"inst/lib/libffi.a\") rtsLib\n                produces [rtsLib]\n\n            -- Install dynamic libraries.\n            when (not $ null dynamicWays) $ do\n                -- Find dynamic libraries.\n                windows <- windowsHost\n                osx     <- osxHost\n                let libffiName'' = libffiName' windows True\n                (dynLibsSrcDir, dynLibFiles) <- if windows\n                    then do\n                        let libffiDll = \"lib\" ++ libffiName'' ++ \".dll\"\n                        return (libffiPath -/- \"inst/bin\", [libffiDll])\n                    else do\n                        let libffiLibPath = libffiPath -/- \"inst/lib\"\n                        dynLibsRelative <- liftIO $ getDirectoryFilesIO\n                            libffiLibPath\n                            (if osx\n                                then [\"lib\" ++ libffiName'' ++ \".dylib*\"]\n                                else [\"lib\" ++ libffiName'' ++ \".so*\"])\n                        return (libffiLibPath, dynLibsRelative)\n\n                -- Install dynamic libraries.\n                rtsPath <- rtsBuildPath stage\n                forM_ dynLibFiles $ \\dynLibFile -> do\n                    let target = rtsPath -/- dynLibFile\n                    copyFileUntracked (dynLibsSrcDir -/- dynLibFile) target\n\n                    -- On OSX the dylib's id must be updated to a relative path.\n                    when osx $ cmd\n                        [ \"install_name_tool\"\n                        , \"-id\", \"@rpath/\" ++ dynLibFile\n                        , target\n                        ]\n\n                    produces [target]\n\n            putSuccess \"| Successfully bundled custom library 'libffi' with rts\"\n\n    fmap (libffiPath -/-) [\"Makefile.in\", \"configure\" ] &%> \\[mkIn, _] -> do\n        -- Extract libffi tar file\n        context <- libffiContext stage\n        removeDirectory libffiPath\n        top <- topDirectory\n        tarball <- unifyPath . fromSingleton \"Exactly one LibFFI tarball is expected\"\n               <$> getDirectoryFiles top [\"libffi-tarballs/libffi*.tar.gz\"]\n\n        need [top -/- tarball]\n        -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999'\n        let libname = takeWhile (/= '+') $ takeFileName tarball\n\n        -- Move extracted directory to libffiPath.\n        root <- buildRoot\n        removeDirectory (root -/- libname)\n        actionFinally (do\n            build $ target context (Tar Extract) [tarball] [path]\n            moveDirectory (path -/- libname) libffiPath) $\n            -- And finally:\n            removeFiles (path) [libname <//> \"*\"]\n\n        fixFile mkIn (fixLibffiMakefile top)\n\n        files <- liftIO $ getDirectoryFilesIO \".\" [libffiPath <//> \"*\"]\n        produces files\n\n    fmap (libffiPath -/-) [\"Makefile\", \"config.guess\", \"config.sub\"] &%> \\[mk, _, _] -> do\n        context <- libffiContext stage\n\n        -- This need rule extracts the libffi tar file to libffiPath.\n        need [mk <.> \"in\"]\n\n        -- Configure.\n        forM_ [\"config.guess\", \"config.sub\"] $ \\file -> do\n            copyFile file (libffiPath -/- file)\n        env <- configureEnvironment stage\n        buildWithCmdOptions env $\n            target context (Configure libffiPath) [mk <.> \"in\"] [mk]\n\n        dir   <- setting BuildPlatform\n        files <- liftIO $ getDirectoryFilesIO \".\" [libffiPath -/- dir <//> \"*\"]\n        produces files\n", "num_lines": 212}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Library (libraryRules) where\n\nimport Hadrian.BuildPath\nimport Hadrian.Haskell.Cabal\nimport Hadrian.Haskell.Cabal.Type\nimport qualified System.Directory as IO\nimport qualified Text.Parsec      as Parsec\n\nimport Base\nimport Context\nimport Expression hiding (way, package)\nimport Flavour\nimport Oracles.ModuleFiles\nimport Packages\nimport Rules.Gmp\nimport Rules.Libffi (libffiDependencies)\nimport Settings\nimport Target\nimport Utilities\n\n-- * Library 'Rules'\n\nlibraryRules :: Rules ()\nlibraryRules = do\n    root <- buildRootRules\n    root -/- \"//libHS*-*.dylib\"       %> buildDynamicLibUnix root \"dylib\"\n    root -/- \"//libHS*-*.so\"          %> buildDynamicLibUnix root \"so\"\n    root -/- \"//*.a\"                  %> buildStaticLib      root\n    priority 2 $ do\n        root -/- \"//HS*-*.o\" %> buildGhciLibO root\n        root -/- \"//HS*-*.p_o\" %> buildGhciLibO root\n\n-- * 'Action's for building libraries\n\n-- | Build a static library ('LibA') under the given build root, whose path is\n-- the second argument.\nbuildStaticLib :: FilePath -> FilePath -> Action ()\nbuildStaticLib root archivePath = do\n    l@(BuildPath _ stage _ (LibA pkgname _ way))\n        <- parsePath (parseBuildLibA root)\n                     \"<.a library (build) path parser>\"\n                     archivePath\n    let context = libAContext l\n    objs <- libraryObjects context\n    removeFile archivePath\n    build $ target context (Ar Pack stage) objs [archivePath]\n    synopsis <- pkgSynopsis (package context)\n    putSuccess $ renderLibrary\n        (quote pkgname ++ \" (\" ++ show stage ++ \", way \" ++ show way ++ \").\")\n        archivePath synopsis\n\n-- | Build a dynamic library ('LibDyn') under the given build root, with the\n-- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete\n-- path of the archive to build is given as the third argument.\nbuildDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()\nbuildDynamicLibUnix root suffix dynlibpath = do\n    dynlib <- parsePath (parseBuildLibDyn root suffix) \"<dyn lib parser>\" dynlibpath\n    let context = libDynContext dynlib\n    deps <- contextDependencies context\n    need =<< mapM pkgLibraryFile deps\n\n    -- TODO should this be somewhere else?\n    -- Custom build step to generate libffi.so* in the rts build directory.\n    when (package context == rts) . interpretInContext context $ do\n        stage   <- getStage\n        rtsPath <- expr (rtsBuildPath stage)\n        expr $ need ((rtsPath -/-) <$> libffiDependencies)\n\n    objs <- libraryObjects context\n    build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]\n\n-- | Build a \"GHCi library\" ('LibGhci') under the given build root, with the\n-- complete path of the file to build is given as the second argument.\nbuildGhciLibO :: FilePath -> FilePath -> Action ()\nbuildGhciLibO root ghcilibPath = do\n    l@(BuildPath _ stage _ (LibGhci _ _ _))\n        <- parsePath (parseBuildLibGhci root)\n                     \"<.o ghci lib (build) path parser>\"\n                     ghcilibPath\n    let context = libGhciContext l\n    objs <- allObjects context\n    need objs\n    build $ target context (Ld stage) objs [ghcilibPath]\n\n-- * Helpers\n\n-- | Return all Haskell and non-Haskell object files for the given 'Context'.\nallObjects :: Context -> Action [FilePath]\nallObjects context = (++) <$> nonHsObjects context <*> hsObjects context\n\n-- | Return all the non-Haskell object files for the given library context\n-- (object files built from C, C-- and sometimes other things).\nnonHsObjects :: Context -> Action [FilePath]\nnonHsObjects context = do\n    cObjs   <- cObjects context\n    cmmSrcs <- interpretInContext context (getContextData cmmSrcs)\n    cmmObjs <- mapM (objectPath context) cmmSrcs\n    eObjs   <- extraObjects context\n    return $ cObjs ++ cmmObjs ++ eObjs\n\n-- | Return all the C object files needed to build the given library context.\ncObjects :: Context -> Action [FilePath]\ncObjects context = do\n    srcs <- interpretInContext context (getContextData cSrcs)\n    objs <- mapM (objectPath context) srcs\n    return $ if Threaded `wayUnit` way context\n        then objs\n        else filter ((`notElem` [\"Evac_thr\", \"Scav_thr\"]) . takeBaseName) objs\n\n-- | Return extra object files needed to build the given library context. The\n-- resulting list is currently non-empty only when the package from the\n-- 'Context' is @integer-gmp@.\nextraObjects :: Context -> Action [FilePath]\nextraObjects context\n    | package context == integerGmp = gmpObjects\n    | otherwise                     = return []\n\n-- | Return all the object files to be put into the library we're building for\n-- the given 'Context'.\nlibraryObjects :: Context -> Action [FilePath]\nlibraryObjects context@Context{..} = do\n    hsObjs   <- hsObjects    context\n    noHsObjs <- nonHsObjects context\n    need $ noHsObjs ++ hsObjs\n    return (noHsObjs ++ hsObjs)\n\n-- * Library paths types and parsers\n\n-- | > libHS<pkg name>-<pkg version>[_<way suffix>].a\ndata LibA = LibA String [Integer] Way deriving (Eq, Show)\n\n-- | > <so or dylib>\ndata DynLibExt = So | Dylib deriving (Eq, Show)\n\n-- | > libHS<pkg name>-<pkg version>[_<way suffix>]-ghc<ghc version>.<so|dylib>\ndata LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show)\n\n-- | > HS<pkg name>-<pkg version>[_<way suffix>].o\ndata LibGhci = LibGhci String [Integer] Way deriving (Eq, Show)\n\n-- | Get the 'Context' corresponding to the build path for a given static library.\nlibAContext :: BuildPath LibA -> Context\nlibAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =\n    Context stage pkg way\n  where\n    pkg = library pkgname pkgpath\n\n-- | Get the 'Context' corresponding to the build path for a given GHCi library.\nlibGhciContext :: BuildPath LibGhci -> Context\nlibGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =\n    Context stage pkg way\n  where\n    pkg = library pkgname pkgpath\n\n-- | Get the 'Context' corresponding to the build path for a given dynamic library.\nlibDynContext :: BuildPath LibDyn -> Context\nlibDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =\n    Context stage pkg way\n  where\n    pkg = library pkgname pkgpath\n\n-- | Parse a path to a static library to be built, making sure the path starts\n-- with the given build root.\nparseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)\nparseBuildLibA root = parseBuildPath root parseLibAFilename\n    Parsec.<?> \"build path for a static library\"\n\n-- | Parse a path to a ghci library to be built, making sure the path starts\n-- with the given build root.\nparseBuildLibGhci :: FilePath -> Parsec.Parsec String () (BuildPath LibGhci)\nparseBuildLibGhci root = parseBuildPath root parseLibGhciFilename\n    Parsec.<?> \"build path for a ghci library\"\n\n-- | Parse a path to a dynamic library to be built, making sure the path starts\n-- with the given build root.\nparseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)\nparseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)\n    Parsec.<?> (\"build path for a dynamic library with extension \" ++ ext)\n\n-- | Parse the filename of a static library to be built into a 'LibA' value.\nparseLibAFilename :: Parsec.Parsec String () LibA\nparseLibAFilename = do\n    _ <- Parsec.string \"libHS\"\n    (pkgname, pkgver) <- parsePkgId\n    way <- parseWaySuffix vanilla\n    _ <- Parsec.string \".a\"\n    return (LibA pkgname pkgver way)\n\n-- | Parse the filename of a ghci library to be built into a 'LibGhci' value.\nparseLibGhciFilename :: Parsec.Parsec String () LibGhci\nparseLibGhciFilename = do\n    _ <- Parsec.string \"HS\"\n    (pkgname, pkgver) <- parsePkgId\n    _ <- Parsec.string \".\"\n    way <- parseWayPrefix vanilla\n    _ <- Parsec.string \"o\"\n    return (LibGhci pkgname pkgver way)\n\n-- | Parse the filename of a dynamic library to be built into a 'LibDyn' value.\nparseLibDynFilename :: String -> Parsec.Parsec String () LibDyn\nparseLibDynFilename ext = do\n    _ <- Parsec.string \"libHS\"\n    (pkgname, pkgver) <- parsePkgId\n    way <- addWayUnit Dynamic <$> parseWaySuffix dynamic\n    _ <- optional $ Parsec.string \"-ghc\" *> parsePkgVersion\n    _ <- Parsec.string (\".\" ++ ext)\n    return (LibDyn pkgname pkgver way $ if ext == \"so\" then So else Dylib)\n", "num_lines": 208}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Nofib where\n\nimport Base\nimport Expression\nimport Oracles.Setting\nimport Packages\n\nimport System.Environment\nimport System.Exit\n\nnofibLogFile :: FilePath\nnofibLogFile = \"nofib-log\"\n\n-- | Rules for running the @nofib@ benchmark suite.\nnofibRules :: Rules ()\nnofibRules = do\n    root <- buildRootRules\n\n    -- a phony \"nofib\" rule that just triggers\n    -- the rule below.\n    \"nofib\" ~> need [root -/- nofibLogFile]\n\n    -- a rule to produce <build root>/nofig-log\n    -- by running the nofib suite and capturing\n    -- the relevant output.\n    root -/- nofibLogFile %> \\fp -> do\n        needNofibDeps\n\n        makePath <- builderPath (Make \"nofib\")\n        top      <- topDirectory\n        ghcPath  <- builderPath (Ghc CompileHs Stage2)\n        perlPath <- builderPath Perl\n\n        -- some makefiles in nofib rely on a $MAKE\n        -- env var being defined\n        liftIO (setEnv \"MAKE\" makePath)\n\n        -- this runs make commands in the nofib\n        -- subdirectory, passing the path to\n        -- the GHC to benchmark and perl to\n        -- nofib's makefiles.\n        let nofibArgs = [\"WithNofibHc=\" ++ (top -/- ghcPath), \"PERL=\" ++ perlPath]\n        unit $ cmd (Cwd \"nofib\") [makePath] [\"clean\"]\n        unit $ cmd (Cwd \"nofib\") [makePath] (nofibArgs ++ [\"boot\"])\n        (Exit e, Stdouterr log) <- cmd (Cwd \"nofib\") [makePath] nofibArgs\n        writeFile' fp log\n        if e == ExitSuccess\n            then putLoud $ \"nofib log available at \" ++ fp\n            else error $ \"nofib failed, full log available at \" ++ fp\n\n-- | Build the dependencies required by @nofib@.\nneedNofibDeps :: Action ()\nneedNofibDeps = do\n    unlitPath <- programPath (vanillaContext Stage1 unlit)\n    mtlPath   <- pkgConfFile (vanillaContext Stage1 mtl  )\n    need [ unlitPath, mtlPath ]\n    needBuilder (Ghc CompileHs Stage2)\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Program (buildProgramRules) where\n\nimport Hadrian.Haskell.Cabal\nimport Hadrian.Haskell.Cabal.Type\n\nimport Base\nimport Context\nimport Expression hiding (stage, way)\nimport Oracles.Flag\nimport Oracles.ModuleFiles\nimport Oracles.Setting (topDirectory)\nimport Packages\nimport Settings\nimport Settings.Default\nimport Target\nimport Utilities\n\n-- | TODO: Drop code duplication\nbuildProgramRules :: [(Resource, Int)] -> Rules ()\nbuildProgramRules rs = do\n    root <- buildRootRules\n\n    -- Proxy rule for the whole mingw toolchain on Windows.\n    -- We 'need' configure  because that's when the inplace/mingw\n    -- folder gets filled with the toolchain. This \"proxy\" rule\n    -- is listed as a runtime dependency for stage >= 1 GHCs.\n    root -/- mingwStamp %> \\stampPath -> do\n        top <- topDirectory\n        need [ top -/- \"configure\" ]\n        copyDirectory (top -/- \"inplace\" -/- \"mingw\") root\n        writeFile' stampPath \"OK\"\n\n    -- Rules for programs that are actually built by hadrian.\n    forM_ [Stage0 ..] $ \\stage ->\n        [ root -/- stageString stage -/- \"bin\"     -/- \"*\"\n        , root -/- stageString stage -/- \"lib/bin\" -/- \"*\" ] |%> \\bin -> do\n            programContexts <- getProgramContexts stage\n            case lookupProgramContext bin programContexts of\n                Nothing  -> error $ \"Unknown program \" ++ show bin\n                Just ctx -> buildProgram bin ctx rs\n\ngetProgramContexts :: Stage -> Action [(FilePath, Context)]\ngetProgramContexts stage = do\n  -- This is quite inefficient, but we can't access 'programName' from\n  -- 'Rules', because it is an 'Action' depending on an oracle.\n  sPackages <- filter isProgram <$> stagePackages stage\n  tPackages <- testsuitePackages\n  -- TODO: Shall we use Stage2 for testsuite packages instead?\n  let allPackages = sPackages\n                ++ if stage == Stage1 then tPackages else []\n  fmap concat . forM allPackages $ \\pkg -> do\n    -- the iserv pkg results in three different programs at\n    -- the moment, ghc-iserv (built the vanilla way),\n    -- ghc-iserv-prof (built the profiling way), and\n    -- ghc-iserv-dyn (built the dynamic way).\n    -- The testsuite requires all to be present, so we\n    -- make sure that we cover these\n    -- \"prof-build-under-other-name\" cases.\n    -- iserv gets its names from Packages.hs:programName\n    ctx <- programContext stage pkg -- TODO: see todo on programContext.\n    let allCtxs = if pkg == iserv\n        then [ vanillaContext stage pkg\n             , Context stage pkg profiling\n             , Context stage pkg dynamic\n             ]\n        else [ ctx ]\n    forM allCtxs $ \\ctx -> do\n      name <- programName ctx\n      return (name <.> exe, ctx)\n\nlookupProgramContext :: FilePath -> [(FilePath, Context)] -> Maybe Context\nlookupProgramContext wholePath progs = lookup (takeFileName wholePath) progs\n\nbuildProgram :: FilePath -> Context -> [(Resource, Int)] -> Action ()\nbuildProgram bin ctx@(Context{..}) rs = do\n  -- Custom dependencies: this should be modeled better in the\n  -- Cabal file somehow.\n  -- TODO: Is this still needed? See 'runtimeDependencies'.\n  when (package == hsc2hs) $ do\n    -- 'Hsc2hs' needs the @template-hsc.h@ file.\n    template <- templateHscPath stage\n    need [template]\n  when (package == ghc) $ do\n    -- GHC depends on @settings@, @platformConstants@,\n    -- @llvm-targets@, @ghc-usage.txt@, @ghci-usage.txt@,\n    -- @llvm-passes@.\n    need =<< ghcDeps stage\n  when (package == haddock) $ do\n    -- Haddock has a resource folder\n    need =<< haddockDeps stage\n\n  cross <- flag CrossCompiling\n  -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.\n  case (cross, stage) of\n    (True, s) | s > Stage0 -> do\n        srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- \"bin\"))\n        copyFile (srcDir -/- takeFileName bin) bin\n    (False, s) | s > Stage0 && (package `elem` [touchy, unlit]) -> do\n        srcDir <- stageLibPath Stage0 <&> (-/- \"bin\")\n        copyFile (srcDir -/- takeFileName bin) bin\n    _ -> buildBinary rs bin ctx\n\nbuildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()\nbuildBinary rs bin context@Context {..} = do\n    needLibrary =<< contextDependencies context\n    when (stage > Stage0) $ do\n        ways <- interpretInContext context (getLibraryWays <> getRtsWays)\n        needLibrary [ (rtsContext stage) { way = w } | w <- ways ]\n    cSrcs  <- interpretInContext context (getContextData cSrcs)\n    cObjs  <- mapM (objectPath context) cSrcs\n    hsObjs <- hsObjects context\n    let binDeps = cObjs ++ hsObjs\n    need binDeps\n    buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]\n    synopsis <- pkgSynopsis package\n    putSuccess $ renderProgram\n        (quote (pkgName package) ++ \" (\" ++ show stage ++ \").\") bin synopsis\n", "num_lines": 118}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Register (configurePackageRules, registerPackageRules) where\n\nimport Base\nimport Context\nimport Hadrian.BuildPath\nimport Hadrian.Expression\nimport Hadrian.Haskell.Cabal\nimport Oracles.Setting\nimport Packages\nimport Rules.Gmp\nimport Settings\nimport Target\nimport Utilities\n\nimport Distribution.Version (Version)\nimport qualified Distribution.Parsec as Cabal\nimport qualified Distribution.Types.PackageName as Cabal\nimport qualified Distribution.Types.PackageId as Cabal\n\nimport qualified Hadrian.Haskell.Cabal.Parse as Cabal\nimport qualified System.Directory            as IO\nimport qualified Text.Parsec                 as Parsec\n\n-- * Configuring\n\n-- | Configure a package and build its @setup-config@ file, as well as files in\n-- the @build/pkgName/build/autogen@ directory.\nconfigurePackageRules :: Rules ()\nconfigurePackageRules = do\n    root <- buildRootRules\n    root -/- \"**/setup-config\" %> \\out -> do\n        (stage, path) <- parsePath (parseSetupConfig root) \"<setup config path parser>\" out\n        let pkg = unsafeFindPackageByPath path\n        Cabal.configurePackage (Context stage pkg vanilla)\n\n    root -/- \"**/autogen/cabal_macros.h\" %> \\out -> do\n        (stage, path) <- parsePath (parseToBuildSubdirectory root) \"<cabal macros path parser>\" out\n        let pkg = unsafeFindPackageByPath path\n        Cabal.buildAutogenFiles (Context stage pkg vanilla)\n\n    root -/- \"**/autogen/Paths_*.hs\" %> \\out ->\n        need [takeDirectory out -/- \"cabal_macros.h\"]\n\nparseSetupConfig :: FilePath -> Parsec.Parsec String () (Stage, FilePath)\nparseSetupConfig root = do\n    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')\n    stage <- parseStage\n    _ <- Parsec.char '/'\n    pkgPath <- Parsec.manyTill Parsec.anyChar\n        (Parsec.try $ Parsec.string \"/setup-config\")\n    return (stage, pkgPath)\n\nparseToBuildSubdirectory :: FilePath -> Parsec.Parsec String () (Stage, FilePath)\nparseToBuildSubdirectory root = do\n    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')\n    stage <- parseStage\n    _ <- Parsec.char '/'\n    pkgPath <- Parsec.manyTill Parsec.anyChar\n        (Parsec.try $ Parsec.string \"/build/\")\n    return (stage, pkgPath)\n\n-- * Registering\n\n-- | Register a package and initialise the corresponding package database if\n-- need be. Note that we only register packages in 'Stage0' and 'Stage1'.\nregisterPackageRules :: [(Resource, Int)] -> Stage -> Rules ()\nregisterPackageRules rs stage = do\n    root <- buildRootRules\n\n    -- Initialise the package database.\n    root -/- relativePackageDbPath stage -/- packageDbStamp %> \\stamp ->\n        writeFileLines stamp []\n\n    -- Register a package.\n    root -/- relativePackageDbPath stage -/- \"*.conf\" %> \\conf -> do\n        historyDisable\n        let libpath = takeDirectory (takeDirectory conf)\n            settings = libpath -/- \"settings\"\n            platformConstants = libpath -/- \"platformConstants\"\n\n        need [settings, platformConstants]\n\n        pkgName <- getPackageNameFromConfFile conf\n        let pkg = unsafeFindPackageByName pkgName\n        isBoot <- (pkg `notElem`) <$> stagePackages Stage0\n\n        let ctx = Context stage pkg vanilla\n        case stage of\n            Stage0 | isBoot -> copyConf  rs ctx conf\n            _               -> buildConf rs ctx conf\n\nbuildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()\nbuildConf _ context@Context {..} conf = do\n    depPkgIds <- cabalDependencies context\n    ensureConfigured context\n    need =<< mapM (\\pkgId -> packageDbPath stage <&> (-/- pkgId <.> \"conf\")) depPkgIds\n\n    ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty)\n    need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ]\n\n    -- We might need some package-db resource to limit read/write, see packageRules.\n    path <- buildPath context\n\n    -- Special package cases (these should ideally be rolled into Cabal).\n    when (package == rts) $\n        -- If Cabal knew about \"generated-headers\", we could read them from the\n        -- 'configuredCabal' information, and just \"need\" them here.\n        need [ path -/- \"DerivedConstants.h\"\n             , path -/- \"ghcautoconf.h\"\n             , path -/- \"ghcplatform.h\"\n             , path -/- \"ghcversion.h\"\n             , path -/- \"ffi.h\" ]\n\n    when (package == integerGmp) $ need [path -/- gmpLibraryH]\n\n    -- Copy and register the package.\n    Cabal.copyPackage context\n    Cabal.registerPackage context\n\n    -- The above two steps produce an entry in the package database, with copies\n    -- of many of the files we have build, e.g. Haskell interface files. We need\n    -- to record this side effect so that Shake can cache these files too.\n    -- See why we need 'fixWindows': https://ghc.haskell.org/trac/ghc/ticket/16073\n    let fixWindows path = do\n            win <- windowsHost\n            version  <- setting GhcVersion\n            hostOs   <- cabalOsString <$> setting BuildOs\n            hostArch <- cabalArchString <$> setting BuildArch\n            let dir = hostArch ++ \"-\" ++ hostOs ++ \"-ghc-\" ++ version\n            return $ if win then path -/- \"../..\" -/- dir else path\n    pkgDbPath <- fixWindows =<< packageDbPath stage\n    let dir = pkgDbPath -/- takeBaseName conf\n    files <- liftIO $ getDirectoryFilesIO \".\" [dir -/- \"**\"]\n    produces files\n\ncopyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()\ncopyConf rs context@Context {..} conf = do\n    depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $\n        target context (GhcPkg Dependencies stage) [pkgName package] []\n    need =<< mapM (\\pkgId -> packageDbPath stage <&> (-/- pkgId <.> \"conf\")) depPkgIds\n    -- We should unregister if the file exists since @ghc-pkg@ will complain\n    -- about existing package: https://github.com/snowleopard/hadrian/issues/543.\n    -- Also, we don't always do the unregistration + registration to avoid\n    -- repeated work after a full build.\n    -- We do not track 'doesFileExist' since we are going to create the file if\n    -- it is currently missing. TODO: Is this the right thing to do?\n    -- See https://github.com/snowleopard/hadrian/issues/569.\n    unlessM (liftIO $ IO.doesFileExist conf) $ do\n        buildWithResources rs $\n            target context (GhcPkg Unregister stage) [pkgName package] []\n        buildWithResources rs $\n            target context (GhcPkg Copy stage) [pkgName package] [conf]\n  where\n    stdOutToPkgIds :: String -> [String]\n    stdOutToPkgIds = drop 1 . concatMap words . lines\n\ngetPackageNameFromConfFile :: FilePath -> Action String\ngetPackageNameFromConfFile conf\n    | takeBaseName conf == \"rts\" = return \"rts\"\n    | otherwise = case parseCabalName (takeBaseName conf) of\n        Left err -> error $ \"getPackageNameFromConfFile: Couldn't parse \" ++\n                            takeBaseName conf ++ \": \" ++ err\n        Right (name, _) -> return name\n\nparseCabalName :: String -> Either String (String, Version)\nparseCabalName = fmap f . Cabal.eitherParsec\n  where\n    f :: Cabal.PackageId -> (String, Version)\n    f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id)\n", "num_lines": 170}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule Rules.Selftest (selftestRules) where\n\nimport Hadrian.Haskell.Cabal\nimport Test.QuickCheck\n\nimport Base\nimport Context\nimport Oracles.ModuleFiles\nimport Oracles.Setting\nimport Packages\nimport Settings\nimport Target\nimport Utilities\n\nimport qualified System.FilePath.Posix as Posix ((</>))\n\ninstance Arbitrary Way where\n    arbitrary = wayFromUnits <$> arbitrary\n\ninstance Arbitrary WayUnit where\n    arbitrary = arbitraryBoundedEnum\n\ntest :: Testable a => a -> Action ()\ntest = liftIO . quickCheck\n\nselftestRules :: Rules ()\nselftestRules =\n    \"selftest\" ~> do\n        testBuilder\n        testChunksOfSize\n        testDependencies\n        testLookupAll\n        testModuleName\n        testPackages\n        testPaths\n        testWay\n\ntestBuilder :: Action ()\ntestBuilder = do\n    putBuild \"==== trackArgument\"\n    let make = target undefined (Make undefined) undefined undefined\n    test $ forAll (elements [\"-j\", \"MAKEFLAGS=-j\", \"THREADS=\"])\n         $ \\prefix (NonNegative n) ->\n            not (trackArgument make prefix) &&\n            not (trackArgument make (\"-j\" ++ show (n :: Int)))\n\ntestChunksOfSize :: Action ()\ntestChunksOfSize = do\n    putBuild \"==== chunksOfSize\"\n    test $ chunksOfSize 3 [  \"a\", \"b\", \"c\" ,  \"defg\" ,  \"hi\" ,  \"jk\"  ]\n                       == [ [\"a\", \"b\", \"c\"], [\"defg\"], [\"hi\"], [\"jk\"] ]\n    test $ \\n xs ->\n        let res = chunksOfSize n xs\n        in concat res == xs && all (\\r -> length r == 1 || length (concat r) <= n) res\n\ntestDependencies :: Action ()\ntestDependencies = do\n    putBuild \"==== pkgDependencies\"\n    let pkgs = ghcPackages \\\\ [libffi] -- @libffi@ does not have a Cabal file.\n    depLists <- mapM pkgDependencies pkgs\n    test $ and [ deps == sort deps | deps <- depLists ]\n    putBuild \"==== Dependencies of the 'ghc-bin' binary\"\n    ghcDeps <- pkgDependencies ghc\n    test $ pkgName compiler `elem` ghcDeps\n    stage0Deps <- contextDependencies (vanillaContext Stage0 ghc)\n    stage1Deps <- contextDependencies (vanillaContext Stage1 ghc)\n    stage2Deps <- contextDependencies (vanillaContext Stage2 ghc)\n    test $ vanillaContext Stage0 compiler `notElem` stage1Deps\n    test $ vanillaContext Stage1 compiler `elem`    stage1Deps\n    test $ vanillaContext Stage2 compiler `notElem` stage1Deps\n    test $ stage1Deps /= stage0Deps\n    test $ stage1Deps == stage2Deps\n\ntestLookupAll :: Action ()\ntestLookupAll = do\n    putBuild \"==== lookupAll\"\n    test $ lookupAll [\"b\"    , \"c\"            ] [(\"a\", 1), (\"c\", 3), (\"d\", 4)]\n                  == [Nothing, Just (3 :: Int)]\n    test $ forAll dicts $ \\dict -> forAll extras $ \\extra ->\n        let items = sort $ map fst dict ++ extra\n        in lookupAll items (sort dict) == map (`lookup` dict) items\n  where\n    dicts :: Gen [(Int, Int)]\n    dicts = nubBy (\\x y -> fst x == fst y) <$> vector 20\n    extras :: Gen [Int]\n    extras = vector 20\n\ntestModuleName :: Action ()\ntestModuleName = do\n    putBuild \"==== Encode/decode module name\"\n    test $ encodeModule \"Data/Functor\" \"Identity.hs\" == \"Data.Functor.Identity\"\n    test $ encodeModule \"\" \"Prelude\"                 == \"Prelude\"\n\n    test $ decodeModule \"Data.Functor.Identity\" == (\"Data/Functor\", \"Identity\")\n    test $ decodeModule \"Prelude\"               == (\"\", \"Prelude\")\n\n    test $ forAll names $ \\n -> uncurry encodeModule (decodeModule n) == n\n  where\n    names = intercalate \".\" <$> listOf1 (listOf1 $ elements \"abcABC123_'\")\n\ntestPackages :: Action ()\ntestPackages = do\n    putBuild \"==== Check system configuration\"\n    win <- windowsHost -- This depends on the @boot@ and @configure@ scripts.\n    putBuild \"==== Packages, interpretInContext, configuration flags\"\n    forM_ [Stage0 ..] $ \\stage -> do\n        pkgs <- stagePackages stage\n        when (win32 `elem` pkgs) . test $ win\n        when (unix  `elem` pkgs) . test $ not win\n        test $ pkgs == nubOrd pkgs\n\ntestWay :: Action ()\ntestWay = do\n    putBuild \"==== Read Way, Show Way\"\n    test $ \\(x :: Way) -> read (show x) == x\n\ntestPaths :: Action ()\ntestPaths = do\n    putBuild \"==== Absolute, Relative Path Concatenation\"\n    test $ forAll paths $ \\(path1, path2) ->\n      path1 -/- path2 == path1 Posix.</> path2\n  where\n    paths = (,) <$> path <*> path\n    path = frequency [(1, relativePath), (1, absolutePath)]\n    relativePath = intercalate \"/\" <$> listOf1 (elements [\"a\"])\n    absolutePath = ('/':) <$> relativePath\n", "num_lines": 128}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.SimpleTargets (simplePackageTargets) where\n\nimport Base\nimport Context\nimport Packages\nimport Settings\n\nimport Data.Foldable\n\n-- | Simple aliases for library and executable targets.\n--\n--  - @stage<N>:lib:<name>@ will build library @name@ with\n--    the stage N compiler, putting the result under\n--    @<build root>/stage<N>/lib@.\n--  - @stage<N>:exe:<name>@ will build executable @name@\n--    with the stage N-1 compiler, putting the result under\n--    @<build root>/stage<N-1>/bin.\nsimplePackageTargets :: Rules ()\nsimplePackageTargets = traverse_ simpleTarget targets\n\n  where targets = [ (stage, target)\n                  | stage <- [minBound..maxBound]\n                  , target <- knownPackages\n                  ]\n\nsimpleTarget :: (Stage, Package) -> Rules ()\nsimpleTarget (stage, target) = do\n  let tgt = intercalate \":\" [stagestr, typ, pkgname]\n  tgt ~> do\n    p <- getTargetPath stage target\n    need [ p ]\n\n  where typ = if isLibrary target then \"lib\" else \"exe\"\n        stagestr = stageString stage\n        pkgname = pkgName target\n\ngetTargetPath :: Stage -> Package -> Action FilePath\ngetTargetPath stage pkg\n  | isLibrary pkg = getLibraryPath stage pkg\n  | otherwise     = getProgramPath stage pkg\n\ngetLibraryPath :: Stage -> Package -> Action FilePath\ngetLibraryPath stage pkg = pkgConfFile (vanillaContext stage pkg)\n\ngetProgramPath :: Stage -> Package -> Action FilePath\ngetProgramPath Stage0 _ =\n  error (\"Cannot build a stage 0 executable target: \" ++\n         \"it is the boot compiler's toolchain\")\ngetProgramPath stage pkg = programPath (vanillaContext (pred stage) pkg)\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.SourceDist (sourceDistRules) where\n\nimport Hadrian.Oracles.DirectoryContents\n\nimport Base\nimport Builder\nimport Oracles.Setting\nimport Rules.Clean\n\nsourceDistRules :: Rules ()\nsourceDistRules = do\n    \"source-dist\" ~> do\n        -- We clean the source tree first.\n        -- See https://github.com/snowleopard/hadrian/issues/384.\n        -- TODO: Do we still need to clean the tree?\n        cleanSourceTree\n        version <- setting ProjectVersion\n        need [\"sdistprep/ghc-\" ++ version ++ \"-src.tar.xz\"]\n        putSuccess \"| Done\"\n    \"sdistprep/ghc-*-src.tar.xz\" %> \\fname -> do\n        let tarName   = takeFileName fname\n            dropTarXz = dropExtension . dropExtension\n            treePath  = \"sdistprep/ghc\" -/- dropTarXz tarName\n        prepareTree treePath\n        runBuilderWithCmdOptions [Cwd \"sdistprep/ghc\"] (Tar Create)\n            [\"cJf\", \"..\" -/- tarName,  dropTarXz tarName]\n            [\"cJf\", \"..\" -/- tarName] [dropTarXz tarName]\n    \"GIT_COMMIT_ID\" %> \\fname ->\n        writeFileChanged fname =<< setting ProjectGitCommitId\n    \"VERSION\" %> \\fname ->\n        writeFileChanged fname =<< setting ProjectVersion\n\nprepareTree :: FilePath -> Action ()\nprepareTree dest = do\n    mapM_ cpDir  srcDirs\n    mapM_ cpFile srcFiles\n  where\n    cpFile a = copyFile a (dest -/- a)\n    cpDir  a = copyDirectoryContents (Not excluded) a (dest -/- a)\n    excluded = Or\n        [ Test \"//.*\"\n        , Test \"//#*\"\n        , Test \"//*-SAVE\"\n        , Test \"//*.orig\"\n        , Test \"//*.rej\"\n        , Test \"//*~\"\n        , Test \"//autom4te*\"\n        , Test \"//dist\"\n        , Test \"//dist-install\"\n        , Test \"//log\"\n        , Test \"//stage0\"\n        , Test \"//stage1\"\n        , Test \"//stage2\"\n        , Test \"//stage3\"\n        , Test \"hadrian/.cabal-sandbox\"\n        , Test \"hadrian/.stack-work\"\n        , Test \"hadrian/UserSettings.hs\"\n        , Test \"hadrian/cabal.sandbox.config\"\n        , Test \"hadrian/cfg/system.config\"\n        , Test \"hadrian/bin\"\n        , Test \"hadrian/dist\"\n        , Test \"hadrian/dist-newstyle\"\n        , Test \"libraries//*.buildinfo\"\n        , Test \"libraries//GNUmakefile\"\n        , Test \"libraries//config.log\"\n        , Test \"libraries//config.status\"\n        , Test \"libraries//configure\"\n        , Test \"libraries//ghc.mk\"\n        , Test \"libraries//include/Hs*Config.h\"\n        , Test \"libraries/dph\"\n        , Test \"libraries/primitive\"\n        , Test \"libraries/random\"\n        , Test \"libraries/stm\"\n        , Test \"libraries/vector\"\n        , Test \"mk/build.mk\" ]\n    srcDirs =\n        [ \"bindisttest\"\n        , \"compiler\"\n        , \"distrib\"\n        , \"docs\"\n        , \"docs\"\n        , \"driver\"\n        , \"ghc\"\n        , \"hadrian\"\n        , \"includes\"\n        , \"iserv\"\n        , \"libffi\"\n        , \"libffi-tarballs\"\n        , \"libraries\"\n        , \"mk\"\n        , \"rts\"\n        , \"rules\"\n        , \"utils\" ]\n    srcFiles =\n        [ \"ANNOUNCE\"\n        , \"GIT_COMMIT_ID\"\n        , \"HACKING.md\"\n        , \"INSTALL.md\"\n        , \"LICENSE\"\n        , \"MAKEHELP.md\"\n        , \"Makefile\"\n        , \"README.md\"\n        , \"VERSION\"\n        , \"aclocal.m4\"\n        , \"boot\"\n        , \"config.guess\"\n        , \"config.sub\"\n        , \"configure\"\n        , \"configure.ac\"\n        , \"ghc.mk\"\n        , \"install-sh\"\n        , \"packages\"\n        , \"settings.in\" ]\n", "num_lines": 114}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules.Test (testRules) where\n\nimport System.Environment\n\nimport Base\nimport Expression\nimport Oracles.Setting\nimport Packages\nimport Settings\nimport Settings.Default\nimport Settings.Builders.RunTest\nimport Target\nimport Utilities\n\nghcConfigHsPath :: FilePath\nghcConfigHsPath = \"testsuite/mk/ghc-config.hs\"\n\nghcConfigProgPath :: FilePath\nghcConfigProgPath = \"test/bin/ghc-config\"\n\nghcConfigPath :: FilePath\nghcConfigPath = \"test/ghcconfig\"\n\n-- TODO: clean up after testing\ntestRules :: Rules ()\ntestRules = do\n    root <- buildRootRules\n\n    -- Using program shipped with testsuite to generate ghcconfig file.\n    root -/- ghcConfigProgPath ~> do\n        ghc <- builderPath $ Ghc CompileHs Stage0\n        createDirectory $ takeDirectory (root -/- ghcConfigProgPath)\n        cmd ghc [ghcConfigHsPath, \"-o\" , root -/- ghcConfigProgPath]\n\n    -- TODO : Use input test compiler and not just stage2 compiler.\n    root -/- ghcConfigPath ~> do\n        ghcPath <- needFile Stage1 ghc\n        need [root -/- ghcConfigProgPath]\n        cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)\n            [ghcPath]\n\n    root -/- timeoutPath ~> timeoutProgBuilder\n\n    \"validate\" ~> do\n        needTestBuilders\n        build $ target (vanillaContext Stage2 compiler) (Make \"testsuite/tests\") [] []\n\n    \"test\" ~> do\n        needTestBuilders\n\n        -- TODO : Should we remove the previosly generated config file?\n        -- Prepare Ghc configuration file for input compiler.\n        need [root -/- ghcConfigPath, root -/- timeoutPath]\n\n        -- TODO This approach doesn't work.\n        -- Set environment variables for test's Makefile.\n        env <- sequence\n            [ builderEnvironment \"MAKE\" $ Make \"\"\n            , builderEnvironment \"TEST_HC\" $ Ghc CompileHs Stage2\n            , AddEnv \"TEST_HC_OPTS\" <$> runTestGhcFlags ]\n\n        makePath        <- builderPath $ Make \"\"\n        top             <- topDirectory\n        ghcPath         <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)\n        ghcFlags        <- runTestGhcFlags\n        checkPprPath    <- (top -/-) <$> needFile Stage1 checkPpr\n        annotationsPath <- (top -/-) <$> needFile Stage1 checkApiAnnotations\n\n        -- Set environment variables for test's Makefile.\n        liftIO $ do\n            setEnv \"MAKE\" makePath\n            setEnv \"TEST_HC\" ghcPath\n            setEnv \"TEST_HC_OPTS\" ghcFlags\n            setEnv \"CHECK_PPR\" checkPprPath\n            setEnv \"CHECK_API_ANNOTATIONS\" annotationsPath\n\n        -- Execute the test target.\n        -- We override the verbosity setting to make sure the user can see\n        -- the test output: https://ghc.haskell.org/trac/ghc/ticket/15951.\n        withVerbosity Loud $ buildWithCmdOptions env $\n            target (vanillaContext Stage2 compiler) RunTest [] []\n\n-- | Build extra programs and libraries required by testsuite\nneedTestsuitePackages :: Action ()\nneedTestsuitePackages = do\n    targets   <- mapM (needFile Stage1) =<< testsuitePackages\n    -- iserv is not supported under Windows\n    windows <- windowsHost\n    when (not windows) needIservBins\n    need targets\n\n-- | Build the timeout program.\n-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23\ntimeoutProgBuilder :: Action ()\ntimeoutProgBuilder = do\n    root    <- buildRoot\n    windows <- windowsHost\n    if windows\n        then do\n            prog <- programPath =<< programContext Stage1 timeout\n            copyFile prog (root -/- timeoutPath)\n        else do\n            python <- builderPath Python\n            copyFile \"testsuite/timeout/timeout.py\" (root -/- timeoutPath <.> \"py\")\n            let script = unlines\n                    [ \"#!/usr/bin/env sh\"\n                    , \"exec \" ++ python ++ \" $0.py \\\"$@\\\"\" ]\n            writeFile' (root -/- timeoutPath) script\n            makeExecutable (root -/- timeoutPath)\n\nneedIservBins :: Action ()\nneedIservBins = do\n    rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays\n    need =<< traverse programPath\n               [ Context Stage1 iserv w\n               | w <- [vanilla, profiling, dynamic]\n               , w `elem` rtsways\n               ]\n\nneedTestBuilders :: Action ()\nneedTestBuilders = do\n    needBuilder $ Ghc CompileHs Stage2\n    needBuilder $ GhcPkg Update Stage1\n    needBuilder Hpc\n    needBuilder $ Hsc2Hs Stage1\n    needTestsuitePackages\n\nneedFile :: Stage -> Package -> Action FilePath\nneedFile stage pkg\n-- TODO (Alp): we might sometimes need more than vanilla!\n-- This should therefore depend on what test ways\n-- we are going to use, I suppose?\n    | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)\n    | otherwise     = programPath =<< programContext stage pkg\n", "num_lines": 135}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Default (\n    -- * Packages that are build by default and for the testsuite\n    defaultPackages, testsuitePackages,\n\n    -- * Default build ways\n    defaultLibraryWays, defaultRtsWays,\n\n    -- * Default command line arguments for various builders\n    SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,\n    defaultArgs,\n\n    -- * Default build flavour\n    defaultFlavour\n    ) where\n\nimport qualified Hadrian.Builder.Ar\nimport qualified Hadrian.Builder.Sphinx\nimport qualified Hadrian.Builder.Tar\nimport Hadrian.Haskell.Cabal.Type\n\nimport CommandLine\nimport Expression\nimport Flavour\nimport Oracles.Flag\nimport Oracles.Setting\nimport Packages\nimport Settings\nimport Settings.Builders.Alex\nimport Settings.Builders.DeriveConstants\nimport Settings.Builders.Cabal\nimport Settings.Builders.Cc\nimport Settings.Builders.Configure\nimport Settings.Builders.GenPrimopCode\nimport Settings.Builders.Ghc\nimport Settings.Builders.GhcPkg\nimport Settings.Builders.Haddock\nimport Settings.Builders.Happy\nimport Settings.Builders.Hsc2Hs\nimport Settings.Builders.HsCpp\nimport Settings.Builders.Ld\nimport Settings.Builders.Make\nimport Settings.Builders.RunTest\nimport Settings.Builders.Xelatex\nimport Settings.Packages\nimport Settings.Warnings\n\n-- | Packages that are built by default. You can change this in \"UserSettings\".\ndefaultPackages :: Stage -> Action [Package]\ndefaultPackages Stage0 = stage0Packages\ndefaultPackages Stage1 = stage1Packages\ndefaultPackages Stage2 = stage2Packages\ndefaultPackages Stage3 = return []\n\n-- | Packages built in 'Stage0' by default. You can change this in \"UserSettings\".\nstage0Packages :: Action [Package]\nstage0Packages = do\n    win <- windowsHost\n    cross <- flag CrossCompiling\n    return $ [ binary\n             , cabal\n             , compareSizes\n             , compiler\n             , deriveConstants\n             , genapply\n             , genprimopcode\n             , ghc\n             , ghcBoot\n             , ghcBootTh\n             , ghcHeap\n             , ghci\n             , ghcPkg\n             , hsc2hs\n             , hpc\n             , mtl\n             , parsec\n             , templateHaskell\n             , text\n             , transformers\n             , unlit                         ]\n          ++ [ terminfo | not win, not cross ]\n          ++ [ touchy   | win                ]\n\n-- | Packages built in 'Stage1' by default. You can change this in \"UserSettings\".\nstage1Packages :: Action [Package]\nstage1Packages = do\n    win        <- windowsHost\n    intLib     <- integerLibrary =<< flavour\n    libraries0 <- filter isLibrary <$> stage0Packages\n    cross      <- flag CrossCompiling\n    return $ libraries0 -- Build all Stage0 libraries in Stage1\n          ++ [ array\n             , base\n             , bytestring\n             , containers\n             , deepseq\n             , directory\n             , filepath\n             , ghc\n             , ghcCompact\n             , ghcPkg\n             , ghcPrim\n             , haskeline\n             , hsc2hs\n             , intLib\n             , pretty\n             , process\n             , rts\n             , stm\n             , time\n             , unlit\n             , xhtml                     \n             ]\n          ++ [ haddock | not cross           ]\n          ++ [ hpcBin   | not cross          ]\n          ++ [ iserv    | not win, not cross ]\n          ++ [ libiserv | not win, not cross ]\n          ++ [ runGhc   | not cross          ]\n          ++ [ touchy   | win                ]\n          ++ [ unix     | not win            ]\n          ++ [ win32    | win                ]\n\n-- | Packages built in 'Stage2' by default. You can change this in \"UserSettings\".\nstage2Packages :: Action [Package]\nstage2Packages = stage1Packages\n\n-- | Packages that are built only for the testsuite.\ntestsuitePackages :: Action [Package]\ntestsuitePackages = do\n    win <- windowsHost\n    return $ [ checkApiAnnotations\n             , checkPpr\n             , ghci\n             , ghcCompact\n             , ghcPkg\n             , hp2ps\n             , hsc2hs\n             , iserv\n             , runGhc\n             , unlit         ] ++\n             [ timeout | win ]\n\n-- | Default build ways for library packages:\n-- * We always build 'vanilla' way.\n-- * We build 'profiling' way when stage > Stage0.\n-- * We build 'dynamic' way when stage > Stage0 and the platform supports it.\ndefaultLibraryWays :: Ways\ndefaultLibraryWays = mconcat\n    [ pure [vanilla]\n    , notStage0 ? pure [profiling]\n    , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]\n    ]\n\n-- | Default build ways for the RTS.\ndefaultRtsWays :: Ways\ndefaultRtsWays = mconcat\n  [ pure [vanilla, threaded]\n  , notStage0 ? pure\n      [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling\n      , logging, threadedLogging\n      , debug, threadedDebug\n      ]\n  , notStage0 ? platformSupportsSharedLibs ? pure\n      [ dynamic, threadedDynamic, debugDynamic, loggingDynamic\n      , threadedDebugDynamic, threadedLoggingDynamic\n      ]\n  ]\n\n-- TODO: Move C source arguments here\n-- | Default and package-specific source arguments.\ndata SourceArgs = SourceArgs\n    { hsDefault  :: Args\n    , hsLibrary  :: Args\n    , hsCompiler :: Args\n    , hsGhc      :: Args }\n\n-- | Concatenate source arguments in appropriate order.\nsourceArgs :: SourceArgs -> Args\nsourceArgs SourceArgs {..} = builder Ghc ? mconcat\n    [ hsDefault\n    , getContextData hcOpts\n    , libraryPackage   ? hsLibrary\n    , package compiler ? hsCompiler\n    , package ghc      ? hsGhc ]\n\n-- | All default command line arguments.\ndefaultArgs :: Args\ndefaultArgs = mconcat\n    [ defaultBuilderArgs\n    , sourceArgs defaultSourceArgs\n    , defaultPackageArgs ]\n\n-- | Default source arguments, e.g. optimisation settings.\ndefaultSourceArgs :: SourceArgs\ndefaultSourceArgs = SourceArgs\n    { hsDefault  = mconcat [ stage0    ? arg \"-O\"\n                           , notStage0 ? arg \"-O2\"\n                           , arg \"-H32m\" ]\n    , hsLibrary  = mempty\n    , hsCompiler = mempty\n    , hsGhc      = mempty }\n\n-- Please update doc/flavours.md when changing the default build flavour.\n-- | Default build flavour. Other build flavours are defined in modules\n-- @Settings.Flavours.*@. Users can add new build flavours in \"UserSettings\".\ndefaultFlavour :: Flavour\ndefaultFlavour = Flavour\n    { name               = \"default\"\n    , args               = defaultArgs\n    , packages           = defaultPackages\n    , integerLibrary     = (\\x -> if x then integerSimple else integerGmp) <$> cmdIntegerSimple\n    , libraryWays        = defaultLibraryWays\n    , rtsWays            = defaultRtsWays\n    , dynamicGhcPrograms = defaultDynamicGhcPrograms\n    , ghciWithDebugger   = False\n    , ghcProfiled        = False\n    , ghcDebugged        = False\n    , ghcDocs            = cmdDocsArgs }\n\n-- | Default logic for determining whether to build\n--   dynamic GHC programs.\n--\n--   It corresponds to the DYNAMIC_GHC_PROGRAMS logic implemented\n--   in @mk/config.mk.in@.\ndefaultDynamicGhcPrograms :: Action Bool\ndefaultDynamicGhcPrograms = do\n  win <- windowsHost\n  supportsShared <- platformSupportsSharedLibs\n  return (not win && supportsShared)\n\n-- | All 'Builder'-dependent command line arguments.\ndefaultBuilderArgs :: Args\ndefaultBuilderArgs = mconcat\n    -- GHC-specific builders:\n    [ alexBuilderArgs\n    , cabalBuilderArgs\n    , ccBuilderArgs\n    , configureBuilderArgs\n    , deriveConstantsBuilderArgs\n    , genPrimopCodeBuilderArgs\n    , ghcBuilderArgs\n    , ghcPkgBuilderArgs\n    , haddockBuilderArgs\n    , happyBuilderArgs\n    , hsc2hsBuilderArgs\n    , hsCppBuilderArgs\n    , ldBuilderArgs\n    , makeBuilderArgs\n    , runTestBuilderArgs\n    , validateBuilderArgs\n    , xelatexBuilderArgs\n    -- Generic builders from the Hadrian library:\n    , builder (Ar Pack     ) ? Hadrian.Builder.Ar.args Pack\n    , builder (Ar Unpack   ) ? Hadrian.Builder.Ar.args Unpack\n    , builder (Sphinx Html ) ? Hadrian.Builder.Sphinx.args Html\n    , builder (Sphinx Latex) ? Hadrian.Builder.Sphinx.args Latex\n    , builder (Sphinx Man  ) ? Hadrian.Builder.Sphinx.args Man\n    , builder (Tar Create  ) ? Hadrian.Builder.Tar.args Create\n    , builder (Tar Extract ) ? Hadrian.Builder.Tar.args Extract ]\n\n-- | All 'Package'-dependent command line arguments.\ndefaultPackageArgs :: Args\ndefaultPackageArgs = mconcat [ packageArgs\n                             , builder Ghc ? ghcWarningsArgs ]\n", "num_lines": 264}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Packages (packageArgs) where\n\nimport Expression\nimport Flavour\nimport Oracles.Setting\nimport Oracles.Flag\nimport Packages\nimport Rules.Gmp\nimport Settings\n\n-- | Package-specific command-line arguments.\npackageArgs :: Args\npackageArgs = do\n    stage        <- getStage\n    rtsWays      <- getRtsWays\n    path         <- getBuildPath\n    intLib       <- getIntegerPackage\n    compilerPath <- expr $ buildPath (vanillaContext stage compiler)\n    gmpBuildPath <- expr gmpBuildPath\n    let includeGmp = \"-I\" ++ gmpBuildPath -/- \"include\"\n\n    mconcat\n        --------------------------------- base ---------------------------------\n        [ package base ? mconcat\n          [ builder (Cabal Flags) ? notStage0 ? arg (pkgName intLib)\n\n          -- This fixes the 'unknown symbol stat' issue.\n          -- See: https://github.com/snowleopard/hadrian/issues/259.\n          , builder (Ghc CompileCWithGhc) ? arg \"-optc-O2\" ]\n\n        ------------------------------ bytestring ------------------------------\n        , package bytestring ?\n          builder (Cabal Flags) ? intLib == integerSimple ? arg \"integer-simple\"\n\n        --------------------------------- cabal --------------------------------\n        -- Cabal is a large library and slow to compile. Moreover, we build it\n        -- for Stage0 only so we can link ghc-pkg against it, so there is little\n        -- reason to spend the effort to optimise it.\n        , package cabal ?\n          stage0 ? builder Ghc ? arg \"-O0\"\n\n        ------------------------------- compiler -------------------------------\n        , package compiler ? mconcat\n          [ builder Alex ? arg \"--latin1\"\n\n          , builder (Ghc CompileHs) ? mconcat\n            [ inputs [\"//GHC.hs\", \"//GhcMake.hs\"] ? arg \"-fprof-auto\"\n            , input \"//Parser.hs\" ?\n              pure [\"-fno-ignore-interface-pragmas\", \"-fcmm-sink\" ] ]\n\n          , builder (Cabal Setup) ? mconcat\n            [ arg $ \"--ghc-option=-DSTAGE=\" ++ show (fromEnum stage + 1)\n            , arg \"--disable-library-for-ghci\"\n            , anyTargetOs [\"openbsd\"] ? arg \"--ld-options=-E\"\n            , flag GhcUnregisterised ? arg \"--ghc-option=-DNO_REGS\"\n            , notM ghcWithSMP ? arg \"--ghc-option=-DNOSMP\"\n            , notM ghcWithSMP ? arg \"--ghc-option=-optc-DNOSMP\"\n            , (any (wayUnit Threaded) rtsWays) ?\n              notStage0 ? arg \"--ghc-option=-optc-DTHREADED_RTS\"\n            , ghcWithInterpreter ?\n              ghcEnableTablesNextToCode ?\n              notM (flag GhcUnregisterised) ?\n              notStage0 ? arg \"--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE\"\n            , ghcWithInterpreter ?\n              ghciWithDebugger <$> flavour ?\n              notStage0 ? arg \"--ghc-option=-DDEBUGGER\"\n            , ghcProfiled <$> flavour ?\n              notStage0 ? arg \"--ghc-pkg-option=--force\" ]\n\n         , builder (Cabal Flags) ? mconcat\n            [ ghcWithNativeCodeGen ? arg \"ncg\"\n            , ghcWithInterpreter ? notStage0 ? arg \"ghci\"\n            , flag CrossCompiling ? arg \"-terminfo\"\n            , notStage0 ? intLib == integerGmp ?\n              arg \"integer-gmp\"\n            , notStage0 ? intLib == integerSimple ?\n              arg \"integer-simple\" ]\n\n          , builder (Haddock BuildPackage) ? arg (\"--optghc=-I\" ++ path) ]\n\n        ---------------------------------- ghc ---------------------------------\n        , package ghc ? mconcat\n          [ builder Ghc ? arg (\"-I\" ++ compilerPath)\n\n          , builder (Cabal Flags) ? mconcat\n            [ ghcWithInterpreter ? notStage0 ? arg \"ghci\"\n            , flag CrossCompiling ? arg \"-terminfo\"\n            -- the 'threaded' flag is True by default, but\n            -- let's record explicitly that we link all ghc\n            -- executables with the threaded runtime.\n            , arg \"threaded\" ] ]\n\n        -------------------------------- ghcPkg --------------------------------\n        , package ghcPkg ?\n          builder (Cabal Flags) ? flag CrossCompiling ? arg \"-terminfo\"\n\n        -------------------------------- ghcPrim -------------------------------\n        , package ghcPrim ? mconcat\n          [ builder (Cabal Flags) ? arg \"include-ghc-prim\"\n\n          , builder (Cc CompileC) ? (not <$> flag GccIsClang) ?\n            input \"//cbits/atomic.c\"  ? arg \"-Wno-sync-nand\" ]\n\n        --------------------------------- ghci ---------------------------------\n        -- TODO: This should not be @not <$> flag CrossCompiling@. Instead we\n        -- should ensure that the bootstrap compiler has the same version as the\n        -- one we are building.\n\n        -- TODO: In that case we also do not need to build most of the Stage1\n        -- libraries, as we already know that the compiler comes with the most\n        -- recent versions.\n\n        -- TODO: The use case here is that we want to build @ghc-proxy@ for the\n        -- cross compiler. That one needs to be compiled by the bootstrap\n        -- compiler as it needs to run on the host. Hence @libiserv@ needs\n        -- @GHCi.TH@, @GHCi.Message@ and @GHCi.Run@ from @ghci@. And those are\n        -- behind the @-fghci@ flag.\n        , package ghci ? mconcat\n          [ notStage0 ? builder (Cabal Flags) ? arg \"ghci\"\n          , flag CrossCompiling ? stage0 ? builder (Cabal Flags) ? arg \"ghci\" ]\n\n        -------------------------------- haddock -------------------------------\n        , package haddock ?\n          builder (Cabal Flags) ? arg \"in-ghc-tree\"\n\n        ------------------------------- haskeline ------------------------------\n        , package haskeline ?\n          builder (Cabal Flags) ? flag CrossCompiling ? arg \"-terminfo\"\n\n        -------------------------------- hsc2hs --------------------------------\n        , package hsc2hs ?\n          builder (Cabal Flags) ? arg \"in-ghc-tree\"\n\n        ------------------------------ integerGmp ------------------------------\n        , package integerGmp ? mconcat\n          [ builder Cc ? arg includeGmp\n\n          , builder (Cabal Setup) ? mconcat\n            [ flag GmpInTree ? arg \"--configure-option=--with-intree-gmp\"\n            -- Windows is always built with inplace GMP until we have dynamic\n            -- linking working.\n            , windowsHost  ? arg \"--configure-option=--with-intree-gmp\"\n            , flag GmpFrameworkPref ?\n              arg \"--configure-option=--with-gmp-framework-preferred\"\n            , arg (\"--configure-option=CFLAGS=\" ++ includeGmp)\n            , arg (\"--gcc-options=\"             ++ includeGmp) ] ]\n\n        ---------------------------------- rts ---------------------------------\n        , package rts ? rtsPackageArgs -- RTS deserves a separate function\n\n        -------------------------------- runGhc --------------------------------\n        , package runGhc ?\n          builder Ghc ? input \"//Main.hs\" ?\n          (\\version -> [\"-cpp\", \"-DVERSION=\" ++ show version]) <$> getSetting ProjectVersion\n\n        --------------------------------- text ---------------------------------\n        -- The package @text@ is rather tricky. It's a boot library, and it\n        -- tries to determine on its own if it should link against @integer-gmp@\n        -- or @integer-simple@. For Stage0, we need to use the integer library\n        -- that the bootstrap compiler has (since @interger@ is not a boot\n        -- library) and therefore we copy it over into the Stage0 package-db.\n        -- Maybe we should stop doing this? And subsequently @text@ for Stage1\n        -- detects the same integer library again, even though we don't build it\n        -- in Stage1, and at that point the configuration is just wrong.\n        , package text ?\n          builder (Cabal Flags) ? notStage0 ? intLib == integerSimple ?\n          pure [ \"+integer-simple\", \"-bytestring-builder\"] ]\n\n-- | RTS-specific command line arguments.\nrtsPackageArgs :: Args\nrtsPackageArgs = package rts ? do\n    projectVersion <- getSetting ProjectVersion\n    hostPlatform   <- getSetting HostPlatform\n    hostArch       <- getSetting HostArch\n    hostOs         <- getSetting HostOs\n    hostVendor     <- getSetting HostVendor\n    buildPlatform  <- getSetting BuildPlatform\n    buildArch      <- getSetting BuildArch\n    buildOs        <- getSetting BuildOs\n    buildVendor    <- getSetting BuildVendor\n    targetPlatform <- getSetting TargetPlatform\n    targetArch     <- getSetting TargetArch\n    targetOs       <- getSetting TargetOs\n    targetVendor   <- getSetting TargetVendor\n    ghcUnreg       <- expr $ yesNo <$> flag GhcUnregisterised\n    ghcEnableTNC   <- expr $ yesNo <$> ghcEnableTablesNextToCode\n    rtsWays        <- getRtsWays\n    way            <- getWay\n    path           <- getBuildPath\n    top            <- expr topDirectory\n    libffiName     <- expr libffiLibraryName\n    ffiIncludeDir  <- getSetting FfiIncludeDir\n    ffiLibraryDir  <- getSetting FfiLibDir\n    let cArgs = mconcat\n          [ arg \"-Irts\"\n          , rtsWarnings\n          , arg $ \"-I\" ++ path\n          , flag UseSystemFfi ? arg (\"-I\" ++ ffiIncludeDir)\n          , arg $ \"-DRtsWay=\\\"rts_\" ++ show way ++ \"\\\"\"\n          -- Set the namespace for the rts fs functions\n          , arg $ \"-DFS_NAMESPACE=rts\"\n          , arg $ \"-DCOMPILING_RTS\"\n          -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro\n          -- requires that functions are inlined to work as expected. Inlining\n          -- only happens for optimised builds. Otherwise we can assume that\n          -- there is a non-inlined variant to use instead. But RTS does not\n          -- provide non-inlined alternatives and hence needs the function to\n          -- be inlined. See https://github.com/snowleopard/hadrian/issues/90.\n          , arg \"-O2\"\n          , arg \"-fomit-frame-pointer\"\n          , arg \"-g\"\n\n          , Debug     `wayUnit` way          ? pure [ \"-DDEBUG\"\n                                                    , \"-fno-omit-frame-pointer\"\n                                                    , \"-g\" ]\n          , way `elem` [debug, debugDynamic] ? arg \"-DTICKY_TICKY\"\n          , Profiling `wayUnit` way          ? arg \"-DPROFILING\"\n          , Threaded  `wayUnit` way          ? arg \"-DTHREADED_RTS\"\n\n          , inputs [\"//RtsMessages.c\", \"//Trace.c\"] ?\n            arg (\"-DProjectVersion=\" ++ show projectVersion)\n\n          , input \"//RtsUtils.c\" ? pure\n            [ \"-DProjectVersion=\"            ++ show projectVersion\n            , \"-DHostPlatform=\"              ++ show hostPlatform\n            , \"-DHostArch=\"                  ++ show hostArch\n            , \"-DHostOS=\"                    ++ show hostOs\n            , \"-DHostVendor=\"                ++ show hostVendor\n            , \"-DBuildPlatform=\"             ++ show buildPlatform\n            , \"-DBuildArch=\"                 ++ show buildArch\n            , \"-DBuildOS=\"                   ++ show buildOs\n            , \"-DBuildVendor=\"               ++ show buildVendor\n            , \"-DTargetPlatform=\"            ++ show targetPlatform\n            , \"-DTargetArch=\"                ++ show targetArch\n            , \"-DTargetOS=\"                  ++ show targetOs\n            , \"-DTargetVendor=\"              ++ show targetVendor\n            , \"-DGhcUnregisterised=\"         ++ show ghcUnreg\n            , \"-DGhcEnableTablesNextToCode=\" ++ show ghcEnableTNC ]\n\n          -- We're after pur performance here. So make sure fast math and\n          -- vectorization is enabled.\n          , input \"//xxhash.c\" ? pure\n            [ \"-O3\"\n            , \"-ffast-math\"\n            , \"-ftree-vectorize\" ]\n\n            , inputs [\"//Evac.c\", \"//Evac_thr.c\"] ? arg \"-funroll-loops\"\n\n            , speedHack ?\n              inputs [ \"//Evac.c\", \"//Evac_thr.c\"\n                     , \"//Scav.c\", \"//Scav_thr.c\"\n                     , \"//Compact.c\", \"//GC.c\" ] ? arg \"-fno-PIC\"\n            -- @-static@ is necessary for these bits, as otherwise the NCG\n            -- generates dynamic references.\n            , speedHack ?\n              inputs [ \"//Updates.c\", \"//StgMiscClosures.c\"\n                     , \"//PrimOps.c\", \"//Apply.c\"\n                     , \"//AutoApply.c\" ] ? pure [\"-fno-PIC\", \"-static\"]\n\n            -- inlining warnings happen in Compact\n            , inputs [\"//Compact.c\"] ? arg \"-Wno-inline\"\n\n            -- emits warnings about call-clobbered registers on x86_64\n            , inputs [ \"//RetainerProfile.c\", \"//StgCRun.c\"\n                     , \"//win32/ConsoleHandler.c\", \"//win32/ThrIOManager.c\"] ? arg \"-w\"\n            -- The above warning suppression flags are a temporary kludge.\n            -- While working on this module you are encouraged to remove it and fix\n            -- any warnings in the module. See:\n            -- http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings\n\n            , (not <$> flag GccIsClang) ?\n              inputs [\"//Compact.c\"] ? arg \"-finline-limit=2500\"\n\n            , input \"//RetainerProfile.c\" ? flag GccIsClang ?\n              arg \"-Wno-incompatible-pointer-types\"\n            , windowsHost ? arg (\"-DWINVER=\" ++ windowsVersion)\n\n            -- libffi's ffi.h triggers various warnings\n            , inputs [ \"//Interpreter.c\", \"//Storage.c\", \"//Adjustor.c\" ] ?\n              arg \"-Wno-strict-prototypes\"\n            , inputs [\"//Interpreter.c\", \"//Adjustor.c\", \"//sm/Storage.c\"] ?\n              anyTargetArch [\"powerpc\"] ? arg \"-Wno-undef\" ]\n\n    mconcat\n        [ builder (Cabal Flags) ? mconcat\n          [ any (wayUnit Profiling) rtsWays ? arg \"profiling\"\n          , any (wayUnit Debug) rtsWays ? arg \"debug\"\n          , any (wayUnit Logging) rtsWays ? arg \"logging\"\n          , any (wayUnit Dynamic) rtsWays ? arg \"dynamic\"\n          , Debug `wayUnit` way           ? arg \"find-ptr\"\n          ]\n        , builder (Cc FindCDependencies) ? cArgs\n        , builder (Ghc CompileCWithGhc) ? map (\"-optc\" ++) <$> cArgs\n        , builder Ghc ? arg \"-Irts\"\n\n          , builder HsCpp ? pure\n          [ \"-DTOP=\"             ++ show top\n          , \"-DFFI_INCLUDE_DIR=\" ++ show ffiIncludeDir\n          , \"-DFFI_LIB_DIR=\"     ++ show ffiLibraryDir\n          , \"-DFFI_LIB=\"         ++ show libffiName ]\n\n        , builder HsCpp ? flag HaveLibMingwEx ? arg \"-DHAVE_LIBMINGWEX\" ]\n\n-- Compile various performance-critical pieces *without* -fPIC -dynamic\n-- even when building a shared library.  If we don't do this, then the\n-- GC runs about 50% slower on x86 due to the overheads of PIC.  The\n-- cost of doing this is a little runtime linking and less sharing, but\n-- not much.\n--\n-- On x86_64 this doesn't work, because all objects in a shared library\n-- must be compiled with -fPIC (since the 32-bit relocations generated\n-- by the default small memory can't be resolved at runtime).  So we\n-- only do this on i386.\n--\n-- This apparently doesn't work on OS X (Darwin) nor on Solaris.\n-- On Darwin we get errors of the form\n--\n--  ld: absolute addressing (perhaps -mdynamic-no-pic) used in _stg_ap_0_fast\n--      from rts/dist/build/Apply.dyn_o not allowed in slidable image\n--\n-- and lots of these warnings:\n--\n--  ld: warning codegen in _stg_ap_pppv_fast (offset 0x0000005E) prevents image\n--      from loading in dyld shared cache\n--\n-- On Solaris we get errors like:\n--\n-- Text relocation remains                         referenced\n--     against symbol                  offset      in file\n-- .rodata (section)                   0x11        rts/dist/build/Apply.dyn_o\n--   ...\n-- ld: fatal: relocations remain against allocatable but non-writable sections\n-- collect2: ld returned 1 exit status\nspeedHack :: Action Bool\nspeedHack = do\n    i386   <- anyTargetArch [\"i386\"]\n    goodOS <- not <$> anyTargetOs [\"darwin\", \"solaris2\"]\n    return $ i386 && goodOS\n\n-- See @rts/ghc.mk@.\nrtsWarnings :: Args\nrtsWarnings = mconcat\n    [ arg \"-Wall\"\n    , arg \"-Wextra\"\n    , arg \"-Wstrict-prototypes\"\n    , arg \"-Wmissing-prototypes\"\n    , arg \"-Wmissing-declarations\"\n    , arg \"-Winline\"\n    , arg \"-Waggregate-return\"\n    , arg \"-Wpointer-arith\"\n    , arg \"-Wmissing-noreturn\"\n    , arg \"-Wnested-externs\"\n    , arg \"-Wredundant-decls\"\n    , arg \"-Wundef\"\n    , arg \"-fno-strict-aliasing\" ]\n\n-- These numbers can be found at:\n-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx\n-- If we're compiling on windows, enforce that we only support Vista SP1+\n-- Adding this here means it doesn't have to be done in individual .c files\n-- and also centralizes the versioning.\n-- | Minimum supported Windows version.\nwindowsVersion :: String\nwindowsVersion = \"0x06000100\"\n", "num_lines": 365}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Warnings (defaultGhcWarningsArgs, ghcWarningsArgs) where\n\nimport Expression\nimport Oracles.Flag\nimport Oracles.Setting\nimport Packages\nimport Settings\n\n-- See @mk/warnings.mk@ for warning-related arguments in the Make build system.\n\n-- | Default Haskell warning-related arguments.\ndefaultGhcWarningsArgs :: Args\ndefaultGhcWarningsArgs = mconcat\n    [ notStage0 ? arg \"-Wnoncanonical-monad-instances\"\n    , (not <$> flag GccIsClang) ? mconcat\n      [ (not <$> windowsHost ) ? arg \"-optc-Werror=unused-but-set-variable\"\n      , arg \"-optc-Wno-error=inline\" ]\n    , flag GccIsClang ? arg \"-optc-Wno-unknown-pragmas\" ]\n\n-- | Package-specific warnings-related arguments, mostly suppressing various warnings.\nghcWarningsArgs :: Args\nghcWarningsArgs = do\n    isIntegerSimple <- (== integerSimple) <$> getIntegerPackage\n    mconcat\n        [ stage0 ? mconcat\n        [ libraryPackage       ? pure [ \"-fno-warn-deprecated-flags\" ]\n        , package terminfo     ? pure [ \"-fno-warn-unused-imports\" ]\n        , package transformers ? pure [ \"-fno-warn-unused-matches\"\n                                      , \"-fno-warn-unused-imports\" ] ]\n        , notStage0 ? mconcat\n        [ libraryPackage       ? pure [ \"-Wno-deprecated-flags\" ]\n        , package base         ? pure [ \"-Wno-trustworthy-safe\" ]\n        , package binary       ? pure [ \"-Wno-deprecations\" ]\n        , package bytestring   ? pure [ \"-Wno-inline-rule-shadowing\" ]\n        , package compiler     ? pure [ \"-Wcpp-undef\" ]\n        , package directory    ? pure [ \"-Wno-unused-imports\" ]\n        , package ghc          ? pure [ \"-Wcpp-undef\" ]\n        , package ghcPrim      ? pure [ \"-Wno-trustworthy-safe\" ]\n        , package haddock      ? pure [ \"-Wno-unused-imports\"\n                                      , \"-Wno-deprecations\" ]\n        , package haskeline    ? pure [ \"-Wno-deprecations\"\n                                      , \"-Wno-unused-imports\"\n                                      , \"-Wno-redundant-constraints\"\n                                      , \"-Wno-simplifiable-class-constraints\" ]\n        , package pretty       ? pure [ \"-Wno-unused-imports\" ]\n        , package primitive    ? pure [ \"-Wno-unused-imports\"\n                                      , \"-Wno-deprecations\" ]\n        , package rts          ? pure [ \"-Wcpp-undef\" ]\n        , package terminfo     ? pure [ \"-Wno-unused-imports\" ]\n        , isIntegerSimple      ?\n          package text         ? pure [ \"-Wno-unused-imports\" ]\n        , package transformers ? pure [ \"-Wno-unused-matches\"\n                                      , \"-Wno-unused-imports\"\n                                      , \"-Wno-redundant-constraints\"\n                                      , \"-Wno-orphans\" ]\n        , package win32        ? pure [ \"-Wno-trustworthy-safe\" ]\n        , package xhtml        ? pure [ \"-Wno-unused-imports\" ] ] ]\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Alex (alexBuilderArgs) where\n\nimport Settings.Builders.Common\n\nalexBuilderArgs :: Args\nalexBuilderArgs = builder Alex ? mconcat [ arg \"-g\"\n                                         , arg =<< getInput\n                                         , arg \"-o\", arg =<< getOutput ]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Cabal (cabalBuilderArgs) where\n\nimport Hadrian.Builder (getBuilderPath, needBuilder)\nimport Hadrian.Haskell.Cabal\n\nimport Builder\nimport Context\nimport Flavour\nimport Packages\nimport Settings.Builders.Common\n\ncabalBuilderArgs :: Args\ncabalBuilderArgs = builder (Cabal Setup) ? do\n    verbosity <- expr getVerbosity\n    top       <- expr topDirectory\n    pkg       <- getPackage\n    path      <- getContextPath\n    stage     <- getStage\n    windows   <- expr windowsHost\n    let prefix = \"${pkgroot}\" ++ (if windows then \"\" else \"/..\")\n    mconcat [ arg \"configure\"\n            -- Don't strip libraries when cross compiling.\n            -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,\n            -- and if it's @:@ disable stripping as well. As it is now, I believe\n            -- we might have issues with stripping on Windows, as I can't see a\n            -- consumer of 'stripCmdPath'.\n            -- TODO: See https://github.com/snowleopard/hadrian/issues/549.\n            , flag CrossCompiling ? pure [ \"--disable-executable-stripping\"\n                                         , \"--disable-library-stripping\" ]\n            , arg \"--cabal-file\"\n            , arg $ pkgCabalFile pkg\n            , arg \"--distdir\"\n            , arg $ top -/- path\n            , arg \"--ipid\"\n            , arg \"$pkg-$version\"\n            , arg \"--prefix\"\n            , arg prefix\n\n            -- NB: this is valid only because Hadrian puts the @docs@ and\n            -- @libraries@ folders in the same relative position:\n            --\n            --   * libraries in @_build/stageN/libraries@\n            --   * docs in @_build/docs/html/libraries@\n            --\n            -- This doesn't hold if we move the @docs@ folder anywhere else.\n            , arg \"--htmldir\"\n            , arg $ \"${pkgroot}/../../docs/html/libraries/\" ++ pkgName pkg\n\n            , withStaged $ Ghc CompileHs\n            , withStaged (GhcPkg Update)\n            , withBuilderArgs (GhcPkg Update stage)\n            , bootPackageDatabaseArgs\n            , libraryArgs\n            , configureArgs\n            , bootPackageConstraints\n            , withStaged $ Cc CompileC\n            , notStage0 ? with (Ld stage)\n            , withStaged (Ar Pack)\n            , with Alex\n            , with Happy\n            , verbosity < Chatty ?\n              pure [ \"-v0\", \"--configure-option=--quiet\"\n                   , \"--configure-option=--disable-option-checking\" ] ]\n\n-- TODO: Isn't vanilla always built? If yes, some conditions are redundant.\n-- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?\n-- TODO: should `elem` be `wayUnit`?\n-- This approach still doesn't work. Previously libraries were build only in the\n-- Default flavours and not using context.\nlibraryArgs :: Args\nlibraryArgs = do\n    flavourWays <- getLibraryWays\n    contextWay  <- getWay\n    package     <- getPackage\n    withGhci    <- expr ghcWithInterpreter\n    dynPrograms <- expr (flavour >>= dynamicGhcPrograms)\n    let ways = flavourWays ++ [contextWay]\n        hasVanilla = vanilla `elem` ways\n        hasProfiling = any (wayUnit Profiling) ways\n        hasDynamic = any (wayUnit Dynamic) ways\n    pure [ if hasVanilla\n           then  \"--enable-library-vanilla\"\n           else \"--disable-library-vanilla\"\n         , if hasProfiling\n           then  \"--enable-library-profiling\"\n           else \"--disable-library-profiling\"\n         , if (hasVanilla || hasProfiling) &&\n              package /= rts && withGhci && not dynPrograms\n           then  \"--enable-library-for-ghci\"\n           else \"--disable-library-for-ghci\"\n         , if hasDynamic\n           then  \"--enable-shared\"\n           else \"--disable-shared\" ]\n\n-- TODO: LD_OPTS?\nconfigureArgs :: Args\nconfigureArgs = do\n    top  <- expr topDirectory\n    root <- getBuildRoot\n    pkg  <- getPackage\n    let conf key expr = do\n            values <- unwords <$> expr\n            not (null values) ?\n                arg (\"--configure-option=\" ++ key ++ \"=\" ++ values)\n        cFlags   = mconcat [ remove [\"-Werror\"] cArgs\n                           , getStagedSettingList ConfCcArgs\n                           , arg $ \"-I\" ++ top -/- root -/- generatedDir\n                           -- See https://github.com/snowleopard/hadrian/issues/523\n                           , arg $ \"-I\" ++ top -/- pkgPath pkg\n                           , arg $ \"-I\" ++ top -/- \"includes\" ]\n        ldFlags  = ldArgs  <> (getStagedSettingList ConfGccLinkerArgs)\n        cppFlags = cppArgs <> (getStagedSettingList ConfCppArgs)\n    cldFlags <- unwords <$> (cFlags <> ldFlags)\n    mconcat\n        [ conf \"CFLAGS\"   cFlags\n        , conf \"LDFLAGS\"  ldFlags\n        , conf \"CPPFLAGS\" cppFlags\n        , not (null cldFlags) ? arg (\"--gcc-options=\" ++ cldFlags)\n        , conf \"--with-iconv-includes\"    $ arg =<< getSetting IconvIncludeDir\n        , conf \"--with-iconv-libraries\"   $ arg =<< getSetting IconvLibDir\n        , conf \"--with-gmp-includes\"      $ arg =<< getSetting GmpIncludeDir\n        , conf \"--with-gmp-libraries\"     $ arg =<< getSetting GmpLibDir\n        , conf \"--with-curses-libraries\"  $ arg =<< getSetting CursesLibDir\n        , flag CrossCompiling ? (conf \"--host\" $ arg =<< getSetting TargetPlatformFull)\n        , conf \"--with-cc\" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage\n        , notStage0 ? (arg =<< (\"--ghc-option=-ghcversion-file=\" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))]\n\nbootPackageConstraints :: Args\nbootPackageConstraints = stage0 ? do\n    bootPkgs <- expr $ stagePackages Stage0\n    let pkgs = filter (\\p -> p /= compiler && isLibrary p) bootPkgs\n    constraints <- expr $ forM (sort pkgs) $ \\pkg -> do\n        version <- pkgVersion pkg\n        return $ ((pkgName pkg ++ \" == \") ++) version\n    pure $ concat [ [\"--constraint\", c] | c <- constraints ]\n\ncppArgs :: Args\ncppArgs = do\n    root <- getBuildRoot\n    arg $ \"-I\" ++ root -/- generatedDir\n\nwithBuilderKey :: Builder -> String\nwithBuilderKey b = case b of\n    Ar _ _     -> \"--with-ar=\"\n    Ld _       -> \"--with-ld=\"\n    Cc  _ _    -> \"--with-gcc=\"\n    Ghc _ _    -> \"--with-ghc=\"\n    Alex       -> \"--with-alex=\"\n    Happy      -> \"--with-happy=\"\n    GhcPkg _ _ -> \"--with-ghc-pkg=\"\n    _          -> error $ \"withBuilderKey: not supported builder \" ++ show b\n\n-- | Add arguments to builders if needed.\nwithBuilderArgs :: Builder -> Args\nwithBuilderArgs b = case b of\n    GhcPkg _ stage -> do\n      top   <- expr topDirectory\n      pkgDb <- expr $ packageDbPath stage\n      notStage0 ? arg (\"--ghc-pkg-option=--global-package-db=\" ++ top -/- pkgDb)\n    _          -> return [] -- no arguments\n\n-- | Expression 'with Alex' appends \"--with-alex=/path/to/alex\" and needs Alex.\nwith :: Builder -> Args\nwith b = do\n    path <- getBuilderPath b\n    if null path then mempty else do\n        top <- expr topDirectory\n        expr $ needBuilder b\n        arg  $ withBuilderKey b ++ unifyPath (top </> path)\n\nwithStaged :: (Stage -> Builder) -> Args\nwithStaged sb = with . sb =<< getStage\n", "num_lines": 173}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Cc (ccBuilderArgs) where\n\nimport Hadrian.Haskell.Cabal.Type\nimport Settings.Builders.Common\n\nccBuilderArgs :: Args\nccBuilderArgs = do\n    way <- getWay\n    builder Cc ? mconcat\n        [ getContextData ccOpts\n        , getStagedSettingList ConfCcArgs\n\n        , builder (Cc CompileC) ? mconcat\n            [ arg \"-Wall\"\n            , cIncludeArgs\n            , Dynamic `wayUnit` way ? pure [ \"-fPIC\", \"-DDYNAMIC\" ]\n            , arg \"-c\", arg =<< getInput\n            , arg \"-o\", arg =<< getOutput ]\n\n        , builder (Cc FindCDependencies) ? do\n            output <- getOutput\n            mconcat [ arg \"-E\"\n                    , arg \"-MM\", arg \"-MG\"\n                    , arg \"-MF\", arg output\n                    , arg \"-MT\", arg $ dropExtension output -<.> \"o\"\n                    , cIncludeArgs\n                    , arg \"-x\", arg \"c\"\n                    , arg =<< getInput ] ]\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Common (\n    module Base,\n    module Expression,\n    module Oracles.Flag,\n    module Oracles.Setting,\n    module Settings,\n    module UserSettings,\n    cIncludeArgs, ldArgs, cArgs, cWarnings,\n    packageDatabaseArgs, bootPackageDatabaseArgs\n    ) where\n\nimport Hadrian.Haskell.Cabal.Type\n\nimport Base\nimport Expression\nimport Oracles.Flag\nimport Oracles.Setting\nimport Packages\nimport Settings\nimport UserSettings\n\ncIncludeArgs :: Args\ncIncludeArgs = do\n    pkg     <- getPackage\n    root    <- getBuildRoot\n    path    <- getBuildPath\n    incDirs <- getContextData includeDirs\n    depDirs <- getContextData depIncludeDirs\n    iconvIncludeDir <- getSetting IconvIncludeDir\n    gmpIncludeDir   <- getSetting GmpIncludeDir\n    ffiIncludeDir   <- getSetting FfiIncludeDir\n    mconcat [ notStage0 ||^ package compiler ? arg \"-Iincludes\"\n            , arg $ \"-I\" ++ root -/- generatedDir\n            , arg $ \"-I\" ++ path\n            , pure . map (\"-I\"++) . filter (/= \"\") $ [iconvIncludeDir, gmpIncludeDir]\n            , flag UseSystemFfi ? arg (\"-I\" ++ ffiIncludeDir)\n            -- Add @incDirs@ in the build directory, since some files generated\n            -- with @autoconf@ may end up in the build directory.\n            , pure [ \"-I\" ++ path        -/- dir | dir <- incDirs ]\n            -- Add @incDirs@ in the package directory for include files shipped\n            -- with the package.\n            , pure [ \"-I\" ++ pkgPath pkg -/- dir | dir <- incDirs ]\n            , pure [ \"-I\" ++       unifyPath dir | dir <- depDirs ] ]\n\nldArgs :: Args\nldArgs = mempty\n\ncArgs :: Args\ncArgs = mempty\n\n-- TODO: should be in a different file\ncWarnings :: Args\ncWarnings = mconcat\n    [ arg \"-Wall\"\n    , flag GccIsClang ? arg \"-Wno-unknown-pragmas\"\n    , notM (flag GccIsClang) ? notM windowsHost ? arg \"-Werror=unused-but-set-variable\"\n    , notM (flag GccIsClang) ? arg \"-Wno-error=inline\" ]\n\npackageDatabaseArgs :: Args\npackageDatabaseArgs = do\n    stage <- getStage\n    dbPath <- expr (packageDbPath stage)\n    expr (need [dbPath -/- packageDbStamp])\n    prefix <- ifM (builder Ghc) (return \"-package-db \") (return \"--package-db=\")\n    arg $ prefix ++ dbPath\n\nbootPackageDatabaseArgs :: Args\nbootPackageDatabaseArgs = do\n    stage  <- getStage\n    dbPath <- expr $ packageDbPath stage\n    expr $ need [dbPath -/- packageDbStamp]\n    stage0 ? packageDatabaseArgs\n", "num_lines": 73}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Configure (configureBuilderArgs) where\n\nimport Packages\nimport Rules.Gmp\nimport Settings.Builders.Common\n\nconfigureBuilderArgs :: Args\nconfigureBuilderArgs = do\n    gmpPath    <- expr gmpBuildPath\n    stage      <- getStage\n    libffiPath <- expr (libffiBuildPath stage)\n    mconcat [ builder (Configure gmpPath) ? do\n                hostPlatform  <- getSetting HostPlatform\n                buildPlatform <- getSetting BuildPlatform\n                pure [ \"--enable-shared=no\"\n                     , \"--host=\" ++ hostPlatform\n                     , \"--build=\" ++ buildPlatform ]\n\n            , builder (Configure libffiPath) ? do\n                top            <- expr topDirectory\n                targetPlatform <- getSetting TargetPlatform\n                way            <- getWay\n                pure [ \"--prefix=\" ++ top -/- libffiPath -/- \"inst\"\n                     , \"--libdir=\" ++ top -/- libffiPath -/- \"inst/lib\"\n                     , \"--enable-static=yes\"\n                     , \"--enable-shared=\"\n                            ++ (if wayUnit Dynamic way\n                                    then \"yes\"\n                                    else \"no\")\n                     , \"--host=\" ++ targetPlatform ] ]\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where\n\nimport Builder\nimport Settings.Builders.Common\n\n-- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`?\nderiveConstantsBuilderArgs :: Args\nderiveConstantsBuilderArgs = builder DeriveConstants ? do\n    cFlags <- includeCcArgs\n    outs   <- getOutputs\n    let (outputFile, tempDir) = case outs of\n            [a, b] -> (a, b)\n            _      -> error $ \"DeriveConstants: expected two outputs, got \" ++ show outs\n    mconcat\n        [ output \"//DerivedConstants.h\"             ? arg \"--gen-header\"\n        , output \"//GHCConstantsHaskellType.hs\"     ? arg \"--gen-haskell-type\"\n        , output \"//platformConstants\"              ? arg \"--gen-haskell-value\"\n        , output \"//GHCConstantsHaskellWrappers.hs\" ? arg \"--gen-haskell-wrappers\"\n        , output \"//GHCConstantsHaskellExports.hs\"  ? arg \"--gen-haskell-exports\"\n        , arg \"-o\", arg outputFile\n        , arg \"--tmpdir\", arg tempDir\n        , arg \"--gcc-program\", arg =<< getBuilderPath (Cc CompileC Stage1)\n        , pure $ concatMap (\\a -> [\"--gcc-flag\", a]) cFlags\n        , arg \"--nm-program\", arg =<< getBuilderPath Nm\n        , isSpecified Objdump ? mconcat [ arg \"--objdump-program\"\n                                        , arg =<< getBuilderPath Objdump ]\n        , arg \"--target-os\", arg =<< getSetting TargetOs ]\n\nincludeCcArgs :: Args\nincludeCcArgs = do\n    root <- getBuildRoot\n    mconcat [ cArgs\n            , cWarnings\n            , getSettingList $ ConfCcArgs Stage1\n            , flag GhcUnregisterised ? arg \"-DUSE_MINIINTERPRETER\"\n            , arg \"-Irts\"\n            , arg \"-Iincludes\"\n            , arg $ \"-I\" ++ root -/- generatedDir\n            , notM ghcWithSMP ? arg \"-DNOSMP\"\n            , arg \"-fcommon\" ]\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.GenPrimopCode (genPrimopCodeBuilderArgs) where\n\nimport Settings.Builders.Common\n\ngenPrimopCodeBuilderArgs :: Args\ngenPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat\n    [ output \"//PrimopWrappers.hs\"                 ? arg \"--make-haskell-wrappers\"\n    , output \"//Prim.hs\"                           ? arg \"--make-haskell-source\"\n    , output \"//primop-data-decl.hs-incl\"          ? arg \"--data-decl\"\n    , output \"//primop-tag.hs-incl\"                ? arg \"--primop-tag\"\n    , output \"//primop-list.hs-incl\"               ? arg \"--primop-list\"\n    , output \"//primop-has-side-effects.hs-incl\"   ? arg \"--has-side-effects\"\n    , output \"//primop-out-of-line.hs-incl\"        ? arg \"--out-of-line\"\n    , output \"//primop-commutable.hs-incl\"         ? arg \"--commutable\"\n    , output \"//primop-code-size.hs-incl\"          ? arg \"--code-size\"\n    , output \"//primop-can-fail.hs-incl\"           ? arg \"--can-fail\"\n    , output \"//primop-strictness.hs-incl\"         ? arg \"--strictness\"\n    , output \"//primop-fixity.hs-incl\"             ? arg \"--fixity\"\n    , output \"//primop-primop-info.hs-incl\"        ? arg \"--primop-primop-info\"\n    , output \"//primop-vector-uniques.hs-incl\"     ? arg \"--primop-vector-uniques\"\n    , output \"//primop-vector-tys.hs-incl\"         ? arg \"--primop-vector-tys\"\n    , output \"//primop-vector-tys-exports.hs-incl\" ? arg \"--primop-vector-tys-exports\"\n    , output \"//primop-vector-tycons.hs-incl\"      ? arg \"--primop-vector-tycons\"\n    , output \"//primop-usage.hs-incl\"              ? arg \"--usage\" ]\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where\n\nimport Hadrian.Haskell.Cabal\nimport Hadrian.Haskell.Cabal.Type\n\nimport Flavour\nimport Packages\nimport Settings.Builders.Common\nimport Settings.Warnings\nimport qualified Context as Context\nimport Rules.Libffi (libffiName)\n\nghcBuilderArgs :: Args\nghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]\n\ncompileAndLinkHs :: Args\ncompileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do\n    mconcat [ arg \"-Wall\"\n            , commonGhcArgs\n            , ghcLinkArgs\n            , defaultGhcWarningsArgs\n            , builder (Ghc CompileHs) ? arg \"-c\"\n            , getInputs\n            , arg \"-o\", arg =<< getOutput ]\n\ncompileC :: Args\ncompileC = builder (Ghc CompileCWithGhc) ? do\n    way <- getWay\n    let ccArgs = [ getContextData ccOpts\n                 , getStagedSettingList ConfCcArgs\n                 , cIncludeArgs\n                 , Dynamic `wayUnit` way ? pure [ \"-fPIC\", \"-DDYNAMIC\" ] ]\n    mconcat [ arg \"-Wall\"\n            , ghcLinkArgs\n            , commonGhcArgs\n            , mconcat (map (map (\"-optc\" ++) <$>) ccArgs)\n            , defaultGhcWarningsArgs\n            , arg \"-c\"\n            , getInputs\n            , arg \"-o\"\n            , arg =<< getOutput ]\n\nghcLinkArgs :: Args\nghcLinkArgs = builder (Ghc LinkHs) ? do\n    pkg     <- getPackage\n    libs    <- getContextData extraLibs\n    libDirs <- getContextData extraLibDirs\n    fmwks   <- getContextData frameworks\n    darwin  <- expr osxHost\n    way     <- getWay\n\n    -- Relative path from the output (rpath $ORIGIN).\n    originPath <- dropFileName <$> getOutput\n    context <- getContext\n    libPath' <- expr (libPath context)\n    distDir <- expr Context.distDir\n\n    useSystemFfi <- expr (flag UseSystemFfi)\n    buildPath <- getBuildPath\n    libffiName' <- libffiName\n\n    let\n        dynamic = Dynamic `wayUnit` way\n        distPath = libPath' -/- distDir\n        originToLibsDir = makeRelativeNoSysLink originPath distPath\n        rpath | darwin = \"@loader_path\" -/- originToLibsDir\n              | otherwise = \"$ORIGIN\" -/- originToLibsDir\n\n        -- TODO: an alternative would be to generalize by linking with extra\n        -- bundled libraries, but currently the rts is the only use case. It is\n        -- a special case when `useSystemFfi == True`: the ffi library files\n        -- are not actually bundled with the rts. Perhaps ffi should be part of\n        -- rts's extra libraries instead of extra bundled libraries in that\n        -- case. Care should be take as to not break the make build.\n        rtsFfiArg = package rts ? not useSystemFfi ? mconcat\n            [ arg (\"-L\" ++ buildPath)\n            , arg (\"-l\" ++ libffiName')\n            ]\n\n    mconcat [ dynamic ? mconcat\n                [ arg \"-dynamic\"\n                -- TODO what about windows?\n                , isLibrary pkg ? pure [ \"-shared\", \"-dynload\", \"deploy\" ]\n                , notStage0 ?\n                  hostSupportsRPaths ? arg (\"-optl-Wl,-rpath,\" ++ rpath)\n                ]\n            , arg \"-no-auto-link-packages\"\n            ,      nonHsMainPackage pkg  ? arg \"-no-hs-main\"\n            , not (nonHsMainPackage pkg) ? arg \"-rtsopts\"\n            , pure [ \"-l\" ++ lib    | lib    <- libs    ]\n            , pure [ \"-L\" ++ libDir | libDir <- libDirs ]\n            , rtsFfiArg\n            , darwin ? pure (concat [ [\"-framework\", fmwk] | fmwk <- fmwks ])\n            ]\n\nfindHsDependencies :: Args\nfindHsDependencies = builder (Ghc FindHsDependencies) ? do\n    ways <- getLibraryWays\n    mconcat [ arg \"-M\"\n            , commonGhcArgs\n            , arg \"-include-pkg-deps\"\n            , arg \"-dep-makefile\", arg =<< getOutput\n            , pure $ concat [ [\"-dep-suffix\", wayPrefix w] | w <- ways ]\n            , getInputs ]\n\nhaddockGhcArgs :: Args\nhaddockGhcArgs = mconcat [ commonGhcArgs\n                         , getContextData hcOpts\n                         , ghcWarningsArgs ]\n\n-- | Common GHC command line arguments used in 'ghcBuilderArgs',\n-- 'ghcCBuilderArgs', 'ghcMBuilderArgs' and 'haddockGhcArgs'.\ncommonGhcArgs :: Args\ncommonGhcArgs = do\n    way  <- getWay\n    path <- getBuildPath\n    ghcVersion <- expr ghcVersionH\n    mconcat [ arg \"-hisuf\", arg $ hisuf way\n            , arg \"-osuf\" , arg $  osuf way\n            , arg \"-hcsuf\", arg $ hcsuf way\n            , wayGhcArgs\n            , packageGhcArgs\n            , includeGhcArgs\n            -- When compiling RTS for Stage1 or Stage2 we do not have it (yet)\n            -- in the package database. We therefore explicity supply the path\n            -- to the @ghc-version@ file, to prevent GHC from trying to open the\n            -- RTS package in the package database and failing.\n            , package rts ? notStage0 ? arg (\"-ghcversion-file=\" ++ ghcVersion)\n            , map (\"-optc\" ++) <$> getStagedSettingList ConfCcArgs\n            , map (\"-optP\" ++) <$> getStagedSettingList ConfCppArgs\n            , map (\"-optP\" ++) <$> getContextData cppOpts\n            , arg \"-outputdir\", arg path ]\n\n-- TODO: Do '-ticky' in all debug ways?\nwayGhcArgs :: Args\nwayGhcArgs = do\n    way <- getWay\n    mconcat [ if Dynamic `wayUnit` way\n                then pure [\"-fPIC\", \"-dynamic\"]\n                else arg \"-static\"\n            , (Threaded  `wayUnit` way) ? arg \"-optc-DTHREADED_RTS\"\n            , (Debug     `wayUnit` way) ? arg \"-optc-DDEBUG\"\n            , (Profiling `wayUnit` way) ? arg \"-prof\"\n            , (Logging   `wayUnit` way) ? arg \"-eventlog\"\n            , (way == debug || way == debugDynamic) ?\n              pure [\"-ticky\", \"-DTICKY_TICKY\"] ]\n\npackageGhcArgs :: Args\npackageGhcArgs = do\n    package <- getPackage\n    pkgId   <- expr $ pkgIdentifier package\n    mconcat [ arg \"-hide-all-packages\"\n            , arg \"-no-user-package-db\"\n            , packageDatabaseArgs\n            , libraryPackage ? arg (\"-this-unit-id \" ++ pkgId)\n            , map (\"-package-id \" ++) <$> getContextData depIds ]\n\nincludeGhcArgs :: Args\nincludeGhcArgs = do\n    pkg     <- getPackage\n    path    <- getBuildPath\n    root    <- getBuildRoot\n    context <- getContext\n    srcDirs <- getContextData srcDirs\n    autogen <- expr $ autogenPath context\n    let cabalMacros = autogen -/- \"cabal_macros.h\"\n    expr $ need [cabalMacros]\n    mconcat [ arg \"-i\"\n            , arg $ \"-i\" ++ path\n            , arg $ \"-i\" ++ autogen\n            , pure [ \"-i\" ++ pkgPath pkg -/- dir | dir <- srcDirs ]\n            , cIncludeArgs\n            , arg $      \"-I\" ++ root -/- generatedDir\n            , arg $ \"-optc-I\" ++ root -/- generatedDir\n            , pure [\"-optP-include\", \"-optP\" ++ cabalMacros] ]\n", "num_lines": 176}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.GhcPkg (ghcPkgBuilderArgs) where\n\nimport Settings.Builders.Common\n\nghcPkgBuilderArgs :: Args\nghcPkgBuilderArgs = mconcat\n    [ builder (GhcPkg Copy) ? do\n        verbosity <- expr getVerbosity\n        stage     <- getStage\n        pkgDb     <- expr $ packageDbPath stage\n        mconcat [ arg \"--global-package-db\"\n                , arg pkgDb\n                , arg \"register\"\n                , verbosity < Chatty ? arg \"-v0\"\n                ]\n    , builder (GhcPkg Unregister) ? do\n        verbosity <- expr getVerbosity\n        stage     <- getStage\n        pkgDb     <- expr $ packageDbPath stage\n        mconcat [ arg \"--global-package-db\"\n                , arg pkgDb\n                , arg \"unregister\"\n                , arg \"--force\"\n                , verbosity < Chatty ? arg \"-v0\"\n                ]\n    , builder (GhcPkg Update) ? do\n        verbosity <- expr getVerbosity\n        context   <- getContext\n        config    <- expr $ pkgInplaceConfig context\n        stage     <- getStage\n        pkgDb     <- expr $ packageDbPath stage\n        mconcat [ notStage0 ? arg \"--global-package-db\"\n                , notStage0 ? arg pkgDb\n                , arg \"update\"\n                , arg \"--force\"\n                , verbosity < Chatty ? arg \"-v0\"\n                , bootPackageDatabaseArgs\n                , arg config ] ]\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Haddock (haddockBuilderArgs) where\n\nimport Hadrian.Haskell.Cabal\nimport Hadrian.Haskell.Cabal.Type\nimport Hadrian.Utilities\n\nimport Packages\nimport Rules.Documentation\nimport Settings.Builders.Common\nimport Settings.Builders.Ghc\n\n-- | Given a version string such as \"2.16.2\" produce an integer equivalent.\nversionToInt :: String -> Int\nversionToInt = read . dropWhile (=='0') . filter (/='.')\n\nhaddockBuilderArgs :: Args\nhaddockBuilderArgs = mconcat\n    [ builder (Haddock BuildIndex) ? do\n        output <- getOutput\n        inputs <- getInputs\n        root   <- getBuildRoot\n        mconcat\n            [ arg $ \"-B\" ++ root -/- stageString Stage1 -/- \"lib\"\n            , arg $ \"--lib=\" ++ root -/- stageString Stage1 -/- \"lib\"\n            , arg \"--gen-index\"\n            , arg \"--gen-contents\"\n            , arg \"-o\", arg $ takeDirectory output\n            , arg \"-t\", arg \"Haskell Hierarchical Libraries\"\n            , arg \"-p\", arg \"libraries/prologue.txt\"\n            , pure [ \"--read-interface=\"\n                     ++ (takeFileName . takeDirectory) haddock\n                     ++ \",\" ++ haddock | haddock <- inputs ] ]\n\n    , builder (Haddock BuildPackage) ? do\n        output   <- getOutput\n        pkg      <- getPackage\n        root     <- getBuildRoot\n        path     <- getBuildPath\n        context  <- getContext\n        version  <- expr $ pkgVersion  pkg\n        synopsis <- expr $ pkgSynopsis pkg\n        deps     <- getContextData depNames\n        haddocks <- expr $ haddockDependencies context\n        hVersion <- expr $ pkgVersion haddock\n        ghcOpts  <- haddockGhcArgs\n        mconcat\n            [ arg \"--verbosity=0\"\n            , arg $ \"-B\" ++ root -/- stageString Stage1 -/- \"lib\"\n            , arg $ \"--lib=\" ++ root -/- stageString Stage1 -/- \"lib\"\n            , arg $ \"--odir=\" ++ takeDirectory output\n            , arg \"--no-tmp-comp-dir\"\n            , arg $ \"--dump-interface=\" ++ output\n            , arg \"--html\"\n            , arg \"--hyperlinked-source\"\n            , arg \"--hoogle\"\n            , arg \"--quickjump\"\n            , arg $ \"--title=\" ++ pkgName pkg ++ \"-\" ++ version\n                    ++ \": \" ++ synopsis\n            , arg $ \"--prologue=\" ++ takeDirectory output -/- \"haddock-prologue.txt\"\n            , arg $ \"--optghc=-D__HADDOCK_VERSION__=\"\n                    ++ show (versionToInt hVersion)\n            , map (\"--hide=\" ++) <$> getContextData otherModules\n            , pure [ \"--read-interface=../\" ++ dep\n                     ++ \",../\" ++ dep ++ \"/src/%{MODULE}.html#%{NAME},\"\n                     ++ haddock | (dep, haddock) <- zip deps haddocks ]\n            , pure [ \"--optghc=\" ++ opt | opt <- ghcOpts, not (\"--package-db\" `isInfixOf` opt) ]\n            , getInputs\n            , arg \"+RTS\"\n            , arg $ \"-t\" ++ path -/- \"haddock.t\"\n            , arg \"--machine-readable\"\n            , arg \"-RTS\" ] ]\n", "num_lines": 72}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Happy (happyBuilderArgs) where\n\nimport Settings.Builders.Common\n\nhappyBuilderArgs :: Args\nhappyBuilderArgs = builder Happy ? mconcat [ arg \"-ag\" -- TODO (int-index): restore the -c option when happy/pull/134 is merged.\n                                           , arg \"--strict\"\n                                           , arg =<< getInput\n                                           , arg \"-o\", arg =<< getOutput ]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where\n\nimport Hadrian.Haskell.Cabal.Type\n\nimport Builder\nimport Packages\nimport Settings.Builders.Common\n\nhsc2hsBuilderArgs :: Args\nhsc2hsBuilderArgs = builder Hsc2Hs ? do\n    stage   <- getStage\n    ccPath  <- getBuilderPath $ Cc CompileC stage\n    gmpDir  <- getSetting GmpIncludeDir\n    top     <- expr topDirectory\n    hArch   <- getSetting HostArch\n    hOs     <- getSetting HostOs\n    tArch   <- getSetting TargetArch\n    tOs     <- getSetting TargetOs\n    version <- if stage == Stage0\n               then expr ghcCanonVersion\n               else getSetting ProjectVersionInt\n    tmpl <- (top -/-) <$> expr (templateHscPath Stage0)\n    mconcat [ arg $ \"--cc=\" ++ ccPath\n            , arg $ \"--ld=\" ++ ccPath\n            , notM windowsHost ? notM (flag CrossCompiling) ? arg \"--cross-safe\"\n            , pure $ map (\"-I\" ++) (words gmpDir)\n            , map (\"--cflag=\" ++) <$> getCFlags\n            , map (\"--lflag=\" ++) <$> getLFlags\n            , notStage0 ? flag CrossCompiling ? arg \"--cross-compile\"\n            , stage0    ? arg (\"--cflag=-D\" ++ hArch ++ \"_HOST_ARCH=1\")\n            , stage0    ? arg (\"--cflag=-D\" ++ hOs   ++ \"_HOST_OS=1\"  )\n            , notStage0 ? arg (\"--cflag=-D\" ++ tArch ++ \"_HOST_ARCH=1\")\n            , notStage0 ? arg (\"--cflag=-D\" ++ tOs   ++ \"_HOST_OS=1\"  )\n            , arg $ \"--cflag=-D__GLASGOW_HASKELL__=\" ++ version\n            , arg $ \"--template=\" ++ tmpl\n            , arg =<< getInput\n            , arg \"-o\", arg =<< getOutput ]\n\ngetCFlags :: Expr [String]\ngetCFlags = do\n    context <- getContext\n    autogen <- expr $ autogenPath context\n    let cabalMacros = autogen -/- \"cabal_macros.h\"\n    expr $ need [cabalMacros]\n    mconcat [ remove [\"-O\"] (cArgs <> getStagedSettingList ConfCcArgs)\n            , getStagedSettingList ConfCppArgs\n            , cIncludeArgs\n            , getContextData ccOpts\n            -- we might be able to leave out cppOpts, to be investigated.\n            , getContextData cppOpts\n            , getContextData depCcOpts\n            , cWarnings\n            , arg \"-include\", arg cabalMacros ]\n\ngetLFlags :: Expr [String]\ngetLFlags =\n    mconcat [ getStagedSettingList ConfGccLinkerArgs\n            , ldArgs\n            , getContextData ldOpts\n            , getContextData depLdOpts ]\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.HsCpp (hsCppBuilderArgs) where\n\nimport Packages\nimport Settings.Builders.Common\n\nhsCppBuilderArgs :: Args\nhsCppBuilderArgs = builder HsCpp ? do\n    stage   <- getStage\n    root    <- getBuildRoot\n    ghcPath <- expr $ buildPath (vanillaContext stage compiler)\n    mconcat [ getSettingList HsCppArgs\n            , arg \"-P\"\n            , arg \"-Iincludes\"\n            , arg $ \"-I\" ++ root -/- generatedDir\n            , arg $ \"-I\" ++ ghcPath\n            , arg \"-x\", arg \"c\"\n            , arg =<< getInput ]\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Ld (ldBuilderArgs) where\n\nimport Settings.Builders.Common\n\nldBuilderArgs :: Args\nldBuilderArgs = builder Ld ? mconcat [ getStagedSettingList ConfLdLinkerArgs\n                                     , arg \"-r\"\n                                     , arg \"-o\", arg =<< getOutput\n                                     , getInputs ]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where\n\nimport Oracles.Setting\nimport Packages\nimport Rules.Gmp\nimport Settings.Builders.Common\nimport CommandLine\n\nmakeBuilderArgs :: Args\nmakeBuilderArgs = do\n    threads    <- shakeThreads <$> expr getShakeOptions\n    gmpPath    <- expr gmpBuildPath\n    libffiPaths <- forM [Stage1 ..] $ \\s -> expr (libffiBuildPath s)\n    let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads\n    mconcat $\n        (builder (Make gmpPath   ) ? pure [\"MAKEFLAGS=-j\" ++ t]) :\n        [ builder (Make libffiPath) ? pure [\"MAKEFLAGS=-j\" ++ t, \"install\"]\n        | libffiPath <- libffiPaths ]\n\nvalidateBuilderArgs :: Args\nvalidateBuilderArgs = builder (Make \"testsuite/tests\") ? do\n    threads             <- shakeThreads <$> expr getShakeOptions\n    top                 <- expr topDirectory\n    compiler            <- expr $ fullpath ghc\n    checkPpr            <- expr $ fullpath checkPpr\n    checkApiAnnotations <- expr $ fullpath checkApiAnnotations\n    args                <- expr $ userSetting defaultTestArgs\n    return [ setTestSpeed $ testSpeed args\n           , \"THREADS=\" ++ show threads\n           , \"TEST_HC=\" ++ (top -/- compiler)\n           , \"CHECK_PPR=\" ++ (top -/- checkPpr)\n           , \"CHECK_API_ANNOTATIONS=\" ++ (top -/- checkApiAnnotations)\n           ]\n  where\n    fullpath :: Package -> Action FilePath\n    fullpath pkg = programPath =<< programContext Stage1 pkg\n\n-- | Support for speed of validation\nsetTestSpeed :: TestSpeed -> String\nsetTestSpeed Fast    = \"fasttest\"\nsetTestSpeed Average = \"test\"\nsetTestSpeed Slow    = \"slowtest\"\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.RunTest (runTestBuilderArgs, runTestGhcFlags) where\n\nimport Hadrian.Utilities\nimport System.Environment\n\nimport CommandLine\nimport Flavour\nimport Oracles.Setting (setting)\nimport Oracles.TestSettings\nimport Packages\nimport Settings.Builders.Common\n\ngetTestSetting :: TestSetting -> Expr String\ngetTestSetting key = expr $ testSetting key\n\n-- | Parse the value of a Boolean test setting or report an error.\ngetBooleanSetting :: TestSetting -> Expr Bool\ngetBooleanSetting key = fromMaybe (error msg) <$> parseYesNo <$> getTestSetting key\n  where\n    msg = \"Cannot parse test setting \" ++ quote (show key)\n\n-- | Extra flags to send to the Haskell compiler to run tests.\nrunTestGhcFlags :: Action String\nrunTestGhcFlags = do\n    unregisterised <- flag GhcUnregisterised\n\n    let ifMinGhcVer ver opt = do v <- ghcCanonVersion\n                                 if ver <= v then pure opt\n                                             else pure \"\"\n\n    -- Read extra argument for test from command line, like `-fvectorize`.\n    ghcOpts <- fromMaybe \"\" <$> (liftIO $ lookupEnv \"EXTRA_HC_OPTS\")\n\n    -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28\n    let ghcExtraFlags = if unregisterised\n                           then \"-optc-fno-builtin\"\n                           else \"\"\n\n    -- Take flags to send to the Haskell compiler from test.mk.\n    -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37\n    unwords <$> sequence\n        [ pure \" -dcore-lint -dcmm-lint -no-user-package-db -rtsopts\"\n        , pure ghcOpts\n        , pure ghcExtraFlags\n        , ifMinGhcVer \"711\" \"-fno-warn-missed-specialisations\"\n        , ifMinGhcVer \"711\" \"-fshow-warning-groups\"\n        , ifMinGhcVer \"801\" \"-fdiagnostics-color=never\"\n        , ifMinGhcVer \"801\" \"-fno-diagnostics-show-caret\"\n        , pure \"-Werror=compat\" -- See Trac #15278\n        , pure \"-dno-debug-output\"\n        ]\n\n-- Command line arguments for invoking the @runtest.py@ script. A lot of this\n-- mirrors @testsuite/mk/test.mk@.\nrunTestBuilderArgs :: Args\nrunTestBuilderArgs = builder RunTest ? do\n    pkgs     <- expr $ stagePackages Stage1\n    libTests <- expr $ filterM doesDirectoryExist $ concat\n            [ [ pkgPath pkg -/- \"tests\", pkgPath pkg -/- \"tests-ghc\" ]\n            | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]\n\n    flav    <- expr flavour\n    rtsWays <- expr testRTSSettings\n    libWays <- libraryWays flav\n    let hasRtsWay w = elem w rtsWays\n        hasLibWay w = elem w libWays\n        debugged    = ghcDebugged flav\n    hasDynamic          <- getBooleanSetting TestGhcDynamic\n    hasDynamicByDefault <- getBooleanSetting TestGhcDynamicByDefault\n    withNativeCodeGen   <- getBooleanSetting TestGhcWithNativeCodeGen\n    withInterpreter     <- getBooleanSetting TestGhcWithInterpreter\n    unregisterised      <- getBooleanSetting TestGhcUnregisterised\n    withSMP             <- getBooleanSetting TestGhcWithSMP\n\n    windows     <- expr windowsHost\n    darwin      <- expr osxHost\n    threads     <- shakeThreads <$> expr getShakeOptions\n    os          <- getTestSetting TestHostOS\n    arch        <- getTestSetting TestTargetARCH_CPP\n    platform    <- getTestSetting TestTARGETPLATFORM\n    wordsize    <- getTestSetting TestWORDSIZE\n    top         <- expr $ topDirectory\n    ghcFlags    <- expr runTestGhcFlags\n    timeoutProg <- expr buildRoot <&> (-/- timeoutPath)\n\n    -- See #16087\n    let ghcBuiltByLlvm = False -- TODO: Implement this check\n\n    let asZeroOne s b = s ++ zeroOne b\n\n    -- TODO: set CABAL_MINIMAL_BUILD/CABAL_PLUGIN_BUILD\n    mconcat [ arg $ \"testsuite/driver/runtests.py\"\n            , arg $ \"--rootdir=\" ++ (\"testsuite\" -/- \"tests\")\n            , pure [\"--rootdir=\" ++ test | test <- libTests]\n            , arg \"-e\", arg $ \"windows=\" ++ show windows\n            , arg \"-e\", arg $ \"darwin=\" ++ show darwin\n            , arg \"-e\", arg $ \"config.local=True\"\n            , arg \"-e\", arg $ \"config.cleanup=False\" -- Don't clean up.\n            , arg \"-e\", arg $ \"config.compiler_debugged=\" ++ quote (yesNo debugged)\n            , arg \"-e\", arg $ \"ghc_debugged=\" ++ quote (yesNo debugged)\n            , arg \"-e\", arg $ asZeroOne \"ghc_with_native_codegen=\" withNativeCodeGen\n\n            , arg \"-e\", arg $ \"config.have_interp=\" ++ show withInterpreter\n            , arg \"-e\", arg $ \"config.unregisterised=\" ++ show unregisterised\n\n            , arg \"-e\", arg $ \"ghc_compiler_always_flags=\" ++ quote ghcFlags\n            , arg \"-e\", arg $ asZeroOne \"ghc_with_dynamic_rts=\"  (hasRtsWay \"dyn\")\n            , arg \"-e\", arg $ asZeroOne \"ghc_with_threaded_rts=\" (hasRtsWay \"thr\")\n            , arg \"-e\", arg $ asZeroOne \"config.have_vanilla=\"   (hasLibWay vanilla)\n            , arg \"-e\", arg $ asZeroOne \"config.have_dynamic=\"   (hasLibWay dynamic)\n            , arg \"-e\", arg $ asZeroOne \"config.have_profiling=\" (hasLibWay profiling)\n            , arg \"-e\", arg $ asZeroOne \"ghc_with_smp=\" withSMP\n            , arg \"-e\", arg $ \"ghc_with_llvm=0\" -- TODO: support LLVM\n\n            , arg \"-e\", arg $ \"config.ghc_dynamic_by_default=\" ++ show hasDynamicByDefault\n            , arg \"-e\", arg $ \"config.ghc_dynamic=\" ++ show hasDynamic\n            , arg \"-e\", arg $ \"config.ghc_built_by_llvm=\" ++ show ghcBuiltByLlvm\n\n            -- Use default value, see:\n            -- https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk\n            , arg \"-e\", arg $ \"config.in_tree_compiler=True\"\n            , arg \"-e\", arg $ \"config.top=\" ++ show (top -/- \"testsuite\")\n            , arg \"-e\", arg $ \"config.wordsize=\" ++ show wordsize\n            , arg \"-e\", arg $ \"config.os=\"       ++ show os\n            , arg \"-e\", arg $ \"config.arch=\"     ++ show arch\n            , arg \"-e\", arg $ \"config.platform=\" ++ show platform\n\n            , arg \"--config\", arg $ \"gs=gs\"                           -- Use the default value as in test.mk\n            , arg \"--config\", arg $ \"timeout_prog=\" ++ show (top -/- timeoutProg)\n            , arg $ \"--threads=\" ++ show threads\n            , getTestArgs -- User-provided arguments from command line.\n            ]\n\n-- | Command line arguments for running GHC's test script.\ngetTestArgs :: Args\ngetTestArgs = do\n    -- targets specified in the TEST env var\n    testEnvTargets <- maybe [] words <$> expr (liftIO $ lookupEnv \"TEST\")\n    args            <- expr $ userSetting defaultTestArgs\n    bindir          <- expr $ setBinaryDirectory (testCompiler args)\n    compiler        <- expr $ setCompiler (testCompiler args)\n    globalVerbosity <- shakeVerbosity <$> expr getShakeOptions\n    let configFileArg= [\"--config-file=\" ++ (testConfigFile args)]\n        testOnlyArg  =  map (\"--only=\" ++) (testOnly args ++ testEnvTargets)\n        onlyPerfArg  = if testOnlyPerf args\n                           then Just \"--only-perf-tests\"\n                           else Nothing\n        skipPerfArg  = if testSkipPerf args\n                           then Just \"--skip-perf-tests\"\n                           else Nothing\n        speedArg     = [\"-e\", \"config.speed=\" ++ setTestSpeed (testSpeed args)]\n        summaryArg   = case testSummary args of\n                           Just filepath -> Just $ \"--summary-file\" ++ quote filepath\n                           Nothing -> Just $ \"--summary-file=testsuite_summary.txt\"\n        junitArg     = case testJUnit args of\n                           Just filepath -> Just $ \"--junit \" ++ quote filepath\n                           Nothing -> Nothing\n        configArgs   = concat [[\"-e\", configArg] | configArg <- testConfigs args]\n        verbosityArg = case testVerbosity args of\n                           Nothing -> Just $ \"--verbose=\" ++ show (fromEnum globalVerbosity)\n                           Just verbosity -> Just $ \"--verbose=\" ++ verbosity\n        wayArgs      = map (\"--way=\" ++) (testWays args)\n        compilerArg  = [\"--config\", \"compiler=\" ++ show (compiler)]\n        ghcPkgArg    = [\"--config\", \"ghc_pkg=\" ++ show (bindir -/- \"ghc-pkg\")]\n        haddockArg   = [\"--config\", \"haddock=\" ++ show (bindir -/- \"haddock\")]\n        hp2psArg     = [\"--config\", \"hp2ps=\" ++ show (bindir -/- \"hp2ps\")]\n        hpcArg       = [\"--config\", \"hpc=\" ++ show (bindir -/- \"hpc\")]\n    pure $  configFileArg ++ testOnlyArg ++ speedArg\n         ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg\n                      , junitArg, verbosityArg  ]\n         ++ configArgs ++ wayArgs ++  compilerArg ++ ghcPkgArg\n         ++ haddockArg ++ hp2psArg ++ hpcArg\n\n-- TODO: Switch to 'Stage' as the first argument instead of 'String'.\n-- | Directory to look for Binaries\n-- | We assume that required programs are present in the same binary directory\n-- | in which ghc is stored and that they have their conventional name.\n-- | QUESTION : packages can be named different from their conventional names.\n-- | For example, ghc-pkg can be named as ghc-pkg-version. In such cases, it will\n-- | be impossible to search the binary. Only possible way will be to take user\n-- | inputs for these directory also. boilerplate soes not account for this\n-- | problem, but simply returns an error. How should we handle such cases?\nsetBinaryDirectory :: String -> Action FilePath\nsetBinaryDirectory \"stage0\" = takeDirectory <$> setting SystemGhc\nsetBinaryDirectory \"stage1\" = liftM2 (-/-) topDirectory (stageBinPath Stage0)\nsetBinaryDirectory \"stage2\" = liftM2 (-/-) topDirectory (stageBinPath Stage1)\nsetBinaryDirectory compiler = pure $ parentPath compiler\n\n-- TODO: Switch to 'Stage' as the first argument instead of 'String'.\n-- | Set Test Compiler.\nsetCompiler :: String -> Action FilePath\nsetCompiler \"stage0\" = setting SystemGhc\nsetCompiler \"stage1\" = liftM2 (-/-) topDirectory (fullPath Stage0 ghc)\nsetCompiler \"stage2\" = liftM2 (-/-) topDirectory (fullPath Stage1 ghc)\nsetCompiler compiler = pure compiler\n\n-- | Set speed for test\nsetTestSpeed :: TestSpeed -> String\nsetTestSpeed Slow    = \"0\"\nsetTestSpeed Average = \"1\"\nsetTestSpeed Fast    = \"2\"\n\n-- | Returns parent path of test compiler\n-- | TODO: Is there a simpler way to find parent directory?\nparentPath :: String -> String\nparentPath path = intercalate \"/\" $ init $ splitOn \"/\" path\n\n-- | TODO: Move to Hadrian utilities.\nfullPath :: Stage -> Package -> Action FilePath\nfullPath stage pkg = programPath =<< programContext stage pkg\n", "num_lines": 211}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Builders.Xelatex (xelatexBuilderArgs) where\n\nimport Settings.Builders.Common\n\nxelatexBuilderArgs :: Args\nxelatexBuilderArgs = builder Xelatex ? mconcat [ arg \"-halt-on-error\"\n                                               , arg =<< getInput ]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.Common where\n\nimport Expression\n\n-- See https://ghc.haskell.org/trac/ghc/ticket/15286 and\n-- https://phabricator.haskell.org/D4880\nnaturalInBaseFixArgs :: Args\nnaturalInBaseFixArgs = mconcat\n  [ input \"//Natural.hs\" ? pure [\"-fno-omit-interface-pragmas\"]\n  , input \"//Num.hs\" ? pure [\"-fno-ignore-interface-pragmas\"]\n  ]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.Development (developmentFlavour) where\n\nimport Expression\nimport Flavour\nimport {-# SOURCE #-} Settings.Default\n\n-- Please update doc/flavours.md when changing this file.\ndevelopmentFlavour :: Stage -> Flavour\ndevelopmentFlavour ghcStage = defaultFlavour\n    { name = \"devel\" ++ show (fromEnum ghcStage)\n    , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs\n    , libraryWays = pure [vanilla]\n    , rtsWays = pure [vanilla, threaded]\n    , dynamicGhcPrograms = return False }\n\ndevelopmentArgs :: Stage -> Args\ndevelopmentArgs ghcStage = do\n    stage <- getStage\n    sourceArgs SourceArgs\n        { hsDefault  = pure [\"-O\", \"-H64m\"]\n        , hsLibrary  = notStage0 ? arg \"-dcore-lint\"\n        , hsCompiler = mconcat [stage0 ? arg \"-O2\",\n                                succ stage == ghcStage ? pure [\"-O0\", \"-DDEBUG\"]]\n        , hsGhc      = succ stage == ghcStage ? pure [\"-O0\", \"-DDEBUG\"] }\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.Llvm (\n  performanceLlvmFlavour,\n  profiledLlvmFlavour,\n  quickLlvmFlavour,\n) where\n\nimport Expression\nimport Flavour\n\nimport Settings.Flavours.Performance\nimport Settings.Flavours.Profiled\nimport Settings.Flavours.Quick\n\n-- Please update doc/flavours.md when changing this file.\nperformanceLlvmFlavour, profiledLlvmFlavour, quickLlvmFlavour :: Flavour\nperformanceLlvmFlavour = mkLlvmFlavour performanceFlavour\nprofiledLlvmFlavour    = mkLlvmFlavour profiledFlavour\nquickLlvmFlavour       = mkLlvmFlavour quickFlavour\n\n-- | Turn a flavour into an LLVM flavour\nmkLlvmFlavour :: Flavour -> Flavour\nmkLlvmFlavour flav = flav\n    { name = name flav ++ \"-llvm\"\n    , args = mconcat [ args flav\n                     , builder Ghc ? arg \"-fllvm\" ]\n    }\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.Performance (performanceFlavour) where\n\nimport Expression\nimport Flavour\nimport {-# SOURCE #-} Settings.Default\n\n-- Please update doc/flavours.md when changing this file.\nperformanceFlavour :: Flavour\nperformanceFlavour = defaultFlavour\n    { name = \"perf\"\n    , args = defaultBuilderArgs <> performanceArgs <> defaultPackageArgs }\n\nperformanceArgs :: Args\nperformanceArgs = sourceArgs SourceArgs\n    { hsDefault  = pure [\"-O\", \"-H64m\"]\n    , hsLibrary  = notStage0 ? arg \"-O2\"\n    , hsCompiler = pure [\"-O2\"]\n    , hsGhc      = mconcat [stage0 ? arg \"-O\", notStage0 ? arg \"-O2\"] }\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.Profiled (profiledFlavour) where\n\nimport Expression\nimport Flavour\nimport {-# SOURCE #-} Settings.Default\nimport Settings.Flavours.Common (naturalInBaseFixArgs)\n\n-- Please update doc/flavours.md when changing this file.\nprofiledFlavour :: Flavour\nprofiledFlavour = defaultFlavour\n    { name        = \"prof\"\n    , args        = defaultBuilderArgs <> profiledArgs <> defaultPackageArgs\n    , ghcProfiled = True }\n\nprofiledArgs :: Args\nprofiledArgs = sourceArgs SourceArgs\n    { hsDefault  = mconcat\n        [ pure [\"-O0\", \"-H64m\"]\n        , naturalInBaseFixArgs\n        ]\n    , hsLibrary  = notStage0 ? arg \"-O\"\n    , hsCompiler = mconcat [stage0 ? arg \"-O2\", notStage0 ? arg \"-O\"]\n    , hsGhc      = arg \"-O\" }\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.Quick (quickFlavour) where\n\nimport Expression\nimport Flavour\nimport Oracles.Flag\nimport {-# SOURCE #-} Settings.Default\nimport Settings.Flavours.Common\n\n-- Please update doc/flavours.md when changing this file.\nquickFlavour :: Flavour\nquickFlavour = defaultFlavour\n    { name        = \"quick\"\n    , args        = defaultBuilderArgs <> quickArgs <> defaultPackageArgs\n    , libraryWays = mconcat\n                    [ pure [vanilla]\n                    , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ]\n    , rtsWays     = mconcat\n                    [ pure\n                      [ vanilla, threaded, logging, debug\n                      , threadedDebug, threadedLogging, threaded ]\n                    , notStage0 ? platformSupportsSharedLibs ? pure\n                      [ dynamic, debugDynamic, threadedDynamic, loggingDynamic\n                      , threadedDebugDynamic, threadedLoggingDynamic ]\n                    ] }\n\nquickArgs :: Args\nquickArgs = sourceArgs SourceArgs\n    { hsDefault  = mconcat $\n        [ pure [\"-O0\", \"-H64m\"]\n        , naturalInBaseFixArgs\n        ]\n    , hsLibrary  = notStage0 ? arg \"-O\"\n    , hsCompiler =    stage0 ? arg \"-O2\"\n    , hsGhc      =    stage0 ? arg \"-O\" }\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.QuickCross (quickCrossFlavour) where\n\nimport Expression\nimport Flavour\nimport Oracles.Flag\nimport {-# SOURCE #-} Settings.Default\nimport Settings.Flavours.Common\n\n-- Please update doc/flavours.md when changing this file.\nquickCrossFlavour :: Flavour\nquickCrossFlavour = defaultFlavour\n    { name        = \"quick-cross\"\n    , args        = defaultBuilderArgs <> quickCrossArgs <> defaultPackageArgs\n    , dynamicGhcPrograms = pure False\n    , libraryWays = mconcat\n                    [ pure [vanilla]\n                    , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ]\n    , rtsWays     = mconcat\n                    [ pure\n                      [ vanilla, threaded, logging, debug\n                      , threadedDebug, threadedLogging, threaded ]\n                    , notStage0 ? platformSupportsSharedLibs ? pure\n                      [ dynamic, debugDynamic, threadedDynamic, loggingDynamic\n                      , threadedDebugDynamic, threadedLoggingDynamic ]\n                    ] }\n\nquickCrossArgs :: Args\nquickCrossArgs = sourceArgs SourceArgs\n    { hsDefault  = mconcat $\n        [ pure [\"-O0\", \"-H64m\"]\n        , naturalInBaseFixArgs\n        ]\n    , hsLibrary  = notStage0 ? mconcat [ arg \"-O\", arg \"-fllvm\" ]\n    , hsCompiler = stage0 ? arg \"-O2\"\n    , hsGhc      = mconcat\n                   [ stage0 ? arg \"-O\"\n                   , stage1 ? mconcat [ arg \"-O0\", arg \"-fllvm\" ] ] }\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Settings.Flavours.Quickest (quickestFlavour) where\n\nimport Expression\nimport Flavour\nimport {-# SOURCE #-} Settings.Default\nimport Settings.Flavours.Common\n\n-- Please update doc/flavours.md when changing this file.\nquickestFlavour :: Flavour\nquickestFlavour = defaultFlavour\n    { name        = \"quickest\"\n    , args        = defaultBuilderArgs <> quickestArgs <> defaultPackageArgs\n    , libraryWays = pure [vanilla]\n    , rtsWays     = pure [vanilla, threaded]\n    , dynamicGhcPrograms = return False }\n\nquickestArgs :: Args\nquickestArgs = sourceArgs SourceArgs\n    { hsDefault  = mconcat $\n        [ pure [\"-O0\", \"-H64m\"]\n        , naturalInBaseFixArgs\n        ]\n    , hsLibrary  = mempty\n    , hsCompiler = stage0 ? arg \"-O\"\n    , hsGhc      = stage0 ? arg \"-O\" }\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Way.Type where\n\nimport Data.IntSet (IntSet)\nimport qualified Data.IntSet as Set\nimport Data.List\nimport Data.Maybe\nimport Development.Shake.Classes\nimport Hadrian.Utilities\n\n-- Note: order of constructors is important for compatibility with the old build\n-- system, e.g. we want \"thr_p\", not \"p_thr\" (see instance Show Way).\n-- | A 'WayUnit' is a single way of building source code, for example with\n-- profiling enabled, or dynamically linked.\ndata WayUnit = Threaded\n             | Debug\n             | Profiling\n             | Logging\n             | Dynamic\n             deriving (Bounded, Enum, Eq, Ord)\n\n-- TODO: get rid of non-derived Show instances\ninstance Show WayUnit where\n    show unit = case unit of\n        Threaded  -> \"thr\"\n        Debug     -> \"debug\"\n        Profiling -> \"p\"\n        Logging   -> \"l\"\n        Dynamic   -> \"dyn\"\n\ninstance Read WayUnit where\n    readsPrec _ s = [(unit, \"\") | unit <- [minBound ..], show unit == s]\n\n-- | Collection of 'WayUnit's that stands for the different ways source code\n-- is to be built.\nnewtype Way = Way IntSet\n\ninstance Binary Way where\n    put = put . show\n    get = fmap read get\n\ninstance Hashable Way where\n    hashWithSalt salt = hashWithSalt salt . show\n\ninstance NFData Way where\n    rnf (Way s) = s `seq` ()\n\n-- | Construct a 'Way' from multiple 'WayUnit's. Inverse of 'wayToUnits'.\nwayFromUnits :: [WayUnit] -> Way\nwayFromUnits = Way . Set.fromList . map fromEnum\n\n-- | Split a 'Way' into its 'WayUnit' building blocks.\n-- Inverse of 'wayFromUnits'.\nwayToUnits :: Way -> [WayUnit]\nwayToUnits (Way set) = map toEnum . Set.elems $ set\n\n-- | Check whether a 'Way' contains a certain 'WayUnit'.\nwayUnit :: WayUnit -> Way -> Bool\nwayUnit unit (Way set) = fromEnum unit `Set.member` set\n\n-- | Add a 'WayUnit' to a 'Way'\naddWayUnit :: WayUnit -> Way -> Way\naddWayUnit unit (Way set) = Way . Set.insert (fromEnum unit) $ set\n\n-- | Remove a 'WayUnit' from 'Way'.\nremoveWayUnit :: WayUnit -> Way -> Way\nremoveWayUnit unit (Way set) = Way . Set.delete (fromEnum unit) $ set\n\ninstance Show Way where\n    show way = if null tag then \"v\" else tag\n      where\n        tag = intercalate \"_\" . map show . wayToUnits $ way\n\ninstance Read Way where\n    readsPrec _ s = if s == \"v\" then [(wayFromUnits [], \"\")] else result\n      where\n        uniqueReads token = case reads token of\n            [(unit, \"\")] -> Just unit\n            _            -> Nothing\n        units  = map uniqueReads . words . replaceEq '_' ' ' $ s\n        result = if Nothing `elem` units\n                 then []\n                 else [(wayFromUnits . map fromJust $ units, \"\")]\n\ninstance Eq Way where\n    Way a == Way b = a == b\n\ninstance Ord Way where\n    compare (Way a) (Way b) = compare a b\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport CmmExpr\n#if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \\\n    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc))\nimport Panic\n#endif\nimport Reg\n\n#include \"ghcautoconf.h\"\n#include \"stg/MachRegs.h\"\n\n#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)\n\n# if defined(MACHREGS_i386)\n#  define eax 0\n#  define ebx 1\n#  define ecx 2\n#  define edx 3\n#  define esi 4\n#  define edi 5\n#  define ebp 6\n#  define esp 7\n# endif\n\n# if defined(MACHREGS_x86_64)\n#  define rax   0\n#  define rbx   1\n#  define rcx   2\n#  define rdx   3\n#  define rsi   4\n#  define rdi   5\n#  define rbp   6\n#  define rsp   7\n#  define r8    8\n#  define r9    9\n#  define r10   10\n#  define r11   11\n#  define r12   12\n#  define r13   13\n#  define r14   14\n#  define r15   15\n# endif\n\n# define fake0 16\n# define fake1 17\n# define fake2 18\n# define fake3 19\n# define fake4 20\n# define fake5 21\n\n-- N.B. XMM, YMM, and ZMM are all aliased to the same hardware registers hence\n-- being assigned the same RegNos.\n# define xmm0  24\n# define xmm1  25\n# define xmm2  26\n# define xmm3  27\n# define xmm4  28\n# define xmm5  29\n# define xmm6  30\n# define xmm7  31\n# define xmm8  32\n# define xmm9  33\n# define xmm10 34\n# define xmm11 35\n# define xmm12 36\n# define xmm13 37\n# define xmm14 38\n# define xmm15 39\n\n# define ymm0  24\n# define ymm1  25\n# define ymm2  26\n# define ymm3  27\n# define ymm4  28\n# define ymm5  29\n# define ymm6  30\n# define ymm7  31\n# define ymm8  32\n# define ymm9  33\n# define ymm10 34\n# define ymm11 35\n# define ymm12 36\n# define ymm13 37\n# define ymm14 38\n# define ymm15 39\n\n# define zmm0  24\n# define zmm1  25\n# define zmm2  26\n# define zmm3  27\n# define zmm4  28\n# define zmm5  29\n# define zmm6  30\n# define zmm7  31\n# define zmm8  32\n# define zmm9  33\n# define zmm10 34\n# define zmm11 35\n# define zmm12 36\n# define zmm13 37\n# define zmm14 38\n# define zmm15 39\n\n-- Note: these are only needed for ARM/ARM64 because globalRegMaybe is now used in CmmSink.hs.\n-- Since it's only used to check 'isJust', the actual values don't matter, thus\n-- I'm not sure if these are the correct numberings.\n-- Normally, the register names are just stringified as part of the REG() macro\n\n#elif defined(MACHREGS_powerpc) || defined(MACHREGS_arm) \\\n    || defined(MACHREGS_aarch64)\n\n# define r0 0\n# define r1 1\n# define r2 2\n# define r3 3\n# define r4 4\n# define r5 5\n# define r6 6\n# define r7 7\n# define r8 8\n# define r9 9\n# define r10 10\n# define r11 11\n# define r12 12\n# define r13 13\n# define r14 14\n# define r15 15\n# define r16 16\n# define r17 17\n# define r18 18\n# define r19 19\n# define r20 20\n# define r21 21\n# define r22 22\n# define r23 23\n# define r24 24\n# define r25 25\n# define r26 26\n# define r27 27\n# define r28 28\n# define r29 29\n# define r30 30\n# define r31 31\n\n-- See note above. These aren't actually used for anything except satisfying the compiler for globalRegMaybe\n-- so I'm unsure if they're the correct numberings, should they ever be attempted to be used in the NCG.\n#if defined(MACHREGS_aarch64) || defined(MACHREGS_arm)\n# define s0 32\n# define s1 33\n# define s2 34\n# define s3 35\n# define s4 36\n# define s5 37\n# define s6 38\n# define s7 39\n# define s8 40\n# define s9 41\n# define s10 42\n# define s11 43\n# define s12 44\n# define s13 45\n# define s14 46\n# define s15 47\n# define s16 48\n# define s17 49\n# define s18 50\n# define s19 51\n# define s20 52\n# define s21 53\n# define s22 54\n# define s23 55\n# define s24 56\n# define s25 57\n# define s26 58\n# define s27 59\n# define s28 60\n# define s29 61\n# define s30 62\n# define s31 63\n\n# define d0 32\n# define d1 33\n# define d2 34\n# define d3 35\n# define d4 36\n# define d5 37\n# define d6 38\n# define d7 39\n# define d8 40\n# define d9 41\n# define d10 42\n# define d11 43\n# define d12 44\n# define d13 45\n# define d14 46\n# define d15 47\n# define d16 48\n# define d17 49\n# define d18 50\n# define d19 51\n# define d20 52\n# define d21 53\n# define d22 54\n# define d23 55\n# define d24 56\n# define d25 57\n# define d26 58\n# define d27 59\n# define d28 60\n# define d29 61\n# define d30 62\n# define d31 63\n#endif\n\n# if defined(MACHREGS_darwin)\n#  define f0  32\n#  define f1  33\n#  define f2  34\n#  define f3  35\n#  define f4  36\n#  define f5  37\n#  define f6  38\n#  define f7  39\n#  define f8  40\n#  define f9  41\n#  define f10 42\n#  define f11 43\n#  define f12 44\n#  define f13 45\n#  define f14 46\n#  define f15 47\n#  define f16 48\n#  define f17 49\n#  define f18 50\n#  define f19 51\n#  define f20 52\n#  define f21 53\n#  define f22 54\n#  define f23 55\n#  define f24 56\n#  define f25 57\n#  define f26 58\n#  define f27 59\n#  define f28 60\n#  define f29 61\n#  define f30 62\n#  define f31 63\n# else\n#  define fr0  32\n#  define fr1  33\n#  define fr2  34\n#  define fr3  35\n#  define fr4  36\n#  define fr5  37\n#  define fr6  38\n#  define fr7  39\n#  define fr8  40\n#  define fr9  41\n#  define fr10 42\n#  define fr11 43\n#  define fr12 44\n#  define fr13 45\n#  define fr14 46\n#  define fr15 47\n#  define fr16 48\n#  define fr17 49\n#  define fr18 50\n#  define fr19 51\n#  define fr20 52\n#  define fr21 53\n#  define fr22 54\n#  define fr23 55\n#  define fr24 56\n#  define fr25 57\n#  define fr26 58\n#  define fr27 59\n#  define fr28 60\n#  define fr29 61\n#  define fr30 62\n#  define fr31 63\n# endif\n\n#elif defined(MACHREGS_sparc)\n\n# define g0  0\n# define g1  1\n# define g2  2\n# define g3  3\n# define g4  4\n# define g5  5\n# define g6  6\n# define g7  7\n\n# define o0  8\n# define o1  9\n# define o2  10\n# define o3  11\n# define o4  12\n# define o5  13\n# define o6  14\n# define o7  15\n\n# define l0  16\n# define l1  17\n# define l2  18\n# define l3  19\n# define l4  20\n# define l5  21\n# define l6  22\n# define l7  23\n\n# define i0  24\n# define i1  25\n# define i2  26\n# define i3  27\n# define i4  28\n# define i5  29\n# define i6  30\n# define i7  31\n\n# define f0  32\n# define f1  33\n# define f2  34\n# define f3  35\n# define f4  36\n# define f5  37\n# define f6  38\n# define f7  39\n# define f8  40\n# define f9  41\n# define f10 42\n# define f11 43\n# define f12 44\n# define f13 45\n# define f14 46\n# define f15 47\n# define f16 48\n# define f17 49\n# define f18 50\n# define f19 51\n# define f20 52\n# define f21 53\n# define f22 54\n# define f23 55\n# define f24 56\n# define f25 57\n# define f26 58\n# define f27 59\n# define f28 60\n# define f29 61\n# define f30 62\n# define f31 63\n\n#endif\n\ncallerSaves :: GlobalReg -> Bool\n#if defined(CALLER_SAVES_Base)\ncallerSaves BaseReg           = True\n#endif\n#if defined(CALLER_SAVES_R1)\ncallerSaves (VanillaReg 1 _)  = True\n#endif\n#if defined(CALLER_SAVES_R2)\ncallerSaves (VanillaReg 2 _)  = True\n#endif\n#if defined(CALLER_SAVES_R3)\ncallerSaves (VanillaReg 3 _)  = True\n#endif\n#if defined(CALLER_SAVES_R4)\ncallerSaves (VanillaReg 4 _)  = True\n#endif\n#if defined(CALLER_SAVES_R5)\ncallerSaves (VanillaReg 5 _)  = True\n#endif\n#if defined(CALLER_SAVES_R6)\ncallerSaves (VanillaReg 6 _)  = True\n#endif\n#if defined(CALLER_SAVES_R7)\ncallerSaves (VanillaReg 7 _)  = True\n#endif\n#if defined(CALLER_SAVES_R8)\ncallerSaves (VanillaReg 8 _)  = True\n#endif\n#if defined(CALLER_SAVES_R9)\ncallerSaves (VanillaReg 9 _)  = True\n#endif\n#if defined(CALLER_SAVES_R10)\ncallerSaves (VanillaReg 10 _) = True\n#endif\n#if defined(CALLER_SAVES_F1)\ncallerSaves (FloatReg 1)      = True\n#endif\n#if defined(CALLER_SAVES_F2)\ncallerSaves (FloatReg 2)      = True\n#endif\n#if defined(CALLER_SAVES_F3)\ncallerSaves (FloatReg 3)      = True\n#endif\n#if defined(CALLER_SAVES_F4)\ncallerSaves (FloatReg 4)      = True\n#endif\n#if defined(CALLER_SAVES_F5)\ncallerSaves (FloatReg 5)      = True\n#endif\n#if defined(CALLER_SAVES_F6)\ncallerSaves (FloatReg 6)      = True\n#endif\n#if defined(CALLER_SAVES_D1)\ncallerSaves (DoubleReg 1)     = True\n#endif\n#if defined(CALLER_SAVES_D2)\ncallerSaves (DoubleReg 2)     = True\n#endif\n#if defined(CALLER_SAVES_D3)\ncallerSaves (DoubleReg 3)     = True\n#endif\n#if defined(CALLER_SAVES_D4)\ncallerSaves (DoubleReg 4)     = True\n#endif\n#if defined(CALLER_SAVES_D5)\ncallerSaves (DoubleReg 5)     = True\n#endif\n#if defined(CALLER_SAVES_D6)\ncallerSaves (DoubleReg 6)     = True\n#endif\n#if defined(CALLER_SAVES_L1)\ncallerSaves (LongReg 1)       = True\n#endif\n#if defined(CALLER_SAVES_Sp)\ncallerSaves Sp                = True\n#endif\n#if defined(CALLER_SAVES_SpLim)\ncallerSaves SpLim             = True\n#endif\n#if defined(CALLER_SAVES_Hp)\ncallerSaves Hp                = True\n#endif\n#if defined(CALLER_SAVES_HpLim)\ncallerSaves HpLim             = True\n#endif\n#if defined(CALLER_SAVES_CCCS)\ncallerSaves CCCS              = True\n#endif\n#if defined(CALLER_SAVES_CurrentTSO)\ncallerSaves CurrentTSO        = True\n#endif\n#if defined(CALLER_SAVES_CurrentNursery)\ncallerSaves CurrentNursery    = True\n#endif\ncallerSaves _                 = False\n\nactiveStgRegs :: [GlobalReg]\nactiveStgRegs = [\n#if defined(REG_Base)\n    BaseReg\n#endif\n#if defined(REG_Sp)\n    ,Sp\n#endif\n#if defined(REG_Hp)\n    ,Hp\n#endif\n#if defined(REG_R1)\n    ,VanillaReg 1 VGcPtr\n#endif\n#if defined(REG_R2)\n    ,VanillaReg 2 VGcPtr\n#endif\n#if defined(REG_R3)\n    ,VanillaReg 3 VGcPtr\n#endif\n#if defined(REG_R4)\n    ,VanillaReg 4 VGcPtr\n#endif\n#if defined(REG_R5)\n    ,VanillaReg 5 VGcPtr\n#endif\n#if defined(REG_R6)\n    ,VanillaReg 6 VGcPtr\n#endif\n#if defined(REG_R7)\n    ,VanillaReg 7 VGcPtr\n#endif\n#if defined(REG_R8)\n    ,VanillaReg 8 VGcPtr\n#endif\n#if defined(REG_R9)\n    ,VanillaReg 9 VGcPtr\n#endif\n#if defined(REG_R10)\n    ,VanillaReg 10 VGcPtr\n#endif\n#if defined(REG_SpLim)\n    ,SpLim\n#endif\n#if MAX_REAL_XMM_REG != 0\n#if defined(REG_F1)\n    ,FloatReg 1\n#endif\n#if defined(REG_D1)\n    ,DoubleReg 1\n#endif\n#if defined(REG_XMM1)\n    ,XmmReg 1\n#endif\n#if defined(REG_YMM1)\n    ,YmmReg 1\n#endif\n#if defined(REG_ZMM1)\n    ,ZmmReg 1\n#endif\n#if defined(REG_F2)\n    ,FloatReg 2\n#endif\n#if defined(REG_D2)\n    ,DoubleReg 2\n#endif\n#if defined(REG_XMM2)\n    ,XmmReg 2\n#endif\n#if defined(REG_YMM2)\n    ,YmmReg 2\n#endif\n#if defined(REG_ZMM2)\n    ,ZmmReg 2\n#endif\n#if defined(REG_F3)\n    ,FloatReg 3\n#endif\n#if defined(REG_D3)\n    ,DoubleReg 3\n#endif\n#if defined(REG_XMM3)\n    ,XmmReg 3\n#endif\n#if defined(REG_YMM3)\n    ,YmmReg 3\n#endif\n#if defined(REG_ZMM3)\n    ,ZmmReg 3\n#endif\n#if defined(REG_F4)\n    ,FloatReg 4\n#endif\n#if defined(REG_D4)\n    ,DoubleReg 4\n#endif\n#if defined(REG_XMM4)\n    ,XmmReg 4\n#endif\n#if defined(REG_YMM4)\n    ,YmmReg 4\n#endif\n#if defined(REG_ZMM4)\n    ,ZmmReg 4\n#endif\n#if defined(REG_F5)\n    ,FloatReg 5\n#endif\n#if defined(REG_D5)\n    ,DoubleReg 5\n#endif\n#if defined(REG_XMM5)\n    ,XmmReg 5\n#endif\n#if defined(REG_YMM5)\n    ,YmmReg 5\n#endif\n#if defined(REG_ZMM5)\n    ,ZmmReg 5\n#endif\n#if defined(REG_F6)\n    ,FloatReg 6\n#endif\n#if defined(REG_D6)\n    ,DoubleReg 6\n#endif\n#if defined(REG_XMM6)\n    ,XmmReg 6\n#endif\n#if defined(REG_YMM6)\n    ,YmmReg 6\n#endif\n#if defined(REG_ZMM6)\n    ,ZmmReg 6\n#endif\n#else /* MAX_REAL_XMM_REG == 0 */\n#if defined(REG_F1)\n    ,FloatReg 1\n#endif\n#if defined(REG_F2)\n    ,FloatReg 2\n#endif\n#if defined(REG_F3)\n    ,FloatReg 3\n#endif\n#if defined(REG_F4)\n    ,FloatReg 4\n#endif\n#if defined(REG_F5)\n    ,FloatReg 5\n#endif\n#if defined(REG_F6)\n    ,FloatReg 6\n#endif\n#if defined(REG_D1)\n    ,DoubleReg 1\n#endif\n#if defined(REG_D2)\n    ,DoubleReg 2\n#endif\n#if defined(REG_D3)\n    ,DoubleReg 3\n#endif\n#if defined(REG_D4)\n    ,DoubleReg 4\n#endif\n#if defined(REG_D5)\n    ,DoubleReg 5\n#endif\n#if defined(REG_D6)\n    ,DoubleReg 6\n#endif\n#endif /* MAX_REAL_XMM_REG == 0 */\n    ]\n\nhaveRegBase :: Bool\n#if defined(REG_Base)\nhaveRegBase = True\n#else\nhaveRegBase = False\n#endif\n\n--  | Returns 'Nothing' if this global register is not stored\n-- in a real machine register, otherwise returns @'Just' reg@, where\n-- reg is the machine register it is stored in.\nglobalRegMaybe :: GlobalReg -> Maybe RealReg\n#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \\\n    || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc) \\\n    || defined(MACHREGS_arm) || defined(MACHREGS_aarch64)\n# if defined(REG_Base)\nglobalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)\n# endif\n# if defined(REG_R1)\nglobalRegMaybe (VanillaReg 1 _)         = Just (RealRegSingle REG_R1)\n# endif\n# if defined(REG_R2)\nglobalRegMaybe (VanillaReg 2 _)         = Just (RealRegSingle REG_R2)\n# endif\n# if defined(REG_R3)\nglobalRegMaybe (VanillaReg 3 _)         = Just (RealRegSingle REG_R3)\n# endif\n# if defined(REG_R4)\nglobalRegMaybe (VanillaReg 4 _)         = Just (RealRegSingle REG_R4)\n# endif\n# if defined(REG_R5)\nglobalRegMaybe (VanillaReg 5 _)         = Just (RealRegSingle REG_R5)\n# endif\n# if defined(REG_R6)\nglobalRegMaybe (VanillaReg 6 _)         = Just (RealRegSingle REG_R6)\n# endif\n# if defined(REG_R7)\nglobalRegMaybe (VanillaReg 7 _)         = Just (RealRegSingle REG_R7)\n# endif\n# if defined(REG_R8)\nglobalRegMaybe (VanillaReg 8 _)         = Just (RealRegSingle REG_R8)\n# endif\n# if defined(REG_R9)\nglobalRegMaybe (VanillaReg 9 _)         = Just (RealRegSingle REG_R9)\n# endif\n# if defined(REG_R10)\nglobalRegMaybe (VanillaReg 10 _)        = Just (RealRegSingle REG_R10)\n# endif\n# if defined(REG_F1)\nglobalRegMaybe (FloatReg 1)             = Just (RealRegSingle REG_F1)\n# endif\n# if defined(REG_F2)\nglobalRegMaybe (FloatReg 2)             = Just (RealRegSingle REG_F2)\n# endif\n# if defined(REG_F3)\nglobalRegMaybe (FloatReg 3)             = Just (RealRegSingle REG_F3)\n# endif\n# if defined(REG_F4)\nglobalRegMaybe (FloatReg 4)             = Just (RealRegSingle REG_F4)\n# endif\n# if defined(REG_F5)\nglobalRegMaybe (FloatReg 5)             = Just (RealRegSingle REG_F5)\n# endif\n# if defined(REG_F6)\nglobalRegMaybe (FloatReg 6)             = Just (RealRegSingle REG_F6)\n# endif\n# if defined(REG_D1)\nglobalRegMaybe (DoubleReg 1)            =\n#  if defined(MACHREGS_sparc)\n                                          Just (RealRegPair REG_D1 (REG_D1 + 1))\n#  else\n                                          Just (RealRegSingle REG_D1)\n#  endif\n# endif\n# if defined(REG_D2)\nglobalRegMaybe (DoubleReg 2)            =\n#  if defined(MACHREGS_sparc)\n                                          Just (RealRegPair REG_D2 (REG_D2 + 1))\n#  else\n                                          Just (RealRegSingle REG_D2)\n#  endif\n# endif\n# if defined(REG_D3)\nglobalRegMaybe (DoubleReg 3)            =\n#  if defined(MACHREGS_sparc)\n                                          Just (RealRegPair REG_D3 (REG_D3 + 1))\n#  else\n                                          Just (RealRegSingle REG_D3)\n#  endif\n# endif\n# if defined(REG_D4)\nglobalRegMaybe (DoubleReg 4)            =\n#  if defined(MACHREGS_sparc)\n                                          Just (RealRegPair REG_D4 (REG_D4 + 1))\n#  else\n                                          Just (RealRegSingle REG_D4)\n#  endif\n# endif\n# if defined(REG_D5)\nglobalRegMaybe (DoubleReg 5)            =\n#  if defined(MACHREGS_sparc)\n                                          Just (RealRegPair REG_D5 (REG_D5 + 1))\n#  else\n                                          Just (RealRegSingle REG_D5)\n#  endif\n# endif\n# if defined(REG_D6)\nglobalRegMaybe (DoubleReg 6)            =\n#  if defined(MACHREGS_sparc)\n                                          Just (RealRegPair REG_D6 (REG_D6 + 1))\n#  else\n                                          Just (RealRegSingle REG_D6)\n#  endif\n# endif\n# if MAX_REAL_XMM_REG != 0\n#  if defined(REG_XMM1)\nglobalRegMaybe (XmmReg 1)               = Just (RealRegSingle REG_XMM1)\n#  endif\n#  if defined(REG_XMM2)\nglobalRegMaybe (XmmReg 2)               = Just (RealRegSingle REG_XMM2)\n#  endif\n#  if defined(REG_XMM3)\nglobalRegMaybe (XmmReg 3)               = Just (RealRegSingle REG_XMM3)\n#  endif\n#  if defined(REG_XMM4)\nglobalRegMaybe (XmmReg 4)               = Just (RealRegSingle REG_XMM4)\n#  endif\n#  if defined(REG_XMM5)\nglobalRegMaybe (XmmReg 5)               = Just (RealRegSingle REG_XMM5)\n#  endif\n#  if defined(REG_XMM6)\nglobalRegMaybe (XmmReg 6)               = Just (RealRegSingle REG_XMM6)\n#  endif\n# endif\n# if defined(MAX_REAL_YMM_REG) && MAX_REAL_YMM_REG != 0\n#  if defined(REG_YMM1)\nglobalRegMaybe (YmmReg 1)               = Just (RealRegSingle REG_YMM1)\n#  endif\n#  if defined(REG_YMM2)\nglobalRegMaybe (YmmReg 2)               = Just (RealRegSingle REG_YMM2)\n#  endif\n#  if defined(REG_YMM3)\nglobalRegMaybe (YmmReg 3)               = Just (RealRegSingle REG_YMM3)\n#  endif\n#  if defined(REG_YMM4)\nglobalRegMaybe (YmmReg 4)               = Just (RealRegSingle REG_YMM4)\n#  endif\n#  if defined(REG_YMM5)\nglobalRegMaybe (YmmReg 5)               = Just (RealRegSingle REG_YMM5)\n#  endif\n#  if defined(REG_YMM6)\nglobalRegMaybe (YmmReg 6)               = Just (RealRegSingle REG_YMM6)\n#  endif\n# endif\n# if defined(MAX_REAL_ZMM_REG) && MAX_REAL_ZMM_REG != 0\n#  if defined(REG_ZMM1)\nglobalRegMaybe (ZmmReg 1)               = Just (RealRegSingle REG_ZMM1)\n#  endif\n#  if defined(REG_ZMM2)\nglobalRegMaybe (ZmmReg 2)               = Just (RealRegSingle REG_ZMM2)\n#  endif\n#  if defined(REG_ZMM3)\nglobalRegMaybe (ZmmReg 3)               = Just (RealRegSingle REG_ZMM3)\n#  endif\n#  if defined(REG_ZMM4)\nglobalRegMaybe (ZmmReg 4)               = Just (RealRegSingle REG_ZMM4)\n#  endif\n#  if defined(REG_ZMM5)\nglobalRegMaybe (ZmmReg 5)               = Just (RealRegSingle REG_ZMM5)\n#  endif\n#  if defined(REG_ZMM6)\nglobalRegMaybe (ZmmReg 6)               = Just (RealRegSingle REG_ZMM6)\n#  endif\n# endif\n# if defined(REG_Sp)\nglobalRegMaybe Sp                       = Just (RealRegSingle REG_Sp)\n# endif\n# if defined(REG_Lng1)\nglobalRegMaybe (LongReg 1)              = Just (RealRegSingle REG_Lng1)\n# endif\n# if defined(REG_Lng2)\nglobalRegMaybe (LongReg 2)              = Just (RealRegSingle REG_Lng2)\n# endif\n# if defined(REG_SpLim)\nglobalRegMaybe SpLim                    = Just (RealRegSingle REG_SpLim)\n# endif\n# if defined(REG_Hp)\nglobalRegMaybe Hp                       = Just (RealRegSingle REG_Hp)\n# endif\n# if defined(REG_HpLim)\nglobalRegMaybe HpLim                    = Just (RealRegSingle REG_HpLim)\n# endif\n# if defined(REG_CurrentTSO)\nglobalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)\n# endif\n# if defined(REG_CurrentNursery)\nglobalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)\n# endif\n# if defined(REG_MachSp)\nglobalRegMaybe MachSp                   = Just (RealRegSingle REG_MachSp)\n# endif\nglobalRegMaybe _                        = Nothing\n#elif defined(MACHREGS_NO_REGS)\nglobalRegMaybe _ = Nothing\n#else\nglobalRegMaybe = panic \"globalRegMaybe not defined for this platform\"\n#endif\n\nfreeReg :: RegNo -> Bool\n\n#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)\n\n# if defined(MACHREGS_i386)\nfreeReg esp = False -- %esp is the C stack pointer\nfreeReg esi = False -- Note [esi/edi/ebp not allocatable]\nfreeReg edi = False\nfreeReg ebp = False\n# endif\n# if defined(MACHREGS_x86_64)\nfreeReg rsp = False  --        %rsp is the C stack pointer\n# endif\n\n{-\nNote [esi/edi/ebp not allocatable]\n\n%esi is mapped to R1, so %esi would normally be allocatable while it\nis not being used for R1.  However, %esi has no 8-bit version on x86,\nand the linear register allocator is not sophisticated enough to\nhandle this irregularity (we need more RegClasses).  The\ngraph-colouring allocator also cannot handle this - it was designed\nwith more flexibility in mind, but the current implementation is\nrestricted to the same set of classes as the linear allocator.\n\nHence, on x86 esi, edi and ebp are treated as not allocatable.\n-}\n\n-- split patterns in two functions to prevent overlaps\nfreeReg r         = freeRegBase r\n\nfreeRegBase :: RegNo -> Bool\n# if defined(REG_Base)\nfreeRegBase REG_Base  = False\n# endif\n# if defined(REG_Sp)\nfreeRegBase REG_Sp    = False\n# endif\n# if defined(REG_SpLim)\nfreeRegBase REG_SpLim = False\n# endif\n# if defined(REG_Hp)\nfreeRegBase REG_Hp    = False\n# endif\n# if defined(REG_HpLim)\nfreeRegBase REG_HpLim = False\n# endif\n-- All other regs are considered to be \"free\", because we can track\n-- their liveness accurately.\nfreeRegBase _ = True\n\n#elif defined(MACHREGS_powerpc)\n\nfreeReg 0 = False -- Used by code setting the back chain pointer\n                  -- in stack reallocations on Linux.\n                  -- Moreover r0 is not usable in all insns.\nfreeReg 1 = False -- The Stack Pointer\n-- most ELF PowerPC OSes use r2 as a TOC pointer\nfreeReg 2 = False\nfreeReg 13 = False -- reserved for system thread ID on 64 bit\n-- at least linux in -fPIC relies on r30 in PLT stubs\nfreeReg 30 = False\n{- TODO: reserve r13 on 64 bit systems only and r30 on 32 bit respectively.\n   For now we use r30 on 64 bit and r13 on 32 bit as a temporary register\n   in stack handling code. See compiler/nativeGen/PPC/Instr.hs.\n\n   Later we might want to reserve r13 and r30 only where it is required.\n   Then use r12 as temporary register, which is also what the C ABI does.\n-}\n\n# if defined(REG_Base)\nfreeReg REG_Base  = False\n# endif\n# if defined(REG_R1)\nfreeReg REG_R1    = False\n# endif\n# if defined(REG_R2)\nfreeReg REG_R2    = False\n# endif\n# if defined(REG_R3)\nfreeReg REG_R3    = False\n# endif\n# if defined(REG_R4)\nfreeReg REG_R4    = False\n# endif\n# if defined(REG_R5)\nfreeReg REG_R5    = False\n# endif\n# if defined(REG_R6)\nfreeReg REG_R6    = False\n# endif\n# if defined(REG_R7)\nfreeReg REG_R7    = False\n# endif\n# if defined(REG_R8)\nfreeReg REG_R8    = False\n# endif\n# if defined(REG_R9)\nfreeReg REG_R9    = False\n# endif\n# if defined(REG_R10)\nfreeReg REG_R10   = False\n# endif\n# if defined(REG_F1)\nfreeReg REG_F1    = False\n# endif\n# if defined(REG_F2)\nfreeReg REG_F2    = False\n# endif\n# if defined(REG_F3)\nfreeReg REG_F3    = False\n# endif\n# if defined(REG_F4)\nfreeReg REG_F4    = False\n# endif\n# if defined(REG_F5)\nfreeReg REG_F5    = False\n# endif\n# if defined(REG_F6)\nfreeReg REG_F6    = False\n# endif\n# if defined(REG_D1)\nfreeReg REG_D1    = False\n# endif\n# if defined(REG_D2)\nfreeReg REG_D2    = False\n# endif\n# if defined(REG_D3)\nfreeReg REG_D3    = False\n# endif\n# if defined(REG_D4)\nfreeReg REG_D4    = False\n# endif\n# if defined(REG_D5)\nfreeReg REG_D5    = False\n# endif\n# if defined(REG_D6)\nfreeReg REG_D6    = False\n# endif\n# if defined(REG_Sp)\nfreeReg REG_Sp    = False\n# endif\n# if defined(REG_Su)\nfreeReg REG_Su    = False\n# endif\n# if defined(REG_SpLim)\nfreeReg REG_SpLim = False\n# endif\n# if defined(REG_Hp)\nfreeReg REG_Hp    = False\n# endif\n# if defined(REG_HpLim)\nfreeReg REG_HpLim = False\n# endif\nfreeReg _ = True\n\n#elif defined(MACHREGS_sparc)\n\n-- SPARC regs used by the OS / ABI\n-- %g0(r0) is always zero\nfreeReg g0  = False\n\n-- %g5(r5) - %g7(r7)\n--  are reserved for the OS\nfreeReg g5  = False\nfreeReg g6  = False\nfreeReg g7  = False\n\n-- %o6(r14)\n--  is the C stack pointer\nfreeReg o6  = False\n\n-- %o7(r15)\n--  holds the C return address\nfreeReg o7  = False\n\n-- %i6(r30)\n--  is the C frame pointer\nfreeReg i6  = False\n\n-- %i7(r31)\n--  is used for C return addresses\nfreeReg i7  = False\n\n-- %f0(r32) - %f1(r32)\n--  are C floating point return regs\nfreeReg f0  = False\nfreeReg f1  = False\n\n{-\nfreeReg regNo\n    -- don't release high half of double regs\n    | regNo >= f0\n    , regNo <  NCG_FirstFloatReg\n    , regNo `mod` 2 /= 0\n    = False\n-}\n\n# if defined(REG_Base)\nfreeReg REG_Base  = False\n# endif\n# if defined(REG_R1)\nfreeReg REG_R1    = False\n# endif\n# if defined(REG_R2)\nfreeReg REG_R2    = False\n# endif\n# if defined(REG_R3)\nfreeReg REG_R3    = False\n# endif\n# if defined(REG_R4)\nfreeReg REG_R4    = False\n# endif\n# if defined(REG_R5)\nfreeReg REG_R5    = False\n# endif\n# if defined(REG_R6)\nfreeReg REG_R6    = False\n# endif\n# if defined(REG_R7)\nfreeReg REG_R7    = False\n# endif\n# if defined(REG_R8)\nfreeReg REG_R8    = False\n# endif\n# if defined(REG_R9)\nfreeReg REG_R9    = False\n# endif\n# if defined(REG_R10)\nfreeReg REG_R10   = False\n# endif\n# if defined(REG_F1)\nfreeReg REG_F1    = False\n# endif\n# if defined(REG_F2)\nfreeReg REG_F2    = False\n# endif\n# if defined(REG_F3)\nfreeReg REG_F3    = False\n# endif\n# if defined(REG_F4)\nfreeReg REG_F4    = False\n# endif\n# if defined(REG_F5)\nfreeReg REG_F5    = False\n# endif\n# if defined(REG_F6)\nfreeReg REG_F6    = False\n# endif\n# if defined(REG_D1)\nfreeReg REG_D1    = False\n# endif\n# if defined(REG_D1_2)\nfreeReg REG_D1_2  = False\n# endif\n# if defined(REG_D2)\nfreeReg REG_D2    = False\n# endif\n# if defined(REG_D2_2)\nfreeReg REG_D2_2  = False\n# endif\n# if defined(REG_D3)\nfreeReg REG_D3    = False\n# endif\n# if defined(REG_D3_2)\nfreeReg REG_D3_2  = False\n# endif\n# if defined(REG_D4)\nfreeReg REG_D4    = False\n# endif\n# if defined(REG_D4_2)\nfreeReg REG_D4_2  = False\n# endif\n# if defined(REG_D5)\nfreeReg REG_D5    = False\n# endif\n# if defined(REG_D5_2)\nfreeReg REG_D5_2  = False\n# endif\n# if defined(REG_D6)\nfreeReg REG_D6    = False\n# endif\n# if defined(REG_D6_2)\nfreeReg REG_D6_2  = False\n# endif\n# if defined(REG_Sp)\nfreeReg REG_Sp    = False\n# endif\n# if defined(REG_Su)\nfreeReg REG_Su    = False\n# endif\n# if defined(REG_SpLim)\nfreeReg REG_SpLim = False\n# endif\n# if defined(REG_Hp)\nfreeReg REG_Hp    = False\n# endif\n# if defined(REG_HpLim)\nfreeReg REG_HpLim = False\n# endif\nfreeReg _ = True\n\n#else\n\nfreeReg = panic \"freeReg not defined for this platform\"\n\n#endif\n\n", "num_lines": 1142}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A collection of data types, classes, and functions for interfacing\n-- with another programming language.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign\n        ( module Data.Bits\n        , module Data.Int\n        , module Data.Word\n        , module Foreign.Ptr\n        , module Foreign.ForeignPtr\n        , module Foreign.StablePtr\n        , module Foreign.Storable\n        , module Foreign.Marshal\n        ) where\n\nimport Data.Bits\nimport Data.Int\nimport Data.Word\nimport Foreign.Ptr\nimport Foreign.ForeignPtr\nimport Foreign.StablePtr\nimport Foreign.Storable\nimport Foreign.Marshal\n\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Numeric\n-- Copyright   :  (c) The University of Glasgow 2002\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Odds and ends, mostly functions for reading and showing\n-- 'RealFloat'-like kind of values.\n--\n-----------------------------------------------------------------------------\n\nmodule Numeric (\n\n        -- * Showing\n\n        showSigned,\n\n        showIntAtBase,\n        showInt,\n        showHex,\n        showOct,\n\n        showEFloat,\n        showFFloat,\n        showGFloat,\n        showFFloatAlt,\n        showGFloatAlt,\n        showFloat,\n        showHFloat,\n\n        floatToDigits,\n\n        -- * Reading\n\n        -- | /NB:/ 'readInt' is the \\'dual\\' of 'showIntAtBase',\n        -- and 'readDec' is the \\`dual\\' of 'showInt'.\n        -- The inconsistent naming is a historical accident.\n\n        readSigned,\n\n        readInt,\n        readDec,\n        readOct,\n        readHex,\n\n        readFloat,\n\n        lexDigits,\n\n        -- * Miscellaneous\n\n        fromRat,\n        Floating(..)\n\n        ) where\n\nimport GHC.Base\nimport GHC.Read\nimport GHC.Real\nimport GHC.Float\nimport GHC.Num\nimport GHC.Show\nimport Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )\nimport qualified Text.Read.Lex as L\n\n\n-- -----------------------------------------------------------------------------\n-- Reading\n\n-- | Reads an /unsigned/ 'Integral' value in an arbitrary base.\nreadInt :: Num a\n  => a                  -- ^ the base\n  -> (Char -> Bool)     -- ^ a predicate distinguishing valid digits in this base\n  -> (Char -> Int)      -- ^ a function converting a valid digit character to an 'Int'\n  -> ReadS a\nreadInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)\n\n-- | Read an unsigned number in octal notation.\n--\n-- >>> readOct \"0644\"\n-- [(420,\"\")]\nreadOct :: (Eq a, Num a) => ReadS a\nreadOct = readP_to_S L.readOctP\n\n-- | Read an unsigned number in decimal notation.\n--\n-- >>> readDec \"0644\"\n-- [(644,\"\")]\nreadDec :: (Eq a, Num a) => ReadS a\nreadDec = readP_to_S L.readDecP\n\n-- | Read an unsigned number in hexadecimal notation.\n-- Both upper or lower case letters are allowed.\n--\n-- >>> readHex \"deadbeef\"\n-- [(3735928559,\"\")]\nreadHex :: (Eq a, Num a) => ReadS a\nreadHex = readP_to_S L.readHexP\n\n-- | Reads an /unsigned/ 'RealFrac' value,\n-- expressed in decimal scientific notation.\nreadFloat :: RealFrac a => ReadS a\nreadFloat = readP_to_S readFloatP\n\nreadFloatP :: RealFrac a => ReadP a\nreadFloatP =\n  do tok <- L.lex\n     case tok of\n       L.Number n -> return $ fromRational $ L.numberToRational n\n       _          -> pfail\n\n-- It's turgid to have readSigned work using list comprehensions,\n-- but it's specified as a ReadS to ReadS transformer\n-- With a bit of luck no one will use it.\n\n-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.\nreadSigned :: (Real a) => ReadS a -> ReadS a\nreadSigned readPos = readParen False read'\n                     where read' r  = read'' r ++\n                                      (do\n                                        (\"-\",s) <- lex r\n                                        (x,t)   <- read'' s\n                                        return (-x,t))\n                           read'' r = do\n                               (str,s) <- lex r\n                               (n,\"\")  <- readPos str\n                               return (n,s)\n\n-- -----------------------------------------------------------------------------\n-- Showing\n\n-- | Show /non-negative/ 'Integral' numbers in base 10.\nshowInt :: Integral a => a -> ShowS\nshowInt n0 cs0\n    | n0 < 0    = errorWithoutStackTrace \"Numeric.showInt: can't show negative numbers\"\n    | otherwise = go n0 cs0\n    where\n    go n cs\n        | n < 10    = case unsafeChr (ord '0' + fromIntegral n) of\n            c@(C# _) -> c:cs\n        | otherwise = case unsafeChr (ord '0' + fromIntegral r) of\n            c@(C# _) -> go q (c:cs)\n        where\n        (q,r) = n `quotRem` 10\n\n-- Controlling the format and precision of floats. The code that\n-- implements the formatting itself is in @PrelNum@ to avoid\n-- mutual module deps.\n\n{-# SPECIALIZE showEFloat ::\n        Maybe Int -> Float  -> ShowS,\n        Maybe Int -> Double -> ShowS #-}\n{-# SPECIALIZE showFFloat ::\n        Maybe Int -> Float  -> ShowS,\n        Maybe Int -> Double -> ShowS #-}\n{-# SPECIALIZE showGFloat ::\n        Maybe Int -> Float  -> ShowS,\n        Maybe Int -> Double -> ShowS #-}\n\n-- | Show a signed 'RealFloat' value\n-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).\n--\n-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',\n-- the value is shown to full precision; if @digs@ is @'Just' d@,\n-- then at most @d@ digits after the decimal point are shown.\nshowEFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS\n\n-- | Show a signed 'RealFloat' value\n-- using standard decimal notation (e.g. @245000@, @0.0015@).\n--\n-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',\n-- the value is shown to full precision; if @digs@ is @'Just' d@,\n-- then at most @d@ digits after the decimal point are shown.\nshowFFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS\n\n-- | Show a signed 'RealFloat' value\n-- using standard decimal notation for arguments whose absolute value lies\n-- between @0.1@ and @9,999,999@, and scientific notation otherwise.\n--\n-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',\n-- the value is shown to full precision; if @digs@ is @'Just' d@,\n-- then at most @d@ digits after the decimal point are shown.\nshowGFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS\n\nshowEFloat d x =  showString (formatRealFloat FFExponent d x)\nshowFFloat d x =  showString (formatRealFloat FFFixed d x)\nshowGFloat d x =  showString (formatRealFloat FFGeneric d x)\n\n-- | Show a signed 'RealFloat' value\n-- using standard decimal notation (e.g. @245000@, @0.0015@).\n--\n-- This behaves as 'showFFloat', except that a decimal point\n-- is always guaranteed, even if not needed.\n--\n-- @since 4.7.0.0\nshowFFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS\n\n-- | Show a signed 'RealFloat' value\n-- using standard decimal notation for arguments whose absolute value lies\n-- between @0.1@ and @9,999,999@, and scientific notation otherwise.\n--\n-- This behaves as 'showFFloat', except that a decimal point\n-- is always guaranteed, even if not needed.\n--\n-- @since 4.7.0.0\nshowGFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS\n\nshowFFloatAlt d x =  showString (formatRealFloatAlt FFFixed d True x)\nshowGFloatAlt d x =  showString (formatRealFloatAlt FFGeneric d True x)\n\n{- | Show a floating-point value in the hexadecimal format,\nsimilar to the @%a@ specifier in C's printf.\n\n  >>> showHFloat (212.21 :: Double) \"\"\n  \"0x1.a86b851eb851fp7\"\n  >>> showHFloat (-12.76 :: Float) \"\"\n  \"-0x1.9851ecp3\"\n  >>> showHFloat (-0 :: Double) \"\"\n  \"-0x0p+0\"\n-}\nshowHFloat :: RealFloat a => a -> ShowS\nshowHFloat = showString . fmt\n  where\n  fmt x\n    | isNaN x                   = \"NaN\"\n    | isInfinite x              = (if x < 0 then \"-\" else \"\") ++ \"Infinity\"\n    | x < 0 || isNegativeZero x = '-' : cvt (-x)\n    | otherwise                 = cvt x\n\n  cvt x\n    | x == 0 = \"0x0p+0\"\n    | otherwise =\n      case floatToDigits 2 x of\n        r@([], _) -> error $ \"Impossible happened: showHFloat: \" ++ show r\n        (d:ds, e) -> \"0x\" ++ show d ++ frac ds ++ \"p\" ++ show (e-1)\n\n  -- Given binary digits, convert them to hex in blocks of 4\n  -- Special case: If all 0's, just drop it.\n  frac digits\n    | allZ digits = \"\"\n    | otherwise   = \".\" ++ hex digits\n    where\n    hex ds =\n      case ds of\n        []                -> \"\"\n        [a]               -> hexDigit a 0 0 0 \"\"\n        [a,b]             -> hexDigit a b 0 0 \"\"\n        [a,b,c]           -> hexDigit a b c 0 \"\"\n        a : b : c : d : r -> hexDigit a b c d (hex r)\n\n  hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)\n\n  allZ xs = case xs of\n              x : more -> x == 0 && allZ more\n              []       -> True\n\n-- ---------------------------------------------------------------------------\n-- Integer printing functions\n\n-- | Shows a /non-negative/ 'Integral' number using the base specified by the\n-- first argument, and the character representation specified by the second.\nshowIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS\nshowIntAtBase base toChr n0 r0\n  | base <= 1 = errorWithoutStackTrace (\"Numeric.showIntAtBase: applied to unsupported base \" ++ show base)\n  | n0 <  0   = errorWithoutStackTrace (\"Numeric.showIntAtBase: applied to negative number \" ++ show n0)\n  | otherwise = showIt (quotRem n0 base) r0\n   where\n    showIt (n,d) r = seq c $ -- stricter than necessary\n      case n of\n        0 -> r'\n        _ -> showIt (quotRem n base) r'\n     where\n      c  = toChr (fromIntegral d)\n      r' = c : r\n\n-- | Show /non-negative/ 'Integral' numbers in base 16.\nshowHex :: (Integral a,Show a) => a -> ShowS\nshowHex = showIntAtBase 16 intToDigit\n\n-- | Show /non-negative/ 'Integral' numbers in base 8.\nshowOct :: (Integral a, Show a) => a -> ShowS\nshowOct = showIntAtBase 8  intToDigit\n", "num_lines": 290}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Prelude\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- The Prelude: a standard module. The Prelude is imported by default\n-- into all Haskell modules unless either there is an explicit import\n-- statement for it, or the NoImplicitPrelude extension is enabled.\n--\n-----------------------------------------------------------------------------\n\nmodule Prelude (\n\n    -- * Standard types, classes and related functions\n\n    -- ** Basic data types\n    Bool(False, True),\n    (&&), (||), not, otherwise,\n\n    Maybe(Nothing, Just),\n    maybe,\n\n    Either(Left, Right),\n    either,\n\n    Ordering(LT, EQ, GT),\n    Char, String,\n\n    -- *** Tuples\n    fst, snd, curry, uncurry,\n\n    -- ** Basic type classes\n    Eq((==), (/=)),\n    Ord(compare, (<), (<=), (>=), (>), max, min),\n    Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen,\n         enumFromTo, enumFromThenTo),\n    Bounded(minBound, maxBound),\n\n    -- ** Numbers\n\n    -- *** Numeric types\n    Int, Integer, Float, Double,\n    Rational, Word,\n\n    -- *** Numeric type classes\n    Num((+), (-), (*), negate, abs, signum, fromInteger),\n    Real(toRational),\n    Integral(quot, rem, div, mod, quotRem, divMod, toInteger),\n    Fractional((/), recip, fromRational),\n    Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,\n             asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),\n    RealFrac(properFraction, truncate, round, ceiling, floor),\n    RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,\n              encodeFloat, exponent, significand, scaleFloat, isNaN,\n              isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),\n\n    -- *** Numeric functions\n    subtract, even, odd, gcd, lcm, (^), (^^),\n    fromIntegral, realToFrac,\n\n    -- ** Semigroups and Monoids\n    Semigroup((<>)),\n    Monoid(mempty, mappend, mconcat),\n\n    -- ** Monads and functors\n    Functor(fmap, (<$)), (<$>),\n    Applicative(pure, (<*>), (*>), (<*)),\n    Monad((>>=), (>>), return, fail),\n    mapM_, sequence_, (=<<),\n\n    -- ** Folds and traversals\n    Foldable(elem,      -- :: (Foldable t, Eq a) => a -> t a -> Bool\n             -- fold,   -- :: Monoid m => t m -> m\n             foldMap,   -- :: Monoid m => (a -> m) -> t a -> m\n             foldr,     -- :: (a -> b -> b) -> b -> t a -> b\n             -- foldr', -- :: (a -> b -> b) -> b -> t a -> b\n             foldl,     -- :: (b -> a -> b) -> b -> t a -> b\n             -- foldl', -- :: (b -> a -> b) -> b -> t a -> b\n             foldr1,    -- :: (a -> a -> a) -> t a -> a\n             foldl1,    -- :: (a -> a -> a) -> t a -> a\n             maximum,   -- :: (Foldable t, Ord a) => t a -> a\n             minimum,   -- :: (Foldable t, Ord a) => t a -> a\n             product,   -- :: (Foldable t, Num a) => t a -> a\n             sum),      -- :: Num a => t a -> a\n             -- toList) -- :: Foldable t => t a -> [a]\n\n    Traversable(traverse, sequenceA, mapM, sequence),\n\n    -- ** Miscellaneous functions\n    id, const, (.), flip, ($), until,\n    asTypeOf, error, errorWithoutStackTrace, undefined,\n    seq, ($!),\n\n    -- * List operations\n    map, (++), filter,\n    head, last, tail, init, null, length, (!!),\n    reverse,\n    -- *** Special folds\n    and, or, any, all,\n    concat, concatMap,\n    -- ** Building lists\n    -- *** Scans\n    scanl, scanl1, scanr, scanr1,\n    -- *** Infinite lists\n    iterate, repeat, replicate, cycle,\n    -- ** Sublists\n    take, drop, splitAt, takeWhile, dropWhile, span, break,\n    -- ** Searching lists\n    notElem, lookup,\n    -- ** Zipping and unzipping lists\n    zip, zip3, zipWith, zipWith3, unzip, unzip3,\n    -- ** Functions on strings\n    lines, words, unlines, unwords,\n\n    -- * Converting to and from @String@\n    -- ** Converting to @String@\n    ShowS,\n    Show(showsPrec, showList, show),\n    shows,\n    showChar, showString, showParen,\n    -- ** Converting from @String@\n    ReadS,\n    Read(readsPrec, readList),\n    reads, readParen, read, lex,\n\n    -- * Basic Input and output\n    IO,\n    -- ** Simple I\\/O operations\n    -- All I/O functions defined here are character oriented.  The\n    -- treatment of the newline character will vary on different systems.\n    -- For example, two characters of input, return and linefeed, may\n    -- read as a single newline character.  These functions cannot be\n    -- used portably for binary I/O.\n    -- *** Output functions\n    putChar,\n    putStr, putStrLn, print,\n    -- *** Input functions\n    getChar,\n    getLine, getContents, interact,\n    -- *** Files\n    FilePath,\n    readFile, writeFile, appendFile, readIO, readLn,\n    -- ** Exception handling in the I\\/O monad\n    IOError, ioError, userError,\n\n  ) where\n\nimport Control.Monad\nimport System.IO\nimport System.IO.Error\nimport Data.List\nimport Data.Either\nimport Data.Foldable    ( Foldable(..) )\nimport Data.Functor     ( (<$>) )\nimport Data.Maybe\nimport Data.Traversable ( Traversable(..) )\nimport Data.Tuple\n\nimport GHC.Base hiding ( foldr, mapM, sequence )\nimport Text.Read\nimport GHC.Enum\nimport GHC.Num\nimport GHC.Real\nimport GHC.Float\nimport GHC.Show\n", "num_lines": 174}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMainWithHooks autoconfUserHooks\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{--\nThis is a script to generate the necessary tables to support Windows code page\nencoding/decoding.\n\nLicense: see libraries/base/LICENSE\n\nThe code page tables are available from :\nhttp://www.unicode.org/Public/MAPPINGS/\n\nTo run this script, use e.g.\nrunghc MakeTable.hs <module-name> <output-file> <codepage-dir>/*.TXT\n\nCurrently, this script only supports single-byte encodings, since the lookup\ntables required for the CJK double-byte codepages are too large to be\nstatically linked into every executable.  We plan to add support for them once\nGHC is able to produce Windows DLLs.\n--}\n\nmodule Main where\n\nimport System.FilePath\nimport qualified Data.Map as Map\nimport System.IO\nimport Data.Maybe (mapMaybe)\nimport Data.List (intersperse)\nimport Data.Word\nimport Numeric\nimport Control.Monad.State\nimport System.Environment\nimport Control.Exception(evaluate)\n\nmain :: IO ()\nmain = do\n    moduleName:outFile:files <- getArgs\n    let badFiles = -- These fail with an error like\n                   --     MakeTable: Enum.toEnum{Word8}: tag (33088) is outside of bounds (0,255)\n                   -- I have no idea what's going on, so for now we just\n                   -- skip them.\n                   [\"CPs/CP932.TXT\",\n                    \"CPs/CP936.TXT\",\n                    \"CPs/CP949.TXT\",\n                    \"CPs/CP950.TXT\"]\n    let files' = filter (`notElem` badFiles) files\n    sbes <- mapM readMapAndIx files'\n    putStrLn \"Writing output\"\n    withBinaryFile outFile WriteMode $ flip hPutStr\n        $ unlines $ makeTableFile moduleName files' sbes\n  where\n    readMapAndIx f = do\n        putStrLn (\"Reading \" ++ f)\n        m <- readMap f\n        return (codePageNum f, m)\n\n-- filenames are assumed to be of the form \"CP1250.TXT\"\ncodePageNum :: FilePath -> Int\ncodePageNum = read . drop 2 . takeBaseName\n\nreadMap :: (Ord a, Enum a) => FilePath -> IO (Map.Map a Char)\nreadMap f  = withBinaryFile f ReadMode $ \\h -> do\n    contents <- hGetContents h\n    let ms = Map.fromList $ mapMaybe parseLine $ lines contents\n    evaluate $ Map.size ms\n    return ms\n\nparseLine :: Enum a => String -> Maybe (a,Char)\nparseLine s = case words s of\n    ('#':_):_           -> Nothing\n    bs:\"#DBCS\":_        -> Just (readHex' bs, toEnum 0xDC00)\n    bs:\"#UNDEFINED\":_   -> Just (readHex' bs, toEnum 0)\n    bs:cs:('#':_):_     -> Just (readHex' bs, readCharHex cs)\n    _                   -> Nothing\n\nreadHex' :: Enum a => String -> a\nreadHex' ('0':'x':s) = case readHex s of\n    [(n,\"\")] -> toEnum n -- explicitly call toEnum to catch overflow errors.\n    _ -> errorWithoutStackTrace $ \"Can't read hex: \" ++ show s\nreadHex' s = errorWithoutStackTrace $ \"Can't read hex: \" ++ show s\n\nreadCharHex :: String -> Char\nreadCharHex s = if c > fromEnum (maxBound :: Word16)\n                    then errorWithoutStackTrace \"Can't handle non-BMP character.\"\n                    else toEnum c\n    where c = readHex' s\n\n\n-------------------------------------------\n-- Writing out the main data values.\n\nmakeTableFile :: String -> [FilePath] -> [(Int,Map.Map Word8 Char)] -> [String]\nmakeTableFile moduleName files maps = concat\n    [ languageDirectives, firstComment files, header,\n        theImports, theTypes, blockSizeText, tablePart]\n  where\n    header = [ \"module \" ++ moduleName ++ \" where\"\n             , \"\"\n             ]\n    tablePart = [ \"codePageMap :: [(Word32, CodePageArrays)]\"\n                , \"codePageMap = [\"\n                ] ++ (intersperse \"\\n    ,\" $ map mkTableEntry maps)\n                ++ [\"    ]\"]\n    mkTableEntry (i,m) = \"    (\" ++ show i ++ \", \" ++ makeSBE m ++ \"    )\"\n    blockSizeText = [\"blockBitSize :: Int\", \"blockBitSize = \" ++ show blockBitSize]\n\n\nmakeSBE :: Map.Map Word8 Char -> String\nmakeSBE m = unlines\n                [ \"SingleByteCP {\"\n                , \"     decoderArray = \" ++ mkConvArray es\n                , \"     , encoderArray = \" ++ mkCompactArray (swapMap m)\n                , \"   }\"\n                ]\n  where\n    es = [Map.findWithDefault '\\0' x m | x <- [minBound..maxBound]]\n\nswapMap :: (Ord a, Ord b, Enum a, Enum b) => Map.Map a b -> Map.Map b a\nswapMap = Map.insert (toEnum 0) (toEnum 0) . Map.fromList . map swap . Map.toList\n  where\n    swap (x,y) = (y,x)\n\n\nmkConvArray :: Embed a => [a] -> String\nmkConvArray xs = \"ConvArray \\\"\" ++ concatMap mkHex xs ++ \"\\\"#\"\n\n\n-------------------------------------------\n-- Compact arrays\n--\n-- The decoding map (from Word8 to Char) can be implemented with a simple array\n-- of 256 Word16's.  Bytes which do not belong to the code page are mapped to\n-- '\\0'.\n--\n-- However, a naive table mapping Char to Word8 would require 2^16 Word8's.  We\n-- can use much less space with the right data structure, since at most 256 of\n-- those entries are nonzero.\n--\n-- We use \"compact arrays\", as described in \"Unicode Demystified\" by Richard\n-- Gillam.\n--\n-- Fix a block size S which is a power of two.  We compress an array of N\n-- entries (where N>>S) as follows.  First, split the array into blocks of size\n-- S, then remove all repeate blocks to form the \"value\" array.  Then construct\n-- a separate \"index\" array which maps the position of blocks in the old array\n-- to a position in the value array.\n--\n-- For example, assume that S=32 we have six blocks ABABCA, each with 32\n-- elements.\n--\n-- Then the compressed table consists of two arrays:\n-- 1) An array \"values\", concatenating the unique blocks ABC\n-- 2) An array \"indices\" which equals [0,1,0,1,2,0].\n--\n-- To look up '\\100', first calculate divMod 100 32 = (3,4).  Since\n-- indices[3]=1, we look at the second unique block B; thus the encoded byte is\n-- B[4].\n--\n-- The upshot of this representation is that the lookup is very quick as it only\n-- requires two array accesses plus some bit masking/shifting.\n\n-- From testing, this is an optimal size.\nblockBitSize :: Int\nblockBitSize = 6\n\nmkCompactArray :: (Embed a, Embed b) => Map.Map a b -> String\nmkCompactArray m = unlines [\n            \"\"\n            , \" CompactArray {\"\n            , \"        encoderIndices = \" ++ mkConvArray is'\n            , \"        , encoderValues = \"\n                    ++ mkConvArray (concat $ Map.elems vs)\n            , \"        , encoderMax = \" ++ show (fst $ Map.findMax m)\n            , \"        }\"\n            ]\n  where\n    blockSize = 2 ^ blockBitSize\n    (is,(vs,_)) = compress blockSize $ m\n    is' = map (* blockSize) is\n\ntype CompressState b = (Map.Map Int [b], Map.Map [b] Int)\n-- each entry in the list corresponds to a block of size n.\ncompress :: (Bounded a, Enum a, Ord a, Bounded b, Ord b) => Int -> Map.Map a b\n        -> ([Int], CompressState b)\ncompress n ms = runState (mapM lookupOrAdd chunks) (Map.empty, Map.empty)\n    where\n        chunks = mkChunks $ map (\\i -> Map.findWithDefault minBound i ms)\n                    $ [minBound..fst (Map.findMax ms)]\n        mkChunks [] = []\n        mkChunks xs = take n xs : mkChunks (drop n xs)\n        lookupOrAdd xs = do\n            (m,rm) <- get\n            case Map.lookup xs rm of\n                Just i -> return i\n                Nothing -> do\n                    let i = if Map.null m\n                                then 0\n                                else 1 + fst (Map.findMax m)\n                    put (Map.insert i xs m, Map.insert xs i rm)\n                    return i\n\n-------------------------------------------\n-- Static parts of the generated module.\n\nlanguageDirectives :: [String]\nlanguageDirectives = [\"{-# LANGUAGE MagicHash, NoImplicitPrelude #-}\"]\n\n\nfirstComment :: [FilePath] -> [String]\nfirstComment files = map (\"-- \" ++) $\n    [ \"Do not edit this file directly!\"\n    , \"It was generated by the MakeTable.hs script using the files below.\"\n    , \"To regenerate it, run \\\"make\\\" in ../../../../codepages/\"\n    , \"\"\n    , \"Files:\"\n    ] ++ map takeFileName files\n\ntheImports :: [String]\ntheImports = map (\"import \" ++ )\n    [\"GHC.Prim\", \"GHC.Base\", \"GHC.Word\"]\n\ntheTypes :: [String]\ntheTypes = [ \"data ConvArray a = ConvArray Addr#\"\n           , \"data CompactArray a b = CompactArray {\"\n           , \"    encoderMax :: !a,\"\n           , \"    encoderIndices :: !(ConvArray Int),\"\n           , \"    encoderValues :: !(ConvArray b)\"\n           , \"  }\"\n           , \"\"\n           , \"data CodePageArrays = SingleByteCP {\"\n           , \"    decoderArray :: !(ConvArray Char),\"\n           , \"    encoderArray :: !(CompactArray Char Word8)\"\n           , \"  }\"\n           , \"\"\n           ]\n\n-------------------------------------------\n-- Embed class and associated functions\n\nclass (Ord a, Enum a, Bounded a, Show a) => Embed a where\n    mkHex :: a -> String\n\n-- | @since 4.2.0.0\ninstance Embed Word8 where\n    mkHex = showHex'\n\n-- | @since 4.2.0.0\ninstance Embed Word16 where\n    mkHex = repDualByte\n\n-- | @since 4.2.0.0\ninstance Embed Char where\n    mkHex = repDualByte\n\n-- this is used for the indices of the compressed array.\n-- | @since 4.2.0.0\ninstance Embed Int where\n    mkHex = repDualByte\n\nshowHex' :: Integral a => a -> String\nshowHex' s = \"\\\\x\" ++ showHex s \"\"\n\nrepDualByte :: Enum c => c -> String\nrepDualByte c\n    | n >= 2^(16::Int) = errorWithoutStackTrace \"value is too high!\"\n    -- NOTE : this assumes little-endian architecture.  But we're only using this on Windows,\n    -- so it's probably OK.\n    | otherwise = showHex' (n `mod` 256) ++ showHex' (n `div` 256)\n  where\n    n = fromEnum c\n\n\n", "num_lines": 270}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Applicative\n-- Copyright   :  Conor McBride and Ross Paterson 2005\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- This module describes a structure intermediate between a functor and\n-- a monad (technically, a strong lax monoidal functor).  Compared with\n-- monads, this interface lacks the full power of the binding operation\n-- '>>=', but\n--\n-- * it has more instances.\n--\n-- * it is sufficient for many uses, e.g. context-free parsing, or the\n--   'Data.Traversable.Traversable' class.\n--\n-- * instances can perform analysis of computations before they are\n--   executed, and thus produce shared optimizations.\n--\n-- This interface was introduced for parsers by Niklas R&#xF6;jemo, because\n-- it admits more sharing than the monadic interface.  The names here are\n-- mostly based on parsing work by Doaitse Swierstra.\n--\n-- For more details, see\n-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html Applicative Programming with Effects>,\n-- by Conor McBride and Ross Paterson.\n\nmodule Control.Applicative (\n    -- * Applicative functors\n    Applicative(..),\n    -- * Alternatives\n    Alternative(..),\n    -- * Instances\n    Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),\n    -- * Utility functions\n    (<$>), (<$), (<**>),\n    liftA, liftA3,\n    optional,\n    ) where\n\nimport Control.Category hiding ((.), id)\nimport Control.Arrow\nimport Data.Maybe\nimport Data.Tuple\nimport Data.Eq\nimport Data.Ord\nimport Data.Foldable (Foldable(..))\nimport Data.Functor ((<$>))\nimport Data.Functor.Const (Const(..))\n\nimport GHC.Base\nimport GHC.Generics\nimport GHC.List (repeat, zipWith, drop)\nimport GHC.Read (Read)\nimport GHC.Show (Show)\n\nnewtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }\n                         deriving ( Generic  -- ^ @since 4.7.0.0\n                                  , Generic1 -- ^ @since 4.7.0.0\n                                  , Monad    -- ^ @since 4.7.0.0\n                                  )\n\n-- | @since 2.01\ninstance Monad m => Functor (WrappedMonad m) where\n    fmap f (WrapMonad v) = WrapMonad (liftM f v)\n\n-- | @since 2.01\ninstance Monad m => Applicative (WrappedMonad m) where\n    pure = WrapMonad . pure\n    WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)\n    liftA2 f (WrapMonad x) (WrapMonad y) = WrapMonad (liftM2 f x y)\n\n-- | @since 2.01\ninstance MonadPlus m => Alternative (WrappedMonad m) where\n    empty = WrapMonad mzero\n    WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)\n\nnewtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }\n                           deriving ( Generic  -- ^ @since 4.7.0.0\n                                    , Generic1 -- ^ @since 4.7.0.0\n                                    )\n\n-- | @since 2.01\ninstance Arrow a => Functor (WrappedArrow a b) where\n    fmap f (WrapArrow a) = WrapArrow (a >>> arr f)\n\n-- | @since 2.01\ninstance Arrow a => Applicative (WrappedArrow a b) where\n    pure x = WrapArrow (arr (const x))\n    liftA2 f (WrapArrow u) (WrapArrow v) =\n      WrapArrow (u &&& v >>> arr (uncurry f))\n\n-- | @since 2.01\ninstance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where\n    empty = WrapArrow zeroArrow\n    WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)\n\n-- | Lists, but with an 'Applicative' functor based on zipping.\nnewtype ZipList a = ZipList { getZipList :: [a] }\n                  deriving ( Show     -- ^ @since 4.7.0.0\n                           , Eq       -- ^ @since 4.7.0.0\n                           , Ord      -- ^ @since 4.7.0.0\n                           , Read     -- ^ @since 4.7.0.0\n                           , Functor  -- ^ @since 2.01\n                           , Foldable -- ^ @since 4.9.0.0\n                           , Generic  -- ^ @since 4.7.0.0\n                           , Generic1 -- ^ @since 4.7.0.0\n                           )\n-- See Data.Traversable for Traversable instance due to import loops\n\n-- |\n-- > f <$> ZipList xs1 <*> ... <*> ZipList xsN\n-- >     = ZipList (zipWithN f xs1 ... xsN)\n--\n-- where @zipWithN@ refers to the @zipWith@ function of the appropriate arity\n-- (@zipWith@, @zipWith3@, @zipWith4@, ...). For example:\n--\n-- > (\\a b c -> stimes c [a, b]) <$> ZipList \"abcd\" <*> ZipList \"567\" <*> ZipList [1..]\n-- >     = ZipList (zipWith3 (\\a b c -> stimes c [a, b]) \"abcd\" \"567\" [1..])\n-- >     = ZipList {getZipList = [\"a5\",\"b6b6\",\"c7c7c7\"]}\n--\n-- @since 2.01\ninstance Applicative ZipList where\n    pure x = ZipList (repeat x)\n    liftA2 f (ZipList xs) (ZipList ys) = ZipList (zipWith f xs ys)\n\n-- | @since 4.11.0.0\ninstance Alternative ZipList where\n   empty = ZipList []\n   ZipList xs <|> ZipList ys = ZipList (xs ++ drop (length xs) ys)\n\n-- extra functions\n\n-- | One or none.\noptional :: Alternative f => f a -> f (Maybe a)\noptional v = Just <$> v <|> pure Nothing\n", "num_lines": 146}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}\n    -- The RULES for the methods of class Arrow may never fire\n    -- e.g. compose/arr;  see Trac #10528\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Arrow\n-- Copyright   :  (c) Ross Paterson 2002\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Basic arrow definitions, based on\n--\n--  * /Generalising Monads to Arrows/, by John Hughes,\n--    /Science of Computer Programming/ 37, pp67-111, May 2000.\n--\n-- plus a couple of definitions ('returnA' and 'loop') from\n--\n--  * /A New Notation for Arrows/, by Ross Paterson, in /ICFP 2001/,\n--    Firenze, Italy, pp229-240.\n--\n-- These papers and more information on arrows can be found at\n-- <http://www.haskell.org/arrows/>.\n\nmodule Control.Arrow (\n    -- * Arrows\n    Arrow(..), Kleisli(..),\n    -- ** Derived combinators\n    returnA,\n    (^>>), (>>^),\n    (>>>), (<<<), -- reexported\n    -- ** Right-to-left variants\n    (<<^), (^<<),\n    -- * Monoid operations\n    ArrowZero(..), ArrowPlus(..),\n    -- * Conditionals\n    ArrowChoice(..),\n    -- * Arrow application\n    ArrowApply(..), ArrowMonad(..), leftApp,\n    -- * Feedback\n    ArrowLoop(..)\n    ) where\n\nimport Data.Tuple ( fst, snd, uncurry )\nimport Data.Either\nimport Control.Monad.Fix\nimport Control.Category\nimport GHC.Base hiding ( (.), id )\n\ninfixr 5 <+>\ninfixr 3 ***\ninfixr 3 &&&\ninfixr 2 +++\ninfixr 2 |||\ninfixr 1 ^>>, >>^\ninfixr 1 ^<<, <<^\n\n-- | The basic arrow class.\n--\n-- Instances should satisfy the following laws:\n--\n--  * @'arr' id = 'id'@\n--\n--  * @'arr' (f >>> g) = 'arr' f >>> 'arr' g@\n--\n--  * @'first' ('arr' f) = 'arr' ('first' f)@\n--\n--  * @'first' (f >>> g) = 'first' f >>> 'first' g@\n--\n--  * @'first' f >>> 'arr' 'fst' = 'arr' 'fst' >>> f@\n--\n--  * @'first' f >>> 'arr' ('id' *** g) = 'arr' ('id' *** g) >>> 'first' f@\n--\n--  * @'first' ('first' f) >>> 'arr' assoc = 'arr' assoc >>> 'first' f@\n--\n-- where\n--\n-- > assoc ((a,b),c) = (a,(b,c))\n--\n-- The other combinators have sensible default definitions,\n-- which may be overridden for efficiency.\n\nclass Category a => Arrow a where\n    {-# MINIMAL arr, (first | (***)) #-}\n\n    -- | Lift a function to an arrow.\n    arr :: (b -> c) -> a b c\n\n    -- | Send the first component of the input through the argument\n    --   arrow, and copy the rest unchanged to the output.\n    first :: a b c -> a (b,d) (c,d)\n    first = (*** id)\n\n    -- | A mirror image of 'first'.\n    --\n    --   The default definition may be overridden with a more efficient\n    --   version if desired.\n    second :: a b c -> a (d,b) (d,c)\n    second = (id ***)\n\n    -- | Split the input between the two argument arrows and combine\n    --   their output.  Note that this is in general not a functor.\n    --\n    --   The default definition may be overridden with a more efficient\n    --   version if desired.\n    (***) :: a b c -> a b' c' -> a (b,b') (c,c')\n    f *** g = first f >>> arr swap >>> first g >>> arr swap\n      where swap ~(x,y) = (y,x)\n\n    -- | Fanout: send the input to both argument arrows and combine\n    --   their output.\n    --\n    --   The default definition may be overridden with a more efficient\n    --   version if desired.\n    (&&&) :: a b c -> a b c' -> a b (c,c')\n    f &&& g = arr (\\b -> (b,b)) >>> f *** g\n\n{-# RULES\n\"compose/arr\"   forall f g .\n                (arr f) . (arr g) = arr (f . g)\n\"first/arr\"     forall f .\n                first (arr f) = arr (first f)\n\"second/arr\"    forall f .\n                second (arr f) = arr (second f)\n\"product/arr\"   forall f g .\n                arr f *** arr g = arr (f *** g)\n\"fanout/arr\"    forall f g .\n                arr f &&& arr g = arr (f &&& g)\n\"compose/first\" forall f g .\n                (first f) . (first g) = first (f . g)\n\"compose/second\" forall f g .\n                (second f) . (second g) = second (f . g)\n #-}\n\n-- Ordinary functions are arrows.\n\n-- | @since 2.01\ninstance Arrow (->) where\n    arr f = f\n--  (f *** g) ~(x,y) = (f x, g y)\n--  sorry, although the above defn is fully H'98, nhc98 can't parse it.\n    (***) f g ~(x,y) = (f x, g y)\n\n-- | Kleisli arrows of a monad.\nnewtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }\n\n-- | @since 3.0\ninstance Monad m => Category (Kleisli m) where\n    id = Kleisli return\n    (Kleisli f) . (Kleisli g) = Kleisli (\\b -> g b >>= f)\n\n-- | @since 2.01\ninstance Monad m => Arrow (Kleisli m) where\n    arr f = Kleisli (return . f)\n    first (Kleisli f) = Kleisli (\\ ~(b,d) -> f b >>= \\c -> return (c,d))\n    second (Kleisli f) = Kleisli (\\ ~(d,b) -> f b >>= \\c -> return (d,c))\n\n-- | The identity arrow, which plays the role of 'return' in arrow notation.\nreturnA :: Arrow a => a b b\nreturnA = arr id\n\n-- | Precomposition with a pure function.\n(^>>) :: Arrow a => (b -> c) -> a c d -> a b d\nf ^>> a = arr f >>> a\n\n-- | Postcomposition with a pure function.\n(>>^) :: Arrow a => a b c -> (c -> d) -> a b d\na >>^ f = a >>> arr f\n\n-- | Precomposition with a pure function (right-to-left variant).\n(<<^) :: Arrow a => a c d -> (b -> c) -> a b d\na <<^ f = a <<< arr f\n\n-- | Postcomposition with a pure function (right-to-left variant).\n(^<<) :: Arrow a => (c -> d) -> a b c -> a b d\nf ^<< a = arr f <<< a\n\nclass Arrow a => ArrowZero a where\n    zeroArrow :: a b c\n\n-- | @since 2.01\ninstance MonadPlus m => ArrowZero (Kleisli m) where\n    zeroArrow = Kleisli (\\_ -> mzero)\n\n-- | A monoid on arrows.\nclass ArrowZero a => ArrowPlus a where\n    -- | An associative operation with identity 'zeroArrow'.\n    (<+>) :: a b c -> a b c -> a b c\n\n-- | @since 2.01\ninstance MonadPlus m => ArrowPlus (Kleisli m) where\n    Kleisli f <+> Kleisli g = Kleisli (\\x -> f x `mplus` g x)\n\n-- | Choice, for arrows that support it.  This class underlies the\n-- @if@ and @case@ constructs in arrow notation.\n--\n-- Instances should satisfy the following laws:\n--\n--  * @'left' ('arr' f) = 'arr' ('left' f)@\n--\n--  * @'left' (f >>> g) = 'left' f >>> 'left' g@\n--\n--  * @f >>> 'arr' 'Left' = 'arr' 'Left' >>> 'left' f@\n--\n--  * @'left' f >>> 'arr' ('id' +++ g) = 'arr' ('id' +++ g) >>> 'left' f@\n--\n--  * @'left' ('left' f) >>> 'arr' assocsum = 'arr' assocsum >>> 'left' f@\n--\n-- where\n--\n-- > assocsum (Left (Left x)) = Left x\n-- > assocsum (Left (Right y)) = Right (Left y)\n-- > assocsum (Right z) = Right (Right z)\n--\n-- The other combinators have sensible default definitions, which may\n-- be overridden for efficiency.\n\nclass Arrow a => ArrowChoice a where\n    {-# MINIMAL (left | (+++)) #-}\n\n    -- | Feed marked inputs through the argument arrow, passing the\n    --   rest through unchanged to the output.\n    left :: a b c -> a (Either b d) (Either c d)\n    left = (+++ id)\n\n    -- | A mirror image of 'left'.\n    --\n    --   The default definition may be overridden with a more efficient\n    --   version if desired.\n    right :: a b c -> a (Either d b) (Either d c)\n    right = (id +++)\n\n    -- | Split the input between the two argument arrows, retagging\n    --   and merging their outputs.\n    --   Note that this is in general not a functor.\n    --\n    --   The default definition may be overridden with a more efficient\n    --   version if desired.\n    (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')\n    f +++ g = left f >>> arr mirror >>> left g >>> arr mirror\n      where\n        mirror :: Either x y -> Either y x\n        mirror (Left x) = Right x\n        mirror (Right y) = Left y\n\n    -- | Fanin: Split the input between the two argument arrows and\n    --   merge their outputs.\n    --\n    --   The default definition may be overridden with a more efficient\n    --   version if desired.\n    (|||) :: a b d -> a c d -> a (Either b c) d\n    f ||| g = f +++ g >>> arr untag\n      where\n        untag (Left x) = x\n        untag (Right y) = y\n\n{-# RULES\n\"left/arr\"      forall f .\n                left (arr f) = arr (left f)\n\"right/arr\"     forall f .\n                right (arr f) = arr (right f)\n\"sum/arr\"       forall f g .\n                arr f +++ arr g = arr (f +++ g)\n\"fanin/arr\"     forall f g .\n                arr f ||| arr g = arr (f ||| g)\n\"compose/left\"  forall f g .\n                left f . left g = left (f . g)\n\"compose/right\" forall f g .\n                right f . right g = right (f . g)\n #-}\n\n-- | @since 2.01\ninstance ArrowChoice (->) where\n    left f = f +++ id\n    right f = id +++ f\n    f +++ g = (Left . f) ||| (Right . g)\n    (|||) = either\n\n-- | @since 2.01\ninstance Monad m => ArrowChoice (Kleisli m) where\n    left f = f +++ arr id\n    right f = arr id +++ f\n    f +++ g = (f >>> arr Left) ||| (g >>> arr Right)\n    Kleisli f ||| Kleisli g = Kleisli (either f g)\n\n-- | Some arrows allow application of arrow inputs to other inputs.\n-- Instances should satisfy the following laws:\n--\n--  * @'first' ('arr' (\\\\x -> 'arr' (\\\\y -> (x,y)))) >>> 'app' = 'id'@\n--\n--  * @'first' ('arr' (g >>>)) >>> 'app' = 'second' g >>> 'app'@\n--\n--  * @'first' ('arr' (>>> h)) >>> 'app' = 'app' >>> h@\n--\n-- Such arrows are equivalent to monads (see 'ArrowMonad').\n\nclass Arrow a => ArrowApply a where\n    app :: a (a b c, b) c\n\n-- | @since 2.01\ninstance ArrowApply (->) where\n    app (f,x) = f x\n\n-- | @since 2.01\ninstance Monad m => ArrowApply (Kleisli m) where\n    app = Kleisli (\\(Kleisli f, x) -> f x)\n\n-- | The 'ArrowApply' class is equivalent to 'Monad': any monad gives rise\n--   to a 'Kleisli' arrow, and any instance of 'ArrowApply' defines a monad.\n\nnewtype ArrowMonad a b = ArrowMonad (a () b)\n\n-- | @since 4.6.0.0\ninstance Arrow a => Functor (ArrowMonad a) where\n    fmap f (ArrowMonad m) = ArrowMonad $ m >>> arr f\n\n-- | @since 4.6.0.0\ninstance Arrow a => Applicative (ArrowMonad a) where\n   pure x = ArrowMonad (arr (const x))\n   ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id))\n\n-- | @since 2.01\ninstance ArrowApply a => Monad (ArrowMonad a) where\n    ArrowMonad m >>= f = ArrowMonad $\n        m >>> arr (\\x -> let ArrowMonad h = f x in (h, ())) >>> app\n\n-- | @since 4.6.0.0\ninstance ArrowPlus a => Alternative (ArrowMonad a) where\n   empty = ArrowMonad zeroArrow\n   ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y)\n\n-- | @since 4.6.0.0\ninstance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a)\n\n-- | Any instance of 'ArrowApply' can be made into an instance of\n--   'ArrowChoice' by defining 'left' = 'leftApp'.\n\nleftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d)\nleftApp f = arr ((\\b -> (arr (\\() -> b) >>> f >>> arr Left, ())) |||\n             (\\d -> (arr (\\() -> d) >>> arr Right, ()))) >>> app\n\n-- | The 'loop' operator expresses computations in which an output value\n-- is fed back as input, although the computation occurs only once.\n-- It underlies the @rec@ value recursion construct in arrow notation.\n-- 'loop' should satisfy the following laws:\n--\n-- [/extension/]\n--      @'loop' ('arr' f) = 'arr' (\\\\ b -> 'fst' ('fix' (\\\\ (c,d) -> f (b,d))))@\n--\n-- [/left tightening/]\n--      @'loop' ('first' h >>> f) = h >>> 'loop' f@\n--\n-- [/right tightening/]\n--      @'loop' (f >>> 'first' h) = 'loop' f >>> h@\n--\n-- [/sliding/]\n--      @'loop' (f >>> 'arr' ('id' *** k)) = 'loop' ('arr' ('id' *** k) >>> f)@\n--\n-- [/vanishing/]\n--      @'loop' ('loop' f) = 'loop' ('arr' unassoc >>> f >>> 'arr' assoc)@\n--\n-- [/superposing/]\n--      @'second' ('loop' f) = 'loop' ('arr' assoc >>> 'second' f >>> 'arr' unassoc)@\n--\n-- where\n--\n-- > assoc ((a,b),c) = (a,(b,c))\n-- > unassoc (a,(b,c)) = ((a,b),c)\n--\nclass Arrow a => ArrowLoop a where\n    loop :: a (b,d) (c,d) -> a b c\n\n-- | @since 2.01\ninstance ArrowLoop (->) where\n    loop f b = let (c,d) = f (b,d) in c\n\n-- | Beware that for many monads (those for which the '>>=' operation\n-- is strict) this instance will /not/ satisfy the right-tightening law\n-- required by the 'ArrowLoop' class.\n--\n-- @since 2.01\ninstance MonadFix m => ArrowLoop (Kleisli m) where\n    loop (Kleisli f) = Kleisli (liftM fst . mfix . f')\n      where f' x y = f (x, snd y)\n", "num_lines": 390}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE PolyKinds #-}\n{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}\n    -- The RULES for the methods of class Category may never fire\n    -- e.g. identity/left, identity/right, association;  see Trac #10528\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Category\n-- Copyright   :  (c) Ashley Yakeley 2007\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  ashley@semantic.org\n-- Stability   :  experimental\n-- Portability :  portable\n\n-- http://ghc.haskell.org/trac/ghc/ticket/1773\n\nmodule Control.Category where\n\nimport qualified GHC.Base (id,(.))\nimport Data.Type.Coercion\nimport Data.Type.Equality\nimport GHC.Prim (coerce)\n\ninfixr 9 .\ninfixr 1 >>>, <<<\n\n-- | A class for categories. Instances should satisfy the laws\n--\n-- [Right identity] @f '.' 'id'  =  f@\n-- [Left identity]  @'id' '.' f  =  f@\n-- [Associativity]  @f '.' (g '.' h)  =  (f '.' g) '.' h@\n--\nclass Category cat where\n    -- | the identity morphism\n    id :: cat a a\n\n    -- | morphism composition\n    (.) :: cat b c -> cat a b -> cat a c\n\n{-# RULES\n\"identity/left\" forall p .\n                id . p = p\n\"identity/right\"        forall p .\n                p . id = p\n\"association\"   forall p q r .\n                (p . q) . r = p . (q . r)\n #-}\n\n-- | @since 3.0\ninstance Category (->) where\n    id = GHC.Base.id\n    (.) = (GHC.Base..)\n\n-- | @since 4.7.0.0\ninstance Category (:~:) where\n  id          = Refl\n  Refl . Refl = Refl\n\n-- | @since 4.10.0.0\ninstance Category (:~~:) where\n  id            = HRefl\n  HRefl . HRefl = HRefl\n\n-- | @since 4.7.0.0\ninstance Category Coercion where\n  id = Coercion\n  (.) Coercion = coerce\n\n-- | Right-to-left composition\n(<<<) :: Category cat => cat b c -> cat a b -> cat a c\n(<<<) = (.)\n\n-- | Left-to-right composition\n(>>>) :: Category cat => cat a b -> cat b c -> cat a c\nf >>> g = g . f\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , MagicHash\n           , UnboxedTuples\n           , ScopedTypeVariables\n           , RankNTypes\n  #-}\n{-# OPTIONS_GHC -Wno-deprecations #-}\n-- kludge for the Control.Concurrent.QSem, Control.Concurrent.QSemN\n-- and Control.Concurrent.SampleVar imports.\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Concurrent\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (concurrency)\n--\n-- A common interface to a collection of useful concurrency\n-- abstractions.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Concurrent (\n        -- * Concurrent Haskell\n\n        -- $conc_intro\n\n        -- * Basic concurrency operations\n\n        ThreadId,\n        myThreadId,\n\n        forkIO,\n        forkFinally,\n        forkIOWithUnmask,\n        killThread,\n        throwTo,\n\n        -- ** Threads with affinity\n        forkOn,\n        forkOnWithUnmask,\n        getNumCapabilities,\n        setNumCapabilities,\n        threadCapability,\n\n        -- * Scheduling\n\n        -- $conc_scheduling\n        yield,\n\n        -- ** Blocking\n\n        -- $blocking\n\n        -- ** Waiting\n        threadDelay,\n        threadWaitRead,\n        threadWaitWrite,\n        threadWaitReadSTM,\n        threadWaitWriteSTM,\n\n        -- * Communication abstractions\n\n        module Control.Concurrent.MVar,\n        module Control.Concurrent.Chan,\n        module Control.Concurrent.QSem,\n        module Control.Concurrent.QSemN,\n\n        -- * Bound Threads\n        -- $boundthreads\n        rtsSupportsBoundThreads,\n        forkOS,\n        forkOSWithUnmask,\n        isCurrentThreadBound,\n        runInBoundThread,\n        runInUnboundThread,\n\n        -- * Weak references to ThreadIds\n        mkWeakThreadId,\n\n        -- * GHC's implementation of concurrency\n\n        -- |This section describes features specific to GHC's\n        -- implementation of Concurrent Haskell.\n\n        -- ** Haskell threads and Operating System threads\n\n        -- $osthreads\n\n        -- ** Terminating the program\n\n        -- $termination\n\n        -- ** Pre-emption\n\n        -- $preemption\n\n        -- ** Deadlock\n\n        -- $deadlock\n\n    ) where\n\nimport Control.Exception.Base as Exception\n\nimport GHC.Conc hiding (threadWaitRead, threadWaitWrite,\n                        threadWaitReadSTM, threadWaitWriteSTM)\nimport GHC.IO           ( unsafeUnmask, catchException )\nimport GHC.IORef        ( newIORef, readIORef, writeIORef )\nimport GHC.Base\n\nimport System.Posix.Types ( Fd )\nimport Foreign.StablePtr\nimport Foreign.C.Types\n\n#if defined(mingw32_HOST_OS)\nimport Foreign.C\nimport System.IO\nimport Data.Functor ( void )\nimport Data.Int ( Int64 )\n#else\nimport qualified GHC.Conc\n#endif\n\nimport Control.Concurrent.MVar\nimport Control.Concurrent.Chan\nimport Control.Concurrent.QSem\nimport Control.Concurrent.QSemN\n\n{- $conc_intro\n\nThe concurrency extension for Haskell is described in the paper\n/Concurrent Haskell/\n<http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.\n\nConcurrency is \\\"lightweight\\\", which means that both thread creation\nand context switching overheads are extremely low.  Scheduling of\nHaskell threads is done internally in the Haskell runtime system, and\ndoesn't make use of any operating system-supplied thread packages.\n\nHowever, if you want to interact with a foreign library that expects your\nprogram to use the operating system-supplied thread package, you can do so\nby using 'forkOS' instead of 'forkIO'.\n\nHaskell threads can communicate via 'MVar's, a kind of synchronised\nmutable variable (see \"Control.Concurrent.MVar\").  Several common\nconcurrency abstractions can be built from 'MVar's, and these are\nprovided by the \"Control.Concurrent\" library.\nIn GHC, threads may also communicate via exceptions.\n-}\n\n{- $conc_scheduling\n\n    Scheduling may be either pre-emptive or co-operative,\n    depending on the implementation of Concurrent Haskell (see below\n    for information related to specific compilers).  In a co-operative\n    system, context switches only occur when you use one of the\n    primitives defined in this module.  This means that programs such\n    as:\n\n\n>   main = forkIO (write 'a') >> write 'b'\n>     where write c = putChar c >> write c\n\n    will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,\n    instead of some random interleaving of @a@s and @b@s.  In\n    practice, cooperative multitasking is sufficient for writing\n    simple graphical user interfaces.\n-}\n\n{- $blocking\nDifferent Haskell implementations have different characteristics with\nregard to which operations block /all/ threads.\n\nUsing GHC without the @-threaded@ option, all foreign calls will block\nall other Haskell threads in the system, although I\\/O operations will\nnot.  With the @-threaded@ option, only foreign calls with the @unsafe@\nattribute will block all other threads.\n\n-}\n\n-- | Fork a thread and call the supplied function when the thread is about\n-- to terminate, with an exception or a returned value.  The function is\n-- called with asynchronous exceptions masked.\n--\n-- > forkFinally action and_then =\n-- >   mask $ \\restore ->\n-- >     forkIO $ try (restore action) >>= and_then\n--\n-- This function is useful for informing the parent when a child\n-- terminates, for example.\n--\n-- @since 4.6.0.0\nforkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId\nforkFinally action and_then =\n  mask $ \\restore ->\n    forkIO $ try (restore action) >>= and_then\n\n-- ---------------------------------------------------------------------------\n-- Bound Threads\n\n{- $boundthreads\n   #boundthreads#\n\nSupport for multiple operating system threads and bound threads as described\nbelow is currently only available in the GHC runtime system if you use the\n/-threaded/ option when linking.\n\nOther Haskell systems do not currently support multiple operating system threads.\n\nA bound thread is a haskell thread that is /bound/ to an operating system\nthread. While the bound thread is still scheduled by the Haskell run-time\nsystem, the operating system thread takes care of all the foreign calls made\nby the bound thread.\n\nTo a foreign library, the bound thread will look exactly like an ordinary\noperating system thread created using OS functions like @pthread_create@\nor @CreateThread@.\n\nBound threads can be created using the 'forkOS' function below. All foreign\nexported functions are run in a bound thread (bound to the OS thread that\ncalled the function). Also, the @main@ action of every Haskell program is\nrun in a bound thread.\n\nWhy do we need this? Because if a foreign library is called from a thread\ncreated using 'forkIO', it won't have access to any /thread-local state/ -\nstate variables that have specific values for each OS thread\n(see POSIX's @pthread_key_create@ or Win32's @TlsAlloc@). Therefore, some\nlibraries (OpenGL, for example) will not work from a thread created using\n'forkIO'. They work fine in threads created using 'forkOS' or when called\nfrom @main@ or from a @foreign export@.\n\nIn terms of performance, 'forkOS' (aka bound) threads are much more\nexpensive than 'forkIO' (aka unbound) threads, because a 'forkOS'\nthread is tied to a particular OS thread, whereas a 'forkIO' thread\ncan be run by any OS thread.  Context-switching between a 'forkOS'\nthread and a 'forkIO' thread is many times more expensive than between\ntwo 'forkIO' threads.\n\nNote in particular that the main program thread (the thread running\n@Main.main@) is always a bound thread, so for good concurrency\nperformance you should ensure that the main thread is not doing\nrepeated communication with other threads in the system.  Typically\nthis means forking subthreads to do the work using 'forkIO', and\nwaiting for the results in the main thread.\n\n-}\n\n-- | 'True' if bound threads are supported.\n-- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound'\n-- will always return 'False' and both 'forkOS' and 'runInBoundThread' will\n-- fail.\nforeign import ccall unsafe rtsSupportsBoundThreads :: Bool\n\n\n{- |\nLike 'forkIO', this sparks off a new thread to run the 'IO'\ncomputation passed as the first argument, and returns the 'ThreadId'\nof the newly created thread.\n\nHowever, 'forkOS' creates a /bound/ thread, which is necessary if you\nneed to call foreign (non-Haskell) libraries that make use of\nthread-local state, such as OpenGL (see \"Control.Concurrent#boundthreads\").\n\nUsing 'forkOS' instead of 'forkIO' makes no difference at all to the\nscheduling behaviour of the Haskell runtime system.  It is a common\nmisconception that you need to use 'forkOS' instead of 'forkIO' to\navoid blocking all the Haskell threads when making a foreign call;\nthis isn't the case.  To allow foreign calls to be made without\nblocking all the Haskell threads (with GHC), it is only necessary to\nuse the @-threaded@ option when linking your program, and to make sure\nthe foreign import is not marked @unsafe@.\n-}\n\nforkOS :: IO () -> IO ThreadId\n\nforeign export ccall forkOS_entry\n    :: StablePtr (IO ()) -> IO ()\n\nforeign import ccall \"forkOS_entry\" forkOS_entry_reimported\n    :: StablePtr (IO ()) -> IO ()\n\nforkOS_entry :: StablePtr (IO ()) -> IO ()\nforkOS_entry stableAction = do\n        action <- deRefStablePtr stableAction\n        action\n\nforeign import ccall forkOS_createThread\n    :: StablePtr (IO ()) -> IO CInt\n\nfailNonThreaded :: IO a\nfailNonThreaded = fail $ \"RTS doesn't support multiple OS threads \"\n                       ++\"(use ghc -threaded when linking)\"\n\nforkOS action0\n    | rtsSupportsBoundThreads = do\n        mv <- newEmptyMVar\n        b <- Exception.getMaskingState\n        let\n            -- async exceptions are masked in the child if they are masked\n            -- in the parent, as for forkIO (see #1048). forkOS_createThread\n            -- creates a thread with exceptions masked by default.\n            action1 = case b of\n                        Unmasked -> unsafeUnmask action0\n                        MaskedInterruptible -> action0\n                        MaskedUninterruptible -> uninterruptibleMask_ action0\n\n            action_plus = catch action1 childHandler\n\n        entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)\n        err <- forkOS_createThread entry\n        when (err /= 0) $ fail \"Cannot create OS thread.\"\n        tid <- takeMVar mv\n        freeStablePtr entry\n        return tid\n    | otherwise = failNonThreaded\n\n-- | Like 'forkIOWithUnmask', but the child thread is a bound thread,\n-- as with 'forkOS'.\nforkOSWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId\nforkOSWithUnmask io = forkOS (io unsafeUnmask)\n\n-- | Returns 'True' if the calling thread is /bound/, that is, if it is\n-- safe to use foreign libraries that rely on thread-local state from the\n-- calling thread.\nisCurrentThreadBound :: IO Bool\nisCurrentThreadBound = IO $ \\ s# ->\n    case isCurrentThreadBound# s# of\n        (# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)\n\n\n{- |\nRun the 'IO' computation passed as the first argument. If the calling thread\nis not /bound/, a bound thread is created temporarily. @runInBoundThread@\ndoesn't finish until the 'IO' computation finishes.\n\nYou can wrap a series of foreign function calls that rely on thread-local state\nwith @runInBoundThread@ so that you can use them without knowing whether the\ncurrent thread is /bound/.\n-}\nrunInBoundThread :: IO a -> IO a\n\nrunInBoundThread action\n    | rtsSupportsBoundThreads = do\n        bound <- isCurrentThreadBound\n        if bound\n            then action\n            else do\n                ref <- newIORef undefined\n                let action_plus = Exception.try action >>= writeIORef ref\n                bracket (newStablePtr action_plus)\n                        freeStablePtr\n                        (\\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) >>=\n                  unsafeResult\n    | otherwise = failNonThreaded\n\n{- |\nRun the 'IO' computation passed as the first argument. If the calling thread\nis /bound/, an unbound thread is created temporarily using 'forkIO'.\n@runInBoundThread@ doesn't finish until the 'IO' computation finishes.\n\nUse this function /only/ in the rare case that you have actually observed a\nperformance loss due to the use of bound threads. A program that\ndoesn't need its main thread to be bound and makes /heavy/ use of concurrency\n(e.g. a web server), might want to wrap its @main@ action in\n@runInUnboundThread@.\n\nNote that exceptions which are thrown to the current thread are thrown in turn\nto the thread that is executing the given computation. This ensures there's\nalways a way of killing the forked thread.\n-}\nrunInUnboundThread :: IO a -> IO a\n\nrunInUnboundThread action = do\n  bound <- isCurrentThreadBound\n  if bound\n    then do\n      mv <- newEmptyMVar\n      mask $ \\restore -> do\n        tid <- forkIO $ Exception.try (restore action) >>= putMVar mv\n        let wait = takeMVar mv `catchException` \\(e :: SomeException) ->\n                     Exception.throwTo tid e >> wait\n        wait >>= unsafeResult\n    else action\n\nunsafeResult :: Either SomeException a -> IO a\nunsafeResult = either Exception.throwIO return\n\n-- ---------------------------------------------------------------------------\n-- threadWaitRead/threadWaitWrite\n\n-- | Block the current thread until data is available to read on the\n-- given file descriptor (GHC only).\n--\n-- This will throw an 'IOError' if the file descriptor was closed\n-- while this thread was blocked.  To safely close a file descriptor\n-- that has been used with 'threadWaitRead', use\n-- 'GHC.Conc.closeFdWith'.\nthreadWaitRead :: Fd -> IO ()\nthreadWaitRead fd\n#if defined(mingw32_HOST_OS)\n  -- we have no IO manager implementing threadWaitRead on Windows.\n  -- fdReady does the right thing, but we have to call it in a\n  -- separate thread, otherwise threadWaitRead won't be interruptible,\n  -- and this only works with -threaded.\n  | threaded  = withThread (waitFd fd False)\n  | otherwise = case fd of\n                  0 -> do _ <- hWaitForInput stdin (-1)\n                          return ()\n                        -- hWaitForInput does work properly, but we can only\n                        -- do this for stdin since we know its FD.\n                  _ -> errorWithoutStackTrace \"threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput\"\n#else\n  = GHC.Conc.threadWaitRead fd\n#endif\n\n-- | Block the current thread until data can be written to the\n-- given file descriptor (GHC only).\n--\n-- This will throw an 'IOError' if the file descriptor was closed\n-- while this thread was blocked.  To safely close a file descriptor\n-- that has been used with 'threadWaitWrite', use\n-- 'GHC.Conc.closeFdWith'.\nthreadWaitWrite :: Fd -> IO ()\nthreadWaitWrite fd\n#if defined(mingw32_HOST_OS)\n  | threaded  = withThread (waitFd fd True)\n  | otherwise = errorWithoutStackTrace \"threadWaitWrite requires -threaded on Windows\"\n#else\n  = GHC.Conc.threadWaitWrite fd\n#endif\n\n-- | Returns an STM action that can be used to wait for data\n-- to read from a file descriptor. The second returned value\n-- is an IO action that can be used to deregister interest\n-- in the file descriptor.\n--\n-- @since 4.7.0.0\nthreadWaitReadSTM :: Fd -> IO (STM (), IO ())\nthreadWaitReadSTM fd\n#if defined(mingw32_HOST_OS)\n  | threaded = do v <- newTVarIO Nothing\n                  mask_ $ void $ forkIO $ do result <- try (waitFd fd False)\n                                             atomically (writeTVar v $ Just result)\n                  let waitAction = do result <- readTVar v\n                                      case result of\n                                        Nothing         -> retry\n                                        Just (Right ()) -> return ()\n                                        Just (Left e)   -> throwSTM (e :: IOException)\n                  let killAction = return ()\n                  return (waitAction, killAction)\n  | otherwise = errorWithoutStackTrace \"threadWaitReadSTM requires -threaded on Windows\"\n#else\n  = GHC.Conc.threadWaitReadSTM fd\n#endif\n\n-- | Returns an STM action that can be used to wait until data\n-- can be written to a file descriptor. The second returned value\n-- is an IO action that can be used to deregister interest\n-- in the file descriptor.\n--\n-- @since 4.7.0.0\nthreadWaitWriteSTM :: Fd -> IO (STM (), IO ())\nthreadWaitWriteSTM fd\n#if defined(mingw32_HOST_OS)\n  | threaded = do v <- newTVarIO Nothing\n                  mask_ $ void $ forkIO $ do result <- try (waitFd fd True)\n                                             atomically (writeTVar v $ Just result)\n                  let waitAction = do result <- readTVar v\n                                      case result of\n                                        Nothing         -> retry\n                                        Just (Right ()) -> return ()\n                                        Just (Left e)   -> throwSTM (e :: IOException)\n                  let killAction = return ()\n                  return (waitAction, killAction)\n  | otherwise = errorWithoutStackTrace \"threadWaitWriteSTM requires -threaded on Windows\"\n#else\n  = GHC.Conc.threadWaitWriteSTM fd\n#endif\n\n#if defined(mingw32_HOST_OS)\nforeign import ccall unsafe \"rtsSupportsBoundThreads\" threaded :: Bool\n\nwithThread :: IO a -> IO a\nwithThread io = do\n  m <- newEmptyMVar\n  _ <- mask_ $ forkIO $ try io >>= putMVar m\n  x <- takeMVar m\n  case x of\n    Right a -> return a\n    Left e  -> throwIO (e :: IOException)\n\nwaitFd :: Fd -> Bool -> IO ()\nwaitFd fd write = do\n   throwErrnoIfMinus1_ \"fdReady\" $\n        fdReady (fromIntegral fd) (if write then 1 else 0) (-1) 0\n\nforeign import ccall safe \"fdReady\"\n  fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt\n#endif\n\n-- ---------------------------------------------------------------------------\n-- More docs\n\n{- $osthreads\n\n      #osthreads# In GHC, threads created by 'forkIO' are lightweight threads, and\n      are managed entirely by the GHC runtime.  Typically Haskell\n      threads are an order of magnitude or two more efficient (in\n      terms of both time and space) than operating system threads.\n\n      The downside of having lightweight threads is that only one can\n      run at a time, so if one thread blocks in a foreign call, for\n      example, the other threads cannot continue.  The GHC runtime\n      works around this by making use of full OS threads where\n      necessary.  When the program is built with the @-threaded@\n      option (to link against the multithreaded version of the\n      runtime), a thread making a @safe@ foreign call will not block\n      the other threads in the system; another OS thread will take\n      over running Haskell threads until the original call returns.\n      The runtime maintains a pool of these /worker/ threads so that\n      multiple Haskell threads can be involved in external calls\n      simultaneously.\n\n      The \"System.IO\" library manages multiplexing in its own way.  On\n      Windows systems it uses @safe@ foreign calls to ensure that\n      threads doing I\\/O operations don't block the whole runtime,\n      whereas on Unix systems all the currently blocked I\\/O requests\n      are managed by a single thread (the /IO manager thread/) using\n      a mechanism such as @epoll@ or @kqueue@, depending on what is\n      provided by the host operating system.\n\n      The runtime will run a Haskell thread using any of the available\n      worker OS threads.  If you need control over which particular OS\n      thread is used to run a given Haskell thread, perhaps because\n      you need to call a foreign library that uses OS-thread-local\n      state, then you need bound threads (see \"Control.Concurrent#boundthreads\").\n\n      If you don't use the @-threaded@ option, then the runtime does\n      not make use of multiple OS threads.  Foreign calls will block\n      all other running Haskell threads until the call returns.  The\n      \"System.IO\" library still does multiplexing, so there can be multiple\n      threads doing I\\/O, and this is handled internally by the runtime using\n      @select@.\n-}\n\n{- $termination\n\n      In a standalone GHC program, only the main thread is\n      required to terminate in order for the process to terminate.\n      Thus all other forked threads will simply terminate at the same\n      time as the main thread (the terminology for this kind of\n      behaviour is \\\"daemonic threads\\\").\n\n      If you want the program to wait for child threads to\n      finish before exiting, you need to program this yourself.  A\n      simple mechanism is to have each child thread write to an\n      'MVar' when it completes, and have the main\n      thread wait on all the 'MVar's before\n      exiting:\n\n>   myForkIO :: IO () -> IO (MVar ())\n>   myForkIO io = do\n>     mvar <- newEmptyMVar\n>     forkFinally io (\\_ -> putMVar mvar ())\n>     return mvar\n\n      Note that we use 'forkFinally' to make sure that the\n      'MVar' is written to even if the thread dies or\n      is killed for some reason.\n\n      A better method is to keep a global list of all child\n      threads which we should wait for at the end of the program:\n\n>    children :: MVar [MVar ()]\n>    children = unsafePerformIO (newMVar [])\n>\n>    waitForChildren :: IO ()\n>    waitForChildren = do\n>      cs <- takeMVar children\n>      case cs of\n>        []   -> return ()\n>        m:ms -> do\n>           putMVar children ms\n>           takeMVar m\n>           waitForChildren\n>\n>    forkChild :: IO () -> IO ThreadId\n>    forkChild io = do\n>        mvar <- newEmptyMVar\n>        childs <- takeMVar children\n>        putMVar children (mvar:childs)\n>        forkFinally io (\\_ -> putMVar mvar ())\n>\n>     main =\n>       later waitForChildren $\n>       ...\n\n      The main thread principle also applies to calls to Haskell from\n      outside, using @foreign export@.  When the @foreign export@ed\n      function is invoked, it starts a new main thread, and it returns\n      when this main thread terminates.  If the call causes new\n      threads to be forked, they may remain in the system after the\n      @foreign export@ed function has returned.\n-}\n\n{- $preemption\n\n      GHC implements pre-emptive multitasking: the execution of\n      threads are interleaved in a random fashion.  More specifically,\n      a thread may be pre-empted whenever it allocates some memory,\n      which unfortunately means that tight loops which do no\n      allocation tend to lock out other threads (this only seems to\n      happen with pathological benchmark-style code, however).\n\n      The rescheduling timer runs on a 20ms granularity by\n      default, but this may be altered using the\n      @-i\\<n\\>@ RTS option.  After a rescheduling\n      \\\"tick\\\" the running thread is pre-empted as soon as\n      possible.\n\n      One final note: the\n      @aaaa@ @bbbb@ example may not\n      work too well on GHC (see Scheduling, above), due\n      to the locking on a 'System.IO.Handle'.  Only one thread\n      may hold the lock on a 'System.IO.Handle' at any one\n      time, so if a reschedule happens while a thread is holding the\n      lock, the other thread won't be able to run.  The upshot is that\n      the switch from @aaaa@ to\n      @bbbbb@ happens infrequently.  It can be\n      improved by lowering the reschedule tick period.  We also have a\n      patch that causes a reschedule whenever a thread waiting on a\n      lock is woken up, but haven't found it to be useful for anything\n      other than this example :-)\n-}\n\n{- $deadlock\n\nGHC attempts to detect when threads are deadlocked using the garbage\ncollector.  A thread that is not reachable (cannot be found by\nfollowing pointers from live objects) must be deadlocked, and in this\ncase the thread is sent an exception.  The exception is either\n'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM',\n'NonTermination', or 'Deadlock', depending on the way in which the\nthread is deadlocked.\n\nNote that this feature is intended for debugging, and should not be\nrelied on for the correct operation of your program.  There is no\nguarantee that the garbage collector will be accurate enough to detect\nyour deadlock, and no guarantee that the garbage collector will run in\na timely enough manner.  Basically, the same caveats as for finalizers\napply to deadlock detection.\n\nThere is a subtle interaction between deadlock detection and\nfinalizers (as created by 'Foreign.Concurrent.newForeignPtr' or the\nfunctions in \"System.Mem.Weak\"): if a thread is blocked waiting for a\nfinalizer to run, then the thread will be considered deadlocked and\nsent an exception.  So preferably don't do this, but if you have no\nalternative then it is possible to prevent the thread from being\nconsidered deadlocked by making a 'StablePtr' pointing to it.  Don't\nforget to release the 'StablePtr' later with 'freeStablePtr'.\n-}\n", "num_lines": 667}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Exception\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (extended exceptions)\n--\n-- This module provides support for raising and catching both built-in\n-- and user-defined exceptions.\n--\n-- In addition to exceptions thrown by 'IO' operations, exceptions may\n-- be thrown by pure code (imprecise exceptions) or by external events\n-- (asynchronous exceptions), but may only be caught in the 'IO' monad.\n-- For more details, see:\n--\n--  * /A semantics for imprecise exceptions/, by Simon Peyton Jones,\n--    Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson,\n--    in /PLDI'99/.\n--\n--  * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton\n--    Jones, Andy Moran and John Reppy, in /PLDI'01/.\n--\n--  * /An Extensible Dynamically-Typed Hierarchy of Exceptions/,\n--    by Simon Marlow, in /Haskell '06/.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Exception (\n\n        -- * The Exception type\n        SomeException(..),\n        Exception(..),          -- class\n        IOException,            -- instance Eq, Ord, Show, Typeable, Exception\n        ArithException(..),     -- instance Eq, Ord, Show, Typeable, Exception\n        ArrayException(..),     -- instance Eq, Ord, Show, Typeable, Exception\n        AssertionFailed(..),\n        SomeAsyncException(..),\n        AsyncException(..),     -- instance Eq, Ord, Show, Typeable, Exception\n        asyncExceptionToException, asyncExceptionFromException,\n\n        NonTermination(..),\n        NestedAtomically(..),\n        BlockedIndefinitelyOnMVar(..),\n        BlockedIndefinitelyOnSTM(..),\n        AllocationLimitExceeded(..),\n        CompactionFailed(..),\n        Deadlock(..),\n        NoMethodError(..),\n        PatternMatchFail(..),\n        RecConError(..),\n        RecSelError(..),\n        RecUpdError(..),\n        ErrorCall(..),\n        TypeError(..),\n\n        -- * Throwing exceptions\n        throw,\n        throwIO,\n        ioError,\n        throwTo,\n\n        -- * Catching Exceptions\n\n        -- $catching\n\n        -- ** Catching all exceptions\n\n        -- $catchall\n\n        -- ** The @catch@ functions\n        catch,\n        catches, Handler(..),\n        catchJust,\n\n        -- ** The @handle@ functions\n        handle,\n        handleJust,\n\n        -- ** The @try@ functions\n        try,\n        tryJust,\n\n        -- ** The @evaluate@ function\n        evaluate,\n\n        -- ** The @mapException@ function\n        mapException,\n\n        -- * Asynchronous Exceptions\n\n        -- $async\n\n        -- ** Asynchronous exception control\n\n        -- |The following functions allow a thread to control delivery of\n        -- asynchronous exceptions during a critical region.\n\n        mask,\n        mask_,\n        uninterruptibleMask,\n        uninterruptibleMask_,\n        MaskingState(..),\n        getMaskingState,\n        interruptible,\n        allowInterrupt,\n\n        -- *** Applying @mask@ to an exception handler\n\n        -- $block_handler\n\n        -- *** Interruptible operations\n\n        -- $interruptible\n\n        -- * Assertions\n\n        assert,\n\n        -- * Utilities\n\n        bracket,\n        bracket_,\n        bracketOnError,\n\n        finally,\n        onException,\n\n  ) where\n\nimport Control.Exception.Base\n\nimport GHC.Base\nimport GHC.IO (interruptible)\n\n-- | You need this when using 'catches'.\ndata Handler a = forall e . Exception e => Handler (e -> IO a)\n\n-- | @since 4.6.0.0\ninstance Functor Handler where\n     fmap f (Handler h) = Handler (fmap f . h)\n\n{- |\nSometimes you want to catch two different sorts of exception. You could\ndo something like\n\n> f = expr `catch` \\ (ex :: ArithException) -> handleArith ex\n>          `catch` \\ (ex :: IOException)    -> handleIO    ex\n\nHowever, there are a couple of problems with this approach. The first is\nthat having two exception handlers is inefficient. However, the more\nserious issue is that the second exception handler will catch exceptions\nin the first, e.g. in the example above, if @handleArith@ throws an\n@IOException@ then the second exception handler will catch it.\n\nInstead, we provide a function 'catches', which would be used thus:\n\n> f = expr `catches` [Handler (\\ (ex :: ArithException) -> handleArith ex),\n>                     Handler (\\ (ex :: IOException)    -> handleIO    ex)]\n-}\ncatches :: IO a -> [Handler a] -> IO a\ncatches io handlers = io `catch` catchesHandler handlers\n\ncatchesHandler :: [Handler a] -> SomeException -> IO a\ncatchesHandler handlers e = foldr tryHandler (throw e) handlers\n    where tryHandler (Handler handler) res\n              = case fromException e of\n                Just e' -> handler e'\n                Nothing -> res\n\n-- -----------------------------------------------------------------------------\n-- Catching exceptions\n\n{- $catching\n\nThere are several functions for catching and examining\nexceptions; all of them may only be used from within the\n'IO' monad.\n\nHere's a rule of thumb for deciding which catch-style function to\nuse:\n\n * If you want to do some cleanup in the event that an exception\n   is raised, use 'finally', 'bracket' or 'onException'.\n\n * To recover after an exception and do something else, the best\n   choice is to use one of the 'try' family.\n\n * ... unless you are recovering from an asynchronous exception, in which\n   case use 'catch' or 'catchJust'.\n\nThe difference between using 'try' and 'catch' for recovery is that in\n'catch' the handler is inside an implicit 'mask' (see \\\"Asynchronous\nExceptions\\\") which is important when catching asynchronous\nexceptions, but when catching other kinds of exception it is\nunnecessary.  Furthermore it is possible to accidentally stay inside\nthe implicit 'mask' by tail-calling rather than returning from the\nhandler, which is why we recommend using 'try' rather than 'catch' for\nordinary exception recovery.\n\nA typical use of 'tryJust' for recovery looks like this:\n\n>  do r <- tryJust (guard . isDoesNotExistError) $ getEnv \"HOME\"\n>     case r of\n>       Left  e    -> ...\n>       Right home -> ...\n\n-}\n\n-- -----------------------------------------------------------------------------\n-- Asynchronous exceptions\n\n-- | When invoked inside 'mask', this function allows a masked\n-- asynchronous exception to be raised, if one exists.  It is\n-- equivalent to performing an interruptible operation (see\n-- #interruptible), but does not involve any actual blocking.\n--\n-- When called outside 'mask', or inside 'uninterruptibleMask', this\n-- function has no effect.\n--\n-- @since 4.4.0.0\nallowInterrupt :: IO ()\nallowInterrupt = interruptible $ return ()\n\n{- $async\n\n #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to\nexternal influences, and can be raised at any point during execution.\n'StackOverflow' and 'HeapOverflow' are two examples of\nsystem-generated asynchronous exceptions.\n\nThe primary source of asynchronous exceptions, however, is\n'throwTo':\n\n>  throwTo :: ThreadId -> Exception -> IO ()\n\n'throwTo' (also 'Control.Concurrent.killThread') allows one\nrunning thread to raise an arbitrary exception in another thread.  The\nexception is therefore asynchronous with respect to the target thread,\nwhich could be doing anything at the time it receives the exception.\nGreat care should be taken with asynchronous exceptions; it is all too\neasy to introduce race conditions by the over zealous use of\n'throwTo'.\n-}\n\n{- $block_handler\nThere\\'s an implied 'mask' around every exception handler in a call\nto one of the 'catch' family of functions.  This is because that is\nwhat you want most of the time - it eliminates a common race condition\nin starting an exception handler, because there may be no exception\nhandler on the stack to handle another exception if one arrives\nimmediately.  If asynchronous exceptions are masked on entering the\nhandler, though, we have time to install a new exception handler\nbefore being interrupted.  If this weren\\'t the default, one would have\nto write something like\n\n>      mask $ \\restore ->\n>           catch (restore (...))\n>                 (\\e -> handler)\n\nIf you need to unmask asynchronous exceptions again in the exception\nhandler, @restore@ can be used there too.\n\nNote that 'try' and friends /do not/ have a similar default, because\nthere is no exception handler in this case.  Don't use 'try' for\nrecovering from an asynchronous exception.\n-}\n\n{- $interruptible\n\n #interruptible#\nSome operations are /interruptible/, which means that they can receive\nasynchronous exceptions even in the scope of a 'mask'.  Any function\nwhich may itself block is defined as interruptible; this includes\n'Control.Concurrent.MVar.takeMVar'\n(but not 'Control.Concurrent.MVar.tryTakeMVar'),\nand most operations which perform\nsome I\\/O with the outside world.  The reason for having\ninterruptible operations is so that we can write things like\n\n>      mask $ \\restore -> do\n>         a <- takeMVar m\n>         catch (restore (...))\n>               (\\e -> ...)\n\nif the 'Control.Concurrent.MVar.takeMVar' was not interruptible,\nthen this particular\ncombination could lead to deadlock, because the thread itself would be\nblocked in a state where it can\\'t receive any asynchronous exceptions.\nWith 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be\nsafe in the knowledge that the thread can receive exceptions right up\nuntil the point when the 'Control.Concurrent.MVar.takeMVar' succeeds.\nSimilar arguments apply for other interruptible operations like\n'System.IO.openFile'.\n\nIt is useful to think of 'mask' not as a way to completely prevent\nasynchronous exceptions, but as a way to switch from asynchronous mode\nto polling mode.  The main difficulty with asynchronous\nexceptions is that they normally can occur anywhere, but within a\n'mask' an asynchronous exception is only raised by operations that are\ninterruptible (or call other interruptible operations).  In many cases\nthese operations may themselves raise exceptions, such as I\\/O errors,\nso the caller will usually be prepared to handle exceptions arising from the\noperation anyway.  To perform an explicit poll for asynchronous exceptions\ninside 'mask', use 'allowInterrupt'.\n\nSometimes it is too onerous to handle exceptions in the middle of a\ncritical piece of stateful code.  There are three ways to handle this\nkind of situation:\n\n * Use STM.  Since a transaction is always either completely executed\n   or not at all, transactions are a good way to maintain invariants\n   over state in the presence of asynchronous (and indeed synchronous)\n   exceptions.\n\n * Use 'mask', and avoid interruptible operations.  In order to do\n   this, we have to know which operations are interruptible.  It is\n   impossible to know for any given library function whether it might\n   invoke an interruptible operation internally; so instead we give a\n   list of guaranteed-not-to-be-interruptible operations below.\n\n * Use 'uninterruptibleMask'.  This is generally not recommended,\n   unless you can guarantee that any interruptible operations invoked\n   during the scope of 'uninterruptibleMask' can only ever block for\n   a short time.  Otherwise, 'uninterruptibleMask' is a good way to\n   make your program deadlock and be unresponsive to user interrupts.\n\nThe following operations are guaranteed not to be interruptible:\n\n * operations on 'Data.IORef.IORef' from \"Data.IORef\"\n\n * STM transactions that do not use 'GHC.Conc.retry'\n\n * everything from the @Foreign@ modules\n\n * everything from \"Control.Exception\" except for 'throwTo'\n\n * 'Control.Concurrent.MVar.tryTakeMVar', 'Control.Concurrent.MVar.tryPutMVar',\n   'Control.Concurrent.MVar.isEmptyMVar'\n\n * 'Control.Concurrent.MVar.takeMVar' if the 'Control.Concurrent.MVar.MVar' is\n   definitely full, and conversely 'Control.Concurrent.MVar.putMVar' if the\n   'Control.Concurrent.MVar.MVar' is definitely empty\n\n * 'Control.Concurrent.MVar.newEmptyMVar', 'Control.Concurrent.MVar.newMVar'\n\n * 'Control.Concurrent.forkIO', 'Control.Concurrent.myThreadId'\n\n-}\n\n{- $catchall\n\nIt is possible to catch all exceptions, by using the type 'SomeException':\n\n> catch f (\\e -> ... (e :: SomeException) ...)\n\nHOWEVER, this is normally not what you want to do!\n\nFor example, suppose you want to read a file, but if it doesn't exist\nthen continue as if it contained \\\"\\\".  You might be tempted to just\ncatch all exceptions and return \\\"\\\" in the handler. However, this has\nall sorts of undesirable consequences.  For example, if the user\npresses control-C at just the right moment then the 'UserInterrupt'\nexception will be caught, and the program will continue running under\nthe belief that the file contains \\\"\\\".  Similarly, if another thread\ntries to kill the thread reading the file then the 'ThreadKilled'\nexception will be ignored.\n\nInstead, you should only catch exactly the exceptions that you really\nwant. In this case, this would likely be more specific than even\n\\\"any IO exception\\\"; a permissions error would likely also want to be\nhandled differently. Instead, you would probably want something like:\n\n> e <- tryJust (guard . isDoesNotExistError) (readFile f)\n> let str = either (const \"\") id e\n\nThere are occasions when you really do need to catch any sort of\nexception. However, in most cases this is just so you can do some\ncleaning up; you aren't actually interested in the exception itself.\nFor example, if you open a file then you want to close it again,\nwhether processing the file executes normally or throws an exception.\nHowever, in these cases you can use functions like 'bracket', 'finally'\nand 'onException', which never actually pass you the exception, but\njust call the cleanup functions at the appropriate points.\n\nBut sometimes you really do need to catch any exception, and actually\nsee what the exception is. One example is at the very top-level of a\nprogram, you may wish to catch any exception, print it to a logfile or\nthe screen, and then exit gracefully. For these cases, you can use\n'catch' (or one of the other exception-catching functions) with the\n'SomeException' type.\n-}\n\n", "num_lines": 399}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The 'Functor', 'Monad' and 'MonadPlus' classes,\n-- with some useful operations on monads.\n\nmodule Control.Monad\n    (\n    -- * Functor and monad classes\n\n      Functor(fmap)\n    , Monad((>>=), (>>), return, fail)\n    , MonadPlus(mzero, mplus)\n    -- * Functions\n\n    -- ** Naming conventions\n    -- $naming\n\n    -- ** Basic @Monad@ functions\n\n    , mapM\n    , mapM_\n    , forM\n    , forM_\n    , sequence\n    , sequence_\n    , (=<<)\n    , (>=>)\n    , (<=<)\n    , forever\n    , void\n\n    -- ** Generalisations of list functions\n\n    , join\n    , msum\n    , mfilter\n    , filterM\n    , mapAndUnzipM\n    , zipWithM\n    , zipWithM_\n    , foldM\n    , foldM_\n    , replicateM\n    , replicateM_\n\n    -- ** Conditional execution of monadic expressions\n\n    , guard\n    , when\n    , unless\n\n    -- ** Monadic lifting operators\n\n    , liftM\n    , liftM2\n    , liftM3\n    , liftM4\n    , liftM5\n\n    , ap\n\n    -- ** Strict monadic functions\n\n    , (<$!>)\n    ) where\n\nimport Data.Foldable ( Foldable, sequence_, sequenceA_, msum, mapM_, foldlM, forM_ )\nimport Data.Functor ( void, (<$>) )\nimport Data.Traversable ( forM, mapM, traverse, sequence, sequenceA )\n\nimport GHC.Base hiding ( mapM, sequence )\nimport GHC.List ( zipWith, unzip )\nimport GHC.Num  ( (-) )\n\n-- -----------------------------------------------------------------------------\n-- Functions mandated by the Prelude\n\n-- | Conditional failure of 'Alternative' computations. Defined by\n--\n-- @\n-- guard True  = 'pure' ()\n-- guard False = 'empty'\n-- @\n--\n-- ==== __Examples__\n--\n-- Common uses of 'guard' include conditionally signaling an error in\n-- an error monad and conditionally rejecting the current choice in an\n-- 'Alternative'-based parser.\n--\n-- As an example of signaling an error in the error monad 'Maybe',\n-- consider a safe division function @safeDiv x y@ that returns\n-- 'Nothing' when the denominator @y@ is zero and @'Just' (x \\`div\\`\n-- y)@ otherwise. For example:\n--\n-- @\n-- >>> safeDiv 4 0\n-- Nothing\n-- >>> safeDiv 4 2\n-- Just 2\n-- @\n--\n-- A definition of @safeDiv@ using guards, but not 'guard':\n--\n-- @\n-- safeDiv :: Int -> Int -> Maybe Int\n-- safeDiv x y | y /= 0    = Just (x \\`div\\` y)\n--             | otherwise = Nothing\n-- @\n--\n-- A definition of @safeDiv@ using 'guard' and 'Monad' @do@-notation:\n--\n-- @\n-- safeDiv :: Int -> Int -> Maybe Int\n-- safeDiv x y = do\n--   guard (y /= 0)\n--   return (x \\`div\\` y)\n-- @\nguard           :: (Alternative f) => Bool -> f ()\nguard True      =  pure ()\nguard False     =  empty\n\n-- | This generalizes the list-based 'Data.List.filter' function.\n\n{-# INLINE filterM #-}\nfilterM          :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]\nfilterM p        = foldr (\\ x -> liftA2 (\\ flg -> if flg then (x:) else id) (p x)) (pure [])\n\ninfixr 1 <=<, >=>\n\n-- | Left-to-right composition of Kleisli arrows.\n(>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)\nf >=> g     = \\x -> f x >>= g\n\n-- | Right-to-left composition of Kleisli arrows. @('>=>')@, with the arguments\n-- flipped.\n--\n-- Note how this operator resembles function composition @('.')@:\n--\n-- > (.)   ::            (b ->   c) -> (a ->   b) -> a ->   c\n-- > (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c\n(<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)\n(<=<)       = flip (>=>)\n\n-- | Repeat an action indefinitely.\n--\n-- ==== __Examples__\n--\n-- A common use of 'forever' is to process input from network sockets,\n-- 'System.IO.Handle's, and channels\n-- (e.g. 'Control.Concurrent.MVar.MVar' and\n-- 'Control.Concurrent.Chan.Chan').\n--\n-- For example, here is how we might implement an [echo\n-- server](https://en.wikipedia.org/wiki/Echo_Protocol), using\n-- 'forever' both to listen for client connections on a network socket\n-- and to echo client input on client connection handles:\n--\n-- @\n-- echoServer :: Socket -> IO ()\n-- echoServer socket = 'forever' $ do\n--   client <- accept socket\n--   'Control.Concurrent.forkFinally' (echo client) (\\\\_ -> hClose client)\n--   where\n--     echo :: Handle -> IO ()\n--     echo client = 'forever' $\n--       hGetLine client >>= hPutStrLn client\n-- @\nforever     :: (Applicative f) => f a -> f b\n{-# INLINE forever #-}\nforever a   = let a' = a *> a' in a'\n-- Use explicit sharing here, as it prevents a space leak regardless of\n-- optimizations.\n\n-- -----------------------------------------------------------------------------\n-- Other monad functions\n\n-- | The 'mapAndUnzipM' function maps its first argument over a list, returning\n-- the result as a pair of lists. This function is mainly used with complicated\n-- data structures or a state monad.\nmapAndUnzipM      :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c])\n{-# INLINE mapAndUnzipM #-}\n-- Inline so that fusion with 'unzip' and 'traverse' has a chance to fire.\n-- See Note [Inline @unzipN@ functions] in GHC/OldList.hs.\nmapAndUnzipM f xs =  unzip <$> traverse f xs\n\n-- | The 'zipWithM' function generalizes 'zipWith' to arbitrary applicative functors.\nzipWithM          :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c]\n{-# INLINE zipWithM #-}\n-- Inline so that fusion with zipWith and sequenceA have a chance to fire\n-- See Note [Fusion for zipN/zipWithN] in List.hs]\nzipWithM f xs ys  =  sequenceA (zipWith f xs ys)\n\n-- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.\nzipWithM_         :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m ()\n{-# INLINE zipWithM_ #-}\n-- Inline so that fusion with zipWith and sequenceA have a chance to fire\n-- See Note [Fusion for zipN/zipWithN] in List.hs]\nzipWithM_ f xs ys =  sequenceA_ (zipWith f xs ys)\n\n{- | The 'foldM' function is analogous to 'Data.Foldable.foldl', except that its result is\nencapsulated in a monad. Note that 'foldM' works from left-to-right over\nthe list arguments. This could be an issue where @('>>')@ and the `folded\nfunction' are not commutative.\n\n\n> foldM f a1 [x1, x2, ..., xm]\n>\n> ==\n>\n> do\n>   a2 <- f a1 x1\n>   a3 <- f a2 x2\n>   ...\n>   f am xm\n\nIf right-to-left evaluation is required, the input list should be reversed.\n\nNote: 'foldM' is the same as 'foldlM'\n-}\n\nfoldM          :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b\n{-# INLINABLE foldM #-}\n{-# SPECIALISE foldM :: (a -> b -> IO a) -> a -> [b] -> IO a #-}\n{-# SPECIALISE foldM :: (a -> b -> Maybe a) -> a -> [b] -> Maybe a #-}\nfoldM          = foldlM\n\n-- | Like 'foldM', but discards the result.\nfoldM_         :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()\n{-# INLINABLE foldM_ #-}\n{-# SPECIALISE foldM_ :: (a -> b -> IO a) -> a -> [b] -> IO () #-}\n{-# SPECIALISE foldM_ :: (a -> b -> Maybe a) -> a -> [b] -> Maybe () #-}\nfoldM_ f a xs  = foldlM f a xs >> return ()\n\n{-\nNote [Worker/wrapper transform on replicateM/replicateM_]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe implementations of replicateM and replicateM_ both leverage the\nworker/wrapper transform. The simpler implementation of replicateM_, as an\nexample, would be:\n\n    replicateM_ 0 _ = pure ()\n    replicateM_ n f = f *> replicateM_ (n - 1) f\n\nHowever, the self-recursive nature of this implementation inhibits inlining,\nwhich means we never get to specialise to the action (`f` in the code above).\nBy contrast, the implementation below with a local loop makes it possible to\ninline the entire definition (as happens for foldr, for example) thereby\nspecialising for the particular action.\n\nFor further information, see this Trac comment, which includes side-by-side\nCore: https://ghc.haskell.org/trac/ghc/ticket/11795#comment:6\n-}\n\n-- | @'replicateM' n act@ performs the action @n@ times,\n-- gathering the results.\nreplicateM        :: (Applicative m) => Int -> m a -> m [a]\n{-# INLINABLE replicateM #-}\n{-# SPECIALISE replicateM :: Int -> IO a -> IO [a] #-}\n{-# SPECIALISE replicateM :: Int -> Maybe a -> Maybe [a] #-}\nreplicateM cnt0 f =\n    loop cnt0\n  where\n    loop cnt\n        | cnt <= 0  = pure []\n        | otherwise = liftA2 (:) f (loop (cnt - 1))\n\n-- | Like 'replicateM', but discards the result.\nreplicateM_       :: (Applicative m) => Int -> m a -> m ()\n{-# INLINABLE replicateM_ #-}\n{-# SPECIALISE replicateM_ :: Int -> IO a -> IO () #-}\n{-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-}\nreplicateM_ cnt0 f =\n    loop cnt0\n  where\n    loop cnt\n        | cnt <= 0  = pure ()\n        | otherwise = f *> loop (cnt - 1)\n\n\n-- | The reverse of 'when'.\nunless            :: (Applicative f) => Bool -> f () -> f ()\n{-# INLINABLE unless #-}\n{-# SPECIALISE unless :: Bool -> IO () -> IO () #-}\n{-# SPECIALISE unless :: Bool -> Maybe () -> Maybe () #-}\nunless p s        =  if p then pure () else s\n\ninfixl 4 <$!>\n\n-- | Strict version of 'Data.Functor.<$>'.\n--\n-- @since 4.8.0.0\n(<$!>) :: Monad m => (a -> b) -> m a -> m b\n{-# INLINE (<$!>) #-}\nf <$!> m = do\n  x <- m\n  let z = f x\n  z `seq` return z\n\n\n-- -----------------------------------------------------------------------------\n-- Other MonadPlus functions\n\n-- | Direct 'MonadPlus' equivalent of 'Data.List.filter'.\n--\n-- ==== __Examples__\n--\n-- The 'Data.List.filter' function is just 'mfilter' specialized to\n-- the list monad:\n--\n-- @\n-- 'Data.List.filter' = ( 'mfilter' :: (a -> Bool) -> [a] -> [a] )\n-- @\n--\n-- An example using 'mfilter' with the 'Maybe' monad:\n--\n-- @\n-- >>> mfilter odd (Just 1)\n-- Just 1\n-- >>> mfilter odd (Just 2)\n-- Nothing\n-- @\nmfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a\n{-# INLINABLE mfilter #-}\nmfilter p ma = do\n  a <- ma\n  if p a then return a else mzero\n\n{- $naming\n\nThe functions in this library use the following naming conventions:\n\n* A postfix \\'@M@\\' always stands for a function in the Kleisli category:\n  The monad type constructor @m@ is added to function results\n  (modulo currying) and nowhere else.  So, for example,\n\n> filter  ::              (a ->   Bool) -> [a] ->   [a]\n> filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]\n\n* A postfix \\'@_@\\' changes the result type from @(m a)@ to @(m ())@.\n  Thus, for example:\n\n> sequence  :: Monad m => [m a] -> m [a]\n> sequence_ :: Monad m => [m a] -> m ()\n\n* A prefix \\'@m@\\' generalizes an existing function to a monadic form.\n  Thus, for example:\n\n> filter  ::                (a -> Bool) -> [a] -> [a]\n> mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a\n\n-}\n", "num_lines": 365}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Concurrent.Chan\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (concurrency)\n--\n-- Unbounded channels.\n--\n-- The channels are implemented with @MVar@s and therefore inherit all the\n-- caveats that apply to @MVar@s (possibility of races, deadlocks etc). The\n-- stm (software transactional memory) library has a more robust implementation\n-- of channels called @TChan@s.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Concurrent.Chan\n  (\n          -- * The 'Chan' type\n        Chan,                   -- abstract\n\n          -- * Operations\n        newChan,\n        writeChan,\n        readChan,\n        dupChan,\n\n          -- * Stream interface\n        getChanContents,\n        writeList2Chan,\n   ) where\n\nimport System.IO.Unsafe         ( unsafeInterleaveIO )\nimport Control.Concurrent.MVar\nimport Control.Exception (mask_)\n\n#define _UPK_(x) {-# UNPACK #-} !(x)\n\n-- A channel is represented by two @MVar@s keeping track of the two ends\n-- of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s\n-- are used to handle consumers trying to read from an empty channel.\n\n-- |'Chan' is an abstract type representing an unbounded FIFO channel.\ndata Chan a\n = Chan _UPK_(MVar (Stream a))\n        _UPK_(MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar\n   deriving Eq -- ^ @since 4.4.0.0\n\ntype Stream a = MVar (ChItem a)\n\ndata ChItem a = ChItem a _UPK_(Stream a)\n  -- benchmarks show that unboxing the MVar here is worthwhile, because\n  -- although it leads to higher allocation, the channel data takes up\n  -- less space and is therefore quicker to GC.\n\n-- See the Concurrent Haskell paper for a diagram explaining the\n-- how the different channel operations proceed.\n\n-- @newChan@ sets up the read and write end of a channel by initialising\n-- these two @MVar@s with an empty @MVar@.\n\n-- |Build and returns a new instance of 'Chan'.\nnewChan :: IO (Chan a)\nnewChan = do\n   hole  <- newEmptyMVar\n   readVar  <- newMVar hole\n   writeVar <- newMVar hole\n   return (Chan readVar writeVar)\n\n-- To put an element on a channel, a new hole at the write end is created.\n-- What was previously the empty @MVar@ at the back of the channel is then\n-- filled in with a new stream element holding the entered value and the\n-- new hole.\n\n-- |Write a value to a 'Chan'.\nwriteChan :: Chan a -> a -> IO ()\nwriteChan (Chan _ writeVar) val = do\n  new_hole <- newEmptyMVar\n  mask_ $ do\n    old_hole <- takeMVar writeVar\n    putMVar old_hole (ChItem val new_hole)\n    putMVar writeVar new_hole\n\n-- The reason we don't simply do this:\n--\n--    modifyMVar_ writeVar $ \\old_hole -> do\n--      putMVar old_hole (ChItem val new_hole)\n--      return new_hole\n--\n-- is because if an asynchronous exception is received after the 'putMVar'\n-- completes and before modifyMVar_ installs the new value, it will set the\n-- Chan's write end to a filled hole.\n\n-- |Read the next value from the 'Chan'. Blocks when the channel is empty. Since\n-- the read end of a channel is an 'MVar', this operation inherits fairness\n-- guarantees of 'MVar's (e.g. threads blocked in this operation are woken up in\n-- FIFO order).\n--\n-- Throws 'Control.Exception.BlockedIndefinitelyOnMVar' when the channel is\n-- empty and no other thread holds a reference to the channel.\nreadChan :: Chan a -> IO a\nreadChan (Chan readVar _) = do\n  modifyMVar readVar $ \\read_end -> do\n    (ChItem val new_read_end) <- readMVar read_end\n        -- Use readMVar here, not takeMVar,\n        -- else dupChan doesn't work\n    return (new_read_end, val)\n\n-- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to\n-- either channel from then on will be available from both.  Hence this creates\n-- a kind of broadcast channel, where data written by anyone is seen by\n-- everyone else.\n--\n-- (Note that a duplicated channel is not equal to its original.\n-- So: @fmap (c /=) $ dupChan c@ returns @True@ for all @c@.)\ndupChan :: Chan a -> IO (Chan a)\ndupChan (Chan _ writeVar) = do\n   hole       <- readMVar writeVar\n   newReadVar <- newMVar hole\n   return (Chan newReadVar writeVar)\n\n-- Operators for interfacing with functional streams.\n\n-- |Return a lazy list representing the contents of the supplied\n-- 'Chan', much like 'System.IO.hGetContents'.\ngetChanContents :: Chan a -> IO [a]\ngetChanContents ch\n  = unsafeInterleaveIO (do\n        x  <- readChan ch\n        xs <- getChanContents ch\n        return (x:xs)\n    )\n\n-- |Write an entire list of items to a 'Chan'.\nwriteList2Chan :: Chan a -> [a] -> IO ()\nwriteList2Chan ch ls = sequence_ (map (writeChan ch) ls)\n", "num_lines": 143}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, UnboxedTuples, MagicHash #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Concurrent.MVar\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (concurrency)\n--\n-- An @'MVar' t@ is mutable location that is either empty or contains a\n-- value of type @t@.  It has two fundamental operations: 'putMVar'\n-- which fills an 'MVar' if it is empty and blocks otherwise, and\n-- 'takeMVar' which empties an 'MVar' if it is full and blocks\n-- otherwise.  They can be used in multiple different ways:\n--\n--   1. As synchronized mutable variables,\n--\n--   2. As channels, with 'takeMVar' and 'putMVar' as receive and send, and\n--\n--   3. As a binary semaphore @'MVar' ()@, with 'takeMVar' and 'putMVar' as\n--      wait and signal.\n--\n-- They were introduced in the paper\n-- <https://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz \"Concurrent Haskell\">\n-- by Simon Peyton Jones, Andrew Gordon and Sigbjorn Finne, though\n-- some details of their implementation have since then changed (in\n-- particular, a put on a full 'MVar' used to error, but now merely\n-- blocks.)\n--\n-- === Applicability\n--\n-- 'MVar's offer more flexibility than 'Data.IORef.IORef's, but less flexibility\n-- than 'GHC.Conc.STM'.  They are appropriate for building synchronization\n-- primitives and performing simple interthread communication; however\n-- they are very simple and susceptible to race conditions, deadlocks or\n-- uncaught exceptions.  Do not use them if you need perform larger\n-- atomic operations such as reading from multiple variables: use 'GHC.Conc.STM'\n-- instead.\n--\n-- In particular, the \"bigger\" functions in this module ('swapMVar',\n-- 'withMVar', 'modifyMVar_' and 'modifyMVar') are simply\n-- the composition of a 'takeMVar' followed by a 'putMVar' with\n-- exception safety.\n-- These only have atomicity guarantees if all other threads\n-- perform a 'takeMVar' before a 'putMVar' as well;  otherwise, they may\n-- block.\n--\n-- === Fairness\n--\n-- No thread can be blocked indefinitely on an 'MVar' unless another\n-- thread holds that 'MVar' indefinitely.  One usual implementation of\n-- this fairness guarantee is that threads blocked on an 'MVar' are\n-- served in a first-in-first-out fashion, but this is not guaranteed\n-- in the semantics.\n--\n-- === Gotchas\n--\n-- Like many other Haskell data structures, 'MVar's are lazy.  This\n-- means that if you place an expensive unevaluated thunk inside an\n-- 'MVar', it will be evaluated by the thread that consumes it, not the\n-- thread that produced it.  Be sure to 'evaluate' values to be placed\n-- in an 'MVar' to the appropriate normal form, or utilize a strict\n-- MVar provided by the strict-concurrency package.\n--\n-- === Ordering\n--\n-- 'MVar' operations are always observed to take place in the order\n-- they are written in the program, regardless of the memory model of\n-- the underlying machine.  This is in contrast to 'Data.IORef.IORef' operations\n-- which may appear out-of-order to another thread in some cases.\n--\n-- === Example\n--\n-- Consider the following concurrent data structure, a skip channel.\n-- This is a channel for an intermittent source of high bandwidth\n-- information (for example, mouse movement events.)  Writing to the\n-- channel never blocks, and reading from the channel only returns the\n-- most recent value, or blocks if there are no new values.  Multiple\n-- readers are supported with a @dupSkipChan@ operation.\n--\n-- A skip channel is a pair of 'MVar's. The first 'MVar' contains the\n-- current value, and a list of semaphores that need to be notified\n-- when it changes. The second 'MVar' is a semaphore for this particular\n-- reader: it is full if there is a value in the channel that this\n-- reader has not read yet, and empty otherwise.\n--\n-- @\n--     data SkipChan a = SkipChan (MVar (a, [MVar ()])) (MVar ())\n--\n--     newSkipChan :: IO (SkipChan a)\n--     newSkipChan = do\n--         sem <- newEmptyMVar\n--         main <- newMVar (undefined, [sem])\n--         return (SkipChan main sem)\n--\n--     putSkipChan :: SkipChan a -> a -> IO ()\n--     putSkipChan (SkipChan main _) v = do\n--         (_, sems) <- takeMVar main\n--         putMVar main (v, [])\n--         mapM_ (\\sem -> putMVar sem ()) sems\n--\n--     getSkipChan :: SkipChan a -> IO a\n--     getSkipChan (SkipChan main sem) = do\n--         takeMVar sem\n--         (v, sems) <- takeMVar main\n--         putMVar main (v, sem:sems)\n--         return v\n--\n--     dupSkipChan :: SkipChan a -> IO (SkipChan a)\n--     dupSkipChan (SkipChan main _) = do\n--         sem <- newEmptyMVar\n--         (v, sems) <- takeMVar main\n--         putMVar main (v, sem:sems)\n--         return (SkipChan main sem)\n-- @\n--\n-- This example was adapted from the original Concurrent Haskell paper.\n-- For more examples of 'MVar's being used to build higher-level\n-- synchronization primitives, see 'Control.Concurrent.Chan' and\n-- 'Control.Concurrent.QSem'.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Concurrent.MVar\n        (\n          -- * @MVar@s\n          MVar\n        , newEmptyMVar\n        , newMVar\n        , takeMVar\n        , putMVar\n        , readMVar\n        , swapMVar\n        , tryTakeMVar\n        , tryPutMVar\n        , isEmptyMVar\n        , withMVar\n        , withMVarMasked\n        , modifyMVar_\n        , modifyMVar\n        , modifyMVarMasked_\n        , modifyMVarMasked\n        , tryReadMVar\n        , mkWeakMVar\n        , addMVarFinalizer\n    ) where\n\nimport GHC.MVar ( MVar(..), newEmptyMVar, newMVar, takeMVar, putMVar,\n                  tryTakeMVar, tryPutMVar, isEmptyMVar, readMVar,\n                  tryReadMVar\n                )\nimport qualified GHC.MVar\nimport GHC.Weak\nimport GHC.Base\n\nimport Control.Exception.Base\n\n{-|\n  Take a value from an 'MVar', put a new value into the 'MVar' and\n  return the value taken. This function is atomic only if there are\n  no other producers for this 'MVar'.\n-}\nswapMVar :: MVar a -> a -> IO a\nswapMVar mvar new =\n  mask_ $ do\n    old <- takeMVar mvar\n    putMVar mvar new\n    return old\n\n{-|\n  'withMVar' is an exception-safe wrapper for operating on the contents\n  of an 'MVar'.  This operation is exception-safe: it will replace the\n  original contents of the 'MVar' if an exception is raised (see\n  \"Control.Exception\").  However, it is only atomic if there are no\n  other producers for this 'MVar'.\n-}\n{-# INLINE withMVar #-}\n-- inlining has been reported to have dramatic effects; see\n-- http://www.haskell.org//pipermail/haskell/2006-May/017907.html\nwithMVar :: MVar a -> (a -> IO b) -> IO b\nwithMVar m io =\n  mask $ \\restore -> do\n    a <- takeMVar m\n    b <- restore (io a) `onException` putMVar m a\n    putMVar m a\n    return b\n\n{-|\n  Like 'withMVar', but the @IO@ action in the second argument is executed\n  with asynchronous exceptions masked.\n\n  @since 4.7.0.0\n-}\n{-# INLINE withMVarMasked #-}\nwithMVarMasked :: MVar a -> (a -> IO b) -> IO b\nwithMVarMasked m io =\n  mask_ $ do\n    a <- takeMVar m\n    b <- io a `onException` putMVar m a\n    putMVar m a\n    return b\n\n{-|\n  An exception-safe wrapper for modifying the contents of an 'MVar'.\n  Like 'withMVar', 'modifyMVar' will replace the original contents of\n  the 'MVar' if an exception is raised during the operation.  This\n  function is only atomic if there are no other producers for this\n  'MVar'.\n-}\n{-# INLINE modifyMVar_ #-}\nmodifyMVar_ :: MVar a -> (a -> IO a) -> IO ()\nmodifyMVar_ m io =\n  mask $ \\restore -> do\n    a  <- takeMVar m\n    a' <- restore (io a) `onException` putMVar m a\n    putMVar m a'\n\n{-|\n  A slight variation on 'modifyMVar_' that allows a value to be\n  returned (@b@) in addition to the modified value of the 'MVar'.\n-}\n{-# INLINE modifyMVar #-}\nmodifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b\nmodifyMVar m io =\n  mask $ \\restore -> do\n    a      <- takeMVar m\n    (a',b) <- restore (io a >>= evaluate) `onException` putMVar m a\n    putMVar m a'\n    return b\n\n{-|\n  Like 'modifyMVar_', but the @IO@ action in the second argument is executed with\n  asynchronous exceptions masked.\n\n  @since 4.6.0.0\n-}\n{-# INLINE modifyMVarMasked_ #-}\nmodifyMVarMasked_ :: MVar a -> (a -> IO a) -> IO ()\nmodifyMVarMasked_ m io =\n  mask_ $ do\n    a  <- takeMVar m\n    a' <- io a `onException` putMVar m a\n    putMVar m a'\n\n{-|\n  Like 'modifyMVar', but the @IO@ action in the second argument is executed with\n  asynchronous exceptions masked.\n\n  @since 4.6.0.0\n-}\n{-# INLINE modifyMVarMasked #-}\nmodifyMVarMasked :: MVar a -> (a -> IO (a,b)) -> IO b\nmodifyMVarMasked m io =\n  mask_ $ do\n    a      <- takeMVar m\n    (a',b) <- (io a >>= evaluate) `onException` putMVar m a\n    putMVar m a'\n    return b\n\n{-# DEPRECATED addMVarFinalizer \"use 'mkWeakMVar' instead\" #-} -- deprecated in 7.6\naddMVarFinalizer :: MVar a -> IO () -> IO ()\naddMVarFinalizer = GHC.MVar.addMVarFinalizer\n\n-- | Make a 'Weak' pointer to an 'MVar', using the second argument as\n-- a finalizer to run when 'MVar' is garbage-collected\n--\n-- @since 4.6.0.0\nmkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a))\nmkWeakMVar m@(MVar m#) (IO f) = IO $ \\s ->\n    case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)\n", "num_lines": 275}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE BangPatterns #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Concurrent.QSem\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (concurrency)\n--\n-- Simple quantity semaphores.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Concurrent.QSem\n        ( -- * Simple Quantity Semaphores\n          QSem,         -- abstract\n          newQSem,      -- :: Int  -> IO QSem\n          waitQSem,     -- :: QSem -> IO ()\n          signalQSem    -- :: QSem -> IO ()\n        ) where\n\nimport Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar\n                          , putMVar, newMVar, tryPutMVar)\nimport Control.Exception\nimport Data.Maybe\n\n-- | 'QSem' is a quantity semaphore in which the resource is acquired\n-- and released in units of one. It provides guaranteed FIFO ordering\n-- for satisfying blocked `waitQSem` calls.\n--\n-- The pattern\n--\n-- >   bracket_ waitQSem signalQSem (...)\n--\n-- is safe; it never loses a unit of the resource.\n--\nnewtype QSem = QSem (MVar (Int, [MVar ()], [MVar ()]))\n\n-- The semaphore state (i, xs, ys):\n--\n--   i is the current resource value\n--\n--   (xs,ys) is the queue of blocked threads, where the queue is\n--           given by xs ++ reverse ys.  We can enqueue new blocked threads\n--           by consing onto ys, and dequeue by removing from the head of xs.\n--\n-- A blocked thread is represented by an empty (MVar ()).  To unblock\n-- the thread, we put () into the MVar.\n--\n-- A thread can dequeue itself by also putting () into the MVar, which\n-- it must do if it receives an exception while blocked in waitQSem.\n-- This means that when unblocking a thread in signalQSem we must\n-- first check whether the MVar is already full; the MVar lock on the\n-- semaphore itself resolves race conditions between signalQSem and a\n-- thread attempting to dequeue itself.\n\n-- |Build a new 'QSem' with a supplied initial quantity.\n--  The initial quantity must be at least 0.\nnewQSem :: Int -> IO QSem\nnewQSem initial\n  | initial < 0 = fail \"newQSem: Initial quantity must be non-negative\"\n  | otherwise   = do\n      sem <- newMVar (initial, [], [])\n      return (QSem sem)\n\n-- |Wait for a unit to become available\nwaitQSem :: QSem -> IO ()\nwaitQSem (QSem m) =\n  mask_ $ do\n    (i,b1,b2) <- takeMVar m\n    if i == 0\n       then do\n         b <- newEmptyMVar\n         putMVar m (i, b1, b:b2)\n         wait b\n       else do\n         let !z = i-1\n         putMVar m (z, b1, b2)\n         return ()\n  where\n    wait b = takeMVar b `onException` do\n                (uninterruptibleMask_ $ do -- Note [signal uninterruptible]\n                   (i,b1,b2) <- takeMVar m\n                   r <- tryTakeMVar b\n                   r' <- if isJust r\n                            then signal (i,b1,b2)\n                            else do putMVar b (); return (i,b1,b2)\n                   putMVar m r')\n\n-- |Signal that a unit of the 'QSem' is available\nsignalQSem :: QSem -> IO ()\nsignalQSem (QSem m) =\n  uninterruptibleMask_ $ do -- Note [signal uninterruptible]\n    r <- takeMVar m\n    r' <- signal r\n    putMVar m r'\n\n-- Note [signal uninterruptible]\n--\n--   If we have\n--\n--      bracket waitQSem signalQSem (...)\n--\n--   and an exception arrives at the signalQSem, then we must not lose\n--   the resource.  The signalQSem is masked by bracket, but taking\n--   the MVar might block, and so it would be interruptible.  Hence we\n--   need an uninterruptibleMask here.\n--\n--   This isn't ideal: during high contention, some threads won't be\n--   interruptible.  The QSemSTM implementation has better behaviour\n--   here, but it performs much worse than this one in some\n--   benchmarks.\n\nsignal :: (Int,[MVar ()],[MVar ()]) -> IO (Int,[MVar ()],[MVar ()])\nsignal (i,a1,a2) =\n if i == 0\n   then loop a1 a2\n   else let !z = i+1 in return (z, a1, a2)\n where\n   loop [] [] = return (1, [], [])\n   loop [] b2 = loop (reverse b2) []\n   loop (b:bs) b2 = do\n     r <- tryPutMVar b ()\n     if r then return (0, bs, b2)\n          else loop bs b2\n", "num_lines": 130}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Concurrent.QSemN\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (concurrency)\n--\n-- Quantity semaphores in which each thread may wait for an arbitrary\n-- \\\"amount\\\".\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Concurrent.QSemN\n        (  -- * General Quantity Semaphores\n          QSemN,        -- abstract\n          newQSemN,     -- :: Int   -> IO QSemN\n          waitQSemN,    -- :: QSemN -> Int -> IO ()\n          signalQSemN   -- :: QSemN -> Int -> IO ()\n      ) where\n\nimport Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar\n                          , putMVar, newMVar\n                          , tryPutMVar, isEmptyMVar)\nimport Control.Exception\nimport Data.Maybe\n\n-- | 'QSemN' is a quantity semaphore in which the resource is acquired\n-- and released in units of one. It provides guaranteed FIFO ordering\n-- for satisfying blocked `waitQSemN` calls.\n--\n-- The pattern\n--\n-- >   bracket_ (waitQSemN n) (signalQSemN n) (...)\n--\n-- is safe; it never loses any of the resource.\n--\nnewtype QSemN = QSemN (MVar (Int, [(Int, MVar ())], [(Int, MVar ())]))\n\n-- The semaphore state (i, xs, ys):\n--\n--   i is the current resource value\n--\n--   (xs,ys) is the queue of blocked threads, where the queue is\n--           given by xs ++ reverse ys.  We can enqueue new blocked threads\n--           by consing onto ys, and dequeue by removing from the head of xs.\n--\n-- A blocked thread is represented by an empty (MVar ()).  To unblock\n-- the thread, we put () into the MVar.\n--\n-- A thread can dequeue itself by also putting () into the MVar, which\n-- it must do if it receives an exception while blocked in waitQSemN.\n-- This means that when unblocking a thread in signalQSemN we must\n-- first check whether the MVar is already full; the MVar lock on the\n-- semaphore itself resolves race conditions between signalQSemN and a\n-- thread attempting to dequeue itself.\n\n-- |Build a new 'QSemN' with a supplied initial quantity.\n--  The initial quantity must be at least 0.\nnewQSemN :: Int -> IO QSemN\nnewQSemN initial\n  | initial < 0 = fail \"newQSemN: Initial quantity must be non-negative\"\n  | otherwise   = do\n      sem <- newMVar (initial, [], [])\n      return (QSemN sem)\n\n-- |Wait for the specified quantity to become available\nwaitQSemN :: QSemN -> Int -> IO ()\nwaitQSemN (QSemN m) sz =\n  mask_ $ do\n    (i,b1,b2) <- takeMVar m\n    let z = i-sz\n    if z < 0\n       then do\n         b <- newEmptyMVar\n         putMVar m (i, b1, (sz,b):b2)\n         wait b\n       else do\n         putMVar m (z, b1, b2)\n         return ()\n  where\n    wait b = do\n        takeMVar b `onException`\n                (uninterruptibleMask_ $ do -- Note [signal uninterruptible]\n                   (i,b1,b2) <- takeMVar m\n                   r <- tryTakeMVar b\n                   r' <- if isJust r\n                            then signal sz (i,b1,b2)\n                            else do putMVar b (); return (i,b1,b2)\n                   putMVar m r')\n\n-- |Signal that a given quantity is now available from the 'QSemN'.\nsignalQSemN :: QSemN -> Int -> IO ()\nsignalQSemN (QSemN m) sz = uninterruptibleMask_ $ do\n  r <- takeMVar m\n  r' <- signal sz r\n  putMVar m r'\n\nsignal :: Int\n       -> (Int,[(Int,MVar ())],[(Int,MVar ())])\n       -> IO (Int,[(Int,MVar ())],[(Int,MVar ())])\n\nsignal sz0 (i,a1,a2) = loop (sz0 + i) a1 a2\n where\n   loop 0  bs b2 = return (0,  bs, b2)\n   loop sz [] [] = return (sz, [], [])\n   loop sz [] b2 = loop sz (reverse b2) []\n   loop sz ((j,b):bs) b2\n     | j > sz = do\n       r <- isEmptyMVar b\n       if r then return (sz, (j,b):bs, b2)\n            else loop sz bs b2\n     | otherwise = do\n       r <- tryPutMVar b ()\n       if r then loop (sz-j) bs b2\n            else loop sz bs b2\n", "num_lines": 121}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Exception.Base\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (extended exceptions)\n--\n-- Extensible exceptions, except for multiple handlers.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Exception.Base (\n\n        -- * The Exception type\n        SomeException(..),\n        Exception(..),\n        IOException,\n        ArithException(..),\n        ArrayException(..),\n        AssertionFailed(..),\n        SomeAsyncException(..), AsyncException(..),\n        asyncExceptionToException, asyncExceptionFromException,\n        NonTermination(..),\n        NestedAtomically(..),\n        BlockedIndefinitelyOnMVar(..),\n        FixIOException (..),\n        BlockedIndefinitelyOnSTM(..),\n        AllocationLimitExceeded(..),\n        CompactionFailed(..),\n        Deadlock(..),\n        NoMethodError(..),\n        PatternMatchFail(..),\n        RecConError(..),\n        RecSelError(..),\n        RecUpdError(..),\n        ErrorCall(..),\n        TypeError(..), -- #10284, custom error type for deferred type errors\n\n        -- * Throwing exceptions\n        throwIO,\n        throw,\n        ioError,\n        throwTo,\n\n        -- * Catching Exceptions\n\n        -- ** The @catch@ functions\n        catch,\n        catchJust,\n\n        -- ** The @handle@ functions\n        handle,\n        handleJust,\n\n        -- ** The @try@ functions\n        try,\n        tryJust,\n        onException,\n\n        -- ** The @evaluate@ function\n        evaluate,\n\n        -- ** The @mapException@ function\n        mapException,\n\n        -- * Asynchronous Exceptions\n\n        -- ** Asynchronous exception control\n        mask,\n        mask_,\n        uninterruptibleMask,\n        uninterruptibleMask_,\n        MaskingState(..),\n        getMaskingState,\n\n        -- * Assertions\n\n        assert,\n\n        -- * Utilities\n\n        bracket,\n        bracket_,\n        bracketOnError,\n\n        finally,\n\n        -- * Calls for GHC runtime\n        recSelError, recConError, runtimeError,\n        nonExhaustiveGuardsError, patError, noMethodBindingError,\n        absentError, absentSumFieldError, typeError,\n        nonTermination, nestedAtomically,\n  ) where\n\nimport GHC.Base\nimport GHC.IO hiding (bracket,finally,onException)\nimport GHC.IO.Exception\nimport GHC.Exception\nimport GHC.Show\n-- import GHC.Exception hiding ( Exception )\nimport GHC.Conc.Sync\n\nimport Data.Either\n\n-----------------------------------------------------------------------------\n-- Catching exceptions\n\n-- | The function 'catchJust' is like 'catch', but it takes an extra\n-- argument which is an /exception predicate/, a function which\n-- selects which type of exceptions we\\'re interested in.\n--\n-- > catchJust (\\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)\n-- >           (readFile f)\n-- >           (\\_ -> do hPutStrLn stderr (\"No such file: \" ++ show f)\n-- >                     return \"\")\n--\n-- Any other exceptions which are not matched by the predicate\n-- are re-raised, and may be caught by an enclosing\n-- 'catch', 'catchJust', etc.\ncatchJust\n        :: Exception e\n        => (e -> Maybe b)         -- ^ Predicate to select exceptions\n        -> IO a                   -- ^ Computation to run\n        -> (b -> IO a)            -- ^ Handler\n        -> IO a\ncatchJust p a handler = catch a handler'\n  where handler' e = case p e of\n                        Nothing -> throwIO e\n                        Just b  -> handler b\n\n-- | A version of 'catch' with the arguments swapped around; useful in\n-- situations where the code for the handler is shorter.  For example:\n--\n-- >   do handle (\\NonTermination -> exitWith (ExitFailure 1)) $\n-- >      ...\nhandle     :: Exception e => (e -> IO a) -> IO a -> IO a\nhandle     =  flip catch\n\n-- | A version of 'catchJust' with the arguments swapped around (see\n-- 'handle').\nhandleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a\nhandleJust p =  flip (catchJust p)\n\n-----------------------------------------------------------------------------\n-- 'mapException'\n\n-- | This function maps one exception into another as proposed in the\n-- paper \\\"A semantics for imprecise exceptions\\\".\n\n-- Notice that the usage of 'unsafePerformIO' is safe here.\n\nmapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a\nmapException f v = unsafePerformIO (catch (evaluate v)\n                                          (\\x -> throwIO (f x)))\n\n-----------------------------------------------------------------------------\n-- 'try' and variations.\n\n-- | Similar to 'catch', but returns an 'Either' result which is\n-- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@\n-- if an exception of type @e@ was raised and its value is @ex@.\n-- If any other type of exception is raised than it will be propogated\n-- up to the next enclosing exception handler.\n--\n-- >  try a = catch (Right `liftM` a) (return . Left)\n\ntry :: Exception e => IO a -> IO (Either e a)\ntry a = catch (a >>= \\ v -> return (Right v)) (\\e -> return (Left e))\n\n-- | A variant of 'try' that takes an exception predicate to select\n-- which exceptions are caught (c.f. 'catchJust').  If the exception\n-- does not match the predicate, it is re-thrown.\ntryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)\ntryJust p a = do\n  r <- try a\n  case r of\n        Right v -> return (Right v)\n        Left  e -> case p e of\n                        Nothing -> throwIO e\n                        Just b  -> return (Left b)\n\n-- | Like 'finally', but only performs the final action if there was an\n-- exception raised by the computation.\nonException :: IO a -> IO b -> IO a\nonException io what = io `catch` \\e -> do _ <- what\n                                          throwIO (e :: SomeException)\n\n-----------------------------------------------------------------------------\n-- Some Useful Functions\n\n-- | When you want to acquire a resource, do some work with it, and\n-- then release the resource, it is a good idea to use 'bracket',\n-- because 'bracket' will install the necessary exception handler to\n-- release the resource in the event that an exception is raised\n-- during the computation.  If an exception is raised, then 'bracket' will\n-- re-raise the exception (after performing the release).\n--\n-- A common example is opening a file:\n--\n-- > bracket\n-- >   (openFile \"filename\" ReadMode)\n-- >   (hClose)\n-- >   (\\fileHandle -> do { ... })\n--\n-- The arguments to 'bracket' are in this order so that we can partially apply\n-- it, e.g.:\n--\n-- > withFile name mode = bracket (openFile name mode) hClose\n--\nbracket\n        :: IO a         -- ^ computation to run first (\\\"acquire resource\\\")\n        -> (a -> IO b)  -- ^ computation to run last (\\\"release resource\\\")\n        -> (a -> IO c)  -- ^ computation to run in-between\n        -> IO c         -- returns the value from the in-between computation\nbracket before after thing =\n  mask $ \\restore -> do\n    a <- before\n    r <- restore (thing a) `onException` after a\n    _ <- after a\n    return r\n\n-- | A specialised variant of 'bracket' with just a computation to run\n-- afterward.\n--\nfinally :: IO a         -- ^ computation to run first\n        -> IO b         -- ^ computation to run afterward (even if an exception\n                        -- was raised)\n        -> IO a         -- returns the value from the first computation\na `finally` sequel =\n  mask $ \\restore -> do\n    r <- restore a `onException` sequel\n    _ <- sequel\n    return r\n\n-- | A variant of 'bracket' where the return value from the first computation\n-- is not required.\nbracket_ :: IO a -> IO b -> IO c -> IO c\nbracket_ before after thing = bracket before (const after) (const thing)\n\n-- | Like 'bracket', but only performs the final action if there was an\n-- exception raised by the in-between computation.\nbracketOnError\n        :: IO a         -- ^ computation to run first (\\\"acquire resource\\\")\n        -> (a -> IO b)  -- ^ computation to run last (\\\"release resource\\\")\n        -> (a -> IO c)  -- ^ computation to run in-between\n        -> IO c         -- returns the value from the in-between computation\nbracketOnError before after thing =\n  mask $ \\restore -> do\n    a <- before\n    restore (thing a) `onException` after a\n\n-----\n\n-- |A pattern match failed. The @String@ gives information about the\n-- source location of the pattern.\nnewtype PatternMatchFail = PatternMatchFail String\n\n-- | @since 4.0\ninstance Show PatternMatchFail where\n    showsPrec _ (PatternMatchFail err) = showString err\n\n-- | @since 4.0\ninstance Exception PatternMatchFail\n\n-----\n\n-- |A record selector was applied to a constructor without the\n-- appropriate field. This can only happen with a datatype with\n-- multiple constructors, where some fields are in one constructor\n-- but not another. The @String@ gives information about the source\n-- location of the record selector.\nnewtype RecSelError = RecSelError String\n\n-- | @since 4.0\ninstance Show RecSelError where\n    showsPrec _ (RecSelError err) = showString err\n\n-- | @since 4.0\ninstance Exception RecSelError\n\n-----\n\n-- |An uninitialised record field was used. The @String@ gives\n-- information about the source location where the record was\n-- constructed.\nnewtype RecConError = RecConError String\n\n-- | @since 4.0\ninstance Show RecConError where\n    showsPrec _ (RecConError err) = showString err\n\n-- | @since 4.0\ninstance Exception RecConError\n\n-----\n\n-- |A record update was performed on a constructor without the\n-- appropriate field. This can only happen with a datatype with\n-- multiple constructors, where some fields are in one constructor\n-- but not another. The @String@ gives information about the source\n-- location of the record update.\nnewtype RecUpdError = RecUpdError String\n\n-- | @since 4.0\ninstance Show RecUpdError where\n    showsPrec _ (RecUpdError err) = showString err\n\n-- | @since 4.0\ninstance Exception RecUpdError\n\n-----\n\n-- |A class method without a definition (neither a default definition,\n-- nor a definition in the appropriate instance) was called. The\n-- @String@ gives information about which method it was.\nnewtype NoMethodError = NoMethodError String\n\n-- | @since 4.0\ninstance Show NoMethodError where\n    showsPrec _ (NoMethodError err) = showString err\n\n-- | @since 4.0\ninstance Exception NoMethodError\n\n-----\n\n-- |An expression that didn't typecheck during compile time was called.\n-- This is only possible with -fdefer-type-errors. The @String@ gives\n-- details about the failed type check.\n--\n-- @since 4.9.0.0\nnewtype TypeError = TypeError String\n\n-- | @since 4.9.0.0\ninstance Show TypeError where\n    showsPrec _ (TypeError err) = showString err\n\n-- | @since 4.9.0.0\ninstance Exception TypeError\n\n-----\n\n-- |Thrown when the runtime system detects that the computation is\n-- guaranteed not to terminate. Note that there is no guarantee that\n-- the runtime system will notice whether any given computation is\n-- guaranteed to terminate or not.\ndata NonTermination = NonTermination\n\n-- | @since 4.0\ninstance Show NonTermination where\n    showsPrec _ NonTermination = showString \"<<loop>>\"\n\n-- | @since 4.0\ninstance Exception NonTermination\n\n-----\n\n-- |Thrown when the program attempts to call @atomically@, from the @stm@\n-- package, inside another call to @atomically@.\ndata NestedAtomically = NestedAtomically\n\n-- | @since 4.0\ninstance Show NestedAtomically where\n    showsPrec _ NestedAtomically = showString \"Control.Concurrent.STM.atomically was nested\"\n\n-- | @since 4.0\ninstance Exception NestedAtomically\n\n-----\n\nrecSelError, recConError, runtimeError,\n  nonExhaustiveGuardsError, patError, noMethodBindingError,\n  absentError, typeError\n        :: Addr# -> a   -- All take a UTF8-encoded C string\n\nrecSelError              s = throw (RecSelError (\"No match in record selector \"\n                                                 ++ unpackCStringUtf8# s))  -- No location info unfortunately\nruntimeError             s = errorWithoutStackTrace (unpackCStringUtf8# s)                   -- No location info unfortunately\nabsentError              s = errorWithoutStackTrace (\"Oops!  Entered absent arg \" ++ unpackCStringUtf8# s)\n\nnonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s \"Non-exhaustive guards in\"))\nrecConError              s = throw (RecConError      (untangle s \"Missing field in record construction\"))\nnoMethodBindingError     s = throw (NoMethodError    (untangle s \"No instance nor default method for class operation\"))\npatError                 s = throw (PatternMatchFail (untangle s \"Non-exhaustive patterns in\"))\ntypeError                s = throw (TypeError        (unpackCStringUtf8# s))\n\n-- GHC's RTS calls this\nnonTermination :: SomeException\nnonTermination = toException NonTermination\n\n-- GHC's RTS calls this\nnestedAtomically :: SomeException\nnestedAtomically = toException NestedAtomically\n\n-- Introduced by unarise for unused unboxed sum fields\nabsentSumFieldError :: a\nabsentSumFieldError = absentError \" in unboxed sum.\"#\n", "num_lines": 405}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-- |\n-- Module      :  Control.Monad.Fail\n-- Copyright   :  (C) 2015 David Luposchainsky,\n--                (C) 2015 Herbert Valerio Riedel\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Transitional module providing the 'MonadFail' class and primitive\n-- instances.\n--\n-- This module can be imported for defining forward compatible\n-- 'MonadFail' instances:\n--\n-- @\n-- import qualified Control.Monad.Fail as Fail\n--\n-- instance Monad Foo where\n--   (>>=) = {- ...bind impl... -}\n--\n--   -- Provide legacy 'fail' implementation for when\n--   -- new-style MonadFail desugaring is not enabled.\n--   fail = Fail.fail\n--\n-- instance Fail.MonadFail Foo where\n--   fail = {- ...fail implementation... -}\n-- @\n--\n-- See <https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail>\n-- for more details.\n--\n-- @since 4.9.0.0\n--\nmodule Control.Monad.Fail ( MonadFail(fail) ) where\n\nimport GHC.Base (String, Monad(), Maybe(Nothing), IO())\nimport {-# SOURCE #-} GHC.IO (failIO)\n\n-- | When a value is bound in @do@-notation, the pattern on the left\n-- hand side of @<-@ might not match. In this case, this class\n-- provides a function to recover.\n--\n-- A 'Monad' without a 'MonadFail' instance may only be used in conjunction\n-- with pattern that always match, such as newtypes, tuples, data types with\n-- only a single data constructor, and irrefutable patterns (@~pat@).\n--\n-- Instances of 'MonadFail' should satisfy the following law: @fail s@ should\n-- be a left zero for 'Control.Monad.>>=',\n--\n-- @\n-- fail s >>= f  =  fail s\n-- @\n--\n-- If your 'Monad' is also 'Control.Monad.MonadPlus', a popular definition is\n--\n-- @\n-- fail _ = mzero\n-- @\n--\n-- @since 4.9.0.0\nclass Monad m => MonadFail m where\n    fail :: String -> m a\n\n\n-- | @since 4.9.0.0\ninstance MonadFail Maybe where\n    fail _ = Nothing\n\n-- | @since 4.9.0.0\ninstance MonadFail [] where\n    {-# INLINE fail #-}\n    fail _ = []\n\n-- | @since 4.9.0.0\ninstance MonadFail IO where\n    fail = failIO\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE TypeOperators #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.Fix\n-- Copyright   :  (c) Andy Gill 2001,\n--                (c) Oregon Graduate Institute of Science and Technology, 2002\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Monadic fixpoints.\n--\n-- For a detailed discussion, see Levent Erkok's thesis,\n-- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.Fix (\n        MonadFix(mfix),\n        fix\n  ) where\n\nimport Data.Either\nimport Data.Function ( fix )\nimport Data.Maybe\nimport Data.Monoid ( Dual(..), Sum(..), Product(..)\n                   , First(..), Last(..), Alt(..), Ap(..) )\nimport Data.Ord ( Down(..) )\nimport GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) )\nimport GHC.Generics\nimport GHC.List ( head, tail )\nimport Control.Monad.ST.Imp\nimport System.IO\n\n-- | Monads having fixed points with a \\'knot-tying\\' semantics.\n-- Instances of 'MonadFix' should satisfy the following laws:\n--\n-- [Purity]\n--      @'mfix' ('Control.Monad.return' . h)  =  'Control.Monad.return' ('fix' h)@\n--\n-- [Left shrinking (or Tightening)]\n--      @'mfix' (\\\\x -> a >>= \\\\y -> f x y)  =  a >>= \\\\y -> 'mfix' (\\\\x -> f x y)@\n--\n-- [Sliding]\n--      @'mfix' ('Control.Monad.liftM' h . f)  =  'Control.Monad.liftM' h ('mfix' (f . h))@,\n--      for strict @h@.\n--\n-- [Nesting]\n--      @'mfix' (\\\\x -> 'mfix' (\\\\y -> f x y))  =  'mfix' (\\\\x -> f x x)@\n--\n-- This class is used in the translation of the recursive @do@ notation\n-- supported by GHC and Hugs.\nclass (Monad m) => MonadFix m where\n        -- | The fixed point of a monadic computation.\n        -- @'mfix' f@ executes the action @f@ only once, with the eventual\n        -- output fed back as the input.  Hence @f@ should not be strict,\n        -- for then @'mfix' f@ would diverge.\n        mfix :: (a -> m a) -> m a\n\n-- Instances of MonadFix for Prelude monads\n\n-- | @since 2.01\ninstance MonadFix Maybe where\n    mfix f = let a = f (unJust a) in a\n             where unJust (Just x) = x\n                   unJust Nothing  = errorWithoutStackTrace \"mfix Maybe: Nothing\"\n\n-- | @since 2.01\ninstance MonadFix [] where\n    mfix f = case fix (f . head) of\n               []    -> []\n               (x:_) -> x : mfix (tail . f)\n\n-- | @since 4.9.0.0\ninstance MonadFix NonEmpty where\n  mfix f = case fix (f . neHead) of\n             ~(x :| _) -> x :| mfix (neTail . f)\n    where\n      neHead ~(a :| _) = a\n      neTail ~(_ :| as) = as\n\n-- | @since 2.01\ninstance MonadFix IO where\n    mfix = fixIO\n\n-- | @since 2.01\ninstance MonadFix ((->) r) where\n    mfix f = \\ r -> let a = f a r in a\n\n-- | @since 4.3.0.0\ninstance MonadFix (Either e) where\n    mfix f = let a = f (unRight a) in a\n             where unRight (Right x) = x\n                   unRight (Left  _) = errorWithoutStackTrace \"mfix Either: Left\"\n\n-- | @since 2.01\ninstance MonadFix (ST s) where\n        mfix = fixST\n\n-- Instances of Data.Monoid wrappers\n\n-- | @since 4.8.0.0\ninstance MonadFix Dual where\n    mfix f   = Dual (fix (getDual . f))\n\n-- | @since 4.8.0.0\ninstance MonadFix Sum where\n    mfix f   = Sum (fix (getSum . f))\n\n-- | @since 4.8.0.0\ninstance MonadFix Product where\n    mfix f   = Product (fix (getProduct . f))\n\n-- | @since 4.8.0.0\ninstance MonadFix First where\n    mfix f   = First (mfix (getFirst . f))\n\n-- | @since 4.8.0.0\ninstance MonadFix Last where\n    mfix f   = Last (mfix (getLast . f))\n\n-- | @since 4.8.0.0\ninstance MonadFix f => MonadFix (Alt f) where\n    mfix f   = Alt (mfix (getAlt . f))\n\n-- | @since 4.12.0.0\ninstance MonadFix f => MonadFix (Ap f) where\n    mfix f   = Ap (mfix (getAp . f))\n\n-- Instances for GHC.Generics\n-- | @since 4.9.0.0\ninstance MonadFix Par1 where\n    mfix f = Par1 (fix (unPar1 . f))\n\n-- | @since 4.9.0.0\ninstance MonadFix f => MonadFix (Rec1 f) where\n    mfix f = Rec1 (mfix (unRec1 . f))\n\n-- | @since 4.9.0.0\ninstance MonadFix f => MonadFix (M1 i c f) where\n    mfix f = M1 (mfix (unM1. f))\n\n-- | @since 4.9.0.0\ninstance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where\n    mfix f = (mfix (fstP . f)) :*: (mfix (sndP . f))\n      where\n        fstP (a :*: _) = a\n        sndP (_ :*: b) = b\n\n-- Instances for Data.Ord\n\n-- | @since 4.12.0.0\ninstance MonadFix Down where\n    mfix f = Down (fix (getDown . f))\n      where getDown (Down x) = x\n", "num_lines": 160}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.Instances\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- /This module is DEPRECATED and will be removed in the future!/\n--\n-- 'Functor' and 'Monad' instances for @(->) r@ and\n-- 'Functor' instances for @(,) a@ and @'Either' a@.\n\nmodule Control.Monad.Instances {-# DEPRECATED \"This module now contains no instances and will be removed in the future\" #-} -- deprecated in 7.8\n    (Functor(..),Monad(..)) where\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This library provides support for /strict/ state threads, as\n-- described in the PLDI \\'94 paper by John Launchbury and Simon Peyton\n-- Jones /Lazy Functional State Threads/.\n--\n-- References (variables) that can be used within the @ST@ monad are\n-- provided by \"Data.STRef\", and arrays are provided by\n-- [Data.Array.ST](https://hackage.haskell.org/package/array/docs/Data-Array-ST.html).\n\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST (\n        -- * The 'ST' Monad\n        ST,             -- abstract, instance of Functor, Monad, Typeable.\n        runST,\n        fixST,\n\n        -- * Converting 'ST' to 'IO'\n        RealWorld,              -- abstract\n        stToIO,\n    ) where\n\nimport Control.Monad.ST.Imp\n\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE TypeOperators #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.Zip\n-- Copyright   :  (c) Nils Schweinsberg 2011,\n--                (c) George Giorgidze 2011\n--                (c) University Tuebingen 2011\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Monadic zipping (used for monad comprehensions)\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.Zip where\n\nimport Control.Monad (liftM, liftM2)\nimport Data.Functor.Identity\nimport Data.Monoid\nimport Data.Ord ( Down(..) )\nimport Data.Proxy\nimport qualified Data.List.NonEmpty as NE\nimport GHC.Generics\n\n-- | Instances should satisfy the laws:\n--\n-- [Naturality]\n--\n--     @'liftM' (f 'Control.Arrow.***' g) ('mzip' ma mb)\n--         = 'mzip' ('liftM' f ma) ('liftM' g mb)@\n--\n-- [Information Preservation]\n--\n--     @'liftM' ('Prelude.const' ()) ma = 'liftM' ('Prelude.const' ()) mb@\n--         implies\n--     @'munzip' ('mzip' ma mb) = (ma, mb)@\n--\nclass Monad m => MonadZip m where\n    {-# MINIMAL mzip | mzipWith #-}\n\n    mzip :: m a -> m b -> m (a,b)\n    mzip = mzipWith (,)\n\n    mzipWith :: (a -> b -> c) -> m a -> m b -> m c\n    mzipWith f ma mb = liftM (uncurry f) (mzip ma mb)\n\n    munzip :: m (a,b) -> (m a, m b)\n    munzip mab = (liftM fst mab, liftM snd mab)\n    -- munzip is a member of the class because sometimes\n    -- you can implement it more efficiently than the\n    -- above default code.  See Trac #4370 comment by giorgidze\n\n-- | @since 4.3.1.0\ninstance MonadZip [] where\n    mzip     = zip\n    mzipWith = zipWith\n    munzip   = unzip\n\n-- | @since 4.9.0.0\ninstance MonadZip NE.NonEmpty where\n  mzip     = NE.zip\n  mzipWith = NE.zipWith\n  munzip   = NE.unzip\n\n-- | @since 4.8.0.0\ninstance MonadZip Identity where\n    mzipWith                 = liftM2\n    munzip (Identity (a, b)) = (Identity a, Identity b)\n\n-- | @since 4.8.0.0\ninstance MonadZip Dual where\n    -- Cannot use coerce, it's unsafe\n    mzipWith = liftM2\n\n-- | @since 4.8.0.0\ninstance MonadZip Sum where\n    mzipWith = liftM2\n\n-- | @since 4.8.0.0\ninstance MonadZip Product where\n    mzipWith = liftM2\n\n-- | @since 4.8.0.0\ninstance MonadZip Maybe where\n    mzipWith = liftM2\n\n-- | @since 4.8.0.0\ninstance MonadZip First where\n    mzipWith = liftM2\n\n-- | @since 4.8.0.0\ninstance MonadZip Last where\n    mzipWith = liftM2\n\n-- | @since 4.8.0.0\ninstance MonadZip f => MonadZip (Alt f) where\n    mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)\n\n-- | @since 4.9.0.0\ninstance MonadZip Proxy where\n    mzipWith _ _ _ = Proxy\n\n-- Instances for GHC.Generics\n-- | @since 4.9.0.0\ninstance MonadZip U1 where\n    mzipWith _ _ _ = U1\n\n-- | @since 4.9.0.0\ninstance MonadZip Par1 where\n    mzipWith = liftM2\n\n-- | @since 4.9.0.0\ninstance MonadZip f => MonadZip (Rec1 f) where\n    mzipWith f (Rec1 fa) (Rec1 fb) = Rec1 (mzipWith f fa fb)\n\n-- | @since 4.9.0.0\ninstance MonadZip f => MonadZip (M1 i c f) where\n    mzipWith f (M1 fa) (M1 fb) = M1 (mzipWith f fa fb)\n\n-- | @since 4.9.0.0\ninstance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where\n    mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2\n\n-- instances for Data.Ord\n\n-- | @since 4.12.0.0\ninstance MonadZip Down where\n    mzipWith = liftM2\n", "num_lines": 133}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.IO.Class\n-- Copyright   :  (c) Andy Gill 2001,\n--                (c) Oregon Graduate Institute of Science and Technology, 2001\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  R.Paterson@city.ac.uk\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Class of monads based on @IO@.\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.IO.Class (\n    MonadIO(..)\n  ) where\n\n-- | Monads in which 'IO' computations may be embedded.\n-- Any monad built by applying a sequence of monad transformers to the\n-- 'IO' monad will be an instance of this class.\n--\n-- Instances should satisfy the following laws, which state that 'liftIO'\n-- is a transformer of monads:\n--\n-- * @'liftIO' . 'return' = 'return'@\n--\n-- * @'liftIO' (m >>= f) = 'liftIO' m >>= ('liftIO' . f)@\n\nclass (Monad m) => MonadIO m where\n    -- | Lift a computation from the 'IO' monad.\n    liftIO :: IO a -> m a\n\n-- | @since 4.9.0.0\ninstance MonadIO IO where\n    liftIO = id\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE Unsafe #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Imp\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This library provides support for /strict/ state threads, as\n-- described in the PLDI \\'94 paper by John Launchbury and Simon Peyton\n-- Jones /Lazy Functional State Threads/.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Imp (\n        -- * The 'ST' Monad\n        ST,             -- abstract, instance of Functor, Monad, Typeable.\n        runST,\n        fixST,\n\n        -- * Converting 'ST' to 'Prelude.IO'\n        RealWorld,              -- abstract\n        stToIO,\n\n        -- * Unsafe operations\n        unsafeInterleaveST,\n        unsafeDupableInterleaveST,\n        unsafeIOToST,\n        unsafeSTToIO\n    ) where\n\nimport GHC.ST           ( ST, runST, unsafeInterleaveST\n                        , unsafeDupableInterleaveST )\nimport GHC.Base         ( RealWorld, ($), return )\nimport GHC.IO           ( stToIO, unsafeIOToST, unsafeSTToIO\n                        , unsafeDupableInterleaveIO )\nimport GHC.MVar         ( readMVar, putMVar, newEmptyMVar )\nimport Control.Exception.Base\n                        ( catch, throwIO, NonTermination (..)\n                        , BlockedIndefinitelyOnMVar (..) )\n\n-- | Allow the result of an 'ST' computation to be used (lazily)\n-- inside the computation.\n--\n-- Note that if @f@ is strict, @'fixST' f = _|_@.\nfixST :: (a -> ST s a) -> ST s a\n-- See Note [fixST]\nfixST k = unsafeIOToST $ do\n    m <- newEmptyMVar\n    ans <- unsafeDupableInterleaveIO\n             (readMVar m `catch` \\BlockedIndefinitelyOnMVar ->\n                                    throwIO NonTermination)\n    result <- unsafeSTToIO (k ans)\n    putMVar m result\n    return result\n\n{- Note [fixST]\n   ~~~~~~~~~~~~\n\nFor many years, we implemented fixST much like a pure fixpoint,\nusing liftST:\n\n  fixST :: (a -> ST s a) -> ST s a\n  fixST k = ST $ \\ s ->\n      let ans       = liftST (k r) s\n          STret _ r = ans\n      in\n      case ans of STret s' x -> (# s', x #)\n\nWe knew that lazy blackholing could cause the computation to be re-run if the\nresult was demanded strictly, but we thought that would be okay in the case of\nST. However, that is not the case (see Trac #15349). Notably, the first time\nthe computation is executed, it may mutate variables that cause it to behave\n*differently* the second time it's run. That may allow it to terminate when it\nshould not. More frighteningly, Arseniy Alekseyev produced a somewhat contrived\nexample ( https://mail.haskell.org/pipermail/libraries/2018-July/028889.html )\ndemonstrating that it can break reasonable assumptions in \"trustworthy\" code,\ncausing a memory safety violation. So now we implement fixST much like we do\nfixIO. See also the implementation notes for fixIO. Simon Marlow wondered\nwhether we could get away with an IORef instead of an MVar. I believe we\ncannot. The function passed to fixST may spark a parallel computation that\ndemands the final result. Such a computation should block until the final\nresult is available.\n-}\n", "num_lines": 91}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Lazy\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This module presents an identical interface to \"Control.Monad.ST\",\n-- except that the monad delays evaluation of state operations until\n-- a value depending on them is required.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Lazy (\n        -- * The 'ST' monad\n        ST,\n        runST,\n        fixST,\n\n        -- * Converting between strict and lazy 'ST'\n        strictToLazyST, lazyToStrictST,\n\n        -- * Converting 'ST' To 'IO'\n        RealWorld,\n        stToIO,\n    ) where\n\nimport Control.Monad.ST.Lazy.Imp\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Safe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This library provides support for /strict/ state threads, as\n-- described in the PLDI \\'94 paper by John Launchbury and Simon Peyton\n-- Jones /Lazy Functional State Threads/.\n--\n-- Safe API Only.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Safe {-# DEPRECATED \"Safe is now the default, please use Control.Monad.ST instead\" #-} (\n        -- * The 'ST' Monad\n        ST,             -- abstract\n        runST,\n        fixST,\n\n        -- * Converting 'ST' to 'IO'\n        RealWorld,              -- abstract\n        stToIO,\n    ) where\n\nimport Control.Monad.ST.Imp\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Strict\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- The strict ST monad (re-export of \"Control.Monad.ST\")\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Strict (\n        module Control.Monad.ST\n  ) where\n\nimport Control.Monad.ST\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Unsafe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This library provides support for /strict/ state threads, as\n-- described in the PLDI \\'94 paper by John Launchbury and Simon Peyton\n-- Jones /Lazy Functional State Threads/.\n--\n-- Unsafe API.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Unsafe (\n        -- * Unsafe operations\n        unsafeInterleaveST,\n        unsafeDupableInterleaveST,\n        unsafeIOToST,\n        unsafeSTToIO\n    ) where\n\nimport Control.Monad.ST.Imp\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash, UnboxedTuples, RankNTypes #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Lazy.Imp\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This module presents an identical interface to \"Control.Monad.ST\",\n-- except that the monad delays evaluation of 'ST' operations until\n-- a value depending on them is required.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Lazy.Imp (\n        -- * The 'ST' monad\n        ST,\n        runST,\n        fixST,\n\n        -- * Converting between strict and lazy 'ST'\n        strictToLazyST, lazyToStrictST,\n\n        -- * Converting 'ST' To 'IO'\n        RealWorld,\n        stToIO,\n\n        -- * Unsafe operations\n        unsafeInterleaveST,\n        unsafeIOToST\n    ) where\n\nimport Control.Monad.Fix\n\nimport qualified Control.Monad.ST as ST\nimport qualified Control.Monad.ST.Unsafe as ST\n\nimport qualified GHC.ST as GHC.ST\nimport GHC.Base\nimport qualified Control.Monad.Fail as Fail\n\n-- | The lazy @'ST' monad.\n-- The ST monad allows for destructive updates, but is escapable (unlike IO).\n-- A computation of type @'ST' s a@ returns a value of type @a@, and\n-- execute in \"thread\" @s@. The @s@ parameter is either\n--\n-- * an uninstantiated type variable (inside invocations of 'runST'), or\n--\n-- * 'RealWorld' (inside invocations of 'stToIO').\n--\n-- It serves to keep the internal states of different invocations of\n-- 'runST' separate from each other and from invocations of 'stToIO'.\n--\n-- The '>>=' and '>>' operations are not strict in the state.  For example,\n--\n-- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@\nnewtype ST s a = ST { unST :: State s -> (a, State s) }\n\n-- A lifted state token. This can be imagined as a moment in the timeline\n-- of a lazy state thread. Forcing the token forces all delayed actions in\n-- the thread up until that moment to be performed.\ndata State s = S# (State# s)\n\n{- Note [Lazy ST and multithreading]\n\nWe used to imagine that passing a polymorphic state token was all that we\nneeded to keep state threads separate (see Launchbury and Peyton Jones, 1994:\nhttps://www.microsoft.com/en-us/research/publication/lazy-functional-state-threads/).\nBut this breaks down in the face of concurrency (see #11760). Whereas a strict\nST computation runs to completion before producing anything, a value produced\nby running a lazy ST computation may contain a thunk that, when forced, will\nlead to further stateful computations. If such a thunk is entered by more than\none thread, then they may both read from and write to the same references and\narrays, interfering with each other. To work around this, any time we lazily\nsuspend execution of a lazy ST computation, we bind the result pair to a\nNOINLINE binding (ensuring that it is not duplicated) and calculate that\npair using (unsafePerformIO . evaluate), ensuring that only one thread will\nenter the thunk. We still use lifted state tokens to actually drive execution,\nso in these cases we effectively deal with *two* state tokens: the lifted\none we get from the previous computation, and the unlifted one we pull out of\nthin air. -}\n\n{- Note [Lazy ST: not producing lazy pairs]\n\nThe fixST and strictToLazyST functions used to construct functions that\nproduced lazy pairs. Why don't we need that laziness? The ST type is kept\nabstract, so no one outside this module can ever get their hands on a (result,\nState s) pair. We ourselves never match on such pairs when performing ST\ncomputations unless we also force one of their components. So no one should be\nable to detect the change. By refraining from producing such thunks (which\nreference delayed ST computations), we avoid having to ask whether we have to\nwrap them up with unsafePerformIO. See Note [Lazy ST and multithreading]. -}\n\n-- | This is a terrible hack to prevent a thunk from being entered twice.\n-- Simon Peyton Jones would very much like to be rid of it.\nnoDup :: a -> a\nnoDup a = runRW# (\\s ->\n  case noDuplicate# s of\n    _ -> a)\n\n-- | @since 2.01\ninstance Functor (ST s) where\n    fmap f m = ST $ \\ s ->\n      let\n        -- See Note [Lazy ST and multithreading]\n        {-# NOINLINE res #-}\n        res = noDup (unST m s)\n        (r,new_s) = res\n      in\n        (f r,new_s)\n\n    x <$ m = ST $ \\ s ->\n      let\n        {-# NOINLINE s' #-}\n        -- See Note [Lazy ST and multithreading]\n        s' = noDup (snd (unST m s))\n      in (x, s')\n\n-- | @since 2.01\ninstance Applicative (ST s) where\n    pure a = ST $ \\ s -> (a,s)\n\n    fm <*> xm = ST $ \\ s ->\n       let\n         {-# NOINLINE res1 #-}\n         !res1 = unST fm s\n         !(f, s') = res1\n\n         {-# NOINLINE res2 #-}\n         -- See Note [Lazy ST and multithreading]\n         res2 = noDup (unST xm s')\n         (x, s'') = res2\n       in (f x, s'')\n    -- Why can we use a strict binding for res1? If someone\n    -- forces the (f x, s'') pair, then they must need\n    -- f or s''. To get s'', they need s'.\n\n    liftA2 f m n = ST $ \\ s ->\n      let\n        {-# NOINLINE res1 #-}\n        -- See Note [Lazy ST and multithreading]\n        res1 = noDup (unST m s)\n        (x, s') = res1\n\n        {-# NOINLINE res2 #-}\n        res2 = noDup (unST n s')\n        (y, s'') = res2\n      in (f x y, s'')\n    -- We don't get to be strict in liftA2, but we clear out a\n    -- NOINLINE in comparison to the default definition, which may\n    -- help the simplifier.\n\n    m *> n = ST $ \\s ->\n       let\n         {-# NOINLINE s' #-}\n         -- See Note [Lazy ST and multithreading]\n         s' = noDup (snd (unST m s))\n       in unST n s'\n\n    m <* n = ST $ \\s ->\n       let\n         {-# NOINLINE res1 #-}\n         !res1 = unST m s\n         !(mr, s') = res1\n\n         {-# NOINLINE s'' #-}\n         -- See Note [Lazy ST and multithreading]\n         s'' = noDup (snd (unST n s'))\n       in (mr, s'')\n    -- Why can we use a strict binding for res1? The same reason as\n    -- in <*>. If someone demands the (mr, s'') pair, then they will\n    -- force mr or s''. To get s'', they need s'.\n\n-- | @since 2.01\ninstance Monad (ST s) where\n\n    fail s   = errorWithoutStackTrace s\n\n    (>>) = (*>)\n\n    m >>= k = ST $ \\ s ->\n       let\n         -- See Note [Lazy ST and multithreading]\n         {-# NOINLINE res #-}\n         res = noDup (unST m s)\n         (r,new_s) = res\n       in\n         unST (k r) new_s\n\n-- | @since 4.10\ninstance Fail.MonadFail (ST s) where\n    fail s = errorWithoutStackTrace s\n\n-- | Return the value computed by an 'ST' computation.\n-- The @forall@ ensures that the internal state used by the 'ST'\n-- computation is inaccessible to the rest of the program.\nrunST :: (forall s. ST s a) -> a\nrunST (ST st) = runRW# (\\s -> case st (S# s) of (r, _) -> r)\n\n-- | Allow the result of an 'ST' computation to be used (lazily)\n-- inside the computation.\n-- Note that if @f@ is strict, @'fixST' f = _|_@.\nfixST :: (a -> ST s a) -> ST s a\nfixST m = ST (\\ s -> \n                let \n                   q@(r,_s') = unST (m r) s\n                in q)\n-- Why don't we need unsafePerformIO in fixST? We create a thunk, q,\n-- to perform a lazy state computation, and we pass a reference to that\n-- thunk, r, to m. Uh oh? No, I think it should be fine, because that thunk\n-- itself is demanded directly in the `let` body. See also\n-- Note [Lazy ST: not producing lazy pairs].\n\n-- | @since 2.01\ninstance MonadFix (ST s) where\n        mfix = fixST\n\n-- ---------------------------------------------------------------------------\n-- Strict <--> Lazy\n\n{-|\nConvert a strict 'ST' computation into a lazy one.  The strict state\nthread passed to 'strictToLazyST' is not performed until the result of\nthe lazy state thread it returns is demanded.\n-}\nstrictToLazyST :: ST.ST s a -> ST s a\nstrictToLazyST (GHC.ST.ST m) = ST $ \\(S# s) ->\n  case m s of\n    (# s', a #) -> (a, S# s')\n-- See Note [Lazy ST: not producing lazy pairs]\n\n{-| \nConvert a lazy 'ST' computation into a strict one.\n-}\nlazyToStrictST :: ST s a -> ST.ST s a\nlazyToStrictST (ST m) = GHC.ST.ST $ \\s ->\n        case (m (S# s)) of (a, S# s') -> (# s', a #)\n\n-- | A monad transformer embedding lazy 'ST' in the 'IO'\n-- monad.  The 'RealWorld' parameter indicates that the internal state\n-- used by the 'ST' computation is a special one supplied by the 'IO'\n-- monad, and thus distinct from those used by invocations of 'runST'.\nstToIO :: ST RealWorld a -> IO a\nstToIO = ST.stToIO . lazyToStrictST\n\n-- ---------------------------------------------------------------------------\n-- Strict <--> Lazy\n\nunsafeInterleaveST :: ST s a -> ST s a\nunsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST\n\nunsafeIOToST :: IO a -> ST s a\nunsafeIOToST = strictToLazyST . ST.unsafeIOToST\n\n", "num_lines": 262}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Lazy.Safe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This module presents an identical interface to \"Control.Monad.ST\",\n-- except that the monad delays evaluation of 'ST' operations until\n-- a value depending on them is required.\n--\n-- Safe API only.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Lazy.Safe {-# DEPRECATED \"Safe is now the default, please use Control.Monad.ST.Lazy instead\" #-} (\n        -- * The 'ST' monad\n        ST,\n        runST,\n        fixST,\n\n        -- * Converting between strict and lazy 'ST'\n        strictToLazyST, lazyToStrictST,\n\n        -- * Converting 'ST' To 'IO'\n        RealWorld,\n        stToIO,\n    ) where\n\nimport Control.Monad.ST.Lazy.Imp\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Control.Monad.ST.Lazy.Unsafe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (requires universal quantification for runST)\n--\n-- This module presents an identical interface to \"Control.Monad.ST\",\n-- except that the monad delays evaluation of 'ST' operations until\n-- a value depending on them is required.\n--\n-- Unsafe API.\n--\n-----------------------------------------------------------------------------\n\nmodule Control.Monad.ST.Lazy.Unsafe (\n        -- * Unsafe operations\n        unsafeInterleaveST,\n        unsafeIOToST\n    ) where\n\nimport Control.Monad.ST.Lazy.Imp\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Bifoldable\n-- Copyright   :  (C) 2011-2016 Edward Kmett\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- @since 4.10.0.0\n----------------------------------------------------------------------------\nmodule Data.Bifoldable\n  ( Bifoldable(..)\n  , bifoldr'\n  , bifoldr1\n  , bifoldrM\n  , bifoldl'\n  , bifoldl1\n  , bifoldlM\n  , bitraverse_\n  , bifor_\n  , bimapM_\n  , biforM_\n  , bimsum\n  , bisequenceA_\n  , bisequence_\n  , biasum\n  , biList\n  , binull\n  , bilength\n  , bielem\n  , bimaximum\n  , biminimum\n  , bisum\n  , biproduct\n  , biconcat\n  , biconcatMap\n  , biand\n  , bior\n  , biany\n  , biall\n  , bimaximumBy\n  , biminimumBy\n  , binotElem\n  , bifind\n  ) where\n\nimport Control.Applicative\nimport Data.Functor.Utils (Max(..), Min(..), (#.))\nimport Data.Maybe (fromMaybe)\nimport Data.Monoid\nimport GHC.Generics (K1(..))\n\n-- | 'Bifoldable' identifies foldable structures with two different varieties\n-- of elements (as opposed to 'Foldable', which has one variety of element).\n-- Common examples are 'Either' and '(,)':\n--\n-- > instance Bifoldable Either where\n-- >   bifoldMap f _ (Left  a) = f a\n-- >   bifoldMap _ g (Right b) = g b\n-- >\n-- > instance Bifoldable (,) where\n-- >   bifoldr f g z (a, b) = f a (g b z)\n--\n-- A minimal 'Bifoldable' definition consists of either 'bifoldMap' or\n-- 'bifoldr'. When defining more than this minimal set, one should ensure\n-- that the following identities hold:\n--\n-- @\n-- 'bifold' \u00e2\u2030\u00a1 'bifoldMap' 'id' 'id'\n-- 'bifoldMap' f g \u00e2\u2030\u00a1 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'\n-- 'bifoldr' f g z t \u00e2\u2030\u00a1 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z\n-- @\n--\n-- If the type is also a 'Data.Bifunctor.Bifunctor' instance, it should satisfy:\n--\n-- @\n-- 'bifoldMap' f g \u00e2\u2030\u00a1 'bifold' . 'Data.Bifunctor.bimap' f g\n-- @\n--\n-- which implies that\n--\n-- @\n-- 'bifoldMap' f g . 'Data.Bifunctor.bimap' h i \u00e2\u2030\u00a1 'bifoldMap' (f . h) (g . i)\n-- @\n--\n-- @since 4.10.0.0\nclass Bifoldable p where\n  {-# MINIMAL bifoldr | bifoldMap #-}\n\n  -- | Combines the elements of a structure using a monoid.\n  --\n  -- @'bifold' \u00e2\u2030\u00a1 'bifoldMap' 'id' 'id'@\n  --\n  -- @since 4.10.0.0\n  bifold :: Monoid m => p m m -> m\n  bifold = bifoldMap id id\n\n  -- | Combines the elements of a structure, given ways of mapping them to a\n  -- common monoid.\n  --\n  -- @'bifoldMap' f g\n  --     \u00e2\u2030\u00a1 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@\n  --\n  -- @since 4.10.0.0\n  bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m\n  bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty\n\n  -- | Combines the elements of a structure in a right associative manner.\n  -- Given a hypothetical function @toEitherList :: p a b -> [Either a b]@\n  -- yielding a list of all elements of a structure in order, the following\n  -- would hold:\n  --\n  -- @'bifoldr' f g z \u00e2\u2030\u00a1 'foldr' ('either' f g) z . toEitherList@\n  --\n  -- @since 4.10.0.0\n  bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c\n  bifoldr f g z t = appEndo (bifoldMap (Endo #. f) (Endo #. g) t) z\n\n  -- | Combines the elements of a structure in a left associative manner. Given\n  -- a hypothetical function @toEitherList :: p a b -> [Either a b]@ yielding a\n  -- list of all elements of a structure in order, the following would hold:\n  --\n  -- @'bifoldl' f g z\n  --     \u00e2\u2030\u00a1 'foldl' (\\acc -> 'either' (f acc) (g acc)) z . toEitherList@\n  --\n  -- Note that if you want an efficient left-fold, you probably want to use\n  -- 'bifoldl'' instead of 'bifoldl'. The reason is that the latter does not\n  -- force the \"inner\" results, resulting in a thunk chain which then must be\n  -- evaluated from the outside-in.\n  --\n  -- @since 4.10.0.0\n  bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c\n  bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f)\n                                                (Dual . Endo . flip g) t)) z\n\n-- | @since 4.10.0.0\ninstance Bifoldable (,) where\n  bifoldMap f g ~(a, b) = f a `mappend` g b\n\n-- | @since 4.10.0.0\ninstance Bifoldable Const where\n  bifoldMap f _ (Const a) = f a\n\n-- | @since 4.10.0.0\ninstance Bifoldable (K1 i) where\n  bifoldMap f _ (K1 c) = f c\n\n-- | @since 4.10.0.0\ninstance Bifoldable ((,,) x) where\n  bifoldMap f g ~(_,a,b) = f a `mappend` g b\n\n-- | @since 4.10.0.0\ninstance Bifoldable ((,,,) x y) where\n  bifoldMap f g ~(_,_,a,b) = f a `mappend` g b\n\n-- | @since 4.10.0.0\ninstance Bifoldable ((,,,,) x y z) where\n  bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b\n\n-- | @since 4.10.0.0\ninstance Bifoldable ((,,,,,) x y z w) where\n  bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b\n\n-- | @since 4.10.0.0\ninstance Bifoldable ((,,,,,,) x y z w v) where\n  bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b\n\n-- | @since 4.10.0.0\ninstance Bifoldable Either where\n  bifoldMap f _ (Left a) = f a\n  bifoldMap _ g (Right b) = g b\n\n-- | As 'bifoldr', but strict in the result of the reduction functions at each\n-- step.\n--\n-- @since 4.10.0.0\nbifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c\nbifoldr' f g z0 xs = bifoldl f' g' id xs z0 where\n  f' k x z = k $! f x z\n  g' k x z = k $! g x z\n\n-- | A variant of 'bifoldr' that has no base case,\n-- and thus may only be applied to non-empty structures.\n--\n-- @since 4.10.0.0\nbifoldr1 :: Bifoldable t => (a -> a -> a) -> t a a -> a\nbifoldr1 f xs = fromMaybe (error \"bifoldr1: empty structure\")\n                  (bifoldr mbf mbf Nothing xs)\n  where\n    mbf x m = Just (case m of\n                      Nothing -> x\n                      Just y  -> f x y)\n\n-- | Right associative monadic bifold over a structure.\n--\n-- @since 4.10.0.0\nbifoldrM :: (Bifoldable t, Monad m)\n         => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c\nbifoldrM f g z0 xs = bifoldl f' g' return xs z0 where\n  f' k x z = f x z >>= k\n  g' k x z = g x z >>= k\n\n-- | As 'bifoldl', but strict in the result of the reduction functions at each\n-- step.\n--\n-- This ensures that each step of the bifold is forced to weak head normal form\n-- before being applied, avoiding the collection of thunks that would otherwise\n-- occur. This is often what you want to strictly reduce a finite structure to\n-- a single, monolithic result (e.g., 'bilength').\n--\n-- @since 4.10.0.0\nbifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a\nbifoldl' f g z0 xs = bifoldr f' g' id xs z0 where\n  f' x k z = k $! f z x\n  g' x k z = k $! g z x\n\n-- | A variant of 'bifoldl' that has no base case,\n-- and thus may only be applied to non-empty structures.\n--\n-- @since 4.10.0.0\nbifoldl1 :: Bifoldable t => (a -> a -> a) -> t a a -> a\nbifoldl1 f xs = fromMaybe (error \"bifoldl1: empty structure\")\n                  (bifoldl mbf mbf Nothing xs)\n  where\n    mbf m y = Just (case m of\n                      Nothing -> y\n                      Just x  -> f x y)\n\n-- | Left associative monadic bifold over a structure.\n--\n-- @since 4.10.0.0\nbifoldlM :: (Bifoldable t, Monad m)\n         => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a\nbifoldlM f g z0 xs = bifoldr f' g' return xs z0 where\n  f' x k z = f z x >>= k\n  g' x k z = g z x >>= k\n\n-- | Map each element of a structure using one of two actions, evaluate these\n-- actions from left to right, and ignore the results. For a version that\n-- doesn't ignore the results, see 'Data.Bitraversable.bitraverse'.\n--\n-- @since 4.10.0.0\nbitraverse_ :: (Bifoldable t, Applicative f)\n            => (a -> f c) -> (b -> f d) -> t a b -> f ()\nbitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())\n\n-- | As 'bitraverse_', but with the structure as the primary argument. For a\n-- version that doesn't ignore the results, see 'Data.Bitraversable.bifor'.\n--\n-- >>> > bifor_ ('a', \"bc\") print (print . reverse)\n-- 'a'\n-- \"cb\"\n--\n-- @since 4.10.0.0\nbifor_ :: (Bifoldable t, Applicative f)\n       => t a b -> (a -> f c) -> (b -> f d) -> f ()\nbifor_ t f g = bitraverse_ f g t\n\n-- | Alias for 'bitraverse_'.\n--\n-- @since 4.10.0.0\nbimapM_ :: (Bifoldable t, Applicative f)\n        => (a -> f c) -> (b -> f d) -> t a b -> f ()\nbimapM_ = bitraverse_\n\n-- | Alias for 'bifor_'.\n--\n-- @since 4.10.0.0\nbiforM_ :: (Bifoldable t, Applicative f)\n        => t a b ->  (a -> f c) -> (b -> f d) -> f ()\nbiforM_ = bifor_\n\n-- | Alias for 'bisequence_'.\n--\n-- @since 4.10.0.0\nbisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()\nbisequenceA_ = bisequence_\n\n-- | Evaluate each action in the structure from left to right, and ignore the\n-- results. For a version that doesn't ignore the results, see\n-- 'Data.Bitraversable.bisequence'.\n--\n-- @since 4.10.0.0\nbisequence_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()\nbisequence_ = bifoldr (*>) (*>) (pure ())\n\n-- | The sum of a collection of actions, generalizing 'biconcat'.\n--\n-- @since 4.10.0.0\nbiasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a\nbiasum = bifoldr (<|>) (<|>) empty\n\n-- | Alias for 'biasum'.\n--\n-- @since 4.10.0.0\nbimsum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a\nbimsum = biasum\n\n-- | Collects the list of elements of a structure, from left to right.\n--\n-- @since 4.10.0.0\nbiList :: Bifoldable t => t a a -> [a]\nbiList = bifoldr (:) (:) []\n\n-- | Test whether the structure is empty.\n--\n-- @since 4.10.0.0\nbinull :: Bifoldable t => t a b -> Bool\nbinull = bifoldr (\\_ _ -> False) (\\_ _ -> False) True\n\n-- | Returns the size/length of a finite structure as an 'Int'.\n--\n-- @since 4.10.0.0\nbilength :: Bifoldable t => t a b -> Int\nbilength = bifoldl' (\\c _ -> c+1) (\\c _ -> c+1) 0\n\n-- | Does the element occur in the structure?\n--\n-- @since 4.10.0.0\nbielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool\nbielem x = biany (== x) (== x)\n\n-- | Reduces a structure of lists to the concatenation of those lists.\n--\n-- @since 4.10.0.0\nbiconcat :: Bifoldable t => t [a] [a] -> [a]\nbiconcat = bifold\n\n-- | The largest element of a non-empty structure.\n--\n-- @since 4.10.0.0\nbimaximum :: forall t a. (Bifoldable t, Ord a) => t a a -> a\nbimaximum = fromMaybe (error \"bimaximum: empty structure\") .\n    getMax . bifoldMap mj mj\n  where mj = Max #. (Just :: a -> Maybe a)\n\n-- | The least element of a non-empty structure.\n--\n-- @since 4.10.0.0\nbiminimum :: forall t a. (Bifoldable t, Ord a) => t a a -> a\nbiminimum = fromMaybe (error \"biminimum: empty structure\") .\n    getMin . bifoldMap mj mj\n  where mj = Min #. (Just :: a -> Maybe a)\n\n-- | The 'bisum' function computes the sum of the numbers of a structure.\n--\n-- @since 4.10.0.0\nbisum :: (Bifoldable t, Num a) => t a a -> a\nbisum = getSum #. bifoldMap Sum Sum\n\n-- | The 'biproduct' function computes the product of the numbers of a\n-- structure.\n--\n-- @since 4.10.0.0\nbiproduct :: (Bifoldable t, Num a) => t a a -> a\nbiproduct = getProduct #. bifoldMap Product Product\n\n-- | Given a means of mapping the elements of a structure to lists, computes the\n-- concatenation of all such lists in order.\n--\n-- @since 4.10.0.0\nbiconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]\nbiconcatMap = bifoldMap\n\n-- | 'biand' returns the conjunction of a container of Bools.  For the\n-- result to be 'True', the container must be finite; 'False', however,\n-- results from a 'False' value finitely far from the left end.\n--\n-- @since 4.10.0.0\nbiand :: Bifoldable t => t Bool Bool -> Bool\nbiand = getAll #. bifoldMap All All\n\n-- | 'bior' returns the disjunction of a container of Bools.  For the\n-- result to be 'False', the container must be finite; 'True', however,\n-- results from a 'True' value finitely far from the left end.\n--\n-- @since 4.10.0.0\nbior :: Bifoldable t => t Bool Bool -> Bool\nbior = getAny #. bifoldMap Any Any\n\n-- | Determines whether any element of the structure satisfies its appropriate\n-- predicate argument.\n--\n-- @since 4.10.0.0\nbiany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool\nbiany p q = getAny #. bifoldMap (Any . p) (Any . q)\n\n-- | Determines whether all elements of the structure satisfy their appropriate\n-- predicate argument.\n--\n-- @since 4.10.0.0\nbiall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool\nbiall p q = getAll #. bifoldMap (All . p) (All . q)\n\n-- | The largest element of a non-empty structure with respect to the\n-- given comparison function.\n--\n-- @since 4.10.0.0\nbimaximumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a\nbimaximumBy cmp = bifoldr1 max'\n  where max' x y = case cmp x y of\n                        GT -> x\n                        _  -> y\n\n-- | The least element of a non-empty structure with respect to the\n-- given comparison function.\n--\n-- @since 4.10.0.0\nbiminimumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a\nbiminimumBy cmp = bifoldr1 min'\n  where min' x y = case cmp x y of\n                        GT -> y\n                        _  -> x\n\n-- | 'binotElem' is the negation of 'bielem'.\n--\n-- @since 4.10.0.0\nbinotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool\nbinotElem x =  not . bielem x\n\n-- | The 'bifind' function takes a predicate and a structure and returns\n-- the leftmost element of the structure matching the predicate, or\n-- 'Nothing' if there is no such element.\n--\n-- @since 4.10.0.0\nbifind :: Bifoldable t => (a -> Bool) -> t a a -> Maybe a\nbifind p = getFirst . bifoldMap finder finder\n  where finder x = First (if p x then Just x else Nothing)\n", "num_lines": 434}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Bifunctor\n-- Copyright   :  (C) 2008-2014 Edward Kmett,\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- @since 4.8.0.0\n----------------------------------------------------------------------------\nmodule Data.Bifunctor\n  ( Bifunctor(..)\n  ) where\n\nimport Control.Applicative  ( Const(..) )\nimport GHC.Generics ( K1(..) )\n\n-- | A bifunctor is a type constructor that takes\n-- two type arguments and is a functor in /both/ arguments. That\n-- is, unlike with 'Functor', a type constructor such as 'Either'\n-- does not need to be partially applied for a 'Bifunctor'\n-- instance, and the methods in this class permit mapping\n-- functions over the 'Left' value or the 'Right' value,\n-- or both at the same time.\n--\n-- Formally, the class 'Bifunctor' represents a bifunctor\n-- from @Hask@ -> @Hask@.\n--\n-- Intuitively it is a bifunctor where both the first and second\n-- arguments are covariant.\n--\n-- You can define a 'Bifunctor' by either defining 'bimap' or by\n-- defining both 'first' and 'second'.\n--\n-- If you supply 'bimap', you should ensure that:\n--\n-- @'bimap' 'id' 'id' \u00e2\u2030\u00a1 'id'@\n--\n-- If you supply 'first' and 'second', ensure:\n--\n-- @\n-- 'first' 'id' \u00e2\u2030\u00a1 'id'\n-- 'second' 'id' \u00e2\u2030\u00a1 'id'\n-- @\n--\n-- If you supply both, you should also ensure:\n--\n-- @'bimap' f g \u00e2\u2030\u00a1 'first' f '.' 'second' g@\n--\n-- These ensure by parametricity:\n--\n-- @\n-- 'bimap'  (f '.' g) (h '.' i) \u00e2\u2030\u00a1 'bimap' f h '.' 'bimap' g i\n-- 'first'  (f '.' g) \u00e2\u2030\u00a1 'first'  f '.' 'first'  g\n-- 'second' (f '.' g) \u00e2\u2030\u00a1 'second' f '.' 'second' g\n-- @\n--\n-- @since 4.8.0.0\nclass Bifunctor p where\n    {-# MINIMAL bimap | first, second #-}\n\n    -- | Map over both arguments at the same time.\n    --\n    -- @'bimap' f g \u00e2\u2030\u00a1 'first' f '.' 'second' g@\n    --\n    -- ==== __Examples__\n    -- >>> bimap toUpper (+1) ('j', 3)\n    -- ('J',4)\n    --\n    -- >>> bimap toUpper (+1) (Left 'j')\n    -- Left 'J'\n    --\n    -- >>> bimap toUpper (+1) (Right 3)\n    -- Right 4\n    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d\n    bimap f g = first f . second g\n\n\n    -- | Map covariantly over the first argument.\n    --\n    -- @'first' f \u00e2\u2030\u00a1 'bimap' f 'id'@\n    --\n    -- ==== __Examples__\n    -- >>> first toUpper ('j', 3)\n    -- ('J',3)\n    --\n    -- >>> first toUpper (Left 'j')\n    -- Left 'J'\n    first :: (a -> b) -> p a c -> p b c\n    first f = bimap f id\n\n\n    -- | Map covariantly over the second argument.\n    --\n    -- @'second' \u00e2\u2030\u00a1 'bimap' 'id'@\n    --\n    -- ==== __Examples__\n    -- >>> second (+1) ('j', 3)\n    -- ('j',4)\n    --\n    -- >>> second (+1) (Right 3)\n    -- Right 4\n    second :: (b -> c) -> p a b -> p a c\n    second = bimap id\n\n\n\n-- | @since 4.8.0.0\ninstance Bifunctor (,) where\n    bimap f g ~(a, b) = (f a, g b)\n\n-- | @since 4.8.0.0\ninstance Bifunctor ((,,) x1) where\n    bimap f g ~(x1, a, b) = (x1, f a, g b)\n\n-- | @since 4.8.0.0\ninstance Bifunctor ((,,,) x1 x2) where\n    bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b)\n\n-- | @since 4.8.0.0\ninstance Bifunctor ((,,,,) x1 x2 x3) where\n    bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b)\n\n-- | @since 4.8.0.0\ninstance Bifunctor ((,,,,,) x1 x2 x3 x4) where\n    bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b)\n\n-- | @since 4.8.0.0\ninstance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where\n    bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)\n\n\n-- | @since 4.8.0.0\ninstance Bifunctor Either where\n    bimap f _ (Left a) = Left (f a)\n    bimap _ g (Right b) = Right (g b)\n\n-- | @since 4.8.0.0\ninstance Bifunctor Const where\n    bimap f _ (Const a) = Const (f a)\n\n-- | @since 4.9.0.0\ninstance Bifunctor (K1 i) where\n    bimap f _ (K1 c) = K1 (f c)\n", "num_lines": 150}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Bitraversable\n-- Copyright   :  (C) 2011-2016 Edward Kmett\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- @since 4.10.0.0\n----------------------------------------------------------------------------\nmodule Data.Bitraversable\n  ( Bitraversable(..)\n  , bisequenceA\n  , bisequence\n  , bimapM\n  , bifor\n  , biforM\n  , bimapAccumL\n  , bimapAccumR\n  , bimapDefault\n  , bifoldMapDefault\n  ) where\n\nimport Control.Applicative\nimport Data.Bifunctor\nimport Data.Bifoldable\nimport Data.Coerce\nimport Data.Functor.Identity (Identity(..))\nimport Data.Functor.Utils (StateL(..), StateR(..))\nimport GHC.Generics (K1(..))\n\n-- | 'Bitraversable' identifies bifunctorial data structures whose elements can\n-- be traversed in order, performing 'Applicative' or 'Monad' actions at each\n-- element, and collecting a result structure with the same shape.\n--\n-- As opposed to 'Traversable' data structures, which have one variety of\n-- element on which an action can be performed, 'Bitraversable' data structures\n-- have two such varieties of elements.\n--\n-- A definition of 'bitraverse' must satisfy the following laws:\n--\n-- [Naturality]\n--   @'bitraverse' (t . f) (t . g) \u00e2\u2030\u00a1 t . 'bitraverse' f g@\n--   for every applicative transformation @t@\n--\n-- [Identity]\n--   @'bitraverse' 'Identity' 'Identity' \u00e2\u2030\u00a1 'Identity'@\n--\n-- [Composition]\n--   @'Data.Functor.Compose.Compose' .\n--    'fmap' ('bitraverse' g1 g2) .\n--    'bitraverse' f1 f2\n--     \u00e2\u2030\u00a1 'bitraverse' ('Data.Functor.Compose.Compose' . 'fmap' g1 . f1)\n--                  ('Data.Functor.Compose.Compose' . 'fmap' g2 . f2)@\n--\n-- where an /applicative transformation/ is a function\n--\n-- @t :: ('Applicative' f, 'Applicative' g) => f a -> g a@\n--\n-- preserving the 'Applicative' operations:\n--\n-- @\n-- t ('pure' x) = 'pure' x\n-- t (f '<*>' x) = t f '<*>' t x\n-- @\n--\n-- and the identity functor 'Identity' and composition functors\n-- 'Data.Functor.Compose.Compose' are from \"Data.Functor.Identity\" and\n-- \"Data.Functor.Compose\".\n--\n-- Some simple examples are 'Either' and '(,)':\n--\n-- > instance Bitraversable Either where\n-- >   bitraverse f _ (Left x) = Left <$> f x\n-- >   bitraverse _ g (Right y) = Right <$> g y\n-- >\n-- > instance Bitraversable (,) where\n-- >   bitraverse f g (x, y) = (,) <$> f x <*> g y\n--\n-- 'Bitraversable' relates to its superclasses in the following ways:\n--\n-- @\n-- 'bimap' f g \u00e2\u2030\u00a1 'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)\n-- 'bifoldMap' f g = 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)\n-- @\n--\n-- These are available as 'bimapDefault' and 'bifoldMapDefault' respectively.\n--\n-- @since 4.10.0.0\nclass (Bifunctor t, Bifoldable t) => Bitraversable t where\n  -- | Evaluates the relevant functions at each element in the structure,\n  -- running the action, and builds a new structure with the same shape, using\n  -- the results produced from sequencing the actions.\n  --\n  -- @'bitraverse' f g \u00e2\u2030\u00a1 'bisequenceA' . 'bimap' f g@\n  --\n  -- For a version that ignores the results, see 'bitraverse_'.\n  --\n  -- @since 4.10.0.0\n  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)\n  bitraverse f g = bisequenceA . bimap f g\n\n-- | Alias for 'bisequence'.\n--\n-- @since 4.10.0.0\nbisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)\nbisequenceA = bisequence\n\n-- | Alias for 'bitraverse'.\n--\n-- @since 4.10.0.0\nbimapM :: (Bitraversable t, Applicative f)\n       => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)\nbimapM = bitraverse\n\n-- | Sequences all the actions in a structure, building a new structure with\n-- the same shape using the results of the actions. For a version that ignores\n-- the results, see 'bisequence_'.\n--\n-- @'bisequence' \u00e2\u2030\u00a1 'bitraverse' 'id' 'id'@\n--\n-- @since 4.10.0.0\nbisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)\nbisequence = bitraverse id id\n\n-- | @since 4.10.0.0\ninstance Bitraversable (,) where\n  bitraverse f g ~(a, b) = liftA2 (,) (f a) (g b)\n\n-- | @since 4.10.0.0\ninstance Bitraversable ((,,) x) where\n  bitraverse f g ~(x, a, b) = liftA2 ((,,) x) (f a) (g b)\n\n-- | @since 4.10.0.0\ninstance Bitraversable ((,,,) x y) where\n  bitraverse f g ~(x, y, a, b) = liftA2 ((,,,) x y) (f a) (g b)\n\n-- | @since 4.10.0.0\ninstance Bitraversable ((,,,,) x y z) where\n  bitraverse f g ~(x, y, z, a, b) = liftA2 ((,,,,) x y z) (f a) (g b)\n\n-- | @since 4.10.0.0\ninstance Bitraversable ((,,,,,) x y z w) where\n  bitraverse f g ~(x, y, z, w, a, b) = liftA2 ((,,,,,) x y z w) (f a) (g b)\n\n-- | @since 4.10.0.0\ninstance Bitraversable ((,,,,,,) x y z w v) where\n  bitraverse f g ~(x, y, z, w, v, a, b) =\n    liftA2 ((,,,,,,) x y z w v) (f a) (g b)\n\n-- | @since 4.10.0.0\ninstance Bitraversable Either where\n  bitraverse f _ (Left a) = Left <$> f a\n  bitraverse _ g (Right b) = Right <$> g b\n\n-- | @since 4.10.0.0\ninstance Bitraversable Const where\n  bitraverse f _ (Const a) = Const <$> f a\n\n-- | @since 4.10.0.0\ninstance Bitraversable (K1 i) where\n  bitraverse f _ (K1 c) = K1 <$> f c\n\n-- | 'bifor' is 'bitraverse' with the structure as the first argument. For a\n-- version that ignores the results, see 'bifor_'.\n--\n-- @since 4.10.0.0\nbifor :: (Bitraversable t, Applicative f)\n      => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)\nbifor t f g = bitraverse f g t\n\n-- | Alias for 'bifor'.\n--\n-- @since 4.10.0.0\nbiforM :: (Bitraversable t, Applicative f)\n       => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)\nbiforM = bifor\n\n-- | The 'bimapAccumL' function behaves like a combination of 'bimap' and\n-- 'bifoldl'; it traverses a structure from left to right, threading a state\n-- of type @a@ and using the given actions to compute new elements for the\n-- structure.\n--\n-- @since 4.10.0.0\nbimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))\n            -> a -> t b d -> (a, t c e)\nbimapAccumL f g s t\n  = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s\n\n-- | The 'bimapAccumR' function behaves like a combination of 'bimap' and\n-- 'bifoldl'; it traverses a structure from right to left, threading a state\n-- of type @a@ and using the given actions to compute new elements for the\n-- structure.\n--\n-- @since 4.10.0.0\nbimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))\n            -> a -> t b d -> (a, t c e)\nbimapAccumR f g s t\n  = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s\n\n-- | A default definition of 'bimap' in terms of the 'Bitraversable'\n-- operations.\n--\n-- @'bimapDefault' f g \u00e2\u2030\u00a1\n--     'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)@\n--\n-- @since 4.10.0.0\nbimapDefault :: forall t a b c d . Bitraversable t\n             => (a -> b) -> (c -> d) -> t a c -> t b d\n-- See Note [Function coercion] in Data.Functor.Utils.\nbimapDefault = coerce\n  (bitraverse :: (a -> Identity b)\n              -> (c -> Identity d) -> t a c -> Identity (t b d))\n{-# INLINE bimapDefault #-}\n\n-- | A default definition of 'bifoldMap' in terms of the 'Bitraversable'\n-- operations.\n--\n-- @'bifoldMapDefault' f g \u00e2\u2030\u00a1\n--    'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)@\n--\n-- @since 4.10.0.0\nbifoldMapDefault :: forall t m a b . (Bitraversable t, Monoid m)\n                 => (a -> m) -> (b -> m) -> t a b -> m\n-- See Note [Function coercion] in Data.Functor.Utils.\nbifoldMapDefault = coerce\n  (bitraverse :: (a -> Const m ())\n              -> (b -> Const m ()) -> t a b -> Const m (t () ()))\n{-# INLINE bifoldMapDefault #-}\n", "num_lines": 235}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Bits\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- This module defines bitwise operations for signed and unsigned\n-- integers.  Instances of the class 'Bits' for the 'Int' and\n-- 'Integer' types are available from this module, and instances for\n-- explicitly sized integral types are available from the\n-- \"Data.Int\" and \"Data.Word\" modules.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Bits (\n  Bits(\n    (.&.), (.|.), xor,\n    complement,\n    shift,\n    rotate,\n    zeroBits,\n    bit,\n    setBit,\n    clearBit,\n    complementBit,\n    testBit,\n    bitSizeMaybe,\n    bitSize,\n    isSigned,\n    shiftL, shiftR,\n    unsafeShiftL, unsafeShiftR,\n    rotateL, rotateR,\n    popCount\n  ),\n  FiniteBits(\n    finiteBitSize,\n    countLeadingZeros,\n    countTrailingZeros\n  ),\n\n  bitDefault,\n  testBitDefault,\n  popCountDefault,\n  toIntegralSized\n ) where\n\n-- Defines the @Bits@ class containing bit-based operations.\n-- See library document for details on the semantics of the\n-- individual operations.\n\n#include \"MachDeps.h\"\n\nimport Data.Maybe\nimport GHC.Enum\nimport GHC.Num\nimport GHC.Base\nimport GHC.Real\n\ninfixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`\ninfixl 7 .&.\ninfixl 6 `xor`\ninfixl 5 .|.\n\n{-# DEPRECATED bitSize \"Use 'bitSizeMaybe' or 'finiteBitSize' instead\" #-} -- deprecated in 7.8\n\n-- | The 'Bits' class defines bitwise operations over integral types.\n--\n-- * Bits are numbered from 0 with bit 0 being the least\n--   significant bit.\nclass Eq a => Bits a where\n    {-# MINIMAL (.&.), (.|.), xor, complement,\n                (shift | (shiftL, shiftR)),\n                (rotate | (rotateL, rotateR)),\n                bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-}\n\n    -- | Bitwise \\\"and\\\"\n    (.&.) :: a -> a -> a\n\n    -- | Bitwise \\\"or\\\"\n    (.|.) :: a -> a -> a\n\n    -- | Bitwise \\\"xor\\\"\n    xor :: a -> a -> a\n\n    {-| Reverse all the bits in the argument -}\n    complement        :: a -> a\n\n    {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,\n        or right by @-i@ bits otherwise.\n        Right shifts perform sign extension on signed number types;\n        i.e. they fill the top bits with 1 if the @x@ is negative\n        and with 0 otherwise.\n\n        An instance can define either this unified 'shift' or 'shiftL' and\n        'shiftR', depending on which is more convenient for the type in\n        question. -}\n    shift             :: a -> Int -> a\n\n    x `shift`   i | i<0       = x `shiftR` (-i)\n                  | i>0       = x `shiftL` i\n                  | otherwise = x\n\n    {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,\n        or right by @-i@ bits otherwise.\n\n        For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.\n\n        An instance can define either this unified 'rotate' or 'rotateL' and\n        'rotateR', depending on which is more convenient for the type in\n        question. -}\n    rotate            :: a -> Int -> a\n\n    x `rotate`  i | i<0       = x `rotateR` (-i)\n                  | i>0       = x `rotateL` i\n                  | otherwise = x\n\n    {-\n    -- Rotation can be implemented in terms of two shifts, but care is\n    -- needed for negative values.  This suggested implementation assumes\n    -- 2's-complement arithmetic.  It is commented out because it would\n    -- require an extra context (Ord a) on the signature of 'rotate'.\n    x `rotate`  i | i<0 && isSigned x && x<0\n                         = let left = i+bitSize x in\n                           ((x `shift` i) .&. complement ((-1) `shift` left))\n                           .|. (x `shift` left)\n                  | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))\n                  | i==0 = x\n                  | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))\n    -}\n\n    -- | 'zeroBits' is the value with all bits unset.\n    --\n    -- The following laws ought to hold (for all valid bit indices @/n/@):\n    --\n    --   * @'clearBit' 'zeroBits' /n/ == 'zeroBits'@\n    --   * @'setBit'   'zeroBits' /n/ == 'bit' /n/@\n    --   * @'testBit'  'zeroBits' /n/ == False@\n    --   * @'popCount' 'zeroBits'   == 0@\n    --\n    -- This method uses @'clearBit' ('bit' 0) 0@ as its default\n    -- implementation (which ought to be equivalent to 'zeroBits' for\n    -- types which possess a 0th bit).\n    --\n    -- @since 4.7.0.0\n    zeroBits :: a\n    zeroBits = clearBit (bit 0) 0\n\n    -- | @bit /i/@ is a value with the @/i/@th bit set and all other bits clear.\n    --\n    -- Can be implemented using `bitDefault' if @a@ is also an\n    -- instance of 'Num'.\n    --\n    -- See also 'zeroBits'.\n    bit               :: Int -> a\n\n    -- | @x \\`setBit\\` i@ is the same as @x .|. bit i@\n    setBit            :: a -> Int -> a\n\n    -- | @x \\`clearBit\\` i@ is the same as @x .&. complement (bit i)@\n    clearBit          :: a -> Int -> a\n\n    -- | @x \\`complementBit\\` i@ is the same as @x \\`xor\\` bit i@\n    complementBit     :: a -> Int -> a\n\n    -- | Return 'True' if the @n@th bit of the argument is 1\n    --\n    -- Can be implemented using `testBitDefault' if @a@ is also an\n    -- instance of 'Num'.\n    testBit           :: a -> Int -> Bool\n\n    {-| Return the number of bits in the type of the argument.  The actual\n        value of the argument is ignored.  Returns Nothing\n        for types that do not have a fixed bitsize, like 'Integer'.\n\n        @since 4.7.0.0\n        -}\n    bitSizeMaybe      :: a -> Maybe Int\n\n    {-| Return the number of bits in the type of the argument.  The actual\n        value of the argument is ignored.  The function 'bitSize' is\n        undefined for types that do not have a fixed bitsize, like 'Integer'.\n\n        Default implementation based upon 'bitSizeMaybe' provided since\n        4.12.0.0.\n        -}\n    bitSize           :: a -> Int\n    bitSize b = fromMaybe (error \"bitSize is undefined\") (bitSizeMaybe b)\n\n    {-| Return 'True' if the argument is a signed type.  The actual\n        value of the argument is ignored -}\n    isSigned          :: a -> Bool\n\n    {-# INLINE setBit #-}\n    {-# INLINE clearBit #-}\n    {-# INLINE complementBit #-}\n    x `setBit` i        = x .|. bit i\n    x `clearBit` i      = x .&. complement (bit i)\n    x `complementBit` i = x `xor` bit i\n\n    {-| Shift the argument left by the specified number of bits\n        (which must be non-negative). Some instances may throw an\n        'Control.Exception.Overflow' exception if given a negative input.\n\n        An instance can define either this and 'shiftR' or the unified\n        'shift', depending on which is more convenient for the type in\n        question. -}\n    shiftL            :: a -> Int -> a\n    {-# INLINE shiftL #-}\n    x `shiftL`  i = x `shift`  i\n\n    {-| Shift the argument left by the specified number of bits.  The\n        result is undefined for negative shift amounts and shift amounts\n        greater or equal to the 'bitSize'.\n\n        Defaults to 'shiftL' unless defined explicitly by an instance.\n\n        @since 4.5.0.0 -}\n    unsafeShiftL            :: a -> Int -> a\n    {-# INLINE unsafeShiftL #-}\n    x `unsafeShiftL` i = x `shiftL` i\n\n    {-| Shift the first argument right by the specified number of bits. The\n        result is undefined for negative shift amounts and shift amounts\n        greater or equal to the 'bitSize'. Some instances may throw an\n        'Control.Exception.Overflow' exception if given a negative input.\n\n        Right shifts perform sign extension on signed number types;\n        i.e. they fill the top bits with 1 if the @x@ is negative\n        and with 0 otherwise.\n\n        An instance can define either this and 'shiftL' or the unified\n        'shift', depending on which is more convenient for the type in\n        question. -}\n    shiftR            :: a -> Int -> a\n    {-# INLINE shiftR #-}\n    x `shiftR`  i = x `shift`  (-i)\n\n    {-| Shift the first argument right by the specified number of bits, which\n        must be non-negative and smaller than the number of bits in the type.\n\n        Right shifts perform sign extension on signed number types;\n        i.e. they fill the top bits with 1 if the @x@ is negative\n        and with 0 otherwise.\n\n        Defaults to 'shiftR' unless defined explicitly by an instance.\n\n        @since 4.5.0.0 -}\n    unsafeShiftR            :: a -> Int -> a\n    {-# INLINE unsafeShiftR #-}\n    x `unsafeShiftR` i = x `shiftR` i\n\n    {-| Rotate the argument left by the specified number of bits\n        (which must be non-negative).\n\n        An instance can define either this and 'rotateR' or the unified\n        'rotate', depending on which is more convenient for the type in\n        question. -}\n    rotateL           :: a -> Int -> a\n    {-# INLINE rotateL #-}\n    x `rotateL` i = x `rotate` i\n\n    {-| Rotate the argument right by the specified number of bits\n        (which must be non-negative).\n\n        An instance can define either this and 'rotateL' or the unified\n        'rotate', depending on which is more convenient for the type in\n        question. -}\n    rotateR           :: a -> Int -> a\n    {-# INLINE rotateR #-}\n    x `rotateR` i = x `rotate` (-i)\n\n    {-| Return the number of set bits in the argument.  This number is\n        known as the population count or the Hamming weight.\n\n        Can be implemented using `popCountDefault' if @a@ is also an\n        instance of 'Num'.\n\n        @since 4.5.0.0 -}\n    popCount          :: a -> Int\n\n-- |The 'FiniteBits' class denotes types with a finite, fixed number of bits.\n--\n-- @since 4.7.0.0\nclass Bits b => FiniteBits b where\n    -- | Return the number of bits in the type of the argument.\n    -- The actual value of the argument is ignored. Moreover, 'finiteBitSize'\n    -- is total, in contrast to the deprecated 'bitSize' function it replaces.\n    --\n    -- @\n    -- 'finiteBitSize' = 'bitSize'\n    -- 'bitSizeMaybe' = 'Just' . 'finiteBitSize'\n    -- @\n    --\n    -- @since 4.7.0.0\n    finiteBitSize :: b -> Int\n\n    -- | Count number of zero bits preceding the most significant set bit.\n    --\n    -- @\n    -- 'countLeadingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)\n    -- @\n    --\n    -- 'countLeadingZeros' can be used to compute log base 2 via\n    --\n    -- @\n    -- logBase2 x = 'finiteBitSize' x - 1 - 'countLeadingZeros' x\n    -- @\n    --\n    -- Note: The default implementation for this method is intentionally\n    -- naive. However, the instances provided for the primitive\n    -- integral types are implemented using CPU specific machine\n    -- instructions.\n    --\n    -- @since 4.8.0.0\n    countLeadingZeros :: b -> Int\n    countLeadingZeros x = (w-1) - go (w-1)\n      where\n        go i | i < 0       = i -- no bit set\n             | testBit x i = i\n             | otherwise   = go (i-1)\n\n        w = finiteBitSize x\n\n    -- | Count number of zero bits following the least significant set bit.\n    --\n    -- @\n    -- 'countTrailingZeros' ('zeroBits' :: a) = finiteBitSize ('zeroBits' :: a)\n    -- 'countTrailingZeros' . 'negate' = 'countTrailingZeros'\n    -- @\n    --\n    -- The related\n    -- <http://en.wikipedia.org/wiki/Find_first_set find-first-set operation>\n    -- can be expressed in terms of 'countTrailingZeros' as follows\n    --\n    -- @\n    -- findFirstSet x = 1 + 'countTrailingZeros' x\n    -- @\n    --\n    -- Note: The default implementation for this method is intentionally\n    -- naive. However, the instances provided for the primitive\n    -- integral types are implemented using CPU specific machine\n    -- instructions.\n    --\n    -- @since 4.8.0.0\n    countTrailingZeros :: b -> Int\n    countTrailingZeros x = go 0\n      where\n        go i | i >= w      = i\n             | testBit x i = i\n             | otherwise   = go (i+1)\n\n        w = finiteBitSize x\n\n\n-- The defaults below are written with lambdas so that e.g.\n--     bit = bitDefault\n-- is fully applied, so inlining will happen\n\n-- | Default implementation for 'bit'.\n--\n-- Note that: @bitDefault i = 1 `shiftL` i@\n--\n-- @since 4.6.0.0\nbitDefault :: (Bits a, Num a) => Int -> a\nbitDefault = \\i -> 1 `shiftL` i\n{-# INLINE bitDefault #-}\n\n-- | Default implementation for 'testBit'.\n--\n-- Note that: @testBitDefault x i = (x .&. bit i) /= 0@\n--\n-- @since 4.6.0.0\ntestBitDefault ::  (Bits a, Num a) => a -> Int -> Bool\ntestBitDefault = \\x i -> (x .&. bit i) /= 0\n{-# INLINE testBitDefault #-}\n\n-- | Default implementation for 'popCount'.\n--\n-- This implementation is intentionally naive. Instances are expected to provide\n-- an optimized implementation for their size.\n--\n-- @since 4.6.0.0\npopCountDefault :: (Bits a, Num a) => a -> Int\npopCountDefault = go 0\n where\n   go !c 0 = c\n   go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant\n{-# INLINABLE popCountDefault #-}\n\n\n-- | Interpret 'Bool' as 1-bit bit-field\n--\n--  @since 4.7.0.0\ninstance Bits Bool where\n    (.&.) = (&&)\n\n    (.|.) = (||)\n\n    xor = (/=)\n\n    complement = not\n\n    shift x 0 = x\n    shift _ _ = False\n\n    rotate x _ = x\n\n    bit 0 = True\n    bit _ = False\n\n    testBit x 0 = x\n    testBit _ _ = False\n\n    bitSizeMaybe _ = Just 1\n\n    bitSize _ = 1\n\n    isSigned _ = False\n\n    popCount False = 0\n    popCount True  = 1\n\n-- | @since 4.7.0.0\ninstance FiniteBits Bool where\n    finiteBitSize _ = 1\n    countTrailingZeros x = if x then 0 else 1\n    countLeadingZeros  x = if x then 0 else 1\n\n-- | @since 2.01\ninstance Bits Int where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    -- We want popCnt# to be inlined in user code so that `ghc -msse4.2`\n    -- can compile it down to a popcnt instruction without an extra function call\n    {-# INLINE popCount #-}\n\n    zeroBits = 0\n\n    bit     = bitDefault\n\n    testBit = testBitDefault\n\n    (I# x#) .&.   (I# y#)          = I# (x# `andI#` y#)\n    (I# x#) .|.   (I# y#)          = I# (x# `orI#`  y#)\n    (I# x#) `xor` (I# y#)          = I# (x# `xorI#` y#)\n    complement (I# x#)             = I# (notI# x#)\n    (I# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)      = I# (x# `iShiftL#` i#)\n        | otherwise                = I# (x# `iShiftRA#` negateInt# i#)\n    (I# x#) `shiftL` (I# i#)\n        | isTrue# (i# >=# 0#)      = I# (x# `iShiftL#` i#)\n        | otherwise                = overflowError\n    (I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)\n    (I# x#) `shiftR` (I# i#)\n        | isTrue# (i# >=# 0#)      = I# (x# `iShiftRA#` i#)\n        | otherwise                = overflowError\n    (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)\n\n    {-# INLINE rotate #-}       -- See Note [Constant folding for rotate]\n    (I# x#) `rotate` (I# i#) =\n        I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#)))\n      where\n        !i'# = i# `andI#` (wsib -# 1#)\n        !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}\n    bitSizeMaybe i         = Just (finiteBitSize i)\n    bitSize i              = finiteBitSize i\n\n    popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))\n\n    isSigned _             = True\n\n-- | @since 4.6.0.0\ninstance FiniteBits Int where\n    finiteBitSize _ = WORD_SIZE_IN_BITS\n    countLeadingZeros  (I# x#) = I# (word2Int# (clz# (int2Word# x#)))\n    {-# INLINE countLeadingZeros #-}\n    countTrailingZeros (I# x#) = I# (word2Int# (ctz# (int2Word# x#)))\n    {-# INLINE countTrailingZeros #-}\n\n-- | @since 2.01\ninstance Bits Word where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (W# x#) .&.   (W# y#)    = W# (x# `and#` y#)\n    (W# x#) .|.   (W# y#)    = W# (x# `or#`  y#)\n    (W# x#) `xor` (W# y#)    = W# (x# `xor#` y#)\n    complement (W# x#)       = W# (x# `xor#` mb#)\n        where !(W# mb#) = maxBound\n    (W# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)      = W# (x# `shiftL#` i#)\n        | otherwise                = W# (x# `shiftRL#` negateInt# i#)\n    (W# x#) `shiftL` (I# i#)\n        | isTrue# (i# >=# 0#)      = W# (x# `shiftL#` i#)\n        | otherwise                = overflowError\n    (W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)\n    (W# x#) `shiftR` (I# i#)\n        | isTrue# (i# >=# 0#)      = W# (x# `shiftRL#` i#)\n        | otherwise                = overflowError\n    (W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)\n    (W# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#) = W# x#\n        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))\n        where\n        !i'# = i# `andI#` (wsib -# 1#)\n        !wsib = WORD_SIZE_IN_BITS#  {- work around preprocessor problem (??) -}\n    bitSizeMaybe i           = Just (finiteBitSize i)\n    bitSize i                = finiteBitSize i\n    isSigned _               = False\n    popCount (W# x#)         = I# (word2Int# (popCnt# x#))\n    bit                      = bitDefault\n    testBit                  = testBitDefault\n\n-- | @since 4.6.0.0\ninstance FiniteBits Word where\n    finiteBitSize _ = WORD_SIZE_IN_BITS\n    countLeadingZeros  (W# x#) = I# (word2Int# (clz# x#))\n    {-# INLINE countLeadingZeros #-}\n    countTrailingZeros (W# x#) = I# (word2Int# (ctz# x#))\n    {-# INLINE countTrailingZeros #-}\n\n-- | @since 2.01\ninstance Bits Integer where\n   (.&.) = andInteger\n   (.|.) = orInteger\n   xor = xorInteger\n   complement = complementInteger\n   shift x i@(I# i#) | i >= 0    = shiftLInteger x i#\n                     | otherwise = shiftRInteger x (negateInt# i#)\n   testBit x (I# i) = testBitInteger x i\n   zeroBits   = 0\n\n   bit (I# i#) = bitInteger i#\n   popCount x  = I# (popCountInteger x)\n\n   rotate x i = shift x i   -- since an Integer never wraps around\n\n   bitSizeMaybe _ = Nothing\n   bitSize _  = errorWithoutStackTrace \"Data.Bits.bitSize(Integer)\"\n   isSigned _ = True\n\n-- | @since 4.8.0\ninstance Bits Natural where\n   (.&.) = andNatural\n   (.|.) = orNatural\n   xor = xorNatural\n   complement _ = errorWithoutStackTrace\n                    \"Bits.complement: Natural complement undefined\"\n   shift x i\n     | i >= 0    = shiftLNatural x i\n     | otherwise = shiftRNatural x (negate i)\n   testBit x i   = testBitNatural x i\n   zeroBits      = wordToNaturalBase 0##\n   clearBit x i  = x `xor` (bit i .&. x)\n\n   bit (I# i#) = bitNatural i#\n   popCount x  = popCountNatural x\n\n   rotate x i = shift x i   -- since an Natural never wraps around\n\n   bitSizeMaybe _ = Nothing\n   bitSize _  = errorWithoutStackTrace \"Data.Bits.bitSize(Natural)\"\n   isSigned _ = False\n\n-----------------------------------------------------------------------------\n\n-- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using\n-- the size of the types as measured by 'Bits' methods.\n--\n-- A simpler version of this function is:\n--\n-- > toIntegral :: (Integral a, Integral b) => a -> Maybe b\n-- > toIntegral x\n-- >   | toInteger x == y = Just (fromInteger y)\n-- >   | otherwise        = Nothing\n-- >   where\n-- >     y = toInteger x\n--\n-- This version requires going through 'Integer', which can be inefficient.\n-- However, @toIntegralSized@ is optimized to allow GHC to statically determine\n-- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and\n-- avoid going through 'Integer' for many types. (The implementation uses\n-- 'fromIntegral', which is itself optimized with rules for @base@ types but may\n-- go through 'Integer' for some type pairs.)\n--\n-- @since 4.8.0.0\n\ntoIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b\ntoIntegralSized x                 -- See Note [toIntegralSized optimization]\n  | maybe True (<= x) yMinBound\n  , maybe True (x <=) yMaxBound = Just y\n  | otherwise                   = Nothing\n  where\n    y = fromIntegral x\n\n    xWidth = bitSizeMaybe x\n    yWidth = bitSizeMaybe y\n\n    yMinBound\n      | isBitSubType x y = Nothing\n      | isSigned x, not (isSigned y) = Just 0\n      | isSigned x, isSigned y\n      , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type\n      | otherwise = Nothing\n\n    yMaxBound\n      | isBitSubType x y = Nothing\n      | isSigned x, not (isSigned y)\n      , Just xW <- xWidth, Just yW <- yWidth\n      , xW <= yW+1 = Nothing -- Max bound beyond a's domain\n      | Just yW <- yWidth = if isSigned y\n                            then Just (bit (yW-1)-1)\n                            else Just (bit yW-1)\n      | otherwise = Nothing\n{-# INLINABLE toIntegralSized #-}\n\n-- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured\n-- by 'bitSizeMaybe' and 'isSigned'.\nisBitSubType :: (Bits a, Bits b) => a -> b -> Bool\nisBitSubType x y\n  -- Reflexive\n  | xWidth == yWidth, xSigned == ySigned = True\n\n  -- Every integer is a subset of 'Integer'\n  | ySigned, Nothing == yWidth                  = True\n  | not xSigned, not ySigned, Nothing == yWidth = True\n\n  -- Sub-type relations between fixed-with types\n  | xSigned == ySigned,   Just xW <- xWidth, Just yW <- yWidth = xW <= yW\n  | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <  yW\n\n  | otherwise = False\n  where\n    xWidth  = bitSizeMaybe x\n    xSigned = isSigned     x\n\n    yWidth  = bitSizeMaybe y\n    ySigned = isSigned     y\n{-# INLINE isBitSubType #-}\n\n{-      Note [Constant folding for rotate]\n        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe INLINE on the Int instance of rotate enables it to be constant\nfolded.  For example:\n     sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)\ngoes to:\n   Main.$wfold =\n     \\ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->\n       case ww1_sOb of wild_XM {\n         __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);\n         10000000 -> ww_sO7\nwhereas before it was left as a call to $wrotate.\n\nAll other Bits instances seem to inline well enough on their\nown to enable constant folding; for example 'shift':\n     sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)\n goes to:\n     Main.$wfold =\n       \\ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->\n         case ww1_sOf of wild_XM {\n           __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);\n           10000000 -> ww_sOb\n         }\n-}\n\n-- Note [toIntegralSized optimization]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- The code in 'toIntegralSized' relies on GHC optimizing away statically\n-- decidable branches.\n--\n-- If both integral types are statically known, GHC will be able optimize the\n-- code significantly (for @-O1@ and better).\n--\n-- For instance (as of GHC 7.8.1) the following definitions:\n--\n-- > w16_to_i32 = toIntegralSized :: Word16 -> Maybe Int32\n-- >\n-- > i16_to_w16 = toIntegralSized :: Int16 -> Maybe Word16\n--\n-- are translated into the following (simplified) /GHC Core/ language:\n--\n-- > w16_to_i32 = \\x -> Just (case x of _ { W16# x# -> I32# (word2Int# x#) })\n-- >\n-- > i16_to_w16 = \\x -> case eta of _\n-- >   { I16# b1 -> case tagToEnum# (<=# 0 b1) of _\n-- >       { False -> Nothing\n-- >       ; True -> Just (W16# (narrow16Word# (int2Word# b1)))\n-- >       }\n-- >   }\n", "num_lines": 700}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Bool\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The 'Bool' type and related functions.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Bool (\n   -- * Booleans\n   Bool(..),\n   -- ** Operations\n   (&&),\n   (||),\n   not,\n   otherwise,\n   bool,\n  ) where\n\nimport GHC.Base\n\n-- | Case analysis for the 'Bool' type. @'bool' x y p@ evaluates to @x@\n-- when @p@ is 'False', and evaluates to @y@ when @p@ is 'True'.\n--\n-- This is equivalent to @if p then y else x@; that is, one can\n-- think of it as an if-then-else construct with its arguments\n-- reordered.\n--\n-- @since 4.7.0.0\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> bool \"foo\" \"bar\" True\n-- \"bar\"\n-- >>> bool \"foo\" \"bar\" False\n-- \"foo\"\n--\n-- Confirm that @'bool' x y p@ and @if p then y else x@ are\n-- equivalent:\n--\n-- >>> let p = True; x = \"bar\"; y = \"foo\"\n-- >>> bool x y p == if p then y else x\n-- True\n-- >>> let p = False\n-- >>> bool x y p == if p then y else x\n-- True\n--\nbool :: a -> a -> Bool -> a\nbool f _ False = f\nbool _ t True  = t\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Char\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- The Char type and associated operations.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Char\n    (\n      Char\n\n    -- * Character classification\n    -- | Unicode characters are divided into letters, numbers, marks,\n    -- punctuation, symbols, separators (including spaces) and others\n    -- (including control characters).\n    , isControl, isSpace\n    , isLower, isUpper, isAlpha, isAlphaNum, isPrint\n    , isDigit, isOctDigit, isHexDigit\n    , isLetter, isMark, isNumber, isPunctuation, isSymbol, isSeparator\n\n    -- ** Subranges\n    , isAscii, isLatin1\n    , isAsciiUpper, isAsciiLower\n\n    -- ** Unicode general categories\n    , GeneralCategory(..), generalCategory\n\n    -- * Case conversion\n    , toUpper, toLower, toTitle\n\n    -- * Single digit characters\n    , digitToInt\n    , intToDigit\n\n    -- * Numeric representations\n    , ord\n    , chr\n\n    -- * String representations\n    , showLitChar\n    , lexLitChar\n    , readLitChar\n    ) where\n\nimport GHC.Base\nimport GHC.Char\nimport GHC.Real (fromIntegral)\nimport GHC.Show\nimport GHC.Read (readLitChar, lexLitChar)\nimport GHC.Unicode\nimport GHC.Num\n\n-- $setup\n-- Allow the use of Prelude in doctests.\n-- >>> import Prelude\n\n-- | Convert a single digit 'Char' to the corresponding 'Int'.  This\n-- function fails unless its argument satisfies 'isHexDigit', but\n-- recognises both upper- and lower-case hexadecimal digits (that\n-- is, @\\'0\\'@..@\\'9\\'@, @\\'a\\'@..@\\'f\\'@, @\\'A\\'@..@\\'F\\'@).\n--\n-- ==== __Examples__\n--\n-- Characters @\\'0\\'@ through @\\'9\\'@ are converted properly to\n-- @0..9@:\n--\n-- >>> map digitToInt ['0'..'9']\n-- [0,1,2,3,4,5,6,7,8,9]\n--\n-- Both upper- and lower-case @\\'A\\'@ through @\\'F\\'@ are converted\n-- as well, to @10..15@.\n--\n-- >>> map digitToInt ['a'..'f']\n-- [10,11,12,13,14,15]\n-- >>> map digitToInt ['A'..'F']\n-- [10,11,12,13,14,15]\n--\n-- Anything else throws an exception:\n--\n-- >>> digitToInt 'G'\n-- *** Exception: Char.digitToInt: not a digit 'G'\n-- >>> digitToInt '\u00e2\u2122\u00a5'\n-- *** Exception: Char.digitToInt: not a digit '\\9829'\n--\ndigitToInt :: Char -> Int\ndigitToInt c\n  | (fromIntegral dec::Word) <= 9 = dec\n  | (fromIntegral hexl::Word) <= 5 = hexl + 10\n  | (fromIntegral hexu::Word) <= 5 = hexu + 10\n  | otherwise = errorWithoutStackTrace (\"Char.digitToInt: not a digit \" ++ show c) -- sigh\n  where\n    dec = ord c - ord '0'\n    hexl = ord c - ord 'a'\n    hexu = ord c - ord 'A'\n\n-- derived character classifiers\n\n-- | Selects alphabetic Unicode characters (lower-case, upper-case and\n-- title-case letters, plus letters of caseless scripts and\n-- modifiers letters). This function is equivalent to\n-- 'Data.Char.isAlpha'.\n--\n-- This function returns 'True' if its argument has one of the\n-- following 'GeneralCategory's, or 'False' otherwise:\n--\n-- * 'UppercaseLetter'\n-- * 'LowercaseLetter'\n-- * 'TitlecaseLetter'\n-- * 'ModifierLetter'\n-- * 'OtherLetter'\n--\n-- These classes are defined in the\n-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,\n-- part of the Unicode standard. The same document defines what is\n-- and is not a \\\"Letter\\\".\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isLetter 'a'\n-- True\n-- >>> isLetter 'A'\n-- True\n-- >>> isLetter '\u00ce\u00bb'\n-- True\n-- >>> isLetter '0'\n-- False\n-- >>> isLetter '%'\n-- False\n-- >>> isLetter '\u00e2\u2122\u00a5'\n-- False\n-- >>> isLetter '\\31'\n-- False\n--\n-- Ensure that 'isLetter' and 'isAlpha' are equivalent.\n--\n-- >>> let chars = [(chr 0)..]\n-- >>> let letters = map isLetter chars\n-- >>> let alphas = map isAlpha chars\n-- >>> letters == alphas\n-- True\n--\nisLetter :: Char -> Bool\nisLetter c = case generalCategory c of\n        UppercaseLetter         -> True\n        LowercaseLetter         -> True\n        TitlecaseLetter         -> True\n        ModifierLetter          -> True\n        OtherLetter             -> True\n        _                       -> False\n\n-- | Selects Unicode mark characters, for example accents and the\n-- like, which combine with preceding characters.\n--\n-- This function returns 'True' if its argument has one of the\n-- following 'GeneralCategory's, or 'False' otherwise:\n--\n-- * 'NonSpacingMark'\n-- * 'SpacingCombiningMark'\n-- * 'EnclosingMark'\n--\n-- These classes are defined in the\n-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,\n-- part of the Unicode standard. The same document defines what is\n-- and is not a \\\"Mark\\\".\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isMark 'a'\n-- False\n-- >>> isMark '0'\n-- False\n--\n-- Combining marks such as accent characters usually need to follow\n-- another character before they become printable:\n--\n-- >>> map isMark \"o\u00cc\u20ac\"\n-- [False,True]\n--\n-- Puns are not necessarily supported:\n--\n-- >>> isMark '\u00e2\u0153\u201c'\n-- False\n--\nisMark :: Char -> Bool\nisMark c = case generalCategory c of\n        NonSpacingMark          -> True\n        SpacingCombiningMark    -> True\n        EnclosingMark           -> True\n        _                       -> False\n\n-- | Selects Unicode numeric characters, including digits from various\n-- scripts, Roman numerals, et cetera.\n--\n-- This function returns 'True' if its argument has one of the\n-- following 'GeneralCategory's, or 'False' otherwise:\n--\n-- * 'DecimalNumber'\n-- * 'LetterNumber'\n-- * 'OtherNumber'\n--\n-- These classes are defined in the\n-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,\n-- part of the Unicode standard. The same document defines what is\n-- and is not a \\\"Number\\\".\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isNumber 'a'\n-- False\n-- >>> isNumber '%'\n-- False\n-- >>> isNumber '3'\n-- True\n--\n-- ASCII @\\'0\\'@ through @\\'9\\'@ are all numbers:\n--\n-- >>> and $ map isNumber ['0'..'9']\n-- True\n--\n-- Unicode Roman numerals are \\\"numbers\\\" as well:\n--\n-- >>> isNumber '\u00e2\u2026\u00a8'\n-- True\n--\nisNumber :: Char -> Bool\nisNumber c = case generalCategory c of\n        DecimalNumber           -> True\n        LetterNumber            -> True\n        OtherNumber             -> True\n        _                       -> False\n\n-- | Selects Unicode space and separator characters.\n--\n-- This function returns 'True' if its argument has one of the\n-- following 'GeneralCategory's, or 'False' otherwise:\n--\n-- * 'Space'\n-- * 'LineSeparator'\n-- * 'ParagraphSeparator'\n--\n-- These classes are defined in the\n-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,\n-- part of the Unicode standard. The same document defines what is\n-- and is not a \\\"Separator\\\".\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isSeparator 'a'\n-- False\n-- >>> isSeparator '6'\n-- False\n-- >>> isSeparator ' '\n-- True\n--\n-- Warning: newlines and tab characters are not considered\n-- separators.\n--\n-- >>> isSeparator '\\n'\n-- False\n-- >>> isSeparator '\\t'\n-- False\n--\n-- But some more exotic characters are (like HTML's @&nbsp;@):\n--\n-- >>> isSeparator '\\160'\n-- True\n--\nisSeparator :: Char -> Bool\nisSeparator c = case generalCategory c of\n        Space                   -> True\n        LineSeparator           -> True\n        ParagraphSeparator      -> True\n        _                       -> False\n\n", "num_lines": 293}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Coerce\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Safe coercions between data types.\n--\n-- More in-depth information can be found on the\n-- <https://ghc.haskell.org/trac/ghc/wiki/Roles Roles wiki page>\n--\n-- @since 4.7.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Coerce\n        ( -- * Safe coercions\n          coerce, Coercible,\n        ) where\nimport GHC.Prim (coerce)\nimport GHC.Types (Coercible)\n\nimport GHC.Base () -- for build ordering; see Notes in GHC.Base for more info\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE DeriveTraversable #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Complex\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Complex numbers.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Complex\n        (\n        -- * Rectangular form\n          Complex((:+))\n\n        , realPart\n        , imagPart\n        -- * Polar form\n        , mkPolar\n        , cis\n        , polar\n        , magnitude\n        , phase\n        -- * Conjugate\n        , conjugate\n\n        )  where\n\nimport GHC.Base (Applicative (..))\nimport GHC.Generics (Generic, Generic1)\nimport GHC.Float (Floating(..))\nimport Data.Data (Data)\nimport Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf,\n                alignment)\n\ninfix  6  :+\n\n-- -----------------------------------------------------------------------------\n-- The Complex type\n\n-- | Complex numbers are an algebraic type.\n--\n-- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@,\n-- but oriented in the positive real direction, whereas @'signum' z@\n-- has the phase of @z@, but unit magnitude.\n--\n-- The 'Foldable' and 'Traversable' instances traverse the real part first.\n--\n-- Note that `Complex`'s instances inherit the deficiencies from the type\n-- parameter's. For example, @Complex Float@'s 'Ord' instance has similar\n-- problems to `Float`'s.\ndata Complex a\n  = !a :+ !a    -- ^ forms a complex number from its real and imaginary\n                -- rectangular components.\n        deriving ( Eq          -- ^ @since 2.01\n                 , Show        -- ^ @since 2.01\n                 , Read        -- ^ @since 2.01\n                 , Data        -- ^ @since 2.01\n                 , Generic     -- ^ @since 4.9.0.0\n                 , Generic1    -- ^ @since 4.9.0.0\n                 , Functor     -- ^ @since 4.9.0.0\n                 , Foldable    -- ^ @since 4.9.0.0\n                 , Traversable -- ^ @since 4.9.0.0\n                 )\n\n-- -----------------------------------------------------------------------------\n-- Functions over Complex\n\n-- | Extracts the real part of a complex number.\nrealPart :: Complex a -> a\nrealPart (x :+ _) =  x\n\n-- | Extracts the imaginary part of a complex number.\nimagPart :: Complex a -> a\nimagPart (_ :+ y) =  y\n\n-- | The conjugate of a complex number.\n{-# SPECIALISE conjugate :: Complex Double -> Complex Double #-}\nconjugate        :: Num a => Complex a -> Complex a\nconjugate (x:+y) =  x :+ (-y)\n\n-- | Form a complex number from polar components of magnitude and phase.\n{-# SPECIALISE mkPolar :: Double -> Double -> Complex Double #-}\nmkPolar          :: Floating a => a -> a -> Complex a\nmkPolar r theta  =  r * cos theta :+ r * sin theta\n\n-- | @'cis' t@ is a complex value with magnitude @1@\n-- and phase @t@ (modulo @2*'pi'@).\n{-# SPECIALISE cis :: Double -> Complex Double #-}\ncis              :: Floating a => a -> Complex a\ncis theta        =  cos theta :+ sin theta\n\n-- | The function 'polar' takes a complex number and\n-- returns a (magnitude, phase) pair in canonical form:\n-- the magnitude is nonnegative, and the phase in the range @(-'pi', 'pi']@;\n-- if the magnitude is zero, then so is the phase.\n{-# SPECIALISE polar :: Complex Double -> (Double,Double) #-}\npolar            :: (RealFloat a) => Complex a -> (a,a)\npolar z          =  (magnitude z, phase z)\n\n-- | The nonnegative magnitude of a complex number.\n{-# SPECIALISE magnitude :: Complex Double -> Double #-}\nmagnitude :: (RealFloat a) => Complex a -> a\nmagnitude (x:+y) =  scaleFloat k\n                     (sqrt (sqr (scaleFloat mk x) + sqr (scaleFloat mk y)))\n                    where k  = max (exponent x) (exponent y)\n                          mk = - k\n                          sqr z = z * z\n\n-- | The phase of a complex number, in the range @(-'pi', 'pi']@.\n-- If the magnitude is zero, then so is the phase.\n{-# SPECIALISE phase :: Complex Double -> Double #-}\nphase :: (RealFloat a) => Complex a -> a\nphase (0 :+ 0)   = 0            -- SLPJ July 97 from John Peterson\nphase (x:+y)     = atan2 y x\n\n\n-- -----------------------------------------------------------------------------\n-- Instances of Complex\n\n-- | @since 2.01\ninstance  (RealFloat a) => Num (Complex a)  where\n    {-# SPECIALISE instance Num (Complex Float) #-}\n    {-# SPECIALISE instance Num (Complex Double) #-}\n    (x:+y) + (x':+y')   =  (x+x') :+ (y+y')\n    (x:+y) - (x':+y')   =  (x-x') :+ (y-y')\n    (x:+y) * (x':+y')   =  (x*x'-y*y') :+ (x*y'+y*x')\n    negate (x:+y)       =  negate x :+ negate y\n    abs z               =  magnitude z :+ 0\n    signum (0:+0)       =  0\n    signum z@(x:+y)     =  x/r :+ y/r  where r = magnitude z\n    fromInteger n       =  fromInteger n :+ 0\n\n-- | @since 2.01\ninstance  (RealFloat a) => Fractional (Complex a)  where\n    {-# SPECIALISE instance Fractional (Complex Float) #-}\n    {-# SPECIALISE instance Fractional (Complex Double) #-}\n    (x:+y) / (x':+y')   =  (x*x''+y*y'') / d :+ (y*x''-x*y'') / d\n                           where x'' = scaleFloat k x'\n                                 y'' = scaleFloat k y'\n                                 k   = - max (exponent x') (exponent y')\n                                 d   = x'*x'' + y'*y''\n\n    fromRational a      =  fromRational a :+ 0\n\n-- | @since 2.01\ninstance  (RealFloat a) => Floating (Complex a) where\n    {-# SPECIALISE instance Floating (Complex Float) #-}\n    {-# SPECIALISE instance Floating (Complex Double) #-}\n    pi             =  pi :+ 0\n    exp (x:+y)     =  expx * cos y :+ expx * sin y\n                      where expx = exp x\n    log z          =  log (magnitude z) :+ phase z\n\n    x ** y = case (x,y) of\n      (_ , (0:+0))  -> 1 :+ 0\n      ((0:+0), (exp_re:+_)) -> case compare exp_re 0 of\n                 GT -> 0 :+ 0\n                 LT -> inf :+ 0\n                 EQ -> nan :+ nan\n      ((re:+im), (exp_re:+_))\n        | (isInfinite re || isInfinite im) -> case compare exp_re 0 of\n                 GT -> inf :+ 0\n                 LT -> 0 :+ 0\n                 EQ -> nan :+ nan\n        | otherwise -> exp (log x * y)\n      where\n        inf = 1/0\n        nan = 0/0\n\n    sqrt (0:+0)    =  0\n    sqrt z@(x:+y)  =  u :+ (if y < 0 then -v else v)\n                      where (u,v) = if x < 0 then (v',u') else (u',v')\n                            v'    = abs y / (u'*2)\n                            u'    = sqrt ((magnitude z + abs x) / 2)\n\n    sin (x:+y)     =  sin x * cosh y :+ cos x * sinh y\n    cos (x:+y)     =  cos x * cosh y :+ (- sin x * sinh y)\n    tan (x:+y)     =  (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy))\n                      where sinx  = sin x\n                            cosx  = cos x\n                            sinhy = sinh y\n                            coshy = cosh y\n\n    sinh (x:+y)    =  cos y * sinh x :+ sin  y * cosh x\n    cosh (x:+y)    =  cos y * cosh x :+ sin y * sinh x\n    tanh (x:+y)    =  (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx)\n                      where siny  = sin y\n                            cosy  = cos y\n                            sinhx = sinh x\n                            coshx = cosh x\n\n    asin z@(x:+y)  =  y':+(-x')\n                      where  (x':+y') = log (((-y):+x) + sqrt (1 - z*z))\n    acos z         =  y'':+(-x'')\n                      where (x'':+y'') = log (z + ((-y'):+x'))\n                            (x':+y')   = sqrt (1 - z*z)\n    atan z@(x:+y)  =  y':+(-x')\n                      where (x':+y') = log (((1-y):+x) / sqrt (1+z*z))\n\n    asinh z        =  log (z + sqrt (1+z*z))\n    -- Take care to allow (-1)::Complex, fixing #8532\n    acosh z        =  log (z + (sqrt $ z+1) * (sqrt $ z-1))\n    atanh z        =  0.5 * log ((1.0+z) / (1.0-z))\n\n    log1p x@(a :+ b)\n      | abs a < 0.5 && abs b < 0.5\n      , u <- 2*a + a*a + b*b = log1p (u/(1 + sqrt(u+1))) :+ atan2 (1 + a) b\n      | otherwise = log (1 + x)\n    {-# INLINE log1p #-}\n\n    expm1 x@(a :+ b)\n      | a*a + b*b < 1\n      , u <- expm1 a\n      , v <- sin (b/2)\n      , w <- -2*v*v = (u*w + u + w) :+ (u+1)*sin b\n      | otherwise = exp x - 1\n    {-# INLINE expm1 #-}\n\n-- | @since 4.8.0.0\ninstance Storable a => Storable (Complex a) where\n    sizeOf a       = 2 * sizeOf (realPart a)\n    alignment a    = alignment (realPart a)\n    peek p           = do\n                        q <- return $ castPtr p\n                        r <- peek q\n                        i <- peekElemOff q 1\n                        return (r :+ i)\n    poke p (r :+ i)  = do\n                        q <-return $  (castPtr p)\n                        poke q r\n                        pokeElemOff q 1 i\n\n-- | @since 4.9.0.0\ninstance Applicative Complex where\n  pure a = a :+ a\n  f :+ g <*> a :+ b = f a :+ g b\n  liftA2 f (x :+ y) (a :+ b) = f x a :+ f y b\n\n-- | @since 4.9.0.0\ninstance Monad Complex where\n  a :+ b >>= f = realPart (f a) :+ imagPart (f b)\n\n-- -----------------------------------------------------------------------------\n-- Rules on Complex\n\n{-# RULES\n\n\"realToFrac/a->Complex Double\"\n  realToFrac = \\x -> realToFrac x :+ (0 :: Double)\n\n\"realToFrac/a->Complex Float\"\n  realToFrac = \\x -> realToFrac x :+ (0 :: Float)\n\n  #-}\n", "num_lines": 266}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeOperators #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Data\n-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (local universal quantification)\n--\n-- \\\"Scrap your boilerplate\\\" --- Generic programming in Haskell.  See\n-- <http://www.haskell.org/haskellwiki/Research_papers/Generics#Scrap_your_boilerplate.21>.\n-- This module provides the 'Data' class with its primitives for\n-- generic programming, along with instances for many datatypes. It\n-- corresponds to a merge between the previous \"Data.Generics.Basics\"\n-- and almost all of \"Data.Generics.Instances\". The instances that are\n-- not present in this module were moved to the\n-- @Data.Generics.Instances@ module in the @syb@ package.\n--\n-- For more information, please visit the new\n-- SYB wiki: <http://www.cs.uu.nl/wiki/bin/view/GenericProgramming/SYB>.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Data (\n\n        -- * Module Data.Typeable re-exported for convenience\n        module Data.Typeable,\n\n        -- * The Data class for processing constructor applications\n        Data(\n                gfoldl,\n                gunfold,\n                toConstr,\n                dataTypeOf,\n                dataCast1,      -- mediate types and unary type constructors\n                dataCast2,      -- mediate types and binary type constructors\n                -- Generic maps defined in terms of gfoldl\n                gmapT,\n                gmapQ,\n                gmapQl,\n                gmapQr,\n                gmapQi,\n                gmapM,\n                gmapMp,\n                gmapMo\n            ),\n\n        -- * Datatype representations\n        DataType,       -- abstract\n        -- ** Constructors\n        mkDataType,\n        mkIntType,\n        mkFloatType,\n        mkCharType,\n        mkNoRepType,\n        -- ** Observers\n        dataTypeName,\n        DataRep(..),\n        dataTypeRep,\n        -- ** Convenience functions\n        repConstr,\n        isAlgType,\n        dataTypeConstrs,\n        indexConstr,\n        maxConstrIndex,\n        isNorepType,\n\n        -- * Data constructor representations\n        Constr,         -- abstract\n        ConIndex,       -- alias for Int, start at 1\n        Fixity(..),\n        -- ** Constructors\n        mkConstr,\n        mkIntegralConstr,\n        mkRealConstr,\n        mkCharConstr,\n        -- ** Observers\n        constrType,\n        ConstrRep(..),\n        constrRep,\n        constrFields,\n        constrFixity,\n        -- ** Convenience function: algebraic data types\n        constrIndex,\n        -- ** From strings to constructors and vice versa: all data types\n        showConstr,\n        readConstr,\n\n        -- * Convenience functions: take type constructors apart\n        tyconUQname,\n        tyconModule,\n\n        -- * Generic operations defined in terms of 'gunfold'\n        fromConstr,\n        fromConstrB,\n        fromConstrM\n\n  ) where\n\n\n------------------------------------------------------------------------------\n\nimport Data.Functor.Const\nimport Data.Either\nimport Data.Eq\nimport Data.Maybe\nimport Data.Monoid\nimport Data.Ord\nimport Data.Typeable\nimport Data.Version( Version(..) )\nimport GHC.Base hiding (Any, IntRep, FloatRep)\nimport GHC.List\nimport GHC.Num\nimport GHC.Read\nimport GHC.Show\nimport Text.Read( reads )\n\n-- Imports for the instances\nimport Data.Functor.Identity -- So we can give Data instance for Identity\nimport Data.Int              -- So we can give Data instance for Int8, ...\nimport Data.Type.Coercion\nimport Data.Word             -- So we can give Data instance for Word8, ...\nimport GHC.Real              -- So we can give Data instance for Ratio\n--import GHC.IOBase            -- So we can give Data instance for IO, Handle\nimport GHC.Ptr               -- So we can give Data instance for Ptr\nimport GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr\nimport Foreign.Ptr (IntPtr(..), WordPtr(..))\n                             -- So we can give Data instance for IntPtr and WordPtr\n--import GHC.Stable            -- So we can give Data instance for StablePtr\n--import GHC.ST                -- So we can give Data instance for ST\n--import GHC.Conc              -- So we can give Data instance for MVar & Co.\nimport GHC.Arr               -- So we can give Data instance for Array\nimport qualified GHC.Generics as Generics (Fixity(..))\nimport GHC.Generics hiding (Fixity(..))\n                             -- So we can give Data instance for U1, V1, ...\n\n------------------------------------------------------------------------------\n--\n--      The Data class\n--\n------------------------------------------------------------------------------\n\n{- |\nThe 'Data' class comprehends a fundamental primitive 'gfoldl' for\nfolding over constructor applications, say terms. This primitive can\nbe instantiated in several ways to map over the immediate subterms\nof a term; see the @gmap@ combinators later in this class.  Indeed, a\ngeneric programmer does not necessarily need to use the ingenious gfoldl\nprimitive but rather the intuitive @gmap@ combinators.  The 'gfoldl'\nprimitive is completed by means to query top-level constructors, to\nturn constructor representations into proper terms, and to list all\npossible datatype constructors.  This completion allows us to serve\ngeneric programming scenarios like read, show, equality, term generation.\n\nThe combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with\ndefault definitions in terms of 'gfoldl', leaving open the opportunity\nto provide datatype-specific definitions.\n(The inclusion of the @gmap@ combinators as members of class 'Data'\nallows the programmer or the compiler to derive specialised, and maybe\nmore efficient code per datatype.  /Note/: 'gfoldl' is more higher-order\nthan the @gmap@ combinators.  This is subject to ongoing benchmarking\nexperiments.  It might turn out that the @gmap@ combinators will be\nmoved out of the class 'Data'.)\n\nConceptually, the definition of the @gmap@ combinators in terms of the\nprimitive 'gfoldl' requires the identification of the 'gfoldl' function\narguments.  Technically, we also need to identify the type constructor\n@c@ for the construction of the result type from the folded term type.\n\nIn the definition of @gmapQ@/x/ combinators, we use phantom type\nconstructors for the @c@ in the type of 'gfoldl' because the result type\nof a query does not involve the (polymorphic) type of the term argument.\nIn the definition of 'gmapQl' we simply use the plain constant type\nconstructor because 'gfoldl' is left-associative anyway and so it is\nreadily suited to fold a left-associative binary operation over the\nimmediate subterms.  In the definition of gmapQr, extra effort is\nneeded. We use a higher-order accumulation trick to mediate between\nleft-associative constructor application vs. right-associative binary\noperation (e.g., @(:)@).  When the query is meant to compute a value\nof type @r@, then the result type withing generic folding is @r -> r@.\nSo the result of folding is a function to which we finally pass the\nright unit.\n\nWith the @-XDeriveDataTypeable@ option, GHC can generate instances of the\n'Data' class automatically.  For example, given the declaration\n\n> data T a b = C1 a b | C2 deriving (Typeable, Data)\n\nGHC will generate an instance that is equivalent to\n\n> instance (Data a, Data b) => Data (T a b) where\n>     gfoldl k z (C1 a b) = z C1 `k` a `k` b\n>     gfoldl k z C2       = z C2\n>\n>     gunfold k z c = case constrIndex c of\n>                         1 -> k (k (z C1))\n>                         2 -> z C2\n>\n>     toConstr (C1 _ _) = con_C1\n>     toConstr C2       = con_C2\n>\n>     dataTypeOf _ = ty_T\n>\n> con_C1 = mkConstr ty_T \"C1\" [] Prefix\n> con_C2 = mkConstr ty_T \"C2\" [] Prefix\n> ty_T   = mkDataType \"Module.T\" [con_C1, con_C2]\n\nThis is suitable for datatypes that are exported transparently.\n\n-}\n\nclass Typeable a => Data a where\n\n  -- | Left-associative fold operation for constructor applications.\n  --\n  -- The type of 'gfoldl' is a headache, but operationally it is a simple\n  -- generalisation of a list fold.\n  --\n  -- The default definition for 'gfoldl' is @'const' 'id'@, which is\n  -- suitable for abstract datatypes with no substructures.\n  gfoldl  :: (forall d b. Data d => c (d -> b) -> d -> c b)\n                -- ^ defines how nonempty constructor applications are\n                -- folded.  It takes the folded tail of the constructor\n                -- application and its head, i.e., an immediate subterm,\n                -- and combines them in some way.\n          -> (forall g. g -> c g)\n                -- ^ defines how the empty constructor application is\n                -- folded, like the neutral \\/ start element for list\n                -- folding.\n          -> a\n                -- ^ structure to be folded.\n          -> c a\n                -- ^ result, with a type defined in terms of @a@, but\n                -- variability is achieved by means of type constructor\n                -- @c@ for the construction of the actual result type.\n\n  -- See the 'Data' instances in this file for an illustration of 'gfoldl'.\n\n  gfoldl _ z = z\n\n  -- | Unfolding constructor applications\n  gunfold :: (forall b r. Data b => c (b -> r) -> c r)\n          -> (forall r. r -> c r)\n          -> Constr\n          -> c a\n\n  -- | Obtaining the constructor from a given datum.\n  -- For proper terms, this is meant to be the top-level constructor.\n  -- Primitive datatypes are here viewed as potentially infinite sets of\n  -- values (i.e., constructors).\n  toConstr   :: a -> Constr\n\n\n  -- | The outer type constructor of the type\n  dataTypeOf  :: a -> DataType\n\n\n\n------------------------------------------------------------------------------\n--\n-- Mediate types and type constructors\n--\n------------------------------------------------------------------------------\n\n  -- | Mediate types and unary type constructors.\n  --\n  -- In 'Data' instances of the form\n  --\n  -- @\n  --     instance (Data a, ...) => Data (T a)\n  -- @\n  --\n  -- 'dataCast1' should be defined as 'gcast1'.\n  --\n  -- The default definition is @'const' 'Nothing'@, which is appropriate\n  -- for instances of other forms.\n  dataCast1 :: Typeable t\n            => (forall d. Data d => c (t d))\n            -> Maybe (c a)\n  dataCast1 _ = Nothing\n\n  -- | Mediate types and binary type constructors.\n  --\n  -- In 'Data' instances of the form\n  --\n  -- @\n  --     instance (Data a, Data b, ...) => Data (T a b)\n  -- @\n  --\n  -- 'dataCast2' should be defined as 'gcast2'.\n  --\n  -- The default definition is @'const' 'Nothing'@, which is appropriate\n  -- for instances of other forms.\n  dataCast2 :: Typeable t\n            => (forall d e. (Data d, Data e) => c (t d e))\n            -> Maybe (c a)\n  dataCast2 _ = Nothing\n\n\n\n------------------------------------------------------------------------------\n--\n--      Typical generic maps defined in terms of gfoldl\n--\n------------------------------------------------------------------------------\n\n\n  -- | A generic transformation that maps over the immediate subterms\n  --\n  -- The default definition instantiates the type constructor @c@ in the\n  -- type of 'gfoldl' to an identity datatype constructor, using the\n  -- isomorphism pair as injection and projection.\n  gmapT :: (forall b. Data b => b -> b) -> a -> a\n\n  -- Use the Identity datatype constructor\n  -- to instantiate the type constructor c in the type of gfoldl,\n  -- and perform injections Identity and projections runIdentity accordingly.\n  --\n  gmapT f x0 = runIdentity (gfoldl k Identity x0)\n    where\n      k :: Data d => Identity (d->b) -> d -> Identity b\n      k (Identity c) x = Identity (c (f x))\n\n\n  -- | A generic query with a left-associative binary operator\n  gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r\n  gmapQl o r f = getConst . gfoldl k z\n    where\n      k :: Data d => Const r (d->b) -> d -> Const r b\n      k c x = Const $ (getConst c) `o` f x\n      z :: g -> Const r g\n      z _   = Const r\n\n  -- | A generic query with a right-associative binary operator\n  gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r\n  gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0\n    where\n      k :: Data d => Qr r (d->b) -> d -> Qr r b\n      k (Qr c) x = Qr (\\r -> c (f x `o` r))\n\n\n  -- | A generic query that processes the immediate subterms and returns a list\n  -- of results.  The list is given in the same order as originally specified\n  -- in the declaration of the data constructors.\n  gmapQ :: (forall d. Data d => d -> u) -> a -> [u]\n  gmapQ f = gmapQr (:) [] f\n\n\n  -- | A generic query that processes one child by index (zero-based)\n  gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> a -> u\n  gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }\n    where\n      k :: Data d => Qi u (d -> b) -> d -> Qi u b\n      k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)\n      z :: g -> Qi q g\n      z _           = Qi 0 Nothing\n\n\n  -- | A generic monadic transformation that maps over the immediate subterms\n  --\n  -- The default definition instantiates the type constructor @c@ in\n  -- the type of 'gfoldl' to the monad datatype constructor, defining\n  -- injection and projection using 'return' and '>>='.\n  gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a\n\n  -- Use immediately the monad datatype constructor\n  -- to instantiate the type constructor c in the type of gfoldl,\n  -- so injection and projection is done by return and >>=.\n  --\n  gmapM f = gfoldl k return\n    where\n      k :: Data d => m (d -> b) -> d -> m b\n      k c x = do c' <- c\n                 x' <- f x\n                 return (c' x')\n\n\n  -- | Transformation of at least one immediate subterm does not fail\n  gmapMp :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a\n\n{-\n\nThe type constructor that we use here simply keeps track of the fact\nif we already succeeded for an immediate subterm; see Mp below. To\nthis end, we couple the monadic computation with a Boolean.\n\n-}\n\n  gmapMp f x = unMp (gfoldl k z x) >>= \\(x',b) ->\n                if b then return x' else mzero\n    where\n      z :: g -> Mp m g\n      z g = Mp (return (g,False))\n      k :: Data d => Mp m (d -> b) -> d -> Mp m b\n      k (Mp c) y\n        = Mp ( c >>= \\(h, b) ->\n                 (f y >>= \\y' -> return (h y', True))\n                 `mplus` return (h y, b)\n             )\n\n  -- | Transformation of one immediate subterm with success\n  gmapMo :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a\n\n{-\n\nWe use the same pairing trick as for gmapMp,\ni.e., we use an extra Bool component to keep track of the\nfact whether an immediate subterm was processed successfully.\nHowever, we cut of mapping over subterms once a first subterm\nwas transformed successfully.\n\n-}\n\n  gmapMo f x = unMp (gfoldl k z x) >>= \\(x',b) ->\n                if b then return x' else mzero\n    where\n      z :: g -> Mp m g\n      z g = Mp (return (g,False))\n      k :: Data d => Mp m (d -> b) -> d -> Mp m b\n      k (Mp c) y\n        = Mp ( c >>= \\(h,b) -> if b\n                        then return (h y, b)\n                        else (f y >>= \\y' -> return (h y',True))\n                             `mplus` return (h y, b)\n             )\n\n\n-- | Type constructor for adding counters to queries\ndata Qi q a = Qi Int (Maybe q)\n\n\n-- | The type constructor used in definition of gmapQr\nnewtype Qr r a = Qr { unQr  :: r -> r }\n\n\n-- | The type constructor used in definition of gmapMp\nnewtype Mp m x = Mp { unMp :: m (x, Bool) }\n\n\n\n------------------------------------------------------------------------------\n--\n--      Generic unfolding\n--\n------------------------------------------------------------------------------\n\n\n-- | Build a term skeleton\nfromConstr :: Data a => Constr -> a\nfromConstr = fromConstrB (errorWithoutStackTrace \"Data.Data.fromConstr\")\n\n\n-- | Build a term and use a generic function for subterms\nfromConstrB :: Data a\n            => (forall d. Data d => d)\n            -> Constr\n            -> a\nfromConstrB f = runIdentity . gunfold k z\n where\n  k :: forall b r. Data b => Identity (b -> r) -> Identity r\n  k c = Identity (runIdentity c f)\n\n  z :: forall r. r -> Identity r\n  z = Identity\n\n\n-- | Monadic variation on 'fromConstrB'\nfromConstrM :: forall m a. (Monad m, Data a)\n            => (forall d. Data d => m d)\n            -> Constr\n            -> m a\nfromConstrM f = gunfold k z\n where\n  k :: forall b r. Data b => m (b -> r) -> m r\n  k c = do { c' <- c; b <- f; return (c' b) }\n\n  z :: forall r. r -> m r\n  z = return\n\n\n\n------------------------------------------------------------------------------\n--\n--      Datatype and constructor representations\n--\n------------------------------------------------------------------------------\n\n\n--\n-- | Representation of datatypes.\n-- A package of constructor representations with names of type and module.\n--\ndata DataType = DataType\n                        { tycon   :: String\n                        , datarep :: DataRep\n                        }\n\n              deriving Show -- ^ @since 4.0.0.0\n\n-- | Representation of constructors. Note that equality on constructors\n-- with different types may not work -- i.e. the constructors for 'False' and\n-- 'Nothing' may compare equal.\ndata Constr = Constr\n                        { conrep    :: ConstrRep\n                        , constring :: String\n                        , confields :: [String] -- for AlgRep only\n                        , confixity :: Fixity   -- for AlgRep only\n                        , datatype  :: DataType\n                        }\n\n-- | @since 4.0.0.0\ninstance Show Constr where\n show = constring\n\n\n-- | Equality of constructors\n--\n-- @since 4.0.0.0\ninstance Eq Constr where\n  c == c' = constrRep c == constrRep c'\n\n\n-- | Public representation of datatypes\ndata DataRep = AlgRep [Constr]\n             | IntRep\n             | FloatRep\n             | CharRep\n             | NoRep\n\n            deriving ( Eq   -- ^ @since 4.0.0.0\n                     , Show -- ^ @since 4.0.0.0\n                     )\n-- The list of constructors could be an array, a balanced tree, or others.\n\n\n-- | Public representation of constructors\ndata ConstrRep = AlgConstr    ConIndex\n               | IntConstr    Integer\n               | FloatConstr  Rational\n               | CharConstr   Char\n\n               deriving ( Eq   -- ^ @since 4.0.0.0\n                        , Show -- ^ @since 4.0.0.0\n                        )\n\n\n-- | Unique index for datatype constructors,\n-- counting from 1 in the order they are given in the program text.\ntype ConIndex = Int\n\n\n-- | Fixity of constructors\ndata Fixity = Prefix\n            | Infix     -- Later: add associativity and precedence\n\n            deriving ( Eq   -- ^ @since 4.0.0.0\n                     , Show -- ^ @since 4.0.0.0\n                     )\n\n\n------------------------------------------------------------------------------\n--\n--      Observers for datatype representations\n--\n------------------------------------------------------------------------------\n\n\n-- | Gets the type constructor including the module\ndataTypeName :: DataType -> String\ndataTypeName = tycon\n\n\n\n-- | Gets the public presentation of a datatype\ndataTypeRep :: DataType -> DataRep\ndataTypeRep = datarep\n\n\n-- | Gets the datatype of a constructor\nconstrType :: Constr -> DataType\nconstrType = datatype\n\n\n-- | Gets the public presentation of constructors\nconstrRep :: Constr -> ConstrRep\nconstrRep = conrep\n\n\n-- | Look up a constructor by its representation\nrepConstr :: DataType -> ConstrRep -> Constr\nrepConstr dt cr =\n      case (dataTypeRep dt, cr) of\n        (AlgRep cs, AlgConstr i)      -> cs !! (i-1)\n        (IntRep,    IntConstr i)      -> mkIntegralConstr dt i\n        (FloatRep,  FloatConstr f)    -> mkRealConstr dt f\n        (CharRep,   CharConstr c)     -> mkCharConstr dt c\n        _ -> errorWithoutStackTrace \"Data.Data.repConstr: The given ConstrRep does not fit to the given DataType.\"\n\n\n\n------------------------------------------------------------------------------\n--\n--      Representations of algebraic data types\n--\n------------------------------------------------------------------------------\n\n\n-- | Constructs an algebraic datatype\nmkDataType :: String -> [Constr] -> DataType\nmkDataType str cs = DataType\n                        { tycon   = str\n                        , datarep = AlgRep cs\n                        }\n\n\n-- | Constructs a constructor\nmkConstr :: DataType -> String -> [String] -> Fixity -> Constr\nmkConstr dt str fields fix =\n        Constr\n                { conrep    = AlgConstr idx\n                , constring = str\n                , confields = fields\n                , confixity = fix\n                , datatype  = dt\n                }\n  where\n    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],\n                     showConstr c == str ]\n\n\n-- | Gets the constructors of an algebraic datatype\ndataTypeConstrs :: DataType -> [Constr]\ndataTypeConstrs dt = case datarep dt of\n                        (AlgRep cons) -> cons\n                        _ -> errorWithoutStackTrace $ \"Data.Data.dataTypeConstrs is not supported for \"\n                                    ++ dataTypeName dt ++\n                                    \", as it is not an algebraic data type.\"\n\n\n-- | Gets the field labels of a constructor.  The list of labels\n-- is returned in the same order as they were given in the original\n-- constructor declaration.\nconstrFields :: Constr -> [String]\nconstrFields = confields\n\n\n-- | Gets the fixity of a constructor\nconstrFixity :: Constr -> Fixity\nconstrFixity = confixity\n\n\n\n------------------------------------------------------------------------------\n--\n--      From strings to constr's and vice versa: all data types\n--\n------------------------------------------------------------------------------\n\n\n-- | Gets the string for a constructor\nshowConstr :: Constr -> String\nshowConstr = constring\n\n\n-- | Lookup a constructor via a string\nreadConstr :: DataType -> String -> Maybe Constr\nreadConstr dt str =\n      case dataTypeRep dt of\n        AlgRep cons -> idx cons\n        IntRep      -> mkReadCon (\\i -> (mkPrimCon dt str (IntConstr i)))\n        FloatRep    -> mkReadCon ffloat\n        CharRep     -> mkReadCon (\\c -> (mkPrimCon dt str (CharConstr c)))\n        NoRep       -> Nothing\n  where\n\n    -- Read a value and build a constructor\n    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr\n    mkReadCon f = case (reads str) of\n                    [(t,\"\")] -> Just (f t)\n                    _ -> Nothing\n\n    -- Traverse list of algebraic datatype constructors\n    idx :: [Constr] -> Maybe Constr\n    idx cons = let fit = filter ((==) str . showConstr) cons\n                in if fit == []\n                     then Nothing\n                     else Just (head fit)\n\n    ffloat :: Double -> Constr\n    ffloat =  mkPrimCon dt str . FloatConstr . toRational\n\n------------------------------------------------------------------------------\n--\n--      Convenience functions: algebraic data types\n--\n------------------------------------------------------------------------------\n\n\n-- | Test for an algebraic type\nisAlgType :: DataType -> Bool\nisAlgType dt = case datarep dt of\n                 (AlgRep _) -> True\n                 _ -> False\n\n\n-- | Gets the constructor for an index (algebraic datatypes only)\nindexConstr :: DataType -> ConIndex -> Constr\nindexConstr dt idx = case datarep dt of\n                        (AlgRep cs) -> cs !! (idx-1)\n                        _           -> errorWithoutStackTrace $ \"Data.Data.indexConstr is not supported for \"\n                                               ++ dataTypeName dt ++\n                                               \", as it is not an algebraic data type.\"\n\n\n-- | Gets the index of a constructor (algebraic datatypes only)\nconstrIndex :: Constr -> ConIndex\nconstrIndex con = case constrRep con of\n                    (AlgConstr idx) -> idx\n                    _ -> errorWithoutStackTrace $ \"Data.Data.constrIndex is not supported for \"\n                                 ++ dataTypeName (constrType con) ++\n                                 \", as it is not an algebraic data type.\"\n\n\n-- | Gets the maximum constructor index of an algebraic datatype\nmaxConstrIndex :: DataType -> ConIndex\nmaxConstrIndex dt = case dataTypeRep dt of\n                        AlgRep cs -> length cs\n                        _            -> errorWithoutStackTrace $ \"Data.Data.maxConstrIndex is not supported for \"\n                                                 ++ dataTypeName dt ++\n                                                 \", as it is not an algebraic data type.\"\n\n\n\n------------------------------------------------------------------------------\n--\n--      Representation of primitive types\n--\n------------------------------------------------------------------------------\n\n\n-- | Constructs the 'Int' type\nmkIntType :: String -> DataType\nmkIntType = mkPrimType IntRep\n\n\n-- | Constructs the 'Float' type\nmkFloatType :: String -> DataType\nmkFloatType = mkPrimType FloatRep\n\n\n-- | Constructs the 'Char' type\nmkCharType :: String -> DataType\nmkCharType = mkPrimType CharRep\n\n\n-- | Helper for 'mkIntType', 'mkFloatType'\nmkPrimType :: DataRep -> String -> DataType\nmkPrimType dr str = DataType\n                        { tycon   = str\n                        , datarep = dr\n                        }\n\n\n-- Makes a constructor for primitive types\nmkPrimCon :: DataType -> String -> ConstrRep -> Constr\nmkPrimCon dt str cr = Constr\n                        { datatype  = dt\n                        , conrep    = cr\n                        , constring = str\n                        , confields = errorWithoutStackTrace \"Data.Data.confields\"\n                        , confixity = errorWithoutStackTrace \"Data.Data.confixity\"\n                        }\n\nmkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr\nmkIntegralConstr dt i = case datarep dt of\n                  IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))\n                  _ -> errorWithoutStackTrace $ \"Data.Data.mkIntegralConstr is not supported for \"\n                               ++ dataTypeName dt ++\n                               \", as it is not an Integral data type.\"\n\nmkRealConstr :: (Real a, Show a) => DataType -> a -> Constr\nmkRealConstr dt f = case datarep dt of\n                    FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))\n                    _ -> errorWithoutStackTrace $ \"Data.Data.mkRealConstr is not supported for \"\n                                 ++ dataTypeName dt ++\n                                 \", as it is not a Real data type.\"\n\n-- | Makes a constructor for 'Char'.\nmkCharConstr :: DataType -> Char -> Constr\nmkCharConstr dt c = case datarep dt of\n                   CharRep -> mkPrimCon dt (show c) (CharConstr c)\n                   _ -> errorWithoutStackTrace $ \"Data.Data.mkCharConstr is not supported for \"\n                                ++ dataTypeName dt ++\n                                \", as it is not an Char data type.\"\n\n\n------------------------------------------------------------------------------\n--\n--      Non-representations for non-representable types\n--\n------------------------------------------------------------------------------\n\n\n-- | Constructs a non-representation for a non-representable type\nmkNoRepType :: String -> DataType\nmkNoRepType str = DataType\n                        { tycon   = str\n                        , datarep = NoRep\n                        }\n\n-- | Test for a non-representable type\nisNorepType :: DataType -> Bool\nisNorepType dt = case datarep dt of\n                   NoRep -> True\n                   _ -> False\n\n\n\n------------------------------------------------------------------------------\n--\n--      Convenience for qualified type constructors\n--\n------------------------------------------------------------------------------\n\n\n-- | Gets the unqualified type constructor:\n-- drop *.*.*... before name\n--\ntyconUQname :: String -> String\ntyconUQname x = let x' = dropWhile (not . (==) '.') x\n                 in if x' == [] then x else tyconUQname (tail x')\n\n\n-- | Gets the module of a type constructor:\n-- take *.*.*... before name\ntyconModule :: String -> String\ntyconModule x = let (a,b) = break ((==) '.') x\n                 in if b == \"\"\n                      then b\n                      else a ++ tyconModule' (tail b)\n  where\n    tyconModule' y = let y' = tyconModule y\n                      in if y' == \"\" then \"\" else ('.':y')\n\n\n\n\n------------------------------------------------------------------------------\n------------------------------------------------------------------------------\n--\n--      Instances of the Data class for Prelude-like types.\n--      We define top-level definitions for representations.\n--\n------------------------------------------------------------------------------\n\n-- | @since 4.0.0.0\nderiving instance Data Bool\n\n------------------------------------------------------------------------------\n\ncharType :: DataType\ncharType = mkCharType \"Prelude.Char\"\n\n-- | @since 4.0.0.0\ninstance Data Char where\n  toConstr x = mkCharConstr charType x\n  gunfold _ z c = case constrRep c of\n                    (CharConstr x) -> z x\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Char.\"\n  dataTypeOf _ = charType\n\n\n------------------------------------------------------------------------------\n\nfloatType :: DataType\nfloatType = mkFloatType \"Prelude.Float\"\n\n-- | @since 4.0.0.0\ninstance Data Float where\n  toConstr = mkRealConstr floatType\n  gunfold _ z c = case constrRep c of\n                    (FloatConstr x) -> z (realToFrac x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Float.\"\n  dataTypeOf _ = floatType\n\n\n------------------------------------------------------------------------------\n\ndoubleType :: DataType\ndoubleType = mkFloatType \"Prelude.Double\"\n\n-- | @since 4.0.0.0\ninstance Data Double where\n  toConstr = mkRealConstr doubleType\n  gunfold _ z c = case constrRep c of\n                    (FloatConstr x) -> z (realToFrac x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Double.\"\n  dataTypeOf _ = doubleType\n\n\n------------------------------------------------------------------------------\n\nintType :: DataType\nintType = mkIntType \"Prelude.Int\"\n\n-- | @since 4.0.0.0\ninstance Data Int where\n  toConstr x = mkIntegralConstr intType x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Int.\"\n  dataTypeOf _ = intType\n\n\n------------------------------------------------------------------------------\n\nintegerType :: DataType\nintegerType = mkIntType \"Prelude.Integer\"\n\n-- | @since 4.0.0.0\ninstance Data Integer where\n  toConstr = mkIntegralConstr integerType\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z x\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Integer.\"\n  dataTypeOf _ = integerType\n\n\n------------------------------------------------------------------------------\n\n-- This follows the same style as the other integral 'Data' instances\n-- defined in \"Data.Data\"\nnaturalType :: DataType\nnaturalType = mkIntType \"Numeric.Natural.Natural\"\n\n-- | @since 4.8.0.0\ninstance Data Natural where\n  toConstr x = mkIntegralConstr naturalType x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Natural\"\n  dataTypeOf _ = naturalType\n\n\n------------------------------------------------------------------------------\n\nint8Type :: DataType\nint8Type = mkIntType \"Data.Int.Int8\"\n\n-- | @since 4.0.0.0\ninstance Data Int8 where\n  toConstr x = mkIntegralConstr int8Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Int8.\"\n  dataTypeOf _ = int8Type\n\n\n------------------------------------------------------------------------------\n\nint16Type :: DataType\nint16Type = mkIntType \"Data.Int.Int16\"\n\n-- | @since 4.0.0.0\ninstance Data Int16 where\n  toConstr x = mkIntegralConstr int16Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Int16.\"\n  dataTypeOf _ = int16Type\n\n\n------------------------------------------------------------------------------\n\nint32Type :: DataType\nint32Type = mkIntType \"Data.Int.Int32\"\n\n-- | @since 4.0.0.0\ninstance Data Int32 where\n  toConstr x = mkIntegralConstr int32Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Int32.\"\n  dataTypeOf _ = int32Type\n\n\n------------------------------------------------------------------------------\n\nint64Type :: DataType\nint64Type = mkIntType \"Data.Int.Int64\"\n\n-- | @since 4.0.0.0\ninstance Data Int64 where\n  toConstr x = mkIntegralConstr int64Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Int64.\"\n  dataTypeOf _ = int64Type\n\n\n------------------------------------------------------------------------------\n\nwordType :: DataType\nwordType = mkIntType \"Data.Word.Word\"\n\n-- | @since 4.0.0.0\ninstance Data Word where\n  toConstr x = mkIntegralConstr wordType x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Word\"\n  dataTypeOf _ = wordType\n\n\n------------------------------------------------------------------------------\n\nword8Type :: DataType\nword8Type = mkIntType \"Data.Word.Word8\"\n\n-- | @since 4.0.0.0\ninstance Data Word8 where\n  toConstr x = mkIntegralConstr word8Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Word8.\"\n  dataTypeOf _ = word8Type\n\n\n------------------------------------------------------------------------------\n\nword16Type :: DataType\nword16Type = mkIntType \"Data.Word.Word16\"\n\n-- | @since 4.0.0.0\ninstance Data Word16 where\n  toConstr x = mkIntegralConstr word16Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Word16.\"\n  dataTypeOf _ = word16Type\n\n\n------------------------------------------------------------------------------\n\nword32Type :: DataType\nword32Type = mkIntType \"Data.Word.Word32\"\n\n-- | @since 4.0.0.0\ninstance Data Word32 where\n  toConstr x = mkIntegralConstr word32Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Word32.\"\n  dataTypeOf _ = word32Type\n\n\n------------------------------------------------------------------------------\n\nword64Type :: DataType\nword64Type = mkIntType \"Data.Word.Word64\"\n\n-- | @since 4.0.0.0\ninstance Data Word64 where\n  toConstr x = mkIntegralConstr word64Type x\n  gunfold _ z c = case constrRep c of\n                    (IntConstr x) -> z (fromIntegral x)\n                    _ -> errorWithoutStackTrace $ \"Data.Data.gunfold: Constructor \" ++ show c\n                                 ++ \" is not of type Word64.\"\n  dataTypeOf _ = word64Type\n\n\n------------------------------------------------------------------------------\n\nratioConstr :: Constr\nratioConstr = mkConstr ratioDataType \":%\" [] Infix\n\nratioDataType :: DataType\nratioDataType = mkDataType \"GHC.Real.Ratio\" [ratioConstr]\n\n-- NB: This Data instance intentionally uses the (%) smart constructor instead\n-- of the internal (:%) constructor to preserve the invariant that a Ratio\n-- value is reduced to normal form. See Trac #10011.\n\n-- | @since 4.0.0.0\ninstance (Data a, Integral a) => Data (Ratio a) where\n  gfoldl k z (a :% b) = z (%) `k` a `k` b\n  toConstr _ = ratioConstr\n  gunfold k z c | constrIndex c == 1 = k (k (z (%)))\n  gunfold _ _ _ = errorWithoutStackTrace \"Data.Data.gunfold(Ratio)\"\n  dataTypeOf _  = ratioDataType\n\n\n------------------------------------------------------------------------------\n\nnilConstr :: Constr\nnilConstr    = mkConstr listDataType \"[]\" [] Prefix\nconsConstr :: Constr\nconsConstr   = mkConstr listDataType \"(:)\" [] Infix\n\nlistDataType :: DataType\nlistDataType = mkDataType \"Prelude.[]\" [nilConstr,consConstr]\n\n-- | @since 4.0.0.0\ninstance Data a => Data [a] where\n  gfoldl _ z []     = z []\n  gfoldl f z (x:xs) = z (:) `f` x `f` xs\n  toConstr []    = nilConstr\n  toConstr (_:_) = consConstr\n  gunfold k z c = case constrIndex c of\n                    1 -> z []\n                    2 -> k (k (z (:)))\n                    _ -> errorWithoutStackTrace \"Data.Data.gunfold(List)\"\n  dataTypeOf _ = listDataType\n  dataCast1 f  = gcast1 f\n\n--\n-- The gmaps are given as an illustration.\n-- This shows that the gmaps for lists are different from list maps.\n--\n  gmapT  _   []     = []\n  gmapT  f   (x:xs) = (f x:f xs)\n  gmapQ  _   []     = []\n  gmapQ  f   (x:xs) = [f x,f xs]\n  gmapM  _   []     = return []\n  gmapM  f   (x:xs) = f x >>= \\x' -> f xs >>= \\xs' -> return (x':xs')\n\n\n------------------------------------------------------------------------------\n\n-- | @since 4.9.0.0\nderiving instance Data a => Data (NonEmpty a)\n\n-- | @since 4.0.0.0\nderiving instance Data a => Data (Maybe a)\n\n-- | @since 4.0.0.0\nderiving instance Data Ordering\n\n-- | @since 4.0.0.0\nderiving instance (Data a, Data b) => Data (Either a b)\n\n-- | @since 4.0.0.0\nderiving instance Data ()\n\n-- | @since 4.0.0.0\nderiving instance (Data a, Data b) => Data (a,b)\n\n-- | @since 4.0.0.0\nderiving instance (Data a, Data b, Data c) => Data (a,b,c)\n\n-- | @since 4.0.0.0\nderiving instance (Data a, Data b, Data c, Data d)\n         => Data (a,b,c,d)\n\n-- | @since 4.0.0.0\nderiving instance (Data a, Data b, Data c, Data d, Data e)\n         => Data (a,b,c,d,e)\n\n-- | @since 4.0.0.0\nderiving instance (Data a, Data b, Data c, Data d, Data e, Data f)\n         => Data (a,b,c,d,e,f)\n\n-- | @since 4.0.0.0\nderiving instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)\n         => Data (a,b,c,d,e,f,g)\n\n------------------------------------------------------------------------------\n\n-- | @since 4.8.0.0\ninstance Data a => Data (Ptr a) where\n  toConstr _   = errorWithoutStackTrace \"Data.Data.toConstr(Ptr)\"\n  gunfold _ _  = errorWithoutStackTrace \"Data.Data.gunfold(Ptr)\"\n  dataTypeOf _ = mkNoRepType \"GHC.Ptr.Ptr\"\n  dataCast1 x  = gcast1 x\n\n------------------------------------------------------------------------------\n\n-- | @since 4.8.0.0\ninstance Data a => Data (ForeignPtr a) where\n  toConstr _   = errorWithoutStackTrace \"Data.Data.toConstr(ForeignPtr)\"\n  gunfold _ _  = errorWithoutStackTrace \"Data.Data.gunfold(ForeignPtr)\"\n  dataTypeOf _ = mkNoRepType \"GHC.ForeignPtr.ForeignPtr\"\n  dataCast1 x  = gcast1 x\n\n-- | @since 4.11.0.0\nderiving instance Data IntPtr\n\n-- | @since 4.11.0.0\nderiving instance Data WordPtr\n\n------------------------------------------------------------------------------\n-- The Data instance for Array preserves data abstraction at the cost of\n-- inefficiency. We omit reflection services for the sake of data abstraction.\n-- | @since 4.8.0.0\ninstance (Data a, Data b, Ix a) => Data (Array a b)\n where\n  gfoldl f z a = z (listArray (bounds a)) `f` (elems a)\n  toConstr _   = errorWithoutStackTrace \"Data.Data.toConstr(Array)\"\n  gunfold _ _  = errorWithoutStackTrace \"Data.Data.gunfold(Array)\"\n  dataTypeOf _ = mkNoRepType \"Data.Array.Array\"\n  dataCast2 x  = gcast2 x\n\n----------------------------------------------------------------------------\n-- Data instance for Proxy\n\n-- | @since 4.7.0.0\nderiving instance (Data t) => Data (Proxy t)\n\n-- | @since 4.7.0.0\nderiving instance (a ~ b, Data a) => Data (a :~: b)\n\n-- | @since 4.10.0.0\nderiving instance (Typeable i, Typeable j, Typeable a, Typeable b,\n                    (a :: i) ~~ (b :: j))\n    => Data (a :~~: b)\n\n-- | @since 4.7.0.0\nderiving instance (Coercible a b, Data a, Data b) => Data (Coercion a b)\n\n-- | @since 4.9.0.0\nderiving instance Data a => Data (Identity a)\n\n-- | @since 4.10.0.0\nderiving instance (Typeable k, Data a, Typeable (b :: k)) => Data (Const a b)\n\n-- | @since 4.7.0.0\nderiving instance Data Version\n\n----------------------------------------------------------------------------\n-- Data instances for Data.Monoid wrappers\n\n-- | @since 4.8.0.0\nderiving instance Data a => Data (Dual a)\n\n-- | @since 4.8.0.0\nderiving instance Data All\n\n-- | @since 4.8.0.0\nderiving instance Data Any\n\n-- | @since 4.8.0.0\nderiving instance Data a => Data (Sum a)\n\n-- | @since 4.8.0.0\nderiving instance Data a => Data (Product a)\n\n-- | @since 4.8.0.0\nderiving instance Data a => Data (First a)\n\n-- | @since 4.8.0.0\nderiving instance Data a => Data (Last a)\n\n-- | @since 4.8.0.0\nderiving instance (Data (f a), Data a, Typeable f) => Data (Alt f a)\n\n-- | @since 4.12.0.0\nderiving instance (Data (f a), Data a, Typeable f) => Data (Ap f a)\n\n----------------------------------------------------------------------------\n-- Data instances for GHC.Generics representations\n\n-- | @since 4.9.0.0\nderiving instance Data p => Data (U1 p)\n\n-- | @since 4.9.0.0\nderiving instance Data p => Data (Par1 p)\n\n-- | @since 4.9.0.0\nderiving instance (Data (f p), Typeable f, Data p) => Data (Rec1 f p)\n\n-- | @since 4.9.0.0\nderiving instance (Typeable i, Data p, Data c) => Data (K1 i c p)\n\n-- | @since 4.9.0.0\nderiving instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f)\n    => Data (M1 i c f p)\n\n-- | @since 4.9.0.0\nderiving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))\n    => Data ((f :+: g) p)\n\n-- | @since 4.9.0.0\nderiving instance (Typeable (f :: Type -> Type), Typeable (g :: Type -> Type),\n          Data p, Data (f (g p)))\n    => Data ((f :.: g) p)\n\n-- | @since 4.9.0.0\nderiving instance Data p => Data (V1 p)\n\n-- | @since 4.9.0.0\nderiving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))\n    => Data ((f :*: g) p)\n\n-- | @since 4.9.0.0\nderiving instance Data Generics.Fixity\n\n-- | @since 4.9.0.0\nderiving instance Data Associativity\n\n-- | @since 4.9.0.0\nderiving instance Data SourceUnpackedness\n\n-- | @since 4.9.0.0\nderiving instance Data SourceStrictness\n\n-- | @since 4.9.0.0\nderiving instance Data DecidedStrictness\n\n----------------------------------------------------------------------------\n-- Data instances for Data.Ord\n\n-- | @since 4.12.0.0\nderiving instance Data a => Data (Down a)\n", "num_lines": 1343}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Dynamic\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The Dynamic interface provides basic support for dynamic types.\n--\n-- Operations for injecting values of arbitrary type into\n-- a dynamically typed value, Dynamic, are provided, together\n-- with operations for converting dynamic values into a concrete\n-- (monomorphic) type.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Dynamic\n  (\n\n        -- * The @Dynamic@ type\n        Dynamic(..),\n\n        -- * Converting to and from @Dynamic@\n        toDyn,\n        fromDyn,\n        fromDynamic,\n\n        -- * Applying functions of dynamic type\n        dynApply,\n        dynApp,\n        dynTypeRep,\n\n        -- * Convenience re-exports\n        Typeable\n\n  ) where\n\n\nimport Data.Type.Equality\nimport Type.Reflection\nimport Data.Maybe\n\nimport GHC.Base\nimport GHC.Show\nimport GHC.Exception\n\n-------------------------------------------------------------\n--\n--              The type Dynamic\n--\n-------------------------------------------------------------\n\n{-|\n  A value of type 'Dynamic' is an object encapsulated together with its type.\n\n  A 'Dynamic' may only represent a monomorphic value; an attempt to\n  create a value of type 'Dynamic' from a polymorphically-typed\n  expression will result in an ambiguity error (see 'toDyn').\n\n  'Show'ing a value of type 'Dynamic' returns a pretty-printed representation\n  of the object\\'s type; useful for debugging.\n-}\ndata Dynamic where\n    Dynamic :: forall a. TypeRep a -> a -> Dynamic\n\n-- | @since 2.01\ninstance Show Dynamic where\n   -- the instance just prints the type representation.\n   showsPrec _ (Dynamic t _) =\n          showString \"<<\" .\n          showsPrec 0 t   .\n          showString \">>\"\n\n-- here so that it isn't an orphan:\n-- | @since 4.0.0.0\ninstance Exception Dynamic\n\n -- Use GHC's primitive 'Any' type to hold the dynamically typed value.\n --\n -- In GHC's new eval/apply execution model this type must not look\n -- like a data type.  If it did, GHC would use the constructor convention\n -- when evaluating it, and this will go wrong if the object is really a\n -- function.  Using Any forces GHC to use\n -- a fallback convention for evaluating it that works for all types.\n\n-- | Converts an arbitrary value into an object of type 'Dynamic'.\n--\n-- The type of the object must be an instance of 'Typeable', which\n-- ensures that only monomorphically-typed objects may be converted to\n-- 'Dynamic'.  To convert a polymorphic object into 'Dynamic', give it\n-- a monomorphic type signature.  For example:\n--\n-- >    toDyn (id :: Int -> Int)\n--\ntoDyn :: Typeable a => a -> Dynamic\ntoDyn v = Dynamic typeRep v\n\n-- | Converts a 'Dynamic' object back into an ordinary Haskell value of\n-- the correct type.  See also 'fromDynamic'.\nfromDyn :: Typeable a\n        => Dynamic      -- ^ the dynamically-typed object\n        -> a            -- ^ a default value\n        -> a            -- ^ returns: the value of the first argument, if\n                        -- it has the correct type, otherwise the value of\n                        -- the second argument.\nfromDyn (Dynamic t v) def\n  | Just HRefl <- t `eqTypeRep` typeOf def = v\n  | otherwise                              = def\n\n-- | Converts a 'Dynamic' object back into an ordinary Haskell value of\n-- the correct type.  See also 'fromDyn'.\nfromDynamic\n        :: forall a. Typeable a\n        => Dynamic      -- ^ the dynamically-typed object\n        -> Maybe a      -- ^ returns: @'Just' a@, if the dynamically-typed\n                        -- object has the correct type (and @a@ is its value),\n                        -- or 'Nothing' otherwise.\nfromDynamic (Dynamic t v)\n  | Just HRefl <- t `eqTypeRep` rep = Just v\n  | otherwise                       = Nothing\n  where rep = typeRep :: TypeRep a\n\n-- (f::(a->b)) `dynApply` (x::a) = (f a)::b\ndynApply :: Dynamic -> Dynamic -> Maybe Dynamic\ndynApply (Dynamic (Fun ta tr) f) (Dynamic ta' x)\n  | Just HRefl <- ta `eqTypeRep` ta'\n  , Just HRefl <- typeRep @Type `eqTypeRep` typeRepKind tr\n  = Just (Dynamic tr (f x))\ndynApply _ _\n  = Nothing\n\ndynApp :: Dynamic -> Dynamic -> Dynamic\ndynApp f x = case dynApply f x of\n             Just r -> r\n             Nothing -> errorWithoutStackTrace (\"Type error in dynamic application.\\n\" ++\n                               \"Can't apply function \" ++ show f ++\n                               \" to argument \" ++ show x)\n\ndynTypeRep :: Dynamic -> SomeTypeRep\ndynTypeRep (Dynamic tr _) = SomeTypeRep tr\n", "num_lines": 152}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Either\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The Either type, and associated operations.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Either (\n   Either(..),\n   either,\n   lefts,\n   rights,\n   isLeft,\n   isRight,\n   fromLeft,\n   fromRight,\n   partitionEithers,\n ) where\n\nimport GHC.Base\nimport GHC.Show\nimport GHC.Read\n\n-- $setup\n-- Allow the use of some Prelude functions in doctests.\n-- >>> import Prelude ( (+), (*), length, putStrLn )\n\n{-\n-- just for testing\nimport Test.QuickCheck\n-}\n\n{-|\n\nThe 'Either' type represents values with two possibilities: a value of\ntype @'Either' a b@ is either @'Left' a@ or @'Right' b@.\n\nThe 'Either' type is sometimes used to represent a value which is\neither correct or an error; by convention, the 'Left' constructor is\nused to hold an error value and the 'Right' constructor is used to\nhold a correct value (mnemonic: \\\"right\\\" also means \\\"correct\\\").\n\n==== __Examples__\n\nThe type @'Either' 'String' 'Int'@ is the type of values which can be either\na 'String' or an 'Int'. The 'Left' constructor can be used only on\n'String's, and the 'Right' constructor can be used only on 'Int's:\n\n>>> let s = Left \"foo\" :: Either String Int\n>>> s\nLeft \"foo\"\n>>> let n = Right 3 :: Either String Int\n>>> n\nRight 3\n>>> :type s\ns :: Either String Int\n>>> :type n\nn :: Either String Int\n\nThe 'fmap' from our 'Functor' instance will ignore 'Left' values, but\nwill apply the supplied function to values contained in a 'Right':\n\n>>> let s = Left \"foo\" :: Either String Int\n>>> let n = Right 3 :: Either String Int\n>>> fmap (*2) s\nLeft \"foo\"\n>>> fmap (*2) n\nRight 6\n\nThe 'Monad' instance for 'Either' allows us to chain together multiple\nactions which may fail, and fail overall if any of the individual\nsteps failed. First we'll write a function that can either parse an\n'Int' from a 'Char', or fail.\n\n>>> import Data.Char ( digitToInt, isDigit )\n>>> :{\n    let parseEither :: Char -> Either String Int\n        parseEither c\n          | isDigit c = Right (digitToInt c)\n          | otherwise = Left \"parse error\"\n>>> :}\n\nThe following should work, since both @\\'1\\'@ and @\\'2\\'@ can be\nparsed as 'Int's.\n\n>>> :{\n    let parseMultiple :: Either String Int\n        parseMultiple = do\n          x <- parseEither '1'\n          y <- parseEither '2'\n          return (x + y)\n>>> :}\n\n>>> parseMultiple\nRight 3\n\nBut the following should fail overall, since the first operation where\nwe attempt to parse @\\'m\\'@ as an 'Int' will fail:\n\n>>> :{\n    let parseMultiple :: Either String Int\n        parseMultiple = do\n          x <- parseEither 'm'\n          y <- parseEither '2'\n          return (x + y)\n>>> :}\n\n>>> parseMultiple\nLeft \"parse error\"\n\n-}\ndata  Either a b  =  Left a | Right b\n  deriving ( Eq   -- ^ @since 2.01\n           , Ord  -- ^ @since 2.01\n           , Read -- ^ @since 3.0\n           , Show -- ^ @since 3.0\n           )\n\n-- | @since 3.0\ninstance Functor (Either a) where\n    fmap _ (Left x) = Left x\n    fmap f (Right y) = Right (f y)\n\n-- | @since 4.9.0.0\ninstance Semigroup (Either a b) where\n    Left _ <> b = b\n    a      <> _ = a\n#if !defined(__HADDOCK_VERSION__)\n    -- workaround https://github.com/haskell/haddock/issues/680\n    stimes n x\n      | n <= 0 = errorWithoutStackTrace \"stimes: positive multiplier expected\"\n      | otherwise = x\n#endif\n\n-- | @since 3.0\ninstance Applicative (Either e) where\n    pure          = Right\n    Left  e <*> _ = Left e\n    Right f <*> r = fmap f r\n\n-- | @since 4.4.0.0\ninstance Monad (Either e) where\n    Left  l >>= _ = Left l\n    Right r >>= k = k r\n\n-- | Case analysis for the 'Either' type.\n-- If the value is @'Left' a@, apply the first function to @a@;\n-- if it is @'Right' b@, apply the second function to @b@.\n--\n-- ==== __Examples__\n--\n-- We create two values of type @'Either' 'String' 'Int'@, one using the\n-- 'Left' constructor and another using the 'Right' constructor. Then\n-- we apply \\\"either\\\" the 'Prelude.length' function (if we have a 'String')\n-- or the \\\"times-two\\\" function (if we have an 'Int'):\n--\n-- >>> let s = Left \"foo\" :: Either String Int\n-- >>> let n = Right 3 :: Either String Int\n-- >>> either length (*2) s\n-- 3\n-- >>> either length (*2) n\n-- 6\n--\neither                  :: (a -> c) -> (b -> c) -> Either a b -> c\neither f _ (Left x)     =  f x\neither _ g (Right y)    =  g y\n\n\n-- | Extracts from a list of 'Either' all the 'Left' elements.\n-- All the 'Left' elements are extracted in order.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> let list = [ Left \"foo\", Right 3, Left \"bar\", Right 7, Left \"baz\" ]\n-- >>> lefts list\n-- [\"foo\",\"bar\",\"baz\"]\n--\nlefts   :: [Either a b] -> [a]\nlefts x = [a | Left a <- x]\n{-# INLINEABLE lefts #-} -- otherwise doesn't get an unfolding, see #13689\n\n-- | Extracts from a list of 'Either' all the 'Right' elements.\n-- All the 'Right' elements are extracted in order.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> let list = [ Left \"foo\", Right 3, Left \"bar\", Right 7, Left \"baz\" ]\n-- >>> rights list\n-- [3,7]\n--\nrights   :: [Either a b] -> [b]\nrights x = [a | Right a <- x]\n{-# INLINEABLE rights #-} -- otherwise doesn't get an unfolding, see #13689\n\n-- | Partitions a list of 'Either' into two lists.\n-- All the 'Left' elements are extracted, in order, to the first\n-- component of the output.  Similarly the 'Right' elements are extracted\n-- to the second component of the output.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> let list = [ Left \"foo\", Right 3, Left \"bar\", Right 7, Left \"baz\" ]\n-- >>> partitionEithers list\n-- ([\"foo\",\"bar\",\"baz\"],[3,7])\n--\n-- The pair returned by @'partitionEithers' x@ should be the same\n-- pair as @('lefts' x, 'rights' x)@:\n--\n-- >>> let list = [ Left \"foo\", Right 3, Left \"bar\", Right 7, Left \"baz\" ]\n-- >>> partitionEithers list == (lefts list, rights list)\n-- True\n--\npartitionEithers :: [Either a b] -> ([a],[b])\npartitionEithers = foldr (either left right) ([],[])\n where\n  left  a ~(l, r) = (a:l, r)\n  right a ~(l, r) = (l, a:r)\n\n-- | Return `True` if the given value is a `Left`-value, `False` otherwise.\n--\n-- @since 4.7.0.0\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isLeft (Left \"foo\")\n-- True\n-- >>> isLeft (Right 3)\n-- False\n--\n-- Assuming a 'Left' value signifies some sort of error, we can use\n-- 'isLeft' to write a very simple error-reporting function that does\n-- absolutely nothing in the case of success, and outputs \\\"ERROR\\\" if\n-- any error occurred.\n--\n-- This example shows how 'isLeft' might be used to avoid pattern\n-- matching when one does not care about the value contained in the\n-- constructor:\n--\n-- >>> import Control.Monad ( when )\n-- >>> let report e = when (isLeft e) $ putStrLn \"ERROR\"\n-- >>> report (Right 1)\n-- >>> report (Left \"parse error\")\n-- ERROR\n--\nisLeft :: Either a b -> Bool\nisLeft (Left  _) = True\nisLeft (Right _) = False\n\n-- | Return `True` if the given value is a `Right`-value, `False` otherwise.\n--\n-- @since 4.7.0.0\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isRight (Left \"foo\")\n-- False\n-- >>> isRight (Right 3)\n-- True\n--\n-- Assuming a 'Left' value signifies some sort of error, we can use\n-- 'isRight' to write a very simple reporting function that only\n-- outputs \\\"SUCCESS\\\" when a computation has succeeded.\n--\n-- This example shows how 'isRight' might be used to avoid pattern\n-- matching when one does not care about the value contained in the\n-- constructor:\n--\n-- >>> import Control.Monad ( when )\n-- >>> let report e = when (isRight e) $ putStrLn \"SUCCESS\"\n-- >>> report (Left \"parse error\")\n-- >>> report (Right 1)\n-- SUCCESS\n--\nisRight :: Either a b -> Bool\nisRight (Left  _) = False\nisRight (Right _) = True\n\n-- | Return the contents of a 'Left'-value or a default value otherwise.\n--\n-- @since 4.10.0.0\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> fromLeft 1 (Left 3)\n-- 3\n-- >>> fromLeft 1 (Right \"foo\")\n-- 1\n--\nfromLeft :: a -> Either a b -> a\nfromLeft _ (Left a) = a\nfromLeft a _        = a\n\n-- | Return the contents of a 'Right'-value or a default value otherwise.\n--\n-- @since 4.10.0.0\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> fromRight 1 (Right 3)\n-- 3\n-- >>> fromRight 1 (Left \"foo\")\n-- 1\n--\nfromRight :: b -> Either a b -> b\nfromRight _ (Right b) = b\nfromRight b _         = b\n\n{-\n{--------------------------------------------------------------------\n  Testing\n--------------------------------------------------------------------}\nprop_partitionEithers :: [Either Int Int] -> Bool\nprop_partitionEithers x =\n  partitionEithers x == (lefts x, rights x)\n-}\n", "num_lines": 343}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Eq\n-- Copyright   :  (c) The University of Glasgow 2005\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- Equality\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Eq (\n   Eq(..),\n ) where\n\nimport GHC.Base\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Fixed\n-- Copyright   :  (c) Ashley Yakeley 2005, 2006, 2009\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  Ashley Yakeley <ashley@semantic.org>\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- This module defines a \\\"Fixed\\\" type for fixed-precision arithmetic.\n-- The parameter to 'Fixed' is any type that's an instance of 'HasResolution'.\n-- 'HasResolution' has a single method that gives the resolution of the 'Fixed'\n-- type.\n--\n-- This module also contains generalisations of 'div', 'mod', and 'divMod' to\n-- work with any 'Real' instance.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Fixed\n(\n    div',mod',divMod',\n\n    Fixed(..), HasResolution(..),\n    showFixed,\n    E0,Uni,\n    E1,Deci,\n    E2,Centi,\n    E3,Milli,\n    E6,Micro,\n    E9,Nano,\n    E12,Pico\n) where\n\nimport Data.Data\nimport GHC.Read\nimport Text.ParserCombinators.ReadPrec\nimport Text.Read.Lex\n\ndefault () -- avoid any defaulting shenanigans\n\n-- | generalisation of 'div' to any instance of 'Real'\ndiv' :: (Real a,Integral b) => a -> a -> b\ndiv' n d = floor ((toRational n) / (toRational d))\n\n-- | generalisation of 'divMod' to any instance of 'Real'\ndivMod' :: (Real a,Integral b) => a -> a -> (b,a)\ndivMod' n d = (f,n - (fromIntegral f) * d) where\n    f = div' n d\n\n-- | generalisation of 'mod' to any instance of 'Real'\nmod' :: (Real a) => a -> a -> a\nmod' n d = n - (fromInteger f) * d where\n    f = div' n d\n\n-- | The type parameter should be an instance of 'HasResolution'.\nnewtype Fixed a = MkFixed Integer\n        deriving ( Eq  -- ^ @since 2.01\n                 , Ord -- ^ @since 2.01\n                 )\n\n-- We do this because the automatically derived Data instance requires (Data a) context.\n-- Our manual instance has the more general (Typeable a) context.\ntyFixed :: DataType\ntyFixed = mkDataType \"Data.Fixed.Fixed\" [conMkFixed]\nconMkFixed :: Constr\nconMkFixed = mkConstr tyFixed \"MkFixed\" [] Prefix\n\n-- | @since 4.1.0.0\ninstance (Typeable a) => Data (Fixed a) where\n    gfoldl k z (MkFixed a) = k (z MkFixed) a\n    gunfold k z _ = k (z MkFixed)\n    dataTypeOf _ = tyFixed\n    toConstr _ = conMkFixed\n\nclass HasResolution a where\n    resolution :: p a -> Integer\n\nwithType :: (p a -> f a) -> f a\nwithType foo = foo undefined\n\nwithResolution :: (HasResolution a) => (Integer -> f a) -> f a\nwithResolution foo = withType (foo . resolution)\n\n-- | @since 2.01\ninstance Enum (Fixed a) where\n    succ (MkFixed a) = MkFixed (succ a)\n    pred (MkFixed a) = MkFixed (pred a)\n    toEnum = MkFixed . toEnum\n    fromEnum (MkFixed a) = fromEnum a\n    enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)\n    enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)\n    enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)\n    enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)\n\n-- | @since 2.01\ninstance (HasResolution a) => Num (Fixed a) where\n    (MkFixed a) + (MkFixed b) = MkFixed (a + b)\n    (MkFixed a) - (MkFixed b) = MkFixed (a - b)\n    fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (resolution fa))\n    negate (MkFixed a) = MkFixed (negate a)\n    abs (MkFixed a) = MkFixed (abs a)\n    signum (MkFixed a) = fromInteger (signum a)\n    fromInteger i = withResolution (\\res -> MkFixed (i * res))\n\n-- | @since 2.01\ninstance (HasResolution a) => Real (Fixed a) where\n    toRational fa@(MkFixed a) = (toRational a) / (toRational (resolution fa))\n\n-- | @since 2.01\ninstance (HasResolution a) => Fractional (Fixed a) where\n    fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (resolution fa)) b)\n    recip fa@(MkFixed a) = MkFixed (div (res * res) a) where\n        res = resolution fa\n    fromRational r = withResolution (\\res -> MkFixed (floor (r * (toRational res))))\n\n-- | @since 2.01\ninstance (HasResolution a) => RealFrac (Fixed a) where\n    properFraction a = (i,a - (fromIntegral i)) where\n        i = truncate a\n    truncate f = truncate (toRational f)\n    round f = round (toRational f)\n    ceiling f = ceiling (toRational f)\n    floor f = floor (toRational f)\n\nchopZeros :: Integer -> String\nchopZeros 0 = \"\"\nchopZeros a | mod a 10 == 0 = chopZeros (div a 10)\nchopZeros a = show a\n\n-- only works for positive a\nshowIntegerZeros :: Bool -> Int -> Integer -> String\nshowIntegerZeros True _ 0 = \"\"\nshowIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where\n    s = show a\n    s' = if chopTrailingZeros then chopZeros a else s\n\nwithDot :: String -> String\nwithDot \"\" = \"\"\nwithDot s = '.':s\n\n-- | First arg is whether to chop off trailing zeros\nshowFixed :: (HasResolution a) => Bool -> Fixed a -> String\nshowFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = \"-\" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa))\nshowFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where\n    res = resolution fa\n    (i,d) = divMod a res\n    -- enough digits to be unambiguous\n    digits = ceiling (logBase 10 (fromInteger res) :: Double)\n    maxnum = 10 ^ digits\n    -- read floors, so show must ceil for `read . show = id` to hold. See #9240\n    fracNum = divCeil (d * maxnum) res\n    divCeil x y = (x + y - 1) `div` y\n\n-- | @since 2.01\ninstance (HasResolution a) => Show (Fixed a) where\n    showsPrec p n = showParen (p > 6 && n < 0) $ showString $ showFixed False n\n\n-- | @since 4.3.0.0\ninstance (HasResolution a) => Read (Fixed a) where\n    readPrec     = readNumber convertFixed\n    readListPrec = readListPrecDefault\n    readList     = readListDefault\n\nconvertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a)\nconvertFixed (Number n)\n | Just (i, f) <- numberToFixed e n =\n    return (fromInteger i + (fromInteger f / (10 ^ e)))\n    where r = resolution (undefined :: Fixed a)\n          -- round 'e' up to help make the 'read . show == id' property\n          -- possible also for cases where 'resolution' is not a\n          -- power-of-10, such as e.g. when 'resolution = 128'\n          e = ceiling (logBase 10 (fromInteger r) :: Double)\nconvertFixed _ = pfail\n\ndata E0\n\n-- | @since 4.1.0.0\ninstance HasResolution E0 where\n    resolution _ = 1\n-- | resolution of 1, this works the same as Integer\ntype Uni = Fixed E0\n\ndata E1\n\n-- | @since 4.1.0.0\ninstance HasResolution E1 where\n    resolution _ = 10\n-- | resolution of 10^-1 = .1\ntype Deci = Fixed E1\n\ndata E2\n\n-- | @since 4.1.0.0\ninstance HasResolution E2 where\n    resolution _ = 100\n-- | resolution of 10^-2 = .01, useful for many monetary currencies\ntype Centi = Fixed E2\n\ndata E3\n\n-- | @since 4.1.0.0\ninstance HasResolution E3 where\n    resolution _ = 1000\n-- | resolution of 10^-3 = .001\ntype Milli = Fixed E3\n\ndata E6\n\n-- | @since 2.01\ninstance HasResolution E6 where\n    resolution _ = 1000000\n-- | resolution of 10^-6 = .000001\ntype Micro = Fixed E6\n\ndata E9\n\n-- | @since 4.1.0.0\ninstance HasResolution E9 where\n    resolution _ = 1000000000\n-- | resolution of 10^-9 = .000000001\ntype Nano = Fixed E9\n\ndata E12\n\n-- | @since 2.01\ninstance HasResolution E12 where\n    resolution _ = 1000000000000\n-- | resolution of 10^-12 = .000000000001\ntype Pico = Fixed E12\n", "num_lines": 235}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFoldable #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeOperators #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Foldable\n-- Copyright   :  Ross Paterson 2005\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Class of data structures that can be folded to a summary value.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Foldable (\n    Foldable(..),\n    -- * Special biased folds\n    foldrM,\n    foldlM,\n    -- * Folding actions\n    -- ** Applicative actions\n    traverse_,\n    for_,\n    sequenceA_,\n    asum,\n    -- ** Monadic actions\n    mapM_,\n    forM_,\n    sequence_,\n    msum,\n    -- * Specialized folds\n    concat,\n    concatMap,\n    and,\n    or,\n    any,\n    all,\n    maximumBy,\n    minimumBy,\n    -- * Searches\n    notElem,\n    find\n    ) where\n\nimport Data.Bool\nimport Data.Either\nimport Data.Eq\nimport Data.Functor.Utils (Max(..), Min(..), (#.))\nimport qualified GHC.List as List\nimport Data.Maybe\nimport Data.Monoid\nimport Data.Ord\nimport Data.Proxy\n\nimport GHC.Arr  ( Array(..), elems, numElements,\n                  foldlElems, foldrElems,\n                  foldlElems', foldrElems',\n                  foldl1Elems, foldr1Elems)\nimport GHC.Base hiding ( foldr )\nimport GHC.Generics\nimport GHC.Num  ( Num(..) )\n\ninfix  4 `elem`, `notElem`\n\n-- | Data structures that can be folded.\n--\n-- For example, given a data type\n--\n-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)\n--\n-- a suitable instance would be\n--\n-- > instance Foldable Tree where\n-- >    foldMap f Empty = mempty\n-- >    foldMap f (Leaf x) = f x\n-- >    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r\n--\n-- This is suitable even for abstract types, as the monoid is assumed\n-- to satisfy the monoid laws.  Alternatively, one could define @foldr@:\n--\n-- > instance Foldable Tree where\n-- >    foldr f z Empty = z\n-- >    foldr f z (Leaf x) = f x z\n-- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l\n--\n-- @Foldable@ instances are expected to satisfy the following laws:\n--\n-- > foldr f z t = appEndo (foldMap (Endo . f) t ) z\n--\n-- > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z\n--\n-- > fold = foldMap id\n--\n-- > length = getSum . foldMap (Sum . const  1)\n--\n-- @sum@, @product@, @maximum@, and @minimum@ should all be essentially\n-- equivalent to @foldMap@ forms, such as\n--\n-- > sum = getSum . foldMap Sum\n--\n-- but may be less defined.\n--\n-- If the type is also a 'Functor' instance, it should satisfy\n--\n-- > foldMap f = fold . fmap f\n--\n-- which implies that\n--\n-- > foldMap f . fmap g = foldMap (f . g)\n\nclass Foldable t where\n    {-# MINIMAL foldMap | foldr #-}\n\n    -- | Combine the elements of a structure using a monoid.\n    fold :: Monoid m => t m -> m\n    fold = foldMap id\n\n    -- | Map each element of the structure to a monoid,\n    -- and combine the results.\n    foldMap :: Monoid m => (a -> m) -> t a -> m\n    {-# INLINE foldMap #-}\n    -- This INLINE allows more list functions to fuse. See Trac #9848.\n    foldMap f = foldr (mappend . f) mempty\n\n    -- | A variant of 'foldMap' that is strict in the accumulator.\n    --\n    -- @since 4.13.0.0\n    foldMap' :: Monoid m => (a -> m) -> t a -> m\n    foldMap' f = foldl' (\\ acc a -> acc <> f a) mempty\n\n    -- | Right-associative fold of a structure.\n    --\n    -- In the case of lists, 'foldr', when applied to a binary operator, a\n    -- starting value (typically the right-identity of the operator), and a\n    -- list, reduces the list using the binary operator, from right to left:\n    --\n    -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)\n    --\n    -- Note that, since the head of the resulting expression is produced by\n    -- an application of the operator to the first element of the list,\n    -- 'foldr' can produce a terminating expression from an infinite list.\n    --\n    -- For a general 'Foldable' structure this should be semantically identical\n    -- to,\n    --\n    -- @foldr f z = 'List.foldr' f z . 'toList'@\n    --\n    foldr :: (a -> b -> b) -> b -> t a -> b\n    foldr f z t = appEndo (foldMap (Endo #. f) t) z\n\n    -- | Right-associative fold of a structure, but with strict application of\n    -- the operator.\n    --\n    -- @since 4.6.0.0\n    foldr' :: (a -> b -> b) -> b -> t a -> b\n    foldr' f z0 xs = foldl f' id xs z0\n      where f' k x z = k $! f x z\n\n    -- | Left-associative fold of a structure.\n    --\n    -- In the case of lists, 'foldl', when applied to a binary\n    -- operator, a starting value (typically the left-identity of the operator),\n    -- and a list, reduces the list using the binary operator, from left to\n    -- right:\n    --\n    -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn\n    --\n    -- Note that to produce the outermost application of the operator the\n    -- entire input list must be traversed. This means that 'foldl'' will\n    -- diverge if given an infinite list.\n    --\n    -- Also note that if you want an efficient left-fold, you probably want to\n    -- use 'foldl'' instead of 'foldl'. The reason for this is that latter does\n    -- not force the \"inner\" results (e.g. @z \\`f\\` x1@ in the above example)\n    -- before applying them to the operator (e.g. to @(\\`f\\` x2)@). This results\n    -- in a thunk chain @O(n)@ elements long, which then must be evaluated from\n    -- the outside-in.\n    --\n    -- For a general 'Foldable' structure this should be semantically identical\n    -- to,\n    --\n    -- @foldl f z = 'List.foldl' f z . 'toList'@\n    --\n    foldl :: (b -> a -> b) -> b -> t a -> b\n    foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z\n    -- There's no point mucking around with coercions here,\n    -- because flip forces us to build a new function anyway.\n\n    -- | Left-associative fold of a structure but with strict application of\n    -- the operator.\n    --\n    -- This ensures that each step of the fold is forced to weak head normal\n    -- form before being applied, avoiding the collection of thunks that would\n    -- otherwise occur. This is often what you want to strictly reduce a finite\n    -- list to a single, monolithic result (e.g. 'length').\n    --\n    -- For a general 'Foldable' structure this should be semantically identical\n    -- to,\n    --\n    -- @foldl' f z = 'List.foldl'' f z . 'toList'@\n    --\n    -- @since 4.6.0.0\n    foldl' :: (b -> a -> b) -> b -> t a -> b\n    foldl' f z0 xs = foldr f' id xs z0\n      where f' x k z = k $! f z x\n\n    -- | A variant of 'foldr' that has no base case,\n    -- and thus may only be applied to non-empty structures.\n    --\n    -- @'foldr1' f = 'List.foldr1' f . 'toList'@\n    foldr1 :: (a -> a -> a) -> t a -> a\n    foldr1 f xs = fromMaybe (errorWithoutStackTrace \"foldr1: empty structure\")\n                    (foldr mf Nothing xs)\n      where\n        mf x m = Just (case m of\n                         Nothing -> x\n                         Just y  -> f x y)\n\n    -- | A variant of 'foldl' that has no base case,\n    -- and thus may only be applied to non-empty structures.\n    --\n    -- @'foldl1' f = 'List.foldl1' f . 'toList'@\n    foldl1 :: (a -> a -> a) -> t a -> a\n    foldl1 f xs = fromMaybe (errorWithoutStackTrace \"foldl1: empty structure\")\n                    (foldl mf Nothing xs)\n      where\n        mf m y = Just (case m of\n                         Nothing -> y\n                         Just x  -> f x y)\n\n    -- | List of elements of a structure, from left to right.\n    --\n    -- @since 4.8.0.0\n    toList :: t a -> [a]\n    {-# INLINE toList #-}\n    toList t = build (\\ c n -> foldr c n t)\n\n    -- | Test whether the structure is empty. The default implementation is\n    -- optimized for structures that are similar to cons-lists, because there\n    -- is no general way to do better.\n    --\n    -- @since 4.8.0.0\n    null :: t a -> Bool\n    null = foldr (\\_ _ -> False) True\n\n    -- | Returns the size/length of a finite structure as an 'Int'.  The\n    -- default implementation is optimized for structures that are similar to\n    -- cons-lists, because there is no general way to do better.\n    --\n    -- @since 4.8.0.0\n    length :: t a -> Int\n    length = foldl' (\\c _ -> c+1) 0\n\n    -- | Does the element occur in the structure?\n    --\n    -- @since 4.8.0.0\n    elem :: Eq a => a -> t a -> Bool\n    elem = any . (==)\n\n    -- | The largest element of a non-empty structure.\n    --\n    -- @since 4.8.0.0\n    maximum :: forall a . Ord a => t a -> a\n    maximum = fromMaybe (errorWithoutStackTrace \"maximum: empty structure\") .\n       getMax . foldMap (Max #. (Just :: a -> Maybe a))\n\n    -- | The least element of a non-empty structure.\n    --\n    -- @since 4.8.0.0\n    minimum :: forall a . Ord a => t a -> a\n    minimum = fromMaybe (errorWithoutStackTrace \"minimum: empty structure\") .\n       getMin . foldMap (Min #. (Just :: a -> Maybe a))\n\n    -- | The 'sum' function computes the sum of the numbers of a structure.\n    --\n    -- @since 4.8.0.0\n    sum :: Num a => t a -> a\n    sum = getSum #. foldMap Sum\n\n    -- | The 'product' function computes the product of the numbers of a\n    -- structure.\n    --\n    -- @since 4.8.0.0\n    product :: Num a => t a -> a\n    product = getProduct #. foldMap Product\n\n-- instances for Prelude types\n\n-- | @since 2.01\ninstance Foldable Maybe where\n    foldMap = maybe mempty\n\n    foldr _ z Nothing = z\n    foldr f z (Just x) = f x z\n\n    foldl _ z Nothing = z\n    foldl f z (Just x) = f z x\n\n-- | @since 2.01\ninstance Foldable [] where\n    elem    = List.elem\n    foldl   = List.foldl\n    foldl'  = List.foldl'\n    foldl1  = List.foldl1\n    foldr   = List.foldr\n    foldr1  = List.foldr1\n    length  = List.length\n    maximum = List.maximum\n    minimum = List.minimum\n    null    = List.null\n    product = List.product\n    sum     = List.sum\n    toList  = id\n\n-- | @since 4.9.0.0\ninstance Foldable NonEmpty where\n  foldr f z ~(a :| as) = f a (List.foldr f z as)\n  foldl f z (a :| as) = List.foldl f (f z a) as\n  foldl1 f (a :| as) = List.foldl f a as\n\n  -- GHC isn't clever enough to transform the default definition\n  -- into anything like this, so we'd end up shuffling a bunch of\n  -- Maybes around.\n  foldr1 f (p :| ps) = foldr go id ps p\n    where\n      go x r prev = f prev (r x)\n\n  -- We used to say\n  --\n  --   length (_ :| as) = 1 + length as\n  --\n  -- but the default definition is better, counting from 1.\n  --\n  -- The default definition also works great for null and foldl'.\n  -- As usual for cons lists, foldr' is basically hopeless.\n\n  foldMap f ~(a :| as) = f a `mappend` foldMap f as\n  fold ~(m :| ms) = m `mappend` fold ms\n  toList ~(a :| as) = a : as\n\n-- | @since 4.7.0.0\ninstance Foldable (Either a) where\n    foldMap _ (Left _) = mempty\n    foldMap f (Right y) = f y\n\n    foldr _ z (Left _) = z\n    foldr f z (Right y) = f y z\n\n    length (Left _)  = 0\n    length (Right _) = 1\n\n    null             = isLeft\n\n-- | @since 4.7.0.0\ninstance Foldable ((,) a) where\n    foldMap f (_, y) = f y\n\n    foldr f z (_, y) = f y z\n\n-- | @since 4.8.0.0\ninstance Foldable (Array i) where\n    foldr = foldrElems\n    foldl = foldlElems\n    foldl' = foldlElems'\n    foldr' = foldrElems'\n    foldl1 = foldl1Elems\n    foldr1 = foldr1Elems\n    toList = elems\n    length = numElements\n    null a = numElements a == 0\n\n-- | @since 4.7.0.0\ninstance Foldable Proxy where\n    foldMap _ _ = mempty\n    {-# INLINE foldMap #-}\n    fold _ = mempty\n    {-# INLINE fold #-}\n    foldr _ z _ = z\n    {-# INLINE foldr #-}\n    foldl _ z _ = z\n    {-# INLINE foldl #-}\n    foldl1 _ _ = errorWithoutStackTrace \"foldl1: Proxy\"\n    foldr1 _ _ = errorWithoutStackTrace \"foldr1: Proxy\"\n    length _   = 0\n    null _     = True\n    elem _ _   = False\n    sum _      = 0\n    product _  = 1\n\n-- | @since 4.8.0.0\ninstance Foldable Dual where\n    foldMap            = coerce\n\n    elem               = (. getDual) #. (==)\n    foldl              = coerce\n    foldl'             = coerce\n    foldl1 _           = getDual\n    foldr f z (Dual x) = f x z\n    foldr'             = foldr\n    foldr1 _           = getDual\n    length _           = 1\n    maximum            = getDual\n    minimum            = getDual\n    null _             = False\n    product            = getDual\n    sum                = getDual\n    toList (Dual x)    = [x]\n\n-- | @since 4.8.0.0\ninstance Foldable Sum where\n    foldMap            = coerce\n\n    elem               = (. getSum) #. (==)\n    foldl              = coerce\n    foldl'             = coerce\n    foldl1 _           = getSum\n    foldr f z (Sum x)  = f x z\n    foldr'             = foldr\n    foldr1 _           = getSum\n    length _           = 1\n    maximum            = getSum\n    minimum            = getSum\n    null _             = False\n    product            = getSum\n    sum                = getSum\n    toList (Sum x)     = [x]\n\n-- | @since 4.8.0.0\ninstance Foldable Product where\n    foldMap               = coerce\n\n    elem                  = (. getProduct) #. (==)\n    foldl                 = coerce\n    foldl'                = coerce\n    foldl1 _              = getProduct\n    foldr f z (Product x) = f x z\n    foldr'                = foldr\n    foldr1 _              = getProduct\n    length _              = 1\n    maximum               = getProduct\n    minimum               = getProduct\n    null _                = False\n    product               = getProduct\n    sum                   = getProduct\n    toList (Product x)    = [x]\n\n-- | @since 4.8.0.0\ninstance Foldable First where\n    foldMap f = foldMap f . getFirst\n\n-- | @since 4.8.0.0\ninstance Foldable Last where\n    foldMap f = foldMap f . getLast\n\n-- | @since 4.12.0.0\ninstance (Foldable f) => Foldable (Alt f) where\n    foldMap f = foldMap f . getAlt\n\n-- | @since 4.12.0.0\ninstance (Foldable f) => Foldable (Ap f) where\n    foldMap f = foldMap f . getAp\n\n-- Instances for GHC.Generics\n-- | @since 4.9.0.0\ninstance Foldable U1 where\n    foldMap _ _ = mempty\n    {-# INLINE foldMap #-}\n    fold _ = mempty\n    {-# INLINE fold #-}\n    foldr _ z _ = z\n    {-# INLINE foldr #-}\n    foldl _ z _ = z\n    {-# INLINE foldl #-}\n    foldl1 _ _ = errorWithoutStackTrace \"foldl1: U1\"\n    foldr1 _ _ = errorWithoutStackTrace \"foldr1: U1\"\n    length _   = 0\n    null _     = True\n    elem _ _   = False\n    sum _      = 0\n    product _  = 1\n\n-- | @since 4.9.0.0\nderiving instance Foldable V1\n\n-- | @since 4.9.0.0\nderiving instance Foldable Par1\n\n-- | @since 4.9.0.0\nderiving instance Foldable f => Foldable (Rec1 f)\n\n-- | @since 4.9.0.0\nderiving instance Foldable (K1 i c)\n\n-- | @since 4.9.0.0\nderiving instance Foldable f => Foldable (M1 i c f)\n\n-- | @since 4.9.0.0\nderiving instance (Foldable f, Foldable g) => Foldable (f :+: g)\n\n-- | @since 4.9.0.0\nderiving instance (Foldable f, Foldable g) => Foldable (f :*: g)\n\n-- | @since 4.9.0.0\nderiving instance (Foldable f, Foldable g) => Foldable (f :.: g)\n\n-- | @since 4.9.0.0\nderiving instance Foldable UAddr\n\n-- | @since 4.9.0.0\nderiving instance Foldable UChar\n\n-- | @since 4.9.0.0\nderiving instance Foldable UDouble\n\n-- | @since 4.9.0.0\nderiving instance Foldable UFloat\n\n-- | @since 4.9.0.0\nderiving instance Foldable UInt\n\n-- | @since 4.9.0.0\nderiving instance Foldable UWord\n\n-- Instances for Data.Ord\n-- | @since 4.12.0.0\nderiving instance Foldable Down\n\n-- | Monadic fold over the elements of a structure,\n-- associating to the right, i.e. from right to left.\nfoldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b\nfoldrM f z0 xs = foldl c return xs z0\n  -- See Note [List fusion and continuations in 'c']\n  where c k x z = f x z >>= k\n        {-# INLINE c #-}\n\n-- | Monadic fold over the elements of a structure,\n-- associating to the left, i.e. from left to right.\nfoldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b\nfoldlM f z0 xs = foldr c return xs z0\n  -- See Note [List fusion and continuations in 'c']\n  where c x k z = f z x >>= k\n        {-# INLINE c #-}\n\n-- | Map each element of a structure to an action, evaluate these\n-- actions from left to right, and ignore the results. For a version\n-- that doesn't ignore the results see 'Data.Traversable.traverse'.\ntraverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()\ntraverse_ f = foldr c (pure ())\n  -- See Note [List fusion and continuations in 'c']\n  where c x k = f x *> k\n        {-# INLINE c #-}\n\n-- | 'for_' is 'traverse_' with its arguments flipped. For a version\n-- that doesn't ignore the results see 'Data.Traversable.for'.\n--\n-- >>> for_ [1..4] print\n-- 1\n-- 2\n-- 3\n-- 4\nfor_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()\n{-# INLINE for_ #-}\nfor_ = flip traverse_\n\n-- | Map each element of a structure to a monadic action, evaluate\n-- these actions from left to right, and ignore the results. For a\n-- version that doesn't ignore the results see\n-- 'Data.Traversable.mapM'.\n--\n-- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to\n-- 'Monad'.\nmapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()\nmapM_ f = foldr c (return ())\n  -- See Note [List fusion and continuations in 'c']\n  where c x k = f x >> k\n        {-# INLINE c #-}\n\n-- | 'forM_' is 'mapM_' with its arguments flipped. For a version that\n-- doesn't ignore the results see 'Data.Traversable.forM'.\n--\n-- As of base 4.8.0.0, 'forM_' is just 'for_', specialized to 'Monad'.\nforM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()\n{-# INLINE forM_ #-}\nforM_ = flip mapM_\n\n-- | Evaluate each action in the structure from left to right, and\n-- ignore the results. For a version that doesn't ignore the results\n-- see 'Data.Traversable.sequenceA'.\nsequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()\nsequenceA_ = foldr c (pure ())\n  -- See Note [List fusion and continuations in 'c']\n  where c m k = m *> k\n        {-# INLINE c #-}\n\n-- | Evaluate each monadic action in the structure from left to right,\n-- and ignore the results. For a version that doesn't ignore the\n-- results see 'Data.Traversable.sequence'.\n--\n-- As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized\n-- to 'Monad'.\nsequence_ :: (Foldable t, Monad m) => t (m a) -> m ()\nsequence_ = foldr c (return ())\n  -- See Note [List fusion and continuations in 'c']\n  where c m k = m >> k\n        {-# INLINE c #-}\n\n-- | The sum of a collection of actions, generalizing 'concat'.\n--\n-- >>> asum [Just \"Hello\", Nothing, Just \"World\"]\n-- Just \"Hello\"\nasum :: (Foldable t, Alternative f) => t (f a) -> f a\n{-# INLINE asum #-}\nasum = foldr (<|>) empty\n\n-- | The sum of a collection of actions, generalizing 'concat'.\n-- As of base 4.8.0.0, 'msum' is just 'asum', specialized to 'MonadPlus'.\nmsum :: (Foldable t, MonadPlus m) => t (m a) -> m a\n{-# INLINE msum #-}\nmsum = asum\n\n-- | The concatenation of all the elements of a container of lists.\nconcat :: Foldable t => t [a] -> [a]\nconcat xs = build (\\c n -> foldr (\\x y -> foldr c y x) n xs)\n{-# INLINE concat #-}\n\n-- | Map a function over all the elements of a container and concatenate\n-- the resulting lists.\nconcatMap :: Foldable t => (a -> [b]) -> t a -> [b]\nconcatMap f xs = build (\\c n -> foldr (\\x b -> foldr c b (f x)) n xs)\n{-# INLINE concatMap #-}\n\n-- These use foldr rather than foldMap to avoid repeated concatenation.\n\n-- | 'and' returns the conjunction of a container of Bools.  For the\n-- result to be 'True', the container must be finite; 'False', however,\n-- results from a 'False' value finitely far from the left end.\nand :: Foldable t => t Bool -> Bool\nand = getAll #. foldMap All\n\n-- | 'or' returns the disjunction of a container of Bools.  For the\n-- result to be 'False', the container must be finite; 'True', however,\n-- results from a 'True' value finitely far from the left end.\nor :: Foldable t => t Bool -> Bool\nor = getAny #. foldMap Any\n\n-- | Determines whether any element of the structure satisfies the predicate.\nany :: Foldable t => (a -> Bool) -> t a -> Bool\nany p = getAny #. foldMap (Any #. p)\n\n-- | Determines whether all elements of the structure satisfy the predicate.\nall :: Foldable t => (a -> Bool) -> t a -> Bool\nall p = getAll #. foldMap (All #. p)\n\n-- | The largest element of a non-empty structure with respect to the\n-- given comparison function.\n\n-- See Note [maximumBy/minimumBy space usage]\nmaximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a\nmaximumBy cmp = foldl1 max'\n  where max' x y = case cmp x y of\n                        GT -> x\n                        _  -> y\n\n-- | The least element of a non-empty structure with respect to the\n-- given comparison function.\n\n-- See Note [maximumBy/minimumBy space usage]\nminimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a\nminimumBy cmp = foldl1 min'\n  where min' x y = case cmp x y of\n                        GT -> y\n                        _  -> x\n\n-- | 'notElem' is the negation of 'elem'.\nnotElem :: (Foldable t, Eq a) => a -> t a -> Bool\nnotElem x = not . elem x\n\n-- | The 'find' function takes a predicate and a structure and returns\n-- the leftmost element of the structure matching the predicate, or\n-- 'Nothing' if there is no such element.\nfind :: Foldable t => (a -> Bool) -> t a -> Maybe a\nfind p = getFirst . foldMap (\\ x -> First (if p x then Just x else Nothing))\n\n{-\nNote [List fusion and continuations in 'c']\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nSuppose we define\n  mapM_ f = foldr ((>>) . f) (return ())\n(this is the way it used to be).\n\nNow suppose we want to optimise the call\n\n  mapM_ <big> (build g)\n    where\n  g c n = ...(c x1 y1)...(c x2 y2)....n...\n\nGHC used to proceed like this:\n\n  mapM_ <big> (build g)\n\n  = { Definition of mapM_ }\n    foldr ((>>) . <big>) (return ()) (build g)\n\n  = { foldr/build rule }\n    g ((>>) . <big>) (return ())\n\n  = { Inline g }\n    let c = (>>) . <big>\n        n = return ()\n    in ...(c x1 y1)...(c x2 y2)....n...\n\nThe trouble is that `c`, being big, will not be inlined.  And that can\nbe absolutely terrible for performance, as we saw in Trac #8763.\n\nIt's much better to define\n\n  mapM_ f = foldr c (return ())\n    where\n      c x k = f x >> k\n      {-# INLINE c #-}\n\nNow we get\n  mapM_ <big> (build g)\n\n  = { inline mapM_ }\n    foldr c (return ()) (build g)\n      where c x k = f x >> k\n            {-# INLINE c #-}\n            f = <big>\n\nNotice that `f` does not inline into the RHS of `c`,\nbecause the INLINE pragma stops it; see\nNote [Simplifying inside stable unfoldings] in SimplUtils.\nContinuing:\n\n  = { foldr/build rule }\n    g c (return ())\n      where ...\n         c x k = f x >> k\n         {-# INLINE c #-}\n            f = <big>\n\n  = { inline g }\n    ...(c x1 y1)...(c x2 y2)....n...\n      where c x k = f x >> k\n            {-# INLINE c #-}\n            f = <big>\n            n = return ()\n\n      Now, crucially, `c` does inline\n\n  = { inline c }\n    ...(f x1 >> y1)...(f x2 >> y2)....n...\n      where f = <big>\n            n = return ()\n\nAnd all is well!  The key thing is that the fragment\n`(f x1 >> y1)` is inlined into the body of the builder\n`g`.\n-}\n\n{-\nNote [maximumBy/minimumBy space usage]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen the type signatures of maximumBy and minimumBy were generalized to work\nover any Foldable instance (instead of just lists), they were defined using\nfoldr1. This was problematic for space usage, as the semantics of maximumBy\nand minimumBy essentially require that they examine every element of the\ndata structure. Using foldr1 to examine every element results in space usage\nproportional to the size of the data structure. For the common case of lists,\nthis could be particularly bad (see Trac #10830).\n\nFor the common case of lists, switching the implementations of maximumBy and\nminimumBy to foldl1 solves the issue, as GHC's strictness analysis can then\nmake these functions only use O(1) stack space. It is perhaps not the optimal\nway to fix this problem, as there are other conceivable data structures\n(besides lists) which might benefit from specialized implementations for\nmaximumBy and minimumBy (see\nhttps://ghc.haskell.org/trac/ghc/ticket/10830#comment:26 for a further\ndiscussion). But using foldl1 is at least always better than using foldr1, so\nGHC has chosen to adopt that approach for now.\n-}\n", "num_lines": 791}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Function\n-- Copyright   :  Nils Anders Danielsson 2006\n--             ,  Alexander Berntsen     2014\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Simple combinators working solely on and with functions.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Function\n  ( -- * \"Prelude\" re-exports\n    id, const, (.), flip, ($)\n    -- * Other combinators\n  , (&)\n  , fix\n  , on\n  ) where\n\nimport GHC.Base ( ($), (.), id, const, flip )\n\ninfixl 0 `on`\ninfixl 1 &\n\n-- | @'fix' f@ is the least fixed point of the function @f@,\n-- i.e. the least defined @x@ such that @f x = x@.\n--\n-- For example, we can write the factorial function using direct recursion as\n--\n-- >>> let fac n = if n <= 1 then 1 else n * fac (n-1) in fac 5\n-- 120\n--\n-- This uses the fact that Haskell\u00e2\u20ac\u2122s @let@ introduces recursive bindings. We can\n-- rewrite this definition using 'fix',\n--\n-- >>> fix (\\rec n -> if n <= 1 then 1 else n * rec (n-1)) 5\n-- 120\n--\n-- Instead of making a recursive call, we introduce a dummy parameter @rec@;\n-- when used within 'fix', this parameter then refers to 'fix' argument, hence\n-- the recursion is reintroduced.\nfix :: (a -> a) -> a\nfix f = let x = f x in x\n\n-- | @'on' b u x y@ runs the binary function @b@ /on/ the results of applying\n-- unary function @u@ to two arguments @x@ and @y@. From the opposite\n-- perspective, it transforms two inputs and combines the outputs.\n--\n-- @((+) \\``on`\\` f) x y = f x + f y@\n--\n-- Typical usage: @'Data.List.sortBy' ('Prelude.compare' \\`on\\` 'Prelude.fst')@.\n--\n-- Algebraic properties:\n--\n-- * @(*) \\`on\\` 'id' = (*) -- (if (*) &#x2209; {&#x22a5;, 'const' &#x22a5;})@\n--\n-- * @((*) \\`on\\` f) \\`on\\` g = (*) \\`on\\` (f . g)@\n--\n-- * @'flip' on f . 'flip' on g = 'flip' on (g . f)@\non :: (b -> b -> c) -> (a -> b) -> a -> a -> c\n(.*.) `on` f = \\x y -> f x .*. f y\n-- Proofs (so that I don't have to edit the test-suite):\n\n--   (*) `on` id\n-- =\n--   \\x y -> id x * id y\n-- =\n--   \\x y -> x * y\n-- = { If (*) /= _|_ or const _|_. }\n--   (*)\n\n--   (*) `on` f `on` g\n-- =\n--   ((*) `on` f) `on` g\n-- =\n--   \\x y -> ((*) `on` f) (g x) (g y)\n-- =\n--   \\x y -> (\\x y -> f x * f y) (g x) (g y)\n-- =\n--   \\x y -> f (g x) * f (g y)\n-- =\n--   \\x y -> (f . g) x * (f . g) y\n-- =\n--   (*) `on` (f . g)\n-- =\n--   (*) `on` f . g\n\n--   flip on f . flip on g\n-- =\n--   (\\h (*) -> (*) `on` h) f . (\\h (*) -> (*) `on` h) g\n-- =\n--   (\\(*) -> (*) `on` f) . (\\(*) -> (*) `on` g)\n-- =\n--   \\(*) -> (*) `on` g `on` f\n-- = { See above. }\n--   \\(*) -> (*) `on` g . f\n-- =\n--   (\\h (*) -> (*) `on` h) (g . f)\n-- =\n--   flip on (g . f)\n\n\n-- | '&' is a reverse application operator.  This provides notational\n-- convenience.  Its precedence is one higher than that of the forward\n-- application operator '$', which allows '&' to be nested in '$'.\n--\n-- >>> 5 & (+1) & show\n-- \"6\"\n--\n-- @since 4.8.0.0\n(&) :: a -> (a -> b) -> b\nx & f = f x\n\n-- $setup\n-- >>> import Prelude\n", "num_lines": 124}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n--\n-- A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@,\n-- lets you apply any function of type @(a -> b)@ to turn an @f a@ into an @f b@, preserving the\n-- structure of @f@.\n--\n-- ==== __Examples__\n--\n--  >>> fmap show (Just 1)  --  (a   -> b)      -> f a       -> f b\n--  Just \"1\"                --  (Int -> String) -> Maybe Int -> Maybe String\n--\n--  >>> fmap show Nothing   --  (a   -> b)      -> f a       -> f b\n--  Nothing                 --  (Int -> String) -> Maybe Int -> Maybe String\n--\n--  >>> fmap show [1,2,3]   --  (a   -> b)      -> f a       -> f b\n--  [\"1\", \"2\", \"3\"]         --  (Int -> String) -> [Int]     -> [String]\n--\n--  >>> fmap show []        --  (a   -> b)      -> f a       -> f b\n--  []                      --  (Int -> String) -> [Int]     -> [String]\n--\n-- The 'fmap' function is also available as the infix operator '<$>':\n--\n--  >>> fmap show (Just 1) --  (Int -> String) -> Maybe Int -> Maybe String\n--  Just \"1\"\n--  >>> show <$> (Just 1)  --  (Int -> String) -> Maybe Int -> Maybe String\n--  Just \"1\"\n\nmodule Data.Functor\n    (\n      Functor(fmap),\n      (<$),\n      ($>),\n      (<$>),\n      (<&>),\n      void,\n    ) where\n\nimport GHC.Base ( Functor(..), flip )\n\n-- $setup\n-- Allow the use of Prelude in doctests.\n-- >>> import Prelude hiding ((<$>))\n\ninfixl 4 <$>\n\n-- | An infix synonym for 'fmap'.\n--\n-- The name of this operator is an allusion to 'Prelude.$'.\n-- Note the similarities between their types:\n--\n-- >  ($)  ::              (a -> b) ->   a ->   b\n-- > (<$>) :: Functor f => (a -> b) -> f a -> f b\n--\n-- Whereas 'Prelude.$' is function application, '<$>' is function\n-- application lifted over a 'Functor'.\n--\n-- ==== __Examples__\n--\n-- Convert from a @'Data.Maybe.Maybe' 'Data.Int.Int'@ to a @'Data.Maybe.Maybe'\n-- 'Data.String.String'@ using 'Prelude.show':\n--\n-- >>> show <$> Nothing\n-- Nothing\n-- >>> show <$> Just 3\n-- Just \"3\"\n--\n-- Convert from an @'Data.Either.Either' 'Data.Int.Int' 'Data.Int.Int'@ to an\n-- @'Data.Either.Either' 'Data.Int.Int'@ 'Data.String.String' using 'Prelude.show':\n--\n-- >>> show <$> Left 17\n-- Left 17\n-- >>> show <$> Right 17\n-- Right \"17\"\n--\n-- Double each element of a list:\n--\n-- >>> (*2) <$> [1,2,3]\n-- [2,4,6]\n--\n-- Apply 'Prelude.even' to the second element of a pair:\n--\n-- >>> even <$> (2,2)\n-- (2,True)\n--\n(<$>) :: Functor f => (a -> b) -> f a -> f b\n(<$>) = fmap\n\ninfixl 4 $>\n\n-- | Flipped version of '<$>'.\n--\n-- @\n-- ('<&>') = 'flip' 'fmap'\n-- @\n--\n-- @since 4.11.0.0\n--\n-- ==== __Examples__\n-- Apply @(+1)@ to a list, a 'Data.Maybe.Just' and a 'Data.Either.Right':\n--\n-- >>> Just 2 <&> (+1)\n-- Just 3\n--\n-- >>> [1,2,3] <&> (+1)\n-- [2,3,4]\n--\n-- >>> Right 3 <&> (+1)\n-- Right 4\n--\n(<&>) :: Functor f => f a -> (a -> b) -> f b\nas <&> f = f <$> as\n\ninfixl 1 <&>\n\n-- | Flipped version of '<$'.\n--\n-- @since 4.7.0.0\n--\n-- ==== __Examples__\n--\n-- Replace the contents of a @'Data.Maybe.Maybe' 'Data.Int.Int'@ with a constant\n-- 'Data.String.String':\n--\n-- >>> Nothing $> \"foo\"\n-- Nothing\n-- >>> Just 90210 $> \"foo\"\n-- Just \"foo\"\n--\n-- Replace the contents of an @'Data.Either.Either' 'Data.Int.Int' 'Data.Int.Int'@\n-- with a constant 'Data.String.String', resulting in an @'Data.Either.Either'\n-- 'Data.Int.Int' 'Data.String.String'@:\n--\n-- >>> Left 8675309 $> \"foo\"\n-- Left 8675309\n-- >>> Right 8675309 $> \"foo\"\n-- Right \"foo\"\n--\n-- Replace each element of a list with a constant 'Data.String.String':\n--\n-- >>> [1,2,3] $> \"foo\"\n-- [\"foo\",\"foo\",\"foo\"]\n--\n-- Replace the second element of a pair with a constant 'Data.String.String':\n--\n-- >>> (1,2) $> \"foo\"\n-- (1,\"foo\")\n--\n($>) :: Functor f => f a -> b -> f b\n($>) = flip (<$)\n\n-- | @'void' value@ discards or ignores the result of evaluation, such\n-- as the return value of an 'System.IO.IO' action.\n--\n-- ==== __Examples__\n--\n-- Replace the contents of a @'Data.Maybe.Maybe' 'Data.Int.Int'@ with unit:\n--\n-- >>> void Nothing\n-- Nothing\n-- >>> void (Just 3)\n-- Just ()\n--\n-- Replace the contents of an @'Data.Either.Either' 'Data.Int.Int' 'Data.Int.Int'@\n-- with unit, resulting in an @'Data.Either.Either' 'Data.Int.Int' '()'@:\n--\n-- >>> void (Left 8675309)\n-- Left 8675309\n-- >>> void (Right 8675309)\n-- Right ()\n--\n-- Replace every element of a list with unit:\n--\n-- >>> void [1,2,3]\n-- [(),(),()]\n--\n-- Replace the second element of a pair with unit:\n--\n-- >>> void (1,2)\n-- (1,())\n--\n-- Discard the result of an 'System.IO.IO' action:\n--\n-- >>> mapM print [1,2]\n-- 1\n-- 2\n-- [(),()]\n-- >>> void $ mapM print [1,2]\n-- 1\n-- 2\n--\nvoid :: Functor f => f a -> f ()\nvoid x = () <$ x\n", "num_lines": 205}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Int\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Signed integer types\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Int\n  ( \n        -- * Signed integer types\n        Int,\n        Int8, Int16, Int32, Int64,\n\n        -- * Notes\n\n        -- $notes\n        ) where\n\nimport GHC.Base ( Int )\nimport GHC.Int  ( Int8, Int16, Int32, Int64 )\n\n{- $notes\n\n* All arithmetic is performed modulo 2^n, where @n@ is the number of\n  bits in the type.\n\n* For coercing between any two integer types, use 'Prelude.fromIntegral',\n  which is specialized for all the common cases so should be fast\n  enough.  Coercing word types (see \"Data.Word\") to and from integer\n  types preserves representation, not sign.\n\n* The rules that hold for 'Prelude.Enum' instances over a\n  bounded type such as 'Int' (see the section of the\n  Haskell report dealing with arithmetic sequences) also hold for the\n  'Prelude.Enum' instances over the various\n  'Int' types defined here.\n\n* Right and left shifts by amounts greater than or equal to the width\n  of the type result in either zero or -1, depending on the sign of\n  the value being shifted.  This is contrary to the behaviour in C,\n  which is undefined; a common interpretation is to truncate the shift\n  count to the width of the type, for example @1 \\<\\< 32\n  == 1@ in some C implementations.\n-}\n\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}\n{-# LANGUAGE BangPatterns #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.IORef\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Mutable references in the IO monad.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.IORef\n  ( \n        -- * IORefs\n        IORef,                -- abstract, instance of: Eq, Typeable\n        newIORef,\n        readIORef,\n        writeIORef,\n        modifyIORef,\n        modifyIORef',\n        atomicModifyIORef,\n        atomicModifyIORef',\n        atomicWriteIORef,\n        mkWeakIORef,\n        -- ** Memory Model\n\n        -- $memmodel\n\n        ) where\n\nimport GHC.Base\nimport GHC.STRef\nimport GHC.IORef\nimport GHC.Weak\n\n-- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer\n-- to run when 'IORef' is garbage-collected\nmkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))\nmkWeakIORef r@(IORef (STRef r#)) (IO finalizer) = IO $ \\s ->\n    case mkWeak# r# r finalizer s of (# s1, w #) -> (# s1, Weak w #)\n\n-- |Mutate the contents of an 'IORef'.\n--\n-- Be warned that 'modifyIORef' does not apply the function strictly.  This\n-- means if the program calls 'modifyIORef' many times, but seldomly uses the\n-- value, thunks will pile up in memory resulting in a space leak.  This is a\n-- common mistake made when using an IORef as a counter.  For example, the\n-- following will likely produce a stack overflow:\n--\n-- >ref <- newIORef 0\n-- >replicateM_ 1000000 $ modifyIORef ref (+1)\n-- >readIORef ref >>= print\n--\n-- To avoid this problem, use 'modifyIORef'' instead.\nmodifyIORef :: IORef a -> (a -> a) -> IO ()\nmodifyIORef ref f = readIORef ref >>= writeIORef ref . f\n\n-- |Strict version of 'modifyIORef'\n--\n-- @since 4.6.0.0\nmodifyIORef' :: IORef a -> (a -> a) -> IO ()\nmodifyIORef' ref f = do\n    x <- readIORef ref\n    let x' = f x\n    x' `seq` writeIORef ref x'\n\n-- |Atomically modifies the contents of an 'IORef'.\n--\n-- This function is useful for using 'IORef' in a safe way in a multithreaded\n-- program.  If you only have one 'IORef', then using 'atomicModifyIORef' to\n-- access and modify it will prevent race conditions.\n--\n-- Extending the atomicity to multiple 'IORef's is problematic, so it\n-- is recommended that if you need to do anything more complicated\n-- then using 'Control.Concurrent.MVar.MVar' instead is a good idea.\n--\n-- 'atomicModifyIORef' does not apply the function strictly.  This is important\n-- to know even if all you are doing is replacing the value.  For example, this\n-- will leak memory:\n--\n-- >ref <- newIORef '1'\n-- >forever $ atomicModifyIORef ref (\\_ -> ('2', ()))\n--\n-- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem.\n--\natomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b\natomicModifyIORef ref f = do\n  (_old, ~(_new, res)) <- atomicModifyIORef2 ref f\n  pure res\n\n-- | Variant of 'writeIORef' with the \\\"barrier to reordering\\\" property that\n-- 'atomicModifyIORef' has.\n--\n-- @since 4.6.0.0\natomicWriteIORef :: IORef a -> a -> IO ()\natomicWriteIORef ref a = do\n  _ <- atomicSwapIORef ref a\n  pure ()\n\n{- $memmodel\n\n  In a concurrent program, 'IORef' operations may appear out-of-order\n  to another thread, depending on the memory model of the underlying\n  processor architecture.  For example, on x86, loads can move ahead\n  of stores, so in the following example:\n\n  > import Data.IORef\n  > import Control.Monad (unless)\n  > import Control.Concurrent (forkIO, threadDelay)\n  >\n  > maybePrint :: IORef Bool -> IORef Bool -> IO ()\n  > maybePrint myRef yourRef = do\n  >   writeIORef myRef True\n  >   yourVal <- readIORef yourRef\n  >   unless yourVal $ putStrLn \"critical section\"\n  >\n  > main :: IO ()\n  > main = do\n  >   r1 <- newIORef False\n  >   r2 <- newIORef False\n  >   forkIO $ maybePrint r1 r2\n  >   forkIO $ maybePrint r2 r1\n  >   threadDelay 1000000\n\n  it is possible that the string @\"critical section\"@ is printed\n  twice, even though there is no interleaving of the operations of the\n  two threads that allows that outcome.  The memory model of x86\n  allows 'readIORef' to happen before the earlier 'writeIORef'.\n\n  The implementation is required to ensure that reordering of memory\n  operations cannot cause type-correct code to go wrong.  In\n  particular, when inspecting the value read from an 'IORef', the\n  memory writes that created that value must have occurred from the\n  point of view of the current thread.\n\n  'atomicModifyIORef' acts as a barrier to reordering.  Multiple\n  'atomicModifyIORef' operations occur in strict program order.  An\n  'atomicModifyIORef' is never observed to take place ahead of any\n  earlier (in program order) 'IORef' operations, or after any later\n  'IORef' operations.\n\n-}\n\n", "num_lines": 151}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Ix\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- The 'Ix' class is used to map a contiguous subrange of values in\n-- type onto integers.  It is used primarily for array indexing\n-- (see the array package).  'Ix' uses row-major order.\n-- \n-----------------------------------------------------------------------------\n\nmodule Data.Ix\n    (\n    -- * The 'Ix' class\n        Ix\n          ( range\n          , index\n          , inRange\n          , rangeSize\n          )\n    -- Ix instances:\n    --\n    --  Ix Char\n    --  Ix Int\n    --  Ix Integer\n    --  Ix Bool\n    --  Ix Ordering\n    --  Ix ()\n    --  (Ix a, Ix b) => Ix (a, b)\n    --  ...\n\n    -- * Deriving Instances of 'Ix'\n    -- | Derived instance declarations for the class 'Ix' are only possible\n    -- for enumerations (i.e. datatypes having only nullary constructors)\n    -- and single-constructor datatypes, including arbitrarily large tuples,\n    -- whose constituent types are instances of 'Ix'. \n    -- \n    -- * For an enumeration, the nullary constructors are assumed to be\n    -- numbered left-to-right with the indices being 0 to n-1 inclusive. This\n    -- is the same numbering defined by the 'Enum' class. For example, given\n    -- the datatype: \n    -- \n    -- >        data Colour = Red | Orange | Yellow | Green | Blue | Indigo | Violet\n    -- \n    -- we would have: \n    -- \n    -- >        range   (Yellow,Blue)        ==  [Yellow,Green,Blue]\n    -- >        index   (Yellow,Blue) Green  ==  1\n    -- >        inRange (Yellow,Blue) Red    ==  False\n    -- \n    -- * For single-constructor datatypes, the derived instance declarations\n    -- are as shown for tuples in chapter 19, section 2 of the Haskell 2010 report:\n    -- <https://www.haskell.org/onlinereport/haskell2010/haskellch19.html>.\n\n    ) where\n\nimport GHC.Arr\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy, ExplicitNamespaces #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Kind\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  not portable\n--\n-- Basic kinds\n--\n-- @since 4.9.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Kind ( Type, Constraint ) where\n\nimport GHC.Types\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.List\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- Operations on lists.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.List\n   (\n   -- * Basic functions\n\n     (++)\n   , head\n   , last\n   , tail\n   , init\n   , uncons\n   , null\n   , length\n\n   -- * List transformations\n   , map\n   , reverse\n\n   , intersperse\n   , intercalate\n   , transpose\n\n   , subsequences\n   , permutations\n\n   -- * Reducing lists (folds)\n\n   , foldl\n   , foldl'\n   , foldl1\n   , foldl1'\n   , foldr\n   , foldr1\n\n   -- ** Special folds\n\n   , concat\n   , concatMap\n   , and\n   , or\n   , any\n   , all\n   , sum\n   , product\n   , maximum\n   , minimum\n\n   -- * Building lists\n\n   -- ** Scans\n   , scanl\n   , scanl'\n   , scanl1\n   , scanr\n   , scanr1\n\n   -- ** Accumulating maps\n   , mapAccumL\n   , mapAccumR\n\n   -- ** Infinite lists\n   , iterate\n   , iterate'\n   , repeat\n   , replicate\n   , cycle\n\n   -- ** Unfolding\n   , unfoldr\n\n   -- * Sublists\n\n   -- ** Extracting sublists\n   , take\n   , drop\n   , splitAt\n\n   , takeWhile\n   , dropWhile\n   , dropWhileEnd\n   , span\n   , break\n\n   , stripPrefix\n\n   , group\n\n   , inits\n   , tails\n\n   -- ** Predicates\n   , isPrefixOf\n   , isSuffixOf\n   , isInfixOf\n   , isSubsequenceOf\n\n   -- * Searching lists\n\n   -- ** Searching by equality\n   , elem\n   , notElem\n   , lookup\n\n   -- ** Searching with a predicate\n   , find\n   , filter\n   , partition\n\n   -- * Indexing lists\n   -- | These functions treat a list @xs@ as a indexed collection,\n   -- with indices ranging from 0 to @'length' xs - 1@.\n\n   , (!!)\n\n   , elemIndex\n   , elemIndices\n\n   , findIndex\n   , findIndices\n\n   -- * Zipping and unzipping lists\n\n   , zip\n   , zip3\n   , zip4, zip5, zip6, zip7\n\n   , zipWith\n   , zipWith3\n   , zipWith4, zipWith5, zipWith6, zipWith7\n\n   , unzip\n   , unzip3\n   , unzip4, unzip5, unzip6, unzip7\n\n   -- * Special lists\n\n   -- ** Functions on strings\n   , lines\n   , words\n   , unlines\n   , unwords\n\n   -- ** \\\"Set\\\" operations\n\n   , nub\n\n   , delete\n   , (\\\\)\n\n   , union\n   , intersect\n\n   -- ** Ordered lists\n   , sort\n   , sortOn\n   , insert\n\n   -- * Generalized functions\n\n   -- ** The \\\"@By@\\\" operations\n   -- | By convention, overloaded functions have a non-overloaded\n   -- counterpart whose name is suffixed with \\`@By@\\'.\n   --\n   -- It is often convenient to use these functions together with\n   -- 'Data.Function.on', for instance @'sortBy' ('Prelude.compare'\n   -- ``Data.Function.on`` 'Prelude.fst')@.\n\n   -- *** User-supplied equality (replacing an @Eq@ context)\n   -- | The predicate is assumed to define an equivalence.\n   , nubBy\n   , deleteBy\n   , deleteFirstsBy\n   , unionBy\n   , intersectBy\n   , groupBy\n\n   -- *** User-supplied comparison (replacing an @Ord@ context)\n   -- | The function is assumed to define a total ordering.\n   , sortBy\n   , insertBy\n   , maximumBy\n   , minimumBy\n\n   -- ** The \\\"@generic@\\\" operations\n   -- | The prefix \\`@generic@\\' indicates an overloaded function that\n   -- is a generalized version of a \"Prelude\" function.\n\n   , genericLength\n   , genericTake\n   , genericDrop\n   , genericSplitAt\n   , genericIndex\n   , genericReplicate\n\n   ) where\n\nimport Data.Foldable\nimport Data.Traversable\n\nimport Data.OldList hiding ( all, and, any, concat, concatMap, elem, find,\n                             foldl, foldl1, foldl', foldr, foldr1, mapAccumL,\n                             mapAccumR, maximum, maximumBy, minimum, minimumBy,\n                             length, notElem, null, or, product, sum )\n\nimport GHC.Base ( Bool(..), Eq((==)), otherwise )\n\n-- | The 'isSubsequenceOf' function takes two lists and returns 'True' if all\n-- the elements of the first list occur, in order, in the second. The\n-- elements do not have to occur consecutively.\n--\n-- @'isSubsequenceOf' x y@ is equivalent to @'elem' x ('subsequences' y)@.\n--\n-- @since 4.8.0.0\n--\n-- ==== __Examples__\n--\n-- >>> isSubsequenceOf \"GHC\" \"The Glorious Haskell Compiler\"\n-- True\n-- >>> isSubsequenceOf ['a','d'..'z'] ['a'..'z']\n-- True\n-- >>> isSubsequenceOf [1..10] [10,9..0]\n-- False\nisSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool\nisSubsequenceOf []    _                    = True\nisSubsequenceOf _     []                   = False\nisSubsequenceOf a@(x:a') (y:b) | x == y    = isSubsequenceOf a' b\n                               | otherwise = isSubsequenceOf a b\n", "num_lines": 244}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Maybe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- The Maybe type, and associated operations.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Maybe\n   (\n     Maybe(Nothing,Just)\n\n   , maybe\n\n   , isJust\n   , isNothing\n   , fromJust\n   , fromMaybe\n   , listToMaybe\n   , maybeToList\n   , catMaybes\n   , mapMaybe\n   ) where\n\nimport GHC.Base\nimport GHC.Stack.Types ( HasCallStack )\n\n-- $setup\n-- Allow the use of some Prelude functions in doctests.\n-- >>> import Prelude ( (*), odd, show, sum )\n\n-- ---------------------------------------------------------------------------\n-- Functions over Maybe\n\n-- | The 'maybe' function takes a default value, a function, and a 'Maybe'\n-- value.  If the 'Maybe' value is 'Nothing', the function returns the\n-- default value.  Otherwise, it applies the function to the value inside\n-- the 'Just' and returns the result.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> maybe False odd (Just 3)\n-- True\n--\n-- >>> maybe False odd Nothing\n-- False\n--\n-- Read an integer from a string using 'Text.Read.readMaybe'. If we succeed,\n-- return twice the integer; that is, apply @(*2)@ to it. If instead\n-- we fail to parse an integer, return @0@ by default:\n--\n-- >>> import Text.Read ( readMaybe )\n-- >>> maybe 0 (*2) (readMaybe \"5\")\n-- 10\n-- >>> maybe 0 (*2) (readMaybe \"\")\n-- 0\n--\n-- Apply 'Prelude.show' to a @Maybe Int@. If we have @Just n@, we want to show\n-- the underlying 'Int' @n@. But if we have 'Nothing', we return the\n-- empty string instead of (for example) \\\"Nothing\\\":\n--\n-- >>> maybe \"\" show (Just 5)\n-- \"5\"\n-- >>> maybe \"\" show Nothing\n-- \"\"\n--\nmaybe :: b -> (a -> b) -> Maybe a -> b\nmaybe n _ Nothing  = n\nmaybe _ f (Just x) = f x\n\n-- | The 'isJust' function returns 'True' iff its argument is of the\n-- form @Just _@.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isJust (Just 3)\n-- True\n--\n-- >>> isJust (Just ())\n-- True\n--\n-- >>> isJust Nothing\n-- False\n--\n-- Only the outer constructor is taken into consideration:\n--\n-- >>> isJust (Just Nothing)\n-- True\n--\nisJust         :: Maybe a -> Bool\nisJust Nothing = False\nisJust _       = True\n\n-- | The 'isNothing' function returns 'True' iff its argument is 'Nothing'.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isNothing (Just 3)\n-- False\n--\n-- >>> isNothing (Just ())\n-- False\n--\n-- >>> isNothing Nothing\n-- True\n--\n-- Only the outer constructor is taken into consideration:\n--\n-- >>> isNothing (Just Nothing)\n-- False\n--\nisNothing         :: Maybe a -> Bool\nisNothing Nothing = True\nisNothing _       = False\n\n-- | The 'fromJust' function extracts the element out of a 'Just' and\n-- throws an error if its argument is 'Nothing'.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> fromJust (Just 1)\n-- 1\n--\n-- >>> 2 * (fromJust (Just 10))\n-- 20\n--\n-- >>> 2 * (fromJust Nothing)\n-- *** Exception: Maybe.fromJust: Nothing\n--\nfromJust          :: HasCallStack => Maybe a -> a\nfromJust Nothing  = error \"Maybe.fromJust: Nothing\" -- yuck\nfromJust (Just x) = x\n\n-- | The 'fromMaybe' function takes a default value and and 'Maybe'\n-- value.  If the 'Maybe' is 'Nothing', it returns the default values;\n-- otherwise, it returns the value contained in the 'Maybe'.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> fromMaybe \"\" (Just \"Hello, World!\")\n-- \"Hello, World!\"\n--\n-- >>> fromMaybe \"\" Nothing\n-- \"\"\n--\n-- Read an integer from a string using 'Text.Read.readMaybe'. If we fail to\n-- parse an integer, we want to return @0@ by default:\n--\n-- >>> import Text.Read ( readMaybe )\n-- >>> fromMaybe 0 (readMaybe \"5\")\n-- 5\n-- >>> fromMaybe 0 (readMaybe \"\")\n-- 0\n--\nfromMaybe     :: a -> Maybe a -> a\nfromMaybe d x = case x of {Nothing -> d;Just v  -> v}\n\n-- | The 'maybeToList' function returns an empty list when given\n-- 'Nothing' or a singleton list when given 'Just'.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> maybeToList (Just 7)\n-- [7]\n--\n-- >>> maybeToList Nothing\n-- []\n--\n-- One can use 'maybeToList' to avoid pattern matching when combined\n-- with a function that (safely) works on lists:\n--\n-- >>> import Text.Read ( readMaybe )\n-- >>> sum $ maybeToList (readMaybe \"3\")\n-- 3\n-- >>> sum $ maybeToList (readMaybe \"\")\n-- 0\n--\nmaybeToList            :: Maybe a -> [a]\nmaybeToList  Nothing   = []\nmaybeToList  (Just x)  = [x]\n\n-- | The 'listToMaybe' function returns 'Nothing' on an empty list\n-- or @'Just' a@ where @a@ is the first element of the list.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> listToMaybe []\n-- Nothing\n--\n-- >>> listToMaybe [9]\n-- Just 9\n--\n-- >>> listToMaybe [1,2,3]\n-- Just 1\n--\n-- Composing 'maybeToList' with 'listToMaybe' should be the identity\n-- on singleton/empty lists:\n--\n-- >>> maybeToList $ listToMaybe [5]\n-- [5]\n-- >>> maybeToList $ listToMaybe []\n-- []\n--\n-- But not on lists with more than one element:\n--\n-- >>> maybeToList $ listToMaybe [1,2,3]\n-- [1]\n--\nlistToMaybe :: [a] -> Maybe a\nlistToMaybe = foldr (const . Just) Nothing\n{-# INLINE listToMaybe #-}\n-- We define listToMaybe using foldr so that it can fuse via the foldr/build\n-- rule. See #14387\n\n\n-- | The 'catMaybes' function takes a list of 'Maybe's and returns\n-- a list of all the 'Just' values.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> catMaybes [Just 1, Nothing, Just 3]\n-- [1,3]\n--\n-- When constructing a list of 'Maybe' values, 'catMaybes' can be used\n-- to return all of the \\\"success\\\" results (if the list is the result\n-- of a 'map', then 'mapMaybe' would be more appropriate):\n--\n-- >>> import Text.Read ( readMaybe )\n-- >>> [readMaybe x :: Maybe Int | x <- [\"1\", \"Foo\", \"3\"] ]\n-- [Just 1,Nothing,Just 3]\n-- >>> catMaybes $ [readMaybe x :: Maybe Int | x <- [\"1\", \"Foo\", \"3\"] ]\n-- [1,3]\n--\ncatMaybes              :: [Maybe a] -> [a]\ncatMaybes ls = [x | Just x <- ls]\n\n-- | The 'mapMaybe' function is a version of 'map' which can throw\n-- out elements.  In particular, the functional argument returns\n-- something of type @'Maybe' b@.  If this is 'Nothing', no element\n-- is added on to the result list.  If it is @'Just' b@, then @b@ is\n-- included in the result list.\n--\n-- ==== __Examples__\n--\n-- Using @'mapMaybe' f x@ is a shortcut for @'catMaybes' $ 'map' f x@\n-- in most cases:\n--\n-- >>> import Text.Read ( readMaybe )\n-- >>> let readMaybeInt = readMaybe :: String -> Maybe Int\n-- >>> mapMaybe readMaybeInt [\"1\", \"Foo\", \"3\"]\n-- [1,3]\n-- >>> catMaybes $ map readMaybeInt [\"1\", \"Foo\", \"3\"]\n-- [1,3]\n--\n-- If we map the 'Just' constructor, the entire list should be returned:\n--\n-- >>> mapMaybe Just [1,2,3]\n-- [1,2,3]\n--\nmapMaybe          :: (a -> Maybe b) -> [a] -> [b]\nmapMaybe _ []     = []\nmapMaybe f (x:xs) =\n let rs = mapMaybe f xs in\n case f x of\n  Nothing -> rs\n  Just r  -> r:rs\n{-# NOINLINE [1] mapMaybe #-}\n\n{-# RULES\n\"mapMaybe\"     [~1] forall f xs. mapMaybe f xs\n                    = build (\\c n -> foldr (mapMaybeFB c f) n xs)\n\"mapMaybeList\" [1]  forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f\n  #-}\n\n{-# INLINE [0] mapMaybeFB #-} -- See Note [Inline FB functions] in GHC.List\nmapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r\nmapMaybeFB cons f x next = case f x of\n  Nothing -> next\n  Just r -> cons r next\n", "num_lines": 305}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric              #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE NoImplicitPrelude          #-}\n{-# LANGUAGE PolyKinds                  #-}\n{-# LANGUAGE ScopedTypeVariables        #-}\n{-# LANGUAGE Trustworthy                #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Monoid\n-- Copyright   :  (c) Andy Gill 2001,\n--                (c) Oregon Graduate Institute of Science and Technology, 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- A type @a@ is a 'Monoid' if it provides an associative function ('<>')\n-- that lets you combine any two values of type @a@ into one, and a neutral\n-- element (`mempty`) such that\n--\n-- > a <> mempty == mempty <> a == a\n--\n-- A 'Monoid' is a 'Semigroup' with the added requirement of a neutral element.\n-- Thus any 'Monoid' is a 'Semigroup', but not the other way around.\n--\n-- ==== __Examples__\n--\n-- The 'Sum' monoid is defined by the numerical addition operator and `0` as neutral element:\n--\n-- >>> mempty :: Sum Int\n-- Sum 0\n-- >>> Sum 1 <> Sum 2 <> Sum 3 <> Sum 4 :: Sum Int\n-- Sum {getSum = 10}\n--\n-- We can combine multiple values in a list into a single value using the `mconcat` function.\n-- Note that we have to specify the type here since 'Int' is a monoid under several different\n-- operations:\n--\n-- >>> mconcat [1,2,3,4] :: Sum Int\n-- Sum {getSum = 10}\n-- >>> mconcat [] :: Sum Int\n-- Sum {getSum = 0}\n--\n-- Another valid monoid instance of 'Int' is 'Product' It is defined by multiplication\n-- and `1` as neutral element:\n--\n-- >>> Product 1 <> Product 2 <> Product 3 <> Product 4 :: Product Int\n-- Product {getProduct = 24}\n-- >>> mconcat [1,2,3,4] :: Product Int\n-- Product {getProduct = 24}\n-- >>> mconcat [] :: Product Int\n-- Product {getProduct = 1}\n--\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Monoid (\n        -- * 'Monoid' typeclass\n        Monoid(..),\n        (<>),\n        Dual(..),\n        Endo(..),\n        -- * 'Bool' wrappers\n        All(..),\n        Any(..),\n        -- * 'Num' wrappers\n        Sum(..),\n        Product(..),\n        -- * 'Maybe' wrappers\n        -- $MaybeExamples\n        First(..),\n        Last(..),\n        -- * 'Alternative' wrapper\n        Alt(..),\n        -- * 'Applicative' wrapper\n        Ap(..)\n  ) where\n\n-- Push down the module in the dependency hierarchy.\nimport GHC.Base hiding (Any)\nimport GHC.Enum\nimport GHC.Generics\nimport GHC.Num\nimport GHC.Read\nimport GHC.Show\n\nimport Control.Monad.Fail (MonadFail)\n\nimport Data.Semigroup.Internal\n\n-- $MaybeExamples\n-- To implement @find@ or @findLast@ on any 'Data.Foldable.Foldable':\n--\n-- @\n-- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a\n-- findLast pred = getLast . foldMap (\\x -> if pred x\n--                                            then Last (Just x)\n--                                            else Last Nothing)\n-- @\n--\n-- Much of 'Data.Map.Lazy.Map's interface can be implemented with\n-- 'Data.Map.Lazy.alter'. Some of the rest can be implemented with a new\n-- 'Data.Map.Lazy.alterF' function and either 'First' or 'Last':\n--\n-- > alterF :: (Functor f, Ord k) =>\n-- >           (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)\n-- >\n-- > instance Monoid a => Functor ((,) a)  -- from Data.Functor\n--\n-- @\n-- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v\n--                     -> Map k v -> (Maybe v, Map k v)\n-- insertLookupWithKey combine key value =\n--   Arrow.first getFirst . 'Data.Map.Lazy.alterF' doChange key\n--   where\n--   doChange Nothing = (First Nothing, Just value)\n--   doChange (Just oldValue) =\n--     (First (Just oldValue),\n--      Just (combine key value oldValue))\n-- @\n\n\n-- | Maybe monoid returning the leftmost non-Nothing value.\n--\n-- @'First' a@ is isomorphic to @'Alt' 'Maybe' a@, but precedes it\n-- historically.\n--\n-- >>> getFirst (First (Just \"hello\") <> First Nothing <> First (Just \"world\"))\n-- Just \"hello\"\n--\n-- Use of this type is discouraged. Note the following equivalence:\n--\n-- > Data.Monoid.First x === Maybe (Data.Semigroup.First x)\n--\n-- In addition to being equivalent in the structural sense, the two\n-- also have 'Monoid' instances that behave the same. This type will\n-- be marked deprecated in GHC 8.8, and removed in GHC 8.10.\n-- Users are advised to use the variant from \"Data.Semigroup\" and wrap\n-- it in 'Maybe'.\nnewtype First a = First { getFirst :: Maybe a }\n        deriving ( Eq          -- ^ @since 2.01\n                 , Ord         -- ^ @since 2.01\n                 , Read        -- ^ @since 2.01\n                 , Show        -- ^ @since 2.01\n                 , Generic     -- ^ @since 4.7.0.0\n                 , Generic1    -- ^ @since 4.7.0.0\n                 , Functor     -- ^ @since 4.8.0.0\n                 , Applicative -- ^ @since 4.8.0.0\n                 , Monad       -- ^ @since 4.8.0.0\n                 )\n\n-- | @since 4.9.0.0\ninstance Semigroup (First a) where\n        First Nothing <> b = b\n        a             <> _ = a\n        stimes = stimesIdempotentMonoid\n\n-- | @since 2.01\ninstance Monoid (First a) where\n        mempty = First Nothing\n\n-- | Maybe monoid returning the rightmost non-Nothing value.\n--\n-- @'Last' a@ is isomorphic to @'Dual' ('First' a)@, and thus to\n-- @'Dual' ('Alt' 'Maybe' a)@\n--\n-- >>> getLast (Last (Just \"hello\") <> Last Nothing <> Last (Just \"world\"))\n-- Just \"world\"\n--\n-- Use of this type is discouraged. Note the following equivalence:\n--\n-- > Data.Monoid.Last x === Maybe (Data.Semigroup.Last x)\n--\n-- In addition to being equivalent in the structural sense, the two\n-- also have 'Monoid' instances that behave the same. This type will\n-- be marked deprecated in GHC 8.8, and removed in GHC 8.10.\n-- Users are advised to use the variant from \"Data.Semigroup\" and wrap\n-- it in 'Maybe'.\nnewtype Last a = Last { getLast :: Maybe a }\n        deriving ( Eq          -- ^ @since 2.01\n                 , Ord         -- ^ @since 2.01\n                 , Read        -- ^ @since 2.01\n                 , Show        -- ^ @since 2.01\n                 , Generic     -- ^ @since 4.7.0.0\n                 , Generic1    -- ^ @since 4.7.0.0\n                 , Functor     -- ^ @since 4.8.0.0\n                 , Applicative -- ^ @since 4.8.0.0\n                 , Monad       -- ^ @since 4.8.0.0\n                 )\n\n-- | @since 4.9.0.0\ninstance Semigroup (Last a) where\n        a <> Last Nothing = a\n        _ <> b                   = b\n        stimes = stimesIdempotentMonoid\n\n-- | @since 2.01\ninstance Monoid (Last a) where\n        mempty = Last Nothing\n\n-- | This data type witnesses the lifting of a 'Monoid' into an\n-- 'Applicative' pointwise.\n--\n-- @since 4.12.0.0\nnewtype Ap f a = Ap { getAp :: f a }\n        deriving ( Alternative -- ^ @since 4.12.0.0\n                 , Applicative -- ^ @since 4.12.0.0\n                 , Enum        -- ^ @since 4.12.0.0\n                 , Eq          -- ^ @since 4.12.0.0\n                 , Functor     -- ^ @since 4.12.0.0\n                 , Generic     -- ^ @since 4.12.0.0\n                 , Generic1    -- ^ @since 4.12.0.0\n                 , Monad       -- ^ @since 4.12.0.0\n                 , MonadFail   -- ^ @since 4.12.0.0\n                 , MonadPlus   -- ^ @since 4.12.0.0\n                 , Ord         -- ^ @since 4.12.0.0\n                 , Read        -- ^ @since 4.12.0.0\n                 , Show        -- ^ @since 4.12.0.0\n                 )\n\n-- | @since 4.12.0.0\ninstance (Applicative f, Semigroup a) => Semigroup (Ap f a) where\n        (Ap x) <> (Ap y) = Ap $ liftA2 (<>) x y\n\n-- | @since 4.12.0.0\ninstance (Applicative f, Monoid a) => Monoid (Ap f a) where\n        mempty = Ap $ pure mempty\n\n-- | @since 4.12.0.0\ninstance (Applicative f, Bounded a) => Bounded (Ap f a) where\n  minBound = pure minBound\n  maxBound = pure maxBound\n\n-- | @since 4.12.0.0\ninstance (Applicative f, Num a) => Num (Ap f a) where\n  (+)         = liftA2 (+)\n  (*)         = liftA2 (*)\n  negate      = fmap negate\n  fromInteger = pure . fromInteger\n  abs         = fmap abs\n  signum      = fmap signum\n\n{-\n{--------------------------------------------------------------------\n  Testing\n--------------------------------------------------------------------}\ninstance Arbitrary a => Arbitrary (Maybe a) where\n  arbitrary = oneof [return Nothing, Just `fmap` arbitrary]\n\nprop_mconcatMaybe :: [Maybe [Int]] -> Bool\nprop_mconcatMaybe x =\n  fromMaybe [] (mconcat x) == mconcat (catMaybes x)\n\nprop_mconcatFirst :: [Maybe Int] -> Bool\nprop_mconcatFirst x =\n  getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)\nprop_mconcatLast :: [Maybe Int] -> Bool\nprop_mconcatLast x =\n  getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)\n        where listLastToMaybe [] = Nothing\n              listLastToMaybe lst = Just (last lst)\n-- -}\n\n-- $setup\n-- >>> import Prelude\n", "num_lines": 268}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables,\n             MagicHash, BangPatterns #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.List\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- Operations on lists.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.OldList\n   (\n   -- * Basic functions\n\n     (++)\n   , head\n   , last\n   , tail\n   , init\n   , uncons\n   , null\n   , length\n\n   -- * List transformations\n   , map\n   , reverse\n\n   , intersperse\n   , intercalate\n   , transpose\n\n   , subsequences\n   , permutations\n\n   -- * Reducing lists (folds)\n\n   , foldl\n   , foldl'\n   , foldl1\n   , foldl1'\n   , foldr\n   , foldr1\n\n   -- ** Special folds\n\n   , concat\n   , concatMap\n   , and\n   , or\n   , any\n   , all\n   , sum\n   , product\n   , maximum\n   , minimum\n\n   -- * Building lists\n\n   -- ** Scans\n   , scanl\n   , scanl'\n   , scanl1\n   , scanr\n   , scanr1\n\n   -- ** Accumulating maps\n   , mapAccumL\n   , mapAccumR\n\n   -- ** Infinite lists\n   , iterate\n   , iterate'\n   , repeat\n   , replicate\n   , cycle\n\n   -- ** Unfolding\n   , unfoldr\n\n   -- * Sublists\n\n   -- ** Extracting sublists\n   , take\n   , drop\n   , splitAt\n\n   , takeWhile\n   , dropWhile\n   , dropWhileEnd\n   , span\n   , break\n\n   , stripPrefix\n\n   , group\n\n   , inits\n   , tails\n\n   -- ** Predicates\n   , isPrefixOf\n   , isSuffixOf\n   , isInfixOf\n\n   -- * Searching lists\n\n   -- ** Searching by equality\n   , elem\n   , notElem\n   , lookup\n\n   -- ** Searching with a predicate\n   , find\n   , filter\n   , partition\n\n   -- * Indexing lists\n   -- | These functions treat a list @xs@ as a indexed collection,\n   -- with indices ranging from 0 to @'length' xs - 1@.\n\n   , (!!)\n\n   , elemIndex\n   , elemIndices\n\n   , findIndex\n   , findIndices\n\n   -- * Zipping and unzipping lists\n\n   , zip\n   , zip3\n   , zip4, zip5, zip6, zip7\n\n   , zipWith\n   , zipWith3\n   , zipWith4, zipWith5, zipWith6, zipWith7\n\n   , unzip\n   , unzip3\n   , unzip4, unzip5, unzip6, unzip7\n\n   -- * Special lists\n\n   -- ** Functions on strings\n   , lines\n   , words\n   , unlines\n   , unwords\n\n   -- ** \\\"Set\\\" operations\n\n   , nub\n\n   , delete\n   , (\\\\)\n\n   , union\n   , intersect\n\n   -- ** Ordered lists\n   , sort\n   , sortOn\n   , insert\n\n   -- * Generalized functions\n\n   -- ** The \\\"@By@\\\" operations\n   -- | By convention, overloaded functions have a non-overloaded\n   -- counterpart whose name is suffixed with \\`@By@\\'.\n   --\n   -- It is often convenient to use these functions together with\n   -- 'Data.Function.on', for instance @'sortBy' ('compare'\n   -- \\`on\\` 'fst')@.\n\n   -- *** User-supplied equality (replacing an @Eq@ context)\n   -- | The predicate is assumed to define an equivalence.\n   , nubBy\n   , deleteBy\n   , deleteFirstsBy\n   , unionBy\n   , intersectBy\n   , groupBy\n\n   -- *** User-supplied comparison (replacing an @Ord@ context)\n   -- | The function is assumed to define a total ordering.\n   , sortBy\n   , insertBy\n   , maximumBy\n   , minimumBy\n\n   -- ** The \\\"@generic@\\\" operations\n   -- | The prefix \\`@generic@\\' indicates an overloaded function that\n   -- is a generalized version of a \"Prelude\" function.\n\n   , genericLength\n   , genericTake\n   , genericDrop\n   , genericSplitAt\n   , genericIndex\n   , genericReplicate\n\n   ) where\n\nimport Data.Maybe\nimport Data.Bits        ( (.&.) )\nimport Data.Char        ( isSpace )\nimport Data.Ord         ( comparing )\nimport Data.Tuple       ( fst, snd )\n\nimport GHC.Num\nimport GHC.Real\nimport GHC.List\nimport GHC.Base\n\ninfix 5 \\\\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/phases.html#cpp-and-string-gaps\n\n-- -----------------------------------------------------------------------------\n-- List functions\n\n-- | The 'dropWhileEnd' function drops the largest suffix of a list\n-- in which the given predicate holds for all elements.  For example:\n--\n-- >>> dropWhileEnd isSpace \"foo\\n\"\n-- \"foo\"\n--\n-- >>> dropWhileEnd isSpace \"foo bar\"\n-- \"foo bar\"\n--\n-- > dropWhileEnd isSpace (\"foo\\n\" ++ undefined) == \"foo\" ++ undefined\n--\n-- @since 4.5.0.0\ndropWhileEnd :: (a -> Bool) -> [a] -> [a]\ndropWhileEnd p = foldr (\\x xs -> if p x && null xs then [] else x : xs) []\n\n-- | /O(min(m,n))/. The 'stripPrefix' function drops the given prefix from a\n-- list. It returns 'Nothing' if the list did not start with the prefix given,\n-- or 'Just' the list after the prefix, if it does.\n--\n-- >>> stripPrefix \"foo\" \"foobar\"\n-- Just \"bar\"\n--\n-- >>> stripPrefix \"foo\" \"foo\"\n-- Just \"\"\n--\n-- >>> stripPrefix \"foo\" \"barfoo\"\n-- Nothing\n--\n-- >>> stripPrefix \"foo\" \"barfoobaz\"\n-- Nothing\nstripPrefix :: Eq a => [a] -> [a] -> Maybe [a]\nstripPrefix [] ys = Just ys\nstripPrefix (x:xs) (y:ys)\n | x == y = stripPrefix xs ys\nstripPrefix _ _ = Nothing\n\n-- | The 'elemIndex' function returns the index of the first element\n-- in the given list which is equal (by '==') to the query element,\n-- or 'Nothing' if there is no such element.\n--\n-- >>> elemIndex 4 [0..]\n-- Just 4\nelemIndex       :: Eq a => a -> [a] -> Maybe Int\nelemIndex x     = findIndex (x==)\n\n-- | The 'elemIndices' function extends 'elemIndex', by returning the\n-- indices of all elements equal to the query element, in ascending order.\n--\n-- >>> elemIndices 'o' \"Hello World\"\n-- [4,7]\nelemIndices     :: Eq a => a -> [a] -> [Int]\nelemIndices x   = findIndices (x==)\n\n-- | The 'find' function takes a predicate and a list and returns the\n-- first element in the list matching the predicate, or 'Nothing' if\n-- there is no such element.\n--\n-- >>> find (> 4) [1..]\n-- Just 5\n--\n-- >>> find (< 0) [1..10]\n-- Nothing\nfind            :: (a -> Bool) -> [a] -> Maybe a\nfind p          = listToMaybe . filter p\n\n-- | The 'findIndex' function takes a predicate and a list and returns\n-- the index of the first element in the list satisfying the predicate,\n-- or 'Nothing' if there is no such element.\n--\n-- >>> findIndex isSpace \"Hello World!\"\n-- Just 5\nfindIndex       :: (a -> Bool) -> [a] -> Maybe Int\nfindIndex p     = listToMaybe . findIndices p\n\n-- | The 'findIndices' function extends 'findIndex', by returning the\n-- indices of all elements satisfying the predicate, in ascending order.\n--\n-- >>> findIndices (`elem` \"aeiou\") \"Hello World!\"\n-- [1,4,7]\nfindIndices      :: (a -> Bool) -> [a] -> [Int]\n#if defined(USE_REPORT_PRELUDE)\nfindIndices p xs = [ i | (x,i) <- zip xs [0..], p x]\n#else\n-- Efficient definition, adapted from Data.Sequence\n-- (Note that making this INLINABLE instead of INLINE allows\n-- 'findIndex' to fuse, fixing #15426.)\n{-# INLINABLE findIndices #-}\nfindIndices p ls = build $ \\c n ->\n  let go x r k | p x       = I# k `c` r (k +# 1#)\n               | otherwise = r (k +# 1#)\n  in foldr go (\\_ -> n) ls 0#\n#endif  /* USE_REPORT_PRELUDE */\n\n-- | /O(min(m,n))/. The 'isPrefixOf' function takes two lists and returns 'True'\n-- iff the first list is a prefix of the second.\n--\n-- >>> \"Hello\" `isPrefixOf` \"Hello World!\"\n-- True\n--\n-- >>> \"Hello\" `isPrefixOf` \"Wello Horld!\"\n-- False\nisPrefixOf              :: (Eq a) => [a] -> [a] -> Bool\nisPrefixOf [] _         =  True\nisPrefixOf _  []        =  False\nisPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys\n\n-- | The 'isSuffixOf' function takes two lists and returns 'True' iff\n-- the first list is a suffix of the second. The second list must be\n-- finite.\n--\n-- >>> \"ld!\" `isSuffixOf` \"Hello World!\"\n-- True\n--\n-- >>> \"World\" `isSuffixOf` \"Hello World!\"\n-- False\nisSuffixOf              :: (Eq a) => [a] -> [a] -> Bool\nns `isSuffixOf` hs      = maybe False id $ do\n      delta <- dropLengthMaybe ns hs\n      return $ ns == dropLength delta hs\n      -- Since dropLengthMaybe ns hs succeeded, we know that (if hs is finite)\n      -- length ns + length delta = length hs\n      -- so dropping the length of delta from hs will yield a suffix exactly\n      -- the length of ns.\n\n-- A version of drop that drops the length of the first argument from the\n-- second argument. If xs is longer than ys, xs will not be traversed in its\n-- entirety.  dropLength is also generally faster than (drop . length)\n-- Both this and dropLengthMaybe could be written as folds over their first\n-- arguments, but this reduces clarity with no benefit to isSuffixOf.\n--\n-- >>> dropLength \"Hello\" \"Holla world\"\n-- \" world\"\n--\n-- >>> dropLength [1..] [1,2,3]\n-- []\ndropLength :: [a] -> [b] -> [b]\ndropLength [] y = y\ndropLength _ [] = []\ndropLength (_:x') (_:y') = dropLength x' y'\n\n-- A version of dropLength that returns Nothing if the second list runs out of\n-- elements before the first.\n--\n-- >>> dropLengthMaybe [1..] [1,2,3]\n-- Nothing\ndropLengthMaybe :: [a] -> [b] -> Maybe [b]\ndropLengthMaybe [] y = Just y\ndropLengthMaybe _ [] = Nothing\ndropLengthMaybe (_:x') (_:y') = dropLengthMaybe x' y'\n\n-- | The 'isInfixOf' function takes two lists and returns 'True'\n-- iff the first list is contained, wholly and intact,\n-- anywhere within the second.\n--\n-- >>> isInfixOf \"Haskell\" \"I really like Haskell.\"\n-- True\n--\n-- >>> isInfixOf \"Ial\" \"I really like Haskell.\"\n-- False\nisInfixOf               :: (Eq a) => [a] -> [a] -> Bool\nisInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)\n\n-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.\n-- In particular, it keeps only the first occurrence of each element.\n-- (The name 'nub' means \\`essence\\'.)\n-- It is a special case of 'nubBy', which allows the programmer to supply\n-- their own equality test.\n--\n-- >>> nub [1,2,3,4,3,2,1,2,4,3,5]\n-- [1,2,3,4,5]\nnub                     :: (Eq a) => [a] -> [a]\nnub                     =  nubBy (==)\n\n-- | The 'nubBy' function behaves just like 'nub', except it uses a\n-- user-supplied equality predicate instead of the overloaded '=='\n-- function.\n--\n-- >>> nubBy (\\x y -> mod x 3 == mod y 3) [1,2,4,5,6]\n-- [1,2,6]\nnubBy                   :: (a -> a -> Bool) -> [a] -> [a]\n#if defined(USE_REPORT_PRELUDE)\nnubBy eq []             =  []\nnubBy eq (x:xs)         =  x : nubBy eq (filter (\\ y -> not (eq x y)) xs)\n#else\n-- stolen from HBC\nnubBy eq l              = nubBy' l []\n  where\n    nubBy' [] _         = []\n    nubBy' (y:ys) xs\n       | elem_by eq y xs = nubBy' ys xs\n       | otherwise       = y : nubBy' ys (y:xs)\n\n-- Not exported:\n-- Note that we keep the call to `eq` with arguments in the\n-- same order as in the reference (prelude) implementation,\n-- and that this order is different from how `elem` calls (==).\n-- See #2528, #3280 and #7913.\n-- 'xs' is the list of things we've seen so far,\n-- 'y' is the potential new element\nelem_by :: (a -> a -> Bool) -> a -> [a] -> Bool\nelem_by _  _ []         =  False\nelem_by eq y (x:xs)     =  x `eq` y || elem_by eq y xs\n#endif\n\n\n-- | /O(n)/. 'delete' @x@ removes the first occurrence of @x@ from its list\n-- argument. For example,\n--\n-- >>> delete 'a' \"banana\"\n-- \"bnana\"\n--\n-- It is a special case of 'deleteBy', which allows the programmer to\n-- supply their own equality test.\ndelete                  :: (Eq a) => a -> [a] -> [a]\ndelete                  =  deleteBy (==)\n\n-- | /O(n)/. The 'deleteBy' function behaves like 'delete', but takes a\n-- user-supplied equality predicate.\n--\n-- >>> deleteBy (<=) 4 [1..10]\n-- [1,2,3,5,6,7,8,9,10]\ndeleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]\ndeleteBy _  _ []        = []\ndeleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys\n\n-- | The '\\\\' function is list difference (non-associative).\n-- In the result of @xs@ '\\\\' @ys@, the first occurrence of each element of\n-- @ys@ in turn (if any) has been removed from @xs@.  Thus\n--\n-- > (xs ++ ys) \\\\ xs == ys.\n--\n-- >>> \"Hello World!\" \\\\ \"ell W\"\n-- \"Hoorld!\"\n--\n-- It is a special case of 'deleteFirstsBy', which allows the programmer\n-- to supply their own equality test.\n\n(\\\\)                    :: (Eq a) => [a] -> [a] -> [a]\n(\\\\)                    =  foldl (flip delete)\n\n-- | The 'union' function returns the list union of the two lists.\n-- For example,\n--\n-- >>> \"dog\" `union` \"cow\"\n-- \"dogcw\"\n--\n-- Duplicates, and elements of the first list, are removed from the\n-- the second list, but if the first list contains duplicates, so will\n-- the result.\n-- It is a special case of 'unionBy', which allows the programmer to supply\n-- their own equality test.\n\nunion                   :: (Eq a) => [a] -> [a] -> [a]\nunion                   = unionBy (==)\n\n-- | The 'unionBy' function is the non-overloaded version of 'union'.\nunionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]\nunionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs\n\n-- | The 'intersect' function takes the list intersection of two lists.\n-- For example,\n--\n-- >>> [1,2,3,4] `intersect` [2,4,6,8]\n-- [2,4]\n--\n-- If the first list contains duplicates, so will the result.\n--\n-- >>> [1,2,2,3,4] `intersect` [6,4,4,2]\n-- [2,2,4]\n--\n-- It is a special case of 'intersectBy', which allows the programmer to\n-- supply their own equality test. If the element is found in both the first\n-- and the second list, the element from the first list will be used.\n\nintersect               :: (Eq a) => [a] -> [a] -> [a]\nintersect               =  intersectBy (==)\n\n-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.\nintersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]\nintersectBy _  [] _     =  []\nintersectBy _  _  []    =  []\nintersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]\n\n-- | /O(n)/. The 'intersperse' function takes an element and a list and\n-- \\`intersperses\\' that element between the elements of the list.\n-- For example,\n--\n-- >>> intersperse ',' \"abcde\"\n-- \"a,b,c,d,e\"\nintersperse             :: a -> [a] -> [a]\nintersperse _   []      = []\nintersperse sep (x:xs)  = x : prependToAll sep xs\n\n\n-- Not exported:\n-- We want to make every element in the 'intersperse'd list available\n-- as soon as possible to avoid space leaks. Experiments suggested that\n-- a separate top-level helper is more efficient than a local worker.\nprependToAll            :: a -> [a] -> [a]\nprependToAll _   []     = []\nprependToAll sep (x:xs) = sep : x : prependToAll sep xs\n\n-- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.\n-- It inserts the list @xs@ in between the lists in @xss@ and concatenates the\n-- result.\n--\n-- >>> intercalate \", \" [\"Lorem\", \"ipsum\", \"dolor\"]\n-- \"Lorem, ipsum, dolor\"\nintercalate :: [a] -> [[a]] -> [a]\nintercalate xs xss = concat (intersperse xs xss)\n\n-- | The 'transpose' function transposes the rows and columns of its argument.\n-- For example,\n--\n-- >>> transpose [[1,2,3],[4,5,6]]\n-- [[1,4],[2,5],[3,6]]\n--\n-- If some of the rows are shorter than the following rows, their elements are skipped:\n--\n-- >>> transpose [[10,11],[20],[],[30,31,32]]\n-- [[10,20,30],[11,31],[32]]\ntranspose               :: [[a]] -> [[a]]\ntranspose []             = []\ntranspose ([]   : xss)   = transpose xss\ntranspose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])\n\n\n-- | The 'partition' function takes a predicate a list and returns\n-- the pair of lists of elements which do and do not satisfy the\n-- predicate, respectively; i.e.,\n--\n-- > partition p xs == (filter p xs, filter (not . p) xs)\n--\n-- >>> partition (`elem` \"aeiou\") \"Hello World!\"\n-- (\"eoo\",\"Hll Wrld!\")\npartition               :: (a -> Bool) -> [a] -> ([a],[a])\n{-# INLINE partition #-}\npartition p xs = foldr (select p) ([],[]) xs\n\nselect :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])\nselect p x ~(ts,fs) | p x       = (x:ts,fs)\n                    | otherwise = (ts, x:fs)\n\n-- | The 'mapAccumL' function behaves like a combination of 'map' and\n-- 'foldl'; it applies a function to each element of a list, passing\n-- an accumulating parameter from left to right, and returning a final\n-- value of this accumulator together with the new list.\nmapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list\n                                    -- and accumulator, returning new\n                                    -- accumulator and elt of result list\n          -> acc            -- Initial accumulator\n          -> [x]            -- Input list\n          -> (acc, [y])     -- Final accumulator and result list\n{-# NOINLINE [1] mapAccumL #-}\nmapAccumL _ s []        =  (s, [])\nmapAccumL f s (x:xs)    =  (s'',y:ys)\n                           where (s', y ) = f s x\n                                 (s'',ys) = mapAccumL f s' xs\n\n{-# RULES\n\"mapAccumL\" [~1] forall f s xs . mapAccumL f s xs = foldr (mapAccumLF f) pairWithNil xs s\n\"mapAccumLList\" [1] forall f s xs . foldr (mapAccumLF f) pairWithNil xs s = mapAccumL f s xs\n #-}\n\npairWithNil :: acc -> (acc, [y])\n{-# INLINE [0] pairWithNil #-}\npairWithNil x = (x, [])\n\nmapAccumLF :: (acc -> x -> (acc, y)) -> x -> (acc -> (acc, [y])) -> acc -> (acc, [y])\n{-# INLINE [0] mapAccumLF #-}\nmapAccumLF f = \\x r -> oneShot (\\s ->\n                         let (s', y)   = f s x\n                             (s'', ys) = r s'\n                         in (s'', y:ys))\n  -- See Note [Left folds via right fold]\n\n\n-- | The 'mapAccumR' function behaves like a combination of 'map' and\n-- 'foldr'; it applies a function to each element of a list, passing\n-- an accumulating parameter from right to left, and returning a final\n-- value of this accumulator together with the new list.\nmapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list\n                                        -- and accumulator, returning new\n                                        -- accumulator and elt of result list\n            -> acc              -- Initial accumulator\n            -> [x]              -- Input list\n            -> (acc, [y])               -- Final accumulator and result list\nmapAccumR _ s []        =  (s, [])\nmapAccumR f s (x:xs)    =  (s'', y:ys)\n                           where (s'',y ) = f s' x\n                                 (s', ys) = mapAccumR f s xs\n\n-- | /O(n)/. The 'insert' function takes an element and a list and inserts the\n-- element into the list at the first position where it is less than or equal to\n-- the next element. In particular, if the list is sorted before the call, the\n-- result will also be sorted. It is a special case of 'insertBy', which allows\n-- the programmer to supply their own comparison function.\n--\n-- >>> insert 4 [1,2,3,5,6,7]\n-- [1,2,3,4,5,6,7]\ninsert :: Ord a => a -> [a] -> [a]\ninsert e ls = insertBy (compare) e ls\n\n-- | /O(n)/. The non-overloaded version of 'insert'.\ninsertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]\ninsertBy _   x [] = [x]\ninsertBy cmp x ys@(y:ys')\n = case cmp x y of\n     GT -> y : insertBy cmp x ys'\n     _  -> x : ys\n\n-- | The 'maximumBy' function takes a comparison function and a list\n-- and returns the greatest element of the list by the comparison function.\n-- The list must be finite and non-empty.\n--\n-- We can use this to find the longest entry of a list:\n--\n-- >>> maximumBy (\\x y -> compare (length x) (length y)) [\"Hello\", \"World\", \"!\", \"Longest\", \"bar\"]\n-- \"Longest\"\nmaximumBy               :: (a -> a -> Ordering) -> [a] -> a\nmaximumBy _ []          =  errorWithoutStackTrace \"List.maximumBy: empty list\"\nmaximumBy cmp xs        =  foldl1 maxBy xs\n                        where\n                           maxBy x y = case cmp x y of\n                                       GT -> x\n                                       _  -> y\n\n-- | The 'minimumBy' function takes a comparison function and a list\n-- and returns the least element of the list by the comparison function.\n-- The list must be finite and non-empty.\n--\n-- We can use this to find the shortest entry of a list:\n--\n-- >>> minimumBy (\\x y -> compare (length x) (length y)) [\"Hello\", \"World\", \"!\", \"Longest\", \"bar\"]\n-- \"!\"\nminimumBy               :: (a -> a -> Ordering) -> [a] -> a\nminimumBy _ []          =  errorWithoutStackTrace \"List.minimumBy: empty list\"\nminimumBy cmp xs        =  foldl1 minBy xs\n                        where\n                           minBy x y = case cmp x y of\n                                       GT -> y\n                                       _  -> x\n\n-- | /O(n)/. The 'genericLength' function is an overloaded version of 'length'.\n-- In particular, instead of returning an 'Int', it returns any type which is an\n-- instance of 'Num'. It is, however, less efficient than 'length'.\n--\n-- >>> genericLength [1, 2, 3] :: Int\n-- 3\n-- >>> genericLength [1, 2, 3] :: Float\n-- 3.0\ngenericLength           :: (Num i) => [a] -> i\n{-# NOINLINE [1] genericLength #-}\ngenericLength []        =  0\ngenericLength (_:l)     =  1 + genericLength l\n\n{-# RULES\n  \"genericLengthInt\"     genericLength = (strictGenericLength :: [a] -> Int);\n  \"genericLengthInteger\" genericLength = (strictGenericLength :: [a] -> Integer);\n #-}\n\nstrictGenericLength     :: (Num i) => [b] -> i\nstrictGenericLength l   =  gl l 0\n                        where\n                           gl [] a     = a\n                           gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a'\n\n-- | The 'genericTake' function is an overloaded version of 'take', which\n-- accepts any 'Integral' value as the number of elements to take.\ngenericTake             :: (Integral i) => i -> [a] -> [a]\ngenericTake n _ | n <= 0 = []\ngenericTake _ []        =  []\ngenericTake n (x:xs)    =  x : genericTake (n-1) xs\n\n-- | The 'genericDrop' function is an overloaded version of 'drop', which\n-- accepts any 'Integral' value as the number of elements to drop.\ngenericDrop             :: (Integral i) => i -> [a] -> [a]\ngenericDrop n xs | n <= 0 = xs\ngenericDrop _ []        =  []\ngenericDrop n (_:xs)    =  genericDrop (n-1) xs\n\n\n-- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which\n-- accepts any 'Integral' value as the position at which to split.\ngenericSplitAt          :: (Integral i) => i -> [a] -> ([a], [a])\ngenericSplitAt n xs | n <= 0 =  ([],xs)\ngenericSplitAt _ []     =  ([],[])\ngenericSplitAt n (x:xs) =  (x:xs',xs'') where\n    (xs',xs'') = genericSplitAt (n-1) xs\n\n-- | The 'genericIndex' function is an overloaded version of '!!', which\n-- accepts any 'Integral' value as the index.\ngenericIndex :: (Integral i) => [a] -> i -> a\ngenericIndex (x:_)  0 = x\ngenericIndex (_:xs) n\n | n > 0     = genericIndex xs (n-1)\n | otherwise = errorWithoutStackTrace \"List.genericIndex: negative argument.\"\ngenericIndex _ _      = errorWithoutStackTrace \"List.genericIndex: index too large.\"\n\n-- | The 'genericReplicate' function is an overloaded version of 'replicate',\n-- which accepts any 'Integral' value as the number of repetitions to make.\ngenericReplicate        :: (Integral i) => i -> a -> [a]\ngenericReplicate n x    =  genericTake n (repeat x)\n\n-- | The 'zip4' function takes four lists and returns a list of\n-- quadruples, analogous to 'zip'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# INLINE zip4 #-}\nzip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]\nzip4                    =  zipWith4 (,,,)\n\n-- | The 'zip5' function takes five lists and returns a list of\n-- five-tuples, analogous to 'zip'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# INLINE zip5 #-}\nzip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]\nzip5                    =  zipWith5 (,,,,)\n\n-- | The 'zip6' function takes six lists and returns a list of six-tuples,\n-- analogous to 'zip'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# INLINE zip6 #-}\nzip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->\n                              [(a,b,c,d,e,f)]\nzip6                    =  zipWith6 (,,,,,)\n\n-- | The 'zip7' function takes seven lists and returns a list of\n-- seven-tuples, analogous to 'zip'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# INLINE zip7 #-}\nzip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->\n                              [g] -> [(a,b,c,d,e,f,g)]\nzip7                    =  zipWith7 (,,,,,,)\n\n-- | The 'zipWith4' function takes a function which combines four\n-- elements, as well as four lists and returns a list of their point-wise\n-- combination, analogous to 'zipWith'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zipWith4 #-}\nzipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]\nzipWith4 z (a:as) (b:bs) (c:cs) (d:ds)\n                        =  z a b c d : zipWith4 z as bs cs ds\nzipWith4 _ _ _ _ _      =  []\n\n-- | The 'zipWith5' function takes a function which combines five\n-- elements, as well as five lists and returns a list of their point-wise\n-- combination, analogous to 'zipWith'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zipWith5 #-}\nzipWith5                :: (a->b->c->d->e->f) ->\n                           [a]->[b]->[c]->[d]->[e]->[f]\nzipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)\n                        =  z a b c d e : zipWith5 z as bs cs ds es\nzipWith5 _ _ _ _ _ _    = []\n\n-- | The 'zipWith6' function takes a function which combines six\n-- elements, as well as six lists and returns a list of their point-wise\n-- combination, analogous to 'zipWith'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zipWith6 #-}\nzipWith6                :: (a->b->c->d->e->f->g) ->\n                           [a]->[b]->[c]->[d]->[e]->[f]->[g]\nzipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)\n                        =  z a b c d e f : zipWith6 z as bs cs ds es fs\nzipWith6 _ _ _ _ _ _ _  = []\n\n-- | The 'zipWith7' function takes a function which combines seven\n-- elements, as well as seven lists and returns a list of their point-wise\n-- combination, analogous to 'zipWith'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zipWith7 #-}\nzipWith7                :: (a->b->c->d->e->f->g->h) ->\n                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]\nzipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)\n                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs\nzipWith7 _ _ _ _ _ _ _ _ = []\n\n{-\nFunctions and rules for fusion of zipWith4, zipWith5, zipWith6 and zipWith7.\nThe principle is the same as for zip and zipWith in GHC.List:\nTurn zipWithX into a version in which the first argument and the result\ncan be fused. Turn it back into the original function if no fusion happens.\n-}\n\n{-# INLINE [0] zipWith4FB #-} -- See Note [Inline FB functions]\nzipWith4FB :: (e->xs->xs') -> (a->b->c->d->e) ->\n              a->b->c->d->xs->xs'\nzipWith4FB cons func = \\a b c d r -> (func a b c d) `cons` r\n\n{-# INLINE [0] zipWith5FB #-} -- See Note [Inline FB functions]\nzipWith5FB :: (f->xs->xs') -> (a->b->c->d->e->f) ->\n              a->b->c->d->e->xs->xs'\nzipWith5FB cons func = \\a b c d e r -> (func a b c d e) `cons` r\n\n{-# INLINE [0] zipWith6FB #-} -- See Note [Inline FB functions]\nzipWith6FB :: (g->xs->xs') -> (a->b->c->d->e->f->g) ->\n              a->b->c->d->e->f->xs->xs'\nzipWith6FB cons func = \\a b c d e f r -> (func a b c d e f) `cons` r\n\n{-# INLINE [0] zipWith7FB #-} -- See Note [Inline FB functions]\nzipWith7FB :: (h->xs->xs') -> (a->b->c->d->e->f->g->h) ->\n              a->b->c->d->e->f->g->xs->xs'\nzipWith7FB cons func = \\a b c d e f g r -> (func a b c d e f g) `cons` r\n\n{-# INLINE [0] foldr4 #-}\nfoldr4 :: (a->b->c->d->e->e) ->\n          e->[a]->[b]->[c]->[d]->e\nfoldr4 k z = go\n  where\n    go (a:as) (b:bs) (c:cs) (d:ds) = k a b c d (go as bs cs ds)\n    go _      _      _      _      = z\n\n{-# INLINE [0] foldr5 #-}\nfoldr5 :: (a->b->c->d->e->f->f) ->\n          f->[a]->[b]->[c]->[d]->[e]->f\nfoldr5 k z = go\n  where\n    go (a:as) (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (go as bs cs ds es)\n    go _      _      _      _      _      = z\n\n{-# INLINE [0] foldr6 #-}\nfoldr6 :: (a->b->c->d->e->f->g->g) ->\n          g->[a]->[b]->[c]->[d]->[e]->[f]->g\nfoldr6 k z = go\n  where\n    go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = k a b c d e f (\n        go as bs cs ds es fs)\n    go _      _      _      _      _      _      = z\n\n{-# INLINE [0] foldr7 #-}\nfoldr7 :: (a->b->c->d->e->f->g->h->h) ->\n          h->[a]->[b]->[c]->[d]->[e]->[f]->[g]->h\nfoldr7 k z = go\n  where\n    go (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = k a b c d e f g (\n        go as bs cs ds es fs gs)\n    go _      _      _      _      _      _      _      = z\n\nfoldr4_left :: (a->b->c->d->e->f)->\n               f->a->([b]->[c]->[d]->e)->\n               [b]->[c]->[d]->f\nfoldr4_left k _z a r (b:bs) (c:cs) (d:ds) = k a b c d (r bs cs ds)\nfoldr4_left _  z _ _ _      _      _      = z\n\nfoldr5_left :: (a->b->c->d->e->f->g)->\n               g->a->([b]->[c]->[d]->[e]->f)->\n               [b]->[c]->[d]->[e]->g\nfoldr5_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) = k a b c d e (r bs cs ds es)\nfoldr5_left _  z _ _ _      _      _      _      = z\n\nfoldr6_left :: (a->b->c->d->e->f->g->h)->\n               h->a->([b]->[c]->[d]->[e]->[f]->g)->\n               [b]->[c]->[d]->[e]->[f]->h\nfoldr6_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) =\n    k a b c d e f (r bs cs ds es fs)\nfoldr6_left _  z _ _ _      _      _      _      _      = z\n\nfoldr7_left :: (a->b->c->d->e->f->g->h->i)->\n               i->a->([b]->[c]->[d]->[e]->[f]->[g]->h)->\n               [b]->[c]->[d]->[e]->[f]->[g]->i\nfoldr7_left k _z a r (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) =\n    k a b c d e f g (r bs cs ds es fs gs)\nfoldr7_left _  z _ _ _      _      _      _      _      _      = z\n\n{-# RULES\n\n\"foldr4/left\"   forall k z (g::forall b.(a->b->b)->b->b).\n                  foldr4 k z (build g) = g (foldr4_left k z) (\\_ _ _ -> z)\n\"foldr5/left\"   forall k z (g::forall b.(a->b->b)->b->b).\n                  foldr5 k z (build g) = g (foldr5_left k z) (\\_ _ _ _ -> z)\n\"foldr6/left\"   forall k z (g::forall b.(a->b->b)->b->b).\n                  foldr6 k z (build g) = g (foldr6_left k z) (\\_ _ _ _ _ -> z)\n\"foldr7/left\"   forall k z (g::forall b.(a->b->b)->b->b).\n                  foldr7 k z (build g) = g (foldr7_left k z) (\\_ _ _ _ _ _ -> z)\n\n\"zipWith4\" [~1] forall f as bs cs ds.\n                  zipWith4 f as bs cs ds = build (\\c n ->\n                        foldr4 (zipWith4FB c f) n as bs cs ds)\n\"zipWith5\" [~1] forall f as bs cs ds es.\n                  zipWith5 f as bs cs ds es = build (\\c n ->\n                        foldr5 (zipWith5FB c f) n as bs cs ds es)\n\"zipWith6\" [~1] forall f as bs cs ds es fs.\n                  zipWith6 f as bs cs ds es fs = build (\\c n ->\n                        foldr6 (zipWith6FB c f) n as bs cs ds es fs)\n\"zipWith7\" [~1] forall f as bs cs ds es fs gs.\n                  zipWith7 f as bs cs ds es fs gs = build (\\c n ->\n                        foldr7 (zipWith7FB c f) n as bs cs ds es fs gs)\n\n\"zipWith4List\"  [1]  forall f.   foldr4 (zipWith4FB (:) f) [] = zipWith4 f\n\"zipWith5List\"  [1]  forall f.   foldr5 (zipWith5FB (:) f) [] = zipWith5 f\n\"zipWith6List\"  [1]  forall f.   foldr6 (zipWith6FB (:) f) [] = zipWith6 f\n\"zipWith7List\"  [1]  forall f.   foldr7 (zipWith7FB (:) f) [] = zipWith7 f\n\n #-}\n\n{-\n\nNote [Inline @unzipN@ functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe inline principle for @unzip{4,5,6,7}@ is the same as 'unzip'/'unzip3' in\n\"GHC.List\".\nThe 'unzip'/'unzip3' functions are inlined so that the `foldr` with which they\nare defined has an opportunity to fuse.\n\nAs such, since there are not any differences between 2/3-ary 'unzip' and its\nn-ary counterparts below aside from the number of arguments, the `INLINE`\npragma should be replicated in the @unzipN@ functions below as well.\n\n-}\n\n-- | The 'unzip4' function takes a list of quadruples and returns four\n-- lists, analogous to 'unzip'.\n{-# INLINE unzip4 #-}\n-- Inline so that fusion with `foldr` has an opportunity to fire.\n-- See Note [Inline @unzipN@ functions] above.\nunzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])\nunzip4                  =  foldr (\\(a,b,c,d) ~(as,bs,cs,ds) ->\n                                        (a:as,b:bs,c:cs,d:ds))\n                                 ([],[],[],[])\n\n-- | The 'unzip5' function takes a list of five-tuples and returns five\n-- lists, analogous to 'unzip'.\n{-# INLINE unzip5 #-}\n-- Inline so that fusion with `foldr` has an opportunity to fire.\n-- See Note [Inline @unzipN@ functions] above.\nunzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])\nunzip5                  =  foldr (\\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->\n                                        (a:as,b:bs,c:cs,d:ds,e:es))\n                                 ([],[],[],[],[])\n\n-- | The 'unzip6' function takes a list of six-tuples and returns six\n-- lists, analogous to 'unzip'.\n{-# INLINE unzip6 #-}\n-- Inline so that fusion with `foldr` has an opportunity to fire.\n-- See Note [Inline @unzipN@ functions] above.\nunzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])\nunzip6                  =  foldr (\\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->\n                                        (a:as,b:bs,c:cs,d:ds,e:es,f:fs))\n                                 ([],[],[],[],[],[])\n\n-- | The 'unzip7' function takes a list of seven-tuples and returns\n-- seven lists, analogous to 'unzip'.\n{-# INLINE unzip7 #-}\n-- Inline so that fusion with `foldr` has an opportunity to fire.\n-- See Note [Inline @unzipN@ functions] above.\nunzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])\nunzip7          =  foldr (\\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->\n                                (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))\n                         ([],[],[],[],[],[],[])\n\n\n-- | The 'deleteFirstsBy' function takes a predicate and two lists and\n-- returns the first list with the first occurrence of each element of\n-- the second list removed.\ndeleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]\ndeleteFirstsBy eq       =  foldl (flip (deleteBy eq))\n\n-- | The 'group' function takes a list and returns a list of lists such\n-- that the concatenation of the result is equal to the argument.  Moreover,\n-- each sublist in the result contains only equal elements.  For example,\n--\n-- >>> group \"Mississippi\"\n-- [\"M\",\"i\",\"ss\",\"i\",\"ss\",\"i\",\"pp\",\"i\"]\n--\n-- It is a special case of 'groupBy', which allows the programmer to supply\n-- their own equality test.\ngroup                   :: Eq a => [a] -> [[a]]\ngroup                   =  groupBy (==)\n\n-- | The 'groupBy' function is the non-overloaded version of 'group'.\ngroupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]\ngroupBy _  []           =  []\ngroupBy eq (x:xs)       =  (x:ys) : groupBy eq zs\n                           where (ys,zs) = span (eq x) xs\n\n-- | The 'inits' function returns all initial segments of the argument,\n-- shortest first.  For example,\n--\n-- >>> inits \"abc\"\n-- [\"\",\"a\",\"ab\",\"abc\"]\n--\n-- Note that 'inits' has the following strictness property:\n-- @inits (xs ++ _|_) = inits xs ++ _|_@\n--\n-- In particular,\n-- @inits _|_ = [] : _|_@\ninits                   :: [a] -> [[a]]\ninits                   = map toListSB . scanl' snocSB emptySB\n{-# NOINLINE inits #-}\n\n-- We do not allow inits to inline, because it plays havoc with Call Arity\n-- if it fuses with a consumer, and it would generally lead to serious\n-- loss of sharing if allowed to fuse with a producer.\n\n-- | /O(n)/. The 'tails' function returns all final segments of the argument,\n-- longest first.  For example,\n--\n-- >>> tails \"abc\"\n-- [\"abc\",\"bc\",\"c\",\"\"]\n--\n-- Note that 'tails' has the following strictness property:\n-- @tails _|_ = _|_ : _|_@\ntails                   :: [a] -> [[a]]\n{-# INLINABLE tails #-}\ntails lst               =  build (\\c n ->\n  let tailsGo xs = xs `c` case xs of\n                             []      -> n\n                             _ : xs' -> tailsGo xs'\n  in tailsGo lst)\n\n-- | The 'subsequences' function returns the list of all subsequences of the argument.\n--\n-- >>> subsequences \"abc\"\n-- [\"\",\"a\",\"b\",\"ab\",\"c\",\"ac\",\"bc\",\"abc\"]\nsubsequences            :: [a] -> [[a]]\nsubsequences xs         =  [] : nonEmptySubsequences xs\n\n-- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,\n--   except for the empty list.\n--\n-- >>> nonEmptySubsequences \"abc\"\n-- [\"a\",\"b\",\"ab\",\"c\",\"ac\",\"bc\",\"abc\"]\nnonEmptySubsequences         :: [a] -> [[a]]\nnonEmptySubsequences []      =  []\nnonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)\n  where f ys r = ys : (x : ys) : r\n\n\n-- | The 'permutations' function returns the list of all permutations of the argument.\n--\n-- >>> permutations \"abc\"\n-- [\"abc\",\"bac\",\"cba\",\"bca\",\"cab\",\"acb\"]\npermutations            :: [a] -> [[a]]\npermutations xs0        =  xs0 : perms xs0 []\n  where\n    perms []     _  = []\n    perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)\n      where interleave    xs     r = let (_,zs) = interleave' id xs r in zs\n            interleave' _ []     r = (ts, r)\n            interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r\n                                     in  (y:us, f (t:y:us) : zs)\n\n\n------------------------------------------------------------------------------\n-- Quick Sort algorithm taken from HBC's QSort library.\n\n-- | The 'sort' function implements a stable sorting algorithm.\n-- It is a special case of 'sortBy', which allows the programmer to supply\n-- their own comparison function.\n--\n-- Elements are arranged from from lowest to highest, keeping duplicates in\n-- the order they appeared in the input.\n--\n-- >>> sort [1,6,4,3,2,5]\n-- [1,2,3,4,5,6]\nsort :: (Ord a) => [a] -> [a]\n\n-- | The 'sortBy' function is the non-overloaded version of 'sort'.\n--\n-- >>> sortBy (\\(a,_) (b,_) -> compare a b) [(2, \"world\"), (4, \"!\"), (1, \"Hello\")]\n-- [(1,\"Hello\"),(2,\"world\"),(4,\"!\")]\nsortBy :: (a -> a -> Ordering) -> [a] -> [a]\n\n#if defined(USE_REPORT_PRELUDE)\nsort = sortBy compare\nsortBy cmp = foldr (insertBy cmp) []\n#else\n\n{-\nGHC's mergesort replaced by a better implementation, 24/12/2009.\nThis code originally contributed to the nhc12 compiler by Thomas Nordin\nin 2002.  Rumoured to have been based on code by Lennart Augustsson, e.g.\n    http://www.mail-archive.com/haskell@haskell.org/msg01822.html\nand possibly to bear similarities to a 1982 paper by Richard O'Keefe:\n\"A smooth applicative merge sort\".\n\nBenchmarks show it to be often 2x the speed of the previous implementation.\nFixes ticket http://ghc.haskell.org/trac/ghc/ticket/2143\n-}\n\nsort = sortBy compare\nsortBy cmp = mergeAll . sequences\n  where\n    sequences (a:b:xs)\n      | a `cmp` b == GT = descending b [a]  xs\n      | otherwise       = ascending  b (a:) xs\n    sequences xs = [xs]\n\n    descending a as (b:bs)\n      | a `cmp` b == GT = descending b (a:as) bs\n    descending a as bs  = (a:as): sequences bs\n\n    ascending a as (b:bs)\n      | a `cmp` b /= GT = ascending b (\\ys -> as (a:ys)) bs\n    ascending a as bs   = let !x = as [a]\n                          in x : sequences bs\n\n    mergeAll [x] = x\n    mergeAll xs  = mergeAll (mergePairs xs)\n\n    mergePairs (a:b:xs) = let !x = merge a b\n                          in x : mergePairs xs\n    mergePairs xs       = xs\n\n    merge as@(a:as') bs@(b:bs')\n      | a `cmp` b == GT = b:merge as  bs'\n      | otherwise       = a:merge as' bs\n    merge [] bs         = bs\n    merge as []         = as\n\n{-\nsortBy cmp l = mergesort cmp l\nsort l = mergesort compare l\n\nQuicksort replaced by mergesort, 14/5/2002.\n\nFrom: Ian Lynagh <igloo@earth.li>\n\nI am curious as to why the List.sort implementation in GHC is a\nquicksort algorithm rather than an algorithm that guarantees n log n\ntime in the worst case? I have attached a mergesort implementation along\nwith a few scripts to time it's performance, the results of which are\nshown below (* means it didn't finish successfully - in all cases this\nwas due to a stack overflow).\n\nIf I heap profile the random_list case with only 10000 then I see\nrandom_list peaks at using about 2.5M of memory, whereas in the same\nprogram using List.sort it uses only 100k.\n\nInput style     Input length     Sort data     Sort alg    User time\nstdin           10000            random_list   sort        2.82\nstdin           10000            random_list   mergesort   2.96\nstdin           10000            sorted        sort        31.37\nstdin           10000            sorted        mergesort   1.90\nstdin           10000            revsorted     sort        31.21\nstdin           10000            revsorted     mergesort   1.88\nstdin           100000           random_list   sort        *\nstdin           100000           random_list   mergesort   *\nstdin           100000           sorted        sort        *\nstdin           100000           sorted        mergesort   *\nstdin           100000           revsorted     sort        *\nstdin           100000           revsorted     mergesort   *\nfunc            10000            random_list   sort        0.31\nfunc            10000            random_list   mergesort   0.91\nfunc            10000            sorted        sort        19.09\nfunc            10000            sorted        mergesort   0.15\nfunc            10000            revsorted     sort        19.17\nfunc            10000            revsorted     mergesort   0.16\nfunc            100000           random_list   sort        3.85\nfunc            100000           random_list   mergesort   *\nfunc            100000           sorted        sort        5831.47\nfunc            100000           sorted        mergesort   2.23\nfunc            100000           revsorted     sort        5872.34\nfunc            100000           revsorted     mergesort   2.24\n\nmergesort :: (a -> a -> Ordering) -> [a] -> [a]\nmergesort cmp = mergesort' cmp . map wrap\n\nmergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]\nmergesort' _   [] = []\nmergesort' _   [xs] = xs\nmergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)\n\nmerge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]\nmerge_pairs _   [] = []\nmerge_pairs _   [xs] = [xs]\nmerge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss\n\nmerge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]\nmerge _   [] ys = ys\nmerge _   xs [] = xs\nmerge cmp (x:xs) (y:ys)\n = case x `cmp` y of\n        GT -> y : merge cmp (x:xs)   ys\n        _  -> x : merge cmp    xs (y:ys)\n\nwrap :: a -> [a]\nwrap x = [x]\n\n\n\nOLDER: qsort version\n\n-- qsort is stable and does not concatenate.\nqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]\nqsort _   []     r = r\nqsort _   [x]    r = x:r\nqsort cmp (x:xs) r = qpart cmp x xs [] [] r\n\n-- qpart partitions and sorts the sublists\nqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]\nqpart cmp x [] rlt rge r =\n    -- rlt and rge are in reverse order and must be sorted with an\n    -- anti-stable sorting\n    rqsort cmp rlt (x:rqsort cmp rge r)\nqpart cmp x (y:ys) rlt rge r =\n    case cmp x y of\n        GT -> qpart cmp x ys (y:rlt) rge r\n        _  -> qpart cmp x ys rlt (y:rge) r\n\n-- rqsort is as qsort but anti-stable, i.e. reverses equal elements\nrqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]\nrqsort _   []     r = r\nrqsort _   [x]    r = x:r\nrqsort cmp (x:xs) r = rqpart cmp x xs [] [] r\n\nrqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]\nrqpart cmp x [] rle rgt r =\n    qsort cmp rle (x:qsort cmp rgt r)\nrqpart cmp x (y:ys) rle rgt r =\n    case cmp y x of\n        GT -> rqpart cmp x ys rle (y:rgt) r\n        _  -> rqpart cmp x ys (y:rle) rgt r\n-}\n\n#endif /* USE_REPORT_PRELUDE */\n\n-- | Sort a list by comparing the results of a key function applied to each\n-- element.  @sortOn f@ is equivalent to @sortBy (comparing f)@, but has the\n-- performance advantage of only evaluating @f@ once for each element in the\n-- input list.  This is called the decorate-sort-undecorate paradigm, or\n-- Schwartzian transform.\n--\n-- Elements are arranged from from lowest to highest, keeping duplicates in\n-- the order they appeared in the input.\n--\n-- >>> sortOn fst [(2, \"world\"), (4, \"!\"), (1, \"Hello\")]\n-- [(1,\"Hello\"),(2,\"world\"),(4,\"!\")]\n--\n-- @since 4.8.0.0\nsortOn :: Ord b => (a -> b) -> [a] -> [a]\nsortOn f =\n  map snd . sortBy (comparing fst) . map (\\x -> let y = f x in y `seq` (y, x))\n\n-- | The 'unfoldr' function is a \\`dual\\' to 'foldr': while 'foldr'\n-- reduces a list to a summary value, 'unfoldr' builds a list from\n-- a seed value.  The function takes the element and returns 'Nothing'\n-- if it is done producing the list or returns 'Just' @(a,b)@, in which\n-- case, @a@ is a prepended to the list and @b@ is used as the next\n-- element in a recursive call.  For example,\n--\n-- > iterate f == unfoldr (\\x -> Just (x, f x))\n--\n-- In some cases, 'unfoldr' can undo a 'foldr' operation:\n--\n-- > unfoldr f' (foldr f z xs) == xs\n--\n-- if the following holds:\n--\n-- > f' (f x y) = Just (x,y)\n-- > f' z       = Nothing\n--\n-- A simple use of unfoldr:\n--\n-- >>> unfoldr (\\b -> if b == 0 then Nothing else Just (b, b-1)) 10\n-- [10,9,8,7,6,5,4,3,2,1]\n--\n\n-- Note [INLINE unfoldr]\n-- We treat unfoldr a little differently from some other forms for list fusion\n-- for two reasons:\n--\n-- 1. We don't want to use a rule to rewrite a basic form to a fusible\n-- form because this would inline before constant floating. As Simon Peyton-\n-- Jones and others have pointed out, this could reduce sharing in some cases\n-- where sharing is beneficial. Thus we simply INLINE it, which is, for\n-- example, how enumFromTo::Int becomes eftInt. Unfortunately, we don't seem\n-- to get enough of an inlining discount to get a version of eftInt based on\n-- unfoldr to inline as readily as the usual one. We know that all the Maybe\n-- nonsense will go away, but the compiler does not.\n--\n-- 2. The benefit of inlining unfoldr is likely to be huge in many common cases,\n-- even apart from list fusion. In particular, inlining unfoldr often\n-- allows GHC to erase all the Maybes. This appears to be critical if unfoldr\n-- is to be used in high-performance code. A small increase in code size\n-- in the relatively rare cases when this does not happen looks like a very\n-- small price to pay.\n--\n-- Doing a back-and-forth dance doesn't seem to accomplish anything if the\n-- final form has to be inlined in any case.\n\nunfoldr :: (b -> Maybe (a, b)) -> b -> [a]\n\n{-# INLINE unfoldr #-} -- See Note [INLINE unfoldr]\nunfoldr f b0 = build (\\c n ->\n  let go b = case f b of\n               Just (a, new_b) -> a `c` go new_b\n               Nothing         -> n\n  in go b0)\n\n-- -----------------------------------------------------------------------------\n-- Functions on strings\n\n-- | 'lines' breaks a string up into a list of strings at newline\n-- characters.  The resulting strings do not contain newlines.\n--\n-- Note that after splitting the string at newline characters, the\n-- last part of the string is considered a line even if it doesn't end\n-- with a newline. For example,\n--\n-- >>> lines \"\"\n-- []\n--\n-- >>> lines \"\\n\"\n-- [\"\"]\n--\n-- >>> lines \"one\"\n-- [\"one\"]\n--\n-- >>> lines \"one\\n\"\n-- [\"one\"]\n--\n-- >>> lines \"one\\n\\n\"\n-- [\"one\",\"\"]\n--\n-- >>> lines \"one\\ntwo\"\n-- [\"one\",\"two\"]\n--\n-- >>> lines \"one\\ntwo\\n\"\n-- [\"one\",\"two\"]\n--\n-- Thus @'lines' s@ contains at least as many elements as newlines in @s@.\nlines                   :: String -> [String]\nlines \"\"                =  []\n-- Somehow GHC doesn't detect the selector thunks in the below code,\n-- so s' keeps a reference to the first line via the pair and we have\n-- a space leak (cf. #4334).\n-- So we need to make GHC see the selector thunks with a trick.\nlines s                 =  cons (case break (== '\\n') s of\n                                    (l, s') -> (l, case s' of\n                                                    []      -> []\n                                                    _:s''   -> lines s''))\n  where\n    cons ~(h, t)        =  h : t\n\n-- | 'unlines' is an inverse operation to 'lines'.\n-- It joins lines, after appending a terminating newline to each.\n--\n-- >>> unlines [\"Hello\", \"World\", \"!\"]\n-- \"Hello\\nWorld\\n!\\n\"\nunlines                 :: [String] -> String\n#if defined(USE_REPORT_PRELUDE)\nunlines                 =  concatMap (++ \"\\n\")\n#else\n-- HBC version (stolen)\n-- here's a more efficient version\nunlines [] = []\nunlines (l:ls) = l ++ '\\n' : unlines ls\n#endif\n\n-- | 'words' breaks a string up into a list of words, which were delimited\n-- by white space.\n--\n-- >>> words \"Lorem ipsum\\ndolor\"\n-- [\"Lorem\",\"ipsum\",\"dolor\"]\nwords                   :: String -> [String]\n{-# NOINLINE [1] words #-}\nwords s                 =  case dropWhile {-partain:Char.-}isSpace s of\n                                \"\" -> []\n                                s' -> w : words s''\n                                      where (w, s'') =\n                                             break {-partain:Char.-}isSpace s'\n\n{-# RULES\n\"words\" [~1] forall s . words s = build (\\c n -> wordsFB c n s)\n\"wordsList\" [1] wordsFB (:) [] = words\n #-}\nwordsFB :: ([Char] -> b -> b) -> b -> String -> b\n{-# INLINE [0] wordsFB #-} -- See Note [Inline FB functions] in GHC.List\nwordsFB c n = go\n  where\n    go s = case dropWhile isSpace s of\n             \"\" -> n\n             s' -> w `c` go s''\n                   where (w, s'') = break isSpace s'\n\n-- | 'unwords' is an inverse operation to 'words'.\n-- It joins words with separating spaces.\n--\n-- >>> unwords [\"Lorem\", \"ipsum\", \"dolor\"]\n-- \"Lorem ipsum dolor\"\nunwords                 :: [String] -> String\n#if defined(USE_REPORT_PRELUDE)\nunwords []              =  \"\"\nunwords ws              =  foldr1 (\\w s -> w ++ ' ':s) ws\n#else\n-- Here's a lazier version that can get the last element of a\n-- _|_-terminated list.\n{-# NOINLINE [1] unwords #-}\nunwords []              =  \"\"\nunwords (w:ws)          = w ++ go ws\n  where\n    go []     = \"\"\n    go (v:vs) = ' ' : (v ++ go vs)\n\n-- In general, the foldr-based version is probably slightly worse\n-- than the HBC version, because it adds an extra space and then takes\n-- it back off again. But when it fuses, it reduces allocation. How much\n-- depends entirely on the average word length--it's most effective when\n-- the words are on the short side.\n{-# RULES\n\"unwords\" [~1] forall ws .\n   unwords ws = tailUnwords (foldr unwordsFB \"\" ws)\n\"unwordsList\" [1] forall ws .\n   tailUnwords (foldr unwordsFB \"\" ws) = unwords ws\n #-}\n\n{-# INLINE [0] tailUnwords #-}\ntailUnwords           :: String -> String\ntailUnwords []        = []\ntailUnwords (_:xs)    = xs\n\n{-# INLINE [0] unwordsFB #-}\nunwordsFB               :: String -> String -> String\nunwordsFB w r           = ' ' : w ++ r\n#endif\n\n{- A \"SnocBuilder\" is a version of Chris Okasaki's banker's queue that supports\ntoListSB instead of uncons. In single-threaded use, its performance\ncharacteristics are similar to John Hughes's functional difference lists, but\nlikely somewhat worse. In heavily persistent settings, however, it does much\nbetter, because it takes advantage of sharing. The banker's queue guarantees\n(amortized) O(1) snoc and O(1) uncons, meaning that we can think of toListSB as\nan O(1) conversion to a list-like structure a constant factor slower than\nnormal lists--we pay the O(n) cost incrementally as we consume the list. Using\nfunctional difference lists, on the other hand, we would have to pay the whole\ncost up front for each output list. -}\n\n{- We store a front list, a rear list, and the length of the queue.  Because we\nonly snoc onto the queue and never uncons, we know it's time to rotate when the\nlength of the queue plus 1 is a power of 2. Note that we rely on the value of\nthe length field only for performance.  In the unlikely event of overflow, the\nperformance will suffer but the semantics will remain correct.  -}\n\ndata SnocBuilder a = SnocBuilder {-# UNPACK #-} !Word [a] [a]\n\n{- Smart constructor that rotates the builder when lp is one minus a power of\n2. Does not rotate very small builders because doing so is not worth the\ntrouble. The lp < 255 test goes first because the power-of-2 test gives awful\nbranch prediction for very small n (there are 5 powers of 2 between 1 and\n16). Putting the well-predicted lp < 255 test first avoids branching on the\npower-of-2 test until powers of 2 have become sufficiently rare to be predicted\nwell. -}\n\n{-# INLINE sb #-}\nsb :: Word -> [a] -> [a] -> SnocBuilder a\nsb lp f r\n  | lp < 255 || (lp .&. (lp + 1)) /= 0 = SnocBuilder lp f r\n  | otherwise                          = SnocBuilder lp (f ++ reverse r) []\n\n-- The empty builder\n\nemptySB :: SnocBuilder a\nemptySB = SnocBuilder 0 [] []\n\n-- Add an element to the end of a queue.\n\nsnocSB :: SnocBuilder a -> a -> SnocBuilder a\nsnocSB (SnocBuilder lp f r) x = sb (lp + 1) f (x:r)\n\n-- Convert a builder to a list\n\ntoListSB :: SnocBuilder a -> [a]\ntoListSB (SnocBuilder _ f r) = f ++ reverse r\n", "num_lines": 1502}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Ord\n-- Copyright   :  (c) The University of Glasgow 2005\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- Orderings\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Ord (\n   Ord(..),\n   Ordering(..),\n   Down(..),\n   comparing,\n ) where\n\nimport GHC.Base\nimport GHC.Show\nimport GHC.Read\nimport GHC.Num\n\n-- | \n-- > comparing p x y = compare (p x) (p y)\n--\n-- Useful combinator for use in conjunction with the @xxxBy@ family\n-- of functions from \"Data.List\", for example:\n--\n-- >   ... sortBy (comparing fst) ...\ncomparing :: (Ord a) => (b -> a) -> b -> b -> Ordering\ncomparing p x y = compare (p x) (p y)\n\n-- | The 'Down' type allows you to reverse sort order conveniently.  A value of type\n-- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@).\n-- If @a@ has an @'Ord'@ instance associated with it then comparing two\n-- values thus wrapped will give you the opposite of their normal sort order.\n-- This is particularly useful when sorting in generalised list comprehensions,\n-- as in: @then sortWith by 'Down' x@\n--\n-- @since 4.6.0.0\nnewtype Down a = Down a\n    deriving\n      ( Eq        -- ^ @since 4.6.0.0\n      , Show      -- ^ @since 4.7.0.0\n      , Read      -- ^ @since 4.7.0.0\n      , Num       -- ^ @since 4.11.0.0\n      , Semigroup -- ^ @since 4.11.0.0\n      , Monoid    -- ^ @since 4.11.0.0\n      )\n\n-- | @since 4.6.0.0\ninstance Ord a => Ord (Down a) where\n    compare (Down x) (Down y) = y `compare` x\n\n-- | @since 4.11.0.0\ninstance Functor Down where\n    fmap = coerce\n\n-- | @since 4.11.0.0\ninstance Applicative Down where\n    pure = Down\n    (<*>) = coerce\n\n-- | @since 4.11.0.0\ninstance Monad Down where\n    Down a >>= k = k a\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE PolyKinds #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Proxy\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Definition of a Proxy type (poly-kinded in GHC)\n--\n-- @since 4.7.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Proxy\n  (\n        Proxy(..), asProxyTypeOf\n      , KProxy(..)\n  ) where\n\nimport GHC.Base\nimport GHC.Show\nimport GHC.Read\nimport GHC.Enum\nimport GHC.Arr\n\n-- $setup\n-- >>> import Data.Void\n-- >>> import Prelude\n\n-- | 'Proxy' is a type that holds no data, but has a phantom parameter of\n-- arbitrary type (or even kind). Its use is to provide type information, even\n-- though there is no value available of that type (or it may be too costly to\n-- create one).\n--\n-- Historically, @'Proxy' :: 'Proxy' a@ is a safer alternative to the\n-- @'undefined' :: a@ idiom.\n--\n-- >>> Proxy :: Proxy (Void, Int -> Int)\n-- Proxy\n--\n-- Proxy can even hold types of higher kinds,\n--\n-- >>> Proxy :: Proxy Either\n-- Proxy\n--\n-- >>> Proxy :: Proxy Functor\n-- Proxy\n--\n-- >>> Proxy :: Proxy complicatedStructure\n-- Proxy\ndata Proxy t = Proxy deriving ( Bounded -- ^ @since 4.7.0.0\n                              , Read    -- ^ @since 4.7.0.0\n                              )\n\n-- | A concrete, promotable proxy type, for use at the kind level.\n-- There are no instances for this because it is intended at the kind level only\ndata KProxy (t :: Type) = KProxy\n\n-- It's common to use (undefined :: Proxy t) and (Proxy :: Proxy t)\n-- interchangeably, so all of these instances are hand-written to be\n-- lazy in Proxy arguments.\n\n-- | @since 4.7.0.0\ninstance Eq (Proxy s) where\n  _ == _ = True\n\n-- | @since 4.7.0.0\ninstance Ord (Proxy s) where\n  compare _ _ = EQ\n\n-- | @since 4.7.0.0\ninstance Show (Proxy s) where\n  showsPrec _ _ = showString \"Proxy\"\n\n-- | @since 4.7.0.0\ninstance Enum (Proxy s) where\n    succ _               = errorWithoutStackTrace \"Proxy.succ\"\n    pred _               = errorWithoutStackTrace \"Proxy.pred\"\n    fromEnum _           = 0\n    toEnum 0             = Proxy\n    toEnum _             = errorWithoutStackTrace \"Proxy.toEnum: 0 expected\"\n    enumFrom _           = [Proxy]\n    enumFromThen _ _     = [Proxy]\n    enumFromThenTo _ _ _ = [Proxy]\n    enumFromTo _ _       = [Proxy]\n\n-- | @since 4.7.0.0\ninstance Ix (Proxy s) where\n    range _           = [Proxy]\n    index _ _         = 0\n    inRange _ _       = True\n    rangeSize _       = 1\n    unsafeIndex _ _   = 0\n    unsafeRangeSize _ = 1\n\n-- | @since 4.9.0.0\ninstance Semigroup (Proxy s) where\n    _ <> _ = Proxy\n    sconcat _ = Proxy\n    stimes _ _ = Proxy\n\n-- | @since 4.7.0.0\ninstance Monoid (Proxy s) where\n    mempty = Proxy\n    mconcat _ = Proxy\n\n-- | @since 4.7.0.0\ninstance Functor Proxy where\n    fmap _ _ = Proxy\n    {-# INLINE fmap #-}\n\n-- | @since 4.7.0.0\ninstance Applicative Proxy where\n    pure _ = Proxy\n    {-# INLINE pure #-}\n    _ <*> _ = Proxy\n    {-# INLINE (<*>) #-}\n\n-- | @since 4.9.0.0\ninstance Alternative Proxy where\n    empty = Proxy\n    {-# INLINE empty #-}\n    _ <|> _ = Proxy\n    {-# INLINE (<|>) #-}\n\n-- | @since 4.7.0.0\ninstance Monad Proxy where\n    _ >>= _ = Proxy\n    {-# INLINE (>>=) #-}\n\n-- | @since 4.9.0.0\ninstance MonadPlus Proxy\n\n-- | 'asProxyTypeOf' is a type-restricted version of 'const'.\n-- It is usually used as an infix operator, and its typing forces its first\n-- argument (which is usually overloaded) to have the same type as the tag\n-- of the second.\n--\n-- >>> import Data.Word\n-- >>> :type asProxyTypeOf 123 (Proxy :: Proxy Word8)\n-- asProxyTypeOf 123 (Proxy :: Proxy Word8) :: Word8\n--\n-- Note the lower-case @proxy@ in the definition. This allows any type\n-- constructor with just one argument to be passed to the function, for example\n-- we could also write\n--\n-- >>> import Data.Word\n-- >>> :type asProxyTypeOf 123 (Just (undefined :: Word8))\n-- asProxyTypeOf 123 (Just (undefined :: Word8)) :: Word8\nasProxyTypeOf :: a -> proxy a -> a\nasProxyTypeOf = const\n{-# INLINE asProxyTypeOf #-}\n\n", "num_lines": 159}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Ratio\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- Standard functions on rational numbers\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Ratio\n    ( Ratio\n    , Rational\n    , (%)\n    , numerator\n    , denominator\n    , approxRational\n\n  ) where\n\nimport GHC.Real         -- The basic defns for Ratio\n\n-- -----------------------------------------------------------------------------\n-- approxRational\n\n-- | 'approxRational', applied to two real fractional numbers @x@ and @epsilon@,\n-- returns the simplest rational number within @epsilon@ of @x@.\n-- A rational number @y@ is said to be /simpler/ than another @y'@ if\n--\n-- * @'abs' ('numerator' y) <= 'abs' ('numerator' y')@, and\n--\n-- * @'denominator' y <= 'denominator' y'@.\n--\n-- Any real interval contains a unique simplest rational;\n-- in particular, note that @0\\/1@ is the simplest rational of all.\n\n-- Implementation details: Here, for simplicity, we assume a closed rational\n-- interval.  If such an interval includes at least one whole number, then\n-- the simplest rational is the absolutely least whole number.  Otherwise,\n-- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d\n-- and abs r' < d', and the simplest rational is q%1 + the reciprocal of\n-- the simplest rational between d'%r' and d%r.\n\napproxRational :: (RealFrac a) => a -> a -> Rational\napproxRational rat eps =\n    -- We convert rat and eps to rational *before* subtracting/adding since\n    -- otherwise we may overflow. This was the cause of #14425.\n    simplest (toRational rat - toRational eps) (toRational rat + toRational eps)\n  where\n    simplest x y\n      | y < x      =  simplest y x\n      | x == y     =  xr\n      | x > 0      =  simplest' n d n' d'\n      | y < 0      =  - simplest' (-n') d' (-n) d\n      | otherwise  =  0 :% 1\n      where xr  = toRational x\n            n   = numerator xr\n            d   = denominator xr\n            nd' = toRational y\n            n'  = numerator nd'\n            d'  = denominator nd'\n\n    simplest' n d n' d'       -- assumes 0 < n%d < n'%d'\n      | r == 0     =  q :% 1\n      | q /= q'    =  (q+1) :% 1\n      | otherwise  =  (q*n''+d'') :% n''\n      where (q,r)      =  quotRem n d\n            (q',r')    =  quotRem n' d'\n            nd''       =  simplest' d' r' d r\n            n''        =  numerator nd''\n            d''        =  denominator nd''\n\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP                        #-}\n{-# LANGUAGE DefaultSignatures          #-}\n{-# LANGUAGE DeriveDataTypeable         #-}\n{-# LANGUAGE DeriveGeneric              #-}\n{-# LANGUAGE FlexibleContexts           #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE PolyKinds                  #-}\n{-# LANGUAGE ScopedTypeVariables        #-}\n{-# LANGUAGE Trustworthy                #-}\n{-# LANGUAGE TypeOperators              #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Semigroup\n-- Copyright   :  (C) 2011-2015 Edward Kmett\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A type @a@ is a 'Semigroup' if it provides an associative function ('<>')\n-- that lets you combine any two values of type @a@ into one. Where being\n-- associative means that the following must always hold:\n--\n-- >>> (a <> b) <> c == a <> (b <> c)\n--\n-- ==== __Examples__\n--\n-- The 'Min' 'Semigroup' instance for 'Int' is defined to always pick the smaller\n-- number:\n-- >>> Min 1 <> Min 2 <> Min 3 <> Min 4 :: Min Int\n-- Min {getMin = 1}\n--\n-- If we need to combine multiple values we can use the 'sconcat' function\n-- to do so. We need to ensure however that we have at least one value to\n-- operate on, since otherwise our result would be undefined. It is for this\n-- reason that 'sconcat' uses \"Data.List.NonEmpty.NonEmpty\" - a list that\n-- can never be empty:\n--\n-- >>> (1 :| [])\n-- 1 :| []               -- equivalent to [1] but guaranteed to be non-empty\n-- >>> (1 :| [2, 3, 4])\n-- 1 :| [2,3,4]          -- equivalent to [1,2,3,4] but guaranteed to be non-empty\n--\n-- Equipped with this guaranteed to be non-empty data structure, we can combine\n-- values using 'sconcat' and a 'Semigroup' of our choosing. We can try the 'Min'\n-- and 'Max' instances of 'Int' which pick the smallest, or largest number\n-- respectively:\n--\n-- >>> sconcat (1 :| [2, 3, 4]) :: Min Int\n-- Min {getMin = 1}\n-- >>> sconcat (1 :| [2, 3, 4]) :: Max Int\n-- Max {getMax = 4}\n--\n-- String concatenation is another example of a 'Semigroup' instance:\n--\n-- >>> \"foo\" <> \"bar\"\n-- \"foobar\"\n--\n-- A 'Semigroup' is a generalization of a 'Monoid'. Yet unlike the 'Semigroup', the 'Monoid'\n-- requires the presence of a neutral element ('mempty') in addition to the associative\n-- operator. The requirement for a neutral element prevents many types from being a full Monoid,\n-- like \"Data.List.NonEmpty.NonEmpty\".\n--\n-- Note that the use of @(\\<\\>)@ in this module conflicts with an operator with the same\n-- name that is being exported by \"Data.Monoid\". However, this package\n-- re-exports (most of) the contents of Data.Monoid, so to use semigroups\n-- and monoids in the same package just\n--\n-- > import Data.Semigroup\n--\n-- @since 4.9.0.0\n----------------------------------------------------------------------------\nmodule Data.Semigroup (\n    Semigroup(..)\n  , stimesMonoid\n  , stimesIdempotent\n  , stimesIdempotentMonoid\n  , mtimesDefault\n  -- * Semigroups\n  , Min(..)\n  , Max(..)\n  , First(..)\n  , Last(..)\n  , WrappedMonoid(..)\n  -- * Re-exported monoids from Data.Monoid\n  , Dual(..)\n  , Endo(..)\n  , All(..)\n  , Any(..)\n  , Sum(..)\n  , Product(..)\n  -- * A better monoid for Maybe\n  , Option(..)\n  , option\n  -- * Difference lists of a semigroup\n  , diff\n  , cycle1\n  -- * ArgMin, ArgMax\n  , Arg(..)\n  , ArgMin\n  , ArgMax\n  ) where\n\nimport           Prelude             hiding (foldr1)\n\nimport GHC.Base (Semigroup(..))\n\nimport           Data.Semigroup.Internal\n\nimport           Control.Applicative\nimport           Control.Monad\nimport           Control.Monad.Fix\nimport           Data.Bifoldable\nimport           Data.Bifunctor\nimport           Data.Bitraversable\nimport           Data.Coerce\nimport           Data.Data\nimport           GHC.Generics\n\n-- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'.\n-- May fail to terminate for some values in some semigroups.\ncycle1 :: Semigroup m => m -> m\ncycle1 xs = xs' where xs' = xs <> xs'\n\n-- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'.\ndiff :: Semigroup m => m -> Endo m\ndiff = Endo . (<>)\n\nnewtype Min a = Min { getMin :: a }\n  deriving ( Bounded  -- ^ @since 4.9.0.0\n           , Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Read     -- ^ @since 4.9.0.0\n           , Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Enum a => Enum (Min a) where\n  succ (Min a) = Min (succ a)\n  pred (Min a) = Min (pred a)\n  toEnum = Min . toEnum\n  fromEnum = fromEnum . getMin\n  enumFrom (Min a) = Min <$> enumFrom a\n  enumFromThen (Min a) (Min b) = Min <$> enumFromThen a b\n  enumFromTo (Min a) (Min b) = Min <$> enumFromTo a b\n  enumFromThenTo (Min a) (Min b) (Min c) = Min <$> enumFromThenTo a b c\n\n\n-- | @since 4.9.0.0\ninstance Ord a => Semigroup (Min a) where\n  (<>) = coerce (min :: a -> a -> a)\n  stimes = stimesIdempotent\n\n-- | @since 4.9.0.0\ninstance (Ord a, Bounded a) => Monoid (Min a) where\n  mempty = maxBound\n\n-- | @since 4.9.0.0\ninstance Functor Min where\n  fmap f (Min x) = Min (f x)\n\n-- | @since 4.9.0.0\ninstance Foldable Min where\n  foldMap f (Min a) = f a\n\n-- | @since 4.9.0.0\ninstance Traversable Min where\n  traverse f (Min a) = Min <$> f a\n\n-- | @since 4.9.0.0\ninstance Applicative Min where\n  pure = Min\n  a <* _ = a\n  _ *> a = a\n  (<*>) = coerce\n  liftA2 = coerce\n\n-- | @since 4.9.0.0\ninstance Monad Min where\n  (>>) = (*>)\n  Min a >>= f = f a\n\n-- | @since 4.9.0.0\ninstance MonadFix Min where\n  mfix f = fix (f . getMin)\n\n-- | @since 4.9.0.0\ninstance Num a => Num (Min a) where\n  (Min a) + (Min b) = Min (a + b)\n  (Min a) * (Min b) = Min (a * b)\n  (Min a) - (Min b) = Min (a - b)\n  negate (Min a) = Min (negate a)\n  abs    (Min a) = Min (abs a)\n  signum (Min a) = Min (signum a)\n  fromInteger    = Min . fromInteger\n\nnewtype Max a = Max { getMax :: a }\n  deriving ( Bounded  -- ^ @since 4.9.0.0\n           , Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Read     -- ^ @since 4.9.0.0\n           , Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Enum a => Enum (Max a) where\n  succ (Max a) = Max (succ a)\n  pred (Max a) = Max (pred a)\n  toEnum = Max . toEnum\n  fromEnum = fromEnum . getMax\n  enumFrom (Max a) = Max <$> enumFrom a\n  enumFromThen (Max a) (Max b) = Max <$> enumFromThen a b\n  enumFromTo (Max a) (Max b) = Max <$> enumFromTo a b\n  enumFromThenTo (Max a) (Max b) (Max c) = Max <$> enumFromThenTo a b c\n\n-- | @since 4.9.0.0\ninstance Ord a => Semigroup (Max a) where\n  (<>) = coerce (max :: a -> a -> a)\n  stimes = stimesIdempotent\n\n-- | @since 4.9.0.0\ninstance (Ord a, Bounded a) => Monoid (Max a) where\n  mempty = minBound\n\n-- | @since 4.9.0.0\ninstance Functor Max where\n  fmap f (Max x) = Max (f x)\n\n-- | @since 4.9.0.0\ninstance Foldable Max where\n  foldMap f (Max a) = f a\n\n-- | @since 4.9.0.0\ninstance Traversable Max where\n  traverse f (Max a) = Max <$> f a\n\n-- | @since 4.9.0.0\ninstance Applicative Max where\n  pure = Max\n  a <* _ = a\n  _ *> a = a\n  (<*>) = coerce\n  liftA2 = coerce\n\n-- | @since 4.9.0.0\ninstance Monad Max where\n  (>>) = (*>)\n  Max a >>= f = f a\n\n-- | @since 4.9.0.0\ninstance MonadFix Max where\n  mfix f = fix (f . getMax)\n\n-- | @since 4.9.0.0\ninstance Num a => Num (Max a) where\n  (Max a) + (Max b) = Max (a + b)\n  (Max a) * (Max b) = Max (a * b)\n  (Max a) - (Max b) = Max (a - b)\n  negate (Max a) = Max (negate a)\n  abs    (Max a) = Max (abs a)\n  signum (Max a) = Max (signum a)\n  fromInteger    = Max . fromInteger\n\n-- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be\n-- placed inside 'Min' and 'Max' to compute an arg min or arg max.\ndata Arg a b = Arg a b deriving\n  ( Show     -- ^ @since 4.9.0.0\n  , Read     -- ^ @since 4.9.0.0\n  , Data     -- ^ @since 4.9.0.0\n  , Generic  -- ^ @since 4.9.0.0\n  , Generic1 -- ^ @since 4.9.0.0\n  )\n\ntype ArgMin a b = Min (Arg a b)\ntype ArgMax a b = Max (Arg a b)\n\n-- | @since 4.9.0.0\ninstance Functor (Arg a) where\n  fmap f (Arg x a) = Arg x (f a)\n\n-- | @since 4.9.0.0\ninstance Foldable (Arg a) where\n  foldMap f (Arg _ a) = f a\n\n-- | @since 4.9.0.0\ninstance Traversable (Arg a) where\n  traverse f (Arg x a) = Arg x <$> f a\n\n-- | @since 4.9.0.0\ninstance Eq a => Eq (Arg a b) where\n  Arg a _ == Arg b _ = a == b\n\n-- | @since 4.9.0.0\ninstance Ord a => Ord (Arg a b) where\n  Arg a _ `compare` Arg b _ = compare a b\n  min x@(Arg a _) y@(Arg b _)\n    | a <= b    = x\n    | otherwise = y\n  max x@(Arg a _) y@(Arg b _)\n    | a >= b    = x\n    | otherwise = y\n\n-- | @since 4.9.0.0\ninstance Bifunctor Arg where\n  bimap f g (Arg a b) = Arg (f a) (g b)\n\n-- | @since 4.10.0.0\ninstance Bifoldable Arg where\n  bifoldMap f g (Arg a b) = f a <> g b\n\n-- | @since 4.10.0.0\ninstance Bitraversable Arg where\n  bitraverse f g (Arg a b) = Arg <$> f a <*> g b\n\n-- | Use @'Option' ('First' a)@ to get the behavior of\n-- 'Data.Monoid.First' from \"Data.Monoid\".\nnewtype First a = First { getFirst :: a }\n  deriving ( Bounded  -- ^ @since 4.9.0.0\n           , Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Read     -- ^ @since 4.9.0.0\n           , Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Enum a => Enum (First a) where\n  succ (First a) = First (succ a)\n  pred (First a) = First (pred a)\n  toEnum = First . toEnum\n  fromEnum = fromEnum . getFirst\n  enumFrom (First a) = First <$> enumFrom a\n  enumFromThen (First a) (First b) = First <$> enumFromThen a b\n  enumFromTo (First a) (First b) = First <$> enumFromTo a b\n  enumFromThenTo (First a) (First b) (First c) = First <$> enumFromThenTo a b c\n\n-- | @since 4.9.0.0\ninstance Semigroup (First a) where\n  a <> _ = a\n  stimes = stimesIdempotent\n\n-- | @since 4.9.0.0\ninstance Functor First where\n  fmap f (First x) = First (f x)\n\n-- | @since 4.9.0.0\ninstance Foldable First where\n  foldMap f (First a) = f a\n\n-- | @since 4.9.0.0\ninstance Traversable First where\n  traverse f (First a) = First <$> f a\n\n-- | @since 4.9.0.0\ninstance Applicative First where\n  pure x = First x\n  a <* _ = a\n  _ *> a = a\n  (<*>) = coerce\n  liftA2 = coerce\n\n-- | @since 4.9.0.0\ninstance Monad First where\n  (>>) = (*>)\n  First a >>= f = f a\n\n-- | @since 4.9.0.0\ninstance MonadFix First where\n  mfix f = fix (f . getFirst)\n\n-- | Use @'Option' ('Last' a)@ to get the behavior of\n-- 'Data.Monoid.Last' from \"Data.Monoid\"\nnewtype Last a = Last { getLast :: a }\n  deriving ( Bounded  -- ^ @since 4.9.0.0\n           , Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Read     -- ^ @since 4.9.0.0\n           , Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Enum a => Enum (Last a) where\n  succ (Last a) = Last (succ a)\n  pred (Last a) = Last (pred a)\n  toEnum = Last . toEnum\n  fromEnum = fromEnum . getLast\n  enumFrom (Last a) = Last <$> enumFrom a\n  enumFromThen (Last a) (Last b) = Last <$> enumFromThen a b\n  enumFromTo (Last a) (Last b) = Last <$> enumFromTo a b\n  enumFromThenTo (Last a) (Last b) (Last c) = Last <$> enumFromThenTo a b c\n\n-- | @since 4.9.0.0\ninstance Semigroup (Last a) where\n  _ <> b = b\n  stimes = stimesIdempotent\n\n-- | @since 4.9.0.0\ninstance Functor Last where\n  fmap f (Last x) = Last (f x)\n  a <$ _ = Last a\n\n-- | @since 4.9.0.0\ninstance Foldable Last where\n  foldMap f (Last a) = f a\n\n-- | @since 4.9.0.0\ninstance Traversable Last where\n  traverse f (Last a) = Last <$> f a\n\n-- | @since 4.9.0.0\ninstance Applicative Last where\n  pure = Last\n  a <* _ = a\n  _ *> a = a\n  (<*>) = coerce\n  liftA2 = coerce\n\n-- | @since 4.9.0.0\ninstance Monad Last where\n  (>>) = (*>)\n  Last a >>= f = f a\n\n-- | @since 4.9.0.0\ninstance MonadFix Last where\n  mfix f = fix (f . getLast)\n\n-- | Provide a Semigroup for an arbitrary Monoid.\n--\n-- __NOTE__: This is not needed anymore since 'Semigroup' became a superclass of\n-- 'Monoid' in /base-4.11/ and this newtype be deprecated at some point in the future.\nnewtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m }\n  deriving ( Bounded  -- ^ @since 4.9.0.0\n           , Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Read     -- ^ @since 4.9.0.0\n           , Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Monoid m => Semigroup (WrappedMonoid m) where\n  (<>) = coerce (mappend :: m -> m -> m)\n\n-- | @since 4.9.0.0\ninstance Monoid m => Monoid (WrappedMonoid m) where\n  mempty = WrapMonoid mempty\n\n-- | @since 4.9.0.0\ninstance Enum a => Enum (WrappedMonoid a) where\n  succ (WrapMonoid a) = WrapMonoid (succ a)\n  pred (WrapMonoid a) = WrapMonoid (pred a)\n  toEnum = WrapMonoid . toEnum\n  fromEnum = fromEnum . unwrapMonoid\n  enumFrom (WrapMonoid a) = WrapMonoid <$> enumFrom a\n  enumFromThen (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromThen a b\n  enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromTo a b\n  enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) =\n      WrapMonoid <$> enumFromThenTo a b c\n\n-- | Repeat a value @n@ times.\n--\n-- > mtimesDefault n a = a <> a <> ... <> a  -- using <> (n-1) times\n--\n-- Implemented using 'stimes' and 'mempty'.\n--\n-- This is a suitable definition for an 'mtimes' member of 'Monoid'.\nmtimesDefault :: (Integral b, Monoid a) => b -> a -> a\nmtimesDefault n x\n  | n == 0    = mempty\n  | otherwise = unwrapMonoid (stimes n (WrapMonoid x))\n\n-- | 'Option' is effectively 'Maybe' with a better instance of\n-- 'Monoid', built off of an underlying 'Semigroup' instead of an\n-- underlying 'Monoid'.\n--\n-- Ideally, this type would not exist at all and we would just fix the\n-- 'Monoid' instance of 'Maybe'.\n--\n-- In GHC 8.4 and higher, the 'Monoid' instance for 'Maybe' has been\n-- corrected to lift a 'Semigroup' instance instead of a 'Monoid'\n-- instance. Consequently, this type is no longer useful. It will be\n-- marked deprecated in GHC 8.8 and removed in GHC 8.10.\nnewtype Option a = Option { getOption :: Maybe a }\n  deriving ( Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Read     -- ^ @since 4.9.0.0\n           , Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Functor Option where\n  fmap f (Option a) = Option (fmap f a)\n\n-- | @since 4.9.0.0\ninstance Applicative Option where\n  pure a = Option (Just a)\n  Option a <*> Option b = Option (a <*> b)\n  liftA2 f (Option x) (Option y) = Option (liftA2 f x y)\n\n  Option Nothing  *>  _ = Option Nothing\n  _               *>  b = b\n\n-- | @since 4.9.0.0\ninstance Monad Option where\n  Option (Just a) >>= k = k a\n  _               >>= _ = Option Nothing\n  (>>) = (*>)\n\n-- | @since 4.9.0.0\ninstance Alternative Option where\n  empty = Option Nothing\n  Option Nothing <|> b = b\n  a <|> _ = a\n\n-- | @since 4.9.0.0\ninstance MonadPlus Option\n\n-- | @since 4.9.0.0\ninstance MonadFix Option where\n  mfix f = Option (mfix (getOption . f))\n\n-- | @since 4.9.0.0\ninstance Foldable Option where\n  foldMap f (Option (Just m)) = f m\n  foldMap _ (Option Nothing)  = mempty\n\n-- | @since 4.9.0.0\ninstance Traversable Option where\n  traverse f (Option (Just a)) = Option . Just <$> f a\n  traverse _ (Option Nothing)  = pure (Option Nothing)\n\n-- | Fold an 'Option' case-wise, just like 'maybe'.\noption :: b -> (a -> b) -> Option a -> b\noption n j (Option m) = maybe n j m\n\n-- | @since 4.9.0.0\ninstance Semigroup a => Semigroup (Option a) where\n  (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a)\n#if !defined(__HADDOCK_VERSION__)\n    -- workaround https://github.com/haskell/haddock/issues/680\n  stimes _ (Option Nothing) = Option Nothing\n  stimes n (Option (Just a)) = case compare n 0 of\n    LT -> errorWithoutStackTrace \"stimes: Option, negative multiplier\"\n    EQ -> Option Nothing\n    GT -> Option (Just (stimes n a))\n#endif\n\n-- | @since 4.9.0.0\ninstance Semigroup a => Monoid (Option a) where\n  mempty = Option Nothing\n", "num_lines": 569}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.STRef\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (uses Control.Monad.ST)\n--\n-- Mutable references in the (strict) ST monad.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.STRef (\n        -- * STRefs\n        STRef,          -- abstract\n        newSTRef,\n        readSTRef,\n        writeSTRef,\n        modifySTRef,\n        modifySTRef'\n ) where\n\nimport GHC.ST\nimport GHC.STRef\n\n-- | Mutate the contents of an 'STRef'.\n--\n-- >>> :{\n-- runST (do\n--     ref <- newSTRef \"\"\n--     modifySTRef ref (const \"world\")\n--     modifySTRef ref (++ \"!\")\n--     modifySTRef ref (\"Hello, \" ++)\n--     readSTRef ref )\n-- :}\n-- \"Hello, world!\"\n--\n-- Be warned that 'modifySTRef' does not apply the function strictly.  This\n-- means if the program calls 'modifySTRef' many times, but seldomly uses the\n-- value, thunks will pile up in memory resulting in a space leak.  This is a\n-- common mistake made when using an 'STRef' as a counter.  For example, the\n-- following will leak memory and may produce a stack overflow:\n--\n-- >>> import Control.Monad (replicateM_)\n-- >>> :{\n-- print (runST (do\n--     ref <- newSTRef 0\n--     replicateM_ 1000 $ modifySTRef ref (+1)\n--     readSTRef ref ))\n-- :}\n-- 1000\n--\n-- To avoid this problem, use 'modifySTRef'' instead.\nmodifySTRef :: STRef s a -> (a -> a) -> ST s ()\nmodifySTRef ref f = writeSTRef ref . f =<< readSTRef ref\n\n-- | Strict version of 'modifySTRef'\n--\n-- @since 4.6.0.0\nmodifySTRef' :: STRef s a -> (a -> a) -> ST s ()\nmodifySTRef' ref f = do\n    x <- readSTRef ref\n    let x' = f x\n    x' `seq` writeSTRef ref x'\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.String\n-- Copyright   :  (c) The University of Glasgow 2007\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The @String@ type and associated operations.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.String (\n   String\n , IsString(..)\n\n -- * Functions on strings\n , lines\n , words\n , unlines\n , unwords\n ) where\n\nimport GHC.Base\nimport Data.Functor.Const (Const (Const))\nimport Data.Functor.Identity (Identity (Identity))\nimport Data.List (lines, words, unlines, unwords)\n\n-- | Class for string-like datastructures; used by the overloaded string\n--   extension (-XOverloadedStrings in GHC).\nclass IsString a where\n    fromString :: String -> a\n\n{- Note [IsString String]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nPreviously, the IsString instance that covered String was a flexible\ninstance for [Char]. This is in some sense the most accurate choice,\nbut there are cases where it can lead to an ambiguity, for instance:\n\n  show $ \"foo\" ++ \"bar\"\n\nThe use of (++) ensures that \"foo\" and \"bar\" must have type [t] for\nsome t, but a flexible instance for [Char] will _only_ match if\nsomething further determines t to be Char, and nothing in the above\nexample actually does.\n\nSo, the above example generates an error about the ambiguity of t,\nand what's worse, the above behavior can be generated by simply\ntyping:\n\n   \"foo\" ++ \"bar\"\n\ninto GHCi with the OverloadedStrings extension enabled.\n\nThe new instance fixes this by defining an instance that matches all\n[a], and forces a to be Char. This instance, of course, overlaps\nwith things that the [Char] flexible instance doesn't, but this was\njudged to be an acceptable cost, for the gain of providing a less\nconfusing experience for people experimenting with overloaded strings.\n\nIt may be possible to fix this via (extended) defaulting. Currently,\nthe rules are not able to default t to Char in the above example. If\na more flexible system that enabled this defaulting were put in place,\nthen it would probably make sense to revert to the flexible [Char]\ninstance, since extended defaulting is enabled in GHCi. However, it\nis not clear at the time of this note exactly what such a system\nwould be, and it certainly hasn't been implemented.\n\nA test case (should_run/overloadedstringsrun01.hs) has been added to\nensure the good behavior of the above example remains in the future.\n-}\n\n-- | @(a ~ Char)@ context was introduced in @4.9.0.0@\n--\n-- @since 2.01\ninstance (a ~ Char) => IsString [a] where\n         -- See Note [IsString String]\n    fromString xs = xs\n\n-- | @since 4.9.0.0\nderiving instance IsString a => IsString (Const a b)\n\n-- | @since 4.9.0.0\nderiving instance IsString a => IsString (Identity a)\n", "num_lines": 94}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeOperators #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Traversable\n-- Copyright   :  Conor McBride and Ross Paterson 2005\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Class of data structures that can be traversed from left to right,\n-- performing an action on each element.\n--\n-- See also\n--\n--  * \\\"Applicative Programming with Effects\\\",\n--    by Conor McBride and Ross Paterson,\n--    /Journal of Functional Programming/ 18:1 (2008) 1-13, online at\n--    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.\n--\n--  * \\\"The Essence of the Iterator Pattern\\\",\n--    by Jeremy Gibbons and Bruno Oliveira,\n--    in /Mathematically-Structured Functional Programming/, 2006, online at\n--    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.\n--\n--  * \\\"An Investigation of the Laws of Traversals\\\",\n--    by Mauro Jaskelioff and Ondrej Rypacek,\n--    in /Mathematically-Structured Functional Programming/, 2012, online at\n--    <http://arxiv.org/pdf/1202.2919>.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Traversable (\n    -- * The 'Traversable' class\n    Traversable(..),\n    -- * Utility functions\n    for,\n    forM,\n    mapAccumL,\n    mapAccumR,\n    -- * General definitions for superclass methods\n    fmapDefault,\n    foldMapDefault,\n    ) where\n\n-- It is convenient to use 'Const' here but this means we must\n-- define a few instances here which really belong in Control.Applicative\nimport Control.Applicative ( Const(..), ZipList(..) )\nimport Data.Coerce\nimport Data.Either ( Either(..) )\nimport Data.Foldable ( Foldable )\nimport Data.Functor\nimport Data.Functor.Identity ( Identity(..) )\nimport Data.Functor.Utils ( StateL(..), StateR(..) )\nimport Data.Monoid ( Dual(..), Sum(..), Product(..),\n                     First(..), Last(..), Alt(..), Ap(..) )\nimport Data.Ord ( Down(..) )\nimport Data.Proxy ( Proxy(..) )\n\nimport GHC.Arr\nimport GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..), NonEmpty(..),\n                  ($), (.), id, flip )\nimport GHC.Generics\nimport qualified GHC.List as List ( foldr )\n\n-- | Functors representing data structures that can be traversed from\n-- left to right.\n--\n-- A definition of 'traverse' must satisfy the following laws:\n--\n-- [Naturality]\n--   @t . 'traverse' f = 'traverse' (t . f)@\n--   for every applicative transformation @t@\n--\n-- [Identity]\n--   @'traverse' 'Identity' = 'Identity'@\n--\n-- [Composition]\n--   @'traverse' ('Data.Functor.Compose.Compose' . 'fmap' g . f)\n--     = 'Data.Functor.Compose.Compose' . 'fmap' ('traverse' g) . 'traverse' f@\n--\n-- A definition of 'sequenceA' must satisfy the following laws:\n--\n-- [Naturality]\n--   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@\n--   for every applicative transformation @t@\n--\n-- [Identity]\n--   @'sequenceA' . 'fmap' 'Identity' = 'Identity'@\n--\n-- [Composition]\n--   @'sequenceA' . 'fmap' 'Data.Functor.Compose.Compose'\n--     = 'Data.Functor.Compose.Compose' . 'fmap' 'sequenceA' . 'sequenceA'@\n--\n-- where an /applicative transformation/ is a function\n--\n-- @t :: (Applicative f, Applicative g) => f a -> g a@\n--\n-- preserving the 'Applicative' operations, i.e.\n--\n-- @\n-- t ('pure' x) = 'pure' x\n-- t (f '<*>' x) = t f '<*>' t x\n-- @\n--\n-- and the identity functor 'Identity' and composition functors\n-- 'Data.Functor.Compose.Compose' are from \"Data.Functor.Identity\" and\n-- \"Data.Functor.Compose\".\n--\n-- (The naturality law is implied by parametricity.)\n--\n-- Instances are similar to 'Functor', e.g. given a data type\n--\n-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)\n--\n-- a suitable instance would be\n--\n-- > instance Traversable Tree where\n-- >    traverse f Empty = pure Empty\n-- >    traverse f (Leaf x) = Leaf <$> f x\n-- >    traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r\n--\n-- This is suitable even for abstract types, as the laws for '<*>'\n-- imply a form of associativity.\n--\n-- The superclass instances should satisfy the following:\n--\n--  * In the 'Functor' instance, 'fmap' should be equivalent to traversal\n--    with the identity applicative functor ('fmapDefault').\n--\n--  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be\n--    equivalent to traversal with a constant applicative functor\n--    ('foldMapDefault').\n--\nclass (Functor t, Foldable t) => Traversable t where\n    {-# MINIMAL traverse | sequenceA #-}\n\n    -- | Map each element of a structure to an action, evaluate these actions\n    -- from left to right, and collect the results. For a version that ignores\n    -- the results see 'Data.Foldable.traverse_'.\n    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)\n    {-# INLINE traverse #-}  -- See Note [Inline default methods]\n    traverse f = sequenceA . fmap f\n\n    -- | Evaluate each action in the structure from left to right, and\n    -- collect the results. For a version that ignores the results\n    -- see 'Data.Foldable.sequenceA_'.\n    sequenceA :: Applicative f => t (f a) -> f (t a)\n    {-# INLINE sequenceA #-}  -- See Note [Inline default methods]\n    sequenceA = traverse id\n\n    -- | Map each element of a structure to a monadic action, evaluate\n    -- these actions from left to right, and collect the results. For\n    -- a version that ignores the results see 'Data.Foldable.mapM_'.\n    mapM :: Monad m => (a -> m b) -> t a -> m (t b)\n    {-# INLINE mapM #-}  -- See Note [Inline default methods]\n    mapM = traverse\n\n    -- | Evaluate each monadic action in the structure from left to\n    -- right, and collect the results. For a version that ignores the\n    -- results see 'Data.Foldable.sequence_'.\n    sequence :: Monad m => t (m a) -> m (t a)\n    {-# INLINE sequence #-}  -- See Note [Inline default methods]\n    sequence = sequenceA\n\n{- Note [Inline default methods]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nConsider\n\n   class ... => Traversable t where\n       ...\n       mapM :: Monad m => (a -> m b) -> t a -> m (t b)\n       mapM = traverse   -- Default method\n\n   instance Traversable [] where\n       {-# INLINE traverse #-}\n       traverse = ...code for traverse on lists ...\n\nThis gives rise to a list-instance of mapM looking like this\n\n  $fTraversable[]_$ctraverse = ...code for traverse on lists...\n       {-# INLINE $fTraversable[]_$ctraverse #-}\n  $fTraversable[]_$cmapM    = $fTraversable[]_$ctraverse\n\nNow the $ctraverse obediently inlines into the RHS of $cmapM, /but/\nthat's all!  We get\n\n  $fTraversable[]_$cmapM = ...code for traverse on lists...\n\nwith NO INLINE pragma!  This happens even though 'traverse' had an\nINLINE pragma because the author knew it should be inlined pretty\nvigorously.\n\nIndeed, it turned out that the rhs of $cmapM was just too big to\ninline, so all uses of mapM on lists used a terribly inefficient\ndictionary-passing style, because of its 'Monad m =>' type.  Disaster!\n\nSolution: add an INLINE pragma on the default method:\n\n   class ... => Traversable t where\n       ...\n       mapM :: Monad m => (a -> m b) -> t a -> m (t b)\n       {-# INLINE mapM #-}     -- VERY IMPORTANT!\n       mapM = traverse\n-}\n\n-- instances for Prelude types\n\n-- | @since 2.01\ninstance Traversable Maybe where\n    traverse _ Nothing = pure Nothing\n    traverse f (Just x) = Just <$> f x\n\n-- | @since 2.01\ninstance Traversable [] where\n    {-# INLINE traverse #-} -- so that traverse can fuse\n    traverse f = List.foldr cons_f (pure [])\n      where cons_f x ys = liftA2 (:) (f x) ys\n\n-- | @since 4.9.0.0\ninstance Traversable NonEmpty where\n  traverse f ~(a :| as) = liftA2 (:|) (f a) (traverse f as)\n\n-- | @since 4.7.0.0\ninstance Traversable (Either a) where\n    traverse _ (Left x) = pure (Left x)\n    traverse f (Right y) = Right <$> f y\n\n-- | @since 4.7.0.0\ninstance Traversable ((,) a) where\n    traverse f (x, y) = (,) x <$> f y\n\n-- | @since 2.01\ninstance Ix i => Traversable (Array i) where\n    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)\n\n-- | @since 4.7.0.0\ninstance Traversable Proxy where\n    traverse _ _ = pure Proxy\n    {-# INLINE traverse #-}\n    sequenceA _ = pure Proxy\n    {-# INLINE sequenceA #-}\n    mapM _ _ = pure Proxy\n    {-# INLINE mapM #-}\n    sequence _ = pure Proxy\n    {-# INLINE sequence #-}\n\n-- | @since 4.7.0.0\ninstance Traversable (Const m) where\n    traverse _ (Const m) = pure $ Const m\n\n-- | @since 4.8.0.0\ninstance Traversable Dual where\n    traverse f (Dual x) = Dual <$> f x\n\n-- | @since 4.8.0.0\ninstance Traversable Sum where\n    traverse f (Sum x) = Sum <$> f x\n\n-- | @since 4.8.0.0\ninstance Traversable Product where\n    traverse f (Product x) = Product <$> f x\n\n-- | @since 4.8.0.0\ninstance Traversable First where\n    traverse f (First x) = First <$> traverse f x\n\n-- | @since 4.8.0.0\ninstance Traversable Last where\n    traverse f (Last x) = Last <$> traverse f x\n\n-- | @since 4.12.0.0\ninstance (Traversable f) => Traversable (Alt f) where\n    traverse f (Alt x) = Alt <$> traverse f x\n\n-- | @since 4.12.0.0\ninstance (Traversable f) => Traversable (Ap f) where\n    traverse f (Ap x) = Ap <$> traverse f x\n\n-- | @since 4.9.0.0\ninstance Traversable ZipList where\n    traverse f (ZipList x) = ZipList <$> traverse f x\n\n-- | @since 4.9.0.0\nderiving instance Traversable Identity\n\n\n-- Instances for GHC.Generics\n-- | @since 4.9.0.0\ninstance Traversable U1 where\n    traverse _ _ = pure U1\n    {-# INLINE traverse #-}\n    sequenceA _ = pure U1\n    {-# INLINE sequenceA #-}\n    mapM _ _ = pure U1\n    {-# INLINE mapM #-}\n    sequence _ = pure U1\n    {-# INLINE sequence #-}\n\n-- | @since 4.9.0.0\nderiving instance Traversable V1\n\n-- | @since 4.9.0.0\nderiving instance Traversable Par1\n\n-- | @since 4.9.0.0\nderiving instance Traversable f => Traversable (Rec1 f)\n\n-- | @since 4.9.0.0\nderiving instance Traversable (K1 i c)\n\n-- | @since 4.9.0.0\nderiving instance Traversable f => Traversable (M1 i c f)\n\n-- | @since 4.9.0.0\nderiving instance (Traversable f, Traversable g) => Traversable (f :+: g)\n\n-- | @since 4.9.0.0\nderiving instance (Traversable f, Traversable g) => Traversable (f :*: g)\n\n-- | @since 4.9.0.0\nderiving instance (Traversable f, Traversable g) => Traversable (f :.: g)\n\n-- | @since 4.9.0.0\nderiving instance Traversable UAddr\n\n-- | @since 4.9.0.0\nderiving instance Traversable UChar\n\n-- | @since 4.9.0.0\nderiving instance Traversable UDouble\n\n-- | @since 4.9.0.0\nderiving instance Traversable UFloat\n\n-- | @since 4.9.0.0\nderiving instance Traversable UInt\n\n-- | @since 4.9.0.0\nderiving instance Traversable UWord\n\n-- Instance for Data.Ord\n-- | @since 4.12.0.0\nderiving instance Traversable Down\n\n-- general functions\n\n-- | 'for' is 'traverse' with its arguments flipped. For a version\n-- that ignores the results see 'Data.Foldable.for_'.\nfor :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)\n{-# INLINE for #-}\nfor = flip traverse\n\n-- | 'forM' is 'mapM' with its arguments flipped. For a version that\n-- ignores the results see 'Data.Foldable.forM_'.\nforM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)\n{-# INLINE forM #-}\nforM = flip mapM\n\n-- |The 'mapAccumL' function behaves like a combination of 'fmap'\n-- and 'Data.Foldable.foldl'; it applies a function to each element of a structure,\n-- passing an accumulating parameter from left to right, and returning\n-- a final value of this accumulator together with the new structure.\nmapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)\nmapAccumL f s t = runStateL (traverse (StateL . flip f) t) s\n\n-- |The 'mapAccumR' function behaves like a combination of 'fmap'\n-- and 'Data.Foldable.foldr'; it applies a function to each element of a structure,\n-- passing an accumulating parameter from right to left, and returning\n-- a final value of this accumulator together with the new structure.\nmapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)\nmapAccumR f s t = runStateR (traverse (StateR . flip f) t) s\n\n-- | This function may be used as a value for `fmap` in a `Functor`\n--   instance, provided that 'traverse' is defined. (Using\n--   `fmapDefault` with a `Traversable` instance defined only by\n--   'sequenceA' will result in infinite recursion.)\n--\n-- @\n-- 'fmapDefault' f \u00e2\u2030\u00a1 'runIdentity' . 'traverse' ('Identity' . f)\n-- @\nfmapDefault :: forall t a b . Traversable t\n            => (a -> b) -> t a -> t b\n{-# INLINE fmapDefault #-}\n-- See Note [Function coercion] in Data.Functor.Utils.\nfmapDefault = coerce (traverse :: (a -> Identity b) -> t a -> Identity (t b))\n\n-- | This function may be used as a value for `Data.Foldable.foldMap`\n-- in a `Foldable` instance.\n--\n-- @\n-- 'foldMapDefault' f \u00e2\u2030\u00a1 'getConst' . 'traverse' ('Const' . f)\n-- @\nfoldMapDefault :: forall t m a . (Traversable t, Monoid m)\n               => (a -> m) -> t a -> m\n{-# INLINE foldMapDefault #-}\n-- See Note [Function coercion] in Data.Functor.Utils.\nfoldMapDefault = coerce (traverse :: (a -> Const m ()) -> t a -> Const m (t ()))\n", "num_lines": 407}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Tuple\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Functions associated with the tuple data types.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Tuple\n  ( fst\n  , snd\n  , curry\n  , uncurry\n  , swap\n  ) where\n\nimport GHC.Base ()      -- Note [Depend on GHC.Tuple]\n\ndefault ()              -- Double isn't available yet\n\n-- ---------------------------------------------------------------------------\n-- Standard functions over tuples\n\n-- | Extract the first component of a pair.\nfst                     :: (a,b) -> a\nfst (x,_)               =  x\n\n-- | Extract the second component of a pair.\nsnd                     :: (a,b) -> b\nsnd (_,y)               =  y\n\n-- | 'curry' converts an uncurried function to a curried function.\n--\n-- ==== __Examples__\n--\n-- >>> curry fst 1 2\n-- 1\ncurry                   :: ((a, b) -> c) -> a -> b -> c\ncurry f x y             =  f (x, y)\n\n-- | 'uncurry' converts a curried function to a function on pairs.\n--\n-- ==== __Examples__\n--\n-- >>> uncurry (+) (1,2)\n-- 3\n--\n-- >>> uncurry ($) (show, 1)\n-- \"1\"\n--\n-- >>> map (uncurry max) [(1,2), (3,4), (6,8)]\n-- [2,4,8]\nuncurry                 :: (a -> b -> c) -> ((a, b) -> c)\nuncurry f p             =  f (fst p) (snd p)\n\n-- | Swap the components of a pair.\nswap                    :: (a,b) -> (b,a)\nswap (a,b)              = (b,a)\n\n-- $setup\n-- >>> import Prelude hiding (curry, uncurry, fst, snd)\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE TypeOperators #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Typeable\n-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The 'Typeable' class reifies types to some extent by associating type\n-- representations to types. These type representations can be compared,\n-- and one can in turn define a type-safe cast operation. To this end,\n-- an unsafe cast is guarded by a test for type (representation)\n-- equivalence. The module \"Data.Dynamic\" uses Typeable for an\n-- implementation of dynamics. The module \"Data.Data\" uses Typeable\n-- and type-safe cast (but not dynamics) to support the \\\"Scrap your\n-- boilerplate\\\" style of generic programming.\n--\n-- == Compatibility Notes\n--\n-- Since GHC 8.2, GHC has supported type-indexed type representations.\n-- \"Data.Typeable\" provides type representations which are qualified over this\n-- index, providing an interface very similar to the \"Typeable\" notion seen in\n-- previous releases. For the type-indexed interface, see \"Type.Reflection\".\n--\n-- Since GHC 7.8, 'Typeable' is poly-kinded. The changes required for this might\n-- break some old programs involving 'Typeable'. More details on this, including\n-- how to fix your code, can be found on the\n-- <https://ghc.haskell.org/trac/ghc/wiki/GhcKinds/PolyTypeable PolyTypeable wiki page>\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Typeable\n    ( -- * The Typeable class\n      Typeable\n    , typeOf\n    , typeRep\n\n      -- * Propositional equality\n    , (:~:)(Refl)\n    , (:~~:)(HRefl)\n\n      -- * Type-safe cast\n    , cast\n    , eqT\n    , gcast                -- a generalisation of cast\n\n      -- * Generalized casts for higher-order kinds\n    , gcast1               -- :: ... => c (t a) -> Maybe (c (t' a))\n    , gcast2               -- :: ... => c (t a b) -> Maybe (c (t' a b))\n\n      -- * A canonical proxy type\n    , Proxy (..)\n\n      -- * Type representations\n    , TypeRep\n    , rnfTypeRep\n    , showsTypeRep\n    , mkFunTy\n\n      -- * Observing type representations\n    , funResultTy\n    , splitTyConApp\n    , typeRepArgs\n    , typeRepTyCon\n    , typeRepFingerprint\n\n      -- * Type constructors\n    , I.TyCon          -- abstract, instance of: Eq, Show, Typeable\n                       -- For now don't export Module to avoid name clashes\n    , I.tyConPackage\n    , I.tyConModule\n    , I.tyConName\n    , I.rnfTyCon\n    , I.tyConFingerprint\n\n      -- * For backwards compatibility\n    , typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7\n    ) where\n\nimport qualified Data.Typeable.Internal as I\nimport Data.Typeable.Internal (Typeable)\nimport Data.Type.Equality\n\nimport Data.Maybe\nimport Data.Proxy\nimport GHC.Fingerprint.Type\nimport GHC.Show\nimport GHC.Base\n\n-- | A quantified type representation.\ntype TypeRep = I.SomeTypeRep\n\n-- | Observe a type representation for the type of a value.\ntypeOf :: forall a. Typeable a => a -> TypeRep\ntypeOf _ = I.someTypeRep (Proxy :: Proxy a)\n\n-- | Takes a value of type @a@ and returns a concrete representation\n-- of that type.\n--\n-- @since 4.7.0.0\ntypeRep :: forall proxy a. Typeable a => proxy a -> TypeRep\ntypeRep = I.someTypeRep\n\n-- | Show a type representation\nshowsTypeRep :: TypeRep -> ShowS\nshowsTypeRep = shows\n\n-- | The type-safe cast operation\ncast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b\ncast x\n  | Just HRefl <- ta `I.eqTypeRep` tb = Just x\n  | otherwise                         = Nothing\n  where\n    ta = I.typeRep :: I.TypeRep a\n    tb = I.typeRep :: I.TypeRep b\n\n-- | Extract a witness of equality of two types\n--\n-- @since 4.7.0.0\neqT :: forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)\neqT\n  | Just HRefl <- ta `I.eqTypeRep` tb = Just Refl\n  | otherwise                         = Nothing\n  where\n    ta = I.typeRep :: I.TypeRep a\n    tb = I.typeRep :: I.TypeRep b\n\n-- | A flexible variation parameterised in a type constructor\ngcast :: forall a b c. (Typeable a, Typeable b) => c a -> Maybe (c b)\ngcast x = fmap (\\Refl -> x) (eqT :: Maybe (a :~: b))\n\n-- | Cast over @k1 -> k2@\ngcast1 :: forall c t t' a. (Typeable t, Typeable t')\n       => c (t a) -> Maybe (c (t' a))\ngcast1 x = fmap (\\Refl -> x) (eqT :: Maybe (t :~: t'))\n\n-- | Cast over @k1 -> k2 -> k3@\ngcast2 :: forall c t t' a b. (Typeable t, Typeable t')\n       => c (t a b) -> Maybe (c (t' a b))\ngcast2 x = fmap (\\Refl -> x) (eqT :: Maybe (t :~: t'))\n\n-- | Applies a type to a function type. Returns: @Just u@ if the first argument\n-- represents a function of type @t -> u@ and the second argument represents a\n-- function of type @t@. Otherwise, returns @Nothing@.\nfunResultTy :: TypeRep -> TypeRep -> Maybe TypeRep\nfunResultTy (I.SomeTypeRep f) (I.SomeTypeRep x)\n  | Just HRefl <- (I.typeRep :: I.TypeRep Type) `I.eqTypeRep` I.typeRepKind f\n  , I.Fun arg res <- f\n  , Just HRefl <- arg `I.eqTypeRep` x\n  = Just (I.SomeTypeRep res)\n  | otherwise = Nothing\n\n-- | Build a function type.\nmkFunTy :: TypeRep -> TypeRep -> TypeRep\nmkFunTy (I.SomeTypeRep arg) (I.SomeTypeRep res)\n  | Just HRefl <- I.typeRepKind arg `I.eqTypeRep` liftedTy\n  , Just HRefl <- I.typeRepKind res `I.eqTypeRep` liftedTy\n  = I.SomeTypeRep (I.Fun arg res)\n  | otherwise\n  = error $ \"mkFunTy: Attempted to construct function type from non-lifted \"++\n            \"type: arg=\"++show arg++\", res=\"++show res\n  where liftedTy = I.typeRep :: I.TypeRep Type\n\n-- | Splits a type constructor application. Note that if the type constructor is\n-- polymorphic, this will not return the kinds that were used.\nsplitTyConApp :: TypeRep -> (TyCon, [TypeRep])\nsplitTyConApp (I.SomeTypeRep x) = I.splitApps x\n\n-- | Observe the argument types of a type representation\ntypeRepArgs :: TypeRep -> [TypeRep]\ntypeRepArgs ty = case splitTyConApp ty of (_, args) -> args\n\n-- | Observe the type constructor of a quantified type representation.\ntypeRepTyCon :: TypeRep -> TyCon\ntypeRepTyCon = I.someTypeRepTyCon\n\n-- | Takes a value of type @a@ and returns a concrete representation\n-- of that type.\n--\n-- @since 4.7.0.0\ntypeRepFingerprint :: TypeRep -> Fingerprint\ntypeRepFingerprint = I.someTypeRepFingerprint\n\n-- | Force a 'TypeRep' to normal form.\nrnfTypeRep :: TypeRep -> ()\nrnfTypeRep = I.rnfSomeTypeRep\n\n\n-- Keeping backwards-compatibility\ntypeOf1 :: forall t (a :: Type). Typeable t => t a -> TypeRep\ntypeOf1 _ = I.someTypeRep (Proxy :: Proxy t)\n\ntypeOf2 :: forall t (a :: Type) (b :: Type). Typeable t => t a b -> TypeRep\ntypeOf2 _ = I.someTypeRep (Proxy :: Proxy t)\n\ntypeOf3 :: forall t (a :: Type) (b :: Type) (c :: Type).\n           Typeable t => t a b c -> TypeRep\ntypeOf3 _ = I.someTypeRep (Proxy :: Proxy t)\n\ntypeOf4 :: forall t (a :: Type) (b :: Type) (c :: Type) (d :: Type).\n           Typeable t => t a b c d -> TypeRep\ntypeOf4 _ = I.someTypeRep (Proxy :: Proxy t)\n\ntypeOf5 :: forall t (a :: Type) (b :: Type) (c :: Type) (d :: Type) (e :: Type).\n           Typeable t => t a b c d e -> TypeRep\ntypeOf5 _ = I.someTypeRep (Proxy :: Proxy t)\n\ntypeOf6 :: forall t (a :: Type) (b :: Type) (c :: Type)\n                    (d :: Type) (e :: Type) (f :: Type).\n           Typeable t => t a b c d e f -> TypeRep\ntypeOf6 _ = I.someTypeRep (Proxy :: Proxy t)\n\ntypeOf7 :: forall t (a :: Type) (b :: Type) (c :: Type)\n                    (d :: Type) (e :: Type) (f :: Type) (g :: Type).\n           Typeable t => t a b c d e f g -> TypeRep\ntypeOf7 _ = I.someTypeRep (Proxy :: Proxy t)\n", "num_lines": 228}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE MagicHash #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Unique\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable\n--\n-- An abstract interface to a unique symbol generator.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Unique (\n   -- * Unique objects\n   Unique,\n   newUnique,\n   hashUnique\n ) where\n\nimport System.IO.Unsafe (unsafePerformIO)\n\nimport GHC.Base\nimport GHC.Num\nimport Data.IORef\n\n-- | An abstract unique object.  Objects of type 'Unique' may be\n-- compared for equality and ordering and hashed into 'Int'.\n--\n-- >>> :{\n-- do x <- newUnique\n--    print (x == x)\n--    y <- newUnique\n--    print (x == y)\n-- :}\n-- True\n-- False\nnewtype Unique = Unique Integer deriving (Eq,Ord)\n\nuniqSource :: IORef Integer\nuniqSource = unsafePerformIO (newIORef 0)\n{-# NOINLINE uniqSource #-}\n\n-- | Creates a new object of type 'Unique'.  The value returned will\n-- not compare equal to any other value of type 'Unique' returned by\n-- previous calls to 'newUnique'.  There is no limit on the number of\n-- times 'newUnique' may be called.\nnewUnique :: IO Unique\nnewUnique = do\n  r <- atomicModifyIORef' uniqSource $ \\x -> let z = x+1 in (z,z)\n  return (Unique r)\n\n-- SDM (18/3/2010): changed from MVar to STM.  This fixes\n--  1. there was no async exception protection\n--  2. there was a space leak (now new value is strict)\n--  3. using atomicModifyIORef would be slightly quicker, but can\n--     suffer from adverse scheduling issues (see #3838)\n--  4. also, the STM version is faster.\n\n-- SDM (30/4/2012): changed to IORef using atomicModifyIORef.  Reasons:\n--  1. STM version could not be used inside unsafePerformIO, if it\n--     happened to be poked inside an STM transaction.\n--  2. IORef version can be used with unsafeIOToSTM inside STM,\n--     because if the transaction retries then we just get a new\n--     Unique.\n--  3. IORef version is very slightly faster.\n\n-- IGL (08/06/2013): changed to using atomicModifyIORef' instead.\n--  This feels a little safer, from the point of view of not leaking\n--  memory, but the resulting core is identical.\n\n-- | Hashes a 'Unique' into an 'Int'.  Two 'Unique's may hash to the\n-- same value, although in practice this is unlikely.  The 'Int'\n-- returned makes a good hash key.\nhashUnique :: Unique -> Int\nhashUnique (Unique i) = I# (hashInteger i)\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Version\n-- Copyright   :  (c) The University of Glasgow 2004\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (local universal quantification in ReadP)\n--\n-- A general library for representation and manipulation of versions.\n--\n-- Versioning schemes are many and varied, so the version\n-- representation provided by this library is intended to be a\n-- compromise between complete generality, where almost no common\n-- functionality could reasonably be provided, and fixing a particular\n-- versioning scheme, which would probably be too restrictive.\n--\n-- So the approach taken here is to provide a representation which\n-- subsumes many of the versioning schemes commonly in use, and we\n-- provide implementations of 'Eq', 'Ord' and conversion to\\/from 'String'\n-- which will be appropriate for some applications, but not all.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Version (\n        -- * The @Version@ type\n        Version(..),\n        -- * A concrete representation of @Version@\n        showVersion, parseVersion,\n        -- * Constructor function\n        makeVersion\n  ) where\n\nimport Data.Functor     ( Functor(..) )\nimport Control.Applicative ( Applicative(..) )\nimport Data.Bool        ( (&&) )\nimport Data.Char        ( isDigit, isAlphaNum )\nimport Data.Eq\nimport Data.Int         ( Int )\nimport Data.List\nimport Data.Ord\nimport Data.String      ( String )\nimport GHC.Generics\nimport GHC.Read\nimport GHC.Show\nimport Text.ParserCombinators.ReadP\nimport Text.Read        ( read )\n\n{- |\nA 'Version' represents the version of a software entity.\n\nAn instance of 'Eq' is provided, which implements exact equality\nmodulo reordering of the tags in the 'versionTags' field.\n\nAn instance of 'Ord' is also provided, which gives lexicographic\nordering on the 'versionBranch' fields (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2,\netc.).  This is expected to be sufficient for many uses, but note that\nyou may need to use a more specific ordering for your versioning\nscheme.  For example, some versioning schemes may include pre-releases\nwhich have tags @\\\"pre1\\\"@, @\\\"pre2\\\"@, and so on, and these would need to\nbe taken into account when determining ordering.  In some cases, date\nordering may be more appropriate, so the application would have to\nlook for @date@ tags in the 'versionTags' field and compare those.\nThe bottom line is, don't always assume that 'compare' and other 'Ord'\noperations are the right thing for every 'Version'.\n\nSimilarly, concrete representations of versions may differ.  One\npossible concrete representation is provided (see 'showVersion' and\n'parseVersion'), but depending on the application a different concrete\nrepresentation may be more appropriate.\n-}\ndata Version =\n  Version { versionBranch :: [Int],\n                -- ^ The numeric branch for this version.  This reflects the\n                -- fact that most software versions are tree-structured; there\n                -- is a main trunk which is tagged with versions at various\n                -- points (1,2,3...), and the first branch off the trunk after\n                -- version 3 is 3.1, the second branch off the trunk after\n                -- version 3 is 3.2, and so on.  The tree can be branched\n                -- arbitrarily, just by adding more digits.\n                --\n                -- We represent the branch as a list of 'Int', so\n                -- version 3.2.1 becomes [3,2,1].  Lexicographic ordering\n                -- (i.e. the default instance of 'Ord' for @[Int]@) gives\n                -- the natural ordering of branches.\n\n           versionTags :: [String]  -- really a bag\n                -- ^ A version can be tagged with an arbitrary list of strings.\n                -- The interpretation of the list of tags is entirely dependent\n                -- on the entity that this version applies to.\n        }\n  deriving ( Read    -- ^ @since 2.01\n           , Show    -- ^ @since 2.01\n           , Generic -- ^ @since 4.9.0.0\n           )\n{-# DEPRECATED versionTags \"See GHC ticket #2496\" #-}\n-- TODO. Remove all references to versionTags in GHC 8.0 release.\n\n-- | @since 2.01\ninstance Eq Version where\n  v1 == v2  =  versionBranch v1 == versionBranch v2\n                && sort (versionTags v1) == sort (versionTags v2)\n                -- tags may be in any order\n\n-- | @since 2.01\ninstance Ord Version where\n  v1 `compare` v2 = versionBranch v1 `compare` versionBranch v2\n\n-- -----------------------------------------------------------------------------\n-- A concrete representation of 'Version'\n\n-- | Provides one possible concrete representation for 'Version'.  For\n-- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags'\n-- @= [\\\"tag1\\\",\\\"tag2\\\"]@, the output will be @1.2.3-tag1-tag2@.\n--\nshowVersion :: Version -> String\nshowVersion (Version branch tags)\n  = concat (intersperse \".\" (map show branch)) ++\n     concatMap ('-':) tags\n\n-- | A parser for versions in the format produced by 'showVersion'.\n--\nparseVersion :: ReadP Version\nparseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')\n                  tags   <- many (char '-' *> munch1 isAlphaNum)\n                  pure Version{versionBranch=branch, versionTags=tags}\n\n-- | Construct tag-less 'Version'\n--\n-- @since 4.8.0.0\nmakeVersion :: [Int] -> Version\nmakeVersion b = Version b []\n", "num_lines": 138}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE EmptyDataDeriving #-}\n{-# LANGUAGE Safe #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Copyright   :  (C) 2008-2014 Edward Kmett\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  Edward Kmett <ekmett@gmail.com>\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A logically uninhabited data type, used to indicate that a given\n-- term should not exist.\n--\n-- @since 4.8.0.0\n----------------------------------------------------------------------------\nmodule Data.Void\n    ( Void\n    , absurd\n    , vacuous\n    ) where\n\nimport Control.Exception\nimport Data.Data\nimport Data.Ix\nimport GHC.Generics\nimport Data.Semigroup (Semigroup(..), stimesIdempotent)\n\n-- | Uninhabited data type\n--\n-- @since 4.8.0.0\ndata Void deriving\n  ( Eq      -- ^ @since 4.8.0.0\n  , Data    -- ^ @since 4.8.0.0\n  , Generic -- ^ @since 4.8.0.0\n  , Ord     -- ^ @since 4.8.0.0\n  , Read    -- ^ Reading a 'Void' value is always a parse error, considering\n            -- 'Void' as a data type with no constructors.\n            --\n            -- @since 4.8.0.0\n  , Show    -- ^ @since 4.8.0.0\n  )\n\n-- | @since 4.8.0.0\ninstance Ix Void where\n    range _     = []\n    index _     = absurd\n    inRange _   = absurd\n    rangeSize _ = 0\n\n-- | @since 4.8.0.0\ninstance Exception Void\n\n-- | @since 4.9.0.0\ninstance Semigroup Void where\n    a <> _ = a\n    stimes = stimesIdempotent\n\n-- | Since 'Void' values logically don't exist, this witnesses the\n-- logical reasoning tool of \\\"ex falso quodlibet\\\".\n--\n-- >>> let x :: Either Void Int; x = Right 5\n-- >>> :{\n-- case x of\n--     Right r -> r\n--     Left l  -> absurd l\n-- :}\n-- 5\n--\n-- @since 4.8.0.0\nabsurd :: Void -> a\nabsurd a = case a of {}\n\n-- | If 'Void' is uninhabited then any 'Functor' that holds only\n-- values of type 'Void' is holding no values.\n--\n-- @since 4.8.0.0\nvacuous :: Functor f => f Void -> f a\nvacuous = fmap absurd\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Word\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Unsigned integer types.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Word\n  (\n        -- * Unsigned integral types\n\n        Word,\n        Word8, Word16, Word32, Word64,\n\n        -- * byte swapping\n        byteSwap16, byteSwap32, byteSwap64,\n\n        -- * Notes\n\n        -- $notes\n        ) where\n\nimport GHC.Word\nimport GHC.Read () -- Need the `Read` instance for types defined in `GHC.Word`.\n\n{- $notes\n\n* All arithmetic is performed modulo 2^n, where n is the number of\n  bits in the type.  One non-obvious consequence of this is that 'Prelude.negate'\n  should /not/ raise an error on negative arguments.\n\n* For coercing between any two integer types, use\n  'Prelude.fromIntegral', which is specialized for all the\n  common cases so should be fast enough.  Coercing word types to and\n  from integer types preserves representation, not sign.\n\n* An unbounded size unsigned integer type is available with\n  'Numeric.Natural.Natural'.\n\n* The rules that hold for 'Prelude.Enum' instances over a bounded type\n  such as 'Prelude.Int' (see the section of the Haskell report dealing\n  with arithmetic sequences) also hold for the 'Prelude.Enum' instances\n  over the various 'Word' types defined here.\n\n* Right and left shifts by amounts greater than or equal to the width\n  of the type result in a zero result.  This is contrary to the\n  behaviour in C, which is undefined; a common interpretation is to\n  truncate the shift count to the width of the type, for example @1 \\<\\<\n  32 == 1@ in some C implementations.\n-}\n\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor.Classes\n-- Copyright   :  (c) Ross Paterson 2013\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to\n-- unary and binary type constructors.\n--\n-- These classes are needed to express the constraints on arguments of\n-- transformers in portable Haskell.  Thus for a new transformer @T@,\n-- one might write instances like\n--\n-- > instance (Eq1 f) => Eq1 (T f) where ...\n-- > instance (Ord1 f) => Ord1 (T f) where ...\n-- > instance (Read1 f) => Read1 (T f) where ...\n-- > instance (Show1 f) => Show1 (T f) where ...\n--\n-- If these instances can be defined, defining instances of the base\n-- classes is mechanical:\n--\n-- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1\n-- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1\n-- > instance (Read1 f, Read a) => Read (T f a) where\n-- >   readPrec     = readPrec1\n-- >   readListPrec = readListPrecDefault\n-- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1\n--\n-- @since 4.9.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Functor.Classes (\n    -- * Liftings of Prelude classes\n    -- ** For unary constructors\n    Eq1(..), eq1,\n    Ord1(..), compare1,\n    Read1(..), readsPrec1, readPrec1,\n    liftReadListDefault, liftReadListPrecDefault,\n    Show1(..), showsPrec1,\n    -- ** For binary constructors\n    Eq2(..), eq2,\n    Ord2(..), compare2,\n    Read2(..), readsPrec2, readPrec2,\n    liftReadList2Default, liftReadListPrec2Default,\n    Show2(..), showsPrec2,\n    -- * Helper functions\n    -- $example\n    readsData, readData,\n    readsUnaryWith, readUnaryWith,\n    readsBinaryWith, readBinaryWith,\n    showsUnaryWith,\n    showsBinaryWith,\n    -- ** Obsolete helpers\n    readsUnary,\n    readsUnary1,\n    readsBinary1,\n    showsUnary,\n    showsUnary1,\n    showsBinary1,\n  ) where\n\nimport Control.Applicative (Alternative((<|>)), Const(Const))\n\nimport Data.Functor.Identity (Identity(Identity))\nimport Data.Proxy (Proxy(Proxy))\nimport Data.List.NonEmpty (NonEmpty(..))\nimport Data.Ord (Down(Down))\n\nimport GHC.Read (expectP, list, paren)\n\nimport Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)\nimport Text.Read (Read(..), parens, prec, step)\nimport Text.Read.Lex (Lexeme(..))\nimport Text.Show (showListWith)\n\n-- | Lifting of the 'Eq' class to unary type constructors.\n--\n-- @since 4.9.0.0\nclass Eq1 f where\n    -- | Lift an equality test through the type constructor.\n    --\n    -- The function will usually be applied to an equality function,\n    -- but the more general type ensures that the implementation uses\n    -- it to compare elements of the first container with elements of\n    -- the second.\n    --\n    -- @since 4.9.0.0\n    liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool\n\n-- | Lift the standard @('==')@ function through the type constructor.\n--\n-- @since 4.9.0.0\neq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool\neq1 = liftEq (==)\n\n-- | Lifting of the 'Ord' class to unary type constructors.\n--\n-- @since 4.9.0.0\nclass (Eq1 f) => Ord1 f where\n    -- | Lift a 'compare' function through the type constructor.\n    --\n    -- The function will usually be applied to a comparison function,\n    -- but the more general type ensures that the implementation uses\n    -- it to compare elements of the first container with elements of\n    -- the second.\n    --\n    -- @since 4.9.0.0\n    liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering\n\n-- | Lift the standard 'compare' function through the type constructor.\n--\n-- @since 4.9.0.0\ncompare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering\ncompare1 = liftCompare compare\n\n-- | Lifting of the 'Read' class to unary type constructors.\n--\n-- Both 'liftReadsPrec' and 'liftReadPrec' exist to match the interface\n-- provided in the 'Read' type class, but it is recommended to implement\n-- 'Read1' instances using 'liftReadPrec' as opposed to 'liftReadsPrec', since\n-- the former is more efficient than the latter. For example:\n--\n-- @\n-- instance 'Read1' T where\n--   'liftReadPrec'     = ...\n--   'liftReadListPrec' = 'liftReadListPrecDefault'\n-- @\n--\n-- For more information, refer to the documentation for the 'Read' class.\n--\n-- @since 4.9.0.0\nclass Read1 f where\n    {-# MINIMAL liftReadsPrec | liftReadPrec #-}\n\n    -- | 'readsPrec' function for an application of the type constructor\n    -- based on 'readsPrec' and 'readList' functions for the argument type.\n    --\n    -- @since 4.9.0.0\n    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)\n    liftReadsPrec rp rl = readPrec_to_S $\n        liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))\n\n    -- | 'readList' function for an application of the type constructor\n    -- based on 'readsPrec' and 'readList' functions for the argument type.\n    -- The default implementation using standard list syntax is correct\n    -- for most types.\n    --\n    -- @since 4.9.0.0\n    liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]\n    liftReadList rp rl = readPrec_to_S\n        (list $ liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0\n\n    -- | 'readPrec' function for an application of the type constructor\n    -- based on 'readPrec' and 'readListPrec' functions for the argument type.\n    --\n    -- @since 4.10.0.0\n    liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)\n    liftReadPrec rp rl = readS_to_Prec $\n        liftReadsPrec (readPrec_to_S rp) (readPrec_to_S rl 0)\n\n    -- | 'readListPrec' function for an application of the type constructor\n    -- based on 'readPrec' and 'readListPrec' functions for the argument type.\n    --\n    -- The default definition uses 'liftReadList'. Instances that define\n    -- 'liftReadPrec' should also define 'liftReadListPrec' as\n    -- 'liftReadListPrecDefault'.\n    --\n    -- @since 4.10.0.0\n    liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]\n    liftReadListPrec rp rl = readS_to_Prec $ \\_ ->\n        liftReadList (readPrec_to_S rp) (readPrec_to_S rl 0)\n\n-- | Lift the standard 'readsPrec' and 'readList' functions through the\n-- type constructor.\n--\n-- @since 4.9.0.0\nreadsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)\nreadsPrec1 = liftReadsPrec readsPrec readList\n\n-- | Lift the standard 'readPrec' and 'readListPrec' functions through the\n-- type constructor.\n--\n-- @since 4.10.0.0\nreadPrec1 :: (Read1 f, Read a) => ReadPrec (f a)\nreadPrec1 = liftReadPrec readPrec readListPrec\n\n-- | A possible replacement definition for the 'liftReadList' method.\n-- This is only needed for 'Read1' instances where 'liftReadListPrec' isn't\n-- defined as 'liftReadListPrecDefault'.\n--\n-- @since 4.10.0.0\nliftReadListDefault :: Read1 f => (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]\nliftReadListDefault rp rl = readPrec_to_S\n    (liftReadListPrec (readS_to_Prec rp) (readS_to_Prec (const rl))) 0\n\n-- | A possible replacement definition for the 'liftReadListPrec' method,\n-- defined using 'liftReadPrec'.\n--\n-- @since 4.10.0.0\nliftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a]\n                        -> ReadPrec [f a]\nliftReadListPrecDefault rp rl = list (liftReadPrec rp rl)\n\n-- | Lifting of the 'Show' class to unary type constructors.\n--\n-- @since 4.9.0.0\nclass Show1 f where\n    -- | 'showsPrec' function for an application of the type constructor\n    -- based on 'showsPrec' and 'showList' functions for the argument type.\n    --\n    -- @since 4.9.0.0\n    liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->\n        Int -> f a -> ShowS\n\n    -- | 'showList' function for an application of the type constructor\n    -- based on 'showsPrec' and 'showList' functions for the argument type.\n    -- The default implementation using standard list syntax is correct\n    -- for most types.\n    --\n    -- @since 4.9.0.0\n    liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->\n        [f a] -> ShowS\n    liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)\n\n-- | Lift the standard 'showsPrec' and 'showList' functions through the\n-- type constructor.\n--\n-- @since 4.9.0.0\nshowsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS\nshowsPrec1 = liftShowsPrec showsPrec showList\n\n-- | Lifting of the 'Eq' class to binary type constructors.\n--\n-- @since 4.9.0.0\nclass Eq2 f where\n    -- | Lift equality tests through the type constructor.\n    --\n    -- The function will usually be applied to equality functions,\n    -- but the more general type ensures that the implementation uses\n    -- them to compare elements of the first container with elements of\n    -- the second.\n    --\n    -- @since 4.9.0.0\n    liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool\n\n-- | Lift the standard @('==')@ function through the type constructor.\n--\n-- @since 4.9.0.0\neq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool\neq2 = liftEq2 (==) (==)\n\n-- | Lifting of the 'Ord' class to binary type constructors.\n--\n-- @since 4.9.0.0\nclass (Eq2 f) => Ord2 f where\n    -- | Lift 'compare' functions through the type constructor.\n    --\n    -- The function will usually be applied to comparison functions,\n    -- but the more general type ensures that the implementation uses\n    -- them to compare elements of the first container with elements of\n    -- the second.\n    --\n    -- @since 4.9.0.0\n    liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->\n        f a c -> f b d -> Ordering\n\n-- | Lift the standard 'compare' function through the type constructor.\n--\n-- @since 4.9.0.0\ncompare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering\ncompare2 = liftCompare2 compare compare\n\n-- | Lifting of the 'Read' class to binary type constructors.\n--\n-- Both 'liftReadsPrec2' and 'liftReadPrec2' exist to match the interface\n-- provided in the 'Read' type class, but it is recommended to implement\n-- 'Read2' instances using 'liftReadPrec2' as opposed to 'liftReadsPrec2',\n-- since the former is more efficient than the latter. For example:\n--\n-- @\n-- instance 'Read2' T where\n--   'liftReadPrec2'     = ...\n--   'liftReadListPrec2' = 'liftReadListPrec2Default'\n-- @\n--\n-- For more information, refer to the documentation for the 'Read' class.\n-- @since 4.9.0.0\nclass Read2 f where\n    {-# MINIMAL liftReadsPrec2 | liftReadPrec2 #-}\n\n    -- | 'readsPrec' function for an application of the type constructor\n    -- based on 'readsPrec' and 'readList' functions for the argument types.\n    --\n    -- @since 4.9.0.0\n    liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->\n        (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)\n    liftReadsPrec2 rp1 rl1 rp2 rl2 = readPrec_to_S $\n        liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))\n                      (readS_to_Prec rp2) (readS_to_Prec (const rl2))\n\n    -- | 'readList' function for an application of the type constructor\n    -- based on 'readsPrec' and 'readList' functions for the argument types.\n    -- The default implementation using standard list syntax is correct\n    -- for most types.\n    --\n    -- @since 4.9.0.0\n    liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->\n        (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]\n    liftReadList2 rp1 rl1 rp2 rl2 = readPrec_to_S\n       (list $ liftReadPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))\n                             (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0\n\n    -- | 'readPrec' function for an application of the type constructor\n    -- based on 'readPrec' and 'readListPrec' functions for the argument types.\n    --\n    -- @since 4.10.0.0\n    liftReadPrec2 :: ReadPrec a -> ReadPrec [a] ->\n        ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)\n    liftReadPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $\n        liftReadsPrec2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)\n                       (readPrec_to_S rp2) (readPrec_to_S rl2 0)\n\n    -- | 'readListPrec' function for an application of the type constructor\n    -- based on 'readPrec' and 'readListPrec' functions for the argument types.\n    --\n    -- The default definition uses 'liftReadList2'. Instances that define\n    -- 'liftReadPrec2' should also define 'liftReadListPrec2' as\n    -- 'liftReadListPrec2Default'.\n    --\n    -- @since 4.10.0.0\n    liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] ->\n        ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]\n    liftReadListPrec2 rp1 rl1 rp2 rl2 = readS_to_Prec $ \\_ ->\n        liftReadList2 (readPrec_to_S rp1) (readPrec_to_S rl1 0)\n                      (readPrec_to_S rp2) (readPrec_to_S rl2 0)\n\n-- | Lift the standard 'readsPrec' function through the type constructor.\n--\n-- @since 4.9.0.0\nreadsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)\nreadsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList\n\n-- | Lift the standard 'readPrec' function through the type constructor.\n--\n-- @since 4.10.0.0\nreadPrec2 :: (Read2 f, Read a, Read b) => ReadPrec (f a b)\nreadPrec2 = liftReadPrec2 readPrec readListPrec readPrec readListPrec\n\n-- | A possible replacement definition for the 'liftReadList2' method.\n-- This is only needed for 'Read2' instances where 'liftReadListPrec2' isn't\n-- defined as 'liftReadListPrec2Default'.\n--\n-- @since 4.10.0.0\nliftReadList2Default :: Read2 f => (Int -> ReadS a) -> ReadS [a] ->\n    (Int -> ReadS b) -> ReadS [b] ->ReadS [f a b]\nliftReadList2Default rp1 rl1 rp2 rl2 = readPrec_to_S\n    (liftReadListPrec2 (readS_to_Prec rp1) (readS_to_Prec (const rl1))\n                       (readS_to_Prec rp2) (readS_to_Prec (const rl2))) 0\n\n-- | A possible replacement definition for the 'liftReadListPrec2' method,\n-- defined using 'liftReadPrec2'.\n--\n-- @since 4.10.0.0\nliftReadListPrec2Default :: Read2 f => ReadPrec a -> ReadPrec [a] ->\n    ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]\nliftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2)\n\n-- | Lifting of the 'Show' class to binary type constructors.\n--\n-- @since 4.9.0.0\nclass Show2 f where\n    -- | 'showsPrec' function for an application of the type constructor\n    -- based on 'showsPrec' and 'showList' functions for the argument types.\n    --\n    -- @since 4.9.0.0\n    liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->\n        (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS\n\n    -- | 'showList' function for an application of the type constructor\n    -- based on 'showsPrec' and 'showList' functions for the argument types.\n    -- The default implementation using standard list syntax is correct\n    -- for most types.\n    --\n    -- @since 4.9.0.0\n    liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->\n        (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS\n    liftShowList2 sp1 sl1 sp2 sl2 =\n        showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)\n\n-- | Lift the standard 'showsPrec' function through the type constructor.\n--\n-- @since 4.9.0.0\nshowsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS\nshowsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList\n\n-- Instances for Prelude type constructors\n\n-- | @since 4.9.0.0\ninstance Eq1 Maybe where\n    liftEq _ Nothing Nothing = True\n    liftEq _ Nothing (Just _) = False\n    liftEq _ (Just _) Nothing = False\n    liftEq eq (Just x) (Just y) = eq x y\n\n-- | @since 4.9.0.0\ninstance Ord1 Maybe where\n    liftCompare _ Nothing Nothing = EQ\n    liftCompare _ Nothing (Just _) = LT\n    liftCompare _ (Just _) Nothing = GT\n    liftCompare comp (Just x) (Just y) = comp x y\n\n-- | @since 4.9.0.0\ninstance Read1 Maybe where\n    liftReadPrec rp _ =\n        parens (expectP (Ident \"Nothing\") *> pure Nothing)\n        <|>\n        readData (readUnaryWith rp \"Just\" Just)\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance Show1 Maybe where\n    liftShowsPrec _ _ _ Nothing = showString \"Nothing\"\n    liftShowsPrec sp _ d (Just x) = showsUnaryWith sp \"Just\" d x\n\n-- | @since 4.9.0.0\ninstance Eq1 [] where\n    liftEq _ [] [] = True\n    liftEq _ [] (_:_) = False\n    liftEq _ (_:_) [] = False\n    liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys\n\n-- | @since 4.9.0.0\ninstance Ord1 [] where\n    liftCompare _ [] [] = EQ\n    liftCompare _ [] (_:_) = LT\n    liftCompare _ (_:_) [] = GT\n    liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys\n\n-- | @since 4.9.0.0\ninstance Read1 [] where\n    liftReadPrec _ rl = rl\n    liftReadListPrec  = liftReadListPrecDefault\n    liftReadList      = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance Show1 [] where\n    liftShowsPrec _ sl _ = sl\n\n-- | @since 4.10.0.0\ninstance Eq1 NonEmpty where\n  liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs\n\n-- | @since 4.10.0.0\ninstance Ord1 NonEmpty where\n  liftCompare cmp (a :| as) (b :| bs) = cmp a b `mappend` liftCompare cmp as bs\n\n-- | @since 4.10.0.0\ninstance Read1 NonEmpty where\n  liftReadsPrec rdP rdL p s = readParen (p > 5) (\\s' -> do\n    (a, s'') <- rdP 6 s'\n    (\":|\", s''') <- lex s''\n    (as, s'''') <- rdL s'''\n    return (a :| as, s'''')) s\n\n-- | @since 4.10.0.0\ninstance Show1 NonEmpty where\n  liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $\n    shwP 6 a . showString \" :| \" . shwL as\n\n-- | @since 4.9.0.0\ninstance Eq2 (,) where\n    liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2\n\n-- | @since 4.9.0.0\ninstance Ord2 (,) where\n    liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =\n        comp1 x1 x2 `mappend` comp2 y1 y2\n\n-- | @since 4.9.0.0\ninstance Read2 (,) where\n    liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do\n        x <- rp1\n        expectP (Punc \",\")\n        y <- rp2\n        return (x,y)\n\n    liftReadListPrec2 = liftReadListPrec2Default\n    liftReadList2     = liftReadList2Default\n\n-- | @since 4.9.0.0\ninstance Show2 (,) where\n    liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =\n        showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'\n\n-- | @since 4.9.0.0\ninstance (Eq a) => Eq1 ((,) a) where\n    liftEq = liftEq2 (==)\n\n-- | @since 4.9.0.0\ninstance (Ord a) => Ord1 ((,) a) where\n    liftCompare = liftCompare2 compare\n\n-- | @since 4.9.0.0\ninstance (Read a) => Read1 ((,) a) where\n    liftReadPrec = liftReadPrec2 readPrec readListPrec\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance (Show a) => Show1 ((,) a) where\n    liftShowsPrec = liftShowsPrec2 showsPrec showList\n\n-- | @since 4.9.0.0\ninstance Eq2 Either where\n    liftEq2 e1 _ (Left x) (Left y) = e1 x y\n    liftEq2 _ _ (Left _) (Right _) = False\n    liftEq2 _ _ (Right _) (Left _) = False\n    liftEq2 _ e2 (Right x) (Right y) = e2 x y\n\n-- | @since 4.9.0.0\ninstance Ord2 Either where\n    liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y\n    liftCompare2 _ _ (Left _) (Right _) = LT\n    liftCompare2 _ _ (Right _) (Left _) = GT\n    liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y\n\n-- | @since 4.9.0.0\ninstance Read2 Either where\n    liftReadPrec2 rp1 _ rp2 _ = readData $\n         readUnaryWith rp1 \"Left\" Left <|>\n         readUnaryWith rp2 \"Right\" Right\n\n    liftReadListPrec2 = liftReadListPrec2Default\n    liftReadList2     = liftReadList2Default\n\n-- | @since 4.9.0.0\ninstance Show2 Either where\n    liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 \"Left\" d x\n    liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 \"Right\" d x\n\n-- | @since 4.9.0.0\ninstance (Eq a) => Eq1 (Either a) where\n    liftEq = liftEq2 (==)\n\n-- | @since 4.9.0.0\ninstance (Ord a) => Ord1 (Either a) where\n    liftCompare = liftCompare2 compare\n\n-- | @since 4.9.0.0\ninstance (Read a) => Read1 (Either a) where\n    liftReadPrec = liftReadPrec2 readPrec readListPrec\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance (Show a) => Show1 (Either a) where\n    liftShowsPrec = liftShowsPrec2 showsPrec showList\n\n-- Instances for other functors defined in the base package\n\n-- | @since 4.9.0.0\ninstance Eq1 Identity where\n    liftEq eq (Identity x) (Identity y) = eq x y\n\n-- | @since 4.9.0.0\ninstance Ord1 Identity where\n    liftCompare comp (Identity x) (Identity y) = comp x y\n\n-- | @since 4.9.0.0\ninstance Read1 Identity where\n    liftReadPrec rp _ = readData $\n         readUnaryWith rp \"Identity\" Identity\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance Show1 Identity where\n    liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp \"Identity\" d x\n\n-- | @since 4.9.0.0\ninstance Eq2 Const where\n    liftEq2 eq _ (Const x) (Const y) = eq x y\n\n-- | @since 4.9.0.0\ninstance Ord2 Const where\n    liftCompare2 comp _ (Const x) (Const y) = comp x y\n\n-- | @since 4.9.0.0\ninstance Read2 Const where\n    liftReadPrec2 rp _ _ _ = readData $\n         readUnaryWith rp \"Const\" Const\n\n    liftReadListPrec2 = liftReadListPrec2Default\n    liftReadList2     = liftReadList2Default\n\n-- | @since 4.9.0.0\ninstance Show2 Const where\n    liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp \"Const\" d x\n\n-- | @since 4.9.0.0\ninstance (Eq a) => Eq1 (Const a) where\n    liftEq = liftEq2 (==)\n-- | @since 4.9.0.0\ninstance (Ord a) => Ord1 (Const a) where\n    liftCompare = liftCompare2 compare\n-- | @since 4.9.0.0\ninstance (Read a) => Read1 (Const a) where\n    liftReadPrec = liftReadPrec2 readPrec readListPrec\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n-- | @since 4.9.0.0\ninstance (Show a) => Show1 (Const a) where\n    liftShowsPrec = liftShowsPrec2 showsPrec showList\n\n-- Proxy unfortunately imports this module, hence these instances are placed\n-- here,\n-- | @since 4.9.0.0\ninstance Eq1 Proxy where\n  liftEq _ _ _ = True\n\n-- | @since 4.9.0.0\ninstance Ord1 Proxy where\n  liftCompare _ _ _ = EQ\n\n-- | @since 4.9.0.0\ninstance Show1 Proxy where\n  liftShowsPrec _ _ _ _ = showString \"Proxy\"\n\n-- | @since 4.9.0.0\ninstance Read1 Proxy where\n  liftReadPrec _ _ = parens (expectP (Ident \"Proxy\") *> pure Proxy)\n\n  liftReadListPrec = liftReadListPrecDefault\n  liftReadList     = liftReadListDefault\n\n-- | @since 4.12.0.0\ninstance Eq1 Down where\n    liftEq eq (Down x) (Down y) = eq x y\n\n-- | @since 4.12.0.0\ninstance Ord1 Down where\n    liftCompare comp (Down x) (Down y) = comp x y\n\n-- | @since 4.12.0.0\ninstance Read1 Down where\n    liftReadsPrec rp _ = readsData $\n         readsUnaryWith rp \"Down\" Down\n\n-- | @since 4.12.0.0\ninstance Show1 Down where\n    liftShowsPrec sp _ d (Down x) = showsUnaryWith sp \"Down\" d x\n\n\n-- Building blocks\n\n-- | @'readsData' p d@ is a parser for datatypes where each alternative\n-- begins with a data constructor.  It parses the constructor and\n-- passes it to @p@.  Parsers for various constructors can be constructed\n-- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with\n-- @mappend@ from the @Monoid@ class.\n--\n-- @since 4.9.0.0\nreadsData :: (String -> ReadS a) -> Int -> ReadS a\nreadsData reader d =\n    readParen (d > 10) $ \\ r -> [res | (kw,s) <- lex r, res <- reader kw s]\n\n-- | @'readData' p@ is a parser for datatypes where each alternative\n-- begins with a data constructor.  It parses the constructor and\n-- passes it to @p@.  Parsers for various constructors can be constructed\n-- with 'readUnaryWith' and 'readBinaryWith', and combined with\n-- '(<|>)' from the 'Alternative' class.\n--\n-- @since 4.10.0.0\nreadData :: ReadPrec a -> ReadPrec a\nreadData reader = parens $ prec 10 reader\n\n-- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor\n-- and then parses its argument using @rp@.\n--\n-- @since 4.9.0.0\nreadsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t\nreadsUnaryWith rp name cons kw s =\n    [(cons x,t) | kw == name, (x,t) <- rp 11 s]\n\n-- | @'readUnaryWith' rp n c'@ matches the name of a unary data constructor\n-- and then parses its argument using @rp@.\n--\n-- @since 4.10.0.0\nreadUnaryWith :: ReadPrec a -> String -> (a -> t) -> ReadPrec t\nreadUnaryWith rp name cons = do\n    expectP $ Ident name\n    x <- step rp\n    return $ cons x\n\n-- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary\n-- data constructor and then parses its arguments using @rp1@ and @rp2@\n-- respectively.\n--\n-- @since 4.9.0.0\nreadsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->\n    String -> (a -> b -> t) -> String -> ReadS t\nreadsBinaryWith rp1 rp2 name cons kw s =\n    [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]\n\n-- | @'readBinaryWith' rp1 rp2 n c'@ matches the name of a binary\n-- data constructor and then parses its arguments using @rp1@ and @rp2@\n-- respectively.\n--\n-- @since 4.10.0.0\nreadBinaryWith :: ReadPrec a -> ReadPrec b ->\n    String -> (a -> b -> t) -> ReadPrec t\nreadBinaryWith rp1 rp2 name cons = do\n    expectP $ Ident name\n    x <- step rp1\n    y <- step rp2\n    return $ cons x y\n\n-- | @'showsUnaryWith' sp n d x@ produces the string representation of a\n-- unary data constructor with name @n@ and argument @x@, in precedence\n-- context @d@.\n--\n-- @since 4.9.0.0\nshowsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS\nshowsUnaryWith sp name d x = showParen (d > 10) $\n    showString name . showChar ' ' . sp 11 x\n\n-- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string\n-- representation of a binary data constructor with name @n@ and arguments\n-- @x@ and @y@, in precedence context @d@.\n--\n-- @since 4.9.0.0\nshowsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->\n    String -> Int -> a -> b -> ShowS\nshowsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $\n    showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y\n\n-- Obsolete building blocks\n\n-- | @'readsUnary' n c n'@ matches the name of a unary data constructor\n-- and then parses its argument using 'readsPrec'.\n--\n-- @since 4.9.0.0\n{-# DEPRECATED readsUnary \"Use 'readsUnaryWith' to define 'liftReadsPrec'\" #-}\nreadsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t\nreadsUnary name cons kw s =\n    [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]\n\n-- | @'readsUnary1' n c n'@ matches the name of a unary data constructor\n-- and then parses its argument using 'readsPrec1'.\n--\n-- @since 4.9.0.0\n{-# DEPRECATED readsUnary1 \"Use 'readsUnaryWith' to define 'liftReadsPrec'\" #-}\nreadsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t\nreadsUnary1 name cons kw s =\n    [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]\n\n-- | @'readsBinary1' n c n'@ matches the name of a binary data constructor\n-- and then parses its arguments using 'readsPrec1'.\n--\n-- @since 4.9.0.0\n{-# DEPRECATED readsBinary1\n      \"Use 'readsBinaryWith' to define 'liftReadsPrec'\" #-}\nreadsBinary1 :: (Read1 f, Read1 g, Read a) =>\n    String -> (f a -> g a -> t) -> String -> ReadS t\nreadsBinary1 name cons kw s =\n    [(cons x y,u) | kw == name,\n        (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t]\n\n-- | @'showsUnary' n d x@ produces the string representation of a unary data\n-- constructor with name @n@ and argument @x@, in precedence context @d@.\n--\n-- @since 4.9.0.0\n{-# DEPRECATED showsUnary \"Use 'showsUnaryWith' to define 'liftShowsPrec'\" #-}\nshowsUnary :: (Show a) => String -> Int -> a -> ShowS\nshowsUnary name d x = showParen (d > 10) $\n    showString name . showChar ' ' . showsPrec 11 x\n\n-- | @'showsUnary1' n d x@ produces the string representation of a unary data\n-- constructor with name @n@ and argument @x@, in precedence context @d@.\n--\n-- @since 4.9.0.0\n{-# DEPRECATED showsUnary1 \"Use 'showsUnaryWith' to define 'liftShowsPrec'\" #-}\nshowsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS\nshowsUnary1 name d x = showParen (d > 10) $\n    showString name . showChar ' ' . showsPrec1 11 x\n\n-- | @'showsBinary1' n d x y@ produces the string representation of a binary\n-- data constructor with name @n@ and arguments @x@ and @y@, in precedence\n-- context @d@.\n--\n-- @since 4.9.0.0\n{-# DEPRECATED showsBinary1\n      \"Use 'showsBinaryWith' to define 'liftShowsPrec'\" #-}\nshowsBinary1 :: (Show1 f, Show1 g, Show a) =>\n    String -> Int -> f a -> g a -> ShowS\nshowsBinary1 name d x y = showParen (d > 10) $\n    showString name . showChar ' ' . showsPrec1 11 x .\n        showChar ' ' . showsPrec1 11 y\n\n{- $example\nThese functions can be used to assemble 'Read' and 'Show' instances for\nnew algebraic types.  For example, given the definition\n\n> data T f a = Zero a | One (f a) | Two a (f a)\n\na standard 'Read1' instance may be defined as\n\n> instance (Read1 f) => Read1 (T f) where\n>     liftReadPrec rp rl = readData $\n>         readUnaryWith rp \"Zero\" Zero <|>\n>         readUnaryWith (liftReadPrec rp rl) \"One\" One <|>\n>         readBinaryWith rp (liftReadPrec rp rl) \"Two\" Two\n>     liftReadListPrec = liftReadListPrecDefault\n\nand the corresponding 'Show1' instance as\n\n> instance (Show1 f) => Show1 (T f) where\n>     liftShowsPrec sp _ d (Zero x) =\n>         showsUnaryWith sp \"Zero\" d x\n>     liftShowsPrec sp sl d (One x) =\n>         showsUnaryWith (liftShowsPrec sp sl) \"One\" d x\n>     liftShowsPrec sp sl d (Two x y) =\n>         showsBinaryWith sp (liftShowsPrec sp sl) \"Two\" d x y\n\n-}\n", "num_lines": 837}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeOperators #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor.Compose\n-- Copyright   :  (c) Ross Paterson 2010\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Composition of functors.\n--\n-- @since 4.9.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Functor.Compose (\n    Compose(..),\n  ) where\n\nimport Data.Functor.Classes\n\nimport Control.Applicative\nimport Data.Coerce (coerce)\nimport Data.Data (Data)\nimport Data.Type.Equality (TestEquality(..), (:~:)(..))\nimport GHC.Generics (Generic, Generic1)\nimport Text.Read (Read(..), readListDefault, readListPrecDefault)\n\ninfixr 9 `Compose`\n\n-- | Right-to-left composition of functors.\n-- The composition of applicative functors is always applicative,\n-- but the composition of monads is not always a monad.\nnewtype Compose f g a = Compose { getCompose :: f (g a) }\n  deriving ( Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- Instances of lifted Prelude classes\n\n-- | @since 4.9.0.0\ninstance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where\n    liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y\n\n-- | @since 4.9.0.0\ninstance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where\n    liftCompare comp (Compose x) (Compose y) =\n        liftCompare (liftCompare comp) x y\n\n-- | @since 4.9.0.0\ninstance (Read1 f, Read1 g) => Read1 (Compose f g) where\n    liftReadPrec rp rl = readData $\n        readUnaryWith (liftReadPrec rp' rl') \"Compose\" Compose\n      where\n        rp' = liftReadPrec     rp rl\n        rl' = liftReadListPrec rp rl\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance (Show1 f, Show1 g) => Show1 (Compose f g) where\n    liftShowsPrec sp sl d (Compose x) =\n        showsUnaryWith (liftShowsPrec sp' sl') \"Compose\" d x\n      where\n        sp' = liftShowsPrec sp sl\n        sl' = liftShowList sp sl\n\n-- Instances of Prelude classes\n\n-- | @since 4.9.0.0\ninstance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where\n    (==) = eq1\n\n-- | @since 4.9.0.0\ninstance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where\n    compare = compare1\n\n-- | @since 4.9.0.0\ninstance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where\n    readPrec = readPrec1\n\n    readListPrec = readListPrecDefault\n    readList     = readListDefault\n\n-- | @since 4.9.0.0\ninstance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where\n    showsPrec = showsPrec1\n\n-- Functor instances\n\n-- | @since 4.9.0.0\ninstance (Functor f, Functor g) => Functor (Compose f g) where\n    fmap f (Compose x) = Compose (fmap (fmap f) x)\n\n-- | @since 4.9.0.0\ninstance (Foldable f, Foldable g) => Foldable (Compose f g) where\n    foldMap f (Compose t) = foldMap (foldMap f) t\n\n-- | @since 4.9.0.0\ninstance (Traversable f, Traversable g) => Traversable (Compose f g) where\n    traverse f (Compose t) = Compose <$> traverse (traverse f) t\n\n-- | @since 4.9.0.0\ninstance (Applicative f, Applicative g) => Applicative (Compose f g) where\n    pure x = Compose (pure (pure x))\n    Compose f <*> Compose x = Compose (liftA2 (<*>) f x)\n    liftA2 f (Compose x) (Compose y) =\n      Compose (liftA2 (liftA2 f) x y)\n\n-- | @since 4.9.0.0\ninstance (Alternative f, Applicative g) => Alternative (Compose f g) where\n    empty = Compose empty\n    (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a))\n      :: forall a . Compose f g a -> Compose f g a -> Compose f g a\n\n-- | The deduction (via generativity) that if @g x :~: g y@ then @x :~: y@.\n--\n-- @since 4.14.0.0\ninstance (TestEquality f) => TestEquality (Compose f g) where\n  testEquality (Compose x) (Compose y) =\n    case testEquality x y of -- :: Maybe (g x :~: g y)\n      Just Refl -> Just Refl -- :: Maybe (x :~: y)\n      Nothing   -> Nothing\n", "num_lines": 133}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor.Const\n-- Copyright   :  Conor McBride and Ross Paterson 2005\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n\n-- The 'Const' functor.\n--\n-- @since 4.9.0.0\n\nmodule Data.Functor.Const (Const(..)) where\n\nimport Data.Bits (Bits, FiniteBits)\nimport Data.Foldable (Foldable(foldMap))\nimport Foreign.Storable (Storable)\n\nimport GHC.Arr (Ix)\nimport GHC.Base\nimport GHC.Enum (Bounded, Enum)\nimport GHC.Float (Floating, RealFloat)\nimport GHC.Generics (Generic, Generic1)\nimport GHC.Num (Num)\nimport GHC.Real (Fractional, Integral, Real, RealFrac)\nimport GHC.Read (Read(readsPrec), readParen, lex)\nimport GHC.Show (Show(showsPrec), showParen, showString)\n\n-- | The 'Const' functor.\nnewtype Const a b = Const { getConst :: a }\n    deriving ( Bits       -- ^ @since 4.9.0.0\n             , Bounded    -- ^ @since 4.9.0.0\n             , Enum       -- ^ @since 4.9.0.0\n             , Eq         -- ^ @since 4.9.0.0\n             , FiniteBits -- ^ @since 4.9.0.0\n             , Floating   -- ^ @since 4.9.0.0\n             , Fractional -- ^ @since 4.9.0.0\n             , Generic    -- ^ @since 4.9.0.0\n             , Generic1   -- ^ @since 4.9.0.0\n             , Integral   -- ^ @since 4.9.0.0\n             , Ix         -- ^ @since 4.9.0.0\n             , Semigroup  -- ^ @since 4.9.0.0\n             , Monoid     -- ^ @since 4.9.0.0\n             , Num        -- ^ @since 4.9.0.0\n             , Ord        -- ^ @since 4.9.0.0\n             , Real       -- ^ @since 4.9.0.0\n             , RealFrac   -- ^ @since 4.9.0.0\n             , RealFloat  -- ^ @since 4.9.0.0\n             , Storable   -- ^ @since 4.9.0.0\n             )\n\n-- | This instance would be equivalent to the derived instances of the\n-- 'Const' newtype if the 'getConst' field were removed\n--\n-- @since 4.8.0.0\ninstance Read a => Read (Const a b) where\n    readsPrec d = readParen (d > 10)\n        $ \\r -> [(Const x,t) | (\"Const\", s) <- lex r, (x, t) <- readsPrec 11 s]\n\n-- | This instance would be equivalent to the derived instances of the\n-- 'Const' newtype if the 'getConst' field were removed\n--\n-- @since 4.8.0.0\ninstance Show a => Show (Const a b) where\n    showsPrec d (Const x) = showParen (d > 10) $\n                            showString \"Const \" . showsPrec 11 x\n\n-- | @since 4.7.0.0\ninstance Foldable (Const m) where\n    foldMap _ _ = mempty\n\n-- | @since 2.01\ninstance Functor (Const m) where\n    fmap _ (Const v) = Const v\n\n-- | @since 2.0.1\ninstance Monoid m => Applicative (Const m) where\n    pure _ = Const mempty\n    liftA2 _ (Const x) (Const y) = Const (x `mappend` y)\n    (<*>) = coerce (mappend :: m -> m -> m)\n-- This is pretty much the same as\n-- Const f <*> Const v = Const (f `mappend` v)\n-- but guarantees that mappend for Const a b will have the same arity\n-- as the one for a; it won't create a closure to raise the arity\n-- to 2.\n", "num_lines": 95}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeOperators #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor.Contravariant\n-- Copyright   :  (C) 2007-2015 Edward Kmett\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- 'Contravariant' functors, sometimes referred to colloquially as @Cofunctor@,\n-- even though the dual of a 'Functor' is just a 'Functor'. As with 'Functor'\n-- the definition of 'Contravariant' for a given ADT is unambiguous.\n--\n-- @since 4.12.0.0\n----------------------------------------------------------------------------\n\nmodule Data.Functor.Contravariant (\n  -- * Contravariant Functors\n    Contravariant(..)\n  , phantom\n\n  -- * Operators\n  , (>$<), (>$$<), ($<)\n\n  -- * Predicates\n  , Predicate(..)\n\n  -- * Comparisons\n  , Comparison(..)\n  , defaultComparison\n\n  -- * Equivalence Relations\n  , Equivalence(..)\n  , defaultEquivalence\n  , comparisonEquivalence\n\n  -- * Dual arrows\n  , Op(..)\n  ) where\n\nimport Control.Applicative\nimport Control.Category\nimport Data.Function (on)\n\nimport Data.Functor.Product\nimport Data.Functor.Sum\nimport Data.Functor.Compose\n\nimport Data.Monoid (Alt(..))\nimport Data.Proxy\nimport GHC.Generics\n\nimport Prelude hiding ((.),id)\n\n-- | The class of contravariant functors.\n--\n-- Whereas in Haskell, one can think of a 'Functor' as containing or producing\n-- values, a contravariant functor is a functor that can be thought of as\n-- /consuming/ values.\n--\n-- As an example, consider the type of predicate functions  @a -> Bool@. One\n-- such predicate might be @negative x = x < 0@, which\n-- classifies integers as to whether they are negative. However, given this\n-- predicate, we can re-use it in other situations, providing we have a way to\n-- map values /to/ integers. For instance, we can use the @negative@ predicate\n-- on a person's bank balance to work out if they are currently overdrawn:\n--\n-- @\n-- newtype Predicate a = Predicate { getPredicate :: a -> Bool }\n--\n-- instance Contravariant Predicate where\n--   contramap f (Predicate p) = Predicate (p . f)\n--                                          |   `- First, map the input...\n--                                          `----- then apply the predicate.\n--\n-- overdrawn :: Predicate Person\n-- overdrawn = contramap personBankBalance negative\n-- @\n--\n-- Any instance should be subject to the following laws:\n--\n-- [Identity]    @'contramap' 'id' = 'id'@\n-- [Composition] @'contramap' (g . f) = 'contramap' f . 'contramap' g@\n--\n-- Note, that the second law follows from the free theorem of the type of\n-- 'contramap' and the first law, so you need only check that the former\n-- condition holds.\n\nclass Contravariant f where\n  contramap :: (a -> b) -> f b -> f a\n\n  -- | Replace all locations in the output with the same value.\n  -- The default definition is @'contramap' . 'const'@, but this may be\n  -- overridden with a more efficient version.\n  (>$) :: b -> f b -> f a\n  (>$) = contramap . const\n\n-- | If @f@ is both 'Functor' and 'Contravariant' then by the time you factor\n-- in the laws of each of those classes, it can't actually use its argument in\n-- any meaningful capacity.\n--\n-- This method is surprisingly useful. Where both instances exist and are\n-- lawful we have the following laws:\n--\n-- @\n-- 'fmap' f \u00e2\u2030\u00a1 'phantom'\n-- 'contramap' f \u00e2\u2030\u00a1 'phantom'\n-- @\nphantom :: (Functor f, Contravariant f) => f a -> f b\nphantom x = () <$ x $< ()\n\ninfixl 4 >$, $<, >$<, >$$<\n\n-- | This is '>$' with its arguments flipped.\n($<) :: Contravariant f => f b -> b -> f a\n($<) = flip (>$)\n\n-- | This is an infix alias for 'contramap'.\n(>$<) :: Contravariant f => (a -> b) -> f b -> f a\n(>$<) = contramap\n\n-- | This is an infix version of 'contramap' with the arguments flipped.\n(>$$<) :: Contravariant f => f b -> (a -> b) -> f a\n(>$$<) = flip contramap\n\nderiving instance Contravariant f => Contravariant (Alt f)\nderiving instance Contravariant f => Contravariant (Rec1 f)\nderiving instance Contravariant f => Contravariant (M1 i c f)\n\ninstance Contravariant V1 where\n  contramap _ x = case x of\n\ninstance Contravariant U1 where\n  contramap _ _ = U1\n\ninstance Contravariant (K1 i c) where\n  contramap _ (K1 c) = K1 c\n\ninstance (Contravariant f, Contravariant g) => Contravariant (f :*: g) where\n  contramap f (xs :*: ys) = contramap f xs :*: contramap f ys\n\ninstance (Functor f, Contravariant g) => Contravariant (f :.: g) where\n  contramap f (Comp1 fg) = Comp1 (fmap (contramap f) fg)\n\ninstance (Contravariant f, Contravariant g) => Contravariant (f :+: g) where\n  contramap f (L1 xs) = L1 (contramap f xs)\n  contramap f (R1 ys) = R1 (contramap f ys)\n\ninstance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where\n  contramap f (InL xs) = InL (contramap f xs)\n  contramap f (InR ys) = InR (contramap f ys)\n\ninstance (Contravariant f, Contravariant g)\n  => Contravariant (Product f g) where\n    contramap f (Pair a b) = Pair (contramap f a) (contramap f b)\n\ninstance Contravariant (Const a) where\n  contramap _ (Const a) = Const a\n\ninstance (Functor f, Contravariant g) => Contravariant (Compose f g) where\n  contramap f (Compose fga) = Compose (fmap (contramap f) fga)\n\ninstance Contravariant Proxy where\n  contramap _ _ = Proxy\n\nnewtype Predicate a = Predicate { getPredicate :: a -> Bool }\n\n-- | A 'Predicate' is a 'Contravariant' 'Functor', because 'contramap' can\n-- apply its function argument to the input of the predicate.\ninstance Contravariant Predicate where\n  contramap f g = Predicate $ getPredicate g . f\n\ninstance Semigroup (Predicate a) where\n  Predicate p <> Predicate q = Predicate $ \\a -> p a && q a\n\ninstance Monoid (Predicate a) where\n  mempty = Predicate $ const True\n\n-- | Defines a total ordering on a type as per 'compare'.\n--\n-- This condition is not checked by the types. You must ensure that the\n-- supplied values are valid total orderings yourself.\nnewtype Comparison a = Comparison { getComparison :: a -> a -> Ordering }\n\nderiving instance Semigroup (Comparison a)\nderiving instance Monoid (Comparison a)\n\n-- | A 'Comparison' is a 'Contravariant' 'Functor', because 'contramap' can\n-- apply its function argument to each input of the comparison function.\ninstance Contravariant Comparison where\n  contramap f g = Comparison $ on (getComparison g) f\n\n-- | Compare using 'compare'.\ndefaultComparison :: Ord a => Comparison a\ndefaultComparison = Comparison compare\n\n-- | This data type represents an equivalence relation.\n--\n-- Equivalence relations are expected to satisfy three laws:\n--\n-- [Reflexivity]:  @'getEquivalence' f a a = True@\n-- [Symmetry]:     @'getEquivalence' f a b = 'getEquivalence' f b a@\n-- [Transitivity]:\n--    If @'getEquivalence' f a b@ and @'getEquivalence' f b c@ are both 'True'\n--    then so is @'getEquivalence' f a c@.\n--\n-- The types alone do not enforce these laws, so you'll have to check them\n-- yourself.\nnewtype Equivalence a = Equivalence { getEquivalence :: a -> a -> Bool }\n\n-- | Equivalence relations are 'Contravariant', because you can\n-- apply the contramapped function to each input to the equivalence\n-- relation.\ninstance Contravariant Equivalence where\n  contramap f g = Equivalence $ on (getEquivalence g) f\n\ninstance Semigroup (Equivalence a) where\n  Equivalence p <> Equivalence q = Equivalence $ \\a b -> p a b && q a b\n\ninstance Monoid (Equivalence a) where\n  mempty = Equivalence (\\_ _ -> True)\n\n-- | Check for equivalence with '=='.\n--\n-- Note: The instances for 'Double' and 'Float' violate reflexivity for @NaN@.\ndefaultEquivalence :: Eq a => Equivalence a\ndefaultEquivalence = Equivalence (==)\n\ncomparisonEquivalence :: Comparison a -> Equivalence a\ncomparisonEquivalence (Comparison p) = Equivalence $ \\a b -> p a b == EQ\n\n-- | Dual function arrows.\nnewtype Op a b = Op { getOp :: b -> a }\n\nderiving instance Semigroup a => Semigroup (Op a b)\nderiving instance Monoid a => Monoid (Op a b)\n\ninstance Category Op where\n  id = Op id\n  Op f . Op g = Op (g . f)\n\ninstance Contravariant (Op a) where\n  contramap f g = Op (getOp g . f)\n\ninstance Num a => Num (Op a b) where\n  Op f + Op g = Op $ \\a -> f a + g a\n  Op f * Op g = Op $ \\a -> f a * g a\n  Op f - Op g = Op $ \\a -> f a - g a\n  abs (Op f) = Op $ abs . f\n  signum (Op f) = Op $ signum . f\n  fromInteger = Op . const . fromInteger\n\ninstance Fractional a => Fractional (Op a b) where\n  Op f / Op g = Op $ \\a -> f a / g a\n  recip (Op f) = Op $ recip . f\n  fromRational = Op . const . fromRational\n\ninstance Floating a => Floating (Op a b) where\n  pi = Op $ const pi\n  exp (Op f) = Op $ exp . f\n  sqrt (Op f) = Op $ sqrt . f\n  log (Op f) = Op $ log . f\n  sin (Op f) = Op $ sin . f\n  tan (Op f) = Op $ tan . f\n  cos (Op f) = Op $ cos . f\n  asin (Op f) = Op $ asin . f\n  atan (Op f) = Op $ atan . f\n  acos (Op f) = Op $ acos . f\n  sinh (Op f) = Op $ sinh . f\n  tanh (Op f) = Op $ tanh . f\n  cosh (Op f) = Op $ cosh . f\n  asinh (Op f) = Op $ asinh . f\n  atanh (Op f) = Op $ atanh . f\n  acosh (Op f) = Op $ acosh . f\n  Op f ** Op g = Op $ \\a -> f a ** g a\n  logBase (Op f) (Op g) = Op $ \\a -> logBase (f a) (g a)\n", "num_lines": 284}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor.Identity\n-- Copyright   :  (c) Andy Gill 2001,\n--                (c) Oregon Graduate Institute of Science and Technology 2001\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  ross@soi.city.ac.uk\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The identity functor and monad.\n--\n-- This trivial type constructor serves two purposes:\n--\n-- * It can be used with functions parameterized by functor or monad classes.\n--\n-- * It can be used as a base monad to which a series of monad\n--   transformers may be applied to construct a composite monad.\n--   Most monad transformer modules include the special case of\n--   applying the transformer to 'Identity'.  For example, @State s@\n--   is an abbreviation for @StateT s 'Identity'@.\n--\n-- @since 4.8.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Functor.Identity (\n    Identity(..),\n  ) where\n\nimport Control.Monad.Fix\nimport Data.Bits (Bits, FiniteBits)\nimport Data.Coerce\nimport Data.Foldable\nimport Data.Functor.Utils ((#.))\nimport Foreign.Storable (Storable)\nimport GHC.Arr (Ix)\nimport GHC.Base ( Applicative(..), Eq(..), Functor(..), Monad(..)\n                , Semigroup, Monoid, Ord(..), ($), (.) )\nimport GHC.Enum (Bounded, Enum)\nimport GHC.Float (Floating, RealFloat)\nimport GHC.Generics (Generic, Generic1)\nimport GHC.Num (Num)\nimport GHC.Read (Read(..), lex, readParen)\nimport GHC.Real (Fractional, Integral, Real, RealFrac)\nimport GHC.Show (Show(..), showParen, showString)\nimport GHC.Types (Bool(..))\n\n-- | Identity functor and monad. (a non-strict monad)\n--\n-- @since 4.8.0.0\nnewtype Identity a = Identity { runIdentity :: a }\n    deriving ( Bits       -- ^ @since 4.9.0.0\n             , Bounded    -- ^ @since 4.9.0.0\n             , Enum       -- ^ @since 4.9.0.0\n             , Eq         -- ^ @since 4.8.0.0\n             , FiniteBits -- ^ @since 4.9.0.0\n             , Floating   -- ^ @since 4.9.0.0\n             , Fractional -- ^ @since 4.9.0.0\n             , Generic    -- ^ @since 4.8.0.0\n             , Generic1   -- ^ @since 4.8.0.0\n             , Integral   -- ^ @since 4.9.0.0\n             , Ix         -- ^ @since 4.9.0.0\n             , Semigroup  -- ^ @since 4.9.0.0\n             , Monoid     -- ^ @since 4.9.0.0\n             , Num        -- ^ @since 4.9.0.0\n             , Ord        -- ^ @since 4.8.0.0\n             , Real       -- ^ @since 4.9.0.0\n             , RealFrac   -- ^ @since 4.9.0.0\n             , RealFloat  -- ^ @since 4.9.0.0\n             , Storable   -- ^ @since 4.9.0.0\n             )\n\n-- | This instance would be equivalent to the derived instances of the\n-- 'Identity' newtype if the 'runIdentity' field were removed\n--\n-- @since 4.8.0.0\ninstance (Read a) => Read (Identity a) where\n    readsPrec d = readParen (d > 10) $ \\ r ->\n        [(Identity x,t) | (\"Identity\",s) <- lex r, (x,t) <- readsPrec 11 s]\n\n-- | This instance would be equivalent to the derived instances of the\n-- 'Identity' newtype if the 'runIdentity' field were removed\n--\n-- @since 4.8.0.0\ninstance (Show a) => Show (Identity a) where\n    showsPrec d (Identity x) = showParen (d > 10) $\n        showString \"Identity \" . showsPrec 11 x\n\n-- ---------------------------------------------------------------------------\n-- Identity instances for Functor and Monad\n\n-- | @since 4.8.0.0\ninstance Foldable Identity where\n    foldMap                = coerce\n\n    elem                   = (. runIdentity) #. (==)\n    foldl                  = coerce\n    foldl'                 = coerce\n    foldl1 _               = runIdentity\n    foldr f z (Identity x) = f x z\n    foldr'                 = foldr\n    foldr1 _               = runIdentity\n    length _               = 1\n    maximum                = runIdentity\n    minimum                = runIdentity\n    null _                 = False\n    product                = runIdentity\n    sum                    = runIdentity\n    toList (Identity x)    = [x]\n\n-- | @since 4.8.0.0\ninstance Functor Identity where\n    fmap     = coerce\n\n-- | @since 4.8.0.0\ninstance Applicative Identity where\n    pure     = Identity\n    (<*>)    = coerce\n    liftA2   = coerce\n\n-- | @since 4.8.0.0\ninstance Monad Identity where\n    m >>= k  = k (runIdentity m)\n\n-- | @since 4.8.0.0\ninstance MonadFix Identity where\n    mfix f   = Identity (fix (runIdentity . f))\n", "num_lines": 136}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE Safe #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor.Product\n-- Copyright   :  (c) Ross Paterson 2010\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Products, lifted to functors.\n--\n-- @since 4.9.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Functor.Product (\n    Product(..),\n  ) where\n\nimport Control.Applicative\nimport Control.Monad (MonadPlus(..))\nimport Control.Monad.Fix (MonadFix(..))\nimport Control.Monad.Zip (MonadZip(mzipWith))\nimport Data.Data (Data)\nimport Data.Functor.Classes\nimport GHC.Generics (Generic, Generic1)\nimport Text.Read (Read(..), readListDefault, readListPrecDefault)\n\n-- | Lifted product of functors.\ndata Product f g a = Pair (f a) (g a)\n  deriving ( Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance (Eq1 f, Eq1 g) => Eq1 (Product f g) where\n    liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2\n\n-- | @since 4.9.0.0\ninstance (Ord1 f, Ord1 g) => Ord1 (Product f g) where\n    liftCompare comp (Pair x1 y1) (Pair x2 y2) =\n        liftCompare comp x1 x2 `mappend` liftCompare comp y1 y2\n\n-- | @since 4.9.0.0\ninstance (Read1 f, Read1 g) => Read1 (Product f g) where\n    liftReadPrec rp rl = readData $\n        readBinaryWith (liftReadPrec rp rl) (liftReadPrec rp rl) \"Pair\" Pair\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance (Show1 f, Show1 g) => Show1 (Product f g) where\n    liftShowsPrec sp sl d (Pair x y) =\n        showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) \"Pair\" d x y\n\n-- | @since 4.9.0.0\ninstance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a)\n    where (==) = eq1\n\n-- | @since 4.9.0.0\ninstance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where\n    compare = compare1\n\n-- | @since 4.9.0.0\ninstance (Read1 f, Read1 g, Read a) => Read (Product f g a) where\n    readPrec = readPrec1\n\n    readListPrec = readListPrecDefault\n    readList     = readListDefault\n\n-- | @since 4.9.0.0\ninstance (Show1 f, Show1 g, Show a) => Show (Product f g a) where\n    showsPrec = showsPrec1\n\n-- | @since 4.9.0.0\ninstance (Functor f, Functor g) => Functor (Product f g) where\n    fmap f (Pair x y) = Pair (fmap f x) (fmap f y)\n\n-- | @since 4.9.0.0\ninstance (Foldable f, Foldable g) => Foldable (Product f g) where\n    foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y\n\n-- | @since 4.9.0.0\ninstance (Traversable f, Traversable g) => Traversable (Product f g) where\n    traverse f (Pair x y) = liftA2 Pair (traverse f x) (traverse f y)\n\n-- | @since 4.9.0.0\ninstance (Applicative f, Applicative g) => Applicative (Product f g) where\n    pure x = Pair (pure x) (pure x)\n    Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y)\n    liftA2 f (Pair a b) (Pair x y) = Pair (liftA2 f a x) (liftA2 f b y)\n\n-- | @since 4.9.0.0\ninstance (Alternative f, Alternative g) => Alternative (Product f g) where\n    empty = Pair empty empty\n    Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2)\n\n-- | @since 4.9.0.0\ninstance (Monad f, Monad g) => Monad (Product f g) where\n    Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f)\n      where\n        fstP (Pair a _) = a\n        sndP (Pair _ b) = b\n\n-- | @since 4.9.0.0\ninstance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where\n    mzero = Pair mzero mzero\n    Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2)\n\n-- | @since 4.9.0.0\ninstance (MonadFix f, MonadFix g) => MonadFix (Product f g) where\n    mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f))\n      where\n        fstP (Pair a _) = a\n        sndP (Pair _ b) = b\n\n-- | @since 4.9.0.0\ninstance (MonadZip f, MonadZip g) => MonadZip (Product f g) where\n    mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2)\n", "num_lines": 126}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE Safe #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Functor.Sum\n-- Copyright   :  (c) Ross Paterson 2014\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Sums, lifted to functors.\n--\n-- @since 4.9.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Functor.Sum (\n    Sum(..),\n  ) where\n\nimport Control.Applicative ((<|>))\nimport Data.Data (Data)\nimport Data.Functor.Classes\nimport GHC.Generics (Generic, Generic1)\nimport Text.Read (Read(..), readListDefault, readListPrecDefault)\n\n-- | Lifted sum of functors.\ndata Sum f g a = InL (f a) | InR (g a)\n  deriving ( Data     -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where\n    liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2\n    liftEq _ (InL _) (InR _) = False\n    liftEq _ (InR _) (InL _) = False\n    liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2\n\n-- | @since 4.9.0.0\ninstance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where\n    liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2\n    liftCompare _ (InL _) (InR _) = LT\n    liftCompare _ (InR _) (InL _) = GT\n    liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2\n\n-- | @since 4.9.0.0\ninstance (Read1 f, Read1 g) => Read1 (Sum f g) where\n    liftReadPrec rp rl = readData $\n        readUnaryWith (liftReadPrec rp rl) \"InL\" InL <|>\n        readUnaryWith (liftReadPrec rp rl) \"InR\" InR\n\n    liftReadListPrec = liftReadListPrecDefault\n    liftReadList     = liftReadListDefault\n\n-- | @since 4.9.0.0\ninstance (Show1 f, Show1 g) => Show1 (Sum f g) where\n    liftShowsPrec sp sl d (InL x) =\n        showsUnaryWith (liftShowsPrec sp sl) \"InL\" d x\n    liftShowsPrec sp sl d (InR y) =\n        showsUnaryWith (liftShowsPrec sp sl) \"InR\" d y\n\n-- | @since 4.9.0.0\ninstance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where\n    (==) = eq1\n-- | @since 4.9.0.0\ninstance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where\n    compare = compare1\n-- | @since 4.9.0.0\ninstance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where\n    readPrec = readPrec1\n\n    readListPrec = readListPrecDefault\n    readList     = readListDefault\n-- | @since 4.9.0.0\ninstance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where\n    showsPrec = showsPrec1\n\n-- | @since 4.9.0.0\ninstance (Functor f, Functor g) => Functor (Sum f g) where\n    fmap f (InL x) = InL (fmap f x)\n    fmap f (InR y) = InR (fmap f y)\n\n-- | @since 4.9.0.0\ninstance (Foldable f, Foldable g) => Foldable (Sum f g) where\n    foldMap f (InL x) = foldMap f x\n    foldMap f (InR y) = foldMap f y\n\n-- | @since 4.9.0.0\ninstance (Traversable f, Traversable g) => Traversable (Sum f g) where\n    traverse f (InL x) = InL <$> traverse f x\n    traverse f (InR y) = InR <$> traverse f y\n", "num_lines": 97}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- This is a non-exposed internal module.\n--\n-- This code contains utility function and data structures that are used\n-- to improve the efficiency of several instances in the Data.* namespace.\n-----------------------------------------------------------------------------\nmodule Data.Functor.Utils where\n\nimport Data.Coerce (Coercible, coerce)\nimport GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)\n                , Semigroup(..), ($), otherwise )\n\n-- We don't expose Max and Min because, as Edward Kmett pointed out to me,\n-- there are two reasonable ways to define them. One way is to use Maybe, as we\n-- do here; the other way is to impose a Bounded constraint on the Monoid\n-- instance. We may eventually want to add both versions, but we don't want to\n-- trample on anyone's toes by imposing Max = MaxMaybe.\n\nnewtype Max a = Max {getMax :: Maybe a}\nnewtype Min a = Min {getMin :: Maybe a}\n\n-- | @since 4.11.0.0\ninstance Ord a => Semigroup (Max a) where\n    {-# INLINE (<>) #-}\n    m <> Max Nothing = m\n    Max Nothing <> n = n\n    (Max m@(Just x)) <> (Max n@(Just y))\n      | x >= y    = Max m\n      | otherwise = Max n\n\n-- | @since 4.8.0.0\ninstance Ord a => Monoid (Max a) where\n    mempty = Max Nothing\n\n-- | @since 4.11.0.0\ninstance Ord a => Semigroup (Min a) where\n    {-# INLINE (<>) #-}\n    m <> Min Nothing = m\n    Min Nothing <> n = n\n    (Min m@(Just x)) <> (Min n@(Just y))\n      | x <= y    = Min m\n      | otherwise = Min n\n\n-- | @since 4.8.0.0\ninstance Ord a => Monoid (Min a) where\n    mempty = Min Nothing\n\n-- left-to-right state-transforming monad\nnewtype StateL s a = StateL { runStateL :: s -> (s, a) }\n\n-- | @since 4.0\ninstance Functor (StateL s) where\n    fmap f (StateL k) = StateL $ \\ s -> let (s', v) = k s in (s', f v)\n\n-- | @since 4.0\ninstance Applicative (StateL s) where\n    pure x = StateL (\\ s -> (s, x))\n    StateL kf <*> StateL kv = StateL $ \\ s ->\n        let (s', f) = kf s\n            (s'', v) = kv s'\n        in (s'', f v)\n    liftA2 f (StateL kx) (StateL ky) = StateL $ \\s ->\n        let (s', x) = kx s\n            (s'', y) = ky s'\n        in (s'', f x y)\n\n-- right-to-left state-transforming monad\nnewtype StateR s a = StateR { runStateR :: s -> (s, a) }\n\n-- | @since 4.0\ninstance Functor (StateR s) where\n    fmap f (StateR k) = StateR $ \\ s -> let (s', v) = k s in (s', f v)\n\n-- | @since 4.0\ninstance Applicative (StateR s) where\n    pure x = StateR (\\ s -> (s, x))\n    StateR kf <*> StateR kv = StateR $ \\ s ->\n        let (s', v) = kv s\n            (s'', f) = kf s'\n        in (s'', f v)\n    liftA2 f (StateR kx) (StateR ky) = StateR $ \\ s ->\n        let (s', y) = ky s\n            (s'', x) = kx s'\n        in (s'', f x y)\n\n-- See Note [Function coercion]\n(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)\n(#.) _f = coerce\n{-# INLINE (#.) #-}\n\n{-\nNote [Function coercion]\n~~~~~~~~~~~~~~~~~~~~~~~\n\nSeveral functions here use (#.) instead of (.) to avoid potential efficiency\nproblems relating to #7542. The problem, in a nutshell:\n\nIf N is a newtype constructor, then N x will always have the same\nrepresentation as x (something similar applies for a newtype deconstructor).\nHowever, if f is a function,\n\nN . f = \\x -> N (f x)\n\nThis looks almost the same as f, but the eta expansion lifts it--the lhs could\nbe _|_, but the rhs never is. This can lead to very inefficient code.  Thus we\nsteal a technique from Shachaf and Edward Kmett and adapt it to the current\n(rather clean) setting. Instead of using  N . f,  we use  N #. f, which is\njust\n\ncoerce f `asTypeOf` (N . f)\n\nThat is, we just *pretend* that f has the right type, and thanks to the safety\nof coerce, the type checker guarantees that nothing really goes wrong. We still\nhave to be a bit careful, though: remember that #. completely ignores the\n*value* of its left operand.\n-}\n", "num_lines": 120}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE Trustworthy #-} -- can't use Safe due to IsList instance\n{-# LANGUAGE TypeFamilies #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.List.NonEmpty\n-- Copyright   :  (C) 2011-2015 Edward Kmett,\n--                (C) 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A 'NonEmpty' list is one which always has at least one element, but\n-- is otherwise identical to the traditional list type in complexity\n-- and in terms of API. You will almost certainly want to import this\n-- module @qualified@.\n--\n-- @since 4.9.0.0\n----------------------------------------------------------------------------\n\nmodule Data.List.NonEmpty (\n   -- * The type of non-empty streams\n     NonEmpty(..)\n\n   -- * Non-empty stream transformations\n   , map         -- :: (a -> b) -> NonEmpty a -> NonEmpty b\n   , intersperse -- :: a -> NonEmpty a -> NonEmpty a\n   , scanl       -- :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b\n   , scanr       -- :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b\n   , scanl1      -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a\n   , scanr1      -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a\n   , transpose   -- :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)\n   , sortBy      -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a\n   , sortWith      -- :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a\n   -- * Basic functions\n   , length      -- :: NonEmpty a -> Int\n   , head        -- :: NonEmpty a -> a\n   , tail        -- :: NonEmpty a -> [a]\n   , last        -- :: NonEmpty a -> a\n   , init        -- :: NonEmpty a -> [a]\n   , (<|), cons  -- :: a -> NonEmpty a -> NonEmpty a\n   , uncons      -- :: NonEmpty a -> (a, Maybe (NonEmpty a))\n   , unfoldr     -- :: (a -> (b, Maybe a)) -> a -> NonEmpty b\n   , sort        -- :: NonEmpty a -> NonEmpty a\n   , reverse     -- :: NonEmpty a -> NonEmpty a\n   , inits       -- :: Foldable f => f a -> NonEmpty a\n   , tails       -- :: Foldable f => f a -> NonEmpty a\n   -- * Building streams\n   , iterate     -- :: (a -> a) -> a -> NonEmpty a\n   , repeat      -- :: a -> NonEmpty a\n   , cycle       -- :: NonEmpty a -> NonEmpty a\n   , unfold      -- :: (a -> (b, Maybe a) -> a -> NonEmpty b\n   , insert      -- :: (Foldable f, Ord a) => a -> f a -> NonEmpty a\n   , some1       -- :: Alternative f => f a -> f (NonEmpty a)\n   -- * Extracting sublists\n   , take        -- :: Int -> NonEmpty a -> [a]\n   , drop        -- :: Int -> NonEmpty a -> [a]\n   , splitAt     -- :: Int -> NonEmpty a -> ([a], [a])\n   , takeWhile   -- :: Int -> NonEmpty a -> [a]\n   , dropWhile   -- :: Int -> NonEmpty a -> [a]\n   , span        -- :: Int -> NonEmpty a -> ([a],[a])\n   , break       -- :: Int -> NonEmpty a -> ([a],[a])\n   , filter      -- :: (a -> Bool) -> NonEmpty a -> [a]\n   , partition   -- :: (a -> Bool) -> NonEmpty a -> ([a],[a])\n   , group       -- :: Foldable f => Eq a => f a -> [NonEmpty a]\n   , groupBy     -- :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a]\n   , groupWith     -- :: (Foldable f, Eq b) => (a -> b) -> f a -> [NonEmpty a]\n   , groupAllWith  -- :: (Foldable f, Ord b) => (a -> b) -> f a -> [NonEmpty a]\n   , group1      -- :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a)\n   , groupBy1    -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)\n   , groupWith1     -- :: (Foldable f, Eq b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)\n   , groupAllWith1  -- :: (Foldable f, Ord b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)\n   -- * Sublist predicates\n   , isPrefixOf  -- :: Foldable f => f a -> NonEmpty a -> Bool\n   -- * \\\"Set\\\" operations\n   , nub         -- :: Eq a => NonEmpty a -> NonEmpty a\n   , nubBy       -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a\n   -- * Indexing streams\n   , (!!)        -- :: NonEmpty a -> Int -> a\n   -- * Zipping and unzipping streams\n   , zip         -- :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)\n   , zipWith     -- :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c\n   , unzip       -- :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)\n   -- * Converting to and from a list\n   , fromList    -- :: [a] -> NonEmpty a\n   , toList      -- :: NonEmpty a -> [a]\n   , nonEmpty    -- :: [a] -> Maybe (NonEmpty a)\n   , xor         -- :: NonEmpty a -> Bool\n   ) where\n\n\nimport           Prelude             hiding (break, cycle, drop, dropWhile,\n                                      filter, foldl, foldr, head, init, iterate,\n                                      last, length, map, repeat, reverse,\n                                      scanl, scanl1, scanr, scanr1, span,\n                                      splitAt, tail, take, takeWhile,\n                                      unzip, zip, zipWith, (!!))\nimport qualified Prelude\n\nimport           Control.Applicative (Applicative (..), Alternative (many))\nimport           Data.Foldable       hiding (length, toList)\nimport qualified Data.Foldable       as Foldable\nimport           Data.Function       (on)\nimport qualified Data.List           as List\nimport           Data.Ord            (comparing)\nimport           GHC.Base            (NonEmpty(..))\n\ninfixr 5 <|\n\n-- | Number of elements in 'NonEmpty' list.\nlength :: NonEmpty a -> Int\nlength (_ :| xs) = 1 + Prelude.length xs\n\n-- | Compute n-ary logic exclusive OR operation on 'NonEmpty' list.\nxor :: NonEmpty Bool -> Bool\nxor (x :| xs)   = foldr xor' x xs\n  where xor' True y  = not y\n        xor' False y = y\n\n-- | 'unfold' produces a new stream by repeatedly applying the unfolding\n-- function to the seed value to produce an element of type @b@ and a new\n-- seed value.  When the unfolding function returns 'Nothing' instead of\n-- a new seed value, the stream ends.\nunfold :: (a -> (b, Maybe a)) -> a -> NonEmpty b\nunfold f a = case f a of\n  (b, Nothing) -> b :| []\n  (b, Just c)  -> b <| unfold f c\n{-# DEPRECATED unfold \"Use unfoldr\" #-}\n-- Deprecated in 8.2.1, remove in 8.4\n\n-- | 'nonEmpty' efficiently turns a normal list into a 'NonEmpty' stream,\n-- producing 'Nothing' if the input is empty.\nnonEmpty :: [a] -> Maybe (NonEmpty a)\nnonEmpty []     = Nothing\nnonEmpty (a:as) = Just (a :| as)\n\n-- | 'uncons' produces the first element of the stream, and a stream of the\n-- remaining elements, if any.\nuncons :: NonEmpty a -> (a, Maybe (NonEmpty a))\nuncons ~(a :| as) = (a, nonEmpty as)\n\n-- | The 'unfoldr' function is analogous to \"Data.List\"'s\n-- 'Data.List.unfoldr' operation.\nunfoldr :: (a -> (b, Maybe a)) -> a -> NonEmpty b\nunfoldr f a = case f a of\n  (b, mc) -> b :| maybe [] go mc\n where\n    go c = case f c of\n      (d, me) -> d : maybe [] go me\n\n-- | Extract the first element of the stream.\nhead :: NonEmpty a -> a\nhead ~(a :| _) = a\n\n-- | Extract the possibly-empty tail of the stream.\ntail :: NonEmpty a -> [a]\ntail ~(_ :| as) = as\n\n-- | Extract the last element of the stream.\nlast :: NonEmpty a -> a\nlast ~(a :| as) = List.last (a : as)\n\n-- | Extract everything except the last element of the stream.\ninit :: NonEmpty a -> [a]\ninit ~(a :| as) = List.init (a : as)\n\n-- | Prepend an element to the stream.\n(<|) :: a -> NonEmpty a -> NonEmpty a\na <| ~(b :| bs) = a :| b : bs\n\n-- | Synonym for '<|'.\ncons :: a -> NonEmpty a -> NonEmpty a\ncons = (<|)\n\n-- | Sort a stream.\nsort :: Ord a => NonEmpty a -> NonEmpty a\nsort = lift List.sort\n\n-- | Converts a normal list to a 'NonEmpty' stream.\n--\n-- Raises an error if given an empty list.\nfromList :: [a] -> NonEmpty a\nfromList (a:as) = a :| as\nfromList [] = errorWithoutStackTrace \"NonEmpty.fromList: empty list\"\n\n-- | Convert a stream to a normal list efficiently.\ntoList :: NonEmpty a -> [a]\ntoList ~(a :| as) = a : as\n\n-- | Lift list operations to work on a 'NonEmpty' stream.\n--\n-- /Beware/: If the provided function returns an empty list,\n-- this will raise an error.\nlift :: Foldable f => ([a] -> [b]) -> f a -> NonEmpty b\nlift f = fromList . f . Foldable.toList\n\n-- | Map a function over a 'NonEmpty' stream.\nmap :: (a -> b) -> NonEmpty a -> NonEmpty b\nmap f ~(a :| as) = f a :| fmap f as\n\n-- | The 'inits' function takes a stream @xs@ and returns all the\n-- finite prefixes of @xs@.\ninits :: Foldable f => f a -> NonEmpty [a]\ninits = fromList . List.inits . Foldable.toList\n\n-- | The 'tails' function takes a stream @xs@ and returns all the\n-- suffixes of @xs@.\ntails   :: Foldable f => f a -> NonEmpty [a]\ntails = fromList . List.tails . Foldable.toList\n\n-- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it\n-- is still less than or equal to the next element. In particular, if the\n-- list is sorted beforehand, the result will also be sorted.\ninsert  :: (Foldable f, Ord a) => a -> f a -> NonEmpty a\ninsert a = fromList . List.insert a . Foldable.toList\n\n-- | @'some1' x@ sequences @x@ one or more times.\nsome1 :: Alternative f => f a -> f (NonEmpty a)\nsome1 x = liftA2 (:|) x (many x)\n\n-- | 'scanl' is similar to 'foldl', but returns a stream of successive\n-- reduced values from the left:\n--\n-- > scanl f z [x1, x2, ...] == z :| [z `f` x1, (z `f` x1) `f` x2, ...]\n--\n-- Note that\n--\n-- > last (scanl f z xs) == foldl f z xs.\nscanl   :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b\nscanl f z = fromList . List.scanl f z . Foldable.toList\n\n-- | 'scanr' is the right-to-left dual of 'scanl'.\n-- Note that\n--\n-- > head (scanr f z xs) == foldr f z xs.\nscanr   :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b\nscanr f z = fromList . List.scanr f z . Foldable.toList\n\n-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:\n--\n-- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...]\nscanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a\nscanl1 f ~(a :| as) = fromList (List.scanl f a as)\n\n-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.\nscanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a\nscanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as))\n\n-- | 'intersperse x xs' alternates elements of the list with copies of @x@.\n--\n-- > intersperse 0 (1 :| [2,3]) == 1 :| [0,2,0,3]\nintersperse :: a -> NonEmpty a -> NonEmpty a\nintersperse a ~(b :| bs) = b :| case bs of\n    [] -> []\n    _ -> a : List.intersperse a bs\n\n-- | @'iterate' f x@ produces the infinite sequence\n-- of repeated applications of @f@ to @x@.\n--\n-- > iterate f x = x :| [f x, f (f x), ..]\niterate :: (a -> a) -> a -> NonEmpty a\niterate f a = a :| List.iterate f (f a)\n\n-- | @'cycle' xs@ returns the infinite repetition of @xs@:\n--\n-- > cycle (1 :| [2,3]) = 1 :| [2,3,1,2,3,...]\ncycle :: NonEmpty a -> NonEmpty a\ncycle = fromList . List.cycle . toList\n\n-- | 'reverse' a finite NonEmpty stream.\nreverse :: NonEmpty a -> NonEmpty a\nreverse = lift List.reverse\n\n-- | @'repeat' x@ returns a constant stream, where all elements are\n-- equal to @x@.\nrepeat :: a -> NonEmpty a\nrepeat a = a :| List.repeat a\n\n-- | @'take' n xs@ returns the first @n@ elements of @xs@.\ntake :: Int -> NonEmpty a -> [a]\ntake n = List.take n . toList\n\n-- | @'drop' n xs@ drops the first @n@ elements off the front of\n-- the sequence @xs@.\ndrop :: Int -> NonEmpty a -> [a]\ndrop n = List.drop n . toList\n\n-- | @'splitAt' n xs@ returns a pair consisting of the prefix of @xs@\n-- of length @n@ and the remaining stream immediately following this prefix.\n--\n-- > 'splitAt' n xs == ('take' n xs, 'drop' n xs)\n-- > xs == ys ++ zs where (ys, zs) = 'splitAt' n xs\nsplitAt :: Int -> NonEmpty a -> ([a],[a])\nsplitAt n = List.splitAt n . toList\n\n-- | @'takeWhile' p xs@ returns the longest prefix of the stream\n-- @xs@ for which the predicate @p@ holds.\ntakeWhile :: (a -> Bool) -> NonEmpty a -> [a]\ntakeWhile p = List.takeWhile p . toList\n\n-- | @'dropWhile' p xs@ returns the suffix remaining after\n-- @'takeWhile' p xs@.\ndropWhile :: (a -> Bool) -> NonEmpty a -> [a]\ndropWhile p = List.dropWhile p . toList\n\n-- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies\n-- @p@, together with the remainder of the stream.\n--\n-- > 'span' p xs == ('takeWhile' p xs, 'dropWhile' p xs)\n-- > xs == ys ++ zs where (ys, zs) = 'span' p xs\nspan :: (a -> Bool) -> NonEmpty a -> ([a], [a])\nspan p = List.span p . toList\n\n-- | The @'break' p@ function is equivalent to @'span' (not . p)@.\nbreak :: (a -> Bool) -> NonEmpty a -> ([a], [a])\nbreak p = span (not . p)\n\n-- | @'filter' p xs@ removes any elements from @xs@ that do not satisfy @p@.\nfilter :: (a -> Bool) -> NonEmpty a -> [a]\nfilter p = List.filter p . toList\n\n-- | The 'partition' function takes a predicate @p@ and a stream\n-- @xs@, and returns a pair of lists. The first list corresponds to the\n-- elements of @xs@ for which @p@ holds; the second corresponds to the\n-- elements of @xs@ for which @p@ does not hold.\n--\n-- > 'partition' p xs = ('filter' p xs, 'filter' (not . p) xs)\npartition :: (a -> Bool) -> NonEmpty a -> ([a], [a])\npartition p = List.partition p . toList\n\n-- | The 'group' function takes a stream and returns a list of\n-- streams such that flattening the resulting list is equal to the\n-- argument.  Moreover, each stream in the resulting list\n-- contains only equal elements.  For example, in list notation:\n--\n-- > 'group' $ 'cycle' \"Mississippi\"\n-- >   = \"M\" : \"i\" : \"ss\" : \"i\" : \"ss\" : \"i\" : \"pp\" : \"i\" : \"M\" : \"i\" : ...\ngroup :: (Foldable f, Eq a) => f a -> [NonEmpty a]\ngroup = groupBy (==)\n\n-- | 'groupBy' operates like 'group', but uses the provided equality\n-- predicate instead of `==`.\ngroupBy :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a]\ngroupBy eq0 = go eq0 . Foldable.toList\n  where\n    go _  [] = []\n    go eq (x : xs) = (x :| ys) : groupBy eq zs\n      where (ys, zs) = List.span (eq x) xs\n\n-- | 'groupWith' operates like 'group', but uses the provided projection when\n-- comparing for equality\ngroupWith :: (Foldable f, Eq b) => (a -> b) -> f a -> [NonEmpty a]\ngroupWith f = groupBy ((==) `on` f)\n\n-- | 'groupAllWith' operates like 'groupWith', but sorts the list\n-- first so that each equivalence class has, at most, one list in the\n-- output\ngroupAllWith :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a]\ngroupAllWith f = groupWith f . List.sortBy (compare `on` f)\n\n-- | 'group1' operates like 'group', but uses the knowledge that its\n-- input is non-empty to produce guaranteed non-empty output.\ngroup1 :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a)\ngroup1 = groupBy1 (==)\n\n-- | 'groupBy1' is to 'group1' as 'groupBy' is to 'group'.\ngroupBy1 :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)\ngroupBy1 eq (x :| xs) = (x :| ys) :| groupBy eq zs\n  where (ys, zs) = List.span (eq x) xs\n\n-- | 'groupWith1' is to 'group1' as 'groupWith' is to 'group'\ngroupWith1 :: (Eq b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)\ngroupWith1 f = groupBy1 ((==) `on` f)\n\n-- | 'groupAllWith1' is to 'groupWith1' as 'groupAllWith' is to 'groupWith'\ngroupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)\ngroupAllWith1 f = groupWith1 f . sortWith f\n\n-- | The 'isPrefixOf' function returns 'True' if the first argument is\n-- a prefix of the second.\nisPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool\nisPrefixOf [] _ = True\nisPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs\n\n-- | @xs !! n@ returns the element of the stream @xs@ at index\n-- @n@. Note that the head of the stream has index 0.\n--\n-- /Beware/: a negative or out-of-bounds index will cause an error.\n(!!) :: NonEmpty a -> Int -> a\n(!!) ~(x :| xs) n\n  | n == 0 = x\n  | n > 0  = xs List.!! (n - 1)\n  | otherwise = errorWithoutStackTrace \"NonEmpty.!! negative argument\"\ninfixl 9 !!\n\n-- | The 'zip' function takes two streams and returns a stream of\n-- corresponding pairs.\nzip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)\nzip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys\n\n-- | The 'zipWith' function generalizes 'zip'. Rather than tupling\n-- the elements, the elements are combined using the function\n-- passed as the first argument.\nzipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c\nzipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys\n\n-- | The 'unzip' function is the inverse of the 'zip' function.\nunzip :: Functor f => f (a,b) -> (f a, f b)\nunzip xs = (fst <$> xs, snd <$> xs)\n\n-- | The 'nub' function removes duplicate elements from a list. In\n-- particular, it keeps only the first occurrence of each element.\n-- (The name 'nub' means \\'essence\\'.)\n-- It is a special case of 'nubBy', which allows the programmer to\n-- supply their own inequality test.\nnub :: Eq a => NonEmpty a -> NonEmpty a\nnub = nubBy (==)\n\n-- | The 'nubBy' function behaves just like 'nub', except it uses a\n-- user-supplied equality predicate instead of the overloaded '=='\n-- function.\nnubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a\nnubBy eq (a :| as) = a :| List.nubBy eq (List.filter (\\b -> not (eq a b)) as)\n\n-- | 'transpose' for 'NonEmpty', behaves the same as 'Data.List.transpose'\n-- The rows/columns need not be the same length, in which case\n-- > transpose . transpose /= id\ntranspose :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)\ntranspose = fmap fromList\n          . fromList . List.transpose . toList\n          . fmap toList\n\n-- | 'sortBy' for 'NonEmpty', behaves the same as 'Data.List.sortBy'\nsortBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a\nsortBy f = lift (List.sortBy f)\n\n-- | 'sortWith' for 'NonEmpty', behaves the same as:\n--\n-- > sortBy . comparing\nsortWith :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a\nsortWith = sortBy . comparing\n", "num_lines": 446}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n-- | Auxilary definitions for 'Semigroup'\n--\n-- This module provides some @newtype@ wrappers and helpers which are\n-- reexported from the \"Data.Semigroup\" module or imported directly\n-- by some other modules.\n--\n-- This module also provides internal definitions related to the\n-- 'Semigroup' class some.\n--\n-- This module exists mostly to simplify or workaround import-graph\n-- issues; there is also a .hs-boot file to allow \"GHC.Base\" and other\n-- modules to import method default implementations for 'stimes'\n--\n-- @since 4.11.0.0\nmodule Data.Semigroup.Internal where\n\nimport GHC.Base hiding (Any)\nimport GHC.Enum\nimport GHC.Num\nimport GHC.Read\nimport GHC.Show\nimport GHC.Generics\nimport GHC.Real\n\n-- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'.\n--\n-- When @x <> x = x@, this definition should be preferred, because it\n-- works in /O(1)/ rather than /O(log n)/.\nstimesIdempotent :: Integral b => b -> a -> a\nstimesIdempotent n x\n  | n <= 0 = errorWithoutStackTrace \"stimesIdempotent: positive multiplier expected\"\n  | otherwise = x\n\n-- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.\n--\n-- When @mappend x x = x@, this definition should be preferred, because it\n-- works in /O(1)/ rather than /O(log n)/\nstimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a\nstimesIdempotentMonoid n x = case compare n 0 of\n  LT -> errorWithoutStackTrace \"stimesIdempotentMonoid: negative multiplier\"\n  EQ -> mempty\n  GT -> x\n\n-- | This is a valid definition of 'stimes' for a 'Monoid'.\n--\n-- Unlike the default definition of 'stimes', it is defined for 0\n-- and so it should be preferred where possible.\nstimesMonoid :: (Integral b, Monoid a) => b -> a -> a\nstimesMonoid n x0 = case compare n 0 of\n  LT -> errorWithoutStackTrace \"stimesMonoid: negative multiplier\"\n  EQ -> mempty\n  GT -> f x0 n\n    where\n      f x y\n        | even y = f (x `mappend` x) (y `quot` 2)\n        | y == 1 = x\n        | otherwise = g (x `mappend` x) (y `quot` 2) x               -- See Note [Half of y - 1]\n      g x y z\n        | even y = g (x `mappend` x) (y `quot` 2) z\n        | y == 1 = x `mappend` z\n        | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z) -- See Note [Half of y - 1]\n\n-- this is used by the class definitionin GHC.Base;\n-- it lives here to avoid cycles\nstimesDefault :: (Integral b, Semigroup a) => b -> a -> a\nstimesDefault y0 x0\n  | y0 <= 0   = errorWithoutStackTrace \"stimes: positive multiplier expected\"\n  | otherwise = f x0 y0\n  where\n    f x y\n      | even y = f (x <> x) (y `quot` 2)\n      | y == 1 = x\n      | otherwise = g (x <> x) (y `quot` 2) x        -- See Note [Half of y - 1]\n    g x y z\n      | even y = g (x <> x) (y `quot` 2) z\n      | y == 1 = x <> z\n      | otherwise = g (x <> x) (y `quot` 2) (x <> z) -- See Note [Half of y - 1]\n\n{- Note [Half of y - 1]\n   ~~~~~~~~~~~~~~~~~~~~~\n   Since y is guaranteed to be odd and positive here,\n   half of y - 1 can be computed as y `quot` 2, optimising subtraction away.\n-}\n\nstimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a\nstimesMaybe _ Nothing = Nothing\nstimesMaybe n (Just a) = case compare n 0 of\n    LT -> errorWithoutStackTrace \"stimes: Maybe, negative multiplier\"\n    EQ -> Nothing\n    GT -> Just (stimes n a)\n\nstimesList  :: Integral b => b -> [a] -> [a]\nstimesList n x\n  | n < 0 = errorWithoutStackTrace \"stimes: [], negative multiplier\"\n  | otherwise = rep n\n  where\n    rep 0 = []\n    rep i = x ++ rep (i - 1)\n\n-- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'.\n--\n-- >>> getDual (mappend (Dual \"Hello\") (Dual \"World\"))\n-- \"WorldHello\"\nnewtype Dual a = Dual { getDual :: a }\n        deriving ( Eq       -- ^ @since 2.01\n                 , Ord      -- ^ @since 2.01\n                 , Read     -- ^ @since 2.01\n                 , Show     -- ^ @since 2.01\n                 , Bounded  -- ^ @since 2.01\n                 , Generic  -- ^ @since 4.7.0.0\n                 , Generic1 -- ^ @since 4.7.0.0\n                 )\n\n-- | @since 4.9.0.0\ninstance Semigroup a => Semigroup (Dual a) where\n        Dual a <> Dual b = Dual (b <> a)\n        stimes n (Dual a) = Dual (stimes n a)\n\n-- | @since 2.01\ninstance Monoid a => Monoid (Dual a) where\n        mempty = Dual mempty\n\n-- | @since 4.8.0.0\ninstance Functor Dual where\n    fmap     = coerce\n\n-- | @since 4.8.0.0\ninstance Applicative Dual where\n    pure     = Dual\n    (<*>)    = coerce\n\n-- | @since 4.8.0.0\ninstance Monad Dual where\n    m >>= k  = k (getDual m)\n\n-- | The monoid of endomorphisms under composition.\n--\n-- >>> let computation = Endo (\"Hello, \" ++) <> Endo (++ \"!\")\n-- >>> appEndo computation \"Haskell\"\n-- \"Hello, Haskell!\"\nnewtype Endo a = Endo { appEndo :: a -> a }\n               deriving ( Generic -- ^ @since 4.7.0.0\n                        )\n\n-- | @since 4.9.0.0\ninstance Semigroup (Endo a) where\n        (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))\n        stimes = stimesMonoid\n\n-- | @since 2.01\ninstance Monoid (Endo a) where\n        mempty = Endo id\n\n-- | Boolean monoid under conjunction ('&&').\n--\n-- >>> getAll (All True <> mempty <> All False)\n-- False\n--\n-- >>> getAll (mconcat (map (\\x -> All (even x)) [2,4,6,7,8]))\n-- False\nnewtype All = All { getAll :: Bool }\n        deriving ( Eq      -- ^ @since 2.01\n                 , Ord     -- ^ @since 2.01\n                 , Read    -- ^ @since 2.01\n                 , Show    -- ^ @since 2.01\n                 , Bounded -- ^ @since 2.01\n                 , Generic -- ^ @since 4.7.0.0\n                 )\n\n-- | @since 4.9.0.0\ninstance Semigroup All where\n        (<>) = coerce (&&)\n        stimes = stimesIdempotentMonoid\n\n-- | @since 2.01\ninstance Monoid All where\n        mempty = All True\n\n-- | Boolean monoid under disjunction ('||').\n--\n-- >>> getAny (Any True <> mempty <> Any False)\n-- True\n--\n-- >>> getAny (mconcat (map (\\x -> Any (even x)) [2,4,6,7,8]))\n-- True\nnewtype Any = Any { getAny :: Bool }\n        deriving ( Eq      -- ^ @since 2.01\n                 , Ord     -- ^ @since 2.01\n                 , Read    -- ^ @since 2.01\n                 , Show    -- ^ @since 2.01\n                 , Bounded -- ^ @since 2.01\n                 , Generic -- ^ @since 4.7.0.0\n                 )\n\n-- | @since 4.9.0.0\ninstance Semigroup Any where\n        (<>) = coerce (||)\n        stimes = stimesIdempotentMonoid\n\n-- | @since 2.01\ninstance Monoid Any where\n        mempty = Any False\n\n-- | Monoid under addition.\n--\n-- >>> getSum (Sum 1 <> Sum 2 <> mempty)\n-- 3\nnewtype Sum a = Sum { getSum :: a }\n        deriving ( Eq       -- ^ @since 2.01\n                 , Ord      -- ^ @since 2.01\n                 , Read     -- ^ @since 2.01\n                 , Show     -- ^ @since 2.01\n                 , Bounded  -- ^ @since 2.01\n                 , Generic  -- ^ @since 4.7.0.0\n                 , Generic1 -- ^ @since 4.7.0.0\n                 , Num      -- ^ @since 4.7.0.0\n                 )\n\n-- | @since 4.9.0.0\ninstance Num a => Semigroup (Sum a) where\n        (<>) = coerce ((+) :: a -> a -> a)\n        stimes n (Sum a) = Sum (fromIntegral n * a)\n\n-- | @since 2.01\ninstance Num a => Monoid (Sum a) where\n        mempty = Sum 0\n\n-- | @since 4.8.0.0\ninstance Functor Sum where\n    fmap     = coerce\n\n-- | @since 4.8.0.0\ninstance Applicative Sum where\n    pure     = Sum\n    (<*>)    = coerce\n\n-- | @since 4.8.0.0\ninstance Monad Sum where\n    m >>= k  = k (getSum m)\n\n-- | Monoid under multiplication.\n--\n-- >>> getProduct (Product 3 <> Product 4 <> mempty)\n-- 12\nnewtype Product a = Product { getProduct :: a }\n        deriving ( Eq       -- ^ @since 2.01\n                 , Ord      -- ^ @since 2.01\n                 , Read     -- ^ @since 2.01\n                 , Show     -- ^ @since 2.01\n                 , Bounded  -- ^ @since 2.01\n                 , Generic  -- ^ @since 4.7.0.0\n                 , Generic1 -- ^ @since 4.7.0.0\n                 , Num      -- ^ @since 4.7.0.0\n                 )\n\n-- | @since 4.9.0.0\ninstance Num a => Semigroup (Product a) where\n        (<>) = coerce ((*) :: a -> a -> a)\n        stimes n (Product a) = Product (a ^ n)\n\n\n-- | @since 2.01\ninstance Num a => Monoid (Product a) where\n        mempty = Product 1\n\n-- | @since 4.8.0.0\ninstance Functor Product where\n    fmap     = coerce\n\n-- | @since 4.8.0.0\ninstance Applicative Product where\n    pure     = Product\n    (<*>)    = coerce\n\n-- | @since 4.8.0.0\ninstance Monad Product where\n    m >>= k  = k (getProduct m)\n\n\n-- | Monoid under '<|>'.\n--\n-- @since 4.8.0.0\nnewtype Alt f a = Alt {getAlt :: f a}\n  deriving ( Generic     -- ^ @since 4.8.0.0\n           , Generic1    -- ^ @since 4.8.0.0\n           , Read        -- ^ @since 4.8.0.0\n           , Show        -- ^ @since 4.8.0.0\n           , Eq          -- ^ @since 4.8.0.0\n           , Ord         -- ^ @since 4.8.0.0\n           , Num         -- ^ @since 4.8.0.0\n           , Enum        -- ^ @since 4.8.0.0\n           , Monad       -- ^ @since 4.8.0.0\n           , MonadPlus   -- ^ @since 4.8.0.0\n           , Applicative -- ^ @since 4.8.0.0\n           , Alternative -- ^ @since 4.8.0.0\n           , Functor     -- ^ @since 4.8.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Alternative f => Semigroup (Alt f a) where\n    (<>) = coerce ((<|>) :: f a -> f a -> f a)\n    stimes = stimesMonoid\n\n-- | @since 4.8.0.0\ninstance Alternative f => Monoid (Alt f a) where\n    mempty = Alt empty\n", "num_lines": 313}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.STRef.Lazy\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (uses Control.Monad.ST.Lazy)\n--\n-- Mutable references in the lazy ST monad.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.STRef.Lazy (\n        -- * STRefs\n        ST.STRef,       -- abstract\n        newSTRef,\n        readSTRef,\n        writeSTRef,\n        modifySTRef\n ) where\n\nimport Control.Monad.ST.Lazy\nimport qualified Data.STRef as ST\n\nnewSTRef    :: a -> ST s (ST.STRef s a)\nreadSTRef   :: ST.STRef s a -> ST s a\nwriteSTRef  :: ST.STRef s a -> a -> ST s ()\nmodifySTRef :: ST.STRef s a -> (a -> a) -> ST s ()\n\nnewSTRef        = strictToLazyST . ST.newSTRef\nreadSTRef       = strictToLazyST . ST.readSTRef\nwriteSTRef  r a = strictToLazyST (ST.writeSTRef r a)\nmodifySTRef r f = strictToLazyST (ST.modifySTRef r f)\n\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.STRef.Strict\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (uses Control.Monad.ST.Strict)\n--\n-- Mutable references in the (strict) ST monad (re-export of \"Data.STRef\")\n--\n-----------------------------------------------------------------------------\n\nmodule Data.STRef.Strict (\n        module Data.STRef\n  ) where\n\nimport Data.STRef\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies, Safe, PolyKinds #-}\n{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Type.Bool\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  not portable\n--\n-- Basic operations on type-level Booleans.\n--\n-- @since 4.7.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Type.Bool (\n  If, type (&&), type (||), Not\n  ) where\n\nimport Data.Bool\n\n-- This needs to be in base because (&&) is used in Data.Type.Equality.\n-- The other functions do not need to be in base, but seemed to be appropriate\n-- here.\n\n-- | Type-level \"If\". @If True a b@ ==> @a@; @If False a b@ ==> @b@\ntype family If cond tru fls where\n  If 'True  tru  fls = tru\n  If 'False tru  fls = fls\n\n-- | Type-level \"and\"\ntype family a && b where\n  'False && a      = 'False\n  'True  && a      = a\n  a      && 'False = 'False\n  a      && 'True  = a\n  a      && a      = a\ninfixr 3 &&\n\n-- | Type-level \"or\"\ntype family a || b where\n  'False || a      = a\n  'True  || a      = 'True\n  a      || 'False = a\n  a      || 'True  = 'True\n  a      || a      = a\ninfixr 2 ||\n\n-- | Type-level \"not\". An injective type family since @4.10.0.0@.\n--\n-- @since 4.7.0.0\ntype family Not a = res | res -> a where\n  Not 'False = 'True\n  Not 'True  = 'False\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric       #-}\n{-# LANGUAGE TypeOperators       #-}\n{-# LANGUAGE TypeFamilies        #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs               #-}\n{-# LANGUAGE FlexibleInstances   #-}\n{-# LANGUAGE StandaloneDeriving  #-}\n{-# LANGUAGE NoImplicitPrelude   #-}\n{-# LANGUAGE PolyKinds           #-}\n{-# LANGUAGE RankNTypes          #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Type.Coercion\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  not portable\n--\n-- Definition of representational equality ('Coercion').\n--\n-- @since 4.7.0.0\n-----------------------------------------------------------------------------\n\nmodule Data.Type.Coercion\n  ( Coercion(..)\n  , coerceWith\n  , gcoerceWith\n  , sym\n  , trans\n  , repr\n  , TestCoercion(..)\n  ) where\n\nimport qualified Data.Type.Equality as Eq\nimport Data.Maybe\nimport GHC.Enum\nimport GHC.Show\nimport GHC.Read\nimport GHC.Base\n\n-- | Representational equality. If @Coercion a b@ is inhabited by some terminating\n-- value, then the type @a@ has the same underlying representation as the type @b@.\n--\n-- To use this equality in practice, pattern-match on the @Coercion a b@ to get out\n-- the @Coercible a b@ instance, and then use 'coerce' to apply it.\n--\n-- @since 4.7.0.0\ndata Coercion a b where\n  Coercion :: Coercible a b => Coercion a b\n\n-- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van\n-- Steenbergen for 'type-equality', Edward Kmett for 'eq', and Gabor Greif\n-- for 'type-eq'\n\n-- | Type-safe cast, using representational equality\ncoerceWith :: Coercion a b -> a -> b\ncoerceWith Coercion x = coerce x\n\n-- | Generalized form of type-safe cast using representational equality\n--\n-- @since 4.10.0.0\ngcoerceWith :: Coercion a b -> (Coercible a b => r) -> r\ngcoerceWith Coercion x = x\n\n-- | Symmetry of representational equality\nsym :: Coercion a b -> Coercion b a\nsym Coercion = Coercion\n\n-- | Transitivity of representational equality\ntrans :: Coercion a b -> Coercion b c -> Coercion a c\ntrans Coercion Coercion = Coercion\n\n-- | Convert propositional (nominal) equality to representational equality\nrepr :: (a Eq.:~: b) -> Coercion a b\nrepr Eq.Refl = Coercion\n\n-- | @since 4.7.0.0\nderiving instance Eq   (Coercion a b)\n\n-- | @since 4.7.0.0\nderiving instance Show (Coercion a b)\n\n-- | @since 4.7.0.0\nderiving instance Ord  (Coercion a b)\n\n-- | @since 4.7.0.0\nderiving instance Coercible a b => Read (Coercion a b)\n\n-- | @since 4.7.0.0\ninstance Coercible a b => Enum (Coercion a b) where\n  toEnum 0 = Coercion\n  toEnum _ = errorWithoutStackTrace \"Data.Type.Coercion.toEnum: bad argument\"\n\n  fromEnum Coercion = 0\n\n-- | @since 4.7.0.0\nderiving instance Coercible a b => Bounded (Coercion a b)\n\n-- | This class contains types where you can learn the equality of two types\n-- from information contained in /terms/. Typically, only singleton types should\n-- inhabit this class.\nclass TestCoercion f where\n  -- | Conditionally prove the representational equality of @a@ and @b@.\n  testCoercion :: f a -> f b -> Maybe (Coercion a b)\n\n-- | @since 4.7.0.0\ninstance TestCoercion ((Eq.:~:) a) where\n  testCoercion Eq.Refl Eq.Refl = Just Coercion\n\n-- | @since 4.10.0.0\ninstance TestCoercion ((Eq.:~~:) a) where\n  testCoercion Eq.HRefl Eq.HRefl = Just Coercion\n\n-- | @since 4.7.0.0\ninstance TestCoercion (Coercion a) where\n  testCoercion Coercion Coercion = Just Coercion\n", "num_lines": 119}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric          #-}\n{-# LANGUAGE TypeOperators          #-}\n{-# LANGUAGE GADTs                  #-}\n{-# LANGUAGE FlexibleInstances      #-}\n{-# LANGUAGE StandaloneDeriving     #-}\n{-# LANGUAGE NoImplicitPrelude      #-}\n{-# LANGUAGE RankNTypes             #-}\n{-# LANGUAGE TypeFamilies           #-}\n{-# LANGUAGE UndecidableInstances   #-}\n{-# LANGUAGE ExplicitNamespaces     #-}\n{-# LANGUAGE MultiParamTypeClasses  #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE DataKinds              #-}\n{-# LANGUAGE PolyKinds              #-}\n{-# LANGUAGE Trustworthy            #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Type.Equality\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  not portable\n--\n-- Definition of propositional equality @(':~:')@. Pattern-matching on a variable\n-- of type @(a ':~:' b)@ produces a proof that @a '~' b@.\n--\n-- @since 4.7.0.0\n-----------------------------------------------------------------------------\n\n\n\nmodule Data.Type.Equality (\n  -- * The equality types\n  (:~:)(..), type (~~),\n  (:~~:)(..),\n\n  -- * Working with equality\n  sym, trans, castWith, gcastWith, apply, inner, outer,\n\n  -- * Inferring equality from other types\n  TestEquality(..),\n\n  -- * Boolean type-level equality\n  type (==)\n  ) where\n\nimport Data.Maybe\nimport GHC.Enum\nimport GHC.Show\nimport GHC.Read\nimport GHC.Base\nimport Data.Type.Bool\n\ninfix 4 :~:, :~~:\n\n-- | Propositional equality. If @a :~: b@ is inhabited by some terminating\n-- value, then the type @a@ is the same as the type @b@. To use this equality\n-- in practice, pattern-match on the @a :~: b@ to get out the @Refl@ constructor;\n-- in the body of the pattern-match, the compiler knows that @a ~ b@.\n--\n-- @since 4.7.0.0\ndata a :~: b where  -- See Note [The equality types story] in TysPrim\n  Refl :: a :~: a\n\n-- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van\n-- Steenbergen for 'type-equality', Edward Kmett for 'eq', and Gabor Greif\n-- for 'type-eq'\n\n-- | Symmetry of equality\nsym :: (a :~: b) -> (b :~: a)\nsym Refl = Refl\n\n-- | Transitivity of equality\ntrans :: (a :~: b) -> (b :~: c) -> (a :~: c)\ntrans Refl Refl = Refl\n\n-- | Type-safe cast, using propositional equality\ncastWith :: (a :~: b) -> a -> b\ncastWith Refl x = x\n\n-- | Generalized form of type-safe cast using propositional equality\ngcastWith :: (a :~: b) -> ((a ~ b) => r) -> r\ngcastWith Refl x = x\n\n-- | Apply one equality to another, respectively\napply :: (f :~: g) -> (a :~: b) -> (f a :~: g b)\napply Refl Refl = Refl\n\n-- | Extract equality of the arguments from an equality of applied types\ninner :: (f a :~: g b) -> (a :~: b)\ninner Refl = Refl\n\n-- | Extract equality of type constructors from an equality of applied types\nouter :: (f a :~: g b) -> (f :~: g)\nouter Refl = Refl\n\n-- | @since 4.7.0.0\nderiving instance Eq   (a :~: b)\n\n-- | @since 4.7.0.0\nderiving instance Show (a :~: b)\n\n-- | @since 4.7.0.0\nderiving instance Ord  (a :~: b)\n\n-- | @since 4.7.0.0\nderiving instance a ~ b => Read (a :~: b)\n\n-- | @since 4.7.0.0\ninstance a ~ b => Enum (a :~: b) where\n  toEnum 0 = Refl\n  toEnum _ = errorWithoutStackTrace \"Data.Type.Equality.toEnum: bad argument\"\n\n  fromEnum Refl = 0\n\n-- | @since 4.7.0.0\nderiving instance a ~ b => Bounded (a :~: b)\n\n-- | Kind heterogeneous propositional equality. Like ':~:', @a :~~: b@ is\n-- inhabited by a terminating value if and only if @a@ is the same type as @b@.\n--\n-- @since 4.10.0.0\ndata (a :: k1) :~~: (b :: k2) where\n   HRefl :: a :~~: a\n\n-- | @since 4.10.0.0\nderiving instance Eq   (a :~~: b)\n-- | @since 4.10.0.0\nderiving instance Show (a :~~: b)\n-- | @since 4.10.0.0\nderiving instance Ord  (a :~~: b)\n\n-- | @since 4.10.0.0\nderiving instance a ~~ b => Read (a :~~: b)\n\n-- | @since 4.10.0.0\ninstance a ~~ b => Enum (a :~~: b) where\n  toEnum 0 = HRefl\n  toEnum _ = errorWithoutStackTrace \"Data.Type.Equality.toEnum: bad argument\"\n\n  fromEnum HRefl = 0\n\n-- | @since 4.10.0.0\nderiving instance a ~~ b => Bounded (a :~~: b)\n\n-- | This class contains types where you can learn the equality of two types\n-- from information contained in /terms/. Typically, only singleton types should\n-- inhabit this class.\nclass TestEquality f where\n  -- | Conditionally prove the equality of @a@ and @b@.\n  testEquality :: f a -> f b -> Maybe (a :~: b)\n\n-- | @since 4.7.0.0\ninstance TestEquality ((:~:) a) where\n  testEquality Refl Refl = Just Refl\n\n-- | @since 4.10.0.0\ninstance TestEquality ((:~~:) a) where\n  testEquality HRefl HRefl = Just Refl\n\ninfix 4 ==\n\n-- | A type family to compute Boolean equality.\ntype family (a :: k) == (b :: k) :: Bool where\n  f a == g b = f == g && a == b\n  a == a = 'True\n  _ == _ = 'False\n\n-- The idea here is to recognize equality of *applications* using\n-- the first case, and of *constructors* using the second and third\n-- ones. It would be wonderful if GHC recognized that the\n-- first and second cases are compatible, which would allow us to\n-- prove\n--\n-- a ~ b => a == b\n--\n-- but it (understandably) does not.\n--\n-- It is absolutely critical that the three cases occur in precisely\n-- this order. In particular, if\n--\n-- a == a = 'True\n--\n-- came first, then the type application case would only be reached\n-- (uselessly) when GHC discovered that the types were not equal.\n--\n-- One might reasonably ask what's wrong with a simpler version:\n--\n-- type family (a :: k) == (b :: k) where\n--  a == a = True\n--  a == b = False\n--\n-- Consider\n-- data Nat = Zero | Succ Nat\n--\n-- Suppose I want\n-- foo :: (Succ n == Succ m) ~ True => ((n == m) :~: True)\n-- foo = Refl\n--\n-- This would not type-check with the simple version. `Succ n == Succ m`\n-- is stuck. We don't know enough about `n` and `m` to reduce the family.\n-- With the recursive version, `Succ n == Succ m` reduces to\n-- `Succ == Succ && n == m`, which can reduce to `'True && n == m` and\n-- finally to `n == m`.\n", "num_lines": 207}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Typeable.Internal\n-- Copyright   :  (c) The University of Glasgow, CWI 2001--2011\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- The representations of the types TyCon and TypeRep, and the\n-- function mkTyCon which is used by derived instances of Typeable to\n-- construct a TyCon.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Typeable.Internal (\n    -- * Typeable and kind polymorphism\n    --\n    -- #kind_instantiation\n\n    -- * Miscellaneous\n    Fingerprint(..),\n\n    -- * Typeable class\n    Typeable(..),\n    withTypeable,\n\n    -- * Module\n    Module,  -- Abstract\n    moduleName, modulePackage, rnfModule,\n\n    -- * TyCon\n    TyCon,   -- Abstract\n    tyConPackage, tyConModule, tyConName, tyConKindArgs, tyConKindRep,\n    tyConFingerprint,\n    KindRep(.., KindRepTypeLit), TypeLitSort(..),\n    rnfTyCon,\n\n    -- * TypeRep\n    TypeRep,\n    pattern App, pattern Con, pattern Con', pattern Fun,\n    typeRep,\n    typeOf,\n    typeRepTyCon,\n    typeRepFingerprint,\n    rnfTypeRep,\n    eqTypeRep,\n    typeRepKind,\n    splitApps,\n\n    -- * SomeTypeRep\n    SomeTypeRep(..),\n    someTypeRep,\n    someTypeRepTyCon,\n    someTypeRepFingerprint,\n    rnfSomeTypeRep,\n\n    -- * Construction\n    -- | These are for internal use only\n    mkTrType, mkTrCon, mkTrApp, mkTrAppChecked, mkTrFun,\n    mkTyCon, mkTyCon#,\n    typeSymbolTypeRep, typeNatTypeRep,\n  ) where\n\nimport GHC.Base\nimport qualified GHC.Arr as A\nimport GHC.Types ( TYPE )\nimport Data.Type.Equality\nimport GHC.List ( splitAt, foldl', elem )\nimport GHC.Word\nimport GHC.Show\nimport GHC.TypeLits ( KnownSymbol, symbolVal', AppendSymbol )\nimport GHC.TypeNats ( KnownNat, natVal' )\nimport Unsafe.Coerce ( unsafeCoerce )\n\nimport GHC.Fingerprint.Type\nimport {-# SOURCE #-} GHC.Fingerprint\n   -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable\n   -- Better to break the loop here, because we want non-SOURCE imports\n   -- of Data.Typeable as much as possible so we can optimise the derived\n   -- instances.\n-- import {-# SOURCE #-} Debug.Trace (trace)\n\n#include \"MachDeps.h\"\n\n{- *********************************************************************\n*                                                                      *\n                The TyCon type\n*                                                                      *\n********************************************************************* -}\n\nmodulePackage :: Module -> String\nmodulePackage (Module p _) = trNameString p\n\nmoduleName :: Module -> String\nmoduleName (Module _ m) = trNameString m\n\ntyConPackage :: TyCon -> String\ntyConPackage (TyCon _ _ m _ _ _) = modulePackage m\n\ntyConModule :: TyCon -> String\ntyConModule (TyCon _ _ m _ _ _) = moduleName m\n\ntyConName :: TyCon -> String\ntyConName (TyCon _ _ _ n _ _) = trNameString n\n\ntrNameString :: TrName -> String\ntrNameString (TrNameS s) = unpackCStringUtf8# s\ntrNameString (TrNameD s) = s\n\ntyConFingerprint :: TyCon -> Fingerprint\ntyConFingerprint (TyCon hi lo _ _ _ _)\n  = Fingerprint (W64# hi) (W64# lo)\n\ntyConKindArgs :: TyCon -> Int\ntyConKindArgs (TyCon _ _ _ _ n _) = I# n\n\ntyConKindRep :: TyCon -> KindRep\ntyConKindRep (TyCon _ _ _ _ _ k) = k\n\n-- | Helper to fully evaluate 'TyCon' for use as @NFData(rnf)@ implementation\n--\n-- @since 4.8.0.0\nrnfModule :: Module -> ()\nrnfModule (Module p m) = rnfTrName p `seq` rnfTrName m\n\nrnfTrName :: TrName -> ()\nrnfTrName (TrNameS _) = ()\nrnfTrName (TrNameD n) = rnfString n\n\nrnfKindRep :: KindRep -> ()\nrnfKindRep (KindRepTyConApp tc args) = rnfTyCon tc `seq` rnfList rnfKindRep args\nrnfKindRep (KindRepVar _)   = ()\nrnfKindRep (KindRepApp a b) = rnfKindRep a `seq` rnfKindRep b\nrnfKindRep (KindRepFun a b) = rnfKindRep a `seq` rnfKindRep b\nrnfKindRep (KindRepTYPE rr) = rnfRuntimeRep rr\nrnfKindRep (KindRepTypeLitS _ _) = ()\nrnfKindRep (KindRepTypeLitD _ t) = rnfString t\n\nrnfRuntimeRep :: RuntimeRep -> ()\nrnfRuntimeRep (VecRep !_ !_) = ()\nrnfRuntimeRep !_             = ()\n\nrnfList :: (a -> ()) -> [a] -> ()\nrnfList _     []     = ()\nrnfList force (x:xs) = force x `seq` rnfList force xs\n\nrnfString :: [Char] -> ()\nrnfString = rnfList (`seq` ())\n\nrnfTyCon :: TyCon -> ()\nrnfTyCon (TyCon _ _ m n _ k) = rnfModule m `seq` rnfTrName n `seq` rnfKindRep k\n\n\n{- *********************************************************************\n*                                                                      *\n                The TypeRep type\n*                                                                      *\n********************************************************************* -}\n\n-- | A concrete representation of a (monomorphic) type.\n-- 'TypeRep' supports reasonably efficient equality.\ndata TypeRep (a :: k) where\n    -- The TypeRep of Type. See Note [Kind caching], Wrinkle 2\n    TrType :: TypeRep Type\n    TrTyCon :: { -- See Note [TypeRep fingerprints]\n                 trTyConFingerprint :: {-# UNPACK #-} !Fingerprint\n\n                 -- The TypeRep represents the application of trTyCon\n                 -- to the kind arguments trKindVars. So for\n                 -- 'Just :: Bool -> Maybe Bool, the trTyCon will be\n                 -- 'Just and the trKindVars will be [Bool].\n               , trTyCon :: !TyCon\n               , trKindVars :: [SomeTypeRep]\n               , trTyConKind :: !(TypeRep k) }  -- See Note [Kind caching]\n            -> TypeRep (a :: k)\n\n    -- | Invariant: Saturated arrow types (e.g. things of the form @a -> b@)\n    -- are represented with @'TrFun' a b@, not @TrApp (TrApp funTyCon a) b@.\n    TrApp   :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n               { -- See Note [TypeRep fingerprints]\n                 trAppFingerprint :: {-# UNPACK #-} !Fingerprint\n\n                 -- The TypeRep represents the application of trAppFun\n                 -- to trAppArg. For Maybe Int, the trAppFun will be Maybe\n                 -- and the trAppArg will be Int.\n               , trAppFun :: !(TypeRep (a :: k1 -> k2))\n               , trAppArg :: !(TypeRep (b :: k1))\n               , trAppKind :: !(TypeRep k2) }   -- See Note [Kind caching]\n            -> TypeRep (a b)\n\n    -- | @TrFun fpr a b@ represents a function type @a -> b@. We use this for\n    -- the sake of efficiency as functions are quite ubiquitous.\n    TrFun   :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                      (a :: TYPE r1) (b :: TYPE r2).\n               { -- See Note [TypeRep fingerprints]\n                 trFunFingerprint :: {-# UNPACK #-} !Fingerprint\n\n                 -- The TypeRep represents a function from trFunArg to\n                 -- trFunRes.\n               , trFunArg :: !(TypeRep a)\n               , trFunRes :: !(TypeRep b) }\n            -> TypeRep (a -> b)\n\n{- Note [TypeRep fingerprints]\n   ~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe store a Fingerprint of each TypeRep in its constructor. This allows\nus to test whether two TypeReps are equal in constant time, rather than\nhaving to walk their full structures.\n-}\n\n{- Note [Kind caching]\n   ~~~~~~~~~~~~~~~~~~~\n\nWe cache the kind of the TypeRep in each TrTyCon and TrApp constructor.\nThis is necessary to ensure that typeRepKind (which is used, at least, in\ndeserialization and dynApply) is cheap. There are two reasons for this:\n\n1. Calculating the kind of a nest of type applications, such as\n\n  F X Y Z W   (App (App (App (App F X) Y) Z) W)\n\nis linear in the depth, which is already a bit pricy. In deserialization,\nwe build up such a nest from the inside out, so without caching, that ends\nup taking quadratic time, and calculating the KindRep of the constructor,\nF, a linear number of times. See #14254.\n\n2. Calculating the kind of a type constructor, in instantiateTypeRep,\nrequires building (allocating) a TypeRep for the kind \"from scratch\".\nThis can get pricy. When combined with point (1), we can end up with\na large amount of extra allocation deserializing very deep nests.\nSee #14337.\n\nIt is quite possible to speed up deserialization by structuring that process\nvery carefully. Unfortunately, that doesn't help dynApply or anything else\nthat may use typeRepKind. Since caching the kind isn't terribly expensive, it\nseems better to just do that and solve all the potential problems at once.\n\nThere are two things we need to be careful about when caching kinds.\n\nWrinkle 1:\n\nWe want to do it eagerly. Suppose we have\n\n  tf :: TypeRep (f :: j -> k)\n  ta :: TypeRep (a :: j)\n\nThen the cached kind of App tf ta should be eagerly evaluated to k, rather\nthan being stored as a thunk that will strip the (j ->) off of j -> k if\nand when it is forced.\n\nWrinkle 2:\n\nWe need to be able to represent TypeRep Type. This is a bit tricky because\ntypeRepKind (typeRep @Type) = typeRep @Type, so if we actually cache the\ntyperep of the kind of Type, we will have a loop. One simple way to do this\nis to make the cached kind fields lazy and allow TypeRep Type to be cyclical.\n\nBut we *do not* want TypeReps to have cyclical structure! Most importantly,\na cyclical structure cannot be stored in a compact region. Secondarily,\nusing :force in GHCi on a cyclical structure will lead to non-termination.\n\nTo avoid this trouble, we use a separate constructor for TypeRep Type.\nmkTrApp is responsible for recognizing that TYPE is being applied to\n'LiftedRep and produce trType; other functions must recognize that TrType\nrepresents an application.\n-}\n\n-- Compare keys for equality\n\n-- | @since 2.01\ninstance Eq (TypeRep a) where\n  _ == _  = True\n  {-# INLINABLE (==) #-}\n\ninstance TestEquality TypeRep where\n  a `testEquality` b\n    | Just HRefl <- eqTypeRep a b\n    = Just Refl\n    | otherwise\n    = Nothing\n  {-# INLINEABLE testEquality #-}\n\n-- | @since 4.4.0.0\ninstance Ord (TypeRep a) where\n  compare _ _ = EQ\n  {-# INLINABLE compare #-}\n\n-- | A non-indexed type representation.\ndata SomeTypeRep where\n    SomeTypeRep :: forall k (a :: k). !(TypeRep a) -> SomeTypeRep\n\ninstance Eq SomeTypeRep where\n  SomeTypeRep a == SomeTypeRep b =\n      case a `eqTypeRep` b of\n          Just _  -> True\n          Nothing -> False\n\ninstance Ord SomeTypeRep where\n  SomeTypeRep a `compare` SomeTypeRep b =\n    typeRepFingerprint a `compare` typeRepFingerprint b\n\n-- | The function type constructor.\n--\n-- For instance,\n--\n-- @\n-- typeRep \\@(Int -> Char) === Fun (typeRep \\@Int) (typeRep \\@Char)\n-- @\n--\npattern Fun :: forall k (fun :: k). ()\n            => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                      (arg :: TYPE r1) (res :: TYPE r2).\n               (k ~ Type, fun ~~ (arg -> res))\n            => TypeRep arg\n            -> TypeRep res\n            -> TypeRep fun\npattern Fun arg res <- TrFun {trFunArg = arg, trFunRes = res}\n  where Fun arg res = mkTrFun arg res\n\n-- | Observe the 'Fingerprint' of a type representation\n--\n-- @since 4.8.0.0\ntypeRepFingerprint :: TypeRep a -> Fingerprint\ntypeRepFingerprint TrType = fpTYPELiftedRep\ntypeRepFingerprint (TrTyCon {trTyConFingerprint = fpr}) = fpr\ntypeRepFingerprint (TrApp {trAppFingerprint = fpr}) = fpr\ntypeRepFingerprint (TrFun {trFunFingerprint = fpr}) = fpr\n\n-- For compiler use\nmkTrType :: TypeRep Type\nmkTrType = TrType\n\n-- | Construct a representation for a type constructor\n-- applied at a monomorphic kind.\n--\n-- Note that this is unsafe as it allows you to construct\n-- ill-kinded types.\nmkTrCon :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a\nmkTrCon tc kind_vars = TrTyCon\n    { trTyConFingerprint = fpr\n    , trTyCon = tc\n    , trKindVars = kind_vars\n    , trTyConKind = kind }\n  where\n    fpr_tc  = tyConFingerprint tc\n    fpr_kvs = map someTypeRepFingerprint kind_vars\n    fpr     = fingerprintFingerprints (fpr_tc:fpr_kvs)\n    kind    = unsafeCoerceRep $ tyConKind tc kind_vars\n\n-- The fingerprint of Type. We don't store this in the TrType\n-- constructor, so we need to build it here.\nfpTYPELiftedRep :: Fingerprint\nfpTYPELiftedRep = fingerprintFingerprints\n      [tyConFingerprint tyConTYPE, typeRepFingerprint trLiftedRep]\n-- There is absolutely nothing to gain and everything to lose\n-- by inlining the worker. The wrapper should inline anyway.\n{-# NOINLINE fpTYPELiftedRep #-}\n\ntrTYPE :: TypeRep TYPE\ntrTYPE = typeRep\n\ntrLiftedRep :: TypeRep 'LiftedRep\ntrLiftedRep = typeRep\n\n-- | Construct a representation for a type application that is\n-- NOT a saturated arrow type. This is not checked!\n\n-- Note that this is known-key to the compiler, which uses it in desugar\n-- 'Typeable' evidence.\nmkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n           TypeRep (a :: k1 -> k2)\n        -> TypeRep (b :: k1)\n        -> TypeRep (a b)\nmkTrApp a b -- See Note [Kind caching], Wrinkle 2\n  | Just HRefl <- a `eqTypeRep` trTYPE\n  , Just HRefl <- b `eqTypeRep` trLiftedRep\n  = TrType\n\n  | TrFun {trFunRes = res_kind} <- typeRepKind a\n  = TrApp\n    { trAppFingerprint = fpr\n    , trAppFun = a\n    , trAppArg = b\n    , trAppKind = res_kind }\n\n  | otherwise = error (\"Ill-kinded type application: \"\n                           ++ show (typeRepKind a))\n  where\n    fpr_a = typeRepFingerprint a\n    fpr_b = typeRepFingerprint b\n    fpr   = fingerprintFingerprints [fpr_a, fpr_b]\n\n-- | Construct a representation for a type application that\n-- may be a saturated arrow type. This is renamed to mkTrApp in\n-- Type.Reflection.Unsafe\nmkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n                  TypeRep (a :: k1 -> k2)\n               -> TypeRep (b :: k1)\n               -> TypeRep (a b)\nmkTrAppChecked rep@(TrApp {trAppFun = p, trAppArg = x :: TypeRep x})\n               (y :: TypeRep y)\n  | TrTyCon {trTyCon=con} <- p\n  , con == funTyCon  -- cheap check first\n  , Just (IsTYPE (rx :: TypeRep rx)) <- isTYPE (typeRepKind x)\n  , Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y)\n  , Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry\n                  $ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep\n  = mkTrFun x y\nmkTrAppChecked a b = mkTrApp a b\n\n-- | A type application.\n--\n-- For instance,\n--\n-- @\n-- typeRep \\@(Maybe Int) === App (typeRep \\@Maybe) (typeRep \\@Int)\n-- @\n--\n-- Note that this will also match a function type,\n--\n-- @\n-- typeRep \\@(Int# -> Char)\n--   ===\n-- App (App arrow (typeRep \\@Int#)) (typeRep \\@Char)\n-- @\n--\n-- where @arrow :: TypeRep ((->) :: TYPE IntRep -> Type -> Type)@.\n--\npattern App :: forall k2 (t :: k2). ()\n            => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b)\n            => TypeRep a -> TypeRep b -> TypeRep t\npattern App f x <- (splitApp -> IsApp f x)\n  where App f x = mkTrAppChecked f x\n\ndata AppOrCon (a :: k) where\n    IsApp :: forall k k' (f :: k' -> k) (x :: k'). ()\n          => TypeRep f -> TypeRep x -> AppOrCon (f x)\n    -- See Note [Con evidence]\n    IsCon :: IsApplication a ~ \"\" => TyCon -> [SomeTypeRep] -> AppOrCon a\n\ntype family IsApplication (x :: k) :: Symbol where\n  IsApplication (_ _) = \"An error message about this unifying with \\\"\\\" \"\n     `AppendSymbol` \"means that you tried to match a TypeRep with Con or \"\n     `AppendSymbol` \"Con' when the represented type was known to be an \"\n     `AppendSymbol` \"application.\"\n  IsApplication _ = \"\"\n\nsplitApp :: forall k (a :: k). ()\n         => TypeRep a\n         -> AppOrCon a\nsplitApp TrType = IsApp trTYPE trLiftedRep\nsplitApp (TrApp {trAppFun = f, trAppArg = x}) = IsApp f x\nsplitApp rep@(TrFun {trFunArg=a, trFunRes=b}) = IsApp (mkTrApp arr a) b\n  where arr = bareArrow rep\nsplitApp (TrTyCon{trTyCon = con, trKindVars = kinds})\n  = case unsafeCoerce Refl :: IsApplication a :~: \"\" of\n      Refl -> IsCon con kinds\n\n-- | Use a 'TypeRep' as 'Typeable' evidence.\nwithTypeable :: forall k (a :: k) rep (r :: TYPE rep). ()\n             => TypeRep a -> (Typeable a => r) -> r\nwithTypeable rep k = unsafeCoerce k' rep\n  where k' :: Gift a r\n        k' = Gift k\n\n-- | A helper to satisfy the type checker in 'withTypeable'.\nnewtype Gift a (r :: TYPE rep) = Gift (Typeable a => r)\n\n-- | Pattern match on a type constructor\npattern Con :: forall k (a :: k). ()\n            => IsApplication a ~ \"\" -- See Note [Con evidence]\n            => TyCon -> TypeRep a\npattern Con con <- (splitApp -> IsCon con _)\n\n-- | Pattern match on a type constructor including its instantiated kind\n-- variables.\n--\n-- For instance,\n--\n-- @\n-- App (Con' proxyTyCon ks) intRep = typeRep @(Proxy \\@Int)\n-- @\n--\n-- will bring into scope,\n--\n-- @\n-- proxyTyCon :: TyCon\n-- ks         == [someTypeRep @Type] :: [SomeTypeRep]\n-- intRep     == typeRep @Int\n-- @\n--\npattern Con' :: forall k (a :: k). ()\n             => IsApplication a ~ \"\" -- See Note [Con evidence]\n             => TyCon -> [SomeTypeRep] -> TypeRep a\npattern Con' con ks <- (splitApp -> IsCon con ks)\n\n-- TODO: Remove Fun when #14253 is fixed\n{-# COMPLETE Fun, App, Con  #-}\n{-# COMPLETE Fun, App, Con' #-}\n\n{- Note [Con evidence]\n    ~~~~~~~~~~~~~~~~~~~\n\nMatching TypeRep t on Con or Con' fakes up evidence that\n\n  IsApplication t ~ \"\".\n\nWhy should anyone care about the value of strange internal type family?\nWell, almost nobody cares about it, but the pattern checker does!\nFor example, suppose we have TypeRep (f x) and we want to get\nTypeRep f and TypeRep x. There is no chance that the Con constructor\nwill match, because (f x) is not a constructor, but without the\nIsApplication evidence, omitting it will lead to an incomplete pattern\nwarning. With the evidence, the pattern checker will see that\nCon wouldn't typecheck, so everything works out as it should.\n\nWhy do we use Symbols? We would really like to use something like\n\n  type family NotApplication (t :: k) :: Constraint where\n    NotApplication (f a) = TypeError ...\n    NotApplication _ = ()\n\nUnfortunately, #11503 means that the pattern checker and type checker\nwill fail to actually reject the mistaken patterns. So we describe the\nerror in the result type. It's a horrible hack.\n-}\n\n----------------- Observation ---------------------\n\n-- | Observe the type constructor of a quantified type representation.\nsomeTypeRepTyCon :: SomeTypeRep -> TyCon\nsomeTypeRepTyCon (SomeTypeRep t) = typeRepTyCon t\n\n-- | Observe the type constructor of a type representation\ntypeRepTyCon :: TypeRep a -> TyCon\ntypeRepTyCon TrType = tyConTYPE\ntypeRepTyCon (TrTyCon {trTyCon = tc}) = tc\ntypeRepTyCon (TrApp {trAppFun = a})   = typeRepTyCon a\ntypeRepTyCon (TrFun {})               = typeRepTyCon $ typeRep @(->)\n\n-- | Type equality\n--\n-- @since 4.10\neqTypeRep :: forall k1 k2 (a :: k1) (b :: k2).\n             TypeRep a -> TypeRep b -> Maybe (a :~~: b)\neqTypeRep a b\n  | sameTypeRep a b = Just (unsafeCoerce# HRefl)\n  | otherwise       = Nothing\n-- We want GHC to inline eqTypeRep to get rid of the Maybe\n-- in the usual case that it is scrutinized immediately. We\n-- split eqTypeRep into a worker and wrapper because otherwise\n-- it's much larger than anything we'd want to inline.\n{-# INLINABLE eqTypeRep #-}\n\nsameTypeRep :: forall k1 k2 (a :: k1) (b :: k2).\n               TypeRep a -> TypeRep b -> Bool\nsameTypeRep a b = typeRepFingerprint a == typeRepFingerprint b\n\n-------------------------------------------------------------\n--\n--      Computing kinds\n--\n-------------------------------------------------------------\n\n-- | Observe the kind of a type.\ntypeRepKind :: TypeRep (a :: k) -> TypeRep k\ntypeRepKind TrType = TrType\ntypeRepKind (TrTyCon {trTyConKind = kind}) = kind\ntypeRepKind (TrApp {trAppKind = kind}) = kind\ntypeRepKind (TrFun {}) = typeRep @Type\n\ntyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep\ntyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars =\n    let kindVarsArr :: A.Array KindBndr SomeTypeRep\n        kindVarsArr = A.listArray (0, I# (nKindVars# -# 1#)) kindVars\n    in instantiateKindRep kindVarsArr kindRep\n\ninstantiateKindRep :: A.Array KindBndr SomeTypeRep -> KindRep -> SomeTypeRep\ninstantiateKindRep vars = go\n  where\n    go :: KindRep -> SomeTypeRep\n    go (KindRepTyConApp tc args)\n      = let n_kind_args = tyConKindArgs tc\n            (kind_args, ty_args) = splitAt n_kind_args args\n            -- First instantiate tycon kind arguments\n            tycon_app = SomeTypeRep $ mkTrCon tc (map go kind_args)\n            -- Then apply remaining type arguments\n            applyTy :: SomeTypeRep -> KindRep -> SomeTypeRep\n            applyTy (SomeTypeRep acc) ty\n              | SomeTypeRep ty' <- go ty\n              = SomeTypeRep $ mkTrApp (unsafeCoerce acc) ty'\n        in foldl' applyTy tycon_app ty_args\n    go (KindRepVar var)\n      = vars A.! var\n    go (KindRepApp f a)\n      = SomeTypeRep $ mkTrApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a)\n    go (KindRepFun a b)\n      = SomeTypeRep $ mkTrFun (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b)\n    go (KindRepTYPE LiftedRep) = SomeTypeRep TrType\n    go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r\n    go (KindRepTypeLitS sort s)\n      = mkTypeLitFromString sort (unpackCStringUtf8# s)\n    go (KindRepTypeLitD sort s)\n      = mkTypeLitFromString sort s\n\n    tYPE = kindedTypeRep @(RuntimeRep -> Type) @TYPE\n\nunsafeCoerceRep :: SomeTypeRep -> TypeRep a\nunsafeCoerceRep (SomeTypeRep r) = unsafeCoerce r\n\nunkindedTypeRep :: SomeKindedTypeRep k -> SomeTypeRep\nunkindedTypeRep (SomeKindedTypeRep x) = SomeTypeRep x\n\ndata SomeKindedTypeRep k where\n    SomeKindedTypeRep :: forall k (a :: k). TypeRep a\n                      -> SomeKindedTypeRep k\n\nkApp :: SomeKindedTypeRep (k -> k')\n     -> SomeKindedTypeRep k\n     -> SomeKindedTypeRep k'\nkApp (SomeKindedTypeRep f) (SomeKindedTypeRep a) =\n    SomeKindedTypeRep (mkTrApp f a)\n\nkindedTypeRep :: forall k (a :: k). Typeable a => SomeKindedTypeRep k\nkindedTypeRep = SomeKindedTypeRep (typeRep @a)\n\nbuildList :: forall k. Typeable k\n          => [SomeKindedTypeRep k]\n          -> SomeKindedTypeRep [k]\nbuildList = foldr cons nil\n  where\n    nil = kindedTypeRep @[k] @'[]\n    cons x rest = SomeKindedTypeRep (typeRep @'(:)) `kApp` x `kApp` rest\n\nruntimeRepTypeRep :: RuntimeRep -> SomeKindedTypeRep RuntimeRep\nruntimeRepTypeRep r =\n    case r of\n      LiftedRep   -> rep @'LiftedRep\n      UnliftedRep -> rep @'UnliftedRep\n      VecRep c e  -> kindedTypeRep @_ @'VecRep\n                     `kApp` vecCountTypeRep c\n                     `kApp` vecElemTypeRep e\n      TupleRep rs -> kindedTypeRep @_ @'TupleRep\n                     `kApp` buildList (map runtimeRepTypeRep rs)\n      SumRep rs   -> kindedTypeRep @_ @'SumRep\n                     `kApp` buildList (map runtimeRepTypeRep rs)\n      IntRep      -> rep @'IntRep\n      Int8Rep     -> rep @'Int8Rep\n      Int16Rep    -> rep @'Int16Rep\n      Int64Rep    -> rep @'Int64Rep\n      WordRep     -> rep @'WordRep\n      Word8Rep    -> rep @'Word8Rep\n      Word16Rep   -> rep @'Word16Rep\n      Word64Rep   -> rep @'Word64Rep\n      AddrRep     -> rep @'AddrRep\n      FloatRep    -> rep @'FloatRep\n      DoubleRep   -> rep @'DoubleRep\n  where\n    rep :: forall (a :: RuntimeRep). Typeable a => SomeKindedTypeRep RuntimeRep\n    rep = kindedTypeRep @RuntimeRep @a\n\nvecCountTypeRep :: VecCount -> SomeKindedTypeRep VecCount\nvecCountTypeRep c =\n    case c of\n      Vec2  -> rep @'Vec2\n      Vec4  -> rep @'Vec4\n      Vec8  -> rep @'Vec8\n      Vec16 -> rep @'Vec16\n      Vec32 -> rep @'Vec32\n      Vec64 -> rep @'Vec64\n  where\n    rep :: forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount\n    rep = kindedTypeRep @VecCount @a\n\nvecElemTypeRep :: VecElem -> SomeKindedTypeRep VecElem\nvecElemTypeRep e =\n    case e of\n      Int8ElemRep     -> rep @'Int8ElemRep\n      Int16ElemRep    -> rep @'Int16ElemRep\n      Int32ElemRep    -> rep @'Int32ElemRep\n      Int64ElemRep    -> rep @'Int64ElemRep\n      Word8ElemRep    -> rep @'Word8ElemRep\n      Word16ElemRep   -> rep @'Word16ElemRep\n      Word32ElemRep   -> rep @'Word32ElemRep\n      Word64ElemRep   -> rep @'Word64ElemRep\n      FloatElemRep    -> rep @'FloatElemRep\n      DoubleElemRep   -> rep @'DoubleElemRep\n  where\n    rep :: forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem\n    rep = kindedTypeRep @VecElem @a\n\nbareArrow :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                    (a :: TYPE r1) (b :: TYPE r2). ()\n          => TypeRep (a -> b)\n          -> TypeRep ((->) :: TYPE r1 -> TYPE r2 -> Type)\nbareArrow (TrFun _ a b) =\n    mkTrCon funTyCon [SomeTypeRep rep1, SomeTypeRep rep2]\n  where\n    rep1 = getRuntimeRep $ typeRepKind a :: TypeRep r1\n    rep2 = getRuntimeRep $ typeRepKind b :: TypeRep r2\nbareArrow _ = error \"Data.Typeable.Internal.bareArrow: impossible\"\n\ndata IsTYPE (a :: Type) where\n    IsTYPE :: forall (r :: RuntimeRep). TypeRep r -> IsTYPE (TYPE r)\n\n-- | Is a type of the form @TYPE rep@?\nisTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a)\nisTYPE TrType = Just (IsTYPE trLiftedRep)\nisTYPE (TrApp {trAppFun=f, trAppArg=r})\n  | Just HRefl <- f `eqTypeRep` typeRep @TYPE\n  = Just (IsTYPE r)\nisTYPE _ = Nothing\n\ngetRuntimeRep :: forall (r :: RuntimeRep). TypeRep (TYPE r) -> TypeRep r\ngetRuntimeRep TrType = trLiftedRep\ngetRuntimeRep (TrApp {trAppArg=r}) = r\ngetRuntimeRep _ = error \"Data.Typeable.Internal.getRuntimeRep: impossible\"\n\n\n-------------------------------------------------------------\n--\n--      The Typeable class and friends\n--\n-------------------------------------------------------------\n\n-- | The class 'Typeable' allows a concrete representation of a type to\n-- be calculated.\nclass Typeable (a :: k) where\n  typeRep# :: TypeRep a\n\ntypeRep :: Typeable a => TypeRep a\ntypeRep = typeRep#\n\ntypeOf :: Typeable a => a -> TypeRep a\ntypeOf _ = typeRep\n\n-- | Takes a value of type @a@ and returns a concrete representation\n-- of that type.\n--\n-- @since 4.7.0.0\nsomeTypeRep :: forall proxy a. Typeable a => proxy a -> SomeTypeRep\nsomeTypeRep _ = SomeTypeRep (typeRep :: TypeRep a)\n{-# INLINE typeRep #-}\n\nsomeTypeRepFingerprint :: SomeTypeRep -> Fingerprint\nsomeTypeRepFingerprint (SomeTypeRep t) = typeRepFingerprint t\n\n----------------- Showing TypeReps --------------------\n\n-- This follows roughly the precedence structure described in Note [Precedence\n-- in types].\ninstance Show (TypeRep (a :: k)) where\n    showsPrec = showTypeable\n\n\nshowTypeable :: Int -> TypeRep (a :: k) -> ShowS\nshowTypeable _ TrType = showChar '*'\nshowTypeable _ rep\n  | isListTyCon tc, [ty] <- tys =\n    showChar '[' . shows ty . showChar ']'\n\n    -- Take care only to render saturated tuple tycon applications\n    -- with tuple notation (#14341).\n  | isTupleTyCon tc,\n    Just _ <- TrType `eqTypeRep` typeRepKind rep =\n    showChar '(' . showArgs (showChar ',') tys . showChar ')'\n  where (tc, tys) = splitApps rep\nshowTypeable _ (TrTyCon {trTyCon = tycon, trKindVars = []})\n  = showTyCon tycon\nshowTypeable p (TrTyCon {trTyCon = tycon, trKindVars = args})\n  = showParen (p > 9) $\n    showTyCon tycon .\n    showChar ' ' .\n    showArgs (showChar ' ') args\nshowTypeable p (TrFun {trFunArg = x, trFunRes = r})\n  = showParen (p > 8) $\n    showsPrec 9 x . showString \" -> \" . showsPrec 8 r\nshowTypeable p (TrApp {trAppFun = f, trAppArg = x})\n  = showParen (p > 9) $\n    showsPrec 8 f .\n    showChar ' ' .\n    showsPrec 10 x\n\n-- | @since 4.10.0.0\ninstance Show SomeTypeRep where\n  showsPrec p (SomeTypeRep ty) = showsPrec p ty\n\nsplitApps :: TypeRep a -> (TyCon, [SomeTypeRep])\nsplitApps = go []\n  where\n    go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])\n    go xs (TrTyCon {trTyCon = tc})\n      = (tc, xs)\n    go xs (TrApp {trAppFun = f, trAppArg = x})\n      = go (SomeTypeRep x : xs) f\n    go [] (TrFun {trFunArg = a, trFunRes = b})\n      = (funTyCon, [SomeTypeRep a, SomeTypeRep b])\n    go _  (TrFun {})\n      = errorWithoutStackTrace \"Data.Typeable.Internal.splitApps: Impossible 1\"\n    go [] TrType = (tyConTYPE, [SomeTypeRep trLiftedRep])\n    go _ TrType\n      = errorWithoutStackTrace \"Data.Typeable.Internal.splitApps: Impossible 2\"\n\n-- This is incredibly shady! We don't really want to do this here; we\n-- should really have the compiler reveal the TYPE TyCon directly\n-- somehow. We need to construct this by hand because otherwise\n-- we end up with horrible and somewhat mysterious loops trying to calculate\n-- typeRep @TYPE. For the moment, we use the fact that we can get the proper\n-- name of the ghc-prim package from the TyCon of LiftedRep (which we can\n-- produce a TypeRep for without difficulty), and then just substitute in the\n-- appropriate module and constructor names.\n--\n-- The ticket to find a better way to deal with this is\n-- Trac #14480.\ntyConTYPE :: TyCon\ntyConTYPE = mkTyCon (tyConPackage liftedRepTyCon) \"GHC.Prim\" \"TYPE\" 0\n       (KindRepFun (KindRepTyConApp liftedRepTyCon []) (KindRepTYPE LiftedRep))\n  where\n    liftedRepTyCon = typeRepTyCon (typeRep @RuntimeRep)\n\nfunTyCon :: TyCon\nfunTyCon = typeRepTyCon (typeRep @(->))\n\nisListTyCon :: TyCon -> Bool\nisListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [])\n\nisTupleTyCon :: TyCon -> Bool\nisTupleTyCon tc\n  | ('(':',':_) <- tyConName tc = True\n  | otherwise                   = False\n\n-- This is only an approximation. We don't have the general\n-- character-classification machinery here, so we just do our best.\n-- This should work for promoted Haskell 98 data constructors and\n-- for TypeOperators type constructors that begin with ASCII\n-- characters, but it will miss Unicode operators.\n--\n-- If we wanted to catch Unicode as well, we ought to consider moving\n-- GHC.Lexeme from ghc-boot-th to base. Then we could just say:\n--\n--   startsVarSym symb || startsConSym symb\n--\n-- But this is a fair deal of work just for one corner case, so I think I'll\n-- leave it like this unless someone shouts.\nisOperatorTyCon :: TyCon -> Bool\nisOperatorTyCon tc\n  | symb : _ <- tyConName tc\n  , symb `elem` \"!#$%&*+./<=>?@\\\\^|-~:\" = True\n  | otherwise                           = False\n\nshowTyCon :: TyCon -> ShowS\nshowTyCon tycon = showParen (isOperatorTyCon tycon) (shows tycon)\n\nshowArgs :: Show a => ShowS -> [a] -> ShowS\nshowArgs _   []     = id\nshowArgs _   [a]    = showsPrec 10 a\nshowArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as\n\n-- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation\n--\n-- @since 4.8.0.0\nrnfTypeRep :: TypeRep a -> ()\n-- The TypeRep structure is almost entirely strict by definition. The\n-- fingerprinting and strict kind caching ensure that everything\n-- else is forced anyway. So we don't need to do anything special\n-- to reduce to normal form.\nrnfTypeRep !_ = ()\n\n-- | Helper to fully evaluate 'SomeTypeRep' for use as @NFData(rnf)@\n-- implementation\n--\n-- @since 4.10.0.0\nrnfSomeTypeRep :: SomeTypeRep -> ()\nrnfSomeTypeRep (SomeTypeRep r) = rnfTypeRep r\n\n{- *********************************************************\n*                                                          *\n*       TyCon/TypeRep definitions for type literals        *\n*              (Symbol and Nat)                            *\n*                                                          *\n********************************************************* -}\n\npattern KindRepTypeLit :: TypeLitSort -> String -> KindRep\npattern KindRepTypeLit sort t <- (getKindRepTypeLit -> Just (sort, t))\n  where\n    KindRepTypeLit sort t = KindRepTypeLitD sort t\n\n{-# COMPLETE KindRepTyConApp, KindRepVar, KindRepApp, KindRepFun,\n             KindRepTYPE, KindRepTypeLit #-}\n\ngetKindRepTypeLit :: KindRep -> Maybe (TypeLitSort, String)\ngetKindRepTypeLit (KindRepTypeLitS sort t) = Just (sort, unpackCStringUtf8# t)\ngetKindRepTypeLit (KindRepTypeLitD sort t) = Just (sort, t)\ngetKindRepTypeLit _                        = Nothing\n\n-- | Exquisitely unsafe.\nmkTyCon# :: Addr#       -- ^ package name\n         -> Addr#       -- ^ module name\n         -> Addr#       -- ^ the name of the type constructor\n         -> Int#        -- ^ number of kind variables\n         -> KindRep     -- ^ kind representation\n         -> TyCon       -- ^ A unique 'TyCon' object\nmkTyCon# pkg modl name n_kinds kind_rep\n  | Fingerprint (W64# hi) (W64# lo) <- fingerprint\n  = TyCon hi lo mod (TrNameS name) n_kinds kind_rep\n  where\n    mod = Module (TrNameS pkg) (TrNameS modl)\n    fingerprint :: Fingerprint\n    fingerprint = mkTyConFingerprint (unpackCStringUtf8# pkg)\n                                     (unpackCStringUtf8# modl)\n                                     (unpackCStringUtf8# name)\n\n-- it is extremely important that this fingerprint computation\n-- remains in sync with that in TcTypeable to ensure that type\n-- equality is correct.\n\n-- | Exquisitely unsafe.\nmkTyCon :: String       -- ^ package name\n        -> String       -- ^ module name\n        -> String       -- ^ the name of the type constructor\n        -> Int         -- ^ number of kind variables\n        -> KindRep     -- ^ kind representation\n        -> TyCon        -- ^ A unique 'TyCon' object\n-- Used when the strings are dynamically allocated,\n-- eg from binary deserialisation\nmkTyCon pkg modl name (I# n_kinds) kind_rep\n  | Fingerprint (W64# hi) (W64# lo) <- fingerprint\n  = TyCon hi lo mod (TrNameD name) n_kinds kind_rep\n  where\n    mod = Module (TrNameD pkg) (TrNameD modl)\n    fingerprint :: Fingerprint\n    fingerprint = mkTyConFingerprint pkg modl name\n\n-- This must match the computation done in TcTypeable.mkTyConRepTyConRHS.\nmkTyConFingerprint :: String -- ^ package name\n                   -> String -- ^ module name\n                   -> String -- ^ tycon name\n                   -> Fingerprint\nmkTyConFingerprint pkg_name mod_name tycon_name =\n        fingerprintFingerprints\n        [ fingerprintString pkg_name\n        , fingerprintString mod_name\n        , fingerprintString tycon_name\n        ]\n\nmkTypeLitTyCon :: String -> TyCon -> TyCon\nmkTypeLitTyCon name kind_tycon\n  = mkTyCon \"base\" \"GHC.TypeLits\" name 0 kind\n  where kind = KindRepTyConApp kind_tycon []\n\n-- | Used to make `'Typeable' instance for things of kind Nat\ntypeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep a\ntypeNatTypeRep p = typeLitTypeRep (show (natVal' p)) tcNat\n\n-- | Used to make `'Typeable' instance for things of kind Symbol\ntypeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a\ntypeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p)) tcSymbol\n\nmkTypeLitFromString :: TypeLitSort -> String -> SomeTypeRep\nmkTypeLitFromString TypeLitSymbol s =\n    SomeTypeRep $ (typeLitTypeRep s tcSymbol :: TypeRep Symbol)\nmkTypeLitFromString TypeLitNat s =\n    SomeTypeRep $ (typeLitTypeRep s tcSymbol :: TypeRep Nat)\n\ntcSymbol :: TyCon\ntcSymbol = typeRepTyCon (typeRep @Symbol)\n\ntcNat :: TyCon\ntcNat = typeRepTyCon (typeRep @Nat)\n\n-- | An internal function, to make representations for type literals.\ntypeLitTypeRep :: forall k (a :: k). (Typeable k) =>\n                  String -> TyCon -> TypeRep a\ntypeLitTypeRep nm kind_tycon = mkTrCon (mkTypeLitTyCon nm kind_tycon) []\n\n-- | For compiler use.\nmkTrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                  (a :: TYPE r1) (b :: TYPE r2).\n           TypeRep a -> TypeRep b -> TypeRep ((a -> b) :: Type)\nmkTrFun arg res = TrFun\n    { trFunFingerprint = fpr\n    , trFunArg = arg\n    , trFunRes = res }\n  where fpr = fingerprintFingerprints [ typeRepFingerprint arg\n                                      , typeRepFingerprint res]\n\n{- $kind_instantiation\n\nConsider a type like 'Data.Proxy.Proxy',\n\n@\ndata Proxy :: forall k. k -> Type\n@\n\nOne might think that one could decompose an instantiation of this type like\n@Proxy Int@ into two applications,\n\n@\n'App' (App a b) c === typeRep @(Proxy Int)\n@\n\nwhere,\n\n@\na = typeRep @Proxy\nb = typeRep @Type\nc = typeRep @Int\n@\n\nHowever, this isn't the case. Instead we can only decompose into an application\nand a constructor,\n\n@\n'App' ('Con' proxyTyCon) (typeRep @Int) === typeRep @(Proxy Int)\n@\n\nThe reason for this is that 'Typeable' can only represent /kind-monomorphic/\ntypes. That is, we must saturate enough of @Proxy@\\'s arguments to\nfully determine its kind. In the particular case of @Proxy@ this means we must\ninstantiate the kind variable @k@ such that no @forall@-quantified variables\nremain.\n\nWhile it is not possible to decompose the 'Con' above into an application, it is\npossible to observe the kind variable instantiations of the constructor with the\n'Con\\'' pattern,\n\n@\n'App' (Con' proxyTyCon kinds) _ === typeRep @(Proxy Int)\n@\n\nHere @kinds@ will be @[typeRep \\@Type]@.\n\n-}\n", "num_lines": 1053}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Debug.Trace\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Functions for tracing and monitoring execution.\n--\n-- These can be useful for investigating bugs or performance problems.\n-- They should /not/ be used in production code.\n--\n-----------------------------------------------------------------------------\n\nmodule Debug.Trace (\n        -- * Tracing\n        -- $tracing\n        trace,\n        traceId,\n        traceShow,\n        traceShowId,\n        traceStack,\n        traceIO,\n        traceM,\n        traceShowM,\n        putTraceMsg,\n\n        -- * Eventlog tracing\n        -- $eventlog_tracing\n        traceEvent,\n        traceEventIO,\n\n        -- * Execution phase markers\n        -- $markers\n        traceMarker,\n        traceMarkerIO,\n  ) where\n\nimport System.IO.Unsafe\n\nimport Foreign.C.String\nimport GHC.Base\nimport qualified GHC.Foreign\nimport GHC.IO.Encoding\nimport GHC.Ptr\nimport GHC.Show\nimport GHC.Stack\nimport Data.List\n\n-- $setup\n-- >>> import Prelude\n\n-- $tracing\n--\n-- The 'trace', 'traceShow' and 'traceIO' functions print messages to an output\n-- stream. They are intended for \\\"printf debugging\\\", that is: tracing the flow\n-- of execution and printing interesting values.\n--\n-- All these functions evaluate the message completely before printing\n-- it; so if the message is not fully defined, none of it will be\n-- printed.\n--\n-- The usual output stream is 'System.IO.stderr'. For Windows GUI applications\n-- (that have no stderr) the output is directed to the Windows debug console.\n-- Some implementations of these functions may decorate the string that\\'s\n-- output to indicate that you\\'re tracing.\n\n-- | The 'traceIO' function outputs the trace message from the IO monad.\n-- This sequences the output with respect to other IO actions.\n--\n-- @since 4.5.0.0\ntraceIO :: String -> IO ()\ntraceIO msg = do\n    withCString \"%s\\n\" $ \\cfmt -> do\n     -- NB: debugBelch can't deal with null bytes, so filter them\n     -- out so we don't accidentally truncate the message.  See Trac #9395\n     let (nulls, msg') = partition (=='\\0') msg\n     withCString msg' $ \\cmsg ->\n      debugBelch cfmt cmsg\n     when (not (null nulls)) $\n       withCString \"WARNING: previous trace message had null bytes\" $ \\cmsg ->\n         debugBelch cfmt cmsg\n\n-- don't use debugBelch() directly, because we cannot call varargs functions\n-- using the FFI.\nforeign import ccall unsafe \"HsBase.h debugBelch2\"\n   debugBelch :: CString -> CString -> IO ()\n\n-- |\nputTraceMsg :: String -> IO ()\nputTraceMsg = traceIO\n{-# DEPRECATED putTraceMsg \"Use 'Debug.Trace.traceIO'\" #-} -- deprecated in 7.4\n\n\n{-# NOINLINE trace #-}\n{-|\nThe 'trace' function outputs the trace message given as its first argument,\nbefore returning the second argument as its result.\n\nFor example, this returns the value of @f x@ but first outputs the message.\n\n>>> let x = 123; f = show\n>>> trace (\"calling f with x = \" ++ show x) (f x)\n\"calling f with x = 123\n123\"\n\nThe 'trace' function should /only/ be used for debugging, or for monitoring\nexecution. The function is not referentially transparent: its type indicates\nthat it is a pure function but it has the side effect of outputting the\ntrace message.\n-}\ntrace :: String -> a -> a\ntrace string expr = unsafePerformIO $ do\n    traceIO string\n    return expr\n\n{-|\nLike 'trace' but returns the message instead of a third value.\n\n>>> traceId \"hello\"\n\"hello\nhello\"\n\n@since 4.7.0.0\n-}\ntraceId :: String -> String\ntraceId a = trace a a\n\n{-|\nLike 'trace', but uses 'show' on the argument to convert it to a 'String'.\n\nThis makes it convenient for printing the values of interesting variables or\nexpressions inside a function. For example here we print the value of the\nvariables @x@ and @y@:\n\n>>> let f x y = traceShow (x,y) (x + y) in f (1+2) 5\n(3,5)\n8\n\n-}\ntraceShow :: Show a => a -> b -> b\ntraceShow = trace . show\n\n{-|\nLike 'traceShow' but returns the shown value instead of a third value.\n\n>>> traceShowId (1+2+3, \"hello\" ++ \"world\")\n(6,\"helloworld\")\n(6,\"helloworld\")\n\n@since 4.7.0.0\n-}\ntraceShowId :: Show a => a -> a\ntraceShowId a = trace (show a) a\n\n{-|\nLike 'trace' but returning unit in an arbitrary 'Applicative' context. Allows\nfor convenient use in do-notation.\n\nNote that the application of 'traceM' is not an action in the 'Applicative'\ncontext, as 'traceIO' is in the 'IO' type. While the fresh bindings in the\nfollowing example will force the 'traceM' expressions to be reduced every time\nthe @do@-block is executed, @traceM \"not crashed\"@ would only be reduced once,\nand the message would only be printed once.  If your monad is in\n'Control.Monad.IO.Class.MonadIO', @'Control.Monad.IO.Class.liftIO' . 'traceIO'@\nmay be a better option.\n\n>>> :{\ndo\n    x <- Just 3\n    traceM (\"x: \" ++ show x)\n    y <- pure 12\n    traceM (\"y: \" ++ show y)\n    pure (x*2 + y)\n:}\nx: 3\ny: 12\nJust 18\n\n@since 4.7.0.0\n-}\ntraceM :: Applicative f => String -> f ()\ntraceM string = trace string $ pure ()\n\n{-|\nLike 'traceM', but uses 'show' on the argument to convert it to a 'String'.\n\n>>> :{\ndo\n    x <- Just 3\n    traceShowM x\n    y <- pure 12\n    traceShowM y\n    pure (x*2 + y)\n:}\n3\n12\nJust 18\n\n@since 4.7.0.0\n-}\ntraceShowM :: (Show a, Applicative f) => a -> f ()\ntraceShowM = traceM . show\n\n-- | like 'trace', but additionally prints a call stack if one is\n-- available.\n--\n-- In the current GHC implementation, the call stack is only\n-- available if the program was compiled with @-prof@; otherwise\n-- 'traceStack' behaves exactly like 'trace'.  Entries in the call\n-- stack correspond to @SCC@ annotations, so it is a good idea to use\n-- @-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically.\n--\n-- @since 4.5.0.0\ntraceStack :: String -> a -> a\ntraceStack str expr = unsafePerformIO $ do\n   traceIO str\n   stack <- currentCallStack\n   when (not (null stack)) $ traceIO (renderStack stack)\n   return expr\n\n\n-- $eventlog_tracing\n--\n-- Eventlog tracing is a performance profiling system. These functions emit\n-- extra events into the eventlog. In combination with eventlog profiling\n-- tools these functions can be used for monitoring execution and\n-- investigating performance problems.\n--\n-- Currently only GHC provides eventlog profiling, see the GHC user guide for\n-- details on how to use it. These function exists for other Haskell\n-- implementations but no events are emitted. Note that the string message is\n-- always evaluated, whether or not profiling is available or enabled.\n\n{-# NOINLINE traceEvent #-}\n-- | The 'traceEvent' function behaves like 'trace' with the difference that\n-- the message is emitted to the eventlog, if eventlog profiling is available\n-- and enabled at runtime.\n--\n-- It is suitable for use in pure code. In an IO context use 'traceEventIO'\n-- instead.\n--\n-- Note that when using GHC's SMP runtime, it is possible (but rare) to get\n-- duplicate events emitted if two CPUs simultaneously evaluate the same thunk\n-- that uses 'traceEvent'.\n--\n-- @since 4.5.0.0\ntraceEvent :: String -> a -> a\ntraceEvent msg expr = unsafeDupablePerformIO $ do\n    traceEventIO msg\n    return expr\n\n-- | The 'traceEventIO' function emits a message to the eventlog, if eventlog\n-- profiling is available and enabled at runtime.\n--\n-- Compared to 'traceEvent', 'traceEventIO' sequences the event with respect to\n-- other IO actions.\n--\n-- @since 4.5.0.0\ntraceEventIO :: String -> IO ()\ntraceEventIO msg =\n  GHC.Foreign.withCString utf8 msg $ \\(Ptr p) -> IO $ \\s ->\n    case traceEvent# p s of s' -> (# s', () #)\n\n-- $markers\n--\n-- When looking at a profile for the execution of a program we often want to\n-- be able to mark certain points or phases in the execution and see that\n-- visually in the profile.\n\n-- For example, a program might have several distinct phases with different\n-- performance or resource behaviour in each phase. To properly interpret the\n-- profile graph we really want to see when each phase starts and ends.\n--\n-- Markers let us do this: we can annotate the program to emit a marker at\n-- an appropriate point during execution and then see that in a profile.\n--\n-- Currently this feature is only supported in GHC by the eventlog tracing\n-- system, but in future it may also be supported by the heap profiling or\n-- other profiling tools. These function exists for other Haskell\n-- implementations but they have no effect. Note that the string message is\n-- always evaluated, whether or not profiling is available or enabled.\n\n{-# NOINLINE traceMarker #-}\n-- | The 'traceMarker' function emits a marker to the eventlog, if eventlog\n-- profiling is available and enabled at runtime. The @String@ is the name of\n-- the marker. The name is just used in the profiling tools to help you keep\n-- clear which marker is which.\n--\n-- This function is suitable for use in pure code. In an IO context use\n-- 'traceMarkerIO' instead.\n--\n-- Note that when using GHC's SMP runtime, it is possible (but rare) to get\n-- duplicate events emitted if two CPUs simultaneously evaluate the same thunk\n-- that uses 'traceMarker'.\n--\n-- @since 4.7.0.0\ntraceMarker :: String -> a -> a\ntraceMarker msg expr = unsafeDupablePerformIO $ do\n    traceMarkerIO msg\n    return expr\n\n-- | The 'traceMarkerIO' function emits a marker to the eventlog, if eventlog\n-- profiling is available and enabled at runtime.\n--\n-- Compared to 'traceMarker', 'traceMarkerIO' sequences the event with respect to\n-- other IO actions.\n--\n-- @since 4.7.0.0\ntraceMarkerIO :: String -> IO ()\ntraceMarkerIO msg =\n  GHC.Foreign.withCString utf8 msg $ \\(Ptr p) -> IO $ \\s ->\n    case traceMarker# p s of s' -> (# s', () #)\n", "num_lines": 322}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.C\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Bundles the C specific FFI library functionality\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.C\n        ( module Foreign.C.Types\n        , module Foreign.C.String\n        , module Foreign.C.Error\n        ) where\n\nimport Foreign.C.Types\nimport Foreign.C.String\nimport Foreign.C.Error\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Concurrent\n-- Copyright   :  (c) The University of Glasgow 2003\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (requires concurrency)\n--\n-- FFI datatypes and operations that use or require concurrency (GHC only).\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Concurrent\n  (\n        -- * Concurrency-based 'ForeignPtr' operations\n\n        -- | These functions generalize their namesakes in the portable\n        -- \"Foreign.ForeignPtr\" module by allowing arbitrary 'IO' actions\n        -- as finalizers.  These finalizers necessarily run in a separate\n        -- thread, cf. /Destructors, Finalizers and Synchronization/,\n        -- by Hans Boehm, /POPL/, 2003.\n\n        newForeignPtr,\n        addForeignPtrFinalizer,\n  ) where\n\nimport GHC.IO         ( IO )\nimport GHC.Ptr        ( Ptr )\nimport GHC.ForeignPtr ( ForeignPtr )\nimport qualified GHC.ForeignPtr\n\nnewForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)\n--\n-- ^Turns a plain memory reference into a foreign object by\n-- associating a finalizer - given by the monadic operation - with the\n-- reference.  The storage manager will start the finalizer, in a\n-- separate thread, some time after the last reference to the\n-- 'ForeignPtr' is dropped.  There is no guarantee of promptness, and\n-- in fact there is no guarantee that the finalizer will eventually\n-- run at all.\n--\n-- Note that references from a finalizer do not necessarily prevent\n-- another object from being finalized.  If A's finalizer refers to B\n-- (perhaps using 'Foreign.ForeignPtr.touchForeignPtr', then the only\n-- guarantee is that B's finalizer will never be started before A's.  If both\n-- A and B are unreachable, then both finalizers will start together.  See\n-- 'Foreign.ForeignPtr.touchForeignPtr' for more on finalizer ordering.\n--\nnewForeignPtr = GHC.ForeignPtr.newConcForeignPtr\n\naddForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()\n-- ^This function adds a finalizer to the given 'ForeignPtr'.  The\n-- finalizer will run /before/ all other finalizers for the same\n-- object which have already been registered.\n--\n-- This is a variant of 'Foreign.ForeignPtr.addForeignPtrFinalizer',\n-- where the finalizer is an arbitrary 'IO' action.  When it is\n-- invoked, the finalizer will run in a new thread.\n--\n-- NB. Be very careful with these finalizers.  One common trap is that\n-- if a finalizer references another finalized value, it does not\n-- prevent that value from being finalized.  In particular, 'System.IO.Handle's\n-- are finalized objects, so a finalizer should not refer to a\n-- 'System.IO.Handle' (including 'System.IO.stdout', 'System.IO.stdin', or\n-- 'System.IO.stderr').\n--\naddForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer\n\n", "num_lines": 74}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.ForeignPtr\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The 'ForeignPtr' type and operations.  This module is part of the\n-- Foreign Function Interface (FFI) and will usually be imported via\n-- the \"Foreign\" module.\n--\n-- For non-portable support of Haskell finalizers, see the\n-- \"Foreign.Concurrent\" module.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.ForeignPtr ( \n        -- * Finalised data pointers\n          ForeignPtr\n        , FinalizerPtr\n        , FinalizerEnvPtr\n\n        -- ** Basic operations\n        , newForeignPtr\n        , newForeignPtr_\n        , addForeignPtrFinalizer\n        , newForeignPtrEnv\n        , addForeignPtrFinalizerEnv\n        , withForeignPtr\n        , finalizeForeignPtr\n\n        -- ** Low-level operations\n        , touchForeignPtr\n        , castForeignPtr\n        , plusForeignPtr\n\n        -- ** Allocating managed memory\n        , mallocForeignPtr\n        , mallocForeignPtrBytes\n        , mallocForeignPtrArray\n        , mallocForeignPtrArray0\n    ) where\n\nimport Foreign.ForeignPtr.Imp\n\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal\n-- Copyright   :  (c) The FFI task force 2003\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Marshalling support\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Marshal\n        (\n         -- | The module \"Foreign.Marshal.Safe\" re-exports the other modules in the\n         -- @Foreign.Marshal@ hierarchy (except for @Foreign.Marshal.Unsafe@):\n          module Foreign.Marshal.Alloc\n        , module Foreign.Marshal.Array\n        , module Foreign.Marshal.Error\n        , module Foreign.Marshal.Pool\n        , module Foreign.Marshal.Utils\n        ) where\n\nimport Foreign.Marshal.Alloc\nimport Foreign.Marshal.Array\nimport Foreign.Marshal.Error\nimport Foreign.Marshal.Pool\nimport Foreign.Marshal.Utils\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Ptr\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- This module provides typed pointers to foreign data.  It is part\n-- of the Foreign Function Interface (FFI) and will normally be\n-- imported via the \"Foreign\" module.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Ptr (\n\n    -- * Data pointers\n\n    Ptr,\n    nullPtr,\n    castPtr,\n    plusPtr,\n    alignPtr,\n    minusPtr,\n\n    -- * Function pointers\n\n    FunPtr,\n    nullFunPtr,\n    castFunPtr,\n    castFunPtrToPtr,\n    castPtrToFunPtr,\n\n    freeHaskellFunPtr,\n    -- Free the function pointer created by foreign export dynamic.\n\n    -- * Integral types with lossless conversion to and from pointers\n    IntPtr(..),\n    ptrToIntPtr,\n    intPtrToPtr,\n    WordPtr(..),\n    ptrToWordPtr,\n    wordPtrToPtr\n\n    -- See Note [Exporting constructors of marshallable foreign types]\n    -- for why the constructors for IntPtr and WordPtr are exported.\n ) where\n\nimport GHC.Ptr\nimport GHC.Base\nimport GHC.Num\nimport GHC.Read\nimport GHC.Real\nimport GHC.Show\nimport GHC.Enum\n\nimport Data.Bits\nimport Foreign.Storable ( Storable(..) )\n\n-- | Release the storage associated with the given 'FunPtr', which\n-- must have been obtained from a wrapper stub.  This should be called\n-- whenever the return value from a foreign import wrapper function is\n-- no longer required; otherwise, the storage it uses will leak.\nforeign import ccall unsafe \"freeHaskellFunctionPtr\"\n    freeHaskellFunPtr :: FunPtr a -> IO ()\n\n#include \"HsBaseConfig.h\"\n#include \"CTypes.h\"\n\n-- | An unsigned integral type that can be losslessly converted to and from\n-- @Ptr@. This type is also compatible with the C99 type @uintptr_t@, and\n-- can be marshalled to and from that type safely.\nINTEGRAL_TYPE(WordPtr,Word)\n        -- Word and Int are guaranteed pointer-sized in GHC\n\n-- | A signed integral type that can be losslessly converted to and from\n-- @Ptr@.  This type is also compatible with the C99 type @intptr_t@, and\n-- can be marshalled to and from that type safely.\nINTEGRAL_TYPE(IntPtr,Int)\n        -- Word and Int are guaranteed pointer-sized in GHC\n\n-- | casts a @Ptr@ to a @WordPtr@\nptrToWordPtr :: Ptr a -> WordPtr\nptrToWordPtr (Ptr a#) = WordPtr (W# (int2Word# (addr2Int# a#)))\n\n-- | casts a @WordPtr@ to a @Ptr@\nwordPtrToPtr :: WordPtr -> Ptr a\nwordPtrToPtr (WordPtr (W# w#)) = Ptr (int2Addr# (word2Int# w#))\n\n-- | casts a @Ptr@ to an @IntPtr@\nptrToIntPtr :: Ptr a -> IntPtr\nptrToIntPtr (Ptr a#) = IntPtr (I# (addr2Int# a#))\n\n-- | casts an @IntPtr@ to a @Ptr@\nintPtrToPtr :: IntPtr -> Ptr a\nintPtrToPtr (IntPtr (I# i#)) = Ptr (int2Addr# i#)\n\n{-\nNote [Exporting constructors of marshallable foreign types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nOne might expect that IntPtr, WordPtr, and the other newtypes in the\nForeign.C.Types and System.Posix.Types modules to be abstract, but this is not\nthe case in GHC (see Trac #5229 and #11983). In fact, we deliberately export\nthe constructors for these datatypes in order to satisfy a requirement of the\nHaskell 2010 Report (\u00c2\u00a7 8.4.2) that if a newtype is used in a foreign\ndeclaration, then its constructor must be visible.\n\nThis requirement was motivated by the fact that using a type in a foreign\ndeclaration necessarily exposes some information about the type to the user,\nso being able to use abstract types in a foreign declaration breaks their\nabstraction (see Trac #3008). As a result, the constructors of all FFI-related\nnewtypes in base must be exported in order to be useful for FFI programming,\neven at the cost of exposing their underlying, architecture-dependent types.\n-}\n", "num_lines": 125}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Safe\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A collection of data types, classes, and functions for interfacing\n-- with another programming language.\n--\n-- Safe API Only.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Safe {-# DEPRECATED \"Safe is now the default, please use Foreign instead\" #-}\n        ( module Data.Bits\n        , module Data.Int\n        , module Data.Word\n        , module Foreign.Ptr\n        , module Foreign.ForeignPtr\n        , module Foreign.StablePtr\n        , module Foreign.Storable\n        , module Foreign.Marshal\n        ) where\n\nimport Data.Bits\nimport Data.Int\nimport Data.Word\nimport Foreign.Ptr\nimport Foreign.ForeignPtr\nimport Foreign.StablePtr\nimport Foreign.Storable\nimport Foreign.Marshal\n\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.StablePtr\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- This module is part of the Foreign Function Interface (FFI) and will usually\n-- be imported via the module \"Foreign\".\n--\n-----------------------------------------------------------------------------\n\n\nmodule Foreign.StablePtr\n        ( -- * Stable references to Haskell values\n          StablePtr          -- abstract\n        , newStablePtr\n        , deRefStablePtr\n        , freeStablePtr\n        , castStablePtrToPtr\n        , castPtrToStablePtr\n        , -- ** The C-side interface\n\n          -- $cinterface\n        ) where\n\nimport GHC.Stable\n\n-- $cinterface\n--\n-- The following definition is available to C programs inter-operating with\n-- Haskell code when including the header @HsFFI.h@.\n--\n-- > typedef void *HsStablePtr;  /* C representation of a StablePtr */\n--\n-- Note that no assumptions may be made about the values representing stable\n-- pointers.  In fact, they need not even be valid memory addresses.  The only\n-- guarantee provided is that if they are passed back to Haskell land, the\n-- function 'deRefStablePtr' will be able to reconstruct the\n-- Haskell value referred to by the stable pointer.\n\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, BangPatterns #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Storable\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  see libraries/base/LICENSE\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The module \"Foreign.Storable\" provides most elementary support for\n-- marshalling and is part of the language-independent portion of the\n-- Foreign Function Interface (FFI), and will normally be imported via\n-- the \"Foreign\" module.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Storable\n        ( Storable(\n             sizeOf,\n             alignment,\n             peekElemOff,\n             pokeElemOff,\n             peekByteOff,\n             pokeByteOff,\n             peek,\n             poke)\n        ) where\n\n\n#include \"MachDeps.h\"\n#include \"HsBaseConfig.h\"\n\nimport GHC.Storable\nimport GHC.Stable       ( StablePtr )\nimport GHC.Num\nimport GHC.Int\nimport GHC.Word\nimport GHC.Ptr\nimport GHC.Base\nimport GHC.Fingerprint.Type\nimport Data.Bits\nimport GHC.Real\n\n{- |\nThe member functions of this class facilitate writing values of\nprimitive types to raw memory (which may have been allocated with the\nabove mentioned routines) and reading values from blocks of raw\nmemory.  The class, furthermore, includes support for computing the\nstorage requirements and alignment restrictions of storable types.\n\nMemory addresses are represented as values of type @'Ptr' a@, for some\n@a@ which is an instance of class 'Storable'.  The type argument to\n'Ptr' helps provide some valuable type safety in FFI code (you can\\'t\nmix pointers of different types without an explicit cast), while\nhelping the Haskell type system figure out which marshalling method is\nneeded for a given pointer.\n\nAll marshalling between Haskell and a foreign language ultimately\nboils down to translating Haskell data structures into the binary\nrepresentation of a corresponding data structure of the foreign\nlanguage and vice versa.  To code this marshalling in Haskell, it is\nnecessary to manipulate primitive data types stored in unstructured\nmemory blocks.  The class 'Storable' facilitates this manipulation on\nall types for which it is instantiated, which are the standard basic\ntypes of Haskell, the fixed size @Int@ types ('Int8', 'Int16',\n'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',\n'Word32', 'Word64'), 'StablePtr', all types from \"Foreign.C.Types\",\nas well as 'Ptr'.\n-}\n\nclass Storable a where\n   {-# MINIMAL sizeOf, alignment,\n               (peek | peekElemOff | peekByteOff),\n               (poke | pokeElemOff | pokeByteOff) #-}\n\n   sizeOf      :: a -> Int\n   -- ^ Computes the storage requirements (in bytes) of the argument.\n   -- The value of the argument is not used.\n\n   alignment   :: a -> Int\n   -- ^ Computes the alignment constraint of the argument.  An\n   -- alignment constraint @x@ is fulfilled by any address divisible\n   -- by @x@.  The value of the argument is not used.\n\n   peekElemOff :: Ptr a -> Int      -> IO a\n   -- ^       Read a value from a memory area regarded as an array\n   --         of values of the same kind.  The first argument specifies\n   --         the start address of the array and the second the index into\n   --         the array (the first element of the array has index\n   --         @0@).  The following equality holds,\n   -- \n   -- > peekElemOff addr idx = IOExts.fixIO $ \\result ->\n   -- >   peek (addr `plusPtr` (idx * sizeOf result))\n   --\n   --         Note that this is only a specification, not\n   --         necessarily the concrete implementation of the\n   --         function.\n\n   pokeElemOff :: Ptr a -> Int -> a -> IO ()\n   -- ^       Write a value to a memory area regarded as an array of\n   --         values of the same kind.  The following equality holds:\n   -- \n   -- > pokeElemOff addr idx x = \n   -- >   poke (addr `plusPtr` (idx * sizeOf x)) x\n\n   peekByteOff :: Ptr b -> Int      -> IO a\n   -- ^       Read a value from a memory location given by a base\n   --         address and offset.  The following equality holds:\n   --\n   -- > peekByteOff addr off = peek (addr `plusPtr` off)\n\n   pokeByteOff :: Ptr b -> Int -> a -> IO ()\n   -- ^       Write a value to a memory location given by a base\n   --         address and offset.  The following equality holds:\n   --\n   -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x\n  \n   peek        :: Ptr a      -> IO a\n   -- ^ Read a value from the given memory location.\n   --\n   --  Note that the peek and poke functions might require properly\n   --  aligned addresses to function correctly.  This is architecture\n   --  dependent; thus, portable code should ensure that when peeking or\n   --  poking values of some type @a@, the alignment\n   --  constraint for @a@, as given by the function\n   --  'alignment' is fulfilled.\n\n   poke        :: Ptr a -> a -> IO ()\n   -- ^ Write the given value to the given memory location.  Alignment\n   -- restrictions might apply; see 'peek'.\n \n   -- circular default instances\n   peekElemOff = peekElemOff_ undefined\n      where peekElemOff_ :: a -> Ptr a -> Int -> IO a\n            peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)\n   pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val\n\n   peekByteOff ptr off = peek (ptr `plusPtr` off)\n   pokeByteOff ptr off = poke (ptr `plusPtr` off)\n\n   peek ptr = peekElemOff ptr 0\n   poke ptr = pokeElemOff ptr 0\n\n-- | @since 4.9.0.0\ninstance Storable () where\n  sizeOf _ = 0\n  alignment _ = 1\n  peek _ = return ()\n  poke _ _ = return ()\n\n-- System-dependent, but rather obvious instances\n\n-- | @since 2.01\ninstance Storable Bool where\n   sizeOf _          = sizeOf (undefined::HTYPE_INT)\n   alignment _       = alignment (undefined::HTYPE_INT)\n   peekElemOff p i   = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i\n   pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)\n\n#define STORABLE(T,size,align,read,write)       \\\ninstance Storable (T) where {                   \\\n    sizeOf    _ = size;                         \\\n    alignment _ = align;                        \\\n    peekElemOff = read;                         \\\n    pokeElemOff = write }\n\n-- | @since 2.01\nSTORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,\n         readWideCharOffPtr,writeWideCharOffPtr)\n\n-- | @since 2.01\nSTORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,\n         readIntOffPtr,writeIntOffPtr)\n\n-- | @since 2.01\nSTORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,\n         readWordOffPtr,writeWordOffPtr)\n\n-- | @since 2.01\nSTORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,\n         readPtrOffPtr,writePtrOffPtr)\n\n-- | @since 2.01\nSTORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,\n         readFunPtrOffPtr,writeFunPtrOffPtr)\n\n-- | @since 2.01\nSTORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,\n         readStablePtrOffPtr,writeStablePtrOffPtr)\n\n-- | @since 2.01\nSTORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,\n         readFloatOffPtr,writeFloatOffPtr)\n\n-- | @since 2.01\nSTORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,\n         readDoubleOffPtr,writeDoubleOffPtr)\n\n-- | @since 2.01\nSTORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,\n         readWord8OffPtr,writeWord8OffPtr)\n\n-- | @since 2.01\nSTORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,\n         readWord16OffPtr,writeWord16OffPtr)\n\n-- | @since 2.01\nSTORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,\n         readWord32OffPtr,writeWord32OffPtr)\n\n-- | @since 2.01\nSTORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,\n         readWord64OffPtr,writeWord64OffPtr)\n\n-- | @since 2.01\nSTORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,\n         readInt8OffPtr,writeInt8OffPtr)\n\n-- | @since 2.01\nSTORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,\n         readInt16OffPtr,writeInt16OffPtr)\n\n-- | @since 2.01\nSTORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,\n         readInt32OffPtr,writeInt32OffPtr)\n\n-- | @since 2.01\nSTORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,\n         readInt64OffPtr,writeInt64OffPtr)\n\n-- | @since 4.8.0.0\ninstance (Storable a, Integral a) => Storable (Ratio a) where\n    sizeOf _    = 2 * sizeOf (undefined :: a)\n    alignment _ = alignment (undefined :: a )\n    peek p           = do\n                        q <- return $ castPtr p\n                        r <- peek q\n                        i <- peekElemOff q 1\n                        return (r % i)\n    poke p (r :% i)  = do\n                        q <-return $  (castPtr p)\n                        poke q r\n                        pokeElemOff q 1 i\n\n-- XXX: here to avoid orphan instance in GHC.Fingerprint\n-- | @since 4.4.0.0\ninstance Storable Fingerprint where\n  sizeOf _ = 16\n  alignment _ = 8\n  peek = peekFingerprint\n  poke = pokeFingerprint\n\n-- peek/poke in fixed BIG-endian 128-bit format\npeekFingerprint :: Ptr Fingerprint -> IO Fingerprint\npeekFingerprint p0 = do\n      let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64\n          peekW64 _  0  !i = return i\n          peekW64 !p !n !i = do\n                w8 <- peek p\n                peekW64 (p `plusPtr` 1) (n-1) \n                    ((i `shiftL` 8) .|. fromIntegral w8)\n\n      high <- peekW64 (castPtr p0) 8 0\n      low  <- peekW64 (castPtr p0 `plusPtr` 8) 8 0\n      return (Fingerprint high low)\n\npokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()\npokeFingerprint p0 (Fingerprint high low) = do\n      let pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()\n          pokeW64 _ 0  _  = return ()\n          pokeW64 p !n !i = do\n                pokeElemOff p (n-1) (fromIntegral i)\n                pokeW64 p (n-1) (i `shiftR` 8)\n\n      pokeW64 (castPtr p0) 8 high\n      pokeW64 (castPtr p0 `plusPtr` 8) 8 low\n", "num_lines": 281}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.C.Error\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- C-specific Marshalling support: Handling of C \\\"errno\\\" error codes.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.C.Error (\n\n  -- * Haskell representations of @errno@ values\n\n  Errno(..),\n\n  -- ** Common @errno@ symbols\n  -- | Different operating systems and\\/or C libraries often support\n  -- different values of @errno@.  This module defines the common values,\n  -- but due to the open definition of 'Errno' users may add definitions\n  -- which are not predefined.\n  eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,\n  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,\n  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,\n  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,\n  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,\n  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,\n  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,\n  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,\n  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO,\n  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,\n  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,\n  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,\n  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,\n  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV,\n\n  -- ** 'Errno' functions\n  isValidErrno,\n\n  -- access to the current thread's \"errno\" value\n  --\n  getErrno,\n  resetErrno,\n\n  -- conversion of an \"errno\" value into IO error\n  --\n  errnoToIOError,\n\n  -- throw current \"errno\" value\n  --\n  throwErrno,\n\n  -- ** Guards for IO operations that may fail\n\n  throwErrnoIf,\n  throwErrnoIf_,\n  throwErrnoIfRetry,\n  throwErrnoIfRetry_,\n  throwErrnoIfMinus1,\n  throwErrnoIfMinus1_,\n  throwErrnoIfMinus1Retry,\n  throwErrnoIfMinus1Retry_,\n  throwErrnoIfNull,\n  throwErrnoIfNullRetry,\n\n  throwErrnoIfRetryMayBlock,\n  throwErrnoIfRetryMayBlock_,\n  throwErrnoIfMinus1RetryMayBlock,\n  throwErrnoIfMinus1RetryMayBlock_,\n  throwErrnoIfNullRetryMayBlock,\n\n  throwErrnoPath,\n  throwErrnoPathIf,\n  throwErrnoPathIf_,\n  throwErrnoPathIfNull,\n  throwErrnoPathIfMinus1,\n  throwErrnoPathIfMinus1_,\n) where\n\n\n-- this is were we get the CONST_XXX definitions from that configure\n-- calculated for us\n--\n#include \"HsBaseConfig.h\"\n\nimport Foreign.Ptr\nimport Foreign.C.Types\nimport Foreign.C.String\nimport Data.Functor            ( void )\nimport Data.Maybe\n\nimport GHC.IO\nimport GHC.IO.Exception\nimport GHC.IO.Handle.Types\nimport GHC.Num\nimport GHC.Base\n\n-- \"errno\" type\n-- ------------\n\n-- | Haskell representation for @errno@ values.\n-- The implementation is deliberately exposed, to allow users to add\n-- their own definitions of 'Errno' values.\n\nnewtype Errno = Errno CInt\n\n-- | @since 2.01\ninstance Eq Errno where\n  errno1@(Errno no1) == errno2@(Errno no2)\n    | isValidErrno errno1 && isValidErrno errno2 = no1 == no2\n    | otherwise                                  = False\n\n-- common \"errno\" symbols\n--\neOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,\n  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,\n  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,\n  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,\n  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,\n  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,\n  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,\n  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,\n  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO,\n  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,\n  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,\n  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,\n  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,\n  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV                    :: Errno\n--\n-- the cCONST_XXX identifiers are cpp symbols whose value is computed by\n-- configure\n--\neOK             = Errno 0\ne2BIG           = Errno (CONST_E2BIG)\neACCES          = Errno (CONST_EACCES)\neADDRINUSE      = Errno (CONST_EADDRINUSE)\neADDRNOTAVAIL   = Errno (CONST_EADDRNOTAVAIL)\neADV            = Errno (CONST_EADV)\neAFNOSUPPORT    = Errno (CONST_EAFNOSUPPORT)\neAGAIN          = Errno (CONST_EAGAIN)\neALREADY        = Errno (CONST_EALREADY)\neBADF           = Errno (CONST_EBADF)\neBADMSG         = Errno (CONST_EBADMSG)\neBADRPC         = Errno (CONST_EBADRPC)\neBUSY           = Errno (CONST_EBUSY)\neCHILD          = Errno (CONST_ECHILD)\neCOMM           = Errno (CONST_ECOMM)\neCONNABORTED    = Errno (CONST_ECONNABORTED)\neCONNREFUSED    = Errno (CONST_ECONNREFUSED)\neCONNRESET      = Errno (CONST_ECONNRESET)\neDEADLK         = Errno (CONST_EDEADLK)\neDESTADDRREQ    = Errno (CONST_EDESTADDRREQ)\neDIRTY          = Errno (CONST_EDIRTY)\neDOM            = Errno (CONST_EDOM)\neDQUOT          = Errno (CONST_EDQUOT)\neEXIST          = Errno (CONST_EEXIST)\neFAULT          = Errno (CONST_EFAULT)\neFBIG           = Errno (CONST_EFBIG)\neFTYPE          = Errno (CONST_EFTYPE)\neHOSTDOWN       = Errno (CONST_EHOSTDOWN)\neHOSTUNREACH    = Errno (CONST_EHOSTUNREACH)\neIDRM           = Errno (CONST_EIDRM)\neILSEQ          = Errno (CONST_EILSEQ)\neINPROGRESS     = Errno (CONST_EINPROGRESS)\neINTR           = Errno (CONST_EINTR)\neINVAL          = Errno (CONST_EINVAL)\neIO             = Errno (CONST_EIO)\neISCONN         = Errno (CONST_EISCONN)\neISDIR          = Errno (CONST_EISDIR)\neLOOP           = Errno (CONST_ELOOP)\neMFILE          = Errno (CONST_EMFILE)\neMLINK          = Errno (CONST_EMLINK)\neMSGSIZE        = Errno (CONST_EMSGSIZE)\neMULTIHOP       = Errno (CONST_EMULTIHOP)\neNAMETOOLONG    = Errno (CONST_ENAMETOOLONG)\neNETDOWN        = Errno (CONST_ENETDOWN)\neNETRESET       = Errno (CONST_ENETRESET)\neNETUNREACH     = Errno (CONST_ENETUNREACH)\neNFILE          = Errno (CONST_ENFILE)\neNOBUFS         = Errno (CONST_ENOBUFS)\neNODATA         = Errno (CONST_ENODATA)\neNODEV          = Errno (CONST_ENODEV)\neNOENT          = Errno (CONST_ENOENT)\neNOEXEC         = Errno (CONST_ENOEXEC)\neNOLCK          = Errno (CONST_ENOLCK)\neNOLINK         = Errno (CONST_ENOLINK)\neNOMEM          = Errno (CONST_ENOMEM)\neNOMSG          = Errno (CONST_ENOMSG)\neNONET          = Errno (CONST_ENONET)\neNOPROTOOPT     = Errno (CONST_ENOPROTOOPT)\neNOSPC          = Errno (CONST_ENOSPC)\neNOSR           = Errno (CONST_ENOSR)\neNOSTR          = Errno (CONST_ENOSTR)\neNOSYS          = Errno (CONST_ENOSYS)\neNOTBLK         = Errno (CONST_ENOTBLK)\neNOTCONN        = Errno (CONST_ENOTCONN)\neNOTDIR         = Errno (CONST_ENOTDIR)\neNOTEMPTY       = Errno (CONST_ENOTEMPTY)\neNOTSOCK        = Errno (CONST_ENOTSOCK)\neNOTSUP         = Errno (CONST_ENOTSUP)\n-- ^ @since 4.7.0.0\neNOTTY          = Errno (CONST_ENOTTY)\neNXIO           = Errno (CONST_ENXIO)\neOPNOTSUPP      = Errno (CONST_EOPNOTSUPP)\nePERM           = Errno (CONST_EPERM)\nePFNOSUPPORT    = Errno (CONST_EPFNOSUPPORT)\nePIPE           = Errno (CONST_EPIPE)\nePROCLIM        = Errno (CONST_EPROCLIM)\nePROCUNAVAIL    = Errno (CONST_EPROCUNAVAIL)\nePROGMISMATCH   = Errno (CONST_EPROGMISMATCH)\nePROGUNAVAIL    = Errno (CONST_EPROGUNAVAIL)\nePROTO          = Errno (CONST_EPROTO)\nePROTONOSUPPORT = Errno (CONST_EPROTONOSUPPORT)\nePROTOTYPE      = Errno (CONST_EPROTOTYPE)\neRANGE          = Errno (CONST_ERANGE)\neREMCHG         = Errno (CONST_EREMCHG)\neREMOTE         = Errno (CONST_EREMOTE)\neROFS           = Errno (CONST_EROFS)\neRPCMISMATCH    = Errno (CONST_ERPCMISMATCH)\neRREMOTE        = Errno (CONST_ERREMOTE)\neSHUTDOWN       = Errno (CONST_ESHUTDOWN)\neSOCKTNOSUPPORT = Errno (CONST_ESOCKTNOSUPPORT)\neSPIPE          = Errno (CONST_ESPIPE)\neSRCH           = Errno (CONST_ESRCH)\neSRMNT          = Errno (CONST_ESRMNT)\neSTALE          = Errno (CONST_ESTALE)\neTIME           = Errno (CONST_ETIME)\neTIMEDOUT       = Errno (CONST_ETIMEDOUT)\neTOOMANYREFS    = Errno (CONST_ETOOMANYREFS)\neTXTBSY         = Errno (CONST_ETXTBSY)\neUSERS          = Errno (CONST_EUSERS)\neWOULDBLOCK     = Errno (CONST_EWOULDBLOCK)\neXDEV           = Errno (CONST_EXDEV)\n\n-- | Yield 'True' if the given 'Errno' value is valid on the system.\n-- This implies that the 'Eq' instance of 'Errno' is also system dependent\n-- as it is only defined for valid values of 'Errno'.\n--\nisValidErrno               :: Errno -> Bool\n--\n-- the configure script sets all invalid \"errno\"s to -1\n--\nisValidErrno (Errno errno)  = errno /= -1\n\n\n-- access to the current thread's \"errno\" value\n-- --------------------------------------------\n\n-- | Get the current value of @errno@ in the current thread.\n--\n-- On GHC, the runtime will ensure that any Haskell thread will only see \"its own\"\n-- @errno@, by saving and restoring the value when Haskell threads are scheduled\n-- across OS threads.\ngetErrno :: IO Errno\n\n-- We must call a C function to get the value of errno in general.  On\n-- threaded systems, errno is hidden behind a C macro so that each OS\n-- thread gets its own copy (`saved_errno`, which `rts/Schedule.c` restores\n-- back into the thread-local `errno` when a Haskell thread is rescheduled).\ngetErrno = do e <- get_errno; return (Errno e)\nforeign import ccall unsafe \"HsBase.h __hscore_get_errno\" get_errno :: IO CInt\n\n-- | Reset the current thread\\'s @errno@ value to 'eOK'.\n--\nresetErrno :: IO ()\n\n-- Again, setting errno has to be done via a C function.\nresetErrno = set_errno 0\nforeign import ccall unsafe \"HsBase.h __hscore_set_errno\" set_errno :: CInt -> IO ()\n\n-- throw current \"errno\" value\n-- ---------------------------\n\n-- | Throw an 'IOError' corresponding to the current value of 'getErrno'.\n--\nthrowErrno     :: String        -- ^ textual description of the error location\n               -> IO a\nthrowErrno loc  =\n  do\n    errno <- getErrno\n    ioError (errnoToIOError loc errno Nothing Nothing)\n\n\n-- guards for IO operations that may fail\n-- --------------------------------------\n\n-- | Throw an 'IOError' corresponding to the current value of 'getErrno'\n-- if the result value of the 'IO' action meets the given predicate.\n--\nthrowErrnoIf    :: (a -> Bool)  -- ^ predicate to apply to the result value\n                                -- of the 'IO' operation\n                -> String       -- ^ textual description of the location\n                -> IO a         -- ^ the 'IO' operation to be executed\n                -> IO a\nthrowErrnoIf pred loc f  =\n  do\n    res <- f\n    if pred res then throwErrno loc else return res\n\n-- | as 'throwErrnoIf', but discards the result of the 'IO' action after\n-- error handling.\n--\nthrowErrnoIf_   :: (a -> Bool) -> String -> IO a -> IO ()\nthrowErrnoIf_ pred loc f  = void $ throwErrnoIf pred loc f\n\n-- | as 'throwErrnoIf', but retry the 'IO' action when it yields the\n-- error code 'eINTR' - this amounts to the standard retry loop for\n-- interrupted POSIX system calls.\n--\nthrowErrnoIfRetry            :: (a -> Bool) -> String -> IO a -> IO a\nthrowErrnoIfRetry pred loc f  =\n  do\n    res <- f\n    if pred res\n      then do\n        err <- getErrno\n        if err == eINTR\n          then throwErrnoIfRetry pred loc f\n          else throwErrno loc\n      else return res\n\n-- | as 'throwErrnoIfRetry', but additionally if the operation\n-- yields the error code 'eAGAIN' or 'eWOULDBLOCK', an alternative\n-- action is executed before retrying.\n--\nthrowErrnoIfRetryMayBlock\n                :: (a -> Bool)  -- ^ predicate to apply to the result value\n                                -- of the 'IO' operation\n                -> String       -- ^ textual description of the location\n                -> IO a         -- ^ the 'IO' operation to be executed\n                -> IO b         -- ^ action to execute before retrying if\n                                -- an immediate retry would block\n                -> IO a\nthrowErrnoIfRetryMayBlock pred loc f on_block  =\n  do\n    res <- f\n    if pred res\n      then do\n        err <- getErrno\n        if err == eINTR\n          then throwErrnoIfRetryMayBlock pred loc f on_block\n          else if err == eWOULDBLOCK || err == eAGAIN\n                 then do _ <- on_block\n                         throwErrnoIfRetryMayBlock pred loc f on_block\n                 else throwErrno loc\n      else return res\n\n-- | as 'throwErrnoIfRetry', but discards the result.\n--\nthrowErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()\nthrowErrnoIfRetry_ pred loc f  = void $ throwErrnoIfRetry pred loc f\n\n-- | as 'throwErrnoIfRetryMayBlock', but discards the result.\n--\nthrowErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()\nthrowErrnoIfRetryMayBlock_ pred loc f on_block\n  = void $ throwErrnoIfRetryMayBlock pred loc f on_block\n\n-- | Throw an 'IOError' corresponding to the current value of 'getErrno'\n-- if the 'IO' action returns a result of @-1@.\n--\nthrowErrnoIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a\nthrowErrnoIfMinus1  = throwErrnoIf (== -1)\n\n-- | as 'throwErrnoIfMinus1', but discards the result.\n--\nthrowErrnoIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()\nthrowErrnoIfMinus1_  = throwErrnoIf_ (== -1)\n\n-- | Throw an 'IOError' corresponding to the current value of 'getErrno'\n-- if the 'IO' action returns a result of @-1@, but retries in case of\n-- an interrupted operation.\n--\nthrowErrnoIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a\nthrowErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)\n\n-- | as 'throwErrnoIfMinus1', but discards the result.\n--\nthrowErrnoIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()\nthrowErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)\n\n-- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block.\n--\nthrowErrnoIfMinus1RetryMayBlock :: (Eq a, Num a)\n                                => String -> IO a -> IO b -> IO a\nthrowErrnoIfMinus1RetryMayBlock  = throwErrnoIfRetryMayBlock (== -1)\n\n-- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result.\n--\nthrowErrnoIfMinus1RetryMayBlock_ :: (Eq a, Num a)\n                                 => String -> IO a -> IO b -> IO ()\nthrowErrnoIfMinus1RetryMayBlock_  = throwErrnoIfRetryMayBlock_ (== -1)\n\n-- | Throw an 'IOError' corresponding to the current value of 'getErrno'\n-- if the 'IO' action returns 'nullPtr'.\n--\nthrowErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)\nthrowErrnoIfNull  = throwErrnoIf (== nullPtr)\n\n-- | Throw an 'IOError' corresponding to the current value of 'getErrno'\n-- if the 'IO' action returns 'nullPtr',\n-- but retry in case of an interrupted operation.\n--\nthrowErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)\nthrowErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)\n\n-- | as 'throwErrnoIfNullRetry', but checks for operations that would block.\n--\nthrowErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a)\nthrowErrnoIfNullRetryMayBlock  = throwErrnoIfRetryMayBlock (== nullPtr)\n\n-- | as 'throwErrno', but exceptions include the given path when appropriate.\n--\nthrowErrnoPath :: String -> FilePath -> IO a\nthrowErrnoPath loc path =\n  do\n    errno <- getErrno\n    ioError (errnoToIOError loc errno Nothing (Just path))\n\n-- | as 'throwErrnoIf', but exceptions include the given path when\n--   appropriate.\n--\nthrowErrnoPathIf :: (a -> Bool) -> String -> FilePath -> IO a -> IO a\nthrowErrnoPathIf pred loc path f =\n  do\n    res <- f\n    if pred res then throwErrnoPath loc path else return res\n\n-- | as 'throwErrnoIf_', but exceptions include the given path when\n--   appropriate.\n--\nthrowErrnoPathIf_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO ()\nthrowErrnoPathIf_ pred loc path f  = void $ throwErrnoPathIf pred loc path f\n\n-- | as 'throwErrnoIfNull', but exceptions include the given path when\n--   appropriate.\n--\nthrowErrnoPathIfNull :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)\nthrowErrnoPathIfNull  = throwErrnoPathIf (== nullPtr)\n\n-- | as 'throwErrnoIfMinus1', but exceptions include the given path when\n--   appropriate.\n--\nthrowErrnoPathIfMinus1 :: (Eq a, Num a) => String -> FilePath -> IO a -> IO a\nthrowErrnoPathIfMinus1 = throwErrnoPathIf (== -1)\n\n-- | as 'throwErrnoIfMinus1_', but exceptions include the given path when\n--   appropriate.\n--\nthrowErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> FilePath -> IO a -> IO ()\nthrowErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)\n\n-- conversion of an \"errno\" value into IO error\n-- --------------------------------------------\n\n-- | Construct an 'IOError' based on the given 'Errno' value.\n-- The optional information can be used to improve the accuracy of\n-- error messages.\n--\nerrnoToIOError  :: String       -- ^ the location where the error occurred\n                -> Errno        -- ^ the error number\n                -> Maybe Handle -- ^ optional handle associated with the error\n                -> Maybe String -- ^ optional filename associated with the error\n                -> IOError\nerrnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do\n    str <- strerror errno >>= peekCString\n    return (IOError maybeHdl errType loc str (Just errno') maybeName)\n    where\n    Errno errno' = errno\n    errType\n        | errno == eOK             = OtherError\n        | errno == e2BIG           = ResourceExhausted\n        | errno == eACCES          = PermissionDenied\n        | errno == eADDRINUSE      = ResourceBusy\n        | errno == eADDRNOTAVAIL   = UnsupportedOperation\n        | errno == eADV            = OtherError\n        | errno == eAFNOSUPPORT    = UnsupportedOperation\n        | errno == eAGAIN          = ResourceExhausted\n        | errno == eALREADY        = AlreadyExists\n        | errno == eBADF           = InvalidArgument\n        | errno == eBADMSG         = InappropriateType\n        | errno == eBADRPC         = OtherError\n        | errno == eBUSY           = ResourceBusy\n        | errno == eCHILD          = NoSuchThing\n        | errno == eCOMM           = ResourceVanished\n        | errno == eCONNABORTED    = OtherError\n        | errno == eCONNREFUSED    = NoSuchThing\n        | errno == eCONNRESET      = ResourceVanished\n        | errno == eDEADLK         = ResourceBusy\n        | errno == eDESTADDRREQ    = InvalidArgument\n        | errno == eDIRTY          = UnsatisfiedConstraints\n        | errno == eDOM            = InvalidArgument\n        | errno == eDQUOT          = PermissionDenied\n        | errno == eEXIST          = AlreadyExists\n        | errno == eFAULT          = OtherError\n        | errno == eFBIG           = PermissionDenied\n        | errno == eFTYPE          = InappropriateType\n        | errno == eHOSTDOWN       = NoSuchThing\n        | errno == eHOSTUNREACH    = NoSuchThing\n        | errno == eIDRM           = ResourceVanished\n        | errno == eILSEQ          = InvalidArgument\n        | errno == eINPROGRESS     = AlreadyExists\n        | errno == eINTR           = Interrupted\n        | errno == eINVAL          = InvalidArgument\n        | errno == eIO             = HardwareFault\n        | errno == eISCONN         = AlreadyExists\n        | errno == eISDIR          = InappropriateType\n        | errno == eLOOP           = InvalidArgument\n        | errno == eMFILE          = ResourceExhausted\n        | errno == eMLINK          = ResourceExhausted\n        | errno == eMSGSIZE        = ResourceExhausted\n        | errno == eMULTIHOP       = UnsupportedOperation\n        | errno == eNAMETOOLONG    = InvalidArgument\n        | errno == eNETDOWN        = ResourceVanished\n        | errno == eNETRESET       = ResourceVanished\n        | errno == eNETUNREACH     = NoSuchThing\n        | errno == eNFILE          = ResourceExhausted\n        | errno == eNOBUFS         = ResourceExhausted\n        | errno == eNODATA         = NoSuchThing\n        | errno == eNODEV          = UnsupportedOperation\n        | errno == eNOENT          = NoSuchThing\n        | errno == eNOEXEC         = InvalidArgument\n        | errno == eNOLCK          = ResourceExhausted\n        | errno == eNOLINK         = ResourceVanished\n        | errno == eNOMEM          = ResourceExhausted\n        | errno == eNOMSG          = NoSuchThing\n        | errno == eNONET          = NoSuchThing\n        | errno == eNOPROTOOPT     = UnsupportedOperation\n        | errno == eNOSPC          = ResourceExhausted\n        | errno == eNOSR           = ResourceExhausted\n        | errno == eNOSTR          = InvalidArgument\n        | errno == eNOSYS          = UnsupportedOperation\n        | errno == eNOTBLK         = InvalidArgument\n        | errno == eNOTCONN        = InvalidArgument\n        | errno == eNOTDIR         = InappropriateType\n        | errno == eNOTEMPTY       = UnsatisfiedConstraints\n        | errno == eNOTSOCK        = InvalidArgument\n        | errno == eNOTTY          = IllegalOperation\n        | errno == eNXIO           = NoSuchThing\n        | errno == eOPNOTSUPP      = UnsupportedOperation\n        | errno == ePERM           = PermissionDenied\n        | errno == ePFNOSUPPORT    = UnsupportedOperation\n        | errno == ePIPE           = ResourceVanished\n        | errno == ePROCLIM        = PermissionDenied\n        | errno == ePROCUNAVAIL    = UnsupportedOperation\n        | errno == ePROGMISMATCH   = ProtocolError\n        | errno == ePROGUNAVAIL    = UnsupportedOperation\n        | errno == ePROTO          = ProtocolError\n        | errno == ePROTONOSUPPORT = ProtocolError\n        | errno == ePROTOTYPE      = ProtocolError\n        | errno == eRANGE          = UnsupportedOperation\n        | errno == eREMCHG         = ResourceVanished\n        | errno == eREMOTE         = IllegalOperation\n        | errno == eROFS           = PermissionDenied\n        | errno == eRPCMISMATCH    = ProtocolError\n        | errno == eRREMOTE        = IllegalOperation\n        | errno == eSHUTDOWN       = IllegalOperation\n        | errno == eSOCKTNOSUPPORT = UnsupportedOperation\n        | errno == eSPIPE          = UnsupportedOperation\n        | errno == eSRCH           = NoSuchThing\n        | errno == eSRMNT          = UnsatisfiedConstraints\n        | errno == eSTALE          = ResourceVanished\n        | errno == eTIME           = TimeExpired\n        | errno == eTIMEDOUT       = TimeExpired\n        | errno == eTOOMANYREFS    = ResourceExhausted\n        | errno == eTXTBSY         = ResourceBusy\n        | errno == eUSERS          = ResourceExhausted\n        | errno == eWOULDBLOCK     = OtherError\n        | errno == eXDEV           = UnsupportedOperation\n        | otherwise                = OtherError\n\nforeign import ccall unsafe \"string.h\" strerror :: Errno -> IO (Ptr CChar)\n\n", "num_lines": 581}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.C.String\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Utilities for primitive marshalling of C strings.\n--\n-- The marshalling converts each Haskell character, representing a Unicode\n-- code point, to one or more bytes in a manner that, by default, is\n-- determined by the current locale.  As a consequence, no guarantees\n-- can be made about the relative length of a Haskell string and its\n-- corresponding C string, and therefore all the marshalling routines\n-- include memory allocation.  The translation between Unicode and the\n-- encoding of the current locale may be lossy.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.C.String (   -- representation of strings in C\n  -- * C strings\n\n  CString,\n  CStringLen,\n\n  -- ** Using a locale-dependent encoding\n\n  -- | These functions are different from their @CAString@ counterparts\n  -- in that they will use an encoding determined by the current locale,\n  -- rather than always assuming ASCII.\n\n  -- conversion of C strings into Haskell strings\n  --\n  peekCString,\n  peekCStringLen,\n\n  -- conversion of Haskell strings into C strings\n  --\n  newCString,\n  newCStringLen,\n\n  -- conversion of Haskell strings into C strings using temporary storage\n  --\n  withCString,\n  withCStringLen,\n\n  charIsRepresentable,\n\n  -- ** Using 8-bit characters\n\n  -- | These variants of the above functions are for use with C libraries\n  -- that are ignorant of Unicode.  These functions should be used with\n  -- care, as a loss of information can occur.\n\n  castCharToCChar,\n  castCCharToChar,\n\n  castCharToCUChar,\n  castCUCharToChar,\n  castCharToCSChar,\n  castCSCharToChar,\n\n  peekCAString,\n  peekCAStringLen,\n  newCAString,\n  newCAStringLen,\n  withCAString,\n  withCAStringLen,\n\n  -- * C wide strings\n\n  -- | These variants of the above functions are for use with C libraries\n  -- that encode Unicode using the C @wchar_t@ type in a system-dependent\n  -- way.  The only encodings supported are\n  --\n  -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or\n  --\n  -- * UTF-16 (as used on Windows systems).\n\n  CWString,\n  CWStringLen,\n\n  peekCWString,\n  peekCWStringLen,\n  newCWString,\n  newCWStringLen,\n  withCWString,\n  withCWStringLen,\n\n  ) where\n\nimport Foreign.Marshal.Array\nimport Foreign.C.Types\nimport Foreign.Ptr\nimport Foreign.Storable\n\nimport Data.Word\n\nimport GHC.Char\nimport GHC.List\nimport GHC.Real\nimport GHC.Num\nimport GHC.Base\n\nimport {-# SOURCE #-} GHC.IO.Encoding\nimport qualified GHC.Foreign as GHC\n\n-----------------------------------------------------------------------------\n-- Strings\n\n-- representation of strings in C\n-- ------------------------------\n\n-- | A C string is a reference to an array of C characters terminated by NUL.\ntype CString    = Ptr CChar\n\n-- | A string with explicit length information in bytes instead of a\n-- terminating NUL (allowing NUL characters in the middle of the string).\ntype CStringLen = (Ptr CChar, Int)\n\n-- exported functions\n-- ------------------\n--\n-- * the following routines apply the default conversion when converting the\n--   C-land character encoding into the Haskell-land character encoding\n\n-- | Marshal a NUL terminated C string into a Haskell string.\n--\npeekCString    :: CString -> IO String\npeekCString s = getForeignEncoding >>= flip GHC.peekCString s\n\n-- | Marshal a C string with explicit length into a Haskell string.\n--\npeekCStringLen           :: CStringLen -> IO String\npeekCStringLen s = getForeignEncoding >>= flip GHC.peekCStringLen s\n\n-- | Marshal a Haskell string into a NUL terminated C string.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * new storage is allocated for the C string and must be\n--   explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCString :: String -> IO CString\nnewCString s = getForeignEncoding >>= flip GHC.newCString s\n\n-- | Marshal a Haskell string into a C string (ie, character array) with\n-- explicit length information.\n--\n-- * new storage is allocated for the C string and must be\n--   explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCStringLen     :: String -> IO CStringLen\nnewCStringLen s = getForeignEncoding >>= flip GHC.newCStringLen s\n\n-- | Marshal a Haskell string into a NUL terminated C string using temporary\n-- storage.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCString :: String -> (CString -> IO a) -> IO a\nwithCString s f = getForeignEncoding >>= \\enc -> GHC.withCString enc s f\n\n-- | Marshal a Haskell string into a C string (ie, character array)\n-- in temporary storage, with explicit length information.\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCStringLen         :: String -> (CStringLen -> IO a) -> IO a\nwithCStringLen s f = getForeignEncoding >>= \\enc -> GHC.withCStringLen enc s f\n\n-- -- | Determines whether a character can be accurately encoded in a 'CString'.\n-- -- Unrepresentable characters are converted to '?' or their nearest visual equivalent.\ncharIsRepresentable :: Char -> IO Bool\ncharIsRepresentable c = getForeignEncoding >>= flip GHC.charIsRepresentable c\n\n-- single byte characters\n-- ----------------------\n--\n--   ** NOTE: These routines don't handle conversions! **\n\n-- | Convert a C byte, representing a Latin-1 character, to the corresponding\n-- Haskell character.\ncastCCharToChar :: CChar -> Char\ncastCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))\n\n-- | Convert a Haskell character to a C character.\n-- This function is only safe on the first 256 characters.\ncastCharToCChar :: Char -> CChar\ncastCharToCChar ch = fromIntegral (ord ch)\n\n-- | Convert a C @unsigned char@, representing a Latin-1 character, to\n-- the corresponding Haskell character.\ncastCUCharToChar :: CUChar -> Char\ncastCUCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))\n\n-- | Convert a Haskell character to a C @unsigned char@.\n-- This function is only safe on the first 256 characters.\ncastCharToCUChar :: Char -> CUChar\ncastCharToCUChar ch = fromIntegral (ord ch)\n\n-- | Convert a C @signed char@, representing a Latin-1 character, to the\n-- corresponding Haskell character.\ncastCSCharToChar :: CSChar -> Char\ncastCSCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))\n\n-- | Convert a Haskell character to a C @signed char@.\n-- This function is only safe on the first 256 characters.\ncastCharToCSChar :: Char -> CSChar\ncastCharToCSChar ch = fromIntegral (ord ch)\n\n-- | Marshal a NUL terminated C string into a Haskell string.\n--\npeekCAString    :: CString -> IO String\npeekCAString cp = do\n  l <- lengthArray0 nUL cp\n  if l <= 0 then return \"\" else loop \"\" (l-1)\n  where\n    loop s i = do\n        xval <- peekElemOff cp i\n        let val = castCCharToChar xval\n        val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)\n\n-- | Marshal a C string with explicit length into a Haskell string.\n--\npeekCAStringLen           :: CStringLen -> IO String\npeekCAStringLen (cp, len)\n  | len <= 0  = return \"\" -- being (too?) nice.\n  | otherwise = loop [] (len-1)\n  where\n    loop acc i = do\n         xval <- peekElemOff cp i\n         let val = castCCharToChar xval\n           -- blow away the coercion ASAP.\n         if (val `seq` (i == 0))\n          then return (val:acc)\n          else loop (val:acc) (i-1)\n\n-- | Marshal a Haskell string into a NUL terminated C string.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * new storage is allocated for the C string and must be\n--   explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCAString :: String -> IO CString\nnewCAString str = do\n  ptr <- mallocArray0 (length str)\n  let\n        go [] n     = pokeElemOff ptr n nUL\n        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)\n  go str 0\n  return ptr\n\n-- | Marshal a Haskell string into a C string (ie, character array) with\n-- explicit length information.\n--\n-- * new storage is allocated for the C string and must be\n--   explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCAStringLen     :: String -> IO CStringLen\nnewCAStringLen str = do\n  ptr <- mallocArray0 len\n  let\n        go [] n     = n `seq` return () -- make it strict in n\n        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)\n  go str 0\n  return (ptr, len)\n  where\n    len = length str\n\n-- | Marshal a Haskell string into a NUL terminated C string using temporary\n-- storage.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCAString :: String -> (CString -> IO a) -> IO a\nwithCAString str f =\n  allocaArray0 (length str) $ \\ptr ->\n      let\n        go [] n     = pokeElemOff ptr n nUL\n        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)\n      in do\n      go str 0\n      f ptr\n\n-- | Marshal a Haskell string into a C string (ie, character array)\n-- in temporary storage, with explicit length information.\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCAStringLen         :: String -> (CStringLen -> IO a) -> IO a\nwithCAStringLen str f    =\n  allocaArray len $ \\ptr ->\n      let\n        go [] n     = n `seq` return () -- make it strict in n\n        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)\n      in do\n      go str 0\n      f (ptr,len)\n  where\n    len = length str\n\n-- auxiliary definitions\n-- ----------------------\n\n-- C's end of string character\n--\nnUL :: CChar\nnUL  = 0\n\n-- allocate an array to hold the list and pair it with the number of elements\nnewArrayLen        :: Storable a => [a] -> IO (Ptr a, Int)\nnewArrayLen xs      = do\n  a <- newArray xs\n  return (a, length xs)\n\n-----------------------------------------------------------------------------\n-- Wide strings\n\n-- representation of wide strings in C\n-- -----------------------------------\n\n-- | A C wide string is a reference to an array of C wide characters\n-- terminated by NUL.\ntype CWString    = Ptr CWchar\n\n-- | A wide character string with explicit length information in 'CWchar's\n-- instead of a terminating NUL (allowing NUL characters in the middle\n-- of the string).\ntype CWStringLen = (Ptr CWchar, Int)\n\n-- | Marshal a NUL terminated C wide string into a Haskell string.\n--\npeekCWString    :: CWString -> IO String\npeekCWString cp  = do\n  cs <- peekArray0 wNUL cp\n  return (cWcharsToChars cs)\n\n-- | Marshal a C wide string with explicit length into a Haskell string.\n--\npeekCWStringLen           :: CWStringLen -> IO String\npeekCWStringLen (cp, len)  = do\n  cs <- peekArray len cp\n  return (cWcharsToChars cs)\n\n-- | Marshal a Haskell string into a NUL terminated C wide string.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * new storage is allocated for the C wide string and must\n--   be explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCWString :: String -> IO CWString\nnewCWString  = newArray0 wNUL . charsToCWchars\n\n-- | Marshal a Haskell string into a C wide string (ie, wide character array)\n-- with explicit length information.\n--\n-- * new storage is allocated for the C wide string and must\n--   be explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCWStringLen     :: String -> IO CWStringLen\nnewCWStringLen str  = newArrayLen (charsToCWchars str)\n\n-- | Marshal a Haskell string into a NUL terminated C wide string using\n-- temporary storage.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCWString :: String -> (CWString -> IO a) -> IO a\nwithCWString  = withArray0 wNUL . charsToCWchars\n\n-- | Marshal a Haskell string into a C wide string (i.e. wide\n-- character array) in temporary storage, with explicit length\n-- information.\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCWStringLen         :: String -> (CWStringLen -> IO a) -> IO a\nwithCWStringLen str f    =\n  withArrayLen (charsToCWchars str) $ \\ len ptr -> f (ptr, len)\n\n-- auxiliary definitions\n-- ----------------------\n\nwNUL :: CWchar\nwNUL = 0\n\ncWcharsToChars :: [CWchar] -> [Char]\ncharsToCWchars :: [Char] -> [CWchar]\n\n#if defined(mingw32_HOST_OS)\n\n-- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.\n\n-- coding errors generate Chars in the surrogate range\ncWcharsToChars = map chr . fromUTF16 . map fromIntegral\n where\n  fromUTF16 (c1:c2:wcs)\n    | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =\n      ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs\n  fromUTF16 (c:wcs) = c : fromUTF16 wcs\n  fromUTF16 [] = []\n\ncharsToCWchars = foldr utf16Char [] . map ord\n where\n  utf16Char c wcs\n    | c < 0x10000 = fromIntegral c : wcs\n    | otherwise   = let c' = c - 0x10000 in\n                    fromIntegral (c' `div` 0x400 + 0xd800) :\n                    fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs\n\n#else /* !mingw32_HOST_OS */\n\ncWcharsToChars xs  = map castCWcharToChar xs\ncharsToCWchars xs  = map castCharToCWchar xs\n\n-- These conversions only make sense if __STDC_ISO_10646__ is defined\n-- (meaning that wchar_t is ISO 10646, aka Unicode)\n\ncastCWcharToChar :: CWchar -> Char\ncastCWcharToChar ch = chr (fromIntegral ch )\n\ncastCharToCWchar :: Char -> CWchar\ncastCharToCWchar ch = fromIntegral (ord ch)\n\n#endif /* !mingw32_HOST_OS */\n\n", "num_lines": 460}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -Wno-unused-binds #-}\n-- XXX -Wno-unused-binds stops us warning about unused constructors,\n-- but really we should just remove them if we don't want them\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.C.Types\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Mapping of C types to corresponding Haskell types.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.C.Types\n        ( -- * Representations of C types\n          -- $ctypes\n\n          -- ** Platform differences\n          -- | This module contains platform specific information about types.\n          --   __/As such the types presented on this page reflect the platform\n          --   on which the documentation was generated and may not coincide with\n          --   the types on your platform./__\n\n          -- ** Integral types\n          -- | These types are represented as @newtype@s of\n          -- types in \"Data.Int\" and \"Data.Word\", and are instances of\n          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',\n          -- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable',\n          -- 'Storable', 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral'\n          -- and 'Bits'.\n          CChar(..),    CSChar(..),   CUChar(..)\n        , CShort(..),   CUShort(..),  CInt(..),      CUInt(..)\n        , CLong(..),    CULong(..)\n        , CPtrdiff(..), CSize(..),    CWchar(..),    CSigAtomic(..)\n        , CLLong(..),   CULLong(..), CBool(..)\n        , CIntPtr(..),  CUIntPtr(..), CIntMax(..),   CUIntMax(..)\n\n          -- ** Numeric types\n          -- | These types are represented as @newtype@s of basic\n          -- foreign types, and are instances of\n          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',\n          -- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable' and\n          -- 'Storable'.\n        , CClock(..),   CTime(..),    CUSeconds(..), CSUSeconds(..)\n\n        -- extracted from CTime, because we don't want this comment in\n        -- the Haskell language reports:\n\n        -- | To convert 'CTime' to 'Data.Time.UTCTime', use the following:\n        --\n        -- > \\t -> posixSecondsToUTCTime (realToFrac t :: POSIXTime)\n        --\n\n          -- ** Floating types\n          -- | These types are represented as @newtype@s of\n          -- 'Prelude.Float' and 'Prelude.Double', and are instances of\n          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',\n          -- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable', 'Storable',\n          -- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating',\n          -- 'Prelude.RealFrac' and 'Prelude.RealFloat'. That does mean\n          -- that `CFloat`'s (respectively `CDouble`'s) instances of\n          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num' and\n          -- 'Prelude.Fractional' are as badly behaved as `Prelude.Float`'s\n          -- (respectively `Prelude.Double`'s).\n        , CFloat(..),   CDouble(..)\n        -- XXX GHC doesn't support CLDouble yet\n        -- , CLDouble(..)\n\n          -- See Note [Exporting constructors of marshallable foreign types]\n          -- in Foreign.Ptr for why the constructors for these newtypes are\n          -- exported.\n\n          -- ** Other types\n\n          -- Instances of: Eq and Storable\n        , CFile,        CFpos,     CJmpBuf\n        ) where\n\nimport Foreign.Storable\nimport Data.Bits        ( Bits(..), FiniteBits(..) )\nimport Data.Int         ( Int8,  Int16,  Int32,  Int64  )\nimport Data.Word        ( Word8, Word16, Word32, Word64 )\n\nimport GHC.Base\nimport GHC.Float\nimport GHC.Enum\nimport GHC.Real\nimport GHC.Show\nimport GHC.Read\nimport GHC.Num\n\n#include \"HsBaseConfig.h\"\n#include \"CTypes.h\"\n\n-- | Haskell type representing the C @char@ type.\nINTEGRAL_TYPE(CChar,HTYPE_CHAR)\n-- | Haskell type representing the C @signed char@ type.\nINTEGRAL_TYPE(CSChar,HTYPE_SIGNED_CHAR)\n-- | Haskell type representing the C @unsigned char@ type.\nINTEGRAL_TYPE(CUChar,HTYPE_UNSIGNED_CHAR)\n\n-- | Haskell type representing the C @short@ type.\nINTEGRAL_TYPE(CShort,HTYPE_SHORT)\n-- | Haskell type representing the C @unsigned short@ type.\nINTEGRAL_TYPE(CUShort,HTYPE_UNSIGNED_SHORT)\n\n-- | Haskell type representing the C @int@ type.\nINTEGRAL_TYPE(CInt,HTYPE_INT)\n-- | Haskell type representing the C @unsigned int@ type.\nINTEGRAL_TYPE(CUInt,HTYPE_UNSIGNED_INT)\n\n-- | Haskell type representing the C @long@ type.\nINTEGRAL_TYPE(CLong,HTYPE_LONG)\n-- | Haskell type representing the C @unsigned long@ type.\nINTEGRAL_TYPE(CULong,HTYPE_UNSIGNED_LONG)\n\n-- | Haskell type representing the C @long long@ type.\nINTEGRAL_TYPE(CLLong,HTYPE_LONG_LONG)\n-- | Haskell type representing the C @unsigned long long@ type.\nINTEGRAL_TYPE(CULLong,HTYPE_UNSIGNED_LONG_LONG)\n\n-- | Haskell type representing the C @bool@ type.\n--\n-- @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CBool,bool,HTYPE_BOOL)\n\n{-# RULES\n\"fromIntegral/a->CChar\"   fromIntegral = \\x -> CChar   (fromIntegral x)\n\"fromIntegral/a->CSChar\"  fromIntegral = \\x -> CSChar  (fromIntegral x)\n\"fromIntegral/a->CUChar\"  fromIntegral = \\x -> CUChar  (fromIntegral x)\n\"fromIntegral/a->CShort\"  fromIntegral = \\x -> CShort  (fromIntegral x)\n\"fromIntegral/a->CUShort\" fromIntegral = \\x -> CUShort (fromIntegral x)\n\"fromIntegral/a->CInt\"    fromIntegral = \\x -> CInt    (fromIntegral x)\n\"fromIntegral/a->CUInt\"   fromIntegral = \\x -> CUInt   (fromIntegral x)\n\"fromIntegral/a->CLong\"   fromIntegral = \\x -> CLong   (fromIntegral x)\n\"fromIntegral/a->CULong\"  fromIntegral = \\x -> CULong  (fromIntegral x)\n\"fromIntegral/a->CLLong\"  fromIntegral = \\x -> CLLong  (fromIntegral x)\n\"fromIntegral/a->CULLong\" fromIntegral = \\x -> CULLong (fromIntegral x)\n\n\"fromIntegral/CChar->a\"   fromIntegral = \\(CChar   x) -> fromIntegral x\n\"fromIntegral/CSChar->a\"  fromIntegral = \\(CSChar  x) -> fromIntegral x\n\"fromIntegral/CUChar->a\"  fromIntegral = \\(CUChar  x) -> fromIntegral x\n\"fromIntegral/CShort->a\"  fromIntegral = \\(CShort  x) -> fromIntegral x\n\"fromIntegral/CUShort->a\" fromIntegral = \\(CUShort x) -> fromIntegral x\n\"fromIntegral/CInt->a\"    fromIntegral = \\(CInt    x) -> fromIntegral x\n\"fromIntegral/CUInt->a\"   fromIntegral = \\(CUInt   x) -> fromIntegral x\n\"fromIntegral/CLong->a\"   fromIntegral = \\(CLong   x) -> fromIntegral x\n\"fromIntegral/CULong->a\"  fromIntegral = \\(CULong  x) -> fromIntegral x\n\"fromIntegral/CLLong->a\"  fromIntegral = \\(CLLong  x) -> fromIntegral x\n\"fromIntegral/CULLong->a\" fromIntegral = \\(CULLong x) -> fromIntegral x\n\"fromIntegral/CBool->a\"   fromIntegral = \\(CBool   x) -> fromIntegral x\n #-}\n\n-- | Haskell type representing the C @float@ type.\nFLOATING_TYPE(CFloat,HTYPE_FLOAT)\n-- | Haskell type representing the C @double@ type.\nFLOATING_TYPE(CDouble,HTYPE_DOUBLE)\n-- XXX GHC doesn't support CLDouble yet\n\n{-# RULES\n\"realToFrac/a->CFloat\"    realToFrac = \\x -> CFloat   (realToFrac x)\n\"realToFrac/a->CDouble\"   realToFrac = \\x -> CDouble  (realToFrac x)\n\n\"realToFrac/CFloat->a\"    realToFrac = \\(CFloat   x) -> realToFrac x\n\"realToFrac/CDouble->a\"   realToFrac = \\(CDouble  x) -> realToFrac x\n #-}\n\n-- GHC doesn't support CLDouble yet\n-- \"realToFrac/a->CLDouble\"  realToFrac = \\x -> CLDouble (realToFrac x)\n-- \"realToFrac/CLDouble->a\"  realToFrac = \\(CLDouble x) -> realToFrac x\n\n-- | Haskell type representing the C @ptrdiff_t@ type.\nINTEGRAL_TYPE(CPtrdiff,HTYPE_PTRDIFF_T)\n-- | Haskell type representing the C @size_t@ type.\nINTEGRAL_TYPE(CSize,HTYPE_SIZE_T)\n-- | Haskell type representing the C @wchar_t@ type.\nINTEGRAL_TYPE(CWchar,HTYPE_WCHAR_T)\n-- | Haskell type representing the C @sig_atomic_t@ type.\nINTEGRAL_TYPE(CSigAtomic,HTYPE_SIG_ATOMIC_T)\n\n{-# RULES\n\"fromIntegral/a->CPtrdiff\"   fromIntegral = \\x -> CPtrdiff   (fromIntegral x)\n\"fromIntegral/a->CSize\"      fromIntegral = \\x -> CSize      (fromIntegral x)\n\"fromIntegral/a->CWchar\"     fromIntegral = \\x -> CWchar     (fromIntegral x)\n\"fromIntegral/a->CSigAtomic\" fromIntegral = \\x -> CSigAtomic (fromIntegral x)\n\n\"fromIntegral/CPtrdiff->a\"   fromIntegral = \\(CPtrdiff   x) -> fromIntegral x\n\"fromIntegral/CSize->a\"      fromIntegral = \\(CSize      x) -> fromIntegral x\n\"fromIntegral/CWchar->a\"     fromIntegral = \\(CWchar     x) -> fromIntegral x\n\"fromIntegral/CSigAtomic->a\" fromIntegral = \\(CSigAtomic x) -> fromIntegral x\n #-}\n\n-- | Haskell type representing the C @clock_t@ type.\nARITHMETIC_TYPE(CClock,HTYPE_CLOCK_T)\n-- | Haskell type representing the C @time_t@ type.\nARITHMETIC_TYPE(CTime,HTYPE_TIME_T)\n-- | Haskell type representing the C @useconds_t@ type.\n--\n-- @since 4.4.0.0\n\nARITHMETIC_TYPE(CUSeconds,HTYPE_USECONDS_T)\n-- | Haskell type representing the C @suseconds_t@ type.\n--\n-- @since 4.4.0.0\nARITHMETIC_TYPE(CSUSeconds,HTYPE_SUSECONDS_T)\n\n-- FIXME: Implement and provide instances for Eq and Storable\n-- | Haskell type representing the C @FILE@ type.\ndata CFile = CFile\n-- | Haskell type representing the C @fpos_t@ type.\ndata CFpos = CFpos\n-- | Haskell type representing the C @jmp_buf@ type.\ndata CJmpBuf = CJmpBuf\n\nINTEGRAL_TYPE(CIntPtr,HTYPE_INTPTR_T)\nINTEGRAL_TYPE(CUIntPtr,HTYPE_UINTPTR_T)\nINTEGRAL_TYPE(CIntMax,HTYPE_INTMAX_T)\nINTEGRAL_TYPE(CUIntMax,HTYPE_UINTMAX_T)\n\n{-# RULES\n\"fromIntegral/a->CIntPtr\"  fromIntegral = \\x -> CIntPtr  (fromIntegral x)\n\"fromIntegral/a->CUIntPtr\" fromIntegral = \\x -> CUIntPtr (fromIntegral x)\n\"fromIntegral/a->CIntMax\"  fromIntegral = \\x -> CIntMax  (fromIntegral x)\n\"fromIntegral/a->CUIntMax\" fromIntegral = \\x -> CUIntMax (fromIntegral x)\n #-}\n\n-- C99 types which are still missing include:\n-- wint_t, wctrans_t, wctype_t\n\n{- $ctypes\n\nThese types are needed to accurately represent C function prototypes,\nin order to access C library interfaces in Haskell.  The Haskell system\nis not required to represent those types exactly as C does, but the\nfollowing guarantees are provided concerning a Haskell type @CT@\nrepresenting a C type @t@:\n\n* If a C function prototype has @t@ as an argument or result type, the\n  use of @CT@ in the corresponding position in a foreign declaration\n  permits the Haskell program to access the full range of values encoded\n  by the C type; and conversely, any Haskell value for @CT@ has a valid\n  representation in C.\n\n* @'sizeOf' ('Prelude.undefined' :: CT)@ will yield the same value as\n  @sizeof (t)@ in C.\n\n* @'alignment' ('Prelude.undefined' :: CT)@ matches the alignment\n  constraint enforced by the C implementation for @t@.\n\n* The members 'peek' and 'poke' of the 'Storable' class map all values\n  of @CT@ to the corresponding value of @t@ and vice versa.\n\n* When an instance of 'Prelude.Bounded' is defined for @CT@, the values\n  of 'Prelude.minBound' and 'Prelude.maxBound' coincide with @t_MIN@\n  and @t_MAX@ in C.\n\n* When an instance of 'Prelude.Eq' or 'Prelude.Ord' is defined for @CT@,\n  the predicates defined by the type class implement the same relation\n  as the corresponding predicate in C on @t@.\n\n* When an instance of 'Prelude.Num', 'Prelude.Read', 'Prelude.Integral',\n  'Prelude.Fractional', 'Prelude.Floating', 'Prelude.RealFrac', or\n  'Prelude.RealFloat' is defined for @CT@, the arithmetic operations\n  defined by the type class implement the same function as the\n  corresponding arithmetic operations (if available) in C on @t@.\n\n* When an instance of 'Bits' is defined for @CT@, the bitwise operation\n  defined by the type class implement the same function as the\n  corresponding bitwise operation in C on @t@.\n\n-}\n\n", "num_lines": 285}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.ForeignPtr.Imp\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The 'ForeignPtr' type and operations.  This module is part of the\n-- Foreign Function Interface (FFI) and will usually be imported via\n-- the \"Foreign\" module.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.ForeignPtr.Imp\n        ( \n        -- * Finalised data pointers\n          ForeignPtr\n        , FinalizerPtr\n        , FinalizerEnvPtr\n\n        -- ** Basic operations\n        , newForeignPtr\n        , newForeignPtr_\n        , addForeignPtrFinalizer\n        , newForeignPtrEnv\n        , addForeignPtrFinalizerEnv\n        , withForeignPtr\n        , finalizeForeignPtr\n\n        -- ** Low-level operations\n        , unsafeForeignPtrToPtr\n        , touchForeignPtr\n        , castForeignPtr\n        , plusForeignPtr\n\n        -- ** Allocating managed memory\n        , mallocForeignPtr\n        , mallocForeignPtrBytes\n        , mallocForeignPtrArray\n        , mallocForeignPtrArray0\n        ) \n        where\n\nimport Foreign.Ptr\nimport Foreign.Storable ( Storable(sizeOf) )\n\nimport GHC.Base\nimport GHC.Num\nimport GHC.ForeignPtr\n\nnewForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)\n-- ^Turns a plain memory reference into a foreign pointer, and\n-- associates a finalizer with the reference.  The finalizer will be\n-- executed after the last reference to the foreign object is dropped.\n-- There is no guarantee of promptness, however the finalizer will be\n-- executed before the program exits.\nnewForeignPtr finalizer p\n  = do fObj <- newForeignPtr_ p\n       addForeignPtrFinalizer finalizer fObj\n       return fObj\n\nwithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b\n-- ^This is a way to look at the pointer living inside a\n-- foreign object.  This function takes a function which is\n-- applied to that pointer. The resulting 'IO' action is then\n-- executed. The foreign object is kept alive at least during\n-- the whole action, even if it is not used directly\n-- inside. Note that it is not safe to return the pointer from\n-- the action and use it after the action completes. All uses\n-- of the pointer should be inside the\n-- 'withForeignPtr' bracket.  The reason for\n-- this unsafeness is the same as for\n-- 'unsafeForeignPtrToPtr' below: the finalizer\n-- may run earlier than expected, because the compiler can only\n-- track usage of the 'ForeignPtr' object, not\n-- a 'Ptr' object made from it.\n--\n-- This function is normally used for marshalling data to\n-- or from the object pointed to by the\n-- 'ForeignPtr', using the operations from the\n-- 'Storable' class.\nwithForeignPtr fo io\n  = do r <- io (unsafeForeignPtrToPtr fo)\n       touchForeignPtr fo\n       return r\n\n-- | This variant of 'newForeignPtr' adds a finalizer that expects an\n-- environment in addition to the finalized pointer.  The environment\n-- that will be passed to the finalizer is fixed by the second argument to\n-- 'newForeignPtrEnv'.\nnewForeignPtrEnv ::\n    FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)\nnewForeignPtrEnv finalizer env p\n  = do fObj <- newForeignPtr_ p\n       addForeignPtrFinalizerEnv finalizer env fObj\n       return fObj\n\n-- | This function is similar to 'Foreign.Marshal.Array.mallocArray',\n-- but yields a memory area that has a finalizer attached that releases\n-- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that\n-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.\nmallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)\nmallocForeignPtrArray  = doMalloc undefined\n  where\n    doMalloc            :: Storable b => b -> Int -> IO (ForeignPtr b)\n    doMalloc dummy size  = mallocForeignPtrBytes (size * sizeOf dummy)\n\n-- | This function is similar to 'Foreign.Marshal.Array.mallocArray0',\n-- but yields a memory area that has a finalizer attached that releases\n-- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that\n-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.\nmallocForeignPtrArray0      :: Storable a => Int -> IO (ForeignPtr a)\nmallocForeignPtrArray0 size  = mallocForeignPtrArray (size + 1)\n\n", "num_lines": 122}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.ForeignPtr.Safe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The 'ForeignPtr' type and operations.  This module is part of the\n-- Foreign Function Interface (FFI) and will usually be imported via\n-- the \"Foreign\" module.\n--\n-- Safe API Only.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.ForeignPtr.Safe {-# DEPRECATED \"Safe is now the default, please use Foreign.ForeignPtr instead\" #-} (\n        -- * Finalised data pointers\n          ForeignPtr\n        , FinalizerPtr\n        , FinalizerEnvPtr\n\n        -- ** Basic operations\n        , newForeignPtr\n        , newForeignPtr_\n        , addForeignPtrFinalizer\n        , newForeignPtrEnv\n        , addForeignPtrFinalizerEnv\n        , withForeignPtr\n        , finalizeForeignPtr\n\n        -- ** Low-level operations\n        , touchForeignPtr\n        , castForeignPtr\n\n        -- ** Allocating managed memory\n        , mallocForeignPtr\n        , mallocForeignPtrBytes\n        , mallocForeignPtrArray\n        , mallocForeignPtrArray0\n    ) where\n\nimport Foreign.ForeignPtr.Imp\n\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.ForeignPtr.Unsafe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The 'ForeignPtr' type and operations.  This module is part of the\n-- Foreign Function Interface (FFI) and will usually be imported via\n-- the \"Foreign\" module.\n--\n-- Unsafe API Only.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.ForeignPtr.Unsafe (\n        -- ** Unsafe low-level operations\n        unsafeForeignPtrToPtr,\n    ) where\n\nimport Foreign.ForeignPtr.Imp\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples,\n             ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal.Alloc\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The module \"Foreign.Marshal.Alloc\" provides operations to allocate and\n-- deallocate blocks of raw memory (i.e., unstructured chunks of memory\n-- outside of the area maintained by the Haskell storage manager).  These\n-- memory blocks are commonly used to pass compound data structures to\n-- foreign functions or to provide space in which compound result values\n-- are obtained from foreign functions.\n-- \n-- If any of the allocation functions fails, an exception is thrown.\n-- In some cases, memory exhaustion may mean the process is terminated.\n-- If 'free' or 'reallocBytes' is applied to a memory area\n-- that has been allocated with 'alloca' or 'allocaBytes', the\n-- behaviour is undefined.  Any further access to memory areas allocated with\n-- 'alloca' or 'allocaBytes', after the computation that was passed to\n-- the allocation function has terminated, leads to undefined behaviour.  Any\n-- further access to the memory area referenced by a pointer passed to\n-- 'realloc', 'reallocBytes', or 'free' entails undefined\n-- behaviour.\n-- \n-- All storage allocated by functions that allocate based on a /size in bytes/\n-- must be sufficiently aligned for any of the basic foreign types\n-- that fits into the newly allocated storage. All storage allocated by\n-- functions that allocate based on a specific type must be sufficiently\n-- aligned for that type. Array allocation routines need to obey the same\n-- alignment constraints for each array element.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Marshal.Alloc (\n  -- * Memory allocation\n  -- ** Local allocation\n  alloca,\n  allocaBytes,\n  allocaBytesAligned,\n\n  -- ** Dynamic allocation\n  malloc,\n  mallocBytes,\n\n  calloc,\n  callocBytes,\n\n  realloc,\n  reallocBytes,\n\n  free,\n  finalizerFree\n) where\n\nimport Data.Maybe\nimport Foreign.C.Types          ( CSize(..) )\nimport Foreign.Storable         ( Storable(sizeOf,alignment) )\nimport Foreign.ForeignPtr       ( FinalizerPtr )\nimport GHC.IO.Exception\nimport GHC.Real\nimport GHC.Ptr\nimport GHC.Base\n\n-- exported functions\n-- ------------------\n\n-- |Allocate a block of memory that is sufficient to hold values of type\n-- @a@.  The size of the area allocated is determined by the 'sizeOf'\n-- method from the instance of 'Storable' for the appropriate type.\n--\n-- The memory may be deallocated using 'free' or 'finalizerFree' when\n-- no longer required.\n--\n{-# INLINE malloc #-}\nmalloc :: forall a . Storable a => IO (Ptr a)\nmalloc  = mallocBytes (sizeOf (undefined :: a))\n\n-- |Like 'malloc' but memory is filled with bytes of value zero.\n--\n{-# INLINE calloc #-}\ncalloc :: forall a . Storable a => IO (Ptr a)\ncalloc = callocBytes (sizeOf (undefined :: a))\n\n-- |Allocate a block of memory of the given number of bytes.\n-- The block of memory is sufficiently aligned for any of the basic\n-- foreign types that fits into a memory block of the allocated size.\n--\n-- The memory may be deallocated using 'free' or 'finalizerFree' when\n-- no longer required.\n--\nmallocBytes      :: Int -> IO (Ptr a)\nmallocBytes size  = failWhenNULL \"malloc\" (_malloc (fromIntegral size))\n\n-- |Llike 'mallocBytes' but memory is filled with bytes of value zero.\n--\ncallocBytes :: Int -> IO (Ptr a)\ncallocBytes size = failWhenNULL \"calloc\" $ _calloc 1 (fromIntegral size)\n\n-- |@'alloca' f@ executes the computation @f@, passing as argument\n-- a pointer to a temporarily allocated block of memory sufficient to\n-- hold values of type @a@.\n--\n-- The memory is freed when @f@ terminates (either normally or via an\n-- exception), so the pointer passed to @f@ must /not/ be used after this.\n--\n{-# INLINE alloca #-}\nalloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b\nalloca  =\n  allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a))\n\n-- Note [NOINLINE for touch#]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously\n-- fragile in the presence of simplification (see #14346). In particular, the\n-- simplifier may drop the continuation containing the touch# if it can prove\n-- that the action passed to allocaBytes will not return. The hack introduced to\n-- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the\n-- simplifier can't see the divergence.\n--\n-- These can be removed once #14375 is fixed, which suggests that we instead do\n-- away with touch# in favor of a primitive that will capture the scoping left\n-- implicit in the case of touch#.\n\n-- |@'allocaBytes' n f@ executes the computation @f@, passing as argument\n-- a pointer to a temporarily allocated block of memory of @n@ bytes.\n-- The block of memory is sufficiently aligned for any of the basic\n-- foreign types that fits into a memory block of the allocated size.\n--\n-- The memory is freed when @f@ terminates (either normally or via an\n-- exception), so the pointer passed to @f@ must /not/ be used after this.\n--\nallocaBytes :: Int -> (Ptr a -> IO b) -> IO b\nallocaBytes (I# size) action = IO $ \\ s0 ->\n     case newPinnedByteArray# size s0      of { (# s1, mbarr# #) ->\n     case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr#  #) ->\n     let addr = Ptr (byteArrayContents# barr#) in\n     case action addr     of { IO action' ->\n     case action' s2      of { (# s3, r #) ->\n     case touch# barr# s3 of { s4 ->\n     (# s4, r #)\n  }}}}}\n-- See Note [NOINLINE for touch#]\n{-# NOINLINE allocaBytes #-}\n\nallocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b\nallocaBytesAligned (I# size) (I# align) action = IO $ \\ s0 ->\n     case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->\n     case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr#  #) ->\n     let addr = Ptr (byteArrayContents# barr#) in\n     case action addr     of { IO action' ->\n     case action' s2      of { (# s3, r #) ->\n     case touch# barr# s3 of { s4 ->\n     (# s4, r #)\n  }}}}}\n-- See Note [NOINLINE for touch#]\n{-# NOINLINE allocaBytesAligned #-}\n\n-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'\n-- to the size needed to store values of type @b@.  The returned pointer\n-- may refer to an entirely different memory area, but will be suitably\n-- aligned to hold values of type @b@.  The contents of the referenced\n-- memory area will be the same as of the original pointer up to the\n-- minimum of the original size and the size of values of type @b@.\n--\n-- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like\n-- 'malloc'.\n--\nrealloc :: forall a b . Storable b => Ptr a -> IO (Ptr b)\nrealloc ptr = failWhenNULL \"realloc\" (_realloc ptr size)\n  where\n    size = fromIntegral (sizeOf (undefined :: b))\n\n-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'\n-- to the given size.  The returned pointer may refer to an entirely\n-- different memory area, but will be sufficiently aligned for any of the\n-- basic foreign types that fits into a memory block of the given size.\n-- The contents of the referenced memory area will be the same as of\n-- the original pointer up to the minimum of the original size and the\n-- given size.\n--\n-- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'\n-- behaves like 'malloc'.  If the requested size is 0, 'reallocBytes'\n-- behaves like 'free'.\n--\nreallocBytes          :: Ptr a -> Int -> IO (Ptr a)\nreallocBytes ptr 0     = do free ptr; return nullPtr\nreallocBytes ptr size  = \n  failWhenNULL \"realloc\" (_realloc ptr (fromIntegral size))\n\n-- |Free a block of memory that was allocated with 'malloc',\n-- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'\n-- or any of the @new@/X/ functions in \"Foreign.Marshal.Array\" or\n-- \"Foreign.C.String\".\n--\nfree :: Ptr a -> IO ()\nfree  = _free\n\n\n-- auxiliary routines\n-- -------------------\n\n-- asserts that the pointer returned from the action in the second argument is\n-- non-null\n--\nfailWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)\nfailWhenNULL name f = do\n   addr <- f\n   if addr == nullPtr\n      then ioError (IOError Nothing ResourceExhausted name \n                                        \"out of memory\" Nothing Nothing)\n      else return addr\n\n-- basic C routines needed for memory allocation\n--\nforeign import ccall unsafe \"stdlib.h malloc\"  _malloc  ::          CSize -> IO (Ptr a)\nforeign import ccall unsafe \"stdlib.h calloc\"  _calloc  :: CSize -> CSize -> IO (Ptr a)\nforeign import ccall unsafe \"stdlib.h realloc\" _realloc :: Ptr a -> CSize -> IO (Ptr b)\nforeign import ccall unsafe \"stdlib.h free\"    _free    :: Ptr a -> IO ()\n\n-- | A pointer to a foreign function equivalent to 'free', which may be\n-- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage\n-- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.\nforeign import ccall unsafe \"stdlib.h &free\" finalizerFree :: FinalizerPtr a\n\n", "num_lines": 233}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal.Array\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Marshalling support: routines allocating, storing, and retrieving Haskell\n-- lists that are represented as arrays in the foreign language\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Marshal.Array (\n  -- * Marshalling arrays\n\n  -- ** Allocation\n  --\n  mallocArray,\n  mallocArray0,\n\n  allocaArray,\n  allocaArray0,\n\n  reallocArray,\n  reallocArray0,\n\n  callocArray,\n  callocArray0,\n\n  -- ** Marshalling\n  --\n  peekArray,\n  peekArray0,\n\n  pokeArray,\n  pokeArray0,\n\n  -- ** Combined allocation and marshalling\n  --\n  newArray,\n  newArray0,\n\n  withArray,\n  withArray0,\n\n  withArrayLen,\n  withArrayLen0,\n\n  -- ** Copying\n\n  -- | (argument order: destination, source)\n  copyArray,\n  moveArray,\n\n  -- ** Finding the length\n  --\n  lengthArray0,\n\n  -- ** Indexing\n  --\n  advancePtr,\n) where\n\nimport Foreign.Ptr      (Ptr, plusPtr)\nimport Foreign.Storable (Storable(alignment,sizeOf,peekElemOff,pokeElemOff))\nimport Foreign.Marshal.Alloc (mallocBytes, callocBytes, allocaBytesAligned, reallocBytes)\nimport Foreign.Marshal.Utils (copyBytes, moveBytes)\n\nimport GHC.Num\nimport GHC.List\nimport GHC.Base\n\n-- allocation\n-- ----------\n\n-- |Allocate storage for the given number of elements of a storable type\n-- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements).\n--\nmallocArray :: forall a . Storable a => Int -> IO (Ptr a)\nmallocArray  size = mallocBytes (size * sizeOf (undefined :: a))\n\n-- |Like 'mallocArray', but add an extra position to hold a special\n-- termination element.\n--\nmallocArray0      :: Storable a => Int -> IO (Ptr a)\nmallocArray0 size  = mallocArray (size + 1)\n\n-- |Like 'mallocArray', but allocated memory is filled with bytes of value zero.\n--\ncallocArray :: forall a . Storable a => Int -> IO (Ptr a)\ncallocArray size = callocBytes (size * sizeOf (undefined :: a))\n\n-- |Like 'callocArray0', but allocated memory is filled with bytes of value\n-- zero.\n--\ncallocArray0 :: Storable a => Int -> IO (Ptr a)\ncallocArray0 size  = callocArray (size + 1)\n\n-- |Temporarily allocate space for the given number of elements\n-- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements).\n--\nallocaArray :: forall a b . Storable a => Int -> (Ptr a -> IO b) -> IO b\nallocaArray size = allocaBytesAligned (size * sizeOf (undefined :: a))\n                                      (alignment (undefined :: a))\n\n-- |Like 'allocaArray', but add an extra position to hold a special\n-- termination element.\n--\nallocaArray0      :: Storable a => Int -> (Ptr a -> IO b) -> IO b\nallocaArray0 size  = allocaArray (size + 1)\n{-# INLINE allocaArray0 #-}\n  -- needed to get allocaArray to inline into withCString, for unknown\n  -- reasons --SDM 23/4/2010, see #4004 for benchmark\n\n-- |Adjust the size of an array\n--\nreallocArray :: forall a . Storable a => Ptr a -> Int -> IO (Ptr a)\nreallocArray ptr size = reallocBytes ptr (size * sizeOf (undefined :: a))\n\n-- |Adjust the size of an array including an extra position for the end marker.\n--\nreallocArray0          :: Storable a => Ptr a -> Int -> IO (Ptr a)\nreallocArray0 ptr size  = reallocArray ptr (size + 1)\n\n\n-- marshalling\n-- -----------\n\n-- |Convert an array of given length into a Haskell list.  The implementation\n-- is tail-recursive and so uses constant stack space.\n--\npeekArray          :: Storable a => Int -> Ptr a -> IO [a]\npeekArray size ptr | size <= 0 = return []\n                 | otherwise = f (size-1) []\n  where\n    f 0 acc = do e <- peekElemOff ptr 0; return (e:acc)\n    f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc)\n\n-- |Convert an array terminated by the given end marker into a Haskell list\n--\npeekArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO [a]\npeekArray0 marker ptr  = do\n  size <- lengthArray0 marker ptr\n  peekArray size ptr\n\n-- |Write the list elements consecutive into memory\n--\npokeArray :: Storable a => Ptr a -> [a] -> IO ()\npokeArray ptr vals0 = go vals0 0#\n  where go [] _          = return ()\n        go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)\n\n-- |Write the list elements consecutive into memory and terminate them with the\n-- given marker element\n--\npokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO ()\npokeArray0 marker ptr vals0 = go vals0 0#\n  where go [] n#         = pokeElemOff ptr (I# n#) marker\n        go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)\n\n-- combined allocation and marshalling\n-- -----------------------------------\n\n-- |Write a list of storable elements into a newly allocated, consecutive\n-- sequence of storable values\n-- (like 'Foreign.Marshal.Utils.new', but for multiple elements).\n--\nnewArray      :: Storable a => [a] -> IO (Ptr a)\nnewArray vals  = do\n  ptr <- mallocArray (length vals)\n  pokeArray ptr vals\n  return ptr\n\n-- |Write a list of storable elements into a newly allocated, consecutive\n-- sequence of storable values, where the end is fixed by the given end marker\n--\nnewArray0             :: Storable a => a -> [a] -> IO (Ptr a)\nnewArray0 marker vals  = do\n  ptr <- mallocArray0 (length vals)\n  pokeArray0 marker ptr vals\n  return ptr\n\n-- |Temporarily store a list of storable values in memory\n-- (like 'Foreign.Marshal.Utils.with', but for multiple elements).\n--\nwithArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b\nwithArray vals = withArrayLen vals . const\n\n-- |Like 'withArray', but the action gets the number of values\n-- as an additional parameter\n--\nwithArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b\nwithArrayLen vals f  =\n  allocaArray len $ \\ptr -> do\n      pokeArray ptr vals\n      f len ptr\n  where\n    len = length vals\n\n-- |Like 'withArray', but a terminator indicates where the array ends\n--\nwithArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b\nwithArray0 marker vals = withArrayLen0 marker vals . const\n\n-- |Like 'withArrayLen', but a terminator indicates where the array ends\n--\nwithArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b\nwithArrayLen0 marker vals f  =\n  allocaArray0 len $ \\ptr -> do\n      pokeArray0 marker ptr vals\n      res <- f len ptr\n      return res\n  where\n    len = length vals\n\n\n-- copying (argument order: destination, source)\n-- -------\n\n-- |Copy the given number of elements from the second array (source) into the\n-- first array (destination); the copied areas may /not/ overlap\n--\ncopyArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()\ncopyArray dest src size = copyBytes dest src (size * sizeOf (undefined :: a))\n\n-- |Copy the given number of elements from the second array (source) into the\n-- first array (destination); the copied areas /may/ overlap\n--\nmoveArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()\nmoveArray  dest src size = moveBytes dest src (size * sizeOf (undefined :: a))\n\n\n-- finding the length\n-- ------------------\n\n-- |Return the number of elements in an array, excluding the terminator\n--\nlengthArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO Int\nlengthArray0 marker ptr  = loop 0\n  where\n    loop i = do\n        val <- peekElemOff ptr i\n        if val == marker then return i else loop (i+1)\n\n\n-- indexing\n-- --------\n\n-- |Advance a pointer into an array by the given number of elements\n--\nadvancePtr :: forall a . Storable a => Ptr a -> Int -> Ptr a\nadvancePtr ptr i = ptr `plusPtr` (i * sizeOf (undefined :: a))\n", "num_lines": 259}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal.Error\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Routines for testing return values and raising a 'userError' exception\n-- in case of values indicating an error state.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Marshal.Error (\n  throwIf,\n  throwIf_,\n  throwIfNeg,\n  throwIfNeg_,\n  throwIfNull,\n\n  -- Discard return value\n  --\n  void\n) where\n\nimport Foreign.Ptr\n\nimport GHC.Base\nimport GHC.Num\nimport GHC.IO.Exception\n\n-- exported functions\n-- ------------------\n\n-- |Execute an 'IO' action, throwing a 'userError' if the predicate yields\n-- 'True' when applied to the result returned by the 'IO' action.\n-- If no exception is raised, return the result of the computation.\n--\nthrowIf :: (a -> Bool)  -- ^ error condition on the result of the 'IO' action\n        -> (a -> String) -- ^ computes an error message from erroneous results\n                        -- of the 'IO' action\n        -> IO a         -- ^ the 'IO' action to be executed\n        -> IO a\nthrowIf pred msgfct act  = \n  do\n    res <- act\n    (if pred res then ioError . userError . msgfct else return) res\n\n-- |Like 'throwIf', but discarding the result\n--\nthrowIf_                 :: (a -> Bool) -> (a -> String) -> IO a -> IO ()\nthrowIf_ pred msgfct act  = void $ throwIf pred msgfct act\n\n-- |Guards against negative result values\n--\nthrowIfNeg :: (Ord a, Num a) => (a -> String) -> IO a -> IO a\nthrowIfNeg  = throwIf (< 0)\n\n-- |Like 'throwIfNeg', but discarding the result\n--\nthrowIfNeg_ :: (Ord a, Num a) => (a -> String) -> IO a -> IO ()\nthrowIfNeg_  = throwIf_ (< 0)\n\n-- |Guards against null pointers\n--\nthrowIfNull :: String -> IO (Ptr a) -> IO (Ptr a)\nthrowIfNull  = throwIf (== nullPtr) . const\n\n-- |Discard the return value of an 'IO' action\n--\nvoid     :: IO a -> IO ()\nvoid act  = act >> return ()\n{-# DEPRECATED void \"use 'Control.Monad.void' instead\" #-} -- deprecated in 7.6\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables #-}\n\n--------------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal.Pool\n-- Copyright   :  (c) Sven Panne 2002-2004\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  sven.panne@aedion.de\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- This module contains support for pooled memory management. Under this scheme,\n-- (re-)allocations belong to a given pool, and everything in a pool is\n-- deallocated when the pool itself is deallocated. This is useful when\n-- 'Foreign.Marshal.Alloc.alloca' with its implicit allocation and deallocation\n-- is not flexible enough, but explicit uses of 'Foreign.Marshal.Alloc.malloc'\n-- and 'free' are too awkward.\n--\n--------------------------------------------------------------------------------\n\nmodule Foreign.Marshal.Pool (\n   -- * Pool management\n   Pool,\n   newPool,\n   freePool,\n   withPool,\n\n   -- * (Re-)Allocation within a pool\n   pooledMalloc,\n   pooledMallocBytes,\n\n   pooledRealloc,\n   pooledReallocBytes,\n\n   pooledMallocArray,\n   pooledMallocArray0,\n\n   pooledReallocArray,\n   pooledReallocArray0,\n\n   -- * Combined allocation and marshalling\n   pooledNew,\n   pooledNewArray,\n   pooledNewArray0\n) where\n\nimport GHC.Base              ( Int, Monad(..), (.), liftM, not )\nimport GHC.Err               ( undefined )\nimport GHC.Exception         ( throw )\nimport GHC.IO                ( IO, mask, catchAny )\nimport GHC.IORef             ( IORef, newIORef, readIORef, writeIORef )\nimport GHC.List              ( elem, length )\nimport GHC.Num               ( Num(..) )\n\nimport Data.OldList          ( delete )\nimport Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free )\nimport Foreign.Marshal.Array ( pokeArray, pokeArray0 )\nimport Foreign.Marshal.Error ( throwIf )\nimport Foreign.Ptr           ( Ptr, castPtr )\nimport Foreign.Storable      ( Storable(sizeOf, poke) )\n\n--------------------------------------------------------------------------------\n\n-- To avoid non-H2010 stuff like existentially quantified data constructors, we\n-- simply use pointers to () below. Not very nice, but...\n\n-- | A memory pool.\n\nnewtype Pool = Pool (IORef [Ptr ()])\n\n-- | Allocate a fresh memory pool.\n\nnewPool :: IO Pool\nnewPool = liftM Pool (newIORef [])\n\n-- | Deallocate a memory pool and everything which has been allocated in the\n-- pool itself.\n\nfreePool :: Pool -> IO ()\nfreePool (Pool pool) = readIORef pool >>= freeAll\n   where freeAll []     = return ()\n         freeAll (p:ps) = free p >> freeAll ps\n\n-- | Execute an action with a fresh memory pool, which gets automatically\n-- deallocated (including its contents) after the action has finished.\n\nwithPool :: (Pool -> IO b) -> IO b\nwithPool act =   -- ATTENTION: cut-n-paste from Control.Exception below!\n   mask (\\restore -> do\n      pool <- newPool\n      val <- catchAny\n                (restore (act pool))\n                (\\e -> do freePool pool; throw e)\n      freePool pool\n      return val)\n\n--------------------------------------------------------------------------------\n\n-- | Allocate space for storable type in the given pool. The size of the area\n-- allocated is determined by the 'sizeOf' method from the instance of\n-- 'Storable' for the appropriate type.\n\npooledMalloc :: forall a . Storable a => Pool -> IO (Ptr a)\npooledMalloc pool = pooledMallocBytes pool (sizeOf (undefined :: a))\n\n-- | Allocate the given number of bytes of storage in the pool.\n\npooledMallocBytes :: Pool -> Int -> IO (Ptr a)\npooledMallocBytes (Pool pool) size = do\n   ptr <- mallocBytes size\n   ptrs <- readIORef pool\n   writeIORef pool (ptr:ptrs)\n   return (castPtr ptr)\n\n-- | Adjust the storage area for an element in the pool to the given size of\n-- the required type.\n\npooledRealloc :: forall a . Storable a => Pool -> Ptr a -> IO (Ptr a)\npooledRealloc pool ptr = pooledReallocBytes pool ptr (sizeOf (undefined :: a))\n\n-- | Adjust the storage area for an element in the pool to the given size.\n\npooledReallocBytes :: Pool -> Ptr a -> Int -> IO (Ptr a)\npooledReallocBytes (Pool pool) ptr size = do\n   let cPtr = castPtr ptr\n   _ <- throwIf (not . (cPtr `elem`)) (\\_ -> \"pointer not in pool\") (readIORef pool)\n   newPtr <- reallocBytes cPtr size\n   ptrs <- readIORef pool\n   writeIORef pool (newPtr : delete cPtr ptrs)\n   return (castPtr newPtr)\n\n-- | Allocate storage for the given number of elements of a storable type in the\n-- pool.\n\npooledMallocArray :: forall a . Storable a => Pool -> Int -> IO (Ptr a)\npooledMallocArray pool size =\n    pooledMallocBytes pool (size * sizeOf (undefined :: a))\n\n-- | Allocate storage for the given number of elements of a storable type in the\n-- pool, but leave room for an extra element to signal the end of the array.\n\npooledMallocArray0 :: Storable a => Pool -> Int -> IO (Ptr a)\npooledMallocArray0 pool size =\n   pooledMallocArray pool (size + 1)\n\n-- | Adjust the size of an array in the given pool.\n\npooledReallocArray :: forall a . Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)\npooledReallocArray pool ptr size =\n    pooledReallocBytes pool ptr (size * sizeOf (undefined :: a))\n\n-- | Adjust the size of an array with an end marker in the given pool.\n\npooledReallocArray0 :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)\npooledReallocArray0 pool ptr size =\n   pooledReallocArray pool ptr (size + 1)\n\n--------------------------------------------------------------------------------\n\n-- | Allocate storage for a value in the given pool and marshal the value into\n-- this storage.\n\npooledNew :: Storable a => Pool -> a -> IO (Ptr a)\npooledNew pool val = do\n   ptr <- pooledMalloc pool\n   poke ptr val\n   return ptr\n\n-- | Allocate consecutive storage for a list of values in the given pool and\n-- marshal these values into it.\n\npooledNewArray :: Storable a => Pool -> [a] -> IO (Ptr a)\npooledNewArray pool vals = do\n   ptr <- pooledMallocArray pool (length vals)\n   pokeArray ptr vals\n   return ptr\n\n-- | Allocate consecutive storage for a list of values in the given pool and\n-- marshal these values into it, terminating the end with the given marker.\n\npooledNewArray0 :: Storable a => Pool -> a -> [a] -> IO (Ptr a)\npooledNewArray0 pool marker vals = do\n   ptr <- pooledMallocArray0 pool (length vals)\n   pokeArray0 marker ptr vals\n   return ptr\n", "num_lines": 188}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal.Safe\n-- Copyright   :  (c) The FFI task force 2003\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Marshalling support\n--\n-- Safe API Only.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Marshal.Safe {-# DEPRECATED \"Safe is now the default, please use Foreign.Marshal instead\" #-}\n        (\n         -- | The module \"Foreign.Marshal.Safe\" re-exports the other modules in the\n         -- @Foreign.Marshal@ hierarchy:\n          module Foreign.Marshal.Alloc\n        , module Foreign.Marshal.Array\n        , module Foreign.Marshal.Error\n        , module Foreign.Marshal.Pool\n        , module Foreign.Marshal.Utils\n        ) where\n\nimport Foreign.Marshal.Alloc\nimport Foreign.Marshal.Array\nimport Foreign.Marshal.Error\nimport Foreign.Marshal.Pool\nimport Foreign.Marshal.Utils\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal.Unsafe\n-- Copyright   :  (c) The FFI task force 2003\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Marshalling support. Unsafe API.\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Marshal.Unsafe (\n        -- * Unsafe functions\n        unsafeLocalState\n    ) where\n\nimport GHC.IO\n\n{- |\nSometimes an external entity is a pure function, except that it passes\narguments and/or results via pointers.  The function\n@unsafeLocalState@ permits the packaging of such entities as pure\nfunctions.  \n\nThe only IO operations allowed in the IO action passed to\n@unsafeLocalState@ are (a) local allocation (@alloca@, @allocaBytes@\nand derived operations such as @withArray@ and @withCString@), and (b)\npointer operations (@Foreign.Storable@ and @Foreign.Ptr@) on the\npointers to local storage, and (c) foreign functions whose only\nobservable effect is to read and/or write the locally allocated\nmemory.  Passing an IO operation that does not obey these rules\nresults in undefined behaviour.\n\nIt is expected that this operation will be\nreplaced in a future revision of Haskell.\n-}\nunsafeLocalState :: IO a -> a\nunsafeLocalState = unsafeDupablePerformIO\n\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Foreign.Marshal.Utils\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Utilities for primitive marshaling\n--\n-----------------------------------------------------------------------------\n\nmodule Foreign.Marshal.Utils (\n  -- * General marshalling utilities\n\n  -- ** Combined allocation and marshalling\n  --\n  with,\n  new,\n\n  -- ** Marshalling of Boolean values (non-zero corresponds to 'True')\n  --\n  fromBool,\n  toBool,\n\n  -- ** Marshalling of Maybe values\n  --\n  maybeNew,\n  maybeWith,\n  maybePeek,\n\n  -- ** Marshalling lists of storable objects\n  --\n  withMany,\n\n  -- ** Haskellish interface to memcpy and memmove\n  -- | (argument order: destination, source)\n  --\n  copyBytes,\n  moveBytes,\n\n  -- ** Filling up memory area with required values\n  --\n  fillBytes,\n) where\n\nimport Data.Maybe\nimport Foreign.Ptr              ( Ptr, nullPtr )\nimport Foreign.Storable         ( Storable(poke) )\nimport Foreign.C.Types          ( CSize(..), CInt(..) )\nimport Foreign.Marshal.Alloc    ( malloc, alloca )\nimport Data.Word                ( Word8 )\n\nimport GHC.Real                 ( fromIntegral )\nimport GHC.Num\nimport GHC.Base\n\n-- combined allocation and marshalling\n-- -----------------------------------\n\n-- |Allocate a block of memory and marshal a value into it\n-- (the combination of 'malloc' and 'poke').\n-- The size of the area allocated is determined by the 'Foreign.Storable.sizeOf'\n-- method from the instance of 'Storable' for the appropriate type.\n--\n-- The memory may be deallocated using 'Foreign.Marshal.Alloc.free' or\n-- 'Foreign.Marshal.Alloc.finalizerFree' when no longer required.\n--\nnew     :: Storable a => a -> IO (Ptr a)\nnew val  = \n  do \n    ptr <- malloc\n    poke ptr val\n    return ptr\n\n-- |@'with' val f@ executes the computation @f@, passing as argument\n-- a pointer to a temporarily allocated block of memory into which\n-- @val@ has been marshalled (the combination of 'alloca' and 'poke').\n--\n-- The memory is freed when @f@ terminates (either normally or via an\n-- exception), so the pointer passed to @f@ must /not/ be used after this.\n--\nwith       :: Storable a => a -> (Ptr a -> IO b) -> IO b\nwith val f  =\n  alloca $ \\ptr -> do\n    poke ptr val\n    res <- f ptr\n    return res\n\n\n-- marshalling of Boolean values (non-zero corresponds to 'True')\n-- -----------------------------\n\n-- |Convert a Haskell 'Bool' to its numeric representation\n--\nfromBool       :: Num a => Bool -> a\nfromBool False  = 0\nfromBool True   = 1\n\n-- |Convert a Boolean in numeric representation to a Haskell value\n--\ntoBool :: (Eq a, Num a) => a -> Bool\ntoBool  = (/= 0)\n\n\n-- marshalling of Maybe values\n-- ---------------------------\n\n-- |Allocate storage and marshal a storable value wrapped into a 'Maybe'\n--\n-- * the 'nullPtr' is used to represent 'Nothing'\n--\nmaybeNew :: (      a -> IO (Ptr b))\n         -> (Maybe a -> IO (Ptr b))\nmaybeNew  = maybe (return nullPtr)\n\n-- |Converts a @withXXX@ combinator into one marshalling a value wrapped\n-- into a 'Maybe', using 'nullPtr' to represent 'Nothing'.\n--\nmaybeWith :: (      a -> (Ptr b -> IO c) -> IO c) \n          -> (Maybe a -> (Ptr b -> IO c) -> IO c)\nmaybeWith  = maybe ($ nullPtr)\n\n-- |Convert a peek combinator into a one returning 'Nothing' if applied to a\n-- 'nullPtr' \n--\nmaybePeek                           :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)\nmaybePeek peek ptr | ptr == nullPtr  = return Nothing\n                   | otherwise       = do a <- peek ptr; return (Just a)\n\n\n-- marshalling lists of storable objects\n-- -------------------------------------\n\n-- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of\n-- marshalled objects\n--\nwithMany :: (a -> (b -> res) -> res)  -- withXXX combinator for one object\n         -> [a]                       -- storable objects\n         -> ([b] -> res)              -- action on list of marshalled obj.s\n         -> res\nwithMany _       []     f = f []\nwithMany withFoo (x:xs) f = withFoo x $ \\x' ->\n                              withMany withFoo xs (\\xs' -> f (x':xs'))\n\n\n-- Haskellish interface to memcpy and memmove\n-- ------------------------------------------\n\n-- |Copies the given number of bytes from the second area (source) into the\n-- first (destination); the copied areas may /not/ overlap\n--\ncopyBytes               :: Ptr a -> Ptr a -> Int -> IO ()\ncopyBytes dest src size  = do _ <- memcpy dest src (fromIntegral size)\n                              return ()\n\n-- |Copies the given number of bytes from the second area (source) into the\n-- first (destination); the copied areas /may/ overlap\n--\nmoveBytes               :: Ptr a -> Ptr a -> Int -> IO ()\nmoveBytes dest src size  = do _ <- memmove dest src (fromIntegral size)\n                              return ()\n\n-- Filling up memory area with required values\n-- -------------------------------------------\n\n-- |Fill a given number of bytes in memory area with a byte value.\n--\n-- @since 4.8.0.0\nfillBytes               :: Ptr a -> Word8 -> Int -> IO ()\nfillBytes dest char size = do\n  _ <- memset dest (fromIntegral char) (fromIntegral size)\n  return ()\n\n-- auxiliary routines\n-- -------------------\n\n-- |Basic C routines needed for memory copying\n--\nforeign import ccall unsafe \"string.h\" memcpy  :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)\nforeign import ccall unsafe \"string.h\" memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)\nforeign import ccall unsafe \"string.h\" memset  :: Ptr a -> CInt  -> CSize -> IO (Ptr a)\n", "num_lines": 188}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, RoleAnnotations #-}\n{-# LANGUAGE BangPatterns #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Arr\n-- Copyright   :  (c) The University of Glasgow, 1994-2000\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- GHC\\'s array implementation.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Arr (\n        Ix(..), Array(..), STArray(..),\n\n        indexError, hopelessIndexError,\n        arrEleBottom, array, listArray,\n        (!), safeRangeSize, negRange, safeIndex, badSafeIndex,\n        bounds, numElements, numElementsSTArray, indices, elems,\n        assocs, accumArray, adjust, (//), accum,\n        amap, ixmap,\n        eqArray, cmpArray, cmpIntArray,\n        newSTArray, boundsSTArray,\n        readSTArray, writeSTArray,\n        freezeSTArray, thawSTArray,\n        foldlElems, foldlElems', foldl1Elems,\n        foldrElems, foldrElems', foldr1Elems,\n\n        -- * Unsafe operations\n        fill, done,\n        unsafeArray, unsafeArray',\n        lessSafeIndex, unsafeAt, unsafeReplace,\n        unsafeAccumArray, unsafeAccumArray', unsafeAccum,\n        unsafeReadSTArray, unsafeWriteSTArray,\n        unsafeFreezeSTArray, unsafeThawSTArray,\n    ) where\n\nimport GHC.Enum\nimport GHC.Num\nimport GHC.ST\nimport GHC.Base\nimport GHC.List\nimport GHC.Real( fromIntegral )\nimport GHC.Show\n\ninfixl 9  !, //\n\ndefault ()\n\n-- | The 'Ix' class is used to map a contiguous subrange of values in\n-- a type onto integers.  It is used primarily for array indexing\n-- (see the array package).\n--\n-- The first argument @(l,u)@ of each of these operations is a pair\n-- specifying the lower and upper bounds of a contiguous subrange of values.\n--\n-- An implementation is entitled to assume the following laws about these\n-- operations:\n--\n-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@ @ @\n--\n-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@\n--\n-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@ @ @\n--\n-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@ @ @\n--\nclass (Ord a) => Ix a where\n    {-# MINIMAL range, (index | unsafeIndex), inRange #-}\n\n    -- | The list of values in the subrange defined by a bounding pair.\n    range               :: (a,a) -> [a]\n    -- | The position of a subscript in the subrange.\n    index               :: (a,a) -> a -> Int\n    -- | Like 'index', but without checking that the value is in range.\n    unsafeIndex         :: (a,a) -> a -> Int\n    -- | Returns 'True' the given subscript lies in the range defined\n    -- the bounding pair.\n    inRange             :: (a,a) -> a -> Bool\n    -- | The size of the subrange defined by a bounding pair.\n    rangeSize           :: (a,a) -> Int\n    -- | like 'rangeSize', but without checking that the upper bound is\n    -- in range.\n    unsafeRangeSize     :: (a,a) -> Int\n\n        -- Must specify one of index, unsafeIndex\n\n        -- 'index' is typically over-ridden in instances, with essentially\n        -- the same code, but using indexError instead of hopelessIndexError\n        -- Reason: we have 'Show' at the instances\n    {-# INLINE index #-}  -- See Note [Inlining index]\n    index b i | inRange b i = unsafeIndex b i\n              | otherwise   = hopelessIndexError\n\n    unsafeIndex b i = index b i\n\n    rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1\n                       | otherwise   = 0        -- This case is only here to\n                                                -- check for an empty range\n        -- NB: replacing (inRange b h) by (l <= h) fails for\n        --     tuples.  E.g.  (1,2) <= (2,1) but the range is empty\n\n    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1\n\n{-\nNote that the following is NOT right\n        rangeSize (l,h) | l <= h    = index b h + 1\n                        | otherwise = 0\n\nBecause it might be the case that l<h, but the range\nis nevertheless empty.  Consider\n        ((1,2),(2,1))\nHere l<h, but the second index ranges from 2..1 and\nhence is empty\n\n\nNote [Inlining index]\n~~~~~~~~~~~~~~~~~~~~~\nWe inline the 'index' operation,\n\n * Partly because it generates much faster code\n   (although bigger); see Trac #1216\n\n * Partly because it exposes the bounds checks to the simplifier which\n   might help a big.\n\nIf you make a per-instance index method, you may consider inlining it.\n\nNote [Double bounds-checking of index values]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWhen you index an array, a!x, there are two possible bounds checks we might make:\n\n  (A) Check that (inRange (bounds a) x) holds.\n\n      (A) is checked in the method for 'index'\n\n  (B) Check that (index (bounds a) x) lies in the range 0..n,\n      where n is the size of the underlying array\n\n      (B) is checked in the top-level function (!), in safeIndex.\n\nOf course it *should* be the case that (A) holds iff (B) holds, but that\nis a property of the particular instances of index, bounds, and inRange,\nso GHC cannot guarantee it.\n\n * If you do (A) and not (B), then you might get a seg-fault,\n   by indexing at some bizarre location.  Trac #1610\n\n * If you do (B) but not (A), you may get no complaint when you index\n   an array out of its semantic bounds.  Trac #2120\n\nAt various times we have had (A) and not (B), or (B) and not (A); both\nled to complaints.  So now we implement *both* checks (Trac #2669).\n\nFor 1-d, 2-d, and 3-d arrays of Int we have specialised instances to avoid this.\n\nNote [Out-of-bounds error messages]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe default method for 'index' generates hoplelessIndexError, because\nIx doesn't have Show as a superclass.  For particular base types we\ncan do better, so we override the default method for index.\n-}\n\n-- Abstract these errors from the relevant index functions so that\n-- the guts of the function will be small enough to inline.\n\n{-# NOINLINE indexError #-}\nindexError :: Show a => (a,a) -> a -> String -> b\nindexError rng i tp\n  = errorWithoutStackTrace (showString \"Ix{\" . showString tp . showString \"}.index: Index \" .\n           showParen True (showsPrec 0 i) .\n           showString \" out of range \" $\n           showParen True (showsPrec 0 rng) \"\")\n\nhopelessIndexError :: Int -- Try to use 'indexError' instead!\nhopelessIndexError = errorWithoutStackTrace \"Error in array index\"\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance  Ix Char  where\n    {-# INLINE range #-}\n    range (m,n) = [m..n]\n\n    {-# INLINE unsafeIndex #-}\n    unsafeIndex (m,_n) i = fromEnum i - fromEnum m\n\n    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]\n                          -- and Note [Inlining index]\n    index b i | inRange b i =  unsafeIndex b i\n              | otherwise   =  indexError b i \"Char\"\n\n    inRange (m,n) i     =  m <= i && i <= n\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance  Ix Int  where\n    {-# INLINE range #-}\n        -- The INLINE stops the build in the RHS from getting inlined,\n        -- so that callers can fuse with the result of range\n    range (m,n) = [m..n]\n\n    {-# INLINE unsafeIndex #-}\n    unsafeIndex (m,_n) i = i - m\n\n    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]\n                          -- and Note [Inlining index]\n    index b i | inRange b i =  unsafeIndex b i\n              | otherwise   =  indexError b i \"Int\"\n\n    {-# INLINE inRange #-}\n    inRange (I# m,I# n) (I# i) =  isTrue# (m <=# i) && isTrue# (i <=# n)\n\n-- | @since 4.6.0.0\ninstance Ix Word where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral (i - m)\n    inRange (m,n) i     = m <= i && i <= n\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance  Ix Integer  where\n    {-# INLINE range #-}\n    range (m,n) = [m..n]\n\n    {-# INLINE unsafeIndex #-}\n    unsafeIndex (m,_n) i   = fromInteger (i - m)\n\n    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]\n                          -- and Note [Inlining index]\n    index b i | inRange b i =  unsafeIndex b i\n              | otherwise   =  indexError b i \"Integer\"\n\n    inRange (m,n) i     =  m <= i && i <= n\n\n----------------------------------------------------------------------\n-- | @since 4.8.0.0\ninstance Ix Natural where\n    range (m,n) = [m..n]\n    inRange (m,n) i = m <= i && i <= n\n    unsafeIndex (m,_) i = fromIntegral (i-m)\n    index b i | inRange b i = unsafeIndex b i\n              | otherwise   = indexError b i \"Natural\"\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance Ix Bool where -- as derived\n    {-# INLINE range #-}\n    range (m,n) = [m..n]\n\n    {-# INLINE unsafeIndex #-}\n    unsafeIndex (l,_) i = fromEnum i - fromEnum l\n\n    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]\n                          -- and Note [Inlining index]\n    index b i | inRange b i =  unsafeIndex b i\n              | otherwise   =  indexError b i \"Bool\"\n\n    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance Ix Ordering where -- as derived\n    {-# INLINE range #-}\n    range (m,n) = [m..n]\n\n    {-# INLINE unsafeIndex #-}\n    unsafeIndex (l,_) i = fromEnum i - fromEnum l\n\n    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]\n                          -- and Note [Inlining index]\n    index b i | inRange b i =  unsafeIndex b i\n              | otherwise   =  indexError b i \"Ordering\"\n\n    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance Ix () where\n    {-# INLINE range #-}\n    range   ((), ())    = [()]\n    {-# INLINE unsafeIndex #-}\n    unsafeIndex   ((), ()) () = 0\n    {-# INLINE inRange #-}\n    inRange ((), ()) () = True\n\n    {-# INLINE index #-}  -- See Note [Inlining index]\n    index b i = unsafeIndex b i\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance (Ix a, Ix b) => Ix (a, b) where -- as derived\n    {-# SPECIALISE instance Ix (Int,Int) #-}\n\n    {-# INLINE range #-}\n    range ((l1,l2),(u1,u2)) =\n      [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]\n\n    {-# INLINE unsafeIndex #-}\n    unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =\n      unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2\n\n    {-# INLINE inRange #-}\n    inRange ((l1,l2),(u1,u2)) (i1,i2) =\n      inRange (l1,u1) i1 && inRange (l2,u2) i2\n\n    -- Default method for index\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where\n    {-# SPECIALISE instance Ix (Int,Int,Int) #-}\n\n    range ((l1,l2,l3),(u1,u2,u3)) =\n        [(i1,i2,i3) | i1 <- range (l1,u1),\n                      i2 <- range (l2,u2),\n                      i3 <- range (l3,u3)]\n\n    unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =\n      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (\n      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (\n      unsafeIndex (l1,u1) i1))\n\n    inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =\n      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&\n      inRange (l3,u3) i3\n\n    -- Default method for index\n\n----------------------------------------------------------------------\n-- | @since 2.01\ninstance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where\n    range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =\n      [(i1,i2,i3,i4) | i1 <- range (l1,u1),\n                       i2 <- range (l2,u2),\n                       i3 <- range (l3,u3),\n                       i4 <- range (l4,u4)]\n\n    unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =\n      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (\n      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (\n      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (\n      unsafeIndex (l1,u1) i1)))\n\n    inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =\n      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&\n      inRange (l3,u3) i3 && inRange (l4,u4) i4\n\n    -- Default method for index\n-- | @since 2.01\ninstance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where\n    range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =\n      [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),\n                          i2 <- range (l2,u2),\n                          i3 <- range (l3,u3),\n                          i4 <- range (l4,u4),\n                          i5 <- range (l5,u5)]\n\n    unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =\n      unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (\n      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (\n      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (\n      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (\n      unsafeIndex (l1,u1) i1))))\n\n    inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =\n      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&\n      inRange (l3,u3) i3 && inRange (l4,u4) i4 &&\n      inRange (l5,u5) i5\n\n    -- Default method for index\n\n-- | The type of immutable non-strict (boxed) arrays\n-- with indices in @i@ and elements in @e@.\ndata Array i e\n   = Array            !i         -- the lower bound, l\n                      !i         -- the upper bound, u\n       {-# UNPACK #-} !Int       -- A cache of (rangeSize (l,u))\n                                 -- used to make sure an index is\n                                 -- really in range\n                      (Array# e) -- The actual elements\n\n-- | Mutable, boxed, non-strict arrays in the 'ST' monad.  The type\n-- arguments are as follows:\n--\n--  * @s@: the state variable argument for the 'ST' type\n--\n--  * @i@: the index type of the array (should be an instance of 'Ix')\n--\n--  * @e@: the element type of the array.\n--\ndata STArray s i e\n  = STArray           !i               -- the lower bound, l\n                      !i               -- the upper bound, u\n      {-# UNPACK #-}  !Int             -- A cache of (rangeSize (l,u))\n                                       -- used to make sure an index is\n                                       -- really in range\n                   (MutableArray# s e) -- The actual elements\n        -- No Ix context for STArray.  They are stupid,\n        -- and force an Ix context on the equality instance.\n\n-- Index types should have nominal role, because of Ix class. See also #9220.\ntype role Array nominal representational\ntype role STArray nominal nominal representational\n\n-- Just pointer equality on mutable arrays:\n-- | @since 2.01\ninstance Eq (STArray s i e) where\n    STArray _ _ _ arr1# == STArray _ _ _ arr2# =\n        isTrue# (sameMutableArray# arr1# arr2#)\n\n----------------------------------------------------------------------\n-- Operations on immutable arrays\n\n{-# NOINLINE arrEleBottom #-}\narrEleBottom :: a\narrEleBottom = errorWithoutStackTrace \"(Array.!): undefined array element\"\n\n-- | Construct an array with the specified bounds and containing values\n-- for given indices within these bounds.\n--\n-- The array is undefined (i.e. bottom) if any index in the list is\n-- out of bounds.  The Haskell 2010 Report further specifies that if any\n-- two associations in the list have the same index, the value at that\n-- index is undefined (i.e. bottom).  However in GHC's implementation,\n-- the value at such an index is the value part of the last association\n-- with that index in the list.\n--\n-- Because the indices must be checked for these errors, 'array' is\n-- strict in the bounds argument and in the indices of the association\n-- list, but non-strict in the values.  Thus, recurrences such as the\n-- following are possible:\n--\n-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])\n--\n-- Not every index within the bounds of the array need appear in the\n-- association list, but the values associated with indices that do not\n-- appear will be undefined (i.e. bottom).\n--\n-- If, in any dimension, the lower bound is greater than the upper bound,\n-- then the array is legal, but empty.  Indexing an empty array always\n-- gives an array-bounds error, but 'bounds' still yields the bounds\n-- with which the array was constructed.\n{-# INLINE array #-}\narray :: Ix i\n        => (i,i)        -- ^ a pair of /bounds/, each of the index type\n                        -- of the array.  These bounds are the lowest and\n                        -- highest indices in the array, in that order.\n                        -- For example, a one-origin vector of length\n                        -- @10@ has bounds @(1,10)@, and a one-origin @10@\n                        -- by @10@ matrix has bounds @((1,1),(10,10))@.\n        -> [(i, e)]     -- ^ a list of /associations/ of the form\n                        -- (/index/, /value/).  Typically, this list will\n                        -- be expressed as a comprehension.  An\n                        -- association @(i, x)@ defines the value of\n                        -- the array at index @i@ to be @x@.\n        -> Array i e\narray (l,u) ies\n    = let n = safeRangeSize (l,u)\n      in unsafeArray' (l,u) n\n                      [(safeIndex (l,u) n i, e) | (i, e) <- ies]\n\n{-# INLINE unsafeArray #-}\nunsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e\nunsafeArray b ies = unsafeArray' b (rangeSize b) ies\n\n{-# INLINE unsafeArray' #-}\nunsafeArray' :: (i,i) -> Int -> [(Int, e)] -> Array i e\nunsafeArray' (l,u) n@(I# n#) ies = runST (ST $ \\s1# ->\n    case newArray# n# arrEleBottom s1# of\n        (# s2#, marr# #) ->\n            foldr (fill marr#) (done l u n marr#) ies s2#)\n\n{-# INLINE fill #-}\nfill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a\n-- NB: put the \\s after the \"=\" so that 'fill'\n--     inlines when applied to three args\nfill marr# (I# i#, e) next\n = \\s1# -> case writeArray# marr# i# e s1# of\n             s2# -> next s2#\n\n{-# INLINE done #-}\ndone :: i -> i -> Int -> MutableArray# s e -> STRep s (Array i e)\n-- See NB on 'fill'\n-- Make sure it is strict in 'n'\ndone l u n@(I# _) marr#\n  = \\s1# -> case unsafeFreezeArray# marr# s1# of\n              (# s2#, arr# #) -> (# s2#, Array l u n arr# #)\n\n-- | Construct an array from a pair of bounds and a list of values in\n-- index order.\n{-# INLINE listArray #-}\nlistArray :: Ix i => (i,i) -> [e] -> Array i e\nlistArray (l,u) es = runST (ST $ \\s1# ->\n    case safeRangeSize (l,u)            of { n@(I# n#) ->\n    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->\n      let\n        go y r = \\ i# s3# ->\n            case writeArray# marr# i# y s3# of\n              s4# -> if (isTrue# (i# ==# n# -# 1#))\n                     then s4#\n                     else r (i# +# 1#) s4#\n      in\n        done l u n marr# (\n          if n == 0\n          then s2#\n          else foldr go (\\_ s# -> s#) es 0# s2#)}})\n\n-- | The value at the given index in an array.\n{-# INLINE (!) #-}\n(!) :: Ix i => Array i e -> i -> e\n(!) arr@(Array l u n _) i = unsafeAt arr $ safeIndex (l,u) n i\n\n{-# INLINE (!#) #-}\n(!#) :: Ix i => Array i e -> i -> (# e #)\n(!#) arr@(Array l u n _) i = unsafeAt# arr $ safeIndex (l,u) n i\n\n{-# INLINE safeRangeSize #-}\nsafeRangeSize :: Ix i => (i, i) -> Int\nsafeRangeSize (l,u) = let r = rangeSize (l, u)\n                      in if r < 0 then negRange\n                                  else r\n\n-- Don't inline this error message everywhere!!\nnegRange :: Int   -- Uninformative, but Ix does not provide Show\nnegRange = errorWithoutStackTrace \"Negative range size\"\n\n{-# INLINE[1] safeIndex #-}\n-- See Note [Double bounds-checking of index values]\n-- Inline *after* (!) so the rules can fire\n-- Make sure it is strict in n\nsafeIndex :: Ix i => (i, i) -> Int -> i -> Int\nsafeIndex (l,u) n@(I# _) i\n  | (0 <= i') && (i' < n) = i'\n  | otherwise             = badSafeIndex i' n\n  where\n    i' = index (l,u) i\n\n-- See Note [Double bounds-checking of index values]\n{-# RULES\n\"safeIndex/I\"       safeIndex = lessSafeIndex :: (Int,Int) -> Int -> Int -> Int\n\"safeIndex/(I,I)\"   safeIndex = lessSafeIndex :: ((Int,Int),(Int,Int)) -> Int -> (Int,Int) -> Int\n\"safeIndex/(I,I,I)\" safeIndex = lessSafeIndex :: ((Int,Int,Int),(Int,Int,Int)) -> Int -> (Int,Int,Int) -> Int\n  #-}\n\nlessSafeIndex :: Ix i => (i, i) -> Int -> i -> Int\n-- See Note [Double bounds-checking of index values]\n-- Do only (A), the semantic check\nlessSafeIndex (l,u) _ i = index (l,u) i\n\n-- Don't inline this long error message everywhere!!\nbadSafeIndex :: Int -> Int -> Int\nbadSafeIndex i' n = errorWithoutStackTrace (\"Error in array index; \" ++ show i' ++\n                        \" not in range [0..\" ++ show n ++ \")\")\n\n{-# INLINE unsafeAt #-}\nunsafeAt :: Array i e -> Int -> e\nunsafeAt (Array _ _ _ arr#) (I# i#) =\n    case indexArray# arr# i# of (# e #) -> e\n\n-- | Look up an element in an array without forcing it\nunsafeAt# :: Array i e -> Int -> (# e #)\nunsafeAt# (Array _ _ _ arr#) (I# i#) = indexArray# arr# i#\n\n-- | A convenient version of unsafeAt#\nunsafeAtA :: Applicative f\n          => Array i e -> Int -> f e\nunsafeAtA ary i = case unsafeAt# ary i of (# e #) -> pure e\n\n-- | The bounds with which an array was constructed.\n{-# INLINE bounds #-}\nbounds :: Array i e -> (i,i)\nbounds (Array l u _ _) = (l,u)\n\n-- | The number of elements in the array.\n{-# INLINE numElements #-}\nnumElements :: Array i e -> Int\nnumElements (Array _ _ n _) = n\n\n-- | The list of indices of an array in ascending order.\n{-# INLINE indices #-}\nindices :: Ix i => Array i e -> [i]\nindices (Array l u _ _) = range (l,u)\n\n-- | The list of elements of an array in index order.\n{-# INLINE elems #-}\nelems :: Array i e -> [e]\nelems arr@(Array _ _ n _) =\n    [e | i <- [0 .. n - 1], e <- unsafeAtA arr i]\n\n-- | A right fold over the elements\n{-# INLINABLE foldrElems #-}\nfoldrElems :: (a -> b -> b) -> b -> Array i a -> b\nfoldrElems f b0 = \\ arr@(Array _ _ n _) ->\n  let\n    go i | i == n    = b0\n         | (# e #) <- unsafeAt# arr i\n         = f e (go (i+1))\n  in go 0\n\n-- | A left fold over the elements\n{-# INLINABLE foldlElems #-}\nfoldlElems :: (b -> a -> b) -> b -> Array i a -> b\nfoldlElems f b0 = \\ arr@(Array _ _ n _) ->\n  let\n    go i | i == (-1) = b0\n         | (# e #) <- unsafeAt# arr i\n         = f (go (i-1)) e\n  in go (n-1)\n\n-- | A strict right fold over the elements\n{-# INLINABLE foldrElems' #-}\nfoldrElems' :: (a -> b -> b) -> b -> Array i a -> b\nfoldrElems' f b0 = \\ arr@(Array _ _ n _) ->\n  let\n    go i a | i == (-1) = a\n           | (# e #) <- unsafeAt# arr i\n           = go (i-1) (f e $! a)\n  in go (n-1) b0\n\n-- | A strict left fold over the elements\n{-# INLINABLE foldlElems' #-}\nfoldlElems' :: (b -> a -> b) -> b -> Array i a -> b\nfoldlElems' f b0 = \\ arr@(Array _ _ n _) ->\n  let\n    go i a | i == n    = a\n           | (# e #) <- unsafeAt# arr i\n           = go (i+1) (a `seq` f a e)\n  in go 0 b0\n\n-- | A left fold over the elements with no starting value\n{-# INLINABLE foldl1Elems #-}\nfoldl1Elems :: (a -> a -> a) -> Array i a -> a\nfoldl1Elems f = \\ arr@(Array _ _ n _) ->\n  let\n    go i | i == 0    = unsafeAt arr 0\n         | (# e #) <- unsafeAt# arr i\n         = f (go (i-1)) e\n  in\n    if n == 0 then errorWithoutStackTrace \"foldl1: empty Array\" else go (n-1)\n\n-- | A right fold over the elements with no starting value\n{-# INLINABLE foldr1Elems #-}\nfoldr1Elems :: (a -> a -> a) -> Array i a -> a\nfoldr1Elems f = \\ arr@(Array _ _ n _) ->\n  let\n    go i | i == n-1  = unsafeAt arr i\n         | (# e #) <- unsafeAt# arr i\n         = f e (go (i + 1))\n  in\n    if n == 0 then errorWithoutStackTrace \"foldr1: empty Array\" else go 0\n\n-- | The list of associations of an array in index order.\n{-# INLINE assocs #-}\nassocs :: Ix i => Array i e -> [(i, e)]\nassocs arr@(Array l u _ _) =\n    [(i, e) | i <- range (l,u), let !(# e #) = arr !# i]\n\n-- | The 'accumArray' function deals with repeated indices in the association\n-- list using an /accumulating function/ which combines the values of\n-- associations with the same index.\n--\n-- For example, given a list of values of some index type, @hist@\n-- produces a histogram of the number of occurrences of each index within\n-- a specified range:\n--\n-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b\n-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]\n--\n-- @accumArray@ is strict in each result of applying the accumulating\n-- function, although it is lazy in the initial value. Thus, unlike\n-- arrays built with 'array', accumulated arrays should not in general\n-- be recursive.\n{-# INLINE accumArray #-}\naccumArray :: Ix i\n        => (e -> a -> e)        -- ^ accumulating function\n        -> e                    -- ^ initial value\n        -> (i,i)                -- ^ bounds of the array\n        -> [(i, a)]             -- ^ association list\n        -> Array i e\naccumArray f initial (l,u) ies =\n    let n = safeRangeSize (l,u)\n    in unsafeAccumArray' f initial (l,u) n\n                         [(safeIndex (l,u) n i, e) | (i, e) <- ies]\n\n{-# INLINE unsafeAccumArray #-}\nunsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e\nunsafeAccumArray f initial b ies = unsafeAccumArray' f initial b (rangeSize b) ies\n\n{-# INLINE unsafeAccumArray' #-}\nunsafeAccumArray' :: (e -> a -> e) -> e -> (i,i) -> Int -> [(Int, a)] -> Array i e\nunsafeAccumArray' f initial (l,u) n@(I# n#) ies = runST (ST $ \\s1# ->\n    case newArray# n# initial s1#          of { (# s2#, marr# #) ->\n    foldr (adjust' f marr#) (done l u n marr#) ies s2# })\n\n{-# INLINE adjust #-}\nadjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b\n-- See NB on 'fill'\nadjust f marr# (I# i#, new) next\n  = \\s1# -> case readArray# marr# i# s1# of\n                (# s2#, old #) ->\n                    case writeArray# marr# i# (f old new) s2# of\n                        s3# -> next s3#\n\n{-# INLINE adjust' #-}\nadjust' :: (e -> a -> e)\n        -> MutableArray# s e\n        -> (Int, a)\n        -> STRep s b -> STRep s b\nadjust' f marr# (I# i#, new) next\n  = \\s1# -> case readArray# marr# i# s1# of\n                (# s2#, old #) ->\n                    let !combined = f old new\n                    in next (writeArray# marr# i# combined s2#)\n\n\n-- | Constructs an array identical to the first argument except that it has\n-- been updated by the associations in the right argument.\n-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then\n--\n-- > m//[((i,i), 0) | i <- [1..n]]\n--\n-- is the same matrix, except with the diagonal zeroed.\n--\n-- Repeated indices in the association list are handled as for 'array':\n-- Haskell 2010 specifies that the resulting array is undefined (i.e. bottom),\n-- but GHC's implementation uses the last association for each index.\n{-# INLINE (//) #-}\n(//) :: Ix i => Array i e -> [(i, e)] -> Array i e\narr@(Array l u n _) // ies =\n    unsafeReplace arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]\n\n{-# INLINE unsafeReplace #-}\nunsafeReplace :: Array i e -> [(Int, e)] -> Array i e\nunsafeReplace arr ies = runST (do\n    STArray l u n marr# <- thawSTArray arr\n    ST (foldr (fill marr#) (done l u n marr#) ies))\n\n-- | @'accum' f@ takes an array and an association list and accumulates\n-- pairs from the list into the array with the accumulating function @f@.\n-- Thus 'accumArray' can be defined using 'accum':\n--\n-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])\n--\n-- @accum@ is strict in all the results of applying the accumulation.\n-- However, it is lazy in the initial values of the array.\n{-# INLINE accum #-}\naccum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e\naccum f arr@(Array l u n _) ies =\n    unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]\n\n{-# INLINE unsafeAccum #-}\nunsafeAccum :: (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e\nunsafeAccum f arr ies = runST (do\n    STArray l u n marr# <- thawSTArray arr\n    ST (foldr (adjust' f marr#) (done l u n marr#) ies))\n\n{-# INLINE [1] amap #-}  -- See Note [amap]\namap :: (a -> b) -> Array i a -> Array i b\namap f arr@(Array l u n@(I# n#) _) = runST (ST $ \\s1# ->\n    case newArray# n# arrEleBottom s1# of\n        (# s2#, marr# #) ->\n          let go i s#\n                | i == n    = done l u n marr# s#\n                | (# e #) <- unsafeAt# arr i\n                = fill marr# (i, f e) (go (i+1)) s#\n          in go 0 s2# )\n\n{- Note [amap]\n~~~~~~~~~~~~~~\namap was originally defined like this:\n\n amap f arr@(Array l u n _) =\n     unsafeArray' (l,u) n [(i, f (unsafeAt arr i)) | i <- [0 .. n - 1]]\n\nThere are two problems:\n\n1. The enumFromTo implementation produces (spurious) code for the impossible\n   case of n<0 that ends up duplicating the array freezing code.\n\n2. This implementation relies on list fusion for efficiency. In order\n   to implement the \"amap/coerce\" rule, we need to delay inlining amap\n   until simplifier phase 1, which is when the eftIntList rule kicks\n   in and makes that impossible.  (c.f. Trac #8767)\n-}\n\n\n-- See Breitner, Eisenberg, Peyton Jones, and Weirich, \"Safe Zero-cost\n-- Coercions for Haskell\", section 6.5:\n--   http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf\n{-# RULES\n\"amap/coerce\" amap coerce = coerce  -- See Note [amap]\n #-}\n\n-- Second functor law:\n{-# RULES\n\"amap/amap\" forall f g a . amap f (amap g a) = amap (f . g) a\n #-}\n\n-- | 'ixmap' allows for transformations on array indices.\n-- It may be thought of as providing function composition on the right\n-- with the mapping that the original array embodies.\n--\n-- A similar transformation of array values may be achieved using 'fmap'\n-- from the 'Array' instance of the 'Functor' class.\n{-# INLINE ixmap #-}\nixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e\nixmap (l,u) f arr =\n    array (l,u) [(i, arr ! f i) | i <- range (l,u)]\n\n{-# INLINE eqArray #-}\neqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool\neqArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) =\n    if n1 == 0 then n2 == 0 else\n    l1 == l2 && u1 == u2 &&\n    and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]]\n\n{-# INLINE [1] cmpArray #-}\ncmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering\ncmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)\n\n{-# INLINE cmpIntArray #-}\ncmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering\ncmpIntArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) =\n    if n1 == 0 then\n        if n2 == 0 then EQ else LT\n    else if n2 == 0 then GT\n    else case compare l1 l2 of\n             EQ    -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1]\n             other -> other\n  where\n    cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of\n        EQ    -> rest\n        other -> other\n\n{-# RULES \"cmpArray/Int\" cmpArray = cmpIntArray #-}\n\n----------------------------------------------------------------------\n-- Array instances\n\n-- | @since 2.01\ninstance Functor (Array i) where\n    fmap = amap\n\n-- | @since 2.01\ninstance (Ix i, Eq e) => Eq (Array i e) where\n    (==) = eqArray\n\n-- | @since 2.01\ninstance (Ix i, Ord e) => Ord (Array i e) where\n    compare = cmpArray\n\n-- | @since 2.01\ninstance (Ix a, Show a, Show b) => Show (Array a b) where\n    showsPrec p a =\n        showParen (p > appPrec) $\n        showString \"array \" .\n        showsPrec appPrec1 (bounds a) .\n        showChar ' ' .\n        showsPrec appPrec1 (assocs a)\n        -- Precedence of 'array' is the precedence of application\n\n-- The Read instance is in GHC.Read\n\n----------------------------------------------------------------------\n-- Operations on mutable arrays\n\n{-\nIdle ADR question: What's the tradeoff here between flattening these\ndatatypes into @STArray ix ix (MutableArray# s elt)@ and using\nit as is?  As I see it, the former uses slightly less heap and\nprovides faster access to the individual parts of the bounds while the\ncode used has the benefit of providing a ready-made @(lo, hi)@ pair as\nrequired by many array-related functions.  Which wins? Is the\ndifference significant (probably not).\n\nIdle AJG answer: When I looked at the outputted code (though it was 2\nyears ago) it seems like you often needed the tuple, and we build\nit frequently. Now we've got the overloading specialiser things\nmight be different, though.\n-}\n\n{-# INLINE newSTArray #-}\nnewSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)\nnewSTArray (l,u) initial = ST $ \\s1# ->\n    case safeRangeSize (l,u)            of { n@(I# n#) ->\n    case newArray# n# initial s1#       of { (# s2#, marr# #) ->\n    (# s2#, STArray l u n marr# #) }}\n\n{-# INLINE boundsSTArray #-}\nboundsSTArray :: STArray s i e -> (i,i)\nboundsSTArray (STArray l u _ _) = (l,u)\n\n{-# INLINE numElementsSTArray #-}\nnumElementsSTArray :: STArray s i e -> Int\nnumElementsSTArray (STArray _ _ n _) = n\n\n{-# INLINE readSTArray #-}\nreadSTArray :: Ix i => STArray s i e -> i -> ST s e\nreadSTArray marr@(STArray l u n _) i =\n    unsafeReadSTArray marr (safeIndex (l,u) n i)\n\n{-# INLINE unsafeReadSTArray #-}\nunsafeReadSTArray :: STArray s i e -> Int -> ST s e\nunsafeReadSTArray (STArray _ _ _ marr#) (I# i#)\n    = ST $ \\s1# -> readArray# marr# i# s1#\n\n{-# INLINE writeSTArray #-}\nwriteSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()\nwriteSTArray marr@(STArray l u n _) i e =\n    unsafeWriteSTArray marr (safeIndex (l,u) n i) e\n\n{-# INLINE unsafeWriteSTArray #-}\nunsafeWriteSTArray :: STArray s i e -> Int -> e -> ST s ()\nunsafeWriteSTArray (STArray _ _ _ marr#) (I# i#) e = ST $ \\s1# ->\n    case writeArray# marr# i# e s1# of\n        s2# -> (# s2#, () #)\n\n----------------------------------------------------------------------\n-- Moving between mutable and immutable\n\nfreezeSTArray :: STArray s i e -> ST s (Array i e)\nfreezeSTArray (STArray l u n@(I# n#) marr#) = ST $ \\s1# ->\n    case newArray# n# arrEleBottom s1#  of { (# s2#, marr'# #) ->\n    let copy i# s3# | isTrue# (i# ==# n#) = s3#\n                    | otherwise =\n            case readArray# marr# i# s3# of { (# s4#, e #) ->\n            case writeArray# marr'# i# e s4# of { s5# ->\n            copy (i# +# 1#) s5# }} in\n    case copy 0# s2#                    of { s3# ->\n    case unsafeFreezeArray# marr'# s3#  of { (# s4#, arr# #) ->\n    (# s4#, Array l u n arr# #) }}}\n\n{-# INLINE unsafeFreezeSTArray #-}\nunsafeFreezeSTArray :: STArray s i e -> ST s (Array i e)\nunsafeFreezeSTArray (STArray l u n marr#) = ST $ \\s1# ->\n    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->\n    (# s2#, Array l u n arr# #) }\n\nthawSTArray :: Array i e -> ST s (STArray s i e)\nthawSTArray (Array l u n@(I# n#) arr#) = ST $ \\s1# ->\n    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->\n    let copy i# s3# | isTrue# (i# ==# n#) = s3#\n                    | otherwise =\n            case indexArray# arr# i#    of { (# e #) ->\n            case writeArray# marr# i# e s3# of { s4# ->\n            copy (i# +# 1#) s4# }} in\n    case copy 0# s2#                    of { s3# ->\n    (# s3#, STArray l u n marr# #) }}\n\n{-# INLINE unsafeThawSTArray #-}\nunsafeThawSTArray :: Array i e -> ST s (STArray s i e)\nunsafeThawSTArray (Array l u n arr#) = ST $ \\s1# ->\n    case unsafeThawArray# arr# s1#      of { (# s2#, marr# #) ->\n    (# s2#, STArray l u n marr# #) }\n", "num_lines": 962}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nNOTA BENE: Do NOT use ($) anywhere in this module! The type of ($) is\nslightly magical (it can return unlifted types), and it is wired in.\nBut, it is also *defined* in this module, with a non-magical type.\nGHC gets terribly confused (and *hangs*) if you try to use ($) in this\nmodule, because it has different types in different scenarios.\n\nThis is not a problem in general, because the type ($), being wired in, is not\nwritten out to the interface file, so importing files don't get confused.\nThe problem is only if ($) is used here. So don't!\n\n---------------------------------------------\n\nThe overall structure of the GHC Prelude is a bit tricky.\n\n  a) We want to avoid \"orphan modules\", i.e. ones with instance\n        decls that don't belong either to a tycon or a class\n        defined in the same module\n\n  b) We want to avoid giant modules\n\nSo the rough structure is as follows, in (linearised) dependency order\n\n\nGHC.Prim        Has no implementation.  It defines built-in things, and\n                by importing it you bring them into scope.\n                The source file is GHC.Prim.hi-boot, which is just\n                copied to make GHC.Prim.hi\n\nGHC.Base        Classes: Eq, Ord, Functor, Monad\n                Types:   list, (), Int, Bool, Ordering, Char, String\n\nData.Tuple      Types: tuples, plus instances for GHC.Base classes\n\nGHC.Show        Class: Show, plus instances for GHC.Base/GHC.Tup types\n\nGHC.Enum        Class: Enum,  plus instances for GHC.Base/GHC.Tup types\n\nData.Maybe      Type: Maybe, plus instances for GHC.Base classes\n\nGHC.List        List functions\n\nGHC.Num         Class: Num, plus instances for Int\n                Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show)\n\n                Integer is needed here because it is mentioned in the signature\n                of 'fromInteger' in class Num\n\nGHC.Real        Classes: Real, Integral, Fractional, RealFrac\n                         plus instances for Int, Integer\n                Types:  Ratio, Rational\n                        plus instances for classes so far\n\n                Rational is needed here because it is mentioned in the signature\n                of 'toRational' in class Real\n\nGHC.ST  The ST monad, instances and a few helper functions\n\nIx              Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples\n\nGHC.Arr         Types: Array, MutableArray, MutableVar\n\n                Arrays are used by a function in GHC.Float\n\nGHC.Float       Classes: Floating, RealFloat\n                Types:   Float, Double, plus instances of all classes so far\n\n                This module contains everything to do with floating point.\n                It is a big module (900 lines)\n                With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi\n\n\nOther Prelude modules are much easier with fewer complex dependencies.\n-}\n\n{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , BangPatterns\n           , ExplicitForAll\n           , MagicHash\n           , UnboxedTuples\n           , ExistentialQuantification\n           , RankNTypes\n           , KindSignatures\n           , PolyKinds\n           , DataKinds\n  #-}\n-- -Wno-orphans is needed for things like:\n-- Orphan rule: \"x# -# x#\" ALWAYS forall x# :: Int# -# x# x# = 0\n{-# OPTIONS_GHC -Wno-orphans #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Base\n-- Copyright   :  (c) The University of Glasgow, 1992-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Basic data types and classes.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Base\n        (\n        module GHC.Base,\n        module GHC.Classes,\n        module GHC.CString,\n        module GHC.Magic,\n        module GHC.Types,\n        module GHC.Prim,        -- Re-export GHC.Prim and [boot] GHC.Err,\n                                -- to avoid lots of people having to\n        module GHC.Err,         -- import it explicitly\n        module GHC.Maybe\n  )\n        where\n\nimport GHC.Types\nimport GHC.Classes\nimport GHC.CString\nimport GHC.Magic\nimport GHC.Prim\nimport GHC.Err\nimport GHC.Maybe\nimport {-# SOURCE #-} GHC.IO (failIO,mplusIO)\n\nimport GHC.Tuple ()              -- Note [Depend on GHC.Tuple]\nimport GHC.Integer ()            -- Note [Depend on GHC.Integer]\nimport GHC.Natural ()            -- Note [Depend on GHC.Natural]\n\n-- for 'class Semigroup'\nimport {-# SOURCE #-} GHC.Real (Integral)\nimport {-# SOURCE #-} Data.Semigroup.Internal ( stimesDefault\n                                              , stimesMaybe\n                                              , stimesList\n                                              , stimesIdempotentMonoid\n                                              )\n\ninfixr 9  .\ninfixr 5  ++\ninfixl 4  <$\ninfixl 1  >>, >>=\ninfixr 1  =<<\ninfixr 0  $, $!\n\ninfixl 4 <*>, <*, *>, <**>\n\ndefault ()              -- Double isn't available yet\n\n{-\nNote [Depend on GHC.Integer]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe Integer type is special because TidyPgm uses\nGHC.Integer.Type.mkInteger to construct Integer literal values\nCurrently it reads the interface file whether or not the current\nmodule *has* any Integer literals, so it's important that\nGHC.Integer.Type (in package integer-gmp or integer-simple) is\ncompiled before any other module.  (There's a hack in GHC to disable\nthis for packages ghc-prim, integer-gmp, integer-simple, which aren't\nallowed to contain any Integer literals.)\n\nLikewise we implicitly need Integer when deriving things like Eq\ninstances.\n\nThe danger is that if the build system doesn't know about the dependency\non Integer, it'll compile some base module before GHC.Integer.Type,\nresulting in:\n  Failed to load interface for \u00e2\u20ac\u02dcGHC.Integer.Type\u00e2\u20ac\u2122\n    There are files missing in the \u00e2\u20ac\u02dcinteger-gmp\u00e2\u20ac\u2122 package,\n\nBottom line: we make GHC.Base depend on GHC.Integer; and everything\nelse either depends on GHC.Base, or does not have NoImplicitPrelude\n(and hence depends on Prelude).\n\nNote [Depend on GHC.Tuple]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nSimilarly, tuple syntax (or ()) creates an implicit dependency on\nGHC.Tuple, so we use the same rule as for Integer --- see Note [Depend on\nGHC.Integer] --- to explain this to the build system.  We make GHC.Base\ndepend on GHC.Tuple, and everything else depends on GHC.Base or Prelude.\n\nNote [Depend on GHC.Natural]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nSimilar to GHC.Integer.\n-}\n\n#if 0\n-- for use when compiling GHC.Base itself doesn't work\ndata  Bool  =  False | True\ndata Ordering = LT | EQ | GT\ndata Char = C# Char#\ntype  String = [Char]\ndata Int = I# Int#\ndata  ()  =  ()\ndata [] a = MkNil\n\nnot True = False\n(&&) True True = True\notherwise = True\n\nbuild = errorWithoutStackTrace \"urk\"\nfoldr = errorWithoutStackTrace \"urk\"\n#endif\n\ninfixr 6 <>\n\n-- | The class of semigroups (types with an associative binary operation).\n--\n-- Instances should satisfy the following:\n--\n-- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@\n--\n-- @since 4.9.0.0\nclass Semigroup a where\n        -- | An associative operation.\n        (<>) :: a -> a -> a\n\n        -- | Reduce a non-empty list with '<>'\n        --\n        -- The default definition should be sufficient, but this can be\n        -- overridden for efficiency.\n        --\n        sconcat :: NonEmpty a -> a\n        sconcat (a :| as) = go a as where\n          go b (c:cs) = b <> go c cs\n          go b []     = b\n\n        -- | Repeat a value @n@ times.\n        --\n        -- Given that this works on a 'Semigroup' it is allowed to fail if\n        -- you request 0 or fewer repetitions, and the default definition\n        -- will do so.\n        --\n        -- By making this a member of the class, idempotent semigroups\n        -- and monoids can upgrade this to execute in /O(1)/ by\n        -- picking @stimes = 'Data.Semigroup.stimesIdempotent'@ or @stimes =\n        -- 'stimesIdempotentMonoid'@ respectively.\n        stimes :: Integral b => b -> a -> a\n        stimes = stimesDefault\n\n\n-- | The class of monoids (types with an associative binary operation that\n-- has an identity).  Instances should satisfy the following:\n--\n-- [Right identity] @x '<>' 'mempty' = x@\n-- [Left identity]  @'mempty' '<>' x = x@\n-- [Associativity]  @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law)\n-- [Concatenation]  @'mconcat' = 'foldr' ('<>') 'mempty'@\n--\n-- The method names refer to the monoid of lists under concatenation,\n-- but there are many other instances.\n--\n-- Some types can be viewed as a monoid in more than one way,\n-- e.g. both addition and multiplication on numbers.\n-- In such cases we often define @newtype@s and make those instances\n-- of 'Monoid', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.Product'.\n--\n-- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/.\nclass Semigroup a => Monoid a where\n        -- | Identity of 'mappend'\n        mempty  :: a\n\n        -- | An associative operation\n        --\n        -- __NOTE__: This method is redundant and has the default\n        -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/.\n        mappend :: a -> a -> a\n        mappend = (<>)\n        {-# INLINE mappend #-}\n\n        -- | Fold a list using the monoid.\n        --\n        -- For most types, the default definition for 'mconcat' will be\n        -- used, but the function is included in the class definition so\n        -- that an optimized version can be provided for specific types.\n        mconcat :: [a] -> a\n        mconcat = foldr mappend mempty\n\n-- | @since 4.9.0.0\ninstance Semigroup [a] where\n        (<>) = (++)\n        {-# INLINE (<>) #-}\n\n        stimes = stimesList\n\n-- | @since 2.01\ninstance Monoid [a] where\n        {-# INLINE mempty #-}\n        mempty  = []\n        {-# INLINE mconcat #-}\n        mconcat xss = [x | xs <- xss, x <- xs]\n-- See Note: [List comprehensions and inlining]\n\n{-\nNote: [List comprehensions and inlining]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe list monad operations are traditionally described in terms of concatMap:\n\nxs >>= f = concatMap f xs\n\nSimilarly, mconcat for lists is just concat. Here in Base, however, we don't\nhave concatMap, and we'll refrain from adding it here so it won't have to be\nhidden in imports. Instead, we use GHC's list comprehension desugaring\nmechanism to define mconcat and the Applicative and Monad instances for lists.\nWe mark them INLINE because the inliner is not generally too keen to inline\nbuild forms such as the ones these desugar to without our insistence.  Defining\nthese using list comprehensions instead of foldr has an additional potential\nbenefit, as described in compiler/deSugar/DsListComp.hs: if optimizations\nneeded to make foldr/build forms efficient are turned off, we'll get reasonably\nefficient translations anyway.\n-}\n\n-- | @since 4.9.0.0\ninstance Semigroup (NonEmpty a) where\n        (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)\n\n-- | @since 4.9.0.0\ninstance Semigroup b => Semigroup (a -> b) where\n        f <> g = \\x -> f x <> g x\n        stimes n f e = stimes n (f e)\n\n-- | @since 2.01\ninstance Monoid b => Monoid (a -> b) where\n        mempty _ = mempty\n\n-- | @since 4.9.0.0\ninstance Semigroup () where\n        _ <> _      = ()\n        sconcat _   = ()\n        stimes  _ _ = ()\n\n-- | @since 2.01\ninstance Monoid () where\n        -- Should it be strict?\n        mempty        = ()\n        mconcat _     = ()\n\n-- | @since 4.9.0.0\ninstance (Semigroup a, Semigroup b) => Semigroup (a, b) where\n        (a,b) <> (a',b') = (a<>a',b<>b')\n        stimes n (a,b) = (stimes n a, stimes n b)\n\n-- | @since 2.01\ninstance (Monoid a, Monoid b) => Monoid (a,b) where\n        mempty = (mempty, mempty)\n\n-- | @since 4.9.0.0\ninstance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where\n        (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')\n        stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c)\n\n-- | @since 2.01\ninstance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where\n        mempty = (mempty, mempty, mempty)\n\n-- | @since 4.9.0.0\ninstance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)\n         => Semigroup (a, b, c, d) where\n        (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')\n        stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d)\n\n-- | @since 2.01\ninstance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where\n        mempty = (mempty, mempty, mempty, mempty)\n\n-- | @since 4.9.0.0\ninstance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)\n         => Semigroup (a, b, c, d, e) where\n        (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')\n        stimes n (a,b,c,d,e) =\n            (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e)\n\n-- | @since 2.01\ninstance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>\n                Monoid (a,b,c,d,e) where\n        mempty = (mempty, mempty, mempty, mempty, mempty)\n\n\n-- | @since 4.9.0.0\ninstance Semigroup Ordering where\n    LT <> _ = LT\n    EQ <> y = y\n    GT <> _ = GT\n\n    stimes = stimesIdempotentMonoid\n\n-- lexicographical ordering\n-- | @since 2.01\ninstance Monoid Ordering where\n    mempty             = EQ\n\n-- | @since 4.9.0.0\ninstance Semigroup a => Semigroup (Maybe a) where\n    Nothing <> b       = b\n    a       <> Nothing = a\n    Just a  <> Just b  = Just (a <> b)\n\n    stimes = stimesMaybe\n\n-- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to\n-- <http://en.wikipedia.org/wiki/Monoid>: \\\"Any semigroup @S@ may be\n-- turned into a monoid simply by adjoining an element @e@ not in @S@\n-- and defining @e*e = e@ and @e*s = s = s*e@ for all @s \u00e2\u02c6\u02c6 S@.\\\"\n--\n-- /Since 4.11.0/: constraint on inner @a@ value generalised from\n-- 'Monoid' to 'Semigroup'.\n--\n-- @since 2.01\ninstance Semigroup a => Monoid (Maybe a) where\n    mempty = Nothing\n\n-- | For tuples, the 'Monoid' constraint on @a@ determines\n-- how the first values merge.\n-- For example, 'String's concatenate:\n--\n-- > (\"hello \", (+15)) <*> (\"world!\", 2002)\n-- > (\"hello world!\",2017)\n--\n-- @since 2.01\ninstance Monoid a => Applicative ((,) a) where\n    pure x = (mempty, x)\n    (u, f) <*> (v, x) = (u <> v, f x)\n    liftA2 f (u, x) (v, y) = (u <> v, f x y)\n\n-- | @since 4.9.0.0\ninstance Monoid a => Monad ((,) a) where\n    (u, a) >>= k = case k a of (v, b) -> (u <> v, b)\n\n-- | @since 4.10.0.0\ninstance Semigroup a => Semigroup (IO a) where\n    (<>) = liftA2 (<>)\n\n-- | @since 4.9.0.0\ninstance Monoid a => Monoid (IO a) where\n    mempty = pure mempty\n\n{- | A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@\nlets you apply any function from @(a -> b)@ to turn an @f a@ into an @f b@, preserving the\nstructure of @f@. Furthermore @f@ needs to adhere to the following:\n\n[Identity]    @'fmap' 'id' == 'id'@\n[Composition] @'fmap' (f . g) == 'fmap' f . 'fmap' g@\n\nNote, that the second law follows from the free theorem of the type 'fmap' and\nthe first law, so you need only check that the former condition holds.\n-}\n\nclass  Functor f  where\n    fmap        :: (a -> b) -> f a -> f b\n\n    -- | Replace all locations in the input with the same value.\n    -- The default definition is @'fmap' . 'const'@, but this may be\n    -- overridden with a more efficient version.\n    (<$)        :: a -> f b -> f a\n    (<$)        =  fmap . const\n\n-- | A functor with application, providing operations to\n--\n-- * embed pure expressions ('pure'), and\n--\n-- * sequence computations and combine their results ('<*>' and 'liftA2').\n--\n-- A minimal complete definition must include implementations of 'pure'\n-- and of either '<*>' or 'liftA2'. If it defines both, then they must behave\n-- the same as their default definitions:\n--\n--      @('<*>') = 'liftA2' 'id'@\n--\n--      @'liftA2' f x y = f 'Prelude.<$>' x '<*>' y@\n--\n-- Further, any definition must satisfy the following:\n--\n-- [Identity]\n--\n--      @'pure' 'id' '<*>' v = v@\n--\n-- [Composition]\n--\n--      @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@\n--\n-- [Homomorphism]\n--\n--      @'pure' f '<*>' 'pure' x = 'pure' (f x)@\n--\n-- [Interchange]\n--\n--      @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@\n--\n--\n-- The other methods have the following default definitions, which may\n-- be overridden with equivalent specialized implementations:\n--\n--   * @u '*>' v = ('id' '<$' u) '<*>' v@\n--\n--   * @u '<*' v = 'liftA2' 'const' u v@\n--\n-- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy\n--\n--   * @'fmap' f x = 'pure' f '<*>' x@\n--\n--\n-- It may be useful to note that supposing\n--\n--      @forall x y. p (q x y) = f x . g y@\n--\n-- it follows from the above that\n--\n--      @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@\n--\n--\n-- If @f@ is also a 'Monad', it should satisfy\n--\n--   * @'pure' = 'return'@\n--\n--   * @('<*>') = 'ap'@\n--\n--   * @('*>') = ('>>')@\n--\n-- (which implies that 'pure' and '<*>' satisfy the applicative functor laws).\n\nclass Functor f => Applicative f where\n    {-# MINIMAL pure, ((<*>) | liftA2) #-}\n    -- | Lift a value.\n    pure :: a -> f a\n\n    -- | Sequential application.\n    --\n    -- A few functors support an implementation of '<*>' that is more\n    -- efficient than the default one.\n    (<*>) :: f (a -> b) -> f a -> f b\n    (<*>) = liftA2 id\n\n    -- | Lift a binary function to actions.\n    --\n    -- Some functors support an implementation of 'liftA2' that is more\n    -- efficient than the default one. In particular, if 'fmap' is an\n    -- expensive operation, it is likely better to use 'liftA2' than to\n    -- 'fmap' over the structure and then use '<*>'.\n    liftA2 :: (a -> b -> c) -> f a -> f b -> f c\n    liftA2 f x = (<*>) (fmap f x)\n\n    -- | Sequence actions, discarding the value of the first argument.\n    (*>) :: f a -> f b -> f b\n    a1 *> a2 = (id <$ a1) <*> a2\n    -- This is essentially the same as liftA2 (flip const), but if the\n    -- Functor instance has an optimized (<$), it may be better to use\n    -- that instead. Before liftA2 became a method, this definition\n    -- was strictly better, but now it depends on the functor. For a\n    -- functor supporting a sharing-enhancing (<$), this definition\n    -- may reduce allocation by preventing a1 from ever being fully\n    -- realized. In an implementation with a boring (<$) but an optimizing\n    -- liftA2, it would likely be better to define (*>) using liftA2.\n\n    -- | Sequence actions, discarding the value of the second argument.\n    (<*) :: f a -> f b -> f a\n    (<*) = liftA2 const\n\n-- | A variant of '<*>' with the arguments reversed.\n(<**>) :: Applicative f => f a -> f (a -> b) -> f b\n(<**>) = liftA2 (\\a f -> f a)\n-- Don't use $ here, see the note at the top of the page\n\n-- | Lift a function to actions.\n-- This function may be used as a value for `fmap` in a `Functor` instance.\nliftA :: Applicative f => (a -> b) -> f a -> f b\nliftA f a = pure f <*> a\n-- Caution: since this may be used for `fmap`, we can't use the obvious\n-- definition of liftA = fmap.\n\n-- | Lift a ternary function to actions.\nliftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d\nliftA3 f a b c = liftA2 f a b <*> c\n\n\n{-# INLINABLE liftA #-}\n{-# SPECIALISE liftA :: (a1->r) -> IO a1 -> IO r #-}\n{-# SPECIALISE liftA :: (a1->r) -> Maybe a1 -> Maybe r #-}\n{-# INLINABLE liftA3 #-}\n{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-}\n{-# SPECIALISE liftA3 :: (a1->a2->a3->r) ->\n                                Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-}\n\n-- | The 'join' function is the conventional monad join operator. It\n-- is used to remove one level of monadic structure, projecting its\n-- bound argument into the outer level.\n--\n-- ==== __Examples__\n--\n-- A common use of 'join' is to run an 'IO' computation returned from\n-- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions\n-- can't perform 'IO' directly. Recall that\n--\n-- @\n-- 'GHC.Conc.atomically' :: STM a -> IO a\n-- @\n--\n-- is used to run 'GHC.Conc.STM' transactions atomically. So, by\n-- specializing the types of 'GHC.Conc.atomically' and 'join' to\n--\n-- @\n-- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b)\n-- 'join'       :: IO (IO b)  -> IO b\n-- @\n--\n-- we can compose them as\n--\n-- @\n-- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b\n-- @\n--\n-- to run an 'GHC.Conc.STM' transaction and the 'IO' action it\n-- returns.\njoin              :: (Monad m) => m (m a) -> m a\njoin x            =  x >>= id\n\n{- | The 'Monad' class defines the basic operations over a /monad/,\na concept from a branch of mathematics known as /category theory/.\nFrom the perspective of a Haskell programmer, however, it is best to\nthink of a monad as an /abstract datatype/ of actions.\nHaskell's @do@ expressions provide a convenient syntax for writing\nmonadic expressions.\n\nInstances of 'Monad' should satisfy the following:\n\n[Left identity]  @'return' a '>>=' k  =  k a@\n[Right identity] @m '>>=' 'return'  =  m@\n[Associativity]  @m '>>=' (\\\\x -> k x '>>=' h)  =  (m '>>=' k) '>>=' h@\n\nFurthermore, the 'Monad' and 'Applicative' operations should relate as follows:\n\n* @'pure' = 'return'@\n* @('<*>') = 'ap'@\n\nThe above laws imply:\n\n* @'fmap' f xs  =  xs '>>=' 'return' . f@\n* @('>>') = ('*>')@\n\nand that 'pure' and ('<*>') satisfy the applicative functor laws.\n\nThe instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'\ndefined in the \"Prelude\" satisfy these laws.\n-}\nclass Applicative m => Monad m where\n    -- | Sequentially compose two actions, passing any value produced\n    -- by the first as an argument to the second.\n    (>>=)       :: forall a b. m a -> (a -> m b) -> m b\n\n    -- | Sequentially compose two actions, discarding any value produced\n    -- by the first, like sequencing operators (such as the semicolon)\n    -- in imperative languages.\n    (>>)        :: forall a b. m a -> m b -> m b\n    m >> k = m >>= \\_ -> k -- See Note [Recursive bindings for Applicative/Monad]\n    {-# INLINE (>>) #-}\n\n    -- | Inject a value into the monadic type.\n    return      :: a -> m a\n    return      = pure\n\n    -- | Fail with a message.  This operation is not part of the\n    -- mathematical definition of a monad, but is invoked on pattern-match\n    -- failure in a @do@ expression.\n    --\n    -- As part of the MonadFail proposal (MFP), this function is moved\n    -- to its own class 'Control.Monad.MonadFail' (see \"Control.Monad.Fail\" for\n    -- more details). The definition here will be removed in a future\n    -- release.\n    fail        :: String -> m a\n    fail s      = errorWithoutStackTrace s\n\n{- Note [Recursive bindings for Applicative/Monad]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nThe original Applicative/Monad proposal stated that after\nimplementation, the designated implementation of (>>) would become\n\n  (>>) :: forall a b. m a -> m b -> m b\n  (>>) = (*>)\n\nby default. You might be inclined to change this to reflect the stated\nproposal, but you really shouldn't! Why? Because people tend to define\nsuch instances the /other/ way around: in particular, it is perfectly\nlegitimate to define an instance of Applicative (*>) in terms of (>>),\nwhich would lead to an infinite loop for the default implementation of\nMonad! And people do this in the wild.\n\nThis turned into a nasty bug that was tricky to track down, and rather\nthan eliminate it everywhere upstream, it's easier to just retain the\noriginal default.\n\n-}\n\n-- | Same as '>>=', but with the arguments interchanged.\n{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}\n(=<<)           :: Monad m => (a -> m b) -> m a -> m b\nf =<< x         = x >>= f\n\n-- | Conditional execution of 'Applicative' expressions. For example,\n--\n-- > when debug (putStrLn \"Debugging\")\n--\n-- will output the string @Debugging@ if the Boolean value @debug@\n-- is 'True', and otherwise do nothing.\nwhen      :: (Applicative f) => Bool -> f () -> f ()\n{-# INLINABLE when #-}\n{-# SPECIALISE when :: Bool -> IO () -> IO () #-}\n{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-}\nwhen p s  = if p then s else pure ()\n\n-- | Evaluate each action in the sequence from left to right,\n-- and collect the results.\nsequence :: Monad m => [m a] -> m [a]\n{-# INLINE sequence #-}\nsequence = mapM id\n-- Note: [sequence and mapM]\n\n-- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@.\nmapM :: Monad m => (a -> m b) -> [a] -> m [b]\n{-# INLINE mapM #-}\nmapM f as = foldr k (return []) as\n            where\n              k a r = do { x <- f a; xs <- r; return (x:xs) }\n\n{-\nNote: [sequence and mapM]\n~~~~~~~~~~~~~~~~~~~~~~~~~\nOriginally, we defined\n\nmapM f = sequence . map f\n\nThis relied on list fusion to produce efficient code for mapM, and led to\nexcessive allocation in cryptarithm2. Defining\n\nsequence = mapM id\n\nrelies only on inlining a tiny function (id) and beta reduction, which tends to\nbe a more reliable aspect of simplification. Indeed, this does not lead to\nsimilar problems in nofib.\n-}\n\n-- | Promote a function to a monad.\nliftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r\nliftM f m1              = do { x1 <- m1; return (f x1) }\n\n-- | Promote a function to a monad, scanning the monadic arguments from\n-- left to right.  For example,\n--\n-- > liftM2 (+) [0,1] [0,2] = [0,2,1,3]\n-- > liftM2 (+) (Just 1) Nothing = Nothing\n--\nliftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r\nliftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }\n-- Caution: since this may be used for `liftA2`, we can't use the obvious\n-- definition of liftM2 = liftA2.\n\n-- | Promote a function to a monad, scanning the monadic arguments from\n-- left to right (cf. 'liftM2').\nliftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r\nliftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }\n\n-- | Promote a function to a monad, scanning the monadic arguments from\n-- left to right (cf. 'liftM2').\nliftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r\nliftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }\n\n-- | Promote a function to a monad, scanning the monadic arguments from\n-- left to right (cf. 'liftM2').\nliftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r\nliftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }\n\n{-# INLINABLE liftM #-}\n{-# SPECIALISE liftM :: (a1->r) -> IO a1 -> IO r #-}\n{-# SPECIALISE liftM :: (a1->r) -> Maybe a1 -> Maybe r #-}\n{-# INLINABLE liftM2 #-}\n{-# SPECIALISE liftM2 :: (a1->a2->r) -> IO a1 -> IO a2 -> IO r #-}\n{-# SPECIALISE liftM2 :: (a1->a2->r) -> Maybe a1 -> Maybe a2 -> Maybe r #-}\n{-# INLINABLE liftM3 #-}\n{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-}\n{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-}\n{-# INLINABLE liftM4 #-}\n{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO r #-}\n{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe r #-}\n{-# INLINABLE liftM5 #-}\n{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO a5 -> IO r #-}\n{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-}\n\n{- | In many situations, the 'liftM' operations can be replaced by uses of\n'ap', which promotes function application.\n\n> return f `ap` x1 `ap` ... `ap` xn\n\nis equivalent to\n\n> liftMn f x1 x2 ... xn\n\n-}\n\nap                :: (Monad m) => m (a -> b) -> m a -> m b\nap m1 m2          = do { x1 <- m1; x2 <- m2; return (x1 x2) }\n-- Since many Applicative instances define (<*>) = ap, we\n-- cannot define ap = (<*>)\n{-# INLINABLE ap #-}\n{-# SPECIALISE ap :: IO (a -> b) -> IO a -> IO b #-}\n{-# SPECIALISE ap :: Maybe (a -> b) -> Maybe a -> Maybe b #-}\n\n-- instances for Prelude types\n\n-- | @since 2.01\ninstance Functor ((->) r) where\n    fmap = (.)\n\n-- | @since 2.01\ninstance Applicative ((->) a) where\n    pure = const\n    (<*>) f g x = f x (g x)\n    liftA2 q f g x = q (f x) (g x)\n\n-- | @since 2.01\ninstance Monad ((->) r) where\n    f >>= k = \\ r -> k (f r) r\n\n-- | @since 2.01\ninstance Functor ((,) a) where\n    fmap f (x,y) = (x, f y)\n\n-- | @since 2.01\ninstance  Functor Maybe  where\n    fmap _ Nothing       = Nothing\n    fmap f (Just a)      = Just (f a)\n\n-- | @since 2.01\ninstance Applicative Maybe where\n    pure = Just\n\n    Just f  <*> m       = fmap f m\n    Nothing <*> _m      = Nothing\n\n    liftA2 f (Just x) (Just y) = Just (f x y)\n    liftA2 _ _ _ = Nothing\n\n    Just _m1 *> m2      = m2\n    Nothing  *> _m2     = Nothing\n\n-- | @since 2.01\ninstance  Monad Maybe  where\n    (Just x) >>= k      = k x\n    Nothing  >>= _      = Nothing\n\n    (>>) = (*>)\n\n    fail _              = Nothing\n\n-- -----------------------------------------------------------------------------\n-- The Alternative class definition\n\ninfixl 3 <|>\n\n-- | A monoid on applicative functors.\n--\n-- If defined, 'some' and 'many' should be the least solutions\n-- of the equations:\n--\n-- * @'some' v = (:) 'Prelude.<$>' v '<*>' 'many' v@\n--\n-- * @'many' v = 'some' v '<|>' 'pure' []@\nclass Applicative f => Alternative f where\n    -- | The identity of '<|>'\n    empty :: f a\n    -- | An associative binary operation\n    (<|>) :: f a -> f a -> f a\n\n    -- | One or more.\n    some :: f a -> f [a]\n    some v = some_v\n      where\n        many_v = some_v <|> pure []\n        some_v = liftA2 (:) v many_v\n\n    -- | Zero or more.\n    many :: f a -> f [a]\n    many v = many_v\n      where\n        many_v = some_v <|> pure []\n        some_v = liftA2 (:) v many_v\n\n\n-- | @since 2.01\ninstance Alternative Maybe where\n    empty = Nothing\n    Nothing <|> r = r\n    l       <|> _ = l\n\n-- -----------------------------------------------------------------------------\n-- The MonadPlus class definition\n\n-- | Monads that also support choice and failure.\nclass (Alternative m, Monad m) => MonadPlus m where\n   -- | The identity of 'mplus'.  It should also satisfy the equations\n   --\n   -- > mzero >>= f  =  mzero\n   -- > v >> mzero   =  mzero\n   --\n   -- The default definition is\n   --\n   -- @\n   -- mzero = 'empty'\n   -- @\n   mzero :: m a\n   mzero = empty\n\n   -- | An associative operation. The default definition is\n   --\n   -- @\n   -- mplus = ('<|>')\n   -- @\n   mplus :: m a -> m a -> m a\n   mplus = (<|>)\n\n-- | @since 2.01\ninstance MonadPlus Maybe\n\n---------------------------------------------\n-- The non-empty list type\n\ninfixr 5 :|\n\n-- | Non-empty (and non-strict) list type.\n--\n-- @since 4.9.0.0\ndata NonEmpty a = a :| [a]\n  deriving ( Eq  -- ^ @since 4.9.0.0\n           , Ord -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Functor NonEmpty where\n  fmap f ~(a :| as) = f a :| fmap f as\n  b <$ ~(_ :| as)   = b   :| (b <$ as)\n\n-- | @since 4.9.0.0\ninstance Applicative NonEmpty where\n  pure a = a :| []\n  (<*>) = ap\n  liftA2 = liftM2\n\n-- | @since 4.9.0.0\ninstance Monad NonEmpty where\n  ~(a :| as) >>= f = b :| (bs ++ bs')\n    where b :| bs = f a\n          bs' = as >>= toList . f\n          toList ~(c :| cs) = c : cs\n\n----------------------------------------------\n-- The list type\n\n-- | @since 2.01\ninstance Functor [] where\n    {-# INLINE fmap #-}\n    fmap = map\n\n-- See Note: [List comprehensions and inlining]\n-- | @since 2.01\ninstance Applicative [] where\n    {-# INLINE pure #-}\n    pure x    = [x]\n    {-# INLINE (<*>) #-}\n    fs <*> xs = [f x | f <- fs, x <- xs]\n    {-# INLINE liftA2 #-}\n    liftA2 f xs ys = [f x y | x <- xs, y <- ys]\n    {-# INLINE (*>) #-}\n    xs *> ys  = [y | _ <- xs, y <- ys]\n\n-- See Note: [List comprehensions and inlining]\n-- | @since 2.01\ninstance Monad []  where\n    {-# INLINE (>>=) #-}\n    xs >>= f             = [y | x <- xs, y <- f x]\n    {-# INLINE (>>) #-}\n    (>>) = (*>)\n    {-# INLINE fail #-}\n    fail _              = []\n\n-- | @since 2.01\ninstance Alternative [] where\n    empty = []\n    (<|>) = (++)\n\n-- | @since 2.01\ninstance MonadPlus []\n\n{-\nA few list functions that appear here because they are used here.\nThe rest of the prelude list functions are in GHC.List.\n-}\n\n----------------------------------------------\n--      foldr/build/augment\n----------------------------------------------\n\n-- | 'foldr', applied to a binary operator, a starting value (typically\n-- the right-identity of the operator), and a list, reduces the list\n-- using the binary operator, from right to left:\n--\n-- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)\n\nfoldr            :: (a -> b -> b) -> b -> [a] -> b\n-- foldr _ z []     =  z\n-- foldr f z (x:xs) =  f x (foldr f z xs)\n{-# INLINE [0] foldr #-}\n-- Inline only in the final stage, after the foldr/cons rule has had a chance\n-- Also note that we inline it when it has *two* parameters, which are the\n-- ones we are keen about specialising!\nfoldr k z = go\n          where\n            go []     = z\n            go (y:ys) = y `k` go ys\n\n-- | A list producer that can be fused with 'foldr'.\n-- This function is merely\n--\n-- >    build g = g (:) []\n--\n-- but GHC's simplifier will transform an expression of the form\n-- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@,\n-- which avoids producing an intermediate list.\n\nbuild   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]\n{-# INLINE [1] build #-}\n        -- The INLINE is important, even though build is tiny,\n        -- because it prevents [] getting inlined in the version that\n        -- appears in the interface file.  If [] *is* inlined, it\n        -- won't match with [] appearing in rules in an importing module.\n        --\n        -- The \"1\" says to inline in phase 1\n\nbuild g = g (:) []\n\n-- | A list producer that can be fused with 'foldr'.\n-- This function is merely\n--\n-- >    augment g xs = g (:) xs\n--\n-- but GHC's simplifier will transform an expression of the form\n-- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to\n-- @g k ('foldr' k z xs)@, which avoids producing an intermediate list.\n\naugment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]\n{-# INLINE [1] augment #-}\naugment g xs = g (:) xs\n\n{-# RULES\n\"fold/build\"    forall k z (g::forall b. (a->b->b) -> b -> b) .\n                foldr k z (build g) = g k z\n\n\"foldr/augment\" forall k z xs (g::forall b. (a->b->b) -> b -> b) .\n                foldr k z (augment g xs) = g k (foldr k z xs)\n\n\"foldr/id\"                        foldr (:) [] = \\x  -> x\n\"foldr/app\"     [1] forall ys. foldr (:) ys = \\xs -> xs ++ ys\n        -- Only activate this from phase 1, because that's\n        -- when we disable the rule that expands (++) into foldr\n\n-- The foldr/cons rule looks nice, but it can give disastrously\n-- bloated code when commpiling\n--      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]\n-- i.e. when there are very very long literal lists\n-- So I've disabled it for now. We could have special cases\n-- for short lists, I suppose.\n-- \"foldr/cons\" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)\n\n\"foldr/single\"  forall k z x. foldr k z [x] = k x z\n\"foldr/nil\"     forall k z.   foldr k z []  = z\n\n\"foldr/cons/build\" forall k z x (g::forall b. (a->b->b) -> b -> b) .\n                           foldr k z (x:build g) = k x (g k z)\n\n\"augment/build\" forall (g::forall b. (a->b->b) -> b -> b)\n                       (h::forall b. (a->b->b) -> b -> b) .\n                       augment g (build h) = build (\\c n -> g c (h c n))\n\"augment/nil\"   forall (g::forall b. (a->b->b) -> b -> b) .\n                        augment g [] = build g\n #-}\n\n-- This rule is true, but not (I think) useful:\n--      augment g (augment h t) = augment (\\cn -> g c (h c n)) t\n\n----------------------------------------------\n--              map\n----------------------------------------------\n\n-- | /O(n)/. 'map' @f xs@ is the list obtained by applying @f@ to each element\n-- of @xs@, i.e.,\n--\n-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]\n-- > map f [x1, x2, ...] == [f x1, f x2, ...]\n--\n-- >>> map (+1) [1, 2, 3]\n--- [2,3,4]\n\nmap :: (a -> b) -> [a] -> [b]\n{-# NOINLINE [0] map #-}\n  -- We want the RULEs \"map\" and \"map/coerce\" to fire first.\n  -- map is recursive, so won't inline anyway,\n  -- but saying so is more explicit, and silences warnings\nmap _ []     = []\nmap f (x:xs) = f x : map f xs\n\n-- Note eta expanded\nmapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst\n{-# INLINE [0] mapFB #-} -- See Note [Inline FB functions] in GHC.List\nmapFB c f = \\x ys -> c (f x) ys\n\n{- Note [The rules for map]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThe rules for map work like this.\n\n* Up to (but not including) phase 1, we use the \"map\" rule to\n  rewrite all saturated applications of map with its build/fold\n  form, hoping for fusion to happen.\n\n  In phase 1 and 0, we switch off that rule, inline build, and\n  switch on the \"mapList\" rule, which rewrites the foldr/mapFB\n  thing back into plain map.\n\n  It's important that these two rules aren't both active at once\n  (along with build's unfolding) else we'd get an infinite loop\n  in the rules.  Hence the activation control below.\n\n* This same pattern is followed by many other functions:\n  e.g. append, filter, iterate, repeat, etc. in GHC.List\n\n  See also Note [Inline FB functions] in GHC.List\n\n* The \"mapFB\" rule optimises compositions of map\n\n* The \"mapFB/id\" rule gets rid of 'map id' calls.\n  You might think that (mapFB c id) will turn into c simply\n  when mapFB is inlined; but before that happens the \"mapList\"\n  rule turns\n     (foldr (mapFB (:) id) [] a\n  back into\n     map id\n  Which is not very clever.\n\n* Any similarity to the Functor laws for [] is expected.\n-}\n\n{-# RULES\n\"map\"       [~1] forall f xs.   map f xs                = build (\\c n -> foldr (mapFB c f) n xs)\n\"mapList\"   [1]  forall f.      foldr (mapFB (:) f) []  = map f\n\"mapFB\"     forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g)\n\"mapFB/id\"  forall c.           mapFB c (\\x -> x)       = c\n  #-}\n\n-- See Breitner, Eisenberg, Peyton Jones, and Weirich, \"Safe Zero-cost\n-- Coercions for Haskell\", section 6.5:\n--   http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf\n\n{-# RULES \"map/coerce\" [1] map coerce = coerce #-}\n\n\n----------------------------------------------\n--              append\n----------------------------------------------\n\n-- | Append two lists, i.e.,\n--\n-- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn]\n-- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...]\n--\n-- If the first list is not finite, the result is the first list.\n\n(++) :: [a] -> [a] -> [a]\n{-# NOINLINE [1] (++) #-}    -- We want the RULE to fire first.\n                             -- It's recursive, so won't inline anyway,\n                             -- but saying so is more explicit\n(++) []     ys = ys\n(++) (x:xs) ys = x : xs ++ ys\n\n{-# RULES\n\"++\"    [~1] forall xs ys. xs ++ ys = augment (\\c n -> foldr c n xs) ys\n  #-}\n\n\n-- |'otherwise' is defined as the value 'True'.  It helps to make\n-- guards more readable.  eg.\n--\n-- >  f x | x < 0     = ...\n-- >      | otherwise = ...\notherwise               :: Bool\notherwise               =  True\n\n----------------------------------------------\n-- Type Char and String\n----------------------------------------------\n\n-- | A 'String' is a list of characters.  String constants in Haskell are values\n-- of type 'String'.\n--\ntype String = [Char]\n\nunsafeChr :: Int -> Char\nunsafeChr (I# i#) = C# (chr# i#)\n\n-- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'.\nord :: Char -> Int\nord (C# c#) = I# (ord# c#)\n\n-- | This 'String' equality predicate is used when desugaring\n-- pattern-matches against strings.\neqString :: String -> String -> Bool\neqString []       []       = True\neqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2\neqString _        _        = False\n\n{-# RULES \"eqString\" (==) = eqString #-}\n-- eqString also has a BuiltInRule in PrelRules.hs:\n--      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2\n\n\n----------------------------------------------\n-- 'Int' related definitions\n----------------------------------------------\n\nmaxInt, minInt :: Int\n\n{- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}\n#if WORD_SIZE_IN_BITS == 31\nminInt  = I# (-0x40000000#)\nmaxInt  = I# 0x3FFFFFFF#\n#elif WORD_SIZE_IN_BITS == 32\nminInt  = I# (-0x80000000#)\nmaxInt  = I# 0x7FFFFFFF#\n#else\nminInt  = I# (-0x8000000000000000#)\nmaxInt  = I# 0x7FFFFFFFFFFFFFFF#\n#endif\n\n----------------------------------------------\n-- The function type\n----------------------------------------------\n\n-- | Identity function.\n--\n-- > id x = x\nid                      :: a -> a\nid x                    =  x\n\n-- Assertion function.  This simply ignores its boolean argument.\n-- The compiler may rewrite it to @('assertError' line)@.\n\n-- | If the first argument evaluates to 'True', then the result is the\n-- second argument.  Otherwise an 'Control.Exception.AssertionFailed' exception\n-- is raised, containing a 'String' with the source file and line number of the\n-- call to 'assert'.\n--\n-- Assertions can normally be turned on or off with a compiler flag\n-- (for GHC, assertions are normally on unless optimisation is turned on\n-- with @-O@ or the @-fignore-asserts@\n-- option is given).  When assertions are turned off, the first\n-- argument to 'assert' is ignored, and the second argument is\n-- returned as the result.\n\n--      SLPJ: in 5.04 etc 'assert' is in GHC.Prim,\n--      but from Template Haskell onwards it's simply\n--      defined here in Base.hs\nassert :: Bool -> a -> a\nassert _pred r = r\n\nbreakpoint :: a -> a\nbreakpoint r = r\n\nbreakpointCond :: Bool -> a -> a\nbreakpointCond _ r = r\n\ndata Opaque = forall a. O a\n-- | @const x@ is a unary function which evaluates to @x@ for all inputs.\n--\n-- >>> const 42 \"hello\"\n-- 42\n--\n-- >>> map (const 42) [0..3]\n-- [42,42,42,42]\nconst                   :: a -> b -> a\nconst x _               =  x\n\n-- | Function composition.\n{-# INLINE (.) #-}\n-- Make sure it has TWO args only on the left, so that it inlines\n-- when applied to two functions, even if there is no final argument\n(.)    :: (b -> c) -> (a -> b) -> a -> c\n(.) f g = \\x -> f (g x)\n\n-- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@.\n--\n-- >>> flip (++) \"hello\" \"world\"\n-- \"worldhello\"\nflip                    :: (a -> b -> c) -> b -> a -> c\nflip f x y              =  f y x\n\n-- | Application operator.  This operator is redundant, since ordinary\n-- application @(f x)@ means the same as @(f '$' x)@. However, '$' has\n-- low, right-associative binding precedence, so it sometimes allows\n-- parentheses to be omitted; for example:\n--\n-- > f $ g $ h x  =  f (g (h x))\n--\n-- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,\n-- or @'Data.List.zipWith' ('$') fs xs@.\n--\n-- Note that @('$')@ is levity-polymorphic in its result type, so that\n-- @foo '$' True@ where @foo :: Bool -> Int#@ is well-typed.\n{-# INLINE ($) #-}\n($) :: forall r a (b :: TYPE r). (a -> b) -> a -> b\nf $ x =  f x\n\n-- | Strict (call-by-value) application operator. It takes a function and an\n-- argument, evaluates the argument to weak head normal form (WHNF), then calls\n-- the function with that value.\n\n($!) :: forall r a (b :: TYPE r). (a -> b) -> a -> b\nf $! x = let !vx = x in f vx  -- see #2273\n\n-- | @'until' p f@ yields the result of applying @f@ until @p@ holds.\nuntil                   :: (a -> Bool) -> (a -> a) -> a -> a\nuntil p f = go\n  where\n    go x | p x          = x\n         | otherwise    = go (f x)\n\n-- | 'asTypeOf' is a type-restricted version of 'const'.  It is usually\n-- used as an infix operator, and its typing forces its first argument\n-- (which is usually overloaded) to have the same type as the second.\nasTypeOf                :: a -> a -> a\nasTypeOf                =  const\n\n----------------------------------------------\n-- Functor/Applicative/Monad instances for IO\n----------------------------------------------\n\n-- | @since 2.01\ninstance  Functor IO where\n   fmap f x = x >>= (pure . f)\n\n-- | @since 2.01\ninstance Applicative IO where\n    {-# INLINE pure #-}\n    {-# INLINE (*>) #-}\n    {-# INLINE liftA2 #-}\n    pure  = returnIO\n    (*>)  = thenIO\n    (<*>) = ap\n    liftA2 = liftM2\n\n-- | @since 2.01\ninstance  Monad IO  where\n    {-# INLINE (>>)   #-}\n    {-# INLINE (>>=)  #-}\n    (>>)      = (*>)\n    (>>=)     = bindIO\n    fail s    = failIO s\n\n-- | @since 4.9.0.0\ninstance Alternative IO where\n    empty = failIO \"mzero\"\n    (<|>) = mplusIO\n\n-- | @since 4.9.0.0\ninstance MonadPlus IO\n\nreturnIO :: a -> IO a\nreturnIO x = IO (\\ s -> (# s, x #))\n\nbindIO :: IO a -> (a -> IO b) -> IO b\nbindIO (IO m) k = IO (\\ s -> case m s of (# new_s, a #) -> unIO (k a) new_s)\n\nthenIO :: IO a -> IO b -> IO b\nthenIO (IO m) k = IO (\\ s -> case m s of (# new_s, _ #) -> unIO k new_s)\n\nunIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))\nunIO (IO a) = a\n\n{- |\nReturns the tag of a constructor application; this function is used\nby the deriving code for Eq, Ord and Enum.\n-}\n{-# INLINE getTag #-}\ngetTag :: a -> Int#\ngetTag x = dataToTag# x\n\n----------------------------------------------\n-- Numeric primops\n----------------------------------------------\n\n-- Definitions of the boxed PrimOps; these will be\n-- used in the case of partial applications, etc.\n\n{-# INLINE quotInt #-}\n{-# INLINE remInt #-}\n\nquotInt, remInt, divInt, modInt :: Int -> Int -> Int\n(I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)\n(I# x) `remInt`   (I# y) = I# (x `remInt#`  y)\n(I# x) `divInt`   (I# y) = I# (x `divInt#`  y)\n(I# x) `modInt`   (I# y) = I# (x `modInt#`  y)\n\nquotRemInt :: Int -> Int -> (Int, Int)\n(I# x) `quotRemInt` (I# y) = case x `quotRemInt#` y of\n                             (# q, r #) ->\n                                 (I# q, I# r)\n\ndivModInt :: Int -> Int -> (Int, Int)\n(I# x) `divModInt` (I# y) = case x `divModInt#` y of\n                            (# q, r #) -> (I# q, I# r)\n\ndivModInt# :: Int# -> Int# -> (# Int#, Int# #)\nx# `divModInt#` y#\n | isTrue# (x# ># 0#) && isTrue# (y# <# 0#) =\n                                    case (x# -# 1#) `quotRemInt#` y# of\n                                      (# q, r #) -> (# q -# 1#, r +# y# +# 1# #)\n | isTrue# (x# <# 0#) && isTrue# (y# ># 0#) =\n                                    case (x# +# 1#) `quotRemInt#` y# of\n                                      (# q, r #) -> (# q -# 1#, r +# y# -# 1# #)\n | otherwise                                =\n                                    x# `quotRemInt#` y#\n\n-- Wrappers for the shift operations.  The uncheckedShift# family are\n-- undefined when the amount being shifted by is greater than the size\n-- in bits of Int#, so these wrappers perform a check and return\n-- either zero or -1 appropriately.\n--\n-- Note that these wrappers still produce undefined results when the\n-- second argument (the shift amount) is negative.\n\n-- | Shift the argument left by the specified number of bits\n-- (which must be non-negative).\nshiftL# :: Word# -> Int# -> Word#\na `shiftL#` b   | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##\n                | otherwise                          = a `uncheckedShiftL#` b\n\n-- | Shift the argument right by the specified number of bits\n-- (which must be non-negative).\n-- The \"RL\" means \"right, logical\" (as opposed to RA for arithmetic)\n-- (although an arithmetic right shift wouldn't make sense for Word#)\nshiftRL# :: Word# -> Int# -> Word#\na `shiftRL#` b  | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##\n                | otherwise                          = a `uncheckedShiftRL#` b\n\n-- | Shift the argument left by the specified number of bits\n-- (which must be non-negative).\niShiftL# :: Int# -> Int# -> Int#\na `iShiftL#` b  | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#\n                | otherwise                          = a `uncheckedIShiftL#` b\n\n-- | Shift the argument right (signed) by the specified number of bits\n-- (which must be non-negative).\n-- The \"RA\" means \"right, arithmetic\" (as opposed to RL for logical)\niShiftRA# :: Int# -> Int# -> Int#\na `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = if isTrue# (a <# 0#)\n                                                          then (-1#)\n                                                          else 0#\n                | otherwise                          = a `uncheckedIShiftRA#` b\n\n-- | Shift the argument right (unsigned) by the specified number of bits\n-- (which must be non-negative).\n-- The \"RL\" means \"right, logical\" (as opposed to RA for arithmetic)\niShiftRL# :: Int# -> Int# -> Int#\na `iShiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#\n                | otherwise                          = a `uncheckedIShiftRL#` b\n\n-- Rules for C strings (the functions themselves are now in GHC.CString)\n{-# RULES\n\"unpack\"       [~1] forall a   . unpackCString# a             = build (unpackFoldrCString# a)\n\"unpack-list\"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a\n\"unpack-append\"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n\n\n-- There's a built-in rule (in PrelRules.hs) for\n--      unpackFoldr \"foo\" c (unpackFoldr \"baz\" c n)  =  unpackFoldr \"foobaz\" c n\n\n  #-}\n", "num_lines": 1488}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.ByteOrder\n-- Copyright   :  (c) The University of Glasgow, 1994-2000\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Target byte ordering.\n--\n-- @since 4.11.0.0\n-----------------------------------------------------------------------------\n\nmodule GHC.ByteOrder where\n\n-- | Byte ordering.\ndata ByteOrder\n    = BigEndian    -- ^ most-significant-byte occurs in lowest address.\n    | LittleEndian -- ^ least-significant-byte occurs in lowest address.\n    deriving ( Eq      -- ^ @since 4.11.0.0\n             , Ord     -- ^ @since 4.11.0.0\n             , Bounded -- ^ @since 4.11.0.0\n             , Enum    -- ^ @since 4.11.0.0\n             , Read    -- ^ @since 4.11.0.0\n             , Show    -- ^ @since 4.11.0.0\n             )\n\n-- | The byte ordering of the target machine.\ntargetByteOrder :: ByteOrder\n#if defined(WORDS_BIGENDIAN)\ntargetByteOrder = BigEndian\n#else\ntargetByteOrder = LittleEndian\n#endif\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash #-}\n\nmodule GHC.Char\n    ( -- * Utilities\n      chr\n\n      -- * Monomorphic equality operators\n      -- | See GHC.Classes#matching_overloaded_methods_in_rules\n    , eqChar, neChar\n    ) where\n\nimport GHC.Base\nimport GHC.Show\n\n-- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'.\nchr :: Int -> Char\nchr i@(I# i#)\n | isTrue# (int2Word# i# `leWord#` 0x10FFFF##) = C# (chr# i#)\n | otherwise\n    = errorWithoutStackTrace (\"Prelude.chr: bad argument: \" ++ showSignedInt (I# 9#) i \"\")\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE CPP, NoImplicitPrelude #-}\n{-# OPTIONS_GHC -Wno-missing-signatures #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Conc\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Basic concurrency stuff.\n--\n-----------------------------------------------------------------------------\n\n-- No: #hide, because bits of this module are exposed by the stm package.\n-- However, we don't want this module to be the home location for the\n-- bits it exports, we'd rather have Control.Concurrent and the other\n-- higher level modules be the home.  Hence: #not-home\n\nmodule GHC.Conc\n        ( ThreadId(..)\n\n        -- * Forking and suchlike\n        , forkIO\n        , forkIOWithUnmask\n        , forkOn\n        , forkOnWithUnmask\n        , numCapabilities\n        , getNumCapabilities\n        , setNumCapabilities\n        , getNumProcessors\n        , numSparks\n        , childHandler\n        , myThreadId\n        , killThread\n        , throwTo\n        , par\n        , pseq\n        , runSparks\n        , yield\n        , labelThread\n        , mkWeakThreadId\n\n        , ThreadStatus(..), BlockReason(..)\n        , threadStatus\n        , threadCapability\n\n        , newStablePtrPrimMVar, PrimMVar\n\n        -- * Waiting\n        , threadDelay\n        , registerDelay\n        , threadWaitRead\n        , threadWaitWrite\n        , threadWaitReadSTM\n        , threadWaitWriteSTM\n        , closeFdWith\n\n        -- * Allocation counter and limit\n        , setAllocationCounter\n        , getAllocationCounter\n        , enableAllocationLimit\n        , disableAllocationLimit\n\n        -- * TVars\n        , STM(..)\n        , atomically\n        , retry\n        , orElse\n        , throwSTM\n        , catchSTM\n        , TVar(..)\n        , newTVar\n        , newTVarIO\n        , readTVar\n        , readTVarIO\n        , writeTVar\n        , unsafeIOToSTM\n\n        -- * Miscellaneous\n        , withMVar\n#if defined(mingw32_HOST_OS)\n        , asyncRead\n        , asyncWrite\n        , asyncDoProc\n\n        , asyncReadBA\n        , asyncWriteBA\n#endif\n\n#if !defined(mingw32_HOST_OS)\n        , Signal, HandlerFun, setHandler, runHandlers\n#endif\n\n        , ensureIOManagerIsRunning\n        , ioManagerCapabilitiesChanged\n\n#if defined(mingw32_HOST_OS)\n        , ConsoleEvent(..)\n        , win32ConsoleHandler\n        , toWin32ConsoleEvent\n#endif\n        , setUncaughtExceptionHandler\n        , getUncaughtExceptionHandler\n\n        , reportError, reportStackOverflow, reportHeapOverflow\n        ) where\n\nimport GHC.Conc.IO\nimport GHC.Conc.Sync\n\n#if !defined(mingw32_HOST_OS)\nimport GHC.Conc.Signal\n#endif\n", "num_lines": 120}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.ConsoleHandler\n-- Copyright   :  (c) The University of Glasgow\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- NB. the contents of this module are only available on Windows.\n--\n-- Installing Win32 console handlers.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.ConsoleHandler\n#if !defined(mingw32_HOST_OS)\n        where\n\nimport GHC.Base ()  -- dummy dependency\n#else /* whole file */\n        ( Handler(..)\n        , installHandler\n        , ConsoleEvent(..)\n        , flushConsole\n        ) where\n\n{-\n#include \"rts/Signals.h\"\n\nNote: this #include is inside a Haskell comment\n      but it brings into scope some #defines\n      that are used by CPP below (eg STG_SIG_DFL).\n      Having it in a comment means that there's no\n      danger that C-like crap will be misunderstood\n      by GHC\n-}\n\nimport GHC.Base\nimport Foreign\nimport Foreign.C\nimport GHC.IO.FD\nimport GHC.IO.Exception\nimport GHC.IO.Handle.Types\nimport GHC.IO.Handle.Internals\nimport GHC.Conc\nimport Control.Concurrent.MVar\nimport Data.Typeable\n\ndata Handler\n = Default\n | Ignore\n | Catch (ConsoleEvent -> IO ())\n\n-- | Allows Windows console events to be caught and handled.  To\n-- handle a console event, call 'installHandler' passing the\n-- appropriate 'Handler' value.  When the event is received, if the\n-- 'Handler' value is @Catch f@, then a new thread will be spawned by\n-- the system to execute @f e@, where @e@ is the 'ConsoleEvent' that\n-- was received.\n--\n-- Note that console events can only be received by an application\n-- running in a Windows console.  Certain environments that look like consoles\n-- do not support console events, these include:\n--\n--  * Cygwin shells with @CYGWIN=tty@ set (if you don't set @CYGWIN=tty@,\n--    then a Cygwin shell behaves like a Windows console).\n--  * Cygwin xterm and rxvt windows\n--  * MSYS rxvt windows\n--\n-- In order for your application to receive console events, avoid running\n-- it in one of these environments.\n--\ninstallHandler :: Handler -> IO Handler\ninstallHandler handler\n  | threaded =\n    modifyMVar win32ConsoleHandler $ \\old_h -> do\n      (new_h,rc) <-\n        case handler of\n          Default -> do\n            r <- rts_installHandler STG_SIG_DFL nullPtr\n            return (no_handler, r)\n          Ignore  -> do\n            r <- rts_installHandler STG_SIG_IGN nullPtr\n            return (no_handler, r)\n          Catch h -> do\n            r <- rts_installHandler STG_SIG_HAN nullPtr\n            return (h, r)\n      prev_handler <-\n        case rc of\n          STG_SIG_DFL -> return Default\n          STG_SIG_IGN -> return Ignore\n          STG_SIG_HAN -> return (Catch old_h)\n          _           -> errorWithoutStackTrace \"installHandler: Bad threaded rc value\"\n      return (new_h, prev_handler)\n\n  | otherwise =\n  alloca $ \\ p_sp -> do\n   rc <-\n    case handler of\n     Default -> rts_installHandler STG_SIG_DFL p_sp\n     Ignore  -> rts_installHandler STG_SIG_IGN p_sp\n     Catch h -> do\n        v <- newStablePtr (toHandler h)\n        poke p_sp v\n        rts_installHandler STG_SIG_HAN p_sp\n   case rc of\n     STG_SIG_DFL -> return Default\n     STG_SIG_IGN -> return Ignore\n     STG_SIG_HAN -> do\n        osptr <- peek p_sp\n        oldh  <- deRefStablePtr osptr\n         -- stable pointer is no longer in use, free it.\n        freeStablePtr osptr\n        return (Catch (\\ ev -> oldh (fromConsoleEvent ev)))\n     _           -> errorWithoutStackTrace \"installHandler: Bad non-threaded rc value\"\n  where\n   fromConsoleEvent ev =\n     case ev of\n       ControlC -> 0 {- CTRL_C_EVENT-}\n       Break    -> 1 {- CTRL_BREAK_EVENT-}\n       Close    -> 2 {- CTRL_CLOSE_EVENT-}\n       Logoff   -> 5 {- CTRL_LOGOFF_EVENT-}\n       Shutdown -> 6 {- CTRL_SHUTDOWN_EVENT-}\n\n   toHandler hdlr ev = do\n      case toWin32ConsoleEvent ev of\n         -- see rts/win32/ConsoleHandler.c for comments as to why\n         -- rts_ConsoleHandlerDone is called here.\n        Just x  -> hdlr x >> rts_ConsoleHandlerDone ev\n        Nothing -> return () -- silently ignore..\n\n   no_handler = errorWithoutStackTrace \"win32ConsoleHandler\"\n\nforeign import ccall unsafe \"rtsSupportsBoundThreads\" threaded :: Bool\n\nforeign import ccall unsafe \"RtsExternal.h rts_InstallConsoleEvent\"\n  rts_installHandler :: CInt -> Ptr (StablePtr (CInt -> IO ())) -> IO CInt\nforeign import ccall unsafe \"RtsExternal.h rts_ConsoleHandlerDone\"\n  rts_ConsoleHandlerDone :: CInt -> IO ()\n\n\nflushConsole :: Handle -> IO ()\nflushConsole h =\n  wantReadableHandle_ \"flushConsole\" h $ \\ Handle__{haDevice=dev} ->\n    case cast dev of\n      Nothing -> ioException $\n                    IOError (Just h) IllegalOperation \"flushConsole\"\n                        \"handle is not a file descriptor\" Nothing Nothing\n      Just fd -> do\n        throwErrnoIfMinus1Retry_ \"flushConsole\" $\n           flush_console_fd (fdFD fd)\n\nforeign import ccall unsafe \"consUtils.h flush_input_console__\"\n        flush_console_fd :: CInt -> IO CInt\n\n#endif /* mingw32_HOST_OS */\n", "num_lines": 163}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule GHC.Constants where\n\n-- TODO: This used to include HaskellConstants.hs, but that has now gone.\n-- We probably want to include the constants in platformConstants somehow\n-- instead.\n\nimport GHC.Base () -- dummy dependency\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , RankNTypes\n           , ExistentialQuantification\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Desugar\n-- Copyright   :  (c) The University of Glasgow, 2007\n-- License     :  see libraries/base/LICENSE\n-- \n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Support code for desugaring in GHC\n-- \n-----------------------------------------------------------------------------\n\nmodule GHC.Desugar ((>>>), AnnotationWrapper(..), toAnnotationWrapper) where\n\nimport Control.Arrow    (Arrow(..))\nimport Control.Category ((.))\nimport Data.Data        (Data)\n\n-- A version of Control.Category.>>> overloaded on Arrow\n(>>>) :: forall arr. Arrow arr => forall a b c. arr a b -> arr b c -> arr a c\n-- NB: the type of this function is the \"shape\" that GHC expects\n--     in tcInstClassOp.  So don't put all the foralls at the front!  \n--     Yes, this is a bit grotesque, but heck it works and the whole\n--     arrows stuff needs reworking anyway!\nf >>> g = g . f\n\n-- A wrapper data type that lets the typechecker get at the appropriate dictionaries for an annotation\ndata AnnotationWrapper = forall a. (Data a) => AnnotationWrapper a\n\ntoAnnotationWrapper :: (Data a) => a -> AnnotationWrapper\ntoAnnotationWrapper what = AnnotationWrapper what\n\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Enum\n-- Copyright   :  (c) The University of Glasgow, 1992-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- The 'Enum' and 'Bounded' classes.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Enum(\n        Bounded(..), Enum(..),\n        boundedEnumFrom, boundedEnumFromThen,\n        toEnumError, fromEnumError, succError, predError,\n\n        -- Instances for Bounded and Enum: (), Char, Int\n\n   ) where\n\nimport GHC.Base hiding ( many )\nimport GHC.Char\nimport GHC.Integer\nimport GHC.Num\nimport GHC.Show\ndefault ()              -- Double isn't available yet\n\n-- | The 'Bounded' class is used to name the upper and lower limits of a\n-- type.  'Ord' is not a superclass of 'Bounded' since types that are not\n-- totally ordered may also have upper and lower bounds.\n--\n-- The 'Bounded' class may be derived for any enumeration type;\n-- 'minBound' is the first constructor listed in the @data@ declaration\n-- and 'maxBound' is the last.\n-- 'Bounded' may also be derived for single-constructor datatypes whose\n-- constituent types are in 'Bounded'.\n\nclass  Bounded a  where\n    minBound, maxBound :: a\n\n-- | Class 'Enum' defines operations on sequentially ordered types.\n--\n-- The @enumFrom@... methods are used in Haskell's translation of\n-- arithmetic sequences.\n--\n-- Instances of 'Enum' may be derived for any enumeration type (types\n-- whose constructors have no fields).  The nullary constructors are\n-- assumed to be numbered left-to-right by 'fromEnum' from @0@ through @n-1@.\n-- See Chapter 10 of the /Haskell Report/ for more details.\n--\n-- For any type that is an instance of class 'Bounded' as well as 'Enum',\n-- the following should hold:\n--\n-- * The calls @'succ' 'maxBound'@ and @'pred' 'minBound'@ should result in\n--   a runtime error.\n--\n-- * 'fromEnum' and 'toEnum' should give a runtime error if the\n--   result value is not representable in the result type.\n--   For example, @'toEnum' 7 :: 'Bool'@ is an error.\n--\n-- * 'enumFrom' and 'enumFromThen' should be defined with an implicit bound,\n--   thus:\n--\n-- >    enumFrom     x   = enumFromTo     x maxBound\n-- >    enumFromThen x y = enumFromThenTo x y bound\n-- >      where\n-- >        bound | fromEnum y >= fromEnum x = maxBound\n-- >              | otherwise                = minBound\n--\nclass  Enum a   where\n    -- | the successor of a value.  For numeric types, 'succ' adds 1.\n    succ                :: a -> a\n    -- | the predecessor of a value.  For numeric types, 'pred' subtracts 1.\n    pred                :: a -> a\n    -- | Convert from an 'Int'.\n    toEnum              :: Int -> a\n    -- | Convert to an 'Int'.\n    -- It is implementation-dependent what 'fromEnum' returns when\n    -- applied to a value that is too large to fit in an 'Int'.\n    fromEnum            :: a -> Int\n\n    -- | Used in Haskell's translation of @[n..]@ with @[n..] = enumFrom n@,\n    --   a possible implementation being @enumFrom n = n : enumFrom (succ n)@.\n    --   For example:\n    --\n    --     * @enumFrom 4 :: [Integer] = [4,5,6,7,...]@\n    --     * @enumFrom 6 :: [Int] = [6,7,8,9,...,maxBound :: Int]@\n    enumFrom            :: a -> [a]\n    -- | Used in Haskell's translation of @[n,n'..]@\n    --   with @[n,n'..] = enumFromThen n n'@, a possible implementation being\n    --   @enumFromThen n n' = n : n' : worker (f x) (f x n')@,\n    --   @worker s v = v : worker s (s v)@, @x = fromEnum n' - fromEnum n@ and\n    --   @f n y\n    --     | n > 0 = f (n - 1) (succ y)\n    --     | n < 0 = f (n + 1) (pred y)\n    --     | otherwise = y@\n    --   For example:\n    --\n    --     * @enumFromThen 4 6 :: [Integer] = [4,6,8,10...]@\n    --     * @enumFromThen 6 2 :: [Int] = [6,2,-2,-6,...,minBound :: Int]@\n    enumFromThen        :: a -> a -> [a]\n    -- | Used in Haskell's translation of @[n..m]@ with\n    --   @[n..m] = enumFromTo n m@, a possible implementation being\n    --   @enumFromTo n m\n    --      | n <= m = n : enumFromTo (succ n) m\n    --      | otherwise = []@.\n    --   For example:\n    --\n    --     * @enumFromTo 6 10 :: [Int] = [6,7,8,9,10]@\n    --     * @enumFromTo 42 1 :: [Integer] = []@\n    enumFromTo          :: a -> a -> [a]\n    -- | Used in Haskell's translation of @[n,n'..m]@ with\n    --   @[n,n'..m] = enumFromThenTo n n' m@, a possible implementation\n    --   being @enumFromThenTo n n' m = worker (f x) (c x) n m@,\n    --   @x = fromEnum n' - fromEnum n@, @c x = bool (>=) (<=) (x > 0)@\n    --   @f n y\n    --      | n > 0 = f (n - 1) (succ y)\n    --      | n < 0 = f (n + 1) (pred y)\n    --      | otherwise = y@ and\n    --   @worker s c v m\n    --      | c v m = v : worker s c (s v) m\n    --      | otherwise = []@\n    --   For example:\n    --\n    --     * @enumFromThenTo 4 2 -6 :: [Integer] = [4,2,0,-2,-4,-6]@\n    --     * @enumFromThenTo 6 8 2 :: [Int] = []@\n    enumFromThenTo      :: a -> a -> a -> [a]\n\n    succ                   = toEnum . (+ 1)  . fromEnum\n    pred                   = toEnum . (subtract 1) . fromEnum\n    enumFrom x             = map toEnum [fromEnum x ..]\n    enumFromThen x y       = map toEnum [fromEnum x, fromEnum y ..]\n    enumFromTo x y         = map toEnum [fromEnum x .. fromEnum y]\n    enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]\n\n-- Default methods for bounded enumerations\nboundedEnumFrom :: (Enum a, Bounded a) => a -> [a]\nboundedEnumFrom n = map toEnum [fromEnum n .. fromEnum (maxBound `asTypeOf` n)]\n\nboundedEnumFromThen :: (Enum a, Bounded a) => a -> a -> [a]\nboundedEnumFromThen n1 n2\n  | i_n2 >= i_n1  = map toEnum [i_n1, i_n2 .. fromEnum (maxBound `asTypeOf` n1)]\n  | otherwise     = map toEnum [i_n1, i_n2 .. fromEnum (minBound `asTypeOf` n1)]\n  where\n    i_n1 = fromEnum n1\n    i_n2 = fromEnum n2\n\n------------------------------------------------------------------------\n-- Helper functions\n------------------------------------------------------------------------\n\n{-# NOINLINE toEnumError #-}\ntoEnumError :: (Show a) => String -> Int -> (a,a) -> b\ntoEnumError inst_ty i bnds =\n    errorWithoutStackTrace $ \"Enum.toEnum{\" ++ inst_ty ++ \"}: tag (\" ++\n            show i ++\n            \") is outside of bounds \" ++\n            show bnds\n\n{-# NOINLINE fromEnumError #-}\nfromEnumError :: (Show a) => String -> a -> b\nfromEnumError inst_ty x =\n    errorWithoutStackTrace $ \"Enum.fromEnum{\" ++ inst_ty ++ \"}: value (\" ++\n            show x ++\n            \") is outside of Int's bounds \" ++\n            show (minBound::Int, maxBound::Int)\n\n{-# NOINLINE succError #-}\nsuccError :: String -> a\nsuccError inst_ty =\n    errorWithoutStackTrace $ \"Enum.succ{\" ++ inst_ty ++ \"}: tried to take `succ' of maxBound\"\n\n{-# NOINLINE predError #-}\npredError :: String -> a\npredError inst_ty =\n    errorWithoutStackTrace $ \"Enum.pred{\" ++ inst_ty ++ \"}: tried to take `pred' of minBound\"\n\n------------------------------------------------------------------------\n-- Tuples\n------------------------------------------------------------------------\n\n-- | @since 2.01\nderiving instance Bounded ()\n\n-- | @since 2.01\ninstance Enum () where\n    succ _      = errorWithoutStackTrace \"Prelude.Enum.().succ: bad argument\"\n    pred _      = errorWithoutStackTrace \"Prelude.Enum.().pred: bad argument\"\n\n    toEnum x | x == 0    = ()\n             | otherwise = errorWithoutStackTrace \"Prelude.Enum.().toEnum: bad argument\"\n\n    fromEnum () = 0\n    enumFrom ()         = [()]\n    enumFromThen () ()  = let many = ():many in many\n    enumFromTo () ()    = [()]\n    enumFromThenTo () () () = let many = ():many in many\n\n-- Report requires instances up to 15\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b)\n        => Bounded (a,b)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c)\n        => Bounded (a,b,c)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d)\n        => Bounded (a,b,c,d)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e)\n        => Bounded (a,b,c,d,e)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f)\n        => Bounded (a,b,c,d,e,f)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g)\n        => Bounded (a,b,c,d,e,f,g)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h)\n        => Bounded (a,b,c,d,e,f,g,h)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h, Bounded i)\n        => Bounded (a,b,c,d,e,f,g,h,i)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h, Bounded i, Bounded j)\n        => Bounded (a,b,c,d,e,f,g,h,i,j)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k)\n        => Bounded (a,b,c,d,e,f,g,h,i,j,k)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,\n          Bounded l)\n        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,\n          Bounded l, Bounded m)\n        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,\n          Bounded l, Bounded m, Bounded n)\n        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n)\n-- | @since 2.01\nderiving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e,\n          Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k,\n          Bounded l, Bounded m, Bounded n, Bounded o)\n        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)\n\n------------------------------------------------------------------------\n-- Bool\n------------------------------------------------------------------------\n\n-- | @since 2.01\nderiving instance Bounded Bool\n\n-- | @since 2.01\ninstance Enum Bool where\n  succ False = True\n  succ True  = errorWithoutStackTrace \"Prelude.Enum.Bool.succ: bad argument\"\n\n  pred True  = False\n  pred False  = errorWithoutStackTrace \"Prelude.Enum.Bool.pred: bad argument\"\n\n  toEnum n | n == 0    = False\n           | n == 1    = True\n           | otherwise = errorWithoutStackTrace \"Prelude.Enum.Bool.toEnum: bad argument\"\n\n  fromEnum False = 0\n  fromEnum True  = 1\n\n  -- Use defaults for the rest\n  enumFrom     = boundedEnumFrom\n  enumFromThen = boundedEnumFromThen\n\n------------------------------------------------------------------------\n-- Ordering\n------------------------------------------------------------------------\n\n-- | @since 2.01\nderiving instance Bounded Ordering\n-- | @since 2.01\ninstance Enum Ordering where\n  succ LT = EQ\n  succ EQ = GT\n  succ GT = errorWithoutStackTrace \"Prelude.Enum.Ordering.succ: bad argument\"\n\n  pred GT = EQ\n  pred EQ = LT\n  pred LT = errorWithoutStackTrace \"Prelude.Enum.Ordering.pred: bad argument\"\n\n  toEnum n | n == 0 = LT\n           | n == 1 = EQ\n           | n == 2 = GT\n  toEnum _ = errorWithoutStackTrace \"Prelude.Enum.Ordering.toEnum: bad argument\"\n\n  fromEnum LT = 0\n  fromEnum EQ = 1\n  fromEnum GT = 2\n\n  -- Use defaults for the rest\n  enumFrom     = boundedEnumFrom\n  enumFromThen = boundedEnumFromThen\n\n------------------------------------------------------------------------\n-- Char\n------------------------------------------------------------------------\n\n-- | @since 2.01\ninstance  Bounded Char  where\n    minBound =  '\\0'\n    maxBound =  '\\x10FFFF'\n\n-- | @since 2.01\ninstance  Enum Char  where\n    succ (C# c#)\n       | isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))\n       | otherwise             = errorWithoutStackTrace (\"Prelude.Enum.Char.succ: bad argument\")\n    pred (C# c#)\n       | isTrue# (ord# c# /=# 0#) = C# (chr# (ord# c# -# 1#))\n       | otherwise                = errorWithoutStackTrace (\"Prelude.Enum.Char.pred: bad argument\")\n\n    toEnum   = chr\n    fromEnum = ord\n\n    {-# INLINE enumFrom #-}\n    enumFrom (C# x) = eftChar (ord# x) 0x10FFFF#\n        -- Blarg: technically I guess enumFrom isn't strict!\n\n    {-# INLINE enumFromTo #-}\n    enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y)\n\n    {-# INLINE enumFromThen #-}\n    enumFromThen (C# x1) (C# x2) = efdChar (ord# x1) (ord# x2)\n\n    {-# INLINE enumFromThenTo #-}\n    enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)\n\n-- See Note [How the Enum rules work]\n{-# RULES\n\"eftChar\"       [~1] forall x y.        eftChar x y       = build (\\c n -> eftCharFB c n x y)\n\"efdChar\"       [~1] forall x1 x2.      efdChar x1 x2     = build (\\ c n -> efdCharFB c n x1 x2)\n\"efdtChar\"      [~1] forall x1 x2 l.    efdtChar x1 x2 l  = build (\\ c n -> efdtCharFB c n x1 x2 l)\n\"eftCharList\"   [1]  eftCharFB  (:) [] = eftChar\n\"efdCharList\"   [1]  efdCharFB  (:) [] = efdChar\n\"efdtCharList\"  [1]  efdtCharFB (:) [] = efdtChar\n #-}\n\n\n-- We can do better than for Ints because we don't\n-- have hassles about arithmetic overflow at maxBound\n{-# INLINE [0] eftCharFB #-} -- See Note [Inline FB functions] in GHC.List\neftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a\neftCharFB c n x0 y = go x0\n                 where\n                    go x | isTrue# (x ># y) = n\n                         | otherwise        = C# (chr# x) `c` go (x +# 1#)\n\n{-# NOINLINE [1] eftChar #-}\neftChar :: Int# -> Int# -> String\neftChar x y | isTrue# (x ># y ) = []\n            | otherwise         = C# (chr# x) : eftChar (x +# 1#) y\n\n\n-- For enumFromThenTo we give up on inlining\n{-# INLINE [0] efdCharFB #-} -- See Note [Inline FB functions] in GHC.List\nefdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a\nefdCharFB c n x1 x2\n  | isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta 0x10FFFF#\n  | otherwise              = go_dn_char_fb c n x1 delta 0#\n  where\n    !delta = x2 -# x1\n\n{-# NOINLINE [1] efdChar #-}\nefdChar :: Int# -> Int# -> String\nefdChar x1 x2\n  | isTrue# (delta >=# 0#) = go_up_char_list x1 delta 0x10FFFF#\n  | otherwise              = go_dn_char_list x1 delta 0#\n  where\n    !delta = x2 -# x1\n\n{-# INLINE [0] efdtCharFB #-} -- See Note [Inline FB functions] in GHC.List\nefdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a\nefdtCharFB c n x1 x2 lim\n  | isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta lim\n  | otherwise              = go_dn_char_fb c n x1 delta lim\n  where\n    !delta = x2 -# x1\n\n{-# NOINLINE [1] efdtChar #-}\nefdtChar :: Int# -> Int# -> Int# -> String\nefdtChar x1 x2 lim\n  | isTrue# (delta >=# 0#) = go_up_char_list x1 delta lim\n  | otherwise              = go_dn_char_list x1 delta lim\n  where\n    !delta = x2 -# x1\n\ngo_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a\ngo_up_char_fb c n x0 delta lim\n  = go_up x0\n  where\n    go_up x | isTrue# (x ># lim) = n\n            | otherwise          = C# (chr# x) `c` go_up (x +# delta)\n\ngo_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a\ngo_dn_char_fb c n x0 delta lim\n  = go_dn x0\n  where\n    go_dn x | isTrue# (x <# lim) = n\n            | otherwise          = C# (chr# x) `c` go_dn (x +# delta)\n\ngo_up_char_list :: Int# -> Int# -> Int# -> String\ngo_up_char_list x0 delta lim\n  = go_up x0\n  where\n    go_up x | isTrue# (x ># lim) = []\n            | otherwise          = C# (chr# x) : go_up (x +# delta)\n\ngo_dn_char_list :: Int# -> Int# -> Int# -> String\ngo_dn_char_list x0 delta lim\n  = go_dn x0\n  where\n    go_dn x | isTrue# (x <# lim) = []\n            | otherwise          = C# (chr# x) : go_dn (x +# delta)\n\n\n------------------------------------------------------------------------\n-- Int\n------------------------------------------------------------------------\n\n{-\nBe careful about these instances.\n        (a) remember that you have to count down as well as up e.g. [13,12..0]\n        (b) be careful of Int overflow\n        (c) remember that Int is bounded, so [1..] terminates at maxInt\n-}\n\n-- | @since 2.01\ninstance  Bounded Int where\n    minBound =  minInt\n    maxBound =  maxInt\n\n-- | @since 2.01\ninstance  Enum Int  where\n    succ x\n       | x == maxBound  = errorWithoutStackTrace \"Prelude.Enum.succ{Int}: tried to take `succ' of maxBound\"\n       | otherwise      = x + 1\n    pred x\n       | x == minBound  = errorWithoutStackTrace \"Prelude.Enum.pred{Int}: tried to take `pred' of minBound\"\n       | otherwise      = x - 1\n\n    toEnum   x = x\n    fromEnum x = x\n\n    {-# INLINE enumFrom #-}\n    enumFrom (I# x) = eftInt x maxInt#\n        where !(I# maxInt#) = maxInt\n        -- Blarg: technically I guess enumFrom isn't strict!\n\n    {-# INLINE enumFromTo #-}\n    enumFromTo (I# x) (I# y) = eftInt x y\n\n    {-# INLINE enumFromThen #-}\n    enumFromThen (I# x1) (I# x2) = efdInt x1 x2\n\n    {-# INLINE enumFromThenTo #-}\n    enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y\n\n\n-----------------------------------------------------\n-- eftInt and eftIntFB deal with [a..b], which is the\n-- most common form, so we take a lot of care\n-- In particular, we have rules for deforestation\n\n{-# RULES\n\"eftInt\"        [~1] forall x y. eftInt x y = build (\\ c n -> eftIntFB c n x y)\n\"eftIntList\"    [1] eftIntFB  (:) [] = eftInt\n #-}\n\n{- Note [How the Enum rules work]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n* Phase 2: eftInt ---> build . eftIntFB\n* Phase 1: inline build; eftIntFB (:) --> eftInt\n* Phase 0: optionally inline eftInt\n-}\n\n{-# NOINLINE [1] eftInt #-}\neftInt :: Int# -> Int# -> [Int]\n-- [x1..x2]\neftInt x0 y | isTrue# (x0 ># y) = []\n            | otherwise         = go x0\n               where\n                 go x = I# x : if isTrue# (x ==# y)\n                               then []\n                               else go (x +# 1#)\n\n{-# INLINE [0] eftIntFB #-} -- See Note [Inline FB functions] in GHC.List\neftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r\neftIntFB c n x0 y | isTrue# (x0 ># y) = n\n                  | otherwise         = go x0\n                 where\n                   go x = I# x `c` if isTrue# (x ==# y)\n                                   then n\n                                   else go (x +# 1#)\n                        -- Watch out for y=maxBound; hence ==, not >\n        -- Be very careful not to have more than one \"c\"\n        -- so that when eftInfFB is inlined we can inline\n        -- whatever is bound to \"c\"\n\n\n-----------------------------------------------------\n-- efdInt and efdtInt deal with [a,b..] and [a,b..c].\n-- The code is more complicated because of worries about Int overflow.\n\n-- See Note [How the Enum rules work]\n{-# RULES\n\"efdtInt\"       [~1] forall x1 x2 y.\n                     efdtInt x1 x2 y = build (\\ c n -> efdtIntFB c n x1 x2 y)\n\"efdtIntUpList\" [1]  efdtIntFB (:) [] = efdtInt\n #-}\n\nefdInt :: Int# -> Int# -> [Int]\n-- [x1,x2..maxInt]\nefdInt x1 x2\n | isTrue# (x2 >=# x1) = case maxInt of I# y -> efdtIntUp x1 x2 y\n | otherwise           = case minInt of I# y -> efdtIntDn x1 x2 y\n\n{-# NOINLINE [1] efdtInt #-}\nefdtInt :: Int# -> Int# -> Int# -> [Int]\n-- [x1,x2..y]\nefdtInt x1 x2 y\n | isTrue# (x2 >=# x1) = efdtIntUp x1 x2 y\n | otherwise           = efdtIntDn x1 x2 y\n\n{-# INLINE [0] efdtIntFB #-} -- See Note [Inline FB functions] in GHC.List\nefdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r\nefdtIntFB c n x1 x2 y\n | isTrue# (x2 >=# x1) = efdtIntUpFB c n x1 x2 y\n | otherwise           = efdtIntDnFB c n x1 x2 y\n\n-- Requires x2 >= x1\nefdtIntUp :: Int# -> Int# -> Int# -> [Int]\nefdtIntUp x1 x2 y    -- Be careful about overflow!\n | isTrue# (y <# x2) = if isTrue# (y <# x1) then [] else [I# x1]\n | otherwise = -- Common case: x1 <= x2 <= y\n               let !delta = x2 -# x1 -- >= 0\n                   !y' = y -# delta  -- x1 <= y' <= y; hence y' is representable\n\n                   -- Invariant: x <= y\n                   -- Note that: z <= y' => z + delta won't overflow\n                   -- so we are guaranteed not to overflow if/when we recurse\n                   go_up x | isTrue# (x ># y') = [I# x]\n                           | otherwise         = I# x : go_up (x +# delta)\n               in I# x1 : go_up x2\n\n-- Requires x2 >= x1\n{-# INLINE [0] efdtIntUpFB #-} -- See Note [Inline FB functions] in GHC.List\nefdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r\nefdtIntUpFB c n x1 x2 y    -- Be careful about overflow!\n | isTrue# (y <# x2) = if isTrue# (y <# x1) then n else I# x1 `c` n\n | otherwise = -- Common case: x1 <= x2 <= y\n               let !delta = x2 -# x1 -- >= 0\n                   !y' = y -# delta  -- x1 <= y' <= y; hence y' is representable\n\n                   -- Invariant: x <= y\n                   -- Note that: z <= y' => z + delta won't overflow\n                   -- so we are guaranteed not to overflow if/when we recurse\n                   go_up x | isTrue# (x ># y') = I# x `c` n\n                           | otherwise         = I# x `c` go_up (x +# delta)\n               in I# x1 `c` go_up x2\n\n-- Requires x2 <= x1\nefdtIntDn :: Int# -> Int# -> Int# -> [Int]\nefdtIntDn x1 x2 y    -- Be careful about underflow!\n | isTrue# (y ># x2) = if isTrue# (y ># x1) then [] else [I# x1]\n | otherwise = -- Common case: x1 >= x2 >= y\n               let !delta = x2 -# x1 -- <= 0\n                   !y' = y -# delta  -- y <= y' <= x1; hence y' is representable\n\n                   -- Invariant: x >= y\n                   -- Note that: z >= y' => z + delta won't underflow\n                   -- so we are guaranteed not to underflow if/when we recurse\n                   go_dn x | isTrue# (x <# y') = [I# x]\n                           | otherwise         = I# x : go_dn (x +# delta)\n   in I# x1 : go_dn x2\n\n-- Requires x2 <= x1\n{-# INLINE [0] efdtIntDnFB #-} -- See Note [Inline FB functions] in GHC.List\nefdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r\nefdtIntDnFB c n x1 x2 y    -- Be careful about underflow!\n | isTrue# (y ># x2) = if isTrue# (y ># x1) then n else I# x1 `c` n\n | otherwise = -- Common case: x1 >= x2 >= y\n               let !delta = x2 -# x1 -- <= 0\n                   !y' = y -# delta  -- y <= y' <= x1; hence y' is representable\n\n                   -- Invariant: x >= y\n                   -- Note that: z >= y' => z + delta won't underflow\n                   -- so we are guaranteed not to underflow if/when we recurse\n                   go_dn x | isTrue# (x <# y') = I# x `c` n\n                           | otherwise         = I# x `c` go_dn (x +# delta)\n               in I# x1 `c` go_dn x2\n\n\n------------------------------------------------------------------------\n-- Word\n------------------------------------------------------------------------\n\n-- | @since 2.01\ninstance Bounded Word where\n    minBound = 0\n\n    -- use unboxed literals for maxBound, because GHC doesn't optimise\n    -- (fromInteger 0xffffffff :: Word).\n#if WORD_SIZE_IN_BITS == 32\n    maxBound = W# 0xFFFFFFFF##\n#elif WORD_SIZE_IN_BITS == 64\n    maxBound = W# 0xFFFFFFFFFFFFFFFF##\n#else\n#error Unhandled value for WORD_SIZE_IN_BITS\n#endif\n\n-- | @since 2.01\ninstance Enum Word where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Word\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Word\"\n    toEnum i@(I# i#)\n        | i >= 0        = W# (int2Word# i#)\n        | otherwise     = toEnumError \"Word\" i (minBound::Word, maxBound::Word)\n    fromEnum x@(W# x#)\n        | x <= maxIntWord = I# (word2Int# x#)\n        | otherwise       = fromEnumError \"Word\" x\n\n    {-# INLINE enumFrom #-}\n    enumFrom (W# x#)      = eftWord x# maxWord#\n        where !(W# maxWord#) = maxBound\n        -- Blarg: technically I guess enumFrom isn't strict!\n\n    {-# INLINE enumFromTo #-}\n    enumFromTo (W# x) (W# y) = eftWord x y\n\n    {-# INLINE enumFromThen #-}\n    enumFromThen (W# x1) (W# x2) = efdWord x1 x2\n\n    {-# INLINE enumFromThenTo #-}\n    enumFromThenTo (W# x1) (W# x2) (W# y) = efdtWord x1 x2 y\n\nmaxIntWord :: Word\n-- The biggest word representable as an Int\nmaxIntWord = W# (case maxInt of I# i -> int2Word# i)\n\n-----------------------------------------------------\n-- eftWord and eftWordFB deal with [a..b], which is the\n-- most common form, so we take a lot of care\n-- In particular, we have rules for deforestation\n\n{-# RULES\n\"eftWord\"        [~1] forall x y. eftWord x y = build (\\ c n -> eftWordFB c n x y)\n\"eftWordList\"    [1] eftWordFB  (:) [] = eftWord\n #-}\n\n-- The Enum rules for Word work much the same way that they do for Int.\n-- See Note [How the Enum rules work].\n\n{-# NOINLINE [1] eftWord #-}\neftWord :: Word# -> Word# -> [Word]\n-- [x1..x2]\neftWord x0 y | isTrue# (x0 `gtWord#` y) = []\n             | otherwise                = go x0\n                where\n                  go x = W# x : if isTrue# (x `eqWord#` y)\n                                then []\n                                else go (x `plusWord#` 1##)\n\n{-# INLINE [0] eftWordFB #-} -- See Note [Inline FB functions] in GHC.List\neftWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> r\neftWordFB c n x0 y | isTrue# (x0 `gtWord#` y) = n\n                   | otherwise                = go x0\n                  where\n                    go x = W# x `c` if isTrue# (x `eqWord#` y)\n                                    then n\n                                    else go (x `plusWord#` 1##)\n                        -- Watch out for y=maxBound; hence ==, not >\n        -- Be very careful not to have more than one \"c\"\n        -- so that when eftInfFB is inlined we can inline\n        -- whatever is bound to \"c\"\n\n\n-----------------------------------------------------\n-- efdWord and efdtWord deal with [a,b..] and [a,b..c].\n-- The code is more complicated because of worries about Word overflow.\n\n-- See Note [How the Enum rules work]\n{-# RULES\n\"efdtWord\"       [~1] forall x1 x2 y.\n                     efdtWord x1 x2 y = build (\\ c n -> efdtWordFB c n x1 x2 y)\n\"efdtWordUpList\" [1]  efdtWordFB (:) [] = efdtWord\n #-}\n\nefdWord :: Word# -> Word# -> [Word]\n-- [x1,x2..maxWord]\nefdWord x1 x2\n | isTrue# (x2 `geWord#` x1) = case maxBound of W# y -> efdtWordUp x1 x2 y\n | otherwise                 = case minBound of W# y -> efdtWordDn x1 x2 y\n\n{-# NOINLINE [1] efdtWord #-}\nefdtWord :: Word# -> Word# -> Word# -> [Word]\n-- [x1,x2..y]\nefdtWord x1 x2 y\n | isTrue# (x2 `geWord#` x1) = efdtWordUp x1 x2 y\n | otherwise                 = efdtWordDn x1 x2 y\n\n{-# INLINE [0] efdtWordFB #-} -- See Note [Inline FB functions] in GHC.List\nefdtWordFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r\nefdtWordFB c n x1 x2 y\n | isTrue# (x2 `geWord#` x1) = efdtWordUpFB c n x1 x2 y\n | otherwise                 = efdtWordDnFB c n x1 x2 y\n\n-- Requires x2 >= x1\nefdtWordUp :: Word# -> Word# -> Word# -> [Word]\nefdtWordUp x1 x2 y    -- Be careful about overflow!\n | isTrue# (y `ltWord#` x2) = if isTrue# (y `ltWord#` x1) then [] else [W# x1]\n | otherwise = -- Common case: x1 <= x2 <= y\n               let !delta = x2 `minusWord#` x1 -- >= 0\n                   !y' = y `minusWord#` delta  -- x1 <= y' <= y; hence y' is representable\n\n                   -- Invariant: x <= y\n                   -- Note that: z <= y' => z + delta won't overflow\n                   -- so we are guaranteed not to overflow if/when we recurse\n                   go_up x | isTrue# (x `gtWord#` y') = [W# x]\n                           | otherwise                = W# x : go_up (x `plusWord#` delta)\n               in W# x1 : go_up x2\n\n-- Requires x2 >= x1\n{-# INLINE [0] efdtWordUpFB #-} -- See Note [Inline FB functions] in GHC.List\nefdtWordUpFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r\nefdtWordUpFB c n x1 x2 y    -- Be careful about overflow!\n | isTrue# (y `ltWord#` x2) = if isTrue# (y `ltWord#` x1) then n else W# x1 `c` n\n | otherwise = -- Common case: x1 <= x2 <= y\n               let !delta = x2 `minusWord#` x1 -- >= 0\n                   !y' = y `minusWord#` delta  -- x1 <= y' <= y; hence y' is representable\n\n                   -- Invariant: x <= y\n                   -- Note that: z <= y' => z + delta won't overflow\n                   -- so we are guaranteed not to overflow if/when we recurse\n                   go_up x | isTrue# (x `gtWord#` y') = W# x `c` n\n                           | otherwise                = W# x `c` go_up (x `plusWord#` delta)\n               in W# x1 `c` go_up x2\n\n-- Requires x2 <= x1\nefdtWordDn :: Word# -> Word# -> Word# -> [Word]\nefdtWordDn x1 x2 y    -- Be careful about underflow!\n | isTrue# (y `gtWord#` x2) = if isTrue# (y `gtWord#` x1) then [] else [W# x1]\n | otherwise = -- Common case: x1 >= x2 >= y\n               let !delta = x2 `minusWord#` x1 -- <= 0\n                   !y' = y `minusWord#` delta  -- y <= y' <= x1; hence y' is representable\n\n                   -- Invariant: x >= y\n                   -- Note that: z >= y' => z + delta won't underflow\n                   -- so we are guaranteed not to underflow if/when we recurse\n                   go_dn x | isTrue# (x `ltWord#` y') = [W# x]\n                           | otherwise                = W# x : go_dn (x `plusWord#` delta)\n   in W# x1 : go_dn x2\n\n-- Requires x2 <= x1\n{-# INLINE [0] efdtWordDnFB #-} -- See Note [Inline FB functions] in GHC.List\nefdtWordDnFB :: (Word -> r -> r) -> r -> Word# -> Word# -> Word# -> r\nefdtWordDnFB c n x1 x2 y    -- Be careful about underflow!\n | isTrue# (y `gtWord#` x2) = if isTrue# (y `gtWord#` x1) then n else W# x1 `c` n\n | otherwise = -- Common case: x1 >= x2 >= y\n               let !delta = x2 `minusWord#` x1 -- <= 0\n                   !y' = y `minusWord#` delta  -- y <= y' <= x1; hence y' is representable\n\n                   -- Invariant: x >= y\n                   -- Note that: z >= y' => z + delta won't underflow\n                   -- so we are guaranteed not to underflow if/when we recurse\n                   go_dn x | isTrue# (x `ltWord#` y') = W# x `c` n\n                           | otherwise                = W# x `c` go_dn (x `plusWord#` delta)\n               in W# x1 `c` go_dn x2\n\n------------------------------------------------------------------------\n-- Integer\n------------------------------------------------------------------------\n\n-- | @since 2.01\ninstance  Enum Integer  where\n    succ x               = x + 1\n    pred x               = x - 1\n    toEnum (I# n)        = smallInteger n\n    fromEnum n           = I# (integerToInt n)\n\n    {-# INLINE enumFrom #-}\n    {-# INLINE enumFromThen #-}\n    {-# INLINE enumFromTo #-}\n    {-# INLINE enumFromThenTo #-}\n    enumFrom x             = enumDeltaInteger   x 1\n    enumFromThen x y       = enumDeltaInteger   x (y-x)\n    enumFromTo x lim       = enumDeltaToInteger x 1     lim\n    enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim\n\n-- See Note [How the Enum rules work]\n{-# RULES\n\"enumDeltaInteger\"      [~1] forall x y.   enumDeltaInteger x y         = build (\\c _ -> enumDeltaIntegerFB c x y)\n\"efdtInteger\"           [~1] forall x d l. enumDeltaToInteger x d l     = build (\\c n -> enumDeltaToIntegerFB  c n x d l)\n\"efdtInteger1\"          [~1] forall x l.   enumDeltaToInteger x 1 l     = build (\\c n -> enumDeltaToInteger1FB c n x l)\n\n\"enumDeltaToInteger1FB\" [1] forall c n x.  enumDeltaToIntegerFB c n x 1 = enumDeltaToInteger1FB c n x\n\n\"enumDeltaInteger\"      [1] enumDeltaIntegerFB    (:)     = enumDeltaInteger\n\"enumDeltaToInteger\"    [1] enumDeltaToIntegerFB  (:) []  = enumDeltaToInteger\n\"enumDeltaToInteger1\"   [1] enumDeltaToInteger1FB (:) []  = enumDeltaToInteger1\n #-}\n\n{- Note [Enum Integer rules for literal 1]\nThe \"1\" rules above specialise for the common case where delta = 1,\nso that we can avoid the delta>=0 test in enumDeltaToIntegerFB.\nThen enumDeltaToInteger1FB is nice and small and can be inlined,\nwhich would allow the constructor to be inlined and good things to happen.\n\nWe match on the literal \"1\" both in phase 2 (rule \"efdtInteger1\") and\nphase 1 (rule \"enumDeltaToInteger1FB\"), just for belt and braces\n\nWe do not do it for Int this way because hand-tuned code already exists, and\nthe special case varies more from the general case, due to the issue of overflows.\n-}\n\n{-# INLINE [0] enumDeltaIntegerFB #-}\n-- See Note [Inline FB functions] in GHC.List\nenumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b\nenumDeltaIntegerFB c x0 d = go x0\n  where go x = x `seq` (x `c` go (x+d))\n\n{-# NOINLINE [1] enumDeltaInteger #-}\nenumDeltaInteger :: Integer -> Integer -> [Integer]\nenumDeltaInteger x d = x `seq` (x : enumDeltaInteger (x+d) d)\n-- strict accumulator, so\n--     head (drop 1000000 [1 .. ]\n-- works\n\n{-# INLINE [0] enumDeltaToIntegerFB #-}\n-- See Note [Inline FB functions] in GHC.List\n-- Don't inline this until RULE \"enumDeltaToInteger\" has had a chance to fire\nenumDeltaToIntegerFB :: (Integer -> a -> a) -> a\n                     -> Integer -> Integer -> Integer -> a\nenumDeltaToIntegerFB c n x delta lim\n  | delta >= 0 = up_fb c n x delta lim\n  | otherwise  = dn_fb c n x delta lim\n\n{-# INLINE [0] enumDeltaToInteger1FB #-}\n-- See Note [Inline FB functions] in GHC.List\n-- Don't inline this until RULE \"enumDeltaToInteger\" has had a chance to fire\nenumDeltaToInteger1FB :: (Integer -> a -> a) -> a\n                      -> Integer -> Integer -> a\nenumDeltaToInteger1FB c n x0 lim = go (x0 :: Integer)\n                      where\n                        go x | x > lim   = n\n                             | otherwise = x `c` go (x+1)\n\n{-# NOINLINE [1] enumDeltaToInteger #-}\nenumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer]\nenumDeltaToInteger x delta lim\n  | delta >= 0 = up_list x delta lim\n  | otherwise  = dn_list x delta lim\n\n{-# NOINLINE [1] enumDeltaToInteger1 #-}\nenumDeltaToInteger1 :: Integer -> Integer -> [Integer]\n-- Special case for Delta = 1\nenumDeltaToInteger1 x0 lim = go (x0 :: Integer)\n                      where\n                        go x | x > lim   = []\n                             | otherwise = x : go (x+1)\n\nup_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a\nup_fb c n x0 delta lim = go (x0 :: Integer)\n                      where\n                        go x | x > lim   = n\n                             | otherwise = x `c` go (x+delta)\ndn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a\ndn_fb c n x0 delta lim = go (x0 :: Integer)\n                      where\n                        go x | x < lim   = n\n                             | otherwise = x `c` go (x+delta)\n\nup_list :: Integer -> Integer -> Integer -> [Integer]\nup_list x0 delta lim = go (x0 :: Integer)\n                    where\n                        go x | x > lim   = []\n                             | otherwise = x : go (x+delta)\ndn_list :: Integer -> Integer -> Integer -> [Integer]\ndn_list x0 delta lim = go (x0 :: Integer)\n                    where\n                        go x | x < lim   = []\n                             | otherwise = x : go (x+delta)\n\n------------------------------------------------------------------------\n-- Natural\n------------------------------------------------------------------------\n\n-- | @since 4.8.0.0\ninstance Enum Natural where\n    succ n = n `plusNatural`  wordToNaturalBase 1##\n    pred n = n `minusNatural` wordToNaturalBase 1##\n\n    toEnum = intToNatural\n\n#if defined(MIN_VERSION_integer_gmp)\n    fromEnum (NatS# w)\n      | i >= 0    = i\n      | otherwise = errorWithoutStackTrace \"fromEnum: out of Int range\"\n      where\n        i = I# (word2Int# w)\n#endif\n    fromEnum n = fromEnum (naturalToInteger n)\n\n    enumFrom x        = enumDeltaNatural      x (wordToNaturalBase 1##)\n    enumFromThen x y\n      | x <= y        = enumDeltaNatural      x (y-x)\n      | otherwise     = enumNegDeltaToNatural x (x-y) (wordToNaturalBase 0##)\n\n    enumFromTo x lim  = enumDeltaToNatural    x (wordToNaturalBase 1##) lim\n    enumFromThenTo x y lim\n      | x <= y        = enumDeltaToNatural    x (y-x) lim\n      | otherwise     = enumNegDeltaToNatural x (x-y) lim\n\n-- Helpers for 'Enum Natural'; TODO: optimise & make fusion work\n\nenumDeltaNatural :: Natural -> Natural -> [Natural]\nenumDeltaNatural !x d = x : enumDeltaNatural (x+d) d\n\nenumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]\nenumDeltaToNatural x0 delta lim = go x0\n  where\n    go x | x > lim   = []\n         | otherwise = x : go (x+delta)\n\nenumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]\nenumNegDeltaToNatural x0 ndelta lim = go x0\n  where\n    go x | x < lim     = []\n         | x >= ndelta = x : go (x-ndelta)\n         | otherwise   = [x]\n\n\n-- Instances from GHC.Types\n\n-- | @since 4.10.0.0\nderiving instance Bounded VecCount\n-- | @since 4.10.0.0\nderiving instance Enum VecCount\n\n-- | @since 4.10.0.0\nderiving instance Bounded VecElem\n-- | @since 4.10.0.0\nderiving instance Enum VecElem\n", "num_lines": 978}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE CPP #-}\n\nmodule GHC.Environment (getFullArgs) where\n\nimport Foreign\nimport Foreign.C\nimport GHC.Base\nimport GHC.Real ( fromIntegral )\nimport GHC.IO.Encoding\nimport qualified GHC.Foreign as GHC\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\n-- | Computation 'getFullArgs' is the \"raw\" version of\n-- 'System.Environment.getArgs', similar to @argv@ in other languages. It\n-- returns a list of the program's command line arguments, starting with the\n-- program name, and including those normally eaten by the RTS (+RTS ... -RTS).\ngetFullArgs :: IO [String]\ngetFullArgs = do\n  alloca $ \\ p_argc -> do\n    alloca $ \\ p_argv -> do\n        getFullProgArgv p_argc p_argv\n        p    <- fromIntegral `liftM` peek p_argc\n        argv <- peek p_argv\n        enc <- argvEncoding\n        peekArray p argv >>= mapM (GHC.peekCString enc)\n\nforeign import ccall unsafe \"getFullProgArgv\"\n    getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-}\n{-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Err\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- The \"GHC.Err\" module defines the code for the wired-in error functions,\n-- which have a special type in the compiler (with \\\"open tyvars\\\").\n--\n-- We cannot define these functions in a module where they might be used\n-- (e.g., \"GHC.Base\"), because the magical wired-in type will get confused\n-- with what the typechecker figures out.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Err( absentErr, error, errorWithoutStackTrace, undefined ) where\nimport GHC.CString ()\nimport GHC.Types (Char, RuntimeRep)\nimport GHC.Stack.Types\nimport GHC.Prim\nimport GHC.Integer ()   -- Make sure Integer and Natural are compiled first\nimport GHC.Natural ()   -- because GHC depends on it in a wired-in way\n                        -- so the build system doesn't see the dependency.\n                        -- See Note [Depend on GHC.Integer] and\n                        -- Note [Depend on GHC.Natural] in GHC.Base.\nimport {-# SOURCE #-} GHC.Exception\n  ( errorCallWithCallStackException\n  , errorCallException )\n\n-- | 'error' stops execution and displays an error message.\nerror :: forall (r :: RuntimeRep). forall (a :: TYPE r).\n         HasCallStack => [Char] -> a\nerror s = raise# (errorCallWithCallStackException s ?callStack)\n          -- Bleh, we should be using 'GHC.Stack.callStack' instead of\n          -- '?callStack' here, but 'GHC.Stack.callStack' depends on\n          -- 'GHC.Stack.popCallStack', which is partial and depends on\n          -- 'error'.. Do as I say, not as I do.\n\n-- | A variant of 'error' that does not produce a stack trace.\n--\n-- @since 4.9.0.0\nerrorWithoutStackTrace :: forall (r :: RuntimeRep). forall (a :: TYPE r).\n                          [Char] -> a\nerrorWithoutStackTrace s = raise# (errorCallException s)\n\n\n-- Note [Errors in base]\n-- ~~~~~~~~~~~~~~~~~~~~~\n-- As of base-4.9.0.0, `error` produces a stack trace alongside the\n-- error message using the HasCallStack machinery. This provides\n-- a partial stack trace, containing the call-site of each function\n-- with a HasCallStack constraint.\n--\n-- In base, however, the only functions that have such constraints are\n-- error and undefined, so the stack traces from partial functions in\n-- base will never contain a call-site in user code. Instead we'll\n-- usually just get the actual call to error. Base functions already\n-- have a good habit of providing detailed error messages, including the\n-- name of the offending partial function, so the partial stack-trace\n-- does not provide any extra information, just noise. Thus, we export\n-- the callstack-aware error, but within base we use the\n-- errorWithoutStackTrace variant for more hygienic error messages.\n\n\n-- | A special case of 'error'.\n-- It is expected that compilers will recognize this and insert error\n-- messages which are more appropriate to the context in which 'undefined'\n-- appears.\nundefined :: forall (r :: RuntimeRep). forall (a :: TYPE r).\n             HasCallStack => a\nundefined =  error \"Prelude.undefined\"\n\n-- | Used for compiler-generated error message;\n-- encoding saves bytes of string junk.\nabsentErr :: a\nabsentErr = errorWithoutStackTrace \"Oops! The program has entered an `absent' argument!\\n\"\n", "num_lines": 86}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-- ----------------------------------------------------------------------------\n-- | This module provides scalable event notification for file\n-- descriptors and timeouts.\n--\n-- This module should be considered GHC internal.\n--\n-- ----------------------------------------------------------------------------\n\nmodule GHC.Event\n    ( -- * Types\n      EventManager\n    , TimerManager\n\n      -- * Creation\n    , getSystemEventManager\n    , new\n    , getSystemTimerManager\n\n      -- * Registering interest in I/O events\n    , Event\n    , evtRead\n    , evtWrite\n    , IOCallback\n    , FdKey(keyFd)\n    , Lifetime(..)\n    , registerFd\n    , unregisterFd\n    , unregisterFd_\n    , closeFd\n\n      -- * Registering interest in timeout events\n    , TimeoutCallback\n    , TimeoutKey\n    , registerTimeout\n    , updateTimeout\n    , unregisterTimeout\n    ) where\n\nimport GHC.Event.Manager\nimport GHC.Event.TimerManager (TimeoutCallback, TimeoutKey, registerTimeout,\n                               updateTimeout, unregisterTimeout, TimerManager)\nimport GHC.Event.Thread (getSystemEventManager, getSystemTimerManager)\n\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , ExistentialQuantification\n           , MagicHash\n           , RecordWildCards\n           , PatternSynonyms\n  #-}\n{-# LANGUAGE TypeInType #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Exception\n-- Copyright   :  (c) The University of Glasgow, 1998-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Exceptions and exception-handling functions.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Exception\n       ( module GHC.Exception.Type\n       , throw\n       , ErrorCall(..,ErrorCall)\n       , errorCallException\n       , errorCallWithCallStackException\n         -- re-export CallStack and SrcLoc from GHC.Types\n       , CallStack, fromCallSiteList, getCallStack, prettyCallStack\n       , prettyCallStackLines, showCCSStack\n       , SrcLoc(..), prettySrcLoc\n       ) where\n\nimport GHC.Base\nimport GHC.Show\nimport GHC.Stack.Types\nimport GHC.OldList\nimport GHC.Prim\nimport GHC.IO.Unsafe\nimport {-# SOURCE #-} GHC.Stack.CCS\nimport GHC.Exception.Type\n\n-- | Throw an exception.  Exceptions may be thrown from purely\n-- functional code, but may only be caught within the 'IO' monad.\nthrow :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.\n         Exception e => e -> a\nthrow e = raise# (toException e)\n\n-- | This is thrown when the user calls 'error'. The first @String@ is the\n-- argument given to 'error', second @String@ is the location.\ndata ErrorCall = ErrorCallWithLocation String String\n    deriving ( Eq  -- ^ @since 4.7.0.0\n             , Ord -- ^ @since 4.7.0.0\n             )\n\npattern ErrorCall :: String -> ErrorCall\npattern ErrorCall err <- ErrorCallWithLocation err _ where\n  ErrorCall err = ErrorCallWithLocation err \"\"\n\n{-# COMPLETE ErrorCall #-}\n\n-- | @since 4.0.0.0\ninstance Exception ErrorCall\n\n-- | @since 4.0.0.0\ninstance Show ErrorCall where\n  showsPrec _ (ErrorCallWithLocation err \"\") = showString err\n  showsPrec _ (ErrorCallWithLocation err loc) =\n      showString err . showChar '\\n' . showString loc\n\nerrorCallException :: String -> SomeException\nerrorCallException s = toException (ErrorCall s)\n\nerrorCallWithCallStackException :: String -> CallStack -> SomeException\nerrorCallWithCallStackException s stk = unsafeDupablePerformIO $ do\n  ccsStack <- currentCallStack\n  let\n    implicitParamCallStack = prettyCallStackLines stk\n    ccsCallStack = showCCSStack ccsStack\n    stack = intercalate \"\\n\" $ implicitParamCallStack ++ ccsCallStack\n  return $ toException (ErrorCallWithLocation s stack)\n\nshowCCSStack :: [String] -> [String]\nshowCCSStack [] = []\nshowCCSStack stk = \"CallStack (from -prof):\" : map (\"  \" ++) (reverse stk)\n\n-- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot\n-- files. See Note [Definition of CallStack]\n\n-- | Pretty print a 'SrcLoc'.\n--\n-- @since 4.9.0.0\nprettySrcLoc :: SrcLoc -> String\nprettySrcLoc SrcLoc {..}\n  = foldr (++) \"\"\n      [ srcLocFile, \":\"\n      , show srcLocStartLine, \":\"\n      , show srcLocStartCol, \" in \"\n      , srcLocPackage, \":\", srcLocModule\n      ]\n\n-- | Pretty print a 'CallStack'.\n--\n-- @since 4.9.0.0\nprettyCallStack :: CallStack -> String\nprettyCallStack = intercalate \"\\n\" . prettyCallStackLines\n\nprettyCallStackLines :: CallStack -> [String]\nprettyCallStackLines cs = case getCallStack cs of\n  []  -> []\n  stk -> \"CallStack (from HasCallStack):\"\n       : map ((\"  \" ++) . prettyCallSite) stk\n  where\n    prettyCallSite (f, loc) = f ++ \", called at \" ++ prettySrcLoc loc\n", "num_lines": 118}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.ExecutionStack\n-- Copyright   :  (c) The University of Glasgow 2013-2015\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- This is a module for efficient stack traces. This stack trace implementation\n-- is considered low overhead. Basic usage looks like this:\n--\n-- @\n-- import GHC.ExecutionStack\n--\n-- myFunction :: IO ()\n-- myFunction = do\n--      putStrLn =<< showStackTrace\n-- @\n--\n-- Your GHC must have been built with @libdw@ support for this to work.\n--\n-- @\n-- user@host:~$ ghc --info | grep libdw\n--  ,(\"RTS expects libdw\",\"YES\")\n-- @\n--\n-- @since 4.9.0.0\n-----------------------------------------------------------------------------\n\nmodule GHC.ExecutionStack (\n    Location (..)\n  , SrcLoc (..)\n  , getStackTrace\n  , showStackTrace\n  ) where\n\nimport Control.Monad (join)\nimport GHC.ExecutionStack.Internal\n\n-- | Get a trace of the current execution stack state.\n--\n-- Returns @Nothing@ if stack trace support isn't available on host machine.\ngetStackTrace :: IO (Maybe [Location])\ngetStackTrace = (join . fmap stackFrames) `fmap` collectStackTrace\n\n-- | Get a string representation of the current execution stack state.\nshowStackTrace :: IO (Maybe String)\nshowStackTrace = fmap (\\st -> showStackFrames st \"\") `fmap` getStackTrace\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies, DeriveDataTypeable,\n             MultiParamTypeClasses, FlexibleInstances, NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Exts\n-- Copyright   :  (c) The University of Glasgow 2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- GHC Extensions: this is the Approved Way to get at GHC-specific extensions.\n--\n-- Note: no other base module should import this module.\n-----------------------------------------------------------------------------\n\nmodule GHC.Exts\n       (\n        -- * Representations of some basic types\n        Int(..),Word(..),Float(..),Double(..),\n        Char(..),\n        Ptr(..), FunPtr(..),\n\n        -- * The maximum tuple size\n        maxTupleSize,\n\n        -- * Primitive operations\n        module GHC.Prim,\n        shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,\n        uncheckedShiftL64#, uncheckedShiftRL64#,\n        uncheckedIShiftL64#, uncheckedIShiftRA64#,\n        isTrue#,\n\n        -- * Compat wrapper\n        atomicModifyMutVar#,\n\n        -- * Fusion\n        build, augment,\n\n        -- * Overloaded string literals\n        IsString(..),\n\n        -- * Debugging\n        breakpoint, breakpointCond,\n\n        -- * Ids with special behaviour\n        lazy, inline, oneShot,\n\n        -- * Running 'RealWorld' state thread\n        runRW#,\n\n        -- * Safe coercions\n        --\n        -- | These are available from the /Trustworthy/ module \"Data.Coerce\" as well\n        --\n        -- @since 4.7.0.0\n        Data.Coerce.coerce, Data.Coerce.Coercible,\n\n        -- * Equality\n        type (~~),\n\n        -- * Representation polymorphism\n        GHC.Prim.TYPE, RuntimeRep(..), VecCount(..), VecElem(..),\n\n        -- * Transform comprehensions\n        Down(..), groupWith, sortWith, the,\n\n        -- * Event logging\n        traceEvent,\n\n        -- * SpecConstr annotations\n        SpecConstrAnnotation(..),\n\n        -- * The call stack\n        currentCallStack,\n\n        -- * The Constraint kind\n        Constraint,\n\n        -- * The Any type\n        Any,\n\n        -- * Overloaded lists\n        IsList(..)\n       ) where\n\nimport GHC.Prim hiding ( coerce, TYPE )\nimport qualified GHC.Prim\nimport GHC.Base hiding ( coerce )\nimport GHC.Word\nimport GHC.Int\nimport GHC.Ptr\nimport GHC.Stack\n\nimport qualified Data.Coerce\nimport Data.String\nimport Data.OldList\nimport Data.Data\nimport Data.Ord\nimport Data.Version ( Version(..), makeVersion )\nimport qualified Debug.Trace\n\n-- XXX This should really be in Data.Tuple, where the definitions are\nmaxTupleSize :: Int\nmaxTupleSize = 62\n\n-- | 'the' ensures that all the elements of the list are identical\n-- and then returns that unique element\nthe :: Eq a => [a] -> a\nthe (x:xs)\n  | all (x ==) xs = x\n  | otherwise     = errorWithoutStackTrace \"GHC.Exts.the: non-identical elements\"\nthe []            = errorWithoutStackTrace \"GHC.Exts.the: empty list\"\n\n-- | The 'sortWith' function sorts a list of elements using the\n-- user supplied function to project something out of each element\nsortWith :: Ord b => (a -> b) -> [a] -> [a]\nsortWith f = sortBy (\\x y -> compare (f x) (f y))\n\n-- | The 'groupWith' function uses the user supplied function which\n-- projects an element out of every list element in order to first sort the\n-- input list and then to form groups by equality on these projected elements\n{-# INLINE groupWith #-}\ngroupWith :: Ord b => (a -> b) -> [a] -> [[a]]\ngroupWith f xs = build (\\c n -> groupByFB c n (\\x y -> f x == f y) (sortWith f xs))\n\n{-# INLINE [0] groupByFB #-} -- See Note [Inline FB functions] in GHC.List\ngroupByFB :: ([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst\ngroupByFB c n eq xs0 = groupByFBCore xs0\n  where groupByFBCore [] = n\n        groupByFBCore (x:xs) = c (x:ys) (groupByFBCore zs)\n            where (ys, zs) = span (eq x) xs\n\n\n-- -----------------------------------------------------------------------------\n-- tracing\n\ntraceEvent :: String -> IO ()\ntraceEvent = Debug.Trace.traceEventIO\n{-# DEPRECATED traceEvent \"Use 'Debug.Trace.traceEvent' or 'Debug.Trace.traceEventIO'\" #-} -- deprecated in 7.4\n\n\n{- **********************************************************************\n*                                                                       *\n*              SpecConstr annotation                                    *\n*                                                                       *\n********************************************************************** -}\n\n-- Annotating a type with NoSpecConstr will make SpecConstr\n-- not specialise for arguments of that type.\n\n-- This data type is defined here, rather than in the SpecConstr module\n-- itself, so that importing it doesn't force stupidly linking the\n-- entire ghc package at runtime\n\ndata SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr\n                deriving ( Data -- ^ @since 4.3.0.0\n                         , Eq   -- ^ @since 4.3.0.0\n                         )\n\n\n{- **********************************************************************\n*                                                                       *\n*              The IsList class                                         *\n*                                                                       *\n********************************************************************** -}\n\n-- | The 'IsList' class and its methods are intended to be used in\n--   conjunction with the OverloadedLists extension.\n--\n-- @since 4.7.0.0\nclass IsList l where\n  -- | The 'Item' type function returns the type of items of the structure\n  --   @l@.\n  type Item l\n\n  -- | The 'fromList' function constructs the structure @l@ from the given\n  --   list of @Item l@\n  fromList  :: [Item l] -> l\n\n  -- | The 'fromListN' function takes the input list's length as a hint. Its\n  --   behaviour should be equivalent to 'fromList'. The hint can be used to\n  --   construct the structure @l@ more efficiently compared to 'fromList'. If\n  --   the given hint does not equal to the input list's length the behaviour of\n  --   'fromListN' is not specified.\n  fromListN :: Int -> [Item l] -> l\n  fromListN _ = fromList\n\n  -- | The 'toList' function extracts a list of @Item l@ from the structure @l@.\n  --   It should satisfy fromList . toList = id.\n  toList :: l -> [Item l]\n\n-- | @since 4.7.0.0\ninstance IsList [a] where\n  type (Item [a]) = a\n  fromList = id\n  toList = id\n\n-- | @since 4.9.0.0\ninstance IsList (NonEmpty a) where\n  type Item (NonEmpty a) = a\n\n  fromList (a:as) = a :| as\n  fromList [] = errorWithoutStackTrace \"NonEmpty.fromList: empty list\"\n\n  toList ~(a :| as) = a : as\n\n-- | @since 4.8.0.0\ninstance IsList Version where\n  type (Item Version) = Int\n  fromList = makeVersion\n  toList = versionBranch\n\n-- | Be aware that 'fromList . toList = id' only for unfrozen 'CallStack's,\n-- since 'toList' removes frozenness information.\n--\n-- @since 4.9.0.0\ninstance IsList CallStack where\n  type (Item CallStack) = (String, SrcLoc)\n  fromList = fromCallSiteList\n  toList   = getCallStack\n\n-- | An implementation of the old @atomicModifyMutVar#@ primop in\n-- terms of the new 'atomicModifyMutVar2#' primop, for backwards\n-- compatibility. The type of this function is a bit bogus. It's\n-- best to think of it as having type\n--\n-- @\n-- atomicModifyMutVar#\n--   :: MutVar# s a\n--   -> (a -> (a, b))\n--   -> State# s\n--   -> (# State# s, b #)\n-- @\n--\n-- but there may be code that uses this with other two-field record\n-- types.\natomicModifyMutVar#\n  :: MutVar# s a\n  -> (a -> b)\n  -> State# s\n  -> (# State# s, c #)\natomicModifyMutVar# mv f s =\n  case unsafeCoerce# (atomicModifyMutVar2# mv f s) of\n    (# s', _, ~(_, res) #) -> (# s', res #)\n", "num_lines": 249}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , BangPatterns\n  #-}\n\n-- ----------------------------------------------------------------------------\n--\n--  (c) The University of Glasgow 2006\n--\n-- Fingerprints for recompilation checking and ABI versioning, and\n-- implementing fast comparison of Typeable.\n--\n-- ----------------------------------------------------------------------------\n\nmodule GHC.Fingerprint (\n        Fingerprint(..), fingerprint0,\n        fingerprintData,\n        fingerprintString,\n        fingerprintFingerprints,\n        getFileHash\n   ) where\n\nimport GHC.IO\nimport GHC.Base\nimport GHC.Num\nimport GHC.List\nimport GHC.Real\nimport GHC.Show\nimport Foreign\nimport Foreign.C\nimport System.IO\n\nimport GHC.Fingerprint.Type\n\n-- for SIZEOF_STRUCT_MD5CONTEXT:\n#include \"HsBaseConfig.h\"\n\n-- XXX instance Storable Fingerprint\n-- defined in Foreign.Storable to avoid orphan instance\n\nfingerprint0 :: Fingerprint\nfingerprint0 = Fingerprint 0 0\n\nfingerprintFingerprints :: [Fingerprint] -> Fingerprint\nfingerprintFingerprints fs = unsafeDupablePerformIO $\n  withArrayLen fs $ \\len p -> do\n    fingerprintData (castPtr p) (len * sizeOf (head fs))\n\nfingerprintData :: Ptr Word8 -> Int -> IO Fingerprint\nfingerprintData buf len = do\n  allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \\pctxt -> do\n    c_MD5Init pctxt\n    c_MD5Update pctxt buf (fromIntegral len)\n    allocaBytes 16 $ \\pdigest -> do\n      c_MD5Final pdigest pctxt\n      peek (castPtr pdigest :: Ptr Fingerprint)\n\nfingerprintString :: String -> Fingerprint\nfingerprintString str = unsafeDupablePerformIO $\n  withArrayLen word8s $ \\len p ->\n     fingerprintData p len\n    where word8s = concatMap f str\n          f c = let w32 :: Word32\n                    w32 = fromIntegral (ord c)\n                in [fromIntegral (w32 `shiftR` 24),\n                    fromIntegral (w32 `shiftR` 16),\n                    fromIntegral (w32 `shiftR` 8),\n                    fromIntegral w32]\n\n-- | Computes the hash of a given file.\n-- This function loops over the handle, running in constant memory.\n--\n-- @since 4.7.0.0\ngetFileHash :: FilePath -> IO Fingerprint\ngetFileHash path = withBinaryFile path ReadMode $ \\h -> do\n  allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \\pctxt -> do\n    c_MD5Init pctxt\n\n    processChunks h (\\buf size -> c_MD5Update pctxt buf (fromIntegral size))\n\n    allocaBytes 16 $ \\pdigest -> do\n      c_MD5Final pdigest pctxt\n      peek (castPtr pdigest :: Ptr Fingerprint)\n\n  where\n    _BUFSIZE = 4096\n\n    -- | Loop over _BUFSIZE sized chunks read from the handle,\n    -- passing the callback a block of bytes and its size.\n    processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()\n    processChunks h f = allocaBytes _BUFSIZE $ \\arrPtr ->\n\n      let loop = do\n            count <- hGetBuf h arrPtr _BUFSIZE\n            eof <- hIsEOF h\n            when (count /= _BUFSIZE && not eof) $ errorWithoutStackTrace $\n              \"GHC.Fingerprint.getFileHash: only read \" ++ show count ++ \" bytes\"\n\n            f arrPtr count\n\n            when (not eof) loop\n\n      in loop\n\ndata MD5Context\n\nforeign import ccall unsafe \"__hsbase_MD5Init\"\n   c_MD5Init   :: Ptr MD5Context -> IO ()\nforeign import ccall unsafe \"__hsbase_MD5Update\"\n   c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()\nforeign import ccall unsafe \"__hsbase_MD5Final\"\n   c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()\n", "num_lines": 114}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , GHCForeignImportPrim\n           , NoImplicitPrelude\n           , MagicHash\n           , UnboxedTuples\n           , UnliftedFFITypes\n  #-}\n{-# LANGUAGE CApiFFI #-}\n-- We believe we could deorphan this module, by moving lots of things\n-- around, but we haven't got there yet:\n{-# OPTIONS_GHC -Wno-orphans #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Float\n-- Copyright   :  (c) The University of Glasgow 1994-2002\n--                Portions obtained from hbc (c) Lennart Augusstson\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The types 'Float' and 'Double', the classes 'Floating' and 'RealFloat' and\n-- casting between Word32 and Float and Word64 and Double.\n--\n-----------------------------------------------------------------------------\n\n#include \"ieee-flpt.h\"\n#include \"MachDeps.h\"\n\nmodule GHC.Float\n   ( module GHC.Float\n   , Float(..), Double(..), Float#, Double#\n   , double2Int, int2Double, float2Int, int2Float\n\n    -- * Monomorphic equality operators\n    -- | See GHC.Classes#matching_overloaded_methods_in_rules\n   , eqFloat, eqDouble\n   ) where\n\nimport Data.Maybe\n\nimport Data.Bits\nimport GHC.Base\nimport GHC.List\nimport GHC.Enum\nimport GHC.Show\nimport GHC.Num\nimport GHC.Real\nimport GHC.Word\nimport GHC.Arr\nimport GHC.Float.RealFracMethods\nimport GHC.Float.ConversionUtils\nimport GHC.Integer.Logarithms ( integerLogBase# )\nimport GHC.Integer.Logarithms.Internals\n\ninfixr 8  **\n\n------------------------------------------------------------------------\n-- Standard numeric classes\n------------------------------------------------------------------------\n\n-- | Trigonometric and hyperbolic functions and related functions.\n--\n-- The Haskell Report defines no laws for 'Floating'. However, @('+')@, @('*')@\n-- and 'exp' are customarily expected to define an exponential field and have\n-- the following properties:\n--\n-- * @exp (a + b)@ = @exp a * exp b@\n-- * @exp (fromInteger 0)@ = @fromInteger 1@\n--\nclass  (Fractional a) => Floating a  where\n    pi                  :: a\n    exp, log, sqrt      :: a -> a\n    (**), logBase       :: a -> a -> a\n    sin, cos, tan       :: a -> a\n    asin, acos, atan    :: a -> a\n    sinh, cosh, tanh    :: a -> a\n    asinh, acosh, atanh :: a -> a\n\n    -- | @'log1p' x@ computes @'log' (1 + x)@, but provides more precise\n    -- results for small (absolute) values of @x@ if possible.\n    --\n    -- @since 4.9.0.0\n    log1p               :: a -> a\n\n    -- | @'expm1' x@ computes @'exp' x - 1@, but provides more precise\n    -- results for small (absolute) values of @x@ if possible.\n    --\n    -- @since 4.9.0.0\n    expm1               :: a -> a\n\n    -- | @'log1pexp' x@ computes @'log' (1 + 'exp' x)@, but provides more\n    -- precise results if possible.\n    --\n    -- Examples:\n    --\n    -- * if @x@ is a large negative number, @'log' (1 + 'exp' x)@ will be\n    --   imprecise for the reasons given in 'log1p'.\n    --\n    -- * if @'exp' x@ is close to @-1@, @'log' (1 + 'exp' x)@ will be\n    --   imprecise for the reasons given in 'expm1'.\n    --\n    -- @since 4.9.0.0\n    log1pexp            :: a -> a\n\n    -- | @'log1mexp' x@ computes @'log' (1 - 'exp' x)@, but provides more\n    -- precise results if possible.\n    --\n    -- Examples:\n    --\n    -- * if @x@ is a large negative number, @'log' (1 - 'exp' x)@ will be\n    --   imprecise for the reasons given in 'log1p'.\n    --\n    -- * if @'exp' x@ is close to @1@, @'log' (1 - 'exp' x)@ will be\n    --   imprecise for the reasons given in 'expm1'.\n    --\n    -- @since 4.9.0.0\n    log1mexp            :: a -> a\n\n    {-# INLINE (**) #-}\n    {-# INLINE logBase #-}\n    {-# INLINE sqrt #-}\n    {-# INLINE tan #-}\n    {-# INLINE tanh #-}\n    x ** y              =  exp (log x * y)\n    logBase x y         =  log y / log x\n    sqrt x              =  x ** 0.5\n    tan  x              =  sin  x / cos  x\n    tanh x              =  sinh x / cosh x\n\n    {-# INLINE log1p #-}\n    {-# INLINE expm1 #-}\n    {-# INLINE log1pexp #-}\n    {-# INLINE log1mexp #-}\n    log1p x = log (1 + x)\n    expm1 x = exp x - 1\n    log1pexp x = log1p (exp x)\n    log1mexp x = log1p (negate (exp x))\n\n-- | Efficient, machine-independent access to the components of a\n-- floating-point number.\nclass  (RealFrac a, Floating a) => RealFloat a  where\n    -- | a constant function, returning the radix of the representation\n    -- (often @2@)\n    floatRadix          :: a -> Integer\n    -- | a constant function, returning the number of digits of\n    -- 'floatRadix' in the significand\n    floatDigits         :: a -> Int\n    -- | a constant function, returning the lowest and highest values\n    -- the exponent may assume\n    floatRange          :: a -> (Int,Int)\n    -- | The function 'decodeFloat' applied to a real floating-point\n    -- number returns the significand expressed as an 'Integer' and an\n    -- appropriately scaled exponent (an 'Int').  If @'decodeFloat' x@\n    -- yields @(m,n)@, then @x@ is equal in value to @m*b^^n@, where @b@\n    -- is the floating-point radix, and furthermore, either @m@ and @n@\n    -- are both zero or else @b^(d-1) <= 'abs' m < b^d@, where @d@ is\n    -- the value of @'floatDigits' x@.\n    -- In particular, @'decodeFloat' 0 = (0,0)@. If the type\n    -- contains a negative zero, also @'decodeFloat' (-0.0) = (0,0)@.\n    -- /The result of/ @'decodeFloat' x@ /is unspecified if either of/\n    -- @'isNaN' x@ /or/ @'isInfinite' x@ /is/ 'True'.\n    decodeFloat         :: a -> (Integer,Int)\n    -- | 'encodeFloat' performs the inverse of 'decodeFloat' in the\n    -- sense that for finite @x@ with the exception of @-0.0@,\n    -- @'Prelude.uncurry' 'encodeFloat' ('decodeFloat' x) = x@.\n    -- @'encodeFloat' m n@ is one of the two closest representable\n    -- floating-point numbers to @m*b^^n@ (or @&#177;Infinity@ if overflow\n    -- occurs); usually the closer, but if @m@ contains too many bits,\n    -- the result may be rounded in the wrong direction.\n    encodeFloat         :: Integer -> Int -> a\n    -- | 'exponent' corresponds to the second component of 'decodeFloat'.\n    -- @'exponent' 0 = 0@ and for finite nonzero @x@,\n    -- @'exponent' x = snd ('decodeFloat' x) + 'floatDigits' x@.\n    -- If @x@ is a finite floating-point number, it is equal in value to\n    -- @'significand' x * b ^^ 'exponent' x@, where @b@ is the\n    -- floating-point radix.\n    -- The behaviour is unspecified on infinite or @NaN@ values.\n    exponent            :: a -> Int\n    -- | The first component of 'decodeFloat', scaled to lie in the open\n    -- interval (@-1@,@1@), either @0.0@ or of absolute value @>= 1\\/b@,\n    -- where @b@ is the floating-point radix.\n    -- The behaviour is unspecified on infinite or @NaN@ values.\n    significand         :: a -> a\n    -- | multiplies a floating-point number by an integer power of the radix\n    scaleFloat          :: Int -> a -> a\n    -- | 'True' if the argument is an IEEE \\\"not-a-number\\\" (NaN) value\n    isNaN               :: a -> Bool\n    -- | 'True' if the argument is an IEEE infinity or negative infinity\n    isInfinite          :: a -> Bool\n    -- | 'True' if the argument is too small to be represented in\n    -- normalized format\n    isDenormalized      :: a -> Bool\n    -- | 'True' if the argument is an IEEE negative zero\n    isNegativeZero      :: a -> Bool\n    -- | 'True' if the argument is an IEEE floating point number\n    isIEEE              :: a -> Bool\n    -- | a version of arctangent taking two real floating-point arguments.\n    -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle\n    -- (from the positive x-axis) of the vector from the origin to the\n    -- point @(x,y)@.  @'atan2' y x@ returns a value in the range [@-pi@,\n    -- @pi@].  It follows the Common Lisp semantics for the origin when\n    -- signed zeroes are supported.  @'atan2' y 1@, with @y@ in a type\n    -- that is 'RealFloat', should return the same value as @'atan' y@.\n    -- A default definition of 'atan2' is provided, but implementors\n    -- can provide a more accurate implementation.\n    atan2               :: a -> a -> a\n\n\n    exponent x          =  if m == 0 then 0 else n + floatDigits x\n                           where (m,n) = decodeFloat x\n\n    significand x       =  encodeFloat m (negate (floatDigits x))\n                           where (m,_) = decodeFloat x\n\n    scaleFloat 0 x      =  x\n    scaleFloat k x\n      | isFix           =  x\n      | otherwise       =  encodeFloat m (n + clamp b k)\n                           where (m,n) = decodeFloat x\n                                 (l,h) = floatRange x\n                                 d     = floatDigits x\n                                 b     = h - l + 4*d\n                                 -- n+k may overflow, which would lead\n                                 -- to wrong results, hence we clamp the\n                                 -- scaling parameter.\n                                 -- If n + k would be larger than h,\n                                 -- n + clamp b k must be too, simliar\n                                 -- for smaller than l - d.\n                                 -- Add a little extra to keep clear\n                                 -- from the boundary cases.\n                                 isFix = x == 0 || isNaN x || isInfinite x\n\n    atan2 y x\n      | x > 0            =  atan (y/x)\n      | x == 0 && y > 0  =  pi/2\n      | x <  0 && y > 0  =  pi + atan (y/x)\n      |(x <= 0 && y < 0)            ||\n       (x <  0 && isNegativeZero y) ||\n       (isNegativeZero x && isNegativeZero y)\n                         = -atan2 (-y) x\n      | y == 0 && (x < 0 || isNegativeZero x)\n                          =  pi    -- must be after the previous test on zero y\n      | x==0 && y==0      =  y     -- must be after the other double zero tests\n      | otherwise         =  x + y -- x or y is a NaN, return a NaN (via +)\n\n------------------------------------------------------------------------\n-- Float\n------------------------------------------------------------------------\n\n-- | @since 2.01\n-- Note that due to the presence of @NaN@, not all elements of 'Float' have an\n-- additive inverse.\n--\n-- >>> 0/0 + (negate 0/0 :: Float)\n-- NaN\n--\n-- Also note that due to the presence of -0, `Float`'s 'Num' instance doesn't\n-- have an additive identity\n--\n-- >>> 0 + (-0 :: Float)\n-- 0.0\ninstance Num Float where\n    (+)         x y     =  plusFloat x y\n    (-)         x y     =  minusFloat x y\n    negate      x       =  negateFloat x\n    (*)         x y     =  timesFloat x y\n    abs         x       =  fabsFloat x\n    signum x | x > 0     = 1\n             | x < 0     = negateFloat 1\n             | otherwise = x -- handles 0.0, (-0.0), and NaN\n\n    {-# INLINE fromInteger #-}\n    fromInteger i = F# (floatFromInteger i)\n\n-- | @since 2.01\ninstance  Real Float  where\n    toRational (F# x#)  =\n        case decodeFloat_Int# x# of\n          (# m#, e# #)\n            | isTrue# (e# >=# 0#)                               ->\n                    (smallInteger m# `shiftLInteger` e#) :% 1\n            | isTrue# ((int2Word# m# `and#` 1##) `eqWord#` 0##) ->\n                    case elimZerosInt# m# (negateInt# e#) of\n                      (# n, d# #) -> n :% shiftLInteger 1 d#\n            | otherwise                                         ->\n                    smallInteger m# :% shiftLInteger 1 (negateInt# e#)\n\n-- | @since 2.01\n-- Note that due to the presence of @NaN@, not all elements of 'Float' have an\n-- multiplicative inverse.\n--\n-- >>> 0/0 * (recip 0/0 :: Float)\n-- NaN\ninstance  Fractional Float  where\n    (/) x y             =  divideFloat x y\n    {-# INLINE fromRational #-}\n    fromRational (n:%d) = rationalToFloat n d\n    recip x             =  1.0 / x\n\nrationalToFloat :: Integer -> Integer -> Float\n{-# NOINLINE [1] rationalToFloat #-}\nrationalToFloat n 0\n    | n == 0        = 0/0\n    | n < 0         = (-1)/0\n    | otherwise     = 1/0\nrationalToFloat n d\n    | n == 0        = encodeFloat 0 0\n    | n < 0         = -(fromRat'' minEx mantDigs (-n) d)\n    | otherwise     = fromRat'' minEx mantDigs n d\n      where\n        minEx       = FLT_MIN_EXP\n        mantDigs    = FLT_MANT_DIG\n\n-- RULES for Integer and Int\n{-# RULES\n\"properFraction/Float->Integer\"     properFraction = properFractionFloatInteger\n\"truncate/Float->Integer\"           truncate = truncateFloatInteger\n\"floor/Float->Integer\"              floor = floorFloatInteger\n\"ceiling/Float->Integer\"            ceiling = ceilingFloatInteger\n\"round/Float->Integer\"              round = roundFloatInteger\n\"properFraction/Float->Int\"         properFraction = properFractionFloatInt\n\"truncate/Float->Int\"               truncate = float2Int\n\"floor/Float->Int\"                  floor = floorFloatInt\n\"ceiling/Float->Int\"                ceiling = ceilingFloatInt\n\"round/Float->Int\"                  round = roundFloatInt\n  #-}\n-- | @since 2.01\ninstance  RealFrac Float  where\n\n        -- ceiling, floor, and truncate are all small\n    {-# INLINE [1] ceiling #-}\n    {-# INLINE [1] floor #-}\n    {-# INLINE [1] truncate #-}\n\n-- We assume that FLT_RADIX is 2 so that we can use more efficient code\n#if FLT_RADIX != 2\n#error FLT_RADIX must be 2\n#endif\n    properFraction (F# x#)\n      = case decodeFloat_Int# x# of\n        (# m#, n# #) ->\n            let m = I# m#\n                n = I# n#\n            in\n            if n >= 0\n            then (fromIntegral m * (2 ^ n), 0.0)\n            else let i = if m >= 0 then                m `shiftR` negate n\n                                   else negate (negate m `shiftR` negate n)\n                     f = m - (i `shiftL` negate n)\n                 in (fromIntegral i, encodeFloat (fromIntegral f) n)\n\n    truncate x  = case properFraction x of\n                     (n,_) -> n\n\n    round x     = case properFraction x of\n                     (n,r) -> let\n                                m         = if r < 0.0 then n - 1 else n + 1\n                                half_down = abs r - 0.5\n                              in\n                              case (compare half_down 0.0) of\n                                LT -> n\n                                EQ -> if even n then n else m\n                                GT -> m\n\n    ceiling x   = case properFraction x of\n                    (n,r) -> if r > 0.0 then n + 1 else n\n\n    floor x     = case properFraction x of\n                    (n,r) -> if r < 0.0 then n - 1 else n\n\n-- | @since 2.01\ninstance  Floating Float  where\n    pi                  =  3.141592653589793238\n    exp x               =  expFloat x\n    log x               =  logFloat x\n    sqrt x              =  sqrtFloat x\n    sin x               =  sinFloat x\n    cos x               =  cosFloat x\n    tan x               =  tanFloat x\n    asin x              =  asinFloat x\n    acos x              =  acosFloat x\n    atan x              =  atanFloat x\n    sinh x              =  sinhFloat x\n    cosh x              =  coshFloat x\n    tanh x              =  tanhFloat x\n    (**) x y            =  powerFloat x y\n    logBase x y         =  log y / log x\n\n    asinh x             =  asinhFloat x\n    acosh x             =  acoshFloat x\n    atanh x             =  atanhFloat x\n\n    log1p = log1pFloat\n    expm1 = expm1Float\n\n    log1mexp a\n      | a <= log 2 = log (negate (expm1Float a))\n      | otherwise  = log1pFloat (negate (exp a))\n    {-# INLINE log1mexp #-}\n    log1pexp a\n      | a <= 18   = log1pFloat (exp a)\n      | a <= 100  = a + exp (negate a)\n      | otherwise = a\n    {-# INLINE log1pexp #-}\n\n-- | @since 2.01\ninstance  RealFloat Float  where\n    floatRadix _        =  FLT_RADIX        -- from float.h\n    floatDigits _       =  FLT_MANT_DIG     -- ditto\n    floatRange _        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto\n\n    decodeFloat (F# f#) = case decodeFloat_Int# f# of\n                          (# i, e #) -> (smallInteger i, I# e)\n\n    encodeFloat i (I# e) = F# (encodeFloatInteger i e)\n\n    exponent x          = case decodeFloat x of\n                            (m,n) -> if m == 0 then 0 else n + floatDigits x\n\n    significand x       = case decodeFloat x of\n                            (m,_) -> encodeFloat m (negate (floatDigits x))\n\n    scaleFloat 0 x      = x\n    scaleFloat k x\n      | isFix           = x\n      | otherwise       = case decodeFloat x of\n                            (m,n) -> encodeFloat m (n + clamp bf k)\n                        where bf = FLT_MAX_EXP - (FLT_MIN_EXP) + 4*FLT_MANT_DIG\n                              isFix = x == 0 || isFloatFinite x == 0\n\n    isNaN x          = 0 /= isFloatNaN x\n    isInfinite x     = 0 /= isFloatInfinite x\n    isDenormalized x = 0 /= isFloatDenormalized x\n    isNegativeZero x = 0 /= isFloatNegativeZero x\n    isIEEE _         = True\n\n-- | @since 2.01\ninstance  Show Float  where\n    showsPrec   x = showSignedFloat showFloat x\n    showList = showList__ (showsPrec 0)\n\n------------------------------------------------------------------------\n-- Double\n------------------------------------------------------------------------\n\n-- | @since 2.01\n-- Note that due to the presence of @NaN@, not all elements of 'Double' have an\n-- additive inverse.\n--\n-- >>> 0/0 + (negate 0/0 :: Double)\n-- NaN\n--\n-- Also note that due to the presence of -0, `Double`'s 'Num' instance doesn't\n-- have an additive identity\n--\n-- >>> 0 + (-0 :: Double)\n-- 0.0\ninstance  Num Double  where\n    (+)         x y     =  plusDouble x y\n    (-)         x y     =  minusDouble x y\n    negate      x       =  negateDouble x\n    (*)         x y     =  timesDouble x y\n    abs         x       =  fabsDouble x\n    signum x | x > 0     = 1\n             | x < 0     = negateDouble 1\n             | otherwise = x -- handles 0.0, (-0.0), and NaN\n\n\n    {-# INLINE fromInteger #-}\n    fromInteger i = D# (doubleFromInteger i)\n\n\n-- | @since 2.01\ninstance  Real Double  where\n    toRational (D# x#)  =\n        case decodeDoubleInteger x# of\n          (# m, e# #)\n            | isTrue# (e# >=# 0#)                                  ->\n                shiftLInteger m e# :% 1\n            | isTrue# ((integerToWord m `and#` 1##) `eqWord#` 0##) ->\n                case elimZerosInteger m (negateInt# e#) of\n                    (# n, d# #) ->  n :% shiftLInteger 1 d#\n            | otherwise                                            ->\n                m :% shiftLInteger 1 (negateInt# e#)\n\n-- | @since 2.01\n-- Note that due to the presence of @NaN@, not all elements of 'Double' have an\n-- multiplicative inverse.\n--\n-- >>> 0/0 * (recip 0/0 :: Double)\n-- NaN\ninstance  Fractional Double  where\n    (/) x y             =  divideDouble x y\n    {-# INLINE fromRational #-}\n    fromRational (n:%d) = rationalToDouble n d\n    recip x             =  1.0 / x\n\nrationalToDouble :: Integer -> Integer -> Double\n{-# NOINLINE [1] rationalToDouble #-}\nrationalToDouble n 0\n    | n == 0        = 0/0\n    | n < 0         = (-1)/0\n    | otherwise     = 1/0\nrationalToDouble n d\n    | n == 0        = encodeFloat 0 0\n    | n < 0         = -(fromRat'' minEx mantDigs (-n) d)\n    | otherwise     = fromRat'' minEx mantDigs n d\n      where\n        minEx       = DBL_MIN_EXP\n        mantDigs    = DBL_MANT_DIG\n\n-- | @since 2.01\ninstance  Floating Double  where\n    pi                  =  3.141592653589793238\n    exp x               =  expDouble x\n    log x               =  logDouble x\n    sqrt x              =  sqrtDouble x\n    sin  x              =  sinDouble x\n    cos  x              =  cosDouble x\n    tan  x              =  tanDouble x\n    asin x              =  asinDouble x\n    acos x              =  acosDouble x\n    atan x              =  atanDouble x\n    sinh x              =  sinhDouble x\n    cosh x              =  coshDouble x\n    tanh x              =  tanhDouble x\n    (**) x y            =  powerDouble x y\n    logBase x y         =  log y / log x\n\n    asinh x             =  asinhDouble x\n    acosh x             =  acoshDouble x\n    atanh x             =  atanhDouble x\n\n    log1p = log1pDouble\n    expm1 = expm1Double\n\n    log1mexp a\n      | a <= log 2 = log (negate (expm1Double a))\n      | otherwise  = log1pDouble (negate (exp a))\n    {-# INLINE log1mexp #-}\n    log1pexp a\n      | a <= 18   = log1pDouble (exp a)\n      | a <= 100  = a + exp (negate a)\n      | otherwise = a\n    {-# INLINE log1pexp #-}\n\n-- RULES for Integer and Int\n{-# RULES\n\"properFraction/Double->Integer\"    properFraction = properFractionDoubleInteger\n\"truncate/Double->Integer\"          truncate = truncateDoubleInteger\n\"floor/Double->Integer\"             floor = floorDoubleInteger\n\"ceiling/Double->Integer\"           ceiling = ceilingDoubleInteger\n\"round/Double->Integer\"             round = roundDoubleInteger\n\"properFraction/Double->Int\"        properFraction = properFractionDoubleInt\n\"truncate/Double->Int\"              truncate = double2Int\n\"floor/Double->Int\"                 floor = floorDoubleInt\n\"ceiling/Double->Int\"               ceiling = ceilingDoubleInt\n\"round/Double->Int\"                 round = roundDoubleInt\n  #-}\n-- | @since 2.01\ninstance  RealFrac Double  where\n\n        -- ceiling, floor, and truncate are all small\n    {-# INLINE [1] ceiling #-}\n    {-# INLINE [1] floor #-}\n    {-# INLINE [1] truncate #-}\n\n    properFraction x\n      = case (decodeFloat x)      of { (m,n) ->\n        if n >= 0 then\n            (fromInteger m * 2 ^ n, 0.0)\n        else\n            case (quotRem m (2^(negate n))) of { (w,r) ->\n            (fromInteger w, encodeFloat r n)\n            }\n        }\n\n    truncate x  = case properFraction x of\n                     (n,_) -> n\n\n    round x     = case properFraction x of\n                     (n,r) -> let\n                                m         = if r < 0.0 then n - 1 else n + 1\n                                half_down = abs r - 0.5\n                              in\n                              case (compare half_down 0.0) of\n                                LT -> n\n                                EQ -> if even n then n else m\n                                GT -> m\n\n    ceiling x   = case properFraction x of\n                    (n,r) -> if r > 0.0 then n + 1 else n\n\n    floor x     = case properFraction x of\n                    (n,r) -> if r < 0.0 then n - 1 else n\n\n-- | @since 2.01\ninstance  RealFloat Double  where\n    floatRadix _        =  FLT_RADIX        -- from float.h\n    floatDigits _       =  DBL_MANT_DIG     -- ditto\n    floatRange _        =  (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto\n\n    decodeFloat (D# x#)\n      = case decodeDoubleInteger x#   of\n          (# i, j #) -> (i, I# j)\n\n    encodeFloat i (I# j) = D# (encodeDoubleInteger i j)\n\n    exponent x          = case decodeFloat x of\n                            (m,n) -> if m == 0 then 0 else n + floatDigits x\n\n    significand x       = case decodeFloat x of\n                            (m,_) -> encodeFloat m (negate (floatDigits x))\n\n    scaleFloat 0 x      = x\n    scaleFloat k x\n      | isFix           = x\n      | otherwise       = case decodeFloat x of\n                            (m,n) -> encodeFloat m (n + clamp bd k)\n                        where bd = DBL_MAX_EXP - (DBL_MIN_EXP) + 4*DBL_MANT_DIG\n                              isFix = x == 0 || isDoubleFinite x == 0\n\n    isNaN x             = 0 /= isDoubleNaN x\n    isInfinite x        = 0 /= isDoubleInfinite x\n    isDenormalized x    = 0 /= isDoubleDenormalized x\n    isNegativeZero x    = 0 /= isDoubleNegativeZero x\n    isIEEE _            = True\n\n-- | @since 2.01\ninstance  Show Double  where\n    showsPrec   x = showSignedFloat showFloat x\n    showList = showList__ (showsPrec 0)\n\n\n------------------------------------------------------------------------\n-- Enum instances\n------------------------------------------------------------------------\n\n{-\nThe @Enum@ instances for Floats and Doubles are slightly unusual.\nThe @toEnum@ function truncates numbers to Int.  The definitions\nof @enumFrom@ and @enumFromThen@ allow floats to be used in arithmetic\nseries: [0,0.1 .. 1.0].  However, roundoff errors make these somewhat\ndubious.  This example may have either 10 or 11 elements, depending on\nhow 0.1 is represented.\n\nNOTE: The instances for Float and Double do not make use of the default\nmethods for @enumFromTo@ and @enumFromThenTo@, as these rely on there being\na `non-lossy' conversion to and from Ints. Instead we make use of the\n1.2 default methods (back in the days when Enum had Ord as a superclass)\nfor these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.)\n-}\n\n-- | @since 2.01\ninstance  Enum Float  where\n    succ x         = x + 1\n    pred x         = x - 1\n    toEnum         = int2Float\n    fromEnum       = fromInteger . truncate   -- may overflow\n    enumFrom       = numericEnumFrom\n    enumFromTo     = numericEnumFromTo\n    enumFromThen   = numericEnumFromThen\n    enumFromThenTo = numericEnumFromThenTo\n\n-- | @since 2.01\ninstance  Enum Double  where\n    succ x         = x + 1\n    pred x         = x - 1\n    toEnum         =  int2Double\n    fromEnum       =  fromInteger . truncate   -- may overflow\n    enumFrom       =  numericEnumFrom\n    enumFromTo     =  numericEnumFromTo\n    enumFromThen   =  numericEnumFromThen\n    enumFromThenTo =  numericEnumFromThenTo\n\n------------------------------------------------------------------------\n-- Printing floating point\n------------------------------------------------------------------------\n\n-- | Show a signed 'RealFloat' value to full precision\n-- using standard decimal notation for arguments whose absolute value lies\n-- between @0.1@ and @9,999,999@, and scientific notation otherwise.\nshowFloat :: (RealFloat a) => a -> ShowS\nshowFloat x  =  showString (formatRealFloat FFGeneric Nothing x)\n\n-- These are the format types.  This type is not exported.\n\ndata FFFormat = FFExponent | FFFixed | FFGeneric\n\n-- This is just a compatibility stub, as the \"alt\" argument formerly\n-- didn't exist.\nformatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String\nformatRealFloat fmt decs x = formatRealFloatAlt fmt decs False x\n\nformatRealFloatAlt :: (RealFloat a) => FFFormat -> Maybe Int -> Bool -> a\n                 -> String\nformatRealFloatAlt fmt decs alt x\n   | isNaN x                   = \"NaN\"\n   | isInfinite x              = if x < 0 then \"-Infinity\" else \"Infinity\"\n   | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x))\n   | otherwise                 = doFmt fmt (floatToDigits (toInteger base) x)\n where\n  base = 10\n\n  doFmt format (is, e) =\n    let ds = map intToDigit is in\n    case format of\n     FFGeneric ->\n      doFmt (if e < 0 || e > 7 then FFExponent else FFFixed)\n            (is,e)\n     FFExponent ->\n      case decs of\n       Nothing ->\n        let show_e' = show (e-1) in\n        case ds of\n          \"0\"     -> \"0.0e0\"\n          [d]     -> d : \".0e\" ++ show_e'\n          (d:ds') -> d : '.' : ds' ++ \"e\" ++ show_e'\n          []      -> errorWithoutStackTrace \"formatRealFloat/doFmt/FFExponent: []\"\n       Just d | d <= 0 ->\n        -- handle this case specifically since we need to omit the\n        -- decimal point as well (#15115).\n        -- Note that this handles negative precisions as well for consistency\n        -- (see #15509).\n        case is of\n          [0] -> \"0e0\"\n          _ ->\n           let\n             (ei,is') = roundTo base 1 is\n             n:_ = map intToDigit (if ei > 0 then init is' else is')\n           in n : 'e' : show (e-1+ei)\n       Just dec ->\n        let dec' = max dec 1 in\n        case is of\n         [0] -> '0' :'.' : take dec' (repeat '0') ++ \"e0\"\n         _ ->\n          let\n           (ei,is') = roundTo base (dec'+1) is\n           (d:ds') = map intToDigit (if ei > 0 then init is' else is')\n          in\n          d:'.':ds' ++ 'e':show (e-1+ei)\n     FFFixed ->\n      let\n       mk0 ls = case ls of { \"\" -> \"0\" ; _ -> ls}\n      in\n      case decs of\n       Nothing\n          | e <= 0    -> \"0.\" ++ replicate (-e) '0' ++ ds\n          | otherwise ->\n             let\n                f 0 s    rs  = mk0 (reverse s) ++ '.':mk0 rs\n                f n s    \"\"  = f (n-1) ('0':s) \"\"\n                f n s (r:rs) = f (n-1) (r:s) rs\n             in\n                f e \"\" ds\n       Just dec ->\n        let dec' = max dec 0 in\n        if e >= 0 then\n         let\n          (ei,is') = roundTo base (dec' + e) is\n          (ls,rs)  = splitAt (e+ei) (map intToDigit is')\n         in\n         mk0 ls ++ (if null rs && not alt then \"\" else '.':rs)\n        else\n         let\n          (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is)\n          d:ds' = map intToDigit (if ei > 0 then is' else 0:is')\n         in\n         d : (if null ds' && not alt then \"\" else '.':ds')\n\n\nroundTo :: Int -> Int -> [Int] -> (Int,[Int])\nroundTo base d is =\n  case f d True is of\n    x@(0,_) -> x\n    (1,xs)  -> (1, 1:xs)\n    _       -> errorWithoutStackTrace \"roundTo: bad Value\"\n where\n  b2 = base `quot` 2\n\n  f n _ []     = (0, replicate n 0)\n  f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, [])   -- Round to even when at exactly half the base\n               | otherwise = (if x >= b2 then 1 else 0, [])\n  f n _ (i:xs)\n     | i' == base = (1,0:ds)\n     | otherwise  = (0,i':ds)\n      where\n       (c,ds) = f (n-1) (even i) xs\n       i'     = c + i\n\n-- Based on \"Printing Floating-Point Numbers Quickly and Accurately\"\n-- by R.G. Burger and R.K. Dybvig in PLDI 96.\n-- This version uses a much slower logarithm estimator. It should be improved.\n\n-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,\n-- and returns a list of digits and an exponent.\n-- In particular, if @x>=0@, and\n--\n-- > floatToDigits base x = ([d1,d2,...,dn], e)\n--\n-- then\n--\n--      (1) @n >= 1@\n--\n--      (2) @x = 0.d1d2...dn * (base**e)@\n--\n--      (3) @0 <= di <= base-1@\n\nfloatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)\nfloatToDigits _ 0 = ([0], 0)\nfloatToDigits base x =\n let\n  (f0, e0) = decodeFloat x\n  (minExp0, _) = floatRange x\n  p = floatDigits x\n  b = floatRadix x\n  minExp = minExp0 - p -- the real minimum exponent\n  -- Haskell requires that f be adjusted so denormalized numbers\n  -- will have an impossibly low exponent.  Adjust for this.\n  (f, e) =\n   let n = minExp - e0 in\n   if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)\n  (r, s, mUp, mDn) =\n   if e >= 0 then\n    let be = expt b e in\n    if f == expt b (p-1) then\n      (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig\n    else\n      (f*be*2, 2, be, be)\n   else\n    if e > minExp && f == expt b (p-1) then\n      (f*b*2, expt b (-e+1)*2, b, 1)\n    else\n      (f*2, expt b (-e)*2, 1, 1)\n  k :: Int\n  k =\n   let\n    k0 :: Int\n    k0 =\n     if b == 2 && base == 10 then\n        -- logBase 10 2 is very slightly larger than 8651/28738\n        -- (about 5.3558e-10), so if log x >= 0, the approximation\n        -- k1 is too small, hence we add one and need one fixup step less.\n        -- If log x < 0, the approximation errs rather on the high side.\n        -- That is usually more than compensated for by ignoring the\n        -- fractional part of logBase 2 x, but when x is a power of 1/2\n        -- or slightly larger and the exponent is a multiple of the\n        -- denominator of the rational approximation to logBase 10 2,\n        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,\n        -- we get a leading zero-digit we don't want.\n        -- With the approximation 3/10, this happened for\n        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.\n        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x\n        -- for IEEE-ish floating point types with exponent fields\n        -- <= 17 bits and mantissae of several thousand bits, earlier\n        -- convergents to logBase 10 2 would fail for long double.\n        -- Using quot instead of div is a little faster and requires\n        -- fewer fixup steps for negative lx.\n        let lx = p - 1 + e0\n            k1 = (lx * 8651) `quot` 28738\n        in if lx >= 0 then k1 + 1 else k1\n     else\n        -- f :: Integer, log :: Float -> Float,\n        --               ceiling :: Float -> Int\n        ceiling ((log (fromInteger (f+1) :: Float) +\n                 fromIntegral e * log (fromInteger b)) /\n                   log (fromInteger base))\n--WAS:            fromInt e * log (fromInteger b))\n\n    fixup n =\n      if n >= 0 then\n        if r + mUp <= expt base n * s then n else fixup (n+1)\n      else\n        if expt base (-n) * (r + mUp) <= s then n else fixup (n+1)\n   in\n   fixup k0\n\n  gen ds rn sN mUpN mDnN =\n   let\n    (dn, rn') = (rn * base) `quotRem` sN\n    mUpN' = mUpN * base\n    mDnN' = mDnN * base\n   in\n   case (rn' < mDnN', rn' + mUpN' > sN) of\n    (True,  False) -> dn : ds\n    (False, True)  -> dn+1 : ds\n    (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds\n    (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'\n\n  rds =\n   if k >= 0 then\n      gen [] r (s * expt base k) mUp mDn\n   else\n     let bk = expt base (-k) in\n     gen [] (r * bk) s (mUp * bk) (mDn * bk)\n in\n (map fromIntegral (reverse rds), k)\n\n------------------------------------------------------------------------\n-- Converting from a Rational to a RealFloa\n------------------------------------------------------------------------\n\n{-\n[In response to a request for documentation of how fromRational works,\nJoe Fasel writes:] A quite reasonable request!  This code was added to\nthe Prelude just before the 1.2 release, when Lennart, working with an\nearly version of hbi, noticed that (read . show) was not the identity\nfor floating-point numbers.  (There was a one-bit error about half the\ntime.)  The original version of the conversion function was in fact\nsimply a floating-point divide, as you suggest above. The new version\nis, I grant you, somewhat denser.\n\nUnfortunately, Joe's code doesn't work!  Here's an example:\n\nmain = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) \"\\n\")\n\nThis program prints\n        0.0000000000000000\ninstead of\n        1.8217369128763981e-300\n\nHere's Joe's code:\n\n\\begin{pseudocode}\nfromRat :: (RealFloat a) => Rational -> a\nfromRat x = x'\n        where x' = f e\n\n--              If the exponent of the nearest floating-point number to x\n--              is e, then the significand is the integer nearest xb^(-e),\n--              where b is the floating-point radix.  We start with a good\n--              guess for e, and if it is correct, the exponent of the\n--              floating-point number we construct will again be e.  If\n--              not, one more iteration is needed.\n\n              f e   = if e' == e then y else f e'\n                      where y      = encodeFloat (round (x * (1 % b)^^e)) e\n                            (_,e') = decodeFloat y\n              b     = floatRadix x'\n\n--              We obtain a trial exponent by doing a floating-point\n--              division of x's numerator by its denominator.  The\n--              result of this division may not itself be the ultimate\n--              result, because of an accumulation of three rounding\n--              errors.\n\n              (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'\n                                        / fromInteger (denominator x))\n\\end{pseudocode}\n\nNow, here's Lennart's code (which works):\n-}\n\n-- | Converts a 'Rational' value into any type in class 'RealFloat'.\n{-# RULES\n\"fromRat/Float\"     fromRat = (fromRational :: Rational -> Float)\n\"fromRat/Double\"    fromRat = (fromRational :: Rational -> Double)\n  #-}\n\n{-# NOINLINE [1] fromRat #-}\nfromRat :: (RealFloat a) => Rational -> a\n\n-- Deal with special cases first, delegating the real work to fromRat'\nfromRat (n :% 0) | n > 0     =  1/0        -- +Infinity\n                 | n < 0     = -1/0        -- -Infinity\n                 | otherwise =  0/0        -- NaN\n\nfromRat (n :% d) | n > 0     = fromRat' (n :% d)\n                 | n < 0     = - fromRat' ((-n) :% d)\n                 | otherwise = encodeFloat 0 0             -- Zero\n\n-- Conversion process:\n-- Scale the rational number by the RealFloat base until\n-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).\n-- Then round the rational to an Integer and encode it with the exponent\n-- that we got from the scaling.\n-- To speed up the scaling process we compute the log2 of the number to get\n-- a first guess of the exponent.\n\nfromRat' :: (RealFloat a) => Rational -> a\n-- Invariant: argument is strictly positive\nfromRat' x = r\n  where b = floatRadix r\n        p = floatDigits r\n        (minExp0, _) = floatRange r\n        minExp = minExp0 - p            -- the real minimum exponent\n        xMax   = toRational (expt b p)\n        p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp\n        -- if x = n/d and ln = integerLogBase b n, ld = integerLogBase b d,\n        -- then b^(ln-ld-1) < x < b^(ln-ld+1)\n        f = if p0 < 0 then 1 :% expt b (-p0) else expt b p0 :% 1\n        x0 = x / f\n        -- if ln - ld >= minExp0, then b^(p-1) < x0 < b^(p+1), so there's at most\n        -- one scaling step needed, otherwise, x0 < b^p and no scaling is needed\n        (x', p') = if x0 >= xMax then (x0 / toRational b, p0+1) else (x0, p0)\n        r = encodeFloat (round x') p'\n\n-- Exponentiation with a cache for the most common numbers.\nminExpt, maxExpt :: Int\nminExpt = 0\nmaxExpt = 1100\n\nexpt :: Integer -> Int -> Integer\nexpt base n =\n    if base == 2 && n >= minExpt && n <= maxExpt then\n        expts!n\n    else\n        if base == 10 && n <= maxExpt10 then\n            expts10!n\n        else\n            base^n\n\nexpts :: Array Int Integer\nexpts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]\n\nmaxExpt10 :: Int\nmaxExpt10 = 324\n\nexpts10 :: Array Int Integer\nexpts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]\n\n-- Compute the (floor of the) log of i in base b.\n-- Simplest way would be just divide i by b until it's smaller then b, but that would\n-- be very slow!  We are just slightly more clever, except for base 2, where\n-- we take advantage of the representation of Integers.\n-- The general case could be improved by a lookup table for\n-- approximating the result by integerLog2 i / integerLog2 b.\nintegerLogBase :: Integer -> Integer -> Int\nintegerLogBase b i\n   | i < b     = 0\n   | b == 2    = I# (integerLog2# i)\n   | otherwise = I# (integerLogBase# b i)\n\n{-\nUnfortunately, the old conversion code was awfully slow due to\na) a slow integer logarithm\nb) repeated calculation of gcd's\n\nFor the case of Rational's coming from a Float or Double via toRational,\nwe can exploit the fact that the denominator is a power of two, which for\nthese brings a huge speedup since we need only shift and add instead\nof division.\n\nThe below is an adaption of fromRat' for the conversion to\nFloat or Double exploiting the known floatRadix and avoiding\ndivisions as much as possible.\n-}\n\n{-# SPECIALISE fromRat'' :: Int -> Int -> Integer -> Integer -> Float,\n                            Int -> Int -> Integer -> Integer -> Double #-}\nfromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a\n-- Invariant: n and d strictly positive\nfromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =\n    case integerLog2IsPowerOf2# d of\n      (# ld#, pw# #)\n        | isTrue# (pw# ==# 0#) ->\n          case integerLog2# n of\n            ln# | isTrue# (ln# >=# (ld# +# me# -# 1#)) ->\n                  -- this means n/d >= 2^(minEx-1), i.e. we are guaranteed to get\n                  -- a normalised number, round to mantDigs bits\n                  if isTrue# (ln# <# md#)\n                    then encodeFloat n (I# (negateInt# ld#))\n                    else let n'  = n `shiftR` (I# (ln# +# 1# -# md#))\n                             n'' = case roundingMode# n (ln# -# md#) of\n                                    0# -> n'\n                                    2# -> n' + 1\n                                    _  -> case fromInteger n' .&. (1 :: Int) of\n                                            0 -> n'\n                                            _ -> n' + 1\n                         in encodeFloat n'' (I# (ln# -# ld# +# 1# -# md#))\n                | otherwise ->\n                  -- n/d < 2^(minEx-1), a denorm or rounded to 2^(minEx-1)\n                  -- the exponent for encoding is always minEx-mantDigs\n                  -- so we must shift right by (minEx-mantDigs) - (-ld)\n                  case ld# +# (me# -# md#) of\n                    ld'# | isTrue# (ld'# <=# 0#) -> -- we would shift left, so we don't shift\n                           encodeFloat n (I# ((me# -# md#) -# ld'#))\n                         | isTrue# (ld'# <=# ln#) ->\n                           let n' = n `shiftR` (I# ld'#)\n                           in case roundingMode# n (ld'# -# 1#) of\n                                0# -> encodeFloat n' (minEx - mantDigs)\n                                1# -> if fromInteger n' .&. (1 :: Int) == 0\n                                        then encodeFloat n' (minEx-mantDigs)\n                                        else encodeFloat (n' + 1) (minEx-mantDigs)\n                                _  -> encodeFloat (n' + 1) (minEx-mantDigs)\n                         | isTrue# (ld'# ># (ln# +# 1#)) -> encodeFloat 0 0 -- result of shift < 0.5\n                         | otherwise ->  -- first bit of n shifted to 0.5 place\n                           case integerLog2IsPowerOf2# n of\n                            (# _, 0# #) -> encodeFloat 0 0  -- round to even\n                            (# _, _ #)  -> encodeFloat 1 (minEx - mantDigs)\n        | otherwise ->\n          let ln = I# (integerLog2# n)\n              ld = I# ld#\n              -- 2^(ln-ld-1) < n/d < 2^(ln-ld+1)\n              p0 = max minEx (ln - ld)\n              (n', d')\n                | p0 < mantDigs = (n `shiftL` (mantDigs - p0), d)\n                | p0 == mantDigs = (n, d)\n                | otherwise     = (n, d `shiftL` (p0 - mantDigs))\n              -- if ln-ld < minEx, then n'/d' < 2^mantDigs, else\n              -- 2^(mantDigs-1) < n'/d' < 2^(mantDigs+1) and we\n              -- may need one scaling step\n              scale p a b\n                | (b `shiftL` mantDigs) <= a = (p+1, a, b `shiftL` 1)\n                | otherwise = (p, a, b)\n              (p', n'', d'') = scale (p0-mantDigs) n' d'\n              -- n''/d'' < 2^mantDigs and p' == minEx-mantDigs or n''/d'' >= 2^(mantDigs-1)\n              rdq = case n'' `quotRem` d'' of\n                     (q,r) -> case compare (r `shiftL` 1) d'' of\n                                LT -> q\n                                EQ -> if fromInteger q .&. (1 :: Int) == 0\n                                        then q else q+1\n                                GT -> q+1\n          in  encodeFloat rdq p'\n\n------------------------------------------------------------------------\n-- Floating point numeric primops\n------------------------------------------------------------------------\n\n-- Definitions of the boxed PrimOps; these will be\n-- used in the case of partial applications, etc.\n\nplusFloat, minusFloat, timesFloat, divideFloat :: Float -> Float -> Float\nplusFloat   (F# x) (F# y) = F# (plusFloat# x y)\nminusFloat  (F# x) (F# y) = F# (minusFloat# x y)\ntimesFloat  (F# x) (F# y) = F# (timesFloat# x y)\ndivideFloat (F# x) (F# y) = F# (divideFloat# x y)\n\nnegateFloat :: Float -> Float\nnegateFloat (F# x)        = F# (negateFloat# x)\n\ngtFloat, geFloat, ltFloat, leFloat :: Float -> Float -> Bool\ngtFloat     (F# x) (F# y) = isTrue# (gtFloat# x y)\ngeFloat     (F# x) (F# y) = isTrue# (geFloat# x y)\nltFloat     (F# x) (F# y) = isTrue# (ltFloat# x y)\nleFloat     (F# x) (F# y) = isTrue# (leFloat# x y)\n\nexpFloat, logFloat, sqrtFloat, fabsFloat :: Float -> Float\nsinFloat, cosFloat, tanFloat  :: Float -> Float\nasinFloat, acosFloat, atanFloat  :: Float -> Float\nsinhFloat, coshFloat, tanhFloat  :: Float -> Float\nasinhFloat, acoshFloat, atanhFloat  :: Float -> Float\nexpFloat    (F# x) = F# (expFloat# x)\nlogFloat    (F# x) = F# (logFloat# x)\nsqrtFloat   (F# x) = F# (sqrtFloat# x)\nfabsFloat   (F# x) = F# (fabsFloat# x)\nsinFloat    (F# x) = F# (sinFloat# x)\ncosFloat    (F# x) = F# (cosFloat# x)\ntanFloat    (F# x) = F# (tanFloat# x)\nasinFloat   (F# x) = F# (asinFloat# x)\nacosFloat   (F# x) = F# (acosFloat# x)\natanFloat   (F# x) = F# (atanFloat# x)\nsinhFloat   (F# x) = F# (sinhFloat# x)\ncoshFloat   (F# x) = F# (coshFloat# x)\ntanhFloat   (F# x) = F# (tanhFloat# x)\nasinhFloat  (F# x) = F# (asinhFloat# x)\nacoshFloat  (F# x) = F# (acoshFloat# x)\natanhFloat  (F# x) = F# (atanhFloat# x)\n\npowerFloat :: Float -> Float -> Float\npowerFloat  (F# x) (F# y) = F# (powerFloat# x y)\n\n-- definitions of the boxed PrimOps; these will be\n-- used in the case of partial applications, etc.\n\nplusDouble, minusDouble, timesDouble, divideDouble :: Double -> Double -> Double\nplusDouble   (D# x) (D# y) = D# (x +## y)\nminusDouble  (D# x) (D# y) = D# (x -## y)\ntimesDouble  (D# x) (D# y) = D# (x *## y)\ndivideDouble (D# x) (D# y) = D# (x /## y)\n\nnegateDouble :: Double -> Double\nnegateDouble (D# x)        = D# (negateDouble# x)\n\ngtDouble, geDouble, leDouble, ltDouble :: Double -> Double -> Bool\ngtDouble    (D# x) (D# y) = isTrue# (x >##  y)\ngeDouble    (D# x) (D# y) = isTrue# (x >=## y)\nltDouble    (D# x) (D# y) = isTrue# (x <##  y)\nleDouble    (D# x) (D# y) = isTrue# (x <=## y)\n\ndouble2Float :: Double -> Float\ndouble2Float (D# x) = F# (double2Float# x)\n\nfloat2Double :: Float -> Double\nfloat2Double (F# x) = D# (float2Double# x)\n\nexpDouble, logDouble, sqrtDouble, fabsDouble :: Double -> Double\nsinDouble, cosDouble, tanDouble  :: Double -> Double\nasinDouble, acosDouble, atanDouble  :: Double -> Double\nsinhDouble, coshDouble, tanhDouble  :: Double -> Double\nasinhDouble, acoshDouble, atanhDouble  :: Double -> Double\nexpDouble    (D# x) = D# (expDouble# x)\nlogDouble    (D# x) = D# (logDouble# x)\nsqrtDouble   (D# x) = D# (sqrtDouble# x)\nfabsDouble   (D# x) = D# (fabsDouble# x)\nsinDouble    (D# x) = D# (sinDouble# x)\ncosDouble    (D# x) = D# (cosDouble# x)\ntanDouble    (D# x) = D# (tanDouble# x)\nasinDouble   (D# x) = D# (asinDouble# x)\nacosDouble   (D# x) = D# (acosDouble# x)\natanDouble   (D# x) = D# (atanDouble# x)\nsinhDouble   (D# x) = D# (sinhDouble# x)\ncoshDouble   (D# x) = D# (coshDouble# x)\ntanhDouble   (D# x) = D# (tanhDouble# x)\nasinhDouble  (D# x) = D# (asinhDouble# x)\nacoshDouble  (D# x) = D# (acoshDouble# x)\natanhDouble  (D# x) = D# (atanhDouble# x)\n\npowerDouble :: Double -> Double -> Double\npowerDouble  (D# x) (D# y) = D# (x **## y)\n\nforeign import ccall unsafe \"isFloatNaN\" isFloatNaN :: Float -> Int\nforeign import ccall unsafe \"isFloatInfinite\" isFloatInfinite :: Float -> Int\nforeign import ccall unsafe \"isFloatDenormalized\" isFloatDenormalized :: Float -> Int\nforeign import ccall unsafe \"isFloatNegativeZero\" isFloatNegativeZero :: Float -> Int\nforeign import ccall unsafe \"isFloatFinite\" isFloatFinite :: Float -> Int\n\nforeign import ccall unsafe \"isDoubleNaN\" isDoubleNaN :: Double -> Int\nforeign import ccall unsafe \"isDoubleInfinite\" isDoubleInfinite :: Double -> Int\nforeign import ccall unsafe \"isDoubleDenormalized\" isDoubleDenormalized :: Double -> Int\nforeign import ccall unsafe \"isDoubleNegativeZero\" isDoubleNegativeZero :: Double -> Int\nforeign import ccall unsafe \"isDoubleFinite\" isDoubleFinite :: Double -> Int\n\n\n------------------------------------------------------------------------\n-- libm imports for extended floating\n------------------------------------------------------------------------\nforeign import capi unsafe \"math.h log1p\" log1pDouble :: Double -> Double\nforeign import capi unsafe \"math.h expm1\" expm1Double :: Double -> Double\nforeign import capi unsafe \"math.h log1pf\" log1pFloat :: Float -> Float\nforeign import capi unsafe \"math.h expm1f\" expm1Float :: Float -> Float\n\n\n------------------------------------------------------------------------\n-- Coercion rules\n------------------------------------------------------------------------\n\nword2Double :: Word -> Double\nword2Double (W# w) = D# (word2Double# w)\n\nword2Float :: Word -> Float\nword2Float (W# w) = F# (word2Float# w)\n\n{-# RULES\n\"fromIntegral/Int->Float\"   fromIntegral = int2Float\n\"fromIntegral/Int->Double\"  fromIntegral = int2Double\n\"fromIntegral/Word->Float\"  fromIntegral = word2Float\n\"fromIntegral/Word->Double\" fromIntegral = word2Double\n\"realToFrac/Float->Float\"   realToFrac   = id :: Float -> Float\n\"realToFrac/Float->Double\"  realToFrac   = float2Double\n\"realToFrac/Double->Float\"  realToFrac   = double2Float\n\"realToFrac/Double->Double\" realToFrac   = id :: Double -> Double\n\"realToFrac/Int->Double\"    realToFrac   = int2Double   -- See Note [realToFrac int-to-float]\n\"realToFrac/Int->Float\"     realToFrac   = int2Float    --      ..ditto\n    #-}\n\n{-\nNote [realToFrac int-to-float]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nDon found that the RULES for realToFrac/Int->Double and simliarly\nFloat made a huge difference to some stream-fusion programs.  Here's\nan example\n\n      import Data.Array.Vector\n\n      n = 40000000\n\n      main = do\n            let c = replicateU n (2::Double)\n                a = mapU realToFrac (enumFromToU 0 (n-1) ) :: UArr Double\n            print (sumU (zipWithU (*) c a))\n\nWithout the RULE we get this loop body:\n\n      case $wtoRational sc_sY4 of ww_aM7 { (# ww1_aM9, ww2_aMa #) ->\n      case $wfromRat ww1_aM9 ww2_aMa of tpl_X1P { D# ipv_sW3 ->\n      Main.$s$wfold\n        (+# sc_sY4 1)\n        (+# wild_X1i 1)\n        (+## sc2_sY6 (*## 2.0 ipv_sW3))\n\nAnd with the rule:\n\n     Main.$s$wfold\n        (+# sc_sXT 1)\n        (+# wild_X1h 1)\n        (+## sc2_sXV (*## 2.0 (int2Double# sc_sXT)))\n\nThe running time of the program goes from 120 seconds to 0.198 seconds\nwith the native backend, and 0.143 seconds with the C backend.\n\nA few more details in Trac #2251, and the patch message\n\"Add RULES for realToFrac from Int\".\n-}\n\n-- Utils\n\nshowSignedFloat :: (RealFloat a)\n  => (a -> ShowS)       -- ^ a function that can show unsigned values\n  -> Int                -- ^ the precedence of the enclosing context\n  -> a                  -- ^ the value to show\n  -> ShowS\nshowSignedFloat showPos p x\n   | x < 0 || isNegativeZero x\n       = showParen (p > 6) (showChar '-' . showPos (-x))\n   | otherwise = showPos x\n\n{-\nWe need to prevent over/underflow of the exponent in encodeFloat when\ncalled from scaleFloat, hence we clamp the scaling parameter.\nWe must have a large enough range to cover the maximum difference of\nexponents returned by decodeFloat.\n-}\nclamp :: Int -> Int -> Int\nclamp bd k = max (-bd) (min bd k)\n\n\n{-\nNote [Casting from integral to floating point types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nTo implement something like `reinterpret_cast` from C++ to go from a\nfloating-point type to an integral type one might niavely think that the\nfollowing should work:\n\n      cast :: Float -> Word32\n      cast (F# f#) = W32# (unsafeCoerce# f#)\n\nUnfortunately that is not the case, because all the `unsafeCoerce#` does is tell\nthe compiler that the types have changed. When one does the above cast and\ntries to operate on the resulting `Word32` the code generator will generate code\nthat performs an integer/word operation on a floating-point register, which\nresults in a compile error.\n\nThe correct way of implementing `reinterpret_cast` to implement a primpop, but\nthat requires a unique implementation for all supported archetectures. The next\nbest solution is to write the value from the source register to memory and then\nread it from memory into the destination register and the best way to do that\nis using CMM.\n-}\n\n-- | @'castWord32ToFloat' w@ does a bit-for-bit copy from an integral value\n-- to a floating-point value.\n--\n-- @since 4.10.0.0\n\n{-# INLINE castWord32ToFloat #-}\ncastWord32ToFloat :: Word32 -> Float\ncastWord32ToFloat (W32# w#) = F# (stgWord32ToFloat w#)\n\nforeign import prim \"stg_word32ToFloatzh\"\n    stgWord32ToFloat :: Word# -> Float#\n\n\n-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value\n-- to an integral value.\n--\n-- @since 4.10.0.0\n\n{-# INLINE castFloatToWord32 #-}\ncastFloatToWord32 :: Float -> Word32\ncastFloatToWord32 (F# f#) = W32# (stgFloatToWord32 f#)\n\nforeign import prim \"stg_floatToWord32zh\"\n    stgFloatToWord32 :: Float# -> Word#\n\n\n\n-- | @'castWord64ToDouble' w@ does a bit-for-bit copy from an integral value\n-- to a floating-point value.\n--\n-- @since 4.10.0.0\n\n{-# INLINE castWord64ToDouble #-}\ncastWord64ToDouble :: Word64 -> Double\ncastWord64ToDouble (W64# w) = D# (stgWord64ToDouble w)\n\nforeign import prim \"stg_word64ToDoublezh\"\n#if WORD_SIZE_IN_BITS == 64\n    stgWord64ToDouble :: Word# -> Double#\n#else\n    stgWord64ToDouble :: Word64# -> Double#\n#endif\n\n\n-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value\n-- to an integral value.\n--\n-- @since 4.10.0.0\n\n{-# INLINE castDoubleToWord64 #-}\ncastDoubleToWord64 :: Double -> Word64\ncastDoubleToWord64 (D# d#) = W64# (stgDoubleToWord64 d#)\n\nforeign import prim \"stg_doubleToWord64zh\"\n#if WORD_SIZE_IN_BITS == 64\n    stgDoubleToWord64 :: Double# -> Word#\n#else\n    stgDoubleToWord64 :: Double# -> Word64#\n#endif\n", "num_lines": 1405}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE BangPatterns #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Foreign\n-- Copyright   :  (c) The University of Glasgow, 2008-2011\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Foreign marshalling support for CStrings with configurable encodings\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Foreign (\n    -- * C strings with a configurable encoding\n\n    -- conversion of C strings into Haskell strings\n    --\n    peekCString,\n    peekCStringLen,\n\n    -- conversion of Haskell strings into C strings\n    --\n    newCString,\n    newCStringLen,\n\n    -- conversion of Haskell strings into C strings using temporary storage\n    --\n    withCString,\n    withCStringLen,\n    withCStringsLen,\n\n    charIsRepresentable,\n  ) where\n\nimport Foreign.Marshal.Array\nimport Foreign.C.Types\nimport Foreign.Ptr\nimport Foreign.Storable\n\nimport Data.Word\n\n-- Imports for the locale-encoding version of marshallers\n\nimport Data.Tuple (fst)\n\nimport GHC.Show ( show )\n\nimport Foreign.Marshal.Alloc\nimport Foreign.ForeignPtr\n\nimport GHC.Debug\nimport GHC.List\nimport GHC.Num\nimport GHC.Base\n\nimport GHC.IO\nimport GHC.IO.Exception\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Types\n\n\nc_DEBUG_DUMP :: Bool\nc_DEBUG_DUMP = False\n\nputDebugMsg :: String -> IO ()\nputDebugMsg | c_DEBUG_DUMP = debugLn\n            | otherwise    = const (return ())\n\n\n-- These definitions are identical to those in Foreign.C.String, but copied in here to avoid a cycle:\ntype CString    = Ptr CChar\ntype CStringLen = (Ptr CChar, Int)\n\n-- exported functions\n-- ------------------\n\n-- | Marshal a NUL terminated C string into a Haskell string.\n--\npeekCString    :: TextEncoding -> CString -> IO String\npeekCString enc cp = do\n    sz <- lengthArray0 nUL cp\n    peekEncodedCString enc (cp, sz * cCharSize)\n\n-- | Marshal a C string with explicit length into a Haskell string.\n--\npeekCStringLen           :: TextEncoding -> CStringLen -> IO String\npeekCStringLen = peekEncodedCString\n\n-- | Marshal a Haskell string into a NUL terminated C string.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * new storage is allocated for the C string and must be\n--   explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCString :: TextEncoding -> String -> IO CString\nnewCString enc = liftM fst . newEncodedCString enc True\n\n-- | Marshal a Haskell string into a C string (ie, character array) with\n-- explicit length information.\n--\n-- * new storage is allocated for the C string and must be\n--   explicitly freed using 'Foreign.Marshal.Alloc.free' or\n--   'Foreign.Marshal.Alloc.finalizerFree'.\n--\nnewCStringLen     :: TextEncoding -> String -> IO CStringLen\nnewCStringLen enc = newEncodedCString enc False\n\n-- | Marshal a Haskell string into a NUL terminated C string using temporary\n-- storage.\n--\n-- * the Haskell string may /not/ contain any NUL characters\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCString :: TextEncoding -> String -> (CString -> IO a) -> IO a\nwithCString enc s act = withEncodedCString enc True s $ \\(cp, _sz) -> act cp\n\n-- | Marshal a Haskell string into a C string (ie, character array)\n-- in temporary storage, with explicit length information.\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCStringLen         :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a\nwithCStringLen enc = withEncodedCString enc False\n\n-- | Marshal a list of Haskell strings into an array of NUL terminated C strings\n-- using temporary storage.\n--\n-- * the Haskell strings may /not/ contain any NUL characters\n--\n-- * the memory is freed when the subcomputation terminates (either\n--   normally or via an exception), so the pointer to the temporary\n--   storage must /not/ be used after this.\n--\nwithCStringsLen :: TextEncoding\n                -> [String]\n                -> (Int -> Ptr CString -> IO a)\n                -> IO a\nwithCStringsLen enc strs f = go [] strs\n  where\n  go cs (s:ss) = withCString enc s $ \\c -> go (c:cs) ss\n  go cs [] = withArrayLen (reverse cs) f\n\n-- | Determines whether a character can be accurately encoded in a\n-- 'Foreign.C.String.CString'.\n--\n-- Pretty much anyone who uses this function is in a state of sin because\n-- whether or not a character is encodable will, in general, depend on the\n-- context in which it occurs.\ncharIsRepresentable :: TextEncoding -> Char -> IO Bool\n-- We force enc explicitly because `catch` is lazy in its\n-- first argument. We would probably like to force c as well,\n-- but unfortunately worker/wrapper produces very bad code for\n-- that.\n--\n-- TODO If this function is performance-critical, it would probably\n-- pay to use a single-character specialization of withCString. That\n-- would allow worker/wrapper to actually eliminate Char boxes, and\n-- would also get rid of the completely unnecessary cons allocation.\ncharIsRepresentable !enc c =\n  withCString enc [c]\n              (\\cstr -> do str <- peekCString enc cstr\n                           case str of\n                             [ch] | ch == c -> pure True\n                             _ -> pure False)\n    `catch`\n       \\(_ :: IOException) -> pure False\n\n-- auxiliary definitions\n-- ----------------------\n\n-- C's end of string character\nnUL :: CChar\nnUL  = 0\n\n-- Size of a CChar in bytes\ncCharSize :: Int\ncCharSize = sizeOf (undefined :: CChar)\n\n\n{-# INLINE peekEncodedCString #-}\npeekEncodedCString :: TextEncoding -- ^ Encoding of CString\n                   -> CStringLen\n                   -> IO String    -- ^ String in Haskell terms\npeekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes)\n  = bracket mk_decoder close $ \\decoder -> do\n      let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII\n      from0 <- fmap (\\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p)\n      to <- newCharBuffer chunk_size WriteBuffer\n\n      let go !iteration from = do\n            (why, from', to') <- encode decoder from to\n            if isEmptyBuffer from'\n             then\n              -- No input remaining: @why@ will be InputUnderflow, but we don't care\n              withBuffer to' $ peekArray (bufferElems to')\n             else do\n              -- Input remaining: what went wrong?\n              putDebugMsg (\"peekEncodedCString: \" ++ show iteration ++ \" \" ++ show why)\n              (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because\n                                            InputUnderflow  -> recover decoder from' to' -- they indicate malformed/truncated input\n                                            OutputUnderflow -> return (from', to')       -- We will have more space next time round\n              putDebugMsg (\"peekEncodedCString: from \" ++ summaryBuffer from ++ \" \" ++ summaryBuffer from' ++ \" \" ++ summaryBuffer from'')\n              putDebugMsg (\"peekEncodedCString: to \" ++ summaryBuffer to ++ \" \" ++ summaryBuffer to' ++ \" \" ++ summaryBuffer to'')\n              to_chars <- withBuffer to'' $ peekArray (bufferElems to'')\n              fmap (to_chars++) $ go (iteration + 1) from''\n\n      go (0 :: Int) from0\n\n{-# INLINE withEncodedCString #-}\nwithEncodedCString :: TextEncoding         -- ^ Encoding of CString to create\n                   -> Bool                 -- ^ Null-terminate?\n                   -> String               -- ^ String to encode\n                   -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory\n                   -> IO a\nwithEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act\n  = bracket mk_encoder close $ \\encoder -> withArrayLen s $ \\sz p -> do\n      from <- fmap (\\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p\n\n      let go !iteration to_sz_bytes = do\n           putDebugMsg (\"withEncodedCString: \" ++ show iteration)\n           allocaBytes to_sz_bytes $ \\to_p -> do\n            mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes act\n            case mb_res of\n              Nothing  -> go (iteration + 1) (to_sz_bytes * 2)\n              Just res -> return res\n\n      -- If the input string is ASCII, this value will ensure we only allocate once\n      go (0 :: Int) (cCharSize * (sz + 1))\n\n{-# INLINE newEncodedCString #-}\nnewEncodedCString :: TextEncoding  -- ^ Encoding of CString to create\n                  -> Bool          -- ^ Null-terminate?\n                  -> String        -- ^ String to encode\n                  -> IO CStringLen\nnewEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s\n  = bracket mk_encoder close $ \\encoder -> withArrayLen s $ \\sz p -> do\n      from <- fmap (\\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p\n\n      let go !iteration to_p to_sz_bytes = do\n           putDebugMsg (\"newEncodedCString: \" ++ show iteration)\n           mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes return\n           case mb_res of\n             Nothing  -> do\n                 let to_sz_bytes' = to_sz_bytes * 2\n                 to_p' <- reallocBytes to_p to_sz_bytes'\n                 go (iteration + 1) to_p' to_sz_bytes'\n             Just res -> return res\n\n      -- If the input string is ASCII, this value will ensure we only allocate once\n      let to_sz_bytes = cCharSize * (sz + 1)\n      to_p <- mallocBytes to_sz_bytes\n      go (0 :: Int) to_p to_sz_bytes\n\n\ntryFillBufferAndCall :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int\n                     -> (CStringLen -> IO a) -> IO (Maybe a)\ntryFillBufferAndCall encoder null_terminate from0 to_p to_sz_bytes act = do\n    to_fp <- newForeignPtr_ to_p\n    go (0 :: Int) (from0, emptyBuffer to_fp to_sz_bytes WriteBuffer)\n  where\n    go !iteration (from, to) = do\n      (why, from', to') <- encode encoder from to\n      putDebugMsg (\"tryFillBufferAndCall: \" ++ show iteration ++ \" \" ++ show why ++ \" \" ++ summaryBuffer from ++ \" \" ++ summaryBuffer from')\n      if isEmptyBuffer from'\n       then if null_terminate && bufferAvailable to' == 0\n             then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer\n             else do\n               -- Awesome, we had enough buffer\n               let bytes = bufferElems to'\n               withBuffer to' $ \\to_ptr -> do\n                   when null_terminate $ pokeElemOff to_ptr (bufR to') 0\n                   fmap Just $ act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes*\n       else case why of -- We didn't consume all of the input\n              InputUnderflow  -> recover encoder from' to' >>= go (iteration + 1) -- These conditions are equally bad\n              InvalidSequence -> recover encoder from' to' >>= go (iteration + 1) -- since the input was truncated/invalid\n              OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more\n\n", "num_lines": 292}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude\n           , BangPatterns\n           , MagicHash\n           , UnboxedTuples\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.ForeignPtr\n-- Copyright   :  (c) The University of Glasgow, 1992-2003\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- GHC's implementation of the 'ForeignPtr' data type.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.ForeignPtr\n  (\n        ForeignPtr(..),\n        ForeignPtrContents(..),\n        FinalizerPtr,\n        FinalizerEnvPtr,\n        newForeignPtr_,\n        mallocForeignPtr,\n        mallocPlainForeignPtr,\n        mallocForeignPtrBytes,\n        mallocPlainForeignPtrBytes,\n        mallocForeignPtrAlignedBytes,\n        mallocPlainForeignPtrAlignedBytes,\n        addForeignPtrFinalizer,\n        addForeignPtrFinalizerEnv,\n        touchForeignPtr,\n        unsafeForeignPtrToPtr,\n        castForeignPtr,\n        plusForeignPtr,\n        newConcForeignPtr,\n        addForeignPtrConcFinalizer,\n        finalizeForeignPtr\n  ) where\n\nimport Foreign.Storable\nimport Data.Foldable    ( sequence_ )\n\nimport GHC.Show\nimport GHC.Base\nimport GHC.IORef\nimport GHC.STRef        ( STRef(..) )\nimport GHC.Ptr          ( Ptr(..), FunPtr(..) )\n\n-- |The type 'ForeignPtr' represents references to objects that are\n-- maintained in a foreign language, i.e., that are not part of the\n-- data structures usually managed by the Haskell storage manager.\n-- The essential difference between 'ForeignPtr's and vanilla memory\n-- references of type @Ptr a@ is that the former may be associated\n-- with /finalizers/. A finalizer is a routine that is invoked when\n-- the Haskell storage manager detects that - within the Haskell heap\n-- and stack - there are no more references left that are pointing to\n-- the 'ForeignPtr'.  Typically, the finalizer will, then, invoke\n-- routines in the foreign language that free the resources bound by\n-- the foreign object.\n--\n-- The 'ForeignPtr' is parameterised in the same way as 'Ptr'.  The\n-- type argument of 'ForeignPtr' should normally be an instance of\n-- class 'Storable'.\n--\ndata ForeignPtr a = ForeignPtr Addr# ForeignPtrContents\n        -- The Addr# in the ForeignPtr object is intentionally stored\n        -- separately from the finalizer. The primary aim of the\n        -- representation is to make withForeignPtr efficient; in fact,\n        -- withForeignPtr should be just as efficient as unpacking a\n        -- Ptr, and multiple withForeignPtrs can share an unpacked\n        -- ForeignPtr. As a secondary benefit, this representation\n        -- allows pointers to subregions within the same overall block\n        -- to share the same finalizer (see 'plusForeignPtr'). Note\n        -- that touchForeignPtr only has to touch the ForeignPtrContents\n        -- object, because that ensures that whatever the finalizer is\n        -- attached to is kept alive.\n\ndata Finalizers\n  = NoFinalizers\n  | CFinalizers (Weak# ())\n  | HaskellFinalizers [IO ()]\n\ndata ForeignPtrContents\n  = PlainForeignPtr !(IORef Finalizers)\n  | MallocPtr      (MutableByteArray# RealWorld) !(IORef Finalizers)\n  | PlainPtr       (MutableByteArray# RealWorld)\n\n-- | @since 2.01\ninstance Eq (ForeignPtr a) where\n    p == q  =  unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q\n\n-- | @since 2.01\ninstance Ord (ForeignPtr a) where\n    compare p q  =  compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q)\n\n-- | @since 2.01\ninstance Show (ForeignPtr a) where\n    showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f)\n\n\n-- |A finalizer is represented as a pointer to a foreign function that, at\n-- finalisation time, gets as an argument a plain pointer variant of the\n-- foreign pointer that the finalizer is associated with.\n--\n-- Note that the foreign function /must/ use the @ccall@ calling convention.\n--\ntype FinalizerPtr a        = FunPtr (Ptr a -> IO ())\ntype FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> IO ())\n\nnewConcForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)\n--\n-- ^Turns a plain memory reference into a foreign object by\n-- associating a finalizer - given by the monadic operation - with the\n-- reference.  The storage manager will start the finalizer, in a\n-- separate thread, some time after the last reference to the\n-- @ForeignPtr@ is dropped.  There is no guarantee of promptness, and\n-- in fact there is no guarantee that the finalizer will eventually\n-- run at all.\n--\n-- Note that references from a finalizer do not necessarily prevent\n-- another object from being finalized.  If A's finalizer refers to B\n-- (perhaps using 'touchForeignPtr', then the only guarantee is that\n-- B's finalizer will never be started before A's.  If both A and B\n-- are unreachable, then both finalizers will start together.  See\n-- 'touchForeignPtr' for more on finalizer ordering.\n--\nnewConcForeignPtr p finalizer\n  = do fObj <- newForeignPtr_ p\n       addForeignPtrConcFinalizer fObj finalizer\n       return fObj\n\nmallocForeignPtr :: Storable a => IO (ForeignPtr a)\n-- ^ Allocate some memory and return a 'ForeignPtr' to it.  The memory\n-- will be released automatically when the 'ForeignPtr' is discarded.\n--\n-- 'mallocForeignPtr' is equivalent to\n--\n-- >    do { p <- malloc; newForeignPtr finalizerFree p }\n--\n-- although it may be implemented differently internally: you may not\n-- assume that the memory returned by 'mallocForeignPtr' has been\n-- allocated with 'Foreign.Marshal.Alloc.malloc'.\n--\n-- GHC notes: 'mallocForeignPtr' has a heavily optimised\n-- implementation in GHC.  It uses pinned memory in the garbage\n-- collected heap, so the 'ForeignPtr' does not require a finalizer to\n-- free the memory.  Use of 'mallocForeignPtr' and associated\n-- functions is strongly recommended in preference to\n-- 'Foreign.ForeignPtr.newForeignPtr' with a finalizer.\n--\nmallocForeignPtr = doMalloc undefined\n  where doMalloc :: Storable b => b -> IO (ForeignPtr b)\n        doMalloc a\n          | I# size < 0 = errorWithoutStackTrace \"mallocForeignPtr: size must be >= 0\"\n          | otherwise = do\n          r <- newIORef NoFinalizers\n          IO $ \\s ->\n            case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->\n             (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))\n                               (MallocPtr mbarr# r) #)\n            }\n            where !(I# size)  = sizeOf a\n                  !(I# align) = alignment a\n\n-- | This function is similar to 'mallocForeignPtr', except that the\n-- size of the memory required is given explicitly as a number of bytes.\nmallocForeignPtrBytes :: Int -> IO (ForeignPtr a)\nmallocForeignPtrBytes size | size < 0 =\n  errorWithoutStackTrace \"mallocForeignPtrBytes: size must be >= 0\"\nmallocForeignPtrBytes (I# size) = do\n  r <- newIORef NoFinalizers\n  IO $ \\s ->\n     case newPinnedByteArray# size s      of { (# s', mbarr# #) ->\n       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))\n                         (MallocPtr mbarr# r) #)\n     }\n\n-- | This function is similar to 'mallocForeignPtrBytes', except that the\n-- size and alignment of the memory required is given explicitly as numbers of\n-- bytes.\nmallocForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)\nmallocForeignPtrAlignedBytes size _align | size < 0 =\n  errorWithoutStackTrace \"mallocForeignPtrAlignedBytes: size must be >= 0\"\nmallocForeignPtrAlignedBytes (I# size) (I# align) = do\n  r <- newIORef NoFinalizers\n  IO $ \\s ->\n     case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->\n       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))\n                         (MallocPtr mbarr# r) #)\n     }\n\n-- | Allocate some memory and return a 'ForeignPtr' to it.  The memory\n-- will be released automatically when the 'ForeignPtr' is discarded.\n--\n-- GHC notes: 'mallocPlainForeignPtr' has a heavily optimised\n-- implementation in GHC.  It uses pinned memory in the garbage\n-- collected heap, as for mallocForeignPtr. Unlike mallocForeignPtr, a\n-- ForeignPtr created with mallocPlainForeignPtr carries no finalizers.\n-- It is not possible to add a finalizer to a ForeignPtr created with\n-- mallocPlainForeignPtr. This is useful for ForeignPtrs that will live\n-- only inside Haskell (such as those created for packed strings).\n-- Attempts to add a finalizer to a ForeignPtr created this way, or to\n-- finalize such a pointer, will throw an exception.\n--\nmallocPlainForeignPtr :: Storable a => IO (ForeignPtr a)\nmallocPlainForeignPtr = doMalloc undefined\n  where doMalloc :: Storable b => b -> IO (ForeignPtr b)\n        doMalloc a\n          | I# size < 0 = errorWithoutStackTrace \"mallocForeignPtr: size must be >= 0\"\n          | otherwise = IO $ \\s ->\n            case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->\n             (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))\n                               (PlainPtr mbarr#) #)\n            }\n            where !(I# size)  = sizeOf a\n                  !(I# align) = alignment a\n\n-- | This function is similar to 'mallocForeignPtrBytes', except that\n-- the internally an optimised ForeignPtr representation with no\n-- finalizer is used. Attempts to add a finalizer will cause an\n-- exception to be thrown.\nmallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a)\nmallocPlainForeignPtrBytes size | size < 0 =\n  errorWithoutStackTrace \"mallocPlainForeignPtrBytes: size must be >= 0\"\nmallocPlainForeignPtrBytes (I# size) = IO $ \\s ->\n    case newPinnedByteArray# size s      of { (# s', mbarr# #) ->\n       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))\n                         (PlainPtr mbarr#) #)\n     }\n\n-- | This function is similar to 'mallocForeignPtrAlignedBytes', except that\n-- the internally an optimised ForeignPtr representation with no\n-- finalizer is used. Attempts to add a finalizer will cause an\n-- exception to be thrown.\nmallocPlainForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)\nmallocPlainForeignPtrAlignedBytes size _align | size < 0 =\n  errorWithoutStackTrace \"mallocPlainForeignPtrAlignedBytes: size must be >= 0\"\nmallocPlainForeignPtrAlignedBytes (I# size) (I# align) = IO $ \\s ->\n    case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->\n       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))\n                         (PlainPtr mbarr#) #)\n     }\n\naddForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()\n-- ^ This function adds a finalizer to the given foreign object.  The\n-- finalizer will run /before/ all other finalizers for the same\n-- object which have already been registered.\naddForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of\n  PlainForeignPtr r -> insertCFinalizer r fp 0# nullAddr# p ()\n  MallocPtr     _ r -> insertCFinalizer r fp 0# nullAddr# p c\n  _ -> errorWithoutStackTrace \"GHC.ForeignPtr: attempt to add a finalizer to a plain pointer\"\n\n-- Note [MallocPtr finalizers] (#10904)\n--\n-- When we have C finalizers for a MallocPtr, the memory is\n-- heap-resident and would normally be recovered by the GC before the\n-- finalizers run.  To prevent the memory from being reused too early,\n-- we attach the MallocPtr constructor to the \"value\" field of the\n-- weak pointer when we call mkWeak# in ensureCFinalizerWeak below.\n-- The GC will keep this field alive until the finalizers have run.\n\naddForeignPtrFinalizerEnv ::\n  FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()\n-- ^ Like 'addForeignPtrFinalizer' but the finalizer is passed an additional\n-- environment parameter.\naddForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of\n  PlainForeignPtr r -> insertCFinalizer r fp 1# ep p ()\n  MallocPtr     _ r -> insertCFinalizer r fp 1# ep p c\n  _ -> errorWithoutStackTrace \"GHC.ForeignPtr: attempt to add a finalizer to a plain pointer\"\n\naddForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()\n-- ^This function adds a finalizer to the given @ForeignPtr@.  The\n-- finalizer will run /before/ all other finalizers for the same\n-- object which have already been registered.\n--\n-- This is a variant of @addForeignPtrFinalizer@, where the finalizer\n-- is an arbitrary @IO@ action.  When it is invoked, the finalizer\n-- will run in a new thread.\n--\n-- NB. Be very careful with these finalizers.  One common trap is that\n-- if a finalizer references another finalized value, it does not\n-- prevent that value from being finalized.  In particular, 'System.IO.Handle's\n-- are finalized objects, so a finalizer should not refer to a\n-- 'System.IO.Handle' (including 'System.IO.stdout', 'System.IO.stdin', or\n-- 'System.IO.stderr').\n--\naddForeignPtrConcFinalizer (ForeignPtr _ c) finalizer =\n  addForeignPtrConcFinalizer_ c finalizer\n\naddForeignPtrConcFinalizer_ :: ForeignPtrContents -> IO () -> IO ()\naddForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do\n  noFinalizers <- insertHaskellFinalizer r finalizer\n  if noFinalizers\n     then IO $ \\s ->\n              case r of { IORef (STRef r#) ->\n              case mkWeak# r# () (unIO $ foreignPtrFinalizer r) s of {\n                (# s1, _ #) -> (# s1, () #) }}\n     else return ()\naddForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do\n  noFinalizers <- insertHaskellFinalizer r finalizer\n  if noFinalizers\n     then  IO $ \\s ->\n               case mkWeak# fo () finalizer' s of\n                  (# s1, _ #) -> (# s1, () #)\n     else return ()\n  where\n    finalizer' :: State# RealWorld -> (# State# RealWorld, () #)\n    finalizer' = unIO (foreignPtrFinalizer r >> touch f)\n\naddForeignPtrConcFinalizer_ _ _ =\n  errorWithoutStackTrace \"GHC.ForeignPtr: attempt to add a finalizer to plain pointer\"\n\ninsertHaskellFinalizer :: IORef Finalizers -> IO () -> IO Bool\ninsertHaskellFinalizer r f = do\n  !wasEmpty <- atomicModifyIORefP r $ \\finalizers -> case finalizers of\n      NoFinalizers -> (HaskellFinalizers [f], True)\n      HaskellFinalizers fs -> (HaskellFinalizers (f:fs), False)\n      _ -> noMixingError\n  return wasEmpty\n\n-- | A box around Weak#, private to this module.\ndata MyWeak = MyWeak (Weak# ())\n\ninsertCFinalizer ::\n  IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO ()\ninsertCFinalizer r fp flag ep p val = do\n  MyWeak w <- ensureCFinalizerWeak r val\n  IO $ \\s -> case addCFinalizerToWeak# fp p flag ep w s of\n      (# s1, 1# #) -> (# s1, () #)\n\n      -- Failed to add the finalizer because some other thread\n      -- has finalized w by calling foreignPtrFinalizer. We retry now.\n      -- This won't be an infinite loop because that thread must have\n      -- replaced the content of r before calling finalizeWeak#.\n      (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p val) s1\n\nensureCFinalizerWeak :: IORef Finalizers -> value -> IO MyWeak\nensureCFinalizerWeak ref@(IORef (STRef r#)) value = do\n  fin <- readIORef ref\n  case fin of\n      CFinalizers weak -> return (MyWeak weak)\n      HaskellFinalizers{} -> noMixingError\n      NoFinalizers -> IO $ \\s ->\n          case mkWeakNoFinalizer# r# (unsafeCoerce# value) s of { (# s1, w #) ->\n             -- See Note [MallocPtr finalizers] (#10904)\n          case atomicModifyMutVar2# r# (update w) s1 of\n              { (# s2, _, (_, (weak, needKill )) #) ->\n          if needKill\n            then case finalizeWeak# w s2 of { (# s3, _, _ #) ->\n              (# s3, weak #) }\n            else (# s2, weak #) }}\n  where\n      update _ fin@(CFinalizers w) = (fin, (MyWeak w, True))\n      update w NoFinalizers = (CFinalizers w, (MyWeak w, False))\n      update _ _ = noMixingError\n\nnoMixingError :: a\nnoMixingError = errorWithoutStackTrace $\n   \"GHC.ForeignPtr: attempt to mix Haskell and C finalizers \" ++\n   \"in the same ForeignPtr\"\n\nforeignPtrFinalizer :: IORef Finalizers -> IO ()\nforeignPtrFinalizer r = do\n  fs <- atomicSwapIORef r NoFinalizers\n             -- atomic, see #7170\n  case fs of\n    NoFinalizers -> return ()\n    CFinalizers w -> IO $ \\s -> case finalizeWeak# w s of\n        (# s1, 1#, f #) -> f s1\n        (# s1, _, _ #) -> (# s1, () #)\n    HaskellFinalizers actions -> sequence_ actions\n\nnewForeignPtr_ :: Ptr a -> IO (ForeignPtr a)\n-- ^Turns a plain memory reference into a foreign pointer that may be\n-- associated with finalizers by using 'addForeignPtrFinalizer'.\nnewForeignPtr_ (Ptr obj) =  do\n  r <- newIORef NoFinalizers\n  return (ForeignPtr obj (PlainForeignPtr r))\n\ntouchForeignPtr :: ForeignPtr a -> IO ()\n-- ^This function ensures that the foreign object in\n-- question is alive at the given place in the sequence of IO\n-- actions. In particular 'Foreign.ForeignPtr.withForeignPtr'\n-- does a 'touchForeignPtr' after it\n-- executes the user action.\n--\n-- Note that this function should not be used to express dependencies\n-- between finalizers on 'ForeignPtr's.  For example, if the finalizer\n-- for a 'ForeignPtr' @F1@ calls 'touchForeignPtr' on a second\n-- 'ForeignPtr' @F2@, then the only guarantee is that the finalizer\n-- for @F2@ is never started before the finalizer for @F1@.  They\n-- might be started together if for example both @F1@ and @F2@ are\n-- otherwise unreachable, and in that case the scheduler might end up\n-- running the finalizer for @F2@ first.\n--\n-- In general, it is not recommended to use finalizers on separate\n-- objects with ordering constraints between them.  To express the\n-- ordering robustly requires explicit synchronisation using @MVar@s\n-- between the finalizers, but even then the runtime sometimes runs\n-- multiple finalizers sequentially in a single thread (for\n-- performance reasons), so synchronisation between finalizers could\n-- result in artificial deadlock.  Another alternative is to use\n-- explicit reference counting.\n--\ntouchForeignPtr (ForeignPtr _ r) = touch r\n\ntouch :: ForeignPtrContents -> IO ()\ntouch r = IO $ \\s -> case touch# r s of s' -> (# s', () #)\n\nunsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a\n-- ^This function extracts the pointer component of a foreign\n-- pointer.  This is a potentially dangerous operations, as if the\n-- argument to 'unsafeForeignPtrToPtr' is the last usage\n-- occurrence of the given foreign pointer, then its finalizer(s) will\n-- be run, which potentially invalidates the plain pointer just\n-- obtained.  Hence, 'touchForeignPtr' must be used\n-- wherever it has to be guaranteed that the pointer lives on - i.e.,\n-- has another usage occurrence.\n--\n-- To avoid subtle coding errors, hand written marshalling code\n-- should preferably use 'Foreign.ForeignPtr.withForeignPtr' rather\n-- than combinations of 'unsafeForeignPtrToPtr' and\n-- 'touchForeignPtr'.  However, the latter routines\n-- are occasionally preferred in tool generated marshalling code.\nunsafeForeignPtrToPtr (ForeignPtr fo _) = Ptr fo\n\ncastForeignPtr :: ForeignPtr a -> ForeignPtr b\n-- ^This function casts a 'ForeignPtr'\n-- parameterised by one type into another type.\ncastForeignPtr = coerce\n\nplusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b\n-- ^Advances the given address by the given offset in bytes.\n--\n-- The new 'ForeignPtr' shares the finalizer of the original,\n-- equivalent from a finalization standpoint to just creating another\n-- reference to the original. That is, the finalizer will not be\n-- called before the new 'ForeignPtr' is unreachable, nor will it be\n-- called an additional time due to this call, and the finalizer will\n-- be called with the same address that it would have had this call\n-- not happened, *not* the new address.\n--\n-- @since 4.10.0.0\nplusForeignPtr (ForeignPtr addr c) (I# d) = ForeignPtr (plusAddr# addr d) c\n\n-- | Causes the finalizers associated with a foreign pointer to be run\n-- immediately.\nfinalizeForeignPtr :: ForeignPtr a -> IO ()\nfinalizeForeignPtr (ForeignPtr _ (PlainPtr _)) = return () -- no effect\nfinalizeForeignPtr (ForeignPtr _ foreignPtr) = foreignPtrFinalizer refFinalizers\n        where\n                refFinalizers = case foreignPtr of\n                        (PlainForeignPtr ref) -> ref\n                        (MallocPtr     _ ref) -> ref\n                        PlainPtr _            ->\n                            errorWithoutStackTrace \"finalizeForeignPtr PlainPtr\"\n\n", "num_lines": 466}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP                        #-}\n{-# LANGUAGE DataKinds                  #-}\n{-# LANGUAGE DeriveFunctor              #-}\n{-# LANGUAGE DeriveGeneric              #-}\n{-# LANGUAGE EmptyDataDeriving          #-}\n{-# LANGUAGE FlexibleContexts           #-}\n{-# LANGUAGE FlexibleInstances          #-}\n{-# LANGUAGE GADTs                      #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE KindSignatures             #-}\n{-# LANGUAGE MagicHash                  #-}\n{-# LANGUAGE NoImplicitPrelude          #-}\n{-# LANGUAGE PolyKinds                  #-}\n{-# LANGUAGE ScopedTypeVariables        #-}\n{-# LANGUAGE StandaloneDeriving         #-}\n{-# LANGUAGE Trustworthy                #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE TypeOperators              #-}\n{-# LANGUAGE TypeSynonymInstances       #-}\n{-# LANGUAGE UndecidableInstances       #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Generics\n-- Copyright   :  (c) Universiteit Utrecht 2010-2011, University of Oxford 2012-2014\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- @since 4.6.0.0\n--\n-- If you're using @GHC.Generics@, you should consider using the\n-- <http://hackage.haskell.org/package/generic-deriving> package, which\n-- contains many useful generic functions.\n\nmodule GHC.Generics  (\n-- * Introduction\n--\n-- |\n--\n-- Datatype-generic functions are based on the idea of converting values of\n-- a datatype @T@ into corresponding values of a (nearly) isomorphic type @'Rep' T@.\n-- The type @'Rep' T@ is\n-- built from a limited set of type constructors, all provided by this module. A\n-- datatype-generic function is then an overloaded function with instances\n-- for most of these type constructors, together with a wrapper that performs\n-- the mapping between @T@ and @'Rep' T@. By using this technique, we merely need\n-- a few generic instances in order to implement functionality that works for any\n-- representable type.\n--\n-- Representable types are collected in the 'Generic' class, which defines the\n-- associated type 'Rep' as well as conversion functions 'from' and 'to'.\n-- Typically, you will not define 'Generic' instances by hand, but have the compiler\n-- derive them for you.\n\n-- ** Representing datatypes\n--\n-- |\n--\n-- The key to defining your own datatype-generic functions is to understand how to\n-- represent datatypes using the given set of type constructors.\n--\n-- Let us look at an example first:\n--\n-- @\n-- data Tree a = Leaf a | Node (Tree a) (Tree a)\n--   deriving 'Generic'\n-- @\n--\n-- The above declaration (which requires the language pragma @DeriveGeneric@)\n-- causes the following representation to be generated:\n--\n-- @\n-- instance 'Generic' (Tree a) where\n--   type 'Rep' (Tree a) =\n--     'D1' ('MetaData \\\"Tree\\\" \\\"Main\\\" \\\"package-name\\\" 'False)\n--       ('C1' ('MetaCons \\\"Leaf\\\" 'PrefixI 'False)\n--          ('S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--                 ('Rec0' a))\n--        ':+:'\n--        'C1' ('MetaCons \\\"Node\\\" 'PrefixI 'False)\n--          ('S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--                ('Rec0' (Tree a))\n--           ':*:'\n--           'S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--                ('Rec0' (Tree a))))\n--   ...\n-- @\n--\n-- /Hint:/ You can obtain information about the code being generated from GHC by passing\n-- the @-ddump-deriv@ flag. In GHCi, you can expand a type family such as 'Rep' using\n-- the @:kind!@ command.\n--\n-- This is a lot of information! However, most of it is actually merely meta-information\n-- that makes names of datatypes and constructors and more available on the type level.\n--\n-- Here is a reduced representation for @Tree@ with nearly all meta-information removed,\n-- for now keeping only the most essential aspects:\n--\n-- @\n-- instance 'Generic' (Tree a) where\n--   type 'Rep' (Tree a) =\n--     'Rec0' a\n--     ':+:'\n--     ('Rec0' (Tree a) ':*:' 'Rec0' (Tree a))\n-- @\n--\n-- The @Tree@ datatype has two constructors. The representation of individual constructors\n-- is combined using the binary type constructor ':+:'.\n--\n-- The first constructor consists of a single field, which is the parameter @a@. This is\n-- represented as @'Rec0' a@.\n--\n-- The second constructor consists of two fields. Each is a recursive field of type @Tree a@,\n-- represented as @'Rec0' (Tree a)@. Representations of individual fields are combined using\n-- the binary type constructor ':*:'.\n--\n-- Now let us explain the additional tags being used in the complete representation:\n--\n--    * The @'S1' ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness\n--      'DecidedLazy)@ tag indicates several things. The @'Nothing@ indicates\n--      that there is no record field selector associated with this field of\n--      the constructor (if there were, it would have been marked @'Just\n--      \\\"recordName\\\"@ instead). The other types contain meta-information on\n--      the field's strictness:\n--\n--      * There is no @{\\-\\# UNPACK \\#-\\}@ or @{\\-\\# NOUNPACK \\#-\\}@ annotation\n--        in the source, so it is tagged with @'NoSourceUnpackedness@.\n--\n--      * There is no strictness (@!@) or laziness (@~@) annotation in the\n--        source, so it is tagged with @'NoSourceStrictness@.\n--\n--      * The compiler infers that the field is lazy, so it is tagged with\n--        @'DecidedLazy@. Bear in mind that what the compiler decides may be\n--        quite different from what is written in the source. See\n--        'DecidedStrictness' for a more detailed explanation.\n--\n--      The @'MetaSel@ type is also an instance of the type class 'Selector',\n--      which can be used to obtain information about the field at the value\n--      level.\n--\n--    * The @'C1' ('MetaCons \\\"Leaf\\\" 'PrefixI 'False)@ and\n--      @'C1' ('MetaCons \\\"Node\\\" 'PrefixI 'False)@ invocations indicate that the enclosed part is\n--      the representation of the first and second constructor of datatype @Tree@, respectively.\n--      Here, the meta-information regarding constructor names, fixity and whether\n--      it has named fields or not is encoded at the type level. The @'MetaCons@\n--      type is also an instance of the type class 'Constructor'. This type class can be used\n--      to obtain information about the constructor at the value level.\n--\n--    * The @'D1' ('MetaData \\\"Tree\\\" \\\"Main\\\" \\\"package-name\\\" 'False)@ tag\n--      indicates that the enclosed part is the representation of the\n--      datatype @Tree@. Again, the meta-information is encoded at the type level.\n--      The @'MetaData@ type is an instance of class 'Datatype', which\n--      can be used to obtain the name of a datatype, the module it has been\n--      defined in, the package it is located under, and whether it has been\n--      defined using @data@ or @newtype@ at the value level.\n\n-- ** Derived and fundamental representation types\n--\n-- |\n--\n-- There are many datatype-generic functions that do not distinguish between positions that\n-- are parameters or positions that are recursive calls. There are also many datatype-generic\n-- functions that do not care about the names of datatypes and constructors at all. To keep\n-- the number of cases to consider in generic functions in such a situation to a minimum,\n-- it turns out that many of the type constructors introduced above are actually synonyms,\n-- defining them to be variants of a smaller set of constructors.\n\n-- *** Individual fields of constructors: 'K1'\n--\n-- |\n--\n-- The type constructor 'Rec0' is a variant of 'K1':\n--\n-- @\n-- type 'Rec0' = 'K1' 'R'\n-- @\n--\n-- Here, 'R' is a type-level proxy that does not have any associated values.\n--\n-- There used to be another variant of 'K1' (namely @Par0@), but it has since\n-- been deprecated.\n\n-- *** Meta information: 'M1'\n--\n-- |\n--\n-- The type constructors 'S1', 'C1' and 'D1' are all variants of 'M1':\n--\n-- @\n-- type 'S1' = 'M1' 'S'\n-- type 'C1' = 'M1' 'C'\n-- type 'D1' = 'M1' 'D'\n-- @\n--\n-- The types 'S', 'C' and 'D' are once again type-level proxies, just used to create\n-- several variants of 'M1'.\n\n-- *** Additional generic representation type constructors\n--\n-- |\n--\n-- Next to 'K1', 'M1', ':+:' and ':*:' there are a few more type constructors that occur\n-- in the representations of other datatypes.\n\n-- **** Empty datatypes: 'V1'\n--\n-- |\n--\n-- For empty datatypes, 'V1' is used as a representation. For example,\n--\n-- @\n-- data Empty deriving 'Generic'\n-- @\n--\n-- yields\n--\n-- @\n-- instance 'Generic' Empty where\n--   type 'Rep' Empty =\n--     'D1' ('MetaData \\\"Empty\\\" \\\"Main\\\" \\\"package-name\\\" 'False) 'V1'\n-- @\n\n-- **** Constructors without fields: 'U1'\n--\n-- |\n--\n-- If a constructor has no arguments, then 'U1' is used as its representation. For example\n-- the representation of 'Bool' is\n--\n-- @\n-- instance 'Generic' Bool where\n--   type 'Rep' Bool =\n--     'D1' ('MetaData \\\"Bool\\\" \\\"Data.Bool\\\" \\\"package-name\\\" 'False)\n--       ('C1' ('MetaCons \\\"False\\\" 'PrefixI 'False) 'U1' ':+:' 'C1' ('MetaCons \\\"True\\\" 'PrefixI 'False) 'U1')\n-- @\n\n-- *** Representation of types with many constructors or many fields\n--\n-- |\n--\n-- As ':+:' and ':*:' are just binary operators, one might ask what happens if the\n-- datatype has more than two constructors, or a constructor with more than two\n-- fields. The answer is simple: the operators are used several times, to combine\n-- all the constructors and fields as needed. However, users /should not rely on\n-- a specific nesting strategy/ for ':+:' and ':*:' being used. The compiler is\n-- free to choose any nesting it prefers. (In practice, the current implementation\n-- tries to produce a more-or-less balanced nesting, so that the traversal of\n-- the structure of the datatype from the root to a particular component can be\n-- performed in logarithmic rather than linear time.)\n\n-- ** Defining datatype-generic functions\n--\n-- |\n--\n-- A datatype-generic function comprises two parts:\n--\n--    1. /Generic instances/ for the function, implementing it for most of the representation\n--       type constructors introduced above.\n--\n--    2. A /wrapper/ that for any datatype that is in `Generic`, performs the conversion\n--       between the original value and its `Rep`-based representation and then invokes the\n--       generic instances.\n--\n-- As an example, let us look at a function @encode@ that produces a naive, but lossless\n-- bit encoding of values of various datatypes. So we are aiming to define a function\n--\n-- @\n-- encode :: 'Generic' a => a -> [Bool]\n-- @\n--\n-- where we use 'Bool' as our datatype for bits.\n--\n-- For part 1, we define a class @Encode'@. Perhaps surprisingly, this class is parameterized\n-- over a type constructor @f@ of kind @* -> *@. This is a technicality: all the representation\n-- type constructors operate with kind @* -> *@ as base kind. But the type argument is never\n-- being used. This may be changed at some point in the future. The class has a single method,\n-- and we use the type we want our final function to have, but we replace the occurrences of\n-- the generic type argument @a@ with @f p@ (where the @p@ is any argument; it will not be used).\n--\n-- > class Encode' f where\n-- >   encode' :: f p -> [Bool]\n--\n-- With the goal in mind to make @encode@ work on @Tree@ and other datatypes, we now define\n-- instances for the representation type constructors 'V1', 'U1', ':+:', ':*:', 'K1', and 'M1'.\n\n-- *** Definition of the generic representation types\n--\n-- |\n--\n-- In order to be able to do this, we need to know the actual definitions of these types:\n--\n-- @\n-- data    'V1'        p                       -- lifted version of Empty\n-- data    'U1'        p = 'U1'                  -- lifted version of ()\n-- data    (':+:') f g p = 'L1' (f p) | 'R1' (g p) -- lifted version of 'Either'\n-- data    (':*:') f g p = (f p) ':*:' (g p)     -- lifted version of (,)\n-- newtype 'K1'    i c p = 'K1' { 'unK1' :: c }    -- a container for a c\n-- newtype 'M1'  i t f p = 'M1' { 'unM1' :: f p }  -- a wrapper\n-- @\n--\n-- So, 'U1' is just the unit type, ':+:' is just a binary choice like 'Either',\n-- ':*:' is a binary pair like the pair constructor @(,)@, and 'K1' is a value\n-- of a specific type @c@, and 'M1' wraps a value of the generic type argument,\n-- which in the lifted world is an @f p@ (where we do not care about @p@).\n\n-- *** Generic instances\n--\n-- |\n--\n-- The instance for 'V1' is slightly awkward (but also rarely used):\n--\n-- @\n-- instance Encode' 'V1' where\n--   encode' x = undefined\n-- @\n--\n-- There are no values of type @V1 p@ to pass (except undefined), so this is\n-- actually impossible. One can ask why it is useful to define an instance for\n-- 'V1' at all in this case? Well, an empty type can be used as an argument to\n-- a non-empty type, and you might still want to encode the resulting type.\n-- As a somewhat contrived example, consider @[Empty]@, which is not an empty\n-- type, but contains just the empty list. The 'V1' instance ensures that we\n-- can call the generic function on such types.\n--\n-- There is exactly one value of type 'U1', so encoding it requires no\n-- knowledge, and we can use zero bits:\n--\n-- @\n-- instance Encode' 'U1' where\n--   encode' 'U1' = []\n-- @\n--\n-- In the case for ':+:', we produce 'False' or 'True' depending on whether\n-- the constructor of the value provided is located on the left or on the right:\n--\n-- @\n-- instance (Encode' f, Encode' g) => Encode' (f ':+:' g) where\n--   encode' ('L1' x) = False : encode' x\n--   encode' ('R1' x) = True  : encode' x\n-- @\n--\n-- (Note that this encoding strategy may not be reliable across different\n-- versions of GHC. Recall that the compiler is free to choose any nesting\n-- of ':+:' it chooses, so if GHC chooses @(a ':+:' b) ':+:' c@, then the\n-- encoding for @a@ would be @[False, False]@, @b@ would be @[False, True]@,\n-- and @c@ would be @[True]@. However, if GHC chooses @a ':+:' (b ':+:' c)@,\n-- then the encoding for @a@ would be @[False]@, @b@ would be @[True, False]@,\n-- and @c@ would be @[True, True]@.)\n--\n-- In the case for ':*:', we append the encodings of the two subcomponents:\n--\n-- @\n-- instance (Encode' f, Encode' g) => Encode' (f ':*:' g) where\n--   encode' (x ':*:' y) = encode' x ++ encode' y\n-- @\n--\n-- The case for 'K1' is rather interesting. Here, we call the final function\n-- @encode@ that we yet have to define, recursively. We will use another type\n-- class @Encode@ for that function:\n--\n-- @\n-- instance (Encode c) => Encode' ('K1' i c) where\n--   encode' ('K1' x) = encode x\n-- @\n--\n-- Note how we can define a uniform instance for 'M1', because we completely\n-- disregard all meta-information:\n--\n-- @\n-- instance (Encode' f) => Encode' ('M1' i t f) where\n--   encode' ('M1' x) = encode' x\n-- @\n--\n-- Unlike in 'K1', the instance for 'M1' refers to @encode'@, not @encode@.\n\n-- *** The wrapper and generic default\n--\n-- |\n--\n-- We now define class @Encode@ for the actual @encode@ function:\n--\n-- @\n-- class Encode a where\n--   encode :: a -> [Bool]\n--   default encode :: (Generic a, Encode' (Rep a)) => a -> [Bool]\n--   encode x = encode' ('from' x)\n-- @\n--\n-- The incoming @x@ is converted using 'from', then we dispatch to the\n-- generic instances using @encode'@. We use this as a default definition\n-- for @encode@. We need the @default encode@ signature because ordinary\n-- Haskell default methods must not introduce additional class constraints,\n-- but our generic default does.\n--\n-- Defining a particular instance is now as simple as saying\n--\n-- @\n-- instance (Encode a) => Encode (Tree a)\n-- @\n--\n#if 0\n-- /TODO:/ Add usage example?\n--\n#endif\n-- The generic default is being used. In the future, it will hopefully be\n-- possible to use @deriving Encode@ as well, but GHC does not yet support\n-- that syntax for this situation.\n--\n-- Having @Encode@ as a class has the advantage that we can define\n-- non-generic special cases, which is particularly useful for abstract\n-- datatypes that have no structural representation. For example, given\n-- a suitable integer encoding function @encodeInt@, we can define\n--\n-- @\n-- instance Encode Int where\n--   encode = encodeInt\n-- @\n\n-- *** Omitting generic instances\n--\n-- |\n--\n-- It is not always required to provide instances for all the generic\n-- representation types, but omitting instances restricts the set of\n-- datatypes the functions will work for:\n--\n--    * If no ':+:' instance is given, the function may still work for\n--      empty datatypes or datatypes that have a single constructor,\n--      but will fail on datatypes with more than one constructor.\n--\n--    * If no ':*:' instance is given, the function may still work for\n--      datatypes where each constructor has just zero or one field,\n--      in particular for enumeration types.\n--\n--    * If no 'K1' instance is given, the function may still work for\n--      enumeration types, where no constructor has any fields.\n--\n--    * If no 'V1' instance is given, the function may still work for\n--      any datatype that is not empty.\n--\n--    * If no 'U1' instance is given, the function may still work for\n--      any datatype where each constructor has at least one field.\n--\n-- An 'M1' instance is always required (but it can just ignore the\n-- meta-information, as is the case for @encode@ above).\n#if 0\n-- *** Using meta-information\n--\n-- |\n--\n-- TODO\n#endif\n-- ** Generic constructor classes\n--\n-- |\n--\n-- Datatype-generic functions as defined above work for a large class\n-- of datatypes, including parameterized datatypes. (We have used @Tree@\n-- as our example above, which is of kind @* -> *@.) However, the\n-- 'Generic' class ranges over types of kind @*@, and therefore, the\n-- resulting generic functions (such as @encode@) must be parameterized\n-- by a generic type argument of kind @*@.\n--\n-- What if we want to define generic classes that range over type\n-- constructors (such as 'Data.Functor.Functor',\n-- 'Data.Traversable.Traversable', or 'Data.Foldable.Foldable')?\n\n-- *** The 'Generic1' class\n--\n-- |\n--\n-- Like 'Generic', there is a class 'Generic1' that defines a\n-- representation 'Rep1' and conversion functions 'from1' and 'to1',\n-- only that 'Generic1' ranges over types of kind @* -> *@. (More generally,\n-- it can range over types of kind @k -> *@, for any kind @k@, if the\n-- @PolyKinds@ extension is enabled. More on this later.)\n-- The 'Generic1' class is also derivable.\n--\n-- The representation 'Rep1' is ever so slightly different from 'Rep'.\n-- Let us look at @Tree@ as an example again:\n--\n-- @\n-- data Tree a = Leaf a | Node (Tree a) (Tree a)\n--   deriving 'Generic1'\n-- @\n--\n-- The above declaration causes the following representation to be generated:\n--\n-- @\n-- instance 'Generic1' Tree where\n--   type 'Rep1' Tree =\n--     'D1' ('MetaData \\\"Tree\\\" \\\"Main\\\" \\\"package-name\\\" 'False)\n--       ('C1' ('MetaCons \\\"Leaf\\\" 'PrefixI 'False)\n--          ('S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--                'Par1')\n--        ':+:'\n--        'C1' ('MetaCons \\\"Node\\\" 'PrefixI 'False)\n--          ('S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--                ('Rec1' Tree)\n--           ':*:'\n--           'S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--                ('Rec1' Tree)))\n--   ...\n-- @\n--\n-- The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well\n-- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we\n-- carry around the dummy type argument for kind-@*@-types, but there are\n-- already enough different names involved without duplicating each of\n-- these.)\n--\n-- What's different is that we now use 'Par1' to refer to the parameter\n-- (and that parameter, which used to be @a@), is not mentioned explicitly\n-- by name anywhere; and we use 'Rec1' to refer to a recursive use of @Tree a@.\n\n-- *** Representation of @* -> *@ types\n--\n-- |\n--\n-- Unlike 'Rec0', the 'Par1' and 'Rec1' type constructors do not\n-- map to 'K1'. They are defined directly, as follows:\n--\n-- @\n-- newtype 'Par1'   p = 'Par1' { 'unPar1' ::   p } -- gives access to parameter p\n-- newtype 'Rec1' f p = 'Rec1' { 'unRec1' :: f p } -- a wrapper\n-- @\n--\n-- In 'Par1', the parameter @p@ is used for the first time, whereas 'Rec1' simply\n-- wraps an application of @f@ to @p@.\n--\n-- Note that 'K1' (in the guise of 'Rec0') can still occur in a 'Rep1' representation,\n-- namely when the datatype has a field that does not mention the parameter.\n--\n-- The declaration\n--\n-- @\n-- data WithInt a = WithInt Int a\n--   deriving 'Generic1'\n-- @\n--\n-- yields\n--\n-- @\n-- instance 'Generic1' WithInt where\n--   type 'Rep1' WithInt =\n--     'D1' ('MetaData \\\"WithInt\\\" \\\"Main\\\" \\\"package-name\\\" 'False)\n--       ('C1' ('MetaCons \\\"WithInt\\\" 'PrefixI 'False)\n--         ('S1' ('MetaSel 'Nothing\n--                         'NoSourceUnpackedness\n--                         'NoSourceStrictness\n--                         'DecidedLazy)\n--               ('Rec0' Int)\n--          ':*:'\n--          'S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--               'Par1'))\n-- @\n--\n-- If the parameter @a@ appears underneath a composition of other type constructors,\n-- then the representation involves composition, too:\n--\n-- @\n-- data Rose a = Fork a [Rose a]\n-- @\n--\n-- yields\n--\n-- @\n-- instance 'Generic1' Rose where\n--   type 'Rep1' Rose =\n--     'D1' ('MetaData \\\"Rose\\\" \\\"Main\\\" \\\"package-name\\\" 'False)\n--       ('C1' ('MetaCons \\\"Fork\\\" 'PrefixI 'False)\n--         ('S1' ('MetaSel 'Nothing\n--                         'NoSourceUnpackedness\n--                         'NoSourceStrictness\n--                         'DecidedLazy)\n--               'Par1'\n--          ':*:'\n--          'S1' ('MetaSel 'Nothing\n--                          'NoSourceUnpackedness\n--                          'NoSourceStrictness\n--                          'DecidedLazy)\n--               ([] ':.:' 'Rec1' Rose)))\n-- @\n--\n-- where\n--\n-- @\n-- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) }\n-- @\n\n-- *** Representation of @k -> *@ types\n--\n-- |\n--\n-- The 'Generic1' class can be generalized to range over types of kind\n-- @k -> *@, for any kind @k@. To do so, derive a 'Generic1' instance with the\n-- @PolyKinds@ extension enabled. For example, the declaration\n--\n-- @\n-- data Proxy (a :: k) = Proxy deriving 'Generic1'\n-- @\n--\n-- yields a slightly different instance depending on whether @PolyKinds@ is\n-- enabled. If compiled without @PolyKinds@, then @'Rep1' Proxy :: * -> *@, but\n-- if compiled with @PolyKinds@, then @'Rep1' Proxy :: k -> *@.\n\n-- *** Representation of unlifted types\n--\n-- |\n--\n-- If one were to attempt to derive a Generic instance for a datatype with an\n-- unlifted argument (for example, 'Int#'), one might expect the occurrence of\n-- the 'Int#' argument to be marked with @'Rec0' 'Int#'@. This won't work,\n-- though, since 'Int#' is of an unlifted kind, and 'Rec0' expects a type of\n-- kind @*@.\n--\n-- One solution would be to represent an occurrence of 'Int#' with 'Rec0 Int'\n-- instead. With this approach, however, the programmer has no way of knowing\n-- whether the 'Int' is actually an 'Int#' in disguise.\n--\n-- Instead of reusing 'Rec0', a separate data family 'URec' is used to mark\n-- occurrences of common unlifted types:\n--\n-- @\n-- data family URec a p\n--\n-- data instance 'URec' ('Ptr' ()) p = 'UAddr'   { 'uAddr#'   :: 'Addr#'   }\n-- data instance 'URec' 'Char'     p = 'UChar'   { 'uChar#'   :: 'Char#'   }\n-- data instance 'URec' 'Double'   p = 'UDouble' { 'uDouble#' :: 'Double#' }\n-- data instance 'URec' 'Int'      p = 'UFloat'  { 'uFloat#'  :: 'Float#'  }\n-- data instance 'URec' 'Float'    p = 'UInt'    { 'uInt#'    :: 'Int#'    }\n-- data instance 'URec' 'Word'     p = 'UWord'   { 'uWord#'   :: 'Word#'   }\n-- @\n--\n-- Several type synonyms are provided for convenience:\n--\n-- @\n-- type 'UAddr'   = 'URec' ('Ptr' ())\n-- type 'UChar'   = 'URec' 'Char'\n-- type 'UDouble' = 'URec' 'Double'\n-- type 'UFloat'  = 'URec' 'Float'\n-- type 'UInt'    = 'URec' 'Int'\n-- type 'UWord'   = 'URec' 'Word'\n-- @\n--\n-- The declaration\n--\n-- @\n-- data IntHash = IntHash Int#\n--   deriving 'Generic'\n-- @\n--\n-- yields\n--\n-- @\n-- instance 'Generic' IntHash where\n--   type 'Rep' IntHash =\n--     'D1' ('MetaData \\\"IntHash\\\" \\\"Main\\\" \\\"package-name\\\" 'False)\n--       ('C1' ('MetaCons \\\"IntHash\\\" 'PrefixI 'False)\n--         ('S1' ('MetaSel 'Nothing\n--                         'NoSourceUnpackedness\n--                         'NoSourceStrictness\n--                         'DecidedLazy)\n--               'UInt'))\n-- @\n--\n-- Currently, only the six unlifted types listed above are generated, but this\n-- may be extended to encompass more unlifted types in the future.\n#if 0\n-- *** Limitations\n--\n-- |\n--\n-- /TODO/\n--\n-- /TODO:/ Also clear up confusion about 'Rec0' and 'Rec1' not really indicating recursion.\n--\n#endif\n-----------------------------------------------------------------------------\n\n  -- * Generic representation types\n    V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..)\n  , (:+:)(..), (:*:)(..), (:.:)(..)\n\n  -- ** Unboxed representation types\n  , URec(..)\n  , type UAddr, type UChar, type UDouble\n  , type UFloat, type UInt, type UWord\n\n  -- ** Synonyms for convenience\n  , Rec0, R\n  , D1, C1, S1, D, C, S\n\n  -- * Meta-information\n  , Datatype(..), Constructor(..), Selector(..)\n  , Fixity(..), FixityI(..), Associativity(..), prec\n  , SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..)\n  , Meta(..)\n\n  -- * Generic type classes\n  , Generic(..), Generic1(..)\n\n  ) where\n\n-- We use some base types\nimport Data.Either ( Either (..) )\nimport Data.Maybe  ( Maybe(..), fromMaybe )\nimport Data.Ord    ( Down(..) )\nimport GHC.Integer ( Integer, integerToInt )\nimport GHC.Prim    ( Addr#, Char#, Double#, Float#, Int#, Word# )\nimport GHC.Ptr     ( Ptr )\nimport GHC.Types\n\n-- Needed for instances\nimport GHC.Arr     ( Ix )\nimport GHC.Base    ( Alternative(..), Applicative(..), Functor(..)\n                   , Monad(..), MonadPlus(..), NonEmpty(..), String, coerce\n                   , Semigroup(..), Monoid(..) )\nimport GHC.Classes ( Eq(..), Ord(..) )\nimport GHC.Enum    ( Bounded, Enum )\nimport GHC.Read    ( Read(..) )\nimport GHC.Show    ( Show(..), showString )\n\n-- Needed for metadata\nimport Data.Proxy   ( Proxy(..) )\nimport GHC.TypeLits ( KnownSymbol, KnownNat, symbolVal, natVal )\n\n--------------------------------------------------------------------------------\n-- Representation types\n--------------------------------------------------------------------------------\n\n-- | Void: used for datatypes without constructors\ndata V1 (p :: k)\n  deriving ( Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Read     -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.12.0.0\ninstance Semigroup (V1 p) where\n  v <> _ = v\n\n-- | Unit: used for constructors without arguments\ndata U1 (p :: k) = U1\n  deriving ( Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Eq (U1 p) where\n  _ == _ = True\n\n-- | @since 4.7.0.0\ninstance Ord (U1 p) where\n  compare _ _ = EQ\n\n-- | @since 4.9.0.0\nderiving instance Read (U1 p)\n\n-- | @since 4.9.0.0\ninstance Show (U1 p) where\n  showsPrec _ _ = showString \"U1\"\n\n-- | @since 4.9.0.0\ninstance Functor U1 where\n  fmap _ _ = U1\n\n-- | @since 4.9.0.0\ninstance Applicative U1 where\n  pure _ = U1\n  _ <*> _ = U1\n  liftA2 _ _ _ = U1\n\n-- | @since 4.9.0.0\ninstance Alternative U1 where\n  empty = U1\n  _ <|> _ = U1\n\n-- | @since 4.9.0.0\ninstance Monad U1 where\n  _ >>= _ = U1\n\n-- | @since 4.9.0.0\ninstance MonadPlus U1\n\n-- | @since 4.12.0.0\ninstance Semigroup (U1 p) where\n  _ <> _ = U1\n\n-- | @since 4.12.0.0\ninstance Monoid (U1 p) where\n  mempty = U1\n\n-- | Used for marking occurrences of the parameter\nnewtype Par1 p = Par1 { unPar1 :: p }\n  deriving ( Eq       -- ^ @since 4.7.0.0\n           , Ord      -- ^ @since 4.7.0.0\n           , Read     -- ^ @since 4.7.0.0\n           , Show     -- ^ @since 4.7.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance Applicative Par1 where\n  pure = Par1\n  (<*>) = coerce\n  liftA2 = coerce\n\n-- | @since 4.9.0.0\ninstance Monad Par1 where\n  Par1 x >>= f = f x\n\n-- | @since 4.12.0.0\nderiving instance Semigroup p => Semigroup (Par1 p)\n\n-- | @since 4.12.0.0\nderiving instance Monoid p => Monoid (Par1 p)\n\n-- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@\n-- is enabled)\nnewtype Rec1 (f :: k -> Type) (p :: k) = Rec1 { unRec1 :: f p }\n  deriving ( Eq       -- ^ @since 4.7.0.0\n           , Ord      -- ^ @since 4.7.0.0\n           , Read     -- ^ @since 4.7.0.0\n           , Show     -- ^ @since 4.7.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\nderiving instance Applicative f => Applicative (Rec1 f)\n\n-- | @since 4.9.0.0\nderiving instance Alternative f => Alternative (Rec1 f)\n\n-- | @since 4.9.0.0\ninstance Monad f => Monad (Rec1 f) where\n  Rec1 x >>= f = Rec1 (x >>= \\a -> unRec1 (f a))\n\n-- | @since 4.9.0.0\nderiving instance MonadPlus f => MonadPlus (Rec1 f)\n\n-- | @since 4.12.0.0\nderiving instance Semigroup (f p) => Semigroup (Rec1 f p)\n\n-- | @since 4.12.0.0\nderiving instance Monoid (f p) => Monoid (Rec1 f p)\n\n-- | Constants, additional parameters and recursion of kind @*@\nnewtype K1 (i :: Type) c (p :: k) = K1 { unK1 :: c }\n  deriving ( Eq       -- ^ @since 4.7.0.0\n           , Ord      -- ^ @since 4.7.0.0\n           , Read     -- ^ @since 4.7.0.0\n           , Show     -- ^ @since 4.7.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.12.0.0\ninstance Monoid c => Applicative (K1 i c) where\n  pure _ = K1 mempty\n  liftA2 = \\_ -> coerce (mappend :: c -> c -> c)\n  (<*>) = coerce (mappend :: c -> c -> c)\n\n-- | @since 4.12.0.0\nderiving instance Semigroup c => Semigroup (K1 i c p)\n\n-- | @since 4.12.0.0\nderiving instance Monoid c => Monoid (K1 i c p)\n\n-- | @since 4.9.0.0\nderiving instance Applicative f => Applicative (M1 i c f)\n\n-- | @since 4.9.0.0\nderiving instance Alternative f => Alternative (M1 i c f)\n\n-- | @since 4.9.0.0\nderiving instance Monad f => Monad (M1 i c f)\n\n-- | @since 4.9.0.0\nderiving instance MonadPlus f => MonadPlus (M1 i c f)\n\n-- | @since 4.12.0.0\nderiving instance Semigroup (f p) => Semigroup (M1 i c f p)\n\n-- | @since 4.12.0.0\nderiving instance Monoid (f p) => Monoid (M1 i c f p)\n\n-- | Meta-information (constructor names, etc.)\nnewtype M1 (i :: Type) (c :: Meta) (f :: k -> Type) (p :: k) =\n    M1 { unM1 :: f p }\n  deriving ( Eq       -- ^ @since 4.7.0.0\n           , Ord      -- ^ @since 4.7.0.0\n           , Read     -- ^ @since 4.7.0.0\n           , Show     -- ^ @since 4.7.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Sums: encode choice between constructors\ninfixr 5 :+:\ndata (:+:) (f :: k -> Type) (g :: k -> Type) (p :: k) = L1 (f p) | R1 (g p)\n  deriving ( Eq       -- ^ @since 4.7.0.0\n           , Ord      -- ^ @since 4.7.0.0\n           , Read     -- ^ @since 4.7.0.0\n           , Show     -- ^ @since 4.7.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Products: encode multiple arguments to constructors\ninfixr 6 :*:\ndata (:*:) (f :: k -> Type) (g :: k -> Type) (p :: k) = f p :*: g p\n  deriving ( Eq       -- ^ @since 4.7.0.0\n           , Ord      -- ^ @since 4.7.0.0\n           , Read     -- ^ @since 4.7.0.0\n           , Show     -- ^ @since 4.7.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance (Applicative f, Applicative g) => Applicative (f :*: g) where\n  pure a = pure a :*: pure a\n  (f :*: g) <*> (x :*: y) = (f <*> x) :*: (g <*> y)\n  liftA2 f (a :*: b) (x :*: y) = liftA2 f a x :*: liftA2 f b y\n\n-- | @since 4.9.0.0\ninstance (Alternative f, Alternative g) => Alternative (f :*: g) where\n  empty = empty :*: empty\n  (x1 :*: y1) <|> (x2 :*: y2) = (x1 <|> x2) :*: (y1 <|> y2)\n\n-- | @since 4.9.0.0\ninstance (Monad f, Monad g) => Monad (f :*: g) where\n  (m :*: n) >>= f = (m >>= \\a -> fstP (f a)) :*: (n >>= \\a -> sndP (f a))\n    where\n      fstP (a :*: _) = a\n      sndP (_ :*: b) = b\n\n-- | @since 4.9.0.0\ninstance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g)\n\n-- | @since 4.12.0.0\ninstance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where\n  (x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2)\n\n-- | @since 4.12.0.0\ninstance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where\n  mempty = mempty :*: mempty\n\n-- | Composition of functors\ninfixr 7 :.:\nnewtype (:.:) (f :: k2 -> Type) (g :: k1 -> k2) (p :: k1) =\n    Comp1 { unComp1 :: f (g p) }\n  deriving ( Eq       -- ^ @since 4.7.0.0\n           , Ord      -- ^ @since 4.7.0.0\n           , Read     -- ^ @since 4.7.0.0\n           , Show     -- ^ @since 4.7.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | @since 4.9.0.0\ninstance (Applicative f, Applicative g) => Applicative (f :.: g) where\n  pure x = Comp1 (pure (pure x))\n  Comp1 f <*> Comp1 x = Comp1 (liftA2 (<*>) f x)\n  liftA2 f (Comp1 x) (Comp1 y) = Comp1 (liftA2 (liftA2 f) x y)\n\n-- | @since 4.9.0.0\ninstance (Alternative f, Applicative g) => Alternative (f :.: g) where\n  empty = Comp1 empty\n  (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) ::\n    forall a . (f :.: g) a -> (f :.: g) a -> (f :.: g) a\n\n-- | @since 4.12.0.0\nderiving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p)\n\n-- | @since 4.12.0.0\nderiving instance Monoid (f (g p)) => Monoid ((f :.: g) p)\n\n-- | Constants of unlifted kinds\n--\n-- @since 4.9.0.0\ndata family URec (a :: Type) (p :: k)\n\n-- | Used for marking occurrences of 'Addr#'\n--\n-- @since 4.9.0.0\ndata instance URec (Ptr ()) (p :: k) = UAddr { uAddr# :: Addr# }\n  deriving ( Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Used for marking occurrences of 'Char#'\n--\n-- @since 4.9.0.0\ndata instance URec Char (p :: k) = UChar { uChar# :: Char# }\n  deriving ( Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Used for marking occurrences of 'Double#'\n--\n-- @since 4.9.0.0\ndata instance URec Double (p :: k) = UDouble { uDouble# :: Double# }\n  deriving ( Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Used for marking occurrences of 'Float#'\n--\n-- @since 4.9.0.0\ndata instance URec Float (p :: k) = UFloat { uFloat# :: Float# }\n  deriving ( Eq, Ord, Show\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Used for marking occurrences of 'Int#'\n--\n-- @since 4.9.0.0\ndata instance URec Int (p :: k) = UInt { uInt# :: Int# }\n  deriving ( Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Used for marking occurrences of 'Word#'\n--\n-- @since 4.9.0.0\ndata instance URec Word (p :: k) = UWord { uWord# :: Word# }\n  deriving ( Eq       -- ^ @since 4.9.0.0\n           , Ord      -- ^ @since 4.9.0.0\n           , Show     -- ^ @since 4.9.0.0\n           , Functor  -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.9.0.0\n           , Generic1 -- ^ @since 4.9.0.0\n           )\n\n-- | Type synonym for @'URec' 'Addr#'@\n--\n-- @since 4.9.0.0\ntype UAddr   = URec (Ptr ())\n-- | Type synonym for @'URec' 'Char#'@\n--\n-- @since 4.9.0.0\ntype UChar   = URec Char\n\n-- | Type synonym for @'URec' 'Double#'@\n--\n-- @since 4.9.0.0\ntype UDouble = URec Double\n\n-- | Type synonym for @'URec' 'Float#'@\n--\n-- @since 4.9.0.0\ntype UFloat  = URec Float\n\n-- | Type synonym for @'URec' 'Int#'@\n--\n-- @since 4.9.0.0\ntype UInt    = URec Int\n\n-- | Type synonym for @'URec' 'Word#'@\n--\n-- @since 4.9.0.0\ntype UWord   = URec Word\n\n-- | Tag for K1: recursion (of kind @Type@)\ndata R\n\n-- | Type synonym for encoding recursion (of kind @Type@)\ntype Rec0  = K1 R\n\n-- | Tag for M1: datatype\ndata D\n-- | Tag for M1: constructor\ndata C\n-- | Tag for M1: record selector\ndata S\n\n-- | Type synonym for encoding meta-information for datatypes\ntype D1 = M1 D\n\n-- | Type synonym for encoding meta-information for constructors\ntype C1 = M1 C\n\n-- | Type synonym for encoding meta-information for record selectors\ntype S1 = M1 S\n\n-- | Class for datatypes that represent datatypes\nclass Datatype d where\n  -- | The name of the datatype (unqualified)\n  datatypeName :: t d (f :: k -> Type) (a :: k) -> [Char]\n  -- | The fully-qualified name of the module where the type is declared\n  moduleName   :: t d (f :: k -> Type) (a :: k) -> [Char]\n  -- | The package name of the module where the type is declared\n  --\n  -- @since 4.9.0.0\n  packageName :: t d (f :: k -> Type) (a :: k) -> [Char]\n  -- | Marks if the datatype is actually a newtype\n  --\n  -- @since 4.7.0.0\n  isNewtype    :: t d (f :: k -> Type) (a :: k) -> Bool\n  isNewtype _ = False\n\n-- | @since 4.9.0.0\ninstance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt)\n    => Datatype ('MetaData n m p nt) where\n  datatypeName _ = symbolVal (Proxy :: Proxy n)\n  moduleName   _ = symbolVal (Proxy :: Proxy m)\n  packageName  _ = symbolVal (Proxy :: Proxy p)\n  isNewtype    _ = fromSing  (sing  :: Sing nt)\n\n-- | Class for datatypes that represent data constructors\nclass Constructor c where\n  -- | The name of the constructor\n  conName :: t c (f :: k -> Type) (a :: k) -> [Char]\n\n  -- | The fixity of the constructor\n  conFixity :: t c (f :: k -> Type) (a :: k) -> Fixity\n  conFixity _ = Prefix\n\n  -- | Marks if this constructor is a record\n  conIsRecord :: t c (f :: k -> Type) (a :: k) -> Bool\n  conIsRecord _ = False\n\n-- | @since 4.9.0.0\ninstance (KnownSymbol n, SingI f, SingI r)\n    => Constructor ('MetaCons n f r) where\n  conName     _ = symbolVal (Proxy :: Proxy n)\n  conFixity   _ = fromSing  (sing  :: Sing f)\n  conIsRecord _ = fromSing  (sing  :: Sing r)\n\n-- | Datatype to represent the fixity of a constructor. An infix\n-- | declaration directly corresponds to an application of 'Infix'.\ndata Fixity = Prefix | Infix Associativity Int\n  deriving ( Eq       -- ^ @since 4.6.0.0\n           , Show     -- ^ @since 4.6.0.0\n           , Ord      -- ^ @since 4.6.0.0\n           , Read     -- ^ @since 4.6.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           )\n\n-- | This variant of 'Fixity' appears at the type level.\n--\n-- @since 4.9.0.0\ndata FixityI = PrefixI | InfixI Associativity Nat\n\n-- | Get the precedence of a fixity value.\nprec :: Fixity -> Int\nprec Prefix      = 10\nprec (Infix _ n) = n\n\n-- | Datatype to represent the associativity of a constructor\ndata Associativity = LeftAssociative\n                   | RightAssociative\n                   | NotAssociative\n  deriving ( Eq       -- ^ @since 4.6.0.0\n           , Show     -- ^ @since 4.6.0.0\n           , Ord      -- ^ @since 4.6.0.0\n           , Read     -- ^ @since 4.6.0.0\n           , Enum     -- ^ @since 4.9.0.0\n           , Bounded  -- ^ @since 4.9.0.0\n           , Ix       -- ^ @since 4.9.0.0\n           , Generic  -- ^ @since 4.7.0.0\n           )\n\n-- | The unpackedness of a field as the user wrote it in the source code. For\n-- example, in the following data type:\n--\n-- @\n-- data E = ExampleConstructor     Int\n--            {\\-\\# NOUNPACK \\#-\\} Int\n--            {\\-\\#   UNPACK \\#-\\} Int\n-- @\n--\n-- The fields of @ExampleConstructor@ have 'NoSourceUnpackedness',\n-- 'SourceNoUnpack', and 'SourceUnpack', respectively.\n--\n-- @since 4.9.0.0\ndata SourceUnpackedness = NoSourceUnpackedness\n                        | SourceNoUnpack\n                        | SourceUnpack\n  deriving ( Eq      -- ^ @since 4.9.0.0\n           , Show    -- ^ @since 4.9.0.0\n           , Ord     -- ^ @since 4.9.0.0\n           , Read    -- ^ @since 4.9.0.0\n           , Enum    -- ^ @since 4.9.0.0\n           , Bounded -- ^ @since 4.9.0.0\n           , Ix      -- ^ @since 4.9.0.0\n           , Generic -- ^ @since 4.9.0.0\n           )\n\n-- | The strictness of a field as the user wrote it in the source code. For\n-- example, in the following data type:\n--\n-- @\n-- data E = ExampleConstructor Int ~Int !Int\n-- @\n--\n-- The fields of @ExampleConstructor@ have 'NoSourceStrictness',\n-- 'SourceLazy', and 'SourceStrict', respectively.\n--\n-- @since 4.9.0.0\ndata SourceStrictness = NoSourceStrictness\n                      | SourceLazy\n                      | SourceStrict\n  deriving ( Eq      -- ^ @since 4.9.0.0\n           , Show    -- ^ @since 4.9.0.0\n           , Ord     -- ^ @since 4.9.0.0\n           , Read    -- ^ @since 4.9.0.0\n           , Enum    -- ^ @since 4.9.0.0\n           , Bounded -- ^ @since 4.9.0.0\n           , Ix      -- ^ @since 4.9.0.0\n           , Generic -- ^ @since 4.9.0.0\n           )\n\n-- | The strictness that GHC infers for a field during compilation. Whereas\n-- there are nine different combinations of 'SourceUnpackedness' and\n-- 'SourceStrictness', the strictness that GHC decides will ultimately be one\n-- of lazy, strict, or unpacked. What GHC decides is affected both by what the\n-- user writes in the source code and by GHC flags. As an example, consider\n-- this data type:\n--\n-- @\n-- data E = ExampleConstructor {\\-\\# UNPACK \\#-\\} !Int !Int Int\n-- @\n--\n-- * If compiled without optimization or other language extensions, then the\n--   fields of @ExampleConstructor@ will have 'DecidedStrict', 'DecidedStrict',\n--   and 'DecidedLazy', respectively.\n--\n-- * If compiled with @-XStrictData@ enabled, then the fields will have\n--   'DecidedStrict', 'DecidedStrict', and 'DecidedStrict', respectively.\n--\n-- * If compiled with @-O2@ enabled, then the fields will have 'DecidedUnpack',\n--   'DecidedStrict', and 'DecidedLazy', respectively.\n--\n-- @since 4.9.0.0\ndata DecidedStrictness = DecidedLazy\n                       | DecidedStrict\n                       | DecidedUnpack\n  deriving ( Eq      -- ^ @since 4.9.0.0\n           , Show    -- ^ @since 4.9.0.0\n           , Ord     -- ^ @since 4.9.0.0\n           , Read    -- ^ @since 4.9.0.0\n           , Enum    -- ^ @since 4.9.0.0\n           , Bounded -- ^ @since 4.9.0.0\n           , Ix      -- ^ @since 4.9.0.0\n           , Generic -- ^ @since 4.9.0.0\n           )\n\n-- | Class for datatypes that represent records\nclass Selector s where\n  -- | The name of the selector\n  selName :: t s (f :: k -> Type) (a :: k) -> [Char]\n  -- | The selector's unpackedness annotation (if any)\n  --\n  -- @since 4.9.0.0\n  selSourceUnpackedness :: t s (f :: k -> Type) (a :: k) -> SourceUnpackedness\n  -- | The selector's strictness annotation (if any)\n  --\n  -- @since 4.9.0.0\n  selSourceStrictness :: t s (f :: k -> Type) (a :: k) -> SourceStrictness\n  -- | The strictness that the compiler inferred for the selector\n  --\n  -- @since 4.9.0.0\n  selDecidedStrictness :: t s (f :: k -> Type) (a :: k) -> DecidedStrictness\n\n-- | @since 4.9.0.0\ninstance (SingI mn, SingI su, SingI ss, SingI ds)\n    => Selector ('MetaSel mn su ss ds) where\n  selName _ = fromMaybe \"\" (fromSing (sing :: Sing mn))\n  selSourceUnpackedness _ = fromSing (sing :: Sing su)\n  selSourceStrictness   _ = fromSing (sing :: Sing ss)\n  selDecidedStrictness  _ = fromSing (sing :: Sing ds)\n\n-- | Representable types of kind @*@.\n-- This class is derivable in GHC with the @DeriveGeneric@ flag on.\n--\n-- A 'Generic' instance must satisfy the following laws:\n--\n-- @\n-- 'from' . 'to' \u00e2\u2030\u00a1 'Prelude.id'\n-- 'to' . 'from' \u00e2\u2030\u00a1 'Prelude.id'\n-- @\nclass Generic a where\n  -- | Generic representation type\n  type Rep a :: Type -> Type\n  -- | Convert from the datatype to its representation\n  from  :: a -> (Rep a) x\n  -- | Convert from the representation to the datatype\n  to    :: (Rep a) x -> a\n\n\n-- | Representable types of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@\n-- is enabled).\n-- This class is derivable in GHC with the @DeriveGeneric@ flag on.\n--\n-- A 'Generic1' instance must satisfy the following laws:\n--\n-- @\n-- 'from1' . 'to1' \u00e2\u2030\u00a1 'Prelude.id'\n-- 'to1' . 'from1' \u00e2\u2030\u00a1 'Prelude.id'\n-- @\nclass Generic1 (f :: k -> Type) where\n  -- | Generic representation type\n  type Rep1 f :: k -> Type\n  -- | Convert from the datatype to its representation\n  from1  :: f a -> (Rep1 f) a\n  -- | Convert from the representation to the datatype\n  to1    :: (Rep1 f) a -> f a\n\n--------------------------------------------------------------------------------\n-- Meta-data\n--------------------------------------------------------------------------------\n\n-- | Datatype to represent metadata associated with a datatype (@MetaData@),\n-- constructor (@MetaCons@), or field selector (@MetaSel@).\n--\n-- * In @MetaData n m p nt@, @n@ is the datatype's name, @m@ is the module in\n--   which the datatype is defined, @p@ is the package in which the datatype\n--   is defined, and @nt@ is @'True@ if the datatype is a @newtype@.\n--\n-- * In @MetaCons n f s@, @n@ is the constructor's name, @f@ is its fixity,\n--   and @s@ is @'True@ if the constructor contains record selectors.\n--\n-- * In @MetaSel mn su ss ds@, if the field uses record syntax, then @mn@ is\n--   'Just' the record name. Otherwise, @mn@ is 'Nothing'. @su@ and @ss@ are\n--   the field's unpackedness and strictness annotations, and @ds@ is the\n--   strictness that GHC infers for the field.\n--\n-- @since 4.9.0.0\ndata Meta = MetaData Symbol Symbol Symbol Bool\n          | MetaCons Symbol FixityI Bool\n          | MetaSel  (Maybe Symbol)\n                     SourceUnpackedness SourceStrictness DecidedStrictness\n\n--------------------------------------------------------------------------------\n-- Derived instances\n--------------------------------------------------------------------------------\n\n-- | @since 4.6.0.0\nderiving instance Generic [a]\n\n-- | @since 4.6.0.0\nderiving instance Generic (NonEmpty a)\n\n-- | @since 4.6.0.0\nderiving instance Generic (Maybe a)\n\n-- | @since 4.6.0.0\nderiving instance Generic (Either a b)\n\n-- | @since 4.6.0.0\nderiving instance Generic Bool\n\n-- | @since 4.6.0.0\nderiving instance Generic Ordering\n\n-- | @since 4.6.0.0\nderiving instance Generic (Proxy t)\n\n-- | @since 4.6.0.0\nderiving instance Generic ()\n\n-- | @since 4.6.0.0\nderiving instance Generic ((,) a b)\n\n-- | @since 4.6.0.0\nderiving instance Generic ((,,) a b c)\n\n-- | @since 4.6.0.0\nderiving instance Generic ((,,,) a b c d)\n\n-- | @since 4.6.0.0\nderiving instance Generic ((,,,,) a b c d e)\n\n-- | @since 4.6.0.0\nderiving instance Generic ((,,,,,) a b c d e f)\n\n-- | @since 4.6.0.0\nderiving instance Generic ((,,,,,,) a b c d e f g)\n\n-- | @since 4.12.0.0\nderiving instance Generic (Down a)\n\n\n-- | @since 4.6.0.0\nderiving instance Generic1 []\n\n-- | @since 4.6.0.0\nderiving instance Generic1 NonEmpty\n\n-- | @since 4.6.0.0\nderiving instance Generic1 Maybe\n\n-- | @since 4.6.0.0\nderiving instance Generic1 (Either a)\n\n-- | @since 4.6.0.0\nderiving instance Generic1 Proxy\n\n-- | @since 4.6.0.0\nderiving instance Generic1 ((,) a)\n\n-- | @since 4.6.0.0\nderiving instance Generic1 ((,,) a b)\n\n-- | @since 4.6.0.0\nderiving instance Generic1 ((,,,) a b c)\n\n-- | @since 4.6.0.0\nderiving instance Generic1 ((,,,,) a b c d)\n\n-- | @since 4.6.0.0\nderiving instance Generic1 ((,,,,,) a b c d e)\n\n-- | @since 4.6.0.0\nderiving instance Generic1 ((,,,,,,) a b c d e f)\n\n-- | @since 4.12.0.0\nderiving instance Generic1 Down\n\n--------------------------------------------------------------------------------\n-- Copied from the singletons package\n--------------------------------------------------------------------------------\n\n-- | The singleton kind-indexed data family.\ndata family Sing (a :: k)\n\n-- | A 'SingI' constraint is essentially an implicitly-passed singleton.\nclass SingI (a :: k) where\n  -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@\n  -- extension to use this method the way you want.\n  sing :: Sing a\n\n-- | The 'SingKind' class is essentially a /kind/ class. It classifies all kinds\n-- for which singletons are defined. The class supports converting between a singleton\n-- type and the base (unrefined) type which it is built from.\nclass SingKind k where\n  -- | Get a base type from a proxy for the promoted kind. For example,\n  -- @DemoteRep Bool@ will be the type @Bool@.\n  type DemoteRep k :: Type\n\n  -- | Convert a singleton to its unrefined version.\n  fromSing :: Sing (a :: k) -> DemoteRep k\n\n-- Singleton symbols\ndata instance Sing (s :: Symbol) where\n  SSym :: KnownSymbol s => Sing s\n\n-- | @since 4.9.0.0\ninstance KnownSymbol a => SingI a where sing = SSym\n\n-- | @since 4.9.0.0\ninstance SingKind Symbol where\n  type DemoteRep Symbol = String\n  fromSing (SSym :: Sing s) = symbolVal (Proxy :: Proxy s)\n\n-- Singleton booleans\ndata instance Sing (a :: Bool) where\n  STrue  :: Sing 'True\n  SFalse :: Sing 'False\n\n-- | @since 4.9.0.0\ninstance SingI 'True  where sing = STrue\n\n-- | @since 4.9.0.0\ninstance SingI 'False where sing = SFalse\n\n-- | @since 4.9.0.0\ninstance SingKind Bool where\n  type DemoteRep Bool = Bool\n  fromSing STrue  = True\n  fromSing SFalse = False\n\n-- Singleton Maybe\ndata instance Sing (b :: Maybe a) where\n  SNothing :: Sing 'Nothing\n  SJust    :: Sing a -> Sing ('Just a)\n\n-- | @since 4.9.0.0\ninstance            SingI 'Nothing  where sing = SNothing\n\n-- | @since 4.9.0.0\ninstance SingI a => SingI ('Just a) where sing = SJust sing\n\n-- | @since 4.9.0.0\ninstance SingKind a => SingKind (Maybe a) where\n  type DemoteRep (Maybe a) = Maybe (DemoteRep a)\n  fromSing SNothing  = Nothing\n  fromSing (SJust a) = Just (fromSing a)\n\n-- Singleton Fixity\ndata instance Sing (a :: FixityI) where\n  SPrefix :: Sing 'PrefixI\n  SInfix  :: Sing a -> Integer -> Sing ('InfixI a n)\n\n-- | @since 4.9.0.0\ninstance SingI 'PrefixI where sing = SPrefix\n\n-- | @since 4.9.0.0\ninstance (SingI a, KnownNat n) => SingI ('InfixI a n) where\n  sing = SInfix (sing :: Sing a) (natVal (Proxy :: Proxy n))\n\n-- | @since 4.9.0.0\ninstance SingKind FixityI where\n  type DemoteRep FixityI = Fixity\n  fromSing SPrefix      = Prefix\n  fromSing (SInfix a n) = Infix (fromSing a) (I# (integerToInt n))\n\n-- Singleton Associativity\ndata instance Sing (a :: Associativity) where\n  SLeftAssociative  :: Sing 'LeftAssociative\n  SRightAssociative :: Sing 'RightAssociative\n  SNotAssociative   :: Sing 'NotAssociative\n\n-- | @since 4.9.0.0\ninstance SingI 'LeftAssociative  where sing = SLeftAssociative\n\n-- | @since 4.9.0.0\ninstance SingI 'RightAssociative where sing = SRightAssociative\n\n-- | @since 4.9.0.0\ninstance SingI 'NotAssociative   where sing = SNotAssociative\n\n-- | @since 4.0.0.0\ninstance SingKind Associativity where\n  type DemoteRep Associativity = Associativity\n  fromSing SLeftAssociative  = LeftAssociative\n  fromSing SRightAssociative = RightAssociative\n  fromSing SNotAssociative   = NotAssociative\n\n-- Singleton SourceUnpackedness\ndata instance Sing (a :: SourceUnpackedness) where\n  SNoSourceUnpackedness :: Sing 'NoSourceUnpackedness\n  SSourceNoUnpack       :: Sing 'SourceNoUnpack\n  SSourceUnpack         :: Sing 'SourceUnpack\n\n-- | @since 4.9.0.0\ninstance SingI 'NoSourceUnpackedness where sing = SNoSourceUnpackedness\n\n-- | @since 4.9.0.0\ninstance SingI 'SourceNoUnpack       where sing = SSourceNoUnpack\n\n-- | @since 4.9.0.0\ninstance SingI 'SourceUnpack         where sing = SSourceUnpack\n\n-- | @since 4.9.0.0\ninstance SingKind SourceUnpackedness where\n  type DemoteRep SourceUnpackedness = SourceUnpackedness\n  fromSing SNoSourceUnpackedness = NoSourceUnpackedness\n  fromSing SSourceNoUnpack       = SourceNoUnpack\n  fromSing SSourceUnpack         = SourceUnpack\n\n-- Singleton SourceStrictness\ndata instance Sing (a :: SourceStrictness) where\n  SNoSourceStrictness :: Sing 'NoSourceStrictness\n  SSourceLazy         :: Sing 'SourceLazy\n  SSourceStrict       :: Sing 'SourceStrict\n\n-- | @since 4.9.0.0\ninstance SingI 'NoSourceStrictness where sing = SNoSourceStrictness\n\n-- | @since 4.9.0.0\ninstance SingI 'SourceLazy         where sing = SSourceLazy\n\n-- | @since 4.9.0.0\ninstance SingI 'SourceStrict       where sing = SSourceStrict\n\n-- | @since 4.9.0.0\ninstance SingKind SourceStrictness where\n  type DemoteRep SourceStrictness = SourceStrictness\n  fromSing SNoSourceStrictness = NoSourceStrictness\n  fromSing SSourceLazy         = SourceLazy\n  fromSing SSourceStrict       = SourceStrict\n\n-- Singleton DecidedStrictness\ndata instance Sing (a :: DecidedStrictness) where\n  SDecidedLazy   :: Sing 'DecidedLazy\n  SDecidedStrict :: Sing 'DecidedStrict\n  SDecidedUnpack :: Sing 'DecidedUnpack\n\n-- | @since 4.9.0.0\ninstance SingI 'DecidedLazy   where sing = SDecidedLazy\n\n-- | @since 4.9.0.0\ninstance SingI 'DecidedStrict where sing = SDecidedStrict\n\n-- | @since 4.9.0.0\ninstance SingI 'DecidedUnpack where sing = SDecidedUnpack\n\n-- | @since 4.9.0.0\ninstance SingKind DecidedStrictness where\n  type DemoteRep DecidedStrictness = DecidedStrictness\n  fromSing SDecidedLazy   = DecidedLazy\n  fromSing SDecidedStrict = DecidedStrict\n  fromSing SDecidedUnpack = DecidedUnpack\n", "num_lines": 1652}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.GHCi\n-- Copyright   :  (c) The University of Glasgow 2012\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The GHCi Monad lifting interface.\n--\n-- EXPERIMENTAL! DON'T USE.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.GHCi {-# WARNING \"This is an unstable interface.\" #-} (\n        GHCiSandboxIO(..), NoIO()\n    ) where\n\nimport GHC.Base (IO(), Monad, Functor(fmap), Applicative(..), (>>=), id, (.), ap)\n\n-- | A monad that can execute GHCi statements by lifting them out of\n-- m into the IO monad. (e.g state monads)\nclass (Monad m) => GHCiSandboxIO m where\n    ghciStepIO :: m a -> IO a\n\n-- | @since 4.4.0.0\ninstance GHCiSandboxIO IO where\n    ghciStepIO = id\n\n-- | A monad that doesn't allow any IO.\nnewtype NoIO a = NoIO { noio :: IO a }\n\n-- | @since 4.8.0.0\ninstance Functor NoIO where\n  fmap f (NoIO a) = NoIO (fmap f a)\n\n-- | @since 4.8.0.0\ninstance Applicative NoIO where\n  pure a = NoIO (pure a)\n  (<*>) = ap\n\n-- | @since 4.4.0.0\ninstance Monad NoIO where\n    (>>=) k f = NoIO (noio k >>= noio . f)\n\n-- | @since 4.4.0.0\ninstance GHCiSandboxIO NoIO where\n    ghciStepIO = noio\n\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples,\n             StandaloneDeriving, NegativeLiterals #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Int\n-- Copyright   :  (c) The University of Glasgow 1997-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The sized integral datatypes, 'Int8', 'Int16', 'Int32', and 'Int64'.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Int (\n        Int(..), Int8(..), Int16(..), Int32(..), Int64(..),\n        uncheckedIShiftL64#, uncheckedIShiftRA64#,\n        -- * Equality operators\n        -- | See GHC.Classes#matching_overloaded_methods_in_rules\n        eqInt, neInt, gtInt, geInt, ltInt, leInt,\n        eqInt8, neInt8, gtInt8, geInt8, ltInt8, leInt8,\n        eqInt16, neInt16, gtInt16, geInt16, ltInt16, leInt16,\n        eqInt32, neInt32, gtInt32, geInt32, ltInt32, leInt32,\n        eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64\n    ) where\n\nimport Data.Bits\nimport Data.Maybe\n\n#if WORD_SIZE_IN_BITS < 64\nimport GHC.IntWord64\n#endif\n\nimport GHC.Base\nimport GHC.Enum\nimport GHC.Num\nimport GHC.Real\nimport GHC.Read\nimport GHC.Arr\nimport GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#)\nimport GHC.Show\n\n------------------------------------------------------------------------\n-- type Int8\n------------------------------------------------------------------------\n\n-- Int8 is represented in the same way as Int. Operations may assume\n-- and must ensure that it holds only values from its logical range.\n\ndata {-# CTYPE \"HsInt8\" #-} Int8 = I8# Int#\n-- ^ 8-bit signed integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Int8 where\n    (==) = eqInt8\n    (/=) = neInt8\n\neqInt8, neInt8 :: Int8 -> Int8 -> Bool\neqInt8 (I8# x) (I8# y) = isTrue# (x ==# y)\nneInt8 (I8# x) (I8# y) = isTrue# (x /=# y)\n{-# INLINE [1] eqInt8 #-}\n{-# INLINE [1] neInt8 #-}\n\n-- | @since 2.01\ninstance Ord Int8 where\n    (<)  = ltInt8\n    (<=) = leInt8\n    (>=) = geInt8\n    (>)  = gtInt8\n\n{-# INLINE [1] gtInt8 #-}\n{-# INLINE [1] geInt8 #-}\n{-# INLINE [1] ltInt8 #-}\n{-# INLINE [1] leInt8 #-}\ngtInt8, geInt8, ltInt8, leInt8 :: Int8 -> Int8 -> Bool\n(I8# x) `gtInt8` (I8# y) = isTrue# (x >#  y)\n(I8# x) `geInt8` (I8# y) = isTrue# (x >=# y)\n(I8# x) `ltInt8` (I8# y) = isTrue# (x <#  y)\n(I8# x) `leInt8` (I8# y) = isTrue# (x <=# y)\n\n-- | @since 2.01\ninstance Show Int8 where\n    showsPrec p x = showsPrec p (fromIntegral x :: Int)\n\n-- | @since 2.01\ninstance Num Int8 where\n    (I8# x#) + (I8# y#)    = I8# (narrow8Int# (x# +# y#))\n    (I8# x#) - (I8# y#)    = I8# (narrow8Int# (x# -# y#))\n    (I8# x#) * (I8# y#)    = I8# (narrow8Int# (x# *# y#))\n    negate (I8# x#)        = I8# (narrow8Int# (negateInt# x#))\n    abs x | x >= 0         = x\n          | otherwise      = negate x\n    signum x | x > 0       = 1\n    signum 0               = 0\n    signum _               = -1\n    fromInteger i          = I8# (narrow8Int# (integerToInt i))\n\n-- | @since 2.01\ninstance Real Int8 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Enum Int8 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Int8\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Int8\"\n    toEnum i@(I# i#)\n        | i >= fromIntegral (minBound::Int8) && i <= fromIntegral (maxBound::Int8)\n                        = I8# i#\n        | otherwise     = toEnumError \"Int8\" i (minBound::Int8, maxBound::Int8)\n    fromEnum (I8# x#)   = I# x#\n    enumFrom            = boundedEnumFrom\n    enumFromThen        = boundedEnumFromThen\n\n-- | @since 2.01\ninstance Integral Int8 where\n    quot    x@(I8# x#) y@(I8# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I8# (narrow8Int# (x# `quotInt#` y#))\n    rem     (I8# x#) y@(I8# y#)\n        | y == 0                     = divZeroError\n        | otherwise                  = I8# (narrow8Int# (x# `remInt#` y#))\n    div     x@(I8# x#) y@(I8# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I8# (narrow8Int# (x# `divInt#` y#))\n    mod       (I8# x#) y@(I8# y#)\n        | y == 0                     = divZeroError\n        | otherwise                  = I8# (narrow8Int# (x# `modInt#` y#))\n    quotRem x@(I8# x#) y@(I8# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `quotRemInt#` y# of\n                                       (# q, r #) ->\n                                           (I8# (narrow8Int# q),\n                                            I8# (narrow8Int# r))\n    divMod  x@(I8# x#) y@(I8# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `divModInt#` y# of\n                                       (# d, m #) ->\n                                           (I8# (narrow8Int# d),\n                                            I8# (narrow8Int# m))\n    toInteger (I8# x#)               = smallInteger x#\n\n-- | @since 2.01\ninstance Bounded Int8 where\n    minBound = -0x80\n    maxBound =  0x7F\n\n-- | @since 2.01\ninstance Ix Int8 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m\n    inRange (m,n) i     = m <= i && i <= n\n\n-- | @since 2.01\ninstance Read Int8 where\n    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Bits Int8 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (I8# x#) .&.   (I8# y#)   = I8# (word2Int# (int2Word# x# `and#` int2Word# y#))\n    (I8# x#) .|.   (I8# y#)   = I8# (word2Int# (int2Word# x# `or#`  int2Word# y#))\n    (I8# x#) `xor` (I8# y#)   = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))\n    complement (I8# x#)       = I8# (word2Int# (not# (int2Word# x#)))\n    (I8# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))\n        | otherwise           = I8# (x# `iShiftRA#` negateInt# i#)\n    (I8# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))\n        | otherwise           = overflowError\n    (I8# x#) `unsafeShiftL` (I# i#) = I8# (narrow8Int# (x# `uncheckedIShiftL#` i#))\n    (I8# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#) = I8# (x# `iShiftRA#` i#)\n        | otherwise           = overflowError\n    (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedIShiftRA#` i#)\n    (I8# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#)\n        = I8# x#\n        | otherwise\n        = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`\n                                       (x'# `uncheckedShiftRL#` (8# -# i'#)))))\n        where\n        !x'# = narrow8Word# (int2Word# x#)\n        !i'# = word2Int# (int2Word# i# `and#` 7##)\n    bitSizeMaybe i            = Just (finiteBitSize i)\n    bitSize i                 = finiteBitSize i\n    isSigned _                = True\n    popCount (I8# x#)         = I# (word2Int# (popCnt8# (int2Word# x#)))\n    bit                       = bitDefault\n    testBit                   = testBitDefault\n\n-- | @since 4.6.0.0\ninstance FiniteBits Int8 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 8\n    countLeadingZeros  (I8# x#) = I# (word2Int# (clz8# (int2Word# x#)))\n    countTrailingZeros (I8# x#) = I# (word2Int# (ctz8# (int2Word# x#)))\n\n{-# RULES\n\"fromIntegral/Int8->Int8\" fromIntegral = id :: Int8 -> Int8\n\"fromIntegral/a->Int8\"    fromIntegral = \\x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)\n\"fromIntegral/Int8->a\"    fromIntegral = \\(I8# x#) -> fromIntegral (I# x#)\n  #-}\n\n{-# RULES\n\"properFraction/Float->(Int8,Float)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Float) }\n\"truncate/Float->Int8\"\n    truncate = (fromIntegral :: Int -> Int8) . (truncate :: Float -> Int)\n\"floor/Float->Int8\"\n    floor    = (fromIntegral :: Int -> Int8) . (floor :: Float -> Int)\n\"ceiling/Float->Int8\"\n    ceiling  = (fromIntegral :: Int -> Int8) . (ceiling :: Float -> Int)\n\"round/Float->Int8\"\n    round    = (fromIntegral :: Int -> Int8) . (round  :: Float -> Int)\n  #-}\n\n{-# RULES\n\"properFraction/Double->(Int8,Double)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Double) }\n\"truncate/Double->Int8\"\n    truncate = (fromIntegral :: Int -> Int8) . (truncate :: Double -> Int)\n\"floor/Double->Int8\"\n    floor    = (fromIntegral :: Int -> Int8) . (floor :: Double -> Int)\n\"ceiling/Double->Int8\"\n    ceiling  = (fromIntegral :: Int -> Int8) . (ceiling :: Double -> Int)\n\"round/Double->Int8\"\n    round    = (fromIntegral :: Int -> Int8) . (round  :: Double -> Int)\n  #-}\n\n------------------------------------------------------------------------\n-- type Int16\n------------------------------------------------------------------------\n\n-- Int16 is represented in the same way as Int. Operations may assume\n-- and must ensure that it holds only values from its logical range.\n\ndata {-# CTYPE \"HsInt16\" #-} Int16 = I16# Int#\n-- ^ 16-bit signed integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Int16 where\n    (==) = eqInt16\n    (/=) = neInt16\n\neqInt16, neInt16 :: Int16 -> Int16 -> Bool\neqInt16 (I16# x) (I16# y) = isTrue# (x ==# y)\nneInt16 (I16# x) (I16# y) = isTrue# (x /=# y)\n{-# INLINE [1] eqInt16 #-}\n{-# INLINE [1] neInt16 #-}\n\n-- | @since 2.01\ninstance Ord Int16 where\n    (<)  = ltInt16\n    (<=) = leInt16\n    (>=) = geInt16\n    (>)  = gtInt16\n\n{-# INLINE [1] gtInt16 #-}\n{-# INLINE [1] geInt16 #-}\n{-# INLINE [1] ltInt16 #-}\n{-# INLINE [1] leInt16 #-}\ngtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool\n(I16# x) `gtInt16` (I16# y) = isTrue# (x >#  y)\n(I16# x) `geInt16` (I16# y) = isTrue# (x >=# y)\n(I16# x) `ltInt16` (I16# y) = isTrue# (x <#  y)\n(I16# x) `leInt16` (I16# y) = isTrue# (x <=# y)\n\n-- | @since 2.01\ninstance Show Int16 where\n    showsPrec p x = showsPrec p (fromIntegral x :: Int)\n\n-- | @since 2.01\ninstance Num Int16 where\n    (I16# x#) + (I16# y#)  = I16# (narrow16Int# (x# +# y#))\n    (I16# x#) - (I16# y#)  = I16# (narrow16Int# (x# -# y#))\n    (I16# x#) * (I16# y#)  = I16# (narrow16Int# (x# *# y#))\n    negate (I16# x#)       = I16# (narrow16Int# (negateInt# x#))\n    abs x | x >= 0         = x\n          | otherwise      = negate x\n    signum x | x > 0       = 1\n    signum 0               = 0\n    signum _               = -1\n    fromInteger i          = I16# (narrow16Int# (integerToInt i))\n\n-- | @since 2.01\ninstance Real Int16 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Enum Int16 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Int16\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Int16\"\n    toEnum i@(I# i#)\n        | i >= fromIntegral (minBound::Int16) && i <= fromIntegral (maxBound::Int16)\n                        = I16# i#\n        | otherwise     = toEnumError \"Int16\" i (minBound::Int16, maxBound::Int16)\n    fromEnum (I16# x#)  = I# x#\n    enumFrom            = boundedEnumFrom\n    enumFromThen        = boundedEnumFromThen\n\n-- | @since 2.01\ninstance Integral Int16 where\n    quot    x@(I16# x#) y@(I16# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I16# (narrow16Int# (x# `quotInt#` y#))\n    rem       (I16# x#) y@(I16# y#)\n        | y == 0                     = divZeroError\n        | otherwise                  = I16# (narrow16Int# (x# `remInt#` y#))\n    div     x@(I16# x#) y@(I16# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I16# (narrow16Int# (x# `divInt#` y#))\n    mod       (I16# x#) y@(I16# y#)\n        | y == 0                     = divZeroError\n        | otherwise                  = I16# (narrow16Int# (x# `modInt#` y#))\n    quotRem x@(I16# x#) y@(I16# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `quotRemInt#` y# of\n                                       (# q, r #) ->\n                                           (I16# (narrow16Int# q),\n                                            I16# (narrow16Int# r))\n    divMod  x@(I16# x#) y@(I16# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `divModInt#` y# of\n                                       (# d, m #) ->\n                                           (I16# (narrow16Int# d),\n                                            I16# (narrow16Int# m))\n    toInteger (I16# x#)              = smallInteger x#\n\n-- | @since 2.01\ninstance Bounded Int16 where\n    minBound = -0x8000\n    maxBound =  0x7FFF\n\n-- | @since 2.01\ninstance Ix Int16 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m\n    inRange (m,n) i     = m <= i && i <= n\n\n-- | @since 2.01\ninstance Read Int16 where\n    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Bits Int16 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (I16# x#) .&.   (I16# y#)  = I16# (word2Int# (int2Word# x# `and#` int2Word# y#))\n    (I16# x#) .|.   (I16# y#)  = I16# (word2Int# (int2Word# x# `or#`  int2Word# y#))\n    (I16# x#) `xor` (I16# y#)  = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))\n    complement (I16# x#)       = I16# (word2Int# (not# (int2Word# x#)))\n    (I16# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = I16# (narrow16Int# (x# `iShiftL#` i#))\n        | otherwise            = I16# (x# `iShiftRA#` negateInt# i#)\n    (I16# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#)  = I16# (narrow16Int# (x# `iShiftL#` i#))\n        | otherwise            = overflowError\n    (I16# x#) `unsafeShiftL` (I# i#) = I16# (narrow16Int# (x# `uncheckedIShiftL#` i#))\n    (I16# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#)  = I16# (x# `iShiftRA#` i#)\n        | otherwise            = overflowError\n    (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedIShiftRA#` i#)\n    (I16# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#)\n        = I16# x#\n        | otherwise\n        = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`\n                                         (x'# `uncheckedShiftRL#` (16# -# i'#)))))\n        where\n        !x'# = narrow16Word# (int2Word# x#)\n        !i'# = word2Int# (int2Word# i# `and#` 15##)\n    bitSizeMaybe i             = Just (finiteBitSize i)\n    bitSize i                  = finiteBitSize i\n    isSigned _                 = True\n    popCount (I16# x#)         = I# (word2Int# (popCnt16# (int2Word# x#)))\n    bit                        = bitDefault\n    testBit                    = testBitDefault\n\n-- | @since 4.6.0.0\ninstance FiniteBits Int16 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 16\n    countLeadingZeros  (I16# x#) = I# (word2Int# (clz16# (int2Word# x#)))\n    countTrailingZeros (I16# x#) = I# (word2Int# (ctz16# (int2Word# x#)))\n\n{-# RULES\n\"fromIntegral/Word8->Int16\"  fromIntegral = \\(W8# x#) -> I16# (word2Int# x#)\n\"fromIntegral/Int8->Int16\"   fromIntegral = \\(I8# x#) -> I16# x#\n\"fromIntegral/Int16->Int16\"  fromIntegral = id :: Int16 -> Int16\n\"fromIntegral/a->Int16\"      fromIntegral = \\x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#)\n\"fromIntegral/Int16->a\"      fromIntegral = \\(I16# x#) -> fromIntegral (I# x#)\n  #-}\n\n{-# RULES\n\"properFraction/Float->(Int16,Float)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Float) }\n\"truncate/Float->Int16\"\n    truncate = (fromIntegral :: Int -> Int16) . (truncate :: Float -> Int)\n\"floor/Float->Int16\"\n    floor    = (fromIntegral :: Int -> Int16) . (floor :: Float -> Int)\n\"ceiling/Float->Int16\"\n    ceiling  = (fromIntegral :: Int -> Int16) . (ceiling :: Float -> Int)\n\"round/Float->Int16\"\n    round    = (fromIntegral :: Int -> Int16) . (round  :: Float -> Int)\n  #-}\n\n{-# RULES\n\"properFraction/Double->(Int16,Double)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Double) }\n\"truncate/Double->Int16\"\n    truncate = (fromIntegral :: Int -> Int16) . (truncate :: Double -> Int)\n\"floor/Double->Int16\"\n    floor    = (fromIntegral :: Int -> Int16) . (floor :: Double -> Int)\n\"ceiling/Double->Int16\"\n    ceiling  = (fromIntegral :: Int -> Int16) . (ceiling :: Double -> Int)\n\"round/Double->Int16\"\n    round    = (fromIntegral :: Int -> Int16) . (round  :: Double -> Int)\n  #-}\n\n------------------------------------------------------------------------\n-- type Int32\n------------------------------------------------------------------------\n\n-- Int32 is represented in the same way as Int.\n#if WORD_SIZE_IN_BITS > 32\n-- Operations may assume and must ensure that it holds only values\n-- from its logical range.\n#endif\n\ndata {-# CTYPE \"HsInt32\" #-} Int32 = I32# Int#\n-- ^ 32-bit signed integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Int32 where\n    (==) = eqInt32\n    (/=) = neInt32\n\neqInt32, neInt32 :: Int32 -> Int32 -> Bool\neqInt32 (I32# x) (I32# y) = isTrue# (x ==# y)\nneInt32 (I32# x) (I32# y) = isTrue# (x /=# y)\n{-# INLINE [1] eqInt32 #-}\n{-# INLINE [1] neInt32 #-}\n\n-- | @since 2.01\ninstance Ord Int32 where\n    (<)  = ltInt32\n    (<=) = leInt32\n    (>=) = geInt32\n    (>)  = gtInt32\n\n{-# INLINE [1] gtInt32 #-}\n{-# INLINE [1] geInt32 #-}\n{-# INLINE [1] ltInt32 #-}\n{-# INLINE [1] leInt32 #-}\ngtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool\n(I32# x) `gtInt32` (I32# y) = isTrue# (x >#  y)\n(I32# x) `geInt32` (I32# y) = isTrue# (x >=# y)\n(I32# x) `ltInt32` (I32# y) = isTrue# (x <#  y)\n(I32# x) `leInt32` (I32# y) = isTrue# (x <=# y)\n\n-- | @since 2.01\ninstance Show Int32 where\n    showsPrec p x = showsPrec p (fromIntegral x :: Int)\n\n-- | @since 2.01\ninstance Num Int32 where\n    (I32# x#) + (I32# y#)  = I32# (narrow32Int# (x# +# y#))\n    (I32# x#) - (I32# y#)  = I32# (narrow32Int# (x# -# y#))\n    (I32# x#) * (I32# y#)  = I32# (narrow32Int# (x# *# y#))\n    negate (I32# x#)       = I32# (narrow32Int# (negateInt# x#))\n    abs x | x >= 0         = x\n          | otherwise      = negate x\n    signum x | x > 0       = 1\n    signum 0               = 0\n    signum _               = -1\n    fromInteger i          = I32# (narrow32Int# (integerToInt i))\n\n-- | @since 2.01\ninstance Enum Int32 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Int32\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Int32\"\n#if WORD_SIZE_IN_BITS == 32\n    toEnum (I# i#)      = I32# i#\n#else\n    toEnum i@(I# i#)\n        | i >= fromIntegral (minBound::Int32) && i <= fromIntegral (maxBound::Int32)\n                        = I32# i#\n        | otherwise     = toEnumError \"Int32\" i (minBound::Int32, maxBound::Int32)\n#endif\n    fromEnum (I32# x#)  = I# x#\n    enumFrom            = boundedEnumFrom\n    enumFromThen        = boundedEnumFromThen\n\n-- | @since 2.01\ninstance Integral Int32 where\n    quot    x@(I32# x#) y@(I32# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I32# (narrow32Int# (x# `quotInt#` y#))\n    rem       (I32# x#) y@(I32# y#)\n        | y == 0                     = divZeroError\n          -- The quotRem CPU instruction fails for minBound `quotRem` -1,\n          -- but minBound `rem` -1 is well-defined (0). We therefore\n          -- special-case it.\n        | y == (-1)                  = 0\n        | otherwise                  = I32# (narrow32Int# (x# `remInt#` y#))\n    div     x@(I32# x#) y@(I32# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I32# (narrow32Int# (x# `divInt#` y#))\n    mod       (I32# x#) y@(I32# y#)\n        | y == 0                     = divZeroError\n          -- The divMod CPU instruction fails for minBound `divMod` -1,\n          -- but minBound `mod` -1 is well-defined (0). We therefore\n          -- special-case it.\n        | y == (-1)                  = 0\n        | otherwise                  = I32# (narrow32Int# (x# `modInt#` y#))\n    quotRem x@(I32# x#) y@(I32# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `quotRemInt#` y# of\n                                       (# q, r #) ->\n                                           (I32# (narrow32Int# q),\n                                            I32# (narrow32Int# r))\n    divMod  x@(I32# x#) y@(I32# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `divModInt#` y# of\n                                       (# d, m #) ->\n                                           (I32# (narrow32Int# d),\n                                            I32# (narrow32Int# m))\n    toInteger (I32# x#)              = smallInteger x#\n\n-- | @since 2.01\ninstance Read Int32 where\n    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Bits Int32 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (I32# x#) .&.   (I32# y#)  = I32# (word2Int# (int2Word# x# `and#` int2Word# y#))\n    (I32# x#) .|.   (I32# y#)  = I32# (word2Int# (int2Word# x# `or#`  int2Word# y#))\n    (I32# x#) `xor` (I32# y#)  = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))\n    complement (I32# x#)       = I32# (word2Int# (not# (int2Word# x#)))\n    (I32# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = I32# (narrow32Int# (x# `iShiftL#` i#))\n        | otherwise            = I32# (x# `iShiftRA#` negateInt# i#)\n    (I32# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#)  = I32# (narrow32Int# (x# `iShiftL#` i#))\n        | otherwise            = overflowError\n    (I32# x#) `unsafeShiftL` (I# i#) =\n        I32# (narrow32Int# (x# `uncheckedIShiftL#` i#))\n    (I32# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#)  = I32# (x# `iShiftRA#` i#)\n        | otherwise            = overflowError\n    (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedIShiftRA#` i#)\n    (I32# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#)\n        = I32# x#\n        | otherwise\n        = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`\n                                         (x'# `uncheckedShiftRL#` (32# -# i'#)))))\n        where\n        !x'# = narrow32Word# (int2Word# x#)\n        !i'# = word2Int# (int2Word# i# `and#` 31##)\n    bitSizeMaybe i             = Just (finiteBitSize i)\n    bitSize i                  = finiteBitSize i\n    isSigned _                 = True\n    popCount (I32# x#)         = I# (word2Int# (popCnt32# (int2Word# x#)))\n    bit                        = bitDefault\n    testBit                    = testBitDefault\n\n-- | @since 4.6.0.0\ninstance FiniteBits Int32 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 32\n    countLeadingZeros  (I32# x#) = I# (word2Int# (clz32# (int2Word# x#)))\n    countTrailingZeros (I32# x#) = I# (word2Int# (ctz32# (int2Word# x#)))\n\n{-# RULES\n\"fromIntegral/Word8->Int32\"  fromIntegral = \\(W8# x#) -> I32# (word2Int# x#)\n\"fromIntegral/Word16->Int32\" fromIntegral = \\(W16# x#) -> I32# (word2Int# x#)\n\"fromIntegral/Int8->Int32\"   fromIntegral = \\(I8# x#) -> I32# x#\n\"fromIntegral/Int16->Int32\"  fromIntegral = \\(I16# x#) -> I32# x#\n\"fromIntegral/Int32->Int32\"  fromIntegral = id :: Int32 -> Int32\n\"fromIntegral/a->Int32\"      fromIntegral = \\x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#)\n\"fromIntegral/Int32->a\"      fromIntegral = \\(I32# x#) -> fromIntegral (I# x#)\n  #-}\n\n{-# RULES\n\"properFraction/Float->(Int32,Float)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Float) }\n\"truncate/Float->Int32\"\n    truncate = (fromIntegral :: Int -> Int32) . (truncate :: Float -> Int)\n\"floor/Float->Int32\"\n    floor    = (fromIntegral :: Int -> Int32) . (floor :: Float -> Int)\n\"ceiling/Float->Int32\"\n    ceiling  = (fromIntegral :: Int -> Int32) . (ceiling :: Float -> Int)\n\"round/Float->Int32\"\n    round    = (fromIntegral :: Int -> Int32) . (round  :: Float -> Int)\n  #-}\n\n{-# RULES\n\"properFraction/Double->(Int32,Double)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Double) }\n\"truncate/Double->Int32\"\n    truncate = (fromIntegral :: Int -> Int32) . (truncate :: Double -> Int)\n\"floor/Double->Int32\"\n    floor    = (fromIntegral :: Int -> Int32) . (floor :: Double -> Int)\n\"ceiling/Double->Int32\"\n    ceiling  = (fromIntegral :: Int -> Int32) . (ceiling :: Double -> Int)\n\"round/Double->Int32\"\n    round    = (fromIntegral :: Int -> Int32) . (round  :: Double -> Int)\n  #-}\n\n-- | @since 2.01\ninstance Real Int32 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Bounded Int32 where\n    minBound = -0x80000000\n    maxBound =  0x7FFFFFFF\n\n-- | @since 2.01\ninstance Ix Int32 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m\n    inRange (m,n) i     = m <= i && i <= n\n\n------------------------------------------------------------------------\n-- type Int64\n------------------------------------------------------------------------\n\n#if WORD_SIZE_IN_BITS < 64\n\ndata {-# CTYPE \"HsInt64\" #-} Int64 = I64# Int64#\n-- ^ 64-bit signed integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Int64 where\n    (==) = eqInt64\n    (/=) = neInt64\n\neqInt64, neInt64 :: Int64 -> Int64 -> Bool\neqInt64 (I64# x) (I64# y) = isTrue# (x `eqInt64#` y)\nneInt64 (I64# x) (I64# y) = isTrue# (x `neInt64#` y)\n{-# INLINE [1] eqInt64 #-}\n{-# INLINE [1] neInt64 #-}\n\n-- | @since 2.01\ninstance Ord Int64 where\n    (<)  = ltInt64\n    (<=) = leInt64\n    (>=) = geInt64\n    (>)  = gtInt64\n\n{-# INLINE [1] gtInt64 #-}\n{-# INLINE [1] geInt64 #-}\n{-# INLINE [1] ltInt64 #-}\n{-# INLINE [1] leInt64 #-}\ngtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool\n(I64# x) `gtInt64` (I64# y) = isTrue# (x `gtInt64#` y)\n(I64# x) `geInt64` (I64# y) = isTrue# (x `geInt64#` y)\n(I64# x) `ltInt64` (I64# y) = isTrue# (x `ltInt64#` y)\n(I64# x) `leInt64` (I64# y) = isTrue# (x `leInt64#` y)\n\n-- | @since 2.01\ninstance Show Int64 where\n    showsPrec p x = showsPrec p (toInteger x)\n\n-- | @since 2.01\ninstance Num Int64 where\n    (I64# x#) + (I64# y#)  = I64# (x# `plusInt64#`  y#)\n    (I64# x#) - (I64# y#)  = I64# (x# `minusInt64#` y#)\n    (I64# x#) * (I64# y#)  = I64# (x# `timesInt64#` y#)\n    negate (I64# x#)       = I64# (negateInt64# x#)\n    abs x | x >= 0         = x\n          | otherwise      = negate x\n    signum x | x > 0       = 1\n    signum 0               = 0\n    signum _               = -1\n    fromInteger i          = I64# (integerToInt64 i)\n\n-- | @since 2.01\ninstance Enum Int64 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Int64\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Int64\"\n    toEnum (I# i#)      = I64# (intToInt64# i#)\n    fromEnum x@(I64# x#)\n        | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)\n                        = I# (int64ToInt# x#)\n        | otherwise     = fromEnumError \"Int64\" x\n    enumFrom            = integralEnumFrom\n    enumFromThen        = integralEnumFromThen\n    enumFromTo          = integralEnumFromTo\n    enumFromThenTo      = integralEnumFromThenTo\n\n-- | @since 2.01\ninstance Integral Int64 where\n    quot    x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I64# (x# `quotInt64#` y#)\n    rem       (I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- The quotRem CPU instruction fails for minBound `quotRem` -1,\n          -- but minBound `rem` -1 is well-defined (0). We therefore\n          -- special-case it.\n        | y == (-1)                  = 0\n        | otherwise                  = I64# (x# `remInt64#` y#)\n    div     x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I64# (x# `divInt64#` y#)\n    mod       (I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- The divMod CPU instruction fails for minBound `divMod` -1,\n          -- but minBound `mod` -1 is well-defined (0). We therefore\n          -- special-case it.\n        | y == (-1)                  = 0\n        | otherwise                  = I64# (x# `modInt64#` y#)\n    quotRem x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = (I64# (x# `quotInt64#` y#),\n                                        I64# (x# `remInt64#` y#))\n    divMod  x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = (I64# (x# `divInt64#` y#),\n                                        I64# (x# `modInt64#` y#))\n    toInteger (I64# x)               = int64ToInteger x\n\n\ndivInt64#, modInt64# :: Int64# -> Int64# -> Int64#\n\n-- Define div in terms of quot, being careful to avoid overflow (#7233)\nx# `divInt64#` y#\n    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero)\n        = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one\n    | isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)\n        = ((x# `plusInt64#` one)  `quotInt64#` y#) `minusInt64#` one\n    | otherwise\n        = x# `quotInt64#` y#\n    where\n    !zero = intToInt64# 0#\n    !one  = intToInt64# 1#\n\nx# `modInt64#` y#\n    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero) ||\n      isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)\n        = if isTrue# (r# `neInt64#` zero) then r# `plusInt64#` y# else zero\n    | otherwise = r#\n    where\n    !zero = intToInt64# 0#\n    !r# = x# `remInt64#` y#\n\n-- | @since 2.01\ninstance Read Int64 where\n    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Bits Int64 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (I64# x#) .&.   (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#))\n    (I64# x#) .|.   (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `or64#`  int64ToWord64# y#))\n    (I64# x#) `xor` (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))\n    complement (I64# x#)       = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))\n    (I64# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL64#` i#)\n        | otherwise            = I64# (x# `iShiftRA64#` negateInt# i#)\n    (I64# x#) `shiftL` (I# i#)\n        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL64#` i#)\n        | otherwise            = overflowError\n    (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL64#` i#)\n    (I64# x#) `shiftR` (I# i#)\n        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftRA64#` i#)\n        | otherwise            = overflowError\n    (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA64#` i#)\n    (I64# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#)\n        = I64# x#\n        | otherwise\n        = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`\n                                (x'# `uncheckedShiftRL64#` (64# -# i'#))))\n        where\n        !x'# = int64ToWord64# x#\n        !i'# = word2Int# (int2Word# i# `and#` 63##)\n    bitSizeMaybe i             = Just (finiteBitSize i)\n    bitSize i                  = finiteBitSize i\n    isSigned _                 = True\n    popCount (I64# x#)         =\n        I# (word2Int# (popCnt64# (int64ToWord64# x#)))\n    bit                        = bitDefault\n    testBit                    = testBitDefault\n\n-- give the 64-bit shift operations the same treatment as the 32-bit\n-- ones (see GHC.Base), namely we wrap them in tests to catch the\n-- cases when we're shifting more than 64 bits to avoid unspecified\n-- behaviour in the C shift operations.\n\niShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64#\n\na `iShiftL64#` b  | isTrue# (b >=# 64#) = intToInt64# 0#\n                  | otherwise           = a `uncheckedIShiftL64#` b\n\na `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# 0#))\n                                          then intToInt64# (-1#)\n                                          else intToInt64# 0#\n                  | otherwise = a `uncheckedIShiftRA64#` b\n\n{-# RULES\n\"fromIntegral/Int->Int64\"    fromIntegral = \\(I#   x#) -> I64# (intToInt64# x#)\n\"fromIntegral/Word->Int64\"   fromIntegral = \\(W#   x#) -> I64# (word64ToInt64# (wordToWord64# x#))\n\"fromIntegral/Word64->Int64\" fromIntegral = \\(W64# x#) -> I64# (word64ToInt64# x#)\n\"fromIntegral/Int64->Int\"    fromIntegral = \\(I64# x#) -> I#   (int64ToInt# x#)\n\"fromIntegral/Int64->Word\"   fromIntegral = \\(I64# x#) -> W#   (int2Word# (int64ToInt# x#))\n\"fromIntegral/Int64->Word64\" fromIntegral = \\(I64# x#) -> W64# (int64ToWord64# x#)\n\"fromIntegral/Int64->Int64\"  fromIntegral = id :: Int64 -> Int64\n  #-}\n\n-- No RULES for RealFrac methods if Int is smaller than Int64, we can't\n-- go through Int and whether going through Integer is faster is uncertain.\n#else\n\n-- Int64 is represented in the same way as Int.\n-- Operations may assume and must ensure that it holds only values\n-- from its logical range.\n\ndata {-# CTYPE \"HsInt64\" #-} Int64 = I64# Int#\n-- ^ 64-bit signed integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Int64 where\n    (==) = eqInt64\n    (/=) = neInt64\n\neqInt64, neInt64 :: Int64 -> Int64 -> Bool\neqInt64 (I64# x) (I64# y) = isTrue# (x ==# y)\nneInt64 (I64# x) (I64# y) = isTrue# (x /=# y)\n{-# INLINE [1] eqInt64 #-}\n{-# INLINE [1] neInt64 #-}\n\n-- | @since 2.01\ninstance Ord Int64 where\n    (<)  = ltInt64\n    (<=) = leInt64\n    (>=) = geInt64\n    (>)  = gtInt64\n\n{-# INLINE [1] gtInt64 #-}\n{-# INLINE [1] geInt64 #-}\n{-# INLINE [1] ltInt64 #-}\n{-# INLINE [1] leInt64 #-}\ngtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool\n(I64# x) `gtInt64` (I64# y) = isTrue# (x >#  y)\n(I64# x) `geInt64` (I64# y) = isTrue# (x >=# y)\n(I64# x) `ltInt64` (I64# y) = isTrue# (x <#  y)\n(I64# x) `leInt64` (I64# y) = isTrue# (x <=# y)\n\n-- | @since 2.01\ninstance Show Int64 where\n    showsPrec p x = showsPrec p (fromIntegral x :: Int)\n\n-- | @since 2.01\ninstance Num Int64 where\n    (I64# x#) + (I64# y#)  = I64# (x# +# y#)\n    (I64# x#) - (I64# y#)  = I64# (x# -# y#)\n    (I64# x#) * (I64# y#)  = I64# (x# *# y#)\n    negate (I64# x#)       = I64# (negateInt# x#)\n    abs x | x >= 0         = x\n          | otherwise      = negate x\n    signum x | x > 0       = 1\n    signum 0               = 0\n    signum _               = -1\n    fromInteger i          = I64# (integerToInt i)\n\n-- | @since 2.01\ninstance Enum Int64 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Int64\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Int64\"\n    toEnum (I# i#)      = I64# i#\n    fromEnum (I64# x#)  = I# x#\n    enumFrom            = boundedEnumFrom\n    enumFromThen        = boundedEnumFromThen\n\n-- | @since 2.01\ninstance Integral Int64 where\n    quot    x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I64# (x# `quotInt#` y#)\n    rem       (I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- The quotRem CPU instruction fails for minBound `quotRem` -1,\n          -- but minBound `rem` -1 is well-defined (0). We therefore\n          -- special-case it.\n        | y == (-1)                  = 0\n        | otherwise                  = I64# (x# `remInt#` y#)\n    div     x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]\n        | otherwise                  = I64# (x# `divInt#` y#)\n    mod       (I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- The divMod CPU instruction fails for minBound `divMod` -1,\n          -- but minBound `mod` -1 is well-defined (0). We therefore\n          -- special-case it.\n        | y == (-1)                  = 0\n        | otherwise                  = I64# (x# `modInt#` y#)\n    quotRem x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `quotRemInt#` y# of\n                                       (# q, r #) ->\n                                           (I64# q, I64# r)\n    divMod  x@(I64# x#) y@(I64# y#)\n        | y == 0                     = divZeroError\n          -- Note [Order of tests]\n        | y == (-1) && x == minBound = (overflowError, 0)\n        | otherwise                  = case x# `divModInt#` y# of\n                                       (# d, m #) ->\n                                           (I64# d, I64# m)\n    toInteger (I64# x#)              = smallInteger x#\n\n-- | @since 2.01\ninstance Read Int64 where\n    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Bits Int64 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (I64# x#) .&.   (I64# y#)  = I64# (word2Int# (int2Word# x# `and#` int2Word# y#))\n    (I64# x#) .|.   (I64# y#)  = I64# (word2Int# (int2Word# x# `or#`  int2Word# y#))\n    (I64# x#) `xor` (I64# y#)  = I64# (word2Int# (int2Word# x# `xor#` int2Word# y#))\n    complement (I64# x#)       = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))\n    (I64# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL#` i#)\n        | otherwise            = I64# (x# `iShiftRA#` negateInt# i#)\n    (I64# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL#` i#)\n        | otherwise            = overflowError\n    (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#)\n    (I64# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftRA#` i#)\n        | otherwise            = overflowError\n    (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#)\n    (I64# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#)\n        = I64# x#\n        | otherwise\n        = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`\n                           (x'# `uncheckedShiftRL#` (64# -# i'#))))\n        where\n        !x'# = int2Word# x#\n        !i'# = word2Int# (int2Word# i# `and#` 63##)\n    bitSizeMaybe i             = Just (finiteBitSize i)\n    bitSize i                  = finiteBitSize i\n    isSigned _                 = True\n    popCount (I64# x#)         = I# (word2Int# (popCnt64# (int2Word# x#)))\n    bit                        = bitDefault\n    testBit                    = testBitDefault\n\n{-# RULES\n\"fromIntegral/a->Int64\" fromIntegral = \\x -> case fromIntegral x of I# x# -> I64# x#\n\"fromIntegral/Int64->a\" fromIntegral = \\(I64# x#) -> fromIntegral (I# x#)\n  #-}\n\n{-# RULES\n\"properFraction/Float->(Int64,Float)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Float) }\n\"truncate/Float->Int64\"\n    truncate = (fromIntegral :: Int -> Int64) . (truncate :: Float -> Int)\n\"floor/Float->Int64\"\n    floor    = (fromIntegral :: Int -> Int64) . (floor :: Float -> Int)\n\"ceiling/Float->Int64\"\n    ceiling  = (fromIntegral :: Int -> Int64) . (ceiling :: Float -> Int)\n\"round/Float->Int64\"\n    round    = (fromIntegral :: Int -> Int64) . (round  :: Float -> Int)\n  #-}\n\n{-# RULES\n\"properFraction/Double->(Int64,Double)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Double) }\n\"truncate/Double->Int64\"\n    truncate = (fromIntegral :: Int -> Int64) . (truncate :: Double -> Int)\n\"floor/Double->Int64\"\n    floor    = (fromIntegral :: Int -> Int64) . (floor :: Double -> Int)\n\"ceiling/Double->Int64\"\n    ceiling  = (fromIntegral :: Int -> Int64) . (ceiling :: Double -> Int)\n\"round/Double->Int64\"\n    round    = (fromIntegral :: Int -> Int64) . (round  :: Double -> Int)\n  #-}\n\nuncheckedIShiftL64# :: Int# -> Int# -> Int#\nuncheckedIShiftL64#  = uncheckedIShiftL#\n\nuncheckedIShiftRA64# :: Int# -> Int# -> Int#\nuncheckedIShiftRA64# = uncheckedIShiftRA#\n#endif\n\n-- | @since 4.6.0.0\ninstance FiniteBits Int64 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 64\n#if WORD_SIZE_IN_BITS < 64\n    countLeadingZeros  (I64# x#) = I# (word2Int# (clz64# (int64ToWord64# x#)))\n    countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int64ToWord64# x#)))\n#else\n    countLeadingZeros  (I64# x#) = I# (word2Int# (clz64# (int2Word# x#)))\n    countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int2Word# x#)))\n#endif\n\n-- | @since 2.01\ninstance Real Int64 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Bounded Int64 where\n    minBound = -0x8000000000000000\n    maxBound =  0x7FFFFFFFFFFFFFFF\n\n-- | @since 2.01\ninstance Ix Int64 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m\n    inRange (m,n) i     = m <= i && i <= n\n\n-------------------------------------------------------------------------------\n\n{-# RULES\n\"fromIntegral/Natural->Int8\"\n    fromIntegral = (fromIntegral :: Int -> Int8)    . naturalToInt\n\"fromIntegral/Natural->Int16\"\n    fromIntegral = (fromIntegral :: Int -> Int16)   . naturalToInt\n\"fromIntegral/Natural->Int32\"\n    fromIntegral = (fromIntegral :: Int -> Int32)   . naturalToInt\n  #-}\n\n{-# RULES\n\"fromIntegral/Int8->Natural\"\n    fromIntegral = intToNatural  . (fromIntegral :: Int8  -> Int)\n\"fromIntegral/Int16->Natural\"\n    fromIntegral = intToNatural  . (fromIntegral :: Int16 -> Int)\n\"fromIntegral/Int32->Natural\"\n    fromIntegral = intToNatural  . (fromIntegral :: Int32 -> Int)\n  #-}\n\n#if WORD_SIZE_IN_BITS == 64\n-- these RULES are valid for Word==Word64 & Int==Int64\n{-# RULES\n\"fromIntegral/Natural->Int64\"\n    fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt\n\"fromIntegral/Int64->Natural\"\n    fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)\n  #-}\n#endif\n\n\n{- Note [Order of tests]\n~~~~~~~~~~~~~~~~~~~~~~~~~\n(See Trac #3065, #5161.) Suppose we had a definition like:\n\n    quot x y\n     | y == 0                     = divZeroError\n     | x == minBound && y == (-1) = overflowError\n     | otherwise                  = x `primQuot` y\n\nNote in particular that the\n    x == minBound\ntest comes before the\n    y == (-1)\ntest.\n\nthis expands to something like:\n\n    case y of\n    0 -> divZeroError\n    _ -> case x of\n         -9223372036854775808 ->\n             case y of\n             -1 -> overflowError\n             _ -> x `primQuot` y\n         _ -> x `primQuot` y\n\nNow if we have the call (x `quot` 2), and quot gets inlined, then we get:\n\n    case 2 of\n    0 -> divZeroError\n    _ -> case x of\n         -9223372036854775808 ->\n             case 2 of\n             -1 -> overflowError\n             _ -> x `primQuot` 2\n         _ -> x `primQuot` 2\n\nwhich simplifies to:\n\n    case x of\n    -9223372036854775808 -> x `primQuot` 2\n    _                    -> x `primQuot` 2\n\nNow we have a case with two identical branches, which would be\neliminated (assuming it doesn't affect strictness, which it doesn't in\nthis case), leaving the desired:\n\n    x `primQuot` 2\n\nexcept in the minBound branch we know what x is, and GHC cleverly does\nthe division at compile time, giving:\n\n    case x of\n    -9223372036854775808 -> -4611686018427387904\n    _                    -> x `primQuot` 2\n\nSo instead we use a definition like:\n\n    quot x y\n     | y == 0                     = divZeroError\n     | y == (-1) && x == minBound = overflowError\n     | otherwise                  = x `primQuot` y\n\nwhich gives us:\n\n    case y of\n    0 -> divZeroError\n    -1 ->\n        case x of\n        -9223372036854775808 -> overflowError\n        _ -> x `primQuot` y\n    _ -> x `primQuot` y\n\nfor which our call (x `quot` 2) expands to:\n\n    case 2 of\n    0 -> divZeroError\n    -1 ->\n        case x of\n        -9223372036854775808 -> overflowError\n        _ -> x `primQuot` 2\n    _ -> x `primQuot` 2\n\nwhich simplifies to:\n\n    x `primQuot` 2\n\nas required.\n\n\n\nBut we now have the same problem with a constant numerator: the call\n(2 `quot` y) expands to\n\n    case y of\n    0 -> divZeroError\n    -1 ->\n        case 2 of\n        -9223372036854775808 -> overflowError\n        _ -> 2 `primQuot` y\n    _ -> 2 `primQuot` y\n\nwhich simplifies to:\n\n    case y of\n    0 -> divZeroError\n    -1 -> 2 `primQuot` y\n    _ -> 2 `primQuot` y\n\nwhich simplifies to:\n\n    case y of\n    0 -> divZeroError\n    -1 -> -2\n    _ -> 2 `primQuot` y\n\n\nHowever, constant denominators are more common than constant numerators,\nso the\n    y == (-1) && x == minBound\norder gives us better code in the common case.\n-}\n", "num_lines": 1271}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude\n           , BangPatterns\n           , RankNTypes\n           , MagicHash\n           , ScopedTypeVariables\n           , UnboxedTuples\n  #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO\n-- Copyright   :  (c) The University of Glasgow 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Definitions for the 'IO' monad and its friends.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO (\n        IO(..), unIO, failIO, liftIO, mplusIO,\n        unsafePerformIO, unsafeInterleaveIO,\n        unsafeDupablePerformIO, unsafeDupableInterleaveIO,\n        noDuplicate,\n\n        -- To and from from ST\n        stToIO, ioToST, unsafeIOToST, unsafeSTToIO,\n\n        FilePath,\n\n        catch, catchException, catchAny, throwIO,\n        mask, mask_, uninterruptibleMask, uninterruptibleMask_,\n        MaskingState(..), getMaskingState,\n        unsafeUnmask, interruptible,\n        onException, bracket, finally, evaluate\n    ) where\n\nimport GHC.Base\nimport GHC.ST\nimport GHC.Exception\nimport GHC.Show\nimport GHC.IO.Unsafe\n\nimport {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )\n\n-- ---------------------------------------------------------------------------\n-- The IO Monad\n\n{-\nThe IO Monad is just an instance of the ST monad, where the state thread\nis the real world.  We use the exception mechanism (in GHC.Exception) to\nimplement IO exceptions.\n\nNOTE: The IO representation is deeply wired in to various parts of the\nsystem.  The following list may or may not be exhaustive:\n\nCompiler  - types of various primitives in PrimOp.hs\n\nRTS       - forceIO (StgStartup.cmm)\n          - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast\n            (Exception.cmm)\n          - raiseAsync (RaiseAsync.c)\n\nPrelude   - GHC.IO.hs, and several other places including\n            GHC.Exception.hs.\n\nLibraries - parts of hslibs/lang.\n\n--SDM\n-}\n\nliftIO :: IO a -> State# RealWorld -> STret RealWorld a\nliftIO (IO m) = \\s -> case m s of (# s', r #) -> STret s' r\n\nfailIO :: String -> IO a\nfailIO s = IO (raiseIO# (toException (userError s)))\n\n-- ---------------------------------------------------------------------------\n-- Coercions between IO and ST\n\n-- | Embed a strict state thread in an 'IO'\n-- action.  The 'RealWorld' parameter indicates that the internal state\n-- used by the 'ST' computation is a special one supplied by the 'IO'\n-- monad, and thus distinct from those used by invocations of 'runST'.\nstToIO        :: ST RealWorld a -> IO a\nstToIO (ST m) = IO m\n\n-- | Convert an 'IO' action into an 'ST' action. The type of the result\n-- is constrained to use a 'RealWorld' state thread, and therefore the\n-- result cannot be passed to 'runST'.\nioToST        :: IO a -> ST RealWorld a\nioToST (IO m) = (ST m)\n\n-- | Convert an 'IO' action to an 'ST' action.\n-- This relies on 'IO' and 'ST' having the same representation modulo the\n-- constraint on the state thread type parameter.\nunsafeIOToST        :: IO a -> ST s a\nunsafeIOToST (IO io) = ST $ \\ s -> (unsafeCoerce# io) s\n\n-- | Convert an 'ST' action to an 'IO' action.\n-- This relies on 'IO' and 'ST' having the same representation modulo the\n-- constraint on the state thread type parameter.\n--\n-- For an example demonstrating why this is unsafe, see\n-- https://mail.haskell.org/pipermail/haskell-cafe/2009-April/060719.html\nunsafeSTToIO :: ST s a -> IO a\nunsafeSTToIO (ST m) = IO (unsafeCoerce# m)\n\n-- -----------------------------------------------------------------------------\n-- | File and directory names are values of type 'String', whose precise\n-- meaning is operating system dependent. Files can be opened, yielding a\n-- handle which can then be used to operate on the contents of that file.\n\ntype FilePath = String\n\n-- -----------------------------------------------------------------------------\n-- Primitive catch and throwIO\n\n{-\ncatchException/catch used to handle the passing around of the state to the\naction and the handler.  This turned out to be a bad idea - it meant\nthat we had to wrap both arguments in thunks so they could be entered\nas normal (remember IO returns an unboxed pair...).\n\nNow catch# has type\n\n    catch# :: IO a -> (b -> IO a) -> IO a\n\n(well almost; the compiler doesn't know about the IO newtype so we\nhave to work around that in the definition of catch below).\n-}\n\n-- | Catch an exception in the 'IO' monad.\n--\n-- Note that this function is /strict/ in the action. That is,\n-- @catchException undefined b == _|_@. See #exceptions_and_strictness#\n-- for details.\ncatchException :: Exception e => IO a -> (e -> IO a) -> IO a\ncatchException !io handler = catch io handler\n\n-- | This is the simplest of the exception-catching functions.  It\n-- takes a single argument, runs it, and if an exception is raised\n-- the \\\"handler\\\" is executed, with the value of the exception passed as an\n-- argument.  Otherwise, the result is returned as normal.  For example:\n--\n-- >   catch (readFile f)\n-- >         (\\e -> do let err = show (e :: IOException)\n-- >                   hPutStr stderr (\"Warning: Couldn't open \" ++ f ++ \": \" ++ err)\n-- >                   return \"\")\n--\n-- Note that we have to give a type signature to @e@, or the program\n-- will not typecheck as the type is ambiguous. While it is possible\n-- to catch exceptions of any type, see the section \\\"Catching all\n-- exceptions\\\" (in \"Control.Exception\") for an explanation of the problems with doing so.\n--\n-- For catching exceptions in pure (non-'IO') expressions, see the\n-- function 'evaluate'.\n--\n-- Note that due to Haskell\\'s unspecified evaluation order, an\n-- expression may throw one of several possible exceptions: consider\n-- the expression @(error \\\"urk\\\") + (1 \\`div\\` 0)@.  Does\n-- the expression throw\n-- @ErrorCall \\\"urk\\\"@, or @DivideByZero@?\n--\n-- The answer is \\\"it might throw either\\\"; the choice is\n-- non-deterministic. If you are catching any type of exception then you\n-- might catch either. If you are calling @catch@ with type\n-- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may\n-- get run with @DivideByZero@ as an argument, or an @ErrorCall \\\"urk\\\"@\n-- exception may be propogated further up. If you call it again, you\n-- might get a the opposite behaviour. This is ok, because 'catch' is an\n-- 'IO' computation.\n--\ncatch   :: Exception e\n        => IO a         -- ^ The computation to run\n        -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised\n        -> IO a\n-- See #exceptions_and_strictness#.\ncatch (IO io) handler = IO $ catch# io handler'\n    where handler' e = case fromException e of\n                       Just e' -> unIO (handler e')\n                       Nothing -> raiseIO# e\n\n\n-- | Catch any 'Exception' type in the 'IO' monad.\n--\n-- Note that this function is /strict/ in the action. That is,\n-- @catchAny undefined b == _|_@. See #exceptions_and_strictness# for\n-- details.\ncatchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a\ncatchAny !(IO io) handler = IO $ catch# io handler'\n    where handler' (SomeException e) = unIO (handler e)\n\n-- Using catchException here means that if `m` throws an\n-- 'IOError' /as an imprecise exception/, we will not catch\n-- it. No one should really be doing that anyway.\nmplusIO :: IO a -> IO a -> IO a\nmplusIO m n = m `catchException` \\ (_ :: IOError) -> n\n\n-- | A variant of 'throw' that can only be used within the 'IO' monad.\n--\n-- Although 'throwIO' has a type that is an instance of the type of 'throw', the\n-- two functions are subtly different:\n--\n-- > throw e   `seq` x  ===> throw e\n-- > throwIO e `seq` x  ===> x\n--\n-- The first example will cause the exception @e@ to be raised,\n-- whereas the second one won\\'t.  In fact, 'throwIO' will only cause\n-- an exception to be raised when it is used within the 'IO' monad.\n-- The 'throwIO' variant should be used in preference to 'throw' to\n-- raise an exception within the 'IO' monad because it guarantees\n-- ordering with respect to other 'IO' operations, whereas 'throw'\n-- does not.\nthrowIO :: Exception e => e -> IO a\nthrowIO e = IO (raiseIO# (toException e))\n\n-- -----------------------------------------------------------------------------\n-- Controlling asynchronous exception delivery\n\n-- Applying 'block' to a computation will\n-- execute that computation with asynchronous exceptions\n-- /blocked/.  That is, any thread which\n-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be\n-- blocked until asynchronous exceptions are unblocked again.  There\\'s\n-- no need to worry about re-enabling asynchronous exceptions; that is\n-- done automatically on exiting the scope of\n-- 'block'.\n--\n-- Threads created by 'Control.Concurrent.forkIO' inherit the blocked\n-- state from the parent; that is, to start a thread in blocked mode,\n-- use @block $ forkIO ...@.  This is particularly useful if you need to\n-- establish an exception handler in the forked thread before any\n-- asynchronous exceptions are received.\nblock :: IO a -> IO a\nblock (IO io) = IO $ maskAsyncExceptions# io\n\n-- To re-enable asynchronous exceptions inside the scope of\n-- 'block', 'unblock' can be\n-- used.  It scopes in exactly the same way, so on exit from\n-- 'unblock' asynchronous exception delivery will\n-- be disabled again.\nunblock :: IO a -> IO a\nunblock = unsafeUnmask\n\nunsafeUnmask :: IO a -> IO a\nunsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io\n\n-- | Allow asynchronous exceptions to be raised even inside 'mask', making\n-- the operation interruptible (see the discussion of \"Interruptible operations\"\n-- in 'Control.Exception').\n--\n-- When called outside 'mask', or inside 'uninterruptibleMask', this\n-- function has no effect.\n--\n-- @since 4.9.0.0\ninterruptible :: IO a -> IO a\ninterruptible act = do\n  st <- getMaskingState\n  case st of\n    Unmasked              -> act\n    MaskedInterruptible   -> unsafeUnmask act\n    MaskedUninterruptible -> act\n\nblockUninterruptible :: IO a -> IO a\nblockUninterruptible (IO io) = IO $ maskUninterruptible# io\n\n-- | Describes the behaviour of a thread when an asynchronous\n-- exception is received.\ndata MaskingState\n  = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)\n  | MaskedInterruptible\n      -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted\n  | MaskedUninterruptible\n      -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted\n deriving ( Eq   -- ^ @since 4.3.0.0\n          , Show -- ^ @since 4.3.0.0\n          )\n\n-- | Returns the 'MaskingState' for the current thread.\ngetMaskingState :: IO MaskingState\ngetMaskingState  = IO $ \\s ->\n  case getMaskingState# s of\n     (# s', i #) -> (# s', case i of\n                             0# -> Unmasked\n                             1# -> MaskedUninterruptible\n                             _  -> MaskedInterruptible #)\n\nonException :: IO a -> IO b -> IO a\nonException io what = io `catchException` \\e -> do _ <- what\n                                                   throwIO (e :: SomeException)\n\n-- | Executes an IO computation with asynchronous\n-- exceptions /masked/.  That is, any thread which attempts to raise\n-- an exception in the current thread with 'Control.Exception.throwTo'\n-- will be blocked until asynchronous exceptions are unmasked again.\n--\n-- The argument passed to 'mask' is a function that takes as its\n-- argument another function, which can be used to restore the\n-- prevailing masking state within the context of the masked\n-- computation.  For example, a common way to use 'mask' is to protect\n-- the acquisition of a resource:\n--\n-- > mask $ \\restore -> do\n-- >     x <- acquire\n-- >     restore (do_something_with x) `onException` release\n-- >     release\n--\n-- This code guarantees that @acquire@ is paired with @release@, by masking\n-- asynchronous exceptions for the critical parts. (Rather than write\n-- this code yourself, it would be better to use\n-- 'Control.Exception.bracket' which abstracts the general pattern).\n--\n-- Note that the @restore@ action passed to the argument to 'mask'\n-- does not necessarily unmask asynchronous exceptions, it just\n-- restores the masking state to that of the enclosing context.  Thus\n-- if asynchronous exceptions are already masked, 'mask' cannot be used\n-- to unmask exceptions again.  This is so that if you call a library function\n-- with exceptions masked, you can be sure that the library call will not be\n-- able to unmask exceptions again.  If you are writing library code and need\n-- to use asynchronous exceptions, the only way is to create a new thread;\n-- see 'Control.Concurrent.forkIOWithUnmask'.\n--\n-- Asynchronous exceptions may still be received while in the masked\n-- state if the masked thread /blocks/ in certain ways; see\n-- \"Control.Exception#interruptible\".\n--\n-- Threads created by 'Control.Concurrent.forkIO' inherit the\n-- 'MaskingState' from the parent; that is, to start a thread in the\n-- 'MaskedInterruptible' state,\n-- use @mask_ $ forkIO ...@.  This is particularly useful if you need\n-- to establish an exception handler in the forked thread before any\n-- asynchronous exceptions are received.  To create a new thread in\n-- an unmasked state use 'Control.Concurrent.forkIOWithUnmask'.\n--\nmask  :: ((forall a. IO a -> IO a) -> IO b) -> IO b\n\n-- | Like 'mask', but does not pass a @restore@ action to the argument.\nmask_ :: IO a -> IO a\n\n-- | Like 'mask', but the masked computation is not interruptible (see\n-- \"Control.Exception#interruptible\").  THIS SHOULD BE USED WITH\n-- GREAT CARE, because if a thread executing in 'uninterruptibleMask'\n-- blocks for any reason, then the thread (and possibly the program,\n-- if this is the main thread) will be unresponsive and unkillable.\n-- This function should only be necessary if you need to mask\n-- exceptions around an interruptible operation, and you can guarantee\n-- that the interruptible operation will only block for a short period\n-- of time.\n--\nuninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b\n\n-- | Like 'uninterruptibleMask', but does not pass a @restore@ action\n-- to the argument.\nuninterruptibleMask_ :: IO a -> IO a\n\nmask_ io = mask $ \\_ -> io\n\nmask io = do\n  b <- getMaskingState\n  case b of\n    Unmasked              -> block $ io unblock\n    MaskedInterruptible   -> io block\n    MaskedUninterruptible -> io blockUninterruptible\n\nuninterruptibleMask_ io = uninterruptibleMask $ \\_ -> io\n\nuninterruptibleMask io = do\n  b <- getMaskingState\n  case b of\n    Unmasked              -> blockUninterruptible $ io unblock\n    MaskedInterruptible   -> blockUninterruptible $ io block\n    MaskedUninterruptible -> io blockUninterruptible\n\nbracket\n        :: IO a         -- ^ computation to run first (\\\"acquire resource\\\")\n        -> (a -> IO b)  -- ^ computation to run last (\\\"release resource\\\")\n        -> (a -> IO c)  -- ^ computation to run in-between\n        -> IO c         -- returns the value from the in-between computation\nbracket before after thing =\n  mask $ \\restore -> do\n    a <- before\n    r <- restore (thing a) `onException` after a\n    _ <- after a\n    return r\n\nfinally :: IO a         -- ^ computation to run first\n        -> IO b         -- ^ computation to run afterward (even if an exception\n                        -- was raised)\n        -> IO a         -- returns the value from the first computation\na `finally` sequel =\n  mask $ \\restore -> do\n    r <- restore a `onException` sequel\n    _ <- sequel\n    return r\n\n-- | Evaluate the argument to weak head normal form.\n--\n-- 'evaluate' is typically used to uncover any exceptions that a lazy value\n-- may contain, and possibly handle them.\n--\n-- 'evaluate' only evaluates to /weak head normal form/. If deeper\n-- evaluation is needed, the @force@ function from @Control.DeepSeq@\n-- may be handy:\n--\n-- > evaluate $ force x\n--\n-- There is a subtle difference between @'evaluate' x@ and @'return' '$!' x@,\n-- analogous to the difference between 'throwIO' and 'throw'. If the lazy\n-- value @x@ throws an exception, @'return' '$!' x@ will fail to return an\n-- 'IO' action and will throw an exception instead. @'evaluate' x@, on the\n-- other hand, always produces an 'IO' action; that action will throw an\n-- exception upon /execution/ iff @x@ throws an exception upon /evaluation/.\n--\n-- The practical implication of this difference is that due to the\n-- /imprecise exceptions/ semantics,\n--\n-- > (return $! error \"foo\") >> error \"bar\"\n--\n-- may throw either @\"foo\"@ or @\"bar\"@, depending on the optimizations\n-- performed by the compiler. On the other hand,\n--\n-- > evaluate (error \"foo\") >> error \"bar\"\n--\n-- is guaranteed to throw @\"foo\"@.\n--\n-- The rule of thumb is to use 'evaluate' to force or handle exceptions in\n-- lazy values. If, on the other hand, you are forcing a lazy value for\n-- efficiency reasons only and do not care about exceptions, you may\n-- use @'return' '$!' x@.\nevaluate :: a -> IO a\nevaluate a = IO $ \\s -> seq# a s -- NB. see #2273, #5129\n\n{- $exceptions_and_strictness\n\nLaziness can interact with @catch@-like operations in non-obvious ways (see,\ne.g. GHC Trac #11555 and #13330). For instance, consider these subtly-different\nexamples:\n\n> test1 = Control.Exception.catch (error \"uh oh\") (\\(_ :: SomeException) -> putStrLn \"it failed\")\n>\n> test2 = GHC.IO.catchException (error \"uh oh\") (\\(_ :: SomeException) -> putStrLn \"it failed\")\n\nWhile @test1@ will print \"it failed\", @test2@ will print \"uh oh\".\n\nWhen using 'catchException', exceptions thrown while evaluating the\naction-to-be-executed will not be caught; only exceptions thrown during\nexecution of the action will be handled by the exception handler.\n\nSince this strictness is a small optimization and may lead to surprising\nresults, all of the @catch@ and @handle@ variants offered by \"Control.Exception\"\nuse 'catch' rather than 'catchException'.\n-}\n", "num_lines": 460}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, RoleAnnotations #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IOArray\n-- Copyright   :  (c) The University of Glasgow 2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The IOArray type\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IOArray (\n        IOArray(..),\n        newIOArray, unsafeReadIOArray, unsafeWriteIOArray,\n        readIOArray, writeIOArray,\n        boundsIOArray\n    ) where\n\nimport GHC.Base\nimport GHC.IO\nimport GHC.Arr\n\n-- ---------------------------------------------------------------------------\n-- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad.\n-- The type arguments are as follows:\n--\n--  * @i@: the index type of the array (should be an instance of 'Ix')\n--\n--  * @e@: the element type of the array.\n--\n--\n\nnewtype IOArray i e = IOArray (STArray RealWorld i e)\n\n-- index type should have a nominal role due to Ix class. See also #9220.\ntype role IOArray nominal representational\n\n-- explicit instance because Haddock can't figure out a derived one\n-- | @since 4.1.0.0\ninstance Eq (IOArray i e) where\n  IOArray x == IOArray y = x == y\n\n-- |Build a new 'IOArray'\nnewIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)\n{-# INLINE newIOArray #-}\nnewIOArray lu initial  = stToIO $ do {marr <- newSTArray lu initial; return (IOArray marr)}\n\n-- | Read a value from an 'IOArray'\nunsafeReadIOArray  :: IOArray i e -> Int -> IO e\n{-# INLINE unsafeReadIOArray #-}\nunsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i)\n\n-- | Write a new value into an 'IOArray'\nunsafeWriteIOArray :: IOArray i e -> Int -> e -> IO ()\n{-# INLINE unsafeWriteIOArray #-}\nunsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e)\n\n-- | Read a value from an 'IOArray'\nreadIOArray  :: Ix i => IOArray i e -> i -> IO e\nreadIOArray (IOArray marr) i = stToIO (readSTArray marr i)\n\n-- | Write a new value into an 'IOArray'\nwriteIOArray :: Ix i => IOArray i e -> i -> e -> IO ()\nwriteIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e)\n\n{-# INLINE boundsIOArray #-}\nboundsIOArray :: IOArray i e -> (i,i)\nboundsIOArray (IOArray marr) = boundsSTArray marr\n\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE BangPatterns #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IORef\n-- Copyright   :  (c) The University of Glasgow 2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The IORef type\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IORef (\n        IORef(..),\n        newIORef, readIORef, writeIORef, atomicModifyIORef2Lazy,\n        atomicModifyIORef2, atomicModifyIORefLazy_, atomicModifyIORef'_,\n        atomicModifyIORefP, atomicSwapIORef, atomicModifyIORef'\n    ) where\n\nimport GHC.Base\nimport GHC.STRef\nimport GHC.IO\n\n-- ---------------------------------------------------------------------------\n-- IORefs\n\n-- |A mutable variable in the 'IO' monad\nnewtype IORef a = IORef (STRef RealWorld a)\n  deriving Eq\n  -- ^ Pointer equality.\n  --\n  -- @since 4.0.0.0\n\n-- |Build a new 'IORef'\nnewIORef    :: a -> IO (IORef a)\nnewIORef v = stToIO (newSTRef v) >>= \\ var -> return (IORef var)\n\n-- |Read the value of an 'IORef'\nreadIORef   :: IORef a -> IO a\nreadIORef  (IORef var) = stToIO (readSTRef var)\n\n-- |Write a new value into an 'IORef'\nwriteIORef  :: IORef a -> a -> IO ()\nwriteIORef (IORef var) v = stToIO (writeSTRef var v)\n\n-- Atomically apply a function to the contents of an 'IORef',\n-- installing its first component in the 'IORef' and returning\n-- the old contents and the result of applying the function.\n-- The result of the function application (the pair) is not forced.\n-- As a result, this can lead to memory leaks. It is generally better\n-- to use 'atomicModifyIORef2'.\natomicModifyIORef2Lazy :: IORef a -> (a -> (a,b)) -> IO (a, (a, b))\natomicModifyIORef2Lazy (IORef (STRef r#)) f =\n  IO (\\s -> case atomicModifyMutVar2# r# f s of\n              (# s', old, res #) -> (# s', (old, res) #))\n\n-- Atomically apply a function to the contents of an 'IORef',\n-- installing its first component in the 'IORef' and returning\n-- the old contents and the result of applying the function.\n-- The result of the function application (the pair) is forced,\n-- but neither of its components is.\natomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b))\natomicModifyIORef2 ref f = do\n  r@(_old, (_new, _res)) <- atomicModifyIORef2Lazy ref f\n  return r\n\n-- | A version of 'Data.IORef.atomicModifyIORef' that forces\n-- the (pair) result of the function.\natomicModifyIORefP :: IORef a -> (a -> (a,b)) -> IO b\natomicModifyIORefP ref f = do\n  (_old, (_,r)) <- atomicModifyIORef2 ref f\n  pure r\n\n-- | Atomically apply a function to the contents of an\n-- 'IORef' and return the old and new values. The result\n-- of the function is not forced. As this can lead to a\n-- memory leak, it is usually better to use `atomicModifyIORef'_`.\natomicModifyIORefLazy_ :: IORef a -> (a -> a) -> IO (a, a)\natomicModifyIORefLazy_ (IORef (STRef ref)) f = IO $ \\s ->\n  case atomicModifyMutVar_# ref f s of\n    (# s', old, new #) -> (# s', (old, new) #)\n\n-- | Atomically apply a function to the contents of an\n-- 'IORef' and return the old and new values. The result\n-- of the function is forced.\natomicModifyIORef'_ :: IORef a -> (a -> a) -> IO (a, a)\natomicModifyIORef'_ ref f = do\n  (old, !new) <- atomicModifyIORefLazy_ ref f\n  return (old, new)\n\n-- | Atomically replace the contents of an 'IORef', returning\n-- the old contents.\natomicSwapIORef :: IORef a -> a -> IO a\n-- Bad implementation! This will be a primop shortly.\natomicSwapIORef (IORef (STRef ref)) new = IO $ \\s ->\n  case atomicModifyMutVar2# ref (\\_old -> Box new) s of\n    (# s', old, Box _new #) -> (# s', old #)\n\ndata Box a = Box a\n\n-- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both\n-- the value stored in the 'IORef' and the value returned. The new value\n-- is installed in the 'IORef' before the returned value is forced.\n-- So\n--\n-- @atomicModifyIORef' ref (\\x -> (x+1, undefined))@\n--\n-- will increment the 'IORef' and then throw an exception in the calling\n-- thread.\n--\n-- @since 4.6.0.0\natomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b\n-- See Note [atomicModifyIORef' definition]\natomicModifyIORef' ref f = do\n  (_old, (_new, !res)) <- atomicModifyIORef2 ref $\n    \\old -> case f old of\n       r@(!_new, _res) -> r\n  pure res\n\n-- Note [atomicModifyIORef' definition]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- atomicModifyIORef' was historically defined\n--\n--    atomicModifyIORef' ref f = do\n--        b <- atomicModifyIORef ref $ \\a ->\n--                case f a of\n--                    v@(a',_) -> a' `seq` v\n--        b `seq` return b\n--\n-- The most obvious definition, now that we have atomicModifyMutVar2#,\n-- would be\n--\n--    atomicModifyIORef' ref f = do\n--      (_old, (!_new, !res)) <- atomicModifyIORef2 ref f\n--      pure res\n--\n-- Why do we force the new value on the \"inside\" instead of afterwards?\n-- I initially thought the latter would be okay, but then I realized\n-- that if we write\n--\n--   atomicModifyIORef' ref $ \\x -> (x + 5, x - 5)\n--\n-- then we'll end up building a pair of thunks to calculate x + 5\n-- and x - 5. That's no good! With the more complicated definition,\n-- we avoid this problem; the result pair is strict in the new IORef\n-- contents. Of course, if the function passed to atomicModifyIORef'\n-- doesn't inline, we'll build a closure for it. But that was already\n-- true for the historical definition of atomicModifyIORef' (in terms\n-- of atomicModifyIORef), so we shouldn't lose anything. Note that\n-- in keeping with the historical behavior, we *don't* propagate the\n-- strict demand on the result inwards. In particular,\n--\n--   atomicModifyIORef' ref (\\x -> (x + 1, undefined))\n--\n-- will increment the IORef and throw an exception; it will not\n-- install an undefined value in the IORef.\n--\n-- A clearer version, in my opinion (but one quite incompatible with\n-- the traditional one) would only force the new IORef value and not\n-- the result. This version would have been relatively inefficient\n-- to implement using atomicModifyMutVar#, but is just fine now.\n", "num_lines": 171}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-}\n{-# LANGUAGE BangPatterns #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.List\n-- Copyright   :  (c) The University of Glasgow 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The List data type and its operations\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.List (\n   -- [] (..),          -- built-in syntax; can't be used in export list\n\n   map, (++), filter, concat,\n   head, last, tail, init, uncons, null, length, (!!),\n   foldl, foldl', foldl1, foldl1', scanl, scanl1, scanl', foldr, foldr1,\n   scanr, scanr1, iterate, iterate', repeat, replicate, cycle,\n   take, drop, sum, product, maximum, minimum, splitAt, takeWhile, dropWhile,\n   span, break, reverse, and, or,\n   any, all, elem, notElem, lookup,\n   concatMap,\n   zip, zip3, zipWith, zipWith3, unzip, unzip3,\n   errorEmptyList,\n\n ) where\n\nimport Data.Maybe\nimport GHC.Base\nimport GHC.Num (Num(..))\nimport GHC.Integer (Integer)\n\ninfixl 9  !!\ninfix  4 `elem`, `notElem`\n\n--------------------------------------------------------------\n-- List-manipulation functions\n--------------------------------------------------------------\n\n-- | /O(1)/. Extract the first element of a list, which must be non-empty.\nhead                    :: [a] -> a\nhead (x:_)              =  x\nhead []                 =  badHead\n{-# NOINLINE [1] head #-}\n\nbadHead :: a\nbadHead = errorEmptyList \"head\"\n\n-- This rule is useful in cases like\n--      head [y | (x,y) <- ps, x==t]\n{-# RULES\n\"head/build\"    forall (g::forall b.(a->b->b)->b->b) .\n                head (build g) = g (\\x _ -> x) badHead\n\"head/augment\"  forall xs (g::forall b. (a->b->b) -> b -> b) .\n                head (augment g xs) = g (\\x _ -> x) (head xs)\n #-}\n\n-- | /O(1)/. Decompose a list into its head and tail. If the list is empty,\n-- returns 'Nothing'. If the list is non-empty, returns @'Just' (x, xs)@,\n-- where @x@ is the head of the list and @xs@ its tail.\n--\n-- @since 4.8.0.0\nuncons                  :: [a] -> Maybe (a, [a])\nuncons []               = Nothing\nuncons (x:xs)           = Just (x, xs)\n\n-- | /O(1)/. Extract the elements after the head of a list, which must be\n-- non-empty.\ntail                    :: [a] -> [a]\ntail (_:xs)             =  xs\ntail []                 =  errorEmptyList \"tail\"\n\n-- | /O(n)/. Extract the last element of a list, which must be finite and\n-- non-empty.\nlast                    :: [a] -> a\n#if defined(USE_REPORT_PRELUDE)\nlast [x]                =  x\nlast (_:xs)             =  last xs\nlast []                 =  errorEmptyList \"last\"\n#else\n-- Use foldl to make last a good consumer.\n-- This will compile to good code for the actual GHC.List.last.\n-- (At least as long it is eta-expaned, otherwise it does not, #10260.)\nlast xs = foldl (\\_ x -> x) lastError xs\n{-# INLINE last #-}\n-- The inline pragma is required to make GHC remember the implementation via\n-- foldl.\nlastError :: a\nlastError = errorEmptyList \"last\"\n#endif\n\n-- | /O(n)/. Return all the elements of a list except the last one.\n-- The list must be non-empty.\ninit                    :: [a] -> [a]\n#if defined(USE_REPORT_PRELUDE)\ninit [x]                =  []\ninit (x:xs)             =  x : init xs\ninit []                 =  errorEmptyList \"init\"\n#else\n-- eliminate repeated cases\ninit []                 =  errorEmptyList \"init\"\ninit (x:xs)             =  init' x xs\n  where init' _ []     = []\n        init' y (z:zs) = y : init' z zs\n#endif\n\n-- | /O(1)/. Test whether a list is empty.\nnull                    :: [a] -> Bool\nnull []                 =  True\nnull (_:_)              =  False\n\n-- | /O(n)/. 'length' returns the length of a finite list as an 'Int'.\n-- It is an instance of the more general 'Data.List.genericLength',\n-- the result type of which may be any kind of number.\n{-# NOINLINE [1] length #-}\nlength                  :: [a] -> Int\nlength xs               = lenAcc xs 0\n\nlenAcc          :: [a] -> Int -> Int\nlenAcc []     n = n\nlenAcc (_:ys) n = lenAcc ys (n+1)\n\n{-# RULES\n\"length\" [~1] forall xs . length xs = foldr lengthFB idLength xs 0\n\"lengthList\" [1] foldr lengthFB idLength = lenAcc\n #-}\n\n-- The lambda form turns out to be necessary to make this inline\n-- when we need it to and give good performance.\n{-# INLINE [0] lengthFB #-}\nlengthFB :: x -> (Int -> Int) -> Int -> Int\nlengthFB _ r = \\ !a -> r (a + 1)\n\n{-# INLINE [0] idLength #-}\nidLength :: Int -> Int\nidLength = id\n\n-- | /O(n)/. 'filter', applied to a predicate and a list, returns the list of\n-- those elements that satisfy the predicate; i.e.,\n--\n-- > filter p xs = [ x | x <- xs, p x]\n--\n-- >>> filter odd [1, 2, 3]\n-- [1,3]\n\n{-# NOINLINE [1] filter #-}\nfilter :: (a -> Bool) -> [a] -> [a]\nfilter _pred []    = []\nfilter pred (x:xs)\n  | pred x         = x : filter pred xs\n  | otherwise      = filter pred xs\n\n{-# INLINE [0] filterFB #-} -- See Note [Inline FB functions]\nfilterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b\nfilterFB c p x r | p x       = x `c` r\n                 | otherwise = r\n\n{-# RULES\n\"filter\"     [~1] forall p xs.  filter p xs = build (\\c n -> foldr (filterFB c p) n xs)\n\"filterList\" [1]  forall p.     foldr (filterFB (:) p) [] = filter p\n\"filterFB\"        forall c p q. filterFB (filterFB c p) q = filterFB c (\\x -> q x && p x)\n #-}\n\n-- Note the filterFB rule, which has p and q the \"wrong way round\" in the RHS.\n--     filterFB (filterFB c p) q a b\n--   = if q a then filterFB c p a b else b\n--   = if q a then (if p a then c a b else b) else b\n--   = if q a && p a then c a b else b\n--   = filterFB c (\\x -> q x && p x) a b\n-- I originally wrote (\\x -> p x && q x), which is wrong, and actually\n-- gave rise to a live bug report.  SLPJ.\n\n\n-- | 'foldl', applied to a binary operator, a starting value (typically\n-- the left-identity of the operator), and a list, reduces the list\n-- using the binary operator, from left to right:\n--\n-- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn\n--\n-- The list must be finite.\n\nfoldl :: forall a b. (b -> a -> b) -> b -> [a] -> b\n{-# INLINE foldl #-}\nfoldl k z0 xs =\n  foldr (\\(v::a) (fn::b->b) -> oneShot (\\(z::b) -> fn (k z v))) (id :: b -> b) xs z0\n  -- See Note [Left folds via right fold]\n\n{-\nNote [Left folds via right fold]\n\nImplementing foldl et. al. via foldr is only a good idea if the compiler can\noptimize the resulting code (eta-expand the recursive \"go\"). See #7994.\nWe hope that one of the two measure kick in:\n\n   * Call Arity (-fcall-arity, enabled by default) eta-expands it if it can see\n     all calls and determine that the arity is large.\n   * The oneShot annotation gives a hint to the regular arity analysis that\n     it may assume that the lambda is called at most once.\n     See [One-shot lambdas] in CoreArity and especially [Eta expanding thunks]\n     in CoreArity.\n\nThe oneShot annotations used in this module are correct, as we only use them in\narguments to foldr, where we know how the arguments are called.\n\nNote [Inline FB functions]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\nAfter fusion rules successfully fire, we are usually left with one or more calls\nto list-producing functions abstracted over cons and nil. Here we call them\nFB functions because their names usually end with 'FB'. It's a good idea to\ninline FB functions because:\n\n* They are higher-order functions and therefore benefits from inlining.\n\n* When the final consumer is a left fold, inlining the FB functions is the only\n  way to make arity expansion to happen. See Note [Left fold via right fold].\n\nFor this reason we mark all FB functions INLINE [0]. The [0] phase-specifier\nensures that calls to FB functions can be written back to the original form\nwhen no fusion happens.\n\nWithout these inline pragmas, the loop in perf/should_run/T13001 won't be\nallocation-free. Also see Trac #13001.\n-}\n\n-- ----------------------------------------------------------------------------\n\n-- | A strict version of 'foldl'.\nfoldl'           :: forall a b . (b -> a -> b) -> b -> [a] -> b\n{-# INLINE foldl' #-}\nfoldl' k z0 xs =\n  foldr (\\(v::a) (fn::b->b) -> oneShot (\\(z::b) -> z `seq` fn (k z v))) (id :: b -> b) xs z0\n  -- See Note [Left folds via right fold]\n\n-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,\n-- and thus must be applied to non-empty lists.\nfoldl1                  :: (a -> a -> a) -> [a] -> a\nfoldl1 f (x:xs)         =  foldl f x xs\nfoldl1 _ []             =  errorEmptyList \"foldl1\"\n\n-- | A strict version of 'foldl1'\nfoldl1'                  :: (a -> a -> a) -> [a] -> a\nfoldl1' f (x:xs)         =  foldl' f x xs\nfoldl1' _ []             =  errorEmptyList \"foldl1'\"\n\n-- -----------------------------------------------------------------------------\n-- List sum and product\n\n-- | The 'sum' function computes the sum of a finite list of numbers.\nsum                     :: (Num a) => [a] -> a\n{-# INLINE sum #-}\nsum                     =  foldl (+) 0\n\n-- | The 'product' function computes the product of a finite list of numbers.\nproduct                 :: (Num a) => [a] -> a\n{-# INLINE product #-}\nproduct                 =  foldl (*) 1\n\n-- | /O(n)/. 'scanl' is similar to 'foldl', but returns a list of successive\n-- reduced values from the left:\n--\n-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]\n--\n-- Note that\n--\n-- > last (scanl f z xs) == foldl f z xs.\n\n-- This peculiar arrangement is necessary to prevent scanl being rewritten in\n-- its own right-hand side.\n{-# NOINLINE [1] scanl #-}\nscanl                   :: (b -> a -> b) -> b -> [a] -> [b]\nscanl                   = scanlGo\n  where\n    scanlGo           :: (b -> a -> b) -> b -> [a] -> [b]\n    scanlGo f q ls    = q : (case ls of\n                               []   -> []\n                               x:xs -> scanlGo f (f q x) xs)\n\n-- Note [scanl rewrite rules]\n{-# RULES\n\"scanl\"  [~1] forall f a bs . scanl f a bs =\n  build (\\c n -> a `c` foldr (scanlFB f c) (constScanl n) bs a)\n\"scanlList\" [1] forall f (a::a) bs .\n    foldr (scanlFB f (:)) (constScanl []) bs a = tail (scanl f a bs)\n #-}\n\n{-# INLINE [0] scanlFB #-} -- See Note [Inline FB functions]\nscanlFB :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c\nscanlFB f c = \\b g -> oneShot (\\x -> let b' = f x b in b' `c` g b')\n  -- See Note [Left folds via right fold]\n\n{-# INLINE [0] constScanl #-}\nconstScanl :: a -> b -> a\nconstScanl = const\n\n\n-- | /O(n)/. 'scanl1' is a variant of 'scanl' that has no starting value\n-- argument:\n--\n-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]\n\nscanl1                  :: (a -> a -> a) -> [a] -> [a]\nscanl1 f (x:xs)         =  scanl f x xs\nscanl1 _ []             =  []\n\n-- | /O(n)/. A strictly accumulating version of 'scanl'\n{-# NOINLINE [1] scanl' #-}\nscanl'           :: (b -> a -> b) -> b -> [a] -> [b]\n-- This peculiar form is needed to prevent scanl' from being rewritten\n-- in its own right hand side.\nscanl' = scanlGo'\n  where\n    scanlGo'           :: (b -> a -> b) -> b -> [a] -> [b]\n    scanlGo' f !q ls    = q : (case ls of\n                            []   -> []\n                            x:xs -> scanlGo' f (f q x) xs)\n\n-- Note [scanl rewrite rules]\n{-# RULES\n\"scanl'\"  [~1] forall f a bs . scanl' f a bs =\n  build (\\c n -> a `c` foldr (scanlFB' f c) (flipSeqScanl' n) bs a)\n\"scanlList'\" [1] forall f a bs .\n    foldr (scanlFB' f (:)) (flipSeqScanl' []) bs a = tail (scanl' f a bs)\n #-}\n\n{-# INLINE [0] scanlFB' #-} -- See Note [Inline FB functions]\nscanlFB' :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c\nscanlFB' f c = \\b g -> oneShot (\\x -> let !b' = f x b in b' `c` g b')\n  -- See Note [Left folds via right fold]\n\n{-# INLINE [0] flipSeqScanl' #-}\nflipSeqScanl' :: a -> b -> a\nflipSeqScanl' a !_b = a\n\n{-\nNote [scanl rewrite rules]\n~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nIn most cases, when we rewrite a form to one that can fuse, we try to rewrite it\nback to the original form if it does not fuse. For scanl, we do something a\nlittle different. In particular, we rewrite\n\nscanl f a bs\n\nto\n\nbuild (\\c n -> a `c` foldr (scanlFB f c) (constScanl n) bs a)\n\nWhen build is inlined, this becomes\n\na : foldr (scanlFB f (:)) (constScanl []) bs a\n\nTo rewrite this form back to scanl, we would need a rule that looked like\n\nforall f a bs. a : foldr (scanlFB f (:)) (constScanl []) bs a = scanl f a bs\n\nThe problem with this rule is that it has (:) at its head. This would have the\neffect of changing the way the inliner looks at (:), not only here but\neverywhere.  In most cases, this makes no difference, but in some cases it\ncauses it to come to a different decision about whether to inline something.\nBased on nofib benchmarks, this is bad for performance. Therefore, we instead\nmatch on everything past the :, which is just the tail of scanl.\n-}\n\n-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the\n-- above functions.\n\n-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,\n-- and thus must be applied to non-empty lists.\n\nfoldr1                  :: (a -> a -> a) -> [a] -> a\nfoldr1 f = go\n  where go [x]            =  x\n        go (x:xs)         =  f x (go xs)\n        go []             =  errorEmptyList \"foldr1\"\n{-# INLINE [0] foldr1 #-}\n\n-- | /O(n)/. 'scanr' is the right-to-left dual of 'scanl'.\n-- Note that\n--\n-- > head (scanr f z xs) == foldr f z xs.\n{-# NOINLINE [1] scanr #-}\nscanr                   :: (a -> b -> b) -> b -> [a] -> [b]\nscanr _ q0 []           =  [q0]\nscanr f q0 (x:xs)       =  f x q : qs\n                           where qs@(q:_) = scanr f q0 xs\n\n{-# INLINE [0] strictUncurryScanr #-}\nstrictUncurryScanr :: (a -> b -> c) -> (a, b) -> c\nstrictUncurryScanr f pair = case pair of\n                              (x, y) -> f x y\n\n{-# INLINE [0] scanrFB #-} -- See Note [Inline FB functions]\nscanrFB :: (a -> b -> b) -> (b -> c -> c) -> a -> (b, c) -> (b, c)\nscanrFB f c = \\x (r, est) -> (f x r, r `c` est)\n\n{-# RULES\n\"scanr\" [~1] forall f q0 ls . scanr f q0 ls =\n  build (\\c n -> strictUncurryScanr c (foldr (scanrFB f c) (q0,n) ls))\n\"scanrList\" [1] forall f q0 ls .\n               strictUncurryScanr (:) (foldr (scanrFB f (:)) (q0,[]) ls) =\n                 scanr f q0 ls\n #-}\n\n-- | /O(n)/. 'scanr1' is a variant of 'scanr' that has no starting value\n-- argument.\nscanr1                  :: (a -> a -> a) -> [a] -> [a]\nscanr1 _ []             =  []\nscanr1 _ [x]            =  [x]\nscanr1 f (x:xs)         =  f x q : qs\n                           where qs@(q:_) = scanr1 f xs\n\n-- | 'maximum' returns the maximum value from a list,\n-- which must be non-empty, finite, and of an ordered type.\n-- It is a special case of 'Data.List.maximumBy', which allows the\n-- programmer to supply their own comparison function.\nmaximum                 :: (Ord a) => [a] -> a\n{-# INLINABLE maximum #-}\nmaximum []              =  errorEmptyList \"maximum\"\nmaximum xs              =  foldl1 max xs\n\n-- We want this to be specialized so that with a strict max function, GHC\n-- produces good code. Note that to see if this is happending, one has to\n-- look at -ddump-prep, not -ddump-core!\n{-# SPECIALIZE  maximum :: [Int] -> Int #-}\n{-# SPECIALIZE  maximum :: [Integer] -> Integer #-}\n\n-- | 'minimum' returns the minimum value from a list,\n-- which must be non-empty, finite, and of an ordered type.\n-- It is a special case of 'Data.List.minimumBy', which allows the\n-- programmer to supply their own comparison function.\nminimum                 :: (Ord a) => [a] -> a\n{-# INLINABLE minimum #-}\nminimum []              =  errorEmptyList \"minimum\"\nminimum xs              =  foldl1 min xs\n\n{-# SPECIALIZE  minimum :: [Int] -> Int #-}\n{-# SPECIALIZE  minimum :: [Integer] -> Integer #-}\n\n\n-- | 'iterate' @f x@ returns an infinite list of repeated applications\n-- of @f@ to @x@:\n--\n-- > iterate f x == [x, f x, f (f x), ...]\n--\n-- Note that 'iterate' is lazy, potentially leading to thunk build-up if\n-- the consumer doesn't force each iterate. See 'iterate'' for a strict\n-- variant of this function.\n{-# NOINLINE [1] iterate #-}\niterate :: (a -> a) -> a -> [a]\niterate f x =  x : iterate f (f x)\n\n{-# INLINE [0] iterateFB #-} -- See Note [Inline FB functions]\niterateFB :: (a -> b -> b) -> (a -> a) -> a -> b\niterateFB c f x0 = go x0\n  where go x = x `c` go (f x)\n\n{-# RULES\n\"iterate\"    [~1] forall f x.   iterate f x = build (\\c _n -> iterateFB c f x)\n\"iterateFB\"  [1]                iterateFB (:) = iterate\n #-}\n\n\n-- | 'iterate'' is the strict version of 'iterate'.\n--\n-- It ensures that the result of each application of force to weak head normal\n-- form before proceeding.\n{-# NOINLINE [1] iterate' #-}\niterate' :: (a -> a) -> a -> [a]\niterate' f x =\n    let x' = f x\n    in x' `seq` (x : iterate' f x')\n\n{-# INLINE [0] iterate'FB #-} -- See Note [Inline FB functions]\niterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b\niterate'FB c f x0 = go x0\n  where go x =\n            let x' = f x\n            in x' `seq` (x `c` go x')\n\n{-# RULES\n\"iterate'\"    [~1] forall f x.   iterate' f x = build (\\c _n -> iterate'FB c f x)\n\"iterate'FB\"  [1]                iterate'FB (:) = iterate'\n #-}\n\n\n-- | 'repeat' @x@ is an infinite list, with @x@ the value of every element.\nrepeat :: a -> [a]\n{-# INLINE [0] repeat #-}\n-- The pragma just gives the rules more chance to fire\nrepeat x = xs where xs = x : xs\n\n{-# INLINE [0] repeatFB #-}     -- ditto -- See Note [Inline FB functions]\nrepeatFB :: (a -> b -> b) -> a -> b\nrepeatFB c x = xs where xs = x `c` xs\n\n\n{-# RULES\n\"repeat\"    [~1] forall x. repeat x = build (\\c _n -> repeatFB c x)\n\"repeatFB\"  [1]  repeatFB (:)       = repeat\n #-}\n\n-- | 'replicate' @n x@ is a list of length @n@ with @x@ the value of\n-- every element.\n-- It is an instance of the more general 'Data.List.genericReplicate',\n-- in which @n@ may be of any integral type.\n{-# INLINE replicate #-}\nreplicate               :: Int -> a -> [a]\nreplicate n x           =  take n (repeat x)\n\n-- | 'cycle' ties a finite list into a circular one, or equivalently,\n-- the infinite repetition of the original list.  It is the identity\n-- on infinite lists.\n\ncycle                   :: [a] -> [a]\ncycle []                = errorEmptyList \"cycle\"\ncycle xs                = xs' where xs' = xs ++ xs'\n\n-- | 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the\n-- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@:\n--\n-- > takeWhile (< 3) [1,2,3,4,1,2,3,4] == [1,2]\n-- > takeWhile (< 9) [1,2,3] == [1,2,3]\n-- > takeWhile (< 0) [1,2,3] == []\n--\n\n{-# NOINLINE [1] takeWhile #-}\ntakeWhile               :: (a -> Bool) -> [a] -> [a]\ntakeWhile _ []          =  []\ntakeWhile p (x:xs)\n            | p x       =  x : takeWhile p xs\n            | otherwise =  []\n\n{-# INLINE [0] takeWhileFB #-} -- See Note [Inline FB functions]\ntakeWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> b -> b\ntakeWhileFB p c n = \\x r -> if p x then x `c` r else n\n\n-- The takeWhileFB rule is similar to the filterFB rule. It works like this:\n-- takeWhileFB q (takeWhileFB p c n) n =\n-- \\x r -> if q x then (takeWhileFB p c n) x r else n =\n-- \\x r -> if q x then (\\x' r' -> if p x' then x' `c` r' else n) x r else n =\n-- \\x r -> if q x then (if p x then x `c` r else n) else n =\n-- \\x r -> if q x && p x then x `c` r else n =\n-- takeWhileFB (\\x -> q x && p x) c n\n{-# RULES\n\"takeWhile\"     [~1] forall p xs. takeWhile p xs =\n                                build (\\c n -> foldr (takeWhileFB p c n) n xs)\n\"takeWhileList\" [1]  forall p.    foldr (takeWhileFB p (:) []) [] = takeWhile p\n\"takeWhileFB\"        forall c n p q. takeWhileFB q (takeWhileFB p c n) n =\n                        takeWhileFB (\\x -> q x && p x) c n\n #-}\n\n-- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@:\n--\n-- > dropWhile (< 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3]\n-- > dropWhile (< 9) [1,2,3] == []\n-- > dropWhile (< 0) [1,2,3] == [1,2,3]\n--\n\ndropWhile               :: (a -> Bool) -> [a] -> [a]\ndropWhile _ []          =  []\ndropWhile p xs@(x:xs')\n            | p x       =  dropWhile p xs'\n            | otherwise =  xs\n\n-- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@\n-- of length @n@, or @xs@ itself if @n > 'length' xs@:\n--\n-- > take 5 \"Hello World!\" == \"Hello\"\n-- > take 3 [1,2,3,4,5] == [1,2,3]\n-- > take 3 [1,2] == [1,2]\n-- > take 3 [] == []\n-- > take (-1) [1,2] == []\n-- > take 0 [1,2] == []\n--\n-- It is an instance of the more general 'Data.List.genericTake',\n-- in which @n@ may be of any integral type.\ntake                   :: Int -> [a] -> [a]\n#if defined(USE_REPORT_PRELUDE)\ntake n _      | n <= 0 =  []\ntake _ []              =  []\ntake n (x:xs)          =  x : take (n-1) xs\n#else\n\n{- We always want to inline this to take advantage of a known length argument\nsign. Note, however, that it's important for the RULES to grab take, rather\nthan trying to INLINE take immediately and then letting the RULES grab\nunsafeTake. Presumably the latter approach doesn't grab it early enough; it led\nto an allocation regression in nofib/fft2. -}\n{-# INLINE [1] take #-}\ntake n xs | 0 < n     = unsafeTake n xs\n          | otherwise = []\n\n-- A version of take that takes the whole list if it's given an argument less\n-- than 1.\n{-# NOINLINE [1] unsafeTake #-}\nunsafeTake :: Int -> [a] -> [a]\nunsafeTake !_  []     = []\nunsafeTake 1   (x: _) = [x]\nunsafeTake m   (x:xs) = x : unsafeTake (m - 1) xs\n\n{-# RULES\n\"take\"     [~1] forall n xs . take n xs =\n  build (\\c nil -> if 0 < n\n                   then foldr (takeFB c nil) (flipSeqTake nil) xs n\n                   else nil)\n\"unsafeTakeList\"  [1] forall n xs . foldr (takeFB (:) []) (flipSeqTake []) xs n\n                                        = unsafeTake n xs\n #-}\n\n{-# INLINE [0] flipSeqTake #-}\n-- Just flip seq, specialized to Int, but not inlined too early.\n-- It's important to force the numeric argument here, even though\n-- it's not used. Otherwise, take n [] doesn't force n. This is\n-- bad for strictness analysis and unboxing, and leads to increased\n-- allocation in T7257.\nflipSeqTake :: a -> Int -> a\nflipSeqTake x !_n = x\n\n{-# INLINE [0] takeFB #-} -- See Note [Inline FB functions]\ntakeFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b\n-- The \\m accounts for the fact that takeFB is used in a higher-order\n-- way by takeFoldr, so it's better to inline.  A good example is\n--     take n (repeat x)\n-- for which we get excellent code... but only if we inline takeFB\n-- when given four arguments\ntakeFB c n x xs\n  = \\ m -> case m of\n            1 -> x `c` n\n            _ -> x `c` xs (m - 1)\n#endif\n\n-- | 'drop' @n xs@ returns the suffix of @xs@\n-- after the first @n@ elements, or @[]@ if @n > 'length' xs@:\n--\n-- > drop 6 \"Hello World!\" == \"World!\"\n-- > drop 3 [1,2,3,4,5] == [4,5]\n-- > drop 3 [1,2] == []\n-- > drop 3 [] == []\n-- > drop (-1) [1,2] == [1,2]\n-- > drop 0 [1,2] == [1,2]\n--\n-- It is an instance of the more general 'Data.List.genericDrop',\n-- in which @n@ may be of any integral type.\ndrop                   :: Int -> [a] -> [a]\n#if defined(USE_REPORT_PRELUDE)\ndrop n xs     | n <= 0 =  xs\ndrop _ []              =  []\ndrop n (_:xs)          =  drop (n-1) xs\n#else /* hack away */\n{-# INLINE drop #-}\ndrop n ls\n  | n <= 0     = ls\n  | otherwise  = unsafeDrop n ls\n  where\n    -- A version of drop that drops the whole list if given an argument\n    -- less than 1\n    unsafeDrop :: Int -> [a] -> [a]\n    unsafeDrop !_ []     = []\n    unsafeDrop 1  (_:xs) = xs\n    unsafeDrop m  (_:xs) = unsafeDrop (m - 1) xs\n#endif\n\n-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of\n-- length @n@ and second element is the remainder of the list:\n--\n-- > splitAt 6 \"Hello World!\" == (\"Hello \",\"World!\")\n-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])\n-- > splitAt 1 [1,2,3] == ([1],[2,3])\n-- > splitAt 3 [1,2,3] == ([1,2,3],[])\n-- > splitAt 4 [1,2,3] == ([1,2,3],[])\n-- > splitAt 0 [1,2,3] == ([],[1,2,3])\n-- > splitAt (-1) [1,2,3] == ([],[1,2,3])\n--\n-- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@\n-- (@splitAt _|_ xs = _|_@).\n-- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt',\n-- in which @n@ may be of any integral type.\nsplitAt                :: Int -> [a] -> ([a],[a])\n\n#if defined(USE_REPORT_PRELUDE)\nsplitAt n xs           =  (take n xs, drop n xs)\n#else\nsplitAt n ls\n  | n <= 0 = ([], ls)\n  | otherwise          = splitAt' n ls\n    where\n        splitAt' :: Int -> [a] -> ([a], [a])\n        splitAt' _  []     = ([], [])\n        splitAt' 1  (x:xs) = ([x], xs)\n        splitAt' m  (x:xs) = (x:xs', xs'')\n          where\n            (xs', xs'') = splitAt' (m - 1) xs\n#endif /* USE_REPORT_PRELUDE */\n\n-- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where\n-- first element is longest prefix (possibly empty) of @xs@ of elements that\n-- satisfy @p@ and second element is the remainder of the list:\n--\n-- > span (< 3) [1,2,3,4,1,2,3,4] == ([1,2],[3,4,1,2,3,4])\n-- > span (< 9) [1,2,3] == ([1,2,3],[])\n-- > span (< 0) [1,2,3] == ([],[1,2,3])\n--\n-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@\n\nspan                    :: (a -> Bool) -> [a] -> ([a],[a])\nspan _ xs@[]            =  (xs, xs)\nspan p xs@(x:xs')\n         | p x          =  let (ys,zs) = span p xs' in (x:ys,zs)\n         | otherwise    =  ([],xs)\n\n-- | 'break', applied to a predicate @p@ and a list @xs@, returns a tuple where\n-- first element is longest prefix (possibly empty) of @xs@ of elements that\n-- /do not satisfy/ @p@ and second element is the remainder of the list:\n--\n-- > break (> 3) [1,2,3,4,1,2,3,4] == ([1,2,3],[4,1,2,3,4])\n-- > break (< 9) [1,2,3] == ([],[1,2,3])\n-- > break (> 9) [1,2,3] == ([1,2,3],[])\n--\n-- 'break' @p@ is equivalent to @'span' ('not' . p)@.\n\nbreak                   :: (a -> Bool) -> [a] -> ([a],[a])\n#if defined(USE_REPORT_PRELUDE)\nbreak p                 =  span (not . p)\n#else\n-- HBC version (stolen)\nbreak _ xs@[]           =  (xs, xs)\nbreak p xs@(x:xs')\n           | p x        =  ([],xs)\n           | otherwise  =  let (ys,zs) = break p xs' in (x:ys,zs)\n#endif\n\n-- | 'reverse' @xs@ returns the elements of @xs@ in reverse order.\n-- @xs@ must be finite.\nreverse                 :: [a] -> [a]\n#if defined(USE_REPORT_PRELUDE)\nreverse                 =  foldl (flip (:)) []\n#else\nreverse l =  rev l []\n  where\n    rev []     a = a\n    rev (x:xs) a = rev xs (x:a)\n#endif\n\n-- | 'and' returns the conjunction of a Boolean list.  For the result to be\n-- 'True', the list must be finite; 'False', however, results from a 'False'\n-- value at a finite index of a finite or infinite list.\nand                     :: [Bool] -> Bool\n#if defined(USE_REPORT_PRELUDE)\nand                     =  foldr (&&) True\n#else\nand []          =  True\nand (x:xs)      =  x && and xs\n{-# NOINLINE [1] and #-}\n\n{-# RULES\n\"and/build\"     forall (g::forall b.(Bool->b->b)->b->b) .\n                and (build g) = g (&&) True\n #-}\n#endif\n\n-- | 'or' returns the disjunction of a Boolean list.  For the result to be\n-- 'False', the list must be finite; 'True', however, results from a 'True'\n-- value at a finite index of a finite or infinite list.\nor                      :: [Bool] -> Bool\n#if defined(USE_REPORT_PRELUDE)\nor                      =  foldr (||) False\n#else\nor []           =  False\nor (x:xs)       =  x || or xs\n{-# NOINLINE [1] or #-}\n\n{-# RULES\n\"or/build\"      forall (g::forall b.(Bool->b->b)->b->b) .\n                or (build g) = g (||) False\n #-}\n#endif\n\n-- | Applied to a predicate and a list, 'any' determines if any element\n-- of the list satisfies the predicate.  For the result to be\n-- 'False', the list must be finite; 'True', however, results from a 'True'\n-- value for the predicate applied to an element at a finite index of a finite or infinite list.\nany                     :: (a -> Bool) -> [a] -> Bool\n\n#if defined(USE_REPORT_PRELUDE)\nany p                   =  or . map p\n#else\nany _ []        = False\nany p (x:xs)    = p x || any p xs\n\n{-# NOINLINE [1] any #-}\n\n{-# RULES\n\"any/build\"     forall p (g::forall b.(a->b->b)->b->b) .\n                any p (build g) = g ((||) . p) False\n #-}\n#endif\n\n-- | Applied to a predicate and a list, 'all' determines if all elements\n-- of the list satisfy the predicate. For the result to be\n-- 'True', the list must be finite; 'False', however, results from a 'False'\n-- value for the predicate applied to an element at a finite index of a finite or infinite list.\nall                     :: (a -> Bool) -> [a] -> Bool\n#if defined(USE_REPORT_PRELUDE)\nall p                   =  and . map p\n#else\nall _ []        =  True\nall p (x:xs)    =  p x && all p xs\n\n{-# NOINLINE [1] all #-}\n\n{-# RULES\n\"all/build\"     forall p (g::forall b.(a->b->b)->b->b) .\n                all p (build g) = g ((&&) . p) True\n #-}\n#endif\n\n-- | 'elem' is the list membership predicate, usually written in infix form,\n-- e.g., @x \\`elem\\` xs@.  For the result to be\n-- 'False', the list must be finite; 'True', however, results from an element\n-- equal to @x@ found at a finite index of a finite or infinite list.\nelem                    :: (Eq a) => a -> [a] -> Bool\n#if defined(USE_REPORT_PRELUDE)\nelem x                  =  any (== x)\n#else\nelem _ []       = False\nelem x (y:ys)   = x==y || elem x ys\n{-# NOINLINE [1] elem #-}\n{-# RULES\n\"elem/build\"    forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b)\n   . elem x (build g) = g (\\ y r -> (x == y) || r) False\n #-}\n#endif\n\n-- | 'notElem' is the negation of 'elem'.\nnotElem                 :: (Eq a) => a -> [a] -> Bool\n#if defined(USE_REPORT_PRELUDE)\nnotElem x               =  all (/= x)\n#else\nnotElem _ []    =  True\nnotElem x (y:ys)=  x /= y && notElem x ys\n{-# NOINLINE [1] notElem #-}\n{-# RULES\n\"notElem/build\" forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b)\n   . notElem x (build g) = g (\\ y r -> (x /= y) && r) True\n #-}\n#endif\n\n-- | /O(n)/. 'lookup' @key assocs@ looks up a key in an association list.\n--\n-- >>> lookup 2 [(1, \"first\"), (2, \"second\"), (3, \"third\")]\n-- Just \"second\"\nlookup                  :: (Eq a) => a -> [(a,b)] -> Maybe b\nlookup _key []          =  Nothing\nlookup  key ((x,y):xys)\n    | key == x           =  Just y\n    | otherwise         =  lookup key xys\n\n-- | Map a function over a list and concatenate the results.\nconcatMap               :: (a -> [b]) -> [a] -> [b]\nconcatMap f             =  foldr ((++) . f) []\n\n{-# NOINLINE [1] concatMap #-}\n\n{-# RULES\n\"concatMap\" forall f xs . concatMap f xs =\n    build (\\c n -> foldr (\\x b -> foldr c b (f x)) n xs)\n #-}\n\n\n-- | Concatenate a list of lists.\nconcat :: [[a]] -> [a]\nconcat = foldr (++) []\n\n{-# NOINLINE [1] concat #-}\n\n{-# RULES\n  \"concat\" forall xs. concat xs =\n     build (\\c n -> foldr (\\x y -> foldr c y x) n xs)\n-- We don't bother to turn non-fusible applications of concat back into concat\n #-}\n\n-- | List index (subscript) operator, starting from 0.\n-- It is an instance of the more general 'Data.List.genericIndex',\n-- which takes an index of any integral type.\n(!!)                    :: [a] -> Int -> a\n#if defined(USE_REPORT_PRELUDE)\nxs     !! n | n < 0 =  errorWithoutStackTrace \"Prelude.!!: negative index\"\n[]     !! _         =  errorWithoutStackTrace \"Prelude.!!: index too large\"\n(x:_)  !! 0         =  x\n(_:xs) !! n         =  xs !! (n-1)\n#else\n\n-- We don't really want the errors to inline with (!!).\n-- We may want to fuss around a bit with NOINLINE, and\n-- if so we should be careful not to trip up known-bottom\n-- optimizations.\ntooLarge :: Int -> a\ntooLarge _ = errorWithoutStackTrace (prel_list_str ++ \"!!: index too large\")\n\nnegIndex :: a\nnegIndex = errorWithoutStackTrace $ prel_list_str ++ \"!!: negative index\"\n\n{-# INLINABLE (!!) #-}\nxs !! n\n  | n < 0     = negIndex\n  | otherwise = foldr (\\x r k -> case k of\n                                   0 -> x\n                                   _ -> r (k-1)) tooLarge xs n\n#endif\n\n--------------------------------------------------------------\n-- The zip family\n--------------------------------------------------------------\n\nfoldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c\nfoldr2 k z = go\n  where\n        go []    _ys     = z\n        go _xs   []      = z\n        go (x:xs) (y:ys) = k x y (go xs ys)\n{-# INLINE [0] foldr2 #-}  -- See Note [Fusion for foldrN]\n\nfoldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d\nfoldr2_left _k  z _x _r []     = z\nfoldr2_left  k _z  x  r (y:ys) = k x y (r ys)\n\n-- foldr2 k z xs ys = foldr (foldr2_left k z)  (\\_ -> z) xs ys\n{-# RULES   -- See Note [Fusion for foldrN]\n\"foldr2/left\"   forall k z ys (g::forall b.(a->b->b)->b->b) .\n                  foldr2 k z (build g) ys = g (foldr2_left  k z) (\\_ -> z) ys\n #-}\n\nfoldr3 :: (a -> b -> c -> d -> d) -> d -> [a] -> [b] -> [c] -> d\nfoldr3 k z = go\n  where\n    go  []    _      _      = z\n    go  _     []     _      = z\n    go  _     _      []     = z\n    go (a:as) (b:bs) (c:cs) = k a b c (go as bs cs)\n{-# INLINE [0] foldr3 #-}  -- See Note [Fusion for foldrN]\n\n\nfoldr3_left :: (a -> b -> c -> d -> e) -> e -> a ->\n               ([b] -> [c] -> d) -> [b] -> [c] -> e\nfoldr3_left k _z a r (b:bs) (c:cs) = k a b c (r bs cs)\nfoldr3_left _  z _ _  _      _     = z\n\n-- foldr3 k n xs ys zs = foldr (foldr3_left k n) (\\_ _ -> n) xs ys zs\n{-# RULES   -- See Note [Fusion for foldrN]\n\"foldr3/left\"   forall k z (g::forall b.(a->b->b)->b->b).\n                  foldr3 k z (build g) = g (foldr3_left k z) (\\_ _ -> z)\n #-}\n\n{- Note [Fusion for foldrN]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe arrange that foldr2, foldr3, etc is a good consumer for its first\n(left) list argument. Here's how. See below for the second, third\netc list arguments\n\n* The rule \"foldr2/left\" (active only before phase 1) does this:\n     foldr2 k z (build g) ys = g (foldr2_left  k z) (\\_ -> z) ys\n  thereby fusing away the 'build' on the left argument\n\n* To ensure this rule has a chance to fire, foldr2 has a NOINLINE[1] pragma\n\nThere used to be a \"foldr2/right\" rule, allowing foldr2 to fuse with a build\nform on the right. However, this causes trouble if the right list ends in\na bottom that is only avoided by the left list ending at that spot. That is,\nfoldr2 f z [a,b,c] (d:e:f:_|_), where the right list is produced by a build\nform, would cause the foldr2/right rule to introduce bottom. Example:\n  zip [1,2,3,4] (unfoldr (\\s -> if s > 4 then undefined else Just (s,s+1)) 1)\nshould produce\n  [(1,1),(2,2),(3,3),(4,4)]\nbut with the foldr2/right rule it would instead produce\n  (1,1):(2,2):(3,3):(4,4):_|_\n\nNote [Fusion for zipN/zipWithN]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe arrange that zip, zip3, etc, and zipWith, zipWit3 etc, are all\ngood consumers for their first (left) argument, and good producers.\nHere's how.  See Note [Fusion for foldr2] for why it can't fuse its\nsecond (right) list argument.\n\nNB: Zips for larger tuples are in the List module.\n\n* Rule \"zip\" (active only before phase 1) rewrites\n    zip xs ys = build (\\c n -> foldr2 (zipFB c) n xs ys)\n  See also Note [Inline FB functions]\n\n  Ditto rule \"zipWith\".\n\n* To give this rule a chance to fire, we give zip a NOLINLINE[1]\n  pragma (although since zip is recursive it might not need it)\n\n* Now the rules for foldr2 (see Note [Fusion for foldr2]) may fire,\n  or rules that fuse the build-produced output of zip.\n\n* If none of these fire, rule \"zipList\" (active only in phase 1)\n  rewrites the foldr2 call back to zip\n     foldr2 (zipFB (:)) []   = zip\n  This rule will only fire when build has inlined, which also\n  happens in phase 1.\n\n  Ditto rule \"zipWithList\".\n-}\n\n----------------------------------------------\n-- | /O(min(m,n))/. 'zip' takes two lists and returns a list of corresponding\n-- pairs.\n--\n-- > zip [1, 2] ['a', 'b'] = [(1, 'a'), (2, 'b')]\n--\n-- If one input list is short, excess elements of the longer list are\n-- discarded:\n--\n-- > zip [1] ['a', 'b'] = [(1, 'a')]\n-- > zip [1, 2] ['a'] = [(1, 'a')]\n--\n-- 'zip' is right-lazy:\n--\n-- > zip [] _|_ = []\n-- > zip _|_ [] = _|_\n--\n-- 'zip' is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zip #-}  -- See Note [Fusion for zipN/zipWithN]\nzip :: [a] -> [b] -> [(a,b)]\nzip []     _bs    = []\nzip _as    []     = []\nzip (a:as) (b:bs) = (a,b) : zip as bs\n\n{-# INLINE [0] zipFB #-} -- See Note [Inline FB functions]\nzipFB :: ((a, b) -> c -> d) -> a -> b -> c -> d\nzipFB c = \\x y r -> (x,y) `c` r\n\n{-# RULES  -- See Note [Fusion for zipN/zipWithN]\n\"zip\"      [~1] forall xs ys. zip xs ys = build (\\c n -> foldr2 (zipFB c) n xs ys)\n\"zipList\"  [1]  foldr2 (zipFB (:)) []   = zip\n #-}\n\n----------------------------------------------\n-- | 'zip3' takes three lists and returns a list of triples, analogous to\n-- 'zip'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zip3 #-}\nzip3 :: [a] -> [b] -> [c] -> [(a,b,c)]\n-- Specification\n-- zip3 =  zipWith3 (,,)\nzip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs\nzip3 _      _      _      = []\n\n{-# INLINE [0] zip3FB #-} -- See Note [Inline FB functions]\nzip3FB :: ((a,b,c) -> xs -> xs') -> a -> b -> c -> xs -> xs'\nzip3FB cons = \\a b c r -> (a,b,c) `cons` r\n\n{-# RULES    -- See Note [Fusion for zipN/zipWithN]\n\"zip3\"       [~1] forall as bs cs. zip3 as bs cs = build (\\c n -> foldr3 (zip3FB c) n as bs cs)\n\"zip3List\"   [1]          foldr3 (zip3FB (:)) [] = zip3\n #-}\n\n-- The zipWith family generalises the zip family by zipping with the\n-- function given as the first argument, instead of a tupling function.\n\n----------------------------------------------\n-- | /O(min(m,n))/. 'zipWith' generalises 'zip' by zipping with the function\n-- given as the first argument, instead of a tupling function. For example,\n-- @'zipWith' (+)@ is applied to two lists to produce the list of corresponding\n-- sums:\n--\n-- >>> zipWith (+) [1, 2, 3] [4, 5, 6]\n-- [5,7,9]\n--\n-- 'zipWith' is right-lazy:\n--\n-- > zipWith f [] _|_ = []\n--\n-- 'zipWith' is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zipWith #-}  -- See Note [Fusion for zipN/zipWithN]\nzipWith :: (a->b->c) -> [a]->[b]->[c]\nzipWith f = go\n  where\n    go [] _ = []\n    go _ [] = []\n    go (x:xs) (y:ys) = f x y : go xs ys\n\n-- zipWithFB must have arity 2 since it gets two arguments in the \"zipWith\"\n-- rule; it might not get inlined otherwise\n{-# INLINE [0] zipWithFB #-} -- See Note [Inline FB functions]\nzipWithFB :: (a -> b -> c) -> (d -> e -> a) -> d -> e -> b -> c\nzipWithFB c f = \\x y r -> (x `f` y) `c` r\n\n{-# RULES       -- See Note [Fusion for zipN/zipWithN]\n\"zipWith\"       [~1] forall f xs ys.    zipWith f xs ys = build (\\c n -> foldr2 (zipWithFB c f) n xs ys)\n\"zipWithList\"   [1]  forall f.  foldr2 (zipWithFB (:) f) [] = zipWith f\n  #-}\n\n-- | The 'zipWith3' function takes a function which combines three\n-- elements, as well as three lists and returns a list of their point-wise\n-- combination, analogous to 'zipWith'.\n-- It is capable of list fusion, but it is restricted to its\n-- first list argument and its resulting list.\n{-# NOINLINE [1] zipWith3 #-}\nzipWith3                :: (a->b->c->d) -> [a]->[b]->[c]->[d]\nzipWith3 z = go\n  where\n    go (a:as) (b:bs) (c:cs) = z a b c : go as bs cs\n    go _ _ _                = []\n\n{-# INLINE [0] zipWith3FB #-} -- See Note [Inline FB functions]\nzipWith3FB :: (d -> xs -> xs') -> (a -> b -> c -> d) -> a -> b -> c -> xs -> xs'\nzipWith3FB cons func = \\a b c r -> (func a b c) `cons` r\n\n{-# RULES\n\"zipWith3\"      [~1] forall f as bs cs.   zipWith3 f as bs cs = build (\\c n -> foldr3 (zipWith3FB c f) n as bs cs)\n\"zipWith3List\"  [1]  forall f.   foldr3 (zipWith3FB (:) f) [] = zipWith3 f\n #-}\n\n-- | 'unzip' transforms a list of pairs into a list of first components\n-- and a list of second components.\nunzip    :: [(a,b)] -> ([a],[b])\n{-# INLINE unzip #-}\n-- Inline so that fusion `foldr` has an opportunity to fire.\n-- See Note [Inline @unzipN@ functions] in GHC/OldList.hs.\nunzip    =  foldr (\\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])\n\n-- | The 'unzip3' function takes a list of triples and returns three\n-- lists, analogous to 'unzip'.\nunzip3   :: [(a,b,c)] -> ([a],[b],[c])\n{-# INLINE unzip3 #-}\n-- Inline so that fusion `foldr` has an opportunity to fire.\n-- See Note [Inline @unzipN@ functions] in GHC/OldList.hs.\nunzip3   =  foldr (\\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))\n                  ([],[],[])\n\n--------------------------------------------------------------\n-- Error code\n--------------------------------------------------------------\n\n-- Common up near identical calls to `error' to reduce the number\n-- constant strings created when compiled:\n\nerrorEmptyList :: String -> a\nerrorEmptyList fun =\n  errorWithoutStackTrace (prel_list_str ++ fun ++ \": empty list\")\n\nprel_list_str :: String\nprel_list_str = \"Prelude.\"\n", "num_lines": 1157}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-- | Maybe type\nmodule GHC.Maybe\n   ( Maybe (..)\n   )\nwhere\n\nimport GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base\nimport GHC.Classes\n\ndefault ()\n\n-------------------------------------------------------------------------------\n-- Maybe type\n-------------------------------------------------------------------------------\n\n-- | The 'Maybe' type encapsulates an optional value.  A value of type\n-- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@),\n-- or it is empty (represented as 'Nothing').  Using 'Maybe' is a good way to\n-- deal with errors or exceptional cases without resorting to drastic\n-- measures such as 'Prelude.error'.\n--\n-- The 'Maybe' type is also a monad.  It is a simple kind of error\n-- monad, where all errors are represented by 'Nothing'.  A richer\n-- error monad can be built using the 'Data.Either.Either' type.\n--\ndata  Maybe a  =  Nothing | Just a\n  deriving ( Eq  -- ^ @since 2.01\n           , Ord -- ^ @since 2.01\n           )\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.MVar\n-- Copyright   :  (c) The University of Glasgow 2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The MVar type\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.MVar (\n        -- * MVars\n          MVar(..)\n        , newMVar\n        , newEmptyMVar\n        , takeMVar\n        , readMVar\n        , putMVar\n        , tryTakeMVar\n        , tryPutMVar\n        , tryReadMVar\n        , isEmptyMVar\n        , addMVarFinalizer\n    ) where\n\nimport GHC.Base\n\ndata MVar a = MVar (MVar# RealWorld a)\n{- ^\nAn 'MVar' (pronounced \\\"em-var\\\") is a synchronising variable, used\nfor communication between concurrent threads.  It can be thought of\nas a box, which may be empty or full.\n-}\n\n-- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module\n-- | @since 4.1.0.0\ninstance Eq (MVar a) where\n        (MVar mvar1#) == (MVar mvar2#) = isTrue# (sameMVar# mvar1# mvar2#)\n\n{-\nM-Vars are rendezvous points for concurrent threads.  They begin\nempty, and any attempt to read an empty M-Var blocks.  When an M-Var\nis written, a single blocked thread may be freed.  Reading an M-Var\ntoggles its state from full back to empty.  Therefore, any value\nwritten to an M-Var may only be read once.  Multiple reads and writes\nare allowed, but there must be at least one read between any two\nwrites.\n-}\n\n--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)\n\n-- |Create an 'MVar' which is initially empty.\nnewEmptyMVar  :: IO (MVar a)\nnewEmptyMVar = IO $ \\ s# ->\n    case newMVar# s# of\n         (# s2#, svar# #) -> (# s2#, MVar svar# #)\n\n-- |Create an 'MVar' which contains the supplied value.\nnewMVar :: a -> IO (MVar a)\nnewMVar value =\n    newEmptyMVar        >>= \\ mvar ->\n    putMVar mvar value  >>\n    return mvar\n\n-- |Return the contents of the 'MVar'.  If the 'MVar' is currently\n-- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar',\n-- the 'MVar' is left empty.\n--\n-- There are two further important properties of 'takeMVar':\n--\n--   * 'takeMVar' is single-wakeup.  That is, if there are multiple\n--     threads blocked in 'takeMVar', and the 'MVar' becomes full,\n--     only one thread will be woken up.  The runtime guarantees that\n--     the woken thread completes its 'takeMVar' operation.\n--\n--   * When multiple threads are blocked on an 'MVar', they are\n--     woken up in FIFO order.  This is useful for providing\n--     fairness properties of abstractions built using 'MVar's.\n--\ntakeMVar :: MVar a -> IO a\ntakeMVar (MVar mvar#) = IO $ \\ s# -> takeMVar# mvar# s#\n\n-- |Atomically read the contents of an 'MVar'.  If the 'MVar' is\n-- currently empty, 'readMVar' will wait until it is full.\n-- 'readMVar' is guaranteed to receive the next 'putMVar'.\n--\n-- 'readMVar' is multiple-wakeup, so when multiple readers are\n-- blocked on an 'MVar', all of them are woken up at the same time.\n--\n-- /Compatibility note:/ Prior to base 4.7, 'readMVar' was a combination\n-- of 'takeMVar' and 'putMVar'.  This mean that in the presence of\n-- other threads attempting to 'putMVar', 'readMVar' could block.\n-- Furthermore, 'readMVar' would not receive the next 'putMVar' if there\n-- was already a pending thread blocked on 'takeMVar'.  The old behavior\n-- can be recovered by implementing 'readMVar as follows:\n--\n-- @\n--  readMVar :: MVar a -> IO a\n--  readMVar m =\n--    mask_ $ do\n--      a <- takeMVar m\n--      putMVar m a\n--      return a\n-- @\nreadMVar :: MVar a -> IO a\nreadMVar (MVar mvar#) = IO $ \\ s# -> readMVar# mvar# s#\n\n-- |Put a value into an 'MVar'.  If the 'MVar' is currently full,\n-- 'putMVar' will wait until it becomes empty.\n--\n-- There are two further important properties of 'putMVar':\n--\n--   * 'putMVar' is single-wakeup.  That is, if there are multiple\n--     threads blocked in 'putMVar', and the 'MVar' becomes empty,\n--     only one thread will be woken up.  The runtime guarantees that\n--     the woken thread completes its 'putMVar' operation.\n--\n--   * When multiple threads are blocked on an 'MVar', they are\n--     woken up in FIFO order.  This is useful for providing\n--     fairness properties of abstractions built using 'MVar's.\n--\nputMVar  :: MVar a -> a -> IO ()\nputMVar (MVar mvar#) x = IO $ \\ s# ->\n    case putMVar# mvar# x s# of\n        s2# -> (# s2#, () #)\n\n-- |A non-blocking version of 'takeMVar'.  The 'tryTakeMVar' function\n-- returns immediately, with 'Nothing' if the 'MVar' was empty, or\n-- @'Just' a@ if the 'MVar' was full with contents @a@.  After 'tryTakeMVar',\n-- the 'MVar' is left empty.\ntryTakeMVar :: MVar a -> IO (Maybe a)\ntryTakeMVar (MVar m) = IO $ \\ s ->\n    case tryTakeMVar# m s of\n        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty\n        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full\n\n-- |A non-blocking version of 'putMVar'.  The 'tryPutMVar' function\n-- attempts to put the value @a@ into the 'MVar', returning 'True' if\n-- it was successful, or 'False' otherwise.\ntryPutMVar  :: MVar a -> a -> IO Bool\ntryPutMVar (MVar mvar#) x = IO $ \\ s# ->\n    case tryPutMVar# mvar# x s# of\n        (# s, 0# #) -> (# s, False #)\n        (# s, _  #) -> (# s, True #)\n\n-- |A non-blocking version of 'readMVar'.  The 'tryReadMVar' function\n-- returns immediately, with 'Nothing' if the 'MVar' was empty, or\n-- @'Just' a@ if the 'MVar' was full with contents @a@.\n--\n-- @since 4.7.0.0\ntryReadMVar :: MVar a -> IO (Maybe a)\ntryReadMVar (MVar m) = IO $ \\ s ->\n    case tryReadMVar# m s of\n        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty\n        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full\n\n-- |Check whether a given 'MVar' is empty.\n--\n-- Notice that the boolean value returned  is just a snapshot of\n-- the state of the MVar. By the time you get to react on its result,\n-- the MVar may have been filled (or emptied) - so be extremely\n-- careful when using this operation.   Use 'tryTakeMVar' instead if possible.\nisEmptyMVar :: MVar a -> IO Bool\nisEmptyMVar (MVar mv#) = IO $ \\ s# ->\n    case isEmptyMVar# mv# s# of\n        (# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)\n\n-- |Add a finalizer to an 'MVar' (GHC only).  See \"Foreign.ForeignPtr\" and\n-- \"System.Mem.Weak\" for more about finalizers.\naddMVarFinalizer :: MVar a -> IO () -> IO ()\naddMVarFinalizer (MVar m) (IO finalizer) =\n    IO $ \\s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }\n\n", "num_lines": 183}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Natural\n-- Copyright   :  (C) 2014 Herbert Valerio Riedel,\n--                (C) 2011 Edward Kmett\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The arbitrary-precision 'Natural' number type.\n--\n-- __Note__: This is an internal GHC module with an API subject to\n-- change.  It's recommended use the \"Numeric.Natural\" module to import\n-- the 'Natural' type.\n--\n-- @since 4.8.0.0\n-----------------------------------------------------------------------------\nmodule GHC.Natural\n    ( -- * The 'Natural' number type\n      --\n      -- | __Warning__: The internal implementation of 'Natural'\n      -- (i.e. which constructors are available) depends on the\n      -- 'Integer' backend used!\n      Natural(..)\n    , mkNatural\n    , isValidNatural\n      -- * Arithmetic\n    , plusNatural\n    , minusNatural\n    , minusNaturalMaybe\n    , timesNatural\n    , negateNatural\n    , signumNatural\n    , quotRemNatural\n    , quotNatural\n    , remNatural\n    , gcdNatural\n    , lcmNatural\n      -- * Bits\n    , andNatural\n    , orNatural\n    , xorNatural\n    , bitNatural\n    , testBitNatural\n    , popCountNatural\n    , shiftLNatural\n    , shiftRNatural\n      -- * Conversions\n    , naturalToInteger\n    , naturalToWord\n    , naturalToInt\n    , naturalFromInteger\n    , wordToNatural\n    , intToNatural\n    , naturalToWordMaybe\n    , wordToNatural#\n    , wordToNaturalBase\n      -- * Modular arithmetic\n    , powModNatural\n    ) where\n\n#include \"MachDeps.h\"\n\nimport GHC.Classes\nimport GHC.Maybe\nimport GHC.Types\nimport GHC.Prim\nimport {-# SOURCE #-} GHC.Exception.Type (underflowException, divZeroException)\n#if defined(MIN_VERSION_integer_gmp)\nimport GHC.Integer.GMP.Internals\n#else\nimport GHC.Integer\n#endif\n\ndefault ()\n\n-- Most high-level operations need to be marked `NOINLINE` as\n-- otherwise GHC doesn't recognize them and fails to apply constant\n-- folding to `Natural`-typed expression.\n--\n-- To this end, the CPP hack below allows to write the pseudo-pragma\n--\n--   {-# CONSTANT_FOLDED plusNatural #-}\n--\n-- which is simply expanded into a\n--\n--   {-# NOINLINE plusNatural #-}\n--\n--\n-- TODO: Note that some functions have commented CONSTANT_FOLDED annotations,\n-- that's because the Integer counter-parts of these functions do actually have\n-- a builtinRule in PrelRules, where the Natural functions do not. The plan is\n-- to eventually also add builtin rules for those functions on Natural.\n#define CONSTANT_FOLDED NOINLINE\n\n-------------------------------------------------------------------------------\n-- Arithmetic underflow\n-------------------------------------------------------------------------------\n\n-- We put them here because they are needed relatively early\n-- in the libraries before the Exception type has been defined yet.\n\n{-# NOINLINE underflowError #-}\nunderflowError :: a\nunderflowError = raise# underflowException\n\n{-# NOINLINE divZeroError #-}\ndivZeroError :: a\ndivZeroError = raise# divZeroException\n\n-------------------------------------------------------------------------------\n-- Natural type\n-------------------------------------------------------------------------------\n\n#if defined(MIN_VERSION_integer_gmp)\n-- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0'\n\n-- | Type representing arbitrary-precision non-negative integers.\n--\n-- >>> 2^100 :: Natural\n-- 1267650600228229401496703205376\n--\n-- Operations whose result would be negative @'Control.Exception.throw'\n-- ('Control.Exception.Underflow' :: 'Control.Exception.ArithException')@,\n--\n-- >>> -1 :: Natural\n-- *** Exception: arithmetic underflow\n--\n-- @since 4.8.0.0\ndata Natural = NatS#                 GmpLimb# -- ^ in @[0, maxBound::Word]@\n             | NatJ# {-# UNPACK #-} !BigNat   -- ^ in @]maxBound::Word, +inf[@\n                                              --\n                                              -- __Invariant__: 'NatJ#' is used\n                                              -- /iff/ value doesn't fit in\n                                              -- 'NatS#' constructor.\n                               -- NB: Order of constructors *must*\n                               -- coincide with 'Ord' relation\n             deriving ( Eq  -- ^ @since 4.8.0.0\n                      , Ord -- ^ @since 4.8.0.0\n                      )\n\n\n-- | Test whether all internal invariants are satisfied by 'Natural' value\n--\n-- This operation is mostly useful for test-suites and/or code which\n-- constructs 'Integer' values directly.\n--\n-- @since 4.8.0.0\nisValidNatural :: Natural -> Bool\nisValidNatural (NatS# _)  = True\nisValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)\n                            && isTrue# (sizeofBigNat# bn ># 0#)\n\nsignumNatural :: Natural -> Natural\nsignumNatural (NatS# 0##) = NatS# 0##\nsignumNatural _           = NatS# 1##\n-- {-# CONSTANT_FOLDED signumNatural #-}\n\nnegateNatural :: Natural -> Natural\nnegateNatural (NatS# 0##) = NatS# 0##\nnegateNatural _           = underflowError\n-- {-# CONSTANT_FOLDED negateNatural #-}\n\n-- | @since 4.10.0.0\nnaturalFromInteger :: Integer -> Natural\nnaturalFromInteger (S# i#)\n  | isTrue# (i# >=# 0#)     = NatS# (int2Word# i#)\nnaturalFromInteger (Jp# bn) = bigNatToNatural bn\nnaturalFromInteger _        = underflowError\n{-# CONSTANT_FOLDED naturalFromInteger #-}\n\n-- | Compute greatest common divisor.\ngcdNatural :: Natural -> Natural -> Natural\ngcdNatural (NatS# 0##) y       = y\ngcdNatural x       (NatS# 0##) = x\ngcdNatural (NatS# 1##) _       = NatS# 1##\ngcdNatural _       (NatS# 1##) = NatS# 1##\ngcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y)\ngcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y)\ngcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x)\ngcdNatural (NatS# x) (NatS# y) = NatS# (gcdWord x y)\n\n-- | Compute least common multiple.\nlcmNatural :: Natural -> Natural -> Natural\nlcmNatural (NatS# 0##) _ = NatS# 0##\nlcmNatural _ (NatS# 0##) = NatS# 0##\nlcmNatural (NatS# 1##) y = y\nlcmNatural x (NatS# 1##) = x\nlcmNatural x y           = (x `quotNatural` (gcdNatural x y)) `timesNatural` y\n\n----------------------------------------------------------------------------\n\nquotRemNatural :: Natural -> Natural -> (Natural, Natural)\nquotRemNatural _ (NatS# 0##) = divZeroError\nquotRemNatural n (NatS# 1##) = (n,NatS# 0##)\nquotRemNatural n@(NatS# _) (NatJ# _) = (NatS# 0##, n)\nquotRemNatural (NatS# n) (NatS# d) = case quotRemWord# n d of\n    (# q, r #) -> (NatS# q, NatS# r)\nquotRemNatural (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of\n    (# q, r #) -> (bigNatToNatural q, NatS# r)\nquotRemNatural (NatJ# n) (NatJ# d) = case quotRemBigNat n d of\n    (# q, r #) -> (bigNatToNatural q, bigNatToNatural r)\n-- {-# CONSTANT_FOLDED quotRemNatural #-}\n\nquotNatural :: Natural -> Natural -> Natural\nquotNatural _       (NatS# 0##) = divZeroError\nquotNatural n       (NatS# 1##) = n\nquotNatural (NatS# _) (NatJ# _) = NatS# 0##\nquotNatural (NatS# n) (NatS# d) = NatS# (quotWord# n d)\nquotNatural (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)\nquotNatural (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)\n-- {-# CONSTANT_FOLDED quotNatural #-}\n\nremNatural :: Natural -> Natural -> Natural\nremNatural _         (NatS# 0##) = divZeroError\nremNatural _         (NatS# 1##) = NatS# 0##\nremNatural n@(NatS# _) (NatJ# _) = n\nremNatural   (NatS# n) (NatS# d) = NatS# (remWord# n d)\nremNatural   (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)\nremNatural   (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)\n-- {-# CONSTANT_FOLDED remNatural #-}\n\n-- | @since 4.X.0.0\nnaturalToInteger :: Natural -> Integer\nnaturalToInteger (NatS# w)  = wordToInteger w\nnaturalToInteger (NatJ# bn) = Jp# bn\n{-# CONSTANT_FOLDED naturalToInteger #-}\n\nandNatural :: Natural -> Natural -> Natural\nandNatural (NatS# n) (NatS# m) = NatS# (n `and#` m)\nandNatural (NatS# n) (NatJ# m) = NatS# (n `and#` bigNatToWord m)\nandNatural (NatJ# n) (NatS# m) = NatS# (bigNatToWord n `and#` m)\nandNatural (NatJ# n) (NatJ# m) = bigNatToNatural (andBigNat n m)\n-- {-# CONSTANT_FOLDED andNatural #-}\n\norNatural :: Natural -> Natural -> Natural\norNatural (NatS# n) (NatS# m) = NatS# (n `or#` m)\norNatural (NatS# n) (NatJ# m) = NatJ# (orBigNat (wordToBigNat n) m)\norNatural (NatJ# n) (NatS# m) = NatJ# (orBigNat n (wordToBigNat m))\norNatural (NatJ# n) (NatJ# m) = NatJ# (orBigNat n m)\n-- {-# CONSTANT_FOLDED orNatural #-}\n\nxorNatural :: Natural -> Natural -> Natural\nxorNatural (NatS# n) (NatS# m) = NatS# (n `xor#` m)\nxorNatural (NatS# n) (NatJ# m) = NatJ# (xorBigNat (wordToBigNat n) m)\nxorNatural (NatJ# n) (NatS# m) = NatJ# (xorBigNat n (wordToBigNat m))\nxorNatural (NatJ# n) (NatJ# m) = bigNatToNatural (xorBigNat n m)\n-- {-# CONSTANT_FOLDED xorNatural #-}\n\nbitNatural :: Int# -> Natural\nbitNatural i#\n  | isTrue# (i# <# WORD_SIZE_IN_BITS#) = NatS# (1## `uncheckedShiftL#` i#)\n  | True                               = NatJ# (bitBigNat i#)\n-- {-# CONSTANT_FOLDED bitNatural #-}\n\ntestBitNatural :: Natural -> Int -> Bool\ntestBitNatural (NatS# w) (I# i#)\n  | isTrue# (i# <# WORD_SIZE_IN_BITS#) =\n      isTrue# ((w `and#` (1## `uncheckedShiftL#` i#)) `neWord#` 0##)\n  | True                               = False\ntestBitNatural (NatJ# bn) (I# i#)      = testBitBigNat bn i#\n-- {-# CONSTANT_FOLDED testBitNatural #-}\n\npopCountNatural :: Natural -> Int\npopCountNatural (NatS# w)  = I# (word2Int# (popCnt# w))\npopCountNatural (NatJ# bn) = I# (popCountBigNat bn)\n-- {-# CONSTANT_FOLDED popCountNatural #-}\n\nshiftLNatural :: Natural -> Int -> Natural\nshiftLNatural n           (I# 0#) = n\nshiftLNatural (NatS# 0##) _       = NatS# 0##\nshiftLNatural (NatS# 1##) (I# i#) = bitNatural i#\nshiftLNatural (NatS# w) (I# i#)\n    = bigNatToNatural (shiftLBigNat (wordToBigNat w) i#)\nshiftLNatural (NatJ# bn) (I# i#)\n    = bigNatToNatural (shiftLBigNat bn i#)\n-- {-# CONSTANT_FOLDED shiftLNatural #-}\n\nshiftRNatural :: Natural -> Int -> Natural\nshiftRNatural n          (I# 0#) = n\nshiftRNatural (NatS# w)  (I# i#)\n      | isTrue# (i# >=# WORD_SIZE_IN_BITS#) = NatS# 0##\n      | True = NatS# (w `uncheckedShiftRL#` i#)\nshiftRNatural (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)\n-- {-# CONSTANT_FOLDED shiftRNatural #-}\n\n----------------------------------------------------------------------------\n\n-- | 'Natural' Addition\nplusNatural :: Natural -> Natural -> Natural\nplusNatural (NatS# 0##) y         = y\nplusNatural x         (NatS# 0##) = x\nplusNatural (NatS# x) (NatS# y)\n    = case plusWord2# x y of\n       (# 0##, l #) -> NatS# l\n       (# h,   l #) -> NatJ# (wordToBigNat2 h l)\nplusNatural (NatS# x) (NatJ# y) = NatJ# (plusBigNatWord y x)\nplusNatural (NatJ# x) (NatS# y) = NatJ# (plusBigNatWord x y)\nplusNatural (NatJ# x) (NatJ# y) = NatJ# (plusBigNat     x y)\n{-# CONSTANT_FOLDED plusNatural #-}\n\n-- | 'Natural' multiplication\ntimesNatural :: Natural -> Natural -> Natural\ntimesNatural _         (NatS# 0##) = NatS# 0##\ntimesNatural (NatS# 0##) _         = NatS# 0##\ntimesNatural x         (NatS# 1##) = x\ntimesNatural (NatS# 1##) y         = y\ntimesNatural (NatS# x) (NatS# y) = case timesWord2# x y of\n    (# 0##, 0## #) -> NatS# 0##\n    (# 0##, xy  #) -> NatS# xy\n    (# h  , l   #) -> NatJ# (wordToBigNat2 h l)\ntimesNatural (NatS# x) (NatJ# y) = NatJ# (timesBigNatWord y x)\ntimesNatural (NatJ# x) (NatS# y) = NatJ# (timesBigNatWord x y)\ntimesNatural (NatJ# x) (NatJ# y) = NatJ# (timesBigNat     x y)\n{-# CONSTANT_FOLDED timesNatural #-}\n\n-- | 'Natural' subtraction. May @'Control.Exception.throw'\n-- 'Control.Exception.Underflow'@.\nminusNatural :: Natural -> Natural -> Natural\nminusNatural x         (NatS# 0##) = x\nminusNatural (NatS# x) (NatS# y) = case subWordC# x y of\n    (# l, 0# #) -> NatS# l\n    _           -> underflowError\nminusNatural (NatS# _) (NatJ# _) = underflowError\nminusNatural (NatJ# x) (NatS# y)\n    = bigNatToNatural (minusBigNatWord x y)\nminusNatural (NatJ# x) (NatJ# y)\n    = bigNatToNatural (minusBigNat     x y)\n{-# CONSTANT_FOLDED minusNatural #-}\n\n-- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.\n--\n-- @since 4.8.0.0\nminusNaturalMaybe :: Natural -> Natural -> Maybe Natural\nminusNaturalMaybe x         (NatS# 0##) = Just x\nminusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of\n    (# l, 0# #) -> Just (NatS# l)\n    _           -> Nothing\nminusNaturalMaybe (NatS# _) (NatJ# _) = Nothing\nminusNaturalMaybe (NatJ# x) (NatS# y)\n    = Just (bigNatToNatural (minusBigNatWord x y))\nminusNaturalMaybe (NatJ# x) (NatJ# y)\n  | isTrue# (isNullBigNat# res) = Nothing\n  | True                        = Just (bigNatToNatural res)\n  where\n    res = minusBigNat x y\n\n-- | Convert 'BigNat' to 'Natural'.\n-- Throws 'Control.Exception.Underflow' if passed a 'nullBigNat'.\nbigNatToNatural :: BigNat -> Natural\nbigNatToNatural bn\n  | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)\n  | isTrue# (isNullBigNat# bn)        = underflowError\n  | True                              = NatJ# bn\n\nnaturalToBigNat :: Natural -> BigNat\nnaturalToBigNat (NatS# w#) = wordToBigNat w#\nnaturalToBigNat (NatJ# bn) = bn\n\nnaturalToWord :: Natural -> Word\nnaturalToWord (NatS# w#) = W# w#\nnaturalToWord (NatJ# bn) = W# (bigNatToWord bn)\n\nnaturalToInt :: Natural -> Int\nnaturalToInt (NatS# w#) = I# (word2Int# w#)\nnaturalToInt (NatJ# bn) = I# (bigNatToInt bn)\n\n----------------------------------------------------------------------------\n\n-- | Convert a Word# into a Natural\n--\n-- Built-in rule ensures that applications of this function to literal Word# are\n-- lifted into Natural literals.\nwordToNatural# :: Word# -> Natural\nwordToNatural# w# = NatS# w#\n{-# CONSTANT_FOLDED wordToNatural# #-}\n\n-- | Convert a Word# into a Natural\n--\n-- In base we can't use wordToNatural# as built-in rules transform some of them\n-- into Natural literals. Use this function instead.\nwordToNaturalBase :: Word# -> Natural\nwordToNaturalBase w# = NatS# w#\n\n#else /* !defined(MIN_VERSION_integer_gmp) */\n----------------------------------------------------------------------------\n-- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package\n\n-- | Type representing arbitrary-precision non-negative integers.\n--\n-- Operations whose result would be negative @'Control.Exception.throw'\n-- ('Control.Exception.Underflow' :: 'Control.Exception.ArithException')@.\n--\n-- @since 4.8.0.0\nnewtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer'\n                  deriving (Eq,Ord)\n\n\n-- | Test whether all internal invariants are satisfied by 'Natural' value\n--\n-- This operation is mostly useful for test-suites and/or code which\n-- constructs 'Natural' values directly.\n--\n-- @since 4.8.0.0\nisValidNatural :: Natural -> Bool\nisValidNatural (Natural i) = i >= wordToInteger 0##\n\n-- | Convert a 'Word#' into a 'Natural'\n--\n-- Built-in rule ensures that applications of this function to literal 'Word#'\n-- are lifted into 'Natural' literals.\nwordToNatural# :: Word# -> Natural\nwordToNatural# w## = Natural (wordToInteger w##)\n{-# CONSTANT_FOLDED wordToNatural# #-}\n\n-- | Convert a 'Word#' into a Natural\n--\n-- In base we can't use wordToNatural# as built-in rules transform some of them\n-- into Natural literals. Use this function instead.\nwordToNaturalBase :: Word# -> Natural\nwordToNaturalBase w## = Natural (wordToInteger w##)\n\n-- | @since 4.10.0.0\nnaturalFromInteger :: Integer -> Natural\nnaturalFromInteger n\n  | n >= wordToInteger 0## = Natural n\n  | True                   = underflowError\n{-# INLINE naturalFromInteger #-}\n\n\n-- | Compute greatest common divisor.\ngcdNatural :: Natural -> Natural -> Natural\ngcdNatural (Natural n) (Natural m) = Natural (n `gcdInteger` m)\n\n-- | Compute lowest common multiple.\nlcmNatural :: Natural -> Natural -> Natural\nlcmNatural (Natural n) (Natural m) = Natural (n `lcmInteger` m)\n\n-- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.\n--\n-- @since 4.8.0.0\nminusNaturalMaybe :: Natural -> Natural -> Maybe Natural\nminusNaturalMaybe (Natural x) (Natural y)\n  | x >= y  = Just (Natural (x `minusInteger` y))\n  | True    = Nothing\n\nshiftLNatural :: Natural -> Int -> Natural\nshiftLNatural (Natural n) (I# i) = Natural (n `shiftLInteger` i)\n-- {-# CONSTANT_FOLDED shiftLNatural #-}\n\nshiftRNatural :: Natural -> Int -> Natural\nshiftRNatural (Natural n) (I# i) = Natural (n `shiftRInteger` i)\n-- {-# CONSTANT_FOLDED shiftRNatural #-}\n\nplusNatural :: Natural -> Natural -> Natural\nplusNatural (Natural x) (Natural y) = Natural (x `plusInteger` y)\n{-# CONSTANT_FOLDED plusNatural #-}\n\nminusNatural :: Natural -> Natural -> Natural\nminusNatural (Natural x) (Natural y)\n  = if z `ltInteger` wordToInteger 0## then underflowError else Natural z\n  where z = x `minusInteger` y\n{-# CONSTANT_FOLDED minusNatural #-}\n\ntimesNatural :: Natural -> Natural -> Natural\ntimesNatural (Natural x) (Natural y) = Natural (x `timesInteger` y)\n{-# CONSTANT_FOLDED timesNatural #-}\n\norNatural :: Natural -> Natural -> Natural\norNatural (Natural x) (Natural y) = Natural (x `orInteger` y)\n-- {-# CONSTANT_FOLDED orNatural #-}\n\nxorNatural :: Natural -> Natural -> Natural\nxorNatural (Natural x) (Natural y) = Natural (x `xorInteger` y)\n-- {-# CONSTANT_FOLDED xorNatural #-}\n\nandNatural :: Natural -> Natural -> Natural\nandNatural (Natural x) (Natural y) = Natural (x `andInteger` y)\n-- {-# CONSTANT_FOLDED andNatural #-}\n\nnaturalToInt :: Natural -> Int\nnaturalToInt (Natural i) = I# (integerToInt i)\n\nnaturalToWord :: Natural -> Word\nnaturalToWord (Natural i) = W# (integerToWord i)\n\nnaturalToInteger :: Natural -> Integer\nnaturalToInteger (Natural i) = i\n{-# CONSTANT_FOLDED naturalToInteger #-}\n\ntestBitNatural :: Natural -> Int -> Bool\ntestBitNatural (Natural n) (I# i) = testBitInteger n i\n-- {-# CONSTANT_FOLDED testBitNatural #-}\n\npopCountNatural :: Natural -> Int\npopCountNatural (Natural n) = I# (popCountInteger n)\n\nbitNatural :: Int# -> Natural\nbitNatural i#\n  | isTrue# (i# <# WORD_SIZE_IN_BITS#) = wordToNaturalBase (1## `uncheckedShiftL#` i#)\n  | True                               = Natural (1 `shiftLInteger` i#)\n-- {-# CONSTANT_FOLDED bitNatural #-}\n\nquotNatural :: Natural -> Natural -> Natural\nquotNatural n@(Natural x) (Natural y)\n   | y == wordToInteger 0## = divZeroError\n   | y == wordToInteger 1## = n\n   | True                   = Natural (x `quotInteger` y)\n-- {-# CONSTANT_FOLDED quotNatural #-}\n\nremNatural :: Natural -> Natural -> Natural\nremNatural (Natural x) (Natural y)\n   | y == wordToInteger 0## = divZeroError\n   | y == wordToInteger 1## = wordToNaturalBase 0##\n   | True                   = Natural (x `remInteger` y)\n-- {-# CONSTANT_FOLDED remNatural #-}\n\nquotRemNatural :: Natural -> Natural -> (Natural, Natural)\nquotRemNatural n@(Natural x) (Natural y)\n   | y == wordToInteger 0## = divZeroError\n   | y == wordToInteger 1## = (n,wordToNaturalBase 0##)\n   | True                   = case quotRemInteger x y of\n      (# k, r #) -> (Natural k, Natural r)\n-- {-# CONSTANT_FOLDED quotRemNatural #-}\n\nsignumNatural :: Natural -> Natural\nsignumNatural (Natural x)\n   | x == wordToInteger 0## = wordToNaturalBase 0##\n   | True                   = wordToNaturalBase 1##\n-- {-# CONSTANT_FOLDED signumNatural #-}\n\nnegateNatural :: Natural -> Natural\nnegateNatural (Natural x)\n   | x == wordToInteger 0## = wordToNaturalBase 0##\n   | True                   = underflowError\n-- {-# CONSTANT_FOLDED negateNatural #-}\n\n#endif\n\n-- | Construct 'Natural' from 'Word' value.\n--\n-- @since 4.8.0.0\nwordToNatural :: Word -> Natural\nwordToNatural (W# w#) = wordToNatural# w#\n\n-- | Try downcasting 'Natural' to 'Word' value.\n-- Returns 'Nothing' if value doesn't fit in 'Word'.\n--\n-- @since 4.8.0.0\nnaturalToWordMaybe :: Natural -> Maybe Word\n#if defined(MIN_VERSION_integer_gmp)\nnaturalToWordMaybe (NatS# w#) = Just (W# w#)\nnaturalToWordMaybe (NatJ# _)  = Nothing\n#else\nnaturalToWordMaybe (Natural i)\n  | i < maxw  = Just (W# (integerToWord i))\n  | True      = Nothing\n  where\n    maxw = 1 `shiftLInteger` WORD_SIZE_IN_BITS#\n#endif\n\n-- | \\\"@'powModNatural' /b/ /e/ /m/@\\\" computes base @/b/@ raised to\n-- exponent @/e/@ modulo @/m/@.\n--\n-- @since 4.8.0.0\npowModNatural :: Natural -> Natural -> Natural -> Natural\n#if defined(MIN_VERSION_integer_gmp)\npowModNatural _           _           (NatS# 0##) = divZeroError\npowModNatural _           _           (NatS# 1##) = NatS# 0##\npowModNatural _           (NatS# 0##) _           = NatS# 1##\npowModNatural (NatS# 0##) _           _           = NatS# 0##\npowModNatural (NatS# 1##) _           _           = NatS# 1##\npowModNatural (NatS# b)   (NatS# e)   (NatS# m)   = NatS# (powModWord b e m)\npowModNatural b           e           (NatS# m)\n  = NatS# (powModBigNatWord (naturalToBigNat b) (naturalToBigNat e) m)\npowModNatural b           e           (NatJ# m)\n  = bigNatToNatural (powModBigNat (naturalToBigNat b) (naturalToBigNat e) m)\n#else\n-- Portable reference fallback implementation\npowModNatural (Natural b0) (Natural e0) (Natural m)\n   | m  == wordToInteger 0## = divZeroError\n   | m  == wordToInteger 1## = wordToNaturalBase 0##\n   | e0 == wordToInteger 0## = wordToNaturalBase 1##\n   | b0 == wordToInteger 0## = wordToNaturalBase 0##\n   | b0 == wordToInteger 1## = wordToNaturalBase 1##\n   | True    = go b0 e0 (wordToInteger 1##)\n  where\n    go !b e !r\n      | e `testBitInteger` 0#  = go b' e' ((r `timesInteger` b) `modInteger` m)\n      | e == wordToInteger 0## = naturalFromInteger r\n      | True                   = go b' e' r\n      where\n        b' = (b `timesInteger` b) `modInteger` m\n        e' = e `shiftRInteger` 1# -- slightly faster than \"e `div` 2\"\n#endif\n\n\n-- | Construct 'Natural' value from list of 'Word's.\n--\n-- This function is used by GHC for constructing 'Natural' literals.\nmkNatural :: [Word]  -- ^ value expressed in 32 bit chunks, least\n                     --   significant first\n          -> Natural\nmkNatural [] = wordToNaturalBase 0##\nmkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural`\n                         shiftLNatural (mkNatural is') 32\n{-# CONSTANT_FOLDED mkNatural #-}\n\n-- | Convert 'Int' to 'Natural'.\n-- Throws 'Control.Exception.Underflow' when passed a negative 'Int'.\nintToNatural :: Int -> Natural\nintToNatural (I# i#)\n  | isTrue# (i# <# 0#) = underflowError\n  | True               = wordToNaturalBase (int2Word# i#)\n", "num_lines": 623}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Num\n-- Copyright   :  (c) The University of Glasgow 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The 'Num' class and the 'Integer' type.\n--\n-----------------------------------------------------------------------------\n\n\nmodule GHC.Num (module GHC.Num, module GHC.Integer, module GHC.Natural) where\n\n#include \"MachDeps.h\"\n\nimport GHC.Base\nimport GHC.Integer\nimport GHC.Natural\n\ninfixl 7  *\ninfixl 6  +, -\n\ndefault ()              -- Double isn't available yet,\n                        -- and we shouldn't be using defaults anyway\n\n-- | Basic numeric class.\n--\n-- The Haskell Report defines no laws for 'Num'. However, @('+')@ and @('*')@ are\n-- customarily expected to define a ring and have the following properties:\n--\n-- [__Associativity of @('+')@__]: @(x + y) + z@ = @x + (y + z)@\n-- [__Commutativity of @('+')@__]: @x + y@ = @y + x@\n-- [__@'fromInteger' 0@ is the additive identity__]: @x + fromInteger 0@ = @x@\n-- [__'negate' gives the additive inverse__]: @x + negate x@ = @fromInteger 0@\n-- [__Associativity of @('*')@__]: @(x * y) * z@ = @x * (y * z)@\n-- [__@'fromInteger' 1@ is the multiplicative identity__]:\n-- @x * fromInteger 1@ = @x@ and @fromInteger 1 * x@ = @x@\n-- [__Distributivity of @('*')@ with respect to @('+')@__]:\n-- @a * (b + c)@ = @(a * b) + (a * c)@ and @(b + c) * a@ = @(b * a) + (c * a)@\n--\n-- Note that it /isn't/ customarily expected that a type instance of both 'Num'\n-- and 'Ord' implement an ordered ring. Indeed, in @base@ only 'Integer' and\n-- 'Data.Ratio.Rational' do.\nclass  Num a  where\n    {-# MINIMAL (+), (*), abs, signum, fromInteger, (negate | (-)) #-}\n\n    (+), (-), (*)       :: a -> a -> a\n    -- | Unary negation.\n    negate              :: a -> a\n    -- | Absolute value.\n    abs                 :: a -> a\n    -- | Sign of a number.\n    -- The functions 'abs' and 'signum' should satisfy the law:\n    --\n    -- > abs x * signum x == x\n    --\n    -- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero)\n    -- or @1@ (positive).\n    signum              :: a -> a\n    -- | Conversion from an 'Integer'.\n    -- An integer literal represents the application of the function\n    -- 'fromInteger' to the appropriate value of type 'Integer',\n    -- so such literals have type @('Num' a) => a@.\n    fromInteger         :: Integer -> a\n\n    {-# INLINE (-) #-}\n    {-# INLINE negate #-}\n    x - y               = x + negate y\n    negate x            = 0 - x\n\n-- | the same as @'flip' ('-')@.\n--\n-- Because @-@ is treated specially in the Haskell grammar,\n-- @(-@ /e/@)@ is not a section, but an application of prefix negation.\n-- However, @('subtract'@ /exp/@)@ is equivalent to the disallowed section.\n{-# INLINE subtract #-}\nsubtract :: (Num a) => a -> a -> a\nsubtract x y = y - x\n\n-- | @since 2.01\ninstance  Num Int  where\n    I# x + I# y = I# (x +# y)\n    I# x - I# y = I# (x -# y)\n    negate (I# x) = I# (negateInt# x)\n    I# x * I# y = I# (x *# y)\n    abs n  = if n `geInt` 0 then n else negate n\n\n    signum n | n `ltInt` 0 = negate 1\n             | n `eqInt` 0 = 0\n             | otherwise   = 1\n\n    {-# INLINE fromInteger #-}   -- Just to be sure!\n    fromInteger i = I# (integerToInt i)\n\n-- | @since 2.01\ninstance Num Word where\n    (W# x#) + (W# y#)      = W# (x# `plusWord#` y#)\n    (W# x#) - (W# y#)      = W# (x# `minusWord#` y#)\n    (W# x#) * (W# y#)      = W# (x# `timesWord#` y#)\n    negate (W# x#)         = W# (int2Word# (negateInt# (word2Int# x#)))\n    abs x                  = x\n    signum 0               = 0\n    signum _               = 1\n    fromInteger i          = W# (integerToWord i)\n\n-- | @since 2.01\ninstance  Num Integer  where\n    (+) = plusInteger\n    (-) = minusInteger\n    (*) = timesInteger\n    negate         = negateInteger\n    fromInteger x  =  x\n\n    abs = absInteger\n    signum = signumInteger\n\n-- | Note that `Natural`'s 'Num' instance isn't a ring: no element but 0 has an\n-- additive inverse. It is a semiring though.\n--\n-- @since 4.8.0.0\ninstance  Num Natural  where\n    (+) = plusNatural\n    (-) = minusNatural\n    (*) = timesNatural\n    negate      = negateNatural\n    fromInteger = naturalFromInteger\n\n    abs = id\n    signum = signumNatural\n\n", "num_lines": 139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.OldList\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- This legacy module provides access to the list-specialised operations\n-- of \"Data.List\". This module may go away again in future GHC versions and\n-- is provided as transitional tool to access some of the list-specialised\n-- operations that had to be generalised due to the implementation of the\n-- <https://wiki.haskell.org/Foldable_Traversable_In_Prelude Foldable/Traversable-in-Prelude Proposal (FTP)>.\n--\n-- If the operations needed are available in \"GHC.List\", it's\n-- recommended to avoid importing this module and use \"GHC.List\"\n-- instead for now.\n--\n-- @since 4.8.0.0\n-----------------------------------------------------------------------------\n\nmodule GHC.OldList (module Data.OldList) where\n\nimport Data.OldList\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes\n           , DataKinds\n           , FlexibleInstances\n           , KindSignatures\n           , MultiParamTypeClasses\n           , ScopedTypeVariables\n           , TypeApplications\n  #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.OverloadedLabels\n-- Copyright   :  (c) Adam Gundry 2015-2016\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- This module defines the 'IsLabel' class is used by the\n-- @OverloadedLabels@ extension.  See the\n-- <https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/OverloadedLabels wiki page>\n-- for more details.\n--\n-- When @OverloadedLabels@ is enabled, if GHC sees an occurrence of\n-- the overloaded label syntax @#foo@, it is replaced with\n--\n-- > fromLabel @\"foo\" :: alpha\n--\n-- plus a wanted constraint @IsLabel \"foo\" alpha@.\n--\n-- Note that if @RebindableSyntax@ is enabled, the desugaring of\n-- overloaded label syntax will make use of whatever @fromLabel@ is in\n-- scope.\n--\n-----------------------------------------------------------------------------\n\n-- Note [Overloaded labels]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~\n-- An overloaded label is represented by the 'HsOverLabel' constructor\n-- of 'HsExpr', which stores the 'FastString' text of the label and an\n-- optional id for the 'fromLabel' function to use (if\n-- RebindableSyntax is enabled) .  The type-checker transforms it into\n-- a call to 'fromLabel'.  See Note [Type-checking overloaded labels]\n-- in TcExpr for more details in how type-checking works.\n\nmodule GHC.OverloadedLabels\n       ( IsLabel(..)\n       ) where\n\nimport GHC.Base ( Symbol )\n\nclass IsLabel (x :: Symbol) a where\n  fromLabel :: a\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Pack\n-- Copyright   :  (c) The University of Glasgow 1997-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- This module provides a small set of low-level functions for packing\n-- and unpacking a chunk of bytes. Used by code emitted by the compiler\n-- plus the prelude libraries.\n--\n-- The programmer level view of packed strings is provided by a GHC\n-- system library PackedString.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Pack\n       (\n        -- (**) - emitted by compiler.\n\n        packCString#,\n        unpackCString,\n        unpackCString#,\n        unpackNBytes#,\n        unpackFoldrCString#,  -- (**)\n        unpackAppendCString#,  -- (**)\n       )\n        where\n\nimport GHC.Base\nimport GHC.List ( length )\nimport GHC.ST\nimport GHC.Ptr\n\ndata ByteArray ix              = ByteArray        ix ix ByteArray#\ndata MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)\n\nunpackCString :: Ptr a -> [Char]\nunpackCString a@(Ptr addr)\n  | a == nullPtr  = []\n  | otherwise      = unpackCString# addr\n\npackCString#         :: [Char]          -> ByteArray#\npackCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }\n\npackString :: [Char] -> ByteArray Int\npackString str = runST (packStringST str)\n\npackStringST :: [Char] -> ST s (ByteArray Int)\npackStringST str =\n  let len = length str  in\n  packNBytesST len str\n\npackNBytesST :: Int -> [Char] -> ST s (ByteArray Int)\npackNBytesST (I# length#) str =\n  {-\n   allocate an array that will hold the string\n   (not forgetting the NUL byte at the end)\n  -}\n new_ps_array (length# +# 1#) >>= \\ ch_array ->\n   -- fill in packed string from \"str\"\n fill_in ch_array 0# str   >>\n   -- freeze the puppy:\n freeze_ps_array ch_array length#\n where\n  fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()\n  fill_in arr_in# idx [] =\n   write_ps_array arr_in# idx (chr# 0#) >>\n   return ()\n\n  fill_in arr_in# idx (C# c : cs) =\n   write_ps_array arr_in# idx c  >>\n   fill_in arr_in# (idx +# 1#) cs\n\n-- (Very :-) ``Specialised'' versions of some CharArray things...\n\nnew_ps_array    :: Int# -> ST s (MutableByteArray s Int)\nwrite_ps_array  :: MutableByteArray s Int -> Int# -> Char# -> ST s ()\nfreeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)\n\nnew_ps_array size = ST $ \\ s ->\n    case (newByteArray# size s)   of { (# s2#, barr# #) ->\n    (# s2#, MutableByteArray bot bot barr# #) }\n  where\n    bot = errorWithoutStackTrace \"new_ps_array\"\n\nwrite_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \\ s# ->\n    case writeCharArray# barr# n ch s#  of { s2#   ->\n    (# s2#, () #) }\n\n-- same as unsafeFreezeByteArray\nfreeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \\ s# ->\n    case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->\n    (# s2#, ByteArray 0 (I# len#) frozen# #) }\n", "num_lines": 102}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-- | @since 4.7.0.0\nmodule GHC.Profiling where\n\nimport GHC.Base\n\n-- | Stop attributing ticks to cost centres. Allocations will still be\n-- attributed.\n--\n-- @since 4.7.0.0\nforeign import ccall stopProfTimer :: IO ()\n\n-- | Start attributing ticks to cost centres. This is called by the RTS on\n-- startup.\n--\n-- @since 4.7.0.0\nforeign import ccall startProfTimer :: IO ()\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, RoleAnnotations #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Ptr\n-- Copyright   :  (c) The FFI Task Force, 2000-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The 'Ptr' and 'FunPtr' types and operations.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Ptr (\n        Ptr(..), FunPtr(..),\n        nullPtr, castPtr, plusPtr, alignPtr, minusPtr,\n        nullFunPtr, castFunPtr,\n\n        -- * Unsafe functions\n        castFunPtrToPtr, castPtrToFunPtr\n    ) where\n\nimport GHC.Base\nimport GHC.Show\nimport GHC.Num\nimport GHC.List ( length, replicate )\nimport Numeric          ( showHex )\n\n#include \"MachDeps.h\"\n\n------------------------------------------------------------------------\n-- Data pointers.\n\n-- The role of Ptr's parameter is phantom, as there is no relation between\n-- the Haskell representation and whathever the user puts at the end of the\n-- pointer. And phantom is useful to implement castPtr (see #9163)\n\n-- redundant role annotation checks that this doesn't change\ntype role Ptr phantom\ndata Ptr a = Ptr Addr#\n  deriving ( Eq  -- ^ @since 2.01\n           , Ord -- ^ @since 2.01\n           )\n-- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an\n-- array of objects, which may be marshalled to or from Haskell values\n-- of type @a@.\n--\n-- The type @a@ will often be an instance of class\n-- 'Foreign.Storable.Storable' which provides the marshalling operations.\n-- However this is not essential, and you can provide your own operations\n-- to access the pointer.  For example you might write small foreign\n-- functions to get or set the fields of a C @struct@.\n\n-- |The constant 'nullPtr' contains a distinguished value of 'Ptr'\n-- that is not associated with a valid memory location.\nnullPtr :: Ptr a\nnullPtr = Ptr nullAddr#\n\n-- |The 'castPtr' function casts a pointer from one type to another.\ncastPtr :: Ptr a -> Ptr b\ncastPtr = coerce\n\n-- |Advances the given address by the given offset in bytes.\nplusPtr :: Ptr a -> Int -> Ptr b\nplusPtr (Ptr addr) (I# d) = Ptr (plusAddr# addr d)\n\n-- |Given an arbitrary address and an alignment constraint,\n-- 'alignPtr' yields the next higher address that fulfills the\n-- alignment constraint.  An alignment constraint @x@ is fulfilled by\n-- any address divisible by @x@.  This operation is idempotent.\nalignPtr :: Ptr a -> Int -> Ptr a\nalignPtr addr@(Ptr a) (I# i)\n  = case remAddr# a i of {\n      0# -> addr;\n      n -> Ptr (plusAddr# a (i -# n)) }\n\n-- |Computes the offset required to get from the second to the first\n-- argument.  We have\n--\n-- > p2 == p1 `plusPtr` (p2 `minusPtr` p1)\nminusPtr :: Ptr a -> Ptr b -> Int\nminusPtr (Ptr a1) (Ptr a2) = I# (minusAddr# a1 a2)\n\n------------------------------------------------------------------------\n-- Function pointers for the default calling convention.\n\n-- 'FunPtr' has a phantom role for similar reasons to 'Ptr'. Note\n-- that 'FunPtr's role cannot become nominal without changes elsewhere\n-- in GHC. See Note [FFI type roles] in TcForeign.\ntype role FunPtr phantom\ndata FunPtr a = FunPtr Addr# deriving (Eq, Ord)\n-- ^ A value of type @'FunPtr' a@ is a pointer to a function callable\n-- from foreign code.  The type @a@ will normally be a /foreign type/,\n-- a function type with zero or more arguments where\n--\n-- * the argument types are /marshallable foreign types/,\n--   i.e. 'Char', 'Int', 'Double', 'Float',\n--   'Bool', 'Data.Int.Int8', 'Data.Int.Int16', 'Data.Int.Int32',\n--   'Data.Int.Int64', 'Data.Word.Word8', 'Data.Word.Word16',\n--   'Data.Word.Word32', 'Data.Word.Word64', @'Ptr' a@, @'FunPtr' a@,\n--   @'Foreign.StablePtr.StablePtr' a@ or a renaming of any of these\n--   using @newtype@.\n--\n-- * the return type is either a marshallable foreign type or has the form\n--   @'IO' t@ where @t@ is a marshallable foreign type or @()@.\n--\n-- A value of type @'FunPtr' a@ may be a pointer to a foreign function,\n-- either returned by another foreign function or imported with a\n-- a static address import like\n--\n-- > foreign import ccall \"stdlib.h &free\"\n-- >   p_free :: FunPtr (Ptr a -> IO ())\n--\n-- or a pointer to a Haskell function created using a /wrapper/ stub\n-- declared to produce a 'FunPtr' of the correct type.  For example:\n--\n-- > type Compare = Int -> Int -> Bool\n-- > foreign import ccall \"wrapper\"\n-- >   mkCompare :: Compare -> IO (FunPtr Compare)\n--\n-- Calls to wrapper stubs like @mkCompare@ allocate storage, which\n-- should be released with 'Foreign.Ptr.freeHaskellFunPtr' when no\n-- longer required.\n--\n-- To convert 'FunPtr' values to corresponding Haskell functions, one\n-- can define a /dynamic/ stub for the specific foreign type, e.g.\n--\n-- > type IntFunction = CInt -> IO ()\n-- > foreign import ccall \"dynamic\"\n-- >   mkFun :: FunPtr IntFunction -> IntFunction\n\n-- |The constant 'nullFunPtr' contains a\n-- distinguished value of 'FunPtr' that is not\n-- associated with a valid memory location.\nnullFunPtr :: FunPtr a\nnullFunPtr = FunPtr nullAddr#\n\n-- |Casts a 'FunPtr' to a 'FunPtr' of a different type.\ncastFunPtr :: FunPtr a -> FunPtr b\ncastFunPtr = coerce\n\n-- |Casts a 'FunPtr' to a 'Ptr'.\n--\n-- /Note:/ this is valid only on architectures where data and function\n-- pointers range over the same set of addresses, and should only be used\n-- for bindings to external libraries whose interface already relies on\n-- this assumption.\ncastFunPtrToPtr :: FunPtr a -> Ptr b\ncastFunPtrToPtr (FunPtr addr) = Ptr addr\n\n-- |Casts a 'Ptr' to a 'FunPtr'.\n--\n-- /Note:/ this is valid only on architectures where data and function\n-- pointers range over the same set of addresses, and should only be used\n-- for bindings to external libraries whose interface already relies on\n-- this assumption.\ncastPtrToFunPtr :: Ptr a -> FunPtr b\ncastPtrToFunPtr (Ptr addr) = FunPtr addr\n\n\n------------------------------------------------------------------------\n-- Show instances for Ptr and FunPtr\n\n-- | @since 2.01\ninstance Show (Ptr a) where\n   showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) \"\")\n     where\n        -- want 0s prefixed to pad it out to a fixed length.\n       pad_out ls =\n          '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs\n\n-- | @since 2.01\ninstance Show (FunPtr a) where\n   showsPrec p = showsPrec p . castFunPtrToPtr\n", "num_lines": 180}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving, ScopedTypeVariables #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Read\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The 'Read' class and instances for basic data types.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Read\n  ( Read(..)   -- class\n\n  -- ReadS type\n  , ReadS\n\n  -- H2010 compatibility\n  , lex\n  , lexLitChar\n  , readLitChar\n  , lexDigits\n\n  -- defining readers\n  , lexP, expectP\n  , paren\n  , parens\n  , list\n  , choose\n  , readListDefault, readListPrecDefault\n  , readNumber\n  , readField\n  , readFieldHash\n  , readSymField\n\n  -- Temporary\n  , readParen\n  )\n where\n\n#include \"MachDeps.h\"\n\nimport qualified Text.ParserCombinators.ReadP as P\n\nimport Text.ParserCombinators.ReadP\n  ( ReadS\n  , readP_to_S\n  )\n\nimport qualified Text.Read.Lex as L\n-- Lex exports 'lex', which is also defined here,\n-- hence the qualified import.\n-- We can't import *anything* unqualified, because that\n-- confuses Haddock.\n\nimport Text.ParserCombinators.ReadPrec\n\nimport Data.Maybe\n\nimport GHC.Unicode\nimport GHC.Num\nimport GHC.Real\nimport GHC.Float\nimport GHC.Show\nimport GHC.Base\nimport GHC.Arr\nimport GHC.Word\nimport GHC.List (filter)\n\n\n-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with\n-- parentheses.\n--\n-- @'readParen' 'False' p@ parses what @p@ parses, but optionally\n-- surrounded with parentheses.\nreadParen       :: Bool -> ReadS a -> ReadS a\n-- A Haskell 2010 function\nreadParen b g   =  if b then mandatory else optional\n                   where optional r  = g r ++ mandatory r\n                         mandatory r = do\n                                (\"(\",s) <- lex r\n                                (x,t)   <- optional s\n                                (\")\",u) <- lex t\n                                return (x,u)\n\n-- | Parsing of 'String's, producing values.\n--\n-- Derived instances of 'Read' make the following assumptions, which\n-- derived instances of 'Text.Show.Show' obey:\n--\n-- * If the constructor is defined to be an infix operator, then the\n--   derived 'Read' instance will parse only infix applications of\n--   the constructor (not the prefix form).\n--\n-- * Associativity is not used to reduce the occurrence of parentheses,\n--   although precedence may be.\n--\n-- * If the constructor is defined using record syntax, the derived 'Read'\n--   will parse only the record-syntax form, and furthermore, the fields\n--   must be given in the same order as the original declaration.\n--\n-- * The derived 'Read' instance allows arbitrary Haskell whitespace\n--   between tokens of the input string.  Extra parentheses are also\n--   allowed.\n--\n-- For example, given the declarations\n--\n-- > infixr 5 :^:\n-- > data Tree a =  Leaf a  |  Tree a :^: Tree a\n--\n-- the derived instance of 'Read' in Haskell 2010 is equivalent to\n--\n-- > instance (Read a) => Read (Tree a) where\n-- >\n-- >         readsPrec d r =  readParen (d > app_prec)\n-- >                          (\\r -> [(Leaf m,t) |\n-- >                                  (\"Leaf\",s) <- lex r,\n-- >                                  (m,t) <- readsPrec (app_prec+1) s]) r\n-- >\n-- >                       ++ readParen (d > up_prec)\n-- >                          (\\r -> [(u:^:v,w) |\n-- >                                  (u,s) <- readsPrec (up_prec+1) r,\n-- >                                  (\":^:\",t) <- lex s,\n-- >                                  (v,w) <- readsPrec (up_prec+1) t]) r\n-- >\n-- >           where app_prec = 10\n-- >                 up_prec = 5\n--\n-- Note that right-associativity of @:^:@ is unused.\n--\n-- The derived instance in GHC is equivalent to\n--\n-- > instance (Read a) => Read (Tree a) where\n-- >\n-- >         readPrec = parens $ (prec app_prec $ do\n-- >                                  Ident \"Leaf\" <- lexP\n-- >                                  m <- step readPrec\n-- >                                  return (Leaf m))\n-- >\n-- >                      +++ (prec up_prec $ do\n-- >                                  u <- step readPrec\n-- >                                  Symbol \":^:\" <- lexP\n-- >                                  v <- step readPrec\n-- >                                  return (u :^: v))\n-- >\n-- >           where app_prec = 10\n-- >                 up_prec = 5\n-- >\n-- >         readListPrec = readListPrecDefault\n--\n-- Why do both 'readsPrec' and 'readPrec' exist, and why does GHC opt to\n-- implement 'readPrec' in derived 'Read' instances instead of 'readsPrec'?\n-- The reason is that 'readsPrec' is based on the 'ReadS' type, and although\n-- 'ReadS' is mentioned in the Haskell 2010 Report, it is not a very efficient\n-- parser data structure.\n--\n-- 'readPrec', on the other hand, is based on a much more efficient 'ReadPrec'\n-- datatype (a.k.a \\\"new-style parsers\\\"), but its definition relies on the use\n-- of the @RankNTypes@ language extension. Therefore, 'readPrec' (and its\n-- cousin, 'readListPrec') are marked as GHC-only. Nevertheless, it is\n-- recommended to use 'readPrec' instead of 'readsPrec' whenever possible\n-- for the efficiency improvements it brings.\n--\n-- As mentioned above, derived 'Read' instances in GHC will implement\n-- 'readPrec' instead of 'readsPrec'. The default implementations of\n-- 'readsPrec' (and its cousin, 'readList') will simply use 'readPrec' under\n-- the hood. If you are writing a 'Read' instance by hand, it is recommended\n-- to write it like so:\n--\n-- @\n-- instance 'Read' T where\n--   'readPrec'     = ...\n--   'readListPrec' = 'readListPrecDefault'\n-- @\n\nclass Read a where\n  {-# MINIMAL readsPrec | readPrec #-}\n\n  -- | attempts to parse a value from the front of the string, returning\n  -- a list of (parsed value, remaining string) pairs.  If there is no\n  -- successful parse, the returned list is empty.\n  --\n  -- Derived instances of 'Read' and 'Text.Show.Show' satisfy the following:\n  --\n  -- * @(x,\\\"\\\")@ is an element of\n  --   @('readsPrec' d ('Text.Show.showsPrec' d x \\\"\\\"))@.\n  --\n  -- That is, 'readsPrec' parses the string produced by\n  -- 'Text.Show.showsPrec', and delivers the value that\n  -- 'Text.Show.showsPrec' started with.\n\n  readsPrec    :: Int   -- ^ the operator precedence of the enclosing\n                        -- context (a number from @0@ to @11@).\n                        -- Function application has precedence @10@.\n                -> ReadS a\n\n  -- | The method 'readList' is provided to allow the programmer to\n  -- give a specialised way of parsing lists of values.\n  -- For example, this is used by the predefined 'Read' instance of\n  -- the 'Char' type, where values of type 'String' should be are\n  -- expected to use double quotes, rather than square brackets.\n  readList     :: ReadS [a]\n\n  -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only).\n  readPrec     :: ReadPrec a\n\n  -- | Proposed replacement for 'readList' using new-style parsers (GHC only).\n  -- The default definition uses 'readList'.  Instances that define 'readPrec'\n  -- should also define 'readListPrec' as 'readListPrecDefault'.\n  readListPrec :: ReadPrec [a]\n\n  -- default definitions\n  readsPrec    = readPrec_to_S readPrec\n  readList     = readPrec_to_S (list readPrec) 0\n  readPrec     = readS_to_Prec readsPrec\n  readListPrec = readS_to_Prec (\\_ -> readList)\n\nreadListDefault :: Read a => ReadS [a]\n-- ^ A possible replacement definition for the 'readList' method (GHC only).\n--   This is only needed for GHC, and even then only for 'Read' instances\n--   where 'readListPrec' isn't defined as 'readListPrecDefault'.\nreadListDefault = readPrec_to_S readListPrec 0\n\nreadListPrecDefault :: Read a => ReadPrec [a]\n-- ^ A possible replacement definition for the 'readListPrec' method,\n--   defined using 'readPrec' (GHC only).\nreadListPrecDefault = list readPrec\n\n------------------------------------------------------------------------\n-- H2010 compatibility\n\n-- | The 'lex' function reads a single lexeme from the input, discarding\n-- initial white space, and returning the characters that constitute the\n-- lexeme.  If the input string contains only white space, 'lex' returns a\n-- single successful \\`lexeme\\' consisting of the empty string.  (Thus\n-- @'lex' \\\"\\\" = [(\\\"\\\",\\\"\\\")]@.)  If there is no legal lexeme at the\n-- beginning of the input string, 'lex' fails (i.e. returns @[]@).\n--\n-- This lexer is not completely faithful to the Haskell lexical syntax\n-- in the following respects:\n--\n-- * Qualified names are not handled properly\n--\n-- * Octal and hexadecimal numerics are not recognized as a single token\n--\n-- * Comments are not treated properly\nlex :: ReadS String             -- As defined by H2010\nlex s  = readP_to_S L.hsLex s\n\n-- | Read a string representation of a character, using Haskell\n-- source-language escape conventions.  For example:\n--\n-- > lexLitChar  \"\\\\nHello\"  =  [(\"\\\\n\", \"Hello\")]\n--\nlexLitChar :: ReadS String      -- As defined by H2010\nlexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ;\n                              let s' = removeNulls s in\n                              return s' })\n    where\n    -- remove nulls from end of the character if they exist\n    removeNulls [] = []\n    removeNulls ('\\\\':'&':xs) = removeNulls xs\n    removeNulls (first:rest) = first : removeNulls rest\n        -- There was a skipSpaces before the P.gather L.lexChar,\n        -- but that seems inconsistent with readLitChar\n\n-- | Read a string representation of a character, using Haskell\n-- source-language escape conventions, and convert it to the character\n-- that it encodes.  For example:\n--\n-- > readLitChar \"\\\\nHello\"  =  [('\\n', \"Hello\")]\n--\nreadLitChar :: ReadS Char       -- As defined by H2010\nreadLitChar = readP_to_S L.lexChar\n\n-- | Reads a non-empty string of decimal digits.\nlexDigits :: ReadS String\nlexDigits = readP_to_S (P.munch1 isDigit)\n\n------------------------------------------------------------------------\n-- utility parsers\n\nlexP :: ReadPrec L.Lexeme\n-- ^ Parse a single lexeme\nlexP = lift L.lex\n\nexpectP :: L.Lexeme -> ReadPrec ()\nexpectP lexeme = lift (L.expect lexeme)\n\nexpectCharP :: Char -> ReadPrec a -> ReadPrec a\nexpectCharP c a = do\n  q <- get\n  if q == c\n    then a\n    else pfail\n{-# INLINE expectCharP #-}\n\nskipSpacesThenP :: ReadPrec a -> ReadPrec a\nskipSpacesThenP m =\n  do s <- look\n     skip s\n where\n   skip (c:s) | isSpace c = get *> skip s\n   skip _ = m\n\nparen :: ReadPrec a -> ReadPrec a\n-- ^ @(paren p)@ parses \\\"(P0)\\\"\n--      where @p@ parses \\\"P0\\\" in precedence context zero\nparen p = skipSpacesThenP (paren' p)\n\nparen' :: ReadPrec a -> ReadPrec a\nparen' p = expectCharP '(' $ reset p >>= \\x ->\n              skipSpacesThenP (expectCharP ')' (pure x))\n\nparens :: ReadPrec a -> ReadPrec a\n-- ^ @(parens p)@ parses \\\"P\\\", \\\"(P0)\\\", \\\"((P0))\\\", etc,\n--      where @p@ parses \\\"P\\\"  in the current precedence context\n--          and parses \\\"P0\\\" in precedence context zero\nparens p = optional\n  where\n    optional = skipSpacesThenP (p +++ mandatory)\n    mandatory = paren' optional\n\nlist :: ReadPrec a -> ReadPrec [a]\n-- ^ @(list p)@ parses a list of things parsed by @p@,\n-- using the usual square-bracket syntax.\nlist readx =\n  parens\n  ( do expectP (L.Punc \"[\")\n       (listRest False +++ listNext)\n  )\n where\n  listRest started =\n    do L.Punc c <- lexP\n       case c of\n         \"]\"           -> return []\n         \",\" | started -> listNext\n         _             -> pfail\n\n  listNext =\n    do x  <- reset readx\n       xs <- listRest True\n       return (x:xs)\n\nchoose :: [(String, ReadPrec a)] -> ReadPrec a\n-- ^ Parse the specified lexeme and continue as specified.\n-- Esp useful for nullary constructors; e.g.\n--    @choose [(\\\"A\\\", return A), (\\\"B\\\", return B)]@\n-- We match both Ident and Symbol because the constructor\n-- might be an operator eg @(:~:)@\nchoose sps = foldr ((+++) . try_one) pfail sps\n           where\n             try_one (s,p) = do { token <- lexP ;\n                                  case token of\n                                    L.Ident s'  | s==s' -> p\n                                    L.Symbol s' | s==s' -> p\n                                    _other              -> pfail }\n\n-- See Note [Why readField]\n\n-- | 'Read' parser for a record field, of the form @fieldName=value@. The\n-- @fieldName@ must be an alphanumeric identifier; for symbols (operator-style)\n-- field names, e.g. @(#)@, use 'readSymField'). The second argument is a\n-- parser for the field value.\nreadField :: String -> ReadPrec a -> ReadPrec a\nreadField fieldName readVal = do\n        expectP (L.Ident fieldName)\n        expectP (L.Punc \"=\")\n        readVal\n{-# NOINLINE readField #-}\n\n-- See Note [Why readField]\n\n-- | 'Read' parser for a record field, of the form @fieldName#=value@. That is,\n-- an alphanumeric identifier @fieldName@ followed by the symbol @#@. The\n-- second argument is a parser for the field value.\n--\n-- Note that 'readField' does not suffice for this purpose due to\n-- <https://ghc.haskell.org/trac/ghc/ticket/5041 Trac #5041>.\nreadFieldHash :: String -> ReadPrec a -> ReadPrec a\nreadFieldHash fieldName readVal = do\n        expectP (L.Ident fieldName)\n        expectP (L.Symbol \"#\")\n        expectP (L.Punc \"=\")\n        readVal\n{-# NOINLINE readFieldHash #-}\n\n-- See Note [Why readField]\n\n-- | 'Read' parser for a symbol record field, of the form @(###)=value@ (where\n-- @###@ is the field name). The field name must be a symbol (operator-style),\n-- e.g. @(#)@. For regular (alphanumeric) field names, use 'readField'. The\n-- second argument is a parser for the field value.\nreadSymField :: String -> ReadPrec a -> ReadPrec a\nreadSymField fieldName readVal = do\n        expectP (L.Punc \"(\")\n        expectP (L.Symbol fieldName)\n        expectP (L.Punc \")\")\n        expectP (L.Punc \"=\")\n        readVal\n{-# NOINLINE readSymField #-}\n\n\n-- Note [Why readField]\n--\n-- Previously, the code for automatically deriving Read instance (in\n-- typecheck/TcGenDeriv.hs) would generate inline code for parsing fields;\n-- this, however, turned out to produce massive amounts of intermediate code,\n-- and produced a considerable performance hit in the code generator.\n-- Since Read instances are not generally supposed to be perfomance critical,\n-- the readField and readSymField functions have been factored out, and the\n-- code generator now just generates calls rather than manually inlining the\n-- parsers. For large record types (e.g. 500 fields), this produces a\n-- significant performance boost.\n--\n-- See also Trac #14364.\n\n\n--------------------------------------------------------------\n-- Simple instances of Read\n--------------------------------------------------------------\n\n-- | @since 2.01\nderiving instance Read GeneralCategory\n\n-- | @since 2.01\ninstance Read Char where\n  readPrec =\n    parens\n    ( do L.Char c <- lexP\n         return c\n    )\n\n  readListPrec =\n    parens\n    ( do L.String s <- lexP     -- Looks for \"foo\"\n         return s\n     +++\n      readListPrecDefault       -- Looks for ['f','o','o']\n    )                           -- (more generous than H2010 spec)\n\n  readList = readListDefault\n\n-- | @since 2.01\ninstance Read Bool where\n  readPrec =\n    parens\n    ( do L.Ident s <- lexP\n         case s of\n           \"True\"  -> return True\n           \"False\" -> return False\n           _       -> pfail\n    )\n\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance Read Ordering where\n  readPrec =\n    parens\n    ( do L.Ident s <- lexP\n         case s of\n           \"LT\" -> return LT\n           \"EQ\" -> return EQ\n           \"GT\" -> return GT\n           _    -> pfail\n    )\n\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 4.11.0.0\nderiving instance Read a => Read (NonEmpty a)\n\n--------------------------------------------------------------\n-- Structure instances of Read: Maybe, List etc\n--------------------------------------------------------------\n\n{-\nFor structured instances of Read we start using the precedences.  The\nidea is then that 'parens (prec k p)' will fail immediately when trying\nto parse it in a context with a higher precedence level than k. But if\nthere is one parenthesis parsed, then the required precedence level\ndrops to 0 again, and parsing inside p may succeed.\n\n'appPrec' is just the precedence level of function application.  So,\nif we are parsing function application, we'd better require the\nprecedence level to be at least 'appPrec'. Otherwise, we have to put\nparentheses around it.\n\n'step' is used to increase the precedence levels inside a\nparser, and can be used to express left- or right- associativity. For\nexample, % is defined to be left associative, so we only increase\nprecedence on the right hand side.\n\nNote how step is used in for example the Maybe parser to increase the\nprecedence beyond appPrec, so that basically only literals and\nparenthesis-like objects such as (...) and [...] can be an argument to\n'Just'.\n-}\n\n-- | @since 2.01\ninstance Read a => Read (Maybe a) where\n  readPrec =\n    parens\n    (do expectP (L.Ident \"Nothing\")\n        return Nothing\n     +++\n     prec appPrec (\n        do expectP (L.Ident \"Just\")\n           x <- step readPrec\n           return (Just x))\n    )\n\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance Read a => Read [a] where\n  {-# SPECIALISE instance Read [String] #-}\n  {-# SPECIALISE instance Read [Char] #-}\n  {-# SPECIALISE instance Read [Int] #-}\n  readPrec     = readListPrec\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance  (Ix a, Read a, Read b) => Read (Array a b)  where\n    readPrec = parens $ prec appPrec $\n               do expectP (L.Ident \"array\")\n                  theBounds <- step readPrec\n                  vals   <- step readPrec\n                  return (array theBounds vals)\n\n    readListPrec = readListPrecDefault\n    readList     = readListDefault\n\n-- | @since 2.01\ninstance Read L.Lexeme where\n  readPrec     = lexP\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n--------------------------------------------------------------\n-- Numeric instances of Read\n--------------------------------------------------------------\n\nreadNumber :: Num a => (L.Lexeme -> ReadPrec a) -> ReadPrec a\n-- Read a signed number\nreadNumber convert =\n  parens\n  ( do x <- lexP\n       case x of\n         L.Symbol \"-\" -> do y <- lexP\n                            n <- convert y\n                            return (negate n)\n\n         _   -> convert x\n  )\n\n\nconvertInt :: Num a => L.Lexeme -> ReadPrec a\nconvertInt (L.Number n)\n | Just i <- L.numberToInteger n = return (fromInteger i)\nconvertInt _ = pfail\n\nconvertFrac :: forall a . RealFloat a => L.Lexeme -> ReadPrec a\nconvertFrac (L.Ident \"NaN\")      = return (0 / 0)\nconvertFrac (L.Ident \"Infinity\") = return (1 / 0)\nconvertFrac (L.Number n) = let resRange = floatRange (undefined :: a)\n                           in case L.numberToRangedRational resRange n of\n                              Nothing -> return (1 / 0)\n                              Just rat -> return $ fromRational rat\nconvertFrac _            = pfail\n\n-- | @since 2.01\ninstance Read Int where\n  readPrec     = readNumber convertInt\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 4.5.0.0\ninstance Read Word where\n    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Read Word8 where\n    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Read Word16 where\n    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Read Word32 where\n#if WORD_SIZE_IN_BITS < 33\n    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]\n#else\n    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]\n#endif\n\n-- | @since 2.01\ninstance Read Word64 where\n    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]\n\n-- | @since 2.01\ninstance Read Integer where\n  readPrec     = readNumber convertInt\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n\n-- | @since 4.8.0.0\ninstance Read Natural where\n  readsPrec d = map (\\(n, s) -> (fromInteger n, s))\n                  . filter ((>= 0) . (\\(x,_)->x)) . readsPrec d\n\n-- | @since 2.01\ninstance Read Float where\n  readPrec     = readNumber convertFrac\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance Read Double where\n  readPrec     = readNumber convertFrac\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Integral a, Read a) => Read (Ratio a) where\n  readPrec =\n    parens\n    ( prec ratioPrec\n      ( do x <- step readPrec\n           expectP (L.Symbol \"%\")\n           y <- step readPrec\n           return (x % y)\n      )\n    )\n\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n\n------------------------------------------------------------------------\n-- Tuple instances of Read, up to size 15\n------------------------------------------------------------------------\n\n-- | @since 2.01\ninstance Read () where\n  readPrec =\n    parens\n    ( paren\n      ( return ()\n      )\n    )\n\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b) => Read (a,b) where\n  readPrec = wrap_tup read_tup2\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\nwrap_tup :: ReadPrec a -> ReadPrec a\nwrap_tup p = parens (paren p)\n\nread_comma :: ReadPrec ()\nread_comma = expectP (L.Punc \",\")\n\nread_tup2 :: (Read a, Read b) => ReadPrec (a,b)\n-- Reads \"a , b\"  no parens!\nread_tup2 = do x <- readPrec\n               read_comma\n               y <- readPrec\n               return (x,y)\n\nread_tup4 :: (Read a, Read b, Read c, Read d) => ReadPrec (a,b,c,d)\nread_tup4 = do  (a,b) <- read_tup2\n                read_comma\n                (c,d) <- read_tup2\n                return (a,b,c,d)\n\n\nread_tup8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)\n          => ReadPrec (a,b,c,d,e,f,g,h)\nread_tup8 = do  (a,b,c,d) <- read_tup4\n                read_comma\n                (e,f,g,h) <- read_tup4\n                return (a,b,c,d,e,f,g,h)\n\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c) => Read (a, b, c) where\n  readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma\n                          ; c <- readPrec\n                          ; return (a,b,c) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where\n  readPrec = wrap_tup read_tup4\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where\n  readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma\n                          ; e <- readPrec\n                          ; return (a,b,c,d,e) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f)\n        => Read (a, b, c, d, e, f) where\n  readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma\n                          ; (e,f) <- read_tup2\n                          ; return (a,b,c,d,e,f) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g)\n        => Read (a, b, c, d, e, f, g) where\n  readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma\n                          ; (e,f) <- read_tup2; read_comma\n                          ; g <- readPrec\n                          ; return (a,b,c,d,e,f,g) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)\n        => Read (a, b, c, d, e, f, g, h) where\n  readPrec     = wrap_tup read_tup8\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,\n          Read i)\n        => Read (a, b, c, d, e, f, g, h, i) where\n  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma\n                          ; i <- readPrec\n                          ; return (a,b,c,d,e,f,g,h,i) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,\n          Read i, Read j)\n        => Read (a, b, c, d, e, f, g, h, i, j) where\n  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma\n                          ; (i,j) <- read_tup2\n                          ; return (a,b,c,d,e,f,g,h,i,j) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,\n          Read i, Read j, Read k)\n        => Read (a, b, c, d, e, f, g, h, i, j, k) where\n  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma\n                          ; (i,j) <- read_tup2; read_comma\n                          ; k <- readPrec\n                          ; return (a,b,c,d,e,f,g,h,i,j,k) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,\n          Read i, Read j, Read k, Read l)\n        => Read (a, b, c, d, e, f, g, h, i, j, k, l) where\n  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma\n                          ; (i,j,k,l) <- read_tup4\n                          ; return (a,b,c,d,e,f,g,h,i,j,k,l) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,\n          Read i, Read j, Read k, Read l, Read m)\n        => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where\n  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma\n                          ; (i,j,k,l) <- read_tup4; read_comma\n                          ; m <- readPrec\n                          ; return (a,b,c,d,e,f,g,h,i,j,k,l,m) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,\n          Read i, Read j, Read k, Read l, Read m, Read n)\n        => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where\n  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma\n                          ; (i,j,k,l) <- read_tup4; read_comma\n                          ; (m,n) <- read_tup2\n                          ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n\n-- | @since 2.01\ninstance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,\n          Read i, Read j, Read k, Read l, Read m, Read n, Read o)\n        => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where\n  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma\n                          ; (i,j,k,l) <- read_tup4; read_comma\n                          ; (m,n) <- read_tup2; read_comma\n                          ; o <- readPrec\n                          ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })\n  readListPrec = readListPrecDefault\n  readList     = readListDefault\n", "num_lines": 826}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples, BangPatterns #-}\n{-# OPTIONS_GHC -Wno-orphans #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Real\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The types 'Ratio' and 'Rational', and the classes 'Real', 'Fractional',\n-- 'Integral', and 'RealFrac'.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Real where\n\n#include \"MachDeps.h\"\n\nimport GHC.Base\nimport GHC.Num\nimport GHC.List\nimport GHC.Enum\nimport GHC.Show\nimport {-# SOURCE #-} GHC.Exception( divZeroException, overflowException\n                                   , underflowException\n                                   , ratioZeroDenomException )\n\n#if defined(MIN_VERSION_integer_gmp)\nimport GHC.Integer.GMP.Internals\n#endif\n\ninfixr 8  ^, ^^\ninfixl 7  /, `quot`, `rem`, `div`, `mod`\ninfixl 7  %\n\ndefault ()              -- Double isn't available yet,\n                        -- and we shouldn't be using defaults anyway\n\n------------------------------------------------------------------------\n-- Divide by zero and arithmetic overflow\n------------------------------------------------------------------------\n\n-- We put them here because they are needed relatively early\n-- in the libraries before the Exception type has been defined yet.\n\n{-# NOINLINE divZeroError #-}\ndivZeroError :: a\ndivZeroError = raise# divZeroException\n\n{-# NOINLINE ratioZeroDenominatorError #-}\nratioZeroDenominatorError :: a\nratioZeroDenominatorError = raise# ratioZeroDenomException\n\n{-# NOINLINE overflowError #-}\noverflowError :: a\noverflowError = raise# overflowException\n\n{-# NOINLINE underflowError #-}\nunderflowError :: a\nunderflowError = raise# underflowException\n\n\n--------------------------------------------------------------\n-- The Ratio and Rational types\n--------------------------------------------------------------\n\n-- | Rational numbers, with numerator and denominator of some 'Integral' type.\n--\n-- Note that `Ratio`'s instances inherit the deficiencies from the type\n-- parameter's. For example, @Ratio Natural@'s 'Num' instance has similar\n-- problems to `Numeric.Natural.Natural`'s.\ndata  Ratio a = !a :% !a  deriving Eq -- ^ @since 2.01\n\n-- | Arbitrary-precision rational numbers, represented as a ratio of\n-- two 'Integer' values.  A rational number may be constructed using\n-- the '%' operator.\ntype  Rational          =  Ratio Integer\n\nratioPrec, ratioPrec1 :: Int\nratioPrec  = 7  -- Precedence of ':%' constructor\nratioPrec1 = ratioPrec + 1\n\ninfinity, notANumber :: Rational\ninfinity   = 1 :% 0\nnotANumber = 0 :% 0\n\n-- Use :%, not % for Inf/NaN; the latter would\n-- immediately lead to a runtime error, because it normalises.\n\n-- | Forms the ratio of two integral numbers.\n{-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}\n(%)                     :: (Integral a) => a -> a -> Ratio a\n\n-- | Extract the numerator of the ratio in reduced form:\n-- the numerator and denominator have no common factor and the denominator\n-- is positive.\nnumerator       :: Ratio a -> a\n\n-- | Extract the denominator of the ratio in reduced form:\n-- the numerator and denominator have no common factor and the denominator\n-- is positive.\ndenominator     :: Ratio a -> a\n\n\n-- | 'reduce' is a subsidiary function used only in this module.\n-- It normalises a ratio by dividing both numerator and denominator by\n-- their greatest common divisor.\nreduce ::  (Integral a) => a -> a -> Ratio a\n{-# SPECIALISE reduce :: Integer -> Integer -> Rational #-}\nreduce _ 0              =  ratioZeroDenominatorError\nreduce x y              =  (x `quot` d) :% (y `quot` d)\n                           where d = gcd x y\n\nx % y                   =  reduce (x * signum y) (abs y)\n\nnumerator   (x :% _)    =  x\ndenominator (_ :% y)    =  y\n\n--------------------------------------------------------------\n-- Standard numeric classes\n--------------------------------------------------------------\n\nclass  (Num a, Ord a) => Real a  where\n    -- | the rational equivalent of its real argument with full precision\n    toRational          ::  a -> Rational\n\n-- | Integral numbers, supporting integer division.\n--\n-- The Haskell Report defines no laws for 'Integral'. However, 'Integral'\n-- instances are customarily expected to define a Euclidean domain and have the\n-- following properties for the `div`\\/`mod` and `quot`\\/`rem` pairs, given\n-- suitable Euclidean functions @f@ and @g@:\n--\n-- * @x@ = @y * quot x y + rem x y@ with @rem x y@ = @fromInteger 0@ or\n-- @g (rem x y)@ < @g y@\n-- * @x@ = @y * div x y + mod x y@ with @mod x y@ = @fromInteger 0@ or\n-- @f (mod x y)@ < @f y@\n--\n-- An example of a suitable Euclidean function, for `Integer`'s instance, is\n-- 'abs'.\nclass  (Real a, Enum a) => Integral a  where\n    -- | integer division truncated toward zero\n    quot                :: a -> a -> a\n    -- | integer remainder, satisfying\n    --\n    -- > (x `quot` y)*y + (x `rem` y) == x\n    rem                 :: a -> a -> a\n    -- | integer division truncated toward negative infinity\n    div                 :: a -> a -> a\n    -- | integer modulus, satisfying\n    --\n    -- > (x `div` y)*y + (x `mod` y) == x\n    mod                 :: a -> a -> a\n    -- | simultaneous 'quot' and 'rem'\n    quotRem             :: a -> a -> (a,a)\n    -- | simultaneous 'div' and 'mod'\n    divMod              :: a -> a -> (a,a)\n    -- | conversion to 'Integer'\n    toInteger           :: a -> Integer\n\n    {-# INLINE quot #-}\n    {-# INLINE rem #-}\n    {-# INLINE div #-}\n    {-# INLINE mod #-}\n    n `quot` d          =  q  where (q,_) = quotRem n d\n    n `rem` d           =  r  where (_,r) = quotRem n d\n    n `div` d           =  q  where (q,_) = divMod n d\n    n `mod` d           =  r  where (_,r) = divMod n d\n\n    divMod n d          =  if signum r == negate (signum d) then (q-1, r+d) else qr\n                           where qr@(q,r) = quotRem n d\n\n-- | Fractional numbers, supporting real division.\n--\n-- The Haskell Report defines no laws for 'Fractional'. However, @('+')@ and\n-- @('*')@ are customarily expected to define a division ring and have the\n-- following properties:\n--\n-- [__'recip' gives the multiplicative inverse__]:\n-- @x * recip x@ = @recip x * x@ = @fromInteger 1@\n--\n-- Note that it /isn't/ customarily expected that a type instance of\n-- 'Fractional' implement a field. However, all instances in @base@ do.\nclass  (Num a) => Fractional a  where\n    {-# MINIMAL fromRational, (recip | (/)) #-}\n\n    -- | Fractional division.\n    (/)                 :: a -> a -> a\n    -- | Reciprocal fraction.\n    recip               :: a -> a\n    -- | Conversion from a 'Rational' (that is @'Ratio' 'Integer'@).\n    -- A floating literal stands for an application of 'fromRational'\n    -- to a value of type 'Rational', so such literals have type\n    -- @('Fractional' a) => a@.\n    fromRational        :: Rational -> a\n\n    {-# INLINE recip #-}\n    {-# INLINE (/) #-}\n    recip x             =  1 / x\n    x / y               = x * recip y\n\n-- | Extracting components of fractions.\nclass  (Real a, Fractional a) => RealFrac a  where\n    -- | The function 'properFraction' takes a real fractional number @x@\n    -- and returns a pair @(n,f)@ such that @x = n+f@, and:\n    --\n    -- * @n@ is an integral number with the same sign as @x@; and\n    --\n    -- * @f@ is a fraction with the same type and sign as @x@,\n    --   and with absolute value less than @1@.\n    --\n    -- The default definitions of the 'ceiling', 'floor', 'truncate'\n    -- and 'round' functions are in terms of 'properFraction'.\n    properFraction      :: (Integral b) => a -> (b,a)\n    -- | @'truncate' x@ returns the integer nearest @x@ between zero and @x@\n    truncate            :: (Integral b) => a -> b\n    -- | @'round' x@ returns the nearest integer to @x@;\n    --   the even integer if @x@ is equidistant between two integers\n    round               :: (Integral b) => a -> b\n    -- | @'ceiling' x@ returns the least integer not less than @x@\n    ceiling             :: (Integral b) => a -> b\n    -- | @'floor' x@ returns the greatest integer not greater than @x@\n    floor               :: (Integral b) => a -> b\n\n    {-# INLINE truncate #-}\n    truncate x          =  m  where (m,_) = properFraction x\n\n    round x             =  let (n,r) = properFraction x\n                               m     = if r < 0 then n - 1 else n + 1\n                           in case signum (abs r - 0.5) of\n                                -1 -> n\n                                0  -> if even n then n else m\n                                1  -> m\n                                _  -> errorWithoutStackTrace \"round default defn: Bad value\"\n\n    ceiling x           =  if r > 0 then n + 1 else n\n                           where (n,r) = properFraction x\n\n    floor x             =  if r < 0 then n - 1 else n\n                           where (n,r) = properFraction x\n\n-- These 'numeric' enumerations come straight from the Report\n\nnumericEnumFrom         :: (Fractional a) => a -> [a]\nnumericEnumFrom n       = go 0\n  where\n    -- See Note [Numeric Stability of Enumerating Floating Numbers]\n    go !k = let !n' = n + k\n             in n' : go (k + 1)\n\nnumericEnumFromThen     :: (Fractional a) => a -> a -> [a]\nnumericEnumFromThen n m = go 0\n  where\n    step = m - n\n    -- See Note [Numeric Stability of Enumerating Floating Numbers]\n    go !k = let !n' = n + k * step\n             in n' : go (k + 1)\n\nnumericEnumFromTo       :: (Ord a, Fractional a) => a -> a -> [a]\nnumericEnumFromTo n m   = takeWhile (<= m + 1/2) (numericEnumFrom n)\n\nnumericEnumFromThenTo   :: (Ord a, Fractional a) => a -> a -> a -> [a]\nnumericEnumFromThenTo e1 e2 e3\n    = takeWhile predicate (numericEnumFromThen e1 e2)\n                                where\n                                 mid = (e2 - e1) / 2\n                                 predicate | e2 >= e1  = (<= e3 + mid)\n                                           | otherwise = (>= e3 + mid)\n\n{- Note [Numeric Stability of Enumerating Floating Numbers]\n-----------------------------------------------------------\nWhen enumerate floating numbers, we could add the increment to the last number\nat every run (as what we did previously):\n\n    numericEnumFrom n =  n `seq` (n : numericEnumFrom (n + 1))\n\nThis approach is concise and really fast, only needs an addition operation.\nHowever when a floating number is large enough, for `n`, `n` and `n+1` will\nhave the same binary representation. For example (all number has type\n`Double`):\n\n    9007199254740990                 is: 0x433ffffffffffffe\n    9007199254740990 + 1             is: 0x433fffffffffffff\n    (9007199254740990 + 1) + 1       is: 0x4340000000000000\n    ((9007199254740990 + 1) + 1) + 1 is: 0x4340000000000000\n\nWhen we evaluate ([9007199254740990..9007199254740991] :: Double), we would\nnever reach the condition in `numericEnumFromTo`\n\n    9007199254740990 + 1 + 1 + ... > 9007199254740991 + 1/2\n\nWe would fall into infinite loop (as reported in Trac #15081).\n\nTo remedy the situation, we record the number of `1` that needed to be added\nto the start number, rather than increasing `1` at every time. This approach\ncan improvement the numeric stability greatly at the cost of a multiplication.\n\nFurthermore, we use the type of the enumerated number, `Fractional a => a`,\nas the type of multiplier. In rare situations, the multiplier could be very\nlarge and will lead to the enumeration to infinite loop, too, which should\nbe very rare. Consider the following example:\n\n    [1..9007199254740994]\n\nWe could fix that by using an Integer as multiplier but we don't do that.\nThe benchmark on T7954.hs shows that this approach leads to significant\ndegeneration on performance (33% increase allocation and 300% increase on\nelapsed time).\n\nSee Trac #15081 and Phab:D4650 for the related discussion about this problem.\n-}\n\n--------------------------------------------------------------\n-- Instances for Int\n--------------------------------------------------------------\n\n-- | @since 2.0.1\ninstance  Real Int  where\n    toRational x        =  toInteger x :% 1\n\n-- | @since 2.0.1\ninstance  Integral Int  where\n    toInteger (I# i) = smallInteger i\n\n    a `quot` b\n     | b == 0                     = divZeroError\n     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]\n                                                  -- in GHC.Int\n     | otherwise                  =  a `quotInt` b\n\n    a `rem` b\n     | b == 0                     = divZeroError\n       -- The quotRem CPU instruction fails for minBound `quotRem` -1,\n       -- but minBound `rem` -1 is well-defined (0). We therefore\n       -- special-case it.\n     | b == (-1)                  = 0\n     | otherwise                  =  a `remInt` b\n\n    a `div` b\n     | b == 0                     = divZeroError\n     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]\n                                                  -- in GHC.Int\n     | otherwise                  =  a `divInt` b\n\n    a `mod` b\n     | b == 0                     = divZeroError\n       -- The divMod CPU instruction fails for minBound `divMod` -1,\n       -- but minBound `mod` -1 is well-defined (0). We therefore\n       -- special-case it.\n     | b == (-1)                  = 0\n     | otherwise                  =  a `modInt` b\n\n    a `quotRem` b\n     | b == 0                     = divZeroError\n       -- Note [Order of tests] in GHC.Int\n     | b == (-1) && a == minBound = (overflowError, 0)\n     | otherwise                  =  a `quotRemInt` b\n\n    a `divMod` b\n     | b == 0                     = divZeroError\n       -- Note [Order of tests] in GHC.Int\n     | b == (-1) && a == minBound = (overflowError, 0)\n     | otherwise                  =  a `divModInt` b\n\n--------------------------------------------------------------\n-- Instances for @Word@\n--------------------------------------------------------------\n\n-- | @since 2.01\ninstance Real Word where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Integral Word where\n    quot    (W# x#) y@(W# y#)\n        | y /= 0                = W# (x# `quotWord#` y#)\n        | otherwise             = divZeroError\n    rem     (W# x#) y@(W# y#)\n        | y /= 0                = W# (x# `remWord#` y#)\n        | otherwise             = divZeroError\n    div     (W# x#) y@(W# y#)\n        | y /= 0                = W# (x# `quotWord#` y#)\n        | otherwise             = divZeroError\n    mod     (W# x#) y@(W# y#)\n        | y /= 0                = W# (x# `remWord#` y#)\n        | otherwise             = divZeroError\n    quotRem (W# x#) y@(W# y#)\n        | y /= 0                = case x# `quotRemWord#` y# of\n                                  (# q, r #) ->\n                                      (W# q, W# r)\n        | otherwise             = divZeroError\n    divMod  (W# x#) y@(W# y#)\n        | y /= 0                = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#))\n        | otherwise             = divZeroError\n    toInteger (W# x#)           = wordToInteger x#\n\n--------------------------------------------------------------\n-- Instances for Integer\n--------------------------------------------------------------\n\n-- | @since 2.0.1\ninstance  Real Integer  where\n    toRational x        =  x :% 1\n\n-- | @since 4.8.0.0\ninstance Real Natural where\n    toRational n = naturalToInteger n :% 1\n\n-- Note [Integer division constant folding]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- Constant folding of quot, rem, div, mod, divMod and quotRem for\n-- Integer arguments depends crucially on inlining. Constant folding\n-- rules defined in compiler/prelude/PrelRules.hs trigger for\n-- quotInteger, remInteger and so on. So if calls to quot, rem and so on\n-- were not inlined the rules would not fire. The rules would also not\n-- fire if calls to quotInteger and so on were inlined, but this does not\n-- happen because they are all marked with NOINLINE pragma - see documentation\n-- of integer-gmp or integer-simple.\n\n-- | @since 2.0.1\ninstance  Integral Integer where\n    toInteger n      = n\n\n    {-# INLINE quot #-}\n    _ `quot` 0 = divZeroError\n    n `quot` d = n `quotInteger` d\n\n    {-# INLINE rem #-}\n    _ `rem` 0 = divZeroError\n    n `rem` d = n `remInteger` d\n\n    {-# INLINE div #-}\n    _ `div` 0 = divZeroError\n    n `div` d = n `divInteger` d\n\n    {-# INLINE mod #-}\n    _ `mod` 0 = divZeroError\n    n `mod` d = n `modInteger` d\n\n    {-# INLINE divMod #-}\n    _ `divMod` 0 = divZeroError\n    n `divMod` d = case n `divModInteger` d of\n                     (# x, y #) -> (x, y)\n\n    {-# INLINE quotRem #-}\n    _ `quotRem` 0 = divZeroError\n    n `quotRem` d = case n `quotRemInteger` d of\n                      (# q, r #) -> (q, r)\n\n-- | @since 4.8.0.0\ninstance Integral Natural where\n    toInteger = naturalToInteger\n\n    divMod = quotRemNatural\n    div    = quotNatural\n    mod    = remNatural\n\n    quotRem = quotRemNatural\n    quot    = quotNatural\n    rem     = remNatural\n\n--------------------------------------------------------------\n-- Instances for @Ratio@\n--------------------------------------------------------------\n\n-- | @since 2.0.1\ninstance  (Integral a)  => Ord (Ratio a)  where\n    {-# SPECIALIZE instance Ord Rational #-}\n    (x:%y) <= (x':%y')  =  x * y' <= x' * y\n    (x:%y) <  (x':%y')  =  x * y' <  x' * y\n\n-- | @since 2.0.1\ninstance  (Integral a)  => Num (Ratio a)  where\n    {-# SPECIALIZE instance Num Rational #-}\n    (x:%y) + (x':%y')   =  reduce (x*y' + x'*y) (y*y')\n    (x:%y) - (x':%y')   =  reduce (x*y' - x'*y) (y*y')\n    (x:%y) * (x':%y')   =  reduce (x * x') (y * y')\n    negate (x:%y)       =  (-x) :% y\n    abs (x:%y)          =  abs x :% y\n    signum (x:%_)       =  signum x :% 1\n    fromInteger x       =  fromInteger x :% 1\n\n-- | @since 2.0.1\n{-# RULES \"fromRational/id\" fromRational = id :: Rational -> Rational #-}\ninstance  (Integral a)  => Fractional (Ratio a)  where\n    {-# SPECIALIZE instance Fractional Rational #-}\n    (x:%y) / (x':%y')   =  (x*y') % (y*x')\n    recip (0:%_)        = ratioZeroDenominatorError\n    recip (x:%y)\n        | x < 0         = negate y :% negate x\n        | otherwise     = y :% x\n    fromRational (x:%y) =  fromInteger x % fromInteger y\n\n-- | @since 2.0.1\ninstance  (Integral a)  => Real (Ratio a)  where\n    {-# SPECIALIZE instance Real Rational #-}\n    toRational (x:%y)   =  toInteger x :% toInteger y\n\n-- | @since 2.0.1\ninstance  (Integral a)  => RealFrac (Ratio a)  where\n    {-# SPECIALIZE instance RealFrac Rational #-}\n    properFraction (x:%y) = (fromInteger (toInteger q), r:%y)\n                          where (q,r) = quotRem x y\n\n-- | @since 2.0.1\ninstance  (Show a)  => Show (Ratio a)  where\n    {-# SPECIALIZE instance Show Rational #-}\n    showsPrec p (x:%y)  =  showParen (p > ratioPrec) $\n                           showsPrec ratioPrec1 x .\n                           showString \" % \" .\n                           -- H98 report has spaces round the %\n                           -- but we removed them [May 04]\n                           -- and added them again for consistency with\n                           -- Haskell 98 [Sep 08, #1920]\n                           showsPrec ratioPrec1 y\n\n-- | @since 2.0.1\ninstance  (Integral a)  => Enum (Ratio a)  where\n    {-# SPECIALIZE instance Enum Rational #-}\n    succ x              =  x + 1\n    pred x              =  x - 1\n\n    toEnum n            =  fromIntegral n :% 1\n    fromEnum            =  fromInteger . truncate\n\n    enumFrom            =  numericEnumFrom\n    enumFromThen        =  numericEnumFromThen\n    enumFromTo          =  numericEnumFromTo\n    enumFromThenTo      =  numericEnumFromThenTo\n\n--------------------------------------------------------------\n-- Coercions\n--------------------------------------------------------------\n\n-- | general coercion from integral types\n{-# NOINLINE [1] fromIntegral #-}\nfromIntegral :: (Integral a, Num b) => a -> b\nfromIntegral = fromInteger . toInteger\n\n{-# RULES\n\"fromIntegral/Int->Int\" fromIntegral = id :: Int -> Int\n    #-}\n\n{-# RULES\n\"fromIntegral/Int->Word\"  fromIntegral = \\(I# x#) -> W# (int2Word# x#)\n\"fromIntegral/Word->Int\"  fromIntegral = \\(W# x#) -> I# (word2Int# x#)\n\"fromIntegral/Word->Word\" fromIntegral = id :: Word -> Word\n    #-}\n\n{-# RULES\n\"fromIntegral/Natural->Natural\"  fromIntegral = id :: Natural -> Natural\n\"fromIntegral/Natural->Integer\"  fromIntegral = toInteger :: Natural->Integer\n\"fromIntegral/Natural->Word\"     fromIntegral = naturalToWord\n  #-}\n\n{-# RULES\n\"fromIntegral/Word->Natural\"     fromIntegral = wordToNatural\n\"fromIntegral/Int->Natural\"     fromIntegral = intToNatural\n  #-}\n\n-- | general coercion to fractional types\nrealToFrac :: (Real a, Fractional b) => a -> b\n{-# NOINLINE [1] realToFrac #-}\nrealToFrac = fromRational . toRational\n\n--------------------------------------------------------------\n-- Overloaded numeric functions\n--------------------------------------------------------------\n\n-- | Converts a possibly-negative 'Real' value to a string.\nshowSigned :: (Real a)\n  => (a -> ShowS)       -- ^ a function that can show unsigned values\n  -> Int                -- ^ the precedence of the enclosing context\n  -> a                  -- ^ the value to show\n  -> ShowS\nshowSigned showPos p x\n   | x < 0     = showParen (p > 6) (showChar '-' . showPos (-x))\n   | otherwise = showPos x\n\neven, odd       :: (Integral a) => a -> Bool\neven n          =  n `rem` 2 == 0\nodd             =  not . even\n{-# INLINABLE even #-}\n{-# INLINABLE odd  #-}\n\n-------------------------------------------------------\n-- | raise a number to a non-negative integral power\n{-# SPECIALISE [1] (^) ::\n        Integer -> Integer -> Integer,\n        Integer -> Int -> Integer,\n        Int -> Int -> Int #-}\n{-# INLINABLE [1] (^) #-}    -- See Note [Inlining (^)]\n(^) :: (Num a, Integral b) => a -> b -> a\nx0 ^ y0 | y0 < 0    = errorWithoutStackTrace \"Negative exponent\"\n        | y0 == 0   = 1\n        | otherwise = f x0 y0\n    where -- f : x0 ^ y0 = x ^ y\n          f x y | even y    = f (x * x) (y `quot` 2)\n                | y == 1    = x\n                | otherwise = g (x * x) (y `quot` 2) x         -- See Note [Half of y - 1]\n          -- g : x0 ^ y0 = (x ^ y) * z\n          g x y z | even y = g (x * x) (y `quot` 2) z\n                  | y == 1 = x * z\n                  | otherwise = g (x * x) (y `quot` 2) (x * z) -- See Note [Half of y - 1]\n\n-- | raise a number to an integral power\n(^^)            :: (Fractional a, Integral b) => a -> b -> a\n{-# INLINABLE [1] (^^) #-}         -- See Note [Inlining (^)\nx ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))\n\n{- Note [Half of y - 1]\n   ~~~~~~~~~~~~~~~~~~~~~\n   Since y is guaranteed to be odd and positive here,\n   half of y - 1 can be computed as y `quot` 2, optimising subtraction away.\n-}\n\n{- Note [Inlining (^)\n   ~~~~~~~~~~~~~~~~~~~~~\n   The INLINABLE pragma allows (^) to be specialised at its call sites.\n   If it is called repeatedly at the same type, that can make a huge\n   difference, because of those constants which can be repeatedly\n   calculated.\n\n   Currently the fromInteger calls are not floated because we get\n             \\d1 d2 x y -> blah\n   after the gentle round of simplification. -}\n\n{- Rules for powers with known small exponent\n    see #5237\n    For small exponents, (^) is inefficient compared to manually\n    expanding the multiplication tree.\n    Here, rules for the most common exponent types are given.\n    The range of exponents for which rules are given is quite\n    arbitrary and kept small to not unduly increase the number of rules.\n    0 and 1 are excluded based on the assumption that nobody would\n    write x^0 or x^1 in code and the cases where an exponent could\n    be statically resolved to 0 or 1 are rare.\n\n    It might be desirable to have corresponding rules also for\n    exponents of other types (e. g., Word), but it's doubtful they\n    would fire, since the exponents of other types tend to get\n    floated out before the rule has a chance to fire.\n\n    Also desirable would be rules for (^^), but I haven't managed\n    to get those to fire.\n\n    Note: Trying to save multiplications by sharing the square for\n    exponents 4 and 5 does not save time, indeed, for Double, it is\n    up to twice slower, so the rules contain flat sequences of\n    multiplications.\n-}\n\n{-# RULES\n\"^2/Int\"        forall x. x ^ (2 :: Int) = let u = x in u*u\n\"^3/Int\"        forall x. x ^ (3 :: Int) = let u = x in u*u*u\n\"^4/Int\"        forall x. x ^ (4 :: Int) = let u = x in u*u*u*u\n\"^5/Int\"        forall x. x ^ (5 :: Int) = let u = x in u*u*u*u*u\n\"^2/Integer\"    forall x. x ^ (2 :: Integer) = let u = x in u*u\n\"^3/Integer\"    forall x. x ^ (3 :: Integer) = let u = x in u*u*u\n\"^4/Integer\"    forall x. x ^ (4 :: Integer) = let u = x in u*u*u*u\n\"^5/Integer\"    forall x. x ^ (5 :: Integer) = let u = x in u*u*u*u*u\n  #-}\n\n-------------------------------------------------------\n-- Special power functions for Rational\n--\n-- see #4337\n--\n-- Rationale:\n-- For a legitimate Rational (n :% d), the numerator and denominator are\n-- coprime, i.e. they have no common prime factor.\n-- Therefore all powers (n ^ a) and (d ^ b) are also coprime, so it is\n-- not necessary to compute the greatest common divisor, which would be\n-- done in the default implementation at each multiplication step.\n-- Since exponentiation quickly leads to very large numbers and\n-- calculation of gcds is generally very slow for large numbers,\n-- avoiding the gcd leads to an order of magnitude speedup relatively\n-- soon (and an asymptotic improvement overall).\n--\n-- Note:\n-- We cannot use these functions for general Ratio a because that would\n-- change results in a multitude of cases.\n-- The cause is that if a and b are coprime, their remainders by any\n-- positive modulus generally aren't, so in the default implementation\n-- reduction occurs.\n--\n-- Example:\n-- (17 % 3) ^ 3 :: Ratio Word8\n-- Default:\n-- (17 % 3) ^ 3 = ((17 % 3) ^ 2) * (17 % 3)\n--              = ((289 `mod` 256) % 9) * (17 % 3)\n--              = (33 % 9) * (17 % 3)\n--              = (11 % 3) * (17 % 3)\n--              = (187 % 9)\n-- But:\n-- ((17^3) `mod` 256) % (3^3)   = (4913 `mod` 256) % 27\n--                              = 49 % 27\n--\n-- TODO:\n-- Find out whether special-casing for numerator, denominator or\n-- exponent = 1 (or -1, where that may apply) gains something.\n\n-- Special version of (^) for Rational base\n{-# RULES \"(^)/Rational\"    (^) = (^%^) #-}\n(^%^)           :: Integral a => Rational -> a -> Rational\n(n :% d) ^%^ e\n    | e < 0     = errorWithoutStackTrace \"Negative exponent\"\n    | e == 0    = 1 :% 1\n    | otherwise = (n ^ e) :% (d ^ e)\n\n-- Special version of (^^) for Rational base\n{-# RULES \"(^^)/Rational\"   (^^) = (^^%^^) #-}\n(^^%^^)         :: Integral a => Rational -> a -> Rational\n(n :% d) ^^%^^ e\n    | e > 0     = (n ^ e) :% (d ^ e)\n    | e == 0    = 1 :% 1\n    | n > 0     = (d ^ (negate e)) :% (n ^ (negate e))\n    | n == 0    = ratioZeroDenominatorError\n    | otherwise = let nn = d ^ (negate e)\n                      dd = (negate n) ^ (negate e)\n                  in if even e then (nn :% dd) else (negate nn :% dd)\n\n-------------------------------------------------------\n-- | @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which\n-- every common factor of @x@ and @y@ is also a factor; for example\n-- @'gcd' 4 2 = 2@, @'gcd' (-4) 6 = 2@, @'gcd' 0 4@ = @4@. @'gcd' 0 0@ = @0@.\n-- (That is, the common divisor that is \\\"greatest\\\" in the divisibility\n-- preordering.)\n--\n-- Note: Since for signed fixed-width integer types, @'abs' 'minBound' < 0@,\n-- the result may be negative if one of the arguments is @'minBound'@ (and\n-- necessarily is if the other is @0@ or @'minBound'@) for such types.\ngcd             :: (Integral a) => a -> a -> a\n{-# NOINLINE [1] gcd #-}\ngcd x y         =  gcd' (abs x) (abs y)\n                   where gcd' a 0  =  a\n                         gcd' a b  =  gcd' b (a `rem` b)\n\n-- | @'lcm' x y@ is the smallest positive integer that both @x@ and @y@ divide.\nlcm             :: (Integral a) => a -> a -> a\n{-# SPECIALISE lcm :: Int -> Int -> Int #-}\n{-# SPECIALISE lcm :: Word -> Word -> Word #-}\n{-# NOINLINE [1] lcm #-}\nlcm _ 0         =  0\nlcm 0 _         =  0\nlcm x y         =  abs ((x `quot` (gcd x y)) * y)\n\n{-# RULES\n\"gcd/Integer->Integer->Integer\" gcd = gcdInteger\n\"lcm/Integer->Integer->Integer\" lcm = lcmInteger\n\"gcd/Natural->Natural->Natural\" gcd = gcdNatural\n\"lcm/Natural->Natural->Natural\" lcm = lcmNatural\n #-}\n\n#if defined(MIN_VERSION_integer_gmp)\n-- GMP defines a more efficient Int# and Word# GCD\n\ngcdInt' :: Int -> Int -> Int\ngcdInt' (I# x) (I# y) = I# (gcdInt x y)\n\ngcdWord' :: Word -> Word -> Word\ngcdWord' (W# x) (W# y) = W# (gcdWord x y)\n\n{-# RULES\n\"gcd/Int->Int->Int\"             gcd = gcdInt'\n\"gcd/Word->Word->Word\"          gcd = gcdWord'\n #-}\n\n#endif\n\nintegralEnumFrom :: (Integral a, Bounded a) => a -> [a]\nintegralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)]\n\nintegralEnumFromThen :: (Integral a, Bounded a) => a -> a -> [a]\nintegralEnumFromThen n1 n2\n  | i_n2 >= i_n1  = map fromInteger [i_n1, i_n2 .. toInteger (maxBound `asTypeOf` n1)]\n  | otherwise     = map fromInteger [i_n1, i_n2 .. toInteger (minBound `asTypeOf` n1)]\n  where\n    i_n1 = toInteger n1\n    i_n2 = toInteger n2\n\nintegralEnumFromTo :: Integral a => a -> a -> [a]\nintegralEnumFromTo n m = map fromInteger [toInteger n .. toInteger m]\n\nintegralEnumFromThenTo :: Integral a => a -> a -> a -> [a]\nintegralEnumFromThenTo n1 n2 m\n  = map fromInteger [toInteger n1, toInteger n2 .. toInteger m]\n", "num_lines": 795}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes\n           , FunctionalDependencies\n           , KindSignatures\n           , MultiParamTypeClasses\n           , PolyKinds\n  #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Records\n-- Copyright   :  (c) Adam Gundry 2015-2016\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- This module defines the 'HasField' class used by the\n-- @OverloadedRecordFields@ extension.  See the\n-- <https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields\n-- wiki page> for more details.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Records\n       ( HasField(..)\n       ) where\n\n-- | Constraint representing the fact that the field @x@ belongs to\n-- the record type @r@ and has field type @a@.  This will be solved\n-- automatically, but manual instances may be provided as well.\n\n--   HasField :: forall {k}. k -> * -> * -> Constraint\n--   getField :: forall {k} (x::k) r a. HasField x r a => r -> a\n-- NB: The {k} means that k is an 'inferred' type variable, and\n--     hence not provided in visible type applications.  Thus you\n--     say     getField @\"foo\"\n--     not     getField @Symbol @\"foo\"\nclass HasField x r a | x r -> a where\n  -- | Selector function to extract the field from the record.\n  getField :: r -> a\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.ResponseFile\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  portable\n--\n-- GCC style response files.\n--\n-- @since 4.12.0.0\n----------------------------------------------------------------------------\n\n-- Migrated from Haddock.\n\nmodule GHC.ResponseFile (\n    getArgsWithResponseFiles,\n    unescapeArgs,\n    escapeArgs,\n    expandResponse\n  ) where\n\nimport Control.Exception\nimport Data.Char          (isSpace)\nimport Data.Foldable      (foldl')\nimport System.Environment (getArgs)\nimport System.Exit        (exitFailure)\nimport System.IO\n\n{-|\nLike 'getArgs', but can also read arguments supplied via response files.\n\n\nFor example, consider a program @foo@:\n\n@\nmain :: IO ()\nmain = do\n  args <- getArgsWithResponseFiles\n  putStrLn (show args)\n@\n\n\nAnd a response file @args.txt@:\n\n@\n--one 1\n--\\'two\\' 2\n--\"three\" 3\n@\n\nThen the result of invoking @foo@ with @args.txt@ is:\n\n> > ./foo @args.txt\n> [\"--one\",\"1\",\"--two\",\"2\",\"--three\",\"3\"]\n\n-}\ngetArgsWithResponseFiles :: IO [String]\ngetArgsWithResponseFiles = getArgs >>= expandResponse\n\n-- | Given a string of concatenated strings, separate each by removing\n-- a layer of /quoting/ and\\/or /escaping/ of certain characters.\n--\n-- These characters are: any whitespace, single quote, double quote,\n-- and the backslash character.  The backslash character always\n-- escapes (i.e., passes through without further consideration) the\n-- character which follows.  Characters can also be escaped in blocks\n-- by quoting (i.e., surrounding the blocks with matching pairs of\n-- either single- or double-quotes which are not themselves escaped).\n--\n-- Any whitespace which appears outside of either of the quoting and\n-- escaping mechanisms, is interpreted as having been added by this\n-- special concatenation process to designate where the boundaries\n-- are between the original, un-concatenated list of strings.  These\n-- added whitespace characters are removed from the output.\n--\n-- > unescapeArgs \"hello\\\\ \\\\\\\"world\\\\\\\"\\n\" == escapeArgs \"hello \\\"world\\\"\"\nunescapeArgs :: String -> [String]\nunescapeArgs = filter (not . null) . unescape\n\n-- | Given a list of strings, concatenate them into a single string\n-- with escaping of certain characters, and the addition of a newline\n-- between each string.  The escaping is done by adding a single\n-- backslash character before any whitespace, single quote, double\n-- quote, or backslash character, so this escaping character must be\n-- removed.  Unescaped whitespace (in this case, newline) is part\n-- of this \"transport\" format to indicate the end of the previous\n-- string and the start of a new string.\n--\n-- While 'unescapeArgs' allows using quoting (i.e., convenient\n-- escaping of many characters) by having matching sets of single- or\n-- double-quotes,'escapeArgs' does not use the quoting mechasnism,\n-- and thus will always escape any whitespace, quotes, and\n-- backslashes.\n--\n-- > unescapeArgs \"hello\\\\ \\\\\\\"world\\\\\\\"\\\\n\" == escapeArgs \"hello \\\"world\\\"\"\nescapeArgs :: [String] -> String\nescapeArgs = unlines . map escapeArg\n\n-- | Arguments which look like @\\@foo@ will be replaced with the\n-- contents of file @foo@. A gcc-like syntax for response files arguments\n-- is expected.  This must re-constitute the argument list by doing an\n-- inverse of the escaping mechanism done by the calling-program side.\n--\n-- We quit if the file is not found or reading somehow fails.\n-- (A convenience routine for haddock or possibly other clients)\nexpandResponse :: [String] -> IO [String]\nexpandResponse = fmap concat . mapM expand\n  where\n    expand :: String -> IO [String]\n    expand ('@':f) = readFileExc f >>= return . unescapeArgs\n    expand x = return [x]\n\n    readFileExc f =\n      readFile f `catch` \\(e :: IOException) -> do\n        hPutStrLn stderr $ \"Error while expanding response file: \" ++ show e\n        exitFailure\n\ndata Quoting = NoneQ | SngQ | DblQ\n\nunescape :: String -> [String]\nunescape args = reverse . map reverse $ go args NoneQ False [] []\n    where\n      -- n.b., the order of these cases matters; these are cribbed from gcc\n      -- case 1: end of input\n      go []     _q    _bs   a as = a:as\n      -- case 2: back-slash escape in progress\n      go (c:cs) q     True  a as = go cs q     False (c:a) as\n      -- case 3: no back-slash escape in progress, but got a back-slash\n      go (c:cs) q     False a as\n        | '\\\\' == c              = go cs q     True  a     as\n      -- case 4: single-quote escaping in progress\n      go (c:cs) SngQ  False a as\n        | '\\'' == c              = go cs NoneQ False a     as\n        | otherwise              = go cs SngQ  False (c:a) as\n      -- case 5: double-quote escaping in progress\n      go (c:cs) DblQ  False a as\n        | '\"' == c               = go cs NoneQ False a     as\n        | otherwise              = go cs DblQ  False (c:a) as\n      -- case 6: no escaping is in progress\n      go (c:cs) NoneQ False a as\n        | isSpace c              = go cs NoneQ False []    (a:as)\n        | '\\'' == c              = go cs SngQ  False a     as\n        | '\"'  == c              = go cs DblQ  False a     as\n        | otherwise              = go cs NoneQ False (c:a) as\n\nescapeArg :: String -> String\nescapeArg = reverse . foldl' escape []\n\nescape :: String -> Char -> String\nescape cs c\n  |    isSpace c\n    || '\\\\' == c\n    || '\\'' == c\n    || '\"'  == c = c:'\\\\':cs -- n.b., our caller must reverse the result\n  | otherwise    = c:cs\n", "num_lines": 160}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, StandaloneDeriving,\n             MagicHash, UnboxedTuples #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n#include \"MachDeps.h\"\n#if SIZEOF_HSWORD == 4\n#define DIGITS       9\n#define BASE         1000000000\n#elif SIZEOF_HSWORD == 8\n#define DIGITS       18\n#define BASE         1000000000000000000\n#else\n#error Please define DIGITS and BASE\n-- DIGITS should be the largest integer such that\n--     10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1)\n-- BASE should be 10^DIGITS. Note that ^ is not available yet.\n#endif\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Show\n-- Copyright   :  (c) The University of Glasgow, 1992-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The 'Show' class, and related operations.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Show\n        (\n        Show(..), ShowS,\n\n        -- Instances for Show: (), [], Bool, Ordering, Int, Char\n\n        -- Show support code\n        shows, showChar, showString, showMultiLineString,\n        showParen, showList__, showCommaSpace, showSpace,\n        showLitChar, showLitString, protectEsc,\n        intToDigit, showSignedInt,\n        appPrec, appPrec1,\n\n        -- Character operations\n        asciiTab,\n  )\n        where\n\nimport GHC.Base\nimport GHC.List ((!!), foldr1, break)\nimport GHC.Num\nimport GHC.Stack.Types\n\n\n-- | The @shows@ functions return a function that prepends the\n-- output 'String' to an existing 'String'.  This allows constant-time\n-- concatenation of results using function composition.\ntype ShowS = String -> String\n\n-- | Conversion of values to readable 'String's.\n--\n-- Derived instances of 'Show' have the following properties, which\n-- are compatible with derived instances of 'Text.Read.Read':\n--\n-- * The result of 'show' is a syntactically correct Haskell\n--   expression containing only constants, given the fixity\n--   declarations in force at the point where the type is declared.\n--   It contains only the constructor names defined in the data type,\n--   parentheses, and spaces.  When labelled constructor fields are\n--   used, braces, commas, field names, and equal signs are also used.\n--\n-- * If the constructor is defined to be an infix operator, then\n--   'showsPrec' will produce infix applications of the constructor.\n--\n-- * the representation will be enclosed in parentheses if the\n--   precedence of the top-level constructor in @x@ is less than @d@\n--   (associativity is ignored).  Thus, if @d@ is @0@ then the result\n--   is never surrounded in parentheses; if @d@ is @11@ it is always\n--   surrounded in parentheses, unless it is an atomic expression.\n--\n-- * If the constructor is defined using record syntax, then 'show'\n--   will produce the record-syntax form, with the fields given in the\n--   same order as the original declaration.\n--\n-- For example, given the declarations\n--\n-- > infixr 5 :^:\n-- > data Tree a =  Leaf a  |  Tree a :^: Tree a\n--\n-- the derived instance of 'Show' is equivalent to\n--\n-- > instance (Show a) => Show (Tree a) where\n-- >\n-- >        showsPrec d (Leaf m) = showParen (d > app_prec) $\n-- >             showString \"Leaf \" . showsPrec (app_prec+1) m\n-- >          where app_prec = 10\n-- >\n-- >        showsPrec d (u :^: v) = showParen (d > up_prec) $\n-- >             showsPrec (up_prec+1) u .\n-- >             showString \" :^: \"      .\n-- >             showsPrec (up_prec+1) v\n-- >          where up_prec = 5\n--\n-- Note that right-associativity of @:^:@ is ignored.  For example,\n--\n-- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string\n--   @\\\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\\\"@.\n\nclass  Show a  where\n    {-# MINIMAL showsPrec | show #-}\n\n    -- | Convert a value to a readable 'String'.\n    --\n    -- 'showsPrec' should satisfy the law\n    --\n    -- > showsPrec d x r ++ s  ==  showsPrec d x (r ++ s)\n    --\n    -- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following:\n    --\n    -- * @(x,\\\"\\\")@ is an element of\n    --   @('Text.Read.readsPrec' d ('showsPrec' d x \\\"\\\"))@.\n    --\n    -- That is, 'Text.Read.readsPrec' parses the string produced by\n    -- 'showsPrec', and delivers the value that 'showsPrec' started with.\n\n    showsPrec :: Int    -- ^ the operator precedence of the enclosing\n                        -- context (a number from @0@ to @11@).\n                        -- Function application has precedence @10@.\n              -> a      -- ^ the value to be converted to a 'String'\n              -> ShowS\n\n    -- | A specialised variant of 'showsPrec', using precedence context\n    -- zero, and returning an ordinary 'String'.\n    show      :: a   -> String\n\n    -- | The method 'showList' is provided to allow the programmer to\n    -- give a specialised way of showing lists of values.\n    -- For example, this is used by the predefined 'Show' instance of\n    -- the 'Char' type, where values of type 'String' should be shown\n    -- in double quotes, rather than between square brackets.\n    showList  :: [a] -> ShowS\n\n    showsPrec _ x s = show x ++ s\n    show x          = shows x \"\"\n    showList ls   s = showList__ shows ls s\n\nshowList__ :: (a -> ShowS) ->  [a] -> ShowS\nshowList__ _     []     s = \"[]\" ++ s\nshowList__ showx (x:xs) s = '[' : showx x (showl xs)\n  where\n    showl []     = ']' : s\n    showl (y:ys) = ',' : showx y (showl ys)\n\nappPrec, appPrec1 :: Int\n        -- Use unboxed stuff because we don't have overloaded numerics yet\nappPrec = I# 10#        -- Precedence of application:\n                        --   one more than the maximum operator precedence of 9\nappPrec1 = I# 11#       -- appPrec + 1\n\n--------------------------------------------------------------\n-- Simple Instances\n--------------------------------------------------------------\n\n-- | @since 2.01\nderiving instance Show ()\n\n-- | @since 2.01\ninstance Show a => Show [a]  where\n  {-# SPECIALISE instance Show [String] #-}\n  {-# SPECIALISE instance Show [Char] #-}\n  {-# SPECIALISE instance Show [Int] #-}\n  showsPrec _         = showList\n\n-- | @since 2.01\nderiving instance Show Bool\n\n-- | @since 2.01\nderiving instance Show Ordering\n\n-- | @since 2.01\ninstance  Show Char  where\n    showsPrec _ '\\'' = showString \"'\\\\''\"\n    showsPrec _ c    = showChar '\\'' . showLitChar c . showChar '\\''\n\n    showList cs = showChar '\"' . showLitString cs . showChar '\"'\n\n-- | @since 2.01\ninstance Show Int where\n    showsPrec = showSignedInt\n\n-- | @since 2.01\ninstance Show Word where\n    showsPrec _ (W# w) = showWord w\n\nshowWord :: Word# -> ShowS\nshowWord w# cs\n | isTrue# (w# `ltWord#` 10##) = C# (chr# (ord# '0'# +# word2Int# w#)) : cs\n | otherwise = case chr# (ord# '0'# +# word2Int# (w# `remWord#` 10##)) of\n               c# ->\n                   showWord (w# `quotWord#` 10##) (C# c# : cs)\n\n-- | @since 2.01\nderiving instance Show a => Show (Maybe a)\n\n-- | @since 4.11.0.0\nderiving instance Show a => Show (NonEmpty a)\n\n-- | @since 2.01\ninstance Show TyCon where\n  showsPrec p (TyCon _ _ _ tc_name _ _) = showsPrec p tc_name\n\n-- | @since 4.9.0.0\ninstance Show TrName where\n  showsPrec _ (TrNameS s) = showString (unpackCStringUtf8# s)\n  showsPrec _ (TrNameD s) = showString s\n\n-- | @since 4.9.0.0\ninstance Show Module where\n  showsPrec _ (Module p m) = shows p . (':' :) . shows m\n\n-- | @since 4.9.0.0\ninstance Show CallStack where\n  showsPrec _ = shows . getCallStack\n\n-- | @since 4.9.0.0\nderiving instance Show SrcLoc\n\n--------------------------------------------------------------\n-- Show instances for the first few tuple\n--------------------------------------------------------------\n\n-- The explicit 's' parameters are important\n-- Otherwise GHC thinks that \"shows x\" might take a lot of work to compute\n-- and generates defns like\n--      showsPrec _ (x,y) = let sx = shows x; sy = shows y in\n--                          \\s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))\n\n-- | @since 2.01\ninstance  (Show a, Show b) => Show (a,b)  where\n  showsPrec _ (a,b) s = show_tuple [shows a, shows b] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c) => Show (a, b, c) where\n  showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where\n  showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where\n  showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where\n  showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)\n        => Show (a,b,c,d,e,f,g) where\n  showsPrec _ (a,b,c,d,e,f,g) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)\n         => Show (a,b,c,d,e,f,g,h) where\n  showsPrec _ (a,b,c,d,e,f,g,h) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i)\n         => Show (a,b,c,d,e,f,g,h,i) where\n  showsPrec _ (a,b,c,d,e,f,g,h,i) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,\n                      shows i] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j)\n         => Show (a,b,c,d,e,f,g,h,i,j) where\n  showsPrec _ (a,b,c,d,e,f,g,h,i,j) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,\n                      shows i, shows j] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k)\n         => Show (a,b,c,d,e,f,g,h,i,j,k) where\n  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,\n                      shows i, shows j, shows k] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,\n          Show l)\n         => Show (a,b,c,d,e,f,g,h,i,j,k,l) where\n  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,\n                      shows i, shows j, shows k, shows l] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,\n          Show l, Show m)\n         => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where\n  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,\n                      shows i, shows j, shows k, shows l, shows m] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,\n          Show l, Show m, Show n)\n         => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where\n  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,\n                      shows i, shows j, shows k, shows l, shows m, shows n] s\n\n-- | @since 2.01\ninstance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,\n          Show l, Show m, Show n, Show o)\n         => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where\n  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) s\n        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,\n                      shows i, shows j, shows k, shows l, shows m, shows n, shows o] s\n\nshow_tuple :: [ShowS] -> ShowS\nshow_tuple ss = showChar '('\n              . foldr1 (\\s r -> s . showChar ',' . r) ss\n              . showChar ')'\n\n--------------------------------------------------------------\n-- Support code for Show\n--------------------------------------------------------------\n\n-- | equivalent to 'showsPrec' with a precedence of 0.\nshows           :: (Show a) => a -> ShowS\nshows           =  showsPrec 0\n\n-- | utility function converting a 'Char' to a show function that\n-- simply prepends the character unchanged.\nshowChar        :: Char -> ShowS\nshowChar        =  (:)\n\n-- | utility function converting a 'String' to a show function that\n-- simply prepends the string unchanged.\nshowString      :: String -> ShowS\nshowString      =  (++)\n\n-- | utility function that surrounds the inner show function with\n-- parentheses when the 'Bool' parameter is 'True'.\nshowParen       :: Bool -> ShowS -> ShowS\nshowParen b p   =  if b then showChar '(' . p . showChar ')' else p\n\nshowSpace :: ShowS\nshowSpace = {-showChar ' '-} \\ xs -> ' ' : xs\n\nshowCommaSpace :: ShowS\nshowCommaSpace = showString \", \"\n-- Code specific for characters\n\n-- | Convert a character to a string using only printable characters,\n-- using Haskell source-language escape conventions.  For example:\n--\n-- > showLitChar '\\n' s  =  \"\\\\n\" ++ s\n--\nshowLitChar                :: Char -> ShowS\nshowLitChar c s | c > '\\DEL' =  showChar '\\\\' (protectEsc isDec (shows (ord c)) s)\nshowLitChar '\\DEL'         s =  showString \"\\\\DEL\" s\nshowLitChar '\\\\'           s =  showString \"\\\\\\\\\" s\nshowLitChar c s | c >= ' '   =  showChar c s\nshowLitChar '\\a'           s =  showString \"\\\\a\" s\nshowLitChar '\\b'           s =  showString \"\\\\b\" s\nshowLitChar '\\f'           s =  showString \"\\\\f\" s\nshowLitChar '\\n'           s =  showString \"\\\\n\" s\nshowLitChar '\\r'           s =  showString \"\\\\r\" s\nshowLitChar '\\t'           s =  showString \"\\\\t\" s\nshowLitChar '\\v'           s =  showString \"\\\\v\" s\nshowLitChar '\\SO'          s =  protectEsc (== 'H') (showString \"\\\\SO\") s\nshowLitChar c              s =  showString ('\\\\' : asciiTab!!ord c) s\n        -- I've done manual eta-expansion here, because otherwise it's\n        -- impossible to stop (asciiTab!!ord) getting floated out as an MFE\n\nshowLitString :: String -> ShowS\n-- | Same as 'showLitChar', but for strings\n-- It converts the string to a string using Haskell escape conventions\n-- for non-printable characters. Does not add double-quotes around the\n-- whole thing; the caller should do that.\n-- The main difference from showLitChar (apart from the fact that the\n-- argument is a string not a list) is that we must escape double-quotes\nshowLitString []         s = s\nshowLitString ('\"' : cs) s = showString \"\\\\\\\"\" (showLitString cs s)\nshowLitString (c   : cs) s = showLitChar c (showLitString cs s)\n   -- Making 's' an explicit parameter makes it clear to GHC that\n   -- showLitString has arity 2, which avoids it allocating an extra lambda\n   -- The sticking point is the recursive call to (showLitString cs), which\n   -- it can't figure out would be ok with arity 2.\n\nshowMultiLineString :: String -> [String]\n-- | Like 'showLitString' (expand escape characters using Haskell\n-- escape conventions), but\n--   * break the string into multiple lines\n--   * wrap the entire thing in double quotes\n-- Example:  @showMultiLineString \"hello\\ngoodbye\\nblah\"@\n-- returns   @[\"\\\"hello\\\\n\\\\\", \"\\\\goodbye\\n\\\\\", \"\\\\blah\\\"\"]@\nshowMultiLineString str\n  = go '\\\"' str\n  where\n    go ch s = case break (== '\\n') s of\n                (l, _:s'@(_:_)) -> (ch : showLitString l \"\\\\n\\\\\") : go '\\\\' s'\n                (l, \"\\n\")       -> [ch : showLitString l \"\\\\n\\\"\"]\n                (l, _)          -> [ch : showLitString l \"\\\"\"]\n\nisDec :: Char -> Bool\nisDec c = c >= '0' && c <= '9'\n\nprotectEsc :: (Char -> Bool) -> ShowS -> ShowS\nprotectEsc p f             = f . cont\n                             where cont s@(c:_) | p c = \"\\\\&\" ++ s\n                                   cont s             = s\n\n\nasciiTab :: [String]\nasciiTab = -- Using an array drags in the array module.  listArray ('\\NUL', ' ')\n           [\"NUL\", \"SOH\", \"STX\", \"ETX\", \"EOT\", \"ENQ\", \"ACK\", \"BEL\",\n            \"BS\",  \"HT\",  \"LF\",  \"VT\",  \"FF\",  \"CR\",  \"SO\",  \"SI\",\n            \"DLE\", \"DC1\", \"DC2\", \"DC3\", \"DC4\", \"NAK\", \"SYN\", \"ETB\",\n            \"CAN\", \"EM\",  \"SUB\", \"ESC\", \"FS\",  \"GS\",  \"RS\",  \"US\",\n            \"SP\"]\n\n-- Code specific for Ints.\n\n-- | Convert an 'Int' in the range @0@..@15@ to the corresponding single\n-- digit 'Char'.  This function fails on other inputs, and generates\n-- lower-case hexadecimal digits.\nintToDigit :: Int -> Char\nintToDigit (I# i)\n    | isTrue# (i >=# 0#)  && isTrue# (i <=#  9#) = unsafeChr (ord '0' + I# i)\n    | isTrue# (i >=# 10#) && isTrue# (i <=# 15#) = unsafeChr (ord 'a' + I# i - 10)\n    | otherwise =  errorWithoutStackTrace (\"Char.intToDigit: not a digit \" ++ show (I# i))\n\nshowSignedInt :: Int -> Int -> ShowS\nshowSignedInt (I# p) (I# n) r\n    | isTrue# (n <# 0#) && isTrue# (p ># 6#) = '(' : itos n (')' : r)\n    | otherwise                              = itos n r\n\nitos :: Int# -> String -> String\nitos n# cs\n    | isTrue# (n# <# 0#) =\n        let !(I# minInt#) = minInt in\n        if isTrue# (n# ==# minInt#)\n                -- negateInt# minInt overflows, so we can't do that:\n           then '-' : (case n# `quotRemInt#` 10# of\n                       (# q, r #) ->\n                           itos' (negateInt# q) (itos' (negateInt# r) cs))\n           else '-' : itos' (negateInt# n#) cs\n    | otherwise = itos' n# cs\n    where\n    itos' :: Int# -> String -> String\n    itos' x# cs'\n        | isTrue# (x# <# 10#) = C# (chr# (ord# '0'# +# x#)) : cs'\n        | otherwise = case x# `quotRemInt#` 10# of\n                      (# q, r #) ->\n                          case chr# (ord# '0'# +# r) of\n                          c# ->\n                              itos' q (C# c# : cs')\n\n--------------------------------------------------------------\n-- The Integer instances for Show\n--------------------------------------------------------------\n\n-- | @since 2.01\ninstance Show Integer where\n    showsPrec p n r\n        | p > 6 && n < 0 = '(' : integerToString n (')' : r)\n        -- Minor point: testing p first gives better code\n        -- in the not-uncommon case where the p argument\n        -- is a constant\n        | otherwise = integerToString n r\n    showList = showList__ (showsPrec 0)\n\n-- | @since 4.8.0.0\ninstance Show Natural where\n#if defined(MIN_VERSION_integer_gmp)\n    showsPrec p (NatS# w#) = showsPrec p (W# w#)\n#endif\n    showsPrec p i          = showsPrec p (naturalToInteger i)\n\n-- Divide and conquer implementation of string conversion\nintegerToString :: Integer -> String -> String\nintegerToString n0 cs0\n    | n0 < 0    = '-' : integerToString' (- n0) cs0\n    | otherwise = integerToString' n0 cs0\n    where\n    integerToString' :: Integer -> String -> String\n    integerToString' n cs\n        | n < BASE  = jhead (fromInteger n) cs\n        | otherwise = jprinth (jsplitf (BASE*BASE) n) cs\n\n    -- Split n into digits in base p. We first split n into digits\n    -- in base p*p and then split each of these digits into two.\n    -- Note that the first 'digit' modulo p*p may have a leading zero\n    -- in base p that we need to drop - this is what jsplith takes care of.\n    -- jsplitb the handles the remaining digits.\n    jsplitf :: Integer -> Integer -> [Integer]\n    jsplitf p n\n        | p > n     = [n]\n        | otherwise = jsplith p (jsplitf (p*p) n)\n\n    jsplith :: Integer -> [Integer] -> [Integer]\n    jsplith p (n:ns) =\n        case n `quotRemInteger` p of\n        (# q, r #) ->\n            if q > 0 then q : r : jsplitb p ns\n                     else     r : jsplitb p ns\n    jsplith _ [] = errorWithoutStackTrace \"jsplith: []\"\n\n    jsplitb :: Integer -> [Integer] -> [Integer]\n    jsplitb _ []     = []\n    jsplitb p (n:ns) = case n `quotRemInteger` p of\n                       (# q, r #) ->\n                           q : r : jsplitb p ns\n\n    -- Convert a number that has been split into digits in base BASE^2\n    -- this includes a last splitting step and then conversion of digits\n    -- that all fit into a machine word.\n    jprinth :: [Integer] -> String -> String\n    jprinth (n:ns) cs =\n        case n `quotRemInteger` BASE of\n        (# q', r' #) ->\n            let q = fromInteger q'\n                r = fromInteger r'\n            in if q > 0 then jhead q $ jblock r $ jprintb ns cs\n                        else jhead r $ jprintb ns cs\n    jprinth [] _ = errorWithoutStackTrace \"jprinth []\"\n\n    jprintb :: [Integer] -> String -> String\n    jprintb []     cs = cs\n    jprintb (n:ns) cs = case n `quotRemInteger` BASE of\n                        (# q', r' #) ->\n                            let q = fromInteger q'\n                                r = fromInteger r'\n                            in jblock q $ jblock r $ jprintb ns cs\n\n    -- Convert an integer that fits into a machine word. Again, we have two\n    -- functions, one that drops leading zeros (jhead) and one that doesn't\n    -- (jblock)\n    jhead :: Int -> String -> String\n    jhead n cs\n        | n < 10    = case unsafeChr (ord '0' + n) of\n            c@(C# _) -> c : cs\n        | otherwise = case unsafeChr (ord '0' + r) of\n            c@(C# _) -> jhead q (c : cs)\n        where\n        (q, r) = n `quotRemInt` 10\n\n    jblock = jblock' {- ' -} DIGITS\n\n    jblock' :: Int -> Int -> String -> String\n    jblock' d n cs\n        | d == 1    = case unsafeChr (ord '0' + n) of\n             c@(C# _) -> c : cs\n        | otherwise = case unsafeChr (ord '0' + r) of\n             c@(C# _) -> jblock' (d - 1) q (c : cs)\n        where\n        (q, r) = n `quotRemInt` 10\n\ninstance Show KindRep where\n  showsPrec d (KindRepVar v) = showParen (d > 10) $\n    showString \"KindRepVar \" . showsPrec 11 v\n  showsPrec d (KindRepTyConApp p q) = showParen (d > 10) $\n    showString \"KindRepTyConApp \"\n      . showsPrec 11 p\n      . showString \" \"\n      . showsPrec 11 q\n  showsPrec d (KindRepApp p q) = showParen (d > 10) $\n    showString \"KindRepApp \"\n      . showsPrec 11 p\n      . showString \" \"\n      . showsPrec 11 q\n  showsPrec d (KindRepFun p q) = showParen (d > 10) $\n    showString \"KindRepFun \"\n      . showsPrec 11 p\n      . showString \" \"\n      . showsPrec 11 q\n  showsPrec d (KindRepTYPE rep) = showParen (d > 10) $\n    showString \"KindRepTYPE \" . showsPrec 11 rep\n  showsPrec d (KindRepTypeLitS p q) = showParen (d > 10) $\n    showString \"KindRepTypeLitS \"\n      . showsPrec 11 p\n      . showString \" \"\n      . showsPrec 11 (unpackCString# q)\n  showsPrec d (KindRepTypeLitD p q) = showParen (d > 10) $\n    showString \"KindRepTypeLitD \"\n      . showsPrec 11 p\n      . showString \" \"\n      . showsPrec 11 q\n\n-- | @since 4.11.0.0\nderiving instance Show RuntimeRep\n\n-- | @since 4.11.0.0\nderiving instance Show VecCount\n\n-- | @since 4.11.0.0\nderiving instance Show VecElem\n\n-- | @since 4.11.0.0\nderiving instance Show TypeLitSort\n", "num_lines": 609}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, RankNTypes #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.ST\n-- Copyright   :  (c) The University of Glasgow, 1992-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The 'ST' Monad.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.ST (\n        ST(..), STret(..), STRep,\n        runST,\n\n        -- * Unsafe functions\n        liftST, unsafeInterleaveST, unsafeDupableInterleaveST\n    ) where\n\nimport GHC.Base\nimport GHC.Show\nimport qualified Control.Monad.Fail as Fail\n\ndefault ()\n\n-- The 'ST' monad proper.  By default the monad is strict;\n-- too many people got bitten by space leaks when it was lazy.\n\n-- | The strict 'ST' monad.\n-- The 'ST' monad allows for destructive updates, but is escapable (unlike IO).\n-- A computation of type @'ST' s a@ returns a value of type @a@, and\n-- execute in \"thread\" @s@. The @s@ parameter is either\n--\n-- * an uninstantiated type variable (inside invocations of 'runST'), or\n--\n-- * 'RealWorld' (inside invocations of 'Control.Monad.ST.stToIO').\n--\n-- It serves to keep the internal states of different invocations\n-- of 'runST' separate from each other and from invocations of\n-- 'Control.Monad.ST.stToIO'.\n--\n-- The '>>=' and '>>' operations are strict in the state (though not in\n-- values stored in the state).  For example,\n--\n-- @'runST' (writeSTRef _|_ v >>= f) = _|_@\nnewtype ST s a = ST (STRep s a)\ntype STRep s a = State# s -> (# State# s, a #)\n\n-- | @since 2.01\ninstance Functor (ST s) where\n    fmap f (ST m) = ST $ \\ s ->\n      case (m s) of { (# new_s, r #) ->\n      (# new_s, f r #) }\n\n-- | @since 4.4.0.0\ninstance Applicative (ST s) where\n    {-# INLINE pure #-}\n    {-# INLINE (*>)   #-}\n    pure x = ST (\\ s -> (# s, x #))\n    m *> k = m >>= \\ _ -> k\n    (<*>) = ap\n    liftA2 = liftM2\n\n-- | @since 2.01\ninstance Monad (ST s) where\n    {-# INLINE (>>=)  #-}\n    (>>) = (*>)\n    (ST m) >>= k\n      = ST (\\ s ->\n        case (m s) of { (# new_s, r #) ->\n        case (k r) of { ST k2 ->\n        (k2 new_s) }})\n\n-- | @since 4.11.0.0\ninstance Fail.MonadFail (ST s) where\n    fail s = errorWithoutStackTrace s\n\n-- | @since 4.11.0.0\ninstance Semigroup a => Semigroup (ST s a) where\n    (<>) = liftA2 (<>)\n\n-- | @since 4.11.0.0\ninstance Monoid a => Monoid (ST s a) where\n    mempty = pure mempty\n\ndata STret s a = STret (State# s) a\n\n-- liftST is useful when we want a lifted result from an ST computation.\nliftST :: ST s a -> State# s -> STret s a\nliftST (ST m) = \\s -> case m s of (# s', r #) -> STret s' r\n\nnoDuplicateST :: ST s ()\nnoDuplicateST = ST $ \\s -> (# noDuplicate# s, () #)\n\n-- | 'unsafeInterleaveST' allows an 'ST' computation to be deferred\n-- lazily.  When passed a value of type @ST a@, the 'ST' computation will\n-- only be performed when the value of the @a@ is demanded.\n{-# INLINE unsafeInterleaveST #-}\nunsafeInterleaveST :: ST s a -> ST s a\nunsafeInterleaveST m = unsafeDupableInterleaveST (noDuplicateST >> m)\n\n-- | 'unsafeDupableInterleaveST' allows an 'ST' computation to be deferred\n-- lazily.  When passed a value of type @ST a@, the 'ST' computation will\n-- only be performed when the value of the @a@ is demanded.\n--\n-- The computation may be performed multiple times by different threads,\n-- possibly at the same time. To prevent this, use 'unsafeInterleaveST' instead.\n--\n-- @since 4.11\n{-# NOINLINE unsafeDupableInterleaveST #-}\n-- See Note [unsafeDupableInterleaveIO should not be inlined]\n-- in GHC.IO.Unsafe\nunsafeDupableInterleaveST :: ST s a -> ST s a\nunsafeDupableInterleaveST (ST m) = ST ( \\ s ->\n    let\n        r = case m s of (# _, res #) -> res\n    in\n    (# s, r #)\n  )\n\n-- | @since 2.01\ninstance  Show (ST s a)  where\n    showsPrec _ _  = showString \"<<ST action>>\"\n    showList       = showList__ (showsPrec 0)\n\n{-# INLINE runST #-}\n-- | Return the value computed by a state thread.\n-- The @forall@ ensures that the internal state used by the 'ST'\n-- computation is inaccessible to the rest of the program.\nrunST :: (forall s. ST s a) -> a\nrunST (ST st_rep) = case runRW# st_rep of (# _, a #) -> a\n-- See Note [Definition of runRW#] in GHC.Magic\n", "num_lines": 140}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude\n           , MagicHash\n           , UnboxedTuples\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Stable\n-- Copyright   :  (c) The University of Glasgow, 1992-2004\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Stable pointers.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Stable (\n        StablePtr(..),\n        newStablePtr,\n        deRefStablePtr,\n        freeStablePtr,\n        castStablePtrToPtr,\n        castPtrToStablePtr\n    ) where\n\nimport GHC.Ptr\nimport GHC.Base\n\n-----------------------------------------------------------------------------\n-- Stable Pointers\n\n{- |\nA /stable pointer/ is a reference to a Haskell expression that is\nguaranteed not to be affected by garbage collection, i.e., it will neither be\ndeallocated nor will the value of the stable pointer itself change during\ngarbage collection (ordinary references may be relocated during garbage\ncollection).  Consequently, stable pointers can be passed to foreign code,\nwhich can treat it as an opaque reference to a Haskell value.\n\nA value of type @StablePtr a@ is a stable pointer to a Haskell\nexpression of type @a@.\n-}\ndata {-# CTYPE \"HsStablePtr\" #-} StablePtr a = StablePtr (StablePtr# a)\n\n-- |\n-- Create a stable pointer referring to the given Haskell value.\n--\nnewStablePtr   :: a -> IO (StablePtr a)\nnewStablePtr a = IO $ \\ s ->\n    case makeStablePtr# a s of (# s', sp #) -> (# s', StablePtr sp #)\n\n-- |\n-- Obtain the Haskell value referenced by a stable pointer, i.e., the\n-- same value that was passed to the corresponding call to\n-- 'newStablePtr'.  If the argument to 'deRefStablePtr' has\n-- already been freed using 'freeStablePtr', the behaviour of\n-- 'deRefStablePtr' is undefined.\n--\ndeRefStablePtr :: StablePtr a -> IO a\ndeRefStablePtr (StablePtr sp) = IO $ \\s -> deRefStablePtr# sp s\n\n-- |\n-- Dissolve the association between the stable pointer and the Haskell\n-- value. Afterwards, if the stable pointer is passed to\n-- 'deRefStablePtr' or 'freeStablePtr', the behaviour is\n-- undefined.  However, the stable pointer may still be passed to\n-- 'castStablePtrToPtr', but the @'Foreign.Ptr.Ptr' ()@ value returned\n-- by 'castStablePtrToPtr', in this case, is undefined (in particular,\n-- it may be 'Foreign.Ptr.nullPtr').  Nevertheless, the call\n-- to 'castStablePtrToPtr' is guaranteed not to diverge.\n--\nforeign import ccall unsafe \"hs_free_stable_ptr\" freeStablePtr :: StablePtr a -> IO ()\n\n-- |\n-- Coerce a stable pointer to an address. No guarantees are made about\n-- the resulting value, except that the original stable pointer can be\n-- recovered by 'castPtrToStablePtr'.  In particular, the address may not\n-- refer to an accessible memory location and any attempt to pass it to\n-- the member functions of the class 'Foreign.Storable.Storable' leads to\n-- undefined behaviour.\n--\ncastStablePtrToPtr :: StablePtr a -> Ptr ()\ncastStablePtrToPtr (StablePtr s) = Ptr (unsafeCoerce# s)\n\n\n-- |\n-- The inverse of 'castStablePtrToPtr', i.e., we have the identity\n--\n-- > sp == castPtrToStablePtr (castStablePtrToPtr sp)\n--\n-- for any stable pointer @sp@ on which 'freeStablePtr' has\n-- not been executed yet.  Moreover, 'castPtrToStablePtr' may\n-- only be applied to pointers that have been produced by\n-- 'castStablePtrToPtr'.\n--\ncastPtrToStablePtr :: Ptr () -> StablePtr a\ncastPtrToStablePtr (Ptr a) = StablePtr (unsafeCoerce# a)\n\n-- | @since 2.01\ninstance Eq (StablePtr a) where\n    (StablePtr sp1) == (StablePtr sp2) =\n        case eqStablePtr# sp1 sp2 of\n           0# -> False\n           _  -> True\n", "num_lines": 110}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Mem.StableName\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable\n--\n-- Stable names are a way of performing fast (O(1)), not-quite-exact\n-- comparison between objects.\n--\n-- Stable names solve the following problem: suppose you want to build\n-- a hash table with Haskell objects as keys, but you want to use\n-- pointer equality for comparison; maybe because the keys are large\n-- and hashing would be slow, or perhaps because the keys are infinite\n-- in size.  We can\\'t build a hash table using the address of the\n-- object as the key, because objects get moved around by the garbage\n-- collector, meaning a re-hash would be necessary after every garbage\n-- collection.\n--\n-------------------------------------------------------------------------------\n\nmodule GHC.StableName (\n  -- * Stable Names\n  StableName (..),\n  makeStableName,\n  hashStableName,\n  eqStableName\n  ) where\n\nimport GHC.IO           ( IO(..) )\nimport GHC.Base         ( Int(..), StableName#, makeStableName#\n                        , eqStableName#, stableNameToInt# )\n\n-----------------------------------------------------------------------------\n-- Stable Names\n\n{-|\n  An abstract name for an object, that supports equality and hashing.\n\n  Stable names have the following property:\n\n  * If @sn1 :: StableName@ and @sn2 :: StableName@ and @sn1 == sn2@\n   then @sn1@ and @sn2@ were created by calls to @makeStableName@ on\n   the same object.\n\n  The reverse is not necessarily true: if two stable names are not\n  equal, then the objects they name may still be equal.  Note in particular\n  that `makeStableName` may return a different `StableName` after an\n  object is evaluated.\n\n  Stable Names are similar to Stable Pointers (\"Foreign.StablePtr\"),\n  but differ in the following ways:\n\n  * There is no @freeStableName@ operation, unlike \"Foreign.StablePtr\"s.\n    Stable names are reclaimed by the runtime system when they are no\n    longer needed.\n\n  * There is no @deRefStableName@ operation.  You can\\'t get back from\n    a stable name to the original Haskell object.  The reason for\n    this is that the existence of a stable name for an object does not\n    guarantee the existence of the object itself; it can still be garbage\n    collected.\n-}\n\ndata StableName a = StableName (StableName# a)\n\n-- | Makes a 'StableName' for an arbitrary object.  The object passed as\n-- the first argument is not evaluated by 'makeStableName'.\nmakeStableName  :: a -> IO (StableName a)\nmakeStableName a = IO $ \\ s ->\n    case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #)\n\n-- | Convert a 'StableName' to an 'Int'.  The 'Int' returned is not\n-- necessarily unique; several 'StableName's may map to the same 'Int'\n-- (in practice however, the chances of this are small, so the result\n-- of 'hashStableName' makes a good hash key).\nhashStableName :: StableName a -> Int\nhashStableName (StableName sn) = I# (stableNameToInt# sn)\n\n-- | @since 2.01\ninstance Eq (StableName a) where\n    (StableName sn1) == (StableName sn2) =\n       case eqStableName# sn1 sn2 of\n         0# -> False\n         _  -> True\n\n-- | Equality on 'StableName' that does not require that the types of\n-- the arguments match.\n--\n-- @since 4.7.0.0\neqStableName :: StableName a -> StableName b -> Bool\neqStableName (StableName sn1) (StableName sn2) =\n       case eqStableName# sn1 sn2 of\n         0# -> False\n         _  -> True\n  -- Requested by Emil Axelsson on glasgow-haskell-users, who wants to\n  -- use it for implementing observable sharing.\n\n", "num_lines": 107}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Stack\n-- Copyright   :  (c) The University of Glasgow 2011\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Access to GHC's call-stack simulation\n--\n-- @since 4.5.0.0\n-----------------------------------------------------------------------------\n\n{-# LANGUAGE MagicHash, NoImplicitPrelude, ImplicitParams, RankNTypes #-}\nmodule GHC.Stack (\n    errorWithStackTrace,\n\n    -- * Profiling call stacks\n    currentCallStack,\n    whoCreated,\n\n    -- * HasCallStack call stacks\n    CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack,\n    fromCallSiteList, getCallStack, popCallStack, prettyCallStack,\n    pushCallStack, withFrozenCallStack,\n\n    -- * Source locations\n    SrcLoc(..), prettySrcLoc,\n\n    -- * Internals\n    CostCentreStack,\n    CostCentre,\n    getCurrentCCS,\n    getCCSOf,\n    clearCCS,\n    ccsCC,\n    ccsParent,\n    ccLabel,\n    ccModule,\n    ccSrcSpan,\n    ccsToStrings,\n    renderStack\n  ) where\n\nimport GHC.Stack.CCS\nimport GHC.Stack.Types\nimport GHC.IO\nimport GHC.Base\nimport GHC.List\nimport GHC.Exception\n\n-- | Like the function 'error', but appends a stack trace to the error\n-- message if one is available.\n--\n-- @since 4.7.0.0\n{-# DEPRECATED errorWithStackTrace \"'error' appends the call stack now\" #-}\n  -- DEPRECATED in 8.0.1\nerrorWithStackTrace :: String -> a\nerrorWithStackTrace x = unsafeDupablePerformIO $ do\n   stack <- ccsToStrings =<< getCurrentCCS x\n   if null stack\n      then throwIO (ErrorCall x)\n      else throwIO (ErrorCallWithLocation x (renderStack stack))\n\n\n-- | Pop the most recent call-site off the 'CallStack'.\n--\n-- This function, like 'pushCallStack', has no effect on a frozen 'CallStack'.\n--\n-- @since 4.9.0.0\npopCallStack :: CallStack -> CallStack\npopCallStack stk = case stk of\n  EmptyCallStack         -> errorWithoutStackTrace \"popCallStack: empty stack\"\n  PushCallStack _ _ stk' -> stk'\n  FreezeCallStack _      -> stk\n{-# INLINE popCallStack #-}\n\n-- | Return the current 'CallStack'.\n--\n-- Does *not* include the call-site of 'callStack'.\n--\n-- @since 4.9.0.0\ncallStack :: HasCallStack => CallStack\ncallStack =\n  case ?callStack of\n    EmptyCallStack -> EmptyCallStack\n    _              -> popCallStack ?callStack\n{-# INLINE callStack #-}\n\n-- | Perform some computation without adding new entries to the 'CallStack'.\n--\n-- @since 4.9.0.0\nwithFrozenCallStack :: HasCallStack\n                    => ( HasCallStack => a )\n                    -> a\nwithFrozenCallStack do_this =\n  -- we pop the stack before freezing it to remove\n  -- withFrozenCallStack's call-site\n  let ?callStack = freezeCallStack (popCallStack callStack)\n  in do_this\n", "num_lines": 105}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP                       #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE MagicHash                 #-}\n{-# LANGUAGE UnboxedTuples             #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.StaticPtr\n-- Copyright   :  (C) 2014 I/O Tweag\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Symbolic references to values.\n--\n-- References to values are usually implemented with memory addresses, and this\n-- is practical when communicating values between the different pieces of a\n-- single process.\n--\n-- When values are communicated across different processes running in possibly\n-- different machines, though, addresses are no longer useful since each\n-- process may use different addresses to store a given value.\n--\n-- To solve such concern, the references provided by this module offer a key\n-- that can be used to locate the values on each process. Each process maintains\n-- a global table of references which can be looked up with a given key. This\n-- table is known as the Static Pointer Table. The reference can then be\n-- dereferenced to obtain the value.\n--\n-- The various communicating processes need to aggree on the keys used to refer\n-- to the values in the Static Pointer Table, or lookups will fail. Only\n-- processes launched from the same program binary are guaranteed to use the\n-- same set of keys.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.StaticPtr\n  ( StaticPtr\n  , deRefStaticPtr\n  , StaticKey\n  , staticKey\n  , unsafeLookupStaticPtr\n  , StaticPtrInfo(..)\n  , staticPtrInfo\n  , staticPtrKeys\n  , IsStatic(..)\n  ) where\n\nimport Foreign.C.Types     (CInt(..))\nimport Foreign.Marshal     (allocaArray, peekArray)\nimport GHC.Ptr             (Ptr(..), nullPtr)\nimport GHC.Fingerprint     (Fingerprint(..))\nimport GHC.Prim\nimport GHC.Word            (Word64(..))\n\n\n#include \"MachDeps.h\"\n\n-- | A reference to a value of type @a@.\n#if WORD_SIZE_IN_BITS < 64\ndata StaticPtr a = StaticPtr Word64# Word64# -- The flattened Fingerprint is\n                                             -- convenient in the compiler.\n                             StaticPtrInfo a\n#else\ndata StaticPtr a = StaticPtr Word# Word#\n                             StaticPtrInfo a\n#endif\n-- | Dereferences a static pointer.\ndeRefStaticPtr :: StaticPtr a -> a\ndeRefStaticPtr (StaticPtr _ _ _ v) = v\n\n-- | A key for 'StaticPtr's that can be serialized and used with\n-- 'unsafeLookupStaticPtr'.\ntype StaticKey = Fingerprint\n\n-- | The 'StaticKey' that can be used to look up the given 'StaticPtr'.\nstaticKey :: StaticPtr a -> StaticKey\nstaticKey (StaticPtr w0 w1 _ _) = Fingerprint (W64# w0) (W64# w1)\n\n-- | Looks up a 'StaticPtr' by its 'StaticKey'.\n--\n-- If the 'StaticPtr' is not found returns @Nothing@.\n--\n-- This function is unsafe because the program behavior is undefined if the type\n-- of the returned 'StaticPtr' does not match the expected one.\n--\nunsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a))\nunsafeLookupStaticPtr (Fingerprint w1 w2) = do\n    ptr@(Ptr addr) <- hs_spt_lookup w1 w2\n    if (ptr == nullPtr)\n    then return Nothing\n    else case addrToAny# addr of\n           (# spe #) -> return (Just spe)\n\nforeign import ccall unsafe hs_spt_lookup :: Word64 -> Word64 -> IO (Ptr a)\n\n-- | A class for things buildable from static pointers.\nclass IsStatic p where\n    fromStaticPtr :: StaticPtr a -> p a\n\n-- | @since 4.9.0.0\ninstance IsStatic StaticPtr where\n    fromStaticPtr = id\n\n-- | Miscelaneous information available for debugging purposes.\ndata StaticPtrInfo = StaticPtrInfo\n    { -- | Package key of the package where the static pointer is defined\n      spInfoUnitId  :: String\n      -- | Name of the module where the static pointer is defined\n    , spInfoModuleName :: String\n      -- | Source location of the definition of the static pointer as a\n      -- @(Line, Column)@ pair.\n    , spInfoSrcLoc     :: (Int, Int)\n    }\n  deriving Show -- ^ @since 4.8.0.0\n\n-- | 'StaticPtrInfo' of the given 'StaticPtr'.\nstaticPtrInfo :: StaticPtr a -> StaticPtrInfo\nstaticPtrInfo (StaticPtr _ _ n _) = n\n\n-- | A list of all known keys.\nstaticPtrKeys :: IO [StaticKey]\nstaticPtrKeys = do\n    keyCount <- hs_spt_key_count\n    allocaArray (fromIntegral keyCount) $ \\p -> do\n      count <- hs_spt_keys p keyCount\n      peekArray (fromIntegral count) p >>=\n        mapM (\\pa -> peekArray 2 pa >>= \\[w1, w2] -> return $ Fingerprint w1 w2)\n{-# NOINLINE staticPtrKeys #-}\n\nforeign import ccall unsafe hs_spt_key_count :: IO CInt\n\nforeign import ccall unsafe hs_spt_keys :: Ptr a -> CInt -> IO CInt\n", "num_lines": 135}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Storable\n-- Copyright   :  (c) The FFI task force, 2000-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Helper functions for \"Foreign.Storable\"\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Storable\n        ( readWideCharOffPtr\n        , readIntOffPtr\n        , readWordOffPtr\n        , readPtrOffPtr\n        , readFunPtrOffPtr\n        , readFloatOffPtr\n        , readDoubleOffPtr\n        , readStablePtrOffPtr\n        , readInt8OffPtr\n        , readInt16OffPtr\n        , readInt32OffPtr\n        , readInt64OffPtr\n        , readWord8OffPtr\n        , readWord16OffPtr\n        , readWord32OffPtr\n        , readWord64OffPtr\n        , writeWideCharOffPtr\n        , writeIntOffPtr\n        , writeWordOffPtr\n        , writePtrOffPtr\n        , writeFunPtrOffPtr\n        , writeFloatOffPtr\n        , writeDoubleOffPtr\n        , writeStablePtrOffPtr\n        , writeInt8OffPtr\n        , writeInt16OffPtr\n        , writeInt32OffPtr\n        , writeInt64OffPtr\n        , writeWord8OffPtr\n        , writeWord16OffPtr\n        , writeWord32OffPtr\n        , writeWord64OffPtr\n        ) where\n\nimport GHC.Stable ( StablePtr(..) )\nimport GHC.Int\nimport GHC.Word\nimport GHC.Ptr\nimport GHC.Base\n\nreadWideCharOffPtr  :: Ptr Char          -> Int -> IO Char\nreadIntOffPtr       :: Ptr Int           -> Int -> IO Int\nreadWordOffPtr      :: Ptr Word          -> Int -> IO Word\nreadPtrOffPtr       :: Ptr (Ptr a)       -> Int -> IO (Ptr a)\nreadFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> IO (FunPtr a)\nreadFloatOffPtr     :: Ptr Float         -> Int -> IO Float\nreadDoubleOffPtr    :: Ptr Double        -> Int -> IO Double\nreadStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)\nreadInt8OffPtr      :: Ptr Int8          -> Int -> IO Int8\nreadInt16OffPtr     :: Ptr Int16         -> Int -> IO Int16\nreadInt32OffPtr     :: Ptr Int32         -> Int -> IO Int32\nreadInt64OffPtr     :: Ptr Int64         -> Int -> IO Int64\nreadWord8OffPtr     :: Ptr Word8         -> Int -> IO Word8\nreadWord16OffPtr    :: Ptr Word16        -> Int -> IO Word16\nreadWord32OffPtr    :: Ptr Word32        -> Int -> IO Word32\nreadWord64OffPtr    :: Ptr Word64        -> Int -> IO Word64\n\nreadWideCharOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readWideCharOffAddr# a i s  of (# s2, x #) -> (# s2, C# x #)\nreadIntOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I# x #)\nreadWordOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W# x #)\nreadPtrOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, Ptr x #)\nreadFunPtrOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, FunPtr x #)\nreadFloatOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readFloatOffAddr# a i s     of (# s2, x #) -> (# s2, F# x #)\nreadDoubleOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readDoubleOffAddr# a i s    of (# s2, x #) -> (# s2, D# x #)\nreadStablePtrOffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)\nreadInt8OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readInt8OffAddr# a i s      of (# s2, x #) -> (# s2, I8# x #)\nreadWord8OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readWord8OffAddr# a i s     of (# s2, x #) -> (# s2, W8# x #)\nreadInt16OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)\nreadWord16OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readWord16OffAddr# a i s    of (# s2, x #) -> (# s2, W16# x #)\nreadInt32OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)\nreadWord32OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readWord32OffAddr# a i s    of (# s2, x #) -> (# s2, W32# x #)\nreadInt64OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)\nreadWord64OffPtr (Ptr a) (I# i)\n  = IO $ \\s -> case readWord64OffAddr# a i s    of (# s2, x #) -> (# s2, W64# x #)\n\nwriteWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()\nwriteIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()\nwriteWordOffPtr      :: Ptr Word          -> Int -> Word        -> IO ()\nwritePtrOffPtr       :: Ptr (Ptr a)       -> Int -> Ptr a       -> IO ()\nwriteFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> FunPtr a    -> IO ()\nwriteFloatOffPtr     :: Ptr Float         -> Int -> Float       -> IO ()\nwriteDoubleOffPtr    :: Ptr Double        -> Int -> Double      -> IO ()\nwriteStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()\nwriteInt8OffPtr      :: Ptr Int8          -> Int -> Int8        -> IO ()\nwriteInt16OffPtr     :: Ptr Int16         -> Int -> Int16       -> IO ()\nwriteInt32OffPtr     :: Ptr Int32         -> Int -> Int32       -> IO ()\nwriteInt64OffPtr     :: Ptr Int64         -> Int -> Int64       -> IO ()\nwriteWord8OffPtr     :: Ptr Word8         -> Int -> Word8       -> IO ()\nwriteWord16OffPtr    :: Ptr Word16        -> Int -> Word16      -> IO ()\nwriteWord32OffPtr    :: Ptr Word32        -> Int -> Word32      -> IO ()\nwriteWord64OffPtr    :: Ptr Word64        -> Int -> Word64      -> IO ()\n\nwriteWideCharOffPtr (Ptr a) (I# i) (C# x)\n  = IO $ \\s -> case writeWideCharOffAddr# a i x s  of s2 -> (# s2, () #)\nwriteIntOffPtr (Ptr a) (I# i) (I# x)\n  = IO $ \\s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)\nwriteWordOffPtr (Ptr a) (I# i) (W# x)\n  = IO $ \\s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)\nwritePtrOffPtr (Ptr a) (I# i) (Ptr x)\n  = IO $ \\s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)\nwriteFunPtrOffPtr (Ptr a) (I# i) (FunPtr x)\n  = IO $ \\s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)\nwriteFloatOffPtr (Ptr a) (I# i) (F# x)\n  = IO $ \\s -> case writeFloatOffAddr# a i x s     of s2 -> (# s2, () #)\nwriteDoubleOffPtr (Ptr a) (I# i) (D# x)\n  = IO $ \\s -> case writeDoubleOffAddr# a i x s    of s2 -> (# s2, () #)\nwriteStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)\n  = IO $ \\s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)\nwriteInt8OffPtr (Ptr a) (I# i) (I8# x)\n  = IO $ \\s -> case writeInt8OffAddr# a i x s      of s2 -> (# s2, () #)\nwriteWord8OffPtr (Ptr a) (I# i) (W8# x)\n  = IO $ \\s -> case writeWord8OffAddr# a i x s     of s2 -> (# s2, () #)\nwriteInt16OffPtr (Ptr a) (I# i) (I16# x)\n  = IO $ \\s -> case writeInt16OffAddr# a i x s     of s2 -> (# s2, () #)\nwriteWord16OffPtr (Ptr a) (I# i) (W16# x)\n  = IO $ \\s -> case writeWord16OffAddr# a i x s    of s2 -> (# s2, () #)\nwriteInt32OffPtr (Ptr a) (I# i) (I32# x)\n  = IO $ \\s -> case writeInt32OffAddr# a i x s     of s2 -> (# s2, () #)\nwriteWord32OffPtr (Ptr a) (I# i) (W32# x)\n  = IO $ \\s -> case writeWord32OffAddr# a i x s    of s2 -> (# s2, () #)\nwriteInt64OffPtr (Ptr a) (I# i) (I64# x)\n  = IO $ \\s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)\nwriteWord64OffPtr (Ptr a) (I# i) (W64# x)\n  = IO $ \\s -> case writeWord64OffAddr# a i x s    of s2 -> (# s2, () #)\n", "num_lines": 159}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.STRef\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- References in the 'ST' monad.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.STRef (\n        STRef(..),\n        newSTRef, readSTRef, writeSTRef\n    ) where\n\nimport GHC.ST\nimport GHC.Base\n\n-- $setup\n-- import Prelude\n\ndata STRef s a = STRef (MutVar# s a)\n-- ^ a value of type @STRef s a@ is a mutable variable in state thread @s@,\n-- containing a value of type @a@\n--\n-- >>> :{\n-- runST (do\n--     ref <- newSTRef \"hello\"\n--     x <- readSTRef ref\n--     writeSTRef ref (x ++ \"world\")\n--     readSTRef ref )\n-- :}\n-- \"helloworld\"\n\n-- |Build a new 'STRef' in the current state thread\nnewSTRef :: a -> ST s (STRef s a)\nnewSTRef init = ST $ \\s1# ->\n    case newMutVar# init s1#            of { (# s2#, var# #) ->\n    (# s2#, STRef var# #) }\n\n-- |Read the value of an 'STRef'\nreadSTRef :: STRef s a -> ST s a\nreadSTRef (STRef var#) = ST $ \\s1# -> readMutVar# var# s1#\n\n-- |Write a new value into an 'STRef'\nwriteSTRef :: STRef s a -> a -> ST s ()\nwriteSTRef (STRef var#) val = ST $ \\s1# ->\n    case writeMutVar# var# val s1#      of { s2# ->\n    (# s2#, () #) }\n\n-- | Pointer equality.\n--\n-- @since 2.01\ninstance Eq (STRef s a) where\n    STRef v1# == STRef v2# = isTrue# (sameMutVar# v1# v2#)\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , MagicHash\n           , UnboxedTuples\n           , UnliftedFFITypes\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.TopHandler\n-- Copyright   :  (c) The University of Glasgow, 2001-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Support for catching exceptions raised during top-level computations\n-- (e.g. @Main.main@, 'Control.Concurrent.forkIO', and foreign exports)\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.TopHandler (\n        runMainIO, runIO, runIOFastExit, runNonIO,\n        topHandler, topHandlerFastExit,\n        reportStackOverflow, reportError,\n        flushStdHandles\n    ) where\n\n#include \"HsBaseConfig.h\"\n\nimport Control.Exception\nimport Data.Maybe\n\nimport Foreign\nimport Foreign.C\nimport GHC.Base\nimport GHC.Conc hiding (throwTo)\nimport GHC.Real\nimport GHC.IO\nimport GHC.IO.Handle.FD\nimport GHC.IO.Handle\nimport GHC.IO.Exception\nimport GHC.Weak\n\n#if defined(mingw32_HOST_OS)\nimport GHC.ConsoleHandler\n#else\nimport Data.Dynamic (toDyn)\n#endif\n\n-- Note [rts_setMainThread must be called unsafely]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- rts_setMainThread must be called as unsafe, because it\n-- dereferences the Weak# and manipulates the raw Haskell value\n-- behind it.  Therefore, it must not race with a garbage collection.\n\n-- Note [rts_setMainThread has an unsound type]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- 'rts_setMainThread' is imported with type Weak# ThreadId -> IO (),\n-- but this is an unsound type for it: it grabs the /key/ of the\n-- 'Weak#' object, which isn't tracked by the type at all.\n-- That this works at all is a consequence of the fact that\n-- 'mkWeakThreadId' produces a 'Weak#' with a 'ThreadId#' as the key\n-- This is fairly robust, in that 'mkWeakThreadId' wouldn't work\n-- otherwise, but it still is sufficiently non-trivial to justify an\n-- ASSERT in rts/TopHandler.c.\n\n-- see Note [rts_setMainThread must be called unsafely] and\n-- Note [rts_setMainThread has an unsound type]\nforeign import ccall unsafe \"rts_setMainThread\"\n  setMainThread :: Weak# ThreadId -> IO ()\n\n-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is\n-- called in the program).  It catches otherwise uncaught exceptions,\n-- and also flushes stdout\\/stderr before exiting.\nrunMainIO :: IO a -> IO a\nrunMainIO main =\n    do\n      main_thread_id <- myThreadId\n      weak_tid <- mkWeakThreadId main_thread_id\n      case weak_tid of (Weak w) -> setMainThread w\n      install_interrupt_handler $ do\n           m <- deRefWeak weak_tid\n           case m of\n               Nothing  -> return ()\n               Just tid -> throwTo tid (toException UserInterrupt)\n      main -- hs_exit() will flush\n    `catch`\n      topHandler\n\ninstall_interrupt_handler :: IO () -> IO ()\n#if defined(mingw32_HOST_OS)\ninstall_interrupt_handler handler = do\n  _ <- GHC.ConsoleHandler.installHandler $\n     Catch $ \\event ->\n        case event of\n           ControlC -> handler\n           Break    -> handler\n           Close    -> handler\n           _ -> return ()\n  return ()\n#else\n#include \"rts/Signals.h\"\n-- specialised version of System.Posix.Signals.installHandler, which\n-- isn't available here.\ninstall_interrupt_handler handler = do\n   let sig = CONST_SIGINT :: CInt\n   _ <- setHandler sig (Just (const handler, toDyn handler))\n   _ <- stg_sig_install sig STG_SIG_RST nullPtr\n     -- STG_SIG_RST: the second ^C kills us for real, just in case the\n     -- RTS or program is unresponsive.\n   return ()\n\nforeign import ccall unsafe\n  stg_sig_install\n        :: CInt                         -- sig no.\n        -> CInt                         -- action code (STG_SIG_HAN etc.)\n        -> Ptr ()                       -- (in, out) blocked\n        -> IO CInt                      -- (ret) old action code\n#endif\n\n-- | 'runIO' is wrapped around every @foreign export@ and @foreign\n-- import \\\"wrapper\\\"@ to mop up any uncaught exceptions.  Thus, the\n-- result of running 'System.Exit.exitWith' in a foreign-exported\n-- function is the same as in the main thread: it terminates the\n-- program.\n--\nrunIO :: IO a -> IO a\nrunIO main = catch main topHandler\n\n-- | Like 'runIO', but in the event of an exception that causes an exit,\n-- we don't shut down the system cleanly, we just exit.  This is\n-- useful in some cases, because the safe exit version will give other\n-- threads a chance to clean up first, which might shut down the\n-- system in a different way.  For example, try\n--\n--   main = forkIO (runIO (exitWith (ExitFailure 1))) >> threadDelay 10000\n--\n-- This will sometimes exit with \"interrupted\" and code 0, because the\n-- main thread is given a chance to shut down when the child thread calls\n-- safeExit.  There is a race to shut down between the main and child threads.\n--\nrunIOFastExit :: IO a -> IO a\nrunIOFastExit main = catch main topHandlerFastExit\n        -- NB. this is used by the testsuite driver\n\n-- | The same as 'runIO', but for non-IO computations.  Used for\n-- wrapping @foreign export@ and @foreign import \\\"wrapper\\\"@ when these\n-- are used to export Haskell functions with non-IO types.\n--\nrunNonIO :: a -> IO a\nrunNonIO a = catch (a `seq` return a) topHandler\n\ntopHandler :: SomeException -> IO a\ntopHandler err = catch (real_handler safeExit err) topHandler\n\ntopHandlerFastExit :: SomeException -> IO a\ntopHandlerFastExit err =\n  catchException (real_handler fastExit err) topHandlerFastExit\n\n-- Make sure we handle errors while reporting the error!\n-- (e.g. evaluating the string passed to 'error' might generate\n--  another error, etc.)\n--\nreal_handler :: (Int -> IO a) -> SomeException -> IO a\nreal_handler exit se = do\n  flushStdHandles -- before any error output\n  case fromException se of\n      Just StackOverflow -> do\n           reportStackOverflow\n           exit 2\n\n      Just UserInterrupt -> exitInterrupted\n\n      Just HeapOverflow -> do\n           reportHeapOverflow\n           exit 251\n\n      _ -> case fromException se of\n           -- only the main thread gets ExitException exceptions\n           Just ExitSuccess     -> exit 0\n           Just (ExitFailure n) -> exit n\n\n           -- EPIPE errors received for stdout are ignored (#2699)\n           _ -> catch (case fromException se of\n                Just IOError{ ioe_type = ResourceVanished,\n                              ioe_errno = Just ioe,\n                              ioe_handle = Just hdl }\n                   | Errno ioe == ePIPE, hdl == stdout -> exit 0\n                _ -> do reportError se\n                        exit 1\n                ) (disasterHandler exit) -- See Note [Disaster with iconv]\n\n-- don't use errorBelch() directly, because we cannot call varargs functions\n-- using the FFI.\nforeign import ccall unsafe \"HsBase.h errorBelch2\"\n   errorBelch :: CString -> CString -> IO ()\n\ndisasterHandler :: (Int -> IO a) -> IOError -> IO a\ndisasterHandler exit _ =\n  withCAString \"%s\" $ \\fmt ->\n    withCAString msgStr $ \\msg ->\n      errorBelch fmt msg >> exit 1\n  where\n    msgStr =\n        \"encountered an exception while trying to report an exception.\\n\" ++\n        \"One possible reason for this is that we failed while trying to \" ++\n        \"encode an error message. Check that your locale is configured \" ++\n        \"properly.\"\n\n{- Note [Disaster with iconv]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nWhen using iconv, it's possible for things like iconv_open to fail in\nrestricted environments (like an initram or restricted container), but\nwhen this happens the error raised inevitably calls `peekCString`,\nwhich depends on the users locale, which depends on using\n`iconv_open`... which causes an infinite loop.\n\nThis occurrence is also known as tickets #10298 and #7695. So to work\naround it we just set _another_ error handler and bail directly by\ncalling the RTS, without iconv at all.\n-}\n\n\n-- try to flush stdout/stderr, but don't worry if we fail\n-- (these handles might have errors, and we don't want to go into\n-- an infinite loop).\nflushStdHandles :: IO ()\nflushStdHandles = do\n  hFlush stdout `catchAny` \\_ -> return ()\n  hFlush stderr `catchAny` \\_ -> return ()\n\nsafeExit, fastExit :: Int -> IO a\nsafeExit = exitHelper useSafeExit\nfastExit = exitHelper useFastExit\n\nunreachable :: IO a\nunreachable = fail \"If you can read this, shutdownHaskellAndExit did not exit.\"\n\nexitHelper :: CInt -> Int -> IO a\n#if defined(mingw32_HOST_OS)\nexitHelper exitKind r =\n  shutdownHaskellAndExit (fromIntegral r) exitKind >> unreachable\n#else\n-- On Unix we use an encoding for the ExitCode:\n--      0 -- 255  normal exit code\n--   -127 -- -1   exit by signal\n-- For any invalid encoding we just use a replacement (0xff).\nexitHelper exitKind r\n  | r >= 0 && r <= 255\n  = shutdownHaskellAndExit   (fromIntegral   r)  exitKind >> unreachable\n  | r >= -127 && r <= -1\n  = shutdownHaskellAndSignal (fromIntegral (-r)) exitKind >> unreachable\n  | otherwise\n  = shutdownHaskellAndExit   0xff                exitKind >> unreachable\n\nforeign import ccall \"shutdownHaskellAndSignal\"\n  shutdownHaskellAndSignal :: CInt -> CInt -> IO ()\n#endif\n\nexitInterrupted :: IO a\nexitInterrupted =\n#if defined(mingw32_HOST_OS)\n  safeExit 252\n#else\n  -- we must exit via the default action for SIGINT, so that the\n  -- parent of this process can take appropriate action (see #2301)\n  safeExit (-CONST_SIGINT)\n#endif\n\n-- NOTE: shutdownHaskellAndExit must be called \"safe\", because it *can*\n-- re-enter Haskell land through finalizers.\nforeign import ccall \"Rts.h shutdownHaskellAndExit\"\n  shutdownHaskellAndExit :: CInt -> CInt -> IO ()\n\nuseFastExit, useSafeExit :: CInt\nuseFastExit = 1\nuseSafeExit = 0\n", "num_lines": 285}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE PolyKinds #-}\n\n{-| This module is an internal GHC module.  It declares the constants used\nin the implementation of type-level natural numbers.  The programmer interface\nfor working with type-level naturals should be defined in a separate library.\n\n@since 4.6.0.0\n-}\n\nmodule GHC.TypeLits\n  ( -- * Kinds\n    Nat, Symbol  -- Both declared in GHC.Types in package ghc-prim\n\n    -- * Linking type and value level\n  , N.KnownNat, natVal, natVal'\n  , KnownSymbol, symbolVal, symbolVal'\n  , N.SomeNat(..), SomeSymbol(..)\n  , someNatVal, someSymbolVal\n  , N.sameNat, sameSymbol\n\n\n    -- * Functions on type literals\n  , type (N.<=), type (N.<=?), type (N.+), type (N.*), type (N.^), type (N.-)\n  , type N.Div, type N.Mod, type N.Log2\n  , AppendSymbol\n  , N.CmpNat, CmpSymbol\n\n  -- * User-defined type errors\n  , TypeError\n  , ErrorMessage(..)\n\n  ) where\n\nimport GHC.Base(Eq(..), Ord(..), Ordering(..), otherwise)\nimport GHC.Types( Nat, Symbol )\nimport GHC.Num(Integer, fromInteger)\nimport GHC.Base(String)\nimport GHC.Show(Show(..))\nimport GHC.Read(Read(..))\nimport GHC.Real(toInteger)\nimport GHC.Prim(magicDict, Proxy#)\nimport Data.Maybe(Maybe(..))\nimport Data.Proxy (Proxy(..))\nimport Data.Type.Equality((:~:)(Refl))\nimport Unsafe.Coerce(unsafeCoerce)\n\nimport GHC.TypeNats (KnownNat)\nimport qualified GHC.TypeNats as N\n\n--------------------------------------------------------------------------------\n\n-- | This class gives the string associated with a type-level symbol.\n-- There are instances of the class for every concrete literal: \"hello\", etc.\n--\n-- @since 4.7.0.0\nclass KnownSymbol (n :: Symbol) where\n  symbolSing :: SSymbol n\n\n-- | @since 4.7.0.0\nnatVal :: forall n proxy. KnownNat n => proxy n -> Integer\nnatVal p = toInteger (N.natVal p)\n\n-- | @since 4.7.0.0\nsymbolVal :: forall n proxy. KnownSymbol n => proxy n -> String\nsymbolVal _ = case symbolSing :: SSymbol n of\n                SSymbol x -> x\n\n-- | @since 4.8.0.0\nnatVal' :: forall n. KnownNat n => Proxy# n -> Integer\nnatVal' p = toInteger (N.natVal' p)\n\n-- | @since 4.8.0.0\nsymbolVal' :: forall n. KnownSymbol n => Proxy# n -> String\nsymbolVal' _ = case symbolSing :: SSymbol n of\n                SSymbol x -> x\n\n\n-- | This type represents unknown type-level symbols.\ndata SomeSymbol = forall n. KnownSymbol n => SomeSymbol (Proxy n)\n                  -- ^ @since 4.7.0.0\n\n-- | Convert an integer into an unknown type-level natural.\n--\n-- @since 4.7.0.0\nsomeNatVal :: Integer -> Maybe N.SomeNat\nsomeNatVal n\n  | n >= 0        = Just (N.someNatVal (fromInteger n))\n  | otherwise     = Nothing\n\n-- | Convert a string into an unknown type-level symbol.\n--\n-- @since 4.7.0.0\nsomeSymbolVal :: String -> SomeSymbol\nsomeSymbolVal n   = withSSymbol SomeSymbol (SSymbol n) Proxy\n\n-- | @since 4.7.0.0\ninstance Eq SomeSymbol where\n  SomeSymbol x == SomeSymbol y = symbolVal x == symbolVal y\n\n-- | @since 4.7.0.0\ninstance Ord SomeSymbol where\n  compare (SomeSymbol x) (SomeSymbol y) = compare (symbolVal x) (symbolVal y)\n\n-- | @since 4.7.0.0\ninstance Show SomeSymbol where\n  showsPrec p (SomeSymbol x) = showsPrec p (symbolVal x)\n\n-- | @since 4.7.0.0\ninstance Read SomeSymbol where\n  readsPrec p xs = [ (someSymbolVal a, ys) | (a,ys) <- readsPrec p xs ]\n\n--------------------------------------------------------------------------------\n\n-- | Comparison of type-level symbols, as a function.\n--\n-- @since 4.7.0.0\ntype family CmpSymbol (m :: Symbol) (n :: Symbol) :: Ordering\n\n-- | Concatenation of type-level symbols.\n--\n-- @since 4.10.0.0\ntype family AppendSymbol (m ::Symbol) (n :: Symbol) :: Symbol\n\n-- | A description of a custom type error.\ndata {-kind-} ErrorMessage = Text Symbol\n                             -- ^ Show the text as is.\n\n                           | forall t. ShowType t\n                             -- ^ Pretty print the type.\n                             -- @ShowType :: k -> ErrorMessage@\n\n                           | ErrorMessage :<>: ErrorMessage\n                             -- ^ Put two pieces of error message next\n                             -- to each other.\n\n                           | ErrorMessage :$$: ErrorMessage\n                             -- ^ Stack two pieces of error message on top\n                             -- of each other.\n\ninfixl 5 :$$:\ninfixl 6 :<>:\n\n-- | The type-level equivalent of 'Prelude.error'.\n--\n-- The polymorphic kind of this type allows it to be used in several settings.\n-- For instance, it can be used as a constraint, e.g. to provide a better error\n-- message for a non-existent instance,\n--\n-- @\n-- -- in a context\n-- instance TypeError (Text \"Cannot 'Show' functions.\" :$$:\n--                     Text \"Perhaps there is a missing argument?\")\n--       => Show (a -> b) where\n--     showsPrec = error \"unreachable\"\n-- @\n--\n-- It can also be placed on the right-hand side of a type-level function\n-- to provide an error for an invalid case,\n--\n-- @\n-- type family ByteSize x where\n--    ByteSize Word16   = 2\n--    ByteSize Word8    = 1\n--    ByteSize a        = TypeError (Text \"The type \" :<>: ShowType a :<>:\n--                                   Text \" is not exportable.\")\n-- @\n--\n-- @since 4.9.0.0\ntype family TypeError (a :: ErrorMessage) :: b where\n\n\n--------------------------------------------------------------------------------\n\n-- | We either get evidence that this function was instantiated with the\n-- same type-level symbols, or 'Nothing'.\n--\n-- @since 4.7.0.0\nsameSymbol :: (KnownSymbol a, KnownSymbol b) =>\n              Proxy a -> Proxy b -> Maybe (a :~: b)\nsameSymbol x y\n  | symbolVal x == symbolVal y  = Just (unsafeCoerce Refl)\n  | otherwise                   = Nothing\n\n--------------------------------------------------------------------------------\n-- PRIVATE:\n\nnewtype SSymbol (s :: Symbol) = SSymbol String\n\ndata WrapS a b = WrapS (KnownSymbol a => Proxy a -> b)\n\n-- See Note [magicDictId magic] in \"basicType/MkId.hs\"\nwithSSymbol :: (KnownSymbol a => Proxy a -> b)\n            -> SSymbol a      -> Proxy a -> b\nwithSSymbol f x y = magicDict (WrapS f) x y\n", "num_lines": 208}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE NoStarIsType #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE PolyKinds #-}\n\n{-| This module is an internal GHC module.  It declares the constants used\nin the implementation of type-level natural numbers.  The programmer interface\nfor working with type-level naturals should be defined in a separate library.\n\n@since 4.10.0.0\n-}\n\nmodule GHC.TypeNats\n  ( -- * Nat Kind\n    Nat -- declared in GHC.Types in package ghc-prim\n\n    -- * Linking type and value level\n  , KnownNat, natVal, natVal'\n  , SomeNat(..)\n  , someNatVal\n  , sameNat\n\n    -- * Functions on type literals\n  , type (<=), type (<=?), type (+), type (*), type (^), type (-)\n  , CmpNat\n  , Div, Mod, Log2\n\n  ) where\n\nimport GHC.Base(Eq(..), Ord(..), Bool(True), Ordering(..), otherwise)\nimport GHC.Types( Nat )\nimport GHC.Natural(Natural)\nimport GHC.Show(Show(..))\nimport GHC.Read(Read(..))\nimport GHC.Prim(magicDict, Proxy#)\nimport Data.Maybe(Maybe(..))\nimport Data.Proxy (Proxy(..))\nimport Data.Type.Equality((:~:)(Refl))\nimport Unsafe.Coerce(unsafeCoerce)\n\n--------------------------------------------------------------------------------\n\n-- | This class gives the integer associated with a type-level natural.\n-- There are instances of the class for every concrete literal: 0, 1, 2, etc.\n--\n-- @since 4.7.0.0\nclass KnownNat (n :: Nat) where\n  natSing :: SNat n\n\n-- | @since 4.10.0.0\nnatVal :: forall n proxy. KnownNat n => proxy n -> Natural\nnatVal _ = case natSing :: SNat n of\n             SNat x -> x\n\n-- | @since 4.10.0.0\nnatVal' :: forall n. KnownNat n => Proxy# n -> Natural\nnatVal' _ = case natSing :: SNat n of\n             SNat x -> x\n\n-- | This type represents unknown type-level natural numbers.\n--\n-- @since 4.10.0.0\ndata SomeNat    = forall n. KnownNat n    => SomeNat    (Proxy n)\n\n-- | Convert an integer into an unknown type-level natural.\n--\n-- @since 4.10.0.0\nsomeNatVal :: Natural -> SomeNat\nsomeNatVal n = withSNat SomeNat (SNat n) Proxy\n\n-- | @since 4.7.0.0\ninstance Eq SomeNat where\n  SomeNat x == SomeNat y = natVal x == natVal y\n\n-- | @since 4.7.0.0\ninstance Ord SomeNat where\n  compare (SomeNat x) (SomeNat y) = compare (natVal x) (natVal y)\n\n-- | @since 4.7.0.0\ninstance Show SomeNat where\n  showsPrec p (SomeNat x) = showsPrec p (natVal x)\n\n-- | @since 4.7.0.0\ninstance Read SomeNat where\n  readsPrec p xs = do (a,ys) <- readsPrec p xs\n                      [(someNatVal a, ys)]\n\n--------------------------------------------------------------------------------\n\ninfix  4 <=?, <=\ninfixl 6 +, -\ninfixl 7 *, `Div`, `Mod`\ninfixr 8 ^\n\n-- | Comparison of type-level naturals, as a constraint.\n--\n-- @since 4.7.0.0\ntype x <= y = (x <=? y) ~ 'True\n\n-- | Comparison of type-level naturals, as a function.\n--\n-- @since 4.7.0.0\ntype family CmpNat    (m :: Nat)    (n :: Nat)    :: Ordering\n\n{- | Comparison of type-level naturals, as a function.\nNOTE: The functionality for this function should be subsumed\nby 'CmpNat', so this might go away in the future.\nPlease let us know, if you encounter discrepancies between the two. -}\ntype family (m :: Nat) <=? (n :: Nat) :: Bool\n\n-- | Addition of type-level naturals.\n--\n-- @since 4.7.0.0\ntype family (m :: Nat) + (n :: Nat) :: Nat\n\n-- | Multiplication of type-level naturals.\n--\n-- @since 4.7.0.0\ntype family (m :: Nat) * (n :: Nat) :: Nat\n\n-- | Exponentiation of type-level naturals.\n--\n-- @since 4.7.0.0\ntype family (m :: Nat) ^ (n :: Nat) :: Nat\n\n-- | Subtraction of type-level naturals.\n--\n-- @since 4.7.0.0\ntype family (m :: Nat) - (n :: Nat) :: Nat\n\n-- | Division (round down) of natural numbers.\n-- @Div x 0@ is undefined (i.e., it cannot be reduced).\n--\n-- @since 4.11.0.0\ntype family Div (m :: Nat) (n :: Nat) :: Nat\n\n-- | Modulus of natural numbers.\n-- @Mod x 0@ is undefined (i.e., it cannot be reduced).\n--\n-- @since 4.11.0.0\ntype family Mod (m :: Nat) (n :: Nat) :: Nat\n\n-- | Log base 2 (round down) of natural numbers.\n-- @Log 0@ is undefined (i.e., it cannot be reduced).\n--\n-- @since 4.11.0.0\ntype family Log2 (m :: Nat) :: Nat\n\n--------------------------------------------------------------------------------\n\n-- | We either get evidence that this function was instantiated with the\n-- same type-level numbers, or 'Nothing'.\n--\n-- @since 4.7.0.0\nsameNat :: (KnownNat a, KnownNat b) =>\n           Proxy a -> Proxy b -> Maybe (a :~: b)\nsameNat x y\n  | natVal x == natVal y = Just (unsafeCoerce Refl)\n  | otherwise            = Nothing\n\n--------------------------------------------------------------------------------\n-- PRIVATE:\n\nnewtype SNat    (n :: Nat)    = SNat    Natural\n\ndata WrapN a b = WrapN (KnownNat    a => Proxy a -> b)\n\n-- See Note [magicDictId magic] in \"basicType/MkId.hs\"\nwithSNat :: (KnownNat a => Proxy a -> b)\n         -> SNat a      -> Proxy a -> b\nwithSNat f x y = magicDict (WrapN f) x y\n", "num_lines": 183}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Unicode\n-- Copyright   :  (c) The University of Glasgow, 2003\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Implementations for the character predicates (isLower, isUpper, etc.)\n-- and the conversions (toUpper, toLower).  The implementation uses\n-- libunicode on Unix systems if that is available.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Unicode (\n        GeneralCategory (..), generalCategory,\n        isAscii, isLatin1, isControl,\n        isAsciiUpper, isAsciiLower,\n        isPrint, isSpace,  isUpper,\n        isLower, isAlpha,  isDigit,\n        isOctDigit, isHexDigit, isAlphaNum,\n        isPunctuation, isSymbol,\n        toUpper, toLower, toTitle,\n        wgencat\n    ) where\n\nimport GHC.Base\nimport GHC.Char        (chr)\nimport GHC.Real\nimport GHC.Enum ( Enum (..), Bounded (..) )\nimport GHC.Arr ( Ix (..) )\nimport GHC.Num\n\n-- Data.Char.chr already imports this and we need to define a Show instance\n-- for GeneralCategory\nimport GHC.Show ( Show )\n\n#include \"HsBaseConfig.h\"\n\n-- | Unicode General Categories (column 2 of the UnicodeData table) in\n-- the order they are listed in the Unicode standard (the Unicode\n-- Character Database, in particular).\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> :t OtherLetter\n-- OtherLetter :: GeneralCategory\n--\n-- 'Eq' instance:\n--\n-- >>> UppercaseLetter == UppercaseLetter\n-- True\n-- >>> UppercaseLetter == LowercaseLetter\n-- False\n--\n-- 'Ord' instance:\n--\n-- >>> NonSpacingMark <= MathSymbol\n-- True\n--\n-- 'Enum' instance:\n--\n-- >>> enumFromTo ModifierLetter SpacingCombiningMark\n-- [ModifierLetter,OtherLetter,NonSpacingMark,SpacingCombiningMark]\n--\n-- 'Text.Read.Read' instance:\n--\n-- >>> read \"DashPunctuation\" :: GeneralCategory\n-- DashPunctuation\n-- >>> read \"17\" :: GeneralCategory\n-- *** Exception: Prelude.read: no parse\n--\n-- 'Show' instance:\n--\n-- >>> show EnclosingMark\n-- \"EnclosingMark\"\n--\n-- 'Bounded' instance:\n--\n-- >>> minBound :: GeneralCategory\n-- UppercaseLetter\n-- >>> maxBound :: GeneralCategory\n-- NotAssigned\n--\n-- 'Ix' instance:\n--\n--  >>> import Data.Ix ( index )\n--  >>> index (OtherLetter,Control) FinalQuote\n--  12\n--  >>> index (OtherLetter,Control) Format\n--  *** Exception: Error in array index\n--\ndata GeneralCategory\n        = UppercaseLetter       -- ^ Lu: Letter, Uppercase\n        | LowercaseLetter       -- ^ Ll: Letter, Lowercase\n        | TitlecaseLetter       -- ^ Lt: Letter, Titlecase\n        | ModifierLetter        -- ^ Lm: Letter, Modifier\n        | OtherLetter           -- ^ Lo: Letter, Other\n        | NonSpacingMark        -- ^ Mn: Mark, Non-Spacing\n        | SpacingCombiningMark  -- ^ Mc: Mark, Spacing Combining\n        | EnclosingMark         -- ^ Me: Mark, Enclosing\n        | DecimalNumber         -- ^ Nd: Number, Decimal\n        | LetterNumber          -- ^ Nl: Number, Letter\n        | OtherNumber           -- ^ No: Number, Other\n        | ConnectorPunctuation  -- ^ Pc: Punctuation, Connector\n        | DashPunctuation       -- ^ Pd: Punctuation, Dash\n        | OpenPunctuation       -- ^ Ps: Punctuation, Open\n        | ClosePunctuation      -- ^ Pe: Punctuation, Close\n        | InitialQuote          -- ^ Pi: Punctuation, Initial quote\n        | FinalQuote            -- ^ Pf: Punctuation, Final quote\n        | OtherPunctuation      -- ^ Po: Punctuation, Other\n        | MathSymbol            -- ^ Sm: Symbol, Math\n        | CurrencySymbol        -- ^ Sc: Symbol, Currency\n        | ModifierSymbol        -- ^ Sk: Symbol, Modifier\n        | OtherSymbol           -- ^ So: Symbol, Other\n        | Space                 -- ^ Zs: Separator, Space\n        | LineSeparator         -- ^ Zl: Separator, Line\n        | ParagraphSeparator    -- ^ Zp: Separator, Paragraph\n        | Control               -- ^ Cc: Other, Control\n        | Format                -- ^ Cf: Other, Format\n        | Surrogate             -- ^ Cs: Other, Surrogate\n        | PrivateUse            -- ^ Co: Other, Private Use\n        | NotAssigned           -- ^ Cn: Other, Not Assigned\n        deriving ( Show     -- ^ @since 2.01\n                 , Eq       -- ^ @since 2.01\n                 , Ord      -- ^ @since 2.01\n                 , Enum     -- ^ @since 2.01\n                 , Bounded  -- ^ @since 2.01\n                 , Ix       -- ^ @since 2.01\n                 )\n\n-- | The Unicode general category of the character. This relies on the\n-- 'Enum' instance of 'GeneralCategory', which must remain in the\n-- same order as the categories are presented in the Unicode\n-- standard.\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> generalCategory 'a'\n-- LowercaseLetter\n-- >>> generalCategory 'A'\n-- UppercaseLetter\n-- >>> generalCategory '0'\n-- DecimalNumber\n-- >>> generalCategory '%'\n-- OtherPunctuation\n-- >>> generalCategory '\u00e2\u2122\u00a5'\n-- OtherSymbol\n-- >>> generalCategory '\\31'\n-- Control\n-- >>> generalCategory ' '\n-- Space\n--\ngeneralCategory :: Char -> GeneralCategory\ngeneralCategory c = toEnum $ fromIntegral $ wgencat $ fromIntegral $ ord c\n\n-- | Selects the first 128 characters of the Unicode character set,\n-- corresponding to the ASCII character set.\nisAscii                 :: Char -> Bool\nisAscii c               =  c <  '\\x80'\n\n-- | Selects the first 256 characters of the Unicode character set,\n-- corresponding to the ISO 8859-1 (Latin-1) character set.\nisLatin1                :: Char -> Bool\nisLatin1 c              =  c <= '\\xff'\n\n-- | Selects ASCII lower-case letters,\n-- i.e. characters satisfying both 'isAscii' and 'isLower'.\nisAsciiLower :: Char -> Bool\nisAsciiLower c          =  c >= 'a' && c <= 'z'\n\n-- | Selects ASCII upper-case letters,\n-- i.e. characters satisfying both 'isAscii' and 'isUpper'.\nisAsciiUpper :: Char -> Bool\nisAsciiUpper c          =  c >= 'A' && c <= 'Z'\n\n-- | Selects control characters, which are the non-printing characters of\n-- the Latin-1 subset of Unicode.\nisControl               :: Char -> Bool\n\n-- | Selects printable Unicode characters\n-- (letters, numbers, marks, punctuation, symbols and spaces).\nisPrint                 :: Char -> Bool\n\n-- | Returns 'True' for any Unicode space character, and the control\n-- characters @\\\\t@, @\\\\n@, @\\\\r@, @\\\\f@, @\\\\v@.\nisSpace                 :: Char -> Bool\n-- isSpace includes non-breaking space\n-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints\n-- at or below 0x377 have been assigned, so we shouldn't have to worry about\n-- any new spaces appearing below there. It would probably be best to\n-- use branchless ||, but currently the eqLit transformation will undo that,\n-- so we'll do it like this until there's a way around that.\nisSpace c\n  | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0\n  | otherwise = iswspace (ord c) /= 0\n  where\n    uc = fromIntegral (ord c) :: Word\n\n-- | Selects upper-case or title-case alphabetic Unicode characters (letters).\n-- Title case is used by a small number of letter ligatures like the\n-- single-character form of /Lj/.\nisUpper                 :: Char -> Bool\n\n-- | Selects lower-case alphabetic Unicode characters (letters).\nisLower                 :: Char -> Bool\n\n-- | Selects alphabetic Unicode characters (lower-case, upper-case and\n-- title-case letters, plus letters of caseless scripts and modifiers letters).\n-- This function is equivalent to 'Data.Char.isLetter'.\nisAlpha                 :: Char -> Bool\n\n-- | Selects alphabetic or numeric Unicode characters.\n--\n-- Note that numeric digits outside the ASCII range, as well as numeric\n-- characters which aren't digits, are selected by this function but not by\n-- 'isDigit'. Such characters may be part of identifiers but are not used by\n-- the printer and reader to represent numbers.\nisAlphaNum              :: Char -> Bool\n\n-- | Selects ASCII digits, i.e. @\\'0\\'@..@\\'9\\'@.\nisDigit                 :: Char -> Bool\nisDigit c               =  (fromIntegral (ord c - ord '0') :: Word) <= 9\n\n-- We use an addition and an unsigned comparison instead of two signed\n-- comparisons because it's usually faster and puts less strain on branch\n-- prediction. It likely also enables some CSE when combined with functions\n-- that follow up with an actual conversion.\n\n-- | Selects ASCII octal digits, i.e. @\\'0\\'@..@\\'7\\'@.\nisOctDigit              :: Char -> Bool\nisOctDigit c            =  (fromIntegral (ord c - ord '0') :: Word) <= 7\n\n-- | Selects ASCII hexadecimal digits,\n-- i.e. @\\'0\\'@..@\\'9\\'@, @\\'a\\'@..@\\'f\\'@, @\\'A\\'@..@\\'F\\'@.\nisHexDigit              :: Char -> Bool\nisHexDigit c            =  isDigit c ||\n                           (fromIntegral (ord c - ord 'A')::Word) <= 5 ||\n                           (fromIntegral (ord c - ord 'a')::Word) <= 5\n\n-- | Selects Unicode punctuation characters, including various kinds\n-- of connectors, brackets and quotes.\n--\n-- This function returns 'True' if its argument has one of the\n-- following 'GeneralCategory's, or 'False' otherwise:\n--\n-- * 'ConnectorPunctuation'\n-- * 'DashPunctuation'\n-- * 'OpenPunctuation'\n-- * 'ClosePunctuation'\n-- * 'InitialQuote'\n-- * 'FinalQuote'\n-- * 'OtherPunctuation'\n--\n-- These classes are defined in the\n-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,\n-- part of the Unicode standard. The same document defines what is\n-- and is not a \\\"Punctuation\\\".\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isPunctuation 'a'\n-- False\n-- >>> isPunctuation '7'\n-- False\n-- >>> isPunctuation '\u00e2\u2122\u00a5'\n-- False\n-- >>> isPunctuation '\"'\n-- True\n-- >>> isPunctuation '?'\n-- True\n-- >>> isPunctuation '\u00e2\u20ac\u201d'\n-- True\n--\nisPunctuation :: Char -> Bool\nisPunctuation c = case generalCategory c of\n        ConnectorPunctuation    -> True\n        DashPunctuation         -> True\n        OpenPunctuation         -> True\n        ClosePunctuation        -> True\n        InitialQuote            -> True\n        FinalQuote              -> True\n        OtherPunctuation        -> True\n        _                       -> False\n\n-- | Selects Unicode symbol characters, including mathematical and\n-- currency symbols.\n--\n-- This function returns 'True' if its argument has one of the\n-- following 'GeneralCategory's, or 'False' otherwise:\n--\n-- * 'MathSymbol'\n-- * 'CurrencySymbol'\n-- * 'ModifierSymbol'\n-- * 'OtherSymbol'\n--\n-- These classes are defined in the\n-- <http://www.unicode.org/reports/tr44/tr44-14.html#GC_Values_Table Unicode Character Database>,\n-- part of the Unicode standard. The same document defines what is\n-- and is not a \\\"Symbol\\\".\n--\n-- ==== __Examples__\n--\n-- Basic usage:\n--\n-- >>> isSymbol 'a'\n-- False\n-- >>> isSymbol '6'\n-- False\n-- >>> isSymbol '='\n-- True\n--\n-- The definition of \\\"math symbol\\\" may be a little\n-- counter-intuitive depending on one's background:\n--\n-- >>> isSymbol '+'\n-- True\n-- >>> isSymbol '-'\n-- False\n--\nisSymbol :: Char -> Bool\nisSymbol c = case generalCategory c of\n        MathSymbol              -> True\n        CurrencySymbol          -> True\n        ModifierSymbol          -> True\n        OtherSymbol             -> True\n        _                       -> False\n\n-- | Convert a letter to the corresponding upper-case letter, if any.\n-- Any other character is returned unchanged.\ntoUpper                 :: Char -> Char\n\n-- | Convert a letter to the corresponding lower-case letter, if any.\n-- Any other character is returned unchanged.\ntoLower                 :: Char -> Char\n\n-- | Convert a letter to the corresponding title-case or upper-case\n-- letter, if any.  (Title case differs from upper case only for a small\n-- number of ligature letters.)\n-- Any other character is returned unchanged.\ntoTitle                 :: Char -> Char\n\n-- -----------------------------------------------------------------------------\n-- Implementation with the supplied auto-generated Unicode character properties\n-- table\n\n-- Regardless of the O/S and Library, use the functions contained in WCsubst.c\n\nisAlpha    c = iswalpha (ord c) /= 0\nisAlphaNum c = iswalnum (ord c) /= 0\nisControl  c = iswcntrl (ord c) /= 0\nisPrint    c = iswprint (ord c) /= 0\nisUpper    c = iswupper (ord c) /= 0\nisLower    c = iswlower (ord c) /= 0\n\ntoLower c = chr (towlower (ord c))\ntoUpper c = chr (towupper (ord c))\ntoTitle c = chr (towtitle (ord c))\n\nforeign import ccall unsafe \"u_iswalpha\"\n  iswalpha :: Int -> Int\n\nforeign import ccall unsafe \"u_iswalnum\"\n  iswalnum :: Int -> Int\n\nforeign import ccall unsafe \"u_iswcntrl\"\n  iswcntrl :: Int -> Int\n\nforeign import ccall unsafe \"u_iswspace\"\n  iswspace :: Int -> Int\n\nforeign import ccall unsafe \"u_iswprint\"\n  iswprint :: Int -> Int\n\nforeign import ccall unsafe \"u_iswlower\"\n  iswlower :: Int -> Int\n\nforeign import ccall unsafe \"u_iswupper\"\n  iswupper :: Int -> Int\n\nforeign import ccall unsafe \"u_towlower\"\n  towlower :: Int -> Int\n\nforeign import ccall unsafe \"u_towupper\"\n  towupper :: Int -> Int\n\nforeign import ccall unsafe \"u_towtitle\"\n  towtitle :: Int -> Int\n\nforeign import ccall unsafe \"u_gencat\"\n  wgencat :: Int -> Int\n", "num_lines": 404}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude\n           , BangPatterns\n           , MagicHash\n           , UnboxedTuples\n           , StandaloneDeriving\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Weak\n-- Copyright   :  (c) The University of Glasgow, 1998-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Weak pointers.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Weak (\n        Weak(..),\n        mkWeak,\n        deRefWeak,\n        finalize,\n        runFinalizerBatch\n    ) where\n\nimport GHC.Base\n\n{-|\nA weak pointer object with a key and a value.  The value has type @v@.\n\nA weak pointer expresses a relationship between two objects, the\n/key/ and the /value/:  if the key is considered to be alive by the\ngarbage collector, then the value is also alive.  A reference from\nthe value to the key does /not/ keep the key alive.\n\nA weak pointer may also have a finalizer of type @IO ()@; if it does,\nthen the finalizer will be run at most once, at a time after the key\nhas become unreachable by the program (\\\"dead\\\").  The storage manager\nattempts to run the finalizer(s) for an object soon after the object\ndies, but promptness is not guaranteed.\n\nIt is not guaranteed that a finalizer will eventually run, and no\nattempt is made to run outstanding finalizers when the program exits.\nTherefore finalizers should not be relied on to clean up resources -\nother methods (eg. exception handlers) should be employed, possibly in\naddition to finalizers.\n\nReferences from the finalizer to the key are treated in the same way\nas references from the value to the key: they do not keep the key\nalive.  A finalizer may therefore ressurrect the key, perhaps by\nstoring it in the same data structure.\n\nThe finalizer, and the relationship between the key and the value,\nexist regardless of whether the program keeps a reference to the\n'Weak' object or not.\n\nThere may be multiple weak pointers with the same key.  In this\ncase, the finalizers for each of these weak pointers will all be\nrun in some arbitrary order, or perhaps concurrently, when the key\ndies.  If the programmer specifies a finalizer that assumes it has\nthe only reference to an object (for example, a file that it wishes\nto close), then the programmer must ensure that there is only one\nsuch finalizer.\n\nIf there are no other threads to run, the runtime system will check\nfor runnable finalizers before declaring the system to be deadlocked.\n\nWARNING: weak pointers to ordinary non-primitive Haskell types are\nparticularly fragile, because the compiler is free to optimise away or\nduplicate the underlying data structure.  Therefore attempting to\nplace a finalizer on an ordinary Haskell type may well result in the\nfinalizer running earlier than you expected.  This is not a problem\nfor caches and memo tables where early finalization is benign.\n\nFinalizers /can/ be used reliably for types that are created explicitly\nand have identity, such as @IORef@ and @MVar@.  However, to place a\nfinalizer on one of these types, you should use the specific operation\nprovided for that type, e.g. @mkWeakIORef@ and @addMVarFinalizer@\nrespectively (the non-uniformity is accidental).  These operations\nattach the finalizer to the primitive object inside the box\n(e.g. @MutVar#@ in the case of @IORef@), because attaching the\nfinalizer to the box itself fails when the outer box is optimised away\nby the compiler.\n\n-}\ndata Weak v = Weak (Weak# v)\n\n-- | Establishes a weak pointer to @k@, with value @v@ and a finalizer.\n--\n-- This is the most general interface for building a weak pointer.\n--\nmkWeak  :: k                            -- ^ key\n        -> v                            -- ^ value\n        -> Maybe (IO ())                -- ^ finalizer\n        -> IO (Weak v)                  -- ^ returns: a weak pointer object\n\nmkWeak key val (Just (IO finalizer)) = IO $ \\s ->\n   case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) }\nmkWeak key val Nothing = IO $ \\s ->\n   case mkWeakNoFinalizer# key val s of { (# s1, w #) -> (# s1, Weak w #) }\n\n{-|\nDereferences a weak pointer.  If the key is still alive, then\n@'Just' v@ is returned (where @v@ is the /value/ in the weak pointer), otherwise\n'Nothing' is returned.\n\nThe return value of 'deRefWeak' depends on when the garbage collector\nruns, hence it is in the 'IO' monad.\n-}\ndeRefWeak :: Weak v -> IO (Maybe v)\ndeRefWeak (Weak w) = IO $ \\s ->\n   case deRefWeak# w s of\n        (# s1, flag, p #) -> case flag of\n                                0# -> (# s1, Nothing #)\n                                _  -> (# s1, Just p #)\n\n-- | Causes a the finalizer associated with a weak pointer to be run\n-- immediately.\nfinalize :: Weak v -> IO ()\nfinalize (Weak w) = IO $ \\s ->\n   case finalizeWeak# w s of\n        (# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finalizer\n        (# s1, _,  f #) -> f s1\n\n{-\nInstance Eq (Weak v) where\n  (Weak w1) == (Weak w2) = w1 `sameWeak#` w2\n-}\n\n\n-- run a batch of finalizers from the garbage collector.  We're given\n-- an array of finalizers and the length of the array, and we just\n-- call each one in turn.\n--\n-- the IO primitives are inlined by hand here to get the optimal\n-- code (sigh) --SDM.\n\nrunFinalizerBatch :: Int -> Array# (State# RealWorld -> State# RealWorld)\n                  -> IO ()\nrunFinalizerBatch (I# n) arr =\n   let  go m  = IO $ \\s ->\n                  case m of\n                  0# -> (# s, () #)\n                  _  -> let !m' = m -# 1# in\n                        case indexArray# arr m' of { (# io #) ->\n                        case catch# (\\p -> (# io p, () #))\n                                    (\\_ s'' -> (# s'', () #)) s of          {\n                         (# s', _ #) -> unIO (go m') s'\n                        }}\n   in\n        go n\n", "num_lines": 158}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Windows\n-- Copyright   :  (c) The University of Glasgow, 2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Windows functionality used by several modules.\n--\n-- ToDo: this just duplicates part of System.Win32.Types, which isn't\n-- available yet.  We should move some Win32 functionality down here,\n-- maybe as part of the grand reorganisation of the base package...\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Windows (\n        -- * Types\n        BOOL,\n        LPBOOL,\n        BYTE,\n        DWORD,\n        UINT,\n        ErrCode,\n        HANDLE,\n        LPWSTR,\n        LPTSTR,\n\n        -- * Constants\n        iNFINITE,\n        iNVALID_HANDLE_VALUE,\n\n        -- * System errors\n        throwGetLastError,\n        failWith,\n        getLastError,\n        getErrorMessage,\n        errCodeToIOError,\n\n        -- ** Guards for system calls that might fail\n        failIf,\n        failIf_,\n        failIfNull,\n        failIfZero,\n        failIfFalse_,\n        failUnlessSuccess,\n        failUnlessSuccessOr,\n\n        -- ** Mapping system errors to errno\n        -- $errno\n        c_maperrno,\n        c_maperrno_func,\n    ) where\n\nimport Data.Char\nimport Data.OldList\nimport Data.Maybe\nimport Data.Word\nimport Foreign.C.Error\nimport Foreign.C.String\nimport Foreign.C.Types\nimport Foreign.Ptr\nimport GHC.Base\nimport GHC.IO\nimport GHC.Num\nimport System.IO.Error\n\nimport qualified Numeric\n\n#if defined(i386_HOST_ARCH)\n# define WINDOWS_CCONV stdcall\n#elif defined(x86_64_HOST_ARCH)\n# define WINDOWS_CCONV ccall\n#else\n# error Unknown mingw32 arch\n#endif\n\ntype BOOL    = Bool\ntype LPBOOL  = Ptr BOOL\ntype BYTE    = Word8\ntype DWORD   = Word32\ntype UINT    = Word32\ntype ErrCode = DWORD\ntype HANDLE  = Ptr ()\ntype LPWSTR  = Ptr CWchar\n\n-- | Be careful with this.  LPTSTR can mean either WCHAR* or CHAR*, depending\n-- on whether the UNICODE macro is defined in the corresponding C code.\n-- Consider using LPWSTR instead.\ntype LPTSTR = LPWSTR\n\niNFINITE :: DWORD\niNFINITE = 0xFFFFFFFF -- urgh\n\niNVALID_HANDLE_VALUE :: HANDLE\niNVALID_HANDLE_VALUE = wordPtrToPtr (-1)\n\n-- | Get the last system error, and throw it as an 'IOError' exception.\nthrowGetLastError :: String -> IO a\nthrowGetLastError where_from =\n    getLastError >>= failWith where_from\n\n-- | Convert a Windows error code to an exception, then throw it.\nfailWith :: String -> ErrCode -> IO a\nfailWith fn_name err_code =\n    errCodeToIOError fn_name err_code >>= throwIO\n\n-- | Convert a Windows error code to an exception.\nerrCodeToIOError :: String -> ErrCode -> IO IOError\nerrCodeToIOError fn_name err_code = do\n    msg <- getErrorMessage err_code\n\n    -- turn GetLastError() into errno, which errnoToIOError knows\n    -- how to convert to an IOException we can throw.\n    -- XXX we should really do this directly.\n    let errno = c_maperrno_func err_code\n\n    let msg' = dropWhileEnd isSpace msg -- drop trailing \\n\n        ioerror = errnoToIOError fn_name errno Nothing Nothing\n                    `ioeSetErrorString` msg'\n    return ioerror\n\n-- | Get a string describing a Windows error code.  This uses the\n-- @FormatMessage@ system call.\ngetErrorMessage :: ErrCode -> IO String\ngetErrorMessage err_code =\n    mask_ $ do\n        c_msg <- c_getErrorMessage err_code\n        if c_msg == nullPtr\n          then return $ \"Error 0x\" ++ Numeric.showHex err_code \"\"\n          else do msg <- peekCWString c_msg\n                  -- We ignore failure of freeing c_msg, given we're already failing\n                  _ <- localFree c_msg\n                  return msg\n\nfailIf :: (a -> Bool) -> String -> IO a -> IO a\nfailIf p wh act = do\n    v <- act\n    if p v then throwGetLastError wh else return v\n\nfailIf_ :: (a -> Bool) -> String -> IO a -> IO ()\nfailIf_ p wh act = do\n    v <- act\n    if p v then throwGetLastError wh else return ()\n\nfailIfNull :: String -> IO (Ptr a) -> IO (Ptr a)\nfailIfNull = failIf (== nullPtr)\n\nfailIfZero :: (Eq a, Num a) => String -> IO a -> IO a\nfailIfZero = failIf (== 0)\n\nfailIfFalse_ :: String -> IO Bool -> IO ()\nfailIfFalse_ = failIf_ not\n\nfailUnlessSuccess :: String -> IO ErrCode -> IO ()\nfailUnlessSuccess fn_name act = do\n    r <- act\n    if r == 0 then return () else failWith fn_name r\n\nfailUnlessSuccessOr :: ErrCode -> String -> IO ErrCode -> IO Bool\nfailUnlessSuccessOr val fn_name act = do\n    r <- act\n    if r == 0 then return False\n        else if r == val then return True\n        else failWith fn_name r\n\n-- $errno\n--\n-- On Windows, @errno@ is defined by msvcrt.dll for compatibility with other\n-- systems, and is distinct from the system error as returned\n-- by @GetLastError@.\n\n-- | Map the last system error to an errno value, and assign it to @errno@.\nforeign import ccall unsafe \"maperrno\"             -- in Win32Utils.c\n   c_maperrno :: IO ()\n\n-- | Pure function variant of 'c_maperrno' that does not call @GetLastError@\n-- or modify @errno@.\nforeign import ccall unsafe \"maperrno_func\"        -- in Win32Utils.c\n   c_maperrno_func :: ErrCode -> Errno\n\nforeign import ccall unsafe \"base_getErrorMessage\" -- in Win32Utils.c\n    c_getErrorMessage :: DWORD -> IO LPWSTR\n\nforeign import WINDOWS_CCONV unsafe \"windows.h LocalFree\"\n    localFree :: Ptr a -> IO (Ptr a)\n\n-- | Get the last system error produced in the current thread.\nforeign import WINDOWS_CCONV unsafe \"windows.h GetLastError\"\n    getLastError :: IO ErrCode\n", "num_lines": 197}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Word\n-- Copyright   :  (c) The University of Glasgow, 1997-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Sized unsigned integral types: 'Word', 'Word8', 'Word16', 'Word32', and\n-- 'Word64'.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Word (\n    Word(..), Word8(..), Word16(..), Word32(..), Word64(..),\n\n    -- * Shifts\n    uncheckedShiftL64#,\n    uncheckedShiftRL64#,\n\n    -- * Byte swapping\n    byteSwap16,\n    byteSwap32,\n    byteSwap64,\n\n    -- * Equality operators\n    -- | See GHC.Classes#matching_overloaded_methods_in_rules\n    eqWord, neWord, gtWord, geWord, ltWord, leWord,\n    eqWord8, neWord8, gtWord8, geWord8, ltWord8, leWord8,\n    eqWord16, neWord16, gtWord16, geWord16, ltWord16, leWord16,\n    eqWord32, neWord32, gtWord32, geWord32, ltWord32, leWord32,\n    eqWord64, neWord64, gtWord64, geWord64, ltWord64, leWord64\n    ) where\n\nimport Data.Bits\nimport Data.Maybe\n\n#if WORD_SIZE_IN_BITS < 64\nimport GHC.IntWord64\n#endif\n\nimport GHC.Base\nimport GHC.Enum\nimport GHC.Num\nimport GHC.Real\nimport GHC.Arr\nimport GHC.Show\n\n------------------------------------------------------------------------\n-- type Word8\n------------------------------------------------------------------------\n\n-- Word8 is represented in the same way as Word. Operations may assume\n-- and must ensure that it holds only values from its logical range.\n\ndata {-# CTYPE \"HsWord8\" #-} Word8 = W8# Word#\n-- ^ 8-bit unsigned integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Word8 where\n    (==) = eqWord8\n    (/=) = neWord8\n\neqWord8, neWord8 :: Word8 -> Word8 -> Bool\neqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord#` y)\nneWord8 (W8# x) (W8# y) = isTrue# (x `neWord#` y)\n{-# INLINE [1] eqWord8 #-}\n{-# INLINE [1] neWord8 #-}\n\n-- | @since 2.01\ninstance Ord Word8 where\n    (<)  = ltWord8\n    (<=) = leWord8\n    (>=) = geWord8\n    (>)  = gtWord8\n\n{-# INLINE [1] gtWord8 #-}\n{-# INLINE [1] geWord8 #-}\n{-# INLINE [1] ltWord8 #-}\n{-# INLINE [1] leWord8 #-}\ngtWord8, geWord8, ltWord8, leWord8 :: Word8 -> Word8 -> Bool\n(W8# x) `gtWord8` (W8# y) = isTrue# (x `gtWord#` y)\n(W8# x) `geWord8` (W8# y) = isTrue# (x `geWord#` y)\n(W8# x) `ltWord8` (W8# y) = isTrue# (x `ltWord#` y)\n(W8# x) `leWord8` (W8# y) = isTrue# (x `leWord#` y)\n\n-- | @since 2.01\ninstance Show Word8 where\n    showsPrec p x = showsPrec p (fromIntegral x :: Int)\n\n-- | @since 2.01\ninstance Num Word8 where\n    (W8# x#) + (W8# y#)    = W8# (narrow8Word# (x# `plusWord#` y#))\n    (W8# x#) - (W8# y#)    = W8# (narrow8Word# (x# `minusWord#` y#))\n    (W8# x#) * (W8# y#)    = W8# (narrow8Word# (x# `timesWord#` y#))\n    negate (W8# x#)        = W8# (narrow8Word# (int2Word# (negateInt# (word2Int# x#))))\n    abs x                  = x\n    signum 0               = 0\n    signum _               = 1\n    fromInteger i          = W8# (narrow8Word# (integerToWord i))\n\n-- | @since 2.01\ninstance Real Word8 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Enum Word8 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Word8\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Word8\"\n    toEnum i@(I# i#)\n        | i >= 0 && i <= fromIntegral (maxBound::Word8)\n                        = W8# (int2Word# i#)\n        | otherwise     = toEnumError \"Word8\" i (minBound::Word8, maxBound::Word8)\n    fromEnum (W8# x#)   = I# (word2Int# x#)\n    enumFrom            = boundedEnumFrom\n    enumFromThen        = boundedEnumFromThen\n\n-- | @since 2.01\ninstance Integral Word8 where\n    quot    (W8# x#) y@(W8# y#)\n        | y /= 0                  = W8# (x# `quotWord#` y#)\n        | otherwise               = divZeroError\n    rem     (W8# x#) y@(W8# y#)\n        | y /= 0                  = W8# (x# `remWord#` y#)\n        | otherwise               = divZeroError\n    div     (W8# x#) y@(W8# y#)\n        | y /= 0                  = W8# (x# `quotWord#` y#)\n        | otherwise               = divZeroError\n    mod     (W8# x#) y@(W8# y#)\n        | y /= 0                  = W8# (x# `remWord#` y#)\n        | otherwise               = divZeroError\n    quotRem (W8# x#) y@(W8# y#)\n        | y /= 0                  = case x# `quotRemWord#` y# of\n                                    (# q, r #) ->\n                                        (W8# q, W8# r)\n        | otherwise               = divZeroError\n    divMod  (W8# x#) y@(W8# y#)\n        | y /= 0                  = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#))\n        | otherwise               = divZeroError\n    toInteger (W8# x#)            = smallInteger (word2Int# x#)\n\n-- | @since 2.01\ninstance Bounded Word8 where\n    minBound = 0\n    maxBound = 0xFF\n\n-- | @since 2.01\ninstance Ix Word8 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral (i - m)\n    inRange (m,n) i     = m <= i && i <= n\n\n-- | @since 2.01\ninstance Bits Word8 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (W8# x#) .&.   (W8# y#)   = W8# (x# `and#` y#)\n    (W8# x#) .|.   (W8# y#)   = W8# (x# `or#`  y#)\n    (W8# x#) `xor` (W8# y#)   = W8# (x# `xor#` y#)\n    complement (W8# x#)       = W8# (x# `xor#` mb#)\n        where !(W8# mb#) = maxBound\n    (W8# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#) = W8# (narrow8Word# (x# `shiftL#` i#))\n        | otherwise           = W8# (x# `shiftRL#` negateInt# i#)\n    (W8# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#) = W8# (narrow8Word# (x# `shiftL#` i#))\n        | otherwise           = overflowError\n    (W8# x#) `unsafeShiftL` (I# i#) =\n        W8# (narrow8Word# (x# `uncheckedShiftL#` i#))\n    (W8# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#) = W8# (x# `shiftRL#` i#)\n        | otherwise           = overflowError\n    (W8# x#) `unsafeShiftR` (I# i#) = W8# (x# `uncheckedShiftRL#` i#)\n    (W8# x#) `rotate`       (I# i#)\n        | isTrue# (i'# ==# 0#) = W8# x#\n        | otherwise  = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#`\n                                          (x# `uncheckedShiftRL#` (8# -# i'#))))\n        where\n        !i'# = word2Int# (int2Word# i# `and#` 7##)\n    bitSizeMaybe i            = Just (finiteBitSize i)\n    bitSize i                 = finiteBitSize i\n    isSigned _                = False\n    popCount (W8# x#)         = I# (word2Int# (popCnt8# x#))\n    bit                       = bitDefault\n    testBit                   = testBitDefault\n\n-- | @since 4.6.0.0\ninstance FiniteBits Word8 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 8\n    countLeadingZeros  (W8# x#) = I# (word2Int# (clz8# x#))\n    countTrailingZeros (W8# x#) = I# (word2Int# (ctz8# x#))\n\n{-# RULES\n\"fromIntegral/Word8->Word8\"   fromIntegral = id :: Word8 -> Word8\n\"fromIntegral/Word8->Integer\" fromIntegral = toInteger :: Word8 -> Integer\n\"fromIntegral/a->Word8\"       fromIntegral = \\x -> case fromIntegral x of W# x# -> W8# (narrow8Word# x#)\n\"fromIntegral/Word8->a\"       fromIntegral = \\(W8# x#) -> fromIntegral (W# x#)\n  #-}\n\n{-# RULES\n\"properFraction/Float->(Word8,Float)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Word8) n, y :: Float) }\n\"truncate/Float->Word8\"\n    truncate = (fromIntegral :: Int -> Word8) . (truncate :: Float -> Int)\n\"floor/Float->Word8\"\n    floor    = (fromIntegral :: Int -> Word8) . (floor :: Float -> Int)\n\"ceiling/Float->Word8\"\n    ceiling  = (fromIntegral :: Int -> Word8) . (ceiling :: Float -> Int)\n\"round/Float->Word8\"\n    round    = (fromIntegral :: Int -> Word8) . (round  :: Float -> Int)\n  #-}\n\n{-# RULES\n\"properFraction/Double->(Word8,Double)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Word8) n, y :: Double) }\n\"truncate/Double->Word8\"\n    truncate = (fromIntegral :: Int -> Word8) . (truncate :: Double -> Int)\n\"floor/Double->Word8\"\n    floor    = (fromIntegral :: Int -> Word8) . (floor :: Double -> Int)\n\"ceiling/Double->Word8\"\n    ceiling  = (fromIntegral :: Int -> Word8) . (ceiling :: Double -> Int)\n\"round/Double->Word8\"\n    round    = (fromIntegral :: Int -> Word8) . (round  :: Double -> Int)\n  #-}\n\n------------------------------------------------------------------------\n-- type Word16\n------------------------------------------------------------------------\n\n-- Word16 is represented in the same way as Word. Operations may assume\n-- and must ensure that it holds only values from its logical range.\n\ndata {-# CTYPE \"HsWord16\" #-} Word16 = W16# Word#\n-- ^ 16-bit unsigned integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Word16 where\n    (==) = eqWord16\n    (/=) = neWord16\n\neqWord16, neWord16 :: Word16 -> Word16 -> Bool\neqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord#` y)\nneWord16 (W16# x) (W16# y) = isTrue# (x `neWord#` y)\n{-# INLINE [1] eqWord16 #-}\n{-# INLINE [1] neWord16 #-}\n\n-- | @since 2.01\ninstance Ord Word16 where\n    (<)  = ltWord16\n    (<=) = leWord16\n    (>=) = geWord16\n    (>)  = gtWord16\n\n{-# INLINE [1] gtWord16 #-}\n{-# INLINE [1] geWord16 #-}\n{-# INLINE [1] ltWord16 #-}\n{-# INLINE [1] leWord16 #-}\ngtWord16, geWord16, ltWord16, leWord16 :: Word16 -> Word16 -> Bool\n(W16# x) `gtWord16` (W16# y) = isTrue# (x `gtWord#` y)\n(W16# x) `geWord16` (W16# y) = isTrue# (x `geWord#` y)\n(W16# x) `ltWord16` (W16# y) = isTrue# (x `ltWord#` y)\n(W16# x) `leWord16` (W16# y) = isTrue# (x `leWord#` y)\n\n-- | @since 2.01\ninstance Show Word16 where\n    showsPrec p x = showsPrec p (fromIntegral x :: Int)\n\n-- | @since 2.01\ninstance Num Word16 where\n    (W16# x#) + (W16# y#)  = W16# (narrow16Word# (x# `plusWord#` y#))\n    (W16# x#) - (W16# y#)  = W16# (narrow16Word# (x# `minusWord#` y#))\n    (W16# x#) * (W16# y#)  = W16# (narrow16Word# (x# `timesWord#` y#))\n    negate (W16# x#)       = W16# (narrow16Word# (int2Word# (negateInt# (word2Int# x#))))\n    abs x                  = x\n    signum 0               = 0\n    signum _               = 1\n    fromInteger i          = W16# (narrow16Word# (integerToWord i))\n\n-- | @since 2.01\ninstance Real Word16 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Enum Word16 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Word16\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Word16\"\n    toEnum i@(I# i#)\n        | i >= 0 && i <= fromIntegral (maxBound::Word16)\n                        = W16# (int2Word# i#)\n        | otherwise     = toEnumError \"Word16\" i (minBound::Word16, maxBound::Word16)\n    fromEnum (W16# x#)  = I# (word2Int# x#)\n    enumFrom            = boundedEnumFrom\n    enumFromThen        = boundedEnumFromThen\n\n-- | @since 2.01\ninstance Integral Word16 where\n    quot    (W16# x#) y@(W16# y#)\n        | y /= 0                    = W16# (x# `quotWord#` y#)\n        | otherwise                 = divZeroError\n    rem     (W16# x#) y@(W16# y#)\n        | y /= 0                    = W16# (x# `remWord#` y#)\n        | otherwise                 = divZeroError\n    div     (W16# x#) y@(W16# y#)\n        | y /= 0                    = W16# (x# `quotWord#` y#)\n        | otherwise                 = divZeroError\n    mod     (W16# x#) y@(W16# y#)\n        | y /= 0                    = W16# (x# `remWord#` y#)\n        | otherwise                 = divZeroError\n    quotRem (W16# x#) y@(W16# y#)\n        | y /= 0                  = case x# `quotRemWord#` y# of\n                                    (# q, r #) ->\n                                        (W16# q, W16# r)\n        | otherwise                 = divZeroError\n    divMod  (W16# x#) y@(W16# y#)\n        | y /= 0                    = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#))\n        | otherwise                 = divZeroError\n    toInteger (W16# x#)             = smallInteger (word2Int# x#)\n\n-- | @since 2.01\ninstance Bounded Word16 where\n    minBound = 0\n    maxBound = 0xFFFF\n\n-- | @since 2.01\ninstance Ix Word16 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral (i - m)\n    inRange (m,n) i     = m <= i && i <= n\n\n-- | @since 2.01\ninstance Bits Word16 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (W16# x#) .&.   (W16# y#)  = W16# (x# `and#` y#)\n    (W16# x#) .|.   (W16# y#)  = W16# (x# `or#`  y#)\n    (W16# x#) `xor` (W16# y#)  = W16# (x# `xor#` y#)\n    complement (W16# x#)       = W16# (x# `xor#` mb#)\n        where !(W16# mb#) = maxBound\n    (W16# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = W16# (narrow16Word# (x# `shiftL#` i#))\n        | otherwise            = W16# (x# `shiftRL#` negateInt# i#)\n    (W16# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W16# (narrow16Word# (x# `shiftL#` i#))\n        | otherwise            = overflowError\n    (W16# x#) `unsafeShiftL` (I# i#) =\n        W16# (narrow16Word# (x# `uncheckedShiftL#` i#))\n    (W16# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W16# (x# `shiftRL#` i#)\n        | otherwise            = overflowError\n    (W16# x#) `unsafeShiftR` (I# i#) = W16# (x# `uncheckedShiftRL#` i#)\n    (W16# x#) `rotate`       (I# i#)\n        | isTrue# (i'# ==# 0#) = W16# x#\n        | otherwise  = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#`\n                                            (x# `uncheckedShiftRL#` (16# -# i'#))))\n        where\n        !i'# = word2Int# (int2Word# i# `and#` 15##)\n    bitSizeMaybe i            = Just (finiteBitSize i)\n    bitSize i                 = finiteBitSize i\n    isSigned _                = False\n    popCount (W16# x#)        = I# (word2Int# (popCnt16# x#))\n    bit                       = bitDefault\n    testBit                   = testBitDefault\n\n-- | @since 4.6.0.0\ninstance FiniteBits Word16 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 16\n    countLeadingZeros  (W16# x#) = I# (word2Int# (clz16# x#))\n    countTrailingZeros (W16# x#) = I# (word2Int# (ctz16# x#))\n\n-- | Swap bytes in 'Word16'.\n--\n-- @since 4.7.0.0\nbyteSwap16 :: Word16 -> Word16\nbyteSwap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#))\n\n{-# RULES\n\"fromIntegral/Word8->Word16\"   fromIntegral = \\(W8# x#) -> W16# x#\n\"fromIntegral/Word16->Word16\"  fromIntegral = id :: Word16 -> Word16\n\"fromIntegral/Word16->Integer\" fromIntegral = toInteger :: Word16 -> Integer\n\"fromIntegral/a->Word16\"       fromIntegral = \\x -> case fromIntegral x of W# x# -> W16# (narrow16Word# x#)\n\"fromIntegral/Word16->a\"       fromIntegral = \\(W16# x#) -> fromIntegral (W# x#)\n  #-}\n\n{-# RULES\n\"properFraction/Float->(Word16,Float)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Word16) n, y :: Float) }\n\"truncate/Float->Word16\"\n    truncate = (fromIntegral :: Int -> Word16) . (truncate :: Float -> Int)\n\"floor/Float->Word16\"\n    floor    = (fromIntegral :: Int -> Word16) . (floor :: Float -> Int)\n\"ceiling/Float->Word16\"\n    ceiling  = (fromIntegral :: Int -> Word16) . (ceiling :: Float -> Int)\n\"round/Float->Word16\"\n    round    = (fromIntegral :: Int -> Word16) . (round  :: Float -> Int)\n  #-}\n\n{-# RULES\n\"properFraction/Double->(Word16,Double)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Word16) n, y :: Double) }\n\"truncate/Double->Word16\"\n    truncate = (fromIntegral :: Int -> Word16) . (truncate :: Double -> Int)\n\"floor/Double->Word16\"\n    floor    = (fromIntegral :: Int -> Word16) . (floor :: Double -> Int)\n\"ceiling/Double->Word16\"\n    ceiling  = (fromIntegral :: Int -> Word16) . (ceiling :: Double -> Int)\n\"round/Double->Word16\"\n    round    = (fromIntegral :: Int -> Word16) . (round  :: Double -> Int)\n  #-}\n\n------------------------------------------------------------------------\n-- type Word32\n------------------------------------------------------------------------\n\n-- Word32 is represented in the same way as Word.\n#if WORD_SIZE_IN_BITS > 32\n-- Operations may assume and must ensure that it holds only values\n-- from its logical range.\n\n-- We can use rewrite rules for the RealFrac methods\n\n{-# RULES\n\"properFraction/Float->(Word32,Float)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Word32) n, y :: Float) }\n\"truncate/Float->Word32\"\n    truncate = (fromIntegral :: Int -> Word32) . (truncate :: Float -> Int)\n\"floor/Float->Word32\"\n    floor    = (fromIntegral :: Int -> Word32) . (floor :: Float -> Int)\n\"ceiling/Float->Word32\"\n    ceiling  = (fromIntegral :: Int -> Word32) . (ceiling :: Float -> Int)\n\"round/Float->Word32\"\n    round    = (fromIntegral :: Int -> Word32) . (round  :: Float -> Int)\n  #-}\n\n{-# RULES\n\"properFraction/Double->(Word32,Double)\"\n    properFraction = \\x ->\n                      case properFraction x of {\n                        (n, y) -> ((fromIntegral :: Int -> Word32) n, y :: Double) }\n\"truncate/Double->Word32\"\n    truncate = (fromIntegral :: Int -> Word32) . (truncate :: Double -> Int)\n\"floor/Double->Word32\"\n    floor    = (fromIntegral :: Int -> Word32) . (floor :: Double -> Int)\n\"ceiling/Double->Word32\"\n    ceiling  = (fromIntegral :: Int -> Word32) . (ceiling :: Double -> Int)\n\"round/Double->Word32\"\n    round    = (fromIntegral :: Int -> Word32) . (round  :: Double -> Int)\n  #-}\n\n#endif\n\ndata {-# CTYPE \"HsWord32\" #-} Word32 = W32# Word#\n-- ^ 32-bit unsigned integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Word32 where\n    (==) = eqWord32\n    (/=) = neWord32\n\neqWord32, neWord32 :: Word32 -> Word32 -> Bool\neqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord#` y)\nneWord32 (W32# x) (W32# y) = isTrue# (x `neWord#` y)\n{-# INLINE [1] eqWord32 #-}\n{-# INLINE [1] neWord32 #-}\n\n-- | @since 2.01\ninstance Ord Word32 where\n    (<)  = ltWord32\n    (<=) = leWord32\n    (>=) = geWord32\n    (>)  = gtWord32\n\n{-# INLINE [1] gtWord32 #-}\n{-# INLINE [1] geWord32 #-}\n{-# INLINE [1] ltWord32 #-}\n{-# INLINE [1] leWord32 #-}\ngtWord32, geWord32, ltWord32, leWord32 :: Word32 -> Word32 -> Bool\n(W32# x) `gtWord32` (W32# y) = isTrue# (x `gtWord#` y)\n(W32# x) `geWord32` (W32# y) = isTrue# (x `geWord#` y)\n(W32# x) `ltWord32` (W32# y) = isTrue# (x `ltWord#` y)\n(W32# x) `leWord32` (W32# y) = isTrue# (x `leWord#` y)\n\n-- | @since 2.01\ninstance Num Word32 where\n    (W32# x#) + (W32# y#)  = W32# (narrow32Word# (x# `plusWord#` y#))\n    (W32# x#) - (W32# y#)  = W32# (narrow32Word# (x# `minusWord#` y#))\n    (W32# x#) * (W32# y#)  = W32# (narrow32Word# (x# `timesWord#` y#))\n    negate (W32# x#)       = W32# (narrow32Word# (int2Word# (negateInt# (word2Int# x#))))\n    abs x                  = x\n    signum 0               = 0\n    signum _               = 1\n    fromInteger i          = W32# (narrow32Word# (integerToWord i))\n\n-- | @since 2.01\ninstance Enum Word32 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Word32\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Word32\"\n    toEnum i@(I# i#)\n        | i >= 0\n#if WORD_SIZE_IN_BITS > 32\n          && i <= fromIntegral (maxBound::Word32)\n#endif\n                        = W32# (int2Word# i#)\n        | otherwise     = toEnumError \"Word32\" i (minBound::Word32, maxBound::Word32)\n#if WORD_SIZE_IN_BITS == 32\n    fromEnum x@(W32# x#)\n        | x <= fromIntegral (maxBound::Int)\n                        = I# (word2Int# x#)\n        | otherwise     = fromEnumError \"Word32\" x\n    enumFrom            = integralEnumFrom\n    enumFromThen        = integralEnumFromThen\n    enumFromTo          = integralEnumFromTo\n    enumFromThenTo      = integralEnumFromThenTo\n#else\n    fromEnum (W32# x#)  = I# (word2Int# x#)\n    enumFrom            = boundedEnumFrom\n    enumFromThen        = boundedEnumFromThen\n#endif\n\n-- | @since 2.01\ninstance Integral Word32 where\n    quot    (W32# x#) y@(W32# y#)\n        | y /= 0                    = W32# (x# `quotWord#` y#)\n        | otherwise                 = divZeroError\n    rem     (W32# x#) y@(W32# y#)\n        | y /= 0                    = W32# (x# `remWord#` y#)\n        | otherwise                 = divZeroError\n    div     (W32# x#) y@(W32# y#)\n        | y /= 0                    = W32# (x# `quotWord#` y#)\n        | otherwise                 = divZeroError\n    mod     (W32# x#) y@(W32# y#)\n        | y /= 0                    = W32# (x# `remWord#` y#)\n        | otherwise                 = divZeroError\n    quotRem (W32# x#) y@(W32# y#)\n        | y /= 0                  = case x# `quotRemWord#` y# of\n                                    (# q, r #) ->\n                                        (W32# q, W32# r)\n        | otherwise                 = divZeroError\n    divMod  (W32# x#) y@(W32# y#)\n        | y /= 0                    = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))\n        | otherwise                 = divZeroError\n    toInteger (W32# x#)\n#if WORD_SIZE_IN_BITS == 32\n        | isTrue# (i# >=# 0#)       = smallInteger i#\n        | otherwise                 = wordToInteger x#\n        where\n        !i# = word2Int# x#\n#else\n                                    = smallInteger (word2Int# x#)\n#endif\n\n-- | @since 2.01\ninstance Bits Word32 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (W32# x#) .&.   (W32# y#)  = W32# (x# `and#` y#)\n    (W32# x#) .|.   (W32# y#)  = W32# (x# `or#`  y#)\n    (W32# x#) `xor` (W32# y#)  = W32# (x# `xor#` y#)\n    complement (W32# x#)       = W32# (x# `xor#` mb#)\n        where !(W32# mb#) = maxBound\n    (W32# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = W32# (narrow32Word# (x# `shiftL#` i#))\n        | otherwise            = W32# (x# `shiftRL#` negateInt# i#)\n    (W32# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W32# (narrow32Word# (x# `shiftL#` i#))\n        | otherwise            = overflowError\n    (W32# x#) `unsafeShiftL` (I# i#) =\n        W32# (narrow32Word# (x# `uncheckedShiftL#` i#))\n    (W32# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W32# (x# `shiftRL#` i#)\n        | otherwise            = overflowError\n    (W32# x#) `unsafeShiftR` (I# i#) = W32# (x# `uncheckedShiftRL#` i#)\n    (W32# x#) `rotate`       (I# i#)\n        | isTrue# (i'# ==# 0#) = W32# x#\n        | otherwise   = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#`\n                                            (x# `uncheckedShiftRL#` (32# -# i'#))))\n        where\n        !i'# = word2Int# (int2Word# i# `and#` 31##)\n    bitSizeMaybe i            = Just (finiteBitSize i)\n    bitSize i                 = finiteBitSize i\n    isSigned _                = False\n    popCount (W32# x#)        = I# (word2Int# (popCnt32# x#))\n    bit                       = bitDefault\n    testBit                   = testBitDefault\n\n-- | @since 4.6.0.0\ninstance FiniteBits Word32 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 32\n    countLeadingZeros  (W32# x#) = I# (word2Int# (clz32# x#))\n    countTrailingZeros (W32# x#) = I# (word2Int# (ctz32# x#))\n\n{-# RULES\n\"fromIntegral/Word8->Word32\"   fromIntegral = \\(W8# x#) -> W32# x#\n\"fromIntegral/Word16->Word32\"  fromIntegral = \\(W16# x#) -> W32# x#\n\"fromIntegral/Word32->Word32\"  fromIntegral = id :: Word32 -> Word32\n\"fromIntegral/Word32->Integer\" fromIntegral = toInteger :: Word32 -> Integer\n\"fromIntegral/a->Word32\"       fromIntegral = \\x -> case fromIntegral x of W# x# -> W32# (narrow32Word# x#)\n\"fromIntegral/Word32->a\"       fromIntegral = \\(W32# x#) -> fromIntegral (W# x#)\n  #-}\n\n-- | @since 2.01\ninstance Show Word32 where\n#if WORD_SIZE_IN_BITS < 33\n    showsPrec p x = showsPrec p (toInteger x)\n#else\n    showsPrec p x = showsPrec p (fromIntegral x :: Int)\n#endif\n\n\n-- | @since 2.01\ninstance Real Word32 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Bounded Word32 where\n    minBound = 0\n    maxBound = 0xFFFFFFFF\n\n-- | @since 2.01\ninstance Ix Word32 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral (i - m)\n    inRange (m,n) i     = m <= i && i <= n\n\n-- | Reverse order of bytes in 'Word32'.\n--\n-- @since 4.7.0.0\nbyteSwap32 :: Word32 -> Word32\nbyteSwap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#))\n\n------------------------------------------------------------------------\n-- type Word64\n------------------------------------------------------------------------\n\n#if WORD_SIZE_IN_BITS < 64\n\ndata {-# CTYPE \"HsWord64\" #-} Word64 = W64# Word64#\n-- ^ 64-bit unsigned integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Word64 where\n    (==) = eqWord64\n    (/=) = neWord64\n\neqWord64, neWord64 :: Word64 -> Word64 -> Bool\neqWord64 (W64# x) (W64# y) = isTrue# (x `eqWord64#` y)\nneWord64 (W64# x) (W64# y) = isTrue# (x `neWord64#` y)\n{-# INLINE [1] eqWord64 #-}\n{-# INLINE [1] neWord64 #-}\n\n-- | @since 2.01\ninstance Ord Word64 where\n    (<)  = ltWord64\n    (<=) = leWord64\n    (>=) = geWord64\n    (>)  = gtWord64\n\n{-# INLINE [1] gtWord64 #-}\n{-# INLINE [1] geWord64 #-}\n{-# INLINE [1] ltWord64 #-}\n{-# INLINE [1] leWord64 #-}\ngtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool\n(W64# x) `gtWord64` (W64# y) = isTrue# (x `gtWord64#` y)\n(W64# x) `geWord64` (W64# y) = isTrue# (x `geWord64#` y)\n(W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord64#` y)\n(W64# x) `leWord64` (W64# y) = isTrue# (x `leWord64#` y)\n\n-- | @since 2.01\ninstance Num Word64 where\n    (W64# x#) + (W64# y#)  = W64# (int64ToWord64# (word64ToInt64# x# `plusInt64#` word64ToInt64# y#))\n    (W64# x#) - (W64# y#)  = W64# (int64ToWord64# (word64ToInt64# x# `minusInt64#` word64ToInt64# y#))\n    (W64# x#) * (W64# y#)  = W64# (int64ToWord64# (word64ToInt64# x# `timesInt64#` word64ToInt64# y#))\n    negate (W64# x#)       = W64# (int64ToWord64# (negateInt64# (word64ToInt64# x#)))\n    abs x                  = x\n    signum 0               = 0\n    signum _               = 1\n    fromInteger i          = W64# (integerToWord64 i)\n\n-- | @since 2.01\ninstance Enum Word64 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Word64\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Word64\"\n    toEnum i@(I# i#)\n        | i >= 0        = W64# (wordToWord64# (int2Word# i#))\n        | otherwise     = toEnumError \"Word64\" i (minBound::Word64, maxBound::Word64)\n    fromEnum x@(W64# x#)\n        | x <= fromIntegral (maxBound::Int)\n                        = I# (word2Int# (word64ToWord# x#))\n        | otherwise     = fromEnumError \"Word64\" x\n    enumFrom            = integralEnumFrom\n    enumFromThen        = integralEnumFromThen\n    enumFromTo          = integralEnumFromTo\n    enumFromThenTo      = integralEnumFromThenTo\n\n-- | @since 2.01\ninstance Integral Word64 where\n    quot    (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `quotWord64#` y#)\n        | otherwise                 = divZeroError\n    rem     (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `remWord64#` y#)\n        | otherwise                 = divZeroError\n    div     (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `quotWord64#` y#)\n        | otherwise                 = divZeroError\n    mod     (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `remWord64#` y#)\n        | otherwise                 = divZeroError\n    quotRem (W64# x#) y@(W64# y#)\n        | y /= 0                    = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))\n        | otherwise                 = divZeroError\n    divMod  (W64# x#) y@(W64# y#)\n        | y /= 0                    = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))\n        | otherwise                 = divZeroError\n    toInteger (W64# x#)             = word64ToInteger x#\n\n-- | @since 2.01\ninstance Bits Word64 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (W64# x#) .&.   (W64# y#)  = W64# (x# `and64#` y#)\n    (W64# x#) .|.   (W64# y#)  = W64# (x# `or64#`  y#)\n    (W64# x#) `xor` (W64# y#)  = W64# (x# `xor64#` y#)\n    complement (W64# x#)       = W64# (not64# x#)\n    (W64# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = W64# (x# `shiftL64#` i#)\n        | otherwise            = W64# (x# `shiftRL64#` negateInt# i#)\n    (W64# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W64# (x# `shiftL64#` i#)\n        | otherwise            = overflowError\n    (W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL64#` i#)\n    (W64# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W64# (x# `shiftRL64#` i#)\n        | otherwise            = overflowError\n    (W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)\n    (W64# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#) = W64# x#\n        | otherwise            = W64# ((x# `uncheckedShiftL64#` i'#) `or64#`\n                                       (x# `uncheckedShiftRL64#` (64# -# i'#)))\n        where\n        !i'# = word2Int# (int2Word# i# `and#` 63##)\n    bitSizeMaybe i            = Just (finiteBitSize i)\n    bitSize i                 = finiteBitSize i\n    isSigned _                = False\n    popCount (W64# x#)        = I# (word2Int# (popCnt64# x#))\n    bit                       = bitDefault\n    testBit                   = testBitDefault\n\n-- give the 64-bit shift operations the same treatment as the 32-bit\n-- ones (see GHC.Base), namely we wrap them in tests to catch the\n-- cases when we're shifting more than 64 bits to avoid unspecified\n-- behaviour in the C shift operations.\n\nshiftL64#, shiftRL64# :: Word64# -> Int# -> Word64#\n\na `shiftL64#` b  | isTrue# (b >=# 64#) = wordToWord64# 0##\n                 | otherwise           = a `uncheckedShiftL64#` b\n\na `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0##\n                 | otherwise           = a `uncheckedShiftRL64#` b\n\n{-# RULES\n\"fromIntegral/Int->Word64\"    fromIntegral = \\(I#   x#) -> W64# (int64ToWord64# (intToInt64# x#))\n\"fromIntegral/Word->Word64\"   fromIntegral = \\(W#   x#) -> W64# (wordToWord64# x#)\n\"fromIntegral/Word64->Int\"    fromIntegral = \\(W64# x#) -> I#   (word2Int# (word64ToWord# x#))\n\"fromIntegral/Word64->Word\"   fromIntegral = \\(W64# x#) -> W#   (word64ToWord# x#)\n\"fromIntegral/Word64->Word64\" fromIntegral = id :: Word64 -> Word64\n  #-}\n\n#else\n\n-- Word64 is represented in the same way as Word.\n-- Operations may assume and must ensure that it holds only values\n-- from its logical range.\n\ndata {-# CTYPE \"HsWord64\" #-} Word64 = W64# Word#\n-- ^ 64-bit unsigned integer type\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n-- | @since 2.01\ninstance Eq Word64 where\n    (==) = eqWord64\n    (/=) = neWord64\n\neqWord64, neWord64 :: Word64 -> Word64 -> Bool\neqWord64 (W64# x) (W64# y) = isTrue# (x `eqWord#` y)\nneWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y)\n{-# INLINE [1] eqWord64 #-}\n{-# INLINE [1] neWord64 #-}\n\n-- | @since 2.01\ninstance Ord Word64 where\n    (<)  = ltWord64\n    (<=) = leWord64\n    (>=) = geWord64\n    (>)  = gtWord64\n\n{-# INLINE [1] gtWord64 #-}\n{-# INLINE [1] geWord64 #-}\n{-# INLINE [1] ltWord64 #-}\n{-# INLINE [1] leWord64 #-}\ngtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool\n(W64# x) `gtWord64` (W64# y) = isTrue# (x `gtWord#` y)\n(W64# x) `geWord64` (W64# y) = isTrue# (x `geWord#` y)\n(W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord#` y)\n(W64# x) `leWord64` (W64# y) = isTrue# (x `leWord#` y)\n\n-- | @since 2.01\ninstance Num Word64 where\n    (W64# x#) + (W64# y#)  = W64# (x# `plusWord#` y#)\n    (W64# x#) - (W64# y#)  = W64# (x# `minusWord#` y#)\n    (W64# x#) * (W64# y#)  = W64# (x# `timesWord#` y#)\n    negate (W64# x#)       = W64# (int2Word# (negateInt# (word2Int# x#)))\n    abs x                  = x\n    signum 0               = 0\n    signum _               = 1\n    fromInteger i          = W64# (integerToWord i)\n\n-- | @since 2.01\ninstance Enum Word64 where\n    succ x\n        | x /= maxBound = x + 1\n        | otherwise     = succError \"Word64\"\n    pred x\n        | x /= minBound = x - 1\n        | otherwise     = predError \"Word64\"\n    toEnum i@(I# i#)\n        | i >= 0        = W64# (int2Word# i#)\n        | otherwise     = toEnumError \"Word64\" i (minBound::Word64, maxBound::Word64)\n    fromEnum x@(W64# x#)\n        | x <= fromIntegral (maxBound::Int)\n                        = I# (word2Int# x#)\n        | otherwise     = fromEnumError \"Word64\" x\n    enumFrom            = integralEnumFrom\n    enumFromThen        = integralEnumFromThen\n    enumFromTo          = integralEnumFromTo\n    enumFromThenTo      = integralEnumFromThenTo\n\n-- | @since 2.01\ninstance Integral Word64 where\n    quot    (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `quotWord#` y#)\n        | otherwise                 = divZeroError\n    rem     (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `remWord#` y#)\n        | otherwise                 = divZeroError\n    div     (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `quotWord#` y#)\n        | otherwise                 = divZeroError\n    mod     (W64# x#) y@(W64# y#)\n        | y /= 0                    = W64# (x# `remWord#` y#)\n        | otherwise                 = divZeroError\n    quotRem (W64# x#) y@(W64# y#)\n        | y /= 0                  = case x# `quotRemWord#` y# of\n                                    (# q, r #) ->\n                                        (W64# q, W64# r)\n        | otherwise                 = divZeroError\n    divMod  (W64# x#) y@(W64# y#)\n        | y /= 0                    = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#))\n        | otherwise                 = divZeroError\n    toInteger (W64# x#)\n        | isTrue# (i# >=# 0#)       = smallInteger i#\n        | otherwise                 = wordToInteger x#\n        where\n        !i# = word2Int# x#\n\n-- | @since 2.01\ninstance Bits Word64 where\n    {-# INLINE shift #-}\n    {-# INLINE bit #-}\n    {-# INLINE testBit #-}\n    {-# INLINE popCount #-}\n\n    (W64# x#) .&.   (W64# y#)  = W64# (x# `and#` y#)\n    (W64# x#) .|.   (W64# y#)  = W64# (x# `or#`  y#)\n    (W64# x#) `xor` (W64# y#)  = W64# (x# `xor#` y#)\n    complement (W64# x#)       = W64# (x# `xor#` mb#)\n        where !(W64# mb#) = maxBound\n    (W64# x#) `shift` (I# i#)\n        | isTrue# (i# >=# 0#)  = W64# (x# `shiftL#` i#)\n        | otherwise            = W64# (x# `shiftRL#` negateInt# i#)\n    (W64# x#) `shiftL`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W64# (x# `shiftL#` i#)\n        | otherwise            = overflowError\n    (W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL#` i#)\n    (W64# x#) `shiftR`       (I# i#)\n        | isTrue# (i# >=# 0#)  = W64# (x# `shiftRL#` i#)\n        | otherwise            = overflowError\n    (W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL#` i#)\n    (W64# x#) `rotate` (I# i#)\n        | isTrue# (i'# ==# 0#) = W64# x#\n        | otherwise            = W64# ((x# `uncheckedShiftL#` i'#) `or#`\n                                       (x# `uncheckedShiftRL#` (64# -# i'#)))\n        where\n        !i'# = word2Int# (int2Word# i# `and#` 63##)\n    bitSizeMaybe i            = Just (finiteBitSize i)\n    bitSize i                 = finiteBitSize i\n    isSigned _                = False\n    popCount (W64# x#)        = I# (word2Int# (popCnt64# x#))\n    bit                       = bitDefault\n    testBit                   = testBitDefault\n\n{-# RULES\n\"fromIntegral/a->Word64\" fromIntegral = \\x -> case fromIntegral x of W# x# -> W64# x#\n\"fromIntegral/Word64->a\" fromIntegral = \\(W64# x#) -> fromIntegral (W# x#)\n  #-}\n\nuncheckedShiftL64# :: Word# -> Int# -> Word#\nuncheckedShiftL64#  = uncheckedShiftL#\n\nuncheckedShiftRL64# :: Word# -> Int# -> Word#\nuncheckedShiftRL64# = uncheckedShiftRL#\n\n#endif\n\n-- | @since 4.6.0.0\ninstance FiniteBits Word64 where\n    {-# INLINE countLeadingZeros #-}\n    {-# INLINE countTrailingZeros #-}\n    finiteBitSize _ = 64\n    countLeadingZeros  (W64# x#) = I# (word2Int# (clz64# x#))\n    countTrailingZeros (W64# x#) = I# (word2Int# (ctz64# x#))\n\n-- | @since 2.01\ninstance Show Word64 where\n    showsPrec p x = showsPrec p (toInteger x)\n\n-- | @since 2.01\ninstance Real Word64 where\n    toRational x = toInteger x % 1\n\n-- | @since 2.01\ninstance Bounded Word64 where\n    minBound = 0\n    maxBound = 0xFFFFFFFFFFFFFFFF\n\n-- | @since 2.01\ninstance Ix Word64 where\n    range (m,n)         = [m..n]\n    unsafeIndex (m,_) i = fromIntegral (i - m)\n    inRange (m,n) i     = m <= i && i <= n\n\n-- | Reverse order of bytes in 'Word64'.\n--\n-- @since 4.7.0.0\n#if WORD_SIZE_IN_BITS < 64\nbyteSwap64 :: Word64 -> Word64\nbyteSwap64 (W64# w#) = W64# (byteSwap64# w#)\n#else\nbyteSwap64 :: Word64 -> Word64\nbyteSwap64 (W64# w#) = W64# (byteSwap# w#)\n#endif\n\n-------------------------------------------------------------------------------\n\n{-# RULES\n\"fromIntegral/Natural->Word8\"\n    fromIntegral = (fromIntegral :: Word -> Word8)  . naturalToWord\n\"fromIntegral/Natural->Word16\"\n    fromIntegral = (fromIntegral :: Word -> Word16) . naturalToWord\n\"fromIntegral/Natural->Word32\"\n    fromIntegral = (fromIntegral :: Word -> Word32) . naturalToWord\n  #-}\n\n{-# RULES\n\"fromIntegral/Word8->Natural\"\n    fromIntegral = wordToNatural . (fromIntegral :: Word8  -> Word)\n\"fromIntegral/Word16->Natural\"\n    fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word)\n\"fromIntegral/Word32->Natural\"\n    fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word)\n  #-}\n\n#if WORD_SIZE_IN_BITS == 64\n-- these RULES are valid for Word==Word64\n{-# RULES\n\"fromIntegral/Natural->Word64\"\n    fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord\n\"fromIntegral/Word64->Natural\"\n    fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word)\n  #-}\n#endif\n", "num_lines": 1038}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , MagicHash\n           , UnboxedTuples\n  #-}\n{-# OPTIONS_GHC -Wno-missing-signatures #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Conc.IO\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Basic concurrency stuff.\n--\n-----------------------------------------------------------------------------\n\n-- No: #hide, because bits of this module are exposed by the stm package.\n-- However, we don't want this module to be the home location for the\n-- bits it exports, we'd rather have Control.Concurrent and the other\n-- higher level modules be the home.  Hence: #not-home\n\nmodule GHC.Conc.IO\n        ( ensureIOManagerIsRunning\n        , ioManagerCapabilitiesChanged\n\n        -- * Waiting\n        , threadDelay\n        , registerDelay\n        , threadWaitRead\n        , threadWaitWrite\n        , threadWaitReadSTM\n        , threadWaitWriteSTM\n        , closeFdWith\n\n#if defined(mingw32_HOST_OS)\n        , asyncRead\n        , asyncWrite\n        , asyncDoProc\n\n        , asyncReadBA\n        , asyncWriteBA\n\n        , ConsoleEvent(..)\n        , win32ConsoleHandler\n        , toWin32ConsoleEvent\n#endif\n        ) where\n\nimport Foreign\nimport GHC.Base\nimport GHC.Conc.Sync as Sync\nimport GHC.Real ( fromIntegral )\nimport System.Posix.Types\n\n#if defined(mingw32_HOST_OS)\nimport qualified GHC.Conc.Windows as Windows\nimport GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,\n                         asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,\n                         toWin32ConsoleEvent)\n#else\nimport qualified GHC.Event.Thread as Event\n#endif\n\nensureIOManagerIsRunning :: IO ()\n#if !defined(mingw32_HOST_OS)\nensureIOManagerIsRunning = Event.ensureIOManagerIsRunning\n#else\nensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning\n#endif\n\nioManagerCapabilitiesChanged :: IO ()\n#if !defined(mingw32_HOST_OS)\nioManagerCapabilitiesChanged = Event.ioManagerCapabilitiesChanged\n#else\nioManagerCapabilitiesChanged = return ()\n#endif\n\n-- | Block the current thread until data is available to read on the\n-- given file descriptor (GHC only).\n--\n-- This will throw an 'Prelude.IOError' if the file descriptor was closed\n-- while this thread was blocked.  To safely close a file descriptor\n-- that has been used with 'threadWaitRead', use 'closeFdWith'.\nthreadWaitRead :: Fd -> IO ()\nthreadWaitRead fd\n#if !defined(mingw32_HOST_OS)\n  | threaded  = Event.threadWaitRead fd\n#endif\n  | otherwise = IO $ \\s ->\n        case fromIntegral fd of { I# fd# ->\n        case waitRead# fd# s of { s' -> (# s', () #)\n        }}\n\n-- | Block the current thread until data can be written to the\n-- given file descriptor (GHC only).\n--\n-- This will throw an 'Prelude.IOError' if the file descriptor was closed\n-- while this thread was blocked.  To safely close a file descriptor\n-- that has been used with 'threadWaitWrite', use 'closeFdWith'.\nthreadWaitWrite :: Fd -> IO ()\nthreadWaitWrite fd\n#if !defined(mingw32_HOST_OS)\n  | threaded  = Event.threadWaitWrite fd\n#endif\n  | otherwise = IO $ \\s ->\n        case fromIntegral fd of { I# fd# ->\n        case waitWrite# fd# s of { s' -> (# s', () #)\n        }}\n\n-- | Returns an STM action that can be used to wait for data\n-- to read from a file descriptor. The second returned value\n-- is an IO action that can be used to deregister interest\n-- in the file descriptor.\nthreadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ())\nthreadWaitReadSTM fd\n#if !defined(mingw32_HOST_OS)\n  | threaded  = Event.threadWaitReadSTM fd\n#endif\n  | otherwise = do\n      m <- Sync.newTVarIO False\n      t <- Sync.forkIO $ do\n        threadWaitRead fd\n        Sync.atomically $ Sync.writeTVar m True\n      let waitAction = do b <- Sync.readTVar m\n                          if b then return () else retry\n      let killAction = Sync.killThread t\n      return (waitAction, killAction)\n\n-- | Returns an STM action that can be used to wait until data\n-- can be written to a file descriptor. The second returned value\n-- is an IO action that can be used to deregister interest\n-- in the file descriptor.\nthreadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())\nthreadWaitWriteSTM fd\n#if !defined(mingw32_HOST_OS)\n  | threaded  = Event.threadWaitWriteSTM fd\n#endif\n  | otherwise = do\n      m <- Sync.newTVarIO False\n      t <- Sync.forkIO $ do\n        threadWaitWrite fd\n        Sync.atomically $ Sync.writeTVar m True\n      let waitAction = do b <- Sync.readTVar m\n                          if b then return () else retry\n      let killAction = Sync.killThread t\n      return (waitAction, killAction)\n\n-- | Close a file descriptor in a concurrency-safe way (GHC only).  If\n-- you are using 'threadWaitRead' or 'threadWaitWrite' to perform\n-- blocking I\\/O, you /must/ use this function to close file\n-- descriptors, or blocked threads may not be woken.\n--\n-- Any threads that are blocked on the file descriptor via\n-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having\n-- IO exceptions thrown.\ncloseFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.\n            -> Fd            -- ^ File descriptor to close.\n            -> IO ()\ncloseFdWith close fd\n#if !defined(mingw32_HOST_OS)\n  | threaded  = Event.closeFdWith close fd\n#endif\n  | otherwise = close fd\n\n-- | Suspends the current thread for a given number of microseconds\n-- (GHC only).\n--\n-- There is no guarantee that the thread will be rescheduled promptly\n-- when the delay has expired, but the thread will never continue to\n-- run /earlier/ than specified.\n--\nthreadDelay :: Int -> IO ()\nthreadDelay time\n#if defined(mingw32_HOST_OS)\n  | threaded  = Windows.threadDelay time\n#else\n  | threaded  = Event.threadDelay time\n#endif\n  | otherwise = IO $ \\s ->\n        case time of { I# time# ->\n        case delay# time# s of { s' -> (# s', () #)\n        }}\n\n-- | Switch the value of returned 'TVar' from initial value 'False' to 'True'\n-- after a given number of microseconds. The caveats associated with\n-- 'threadDelay' also apply.\n--\nregisterDelay :: Int -> IO (TVar Bool)\nregisterDelay usecs\n#if defined(mingw32_HOST_OS)\n  | threaded = Windows.registerDelay usecs\n#else\n  | threaded = Event.registerDelay usecs\n#endif\n  | otherwise = errorWithoutStackTrace \"registerDelay: requires -threaded\"\n\nforeign import ccall unsafe \"rtsSupportsBoundThreads\" threaded :: Bool\n", "num_lines": 205}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule GHC.Conc.Signal\n        ( Signal\n        , HandlerFun\n        , setHandler\n        , runHandlers\n        , runHandlersPtr\n        ) where\n\nimport Control.Concurrent.MVar (MVar, newMVar, withMVar)\nimport Data.Dynamic (Dynamic)\nimport Foreign.C.Types (CInt)\nimport Foreign.ForeignPtr (ForeignPtr, newForeignPtr)\nimport Foreign.StablePtr (castPtrToStablePtr, castStablePtrToPtr,\n                          deRefStablePtr, freeStablePtr, newStablePtr)\nimport Foreign.Ptr (Ptr, castPtr)\nimport Foreign.Marshal.Alloc (finalizerFree)\nimport GHC.Arr (inRange)\nimport GHC.Base\nimport GHC.Conc.Sync (forkIO)\nimport GHC.IO (mask_, unsafePerformIO)\nimport GHC.IOArray (IOArray, boundsIOArray, newIOArray,\n                    unsafeReadIOArray, unsafeWriteIOArray)\nimport GHC.Real (fromIntegral)\nimport GHC.Word (Word8)\n\n------------------------------------------------------------------------\n-- Signal handling\n\ntype Signal = CInt\n\nmaxSig :: Int\nmaxSig = 64\n\ntype HandlerFun = ForeignPtr Word8 -> IO ()\n\n-- Lock used to protect concurrent access to signal_handlers.  Symptom\n-- of this race condition is GHC bug #1922, although that bug was on\n-- Windows a similar bug also exists on Unix.\nsignal_handlers :: MVar (IOArray Int (Maybe (HandlerFun,Dynamic)))\nsignal_handlers = unsafePerformIO $ do\n  arr <- newIOArray (0, maxSig) Nothing\n  m <- newMVar arr\n  sharedCAF m getOrSetGHCConcSignalSignalHandlerStore\n{-# NOINLINE signal_handlers #-}\n\nforeign import ccall unsafe \"getOrSetGHCConcSignalSignalHandlerStore\"\n  getOrSetGHCConcSignalSignalHandlerStore :: Ptr a -> IO (Ptr a)\n\nsetHandler :: Signal -> Maybe (HandlerFun, Dynamic)\n           -> IO (Maybe (HandlerFun, Dynamic))\nsetHandler sig handler = do\n  let int = fromIntegral sig\n  withMVar signal_handlers $ \\arr ->\n    if not (inRange (boundsIOArray arr) int)\n      then errorWithoutStackTrace \"GHC.Conc.setHandler: signal out of range\"\n      else do old <- unsafeReadIOArray arr int\n              unsafeWriteIOArray arr int handler\n              return old\n\nrunHandlers :: ForeignPtr Word8 -> Signal -> IO ()\nrunHandlers p_info sig = do\n  let int = fromIntegral sig\n  withMVar signal_handlers $ \\arr ->\n    if not (inRange (boundsIOArray arr) int)\n      then return ()\n      else do handler <- unsafeReadIOArray arr int\n              case handler of\n                Nothing -> return ()\n                Just (f,_)  -> do _ <- forkIO (f p_info)\n                                  return ()\n\n-- It is our responsibility to free the memory buffer, so we create a\n-- foreignPtr.\nrunHandlersPtr :: Ptr Word8 -> Signal -> IO ()\nrunHandlersPtr p s = do\n  fp <- newForeignPtr finalizerFree p\n  runHandlers fp s\n\n-- Machinery needed to ensure that we only have one copy of certain\n-- CAFs in this module even when the base package is present twice, as\n-- it is when base is dynamically loaded into GHCi.  The RTS keeps\n-- track of the single true value of the CAF, so even when the CAFs in\n-- the dynamically-loaded base package are reverted, nothing bad\n-- happens.\n--\nsharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a\nsharedCAF a get_or_set =\n  mask_ $ do\n    stable_ref <- newStablePtr a\n    let ref = castPtr (castStablePtrToPtr stable_ref)\n    ref2 <- get_or_set ref\n    if ref == ref2\n      then return a\n      else do freeStablePtr stable_ref\n              deRefStablePtr (castPtrToStablePtr (castPtr ref2))\n\n", "num_lines": 100}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , BangPatterns\n           , MagicHash\n           , UnboxedTuples\n           , UnliftedFFITypes\n           , StandaloneDeriving\n           , RankNTypes\n  #-}\n{-# OPTIONS_GHC -Wno-missing-signatures #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Conc.Sync\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Basic concurrency stuff.\n--\n-----------------------------------------------------------------------------\n\n-- No: #hide, because bits of this module are exposed by the stm package.\n-- However, we don't want this module to be the home location for the\n-- bits it exports, we'd rather have Control.Concurrent and the other\n-- higher level modules be the home.  Hence:\n\n-- #not-home\nmodule GHC.Conc.Sync\n        ( ThreadId(..)\n\n        -- * Forking and suchlike\n        , forkIO\n        , forkIOWithUnmask\n        , forkOn\n        , forkOnWithUnmask\n        , numCapabilities\n        , getNumCapabilities\n        , setNumCapabilities\n        , getNumProcessors\n        , numSparks\n        , childHandler\n        , myThreadId\n        , killThread\n        , throwTo\n        , par\n        , pseq\n        , runSparks\n        , yield\n        , labelThread\n        , mkWeakThreadId\n\n        , ThreadStatus(..), BlockReason(..)\n        , threadStatus\n        , threadCapability\n\n        , newStablePtrPrimMVar, PrimMVar\n\n        -- * Allocation counter and quota\n        , setAllocationCounter\n        , getAllocationCounter\n        , enableAllocationLimit\n        , disableAllocationLimit\n\n        -- * TVars\n        , STM(..)\n        , atomically\n        , retry\n        , orElse\n        , throwSTM\n        , catchSTM\n        , TVar(..)\n        , newTVar\n        , newTVarIO\n        , readTVar\n        , readTVarIO\n        , writeTVar\n        , unsafeIOToSTM\n\n        -- * Miscellaneous\n        , withMVar\n        , modifyMVar_\n\n        , setUncaughtExceptionHandler\n        , getUncaughtExceptionHandler\n\n        , reportError, reportStackOverflow, reportHeapOverflow\n\n        , sharedCAF\n        ) where\n\nimport Foreign\nimport Foreign.C\n\nimport Data.Typeable\nimport Data.Maybe\n\nimport GHC.Base\nimport {-# SOURCE #-} GHC.IO.Handle ( hFlush )\nimport {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )\nimport GHC.Int\nimport GHC.IO\nimport GHC.IO.Encoding.UTF8\nimport GHC.IO.Exception\nimport GHC.Exception\nimport qualified GHC.Foreign\nimport GHC.IORef\nimport GHC.MVar\nimport GHC.Ptr\nimport GHC.Real         ( fromIntegral )\nimport GHC.Show         ( Show(..), showString )\nimport GHC.Stable       ( StablePtr(..) )\nimport GHC.Weak\n\ninfixr 0 `par`, `pseq`\n\n-----------------------------------------------------------------------------\n-- 'ThreadId', 'par', and 'fork'\n-----------------------------------------------------------------------------\n\ndata ThreadId = ThreadId ThreadId#\n-- ToDo: data ThreadId = ThreadId (Weak ThreadId#)\n-- But since ThreadId# is unlifted, the Weak type must use open\n-- type variables.\n{- ^\nA 'ThreadId' is an abstract type representing a handle to a thread.\n'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where\nthe 'Ord' instance implements an arbitrary total ordering over\n'ThreadId's. The 'Show' instance lets you convert an arbitrary-valued\n'ThreadId' to string form; showing a 'ThreadId' value is occasionally\nuseful when debugging or diagnosing the behaviour of a concurrent\nprogram.\n\n/Note/: in GHC, if you have a 'ThreadId', you essentially have\na pointer to the thread itself.  This means the thread itself can\\'t be\ngarbage collected until you drop the 'ThreadId'.\nThis misfeature will hopefully be corrected at a later date.\n\n-}\n\n-- | @since 4.2.0.0\ninstance Show ThreadId where\n   showsPrec d t =\n        showString \"ThreadId \" .\n        showsPrec d (getThreadId (id2TSO t))\n\nforeign import ccall unsafe \"rts_getThreadId\" getThreadId :: ThreadId# -> CInt\n\nid2TSO :: ThreadId -> ThreadId#\nid2TSO (ThreadId t) = t\n\nforeign import ccall unsafe \"cmp_thread\" cmp_thread :: ThreadId# -> ThreadId# -> CInt\n-- Returns -1, 0, 1\n\ncmpThread :: ThreadId -> ThreadId -> Ordering\ncmpThread t1 t2 =\n   case cmp_thread (id2TSO t1) (id2TSO t2) of\n      -1 -> LT\n      0  -> EQ\n      _  -> GT -- must be 1\n\n-- | @since 4.2.0.0\ninstance Eq ThreadId where\n   t1 == t2 =\n      case t1 `cmpThread` t2 of\n         EQ -> True\n         _  -> False\n\n-- | @since 4.2.0.0\ninstance Ord ThreadId where\n   compare = cmpThread\n\n-- | Every thread has an allocation counter that tracks how much\n-- memory has been allocated by the thread.  The counter is\n-- initialized to zero, and 'setAllocationCounter' sets the current\n-- value.  The allocation counter counts *down*, so in the absence of\n-- a call to 'setAllocationCounter' its value is the negation of the\n-- number of bytes of memory allocated by the thread.\n--\n-- There are two things that you can do with this counter:\n--\n-- * Use it as a simple profiling mechanism, with\n--   'getAllocationCounter'.\n--\n-- * Use it as a resource limit.  See 'enableAllocationLimit'.\n--\n-- Allocation accounting is accurate only to about 4Kbytes.\n--\n-- @since 4.8.0.0\nsetAllocationCounter :: Int64 -> IO ()\nsetAllocationCounter (I64# i) = IO $ \\s ->\n  case setThreadAllocationCounter# i s of s' -> (# s', () #)\n\n-- | Return the current value of the allocation counter for the\n-- current thread.\n--\n-- @since 4.8.0.0\ngetAllocationCounter :: IO Int64\ngetAllocationCounter = IO $ \\s ->\n  case getThreadAllocationCounter# s of (# s', ctr #) -> (# s', I64# ctr #)\n\n-- | Enables the allocation counter to be treated as a limit for the\n-- current thread.  When the allocation limit is enabled, if the\n-- allocation counter counts down below zero, the thread will be sent\n-- the 'AllocationLimitExceeded' asynchronous exception.  When this\n-- happens, the counter is reinitialised (by default\n-- to 100K, but tunable with the @+RTS -xq@ option) so that it can handle\n-- the exception and perform any necessary clean up.  If it exhausts\n-- this additional allowance, another 'AllocationLimitExceeded' exception\n-- is sent, and so forth.  Like other asynchronous exceptions, the\n-- 'AllocationLimitExceeded' exception is deferred while the thread is inside\n-- 'mask' or an exception handler in 'catch'.\n--\n-- Note that memory allocation is unrelated to /live memory/, also\n-- known as /heap residency/.  A thread can allocate a large amount of\n-- memory and retain anything between none and all of it.  It is\n-- better to think of the allocation limit as a limit on\n-- /CPU time/, rather than a limit on memory.\n--\n-- Compared to using timeouts, allocation limits don't count time\n-- spent blocked or in foreign calls.\n--\n-- @since 4.8.0.0\nenableAllocationLimit :: IO ()\nenableAllocationLimit = do\n  ThreadId t <- myThreadId\n  rts_enableThreadAllocationLimit t\n\n-- | Disable allocation limit processing for the current thread.\n--\n-- @since 4.8.0.0\ndisableAllocationLimit :: IO ()\ndisableAllocationLimit = do\n  ThreadId t <- myThreadId\n  rts_disableThreadAllocationLimit t\n\nforeign import ccall unsafe \"rts_enableThreadAllocationLimit\"\n  rts_enableThreadAllocationLimit :: ThreadId# -> IO ()\n\nforeign import ccall unsafe \"rts_disableThreadAllocationLimit\"\n  rts_disableThreadAllocationLimit :: ThreadId# -> IO ()\n\n{- |\nCreates a new thread to run the 'IO' computation passed as the\nfirst argument, and returns the 'ThreadId' of the newly created\nthread.\n\nThe new thread will be a lightweight, /unbound/ thread.  Foreign calls\nmade by this thread are not guaranteed to be made by any particular OS\nthread; if you need foreign calls to be made by a particular OS\nthread, then use 'Control.Concurrent.forkOS' instead.\n\nThe new thread inherits the /masked/ state of the parent (see\n'Control.Exception.mask').\n\nThe newly created thread has an exception handler that discards the\nexceptions 'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM', and\n'ThreadKilled', and passes all other exceptions to the uncaught\nexception handler.\n-}\nforkIO :: IO () -> IO ThreadId\nforkIO action = IO $ \\ s ->\n   case (fork# action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)\n where\n  -- We must use 'catch' rather than 'catchException' because the action\n  -- could be bottom. #13330\n  action_plus = catch action childHandler\n\n-- | Like 'forkIO', but the child thread is passed a function that can\n-- be used to unmask asynchronous exceptions.  This function is\n-- typically used in the following way\n--\n-- >  ... mask_ $ forkIOWithUnmask $ \\unmask ->\n-- >                 catch (unmask ...) handler\n--\n-- so that the exception handler in the child thread is established\n-- with asynchronous exceptions masked, meanwhile the main body of\n-- the child thread is executed in the unmasked state.\n--\n-- Note that the unmask function passed to the child thread should\n-- only be used in that thread; the behaviour is undefined if it is\n-- invoked in a different thread.\n--\n-- @since 4.4.0.0\nforkIOWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId\nforkIOWithUnmask io = forkIO (io unsafeUnmask)\n\n{- |\nLike 'forkIO', but lets you specify on which capability the thread\nshould run.  Unlike a `forkIO` thread, a thread created by `forkOn`\nwill stay on the same capability for its entire lifetime (`forkIO`\nthreads can migrate between capabilities according to the scheduling\npolicy).  `forkOn` is useful for overriding the scheduling policy when\nyou know in advance how best to distribute the threads.\n\nThe `Int` argument specifies a /capability number/ (see\n'getNumCapabilities').  Typically capabilities correspond to physical\nprocessors, but the exact behaviour is implementation-dependent.  The\nvalue passed to 'forkOn' is interpreted modulo the total number of\ncapabilities as returned by 'getNumCapabilities'.\n\nGHC note: the number of capabilities is specified by the @+RTS -N@\noption when the program is started.  Capabilities can be fixed to\nactual processor cores with @+RTS -qa@ if the underlying operating\nsystem supports that, although in practice this is usually unnecessary\n(and may actually degrade performance in some cases - experimentation\nis recommended).\n\n@since 4.4.0.0\n-}\nforkOn :: Int -> IO () -> IO ThreadId\nforkOn (I# cpu) action = IO $ \\ s ->\n   case (forkOn# cpu action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)\n where\n  -- We must use 'catch' rather than 'catchException' because the action\n  -- could be bottom. #13330\n  action_plus = catch action childHandler\n\n-- | Like 'forkIOWithUnmask', but the child thread is pinned to the\n-- given CPU, as with 'forkOn'.\n--\n-- @since 4.4.0.0\nforkOnWithUnmask :: Int -> ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId\nforkOnWithUnmask cpu io = forkOn cpu (io unsafeUnmask)\n\n-- | the value passed to the @+RTS -N@ flag.  This is the number of\n-- Haskell threads that can run truly simultaneously at any given\n-- time, and is typically set to the number of physical processor cores on\n-- the machine.\n--\n-- Strictly speaking it is better to use 'getNumCapabilities', because\n-- the number of capabilities might vary at runtime.\n--\nnumCapabilities :: Int\nnumCapabilities = unsafePerformIO $ getNumCapabilities\n\n{- |\nReturns the number of Haskell threads that can run truly\nsimultaneously (on separate physical processors) at any given time.  To change\nthis value, use 'setNumCapabilities'.\n\n@since 4.4.0.0\n-}\ngetNumCapabilities :: IO Int\ngetNumCapabilities = do\n   n <- peek enabled_capabilities\n   return (fromIntegral n)\n\n{- |\nSet the number of Haskell threads that can run truly simultaneously\n(on separate physical processors) at any given time.  The number\npassed to `forkOn` is interpreted modulo this value.  The initial\nvalue is given by the @+RTS -N@ runtime flag.\n\nThis is also the number of threads that will participate in parallel\ngarbage collection.  It is strongly recommended that the number of\ncapabilities is not set larger than the number of physical processor\ncores, and it may often be beneficial to leave one or more cores free\nto avoid contention with other processes in the machine.\n\n@since 4.5.0.0\n-}\nsetNumCapabilities :: Int -> IO ()\nsetNumCapabilities i\n  | i <= 0    = fail $ \"setNumCapabilities: Capability count (\"++show i++\") must be positive\"\n  | otherwise = c_setNumCapabilities (fromIntegral i)\n\nforeign import ccall safe \"setNumCapabilities\"\n  c_setNumCapabilities :: CUInt -> IO ()\n\n-- | Returns the number of CPUs that the machine has\n--\n-- @since 4.5.0.0\ngetNumProcessors :: IO Int\ngetNumProcessors = fmap fromIntegral c_getNumberOfProcessors\n\nforeign import ccall unsafe \"getNumberOfProcessors\"\n  c_getNumberOfProcessors :: IO CUInt\n\n-- | Returns the number of sparks currently in the local spark pool\nnumSparks :: IO Int\nnumSparks = IO $ \\s -> case numSparks# s of (# s', n #) -> (# s', I# n #)\n\nforeign import ccall \"&enabled_capabilities\" enabled_capabilities :: Ptr CInt\n\nchildHandler :: SomeException -> IO ()\nchildHandler err = catch (real_handler err) childHandler\n  -- We must use catch here rather than catchException. If the\n  -- raised exception throws an (imprecise) exception, then real_handler err\n  -- will do so as well. If we use catchException here, then we could miss\n  -- that exception.\n\nreal_handler :: SomeException -> IO ()\nreal_handler se\n  | Just BlockedIndefinitelyOnMVar <- fromException se  =  return ()\n  | Just BlockedIndefinitelyOnSTM  <- fromException se  =  return ()\n  | Just ThreadKilled              <- fromException se  =  return ()\n  | Just StackOverflow             <- fromException se  =  reportStackOverflow\n  | otherwise                                           =  reportError se\n\n{- | 'killThread' raises the 'ThreadKilled' exception in the given\nthread (GHC only).\n\n> killThread tid = throwTo tid ThreadKilled\n\n-}\nkillThread :: ThreadId -> IO ()\nkillThread tid = throwTo tid ThreadKilled\n\n{- | 'throwTo' raises an arbitrary exception in the target thread (GHC only).\n\nException delivery synchronizes between the source and target thread:\n'throwTo' does not return until the exception has been raised in the\ntarget thread. The calling thread can thus be certain that the target\nthread has received the exception.  Exception delivery is also atomic\nwith respect to other exceptions. Atomicity is a useful property to have\nwhen dealing with race conditions: e.g. if there are two threads that\ncan kill each other, it is guaranteed that only one of the threads\nwill get to kill the other.\n\nWhatever work the target thread was doing when the exception was\nraised is not lost: the computation is suspended until required by\nanother thread.\n\nIf the target thread is currently making a foreign call, then the\nexception will not be raised (and hence 'throwTo' will not return)\nuntil the call has completed.  This is the case regardless of whether\nthe call is inside a 'mask' or not.  However, in GHC a foreign call\ncan be annotated as @interruptible@, in which case a 'throwTo' will\ncause the RTS to attempt to cause the call to return; see the GHC\ndocumentation for more details.\n\nImportant note: the behaviour of 'throwTo' differs from that described in\nthe paper \\\"Asynchronous exceptions in Haskell\\\"\n(<http://research.microsoft.com/~simonpj/Papers/asynch-exns.htm>).\nIn the paper, 'throwTo' is non-blocking; but the library implementation adopts\na more synchronous design in which 'throwTo' does not return until the exception\nis received by the target thread.  The trade-off is discussed in Section 9 of the paper.\nLike any blocking operation, 'throwTo' is therefore interruptible (see Section 5.3 of\nthe paper).  Unlike other interruptible operations, however, 'throwTo'\nis /always/ interruptible, even if it does not actually block.\n\nThere is no guarantee that the exception will be delivered promptly,\nalthough the runtime will endeavour to ensure that arbitrary\ndelays don't occur.  In GHC, an exception can only be raised when a\nthread reaches a /safe point/, where a safe point is where memory\nallocation occurs.  Some loops do not perform any memory allocation\ninside the loop and therefore cannot be interrupted by a 'throwTo'.\n\nIf the target of 'throwTo' is the calling thread, then the behaviour\nis the same as 'Control.Exception.throwIO', except that the exception\nis thrown as an asynchronous exception.  This means that if there is\nan enclosing pure computation, which would be the case if the current\nIO operation is inside 'unsafePerformIO' or 'unsafeInterleaveIO', that\ncomputation is not permanently replaced by the exception, but is\nsuspended as if it had received an asynchronous exception.\n\nNote that if 'throwTo' is called with the current thread as the\ntarget, the exception will be thrown even if the thread is currently\ninside 'mask' or 'uninterruptibleMask'.\n  -}\nthrowTo :: Exception e => ThreadId -> e -> IO ()\nthrowTo (ThreadId tid) ex = IO $ \\ s ->\n   case (killThread# tid (toException ex) s) of s1 -> (# s1, () #)\n\n-- | Returns the 'ThreadId' of the calling thread (GHC only).\nmyThreadId :: IO ThreadId\nmyThreadId = IO $ \\s ->\n   case (myThreadId# s) of (# s1, tid #) -> (# s1, ThreadId tid #)\n\n\n-- | The 'yield' action allows (forces, in a co-operative multitasking\n-- implementation) a context-switch to any other currently runnable\n-- threads (if any), and is occasionally useful when implementing\n-- concurrency abstractions.\nyield :: IO ()\nyield = IO $ \\s ->\n   case (yield# s) of s1 -> (# s1, () #)\n\n{- | 'labelThread' stores a string as identifier for this thread if\nyou built a RTS with debugging support. This identifier will be used in\nthe debugging output to make distinction of different threads easier\n(otherwise you only have the thread state object\\'s address in the heap).\n\nOther applications like the graphical Concurrent Haskell Debugger\n(<http://www.informatik.uni-kiel.de/~fhu/chd/>) may choose to overload\n'labelThread' for their purposes as well.\n-}\n\nlabelThread :: ThreadId -> String -> IO ()\nlabelThread (ThreadId t) str =\n    GHC.Foreign.withCString utf8 str $ \\(Ptr p) ->\n    IO $ \\ s ->\n     case labelThread# t p s of s1 -> (# s1, () #)\n\n--      Nota Bene: 'pseq' used to be 'seq'\n--                 but 'seq' is now defined in PrelGHC\n--\n-- \"pseq\" is defined a bit weirdly (see below)\n--\n-- The reason for the strange \"lazy\" call is that\n-- it fools the compiler into thinking that pseq  and par are non-strict in\n-- their second argument (even if it inlines pseq at the call site).\n-- If it thinks pseq is strict in \"y\", then it often evaluates\n-- \"y\" before \"x\", which is totally wrong.\n\n{-# INLINE pseq  #-}\npseq :: a -> b -> b\npseq  x y = x `seq` lazy y\n\n{-# INLINE par  #-}\npar :: a -> b -> b\npar  x y = case (par# x) of { _ -> lazy y }\n\n-- | Internal function used by the RTS to run sparks.\nrunSparks :: IO ()\nrunSparks = IO loop\n  where loop s = case getSpark# s of\n                   (# s', n, p #) ->\n                      if isTrue# (n ==# 0#)\n                      then (# s', () #)\n                      else p `seq` loop s'\n\ndata BlockReason\n  = BlockedOnMVar\n        -- ^blocked on 'MVar'\n  {- possibly (see 'threadstatus' below):\n  | BlockedOnMVarRead\n        -- ^blocked on reading an empty 'MVar'\n  -}\n  | BlockedOnBlackHole\n        -- ^blocked on a computation in progress by another thread\n  | BlockedOnException\n        -- ^blocked in 'throwTo'\n  | BlockedOnSTM\n        -- ^blocked in 'retry' in an STM transaction\n  | BlockedOnForeignCall\n        -- ^currently in a foreign call\n  | BlockedOnOther\n        -- ^blocked on some other resource.  Without @-threaded@,\n        -- I\\/O and 'Control.Concurrent.threadDelay' show up as\n        -- 'BlockedOnOther', with @-threaded@ they show up as 'BlockedOnMVar'.\n  deriving ( Eq   -- ^ @since 4.3.0.0\n           , Ord  -- ^ @since 4.3.0.0\n           , Show -- ^ @since 4.3.0.0\n           )\n\n-- | The current status of a thread\ndata ThreadStatus\n  = ThreadRunning\n        -- ^the thread is currently runnable or running\n  | ThreadFinished\n        -- ^the thread has finished\n  | ThreadBlocked  BlockReason\n        -- ^the thread is blocked on some resource\n  | ThreadDied\n        -- ^the thread received an uncaught exception\n  deriving ( Eq   -- ^ @since 4.3.0.0\n           , Ord  -- ^ @since 4.3.0.0\n           , Show -- ^ @since 4.3.0.0\n           )\n\nthreadStatus :: ThreadId -> IO ThreadStatus\nthreadStatus (ThreadId t) = IO $ \\s ->\n   case threadStatus# t s of\n    (# s', stat, _cap, _locked #) -> (# s', mk_stat (I# stat) #)\n   where\n        -- NB. keep these in sync with includes/rts/Constants.h\n     mk_stat 0  = ThreadRunning\n     mk_stat 1  = ThreadBlocked BlockedOnMVar\n     mk_stat 2  = ThreadBlocked BlockedOnBlackHole\n     mk_stat 6  = ThreadBlocked BlockedOnSTM\n     mk_stat 10 = ThreadBlocked BlockedOnForeignCall\n     mk_stat 11 = ThreadBlocked BlockedOnForeignCall\n     mk_stat 12 = ThreadBlocked BlockedOnException\n     mk_stat 14 = ThreadBlocked BlockedOnMVar -- possibly: BlockedOnMVarRead\n     -- NB. these are hardcoded in rts/PrimOps.cmm\n     mk_stat 16 = ThreadFinished\n     mk_stat 17 = ThreadDied\n     mk_stat _  = ThreadBlocked BlockedOnOther\n\n-- | Returns the number of the capability on which the thread is currently\n-- running, and a boolean indicating whether the thread is locked to\n-- that capability or not.  A thread is locked to a capability if it\n-- was created with @forkOn@.\n--\n-- @since 4.4.0.0\nthreadCapability :: ThreadId -> IO (Int, Bool)\nthreadCapability (ThreadId t) = IO $ \\s ->\n   case threadStatus# t s of\n     (# s', _, cap#, locked# #) -> (# s', (I# cap#, isTrue# (locked# /=# 0#)) #)\n\n-- | Make a weak pointer to a 'ThreadId'.  It can be important to do\n-- this if you want to hold a reference to a 'ThreadId' while still\n-- allowing the thread to receive the @BlockedIndefinitely@ family of\n-- exceptions (e.g. 'BlockedIndefinitelyOnMVar').  Holding a normal\n-- 'ThreadId' reference will prevent the delivery of\n-- @BlockedIndefinitely@ exceptions because the reference could be\n-- used as the target of 'throwTo' at any time, which would unblock\n-- the thread.\n--\n-- Holding a @Weak ThreadId@, on the other hand, will not prevent the\n-- thread from receiving @BlockedIndefinitely@ exceptions.  It is\n-- still possible to throw an exception to a @Weak ThreadId@, but the\n-- caller must use @deRefWeak@ first to determine whether the thread\n-- still exists.\n--\n-- @since 4.6.0.0\nmkWeakThreadId :: ThreadId -> IO (Weak ThreadId)\nmkWeakThreadId t@(ThreadId t#) = IO $ \\s ->\n   case mkWeakNoFinalizer# t# t s of\n      (# s1, w #) -> (# s1, Weak w #)\n\n\ndata PrimMVar\n\n-- | Make a StablePtr that can be passed to the C function\n-- @hs_try_putmvar()@.  The RTS wants a 'StablePtr' to the underlying\n-- 'MVar#', but a 'StablePtr#' can only refer to lifted types, so we\n-- have to cheat by coercing.\nnewStablePtrPrimMVar :: MVar () -> IO (StablePtr PrimMVar)\nnewStablePtrPrimMVar (MVar m) = IO $ \\s0 ->\n  case makeStablePtr# (unsafeCoerce# m :: PrimMVar) s0 of\n    (# s1, sp #) -> (# s1, StablePtr sp #)\n\n-----------------------------------------------------------------------------\n-- Transactional heap operations\n-----------------------------------------------------------------------------\n\n-- TVars are shared memory locations which support atomic memory\n-- transactions.\n\n-- |A monad supporting atomic memory transactions.\nnewtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))\n\nunSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))\nunSTM (STM a) = a\n\n-- | @since 4.3.0.0\ninstance  Functor STM where\n   fmap f x = x >>= (pure . f)\n\n-- | @since 4.8.0.0\ninstance Applicative STM where\n  {-# INLINE pure #-}\n  {-# INLINE (*>) #-}\n  {-# INLINE liftA2 #-}\n  pure x = returnSTM x\n  (<*>) = ap\n  liftA2 = liftM2\n  m *> k = thenSTM m k\n\n-- | @since 4.3.0.0\ninstance  Monad STM  where\n    {-# INLINE (>>=)  #-}\n    m >>= k     = bindSTM m k\n    (>>) = (*>)\n\nbindSTM :: STM a -> (a -> STM b) -> STM b\nbindSTM (STM m) k = STM ( \\s ->\n  case m s of\n    (# new_s, a #) -> unSTM (k a) new_s\n  )\n\nthenSTM :: STM a -> STM b -> STM b\nthenSTM (STM m) k = STM ( \\s ->\n  case m s of\n    (# new_s, _ #) -> unSTM k new_s\n  )\n\nreturnSTM :: a -> STM a\nreturnSTM x = STM (\\s -> (# s, x #))\n\n-- | @since 4.8.0.0\ninstance Alternative STM where\n  empty = retry\n  (<|>) = orElse\n\n-- | @since 4.3.0.0\ninstance MonadPlus STM\n\n-- | Unsafely performs IO in the STM monad.  Beware: this is a highly\n-- dangerous thing to do.\n--\n--   * The STM implementation will often run transactions multiple\n--     times, so you need to be prepared for this if your IO has any\n--     side effects.\n--\n--   * The STM implementation will abort transactions that are known to\n--     be invalid and need to be restarted.  This may happen in the middle\n--     of `unsafeIOToSTM`, so make sure you don't acquire any resources\n--     that need releasing (exception handlers are ignored when aborting\n--     the transaction).  That includes doing any IO using Handles, for\n--     example.  Getting this wrong will probably lead to random deadlocks.\n--\n--   * The transaction may have seen an inconsistent view of memory when\n--     the IO runs.  Invariants that you expect to be true throughout\n--     your program may not be true inside a transaction, due to the\n--     way transactions are implemented.  Normally this wouldn't be visible\n--     to the programmer, but using `unsafeIOToSTM` can expose it.\n--\nunsafeIOToSTM :: IO a -> STM a\nunsafeIOToSTM (IO m) = STM m\n\n-- | Perform a series of STM actions atomically.\n--\n-- Using 'atomically' inside an 'unsafePerformIO' or 'unsafeInterleaveIO'\n-- subverts some of guarantees that STM provides. It makes it possible to\n-- run a transaction inside of another transaction, depending on when the\n-- thunk is evaluated. If a nested transaction is attempted, an exception\n-- is thrown by the runtime. It is possible to safely use 'atomically' inside\n-- 'unsafePerformIO' or 'unsafeInterleaveIO', but the typechecker does not\n-- rule out programs that may attempt nested transactions, meaning that\n-- the programmer must take special care to prevent these.\n--\n-- However, there are functions for creating transactional variables that\n-- can always be safely called in 'unsafePerformIO'. See: 'newTVarIO',\n-- 'Control.Concurrent.STM.TChan.newTChanIO',\n-- 'Control.Concurrent.STM.TChan.newBroadcastTChanIO',\n-- 'Control.Concurrent.STM.TQueue.newTQueueIO',\n-- 'Control.Concurrent.STM.TBQueue.newTBQueueIO', and\n-- 'Control.Concurrent.STM.TMVar.newTMVarIO'.\n--\n-- Using 'unsafePerformIO' inside of 'atomically' is also dangerous but for\n-- different reasons. See 'unsafeIOToSTM' for more on this.\n\natomically :: STM a -> IO a\natomically (STM m) = IO (\\s -> (atomically# m) s )\n\n-- | Retry execution of the current memory transaction because it has seen\n-- values in 'TVar's which mean that it should not continue (e.g. the 'TVar's\n-- represent a shared buffer that is now empty).  The implementation may\n-- block the thread until one of the 'TVar's that it has read from has been\n-- updated. (GHC only)\nretry :: STM a\nretry = STM $ \\s# -> retry# s#\n\n-- | Compose two alternative STM actions (GHC only).\n--\n-- If the first action completes without retrying then it forms the result of\n-- the 'orElse'. Otherwise, if the first action retries, then the second action\n-- is tried in its place. If both actions retry then the 'orElse' as a whole\n-- retries.\norElse :: STM a -> STM a -> STM a\norElse (STM m) e = STM $ \\s -> catchRetry# m (unSTM e) s\n\n-- | A variant of 'throw' that can only be used within the 'STM' monad.\n--\n-- Throwing an exception in @STM@ aborts the transaction and propagates the\n-- exception. If the exception is caught via 'catchSTM', only the changes\n-- enclosed by the catch are rolled back; changes made outside of 'catchSTM'\n-- persist.\n--\n-- If the exception is not caught inside of the 'STM', it is re-thrown by\n-- 'atomically', and the entire 'STM' is rolled back.\n--\n-- Although 'throwSTM' has a type that is an instance of the type of 'throw', the\n-- two functions are subtly different:\n--\n-- > throw e    `seq` x  ===> throw e\n-- > throwSTM e `seq` x  ===> x\n--\n-- The first example will cause the exception @e@ to be raised,\n-- whereas the second one won\\'t.  In fact, 'throwSTM' will only cause\n-- an exception to be raised when it is used within the 'STM' monad.\n-- The 'throwSTM' variant should be used in preference to 'throw' to\n-- raise an exception within the 'STM' monad because it guarantees\n-- ordering with respect to other 'STM' operations, whereas 'throw'\n-- does not.\nthrowSTM :: Exception e => e -> STM a\nthrowSTM e = STM $ raiseIO# (toException e)\n\n-- | Exception handling within STM actions.\n--\n-- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',\n-- using the function @f@ to handle the exception. If an exception is\n-- thrown, any changes made by @m@ are rolled back, but changes prior to\n-- @m@ persist.\ncatchSTM :: Exception e => STM a -> (e -> STM a) -> STM a\ncatchSTM (STM m) handler = STM $ catchSTM# m handler'\n    where\n      handler' e = case fromException e of\n                     Just e' -> unSTM (handler e')\n                     Nothing -> raiseIO# e\n\n-- |Shared memory locations that support atomic memory transactions.\ndata TVar a = TVar (TVar# RealWorld a)\n\n-- | @since 4.8.0.0\ninstance Eq (TVar a) where\n        (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#)\n\n-- | Create a new 'TVar' holding a value supplied\nnewTVar :: a -> STM (TVar a)\nnewTVar val = STM $ \\s1# ->\n    case newTVar# val s1# of\n         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)\n\n-- | @IO@ version of 'newTVar'.  This is useful for creating top-level\n-- 'TVar's using 'System.IO.Unsafe.unsafePerformIO', because using\n-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't\n-- possible.\nnewTVarIO :: a -> IO (TVar a)\nnewTVarIO val = IO $ \\s1# ->\n    case newTVar# val s1# of\n         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)\n\n-- | Return the current value stored in a 'TVar'.\n-- This is equivalent to\n--\n-- >  readTVarIO = atomically . readTVar\n--\n-- but works much faster, because it doesn't perform a complete\n-- transaction, it just reads the current value of the 'TVar'.\nreadTVarIO :: TVar a -> IO a\nreadTVarIO (TVar tvar#) = IO $ \\s# -> readTVarIO# tvar# s#\n\n-- |Return the current value stored in a 'TVar'.\nreadTVar :: TVar a -> STM a\nreadTVar (TVar tvar#) = STM $ \\s# -> readTVar# tvar# s#\n\n-- |Write the supplied value into a 'TVar'.\nwriteTVar :: TVar a -> a -> STM ()\nwriteTVar (TVar tvar#) val = STM $ \\s1# ->\n    case writeTVar# tvar# val s1# of\n         s2# -> (# s2#, () #)\n\n-----------------------------------------------------------------------------\n-- MVar utilities\n-----------------------------------------------------------------------------\n\n-- | Provide an 'IO' action with the current value of an 'MVar'. The 'MVar'\n-- will be empty for the duration that the action is running.\nwithMVar :: MVar a -> (a -> IO b) -> IO b\nwithMVar m io =\n  mask $ \\restore -> do\n    a <- takeMVar m\n    b <- catchAny (restore (io a))\n            (\\e -> do putMVar m a; throw e)\n    putMVar m a\n    return b\n\n-- | Modify the value of an 'MVar'.\nmodifyMVar_ :: MVar a -> (a -> IO a) -> IO ()\nmodifyMVar_ m io =\n  mask $ \\restore -> do\n    a <- takeMVar m\n    a' <- catchAny (restore (io a))\n            (\\e -> do putMVar m a; throw e)\n    putMVar m a'\n    return ()\n\n-----------------------------------------------------------------------------\n-- Thread waiting\n-----------------------------------------------------------------------------\n\n-- Machinery needed to ensure that we only have one copy of certain\n-- CAFs in this module even when the base package is present twice, as\n-- it is when base is dynamically loaded into GHCi.  The RTS keeps\n-- track of the single true value of the CAF, so even when the CAFs in\n-- the dynamically-loaded base package are reverted, nothing bad\n-- happens.\n--\nsharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a\nsharedCAF a get_or_set =\n   mask_ $ do\n     stable_ref <- newStablePtr a\n     let ref = castPtr (castStablePtrToPtr stable_ref)\n     ref2 <- get_or_set ref\n     if ref==ref2\n        then return a\n        else do freeStablePtr stable_ref\n                deRefStablePtr (castPtrToStablePtr (castPtr ref2))\n\nreportStackOverflow :: IO ()\nreportStackOverflow = do\n     ThreadId tid <- myThreadId\n     c_reportStackOverflow tid\n\nreportError :: SomeException -> IO ()\nreportError ex = do\n   handler <- getUncaughtExceptionHandler\n   handler ex\n\n-- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove\n-- the unsafe below.\nforeign import ccall unsafe \"reportStackOverflow\"\n        c_reportStackOverflow :: ThreadId# -> IO ()\n\nforeign import ccall unsafe \"reportHeapOverflow\"\n        reportHeapOverflow :: IO ()\n\n{-# NOINLINE uncaughtExceptionHandler #-}\nuncaughtExceptionHandler :: IORef (SomeException -> IO ())\nuncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler)\n   where\n      defaultHandler :: SomeException -> IO ()\n      defaultHandler se@(SomeException ex) = do\n         (hFlush stdout) `catchAny` (\\ _ -> return ())\n         let msg = case cast ex of\n               Just Deadlock -> \"no threads to run:  infinite loop or deadlock?\"\n               _                  -> showsPrec 0 se \"\"\n         withCString \"%s\" $ \\cfmt ->\n          withCString msg $ \\cmsg ->\n            errorBelch cfmt cmsg\n\n-- don't use errorBelch() directly, because we cannot call varargs functions\n-- using the FFI.\nforeign import ccall unsafe \"HsBase.h errorBelch2\"\n   errorBelch :: CString -> CString -> IO ()\n\nsetUncaughtExceptionHandler :: (SomeException -> IO ()) -> IO ()\nsetUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler\n\ngetUncaughtExceptionHandler :: IO (SomeException -> IO ())\ngetUncaughtExceptionHandler = readIORef uncaughtExceptionHandler\n", "num_lines": 922}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_GHC -Wno-missing-signatures #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Conc.Windows\n-- Copyright   :  (c) The University of Glasgow, 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Windows I/O manager\n--\n-----------------------------------------------------------------------------\n\n-- #not-home\nmodule GHC.Conc.Windows\n       ( ensureIOManagerIsRunning\n\n       -- * Waiting\n       , threadDelay\n       , registerDelay\n\n       -- * Miscellaneous\n       , asyncRead\n       , asyncWrite\n       , asyncDoProc\n\n       , asyncReadBA\n       , asyncWriteBA\n\n       , ConsoleEvent(..)\n       , win32ConsoleHandler\n       , toWin32ConsoleEvent\n       ) where\n\nimport Data.Bits (shiftR)\nimport GHC.Base\nimport GHC.Conc.Sync\nimport GHC.Enum (Enum)\nimport GHC.IO (unsafePerformIO)\nimport GHC.IORef\nimport GHC.MVar\nimport GHC.Num (Num(..))\nimport GHC.Ptr\nimport GHC.Read (Read)\nimport GHC.Real (div, fromIntegral)\nimport GHC.Show (Show)\nimport GHC.Word (Word32, Word64)\nimport GHC.Windows\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\n-- ----------------------------------------------------------------------------\n-- Thread waiting\n\n-- Note: threadWaitRead and threadWaitWrite aren't really functional\n-- on Win32, but left in there because lib code (still) uses them (the manner\n-- in which they're used doesn't cause problems on a Win32 platform though.)\n\nasyncRead :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)\nasyncRead  (I# fd) (I# isSock) (I# len) (Ptr buf) =\n  IO $ \\s -> case asyncRead# fd isSock len buf s of\n               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)\n\nasyncWrite :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)\nasyncWrite  (I# fd) (I# isSock) (I# len) (Ptr buf) =\n  IO $ \\s -> case asyncWrite# fd isSock len buf s of\n               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)\n\nasyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int\nasyncDoProc (FunPtr proc) (Ptr param) =\n    -- the 'length' value is ignored; simplifies implementation of\n    -- the async*# primops to have them all return the same result.\n  IO $ \\s -> case asyncDoProc# proc param s  of\n               (# s', _len#, err# #) -> (# s', I# err# #)\n\n-- to aid the use of these primops by the IO Handle implementation,\n-- provide the following convenience funs:\n\n-- this better be a pinned byte array!\nasyncReadBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)\nasyncReadBA fd isSock len off bufB =\n  asyncRead fd isSock len ((Ptr (byteArrayContents# (unsafeCoerce# bufB))) `plusPtr` off)\n\nasyncWriteBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)\nasyncWriteBA fd isSock len off bufB =\n  asyncWrite fd isSock len ((Ptr (byteArrayContents# (unsafeCoerce# bufB))) `plusPtr` off)\n\n-- ----------------------------------------------------------------------------\n-- Threaded RTS implementation of threadDelay\n\n-- | Suspends the current thread for a given number of microseconds\n-- (GHC only).\n--\n-- There is no guarantee that the thread will be rescheduled promptly\n-- when the delay has expired, but the thread will never continue to\n-- run /earlier/ than specified.\n--\nthreadDelay :: Int -> IO ()\nthreadDelay time\n  | threaded  = waitForDelayEvent time\n  | otherwise = IO $ \\s ->\n        case time of { I# time# ->\n        case delay# time# s of { s' -> (# s', () #)\n        }}\n\n-- | Set the value of returned TVar to True after a given number of\n-- microseconds. The caveats associated with threadDelay also apply.\n--\nregisterDelay :: Int -> IO (TVar Bool)\nregisterDelay usecs\n  | threaded = waitForDelayEventSTM usecs\n  | otherwise = errorWithoutStackTrace \"registerDelay: requires -threaded\"\n\nforeign import ccall unsafe \"rtsSupportsBoundThreads\" threaded :: Bool\n\nwaitForDelayEvent :: Int -> IO ()\nwaitForDelayEvent usecs = do\n  m <- newEmptyMVar\n  target <- calculateTarget usecs\n  _ <- atomicModifyIORef'_ pendingDelays (\\xs -> Delay target m : xs)\n  prodServiceThread\n  takeMVar m\n\n-- Delays for use in STM\nwaitForDelayEventSTM :: Int -> IO (TVar Bool)\nwaitForDelayEventSTM usecs = do\n   t <- atomically $ newTVar False\n   target <- calculateTarget usecs\n   _ <- atomicModifyIORef'_ pendingDelays (\\xs -> DelaySTM target t : xs)\n   prodServiceThread\n   return t\n\ncalculateTarget :: Int -> IO USecs\ncalculateTarget usecs = do\n    now <- getMonotonicUSec\n    return $ now + (fromIntegral usecs)\n\ndata DelayReq\n  = Delay    {-# UNPACK #-} !USecs {-# UNPACK #-} !(MVar ())\n  | DelaySTM {-# UNPACK #-} !USecs {-# UNPACK #-} !(TVar Bool)\n\n{-# NOINLINE pendingDelays #-}\npendingDelays :: IORef [DelayReq]\npendingDelays = unsafePerformIO $ do\n   m <- newIORef []\n   sharedCAF m getOrSetGHCConcWindowsPendingDelaysStore\n\nforeign import ccall unsafe \"getOrSetGHCConcWindowsPendingDelaysStore\"\n    getOrSetGHCConcWindowsPendingDelaysStore :: Ptr a -> IO (Ptr a)\n\n{-# NOINLINE ioManagerThread #-}\nioManagerThread :: MVar (Maybe ThreadId)\nioManagerThread = unsafePerformIO $ do\n   m <- newMVar Nothing\n   sharedCAF m getOrSetGHCConcWindowsIOManagerThreadStore\n\nforeign import ccall unsafe \"getOrSetGHCConcWindowsIOManagerThreadStore\"\n    getOrSetGHCConcWindowsIOManagerThreadStore :: Ptr a -> IO (Ptr a)\n\nensureIOManagerIsRunning :: IO ()\nensureIOManagerIsRunning\n  | threaded  = startIOManagerThread\n  | otherwise = return ()\n\nstartIOManagerThread :: IO ()\nstartIOManagerThread = do\n  modifyMVar_ ioManagerThread $ \\old -> do\n    let create = do t <- forkIO ioManager; return (Just t)\n    case old of\n      Nothing -> create\n      Just t  -> do\n        s <- threadStatus t\n        case s of\n          ThreadFinished -> create\n          ThreadDied     -> create\n          _other         -> return (Just t)\n\ninsertDelay :: DelayReq -> [DelayReq] -> [DelayReq]\ninsertDelay d [] = [d]\ninsertDelay d1 ds@(d2 : rest)\n  | delayTime d1 <= delayTime d2 = d1 : ds\n  | otherwise                    = d2 : insertDelay d1 rest\n\ndelayTime :: DelayReq -> USecs\ndelayTime (Delay t _) = t\ndelayTime (DelaySTM t _) = t\n\ntype USecs = Word64\ntype NSecs = Word64\n\nforeign import ccall unsafe \"getMonotonicNSec\"\n  getMonotonicNSec :: IO NSecs\n\ngetMonotonicUSec :: IO USecs\ngetMonotonicUSec = fmap (`div` 1000) getMonotonicNSec\n\n{-# NOINLINE prodding #-}\nprodding :: IORef Bool\nprodding = unsafePerformIO $ do\n   r <- newIORef False\n   sharedCAF r getOrSetGHCConcWindowsProddingStore\n\nforeign import ccall unsafe \"getOrSetGHCConcWindowsProddingStore\"\n    getOrSetGHCConcWindowsProddingStore :: Ptr a -> IO (Ptr a)\n\nprodServiceThread :: IO ()\nprodServiceThread = do\n  -- NB. use atomicSwapIORef here, otherwise there are race\n  -- conditions in which prodding is left at True but the server is\n  -- blocked in select().\n  was_set <- atomicSwapIORef prodding True\n  when (not was_set) wakeupIOManager\n\n-- ----------------------------------------------------------------------------\n-- Windows IO manager thread\n\nioManager :: IO ()\nioManager = do\n  wakeup <- c_getIOManagerEvent\n  service_loop wakeup []\n\nservice_loop :: HANDLE          -- read end of pipe\n             -> [DelayReq]      -- current delay requests\n             -> IO ()\n\nservice_loop wakeup old_delays = do\n  -- pick up new delay requests\n  new_delays <- atomicSwapIORef pendingDelays []\n  let  delays = foldr insertDelay old_delays new_delays\n\n  now <- getMonotonicUSec\n  (delays', timeout) <- getDelay now delays\n\n  r <- c_WaitForSingleObject wakeup timeout\n  case r of\n    0xffffffff -> do throwGetLastError \"service_loop\"\n    0 -> do\n        r2 <- c_readIOManagerEvent\n        exit <-\n              case r2 of\n                _ | r2 == io_MANAGER_WAKEUP -> return False\n                _ | r2 == io_MANAGER_DIE    -> return True\n                0 -> return False -- spurious wakeup\n                _ -> do start_console_handler (r2 `shiftR` 1); return False\n        when (not exit) $ service_cont wakeup delays'\n\n    _other -> service_cont wakeup delays' -- probably timeout\n\nservice_cont :: HANDLE -> [DelayReq] -> IO ()\nservice_cont wakeup delays = do\n  _ <- atomicSwapIORef prodding False\n  service_loop wakeup delays\n\n-- must agree with rts/win32/ThrIOManager.c\nio_MANAGER_WAKEUP, io_MANAGER_DIE :: Word32\nio_MANAGER_WAKEUP = 0xffffffff\nio_MANAGER_DIE    = 0xfffffffe\n\ndata ConsoleEvent\n = ControlC\n | Break\n | Close\n    -- these are sent to Services only.\n | Logoff\n | Shutdown\n deriving ( Eq   -- ^ @since 4.3.0.0\n          , Ord  -- ^ @since 4.3.0.0\n          , Enum -- ^ @since 4.3.0.0\n          , Show -- ^ @since 4.3.0.0\n          , Read -- ^ @since 4.3.0.0\n          )\n\nstart_console_handler :: Word32 -> IO ()\nstart_console_handler r =\n  case toWin32ConsoleEvent r of\n     Just x  -> withMVar win32ConsoleHandler $ \\handler -> do\n                    _ <- forkIO (handler x)\n                    return ()\n     Nothing -> return ()\n\ntoWin32ConsoleEvent :: (Eq a, Num a) => a -> Maybe ConsoleEvent\ntoWin32ConsoleEvent ev =\n   case ev of\n       0 {- CTRL_C_EVENT-}        -> Just ControlC\n       1 {- CTRL_BREAK_EVENT-}    -> Just Break\n       2 {- CTRL_CLOSE_EVENT-}    -> Just Close\n       5 {- CTRL_LOGOFF_EVENT-}   -> Just Logoff\n       6 {- CTRL_SHUTDOWN_EVENT-} -> Just Shutdown\n       _ -> Nothing\n\nwin32ConsoleHandler :: MVar (ConsoleEvent -> IO ())\nwin32ConsoleHandler = unsafePerformIO (newMVar (errorWithoutStackTrace \"win32ConsoleHandler\"))\n\nwakeupIOManager :: IO ()\nwakeupIOManager = c_sendIOManagerEvent io_MANAGER_WAKEUP\n\n-- Walk the queue of pending delays, waking up any that have passed\n-- and return the smallest delay to wait for.  The queue of pending\n-- delays is kept ordered.\ngetDelay :: USecs -> [DelayReq] -> IO ([DelayReq], DWORD)\ngetDelay _   [] = return ([], iNFINITE)\ngetDelay now all@(d : rest)\n  = case d of\n     Delay time m | now >= time -> do\n        putMVar m ()\n        getDelay now rest\n     DelaySTM time t | now >= time -> do\n        atomically $ writeTVar t True\n        getDelay now rest\n     _otherwise ->\n        -- delay is in millisecs for WaitForSingleObject\n        let micro_seconds = delayTime d - now\n            milli_seconds = (micro_seconds + 999) `div` 1000\n        in return (all, fromIntegral milli_seconds)\n\nforeign import ccall unsafe \"getIOManagerEvent\" -- in the RTS (ThrIOManager.c)\n  c_getIOManagerEvent :: IO HANDLE\n\nforeign import ccall unsafe \"readIOManagerEvent\" -- in the RTS (ThrIOManager.c)\n  c_readIOManagerEvent :: IO Word32\n\nforeign import ccall unsafe \"sendIOManagerEvent\" -- in the RTS (ThrIOManager.c)\n  c_sendIOManagerEvent :: Word32 -> IO ()\n\nforeign import WINDOWS_CCONV \"WaitForSingleObject\"\n   c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD\n\n", "num_lines": 342}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples #-}\n\nmodule GHC.Event.Arr\n    (\n      Arr(..)\n    , new\n    , size\n    , read\n    , write\n    ) where\n\nimport GHC.Base (($))\nimport GHC.Prim (MutableArray#, RealWorld, newArray#, readArray#,\n                 sizeofMutableArray#, writeArray#)\nimport GHC.Types (IO(..), Int(..))\n\ndata Arr a = Arr (MutableArray# RealWorld a)\n\nnew :: a -> Int -> IO (Arr a)\nnew defval (I# n#) = IO $ \\s0# ->\n  case newArray# n# defval s0# of (# s1#, marr# #) -> (# s1#, Arr marr# #)\n\nsize :: Arr a -> Int\nsize (Arr a) = I# (sizeofMutableArray# a)\n\nread :: Arr a -> Int -> IO a\nread (Arr a) (I# n#) = IO $ \\s0# ->\n  case readArray# a n# s0# of (# s1#, val #) -> (# s1#, val #)\n\nwrite :: Arr a -> Int -> a -> IO ()\nwrite (Arr a) (I# n#) val = IO $ \\s0# ->\n  case writeArray# a n# val s0# of s1# -> (# s1#, () #)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE BangPatterns, CPP, NoImplicitPrelude #-}\n\nmodule GHC.Event.Array\n    (\n      Array\n    , capacity\n    , clear\n    , concat\n    , copy\n    , duplicate\n    , empty\n    , ensureCapacity\n    , findIndex\n    , forM_\n    , length\n    , loop\n    , new\n    , removeAt\n    , snoc\n    , unsafeLoad\n    , unsafeRead\n    , unsafeWrite\n    , useAsPtr\n    ) where\n\nimport Data.Bits ((.|.), shiftR)\nimport Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)\nimport Data.Maybe\nimport Foreign.C.Types (CSize(..))\nimport Foreign.ForeignPtr (ForeignPtr, withForeignPtr)\nimport Foreign.Ptr (Ptr, nullPtr, plusPtr)\nimport Foreign.Storable (Storable(..))\nimport GHC.Base hiding (empty)\nimport GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)\nimport GHC.Num (Num(..))\nimport GHC.Real (fromIntegral)\nimport GHC.Show (show)\n\n#include \"MachDeps.h\"\n\n#define BOUNDS_CHECKING 1\n\n#if defined(BOUNDS_CHECKING)\n-- This fugly hack is brought by GHC's apparent reluctance to deal\n-- with MagicHash and UnboxedTuples when inferring types. Eek!\n#define CHECK_BOUNDS(_func_,_len_,_k_) \\\nif (_k_) < 0 || (_k_) >= (_len_) then errorWithoutStackTrace (\"GHC.Event.Array.\" ++ (_func_) ++ \": bounds error, index \" ++ show (_k_) ++ \", capacity \" ++ show (_len_)) else\n#else\n#define CHECK_BOUNDS(_func_,_len_,_k_)\n#endif\n\n-- Invariant: size <= capacity\nnewtype Array a = Array (IORef (AC a))\n\n-- The actual array content.\ndata AC a = AC\n    !(ForeignPtr a)  -- Elements\n    !Int      -- Number of elements (length)\n    !Int      -- Maximum number of elements (capacity)\n\nempty :: IO (Array a)\nempty = do\n  p <- newForeignPtr_ nullPtr\n  Array `fmap` newIORef (AC p 0 0)\n\nallocArray :: Storable a => Int -> IO (ForeignPtr a)\nallocArray n = allocHack undefined\n where\n  allocHack :: Storable a => a -> IO (ForeignPtr a)\n  allocHack dummy = mallocPlainForeignPtrBytes (n * sizeOf dummy)\n\nreallocArray :: Storable a => ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)\nreallocArray p newSize oldSize = reallocHack undefined p\n where\n  reallocHack :: Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)\n  reallocHack dummy src = do\n      let size = sizeOf dummy\n      dst <- mallocPlainForeignPtrBytes (newSize * size)\n      withForeignPtr src $ \\s ->\n        when (s /= nullPtr && oldSize > 0) .\n          withForeignPtr dst $ \\d -> do\n            _ <- memcpy d s (fromIntegral (oldSize * size))\n            return ()\n      return dst\n\nnew :: Storable a => Int -> IO (Array a)\nnew c = do\n    es <- allocArray cap\n    fmap Array (newIORef (AC es 0 cap))\n  where\n    cap = firstPowerOf2 c\n\nduplicate :: Storable a => Array a -> IO (Array a)\nduplicate a = dupHack undefined a\n where\n  dupHack :: Storable b => b -> Array b -> IO (Array b)\n  dupHack dummy (Array ref) = do\n    AC es len cap <- readIORef ref\n    ary <- allocArray cap\n    withForeignPtr ary $ \\dest ->\n      withForeignPtr es $ \\src -> do\n        _ <- memcpy dest src (fromIntegral (len * sizeOf dummy))\n        return ()\n    Array `fmap` newIORef (AC ary len cap)\n\nlength :: Array a -> IO Int\nlength (Array ref) = do\n    AC _ len _ <- readIORef ref\n    return len\n\ncapacity :: Array a -> IO Int\ncapacity (Array ref) = do\n    AC _ _ cap <- readIORef ref\n    return cap\n\nunsafeRead :: Storable a => Array a -> Int -> IO a\nunsafeRead (Array ref) ix = do\n    AC es _ cap <- readIORef ref\n    CHECK_BOUNDS(\"unsafeRead\",cap,ix)\n      withForeignPtr es $ \\p ->\n        peekElemOff p ix\n\nunsafeWrite :: Storable a => Array a -> Int -> a -> IO ()\nunsafeWrite (Array ref) ix a = do\n    ac <- readIORef ref\n    unsafeWrite' ac ix a\n\nunsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()\nunsafeWrite' (AC es _ cap) ix a = do\n    CHECK_BOUNDS(\"unsafeWrite'\",cap,ix)\n      withForeignPtr es $ \\p ->\n        pokeElemOff p ix a\n\nunsafeLoad :: Array a -> (Ptr a -> Int -> IO Int) -> IO Int\nunsafeLoad (Array ref) load = do\n    AC es _ cap <- readIORef ref\n    len' <- withForeignPtr es $ \\p -> load p cap\n    writeIORef ref (AC es len' cap)\n    return len'\n\nensureCapacity :: Storable a => Array a -> Int -> IO ()\nensureCapacity (Array ref) c = do\n    ac@(AC _ _ cap) <- readIORef ref\n    ac'@(AC _ _ cap') <- ensureCapacity' ac c\n    when (cap' /= cap) $\n      writeIORef ref ac'\n\nensureCapacity' :: Storable a => AC a -> Int -> IO (AC a)\nensureCapacity' ac@(AC es len cap) c = do\n    if c > cap\n      then do\n        es' <- reallocArray es cap' cap\n        return (AC es' len cap')\n      else\n        return ac\n  where\n    cap' = firstPowerOf2 c\n\nuseAsPtr :: Array a -> (Ptr a -> Int -> IO b) -> IO b\nuseAsPtr (Array ref) f = do\n    AC es len _ <- readIORef ref\n    withForeignPtr es $ \\p -> f p len\n\nsnoc :: Storable a => Array a -> a -> IO ()\nsnoc (Array ref) e = do\n    ac@(AC _ len _) <- readIORef ref\n    let len' = len + 1\n    ac'@(AC es _ cap) <- ensureCapacity' ac len'\n    unsafeWrite' ac' len e\n    writeIORef ref (AC es len' cap)\n\nclear :: Array a -> IO ()\nclear (Array ref) = do\n  atomicModifyIORef' ref $ \\(AC es _ cap) ->\n        (AC es 0 cap, ())\n\nforM_ :: Storable a => Array a -> (a -> IO ()) -> IO ()\nforM_ ary g = forHack ary g undefined\n  where\n    forHack :: Storable b => Array b -> (b -> IO ()) -> b -> IO ()\n    forHack (Array ref) f dummy = do\n      AC es len _ <- readIORef ref\n      let size = sizeOf dummy\n          offset = len * size\n      withForeignPtr es $ \\p -> do\n        let go n | n >= offset = return ()\n                 | otherwise = do\n              f =<< peek (p `plusPtr` n)\n              go (n + size)\n        go 0\n\nloop :: Storable a => Array a -> b -> (b -> a -> IO (b,Bool)) -> IO ()\nloop ary z g = loopHack ary z g undefined\n  where\n    loopHack :: Storable b => Array b -> c -> (c -> b -> IO (c,Bool)) -> b\n             -> IO ()\n    loopHack (Array ref) y f dummy = do\n      AC es len _ <- readIORef ref\n      let size = sizeOf dummy\n          offset = len * size\n      withForeignPtr es $ \\p -> do\n        let go n k\n                | n >= offset = return ()\n                | otherwise = do\n                      (k',cont) <- f k =<< peek (p `plusPtr` n)\n                      when cont $ go (n + size) k'\n        go 0 y\n\nfindIndex :: Storable a => (a -> Bool) -> Array a -> IO (Maybe (Int,a))\nfindIndex = findHack undefined\n where\n  findHack :: Storable b => b -> (b -> Bool) -> Array b -> IO (Maybe (Int,b))\n  findHack dummy p (Array ref) = do\n    AC es len _ <- readIORef ref\n    let size   = sizeOf dummy\n        offset = len * size\n    withForeignPtr es $ \\ptr ->\n      let go !n !i\n            | n >= offset = return Nothing\n            | otherwise = do\n                val <- peek (ptr `plusPtr` n)\n                if p val\n                  then return $ Just (i, val)\n                  else go (n + size) (i + 1)\n      in  go 0 0\n\nconcat :: Storable a => Array a -> Array a -> IO ()\nconcat (Array d) (Array s) = do\n  da@(AC _ dlen _) <- readIORef d\n  sa@(AC _ slen _) <- readIORef s\n  writeIORef d =<< copy' da dlen sa 0 slen\n\n-- | Copy part of the source array into the destination array. The\n-- destination array is resized if not large enough.\ncopy :: Storable a => Array a -> Int -> Array a -> Int -> Int -> IO ()\ncopy (Array d) dstart (Array s) sstart maxCount = do\n  da <- readIORef d\n  sa <- readIORef s\n  writeIORef d =<< copy' da dstart sa sstart maxCount\n\n-- | Copy part of the source array into the destination array. The\n-- destination array is resized if not large enough.\ncopy' :: Storable a => AC a -> Int -> AC a -> Int -> Int -> IO (AC a)\ncopy' d dstart s sstart maxCount = copyHack d s undefined\n where\n  copyHack :: Storable b => AC b -> AC b -> b -> IO (AC b)\n  copyHack dac@(AC _ oldLen _) (AC src slen _) dummy = do\n    when (maxCount < 0 || dstart < 0 || dstart > oldLen || sstart < 0 ||\n          sstart > slen) $ errorWithoutStackTrace \"copy: bad offsets or lengths\"\n    let size = sizeOf dummy\n        count = min maxCount (slen - sstart)\n    if count == 0\n      then return dac\n      else do\n        AC dst dlen dcap <- ensureCapacity' dac (dstart + count)\n        withForeignPtr dst $ \\dptr ->\n          withForeignPtr src $ \\sptr -> do\n            _ <- memcpy (dptr `plusPtr` (dstart * size))\n                        (sptr `plusPtr` (sstart * size))\n                        (fromIntegral (count * size))\n            return $ AC dst (max dlen (dstart + count)) dcap\n\nremoveAt :: Storable a => Array a -> Int -> IO ()\nremoveAt a i = removeHack a undefined\n where\n  removeHack :: Storable b => Array b -> b -> IO ()\n  removeHack (Array ary) dummy = do\n    AC fp oldLen cap <- readIORef ary\n    when (i < 0 || i >= oldLen) $ errorWithoutStackTrace \"removeAt: invalid index\"\n    let size   = sizeOf dummy\n        newLen = oldLen - 1\n    when (newLen > 0 && i < newLen) .\n      withForeignPtr fp $ \\ptr -> do\n        _ <- memmove (ptr `plusPtr` (size * i))\n                     (ptr `plusPtr` (size * (i+1)))\n                     (fromIntegral (size * (newLen-i)))\n        return ()\n    writeIORef ary (AC fp newLen cap)\n\n{-The firstPowerOf2 function works by setting all bits on the right-hand\nside of the most significant flagged bit to 1, and then incrementing\nthe entire value at the end so it \"rolls over\" to the nearest power of\ntwo.\n-}\n\n-- | Computes the next-highest power of two for a particular integer,\n-- @n@.  If @n@ is already a power of two, returns @n@.  If @n@ is\n-- zero, returns zero, even though zero is not a power of two.\nfirstPowerOf2 :: Int -> Int\nfirstPowerOf2 !n =\n    let !n1 = n - 1\n        !n2 = n1 .|. (n1 `shiftR` 1)\n        !n3 = n2 .|. (n2 `shiftR` 2)\n        !n4 = n3 .|. (n3 `shiftR` 4)\n        !n5 = n4 .|. (n4 `shiftR` 8)\n        !n6 = n5 .|. (n5 `shiftR` 16)\n#if WORD_SIZE_IN_BITS == 32\n    in n6 + 1\n#elif WORD_SIZE_IN_BITS == 64\n        !n7 = n6 .|. (n6 `shiftR` 32)\n    in n7 + 1\n#else\n# error firstPowerOf2 not defined on this architecture\n#endif\n\nforeign import ccall unsafe \"string.h memcpy\"\n    memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)\n\nforeign import ccall unsafe \"string.h memmove\"\n    memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)\n\n", "num_lines": 313}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , ScopedTypeVariables\n           , BangPatterns\n  #-}\n\nmodule GHC.Event.Control\n    (\n    -- * Managing the IO manager\n      Signal\n    , ControlMessage(..)\n    , Control\n    , newControl\n    , closeControl\n    -- ** Control message reception\n    , readControlMessage\n    -- *** File descriptors\n    , controlReadFd\n    , controlWriteFd\n    , wakeupReadFd\n    -- ** Control message sending\n    , sendWakeup\n    , sendDie\n    -- * Utilities\n    , setNonBlockingFD\n    ) where\n\n#include \"EventConfig.h\"\n\nimport Foreign.ForeignPtr (ForeignPtr)\nimport GHC.Base\nimport GHC.IORef\nimport GHC.Conc.Signal (Signal)\nimport GHC.Real (fromIntegral)\nimport GHC.Show (Show)\nimport GHC.Word (Word8)\nimport Foreign.C.Error (throwErrnoIfMinus1_, throwErrno, getErrno)\nimport Foreign.C.Types (CInt(..), CSize(..))\nimport Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr)\nimport Foreign.Marshal (alloca, allocaBytes)\nimport Foreign.Marshal.Array (allocaArray)\nimport Foreign.Ptr (castPtr)\nimport Foreign.Storable (peek, peekElemOff, poke)\nimport System.Posix.Internals (c_close, c_pipe, c_read, c_write,\n                               setCloseOnExec, setNonBlockingFD)\nimport System.Posix.Types (Fd)\n\n#if defined(HAVE_EVENTFD)\nimport Foreign.C.Error (throwErrnoIfMinus1, eBADF)\nimport Foreign.C.Types (CULLong(..))\n#else\nimport Foreign.C.Error (eAGAIN, eWOULDBLOCK)\n#endif\n\ndata ControlMessage = CMsgWakeup\n                    | CMsgDie\n                    | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)\n                                 {-# UNPACK #-} !Signal\n    deriving ( Eq   -- ^ @since 4.4.0.0\n             , Show -- ^ @since 4.4.0.0\n             )\n\n-- | The structure used to tell the IO manager thread what to do.\ndata Control = W {\n      controlReadFd  :: {-# UNPACK #-} !Fd\n    , controlWriteFd :: {-# UNPACK #-} !Fd\n#if defined(HAVE_EVENTFD)\n    , controlEventFd :: {-# UNPACK #-} !Fd\n#else\n    , wakeupReadFd   :: {-# UNPACK #-} !Fd\n    , wakeupWriteFd  :: {-# UNPACK #-} !Fd\n#endif\n    , didRegisterWakeupFd :: !Bool\n      -- | Have this Control's fds been cleaned up?\n    , controlIsDead  :: !(IORef Bool)\n    }\n\n#if defined(HAVE_EVENTFD)\nwakeupReadFd :: Control -> Fd\nwakeupReadFd = controlEventFd\n{-# INLINE wakeupReadFd #-}\n#endif\n\n-- | Create the structure (usually a pipe) used for waking up the IO\n-- manager thread from another thread.\nnewControl :: Bool -> IO Control\nnewControl shouldRegister = allocaArray 2 $ \\fds -> do\n  let createPipe = do\n        throwErrnoIfMinus1_ \"pipe\" $ c_pipe fds\n        rd <- peekElemOff fds 0\n        wr <- peekElemOff fds 1\n        -- The write end must be non-blocking, since we may need to\n        -- poke the event manager from a signal handler.\n        setNonBlockingFD wr True\n        setCloseOnExec rd\n        setCloseOnExec wr\n        return (rd, wr)\n  (ctrl_rd, ctrl_wr) <- createPipe\n#if defined(HAVE_EVENTFD)\n  ev <- throwErrnoIfMinus1 \"eventfd\" $ c_eventfd 0 0\n  setNonBlockingFD ev True\n  setCloseOnExec ev\n  when shouldRegister $ c_setIOManagerWakeupFd ev\n#else\n  (wake_rd, wake_wr) <- createPipe\n  when shouldRegister $ c_setIOManagerWakeupFd wake_wr\n#endif\n  isDead <- newIORef False\n  return W { controlReadFd  = fromIntegral ctrl_rd\n           , controlWriteFd = fromIntegral ctrl_wr\n#if defined(HAVE_EVENTFD)\n           , controlEventFd = fromIntegral ev\n#else\n           , wakeupReadFd   = fromIntegral wake_rd\n           , wakeupWriteFd  = fromIntegral wake_wr\n#endif\n           , didRegisterWakeupFd = shouldRegister\n           , controlIsDead  = isDead\n           }\n\n-- | Close the control structure used by the IO manager thread.\n-- N.B. If this Control is the Control whose wakeup file was registered with\n-- the RTS, then *BEFORE* the wakeup file is closed, we must call\n-- c_setIOManagerWakeupFd (-1), so that the RTS does not try to use the wakeup\n-- file after it has been closed.\ncloseControl :: Control -> IO ()\ncloseControl w = do\n  _ <- atomicSwapIORef (controlIsDead w) True\n  _ <- c_close . fromIntegral . controlReadFd $ w\n  _ <- c_close . fromIntegral . controlWriteFd $ w\n  when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1)\n#if defined(HAVE_EVENTFD)\n  _ <- c_close . fromIntegral . controlEventFd $ w\n#else\n  _ <- c_close . fromIntegral . wakeupReadFd $ w\n  _ <- c_close . fromIntegral . wakeupWriteFd $ w\n#endif\n  return ()\n\nio_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8\nio_MANAGER_WAKEUP = 0xff\nio_MANAGER_DIE    = 0xfe\n\nforeign import ccall \"__hscore_sizeof_siginfo_t\"\n    sizeof_siginfo_t :: CSize\n\nreadControlMessage :: Control -> Fd -> IO ControlMessage\nreadControlMessage ctrl fd\n    | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \\p -> do\n                    throwErrnoIfMinus1_ \"readWakeupMessage\" $\n                      c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize)\n                    return CMsgWakeup\n    | otherwise =\n        alloca $ \\p -> do\n            throwErrnoIfMinus1_ \"readControlMessage\" $\n                c_read (fromIntegral fd) p 1\n            s <- peek p\n            case s of\n                -- Wakeup messages shouldn't be sent on the control\n                -- file descriptor but we handle them anyway.\n                _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup\n                _ | s == io_MANAGER_DIE    -> return CMsgDie\n                _ -> do  -- Signal\n                    fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t)\n                    withForeignPtr fp $ \\p_siginfo -> do\n                        r <- c_read (fromIntegral fd) (castPtr p_siginfo)\n                             sizeof_siginfo_t\n                        when (r /= fromIntegral sizeof_siginfo_t) $\n                            errorWithoutStackTrace \"failed to read siginfo_t\"\n                        let !s' = fromIntegral s\n                        return $ CMsgSignal fp s'\n\n  where wakeupBufferSize =\n#if defined(HAVE_EVENTFD)\n            8\n#else\n            4096\n#endif\n\nsendWakeup :: Control -> IO ()\n#if defined(HAVE_EVENTFD)\nsendWakeup c = do\n  n <- c_eventfd_write (fromIntegral (controlEventFd c)) 1\n  case n of\n    0     -> return ()\n    _     -> do errno <- getErrno\n                -- Check that Control is still alive if we failed, since it's\n                -- possible that someone cleaned up the fds behind our backs and\n                -- consequently eventfd_write failed with EBADF. If it is dead\n                -- then just swallow the error since we are shutting down\n                -- anyways. Otherwise we will see failures during shutdown from\n                -- setnumcapabilities001 (#12038)\n                isDead <- readIORef (controlIsDead c)\n                if isDead && errno == eBADF\n                  then return ()\n                  else throwErrno \"sendWakeup\"\n#else\nsendWakeup c = do\n  n <- sendMessage (wakeupWriteFd c) CMsgWakeup\n  case n of\n    _ | n /= -1   -> return ()\n      | otherwise -> do\n                   errno <- getErrno\n                   when (errno /= eAGAIN && errno /= eWOULDBLOCK) $\n                     throwErrno \"sendWakeup\"\n#endif\n\nsendDie :: Control -> IO ()\nsendDie c = throwErrnoIfMinus1_ \"sendDie\" $\n            sendMessage (controlWriteFd c) CMsgDie\n\nsendMessage :: Fd -> ControlMessage -> IO Int\nsendMessage fd msg = alloca $ \\p -> do\n  case msg of\n    CMsgWakeup        -> poke p io_MANAGER_WAKEUP\n    CMsgDie           -> poke p io_MANAGER_DIE\n    CMsgSignal _fp _s -> errorWithoutStackTrace \"Signals can only be sent from within the RTS\"\n  fromIntegral `fmap` c_write (fromIntegral fd) p 1\n\n#if defined(HAVE_EVENTFD)\nforeign import ccall unsafe \"sys/eventfd.h eventfd\"\n   c_eventfd :: CInt -> CInt -> IO CInt\n\nforeign import ccall unsafe \"sys/eventfd.h eventfd_write\"\n   c_eventfd_write :: CInt -> CULLong -> IO CInt\n#endif\n\nforeign import ccall unsafe \"setIOManagerWakeupFd\"\n   c_setIOManagerWakeupFd :: CInt -> IO ()\n", "num_lines": 231}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-}\n\nmodule GHC.Event.Internal\n    (\n    -- * Event back end\n      Backend\n    , backend\n    , delete\n    , poll\n    , modifyFd\n    , modifyFdOnce\n    -- * Event type\n    , Event\n    , evtRead\n    , evtWrite\n    , evtClose\n    , eventIs\n    -- * Lifetimes\n    , Lifetime(..)\n    , EventLifetime\n    , eventLifetime\n    , elLifetime\n    , elEvent\n    -- * Timeout type\n    , Timeout(..)\n    -- * Helpers\n    , throwErrnoIfMinus1NoRetry\n    ) where\n\nimport Data.Bits ((.|.), (.&.))\nimport Data.OldList (foldl', filter, intercalate, null)\nimport Foreign.C.Error (eINTR, getErrno, throwErrno)\nimport System.Posix.Types (Fd)\nimport GHC.Base\nimport GHC.Word (Word64)\nimport GHC.Num (Num(..))\nimport GHC.Show (Show(..))\nimport Data.Semigroup.Internal (stimesMonoid)\n\n-- | An I\\/O event.\nnewtype Event = Event Int\n    deriving Eq -- ^ @since 4.4.0.0\n\nevtNothing :: Event\nevtNothing = Event 0\n{-# INLINE evtNothing #-}\n\n-- | Data is available to be read.\nevtRead :: Event\nevtRead = Event 1\n{-# INLINE evtRead #-}\n\n-- | The file descriptor is ready to accept a write.\nevtWrite :: Event\nevtWrite = Event 2\n{-# INLINE evtWrite #-}\n\n-- | Another thread closed the file descriptor.\nevtClose :: Event\nevtClose = Event 4\n{-# INLINE evtClose #-}\n\neventIs :: Event -> Event -> Bool\neventIs (Event a) (Event b) = a .&. b /= 0\n\n-- | @since 4.4.0.0\ninstance Show Event where\n    show e = '[' : (intercalate \",\" . filter (not . null) $\n                    [evtRead `so` \"evtRead\",\n                     evtWrite `so` \"evtWrite\",\n                     evtClose `so` \"evtClose\"]) ++ \"]\"\n        where ev `so` disp | e `eventIs` ev = disp\n                           | otherwise      = \"\"\n\n-- | @since 4.10.0.0\ninstance Semigroup Event where\n    (<>)    = evtCombine\n    stimes  = stimesMonoid\n\n-- | @since 4.4.0.0\ninstance Monoid Event where\n    mempty  = evtNothing\n    mconcat = evtConcat\n\nevtCombine :: Event -> Event -> Event\nevtCombine (Event a) (Event b) = Event (a .|. b)\n{-# INLINE evtCombine #-}\n\nevtConcat :: [Event] -> Event\nevtConcat = foldl' evtCombine evtNothing\n{-# INLINE evtConcat #-}\n\n-- | The lifetime of an event registration.\n--\n-- @since 4.8.1.0\ndata Lifetime = OneShot   -- ^ the registration will be active for only one\n                          -- event\n              | MultiShot -- ^ the registration will trigger multiple times\n              deriving ( Show -- ^ @since 4.8.1.0\n                       , Eq   -- ^ @since 4.8.1.0\n                       )\n\n-- | The longer of two lifetimes.\nelSupremum :: Lifetime -> Lifetime -> Lifetime\nelSupremum OneShot OneShot = OneShot\nelSupremum _       _       = MultiShot\n{-# INLINE elSupremum #-}\n\n-- | @since 4.10.0.0\ninstance Semigroup Lifetime where\n    (<>) = elSupremum\n    stimes = stimesMonoid\n\n-- | @mappend@ takes the longer of two lifetimes.\n--\n-- @since 4.8.0.0\ninstance Monoid Lifetime where\n    mempty = OneShot\n\n-- | A pair of an event and lifetime\n--\n-- Here we encode the event in the bottom three bits and the lifetime\n-- in the fourth bit.\nnewtype EventLifetime = EL Int\n                      deriving ( Show -- ^ @since 4.8.0.0\n                               , Eq   -- ^ @since 4.8.0.0\n                               )\n\n-- | @since 4.11.0.0\ninstance Semigroup EventLifetime where\n    EL a <> EL b = EL (a .|. b)\n\n-- | @since 4.8.0.0\ninstance Monoid EventLifetime where\n    mempty = EL 0\n\neventLifetime :: Event -> Lifetime -> EventLifetime\neventLifetime (Event e) l = EL (e .|. lifetimeBit l)\n  where\n    lifetimeBit OneShot   = 0\n    lifetimeBit MultiShot = 8\n{-# INLINE eventLifetime #-}\n\nelLifetime :: EventLifetime -> Lifetime\nelLifetime (EL x) = if x .&. 8 == 0 then OneShot else MultiShot\n{-# INLINE elLifetime #-}\n\nelEvent :: EventLifetime -> Event\nelEvent (EL x) = Event (x .&. 0x7)\n{-# INLINE elEvent #-}\n\n-- | A type alias for timeouts, specified in nanoseconds.\ndata Timeout = Timeout {-# UNPACK #-} !Word64\n             | Forever\n               deriving Show -- ^ @since 4.4.0.0\n\n-- | Event notification backend.\ndata Backend = forall a. Backend {\n      _beState :: !a\n\n    -- | Poll backend for new events.  The provided callback is called\n    -- once per file descriptor with new events.\n    , _bePoll :: a                          -- backend state\n              -> Maybe Timeout              -- timeout in milliseconds ('Nothing' for non-blocking poll)\n              -> (Fd -> Event -> IO ())     -- I/O callback\n              -> IO Int\n\n    -- | Register, modify, or unregister interest in the given events\n    -- on the given file descriptor.\n    , _beModifyFd :: a\n                  -> Fd       -- file descriptor\n                  -> Event    -- old events to watch for ('mempty' for new)\n                  -> Event    -- new events to watch for ('mempty' to delete)\n                  -> IO Bool\n\n    -- | Register interest in new events on a given file descriptor, set\n    -- to be deactivated after the first event.\n    , _beModifyFdOnce :: a\n                         -> Fd    -- file descriptor\n                         -> Event -- new events to watch\n                         -> IO Bool\n\n    , _beDelete :: a -> IO ()\n    }\n\nbackend :: (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)\n        -> (a -> Fd -> Event -> Event -> IO Bool)\n        -> (a -> Fd -> Event -> IO Bool)\n        -> (a -> IO ())\n        -> a\n        -> Backend\nbackend bPoll bModifyFd bModifyFdOnce bDelete state =\n  Backend state bPoll bModifyFd bModifyFdOnce bDelete\n{-# INLINE backend #-}\n\npoll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int\npoll (Backend bState bPoll _ _ _) = bPoll bState\n{-# INLINE poll #-}\n\n-- | Returns 'True' if the modification succeeded.\n-- Returns 'False' if this backend does not support\n-- event notifications on this type of file.\nmodifyFd :: Backend -> Fd -> Event -> Event -> IO Bool\nmodifyFd (Backend bState _ bModifyFd _ _) = bModifyFd bState\n{-# INLINE modifyFd #-}\n\n-- | Returns 'True' if the modification succeeded.\n-- Returns 'False' if this backend does not support\n-- event notifications on this type of file.\nmodifyFdOnce :: Backend -> Fd -> Event -> IO Bool\nmodifyFdOnce (Backend bState _ _ bModifyFdOnce _) = bModifyFdOnce bState\n{-# INLINE modifyFdOnce #-}\n\ndelete :: Backend -> IO ()\ndelete (Backend bState _ _ _ bDelete) = bDelete bState\n{-# INLINE delete #-}\n\n-- | Throw an 'Prelude.IOError' corresponding to the current value of\n-- 'getErrno' if the result value of the 'IO' action is -1 and\n-- 'getErrno' is not 'eINTR'.  If the result value is -1 and\n-- 'getErrno' returns 'eINTR' 0 is returned.  Otherwise the result\n-- value is returned.\nthrowErrnoIfMinus1NoRetry :: (Eq a, Num a) => String -> IO a -> IO a\nthrowErrnoIfMinus1NoRetry loc f = do\n    res <- f\n    if res == -1\n        then do\n            err <- getErrno\n            if err == eINTR then return 0 else throwErrno loc\n        else return res\n", "num_lines": 232}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE BangPatterns, NoImplicitPrelude, RecordWildCards #-}\n{-# OPTIONS_GHC -Wno-name-shadowing #-}\n\nmodule GHC.Event.IntTable\n    (\n      IntTable\n    , new\n    , lookup\n    , insertWith\n    , reset\n    , delete\n    , updateWith\n    ) where\n\nimport Data.Bits ((.&.), shiftL, shiftR)\nimport Data.IORef (IORef, newIORef, readIORef, writeIORef)\nimport Data.Maybe (Maybe(..), isJust)\nimport Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)\nimport Foreign.Storable (peek, poke)\nimport GHC.Base (Monad(..), (=<<), ($), ($!), const, liftM, otherwise, when)\nimport GHC.Classes (Eq(..), Ord(..))\nimport GHC.Event.Arr (Arr)\nimport GHC.Num (Num(..))\nimport GHC.Prim (seq)\nimport GHC.Types (Bool(..), IO(..), Int(..))\nimport qualified GHC.Event.Arr as Arr\n\n-- A very simple chained integer-keyed mutable hash table. We use\n-- power-of-two sizing, grow at a load factor of 0.75, and never\n-- shrink. The \"hash function\" is the identity function.\n\nnewtype IntTable a = IntTable (IORef (IT a))\n\ndata IT a = IT {\n      tabArr  :: {-# UNPACK #-} !(Arr (Bucket a))\n    , tabSize :: {-# UNPACK #-} !(ForeignPtr Int)\n    }\n\ndata Bucket a = Empty\n              | Bucket {\n      bucketKey   :: {-# UNPACK #-} !Int\n    , bucketValue :: a\n    , bucketNext  :: Bucket a\n    }\n\nlookup :: Int -> IntTable a -> IO (Maybe a)\nlookup k (IntTable ref) = do\n  let go Bucket{..}\n        | bucketKey == k = Just bucketValue\n        | otherwise      = go bucketNext\n      go _ = Nothing\n  it@IT{..} <- readIORef ref\n  bkt <- Arr.read tabArr (indexOf k it)\n  return $! go bkt\n\nnew :: Int -> IO (IntTable a)\nnew capacity = IntTable `liftM` (newIORef =<< new_ capacity)\n\nnew_ :: Int -> IO (IT a)\nnew_ capacity = do\n  arr <- Arr.new Empty capacity\n  size <- mallocForeignPtr\n  withForeignPtr size $ \\ptr -> poke ptr 0\n  return IT { tabArr = arr\n            , tabSize = size\n            }\n\ngrow :: IT a -> IORef (IT a) -> Int -> IO ()\ngrow oldit ref size = do\n  newit <- new_ (Arr.size (tabArr oldit) `shiftL` 1)\n  let copySlot n !i\n        | n == size = return ()\n        | otherwise = do\n          let copyBucket !m Empty          = copySlot m (i+1)\n              copyBucket  m bkt@Bucket{..} = do\n                let idx = indexOf bucketKey newit\n                next <- Arr.read (tabArr newit) idx\n                Arr.write (tabArr newit) idx bkt { bucketNext = next }\n                copyBucket (m+1) bucketNext\n          copyBucket n =<< Arr.read (tabArr oldit) i\n  copySlot 0 0\n  withForeignPtr (tabSize newit) $ \\ptr -> poke ptr size\n  writeIORef ref newit\n\n-- | @insertWith f k v table@ inserts @k@ into @table@ with value @v@.\n-- If @k@ already appears in @table@ with value @v0@, the value is updated\n-- to @f v0 v@ and @Just v0@ is returned.\ninsertWith :: (a -> a -> a) -> Int -> a -> IntTable a -> IO (Maybe a)\ninsertWith f k v inttable@(IntTable ref) = do\n  it@IT{..} <- readIORef ref\n  let idx = indexOf k it\n      go seen bkt@Bucket{..}\n        | bucketKey == k = do\n          let !v' = f v bucketValue\n              !next = seen <> bucketNext\n              Empty        <> bs = bs\n              b@Bucket{..} <> bs = b { bucketNext = bucketNext <> bs }\n          Arr.write tabArr idx (Bucket k v' next)\n          return (Just bucketValue)\n        | otherwise = go bkt { bucketNext = seen } bucketNext\n      go seen _ = withForeignPtr tabSize $ \\ptr -> do\n        size <- peek ptr\n        if size + 1 >= Arr.size tabArr - (Arr.size tabArr `shiftR` 2)\n          then grow it ref size >> insertWith f k v inttable\n          else do\n            v `seq` Arr.write tabArr idx (Bucket k v seen)\n            poke ptr (size + 1)\n            return Nothing\n  go Empty =<< Arr.read tabArr idx\n{-# INLINABLE insertWith #-}\n\n-- | Used to undo the effect of a prior insertWith.\nreset :: Int -> Maybe a -> IntTable a -> IO ()\nreset k (Just v) tbl = insertWith const k v tbl >> return ()\nreset k Nothing  tbl = delete k tbl >> return ()\n\nindexOf :: Int -> IT a -> Int\nindexOf k IT{..} = k .&. (Arr.size tabArr - 1)\n\n-- | Remove the given key from the table and return its associated value.\ndelete :: Int -> IntTable a -> IO (Maybe a)\ndelete k t = updateWith (const Nothing) k t\n\nupdateWith :: (a -> Maybe a) -> Int -> IntTable a -> IO (Maybe a)\nupdateWith f k (IntTable ref) = do\n  it@IT{..} <- readIORef ref\n  let idx = indexOf k it\n      go bkt@Bucket{..}\n        | bucketKey == k = case f bucketValue of\n            Just val -> let !nb = bkt { bucketValue = val }\n                        in (False, Just bucketValue, nb)\n            Nothing  -> (True, Just bucketValue, bucketNext)\n        | otherwise = case go bucketNext of\n                        (fbv, ov, nb) -> (fbv, ov, bkt { bucketNext = nb })\n      go e = (False, Nothing, e)\n  (del, oldVal, newBucket) <- go `liftM` Arr.read tabArr idx\n  when (isJust oldVal) $ do\n    Arr.write tabArr idx newBucket\n    when del $\n      withForeignPtr tabSize $ \\ptr -> do\n        size <- peek ptr\n        poke ptr (size - 1)\n  return oldVal\n", "num_lines": 145}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE BangPatterns\n           , CPP\n           , ExistentialQuantification\n           , NoImplicitPrelude\n           , RecordWildCards\n           , TypeSynonymInstances\n           , FlexibleInstances\n  #-}\n\n-- |\n-- The event manager supports event notification on fds. Each fd may\n-- have multiple callbacks registered, each listening for a different\n-- set of events. Registrations may be automatically deactivated after\n-- the occurrence of an event (\"one-shot mode\") or active until\n-- explicitly unregistered.\n--\n-- If an fd has only one-shot registrations then we use one-shot\n-- polling if available. Otherwise we use multi-shot polling.\n\nmodule GHC.Event.Manager\n    ( -- * Types\n      EventManager\n\n      -- * Creation\n    , new\n    , newWith\n    , newDefaultBackend\n\n      -- * Running\n    , finished\n    , loop\n    , step\n    , shutdown\n    , release\n    , cleanup\n    , wakeManager\n\n      -- * State\n    , callbackTableVar\n    , emControl\n\n      -- * Registering interest in I/O events\n    , Lifetime (..)\n    , Event\n    , evtRead\n    , evtWrite\n    , IOCallback\n    , FdKey(keyFd)\n    , FdData\n    , registerFd\n    , unregisterFd_\n    , unregisterFd\n    , closeFd\n    , closeFd_\n    ) where\n\n#include \"EventConfig.h\"\n\n------------------------------------------------------------------------\n-- Imports\n\nimport Control.Concurrent.MVar (MVar, newMVar, putMVar,\n                                tryPutMVar, takeMVar, withMVar)\nimport Control.Exception (onException)\nimport Data.Bits ((.&.))\nimport Data.Foldable (forM_)\nimport Data.Functor (void)\nimport Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,\n                   writeIORef)\nimport Data.Maybe (maybe)\nimport Data.OldList (partition)\nimport GHC.Arr (Array, (!), listArray)\nimport GHC.Base\nimport GHC.Conc.Sync (yield)\nimport GHC.List (filter, replicate)\nimport GHC.Num (Num(..))\nimport GHC.Real (fromIntegral)\nimport GHC.Show (Show(..))\nimport GHC.Event.Control\nimport GHC.Event.IntTable (IntTable)\nimport GHC.Event.Internal (Backend, Event, evtClose, evtRead, evtWrite,\n                           Lifetime(..), EventLifetime, Timeout(..))\nimport GHC.Event.Unique (Unique, UniqueSource, newSource, newUnique)\nimport System.Posix.Types (Fd)\n\nimport qualified GHC.Event.IntTable as IT\nimport qualified GHC.Event.Internal as I\n\n#if defined(HAVE_KQUEUE)\nimport qualified GHC.Event.KQueue as KQueue\n#elif defined(HAVE_EPOLL)\nimport qualified GHC.Event.EPoll  as EPoll\n#elif defined(HAVE_POLL)\nimport qualified GHC.Event.Poll   as Poll\n#else\n# error not implemented for this operating system\n#endif\n\n------------------------------------------------------------------------\n-- Types\n\ndata FdData = FdData {\n      fdKey       :: {-# UNPACK #-} !FdKey\n    , fdEvents    :: {-# UNPACK #-} !EventLifetime\n    , _fdCallback :: !IOCallback\n    }\n\n-- | A file descriptor registration cookie.\ndata FdKey = FdKey {\n      keyFd     :: {-# UNPACK #-} !Fd\n    , keyUnique :: {-# UNPACK #-} !Unique\n    } deriving ( Eq   -- ^ @since 4.4.0.0\n               , Show -- ^ @since 4.4.0.0\n               )\n\n-- | Callback invoked on I/O events.\ntype IOCallback = FdKey -> Event -> IO ()\n\ndata State = Created\n           | Running\n           | Dying\n           | Releasing\n           | Finished\n             deriving ( Eq   -- ^ @since 4.4.0.0\n                      , Show -- ^ @since 4.4.0.0\n                      )\n\n-- | The event manager state.\ndata EventManager = EventManager\n    { emBackend      :: !Backend\n    , emFds          :: {-# UNPACK #-} !(Array Int (MVar (IntTable [FdData])))\n    , emState        :: {-# UNPACK #-} !(IORef State)\n    , emUniqueSource :: {-# UNPACK #-} !UniqueSource\n    , emControl      :: {-# UNPACK #-} !Control\n    , emLock         :: {-# UNPACK #-} !(MVar ())\n    }\n\n-- must be power of 2\ncallbackArraySize :: Int\ncallbackArraySize = 32\n\nhashFd :: Fd -> Int\nhashFd fd = fromIntegral fd .&. (callbackArraySize - 1)\n{-# INLINE hashFd #-}\n\ncallbackTableVar :: EventManager -> Fd -> MVar (IntTable [FdData])\ncallbackTableVar mgr fd = emFds mgr ! hashFd fd\n{-# INLINE callbackTableVar #-}\n\nhaveOneShot :: Bool\n{-# INLINE haveOneShot #-}\n#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)\nhaveOneShot = False\n#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)\nhaveOneShot = True\n#else\nhaveOneShot = False\n#endif\n------------------------------------------------------------------------\n-- Creation\n\nhandleControlEvent :: EventManager -> Fd -> Event -> IO ()\nhandleControlEvent mgr fd _evt = do\n  msg <- readControlMessage (emControl mgr) fd\n  case msg of\n    CMsgWakeup      -> return ()\n    CMsgDie         -> writeIORef (emState mgr) Finished\n    _               -> return ()\n\nnewDefaultBackend :: IO Backend\n#if defined(HAVE_KQUEUE)\nnewDefaultBackend = KQueue.new\n#elif defined(HAVE_EPOLL)\nnewDefaultBackend = EPoll.new\n#elif defined(HAVE_POLL)\nnewDefaultBackend = Poll.new\n#else\nnewDefaultBackend = errorWithoutStackTrace \"no back end for this platform\"\n#endif\n\n-- | Create a new event manager.\nnew :: IO EventManager\nnew = newWith =<< newDefaultBackend\n\n-- | Create a new 'EventManager' with the given polling backend.\nnewWith :: Backend -> IO EventManager\nnewWith be = do\n  iofds <- fmap (listArray (0, callbackArraySize-1)) $\n           replicateM callbackArraySize (newMVar =<< IT.new 8)\n  ctrl <- newControl False\n  state <- newIORef Created\n  us <- newSource\n  _ <- mkWeakIORef state $ do\n               st <- atomicModifyIORef' state $ \\s -> (Finished, s)\n               when (st /= Finished) $ do\n                 I.delete be\n                 closeControl ctrl\n  lockVar <- newMVar ()\n  let mgr = EventManager { emBackend = be\n                         , emFds = iofds\n                         , emState = state\n                         , emUniqueSource = us\n                         , emControl = ctrl\n                         , emLock = lockVar\n                         }\n  registerControlFd mgr (controlReadFd ctrl) evtRead\n  registerControlFd mgr (wakeupReadFd ctrl) evtRead\n  return mgr\n  where\n    replicateM n x = sequence (replicate n x)\n\nfailOnInvalidFile :: String -> Fd -> IO Bool -> IO ()\nfailOnInvalidFile loc fd m = do\n  ok <- m\n  when (not ok) $\n    let msg = \"Failed while attempting to modify registration of file \" ++\n              show fd ++ \" at location \" ++ loc\n    in errorWithoutStackTrace msg\n\nregisterControlFd :: EventManager -> Fd -> Event -> IO ()\nregisterControlFd mgr fd evs =\n  failOnInvalidFile \"registerControlFd\" fd $\n  I.modifyFd (emBackend mgr) fd mempty evs\n\n-- | Asynchronously shuts down the event manager, if running.\nshutdown :: EventManager -> IO ()\nshutdown mgr = do\n  state <- atomicModifyIORef' (emState mgr) $ \\s -> (Dying, s)\n  when (state == Running) $ sendDie (emControl mgr)\n\n-- | Asynchronously tell the thread executing the event\n-- manager loop to exit.\nrelease :: EventManager -> IO ()\nrelease EventManager{..} = do\n  state <- atomicModifyIORef' emState $ \\s -> (Releasing, s)\n  when (state == Running) $ sendWakeup emControl\n\nfinished :: EventManager -> IO Bool\nfinished mgr = (== Finished) `liftM` readIORef (emState mgr)\n\ncleanup :: EventManager -> IO ()\ncleanup EventManager{..} = do\n  writeIORef emState Finished\n  void $ tryPutMVar emLock ()\n  I.delete emBackend\n  closeControl emControl\n\n------------------------------------------------------------------------\n-- Event loop\n\n-- | Start handling events.  This function loops until told to stop,\n-- using 'shutdown'.\n--\n-- /Note/: This loop can only be run once per 'EventManager', as it\n-- closes all of its control resources when it finishes.\nloop :: EventManager -> IO ()\nloop mgr@EventManager{..} = do\n  void $ takeMVar emLock\n  state <- atomicModifyIORef' emState $ \\s -> case s of\n    Created -> (Running, s)\n    Releasing -> (Running, s)\n    _       -> (s, s)\n  case state of\n    Created   -> go `onException` cleanup mgr\n    Releasing -> go `onException` cleanup mgr\n    Dying     -> cleanup mgr\n    -- While a poll loop is never forked when the event manager is in the\n    -- 'Finished' state, its state could read 'Finished' once the new thread\n    -- actually runs.  This is not an error, just an unfortunate race condition\n    -- in Thread.restartPollLoop.  See #8235\n    Finished  -> return ()\n    _         -> do cleanup mgr\n                    errorWithoutStackTrace $ \"GHC.Event.Manager.loop: state is already \" ++\n                            show state\n where\n  go = do state <- step mgr\n          case state of\n            Running   -> yield >> go\n            Releasing -> putMVar emLock ()\n            _         -> cleanup mgr\n\n-- | To make a step, we first do a non-blocking poll, in case\n-- there are already events ready to handle. This improves performance\n-- because we can make an unsafe foreign C call, thereby avoiding\n-- forcing the current Task to release the Capability and forcing a context switch.\n-- If the poll fails to find events, we yield, putting the poll loop thread at\n-- end of the Haskell run queue. When it comes back around, we do one more\n-- non-blocking poll, in case we get lucky and have ready events.\n-- If that also returns no events, then we do a blocking poll.\nstep :: EventManager -> IO State\nstep mgr@EventManager{..} = do\n  waitForIO\n  state <- readIORef emState\n  state `seq` return state\n  where\n    waitForIO = do\n      n1 <- I.poll emBackend Nothing (onFdEvent mgr)\n      when (n1 <= 0) $ do\n        yield\n        n2 <- I.poll emBackend Nothing (onFdEvent mgr)\n        when (n2 <= 0) $ do\n          _ <- I.poll emBackend (Just Forever) (onFdEvent mgr)\n          return ()\n\n------------------------------------------------------------------------\n-- Registering interest in I/O events\n\n-- | Register interest in the given events, without waking the event\n-- manager thread.  The 'Bool' return value indicates whether the\n-- event manager ought to be woken.\n--\n-- Note that the event manager is generally implemented in terms of the\n-- platform's @select@ or @epoll@ system call, which tend to vary in\n-- what sort of fds are permitted. For instance, waiting on regular files\n-- is not allowed on many platforms.\nregisterFd_ :: EventManager -> IOCallback -> Fd -> Event -> Lifetime\n            -> IO (FdKey, Bool)\nregisterFd_ mgr@(EventManager{..}) cb fd evs lt = do\n  u <- newUnique emUniqueSource\n  let fd'  = fromIntegral fd\n      reg  = FdKey fd u\n      el = I.eventLifetime evs lt\n      !fdd = FdData reg el cb\n  (modify,ok) <- withMVar (callbackTableVar mgr fd) $ \\tbl -> do\n    oldFdd <- IT.insertWith (++) fd' [fdd] tbl\n    let prevEvs :: EventLifetime\n        prevEvs = maybe mempty eventsOf oldFdd\n\n        el' :: EventLifetime\n        el' = prevEvs `mappend` el\n    case I.elLifetime el' of\n      -- All registrations want one-shot semantics and this is supported\n      OneShot | haveOneShot -> do\n        ok <- I.modifyFdOnce emBackend fd (I.elEvent el')\n        if ok\n          then return (False, True)\n          else IT.reset fd' oldFdd tbl >> return (False, False)\n\n      -- We don't want or don't support one-shot semantics\n      _ -> do\n        let modify = prevEvs /= el'\n        ok <- if modify\n              then let newEvs = I.elEvent el'\n                       oldEvs = I.elEvent prevEvs\n                   in I.modifyFd emBackend fd oldEvs newEvs\n              else return True\n        if ok\n          then return (modify, True)\n          else IT.reset fd' oldFdd tbl >> return (False, False)\n  -- this simulates behavior of old IO manager:\n  -- i.e. just call the callback if the registration fails.\n  when (not ok) (cb reg evs)\n  return (reg,modify)\n{-# INLINE registerFd_ #-}\n\n-- | @registerFd mgr cb fd evs lt@ registers interest in the events @evs@\n-- on the file descriptor @fd@ for lifetime @lt@. @cb@ is called for\n-- each event that occurs.  Returns a cookie that can be handed to\n-- 'unregisterFd'.\nregisterFd :: EventManager -> IOCallback -> Fd -> Event -> Lifetime -> IO FdKey\nregisterFd mgr cb fd evs lt = do\n  (r, wake) <- registerFd_ mgr cb fd evs lt\n  when wake $ wakeManager mgr\n  return r\n{-# INLINE registerFd #-}\n\n{-\n    Building GHC with parallel IO manager on Mac freezes when\n    compiling the dph libraries in the phase 2. As workaround, we\n    don't use oneshot and we wake up an IO manager on Mac every time\n    when we register an event.\n\n    For more information, please read:\n        http://ghc.haskell.org/trac/ghc/ticket/7651\n-}\n-- | Wake up the event manager.\nwakeManager :: EventManager -> IO ()\n#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)\nwakeManager mgr = sendWakeup (emControl mgr)\n#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)\nwakeManager _ = return ()\n#else\nwakeManager mgr = sendWakeup (emControl mgr)\n#endif\n\neventsOf :: [FdData] -> EventLifetime\neventsOf [fdd] = fdEvents fdd\neventsOf fdds  = mconcat $ map fdEvents fdds\n\n-- | Drop a previous file descriptor registration, without waking the\n-- event manager thread.  The return value indicates whether the event\n-- manager ought to be woken.\nunregisterFd_ :: EventManager -> FdKey -> IO Bool\nunregisterFd_ mgr@(EventManager{..}) (FdKey fd u) =\n  withMVar (callbackTableVar mgr fd) $ \\tbl -> do\n    let dropReg = nullToNothing . filter ((/= u) . keyUnique . fdKey)\n        fd' = fromIntegral fd\n        pairEvents :: [FdData] -> IO (EventLifetime, EventLifetime)\n        pairEvents prev = do\n          r <- maybe mempty eventsOf `fmap` IT.lookup fd' tbl\n          return (eventsOf prev, r)\n    (oldEls, newEls) <- IT.updateWith dropReg fd' tbl >>=\n                        maybe (return (mempty, mempty)) pairEvents\n    let modify = oldEls /= newEls\n    when modify $ failOnInvalidFile \"unregisterFd_\" fd $\n      case I.elLifetime newEls of\n        OneShot | I.elEvent newEls /= mempty, haveOneShot ->\n          I.modifyFdOnce emBackend fd (I.elEvent newEls)\n        _ ->\n          I.modifyFd emBackend fd (I.elEvent oldEls) (I.elEvent newEls)\n    return modify\n\n-- | Drop a previous file descriptor registration.\nunregisterFd :: EventManager -> FdKey -> IO ()\nunregisterFd mgr reg = do\n  wake <- unregisterFd_ mgr reg\n  when wake $ wakeManager mgr\n\n-- | Close a file descriptor in a race-safe way.\ncloseFd :: EventManager -> (Fd -> IO ()) -> Fd -> IO ()\ncloseFd mgr close fd = do\n  fds <- withMVar (callbackTableVar mgr fd) $ \\tbl -> do\n    prev <- IT.delete (fromIntegral fd) tbl\n    case prev of\n      Nothing  -> close fd >> return []\n      Just fds -> do\n        let oldEls = eventsOf fds\n        when (I.elEvent oldEls /= mempty) $ do\n          _ <- I.modifyFd (emBackend mgr) fd (I.elEvent oldEls) mempty\n          wakeManager mgr\n        close fd\n        return fds\n  forM_ fds $ \\(FdData reg el cb) -> cb reg (I.elEvent el `mappend` evtClose)\n\n-- | Close a file descriptor in a race-safe way.\n-- It assumes the caller will update the callback tables and that the caller\n-- holds the callback table lock for the fd. It must hold this lock because\n-- this command executes a backend command on the fd.\ncloseFd_ :: EventManager\n            -> IntTable [FdData]\n            -> Fd\n            -> IO (IO ())\ncloseFd_ mgr tbl fd = do\n  prev <- IT.delete (fromIntegral fd) tbl\n  case prev of\n    Nothing  -> return (return ())\n    Just fds -> do\n      let oldEls = eventsOf fds\n      when (oldEls /= mempty) $ do\n        _ <- I.modifyFd (emBackend mgr) fd (I.elEvent oldEls) mempty\n        wakeManager mgr\n      return $\n        forM_ fds $ \\(FdData reg el cb) ->\n          cb reg (I.elEvent el `mappend` evtClose)\n\n------------------------------------------------------------------------\n-- Utilities\n\n-- | Call the callbacks corresponding to the given file descriptor.\nonFdEvent :: EventManager -> Fd -> Event -> IO ()\nonFdEvent mgr fd evs\n  | fd == controlReadFd (emControl mgr) || fd == wakeupReadFd (emControl mgr) =\n    handleControlEvent mgr fd evs\n\n  | otherwise = do\n    fdds <- withMVar (callbackTableVar mgr fd) $ \\tbl ->\n        IT.delete (fromIntegral fd) tbl >>= maybe (return []) (selectCallbacks tbl)\n    forM_ fdds $ \\(FdData reg _ cb) -> cb reg evs\n  where\n    -- | Here we look through the list of registrations for the fd of interest\n    -- and sort out which match the events that were triggered. We,\n    --\n    --   1. re-arm the fd as appropriate\n    --   2. reinsert registrations that weren't triggered and multishot\n    --      registrations\n    --   3. return a list containing the callbacks that should be invoked.\n    selectCallbacks :: IntTable [FdData] -> [FdData] -> IO [FdData]\n    selectCallbacks tbl fdds = do\n        let -- figure out which registrations have been triggered\n            matches :: FdData -> Bool\n            matches fd' = evs `I.eventIs` I.elEvent (fdEvents fd')\n            (triggered, notTriggered) = partition matches fdds\n\n            -- sort out which registrations we need to retain\n            isMultishot :: FdData -> Bool\n            isMultishot fd' = I.elLifetime (fdEvents fd') == MultiShot\n            saved = notTriggered ++ filter isMultishot triggered\n\n            savedEls = eventsOf saved\n            allEls = eventsOf fdds\n\n        -- Reinsert multishot registrations.\n        -- We deleted the table entry for this fd above so we there isn't a preexisting entry\n        _ <- IT.insertWith (\\_ _ -> saved) (fromIntegral fd) saved tbl\n\n        case I.elLifetime allEls of\n          -- we previously armed the fd for multiple shots, no need to rearm\n          MultiShot | allEls == savedEls ->\n            return ()\n\n          -- either we previously registered for one shot or the\n          -- events of interest have changed, we must re-arm\n          _ ->\n            case I.elLifetime savedEls of\n              OneShot | haveOneShot ->\n                -- if there are no saved events and we registered with one-shot\n                -- semantics then there is no need to re-arm\n                unless (OneShot == I.elLifetime allEls\n                        && mempty == I.elEvent savedEls) $ do\n                  void $ I.modifyFdOnce (emBackend mgr) fd (I.elEvent savedEls)\n              _ ->\n                -- we need to re-arm with multi-shot semantics\n                void $ I.modifyFd (emBackend mgr) fd\n                                  (I.elEvent allEls) (I.elEvent savedEls)\n\n        return triggered\n\nnullToNothing :: [a] -> Maybe [a]\nnullToNothing []       = Nothing\nnullToNothing xs@(_:_) = Just xs\n\nunless :: Monad m => Bool -> m () -> m ()\nunless p = when (not p)\n", "num_lines": 525}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy       #-}\n{-# LANGUAGE BangPatterns      #-}\n{-# LANGUAGE CPP               #-}\n{-# LANGUAGE DeriveFoldable    #-}\n{-# LANGUAGE DeriveFunctor     #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE MagicHash         #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE UnboxedTuples     #-}\n\nmodule GHC.Event.PSQ\n    (\n    -- * Binding Type\n      Elem(..)\n    , Key\n    , Prio\n\n    -- * Priority Search Queue Type\n    , PSQ\n\n    -- * Query\n    , size\n    , null\n    , lookup\n\n    -- * Construction\n    , empty\n    , singleton\n\n    -- * Insertion\n    , unsafeInsertNew\n\n    -- * Delete/Update\n    , delete\n    , adjust\n\n    -- * Conversion\n    , toList\n\n    -- * Min\n    , findMin\n    , deleteMin\n    , minView\n    , atMost\n    ) where\n\nimport GHC.Base hiding (Nat, empty)\nimport GHC.Event.Unique\nimport GHC.Word (Word64)\nimport GHC.Num (Num(..))\nimport GHC.Real (fromIntegral)\n\n#include \"MachDeps.h\"\n\n-- TODO (SM): get rid of bang patterns\n\n{-\n-- Use macros to define strictness of functions.\n-- STRICT_x_OF_y denotes a y-ary function strict in the x-th parameter.\n-- We do not use BangPatterns, because they are not in any standard and we\n-- want the compilers to be compiled by as many compilers as possible.\n#define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined\n-}\n\n\n------------------------------------------------------------------------------\n-- Types\n------------------------------------------------------------------------------\n\ntype Prio = Word64\n\ntype Nat = Word\n\ntype Key = Unique\n\n-- | We store masks as the index of the bit that determines the branching.\ntype Mask = Int\n\ntype PSQ a = IntPSQ a\n\n-- | @E k p@ binds the key @k@ with the priority @p@.\ndata Elem a = E\n    { key   :: {-# UNPACK #-} !Key\n    , prio  :: {-# UNPACK #-} !Prio\n    , value :: a\n    }\n\n-- | A priority search queue with @Int@ keys and priorities of type @p@ and\n-- values of type @v@. It is strict in keys, priorities and values.\ndata IntPSQ v\n    = Bin {-# UNPACK #-} !Key {-# UNPACK #-} !Prio !v {-# UNPACK #-} !Mask !(IntPSQ v) !(IntPSQ v)\n    | Tip {-# UNPACK #-} !Key {-# UNPACK #-} !Prio !v\n    | Nil\n\n-- bit twiddling\n----------------\n\n(.&.) :: Nat -> Nat -> Nat\n(.&.) (W# w1) (W# w2) = W# (w1 `and#` w2)\n{-# INLINE (.&.) #-}\n\nxor :: Nat -> Nat -> Nat\nxor (W# w1) (W# w2) = W# (w1 `xor#` w2)\n{-# INLINE xor #-}\n\ncomplement :: Nat -> Nat\ncomplement (W# w) = W# (w `xor#` mb)\n  where\n#if WORD_SIZE_IN_BITS == 32\n    mb = 0xFFFFFFFF##\n#elif WORD_SIZE_IN_BITS == 64\n    mb = 0xFFFFFFFFFFFFFFFF##\n#else\n#error Unhandled value for WORD_SIZE_IN_BITS\n#endif\n{-# INLINE complement #-}\n\n{-# INLINE natFromInt #-}\nnatFromInt :: Int -> Nat\nnatFromInt = fromIntegral\n\n{-# INLINE intFromNat #-}\nintFromNat :: Nat -> Int\nintFromNat = fromIntegral\n\n{-# INLINE zero #-}\nzero :: Key -> Mask -> Bool\nzero i m\n  = (natFromInt (asInt i)) .&. (natFromInt m) == 0\n\n{-# INLINE nomatch #-}\nnomatch :: Key -> Key -> Mask -> Bool\nnomatch k1 k2 m =\n    natFromInt (asInt k1) .&. m' /= natFromInt (asInt k2) .&. m'\n  where\n    m' = maskW (natFromInt m)\n\n{-# INLINE maskW #-}\nmaskW :: Nat -> Nat\nmaskW m = complement (m-1) `xor` m\n\n{-# INLINE branchMask #-}\nbranchMask :: Key -> Key -> Mask\nbranchMask k1' k2' =\n    intFromNat (highestBitMask (natFromInt k1 `xor` natFromInt k2))\n  where\n    k1 = asInt k1'\n    k2 = asInt k2'\n\nhighestBitMask :: Nat -> Nat\nhighestBitMask (W# x) =\n    W# (uncheckedShiftL# 1## (word2Int# (WORD_SIZE_IN_BITS## `minusWord#` 1## `minusWord#` clz# x)))\n{-# INLINE highestBitMask #-}\n\n------------------------------------------------------------------------------\n-- Query\n------------------------------------------------------------------------------\n\n-- | /O(1)/ True if the queue is empty.\nnull :: IntPSQ v -> Bool\nnull Nil = True\nnull _   = False\n\n-- | /O(n)/ The number of elements stored in the queue.\nsize :: IntPSQ v -> Int\nsize Nil               = 0\nsize (Tip _ _ _)       = 1\nsize (Bin _ _ _ _ l r) = 1 + size l + size r\n-- TODO (SM): benchmark this against a tail-recursive variant\n\n-- | /O(min(n,W))/ The priority and value of a given key, or 'Nothing' if the\n-- key is not bound.\nlookup :: Key -> IntPSQ v -> Maybe (Prio, v)\nlookup k = go\n  where\n    go t = case t of\n        Nil                -> Nothing\n\n        Tip k' p' x'\n          | k == k'        -> Just (p', x')\n          | otherwise      -> Nothing\n\n        Bin k' p' x' m l r\n          | nomatch k k' m -> Nothing\n          | k == k'        -> Just (p', x')\n          | zero k m       -> go l\n          | otherwise      -> go r\n\n-- | /O(1)/ The element with the lowest priority.\nfindMin :: IntPSQ v -> Maybe (Elem v)\nfindMin t = case t of\n    Nil             -> Nothing\n    Tip k p x       -> Just (E k p x)\n    Bin k p x _ _ _ -> Just (E k p x)\n\n\n------------------------------------------------------------------------------\n--- Construction\n------------------------------------------------------------------------------\n\n-- | /O(1)/ The empty queue.\nempty :: IntPSQ v\nempty = Nil\n\n-- | /O(1)/ Build a queue with one element.\nsingleton :: Key -> Prio -> v -> IntPSQ v\nsingleton = Tip\n\n\n------------------------------------------------------------------------------\n-- Insertion\n------------------------------------------------------------------------------\n\n-- | /O(min(n,W))/ Insert a new key that is *not* present in the priority queue.\n{-# INLINABLE unsafeInsertNew #-}\nunsafeInsertNew :: Key -> Prio -> v -> IntPSQ v -> IntPSQ v\nunsafeInsertNew k p x = go\n  where\n    go t = case t of\n      Nil       -> Tip k p x\n\n      Tip k' p' x'\n        | (p, k) < (p', k') -> link k  p  x  k' t           Nil\n        | otherwise         -> link k' p' x' k  (Tip k p x) Nil\n\n      Bin k' p' x' m l r\n        | nomatch k k' m ->\n            if (p, k) < (p', k')\n              then link k  p  x  k' t           Nil\n              else link k' p' x' k  (Tip k p x) (merge m l r)\n\n        | otherwise ->\n            if (p, k) < (p', k')\n              then\n                if zero k' m\n                  then Bin k  p  x  m (unsafeInsertNew k' p' x' l) r\n                  else Bin k  p  x  m l (unsafeInsertNew k' p' x' r)\n              else\n                if zero k m\n                  then Bin k' p' x' m (unsafeInsertNew k  p  x  l) r\n                  else Bin k' p' x' m l (unsafeInsertNew k  p  x  r)\n\n-- | Link\nlink :: Key -> Prio -> v -> Key -> IntPSQ v -> IntPSQ v -> IntPSQ v\nlink k p x k' k't otherTree\n  | zero (Unique m) (asInt k') = Bin k p x m k't otherTree\n  | otherwise                  = Bin k p x m otherTree k't\n  where\n    m = branchMask k k'\n\n\n------------------------------------------------------------------------------\n-- Delete/Alter\n------------------------------------------------------------------------------\n\n-- | /O(min(n,W))/ Delete a key and its priority and value from the queue. When\n-- the key is not a member of the queue, the original queue is returned.\n{-# INLINABLE delete #-}\ndelete :: Key -> IntPSQ v -> IntPSQ v\ndelete k = go\n  where\n    go t = case t of\n        Nil           -> Nil\n\n        Tip k' _ _\n          | k == k'   -> Nil\n          | otherwise -> t\n\n        Bin k' p' x' m l r\n          | nomatch k k' m -> t\n          | k == k'        -> merge m l r\n          | zero k m       -> binShrinkL k' p' x' m (go l) r\n          | otherwise      -> binShrinkR k' p' x' m l      (go r)\n\n-- | /O(min(n,W))/ Delete the binding with the least priority, and return the\n-- rest of the queue stripped of that binding. In case the queue is empty, the\n-- empty queue is returned again.\n{-# INLINE deleteMin #-}\ndeleteMin :: IntPSQ v -> IntPSQ v\ndeleteMin t = case minView t of\n    Nothing      -> t\n    Just (_, t') -> t'\n\n\nadjust\n    :: (Prio -> Prio)\n    -> Key\n    -> PSQ a\n    -> PSQ a\nadjust f k q = case alter g k q of (_, q') -> q'\n  where g (Just (p, v)) = ((), Just ((f p), v))\n        g Nothing       = ((), Nothing)\n\n{-# INLINE adjust #-}\n\n-- | /O(min(n,W))/ The expression @alter f k queue@ alters the value @x@ at @k@,\n-- or absence thereof. 'alter' can be used to insert, delete, or update a value\n-- in a queue. It also allows you to calculate an additional value @b@.\n{-# INLINE alter #-}\nalter\n    :: (Maybe (Prio, v) -> (b, Maybe (Prio, v)))\n    -> Key\n    -> IntPSQ v\n    -> (b, IntPSQ v)\nalter f = \\k t0 ->\n    let (t, mbX) = case deleteView k t0 of\n                            Nothing          -> (t0, Nothing)\n                            Just (p, v, t0') -> (t0', Just (p, v))\n    in case f mbX of\n          (b, mbX') ->\n            (b, maybe t (\\(p, v) -> unsafeInsertNew k p v t) mbX')\n    where\n        maybe _ g (Just x)  = g x\n        maybe def _ Nothing = def\n\n-- | Smart constructor for a 'Bin' node whose left subtree could have become\n-- 'Nil'.\n{-# INLINE binShrinkL #-}\nbinShrinkL :: Key -> Prio -> v -> Mask -> IntPSQ v -> IntPSQ v -> IntPSQ v\nbinShrinkL k p x m Nil r = case r of Nil -> Tip k p x; _ -> Bin k p x m Nil r\nbinShrinkL k p x m l   r = Bin k p x m l r\n\n-- | Smart constructor for a 'Bin' node whose right subtree could have become\n-- 'Nil'.\n{-# INLINE binShrinkR #-}\nbinShrinkR :: Key -> Prio -> v -> Mask -> IntPSQ v -> IntPSQ v -> IntPSQ v\nbinShrinkR k p x m l Nil = case l of Nil -> Tip k p x; _ -> Bin k p x m l Nil\nbinShrinkR k p x m l r   = Bin k p x m l r\n\n------------------------------------------------------------------------------\n-- Lists\n------------------------------------------------------------------------------\n\n-- | /O(n)/ Convert a queue to a list of (key, priority, value) tuples. The\n-- order of the list is not specified.\ntoList :: IntPSQ v -> [Elem v]\ntoList =\n    go []\n  where\n    go acc Nil                   = acc\n    go acc (Tip k' p' x')        = (E k' p' x') : acc\n    go acc (Bin k' p' x' _m l r) = (E k' p' x') : go (go acc r) l\n\n\n------------------------------------------------------------------------------\n-- Views\n------------------------------------------------------------------------------\n\n-- | /O(min(n,W))/ Delete a key and its priority and value from the queue. If\n-- the key was present, the associated priority and value are returned in\n-- addition to the updated queue.\n{-# INLINABLE deleteView #-}\ndeleteView :: Key -> IntPSQ v -> Maybe (Prio, v, IntPSQ v)\ndeleteView k t0 =\n    case delFrom t0 of\n      (# _, Nothing     #) -> Nothing\n      (# t, Just (p, x) #) -> Just (p, x, t)\n  where\n    delFrom t = case t of\n      Nil -> (# Nil, Nothing #)\n\n      Tip k' p' x'\n        | k == k'   -> (# Nil, Just (p', x') #)\n        | otherwise -> (# t,   Nothing       #)\n\n      Bin k' p' x' m l r\n        | nomatch k k' m -> (# t, Nothing #)\n        | k == k'   -> let t' = merge m l r\n                       in  t' `seq` (# t', Just (p', x') #)\n\n        | zero k m  -> case delFrom l of\n                         (# l', mbPX #) -> let t' = binShrinkL k' p' x' m l' r\n                                           in  t' `seq` (# t', mbPX #)\n\n        | otherwise -> case delFrom r of\n                         (# r', mbPX #) -> let t' = binShrinkR k' p' x' m l  r'\n                                           in  t' `seq` (# t', mbPX #)\n\n-- | /O(min(n,W))/ Retrieve the binding with the least priority, and the\n-- rest of the queue stripped of that binding.\n{-# INLINE minView #-}\nminView :: IntPSQ v -> Maybe (Elem v, IntPSQ v)\nminView t = case t of\n    Nil             -> Nothing\n    Tip k p x       -> Just (E k p x, Nil)\n    Bin k p x m l r -> Just (E k p x, merge m l r)\n\n-- | Return a list of elements ordered by key whose priorities are at most @pt@,\n-- and the rest of the queue stripped of these elements.  The returned list of\n-- elements can be in any order: no guarantees there.\n{-# INLINABLE atMost #-}\natMost :: Prio -> IntPSQ v -> ([Elem v], IntPSQ v)\natMost pt t0 = go [] t0\n  where\n    go acc t = case t of\n        Nil             -> (acc, t)\n        Tip k p x\n            | p > pt    -> (acc, t)\n            | otherwise -> ((E k p x) : acc, Nil)\n\n        Bin k p x m l r\n            | p > pt    -> (acc, t)\n            | otherwise ->\n                let (acc',  l') = go acc  l\n                    (acc'', r') = go acc' r\n                in  ((E k p x) : acc'', merge m l' r')\n\n\n------------------------------------------------------------------------------\n-- Traversal\n------------------------------------------------------------------------------\n\n-- | Internal function that merges two *disjoint* 'IntPSQ's that share the\n-- same prefix mask.\n{-# INLINABLE merge #-}\nmerge :: Mask -> IntPSQ v -> IntPSQ v -> IntPSQ v\nmerge m l r = case l of\n    Nil -> r\n\n    Tip lk lp lx ->\n      case r of\n        Nil                     -> l\n        Tip rk rp rx\n          | (lp, lk) < (rp, rk) -> Bin lk lp lx m Nil r\n          | otherwise           -> Bin rk rp rx m l   Nil\n        Bin rk rp rx rm rl rr\n          | (lp, lk) < (rp, rk) -> Bin lk lp lx m Nil r\n          | otherwise           -> Bin rk rp rx m l   (merge rm rl rr)\n\n    Bin lk lp lx lm ll lr ->\n      case r of\n        Nil                     -> l\n        Tip rk rp rx\n          | (lp, lk) < (rp, rk) -> Bin lk lp lx m (merge lm ll lr) r\n          | otherwise           -> Bin rk rp rx m l                Nil\n        Bin rk rp rx rm rl rr\n          | (lp, lk) < (rp, rk) -> Bin lk lp lx m (merge lm ll lr) r\n          | otherwise           -> Bin rk rp rx m l                (merge rm rl rr)\n", "num_lines": 439}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}\n\nmodule GHC.Event.Thread\n    ( getSystemEventManager\n    , getSystemTimerManager\n    , ensureIOManagerIsRunning\n    , ioManagerCapabilitiesChanged\n    , threadWaitRead\n    , threadWaitWrite\n    , threadWaitReadSTM\n    , threadWaitWriteSTM\n    , closeFdWith\n    , threadDelay\n    , registerDelay\n    , blockedOnBadFD -- used by RTS\n    ) where\n\nimport Control.Exception (finally, SomeException, toException)\nimport Data.Foldable (forM_, mapM_, sequence_)\nimport Data.IORef (IORef, newIORef, readIORef, writeIORef)\nimport Data.Tuple (snd)\nimport Foreign.C.Error (eBADF, errnoToIOError)\nimport Foreign.C.Types (CInt(..), CUInt(..))\nimport Foreign.Ptr (Ptr)\nimport GHC.Base\nimport GHC.List (zipWith, zipWith3)\nimport GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,\n                      labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,\n                      getNumCapabilities, threadCapability, myThreadId, forkOn,\n                      threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM)\nimport GHC.IO (mask_, onException)\nimport GHC.IO.Exception (ioError)\nimport GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,\n                    boundsIOArray)\nimport GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)\nimport GHC.Event.Control (controlWriteFd)\nimport GHC.Event.Internal (eventIs, evtClose)\nimport GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,\n                             new, registerFd, unregisterFd_)\nimport qualified GHC.Event.Manager as M\nimport qualified GHC.Event.TimerManager as TM\nimport GHC.Num ((-), (+))\nimport GHC.Real (fromIntegral)\nimport GHC.Show (showSignedInt)\nimport System.IO.Unsafe (unsafePerformIO)\nimport System.Posix.Types (Fd)\n\n-- | Suspends the current thread for a given number of microseconds\n-- (GHC only).\n--\n-- There is no guarantee that the thread will be rescheduled promptly\n-- when the delay has expired, but the thread will never continue to\n-- run /earlier/ than specified.\nthreadDelay :: Int -> IO ()\nthreadDelay usecs = mask_ $ do\n  mgr <- getSystemTimerManager\n  m <- newEmptyMVar\n  reg <- TM.registerTimeout mgr usecs (putMVar m ())\n  takeMVar m `onException` TM.unregisterTimeout mgr reg\n\n-- | Set the value of returned TVar to True after a given number of\n-- microseconds. The caveats associated with threadDelay also apply.\n--\nregisterDelay :: Int -> IO (TVar Bool)\nregisterDelay usecs = do\n  t <- atomically $ newTVar False\n  mgr <- getSystemTimerManager\n  _ <- TM.registerTimeout mgr usecs . atomically $ writeTVar t True\n  return t\n\n-- | Block the current thread until data is available to read from the\n-- given file descriptor.\n--\n-- This will throw an 'Prelude.IOError' if the file descriptor was closed\n-- while this thread was blocked.  To safely close a file descriptor\n-- that has been used with 'threadWaitRead', use 'closeFdWith'.\nthreadWaitRead :: Fd -> IO ()\nthreadWaitRead = threadWait evtRead\n{-# INLINE threadWaitRead #-}\n\n-- | Block the current thread until the given file descriptor can\n-- accept data to write.\n--\n-- This will throw an 'Prelude.IOError' if the file descriptor was closed\n-- while this thread was blocked.  To safely close a file descriptor\n-- that has been used with 'threadWaitWrite', use 'closeFdWith'.\nthreadWaitWrite :: Fd -> IO ()\nthreadWaitWrite = threadWait evtWrite\n{-# INLINE threadWaitWrite #-}\n\n-- | Close a file descriptor in a concurrency-safe way.\n--\n-- Any threads that are blocked on the file descriptor via\n-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having\n-- IO exceptions thrown.\ncloseFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.\n            -> Fd                   -- ^ File descriptor to close.\n            -> IO ()\ncloseFdWith close fd = do\n  eventManagerArray <- readIORef eventManager\n  let (low, high) = boundsIOArray eventManagerArray\n  mgrs <- flip mapM [low..high] $ \\i -> do\n    Just (_,!mgr) <- readIOArray eventManagerArray i\n    return mgr\n  mask_ $ do\n    tables <- flip mapM mgrs $ \\mgr -> takeMVar $ M.callbackTableVar mgr fd\n    cbApps <- zipWithM (\\mgr table -> M.closeFd_ mgr table fd) mgrs tables\n    close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)\n  where\n    finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp\n    zipWithM f xs ys = sequence (zipWith f xs ys)\n\nthreadWait :: Event -> Fd -> IO ()\nthreadWait evt fd = mask_ $ do\n  m <- newEmptyMVar\n  mgr <- getSystemEventManager_\n  reg <- registerFd mgr (\\_ e -> putMVar m e) fd evt M.OneShot\n  evt' <- takeMVar m `onException` unregisterFd_ mgr reg\n  if evt' `eventIs` evtClose\n    then ioError $ errnoToIOError \"threadWait\" eBADF Nothing Nothing\n    else return ()\n\n-- used at least by RTS in 'select()' IO manager backend\nblockedOnBadFD :: SomeException\nblockedOnBadFD = toException $ errnoToIOError \"awaitEvent\" eBADF Nothing Nothing\n\nthreadWaitSTM :: Event -> Fd -> IO (STM (), IO ())\nthreadWaitSTM evt fd = mask_ $ do\n  m <- newTVarIO Nothing\n  mgr <- getSystemEventManager_\n  reg <- registerFd mgr (\\_ e -> atomically (writeTVar m (Just e))) fd evt M.OneShot\n  let waitAction =\n        do mevt <- readTVar m\n           case mevt of\n             Nothing -> retry\n             Just evt' ->\n               if evt' `eventIs` evtClose\n               then throwSTM $ errnoToIOError \"threadWaitSTM\" eBADF Nothing Nothing\n               else return ()\n  return (waitAction, unregisterFd_ mgr reg >> return ())\n\n-- | Allows a thread to use an STM action to wait for a file descriptor to be readable.\n-- The STM action will retry until the file descriptor has data ready.\n-- The second element of the return value pair is an IO action that can be used\n-- to deregister interest in the file descriptor.\n--\n-- The STM action will throw an 'Prelude.IOError' if the file descriptor was closed\n-- while the STM action is being executed.  To safely close a file descriptor\n-- that has been used with 'threadWaitReadSTM', use 'closeFdWith'.\nthreadWaitReadSTM :: Fd -> IO (STM (), IO ())\nthreadWaitReadSTM = threadWaitSTM evtRead\n{-# INLINE threadWaitReadSTM #-}\n\n-- | Allows a thread to use an STM action to wait until a file descriptor can accept a write.\n-- The STM action will retry while the file until the given file descriptor can accept a write.\n-- The second element of the return value pair is an IO action that can be used to deregister\n-- interest in the file descriptor.\n--\n-- The STM action will throw an 'Prelude.IOError' if the file descriptor was closed\n-- while the STM action is being executed.  To safely close a file descriptor\n-- that has been used with 'threadWaitWriteSTM', use 'closeFdWith'.\nthreadWaitWriteSTM :: Fd -> IO (STM (), IO ())\nthreadWaitWriteSTM = threadWaitSTM evtWrite\n{-# INLINE threadWaitWriteSTM #-}\n\n\n-- | Retrieve the system event manager for the capability on which the\n-- calling thread is running.\n--\n-- This function always returns 'Just' the current thread's event manager\n-- when using the threaded RTS and 'Nothing' otherwise.\ngetSystemEventManager :: IO (Maybe EventManager)\ngetSystemEventManager = do\n  t <- myThreadId\n  (cap, _) <- threadCapability t\n  eventManagerArray <- readIORef eventManager\n  mmgr <- readIOArray eventManagerArray cap\n  return $ fmap snd mmgr\n\ngetSystemEventManager_ :: IO EventManager\ngetSystemEventManager_ = do\n  Just mgr <- getSystemEventManager\n  return mgr\n{-# INLINE getSystemEventManager_ #-}\n\nforeign import ccall unsafe \"getOrSetSystemEventThreadEventManagerStore\"\n    getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)\n\neventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager)))\neventManager = unsafePerformIO $ do\n    numCaps <- getNumCapabilities\n    eventManagerArray <- newIOArray (0, numCaps - 1) Nothing\n    em <- newIORef eventManagerArray\n    sharedCAF em getOrSetSystemEventThreadEventManagerStore\n{-# NOINLINE eventManager #-}\n\nnumEnabledEventManagers :: IORef Int\nnumEnabledEventManagers = unsafePerformIO $ do\n  newIORef 0\n{-# NOINLINE numEnabledEventManagers #-}\n\nforeign import ccall unsafe \"getOrSetSystemEventThreadIOManagerThreadStore\"\n    getOrSetSystemEventThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)\n\n-- | The ioManagerLock protects the 'eventManager' value:\n-- Only one thread at a time can start or shutdown event managers.\n{-# NOINLINE ioManagerLock #-}\nioManagerLock :: MVar ()\nioManagerLock = unsafePerformIO $ do\n   m <- newMVar ()\n   sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore\n\ngetSystemTimerManager :: IO TM.TimerManager\ngetSystemTimerManager = do\n  Just mgr <- readIORef timerManager\n  return mgr\n\nforeign import ccall unsafe \"getOrSetSystemTimerThreadEventManagerStore\"\n    getOrSetSystemTimerThreadEventManagerStore :: Ptr a -> IO (Ptr a)\n\ntimerManager :: IORef (Maybe TM.TimerManager)\ntimerManager = unsafePerformIO $ do\n    em <- newIORef Nothing\n    sharedCAF em getOrSetSystemTimerThreadEventManagerStore\n{-# NOINLINE timerManager #-}\n\nforeign import ccall unsafe \"getOrSetSystemTimerThreadIOManagerThreadStore\"\n    getOrSetSystemTimerThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)\n\n{-# NOINLINE timerManagerThreadVar #-}\ntimerManagerThreadVar :: MVar (Maybe ThreadId)\ntimerManagerThreadVar = unsafePerformIO $ do\n   m <- newMVar Nothing\n   sharedCAF m getOrSetSystemTimerThreadIOManagerThreadStore\n\nensureIOManagerIsRunning :: IO ()\nensureIOManagerIsRunning\n  | not threaded = return ()\n  | otherwise = do\n      startIOManagerThreads\n      startTimerManagerThread\n\nstartIOManagerThreads :: IO ()\nstartIOManagerThreads =\n  withMVar ioManagerLock $ \\_ -> do\n    eventManagerArray <- readIORef eventManager\n    let (_, high) = boundsIOArray eventManagerArray\n    mapM_ (startIOManagerThread eventManagerArray) [0..high]\n    writeIORef numEnabledEventManagers (high+1)\n\nshow_int :: Int -> String\nshow_int i = showSignedInt 0 i \"\"\n\nrestartPollLoop :: EventManager -> Int -> IO ThreadId\nrestartPollLoop mgr i = do\n  M.release mgr\n  !t <- forkOn i $ loop mgr\n  labelThread t (\"IOManager on cap \" ++ show_int i)\n  return t\n\nstartIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager))\n                        -> Int\n                        -> IO ()\nstartIOManagerThread eventManagerArray i = do\n  let create = do\n        !mgr <- new\n        !t <- forkOn i $ do\n                c_setIOManagerControlFd\n                  (fromIntegral i)\n                  (fromIntegral $ controlWriteFd $ M.emControl mgr)\n                loop mgr\n        labelThread t (\"IOManager on cap \" ++ show_int i)\n        writeIOArray eventManagerArray i (Just (t,mgr))\n  old <- readIOArray eventManagerArray i\n  case old of\n    Nothing     -> create\n    Just (t,em) -> do\n      s <- threadStatus t\n      case s of\n        ThreadFinished -> create\n        ThreadDied     -> do\n          -- Sanity check: if the thread has died, there is a chance\n          -- that event manager is still alive. This could happend during\n          -- the fork, for example. In this case we should clean up\n          -- open pipes and everything else related to the event manager.\n          -- See #4449\n          c_setIOManagerControlFd (fromIntegral i) (-1)\n          M.cleanup em\n          create\n        _other         -> return ()\n\nstartTimerManagerThread :: IO ()\nstartTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \\old -> do\n  let create = do\n        !mgr <- TM.new\n        c_setTimerManagerControlFd\n          (fromIntegral $ controlWriteFd $ TM.emControl mgr)\n        writeIORef timerManager $ Just mgr\n        !t <- forkIO $ TM.loop mgr\n        labelThread t \"TimerManager\"\n        return $ Just t\n  case old of\n    Nothing            -> create\n    st@(Just t) -> do\n      s <- threadStatus t\n      case s of\n        ThreadFinished -> create\n        ThreadDied     -> do\n          -- Sanity check: if the thread has died, there is a chance\n          -- that event manager is still alive. This could happend during\n          -- the fork, for example. In this case we should clean up\n          -- open pipes and everything else related to the event manager.\n          -- See #4449\n          mem <- readIORef timerManager\n          _ <- case mem of\n                 Nothing -> return ()\n                 Just em -> do c_setTimerManagerControlFd (-1)\n                               TM.cleanup em\n          create\n        _other         -> return st\n\nforeign import ccall unsafe \"rtsSupportsBoundThreads\" threaded :: Bool\n\nioManagerCapabilitiesChanged :: IO ()\nioManagerCapabilitiesChanged = do\n  withMVar ioManagerLock $ \\_ -> do\n    new_n_caps <- getNumCapabilities\n    numEnabled <- readIORef numEnabledEventManagers\n    writeIORef numEnabledEventManagers new_n_caps\n    eventManagerArray <- readIORef eventManager\n    let (_, high) = boundsIOArray eventManagerArray\n    let old_n_caps = high + 1\n    if new_n_caps > old_n_caps\n      then do new_eventManagerArray <- newIOArray (0, new_n_caps - 1) Nothing\n\n              -- copy the existing values into the new array:\n              forM_ [0..high] $ \\i -> do\n                Just (tid,mgr) <- readIOArray eventManagerArray i\n                if i < numEnabled\n                  then writeIOArray new_eventManagerArray i (Just (tid,mgr))\n                  else do tid' <- restartPollLoop mgr i\n                          writeIOArray new_eventManagerArray i (Just (tid',mgr))\n\n              -- create new IO managers for the new caps:\n              forM_ [old_n_caps..new_n_caps-1] $\n                startIOManagerThread new_eventManagerArray\n\n              -- update the event manager array reference:\n              writeIORef eventManager new_eventManagerArray\n      else when (new_n_caps > numEnabled) $\n            forM_ [numEnabled..new_n_caps-1] $ \\i -> do\n              Just (_,mgr) <- readIOArray eventManagerArray i\n              tid <- restartPollLoop mgr i\n              writeIOArray eventManagerArray i (Just (tid,mgr))\n\n-- Used to tell the RTS how it can send messages to the I/O manager.\nforeign import ccall unsafe \"setIOManagerControlFd\"\n   c_setIOManagerControlFd :: CUInt -> CInt -> IO ()\n\nforeign import ccall unsafe \"setTimerManagerControlFd\"\n   c_setTimerManagerControlFd :: CInt -> IO ()\n", "num_lines": 363}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE BangPatterns\n           , CPP\n           , ExistentialQuantification\n           , NoImplicitPrelude\n           , TypeSynonymInstances\n           , FlexibleInstances\n  #-}\n\nmodule GHC.Event.TimerManager\n    ( -- * Types\n      TimerManager\n\n      -- * Creation\n    , new\n    , newWith\n    , newDefaultBackend\n    , emControl\n\n      -- * Running\n    , finished\n    , loop\n    , step\n    , shutdown\n    , cleanup\n    , wakeManager\n\n      -- * Registering interest in timeout events\n    , TimeoutCallback\n    , TimeoutKey\n    , registerTimeout\n    , updateTimeout\n    , unregisterTimeout\n    ) where\n\n#include \"EventConfig.h\"\n\n------------------------------------------------------------------------\n-- Imports\n\nimport Control.Exception (finally)\nimport Data.Foldable (sequence_)\nimport Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,\n                   writeIORef)\nimport GHC.Base\nimport GHC.Clock (getMonotonicTimeNSec)\nimport GHC.Conc.Signal (runHandlers)\nimport GHC.Enum (maxBound)\nimport GHC.Num (Num(..))\nimport GHC.Real (quot, fromIntegral)\nimport GHC.Show (Show(..))\nimport GHC.Event.Control\nimport GHC.Event.Internal (Backend, Event, evtRead, Timeout(..))\nimport GHC.Event.Unique (Unique, UniqueSource, newSource, newUnique)\nimport System.Posix.Types (Fd)\n\nimport qualified GHC.Event.Internal as I\nimport qualified GHC.Event.PSQ as Q\n\n#if defined(HAVE_POLL)\nimport qualified GHC.Event.Poll   as Poll\n#else\n# error not implemented for this operating system\n#endif\n\n------------------------------------------------------------------------\n-- Types\n\n-- | A timeout registration cookie.\nnewtype TimeoutKey   = TK Unique\n    deriving Eq -- ^ @since 4.7.0.0\n\n-- | Callback invoked on timeout events.\ntype TimeoutCallback = IO ()\n\ndata State = Created\n           | Running\n           | Dying\n           | Finished\n             deriving ( Eq   -- ^ @since 4.7.0.0\n                      , Show -- ^ @since 4.7.0.0\n                      )\n\n-- | A priority search queue, with timeouts as priorities.\ntype TimeoutQueue = Q.PSQ TimeoutCallback\n\n-- | An edit to apply to a 'TimeoutQueue'.\ntype TimeoutEdit = TimeoutQueue -> TimeoutQueue\n\n-- | The event manager state.\ndata TimerManager = TimerManager\n    { emBackend      :: !Backend\n    , emTimeouts     :: {-# UNPACK #-} !(IORef TimeoutQueue)\n    , emState        :: {-# UNPACK #-} !(IORef State)\n    , emUniqueSource :: {-# UNPACK #-} !UniqueSource\n    , emControl      :: {-# UNPACK #-} !Control\n    }\n\n------------------------------------------------------------------------\n-- Creation\n\nhandleControlEvent :: TimerManager -> Fd -> Event -> IO ()\nhandleControlEvent mgr fd _evt = do\n  msg <- readControlMessage (emControl mgr) fd\n  case msg of\n    CMsgWakeup      -> return ()\n    CMsgDie         -> writeIORef (emState mgr) Finished\n    CMsgSignal fp s -> runHandlers fp s\n\nnewDefaultBackend :: IO Backend\n#if defined(HAVE_POLL)\nnewDefaultBackend = Poll.new\n#else\nnewDefaultBackend = errorWithoutStackTrace \"no back end for this platform\"\n#endif\n\n-- | Create a new event manager.\nnew :: IO TimerManager\nnew = newWith =<< newDefaultBackend\n\nnewWith :: Backend -> IO TimerManager\nnewWith be = do\n  timeouts <- newIORef Q.empty\n  ctrl <- newControl True\n  state <- newIORef Created\n  us <- newSource\n  _ <- mkWeakIORef state $ do\n               st <- atomicModifyIORef' state $ \\s -> (Finished, s)\n               when (st /= Finished) $ do\n                 I.delete be\n                 closeControl ctrl\n  let mgr = TimerManager { emBackend = be\n                         , emTimeouts = timeouts\n                         , emState = state\n                         , emUniqueSource = us\n                         , emControl = ctrl\n                         }\n  _ <- I.modifyFd be (controlReadFd ctrl) mempty evtRead\n  _ <- I.modifyFd be (wakeupReadFd ctrl) mempty evtRead\n  return mgr\n\n-- | Asynchronously shuts down the event manager, if running.\nshutdown :: TimerManager -> IO ()\nshutdown mgr = do\n  state <- atomicModifyIORef' (emState mgr) $ \\s -> (Dying, s)\n  when (state == Running) $ sendDie (emControl mgr)\n\nfinished :: TimerManager -> IO Bool\nfinished mgr = (== Finished) `liftM` readIORef (emState mgr)\n\ncleanup :: TimerManager -> IO ()\ncleanup mgr = do\n  writeIORef (emState mgr) Finished\n  I.delete (emBackend mgr)\n  closeControl (emControl mgr)\n\n------------------------------------------------------------------------\n-- Event loop\n\n-- | Start handling events.  This function loops until told to stop,\n-- using 'shutdown'.\n--\n-- /Note/: This loop can only be run once per 'TimerManager', as it\n-- closes all of its control resources when it finishes.\nloop :: TimerManager -> IO ()\nloop mgr = do\n  state <- atomicModifyIORef' (emState mgr) $ \\s -> case s of\n    Created -> (Running, s)\n    _       -> (s, s)\n  case state of\n    Created -> go `finally` cleanup mgr\n    Dying   -> cleanup mgr\n    _       -> do cleanup mgr\n                  errorWithoutStackTrace $ \"GHC.Event.Manager.loop: state is already \" ++\n                      show state\n where\n  go = do running <- step mgr\n          when running go\n\nstep :: TimerManager -> IO Bool\nstep mgr = do\n  timeout <- mkTimeout\n  _ <- I.poll (emBackend mgr) (Just timeout) (handleControlEvent mgr)\n  state <- readIORef (emState mgr)\n  state `seq` return (state == Running)\n where\n\n  -- | Call all expired timer callbacks and return the time to the\n  -- next timeout.\n  mkTimeout :: IO Timeout\n  mkTimeout = do\n      now <- getMonotonicTimeNSec\n      (expired, timeout) <- atomicModifyIORef' (emTimeouts mgr) $ \\tq ->\n           let (expired, tq') = Q.atMost now tq\n               timeout = case Q.minView tq' of\n                 Nothing             -> Forever\n                 Just (Q.E _ t _, _) ->\n                     -- This value will always be positive since the call\n                     -- to 'atMost' above removed any timeouts <= 'now'\n                     let t' = t - now in t' `seq` Timeout t'\n           in (tq', (expired, timeout))\n      sequence_ $ map Q.value expired\n      return timeout\n\n-- | Wake up the event manager.\nwakeManager :: TimerManager -> IO ()\nwakeManager mgr = sendWakeup (emControl mgr)\n\n------------------------------------------------------------------------\n-- Registering interest in timeout events\n\nexpirationTime :: Int -> IO Q.Prio\nexpirationTime us = do\n    now <- getMonotonicTimeNSec\n    let expTime\n          -- Currently we treat overflows by clamping to maxBound. If humanity\n          -- still exists in 2500 CE we will ned to be a bit more careful here.\n          -- See #15158.\n          | (maxBound - now) `quot` 1000 < fromIntegral us  = maxBound\n          | otherwise                                       = now + ns\n          where ns = 1000 * fromIntegral us\n    return expTime\n\n-- | Register a timeout in the given number of microseconds.  The\n-- returned 'TimeoutKey' can be used to later unregister or update the\n-- timeout.  The timeout is automatically unregistered after the given\n-- time has passed.\nregisterTimeout :: TimerManager -> Int -> TimeoutCallback -> IO TimeoutKey\nregisterTimeout mgr us cb = do\n  !key <- newUnique (emUniqueSource mgr)\n  if us <= 0 then cb\n    else do\n      expTime <- expirationTime us\n\n      -- \"unsafeInsertNew\" is safe - the key must not exist in the PSQ. It\n      -- doesn't because we just generated it from a unique supply.\n      editTimeouts mgr (Q.unsafeInsertNew key expTime cb)\n  return $ TK key\n\n-- | Unregister an active timeout.\nunregisterTimeout :: TimerManager -> TimeoutKey -> IO ()\nunregisterTimeout mgr (TK key) = do\n  editTimeouts mgr (Q.delete key)\n\n-- | Update an active timeout to fire in the given number of\n-- microseconds.\nupdateTimeout :: TimerManager -> TimeoutKey -> Int -> IO ()\nupdateTimeout mgr (TK key) us = do\n  expTime <- expirationTime us\n  editTimeouts mgr (Q.adjust (const expTime) key)\n\neditTimeouts :: TimerManager -> TimeoutEdit -> IO ()\neditTimeouts mgr g = do\n  wake <- atomicModifyIORef' (emTimeouts mgr) f\n  when wake (wakeManager mgr)\n  where\n    f q = (q', wake)\n      where\n        q' = g q\n        wake = case Q.minView q of\n                Nothing -> True\n                Just (Q.E _ t0 _, _) ->\n                  case Q.minView q' of\n                    Just (Q.E _ t1 _, _) ->\n                      -- don't wake the manager if the\n                      -- minimum element didn't change.\n                      t0 /= t1\n                    _ -> True\n", "num_lines": 269}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,\n  NoImplicitPrelude, UnboxedTuples #-}\n\nmodule GHC.Event.Unique\n    (\n      UniqueSource\n    , Unique(..)\n    , newSource\n    , newUnique\n    ) where\n\nimport GHC.Base\nimport GHC.Num(Num)\nimport GHC.Show(Show(..))\n\n#include \"MachDeps.h\"\n\ndata UniqueSource = US (MutableByteArray# RealWorld)\n\nnewtype Unique = Unique { asInt :: Int }\n    deriving ( Eq  -- ^ @since 4.4.0.0\n             , Ord -- ^ @since 4.4.0.0\n             , Num -- ^ @since 4.4.0.0\n             )\n\n-- | @since 4.3.1.0\ninstance Show Unique where\n    show = show . asInt\n\nnewSource :: IO UniqueSource\nnewSource = IO $ \\s ->\n  case newByteArray# size s of\n    (# s', mba #) -> (# s', US mba #)\n  where\n    !(I# size) = SIZEOF_HSINT\n\nnewUnique :: UniqueSource -> IO Unique\nnewUnique (US mba) = IO $ \\s ->\n  case fetchAddIntArray# mba 0# 1# s of\n    (# s', a #) -> (# s', Unique (I# a) #)\n{-# INLINE newUnique #-}\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , ExistentialQuantification\n           , MagicHash\n           , RecordWildCards\n           , PatternSynonyms\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Exception.Type\n-- Copyright   :  (c) The University of Glasgow, 1998-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Exceptions and exception-handling functions.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Exception.Type\n       ( Exception(..)    -- Class\n       , SomeException(..), ArithException(..)\n       , divZeroException, overflowException, ratioZeroDenomException\n       , underflowException\n       ) where\n\nimport Data.Maybe\nimport Data.Typeable (Typeable, cast)\n   -- loop: Data.Typeable -> GHC.Err -> GHC.Exception\nimport GHC.Base\nimport GHC.Show\n\n{- |\nThe @SomeException@ type is the root of the exception type hierarchy.\nWhen an exception of type @e@ is thrown, behind the scenes it is\nencapsulated in a @SomeException@.\n-}\ndata SomeException = forall e . Exception e => SomeException e\n\n-- | @since 3.0\ninstance Show SomeException where\n    showsPrec p (SomeException e) = showsPrec p e\n\n{- |\nAny type that you wish to throw or catch as an exception must be an\ninstance of the @Exception@ class. The simplest case is a new exception\ntype directly below the root:\n\n> data MyException = ThisException | ThatException\n>     deriving Show\n>\n> instance Exception MyException\n\nThe default method definitions in the @Exception@ class do what we need\nin this case. You can now throw and catch @ThisException@ and\n@ThatException@ as exceptions:\n\n@\n*Main> throw ThisException \\`catch\\` \\\\e -> putStrLn (\\\"Caught \\\" ++ show (e :: MyException))\nCaught ThisException\n@\n\nIn more complicated examples, you may wish to define a whole hierarchy\nof exceptions:\n\n> ---------------------------------------------------------------------\n> -- Make the root exception type for all the exceptions in a compiler\n>\n> data SomeCompilerException = forall e . Exception e => SomeCompilerException e\n>\n> instance Show SomeCompilerException where\n>     show (SomeCompilerException e) = show e\n>\n> instance Exception SomeCompilerException\n>\n> compilerExceptionToException :: Exception e => e -> SomeException\n> compilerExceptionToException = toException . SomeCompilerException\n>\n> compilerExceptionFromException :: Exception e => SomeException -> Maybe e\n> compilerExceptionFromException x = do\n>     SomeCompilerException a <- fromException x\n>     cast a\n>\n> ---------------------------------------------------------------------\n> -- Make a subhierarchy for exceptions in the frontend of the compiler\n>\n> data SomeFrontendException = forall e . Exception e => SomeFrontendException e\n>\n> instance Show SomeFrontendException where\n>     show (SomeFrontendException e) = show e\n>\n> instance Exception SomeFrontendException where\n>     toException = compilerExceptionToException\n>     fromException = compilerExceptionFromException\n>\n> frontendExceptionToException :: Exception e => e -> SomeException\n> frontendExceptionToException = toException . SomeFrontendException\n>\n> frontendExceptionFromException :: Exception e => SomeException -> Maybe e\n> frontendExceptionFromException x = do\n>     SomeFrontendException a <- fromException x\n>     cast a\n>\n> ---------------------------------------------------------------------\n> -- Make an exception type for a particular frontend compiler exception\n>\n> data MismatchedParentheses = MismatchedParentheses\n>     deriving Show\n>\n> instance Exception MismatchedParentheses where\n>     toException   = frontendExceptionToException\n>     fromException = frontendExceptionFromException\n\nWe can now catch a @MismatchedParentheses@ exception as\n@MismatchedParentheses@, @SomeFrontendException@ or\n@SomeCompilerException@, but not other types, e.g. @IOException@:\n\n@\n*Main> throw MismatchedParentheses \\`catch\\` \\\\e -> putStrLn (\\\"Caught \\\" ++ show (e :: MismatchedParentheses))\nCaught MismatchedParentheses\n*Main> throw MismatchedParentheses \\`catch\\` \\\\e -> putStrLn (\\\"Caught \\\" ++ show (e :: SomeFrontendException))\nCaught MismatchedParentheses\n*Main> throw MismatchedParentheses \\`catch\\` \\\\e -> putStrLn (\\\"Caught \\\" ++ show (e :: SomeCompilerException))\nCaught MismatchedParentheses\n*Main> throw MismatchedParentheses \\`catch\\` \\\\e -> putStrLn (\\\"Caught \\\" ++ show (e :: IOException))\n*** Exception: MismatchedParentheses\n@\n\n-}\nclass (Typeable e, Show e) => Exception e where\n    toException   :: e -> SomeException\n    fromException :: SomeException -> Maybe e\n\n    toException = SomeException\n    fromException (SomeException e) = cast e\n\n    -- | Render this exception value in a human-friendly manner.\n    --\n    -- Default implementation: @'show'@.\n    --\n    -- @since 4.8.0.0\n    displayException :: e -> String\n    displayException = show\n\n-- | @since 3.0\ninstance Exception SomeException where\n    toException se = se\n    fromException = Just\n    displayException (SomeException e) = displayException e\n\n-- |Arithmetic exceptions.\ndata ArithException\n  = Overflow\n  | Underflow\n  | LossOfPrecision\n  | DivideByZero\n  | Denormal\n  | RatioZeroDenominator -- ^ @since 4.6.0.0\n  deriving ( Eq  -- ^ @since 3.0\n           , Ord -- ^ @since 3.0\n           )\n\ndivZeroException, overflowException, ratioZeroDenomException, underflowException  :: SomeException\ndivZeroException        = toException DivideByZero\noverflowException       = toException Overflow\nratioZeroDenomException = toException RatioZeroDenominator\nunderflowException      = toException Underflow\n\n-- | @since 4.0.0.0\ninstance Exception ArithException\n\n-- | @since 4.0.0.0\ninstance Show ArithException where\n  showsPrec _ Overflow        = showString \"arithmetic overflow\"\n  showsPrec _ Underflow       = showString \"arithmetic underflow\"\n  showsPrec _ LossOfPrecision = showString \"loss of precision\"\n  showsPrec _ DivideByZero    = showString \"divide by zero\"\n  showsPrec _ Denormal        = showString \"denormal\"\n  showsPrec _ RatioZeroDenominator = showString \"Ratio has zero denominator\"\n", "num_lines": 184}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-- ----------------------------------------------------------------------------\n--\n--  (c) The University of Glasgow 2006\n--\n-- Fingerprints for recompilation checking and ABI versioning, and\n-- implementing fast comparison of Typeable.\n--\n-- ----------------------------------------------------------------------------\n\nmodule GHC.Fingerprint.Type (Fingerprint(..)) where\n\nimport GHC.Base\nimport GHC.List (length, replicate)\nimport GHC.Num\nimport GHC.Show\nimport GHC.Word\nimport Numeric (showHex)\n\n-- Using 128-bit MD5 fingerprints for now.\n\ndata Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64\n  deriving ( Eq  -- ^ @since 4.4.0.0\n           , Ord -- ^ @since 4.4.0.0\n           )\n\n-- | @since 4.7.0.0\ninstance Show Fingerprint where\n  show (Fingerprint w1 w2) = hex16 w1 ++ hex16 w2\n    where\n      -- | Formats a 64 bit number as 16 digits hex.\n      hex16 :: Word64 -> String\n      hex16 i = let hex = showHex i \"\"\n                 in replicate (16 - length hex) '0' ++ hex\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}\n{-# OPTIONS_GHC -O2 #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Float.ConversionUtils\n-- Copyright   :  (c) Daniel Fischer 2010\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Utilities for conversion between Double/Float and Rational\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where\n\nimport GHC.Base\nimport GHC.Integer\n#if WORD_SIZE_IN_BITS < 64\nimport GHC.IntWord64\n#endif\n\ndefault ()\n\n#if WORD_SIZE_IN_BITS < 64\n\n#define TO64    integerToInt64\n\ntoByte64# :: Int64# -> Int#\ntoByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))\n\n-- Double mantissae have 53 bits, too much for Int#\nelim64# :: Int64# -> Int# -> (# Integer, Int# #)\nelim64# n e =\n    case zeroCount (toByte64# n) of\n      t | isTrue# (e <=# t) -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)\n        | isTrue# (t <# 8#) -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)\n        | otherwise         -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)\n\n#else\n\n#define TO64    integerToInt\n\n-- Double mantissae fit it Int#\nelim64# :: Int# -> Int# -> (# Integer, Int# #)\nelim64# = elimZerosInt#\n\n#endif\n\n{-# INLINE elimZerosInteger #-}\nelimZerosInteger :: Integer -> Int# -> (# Integer, Int# #)\nelimZerosInteger m e = elim64# (TO64 m) e\n\nelimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)\nelimZerosInt# n e =\n    case zeroCount (toByte# n) of\n      t | isTrue# (e <=# t) -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)\n        | isTrue# (t <# 8#) -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)\n        | otherwise         -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)\n\n{-# INLINE zeroCount #-}\nzeroCount :: Int# -> Int#\nzeroCount i =\n    case zeroCountArr of\n      BA ba -> indexInt8Array# ba i\n\ntoByte# :: Int# -> Int#\ntoByte# i = word2Int# (and# 255## (int2Word# i))\n\n\ndata BA = BA ByteArray#\n\n-- Number of trailing zero bits in a byte\nzeroCountArr :: BA\nzeroCountArr =\n    let mkArr s =\n          case newByteArray# 256# s of\n            (# s1, mba #) ->\n              case writeInt8Array# mba 0# 8# s1 of\n                s2 ->\n                  let fillA step val idx st\n                        | isTrue# (idx <# 256#) =\n                                        case writeInt8Array# mba idx val st of\n                                          nx -> fillA step val (idx +# step) nx\n                        | isTrue# (step <# 256#) =\n                                        fillA (2# *# step) (val +# 1#) step  st\n                        | otherwise   = st\n                  in case fillA 2# 0# 1# s2 of\n                       s3 -> case unsafeFreezeByteArray# mba s3 of\n                                (# _, ba #) -> ba\n    in case mkArr realWorld# of\n        b -> BA b\n\n", "num_lines": 101}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Float.RealFracMethods\n-- Copyright   :  (c) Daniel Fischer 2010\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Methods for the RealFrac instances for 'Float' and 'Double',\n-- with specialised versions for 'Int'.\n--\n-- Moved to their own module to not bloat GHC.Float further.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Float.RealFracMethods\n    ( -- * Double methods\n      -- ** Integer results\n      properFractionDoubleInteger\n    , truncateDoubleInteger\n    , floorDoubleInteger\n    , ceilingDoubleInteger\n    , roundDoubleInteger\n      -- ** Int results\n    , properFractionDoubleInt\n    , floorDoubleInt\n    , ceilingDoubleInt\n    , roundDoubleInt\n      -- * Double/Int conversions, wrapped primops\n    , double2Int\n    , int2Double\n      -- * Float methods\n      -- ** Integer results\n    , properFractionFloatInteger\n    , truncateFloatInteger\n    , floorFloatInteger\n    , ceilingFloatInteger\n    , roundFloatInteger\n      -- ** Int results\n    , properFractionFloatInt\n    , floorFloatInt\n    , ceilingFloatInt\n    , roundFloatInt\n      -- * Float/Int conversions, wrapped primops\n    , float2Int\n    , int2Float\n    ) where\n\nimport GHC.Integer\n\nimport GHC.Base\nimport GHC.Num ()\n\n#if WORD_SIZE_IN_BITS < 64\n\nimport GHC.IntWord64\n\n#define TO64 integerToInt64\n#define FROM64 int64ToInteger\n#define MINUS64 minusInt64#\n#define NEGATE64 negateInt64#\n\n#else\n\n#define TO64 integerToInt\n#define FROM64 smallInteger\n#define MINUS64 ( -# )\n#define NEGATE64 negateInt#\n\nuncheckedIShiftRA64# :: Int# -> Int# -> Int#\nuncheckedIShiftRA64# = uncheckedIShiftRA#\n\nuncheckedIShiftL64# :: Int# -> Int# -> Int#\nuncheckedIShiftL64# = uncheckedIShiftL#\n\n#endif\n\ndefault ()\n\n------------------------------------------------------------------------------\n--                              Float Methods                               --\n------------------------------------------------------------------------------\n\n-- Special Functions for Int, nice, easy and fast.\n-- They should be small enough to be inlined automatically.\n\n-- We have to test for \u00c2\u00b10.0 to avoid returning -0.0 in the second\n-- component of the pair. Unfortunately the branching costs a lot\n-- of performance.\nproperFractionFloatInt :: Float -> (Int, Float)\nproperFractionFloatInt (F# x) =\n    if isTrue# (x `eqFloat#` 0.0#)\n        then (I# 0#, F# 0.0#)\n        else case float2Int# x of\n                n -> (I# n, F# (x `minusFloat#` int2Float# n))\n\n-- truncateFloatInt = float2Int\n\nfloorFloatInt :: Float -> Int\nfloorFloatInt (F# x) =\n    case float2Int# x of\n      n | isTrue# (x `ltFloat#` int2Float# n) -> I# (n -# 1#)\n        | otherwise                           -> I# n\n\nceilingFloatInt :: Float -> Int\nceilingFloatInt (F# x) =\n    case float2Int# x of\n      n | isTrue# (int2Float# n `ltFloat#` x) -> I# (n +# 1#)\n        | otherwise                           -> I# n\n\nroundFloatInt :: Float -> Int\nroundFloatInt x = float2Int (c_rintFloat x)\n\n-- Functions with Integer results\n\n-- With the new code generator in GHC 7, the explicit bit-fiddling is\n-- slower than the old code for values of small modulus, but when the\n-- 'Int' range is left, the bit-fiddling quickly wins big, so we use that.\n-- If the methods are called on smallish values, hopefully people go\n-- through Int and not larger types.\n\n-- Note: For negative exponents, we must check the validity of the shift\n-- distance for the right shifts of the mantissa.\n\n{-# INLINE properFractionFloatInteger #-}\nproperFractionFloatInteger :: Float -> (Integer, Float)\nproperFractionFloatInteger v@(F# x) =\n    case decodeFloat_Int# x of\n      (# m, e #)\n        | isTrue# (e <# 0#) ->\n          case negateInt# e of\n            s | isTrue# (s ># 23#) -> (0, v)\n              | isTrue# (m <#  0#) ->\n                case negateInt# (negateInt# m `uncheckedIShiftRA#` s) of\n                  k -> (smallInteger k,\n                            case m -# (k `uncheckedIShiftL#` s) of\n                              r -> F# (encodeFloatInteger (smallInteger r) e))\n              | otherwise           ->\n                case m `uncheckedIShiftRL#` s of\n                  k -> (smallInteger k,\n                            case m -# (k `uncheckedIShiftL#` s) of\n                              r -> F# (encodeFloatInteger (smallInteger r) e))\n        | otherwise -> (shiftLInteger (smallInteger m) e, F# 0.0#)\n\n{-# INLINE truncateFloatInteger #-}\ntruncateFloatInteger :: Float -> Integer\ntruncateFloatInteger x =\n    case properFractionFloatInteger x of\n      (n, _) -> n\n\n-- floor is easier for negative numbers than truncate, so this gets its\n-- own implementation, it's a little faster.\n{-# INLINE floorFloatInteger #-}\nfloorFloatInteger :: Float -> Integer\nfloorFloatInteger (F# x) =\n    case decodeFloat_Int# x of\n      (# m, e #)\n        | isTrue# (e <# 0#) ->\n          case negateInt# e of\n            s | isTrue# (s ># 23#) -> if isTrue# (m <# 0#) then (-1) else 0\n              | otherwise          -> smallInteger (m `uncheckedIShiftRA#` s)\n        | otherwise -> shiftLInteger (smallInteger m) e\n\n-- ceiling x = -floor (-x)\n-- If giving this its own implementation is faster at all,\n-- it's only marginally so, hence we keep it short.\n{-# INLINE ceilingFloatInteger #-}\nceilingFloatInteger :: Float -> Integer\nceilingFloatInteger (F# x) =\n    negateInteger (floorFloatInteger (F# (negateFloat# x)))\n\n{-# INLINE roundFloatInteger #-}\nroundFloatInteger :: Float -> Integer\nroundFloatInteger x = float2Integer (c_rintFloat x)\n\n------------------------------------------------------------------------------\n--                              Double Methods                              --\n------------------------------------------------------------------------------\n\n-- Special Functions for Int, nice, easy and fast.\n-- They should be small enough to be inlined automatically.\n\n-- We have to test for \u00c2\u00b10.0 to avoid returning -0.0 in the second\n-- component of the pair. Unfortunately the branching costs a lot\n-- of performance.\nproperFractionDoubleInt :: Double -> (Int, Double)\nproperFractionDoubleInt (D# x) =\n    if isTrue# (x ==## 0.0##)\n        then (I# 0#, D# 0.0##)\n        else case double2Int# x of\n                n -> (I# n, D# (x -## int2Double# n))\n\n-- truncateDoubleInt = double2Int\n\nfloorDoubleInt :: Double -> Int\nfloorDoubleInt (D# x) =\n    case double2Int# x of\n      n | isTrue# (x <## int2Double# n) -> I# (n -# 1#)\n        | otherwise                     -> I# n\n\nceilingDoubleInt :: Double -> Int\nceilingDoubleInt (D# x) =\n    case double2Int# x of\n      n | isTrue# (int2Double# n <## x) -> I# (n +# 1#)\n        | otherwise                     -> I# n\n\nroundDoubleInt :: Double -> Int\nroundDoubleInt x = double2Int (c_rintDouble x)\n\n-- Functions with Integer results\n\n-- The new Code generator isn't quite as good for the old 'Double' code\n-- as for the 'Float' code, so for 'Double' the bit-fiddling also wins\n-- when the values have small modulus.\n\n-- When the exponent is negative, all mantissae have less than 64 bits\n-- and the right shifting of sized types is much faster than that of\n-- 'Integer's, especially when we can\n\n-- Note: For negative exponents, we must check the validity of the shift\n-- distance for the right shifts of the mantissa.\n\n{-# INLINE properFractionDoubleInteger #-}\nproperFractionDoubleInteger :: Double -> (Integer, Double)\nproperFractionDoubleInteger v@(D# x) =\n    case decodeDoubleInteger x of\n      (# m, e #)\n        | isTrue# (e <# 0#) ->\n          case negateInt# e of\n            s | isTrue# (s ># 52#) -> (0, v)\n              | m < 0                 ->\n                case TO64 (negateInteger m) of\n                  n ->\n                    case n `uncheckedIShiftRA64#` s of\n                      k ->\n                        (FROM64 (NEGATE64 k),\n                          case MINUS64 n (k `uncheckedIShiftL64#` s) of\n                            r ->\n                              D# (encodeDoubleInteger (FROM64 (NEGATE64 r)) e))\n              | otherwise           ->\n                case TO64 m of\n                  n ->\n                    case n `uncheckedIShiftRA64#` s of\n                      k -> (FROM64 k,\n                            case MINUS64 n (k `uncheckedIShiftL64#` s) of\n                              r -> D# (encodeDoubleInteger (FROM64 r) e))\n        | otherwise -> (shiftLInteger m e, D# 0.0##)\n\n{-# INLINE truncateDoubleInteger #-}\ntruncateDoubleInteger :: Double -> Integer\ntruncateDoubleInteger x =\n    case properFractionDoubleInteger x of\n      (n, _) -> n\n\n-- floor is easier for negative numbers than truncate, so this gets its\n-- own implementation, it's a little faster.\n{-# INLINE floorDoubleInteger #-}\nfloorDoubleInteger :: Double -> Integer\nfloorDoubleInteger (D# x) =\n    case decodeDoubleInteger x of\n      (# m, e #)\n        | isTrue# (e <# 0#) ->\n          case negateInt# e of\n            s | isTrue# (s ># 52#) -> if m < 0 then (-1) else 0\n              | otherwise          ->\n                case TO64 m of\n                  n -> FROM64 (n `uncheckedIShiftRA64#` s)\n        | otherwise -> shiftLInteger m e\n\n{-# INLINE ceilingDoubleInteger #-}\nceilingDoubleInteger :: Double -> Integer\nceilingDoubleInteger (D# x) =\n    negateInteger (floorDoubleInteger (D# (negateDouble# x)))\n\n{-# INLINE roundDoubleInteger #-}\nroundDoubleInteger :: Double -> Integer\nroundDoubleInteger x = double2Integer (c_rintDouble x)\n\n-- Wrappers around double2Int#, int2Double#, float2Int# and int2Float#,\n-- we need them here, so we move them from GHC.Float and re-export them\n-- explicitly from there.\n\ndouble2Int :: Double -> Int\ndouble2Int (D# x) = I# (double2Int# x)\n\nint2Double :: Int -> Double\nint2Double (I# i) = D# (int2Double# i)\n\nfloat2Int :: Float -> Int\nfloat2Int (F# x) = I# (float2Int# x)\n\nint2Float :: Int -> Float\nint2Float (I# i) = F# (int2Float# i)\n\n-- Quicker conversions from 'Double' and 'Float' to 'Integer',\n-- assuming the floating point value is integral.\n--\n-- Note: Since the value is integral, the exponent can't be less than\n-- (-TYP_MANT_DIG), so we need not check the validity of the shift\n-- distance for the right shfts here.\n\n{-# INLINE double2Integer #-}\ndouble2Integer :: Double -> Integer\ndouble2Integer (D# x) =\n    case decodeDoubleInteger x of\n      (# m, e #)\n        | isTrue# (e <# 0#) ->\n          case TO64 m of\n            n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)\n        | otherwise -> shiftLInteger m e\n\n{-# INLINE float2Integer #-}\nfloat2Integer :: Float -> Integer\nfloat2Integer (F# x) =\n    case decodeFloat_Int# x of\n      (# m, e #)\n        | isTrue# (e <# 0#) -> smallInteger (m `uncheckedIShiftRA#` negateInt# e)\n        | otherwise         -> shiftLInteger (smallInteger m) e\n\n-- Foreign imports, the rounding is done faster in C when the value\n-- isn't integral, so we call out for rounding. For values of large\n-- modulus, calling out to C is slower than staying in Haskell, but\n-- presumably 'round' is mostly called for values with smaller modulus,\n-- when calling out to C is a major win.\n-- For all other functions, calling out to C gives at most a marginal\n-- speedup for values of small modulus and is much slower than staying\n-- in Haskell for values of large modulus, so those are done in Haskell.\n\nforeign import ccall unsafe \"rintDouble\"\n    c_rintDouble :: Double -> Double\n\nforeign import ccall unsafe \"rintFloat\"\n    c_rintFloat :: Float -> Float\n\n", "num_lines": 343}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy, BangPatterns #-}\n{-# LANGUAGE CPP, NoImplicitPrelude #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Buffer\n-- Copyright   :  (c) The University of Glasgow 2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Buffers used in the IO system\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Buffer (\n    -- * Buffers of any element\n    Buffer(..), BufferState(..), CharBuffer, CharBufElem,\n\n    -- ** Creation\n    newByteBuffer,\n    newCharBuffer,\n    newBuffer,\n    emptyBuffer,\n\n    -- ** Insertion/removal\n    bufferRemove,\n    bufferAdd,\n    slideContents,\n    bufferAdjustL,\n\n    -- ** Inspecting\n    isEmptyBuffer,\n    isFullBuffer,\n    isFullCharBuffer,\n    isWriteBuffer,\n    bufferElems,\n    bufferAvailable,\n    summaryBuffer,\n\n    -- ** Operating on the raw buffer as a Ptr\n    withBuffer,\n    withRawBuffer,\n\n    -- ** Assertions\n    checkBuffer,\n\n    -- * Raw buffers\n    RawBuffer,\n    readWord8Buf,\n    writeWord8Buf,\n    RawCharBuffer,\n    peekCharBuf,\n    readCharBuf,\n    writeCharBuf,\n    readCharBufPtr,\n    writeCharBufPtr,\n    charSize,\n ) where\n\nimport GHC.Base\n-- import GHC.IO\nimport GHC.Num\nimport GHC.Ptr\nimport GHC.Word\nimport GHC.Show\nimport GHC.Real\nimport Foreign.C.Types\nimport Foreign.ForeignPtr\nimport Foreign.Storable\n\n-- Char buffers use either UTF-16 or UTF-32, with the endianness matching\n-- the endianness of the host.\n--\n-- Invariants:\n--   * a Char buffer consists of *valid* UTF-16 or UTF-32\n--   * only whole characters: no partial surrogate pairs\n\n#define CHARBUF_UTF32\n\n-- #define CHARBUF_UTF16\n--\n-- NB. it won't work to just change this to CHARBUF_UTF16.  Some of\n-- the code to make this work is there, and it has been tested with\n-- the Iconv codec, but there are some pieces that are known to be\n-- broken.  In particular, the built-in codecs\n-- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or\n-- similar in place of the ow >= os comparisons.\n\n-- ---------------------------------------------------------------------------\n-- Raw blocks of data\n\ntype RawBuffer e = ForeignPtr e\n\nreadWord8Buf :: RawBuffer Word8 -> Int -> IO Word8\nreadWord8Buf arr ix = withForeignPtr arr $ \\p -> peekByteOff p ix\n\nwriteWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()\nwriteWord8Buf arr ix w = withForeignPtr arr $ \\p -> pokeByteOff p ix w\n\n#if defined(CHARBUF_UTF16)\ntype CharBufElem = Word16\n#else\ntype CharBufElem = Char\n#endif\n\ntype RawCharBuffer = RawBuffer CharBufElem\n\npeekCharBuf :: RawCharBuffer -> Int -> IO Char\npeekCharBuf arr ix = withForeignPtr arr $ \\p -> do\n                        (c,_) <- readCharBufPtr p ix\n                        return c\n\n{-# INLINE readCharBuf #-}\nreadCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)\nreadCharBuf arr ix = withForeignPtr arr $ \\p -> readCharBufPtr p ix\n\n{-# INLINE writeCharBuf #-}\nwriteCharBuf :: RawCharBuffer -> Int -> Char -> IO Int\nwriteCharBuf arr ix c = withForeignPtr arr $ \\p -> writeCharBufPtr p ix c\n\n{-# INLINE readCharBufPtr #-}\nreadCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int)\n#if defined(CHARBUF_UTF16)\nreadCharBufPtr p ix = do\n  c1 <- peekElemOff p ix\n  if (c1 < 0xd800 || c1 > 0xdbff)\n     then return (chr (fromIntegral c1), ix+1)\n     else do c2 <- peekElemOff p (ix+1)\n             return (unsafeChr ((fromIntegral c1 - 0xd800)*0x400 +\n                                (fromIntegral c2 - 0xdc00) + 0x10000), ix+2)\n#else\nreadCharBufPtr p ix = do c <- peekElemOff (castPtr p) ix; return (c, ix+1)\n#endif\n\n{-# INLINE writeCharBufPtr #-}\nwriteCharBufPtr :: Ptr CharBufElem -> Int -> Char -> IO Int\n#if defined(CHARBUF_UTF16)\nwriteCharBufPtr p ix ch\n  | c < 0x10000 = do pokeElemOff p ix (fromIntegral c)\n                     return (ix+1)\n  | otherwise   = do let c' = c - 0x10000\n                     pokeElemOff p ix (fromIntegral (c' `div` 0x400 + 0xd800))\n                     pokeElemOff p (ix+1) (fromIntegral (c' `mod` 0x400 + 0xdc00))\n                     return (ix+2)\n  where\n    c = ord ch\n#else\nwriteCharBufPtr p ix ch = do pokeElemOff (castPtr p) ix ch; return (ix+1)\n#endif\n\ncharSize :: Int\n#if defined(CHARBUF_UTF16)\ncharSize = 2\n#else\ncharSize = 4\n#endif\n\n-- ---------------------------------------------------------------------------\n-- Buffers\n\n-- | A mutable array of bytes that can be passed to foreign functions.\n--\n-- The buffer is represented by a record, where the record contains\n-- the raw buffer and the start/end points of the filled portion.  The\n-- buffer contents itself is mutable, but the rest of the record is\n-- immutable.  This is a slightly odd mix, but it turns out to be\n-- quite practical: by making all the buffer metadata immutable, we\n-- can have operations on buffer metadata outside of the IO monad.\n--\n-- The \"live\" elements of the buffer are those between the 'bufL' and\n-- 'bufR' offsets.  In an empty buffer, 'bufL' is equal to 'bufR', but\n-- they might not be zero: for example, the buffer might correspond to\n-- a memory-mapped file and in which case 'bufL' will point to the\n-- next location to be written, which is not necessarily the beginning\n-- of the file.\ndata Buffer e\n  = Buffer {\n        bufRaw   :: !(RawBuffer e),\n        bufState :: BufferState,\n        bufSize  :: !Int,          -- in elements, not bytes\n        bufL     :: !Int,          -- offset of first item in the buffer\n        bufR     :: !Int           -- offset of last item + 1\n  }\n\n#if defined(CHARBUF_UTF16)\ntype CharBuffer = Buffer Word16\n#else\ntype CharBuffer = Buffer Char\n#endif\n\ndata BufferState = ReadBuffer | WriteBuffer\n  deriving Eq -- ^ @since 4.2.0.0\n\nwithBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a\nwithBuffer Buffer{ bufRaw=raw } f = withForeignPtr (castForeignPtr raw) f\n\nwithRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a\nwithRawBuffer raw f = withForeignPtr (castForeignPtr raw) f\n\nisEmptyBuffer :: Buffer e -> Bool\nisEmptyBuffer Buffer{ bufL=l, bufR=r } = l == r\n\nisFullBuffer :: Buffer e -> Bool\nisFullBuffer Buffer{ bufR=w, bufSize=s } = s == w\n\n-- if a Char buffer does not have room for a surrogate pair, it is \"full\"\nisFullCharBuffer :: Buffer e -> Bool\n#if defined(CHARBUF_UTF16)\nisFullCharBuffer buf = bufferAvailable buf < 2\n#else\nisFullCharBuffer = isFullBuffer\n#endif\n\nisWriteBuffer :: Buffer e -> Bool\nisWriteBuffer buf = case bufState buf of\n                        WriteBuffer -> True\n                        ReadBuffer  -> False\n\nbufferElems :: Buffer e -> Int\nbufferElems Buffer{ bufR=w, bufL=r } = w - r\n\nbufferAvailable :: Buffer e -> Int\nbufferAvailable Buffer{ bufR=w, bufSize=s } = s - w\n\nbufferRemove :: Int -> Buffer e -> Buffer e\nbufferRemove i buf@Buffer{ bufL=r } = bufferAdjustL (r+i) buf\n\nbufferAdjustL :: Int -> Buffer e -> Buffer e\nbufferAdjustL l buf@Buffer{ bufR=w }\n  | l == w    = buf{ bufL=0, bufR=0 }\n  | otherwise = buf{ bufL=l, bufR=w }\n\nbufferAdd :: Int -> Buffer e -> Buffer e\nbufferAdd i buf@Buffer{ bufR=w } = buf{ bufR=w+i }\n\nemptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e\nemptyBuffer raw sz state =\n  Buffer{ bufRaw=raw, bufState=state, bufR=0, bufL=0, bufSize=sz }\n\nnewByteBuffer :: Int -> BufferState -> IO (Buffer Word8)\nnewByteBuffer c st = newBuffer c c st\n\nnewCharBuffer :: Int -> BufferState -> IO CharBuffer\nnewCharBuffer c st = newBuffer (c * charSize) c st\n\nnewBuffer :: Int -> Int -> BufferState -> IO (Buffer e)\nnewBuffer bytes sz state = do\n  fp <- mallocForeignPtrBytes bytes\n  return (emptyBuffer fp sz state)\n\n-- | slides the contents of the buffer to the beginning\nslideContents :: Buffer Word8 -> IO (Buffer Word8)\nslideContents buf@Buffer{ bufL=l, bufR=r, bufRaw=raw } = do\n  let elems = r - l\n  withRawBuffer raw $ \\p ->\n      do _ <- memmove p (p `plusPtr` l) (fromIntegral elems)\n         return ()\n  return buf{ bufL=0, bufR=elems }\n\nforeign import ccall unsafe \"memmove\"\n   memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)\n\nsummaryBuffer :: Buffer a -> String\nsummaryBuffer !buf  -- Strict => slightly better code\n   = \"buf\" ++ show (bufSize buf) ++ \"(\" ++ show (bufL buf) ++ \"-\" ++ show (bufR buf) ++ \")\"\n\n-- INVARIANTS on Buffers:\n--   * r <= w\n--   * if r == w, and the buffer is for reading, then r == 0 && w == 0\n--   * a write buffer is never full.  If an operation\n--     fills up the buffer, it will always flush it before\n--     returning.\n--   * a read buffer may be full as a result of hLookAhead.  In normal\n--     operation, a read buffer always has at least one character of space.\n\ncheckBuffer :: Buffer a -> IO ()\ncheckBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do\n     check buf (\n        size > 0\n        && r <= w\n        && w <= size\n        && ( r /= w || state == WriteBuffer || (r == 0 && w == 0) )\n        && ( state /= WriteBuffer || w < size ) -- write buffer is never full\n      )\n\ncheck :: Buffer a -> Bool -> IO ()\ncheck _   True  = return ()\ncheck buf False = errorWithoutStackTrace (\"buffer invariant violation: \" ++ summaryBuffer buf)\n\n", "num_lines": 294}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.BufferedIO\n-- Copyright   :  (c) The University of Glasgow 2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Class of buffered IO devices\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.BufferedIO (\n        BufferedIO(..),\n        readBuf, readBufNonBlocking, writeBuf, writeBufNonBlocking\n    ) where\n\nimport GHC.Base\nimport GHC.Ptr\nimport Data.Word\nimport GHC.Num\nimport GHC.IO.Device as IODevice\nimport GHC.IO.Device as RawIO\nimport GHC.IO.Buffer\n\n-- | The purpose of 'BufferedIO' is to provide a common interface for I/O\n-- devices that can read and write data through a buffer.  Devices that\n-- implement 'BufferedIO' include ordinary files, memory-mapped files,\n-- and bytestrings.  The underlying device implementing a 'System.IO.Handle'\n-- must provide 'BufferedIO'.\n--\nclass BufferedIO dev where\n  -- | allocate a new buffer.  The size of the buffer is at the\n  -- discretion of the device; e.g. for a memory-mapped file the\n  -- buffer will probably cover the entire file.\n  newBuffer         :: dev -> BufferState -> IO (Buffer Word8)\n\n  -- | reads bytes into the buffer, blocking if there are no bytes\n  -- available.  Returns the number of bytes read (zero indicates\n  -- end-of-file), and the new buffer.\n  fillReadBuffer    :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)\n\n  -- | reads bytes into the buffer without blocking.  Returns the\n  -- number of bytes read (Nothing indicates end-of-file), and the new\n  -- buffer.\n  fillReadBuffer0   :: dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)\n\n  -- | Prepares an empty write buffer.  This lets the device decide\n  -- how to set up a write buffer: the buffer may need to point to a\n  -- specific location in memory, for example.  This is typically used\n  -- by the client when switching from reading to writing on a\n  -- buffered read/write device.\n  --\n  -- There is no corresponding operation for read buffers, because before\n  -- reading the client will always call 'fillReadBuffer'.\n  emptyWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)\n  emptyWriteBuffer _dev buf\n    = return buf{ bufL=0, bufR=0, bufState = WriteBuffer }\n\n  -- | Flush all the data from the supplied write buffer out to the device.\n  -- The returned buffer should be empty, and ready for writing.\n  flushWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)\n\n  -- | Flush data from the supplied write buffer out to the device\n  -- without blocking.  Returns the number of bytes written and the\n  -- remaining buffer.\n  flushWriteBuffer0 :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)\n\n-- for an I/O device, these operations will perform reading/writing\n-- to/from the device.\n\n-- for a memory-mapped file, the buffer will be the whole file in\n-- memory.  fillReadBuffer sets the pointers to encompass the whole\n-- file, and flushWriteBuffer needs to do no I/O.  A memory-mapped\n-- file has to maintain its own file pointer.\n\n-- for a bytestring, again the buffer should match the bytestring in\n-- memory.\n\n-- ---------------------------------------------------------------------------\n-- Low-level read/write to/from buffers\n\n-- These operations make it easy to implement an instance of 'BufferedIO'\n-- for an object that supports 'RawIO'.\n\nreadBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)\nreadBuf dev bbuf = do\n  let bytes = bufferAvailable bbuf\n  res <- withBuffer bbuf $ \\ptr ->\n             RawIO.read dev (ptr `plusPtr` bufR bbuf) bytes\n  return (res, bbuf{ bufR = bufR bbuf + res })\n         -- zero indicates end of file\n\nreadBufNonBlocking :: RawIO dev => dev -> Buffer Word8\n                     -> IO (Maybe Int,   -- Nothing ==> end of file\n                                         -- Just n  ==> n bytes were read (n>=0)\n                            Buffer Word8)\nreadBufNonBlocking dev bbuf = do\n  let bytes = bufferAvailable bbuf\n  res <- withBuffer bbuf $ \\ptr ->\n           IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) bytes\n  case res of\n     Nothing -> return (Nothing, bbuf)\n     Just n  -> return (Just n, bbuf{ bufR = bufR bbuf + n })\n\nwriteBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)\nwriteBuf dev bbuf = do\n  let bytes = bufferElems bbuf\n  withBuffer bbuf $ \\ptr ->\n      IODevice.write dev (ptr `plusPtr` bufL bbuf) bytes\n  return bbuf{ bufL=0, bufR=0 }\n\n-- XXX ToDo\nwriteBufNonBlocking :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)\nwriteBufNonBlocking dev bbuf = do\n  let bytes = bufferElems bbuf\n  res <- withBuffer bbuf $ \\ptr ->\n            IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf) bytes\n  return (res, bufferAdjustL (bufL bbuf + res) bbuf)\n\n", "num_lines": 127}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Device\n-- Copyright   :  (c) The University of Glasgow, 1994-2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Type classes for I/O providers.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Device (\n        RawIO(..),\n        IODevice(..),\n        IODeviceType(..),\n        SeekMode(..)\n    ) where\n\nimport GHC.Base\nimport GHC.Word\nimport GHC.Arr\nimport GHC.Enum\nimport GHC.Read\nimport GHC.Show\nimport GHC.Ptr\nimport GHC.Num\nimport GHC.IO\nimport {-# SOURCE #-} GHC.IO.Exception ( unsupportedOperation )\n\n-- | A low-level I/O provider where the data is bytes in memory.\nclass RawIO a where\n  -- | Read up to the specified number of bytes, returning the number\n  -- of bytes actually read.  This function should only block if there\n  -- is no data available.  If there is not enough data available,\n  -- then the function should just return the available data. A return\n  -- value of zero indicates that the end of the data stream (e.g. end\n  -- of file) has been reached.\n  read                :: a -> Ptr Word8 -> Int -> IO Int\n\n  -- | Read up to the specified number of bytes, returning the number\n  -- of bytes actually read, or 'Nothing' if the end of the stream has\n  -- been reached.\n  readNonBlocking     :: a -> Ptr Word8 -> Int -> IO (Maybe Int)\n\n  -- | Write the specified number of bytes.\n  write               :: a -> Ptr Word8 -> Int -> IO ()\n\n  -- | Write up to the specified number of bytes without blocking.  Returns\n  -- the actual number of bytes written.\n  writeNonBlocking    :: a -> Ptr Word8 -> Int -> IO Int\n\n\n-- | I/O operations required for implementing a 'System.IO.Handle'.\nclass IODevice a where\n  -- | @ready dev write msecs@ returns 'True' if the device has data\n  -- to read (if @write@ is 'False') or space to write new data (if\n  -- @write@ is 'True').  @msecs@ specifies how long to wait, in\n  -- milliseconds.\n  --\n  ready :: a -> Bool -> Int -> IO Bool\n\n  -- | closes the device.  Further operations on the device should\n  -- produce exceptions.\n  close :: a -> IO ()\n\n  -- | returns 'True' if the device is a terminal or console.\n  isTerminal :: a -> IO Bool\n  isTerminal _ = return False\n\n  -- | returns 'True' if the device supports 'seek' operations.\n  isSeekable :: a -> IO Bool\n  isSeekable _ = return False\n\n  -- | seek to the specified position in the data.\n  seek :: a -> SeekMode -> Integer -> IO ()\n  seek _ _ _ = ioe_unsupportedOperation\n\n  -- | return the current position in the data.\n  tell :: a -> IO Integer\n  tell _ = ioe_unsupportedOperation\n\n  -- | return the size of the data.\n  getSize :: a -> IO Integer\n  getSize _ = ioe_unsupportedOperation\n\n  -- | change the size of the data.\n  setSize :: a -> Integer -> IO ()\n  setSize _ _ = ioe_unsupportedOperation\n\n  -- | for terminal devices, changes whether characters are echoed on\n  -- the device.\n  setEcho :: a -> Bool -> IO ()\n  setEcho _ _ = ioe_unsupportedOperation\n\n  -- | returns the current echoing status.\n  getEcho :: a -> IO Bool\n  getEcho _ = ioe_unsupportedOperation\n\n  -- | some devices (e.g. terminals) support a \"raw\" mode where\n  -- characters entered are immediately made available to the program.\n  -- If available, this operations enables raw mode.\n  setRaw :: a -> Bool -> IO ()\n  setRaw _ _ = ioe_unsupportedOperation\n\n  -- | returns the 'IODeviceType' corresponding to this device.\n  devType :: a -> IO IODeviceType\n\n  -- | duplicates the device, if possible.  The new device is expected\n  -- to share a file pointer with the original device (like Unix @dup@).\n  dup :: a -> IO a\n  dup _ = ioe_unsupportedOperation\n\n  -- | @dup2 source target@ replaces the target device with the source\n  -- device.  The target device is closed first, if necessary, and then\n  -- it is made into a duplicate of the first device (like Unix @dup2@).\n  dup2 :: a -> a -> IO a\n  dup2 _ _ = ioe_unsupportedOperation\n\nioe_unsupportedOperation :: IO a\nioe_unsupportedOperation = throwIO unsupportedOperation\n\n-- | Type of a device that can be used to back a\n-- 'GHC.IO.Handle.Handle' (see also 'GHC.IO.Handle.mkFileHandle'). The\n-- standard libraries provide creation of 'GHC.IO.Handle.Handle's via\n-- Posix file operations with file descriptors (see\n-- 'GHC.IO.Handle.FD.mkHandleFromFD') with FD being the underlying\n-- 'GHC.IO.Device.IODevice' instance.\n--\n-- Users may provide custom instances of 'GHC.IO.Device.IODevice'\n-- which are expected to conform the following rules:\n\ndata IODeviceType\n  = Directory -- ^ The standard libraries do not have direct support\n              -- for this device type, but a user implementation is\n              -- expected to provide a list of file names in\n              -- the directory, in any order, separated by @\\'\\\\0\\'@\n              -- characters, excluding the @\".\"@ and @\"..\"@ names. See\n              -- also 'System.Directory.getDirectoryContents'.  Seek\n              -- operations are not supported on directories (other\n              -- than to the zero position).\n  | Stream    -- ^ A duplex communications channel (results in\n              -- creation of a duplex 'GHC.IO.Handle.Handle'). The\n              -- standard libraries use this device type when\n              -- creating 'GHC.IO.Handle.Handle's for open sockets.\n  | RegularFile -- ^ A file that may be read or written, and also\n                -- may be seekable.\n  | RawDevice -- ^ A \"raw\" (disk) device which supports block binary\n              -- read and write operations and may be seekable only\n              -- to positions of certain granularity (block-\n              -- aligned).\n  deriving ( Eq -- ^ @since 4.2.0.0\n           )\n\n-- -----------------------------------------------------------------------------\n-- SeekMode type\n\n-- | A mode that determines the effect of 'System.IO.hSeek' @hdl mode i@.\ndata SeekMode\n  = AbsoluteSeek        -- ^ the position of @hdl@ is set to @i@.\n  | RelativeSeek        -- ^ the position of @hdl@ is set to offset @i@\n                        -- from the current position.\n  | SeekFromEnd         -- ^ the position of @hdl@ is set to offset @i@\n                        -- from the end of the file.\n    deriving ( Eq   -- ^ @since 4.2.0.0\n             , Ord  -- ^ @since 4.2.0.0\n             , Ix   -- ^ @since 4.2.0.0\n             , Enum -- ^ @since 4.2.0.0\n             , Read -- ^ @since 4.2.0.0\n             , Show -- ^ @since 4.2.0.0\n             )\n\n", "num_lines": 178}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding\n-- Copyright   :  (c) The University of Glasgow, 2008-2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Text codecs for I/O\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding (\n        BufferCodec(..), TextEncoding(..), TextEncoder, TextDecoder, CodingProgress(..),\n        latin1, latin1_encode, latin1_decode,\n        utf8, utf8_bom,\n        utf16, utf16le, utf16be,\n        utf32, utf32le, utf32be,\n        initLocaleEncoding,\n        getLocaleEncoding, getFileSystemEncoding, getForeignEncoding,\n        setLocaleEncoding, setFileSystemEncoding, setForeignEncoding,\n        char8,\n        mkTextEncoding,\n        argvEncoding\n    ) where\n\nimport GHC.Base\nimport GHC.IO.Exception\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\n#if !defined(mingw32_HOST_OS)\nimport qualified GHC.IO.Encoding.Iconv as Iconv\n#else\nimport qualified GHC.IO.Encoding.CodePage as CodePage\nimport Text.Read (reads)\n#endif\nimport qualified GHC.IO.Encoding.Latin1 as Latin1\nimport qualified GHC.IO.Encoding.UTF8   as UTF8\nimport qualified GHC.IO.Encoding.UTF16  as UTF16\nimport qualified GHC.IO.Encoding.UTF32  as UTF32\nimport GHC.List\nimport GHC.Word\n\nimport Data.IORef\nimport Data.Char (toUpper)\nimport System.IO.Unsafe (unsafePerformIO)\n\n-- -----------------------------------------------------------------------------\n\n-- | The Latin1 (ISO8859-1) encoding.  This encoding maps bytes\n-- directly to the first 256 Unicode code points, and is thus not a\n-- complete Unicode encoding.  An attempt to write a character greater than\n-- @\\'\\\\255\\'@ to a 'System.IO.Handle' using the 'latin1' encoding will result in an\n-- error.\nlatin1  :: TextEncoding\nlatin1 = Latin1.latin1_checked\n\n-- | The UTF-8 Unicode encoding\nutf8  :: TextEncoding\nutf8 = UTF8.utf8\n\n-- | The UTF-8 Unicode encoding, with a byte-order-mark (BOM; the byte\n-- sequence 0xEF 0xBB 0xBF).  This encoding behaves like 'utf8',\n-- except that on input, the BOM sequence is ignored at the beginning\n-- of the stream, and on output, the BOM sequence is prepended.\n--\n-- The byte-order-mark is strictly unnecessary in UTF-8, but is\n-- sometimes used to identify the encoding of a file.\n--\nutf8_bom  :: TextEncoding\nutf8_bom = UTF8.utf8_bom\n\n-- | The UTF-16 Unicode encoding (a byte-order-mark should be used to\n-- indicate endianness).\nutf16  :: TextEncoding\nutf16 = UTF16.utf16\n\n-- | The UTF-16 Unicode encoding (litte-endian)\nutf16le  :: TextEncoding\nutf16le = UTF16.utf16le\n\n-- | The UTF-16 Unicode encoding (big-endian)\nutf16be  :: TextEncoding\nutf16be = UTF16.utf16be\n\n-- | The UTF-32 Unicode encoding (a byte-order-mark should be used to\n-- indicate endianness).\nutf32  :: TextEncoding\nutf32 = UTF32.utf32\n\n-- | The UTF-32 Unicode encoding (litte-endian)\nutf32le  :: TextEncoding\nutf32le = UTF32.utf32le\n\n-- | The UTF-32 Unicode encoding (big-endian)\nutf32be  :: TextEncoding\nutf32be = UTF32.utf32be\n\n-- | The Unicode encoding of the current locale\n--\n-- @since 4.5.0.0\ngetLocaleEncoding :: IO TextEncoding\n\n-- | The Unicode encoding of the current locale, but allowing arbitrary\n-- undecodable bytes to be round-tripped through it.\n--\n-- This 'TextEncoding' is used to decode and encode command line arguments\n-- and environment variables on non-Windows platforms.\n--\n-- On Windows, this encoding *should not* be used if possible because\n-- the use of code pages is deprecated: Strings should be retrieved\n-- via the \"wide\" W-family of UTF-16 APIs instead\n--\n-- @since 4.5.0.0\ngetFileSystemEncoding :: IO TextEncoding\n\n-- | The Unicode encoding of the current locale, but where undecodable\n-- bytes are replaced with their closest visual match. Used for\n-- the 'Foreign.C.String.CString' marshalling functions in \"Foreign.C.String\"\n--\n-- @since 4.5.0.0\ngetForeignEncoding :: IO TextEncoding\n\n-- | @since 4.5.0.0\nsetLocaleEncoding, setFileSystemEncoding, setForeignEncoding :: TextEncoding -> IO ()\n\n(getLocaleEncoding, setLocaleEncoding)         = mkGlobal initLocaleEncoding\n(getFileSystemEncoding, setFileSystemEncoding) = mkGlobal initFileSystemEncoding\n(getForeignEncoding, setForeignEncoding)       = mkGlobal initForeignEncoding\n\nmkGlobal :: a -> (IO a, a -> IO ())\nmkGlobal x = unsafePerformIO $ do\n    x_ref <- newIORef x\n    return (readIORef x_ref, writeIORef x_ref)\n\n-- | @since 4.5.0.0\ninitLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding\n\n#if !defined(mingw32_HOST_OS)\n-- It is rather important that we don't just call Iconv.mkIconvEncoding here\n-- because some iconvs (in particular GNU iconv) will brokenly UTF-8 encode\n-- lone surrogates without complaint.\n--\n-- By going through our Haskell implementations of those encodings, we are\n-- guaranteed to catch such errors.\n--\n-- FIXME: this is not a complete solution because if the locale encoding is one\n-- which we don't have a Haskell-side decoder for, iconv might still ignore the\n-- lone surrogate in the input.\ninitLocaleEncoding     = unsafePerformIO $ mkTextEncoding' ErrorOnCodingFailure Iconv.localeEncodingName\ninitFileSystemEncoding = unsafePerformIO $ mkTextEncoding' RoundtripFailure     Iconv.localeEncodingName\ninitForeignEncoding    = unsafePerformIO $ mkTextEncoding' IgnoreCodingFailure  Iconv.localeEncodingName\n#else\ninitLocaleEncoding     = CodePage.localeEncoding\ninitFileSystemEncoding = CodePage.mkLocaleEncoding RoundtripFailure\ninitForeignEncoding    = CodePage.mkLocaleEncoding IgnoreCodingFailure\n#endif\n\n-- See Note [Windows Unicode Arguments] in rts/RtsFlags.c\n-- On Windows we assume hs_init argv is in utf8 encoding.\n\n-- | Internal encoding of argv\nargvEncoding :: IO TextEncoding\n#if defined(mingw32_HOST_OS)\nargvEncoding = return utf8\n#else\nargvEncoding = getFileSystemEncoding\n#endif\n\n-- | An encoding in which Unicode code points are translated to bytes\n-- by taking the code point modulo 256.  When decoding, bytes are\n-- translated directly into the equivalent code point.\n--\n-- This encoding never fails in either direction.  However, encoding\n-- discards information, so encode followed by decode is not the\n-- identity.\n--\n-- @since 4.4.0.0\nchar8 :: TextEncoding\nchar8 = Latin1.latin1\n\n-- | Look up the named Unicode encoding.  May fail with\n--\n--  * 'System.IO.Error.isDoesNotExistError' if the encoding is unknown\n--\n-- The set of known encodings is system-dependent, but includes at least:\n--\n--  * @UTF-8@\n--\n--  * @UTF-16@, @UTF-16BE@, @UTF-16LE@\n--\n--  * @UTF-32@, @UTF-32BE@, @UTF-32LE@\n--\n-- There is additional notation (borrowed from GNU iconv) for specifying\n-- how illegal characters are handled:\n--\n--  * a suffix of @\\/\\/IGNORE@, e.g. @UTF-8\\/\\/IGNORE@, will cause\n--    all illegal sequences on input to be ignored, and on output\n--    will drop all code points that have no representation in the\n--    target encoding.\n--\n--  * a suffix of @\\/\\/TRANSLIT@ will choose a replacement character\n--    for illegal sequences or code points.\n--\n--  * a suffix of @\\/\\/ROUNDTRIP@ will use a PEP383-style escape mechanism\n--    to represent any invalid bytes in the input as Unicode codepoints (specifically,\n--    as lone surrogates, which are normally invalid in UTF-32).\n--    Upon output, these special codepoints are detected and turned back into the\n--    corresponding original byte.\n--\n--    In theory, this mechanism allows arbitrary data to be roundtripped via\n--    a 'String' with no loss of data. In practice, there are two limitations\n--    to be aware of:\n--\n--      1. This only stands a chance of working for an encoding which is an ASCII\n--         superset, as for security reasons we refuse to escape any bytes smaller\n--         than 128. Many encodings of interest are ASCII supersets (in particular,\n--         you can assume that the locale encoding is an ASCII superset) but many\n--         (such as UTF-16) are not.\n--\n--      2. If the underlying encoding is not itself roundtrippable, this mechanism\n--         can fail. Roundtrippable encodings are those which have an injective mapping\n--         into Unicode. Almost all encodings meet this criteria, but some do not. Notably,\n--         Shift-JIS (CP932) and Big5 contain several different encodings of the same\n--         Unicode codepoint.\n--\n-- On Windows, you can access supported code pages with the prefix\n-- @CP@; for example, @\\\"CP1250\\\"@.\n--\nmkTextEncoding :: String -> IO TextEncoding\nmkTextEncoding e = case mb_coding_failure_mode of\n    Nothing -> unknownEncodingErr e\n    Just cfm -> mkTextEncoding' cfm enc\n  where\n    (enc, suffix) = span (/= '/') e\n    mb_coding_failure_mode = case suffix of\n        \"\"            -> Just ErrorOnCodingFailure\n        \"//IGNORE\"    -> Just IgnoreCodingFailure\n        \"//TRANSLIT\"  -> Just TransliterateCodingFailure\n        \"//ROUNDTRIP\" -> Just RoundtripFailure\n        _             -> Nothing\n\nmkTextEncoding' :: CodingFailureMode -> String -> IO TextEncoding\nmkTextEncoding' cfm enc =\n  case [toUpper c | c <- enc, c /= '-'] of\n  -- UTF-8 and friends we can handle ourselves\n    \"UTF8\"    -> return $ UTF8.mkUTF8 cfm\n    \"UTF16\"   -> return $ UTF16.mkUTF16 cfm\n    \"UTF16LE\" -> return $ UTF16.mkUTF16le cfm\n    \"UTF16BE\" -> return $ UTF16.mkUTF16be cfm\n    \"UTF32\"   -> return $ UTF32.mkUTF32 cfm\n    \"UTF32LE\" -> return $ UTF32.mkUTF32le cfm\n    \"UTF32BE\" -> return $ UTF32.mkUTF32be cfm\n    -- On AIX, we want to avoid iconv, because it is either\n    -- a) totally broken, or b) non-reentrant, or c) actually works.\n    -- Detecting b) is difficult as you'd have to trigger the reentrancy\n    -- corruption.\n    -- Therefore, on AIX, we handle the popular ASCII and latin1 encodings\n    -- ourselves. For consistency, we do the same on other platforms.\n    -- We use `mkLatin1_checked` instead of `mkLatin1`, since the latter\n    -- completely ignores the CodingFailureMode (TEST=encoding005).\n    _ | isAscii -> return (Latin1.mkAscii cfm)\n    _ | isLatin1 -> return (Latin1.mkLatin1_checked cfm)\n#if defined(mingw32_HOST_OS)\n    'C':'P':n | [(cp,\"\")] <- reads n -> return $ CodePage.mkCodePageEncoding cfm cp\n    _ -> unknownEncodingErr (enc ++ codingFailureModeSuffix cfm)\n#else\n    -- Otherwise, handle other encoding needs via iconv.\n\n    -- Unfortunately there is no good way to determine whether iconv is actually\n    -- functional without telling it to do something.\n    _ -> do res <- Iconv.mkIconvEncoding cfm enc\n            case res of\n              Just e -> return e\n              Nothing -> unknownEncodingErr (enc ++ codingFailureModeSuffix cfm)\n#endif\n  where\n    isAscii = enc `elem` asciiEncNames\n    isLatin1 = enc `elem` latin1EncNames\n    asciiEncNames = -- ASCII aliases specified by RFC 1345 and RFC 3808.\n      [ \"ANSI_X3.4-1968\", \"iso-ir-6\", \"ANSI_X3.4-1986\", \"ISO_646.irv:1991\"\n      , \"US-ASCII\", \"us\", \"IBM367\", \"cp367\", \"csASCII\", \"ASCII\", \"ISO646-US\"\n      ]\n    latin1EncNames = -- latin1 aliases specified by RFC 1345 and RFC 3808.\n      [ \"ISO_8859-1:1987\", \"iso-ir-100\", \"ISO_8859-1\", \"ISO-8859-1\", \"latin1\",\n        \"l1\", \"IBM819\", \"CP819\", \"csISOLatin1\"\n      ]\n\n\nlatin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8)\nlatin1_encode input output = fmap (\\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8\n--latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode\n\nlatin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer)\nlatin1_decode input output = fmap (\\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output\n--latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode\n\nunknownEncodingErr :: String -> IO a\nunknownEncodingErr e = ioException (IOError Nothing NoSuchThing \"mkTextEncoding\"\n                                            (\"unknown encoding:\" ++ e)  Nothing Nothing)\n", "num_lines": 308}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash,\n             ExistentialQuantification, ImplicitParams #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Exception\n-- Copyright   :  (c) The University of Glasgow, 2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- IO-related Exception types and functions\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Exception (\n  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,\n  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,\n  Deadlock(..),\n  AllocationLimitExceeded(..), allocationLimitExceeded,\n  AssertionFailed(..),\n  CompactionFailed(..),\n  cannotCompactFunction, cannotCompactPinned, cannotCompactMutable,\n\n  SomeAsyncException(..),\n  asyncExceptionToException, asyncExceptionFromException,\n  AsyncException(..), stackOverflow, heapOverflow,\n\n  ArrayException(..),\n  ExitCode(..),\n  FixIOException (..),\n\n  ioException,\n  ioError,\n  IOError,\n  IOException(..),\n  IOErrorType(..),\n  userError,\n  assertError,\n  unsupportedOperation,\n  untangle,\n ) where\n\nimport GHC.Base\nimport GHC.Generics\nimport GHC.List\nimport GHC.IO\nimport GHC.Show\nimport GHC.Read\nimport GHC.Exception\nimport GHC.IO.Handle.Types\nimport GHC.OldList ( intercalate )\nimport {-# SOURCE #-} GHC.Stack.CCS\nimport Foreign.C.Types\n\nimport Data.Typeable ( cast )\n\n-- ------------------------------------------------------------------------\n-- Exception datatypes and operations\n\n-- |The thread is blocked on an @MVar@, but there are no other references\n-- to the @MVar@ so it can't ever continue.\ndata BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar\n\n-- | @since 4.1.0.0\ninstance Exception BlockedIndefinitelyOnMVar\n\n-- | @since 4.1.0.0\ninstance Show BlockedIndefinitelyOnMVar where\n    showsPrec _ BlockedIndefinitelyOnMVar = showString \"thread blocked indefinitely in an MVar operation\"\n\nblockedIndefinitelyOnMVar :: SomeException -- for the RTS\nblockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar\n\n-----\n\n-- |The thread is waiting to retry an STM transaction, but there are no\n-- other references to any @TVar@s involved, so it can't ever continue.\ndata BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM\n\n-- | @since 4.1.0.0\ninstance Exception BlockedIndefinitelyOnSTM\n\n-- | @since 4.1.0.0\ninstance Show BlockedIndefinitelyOnSTM where\n    showsPrec _ BlockedIndefinitelyOnSTM = showString \"thread blocked indefinitely in an STM transaction\"\n\nblockedIndefinitelyOnSTM :: SomeException -- for the RTS\nblockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM\n\n-----\n\n-- |There are no runnable threads, so the program is deadlocked.\n-- The @Deadlock@ exception is raised in the main thread only.\ndata Deadlock = Deadlock\n\n-- | @since 4.1.0.0\ninstance Exception Deadlock\n\n-- | @since 4.1.0.0\ninstance Show Deadlock where\n    showsPrec _ Deadlock = showString \"<<deadlock>>\"\n\n-----\n\n-- |This thread has exceeded its allocation limit.  See\n-- 'System.Mem.setAllocationCounter' and\n-- 'System.Mem.enableAllocationLimit'.\n--\n-- @since 4.8.0.0\ndata AllocationLimitExceeded = AllocationLimitExceeded\n\n-- | @since 4.8.0.0\ninstance Exception AllocationLimitExceeded where\n  toException = asyncExceptionToException\n  fromException = asyncExceptionFromException\n\n-- | @since 4.7.1.0\ninstance Show AllocationLimitExceeded where\n    showsPrec _ AllocationLimitExceeded =\n      showString \"allocation limit exceeded\"\n\nallocationLimitExceeded :: SomeException -- for the RTS\nallocationLimitExceeded = toException AllocationLimitExceeded\n\n-----\n\n-- | Compaction found an object that cannot be compacted.  Functions\n-- cannot be compacted, nor can mutable objects or pinned objects.\n-- See 'GHC.Compact.compact'.\n--\n-- @since 4.10.0.0\nnewtype CompactionFailed = CompactionFailed String\n\n-- | @since 4.10.0.0\ninstance Exception CompactionFailed where\n\n-- | @since 4.10.0.0\ninstance Show CompactionFailed where\n    showsPrec _ (CompactionFailed why) =\n      showString (\"compaction failed: \" ++ why)\n\ncannotCompactFunction :: SomeException -- for the RTS\ncannotCompactFunction =\n  toException (CompactionFailed \"cannot compact functions\")\n\ncannotCompactPinned :: SomeException -- for the RTS\ncannotCompactPinned =\n  toException (CompactionFailed \"cannot compact pinned objects\")\n\ncannotCompactMutable :: SomeException -- for the RTS\ncannotCompactMutable =\n  toException (CompactionFailed \"cannot compact mutable objects\")\n\n-----\n\n-- |'assert' was applied to 'False'.\nnewtype AssertionFailed = AssertionFailed String\n\n-- | @since 4.1.0.0\ninstance Exception AssertionFailed\n\n-- | @since 4.1.0.0\ninstance Show AssertionFailed where\n    showsPrec _ (AssertionFailed err) = showString err\n\n-----\n\n-- |Superclass for asynchronous exceptions.\n--\n-- @since 4.7.0.0\ndata SomeAsyncException = forall e . Exception e => SomeAsyncException e\n\n-- | @since 4.7.0.0\ninstance Show SomeAsyncException where\n    show (SomeAsyncException e) = show e\n\n-- | @since 4.7.0.0\ninstance Exception SomeAsyncException\n\n-- |@since 4.7.0.0\nasyncExceptionToException :: Exception e => e -> SomeException\nasyncExceptionToException = toException . SomeAsyncException\n\n-- |@since 4.7.0.0\nasyncExceptionFromException :: Exception e => SomeException -> Maybe e\nasyncExceptionFromException x = do\n    SomeAsyncException a <- fromException x\n    cast a\n\n\n-- |Asynchronous exceptions.\ndata AsyncException\n  = StackOverflow\n        -- ^The current thread\\'s stack exceeded its limit.\n        -- Since an exception has been raised, the thread\\'s stack\n        -- will certainly be below its limit again, but the\n        -- programmer should take remedial action\n        -- immediately.\n  | HeapOverflow\n        -- ^The program\\'s heap is reaching its limit, and\n        -- the program should take action to reduce the amount of\n        -- live data it has. Notes:\n        --\n        --   * It is undefined which thread receives this exception.\n        --     GHC currently throws this to the same thread that\n        --     receives 'UserInterrupt', but this may change in the\n        --     future.\n        --\n        --   * The GHC RTS currently can only recover from heap overflow\n        --     if it detects that an explicit memory limit (set via RTS flags).\n        --     has been exceeded.  Currently, failure to allocate memory from\n        --     the operating system results in immediate termination of the\n        --     program.\n  | ThreadKilled\n        -- ^This exception is raised by another thread\n        -- calling 'Control.Concurrent.killThread', or by the system\n        -- if it needs to terminate the thread for some\n        -- reason.\n  | UserInterrupt\n        -- ^This exception is raised by default in the main thread of\n        -- the program when the user requests to terminate the program\n        -- via the usual mechanism(s) (e.g. Control-C in the console).\n  deriving ( Eq  -- ^ @since 4.2.0.0\n           , Ord -- ^ @since 4.2.0.0\n           )\n\n-- | @since 4.7.0.0\ninstance Exception AsyncException where\n  toException = asyncExceptionToException\n  fromException = asyncExceptionFromException\n\n-- | Exceptions generated by array operations\ndata ArrayException\n  = IndexOutOfBounds    String\n        -- ^An attempt was made to index an array outside\n        -- its declared bounds.\n  | UndefinedElement    String\n        -- ^An attempt was made to evaluate an element of an\n        -- array that had not been initialized.\n  deriving ( Eq  -- ^ @since 4.2.0.0\n           , Ord -- ^ @since 4.2.0.0\n           )\n\n-- | @since 4.1.0.0\ninstance Exception ArrayException\n\n-- for the RTS\nstackOverflow, heapOverflow :: SomeException\nstackOverflow = toException StackOverflow\nheapOverflow  = toException HeapOverflow\n\n-- | @since 4.1.0.0\ninstance Show AsyncException where\n  showsPrec _ StackOverflow   = showString \"stack overflow\"\n  showsPrec _ HeapOverflow    = showString \"heap overflow\"\n  showsPrec _ ThreadKilled    = showString \"thread killed\"\n  showsPrec _ UserInterrupt   = showString \"user interrupt\"\n\n-- | @since 4.1.0.0\ninstance Show ArrayException where\n  showsPrec _ (IndexOutOfBounds s)\n        = showString \"array index out of range\"\n        . (if not (null s) then showString \": \" . showString s\n                           else id)\n  showsPrec _ (UndefinedElement s)\n        = showString \"undefined array element\"\n        . (if not (null s) then showString \": \" . showString s\n                           else id)\n\n-- | The exception thrown when an infinite cycle is detected in\n-- 'System.IO.fixIO'.\n--\n-- @since 4.11.0.0\ndata FixIOException = FixIOException\n\n-- | @since 4.11.0.0\ninstance Exception FixIOException\n\n-- | @since 4.11.0.0\ninstance Show FixIOException where\n  showsPrec _ FixIOException = showString \"cyclic evaluation in fixIO\"\n\n-- -----------------------------------------------------------------------------\n-- The ExitCode type\n\n-- We need it here because it is used in ExitException in the\n-- Exception datatype (above).\n\n-- | Defines the exit codes that a program can return.\ndata ExitCode\n  = ExitSuccess -- ^ indicates successful termination;\n  | ExitFailure Int\n                -- ^ indicates program failure with an exit code.\n                -- The exact interpretation of the code is\n                -- operating-system dependent.  In particular, some values\n                -- may be prohibited (e.g. 0 on a POSIX-compliant system).\n  deriving (Eq, Ord, Read, Show, Generic)\n\n-- | @since 4.1.0.0\ninstance Exception ExitCode\n\nioException     :: IOException -> IO a\nioException err = throwIO err\n\n-- | Raise an 'IOError' in the 'IO' monad.\nioError         :: IOError -> IO a\nioError         =  ioException\n\n-- ---------------------------------------------------------------------------\n-- IOError type\n\n-- | The Haskell 2010 type for exceptions in the 'IO' monad.\n-- Any I\\/O operation may raise an 'IOError' instead of returning a result.\n-- For a more general type of exception, including also those that arise\n-- in pure code, see 'Control.Exception.Exception'.\n--\n-- In Haskell 2010, this is an opaque type.\ntype IOError = IOException\n\n-- |Exceptions that occur in the @IO@ monad.\n-- An @IOException@ records a more specific error type, a descriptive\n-- string and maybe the handle that was used when the error was\n-- flagged.\ndata IOException\n = IOError {\n     ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging\n                                     -- the error.\n     ioe_type     :: IOErrorType,    -- what it was.\n     ioe_location :: String,         -- location.\n     ioe_description :: String,      -- error type specific information.\n     ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.\n     ioe_filename :: Maybe FilePath  -- filename the error is related to.\n   }\n\n-- | @since 4.1.0.0\ninstance Exception IOException\n\n-- | @since 4.1.0.0\ninstance Eq IOException where\n  (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =\n    e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2\n\n-- | An abstract type that contains a value for each variant of 'IOError'.\ndata IOErrorType\n  -- Haskell 2010:\n  = AlreadyExists\n  | NoSuchThing\n  | ResourceBusy\n  | ResourceExhausted\n  | EOF\n  | IllegalOperation\n  | PermissionDenied\n  | UserError\n  -- GHC only:\n  | UnsatisfiedConstraints\n  | SystemError\n  | ProtocolError\n  | OtherError\n  | InvalidArgument\n  | InappropriateType\n  | HardwareFault\n  | UnsupportedOperation\n  | TimeExpired\n  | ResourceVanished\n  | Interrupted\n\n-- | @since 4.1.0.0\ninstance Eq IOErrorType where\n   x == y = isTrue# (getTag x ==# getTag y)\n\n-- | @since 4.1.0.0\ninstance Show IOErrorType where\n  showsPrec _ e =\n    showString $\n    case e of\n      AlreadyExists     -> \"already exists\"\n      NoSuchThing       -> \"does not exist\"\n      ResourceBusy      -> \"resource busy\"\n      ResourceExhausted -> \"resource exhausted\"\n      EOF               -> \"end of file\"\n      IllegalOperation  -> \"illegal operation\"\n      PermissionDenied  -> \"permission denied\"\n      UserError         -> \"user error\"\n      HardwareFault     -> \"hardware fault\"\n      InappropriateType -> \"inappropriate type\"\n      Interrupted       -> \"interrupted\"\n      InvalidArgument   -> \"invalid argument\"\n      OtherError        -> \"failed\"\n      ProtocolError     -> \"protocol error\"\n      ResourceVanished  -> \"resource vanished\"\n      SystemError       -> \"system error\"\n      TimeExpired       -> \"timeout\"\n      UnsatisfiedConstraints -> \"unsatisfied constraints\" -- ultra-precise!\n      UnsupportedOperation -> \"unsupported operation\"\n\n-- | Construct an 'IOError' value with a string describing the error.\n-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a\n-- 'userError', thus:\n--\n-- > instance Monad IO where\n-- >   ...\n-- >   fail s = ioError (userError s)\n--\nuserError       :: String  -> IOError\nuserError str   =  IOError Nothing UserError \"\" str Nothing Nothing\n\n-- ---------------------------------------------------------------------------\n-- Showing IOErrors\n\n-- | @since 4.1.0.0\ninstance Show IOException where\n    showsPrec p (IOError hdl iot loc s _ fn) =\n      (case fn of\n         Nothing -> case hdl of\n                        Nothing -> id\n                        Just h  -> showsPrec p h . showString \": \"\n         Just name -> showString name . showString \": \") .\n      (case loc of\n         \"\" -> id\n         _  -> showString loc . showString \": \") .\n      showsPrec p iot .\n      (case s of\n         \"\" -> id\n         _  -> showString \" (\" . showString s . showString \")\")\n\n-- Note the use of \"lazy\". This means that\n--     assert False (throw e)\n-- will throw the assertion failure rather than e. See trac #5561.\nassertError :: (?callStack :: CallStack) => Bool -> a -> a\nassertError predicate v\n  | predicate = lazy v\n  | otherwise = unsafeDupablePerformIO $ do\n    ccsStack <- currentCallStack\n    let\n      implicitParamCallStack = prettyCallStackLines ?callStack\n      ccsCallStack = showCCSStack ccsStack\n      stack = intercalate \"\\n\" $ implicitParamCallStack ++ ccsCallStack\n    throwIO (AssertionFailed (\"Assertion failed\\n\" ++ stack))\n\nunsupportedOperation :: IOError\nunsupportedOperation =\n   (IOError Nothing UnsupportedOperation \"\"\n        \"Operation is not supported\" Nothing Nothing)\n\n{-\n(untangle coded message) expects \"coded\" to be of the form\n        \"location|details\"\nIt prints\n        location message details\n-}\nuntangle :: Addr# -> String -> String\nuntangle coded message\n  =  location\n  ++ \": \"\n  ++ message\n  ++ details\n  ++ \"\\n\"\n  where\n    coded_str = unpackCStringUtf8# coded\n\n    (location, details)\n      = case (span not_bar coded_str) of { (loc, rest) ->\n        case rest of\n          ('|':det) -> (loc, ' ' : det)\n          _         -> (loc, \"\")\n        }\n    not_bar c = c /= '|'\n\n", "num_lines": 475}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , BangPatterns\n  #-}\n{-# OPTIONS_GHC -Wno-identities #-}\n-- Whether there are identities depends on the platform\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.FD\n-- Copyright   :  (c) The University of Glasgow, 1994-2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Raw read/write operations on file descriptors\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.FD (\n        FD(..),\n        openFile, mkFD, release,\n        setNonBlockingMode,\n        readRawBufferPtr, readRawBufferPtrNoBlock, writeRawBufferPtr,\n        stdin, stdout, stderr\n    ) where\n\nimport GHC.Base\nimport GHC.Num\nimport GHC.Real\nimport GHC.Show\nimport GHC.Enum\n\nimport GHC.IO\nimport GHC.IO.IOMode\nimport GHC.IO.Buffer\nimport GHC.IO.BufferedIO\nimport qualified GHC.IO.Device\nimport GHC.IO.Device (SeekMode(..), IODeviceType(..))\nimport GHC.Conc.IO\nimport GHC.IO.Exception\n#if defined(mingw32_HOST_OS)\nimport GHC.Windows\nimport Data.Bool\n#endif\n\nimport Foreign\nimport Foreign.C\nimport qualified System.Posix.Internals\nimport System.Posix.Internals hiding (FD, setEcho, getEcho)\nimport System.Posix.Types\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\nc_DEBUG_DUMP :: Bool\nc_DEBUG_DUMP = False\n\n-- -----------------------------------------------------------------------------\n-- The file-descriptor IO device\n\ndata FD = FD {\n  fdFD :: {-# UNPACK #-} !CInt,\n#if defined(mingw32_HOST_OS)\n  -- On Windows, a socket file descriptor needs to be read and written\n  -- using different functions (send/recv).\n  fdIsSocket_ :: {-# UNPACK #-} !Int\n#else\n  -- On Unix we need to know whether this FD has O_NONBLOCK set.\n  -- If it has, then we can use more efficient routines to read/write to it.\n  -- It is always safe for this to be off.\n  fdIsNonBlocking :: {-# UNPACK #-} !Int\n#endif\n }\n\n#if defined(mingw32_HOST_OS)\nfdIsSocket :: FD -> Bool\nfdIsSocket fd = fdIsSocket_ fd /= 0\n#endif\n\n-- | @since 4.1.0.0\ninstance Show FD where\n  show fd = show (fdFD fd)\n\n-- | @since 4.1.0.0\ninstance GHC.IO.Device.RawIO FD where\n  read             = fdRead\n  readNonBlocking  = fdReadNonBlocking\n  write            = fdWrite\n  writeNonBlocking = fdWriteNonBlocking\n\n-- | @since 4.1.0.0\ninstance GHC.IO.Device.IODevice FD where\n  ready         = ready\n  close         = close\n  isTerminal    = isTerminal\n  isSeekable    = isSeekable\n  seek          = seek\n  tell          = tell\n  getSize       = getSize\n  setSize       = setSize\n  setEcho       = setEcho\n  getEcho       = getEcho\n  setRaw        = setRaw\n  devType       = devType\n  dup           = dup\n  dup2          = dup2\n\n-- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is\n-- taken from the value of BUFSIZ on the current platform.  This value\n-- varies too much though: it is 512 on Windows, 1024 on OS X and 8192\n-- on Linux.  So let's just use a decent size on every platform:\ndEFAULT_FD_BUFFER_SIZE :: Int\ndEFAULT_FD_BUFFER_SIZE = 8192\n\n-- | @since 4.1.0.0\ninstance BufferedIO FD where\n  newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state\n  fillReadBuffer    fd buf = readBuf' fd buf\n  fillReadBuffer0   fd buf = readBufNonBlocking fd buf\n  flushWriteBuffer  fd buf = writeBuf' fd buf\n  flushWriteBuffer0 fd buf = writeBufNonBlocking fd buf\n\nreadBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)\nreadBuf' fd buf = do\n  when c_DEBUG_DUMP $\n      puts (\"readBuf fd=\" ++ show fd ++ \" \" ++ summaryBuffer buf ++ \"\\n\")\n  (r,buf') <- readBuf fd buf\n  when c_DEBUG_DUMP $\n      puts (\"after: \" ++ summaryBuffer buf' ++ \"\\n\")\n  return (r,buf')\n\nwriteBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8)\nwriteBuf' fd buf = do\n  when c_DEBUG_DUMP $\n      puts (\"writeBuf fd=\" ++ show fd ++ \" \" ++ summaryBuffer buf ++ \"\\n\")\n  writeBuf fd buf\n\n-- -----------------------------------------------------------------------------\n-- opening files\n\n-- | Open a file and make an 'FD' for it.  Truncates the file to zero\n-- size when the `IOMode` is `WriteMode`.\nopenFile\n  :: FilePath -- ^ file to open\n  -> IOMode   -- ^ mode in which to open the file\n  -> Bool     -- ^ open the file in non-blocking mode?\n  -> IO (FD,IODeviceType)\n\nopenFile filepath iomode non_blocking =\n  withFilePath filepath $ \\ f ->\n\n    let\n      oflags1 = case iomode of\n                  ReadMode      -> read_flags\n                  WriteMode     -> write_flags\n                  ReadWriteMode -> rw_flags\n                  AppendMode    -> append_flags\n\n#if defined(mingw32_HOST_OS)\n      binary_flags = o_BINARY\n#else\n      binary_flags = 0\n#endif\n\n      oflags2 = oflags1 .|. binary_flags\n\n      oflags | non_blocking = oflags2 .|. nonblock_flags\n             | otherwise    = oflags2\n    in do\n\n    -- NB. always use a safe open(), because we don't know whether open()\n    -- will be fast or not.  It can be slow on NFS and FUSE filesystems,\n    -- for example.\n    fd <- throwErrnoIfMinus1Retry \"openFile\" $ c_safe_open f oflags 0o666\n\n    (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}\n                            False{-not a socket-}\n                            non_blocking\n            `catchAny` \\e -> do _ <- c_close fd\n                                throwIO e\n\n    -- we want to truncate() if this is an open in WriteMode, but only\n    -- if the target is a RegularFile.  ftruncate() fails on special files\n    -- like /dev/null.\n    when (iomode == WriteMode && fd_type == RegularFile) $\n      setSize fD 0\n\n    return (fD,fd_type)\n\nstd_flags, output_flags, read_flags, write_flags, rw_flags,\n    append_flags, nonblock_flags :: CInt\nstd_flags    = o_NOCTTY\noutput_flags = std_flags    .|. o_CREAT\nread_flags   = std_flags    .|. o_RDONLY\nwrite_flags  = output_flags .|. o_WRONLY\nrw_flags     = output_flags .|. o_RDWR\nappend_flags = write_flags  .|. o_APPEND\nnonblock_flags = o_NONBLOCK\n\n\n-- | Make a 'FD' from an existing file descriptor.  Fails if the FD\n-- refers to a directory.  If the FD refers to a file, `mkFD` locks\n-- the file according to the Haskell 2010 single writer/multiple reader\n-- locking semantics (this is why we need the `IOMode` argument too).\nmkFD :: CInt\n     -> IOMode\n     -> Maybe (IODeviceType, CDev, CIno)\n     -- the results of fdStat if we already know them, or we want\n     -- to prevent fdToHandle_stat from doing its own stat.\n     -- These are used for:\n     --   - we fail if the FD refers to a directory\n     --   - if the FD refers to a file, we lock it using (cdev,cino)\n     -> Bool   -- ^ is a socket (on Windows)\n     -> Bool   -- ^ is in non-blocking mode on Unix\n     -> IO (FD,IODeviceType)\n\nmkFD fd iomode mb_stat is_socket is_nonblock = do\n\n    let _ = (is_socket, is_nonblock) -- warning suppression\n\n    (fd_type,dev,ino) <-\n        case mb_stat of\n          Nothing   -> fdStat fd\n          Just stat -> return stat\n\n    let write = case iomode of\n                   ReadMode -> False\n                   _ -> True\n\n    case fd_type of\n        Directory ->\n           ioException (IOError Nothing InappropriateType \"openFile\"\n                           \"is a directory\" Nothing Nothing)\n\n        -- regular files need to be locked\n        RegularFile -> do\n           -- On Windows we need an additional call to get a unique device id\n           -- and inode, since fstat just returns 0 for both.\n           (unique_dev, unique_ino) <- getUniqueFileInfo fd dev ino\n           r <- lockFile fd unique_dev unique_ino (fromBool write)\n           when (r == -1)  $\n                ioException (IOError Nothing ResourceBusy \"openFile\"\n                                   \"file is locked\" Nothing Nothing)\n\n        _other_type -> return ()\n\n#if defined(mingw32_HOST_OS)\n    when (not is_socket) $ setmode fd True >> return ()\n#endif\n\n    return (FD{ fdFD = fd,\n#if !defined(mingw32_HOST_OS)\n                fdIsNonBlocking = fromEnum is_nonblock\n#else\n                fdIsSocket_ = fromEnum is_socket\n#endif\n              },\n            fd_type)\n\ngetUniqueFileInfo :: CInt -> CDev -> CIno -> IO (Word64, Word64)\n#if !defined(mingw32_HOST_OS)\ngetUniqueFileInfo _ dev ino = return (fromIntegral dev, fromIntegral ino)\n#else\ngetUniqueFileInfo fd _ _ = do\n  with 0 $ \\devptr -> do\n    with 0 $ \\inoptr -> do\n      c_getUniqueFileInfo fd devptr inoptr\n      liftM2 (,) (peek devptr) (peek inoptr)\n#endif\n\n#if defined(mingw32_HOST_OS)\nforeign import ccall unsafe \"__hscore_setmode\"\n  setmode :: CInt -> Bool -> IO CInt\n#endif\n\n-- -----------------------------------------------------------------------------\n-- Standard file descriptors\n\nstdFD :: CInt -> FD\nstdFD fd = FD { fdFD = fd,\n#if defined(mingw32_HOST_OS)\n                fdIsSocket_ = 0\n#else\n                fdIsNonBlocking = 0\n   -- We don't set non-blocking mode on standard handles, because it may\n   -- confuse other applications attached to the same TTY/pipe\n   -- see Note [nonblock]\n#endif\n                }\n\nstdin, stdout, stderr :: FD\nstdin  = stdFD 0\nstdout = stdFD 1\nstderr = stdFD 2\n\n-- -----------------------------------------------------------------------------\n-- Operations on file descriptors\n\nclose :: FD -> IO ()\nclose fd =\n  do let closer realFd =\n           throwErrnoIfMinus1Retry_ \"GHC.IO.FD.close\" $\n#if defined(mingw32_HOST_OS)\n           if fdIsSocket fd then\n             c_closesocket (fromIntegral realFd)\n           else\n#endif\n             c_close (fromIntegral realFd)\n\n     -- release the lock *first*, because otherwise if we're preempted\n     -- after closing but before releasing, the FD may have been reused.\n     -- (#7646)\n     release fd\n\n     closeFdWith closer (fromIntegral (fdFD fd))\n\nrelease :: FD -> IO ()\nrelease fd = do _ <- unlockFile (fdFD fd)\n                return ()\n\n#if defined(mingw32_HOST_OS)\nforeign import WINDOWS_CCONV unsafe \"HsBase.h closesocket\"\n   c_closesocket :: CInt -> IO CInt\n#endif\n\nisSeekable :: FD -> IO Bool\nisSeekable fd = do\n  t <- devType fd\n  return (t == RegularFile || t == RawDevice)\n\nseek :: FD -> SeekMode -> Integer -> IO ()\nseek fd mode off = do\n  throwErrnoIfMinus1Retry_ \"seek\" $\n     c_lseek (fdFD fd) (fromIntegral off) seektype\n where\n    seektype :: CInt\n    seektype = case mode of\n                   AbsoluteSeek -> sEEK_SET\n                   RelativeSeek -> sEEK_CUR\n                   SeekFromEnd  -> sEEK_END\n\ntell :: FD -> IO Integer\ntell fd =\n fromIntegral `fmap`\n   (throwErrnoIfMinus1Retry \"hGetPosn\" $\n      c_lseek (fdFD fd) 0 sEEK_CUR)\n\ngetSize :: FD -> IO Integer\ngetSize fd = fdFileSize (fdFD fd)\n\nsetSize :: FD -> Integer -> IO ()\nsetSize fd size = do\n  throwErrnoIf_ (/=0) \"GHC.IO.FD.setSize\"  $\n     c_ftruncate (fdFD fd) (fromIntegral size)\n\ndevType :: FD -> IO IODeviceType\ndevType fd = do (ty,_,_) <- fdStat (fdFD fd); return ty\n\ndup :: FD -> IO FD\ndup fd = do\n  newfd <- throwErrnoIfMinus1 \"GHC.IO.FD.dup\" $ c_dup (fdFD fd)\n  return fd{ fdFD = newfd }\n\ndup2 :: FD -> FD -> IO FD\ndup2 fd fdto = do\n  -- Windows' dup2 does not return the new descriptor, unlike Unix\n  throwErrnoIfMinus1_ \"GHC.IO.FD.dup2\" $\n    c_dup2 (fdFD fd) (fdFD fdto)\n  return fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD\n\nsetNonBlockingMode :: FD -> Bool -> IO FD\nsetNonBlockingMode fd set = do\n  setNonBlockingFD (fdFD fd) set\n#if defined(mingw32_HOST_OS)\n  return fd\n#else\n  return fd{ fdIsNonBlocking = fromEnum set }\n#endif\n\nready :: FD -> Bool -> Int -> IO Bool\nready fd write msecs = do\n  r <- throwErrnoIfMinus1Retry \"GHC.IO.FD.ready\" $\n          fdReady (fdFD fd) (fromIntegral $ fromEnum $ write)\n                            (fromIntegral msecs)\n#if defined(mingw32_HOST_OS)\n                          (fromIntegral $ fromEnum $ fdIsSocket fd)\n#else\n                          0\n#endif\n  return (toEnum (fromIntegral r))\n\nforeign import ccall safe \"fdReady\"\n  fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt\n\n-- ---------------------------------------------------------------------------\n-- Terminal-related stuff\n\nisTerminal :: FD -> IO Bool\nisTerminal fd =\n#if defined(mingw32_HOST_OS)\n    if fdIsSocket fd then return False\n                     else is_console (fdFD fd) >>= return.toBool\n#else\n    c_isatty (fdFD fd) >>= return.toBool\n#endif\n\nsetEcho :: FD -> Bool -> IO ()\nsetEcho fd on = System.Posix.Internals.setEcho (fdFD fd) on\n\ngetEcho :: FD -> IO Bool\ngetEcho fd = System.Posix.Internals.getEcho (fdFD fd)\n\nsetRaw :: FD -> Bool -> IO ()\nsetRaw fd raw = System.Posix.Internals.setCooked (fdFD fd) (not raw)\n\n-- -----------------------------------------------------------------------------\n-- Reading and Writing\n\nfdRead :: FD -> Ptr Word8 -> Int -> IO Int\nfdRead fd ptr bytes\n  = do { r <- readRawBufferPtr \"GHC.IO.FD.fdRead\" fd ptr 0 (fromIntegral bytes)\n       ; return (fromIntegral r) }\n\nfdReadNonBlocking :: FD -> Ptr Word8 -> Int -> IO (Maybe Int)\nfdReadNonBlocking fd ptr bytes = do\n  r <- readRawBufferPtrNoBlock \"GHC.IO.FD.fdReadNonBlocking\" fd ptr\n           0 (fromIntegral bytes)\n  case fromIntegral r of\n    (-1) -> return (Nothing)\n    n    -> return (Just n)\n\n\nfdWrite :: FD -> Ptr Word8 -> Int -> IO ()\nfdWrite fd ptr bytes = do\n  res <- writeRawBufferPtr \"GHC.IO.FD.fdWrite\" fd ptr 0 (fromIntegral bytes)\n  let res' = fromIntegral res\n  if res' < bytes\n     then fdWrite fd (ptr `plusPtr` res') (bytes - res')\n     else return ()\n\n-- XXX ToDo: this isn't non-blocking\nfdWriteNonBlocking :: FD -> Ptr Word8 -> Int -> IO Int\nfdWriteNonBlocking fd ptr bytes = do\n  res <- writeRawBufferPtrNoBlock \"GHC.IO.FD.fdWriteNonBlocking\" fd ptr 0\n            (fromIntegral bytes)\n  return (fromIntegral res)\n\n-- -----------------------------------------------------------------------------\n-- FD operations\n\n-- Low level routines for reading/writing to (raw)buffers:\n\n#if !defined(mingw32_HOST_OS)\n\n{-\nNOTE [nonblock]:\n\nUnix has broken semantics when it comes to non-blocking I/O: you can\nset the O_NONBLOCK flag on an FD, but it applies to the all other FDs\nattached to the same underlying file, pipe or TTY; there's no way to\nhave private non-blocking behaviour for an FD.  See bug #724.\n\nWe fix this by only setting O_NONBLOCK on FDs that we create; FDs that\ncome from external sources or are exposed externally are left in\nblocking mode.  This solution has some problems though.  We can't\ncompletely simulate a non-blocking read without O_NONBLOCK: several\ncases are wrong here.  The cases that are wrong:\n\n  * reading/writing to a blocking FD in non-threaded mode.\n    In threaded mode, we just make a safe call to read().\n    In non-threaded mode we call select() before attempting to read,\n    but that leaves a small race window where the data can be read\n    from the file descriptor before we issue our blocking read().\n  * readRawBufferNoBlock for a blocking FD\n\nNOTE [2363]:\n\nIn the threaded RTS we could just make safe calls to read()/write()\nfor file descriptors in blocking mode without worrying about blocking\nother threads, but the problem with this is that the thread will be\nuninterruptible while it is blocked in the foreign call.  See #2363.\nSo now we always call fdReady() before reading, and if fdReady\nindicates that there's no data, we call threadWaitRead.\n\n-}\n\nreadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int\nreadRawBufferPtr loc !fd !buf !off !len\n  | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block\n  | otherwise    = do r <- throwErrnoIfMinus1 loc\n                                (unsafe_fdReady (fdFD fd) 0 0 0)\n                      if r /= 0\n                        then read\n                        else do threadWaitRead (fromIntegral (fdFD fd)); read\n  where\n    do_read call = fromIntegral `fmap`\n                      throwErrnoIfMinus1RetryMayBlock loc call\n                            (threadWaitRead (fromIntegral (fdFD fd)))\n    read        = if threaded then safe_read else unsafe_read\n    unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len)\n    safe_read   = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len)\n\n-- return: -1 indicates EOF, >=0 is bytes read\nreadRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int\nreadRawBufferPtrNoBlock loc !fd !buf !off !len\n  | isNonBlocking fd  = unsafe_read -- unsafe is ok, it can't block\n  | otherwise    = do r <- unsafe_fdReady (fdFD fd) 0 0 0\n                      if r /= 0 then safe_read\n                                else return 0\n       -- XXX see note [nonblock]\n where\n   do_read call = do r <- throwErrnoIfMinus1RetryOnBlock loc call (return (-1))\n                     case r of\n                       (-1) -> return 0\n                       0    -> return (-1)\n                       n    -> return (fromIntegral n)\n   unsafe_read  = do_read (c_read (fdFD fd) (buf `plusPtr` off) len)\n   safe_read    = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len)\n\nwriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nwriteRawBufferPtr loc !fd !buf !off !len\n  | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block\n  | otherwise   = do r <- unsafe_fdReady (fdFD fd) 1 0 0\n                     if r /= 0\n                        then write\n                        else do threadWaitWrite (fromIntegral (fdFD fd)); write\n  where\n    do_write call = fromIntegral `fmap`\n                      throwErrnoIfMinus1RetryMayBlock loc call\n                        (threadWaitWrite (fromIntegral (fdFD fd)))\n    write         = if threaded then safe_write else unsafe_write\n    unsafe_write  = do_write (c_write (fdFD fd) (buf `plusPtr` off) len)\n    safe_write    = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len)\n\nwriteRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nwriteRawBufferPtrNoBlock loc !fd !buf !off !len\n  | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block\n  | otherwise   = do r <- unsafe_fdReady (fdFD fd) 1 0 0\n                     if r /= 0 then write\n                               else return 0\n  where\n    do_write call = do r <- throwErrnoIfMinus1RetryOnBlock loc call (return (-1))\n                       case r of\n                         (-1) -> return 0\n                         n    -> return (fromIntegral n)\n    write         = if threaded then safe_write else unsafe_write\n    unsafe_write  = do_write (c_write (fdFD fd) (buf `plusPtr` off) len)\n    safe_write    = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len)\n\nisNonBlocking :: FD -> Bool\nisNonBlocking fd = fdIsNonBlocking fd /= 0\n\nforeign import ccall unsafe \"fdReady\"\n  unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt\n\n#else /* mingw32_HOST_OS.... */\n\nreadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nreadRawBufferPtr loc !fd !buf !off !len\n  | threaded  = blockingReadRawBufferPtr loc fd buf off len\n  | otherwise = asyncReadRawBufferPtr    loc fd buf off len\n\nwriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nwriteRawBufferPtr loc !fd !buf !off !len\n  | threaded  = blockingWriteRawBufferPtr loc fd buf off len\n  | otherwise = asyncWriteRawBufferPtr    loc fd buf off len\n\nreadRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nreadRawBufferPtrNoBlock = readRawBufferPtr\n\nwriteRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nwriteRawBufferPtrNoBlock = writeRawBufferPtr\n\n-- Async versions of the read/write primitives, for the non-threaded RTS\n\nasyncReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nasyncReadRawBufferPtr loc !fd !buf !off !len = do\n    (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd)\n                        (fromIntegral len) (buf `plusPtr` off)\n    if l == (-1)\n      then let sock_errno = c_maperrno_func (fromIntegral rc)\n               non_sock_errno = Errno (fromIntegral rc)\n               errno = bool non_sock_errno sock_errno (fdIsSocket fd)\n           in  ioError (errnoToIOError loc errno Nothing Nothing)\n      else return (fromIntegral l)\n\nasyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nasyncWriteRawBufferPtr loc !fd !buf !off !len = do\n    (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd)\n                  (fromIntegral len) (buf `plusPtr` off)\n    if l == (-1)\n      then let sock_errno = c_maperrno_func (fromIntegral rc)\n               non_sock_errno = Errno (fromIntegral rc)\n               errno = bool non_sock_errno sock_errno (fdIsSocket fd)\n           in  ioError (errnoToIOError loc errno Nothing Nothing)\n      else return (fromIntegral l)\n\n-- Blocking versions of the read/write primitives, for the threaded RTS\n\nblockingReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt\nblockingReadRawBufferPtr loc !fd !buf !off !len\n  = throwErrnoIfMinus1Retry loc $ do\n        let start_ptr = buf `plusPtr` off\n            recv_ret = c_safe_recv (fdFD fd) start_ptr (fromIntegral len) 0\n            read_ret = c_safe_read (fdFD fd) start_ptr (fromIntegral len)\n        r <- bool read_ret recv_ret (fdIsSocket fd)\n        when ((fdIsSocket fd) && (r == -1)) c_maperrno\n        return r\n      -- We trust read() to give us the correct errno but recv(), as a\n      -- Winsock function, doesn't do the errno conversion so if the fd\n      -- is for a socket, we do it from GetLastError() ourselves.\n\nblockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt\nblockingWriteRawBufferPtr loc !fd !buf !off !len\n  = throwErrnoIfMinus1Retry loc $ do\n        let start_ptr = buf `plusPtr` off\n            send_ret = c_safe_send  (fdFD fd) start_ptr (fromIntegral len) 0\n            write_ret = c_safe_write (fdFD fd) start_ptr (fromIntegral len)\n        r <- bool write_ret send_ret (fdIsSocket fd)\n        when (r == -1) c_maperrno\n        return r\n      -- We don't trust write() to give us the correct errno, and\n      -- instead do the errno conversion from GetLastError()\n      -- ourselves. The main reason is that we treat ERROR_NO_DATA\n      -- (pipe is closing) as EPIPE, whereas write() returns EINVAL\n      -- for this case. We need to detect EPIPE correctly, because it\n      -- shouldn't be reported as an error when it happens on stdout.\n      -- As for send()'s case, Winsock functions don't do errno\n      -- conversion in any case so we have to do it ourselves.\n      -- That means we're doing the errno conversion no matter if the\n      -- fd is from a socket or not.\n\n-- NOTE: \"safe\" versions of the read/write calls for use by the threaded RTS.\n-- These calls may block, but that's ok.\n\nforeign import WINDOWS_CCONV safe \"recv\"\n   c_safe_recv :: CInt -> Ptr Word8 -> CInt -> CInt{-flags-} -> IO CInt\n\nforeign import WINDOWS_CCONV safe \"send\"\n   c_safe_send :: CInt -> Ptr Word8 -> CInt -> CInt{-flags-} -> IO CInt\n\n#endif\n\nforeign import ccall unsafe \"rtsSupportsBoundThreads\" threaded :: Bool\n\n-- -----------------------------------------------------------------------------\n-- utils\n\n#if !defined(mingw32_HOST_OS)\nthrowErrnoIfMinus1RetryOnBlock  :: String -> IO CSsize -> IO CSsize -> IO CSsize\nthrowErrnoIfMinus1RetryOnBlock loc f on_block  =\n  do\n    res <- f\n    if (res :: CSsize) == -1\n      then do\n        err <- getErrno\n        if err == eINTR\n          then throwErrnoIfMinus1RetryOnBlock loc f on_block\n          else if err == eWOULDBLOCK || err == eAGAIN\n                 then do on_block\n                 else throwErrno loc\n      else return res\n#endif\n\n-- -----------------------------------------------------------------------------\n-- Locking/unlocking\n\nforeign import ccall unsafe \"lockFile\"\n  lockFile :: CInt -> Word64 -> Word64 -> CInt -> IO CInt\n\nforeign import ccall unsafe \"unlockFile\"\n  unlockFile :: CInt -> IO CInt\n\n#if defined(mingw32_HOST_OS)\nforeign import ccall unsafe \"get_unique_file_info\"\n  c_getUniqueFileInfo :: CInt -> Ptr Word64 -> Ptr Word64 -> IO ()\n#endif\n", "num_lines": 690}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , RecordWildCards\n           , NondecreasingIndentation\n  #-}\n{-# OPTIONS_GHC -Wno-unused-matches #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Handle\n-- Copyright   :  (c) The University of Glasgow, 1994-2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable\n--\n-- External API for GHC's Handle implementation\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Handle (\n   Handle,\n   BufferMode(..),\n\n   mkFileHandle, mkDuplexHandle,\n\n   hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead,\n   hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,\n   hFlush, hFlushAll, hDuplicate, hDuplicateTo,\n\n   hClose, hClose_help,\n\n   LockMode(..), hLock, hTryLock,\n\n   HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,\n   SeekMode(..), hSeek, hTell,\n\n   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,\n   hSetEcho, hGetEcho, hIsTerminalDevice,\n\n   hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,\n   noNewlineTranslation, universalNewlineMode, nativeNewlineMode,\n\n   hShow,\n\n   hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,\n\n   hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking\n ) where\n\nimport GHC.IO\nimport GHC.IO.Exception\nimport GHC.IO.Encoding\nimport GHC.IO.Buffer\nimport GHC.IO.BufferedIO ( BufferedIO )\nimport GHC.IO.Device as IODevice\nimport GHC.IO.Handle.FD\nimport GHC.IO.Handle.Lock\nimport GHC.IO.Handle.Types\nimport GHC.IO.Handle.Internals\nimport GHC.IO.Handle.Text\nimport qualified GHC.IO.BufferedIO as Buffered\n\nimport GHC.Base\nimport GHC.Exception\nimport GHC.MVar\nimport GHC.IORef\nimport GHC.Show\nimport GHC.Num\nimport GHC.Real\nimport Data.Maybe\nimport Data.Typeable\n\n-- ---------------------------------------------------------------------------\n-- Closing a handle\n\n-- | Computation 'hClose' @hdl@ makes handle @hdl@ closed.  Before the\n-- computation finishes, if @hdl@ is writable its buffer is flushed as\n-- for 'hFlush'.\n-- Performing 'hClose' on a handle that has already been closed has no effect;\n-- doing so is not an error.  All other operations on a closed handle will fail.\n-- If 'hClose' fails for any reason, any further operations (apart from\n-- 'hClose') on the handle will still fail as if @hdl@ had been successfully\n-- closed.\n\nhClose :: Handle -> IO ()\nhClose h@(FileHandle _ m)     = do\n  mb_exc <- hClose' h m\n  hClose_maybethrow mb_exc h\nhClose h@(DuplexHandle _ r w) = do\n  excs <- mapM (hClose' h) [r,w]\n  hClose_maybethrow (listToMaybe (catMaybes excs)) h\n\nhClose_maybethrow :: Maybe SomeException -> Handle -> IO ()\nhClose_maybethrow Nothing  h = return ()\nhClose_maybethrow (Just e) h = hClose_rethrow e h\n\nhClose_rethrow :: SomeException -> Handle -> IO ()\nhClose_rethrow e h =\n  case fromException e of\n    Just ioe -> ioError (augmentIOError ioe \"hClose\" h)\n    Nothing  -> throwIO e\n\nhClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)\nhClose' h m = withHandle' \"hClose\" h m $ hClose_help\n\n-----------------------------------------------------------------------------\n-- Detecting and changing the size of a file\n\n-- | For a handle @hdl@ which attached to a physical file,\n-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.\n\nhFileSize :: Handle -> IO Integer\nhFileSize handle =\n    withHandle_ \"hFileSize\" handle $ \\ handle_@Handle__{haDevice=dev} -> do\n    case haType handle_ of\n      ClosedHandle              -> ioe_closedHandle\n      SemiClosedHandle          -> ioe_semiclosedHandle\n      _ -> do flushWriteBuffer handle_\n              r <- IODevice.getSize dev\n              if r /= -1\n                 then return r\n                 else ioException (IOError Nothing InappropriateType \"hFileSize\"\n                                   \"not a regular file\" Nothing Nothing)\n\n\n-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.\n\nhSetFileSize :: Handle -> Integer -> IO ()\nhSetFileSize handle size =\n    withHandle_ \"hSetFileSize\" handle $ \\ handle_@Handle__{haDevice=dev} -> do\n    case haType handle_ of\n      ClosedHandle              -> ioe_closedHandle\n      SemiClosedHandle          -> ioe_semiclosedHandle\n      _ -> do flushWriteBuffer handle_\n              IODevice.setSize dev size\n              return ()\n\n-- ---------------------------------------------------------------------------\n-- Detecting the End of Input\n\n-- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns\n-- 'True' if no further input can be taken from @hdl@ or for a\n-- physical file, if the current I\\/O position is equal to the length of\n-- the file.  Otherwise, it returns 'False'.\n--\n-- NOTE: 'hIsEOF' may block, because it has to attempt to read from\n-- the stream to determine whether there is any more data to be read.\n\nhIsEOF :: Handle -> IO Bool\nhIsEOF handle = wantReadableHandle_ \"hIsEOF\" handle $ \\Handle__{..} -> do\n\n  cbuf <- readIORef haCharBuffer\n  if not (isEmptyBuffer cbuf) then return False else do\n\n  bbuf <- readIORef haByteBuffer\n  if not (isEmptyBuffer bbuf) then return False else do\n\n  -- NB. do no decoding, just fill the byte buffer; see #3808\n  (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf\n  if r == 0\n     then return True\n     else do writeIORef haByteBuffer bbuf'\n             return False\n\n-- ---------------------------------------------------------------------------\n-- isEOF\n\n-- | The computation 'isEOF' is identical to 'hIsEOF',\n-- except that it works only on 'stdin'.\n\nisEOF :: IO Bool\nisEOF = hIsEOF stdin\n\n-- ---------------------------------------------------------------------------\n-- Looking ahead\n\n-- | Computation 'hLookAhead' returns the next character from the handle\n-- without removing it from the input buffer, blocking until a character\n-- is available.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isEOFError' if the end of file has been reached.\n\nhLookAhead :: Handle -> IO Char\nhLookAhead handle =\n  wantReadableHandle_ \"hLookAhead\"  handle hLookAhead_\n\n-- ---------------------------------------------------------------------------\n-- Buffering Operations\n\n-- Three kinds of buffering are supported: line-buffering,\n-- block-buffering or no-buffering.  See GHC.IO.Handle for definition and\n-- further explanation of what the type represent.\n\n-- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for\n-- handle @hdl@ on subsequent reads and writes.\n--\n-- If the buffer mode is changed from 'BlockBuffering' or\n-- 'LineBuffering' to 'NoBuffering', then\n--\n--  * if @hdl@ is writable, the buffer is flushed as for 'hFlush';\n--\n--  * if @hdl@ is not writable, the contents of the buffer is discarded.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isPermissionError' if the handle has already been used\n--    for reading or writing and the implementation does not allow the\n--    buffering mode to be changed.\n\nhSetBuffering :: Handle -> BufferMode -> IO ()\nhSetBuffering handle mode =\n  withAllHandles__ \"hSetBuffering\" handle $ \\ handle_@Handle__{..} -> do\n  case haType of\n    ClosedHandle -> ioe_closedHandle\n    _ -> do\n         if mode == haBufferMode then return handle_ else do\n\n         -- See [note Buffer Sizing] in GHC.IO.Handle.Types\n\n          -- check for errors:\n          case mode of\n              BlockBuffering (Just n) | n <= 0    -> ioe_bufsiz n\n              _ -> return ()\n\n          -- for input terminals we need to put the terminal into\n          -- cooked or raw mode depending on the type of buffering.\n          is_tty <- IODevice.isTerminal haDevice\n          when (is_tty && isReadableHandleType haType) $\n                case mode of\n#if !defined(mingw32_HOST_OS)\n        -- 'raw' mode under win32 is a bit too specialised (and troublesome\n        -- for most common uses), so simply disable its use here.\n                  NoBuffering -> IODevice.setRaw haDevice True\n#else\n                  NoBuffering -> return ()\n#endif\n                  _           -> IODevice.setRaw haDevice False\n\n          -- throw away spare buffers, they might be the wrong size\n          writeIORef haBuffers BufferListNil\n\n          return Handle__{ haBufferMode = mode,.. }\n\n-- -----------------------------------------------------------------------------\n-- hSetEncoding\n\n-- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding\n-- for the handle @hdl@ to @encoding@.  The default encoding when a 'Handle' is\n-- created is 'System.IO.localeEncoding', namely the default encoding for the\n-- current locale.\n--\n-- To create a 'Handle' with no encoding at all, use 'openBinaryFile'.  To\n-- stop further encoding or decoding on an existing 'Handle', use\n-- 'hSetBinaryMode'.\n--\n-- 'hSetEncoding' may need to flush buffered data in order to change\n-- the encoding.\n--\nhSetEncoding :: Handle -> TextEncoding -> IO ()\nhSetEncoding hdl encoding = do\n  withAllHandles__ \"hSetEncoding\" hdl $ \\h_@Handle__{..} -> do\n    flushCharBuffer h_\n    closeTextCodecs h_\n    openTextEncoding (Just encoding) haType $ \\ mb_encoder mb_decoder -> do\n    bbuf <- readIORef haByteBuffer\n    ref <- newIORef (errorWithoutStackTrace \"last_decode\")\n    return (Handle__{ haLastDecode = ref,\n                      haDecoder = mb_decoder,\n                      haEncoder = mb_encoder,\n                      haCodec   = Just encoding, .. })\n\n-- | Return the current 'TextEncoding' for the specified 'Handle', or\n-- 'Nothing' if the 'Handle' is in binary mode.\n--\n-- Note that the 'TextEncoding' remembers nothing about the state of\n-- the encoder/decoder in use on this 'Handle'.  For example, if the\n-- encoding in use is UTF-16, then using 'hGetEncoding' and\n-- 'hSetEncoding' to save and restore the encoding may result in an\n-- extra byte-order-mark being written to the file.\n--\nhGetEncoding :: Handle -> IO (Maybe TextEncoding)\nhGetEncoding hdl =\n  withHandle_ \"hGetEncoding\" hdl $ \\h_@Handle__{..} -> return haCodec\n\n-- -----------------------------------------------------------------------------\n-- hFlush\n\n-- | The action 'hFlush' @hdl@ causes any items buffered for output\n-- in handle @hdl@ to be sent immediately to the operating system.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isFullError' if the device is full;\n--\n--  * 'System.IO.Error.isPermissionError' if a system resource limit would be\n--    exceeded. It is unspecified whether the characters in the buffer are\n--    discarded or retained under these circumstances.\n\nhFlush :: Handle -> IO ()\nhFlush handle = wantWritableHandle \"hFlush\" handle flushWriteBuffer\n\n-- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,\n-- including any buffered read data.  Buffered read data is flushed\n-- by seeking the file position back to the point before the bufferred\n-- data was read, and hence only works if @hdl@ is seekable (see\n-- 'hIsSeekable').\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isFullError' if the device is full;\n--\n--  * 'System.IO.Error.isPermissionError' if a system resource limit would be\n--    exceeded. It is unspecified whether the characters in the buffer are\n--    discarded or retained under these circumstances;\n--\n--  * 'System.IO.Error.isIllegalOperation' if @hdl@ has buffered read data, and\n--    is not seekable.\n\nhFlushAll :: Handle -> IO ()\nhFlushAll handle = withHandle_ \"hFlushAll\" handle flushBuffer\n\n-- -----------------------------------------------------------------------------\n-- Repositioning Handles\n\ndata HandlePosn = HandlePosn Handle HandlePosition\n\n-- | @since 4.1.0.0\ninstance Eq HandlePosn where\n    (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2\n\n-- | @since 4.1.0.0\ninstance Show HandlePosn where\n   showsPrec p (HandlePosn h pos) =\n        showsPrec p h . showString \" at position \" . shows pos\n\n  -- HandlePosition is the Haskell equivalent of POSIX' off_t.\n  -- We represent it as an Integer on the Haskell side, but\n  -- cheat slightly in that hGetPosn calls upon a C helper\n  -- that reports the position back via (merely) an Int.\ntype HandlePosition = Integer\n\n-- | Computation 'hGetPosn' @hdl@ returns the current I\\/O position of\n-- @hdl@ as a value of the abstract type 'HandlePosn'.\n\nhGetPosn :: Handle -> IO HandlePosn\nhGetPosn handle = do\n    posn <- hTell handle\n    return (HandlePosn handle posn)\n\n-- | If a call to 'hGetPosn' @hdl@ returns a position @p@,\n-- then computation 'hSetPosn' @p@ sets the position of @hdl@\n-- to the position it held at the time of the call to 'hGetPosn'.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isPermissionError' if a system resource limit would be\n--    exceeded.\n\nhSetPosn :: HandlePosn -> IO ()\nhSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i\n\n-- ---------------------------------------------------------------------------\n-- hSeek\n\n{- Note:\n - when seeking using `SeekFromEnd', positive offsets (>=0) means\n   seeking at or past EOF.\n\n - we possibly deviate from the report on the issue of seeking within\n   the buffer and whether to flush it or not.  The report isn't exactly\n   clear here.\n-}\n\n-- | Computation 'hSeek' @hdl mode i@ sets the position of handle\n-- @hdl@ depending on @mode@.\n-- The offset @i@ is given in terms of 8-bit bytes.\n--\n-- If @hdl@ is block- or line-buffered, then seeking to a position which is not\n-- in the current buffer will first cause any items in the output buffer to be\n-- written to the device, and then cause the input buffer to be discarded.\n-- Some handles may not be seekable (see 'hIsSeekable'), or only support a\n-- subset of the possible positioning operations (for instance, it may only\n-- be possible to seek to the end of a tape, or to a positive offset from\n-- the beginning or current position).\n-- It is not possible to set a negative I\\/O position, or for\n-- a physical file, an I\\/O position beyond the current end-of-file.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isIllegalOperationError' if the Handle is not seekable,\n--    or does not support the requested seek mode.\n--\n--  * 'System.IO.Error.isPermissionError' if a system resource limit would be\n--    exceeded.\n\nhSeek :: Handle -> SeekMode -> Integer -> IO ()\nhSeek handle mode offset =\n    wantSeekableHandle \"hSeek\" handle $ \\ handle_@Handle__{..} -> do\n    debugIO (\"hSeek \" ++ show (mode,offset))\n    buf <- readIORef haCharBuffer\n\n    if isWriteBuffer buf\n        then do flushWriteBuffer handle_\n                IODevice.seek haDevice mode offset\n        else do\n\n    let r = bufL buf; w = bufR buf\n    if mode == RelativeSeek && isNothing haDecoder &&\n       offset >= 0 && offset < fromIntegral (w - r)\n        then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset }\n        else do\n\n    flushCharReadBuffer handle_\n    flushByteReadBuffer handle_\n    IODevice.seek haDevice mode offset\n\n\n-- | Computation 'hTell' @hdl@ returns the current position of the\n-- handle @hdl@, as the number of bytes from the beginning of\n-- the file.  The value returned may be subsequently passed to\n-- 'hSeek' to reposition the handle to the current position.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isIllegalOperationError' if the Handle is not seekable.\n--\nhTell :: Handle -> IO Integer\nhTell handle =\n    wantSeekableHandle \"hGetPosn\" handle $ \\ handle_@Handle__{..} -> do\n\n      posn <- IODevice.tell haDevice\n\n      -- we can't tell the real byte offset if there are buffered\n      -- Chars, so must flush first:\n      flushCharBuffer handle_\n\n      bbuf <- readIORef haByteBuffer\n\n      let real_posn\n           | isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)\n           | otherwise          = posn - fromIntegral (bufferElems bbuf)\n\n      cbuf <- readIORef haCharBuffer\n      debugIO (\"\\nhGetPosn: (posn, real_posn) = \" ++ show (posn, real_posn))\n      debugIO (\"   cbuf: \" ++ summaryBuffer cbuf ++\n            \"   bbuf: \" ++ summaryBuffer bbuf)\n\n      return real_posn\n\n-- -----------------------------------------------------------------------------\n-- Handle Properties\n\n-- A number of operations return information about the properties of a\n-- handle.  Each of these operations returns `True' if the handle has\n-- the specified property, and `False' otherwise.\n\nhIsOpen :: Handle -> IO Bool\nhIsOpen handle =\n    withHandle_ \"hIsOpen\" handle $ \\ handle_ -> do\n    case haType handle_ of\n      ClosedHandle         -> return False\n      SemiClosedHandle     -> return False\n      _                    -> return True\n\nhIsClosed :: Handle -> IO Bool\nhIsClosed handle =\n    withHandle_ \"hIsClosed\" handle $ \\ handle_ -> do\n    case haType handle_ of\n      ClosedHandle         -> return True\n      _                    -> return False\n\n{- not defined, nor exported, but mentioned\n   here for documentation purposes:\n\n    hSemiClosed :: Handle -> IO Bool\n    hSemiClosed h = do\n       ho <- hIsOpen h\n       hc <- hIsClosed h\n       return (not (ho || hc))\n-}\n\nhIsReadable :: Handle -> IO Bool\nhIsReadable (DuplexHandle _ _ _) = return True\nhIsReadable handle =\n    withHandle_ \"hIsReadable\" handle $ \\ handle_ -> do\n    case haType handle_ of\n      ClosedHandle         -> ioe_closedHandle\n      SemiClosedHandle     -> ioe_semiclosedHandle\n      htype                -> return (isReadableHandleType htype)\n\nhIsWritable :: Handle -> IO Bool\nhIsWritable (DuplexHandle _ _ _) = return True\nhIsWritable handle =\n    withHandle_ \"hIsWritable\" handle $ \\ handle_ -> do\n    case haType handle_ of\n      ClosedHandle         -> ioe_closedHandle\n      SemiClosedHandle     -> ioe_semiclosedHandle\n      htype                -> return (isWritableHandleType htype)\n\n-- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode\n-- for @hdl@.\n\nhGetBuffering :: Handle -> IO BufferMode\nhGetBuffering handle =\n    withHandle_ \"hGetBuffering\" handle $ \\ handle_ -> do\n    case haType handle_ of\n      ClosedHandle         -> ioe_closedHandle\n      _ ->\n           -- We're being non-standard here, and allow the buffering\n           -- of a semi-closed handle to be queried.   -- sof 6/98\n          return (haBufferMode handle_)  -- could be stricter..\n\nhIsSeekable :: Handle -> IO Bool\nhIsSeekable handle =\n    withHandle_ \"hIsSeekable\" handle $ \\ handle_@Handle__{..} -> do\n    case haType of\n      ClosedHandle         -> ioe_closedHandle\n      SemiClosedHandle     -> ioe_semiclosedHandle\n      AppendHandle         -> return False\n      _                    -> IODevice.isSeekable haDevice\n\n-- -----------------------------------------------------------------------------\n-- Changing echo status\n\n-- | Set the echoing status of a handle connected to a terminal.\n\nhSetEcho :: Handle -> Bool -> IO ()\nhSetEcho handle on = do\n    isT   <- hIsTerminalDevice handle\n    if not isT\n     then return ()\n     else\n      withHandle_ \"hSetEcho\" handle $ \\ Handle__{..} -> do\n      case haType of\n         ClosedHandle -> ioe_closedHandle\n         _            -> IODevice.setEcho haDevice on\n\n-- | Get the echoing status of a handle connected to a terminal.\n\nhGetEcho :: Handle -> IO Bool\nhGetEcho handle = do\n    isT   <- hIsTerminalDevice handle\n    if not isT\n     then return False\n     else\n       withHandle_ \"hGetEcho\" handle $ \\ Handle__{..} -> do\n       case haType of\n         ClosedHandle -> ioe_closedHandle\n         _            -> IODevice.getEcho haDevice\n\n-- | Is the handle connected to a terminal?\n\nhIsTerminalDevice :: Handle -> IO Bool\nhIsTerminalDevice handle = do\n    withHandle_ \"hIsTerminalDevice\" handle $ \\ Handle__{..} -> do\n     case haType of\n       ClosedHandle -> ioe_closedHandle\n       _            -> IODevice.isTerminal haDevice\n\n-- -----------------------------------------------------------------------------\n-- hSetBinaryMode\n\n-- | Select binary mode ('True') or text mode ('False') on a open handle.\n-- (See also 'openBinaryFile'.)\n--\n-- This has the same effect as calling 'hSetEncoding' with 'char8', together\n-- with 'hSetNewlineMode' with 'noNewlineTranslation'.\n--\nhSetBinaryMode :: Handle -> Bool -> IO ()\nhSetBinaryMode handle bin =\n  withAllHandles__ \"hSetBinaryMode\" handle $ \\ h_@Handle__{..} ->\n    do\n         flushCharBuffer h_\n         closeTextCodecs h_\n\n         mb_te <- if bin then return Nothing\n                         else fmap Just getLocaleEncoding\n\n         openTextEncoding mb_te haType $ \\ mb_encoder mb_decoder -> do\n\n         -- should match the default newline mode, whatever that is\n         let nl    | bin       = noNewlineTranslation\n                   | otherwise = nativeNewlineMode\n\n         bbuf <- readIORef haByteBuffer\n         ref <- newIORef (errorWithoutStackTrace \"codec_state\", bbuf)\n\n         return Handle__{ haLastDecode = ref,\n                          haEncoder  = mb_encoder,\n                          haDecoder  = mb_decoder,\n                          haCodec    = mb_te,\n                          haInputNL  = inputNL nl,\n                          haOutputNL = outputNL nl, .. }\n\n-- -----------------------------------------------------------------------------\n-- hSetNewlineMode\n\n-- | Set the 'NewlineMode' on the specified 'Handle'.  All buffered\n-- data is flushed first.\nhSetNewlineMode :: Handle -> NewlineMode -> IO ()\nhSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =\n  withAllHandles__ \"hSetNewlineMode\" handle $ \\h_@Handle__{} ->\n    do\n         flushBuffer h_\n         return h_{ haInputNL=i, haOutputNL=o }\n\n-- -----------------------------------------------------------------------------\n-- Duplicating a Handle\n\n-- | Returns a duplicate of the original handle, with its own buffer.\n-- The two Handles will share a file pointer, however.  The original\n-- handle's buffer is flushed, including discarding any input data,\n-- before the handle is duplicated.\n\nhDuplicate :: Handle -> IO Handle\nhDuplicate h@(FileHandle path m) = do\n  withHandle_' \"hDuplicate\" h m $ \\h_ ->\n      dupHandle path h Nothing h_ (Just handleFinalizer)\nhDuplicate h@(DuplexHandle path r w) = do\n  write_side@(FileHandle _ write_m) <-\n     withHandle_' \"hDuplicate\" h w $ \\h_ ->\n        dupHandle path h Nothing h_ (Just handleFinalizer)\n  read_side@(FileHandle _ read_m) <-\n    withHandle_' \"hDuplicate\" h r $ \\h_ ->\n        dupHandle path h (Just write_m) h_  Nothing\n  return (DuplexHandle path read_m write_m)\n\ndupHandle :: FilePath\n          -> Handle\n          -> Maybe (MVar Handle__)\n          -> Handle__\n          -> Maybe HandleFinalizer\n          -> IO Handle\ndupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do\n  -- flush the buffer first, so we don't have to copy its contents\n  flushBuffer h_\n  case other_side of\n    Nothing -> do\n       new_dev <- IODevice.dup haDevice\n       dupHandle_ new_dev filepath other_side h_ mb_finalizer\n    Just r  ->\n       withHandle_' \"dupHandle\" h r $ \\Handle__{haDevice=dev} -> do\n         dupHandle_ dev filepath other_side h_ mb_finalizer\n\ndupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev\n           -> FilePath\n           -> Maybe (MVar Handle__)\n           -> Handle__\n           -> Maybe HandleFinalizer\n           -> IO Handle\ndupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do\n   -- XXX wrong!\n  mb_codec <- if isJust haEncoder then fmap Just getLocaleEncoding else return Nothing\n  mkHandle new_dev filepath haType True{-buffered-} mb_codec\n      NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }\n      mb_finalizer other_side\n\n-- -----------------------------------------------------------------------------\n-- Replacing a Handle\n\n{- |\nMakes the second handle a duplicate of the first handle.  The second\nhandle will be closed first, if it is not already.\n\nThis can be used to retarget the standard Handles, for example:\n\n> do h <- openFile \"mystdout\" WriteMode\n>    hDuplicateTo h stdout\n-}\n\nhDuplicateTo :: Handle -> Handle -> IO ()\nhDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2)  = do\n withHandle__' \"hDuplicateTo\" h2 m2 $ \\h2_ -> do\n   _ <- hClose_help h2_\n   withHandle_' \"hDuplicateTo\" h1 m1 $ \\h1_ -> do\n     dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)\nhDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2)  = do\n withHandle__' \"hDuplicateTo\" h2 w2  $ \\w2_ -> do\n   _ <- hClose_help w2_\n   withHandle_' \"hDuplicateTo\" h1 w1 $ \\w1_ -> do\n     dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)\n withHandle__' \"hDuplicateTo\" h2 r2  $ \\r2_ -> do\n   _ <- hClose_help r2_\n   withHandle_' \"hDuplicateTo\" h1 r1 $ \\r1_ -> do\n     dupHandleTo path h1 (Just w1) r2_ r1_ Nothing\nhDuplicateTo h1 _ =\n  ioe_dupHandlesNotCompatible h1\n\n\nioe_dupHandlesNotCompatible :: Handle -> IO a\nioe_dupHandlesNotCompatible h =\n   ioException (IOError (Just h) IllegalOperation \"hDuplicateTo\"\n                \"handles are incompatible\" Nothing Nothing)\n\ndupHandleTo :: FilePath\n            -> Handle\n            -> Maybe (MVar Handle__)\n            -> Handle__\n            -> Handle__\n            -> Maybe HandleFinalizer\n            -> IO Handle__\ndupHandleTo filepath h other_side\n            hto_@Handle__{haDevice=devTo}\n            h_@Handle__{haDevice=dev} mb_finalizer = do\n  flushBuffer h_\n  case cast devTo of\n    Nothing   -> ioe_dupHandlesNotCompatible h\n    Just dev' -> do\n      _ <- IODevice.dup2 dev dev'\n      FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer\n      takeMVar m\n\n-- ---------------------------------------------------------------------------\n-- showing Handles.\n--\n-- | 'hShow' is in the 'IO' monad, and gives more comprehensive output\n-- than the (pure) instance of 'Show' for 'Handle'.\n\nhShow :: Handle -> IO String\nhShow h@(FileHandle path _) = showHandle' path False h\nhShow h@(DuplexHandle path _ _) = showHandle' path True h\n\nshowHandle' :: String -> Bool -> Handle -> IO String\nshowHandle' filepath is_duplex h =\n  withHandle_ \"showHandle\" h $ \\hdl_ ->\n    let\n     showType | is_duplex = showString \"duplex (read-write)\"\n              | otherwise = shows (haType hdl_)\n    in\n    return\n      (( showChar '{' .\n        showHdl (haType hdl_)\n            (showString \"loc=\" . showString filepath . showChar ',' .\n             showString \"type=\" . showType . showChar ',' .\n             showString \"buffering=\" . showBufMode (unsafePerformIO (readIORef (haCharBuffer hdl_))) (haBufferMode hdl_) . showString \"}\" )\n      ) \"\")\n   where\n\n    showHdl :: HandleType -> ShowS -> ShowS\n    showHdl ht cont =\n       case ht of\n        ClosedHandle  -> shows ht . showString \"}\"\n        _ -> cont\n\n    showBufMode :: Buffer e -> BufferMode -> ShowS\n    showBufMode buf bmo =\n      case bmo of\n        NoBuffering   -> showString \"none\"\n        LineBuffering -> showString \"line\"\n        BlockBuffering (Just n) -> showString \"block \" . showParen True (shows n)\n        BlockBuffering Nothing  -> showString \"block \" . showParen True (shows def)\n      where\n       def :: Int\n       def = bufSize buf\n\n", "num_lines": 761}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.IOMode\n-- Copyright   :  (c) The University of Glasgow, 1994-2008\n-- License     :  see libraries/base/LICENSE\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- The IOMode type\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.IOMode (IOMode(..)) where\n\nimport GHC.Base\nimport GHC.Show\nimport GHC.Read\nimport GHC.Arr\nimport GHC.Enum\n\n-- | See 'System.IO.openFile'\ndata IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode\n                    deriving ( Eq   -- ^ @since 4.2.0.0\n                             , Ord  -- ^ @since 4.2.0.0\n                             , Ix   -- ^ @since 4.2.0.0\n                             , Enum -- ^ @since 4.2.0.0\n                             , Read -- ^ @since 4.2.0.0\n                             , Show -- ^ @since 4.2.0.0\n                             )\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude\n           , MagicHash\n           , UnboxedTuples\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Unsafe\n-- Copyright   :  (c) The University of Glasgow 1994-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Unsafe IO operations\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Unsafe (\n    unsafePerformIO, unsafeInterleaveIO,\n    unsafeDupablePerformIO, unsafeDupableInterleaveIO,\n    noDuplicate,\n  ) where\n\nimport GHC.Base\n\n\n{-|\nThis is the \\\"back door\\\" into the 'IO' monad, allowing\n'IO' computation to be performed at any time.  For\nthis to be safe, the 'IO' computation should be\nfree of side effects and independent of its environment.\n\nIf the I\\/O computation wrapped in 'unsafePerformIO' performs side\neffects, then the relative order in which those side effects take\nplace (relative to the main I\\/O trunk, or other calls to\n'unsafePerformIO') is indeterminate.  Furthermore, when using\n'unsafePerformIO' to cause side-effects, you should take the following\nprecautions to ensure the side effects are performed as many times as\nyou expect them to be.  Note that these precautions are necessary for\nGHC, but may not be sufficient, and other compilers may require\ndifferent precautions:\n\n  * Use @{\\-\\# NOINLINE foo \\#-\\}@ as a pragma on any function @foo@\n        that calls 'unsafePerformIO'.  If the call is inlined,\n        the I\\/O may be performed more than once.\n\n  * Use the compiler flag @-fno-cse@ to prevent common sub-expression\n        elimination being performed on the module, which might combine\n        two side effects that were meant to be separate.  A good example\n        is using multiple global variables (like @test@ in the example below).\n\n  * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the\n        call to 'unsafePerformIO' cannot float outside a lambda.  For example,\n        if you say:\n        @\n           f x = unsafePerformIO (newIORef [])\n        @\n        you may get only one reference cell shared between all calls to @f@.\n        Better would be\n        @\n           f x = unsafePerformIO (newIORef [x])\n        @\n        because now it can't float outside the lambda.\n\nIt is less well known that\n'unsafePerformIO' is not type safe.  For example:\n\n>     test :: IORef [a]\n>     test = unsafePerformIO $ newIORef []\n>\n>     main = do\n>             writeIORef test [42]\n>             bang <- readIORef test\n>             print (bang :: [Char])\n\nThis program will core dump.  This problem with polymorphic references\nis well known in the ML community, and does not arise with normal\nmonadic use of references.  There is no easy way to make it impossible\nonce you use 'unsafePerformIO'.  Indeed, it is\npossible to write @coerce :: a -> b@ with the\nhelp of 'unsafePerformIO'.  So be careful!\n-}\nunsafePerformIO :: IO a -> a\nunsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)\n\n{-|\nThis version of 'unsafePerformIO' is more efficient\nbecause it omits the check that the IO is only being performed by a\nsingle thread.  Hence, when you use 'unsafeDupablePerformIO',\nthere is a possibility that the IO action may be performed multiple\ntimes (on a multiprocessor), and you should therefore ensure that\nit gives the same results each time. It may even happen that one\nof the duplicated IO actions is only run partially, and then interrupted\nin the middle without an exception being raised. Therefore, functions\nlike 'Control.Exception.bracket' cannot be used safely within\n'unsafeDupablePerformIO'.\n\n@since 4.4.0.0\n-}\nunsafeDupablePerformIO  :: IO a -> a\nunsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a\n\n{-|\n'unsafeInterleaveIO' allows an 'IO' computation to be deferred lazily.\nWhen passed a value of type @IO a@, the 'IO' will only be performed\nwhen the value of the @a@ is demanded.  This is used to implement lazy\nfile reading, see 'System.IO.hGetContents'.\n-}\n{-# INLINE unsafeInterleaveIO #-}\nunsafeInterleaveIO :: IO a -> IO a\nunsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)\n\n-- Note [unsafeDupableInterleaveIO should not be inlined]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- We used to believe that INLINE on unsafeInterleaveIO was safe,\n-- because the state from this IO thread is passed explicitly to the\n-- interleaved IO, so it cannot be floated out and shared.\n--\n-- HOWEVER, if the compiler figures out that r is used strictly here,\n-- then it will eliminate the thunk and the side effects in m will no\n-- longer be shared in the way the programmer was probably expecting,\n-- but can be performed many times.  In #5943, this broke our\n-- definition of fixIO, which contains\n--\n--    ans <- unsafeInterleaveIO (takeMVar m)\n--\n-- after inlining, we lose the sharing of the takeMVar, so the second\n-- time 'ans' was demanded we got a deadlock.  We could fix this with\n-- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes\n-- share and sometimes not (plus it probably breaks the noDuplicate).\n-- So now, we do not inline unsafeDupableInterleaveIO.\n\n{-|\n'unsafeDupableInterleaveIO' allows an 'IO' computation to be deferred lazily.\nWhen passed a value of type @IO a@, the 'IO' will only be performed\nwhen the value of the @a@ is demanded.\n\nThe computation may be performed multiple times by different threads,\npossibly at the same time. To ensure that the computation is performed\nonly once, use 'unsafeInterleaveIO' instead.\n-}\n\n{-# NOINLINE unsafeDupableInterleaveIO #-}\n-- See Note [unsafeDupableInterleaveIO should not be inlined]\nunsafeDupableInterleaveIO :: IO a -> IO a\nunsafeDupableInterleaveIO (IO m)\n  = IO ( \\ s -> let\n                   r = case m s of (# _, res #) -> res\n                in\n                (# s, r #))\n\n{-|\nEnsures that the suspensions under evaluation by the current thread\nare unique; that is, the current thread is not evaluating anything\nthat is also under evaluation by another thread that has also executed\n'noDuplicate'.\n\nThis operation is used in the definition of 'unsafePerformIO' to\nprevent the IO action from being executed multiple times, which is usually\nundesirable.\n-}\nnoDuplicate :: IO ()\nnoDuplicate = IO $ \\s -> case noDuplicate# s of s' -> (# s', () #)\n", "num_lines": 169}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, BangPatterns, NoImplicitPrelude,\n             NondecreasingIndentation, MagicHash #-}\n\nmodule GHC.IO.Encoding.CodePage(\n#if defined(mingw32_HOST_OS)\n                        codePageEncoding, mkCodePageEncoding,\n                        localeEncoding, mkLocaleEncoding\n#endif\n                            ) where\n\n#if !defined(mingw32_HOST_OS)\nimport GHC.Base () -- Build ordering\n#else\nimport GHC.Base\nimport GHC.Show\nimport GHC.Num\nimport GHC.Enum\nimport GHC.Word\nimport GHC.IO (unsafePerformIO)\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\nimport GHC.IO.Buffer\nimport Data.Bits\nimport Data.Maybe\nimport Data.OldList (lookup)\n\nimport qualified GHC.IO.Encoding.CodePage.API as API\nimport GHC.IO.Encoding.CodePage.Table\n\nimport GHC.IO.Encoding.UTF8 (mkUTF8)\nimport GHC.IO.Encoding.UTF16 (mkUTF16le, mkUTF16be)\nimport GHC.IO.Encoding.UTF32 (mkUTF32le, mkUTF32be)\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\n-- note CodePage = UInt which might not work on Win64.  But the Win32 package\n-- also has this issue.\ngetCurrentCodePage :: IO Word32\ngetCurrentCodePage = do\n    conCP <- getConsoleCP\n    if conCP > 0\n        then return conCP\n        else getACP\n\n-- Since the Win32 package depends on base, we have to import these ourselves:\nforeign import WINDOWS_CCONV unsafe \"windows.h GetConsoleCP\"\n    getConsoleCP :: IO Word32\n\nforeign import WINDOWS_CCONV unsafe \"windows.h GetACP\"\n    getACP :: IO Word32\n\n{-# NOINLINE currentCodePage #-}\ncurrentCodePage :: Word32\ncurrentCodePage = unsafePerformIO getCurrentCodePage\n\nlocaleEncoding :: TextEncoding\nlocaleEncoding = mkLocaleEncoding ErrorOnCodingFailure\n\nmkLocaleEncoding :: CodingFailureMode -> TextEncoding\nmkLocaleEncoding cfm = mkCodePageEncoding cfm currentCodePage\n\n\ncodePageEncoding :: Word32 -> TextEncoding\ncodePageEncoding = mkCodePageEncoding ErrorOnCodingFailure\n\nmkCodePageEncoding :: CodingFailureMode -> Word32 -> TextEncoding\nmkCodePageEncoding cfm 65001 = mkUTF8 cfm\nmkCodePageEncoding cfm 1200 = mkUTF16le cfm\nmkCodePageEncoding cfm 1201 = mkUTF16be cfm\nmkCodePageEncoding cfm 12000 = mkUTF32le cfm\nmkCodePageEncoding cfm 12001 = mkUTF32be cfm\nmkCodePageEncoding cfm cp = maybe (API.mkCodePageEncoding cfm cp) (buildEncoding cfm cp) (lookup cp codePageMap)\n\nbuildEncoding :: CodingFailureMode -> Word32 -> CodePageArrays -> TextEncoding\nbuildEncoding cfm cp SingleByteCP {decoderArray = dec, encoderArray = enc}\n  = TextEncoding {\n      textEncodingName = \"CP\" ++ show cp\n    , mkTextDecoder = return $ simpleCodec (recoverDecode cfm) $ decodeFromSingleByte dec\n    , mkTextEncoder = return $ simpleCodec (recoverEncode cfm) $ encodeToSingleByte enc\n    }\n\nsimpleCodec :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))\n            -> (Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to))\n                -> BufferCodec from to ()\nsimpleCodec r f = BufferCodec {\n    encode = f,\n    recover = r,\n    close = return (),\n    getState = return (),\n    setState = return\n  }\n\ndecodeFromSingleByte :: ConvArray Char -> DecodeBuffer\ndecodeFromSingleByte convArr\n    input@Buffer  { bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n    output@Buffer { bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n  = let\n        done why !ir !ow = return (why,\n                                   if ir==iw then input{ bufL=0, bufR=0}\n                                             else input{ bufL=ir},\n                                   output {bufR=ow})\n        loop !ir !ow\n            | ow >= os  = done OutputUnderflow ir ow\n            | ir >= iw  = done InputUnderflow ir ow\n            | otherwise = do\n                b <- readWord8Buf iraw ir\n                let c = lookupConv convArr b\n                if c=='\\0' && b /= 0 then invalid else do\n                ow' <- writeCharBuf oraw ow c\n                loop (ir+1) ow'\n          where\n            invalid = done InvalidSequence ir ow\n    in loop ir0 ow0\n\nencodeToSingleByte :: CompactArray Char Word8 -> EncodeBuffer\nencodeToSingleByte CompactArray { encoderMax = maxChar,\n                         encoderIndices = indices,\n                         encoderValues = values }\n    input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }\n    output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n  = let\n        done why !ir !ow = return (why,\n                                   if ir==iw then input { bufL=0, bufR=0 }\n                                             else input { bufL=ir },\n                                   output {bufR=ow})\n        loop !ir !ow\n            | ow >= os  = done OutputUnderflow ir ow\n            | ir >= iw  = done InputUnderflow ir ow\n            | otherwise = do\n                (c,ir') <- readCharBuf iraw ir\n                case lookupCompact maxChar indices values c of\n                    Nothing -> invalid\n                    Just 0 | c /= '\\0' -> invalid\n                    Just b -> do\n                        writeWord8Buf oraw ow b\n                        loop ir' (ow+1)\n            where\n                invalid = done InvalidSequence ir ow\n    in\n    loop ir0 ow0\n\n\n--------------------------------------------\n-- Array access functions\n\n-- {-# INLINE lookupConv #-}\nlookupConv :: ConvArray Char -> Word8 -> Char\nlookupConv a = indexChar a . fromEnum\n\n{-# INLINE lookupCompact #-}\nlookupCompact :: Char -> ConvArray Int -> ConvArray Word8 -> Char -> Maybe Word8\nlookupCompact maxVal indexes values x\n    | x > maxVal = Nothing\n    | otherwise = Just $ indexWord8 values $ j + (i .&. mask)\n  where\n    i = fromEnum x\n    mask = (1 `shiftL` n) - 1\n    k = i `shiftR` n\n    j = indexInt indexes k\n    n = blockBitSize\n\n{-# INLINE indexInt #-}\nindexInt :: ConvArray Int -> Int -> Int\nindexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)\n\n{-# INLINE indexWord8 #-}\nindexWord8 :: ConvArray Word8 -> Int -> Word8\nindexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)\n\n{-# INLINE indexChar #-}\nindexChar :: ConvArray Char -> Int -> Char\nindexChar (ConvArray p) (I# i) = C# (chr# (indexInt16OffAddr# p i))\n\n#endif\n\n", "num_lines": 185}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding.Failure\n-- Copyright   :  (c) The University of Glasgow, 2008-2011\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Types for specifying how text encoding/decoding fails\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding.Failure (\n    CodingFailureMode(..), codingFailureModeSuffix,\n    isSurrogate,\n    recoverDecode, recoverEncode\n  ) where\n\nimport GHC.IO\nimport GHC.IO.Buffer\nimport GHC.IO.Exception\n\nimport GHC.Base\nimport GHC.Char\nimport GHC.Word\nimport GHC.Show\nimport GHC.Num\nimport GHC.Real ( fromIntegral )\n\n--import System.Posix.Internals\n\n-- | The 'CodingFailureMode' is used to construct 'System.IO.TextEncoding's,\n-- and specifies how they handle illegal sequences.\ndata CodingFailureMode\n  = ErrorOnCodingFailure\n       -- ^ Throw an error when an illegal sequence is encountered\n  | IgnoreCodingFailure\n       -- ^ Attempt to ignore and recover if an illegal sequence is\n       -- encountered\n  | TransliterateCodingFailure\n       -- ^ Replace with the closest visual match upon an illegal\n       -- sequence\n  | RoundtripFailure\n       -- ^ Use the private-use escape mechanism to attempt to allow\n       -- illegal sequences to be roundtripped.\n  deriving ( Show -- ^ @since 4.4.0.0\n           )\n       -- This will only work properly for those encodings which are\n       -- strict supersets of ASCII in the sense that valid ASCII data\n       -- is also valid in that encoding. This is not true for\n       -- e.g. UTF-16, because ASCII characters must be padded to two\n       -- bytes to retain their meaning.\n\n-- Note [Roundtripping]\n-- ~~~~~~~~~~~~~~~~~~~~\n--\n-- Roundtripping is based on the ideas of PEP383.\n--\n-- We used to use the range of private-use characters from 0xEF80 to\n-- 0xEFFF designated for \"encoding hacks\" by the ConScript Unicode Registery\n-- to encode these characters.\n--\n-- However, people didn't like this because it means we don't get\n-- guaranteed roundtripping for byte sequences that look like a UTF-8\n-- encoded codepoint 0xEFxx.\n--\n-- So now like PEP383 we use lone surrogate codepoints 0xDCxx to escape\n-- undecodable bytes, even though that may confuse Unicode processing\n-- software written in Haskell. This guarantees roundtripping because\n-- unicode input that includes lone surrogate codepoints is invalid by\n-- definition.\n--\n--\n-- When we used private-use characters there was a technical problem when it\n-- came to encoding back to bytes using iconv. The iconv code will not fail when\n-- it tries to encode a private-use character (as it would if trying to encode\n-- a surrogate), which means that we wouldn't get a chance to replace it\n-- with the byte we originally escaped.\n--\n-- To work around this, when filling the buffer to be encoded (in\n-- writeBlocks/withEncodedCString/newEncodedCString), we replaced the\n-- private-use characters with lone surrogates again! Likewise, when\n-- reading from a buffer (unpack/unpack_nl/peekEncodedCString) we had\n-- to do the inverse process.\n--\n-- The user of String would never see these lone surrogates, but it\n-- ensured that iconv will throw an error when encountering them.  We\n-- used lone surrogates in the range 0xDC00 to 0xDCFF for this purpose.\n\ncodingFailureModeSuffix :: CodingFailureMode -> String\ncodingFailureModeSuffix ErrorOnCodingFailure       = \"\"\ncodingFailureModeSuffix IgnoreCodingFailure        = \"//IGNORE\"\ncodingFailureModeSuffix TransliterateCodingFailure = \"//TRANSLIT\"\ncodingFailureModeSuffix RoundtripFailure           = \"//ROUNDTRIP\"\n\n-- | In transliterate mode, we use this character when decoding\n-- unknown bytes.\n--\n-- This is the defined Unicode replacement character:\n-- <http://www.fileformat.info/info/unicode/char/0fffd/index.htm>\nunrepresentableChar :: Char\nunrepresentableChar = '\\xFFFD'\n\n-- It is extraordinarily important that this series of\n-- predicates/transformers gets inlined, because they tend to be used\n-- in inner loops related to text encoding. In particular,\n-- surrogatifyRoundtripCharacter must be inlined (see #5536)\n\n-- | Some characters are actually \"surrogate\" codepoints defined for\n-- use in UTF-16. We need to signal an invalid character if we detect\n-- them when encoding a sequence of 'Char's into 'Word8's because they\n-- won't give valid Unicode.\n--\n-- We may also need to signal an invalid character if we detect them\n-- when encoding a sequence of 'Char's into 'Word8's because the\n-- 'RoundtripFailure' mode creates these to round-trip bytes through\n-- our internal UTF-16 encoding.\n{-# INLINE isSurrogate #-}\nisSurrogate :: Char -> Bool\nisSurrogate c = (0xD800 <= x && x <= 0xDBFF)\n             || (0xDC00 <= x && x <= 0xDFFF)\n  where x = ord c\n\n-- Bytes (in Buffer Word8) --> lone surrogates (in Buffer CharBufElem)\n{-# INLINE escapeToRoundtripCharacterSurrogate #-}\nescapeToRoundtripCharacterSurrogate :: Word8 -> Char\nescapeToRoundtripCharacterSurrogate b\n  | b < 128   = chr (fromIntegral b)\n      -- Disallow 'smuggling' of ASCII bytes. For roundtripping to\n      -- work, this assumes encoding is ASCII-superset.\n  | otherwise = chr (0xDC00 + fromIntegral b)\n\n-- Lone surrogates (in Buffer CharBufElem) --> bytes (in Buffer Word8)\n{-# INLINE unescapeRoundtripCharacterSurrogate #-}\nunescapeRoundtripCharacterSurrogate :: Char -> Maybe Word8\nunescapeRoundtripCharacterSurrogate c\n    | 0xDC80 <= x && x < 0xDD00 = Just (fromIntegral x) -- Discard high byte\n    | otherwise                 = Nothing\n  where x = ord c\n\nrecoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char\n              -> IO (Buffer Word8, Buffer Char)\nrecoverDecode cfm input@Buffer{  bufRaw=iraw, bufL=ir, bufR=_  }\n                  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow } = do\n --puts $ \"recoverDecode \" ++ show ir\n case cfm of\n  ErrorOnCodingFailure       -> ioe_decodingError\n  IgnoreCodingFailure        -> return (input { bufL=ir+1 }, output)\n  TransliterateCodingFailure -> do\n      ow' <- writeCharBuf oraw ow unrepresentableChar\n      return (input { bufL=ir+1 }, output { bufR=ow' })\n  RoundtripFailure           -> do\n      b <- readWord8Buf iraw ir\n      ow' <- writeCharBuf oraw ow (escapeToRoundtripCharacterSurrogate b)\n      return (input { bufL=ir+1 }, output { bufR=ow' })\n\nrecoverEncode :: CodingFailureMode -> Buffer Char -> Buffer Word8\n              -> IO (Buffer Char, Buffer Word8)\nrecoverEncode cfm input@Buffer{  bufRaw=iraw, bufL=ir, bufR=_  }\n                  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow } = do\n  (c,ir') <- readCharBuf iraw ir\n  --puts $ \"recoverEncode \" ++ show ir ++ \" \" ++ show ir'\n  case cfm of\n    IgnoreCodingFailure        -> return (input { bufL=ir' }, output)\n    TransliterateCodingFailure -> do\n        if c == '?'\n         then return (input { bufL=ir' }, output)\n         else do\n          -- XXX: evil hack! To implement transliteration, we just\n          -- poke an ASCII ? into the input buffer and tell the caller\n          -- to try and decode again. This is *probably* safe given\n          -- current uses of TextEncoding.\n          --\n          -- The \"if\" test above ensures we skip if the encoding fails\n          -- to deal with the ?, though this should never happen in\n          -- practice as all encodings are in fact capable of\n          -- reperesenting all ASCII characters.\n          _ir' <- writeCharBuf iraw ir '?'\n          return (input, output)\n\n        -- This implementation does not work because e.g. UTF-16\n        -- requires 2 bytes to encode a simple ASCII value\n        --writeWord8Buf oraw ow unrepresentableByte\n        --return (input { bufL=ir' }, output { bufR=ow+1 })\n    RoundtripFailure | Just x <- unescapeRoundtripCharacterSurrogate c -> do\n        writeWord8Buf oraw ow x\n        return (input { bufL=ir' }, output { bufR=ow+1 })\n    _                          -> ioe_encodingError\n\nioe_decodingError :: IO a\nioe_decodingError = ioException\n    (IOError Nothing InvalidArgument \"recoverDecode\"\n        \"invalid byte sequence\" Nothing Nothing)\n\nioe_encodingError :: IO a\nioe_encodingError = ioException\n    (IOError Nothing InvalidArgument \"recoverEncode\"\n        \"invalid character\" Nothing Nothing)\n\n", "num_lines": 205}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , NondecreasingIndentation\n  #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding.Iconv\n-- Copyright   :  (c) The University of Glasgow, 2008-2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- This module provides text encoding/decoding using iconv\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding.Iconv (\n#if !defined(mingw32_HOST_OS)\n   iconvEncoding, mkIconvEncoding,\n   localeEncodingName\n#endif\n ) where\n\n#include \"MachDeps.h\"\n#include \"HsBaseConfig.h\"\n\n#if defined(mingw32_HOST_OS)\nimport GHC.Base () -- For build ordering\n#else\n\nimport Foreign\nimport Foreign.C hiding (charIsRepresentable)\nimport Data.Maybe\nimport GHC.Base\nimport GHC.Foreign (charIsRepresentable)\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\nimport GHC.List (span)\nimport GHC.Num\nimport GHC.Show\nimport GHC.Real\nimport System.IO.Unsafe (unsafePerformIO)\nimport System.Posix.Internals\n\nc_DEBUG_DUMP :: Bool\nc_DEBUG_DUMP = False\n\niconv_trace :: String -> IO ()\niconv_trace s\n | c_DEBUG_DUMP = puts s\n | otherwise    = return ()\n\n-- -----------------------------------------------------------------------------\n-- iconv encoders/decoders\n\n{-# NOINLINE localeEncodingName #-}\nlocaleEncodingName :: String\nlocaleEncodingName = unsafePerformIO $ do\n   -- Use locale_charset() or nl_langinfo(CODESET) to get the encoding\n   -- if we have either of them.\n   cstr <- c_localeEncoding\n   peekCAString cstr -- Assume charset names are ASCII\n\n-- We hope iconv_t is a storable type.  It should be, since it has at least the\n-- value -1, which is a possible return value from iconv_open.\ntype IConv = CLong -- ToDo: (#type iconv_t)\n\nforeign import ccall unsafe \"hs_iconv_open\"\n    hs_iconv_open :: CString -> CString -> IO IConv\n\nforeign import ccall unsafe \"hs_iconv_close\"\n    hs_iconv_close :: IConv -> IO CInt\n\nforeign import ccall unsafe \"hs_iconv\"\n    hs_iconv :: IConv -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize\n          -> IO CSize\n\nforeign import ccall unsafe \"localeEncoding\"\n    c_localeEncoding :: IO CString\n\nhaskellChar :: String\n#if defined(WORDS_BIGENDIAN)\nhaskellChar | charSize == 2 = \"UTF-16BE\"\n            | otherwise     = \"UTF-32BE\"\n#else\nhaskellChar | charSize == 2 = \"UTF-16LE\"\n            | otherwise     = \"UTF-32LE\"\n#endif\n\nchar_shift :: Int\nchar_shift | charSize == 2 = 1\n           | otherwise     = 2\n\niconvEncoding :: String -> IO (Maybe TextEncoding)\niconvEncoding = mkIconvEncoding ErrorOnCodingFailure\n\n-- | Construct an iconv-based 'TextEncoding' for the given character set and\n-- 'CodingFailureMode'.\n--\n-- As iconv is missing in some minimal environments (e.g. #10298), this\n-- checks to ensure that iconv is working properly before returning the\n-- encoding, returning 'Nothing' if not.\nmkIconvEncoding :: CodingFailureMode -> String -> IO (Maybe TextEncoding)\nmkIconvEncoding cfm charset = do\n    let enc = TextEncoding {\n                  textEncodingName = charset,\n                  mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix)\n                                           (recoverDecode cfm) iconvDecode,\n                  mkTextEncoder = newIConv haskellChar charset\n                                           (recoverEncode cfm) iconvEncode}\n    good <- charIsRepresentable enc 'a'\n    return $ if good\n               then Just enc\n               else Nothing\n  where\n    -- An annoying feature of GNU iconv is that the //PREFIXES only take\n    -- effect when they appear on the tocode parameter to iconv_open:\n    (raw_charset, suffix) = span (/= '/') charset\n\nnewIConv :: String -> String\n   -> (Buffer a -> Buffer b -> IO (Buffer a, Buffer b))\n   -> (IConv -> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b))\n   -> IO (BufferCodec a b ())\nnewIConv from to rec fn =\n  -- Assume charset names are ASCII\n  withCAString from $ \\ from_str ->\n  withCAString to   $ \\ to_str -> do\n    iconvt <- throwErrnoIfMinus1 \"mkTextEncoding\" $ hs_iconv_open to_str from_str\n    let iclose = throwErrnoIfMinus1_ \"Iconv.close\" $ hs_iconv_close iconvt\n    return BufferCodec{\n                encode = fn iconvt,\n                recover = rec,\n                close  = iclose,\n                -- iconv doesn't supply a way to save/restore the state\n                getState = return (),\n                setState = const $ return ()\n                }\n\niconvDecode :: IConv -> DecodeBuffer\niconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift\n\niconvEncode :: IConv -> EncodeBuffer\niconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0\n\niconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int\n            -> IO (CodingProgress, Buffer a, Buffer b)\niconvRecode iconv_t\n  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_  }  iscale\n  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow, bufSize=os }  oscale\n  = do\n    iconv_trace (\"haskellChar=\" ++ show haskellChar)\n    iconv_trace (\"iconvRecode before, input=\" ++ show (summaryBuffer input))\n    iconv_trace (\"iconvRecode before, output=\" ++ show (summaryBuffer output))\n    withRawBuffer iraw $ \\ piraw -> do\n    withRawBuffer oraw $ \\ poraw -> do\n    with (piraw `plusPtr` (ir `shiftL` iscale)) $ \\ p_inbuf -> do\n    with (poraw `plusPtr` (ow `shiftL` oscale)) $ \\ p_outbuf -> do\n    with (fromIntegral ((iw-ir) `shiftL` iscale)) $ \\ p_inleft -> do\n    with (fromIntegral ((os-ow) `shiftL` oscale)) $ \\ p_outleft -> do\n      res <- hs_iconv iconv_t p_inbuf p_inleft p_outbuf p_outleft\n      new_inleft  <- peek p_inleft\n      new_outleft <- peek p_outleft\n      let\n          new_inleft'  = fromIntegral new_inleft `shiftR` iscale\n          new_outleft' = fromIntegral new_outleft `shiftR` oscale\n          new_input\n            | new_inleft == 0  = input { bufL = 0, bufR = 0 }\n            | otherwise        = input { bufL = iw - new_inleft' }\n          new_output = output{ bufR = os - new_outleft' }\n      iconv_trace (\"iconv res=\" ++ show res)\n      iconv_trace (\"iconvRecode after,  input=\" ++ show (summaryBuffer new_input))\n      iconv_trace (\"iconvRecode after,  output=\" ++ show (summaryBuffer new_output))\n      if (res /= -1)\n        then do -- all input translated\n           return (InputUnderflow, new_input, new_output)\n        else do\n      errno <- getErrno\n      case errno of\n        e | e == e2BIG  -> return (OutputUnderflow, new_input, new_output)\n          | e == eINVAL -> return (InputUnderflow, new_input, new_output)\n           -- Sometimes iconv reports EILSEQ for a\n           -- character in the input even when there is no room\n           -- in the output; in this case we might be about to\n           -- change the encoding anyway, so the following bytes\n           -- could very well be in a different encoding.\n           --\n           -- Because we can only say InvalidSequence if there is at least\n           -- one element left in the output, we have to special case this.\n          | e == eILSEQ -> return (if new_outleft' == 0 then OutputUnderflow else InvalidSequence, new_input, new_output)\n          | otherwise -> do\n              iconv_trace (\"iconv returned error: \" ++ show (errnoToIOError \"iconv\" e Nothing Nothing))\n              throwErrno \"iconvRecoder\"\n\n#endif /* !mingw32_HOST_OS */\n\n", "num_lines": 202}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , BangPatterns\n           , NondecreasingIndentation\n  #-}\n{-# OPTIONS_GHC  -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding.Latin1\n-- Copyright   :  (c) The University of Glasgow, 2009\n-- License     :  see libraries/base/LICENSE\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Single-byte encodings that map directly to Unicode code points.\n--\n-- Portions Copyright   : (c) Tom Harper 2008-2009,\n--                        (c) Bryan O'Sullivan 2009,\n--                        (c) Duncan Coutts 2009\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding.Latin1 (\n  latin1, mkLatin1,\n  latin1_checked, mkLatin1_checked,\n  ascii, mkAscii,\n  latin1_decode,\n  ascii_decode,\n  latin1_encode,\n  latin1_checked_encode,\n  ascii_encode,\n  ) where\n\nimport GHC.Base\nimport GHC.Real\nimport GHC.Num\n-- import GHC.IO\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\n\n-- -----------------------------------------------------------------------------\n-- Latin1\n\nlatin1 :: TextEncoding\nlatin1 = mkLatin1 ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkLatin1 :: CodingFailureMode -> TextEncoding\nmkLatin1 cfm = TextEncoding { textEncodingName = \"ISO-8859-1\",\n                              mkTextDecoder = latin1_DF cfm,\n                              mkTextEncoder = latin1_EF cfm }\n\nlatin1_DF :: CodingFailureMode -> IO (TextDecoder ())\nlatin1_DF cfm =\n  return (BufferCodec {\n             encode   = latin1_decode,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nlatin1_EF :: CodingFailureMode -> IO (TextEncoder ())\nlatin1_EF cfm =\n  return (BufferCodec {\n             encode   = latin1_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nlatin1_checked :: TextEncoding\nlatin1_checked = mkLatin1_checked ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkLatin1_checked :: CodingFailureMode -> TextEncoding\nmkLatin1_checked cfm = TextEncoding { textEncodingName = \"ISO-8859-1\",\n                                      mkTextDecoder = latin1_DF cfm,\n                                      mkTextEncoder = latin1_checked_EF cfm }\n\nlatin1_checked_EF :: CodingFailureMode -> IO (TextEncoder ())\nlatin1_checked_EF cfm =\n  return (BufferCodec {\n             encode   = latin1_checked_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\n-- -----------------------------------------------------------------------------\n-- ASCII\n\n-- | @since 4.9.0.0\nascii :: TextEncoding\nascii = mkAscii ErrorOnCodingFailure\n\n-- | @since 4.9.0.0\nmkAscii :: CodingFailureMode -> TextEncoding\nmkAscii cfm = TextEncoding { textEncodingName = \"ASCII\",\n                             mkTextDecoder = ascii_DF cfm,\n                             mkTextEncoder = ascii_EF cfm }\n\nascii_DF :: CodingFailureMode -> IO (TextDecoder ())\nascii_DF cfm =\n  return (BufferCodec {\n             encode   = ascii_decode,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nascii_EF :: CodingFailureMode -> IO (TextEncoder ())\nascii_EF cfm =\n  return (BufferCodec {\n             encode   = ascii_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\n\n\n-- -----------------------------------------------------------------------------\n-- The actual decoders and encoders\n\n-- TODO: Eliminate code duplication between the checked and unchecked\n-- versions of the decoder or encoder (but don't change the Core!)\n\nlatin1_decode :: DecodeBuffer\nlatin1_decode \n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let \n       loop !ir !ow\n         | ow >= os = done OutputUnderflow ir ow\n         | ir >= iw = done InputUnderflow ir ow\n         | otherwise = do\n              c0 <- readWord8Buf iraw ir\n              ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))\n              loop (ir+1) ow'\n\n       -- lambda-lifted, to avoid thunks being built in the inner-loop:\n       done why !ir !ow = return (why,\n                                  if ir == iw then input{ bufL=0, bufR=0 }\n                                              else input{ bufL=ir },\n                                  output{ bufR=ow })\n    in\n    loop ir0 ow0\n\nascii_decode :: DecodeBuffer\nascii_decode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n       loop !ir !ow\n         | ow >= os = done OutputUnderflow ir ow\n         | ir >= iw = done InputUnderflow ir ow\n         | otherwise = do\n              c0 <- readWord8Buf iraw ir\n              if c0 > 0x7f then invalid else do\n              ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))\n              loop (ir+1) ow'\n         where\n           invalid = done InvalidSequence ir ow\n\n       -- lambda-lifted, to avoid thunks being built in the inner-loop:\n       done why !ir !ow = return (why,\n                                  if ir == iw then input{ bufL=0, bufR=0 }\n                                              else input{ bufL=ir },\n                                  output{ bufR=ow })\n    in\n    loop ir0 ow0\n\nlatin1_encode :: EncodeBuffer\nlatin1_encode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n      done why !ir !ow = return (why,\n                                 if ir == iw then input{ bufL=0, bufR=0 }\n                                             else input{ bufL=ir },\n                                 output{ bufR=ow })\n      loop !ir !ow\n        | ow >= os = done OutputUnderflow ir ow\n        | ir >= iw = done InputUnderflow ir ow\n        | otherwise = do\n           (c,ir') <- readCharBuf iraw ir\n           writeWord8Buf oraw ow (fromIntegral (ord c))\n           loop ir' (ow+1)\n    in\n    loop ir0 ow0\n\nlatin1_checked_encode :: EncodeBuffer\nlatin1_checked_encode input output\n = single_byte_checked_encode 0xff input output\n\nascii_encode :: EncodeBuffer\nascii_encode input output\n = single_byte_checked_encode 0x7f input output\n\nsingle_byte_checked_encode :: Int -> EncodeBuffer\nsingle_byte_checked_encode max_legal_char\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n      done why !ir !ow = return (why,\n                                 if ir == iw then input{ bufL=0, bufR=0 }\n                                             else input{ bufL=ir },\n                                 output{ bufR=ow })\n      loop !ir !ow\n        | ow >= os = done OutputUnderflow ir ow\n        | ir >= iw = done InputUnderflow ir ow\n        | otherwise = do\n           (c,ir') <- readCharBuf iraw ir\n           if ord c > max_legal_char then invalid else do\n           writeWord8Buf oraw ow (fromIntegral (ord c))\n           loop ir' (ow+1)\n        where\n           invalid = done InvalidSequence ir ow\n    in\n    loop ir0 ow0\n{-# INLINE single_byte_checked_encode #-}\n", "num_lines": 231}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding.Types\n-- Copyright   :  (c) The University of Glasgow, 2008-2009\n-- License     :  see libraries/base/LICENSE\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Types for text encoding/decoding\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding.Types (\n    BufferCodec(..),\n    TextEncoding(..),\n    TextEncoder, TextDecoder,\n    CodeBuffer, EncodeBuffer, DecodeBuffer,\n    CodingProgress(..)\n  ) where\n\nimport GHC.Base\nimport GHC.Word\nimport GHC.Show\n-- import GHC.IO\nimport GHC.IO.Buffer\n\n-- -----------------------------------------------------------------------------\n-- Text encoders/decoders\n\ndata BufferCodec from to state = BufferCodec {\n  encode :: CodeBuffer from to,\n   -- ^ The @encode@ function translates elements of the buffer @from@\n   -- to the buffer @to@.  It should translate as many elements as possible\n   -- given the sizes of the buffers, including translating zero elements\n   -- if there is either not enough room in @to@, or @from@ does not\n   -- contain a complete multibyte sequence.\n   --\n   -- If multiple CodingProgress returns are possible, OutputUnderflow must be\n   -- preferred to InvalidSequence. This allows GHC's IO library to assume that\n   -- if we observe InvalidSequence there is at least a single element available\n   -- in the output buffer.\n   --\n   -- The fact that as many elements as possible are translated is used by the IO\n   -- library in order to report translation errors at the point they\n   -- actually occur, rather than when the buffer is translated.\n  \n  recover :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to),\n   -- ^ The @recover@ function is used to continue decoding\n   -- in the presence of invalid or unrepresentable sequences. This includes\n   -- both those detected by @encode@ returning @InvalidSequence@ and those\n   -- that occur because the input byte sequence appears to be truncated.\n   --\n   -- Progress will usually be made by skipping the first element of the @from@\n   -- buffer. This function should only be called if you are certain that you\n   -- wish to do this skipping and if the @to@ buffer has at least one element\n   -- of free space. Because this function deals with decoding failure, it assumes\n   -- that the from buffer has at least one element.\n   --\n   -- @recover@ may raise an exception rather than skipping anything.\n   --\n   -- Currently, some implementations of @recover@ may mutate the input buffer.\n   -- In particular, this feature is used to implement transliteration.\n   --\n   -- @since 4.4.0.0\n  \n  close  :: IO (),\n   -- ^ Resources associated with the encoding may now be released.\n   -- The @encode@ function may not be called again after calling\n   -- @close@.\n\n  getState :: IO state,\n   -- ^ Return the current state of the codec.\n   --\n   -- Many codecs are not stateful, and in these case the state can be\n   -- represented as '()'.  Other codecs maintain a state.  For\n   -- example, UTF-16 recognises a BOM (byte-order-mark) character at\n   -- the beginning of the input, and remembers thereafter whether to\n   -- use big-endian or little-endian mode.  In this case, the state\n   -- of the codec would include two pieces of information: whether we\n   -- are at the beginning of the stream (the BOM only occurs at the\n   -- beginning), and if not, whether to use the big or little-endian\n   -- encoding.\n\n  setState :: state -> IO ()\n   -- restore the state of the codec using the state from a previous\n   -- call to 'getState'.\n }\n\ntype CodeBuffer from to = Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to)\ntype DecodeBuffer = CodeBuffer Word8 Char\ntype EncodeBuffer = CodeBuffer Char Word8\n\ntype TextDecoder state = BufferCodec Word8 CharBufElem state\ntype TextEncoder state = BufferCodec CharBufElem Word8 state\n\n-- | A 'TextEncoding' is a specification of a conversion scheme\n-- between sequences of bytes and sequences of Unicode characters.\n--\n-- For example, UTF-8 is an encoding of Unicode characters into a sequence\n-- of bytes.  The 'TextEncoding' for UTF-8 is 'System.IO.utf8'.\ndata TextEncoding\n  = forall dstate estate . TextEncoding  {\n        textEncodingName :: String,\n                   -- ^ a string that can be passed to 'System.IO.mkTextEncoding' to\n                   -- create an equivalent 'TextEncoding'.\n        mkTextDecoder :: IO (TextDecoder dstate),\n                   -- ^ Creates a means of decoding bytes into characters: the result must not\n                   -- be shared between several byte sequences or simultaneously across threads\n        mkTextEncoder :: IO (TextEncoder estate)\n                   -- ^ Creates a means of encode characters into bytes: the result must not\n                   -- be shared between several character sequences or simultaneously across threads\n  }\n\n-- | @since 4.3.0.0\ninstance Show TextEncoding where\n  -- | Returns the value of 'textEncodingName'\n  show te = textEncodingName te\n\n-- | @since 4.4.0.0\ndata CodingProgress = InputUnderflow  -- ^ Stopped because the input contains insufficient available elements,\n                                      -- or all of the input sequence has been successfully translated.\n                    | OutputUnderflow -- ^ Stopped because the output contains insufficient free elements\n                    | InvalidSequence -- ^ Stopped because there are sufficient free elements in the output\n                                      -- to output at least one encoded ASCII character, but the input contains\n                                      -- an invalid or unrepresentable sequence\n                    deriving ( Eq   -- ^ @since 4.4.0.0\n                             , Show -- ^ @since 4.4.0.0\n                             )\n\n", "num_lines": 136}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , BangPatterns\n           , NondecreasingIndentation\n           , MagicHash\n  #-}\n{-# OPTIONS_GHC  -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding.UTF16\n-- Copyright   :  (c) The University of Glasgow, 2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- UTF-16 Codecs for the IO library\n--\n-- Portions Copyright   : (c) Tom Harper 2008-2009,\n--                        (c) Bryan O'Sullivan 2009,\n--                        (c) Duncan Coutts 2009\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding.UTF16 (\n  utf16, mkUTF16,\n  utf16_decode,\n  utf16_encode,\n\n  utf16be, mkUTF16be,\n  utf16be_decode,\n  utf16be_encode,\n\n  utf16le, mkUTF16le,\n  utf16le_decode,\n  utf16le_encode,\n  ) where\n\nimport GHC.Base\nimport GHC.Real\nimport GHC.Num\n-- import GHC.IO\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\nimport GHC.Word\nimport Data.Bits\nimport GHC.IORef\n\n-- -----------------------------------------------------------------------------\n-- The UTF-16 codec: either UTF16BE or UTF16LE with a BOM\n\nutf16  :: TextEncoding\nutf16 = mkUTF16 ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkUTF16 :: CodingFailureMode -> TextEncoding\nmkUTF16 cfm =  TextEncoding { textEncodingName = \"UTF-16\",\n                              mkTextDecoder = utf16_DF cfm,\n                              mkTextEncoder = utf16_EF cfm }\n\nutf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))\nutf16_DF cfm = do\n  seen_bom <- newIORef Nothing\n  return (BufferCodec {\n             encode   = utf16_decode seen_bom,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = readIORef seen_bom,\n             setState = writeIORef seen_bom\n          })\n\nutf16_EF :: CodingFailureMode -> IO (TextEncoder Bool)\nutf16_EF cfm = do\n  done_bom <- newIORef False\n  return (BufferCodec {\n             encode   = utf16_encode done_bom,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = readIORef done_bom,\n             setState = writeIORef done_bom\n          })\n\nutf16_encode :: IORef Bool -> EncodeBuffer\nutf16_encode done_bom input\n  output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }\n = do\n  b <- readIORef done_bom\n  if b then utf16_native_encode input output\n       else if os - ow < 2\n               then return (OutputUnderflow,input,output)\n               else do\n                    writeIORef done_bom True\n                    writeWord8Buf oraw ow     bom1\n                    writeWord8Buf oraw (ow+1) bom2\n                    utf16_native_encode input output{ bufR = ow+2 }\n\nutf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer\nutf16_decode seen_bom\n  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }\n  output\n = do\n   mb <- readIORef seen_bom\n   case mb of\n     Just decode -> decode input output\n     Nothing ->\n       if iw - ir < 2 then return (InputUnderflow,input,output) else do\n       c0 <- readWord8Buf iraw ir\n       c1 <- readWord8Buf iraw (ir+1)\n       case () of\n        _ | c0 == bomB && c1 == bomL -> do\n               writeIORef seen_bom (Just utf16be_decode)\n               utf16be_decode input{ bufL= ir+2 } output\n          | c0 == bomL && c1 == bomB -> do\n               writeIORef seen_bom (Just utf16le_decode)\n               utf16le_decode input{ bufL= ir+2 } output\n          | otherwise -> do\n               writeIORef seen_bom (Just utf16_native_decode)\n               utf16_native_decode input output\n\n\nbomB, bomL, bom1, bom2 :: Word8\nbomB = 0xfe\nbomL = 0xff\n\n-- choose UTF-16BE by default for UTF-16 output\nutf16_native_decode :: DecodeBuffer\nutf16_native_decode = utf16be_decode\n\nutf16_native_encode :: EncodeBuffer\nutf16_native_encode = utf16be_encode\n\nbom1 = bomB\nbom2 = bomL\n\n-- -----------------------------------------------------------------------------\n-- UTF16LE and UTF16BE\n\nutf16be :: TextEncoding\nutf16be = mkUTF16be ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkUTF16be :: CodingFailureMode -> TextEncoding\nmkUTF16be cfm = TextEncoding { textEncodingName = \"UTF-16BE\",\n                               mkTextDecoder = utf16be_DF cfm,\n                               mkTextEncoder = utf16be_EF cfm }\n\nutf16be_DF :: CodingFailureMode -> IO (TextDecoder ())\nutf16be_DF cfm =\n  return (BufferCodec {\n             encode   = utf16be_decode,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nutf16be_EF :: CodingFailureMode -> IO (TextEncoder ())\nutf16be_EF cfm =\n  return (BufferCodec {\n             encode   = utf16be_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nutf16le :: TextEncoding\nutf16le = mkUTF16le ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkUTF16le :: CodingFailureMode -> TextEncoding\nmkUTF16le cfm = TextEncoding { textEncodingName = \"UTF16-LE\",\n                               mkTextDecoder = utf16le_DF cfm,\n                               mkTextEncoder = utf16le_EF cfm }\n\nutf16le_DF :: CodingFailureMode -> IO (TextDecoder ())\nutf16le_DF cfm =\n  return (BufferCodec {\n             encode   = utf16le_decode,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nutf16le_EF :: CodingFailureMode -> IO (TextEncoder ())\nutf16le_EF cfm =\n  return (BufferCodec {\n             encode   = utf16le_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\n\nutf16be_decode :: DecodeBuffer\nutf16be_decode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n       loop !ir !ow\n         | ow >= os     = done OutputUnderflow ir ow\n         | ir >= iw     = done InputUnderflow ir ow\n         | ir + 1 == iw = done InputUnderflow ir ow\n         | otherwise = do\n              c0 <- readWord8Buf iraw ir\n              c1 <- readWord8Buf iraw (ir+1)\n              let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1\n              if validate1 x1\n                 then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))\n                         loop (ir+2) ow'\n                 else if iw - ir < 4 then done InputUnderflow ir ow else do\n                      c2 <- readWord8Buf iraw (ir+2)\n                      c3 <- readWord8Buf iraw (ir+3)\n                      let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3\n                      if not (validate2 x1 x2) then invalid else do\n                      ow' <- writeCharBuf oraw ow (chr2 x1 x2)\n                      loop (ir+4) ow'\n         where\n           invalid = done InvalidSequence ir ow\n\n       -- lambda-lifted, to avoid thunks being built in the inner-loop:\n       done why !ir !ow = return (why,\n                                  if ir == iw then input{ bufL=0, bufR=0 }\n                                              else input{ bufL=ir },\n                                  output{ bufR=ow })\n    in\n    loop ir0 ow0\n\nutf16le_decode :: DecodeBuffer\nutf16le_decode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n       loop !ir !ow\n         | ow >= os     = done OutputUnderflow ir ow\n         | ir >= iw     = done InputUnderflow ir ow\n         | ir + 1 == iw = done InputUnderflow ir ow\n         | otherwise = do\n              c0 <- readWord8Buf iraw ir\n              c1 <- readWord8Buf iraw (ir+1)\n              let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0\n              if validate1 x1\n                 then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))\n                         loop (ir+2) ow'\n                 else if iw - ir < 4 then done InputUnderflow ir ow else do\n                      c2 <- readWord8Buf iraw (ir+2)\n                      c3 <- readWord8Buf iraw (ir+3)\n                      let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2\n                      if not (validate2 x1 x2) then invalid else do\n                      ow' <- writeCharBuf oraw ow (chr2 x1 x2)\n                      loop (ir+4) ow'\n         where\n           invalid = done InvalidSequence ir ow\n\n       -- lambda-lifted, to avoid thunks being built in the inner-loop:\n       done why !ir !ow = return (why,\n                                  if ir == iw then input{ bufL=0, bufR=0 }\n                                              else input{ bufL=ir },\n                                  output{ bufR=ow })\n    in\n    loop ir0 ow0\n\nutf16be_encode :: EncodeBuffer\nutf16be_encode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n      done why !ir !ow = return (why,\n                                 if ir == iw then input{ bufL=0, bufR=0 }\n                                             else input{ bufL=ir },\n                                 output{ bufR=ow })\n      loop !ir !ow\n        | ir >= iw     =  done InputUnderflow ir ow\n        | os - ow < 2  =  done OutputUnderflow ir ow\n        | otherwise = do\n           (c,ir') <- readCharBuf iraw ir\n           case ord c of\n             x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do\n                    writeWord8Buf oraw ow     (fromIntegral (x `shiftR` 8))\n                    writeWord8Buf oraw (ow+1) (fromIntegral x)\n                    loop ir' (ow+2)\n               | otherwise -> do\n                    if os - ow < 4 then done OutputUnderflow ir ow else do\n                    let\n                         n1 = x - 0x10000\n                         c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)\n                         c2 = fromIntegral (n1 `shiftR` 10)\n                         n2 = n1 .&. 0x3FF\n                         c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)\n                         c4 = fromIntegral n2\n                    --\n                    writeWord8Buf oraw ow     c1\n                    writeWord8Buf oraw (ow+1) c2\n                    writeWord8Buf oraw (ow+2) c3\n                    writeWord8Buf oraw (ow+3) c4\n                    loop ir' (ow+4)\n    in\n    loop ir0 ow0\n\nutf16le_encode :: EncodeBuffer\nutf16le_encode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n      done why !ir !ow = return (why,\n                                 if ir == iw then input{ bufL=0, bufR=0 }\n                                             else input{ bufL=ir },\n                                 output{ bufR=ow })\n      loop !ir !ow\n        | ir >= iw     =  done InputUnderflow ir ow\n        | os - ow < 2  =  done OutputUnderflow ir ow\n        | otherwise = do\n           (c,ir') <- readCharBuf iraw ir\n           case ord c of\n             x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do\n                    writeWord8Buf oraw ow     (fromIntegral x)\n                    writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))\n                    loop ir' (ow+2)\n               | otherwise ->\n                    if os - ow < 4 then done OutputUnderflow ir ow else do\n                    let\n                         n1 = x - 0x10000\n                         c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)\n                         c2 = fromIntegral (n1 `shiftR` 10)\n                         n2 = n1 .&. 0x3FF\n                         c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)\n                         c4 = fromIntegral n2\n                    --\n                    writeWord8Buf oraw ow     c2\n                    writeWord8Buf oraw (ow+1) c1\n                    writeWord8Buf oraw (ow+2) c4\n                    writeWord8Buf oraw (ow+3) c3\n                    loop ir' (ow+4)\n    in\n    loop ir0 ow0\n\nchr2 :: Word16 -> Word16 -> Char\nchr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))\n    where\n      !x# = word2Int# a#\n      !y# = word2Int# b#\n      !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#\n      !lower# = y# -# 0xDC00#\n{-# INLINE chr2 #-}\n\nvalidate1    :: Word16 -> Bool\nvalidate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF\n{-# INLINE validate1 #-}\n\nvalidate2       ::  Word16 -> Word16 -> Bool\nvalidate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&\n                  x2 >= 0xDC00 && x2 <= 0xDFFF\n{-# INLINE validate2 #-}\n\n", "num_lines": 360}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , BangPatterns\n           , NondecreasingIndentation\n           , MagicHash\n  #-}\n{-# OPTIONS_GHC  -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding.UTF32\n-- Copyright   :  (c) The University of Glasgow, 2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- UTF-32 Codecs for the IO library\n--\n-- Portions Copyright   : (c) Tom Harper 2008-2009,\n--                        (c) Bryan O'Sullivan 2009,\n--                        (c) Duncan Coutts 2009\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding.UTF32 (\n  utf32, mkUTF32,\n  utf32_decode,\n  utf32_encode,\n\n  utf32be, mkUTF32be,\n  utf32be_decode,\n  utf32be_encode,\n\n  utf32le, mkUTF32le,\n  utf32le_decode,\n  utf32le_encode,\n  ) where\n\nimport GHC.Base\nimport GHC.Real\nimport GHC.Num\n-- import GHC.IO\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\nimport GHC.Word\nimport Data.Bits\nimport GHC.IORef\n\n-- -----------------------------------------------------------------------------\n-- The UTF-32 codec: either UTF-32BE or UTF-32LE with a BOM\n\nutf32  :: TextEncoding\nutf32 = mkUTF32 ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkUTF32 :: CodingFailureMode -> TextEncoding\nmkUTF32 cfm = TextEncoding { textEncodingName = \"UTF-32\",\n                             mkTextDecoder = utf32_DF cfm,\n                             mkTextEncoder = utf32_EF cfm }\n\nutf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))\nutf32_DF cfm = do\n  seen_bom <- newIORef Nothing\n  return (BufferCodec {\n             encode   = utf32_decode seen_bom,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = readIORef seen_bom,\n             setState = writeIORef seen_bom\n          })\n\nutf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)\nutf32_EF cfm = do\n  done_bom <- newIORef False\n  return (BufferCodec {\n             encode   = utf32_encode done_bom,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = readIORef done_bom,\n             setState = writeIORef done_bom\n          })\n\nutf32_encode :: IORef Bool -> EncodeBuffer\nutf32_encode done_bom input\n  output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }\n = do\n  b <- readIORef done_bom\n  if b then utf32_native_encode input output\n       else if os - ow < 4\n               then return (OutputUnderflow, input,output)\n               else do\n                    writeIORef done_bom True\n                    writeWord8Buf oraw ow     bom0\n                    writeWord8Buf oraw (ow+1) bom1\n                    writeWord8Buf oraw (ow+2) bom2\n                    writeWord8Buf oraw (ow+3) bom3\n                    utf32_native_encode input output{ bufR = ow+4 }\n\nutf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer\nutf32_decode seen_bom\n  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }\n  output\n = do\n   mb <- readIORef seen_bom\n   case mb of\n     Just decode -> decode input output\n     Nothing ->\n       if iw - ir < 4 then return (InputUnderflow, input,output) else do\n       c0 <- readWord8Buf iraw ir\n       c1 <- readWord8Buf iraw (ir+1)\n       c2 <- readWord8Buf iraw (ir+2)\n       c3 <- readWord8Buf iraw (ir+3)\n       case () of\n        _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do\n               writeIORef seen_bom (Just utf32be_decode)\n               utf32be_decode input{ bufL= ir+4 } output\n        _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do\n               writeIORef seen_bom (Just utf32le_decode)\n               utf32le_decode input{ bufL= ir+4 } output\n          | otherwise -> do\n               writeIORef seen_bom (Just utf32_native_decode)\n               utf32_native_decode input output\n\n\nbom0, bom1, bom2, bom3 :: Word8\nbom0 = 0\nbom1 = 0\nbom2 = 0xfe\nbom3 = 0xff\n\n-- choose UTF-32BE by default for UTF-32 output\nutf32_native_decode :: DecodeBuffer\nutf32_native_decode = utf32be_decode\n\nutf32_native_encode :: EncodeBuffer\nutf32_native_encode = utf32be_encode\n\n-- -----------------------------------------------------------------------------\n-- UTF32LE and UTF32BE\n\nutf32be :: TextEncoding\nutf32be = mkUTF32be ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkUTF32be :: CodingFailureMode -> TextEncoding\nmkUTF32be cfm = TextEncoding { textEncodingName = \"UTF-32BE\",\n                               mkTextDecoder = utf32be_DF cfm,\n                               mkTextEncoder = utf32be_EF cfm }\n\nutf32be_DF :: CodingFailureMode -> IO (TextDecoder ())\nutf32be_DF cfm =\n  return (BufferCodec {\n             encode   = utf32be_decode,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nutf32be_EF :: CodingFailureMode -> IO (TextEncoder ())\nutf32be_EF cfm =\n  return (BufferCodec {\n             encode   = utf32be_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\n\nutf32le :: TextEncoding\nutf32le = mkUTF32le ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkUTF32le :: CodingFailureMode -> TextEncoding\nmkUTF32le cfm = TextEncoding { textEncodingName = \"UTF-32LE\",\n                               mkTextDecoder = utf32le_DF cfm,\n                               mkTextEncoder = utf32le_EF cfm }\n\nutf32le_DF :: CodingFailureMode -> IO (TextDecoder ())\nutf32le_DF cfm =\n  return (BufferCodec {\n             encode   = utf32le_decode,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nutf32le_EF :: CodingFailureMode -> IO (TextEncoder ())\nutf32le_EF cfm =\n  return (BufferCodec {\n             encode   = utf32le_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\n\nutf32be_decode :: DecodeBuffer\nutf32be_decode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n       loop !ir !ow\n         | ow >= os    = done OutputUnderflow ir ow\n         | iw - ir < 4 = done InputUnderflow  ir ow\n         | otherwise = do\n              c0 <- readWord8Buf iraw ir\n              c1 <- readWord8Buf iraw (ir+1)\n              c2 <- readWord8Buf iraw (ir+2)\n              c3 <- readWord8Buf iraw (ir+3)\n              let x1 = chr4 c0 c1 c2 c3\n              if not (validate x1) then invalid else do\n              ow' <- writeCharBuf oraw ow x1\n              loop (ir+4) ow'\n         where\n           invalid = done InvalidSequence ir ow\n\n       -- lambda-lifted, to avoid thunks being built in the inner-loop:\n       done why !ir !ow = return (why,\n                                  if ir == iw then input{ bufL=0, bufR=0 }\n                                              else input{ bufL=ir },\n                                  output{ bufR=ow })\n    in\n    loop ir0 ow0\n\nutf32le_decode :: DecodeBuffer\nutf32le_decode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n       loop !ir !ow\n         | ow >= os    = done OutputUnderflow ir ow\n         | iw - ir < 4 = done InputUnderflow  ir ow\n         | otherwise = do\n              c0 <- readWord8Buf iraw ir\n              c1 <- readWord8Buf iraw (ir+1)\n              c2 <- readWord8Buf iraw (ir+2)\n              c3 <- readWord8Buf iraw (ir+3)\n              let x1 = chr4 c3 c2 c1 c0\n              if not (validate x1) then invalid else do\n              ow' <- writeCharBuf oraw ow x1\n              loop (ir+4) ow'\n         where\n           invalid = done InvalidSequence ir ow\n\n       -- lambda-lifted, to avoid thunks being built in the inner-loop:\n       done why !ir !ow = return (why,\n                                  if ir == iw then input{ bufL=0, bufR=0 }\n                                              else input{ bufL=ir },\n                                  output{ bufR=ow })\n    in\n    loop ir0 ow0\n\nutf32be_encode :: EncodeBuffer\nutf32be_encode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n      done why !ir !ow = return (why,\n                                 if ir == iw then input{ bufL=0, bufR=0 }\n                                             else input{ bufL=ir },\n                                 output{ bufR=ow })\n      loop !ir !ow\n        | ir >= iw    = done InputUnderflow  ir ow\n        | os - ow < 4 = done OutputUnderflow ir ow\n        | otherwise = do\n           (c,ir') <- readCharBuf iraw ir\n           if isSurrogate c then done InvalidSequence ir ow else do\n             let (c0,c1,c2,c3) = ord4 c\n             writeWord8Buf oraw ow     c0\n             writeWord8Buf oraw (ow+1) c1\n             writeWord8Buf oraw (ow+2) c2\n             writeWord8Buf oraw (ow+3) c3\n             loop ir' (ow+4)\n    in\n    loop ir0 ow0\n\nutf32le_encode :: EncodeBuffer\nutf32le_encode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let\n      done why !ir !ow = return (why,\n                                 if ir == iw then input{ bufL=0, bufR=0 }\n                                             else input{ bufL=ir },\n                                 output{ bufR=ow })\n      loop !ir !ow\n        | ir >= iw    = done InputUnderflow  ir ow\n        | os - ow < 4 = done OutputUnderflow ir ow\n        | otherwise = do\n           (c,ir') <- readCharBuf iraw ir\n           if isSurrogate c then done InvalidSequence ir ow else do\n             let (c0,c1,c2,c3) = ord4 c\n             writeWord8Buf oraw ow     c3\n             writeWord8Buf oraw (ow+1) c2\n             writeWord8Buf oraw (ow+2) c1\n             writeWord8Buf oraw (ow+3) c0\n             loop ir' (ow+4)\n    in\n    loop ir0 ow0\n\nchr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char\nchr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =\n    C# (chr# (z1# +# z2# +# z3# +# z4#))\n    where\n      !y1# = word2Int# x1#\n      !y2# = word2Int# x2#\n      !y3# = word2Int# x3#\n      !y4# = word2Int# x4#\n      !z1# = uncheckedIShiftL# y1# 24#\n      !z2# = uncheckedIShiftL# y2# 16#\n      !z3# = uncheckedIShiftL# y3# 8#\n      !z4# = y4#\n{-# INLINE chr4 #-}\n\nord4 :: Char -> (Word8,Word8,Word8,Word8)\nord4 c = (fromIntegral (x `shiftR` 24),\n          fromIntegral (x `shiftR` 16),\n          fromIntegral (x `shiftR` 8),\n          fromIntegral x)\n  where\n    x = ord c\n{-# INLINE ord4 #-}\n\n\nvalidate    :: Char -> Bool\nvalidate c = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)\n   where x1 = ord c\n{-# INLINE validate #-}\n\n", "num_lines": 337}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , BangPatterns\n           , NondecreasingIndentation\n           , MagicHash\n  #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Encoding.UTF8\n-- Copyright   :  (c) The University of Glasgow, 2009\n-- License     :  see libraries/base/LICENSE\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- UTF-8 Codec for the IO library\n--\n-- Portions Copyright   : (c) Tom Harper 2008-2009,\n--                        (c) Bryan O'Sullivan 2009,\n--                        (c) Duncan Coutts 2009\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Encoding.UTF8 (\n  utf8, mkUTF8,\n  utf8_bom, mkUTF8_bom\n  ) where\n\nimport GHC.Base\nimport GHC.Real\nimport GHC.Num\nimport GHC.IORef\n-- import GHC.IO\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\nimport GHC.Word\nimport Data.Bits\n\nutf8 :: TextEncoding\nutf8 = mkUTF8 ErrorOnCodingFailure\n\n-- | @since 4.4.0.0\nmkUTF8 :: CodingFailureMode -> TextEncoding\nmkUTF8 cfm = TextEncoding { textEncodingName = \"UTF-8\",\n                            mkTextDecoder = utf8_DF cfm,\n                            mkTextEncoder = utf8_EF cfm }\n\n\nutf8_DF :: CodingFailureMode -> IO (TextDecoder ())\nutf8_DF cfm =\n  return (BufferCodec {\n             encode   = utf8_decode,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nutf8_EF :: CodingFailureMode -> IO (TextEncoder ())\nutf8_EF cfm =\n  return (BufferCodec {\n             encode   = utf8_encode,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = return (),\n             setState = const $ return ()\n          })\n\nutf8_bom :: TextEncoding\nutf8_bom = mkUTF8_bom ErrorOnCodingFailure\n\nmkUTF8_bom :: CodingFailureMode -> TextEncoding\nmkUTF8_bom cfm = TextEncoding { textEncodingName = \"UTF-8BOM\",\n                                mkTextDecoder = utf8_bom_DF cfm,\n                                mkTextEncoder = utf8_bom_EF cfm }\n\nutf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool)\nutf8_bom_DF cfm = do\n   ref <- newIORef True\n   return (BufferCodec {\n             encode   = utf8_bom_decode ref,\n             recover  = recoverDecode cfm,\n             close    = return (),\n             getState = readIORef ref,\n             setState = writeIORef ref\n          })\n\nutf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool)\nutf8_bom_EF cfm = do\n   ref <- newIORef True\n   return (BufferCodec {\n             encode   = utf8_bom_encode ref,\n             recover  = recoverEncode cfm,\n             close    = return (),\n             getState = readIORef ref,\n             setState = writeIORef ref\n          })\n\nutf8_bom_decode :: IORef Bool -> DecodeBuffer\nutf8_bom_decode ref\n  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }\n  output\n = do\n   first <- readIORef ref\n   if not first\n      then utf8_decode input output\n      else do\n       let no_bom = do writeIORef ref False; utf8_decode input output\n       if iw - ir < 1 then return (InputUnderflow,input,output) else do\n       c0 <- readWord8Buf iraw ir\n       if (c0 /= bom0) then no_bom else do\n       if iw - ir < 2 then return (InputUnderflow,input,output) else do\n       c1 <- readWord8Buf iraw (ir+1)\n       if (c1 /= bom1) then no_bom else do\n       if iw - ir < 3 then return (InputUnderflow,input,output) else do\n       c2 <- readWord8Buf iraw (ir+2)\n       if (c2 /= bom2) then no_bom else do\n       -- found a BOM, ignore it and carry on\n       writeIORef ref False\n       utf8_decode input{ bufL = ir + 3 } output\n\nutf8_bom_encode :: IORef Bool -> EncodeBuffer\nutf8_bom_encode ref input\n  output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }\n = do\n  b <- readIORef ref\n  if not b then utf8_encode input output\n           else if os - ow < 3\n                  then return (OutputUnderflow,input,output)\n                  else do\n                    writeIORef ref False\n                    writeWord8Buf oraw ow     bom0\n                    writeWord8Buf oraw (ow+1) bom1\n                    writeWord8Buf oraw (ow+2) bom2\n                    utf8_encode input output{ bufR = ow+3 }\n\nbom0, bom1, bom2 :: Word8\nbom0 = 0xef\nbom1 = 0xbb\nbom2 = 0xbf\n\nutf8_decode :: DecodeBuffer\nutf8_decode \n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let \n       loop !ir !ow\n         | ow >= os = done OutputUnderflow ir ow\n         | ir >= iw = done InputUnderflow ir ow\n         | otherwise = do\n              c0 <- readWord8Buf iraw ir\n              case c0 of\n                _ | c0 <= 0x7f -> do \n                           ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))\n                           loop (ir+1) ow'\n                  | c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms\n                  | c0 >= 0xc2 && c0 <= 0xdf ->\n                           if iw - ir < 2 then done InputUnderflow ir ow else do\n                           c1 <- readWord8Buf iraw (ir+1)\n                           if (c1 < 0x80 || c1 >= 0xc0) then invalid else do\n                           ow' <- writeCharBuf oraw ow (chr2 c0 c1)\n                           loop (ir+2) ow'\n                  | c0 >= 0xe0 && c0 <= 0xef ->\n                      case iw - ir of\n                        1 -> done InputUnderflow ir ow\n                        2 -> do -- check for an error even when we don't have\n                                -- the full sequence yet (#3341)\n                           c1 <- readWord8Buf iraw (ir+1)\n                           if not (validate3 c0 c1 0x80) \n                              then invalid else done InputUnderflow ir ow\n                        _ -> do\n                           c1 <- readWord8Buf iraw (ir+1)\n                           c2 <- readWord8Buf iraw (ir+2)\n                           if not (validate3 c0 c1 c2) then invalid else do\n                           ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2)\n                           loop (ir+3) ow'\n                  | c0 >= 0xf0 ->\n                      case iw - ir of\n                        1 -> done InputUnderflow ir ow\n                        2 -> do -- check for an error even when we don't have\n                                -- the full sequence yet (#3341)\n                           c1 <- readWord8Buf iraw (ir+1)\n                           if not (validate4 c0 c1 0x80 0x80)\n                              then invalid else done InputUnderflow ir ow\n                        3 -> do\n                           c1 <- readWord8Buf iraw (ir+1)\n                           c2 <- readWord8Buf iraw (ir+2)\n                           if not (validate4 c0 c1 c2 0x80)\n                              then invalid else done InputUnderflow ir ow\n                        _ -> do\n                           c1 <- readWord8Buf iraw (ir+1)\n                           c2 <- readWord8Buf iraw (ir+2)\n                           c3 <- readWord8Buf iraw (ir+3)\n                           if not (validate4 c0 c1 c2 c3) then invalid else do\n                           ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3)\n                           loop (ir+4) ow'\n                  | otherwise ->\n                           invalid\n         where\n           invalid = done InvalidSequence ir ow\n\n       -- lambda-lifted, to avoid thunks being built in the inner-loop:\n       done why !ir !ow = return (why,\n                                  if ir == iw then input{ bufL=0, bufR=0 }\n                                              else input{ bufL=ir },\n                                  output{ bufR=ow })\n   in\n   loop ir0 ow0\n\nutf8_encode :: EncodeBuffer\nutf8_encode\n  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }\n  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }\n = let \n      done why !ir !ow = return (why,\n                                 if ir == iw then input{ bufL=0, bufR=0 }\n                                             else input{ bufL=ir },\n                                 output{ bufR=ow })\n      loop !ir !ow\n        | ow >= os = done OutputUnderflow ir ow\n        | ir >= iw = done InputUnderflow ir ow\n        | otherwise = do\n           (c,ir') <- readCharBuf iraw ir\n           case ord c of\n             x | x <= 0x7F   -> do\n                    writeWord8Buf oraw ow (fromIntegral x)\n                    loop ir' (ow+1)\n               | x <= 0x07FF ->\n                    if os - ow < 2 then done OutputUnderflow ir ow else do\n                    let (c1,c2) = ord2 c\n                    writeWord8Buf oraw ow     c1\n                    writeWord8Buf oraw (ow+1) c2\n                    loop ir' (ow+2)\n               | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow else do\n                    if os - ow < 3 then done OutputUnderflow ir ow else do\n                    let (c1,c2,c3) = ord3 c\n                    writeWord8Buf oraw ow     c1\n                    writeWord8Buf oraw (ow+1) c2\n                    writeWord8Buf oraw (ow+2) c3\n                    loop ir' (ow+3)\n               | otherwise -> do\n                    if os - ow < 4 then done OutputUnderflow ir ow else do\n                    let (c1,c2,c3,c4) = ord4 c\n                    writeWord8Buf oraw ow     c1\n                    writeWord8Buf oraw (ow+1) c2\n                    writeWord8Buf oraw (ow+2) c3\n                    writeWord8Buf oraw (ow+3) c4\n                    loop ir' (ow+4)\n   in\n   loop ir0 ow0\n\n-- -----------------------------------------------------------------------------\n-- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8\n  \nord2   :: Char -> (Word8,Word8)\nord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)\n    where\n      n  = ord c\n      x1 = fromIntegral $ (n `shiftR` 6) + 0xC0\n      x2 = fromIntegral $ (n .&. 0x3F)   + 0x80\n\nord3   :: Char -> (Word8,Word8,Word8)\nord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)\n    where\n      n  = ord c\n      x1 = fromIntegral $ (n `shiftR` 12) + 0xE0\n      x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80\n      x3 = fromIntegral $ (n .&. 0x3F) + 0x80\n\nord4   :: Char -> (Word8,Word8,Word8,Word8)\nord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)\n    where\n      n  = ord c\n      x1 = fromIntegral $ (n `shiftR` 18) + 0xF0\n      x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80\n      x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80\n      x4 = fromIntegral $ (n .&. 0x3F) + 0x80\n\nchr2       :: Word8 -> Word8 -> Char\nchr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))\n    where\n      !y1# = word2Int# x1#\n      !y2# = word2Int# x2#\n      !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#\n      !z2# = y2# -# 0x80#\n{-# INLINE chr2 #-}\n\nchr3          :: Word8 -> Word8 -> Word8 -> Char\nchr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))\n    where\n      !y1# = word2Int# x1#\n      !y2# = word2Int# x2#\n      !y3# = word2Int# x3#\n      !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#\n      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#\n      !z3# = y3# -# 0x80#\n{-# INLINE chr3 #-}\n\nchr4             :: Word8 -> Word8 -> Word8 -> Word8 -> Char\nchr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =\n    C# (chr# (z1# +# z2# +# z3# +# z4#))\n    where\n      !y1# = word2Int# x1#\n      !y2# = word2Int# x2#\n      !y3# = word2Int# x3#\n      !y4# = word2Int# x4#\n      !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#\n      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#\n      !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#\n      !z4# = y4# -# 0x80#\n{-# INLINE chr4 #-}\n\nbetween :: Word8                -- ^ byte to check\n        -> Word8                -- ^ lower bound\n        -> Word8                -- ^ upper bound\n        -> Bool\nbetween x y z = x >= y && x <= z\n{-# INLINE between #-}\n\nvalidate3          :: Word8 -> Word8 -> Word8 -> Bool\n{-# INLINE validate3 #-}\nvalidate3 x1 x2 x3 = validate3_1 ||\n                     validate3_2 ||\n                     validate3_3 ||\n                     validate3_4\n  where\n    validate3_1 = (x1 == 0xE0) &&\n                  between x2 0xA0 0xBF &&\n                  between x3 0x80 0xBF\n    validate3_2 = between x1 0xE1 0xEC &&\n                  between x2 0x80 0xBF &&\n                  between x3 0x80 0xBF\n    validate3_3 = x1 == 0xED &&\n                  between x2 0x80 0x9F &&\n                  between x3 0x80 0xBF\n    validate3_4 = between x1 0xEE 0xEF &&\n                  between x2 0x80 0xBF &&\n                  between x3 0x80 0xBF\n\nvalidate4             :: Word8 -> Word8 -> Word8 -> Word8 -> Bool\n{-# INLINE validate4 #-}\nvalidate4 x1 x2 x3 x4 = validate4_1 ||\n                        validate4_2 ||\n                        validate4_3\n  where \n    validate4_1 = x1 == 0xF0 &&\n                  between x2 0x90 0xBF &&\n                  between x3 0x80 0xBF &&\n                  between x4 0x80 0xBF\n    validate4_2 = between x1 0xF1 0xF3 &&\n                  between x2 0x80 0xBF &&\n                  between x3 0x80 0xBF &&\n                  between x4 0x80 0xBF\n    validate4_3 = x1 == 0xF4 &&\n                  between x2 0x80 0x8F &&\n                  between x3 0x80 0xBF &&\n                  between x4 0x80 0xBF\n\n", "num_lines": 363}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, NondecreasingIndentation,\n             RecordWildCards, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -Wno-name-shadowing #-}\n\nmodule GHC.IO.Encoding.CodePage.API (\n    mkCodePageEncoding\n  ) where\n\nimport Foreign.C\nimport Foreign.Ptr\nimport Foreign.Marshal\nimport Foreign.Storable\nimport Data.Bits\nimport Data.Either\nimport Data.Word\n\nimport GHC.Base\nimport GHC.List\nimport GHC.IO.Buffer\nimport GHC.IO.Encoding.Failure\nimport GHC.IO.Encoding.Types\nimport GHC.IO.Encoding.UTF16\nimport GHC.Num\nimport GHC.Show\nimport GHC.Real\nimport GHC.Windows\nimport GHC.ForeignPtr (castForeignPtr)\n\nimport System.Posix.Internals\n\n\nc_DEBUG_DUMP :: Bool\nc_DEBUG_DUMP = False\n\ndebugIO :: String -> IO ()\ndebugIO s\n | c_DEBUG_DUMP = puts s\n | otherwise    = return ()\n\n\n#if defined(i386_HOST_ARCH)\n# define WINDOWS_CCONV stdcall\n#elif defined(x86_64_HOST_ARCH)\n# define WINDOWS_CCONV ccall\n#else\n# error Unknown mingw32 arch\n#endif\n\n\ntype LPCSTR = Ptr Word8\n\n\nmAX_DEFAULTCHAR :: Int\nmAX_DEFAULTCHAR = 2\n\nmAX_LEADBYTES :: Int\nmAX_LEADBYTES = 12\n\n-- Don't really care about the contents of this, but we have to make sure the size is right\ndata CPINFO = CPINFO {\n    maxCharSize :: UINT,\n    defaultChar :: [BYTE], -- ^ Always of length mAX_DEFAULTCHAR\n    leadByte    :: [BYTE]  -- ^ Always of length mAX_LEADBYTES\n  }\n\n-- | @since 4.7.0.0\ninstance Storable CPINFO where\n    sizeOf    _ = sizeOf (undefined :: UINT) + (mAX_DEFAULTCHAR + mAX_LEADBYTES) * sizeOf (undefined :: BYTE)\n    alignment _ = alignment (undefined :: CInt)\n    peek ptr = do\n      ptr <- return $ castPtr ptr\n      a <- peek ptr\n      ptr <- return $ castPtr $ advancePtr ptr 1\n      b <- peekArray mAX_DEFAULTCHAR ptr\n      c <- peekArray mAX_LEADBYTES   (advancePtr ptr mAX_DEFAULTCHAR)\n      return $ CPINFO a b c\n    poke ptr val = do\n      ptr <- return $ castPtr ptr\n      poke ptr (maxCharSize val)\n      ptr <- return $ castPtr $ advancePtr ptr 1\n      pokeArray' \"CPINFO.defaultChar\" mAX_DEFAULTCHAR ptr                              (defaultChar val)\n      pokeArray' \"CPINFO.leadByte\"    mAX_LEADBYTES   (advancePtr ptr mAX_DEFAULTCHAR) (leadByte val)\n\npokeArray' :: Storable a => String -> Int -> Ptr a -> [a] -> IO ()\npokeArray' msg sz ptr xs | length xs == sz = pokeArray ptr xs\n                         | otherwise       = errorWithoutStackTrace $ msg ++ \": expected \" ++ show sz ++ \" elements in list but got \" ++ show (length xs)\n\n\nforeign import WINDOWS_CCONV unsafe \"windows.h GetCPInfo\"\n    c_GetCPInfo :: UINT       -- ^ CodePage\n                -> Ptr CPINFO -- ^ lpCPInfo\n                -> IO BOOL\n\nforeign import WINDOWS_CCONV unsafe \"windows.h MultiByteToWideChar\"\n    c_MultiByteToWideChar :: UINT   -- ^ CodePage\n                          -> DWORD  -- ^ dwFlags\n                          -> LPCSTR -- ^ lpMultiByteStr\n                          -> CInt   -- ^ cbMultiByte\n                          -> LPWSTR -- ^ lpWideCharStr\n                          -> CInt   -- ^ cchWideChar\n                          -> IO CInt\n\nforeign import WINDOWS_CCONV unsafe \"windows.h WideCharToMultiByte\"\n    c_WideCharToMultiByte :: UINT   -- ^ CodePage\n                          -> DWORD  -- ^ dwFlags\n                          -> LPWSTR -- ^ lpWideCharStr\n                          -> CInt   -- ^ cchWideChar\n                          -> LPCSTR -- ^ lpMultiByteStr\n                          -> CInt   -- ^ cbMultiByte\n                          -> LPCSTR -- ^ lpDefaultChar\n                          -> LPBOOL -- ^ lpUsedDefaultChar\n                          -> IO CInt\n\nforeign import WINDOWS_CCONV unsafe \"windows.h IsDBCSLeadByteEx\"\n    c_IsDBCSLeadByteEx :: UINT    -- ^ CodePage\n                       -> BYTE    -- ^ TestChar\n                       -> IO BOOL\n\n\n-- | Returns a slow but correct implementation of TextEncoding using the Win32 API.\n--\n-- This is useful for supporting DBCS text encoding on the console without having to statically link\n-- in huge code tables into all of our executables, or just as a fallback mechanism if a new code page\n-- is introduced that we don't know how to deal with ourselves yet.\nmkCodePageEncoding :: CodingFailureMode -> Word32 -> TextEncoding\nmkCodePageEncoding cfm cp\n  = TextEncoding {\n        textEncodingName = \"CP\" ++ show cp,\n        mkTextDecoder = newCP (recoverDecode cfm) cpDecode cp,\n        mkTextEncoder = newCP (recoverEncode cfm) cpEncode cp\n      }\n\nnewCP :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))\n      -> (Word32 -> Int -> CodeBuffer from to)\n      -> Word32\n      -> IO (BufferCodec from to ())\nnewCP rec fn cp = do\n  -- Fail early if the code page doesn't exist, to match the behaviour of the IConv TextEncoding\n  max_char_size <- alloca $ \\cpinfo_ptr -> do\n    success <- c_GetCPInfo cp cpinfo_ptr\n    when (not success) $ throwGetLastError (\"GetCPInfo \" ++ show cp)\n    fmap (fromIntegral . maxCharSize) $ peek cpinfo_ptr\n\n  debugIO $ \"GetCPInfo \" ++ show cp ++ \" = \" ++ show max_char_size\n\n  return $ BufferCodec {\n    encode = fn cp max_char_size,\n    recover = rec,\n    close  = return (),\n    -- Windows doesn't supply a way to save/restore the state and doesn't need one\n    -- since it's a dumb string->string API rather than a clever streaming one.\n    getState = return (),\n    setState = const $ return ()\n  }\n\n\nutf16_native_encode' :: EncodeBuffer\nutf16_native_decode' :: DecodeBuffer\n#if defined(WORDS_BIGENDIAN)\nutf16_native_encode' = utf16be_encode\nutf16_native_decode' = utf16be_decode\n#else\nutf16_native_encode' = utf16le_encode\nutf16_native_decode' = utf16le_decode\n#endif\n\nsaner :: CodeBuffer from to\n      -> Buffer from -> Buffer to\n      -> IO (CodingProgress, Int, Buffer from, Buffer to)\nsaner code ibuf obuf = do\n  (why, ibuf', obuf') <- code ibuf obuf\n  -- Weird but true: the UTF16 codes have a special case (see the \"done\" functions)\n  -- whereby if they entirely consume the input instead of returning an input buffer\n  -- that is empty because bufL has reached bufR, they return a buffer that is empty\n  -- because bufL = bufR = 0.\n  --\n  -- This is really very odd and confusing for our code that expects the difference\n  -- between the old and new input buffer bufLs to indicate the number of elements\n  -- that were consumed!\n  --\n  -- We fix it by explicitly extracting an integer which is the # of things consumed, like so:\n  if isEmptyBuffer ibuf'\n   then return (InputUnderflow, bufferElems ibuf,       ibuf', obuf')\n   else return (why,            bufL ibuf' - bufL ibuf, ibuf', obuf')\n\nbyteView :: Buffer CWchar -> Buffer Word8\nbyteView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = bufSize * 2, bufL = bufL * 2, bufR = bufR * 2 }\n\ncwcharView :: Buffer Word8 -> Buffer CWchar\ncwcharView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = half bufSize, bufL = half bufL, bufR = half bufR }\n  where half x = case x `divMod` 2 of (y, 0) -> y\n                                      _      -> errorWithoutStackTrace \"cwcharView: utf16_(encode|decode) (wrote out|consumed) non multiple-of-2 number of bytes\"\n\nutf16_native_encode :: CodeBuffer Char CWchar\nutf16_native_encode ibuf obuf = do\n  (why, ibuf, obuf) <- utf16_native_encode' ibuf (byteView obuf)\n  return (why, ibuf, cwcharView obuf)\n\nutf16_native_decode :: CodeBuffer CWchar Char\nutf16_native_decode ibuf obuf = do\n  (why, ibuf, obuf) <- utf16_native_decode' (byteView ibuf) obuf\n  return (why, cwcharView ibuf, obuf)\n\ncpDecode :: Word32 -> Int -> DecodeBuffer\ncpDecode cp max_char_size = \\ibuf obuf -> do\n#if defined(CHARBUF_UTF16)\n    let mbuf = obuf\n#else\n    -- FIXME: share the buffer between runs, even if the buffer is not the perfect size\n    let sz =       (bufferElems ibuf * 2)     -- I guess in the worst case the input CP text consists of 1-byte sequences that map entirely to things outside the BMP and so require 2 UTF-16 chars\n             `min` (bufferAvailable obuf * 2) -- In the best case, each pair of UTF-16 points becomes a single UTF-32 point\n    mbuf <- newBuffer (2 * sz) sz WriteBuffer :: IO (Buffer CWchar)\n#endif\n    debugIO $ \"cpDecode \" ++ summaryBuffer ibuf ++ \" \" ++ summaryBuffer mbuf\n    (why1, ibuf', mbuf') <- cpRecode try' is_valid_prefix max_char_size 1 0 1 ibuf mbuf\n    debugIO $ \"cpRecode (cpDecode) = \" ++ show why1 ++ \" \" ++ summaryBuffer ibuf' ++ \" \" ++ summaryBuffer mbuf'\n#if defined(CHARBUF_UTF16)\n    return (why1, ibuf', mbuf')\n#else\n    -- Convert as much UTF-16 as possible to UTF-32. Note that it's impossible for this to fail\n    -- due to illegal characters since the output from Window's encoding function should be correct UTF-16.\n    -- However, it's perfectly possible to run out of either output or input buffer.\n    debugIO $ \"utf16_native_decode \" ++ summaryBuffer mbuf' ++ \" \" ++ summaryBuffer obuf\n    (why2, target_utf16_count, mbuf', obuf) <- saner utf16_native_decode (mbuf' { bufState = ReadBuffer }) obuf\n    debugIO $ \"utf16_native_decode = \" ++ show why2 ++ \" \" ++ summaryBuffer mbuf' ++ \" \" ++ summaryBuffer obuf\n    case why2 of\n      -- If we successfully translate all of the UTF-16 buffer, we need to know why we couldn't get any more\n      -- UTF-16 out of the Windows API\n      InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)\n                     | otherwise           -> errorWithoutStackTrace \"cpDecode: impossible underflown UTF-16 buffer\"\n      -- InvalidSequence should be impossible since mbuf' is output from Windows.\n      InvalidSequence -> errorWithoutStackTrace \"InvalidSequence on output of Windows API\"\n      -- If we run out of space in obuf, we need to ask for more output buffer space, while also returning\n      -- the characters we have managed to consume so far.\n      OutputUnderflow -> do\n        -- We have an interesting problem here similar to the cpEncode case where we have to figure out how much\n        -- of the byte buffer was consumed to reach as far as the last UTF-16 character we actually decoded to UTF-32 OK.\n        --\n        -- The minimum number of bytes it could take is half the number of UTF-16 chars we got on the output, since\n        -- one byte could theoretically generate two UTF-16 characters.\n        -- The common case (ASCII text) is that every byte in the input maps to a single UTF-16 character.\n        -- In the worst case max_char_size bytes map to each UTF-16 character.\n        byte_count <- bSearch \"cpDecode\" (cpRecode try' is_valid_prefix max_char_size 1 0 1) ibuf mbuf target_utf16_count (target_utf16_count `div` 2) target_utf16_count (target_utf16_count * max_char_size)\n        return (OutputUnderflow, bufferRemove byte_count ibuf, obuf)\n#endif\n  where\n    is_valid_prefix = c_IsDBCSLeadByteEx cp\n    try' iptr icnt optr ocnt\n     -- MultiByteToWideChar does surprising things if you have ocnt == 0\n     | ocnt == 0 = return (Left True)\n     | otherwise = do\n        err <- c_MultiByteToWideChar (fromIntegral cp) 8 -- MB_ERR_INVALID_CHARS == 8: Fail if an invalid input character is encountered\n                                     iptr (fromIntegral icnt) optr (fromIntegral ocnt)\n        debugIO $ \"MultiByteToWideChar \" ++ show cp ++ \" 8 \" ++ show iptr ++ \" \" ++ show icnt ++ \" \" ++ show optr ++ \" \" ++ show ocnt ++ \"\\n = \" ++ show err\n        case err of\n          -- 0 indicates that we did not succeed\n          0 -> do\n            err <- getLastError\n            case err of\n                122  -> return (Left True)\n                1113 -> return (Left False)\n                _    -> failWith \"MultiByteToWideChar\" err\n          wrote_chars -> return (Right (fromIntegral wrote_chars))\n\ncpEncode :: Word32 -> Int -> EncodeBuffer\ncpEncode cp _max_char_size = \\ibuf obuf -> do\n#if defined(CHARBUF_UTF16)\n    let mbuf' = ibuf\n#else\n    -- FIXME: share the buffer between runs, even though that means we can't size the buffer as we want.\n    let sz =       (bufferElems ibuf * 2)     -- UTF-32 always uses 4 bytes. UTF-16 uses at most 4 bytes.\n             `min` (bufferAvailable obuf * 2) -- In the best case, each pair of UTF-16 points fits into only 1 byte\n    mbuf <- newBuffer (2 * sz) sz WriteBuffer\n\n    -- Convert as much UTF-32 as possible to UTF-16. NB: this can't fail due to output underflow\n    -- since we sized the output buffer correctly. However, it could fail due to an illegal character\n    -- in the input if it encounters a lone surrogate. In this case, our recovery will be applied as normal.\n    (why1, ibuf', mbuf') <- utf16_native_encode ibuf mbuf\n#endif\n    debugIO $ \"\\ncpEncode \" ++ summaryBuffer mbuf' ++ \" \" ++ summaryBuffer obuf\n    (why2, target_utf16_count, mbuf', obuf) <- saner (cpRecode try' is_valid_prefix 2 1 1 0) (mbuf' { bufState = ReadBuffer }) obuf\n    debugIO $ \"cpRecode (cpEncode) = \" ++ show why2 ++ \" \" ++ summaryBuffer mbuf' ++ \" \" ++ summaryBuffer obuf\n#if defined(CHARBUF_UTF16)\n    return (why2, mbuf', obuf)\n#else\n    case why2 of\n      -- If we successfully translate all of the UTF-16 buffer, we need to know why\n      -- we weren't able to get any more UTF-16 out of the UTF-32 buffer\n      InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)\n                     | otherwise           -> errorWithoutStackTrace \"cpEncode: impossible underflown UTF-16 buffer\"\n      -- With OutputUnderflow/InvalidSequence we only care about the failings of the UTF-16->CP translation.\n      -- Yes, InvalidSequence is possible even though mbuf' is guaranteed to be valid UTF-16, because\n      -- the code page may not be able to represent the encoded Unicode codepoint.\n      _ -> do\n        -- Here is an interesting problem. If we have only managed to translate part of the mbuf'\n        -- then we need to return an ibuf which has consumed exactly those bytes required to obtain\n        -- that part of the mbuf'. To reconstruct this information, we binary search for the number of\n        -- UTF-32 characters required to get the consumed count of UTF-16 characters:\n        --\n        -- When dealing with data from the BMP (the common case), consuming N UTF-16 characters will be the same as consuming N\n        -- UTF-32 characters. We start our search there so that most binary searches will terminate in a single iteration.\n        -- Furthermore, the absolute minimum number of UTF-32 characters this can correspond to is 1/2 the UTF-16 byte count\n        -- (this will be realised when the input data is entirely not in the BMP).\n        utf32_count <- bSearch \"cpEncode\" utf16_native_encode ibuf mbuf target_utf16_count (target_utf16_count `div` 2) target_utf16_count target_utf16_count\n        return (why2, bufferRemove utf32_count ibuf, obuf)\n#endif\n  where\n    -- Single characters should be mappable to bytes. If they aren't supported by the CP then we have an invalid input sequence.\n    is_valid_prefix _ = return False\n\n    try' iptr icnt optr ocnt\n     -- WideCharToMultiByte does surprising things if you call it with ocnt == 0\n     | ocnt == 0 = return (Left True)\n     | otherwise = alloca $ \\defaulted_ptr -> do\n      poke defaulted_ptr False\n      err <- c_WideCharToMultiByte (fromIntegral cp) 0 -- NB: the WC_ERR_INVALID_CHARS flag is uselses: only has an effect with the UTF-8 code page\n                                   iptr (fromIntegral icnt) optr (fromIntegral ocnt)\n                                   nullPtr defaulted_ptr\n      defaulted <- peek defaulted_ptr\n      debugIO $ \"WideCharToMultiByte \" ++ show cp ++ \" 0 \" ++ show iptr ++ \" \" ++ show icnt ++ \" \" ++ show optr ++ \" \" ++ show ocnt ++ \" NULL \" ++ show defaulted_ptr ++ \"\\n = \" ++ show err ++ \", \" ++ show defaulted\n      case err of\n          -- 0 indicates that we did not succeed\n          0 -> do\n            err <- getLastError\n            case err of\n                122  -> return (Left True)\n                1113 -> return (Left False)\n                _    -> failWith \"WideCharToMultiByte\" err\n          wrote_bytes | defaulted -> return (Left False)\n                      | otherwise -> return (Right (fromIntegral wrote_bytes))\n\nbSearch :: String\n        -> CodeBuffer from to\n        -> Buffer from -> Buffer to -- From buffer (crucial data source) and to buffer (temporary storage only). To buffer must be empty (L=R).\n        -> Int               -- Target size of to buffer\n        -> Int -> Int -> Int -- Binary search min, mid, max\n        -> IO Int            -- Size of from buffer required to reach target size of to buffer\nbSearch msg code ibuf mbuf target_to_elems = go\n  where\n    go mn md mx = do\n      -- NB: this loop repeatedly reencodes on top of mbuf using a varying fraction of ibuf. It doesn't\n      -- matter if we blast the contents of mbuf since we already consumed all of the contents we are going to use.\n      (_why, ibuf, mbuf) <- code (ibuf { bufR = bufL ibuf + md }) mbuf\n      debugIO $ \"code (bSearch \" ++ msg ++ \") \" ++ show md ++ \" = \" ++ show _why ++ \", \" ++ summaryBuffer ibuf ++ summaryBuffer mbuf\n      -- The normal case is to get InputUnderflow here, which indicates that coding basically\n      -- terminated normally.\n      --\n      -- However, InvalidSequence is also possible if we are being called from cpDecode if we\n      -- have just been unlucky enough to set md so that ibuf straddles a byte boundary.\n      -- In this case we have to be really careful, because we don't want to report that\n      -- \"md\" elements is the right number when in actual fact we could have had md-1 input\n      -- elements and still produced the same number of bufferElems in mbuf.\n      --\n      -- In fact, we have to worry about this possibility even if we get InputUnderflow\n      -- since that will report InputUnderflow rather than InvalidSequence if the buffer\n      -- ends in a valid lead byte. So the expedient thing to do is simply to check if\n      -- the input buffer was entirely consumed.\n      --\n      -- When called from cpDecode, OutputUnderflow is also possible.\n      --\n      -- Luckily if we have InvalidSequence/OutputUnderflow and we do not appear to have reached\n      -- the target, what we should do is the same as normal because the fraction of ibuf that our\n      -- first \"code\" coded successfully must be invalid-sequence-free, and ibuf will always\n      -- have been decoded as far as the first invalid sequence in it.\n      case bufferElems mbuf `compare` target_to_elems of\n        -- Coding n \"from\" chars from the input yields exactly as many \"to\" chars\n        -- as were consumed by the recode. All is peachy:\n        EQ -> debugIO (\"bSearch = \" ++ show solution) >> return solution\n          where solution = md - bufferElems ibuf\n        -- If we encoded fewer \"to\" characters than the target number, try again with more \"from\" characters (and vice-versa)\n        LT -> go' (md+1) mx\n        GT -> go' mn (md-1)\n    go' mn mx | mn <= mx  = go mn (mn + ((mx - mn) `div` 2)) mx\n              | otherwise = errorWithoutStackTrace $ \"bSearch(\" ++ msg ++ \"): search crossed! \" ++ show (summaryBuffer ibuf, summaryBuffer mbuf, target_to_elems, mn, mx)\n\ncpRecode :: forall from to. Storable from\n         => (Ptr from -> Int -> Ptr to -> Int -> IO (Either Bool Int))\n         -> (from -> IO Bool)\n         -> Int -- ^ Maximum length of a complete translatable sequence in the input (e.g. 2 if the input is UTF-16, 1 if the input is a SBCS, 2 is the input is a DBCS). Must be at least 1.\n         -> Int -- ^ Minimum number of output elements per complete translatable sequence in the input (almost certainly 1)\n         -> Int -> Int\n         -> CodeBuffer from to\ncpRecode try' is_valid_prefix max_i_size min_o_size iscale oscale = go\n  where\n    go :: CodeBuffer from to\n    go ibuf obuf | isEmptyBuffer ibuf                = return (InputUnderflow,  ibuf, obuf)\n                 | bufferAvailable obuf < min_o_size = return (OutputUnderflow, ibuf, obuf)\n                 | otherwise                         = try (bufferElems ibuf `min` ((max_i_size * bufferAvailable obuf) `div` min_o_size)) seek_smaller\n      where\n        done why = return (why, ibuf, obuf)\n\n        seek_smaller n longer_was_valid\n          -- In this case, we can't shrink any further via any method. Calling (try 0) wouldn't be right because that will always claim InputUnderflow...\n          | n <= 1 = if longer_was_valid\n                      -- try m (where m >= n) was valid but we overflowed the output buffer with even a single input element\n                      then done OutputUnderflow\n                      -- there was no initial valid sequence in the input, but it might just be a truncated buffer - we need to check\n                      else do byte <- withBuffer ibuf $ \\ptr -> peekElemOff ptr (bufL ibuf)\n                              valid_prefix <- is_valid_prefix byte\n                              done (if valid_prefix && bufferElems ibuf < max_i_size then InputUnderflow else InvalidSequence)\n          -- If we're already looking at very small buffers, try every n down to 1, to ensure we spot as long a sequence as exists while avoiding trying 0.\n          -- Doing it this way ensures that we spot a single initial sequence of length <= max_i_size if any such exists.\n          | n < 2 * max_i_size = try (n - 1) (\\pred_n pred_n_was_valid -> seek_smaller pred_n (longer_was_valid || pred_n_was_valid))\n          -- Otherwise, try a binary chop to try to either get the prefix before the invalid input, or shrink the output down so it fits\n          -- in the output buffer. After the chop, try to consume extra input elements to try to recover as much of the sequence as possible if we\n          -- end up chopping a multi-element input sequence into two parts.\n          --\n          -- Note that since max_i_size >= 1:\n          --  * (n `div` 2) >= 1, so we don't try 0\n          --  * ((n `div` 2) + (max_i_size - 1)) < n, so we don't get into a loop where (seek_smaller n) calls post_divide (n `div` 2) calls (seek_smaller n)\n          | let n' = n `div` 2 = try n' (post_divide n' longer_was_valid)\n\n        post_divide _  _                n True  = seek_smaller n True\n        post_divide n' longer_was_valid n False | n < n' + max_i_size - 1 = try (n + 1) (post_divide n' longer_was_valid) -- There's still a chance..\n                                                | otherwise               = seek_smaller n' longer_was_valid              -- No amount of recovery could save us :(\n\n        try n k_fail = withBuffer ibuf $ \\iptr -> withBuffer obuf $ \\optr -> do\n          ei_err_wrote <- try' (iptr `plusPtr` (bufL ibuf `shiftL` iscale)) n\n                               (optr `plusPtr` (bufR obuf `shiftL` oscale)) (bufferAvailable obuf)\n          debugIO $ \"try \" ++ show n ++ \" = \" ++ show ei_err_wrote\n          case ei_err_wrote of\n            -- ERROR_INSUFFICIENT_BUFFER: A supplied buffer size was not large enough, or it was incorrectly set to NULL.\n            Left True  -> k_fail n True\n            -- ERROR_NO_UNICODE_TRANSLATION: Invalid Unicode was found in a string.\n            Left False -> k_fail n False\n            -- Must have interpreted all given bytes successfully\n            -- We need to iterate until we have consumed the complete contents of the buffer\n            Right wrote_elts -> go (bufferRemove n ibuf) (obuf { bufR = bufR obuf + wrote_elts })\n", "num_lines": 430}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, NoImplicitPrelude #-}\n-- Do not edit this file directly!\n-- It was generated by the MakeTable.hs script using the files below.\n-- To regenerate it, run \"make\" in ../../../../codepages/\n-- \n-- Files:\n-- CP037.TXT\n-- CP1026.TXT\n-- CP1250.TXT\n-- CP1251.TXT\n-- CP1252.TXT\n-- CP1253.TXT\n-- CP1254.TXT\n-- CP1255.TXT\n-- CP1256.TXT\n-- CP1257.TXT\n-- CP1258.TXT\n-- CP437.TXT\n-- CP500.TXT\n-- CP737.TXT\n-- CP775.TXT\n-- CP850.TXT\n-- CP852.TXT\n-- CP855.TXT\n-- CP857.TXT\n-- CP860.TXT\n-- CP861.TXT\n-- CP862.TXT\n-- CP863.TXT\n-- CP864.TXT\n-- CP865.TXT\n-- CP866.TXT\n-- CP869.TXT\n-- CP874.TXT\n-- CP875.TXT\nmodule GHC.IO.Encoding.CodePage.Table where\n\nimport GHC.Prim\nimport GHC.Base\nimport GHC.Word\ndata ConvArray a = ConvArray Addr#\ndata CompactArray a b = CompactArray {\n    encoderMax :: !a,\n    encoderIndices :: !(ConvArray Int),\n    encoderValues :: !(ConvArray b)\n  }\n\ndata CodePageArrays = SingleByteCP {\n    decoderArray :: !(ConvArray Char),\n    encoderArray :: !(CompactArray Char Word8)\n  }\n\nblockBitSize :: Int\nblockBitSize = 6\ncodePageMap :: [(Word32, CodePageArrays)]\ncodePageMap = [\n    (37, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x9c\\x0\\x9\\x0\\x86\\x0\\x7f\\x0\\x97\\x0\\x8d\\x0\\x8e\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x9d\\x0\\x85\\x0\\x8\\x0\\x87\\x0\\x18\\x0\\x19\\x0\\x92\\x0\\x8f\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x80\\x0\\x81\\x0\\x82\\x0\\x83\\x0\\x84\\x0\\xa\\x0\\x17\\x0\\x1b\\x0\\x88\\x0\\x89\\x0\\x8a\\x0\\x8b\\x0\\x8c\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x90\\x0\\x91\\x0\\x16\\x0\\x93\\x0\\x94\\x0\\x95\\x0\\x96\\x0\\x4\\x0\\x98\\x0\\x99\\x0\\x9a\\x0\\x9b\\x0\\x14\\x0\\x15\\x0\\x9e\\x0\\x1a\\x0\\x20\\x0\\xa0\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe1\\x0\\xe3\\x0\\xe5\\x0\\xe7\\x0\\xf1\\x0\\xa2\\x0\\x2e\\x0\\x3c\\x0\\x28\\x0\\x2b\\x0\\x7c\\x0\\x26\\x0\\xe9\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xed\\x0\\xee\\x0\\xef\\x0\\xec\\x0\\xdf\\x0\\x21\\x0\\x24\\x0\\x2a\\x0\\x29\\x0\\x3b\\x0\\xac\\x0\\x2d\\x0\\x2f\\x0\\xc2\\x0\\xc4\\x0\\xc0\\x0\\xc1\\x0\\xc3\\x0\\xc5\\x0\\xc7\\x0\\xd1\\x0\\xa6\\x0\\x2c\\x0\\x25\\x0\\x5f\\x0\\x3e\\x0\\x3f\\x0\\xf8\\x0\\xc9\\x0\\xca\\x0\\xcb\\x0\\xc8\\x0\\xcd\\x0\\xce\\x0\\xcf\\x0\\xcc\\x0\\x60\\x0\\x3a\\x0\\x23\\x0\\x40\\x0\\x27\\x0\\x3d\\x0\\x22\\x0\\xd8\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\xab\\x0\\xbb\\x0\\xf0\\x0\\xfd\\x0\\xfe\\x0\\xb1\\x0\\xb0\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\xaa\\x0\\xba\\x0\\xe6\\x0\\xb8\\x0\\xc6\\x0\\xa4\\x0\\xb5\\x0\\x7e\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\xa1\\x0\\xbf\\x0\\xd0\\x0\\xdd\\x0\\xde\\x0\\xae\\x0\\x5e\\x0\\xa3\\x0\\xa5\\x0\\xb7\\x0\\xa9\\x0\\xa7\\x0\\xb6\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\x5b\\x0\\x5d\\x0\\xaf\\x0\\xa8\\x0\\xb4\\x0\\xd7\\x0\\x7b\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\xad\\x0\\xf4\\x0\\xf6\\x0\\xf2\\x0\\xf3\\x0\\xf5\\x0\\x7d\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\xb9\\x0\\xfb\\x0\\xfc\\x0\\xf9\\x0\\xfa\\x0\\xff\\x0\\x5c\\x0\\xf7\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\xb2\\x0\\xd4\\x0\\xd6\\x0\\xd2\\x0\\xd3\\x0\\xd5\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\xb3\\x0\\xdb\\x0\\xdc\\x0\\xd9\\x0\\xda\\x0\\x9f\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x37\\x2d\\x2e\\x2f\\x16\\x5\\x25\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x3c\\x3d\\x32\\x26\\x18\\x19\\x3f\\x27\\x1c\\x1d\\x1e\\x1f\\x40\\x5a\\x7f\\x7b\\x5b\\x6c\\x50\\x7d\\x4d\\x5d\\x5c\\x4e\\x6b\\x60\\x4b\\x61\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\x7a\\x5e\\x4c\\x7e\\x6e\\x6f\\x7c\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xba\\xe0\\xbb\\xb0\\x6d\\x79\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xc0\\x4f\\xd0\\xa1\\x7\\x20\\x21\\x22\\x23\\x24\\x15\\x6\\x17\\x28\\x29\\x2a\\x2b\\x2c\\x9\\xa\\x1b\\x30\\x31\\x1a\\x33\\x34\\x35\\x36\\x8\\x38\\x39\\x3a\\x3b\\x4\\x14\\x3e\\xff\\x41\\xaa\\x4a\\xb1\\x9f\\xb2\\x6a\\xb5\\xbd\\xb4\\x9a\\x8a\\x5f\\xca\\xaf\\xbc\\x90\\x8f\\xea\\xfa\\xbe\\xa0\\xb6\\xb3\\x9d\\xda\\x9b\\x8b\\xb7\\xb8\\xb9\\xab\\x64\\x65\\x62\\x66\\x63\\x67\\x9e\\x68\\x74\\x71\\x72\\x73\\x78\\x75\\x76\\x77\\xac\\x69\\xed\\xee\\xeb\\xef\\xec\\xbf\\x80\\xfd\\xfe\\xfb\\xfc\\xad\\xae\\x59\\x44\\x45\\x42\\x46\\x43\\x47\\x9c\\x48\\x54\\x51\\x52\\x53\\x58\\x55\\x56\\x57\\x8c\\x49\\xcd\\xce\\xcb\\xcf\\xcc\\xe1\\x70\\xdd\\xde\\xdb\\xdc\\x8d\\x8e\\xdf\"#\n        , encoderMax = '\\255'\n        }\n\n   }\n    )\n\n    ,\n    (1026, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x9c\\x0\\x9\\x0\\x86\\x0\\x7f\\x0\\x97\\x0\\x8d\\x0\\x8e\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x9d\\x0\\x85\\x0\\x8\\x0\\x87\\x0\\x18\\x0\\x19\\x0\\x92\\x0\\x8f\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x80\\x0\\x81\\x0\\x82\\x0\\x83\\x0\\x84\\x0\\xa\\x0\\x17\\x0\\x1b\\x0\\x88\\x0\\x89\\x0\\x8a\\x0\\x8b\\x0\\x8c\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x90\\x0\\x91\\x0\\x16\\x0\\x93\\x0\\x94\\x0\\x95\\x0\\x96\\x0\\x4\\x0\\x98\\x0\\x99\\x0\\x9a\\x0\\x9b\\x0\\x14\\x0\\x15\\x0\\x9e\\x0\\x1a\\x0\\x20\\x0\\xa0\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe1\\x0\\xe3\\x0\\xe5\\x0\\x7b\\x0\\xf1\\x0\\xc7\\x0\\x2e\\x0\\x3c\\x0\\x28\\x0\\x2b\\x0\\x21\\x0\\x26\\x0\\xe9\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xed\\x0\\xee\\x0\\xef\\x0\\xec\\x0\\xdf\\x0\\x1e\\x1\\x30\\x1\\x2a\\x0\\x29\\x0\\x3b\\x0\\x5e\\x0\\x2d\\x0\\x2f\\x0\\xc2\\x0\\xc4\\x0\\xc0\\x0\\xc1\\x0\\xc3\\x0\\xc5\\x0\\x5b\\x0\\xd1\\x0\\x5f\\x1\\x2c\\x0\\x25\\x0\\x5f\\x0\\x3e\\x0\\x3f\\x0\\xf8\\x0\\xc9\\x0\\xca\\x0\\xcb\\x0\\xc8\\x0\\xcd\\x0\\xce\\x0\\xcf\\x0\\xcc\\x0\\x31\\x1\\x3a\\x0\\xd6\\x0\\x5e\\x1\\x27\\x0\\x3d\\x0\\xdc\\x0\\xd8\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\xab\\x0\\xbb\\x0\\x7d\\x0\\x60\\x0\\xa6\\x0\\xb1\\x0\\xb0\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\xaa\\x0\\xba\\x0\\xe6\\x0\\xb8\\x0\\xc6\\x0\\xa4\\x0\\xb5\\x0\\xf6\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\xa1\\x0\\xbf\\x0\\x5d\\x0\\x24\\x0\\x40\\x0\\xae\\x0\\xa2\\x0\\xa3\\x0\\xa5\\x0\\xb7\\x0\\xa9\\x0\\xa7\\x0\\xb6\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\xac\\x0\\x7c\\x0\\xaf\\x0\\xa8\\x0\\xb4\\x0\\xd7\\x0\\xe7\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\xad\\x0\\xf4\\x0\\x7e\\x0\\xf2\\x0\\xf3\\x0\\xf5\\x0\\x1f\\x1\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\xb9\\x0\\xfb\\x0\\x5c\\x0\\xf9\\x0\\xfa\\x0\\xff\\x0\\xfc\\x0\\xf7\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\xb2\\x0\\xd4\\x0\\x23\\x0\\xd2\\x0\\xd3\\x0\\xd5\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\xb3\\x0\\xdb\\x0\\x22\\x0\\xd9\\x0\\xda\\x0\\x9f\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x37\\x2d\\x2e\\x2f\\x16\\x5\\x25\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x3c\\x3d\\x32\\x26\\x18\\x19\\x3f\\x27\\x1c\\x1d\\x1e\\x1f\\x40\\x4f\\xfc\\xec\\xad\\x6c\\x50\\x7d\\x4d\\x5d\\x5c\\x4e\\x6b\\x60\\x4b\\x61\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\x7a\\x5e\\x4c\\x7e\\x6e\\x6f\\xae\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\x68\\xdc\\xac\\x5f\\x6d\\x8d\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\x48\\xbb\\x8c\\xcc\\x7\\x20\\x21\\x22\\x23\\x24\\x15\\x6\\x17\\x28\\x29\\x2a\\x2b\\x2c\\x9\\xa\\x1b\\x30\\x31\\x1a\\x33\\x34\\x35\\x36\\x8\\x38\\x39\\x3a\\x3b\\x4\\x14\\x3e\\xff\\x41\\xaa\\xb0\\xb1\\x9f\\xb2\\x8e\\xb5\\xbd\\xb4\\x9a\\x8a\\xba\\xca\\xaf\\xbc\\x90\\x8f\\xea\\xfa\\xbe\\xa0\\xb6\\xb3\\x9d\\xda\\x9b\\x8b\\xb7\\xb8\\xb9\\xab\\x64\\x65\\x62\\x66\\x63\\x67\\x9e\\x4a\\x74\\x71\\x72\\x73\\x78\\x75\\x76\\x77\\x0\\x69\\xed\\xee\\xeb\\xef\\x7b\\xbf\\x80\\xfd\\xfe\\xfb\\x7f\\x0\\x0\\x59\\x44\\x45\\x42\\x46\\x43\\x47\\x9c\\xc0\\x54\\x51\\x52\\x53\\x58\\x55\\x56\\x57\\x0\\x49\\xcd\\xce\\xcb\\xcf\\xa1\\xe1\\x70\\xdd\\xde\\xdb\\xe0\\x0\\x0\\xdf\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x5a\\xd0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x5b\\x79\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x7c\\x6a\"#\n        , encoderMax = '\\351'\n        }\n\n   }\n    )\n\n    ,\n    (1250, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x1a\\x20\\x0\\x0\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\x0\\x0\\x30\\x20\\x60\\x1\\x39\\x20\\x5a\\x1\\x64\\x1\\x7d\\x1\\x79\\x1\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\x0\\x0\\x22\\x21\\x61\\x1\\x3a\\x20\\x5b\\x1\\x65\\x1\\x7e\\x1\\x7a\\x1\\xa0\\x0\\xc7\\x2\\xd8\\x2\\x41\\x1\\xa4\\x0\\x4\\x1\\xa6\\x0\\xa7\\x0\\xa8\\x0\\xa9\\x0\\x5e\\x1\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\x7b\\x1\\xb0\\x0\\xb1\\x0\\xdb\\x2\\x42\\x1\\xb4\\x0\\xb5\\x0\\xb6\\x0\\xb7\\x0\\xb8\\x0\\x5\\x1\\x5f\\x1\\xbb\\x0\\x3d\\x1\\xdd\\x2\\x3e\\x1\\x7c\\x1\\x54\\x1\\xc1\\x0\\xc2\\x0\\x2\\x1\\xc4\\x0\\x39\\x1\\x6\\x1\\xc7\\x0\\xc\\x1\\xc9\\x0\\x18\\x1\\xcb\\x0\\x1a\\x1\\xcd\\x0\\xce\\x0\\xe\\x1\\x10\\x1\\x43\\x1\\x47\\x1\\xd3\\x0\\xd4\\x0\\x50\\x1\\xd6\\x0\\xd7\\x0\\x58\\x1\\x6e\\x1\\xda\\x0\\x70\\x1\\xdc\\x0\\xdd\\x0\\x62\\x1\\xdf\\x0\\x55\\x1\\xe1\\x0\\xe2\\x0\\x3\\x1\\xe4\\x0\\x3a\\x1\\x7\\x1\\xe7\\x0\\xd\\x1\\xe9\\x0\\x19\\x1\\xeb\\x0\\x1b\\x1\\xed\\x0\\xee\\x0\\xf\\x1\\x11\\x1\\x44\\x1\\x48\\x1\\xf3\\x0\\xf4\\x0\\x51\\x1\\xf6\\x0\\xf7\\x0\\x59\\x1\\x6f\\x1\\xfa\\x0\\x71\\x1\\xfc\\x0\\xfd\\x0\\x63\\x1\\xd9\\x2\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\xc0\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x0\\x2\\x80\\x1\\x40\\x2\\x80\\x1\\x80\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\x0\\x0\\xa4\\x0\\xa6\\xa7\\xa8\\xa9\\x0\\xab\\xac\\xad\\xae\\x0\\xb0\\xb1\\x0\\x0\\xb4\\xb5\\xb6\\xb7\\xb8\\x0\\x0\\xbb\\x0\\x0\\x0\\x0\\x0\\xc1\\xc2\\x0\\xc4\\x0\\x0\\xc7\\x0\\xc9\\x0\\xcb\\x0\\xcd\\xce\\x0\\x0\\x0\\x0\\xd3\\xd4\\x0\\xd6\\xd7\\x0\\x0\\xda\\x0\\xdc\\xdd\\x0\\xdf\\x0\\xe1\\xe2\\x0\\xe4\\x0\\x0\\xe7\\x0\\xe9\\x0\\xeb\\x0\\xed\\xee\\x0\\x0\\x0\\x0\\xf3\\xf4\\x0\\xf6\\xf7\\x0\\x0\\xfa\\x0\\xfc\\xfd\\x0\\x0\\x0\\x0\\xc3\\xe3\\xa5\\xb9\\xc6\\xe6\\x0\\x0\\x0\\x0\\xc8\\xe8\\xcf\\xef\\xd0\\xf0\\x0\\x0\\x0\\x0\\x0\\x0\\xca\\xea\\xcc\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\xe5\\x0\\x0\\xbc\\xbe\\x0\\x0\\xa3\\xb3\\xd1\\xf1\\x0\\x0\\xd2\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd5\\xf5\\x0\\x0\\xc0\\xe0\\x0\\x0\\xd8\\xf8\\x8c\\x9c\\x0\\x0\\xaa\\xba\\x8a\\x9a\\xde\\xfe\\x8d\\x9d\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd9\\xf9\\xdb\\xfb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8f\\x9f\\xaf\\xbf\\x8e\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa2\\xff\\x0\\xb2\\x0\\xbd\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1251, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\x2\\x4\\x3\\x4\\x1a\\x20\\x53\\x4\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\xac\\x20\\x30\\x20\\x9\\x4\\x39\\x20\\xa\\x4\\xc\\x4\\xb\\x4\\xf\\x4\\x52\\x4\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\x0\\x0\\x22\\x21\\x59\\x4\\x3a\\x20\\x5a\\x4\\x5c\\x4\\x5b\\x4\\x5f\\x4\\xa0\\x0\\xe\\x4\\x5e\\x4\\x8\\x4\\xa4\\x0\\x90\\x4\\xa6\\x0\\xa7\\x0\\x1\\x4\\xa9\\x0\\x4\\x4\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\x7\\x4\\xb0\\x0\\xb1\\x0\\x6\\x4\\x56\\x4\\x91\\x4\\xb5\\x0\\xb6\\x0\\xb7\\x0\\x51\\x4\\x16\\x21\\x54\\x4\\xbb\\x0\\x58\\x4\\x5\\x4\\x55\\x4\\x57\\x4\\x10\\x4\\x11\\x4\\x12\\x4\\x13\\x4\\x14\\x4\\x15\\x4\\x16\\x4\\x17\\x4\\x18\\x4\\x19\\x4\\x1a\\x4\\x1b\\x4\\x1c\\x4\\x1d\\x4\\x1e\\x4\\x1f\\x4\\x20\\x4\\x21\\x4\\x22\\x4\\x23\\x4\\x24\\x4\\x25\\x4\\x26\\x4\\x27\\x4\\x28\\x4\\x29\\x4\\x2a\\x4\\x2b\\x4\\x2c\\x4\\x2d\\x4\\x2e\\x4\\x2f\\x4\\x30\\x4\\x31\\x4\\x32\\x4\\x33\\x4\\x34\\x4\\x35\\x4\\x36\\x4\\x37\\x4\\x38\\x4\\x39\\x4\\x3a\\x4\\x3b\\x4\\x3c\\x4\\x3d\\x4\\x3e\\x4\\x3f\\x4\\x40\\x4\\x41\\x4\\x42\\x4\\x43\\x4\\x44\\x4\\x45\\x4\\x46\\x4\\x47\\x4\\x48\\x4\\x49\\x4\\x4a\\x4\\x4b\\x4\\x4c\\x4\\x4d\\x4\\x4e\\x4\\x4f\\x4\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x1\\xc0\\x0\\x0\\x2\\xc0\\x0\\x40\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\x0\\x0\\xa4\\x0\\xa6\\xa7\\x0\\xa9\\x0\\xab\\xac\\xad\\xae\\x0\\xb0\\xb1\\x0\\x0\\x0\\xb5\\xb6\\xb7\\x0\\x0\\x0\\xbb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa8\\x80\\x81\\xaa\\xbd\\xb2\\xaf\\xa3\\x8a\\x8c\\x8e\\x8d\\x0\\xa1\\x8f\\xc0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\xcc\\xcd\\xce\\xcf\\xd0\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xda\\xdb\\xdc\\xdd\\xde\\xdf\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\xfa\\xfb\\xfc\\xfd\\xfe\\xff\\x0\\xb8\\x90\\x83\\xba\\xbe\\xb3\\xbf\\xbc\\x9a\\x9c\\x9e\\x9d\\x0\\xa2\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa5\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1252, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x1a\\x20\\x92\\x1\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\xc6\\x2\\x30\\x20\\x60\\x1\\x39\\x20\\x52\\x1\\x0\\x0\\x7d\\x1\\x0\\x0\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\xdc\\x2\\x22\\x21\\x61\\x1\\x3a\\x20\\x53\\x1\\x0\\x0\\x7e\\x1\\x78\\x1\\xa0\\x0\\xa1\\x0\\xa2\\x0\\xa3\\x0\\xa4\\x0\\xa5\\x0\\xa6\\x0\\xa7\\x0\\xa8\\x0\\xa9\\x0\\xaa\\x0\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\xaf\\x0\\xb0\\x0\\xb1\\x0\\xb2\\x0\\xb3\\x0\\xb4\\x0\\xb5\\x0\\xb6\\x0\\xb7\\x0\\xb8\\x0\\xb9\\x0\\xba\\x0\\xbb\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\xbf\\x0\\xc0\\x0\\xc1\\x0\\xc2\\x0\\xc3\\x0\\xc4\\x0\\xc5\\x0\\xc6\\x0\\xc7\\x0\\xc8\\x0\\xc9\\x0\\xca\\x0\\xcb\\x0\\xcc\\x0\\xcd\\x0\\xce\\x0\\xcf\\x0\\xd0\\x0\\xd1\\x0\\xd2\\x0\\xd3\\x0\\xd4\\x0\\xd5\\x0\\xd6\\x0\\xd7\\x0\\xd8\\x0\\xd9\\x0\\xda\\x0\\xdb\\x0\\xdc\\x0\\xdd\\x0\\xde\\x0\\xdf\\x0\\xe0\\x0\\xe1\\x0\\xe2\\x0\\xe3\\x0\\xe4\\x0\\xe5\\x0\\xe6\\x0\\xe7\\x0\\xe8\\x0\\xe9\\x0\\xea\\x0\\xeb\\x0\\xec\\x0\\xed\\x0\\xee\\x0\\xef\\x0\\xf0\\x0\\xf1\\x0\\xf2\\x0\\xf3\\x0\\xf4\\x0\\xf5\\x0\\xf6\\x0\\xf7\\x0\\xf8\\x0\\xf9\\x0\\xfa\\x0\\xfb\\x0\\xfc\\x0\\xfd\\x0\\xfe\\x0\\xff\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x0\\x1\\x40\\x2\\x0\\x1\\x80\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\xa1\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xaa\\xab\\xac\\xad\\xae\\xaf\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\xba\\xbb\\xbc\\xbd\\xbe\\xbf\\xc0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\xcc\\xcd\\xce\\xcf\\xd0\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xda\\xdb\\xdc\\xdd\\xde\\xdf\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\xfa\\xfb\\xfc\\xfd\\xfe\\xff\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8c\\x9c\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8a\\x9a\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x8e\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x83\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x98\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1253, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x1a\\x20\\x92\\x1\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\x0\\x0\\x30\\x20\\x0\\x0\\x39\\x20\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\x0\\x0\\x22\\x21\\x0\\x0\\x3a\\x20\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\x85\\x3\\x86\\x3\\xa3\\x0\\xa4\\x0\\xa5\\x0\\xa6\\x0\\xa7\\x0\\xa8\\x0\\xa9\\x0\\x0\\x0\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\x15\\x20\\xb0\\x0\\xb1\\x0\\xb2\\x0\\xb3\\x0\\x84\\x3\\xb5\\x0\\xb6\\x0\\xb7\\x0\\x88\\x3\\x89\\x3\\x8a\\x3\\xbb\\x0\\x8c\\x3\\xbd\\x0\\x8e\\x3\\x8f\\x3\\x90\\x3\\x91\\x3\\x92\\x3\\x93\\x3\\x94\\x3\\x95\\x3\\x96\\x3\\x97\\x3\\x98\\x3\\x99\\x3\\x9a\\x3\\x9b\\x3\\x9c\\x3\\x9d\\x3\\x9e\\x3\\x9f\\x3\\xa0\\x3\\xa1\\x3\\x0\\x0\\xa3\\x3\\xa4\\x3\\xa5\\x3\\xa6\\x3\\xa7\\x3\\xa8\\x3\\xa9\\x3\\xaa\\x3\\xab\\x3\\xac\\x3\\xad\\x3\\xae\\x3\\xaf\\x3\\xb0\\x3\\xb1\\x3\\xb2\\x3\\xb3\\x3\\xb4\\x3\\xb5\\x3\\xb6\\x3\\xb7\\x3\\xb8\\x3\\xb9\\x3\\xba\\x3\\xbb\\x3\\xbc\\x3\\xbd\\x3\\xbe\\x3\\xbf\\x3\\xc0\\x3\\xc1\\x3\\xc2\\x3\\xc3\\x3\\xc4\\x3\\xc5\\x3\\xc6\\x3\\xc7\\x3\\xc8\\x3\\xc9\\x3\\xca\\x3\\xcb\\x3\\xcc\\x3\\xcd\\x3\\xce\\x3\\x0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x40\\x1\\x80\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x1\\xc0\\x0\\x0\\x2\\xc0\\x0\\x40\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\x0\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\x0\\xab\\xac\\xad\\xae\\x0\\xb0\\xb1\\xb2\\xb3\\x0\\xb5\\xb6\\xb7\\x0\\x0\\x0\\xbb\\x0\\xbd\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x83\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\xa1\\xa2\\x0\\xb8\\xb9\\xba\\x0\\xbc\\x0\\xbe\\xbf\\xc0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\xcc\\xcd\\xce\\xcf\\xd0\\xd1\\x0\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xda\\xdb\\xdc\\xdd\\xde\\xdf\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\xfa\\xfb\\xfc\\xfd\\xfe\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\xaf\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1254, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x1a\\x20\\x92\\x1\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\xc6\\x2\\x30\\x20\\x60\\x1\\x39\\x20\\x52\\x1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\xdc\\x2\\x22\\x21\\x61\\x1\\x3a\\x20\\x53\\x1\\x0\\x0\\x0\\x0\\x78\\x1\\xa0\\x0\\xa1\\x0\\xa2\\x0\\xa3\\x0\\xa4\\x0\\xa5\\x0\\xa6\\x0\\xa7\\x0\\xa8\\x0\\xa9\\x0\\xaa\\x0\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\xaf\\x0\\xb0\\x0\\xb1\\x0\\xb2\\x0\\xb3\\x0\\xb4\\x0\\xb5\\x0\\xb6\\x0\\xb7\\x0\\xb8\\x0\\xb9\\x0\\xba\\x0\\xbb\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\xbf\\x0\\xc0\\x0\\xc1\\x0\\xc2\\x0\\xc3\\x0\\xc4\\x0\\xc5\\x0\\xc6\\x0\\xc7\\x0\\xc8\\x0\\xc9\\x0\\xca\\x0\\xcb\\x0\\xcc\\x0\\xcd\\x0\\xce\\x0\\xcf\\x0\\x1e\\x1\\xd1\\x0\\xd2\\x0\\xd3\\x0\\xd4\\x0\\xd5\\x0\\xd6\\x0\\xd7\\x0\\xd8\\x0\\xd9\\x0\\xda\\x0\\xdb\\x0\\xdc\\x0\\x30\\x1\\x5e\\x1\\xdf\\x0\\xe0\\x0\\xe1\\x0\\xe2\\x0\\xe3\\x0\\xe4\\x0\\xe5\\x0\\xe6\\x0\\xe7\\x0\\xe8\\x0\\xe9\\x0\\xea\\x0\\xeb\\x0\\xec\\x0\\xed\\x0\\xee\\x0\\xef\\x0\\x1f\\x1\\xf1\\x0\\xf2\\x0\\xf3\\x0\\xf4\\x0\\xf5\\x0\\xf6\\x0\\xf7\\x0\\xf8\\x0\\xf9\\x0\\xfa\\x0\\xfb\\x0\\xfc\\x0\\x31\\x1\\x5f\\x1\\xff\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\x0\\x2\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\x40\\x2\\xc0\\x1\\x80\\x2\\xc0\\x1\\xc0\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\xa1\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xaa\\xab\\xac\\xad\\xae\\xaf\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\xba\\xbb\\xbc\\xbd\\xbe\\xbf\\xc0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\xcc\\xcd\\xce\\xcf\\x0\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xda\\xdb\\xdc\\x0\\x0\\xdf\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef\\x0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\xfa\\xfb\\xfc\\x0\\x0\\xff\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd0\\xf0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdd\\xfd\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8c\\x9c\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xde\\xfe\\x8a\\x9a\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x83\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x98\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1255, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x1a\\x20\\x92\\x1\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\xc6\\x2\\x30\\x20\\x0\\x0\\x39\\x20\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\xdc\\x2\\x22\\x21\\x0\\x0\\x3a\\x20\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\xa1\\x0\\xa2\\x0\\xa3\\x0\\xaa\\x20\\xa5\\x0\\xa6\\x0\\xa7\\x0\\xa8\\x0\\xa9\\x0\\xd7\\x0\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\xaf\\x0\\xb0\\x0\\xb1\\x0\\xb2\\x0\\xb3\\x0\\xb4\\x0\\xb5\\x0\\xb6\\x0\\xb7\\x0\\xb8\\x0\\xb9\\x0\\xf7\\x0\\xbb\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\xbf\\x0\\xb0\\x5\\xb1\\x5\\xb2\\x5\\xb3\\x5\\xb4\\x5\\xb5\\x5\\xb6\\x5\\xb7\\x5\\xb8\\x5\\xb9\\x5\\x0\\x0\\xbb\\x5\\xbc\\x5\\xbd\\x5\\xbe\\x5\\xbf\\x5\\xc0\\x5\\xc1\\x5\\xc2\\x5\\xc3\\x5\\xf0\\x5\\xf1\\x5\\xf2\\x5\\xf3\\x5\\xf4\\x5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd0\\x5\\xd1\\x5\\xd2\\x5\\xd3\\x5\\xd4\\x5\\xd5\\x5\\xd6\\x5\\xd7\\x5\\xd8\\x5\\xd9\\x5\\xda\\x5\\xdb\\x5\\xdc\\x5\\xdd\\x5\\xde\\x5\\xdf\\x5\\xe0\\x5\\xe1\\x5\\xe2\\x5\\xe3\\x5\\xe4\\x5\\xe5\\x5\\xe6\\x5\\xe7\\x5\\xe8\\x5\\xe9\\x5\\xea\\x5\\x0\\x0\\x0\\x0\\xe\\x20\\xf\\x20\\x0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x40\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x1\\x0\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x2\\x0\\x1\\x80\\x2\\x0\\x1\\xc0\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\xa1\\xa2\\xa3\\x0\\xa5\\xa6\\xa7\\xa8\\xa9\\x0\\xab\\xac\\xad\\xae\\xaf\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\x0\\xbb\\xbc\\xbd\\xbe\\xbf\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xaa\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xba\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x83\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x98\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\x0\\xcb\\xcc\\xcd\\xce\\xcf\\xd0\\xd1\\xd2\\xd3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\xfa\\x0\\x0\\x0\\x0\\x0\\xd4\\xd5\\xd6\\xd7\\xd8\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfd\\xfe\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa4\\x0\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1256, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x7e\\x6\\x1a\\x20\\x92\\x1\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\xc6\\x2\\x30\\x20\\x79\\x6\\x39\\x20\\x52\\x1\\x86\\x6\\x98\\x6\\x88\\x6\\xaf\\x6\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\xa9\\x6\\x22\\x21\\x91\\x6\\x3a\\x20\\x53\\x1\\xc\\x20\\xd\\x20\\xba\\x6\\xa0\\x0\\xc\\x6\\xa2\\x0\\xa3\\x0\\xa4\\x0\\xa5\\x0\\xa6\\x0\\xa7\\x0\\xa8\\x0\\xa9\\x0\\xbe\\x6\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\xaf\\x0\\xb0\\x0\\xb1\\x0\\xb2\\x0\\xb3\\x0\\xb4\\x0\\xb5\\x0\\xb6\\x0\\xb7\\x0\\xb8\\x0\\xb9\\x0\\x1b\\x6\\xbb\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\x1f\\x6\\xc1\\x6\\x21\\x6\\x22\\x6\\x23\\x6\\x24\\x6\\x25\\x6\\x26\\x6\\x27\\x6\\x28\\x6\\x29\\x6\\x2a\\x6\\x2b\\x6\\x2c\\x6\\x2d\\x6\\x2e\\x6\\x2f\\x6\\x30\\x6\\x31\\x6\\x32\\x6\\x33\\x6\\x34\\x6\\x35\\x6\\x36\\x6\\xd7\\x0\\x37\\x6\\x38\\x6\\x39\\x6\\x3a\\x6\\x40\\x6\\x41\\x6\\x42\\x6\\x43\\x6\\xe0\\x0\\x44\\x6\\xe2\\x0\\x45\\x6\\x46\\x6\\x47\\x6\\x48\\x6\\xe7\\x0\\xe8\\x0\\xe9\\x0\\xea\\x0\\xeb\\x0\\x49\\x6\\x4a\\x6\\xee\\x0\\xef\\x0\\x4b\\x6\\x4c\\x6\\x4d\\x6\\x4e\\x6\\xf4\\x0\\x4f\\x6\\x50\\x6\\xf7\\x0\\x51\\x6\\xf9\\x0\\x52\\x6\\xfb\\x0\\xfc\\x0\\xe\\x20\\xf\\x20\\xd2\\x6\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x40\\x2\\x80\\x2\\xc0\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x3\\x0\\x1\\x40\\x3\\x0\\x1\\x80\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\x0\\xab\\xac\\xad\\xae\\xaf\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\x0\\xbb\\xbc\\xbd\\xbe\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\xe2\\x0\\x0\\x0\\x0\\xe7\\xe8\\xe9\\xea\\xeb\\x0\\x0\\xee\\xef\\x0\\x0\\x0\\x0\\xf4\\x0\\x0\\xf7\\x0\\xf9\\x0\\xfb\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8c\\x9c\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x83\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xba\\x0\\x0\\x0\\xbf\\x0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\xcc\\xcd\\xce\\xcf\\xd0\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd8\\xd9\\xda\\xdb\\x0\\x0\\x0\\x0\\x0\\xdc\\xdd\\xde\\xdf\\xe1\\xe3\\xe4\\xe5\\xe6\\xec\\xed\\xf0\\xf1\\xf2\\xf3\\xf5\\xf6\\xf8\\xfa\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8a\\x0\\x0\\x0\\x0\\x81\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8d\\x0\\x8f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9a\\x0\\x0\\x0\\x0\\x0\\x0\\x8e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x98\\x0\\x0\\x0\\x0\\x0\\x90\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\xaa\\x0\\x0\\xc0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9d\\x9e\\xfd\\xfe\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1257, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x1a\\x20\\x0\\x0\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\x0\\x0\\x30\\x20\\x0\\x0\\x39\\x20\\x0\\x0\\xa8\\x0\\xc7\\x2\\xb8\\x0\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\x0\\x0\\x22\\x21\\x0\\x0\\x3a\\x20\\x0\\x0\\xaf\\x0\\xdb\\x2\\x0\\x0\\xa0\\x0\\x0\\x0\\xa2\\x0\\xa3\\x0\\xa4\\x0\\x0\\x0\\xa6\\x0\\xa7\\x0\\xd8\\x0\\xa9\\x0\\x56\\x1\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\xc6\\x0\\xb0\\x0\\xb1\\x0\\xb2\\x0\\xb3\\x0\\xb4\\x0\\xb5\\x0\\xb6\\x0\\xb7\\x0\\xf8\\x0\\xb9\\x0\\x57\\x1\\xbb\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\xe6\\x0\\x4\\x1\\x2e\\x1\\x0\\x1\\x6\\x1\\xc4\\x0\\xc5\\x0\\x18\\x1\\x12\\x1\\xc\\x1\\xc9\\x0\\x79\\x1\\x16\\x1\\x22\\x1\\x36\\x1\\x2a\\x1\\x3b\\x1\\x60\\x1\\x43\\x1\\x45\\x1\\xd3\\x0\\x4c\\x1\\xd5\\x0\\xd6\\x0\\xd7\\x0\\x72\\x1\\x41\\x1\\x5a\\x1\\x6a\\x1\\xdc\\x0\\x7b\\x1\\x7d\\x1\\xdf\\x0\\x5\\x1\\x2f\\x1\\x1\\x1\\x7\\x1\\xe4\\x0\\xe5\\x0\\x19\\x1\\x13\\x1\\xd\\x1\\xe9\\x0\\x7a\\x1\\x17\\x1\\x23\\x1\\x37\\x1\\x2b\\x1\\x3c\\x1\\x61\\x1\\x44\\x1\\x46\\x1\\xf3\\x0\\x4d\\x1\\xf5\\x0\\xf6\\x0\\xf7\\x0\\x73\\x1\\x42\\x1\\x5b\\x1\\x6b\\x1\\xfc\\x0\\x7c\\x1\\x7e\\x1\\xd9\\x2\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\xc0\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x0\\x2\\x80\\x1\\x40\\x2\\x80\\x1\\x80\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\xa2\\xa3\\xa4\\x0\\xa6\\xa7\\x8d\\xa9\\x0\\xab\\xac\\xad\\xae\\x9d\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\x8f\\xb9\\x0\\xbb\\xbc\\xbd\\xbe\\x0\\x0\\x0\\x0\\x0\\xc4\\xc5\\xaf\\x0\\x0\\xc9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd3\\x0\\xd5\\xd6\\xd7\\xa8\\x0\\x0\\x0\\xdc\\x0\\x0\\xdf\\x0\\x0\\x0\\x0\\xe4\\xe5\\xbf\\x0\\x0\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf3\\x0\\xf5\\xf6\\xf7\\xb8\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\xc2\\xe2\\x0\\x0\\xc0\\xe0\\xc3\\xe3\\x0\\x0\\x0\\x0\\xc8\\xe8\\x0\\x0\\x0\\x0\\xc7\\xe7\\x0\\x0\\xcb\\xeb\\xc6\\xe6\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcc\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\xce\\xee\\x0\\x0\\xc1\\xe1\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xed\\x0\\x0\\x0\\xcf\\xef\\x0\\x0\\x0\\x0\\xd9\\xf9\\xd1\\xf1\\xd2\\xf2\\x0\\x0\\x0\\x0\\x0\\xd4\\xf4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xaa\\xba\\x0\\x0\\xda\\xfa\\x0\\x0\\x0\\x0\\xd0\\xf0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdb\\xfb\\x0\\x0\\x0\\x0\\x0\\x0\\xd8\\xf8\\x0\\x0\\x0\\x0\\x0\\xca\\xea\\xdd\\xfd\\xde\\xfe\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (1258, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x1a\\x20\\x92\\x1\\x1e\\x20\\x26\\x20\\x20\\x20\\x21\\x20\\xc6\\x2\\x30\\x20\\x0\\x0\\x39\\x20\\x52\\x1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\xdc\\x2\\x22\\x21\\x0\\x0\\x3a\\x20\\x53\\x1\\x0\\x0\\x0\\x0\\x78\\x1\\xa0\\x0\\xa1\\x0\\xa2\\x0\\xa3\\x0\\xa4\\x0\\xa5\\x0\\xa6\\x0\\xa7\\x0\\xa8\\x0\\xa9\\x0\\xaa\\x0\\xab\\x0\\xac\\x0\\xad\\x0\\xae\\x0\\xaf\\x0\\xb0\\x0\\xb1\\x0\\xb2\\x0\\xb3\\x0\\xb4\\x0\\xb5\\x0\\xb6\\x0\\xb7\\x0\\xb8\\x0\\xb9\\x0\\xba\\x0\\xbb\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\xbf\\x0\\xc0\\x0\\xc1\\x0\\xc2\\x0\\x2\\x1\\xc4\\x0\\xc5\\x0\\xc6\\x0\\xc7\\x0\\xc8\\x0\\xc9\\x0\\xca\\x0\\xcb\\x0\\x0\\x3\\xcd\\x0\\xce\\x0\\xcf\\x0\\x10\\x1\\xd1\\x0\\x9\\x3\\xd3\\x0\\xd4\\x0\\xa0\\x1\\xd6\\x0\\xd7\\x0\\xd8\\x0\\xd9\\x0\\xda\\x0\\xdb\\x0\\xdc\\x0\\xaf\\x1\\x3\\x3\\xdf\\x0\\xe0\\x0\\xe1\\x0\\xe2\\x0\\x3\\x1\\xe4\\x0\\xe5\\x0\\xe6\\x0\\xe7\\x0\\xe8\\x0\\xe9\\x0\\xea\\x0\\xeb\\x0\\x1\\x3\\xed\\x0\\xee\\x0\\xef\\x0\\x11\\x1\\xf1\\x0\\x23\\x3\\xf3\\x0\\xf4\\x0\\xa1\\x1\\xf6\\x0\\xf7\\x0\\xf8\\x0\\xf9\\x0\\xfa\\x0\\xfb\\x0\\xfc\\x0\\xb0\\x1\\xab\\x20\\xff\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\x0\\x2\\x40\\x2\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\xc0\\x1\\x80\\x2\\xc0\\x1\\xc0\\x2\\xc0\\x1\\x0\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\xa1\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xaa\\xab\\xac\\xad\\xae\\xaf\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\xba\\xbb\\xbc\\xbd\\xbe\\xbf\\xc0\\xc1\\xc2\\x0\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\x0\\xcd\\xce\\xcf\\x0\\xd1\\x0\\xd3\\xd4\\x0\\xd6\\xd7\\xd8\\xd9\\xda\\xdb\\xdc\\x0\\x0\\xdf\\xe0\\xe1\\xe2\\x0\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\x0\\xed\\xee\\xef\\x0\\xf1\\x0\\xf3\\xf4\\x0\\xf6\\xf7\\xf8\\xf9\\xfa\\xfb\\xfc\\x0\\x0\\xff\\x0\\x0\\xc3\\xe3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd0\\xf0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8c\\x9c\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x83\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd5\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdd\\xfd\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x98\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcc\\xec\\x0\\xde\\x0\\x0\\x0\\x0\\x0\\xd2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x82\\x0\\x93\\x94\\x84\\x0\\x86\\x87\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x9b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\\x80\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x99\"#\n        , encoderMax = '\\8482'\n        }\n\n   }\n    )\n\n    ,\n    (437, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe5\\x0\\xe7\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xef\\x0\\xee\\x0\\xec\\x0\\xc4\\x0\\xc5\\x0\\xc9\\x0\\xe6\\x0\\xc6\\x0\\xf4\\x0\\xf6\\x0\\xf2\\x0\\xfb\\x0\\xf9\\x0\\xff\\x0\\xd6\\x0\\xdc\\x0\\xa2\\x0\\xa3\\x0\\xa5\\x0\\xa7\\x20\\x92\\x1\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\xf1\\x0\\xd1\\x0\\xaa\\x0\\xba\\x0\\xbf\\x0\\x10\\x23\\xac\\x0\\xbd\\x0\\xbc\\x0\\xa1\\x0\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xb1\\x3\\xdf\\x0\\x93\\x3\\xc0\\x3\\xa3\\x3\\xc3\\x3\\xb5\\x0\\xc4\\x3\\xa6\\x3\\x98\\x3\\xa9\\x3\\xb4\\x3\\x1e\\x22\\xc6\\x3\\xb5\\x3\\x29\\x22\\x61\\x22\\xb1\\x0\\x65\\x22\\x64\\x22\\x20\\x23\\x21\\x23\\xf7\\x0\\x48\\x22\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x7f\\x20\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x40\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x40\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x2\\xc0\\x2\\x0\\x1\\x0\\x1\\x0\\x3\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x3\\x80\\x3\\xc0\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\xad\\x9b\\x9c\\x0\\x9d\\x0\\x0\\x0\\x0\\xa6\\xae\\xaa\\x0\\x0\\x0\\xf8\\xf1\\xfd\\x0\\x0\\xe6\\x0\\xfa\\x0\\x0\\xa7\\xaf\\xac\\xab\\x0\\xa8\\x0\\x0\\x0\\x0\\x8e\\x8f\\x92\\x80\\x0\\x90\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa5\\x0\\x0\\x0\\x0\\x99\\x0\\x0\\x0\\x0\\x0\\x9a\\x0\\x0\\xe1\\x85\\xa0\\x83\\x0\\x84\\x86\\x91\\x87\\x8a\\x82\\x88\\x89\\x8d\\xa1\\x8c\\x8b\\x0\\xa4\\x95\\xa2\\x93\\x0\\x94\\xf6\\x0\\x97\\xa3\\x96\\x81\\x0\\x0\\x98\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe2\\x0\\x0\\x0\\x0\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe4\\x0\\x0\\xe8\\x0\\x0\\xea\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\x0\\xeb\\xee\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe3\\x0\\x0\\xe5\\xe7\\x0\\xed\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xf3\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf4\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (500, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x9c\\x0\\x9\\x0\\x86\\x0\\x7f\\x0\\x97\\x0\\x8d\\x0\\x8e\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x9d\\x0\\x85\\x0\\x8\\x0\\x87\\x0\\x18\\x0\\x19\\x0\\x92\\x0\\x8f\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x80\\x0\\x81\\x0\\x82\\x0\\x83\\x0\\x84\\x0\\xa\\x0\\x17\\x0\\x1b\\x0\\x88\\x0\\x89\\x0\\x8a\\x0\\x8b\\x0\\x8c\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x90\\x0\\x91\\x0\\x16\\x0\\x93\\x0\\x94\\x0\\x95\\x0\\x96\\x0\\x4\\x0\\x98\\x0\\x99\\x0\\x9a\\x0\\x9b\\x0\\x14\\x0\\x15\\x0\\x9e\\x0\\x1a\\x0\\x20\\x0\\xa0\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe1\\x0\\xe3\\x0\\xe5\\x0\\xe7\\x0\\xf1\\x0\\x5b\\x0\\x2e\\x0\\x3c\\x0\\x28\\x0\\x2b\\x0\\x21\\x0\\x26\\x0\\xe9\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xed\\x0\\xee\\x0\\xef\\x0\\xec\\x0\\xdf\\x0\\x5d\\x0\\x24\\x0\\x2a\\x0\\x29\\x0\\x3b\\x0\\x5e\\x0\\x2d\\x0\\x2f\\x0\\xc2\\x0\\xc4\\x0\\xc0\\x0\\xc1\\x0\\xc3\\x0\\xc5\\x0\\xc7\\x0\\xd1\\x0\\xa6\\x0\\x2c\\x0\\x25\\x0\\x5f\\x0\\x3e\\x0\\x3f\\x0\\xf8\\x0\\xc9\\x0\\xca\\x0\\xcb\\x0\\xc8\\x0\\xcd\\x0\\xce\\x0\\xcf\\x0\\xcc\\x0\\x60\\x0\\x3a\\x0\\x23\\x0\\x40\\x0\\x27\\x0\\x3d\\x0\\x22\\x0\\xd8\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\xab\\x0\\xbb\\x0\\xf0\\x0\\xfd\\x0\\xfe\\x0\\xb1\\x0\\xb0\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\xaa\\x0\\xba\\x0\\xe6\\x0\\xb8\\x0\\xc6\\x0\\xa4\\x0\\xb5\\x0\\x7e\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\xa1\\x0\\xbf\\x0\\xd0\\x0\\xdd\\x0\\xde\\x0\\xae\\x0\\xa2\\x0\\xa3\\x0\\xa5\\x0\\xb7\\x0\\xa9\\x0\\xa7\\x0\\xb6\\x0\\xbc\\x0\\xbd\\x0\\xbe\\x0\\xac\\x0\\x7c\\x0\\xaf\\x0\\xa8\\x0\\xb4\\x0\\xd7\\x0\\x7b\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\xad\\x0\\xf4\\x0\\xf6\\x0\\xf2\\x0\\xf3\\x0\\xf5\\x0\\x7d\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\xb9\\x0\\xfb\\x0\\xfc\\x0\\xf9\\x0\\xfa\\x0\\xff\\x0\\x5c\\x0\\xf7\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\xb2\\x0\\xd4\\x0\\xd6\\x0\\xd2\\x0\\xd3\\x0\\xd5\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\xb3\\x0\\xdb\\x0\\xdc\\x0\\xd9\\x0\\xda\\x0\\x9f\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x37\\x2d\\x2e\\x2f\\x16\\x5\\x25\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x3c\\x3d\\x32\\x26\\x18\\x19\\x3f\\x27\\x1c\\x1d\\x1e\\x1f\\x40\\x4f\\x7f\\x7b\\x5b\\x6c\\x50\\x7d\\x4d\\x5d\\x5c\\x4e\\x6b\\x60\\x4b\\x61\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\x7a\\x5e\\x4c\\x7e\\x6e\\x6f\\x7c\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\x4a\\xe0\\x5a\\x5f\\x6d\\x79\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xc0\\xbb\\xd0\\xa1\\x7\\x20\\x21\\x22\\x23\\x24\\x15\\x6\\x17\\x28\\x29\\x2a\\x2b\\x2c\\x9\\xa\\x1b\\x30\\x31\\x1a\\x33\\x34\\x35\\x36\\x8\\x38\\x39\\x3a\\x3b\\x4\\x14\\x3e\\xff\\x41\\xaa\\xb0\\xb1\\x9f\\xb2\\x6a\\xb5\\xbd\\xb4\\x9a\\x8a\\xba\\xca\\xaf\\xbc\\x90\\x8f\\xea\\xfa\\xbe\\xa0\\xb6\\xb3\\x9d\\xda\\x9b\\x8b\\xb7\\xb8\\xb9\\xab\\x64\\x65\\x62\\x66\\x63\\x67\\x9e\\x68\\x74\\x71\\x72\\x73\\x78\\x75\\x76\\x77\\xac\\x69\\xed\\xee\\xeb\\xef\\xec\\xbf\\x80\\xfd\\xfe\\xfb\\xfc\\xad\\xae\\x59\\x44\\x45\\x42\\x46\\x43\\x47\\x9c\\x48\\x54\\x51\\x52\\x53\\x58\\x55\\x56\\x57\\x8c\\x49\\xcd\\xce\\xcb\\xcf\\xcc\\xe1\\x70\\xdd\\xde\\xdb\\xdc\\x8d\\x8e\\xdf\"#\n        , encoderMax = '\\255'\n        }\n\n   }\n    )\n\n    ,\n    (737, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\x91\\x3\\x92\\x3\\x93\\x3\\x94\\x3\\x95\\x3\\x96\\x3\\x97\\x3\\x98\\x3\\x99\\x3\\x9a\\x3\\x9b\\x3\\x9c\\x3\\x9d\\x3\\x9e\\x3\\x9f\\x3\\xa0\\x3\\xa1\\x3\\xa3\\x3\\xa4\\x3\\xa5\\x3\\xa6\\x3\\xa7\\x3\\xa8\\x3\\xa9\\x3\\xb1\\x3\\xb2\\x3\\xb3\\x3\\xb4\\x3\\xb5\\x3\\xb6\\x3\\xb7\\x3\\xb8\\x3\\xb9\\x3\\xba\\x3\\xbb\\x3\\xbc\\x3\\xbd\\x3\\xbe\\x3\\xbf\\x3\\xc0\\x3\\xc1\\x3\\xc3\\x3\\xc2\\x3\\xc4\\x3\\xc5\\x3\\xc6\\x3\\xc7\\x3\\xc8\\x3\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xc9\\x3\\xac\\x3\\xad\\x3\\xae\\x3\\xca\\x3\\xaf\\x3\\xcc\\x3\\xcd\\x3\\xcb\\x3\\xce\\x3\\x86\\x3\\x88\\x3\\x89\\x3\\x8a\\x3\\x8c\\x3\\x8e\\x3\\x8f\\x3\\xb1\\x0\\x65\\x22\\x64\\x22\\xaa\\x3\\xab\\x3\\xf7\\x0\\x48\\x22\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x7f\\x20\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x1\\x80\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x40\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x2\\xc0\\x2\\x0\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf8\\xf1\\xfd\\x0\\x0\\x0\\x0\\xfa\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf6\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xea\\x0\\xeb\\xec\\xed\\x0\\xee\\x0\\xef\\xf0\\x0\\x80\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x8a\\x8b\\x8c\\x8d\\x8e\\x8f\\x90\\x0\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\xf4\\xf5\\xe1\\xe2\\xe3\\xe5\\x0\\x98\\x99\\x9a\\x9b\\x9c\\x9d\\x9e\\x9f\\xa0\\xa1\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xaa\\xa9\\xab\\xac\\xad\\xae\\xaf\\xe0\\xe4\\xe8\\xe6\\xe7\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf3\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (775, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\x6\\x1\\xfc\\x0\\xe9\\x0\\x1\\x1\\xe4\\x0\\x23\\x1\\xe5\\x0\\x7\\x1\\x42\\x1\\x13\\x1\\x56\\x1\\x57\\x1\\x2b\\x1\\x79\\x1\\xc4\\x0\\xc5\\x0\\xc9\\x0\\xe6\\x0\\xc6\\x0\\x4d\\x1\\xf6\\x0\\x22\\x1\\xa2\\x0\\x5a\\x1\\x5b\\x1\\xd6\\x0\\xdc\\x0\\xf8\\x0\\xa3\\x0\\xd8\\x0\\xd7\\x0\\xa4\\x0\\x0\\x1\\x2a\\x1\\xf3\\x0\\x7b\\x1\\x7c\\x1\\x7a\\x1\\x1d\\x20\\xa6\\x0\\xa9\\x0\\xae\\x0\\xac\\x0\\xbd\\x0\\xbc\\x0\\x41\\x1\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x4\\x1\\xc\\x1\\x18\\x1\\x16\\x1\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x2e\\x1\\x60\\x1\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x72\\x1\\x6a\\x1\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x7d\\x1\\x5\\x1\\xd\\x1\\x19\\x1\\x17\\x1\\x2f\\x1\\x61\\x1\\x73\\x1\\x6b\\x1\\x7e\\x1\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xd3\\x0\\xdf\\x0\\x4c\\x1\\x43\\x1\\xf5\\x0\\xd5\\x0\\xb5\\x0\\x44\\x1\\x36\\x1\\x37\\x1\\x3b\\x1\\x3c\\x1\\x46\\x1\\x12\\x1\\x45\\x1\\x19\\x20\\xad\\x0\\xb1\\x0\\x1c\\x20\\xbe\\x0\\xb6\\x0\\xa7\\x0\\xf7\\x0\\x1e\\x20\\xb0\\x0\\x19\\x22\\xb7\\x0\\xb9\\x0\\xb3\\x0\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\xc0\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x0\\x2\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x40\\x2\\x80\\x2\\xc0\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x96\\x9c\\x9f\\x0\\xa7\\xf5\\x0\\xa8\\x0\\xae\\xaa\\xf0\\xa9\\x0\\xf8\\xf1\\xfd\\xfc\\x0\\xe6\\xf4\\xfa\\x0\\xfb\\x0\\xaf\\xac\\xab\\xf3\\x0\\x0\\x0\\x0\\x0\\x8e\\x8f\\x92\\x0\\x0\\x90\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\xe5\\x99\\x9e\\x9d\\x0\\x0\\x0\\x9a\\x0\\x0\\xe1\\x0\\x0\\x0\\x0\\x84\\x86\\x91\\x0\\x0\\x82\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa2\\x0\\xe4\\x94\\xf6\\x9b\\x0\\x0\\x0\\x81\\x0\\x0\\x0\\xa0\\x83\\x0\\x0\\xb5\\xd0\\x80\\x87\\x0\\x0\\x0\\x0\\xb6\\xd1\\x0\\x0\\x0\\x0\\xed\\x89\\x0\\x0\\xb8\\xd3\\xb7\\xd2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x95\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\xa1\\x8c\\x0\\x0\\xbd\\xd4\\x0\\x0\\x0\\x0\\x0\\x0\\xe8\\xe9\\x0\\x0\\x0\\xea\\xeb\\x0\\x0\\x0\\x0\\xad\\x88\\xe3\\xe7\\xee\\xec\\x0\\x0\\x0\\x0\\x0\\xe2\\x93\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8a\\x8b\\x0\\x0\\x97\\x98\\x0\\x0\\x0\\x0\\xbe\\xd5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc7\\xd7\\x0\\x0\\x0\\x0\\x0\\x0\\xc6\\xd6\\x0\\x0\\x0\\x0\\x0\\x8d\\xa5\\xa3\\xa4\\xcf\\xd8\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\xf2\\xa6\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\x0\\x0\\xc9\\x0\\x0\\xbb\\x0\\x0\\xc8\\x0\\x0\\xbc\\x0\\x0\\xcc\\x0\\x0\\xb9\\x0\\x0\\xcb\\x0\\x0\\xca\\x0\\x0\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (850, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe5\\x0\\xe7\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xef\\x0\\xee\\x0\\xec\\x0\\xc4\\x0\\xc5\\x0\\xc9\\x0\\xe6\\x0\\xc6\\x0\\xf4\\x0\\xf6\\x0\\xf2\\x0\\xfb\\x0\\xf9\\x0\\xff\\x0\\xd6\\x0\\xdc\\x0\\xf8\\x0\\xa3\\x0\\xd8\\x0\\xd7\\x0\\x92\\x1\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\xf1\\x0\\xd1\\x0\\xaa\\x0\\xba\\x0\\xbf\\x0\\xae\\x0\\xac\\x0\\xbd\\x0\\xbc\\x0\\xa1\\x0\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\xc1\\x0\\xc2\\x0\\xc0\\x0\\xa9\\x0\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\xa2\\x0\\xa5\\x0\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\xe3\\x0\\xc3\\x0\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\xa4\\x0\\xf0\\x0\\xd0\\x0\\xca\\x0\\xcb\\x0\\xc8\\x0\\x31\\x1\\xcd\\x0\\xce\\x0\\xcf\\x0\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\xa6\\x0\\xcc\\x0\\x80\\x25\\xd3\\x0\\xdf\\x0\\xd4\\x0\\xd2\\x0\\xf5\\x0\\xd5\\x0\\xb5\\x0\\xfe\\x0\\xde\\x0\\xda\\x0\\xdb\\x0\\xd9\\x0\\xfd\\x0\\xdd\\x0\\xaf\\x0\\xb4\\x0\\xad\\x0\\xb1\\x0\\x17\\x20\\xbe\\x0\\xb6\\x0\\xa7\\x0\\xf7\\x0\\xb8\\x0\\xb0\\x0\\xa8\\x0\\xb7\\x0\\xb9\\x0\\xb3\\x0\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\xc0\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x40\\x1\\x0\\x2\\x40\\x2\\x80\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\xad\\xbd\\x9c\\xcf\\xbe\\xdd\\xf5\\xf9\\xb8\\xa6\\xae\\xaa\\xf0\\xa9\\xee\\xf8\\xf1\\xfd\\xfc\\xef\\xe6\\xf4\\xfa\\xf7\\xfb\\xa7\\xaf\\xac\\xab\\xf3\\xa8\\xb7\\xb5\\xb6\\xc7\\x8e\\x8f\\x92\\x80\\xd4\\x90\\xd2\\xd3\\xde\\xd6\\xd7\\xd8\\xd1\\xa5\\xe3\\xe0\\xe2\\xe5\\x99\\x9e\\x9d\\xeb\\xe9\\xea\\x9a\\xed\\xe8\\xe1\\x85\\xa0\\x83\\xc6\\x84\\x86\\x91\\x87\\x8a\\x82\\x88\\x89\\x8d\\xa1\\x8c\\x8b\\xd0\\xa4\\x95\\xa2\\x93\\xe4\\x94\\xf6\\x9b\\x97\\xa3\\x96\\x81\\xec\\xe7\\x98\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xd5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\x0\\x0\\xc9\\x0\\x0\\xbb\\x0\\x0\\xc8\\x0\\x0\\xbc\\x0\\x0\\xcc\\x0\\x0\\xb9\\x0\\x0\\xcb\\x0\\x0\\xca\\x0\\x0\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (852, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xe4\\x0\\x6f\\x1\\x7\\x1\\xe7\\x0\\x42\\x1\\xeb\\x0\\x50\\x1\\x51\\x1\\xee\\x0\\x79\\x1\\xc4\\x0\\x6\\x1\\xc9\\x0\\x39\\x1\\x3a\\x1\\xf4\\x0\\xf6\\x0\\x3d\\x1\\x3e\\x1\\x5a\\x1\\x5b\\x1\\xd6\\x0\\xdc\\x0\\x64\\x1\\x65\\x1\\x41\\x1\\xd7\\x0\\xd\\x1\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\x4\\x1\\x5\\x1\\x7d\\x1\\x7e\\x1\\x18\\x1\\x19\\x1\\xac\\x0\\x7a\\x1\\xc\\x1\\x5f\\x1\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\xc1\\x0\\xc2\\x0\\x1a\\x1\\x5e\\x1\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x7b\\x1\\x7c\\x1\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x2\\x1\\x3\\x1\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\xa4\\x0\\x11\\x1\\x10\\x1\\xe\\x1\\xcb\\x0\\xf\\x1\\x47\\x1\\xcd\\x0\\xce\\x0\\x1b\\x1\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x62\\x1\\x6e\\x1\\x80\\x25\\xd3\\x0\\xdf\\x0\\xd4\\x0\\x43\\x1\\x44\\x1\\x48\\x1\\x60\\x1\\x61\\x1\\x54\\x1\\xda\\x0\\x55\\x1\\x70\\x1\\xfd\\x0\\xdd\\x0\\x63\\x1\\xb4\\x0\\xad\\x0\\xdd\\x2\\xdb\\x2\\xc7\\x2\\xd8\\x2\\xa7\\x0\\xf7\\x0\\xb8\\x0\\xb0\\x0\\xa8\\x0\\xd9\\x2\\x71\\x1\\x58\\x1\\x59\\x1\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\xc0\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x0\\x2\\x40\\x2\\x80\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x0\\x0\\xcf\\x0\\x0\\xf5\\xf9\\x0\\x0\\xae\\xaa\\xf0\\x0\\x0\\xf8\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\xf7\\x0\\x0\\xaf\\x0\\x0\\x0\\x0\\x0\\xb5\\xb6\\x0\\x8e\\x0\\x0\\x80\\x0\\x90\\x0\\xd3\\x0\\xd6\\xd7\\x0\\x0\\x0\\x0\\xe0\\xe2\\x0\\x99\\x9e\\x0\\x0\\xe9\\x0\\x9a\\xed\\x0\\xe1\\x0\\xa0\\x83\\x0\\x84\\x0\\x0\\x87\\x0\\x82\\x0\\x89\\x0\\xa1\\x8c\\x0\\x0\\x0\\x0\\xa2\\x93\\x0\\x94\\xf6\\x0\\x0\\xa3\\x0\\x81\\xec\\x0\\x0\\x0\\x0\\xc6\\xc7\\xa4\\xa5\\x8f\\x86\\x0\\x0\\x0\\x0\\xac\\x9f\\xd2\\xd4\\xd1\\xd0\\x0\\x0\\x0\\x0\\x0\\x0\\xa8\\xa9\\xb7\\xd8\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x91\\x92\\x0\\x0\\x95\\x96\\x0\\x0\\x9d\\x88\\xe3\\xe4\\x0\\x0\\xd5\\xe5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8a\\x8b\\x0\\x0\\xe8\\xea\\x0\\x0\\xfc\\xfd\\x97\\x98\\x0\\x0\\xb8\\xad\\xe6\\xe7\\xdd\\xee\\x9b\\x9c\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xde\\x85\\xeb\\xfb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8d\\xab\\xbd\\xbe\\xa6\\xa7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf4\\xfa\\x0\\xf2\\x0\\xf1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\x0\\x0\\xc9\\x0\\x0\\xbb\\x0\\x0\\xc8\\x0\\x0\\xbc\\x0\\x0\\xcc\\x0\\x0\\xb9\\x0\\x0\\xcb\\x0\\x0\\xca\\x0\\x0\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (855, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\x52\\x4\\x2\\x4\\x53\\x4\\x3\\x4\\x51\\x4\\x1\\x4\\x54\\x4\\x4\\x4\\x55\\x4\\x5\\x4\\x56\\x4\\x6\\x4\\x57\\x4\\x7\\x4\\x58\\x4\\x8\\x4\\x59\\x4\\x9\\x4\\x5a\\x4\\xa\\x4\\x5b\\x4\\xb\\x4\\x5c\\x4\\xc\\x4\\x5e\\x4\\xe\\x4\\x5f\\x4\\xf\\x4\\x4e\\x4\\x2e\\x4\\x4a\\x4\\x2a\\x4\\x30\\x4\\x10\\x4\\x31\\x4\\x11\\x4\\x46\\x4\\x26\\x4\\x34\\x4\\x14\\x4\\x35\\x4\\x15\\x4\\x44\\x4\\x24\\x4\\x33\\x4\\x13\\x4\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x45\\x4\\x25\\x4\\x38\\x4\\x18\\x4\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x39\\x4\\x19\\x4\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x3a\\x4\\x1a\\x4\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\xa4\\x0\\x3b\\x4\\x1b\\x4\\x3c\\x4\\x1c\\x4\\x3d\\x4\\x1d\\x4\\x3e\\x4\\x1e\\x4\\x3f\\x4\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x1f\\x4\\x4f\\x4\\x80\\x25\\x2f\\x4\\x40\\x4\\x20\\x4\\x41\\x4\\x21\\x4\\x42\\x4\\x22\\x4\\x43\\x4\\x23\\x4\\x36\\x4\\x16\\x4\\x32\\x4\\x12\\x4\\x4c\\x4\\x2c\\x4\\x16\\x21\\xad\\x0\\x4b\\x4\\x2b\\x4\\x37\\x4\\x17\\x4\\x48\\x4\\x28\\x4\\x4d\\x4\\x2d\\x4\\x49\\x4\\x29\\x4\\x47\\x4\\x27\\x4\\xa7\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x80\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x1\\x0\\x2\\x40\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x0\\x0\\xcf\\x0\\x0\\xfd\\x0\\x0\\x0\\xae\\x0\\xf0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xaf\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x85\\x81\\x83\\x87\\x89\\x8b\\x8d\\x8f\\x91\\x93\\x95\\x97\\x0\\x99\\x9b\\xa1\\xa3\\xec\\xad\\xa7\\xa9\\xea\\xf4\\xb8\\xbe\\xc7\\xd1\\xd3\\xd5\\xd7\\xdd\\xe2\\xe4\\xe6\\xe8\\xab\\xb6\\xa5\\xfc\\xf6\\xfa\\x9f\\xf2\\xee\\xf8\\x9d\\xe0\\xa0\\xa2\\xeb\\xac\\xa6\\xa8\\xe9\\xf3\\xb7\\xbd\\xc6\\xd0\\xd2\\xd4\\xd6\\xd8\\xe1\\xe3\\xe5\\xe7\\xaa\\xb5\\xa4\\xfb\\xf5\\xf9\\x9e\\xf1\\xed\\xf7\\x9c\\xde\\x0\\x84\\x80\\x82\\x86\\x88\\x8a\\x8c\\x8e\\x90\\x92\\x94\\x96\\x0\\x98\\x9a\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\x0\\x0\\xc9\\x0\\x0\\xbb\\x0\\x0\\xc8\\x0\\x0\\xbc\\x0\\x0\\xcc\\x0\\x0\\xb9\\x0\\x0\\xcb\\x0\\x0\\xca\\x0\\x0\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (857, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe5\\x0\\xe7\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xef\\x0\\xee\\x0\\x31\\x1\\xc4\\x0\\xc5\\x0\\xc9\\x0\\xe6\\x0\\xc6\\x0\\xf4\\x0\\xf6\\x0\\xf2\\x0\\xfb\\x0\\xf9\\x0\\x30\\x1\\xd6\\x0\\xdc\\x0\\xf8\\x0\\xa3\\x0\\xd8\\x0\\x5e\\x1\\x5f\\x1\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\xf1\\x0\\xd1\\x0\\x1e\\x1\\x1f\\x1\\xbf\\x0\\xae\\x0\\xac\\x0\\xbd\\x0\\xbc\\x0\\xa1\\x0\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\xc1\\x0\\xc2\\x0\\xc0\\x0\\xa9\\x0\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\xa2\\x0\\xa5\\x0\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\xe3\\x0\\xc3\\x0\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\xa4\\x0\\xba\\x0\\xaa\\x0\\xca\\x0\\xcb\\x0\\xc8\\x0\\x0\\x0\\xcd\\x0\\xce\\x0\\xcf\\x0\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\xa6\\x0\\xcc\\x0\\x80\\x25\\xd3\\x0\\xdf\\x0\\xd4\\x0\\xd2\\x0\\xf5\\x0\\xd5\\x0\\xb5\\x0\\x0\\x0\\xd7\\x0\\xda\\x0\\xdb\\x0\\xd9\\x0\\xec\\x0\\xff\\x0\\xaf\\x0\\xb4\\x0\\xad\\x0\\xb1\\x0\\x0\\x0\\xbe\\x0\\xb6\\x0\\xa7\\x0\\xf7\\x0\\xb8\\x0\\xb0\\x0\\xa8\\x0\\xb7\\x0\\xb9\\x0\\xb3\\x0\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\x80\\x1\\xc0\\x1\\x0\\x2\\x40\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\xad\\xbd\\x9c\\xcf\\xbe\\xdd\\xf5\\xf9\\xb8\\xd1\\xae\\xaa\\xf0\\xa9\\xee\\xf8\\xf1\\xfd\\xfc\\xef\\xe6\\xf4\\xfa\\xf7\\xfb\\xd0\\xaf\\xac\\xab\\xf3\\xa8\\xb7\\xb5\\xb6\\xc7\\x8e\\x8f\\x92\\x80\\xd4\\x90\\xd2\\xd3\\xde\\xd6\\xd7\\xd8\\x0\\xa5\\xe3\\xe0\\xe2\\xe5\\x99\\xe8\\x9d\\xeb\\xe9\\xea\\x9a\\x0\\x0\\xe1\\x85\\xa0\\x83\\xc6\\x84\\x86\\x91\\x87\\x8a\\x82\\x88\\x89\\xec\\xa1\\x8c\\x8b\\x0\\xa4\\x95\\xa2\\x93\\xe4\\x94\\xf6\\x9b\\x97\\xa3\\x96\\x81\\x0\\x0\\xed\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa6\\xa7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x98\\x8d\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9e\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\x0\\x0\\xc9\\x0\\x0\\xbb\\x0\\x0\\xc8\\x0\\x0\\xbc\\x0\\x0\\xcc\\x0\\x0\\xb9\\x0\\x0\\xcb\\x0\\x0\\xca\\x0\\x0\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (860, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xe3\\x0\\xe0\\x0\\xc1\\x0\\xe7\\x0\\xea\\x0\\xca\\x0\\xe8\\x0\\xcd\\x0\\xd4\\x0\\xec\\x0\\xc3\\x0\\xc2\\x0\\xc9\\x0\\xc0\\x0\\xc8\\x0\\xf4\\x0\\xf5\\x0\\xf2\\x0\\xda\\x0\\xf9\\x0\\xcc\\x0\\xd5\\x0\\xdc\\x0\\xa2\\x0\\xa3\\x0\\xd9\\x0\\xa7\\x20\\xd3\\x0\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\xf1\\x0\\xd1\\x0\\xaa\\x0\\xba\\x0\\xbf\\x0\\xd2\\x0\\xac\\x0\\xbd\\x0\\xbc\\x0\\xa1\\x0\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xb1\\x3\\xdf\\x0\\x93\\x3\\xc0\\x3\\xa3\\x3\\xc3\\x3\\xb5\\x0\\xc4\\x3\\xa6\\x3\\x98\\x3\\xa9\\x3\\xb4\\x3\\x1e\\x22\\xc6\\x3\\xb5\\x3\\x29\\x22\\x61\\x22\\xb1\\x0\\x65\\x22\\x64\\x22\\x20\\x23\\x21\\x23\\xf7\\x0\\x48\\x22\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x7f\\x20\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x1\\x80\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x1\\x0\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x2\\x80\\x2\\x0\\x1\\x0\\x1\\xc0\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x3\\x40\\x3\\x80\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\xad\\x9b\\x9c\\x0\\x0\\x0\\x0\\x0\\x0\\xa6\\xae\\xaa\\x0\\x0\\x0\\xf8\\xf1\\xfd\\x0\\x0\\xe6\\x0\\xfa\\x0\\x0\\xa7\\xaf\\xac\\xab\\x0\\xa8\\x91\\x86\\x8f\\x8e\\x0\\x0\\x0\\x80\\x92\\x90\\x89\\x0\\x98\\x8b\\x0\\x0\\x0\\xa5\\xa9\\x9f\\x8c\\x99\\x0\\x0\\x0\\x9d\\x96\\x0\\x9a\\x0\\x0\\xe1\\x85\\xa0\\x83\\x84\\x0\\x0\\x0\\x87\\x8a\\x82\\x88\\x0\\x8d\\xa1\\x0\\x0\\x0\\xa4\\x95\\xa2\\x93\\x94\\x0\\xf6\\x0\\x97\\xa3\\x0\\x81\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe2\\x0\\x0\\x0\\x0\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe4\\x0\\x0\\xe8\\x0\\x0\\xea\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\x0\\xeb\\xee\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe3\\x0\\x0\\xe5\\xe7\\x0\\xed\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xf3\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf4\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (861, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe5\\x0\\xe7\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xd0\\x0\\xf0\\x0\\xde\\x0\\xc4\\x0\\xc5\\x0\\xc9\\x0\\xe6\\x0\\xc6\\x0\\xf4\\x0\\xf6\\x0\\xfe\\x0\\xfb\\x0\\xdd\\x0\\xfd\\x0\\xd6\\x0\\xdc\\x0\\xf8\\x0\\xa3\\x0\\xd8\\x0\\xa7\\x20\\x92\\x1\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\xc1\\x0\\xcd\\x0\\xd3\\x0\\xda\\x0\\xbf\\x0\\x10\\x23\\xac\\x0\\xbd\\x0\\xbc\\x0\\xa1\\x0\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xb1\\x3\\xdf\\x0\\x93\\x3\\xc0\\x3\\xa3\\x3\\xc3\\x3\\xb5\\x0\\xc4\\x3\\xa6\\x3\\x98\\x3\\xa9\\x3\\xb4\\x3\\x1e\\x22\\xc6\\x3\\xb5\\x3\\x29\\x22\\x61\\x22\\xb1\\x0\\x65\\x22\\x64\\x22\\x20\\x23\\x21\\x23\\xf7\\x0\\x48\\x22\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x7f\\x20\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x40\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x40\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x2\\xc0\\x2\\x0\\x1\\x0\\x1\\x0\\x3\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x3\\x80\\x3\\xc0\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\xad\\x0\\x9c\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xae\\xaa\\x0\\x0\\x0\\xf8\\xf1\\xfd\\x0\\x0\\xe6\\x0\\xfa\\x0\\x0\\x0\\xaf\\xac\\xab\\x0\\xa8\\x0\\xa4\\x0\\x0\\x8e\\x8f\\x92\\x80\\x0\\x90\\x0\\x0\\x0\\xa5\\x0\\x0\\x8b\\x0\\x0\\xa6\\x0\\x0\\x99\\x0\\x9d\\x0\\xa7\\x0\\x9a\\x97\\x8d\\xe1\\x85\\xa0\\x83\\x0\\x84\\x86\\x91\\x87\\x8a\\x82\\x88\\x89\\x0\\xa1\\x0\\x0\\x8c\\x0\\x0\\xa2\\x93\\x0\\x94\\xf6\\x9b\\x0\\xa3\\x96\\x81\\x98\\x95\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe2\\x0\\x0\\x0\\x0\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe4\\x0\\x0\\xe8\\x0\\x0\\xea\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\x0\\xeb\\xee\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe3\\x0\\x0\\xe5\\xe7\\x0\\xed\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xf3\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf4\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (862, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xd0\\x5\\xd1\\x5\\xd2\\x5\\xd3\\x5\\xd4\\x5\\xd5\\x5\\xd6\\x5\\xd7\\x5\\xd8\\x5\\xd9\\x5\\xda\\x5\\xdb\\x5\\xdc\\x5\\xdd\\x5\\xde\\x5\\xdf\\x5\\xe0\\x5\\xe1\\x5\\xe2\\x5\\xe3\\x5\\xe4\\x5\\xe5\\x5\\xe6\\x5\\xe7\\x5\\xe8\\x5\\xe9\\x5\\xea\\x5\\xa2\\x0\\xa3\\x0\\xa5\\x0\\xa7\\x20\\x92\\x1\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\xf1\\x0\\xd1\\x0\\xaa\\x0\\xba\\x0\\xbf\\x0\\x10\\x23\\xac\\x0\\xbd\\x0\\xbc\\x0\\xa1\\x0\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xb1\\x3\\xdf\\x0\\x93\\x3\\xc0\\x3\\xa3\\x3\\xc3\\x3\\xb5\\x0\\xc4\\x3\\xa6\\x3\\x98\\x3\\xa9\\x3\\xb4\\x3\\x1e\\x22\\xc6\\x3\\xb5\\x3\\x29\\x22\\x61\\x22\\xb1\\x0\\x65\\x22\\x64\\x22\\x20\\x23\\x21\\x23\\xf7\\x0\\x48\\x22\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x7f\\x20\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x40\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x2\\x80\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x2\\x0\\x3\\x0\\x1\\x0\\x1\\x40\\x3\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x3\\xc0\\x3\\x0\\x4\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\xad\\x9b\\x9c\\x0\\x9d\\x0\\x0\\x0\\x0\\xa6\\xae\\xaa\\x0\\x0\\x0\\xf8\\xf1\\xfd\\x0\\x0\\xe6\\x0\\xfa\\x0\\x0\\xa7\\xaf\\xac\\xab\\x0\\xa8\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe1\\x0\\xa0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa1\\x0\\x0\\x0\\xa4\\x0\\xa2\\x0\\x0\\x0\\xf6\\x0\\x0\\xa3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe2\\x0\\x0\\x0\\x0\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe4\\x0\\x0\\xe8\\x0\\x0\\xea\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\x0\\xeb\\xee\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe3\\x0\\x0\\xe5\\xe7\\x0\\xed\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x8a\\x8b\\x8c\\x8d\\x8e\\x8f\\x90\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\x9a\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xf3\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf4\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (863, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xc2\\x0\\xe0\\x0\\xb6\\x0\\xe7\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xef\\x0\\xee\\x0\\x17\\x20\\xc0\\x0\\xa7\\x0\\xc9\\x0\\xc8\\x0\\xca\\x0\\xf4\\x0\\xcb\\x0\\xcf\\x0\\xfb\\x0\\xf9\\x0\\xa4\\x0\\xd4\\x0\\xdc\\x0\\xa2\\x0\\xa3\\x0\\xd9\\x0\\xdb\\x0\\x92\\x1\\xa6\\x0\\xb4\\x0\\xf3\\x0\\xfa\\x0\\xa8\\x0\\xb8\\x0\\xb3\\x0\\xaf\\x0\\xce\\x0\\x10\\x23\\xac\\x0\\xbd\\x0\\xbc\\x0\\xbe\\x0\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xb1\\x3\\xdf\\x0\\x93\\x3\\xc0\\x3\\xa3\\x3\\xc3\\x3\\xb5\\x0\\xc4\\x3\\xa6\\x3\\x98\\x3\\xa9\\x3\\xb4\\x3\\x1e\\x22\\xc6\\x3\\xb5\\x3\\x29\\x22\\x61\\x22\\xb1\\x0\\x65\\x22\\x64\\x22\\x20\\x23\\x21\\x23\\xf7\\x0\\x48\\x22\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x7f\\x20\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x40\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x40\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x2\\xc0\\x2\\x0\\x1\\x0\\x1\\x0\\x3\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x3\\x80\\x3\\xc0\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x9b\\x9c\\x98\\x0\\xa0\\x8f\\xa4\\x0\\x0\\xae\\xaa\\x0\\x0\\xa7\\xf8\\xf1\\xfd\\xa6\\xa1\\xe6\\x86\\xfa\\xa5\\x0\\x0\\xaf\\xac\\xab\\xad\\x0\\x8e\\x0\\x84\\x0\\x0\\x0\\x0\\x80\\x91\\x90\\x92\\x94\\x0\\x0\\xa8\\x95\\x0\\x0\\x0\\x0\\x99\\x0\\x0\\x0\\x0\\x9d\\x0\\x9e\\x9a\\x0\\x0\\xe1\\x85\\x0\\x83\\x0\\x0\\x0\\x0\\x87\\x8a\\x82\\x88\\x89\\x0\\x0\\x8c\\x8b\\x0\\x0\\x0\\xa2\\x93\\x0\\x0\\xf6\\x0\\x97\\xa3\\x96\\x81\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe2\\x0\\x0\\x0\\x0\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe4\\x0\\x0\\xe8\\x0\\x0\\xea\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\x0\\xeb\\xee\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe3\\x0\\x0\\xe5\\xe7\\x0\\xed\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8d\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xf3\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf4\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (864, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x6a\\x6\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xb0\\x0\\xb7\\x0\\x19\\x22\\x1a\\x22\\x92\\x25\\x0\\x25\\x2\\x25\\x3c\\x25\\x24\\x25\\x2c\\x25\\x1c\\x25\\x34\\x25\\x10\\x25\\xc\\x25\\x14\\x25\\x18\\x25\\xb2\\x3\\x1e\\x22\\xc6\\x3\\xb1\\x0\\xbd\\x0\\xbc\\x0\\x48\\x22\\xab\\x0\\xbb\\x0\\xf7\\xfe\\xf8\\xfe\\x0\\x0\\x0\\x0\\xfb\\xfe\\xfc\\xfe\\x0\\x0\\xa0\\x0\\xad\\x0\\x82\\xfe\\xa3\\x0\\xa4\\x0\\x84\\xfe\\x0\\x0\\x0\\x0\\x8e\\xfe\\x8f\\xfe\\x95\\xfe\\x99\\xfe\\xc\\x6\\x9d\\xfe\\xa1\\xfe\\xa5\\xfe\\x60\\x6\\x61\\x6\\x62\\x6\\x63\\x6\\x64\\x6\\x65\\x6\\x66\\x6\\x67\\x6\\x68\\x6\\x69\\x6\\xd1\\xfe\\x1b\\x6\\xb1\\xfe\\xb5\\xfe\\xb9\\xfe\\x1f\\x6\\xa2\\x0\\x80\\xfe\\x81\\xfe\\x83\\xfe\\x85\\xfe\\xca\\xfe\\x8b\\xfe\\x8d\\xfe\\x91\\xfe\\x93\\xfe\\x97\\xfe\\x9b\\xfe\\x9f\\xfe\\xa3\\xfe\\xa7\\xfe\\xa9\\xfe\\xab\\xfe\\xad\\xfe\\xaf\\xfe\\xb3\\xfe\\xb7\\xfe\\xbb\\xfe\\xbf\\xfe\\xc1\\xfe\\xc5\\xfe\\xcb\\xfe\\xcf\\xfe\\xa6\\x0\\xac\\x0\\xf7\\x0\\xd7\\x0\\xc9\\xfe\\x40\\x6\\xd3\\xfe\\xd7\\xfe\\xdb\\xfe\\xdf\\xfe\\xe3\\xfe\\xe7\\xfe\\xeb\\xfe\\xed\\xfe\\xef\\xfe\\xf3\\xfe\\xbd\\xfe\\xcc\\xfe\\xce\\xfe\\xcd\\xfe\\xe1\\xfe\\x7d\\xfe\\x51\\x6\\xe5\\xfe\\xe9\\xfe\\xec\\xfe\\xf0\\xfe\\xf2\\xfe\\xd0\\xfe\\xd5\\xfe\\xf5\\xfe\\xf6\\xfe\\xdd\\xfe\\xd9\\xfe\\xf1\\xfe\\xa0\\x25\\x0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x1\\x80\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x1\\x0\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x2\\x80\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\xc0\\x2\\x0\\x1\\x0\\x3\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x3\\x80\\x3\\xc0\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x0\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\xc0\\xa3\\xa4\\x0\\xdb\\x0\\x0\\x0\\x0\\x97\\xdc\\xa1\\x0\\x0\\x80\\x93\\x0\\x0\\x0\\x0\\x0\\x81\\x0\\x0\\x0\\x98\\x95\\x94\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xde\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x90\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x92\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xac\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xbb\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\x25\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x82\\x83\\x0\\x0\\x0\\x91\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x85\\x0\\x86\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8d\\x0\\x0\\x0\\x8c\\x0\\x0\\x0\\x8e\\x0\\x0\\x0\\x8f\\x0\\x0\\x0\\x8a\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x89\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8b\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x87\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x84\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xc1\\xc2\\xa2\\xc3\\xa5\\xc4\\x0\\x0\\x0\\x0\\x0\\xc6\\x0\\xc7\\xa8\\xa9\\x0\\xc8\\x0\\xc9\\x0\\xaa\\x0\\xca\\x0\\xab\\x0\\xcb\\x0\\xad\\x0\\xcc\\x0\\xae\\x0\\xcd\\x0\\xaf\\x0\\xce\\x0\\xcf\\x0\\xd0\\x0\\xd1\\x0\\xd2\\x0\\xbc\\x0\\xd3\\x0\\xbd\\x0\\xd4\\x0\\xbe\\x0\\xd5\\x0\\xeb\\x0\\xd6\\x0\\xd7\\x0\\x0\\x0\\xd8\\x0\\x0\\x0\\xdf\\xc5\\xd9\\xec\\xee\\xed\\xda\\xf7\\xba\\x0\\xe1\\x0\\xf8\\x0\\xe2\\x0\\xfc\\x0\\xe3\\x0\\xfb\\x0\\xe4\\x0\\xef\\x0\\xe5\\x0\\xf2\\x0\\xe6\\x0\\xf3\\x0\\xe7\\xf4\\xe8\\x0\\xe9\\xf5\\xfd\\xf6\\xea\\x0\\xf9\\xfa\\x99\\x9a\\x0\\x0\\x9d\\x9e\"#\n        , encoderMax = '\\65276'\n        }\n\n   }\n    )\n\n    ,\n    (865, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xc7\\x0\\xfc\\x0\\xe9\\x0\\xe2\\x0\\xe4\\x0\\xe0\\x0\\xe5\\x0\\xe7\\x0\\xea\\x0\\xeb\\x0\\xe8\\x0\\xef\\x0\\xee\\x0\\xec\\x0\\xc4\\x0\\xc5\\x0\\xc9\\x0\\xe6\\x0\\xc6\\x0\\xf4\\x0\\xf6\\x0\\xf2\\x0\\xfb\\x0\\xf9\\x0\\xff\\x0\\xd6\\x0\\xdc\\x0\\xf8\\x0\\xa3\\x0\\xd8\\x0\\xa7\\x20\\x92\\x1\\xe1\\x0\\xed\\x0\\xf3\\x0\\xfa\\x0\\xf1\\x0\\xd1\\x0\\xaa\\x0\\xba\\x0\\xbf\\x0\\x10\\x23\\xac\\x0\\xbd\\x0\\xbc\\x0\\xa1\\x0\\xab\\x0\\xa4\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\xb1\\x3\\xdf\\x0\\x93\\x3\\xc0\\x3\\xa3\\x3\\xc3\\x3\\xb5\\x0\\xc4\\x3\\xa6\\x3\\x98\\x3\\xa9\\x3\\xb4\\x3\\x1e\\x22\\xc6\\x3\\xb5\\x3\\x29\\x22\\x61\\x22\\xb1\\x0\\x65\\x22\\x64\\x22\\x20\\x23\\x21\\x23\\xf7\\x0\\x48\\x22\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x7f\\x20\\xb2\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\x0\\x1\\x0\\x1\\x40\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x1\\xc0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x2\\x40\\x2\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x80\\x2\\xc0\\x2\\x0\\x1\\x0\\x1\\x0\\x3\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x0\\x1\\x40\\x3\\x80\\x3\\xc0\\x3\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\xad\\x0\\x9c\\xaf\\x0\\x0\\x0\\x0\\x0\\xa6\\xae\\xaa\\x0\\x0\\x0\\xf8\\xf1\\xfd\\x0\\x0\\xe6\\x0\\xfa\\x0\\x0\\xa7\\x0\\xac\\xab\\x0\\xa8\\x0\\x0\\x0\\x0\\x8e\\x8f\\x92\\x80\\x0\\x90\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa5\\x0\\x0\\x0\\x0\\x99\\x0\\x9d\\x0\\x0\\x0\\x9a\\x0\\x0\\xe1\\x85\\xa0\\x83\\x0\\x84\\x86\\x91\\x87\\x8a\\x82\\x88\\x89\\x8d\\xa1\\x8c\\x8b\\x0\\xa4\\x95\\xa2\\x93\\x0\\x94\\xf6\\x9b\\x97\\xa3\\x96\\x81\\x0\\x0\\x98\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe2\\x0\\x0\\x0\\x0\\xe9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe4\\x0\\x0\\xe8\\x0\\x0\\xea\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe0\\x0\\x0\\xeb\\xee\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xe3\\x0\\x0\\xe5\\xe7\\x0\\xed\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x9e\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\xec\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xf3\\xf2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf4\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (866, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\x10\\x4\\x11\\x4\\x12\\x4\\x13\\x4\\x14\\x4\\x15\\x4\\x16\\x4\\x17\\x4\\x18\\x4\\x19\\x4\\x1a\\x4\\x1b\\x4\\x1c\\x4\\x1d\\x4\\x1e\\x4\\x1f\\x4\\x20\\x4\\x21\\x4\\x22\\x4\\x23\\x4\\x24\\x4\\x25\\x4\\x26\\x4\\x27\\x4\\x28\\x4\\x29\\x4\\x2a\\x4\\x2b\\x4\\x2c\\x4\\x2d\\x4\\x2e\\x4\\x2f\\x4\\x30\\x4\\x31\\x4\\x32\\x4\\x33\\x4\\x34\\x4\\x35\\x4\\x36\\x4\\x37\\x4\\x38\\x4\\x39\\x4\\x3a\\x4\\x3b\\x4\\x3c\\x4\\x3d\\x4\\x3e\\x4\\x3f\\x4\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x61\\x25\\x62\\x25\\x56\\x25\\x55\\x25\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x5c\\x25\\x5b\\x25\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\x5e\\x25\\x5f\\x25\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\x67\\x25\\x68\\x25\\x64\\x25\\x65\\x25\\x59\\x25\\x58\\x25\\x52\\x25\\x53\\x25\\x6b\\x25\\x6a\\x25\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\x8c\\x25\\x90\\x25\\x80\\x25\\x40\\x4\\x41\\x4\\x42\\x4\\x43\\x4\\x44\\x4\\x45\\x4\\x46\\x4\\x47\\x4\\x48\\x4\\x49\\x4\\x4a\\x4\\x4b\\x4\\x4c\\x4\\x4d\\x4\\x4e\\x4\\x4f\\x4\\x1\\x4\\x51\\x4\\x4\\x4\\x54\\x4\\x7\\x4\\x57\\x4\\xe\\x4\\x5e\\x4\\xb0\\x0\\x19\\x22\\xb7\\x0\\x1a\\x22\\x16\\x21\\xa4\\x0\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x80\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x2\\x40\\x2\\x80\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x0\\x0\\xfd\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf8\\x0\\x0\\x0\\x0\\x0\\x0\\xfa\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf0\\x0\\x0\\xf2\\x0\\x0\\xf4\\x0\\x0\\x0\\x0\\x0\\x0\\xf6\\x0\\x80\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x8a\\x8b\\x8c\\x8d\\x8e\\x8f\\x90\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\x9a\\x9b\\x9c\\x9d\\x9e\\x9f\\xa0\\xa1\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xaa\\xab\\xac\\xad\\xae\\xaf\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef\\x0\\xf1\\x0\\x0\\xf3\\x0\\x0\\xf5\\x0\\x0\\x0\\x0\\x0\\x0\\xf7\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfc\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xf9\\xfb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\xd5\\xd6\\xc9\\xb8\\xb7\\xbb\\xd4\\xd3\\xc8\\xbe\\xbd\\xbc\\xc6\\xc7\\xcc\\xb5\\xb6\\xb9\\xd1\\xd2\\xcb\\xcf\\xd0\\xca\\xd8\\xd7\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\xdd\\x0\\x0\\x0\\xde\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (869, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x86\\x3\\x0\\x0\\xb7\\x0\\xac\\x0\\xa6\\x0\\x18\\x20\\x19\\x20\\x88\\x3\\x15\\x20\\x89\\x3\\x8a\\x3\\xaa\\x3\\x8c\\x3\\x0\\x0\\x0\\x0\\x8e\\x3\\xab\\x3\\xa9\\x0\\x8f\\x3\\xb2\\x0\\xb3\\x0\\xac\\x3\\xa3\\x0\\xad\\x3\\xae\\x3\\xaf\\x3\\xca\\x3\\x90\\x3\\xcc\\x3\\xcd\\x3\\x91\\x3\\x92\\x3\\x93\\x3\\x94\\x3\\x95\\x3\\x96\\x3\\x97\\x3\\xbd\\x0\\x98\\x3\\x99\\x3\\xab\\x0\\xbb\\x0\\x91\\x25\\x92\\x25\\x93\\x25\\x2\\x25\\x24\\x25\\x9a\\x3\\x9b\\x3\\x9c\\x3\\x9d\\x3\\x63\\x25\\x51\\x25\\x57\\x25\\x5d\\x25\\x9e\\x3\\x9f\\x3\\x10\\x25\\x14\\x25\\x34\\x25\\x2c\\x25\\x1c\\x25\\x0\\x25\\x3c\\x25\\xa0\\x3\\xa1\\x3\\x5a\\x25\\x54\\x25\\x69\\x25\\x66\\x25\\x60\\x25\\x50\\x25\\x6c\\x25\\xa3\\x3\\xa4\\x3\\xa5\\x3\\xa6\\x3\\xa7\\x3\\xa8\\x3\\xa9\\x3\\xb1\\x3\\xb2\\x3\\xb3\\x3\\x18\\x25\\xc\\x25\\x88\\x25\\x84\\x25\\xb4\\x3\\xb5\\x3\\x80\\x25\\xb6\\x3\\xb7\\x3\\xb8\\x3\\xb9\\x3\\xba\\x3\\xbb\\x3\\xbc\\x3\\xbd\\x3\\xbe\\x3\\xbf\\x3\\xc0\\x3\\xc1\\x3\\xc3\\x3\\xc2\\x3\\xc4\\x3\\x84\\x3\\xad\\x0\\xb1\\x0\\xc5\\x3\\xc6\\x3\\xc7\\x3\\xa7\\x0\\xc8\\x3\\x85\\x3\\xb0\\x0\\xa8\\x0\\xc9\\x3\\xcb\\x3\\xb0\\x3\\xce\\x3\\xa0\\x25\\xa0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x80\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x1\\x0\\x2\\x40\\x2\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xff\\x0\\x0\\x9c\\x0\\x0\\x8a\\xf5\\xf9\\x97\\x0\\xae\\x89\\xf0\\x0\\x0\\xf8\\xf1\\x99\\x9a\\x0\\x0\\x0\\x88\\x0\\x0\\x0\\xaf\\x0\\xab\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xef\\xf7\\x86\\x0\\x8d\\x8f\\x90\\x0\\x92\\x0\\x95\\x98\\xa1\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xaa\\xac\\xad\\xb5\\xb6\\xb7\\xb8\\xbd\\xbe\\xc6\\xc7\\x0\\xcf\\xd0\\xd1\\xd2\\xd3\\xd4\\xd5\\x91\\x96\\x9b\\x9d\\x9e\\x9f\\xfc\\xd6\\xd7\\xd8\\xdd\\xde\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xed\\xec\\xee\\xf2\\xf3\\xf4\\xf6\\xfa\\xa0\\xfb\\xa2\\xa3\\xfd\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x8e\\x0\\x0\\x8b\\x8c\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc4\\x0\\xb3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xda\\x0\\x0\\x0\\xbf\\x0\\x0\\x0\\xc0\\x0\\x0\\x0\\xd9\\x0\\x0\\x0\\xc3\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb4\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc1\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xc5\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcd\\xba\\x0\\x0\\xc9\\x0\\x0\\xbb\\x0\\x0\\xc8\\x0\\x0\\xbc\\x0\\x0\\xcc\\x0\\x0\\xb9\\x0\\x0\\xcb\\x0\\x0\\xca\\x0\\x0\\xce\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xdf\\x0\\x0\\x0\\xdc\\x0\\x0\\x0\\xdb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xb0\\xb1\\xb2\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\"#\n        , encoderMax = '\\9632'\n        }\n\n   }\n    )\n\n    ,\n    (874, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x4\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x8\\x0\\x9\\x0\\xa\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x14\\x0\\x15\\x0\\x16\\x0\\x17\\x0\\x18\\x0\\x19\\x0\\x1a\\x0\\x1b\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x20\\x0\\x21\\x0\\x22\\x0\\x23\\x0\\x24\\x0\\x25\\x0\\x26\\x0\\x27\\x0\\x28\\x0\\x29\\x0\\x2a\\x0\\x2b\\x0\\x2c\\x0\\x2d\\x0\\x2e\\x0\\x2f\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\x3a\\x0\\x3b\\x0\\x3c\\x0\\x3d\\x0\\x3e\\x0\\x3f\\x0\\x40\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\x5b\\x0\\x5c\\x0\\x5d\\x0\\x5e\\x0\\x5f\\x0\\x60\\x0\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\x7b\\x0\\x7c\\x0\\x7d\\x0\\x7e\\x0\\x7f\\x0\\xac\\x20\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x26\\x20\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x18\\x20\\x19\\x20\\x1c\\x20\\x1d\\x20\\x22\\x20\\x13\\x20\\x14\\x20\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\x1\\xe\\x2\\xe\\x3\\xe\\x4\\xe\\x5\\xe\\x6\\xe\\x7\\xe\\x8\\xe\\x9\\xe\\xa\\xe\\xb\\xe\\xc\\xe\\xd\\xe\\xe\\xe\\xf\\xe\\x10\\xe\\x11\\xe\\x12\\xe\\x13\\xe\\x14\\xe\\x15\\xe\\x16\\xe\\x17\\xe\\x18\\xe\\x19\\xe\\x1a\\xe\\x1b\\xe\\x1c\\xe\\x1d\\xe\\x1e\\xe\\x1f\\xe\\x20\\xe\\x21\\xe\\x22\\xe\\x23\\xe\\x24\\xe\\x25\\xe\\x26\\xe\\x27\\xe\\x28\\xe\\x29\\xe\\x2a\\xe\\x2b\\xe\\x2c\\xe\\x2d\\xe\\x2e\\xe\\x2f\\xe\\x30\\xe\\x31\\xe\\x32\\xe\\x33\\xe\\x34\\xe\\x35\\xe\\x36\\xe\\x37\\xe\\x38\\xe\\x39\\xe\\x3a\\xe\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x3f\\xe\\x40\\xe\\x41\\xe\\x42\\xe\\x43\\xe\\x44\\xe\\x45\\xe\\x46\\xe\\x47\\xe\\x48\\xe\\x49\\xe\\x4a\\xe\\x4b\\xe\\x4c\\xe\\x4d\\xe\\x4e\\xe\\x4f\\xe\\x50\\xe\\x51\\xe\\x52\\xe\\x53\\xe\\x54\\xe\\x55\\xe\\x56\\xe\\x57\\xe\\x58\\xe\\x59\\xe\\x5a\\xe\\x5b\\xe\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x80\\x1\\xc0\\x0\\xc0\\x1\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x4\\x5\\x6\\x7\\x8\\x9\\xa\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f\\x20\\x21\\x22\\x23\\x24\\x25\\x26\\x27\\x28\\x29\\x2a\\x2b\\x2c\\x2d\\x2e\\x2f\\x30\\x31\\x32\\x33\\x34\\x35\\x36\\x37\\x38\\x39\\x3a\\x3b\\x3c\\x3d\\x3e\\x3f\\x40\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x4a\\x4b\\x4c\\x4d\\x4e\\x4f\\x50\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x59\\x5a\\x5b\\x5c\\x5d\\x5e\\x5f\\x60\\x61\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\x6a\\x6b\\x6c\\x6d\\x6e\\x6f\\x70\\x71\\x72\\x73\\x74\\x75\\x76\\x77\\x78\\x79\\x7a\\x7b\\x7c\\x7d\\x7e\\x7f\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xa1\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xaa\\xab\\xac\\xad\\xae\\xaf\\xb0\\xb1\\xb2\\xb3\\xb4\\xb5\\xb6\\xb7\\xb8\\xb9\\xba\\xbb\\xbc\\xbd\\xbe\\xbf\\xc0\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xca\\xcb\\xcc\\xcd\\xce\\xcf\\xd0\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xda\\x0\\x0\\x0\\x0\\xdf\\xe0\\xe1\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\xea\\xeb\\xec\\xed\\xee\\xef\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\xfa\\xfb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x96\\x97\\x0\\x0\\x0\\x91\\x92\\x0\\x0\\x93\\x94\\x0\\x0\\x0\\x0\\x95\\x0\\x0\\x0\\x85\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\"#\n        , encoderMax = '\\8364'\n        }\n\n   }\n    )\n\n    ,\n    (875, SingleByteCP {\n     decoderArray = ConvArray \"\\x0\\x0\\x1\\x0\\x2\\x0\\x3\\x0\\x9c\\x0\\x9\\x0\\x86\\x0\\x7f\\x0\\x97\\x0\\x8d\\x0\\x8e\\x0\\xb\\x0\\xc\\x0\\xd\\x0\\xe\\x0\\xf\\x0\\x10\\x0\\x11\\x0\\x12\\x0\\x13\\x0\\x9d\\x0\\x85\\x0\\x8\\x0\\x87\\x0\\x18\\x0\\x19\\x0\\x92\\x0\\x8f\\x0\\x1c\\x0\\x1d\\x0\\x1e\\x0\\x1f\\x0\\x80\\x0\\x81\\x0\\x82\\x0\\x83\\x0\\x84\\x0\\xa\\x0\\x17\\x0\\x1b\\x0\\x88\\x0\\x89\\x0\\x8a\\x0\\x8b\\x0\\x8c\\x0\\x5\\x0\\x6\\x0\\x7\\x0\\x90\\x0\\x91\\x0\\x16\\x0\\x93\\x0\\x94\\x0\\x95\\x0\\x96\\x0\\x4\\x0\\x98\\x0\\x99\\x0\\x9a\\x0\\x9b\\x0\\x14\\x0\\x15\\x0\\x9e\\x0\\x1a\\x0\\x20\\x0\\x91\\x3\\x92\\x3\\x93\\x3\\x94\\x3\\x95\\x3\\x96\\x3\\x97\\x3\\x98\\x3\\x99\\x3\\x5b\\x0\\x2e\\x0\\x3c\\x0\\x28\\x0\\x2b\\x0\\x21\\x0\\x26\\x0\\x9a\\x3\\x9b\\x3\\x9c\\x3\\x9d\\x3\\x9e\\x3\\x9f\\x3\\xa0\\x3\\xa1\\x3\\xa3\\x3\\x5d\\x0\\x24\\x0\\x2a\\x0\\x29\\x0\\x3b\\x0\\x5e\\x0\\x2d\\x0\\x2f\\x0\\xa4\\x3\\xa5\\x3\\xa6\\x3\\xa7\\x3\\xa8\\x3\\xa9\\x3\\xaa\\x3\\xab\\x3\\x7c\\x0\\x2c\\x0\\x25\\x0\\x5f\\x0\\x3e\\x0\\x3f\\x0\\xa8\\x0\\x86\\x3\\x88\\x3\\x89\\x3\\xa0\\x0\\x8a\\x3\\x8c\\x3\\x8e\\x3\\x8f\\x3\\x60\\x0\\x3a\\x0\\x23\\x0\\x40\\x0\\x27\\x0\\x3d\\x0\\x22\\x0\\x85\\x3\\x61\\x0\\x62\\x0\\x63\\x0\\x64\\x0\\x65\\x0\\x66\\x0\\x67\\x0\\x68\\x0\\x69\\x0\\xb1\\x3\\xb2\\x3\\xb3\\x3\\xb4\\x3\\xb5\\x3\\xb6\\x3\\xb0\\x0\\x6a\\x0\\x6b\\x0\\x6c\\x0\\x6d\\x0\\x6e\\x0\\x6f\\x0\\x70\\x0\\x71\\x0\\x72\\x0\\xb7\\x3\\xb8\\x3\\xb9\\x3\\xba\\x3\\xbb\\x3\\xbc\\x3\\xb4\\x0\\x7e\\x0\\x73\\x0\\x74\\x0\\x75\\x0\\x76\\x0\\x77\\x0\\x78\\x0\\x79\\x0\\x7a\\x0\\xbd\\x3\\xbe\\x3\\xbf\\x3\\xc0\\x3\\xc1\\x3\\xc3\\x3\\xa3\\x0\\xac\\x3\\xad\\x3\\xae\\x3\\xca\\x3\\xaf\\x3\\xcc\\x3\\xcd\\x3\\xcb\\x3\\xce\\x3\\xc2\\x3\\xc4\\x3\\xc5\\x3\\xc6\\x3\\xc7\\x3\\xc8\\x3\\x7b\\x0\\x41\\x0\\x42\\x0\\x43\\x0\\x44\\x0\\x45\\x0\\x46\\x0\\x47\\x0\\x48\\x0\\x49\\x0\\xad\\x0\\xc9\\x3\\x90\\x3\\xb0\\x3\\x18\\x20\\x15\\x20\\x7d\\x0\\x4a\\x0\\x4b\\x0\\x4c\\x0\\x4d\\x0\\x4e\\x0\\x4f\\x0\\x50\\x0\\x51\\x0\\x52\\x0\\xb1\\x0\\xbd\\x0\\x1a\\x0\\x87\\x3\\x19\\x20\\xa6\\x0\\x5c\\x0\\x1a\\x0\\x53\\x0\\x54\\x0\\x55\\x0\\x56\\x0\\x57\\x0\\x58\\x0\\x59\\x0\\x5a\\x0\\xb2\\x0\\xa7\\x0\\x1a\\x0\\x1a\\x0\\xab\\x0\\xac\\x0\\x30\\x0\\x31\\x0\\x32\\x0\\x33\\x0\\x34\\x0\\x35\\x0\\x36\\x0\\x37\\x0\\x38\\x0\\x39\\x0\\xb3\\x0\\xa9\\x0\\x1a\\x0\\x1a\\x0\\xbb\\x0\\x9f\\x0\"#\n     , encoderArray = \n CompactArray {\n        encoderIndices = ConvArray \"\\x0\\x0\\x40\\x0\\x80\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x0\\x1\\x40\\x1\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\xc0\\x0\\x80\\x1\"#\n        , encoderValues = ConvArray \"\\x0\\x1\\x2\\x3\\x37\\x2d\\x2e\\x2f\\x16\\x5\\x25\\xb\\xc\\xd\\xe\\xf\\x10\\x11\\x12\\x13\\x3c\\x3d\\x32\\x26\\x18\\x19\\xfd\\x27\\x1c\\x1d\\x1e\\x1f\\x40\\x4f\\x7f\\x7b\\x5b\\x6c\\x50\\x7d\\x4d\\x5d\\x5c\\x4e\\x6b\\x60\\x4b\\x61\\xf0\\xf1\\xf2\\xf3\\xf4\\xf5\\xf6\\xf7\\xf8\\xf9\\x7a\\x5e\\x4c\\x7e\\x6e\\x6f\\x7c\\xc1\\xc2\\xc3\\xc4\\xc5\\xc6\\xc7\\xc8\\xc9\\xd1\\xd2\\xd3\\xd4\\xd5\\xd6\\xd7\\xd8\\xd9\\xe2\\xe3\\xe4\\xe5\\xe6\\xe7\\xe8\\xe9\\x4a\\xe0\\x5a\\x5f\\x6d\\x79\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\xa2\\xa3\\xa4\\xa5\\xa6\\xa7\\xa8\\xa9\\xc0\\x6a\\xd0\\xa1\\x7\\x20\\x21\\x22\\x23\\x24\\x15\\x6\\x17\\x28\\x29\\x2a\\x2b\\x2c\\x9\\xa\\x1b\\x30\\x31\\x1a\\x33\\x34\\x35\\x36\\x8\\x38\\x39\\x3a\\x3b\\x4\\x14\\x3e\\xff\\x74\\x0\\x0\\xb0\\x0\\x0\\xdf\\xeb\\x70\\xfb\\x0\\xee\\xef\\xca\\x0\\x0\\x90\\xda\\xea\\xfa\\xa0\\x0\\x0\\x0\\x0\\x0\\x0\\xfe\\x0\\xdb\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x80\\x71\\xdd\\x72\\x73\\x75\\x0\\x76\\x0\\x77\\x78\\xcc\\x41\\x42\\x43\\x44\\x45\\x46\\x47\\x48\\x49\\x51\\x52\\x53\\x54\\x55\\x56\\x57\\x58\\x0\\x59\\x62\\x63\\x64\\x65\\x66\\x67\\x68\\x69\\xb1\\xb2\\xb3\\xb5\\xcd\\x8a\\x8b\\x8c\\x8d\\x8e\\x8f\\x9a\\x9b\\x9c\\x9d\\x9e\\x9f\\xaa\\xab\\xac\\xad\\xae\\xba\\xaf\\xbb\\xbc\\xbd\\xbe\\xbf\\xcb\\xb4\\xb8\\xb6\\xb7\\xb9\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\x0\\xcf\\x0\\x0\\xce\\xde\"#\n        , encoderMax = '\\8217'\n        }\n\n   }\n    )\n    ]\n", "num_lines": 433}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Handle.FD\n-- Copyright   :  (c) The University of Glasgow, 1994-2008\n-- License     :  see libraries/base/LICENSE\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Handle operations implemented by file descriptors (FDs)\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Handle.FD ( \n  stdin, stdout, stderr,\n  openFile, openBinaryFile, openFileBlocking,\n  mkHandleFromFD, fdToHandle, fdToHandle', handleToFd\n ) where\n\nimport GHC.Base\nimport GHC.Show\nimport Data.Maybe\nimport Data.Typeable\nimport Foreign.C.Types\nimport GHC.MVar\nimport GHC.IO\nimport GHC.IO.Encoding\nimport GHC.IO.Device as IODevice\nimport GHC.IO.Exception\nimport GHC.IO.IOMode\nimport GHC.IO.Handle.Types\nimport GHC.IO.Handle.Internals\nimport qualified GHC.IO.FD as FD\nimport qualified System.Posix.Internals as Posix\n\n-- ---------------------------------------------------------------------------\n-- Standard Handles\n\n-- Three handles are allocated during program initialisation.  The first\n-- two manage input or output from the Haskell program's standard input\n-- or output channel respectively.  The third manages output to the\n-- standard error channel. These handles are initially open.\n\n-- | A handle managing input from the Haskell program's standard input channel.\nstdin :: Handle\n{-# NOINLINE stdin #-}\nstdin = unsafePerformIO $ do\n   -- ToDo: acquire lock\n   setBinaryMode FD.stdin\n   enc <- getLocaleEncoding\n   mkHandle FD.stdin \"<stdin>\" ReadHandle True (Just enc)\n                nativeNewlineMode{-translate newlines-}\n                (Just stdHandleFinalizer) Nothing\n\n-- | A handle managing output to the Haskell program's standard output channel.\nstdout :: Handle\n{-# NOINLINE stdout #-}\nstdout = unsafePerformIO $ do\n   -- ToDo: acquire lock\n   setBinaryMode FD.stdout\n   enc <- getLocaleEncoding\n   mkHandle FD.stdout \"<stdout>\" WriteHandle True (Just enc)\n                nativeNewlineMode{-translate newlines-}\n                (Just stdHandleFinalizer) Nothing\n\n-- | A handle managing output to the Haskell program's standard error channel.\nstderr :: Handle\n{-# NOINLINE stderr #-}\nstderr = unsafePerformIO $ do\n    -- ToDo: acquire lock\n   setBinaryMode FD.stderr\n   enc <- getLocaleEncoding\n   mkHandle FD.stderr \"<stderr>\" WriteHandle False{-stderr is unbuffered-} \n                (Just enc)\n                nativeNewlineMode{-translate newlines-}\n                (Just stdHandleFinalizer) Nothing\n\nstdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()\nstdHandleFinalizer fp m = do\n  h_ <- takeMVar m\n  flushWriteBuffer h_\n  case haType h_ of \n      ClosedHandle -> return ()\n      _other       -> closeTextCodecs h_\n  putMVar m (ioe_finalizedHandle fp)\n\n-- We have to put the FDs into binary mode on Windows to avoid the newline\n-- translation that the CRT IO library does.\nsetBinaryMode :: FD.FD -> IO ()\n#if defined(mingw32_HOST_OS)\nsetBinaryMode fd = do _ <- setmode (FD.fdFD fd) True\n                      return ()\n#else\nsetBinaryMode _ = return ()\n#endif\n\n#if defined(mingw32_HOST_OS)\nforeign import ccall unsafe \"__hscore_setmode\"\n  setmode :: CInt -> Bool -> IO CInt\n#endif\n\n-- ---------------------------------------------------------------------------\n-- Opening and Closing Files\n\naddFilePathToIOError :: String -> FilePath -> IOException -> IOException\naddFilePathToIOError fun fp ioe\n  = ioe{ ioe_location = fun, ioe_filename = Just fp }\n\n-- | Computation 'openFile' @file mode@ allocates and returns a new, open\n-- handle to manage the file @file@.  It manages input if @mode@\n-- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',\n-- and both input and output if mode is 'ReadWriteMode'.\n--\n-- If the file does not exist and it is opened for output, it should be\n-- created as a new file.  If @mode@ is 'WriteMode' and the file\n-- already exists, then it should be truncated to zero length.\n-- Some operating systems delete empty files, so there is no guarantee\n-- that the file will exist following an 'openFile' with @mode@\n-- 'WriteMode' unless it is subsequently written to successfully.\n-- The handle is positioned at the end of the file if @mode@ is\n-- 'AppendMode', and otherwise at the beginning (in which case its\n-- internal position is 0).\n-- The initial buffer mode is implementation-dependent.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isAlreadyInUseError' if the file is already open and\n--    cannot be reopened;\n--\n--  * 'System.IO.Error.isDoesNotExistError' if the file does not exist or\n--    (on POSIX systems) is a FIFO without a reader and 'WriteMode' was\n--    requested; or\n--\n--  * 'System.IO.Error.isPermissionError' if the user does not have permission\n--     to open the file.\n--\n-- Note: if you will be working with files containing binary data, you'll want to\n-- be using 'openBinaryFile'.\nopenFile :: FilePath -> IOMode -> IO Handle\nopenFile fp im = \n  catchException\n    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)\n    (\\e -> ioError (addFilePathToIOError \"openFile\" fp e))\n\n-- | Like 'openFile', but opens the file in ordinary blocking mode.\n-- This can be useful for opening a FIFO for writing: if we open in\n-- non-blocking mode then the open will fail if there are no readers,\n-- whereas a blocking open will block until a reader appear.\n--\n-- @since 4.4.0.0\nopenFileBlocking :: FilePath -> IOMode -> IO Handle\nopenFileBlocking fp im =\n  catchException\n    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)\n    (\\e -> ioError (addFilePathToIOError \"openFile\" fp e))\n\n-- | Like 'openFile', but open the file in binary mode.\n-- On Windows, reading a file in text mode (which is the default)\n-- will translate CRLF to LF, and writing will translate LF to CRLF.\n-- This is usually what you want with text files.  With binary files\n-- this is undesirable; also, as usual under Microsoft operating systems,\n-- text mode treats control-Z as EOF.  Binary mode turns off all special\n-- treatment of end-of-line and end-of-file characters.\n-- (See also 'System.IO.hSetBinaryMode'.)\n\nopenBinaryFile :: FilePath -> IOMode -> IO Handle\nopenBinaryFile fp m =\n  catchException\n    (openFile' fp m True True)\n    (\\e -> ioError (addFilePathToIOError \"openBinaryFile\" fp e))\n\nopenFile' :: String -> IOMode -> Bool -> Bool -> IO Handle\nopenFile' filepath iomode binary non_blocking = do\n  -- first open the file to get an FD\n  (fd, fd_type) <- FD.openFile filepath iomode non_blocking\n\n  mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding\n\n  -- then use it to make a Handle\n  mkHandleFromFD fd fd_type filepath iomode\n                   False {- do not *set* non-blocking mode -}\n                   mb_codec\n            `onException` IODevice.close fd\n        -- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise\n        -- this FD leaks.\n        -- ASSERT: if we just created the file, then fdToHandle' won't fail\n        -- (so we don't need to worry about removing the newly created file\n        --  in the event of an error).\n\n\n-- ---------------------------------------------------------------------------\n-- Converting file descriptors from/to Handles\n\nmkHandleFromFD\n   :: FD.FD\n   -> IODeviceType\n   -> FilePath  -- a string describing this file descriptor (e.g. the filename)\n   -> IOMode\n   -> Bool      --  *set* non-blocking mode on the FD\n   -> Maybe TextEncoding\n   -> IO Handle\n\nmkHandleFromFD fd0 fd_type filepath iomode set_non_blocking mb_codec\n  = do\n#if !defined(mingw32_HOST_OS)\n    -- turn on non-blocking mode\n    fd <- if set_non_blocking \n             then FD.setNonBlockingMode fd0 True\n             else return fd0\n#else\n    let _ = set_non_blocking -- warning suppression\n    fd <- return fd0\n#endif\n\n    let nl | isJust mb_codec = nativeNewlineMode\n           | otherwise       = noNewlineTranslation\n\n    case fd_type of\n        Directory -> \n           ioException (IOError Nothing InappropriateType \"openFile\"\n                           \"is a directory\" Nothing Nothing)\n\n        Stream\n           -- only *Streams* can be DuplexHandles.  Other read/write\n           -- Handles must share a buffer.\n           | ReadWriteMode <- iomode -> \n                mkDuplexHandle fd filepath mb_codec nl\n                   \n\n        _other -> \n           mkFileHandle fd filepath iomode mb_codec nl\n\n-- | Old API kept to avoid breaking clients\nfdToHandle' :: CInt\n            -> Maybe IODeviceType\n            -> Bool -- is_socket on Win, non-blocking on Unix\n            -> FilePath\n            -> IOMode\n            -> Bool -- binary\n            -> IO Handle\nfdToHandle' fdint mb_type is_socket filepath iomode binary = do\n  let mb_stat = case mb_type of\n                        Nothing          -> Nothing\n                          -- mkFD will do the stat:\n                        Just RegularFile -> Nothing\n                          -- no stat required for streams etc.:\n                        Just other       -> Just (other,0,0)\n  (fd,fd_type) <- FD.mkFD fdint iomode mb_stat\n                       is_socket\n                       is_socket\n  enc <- if binary then return Nothing else fmap Just getLocaleEncoding\n  mkHandleFromFD fd fd_type filepath iomode is_socket enc\n\n\n-- | Turn an existing file descriptor into a Handle.  This is used by\n-- various external libraries to make Handles.\n--\n-- Makes a binary Handle.  This is for historical reasons; it should\n-- probably be a text Handle with the default encoding and newline\n-- translation instead.\nfdToHandle :: Posix.FD -> IO Handle\nfdToHandle fdint = do\n   iomode <- Posix.fdGetMode fdint\n   (fd,fd_type) <- FD.mkFD fdint iomode Nothing\n            False{-is_socket-} \n              -- NB. the is_socket flag is False, meaning that:\n              --  on Windows we're guessing this is not a socket (XXX)\n            False{-is_nonblock-}\n              -- file descriptors that we get from external sources are\n              -- not put into non-blocking mode, because that would affect\n              -- other users of the file descriptor\n   let fd_str = \"<file descriptor: \" ++ show fd ++ \">\"\n   mkHandleFromFD fd fd_type fd_str iomode False{-non-block-} \n                  Nothing -- bin mode\n\n-- | Turn an existing Handle into a file descriptor. This function throws an\n-- IOError if the Handle does not reference a file descriptor.\nhandleToFd :: Handle -> IO FD.FD\nhandleToFd h = case h of\n  FileHandle _ mv -> do\n    Handle__{haDevice = dev} <- readMVar mv\n    case cast dev of\n      Just fd -> return fd\n      Nothing -> throwErr \"not a file descriptor\"\n  DuplexHandle{} -> throwErr \"not a file handle\"\n  where\n    throwErr msg = ioException $ IOError (Just h)\n      InappropriateType \"handleToFd\" msg Nothing Nothing\n\n\n-- ---------------------------------------------------------------------------\n-- Are files opened by default in text or binary mode, if the user doesn't\n-- specify?\n\ndEFAULT_OPEN_IN_BINARY_MODE :: Bool\ndEFAULT_OPEN_IN_BINARY_MODE = False\n", "num_lines": 301}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude\n           , RecordWildCards\n           , BangPatterns\n           , NondecreasingIndentation\n           , RankNTypes\n  #-}\n{-# OPTIONS_GHC -Wno-unused-matches #-}\n{-# OPTIONS_GHC -Wno-name-shadowing #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Handle.Internals\n-- Copyright   :  (c) The University of Glasgow, 1994-2001\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- This module defines the basic operations on I\\/O \\\"handles\\\".  All\n-- of the operations defined here are independent of the underlying\n-- device.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Handle.Internals (\n  withHandle, withHandle', withHandle_,\n  withHandle__', withHandle_', withAllHandles__,\n  wantWritableHandle, wantReadableHandle, wantReadableHandle_,\n  wantSeekableHandle,\n\n  mkHandle, mkFileHandle, mkDuplexHandle,\n  openTextEncoding, closeTextCodecs, initBufferState,\n  dEFAULT_CHAR_BUFFER_SIZE,\n\n  flushBuffer, flushWriteBuffer, flushCharReadBuffer,\n  flushCharBuffer, flushByteReadBuffer, flushByteWriteBuffer,\n\n  readTextDevice, writeCharBuffer, readTextDeviceNonBlocking,\n  decodeByteBuf,\n\n  augmentIOError,\n  ioe_closedHandle, ioe_semiclosedHandle,\n  ioe_EOF, ioe_notReadable, ioe_notWritable,\n  ioe_finalizedHandle, ioe_bufsiz,\n\n  hClose_help, hLookAhead_,\n\n  HandleFinalizer, handleFinalizer,\n\n  debugIO,\n ) where\n\nimport GHC.IO\nimport GHC.IO.IOMode\nimport GHC.IO.Encoding as Encoding\nimport GHC.IO.Encoding.Types (CodeBuffer)\nimport GHC.IO.Handle.Types\nimport GHC.IO.Buffer\nimport GHC.IO.BufferedIO (BufferedIO)\nimport GHC.IO.Exception\nimport GHC.IO.Device (IODevice, SeekMode(..))\nimport qualified GHC.IO.Device as IODevice\nimport qualified GHC.IO.BufferedIO as Buffered\n\nimport GHC.Conc.Sync\nimport GHC.Real\nimport GHC.Base\nimport GHC.Exception\nimport GHC.Num          ( Num(..) )\nimport GHC.Show\nimport GHC.IORef\nimport GHC.MVar\nimport Data.Typeable\nimport Data.Maybe\nimport Foreign\nimport System.Posix.Internals hiding (FD)\n\nimport Foreign.C\n\nc_DEBUG_DUMP :: Bool\nc_DEBUG_DUMP = False\n\n-- ---------------------------------------------------------------------------\n-- Creating a new handle\n\ntype HandleFinalizer = FilePath -> MVar Handle__ -> IO ()\n\nnewFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle\nnewFileHandle filepath mb_finalizer hc = do\n  m <- newMVar hc\n  case mb_finalizer of\n    Just finalizer -> addMVarFinalizer m (finalizer filepath m)\n    Nothing        -> return ()\n  return (FileHandle filepath m)\n\n-- ---------------------------------------------------------------------------\n-- Working with Handles\n\n{-\nIn the concurrent world, handles are locked during use.  This is done\nby wrapping an MVar around the handle which acts as a mutex over\noperations on the handle.\n\nTo avoid races, we use the following bracketing operations.  The idea\nis to obtain the lock, do some operation and replace the lock again,\nwhether the operation succeeded or failed.  We also want to handle the\ncase where the thread receives an exception while processing the IO\noperation: in these cases we also want to relinquish the lock.\n\nThere are three versions of @withHandle@: corresponding to the three\npossible combinations of:\n\n        - the operation may side-effect the handle\n        - the operation may return a result\n\nIf the operation generates an error or an exception is raised, the\noriginal handle is always replaced.\n-}\n\n{-# INLINE withHandle #-}\nwithHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a\nwithHandle fun h@(FileHandle _ m)     act = withHandle' fun h m act\nwithHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act\n\nwithHandle' :: String -> Handle -> MVar Handle__\n   -> (Handle__ -> IO (Handle__,a)) -> IO a\nwithHandle' fun h m act =\n mask_ $ do\n   (h',v)  <- do_operation fun h act m\n   checkHandleInvariants h'\n   putMVar m h'\n   return v\n\n{-# INLINE withHandle_ #-}\nwithHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a\nwithHandle_ fun h@(FileHandle _ m)     act = withHandle_' fun h m act\nwithHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act\n\nwithHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a\nwithHandle_' fun h m act = withHandle' fun h m $ \\h_ -> do\n                              a <- act h_\n                              return (h_,a)\n\nwithAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()\nwithAllHandles__ fun h@(FileHandle _ m)     act = withHandle__' fun h m act\nwithAllHandles__ fun h@(DuplexHandle _ r w) act = do\n  withHandle__' fun h r act\n  withHandle__' fun h w act\n\nwithHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)\n              -> IO ()\nwithHandle__' fun h m act =\n mask_ $ do\n   h'  <- do_operation fun h act m\n   checkHandleInvariants h'\n   putMVar m h'\n   return ()\n\ndo_operation :: String -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a\ndo_operation fun h act m = do\n  h_ <- takeMVar m\n  checkHandleInvariants h_\n  act h_ `catchException` handler h_\n  where\n    handler h_ e = do\n      putMVar m h_\n      case () of\n        _ | Just ioe <- fromException e ->\n            ioError (augmentIOError ioe fun h)\n        _ | Just async_ex <- fromException e -> do -- see Note [async]\n            let _ = async_ex :: SomeAsyncException\n            t <- myThreadId\n            throwTo t e\n            do_operation fun h act m\n        _otherwise ->\n            throwIO e\n\n-- Note [async]\n--\n-- If an asynchronous exception is raised during an I/O operation,\n-- normally it is fine to just re-throw the exception synchronously.\n-- However, if we are inside an unsafePerformIO or an\n-- unsafeInterleaveIO, this would replace the enclosing thunk with the\n-- exception raised, which is wrong (#3997).  We have to release the\n-- lock on the Handle, but what do we replace the thunk with?  What\n-- should happen when the thunk is subsequently demanded again?\n--\n-- The only sensible choice we have is to re-do the IO operation on\n-- resumption, but then we have to be careful in the IO library that\n-- this is always safe to do.  In particular we should\n--\n--    never perform any side-effects before an interruptible operation\n--\n-- because the interruptible operation may raise an asynchronous\n-- exception, which may cause the operation and its side effects to be\n-- subsequently performed again.\n--\n-- Re-doing the IO operation is achieved by:\n--   - using throwTo to re-throw the asynchronous exception asynchronously\n--     in the current thread\n--   - on resumption, it will be as if throwTo returns.  In that case, we\n--     recursively invoke the original operation (see do_operation above).\n--\n-- Interruptible operations in the I/O library are:\n--    - threadWaitRead/threadWaitWrite\n--    - fillReadBuffer/flushWriteBuffer\n--    - readTextDevice/writeTextDevice\n\naugmentIOError :: IOException -> String -> Handle -> IOException\naugmentIOError ioe@IOError{ ioe_filename = fp } fun h\n  = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }\n  where filepath\n          | Just _ <- fp = fp\n          | otherwise = case h of\n                          FileHandle path _     -> Just path\n                          DuplexHandle path _ _ -> Just path\n\n-- ---------------------------------------------------------------------------\n-- Wrapper for write operations.\n\nwantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a\nwantWritableHandle fun h@(FileHandle _ m) act\n  = wantWritableHandle' fun h m act\nwantWritableHandle fun h@(DuplexHandle _ _ m) act\n  = wantWritableHandle' fun h m act\n    -- we know it's not a ReadHandle or ReadWriteHandle, but we have to\n    -- check for ClosedHandle/SemiClosedHandle. (#4808)\n\nwantWritableHandle'\n        :: String -> Handle -> MVar Handle__\n        -> (Handle__ -> IO a) -> IO a\nwantWritableHandle' fun h m act\n   = withHandle_' fun h m (checkWritableHandle act)\n\ncheckWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a\ncheckWritableHandle act h_@Handle__{..}\n  = case haType of\n      ClosedHandle         -> ioe_closedHandle\n      SemiClosedHandle     -> ioe_semiclosedHandle\n      ReadHandle           -> ioe_notWritable\n      ReadWriteHandle      -> do\n        buf <- readIORef haCharBuffer\n        when (not (isWriteBuffer buf)) $ do\n           flushCharReadBuffer h_\n           flushByteReadBuffer h_\n           buf <- readIORef haCharBuffer\n           writeIORef haCharBuffer buf{ bufState = WriteBuffer }\n           buf <- readIORef haByteBuffer\n           buf' <- Buffered.emptyWriteBuffer haDevice buf\n           writeIORef haByteBuffer buf'\n        act h_\n      _other               -> act h_\n\n-- ---------------------------------------------------------------------------\n-- Wrapper for read operations.\n\nwantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a\nwantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)\n\nwantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a\nwantReadableHandle_ fun h@(FileHandle  _ m)   act\n  = wantReadableHandle' fun h m act\nwantReadableHandle_ fun h@(DuplexHandle _ m _) act\n  = wantReadableHandle' fun h m act\n    -- we know it's not a WriteHandle or ReadWriteHandle, but we have to\n    -- check for ClosedHandle/SemiClosedHandle. (#4808)\n\nwantReadableHandle'\n        :: String -> Handle -> MVar Handle__\n        -> (Handle__ -> IO a) -> IO a\nwantReadableHandle' fun h m act\n  = withHandle_' fun h m (checkReadableHandle act)\n\ncheckReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a\ncheckReadableHandle act h_@Handle__{..} =\n    case haType of\n      ClosedHandle         -> ioe_closedHandle\n      SemiClosedHandle     -> ioe_semiclosedHandle\n      AppendHandle         -> ioe_notReadable\n      WriteHandle          -> ioe_notReadable\n      ReadWriteHandle      -> do\n          -- a read/write handle and we want to read from it.  We must\n          -- flush all buffered write data first.\n          bbuf <- readIORef haByteBuffer\n          when (isWriteBuffer bbuf) $ do\n             when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_\n             cbuf' <- readIORef haCharBuffer\n             writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }\n             bbuf <- readIORef haByteBuffer\n             writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }\n          act h_\n      _other               -> act h_\n\n-- ---------------------------------------------------------------------------\n-- Wrapper for seek operations.\n\nwantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a\nwantSeekableHandle fun h@(DuplexHandle _ _ _) _act =\n  ioException (IOError (Just h) IllegalOperation fun\n                   \"handle is not seekable\" Nothing Nothing)\nwantSeekableHandle fun h@(FileHandle _ m) act =\n  withHandle_' fun h m (checkSeekableHandle act)\n\ncheckSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a\ncheckSeekableHandle act handle_@Handle__{haDevice=dev} =\n    case haType handle_ of\n      ClosedHandle      -> ioe_closedHandle\n      SemiClosedHandle  -> ioe_semiclosedHandle\n      AppendHandle      -> ioe_notSeekable\n      _ -> do b <- IODevice.isSeekable dev\n              if b then act handle_\n                   else ioe_notSeekable\n\n-- -----------------------------------------------------------------------------\n-- Handy IOErrors\n\nioe_closedHandle, ioe_semiclosedHandle, ioe_EOF,\n  ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,\n  ioe_notSeekable :: IO a\n\nioe_closedHandle = ioException\n   (IOError Nothing IllegalOperation \"\"\n        \"handle is closed\" Nothing Nothing)\nioe_semiclosedHandle = ioException\n   (IOError Nothing IllegalOperation \"\"\n        \"handle is semi-closed\" Nothing Nothing)\nioe_EOF = ioException\n   (IOError Nothing EOF \"\" \"\" Nothing Nothing)\nioe_notReadable = ioException\n   (IOError Nothing IllegalOperation \"\"\n        \"handle is not open for reading\" Nothing Nothing)\nioe_notWritable = ioException\n   (IOError Nothing IllegalOperation \"\"\n        \"handle is not open for writing\" Nothing Nothing)\nioe_notSeekable = ioException\n   (IOError Nothing IllegalOperation \"\"\n        \"handle is not seekable\" Nothing Nothing)\nioe_cannotFlushNotSeekable = ioException\n   (IOError Nothing IllegalOperation \"\"\n      \"cannot flush the read buffer: underlying device is not seekable\"\n        Nothing Nothing)\n\nioe_finalizedHandle :: FilePath -> Handle__\nioe_finalizedHandle fp = throw\n   (IOError Nothing IllegalOperation \"\"\n        \"handle is finalized\" Nothing (Just fp))\n\nioe_bufsiz :: Int -> IO a\nioe_bufsiz n = ioException\n   (IOError Nothing InvalidArgument \"hSetBuffering\"\n        (\"illegal buffer size \" ++ showsPrec 9 n []) Nothing Nothing)\n                                -- 9 => should be parens'ified.\n\n-- ---------------------------------------------------------------------------\n-- Wrapper for Handle encoding/decoding.\n\n-- The interface for TextEncoding changed so that a TextEncoding doesn't raise\n-- an exception if it encounters an invalid sequnce. Furthermore, encoding\n-- returns a reason as to why encoding stopped, letting us know if it was due\n-- to input/output underflow or an invalid sequence.\n--\n-- This code adapts this elaborated interface back to the original TextEncoding\n-- interface.\n--\n-- FIXME: it is possible that Handle code using the haDecoder/haEncoder fields\n-- could be made clearer by using the 'encode' interface directly. I have not\n-- looked into this.\n\nstreamEncode :: BufferCodec from to state\n             -> Buffer from -> Buffer to\n             -> IO (Buffer from, Buffer to)\nstreamEncode codec from to = fmap (\\(_, from', to') -> (from', to')) $ recoveringEncode codec from to\n\n-- | Just like 'encode', but interleaves calls to 'encode' with calls to 'recover' in order to make as much progress as possible\nrecoveringEncode :: BufferCodec from to state -> CodeBuffer from to\nrecoveringEncode codec from to = go from to\n  where\n    go from to = do\n      (why, from', to') <- encode codec from to\n      -- When we are dealing with Handles, we don't care about input/output\n      -- underflow particularly, and we want to delay errors about invalid\n      -- sequences as far as possible.\n      case why of\n        InvalidSequence | bufL from == bufL from' -> do\n          -- NB: it is OK to call recover here. Because we saw InvalidSequence, by the invariants\n          -- on \"encode\" it must be the case that there is at least one elements available in the output\n          -- buffer. Furthermore, clearly there is at least one element in the input buffer since we found\n          -- something invalid there!\n          (from', to') <- recover codec from' to'\n          go from' to'\n        _ -> return (why, from', to')\n\n-- -----------------------------------------------------------------------------\n-- Handle Finalizers\n\n-- For a duplex handle, we arrange that the read side points to the write side\n-- (and hence keeps it alive if the read side is alive).  This is done by\n-- having the haOtherSide field of the read side point to the read side.\n-- The finalizer is then placed on the write side, and the handle only gets\n-- finalized once, when both sides are no longer required.\n\n-- NOTE about finalized handles: It's possible that a handle can be\n-- finalized and then we try to use it later, for example if the\n-- handle is referenced from another finalizer, or from a thread that\n-- has become unreferenced and then resurrected (arguably in the\n-- latter case we shouldn't finalize the Handle...).  Anyway,\n-- we try to emit a helpful message which is better than nothing.\n--\n-- [later; 8/2010] However, a program like this can yield a strange\n-- error message:\n--\n--   main = writeFile \"out\" loop\n--   loop = let x = x in x\n--\n-- because the main thread and the Handle are both unreachable at the\n-- same time, the Handle may get finalized before the main thread\n-- receives the NonTermination exception, and the exception handler\n-- will then report an error.  We'd rather this was not an error and\n-- the program just prints \"<<loop>>\".\n\nhandleFinalizer :: FilePath -> MVar Handle__ -> IO ()\nhandleFinalizer fp m = do\n  handle_ <- takeMVar m\n  (handle_', _) <- hClose_help handle_\n  putMVar m handle_'\n  return ()\n\n-- ---------------------------------------------------------------------------\n-- Allocating buffers\n\n-- using an 8k char buffer instead of 32k improved performance for a\n-- basic \"cat\" program by ~30% for me.  --SDM\ndEFAULT_CHAR_BUFFER_SIZE :: Int\ndEFAULT_CHAR_BUFFER_SIZE = 2048 -- 8k/sizeof(HsChar)\n\ngetCharBuffer :: IODevice dev => dev -> BufferState\n              -> IO (IORef CharBuffer, BufferMode)\ngetCharBuffer dev state = do\n  buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state\n  ioref  <- newIORef buffer\n  is_tty <- IODevice.isTerminal dev\n\n  let buffer_mode\n         | is_tty    = LineBuffering\n         | otherwise = BlockBuffering Nothing\n\n  return (ioref, buffer_mode)\n\nmkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)\nmkUnBuffer state = do\n  buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state\n              --  See [note Buffer Sizing], GHC.IO.Handle.Types\n  ref <- newIORef buffer\n  return (ref, NoBuffering)\n\n-- -----------------------------------------------------------------------------\n-- Flushing buffers\n\n-- | syncs the file with the buffer, including moving the\n-- file pointer backwards in the case of a read buffer.  This can fail\n-- on a non-seekable read Handle.\nflushBuffer :: Handle__ -> IO ()\nflushBuffer h_@Handle__{..} = do\n  buf <- readIORef haCharBuffer\n  case bufState buf of\n    ReadBuffer  -> do\n        flushCharReadBuffer h_\n        flushByteReadBuffer h_\n    WriteBuffer -> do\n        flushByteWriteBuffer h_\n\n-- | flushes the Char buffer only.  Works on all Handles.\nflushCharBuffer :: Handle__ -> IO ()\nflushCharBuffer h_@Handle__{..} = do\n  cbuf <- readIORef haCharBuffer\n  case bufState cbuf of\n    ReadBuffer  -> do\n        flushCharReadBuffer h_\n    WriteBuffer ->\n        -- Nothing to do here. Char buffer on a write Handle is always empty\n        -- between Handle operations.\n        -- See [note Buffer Flushing], GHC.IO.Handle.Types.\n        when (not (isEmptyBuffer cbuf)) $\n           error \"internal IO library error: Char buffer non-empty\"\n\n-- -----------------------------------------------------------------------------\n-- Writing data (flushing write buffers)\n\n-- flushWriteBuffer flushes the byte buffer iff it contains pending write\n-- data. Because the Char buffer on a write Handle is always empty between\n-- Handle operations (see [note Buffer Flushing], GHC.IO.Handle.Types),\n-- both buffers are empty after this.\nflushWriteBuffer :: Handle__ -> IO ()\nflushWriteBuffer h_@Handle__{..} = do\n  buf <- readIORef haByteBuffer\n  when (isWriteBuffer buf) $ flushByteWriteBuffer h_\n\nflushByteWriteBuffer :: Handle__ -> IO ()\nflushByteWriteBuffer h_@Handle__{..} = do\n  bbuf <- readIORef haByteBuffer\n  when (not (isEmptyBuffer bbuf)) $ do\n    bbuf' <- Buffered.flushWriteBuffer haDevice bbuf\n    writeIORef haByteBuffer bbuf'\n\n-- write the contents of the CharBuffer to the Handle__.\n-- The data will be encoded and pushed to the byte buffer,\n-- flushing if the buffer becomes full.\nwriteCharBuffer :: Handle__ -> CharBuffer -> IO ()\nwriteCharBuffer h_@Handle__{..} !cbuf = do\n  --\n  bbuf <- readIORef haByteBuffer\n\n  debugIO (\"writeCharBuffer: cbuf=\" ++ summaryBuffer cbuf ++\n        \" bbuf=\" ++ summaryBuffer bbuf)\n\n  (cbuf',bbuf') <- case haEncoder of\n    Nothing      -> latin1_encode cbuf bbuf\n    Just encoder -> (streamEncode encoder) cbuf bbuf\n\n  debugIO (\"writeCharBuffer after encoding: cbuf=\" ++ summaryBuffer cbuf' ++\n        \" bbuf=\" ++ summaryBuffer bbuf')\n\n          -- flush the byte buffer if it is full\n  if isFullBuffer bbuf'\n          --  or we made no progress\n     || not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf\n          -- or the byte buffer has more elements than the user wanted buffered\n     || (case haBufferMode of\n          BlockBuffering (Just s) -> bufferElems bbuf' >= s\n          NoBuffering -> True\n          _other -> False)\n    then do\n      bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'\n      writeIORef haByteBuffer bbuf''\n    else\n      writeIORef haByteBuffer bbuf'\n\n  if not (isEmptyBuffer cbuf')\n     then writeCharBuffer h_ cbuf'\n     else return ()\n\n-- -----------------------------------------------------------------------------\n-- Flushing read buffers\n\n-- It is always possible to flush the Char buffer back to the byte buffer.\nflushCharReadBuffer :: Handle__ -> IO ()\nflushCharReadBuffer Handle__{..} = do\n  cbuf <- readIORef haCharBuffer\n  if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do\n\n  -- haLastDecode is the byte buffer just before we did our last batch of\n  -- decoding.  We're going to re-decode the bytes up to the current char,\n  -- to find out where we should revert the byte buffer to.\n  (codec_state, bbuf0) <- readIORef haLastDecode\n\n  cbuf0 <- readIORef haCharBuffer\n  writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }\n\n  -- if we haven't used any characters from the char buffer, then just\n  -- re-install the old byte buffer.\n  if bufL cbuf0 == 0\n     then do writeIORef haByteBuffer bbuf0\n             return ()\n     else do\n\n  case haDecoder of\n    Nothing -> do\n      writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }\n      -- no decoder: the number of bytes to decode is the same as the\n      -- number of chars we have used up.\n\n    Just decoder -> do\n      debugIO (\"flushCharReadBuffer re-decode, bbuf=\" ++ summaryBuffer bbuf0 ++\n               \" cbuf=\" ++ summaryBuffer cbuf0)\n\n      -- restore the codec state\n      setState decoder codec_state\n\n      (bbuf1,cbuf1) <- (streamEncode decoder) bbuf0\n                               cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }\n\n      debugIO (\"finished, bbuf=\" ++ summaryBuffer bbuf1 ++\n               \" cbuf=\" ++ summaryBuffer cbuf1)\n\n      writeIORef haByteBuffer bbuf1\n\n\n-- When flushing the byte read buffer, we seek backwards by the number\n-- of characters in the buffer.  The file descriptor must therefore be\n-- seekable: attempting to flush the read buffer on an unseekable\n-- handle is not allowed.\n\nflushByteReadBuffer :: Handle__ -> IO ()\nflushByteReadBuffer h_@Handle__{..} = do\n  bbuf <- readIORef haByteBuffer\n\n  if isEmptyBuffer bbuf then return () else do\n\n  seekable <- IODevice.isSeekable haDevice\n  when (not seekable) $ ioe_cannotFlushNotSeekable\n\n  let seek = negate (bufR bbuf - bufL bbuf)\n\n  debugIO (\"flushByteReadBuffer: new file offset = \" ++ show seek)\n  IODevice.seek haDevice RelativeSeek (fromIntegral seek)\n\n  writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }\n\n-- ----------------------------------------------------------------------------\n-- Making Handles\n\nmkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev\n            -> FilePath\n            -> HandleType\n            -> Bool                     -- buffered?\n            -> Maybe TextEncoding\n            -> NewlineMode\n            -> Maybe HandleFinalizer\n            -> Maybe (MVar Handle__)\n            -> IO Handle\n\nmkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do\n   openTextEncoding mb_codec ha_type $ \\ mb_encoder mb_decoder -> do\n\n   let buf_state = initBufferState ha_type\n   bbuf <- Buffered.newBuffer dev buf_state\n   bbufref <- newIORef bbuf\n   last_decode <- newIORef (errorWithoutStackTrace \"codec_state\", bbuf)\n\n   (cbufref,bmode) <-\n         if buffered then getCharBuffer dev buf_state\n                     else mkUnBuffer buf_state\n\n   spares <- newIORef BufferListNil\n   newFileHandle filepath finalizer\n            (Handle__ { haDevice = dev,\n                        haType = ha_type,\n                        haBufferMode = bmode,\n                        haByteBuffer = bbufref,\n                        haLastDecode = last_decode,\n                        haCharBuffer = cbufref,\n                        haBuffers = spares,\n                        haEncoder = mb_encoder,\n                        haDecoder = mb_decoder,\n                        haCodec = mb_codec,\n                        haInputNL = inputNL nl,\n                        haOutputNL = outputNL nl,\n                        haOtherSide = other_side\n                      })\n\n-- | makes a new 'Handle'\nmkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)\n             => dev -- ^ the underlying IO device, which must support\n                    -- 'IODevice', 'BufferedIO' and 'Typeable'\n             -> FilePath\n                    -- ^ a string describing the 'Handle', e.g. the file\n                    -- path for a file.  Used in error messages.\n             -> IOMode\n                    -- The mode in which the 'Handle' is to be used\n             -> Maybe TextEncoding\n                    -- Create the 'Handle' with no text encoding?\n             -> NewlineMode\n                    -- Translate newlines?\n             -> IO Handle\nmkFileHandle dev filepath iomode mb_codec tr_newlines = do\n   mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec\n            tr_newlines\n            (Just handleFinalizer) Nothing{-other_side-}\n\n-- | like 'mkFileHandle', except that a 'Handle' is created with two\n-- independent buffers, one for reading and one for writing.  Used for\n-- full-duplex streams, such as network sockets.\nmkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev\n               -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle\nmkDuplexHandle dev filepath mb_codec tr_newlines = do\n\n  write_side@(FileHandle _ write_m) <-\n       mkHandle dev filepath WriteHandle True mb_codec\n                        tr_newlines\n                        (Just handleFinalizer)\n                        Nothing -- no othersie\n\n  read_side@(FileHandle _ read_m) <-\n      mkHandle dev filepath ReadHandle True mb_codec\n                        tr_newlines\n                        Nothing -- no finalizer\n                        (Just write_m)\n\n  return (DuplexHandle filepath read_m write_m)\n\nioModeToHandleType :: IOMode -> HandleType\nioModeToHandleType ReadMode      = ReadHandle\nioModeToHandleType WriteMode     = WriteHandle\nioModeToHandleType ReadWriteMode = ReadWriteHandle\nioModeToHandleType AppendMode    = AppendHandle\n\ninitBufferState :: HandleType -> BufferState\ninitBufferState ReadHandle = ReadBuffer\ninitBufferState _          = WriteBuffer\n\nopenTextEncoding\n   :: Maybe TextEncoding\n   -> HandleType\n   -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)\n   -> IO a\n\nopenTextEncoding Nothing   ha_type cont = cont Nothing Nothing\nopenTextEncoding (Just TextEncoding{..}) ha_type cont = do\n    mb_decoder <- if isReadableHandleType ha_type then do\n                     decoder <- mkTextDecoder\n                     return (Just decoder)\n                  else\n                     return Nothing\n    mb_encoder <- if isWritableHandleType ha_type then do\n                     encoder <- mkTextEncoder\n                     return (Just encoder)\n                  else\n                     return Nothing\n    cont mb_encoder mb_decoder\n\ncloseTextCodecs :: Handle__ -> IO ()\ncloseTextCodecs Handle__{..} = do\n  case haDecoder of Nothing -> return (); Just d -> Encoding.close d\n  case haEncoder of Nothing -> return (); Just d -> Encoding.close d\n\n-- ---------------------------------------------------------------------------\n-- closing Handles\n\n-- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when\n-- EOF is read or an IO error occurs on a lazy stream.  The\n-- semi-closed Handle is then closed immediately.  We have to be\n-- careful with DuplexHandles though: we have to leave the closing to\n-- the finalizer in that case, because the write side may still be in\n-- use.\nhClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)\nhClose_help handle_ =\n  case haType handle_ of\n      ClosedHandle -> return (handle_,Nothing)\n      _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible\n                    -- it is important that hClose doesn't fail and\n                    -- leave the Handle open (#3128), so we catch\n                    -- exceptions when flushing the buffer.\n              (h_, mb_exc2) <- hClose_handle_ handle_\n              return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)\n\n\ntrymaybe :: IO () -> IO (Maybe SomeException)\ntrymaybe io = (do io; return Nothing) `catchException` \\e -> return (Just e)\n\nhClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)\nhClose_handle_ h_@Handle__{..} = do\n\n    -- close the file descriptor, but not when this is the read\n    -- side of a duplex handle.\n    -- If an exception is raised by the close(), we want to continue\n    -- to close the handle and release the lock if it has one, then\n    -- we return the exception to the caller of hClose_help which can\n    -- raise it if necessary.\n    maybe_exception <-\n      case haOtherSide of\n        Nothing -> trymaybe $ IODevice.close haDevice\n        Just _  -> return Nothing\n\n    -- free the spare buffers\n    writeIORef haBuffers BufferListNil\n    writeIORef haCharBuffer noCharBuffer\n    writeIORef haByteBuffer noByteBuffer\n\n    -- release our encoder/decoder\n    closeTextCodecs h_\n\n    -- we must set the fd to -1, because the finalizer is going\n    -- to run eventually and try to close/unlock it.\n    -- ToDo: necessary?  the handle will be marked ClosedHandle\n    -- XXX GHC won't let us use record update here, hence wildcards\n    return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)\n\n{-# NOINLINE noCharBuffer #-}\nnoCharBuffer :: CharBuffer\nnoCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer\n\n{-# NOINLINE noByteBuffer #-}\nnoByteBuffer :: Buffer Word8\nnoByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer\n\n-- ---------------------------------------------------------------------------\n-- Looking ahead\n\nhLookAhead_ :: Handle__ -> IO Char\nhLookAhead_ handle_@Handle__{..} = do\n    buf <- readIORef haCharBuffer\n\n    -- fill up the read buffer if necessary\n    new_buf <- if isEmptyBuffer buf\n                  then readTextDevice handle_ buf\n                  else return buf\n    writeIORef haCharBuffer new_buf\n\n    peekCharBuf (bufRaw buf) (bufL buf)\n\n-- ---------------------------------------------------------------------------\n-- debugging\n\ndebugIO :: String -> IO ()\ndebugIO s\n | c_DEBUG_DUMP\n    = do _ <- withCStringLen (s ++ \"\\n\") $\n                  \\(p, len) -> c_write 1 (castPtr p) (fromIntegral len)\n         return ()\n | otherwise = return ()\n\n-- ----------------------------------------------------------------------------\n-- Text input/output\n\n-- Read characters into the provided buffer.  Return when any\n-- characters are available; raise an exception if the end of\n-- file is reached.\n--\n-- In uses of readTextDevice within base, the input buffer is either:\n--   * empty\n--   * or contains a single \\r (when doing newline translation)\n--\n-- The input character buffer must have a capacity at least 1 greater\n-- than the number of elements it currently contains.\n--\n-- Users of this function expect that the buffer returned contains\n-- at least 1 more character than the input buffer.\nreadTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer\nreadTextDevice h_@Handle__{..} cbuf = do\n  --\n  bbuf0 <- readIORef haByteBuffer\n\n  debugIO (\"readTextDevice: cbuf=\" ++ summaryBuffer cbuf ++\n        \" bbuf=\" ++ summaryBuffer bbuf0)\n\n  bbuf1 <- if not (isEmptyBuffer bbuf0)\n              then return bbuf0\n              else do\n                   (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0\n                   if r == 0 then ioe_EOF else do  -- raise EOF\n                   return bbuf1\n\n  debugIO (\"readTextDevice after reading: bbuf=\" ++ summaryBuffer bbuf1)\n\n  (bbuf2,cbuf') <-\n      case haDecoder of\n          Nothing      -> do\n               writeIORef haLastDecode (errorWithoutStackTrace \"codec_state\", bbuf1)\n               latin1_decode bbuf1 cbuf\n          Just decoder -> do\n               state <- getState decoder\n               writeIORef haLastDecode (state, bbuf1)\n               (streamEncode decoder) bbuf1 cbuf\n\n  debugIO (\"readTextDevice after decoding: cbuf=\" ++ summaryBuffer cbuf' ++\n        \" bbuf=\" ++ summaryBuffer bbuf2)\n\n  -- We can't return from readTextDevice without reading at least a single extra character,\n  -- so check that we have managed to achieve that\n  writeIORef haByteBuffer bbuf2\n  if bufR cbuf' == bufR cbuf\n     -- we need more bytes to make a Char. NB: bbuf2 may be empty (even though bbuf1 wasn't) when we\n     -- are using an encoding that can skip bytes without outputting characters, such as UTF8//IGNORE\n     then readTextDevice' h_ bbuf2 cbuf\n     else return cbuf'\n\n-- we have an incomplete byte sequence at the end of the buffer: try to\n-- read more bytes.\nreadTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer\nreadTextDevice' h_@Handle__{..} bbuf0 cbuf0 = do\n  --\n  -- copy the partial sequence to the beginning of the buffer, so we have\n  -- room to read more bytes.\n  bbuf1 <- slideContents bbuf0\n\n  -- readTextDevice only calls us if we got some bytes but not some characters.\n  -- This can't occur if haDecoder is Nothing because latin1_decode accepts all bytes.\n  let Just decoder = haDecoder\n\n  (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1\n  if r == 0\n   then do\n     -- bbuf2 can be empty here when we encounter an invalid byte sequence at the end of the input\n     -- with a //IGNORE codec which consumes bytes without outputting characters\n     if isEmptyBuffer bbuf2 then ioe_EOF else do\n     (bbuf3, cbuf1) <- recover decoder bbuf2 cbuf0\n     debugIO (\"readTextDevice' after recovery: bbuf=\" ++ summaryBuffer bbuf3 ++ \", cbuf=\" ++ summaryBuffer cbuf1)\n     writeIORef haByteBuffer bbuf3\n     -- We should recursively invoke readTextDevice after recovery,\n     -- if recovery did not add at least one new character to the buffer:\n     --  1. If we were using IgnoreCodingFailure it might be the case that\n     --     cbuf1 is the same length as cbuf0 and we need to raise ioe_EOF\n     --  2. If we were using TransliterateCodingFailure we might have *mutated*\n     --     the byte buffer without changing the pointers into either buffer.\n     --     We need to try and decode it again - it might just go through this time.\n     if bufR cbuf1 == bufR cbuf0\n      then readTextDevice h_ cbuf1\n      else return cbuf1\n   else do\n    debugIO (\"readTextDevice' after reading: bbuf=\" ++ summaryBuffer bbuf2)\n\n    (bbuf3,cbuf1) <- do\n       state <- getState decoder\n       writeIORef haLastDecode (state, bbuf2)\n       (streamEncode decoder) bbuf2 cbuf0\n\n    debugIO (\"readTextDevice' after decoding: cbuf=\" ++ summaryBuffer cbuf1 ++\n          \" bbuf=\" ++ summaryBuffer bbuf3)\n\n    writeIORef haByteBuffer bbuf3\n    if bufR cbuf0 == bufR cbuf1\n       then readTextDevice' h_ bbuf3 cbuf1\n       else return cbuf1\n\n-- Read characters into the provided buffer.  Do not block;\n-- return zero characters instead.  Raises an exception on end-of-file.\nreadTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer\nreadTextDeviceNonBlocking h_@Handle__{..} cbuf = do\n  --\n  bbuf0 <- readIORef haByteBuffer\n  when (isEmptyBuffer bbuf0) $ do\n     (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0\n     if isNothing r then ioe_EOF else do  -- raise EOF\n     writeIORef haByteBuffer bbuf1\n\n  decodeByteBuf h_ cbuf\n\n-- Decode bytes from the byte buffer into the supplied CharBuffer.\ndecodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer\ndecodeByteBuf h_@Handle__{..} cbuf = do\n  --\n  bbuf0 <- readIORef haByteBuffer\n\n  (bbuf2,cbuf') <-\n      case haDecoder of\n          Nothing      -> do\n               writeIORef haLastDecode (errorWithoutStackTrace \"codec_state\", bbuf0)\n               latin1_decode bbuf0 cbuf\n          Just decoder -> do\n               state <- getState decoder\n               writeIORef haLastDecode (state, bbuf0)\n               (streamEncode decoder) bbuf0 cbuf\n\n  writeIORef haByteBuffer bbuf2\n  return cbuf'\n\n", "num_lines": 950}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , RecordWildCards\n           , BangPatterns\n           , NondecreasingIndentation\n           , MagicHash\n  #-}\n{-# OPTIONS_GHC -Wno-name-shadowing #-}\n{-# OPTIONS_GHC -Wno-unused-matches #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Text\n-- Copyright   :  (c) The University of Glasgow, 1992-2008\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- String I\\/O functions\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Handle.Text (\n        hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,\n        commitBuffer',       -- hack, see below\n        hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,\n        memcpy, hPutStrLn,\n    ) where\n\nimport GHC.IO\nimport GHC.IO.FD\nimport GHC.IO.Buffer\nimport qualified GHC.IO.BufferedIO as Buffered\nimport GHC.IO.Exception\nimport GHC.Exception\nimport GHC.IO.Handle.Types\nimport GHC.IO.Handle.Internals\nimport qualified GHC.IO.Device as IODevice\nimport qualified GHC.IO.Device as RawIO\n\nimport Foreign\nimport Foreign.C\n\nimport qualified Control.Exception as Exception\nimport Data.Typeable\nimport System.IO.Error\nimport Data.Maybe\n\nimport GHC.IORef\nimport GHC.Base\nimport GHC.Real\nimport GHC.Num\nimport GHC.Show\nimport GHC.List\n\n-- ---------------------------------------------------------------------------\n-- Simple input operations\n\n-- If hWaitForInput finds anything in the Handle's buffer, it\n-- immediately returns.  If not, it tries to read from the underlying\n-- OS handle. Notice that for buffered Handles connected to terminals\n-- this means waiting until a complete line is available.\n\n-- | Computation 'hWaitForInput' @hdl t@\n-- waits until input is available on handle @hdl@.\n-- It returns 'True' as soon as input is available on @hdl@,\n-- or 'False' if no input is available within @t@ milliseconds.  Note that\n-- 'hWaitForInput' waits until one or more full /characters/ are available,\n-- which means that it needs to do decoding, and hence may fail\n-- with a decoding error.\n--\n-- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.\n--\n-- This operation may fail with:\n--\n--  * 'isEOFError' if the end of file has been reached.\n--\n--  * a decoding error, if the input begins with an invalid byte sequence\n--    in this Handle's encoding.\n--\n-- NOTE for GHC users: unless you use the @-threaded@ flag,\n-- @hWaitForInput hdl t@ where @t >= 0@ will block all other Haskell\n-- threads for the duration of the call.  It behaves like a\n-- @safe@ foreign call in this respect.\n--\n\nhWaitForInput :: Handle -> Int -> IO Bool\nhWaitForInput h msecs = do\n  wantReadableHandle_ \"hWaitForInput\" h $ \\ handle_@Handle__{..} -> do\n  cbuf <- readIORef haCharBuffer\n\n  if not (isEmptyBuffer cbuf) then return True else do\n\n  if msecs < 0\n        then do cbuf' <- readTextDevice handle_ cbuf\n                writeIORef haCharBuffer cbuf'\n                return True\n        else do\n               -- there might be bytes in the byte buffer waiting to be decoded\n               cbuf' <- decodeByteBuf handle_ cbuf\n               writeIORef haCharBuffer cbuf'\n\n               if not (isEmptyBuffer cbuf') then return True else do\n\n                r <- IODevice.ready haDevice False{-read-} msecs\n                if r then do -- Call hLookAhead' to throw an EOF\n                             -- exception if appropriate\n                             _ <- hLookAhead_ handle_\n                             return True\n                     else return False\n                -- XXX we should only return when there are full characters\n                -- not when there are only bytes.  That would mean looping\n                -- and re-running IODevice.ready if we don't have any full\n                -- characters; but we don't know how long we've waited\n                -- so far.\n\n-- ---------------------------------------------------------------------------\n-- hGetChar\n\n-- | Computation 'hGetChar' @hdl@ reads a character from the file or\n-- channel managed by @hdl@, blocking until a character is available.\n--\n-- This operation may fail with:\n--\n--  * 'isEOFError' if the end of file has been reached.\n\nhGetChar :: Handle -> IO Char\nhGetChar handle =\n  wantReadableHandle_ \"hGetChar\" handle $ \\handle_@Handle__{..} -> do\n\n  -- buffering mode makes no difference: we just read whatever is available\n  -- from the device (blocking only if there is nothing available), and then\n  -- return the first character.\n  -- See [note Buffered Reading] in GHC.IO.Handle.Types\n  buf0 <- readIORef haCharBuffer\n\n  buf1 <- if isEmptyBuffer buf0\n             then readTextDevice handle_ buf0\n             else return buf0\n\n  (c1,i) <- readCharBuf (bufRaw buf1) (bufL buf1)\n  let buf2 = bufferAdjustL i buf1\n\n  if haInputNL == CRLF && c1 == '\\r'\n     then do\n            mbuf3 <- if isEmptyBuffer buf2\n                      then maybeFillReadBuffer handle_ buf2\n                      else return (Just buf2)\n\n            case mbuf3 of\n               -- EOF, so just return the '\\r' we have\n               Nothing -> do\n                  writeIORef haCharBuffer buf2\n                  return '\\r'\n               Just buf3 -> do\n                  (c2,i2) <- readCharBuf (bufRaw buf2) (bufL buf2)\n                  if c2 == '\\n'\n                     then do\n                       writeIORef haCharBuffer (bufferAdjustL i2 buf3)\n                       return '\\n'\n                     else do\n                       -- not a \\r\\n sequence, so just return the \\r\n                       writeIORef haCharBuffer buf3\n                       return '\\r'\n     else do\n            writeIORef haCharBuffer buf2\n            return c1\n\n-- ---------------------------------------------------------------------------\n-- hGetLine\n\n-- | Computation 'hGetLine' @hdl@ reads a line from the file or\n-- channel managed by @hdl@.\n--\n-- This operation may fail with:\n--\n--  * 'isEOFError' if the end of file is encountered when reading\n--    the /first/ character of the line.\n--\n-- If 'hGetLine' encounters end-of-file at any other point while reading\n-- in a line, it is treated as a line terminator and the (partial)\n-- line is returned.\n\nhGetLine :: Handle -> IO String\nhGetLine h =\n  wantReadableHandle_ \"hGetLine\" h $ \\ handle_ -> do\n     hGetLineBuffered handle_\n\nhGetLineBuffered :: Handle__ -> IO String\nhGetLineBuffered handle_@Handle__{..} = do\n  buf <- readIORef haCharBuffer\n  hGetLineBufferedLoop handle_ buf []\n\nhGetLineBufferedLoop :: Handle__\n                     -> CharBuffer -> [String]\n                     -> IO String\nhGetLineBufferedLoop handle_@Handle__{..}\n        buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } xss =\n  let\n        -- find the end-of-line character, if there is one\n        loop raw r\n           | r == w = return (False, w)\n           | otherwise =  do\n                (c,r') <- readCharBuf raw r\n                if c == '\\n'\n                   then return (True, r) -- NB. not r': don't include the '\\n'\n                   else loop raw r'\n  in do\n  (eol, off) <- loop raw0 r0\n\n  debugIO (\"hGetLineBufferedLoop: r=\" ++ show r0 ++ \", w=\" ++ show w ++ \", off=\" ++ show off)\n\n  (xs,r') <- if haInputNL == CRLF\n                then unpack_nl raw0 r0 off \"\"\n                else do xs <- unpack raw0 r0 off \"\"\n                        return (xs,off)\n\n  -- if eol == True, then off is the offset of the '\\n'\n  -- otherwise off == w and the buffer is now empty.\n  if eol -- r' == off\n        then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)\n                return (concat (reverse (xs:xss)))\n        else do\n             let buf1 = bufferAdjustL r' buf\n             maybe_buf <- maybeFillReadBuffer handle_ buf1\n             case maybe_buf of\n                -- Nothing indicates we caught an EOF, and we may have a\n                -- partial line to return.\n                Nothing -> do\n                     -- we reached EOF.  There might be a lone \\r left\n                     -- in the buffer, so check for that and\n                     -- append it to the line if necessary.\n                     --\n                     let pre = if not (isEmptyBuffer buf1) then \"\\r\" else \"\"\n                     writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }\n                     let str = concat (reverse (pre:xs:xss))\n                     if not (null str)\n                        then return str\n                        else ioe_EOF\n                Just new_buf ->\n                     hGetLineBufferedLoop handle_ new_buf (xs:xss)\n\nmaybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)\nmaybeFillReadBuffer handle_ buf\n  = catchException\n     (do buf' <- getSomeCharacters handle_ buf\n         return (Just buf')\n     )\n     (\\e -> do if isEOFError e\n                  then return Nothing\n                  else ioError e)\n\n-- See GHC.IO.Buffer\n#define CHARBUF_UTF32\n-- #define CHARBUF_UTF16\n\n-- NB. performance-critical code: eyeball the Core.\nunpack :: RawCharBuffer -> Int -> Int -> [Char] -> IO [Char]\nunpack !buf !r !w acc0\n | r == w    = return acc0\n | otherwise =\n  withRawBuffer buf $ \\pbuf ->\n    let\n        unpackRB acc !i\n         | i < r  = return acc\n         | otherwise = do\n              -- Here, we are rather careful to only put an *evaluated* character\n              -- in the output string. Due to pointer tagging, this allows the consumer\n              -- to avoid ping-ponging between the actual consumer code and the thunk code\n#if defined(CHARBUF_UTF16)\n              -- reverse-order decoding of UTF-16\n              c2 <- peekElemOff pbuf i\n              if (c2 < 0xdc00 || c2 > 0xdffff)\n                 then unpackRB (unsafeChr (fromIntegral c2) : acc) (i-1)\n                 else do c1 <- peekElemOff pbuf (i-1)\n                         let c = (fromIntegral c1 - 0xd800) * 0x400 +\n                                 (fromIntegral c2 - 0xdc00) + 0x10000\n                         case desurrogatifyRoundtripCharacter (unsafeChr c) of\n                           { C# c# -> unpackRB (C# c# : acc) (i-2) }\n#else\n              c <- peekElemOff pbuf i\n              unpackRB (c : acc) (i-1)\n#endif\n     in\n     unpackRB acc0 (w-1)\n\n-- NB. performance-critical code: eyeball the Core.\nunpack_nl :: RawCharBuffer -> Int -> Int -> [Char] -> IO ([Char],Int)\nunpack_nl !buf !r !w acc0\n | r == w    =  return (acc0, 0)\n | otherwise =\n  withRawBuffer buf $ \\pbuf ->\n    let\n        unpackRB acc !i\n         | i < r  = return acc\n         | otherwise = do\n              c <- peekElemOff pbuf i\n              if (c == '\\n' && i > r)\n                 then do\n                         c1 <- peekElemOff pbuf (i-1)\n                         if (c1 == '\\r')\n                            then unpackRB ('\\n':acc) (i-2)\n                            else unpackRB ('\\n':acc) (i-1)\n                 else do\n                         unpackRB (c : acc) (i-1)\n     in do\n     c <- peekElemOff pbuf (w-1)\n     if (c == '\\r')\n        then do\n                -- If the last char is a '\\r', we need to know whether or\n                -- not it is followed by a '\\n', so leave it in the buffer\n                -- for now and just unpack the rest.\n                str <- unpackRB acc0 (w-2)\n                return (str, w-1)\n        else do\n                str <- unpackRB acc0 (w-1)\n                return (str, w)\n\n-- Note [#5536]\n--\n-- We originally had\n--\n--    let c' = desurrogatifyRoundtripCharacter c in\n--    c' `seq` unpackRB (c':acc) (i-1)\n--\n-- but this resulted in Core like\n--\n--    case (case x <# y of True -> C# e1; False -> C# e2) of c\n--      C# _ -> unpackRB (c:acc) (i-1)\n--\n-- which compiles into a continuation for the outer case, with each\n-- branch of the inner case building a C# and then jumping to the\n-- continuation.  We'd rather not have this extra jump, which makes\n-- quite a difference to performance (see #5536) It turns out that\n-- matching on the C# directly causes GHC to do the case-of-case,\n-- giving much straighter code.\n\n-- -----------------------------------------------------------------------------\n-- hGetContents\n\n-- hGetContents on a DuplexHandle only affects the read side: you can\n-- carry on writing to it afterwards.\n\n-- | Computation 'hGetContents' @hdl@ returns the list of characters\n-- corresponding to the unread portion of the channel or file managed\n-- by @hdl@, which is put into an intermediate state, /semi-closed/.\n-- In this state, @hdl@ is effectively closed,\n-- but items are read from @hdl@ on demand and accumulated in a special\n-- list returned by 'hGetContents' @hdl@.\n--\n-- Any operation that fails because a handle is closed,\n-- also fails if a handle is semi-closed.  The only exception is\n-- 'System.IO.hClose'.  A semi-closed handle becomes closed:\n--\n--  * if 'System.IO.hClose' is applied to it;\n--\n--  * if an I\\/O error occurs when reading an item from the handle;\n--\n--  * or once the entire contents of the handle has been read.\n--\n-- Once a semi-closed handle becomes closed, the contents of the\n-- associated list becomes fixed.  The contents of this final list is\n-- only partially specified: it will contain at least all the items of\n-- the stream that were evaluated prior to the handle becoming closed.\n--\n-- Any I\\/O errors encountered while a handle is semi-closed are simply\n-- discarded.\n--\n-- This operation may fail with:\n--\n--  * 'isEOFError' if the end of file has been reached.\n\nhGetContents :: Handle -> IO String\nhGetContents handle =\n   wantReadableHandle \"hGetContents\" handle $ \\handle_ -> do\n      xs <- lazyRead handle\n      return (handle_{ haType=SemiClosedHandle}, xs )\n\n-- Note that someone may close the semi-closed handle (or change its\n-- buffering), so each time these lazy read functions are pulled on,\n-- they have to check whether the handle has indeed been closed.\n\nlazyRead :: Handle -> IO String\nlazyRead handle =\n   unsafeInterleaveIO $\n        withHandle \"hGetContents\" handle $ \\ handle_ -> do\n        case haType handle_ of\n          SemiClosedHandle -> lazyReadBuffered handle handle_\n          ClosedHandle\n            -> ioException\n                  (IOError (Just handle) IllegalOperation \"hGetContents\"\n                        \"delayed read on closed handle\" Nothing Nothing)\n          _ -> ioException\n                  (IOError (Just handle) IllegalOperation \"hGetContents\"\n                        \"illegal handle type\" Nothing Nothing)\n\nlazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])\nlazyReadBuffered h handle_@Handle__{..} = do\n   buf <- readIORef haCharBuffer\n   Exception.catch\n        (do\n            buf'@Buffer{..} <- getSomeCharacters handle_ buf\n            lazy_rest <- lazyRead h\n            (s,r) <- if haInputNL == CRLF\n                         then unpack_nl bufRaw bufL bufR lazy_rest\n                         else do s <- unpack bufRaw bufL bufR lazy_rest\n                                 return (s,bufR)\n            writeIORef haCharBuffer (bufferAdjustL r buf')\n            return (handle_, s)\n        )\n        (\\e -> do (handle_', _) <- hClose_help handle_\n                  debugIO (\"hGetContents caught: \" ++ show e)\n                  -- We might have a \\r cached in CRLF mode.  So we\n                  -- need to check for that and return it:\n                  let r = if isEOFError e\n                             then if not (isEmptyBuffer buf)\n                                     then \"\\r\"\n                                     else \"\"\n                             else\n                                  throw (augmentIOError e \"hGetContents\" h)\n\n                  return (handle_', r)\n        )\n\n-- ensure we have some characters in the buffer\ngetSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer\ngetSomeCharacters handle_@Handle__{..} buf@Buffer{..} =\n  case bufferElems buf of\n\n    -- buffer empty: read some more\n    0 -> readTextDevice handle_ buf\n\n    -- if the buffer has a single '\\r' in it and we're doing newline\n    -- translation: read some more\n    1 | haInputNL == CRLF -> do\n      (c,_) <- readCharBuf bufRaw bufL\n      if c == '\\r'\n         then do -- shuffle the '\\r' to the beginning.  This is only safe\n                 -- if we're about to call readTextDevice, otherwise it\n                 -- would mess up flushCharBuffer.\n                 -- See [note Buffer Flushing], GHC.IO.Handle.Types\n                 _ <- writeCharBuf bufRaw 0 '\\r'\n                 let buf' = buf{ bufL=0, bufR=1 }\n                 readTextDevice handle_ buf'\n         else do\n                 return buf\n\n    -- buffer has some chars in it already: just return it\n    _otherwise ->\n      return buf\n\n-- ---------------------------------------------------------------------------\n-- hPutChar\n\n-- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the\n-- file or channel managed by @hdl@.  Characters may be buffered if\n-- buffering is enabled for @hdl@.\n--\n-- This operation may fail with:\n--\n--  * 'isFullError' if the device is full; or\n--\n--  * 'isPermissionError' if another system resource limit would be exceeded.\n\nhPutChar :: Handle -> Char -> IO ()\nhPutChar handle c = do\n    c `seq` return ()\n    wantWritableHandle \"hPutChar\" handle $ \\ handle_  -> do\n     hPutcBuffered handle_ c\n\nhPutcBuffered :: Handle__ -> Char -> IO ()\nhPutcBuffered handle_@Handle__{..} c = do\n  buf <- readIORef haCharBuffer\n  if c == '\\n'\n     then do buf1 <- if haOutputNL == CRLF\n                        then do\n                          buf1 <- putc buf '\\r'\n                          putc buf1 '\\n'\n                        else do\n                          putc buf '\\n'\n             writeCharBuffer handle_ buf1\n             when is_line $ flushByteWriteBuffer handle_\n      else do\n          buf1 <- putc buf c\n          writeCharBuffer handle_ buf1\n          return ()\n  where\n    is_line = case haBufferMode of\n                LineBuffering -> True\n                _             -> False\n\n    putc buf@Buffer{ bufRaw=raw, bufR=w } c = do\n       debugIO (\"putc: \" ++ summaryBuffer buf)\n       w'  <- writeCharBuf raw w c\n       return buf{ bufR = w' }\n\n-- ---------------------------------------------------------------------------\n-- hPutStr\n\n-- We go to some trouble to avoid keeping the handle locked while we're\n-- evaluating the string argument to hPutStr, in case doing so triggers another\n-- I/O operation on the same handle which would lead to deadlock.  The classic\n-- case is\n--\n--              putStr (trace \"hello\" \"world\")\n--\n-- so the basic scheme is this:\n--\n--      * copy the string into a fresh buffer,\n--      * \"commit\" the buffer to the handle.\n--\n-- Committing may involve simply copying the contents of the new\n-- buffer into the handle's buffer, flushing one or both buffers, or\n-- maybe just swapping the buffers over (if the handle's buffer was\n-- empty).  See commitBuffer below.\n\n-- | Computation 'hPutStr' @hdl s@ writes the string\n-- @s@ to the file or channel managed by @hdl@.\n--\n-- This operation may fail with:\n--\n--  * 'isFullError' if the device is full; or\n--\n--  * 'isPermissionError' if another system resource limit would be exceeded.\n\nhPutStr :: Handle -> String -> IO ()\nhPutStr handle str = hPutStr' handle str False\n\n-- | The same as 'hPutStr', but adds a newline character.\nhPutStrLn :: Handle -> String -> IO ()\nhPutStrLn handle str = hPutStr' handle str True\n  -- An optimisation: we treat hPutStrLn specially, to avoid the\n  -- overhead of a single putChar '\\n', which is quite high now that we\n  -- have to encode eagerly.\n\n{-# NOINLINE hPutStr' #-}\nhPutStr' :: Handle -> String -> Bool -> IO ()\nhPutStr' handle str add_nl =\n  do\n    (buffer_mode, nl) <-\n         wantWritableHandle \"hPutStr\" handle $ \\h_ -> do\n                       bmode <- getSpareBuffer h_\n                       return (bmode, haOutputNL h_)\n\n    case buffer_mode of\n       (NoBuffering, _) -> do\n            hPutChars handle str        -- v. slow, but we don't care\n            when add_nl $ hPutChar handle '\\n'\n       (LineBuffering, buf) -> do\n            writeBlocks handle True  add_nl nl buf str\n       (BlockBuffering _, buf) -> do\n            writeBlocks handle False add_nl nl buf str\n\nhPutChars :: Handle -> [Char] -> IO ()\nhPutChars _      [] = return ()\nhPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs\n\ngetSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)\ngetSpareBuffer Handle__{haCharBuffer=ref,\n                        haBuffers=spare_ref,\n                        haBufferMode=mode}\n = do\n   case mode of\n     NoBuffering -> return (mode, errorWithoutStackTrace \"no buffer!\")\n     _ -> do\n          bufs <- readIORef spare_ref\n          buf  <- readIORef ref\n          case bufs of\n            BufferListCons b rest -> do\n                writeIORef spare_ref rest\n                return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)\n            BufferListNil -> do\n                new_buf <- newCharBuffer (bufSize buf) WriteBuffer\n                return (mode, new_buf)\n\n\n-- NB. performance-critical code: eyeball the Core.\nwriteBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()\nwriteBlocks hdl line_buffered add_nl nl\n            buf@Buffer{ bufRaw=raw, bufSize=len } s =\n  let\n   shoveString :: Int -> [Char] -> [Char] -> IO ()\n   shoveString !n [] [] = do\n        commitBuffer hdl raw len n False{-no flush-} True{-release-}\n   shoveString !n [] rest = do\n        shoveString n rest []\n   shoveString !n (c:cs) rest\n     -- n+1 so we have enough room to write '\\r\\n' if necessary\n     | n + 1 >= len = do\n        commitBuffer hdl raw len n False{-flush-} False\n        shoveString 0 (c:cs) rest\n     | c == '\\n'  =  do\n        n' <- if nl == CRLF\n                 then do\n                    n1 <- writeCharBuf raw n  '\\r'\n                    writeCharBuf raw n1 '\\n'\n                 else do\n                    writeCharBuf raw n c\n        if line_buffered\n           then do\n                -- end of line, so write and flush\n               commitBuffer hdl raw len n' True{-flush-} False\n               shoveString 0 cs rest\n           else do\n               shoveString n' cs rest\n     | otherwise = do\n        n' <- writeCharBuf raw n c\n        shoveString n' cs rest\n  in\n  shoveString 0 s (if add_nl then \"\\n\" else \"\")\n\n-- -----------------------------------------------------------------------------\n-- commitBuffer handle buf sz count flush release\n--\n-- Write the contents of the buffer 'buf' ('sz' bytes long, containing\n-- 'count' bytes of data) to handle (handle must be block or line buffered).\n\ncommitBuffer\n        :: Handle                       -- handle to commit to\n        -> RawCharBuffer -> Int         -- address and size (in bytes) of buffer\n        -> Int                          -- number of bytes of data in buffer\n        -> Bool                         -- True <=> flush the handle afterward\n        -> Bool                         -- release the buffer?\n        -> IO ()\n\ncommitBuffer hdl !raw !sz !count flush release =\n  wantWritableHandle \"commitBuffer\" hdl $ \\h_@Handle__{..} -> do\n      debugIO (\"commitBuffer: sz=\" ++ show sz ++ \", count=\" ++ show count\n            ++ \", flush=\" ++ show flush ++ \", release=\" ++ show release)\n\n      writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer,\n                                 bufL=0, bufR=count, bufSize=sz }\n\n      when flush $ flushByteWriteBuffer h_\n\n      -- release the buffer if necessary\n      when release $ do\n          -- find size of current buffer\n          old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer\n          when (sz == size) $ do\n               spare_bufs <- readIORef haBuffers\n               writeIORef haBuffers (BufferListCons raw spare_bufs)\n\n      return ()\n\n-- backwards compatibility; the text package uses this\ncommitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__\n              -> IO CharBuffer\ncommitBuffer' raw sz@(I# _) count@(I# _) flush release h_@Handle__{..}\n   = do\n      debugIO (\"commitBuffer: sz=\" ++ show sz ++ \", count=\" ++ show count\n            ++ \", flush=\" ++ show flush ++ \", release=\" ++ show release)\n\n      let this_buf = Buffer{ bufRaw=raw, bufState=WriteBuffer,\n                             bufL=0, bufR=count, bufSize=sz }\n\n      writeCharBuffer h_ this_buf\n\n      when flush $ flushByteWriteBuffer h_\n\n      -- release the buffer if necessary\n      when release $ do\n          -- find size of current buffer\n          old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer\n          when (sz == size) $ do\n               spare_bufs <- readIORef haBuffers\n               writeIORef haBuffers (BufferListCons raw spare_bufs)\n\n      return this_buf\n\n-- ---------------------------------------------------------------------------\n-- Reading/writing sequences of bytes.\n\n-- ---------------------------------------------------------------------------\n-- hPutBuf\n\n-- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the\n-- buffer @buf@ to the handle @hdl@.  It returns ().\n--\n-- 'hPutBuf' ignores any text encoding that applies to the 'Handle',\n-- writing the bytes directly to the underlying file or device.\n--\n-- 'hPutBuf' ignores the prevailing 'System.IO.TextEncoding' and\n-- 'NewlineMode' on the 'Handle', and writes bytes directly.\n--\n-- This operation may fail with:\n--\n--  * 'ResourceVanished' if the handle is a pipe or socket, and the\n--    reading end is closed.  (If this is a POSIX system, and the program\n--    has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered\n--    instead, whose default action is to terminate the program).\n\nhPutBuf :: Handle                       -- handle to write to\n        -> Ptr a                        -- address of buffer\n        -> Int                          -- number of bytes of data in buffer\n        -> IO ()\nhPutBuf h ptr count = do _ <- hPutBuf' h ptr count True\n                         return ()\n\nhPutBufNonBlocking\n        :: Handle                       -- handle to write to\n        -> Ptr a                        -- address of buffer\n        -> Int                          -- number of bytes of data in buffer\n        -> IO Int                       -- returns: number of bytes written\nhPutBufNonBlocking h ptr count = hPutBuf' h ptr count False\n\nhPutBuf':: Handle                       -- handle to write to\n        -> Ptr a                        -- address of buffer\n        -> Int                          -- number of bytes of data in buffer\n        -> Bool                         -- allow blocking?\n        -> IO Int\nhPutBuf' handle ptr count can_block\n  | count == 0 = return 0\n  | count <  0 = illegalBufferSize handle \"hPutBuf\" count\n  | otherwise =\n    wantWritableHandle \"hPutBuf\" handle $\n      \\ h_@Handle__{..} -> do\n          debugIO (\"hPutBuf count=\" ++ show count)\n\n          r <- bufWrite h_ (castPtr ptr) count can_block\n\n          -- we must flush if this Handle is set to NoBuffering.  If\n          -- it is set to LineBuffering, be conservative and flush\n          -- anyway (we didn't check for newlines in the data).\n          case haBufferMode of\n             BlockBuffering _      -> do return ()\n             _line_or_no_buffering -> do flushWriteBuffer h_\n          return r\n\nbufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int\nbufWrite h_@Handle__{..} ptr count can_block =\n  seq count $ do  -- strictness hack\n  old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }\n     <- readIORef haByteBuffer\n\n  -- TODO: Possible optimisation:\n  --       If we know that `w + count > size`, we should write both the\n  --       handle buffer and the `ptr` in a single `writev()` syscall.\n\n  -- Need to buffer and enough room in handle buffer?\n  -- There's no need to buffer if the data to be written is larger than\n  -- the handle buffer (`count >= size`).\n  if (count < size && count <= size - w)\n        -- We need to buffer and there's enough room in the buffer:\n        -- just copy the data in and update bufR.\n        then do debugIO (\"hPutBuf: copying to buffer, w=\" ++ show w)\n                copyToRawBuffer old_raw w ptr count\n                let copied_buf = old_buf{ bufR = w + count }\n                -- If the write filled the buffer completely, we need to flush,\n                -- to maintain the \"INVARIANTS on Buffers\" from\n                -- GHC.IO.Buffer.checkBuffer: \"a write buffer is never full\".\n                if (count == size - w)\n                  then do\n                    debugIO \"hPutBuf: flushing full buffer after writing\"\n                    flushed_buf <- Buffered.flushWriteBuffer haDevice copied_buf\n                            -- TODO: we should do a non-blocking flush here\n                    writeIORef haByteBuffer flushed_buf\n                  else do\n                    writeIORef haByteBuffer copied_buf\n                return count\n\n        -- else, we have to flush any existing handle buffer data\n        -- and can then write out the data in `ptr` directly.\n        else do -- No point flushing when there's nothing in the buffer.\n                when (w > 0) $ do\n                  debugIO \"hPutBuf: flushing first\"\n                  flushed_buf <- Buffered.flushWriteBuffer haDevice old_buf\n                          -- TODO: we should do a non-blocking flush here\n                  writeIORef haByteBuffer flushed_buf\n                -- if we can fit in the buffer, then just loop\n                if count < size\n                   then bufWrite h_ ptr count can_block\n                   else if can_block\n                           then do writeChunk h_ (castPtr ptr) count\n                                   return count\n                           else writeChunkNonBlocking h_ (castPtr ptr) count\n\nwriteChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()\nwriteChunk h_@Handle__{..} ptr bytes\n  | Just fd <- cast haDevice  =  RawIO.write (fd::FD) ptr bytes\n  | otherwise = error \"Todo: hPutBuf\"\n\nwriteChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int\nwriteChunkNonBlocking h_@Handle__{..} ptr bytes\n  | Just fd <- cast haDevice  =  RawIO.writeNonBlocking (fd::FD) ptr bytes\n  | otherwise = error \"Todo: hPutBuf\"\n\n-- ---------------------------------------------------------------------------\n-- hGetBuf\n\n-- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@\n-- into the buffer @buf@ until either EOF is reached or\n-- @count@ 8-bit bytes have been read.\n-- It returns the number of bytes actually read.  This may be zero if\n-- EOF was reached before any data was read (or if @count@ is zero).\n--\n-- 'hGetBuf' never raises an EOF exception, instead it returns a value\n-- smaller than @count@.\n--\n-- If the handle is a pipe or socket, and the writing end\n-- is closed, 'hGetBuf' will behave as if EOF was reached.\n--\n-- 'hGetBuf' ignores the prevailing 'System.IO.TextEncoding' and 'NewlineMode'\n-- on the 'Handle', and reads bytes directly.\n\nhGetBuf :: Handle -> Ptr a -> Int -> IO Int\nhGetBuf h !ptr count\n  | count == 0 = return 0\n  | count <  0 = illegalBufferSize h \"hGetBuf\" count\n  | otherwise =\n      wantReadableHandle_ \"hGetBuf\" h $ \\ h_@Handle__{..} -> do\n         flushCharReadBuffer h_\n         buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }\n            <- readIORef haByteBuffer\n         if isEmptyBuffer buf\n            then bufReadEmpty    h_ buf (castPtr ptr) 0 count\n            else bufReadNonEmpty h_ buf (castPtr ptr) 0 count\n\n-- small reads go through the buffer, large reads are satisfied by\n-- taking data first from the buffer and then direct from the file\n-- descriptor.\n\nbufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int\nbufReadNonEmpty h_@Handle__{..}\n                buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }\n                ptr !so_far !count\n = do\n        let avail = w - r\n        if (count < avail)\n           then do\n                copyFromRawBuffer ptr raw r count\n                writeIORef haByteBuffer buf{ bufL = r + count }\n                return (so_far + count)\n           else do\n\n        copyFromRawBuffer ptr raw r avail\n        let buf' = buf{ bufR=0, bufL=0 }\n        writeIORef haByteBuffer buf'\n        let remaining = count - avail\n            so_far' = so_far + avail\n            ptr' = ptr `plusPtr` avail\n\n        if remaining == 0\n           then return so_far'\n           else bufReadEmpty h_ buf' ptr' so_far' remaining\n\n\nbufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int\nbufReadEmpty h_@Handle__{..}\n             buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }\n             ptr so_far count\n | count > sz, Just fd <- cast haDevice = loop fd 0 count\n | otherwise = do\n     (r,buf') <- Buffered.fillReadBuffer haDevice buf\n     if r == 0\n        then return so_far\n        else do writeIORef haByteBuffer buf'\n                bufReadNonEmpty h_ buf' ptr so_far count\n where\n  loop :: FD -> Int -> Int -> IO Int\n  loop fd off bytes | bytes <= 0 = return (so_far + off)\n  loop fd off bytes = do\n    r <- RawIO.read (fd::FD) (ptr `plusPtr` off) bytes\n    if r == 0\n        then return (so_far + off)\n        else loop fd (off + r) (bytes - r)\n\n-- ---------------------------------------------------------------------------\n-- hGetBufSome\n\n-- | 'hGetBufSome' @hdl buf count@ reads data from the handle @hdl@\n-- into the buffer @buf@.  If there is any data available to read,\n-- then 'hGetBufSome' returns it immediately; it only blocks if there\n-- is no data to be read.\n--\n-- It returns the number of bytes actually read.  This may be zero if\n-- EOF was reached before any data was read (or if @count@ is zero).\n--\n-- 'hGetBufSome' never raises an EOF exception, instead it returns a value\n-- smaller than @count@.\n--\n-- If the handle is a pipe or socket, and the writing end\n-- is closed, 'hGetBufSome' will behave as if EOF was reached.\n--\n-- 'hGetBufSome' ignores the prevailing 'System.IO.TextEncoding' and\n-- 'NewlineMode' on the 'Handle', and reads bytes directly.\n\nhGetBufSome :: Handle -> Ptr a -> Int -> IO Int\nhGetBufSome h !ptr count\n  | count == 0 = return 0\n  | count <  0 = illegalBufferSize h \"hGetBufSome\" count\n  | otherwise =\n      wantReadableHandle_ \"hGetBufSome\" h $ \\ h_@Handle__{..} -> do\n         flushCharReadBuffer h_\n         buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer\n         if isEmptyBuffer buf\n            then case count > sz of  -- large read? optimize it with a little special case:\n                    True | Just fd <- haFD h_ -> do RawIO.read fd (castPtr ptr) count\n                    _ -> do (r,buf') <- Buffered.fillReadBuffer haDevice buf\n                            if r == 0\n                               then return 0\n                               else do writeIORef haByteBuffer buf'\n                                       bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 (min r count)\n                                        -- new count is  (min r count), so\n                                        -- that bufReadNBNonEmpty will not\n                                        -- issue another read.\n            else\n              let count' = min count (bufferElems buf)\n              in bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count'\n\nhaFD :: Handle__ -> Maybe FD\nhaFD h_@Handle__{..} = cast haDevice\n\n-- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@\n-- into the buffer @buf@ until either EOF is reached, or\n-- @count@ 8-bit bytes have been read, or there is no more data available\n-- to read immediately.\n--\n-- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will\n-- never block waiting for data to become available, instead it returns\n-- only whatever data is available.  To wait for data to arrive before\n-- calling 'hGetBufNonBlocking', use 'hWaitForInput'.\n--\n-- If the handle is a pipe or socket, and the writing end\n-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.\n--\n-- 'hGetBufNonBlocking' ignores the prevailing 'System.IO.TextEncoding' and\n-- 'NewlineMode' on the 'Handle', and reads bytes directly.\n--\n-- NOTE: on Windows, this function does not work correctly; it\n-- behaves identically to 'hGetBuf'.\n\nhGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int\nhGetBufNonBlocking h !ptr count\n  | count == 0 = return 0\n  | count <  0 = illegalBufferSize h \"hGetBufNonBlocking\" count\n  | otherwise =\n      wantReadableHandle_ \"hGetBufNonBlocking\" h $ \\ h_@Handle__{..} -> do\n         flushCharReadBuffer h_\n         buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }\n            <- readIORef haByteBuffer\n         if isEmptyBuffer buf\n            then bufReadNBEmpty    h_ buf (castPtr ptr) 0 count\n            else bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count\n\nbufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int\nbufReadNBEmpty   h_@Handle__{..}\n                 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }\n                 ptr so_far count\n  | count > sz,\n    Just fd <- cast haDevice = do\n       m <- RawIO.readNonBlocking (fd::FD) ptr count\n       case m of\n         Nothing -> return so_far\n         Just n  -> return (so_far + n)\n\n | otherwise = do\n     buf <- readIORef haByteBuffer\n     (r,buf') <- Buffered.fillReadBuffer0 haDevice buf\n     case r of\n       Nothing -> return so_far\n       Just 0  -> return so_far\n       Just r  -> do\n         writeIORef haByteBuffer buf'\n         bufReadNBNonEmpty h_ buf' ptr so_far (min count r)\n                          -- NOTE: new count is    min count r\n                          -- so we will just copy the contents of the\n                          -- buffer in the recursive call, and not\n                          -- loop again.\n\n\nbufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int\nbufReadNBNonEmpty h_@Handle__{..}\n                  buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }\n                  ptr so_far count\n  = do\n        let avail = w - r\n        if (count < avail)\n           then do\n                copyFromRawBuffer ptr raw r count\n                writeIORef haByteBuffer buf{ bufL = r + count }\n                return (so_far + count)\n           else do\n\n        copyFromRawBuffer ptr raw r avail\n        let buf' = buf{ bufR=0, bufL=0 }\n        writeIORef haByteBuffer buf'\n        let remaining = count - avail\n            so_far' = so_far + avail\n            ptr' = ptr `plusPtr` avail\n\n        if remaining == 0\n           then return so_far'\n           else bufReadNBEmpty h_ buf' ptr' so_far' remaining\n\n-- ---------------------------------------------------------------------------\n-- memcpy wrappers\n\ncopyToRawBuffer :: RawBuffer e -> Int -> Ptr e -> Int -> IO ()\ncopyToRawBuffer raw off ptr bytes =\n withRawBuffer raw $ \\praw ->\n   do _ <- memcpy (praw `plusPtr` off) ptr (fromIntegral bytes)\n      return ()\n\ncopyFromRawBuffer :: Ptr e -> RawBuffer e -> Int -> Int -> IO ()\ncopyFromRawBuffer ptr raw off bytes =\n withRawBuffer raw $ \\praw ->\n   do _ <- memcpy ptr (praw `plusPtr` off) (fromIntegral bytes)\n      return ()\n\nforeign import ccall unsafe \"memcpy\"\n   memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())\n\n-----------------------------------------------------------------------------\n-- Internal Utils\n\nillegalBufferSize :: Handle -> String -> Int -> IO a\nillegalBufferSize handle fn sz =\n        ioException (IOError (Just handle)\n                            InvalidArgument  fn\n                            (\"illegal buffer size \" ++ showsPrec 9 sz [])\n                            Nothing Nothing)\n\n", "num_lines": 1028}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , ExistentialQuantification\n  #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IO.Handle.Types\n-- Copyright   :  (c) The University of Glasgow, 1994-2009\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable\n--\n-- Basic types for the implementation of IO Handles.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.IO.Handle.Types (\n      Handle(..), Handle__(..), showHandle,\n      checkHandleInvariants,\n      BufferList(..),\n      HandleType(..),\n      isReadableHandleType, isWritableHandleType, isReadWriteHandleType,\n      BufferMode(..),\n      BufferCodec(..),\n      NewlineMode(..), Newline(..), nativeNewline,\n      universalNewlineMode, noNewlineTranslation, nativeNewlineMode\n  ) where\n\n#undef DEBUG\n\nimport GHC.Base\nimport GHC.MVar\nimport GHC.IO\nimport GHC.IO.Buffer\nimport GHC.IO.BufferedIO\nimport GHC.IO.Encoding.Types\nimport GHC.IORef\nimport GHC.Show\nimport GHC.Read\nimport GHC.Word\nimport GHC.IO.Device\nimport Data.Typeable\n#if defined(DEBUG)\nimport Control.Monad\n#endif\n\n-- ---------------------------------------------------------------------------\n-- Handle type\n\n--  A Handle is represented by (a reference to) a record\n--  containing the state of the I/O port/device. We record\n--  the following pieces of info:\n\n--    * type (read,write,closed etc.)\n--    * the underlying file descriptor\n--    * buffering mode\n--    * buffer, and spare buffers\n--    * user-friendly name (usually the\n--      FilePath used when IO.openFile was called)\n\n-- Note: when a Handle is garbage collected, we want to flush its buffer\n-- and close the OS file handle, so as to free up a (precious) resource.\n\n-- | Haskell defines operations to read and write characters from and to files,\n-- represented by values of type @Handle@.  Each value of this type is a\n-- /handle/: a record used by the Haskell run-time system to /manage/ I\\/O\n-- with file system objects.  A handle has at least the following properties:\n--\n--  * whether it manages input or output or both;\n--\n--  * whether it is /open/, /closed/ or /semi-closed/;\n--\n--  * whether the object is seekable;\n--\n--  * whether buffering is disabled, or enabled on a line or block basis;\n--\n--  * a buffer (whose length may be zero).\n--\n-- Most handles will also have a current I\\/O position indicating where the next\n-- input or output operation will occur.  A handle is /readable/ if it\n-- manages only input or both input and output; likewise, it is /writable/ if\n-- it manages only output or both input and output.  A handle is /open/ when\n-- first allocated.\n-- Once it is closed it can no longer be used for either input or output,\n-- though an implementation cannot re-use its storage while references\n-- remain to it.  Handles are in the 'Show' and 'Eq' classes.  The string\n-- produced by showing a handle is system dependent; it should include\n-- enough information to identify the handle for debugging.  A handle is\n-- equal according to '==' only to itself; no attempt\n-- is made to compare the internal state of different handles for equality.\n\ndata Handle\n  = FileHandle                          -- A normal handle to a file\n        FilePath                        -- the file (used for error messages\n                                        -- only)\n        !(MVar Handle__)\n\n  | DuplexHandle                        -- A handle to a read/write stream\n        FilePath                        -- file for a FIFO, otherwise some\n                                        --   descriptive string (used for error\n                                        --   messages only)\n        !(MVar Handle__)                -- The read side\n        !(MVar Handle__)                -- The write side\n\n-- NOTES:\n--    * A 'FileHandle' is seekable.  A 'DuplexHandle' may or may not be\n--      seekable.\n\n-- | @since 4.1.0.0\ninstance Eq Handle where\n (FileHandle _ h1)     == (FileHandle _ h2)     = h1 == h2\n (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2\n _ == _ = False\n\ndata Handle__\n  = forall dev enc_state dec_state . (IODevice dev, BufferedIO dev, Typeable dev) =>\n    Handle__ {\n      haDevice      :: !dev,\n      haType        :: HandleType,           -- type (read/write/append etc.)\n      haByteBuffer  :: !(IORef (Buffer Word8)), -- See [note Buffering Implementation]\n      haBufferMode  :: BufferMode,\n      haLastDecode  :: !(IORef (dec_state, Buffer Word8)),\n      haCharBuffer  :: !(IORef (Buffer CharBufElem)), -- See [note Buffering Implementation]\n      haBuffers     :: !(IORef (BufferList CharBufElem)),  -- spare buffers\n      haEncoder     :: Maybe (TextEncoder enc_state),\n      haDecoder     :: Maybe (TextDecoder dec_state),\n      haCodec       :: Maybe TextEncoding,\n      haInputNL     :: Newline,\n      haOutputNL    :: Newline,\n      haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a\n                                             -- duplex handle.\n    }\n\n-- we keep a few spare buffers around in a handle to avoid allocating\n-- a new one for each hPutStr.  These buffers are *guaranteed* to be the\n-- same size as the main buffer.\ndata BufferList e\n  = BufferListNil\n  | BufferListCons (RawBuffer e) (BufferList e)\n\n--  Internally, we classify handles as being one\n--  of the following:\n\ndata HandleType\n = ClosedHandle\n | SemiClosedHandle\n | ReadHandle\n | WriteHandle\n | AppendHandle\n | ReadWriteHandle\n\nisReadableHandleType :: HandleType -> Bool\nisReadableHandleType ReadHandle         = True\nisReadableHandleType ReadWriteHandle    = True\nisReadableHandleType _                  = False\n\nisWritableHandleType :: HandleType -> Bool\nisWritableHandleType AppendHandle    = True\nisWritableHandleType WriteHandle     = True\nisWritableHandleType ReadWriteHandle = True\nisWritableHandleType _               = False\n\nisReadWriteHandleType :: HandleType -> Bool\nisReadWriteHandleType ReadWriteHandle{} = True\nisReadWriteHandleType _                 = False\n\n-- INVARIANTS on Handles:\n--\n--   * A handle *always* has a buffer, even if it is only 1 character long\n--     (an unbuffered handle needs a 1 character buffer in order to support\n--      hLookAhead and hIsEOF).\n--   * In a read Handle, the byte buffer is always empty (we decode when reading)\n--   * In a wriite Handle, the Char buffer is always empty (we encode when writing)\n--\ncheckHandleInvariants :: Handle__ -> IO ()\n#if defined(DEBUG)\ncheckHandleInvariants h_ = do\n bbuf <- readIORef (haByteBuffer h_)\n checkBuffer bbuf\n cbuf <- readIORef (haCharBuffer h_)\n checkBuffer cbuf\n when (isWriteBuffer cbuf && not (isEmptyBuffer cbuf)) $\n   errorWithoutStackTrace (\"checkHandleInvariants: char write buffer non-empty: \" ++\n          summaryBuffer bbuf ++ \", \" ++ summaryBuffer cbuf)\n when (isWriteBuffer bbuf /= isWriteBuffer cbuf) $\n   errorWithoutStackTrace (\"checkHandleInvariants: buffer modes differ: \" ++\n          summaryBuffer bbuf ++ \", \" ++ summaryBuffer cbuf)\n\n#else\ncheckHandleInvariants _ = return ()\n#endif\n\n-- ---------------------------------------------------------------------------\n-- Buffering modes\n\n-- | Three kinds of buffering are supported: line-buffering,\n-- block-buffering or no-buffering.  These modes have the following\n-- effects. For output, items are written out, or /flushed/,\n-- from the internal buffer according to the buffer mode:\n--\n--  * /line-buffering/: the entire output buffer is flushed\n--    whenever a newline is output, the buffer overflows,\n--    a 'System.IO.hFlush' is issued, or the handle is closed.\n--\n--  * /block-buffering/: the entire buffer is written out whenever it\n--    overflows, a 'System.IO.hFlush' is issued, or the handle is closed.\n--\n--  * /no-buffering/: output is written immediately, and never stored\n--    in the buffer.\n--\n-- An implementation is free to flush the buffer more frequently,\n-- but not less frequently, than specified above.\n-- The output buffer is emptied as soon as it has been written out.\n--\n-- Similarly, input occurs according to the buffer mode for the handle:\n--\n--  * /line-buffering/: when the buffer for the handle is not empty,\n--    the next item is obtained from the buffer; otherwise, when the\n--    buffer is empty, characters up to and including the next newline\n--    character are read into the buffer.  No characters are available\n--    until the newline character is available or the buffer is full.\n--\n--  * /block-buffering/: when the buffer for the handle becomes empty,\n--    the next block of data is read into the buffer.\n--\n--  * /no-buffering/: the next input item is read and returned.\n--    The 'System.IO.hLookAhead' operation implies that even a no-buffered\n--    handle may require a one-character buffer.\n--\n-- The default buffering mode when a handle is opened is\n-- implementation-dependent and may depend on the file system object\n-- which is attached to that handle.\n-- For most implementations, physical files will normally be block-buffered\n-- and terminals will normally be line-buffered.\n\ndata BufferMode\n = NoBuffering  -- ^ buffering is disabled if possible.\n | LineBuffering\n                -- ^ line-buffering should be enabled if possible.\n | BlockBuffering (Maybe Int)\n                -- ^ block-buffering should be enabled if possible.\n                -- The size of the buffer is @n@ items if the argument\n                -- is 'Just' @n@ and is otherwise implementation-dependent.\n   deriving ( Eq   -- ^ @since 4.2.0.0\n            , Ord  -- ^ @since 4.2.0.0\n            , Read -- ^ @since 4.2.0.0\n            , Show -- ^ @since 4.2.0.0\n            )\n\n{-\n[note Buffering Implementation]\n\nEach Handle has two buffers: a byte buffer (haByteBuffer) and a Char\nbuffer (haCharBuffer).\n\n[note Buffered Reading]\n\nFor read Handles, bytes are read into the byte buffer, and immediately\ndecoded into the Char buffer (see\nGHC.IO.Handle.Internals.readTextDevice).  The only way there might be\nsome data left in the byte buffer is if there is a partial multi-byte\ncharacter sequence that cannot be decoded into a full character.\n\nNote that the buffering mode (haBufferMode) makes no difference when\nreading data into a Handle.  When reading, we can always just read all\nthe data there is available without blocking, decode it into the Char\nbuffer, and then provide it immediately to the caller.\n\n[note Buffered Writing]\n\nCharacters are written into the Char buffer by e.g. hPutStr.  At the\nend of the operation, or when the char buffer is full, the buffer is\ndecoded to the byte buffer (see writeCharBuffer).  This is so that we\ncan detect encoding errors at the right point.\n\nHence, the Char buffer is always empty between Handle operations.\n\n[note Buffer Sizing]\n\nThe char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE).\nThe byte buffer size is chosen by the underlying device (via its\nIODevice.newBuffer).  Hence the size of these buffers is not under\nuser control.\n\nThere are certain minimum sizes for these buffers imposed by the\nlibrary (but not checked):\n\n - we must be able to buffer at least one character, so that\n   hLookAhead can work\n\n - the byte buffer must be able to store at least one encoded\n   character in the current encoding (6 bytes?)\n\n - when reading, the char buffer must have room for two characters, so\n   that we can spot the \\r\\n sequence.\n\nHow do we implement hSetBuffering?\n\nFor reading, we have never used the user-supplied buffer size, because\nthere's no point: we always pass all available data to the reader\nimmediately.  Buffering would imply waiting until a certain amount of\ndata is available, which has no advantages.  So hSetBuffering is\nessentially a no-op for read handles, except that it turns on/off raw\nmode for the underlying device if necessary.\n\nFor writing, the buffering mode is handled by the write operations\nthemselves (hPutChar and hPutStr).  Every write ends with\nwriteCharBuffer, which checks whether the buffer should be flushed\naccording to the current buffering mode.  Additionally, we look for\nnewlines and flush if the mode is LineBuffering.\n\n[note Buffer Flushing]\n\n** Flushing the Char buffer\n\nWe must be able to flush the Char buffer, in order to implement\nhSetEncoding, and things like hGetBuf which want to read raw bytes.\n\nFlushing the Char buffer on a write Handle is easy: it is always empty.\n\nFlushing the Char buffer on a read Handle involves rewinding the byte\nbuffer to the point representing the next Char in the Char buffer.\nThis is done by\n\n - remembering the state of the byte buffer *before* the last decode\n\n - re-decoding the bytes that represent the chars already read from the\n   Char buffer.  This gives us the point in the byte buffer that\n   represents the *next* Char to be read.\n\nIn order for this to work, after readTextHandle we must NOT MODIFY THE\nCONTENTS OF THE BYTE OR CHAR BUFFERS, except to remove characters from\nthe Char buffer.\n\n** Flushing the byte buffer\n\nThe byte buffer can be flushed if the Char buffer has already been\nflushed (see above).  For a read Handle, flushing the byte buffer\nmeans seeking the device back by the number of bytes in the buffer,\nand hence it is only possible on a seekable Handle.\n\n-}\n\n-- ---------------------------------------------------------------------------\n-- Newline translation\n\n-- | The representation of a newline in the external file or stream.\ndata Newline = LF    -- ^ @\\'\\\\n\\'@\n             | CRLF  -- ^ @\\'\\\\r\\\\n\\'@\n             deriving ( Eq   -- ^ @since 4.2.0.0\n                      , Ord  -- ^ @since 4.3.0.0\n                      , Read -- ^ @since 4.3.0.0\n                      , Show -- ^ @since 4.3.0.0\n                      )\n\n-- | Specifies the translation, if any, of newline characters between\n-- internal Strings and the external file or stream.  Haskell Strings\n-- are assumed to represent newlines with the @\\'\\\\n\\'@ character; the\n-- newline mode specifies how to translate @\\'\\\\n\\'@ on output, and what to\n-- translate into @\\'\\\\n\\'@ on input.\ndata NewlineMode\n  = NewlineMode { inputNL :: Newline,\n                    -- ^ the representation of newlines on input\n                  outputNL :: Newline\n                    -- ^ the representation of newlines on output\n                 }\n             deriving ( Eq   -- ^ @since 4.2.0.0\n                      , Ord  -- ^ @since 4.3.0.0\n                      , Read -- ^ @since 4.3.0.0\n                      , Show -- ^ @since 4.3.0.0\n                      )\n\n-- | The native newline representation for the current platform: 'LF'\n-- on Unix systems, 'CRLF' on Windows.\nnativeNewline :: Newline\n#if defined(mingw32_HOST_OS)\nnativeNewline = CRLF\n#else\nnativeNewline = LF\n#endif\n\n-- | Map @\\'\\\\r\\\\n\\'@ into @\\'\\\\n\\'@ on input, and @\\'\\\\n\\'@ to the native newline\n-- represetnation on output.  This mode can be used on any platform, and\n-- works with text files using any newline convention.  The downside is\n-- that @readFile >>= writeFile@ might yield a different file.\n--\n-- > universalNewlineMode  = NewlineMode { inputNL  = CRLF,\n-- >                                       outputNL = nativeNewline }\n--\nuniversalNewlineMode :: NewlineMode\nuniversalNewlineMode  = NewlineMode { inputNL  = CRLF,\n                                      outputNL = nativeNewline }\n\n-- | Use the native newline representation on both input and output\n--\n-- > nativeNewlineMode  = NewlineMode { inputNL  = nativeNewline\n-- >                                    outputNL = nativeNewline }\n--\nnativeNewlineMode    :: NewlineMode\nnativeNewlineMode     = NewlineMode { inputNL  = nativeNewline,\n                                      outputNL = nativeNewline }\n\n-- | Do no newline translation at all.\n--\n-- > noNewlineTranslation  = NewlineMode { inputNL  = LF, outputNL = LF }\n--\nnoNewlineTranslation :: NewlineMode\nnoNewlineTranslation  = NewlineMode { inputNL  = LF, outputNL = LF }\n\n-- ---------------------------------------------------------------------------\n-- Show instance for Handles\n\n-- handle types are 'show'n when printing error msgs, so\n-- we provide a more user-friendly Show instance for it\n-- than the derived one.\n\n-- | @since 4.1.0.0\ninstance Show HandleType where\n  showsPrec _ t =\n    case t of\n      ClosedHandle      -> showString \"closed\"\n      SemiClosedHandle  -> showString \"semi-closed\"\n      ReadHandle        -> showString \"readable\"\n      WriteHandle       -> showString \"writable\"\n      AppendHandle      -> showString \"writable (append)\"\n      ReadWriteHandle   -> showString \"read-writable\"\n\n-- | @since 4.1.0.0\ninstance Show Handle where\n  showsPrec _ (FileHandle   file _)   = showHandle file\n  showsPrec _ (DuplexHandle file _ _) = showHandle file\n\nshowHandle :: FilePath -> String -> String\nshowHandle file = showString \"{handle: \" . showString file . showString \"}\"\n\n", "num_lines": 442}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE ConstraintKinds   #-}\n{-# LANGUAGE ImplicitParams    #-}\n{-# LANGUAGE KindSignatures    #-}\n{-# LANGUAGE PolyKinds         #-}\n{-# LANGUAGE RankNTypes        #-}\n{-# LANGUAGE Trustworthy       #-}\n\n{-# OPTIONS_HADDOCK not-home #-}\n-- we hide this module from haddock to enforce GHC.Stack as the main\n-- access point.\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Stack.Types\n-- Copyright   :  (c) The University of Glasgow 2015\n-- License     :  see libraries/ghc-prim/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- type definitions for implicit call-stacks.\n-- Use \"GHC.Stack\" from the base package instead of importing this\n-- module directly.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Stack.Types (\n    -- * Implicit call stacks\n    CallStack(..), HasCallStack,\n    emptyCallStack, freezeCallStack, fromCallSiteList,\n    getCallStack, pushCallStack,\n\n    -- * Source locations\n    SrcLoc(..)\n  ) where\n\n{-\nIdeally these would live in GHC.Stack but sadly they can't due to this\nimport cycle,\n\n    Module imports form a cycle:\n           module \u00e2\u20ac\u02dcGHC.Base\u00e2\u20ac\u2122 (libraries/base/GHC/Base.hs)\n          imports \u00e2\u20ac\u02dcGHC.Err\u00e2\u20ac\u2122 (libraries/base/GHC/Err.hs)\n    which imports \u00e2\u20ac\u02dcGHC.Stack\u00e2\u20ac\u2122 (libraries/base/dist-install/build/GHC/Stack.hs)\n    which imports \u00e2\u20ac\u02dcGHC.Base\u00e2\u20ac\u02dc (libraries/base/GHC/Base.hs)\n-}\n\nimport GHC.Classes (Eq)\nimport GHC.Types (Char, Int)\n\n-- Make implicit dependency known to build system\nimport GHC.Tuple ()   -- See Note [Depend on GHC.Tuple] in GHC.Base\nimport GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base\nimport GHC.Natural () -- See Note [Depend on GHC.Natural] in GHC.Base\n\n----------------------------------------------------------------------\n-- Explicit call-stacks built via ImplicitParams\n----------------------------------------------------------------------\n\n-- | Request a CallStack.\n--\n-- NOTE: The implicit parameter @?callStack :: CallStack@ is an\n-- implementation detail and __should not__ be considered part of the\n-- 'CallStack' API, we may decide to change the implementation in the\n-- future.\n--\n-- @since 4.9.0.0\ntype HasCallStack = (?callStack :: CallStack)\n\n-- | 'CallStack's are a lightweight method of obtaining a\n-- partial call-stack at any point in the program.\n--\n-- A function can request its call-site with the 'HasCallStack' constraint.\n-- For example, we can define\n--\n-- @\n-- putStrLnWithCallStack :: HasCallStack => String -> IO ()\n-- @\n--\n-- as a variant of @putStrLn@ that will get its call-site and print it,\n-- along with the string given as argument. We can access the\n-- call-stack inside @putStrLnWithCallStack@ with 'GHC.Stack.callStack'.\n--\n-- @\n-- putStrLnWithCallStack :: HasCallStack => String -> IO ()\n-- putStrLnWithCallStack msg = do\n--   putStrLn msg\n--   putStrLn (prettyCallStack callStack)\n-- @\n--\n-- Thus, if we call @putStrLnWithCallStack@ we will get a formatted call-stack\n-- alongside our string.\n--\n--\n-- >>> putStrLnWithCallStack \"hello\"\n-- hello\n-- CallStack (from HasCallStack):\n--   putStrLnWithCallStack, called at <interactive>:2:1 in interactive:Ghci1\n--\n--\n-- GHC solves 'HasCallStack' constraints in three steps:\n--\n-- 1. If there is a 'CallStack' in scope -- i.e. the enclosing function\n--    has a 'HasCallStack' constraint -- GHC will append the new\n--    call-site to the existing 'CallStack'.\n--\n-- 2. If there is no 'CallStack' in scope -- e.g. in the GHCi session\n--    above -- and the enclosing definition does not have an explicit\n--    type signature, GHC will infer a 'HasCallStack' constraint for the\n--    enclosing definition (subject to the monomorphism restriction).\n--\n-- 3. If there is no 'CallStack' in scope and the enclosing definition\n--    has an explicit type signature, GHC will solve the 'HasCallStack'\n--    constraint for the singleton 'CallStack' containing just the\n--    current call-site.\n--\n-- 'CallStack's do not interact with the RTS and do not require compilation\n-- with @-prof@. On the other hand, as they are built up explicitly via the\n-- 'HasCallStack' constraints, they will generally not contain as much\n-- information as the simulated call-stacks maintained by the RTS.\n--\n-- A 'CallStack' is a @[(String, SrcLoc)]@. The @String@ is the name of\n-- function that was called, the 'SrcLoc' is the call-site. The list is\n-- ordered with the most recently called function at the head.\n--\n-- NOTE: The intrepid user may notice that 'HasCallStack' is just an\n-- alias for an implicit parameter @?callStack :: CallStack@. This is an\n-- implementation detail and __should not__ be considered part of the\n-- 'CallStack' API, we may decide to change the implementation in the\n-- future.\n--\n-- @since 4.8.1.0\ndata CallStack\n  = EmptyCallStack\n  | PushCallStack [Char] SrcLoc CallStack\n  | FreezeCallStack CallStack\n    -- ^ Freeze the stack at the given @CallStack@, preventing any further\n    -- call-sites from being pushed onto it.\n\n  -- See Note [Overview of implicit CallStacks]\n\n-- | Extract a list of call-sites from the 'CallStack'.\n--\n-- The list is ordered by most recent call.\n--\n-- @since 4.8.1.0\ngetCallStack :: CallStack -> [([Char], SrcLoc)]\ngetCallStack stk = case stk of\n  EmptyCallStack            -> []\n  PushCallStack fn loc stk' -> (fn,loc) : getCallStack stk'\n  FreezeCallStack stk'      -> getCallStack stk'\n\n-- | Convert a list of call-sites to a 'CallStack'.\n--\n-- @since 4.9.0.0\nfromCallSiteList :: [([Char], SrcLoc)] -> CallStack\nfromCallSiteList ((fn,loc):cs) = PushCallStack fn loc (fromCallSiteList cs)\nfromCallSiteList []            = EmptyCallStack\n\n-- Note [Definition of CallStack]\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n-- CallStack is defined very early in base because it is\n-- used by error and undefined. At this point in the dependency graph,\n-- we do not have enough functionality to (conveniently) write a nice\n-- pretty-printer for CallStack. The sensible place to define the\n-- pretty-printer would be GHC.Stack, which is the main access point,\n-- but unfortunately GHC.Stack imports GHC.Exception, which *needs*\n-- the pretty-printer. So the CallStack type and functions are split\n-- between three modules:\n--\n-- 1. GHC.Stack.Types: defines the type and *simple* functions\n-- 2. GHC.Exception: defines the pretty-printer\n-- 3. GHC.Stack: exports everything and acts as the main access point\n\n\n-- | Push a call-site onto the stack.\n--\n-- This function has no effect on a frozen 'CallStack'.\n--\n-- @since 4.9.0.0\npushCallStack :: ([Char], SrcLoc) -> CallStack -> CallStack\npushCallStack (fn, loc) stk = case stk of\n  FreezeCallStack _ -> stk\n  _                 -> PushCallStack fn loc stk\n{-# INLINE pushCallStack #-}\n\n\n-- | The empty 'CallStack'.\n--\n-- @since 4.9.0.0\nemptyCallStack :: CallStack\nemptyCallStack = EmptyCallStack\n{-# INLINE emptyCallStack #-}\n\n\n-- | Freeze a call-stack, preventing any further call-sites from being appended.\n--\n-- prop> pushCallStack callSite (freezeCallStack callStack) = freezeCallStack callStack\n--\n-- @since 4.9.0.0\nfreezeCallStack :: CallStack -> CallStack\nfreezeCallStack stk = FreezeCallStack stk\n{-# INLINE freezeCallStack #-}\n\n\n-- | A single location in the source code.\n--\n-- @since 4.8.1.0\ndata SrcLoc = SrcLoc\n  { srcLocPackage   :: [Char]\n  , srcLocModule    :: [Char]\n  , srcLocFile      :: [Char]\n  , srcLocStartLine :: Int\n  , srcLocStartCol  :: Int\n  , srcLocEndLine   :: Int\n  , srcLocEndCol    :: Int\n  } deriving Eq -- ^ @since 4.9.0.0\n", "num_lines": 220}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- |\n-- Module      :  GHC.StaticPtr\n-- Copyright   :  (C) 2016 I/O Tweag\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Internal definitions needed for compiling static forms.\n--\n\n-- By omitting interface pragmas, we drop the strictness annotations\n-- which otherwise would bias GHC to conclude that any code using\n-- the static form would fail.\n{-# OPTIONS_GHC -fomit-interface-pragmas #-}\nmodule GHC.StaticPtr.Internal (makeStatic) where\n\nimport GHC.StaticPtr(StaticPtr)\n\n-- 'makeStatic' should never be called by the user.\n-- See Note [Grand plan for static forms] in StaticPtrTable.\n\nmakeStatic :: (Int, Int) -> a -> StaticPtr a\nmakeStatic (line, col) _ =\n    error $ \"GHC bug - makeStatic: Unresolved static form at line \"\n            ++ show line ++ \", column \" ++ show col ++ \".\"\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Numeric.Natural\n-- Copyright   :  (C) 2014 Herbert Valerio Riedel,\n--                (C) 2011 Edward Kmett\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- The arbitrary-precision 'Natural' number type.\n--\n-- @since 4.8.0.0\n-----------------------------------------------------------------------------\n\nmodule Numeric.Natural\n    ( Natural\n    ) where\n\nimport GHC.Natural\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Environment\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Miscellaneous information about the system environment.\n--\n-----------------------------------------------------------------------------\n\nmodule System.Environment\n    (\n      getArgs,\n      getProgName,\n      getExecutablePath,\n      getEnv,\n      lookupEnv,\n      setEnv,\n      unsetEnv,\n      withArgs,\n      withProgName,\n      getEnvironment,\n  ) where\n\nimport Foreign\nimport Foreign.C\nimport System.IO.Error (mkIOError)\nimport Control.Exception.Base (bracket_, throwIO)\n#if defined(mingw32_HOST_OS)\nimport Control.Exception.Base (bracket)\n#endif\n-- import GHC.IO\nimport GHC.IO.Exception\nimport qualified GHC.Foreign as GHC\nimport Control.Monad\n#if defined(mingw32_HOST_OS)\nimport GHC.IO.Encoding (argvEncoding)\nimport GHC.Windows\n#else\nimport GHC.IO.Encoding (getFileSystemEncoding, argvEncoding)\nimport System.Posix.Internals (withFilePath)\n#endif\n\nimport System.Environment.ExecutablePath\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\n#include \"HsBaseConfig.h\"\n\n-- ---------------------------------------------------------------------------\n-- getArgs, getProgName, getEnv\n\n-- | Computation 'getArgs' returns a list of the program's command\n-- line arguments (not including the program name).\ngetArgs :: IO [String]\ngetArgs =\n  alloca $ \\ p_argc ->\n  alloca $ \\ p_argv -> do\n   getProgArgv p_argc p_argv\n   p    <- fromIntegral `liftM` peek p_argc\n   argv <- peek p_argv\n   enc <- argvEncoding\n   peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)\n\n\nforeign import ccall unsafe \"getProgArgv\"\n  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()\n\n{-|\nComputation 'getProgName' returns the name of the program as it was\ninvoked.\n\nHowever, this is hard-to-impossible to implement on some non-Unix\nOSes, so instead, for maximum portability, we just return the leafname\nof the program as invoked. Even then there are some differences\nbetween platforms: on Windows, for example, a program invoked as foo\nis probably really @FOO.EXE@, and that is what 'getProgName' will return.\n-}\ngetProgName :: IO String\n-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat\ngetProgName =\n  alloca $ \\ p_argc ->\n  alloca $ \\ p_argv -> do\n     getProgArgv p_argc p_argv\n     argv <- peek p_argv\n     unpackProgName argv\n\nunpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]\nunpackProgName argv = do\n  enc <- argvEncoding\n  s <- peekElemOff argv 0 >>= GHC.peekCString enc\n  return (basename s)\n\nbasename :: FilePath -> FilePath\nbasename f = go f f\n where\n  go acc [] = acc\n  go acc (x:xs)\n    | isPathSeparator x = go xs xs\n    | otherwise         = go acc xs\n\n  isPathSeparator :: Char -> Bool\n  isPathSeparator '/'  = True\n#if defined(mingw32_HOST_OS)\n  isPathSeparator '\\\\' = True\n#endif\n  isPathSeparator _    = False\n\n\n-- | Computation 'getEnv' @var@ returns the value\n-- of the environment variable @var@. For the inverse, the\n-- `System.Environment.setEnv` function can be used.\n--\n-- This computation may fail with:\n--\n--  * 'System.IO.Error.isDoesNotExistError' if the environment variable\n--    does not exist.\n\ngetEnv :: String -> IO String\ngetEnv name = lookupEnv name >>= maybe handleError return\n  where\n#if defined(mingw32_HOST_OS)\n    handleError = do\n        err <- c_GetLastError\n        if err == eRROR_ENVVAR_NOT_FOUND\n            then ioe_missingEnvVar name\n            else throwGetLastError \"getEnv\"\n\neRROR_ENVVAR_NOT_FOUND :: DWORD\neRROR_ENVVAR_NOT_FOUND = 203\n\nforeign import WINDOWS_CCONV unsafe \"windows.h GetLastError\"\n  c_GetLastError:: IO DWORD\n\n#else\n    handleError = ioe_missingEnvVar name\n#endif\n\n-- | Return the value of the environment variable @var@, or @Nothing@ if\n-- there is no such value.\n--\n-- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'.\n--\n-- @since 4.6.0.0\nlookupEnv :: String -> IO (Maybe String)\n#if defined(mingw32_HOST_OS)\nlookupEnv name = withCWString name $ \\s -> try_size s 256\n  where\n    try_size s size = allocaArray (fromIntegral size) $ \\p_value -> do\n      res <- c_GetEnvironmentVariable s p_value size\n      case res of\n        0 -> return Nothing\n        _ | res > size -> try_size s res -- Rare: size increased between calls to GetEnvironmentVariable\n          | otherwise  -> peekCWString p_value >>= return . Just\n\nforeign import WINDOWS_CCONV unsafe \"windows.h GetEnvironmentVariableW\"\n  c_GetEnvironmentVariable :: LPWSTR -> LPWSTR -> DWORD -> IO DWORD\n#else\nlookupEnv name =\n    withCString name $ \\s -> do\n      litstring <- c_getenv s\n      if litstring /= nullPtr\n        then do enc <- getFileSystemEncoding\n                result <- GHC.peekCString enc litstring\n                return $ Just result\n        else return Nothing\n\nforeign import ccall unsafe \"getenv\"\n   c_getenv :: CString -> IO (Ptr CChar)\n#endif\n\nioe_missingEnvVar :: String -> IO a\nioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing \"getEnv\"\n    \"no environment variable\" Nothing (Just name))\n\n-- | @setEnv name value@ sets the specified environment variable to @value@.\n--\n-- Early versions of this function operated under the mistaken belief that\n-- setting an environment variable to the /empty string/ on Windows removes\n-- that environment variable from the environment.  For the sake of\n-- compatibility, it adopted that behavior on POSIX.  In particular\n--\n-- @\n-- setEnv name \\\"\\\"\n-- @\n--\n-- has the same effect as\n--\n-- @\n-- `unsetEnv` name\n-- @\n--\n-- If you'd like to be able to set environment variables to blank strings,\n-- use `System.Environment.Blank.setEnv`.\n--\n-- Throws `Control.Exception.IOException` if @name@ is the empty string or\n-- contains an equals sign.\n--\n-- @since 4.7.0.0\nsetEnv :: String -> String -> IO ()\nsetEnv key_ value_\n  | null key       = throwIO (mkIOError InvalidArgument \"setEnv\" Nothing Nothing)\n  | '=' `elem` key = throwIO (mkIOError InvalidArgument \"setEnv\" Nothing Nothing)\n  | null value     = unsetEnv key\n  | otherwise      = setEnv_ key value\n  where\n    key   = takeWhile (/= '\\NUL') key_\n    value = takeWhile (/= '\\NUL') value_\n\nsetEnv_ :: String -> String -> IO ()\n#if defined(mingw32_HOST_OS)\nsetEnv_ key value = withCWString key $ \\k -> withCWString value $ \\v -> do\n  success <- c_SetEnvironmentVariable k v\n  unless success (throwGetLastError \"setEnv\")\n\nforeign import WINDOWS_CCONV unsafe \"windows.h SetEnvironmentVariableW\"\n  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool\n#else\n\n-- NOTE: The 'setenv()' function is not available on all systems, hence we use\n-- 'putenv()'.  This leaks memory, but so do common implementations of\n-- 'setenv()' (AFAIK).\nsetEnv_ k v = putEnv (k ++ \"=\" ++ v)\n\nputEnv :: String -> IO ()\nputEnv keyvalue = do\n  s <- getFileSystemEncoding >>= (`GHC.newCString` keyvalue)\n  -- IMPORTANT: Do not free `s` after calling putenv!\n  --\n  -- According to SUSv2, the string passed to putenv becomes part of the\n  -- environment.\n  throwErrnoIf_ (/= 0) \"putenv\" (c_putenv s)\n\nforeign import ccall unsafe \"putenv\" c_putenv :: CString -> IO CInt\n#endif\n\n-- | @unsetEnv name@ removes the specified environment variable from the\n-- environment of the current process.\n--\n-- Throws `Control.Exception.IOException` if @name@ is the empty string or\n-- contains an equals sign.\n--\n-- @since 4.7.0.0\nunsetEnv :: String -> IO ()\n#if defined(mingw32_HOST_OS)\nunsetEnv key = withCWString key $ \\k -> do\n  success <- c_SetEnvironmentVariable k nullPtr\n  unless success $ do\n    -- We consider unsetting an environment variable that does not exist not as\n    -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND.\n    err <- c_GetLastError\n    unless (err == eRROR_ENVVAR_NOT_FOUND) $ do\n      throwGetLastError \"unsetEnv\"\n#else\n\n#if defined(HAVE_UNSETENV)\nunsetEnv key = withFilePath key (throwErrnoIf_ (/= 0) \"unsetEnv\" . c_unsetenv)\nforeign import ccall unsafe \"__hsbase_unsetenv\" c_unsetenv :: CString -> IO CInt\n#else\nunsetEnv key = setEnv_ key \"\"\n#endif\n\n#endif\n\n{-|\n'withArgs' @args act@ - while executing action @act@, have 'getArgs'\nreturn @args@.\n-}\nwithArgs :: [String] -> IO a -> IO a\nwithArgs xs act = do\n   p <- System.Environment.getProgName\n   withArgv (p:xs) act\n\n{-|\n'withProgName' @name act@ - while executing action @act@,\nhave 'getProgName' return @name@.\n-}\nwithProgName :: String -> IO a -> IO a\nwithProgName nm act = do\n   xs <- System.Environment.getArgs\n   withArgv (nm:xs) act\n\n-- Worker routine which marshals and replaces an argv vector for\n-- the duration of an action.\n\nwithArgv :: [String] -> IO a -> IO a\nwithArgv = withProgArgv\n\nwithProgArgv :: [String] -> IO a -> IO a\nwithProgArgv new_args act = do\n  pName <- System.Environment.getProgName\n  existing_args <- System.Environment.getArgs\n  bracket_ (setProgArgv new_args)\n           (setProgArgv (pName:existing_args))\n           act\n\nsetProgArgv :: [String] -> IO ()\nsetProgArgv argv = do\n  enc <- argvEncoding\n  GHC.withCStringsLen enc argv $ \\len css ->\n    c_setProgArgv (fromIntegral len) css\n\n-- setProgArgv copies the arguments\nforeign import ccall unsafe \"setProgArgv\"\n  c_setProgArgv  :: CInt -> Ptr CString -> IO ()\n\n-- |'getEnvironment' retrieves the entire environment as a\n-- list of @(key,value)@ pairs.\n--\n-- If an environment entry does not contain an @\\'=\\'@ character,\n-- the @key@ is the whole entry and the @value@ is the empty string.\ngetEnvironment :: IO [(String, String)]\n\n#if defined(mingw32_HOST_OS)\ngetEnvironment = bracket c_GetEnvironmentStrings c_FreeEnvironmentStrings $ \\pBlock ->\n    if pBlock == nullPtr then return []\n     else go pBlock\n  where\n    go pBlock = do\n        -- The block is terminated by a null byte where there\n        -- should be an environment variable of the form X=Y\n        c <- peek pBlock\n        if c == 0 then return []\n         else do\n          -- Seek the next pair (or terminating null):\n          pBlock' <- seekNull pBlock False\n          -- We now know the length in bytes, but ignore it when\n          -- getting the actual String:\n          str <- peekCWString pBlock\n          fmap (divvy str :) $ go pBlock'\n\n    -- Returns pointer to the byte *after* the next null\n    seekNull pBlock done = do\n        let pBlock' = pBlock `plusPtr` sizeOf (undefined :: CWchar)\n        if done then return pBlock'\n         else do\n           c <- peek pBlock'\n           seekNull pBlock' (c == (0 :: Word8 ))\n\nforeign import WINDOWS_CCONV unsafe \"windows.h GetEnvironmentStringsW\"\n  c_GetEnvironmentStrings :: IO (Ptr CWchar)\n\nforeign import WINDOWS_CCONV unsafe \"windows.h FreeEnvironmentStringsW\"\n  c_FreeEnvironmentStrings :: Ptr CWchar -> IO Bool\n#else\ngetEnvironment = do\n   pBlock <- getEnvBlock\n   if pBlock == nullPtr then return []\n    else do\n      enc <- getFileSystemEncoding\n      stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString enc)\n      return (map divvy stuff)\n\nforeign import ccall unsafe \"__hscore_environ\"\n  getEnvBlock :: IO (Ptr CString)\n#endif\n\ndivvy :: String -> (String, String)\ndivvy str =\n  case break (=='=') str of\n    (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)\n    (name,_:value) -> (name,value)\n", "num_lines": 378}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Exit\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Exiting the program.\n--\n-----------------------------------------------------------------------------\n\nmodule System.Exit\n    (\n      ExitCode(ExitSuccess,ExitFailure)\n    , exitWith\n    , exitFailure\n    , exitSuccess\n    , die\n  ) where\n\nimport System.IO\n\nimport GHC.IO\nimport GHC.IO.Exception\n\n-- ---------------------------------------------------------------------------\n-- exitWith\n\n-- | Computation 'exitWith' @code@ throws 'ExitCode' @code@.\n-- Normally this terminates the program, returning @code@ to the\n-- program's caller.\n--\n-- On program termination, the standard 'Handle's 'stdout' and\n-- 'stderr' are flushed automatically; any other buffered 'Handle's\n-- need to be flushed manually, otherwise the buffered data will be\n-- discarded.\n--\n-- A program that fails in any other way is treated as if it had\n-- called 'exitFailure'.\n-- A program that terminates successfully without calling 'exitWith'\n-- explicitly is treated as if it had called 'exitWith' 'ExitSuccess'.\n--\n-- As an 'ExitCode' is not an 'IOError', 'exitWith' bypasses\n-- the error handling in the 'IO' monad and cannot be intercepted by\n-- 'catch' from the \"Prelude\".  However it is a 'Control.Exception.SomeException', and can\n-- be caught using the functions of \"Control.Exception\".  This means\n-- that cleanup computations added with 'Control.Exception.bracket'\n-- (from \"Control.Exception\") are also executed properly on 'exitWith'.\n--\n-- Note: in GHC, 'exitWith' should be called from the main program\n-- thread in order to exit the process.  When called from another\n-- thread, 'exitWith' will throw an 'ExitException' as normal, but the\n-- exception will not cause the process itself to exit.\n--\nexitWith :: ExitCode -> IO a\nexitWith ExitSuccess = throwIO ExitSuccess\nexitWith code@(ExitFailure n)\n  | n /= 0 = throwIO code\n  | otherwise = ioError (IOError Nothing InvalidArgument \"exitWith\" \"ExitFailure 0\" Nothing Nothing)\n\n-- | The computation 'exitFailure' is equivalent to\n-- 'exitWith' @(@'ExitFailure' /exitfail/@)@,\n-- where /exitfail/ is implementation-dependent.\nexitFailure :: IO a\nexitFailure = exitWith (ExitFailure 1)\n\n-- | The computation 'exitSuccess' is equivalent to\n-- 'exitWith' 'ExitSuccess', It terminates the program\n-- successfully.\nexitSuccess :: IO a\nexitSuccess = exitWith ExitSuccess\n\n-- | Write given error message to `stderr` and terminate with `exitFailure`.\n--\n-- @since 4.8.0.0\ndie :: String -> IO a\ndie err = hPutStrLn stderr err >> exitFailure\n", "num_lines": 83}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE CPP #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Info\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Information about the characteristics of the host \n-- system lucky enough to run your program.\n--\n-----------------------------------------------------------------------------\n\nmodule System.Info\n   (\n       os,\n       arch,\n       compilerName,\n       compilerVersion\n   ) where\n\nimport Data.Version\n\n-- | The version of 'compilerName' with which the program was compiled\n-- or is being interpreted.\ncompilerVersion :: Version\ncompilerVersion = Version [major, minor] []\n  where (major, minor) = compilerVersionRaw `divMod` 100\n\n#include \"ghcplatform.h\"\n\n-- | The operating system on which the program is running.\nos :: String\nos = HOST_OS\n\n-- | The machine architecture on which the program is running.\narch :: String\narch = HOST_ARCH\n\n-- | The Haskell implementation with which the program was compiled\n-- or is being interpreted.\ncompilerName :: String\ncompilerName = \"ghc\"\n\ncompilerVersionRaw :: Int\ncompilerVersionRaw = __GLASGOW_HASKELL__\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.IO\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  stable\n-- Portability :  portable\n--\n-- The standard IO library.\n--\n-----------------------------------------------------------------------------\n\nmodule System.IO (\n    -- * The IO monad\n\n    IO,\n    fixIO,\n\n    -- * Files and handles\n\n    FilePath,\n\n    Handle,             -- abstract, instance of: Eq, Show.\n\n    -- | GHC note: a 'Handle' will be automatically closed when the garbage\n    -- collector detects that it has become unreferenced by the program.\n    -- However, relying on this behaviour is not generally recommended:\n    -- the garbage collector is unpredictable.  If possible, use\n    -- an explicit 'hClose' to close 'Handle's when they are no longer\n    -- required.  GHC does not currently attempt to free up file\n    -- descriptors when they have run out, it is your responsibility to\n    -- ensure that this doesn't happen.\n\n    -- ** Standard handles\n\n    -- | Three handles are allocated during program initialisation,\n    -- and are initially open.\n\n    stdin, stdout, stderr,\n\n    -- * Opening and closing files\n\n    -- ** Opening files\n\n    withFile,\n    openFile,\n    IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),\n\n    -- ** Closing files\n\n    hClose,\n\n    -- ** Special cases\n\n    -- | These functions are also exported by the \"Prelude\".\n\n    readFile,\n    writeFile,\n    appendFile,\n\n    -- ** File locking\n\n    -- $locking\n\n    -- * Operations on handles\n\n    -- ** Determining and changing the size of a file\n\n    hFileSize,\n    hSetFileSize,\n\n    -- ** Detecting the end of input\n\n    hIsEOF,\n    isEOF,\n\n    -- ** Buffering operations\n\n    BufferMode(NoBuffering,LineBuffering,BlockBuffering),\n    hSetBuffering,\n    hGetBuffering,\n    hFlush,\n\n    -- ** Repositioning handles\n\n    hGetPosn,\n    hSetPosn,\n    HandlePosn,                -- abstract, instance of: Eq, Show.\n\n    hSeek,\n    SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),\n    hTell,\n\n    -- ** Handle properties\n\n    hIsOpen, hIsClosed,\n    hIsReadable, hIsWritable,\n    hIsSeekable,\n\n    -- ** Terminal operations (not portable: GHC only)\n\n    hIsTerminalDevice,\n\n    hSetEcho,\n    hGetEcho,\n\n    -- ** Showing handle state (not portable: GHC only)\n\n    hShow,\n\n    -- * Text input and output\n\n    -- ** Text input\n\n    hWaitForInput,\n    hReady,\n    hGetChar,\n    hGetLine,\n    hLookAhead,\n    hGetContents,\n\n    -- ** Text output\n\n    hPutChar,\n    hPutStr,\n    hPutStrLn,\n    hPrint,\n\n    -- ** Special cases for standard input and output\n\n    -- | These functions are also exported by the \"Prelude\".\n\n    interact,\n    putChar,\n    putStr,\n    putStrLn,\n    print,\n    getChar,\n    getLine,\n    getContents,\n    readIO,\n    readLn,\n\n    -- * Binary input and output\n\n    withBinaryFile,\n    openBinaryFile,\n    hSetBinaryMode,\n    hPutBuf,\n    hGetBuf,\n    hGetBufSome,\n    hPutBufNonBlocking,\n    hGetBufNonBlocking,\n\n    -- * Temporary files\n\n    openTempFile,\n    openBinaryTempFile,\n    openTempFileWithDefaultPermissions,\n    openBinaryTempFileWithDefaultPermissions,\n\n    -- * Unicode encoding\\/decoding\n\n    -- | A text-mode 'Handle' has an associated 'TextEncoding', which\n    -- is used to decode bytes into Unicode characters when reading,\n    -- and encode Unicode characters into bytes when writing.\n    --\n    -- The default 'TextEncoding' is the same as the default encoding\n    -- on your system, which is also available as 'localeEncoding'.\n    -- (GHC note: on Windows, we currently do not support double-byte\n    -- encodings; if the console\\'s code page is unsupported, then\n    -- 'localeEncoding' will be 'latin1'.)\n    --\n    -- Encoding and decoding errors are always detected and reported,\n    -- except during lazy I/O ('hGetContents', 'getContents', and\n    -- 'readFile'), where a decoding error merely results in\n    -- termination of the character stream, as with other I/O errors.\n\n    hSetEncoding,\n    hGetEncoding,\n\n    -- ** Unicode encodings\n    TextEncoding,\n    latin1,\n    utf8, utf8_bom,\n    utf16, utf16le, utf16be,\n    utf32, utf32le, utf32be,\n    localeEncoding,\n    char8,\n    mkTextEncoding,\n\n    -- * Newline conversion\n\n    -- | In Haskell, a newline is always represented by the character\n    -- @\\'\\\\n\\'@.  However, in files and external character streams, a\n    -- newline may be represented by another character sequence, such\n    -- as @\\'\\\\r\\\\n\\'@.\n    --\n    -- A text-mode 'Handle' has an associated 'NewlineMode' that\n    -- specifies how to transate newline characters.  The\n    -- 'NewlineMode' specifies the input and output translation\n    -- separately, so that for instance you can translate @\\'\\\\r\\\\n\\'@\n    -- to @\\'\\\\n\\'@ on input, but leave newlines as @\\'\\\\n\\'@ on output.\n    --\n    -- The default 'NewlineMode' for a 'Handle' is\n    -- 'nativeNewlineMode', which does no translation on Unix systems,\n    -- but translates @\\'\\\\r\\\\n\\'@ to @\\'\\\\n\\'@ and back on Windows.\n    --\n    -- Binary-mode 'Handle's do no newline translation at all.\n    --\n    hSetNewlineMode,\n    Newline(..), nativeNewline,\n    NewlineMode(..),\n    noNewlineTranslation, universalNewlineMode, nativeNewlineMode,\n  ) where\n\nimport Control.Exception.Base\n\nimport Data.Bits\nimport Data.Maybe\nimport Foreign.C.Error\n#if defined(mingw32_HOST_OS)\nimport Foreign.C.String\nimport Foreign.Ptr\nimport Foreign.Marshal.Alloc\nimport Foreign.Storable\n#endif\nimport Foreign.C.Types\nimport System.Posix.Internals\nimport System.Posix.Types\n\nimport GHC.Base\nimport GHC.List\n#ifndef mingw32_HOST_OS\nimport GHC.IORef\n#endif\nimport GHC.Num\nimport GHC.IO hiding ( bracket, onException )\nimport GHC.IO.IOMode\nimport GHC.IO.Handle.FD\nimport qualified GHC.IO.FD as FD\nimport GHC.IO.Handle\nimport GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn )\nimport GHC.IO.Exception ( userError )\nimport GHC.IO.Encoding\nimport Text.Read\nimport GHC.Show\nimport GHC.MVar\n\n-- -----------------------------------------------------------------------------\n-- Standard IO\n\n-- | Write a character to the standard output device\n-- (same as 'hPutChar' 'stdout').\n\nputChar         :: Char -> IO ()\nputChar c       =  hPutChar stdout c\n\n-- | Write a string to the standard output device\n-- (same as 'hPutStr' 'stdout').\n\nputStr          :: String -> IO ()\nputStr s        =  hPutStr stdout s\n\n-- | The same as 'putStr', but adds a newline character.\n\nputStrLn        :: String -> IO ()\nputStrLn s      =  hPutStrLn stdout s\n\n-- | The 'print' function outputs a value of any printable type to the\n-- standard output device.\n-- Printable types are those that are instances of class 'Show'; 'print'\n-- converts values to strings for output using the 'show' operation and\n-- adds a newline.\n--\n-- For example, a program to print the first 20 integers and their\n-- powers of 2 could be written as:\n--\n-- > main = print ([(n, 2^n) | n <- [0..19]])\n\nprint           :: Show a => a -> IO ()\nprint x         =  putStrLn (show x)\n\n-- | Read a character from the standard input device\n-- (same as 'hGetChar' 'stdin').\n\ngetChar         :: IO Char\ngetChar         =  hGetChar stdin\n\n-- | Read a line from the standard input device\n-- (same as 'hGetLine' 'stdin').\n\ngetLine         :: IO String\ngetLine         =  hGetLine stdin\n\n-- | The 'getContents' operation returns all user input as a single string,\n-- which is read lazily as it is needed\n-- (same as 'hGetContents' 'stdin').\n\ngetContents     :: IO String\ngetContents     =  hGetContents stdin\n\n-- | The 'interact' function takes a function of type @String->String@\n-- as its argument.  The entire input from the standard input device is\n-- passed to this function as its argument, and the resulting string is\n-- output on the standard output device.\n\ninteract        ::  (String -> String) -> IO ()\ninteract f      =   do s <- getContents\n                       putStr (f s)\n\n-- | The 'readFile' function reads a file and\n-- returns the contents of the file as a string.\n-- The file is read lazily, on demand, as with 'getContents'.\n\nreadFile        :: FilePath -> IO String\nreadFile name   =  openFile name ReadMode >>= hGetContents\n\n-- | The computation 'writeFile' @file str@ function writes the string @str@,\n-- to the file @file@.\nwriteFile :: FilePath -> String -> IO ()\nwriteFile f txt = withFile f WriteMode (\\ hdl -> hPutStr hdl txt)\n\n-- | The computation 'appendFile' @file str@ function appends the string @str@,\n-- to the file @file@.\n--\n-- Note that 'writeFile' and 'appendFile' write a literal string\n-- to a file.  To write a value of any printable type, as with 'print',\n-- use the 'show' function to convert the value to a string first.\n--\n-- > main = appendFile \"squares\" (show [(x,x*x) | x <- [0,0.1..2]])\n\nappendFile      :: FilePath -> String -> IO ()\nappendFile f txt = withFile f AppendMode (\\ hdl -> hPutStr hdl txt)\n\n-- | The 'readLn' function combines 'getLine' and 'readIO'.\n\nreadLn          :: Read a => IO a\nreadLn          =  do l <- getLine\n                      r <- readIO l\n                      return r\n\n-- | The 'readIO' function is similar to 'read' except that it signals\n-- parse failure to the 'IO' monad instead of terminating the program.\n\nreadIO          :: Read a => String -> IO a\nreadIO s        =  case (do { (x,t) <- reads s ;\n                              (\"\",\"\") <- lex t ;\n                              return x }) of\n                        [x]    -> return x\n                        []     -> ioError (userError \"Prelude.readIO: no parse\")\n                        _      -> ioError (userError \"Prelude.readIO: ambiguous parse\")\n\n-- | The Unicode encoding of the current locale\n--\n-- This is the initial locale encoding: if it has been subsequently changed by\n-- 'GHC.IO.Encoding.setLocaleEncoding' this value will not reflect that change.\nlocaleEncoding :: TextEncoding\nlocaleEncoding = initLocaleEncoding\n\n-- | Computation 'hReady' @hdl@ indicates whether at least one item is\n-- available for input from handle @hdl@.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isEOFError' if the end of file has been reached.\n\nhReady          :: Handle -> IO Bool\nhReady h        =  hWaitForInput h 0\n\n-- | Computation 'hPrint' @hdl t@ writes the string representation of @t@\n-- given by the 'shows' function to the file or channel managed by @hdl@\n-- and appends a newline.\n--\n-- This operation may fail with:\n--\n--  * 'System.IO.Error.isFullError' if the device is full; or\n--\n--  * 'System.IO.Error.isPermissionError' if another system resource limit\n--    would be exceeded.\n\nhPrint          :: Show a => Handle -> a -> IO ()\nhPrint hdl      =  hPutStrLn hdl . show\n\n-- | @'withFile' name mode act@ opens a file using 'openFile' and passes\n-- the resulting handle to the computation @act@.  The handle will be\n-- closed on exit from 'withFile', whether by normal termination or by\n-- raising an exception.  If closing the handle raises an exception, then\n-- this exception will be raised by 'withFile' rather than any exception\n-- raised by @act@.\nwithFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r\nwithFile name mode = bracket (openFile name mode) hClose\n\n-- | @'withBinaryFile' name mode act@ opens a file using 'openBinaryFile'\n-- and passes the resulting handle to the computation @act@.  The handle\n-- will be closed on exit from 'withBinaryFile', whether by normal\n-- termination or by raising an exception.\nwithBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r\nwithBinaryFile name mode = bracket (openBinaryFile name mode) hClose\n\n-- ---------------------------------------------------------------------------\n-- fixIO\n\n-- | The implementation of 'Control.Monad.Fix.mfix' for 'IO'. If the function\n-- passed to 'fixIO' inspects its argument, the resulting action will throw\n-- 'FixIOException'.\nfixIO :: (a -> IO a) -> IO a\nfixIO k = do\n    m <- newEmptyMVar\n    ans <- unsafeDupableInterleaveIO\n             (readMVar m `catch` \\BlockedIndefinitelyOnMVar ->\n                                    throwIO FixIOException)\n    result <- k ans\n    putMVar m result\n    return result\n\n-- NOTE: we do our own explicit black holing here, because GHC's lazy\n-- blackholing isn't enough.  In an infinite loop, GHC may run the IO\n-- computation a few times before it notices the loop, which is wrong.\n--\n-- NOTE2: the explicit black-holing with an IORef ran into trouble\n-- with multiple threads (see #5421), so now we use an MVar. We used\n-- to use takeMVar with unsafeInterleaveIO. This, however, uses noDuplicate#,\n-- which is not particularly cheap. Better to use readMVar, which can be\n-- performed in multiple threads safely, and to use unsafeDupableInterleaveIO\n-- to avoid the noDuplicate cost.\n--\n-- What we'd ideally want is probably an IVar, but we don't quite have those.\n-- STM TVars look like an option at first, but I don't think they are:\n-- we'd need to be able to write to the variable in an IO context, which can\n-- only be done using 'atomically', and 'atomically' is not allowed within\n-- unsafePerformIO. We can't know if someone will try to use the result\n-- of fixIO with unsafePerformIO!\n--\n-- See also System.IO.Unsafe.unsafeFixIO.\n--\n\n-- | The function creates a temporary file in ReadWrite mode.\n-- The created file isn\\'t deleted automatically, so you need to delete it manually.\n--\n-- The file is created with permissions such that only the current\n-- user can read\\/write it.\n--\n-- With some exceptions (see below), the file will be created securely\n-- in the sense that an attacker should not be able to cause\n-- openTempFile to overwrite another file on the filesystem using your\n-- credentials, by putting symbolic links (on Unix) in the place where\n-- the temporary file is to be created.  On Unix the @O_CREAT@ and\n-- @O_EXCL@ flags are used to prevent this attack, but note that\n-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you\n-- rely on this behaviour it is best to use local filesystems only.\n--\nopenTempFile :: FilePath   -- ^ Directory in which to create the file\n             -> String     -- ^ File name template. If the template is \\\"foo.ext\\\" then\n                           -- the created file will be \\\"fooXXX.ext\\\" where XXX is some\n                           -- random number. Note that this should not contain any path\n                           -- separator characters.\n             -> IO (FilePath, Handle)\nopenTempFile tmp_dir template\n    = openTempFile' \"openTempFile\" tmp_dir template False 0o600\n\n-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.\nopenBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)\nopenBinaryTempFile tmp_dir template\n    = openTempFile' \"openBinaryTempFile\" tmp_dir template True 0o600\n\n-- | Like 'openTempFile', but uses the default file permissions\nopenTempFileWithDefaultPermissions :: FilePath -> String\n                                   -> IO (FilePath, Handle)\nopenTempFileWithDefaultPermissions tmp_dir template\n    = openTempFile' \"openTempFileWithDefaultPermissions\" tmp_dir template False 0o666\n\n-- | Like 'openBinaryTempFile', but uses the default file permissions\nopenBinaryTempFileWithDefaultPermissions :: FilePath -> String\n                                         -> IO (FilePath, Handle)\nopenBinaryTempFileWithDefaultPermissions tmp_dir template\n    = openTempFile' \"openBinaryTempFileWithDefaultPermissions\" tmp_dir template True 0o666\n\nopenTempFile' :: String -> FilePath -> String -> Bool -> CMode\n              -> IO (FilePath, Handle)\nopenTempFile' loc tmp_dir template binary mode\n    | pathSeparator template\n    = fail $ \"openTempFile': Template string must not contain path separator characters: \"++template\n    | otherwise = findTempName\n  where\n    -- We split off the last extension, so we can use .foo.ext files\n    -- for temporary files (hidden on Unix OSes). Unfortunately we're\n    -- below filepath in the hierarchy here.\n    (prefix, suffix) =\n       case break (== '.') $ reverse template of\n         -- First case: template contains no '.'s. Just re-reverse it.\n         (rev_suffix, \"\")       -> (reverse rev_suffix, \"\")\n         -- Second case: template contains at least one '.'. Strip the\n         -- dot from the prefix and prepend it to the suffix (if we don't\n         -- do this, the unique number will get added after the '.' and\n         -- thus be part of the extension, which is wrong.)\n         (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)\n         -- Otherwise, something is wrong, because (break (== '.')) should\n         -- always return a pair with either the empty string or a string\n         -- beginning with '.' as the second component.\n         _                      -> errorWithoutStackTrace \"bug in System.IO.openTempFile\"\n#if defined(mingw32_HOST_OS)\n    findTempName = do\n      let label = if null prefix then \"ghc\" else prefix\n      withCWString tmp_dir $ \\c_tmp_dir ->\n        withCWString label $ \\c_template ->\n          withCWString suffix $ \\c_suffix ->\n            -- NOTE: revisit this when new I/O manager in place and use a UUID\n            --       based one when we are no longer MAX_PATH bound.\n            allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \\c_str -> do\n            res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0\n                                            c_str\n            if not res\n               then do errno <- getErrno\n                       ioError (errnoToIOError loc errno Nothing (Just tmp_dir))\n               else do filename <- peekCWString c_str\n                       handleResults filename\n\n    handleResults filename = do\n      let oflags1 = rw_flags .|. o_EXCL\n          binary_flags\n              | binary    = o_BINARY\n              | otherwise = 0\n          oflags = oflags1 .|. binary_flags\n      fd <- withFilePath filename $ \\ f -> c_open f oflags mode\n      case fd < 0 of\n        True -> do errno <- getErrno\n                   ioError (errnoToIOError loc errno Nothing (Just tmp_dir))\n        False ->\n          do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}\n                                     False{-is_socket-}\n                                     True{-is_nonblock-}\n\n             enc <- getLocaleEncoding\n             h <- mkHandleFromFD fD fd_type filename ReadWriteMode\n                                 False{-set non-block-} (Just enc)\n\n             return (filename, h)\n\nforeign import ccall \"getTempFileNameErrorNo\" c_getTempFileNameErrorNo\n  :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool\n\npathSeparator :: String -> Bool\npathSeparator template = any (\\x-> x == '/' || x == '\\\\') template\n\noutput_flags = std_flags\n#else /* else mingw32_HOST_OS */\n    findTempName = do\n      rs <- rand_string\n      let filename = prefix ++ rs ++ suffix\n          filepath = tmp_dir `combine` filename\n      r <- openNewFile filepath binary mode\n      case r of\n        FileExists -> findTempName\n        OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))\n        NewFileCreated fd -> do\n          (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}\n                               False{-is_socket-}\n                               True{-is_nonblock-}\n\n          enc <- getLocaleEncoding\n          h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)\n\n          return (filepath, h)\n\n      where\n        -- XXX bits copied from System.FilePath, since that's not available here\n        combine a b\n                  | null b = a\n                  | null a = b\n                  | pathSeparator [last a] = a ++ b\n                  | otherwise = a ++ [pathSeparatorChar] ++ b\n\ntempCounter :: IORef Int\ntempCounter = unsafePerformIO $ newIORef 0\n{-# NOINLINE tempCounter #-}\n\n-- build large digit-alike number\nrand_string :: IO String\nrand_string = do\n  r1 <- c_getpid\n  (r2, _) <- atomicModifyIORef'_ tempCounter (+1)\n  return $ show r1 ++ \"-\" ++ show r2\n\ndata OpenNewFileResult\n  = NewFileCreated CInt\n  | FileExists\n  | OpenNewError Errno\n\nopenNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult\nopenNewFile filepath binary mode = do\n  let oflags1 = rw_flags .|. o_EXCL\n\n      binary_flags\n        | binary    = o_BINARY\n        | otherwise = 0\n\n      oflags = oflags1 .|. binary_flags\n  fd <- withFilePath filepath $ \\ f ->\n          c_open f oflags mode\n  if fd < 0\n    then do\n      errno <- getErrno\n      case errno of\n        _ | errno == eEXIST -> return FileExists\n        _ -> return (OpenNewError errno)\n    else return (NewFileCreated fd)\n\n-- XXX Should use filepath library\npathSeparatorChar :: Char\npathSeparatorChar = '/'\n\npathSeparator :: String -> Bool\npathSeparator template = pathSeparatorChar `elem` template\n\noutput_flags = std_flags    .|. o_CREAT\n#endif /* mingw32_HOST_OS */\n\n-- XXX Copied from GHC.Handle\nstd_flags, output_flags, rw_flags :: CInt\nstd_flags    = o_NONBLOCK   .|. o_NOCTTY\nrw_flags     = output_flags .|. o_RDWR\n\n-- $locking\n-- Implementations should enforce as far as possible, at least locally to the\n-- Haskell process, multiple-reader single-writer locking on files.\n-- That is, /there may either be many handles on the same file which manage input, or just one handle on the file which manages output/.  If any\n-- open or semi-closed handle is managing a file for output, no new\n-- handle can be allocated for that file.  If any open or semi-closed\n-- handle is managing a file for input, new handles can only be allocated\n-- if they do not manage output.  Whether two files are the same is\n-- implementation-dependent, but they should normally be the same if they\n-- have the same absolute path name and neither has been renamed, for\n-- example.\n--\n-- /Warning/: the 'readFile' operation holds a semi-closed handle on\n-- the file until the entire contents of the file have been consumed.\n-- It follows that an attempt to write to a file (using 'writeFile', for\n-- example) that was earlier opened by 'readFile' will usually result in\n-- failure with 'System.IO.Error.isAlreadyInUseError'.\n", "num_lines": 646}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Mem\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Memory-related system things.\n--\n-----------------------------------------------------------------------------\n\n{-# LANGUAGE Trustworthy #-}\n-- allocation counter stuff is safe, but GHC.Conc.Sync is Unsafe\n\nmodule System.Mem\n       (\n       -- * Garbage collection\n         performGC\n       , performMajorGC\n       , performMinorGC\n\n        -- * Allocation counter and limits\n        , setAllocationCounter\n        , getAllocationCounter\n        , enableAllocationLimit\n        , disableAllocationLimit\n       ) where\n\nimport GHC.Conc.Sync\n\n-- | Triggers an immediate major garbage collection.\nperformGC :: IO ()\nperformGC = performMajorGC\n\n-- | Triggers an immediate major garbage collection.\n--\n-- @since 4.7.0.0\nforeign import ccall \"performMajorGC\" performMajorGC :: IO ()\n\n-- | Triggers an immediate minor garbage collection.\n--\n-- @since 4.7.0.0\nforeign import ccall \"performGC\" performMinorGC :: IO ()\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\n-------------------------------------------------------------------------------\n-- |\n-- Module      :  System.Timeout\n-- Copyright   :  (c) The University of Glasgow 2007\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable\n--\n-- Attach a timeout event to arbitrary 'IO' computations.\n--\n-------------------------------------------------------------------------------\n\nmodule System.Timeout ( timeout ) where\n\n#if !defined(mingw32_HOST_OS)\nimport Control.Monad\nimport GHC.Event           (getSystemTimerManager,\n                            registerTimeout, unregisterTimeout)\n#endif\n\nimport Control.Concurrent\nimport Control.Exception   (Exception(..), handleJust, bracket,\n                            uninterruptibleMask_,\n                            asyncExceptionToException,\n                            asyncExceptionFromException)\nimport Data.Unique         (Unique, newUnique)\n\n-- An internal type that is thrown as a dynamic exception to\n-- interrupt the running IO computation when the timeout has\n-- expired.\n\nnewtype Timeout = Timeout Unique deriving Eq -- ^ @since 4.0\n\n-- | @since 4.0\ninstance Show Timeout where\n    show _ = \"<<timeout>>\"\n\n-- Timeout is a child of SomeAsyncException\n-- | @since 4.7.0.0\ninstance Exception Timeout where\n  toException = asyncExceptionToException\n  fromException = asyncExceptionFromException\n\n-- |Wrap an 'IO' computation to time out and return @Nothing@ in case no result\n-- is available within @n@ microseconds (@1\\/10^6@ seconds). In case a result\n-- is available before the timeout expires, @Just a@ is returned. A negative\n-- timeout interval means \\\"wait indefinitely\\\". When specifying long timeouts,\n-- be careful not to exceed @maxBound :: Int@.\n--\n-- >>> timeout 1000000 (threadDelay 1000 *> pure \"finished on time\")\n-- Just \"finished on time\"\n--\n-- >>> timeout 10000 (threadDelay 100000 *> pure \"finished on time\")\n-- Nothing\n--\n-- The design of this combinator was guided by the objective that @timeout n f@\n-- should behave exactly the same as @f@ as long as @f@ doesn't time out. This\n-- means that @f@ has the same 'myThreadId' it would have without the timeout\n-- wrapper. Any exceptions @f@ might throw cancel the timeout and propagate\n-- further up. It also possible for @f@ to receive exceptions thrown to it by\n-- another thread.\n--\n-- A tricky implementation detail is the question of how to abort an @IO@\n-- computation. This combinator relies on asynchronous exceptions internally.\n-- The technique works very well for computations executing inside of the\n-- Haskell runtime system, but it doesn't work at all for non-Haskell code.\n-- Foreign function calls, for example, cannot be timed out with this\n-- combinator simply because an arbitrary C function cannot receive\n-- asynchronous exceptions. When @timeout@ is used to wrap an FFI call that\n-- blocks, no timeout event can be delivered until the FFI call returns, which\n-- pretty much negates the purpose of the combinator. In practice, however,\n-- this limitation is less severe than it may sound. Standard I\\/O functions\n-- like 'System.IO.hGetBuf', 'System.IO.hPutBuf', Network.Socket.accept, or\n-- 'System.IO.hWaitForInput' appear to be blocking, but they really don't\n-- because the runtime system uses scheduling mechanisms like @select(2)@ to\n-- perform asynchronous I\\/O, so it is possible to interrupt standard socket\n-- I\\/O or file I\\/O using this combinator.\ntimeout :: Int -> IO a -> IO (Maybe a)\ntimeout n f\n    | n <  0    = fmap Just f\n    | n == 0    = return Nothing\n#if !defined(mingw32_HOST_OS)\n    | rtsSupportsBoundThreads = do\n        -- In the threaded RTS, we use the Timer Manager to delay the\n        -- (fairly expensive) 'forkIO' call until the timeout has expired.\n        --\n        -- An additional thread is required for the actual delivery of\n        -- the Timeout exception because killThread (or another throwTo)\n        -- is the only way to reliably interrupt a throwTo in flight.\n        pid <- myThreadId\n        ex  <- fmap Timeout newUnique\n        tm  <- getSystemTimerManager\n        -- 'lock' synchronizes the timeout handler and the main thread:\n        --  * the main thread can disable the handler by writing to 'lock';\n        --  * the handler communicates the spawned thread's id through 'lock'.\n        -- These two cases are mutually exclusive.\n        lock <- newEmptyMVar\n        let handleTimeout = do\n                v <- isEmptyMVar lock\n                when v $ void $ forkIOWithUnmask $ \\unmask -> unmask $ do\n                    v2 <- tryPutMVar lock =<< myThreadId\n                    when v2 $ throwTo pid ex\n            cleanupTimeout key = uninterruptibleMask_ $ do\n                v <- tryPutMVar lock undefined\n                if v then unregisterTimeout tm key\n                     else takeMVar lock >>= killThread\n        handleJust (\\e -> if e == ex then Just () else Nothing)\n                   (\\_ -> return Nothing)\n                   (bracket (registerTimeout tm n handleTimeout)\n                            cleanupTimeout\n                            (\\_ -> fmap Just f))\n#endif\n    | otherwise = do\n        pid <- myThreadId\n        ex  <- fmap Timeout newUnique\n        handleJust (\\e -> if e == ex then Just () else Nothing)\n                   (\\_ -> return Nothing)\n                   (bracket (forkIOWithUnmask $ \\unmask ->\n                                 unmask $ threadDelay n >> throwTo pid ex)\n                            (uninterruptibleMask_ . killThread)\n                            (\\_ -> fmap Just f))\n        -- #7719 explains why we need uninterruptibleMask_ above.\n", "num_lines": 129}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Console.GetOpt\n-- Copyright   :  (c) Sven Panne 2002-2005\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- This library provides facilities for parsing the command-line options\n-- in a standalone program.  It is essentially a Haskell port of the GNU \n-- @getopt@ library.\n--\n-----------------------------------------------------------------------------\n\n{-\nSven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small\nchanges Dec. 1997)\n\nTwo rather obscure features are missing: The Bash 2.0 non-option hack\n(if you don't already know it, you probably don't want to hear about\nit...) and the recognition of long options with a single dash\n(e.g. '-help' is recognised as '--help', as long as there is no short\noption 'h').\n\nOther differences between GNU's getopt and this implementation:\n\n* To enforce a coherent description of options and arguments, there\n  are explanation fields in the option/argument descriptor.\n\n* Error messages are now more informative, but no longer POSIX\n  compliant... :-(\n\nAnd a final Haskell advertisement: The GNU C implementation uses well\nover 1100 lines, we need only 195 here, including a 46 line example! \n:-)\n-}\n\nmodule System.Console.GetOpt (\n   -- * GetOpt\n   getOpt, getOpt',\n   usageInfo,\n   ArgOrder(..),\n   OptDescr(..),\n   ArgDescr(..),\n\n   -- * Examples\n\n   -- |To hopefully illuminate the role of the different data structures,\n   -- here are the command-line options for a (very simple) compiler,\n   -- done in two different ways.\n   -- The difference arises because the type of 'getOpt' is\n   -- parameterized by the type of values derived from flags.\n\n   -- ** Interpreting flags as concrete values\n   -- $example1\n\n   -- ** Interpreting flags as transformations of an options record\n   -- $example2\n) where\n\nimport Data.List ( isPrefixOf, find )\n\n-- |What to do with options following non-options\ndata ArgOrder a\n  = RequireOrder                -- ^ no option processing after first non-option\n  | Permute                     -- ^ freely intersperse options and non-options\n  | ReturnInOrder (String -> a) -- ^ wrap non-options into options\n\n{-|\nEach 'OptDescr' describes a single option.\n\nThe arguments to 'Option' are:\n\n* list of short option characters\n\n* list of long option strings (without \\\"--\\\")\n\n* argument descriptor\n\n* explanation of option for user\n-}\ndata OptDescr a =              -- description of a single options:\n   Option [Char]                --    list of short option characters\n          [String]              --    list of long option strings (without \"--\")\n          (ArgDescr a)          --    argument descriptor\n          String                --    explanation of option for user\n\n-- |Describes whether an option takes an argument or not, and if so\n-- how the argument is injected into a value of type @a@.\ndata ArgDescr a\n   = NoArg                   a         -- ^   no argument expected\n   | ReqArg (String       -> a) String -- ^   option requires argument\n   | OptArg (Maybe String -> a) String -- ^   optional argument\n\n-- | @since 4.6.0.0\ninstance Functor ArgOrder where\n    fmap _ RequireOrder      = RequireOrder\n    fmap _ Permute           = Permute\n    fmap f (ReturnInOrder g) = ReturnInOrder (f . g)\n\n-- | @since 4.6.0.0\ninstance Functor OptDescr where\n    fmap f (Option a b argDescr c) = Option a b (fmap f argDescr) c\n\n-- | @since 4.6.0.0\ninstance Functor ArgDescr where\n    fmap f (NoArg a)    = NoArg (f a)\n    fmap f (ReqArg g s) = ReqArg (f . g) s\n    fmap f (OptArg g s) = OptArg (f . g) s\n\ndata OptKind a                -- kind of cmd line arg (internal use only):\n   = Opt       a                --    an option\n   | UnreqOpt  String           --    an un-recognized option\n   | NonOpt    String           --    a non-option\n   | EndOfOpts                  --    end-of-options marker (i.e. \"--\")\n   | OptErr    String           --    something went wrong...\n\n-- | Return a string describing the usage of a command, derived from\n-- the header (first argument) and the options described by the \n-- second argument.\nusageInfo :: String                    -- header\n          -> [OptDescr a]              -- option descriptors\n          -> String                    -- nicely formatted description of options\nusageInfo header optDescr = unlines (header:table)\n   where (ss,ls,ds)     = (unzip3 . concatMap fmtOpt) optDescr\n         table          = zipWith3 paste (sameLen ss) (sameLen ls) ds\n         paste x y z    = \"  \" ++ x ++ \"  \" ++ y ++ \"  \" ++ z\n         sameLen xs     = flushLeft ((maximum . map length) xs) xs\n         flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]\n\nfmtOpt :: OptDescr a -> [(String,String,String)]\nfmtOpt (Option sos los ad descr) =\n   case lines descr of\n     []     -> [(sosFmt,losFmt,\"\")]\n     (d:ds) ->  (sosFmt,losFmt,d) : [ (\"\",\"\",d') | d' <- ds ]\n   where sepBy _  []     = \"\"\n         sepBy _  [x]    = x\n         sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs\n         sosFmt = sepBy ',' (map (fmtShort ad) sos)\n         losFmt = sepBy ',' (map (fmtLong  ad) los)\n\nfmtShort :: ArgDescr a -> Char -> String\nfmtShort (NoArg  _   ) so = \"-\" ++ [so]\nfmtShort (ReqArg _ ad) so = \"-\" ++ [so] ++ \" \" ++ ad\nfmtShort (OptArg _ ad) so = \"-\" ++ [so] ++ \"[\" ++ ad ++ \"]\"\n\nfmtLong :: ArgDescr a -> String -> String\nfmtLong (NoArg  _   ) lo = \"--\" ++ lo\nfmtLong (ReqArg _ ad) lo = \"--\" ++ lo ++ \"=\" ++ ad\nfmtLong (OptArg _ ad) lo = \"--\" ++ lo ++ \"[=\" ++ ad ++ \"]\"\n\n{-|\nProcess the command-line, and return the list of values that matched\n(and those that didn\\'t). The arguments are:\n\n* The order requirements (see 'ArgOrder')\n\n* The option descriptions (see 'OptDescr')\n\n* The actual command line arguments (presumably got from \n  'System.Environment.getArgs').\n\n'getOpt' returns a triple consisting of the option arguments, a list\nof non-options, and a list of error messages.\n-}\ngetOpt :: ArgOrder a                   -- non-option handling\n       -> [OptDescr a]                 -- option descriptors\n       -> [String]                     -- the command-line arguments\n       -> ([a],[String],[String])      -- (options,non-options,error messages)\ngetOpt ordering optDescr args = (os,xs,es ++ map errUnrec us)\n   where (os,xs,us,es) = getOpt' ordering optDescr args\n\n{-|\nThis is almost the same as 'getOpt', but returns a quadruple\nconsisting of the option arguments, a list of non-options, a list of\nunrecognized options, and a list of error messages.\n-}\ngetOpt' :: ArgOrder a                         -- non-option handling\n        -> [OptDescr a]                       -- option descriptors\n        -> [String]                           -- the command-line arguments\n        -> ([a],[String], [String] ,[String]) -- (options,non-options,unrecognized,error messages)\ngetOpt' _        _        []         =  ([],[],[],[])\ngetOpt' ordering optDescr (arg:args) = procNextOpt opt ordering\n   where procNextOpt (Opt o)      _                 = (o:os,xs,us,es)\n         procNextOpt (UnreqOpt u) _                 = (os,xs,u:us,es)\n         procNextOpt (NonOpt x)   RequireOrder      = ([],x:rest,[],[])\n         procNextOpt (NonOpt x)   Permute           = (os,x:xs,us,es)\n         procNextOpt (NonOpt x)   (ReturnInOrder f) = (f x :os, xs,us,es)\n         procNextOpt EndOfOpts    RequireOrder      = ([],rest,[],[])\n         procNextOpt EndOfOpts    Permute           = ([],rest,[],[])\n         procNextOpt EndOfOpts    (ReturnInOrder f) = (map f rest,[],[],[])\n         procNextOpt (OptErr e)   _                 = (os,xs,us,e:es)\n\n         (opt,rest) = getNext arg args optDescr\n         (os,xs,us,es) = getOpt' ordering optDescr rest\n\n-- take a look at the next cmd line arg and decide what to do with it\ngetNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])\ngetNext ('-':'-':[]) rest _        = (EndOfOpts,rest)\ngetNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr\ngetNext ('-': x :xs) rest optDescr = shortOpt x xs rest optDescr\ngetNext a            rest _        = (NonOpt a,rest)\n\n-- handle long option\nlongOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])\nlongOpt ls rs optDescr = long ads arg rs\n   where (opt,arg) = break (=='=') ls\n         getWith p = [ o | o@(Option _ xs _ _) <- optDescr\n                         , find (p opt) xs /= Nothing ]\n         exact     = getWith (==)\n         options   = if null exact then getWith isPrefixOf else exact\n         ads       = [ ad | Option _ _ ad _ <- options ]\n         optStr    = (\"--\"++opt)\n\n         long (_:_:_)      _        rest     = (errAmbig options optStr,rest)\n         long [NoArg  a  ] []       rest     = (Opt a,rest)\n         long [NoArg  _  ] ('=':_)  rest     = (errNoArg optStr,rest)\n         long [ReqArg _ d] []       []       = (errReq d optStr,[])\n         long [ReqArg f _] []       (r:rest) = (Opt (f r),rest)\n         long [ReqArg f _] ('=':xs) rest     = (Opt (f xs),rest)\n         long [OptArg f _] []       rest     = (Opt (f Nothing),rest)\n         long [OptArg f _] ('=':xs) rest     = (Opt (f (Just xs)),rest)\n         long _            _        rest     = (UnreqOpt (\"--\"++ls),rest)\n\n-- handle short option\nshortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])\nshortOpt y ys rs optDescr = short ads ys rs\n  where options = [ o  | o@(Option ss _ _ _) <- optDescr, s <- ss, y == s ]\n        ads     = [ ad | Option _ _ ad _ <- options ]\n        optStr  = '-':[y]\n\n        short (_:_:_)        _  rest     = (errAmbig options optStr,rest)\n        short (NoArg  a  :_) [] rest     = (Opt a,rest)\n        short (NoArg  a  :_) xs rest     = (Opt a,('-':xs):rest)\n        short (ReqArg _ d:_) [] []       = (errReq d optStr,[])\n        short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest)\n        short (ReqArg f _:_) xs rest     = (Opt (f xs),rest)\n        short (OptArg f _:_) [] rest     = (Opt (f Nothing),rest)\n        short (OptArg f _:_) xs rest     = (Opt (f (Just xs)),rest)\n        short []             [] rest     = (UnreqOpt optStr,rest)\n        short []             xs rest     = (UnreqOpt optStr,('-':xs):rest)\n\n-- miscellaneous error formatting\n\nerrAmbig :: [OptDescr a] -> String -> OptKind a\nerrAmbig ods optStr = OptErr (usageInfo header ods)\n   where header = \"option `\" ++ optStr ++ \"' is ambiguous; could be one of:\"\n\nerrReq :: String -> String -> OptKind a\nerrReq d optStr = OptErr (\"option `\" ++ optStr ++ \"' requires an argument \" ++ d ++ \"\\n\")\n\nerrUnrec :: String -> String\nerrUnrec optStr = \"unrecognized option `\" ++ optStr ++ \"'\\n\"\n\nerrNoArg :: String -> OptKind a\nerrNoArg optStr = OptErr (\"option `\" ++ optStr ++ \"' doesn't allow an argument\\n\")\n\n{-\n-----------------------------------------------------------------------------------------\n-- and here a small and hopefully enlightening example:\n\ndata Flag = Verbose | Version | Name String | Output String | Arg String   deriving Show\n\noptions :: [OptDescr Flag]\noptions =\n   [Option ['v']     [\"verbose\"]           (NoArg Verbose)      \"verbosely list files\",\n    Option ['V','?'] [\"version\",\"release\"] (NoArg Version)      \"show version info\",\n    Option ['o']     [\"output\"]            (OptArg out \"FILE\")  \"use FILE for dump\",\n    Option ['n']     [\"name\"]              (ReqArg Name \"USER\") \"only dump USER's files\"]\n\nout :: Maybe String -> Flag\nout Nothing  = Output \"stdout\"\nout (Just o) = Output o\n\ntest :: ArgOrder Flag -> [String] -> String\ntest order cmdline = case getOpt order options cmdline of\n                        (o,n,[]  ) -> \"options=\" ++ show o ++ \"  args=\" ++ show n ++ \"\\n\"\n                        (_,_,errs) -> concat errs ++ usageInfo header options\n   where header = \"Usage: foobar [OPTION...] files...\"\n\n-- example runs:\n-- putStr (test RequireOrder [\"foo\",\"-v\"])\n--    ==> options=[]  args=[\"foo\", \"-v\"]\n-- putStr (test Permute [\"foo\",\"-v\"])\n--    ==> options=[Verbose]  args=[\"foo\"]\n-- putStr (test (ReturnInOrder Arg) [\"foo\",\"-v\"])\n--    ==> options=[Arg \"foo\", Verbose]  args=[]\n-- putStr (test Permute [\"foo\",\"--\",\"-v\"])\n--    ==> options=[]  args=[\"foo\", \"-v\"]\n-- putStr (test Permute [\"-?o\",\"--name\",\"bar\",\"--na=baz\"])\n--    ==> options=[Version, Output \"stdout\", Name \"bar\", Name \"baz\"]  args=[]\n-- putStr (test Permute [\"--ver\",\"foo\"])\n--    ==> option `--ver' is ambiguous; could be one of:\n--          -v      --verbose             verbosely list files\n--          -V, -?  --version, --release  show version info   \n--        Usage: foobar [OPTION...] files...\n--          -v        --verbose             verbosely list files  \n--          -V, -?    --version, --release  show version info     \n--          -o[FILE]  --output[=FILE]       use FILE for dump     \n--          -n USER   --name=USER           only dump USER's files\n-----------------------------------------------------------------------------------------\n-}\n\n{- $example1\n\nA simple choice for the type associated with flags is to define a type\n@Flag@ as an algebraic type representing the possible flags and their\narguments:\n\n>    module Opts1 where\n>    \n>    import System.Console.GetOpt\n>    import Data.Maybe ( fromMaybe )\n>    \n>    data Flag \n>     = Verbose  | Version \n>     | Input String | Output String | LibDir String\n>       deriving Show\n>    \n>    options :: [OptDescr Flag]\n>    options =\n>     [ Option ['v']     [\"verbose\"] (NoArg Verbose)       \"chatty output on stderr\"\n>     , Option ['V','?'] [\"version\"] (NoArg Version)       \"show version number\"\n>     , Option ['o']     [\"output\"]  (OptArg outp \"FILE\")  \"output FILE\"\n>     , Option ['c']     []          (OptArg inp  \"FILE\")  \"input FILE\"\n>     , Option ['L']     [\"libdir\"]  (ReqArg LibDir \"DIR\") \"library directory\"\n>     ]\n>    \n>    inp,outp :: Maybe String -> Flag\n>    outp = Output . fromMaybe \"stdout\"\n>    inp  = Input  . fromMaybe \"stdin\"\n>    \n>    compilerOpts :: [String] -> IO ([Flag], [String])\n>    compilerOpts argv = \n>       case getOpt Permute options argv of\n>          (o,n,[]  ) -> return (o,n)\n>          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))\n>      where header = \"Usage: ic [OPTION...] files...\"\n\nThen the rest of the program will use the constructed list of flags\nto determine it\\'s behaviour.\n\n-}\n\n{- $example2\n\nA different approach is to group the option values in a record of type\n@Options@, and have each flag yield a function of type\n@Options -> Options@ transforming this record.\n\n>    module Opts2 where\n>\n>    import System.Console.GetOpt\n>    import Data.Maybe ( fromMaybe )\n>\n>    data Options = Options\n>     { optVerbose     :: Bool\n>     , optShowVersion :: Bool\n>     , optOutput      :: Maybe FilePath\n>     , optInput       :: Maybe FilePath\n>     , optLibDirs     :: [FilePath]\n>     } deriving Show\n>\n>    defaultOptions    = Options\n>     { optVerbose     = False\n>     , optShowVersion = False\n>     , optOutput      = Nothing\n>     , optInput       = Nothing\n>     , optLibDirs     = []\n>     }\n>\n>    options :: [OptDescr (Options -> Options)]\n>    options =\n>     [ Option ['v']     [\"verbose\"]\n>         (NoArg (\\ opts -> opts { optVerbose = True }))\n>         \"chatty output on stderr\"\n>     , Option ['V','?'] [\"version\"]\n>         (NoArg (\\ opts -> opts { optShowVersion = True }))\n>         \"show version number\"\n>     , Option ['o']     [\"output\"]\n>         (OptArg ((\\ f opts -> opts { optOutput = Just f }) . fromMaybe \"output\")\n>                 \"FILE\")\n>         \"output FILE\"\n>     , Option ['c']     []\n>         (OptArg ((\\ f opts -> opts { optInput = Just f }) . fromMaybe \"input\")\n>                 \"FILE\")\n>         \"input FILE\"\n>     , Option ['L']     [\"libdir\"]\n>         (ReqArg (\\ d opts -> opts { optLibDirs = optLibDirs opts ++ [d] }) \"DIR\")\n>         \"library directory\"\n>     ]\n>\n>    compilerOpts :: [String] -> IO (Options, [String])\n>    compilerOpts argv =\n>       case getOpt Permute options argv of\n>          (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)\n>          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))\n>      where header = \"Usage: ic [OPTION...] files...\"\n\nSimilarly, each flag could yield a monadic function transforming a record,\nof type @Options -> IO Options@ (or any other monad), allowing option\nprocessing to perform actions of the chosen monad, e.g. printing help or\nversion messages, checking that file arguments exist, etc.\n\n-}\n\n", "num_lines": 411}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module System.CPUTime.Unsupported\n    ( getCPUTime\n    , getCpuTimePrecision\n    ) where\n\nimport GHC.IO.Exception\n\ngetCPUTime :: IO Integer\ngetCPUTime =\n    ioError (IOError Nothing UnsupportedOperation\n                     \"getCPUTime\"\n                     \"can't get CPU time\"\n                     Nothing Nothing)\n\ngetCpuTimePrecision :: IO Integer\ngetCpuTimePrecision =\n    ioError (IOError Nothing UnsupportedOperation\n                     \"cpuTimePrecision\"\n                     \"can't get CPU time\"\n                     Nothing Nothing)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module System.CPUTime.Utils\n    ( -- * Integer conversions\n      -- | These types have no 'Integral' instances in the Haskell report\n      -- so we must do this ourselves.\n      cClockToInteger\n    , cTimeToInteger\n    , csuSecondsToInteger\n    ) where\n\nimport Foreign.C.Types\n\ncClockToInteger :: CClock -> Integer\ncClockToInteger (CClock n) = fromIntegral n\n\ncTimeToInteger :: CTime -> Integer\ncTimeToInteger (CTime n) = fromIntegral n\n\ncsuSecondsToInteger :: CSUSeconds -> Integer\ncsuSecondsToInteger (CSUSeconds n) = fromIntegral n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.IO.Error\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Standard IO Errors.\n--\n-----------------------------------------------------------------------------\n\nmodule System.IO.Error (\n\n    -- * I\\/O errors\n    IOError,\n\n    userError,\n\n    mkIOError,\n\n    annotateIOError,\n\n    -- ** Classifying I\\/O errors\n    isAlreadyExistsError,\n    isDoesNotExistError,\n    isAlreadyInUseError,\n    isFullError,\n    isEOFError,\n    isIllegalOperation,\n    isPermissionError,\n    isUserError,\n\n    -- ** Attributes of I\\/O errors\n    ioeGetErrorType,\n    ioeGetLocation,\n    ioeGetErrorString,\n    ioeGetHandle,\n    ioeGetFileName,\n\n    ioeSetErrorType,\n    ioeSetErrorString,\n    ioeSetLocation,\n    ioeSetHandle,\n    ioeSetFileName,\n\n    -- * Types of I\\/O error\n    IOErrorType,                -- abstract\n\n    alreadyExistsErrorType,\n    doesNotExistErrorType,\n    alreadyInUseErrorType,\n    fullErrorType,\n    eofErrorType,\n    illegalOperationErrorType,\n    permissionErrorType,\n    userErrorType,\n\n    -- ** 'IOErrorType' predicates\n    isAlreadyExistsErrorType,\n    isDoesNotExistErrorType,\n    isAlreadyInUseErrorType,\n    isFullErrorType,\n    isEOFErrorType,\n    isIllegalOperationErrorType,\n    isPermissionErrorType,\n    isUserErrorType,\n\n    -- * Throwing and catching I\\/O errors\n\n    ioError,\n\n    catchIOError,\n    tryIOError,\n\n    modifyIOError,\n  ) where\n\nimport Control.Exception.Base\n\nimport Data.Either\nimport Data.Maybe\n\nimport GHC.Base\nimport GHC.IO\nimport GHC.IO.Exception\nimport GHC.IO.Handle.Types\nimport Text.Show\n\n-- | The construct 'tryIOError' @comp@ exposes IO errors which occur within a\n-- computation, and which are not fully handled.\n--\n-- Non-I\\/O exceptions are not caught by this variant; to catch all\n-- exceptions, use 'Control.Exception.try' from \"Control.Exception\".\n--\n-- @since 4.4.0.0\ntryIOError     :: IO a -> IO (Either IOError a)\ntryIOError f   =  catch (do r <- f\n                            return (Right r))\n                        (return . Left)\n\n-- -----------------------------------------------------------------------------\n-- Constructing an IOError\n\n-- | Construct an 'IOError' of the given type where the second argument\n-- describes the error location and the third and fourth argument\n-- contain the file handle and file path of the file involved in the\n-- error if applicable.\nmkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError\nmkIOError t location maybe_hdl maybe_filename =\n               IOError{ ioe_type = t,\n                        ioe_location = location,\n                        ioe_description = \"\",\n                        ioe_errno = Nothing,\n                        ioe_handle = maybe_hdl,\n                        ioe_filename = maybe_filename\n                        }\n\n-- -----------------------------------------------------------------------------\n-- IOErrorType\n\n-- | An error indicating that an 'IO' operation failed because\n-- one of its arguments already exists.\nisAlreadyExistsError :: IOError -> Bool\nisAlreadyExistsError = isAlreadyExistsErrorType    . ioeGetErrorType\n\n-- | An error indicating that an 'IO' operation failed because\n-- one of its arguments does not exist.\nisDoesNotExistError :: IOError -> Bool\nisDoesNotExistError  = isDoesNotExistErrorType     . ioeGetErrorType\n\n-- | An error indicating that an 'IO' operation failed because\n-- one of its arguments is a single-use resource, which is already\n-- being used (for example, opening the same file twice for writing\n-- might give this error).\nisAlreadyInUseError :: IOError -> Bool\nisAlreadyInUseError  = isAlreadyInUseErrorType     . ioeGetErrorType\n\n-- | An error indicating that an 'IO' operation failed because\n-- the device is full.\nisFullError         :: IOError -> Bool\nisFullError          = isFullErrorType             . ioeGetErrorType\n\n-- | An error indicating that an 'IO' operation failed because\n-- the end of file has been reached.\nisEOFError          :: IOError -> Bool\nisEOFError           = isEOFErrorType              . ioeGetErrorType\n\n-- | An error indicating that an 'IO' operation failed because\n-- the operation was not possible.\n-- Any computation which returns an 'IO' result may fail with\n-- 'isIllegalOperation'.  In some cases, an implementation will not be\n-- able to distinguish between the possible error causes.  In this case\n-- it should fail with 'isIllegalOperation'.\nisIllegalOperation  :: IOError -> Bool\nisIllegalOperation   = isIllegalOperationErrorType . ioeGetErrorType\n\n-- | An error indicating that an 'IO' operation failed because\n-- the user does not have sufficient operating system privilege\n-- to perform that operation.\nisPermissionError   :: IOError -> Bool\nisPermissionError    = isPermissionErrorType       . ioeGetErrorType\n\n-- | A programmer-defined error value constructed using 'userError'.\nisUserError         :: IOError -> Bool\nisUserError          = isUserErrorType             . ioeGetErrorType\n\n-- -----------------------------------------------------------------------------\n-- IOErrorTypes\n\n-- | I\\/O error where the operation failed because one of its arguments\n-- already exists.\nalreadyExistsErrorType   :: IOErrorType\nalreadyExistsErrorType    = AlreadyExists\n\n-- | I\\/O error where the operation failed because one of its arguments\n-- does not exist.\ndoesNotExistErrorType    :: IOErrorType\ndoesNotExistErrorType     = NoSuchThing\n\n-- | I\\/O error where the operation failed because one of its arguments\n-- is a single-use resource, which is already being used.\nalreadyInUseErrorType    :: IOErrorType\nalreadyInUseErrorType     = ResourceBusy\n\n-- | I\\/O error where the operation failed because the device is full.\nfullErrorType            :: IOErrorType\nfullErrorType             = ResourceExhausted\n\n-- | I\\/O error where the operation failed because the end of file has\n-- been reached.\neofErrorType             :: IOErrorType\neofErrorType              = EOF\n\n-- | I\\/O error where the operation is not possible.\nillegalOperationErrorType :: IOErrorType\nillegalOperationErrorType = IllegalOperation\n\n-- | I\\/O error where the operation failed because the user does not\n-- have sufficient operating system privilege to perform that operation.\npermissionErrorType      :: IOErrorType\npermissionErrorType       = PermissionDenied\n\n-- | I\\/O error that is programmer-defined.\nuserErrorType            :: IOErrorType\nuserErrorType             = UserError\n\n-- -----------------------------------------------------------------------------\n-- IOErrorType predicates\n\n-- | I\\/O error where the operation failed because one of its arguments\n-- already exists.\nisAlreadyExistsErrorType :: IOErrorType -> Bool\nisAlreadyExistsErrorType AlreadyExists = True\nisAlreadyExistsErrorType _ = False\n\n-- | I\\/O error where the operation failed because one of its arguments\n-- does not exist.\nisDoesNotExistErrorType :: IOErrorType -> Bool\nisDoesNotExistErrorType NoSuchThing = True\nisDoesNotExistErrorType _ = False\n\n-- | I\\/O error where the operation failed because one of its arguments\n-- is a single-use resource, which is already being used.\nisAlreadyInUseErrorType :: IOErrorType -> Bool\nisAlreadyInUseErrorType ResourceBusy = True\nisAlreadyInUseErrorType _ = False\n\n-- | I\\/O error where the operation failed because the device is full.\nisFullErrorType :: IOErrorType -> Bool\nisFullErrorType ResourceExhausted = True\nisFullErrorType _ = False\n\n-- | I\\/O error where the operation failed because the end of file has\n-- been reached.\nisEOFErrorType :: IOErrorType -> Bool\nisEOFErrorType EOF = True\nisEOFErrorType _ = False\n\n-- | I\\/O error where the operation is not possible.\nisIllegalOperationErrorType :: IOErrorType -> Bool\nisIllegalOperationErrorType IllegalOperation = True\nisIllegalOperationErrorType _ = False\n\n-- | I\\/O error where the operation failed because the user does not\n-- have sufficient operating system privilege to perform that operation.\nisPermissionErrorType :: IOErrorType -> Bool\nisPermissionErrorType PermissionDenied = True\nisPermissionErrorType _ = False\n\n-- | I\\/O error that is programmer-defined.\nisUserErrorType :: IOErrorType -> Bool\nisUserErrorType UserError = True\nisUserErrorType _ = False\n\n-- -----------------------------------------------------------------------------\n-- Miscellaneous\n\nioeGetErrorType       :: IOError -> IOErrorType\nioeGetErrorString     :: IOError -> String\nioeGetLocation        :: IOError -> String\nioeGetHandle          :: IOError -> Maybe Handle\nioeGetFileName        :: IOError -> Maybe FilePath\n\nioeGetErrorType ioe = ioe_type ioe\n\nioeGetErrorString ioe\n   | isUserErrorType (ioe_type ioe) = ioe_description ioe\n   | otherwise                      = show (ioe_type ioe)\n\nioeGetLocation ioe = ioe_location ioe\n\nioeGetHandle ioe = ioe_handle ioe\n\nioeGetFileName ioe = ioe_filename ioe\n\nioeSetErrorType   :: IOError -> IOErrorType -> IOError\nioeSetErrorString :: IOError -> String      -> IOError\nioeSetLocation    :: IOError -> String      -> IOError\nioeSetHandle      :: IOError -> Handle      -> IOError\nioeSetFileName    :: IOError -> FilePath    -> IOError\n\nioeSetErrorType   ioe errtype  = ioe{ ioe_type = errtype }\nioeSetErrorString ioe str      = ioe{ ioe_description = str }\nioeSetLocation    ioe str      = ioe{ ioe_location = str }\nioeSetHandle      ioe hdl      = ioe{ ioe_handle = Just hdl }\nioeSetFileName    ioe filename = ioe{ ioe_filename = Just filename }\n\n-- | Catch any 'IOError' that occurs in the computation and throw a\n-- modified version.\nmodifyIOError :: (IOError -> IOError) -> IO a -> IO a\nmodifyIOError f io = catch io (\\e -> ioError (f e))\n\n-- -----------------------------------------------------------------------------\n-- annotating an IOError\n\n-- | Adds a location description and maybe a file path and file handle\n-- to an 'IOError'.  If any of the file handle or file path is not given\n-- the corresponding value in the 'IOError' remains unaltered.\nannotateIOError :: IOError\n              -> String\n              -> Maybe Handle\n              -> Maybe FilePath\n              -> IOError\nannotateIOError ioe loc hdl path =\n  ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,\n       ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }\n\n-- | The 'catchIOError' function establishes a handler that receives any\n-- 'IOError' raised in the action protected by 'catchIOError'.\n-- An 'IOError' is caught by\n-- the most recent handler established by one of the exception handling\n-- functions.  These handlers are\n-- not selective: all 'IOError's are caught.  Exception propagation\n-- must be explicitly provided in a handler by re-raising any unwanted\n-- exceptions.  For example, in\n--\n-- > f = catchIOError g (\\e -> if IO.isEOFError e then return [] else ioError e)\n--\n-- the function @f@ returns @[]@ when an end-of-file exception\n-- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the\n-- exception is propagated to the next outer handler.\n--\n-- When an exception propagates outside the main program, the Haskell\n-- system prints the associated 'IOError' value and exits the program.\n--\n-- Non-I\\/O exceptions are not caught by this variant; to catch all\n-- exceptions, use 'Control.Exception.catch' from \"Control.Exception\".\n--\n-- @since 4.4.0.0\ncatchIOError :: IO a -> (IOError -> IO a) -> IO a\ncatchIOError = catch\n", "num_lines": 338}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.IO.Unsafe\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- \\\"Unsafe\\\" IO operations.\n--\n-----------------------------------------------------------------------------\n\nmodule System.IO.Unsafe (\n   -- * Unsafe 'System.IO.IO' operations\n   unsafePerformIO,\n   unsafeDupablePerformIO,\n   unsafeInterleaveIO,\n   unsafeFixIO,\n  ) where\n\nimport GHC.Base\nimport GHC.IO\nimport GHC.IORef\nimport GHC.Exception\nimport Control.Exception\n\n-- | A slightly faster version of `System.IO.fixIO` that may not be\n-- safe to use with multiple threads.  The unsafety arises when used\n-- like this:\n--\n-- >  unsafeFixIO $ \\r -> do\n-- >     forkIO (print r)\n-- >     return (...)\n--\n-- In this case, the child thread will receive a @NonTermination@\n-- exception instead of waiting for the value of @r@ to be computed.\n--\n-- @since 4.5.0.0\nunsafeFixIO :: (a -> IO a) -> IO a\nunsafeFixIO k = do\n  ref <- newIORef (throw NonTermination)\n  ans <- unsafeDupableInterleaveIO (readIORef ref)\n  result <- k ans\n  writeIORef ref result\n  return result\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Mem.StableName\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable\n--\n-- Stable names are a way of performing fast (O(1)), not-quite-exact\n-- comparison between objects.\n--\n-- Stable names solve the following problem: suppose you want to build\n-- a hash table with Haskell objects as keys, but you want to use\n-- pointer equality for comparison; maybe because the keys are large\n-- and hashing would be slow, or perhaps because the keys are infinite\n-- in size.  We can\\'t build a hash table using the address of the\n-- object as the key, because objects get moved around by the garbage\n-- collector, meaning a re-hash would be necessary after every garbage\n-- collection.\n--\n-------------------------------------------------------------------------------\n\nmodule System.Mem.StableName (\n  -- * Stable Names\n  StableName,\n  makeStableName,\n  hashStableName,\n  eqStableName\n  ) where\n\nimport GHC.StableName\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Mem.Weak\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable\n--\n-- In general terms, a weak pointer is a reference to an object that is\n-- not followed by the garbage collector - that is, the existence of a\n-- weak pointer to an object has no effect on the lifetime of that\n-- object.  A weak pointer can be de-referenced to find out\n-- whether the object it refers to is still alive or not, and if so\n-- to return the object itself.\n--\n-- Weak pointers are particularly useful for caches and memo tables.\n-- To build a memo table, you build a data structure\n-- mapping from the function argument (the key) to its result (the\n-- value).  When you apply the function to a new argument you first\n-- check whether the key\\/value pair is already in the memo table.\n-- The key point is that the memo table itself should not keep the\n-- key and value alive.  So the table should contain a weak pointer\n-- to the key, not an ordinary pointer.  The pointer to the value must\n-- not be weak, because the only reference to the value might indeed be\n-- from the memo table.\n--\n-- So it looks as if the memo table will keep all its values\n-- alive for ever.  One way to solve this is to purge the table\n-- occasionally, by deleting entries whose keys have died.\n--\n-- The weak pointers in this library\n-- support another approach, called /finalization/.\n-- When the key referred to by a weak pointer dies, the storage manager\n-- arranges to run a programmer-specified finalizer.  In the case of memo\n-- tables, for example, the finalizer could remove the key\\/value pair\n-- from the memo table.\n--\n-- Another difficulty with the memo table is that the value of a\n-- key\\/value pair might itself contain a pointer to the key.\n-- So the memo table keeps the value alive, which keeps the key alive,\n-- even though there may be no other references to the key so both should\n-- die.  The weak pointers in this library provide a slight\n-- generalisation of the basic weak-pointer idea, in which each\n-- weak pointer actually contains both a key and a value.\n--\n-----------------------------------------------------------------------------\n\nmodule System.Mem.Weak (\n        -- * The @Weak@ type\n        Weak,                   -- abstract\n\n        -- * The general interface\n        mkWeak,\n        deRefWeak,\n        finalize,\n\n        -- * Specialised versions\n        mkWeakPtr,\n        addFinalizer,\n        mkWeakPair,\n        -- replaceFinaliser\n\n        -- * A precise semantics\n\n        -- $precise\n\n        -- * Implementation notes\n\n        -- $notes\n   ) where\n\nimport GHC.Weak\n\n-- | A specialised version of 'mkWeak', where the key and the value are\n-- the same object:\n--\n-- > mkWeakPtr key finalizer = mkWeak key key finalizer\n--\nmkWeakPtr :: k -> Maybe (IO ()) -> IO (Weak k)\nmkWeakPtr key finalizer = mkWeak key key finalizer\n\n{-|\n  A specialised version of 'mkWeakPtr', where the 'Weak' object\n  returned is simply thrown away (however the finalizer will be\n  remembered by the garbage collector, and will still be run\n  when the key becomes unreachable).\n\n  Note: adding a finalizer to a 'Foreign.ForeignPtr.ForeignPtr' using\n  'addFinalizer' won't work; use the specialised version\n  'Foreign.ForeignPtr.addForeignPtrFinalizer' instead.  For discussion\n  see the 'Weak' type.\n.\n-}\naddFinalizer :: key -> IO () -> IO ()\naddFinalizer key finalizer = do\n   _ <- mkWeakPtr key (Just finalizer) -- throw it away\n   return ()\n\n-- | A specialised version of 'mkWeak' where the value is actually a pair\n-- of the key and value passed to 'mkWeakPair':\n--\n-- > mkWeakPair key val finalizer = mkWeak key (key,val) finalizer\n--\n-- The advantage of this is that the key can be retrieved by 'deRefWeak'\n-- in addition to the value.\nmkWeakPair :: k -> v -> Maybe (IO ()) -> IO (Weak (k,v))\nmkWeakPair key val finalizer = mkWeak key (key,val) finalizer\n\n\n{- $precise\n\nThe above informal specification is fine for simple situations, but\nmatters can get complicated.  In particular, it needs to be clear\nexactly when a key dies, so that any weak pointers that refer to it\ncan be finalized.  Suppose, for example, the value of one weak pointer\nrefers to the key of another...does that keep the key alive?\n\nThe behaviour is simply this:\n\n *  If a weak pointer (object) refers to an /unreachable/\n    key, it may be finalized.\n\n *  Finalization means (a) arrange that subsequent calls\n    to 'deRefWeak' return 'Nothing'; and (b) run the finalizer.\n\nThis behaviour depends on what it means for a key to be reachable.\nInformally, something is reachable if it can be reached by following\nordinary pointers from the root set, but not following weak pointers.\nWe define reachability more precisely as follows.\n\nA heap object is /reachable/ if:\n\n * It is a member of the /root set/.\n\n * It is directly pointed to by a reachable object, other than\n   a weak pointer object.\n\n * It is a weak pointer object whose key is reachable.\n\n * It is the value or finalizer of a weak pointer object whose key is reachable.\n-}\n\n{- $notes\n\nA finalizer is not always called after its weak pointer\\'s object becomes\nunreachable. There are two situations that can cause this:\n\n * If the object becomes unreachable right before the program exits,\n   then GC may not be performed. Finalizers run during GC, so finalizers\n   associated with the object do not run if GC does not happen.\n\n * If a finalizer throws an exception, subsequent finalizers that had\n   been queued to run after it do not get run. This behavior may change\n   in a future release. See issue <https://ghc.haskell.org/trac/ghc/ticket/13167 13167>\n   on the issue tracker. Writing a finalizer that throws exceptions is\n   discouraged.\n\nOther than these two caveats, users can always expect that a finalizer\nwill be run after its weak pointer\\'s object becomes unreachable. However,\nthe second caveat means that users need to trust that all of their\ntransitive dependencies do not throw exceptions in finalizers, since\nany finalizers can end up queued together.\n\n-}\n", "num_lines": 169}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Posix.Internals\n-- Copyright   :  (c) The University of Glasgow, 1992-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (requires POSIX)\n--\n-- POSIX support layer for the standard libraries.\n-- This library is built on *every* platform, including Win32.\n--\n-- Non-posix compliant in order to support the following features:\n--      * S_ISSOCK (no sockets in POSIX)\n--\n-----------------------------------------------------------------------------\n\nmodule System.Posix.Internals where\n\n#include \"HsBaseConfig.h\"\n\nimport System.Posix.Types\n\nimport Foreign\nimport Foreign.C\n\n-- import Data.Bits\nimport Data.Maybe\n\n#if !defined(HTYPE_TCFLAG_T)\nimport System.IO.Error\n#endif\n\nimport GHC.Base\nimport GHC.Num\nimport GHC.Real\nimport GHC.IO\nimport GHC.IO.IOMode\nimport GHC.IO.Exception\nimport GHC.IO.Device\n#if !defined(mingw32_HOST_OS)\nimport {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding)\nimport qualified GHC.Foreign as GHC\n#endif\n\n-- ---------------------------------------------------------------------------\n-- Debugging the base package\n\nputs :: String -> IO ()\nputs s = withCAStringLen (s ++ \"\\n\") $ \\(p, len) -> do\n            -- In reality should be withCString, but assume ASCII to avoid loop\n            -- if this is called by GHC.Foreign\n           _ <- c_write 1 (castPtr p) (fromIntegral len)\n           return ()\n\n\n-- ---------------------------------------------------------------------------\n-- Types\n\ndata {-# CTYPE \"struct flock\" #-} CFLock\ndata {-# CTYPE \"struct group\" #-} CGroup\ndata {-# CTYPE \"struct lconv\" #-} CLconv\ndata {-# CTYPE \"struct passwd\" #-} CPasswd\ndata {-# CTYPE \"struct sigaction\" #-} CSigaction\ndata {-# CTYPE \"sigset_t\" #-} CSigset\ndata {-# CTYPE \"struct stat\" #-}  CStat\ndata {-# CTYPE \"struct termios\" #-} CTermios\ndata {-# CTYPE \"struct tm\" #-} CTm\ndata {-# CTYPE \"struct tms\" #-} CTms\ndata {-# CTYPE \"struct utimbuf\" #-} CUtimbuf\ndata {-# CTYPE \"struct utsname\" #-} CUtsname\n\ntype FD = CInt\n\n-- ---------------------------------------------------------------------------\n-- stat()-related stuff\n\nfdFileSize :: FD -> IO Integer\nfdFileSize fd =\n  allocaBytes sizeof_stat $ \\ p_stat -> do\n    throwErrnoIfMinus1Retry_ \"fileSize\" $\n        c_fstat fd p_stat\n    c_mode <- st_mode p_stat :: IO CMode\n    if not (s_isreg c_mode)\n        then return (-1)\n        else do\n      c_size <- st_size p_stat\n      return (fromIntegral c_size)\n\nfileType :: FilePath -> IO IODeviceType\nfileType file =\n  allocaBytes sizeof_stat $ \\ p_stat -> do\n  withFilePath file $ \\p_file -> do\n    throwErrnoIfMinus1Retry_ \"fileType\" $\n      c_stat p_file p_stat\n    statGetType p_stat\n\n-- NOTE: On Win32 platforms, this will only work with file descriptors\n-- referring to file handles. i.e., it'll fail for socket FDs.\nfdStat :: FD -> IO (IODeviceType, CDev, CIno)\nfdStat fd =\n  allocaBytes sizeof_stat $ \\ p_stat -> do\n    throwErrnoIfMinus1Retry_ \"fdType\" $\n        c_fstat fd p_stat\n    ty <- statGetType p_stat\n    dev <- st_dev p_stat\n    ino <- st_ino p_stat\n    return (ty,dev,ino)\n\nfdType :: FD -> IO IODeviceType\nfdType fd = do (ty,_,_) <- fdStat fd; return ty\n\nstatGetType :: Ptr CStat -> IO IODeviceType\nstatGetType p_stat = do\n  c_mode <- st_mode p_stat :: IO CMode\n  case () of\n      _ | s_isdir c_mode        -> return Directory\n        | s_isfifo c_mode || s_issock c_mode || s_ischr  c_mode\n                                -> return Stream\n        | s_isreg c_mode        -> return RegularFile\n         -- Q: map char devices to RawDevice too?\n        | s_isblk c_mode        -> return RawDevice\n        | otherwise             -> ioError ioe_unknownfiletype\n\nioe_unknownfiletype :: IOException\nioe_unknownfiletype = IOError Nothing UnsupportedOperation \"fdType\"\n                        \"unknown file type\"\n                        Nothing\n                        Nothing\n\nfdGetMode :: FD -> IO IOMode\n#if defined(mingw32_HOST_OS)\nfdGetMode _ = do\n    -- We don't have a way of finding out which flags are set on FDs\n    -- on Windows, so make a handle that thinks that anything goes.\n    let flags = o_RDWR\n#else\nfdGetMode fd = do\n    flags <- throwErrnoIfMinus1Retry \"fdGetMode\"\n                (c_fcntl_read fd const_f_getfl)\n#endif\n    let\n       wH  = (flags .&. o_WRONLY) /= 0\n       aH  = (flags .&. o_APPEND) /= 0\n       rwH = (flags .&. o_RDWR) /= 0\n\n       mode\n         | wH && aH  = AppendMode\n         | wH        = WriteMode\n         | rwH       = ReadWriteMode\n         | otherwise = ReadMode\n\n    return mode\n\n#if defined(mingw32_HOST_OS)\nwithFilePath :: FilePath -> (CWString -> IO a) -> IO a\nwithFilePath = withCWString\n\nnewFilePath :: FilePath -> IO CWString\nnewFilePath = newCWString\n\npeekFilePath :: CWString -> IO FilePath\npeekFilePath = peekCWString\n#else\n\nwithFilePath :: FilePath -> (CString -> IO a) -> IO a\nnewFilePath :: FilePath -> IO CString\npeekFilePath :: CString -> IO FilePath\npeekFilePathLen :: CStringLen -> IO FilePath\n\nwithFilePath fp f = getFileSystemEncoding >>= \\enc -> GHC.withCString enc fp f\nnewFilePath fp = getFileSystemEncoding >>= \\enc -> GHC.newCString enc fp\npeekFilePath fp = getFileSystemEncoding >>= \\enc -> GHC.peekCString enc fp\npeekFilePathLen fp = getFileSystemEncoding >>= \\enc -> GHC.peekCStringLen enc fp\n\n#endif\n\n-- ---------------------------------------------------------------------------\n-- Terminal-related stuff\n\n#if defined(HTYPE_TCFLAG_T)\n\nsetEcho :: FD -> Bool -> IO ()\nsetEcho fd on = do\n  tcSetAttr fd $ \\ p_tios -> do\n    lflag <- c_lflag p_tios :: IO CTcflag\n    let new_lflag\n         | on        = lflag .|. fromIntegral const_echo\n         | otherwise = lflag .&. complement (fromIntegral const_echo)\n    poke_c_lflag p_tios (new_lflag :: CTcflag)\n\ngetEcho :: FD -> IO Bool\ngetEcho fd = do\n  tcSetAttr fd $ \\ p_tios -> do\n    lflag <- c_lflag p_tios :: IO CTcflag\n    return ((lflag .&. fromIntegral const_echo) /= 0)\n\nsetCooked :: FD -> Bool -> IO ()\nsetCooked fd cooked =\n  tcSetAttr fd $ \\ p_tios -> do\n\n    -- turn on/off ICANON\n    lflag <- c_lflag p_tios :: IO CTcflag\n    let new_lflag | cooked    = lflag .|. (fromIntegral const_icanon)\n                  | otherwise = lflag .&. complement (fromIntegral const_icanon)\n    poke_c_lflag p_tios (new_lflag :: CTcflag)\n\n    -- set VMIN & VTIME to 1/0 respectively\n    when (not cooked) $ do\n            c_cc <- ptr_c_cc p_tios\n            let vmin  = (c_cc `plusPtr` (fromIntegral const_vmin))  :: Ptr Word8\n                vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8\n            poke vmin  1\n            poke vtime 0\n\ntcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a\ntcSetAttr fd fun = do\n     allocaBytes sizeof_termios  $ \\p_tios -> do\n        throwErrnoIfMinus1Retry_ \"tcSetAttr\"\n           (c_tcgetattr fd p_tios)\n\n        -- Save a copy of termios, if this is a standard file descriptor.\n        -- These terminal settings are restored in hs_exit().\n        when (fd <= 2) $ do\n          p <- get_saved_termios fd\n          when (p == nullPtr) $ do\n             saved_tios <- mallocBytes sizeof_termios\n             copyBytes saved_tios p_tios sizeof_termios\n             set_saved_termios fd saved_tios\n\n        -- tcsetattr() when invoked by a background process causes the process\n        -- to be sent SIGTTOU regardless of whether the process has TOSTOP set\n        -- in its terminal flags (try it...).  This function provides a\n        -- wrapper which temporarily blocks SIGTTOU around the call, making it\n        -- transparent.\n        allocaBytes sizeof_sigset_t $ \\ p_sigset -> do\n          allocaBytes sizeof_sigset_t $ \\ p_old_sigset -> do\n             throwErrnoIfMinus1_ \"sigemptyset\" $\n                 c_sigemptyset p_sigset\n             throwErrnoIfMinus1_ \"sigaddset\" $\n                 c_sigaddset   p_sigset const_sigttou\n             throwErrnoIfMinus1_ \"sigprocmask\" $\n                 c_sigprocmask const_sig_block p_sigset p_old_sigset\n             r <- fun p_tios  -- do the business\n             throwErrnoIfMinus1Retry_ \"tcSetAttr\" $\n                 c_tcsetattr fd const_tcsanow p_tios\n             throwErrnoIfMinus1_ \"sigprocmask\" $\n                 c_sigprocmask const_sig_setmask p_old_sigset nullPtr\n             return r\n\nforeign import ccall unsafe \"HsBase.h __hscore_get_saved_termios\"\n   get_saved_termios :: CInt -> IO (Ptr CTermios)\n\nforeign import ccall unsafe \"HsBase.h __hscore_set_saved_termios\"\n   set_saved_termios :: CInt -> (Ptr CTermios) -> IO ()\n\n#else\n\n-- 'raw' mode for Win32 means turn off 'line input' (=> buffering and\n-- character translation for the console.) The Win32 API for doing\n-- this is GetConsoleMode(), which also requires echoing to be disabled\n-- when turning off 'line input' processing. Notice that turning off\n-- 'line input' implies enter/return is reported as '\\r' (and it won't\n-- report that character until another character is input..odd.) This\n-- latter feature doesn't sit too well with IO actions like IO.hGetLine..\n-- consider yourself warned.\nsetCooked :: FD -> Bool -> IO ()\nsetCooked fd cooked = do\n  x <- set_console_buffering fd (if cooked then 1 else 0)\n  if (x /= 0)\n   then ioError (ioe_unk_error \"setCooked\" \"failed to set buffering\")\n   else return ()\n\nioe_unk_error :: String -> String -> IOException\nioe_unk_error loc msg\n = ioeSetErrorString (mkIOError OtherError loc Nothing Nothing) msg\n\n-- Note: echoing goes hand in hand with enabling 'line input' / raw-ness\n-- for Win32 consoles, hence setEcho ends up being the inverse of setCooked.\nsetEcho :: FD -> Bool -> IO ()\nsetEcho fd on = do\n  x <- set_console_echo fd (if on then 1 else 0)\n  if (x /= 0)\n   then ioError (ioe_unk_error \"setEcho\" \"failed to set echoing\")\n   else return ()\n\ngetEcho :: FD -> IO Bool\ngetEcho fd = do\n  r <- get_console_echo fd\n  if (r == (-1))\n   then ioError (ioe_unk_error \"getEcho\" \"failed to get echoing\")\n   else return (r == 1)\n\nforeign import ccall unsafe \"consUtils.h set_console_buffering__\"\n   set_console_buffering :: CInt -> CInt -> IO CInt\n\nforeign import ccall unsafe \"consUtils.h set_console_echo__\"\n   set_console_echo :: CInt -> CInt -> IO CInt\n\nforeign import ccall unsafe \"consUtils.h get_console_echo__\"\n   get_console_echo :: CInt -> IO CInt\n\nforeign import ccall unsafe \"consUtils.h is_console__\"\n   is_console :: CInt -> IO CInt\n\n#endif\n\n-- ---------------------------------------------------------------------------\n-- Turning on non-blocking for a file descriptor\n\nsetNonBlockingFD :: FD -> Bool -> IO ()\n#if !defined(mingw32_HOST_OS)\nsetNonBlockingFD fd set = do\n  flags <- throwErrnoIfMinus1Retry \"setNonBlockingFD\"\n                 (c_fcntl_read fd const_f_getfl)\n  let flags' | set       = flags .|. o_NONBLOCK\n             | otherwise = flags .&. complement o_NONBLOCK\n  when (flags /= flags') $ do\n    -- An error when setting O_NONBLOCK isn't fatal: on some systems\n    -- there are certain file handles on which this will fail (eg. /dev/null\n    -- on FreeBSD) so we throw away the return code from fcntl_write.\n    _ <- c_fcntl_write fd const_f_setfl (fromIntegral flags')\n    return ()\n#else\n\n-- bogus defns for win32\nsetNonBlockingFD _ _ = return ()\n\n#endif\n\n-- -----------------------------------------------------------------------------\n-- Set close-on-exec for a file descriptor\n\n#if !defined(mingw32_HOST_OS)\nsetCloseOnExec :: FD -> IO ()\nsetCloseOnExec fd = do\n  throwErrnoIfMinus1_ \"setCloseOnExec\" $\n    c_fcntl_write fd const_f_setfd const_fd_cloexec\n#endif\n\n-- -----------------------------------------------------------------------------\n-- foreign imports\n\n#if !defined(mingw32_HOST_OS)\ntype CFilePath = CString\n#else\ntype CFilePath = CWString\n#endif\n\nforeign import ccall unsafe \"HsBase.h __hscore_open\"\n   c_open :: CFilePath -> CInt -> CMode -> IO CInt\n\nforeign import ccall safe \"HsBase.h __hscore_open\"\n   c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h __hscore_fstat\"\n   c_fstat :: CInt -> Ptr CStat -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h __hscore_lstat\"\n   lstat :: CFilePath -> Ptr CStat -> IO CInt\n\n{- Note: Win32 POSIX functions\nFunctions that are not part of the POSIX standards were\nat some point deprecated by Microsoft. This deprecation\nwas performed by renaming the functions according to the\nC++ ABI Section 17.6.4.3.2b. This was done to free up the\nnamespace of normal Windows programs since Windows isn't\nPOSIX compliant anyway.\n\nThese were working before since the RTS was re-exporting\nthese symbols under the undeprecated names. This is no longer\nbeing done. See #11223\n\nSee https://msdn.microsoft.com/en-us/library/ms235384.aspx\nfor more.\n\nHowever since we can't hope to get people to support Windows\npackages we should support the deprecated names. See #12497\n-}\nforeign import capi unsafe \"unistd.h lseek\"\n   c_lseek :: CInt -> COff -> CInt -> IO COff\n\nforeign import ccall unsafe \"HsBase.h access\"\n   c_access :: CString -> CInt -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h chmod\"\n   c_chmod :: CString -> CMode -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h close\"\n   c_close :: CInt -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h creat\"\n   c_creat :: CString -> CMode -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h dup\"\n   c_dup :: CInt -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h dup2\"\n   c_dup2 :: CInt -> CInt -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h isatty\"\n   c_isatty :: CInt -> IO CInt\n\n#if defined(mingw32_HOST_OS)\n-- See Note: Windows types\nforeign import capi unsafe \"HsBase.h _read\"\n   c_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt\n\n-- See Note: Windows types\nforeign import capi safe \"HsBase.h _read\"\n   c_safe_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h _umask\"\n   c_umask :: CMode -> IO CMode\n\n-- See Note: Windows types\nforeign import capi unsafe \"HsBase.h _write\"\n   c_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt\n\n-- See Note: Windows types\nforeign import capi safe \"HsBase.h _write\"\n   c_safe_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h _pipe\"\n   c_pipe :: Ptr CInt -> IO CInt\n#else\n-- We use CAPI as on some OSs (eg. Linux) this is wrapped by a macro\n-- which redirects to the 64-bit-off_t versions when large file\n-- support is enabled.\n\n-- See Note: Windows types\nforeign import capi unsafe \"HsBase.h read\"\n   c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize\n\n-- See Note: Windows types\nforeign import capi safe \"HsBase.h read\"\n   c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize\n\nforeign import ccall unsafe \"HsBase.h umask\"\n   c_umask :: CMode -> IO CMode\n\n-- See Note: Windows types\nforeign import capi unsafe \"HsBase.h write\"\n   c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize\n\n-- See Note: Windows types\nforeign import capi safe \"HsBase.h write\"\n   c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize\n\nforeign import ccall unsafe \"HsBase.h pipe\"\n   c_pipe :: Ptr CInt -> IO CInt\n#endif\n\nforeign import ccall unsafe \"HsBase.h unlink\"\n   c_unlink :: CString -> IO CInt\n\nforeign import capi unsafe \"HsBase.h utime\"\n   c_utime :: CString -> Ptr CUtimbuf -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h getpid\"\n   c_getpid :: IO CPid\n\nforeign import ccall unsafe \"HsBase.h __hscore_stat\"\n   c_stat :: CFilePath -> Ptr CStat -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h __hscore_ftruncate\"\n   c_ftruncate :: CInt -> COff -> IO CInt\n\n#if !defined(mingw32_HOST_OS)\nforeign import capi unsafe \"HsBase.h fcntl\"\n   c_fcntl_read  :: CInt -> CInt -> IO CInt\n\nforeign import capi unsafe \"HsBase.h fcntl\"\n   c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt\n\nforeign import capi unsafe \"HsBase.h fcntl\"\n   c_fcntl_lock  :: CInt -> CInt -> Ptr CFLock -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h fork\"\n   c_fork :: IO CPid\n\nforeign import ccall unsafe \"HsBase.h link\"\n   c_link :: CString -> CString -> IO CInt\n\n-- capi is required at least on Android\nforeign import capi unsafe \"HsBase.h mkfifo\"\n   c_mkfifo :: CString -> CMode -> IO CInt\n\nforeign import capi unsafe \"signal.h sigemptyset\"\n   c_sigemptyset :: Ptr CSigset -> IO CInt\n\nforeign import capi unsafe \"signal.h sigaddset\"\n   c_sigaddset :: Ptr CSigset -> CInt -> IO CInt\n\nforeign import capi unsafe \"signal.h sigprocmask\"\n   c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt\n\n-- capi is required at least on Android\nforeign import capi unsafe \"HsBase.h tcgetattr\"\n   c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt\n\n-- capi is required at least on Android\nforeign import capi unsafe \"HsBase.h tcsetattr\"\n   c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt\n\nforeign import ccall unsafe \"HsBase.h waitpid\"\n   c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid\n#endif\n\n-- POSIX flags only:\nforeign import ccall unsafe \"HsBase.h __hscore_o_rdonly\" o_RDONLY :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_wronly\" o_WRONLY :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_rdwr\"   o_RDWR   :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_append\" o_APPEND :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_creat\"  o_CREAT  :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_excl\"   o_EXCL   :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_trunc\"  o_TRUNC  :: CInt\n\n-- non-POSIX flags.\nforeign import ccall unsafe \"HsBase.h __hscore_o_noctty\"   o_NOCTTY   :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_nonblock\" o_NONBLOCK :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_o_binary\"   o_BINARY   :: CInt\n\nforeign import capi unsafe \"sys/stat.h S_ISREG\"  c_s_isreg  :: CMode -> CInt\nforeign import capi unsafe \"sys/stat.h S_ISCHR\"  c_s_ischr  :: CMode -> CInt\nforeign import capi unsafe \"sys/stat.h S_ISBLK\"  c_s_isblk  :: CMode -> CInt\nforeign import capi unsafe \"sys/stat.h S_ISDIR\"  c_s_isdir  :: CMode -> CInt\nforeign import capi unsafe \"sys/stat.h S_ISFIFO\" c_s_isfifo :: CMode -> CInt\n\ns_isreg  :: CMode -> Bool\ns_isreg cm = c_s_isreg cm /= 0\ns_ischr  :: CMode -> Bool\ns_ischr cm = c_s_ischr cm /= 0\ns_isblk  :: CMode -> Bool\ns_isblk cm = c_s_isblk cm /= 0\ns_isdir  :: CMode -> Bool\ns_isdir cm = c_s_isdir cm /= 0\ns_isfifo :: CMode -> Bool\ns_isfifo cm = c_s_isfifo cm /= 0\n\nforeign import ccall unsafe \"HsBase.h __hscore_sizeof_stat\" sizeof_stat :: Int\nforeign import ccall unsafe \"HsBase.h __hscore_st_mtime\" st_mtime :: Ptr CStat -> IO CTime\n#if defined(mingw32_HOST_OS)\nforeign import ccall unsafe \"HsBase.h __hscore_st_size\" st_size :: Ptr CStat -> IO Int64\n#else\nforeign import ccall unsafe \"HsBase.h __hscore_st_size\" st_size :: Ptr CStat -> IO COff\n#endif\nforeign import ccall unsafe \"HsBase.h __hscore_st_mode\" st_mode :: Ptr CStat -> IO CMode\nforeign import ccall unsafe \"HsBase.h __hscore_st_dev\" st_dev :: Ptr CStat -> IO CDev\nforeign import ccall unsafe \"HsBase.h __hscore_st_ino\" st_ino :: Ptr CStat -> IO CIno\n\nforeign import ccall unsafe \"HsBase.h __hscore_echo\"         const_echo :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_tcsanow\"      const_tcsanow :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_icanon\"       const_icanon :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_vmin\"         const_vmin   :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_vtime\"        const_vtime  :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_sigttou\"      const_sigttou :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_sig_block\"    const_sig_block :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_sig_setmask\"  const_sig_setmask :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_f_getfl\"      const_f_getfl :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_f_setfl\"      const_f_setfl :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_f_setfd\"      const_f_setfd :: CInt\nforeign import ccall unsafe \"HsBase.h __hscore_fd_cloexec\"   const_fd_cloexec :: CLong\n\n#if defined(HTYPE_TCFLAG_T)\nforeign import ccall unsafe \"HsBase.h __hscore_sizeof_termios\"  sizeof_termios :: Int\nforeign import ccall unsafe \"HsBase.h __hscore_sizeof_sigset_t\" sizeof_sigset_t :: Int\n\nforeign import ccall unsafe \"HsBase.h __hscore_lflag\" c_lflag :: Ptr CTermios -> IO CTcflag\nforeign import ccall unsafe \"HsBase.h __hscore_poke_lflag\" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO ()\nforeign import ccall unsafe \"HsBase.h __hscore_ptr_c_cc\" ptr_c_cc  :: Ptr CTermios -> IO (Ptr Word8)\n#endif\n\ns_issock :: CMode -> Bool\n#if !defined(mingw32_HOST_OS)\ns_issock cmode = c_s_issock cmode /= 0\nforeign import capi unsafe \"sys/stat.h S_ISSOCK\" c_s_issock :: CMode -> CInt\n#else\ns_issock _ = False\n#endif\n\nforeign import ccall unsafe \"__hscore_bufsiz\"  dEFAULT_BUFFER_SIZE :: Int\nforeign import capi  unsafe \"stdio.h value SEEK_CUR\" sEEK_CUR :: CInt\nforeign import capi  unsafe \"stdio.h value SEEK_SET\" sEEK_SET :: CInt\nforeign import capi  unsafe \"stdio.h value SEEK_END\" sEEK_END :: CInt\n\n{-\nNote: Windows types\n\nWindows' _read and _write have types that differ from POSIX. They take an\nunsigned int for lengh and return a signed int where POSIX uses size_t and\nssize_t. Those are different on x86_64 and equivalent on x86. We import them\nwith the types in Microsoft's documentation which means that c_read,\nc_safe_read, c_write and c_safe_write have different Haskell types depending on\nthe OS.\n-}\n\n", "num_lines": 603}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE Trustworthy #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  System.Posix.Types\n-- Copyright   :  (c) The University of Glasgow 2002\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (requires POSIX)\n--\n-- POSIX data types: Haskell equivalents of the types defined by the\n-- @\\<sys\\/types.h>@ C header on a POSIX system.\n--\n-----------------------------------------------------------------------------\n#include \"HsBaseConfig.h\"\n\nmodule System.Posix.Types (\n\n  -- * POSIX data types\n\n  -- ** Platform differences\n  -- | This module contains platform specific information about types.\n  --   __/As such the types presented on this page reflect the platform\n  --   on which the documentation was generated and may not coincide with\n  --   the types on your platform./__\n#if defined(HTYPE_DEV_T)\n  CDev(..),\n#endif\n#if defined(HTYPE_INO_T)\n  CIno(..),\n#endif\n#if defined(HTYPE_MODE_T)\n  CMode(..),\n#endif\n#if defined(HTYPE_OFF_T)\n  COff(..),\n#endif\n#if defined(HTYPE_PID_T)\n  CPid(..),\n#endif\n#if defined(HTYPE_SSIZE_T)\n  CSsize(..),\n#endif\n\n#if defined(HTYPE_GID_T)\n  CGid(..),\n#endif\n#if defined(HTYPE_NLINK_T)\n  CNlink(..),\n#endif\n#if defined(HTYPE_UID_T)\n  CUid(..),\n#endif\n#if defined(HTYPE_CC_T)\n  CCc(..),\n#endif\n#if defined(HTYPE_SPEED_T)\n  CSpeed(..),\n#endif\n#if defined(HTYPE_TCFLAG_T)\n  CTcflag(..),\n#endif\n#if defined(HTYPE_RLIM_T)\n  CRLim(..),\n#endif\n#if defined(HTYPE_BLKSIZE_T)\n  CBlkSize(..),\n#endif\n#if defined(HTYPE_BLKCNT_T)\n  CBlkCnt(..),\n#endif\n#if defined(HTYPE_CLOCKID_T)\n  CClockId(..),\n#endif\n#if defined(HTYPE_FSBLKCNT_T)\n  CFsBlkCnt(..),\n#endif\n#if defined(HTYPE_FSFILCNT_T)\n  CFsFilCnt(..),\n#endif\n#if defined(HTYPE_ID_T)\n  CId(..),\n#endif\n#if defined(HTYPE_KEY_T)\n  CKey(..),\n#endif\n#if defined(HTYPE_TIMER_T)\n  CTimer(..),\n#endif\n\n  Fd(..),\n\n  -- See Note [Exporting constructors of marshallable foreign types]\n  -- in Foreign.Ptr for why the constructors for these newtypes are\n  -- exported.\n\n#if defined(HTYPE_NLINK_T)\n  LinkCount,\n#endif\n#if defined(HTYPE_UID_T)\n  UserID,\n#endif\n#if defined(HTYPE_GID_T)\n  GroupID,\n#endif\n\n  ByteCount,\n  ClockTick,\n  EpochTime,\n  FileOffset,\n  ProcessID,\n  ProcessGroupID,\n  DeviceID,\n  FileID,\n  FileMode,\n  Limit\n ) where\n\nimport Foreign\nimport Foreign.C\n-- import Data.Bits\n\nimport GHC.Base\nimport GHC.Enum\nimport GHC.Num\nimport GHC.Real\n-- import GHC.Prim\nimport GHC.Read\nimport GHC.Show\n\n#include \"CTypes.h\"\n\n#if defined(HTYPE_DEV_T)\nINTEGRAL_TYPE(CDev,HTYPE_DEV_T)\n#endif\n#if defined(HTYPE_INO_T)\nINTEGRAL_TYPE(CIno,HTYPE_INO_T)\n#endif\n#if defined(HTYPE_MODE_T)\nINTEGRAL_TYPE_WITH_CTYPE(CMode,mode_t,HTYPE_MODE_T)\n#endif\n#if defined(HTYPE_OFF_T)\nINTEGRAL_TYPE(COff,HTYPE_OFF_T)\n#endif\n#if defined(HTYPE_PID_T)\nINTEGRAL_TYPE(CPid,HTYPE_PID_T)\n#endif\n\n#if defined(HTYPE_SSIZE_T)\nINTEGRAL_TYPE(CSsize,HTYPE_SSIZE_T)\n#endif\n\n#if defined(HTYPE_GID_T)\nINTEGRAL_TYPE(CGid,HTYPE_GID_T)\n#endif\n#if defined(HTYPE_NLINK_T)\nINTEGRAL_TYPE(CNlink,HTYPE_NLINK_T)\n#endif\n\n#if defined(HTYPE_UID_T)\nINTEGRAL_TYPE(CUid,HTYPE_UID_T)\n#endif\n#if defined(HTYPE_CC_T)\nARITHMETIC_TYPE(CCc,HTYPE_CC_T)\n#endif\n#if defined(HTYPE_SPEED_T)\nARITHMETIC_TYPE(CSpeed,HTYPE_SPEED_T)\n#endif\n#if defined(HTYPE_TCFLAG_T)\nINTEGRAL_TYPE(CTcflag,HTYPE_TCFLAG_T)\n#endif\n#if defined(HTYPE_RLIM_T)\nINTEGRAL_TYPE(CRLim,HTYPE_RLIM_T)\n#endif\n\n#if defined(HTYPE_BLKSIZE_T)\n-- | @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CBlkSize,blksize_t,HTYPE_BLKSIZE_T)\n#endif\n#if defined(HTYPE_BLKCNT_T)\n-- | @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CBlkCnt,blkcnt_t,HTYPE_BLKCNT_T)\n#endif\n#if defined(HTYPE_CLOCKID_T)\n-- | @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CClockId,clockid_t,HTYPE_CLOCKID_T)\n#endif\n#if defined(HTYPE_FSBLKCNT_T)\n-- | @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CFsBlkCnt,fsblkcnt_t,HTYPE_FSBLKCNT_T)\n#endif\n#if defined(HTYPE_FSFILCNT_T)\n-- | @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CFsFilCnt,fsfilcnt_t,HTYPE_FSFILCNT_T)\n#endif\n#if defined(HTYPE_ID_T)\n-- | @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CId,id_t,HTYPE_ID_T)\n#endif\n#if defined(HTYPE_KEY_T)\n-- | @since 4.10.0.0\nINTEGRAL_TYPE_WITH_CTYPE(CKey,key_t,HTYPE_KEY_T)\n#endif\n#if defined(HTYPE_TIMER_T)\n-- | @since 4.10.0.0\nOPAQUE_TYPE_WITH_CTYPE(CTimer,timer_t,HTYPE_TIMER_T)\n#endif\n\n-- Make an Fd type rather than using CInt everywhere\nINTEGRAL_TYPE(Fd,CInt)\n\n-- nicer names, and backwards compatibility with POSIX library:\n#if defined(HTYPE_NLINK_T)\ntype LinkCount      = CNlink\n#endif\n#if defined(HTYPE_UID_T)\ntype UserID         = CUid\n#endif\n#if defined(HTYPE_GID_T)\ntype GroupID        = CGid\n#endif\n\ntype ByteCount      = CSize\ntype ClockTick      = CClock\ntype EpochTime      = CTime\ntype DeviceID       = CDev\ntype FileID         = CIno\ntype FileMode       = CMode\ntype ProcessID      = CPid\ntype FileOffset     = COff\ntype ProcessGroupID = CPid\ntype Limit          = CLong\n", "num_lines": 241}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing that Show for Addr is OK..\nmodule Main(main) where\n\nimport Foreign.Ptr\n\nmain :: IO ()\nmain = do\n  print (nullPtr `plusPtr` maxBound)\n  print (nullPtr `plusPtr` minBound)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Exception\n\n-- We want to get the assertion failure, not the overflow exception.\n-- trac #5561.\n\nmain :: IO ()\nmain = let e1 i = throw Overflow\n       in assert False (e1 5)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, GADTs, RankNTypes #-}\n{-# LANGUAGE TypeOperators, KindSignatures #-}\nmodule CatEntail where\nimport Prelude hiding (id, (.))\nimport Data.Kind\nimport Control.Category\n\n-- One dictionary to rule them all.\ndata Dict :: Constraint -> Type where\n  Dict :: ctx => Dict ctx\n\n-- Entailment.\n-- Note the kind 'Constraint -> Constraint -> *'\nnewtype (|-) a b = Sub (a => Dict b)\n\n(\\\\) :: a => (b => r) -> (a |- b) -> r\nr \\\\ Sub Dict = r\n\nreflexive :: a |- a\nreflexive = Sub Dict\n\ntransitive :: (b |- c) -> (a |- b) -> a |- c\ntransitive f g = Sub $ Dict \\\\ f \\\\ g\n\ninstance Category (|-) where\n  id  = reflexive\n  (.) = transitive\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}\nmodule CatPairs where\n\nimport Prelude hiding (id, (.))\nimport Data.Kind (Type)\nimport Control.Monad ((>=>))\nimport Control.Category\n\n-- Categories over pairs of types.\n-- Taken from Twan van Laarhoven:\n--   http://twanvl.nl/blog/haskell/categories-over-pairs-of-types\n\ntype family Fst (xy :: (Type, Type)) :: Type\ntype family Snd (xy :: (Type, Type)) :: Type\ntype instance Fst '(x,y) = x\ntype instance Snd '(x,y) = y\n\n-- Ceci n'est pas une pipe\ndata Pipe i o u m r = Pipe { runPipe :: Either i u -> m (Either o r) }\n\n(>+>) :: Monad m\n      => Pipe io1 io2 ur1 m ur2\n      -> Pipe io2 io3 ur2 m ur3\n      -> Pipe io1 io3 ur1 m ur3\n(>+>) (Pipe f) (Pipe g) = Pipe (f >=> g)\n\nidP :: Monad m => Pipe i i r m r\nidP = Pipe return\n\nnewtype WrapPipe m iu or = WrapPipe\n    { unWrapPipe :: Pipe (Fst iu) (Fst or) (Snd iu) m (Snd or) }\n\ninstance Monad m => Category (WrapPipe m) where\n  id    = WrapPipe idP\n  x . y = WrapPipe (unWrapPipe y >+> unWrapPipe x)\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing the behaviour of Char.lexLitChar a little..\n\n-- [March 2003]  We now allow \\X and \\O as escapes although the \n-- spec only permits \\x and \\o.  Seems more consistent. \n\nmodule Main where\n\nimport Data.Char\n\nlex' str = do\n  putStr (\"lex \" ++ str ++ \" = \")\n  print (lex str)\n\nhexes = do\n  lex' \"'\\\\X00'\"\n  lex' \"'\\\\x0f2'\"\n  lex' \"'\\\\xf2'\"\n  lex' \"'\\\\xf2t'\"\n  lex' \"'\\\\X24'\"\n  lex' \"'\\\\x24b'\"\n  lex' \"'\\\\Xa4b'\"\n  lex' \"'\\\\xa4bg'\"\n\nocts = do\n  lex' \"'\\\\o00'\"\n  lex' \"'\\\\o05'\"\n  lex' \"'\\\\o50'\"\n  lex' \"'\\\\o72'\"\n  lex' \"'\\\\o82'\"\n  lex' \"'\\\\O24'\"\n  lex' \"'\\\\O000024'\"\n  lex' \"'\\\\024b'\"\n  lex' \"'\\\\o14b'\"\n  lex' \"'\\\\0a4bg'\"\n\nmain = do\n  hexes\n  octs\n\n\n\n\n\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests for large character values in literals\nimport Data.Char\nmain = do\n  print (ord '\\xffff')\n  print (ord '\\o7777')\n  print (ord '\\65535')\n  print (map ord \"\\xffff\\o7777\\65535\")\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test getCPUTime\n\nimport System.CPUTime\nimport System.IO\n\nmain :: IO ()\nmain = do\n    t28 <- timeFib 28\n    t29 <- timeFib 29\n    t30 <- timeFib 30\n    print (t28 <= t29, t29 <= t30)\n\ntimeFib :: Integer -> IO Integer\ntimeFib n = do\n    start <- getCPUTime\n    print (nfib n)\n    end <- getCPUTime\n    return (end - start)\n\nnfib :: Integer -> Integer\nnfib n\n  | n <= 1 = 1\n  | otherwise = (n1 + n2 + 1)\n  where\n    n1 = nfib (n-1)\n    n2 = nfib (n-2)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport Foreign.C.String\n\ntest_strings = [\"Hello World\", replicate 10000 'a']\n\nassertEqual :: (Eq a, Show a) => a -> a -> IO ()\nassertEqual x y = if x == y then return () else error $ \"assertEqual: \" ++ show x ++ \" /= \" ++ show y\n\nmain = do\n    -- Try roundtripping some ASCII strings through the locale encoding\n    forM test_strings $ \\try_str -> do\n        got_str <- withCString try_str peekCString\n        got_str `assertEqual` try_str\n\n    -- Try roundtripping some ASCII strings with lengths through the locale encoding\n    forM test_strings $ \\try_str -> do\n        got_str <- withCStringLen try_str peekCStringLen\n        got_str `assertEqual` try_str\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Data.Fixed\n\ndata B7\n\ninstance HasResolution B7 where\n  resolution _ = 128\n\nmain :: IO ()\nmain = do doit 38.001\n          doit 38.009\n          doit 38.01\n          doit 38.09\n          print (read \"38\" :: Centi)\n          doit (-38.001)\n          doit (-38.009)\n          doit (-38.01)\n          doit (-38.09)\n          print (read \"-38\" :: Centi)\n          print (read \"0.008\" :: Fixed B7)\n          print (read \"-0.008\" :: Fixed B7)\n          print $ show (Just (-1 :: Milli))\n          print $ show (Just (1 :: Milli))\n          print ((read $ show (Just (-1 :: Deci))) :: Maybe Deci)\n          print ((read $ show (Just (1 :: Deci))) :: Maybe Deci)\n\ndoit :: Centi -> IO ()\ndoit c = do let s = show c\n                r = read s :: Centi\n            putStrLn s\n            print r\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Dynamic library regression tests\nmodule Main(main) where\n\nimport Data.Dynamic\n\nmain :: IO ()\nmain = do\n   test   \"toDyn\"   toDyn_list\n   testIO \"fromDyn\" fromDyn_test\n\ntoDyn_list :: [Dynamic]\ntoDyn_list =\n    [ toDyn (1::Int)\n    , toDyn ('a')\n    , toDyn False\n    , toDyn ((-1.0)::Float)\n    , toDyn (0.0::Double)\n    , toDyn (1394::Integer)\n    , toDyn (print \"hello\")\n    , toDyn toDyn_list\n    , toDyn ([]::[Int])\n    , toDyn (Nothing  :: Maybe Int)\n    , toDyn ((Just 2) :: Maybe Int)\n    , toDyn ((Just 2) :: Maybe Int)\n    , toDyn ((Left 3) :: Either Int Bool)\n    , toDyn ((Right 3) :: Either Char Int)\n    , toDyn ()\n    , toDyn LT\n    , toDyn ((),2::Int)\n    , toDyn ((),2::Int,'a')\n    , toDyn ((),2::Int,'a',1.0::Double)\n    , toDyn ((),2::Int,'a',1.0::Double,Nothing::Maybe Bool)\n    , toDyn ((+) :: Int -> Int -> Int)\n    , toDyn ((+) :: Integer -> Integer -> Integer)\n    , toDyn ((++) :: [Char] -> [Char] -> [Char])\n    ]\n\n-- Testing the conversion from Dynamic values:\nfromDyn_test :: IO ()\nfromDyn_test = do\n   print (fromDyn (toDyn (1::Int)) (0::Int))\n   print (fromDyn (toDyn ('a'::Char)) (0::Int))\n   print (fromDyn (toDyn 'a') 'b')\n   print (fromDyn (toDyn (1::Float)) (0::Float))\n   print (fromDyn (toDyn (2::Float)) (0::Int))\n   print (fromDyn (toDyn (3::Double)) (0::Double))\n   print (fromDyn (toDyn (4::Double)) (0::Int))\n   print (fromDyn (toDyn (5::Integer)) (0::Integer))\n   print (fromDyn (toDyn (6::Integer)) False)\n   print (fromDyn (toDyn [1,3,5::Integer]) ([]::[Integer]))\n   print (fromDyn (toDyn (Just True)) (Nothing::Maybe Bool))\n   print (fromDyn (toDyn (Left True::Either Bool Bool)) (Right False :: Either Bool Bool))\n   print (fromDyn (toDyn LT) GT)\n   print (fromDyn (toDyn ((+1)::Int->Int)) False)\n   print ((fromDyn (toDyn ((+1)::Int->Int)) ((+2)::Int->Int)) 3)\n   print ((fromDyn (toDyn ((++)::[Int]->[Int]->[Int])) ((undefined)::[Int]->[Int]->[Int])) [1] [2])\n\n    \n-- Misc test utilities:\ntest :: Show a => String -> [a] -> IO ()\ntest str ls = do\n  putStrLn (\"*** Testing: \" ++ str ++ \" ***\")\n  putStrLn (showListLn ls)\n\ntestIO :: String -> IO () -> IO ()\ntestIO str tst = do\n  putStrLn (\"*** Testing: \" ++ str ++ \" ***\")\n  tst\n\n\n-- showListLn presents a list in a diff-friendly format.\n-- showListLn [a1,..an]\n--  =>\n--      [ a1\n--      , a2\n--      ..\n--      , an\n--      ]\n--   \nshowListLn :: Show a => [a] -> String\nshowListLn [] = \"\"\nshowListLn ls = '[' : ' ' : go ls\n where\n   go    [x] = show x ++ \"\\n]\"\n   go (x:xs) = show x ++ '\\n':',':' ':go xs\n\n{-\ntest8 = toDyn (mkAppTy listTc)\ntest9 :: Float\ntest9 = fromDyn test8 0\n\nprintf :: String -> [Dynamic] -> IO ()\nprintf str args = putStr (decode str args)\n where\n  decode [] [] = []\n  decode ('%':'n':cs) (d:ds) =\n    (\\ v -> show v++decode cs ds) (fromDyn  d (0::Int))\n  decode ('%':'c':cs) (d:ds) =\n    (\\ v -> show v++decode cs ds) (fromDyn  d ('\\0'))\n  decode ('%':'b':cs) (d:ds) =\n    (\\ v -> show v++decode cs ds) (fromDyn  d (False::Bool))\n  decode (x:xs) ds = x:decode xs ds\n\ntest10 :: IO ()\ntest10 = printf \"%n = %c, that much is %b\\n\" [toDyn (3::Int),toDyn 'a', toDyn False]\n\n-}\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- !!! Testing Typeable instances\nmodule Main(main) where\n\nimport Data.Dynamic\n#if MIN_VERSION_base(4,10,0)\nimport Data.Typeable (TyCon, TypeRep, typeOf)\n#endif\nimport Data.Array\nimport Data.Array.MArray\nimport Data.Array.ST\nimport Data.Array.IO\nimport Data.Array.Unboxed\nimport Data.Complex\nimport Data.Int\nimport Data.Word\nimport Data.IORef\nimport System.IO\nimport Control.Monad.ST\nimport System.Mem.StableName\nimport System.Mem.Weak\nimport Foreign.StablePtr\nimport Control.Exception\nimport Foreign.C.Types\n\nmain :: IO ()\nmain = do\n   print (typeOf (undefined :: [()]))\n   print (typeOf (undefined :: ()))\n   print (typeOf (undefined :: ((),())))\n   print (typeOf (undefined :: ((),(),())))\n   print (typeOf (undefined :: ((),(),(),())))\n   print (typeOf (undefined :: ((),(),(),(),())))\n   print (typeOf (undefined :: (() -> ())))\n   print (typeOf (undefined :: (Array () ())))\n   print (typeOf (undefined :: Bool))\n   print (typeOf (undefined :: Char))\n   print (typeOf (undefined :: (Complex ())))\n   print (typeOf (undefined :: Double))\n   print (typeOf (undefined :: (Either () ())))\n   print (typeOf (undefined :: Float))\n   print (typeOf (undefined :: Handle))\n   print (typeOf (undefined :: Int))\n   print (typeOf (undefined :: Integer))\n   print (typeOf (undefined :: IO ()))\n   print (typeOf (undefined :: (Maybe ())))\n   print (typeOf (undefined :: Ordering))\n\n   print (typeOf (undefined :: Dynamic))\n   print (typeOf (undefined :: (IORef ())))\n   print (typeOf (undefined :: Int8))\n   print (typeOf (undefined :: Int16))\n   print (typeOf (undefined :: Int32))\n   print (typeOf (undefined :: Int64))\n   print (typeOf (undefined :: (ST () ())))\n   print (typeOf (undefined :: (StableName ())))\n   print (typeOf (undefined :: (StablePtr ())))\n   print (typeOf (undefined :: TyCon))\n   print (typeOf (undefined :: TypeRep))\n   print (typeOf (undefined :: Word8))\n   print (typeOf (undefined :: Word16))\n   print (typeOf (undefined :: Word32))\n   print (typeOf (undefined :: Word64))\n\n   print (typeOf (undefined :: ArithException))\n   print (typeOf (undefined :: AsyncException))\n   print (typeOf (undefined :: (IOArray () ())))\n   print (typeOf (undefined :: (IOUArray () ())))\n   print (typeOf (undefined :: (STArray () () ())))\n   print (typeOf (undefined :: (STUArray () () ())))\n   print (typeOf (undefined :: (StableName ())))\n   print (typeOf (undefined :: (StablePtr ())))\n   print (typeOf (undefined :: (UArray () ())))\n   print (typeOf (undefined :: (Weak ())))\n\n   print (typeOf (undefined :: CChar))\n   print (typeOf (undefined :: CSChar))\n   print (typeOf (undefined :: CUChar))\n   print (typeOf (undefined :: CShort))\n   print (typeOf (undefined :: CUShort))\n   print (typeOf (undefined :: CInt))\n   print (typeOf (undefined :: CUInt))\n   print (typeOf (undefined :: CLong))\n   print (typeOf (undefined :: CULong))\n   print (typeOf (undefined :: CLLong))\n   print (typeOf (undefined :: CULLong))\n   print (typeOf (undefined :: CFloat))\n   print (typeOf (undefined :: CDouble))\n\n   print (typeOf (undefined :: CPtrdiff))\n   print (typeOf (undefined :: CSize))\n   print (typeOf (undefined :: CWchar))\n   print (typeOf (undefined :: CSigAtomic))\n   print (typeOf (undefined :: CClock))\n   print (typeOf (undefined :: CTime))\n", "num_lines": 97}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- Test generation of large TypeReps\n-- (can be used as a benchmark)\n\nimport Data.Typeable\n\nf :: Typeable a => Int -> a -> TypeRep\nf 0 a = typeOf a\nf n a = f (n-1) [a]\n\nmain = print (f 50000 () == f 50001 ())\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Typeable\nimport GHC.Fingerprint\nimport Text.Printf\n\nf :: Typeable a => Int -> a -> [TypeRep]\nf 0 a = []\nf n a = typeOf a : f (n-1) [a]\n\n-- pointwise compare 1000x1001 TypeReps, there should be exactly 1000 equalities\n-- (can be used as a benchmark)\nmain = print $ length [ t1 | t1 <- f 1000 (), t2 <- f 1001 (), t1 == t2 ]\n\n{-\n DEBUGGING code to help find bugs in the TypeRep implementation when\n this test fails:\n\n where\n   g (x:xs) (y:ys)\n     | x == y = g xs ys\n     | otherwise = do\n         print x\n         case x of\n           TypeRep f1 (TyCon f2 _ _ _) [TypeRep f3 _ _] ->\n              printf \"f1: %s\\nf2: %s\\nf3: %s\\n\" (show_fp f1) (show_fp f2) (show_fp f3)\n         case y of\n           TypeRep f1 (TyCon f2 _ _ _) [TypeRep f3 _ _] ->\n              printf \"f1: %s\\nf2: %s\\nf3: %s\\n\" (show_fp f1) (show_fp f2) (show_fp f3)\n   g _ _ = return ()\n\n   show_fp :: Fingerprint -> String\n   show_fp (Fingerprint h l) =\n       printf \"%x %x\" h l\n-}\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Typeable\n\nf :: Typeable a => Int -> a -> [TypeRep]\nf 0 a = []\nf n a = typeOf a : f (n-1) [a]\n\n-- pointwise compare 1000x1000 different TypeReps, there should be no equalities\n-- (can be used as a benchmark)\n\nmain = print $ length [ t1 | t1 <- replicate 1000 (f 10 ()),\n                             t2 <- replicate 1000 (f 10 'a'),\n                             t1 == t2 ]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\nimport System.IO\nimport Data.Char\n\nmain = do\n  isT <- hIsTerminalDevice stdin\n  flg <- if not isT then return False else hGetEcho stdin\n  print flg\n  if not isT then hSetEcho stdin False else return ()\n  hSetBuffering stdin NoBuffering\n  interact (map toUpper)\n  \n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing the Prelude's Enum instances.\n{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-}\n-- The processor is a non-CPP-based equivalent of\n-- #define printTest(x) (do{ putStr ( \"    \" ++ \"x\" ++ \" = \" ) ; print (x) })\n-- which is not portable to clang\n\nmodule Main(main) where\n\nimport Control.Exception\nimport Data.Char\nimport Data.Ratio\n\nmain = do\n   -- Enum Int\n  putStrLn \"Testing Enum Int: \"\n  testEnumInt\n   -- Enum Integer\n  putStrLn \"Testing Enum Integer: \"\n  testEnumInteger\n   -- Enum Char\n  putStrLn \"Testing Enum Char: \"\n  testEnumChar\n   -- Enum ()\n  putStrLn \"Testing Enum (): \"\n  testEnumUnit\n   -- Enum Ordering\n  putStrLn \"Testing Enum Ordering (derived): \"\n  testEnumOrdering\n   -- Enum Bool\n  putStrLn \"Testing Enum Bool: \"\n  testEnumBool\n   -- Enum Rational\n  putStrLn \"Testing Enum Rational: \"\n  testEnumRational\n   -- Enum (Ratio Int)\n  putStrLn \"Testing Enum (Ratio Int): \"\n  testEnumRatioInt\n\n{-\n  Here's the properties that's supposed to\n  hold for arithmetic sequences over Int:\n\n   - [e1..]    = [e1, (e1+1), (e1+2), ..., maxBound]\n\n   - [e1,e2..] = [e1, (e1+i), (e1+2*i), ... upper]\n                 where\n                  i = e2 - e1\n                  upper\n                   | i >  0 = maxBound\n                   | i <  0 = minBound\n                   | i == 0 = maxBound -- this really shouldn't matter (I feel.)\n   - [e1..e3] = [e1, (e1+i), (e1+2*i),..e3]\n                where\n                 i\n                  | e3 >= e1 = 1\n                  | e3 <  e1 = (-1)\n\n   - [e1,e2..e3] = res\n                   where\n                    i = e2 - e1\n\n                    res\n                     | i >= 0 && e3 <  e1 = []\n                     | i <  0 && e3 >= e1 = []  -- (*)\n                     | otherwise          = [e1, (e1+i), (e1 + 2*i), .. e3]\n\n   Note:\n     (*) - I think this instead should be (i < 0 && e3 > e1), since, as is,\n\n            [x,(x+1) ..x] = [x]\n            [x,(x-1) ..x] = []\n\n           which does not look right, symmetrically speaking.\n\n\n   The same properties hold for other Prelude types that\n   are instances of Enum as well as being Bounded.\n\n   For non-Bounded types (e.g., Float and Double), the properties are similar,\n   except that the boundary tests become slightly different, i.e., when an\n   element becomes greater than (e3 + i/2) (or less than (e3 + i/2) for negative\n   i.)\n\n  Q - does [(x::Double)..] have an upper bound? (ditto for Float.)\n\n  OK - on with the regression testing.\n-}\n\n\n\ntestEnumInt :: IO ()\ntestEnumInt = do\n     -- succ\n  printTest ((succ (0::Int)))\n  printTest ((succ (minBound::Int)))\n  mayBomb   (printTest ((succ (maxBound::Int))))\n\n     -- pred\n  printTest (pred (1::Int))\n  printTest (pred (maxBound::Int))\n  mayBomb   (printTest (pred (minBound::Int)))\n\n     -- toEnum\n  printTest ((map (toEnum::Int->Int) [1,minBound,maxBound]))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Int),minBound,maxBound]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Int)..]))\n  printTest ((take 7 [((maxBound::Int)-5)..])) -- just in case it doesn't catch the upper bound..\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Int),2..]))\n  printTest ((take 7 [(1::Int),7..]))\n  printTest ((take 7 [(1::Int),1..]))\n  printTest ((take 7 [(1::Int),0..]))\n  printTest ((take 7 [(5::Int),2..]))\n  let x = (minBound::Int) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Int) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Int) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n        -- Test overflow conditions\n  printTest (([minBound::Int,1..]))\n  printTest (([minBound::Int,0..]))\n  printTest (([minBound::Int,-1..]))\n  printTest (([maxBound::Int,1..]))\n  printTest (([maxBound::Int,0..]))\n  printTest (([maxBound::Int,-1..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Int) .. 5])))\n  printTest ((take 4 ([(1::Int) .. 1])))\n  printTest ((take 7 ([(1::Int) .. 0])))\n  printTest ((take 7 ([(5::Int) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Int)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Int)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Int),4..1]))\n  printTest ((take 7 [(5::Int),3..1]))\n  printTest ((take 7 [(5::Int),3..2]))\n  printTest ((take 7 [(1::Int),2..1]))\n  printTest ((take 7 [(2::Int),1..2]))\n  printTest ((take 7 [(2::Int),1..1]))\n  printTest ((take 7 [(2::Int),3..1]))\n\n        -- Test overflow conditions\n  printTest (([minBound, 1..maxBound::Int]))\n  printTest (([minBound, 0..maxBound::Int]))\n  printTest (([minBound,-1..maxBound::Int]))\n  printTest (([minBound,-1..maxBound-1::Int]))\n  printTest (([minBound,-1..maxBound-2::Int]))\n\n  printTest (([maxBound, 1..minBound::Int]))\n  printTest (([maxBound, 0..minBound::Int]))\n  printTest (([maxBound, 0..minBound+1::Int]))\n  printTest (([maxBound, 0..minBound+2::Int]))\n  printTest (([maxBound,-1..minBound::Int]))\n\n  let x = (maxBound::Int) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Int) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\ntestEnumChar :: IO ()\ntestEnumChar = do\n     -- succ\n  printTest ((succ 'a'))\n  printTest ((succ (minBound::Char)))\n  mayBomb (printTest ((succ (maxBound::Char))))\n\n     -- pred\n  printTest ((pred 'b'))\n  printTest (pred (maxBound::Char))\n  mayBomb (printTest (pred (minBound::Char)))\n\n     -- toEnum\n  printTest ((map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]))\n  mayBomb (printTest ((toEnum::Int->Char) (minBound::Int)))\n\n     -- fromEnum\n  printTest ((map fromEnum ['X',minBound,maxBound]))\n\n     -- [x..] aka enumFrom\n  -- printTest ((take 7 ['\\NUL' .. ]))\n  do{ putStr ( \"    \" ++ \"(take 7 ['\\\\NUL' .. ])\" ++ \" = \" ) ; print (take 7 ['\\NUL' .. ]) }\n  -- printTest ((take 7 ['\\250' .. ]))\n  do{ putStr ( \"    \" ++ \"(take 7 ['\\\\250' .. ])\" ++ \" = \" ) ; print (take 7 ['\\250' .. ]) }\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 ['a','b'..]))\n  printTest ((take 7 ['a','e'..]))\n  printTest ((take 7 ['a','a'..]))\n  printTest ((take 7 ['z','y'..]))\n  printTest ((take 7 ['z','v'..]))\n  let x = '\\1'\n  -- printTest ((take 7 ['\\1', '\\0' ..]))\n  do{ putStr ( \"    \" ++ \"(take 7 ['\\\\1', '\\\\0' ..])\" ++ \" = \" ) ; print (take 7 ['\\1', '\\0' ..]) }\n  let x = '\\5'\n  -- printTest ((take 7 ['\\5', '\\4' ..]))\n  do{ putStr ( \"    \" ++ \"(take 7 ['\\\\5', '\\\\4' ..])\" ++ \" = \" ) ; print (take 7 ['\\5', '\\4' ..]) }\n  let x = (maxBound::Int) - 5\n  -- printTest ((take 7 ['\\250', '\\251' ..]))\n  do{ putStr ( \"    \" ++ \"(take 7 ['\\\\250', '\\\\251' ..])\" ++ \" = \" ) ; print (take 7 ['\\250', '\\251' ..]) }\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 (['a' .. 'e'])))\n  printTest ((take 4 (['a' .. 'a'])))\n  printTest ((take 7 (['b' .. 'a'])))\n  printTest ((take 7 (['e' .. 'a'])))\n  -- printTest ((take 7 (['\\250' .. '\\255'])))\n  do{ putStr ( \"    \" ++ \"(take 7 (['\\\\250' .. '\\\\255']))\" ++ \" = \" ) ; print (take 7 (['\\250' .. '\\255'])) }\n  -- printTest ((take 7 (['\\5' .. '\\0'])))\n  do{ putStr ( \"    \" ++ \"(take 7 (['\\\\5' .. '\\\\0']))\" ++ \" = \" ) ; print (take 7 (['\\5' .. '\\0'])) }\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 ['f','e' .. 'b']))\n  printTest ((take 7 ['g','e' .. 'b']))\n  printTest ((take 7 ['g','d' .. 'c']))\n  printTest ((take 7 ['b','c' .. 'b']))\n  printTest ((take 7 ['c','b' .. 'c']))\n  printTest ((take 7 ['c','b' .. 'b']))\n  printTest ((take 7 ['c','d' .. 'b']))\n  -- printTest ((take 7 ['\\251', '\\252' .. maxBound]))\n  do{ putStr ( \"    \" ++ \"(take 7 ['\\\\251', '\\\\252' .. maxBound])\" ++ \" = \" ) ; print (take 7 ['\\251', '\\252' .. maxBound]) }\n  -- printTest ((take 7 ['\\5', '\\4' .. minBound]))\n  do{ putStr ( \"    \" ++ \"(take 7 ['\\\\5', '\\\\4' .. minBound])\" ++ \" = \" ) ; print (take 7 ['\\5', '\\4' .. minBound]) }\n\n\ntestEnumUnit :: IO ()\ntestEnumUnit = do\n   -- succ:\n  mayBomb (printTest ((succ ())))\n  mayBomb (printTest ((succ (minBound::()))))\n  mayBomb (printTest ((succ (maxBound::()))))\n\n   -- pred:\n  mayBomb (printTest ((pred ())))\n  mayBomb (printTest ((pred (minBound::()))))\n  mayBomb (printTest ((pred (maxBound::()))))\n\n   -- toEnum:\n  printTest ((toEnum 0)::())\n  mayBomb   (printTest ((toEnum 1)::()))\n\n   -- fromEnum:\n  printTest ((fromEnum ()))\n\n   -- enumFrom:\n  printTest ((take 7 [()..]))\n\n   -- enumFromThen:\n  printTest ((take 7 [(),()..]))\n\n   -- enumFromTo\n  printTest ((take 7 [()..()]))\n\n   -- enumFromThenTo\n  printTest ((take 7 [(),()..()]))\n\ntestEnumOrdering :: IO ()\ntestEnumOrdering = do\n   -- succ:\n  printTest ((succ LT))\n  printTest ((succ (minBound::Ordering)))\n  mayBomb (printTest ((succ (maxBound::Ordering))))\n\n   -- pred:\n  printTest ((pred GT))\n  printTest ((pred (maxBound::Ordering)))\n  mayBomb (printTest ((pred (minBound::Ordering))))\n\n   -- toEnum:\n  printTest ((toEnum 0)::Ordering)\n  mayBomb   (printTest ((toEnum 5)::Ordering))\n\n   -- fromEnum:\n  printTest ((fromEnum LT))\n  printTest ((fromEnum EQ))\n  printTest ((fromEnum GT))\n\n   -- enumFrom:\n  printTest (([LT ..]))\n  printTest (([EQ ..]))\n  printTest (([GT ..]))\n\n   -- enumFromThen:\n  printTest (([LT,EQ ..]))\n  printTest (([EQ,GT ..]))\n  printTest (([EQ,LT ..]))\n  printTest (([LT,GT ..]))\n  printTest (([GT,LT ..]))\n  printTest (take 7 (([GT,GT ..])))\n  printTest (take 7 (([LT,LT ..])))\n\n   -- enumFromTo\n  printTest (([LT .. GT]))\n  printTest (([LT .. EQ]))\n  printTest (([LT .. LT]))\n  printTest (([GT .. LT]))\n  printTest (([GT .. EQ]))\n  printTest (([GT .. GT]))\n\n   -- enumFromThenTo\n  printTest (([LT,EQ .. GT]))\n  printTest (([GT,EQ .. LT]))\n  printTest (([GT,EQ .. EQ]))\n  printTest (([GT,EQ .. GT]))\n  printTest (([GT,EQ .. LT]))\n  printTest (([LT,EQ .. LT]))\n  printTest (([LT,EQ .. GT]))\n  printTest (take 7 (([LT,LT .. GT])))\n  printTest (take 7 (([GT,GT .. LT])))\n\ntestEnumBool :: IO ()\ntestEnumBool = do\n   -- succ:\n  printTest ((succ False))\n  printTest ((succ (minBound::Bool)))\n  mayBomb (printTest ((succ (maxBound::Bool))))\n\n   -- pred:\n  printTest ((pred True))\n  printTest ((pred (maxBound::Bool)))\n  mayBomb (printTest ((pred (minBound::Bool))))\n\n   -- toEnum:\n  printTest ((toEnum 0)::Bool)\n  mayBomb   (printTest ((toEnum 5)::Bool))\n\n   -- fromEnum:\n  printTest ((fromEnum False))\n  printTest ((fromEnum True))\n\n   -- enumFrom:\n  printTest (([False ..]))\n  printTest (([True ..]))\n\n   -- enumFromThen:\n  printTest (([False,True ..]))\n  printTest (([True,False ..]))\n  printTest ((take 7 ([False,False ..])))\n  printTest ((take 7 ([True,True ..])))\n\n   -- enumFromTo\n  printTest (([False .. True]))\n  printTest (([True .. False]))\n\n   -- enumFromThenTo\n  printTest (take 7 ([False,False .. False]))\n  printTest (take 7 ([False,False .. True]))\n  printTest (take 7 ([False,True .. False]))\n  printTest (take 7 ([False,True .. True]))\n  printTest (take 7 ([True,False .. False]))\n  printTest (take 7 ([True,False .. True]))\n  printTest (take 7 ([True,True .. False]))\n  printTest (take 7 ([True,True .. True]))\n\n\ntestEnumInteger :: IO ()\ntestEnumInteger = do\n     -- succ\n  printTest ((succ (0::Integer)))\n  printTest ((succ ((-1)::Integer)))\n\n     -- pred\n  printTest (pred (1::Integer))\n  printTest (pred (0::Integer))\n\n     -- toEnum\n  printTest ((map (toEnum::Int->Integer) [1,minBound,maxBound]))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Integer),42,45]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Integer)..]))\n  printTest ((take 7 [(-5::Integer)..]))\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Integer),2..]))\n  printTest ((take 7 [(1::Integer),7..]))\n  printTest ((take 7 [(1::Integer),1..]))\n  printTest ((take 7 [(1::Integer),0..]))\n  printTest ((take 7 [(5::Integer),2..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Integer) .. 5])))\n  printTest ((take 4 ([(1::Integer) .. 1])))\n  printTest ((take 7 ([(1::Integer) .. 0])))\n  printTest ((take 7 ([(5::Integer) .. 0])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Integer),4..1]))\n  printTest ((take 7 [(5::Integer),3..1]))\n  printTest ((take 7 [(5::Integer),3..2]))\n  printTest ((take 7 [(1::Integer),2..1]))\n  printTest ((take 7 [(2::Integer),1..2]))\n  printTest ((take 7 [(2::Integer),1..1]))\n  printTest ((take 7 [(2::Integer),3..1]))\n\ntestEnumRational :: IO ()\ntestEnumRational = do\n     -- succ\n  printTest ((succ (0::Rational)))\n  printTest ((succ ((-1)::Rational)))\n\n     -- pred\n  printTest (pred (1::Rational))\n  printTest (pred (0::Rational))\n\n     -- toEnum\n  printTest ((map (toEnum::Int->Rational) [1,minBound,maxBound]))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Rational),42,45]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Rational)..]))\n  printTest ((take 7 [(-5::Rational)..]))\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Rational),2..]))\n  printTest ((take 7 [(1::Rational),7..]))\n  printTest ((take 7 [(1::Rational),1..]))\n  printTest ((take 7 [(1::Rational),0..]))\n  printTest ((take 7 [(5::Rational),2..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Rational) .. 5])))\n  printTest ((take 4 ([(1::Rational) .. 1])))\n  printTest ((take 7 ([(1::Rational) .. 0])))\n  printTest ((take 7 ([(5::Rational) .. 0])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Rational),4..1]))\n  printTest ((take 7 [(5::Rational),3..1]))\n  printTest ((take 7 [(5::Rational),3..2]))\n  printTest ((take 7 [(1::Rational),2..1]))\n  printTest ((take 7 [(2::Rational),1..2]))\n  printTest ((take 7 [(2::Rational),1..1]))\n  printTest ((take 7 [(2::Rational),3..1]))\n\ntestEnumRatioInt :: IO ()\ntestEnumRatioInt = do\n     -- succ\n  printTest ((succ (0::Ratio Int)))\n  printTest ((succ ((-1)::Ratio Int)))\n\n     -- pred\n  printTest (pred (1::Ratio Int))\n  printTest (pred (0::Ratio Int))\n\n     -- toEnum\n  printTest ((map (toEnum::Int->Ratio Int) [1,minBound,maxBound]))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Ratio Int),42,45]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Ratio Int)..]))\n  printTest ((take 7 [(-5::Ratio Int)..]))\n  printTest ((take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]))\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Ratio Int),2..]))\n  printTest ((take 7 [(1::Ratio Int),7..]))\n  printTest ((take 7 [(1::Ratio Int),1..]))\n  printTest ((take 7 [(1::Ratio Int),0..]))\n  printTest ((take 7 [(5::Ratio Int),2..]))\n  let x = (toEnum ((minBound::Int) + 1))::Ratio Int\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (toEnum ((minBound::Int) + 5))::Ratio Int\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (toEnum ((maxBound::Int) - 5))::Ratio Int\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Ratio Int) .. 5])))\n  printTest ((take 4 ([(1::Ratio Int) .. 1])))\n  printTest ((take 7 ([(1::Ratio Int) .. 0])))\n  printTest ((take 7 ([(5::Ratio Int) .. 0])))\n  let x = (toEnum (maxBound - (5::Int))) :: Ratio Int\n  let y = (toEnum (maxBound::Int)) :: Ratio Int\n  printTest ((take 7 ([x..y])))\n  let x = (toEnum (minBound + (5::Int))) :: Ratio Int\n  let y = (toEnum (minBound::Int)) :: Ratio Int\n  printTest ((take 7 ([x..y])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Ratio Int),4..1]))\n  printTest ((take 7 [(5::Ratio Int),3..1]))\n  printTest ((take 7 [(5::Ratio Int),3..2]))\n  printTest ((take 7 [(1::Ratio Int),2..1]))\n  printTest ((take 7 [(2::Ratio Int),1..2]))\n  printTest ((take 7 [(2::Ratio Int),1..1]))\n  printTest ((take 7 [(2::Ratio Int),3..1]))\n\n  let x = (toEnum ((maxBound::Int) - 4)) :: Ratio Int\n  let y = (toEnum (maxBound::Int)) :: Ratio Int\n  printTest ((take 7 [x,(x+1)..y]))\n  let x = (toEnum ((minBound::Int) + 5)) :: Ratio Int\n  let y = (toEnum (minBound::Int)) :: Ratio Int\n  printTest ((take 7 [x,(x-1)..y]))\n\n--\n--\n--  Utils\n--\n--\n\n\nmayBomb x = catch x (\\(ErrorCall e) -> putStrLn (\"error \" ++ show e))\n   `catch` (\\e -> putStrLn (\"Fail: \" ++ show (e :: SomeException)))\n\ntest :: Show a => String -> String -> a -> IO ()\ntest test_nm expected val = do\n   putStr test_nm\n   if expected == got then\n      putStrLn \": SUCCEEDED\"\n    else do\n      putStr   \": FAILED\"\n      putStrLn (\"( expected: \" ++ show expected ++ \" , got: \" ++ show got ++ \" )\")\n  where\n   got = show val\n", "num_lines": 530}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing the Int Enum instances.\n{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-}\n-- The processor is a non-CPP-based equivalent of\n-- #define printTest(x) (do{ putStr ( \"    \" ++ \"x\" ++ \" = \" ) ; print (x) })\n-- which is not portable to clang\n\nmodule Main(main) where\n\nimport Control.Exception\nimport Data.Int\n\nmain = do\n  putStrLn \"Testing Enum Int8:\"\n  testEnumInt8\n  putStrLn \"Testing Enum Int16:\"\n  testEnumInt16\n  putStrLn \"Testing Enum Int32:\"\n  testEnumInt32\n  putStrLn \"Testing Enum Int64:\"\n  testEnumInt64\n\n\ntestEnumInt8 :: IO ()\ntestEnumInt8 = do\n     -- succ\n  printTest ((succ (0::Int8)))\n  printTest ((succ (minBound::Int8)))\n  mayBomb   (printTest ((succ (maxBound::Int8))))\n\n     -- pred\n  printTest (pred (1::Int8))\n  printTest (pred (maxBound::Int8))\n  mayBomb   (printTest (pred (minBound::Int8))) \n\n     -- toEnum\n  printTest ((map (toEnum::Int->Int8) [1, fromIntegral (minBound::Int8), fromIntegral (maxBound::Int8)]))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Int8))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Int8),minBound,maxBound]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Int8)..]))\n  printTest ((take 7 [((maxBound::Int8)-5)..])) -- just in case it doesn't catch the upper bound..\n  \n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Int8),2..]))\n  printTest ((take 7 [(1::Int8),7..]))\n  printTest ((take 7 [(1::Int8),1..]))\n  printTest ((take 7 [(1::Int8),0..]))\n  printTest ((take 7 [(5::Int8),2..]))\n  let x = (minBound::Int8) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Int8) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Int8) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Int8) .. 5])))\n  printTest ((take 4 ([(1::Int8) .. 1])))\n  printTest ((take 7 ([(1::Int8) .. 0])))\n  printTest ((take 7 ([(5::Int8) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Int8)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Int8)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Int8),4..1]))\n  printTest ((take 7 [(5::Int8),3..1]))\n  printTest ((take 7 [(5::Int8),3..2]))\n  printTest ((take 7 [(1::Int8),2..1]))\n  printTest ((take 7 [(2::Int8),1..2]))\n  printTest ((take 7 [(2::Int8),1..1]))\n  printTest ((take 7 [(2::Int8),3..1]))\n\n  let x = (maxBound::Int8) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Int8) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\ntestEnumInt16 :: IO ()\ntestEnumInt16 = do\n     -- succ\n  printTest ((succ (0::Int16)))\n  printTest ((succ (minBound::Int16)))\n  mayBomb   (printTest ((succ (maxBound::Int16))))\n\n     -- pred\n  printTest (pred (1::Int16))\n  printTest (pred (maxBound::Int16))\n  mayBomb   (printTest (pred (minBound::Int16))) \n\n     -- toEnum\n  printTest ((map (toEnum::Int->Int16) [1, fromIntegral (minBound::Int16), fromIntegral (maxBound::Int16)]))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Int16))\n\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Int16),minBound,maxBound]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Int16)..]))\n  printTest ((take 7 [((maxBound::Int16)-5)..])) -- just in case it doesn't catch the upper bound..\n  \n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Int16),2..]))\n  printTest ((take 7 [(1::Int16),7..]))\n  printTest ((take 7 [(1::Int16),1..]))\n  printTest ((take 7 [(1::Int16),0..]))\n  printTest ((take 7 [(5::Int16),2..]))\n  let x = (minBound::Int16) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Int16) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Int16) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Int16) .. 5])))\n  printTest ((take 4 ([(1::Int16) .. 1])))\n  printTest ((take 7 ([(1::Int16) .. 0])))\n  printTest ((take 7 ([(5::Int16) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Int16)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Int16)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Int16),4..1]))\n  printTest ((take 7 [(5::Int16),3..1]))\n  printTest ((take 7 [(5::Int16),3..2]))\n  printTest ((take 7 [(1::Int16),2..1]))\n  printTest ((take 7 [(2::Int16),1..2]))\n  printTest ((take 7 [(2::Int16),1..1]))\n  printTest ((take 7 [(2::Int16),3..1]))\n\n  let x = (maxBound::Int16) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Int16) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\ntestEnumInt32 :: IO ()\ntestEnumInt32 = do\n     -- succ\n  printTest ((succ (0::Int32)))\n  printTest ((succ (minBound::Int32)))\n  mayBomb   (printTest ((succ (maxBound::Int32))))\n\n     -- pred\n  printTest (pred (1::Int32))\n  printTest (pred (maxBound::Int32))\n  mayBomb   (printTest (pred (minBound::Int32))) \n\n     -- toEnum\n  printTest ((map (toEnum::Int->Int32) [1, fromIntegral (minBound::Int32), fromIntegral (maxBound::Int32)]))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Int32))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Int32),minBound,maxBound]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Int32)..]))\n  printTest ((take 7 [((maxBound::Int32)-5)..])) -- just in case it doesn't catch the upper bound..\n  \n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Int32),2..]))\n  printTest ((take 7 [(1::Int32),7..]))\n  printTest ((take 7 [(1::Int32),1..]))\n  printTest ((take 7 [(1::Int32),0..]))\n  printTest ((take 7 [(5::Int32),2..]))\n  let x = (minBound::Int32) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Int32) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Int32) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Int32) .. 5])))\n  printTest ((take 4 ([(1::Int32) .. 1])))\n  printTest ((take 7 ([(1::Int32) .. 0])))\n  printTest ((take 7 ([(5::Int32) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Int32)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Int32)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Int32),4..1]))\n  printTest ((take 7 [(5::Int32),3..1]))\n  printTest ((take 7 [(5::Int32),3..2]))\n  printTest ((take 7 [(1::Int32),2..1]))\n  printTest ((take 7 [(2::Int32),1..2]))\n  printTest ((take 7 [(2::Int32),1..1]))\n  printTest ((take 7 [(2::Int32),3..1]))\n\n  let x = (maxBound::Int32) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Int32) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\ntestEnumInt64 :: IO ()\ntestEnumInt64 = do\n     -- succ\n  printTest ((succ (0::Int64)))\n  printTest ((succ (minBound::Int64)))\n  mayBomb   (printTest ((succ (maxBound::Int64))))\n\n     -- pred\n  printTest (pred (1::Int64))\n  printTest (pred (maxBound::Int64))\n  mayBomb   (printTest (pred (minBound::Int64))) \n\n     -- toEnum\n  mayBomb   (printTest ((map (toEnum::Int->Int64) [1, fromIntegral (minBound::Int64), fromIntegral (maxBound::Int64)])))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Int64))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Int64),fromIntegral (minBound::Int) ,fromIntegral (maxBound::Int)]))\n  mayBomb   (printTest (fromEnum (maxBound::Int64)))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Int64)..]))\n  printTest ((take 7 [((maxBound::Int64)-5)..])) -- just in case it doesn't catch the upper bound..\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Int64),2..]))\n  printTest ((take 7 [(1::Int64),7..]))\n  printTest ((take 7 [(1::Int64),1..]))\n  printTest ((take 7 [(1::Int64),0..]))\n  printTest ((take 7 [(5::Int64),2..]))\n  let x = (minBound::Int64) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Int64) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Int64) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Int64) .. 5])))\n  printTest ((take 4 ([(1::Int64) .. 1])))\n  printTest ((take 7 ([(1::Int64) .. 0])))\n  printTest ((take 7 ([(5::Int64) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Int64)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Int64)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Int64),4..1]))\n  printTest ((take 7 [(5::Int64),3..1]))\n  printTest ((take 7 [(5::Int64),3..2]))\n  printTest ((take 7 [(1::Int64),2..1]))\n  printTest ((take 7 [(2::Int64),1..2]))\n  printTest ((take 7 [(2::Int64),1..1]))\n  printTest ((take 7 [(2::Int64),3..1]))\n\n  let x = (maxBound::Int64) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Int64) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\n\n--\n--\n--  Utils\n--\n--\n\n\nmayBomb x = catch x (\\(ErrorCall e) -> putStrLn (\"error \" ++ show e))\n  `catch` (\\e -> putStrLn (\"Fail: \" ++ show (e :: SomeException)))\n", "num_lines": 267}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing the Word Enum instances.\n{-# OPTIONS_GHC -F -pgmF ./enum_processor.bat #-}\n-- The processor is a non-CPP-based equivalent of\n-- #define printTest(x) (do{ putStr ( \"    \" ++ \"x\" ++ \" = \" ) ; print (x) })\n-- which is not portable to clang\n\nmodule Main(main) where\n\nimport Control.Exception\nimport Data.Word\nimport Data.Int\n\nmain = do\n  putStrLn \"Testing Enum Word8:\"\n  testEnumWord8\n  putStrLn \"Testing Enum Word16:\"\n  testEnumWord16\n  putStrLn \"Testing Enum Word32:\"\n  testEnumWord32\n  putStrLn \"Testing Enum Word64:\"\n  testEnumWord64\n\n\n\ntestEnumWord8 :: IO ()\ntestEnumWord8 = do\n     -- succ\n  printTest ((succ (0::Word8)))\n  printTest ((succ (minBound::Word8)))\n  mayBomb   (printTest ((succ (maxBound::Word8))))\n\n     -- pred\n  printTest (pred (1::Word8))\n  printTest (pred (maxBound::Word8))\n  mayBomb   (printTest (pred (minBound::Word8))) \n\n     -- toEnum\n  printTest ((map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Word8))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Word8),minBound,maxBound]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Word8)..]))\n  printTest ((take 7 [((maxBound::Word8)-5)..])) -- just in case it doesn't catch the upper bound..\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Word8),2..]))\n  printTest ((take 7 [(1::Word8),7..]))\n  printTest ((take 7 [(1::Word8),1..]))\n  printTest ((take 7 [(1::Word8),0..]))\n  printTest ((take 7 [(5::Word8),2..]))\n  let x = (minBound::Word8) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Word8) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Word8) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Word8) .. 5])))\n  printTest ((take 4 ([(1::Word8) .. 1])))\n  printTest ((take 7 ([(1::Word8) .. 0])))\n  printTest ((take 7 ([(5::Word8) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Word8)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Word8)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Word8),4..1]))\n  printTest ((take 7 [(5::Word8),3..1]))\n  printTest ((take 7 [(5::Word8),3..2]))\n  printTest ((take 7 [(1::Word8),2..1]))\n  printTest ((take 7 [(2::Word8),1..2]))\n  printTest ((take 7 [(2::Word8),1..1]))\n  printTest ((take 7 [(2::Word8),3..1]))\n\n  let x = (maxBound::Word8) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Word8) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\ntestEnumWord16 :: IO ()\ntestEnumWord16 = do\n     -- succ\n  printTest ((succ (0::Word16)))\n  printTest ((succ (minBound::Word16)))\n  mayBomb   (printTest ((succ (maxBound::Word16))))\n\n     -- pred\n  printTest (pred (1::Word16))\n  printTest (pred (maxBound::Word16))\n  mayBomb   (printTest (pred (minBound::Word16))) \n\n     -- toEnum\n  printTest ((map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Word16))\n\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Word16),minBound,maxBound]))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Word16)..]))\n  printTest ((take 7 [((maxBound::Word16)-5)..])) -- just in case it doesn't catch the upper bound..\n  \n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Word16),2..]))\n  printTest ((take 7 [(1::Word16),7..]))\n  printTest ((take 7 [(1::Word16),1..]))\n  printTest ((take 7 [(1::Word16),0..]))\n  printTest ((take 7 [(5::Word16),2..]))\n  let x = (minBound::Word16) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Word16) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Word16) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Word16) .. 5])))\n  printTest ((take 4 ([(1::Word16) .. 1])))\n  printTest ((take 7 ([(1::Word16) .. 0])))\n  printTest ((take 7 ([(5::Word16) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Word16)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Word16)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Word16),4..1]))\n  printTest ((take 7 [(5::Word16),3..1]))\n  printTest ((take 7 [(5::Word16),3..2]))\n  printTest ((take 7 [(1::Word16),2..1]))\n  printTest ((take 7 [(2::Word16),1..2]))\n  printTest ((take 7 [(2::Word16),1..1]))\n  printTest ((take 7 [(2::Word16),3..1]))\n\n  let x = (maxBound::Word16) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Word16) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\ntestEnumWord32 :: IO ()\ntestEnumWord32 = do\n     -- succ\n  printTest ((succ (0::Word32)))\n  printTest ((succ (minBound::Word32)))\n  mayBomb   (printTest ((succ (maxBound::Word32))))\n\n     -- pred\n  printTest (pred (1::Word32))\n  printTest (pred (maxBound::Word32))\n  mayBomb   (printTest (pred (minBound::Word32))) \n\n     -- toEnum\n  printTest ((map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Word32))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]))\n  mayBomb   (printTest (fromEnum (maxBound::Word32)))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Word32)..]))\n  printTest ((take 7 [((maxBound::Word32)-5)..])) -- just in case it doesn't catch the upper bound..\n  \n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Word32),2..]))\n  printTest ((take 7 [(1::Word32),7..]))\n  printTest ((take 7 [(1::Word32),1..]))\n  printTest ((take 7 [(1::Word32),0..]))\n  printTest ((take 7 [(5::Word32),2..]))\n  let x = (minBound::Word32) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Word32) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Word32) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Word32) .. 5])))\n  printTest ((take 4 ([(1::Word32) .. 1])))\n  printTest ((take 7 ([(1::Word32) .. 0])))\n  printTest ((take 7 ([(5::Word32) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Word32)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Word32)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Word32),4..1]))\n  printTest ((take 7 [(5::Word32),3..1]))\n  printTest ((take 7 [(5::Word32),3..2]))\n  printTest ((take 7 [(1::Word32),2..1]))\n  printTest ((take 7 [(2::Word32),1..2]))\n  printTest ((take 7 [(2::Word32),1..1]))\n  printTest ((take 7 [(2::Word32),3..1]))\n\n  let x = (maxBound::Word32) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Word32) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\ntestEnumWord64 :: IO ()\ntestEnumWord64 = do\n     -- succ\n  printTest ((succ (0::Word64)))\n  printTest ((succ (minBound::Word64)))\n  mayBomb   (printTest ((succ (maxBound::Word64))))\n\n     -- pred\n  printTest (pred (1::Word64))\n  printTest (pred (maxBound::Word64))\n  mayBomb   (printTest (pred (minBound::Word64))) \n\n     -- toEnum\n  mayBomb   (printTest ((map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int])))\n  mayBomb   (printTest ((toEnum (maxBound::Int))::Word64))\n\n     -- fromEnum\n  printTest ((map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]))\n  mayBomb   (printTest (fromEnum (maxBound::Word64)))\n\n     -- [x..] aka enumFrom\n  printTest ((take 7 [(1::Word64)..]))\n  printTest ((take 7 [((maxBound::Word64)-5)..])) -- just in case it doesn't catch the upper bound..\n\n     -- [x,y..] aka enumFromThen\n  printTest ((take 7 [(1::Word64),2..]))\n  printTest ((take 7 [(1::Word64),7..]))\n  printTest ((take 7 [(1::Word64),1..]))\n  printTest ((take 7 [(1::Word64),0..]))\n  printTest ((take 7 [(5::Word64),2..]))\n  let x = (minBound::Word64) + 1\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (minBound::Word64) + 5\n  printTest ((take 7 [x, x-1 ..]))\n  let x = (maxBound::Word64) - 5\n  printTest ((take 7 [x, (x+1) ..]))\n\n     -- [x..y] aka enumFromTo\n  printTest ((take 7 ([(1::Word64) .. 5])))\n  printTest ((take 4 ([(1::Word64) .. 1])))\n  printTest ((take 7 ([(1::Word64) .. 0])))\n  printTest ((take 7 ([(5::Word64) .. 0])))\n  printTest ((take 7 ([(maxBound-(5::Word64)) .. maxBound])))\n  printTest ((take 7 ([(minBound+(5::Word64)) .. minBound])))\n\n     -- [x,y..z] aka enumFromThenTo\n  printTest ((take 7 [(5::Word64),4..1]))\n  printTest ((take 7 [(5::Word64),3..1]))\n  printTest ((take 7 [(5::Word64),3..2]))\n  printTest ((take 7 [(1::Word64),2..1]))\n  printTest ((take 7 [(2::Word64),1..2]))\n  printTest ((take 7 [(2::Word64),1..1]))\n  printTest ((take 7 [(2::Word64),3..1]))\n\n  let x = (maxBound::Word64) - 4\n  printTest ((take 7 [x,(x+1)..maxBound]))\n  let x = (minBound::Word64) + 5\n  printTest ((take 7 [x,(x-1)..minBound]))\n\n\n--\n--\n--  Utils\n--\n--\n\n\nmayBomb x = catch x (\\(ErrorCall e) -> putStrLn (\"error \" ++ show e))\n  `catch` (\\e -> putStrLn (\"Fail: \" ++ show (e :: SomeException)))\n", "num_lines": 270}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nimport Control.Exception\n\n-- enumFrom on basic numeric types should be strict\n-- (possibly a bug in the Haskell Report: it specifies that\n-- these ops should be strict in the section on Enum, but the\n-- sample code in the Prelude doesn't agree, at least for\n-- Float and Double).\n\nmain = do\n  catch (evaluate [error \"\" :: Int ..] >> return ())     (\\(e::SomeException) -> putStrLn \"ok1\")\n  catch (evaluate [error \"\" :: Integer ..] >> return ()) (\\(e::SomeException) -> putStrLn \"ok2\")\n  catch (evaluate [error \"\" :: Float ..] >> return ())   (\\(e::SomeException) -> putStrLn \"ok3\")\n  catch (evaluate [error \"\" :: Double ..] >> return ())  (\\(e::SomeException) -> putStrLn \"ok4\")\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = print (succ (1.0e20 :: Double))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do\n    print $ map (/2) ([5..6] :: [Double])\n    print $ ([9007199254740990..9007199254740991] :: [Double])\n    print $ map (/2) ([9007199254740990..9007199254740991] :: [Double])\n    print $ ([9007199254740989..9007199254740990] :: [Double])\n    print $ map (/2) ([9007199254740989..9007199254740990] :: [Double])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Data.Ratio\nmain = print [ 1, 4%(3::Int) .. 1 ]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport System.IO.Error\n\nmain = do\n  ioTest\n  errorTest\n  noMethodTest\n  patMatchTest\n  guardTest\n\nioTest :: IO ()\nioTest = catchJust (\\e -> if isUserError e then Just () else Nothing)\n                   (ioError (userError \"wibble\"))\n                   (\\() -> putStrLn \"user exception caught\")\n\nerrorTest :: IO ()\nerrorTest = do r <- try (evaluate (1 + error \"call to 'error'\"))\n               case r of\n                   Left (ErrorCall _) -> putStrLn \"error call caught\"\n                   Right _            -> error \"help!\"\n\ninstance (Show a, Eq a) => Num (Maybe a) where {}\n\nnoMethodTest :: IO ()\nnoMethodTest = do r <- try (evaluate (Just () + Just ()))\n                  case r of\n                      Left (NoMethodError err) -> putStrLn \"no method error\"\n                      Right _                  -> error \"help!\"\n\npatMatchTest :: IO ()\npatMatchTest = catch (case test1 [1..10] of () -> return ())\n  (\\ex -> case ex of\n          PatternMatchFail err -> putStr err\n          _                    -> error \"help!\")\n\ntest1 [] = ()\n\nguardTest = catch (case test2 of () -> return ())\n                  (\\ex -> case ex of\n                          PatternMatchFail err -> putStr err\n                          _                    -> error \"help!\")\n\ntest2 | all (==0) [1] = ()\n\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport qualified Control.Exception as Exception\nimport System.IO.Error (mkIOError, catchIOError)\nimport Data.IORef\n\nsafeCatch :: IO () -> IO ()\nsafeCatch f = Exception.catch f\n                  ((\\_ -> return ()) :: Exception.SomeException -> IO ())\n\ntype Thrower = IO Bool\n\ntype Catcher = IO Bool -> IO () -> IO ()\n\ncheckCatch :: Catcher -> Thrower -> IO Bool\ncheckCatch catcher thrower = do\n    ref <- newIORef False\n    safeCatch (catcher thrower (writeIORef ref True))\n    readIORef ref\n\ndata Named a = MkNamed String a\n\ncheckNamedCatch :: Named Catcher -> Named Thrower -> IO ()\ncheckNamedCatch (MkNamed cname catcher) (MkNamed tname thrower) = do\n    didCatch <- checkCatch catcher thrower\n    putStrLn (cname ++ (if didCatch then \" CAUGHT \" else \" MISSED \") ++ tname)\n\ncheckNamedCatches :: [Named Catcher] -> [Named Thrower] -> IO ()\ncheckNamedCatches []     _      = return ()\ncheckNamedCatches _      []     = return ()\ncheckNamedCatches [c]    (t:tr) = do checkNamedCatch c t\n                                     checkNamedCatches [c] tr\ncheckNamedCatches (c:cr) ts     = do checkNamedCatches [c] ts\n                                     checkNamedCatches cr ts\n\n\n-- throwers\n\nreturnThrower :: Named Thrower\nreturnThrower = MkNamed \"return\" (return True)\n\nreturnUndefinedThrower :: Named Thrower\nreturnUndefinedThrower = MkNamed \"return undefined\" (return undefined)\n\nreturnErrorThrower :: Named Thrower\nreturnErrorThrower = MkNamed \"return error\" (return (error \"some error\"))\n\nundefinedThrower :: Named Thrower\nundefinedThrower = MkNamed \"undefined\" undefined\n\nfailThrower :: Named Thrower\nfailThrower = MkNamed \"fail\" (fail \"some failure\")\n\nerrorThrower :: Named Thrower\nerrorThrower = MkNamed \"error\" (error \"some error\")\n\nthrowThrower :: Named Thrower\nthrowThrower = MkNamed \"Exception.throw\"\n (Exception.throw (Exception.ErrorCall \"throw error\"))\n\nioErrorErrorCallThrower :: Named Thrower\nioErrorErrorCallThrower = MkNamed \"ioError ErrorCall\"\n (Exception.throwIO (Exception.ErrorCall \"throw error\"))\n\nioErrorIOExceptionThrower :: Named Thrower\nioErrorIOExceptionThrower = MkNamed \"ioError IOException\"\n (Exception.throwIO (mkIOError undefined undefined undefined undefined))\n\nreturnThrowThrower :: Named Thrower\nreturnThrowThrower = MkNamed \"return Exception.throw\"\n (return (Exception.throw (Exception.ErrorCall \"throw error\")))\n\n\n-- catchers\n\nbindCatcher :: Named Catcher\nbindCatcher = MkNamed \">>\" (>>)\n\npreludeCatchCatcher :: Named Catcher\npreludeCatchCatcher = MkNamed \"Prelude.catch\"\n (\\f cc -> catchIOError (f >> (return ())) (const cc))\n\nceCatchCatcher :: Named Catcher\nceCatchCatcher = MkNamed \"Exception.catch\"\n (\\f cc -> Exception.catch (f >> (return ())) (const cc :: Exception.SomeException -> IO ()))\n\nfinallyCatcher :: Named Catcher\nfinallyCatcher = MkNamed \"Exception.finally\"\n (\\f cc -> Exception.finally (f >> (return ())) cc)\n\nmain = checkNamedCatches\n        [bindCatcher,preludeCatchCatcher,ceCatchCatcher,finallyCatcher]\n        [returnThrower,returnUndefinedThrower,returnThrowThrower,returnErrorThrower,failThrower,\n        errorThrower,throwThrower,ioErrorErrorCallThrower,ioErrorIOExceptionThrower,undefinedThrower]\n\n", "num_lines": 96}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall -Werror #-}\n\nmodule Main where\n\nimport Data.Fixed\n\nnums :: Fractional a => [a]\nnums = [0,7,7.1,7.01,7.9,7.09,5 + 7,3.2 - 7.8,5.75 * (-2)]\n\nmain :: IO ()\nmain = do mapM_ putStrLn $ doit (nums :: [Micro])\n          mapM_ putStrLn $ doit (nums :: [Pico])\n\ndoit :: HasResolution a => [Fixed a] -> [String]\ndoit xs = [ showFun (signFun x)\n          | showFun <- [show, showFixed True]\n          , signFun <- [id, negate]\n          , x <- xs ]\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE CPP #-}\nmodule Main where\nimport Prelude hiding (foldr, foldl, foldl', foldr1, foldl1, length, null, sum,\n                       product, all, any, and, or)\nimport Data.Foldable\nimport Control.Exception\nimport Data.Array\nimport Data.Foldable\nimport Data.Typeable\nimport Data.Either\nimport Control.Applicative\nimport Control.DeepSeq\n#if __GLASGOW_HASKELL__ < 709\nimport qualified Data.List as L\n#else\nimport qualified GHC.List as L\n#endif\n\ndata BadElementException = BadFirst | BadLast deriving (Show, Eq)\ninstance Exception BadElementException\n\nnewtype ForceDefault f a = ForceDefault (f a)\ninstance Foldable f => Foldable (ForceDefault f) where\n  foldMap f (ForceDefault c) = foldMap f c\n\ngoodLists, badFronts, badBacks :: [[Integer]]\ngoodLists = [[0..n] | n <- [(-1)..5]]\nbadFronts = map (throw BadFirst :) goodLists\nbadBacks  = map (++ [throw BadLast]) goodLists\ndoubleBads = map (\\l -> throw BadFirst : l ++ [throw BadLast]) goodLists\nlists =\n        goodLists\n        ++ badFronts\n        ++ badBacks\n        ++ doubleBads\n\nmakeArray xs = array (1::Int, length xs) (zip [1..] xs)\n\narrays = map makeArray lists\ngoodArrays = map makeArray goodLists\n\n\nstrictCons x y = x + 10*y\nrightLazyCons x y = x\nleftLazyCons x y = y\n\nconses :: [Integer -> Integer -> Integer]\nconses = [(+), strictCons, rightLazyCons, leftLazyCons]\n\nrunOneRight :: forall f . Foldable f =>\n                             (forall a b . (a -> b -> b) -> b -> f a -> b) ->\n                             (Integer -> Integer -> Integer) -> f Integer ->\n                             IO (Either BadElementException Integer)\nrunOneRight fol f container = try (evaluate (fol f 12 container))\n\nrunOne1 :: forall f . Foldable f => (forall a . (a -> a -> a) -> f a -> a) ->\n                              (Integer -> Integer -> Integer) -> f Integer ->\n                              IO (Either BadElementException Integer)\nrunOne1 fol f container = try (evaluate (fol f container))\n\nrunOneLeft :: forall f . Foldable f =>\n                             (forall a b . (b -> a -> b) -> b -> f a -> b) ->\n                              (Integer -> Integer -> Integer) -> f Integer ->\n                              IO (Either BadElementException Integer)\nrunOneLeft fol f container = try (evaluate (fol f 13 container))\n\nrunWithAllRight :: forall f . Foldable f =>\n                          (forall a b . (a -> b -> b) -> b -> f a -> b) ->\n                          [f Integer] -> IO [Either BadElementException Integer]\nrunWithAllRight fol containers =\n       mapM (uncurry (runOneRight fol)) [(f,c) | f <- conses, c <- containers]\n\nrunWithAll1 :: forall f . Foldable f =>\n                        (forall a . (a -> a -> a) -> f a -> a) ->\n                        [f Integer] -> IO [Either BadElementException Integer]\nrunWithAll1 fol containers =\n          mapM (uncurry (runOne1 fol)) [(f,c) | f <- conses, c <- containers]\n\nrunWithAllLeft :: forall f . Foldable f =>\n                          (forall a b . (b -> a -> b) -> b -> f a -> b) ->\n                          [f Integer] -> IO [Either BadElementException Integer]\nrunWithAllLeft fol containers = mapM (uncurry (runOneLeft fol))\n                              [(f,c) | f <- map flip conses, c <- containers]\n\ntestWithAllRight :: forall f . Foldable f =>\n                 (forall a b . (a -> b -> b) -> b -> f a -> b) ->\n                  (forall a b . (a -> b -> b) -> b -> ForceDefault f a -> b) ->\n                   [f Integer] -> IO Bool\ntestWithAllRight fol1 fol2 containers = (==) <$>\n       runWithAllRight fol1 containers <*>\n           runWithAllRight fol2 (map ForceDefault containers)\n\ntestWithAllLeft :: forall f . Foldable f =>\n                   (forall a b . (b -> a -> b) -> b -> f a -> b) ->\n                   (forall a b . (b -> a -> b) -> b -> ForceDefault f a -> b) ->\n                       [f Integer] -> IO Bool\ntestWithAllLeft fol1 fol2 containers = (==) <$>\n      runWithAllLeft fol1 containers <*>\n         runWithAllLeft fol2 (map ForceDefault containers)\n\n\ntestWithAll1 :: forall f . Foldable f =>\n                        (forall a . (a -> a -> a) -> f a -> a) ->\n                        (forall a . (a -> a -> a) -> ForceDefault f a -> a) ->\n                                               [f Integer] -> IO Bool\ntestWithAll1 fol1 fol2 containers =\n  (==) <$> runWithAll1 fol1 containers\n            <*> runWithAll1 fol2 (map ForceDefault containers)\n\ncheckup f g cs = map f cs == map g (map ForceDefault cs)\n\nmain = do\n         testWithAllRight foldr foldr arrays >>= print\n         testWithAllRight foldr' foldr' arrays >>= print\n         testWithAllLeft foldl foldl arrays >>= print\n         testWithAllLeft foldl' foldl' arrays >>= print\n         testWithAll1 foldl1 foldl1 (filter (not . null) arrays) >>= print\n         testWithAll1 foldr1 foldr1 (filter (not . null) arrays) >>= print\n         -- we won't bother with the fancy laziness tests for the rest\n         print $ checkup length length goodArrays\n         print $ checkup sum sum goodArrays\n         print $ checkup product product goodArrays\n         print $ checkup maximum maximum $ filter (not . null) goodArrays\n         print $ checkup minimum minimum $ filter (not . null) goodArrays\n         print $ checkup toList toList goodArrays\n         print $ checkup null null arrays\n", "num_lines": 130}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- Trac #15559: Add HasCallStack to fromJust\n\nimport Data.Maybe ( fromJust )\n\nmain :: IO ()\nmain = do\n  _ <- fromJust Nothing `seq` return ()\n  putStrLn \"Should see a stacktrace instead of this\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test infix operators of 'Functor'\n\nimport Data.Functor\n\nmain :: IO ()\nmain = do\n        testInfixFmap\n        testFlippedInfixFmap\n        testInfixReplace\n        testFlippedInfixReplace\n\ntestInfixFmap :: IO ()\ntestInfixFmap = do\n        print \"<$> tests:\"\n        print $ (+ 1) <$> Just 2 -- => Just 3\n        print (((+ 1) <$> Right 3) :: Either Int Int) -- => Right 4\n        print $ (+ 1) <$> [1, 2, 3] -- => [2,3,4]\n\ntestFlippedInfixFmap :: IO ()\ntestFlippedInfixFmap = do\n        print \"<&> tests:\"\n        print $ Just 2 <&> (+ 1) -- => Just 3\n        print ((Right 3 <&> (+ 1)) :: Either Int Int) -- => Right 4\n        print $ [1, 2, 3] <&> (+ 1) -- => [2,3,4]\n\ntestInfixReplace :: IO ()\ntestInfixReplace = do\n        print \"<$ tests:\"\n        print $ 42 <$ Just 1 -- => Just 42\n        print ((42 <$ Right 1) :: Either Int Int) -- => Right 42\n        print $ 42 <$ [1, 2, 3] -- => [42,42,42]\n\ntestFlippedInfixReplace :: IO ()\ntestFlippedInfixReplace = do\n        print \"$> tests:\"\n        print $ Just 1 $> 42 -- => Just 42\n        print ((Right 1 $> 42) :: Either Int Int) -- => Right 42\n        print $ [1, 2, 3] $> 42 -- => [42,42,42]\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for http://ghc.haskell.org/trac/ghc/ticket/2533\nimport System.Environment\nimport Data.List\nmain = do\n (n:_) <- getArgs\n print (genericTake (read n) \"none taken\")\n print (genericDrop (read n) \"none dropped\")\n print (genericSplitAt (read n) \"none split\")\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport Foreign\nimport Foreign.C\n\nmain = do test True; test False\n\ntest blocking = do\n  h <- openBinaryFile \"hGetBuf002.hs\" ReadMode\n\n  let sz = 42\n      loop = do\n         b <- allocaBytes sz $ \\ptr -> do\n                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz\n                if (r == 0)\n                   then return True\n                   else do s <- peekCStringLen (ptr,r)\n                           putStr s\n                           return False\n         if b then return () else loop -- tail call\n\n  loop\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport Foreign\nimport Foreign.C\nimport Control.Monad\n\nmain = do test True; test False\n\ntest blocking = do\n  h <- openBinaryFile \"hGetBuf003.hs\" ReadMode\n\n  let sz = 42\n      loop = do\n         -- mix ordinary char buffering with hGetBuf\n         eof <- hIsEOF h\n         when (not eof) $ hGetChar h >>= putChar\n         b <- allocaBytes sz $ \\ptr -> do\n                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz\n                if (r == 0)\n                   then return True\n                   else do s <- peekCStringLen (ptr,r)\n                           putStr s\n                           return False\n         if b then return () else loop -- tail call\n\n  loop\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport Foreign\nimport Foreign.C\n\nmain = do\n  hSetBinaryMode stdout True\n  withCStringLen \"hello world\\n\" $ \\(ptr,len) -> hPutBuf stdout ptr len\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport Foreign\nimport Foreign.C\n\n-- !!! this test failed to write anything in GHC 5.00.2\nmain = do\n  h <- openBinaryFile \"hPutBuf002.out\" ReadWriteMode\n  withCStringLen \"hello world\\n\" $ \\(ptr,len) -> hPutBuf h ptr len\n  hFileSize h >>= print\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing hGetPosn and hSetPosn\nmodule Main(main) where\n\nimport System.IO\n\ngetPosnAndPrint h = do\n  x <- hTell h\n  v <- hGetChar h\n  putStrLn (\"At position: \" ++ show x ++ \", found: \" ++ show v)\n  return x\n\nrecordDoAndRepos h a = do\n  x <- getPosnAndPrint h\n  a \n  hSeek h AbsoluteSeek x\n  getPosnAndPrint h\n  return ()\n\nrecordDoAndRepos2 h a = do\n  x <- getPosnAndPrint h\n  a \n  hSeek h AbsoluteSeek x\n  getPosnAndPrint h\n  return ()\n\nrecordDoAndRepos3 h a = do\n  x <- getPosnAndPrint h\n  a \n  hSeek h SeekFromEnd (negate (x + 1))\n  getPosnAndPrint h\n  return ()\n\nfile = \"hTell001.hs\"\n\nmain :: IO ()\nmain = do\n  h  <- openBinaryFile file ReadMode\n  recordDoAndRepos h $\n   recordDoAndRepos h $\n    recordDoAndRepos h $\n     recordDoAndRepos h $\n      recordDoAndRepos h $\n       putStrLn \"\"\n  hClose h\n  putStrLn \"\\nUsing hSeek/AbsoluteSeek: \"\n  h  <- openBinaryFile file ReadMode\n  recordDoAndRepos2 h $\n   recordDoAndRepos2 h $\n    recordDoAndRepos2 h $\n     recordDoAndRepos2 h $\n      recordDoAndRepos2 h $\n       putStrLn \"\"\n\n  hClose h\n  putStrLn \"\\nUsing hSeek/SeekFromEnd: \"\n  putStrLn \"(Don't worry if you're seeing differing numbers here, it might be down to '\\\\n' vs '\\\\r\\\\n')\"\n  h  <- openBinaryFile file ReadMode\n  recordDoAndRepos3 h $\n   recordDoAndRepos3 h $\n    recordDoAndRepos3 h $\n     recordDoAndRepos3 h $\n      recordDoAndRepos3 h $\n       putStrLn \"\"\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing hSeek\nmodule Main(main) where\n\nimport System.Directory\nimport System.IO\n\nmain :: IO ()\nmain = do\n  h <- openFile \"tst-seek\" WriteMode\n  hSetEncoding h utf8 -- hSeek/hTell work with Unicode streams\n  hPutStr h \"test string1\"\n   -- seek to EOF should be cool..\n  hSeek h SeekFromEnd 0\n  hPutStr h \"test string2\"\n   -- seek past EOF should now also be cool..\n  hSeek h SeekFromEnd 3\n  hPutStr h \"test string3\"\n  hSeek h AbsoluteSeek 13\n  hPutStr h \"test string4\"\n  x <- hTell h\n  print x\n  hSeek h AbsoluteSeek 30\n  x1 <- hTell h\n  hPutStr h \"\u00e4\u00ba\u00ba\u00e9\u2013\u201c\u00e8\u2122\u00ab\" -- we should be able to output Unicode too\n  x2 <- hTell h\n  print (x2 - x1)\n  hPutStr h \"filler\"\n  hClose h\n  h <- openFile \"tst-seek\" ReadMode\n  hSetEncoding h utf8\n  str <- hGetContents h\n  putStrLn str\n  removeFile \"tst-seek\"\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\nimport GHC.Clock\nimport System.IO\nimport System.Posix.IO\nimport System.Timeout\n\nmain :: IO ()\nmain = do\n    (readPipe, _) <- createPipe\n    readPipeHandle <- fdToHandle readPipe\n    let nanoSecondsPerSecond = 1000 * 1000 * 1000\n    let milliSecondsPerSecond = 1000\n    let timeToSpend = 1\n    let timeToSpendNano = timeToSpend * nanoSecondsPerSecond\n    let timeToSpendMilli = timeToSpend * milliSecondsPerSecond\n    start <- getMonotonicTimeNSec\n    b <- hWaitForInput readPipeHandle timeToSpendMilli\n    end <- getMonotonicTimeNSec\n    let timeSpentNano = fromIntegral $ end - start\n    let delta = timeSpentNano - timeToSpendNano\n    -- We can never wait for a shorter amount of time than specified\n    putStrLn $ \"delta >= 0: \" ++ show (delta > 0)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\nimport Foreign.C\nimport GHC.Clock\nimport GHC.IO.Device\nimport GHC.IO.Handle.FD\nimport System.IO\nimport System.Posix.IO\nimport System.Posix.Types\nimport System.Timeout\n\nmain :: IO ()\nmain = do\n    socketHandle <- makeTestSocketHandle\n    let nanoSecondsPerSecond = 1000 * 1000 * 1000\n    let milliSecondsPerSecond = 1000\n    let timeToSpend = 1\n    let timeToSpendNano = timeToSpend * nanoSecondsPerSecond\n    let timeToSpendMilli = timeToSpend * milliSecondsPerSecond\n    start <- getMonotonicTimeNSec\n    b <- hWaitForInput socketHandle timeToSpendMilli\n    end <- getMonotonicTimeNSec\n    let timeSpentNano = fromIntegral $ end - start\n    let delta = timeSpentNano - timeToSpendNano\n    -- We can never wait for a shorter amount of time than specified\n    putStrLn $ \"delta >= 0: \" ++ show (delta >= 0)\n\nforeign import ccall unsafe \"socket\" c_socket ::\n               CInt -> CInt -> CInt -> IO CInt\n\nmakeTestSocketHandle :: IO Handle\nmakeTestSocketHandle = do\n    sockNum <-\n        c_socket\n            1 -- PF_LOCAL\n            2 -- SOCK_DGRAM\n            0\n    let fd = fromIntegral sockNum :: Fd\n    h <-\n        fdToHandle'\n            (fromIntegral fd)\n            (Just GHC.IO.Device.Stream)\n            True\n            \"testsocket\"\n            ReadMode\n            True\n    hSetBuffering h NoBuffering\n    pure h\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nimport Control.Concurrent\nimport Control.Monad\nimport GHC.Clock\nimport System.Environment\nimport System.Exit\nimport System.IO\nimport System.Process\nimport System.Timeout\n\n-- IMPORTANT: Re-run this test _manually_ on windows if/when you change\n-- the code in `libraries/base/cbits/inputReady.c` that mentions\n-- `FILE_TYPE_CHAR`. Only when you run the code manually, in cmd.exe\n-- or PowerShell, does this code path get activated.\n-- Running this code in mintty does not count.\nmain :: IO ()\nmain = do\n    args <- getArgs\n    case args of\n        [] -> do\n            let cp =\n                    (shell\n                         ((if isLinuxHost\n                               then (\"./\" ++)\n                               else id)\n                              \"hWaitForInput-accurate-stdin --read-from-stdin\"))\n                        {std_in = CreatePipe}\n            (_, _, _, ph) <- createProcess cp\n            waitForProcess ph >>= exitWith\n        (\"--read-from-stdin\":_) -> do\n            let nanoSecondsPerSecond = 1000 * 1000 * 1000\n            let milliSecondsPerSecond = 1000\n            let timeToSpend = 1\n            let timeToSpendNano = timeToSpend * nanoSecondsPerSecond\n            let timeToSpendMilli = timeToSpend * milliSecondsPerSecond\n            start <- getMonotonicTimeNSec\n            b <- hWaitForInput stdin timeToSpendMilli\n            end <- getMonotonicTimeNSec\n            let timeSpentNano = fromIntegral $ end - start\n            let delta = timeSpentNano - timeToSpendNano\n            -- We can never wait for a shorter amount of time than specified\n            putStrLn $ \"delta >= 0: \" ++ show (delta >= 0)\n        _ -> error \"should not happen.\"\n\nisLinuxHost :: Bool\n#if defined(mingw32_HOST_OS)\nisLinuxHost = False\n#else\nisLinuxHost = True\n#endif\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule Main (main) where\n\nimport Data.List\n\n-- A simple implementation of inits that should be obviously correct.\n{-# NOINLINE initsR #-}\ninitsR :: [a] -> [[a]]\ninitsR = map reverse . scanl (flip (:)) []\n\n-- The inits implementation added in 7.10 uses a queue rotated around\n-- powers of 2, starting the rotation only at size 255, so we want to check\n-- around powers of 2 and around the switch.\nranges :: [Int]\nranges = [0..20] ++ [252..259] ++ [508..515]\n\nsimple :: (forall a . [a] -> [[a]]) -> [[[Int]]]\nsimple impl = [impl [1..n] | n <- ranges]\n\n-- We want inits (xs ++ undefined) = inits xs ++ undefined\nlaziness :: Bool\nlaziness = [take (n+1) (inits $ [1..n] ++ undefined) | n <- ranges]\n              == simple inits\n\nmain :: IO ()\nmain | simple initsR /= simple inits = error \"inits failed simple test\"\n     | not laziness = error \"inits failed laziness test\"\n     | otherwise = return ()\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Data.IORef\n\nloop r 0 = return ()\nloop r c = loop r (c-1) >> writeIORef r 42\n\nmain = newIORef 0 >>= \\r -> loop r 1000000 >> putStrLn \"done\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\nimport Data.List\n\nneedles = [\"\",\"1\",\"2\",\"12\",\"123\",\"1234\"]\nhaystacks = [\"\",\"a\",\"ab\",\"abc\",\"1\",\"2\",\"3\",\"a1\",\"1a\",\n             \"23\",\"123\",\"a123\",\"ab123\",\"abc123\"]\n\nmain :: IO()\nmain = mapM_ print $ [needle `isSuffixOf` haystack\n                       | needle <- needles, haystack <- haystacks]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Ix\nimport Data.Int\n\nmain = print (index (minBound::Int16,maxBound) maxBound)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.STRef.Lazy\nimport Control.Monad.ST.Lazy as L\nimport Control.Monad.ST.Strict as S\nimport qualified Data.STRef as S\nimport Data.Function (fix)\nimport System.IO (hPutStrLn, stderr)\nimport Debug.Trace (trace)\n\n-- The following implements `fix` using lazy `ST`. It is based on code\n-- by Oleg Kiselyov (source: http://okmij.org/ftp/Haskell/Fix.hs) which is\n-- in the public domain according to the main page (http://okmij.org/ftp/).\n\nfact :: (Int -> Int) -> Int -> Int\nfact self 0 = 1\nfact self n = n * self (pred n)\n\n-- Test liftM style (Oleg's original style)\nfix1 :: (a -> a) -> a\nfix1 f = L.runST $ do\n  wrap <- newSTRef (error \"black hole\")\n  let aux = readSTRef wrap >>= (\\x -> x >>= pure . f)\n  writeSTRef wrap aux\n  aux\n\n-- Test fmap style\nfix2 :: (a -> a) -> a\nfix2 f = L.runST $ do\n  wrap <- newSTRef (error \"black hole\")\n  let aux = readSTRef wrap >>= \\x -> f <$> x\n  writeSTRef wrap aux\n  aux\n\n-- The following examples are by Albert Y. C. Lai, and included (under the\n-- GHC license) with his permission:\n-- https://mail.haskell.org/pipermail/haskell-cafe/2017-January/126182.html\n\nexample1 :: [Int]\nexample1 = L.runST go where\n  go = do\n    v <- strictToLazyST (S.newSTRef 0)\n    fix (\\loop -> do\n            n <- strictToLazyST (do n <- S.readSTRef v\n                                    S.writeSTRef v (n+1)\n                                    return n\n                                )\n            ns <- loop\n            return (n : ns))\n\nexample2 :: [Int]\nexample2 = L.runST main where\n  main = do\n    v <- strictToLazyST (S.newSTRef 0)\n    sequence (repeat (strictToLazyST (do n <- S.readSTRef v\n                                         S.writeSTRef v (n+1)\n                                         return n\n                                     )))\n\nexample3 :: L.ST s [Integer]\nexample3 = do\n    r <- newSTRef 0\n    let loop = do\n            x <- readSTRef r\n            writeSTRef r $ x + 1\n            xs <- loop\n            writeSTRef r $ x + 2\n            return $ x : xs\n    loop\n\nexample4 :: L.ST s [Integer]\nexample4 = do\n    r <- newSTRef 0\n    let loop = do\n            x <- readSTRef r\n            writeSTRef r $ x + 1\n            xs <- loop\n            error \"this line is dead code\"\n            return $ x : xs\n    loop\n\nstar n s = trace (\"<\" ++ s ++ show n ++ \">\") (return ())\n\n-- Albert called this \"Sprinkle sprinkle little stars, how\n-- I wonder when you are\"\nexample5 :: L.ST s [Integer]\nexample5 = do\n    star 0 \"init begin\"\n    r <- newSTRef 0\n    star 0 \"init end\"\n    let loop n = do\n            star n \"A\"\n            x <- readSTRef r\n            star n \"B\"\n            writeSTRef r $ x + 1\n            star n \"C\"\n            xs <- loop (n+1)\n            star n \"D\"\n            writeSTRef r $ x + 2\n            star n \"E\"\n            return $ x : xs\n    loop 0\n\nmain :: IO ()\nmain = do\n  print $ fix1 fact 5\n  print $ fix2 fact 6\n  print $ take 5 example1\n  print $ take 5 example2\n  print $ take 10 (L.runST example3)\n  print $ take 10 (L.runST example4)\n  hPutStrLn stderr $ show (take 5 (L.runST example5))\n", "num_lines": 111}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Data.List\n\nmain :: IO ()\nmain = do print (genericLength [1..10000000] :: Int)\n          print (genericLength [1..10000000] :: Integer)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Text.ParserCombinators.ReadP\nimport qualified Text.Read.Lex\n\ntestStrings\n = [    \"0x3y\",\n        \"0X3abx\",\n        \"0o39y\",\n        \"0O334z\",\n\n        \"NaN\",\n        \"NaNx\",\n        \"Infinity\",\n        \"Infinityx\",\n\n        \"Wibble Foo\",\n        \"Wibble8_+\",\n\n        \"34yy\",\n        \"34.4x\",\n        \"034.4x\",\n        \"31.45e-6y\",\n        \"49.2v\",\n        \"049.2v\",\n        \"35e-3x\",\n        \"035e-3x\",\n        \"35e+3y\",\n        \"83.3e-22\",\n        \"083.3e-22\"\n   ]\n\nmain = mapM test testStrings\n\ntest s = do print s\n            print (lex s)\n            print (readP_to_S Text.Read.Lex.lex s)\n            putStrLn \"\"\n\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule Main where\n\nimport Data.List\nimport Control.Exception\n\n-- This module briefly tests all the functions in PrelList and a few\n-- from List.\n\n-- ToDo: test strictness properties.\n\nmain = do\n\n  -- head\n  print (head [1,2,3,4], head \"a\")\n  catch (print (head [] :: String)) (\\(ErrorCall _) -> putStr \"head []\\n\")\n\n  -- tail\n  print (tail [1,2,3,4], tail \"a\")\n  catch (print (tail [] :: String)) (\\(ErrorCall _) -> putStr \"tail []\\n\")\n\n  -- init\n  print (init [1,2,3,4], init \"a\")\n  catch (print (init [] :: String)) (\\(ErrorCall _) -> putStr \"init []\\n\")\n\n  -- last\n  print (last [1,2,3,4], last \"a\")\n  catch (print (last [] :: String)) (\\(ErrorCall _) -> putStr \"last []\\n\")\n\n  -- null\n  print [null [], null \"abc\"]\n\n  -- length\n  print (length [1..10])\n\n  -- foldl\n  print (foldl  (+) 1 [1..10])\n\n  -- foldl1\n  print (foldl1 (+) [1..10])\n  catch (print (foldl1 (+) [] :: Int)) (\\(ErrorCall _) -> putStr \"foldl1 []\\n\")\n\n  -- scanl\n  print (scanl  (+) 1 [1..10])\n\n  -- scanl1\n  print (scanl1 (+) [1..10])\n  print (scanl1 (+) [] :: [Int])\n\n  -- foldr1\n  print (foldr1 (+) [1..10])\n  catch (print (foldr1 (+) [] :: Int)) (\\(ErrorCall _) -> putStr \"foldr1 []\\n\")\n\n  -- scanr\n  print (scanr  (+) 1 [1..10])\n\n  -- scanr1\n  print (scanr1 (+) [1..10])\n  print (scanr1 (+) [] :: [Int])\n\n  -- iterate\n  print (take 10 (cycle (take 4 (iterate (+1) 1))))\n\n  -- take\n  print (take 4 (repeat \"x\"), take 0 (repeat \"x\"), take 5 [1..4])\n  catch (print (take (-1) [1..10])) (\\(ErrorCall _) -> putStr \"take (-1)\\n\")\n\n  -- replicate\n  print [replicate 2 \"abc\", replicate 0 \"abc\", replicate 3 []]\n\n  -- drop\n  print [drop 5 [1..10], drop 0 [1..10], drop 5 [1..4]]\n  catch (print (drop (-1) [1..10])) (\\(ErrorCall _) -> putStr \"drop (-1)\\n\")\n\n  -- splitAt\n  print [splitAt 5 [1..10], splitAt 5 [1..4]]\n  catch (print (splitAt (-1) [1..10])) (\\(ErrorCall _) -> putStr \"splitAt (-1)\\n\")\n\n  -- scan\n  print (span (<5) [1..10])\n\n  -- break\n  print (break (<5) [1..10])\n\n  -- reverse\n  print [reverse [1..10], reverse []]\n\n  -- and\n  print [and [], and [True], and [False]]\n\n  -- or\n  print [or [], or [True], or [False]]\n\n  -- elem\n  print [elem 5 [1..10], elem 0 [1..10], elem 1 []]\n\n  -- notElem\n  print [notElem 5 [1..10], notElem 0 [1..10], notElem 1 []]\n\n  -- lookkup\n  print (lookup 4 (zip [1..10] (reverse [1..10])))\n\n  -- sum\n  print [sum [1..10], sum []]\n\n  -- product\n  print [product [1..10], product []]\n\n  -- maximum\n  print (maximum [1..10])\n  catch (print (maximum [] :: Int)) (\\(ErrorCall _) -> putStr \"maximum []\\n\")\n\n  -- minimum\n  print (minimum [1..10])\n  catch (print (minimum [] :: Int)) (\\(ErrorCall _) -> putStr \"minimum []\\n\")\n\n  -- concatMap\n  print (concatMap (:[]) [(1::Int)..10])\n\n  -- zip\n  print [zip [1] [2], zip [1] [], zip [] [2], zip [1..5] [2..6]]\n\n  -- zip3\n  print (zip3 [1,2] [3,4] [5,6])\n\n  -- zipWith\n  print [zipWith (+) [1,2] [3,4], zipWith (+) [1] [], zipWith (+) [] []]\n\n  -- unzip\n  print [unzip [(1,2),(3,4)], unzip []]\n\n  -- unzip3\n  print [unzip3 [(1,2,3),(3,4,5)], unzip3 []]\n\n  -- unlines\n  print (unlines (lines \"a\\nb\\nc\\n\"), lines \"\", unlines [])\n\n  -- words\n  print (unwords (words \"a b c d\"),   words \"\", unwords [])\n\n  -- deleteBy\n  print [deleteBy (==) 1 [0,1,1,2,3,4],\n         deleteBy (==) (error \"deleteBy\") []]\n\n  -- delete\n  print [delete 1 [0,1,1,2,3,4],\n         delete (error \"delete\") []]\n\n  -- (\\\\)\n  print [ [0,1,1,2,3,4] \\\\ [3,2,1],\n          [1,2,3,4] \\\\ [],\n          [] \\\\ [error \"\\\\\\\\\"] ]\n", "num_lines": 153}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test that List.sortBy is stable.\n\nimport Data.List\n\nmain = print (sortBy (\\(a,b) (a',b')->compare a a')\n                ([1,1,1,1,1,1,1,1,1,1]`zip`[1..10]))\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test that length doesn't give a stack overflow\n\nmodule Main (main) where\n\nmain :: IO ()\nmain = print $ length $ filter odd [0 .. 9999999]\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\nimport Memo1\n\ntestMemo = do\n   let keys = [ [1..n] | n <- [1..1000] ]\n       keys2 = [ [n,n-1..1] | n <- [1..1000] ]\n       mlength = memo length\n   putStr (show (map mlength (keys ++ keys ++ keys2 ++ keys2)))\n   putStr (show (mlength [1..100000]))\n\n-- mlength will memoize itself over each element of 'keys', returning\n-- the memoized result the second time around.  Then we move onto\n-- keys2, and while we're doing this the first lot of memo table\n-- entries can be purged.  Finally, we do a large computation\n-- (length [1..10000]) to allow time for the memo table to be fully\n-- purged.\n\nmain = testMemo\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Memo2              ( memo )\nimport Data.List          ( genericLength, genericReplicate )\nimport System.Environment ( getArgs )\n\nmain :: IO ()\nmain = do (arg:_) <- getArgs\n          mapM_ printTriple [ (i,fib i,mfib i) | i <- [10..read arg] ]\n  where printTriple (i,fi,mfi) = do print i\n                                    print fi\n                                    print mfi\n                                    putStrLn \"\"\n\n-- There is not much point in memoising Integers, so we use unary \"numbers\" instead\nmfib :: Integer -> Integer\nmfib = genericLength . mfib' . flip genericReplicate ()\n\nmfib' :: [()] -> [()]\nmfib' = memo ufib\n\nufib :: [()] -> [()]\nufib []              = [()]\nufib [()]            = [()]\nufib (():n1@(():n2)) = mfib' n1 ++ mfib' n2\n\nfib :: Integer -> Integer\nfib 0 = 1\nfib 1 = 1\nfib n = fib (n-1) + fib (n-2)\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "% $Id: Memo.lhs,v 1.1 2005/12/16 10:46:05 simonmar Exp $\n%\n% (c) The GHC Team, 1999\n%\n% Hashing memo tables.\n\n\\begin{code}\n\nmodule Memo1\n        ( memo          -- :: (a -> b) -> a -> b\n        , memoSized     -- :: Int -> (a -> b) -> a -> b\n        )\n        where\n\nimport System.Mem.StableName    ( StableName, makeStableName, hashStableName )\nimport System.Mem.Weak          ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )\nimport Data.Array.IO            ( IOArray, newArray, readArray, writeArray )\nimport System.IO.Unsafe         ( unsafePerformIO )\nimport Control.Concurrent.MVar  ( MVar, newMVar, putMVar, takeMVar )\n\\end{code}\n\n-----------------------------------------------------------------------------\nMemo table representation.\n\nThe representation is this: a fixed-size hash table where each bucket\nis a list of table entries, of the form (key,value).\n\nThe key in this case is (StableName key), and we use hashStableName to\nhash it.\n\nIt's important that we can garbage collect old entries in the table\nwhen the key is no longer reachable in the heap.  Hence the value part\nof each table entry is (Weak val), where the weak pointer \"key\" is the\nkey for our memo table, and 'val' is the value of this memo table\nentry.  When the key becomes unreachable, a finalizer will fire and\nremove this entry from the hash bucket, and further attempts to\ndereference the weak pointer will return Nothing.  References from\n'val' to the key are ignored (see the semantics of weak pointers in\nthe documentation).\n\n\\begin{code}\ntype MemoTable key val\n        = MVar (\n            Int,        -- current table size\n            IOArray Int [MemoEntry key val]   -- hash table\n           )\n\n-- a memo table entry: compile with -funbox-strict-fields to eliminate\n-- the boxes around the StableName and Weak fields.\ndata MemoEntry key val = MemoEntry !(StableName key) !(Weak val)\n\\end{code}\n\nWe use an MVar to the hash table, so that several threads may safely\naccess it concurrently.  This includes the finalization threads that\nremove entries from the table.\n\nToDo: Can efficiency be improved at all?\n\n\\begin{code}\nmemo :: (a -> b) -> a -> b\nmemo f = memoSized default_table_size f\n\ndefault_table_size = 1001\n\n-- Our memo functions are *strict*.  Lazy memo functions tend to be\n-- less useful because it is less likely you'll get a memo table hit\n-- for a thunk.  This change was made to match Hugs's Memo\n-- implementation, and as the result of feedback from Conal Elliot\n-- <conal@microsoft.com>.\n\nmemoSized :: Int -> (a -> b) -> a -> b\nmemoSized size f = strict (lazyMemoSized size f)\n\nstrict = ($!)\n\nlazyMemoSized :: Int -> (a -> b) -> a -> b\nlazyMemoSized size f =\n   let (table,weak) = unsafePerformIO (\n                do { tbl <- newArray (0,size) []\n                   ; mvar <- newMVar (size,tbl)\n                   ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))\n                   ; return (mvar,weak)\n                   })\n   in  memo' f table weak\n\ntable_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()\ntable_finalizer table size =\n   sequence_ [ finalizeBucket i | i <- [0..size] ]\n where\n   finalizeBucket i = do\n      bucket <- readArray table i\n      sequence_ [ finalize w | MemoEntry _ w <- bucket ]\n\nmemo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b\nmemo' f ref weak_ref = \\k -> unsafePerformIO $ do\n   stable_key <- makeStableName k\n   (size, table) <- takeMVar ref\n   let hash_key = hashStableName stable_key `mod` size\n   bucket <- readArray table hash_key\n   lkp <- lookupSN stable_key bucket\n\n   case lkp of\n     Just result -> do\n        putMVar ref (size,table)\n        return result\n     Nothing -> do\n        let result = f k\n        weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))\n        writeArray table hash_key (MemoEntry stable_key weak : bucket)\n        putMVar ref (size,table)\n        return result\n\nfinalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()\nfinalizer hash_key stable_key weak_ref =\n  do r <- deRefWeak weak_ref\n     case r of\n        Nothing -> return ()\n        Just mvar -> do\n                (size,table) <- takeMVar mvar\n                bucket <- readArray table hash_key\n                let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket,\n                                       sn /= stable_key ]\n                writeArray table hash_key new_bucket\n                putMVar mvar (size,table)\n\nlookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)\nlookupSN sn [] = sn `seq` return Nothing -- make it strict in sn\nlookupSN sn (MemoEntry sn' weak : xs)\n   | sn == sn'  = do maybe_item <- deRefWeak weak\n                     case maybe_item of\n                        Nothing -> error (\"dead weak pair: \" ++\n                                                show (hashStableName sn))\n                        Just v  -> return (Just v)\n   | otherwise  = lookupSN sn xs\n\\end{code}\n", "num_lines": 136}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "% $Id: Memo.lhs,v 1.1 2005/12/16 10:46:05 simonmar Exp $\n%\n% (c) The GHC Team, 1999\n%\n% Hashing memo tables.\n\n\\begin{code}\n\nmodule Memo2\n        ( memo          -- :: (a -> b) -> a -> b\n        , memoSized     -- :: Int -> (a -> b) -> a -> b\n        )\n        where\n\nimport System.Mem.StableName    ( StableName, makeStableName, hashStableName )\nimport System.Mem.Weak          ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )\nimport Data.Array.IO            ( IOArray, newArray, readArray, writeArray )\nimport System.IO.Unsafe         ( unsafePerformIO )\nimport Control.Concurrent.MVar  ( MVar, newMVar, putMVar, takeMVar )\n\\end{code}\n\n-----------------------------------------------------------------------------\nMemo table representation.\n\nThe representation is this: a fixed-size hash table where each bucket\nis a list of table entries, of the form (key,value).\n\nThe key in this case is (StableName key), and we use hashStableName to\nhash it.\n\nIt's important that we can garbage collect old entries in the table\nwhen the key is no longer reachable in the heap.  Hence the value part\nof each table entry is (Weak val), where the weak pointer \"key\" is the\nkey for our memo table, and 'val' is the value of this memo table\nentry.  When the key becomes unreachable, a finalizer will fire and\nremove this entry from the hash bucket, and further attempts to\ndereference the weak pointer will return Nothing.  References from\n'val' to the key are ignored (see the semantics of weak pointers in\nthe documentation).\n\n\\begin{code}\ntype MemoTable key val\n        = MVar (\n            Int,        -- current table size\n            IOArray Int [MemoEntry key val]   -- hash table\n           )\n\n-- a memo table entry: compile with -funbox-strict-fields to eliminate\n-- the boxes around the StableName and Weak fields.\ndata MemoEntry key val = MemoEntry !(StableName key) !(Weak val)\n\\end{code}\n\nWe use an MVar to the hash table, so that several threads may safely\naccess it concurrently.  This includes the finalization threads that\nremove entries from the table.\n\nToDo: Can efficiency be improved at all?\n\n\\begin{code}\nmemo :: (a -> b) -> a -> b\nmemo f = memoSized default_table_size f\n\ndefault_table_size = 1001\n\n-- Our memo functions are *strict*.  Lazy memo functions tend to be\n-- less useful because it is less likely you'll get a memo table hit\n-- for a thunk.  This change was made to match Hugs's Memo\n-- implementation, and as the result of feedback from Conal Elliot\n-- <conal@microsoft.com>.\n\nmemoSized :: Int -> (a -> b) -> a -> b\nmemoSized size f = strict (lazyMemoSized size f)\n\nstrict = ($!)\n\nlazyMemoSized :: Int -> (a -> b) -> a -> b\nlazyMemoSized size f =\n   let (table,weak) = unsafePerformIO (\n                do { tbl <- newArray (0,size) []\n                   ; mvar <- newMVar (size,tbl)\n                   ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))\n                   ; return (mvar,weak)\n                   })\n   in  memo' f table weak\n\ntable_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()\ntable_finalizer table size =\n   sequence_ [ finalizeBucket i | i <- [0..size] ]\n where\n   finalizeBucket i = do\n      bucket <- readArray table i\n      sequence_ [ finalize w | MemoEntry _ w <- bucket ]\n\nmemo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b\nmemo' f ref weak_ref = \\k -> unsafePerformIO $ do\n   stable_key <- makeStableName k\n   (size, table) <- takeMVar ref\n   let hash_key = hashStableName stable_key `mod` size\n   bucket <- readArray table hash_key\n   lkp <- lookupSN stable_key bucket\n\n   case lkp of\n     Just result -> do\n        putMVar ref (size,table)\n        return result\n     Nothing -> do\n        let result = f k\n        weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))\n        writeArray table hash_key (MemoEntry stable_key weak : bucket)\n        putMVar ref (size,table)\n        return result\n\nfinalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()\nfinalizer hash_key stable_key weak_ref =\n  do r <- deRefWeak weak_ref\n     case r of\n        Nothing -> return ()\n        Just mvar -> do\n                (size,table) <- takeMVar mvar\n                bucket <- readArray table hash_key\n                let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket,\n                                       sn /= stable_key ]\n                writeArray table hash_key new_bucket\n                putMVar mvar (size,table)\n\nlookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)\nlookupSN sn [] = sn `seq` return Nothing -- make it strict in sn\nlookupSN sn (MemoEntry sn' weak : xs)\n   | sn == sn'  = do maybe_item <- deRefWeak weak\n                     case maybe_item of\n                        Nothing -> error (\"dead weak pair: \" ++\n                                                show (hashStableName sn))\n                        Just v  -> return (Just v)\n   | otherwise  = lookupSN sn xs\n\\end{code}\n", "num_lines": 136}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test System.Mem.performGC\n\nimport System.Mem\n\nmain = performGC\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent.QSem as OldQ\n\nimport Control.Concurrent.Chan\nimport Control.Concurrent (forkIO, threadDelay, killThread, yield)\nimport Control.Concurrent.MVar\nimport Control.Exception\nimport Control.Monad\n\nnew = newQSem\nwait = waitQSem\nsignal = signalQSem\n\n--------\n-- dummy test-framework\n\ntype Assertion = IO ()\n\nx @?= y = when (x /= y) $ error (show x ++ \" /= \" ++ show y)\n\ntestCase :: String -> IO () -> IO ()\ntestCase n io = putStrLn (\"test \" ++ n) >> io\n\ndefaultMain = sequence\n------\n\nmain = defaultMain tests\n\ntests = [\n    testCase \"sem1\" sem1,\n    testCase \"sem2\" sem2,\n    testCase \"sem_kill\" sem_kill,\n    testCase \"sem_fifo\" sem_fifo,\n    testCase \"sem_bracket\" sem_bracket\n ]\n\nsem1 :: Assertion\nsem1 = do\n  q <- new 0\n  signal q\n  wait q\n\nsem2 :: Assertion\nsem2 = do\n  q <- new 0\n  signal q\n  signal q\n  wait q\n  wait q\n\nsem_fifo :: Assertion\nsem_fifo = do\n  c <- newChan\n  q <- new 0\n  t1 <- forkIO $ do wait q; writeChan c 'a'\n  threadDelay 10000\n  t2 <- forkIO $ do wait q; writeChan c 'b'\n  threadDelay 10000\n  t3 <- forkIO $ do wait q; writeChan c 'c'\n  threadDelay 10000\n  signal q\n  a <- readChan c\n  signal q\n  b <- readChan c\n  signal q\n  c <- readChan c\n  [a,b,c] @?= \"abc\"\n\nsem_kill :: Assertion\nsem_kill  = do\n  q <- new 0\n  t <- forkIO $ do wait q\n  threadDelay 100000\n  killThread t\n  m <- newEmptyMVar\n  t <- forkIO $ do wait q; putMVar m ()\n  signal q\n  takeMVar m\n\n\nsem_bracket :: Assertion\nsem_bracket = do\n  q <- new 1\n  ts <- forM [1..100000] $ \\n -> do\n     forkIO $ do bracket_ (wait q) (signal q) (return ())\n  mapM_ killThread ts\n  wait q\n\n", "num_lines": 88}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport Control.Monad\nimport Data.List\n\nnew = newQSemN\nwait = waitQSemN\nsignal = signalQSemN\n\n--------\n-- dummy test-framework\n\ntype Assertion = IO ()\n\nx @?= y = when (x /= y) $ error (show x ++ \" /= \" ++ show y)\n\ntestCase :: String -> IO () -> IO ()\ntestCase n io = putStrLn (\"test \" ++ n) >> io\n\ndefaultMain = sequence\n------\n\nmain = defaultMain tests\n\ntests = [\n    testCase \"semn\" semn,\n    testCase \"semn2\" semn2,\n    testCase \"semn3\" semn3,\n    testCase \"semn_kill\" semn_kill,\n    testCase \"semn_bracket\" sem_bracket\n ]\n\nsemn :: Assertion\nsemn = do\n  c <- newEmptyMVar\n  q <- new 0\n  t1 <- forkIO $ do wait q 1;  putMVar c 'a'\n  threadDelay 10000\n  t2 <- forkIO $ do wait q 2;  putMVar c 'b'\n  threadDelay 10000\n  t3 <- forkIO $ do wait q 3;  putMVar c 'c'\n  threadDelay 10000\n  signal q 1\n  a <-  takeMVar c\n  signal q 2\n  b <-  takeMVar c\n  signal q 3\n  c <-  takeMVar c\n  [a,b,c] @?= \"abc\"\n\nsemn2 :: Assertion\nsemn2 = do\n  c <- newEmptyMVar\n  q <- new 0\n  t1 <- forkIO $ do wait q 1; putMVar c 'a'\n  threadDelay 10000\n  t2 <- forkIO $ do wait q 2; putMVar c 'b'\n  threadDelay 10000\n  t3 <- forkIO $ do wait q 3; putMVar c 'c'\n  threadDelay 10000\n  signal q 6\n  a <-  takeMVar c\n  b <-  takeMVar c\n  c <-  takeMVar c\n  sort [a,b,c] @?= \"abc\"\n\nsemn3 :: Assertion\nsemn3 = do\n  c <- newEmptyMVar\n  q <- new 0\n  t1 <- forkIO $ do wait q 1; putMVar c 'a'\n  threadDelay 10000\n  t2 <- forkIO $ do wait q 2; putMVar c 'b'\n  threadDelay 10000\n  t3 <- forkIO $ do wait q 3; putMVar c 'c'\n  threadDelay 10000\n  signal q 3\n  a <-  takeMVar c\n  b <-  takeMVar c\n  threadDelay 10000\n  sort [a,b] @?= \"ab\"\n  d <-  isEmptyMVar c\n  d @?= True\n  signal q 1\n  threadDelay 10000\n  d <-  isEmptyMVar c\n  d @?= True\n  signal q 2\n  x <-  takeMVar c\n  x @?= 'c'\n\nsemn_kill :: Assertion\nsemn_kill  = do\n  q <- new 0\n  t <- forkIO $ do wait q 1\n  threadDelay 10000\n  killThread t\n  m <- newEmptyMVar\n  t <- forkIO $ do wait q 1; putMVar m ()\n  signal q 1\n  takeMVar m\n\nsem_bracket :: Assertion\nsem_bracket = do\n  q <- new 1\n  ts <- forM [1..100000] $ \\n -> do\n     forkIO $ do bracket_ (wait q 1) (signal q 1) (return ())\n  mapM_ killThread ts\n  wait q 1\n", "num_lines": 110}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Exception as E\n\nimport Data.Int\n\nmain :: IO ()\nmain = do putStrLn \"Int8\"\n          mapM_ p =<< (f :: IO [Either Int8 String])\n          putStrLn \"Int16\"\n          mapM_ p =<< (f :: IO [Either Int16 String])\n          putStrLn \"Int32\"\n          mapM_ p =<< (f :: IO [Either Int32 String])\n          putStrLn \"Int64\"\n          mapM_ p =<< (f :: IO [Either Int64 String])\n          putStrLn \"Int\"\n          mapM_ p =<< (f :: IO [Either Int String])\n    where p (Left x) = print x\n          p (Right e) = putStrLn e\n\nf :: (Integral a, Bounded a) => IO [Either a String]\nf = sequence [ g (minBound `div` (-1)),\n               g (minBound `mod` (-1)),\n               g (case minBound `divMod` (-1) of (x, _) -> x),\n               g (case minBound `divMod` (-1) of (_, x) -> x),\n               g (minBound `quot` (-1)),\n               g (minBound `rem` (-1)),\n               g (case minBound `quotRem` (-1) of (x, _) -> x),\n               g (case minBound `quotRem` (-1) of (_, x) -> x) ]\n    where g x = do x' <- evaluate x\n                   return (Left x')\n                `E.catch`\n                   \\e -> return (Right (show (e :: SomeException)))\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\nimport System.Random\n\ntstRnd rng = checkRange rng (genRnd 50 rng)\n \ngenRnd n rng = take n (randomRs rng (mkStdGen 2))\n \ncheckRange (lo,hi) = all pred\n  where\n   pred\n    | lo <= hi  = \\ x -> x >= lo && x <= hi\n    | otherwise = \\ x -> x >= hi && x <= lo\n\nmain :: IO ()\nmain = do\n  print (tstRnd (1,5::Double))\n  print (tstRnd (1,5::Int))\n  print (tstRnd (10,54::Integer))\n  print (tstRnd ((-6),2::Int))\n  print (tstRnd (2,(-6)::Int))\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Ratio\n\n-- !!! Test that (%) has the right fixity\nmain = print (2^3%5)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = do f \"Infinity\"\n          f \"-Infinity\"\n          f \"  -  Infinity  \"\n          f \"NaN\"\n          f \"-NaN\"\n          f \"  -  NaN  \"\n\nf :: String -> IO ()\nf str = print (reads str :: [(Double, String)])\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Data.Fixed\n\nmain :: IO ()\nmain = do f \"  (( (  12.3456  ) )  )  \"\n          f \"  (( (  12.3     ) )  )  \"\n          f \"  (( (  12.      ) )  )  \"\n          f \"  (( (  12       ) )  )  \"\n          f \"  (( - (  12.3456  ) )  )  \"\n          f \"  (( (  -12.3456  ) )  )  \"\n\nf :: String -> IO ()\nf str = print (reads str :: [(Centi, String)])\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Numeric\n\nmain :: IO ()\nmain = putStrLn $ showFloat (read \"\" :: Float) \"\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = do f \"100e12\"\n          f \"00123.456\"\n\nf :: String -> IO ()\nf str = print (reads str :: [(Integer, String)])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main)\nwhere\n\nimport Data.Char (digitToInt, lexLitChar, readLitChar)\n\nmain :: IO ()\nmain =\n    do putStrLn (show $ readLitChar \"A\")\n       putStrLn (show $ readLitChar \"'A'\")\n       putStrLn (show $ lexLitChar \"A\")\n       putStrLn (show $ lexLitChar \"'A'\")\n       putStrLn (show $ lexLitChar \"\\\\243\\\\&1\")\n       putStrLn (show $ lexLitChar \"a\\\\&1\")\n       putStrLn (show $ lexLitChar \"a\\\\&\\\\&1\")\n       putStrLn (show $ lexLitChar \"a\\\\&\\\\&\")\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test the classic \"\\SOH\" ambiguity\n\nmodule Main(main) where\n\nmain = do { print soh ; print (length (fst (head soh))) ;\n            print so  ; print (length (fst (head so))) }\n     where\n        so, soh :: [(String,String)]\n        soh = reads \"\\\"\\\\SOH\\\"\" -- Should read \\SOH\n        so  = reads \"\\\"\\\\SOx\\\"\" -- Should read \\SO followed by x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing Show on Maybes and Eithers\nmodule Main(main) where\n\nx :: Maybe ()\nx = Nothing\n\nmain :: IO ()\nmain = do\n  print x\n  print (Just ())\n  print ((Just (Just ())) :: Maybe (Maybe ()))\n  print (Just x)\n  print ((Left 'a')  :: Either Char Int)\n  print ((Right 'b') :: Either Int Char)\n  print ((Right x)   :: Either Int (Maybe ()))\n  print ((Right (Just  'c')) :: Either Int (Maybe Char))\n  print ((Right (Right 'd')) :: Either Int (Either Char Char))\n  print ((Right (Left  'e')) :: Either Int (Either Char Int))\n  print ((Left 'f') :: Either Char Int)\n  print ((Left x) :: Either (Maybe ()) Char)\n  print ((Left (Just  'g')) :: Either (Maybe Char) ())\n  print ((Left (Right 'h')) :: Either (Either Int Char) Char)\n  print ((Left (Right 'i')) :: Either (Either Int Char) ())\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nmain :: IO ()\nmain = do let xs = [p0, p01, p3, p31, n0, n01, n3, n31, pinf, ninf, nan]\n          mapM_ print xs\n          mapM_ (print . Just) xs\n\np0 :: Double\np0 = 0\n\np01 :: Double\np01 = 0.1\n\np3 :: Double\np3 = 3\n\np31 :: Double\np31 = 3.1\n\nn0 :: Double\nn0 = -0\n\nn01 :: Double\nn01 = -0.1\n\nn3 :: Double\nn3 = -3\n\nn31 :: Double\nn31 = -3.1\n\npinf :: Double\npinf = 1 / 0\n\nninf :: Double\nninf = - 1 / 0\n\nnan :: Double\nnan = 0 / 0\n\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Foreign\n\n-- simple test for building/dereferencing stable ptrs\n\nmain\n  = do  l <- mapM newStablePtr [1..100000]\n        sum <- stable_sum l\n        print sum\n\nstable_sum :: [StablePtr Integer] -> IO Integer\nstable_sum [] = return 0\nstable_sum (x:xs)\n  = do  x'  <- deRefStablePtr x\n        freeStablePtr x\n        xs' <- stable_sum xs\n        return (x' + xs')\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Monad\nimport System.Mem.StableName\nimport Control.Exception\n\nmain = do\n  mapM_ evaluate list\n  stable_list1 <- mapM makeStableName list\n  stable_list2 <- mapM makeStableName list\n  unless (stable_list1 == stable_list2) $ do\n    let l1 = map hashStableName stable_list1\n    let l2 = map hashStableName stable_list2\n    print $ zip l1 l2\n\nlist = [1..10000] :: [Integer]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign.StablePtr\n\n-- compile without optimisation.\n-- run with +RTS -D256 to see the stable pointer being garbage collected.\n\nmain = do\n  let xs = [ 1 .. 50000 ]\n  let ys = [ 1 .. 60000 ]\n  s1 <- newStablePtr xs\n  print (sum xs)\n  freeStablePtr s1\n  print (sum ys)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! triggered a temporary bug in freeStablePtr around 20020424\n\nmodule Main where\nimport Foreign.StablePtr (newStablePtr, freeStablePtr)\n\ndata Foo = A | B | C | D\n\nmain :: IO ()\nmain = do aSPtr <- newStablePtr A\n          bSPtr <- newStablePtr B\n          cSPtr <- newStablePtr C\n          cSPtr' <- newStablePtr C\n          freeStablePtr aSPtr\n          freeStablePtr bSPtr\n          freeStablePtr cSPtr\n          freeStablePtr cSPtr'\n          aSPtr <- newStablePtr A\n          bSPtr <- newStablePtr B\n          cSPtr <- newStablePtr C\n          dSPtr <- newStablePtr D\n          print \"Hello World\"\n      \n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\nmain :: IO ()\nmain = do\n    mask $ \\unmask -> mask $ \\restore ->\n      unmask $ restore $ getMaskingState >>= print\n    uninterruptibleMask $ \\unmask -> uninterruptibleMask $ \\restore ->\n      unmask $ restore $ getMaskingState >>= print\n\n    mv <- newEmptyMVar\n    mask_ $ -- start with exceptions masked\n      mask $ \\restore -> forkIOWithUnmask $ \\unmask -> unmask $\n        restore $ getMaskingState >>= print >> putMVar mv ()\n    takeMVar mv\n    uninterruptibleMask_ $ -- start with exceptions uninterruptibly masked\n      uninterruptibleMask $ \\restore -> forkIOWithUnmask $ \\unmask -> unmask $\n        restore $ getMaskingState >>= print >> putMVar mv ()\n    takeMVar mv\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Char\n\nmain :: IO ()\nmain = do\n    print $ isMark '\\768'\n    print $ isAlphaNum '\\768'\n    print $ (isAlpha '\\768', isNumber '\\768')\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\nmodule Main (main) where\n\nimport Data.Typeable\nimport GHC.Types\n\nmain :: IO ()\nmain = do\n  print (typeOf (Proxy :: Proxy 'Just))\n  print (typeOf (Proxy :: Proxy (TYPE 'LiftedRep)))\n  print (typeOf (Proxy :: Proxy (TYPE 'UnliftedRep)))\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\n\n-- Ensure that catch catches exceptions thrown during the evaluation of the\n-- action-to-be-executed. This should output \"it failed\".\nmain :: IO ()\nmain = catch (error \"uh oh\") handler\n\nhandler :: SomeException -> IO ()\nhandler _ = putStrLn \"it failed\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Written by Bertram Felgenhauer\n--\n-- https://ghc.haskell.org/trac/ghc/ticket/11760#comment:14\n--\n-- Compile with -threaded -with-rtsopts=-N2\n\n{-# LANGUAGE BangPatterns #-}\nimport Control.Concurrent\nimport Control.Monad\nimport Control.Monad.ST.Lazy\nimport Control.Exception\nimport Data.STRef\nimport Data.IORef\nimport Control.Concurrent.MVar\nimport Data.List\n\n-- evil ST action that tries to synchronize (by busy waiting on the\n-- shared STRef) with a concurrent evaluation\nevil :: ST s [Int]\nevil = do\n    r <- strictToLazyST $ newSTRef 0\n    replicateM 100 $ do\n        i <- strictToLazyST $ readSTRef r\n        let !j = i + 1\n        strictToLazyST $ writeSTRef r j\n        let go 0 = return ()\n            go n = do\n                i' <- strictToLazyST $ readSTRef r\n                when (j == i') $ go (n-1)\n        go 100\n        return j\n\nmain = do\n    let res = runST evil\n    s0 <- newIORef (map pred (0 : res))\n    s1 <- newIORef (map pred (1 : res))\n    m0 <- newMVar ()\n    m1 <- newMVar ()\n    forkIO $ do\n        putMVar m0 ()\n        readIORef s0 >>= evaluate . foldl' (+) 0\n        putMVar m0 ()\n    forkIO $ do\n        putMVar m1 ()\n        readIORef s1 >>= evaluate . foldl' (+) 0\n        putMVar m1 ()\n    threadDelay 10000\n    replicateM 3 $ takeMVar m0 >> takeMVar m1\n    v0 <- tail <$> readIORef s0\n    v1 <- tail <$> readIORef s1\n    print (v0 == v1)\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment.Blank\n\nmain = do\n  let envVar = \"AN_ENVIRONMENT_VARIABLE\"\n\n  valueBeforeSettingVariable <- getEnv envVar\n  print valueBeforeSettingVariable -- Nothing\n\n  valueWithDefaultBeforeSetting <- getEnvDefault envVar \"DEFAULT\"\n  print valueWithDefaultBeforeSetting -- \"DEFAULT\"\n\n  setEnv envVar \"\" False\n\n  valueAfterSettingVariable <- getEnv envVar\n  print valueAfterSettingVariable -- Just \"\"\n\n  valueWithDefaultAfterSetting <- getEnvDefault envVar \"DEFAULT\"\n  print valueWithDefaultAfterSetting -- \"\"\n\n  valueFromGetEnvironment <- lookup envVar <$> getEnvironment\n  print valueFromGetEnvironment -- Just \"\"\n\n  setEnv envVar \"NO_OVERRIDE\" False\n\n  valueAfterSettingWithExistingValueAndOverrideFalse <- getEnv envVar\n  print valueAfterSettingWithExistingValueAndOverrideFalse -- Just \"\"\n\n  setEnv envVar \"OVERRIDE\" True\n\n  valueAfterSettingWithExistingValueAndOverrideTrue <- getEnv envVar\n  print valueAfterSettingWithExistingValueAndOverrideTrue -- Just \"OVERRIDE\"\n\n  unsetEnv envVar\n\n  valueAfterUnsettingVariable <- getEnv envVar\n  print valueAfterUnsettingVariable -- Nothing\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.Conc\nimport GHC.IO\nimport GHC.IO.FD as FD\nimport System.Posix.IO\nimport System.Posix.Types\n\nmain = do\n  (rfd,wfd) <- createPipe\n  (waitread, unregister) <- threadWaitReadSTM rfd\n  unregister\n  result0 <- atomically $ (fmap (const False) waitread) `orElse` return True\n  print result0\n  fdWrite wfd \"test\"\n  threadDelay 20000\n  result1 <- atomically $ (fmap (const False) waitread) `orElse` return True\n  print result1\n  (waitread1, _) <- threadWaitReadSTM rfd\n  threadDelay 20000\n  result2 <- atomically $ (fmap (const True) waitread1) `orElse` return False\n  print result2\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Proxy\n\nmain :: IO ()\nmain = print (read \"Thing Proxy\" :: Thing (Proxy Int))\n\ndata Thing a = Thing a\n  deriving (Read,Show)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\nimport Data.Ord\n\nmain :: IO ()\nmain = do\n  print ((<) 10 20)\n  print ((<) @(Down _) 10 20)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.IORef\nimport Control.Monad\nimport Control.Exception\nimport Control.Concurrent.MVar\nimport System.Mem\n\nmain :: IO ()\nmain = do\n  run\n  run\n  run\n  run\n  m <- newEmptyMVar\n  quit m\n  performMajorGC\n  takeMVar m\n\nrun :: IO ()\nrun = do\n  ref <- newIORef ()\n  void $ mkWeakIORef ref $ do\n    putStr \".\"\n    throwIO $ ErrorCall \"failed\"\n\nquit :: MVar () -> IO ()\nquit m = do\n  ref <- newIORef ()\n  void $ mkWeakIORef ref $ do\n    putMVar m ()\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- To test with GHC before liftA2 was added to the Applicative\n-- class, remove the definition of liftA2 here, and import\n-- liftA2 separately from Control.Applicative.\n{-# LANGUAGE DeriveTraversable, GADTs, DataKinds,\n    DeriveFunctor, StandaloneDeriving #-}\n\nmodule Main where\nimport Control.Applicative (Applicative (..))\nimport Data.Monoid (Sum (..))\nimport qualified Data.Array as A\n\ndata Tree a = Leaf a a | Node (Tree a) (Tree a)\n  deriving (Functor, Foldable, Traversable)\n\nbuildTree :: Int -> a -> Tree a\nbuildTree 0 a = Leaf a a\nbuildTree n a =\n  let subtree = buildTree (n - 1) a\n  in Node subtree subtree\n\ndata Nat = Z | S Nat\n\ndata Vec n a where\n  Nil :: Vec 'Z a\n  Cons :: a -> !(Vec n a) -> Vec ('S n) a\n\nderiving instance Functor (Vec n)\nderiving instance Foldable (Vec n)\nderiving instance Show a => Show (Vec n a)\n\nclass Pure n where\n  pure' :: a -> Vec n a\ninstance Pure 'Z where\n  pure' _ = Nil\ninstance Pure n => Pure ('S n) where\n  pure' a = Cons a (pure' a)\n\ninstance Pure n => Applicative (Vec n) where\n  pure = pure'\n  (<*>) = apVec\n  liftA2 = liftA2Vec\n\napVec :: Vec n (a -> b) -> Vec n a -> Vec n b\napVec Nil Nil = Nil\napVec (Cons f fs) (Cons x xs) = f x `Cons` apVec fs xs\n\nliftA2Vec :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c\nliftA2Vec _ Nil Nil = Nil\nliftA2Vec f (Cons x xs) (Cons y ys) = f x y `Cons` liftA2Vec f xs ys\n\ndata SomeVec a where\n  SomeVec :: Pure n => Vec n a -> SomeVec a\n\nreplicateVec :: Int -> a -> SomeVec a\nreplicateVec 0 _ = SomeVec Nil\nreplicateVec n a =\n  case replicateVec (n - 1) a of\n    SomeVec v -> SomeVec (a `Cons` v)\n\nones :: SomeVec Int\nones = replicateVec 6000 (1 :: Int)\n\ntheTree :: Tree ()\ntheTree = buildTree 7 ()\n\nblah :: SomeVec (Tree Int)\nblah = case ones of\n         SomeVec v -> SomeVec $ traverse (const v) theTree\n\nmain = case blah of\n         SomeVec v -> print $ getSum $ foldMap (foldMap Sum) v\n", "num_lines": 72}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Posix.Files\nimport System.IO\nimport System.Timeout\n\nmain :: IO ()\nmain = do\n    createNamedPipe \"test\" accessModes\n    h <- openFile \"test\" ReadMode\n    hWaitForInput h (5 * 1000)\n    return ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.ResponseFile\n\nassertEqual :: (Eq a, Show a) => a -> a -> IO ()\nassertEqual x y = if x == y\n                  then return ()\n                  else error $ \"assertEqual: \" ++ show x ++ \" /= \" ++ show y\n\n-- Migrated from Haddock.\n\n-- The first two elements are\n--   1) a list of 'args' to encode and\n--   2) a single string of the encoded args\n-- The 3rd element is just a description for the tests.\ntestStrs :: [(([String], String), String)]\ntestStrs =\n  [ (([\"a simple command line\"],\n      \"a\\\\ simple\\\\ command\\\\ line\\n\"),\n     \"the white-space, end with newline\")\n\n  , (([\"arg 'foo' is single quoted\"],\n      \"arg\\\\ \\\\'foo\\\\'\\\\ is\\\\ single\\\\ quoted\\n\"),\n     \"the single quotes as well\")\n\n  , (([\"arg \\\"bar\\\" is double quoted\"],\n      \"arg\\\\ \\\\\\\"bar\\\\\\\"\\\\ is\\\\ double\\\\ quoted\\n\"),\n     \"the double quotes as well\" )\n\n  , (([\"arg \\\"foo bar\\\" has embedded whitespace\"],\n      \"arg\\\\ \\\\\\\"foo\\\\ bar\\\\\\\"\\\\ has\\\\ embedded\\\\ whitespace\\n\"),\n     \"the quote-embedded whitespace\")\n\n  , (([\"arg 'Jack said \\\\'hi\\\\'' has single quotes\"],\n      \"arg\\\\ \\\\'Jack\\\\ said\\\\ \\\\\\\\\\\\'hi\\\\\\\\\\\\'\\\\'\\\\ has\\\\ single\\\\ quotes\\n\"),\n     \"the escaped single quotes\")\n\n  , (([\"arg 'Jack said \\\\\\\"hi\\\\\\\"' has double quotes\"],\n      \"arg\\\\ \\\\'Jack\\\\ said\\\\ \\\\\\\\\\\\\\\"hi\\\\\\\\\\\\\\\"\\\\'\\\\ has\\\\ double\\\\ quotes\\n\"),\n     \"the escaped double quotes\")\n\n  , (([\"arg 'Jack said\\\\r\\\\n\\\\t \\\\\\\"hi\\\\\\\"' has other whitespace\"],\n      \"arg\\\\ \\\\'Jack\\\\ said\\\\\\\\r\\\\\\\\n\\\\\\\\t\\\\ \\\\\\\\\\\\\\\"hi\\\\\\\\\\\\\\\"\\\\'\\\\ has\\\\ \\\n           \\other\\\\ whitespace\\n\"),\n     \"the other whitespace\")\n\n  , (([ \"--prologue=.\\\\dist\\\\.\\\\haddock-prologue3239114604.txt\"\n      , \"--title=HaddockNewline-0.1.0.0: This has a\\n\\\n        \\newline yo.\"\n      , \"-BC:\\\\Program Files\\\\Haskell Platform\\\\lib\"],\n      \"--prologue=.\\\\\\\\dist\\\\\\\\.\\\\\\\\haddock-prologue3239114604.txt\\n\\\n      \\--title=HaddockNewline-0.1.0.0:\\\\ This\\\\ has\\\\ a\\\\\\n\\\n      \\newline\\\\ yo.\\n\\\n      \\-BC:\\\\\\\\Program\\\\ Files\\\\\\\\Haskell\\\\ Platform\\\\\\\\lib\\n\"),\n     \"an actual haddock response file snippet with embedded newlines\")\n  ]\n\nmain :: IO ()\nmain = do\n  -- Test escapeArgs\n  mapM_ (\\((ss1,s2),des) -> escapeArgs ss1 `assertEqual` s2) testStrs\n\n  -- Test unescapeArgs\n  mapM_ (\\((ss1,s2),des) -> unescapeArgs s2 `assertEqual` ss1) testStrs\n\n  -- Given unescaped quotes, it should pass-through,\n  -- without escaping everything inside\n\n  (filter (not . null) $\n   unescapeArgs \"this\\\\ is\\\\ 'not escape\\\\d \\\"inside\\\"'\\\\ yo\\n\")\n   `assertEqual`\n   [\"this is not escaped \\\"inside\\\" yo\"]\n\n  (filter (not . null) $\n   unescapeArgs \"this\\\\ is\\\\ \\\"not escape\\\\d 'inside'\\\"\\\\ yo\\n\")\n   `assertEqual`\n   [\"this is not escaped 'inside' yo\"]\n", "num_lines": 76}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Ratio\n\nmain = do\n  print (approxRational (0 % 1 :: Ratio Int) (1 % 10)) -- 0%1, correct\n  print (approxRational (0 % 1 :: Ratio Word) (1 % 10)) -- 1%1, incorrect\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad.ST.Strict\nimport Control.Monad.Fix\nimport Data.STRef\n\nfoo :: ST s Int\nfoo = do\n  ref <- newSTRef True\n  mfix $ \\res -> do\n    x <- readSTRef ref\n    if x\n      then do\n        writeSTRef ref False\n        return $! (res + 5)\n      else return 10\n\nmain :: IO ()\nmain = print $ runST foo\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport qualified Data.List as L\n\n-- USE_REPORT_PRELUDE versions of nub and nubBy, copied from\n-- libraries/base/Data/OldList.hs.\nnub                     :: (Eq a) => [a] -> [a]\nnub                     =  nubBy (==)\n\nnubBy                   :: (a -> a -> Bool) -> [a] -> [a]\nnubBy eq []             =  []\nnubBy eq (x:xs)         =  x : nubBy eq (filter (\\ y -> not (eq x y)) xs)\n\ndata Asymmetric = A | B deriving Show\n\ninstance Eq Asymmetric where\n  A == _ = True\n  B == _ = False\n\nmain :: IO()\nmain = do\n  print $ L.nub [A,B]\n  print $ L.nubBy (<) [1,2]\n  -- The implementation from Data.List and the one from the Prelude defined in\n  -- the Haskell 98 report should have the same behavior.\n  print $ L.nub [A,B] == nub [A,B]\n  print $ L.nubBy (<) [1,2] == nubBy (<) [1,2]\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.List\n\n-- this should evaluate in constant space\nmain :: IO ()\nmain = print $ iterate' (+1) 1 !! 100000000\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nimport Control.Monad\nimport Control.Monad.Fix\nimport Data.IORef\nimport Prelude hiding (until)\n\ndata Phase a = Ready a | Updated a a\n\ndelay :: IO Int               -- ^ the signal to delay\n      -> IO (IO (), IO (), IO Int)   -- ^ the delayed signal\ndelay s = do\n  ref <- newIORef (Ready 0)\n  let\n      upd = do v <- readIORef ref\n               case v of\n                 Ready x -> do putStrLn \"upd: Ready\"; x' <- s; putStrLn (show x'); writeIORef ref (Updated x' x)\n                 _       -> return ()\n\n      fin = do v <- readIORef ref\n               case v of\n                 Updated x _ -> do putStrLn \"fin: Updated\"; writeIORef ref $! Ready x\n                 _           -> error \"Signal not updated!\"\n\n      sig = do v <- readIORef ref\n               case v of\n                 Ready x     -> do putStrLn \"sig: Ready\"; return x\n                 Updated _ x -> do putStrLn \"sig: Updated\"; return x\n\n  return (upd,fin,sig)\n\nmain = do\n    (upd,fin,_) <- mfix $ \\ ~(_,_,sig) -> delay (fmap (1+) sig)\n    upd\n    fin\n    upd\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Typeable\n\nunitToUnit_a = typeOf (\\() -> ())\nunitToUnit_b = mkFunTy (typeOf ()) (typeOf ())\n\nmain = print (unitToUnit_a == unitToUnit_b)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do\n  print $ r \"1E100000\"\n  print $ r \"1E100000000\"\n  print $ r \"1E100000000000\"\n  print $ r \"1E100000000000000\"\n  print $ r \"1E100000000000000000\"\n  print $ r \"1E100000000000000000000\"\n\nr :: String -> Double\nr = read\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Text.Printf\nmain = printf \"%*sx\\n\" (-(3::Int)) \"hi\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Monad;\nimport Control.Concurrent\n\nmain :: IO ()\nmain = replicateM_ 1000000 (forkIO (threadDelay 1))\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport System.Posix.IO\n\nmain = do\n  putStrLn \"hello\"\n  fd <- openFd \"/dev/random\" ReadOnly Nothing defaultFileFlags\n  threadWaitRead fd\n  putStrLn \"goodbye\"\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent.MVar\nimport Control.Exception\n\nmain = do\n  mv <- newMVar 'x'\n  e <- try (modifyMVar mv $ \\_ -> return undefined)\n  let _ = e :: Either SomeException ()\n  withMVar mv print -- should not hang\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\n\nmain :: IO ()\nmain = threadDelay maxBound\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport System.IO\nimport System.Timeout\n\nmain :: IO ()\nmain = do\n    forkIO $ do\n        threadDelay (5 * 1000000)\n        -- The timeout should terminate before we ever make it here\n        putStrLn \"t=5 seconds: we shouldn't be here\"\n\n    timeout (1 * 1000000) $ do\n        hWaitForInput stdin (10 * 1000)\n        putStrLn \"we shouldn't be here\"\n\n    return ()\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO()\nmain = print $ length [1..(2^(20::Int)::Integer)]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n\nmodule T9111 where\n\nimport Data.Typeable\n\na = typeRep (Proxy :: Proxy 'True)\nb = typeRep (Proxy :: Proxy Typeable)\nc = typeRep (Proxy :: Proxy (~))\nd = typeRep (Proxy :: Proxy 'Left)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Debug.Trace\nmain = trace \"333\\0UUUU\" $ return ()\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests Data.Bits.FiniteBits(count{Leading,Trailing}Zeros)` -- c.f. T9340.hs\n\nimport Control.Monad\nimport Data.Bits\nimport Data.Int\nimport Data.Typeable\nimport Data.Word\nimport Numeric (showHex)\n\n-- Reference Implementations\n\n-- count trailing zeros\nctzRI :: FiniteBits a => a -> Word\nctzRI x = fromIntegral $ go 0\n  where\n    go i | i >= w      = i\n         | testBit x i = i\n         | otherwise   = go (i+1)\n\n    w = finiteBitSize x\n\n-- count leading zeros\nclzRI :: FiniteBits a => a -> Word\nclzRI x = fromIntegral $ (w-1) - go (w-1)\n  where\n    go i | i < 0       = i -- no bit set\n         | testBit x i = i\n         | otherwise   = go (i-1)\n\n    w = finiteBitSize x\n\n-- Test Driver\nmain :: IO ()\nmain = do\n    forM_ testpats $ \\w64 -> do\n        checkCLZ (fromIntegral w64 :: Word)\n        checkCLZ (fromIntegral w64 :: Word8)\n        checkCLZ (fromIntegral w64 :: Word16)\n        checkCLZ (fromIntegral w64 :: Word32)\n        checkCLZ (fromIntegral w64 :: Word64)\n\n        checkCLZ (fromIntegral w64 :: Int)\n        checkCLZ (fromIntegral w64 :: Int8)\n        checkCLZ (fromIntegral w64 :: Int16)\n        checkCLZ (fromIntegral w64 :: Int32)\n        checkCLZ (fromIntegral w64 :: Int64)\n\n        checkCTZ (fromIntegral w64 :: Word)\n        checkCTZ (fromIntegral w64 :: Word8)\n        checkCTZ (fromIntegral w64 :: Word16)\n        checkCTZ (fromIntegral w64 :: Word32)\n        checkCTZ (fromIntegral w64 :: Word64)\n\n        checkCTZ (fromIntegral w64 :: Int)\n        checkCTZ (fromIntegral w64 :: Int8)\n        checkCTZ (fromIntegral w64 :: Int16)\n        checkCTZ (fromIntegral w64 :: Int32)\n        checkCTZ (fromIntegral w64 :: Int64)\n\n    putStrLn $ concat [\"tested \", show (length testpats), \" patterns\"]\n\n  where\n    -- try to construct some interesting patterns\n    testpats :: [Word64]\n    testpats = [ bit i - 1 | i <- [0..63] ] ++\n               [ complement (bit i - 1) | i <- [0..63] ] ++\n               [ bit i .|. bit j | i <- [0..63], j <- [0..i] ]\n\n    -- Compare impl-under-test with reference-impl\n    checkCLZ :: (Typeable a, Show a, Integral a, FiniteBits a) => a -> IO ()\n    checkCLZ v = unless (vri == viut) $ do\n        putStrLn $ concat [ \"FAILED: clz (0x\", showHex v \" :: \", tyName\n                          , \") ==> (RI=\", show vri, \" vs. IUT=\", show viut, \")\"\n                          ]\n      where\n        tyName = show (typeOf v)\n        vri    = clzRI v\n        viut   = fromIntegral (countLeadingZeros v)\n\n    -- Compare impl-under-test with reference-impl\n    checkCTZ :: (Typeable a, Show a, Integral a, FiniteBits a) => a -> IO ()\n    checkCTZ v = unless (vri == viut) $ do\n        putStrLn $ concat [ \"FAILED: ctz (0x\", showHex v \" :: \", tyName\n                          , \") ==> (RI=\", show vri, \" vs. IUT=\", show viut, \")\"\n                          ]\n      where\n        tyName = show (typeOf v)\n        vri    = ctzRI v\n        viut   = fromIntegral (countTrailingZeros v)\n", "num_lines": 90}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module XPrelude (module X) where\n\nimport Control.Monad    as X\nimport Data.Foldable    as X\nimport Data.List        as X\nimport Data.Monoid      as X\nimport Data.Traversable as X\nimport Prelude          as X\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9681 where\n\nfoo = 1 + \"\\n\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n--import qualified Data.Vector.Storable as V\nimport Foreign\nimport Data.Ratio\nimport Data.Complex\n\ncomplexZI :: Complex Int\ncomplexZI = 1 :+ 1\n\nratio23 :: Ratio Int\nratio23 =  1 % 1\n\nputter :: Storable a => a -> Ptr a -> IO a\nputter v !ptr = do poke ptr v ; peek ptr\n\nmain =\n  do\n      !vComplex <- alloca (putter complexZI)\n      !vRatio <- alloca (putter ratio23)\n      if vComplex  == complexZI &&  vRatio  == ratio23\n        then putStrLn \"success\"\n        else putStrLn \"uh oh, something is wrong with storable\"\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.IORef\n\nfoo :: Int -> Bool\nfoo n = all (<10000000) [1..n]\n\nbar :: Int -> Bool\nbar n = and $ map (<10000000) [1..n]\n\nmain :: IO ()\nmain = do\n  ref <- newIORef 1000000\n  val <- readIORef ref\n  print $ foo val\n  print $ bar val\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for bug #1219, F/B rule for take was too strict\nimport System.Environment\nmain = do\n (n:_) <- getArgs\n print (map (const 'x') (take (read n) (undefined:undefined)))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Exception\nimport Data.List\nimport System.FilePath\nimport System.Directory\nimport System.IO\n\n-- Checks that openTempFile returns filenames with the right structure\nmain :: IO ()\nmain = do\n fp0 <- otf \".no_prefix.hs\"\n print (\".hs\"        `isSuffixOf` fp0)\n print (\".no_prefix\" `isPrefixOf` takeFileName fp0)\n\n fp1 <- otf \"no_suffix\"\n print (not ('.' `elem` fp1))\n print (\"no_suffix\" `isPrefixOf` takeFileName fp1)\n\n fp2 <- otf \"one_suffix.hs\"\n print (\".hs\"        `isSuffixOf` fp2)\n print (\"one_suffix\" `isPrefixOf` takeFileName fp2)\n\n fp3 <- otf \"two_suffixes.hs.blah\"\n print (\".blah\"           `isSuffixOf` fp3)\n print (\"two_suffixes.hs\" `isPrefixOf` takeFileName fp3)\n\notf :: FilePath -> IO FilePath\notf fp = do putStrLn fp\n            bracket (openTempFile \".\" fp)\n                    (\\(fp', h) -> do hClose h\n                                     removeFile fp')\n                    (\\(fp', _) -> case fp' of\n                                  '.' : '/'  : fp'' -> return fp''\n                                  '.' : '\\\\' : fp'' -> return fp''\n                                  _                 -> return fp')\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-      Bug report 28 May 99\n\nWhen compiled with ghc-4.02, everything's fine, it outputs \"Value 7\" as\nexpected. But compiled with ghc-pre-4.03 it yields this error message.\n\n   Fail: Prelude.read: no parse\n-}\n\nmodule Main where\n\ndata Msg = Value Int | Inc   deriving (Show, Read)\n\nmain = do let v = read \"Value 7\"::Msg\n          print v\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Posix.Process\nimport System.Posix.Signals\nimport Control.Exception\nimport Control.Concurrent\n\n-- Test that a simulated ^C sends an async UserInterrupt\n-- exception to the main thread.\n\nmain = handle userInterrupt $ do\n  us <- getProcessID\n  signalProcess sigINT us\n  threadDelay 1000000\n  putStrLn \"Fail: never received  exception\"\n\nuserInterrupt UserInterrupt = putStrLn \"Success: caught UserInterrupt\"\nuserInterrupt e             = putStrLn \"Fail: caught unexpected exception\"\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Control.Concurrent\n\n-- Test that a UserInterrupt exception that propagates to the top level\n-- causes the process to terminate by killing itself with SIGINT\n\nmain = throwIO UserInterrupt\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Posix.Signals\nimport System.Exit\nimport Data.Bits\n\n-- Test that a ExitFailure representing SIGTERM causes\n-- the process to terminate by killing itself with SIGTERM\n\nmain = exitWith (ExitFailure (fromIntegral (-sigTERM)))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\n\n-- test that the out-of-band data in an ErrorCall exception is printed\n\nmain = throw (ErrorCallWithLocation \"error\" \"out-of-band\")\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport Debug.Trace\n\nmain = do\n   hPutStr stderr\n        (trace (trace (trace (trace (trace (trace (trace\n          \"one\" \"fish\") \"two\") \"fish\") \"red\") \"fish\") \"blue\") \"fish\")\n   hPutStr stdout\n        (trace (trace (trace (trace (trace (trace (trace\n          \"ONE\" \"FISH\") \"TWO\") \"FISH\") \"RED\") \"FISH\") \"BLUE\") \"FISH\")\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test instances for tuples up to 15\n-- For Read, Show, Eq, Ord, Bounded\n\nmodule Main where\n\ndata T = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O\n       deriving( Eq, Ord, Show, Read, Bounded )\n\nt15 = (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O)\nt14 = (A,B,C,D,E,F,G,H,I,J,K,L,M,N)\nt13 = (A,B,C,D,E,F,G,H,I,J,K,L,M)\nt12 = (A,B,C,D,E,F,G,H,I,J,K,L)\nt11 = (A,B,C,D,E,F,G,H,I,J,K)\nt10 = (A,B,C,D,E,F,G,H,I,J)\nt9  = (A,B,C,D,E,F,G,H,I)\nt8  = (A,B,C,D,E,F,G,H)\nt7  = (A,B,C,D,E,F,G)\nt6  = (A,B,C,D,E,F)\nt5  = (A,B,C,D,E)\nt4  = (A,B,C,D)\nt3  = (A,B,C)\nt2  = (A,B)\nt0  = ()\n\nbig = (t0,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15)\n\nmain = do print big\n          print (read (show big) `asTypeOf` big)\n          print (big == big)\n          print (big < big)\n          print (big > big)\n          print (minBound `asTypeOf` big)\n          print (maxBound `asTypeOf` big)\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Tests the various character classifications for a selection of Unicode\n-- characters.\n\nmodule Main where\n\nimport Data.Char\n\nmain = do\n  putStrLn (\"            \" ++ concat (map (++\" \") strs))\n  mapM putStrLn (map do_char chars)\n where\n  do_char char = s ++ (take (12-length s) (repeat ' ')) ++ concat (map f bs)\n    where\n          s = show char\n          bs = map ($char) functions\n          f True  = \"X     \"\n          f False = \"      \"\n\nstrs = [\"upper\",\"lower\",\"alpha\",\"alnum\",\"digit\",\"print\",\"space\",\"cntrl\"]\n\nfunctions = [isUpper,isLower,isAlpha,isAlphaNum,isDigit,isPrint,isSpace,isControl]\n\nchars = [backspace,tab,space,zero,lower_a,upper_a,delete,\n        right_pointing_double_angle_quotation_mark,\n        greek_capital_letter_alpha,\n        bengali_digit_zero,\n        en_space,\n        gothic_letter_ahsa,\n        monospaced_digit_zero\n        ]\n\nbackspace             = '\\x08'\ntab                   = '\\t'\nspace                 = ' '\nzero                  = '0'\nlower_a               = 'a'\nupper_a               = 'A'\ndelete                = '\\x7f'\nright_pointing_double_angle_quotation_mark = '\\xBB'\nlatin_small_letter_i_with_caron = '\\x1D0'\ncombining_acute_accent = '\\x301'\ngreek_capital_letter_alpha = '\\x0391'\nbengali_digit_zero    = '\\x09E6'\nen_space              = '\\x2002'\ngothic_letter_ahsa    = '\\x10330'\nmonospaced_digit_zero = '\\x1D7F6'\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n\nimport Data.Char\nimport Numeric\n\nheader = \"Code C P S U L A D\"\n\npreds = [\n  isControl,\n  isPrint,\n  isSpace,\n  isUpper,\n  isLower,\n  isAlpha,\n  isDigit]\n\nprtBool :: Bool -> String\n\nprtBool True  = \"T \"\nprtBool False = \"F \"\n\nshowCode :: Char -> Int -> String\n\nshowCode c w = code ++ pad\n  where\n    code = show (ord c)\n    l = length code\n    spaces = map anytospace [1..]\n    anytospace _ = ' '\n    pad  | l >= w = \"\"\n         | otherwise = take (w - l) spaces\n\ncharCode :: Char -> String\n\nrapply a b = b a\n\ncharCode c = (showCode c 5) ++ (foldr1 (++) $ map prtBool $ map (rapply c) preds)\n\nmain = do\n    putStrLn header\n    mapM (putStrLn . charCode) [ (chr 0) .. (chr 6553) ]\n\n\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport System.Mem.Weak\n\nkill:: Ptr a -> IO ()\nkill a = do\n    w <- mkWeakPtr a Nothing\n    addFinalizer a $\n        deRefWeak w >> return ()\n\nmain:: IO ()\nmain = sequence_ . take 10000 . repeat $\n    mallocBytes 100 >>= kill >> return ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Test.QuickCheck\nimport System.IO.Unsafe\nimport Control.Concurrent.Chan\nimport Control.Concurrent\nimport Control.Monad\n\ndata Action = NewChan | ReadChan | WriteChan Int | IsEmptyChan | ReturnInt Int\n            | ReturnBool Bool\n  deriving (Eq,Show)\n\n\nmain = do\n  t <- myThreadId\n  forkIO (threadDelay 1000000 >> killThread t)\n        -- just in case we deadlock\n  testChan\n\ntestChan :: IO ()\ntestChan = do\n  quickCheck prop_NewIs_NewRet\n  quickCheck prop_NewWriteIs_NewRet\n  quickCheck prop_NewWriteRead_NewRet\n\n\nprop_NewIs_NewRet =\n  [NewChan,IsEmptyChan] =^ [NewChan,ReturnBool True]\n\nprop_NewWriteIs_NewRet n =\n  [NewChan,WriteChan n,IsEmptyChan] =^ [NewChan,WriteChan n,ReturnBool False]\n\nprop_NewWriteRead_NewRet n =\n  [NewChan,WriteChan n,ReadChan] =^ [NewChan,ReturnInt n]\n\n\nperform :: [Action] -> IO ([Bool],[Int])\nperform [] = return ([],[])\n\nperform (a:as) =\n  case a of\n    ReturnInt v  -> liftM (\\(b,l) -> (b,v:l)) (perform as)\n    ReturnBool v -> liftM (\\(b,l) -> (v:b,l)) (perform as)\n    NewChan      -> newChan >>= \\chan -> perform' chan as\n    _            -> error $ \"Please use NewChan as first action\"\n\n\nperform' :: Chan Int -> [Action] -> IO ([Bool],[Int])\nperform' _ [] = return ([],[])\n\nperform' chan (a:as) =\n  case a of\n    ReturnInt v  -> liftM (\\(b,l) -> (b,v:l)) (perform' chan as)\n    ReturnBool v -> liftM (\\(b,l) -> (v:b,l)) (perform' chan as)\n    ReadChan     -> liftM2 (\\v (b,l) -> (b,v:l)) (readChan chan)\n                                (perform' chan as)\n    WriteChan n  -> writeChan chan n >> perform' chan as\n    IsEmptyChan  -> liftM2 (\\v (b,l) -> (v:b,l)) (isEmptyChan chan)\n                                (perform' chan as)\n    _                -> error $ \"If you want to use \" ++ show a\n                                ++ \" please use the =^ operator\"\n\n\nactions :: Gen [Action]\nactions =\n  liftM (NewChan:) (actions' 0)\n\n\nactions' :: Int -> Gen [Action]\nactions' contents =\n  oneof ([return [],\n          liftM (IsEmptyChan:) (actions' contents),\n          liftM2 (:) (liftM WriteChan arbitrary) (actions' (contents+1))]\n          ++\n          if contents==0\n             then []\n             else [liftM (ReadChan:) (actions' (contents-1))])\n\n\n(=^) :: [Action] -> [Action] -> Property\nc =^ c' =\n  forAll (actions' (delta 0 c))\n         (\\suff -> observe c suff == observe c' suff)\n  where observe x suff = unsafePerformIO (perform (x++suff))\n\n\n(^=^) :: [Action] -> [Action] -> Property\nc ^=^ c' =\n  forAll actions\n         (\\pref -> forAll (actions' (delta 0 (pref++c)))\n                          (\\suff -> observe c pref suff ==\n                                      observe c' pref suff))\n  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))\n\n\ndelta :: Int -> [Action] -> Int\ndelta i [] = i\n\ndelta i (ReturnInt _:as) = delta i as\n\ndelta i (ReturnBool _:as) = delta i as\n\ndelta _ (NewChan:as) = delta 0 as\n\ndelta i (WriteChan _:as) = delta (i+1) as\n\ndelta i (ReadChan:as) = delta (if i==0\n                                  then error \"read on empty Chan\"\n                                  else i-1) as\n\ndelta i (IsEmptyChan:as) = delta i as\n", "num_lines": 110}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport Control.Monad\nimport System.IO\nimport System.Environment\n\n-- test for deadlocks\nmain = do\n  hSetBuffering stdout NoBuffering\n  [n] <- getArgs\n  replicateM_ (read n) $ do\n         chan <- newChan\n         wid <- forkIO $ forever $ writeChan chan (5::Int)\n         rid <- forkIO $ forever $ void $ readChan chan\n         threadDelay 1000\n         throwTo rid ThreadKilled\n         putStr \".\"\n         readChan chan\n         throwTo wid ThreadKilled\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport Control.Monad\nimport System.IO\nimport System.Environment\n\n-- test for deadlocks\nmain = do\n  hSetBuffering stdout NoBuffering\n  [n] <- getArgs\n  replicateM_ (read n) $ do\n         chan <- newChan\n         wid <- forkIO $ forever $ writeChan chan (5::Int)\n         threadDelay 3000\n         throwTo wid ThreadKilled\n         putStr \".\"\n         writeChan chan (3::Int)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Test.QuickCheck\nimport System.IO.Unsafe\nimport Control.Concurrent.MVar\nimport Control.Concurrent\nimport Control.Monad\n\n\ndata Action = NewEmptyMVar | NewMVar Int | TakeMVar | ReadMVar | PutMVar Int\n            | SwapMVar Int | IsEmptyMVar | ReturnInt Int | ReturnBool Bool\n  deriving (Eq,Show)\n\nmain = do\n  t <- myThreadId\n  forkIO (threadDelay 1000000 >> killThread t)\n        -- just in case we deadlock\n  testMVar\n\ntestMVar :: IO ()\ntestMVar = do\n  quickCheck prop_NewEIs_NewERet\n  quickCheck prop_NewIs_NewRet\n  quickCheck prop_NewTake_NewRet\n  quickCheck prop_NewEPutTake_NewERet\n  quickCheck prop_NewRead_NewRet\n  quickCheck prop_NewSwap_New\n\n\nprop_NewEIs_NewERet =\n  [NewEmptyMVar,IsEmptyMVar] =^ [NewEmptyMVar,ReturnBool True]\n\nprop_NewIs_NewRet n =\n  [NewMVar n,IsEmptyMVar] =^ [NewMVar n,ReturnBool False]\n\nprop_NewTake_NewRet n =\n  [NewMVar n,TakeMVar] =^ [NewEmptyMVar,ReturnInt n]\n\nprop_NewEPutTake_NewERet n =\n  [NewEmptyMVar,PutMVar n,TakeMVar] =^\n    [NewEmptyMVar,ReturnInt n]\n\nprop_NewRead_NewRet n =\n  [NewMVar n,ReadMVar] =^ [NewMVar n,ReturnInt n]\n\nprop_NewSwap_New m n =\n  [NewMVar m,SwapMVar n] =^ [NewMVar n]\n\n\nperform :: [Action] -> IO ([Bool],[Int])\nperform [] = return ([],[])\n\nperform (a:as) =\n  case a of\n    ReturnInt v  -> liftM (\\(b,l) -> (b,v:l)) (perform as)\n    ReturnBool v -> liftM (\\(b,l) -> (v:b,l)) (perform as)\n    NewEmptyMVar -> newEmptyMVar >>= \\mv -> perform' mv as\n    NewMVar n    -> newMVar n >>= \\mv -> perform' mv as\n    _            -> error $ \"Please use NewMVar or NewEmptyMVar as first \"\n                            ++ \"action\"\n\n\nperform' :: MVar Int -> [Action] -> IO ([Bool],[Int])\nperform' _ [] = return ([],[])\n\nperform' mv (a:as) =\n  case a of\n    ReturnInt v  -> liftM (\\(b,l) -> (b,v:l)) (perform' mv as)\n    ReturnBool v -> liftM (\\(b,l) -> (v:b,l)) (perform' mv as)\n    TakeMVar     -> liftM2 (\\v (b,l) -> (b,v:l)) (takeMVar mv)\n                                (perform' mv as)\n    ReadMVar     -> liftM2 (\\v (b,l) -> (b,v:l)) (readMVar mv)\n                                (perform' mv as)\n    PutMVar n    -> putMVar mv n >> perform' mv as\n    SwapMVar n   -> swapMVar mv n >> perform' mv as\n    IsEmptyMVar  -> liftM2 (\\v (b,l) -> (v:b,l)) (isEmptyMVar mv)\n                                (perform' mv as)\n    _            -> error $ \"If you want to use \" ++ show a\n                            ++ \" please use the =^ operator\"\n\n\nactions :: Gen [Action]\nactions = do\n  oneof [liftM (NewEmptyMVar:) (actions' True),\n         liftM2 (:) (liftM NewMVar arbitrary) (actions' False)]\n\n\nactions' :: Bool -> Gen [Action]\nactions' empty =\n  oneof ([return [],\n          liftM (IsEmptyMVar:) (actions' empty)] ++\n          if empty\n             then [liftM2 (:) (liftM PutMVar arbitrary) (actions' False)]\n             else []\n          ++\n          if empty\n             then []\n             else [liftM (TakeMVar:) (actions' True)]\n          ++\n          if empty\n             then []\n             else [liftM (ReadMVar:) (actions' False)]\n          ++\n          if empty\n             then []\n             else [liftM2 (:) (liftM SwapMVar arbitrary) (actions' False)]   )\n\n\n(=^) :: [Action] -> [Action] -> Property\nc =^ c' =\n  forAll (actions' (delta True c))\n         (\\suff -> observe c suff == observe c' suff)\n  where observe x suff = unsafePerformIO (perform (x++suff))\n\n\n(^=^) :: [Action] -> [Action] -> Property\nc ^=^ c' =\n  forAll actions\n         (\\pref -> forAll (actions' (delta True (pref++c)))\n                          (\\suff -> observe c pref suff ==\n                                      observe c' pref suff))\n  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))\n\n\ndelta :: Bool -> [Action] -> Bool\ndelta b [] = b\n\ndelta b (ReturnInt _:as) = delta b as\n\ndelta b (ReturnBool _:as) = delta b as\n\ndelta _ (NewEmptyMVar:as) = delta True as\n\ndelta _ (NewMVar _:as) = delta False as\n\ndelta b (TakeMVar:as) = delta (if b\n                                  then error \"take on empty MVar\"\n                                  else True) as\n\ndelta b (ReadMVar:as) = delta (if b\n                                  then error \"read on empty MVar\"\n                                  else False) as\n\ndelta _ (PutMVar _:as) = delta False as\n\ndelta b (SwapMVar _:as) = delta (if b\n                                  then error \"swap on empty MVar\"\n                                  else False) as\n\ndelta b (IsEmptyMVar:as) = delta b as\n", "num_lines": 149}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test that threadDelay actually sleeps for (at least) as long as we\n-- ask it\n\nmodule Main (main) where\n\nimport Control.Concurrent\nimport Control.Monad\nimport Data.Time\n\nmain :: IO ()\nmain = mapM_ delay (0 : take 7 (iterate (*5) 100))\n\ndelay :: Int -> IO ()\ndelay n = do\n  tS <- getCurrentTime\n  threadDelay n\n  tE <- getCurrentTime\n\n  let req = fromIntegral n * 10 ^ (6 :: Int)\n      obs = floor (diffUTCTime tE tS * 10 ^ (12 :: Int))\n      diff = obs - req\n      diff' :: Double\n      diff' = fromIntegral diff /  10 ^ (12 :: Int)\n\n  when (obs < req) $ print (tS, tE, req, obs, diff, diff')\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\n\nmain = do\n  forkIO $ do threadDelay  100000; putStrLn \"child\"\n  getLine\n  putStrLn \"parent\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Process\nimport System.IO\nimport Control.Concurrent\n\nmain = do\n  (hin,hout,herr,ph) <- runInteractiveProcess \"cat\" [] Nothing Nothing\n  forkIO $ do threadDelay 100000\n              putStrLn \"child\"\n              hFlush stdout\n              hPutStrLn hin \"msg\"\n              hFlush hin\n  putStrLn \"parent1\"\n  hGetLine hout >>= putStrLn\n  putStrLn \"parent2\"\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for trac #629. We need to keep track of how many readers\n-- there are rather than closing the first read handle causing the\n-- lock to be released.\n\nimport System.IO\nimport System.IO.Error\n\nfile = \"countReaders001.txt\"\n\nmain = do\n  writeFile file \"foo\"\n\n  h1 <- openFile file ReadMode\n  h2 <- openFile file ReadMode\n  hClose h1\n  tryIOError (openFile file AppendMode) >>= print\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport System.IO\nimport System.IO.Error\nimport GHC.IO.Encoding (utf8)\nimport GHC.IO.Handle (hSetEncoding)\n\ntestfiles = [\"decodingerror001.in1\", \"decodingerror001.in2\"]\n\nmain = mapM_ alltests testfiles\n\nalltests file = mapM (test file)  [NoBuffering,\n                                   LineBuffering,\n                                   BlockBuffering Nothing,\n                                   BlockBuffering (Just 9),\n                                   BlockBuffering (Just 23) ]\n\ntest file bufmode = do\n  h <- openFile file ReadMode\n  hSetEncoding h utf8\n  hSetBuffering h bufmode\n  e <- tryIOError $ forever $ hGetChar h >>= putChar\n  print (e :: Either IOError ())\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport System.IO\nimport System.IO.Error\nimport GHC.IO.Handle (hSetEncoding)\n\nmain = do\n  -- Explicitly set stdout encoding so that the UTF8//ROUNDTRIP\n  -- test is always able to write the surrogate byte out without error.\n  enc <- mkTextEncoding \"UTF-8//ROUNDTRIP\"\n  hSetEncoding stdout enc\n  alltests \"decodingerror002.in\"\n\nalltests file = mapM (test file)  [\"UTF-8\",\n                                   \"UTF-8//IGNORE\",\n                                   \"UTF-8//TRANSLIT\",\n                                   \"UTF-8//ROUNDTRIP\"]\n\ntest file enc_name = do\n  h <- openFile file ReadMode\n  enc <- mkTextEncoding enc_name\n  hSetEncoding h enc\n  e <- tryIOError $ forever $ hGetChar h >>= putChar\n  print (e :: Either IOError ())\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport System.IO\nimport GHC.IO.Encoding\nimport GHC.IO.Handle\nimport Data.Bits\nimport Data.Word\nimport Data.Char\nimport System.FilePath\nimport System.Exit\n\nfile = \"encoding001\"\n\nencodings = [(utf8,     \"utf8\"),\n             (utf8_bom, \"utf8_bom\"),\n             (utf16,    \"utf16\"),\n             (utf16le,  \"utf16le\"),\n             (utf16be,  \"utf16be\"),\n             (utf32,    \"utf32\"),\n             (utf32le,  \"utf32le\"),\n             (utf32be,  \"utf32be\")]\n\nmain = do\n  -- make a UTF-32BE file\n  h <- openBinaryFile (file <.> \"utf32be\") WriteMode\n  let expand32 :: Word32 -> [Char]\n      expand32 x = [\n          chr (fromIntegral (x `shiftR` 24) .&. 0xff),\n          chr (fromIntegral (x `shiftR` 16) .&. 0xff),\n          chr (fromIntegral (x `shiftR` 8)  .&. 0xff),\n          chr (fromIntegral x .&. 0xff) ]\n  hPutStr h (concatMap expand32 [ 0, 32 .. 0xD7ff ])\n  hPutStr h (concatMap expand32 [ 0xE000, 0xE000+32 .. 0x10FFFF ])\n  hClose h\n\n  -- convert the UTF-32BE file into each other encoding\n  forM_ encodings $ \\(enc,name) -> do\n     when (name /=  \"utf32be\") $ do\n       hin <- openFile (file <.> \"utf32be\") ReadMode\n       hSetEncoding hin utf32be\n       hout <- openFile (file <.> name) WriteMode\n       hSetEncoding hout enc\n       hGetContents hin >>= hPutStr hout\n       hClose hin\n       hClose hout\n\n  forM_ [ (from,to) | from <- encodings, to <- encodings, snd from /= snd to ]\n      $ \\((fromenc,fromname),(toenc,toname)) -> do\n     hin <- openFile (file <.> fromname) ReadMode\n     hSetEncoding hin fromenc\n     hout <- openFile (file <.> toname <.> fromname) WriteMode\n     hSetEncoding hout toenc\n     hGetContents hin >>= hPutStr hout\n     hClose hin\n     hClose hout\n\n     h1 <- openBinaryFile (file <.> toname) ReadMode\n     h2 <- openBinaryFile (file <.> toname <.> fromname) ReadMode\n     str1 <- hGetContents h1\n     str2 <- hGetContents h2\n     when (str1 /= str2) $ do\n       putStrLn (file <.> toname ++ \" and \" ++ file <.> toname <.> fromname ++ \" differ\")\n       exitWith (ExitFailure 1)\n     hClose h1\n     hClose h2\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\n\nimport System.IO\nimport Control.Exception\n\nimport Foreign.Marshal.Array\nimport Foreign.Ptr\n\nimport GHC.Foreign\nimport GHC.IO.Encoding (TextEncoding, mkTextEncoding)\n\nimport Data.Char\nimport Data.Word\n\n\ndecode :: TextEncoding -> [Word8] -> IO String\ndecode enc xs = withArrayLen xs (\\sz p -> peekCStringLen enc (castPtr p, sz)) `catch` \\e -> return (show (e :: IOException))\n\nencode :: TextEncoding -> String -> IO [Word8]\nencode enc cs = withCStringLen enc cs (\\(p, sz) -> peekArray sz (castPtr p)) `catch` \\e -> return (const [] (e :: IOException))\n\nasc :: Char -> Word8\nasc = fromIntegral . ord\n\nfamilies = [ ([asc 'H', asc 'i', 0xED, 0xB2, 0x80, asc '!'],\n              [\"UTF-8\",    \"UTF-8//IGNORE\",    \"UTF-8//TRANSLIT\",    \"UTF-8//ROUNDTRIP\"])\n           , ([asc 'H', 0, asc 'i', 0, 0xFF, 0xDF, 0xFF, 0xDF, asc '!', 0],\n              [\"UTF-16LE\", \"UTF-16LE//IGNORE\", \"UTF-16LE//TRANSLIT\", \"UTF-16LE//ROUNDTRIP\"])\n           , ([0, asc 'H', 0, asc 'i', 0xDF, 0xFF, 0xDF, 0xFF, 0, asc '!'],\n              [\"UTF-16BE\", \"UTF-16BE//IGNORE\", \"UTF-16BE//TRANSLIT\", \"UTF-16BE//ROUNDTRIP\"])\n           , ([asc 'H', 0, 0, 0, asc 'i', 0, 0, 0, 0xED, 0xB2, 0x80, 0, asc '!', 0, 0, 0],\n              [\"UTF-32LE\", \"UTF-32LE//IGNORE\", \"UTF-32LE//TRANSLIT\", \"UTF-32LE//ROUNDTRIP\"])\n           , ([0, 0, 0, asc 'H', 0, 0, 0, asc 'i', 0, 0x80, 0xB2, 0xED, 0, 0, 0, asc '!'],\n              [\"UTF-32BE\", \"UTF-32BE//IGNORE\", \"UTF-32BE//TRANSLIT\", \"UTF-32BE//ROUNDTRIP\"])\n           ]\n\nmain = do\n  surrogate_enc <- mkTextEncoding \"UTF-8//ROUNDTRIP\"\n    \n  -- Test that invalid input is correctly roundtripped as surrogates\n  -- This only works for the UTF-8 UTF since it is the only UTF which\n  -- is an ASCII superset.\n  putStrLn $ \"== UTF-8: roundtripping\"\n  let invalid_bytes = [asc 'H', asc 'i', 0xED, 0xB2, 0x80, asc '!']\n  surrogates <- decode surrogate_enc invalid_bytes\n  invalid_bytes' <- encode surrogate_enc surrogates\n  print invalid_bytes\n  print surrogates\n  print invalid_bytes'\n  print (invalid_bytes == invalid_bytes')\n  putStrLn \"\"\n  \n  forM families $ \\(invalid_bytes, enc_names) -> do\n    encs <- mapM mkTextEncoding enc_names\n    let name = head enc_names\n    \n    -- How we deal with decoding errors in the various modes:\n    putStrLn $ \"== \" ++ name ++ \": decoding\"\n    forM encs $ \\enc -> decode enc invalid_bytes >>= print\n    \n    -- How about encoding errors, particularly those from embedded surrogates?\n    putStrLn $ \"== \" ++ name ++ \": encoding\"\n    forM encs $ \\enc -> encode enc \"Hi\\xDC80!\" >>= print\n    \n    putStrLn \"\"\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport System.Directory\nimport Data.Char\n\ntempFile = \"temp\"\n\ncreate :: IO ()\ncreate = do\n    h <- openFile tempFile WriteMode\n    hSetEncoding h latin1\n    hPutStr h [chr 128]\n    hClose h\n\nmain :: IO ()\nmain = do\n    create\n\n    utf8Ignore <- mkTextEncoding \"UTF8//IGNORE\"\n    h <- openFile tempFile ReadMode\n    hSetEncoding h utf8Ignore\n    hGetContents h >>= putStrLn\n\n    removeFile tempFile\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport System.Directory\nimport Data.Char\nimport System.Process\nimport Control.Monad\nimport qualified Data.ByteString as BS\nimport System.Environment\nimport System.Exit\nimport System.FilePath\nimport Data.Maybe\nimport qualified Data.Map as M\nimport GHC.Foreign\nimport Control.Exception\n\n\ndecode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)\ndecode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc\n\nencode :: TextEncoding -> String -> IO (Either SomeException BS.ByteString)\nencode enc cs = try $ withCStringLen enc cs $ BS.packCStringLen\n\ndecodeEncode :: TextEncoding -> BS.ByteString -> IO (Either SomeException BS.ByteString)\ndecodeEncode enc bs = decode enc bs `bind` encode enc\n\nencodedecode :: TextEncoding -> String -> IO (Either SomeException String)\nencodedecode enc bs = encode enc bs `bind` decode enc\n\nbind mx fxmy = do\n    ei_e_cs <- mx\n    case ei_e_cs of\n        Left e   -> return (Left e)\n        Right cs -> fxmy cs\n\n\nmain :: IO ()\nmain = forM_ [ (\"CP936\",  2, \"CP936\",      Just \"CP936-UTF8\")  -- Representative (roundtrippable) DBCS\n             , (\"CP1251\", 1, \"CP1251\",     Just \"CP1251-UTF8\") -- Representative SBCS\n             , (\"UTF-8\",  4, \"CP936-UTF8\", Nothing)            -- Sanity check\n             ] $ \\(enc_name, max_byte_length, file, mb_utf8_file) -> do\n    putStrLn $ \"== \" ++ enc_name\n\n    let fp = \"encoded-data\" </> file <.> \"txt\"\n    enc <- mkTextEncoding enc_name\n    bs <- BS.readFile fp\n\n    -- In a DBCS you should never fail to encode truncated input for two consecutive truncation points,\n    -- assuming that the input file is actually error free:\n    testTruncations enc max_byte_length bs\n\n    -- Should be able to roundtrip arbitrary rubbish, as long as we use the right encoding\n    roundtrip_enc <- mkTextEncoding (enc_name ++ \"//ROUNDTRIP\")\n    testRoundtripping roundtrip_enc bs\n\n    -- Just check that we actually decode to the right thing, for good measure\n    case mb_utf8_file of\n      Nothing -> return ()\n      Just utf8_file -> do\n        utf8_bs <- BS.readFile (\"encoded-data\" </> utf8_file <.> \"txt\")\n        Right expected <- decode utf8 utf8_bs\n        Right actual   <- decode enc  bs\n        unless (expected == actual) $ do\n            putStrLn (bsDiff 0 actual expected)\n\nforTruncations :: BS.ByteString -> (BS.ByteString -> IO a) -> IO [a]\nforTruncations bs f = forSplits bs $ \\before _ -> f before\n\nforSplits :: BS.ByteString -> (BS.ByteString -> BS.ByteString -> IO a) -> IO [a]\nforSplits bs f = forM [(800 * block) + ix | block <- [0..len `div` 800], ix <- [0..100]] $ \\i -> uncurry f (BS.splitAt i bs)\n    where len = BS.length bs\n\ntestTruncations :: TextEncoding -> Int -> BS.ByteString -> IO ()\ntestTruncations enc max_byte_length bs = do\n    failures <- fmap catMaybes $ forTruncations bs $ testTruncation enc\n\n    let failure_map = M.fromList failures\n    forM_ failures $ \\(i, e) -> do\n        let js = [i+1..i+(max_byte_length - 1)]\n        case sequence (map (`M.lookup` failure_map) js) of\n            Nothing -> return ()\n            Just es -> putStrLn (\"Failed on consecutive truncated byte indexes \" ++ show (i:js) ++ \" (\" ++ show (e:es) ++ \")\")\n\ntestTruncation :: TextEncoding -> BS.ByteString -> IO (Maybe (Int, SomeException))\ntestTruncation enc expected = do\n        --putStr (show i ++ \": \") >> hFlush stdout\n        ei_e_actual <- decodeEncode enc expected\n        case ei_e_actual of\n            Left  e      -> return (Just (BS.length expected, e))\n            Right actual | expected /= actual -> error $ \"Mismatch on success when truncating at byte index \" ++ show (BS.length expected)\n                         | otherwise          -> return Nothing\n\ntestRoundtripping :: TextEncoding -> BS.ByteString -> IO ()\ntestRoundtripping roundtrip_enc bs = void $ forSplits bs $ \\before after -> do\n    let expected = before `BS.append` (fromIntegral (BS.length before `mod` 256) `BS.cons` after)\n    Right actual <- decodeEncode roundtrip_enc expected\n    when (actual /= expected) $ do\n        let i_str = show (BS.length before)\n        putStrLn $ \"Failed to roundtrip given mutant byte at index \" ++ i_str ++ \" (\" ++ bsDiff 0 (BS.unpack actual) (BS.unpack expected) ++ \")\"\n        -- Possibly useful for debugging porpoises:\n        --BS.writeFile (i_str ++ \".expected\") expected\n        --BS.writeFile (i_str ++ \".actual\")   actual\n\nbsDiff :: (Show a, Eq a) => Int -> [a] -> [a] -> String\nbsDiff _ [] [] = error \"bsDiff\"\nbsDiff _ [] bs = \"actual \" ++ show (length bs) ++ \" elements shorter than expected\"\nbsDiff _ as [] = \"expected \" ++ show (length as) ++ \" elements shorter than actual\"\nbsDiff i (a:as) (b:bs) | a == b    = bsDiff (i + 1) as bs\n                       | otherwise = show a ++ \" /= \" ++ show b ++ \" at index \" ++ show i\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport Data.Word (Word8)\nimport Foreign.Ptr\nimport Foreign.Marshal.Array\nimport GHC.Foreign (peekCStringLen, withCStringLen)\nimport GHC.IO.Encoding.Failure (CodingFailureMode(..))\nimport qualified GHC.IO.Encoding.Latin1 as Latin1\nimport System.IO\nimport System.IO.Error\n\n-- Tests for single-byte encodings that map directly to Unicode\n-- (module GHC.IO.Encoding.Latin1)\n\neitherToMaybe :: Either a b -> Maybe b\neitherToMaybe (Left _) = Nothing\neitherToMaybe (Right b) = Just b\n\ndecode :: TextEncoding -> [Word8] -> IO (Maybe String)\ndecode enc xs = fmap eitherToMaybe . tryIOError $ withArrayLen xs (\\sz p -> peekCStringLen enc (castPtr p, sz))\n\nencode :: TextEncoding -> String -> IO (Maybe [Word8])\nencode enc cs = fmap eitherToMaybe . tryIOError $ withCStringLen enc cs (\\(p, sz) -> peekArray sz (castPtr p))\n\ntestIO :: (Eq a, Show a) => IO a -> a -> IO ()\ntestIO action expected = do\n  result <- action\n  when (result /= expected) $\n    putStrLn $ \"Test failed: expected \" ++ show expected ++ \", but got \" ++ show result\n\n-- Test char8-like encodings\ntest_char8 :: TextEncoding -> IO ()\ntest_char8 enc = do\n  testIO (decode enc [0..0xff]) $ Just ['\\0'..'\\xff']\n\n  testIO (encode enc ['\\0'..'\\x200']) $ Just ([0..0xff] ++ [0..0xff] ++ [0])\n\n-- Test latin1-like encodings\ntest_latin1 :: CodingFailureMode -> TextEncoding -> IO ()\ntest_latin1 cfm enc = do\n  testIO (decode enc [0..0xff]) $ Just ['\\0'..'\\xff']\n\n  testIO (encode enc ['\\0'..'\\xff']) $ Just [0..0xff]\n  testIO (encode enc \"\\xfe\\xff\\x100\\x101\\x100\\xff\\xfe\") $ case cfm of\n    ErrorOnCodingFailure -> Nothing\n    IgnoreCodingFailure -> Just [0xfe,0xff,0xff,0xfe]\n    TransliterateCodingFailure -> Just [0xfe,0xff,0x3f,0x3f,0x3f,0xff,0xfe]\n    -- N.B. The argument \"latin1//TRANSLIT\" to mkTextEncoding does not\n    -- correspond to \"latin1//TRANSLIT\" in iconv! Instead GHC asks iconv\n    -- to encode to \"latin1\" and uses its own \"evil hack\" to insert '?'\n    -- (ASCII 0x3f) in place of failures. See GHC.IO.Encoding.recoverEncode.\n    --\n    -- U+0100 is LATIN CAPITAL LETTER A WITH MACRON, which iconv would\n    -- transliterate to 'A' (ASCII 0x41). Similarly iconv would\n    -- transliterate U+0101 LATIN SMALL LETTER A WITH MACRON to 'a'\n    -- (ASCII 0x61).\n    RoundtripFailure -> Nothing\n\ntest_ascii :: CodingFailureMode -> TextEncoding -> IO ()\ntest_ascii cfm enc = do\n  testIO (decode enc [0..0x7f]) $ Just ['\\0'..'\\x7f']\n  testIO (decode enc [0x7e,0x7f,0x80,0x81,0x80,0x7f,0x7e]) $ case cfm of\n    ErrorOnCodingFailure -> Nothing\n    IgnoreCodingFailure -> Just \"\\x7e\\x7f\\x7f\\x7e\"\n    TransliterateCodingFailure -> Just \"\\x7e\\x7f\\xfffd\\xfffd\\xfffd\\x7f\\x7e\"\n    -- Another GHC special: decode invalid input to the Char U+FFFD\n    -- REPLACEMENT CHARACTER.\n    RoundtripFailure -> Just \"\\x7e\\x7f\\xdc80\\xdc81\\xdc80\\x7f\\x7e\"\n    -- GHC's PEP383-style String-encoding of invalid input,\n    -- see Note [Roundtripping]\n\n  testIO (encode enc ['\\0'..'\\x7f']) $ Just [0..0x7f]\n  testIO (encode enc \"\\x7e\\x7f\\x80\\x81\\x80\\x7f\\xe9\") $ case cfm of\n    ErrorOnCodingFailure -> Nothing\n    IgnoreCodingFailure -> Just [0x7e,0x7f,0x7f]\n    TransliterateCodingFailure -> Just [0x7e,0x7f,0x3f,0x3f,0x3f,0x7f,0x3f]\n    -- See comment in test_latin1. iconv -t ASCII//TRANSLIT would encode\n    -- U+00E9 LATIN SMALL LETTER E WITH ACUTE as 'e' (ASCII 0x65).\n    RoundtripFailure -> Nothing\n\n  -- Test roundtripping for good measure\n  case cfm of\n    RoundtripFailure -> do\n      Just s <- decode enc [0..0xff]\n      testIO (encode enc s) $ Just [0..0xff]\n    _ -> return ()\n\nmain = do\n  putStrLn \"char8 tests\"\n  test_char8 char8              -- char8 never fails in either direction\n\n  -- These use GHC's own implementation\n  putStrLn \"Latin1.ascii tests\"\n  test_ascii ErrorOnCodingFailure (Latin1.ascii)\n  test_ascii IgnoreCodingFailure (Latin1.mkAscii IgnoreCodingFailure)\n  test_ascii TransliterateCodingFailure (Latin1.mkAscii TransliterateCodingFailure)\n  test_ascii RoundtripFailure (Latin1.mkAscii RoundtripFailure)\n\n  putStrLn \"Latin1.latin1_checked tests\"\n  test_latin1 ErrorOnCodingFailure (Latin1.latin1_checked)\n  test_latin1 IgnoreCodingFailure (Latin1.mkLatin1_checked IgnoreCodingFailure)\n  test_latin1 TransliterateCodingFailure (Latin1.mkLatin1_checked TransliterateCodingFailure)\n  test_latin1 RoundtripFailure (Latin1.mkLatin1_checked RoundtripFailure)\n\n  -- These use iconv (normally, unless it is broken)\n  putStrLn \"mkTextEncoding ASCII tests\"\n  test_ascii ErrorOnCodingFailure =<< mkTextEncoding \"ASCII\"\n  test_ascii IgnoreCodingFailure =<< mkTextEncoding \"ASCII//IGNORE\"\n  test_ascii TransliterateCodingFailure =<< mkTextEncoding \"ASCII//TRANSLIT\"\n  test_ascii RoundtripFailure =<< mkTextEncoding \"ASCII//ROUNDTRIP\"\n\n  putStrLn \"mkTextEncoding latin1 tests\"\n  test_latin1 ErrorOnCodingFailure =<< mkTextEncoding \"latin1\"\n  test_latin1 IgnoreCodingFailure =<< mkTextEncoding \"latin1//IGNORE\"\n  test_latin1 TransliterateCodingFailure =<< mkTextEncoding \"latin1//TRANSLIT\"\n  test_latin1 RoundtripFailure =<< mkTextEncoding \"latin1//ROUNDTRIP\"\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport System.IO.Error\nimport Text.Printf\nimport Control.Monad\n\nmain = do\n  hSetEncoding stdout latin1\n  forM [NoBuffering,\n        LineBuffering,\n        BlockBuffering Nothing,\n        BlockBuffering (Just 3),\n        BlockBuffering (Just 9),\n        BlockBuffering (Just 32)] $ \\b -> do\n     hSetBuffering stdout b\n     checkedPutStr \"test 1\\n\"\n     checkedPutStr \"\u00c4\u203a\\n\" -- nothing gets written\n     checkedPutStr \"test 2\\n\"\n     checkedPutStr \"H\u00ce\u00adllo\\n\" -- we should write at least the 'H'\n     checkedPutStr \"test 3\\n\"\n     checkedPutStr \"Hello \u00ce\u00b1\u00ce\u00b2\u00ce\u00b3\\n\" -- we should write at least the \"Hello \"\n\ncheckedPutStr str = do\n  r <- tryIOError $ putStr str\n  case r of\n    Right _ -> return ()\n    Left  e -> printf \"Caught %s while trying to write %s\\n\"\n                  (show e) (show str)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\n\nmain = do\n    var0 <- getEnv \"GHC_TEST\"\n    putStrLn var0\n    -- The length proves that we actually decoded it properly, not just read it\n    -- in as latin1 or something (#3308, #3307)\n    putStrLn (\"Test 1: \" ++ show (length var0))\n\n    [arg0] <- getArgs\n    putStrLn arg0\n    putStrLn (\"Test 2: \" ++ show (length arg0))\n\n    [arg1] <- withArgs [\"\u00e4\u00bd\u00a0\u00e5\u00a5\u00bd!\"] getArgs\n    putStrLn arg1\n    putStrLn (\"Test 3: \" ++ show (length arg1))\n\n    args2 <- withArgs [\"a\", \"b\"] getArgs\n    print args2\n    putStrLn (\"Test 4: \" ++ show (length args2))\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--- !!! test for bug in handle finalization fixed in \n--- !!!  1.60      +1 -2      fptools/ghc/lib/std/PrelHandle.lhs\n--- !!!  1.15      +4 -10     fptools/ghc/lib/std/PrelIO.lhs\n\nmodule Main (main) where\n\nimport System.IO\n\ndoTest :: IO ()\ndoTest = do\n  sd <- openFile \"finalization001.hs\" ReadMode\n  result <- hGetContents sd\n  slurp result\n  hClose sd\n  if \"\" `elem` lines (filter (/= '\\r') result)\n   then\n    putStrLn \"ok\"\n   else\n    putStrLn \"fail\"\n\nslurp :: String -> IO ()\nslurp [] = return ()\nslurp (x:xs) = x `seq` slurp xs\n\nmain :: IO ()\nmain = sequence_ (take 200 (repeat doTest))\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport System.IO.Error\n\nmain = do\n  h <- openFile \"hClose001.tmp\" WriteMode\n  hPutStr h \"junk\" \n  hClose h\n  hPutStr h \"junk\" `catchIOError` \\ err -> if isIllegalOperation err then putStr \"Okay\\n\" else error \"Not okay\\n\"\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport Control.Exception\n\nimport qualified GHC.IO.Device as IODevice\nimport GHC.IO.Handle\nimport GHC.IO.Handle.Internals\nimport GHC.IO.Handle.Types\nimport System.Posix.Internals\n\nmain = do\n  h <- openFile \"hClose002.tmp\" WriteMode\n        -- close the FD without telling the IO library:\n  naughtyClose h\n        -- first hClose will raise an exception, but close the\n        -- Handle anyway:\n  showPossibleException (hClose h)\n        -- second hClose should success (Handle is already closed)\n  showPossibleException (hClose h)\n        -- this should succeed (checking that the lock on the file has\n        -- been released:\n  h <- openFile \"hClose002.tmp\" ReadMode\n  showPossibleException (hClose h)\n  showPossibleException (hClose h)\n\nshowPossibleException :: IO () -> IO ()\nshowPossibleException f = do e <- try f\n                             print (e :: Either SomeException ())\n\nnaughtyClose h = \n  withHandle_ \"naughtyClose\" h $ \\ Handle__{haDevice=dev} -> do\n     IODevice.close dev\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for #3128, file descriptor leak when hClose fails\n\nimport System.IO\nimport Control.Exception\nimport Data.Char\n\nimport System.Posix\nimport qualified GHC.IO.Device as IODevice\nimport GHC.IO.Handle\nimport GHC.IO.Handle.Internals\nimport GHC.IO.Handle.Types\nimport System.Posix.Internals\n\nmain = do\n  (read,write) <- createPipe\n  hread <- fdToHandle read\n  hwrite <- fdToHandle write\n\n        -- close the FD without telling the IO library:\n  showPossibleException (hClose hread)\n  hIsOpen hread >>= print\n\n        -- put some data in the Handle's write buffer:\n  hPutStr hwrite \"testing\"\n        -- now try to close the Handle:\n  showPossibleException (hClose hwrite)\n  hIsOpen hwrite >>= print\n\nshowPossibleException :: IO () -> IO ()\nshowPossibleException f = do \n  e <- try f\n  putStrLn (sanitise (show (e :: Either SomeException ())))\n where\n  -- we don't care which file descriptor it is\n  sanitise [] = []\n  sanitise (x:xs) = if isDigit x then ('X':(sanitise' xs)) else (x:(sanitise xs))\n  sanitise' [] = []\n  sanitise' (x:xs) = if isDigit x then (sanitise' xs) else (x:(sanitise xs))\n\nnaughtyClose h = \n  withHandle_ \"naughtyClose\" h $ \\ Handle__{haDevice=dev} -> do\n     IODevice.close dev\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.IO\nimport GHC.IO.Handle\nimport GHC.IO.Handle.Types\nimport System.IO\nimport Control.Concurrent.MVar\nimport Data.Typeable\nimport qualified GHC.IO.FD as FD\n\nmain = do\n   h <- openFile \"tmp\" WriteMode\n   hDuplicateTo h stdout\n   \n   fdh <- getfd h\n   fdstdout <- getfd stdout\n   hPutStrLn stderr (\"h: \" ++ show (fdh /= fdstdout) ++ \"\\nstdout: \" ++ show fdstdout)\n\n   hClose h\n   putStrLn \"bla\"\n\n\ngetfd h@(FileHandle _ mvar) = do\n  withMVar mvar $ \\h__@Handle__{haDevice=dev} ->\n   case cast dev of\n     Just fd -> return (FD.fdFD fd)\n     Nothing -> error \"getfd\"\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\n-- !!! test hFileSize\n\nmain = do\n    h  <- openFile \"hFileSize001.hs\" ReadMode\n    sz <- hFileSize h\n    print sz\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing IO.hFileSize\nmodule Main(main) where\n\nimport Control.Monad\nimport System.Directory ( removeFile, doesFileExist )\nimport System.IO\nimport System.IO.Error\n\nmain = do\n  sz <- hFileSize stdin `catchIOError` (\\ _ -> return (-1))\n  print sz\n  let fn = \"hFileSize002.out\"\n  f <- doesFileExist fn\n  when f (removeFile fn)\n  hdl <- openFile fn WriteMode\n  hPutStr hdl \"file_size\"\n   -- with default buffering\n  sz <- hFileSize hdl\n  print sz\n\n  hSetBuffering hdl NoBuffering\n  hPutStr hdl \"file_size\"\n   -- with no buffering\n  sz <- hFileSize hdl\n  print sz\n  hSetBuffering hdl LineBuffering\n  hPutStr hdl \"file_size\"\n   -- with line buffering\n  sz <- hFileSize hdl\n  print sz\n  hSetBuffering hdl (BlockBuffering (Just 4))\n   -- with block buffering\n  hPutStr hdl \"file_size\"\n  sz <- hFileSize hdl\n  print sz\n  hClose hdl\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Flushing\nmodule Main(main) where\n\nimport Control.Monad\nimport System.Directory ( removeFile, doesFileExist )\nimport System.IO\nimport System.IO.Error\n\nmain = do\n  hFlush stdin `catchIOError` \\ _ -> putStrLn \"No can do - flushing read-only handles isn't legal\"\n  putStr \"Hello,\"\n  hFlush stdout\n  putStr \"Hello - \"\n  hFlush stderr\n  hdl <- openFile \"hFlush001.hs\" ReadMode\n  hFlush hdl `catchIOError` \\ _ -> putStrLn \"No can do - flushing read-only handles isn't legal\"\n  hClose hdl\n  remove\n  hdl <- openFile \"hFlush001.out\" WriteMode\n  hFlush hdl\n  hClose hdl\n  remove\n  hdl <- openFile \"hFlush001.out\" AppendMode\n  hFlush hdl\n  hClose hdl\n  remove\n  hdl <- openFile \"hFlush001.out\" ReadWriteMode\n  hFlush hdl\n  hClose hdl\n where remove = do\n         f <- doesFileExist \"hFlush001.out\"\n         when f (removeFile \"hFlush001.out\")\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing hGetBuf(NonBlocking), hPutBuf(NonBlocking)\n\nimport System.Posix\nimport System.IO\nimport Control.Concurrent\nimport Foreign\nimport Foreign.C\nimport System.Exit\nimport Control.Exception\nimport Control.Monad\n\n\nmain = do\n  -- test should run quickly, but arrange to kill it if it hangs for any reason:\n  main_t <- myThreadId\n  forkIO $ do\n        threadDelay 10000000\n        throwTo main_t (ErrorCall \"killed\")\n\n  zipWithM_ ($)\n          [ f rbuf wbuf\n            | f <- [hGetBufTest, hGetBufNBTest, hGetBufSomeTest],\n              rbuf <- [buf1,buf2,buf3],\n              wbuf <- [buf1,buf2,buf3]\n            ]\n          [1..]\n\nmsg = \"hello!\"\nmsg_length = length msg\n\nbuf1 = NoBuffering\nbuf2 = BlockBuffering (Just 5)\nbuf3 = BlockBuffering (Just 10)\n\n-- chosen to be larger than buf2 & smaller than buf3, so that we exercise\n-- all code paths:\nread_size = 8 :: Int\n\n-- ----------------------------------------------------------------------------\n\n-- hGetBuf/hPutBuf:\n--   - test that it always reads all the data that is available\n--     (with buffer size <, =, > message size).\n--   - test that at the EOF, it returns a short read.\n--   - the writing end is using hPutBuf, with various buffer sizes, and\n--     doing an hFlush at the end of each write.\n\nhGetBufTest rbuf wbuf n = do\n  (read,write) <- createPipe\n  hread <- fdToHandle read\n  hwrite <- fdToHandle write\n  m1 <- newEmptyMVar\n  m2 <- newEmptyMVar\n  finished <- newEmptyMVar\n  hSetBuffering hread rbuf\n  hSetBuffering hwrite wbuf\n  forkIO (readProc m1 m2 finished hread)\n  writeProc m1 m2 hwrite\n  takeMVar finished\n  putStrLn (\"test \" ++ show n ++ \" OK\")\n\n\nreadProc :: MVar () -> MVar () -> MVar () -> Handle -> IO ()\nreadProc m1 m2 finished h = do\n  buf <- mallocBytes 20\n  let\n    loop 0 = return ()\n    loop n = do putMVar m2 (); takeMVar m1\n                r <- hGetBuf h buf msg_length\n                if (r /= msg_length)\n                        then do hPutStr stderr (\"error: \" ++ show r)\n                                exitFailure\n                        else do s <- peekCStringLen (buf,r)\n                                hPutStr stdout (show n ++ \" \")\n                                loop (n-1)\n  loop 100\n  hPutStr stdout \"\\n\"\n  putMVar m2 (); takeMVar m1\n  r <- hGetBuf h buf read_size -- EOF, should get short read\n  s <- peekCStringLen (buf,r)\n  putStrLn (\"got \" ++ show r ++  \": \" ++ s)\n  r <- hGetBuf h buf read_size -- EOF, should get zero-length read\n  s <- peekCStringLen (buf,r)\n  putStrLn (\"got \" ++ show r ++  \": \" ++ s)\n  hClose h\n  putMVar finished ()\n\nwriteProc :: MVar () -> MVar () -> Handle -> IO ()\nwriteProc m1 m2 h = do\n  let\n    loop 0 = return ()\n    loop n =\n        withCStringLen msg  $ \\ (s,len) -> do\n          takeMVar m2\n          hPutBuf h s len\n          hFlush h\n          putMVar m1 ()\n          loop (n-1)\n\n  loop 100\n  takeMVar m2\n  withCString \"end\" $ \\s -> do\n    hPutBuf h s 3\n    putMVar m1 ()\n  hClose h\n\n-- -----------------------------------------------------------------------------\n-- hGetBufNonBlocking:\n\nhGetBufNBTest rbuf wbuf n = do\n  (read,write) <- createPipe\n  hread <- fdToHandle read\n  hwrite <- fdToHandle write\n  m1 <- newEmptyMVar\n  m2 <- newEmptyMVar\n  finished <- newEmptyMVar\n  hSetBuffering hread rbuf\n  hSetBuffering hwrite wbuf\n  forkIO (readProcNB m1 m2 finished hread)\n  writeProcNB m1 m2 hwrite\n  takeMVar finished\n  putStrLn (\"test \" ++ show n ++ \" OK\")\n\n\nreadProcNB :: MVar () -> MVar () -> MVar () -> Handle -> IO ()\nreadProcNB m1 m2 finished h = do\n  buf <- mallocBytes 20\n\n  -- first, test that we can do a non-blocking read:\n  r <- hGetBufNonBlocking h buf read_size\n  s <- peekCStringLen (buf,r)\n  putStrLn (\"got \" ++ show r ++  \": \" ++ s)\n\n  let\n    loop 0 = return ()\n    loop n = do putMVar m2 (); takeMVar m1\n                r <- hGetBufNonBlocking h buf read_size\n                if (r /= msg_length)\n                        then do hPutStr stderr (\"error: \" ++ show r)\n                                exitFailure\n                        else do s <- peekCStringLen (buf,r)\n                                hPutStr stdout (show n ++ \" \")\n                                loop (n-1)\n  loop 100\n  hPutStr stdout \"\\n\"\n  putMVar m2 (); takeMVar m1\n  r <- hGetBufNonBlocking h buf read_size -- EOF, should get short read\n  s <- peekCStringLen (buf,r)\n  putStrLn (\"got \" ++ show r ++  \": \" ++ s)\n  r <- hGetBufNonBlocking h buf read_size -- EOF, should get zero-length read\n  s <- peekCStringLen (buf,r)\n  putStrLn (\"got \" ++ show r ++  \": \" ++ s)\n  hClose h\n  putMVar finished ()\n\nwriteProcNB :: MVar () -> MVar () -> Handle -> IO ()\nwriteProcNB m1 m2 h = do\n  let\n    loop 0 = return ()\n    loop n =\n        withCStringLen msg  $ \\ (s,len) -> do\n          takeMVar m2\n          hPutBufNonBlocking h s len\n          hFlush h\n          putMVar m1 ()\n          loop (n-1)\n\n  loop 100\n  takeMVar m2\n  withCString \"end\" $ \\s -> do\n    hPutBuf h s 3\n    hFlush h\n    putMVar m1 ()\n  hClose h\n\n-- -----------------------------------------------------------------------------\n-- hGetBufSome:\n\nhGetBufSomeTest rbuf wbuf n = do\n  (read,write) <- createPipe\n  hread <- fdToHandle read\n  hwrite <- fdToHandle write\n  m1 <- newEmptyMVar\n  m2 <- newEmptyMVar\n  finished <- newEmptyMVar\n  hSetBuffering hread rbuf\n  hSetBuffering hwrite wbuf\n  forkIO (readProcSome m1 m2 finished hread)\n  writeProcNB m1 m2 hwrite\n  takeMVar finished\n  putStrLn (\"test \" ++ show n ++ \" OK\")\n\n\nreadProcSome :: MVar () -> MVar () -> MVar () -> Handle -> IO ()\nreadProcSome m1 m2 finished h = do\n  buf <- mallocBytes 20\n\n  let\n    loop 0 = return ()\n    loop n = do putMVar m2 (); takeMVar m1\n                r <- hGetBufSome h buf read_size\n                if (r /= msg_length)\n                        then do hPutStr stderr (\"error: \" ++ show r)\n                                exitFailure\n                        else do s <- peekCStringLen (buf,r)\n                                hPutStr stdout (show n ++ \" \")\n                                loop (n-1)\n  loop 100\n  hPutStr stdout \"\\n\"\n  putMVar m2 (); takeMVar m1\n  r <- hGetBufSome h buf read_size -- EOF, should get short read\n  s <- peekCStringLen (buf,r)\n  putStrLn (\"got \" ++ show r ++  \": \" ++ s)\n  r <- hGetBufSome h buf read_size -- EOF, should get zero-length read\n  s <- peekCStringLen (buf,r)\n  putStrLn (\"got \" ++ show r ++  \": \" ++ s)\n  hClose h\n  putMVar finished ()\n", "num_lines": 219}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\nmain = \n    sequence (map hIsOpen [stdin, stdout, stderr]) >>= \\ opens ->\n    print opens >>\n    sequence (map hIsClosed [stdin, stdout, stderr]) >>= \\ closeds ->\n    print closeds >>\n    sequence (map hIsReadable [stdin, stdout, stderr]) >>= \\ readables ->\n    print readables >>\n    sequence (map hIsWritable [stdin, stdout, stderr]) >>= \\ writables ->\n    print writables >>\n    sequence (map hIsBlockBuffered [stdin, stdout, stderr]) >>= \\ buffereds ->\n    print buffereds >>\n    sequence (map hIsLineBuffered [stdin, stdout, stderr]) >>= \\ buffereds ->\n    print buffereds >>\n    sequence (map hIsNotBuffered [stdin, stdout, stderr]) >>= \\ buffereds ->\n    print buffereds\n  where\n    hIsBlockBuffered h = hGetBuffering h >>= \\ b -> return $ case b of { BlockBuffering _ -> True; _ -> False }\n    hIsLineBuffered  h = hGetBuffering h >>= \\ b -> return $ case b of { LineBuffering -> True; _ -> False }\n    hIsNotBuffered   h = hGetBuffering h >>= \\ b -> return $ case b of { NoBuffering -> True; _ -> False }\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\nmain = do\n hSetBuffering stdout NoBuffering\n putStr   \"Enter an integer: \"\n x1 <- readLine\n putStr   \"Enter another integer: \"\n x2 <- readLine\n putStr  (\"Their sum is \" ++ show (read x1 + read x2 :: Int) ++ \"\\n\")\n\n where readLine = do\n           eof <- isEOF\n           if eof then return [] else do\n           c <- getChar\n           if c `elem` ['\\n','\\r']\n                then return []\n                else do cs <- readLine\n                        return (c:cs)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! testing hGetLine\n\nimport System.IO\n\n-- one version of 'cat'\nmain = do\n  let loop h = do b <- hIsEOF h\n                  if b then return ()\n                       else do l <- hGetLine h; putStrLn l; loop h\n  loop stdin\n\n  h <- openFile \"hGetLine001.hs\" ReadMode\n\n  hSetBinaryMode stdout True\n\n  hSetBuffering h NoBuffering\n  loop h\n\n  hSeek h AbsoluteSeek 0\n  hSetBuffering h LineBuffering\n  loop h\n\n  hSeek h AbsoluteSeek 0\n  hSetBuffering h (BlockBuffering (Just 83))\n  loop h\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! testing hGetLine on a file without a final '\\n'.\n\n-- According to the Haskell 98 report, getLine should discard a line without a\n-- closing newline character (see implementation of getLine). \n--\n-- However, we don't believe that this is the right behaviour.\n\nimport System.IO\nimport System.IO.Error\n\nmain = catchIOError loop (\\e -> print e)\n\nloop = do \n  hSetBuffering stdin LineBuffering\n  l <- hGetLine stdin\n  putStrLn l\n  loop\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\nmain = f stdin\n  where f h = do p <- hIsEOF h\n                 if p then putStrLn \"done\"\n                      else do l <- hGetLine h\n                              putStrLn l\n                              f h\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test file positioning\n\nmodule Main(main) where\n\nimport Control.Monad\nimport System.Directory (removeFile, doesFileExist)\nimport System.IO\nimport System.IO.Error\n\nmain = do\n  hIn <- openFile \"hGetPosn001.in\" ReadMode\n  f <- doesFileExist \"hGetPosn001.out\"\n  when f (removeFile \"hGetPosn001.out\")\n  hOut <- openFile \"hGetPosn001.out\" ReadWriteMode\n  bof <- hGetPosn hIn\n  putStrLn (show bof)  -- you can show HandlePosns\n  copy hIn hOut\n  hSetPosn bof\n  copy hIn hOut\n  hSeek hOut AbsoluteSeek 0\n  stuff <- hGetContents hOut\n  putStr stuff\n\ncopy :: Handle -> Handle -> IO ()\ncopy hIn hOut =\n    tryIOError (hGetChar hIn) >>=\n    either (\\ err -> if isEOFError err then return () else error \"copy\")\n           ( \\ x -> hPutChar hOut x >> copy hIn hOut)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hIsEOF (on stdout)\n\nimport System.IO ( hIsEOF, stdout )\nimport System.IO.Error\n\nmain = do\n  flg <- hIsEOF stdout `catchIOError` \\ _ -> putStrLn \"hIsEOF failed\" >> return False\n  print flg\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test hIsEOF in various buffering situations\n\nimport System.IO\n\nmain = do\n  h <- openFile \"hIsEOF002.hs\" ReadMode\n  hSetBuffering h NoBuffering\n  hSeek h SeekFromEnd 0\n  hIsEOF h >>= print\n  hSeek h SeekFromEnd (-1)\n  hIsEOF h >>= print\n  hGetChar h >>= print \n\n  hSetBuffering h LineBuffering\n  hSeek h SeekFromEnd 0\n  hIsEOF h >>= print\n  hSeek h SeekFromEnd (-1)\n  hIsEOF h >>= print\n  hGetChar h >>= print  \n\n  hSetBuffering h (BlockBuffering (Just 1))\n  hSeek h SeekFromEnd 0\n  hIsEOF h >>= print\n  hSeek h SeekFromEnd (-1)\n  hIsEOF h >>= print\n  hGetChar h >>= print  \n\n  hSetBuffering h (BlockBuffering Nothing)\n  hSeek h SeekFromEnd 0\n  hIsEOF h >>= print\n  hSeek h SeekFromEnd (-1)\n  hIsEOF h >>= print\n  hGetChar h >>= print  \n  hClose h\n\n  h <- openFile \"hIsEOF002.out\" WriteMode\n  hPutStrLn h \"hello, world\"\n  hClose h\n\n  h <- openFile \"hIsEOF002.out\" ReadWriteMode\n  hSetBuffering h NoBuffering\n  hSeek h SeekFromEnd 0\n  hIsEOF h >>= print\n  hPutChar h 'x'\n  hIsEOF h >>= print\n  hSeek h SeekFromEnd (-1)\n  hIsEOF h >>= print\n  hGetChar h >>= print \n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hReady test\n\n -- hReady should throw and EOF exception at the end of a file. Trac #1063.\n\nimport System.IO\nimport System.IO.Error\n\nmain = do\n h <- openFile \"hReady001.hs\" ReadMode\n hReady h >>= print\n hSeek h SeekFromEnd 0\n (hReady h >> return ()) `catchIOError` print\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for bug #4078\nimport System.IO\nimport Control.Concurrent\nimport System.Exit\n\nmain = do\n  m <- newEmptyMVar\n  forkIO $ do threadDelay 500000; putMVar m Nothing\n  forkIO $ do hReady stdin >>= putMVar m . Just\n  takeMVar m >>= print\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test seeking\n\nimport System.IO\n\nmain = do\n    h  <- openFile \"hSeek001.in\" ReadMode\n    True <- hIsSeekable h\n    hSeek h SeekFromEnd (-1)\n    z <- hGetChar h\n    putStr (z:\"\\n\")\n    hSeek h SeekFromEnd (-3)\n    x <- hGetChar h\n    putStr (x:\"\\n\")\n    hSeek h RelativeSeek (-2)\n    w <- hGetChar h\n    putStr (w:\"\\n\")\n    hSeek h RelativeSeek 2\n    z <- hGetChar h\n    putStr (z:\"\\n\")\n    hSeek h AbsoluteSeek (0)\n    a <- hGetChar h\n    putStr (a:\"\\n\")\n    hSeek h AbsoluteSeek (10)\n    k <- hGetChar h\n    putStr (k:\"\\n\")\n    hSeek h AbsoluteSeek (25)\n    z <- hGetChar h\n    putStr (z:\"\\n\")\n    hClose h\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing EOF (and the clearing of it)\n\nmodule Main(main) where\n\nimport System.IO\nimport System.Directory ( removeFile )\n\nmain :: IO ()\nmain = do\n   hdl <- openFile \"hSeek002.hs\" ReadMode\n   flg <- hIsEOF hdl\n   print flg\n   hSeek hdl SeekFromEnd 0\n   flg <- hIsEOF hdl\n   print flg\n   hSeek hdl SeekFromEnd (-1)\n   flg <- hIsEOF hdl\n   print flg\n   hGetChar hdl\n   flg <- hIsEOF hdl\n   print flg\n   hSeek hdl SeekFromEnd (-1)\n   flg <- hIsEOF hdl\n   print flg\n   hClose hdl\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! file positions (hGetPosn and hSetPosn)\n\nmodule Main(main) where\n\nimport System.IO\nimport Control.Monad ( sequence )\n\ntestPosns :: Handle -> BufferMode -> IO ()\ntestPosns hdl bmo = do\n   hSetBuffering hdl bmo\n   putStrLn (\"Testing positioning with buffer mode set to: \" ++ show bmo)\n   testPositioning hdl\n\nbmo_ls = [NoBuffering, LineBuffering, BlockBuffering Nothing, \n          BlockBuffering (Just 511),BlockBuffering (Just 3), BlockBuffering (Just 11)]\n\nmain = do\n  hdl  <- openFile \"hSeek003.hs\" ReadMode\n  sequence (zipWith testPosns (repeat hdl) bmo_ls)\n  hClose hdl\n\ntestPositioning hdl = do\n  hSeek hdl AbsoluteSeek 0  -- go to the beginning of the file again.\n  ps   <- getFilePosns 10 hdl\n  hSeek hdl AbsoluteSeek 0\n  putStr \"First ten chars: \"\n  ls   <- hGetChars 10 hdl\n  putStrLn ls\n    -- go to the end\n  hSeek hdl SeekFromEnd 0  \n  ls   <- sequence (map (\\ p -> hSetPosn p >> hGetChar hdl) ps)\n  putStr \"First ten chars: \"\n  putStrLn ls\n\n    -- position ourselves in the middle.\n  sz <- hFileSize hdl\n  hSeek hdl AbsoluteSeek (sz `div` 2)\n  ls   <- sequence (map (\\ p -> hSetPosn p >> hGetChar hdl) ps)\n  putStr \"First ten chars: \"\n  putStrLn ls\n\nhGetChars :: Int -> Handle -> IO String\nhGetChars n h = sequence (replicate n (hGetChar h))\n\ngetFilePosns :: Int -> Handle -> IO [HandlePosn]\ngetFilePosns 0 h = return []\ngetFilePosns x h = do\n   p <- hGetPosn h\n   hGetChar h\n   ps <- getFilePosns (x-1) h\n   return (p:ps)\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! can't seek an AppendMode handle\n\nimport System.IO\nimport System.IO.Error\n\nmain = do\n  h <- openFile \"hSeek004.out\" AppendMode\n  tryIOError (hSeek h AbsoluteSeek 0) >>= print\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\nmain =\n    hSetBuffering stdin NoBuffering     >>\n    hSetBuffering stdout NoBuffering    >>\n    interact id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Reconfiguring the buffering of a handle\nmodule Main(main) where\n\nimport System.IO\nimport System.IO.Error\n\nqueryBuffering :: String -> Handle -> IO ()\nqueryBuffering handle_nm handle = do\n  bufm  <- hGetBuffering handle\n  putStrLn (\"Buffering for \" ++ handle_nm ++ \" is: \" ++ show bufm)\n   \nmain = do\n  queryBuffering \"stdin\" stdin\n  queryBuffering \"stdout\" stdout\n  queryBuffering \"stderr\" stderr\n\n   -- twiddling the setting for stdin.\n  hSetBuffering stdin NoBuffering\n  queryBuffering \"stdin\" stdin\n  hSetBuffering stdin LineBuffering\n  queryBuffering \"stdin\" stdin\n  hSetBuffering stdin (BlockBuffering (Just 2))\n  queryBuffering \"stdin\" stdin\n  hSetBuffering stdin (BlockBuffering Nothing)\n  queryBuffering \"stdin\" stdin\n  let bmo = BlockBuffering (Just (-3))\n  hSetBuffering stdin bmo `catchIOError` \\ _ -> putStrLn (\"Caught illegal op: hSetBuffering stdin \" ++ showParen True (showsPrec 9 bmo) [])\n\n  putChar '\\n'\n\n   -- twiddling the buffering for stdout\n  hPutStr stdout \"Hello stdout 1\"\n  hSetBuffering stdout NoBuffering\n  queryBuffering \"stdout\" stdout\n  hPutStr stdout \"Hello stdout 2\"\n  hSetBuffering stdout LineBuffering\n  queryBuffering \"stdout\" stdout\n  hPutStr stdout \"Hello stdout 3\"\n  hSetBuffering stdout (BlockBuffering (Just 2))\n  queryBuffering \"stdout\" stdout\n  hPutStr stdout \"Hello stdout 4\"\n  hSetBuffering stdout (BlockBuffering Nothing)\n  queryBuffering \"stdout\" stdout\n  hPutStr stdout \"Hello stdout 5\"\n  let bmo = BlockBuffering (Just (-3))\n  hSetBuffering stdout bmo `catchIOError` \\ _ -> putStrLn (\"Caught illegal op: hSetBuffering stdout \" ++ showParen True (showsPrec 9 bmo) [])\n\n  putChar '\\n'\n\n   -- twiddling the buffering for stderr\n  hPutStr stderr \"Hello stderr 1\"\n  hSetBuffering stderr NoBuffering\n  queryBuffering \"stderr\" stderr\n  hPutStr stderr \"Hello stderr 2\"\n  hSetBuffering stderr LineBuffering\n  queryBuffering \"stderr\" stderr\n  hPutStr stderr \"Hello stderr 3\"\n  hSetBuffering stderr (BlockBuffering (Just 2))\n  queryBuffering \"stderr\" stderr\n  hPutStr stderr \"Hello stderr 4\"\n  hSetBuffering stderr (BlockBuffering Nothing)\n  queryBuffering \"stderr\" stderr\n  hPutStr stderr \"Hello stderr 5\"\n  let bmo = BlockBuffering (Just (-3))\n  hSetBuffering stderr bmo `catchIOError` \\ _ -> putStrLn (\"Caught illegal op: hSetBuffering stderr \" ++ showParen True (showsPrec 9 bmo) [])\n\n  ls  <- hGetContents stdin\n  ls' <- putLine ls\n  hSetBuffering stdin NoBuffering\n  putLine ls'\n  return ()\n\nputLine :: String -> IO String\nputLine [] = return []\nputLine (x:xs) = do\n   putChar x\n   case x of\n     '\\n' -> return xs\n     _    -> putLine xs\n  \n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for #2678\nmodule Main (main) where\n\nimport System.IO\n\nmain :: IO ()\nmain = do hSetBuffering stdin NoBuffering\n          hLookAhead stdin >>= print\n          hSetBuffering stdin LineBuffering\n          getContents >>= print\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport GHC.IO.Handle\nimport GHC.IO.Encoding\nimport System.Environment\n\n-- Test switching encodings\n-- The test file is built by the Makefile\n\nmain = do\n  [file] <- getArgs\n  test file NoBuffering\n  test file (BlockBuffering Nothing)\n  test file (BlockBuffering (Just 5))\n\ntest file buf = do\n  hSetEncoding stdout utf8\n  h <- openBinaryFile file ReadMode\n  hSetBuffering stdout buf\n  putStrLn \"no encoding:\"\n  getUntilX h\n  hSetEncoding h utf8\n  putStrLn \"UTF8:\"\n  getUntilX h\n  hSetEncoding h utf16le\n  putStrLn \"UTF16LE:\"\n  getUntilX h\n  hSetEncoding h utf16be\n  putStrLn \"UTF16BE:\"\n  getUntilX h\n  hSetEncoding h utf16\n  putStrLn \"UTF16:\"\n  getUntilX h\n  hSetEncoding h utf32\n  putStrLn \"UTF32:\"\n  getUntilX h\n  hSetEncoding h utf32le\n  putStrLn \"UTF32LE:\"\n  getUntilX h\n  hSetEncoding h utf32be\n  putStrLn \"UTF32BE:\"\n  getUntilX h\n  hSetEncoding h utf8_bom\n  putStrLn \"UTF8-BOM:\"\n  getUntilX h\n  hIsEOF h >>= print\n\ngetUntilX h = do\n  c <- hGetChar h\n  if c == 'X' then return () else do putChar c; getUntilX h\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for #4066\n\nimport System.IO\n\nimport GHC.IO.FD as FD (stdout)\nimport GHC.IO.Handle.FD as FD (fdToHandle)\nimport GHC.IO.Handle ( mkDuplexHandle )\n\nmain = do\n  h <- mkDuplexHandle FD.stdout \"stdout\" Nothing noNewlineTranslation\n  hSetEncoding h utf8\n  hPutStrLn h \"\u00c3\u00b6\"\n  hClose h\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test ioeGetErrorString\n\nimport System.IO\nimport System.IO.Error\nimport Data.Maybe\n\nmain = do\n  h <- openFile \"ioeGetErrorString001.hs\" ReadMode\n  hSeek h SeekFromEnd 0\n  (hGetChar h >> return ()) `catchIOError`\n        \\e -> if isEOFError e\n                then print (ioeGetErrorString e)\n                else putStrLn \"failed.\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test ioeGetFileName\n\nimport System.IO\nimport System.IO.Error\n\nmain = do\n  h <- openFile \"ioeGetFileName001.hs\" ReadMode\n  hSeek h SeekFromEnd 0\n  (hGetChar h >> return ()) `catchIOError`\n        \\e -> if isEOFError e\n                then print (ioeGetFileName e)\n                else putStrLn \"failed.\"\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test ioeGetHandle\n\nimport System.IO\nimport System.IO.Error\nimport Data.Maybe\n\nmain = do\n  h <- openFile \"ioeGetHandle001.hs\" ReadMode\n  hSeek h SeekFromEnd 0\n  (hGetChar h >> return ()) `catchIOError`\n        \\e -> if isEOFError e && fromJust (ioeGetHandle e) == h\n                then putStrLn \"ok.\"\n                else putStrLn \"failed.\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport System.IO.Error\n\n-- test for a bug in GHC <= 4.08.2: handles were being left locked after\n-- being shown in an error message.\nmain = do\n  getContents\n  catchIOError getChar (\\e -> print e >> return 'x')\n  catchIOError getChar (\\e -> print e >> return 'x')\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! IOErrors should have Eq defined\n\nimport System.IO\n\nmain = print (userError \"urk\" == userError \"urk\")\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\nmain = isEOF >>= print\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\nimport Data.Char          (toUpper)\nimport System.Directory   (removeFile, doesFileExist)\nimport System.Environment (getArgs)\n\nmain   =  do\n  [f1,f2] <- getArgs\n  h1 <- openFile f1 ReadMode\n  f <- doesFileExist f2\n  if f then removeFile f2 else return ()\n  h2 <- openFile f2 WriteMode\n  copyFile h1 h2\n  hClose h1\n  hClose h2\n\ncopyFile h1 h2 = do\n  eof <- hIsEOF h1\n  if eof\n        then return ()\n        else do\n  c <- hGetChar h1\n  c <- hPutChar h2 (toUpper c)\n  copyFile h1 h2\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport GHC.IO.Handle\nimport Control.Monad\nimport Data.List\n\nnewlines = [\"\\n\",\"\\r\",\"\\r\\n\",\"\\n\\r\",\"\\n\\n\",\"\\r\\r\"]\n\n-- make sure the file ends in '\\r': that's a tricky case for CRLF\n-- conversion, because the IO library has to check whether there's a\n-- following \\n before returning the \\r.\ncontent = concat [ show i ++ t | (i,t) <- zip [1..100] (cycle newlines) ]\n\nfilename = \"newline001.out\"\n\nfromCRLF [] = []\nfromCRLF ('\\r':'\\n':cs) = '\\n' : fromCRLF cs\nfromCRLF (c:cs) = c : fromCRLF cs\n\ntoCRLF [] = []\ntoCRLF ('\\n':cs) = '\\r':'\\n': toCRLF cs\ntoCRLF (c:cs) = c : toCRLF cs\n\nmain = do\n  h <- openBinaryFile filename WriteMode\n  hPutStr h content\n  hClose h\n  testinput NoBuffering\n  testinput LineBuffering\n  testinput (BlockBuffering Nothing)\n  testinput (BlockBuffering (Just 3))\n  testinput (BlockBuffering (Just 7))\n  testinput (BlockBuffering (Just 16))\n  testoutput NoBuffering\n  testoutput LineBuffering\n  testoutput (BlockBuffering Nothing)\n  testoutput (BlockBuffering (Just 3))\n  testoutput (BlockBuffering (Just 7))\n  testoutput (BlockBuffering (Just 16))\n\ntestinput b = do\n  h <- openFile filename ReadMode\n  hSetBuffering h b\n  hSetNewlineMode h noNewlineTranslation\n  str <- hGetContents h\n  check \"in1\" b str content\n  hClose h\n\n  h <- openFile filename ReadMode\n  hSetBuffering h b\n  hSetNewlineMode h noNewlineTranslation\n  str <- read_chars h\n  check \"in2\" b str content\n  hClose h\n\n  h <- openFile filename ReadMode\n  hSetBuffering h b\n  hSetNewlineMode h noNewlineTranslation\n  str <- read_lines h\n  check \"in3\" b str content\n  hClose h\n\n  h <- openFile filename ReadMode\n  hSetBuffering h b\n  hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF }\n  str <- hGetContents h\n  check \"in4\" b str (fromCRLF content)\n  hClose h\n\n  h <- openFile filename ReadMode\n  hSetBuffering h b\n  hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF }\n  str <- read_chars  h\n  check \"in5\" b str (fromCRLF content)\n  hClose h\n\n  h <- openFile filename ReadMode\n  hSetBuffering h b\n  hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF }\n  str <- read_lines  h\n  check \"in6\" b str (fromCRLF content)\n  hClose h\n\ntestoutput b = do\n  h <- openFile filename WriteMode\n  hSetBuffering h b\n  hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF }\n  hPutStr h content\n  hClose h\n  h <- openBinaryFile filename ReadMode\n  str <- hGetContents h\n  check \"out1\" b (toCRLF content) str\n  hClose h\n\n  h <- openFile filename WriteMode\n  hSetBuffering h b\n  hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF }\n  mapM_ (hPutChar h) content\n  hClose h\n  h <- openBinaryFile filename ReadMode\n  str <- hGetContents h\n  check \"out2\" b (toCRLF content) str\n  hClose h\n\ncheck s b str1 str2 = do\n  when (str1 /= str2) $ error (\"failed: \" ++ s ++ \", \" ++ show b ++ '\\n':show str1 ++ '\\n':show str2)\n\nread_chars :: Handle -> IO String\nread_chars h = loop h \"\"\n  where loop h acc = do\n          b <- hIsEOF h\n          if b then return (reverse acc) else do\n          c <- hGetChar h\n          loop h (c:acc)\n\nread_lines :: Handle -> IO String\nread_lines h = loop h []\n  where loop h acc = do\n          b <- hIsEOF h\n          if b then return (intercalate \"\\n\" (reverse acc)) else do\n          l <- hGetLine h\n          loop h (l : acc)\n", "num_lines": 122}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test that a file opened in ReadMode can't be written to\n\nimport System.IO\nimport System.IO.Error\n\nmain = do\n  hIn <- openFile \"openFile001.hs\" ReadMode\n  hPutStr hIn \"test\" `catchIOError` \\ err ->\n      if isIllegalOperation err\n        then putStrLn \"ok.\"\n        else error \"Oh dear\\n\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Char\nimport System.IO\n\n-- !!! Open a non-existent file for reading (should fail)\n\nmain = openFile \"nonexistent\" ReadMode\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Directory\nimport System.IO\nimport System.IO.Error\n\n-- !!! Open a directory (should fail)\n\nmain = do\n  let dir = \"openFile003Dir\"\n  createDirectoryIfMissing False dir\n  r <- tryIOError (openFile dir ReadMode)\n  print r\n  r <- tryIOError (openFile dir WriteMode)\n  print r\n  r <- tryIOError (openFile dir AppendMode)\n  print r\n  r <- tryIOError (openFile dir ReadWriteMode)\n  print r\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Open a non-existent file for writing\n\nimport Control.Monad\nimport Data.Char\nimport System.Directory\nimport System.IO\n\nfile = \"openFile004.out\"\n\nmain = do\n  b <- doesFileExist file\n  when b (removeFile file)\n\n  h <- openFile file WriteMode\n  hPutStr h \"hello world\\n\"\n  hClose h\n\n  h <- openFile file ReadMode\n  let loop = do\n        b <- hIsEOF h\n        if b then return ()\n             else do c <- hGetChar h; putChar c; loop\n  loop\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test multiple-reader single-writer locking semantics\n\nimport System.IO\nimport System.IO.Error\n\nfile1 = \"openFile005.out1\"\nfile2 = \"openFile005.out2\"\n\nmain = do\n  putStrLn \"two writes (should fail)\"\n  h <- openFile file1 WriteMode\n  tryIOError (openFile file1 WriteMode) >>= print\n  hClose h\n\n  putStrLn \"write and an append (should fail)\"\n  h <- openFile file1 WriteMode\n  tryIOError (openFile file1 AppendMode) >>= print\n  hClose h\n\n  putStrLn \"read/write and a write (should fail)\"\n  h <- openFile file1 ReadWriteMode\n  tryIOError (openFile file1 WriteMode) >>= print\n  hClose h\n\n  putStrLn \"read and a read/write (should fail)\"\n  h <- openFile file1 ReadMode\n  tryIOError (openFile file1 ReadWriteMode) >>= print\n  hClose h\n\n  putStrLn \"write and a read (should fail)\"\n  h <- openFile file1 WriteMode\n  tryIOError (openFile file1 ReadMode) >>= print\n  hClose h\n\n  putStrLn \"two writes, different files (silly, but should succeed)\"\n  h1 <- openFile file1 WriteMode\n  h2 <- openFile file2 WriteMode\n  hClose h1\n  hClose h2\n\n  putStrLn \"two reads, should succeed\"\n  h1 <- openFile file1 ReadMode\n  h2 <- openFile file1 ReadMode\n  hClose h1\n  hClose h2\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! opening a file in WriteMode better truncate it\n\nimport System.IO\n\nmain = do\n  h <- openFile \"openFile006.out\" AppendMode\n  hPutStr h \"hello, world\"\n  size <- hFileSize h\n  print size\n  hClose h\n \n  h <- openFile \"openFile006.out\" WriteMode\n  size <- hFileSize h\n  print size\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! check that we don't truncate files if the open fails\n\nimport Control.Monad\nimport System.IO\nimport System.IO.Error\n\ntmp = \"openFile007.out\"\n\nmain = do\n  h <- openFile tmp WriteMode\n  hPutStrLn h \"hello, world\"\n\n  -- second open in write mode better fail, but better not truncate the file\n  tryIOError (openFile tmp WriteMode) >>= print\n  \n  hClose h\n  s <- readFile tmp -- make sure our \"hello, world\" is still there\n  putStr s\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport System.Cmd\nimport System.FilePath\nimport Text.Printf\nimport System.Directory\nimport Control.Monad\n\ntestdir = \"openFile008_testdir\"\n\n-- Test repeated opening/closing of 1000 files.  This is useful for guaging\n-- the performance of open/close and file locking.\nmain = do\n  system (\"rm -rf \" ++ testdir)\n  createDirectory testdir\n  let filenames = [testdir </> printf \"file%03d\" (n::Int) | n <- [1..1000]]\n\n  forM_ [1..50] $ \\_ -> do\n    hs <- mapM (\\f -> openFile f WriteMode) filenames\n    mapM_ hClose hs\n\n  mapM_ removeFile filenames\n  removeDirectory testdir\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport System.IO\nimport Control.Exception\nimport System.Directory\n\nmain = bracket \n          (openTempFile \".\" \"test.txt\")\n          (\\(f,_) -> removeFile f)\n          (\\(f,h) -> do hPutStrLn h $ \"\\xa9\" -- Copyright symbol\n                        hClose h\n                        s <- readFile f\n                        if (s /= \"\\xa9\\n\") then error (\"failed: \" ++ s) else return ())\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing output on stdout\n\n-- stdout is buffered, so test if its buffer\n-- is flushed upon program termination.\n\nmain = putStr \"Hello, world\\n\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! readFile test\n\nimport System.IO\nimport System.IO.Error\n\nsource   = \"readFile001.hs\"\nfilename = \"readFile001.out\"\n\nmain = do\n  s <- readFile source\n  h <- openFile filename WriteMode\n  hPutStrLn h s\n  hClose h\n  s <- readFile filename\n\n  -- This open should fail, because the readFile hasn't been forced\n  -- and the file is therefore still locked.\n  tryIOError (openFile filename WriteMode) >>= print\n\n  putStrLn s\n\n  -- should be able to open it for writing now, because we've forced the\n  -- whole file.\n  h <- openFile filename WriteMode\n\n  print h\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! RW files \n\nmodule Main(main) where\n\nimport System.IO\nimport System.Directory ( removeFile, doesFileExist )\nimport Control.Monad\n\nmain = do\n  f <- doesFileExist \"readwrite001.inout\" \n  when f (removeFile \"readwrite001.inout\")\n  hdl <- openFile \"readwrite001.inout\" ReadWriteMode\n  hSetBuffering hdl LineBuffering\n  hPutStr hdl \"as\"\n  hSeek hdl AbsoluteSeek 0\n  ch <- hGetChar hdl\n  print ch\n  hPutStr hdl \"ase\"\n  hSeek hdl AbsoluteSeek 0\n  putChar '\\n'\n  ls <- hGetContents hdl\n  putStrLn ls\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing RW handles\n\nimport System.IO\nimport System.IO.Error\nimport System.Directory (removeFile, doesFileExist)\nimport Control.Monad\nimport System.Cmd\n\n-- This test is weird, full marks to whoever dreamt it up!\n\nmain :: IO ()\nmain = do\n   let username = \"readwrite002.inout\"\n   f <- doesFileExist username\n   when f (removeFile username)\n   cd <- openFile username ReadWriteMode\n\n   -- binary mode needed, otherwise newline translation gives\n   -- unpredictable results.\n   hSetBinaryMode cd True\n\n-- Leva buffering on to make things more interesting:\n--   hSetBuffering stdin NoBuffering\n--   hSetBuffering stdout NoBuffering\n--   hSetBuffering cd NoBuffering\n   hPutStr cd speakString\n   hSeek cd AbsoluteSeek 0\n   speak cd  `catchIOError` \\ err -> if isEOFError err then putStrLn \"\\nCaught EOF\" else ioError err\n   hSeek cd AbsoluteSeek 0\n   hSetBuffering cd LineBuffering\n   speak cd  `catchIOError` \\ err -> if isEOFError err then putStrLn \"\\nCaught EOF\" else ioError err\n   return ()\n   hSeek cd AbsoluteSeek 0\n   hSetBuffering cd (BlockBuffering Nothing)\n   speak cd  `catchIOError` \\ err -> if isEOFError err then putStrLn \"\\nCaught EOF\" else ioError err\n\nspeakString = \"##############################\\n\"\n\nspeak cd = do\n     (do\n        ready <- hReady cd\n        if ready then\n           hGetChar cd >>= putChar\n         else\n           return ()\n        ready <- hReady stdin\n        if ready then (do { ch <- getChar; hPutChar cd ch})\n         else return ())\n     speak cd\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\n\nfile = \"readwrite003.txt\"\n\nmain = do\n  writeFile file \"ab\\ncd\\nef\\ngh\"\n  h <- openFile file ReadWriteMode\n  hGetLine h\n  hPutStrLn h \"yz\"\n  hClose h\n  h <- openBinaryFile file ReadMode\n  hSetNewlineMode stdout noNewlineTranslation\n  hGetContents h >>= putStr\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nBefore running this, check that /tmp/test does not exist and\ncontain something important. Then do:\n\n $ touch /tmp/test\n\nIf you do:\n\n $ runhaskell Test.hs\n\nit will work. If you do:\n\n $ runhaskell Test.hs fail\n\nit will fail every time with:\n\nTest.hs: writeFile: /tmp/test: openFile: resource busy (file is locked)\n\n-}\n\nimport Control.Monad\nimport System.Directory\nimport System.IO\nimport System.IO.Error\nimport System.Environment\n-- Used by test2:\n-- import System.Posix.IO\n\nfp = \"T2122-test\"\n\nmain :: IO ()\nmain = do\n   writeFile fp \"test\"\n   test True\n\n-- fails everytime when causeFailure is True in GHCi, with runhaskell,\n-- or when compiled.\ntest :: Bool -> IO ()\ntest causeFailure =\n    do h1 <- openFile fp ReadMode `catchIOError` (\\e -> error (\"openFile 1: \" ++ show e))\n       when causeFailure $ do\n         h2 <- openFile fp ReadMode `catchIOError` (\\e -> error (\"openFile 2: \" ++ show e))\n         hClose h2\n       hClose h1\n       removeFile fp\n       writeFile fp (show [1..100]) `catchIOError` (\\e -> error (\"writeFile: \" ++ show e))\n\n{-\n-- this version never fails (except in GHCi, if test has previously failed).\n-- probably because openFd does not try to lock the file\ntest2 :: Bool -> IO ()\ntest2 causeFailure =\n    do fd1 <- openFd fp ReadOnly defaultFileFlags `catchIOError` (\\e -> error (\"openFile 1: \" ++ show e))\n       when causeFailure $ do\n         fd2 <- openFd fp ReadOnly defaultFileFlags `catchIOError` (\\e -> error (\"openFile 2: \" ++ show e))\n         closeFd fd2\n       closeFd fd1\n       removeFile fp\n       writeFile fp (show [1..100]) `catchIOError` (\\e -> error (\"writeFile: \" ++ show e))\n-}\n\n{-\n-- fails sometimes when run repeated in GHCi, but seems fine with\n-- runhaskell or compiled\ntest3 :: IO ()\ntest3 =\n    do h1 <- openFile fp ReadMode `catchIOError` (\\e -> error (\"openFile 1: \" ++ show e))\n       h2 <- openFile fp ReadMode `catchIOError` (\\e -> error (\"openFile 2: \" ++ show e))\n       removeFile fp\n       writeFile fp (show [1..100]) `catchIOError` (\\e -> error (\"writeFile: \" ++ show e))\n       print =<< hGetContents h1\n       print =<< hGetContents h2\n       hClose h2\n       hClose h1\n-}\n\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}\nmodule Main (main) where\n\nimport Control.Applicative\nimport Control.Concurrent.MVar\nimport Control.Monad\n\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.Char8\nimport Data.ByteString.Char8()\nimport Data.ByteString.Unsafe as B\nimport Data.ByteString.Internal (memcpy)\nimport Data.Typeable (Typeable)\nimport Data.Word\n\nimport Foreign\n\nimport GHC.IO.Buffer\nimport GHC.IO.BufferedIO\nimport GHC.IO.Device\nimport GHC.IO.Handle\n\nimport System.IO\n\n-- | Create a seakable read-handle from a bytestring\nbsHandle :: ByteString -> FilePath -> IO Handle\nbsHandle bs fp\n    = newBsDevice bs >>= \\dev ->\n      mkFileHandle dev fp ReadMode Nothing noNewlineTranslation\n\ndata BSIODevice\n    = BSIODevice\n       ByteString\n       (MVar Int) -- Position\n\nnewBsDevice :: ByteString -> IO BSIODevice\nnewBsDevice bs = BSIODevice bs <$> newMVar 0\n\nremaining :: BSIODevice -> IO Int\nremaining (BSIODevice bs mPos)\n    = do\n  let bsLen = B.length bs\n  withMVar mPos $ \\pos -> return (bsLen - pos)\n\nsizeBS :: BSIODevice -> Int\nsizeBS (BSIODevice bs _) = B.length bs\n\nseekBS :: BSIODevice -> SeekMode -> Int -> IO ()\nseekBS dev AbsoluteSeek pos\n    | pos < 0 = error \"Cannot seek to a negative position!\"\n    | pos > sizeBS dev = error \"Cannot seek past end of handle!\"\n    | otherwise = case dev of\n                    BSIODevice _ mPos\n                        -> modifyMVar_ mPos $ \\_ -> return pos\nseekBS dev SeekFromEnd pos = seekBS dev AbsoluteSeek (sizeBS dev - pos)\nseekBS dev RelativeSeek pos\n    = case dev of\n        BSIODevice _bs mPos\n            -> modifyMVar_ mPos $ \\curPos ->\n               let newPos = curPos + pos\n               in if newPos < 0 || newPos > sizeBS dev\n                  then error \"Cannot seek outside of handle!\"\n                  else return newPos\n\ntellBS :: BSIODevice -> IO Int\ntellBS (BSIODevice _ mPos) = readMVar mPos\n\ndupBS :: BSIODevice -> IO BSIODevice\ndupBS (BSIODevice bs mPos) = BSIODevice bs <$> (readMVar mPos >>= newMVar)\n\nreadBS :: BSIODevice -> Ptr Word8 -> Int -> IO Int\nreadBS dev@(BSIODevice bs mPos) buff amount\n    = do\n  rem <- remaining dev\n  if amount > rem\n   then readBS dev buff rem\n   else B.unsafeUseAsCString bs $ \\ptr ->\n       do\n         memcpy buff (castPtr ptr) (fromIntegral amount)\n         modifyMVar_ mPos (return . (+amount))\n         return amount\n\ninstance BufferedIO BSIODevice where\n    newBuffer dev buffState = newByteBuffer (sizeBS dev) buffState\n    fillReadBuffer dev buff = readBuf dev buff\n    fillReadBuffer0 dev buff\n        = do\n      (amount, buff') <- fillReadBuffer dev buff\n      return (if amount == 0 then Nothing else Just amount, buff')\n\ninstance RawIO BSIODevice where\n    read = readBS\n    readNonBlocking dev buff n = Just `liftM` readBS dev buff n\n\ninstance IODevice BSIODevice where\n    ready _ True _ = return False -- read only\n    ready _ False _ = return True -- always ready\n\n    close _ = return ()\n    isTerminal _ = return False\n    isSeekable _ = return True\n    seek dev seekMode pos = seekBS dev seekMode (fromIntegral pos)\n    tell dev = fromIntegral <$> tellBS dev\n    getSize dev = return $ fromIntegral $ sizeBS dev\n    setEcho _ _ = error \"Not a terminal device\"\n    getEcho _ = error \"Not a terminal device\"\n    setRaw _ _ = error \"Raw mode not supported\"\n    devType _ = return RegularFile\n    dup = dupBS\n    dup2 _ _ = error \"Dup2 not supported\"\n\n\nmain = bsHandle \"test\" \"<fake file>\" >>= Data.ByteString.Char8.hGetContents >>= print\n", "num_lines": 115}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nimport GHC.IO.Handle\nimport GHC.IO.FD as FD\n\nmain = do\n  writeFile \"T4808.test\" \"This is some test data\"\n  (fd, _) <- FD.openFile \"T4808.test\" ReadWriteMode False\n  hdl <- mkDuplexHandle fd \"T4808.test\" Nothing nativeNewlineMode\n  hClose hdl\n  (fd2, _) <- FD.openFile \"T4808.test\" ReadWriteMode False\n  print (fdFD fd == fdFD fd2) -- should be True\n  hGetLine hdl >>= print -- should fail with an exception\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Debug.Trace\n\nmain = trace \"\u00e6\u02c6\u2018\u00e7\u02c6\u00b1\u00e6\u02c6\u2018\u00e7\u0161\u201e\u00e7\u201d\u00b5\u00e8\u201e\u2018\" $ return ()", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport Foreign.Marshal.Alloc\nimport System.IO\n\nmain = do\n  h <- openBinaryFile \"T4895.hs\" ReadMode\n  allocaBytes 10 $ \\ptr -> hGetBuf h ptr 10\n  some <- allocaBytes 10 $ \\ptr -> hGetBufSome h ptr 10\n  print some\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified Data.ByteString as BS\nimport System.IO\nimport GHC.Foreign\nimport Control.Exception\nimport Data.Word\n\ndecode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)\ndecode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc\n\nmain :: IO ()\nmain = mapM_ go [ [\"01111111\"] -- (just fits into 1 byte)\n                , [\"11000010\", \"10000000\"] -- (just large enough for 2 bytes)\n                , [\"11000001\", \"10111111\"] -- (overlong: only 7 bits, so should fit into 1 byte)\n                , [\"11011111\", \"10111111\"] -- (just fits into 2 bytes)\n                , [\"11100000\", \"10100000\", \"10000000\"] -- (just large enough for 3 bytes)\n                , [\"11100000\", \"10011111\", \"10111111\"] -- (overlong: only 11 bits, so should fit into 2 bytes)\n                , [\"11101111\", \"10111111\", \"10111111\"] -- (just fits into 3 bytes)\n                , [\"11110000\", \"10010000\", \"10000000\", \"10000000\"] -- (just large enough for 4 bytes)\n                , [\"11110000\", \"10001111\", \"10111111\", \"10111111\"] -- (overlong: only 16 bits, so should fit into 3 bytes)\n                , [\"11110100\", \"10001111\", \"10111111\", \"10111111\"] -- (largest allowed codepoint)\n                , [\"11110111\", \"10111111\", \"10111111\", \"10111111\"] -- (just fits into 4 bytes but disallowed by RFC3629)\n                ]\n  where go xs = decode utf8 (BS.pack (map toByte xs)) >>= either (\\_ -> putStrLn \"Error\") print\n\ntoByte :: String -> Word8\ntoByte [] = 0\ntoByte ('1':xs) = (2 ^ length xs) + toByte xs\ntoByte ('0':xs) = toByte xs\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\nimport Numeric\nimport Data.Ratio\n\nmain = print ((fromRat (132874 % 23849))::Double)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Testing showInt, lightly.\n\nmodule Main(main) where\n\nimport Numeric\n\nshowSignedInt :: Integral a => a -> String\nshowSignedInt x = showSigned (showInt) 0 x \"\"\n\nmain =\n  do\n   putStrLn (showInt (343023920121::Integer) [])\n   putStrLn (showInt (3430239::Int) [])\n   putStrLn (showInt (1212 :: Int) [])\n   putStrLn (showSignedInt (591125662431 `div` (517::Int)))\n   -- showInt just works over naturals, wrap it up inside\n   -- a use of Numeric.showSigned to show negative nums.\n   putStrLn (showSignedInt (-111::Int))\n   putStrLn (showInt (232189458241::Integer) [])\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Testing readInt, lightly.\n--\nmodule Main(main) where\n\nimport Numeric\nimport Data.Char\n\nmain =\n  let\n   rd :: ReadS Integer\n   rd = readSigned (readInt 10 (isDigit) (digitToInt))\n  in\n  do\n   print (rd (show (343023920121::Integer)))\n   print (rd (show (3430239::Int)))\n   print (rd (show (1212 :: Int)))\n   print (rd (show (591125662431 `div` (517::Int))))\n   print (rd (show (-111::Int)))\n   print (rd (show (232189458241::Integer)))\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Exercising Numeric.readSigned a bit\n--\nmodule Main(main) where\n\nimport Numeric\nimport Data.Char\n\nmain =\n  let\n   rd :: ReadS Integer\n   rd = readSigned (readInt 10 (isDigit) (digitToInt))\n  in\n  do\n   print (rd (show (343023920121::Integer)))\n   print (rd (show (3430239::Int)))\n   print (rd (show (-0 :: Int)))\n   print (rd (show (591125662431 `div` (517::Int))))\n   print (rd (show (-111::Int)))\n   print (rd (show (232189458241::Integer)))\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Exercising Numeric.readSigned a bit\n--\nmodule Main(main) where\n\nimport Numeric\n\nmain =\n  let\n   ls = [\"3489348394032498320438240938403\",\"0\",\"-1\",\"1\",\"34323\",\"2L\",\"012\",\"0x23\",\"3243ab\"]\n   present str f ls =\n    sequence (map (\\ v -> putStr ('\\n':str ++\n                                  ' ': v   ++\n                                  \" = \"    ++\n                                  (show (f v)))) ls)\n  in\n  do\n   present \"(readDec::ReadS Integer)\" (readDec::ReadS Integer) ls\n   present \"(readDec::ReadS Int)\"     (readDec::ReadS Int) ls\n   present \"(readOct::ReadS Integer)\" (readOct::ReadS Integer) ls\n   present \"(readOct::ReadS Int)\"     (readOct::ReadS Int) ls\n   present \"(readHex::ReadS Integer)\" (readHex::ReadS Integer) ls\n   present \"(readHex::ReadS Int)\"     (readHex::ReadS Int) ls\n   putStrLn \"\"\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Exercising the showing of positive numbers at various bases.\n--\nmodule Main(main) where\n\nimport Numeric\nimport Data.Char\n\n--showDec :: Integral a => a -> ShowS\nshowDec = showInt\n\n{-\n--showBinary :: Integral a => a -> ShowS\nshowBinary n r =\n showString \"0b\" $\n showIntAtBase 2 (toChr) n r\n where toChr d = chr (ord '0' + fromIntegral d)\n-}\n\nmain =\n do\n  print (map (\\ x -> showOct x []) [1..32])\n  print (map (\\ x -> showDec x []) [1..32])\n  print (map (\\ x -> showHex x []) [1..32])\n--  print (map (\\ x -> showBinary x []) [1..32])\n  putStrLn (showOct (241324784::Int) [])\n  putStrLn (showDec (241324784::Int) [])\n  putStrLn (showHex (241324784::Int) [])\n---  putStrLn (showBinary (241324784::Int) [])\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Exercising the reading of positive numbers at various bases.\n--\nmodule Main(main) where\n\nimport Numeric\n\nmain =\n do\n  putStrLn (show (readOct \"00000111\"))\n  putStrLn (show (readDec \"00000111\"))\n  putStrLn (show (readHex \"00000111\"))\n  putStrLn (show (readOct \"-24\"))\n  putStrLn (show (readDec \"-24\"))\n  putStrLn (show (readHex \"-24\"))\n  putStrLn (show ((readOct ::ReadS Integer) \"3248784372843778438743\"))\n  putStrLn (show ((readDec ::ReadS Integer) \"3248784372843778438743\"))\n  putStrLn (show ((readHex ::ReadS Integer) \"3248784372843778438743\"))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- showing/reading floats\n--\nmodule Main(main) where\n\nimport Numeric\n\nmain = do\n  let dbls   =  map (shEFloat (Just 7)) doubles\n             ++ map (shEFloat (Just 0)) doubles\n             ++ map (shEFloat Nothing)  doubles\n             ++ map (shFFloat (Just 7)) doubles\n             ++ map (shFFloat (Just 0)) doubles\n             ++ map (shFFloat Nothing)  doubles\n             ++ map (shGFloat (Just 7)) doubles\n             ++ map (shGFloat (Just 0)) doubles\n             ++ map (shGFloat Nothing)  doubles\n\n      flts   =  map (shEFloat (Just 7)) floats\n             ++ map (shEFloat (Just 0)) floats\n             ++ map (shEFloat Nothing)  floats\n             ++ map (shFFloat (Just 7)) floats\n             ++ map (shFFloat (Just 0)) floats\n             ++ map (shFFloat Nothing)  floats\n             ++ map (shGFloat (Just 7)) floats\n             ++ map (shGFloat (Just 0)) floats\n             ++ map (shGFloat Nothing)  floats\n\n  putStrLn (unlines dbls)\n  putStrLn (unlines flts)\n  print (map read dbls :: [Double])\n  print (map read flts :: [Double])\n\nshEFloat p f = showEFloat p f \"\"\nshFFloat p f = showFFloat p f \"\"\nshGFloat p f = showGFloat p f \"\"\n\ndoubles :: [ Double ]\ndoubles = [ 0.0\n          , 420\n          ,  42\n          ,   4.2\n          ,   0.42\n          ,   0.042\n          , 1.82173691287639817263897126389712638972163\n          , 1.82173691287639817263897126389712638972163e-300\n          ]\n\nfloats :: [ Float ]\nfloats = [ 0.0\n          , 420\n          ,  42\n          ,   4.2\n          ,   0.42\n          ,   0.042\n          , 1.82173691287639817263897126389712638972163\n          , 1.82173691287639817263897126389712638972163e-300\n          ]\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- trac #2059\n--\n-- Note that this test fails miserably when compiled to use X87 floating point.\n-- For instance, in the case of (sin 1e20) the X86 FSIN instruction doesn't even\n-- get the sign right on my machine.\n\nmodule Main(main) where\n\nimport Control.Monad\nimport Foreign.C\n\nmain = do let d = [0, pi, pi/2, pi/3, 1e10, 1e20] :: [Double]\n              f = [0, pi, pi/2, pi/3, 1e10, 1e20] :: [Float]\n          mapM_ (test \"sind\" sind sin) d\n          mapM_ (test \"sinf\" sinf sin) f\n          mapM_ (test \"cosd\" cosd cos) d\n          mapM_ (test \"cosf\" cosf cos) f\n          mapM_ (test \"tand\" tand tan) d\n          mapM_ (test \"tanf\" tanf tan) f\n          -- added to test #13629\n          mapM_ (test \"sqrtd\" sqrtd sqrt) f\n          mapM_ (test \"sqrtf\" sqrtf sqrt) f\n          putStrLn \"Done\"\n\ntest :: (RealFloat a, Floating a, RealFloat b, Floating b, Show b)\n     => String -> (a -> a) -> (b -> b) -> b -> IO ()\ntest s f g x = do let y = realToFrac (f (realToFrac x))\n                      z = g x\n                  unless (y == z) $ do\n                      putStrLn (\"uh oh! \" ++ s ++ ' ':show x)\n                      print y\n                      print z\n                      print $ decodeFloat y\n                      print $ decodeFloat z\n\nforeign import ccall \"math.h sin\"  sind :: CDouble -> CDouble\nforeign import ccall \"math.h sinf\" sinf :: CFloat  -> CFloat\n\nforeign import ccall \"math.h cos\"  cosd :: CDouble -> CDouble\nforeign import ccall \"math.h cosf\" cosf :: CFloat  -> CFloat\n\nforeign import ccall \"math.h tan\"  tand :: CDouble -> CDouble\nforeign import ccall \"math.h tanf\" tanf :: CFloat  -> CFloat\n\nforeign import ccall \"math.h sqrt\"  sqrtd :: CDouble -> CDouble\nforeign import ccall \"math.h sqrtf\" sqrtf :: CFloat  -> CFloat\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main(main) where\n\nmain = sequence_ [ f x y | x <- [0,\n                                 1000,\n                                 1000000000000,              -- > 2^32\n                                 1000000000000000000000000,  -- > 2^64\n                                 -1000,\n                                 -1000000000000,             -- < -2^32\n                                 -1000000000000000000000000] -- < -2^64\n                         , y <- [0, -10, 10] ]\n\nf :: Integer -> Int -> IO ()\nf x y = do putStrLn \"------------------------\"\n           print x\n           print y\n           let d :: Double\n               d = encodeFloat x y\n               (xd, yd) = decodeFloat d\n           let f :: Float\n               f = encodeFloat x y\n               (xf, yf) = decodeFloat f\n           print d\n           print xd\n           print yd\n           print f\n           print xf\n           print yf\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = do\n    print (sqrt (-7 :: Double))\n    print (sqrt (-7 :: Float))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Exit (exitWith, ExitCode(..))\n\nmain = exitWith (ExitFailure 42)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment (getProgName, getArgs)\n\nmain = do argv0 <- getProgName\n          putStr argv0\n          argv <- getArgs\n          mapM_ (\\ x -> putChar ' ' >> putStr x) argv\n          putChar '\\n'\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport System.Environment (getEnv)\nimport System.IO.Error (catchIOError, isDoesNotExistError)\n\nmain :: IO ()\nmain = do\n    term <- getEnv \"PATH\"\n    putStrLn \"Got $PATH\"\n    fish <- getEnv \"One fish, two fish, red fish, blue fish\" `catchIOError` getEnv_except\n    putStrLn fish\n\ngetEnv_except :: IOError -> IO String\ngetEnv_except ioe\n | isDoesNotExistError ioe = return \"\"\n | otherwise               = ioError ioe\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Not run on mingw, because of /dev/null use\n\nimport System.Cmd (system)\nimport System.Exit (ExitCode(..), exitWith)\n\nmain = do ec <- system \"cat dog 1>/dev/null 2>&1\"\n          case ec of\n              ExitSuccess ->\n                  do putStr \"What?!?\\n\"\n                     ioError (userError \"dog succeeded\")\n              ExitFailure _ ->\n                  do ec <- system \"cat system001.hs 2>/dev/null\"\n                     case ec of\n                         ExitSuccess ->\n                             exitWith ExitSuccess\n                         ExitFailure _ ->\n                             do putStr \"What?!?\\n\"\n                                ioError (userError \"cat failed\")\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad (when)\nimport Data.Maybe (isJust)\nimport System.Environment (lookupEnv)\n\nmain :: IO ()\nmain = do\n    term <- lookupEnv \"PATH\"\n    when (isJust term) $ putStrLn \"Got PATH\"\n    fish <- lookupEnv \"One fish, two fish, red fish, blue fish\"\n    print fish\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for escaping Timeout exceptions, see #7719\n\nimport System.Timeout\nimport Control.Monad\nimport Control.Concurrent\n\nt d = timeout d $ timeout d $ timeout d $ timeout d $ timeout d $ timeout (10^9) $ threadDelay 100\n\nmain = forM_ [1..20] $ \\_ -> forM_ [1..40] t\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Text.Printf\n\nmain = do\n   printf \"%.*f\\n\" (2::Int) ((1/3) :: Double)\n   -- (expected: \"0.33\")\n\n   printf \"%.3s\\n\" \"foobar\"\n   -- (expected: \"foo\")\n\n   printf \"%10.5d\\n\" (4::Int)\n   -- (expected: \"     00004\")\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE GADTs #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Text.Printf\n-- Copyright   :  (c) Lennart Augustsson and Bart Massey 2013\n-- License     :  BSD-style (see the file LICENSE in this distribution)\n--\n-- Maintainer  :  Bart Massey <bart@cs.pdx.edu>\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A C @printf(3)@-like formatter. This version has been\n-- extended by Bart Massey as per the recommendations of\n-- John Meacham and Simon Marlow\n-- <http://comments.gmane.org/gmane.comp.lang.haskell.libraries/4726>\n-- to support extensible formatting for new datatypes.  It\n-- has also been extended to support almost all C\n-- @printf(3)@ syntax.\n-----------------------------------------------------------------------------\n\nmodule Text.Printf(\n-- * Printing Functions\n   printf, hPrintf,\n-- * Extending To New Types\n--\n-- | This 'printf' can be extended to format types\n-- other than those provided for by default. This\n-- is done by instantiating 'PrintfArg' and providing\n-- a 'formatArg' for the type. It is possible to\n-- provide a 'parseFormat' to process type-specific\n-- modifiers, but the default instance is usually\n-- the best choice.\n--\n-- For example:\n--\n-- > instance PrintfArg () where\n-- >   formatArg x fmt | fmtChar (vFmt 'U' fmt) == 'U' =\n-- >     formatString \"()\" (fmt { fmtChar = 's', fmtPrecision = Nothing })\n-- >   formatArg _ fmt = errorBadFormat $ fmtChar fmt\n-- >\n-- > main :: IO ()\n-- > main = printf \"[%-3.1U]\\n\" ()\n--\n-- prints \\\"@[() ]@\\\". Note the use of 'formatString' to\n-- take care of field formatting specifications in a convenient\n-- way.\n   PrintfArg(..),\n   FieldFormatter,\n   FieldFormat(..),\n   FormatAdjustment(..), FormatSign(..),\n   vFmt,\n-- ** Handling Type-specific Modifiers\n--\n-- | In the unlikely case that modifier characters of\n-- some kind are desirable for a user-provided type,\n-- a 'ModifierParser' can be provided to process these\n-- characters. The resulting modifiers will appear in\n-- the 'FieldFormat' for use by the type-specific formatter.\n   ModifierParser, FormatParse(..),\n-- ** Standard Formatters\n--\n-- | These formatters for standard types are provided for\n-- convenience in writting new type-specific formatters:\n-- a common pattern is to throw to 'formatString' or\n-- 'formatInteger' to do most of the format handling for\n-- a new type.\n   formatString, formatChar, formatInt,\n   formatInteger, formatRealFloat,\n-- ** Raising Errors\n--\n-- | These functions are used internally to raise various\n-- errors, and are exported for use by new type-specific\n-- formatters.\n  errorBadFormat, errorShortFormat, errorMissingArgument,\n  errorBadArgument,\n  perror,\n-- * Implementation Internals\n-- | These types are needed for implementing processing\n-- variable numbers of arguments to 'printf' and 'hPrintf'.\n-- Their implementation is intentionally not visible from\n-- this module. If you attempt to pass an argument of a type\n-- which is not an instance of the appropriate class to\n-- 'printf' or 'hPrintf', then the compiler will report it\n-- as a missing instance of 'PrintfArg'.  (All 'PrintfArg'\n-- instances are 'PrintfType' instances.)\n  PrintfType, HPrintfType,\n-- | This class is needed as a Haskell98 compatibility\n-- workaround for the lack of FlexibleInstances.\n  IsChar(..)\n) where\n\nimport Data.Char\nimport Data.Int\nimport Data.List\nimport Data.Word\nimport Numeric\nimport Numeric.Natural\nimport System.IO\n\n-------------------\n\n-- | Format a variable number of arguments with the C-style formatting string.\n--\n-- >>> printf \"%s, %d, %.4f\" \"hello\" 123 pi\n-- hello, 123, 3.1416\n--\n-- The return value is either 'String' or @('IO' a)@ (which\n-- should be @('IO' ())@, but Haskell's type system\n-- makes this hard).\n--\n-- The format string consists of ordinary characters and\n-- /conversion specifications/, which specify how to format\n-- one of the arguments to 'printf' in the output string. A\n-- format specification is introduced by the @%@ character;\n-- this character can be self-escaped into the format string\n-- using @%%@. A format specification ends with a\n-- /format character/ that provides the primary information about\n-- how to format the value. The rest of the conversion\n-- specification is optional.  In order, one may have flag\n-- characters, a width specifier, a precision specifier, and\n-- type-specific modifier characters.\n--\n-- Unlike C @printf(3)@, the formatting of this 'printf'\n-- is driven by the argument type; formatting is type specific. The\n-- types formatted by 'printf' \\\"out of the box\\\" are:\n--\n--   * 'Integral' types, including 'Char'\n--\n--   * 'String'\n--\n--   * 'RealFloat' types\n--\n-- 'printf' is also extensible to support other types: see below.\n--\n-- A conversion specification begins with the\n-- character @%@, followed by zero or more of the following flags:\n--\n-- > -      left adjust (default is right adjust)\n-- > +      always use a sign (+ or -) for signed conversions\n-- > space  leading space for positive numbers in signed conversions\n-- > 0      pad with zeros rather than spaces\n-- > #      use an \\\"alternate form\\\": see below\n--\n-- When both flags are given, @-@ overrides @0@ and @+@ overrides space.\n-- A negative width specifier in a @*@ conversion is treated as\n-- positive but implies the left adjust flag.\n--\n-- The \\\"alternate form\\\" for unsigned radix conversions is\n-- as in C @printf(3)@:\n--\n-- > %o           prefix with a leading 0 if needed\n-- > %x           prefix with a leading 0x if nonzero\n-- > %X           prefix with a leading 0X if nonzero\n-- > %b           prefix with a leading 0b if nonzero\n-- > %[eEfFgG]    ensure that the number contains a decimal point\n--\n-- Any flags are followed optionally by a field width:\n--\n-- > num    field width\n-- > *      as num, but taken from argument list\n--\n-- The field width is a minimum, not a maximum: it will be\n-- expanded as needed to avoid mutilating a value.\n--\n-- Any field width is followed optionally by a precision:\n--\n-- > .num   precision\n-- > .      same as .0\n-- > .*     as num, but taken from argument list\n--\n-- Negative precision is taken as 0. The meaning of the\n-- precision depends on the conversion type.\n--\n-- > Integral    minimum number of digits to show\n-- > RealFloat   number of digits after the decimal point\n-- > String      maximum number of characters\n--\n-- The precision for Integral types is accomplished by zero-padding.\n-- If both precision and zero-pad are given for an Integral field,\n-- the zero-pad is ignored.\n--\n-- Any precision is followed optionally for Integral types\n-- by a width modifier; the only use of this modifier being\n-- to set the implicit size of the operand for conversion of\n-- a negative operand to unsigned:\n--\n-- > hh     Int8\n-- > h      Int16\n-- > l      Int32\n-- > ll     Int64\n-- > L      Int64\n--\n-- The specification ends with a format character:\n--\n-- > c      character               Integral\n-- > d      decimal                 Integral\n-- > o      octal                   Integral\n-- > x      hexadecimal             Integral\n-- > X      hexadecimal             Integral\n-- > b      binary                  Integral\n-- > u      unsigned decimal        Integral\n-- > f      floating point          RealFloat\n-- > F      floating point          RealFloat\n-- > g      general format float    RealFloat\n-- > G      general format float    RealFloat\n-- > e      exponent format float   RealFloat\n-- > E      exponent format float   RealFloat\n-- > s      string                  String\n-- > v      default format          any type\n--\n-- The \\\"%v\\\" specifier is provided for all built-in types,\n-- and should be provided for user-defined type formatters\n-- as well. It picks a \\\"best\\\" representation for the given\n-- type. For the built-in types the \\\"%v\\\" specifier is\n-- converted as follows:\n--\n-- > c      Char\n-- > u      other unsigned Integral\n-- > d      other signed Integral\n-- > g      RealFloat\n-- > s      String\n--\n-- Mismatch between the argument types and the format\n-- string, as well as any other syntactic or semantic errors\n-- in the format string, will cause an exception to be\n-- thrown at runtime.\n--\n-- Note that the formatting for 'RealFloat' types is\n-- currently a bit different from that of C @printf(3)@,\n-- conforming instead to 'Numeric.showEFloat',\n-- 'Numeric.showFFloat' and 'Numeric.showGFloat' (and their\n-- alternate versions 'Numeric.showFFloatAlt' and\n-- 'Numeric.showGFloatAlt'). This is hard to fix: the fixed\n-- versions would format in a backward-incompatible way.\n-- In any case the Haskell behavior is generally more\n-- sensible than the C behavior.  A brief summary of some\n-- key differences:\n--\n-- * Haskell 'printf' never uses the default \\\"6-digit\\\" precision\n--   used by C printf.\n--\n-- * Haskell 'printf' treats the \\\"precision\\\" specifier as\n--   indicating the number of digits after the decimal point.\n--\n-- * Haskell 'printf' prints the exponent of e-format\n--   numbers without a gratuitous plus sign, and with the\n--   minimum possible number of digits.\n--\n-- * Haskell 'printf' will place a zero after a decimal point when\n--   possible.\nprintf :: (PrintfType r) => String -> r\nprintf fmts = spr fmts []\n\n-- | Similar to 'printf', except that output is via the specified\n-- 'Handle'.  The return type is restricted to @('IO' a)@.\nhPrintf :: (HPrintfType r) => Handle -> String -> r\nhPrintf hdl fmts = hspr hdl fmts []\n\n-- |The 'PrintfType' class provides the variable argument magic for\n-- 'printf'.  Its implementation is intentionally not visible from\n-- this module. If you attempt to pass an argument of a type which\n-- is not an instance of this class to 'printf' or 'hPrintf', then\n-- the compiler will report it as a missing instance of 'PrintfArg'.\nclass PrintfType t where\n    spr :: String -> [UPrintf] -> t\n\n-- | The 'HPrintfType' class provides the variable argument magic for\n-- 'hPrintf'.  Its implementation is intentionally not visible from\n-- this module.\nclass HPrintfType t where\n    hspr :: Handle -> String -> [UPrintf] -> t\n\n{- not allowed in Haskell 2010\ninstance PrintfType String where\n    spr fmt args = uprintf fmt (reverse args)\n-}\n-- | @since 2.01\ninstance (IsChar c) => PrintfType [c] where\n    spr fmts args = map fromChar (uprintf fmts (reverse args))\n\n-- Note that this should really be (IO ()), but GHC's\n-- type system won't readily let us say that without\n-- bringing the GADTs. So we go conditional for these defs.\n\n-- | @since 4.7.0.0\ninstance (a ~ ()) => PrintfType (IO a) where\n    spr fmts args =\n        putStr $ map fromChar $ uprintf fmts $ reverse args\n\n-- | @since 4.7.0.0\ninstance (a ~ ()) => HPrintfType (IO a) where\n    hspr hdl fmts args = do\n        hPutStr hdl (uprintf fmts (reverse args))\n\n-- | @since 2.01\ninstance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where\n    spr fmts args = \\ a -> spr fmts\n                             ((parseFormat a, formatArg a) : args)\n\n-- | @since 2.01\ninstance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where\n    hspr hdl fmts args = \\ a -> hspr hdl fmts\n                                  ((parseFormat a, formatArg a) : args)\n\n-- | Typeclass of 'printf'-formattable values. The 'formatArg' method\n-- takes a value and a field format descriptor and either fails due\n-- to a bad descriptor or produces a 'ShowS' as the result. The\n-- default 'parseFormat' expects no modifiers: this is the normal\n-- case. Minimal instance: 'formatArg'.\nclass PrintfArg a where\n    -- | @since 4.7.0.0\n    formatArg :: a -> FieldFormatter\n    -- | @since 4.7.0.0\n    parseFormat :: a -> ModifierParser\n    parseFormat _ (c : cs) = FormatParse \"\" c cs\n    parseFormat _ \"\" = errorShortFormat\n\n-- | @since 2.01\ninstance PrintfArg Char where\n    formatArg = formatChar\n    parseFormat _ cf = parseIntFormat (undefined :: Int) cf\n\n-- | @since 2.01\ninstance (IsChar c) => PrintfArg [c] where\n    formatArg = formatString\n\n-- | @since 2.01\ninstance PrintfArg Int where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Int8 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Int16 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Int32 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Int64 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Word where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Word8 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Word16 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Word32 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Word64 where\n    formatArg = formatInt\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Integer where\n    formatArg = formatInteger\n    parseFormat = parseIntFormat\n\n-- | @since 4.8.0.0\ninstance PrintfArg Natural where\n    formatArg = formatInteger . toInteger\n    parseFormat = parseIntFormat\n\n-- | @since 2.01\ninstance PrintfArg Float where\n    formatArg = formatRealFloat\n\n-- | @since 2.01\ninstance PrintfArg Double where\n    formatArg = formatRealFloat\n\n-- | This class, with only the one instance, is used as\n-- a workaround for the fact that 'String', as a concrete\n-- type, is not allowable as a typeclass instance. 'IsChar'\n-- is exported for backward-compatibility.\nclass IsChar c where\n    -- | @since 4.7.0.0\n    toChar :: c -> Char\n    -- | @since 4.7.0.0\n    fromChar :: Char -> c\n\n-- | @since 2.01\ninstance IsChar Char where\n    toChar c = c\n    fromChar c = c\n\n-------------------\n\n-- | Whether to left-adjust or zero-pad a field. These are\n-- mutually exclusive, with 'LeftAdjust' taking precedence.\n--\n-- @since 4.7.0.0\ndata FormatAdjustment = LeftAdjust | ZeroPad\n\n-- | How to handle the sign of a numeric field.  These are\n-- mutually exclusive, with 'SignPlus' taking precedence.\n--\n-- @since 4.7.0.0\ndata FormatSign = SignPlus | SignSpace\n\n-- | Description of field formatting for 'formatArg'. See UNIX @printf(3)@\n-- for a description of how field formatting works.\n--\n-- @since 4.7.0.0\ndata FieldFormat = FieldFormat {\n  fmtWidth :: Maybe Int,       -- ^ Total width of the field.\n  fmtPrecision :: Maybe Int,   -- ^ Secondary field width specifier.\n  fmtAdjust :: Maybe FormatAdjustment,  -- ^ Kind of filling or padding\n                                        --   to be done.\n  fmtSign :: Maybe FormatSign, -- ^ Whether to insist on a\n                               -- plus sign for positive\n                               -- numbers.\n  fmtAlternate :: Bool,        -- ^ Indicates an \"alternate\n                               -- format\".  See @printf(3)@\n                               -- for the details, which\n                               -- vary by argument spec.\n  fmtModifiers :: String,      -- ^ Characters that appeared\n                               -- immediately to the left of\n                               -- 'fmtChar' in the format\n                               -- and were accepted by the\n                               -- type's 'parseFormat'.\n                               -- Normally the empty string.\n  fmtChar :: Char              -- ^ The format character\n                               -- 'printf' was invoked\n                               -- with. 'formatArg' should\n                               -- fail unless this character\n                               -- matches the type. It is\n                               -- normal to handle many\n                               -- different format\n                               -- characters for a single\n                               -- type.\n  }\n\n-- | The \\\"format parser\\\" walks over argument-type-specific\n-- modifier characters to find the primary format character.\n-- This is the type of its result.\n--\n-- @since 4.7.0.0\ndata FormatParse = FormatParse {\n  fpModifiers :: String,   -- ^ Any modifiers found.\n  fpChar :: Char,          -- ^ Primary format character.\n  fpRest :: String         -- ^ Rest of the format string.\n  }\n\n-- Contains the \"modifier letters\" that can precede an\n-- integer type.\nintModifierMap :: [(String, Integer)]\nintModifierMap = [\n  (\"hh\", toInteger (minBound :: Int8)),\n  (\"h\", toInteger (minBound :: Int16)),\n  (\"l\", toInteger (minBound :: Int32)),\n  (\"ll\", toInteger (minBound :: Int64)),\n  (\"L\", toInteger (minBound :: Int64)) ]\n\nparseIntFormat :: a -> String -> FormatParse\nparseIntFormat _ s =\n  case foldr matchPrefix Nothing intModifierMap of\n    Just m -> m\n    Nothing ->\n      case s of\n        c : cs -> FormatParse \"\" c cs\n        \"\" -> errorShortFormat\n  where\n    matchPrefix (p, _) m@(Just (FormatParse p0 _ _))\n      | length p0 >= length p = m\n      | otherwise = case getFormat p of\n          Nothing -> m\n          Just fp -> Just fp\n    matchPrefix (p, _) Nothing =\n      getFormat p\n    getFormat p =\n      stripPrefix p s >>= fp\n      where\n        fp (c : cs) = Just $ FormatParse p c cs\n        fp \"\" = errorShortFormat\n\n-- | This is the type of a field formatter reified over its\n-- argument.\n--\n-- @since 4.7.0.0\ntype FieldFormatter = FieldFormat -> ShowS\n\n-- | Type of a function that will parse modifier characters\n-- from the format string.\n--\n-- @since 4.7.0.0\ntype ModifierParser = String -> FormatParse\n\n-- | Substitute a \\'v\\' format character with the given\n-- default format character in the 'FieldFormat'. A\n-- convenience for user-implemented types, which should\n-- support \\\"%v\\\".\n--\n-- @since 4.7.0.0\nvFmt :: Char -> FieldFormat -> FieldFormat\nvFmt c ufmt@(FieldFormat {fmtChar = 'v'}) = ufmt {fmtChar = c}\nvFmt _ ufmt = ufmt\n\n-- | Formatter for 'Char' values.\n--\n-- @since 4.7.0.0\nformatChar :: Char -> FieldFormatter\nformatChar x ufmt =\n  formatIntegral (Just 0) (toInteger $ ord x) $ vFmt 'c' ufmt\n\n-- | Formatter for 'String' values.\n--\n-- @since 4.7.0.0\nformatString :: IsChar a => [a] -> FieldFormatter\nformatString x ufmt =\n  case fmtChar $ vFmt 's' ufmt of\n    's' -> map toChar . (adjust ufmt (\"\", ts) ++)\n           where\n             ts = map toChar $ trunc $ fmtPrecision ufmt\n               where\n                 trunc Nothing = x\n                 trunc (Just n) = take n x\n    c   -> errorBadFormat c\n\n-- Possibly apply the int modifiers to get a new\n-- int width for conversion.\nfixupMods :: FieldFormat -> Maybe Integer -> Maybe Integer\nfixupMods ufmt m =\n  let mods = fmtModifiers ufmt in\n  case mods of\n    \"\" -> m\n    _ -> case lookup mods intModifierMap of\n      Just m0 -> Just m0\n      Nothing -> perror \"unknown format modifier\"\n\n-- | Formatter for 'Int' values.\n--\n-- @since 4.7.0.0\nformatInt :: (Integral a, Bounded a) => a -> FieldFormatter\nformatInt x ufmt =\n  let lb = toInteger $ minBound `asTypeOf` x\n      m = fixupMods ufmt (Just lb)\n      ufmt' = case lb of\n        0 -> vFmt 'u' ufmt\n        _ -> ufmt\n  in\n  formatIntegral m (toInteger x) ufmt'\n\n-- | Formatter for 'Integer' values.\n--\n-- @since 4.7.0.0\nformatInteger :: Integer -> FieldFormatter\nformatInteger x ufmt =\n  let m = fixupMods ufmt Nothing in\n  formatIntegral m x ufmt\n\n-- All formatting for integral types is handled\n-- consistently.  The only difference is between Integer and\n-- bounded types; this difference is handled by the 'm'\n-- argument containing the lower bound.\nformatIntegral :: Maybe Integer -> Integer -> FieldFormatter\nformatIntegral m x ufmt0 =\n  let prec = fmtPrecision ufmt0 in\n  case fmtChar ufmt of\n    'd' -> (adjustSigned ufmt (fmti prec x) ++)\n    'i' -> (adjustSigned ufmt (fmti prec x) ++)\n    'x' -> (adjust ufmt (fmtu 16 (alt \"0x\" x) prec m x) ++)\n    'X' -> (adjust ufmt (upcase $ fmtu 16 (alt \"0X\" x) prec m x) ++)\n    'b' -> (adjust ufmt (fmtu 2 (alt \"0b\" x) prec m x) ++)\n    'o' -> (adjust ufmt (fmtu 8 (alt \"0\" x) prec m x) ++)\n    'u' -> (adjust ufmt (fmtu 10 Nothing prec m x) ++)\n    'c' | x >= fromIntegral (ord (minBound :: Char)) &&\n          x <= fromIntegral (ord (maxBound :: Char)) &&\n          fmtPrecision ufmt == Nothing &&\n          fmtModifiers ufmt == \"\" ->\n            formatString [chr $ fromIntegral x] (ufmt { fmtChar = 's' })\n    'c' -> perror \"illegal char conversion\"\n    c   -> errorBadFormat c\n  where\n    ufmt = vFmt 'd' $ case ufmt0 of\n      FieldFormat { fmtPrecision = Just _, fmtAdjust = Just ZeroPad } ->\n        ufmt0 { fmtAdjust = Nothing }\n      _ -> ufmt0\n    alt _ 0 = Nothing\n    alt p _ = case fmtAlternate ufmt of\n      True -> Just p\n      False -> Nothing\n    upcase (s1, s2) = (s1, map toUpper s2)\n\n-- | Formatter for 'RealFloat' values.\n--\n-- @since 4.7.0.0\nformatRealFloat :: RealFloat a => a -> FieldFormatter\nformatRealFloat x ufmt =\n  let c = fmtChar $ vFmt 'g' ufmt\n      prec = fmtPrecision ufmt\n      alt = fmtAlternate ufmt\n  in\n   case c of\n     'e' -> (adjustSigned ufmt (dfmt c prec alt x) ++)\n     'E' -> (adjustSigned ufmt (dfmt c prec alt x) ++)\n     'f' -> (adjustSigned ufmt (dfmt c prec alt x) ++)\n     'F' -> (adjustSigned ufmt (dfmt c prec alt x) ++)\n     'g' -> (adjustSigned ufmt (dfmt c prec alt x) ++)\n     'G' -> (adjustSigned ufmt (dfmt c prec alt x) ++)\n     _   -> errorBadFormat c\n\n-- This is the type carried around for arguments in\n-- the varargs code.\ntype UPrintf = (ModifierParser, FieldFormatter)\n\n-- Given a format string and a list of formatting functions\n-- (the actual argument value having already been baked into\n-- each of these functions before delivery), return the\n-- actual formatted text string.\nuprintf :: String -> [UPrintf] -> String\nuprintf s us = uprintfs s us \"\"\n\n-- This function does the actual work, producing a ShowS\n-- instead of a string, for future expansion and for\n-- misguided efficiency.\nuprintfs :: String -> [UPrintf] -> ShowS\nuprintfs \"\"       []       = id\nuprintfs \"\"       (_:_)    = errorShortFormat\nuprintfs ('%':'%':cs) us   = ('%' :) . uprintfs cs us\nuprintfs ('%':_)  []       = errorMissingArgument\nuprintfs ('%':cs) us@(_:_) = fmt cs us\nuprintfs (c:cs)   us       = (c :) . uprintfs cs us\n\n-- Given a suffix of the format string starting just after\n-- the percent sign, and the list of remaining unprocessed\n-- arguments in the form described above, format the portion\n-- of the output described by this field description, and\n-- then continue with 'uprintfs'.\nfmt :: String -> [UPrintf] -> ShowS\nfmt cs0 us0 =\n  case getSpecs False False Nothing False cs0 us0 of\n    (_, _, []) -> errorMissingArgument\n    (ufmt, cs, (_, u) : us) -> u ufmt . uprintfs cs us\n\n-- Given field formatting information, and a tuple\n-- consisting of a prefix (for example, a minus sign) that\n-- is supposed to go before the argument value and a string\n-- representing the value, return the properly padded and\n-- formatted result.\nadjust :: FieldFormat -> (String, String) -> String\nadjust ufmt (pre, str) =\n  let naturalWidth = length pre + length str\n      zero = case fmtAdjust ufmt of\n        Just ZeroPad -> True\n        _ -> False\n      left = case fmtAdjust ufmt of\n        Just LeftAdjust -> True\n        _ -> False\n      fill = case fmtWidth ufmt of\n        Just width | naturalWidth < width ->\n          let fillchar = if zero then '0' else ' ' in\n          replicate (width - naturalWidth) fillchar\n        _ -> \"\"\n  in\n   if left\n   then pre ++ str ++ fill\n   else if zero\n        then pre ++ fill ++ str\n        else fill ++ pre ++ str\n\n-- For positive numbers with an explicit sign field (\"+\" or\n-- \" \"), adjust accordingly.\nadjustSigned :: FieldFormat -> (String, String) -> String\nadjustSigned ufmt@(FieldFormat {fmtSign = Just SignPlus}) (\"\", str) =\n  adjust ufmt (\"+\", str)\nadjustSigned ufmt@(FieldFormat {fmtSign = Just SignSpace}) (\"\", str) =\n  adjust ufmt (\" \", str)\nadjustSigned ufmt ps =\n  adjust ufmt ps\n\n-- Format a signed integer in the \"default\" fashion.\n-- This will be subjected to adjust subsequently.\nfmti :: Maybe Int -> Integer -> (String, String)\nfmti prec i\n  | i < 0 = (\"-\", integral_prec prec (show (-i)))\n  | otherwise = (\"\", integral_prec prec (show i))\n\n-- Format an unsigned integer in the \"default\" fashion.\n-- This will be subjected to adjust subsequently.  The 'b'\n-- argument is the base, the 'pre' argument is the prefix,\n-- and the '(Just m)' argument is the implicit lower-bound\n-- size of the operand for conversion from signed to\n-- unsigned. Thus, this function will refuse to convert an\n-- unbounded negative integer to an unsigned string.\nfmtu :: Integer -> Maybe String -> Maybe Int -> Maybe Integer -> Integer\n     -> (String, String)\nfmtu b (Just pre) prec m i =\n  let (\"\", s) = fmtu b Nothing prec m i in\n  case pre of\n    \"0\" -> case s of\n      '0' : _ -> (\"\", s)\n      _ -> (pre, s)\n    _ -> (pre, s)\nfmtu b Nothing prec0 m0 i0 =\n  case fmtu' prec0 m0 i0 of\n    Just s -> (\"\", s)\n    Nothing -> errorBadArgument\n  where\n    fmtu' :: Maybe Int -> Maybe Integer -> Integer -> Maybe String\n    fmtu' prec (Just m) i | i < 0 =\n      fmtu' prec Nothing (-2 * m + i)\n    fmtu' (Just prec) _ i | i >= 0 =\n      fmap (integral_prec (Just prec)) $ fmtu' Nothing Nothing i\n    fmtu' Nothing _ i | i >= 0 =\n      Just $ showIntAtBase b intToDigit i \"\"\n    fmtu' _ _ _ = Nothing\n\n\n-- This is used by 'fmtu' and 'fmti' to zero-pad an\n-- int-string to a required precision.\nintegral_prec :: Maybe Int -> String -> String\nintegral_prec Nothing integral = integral\nintegral_prec (Just 0) \"0\" = \"\"\nintegral_prec (Just prec) integral =\n  replicate (prec - length integral) '0' ++ integral\n\nstoi :: String -> (Int, String)\nstoi cs =\n  let (as, cs') = span isDigit cs in\n  case as of\n    \"\" -> (0, cs')\n    _ -> (read as, cs')\n\n-- Figure out the FormatAdjustment, given:\n--   width, precision, left-adjust, zero-fill\nadjustment :: Maybe Int -> Maybe a -> Bool -> Bool\n           -> Maybe FormatAdjustment\nadjustment w p l z =\n  case w of\n    Just n | n < 0 -> adjl p True z\n    _ -> adjl p l z\n  where\n    adjl _ True _ = Just LeftAdjust\n    adjl _ False True = Just ZeroPad\n    adjl _ _ _ = Nothing\n\n-- Parse the various format controls to get a format specification.\ngetSpecs :: Bool -> Bool -> Maybe FormatSign -> Bool -> String -> [UPrintf]\n         -> (FieldFormat, String, [UPrintf])\ngetSpecs _ z s a ('-' : cs0) us = getSpecs True z s a cs0 us\ngetSpecs l z _ a ('+' : cs0) us = getSpecs l z (Just SignPlus) a cs0 us\ngetSpecs l z s a (' ' : cs0) us =\n  getSpecs l z ss a cs0 us\n  where\n    ss = case s of\n      Just SignPlus -> Just SignPlus\n      _ -> Just SignSpace\ngetSpecs l _ s a ('0' : cs0) us = getSpecs l True s a cs0 us\ngetSpecs l z s _ ('#' : cs0) us = getSpecs l z s True cs0 us\ngetSpecs l z s a ('*' : cs0) us =\n  let (us', n) = getStar us\n      ((p, cs''), us'') = case cs0 of\n        '.':'*':r ->\n          let (us''', p') = getStar us' in ((Just p', r), us''')\n        '.':r ->\n          let (p', r') = stoi r in ((Just p', r'), us')\n        _ ->\n          ((Nothing, cs0), us')\n      FormatParse ms c cs =\n        case us'' of\n          (ufmt, _) : _ -> ufmt cs''\n          [] -> errorMissingArgument\n  in\n   (FieldFormat {\n       fmtWidth = Just (abs n),\n       fmtPrecision = p,\n       fmtAdjust = adjustment (Just n) p l z,\n       fmtSign = s,\n       fmtAlternate = a,\n       fmtModifiers = ms,\n       fmtChar = c}, cs, us'')\ngetSpecs l z s a ('.' : cs0) us =\n  let ((p, cs'), us') = case cs0 of\n        '*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')\n        _ ->        (stoi cs0, us)\n      FormatParse ms c cs =\n        case us' of\n          (ufmt, _) : _ -> ufmt cs'\n          [] -> errorMissingArgument\n  in\n   (FieldFormat {\n       fmtWidth = Nothing,\n       fmtPrecision = Just p,\n       fmtAdjust = adjustment Nothing (Just p) l z,\n       fmtSign = s,\n       fmtAlternate = a,\n       fmtModifiers = ms,\n       fmtChar = c}, cs, us')\ngetSpecs l z s a cs0@(c0 : _) us | isDigit c0 =\n  let (n, cs') = stoi cs0\n      ((p, cs''), us') = case cs' of\n        '.' : '*' : r ->\n          let (us'', p') = getStar us in ((Just p', r), us'')\n        '.' : r ->\n          let (p', r') = stoi r in ((Just p', r'), us)\n        _ ->\n          ((Nothing, cs'), us)\n      FormatParse ms c cs =\n        case us' of\n          (ufmt, _) : _ -> ufmt cs''\n          [] -> errorMissingArgument\n  in\n   (FieldFormat {\n       fmtWidth = Just (abs n),\n       fmtPrecision = p,\n       fmtAdjust = adjustment (Just n) p l z,\n       fmtSign = s,\n       fmtAlternate = a,\n       fmtModifiers = ms,\n       fmtChar = c}, cs, us')\ngetSpecs l z s a cs0@(_ : _) us =\n  let FormatParse ms c cs =\n        case us of\n          (ufmt, _) : _ -> ufmt cs0\n          [] -> errorMissingArgument\n  in\n   (FieldFormat {\n       fmtWidth = Nothing,\n       fmtPrecision = Nothing,\n       fmtAdjust = adjustment Nothing Nothing l z,\n       fmtSign = s,\n       fmtAlternate = a,\n       fmtModifiers = ms,\n       fmtChar = c}, cs, us)\ngetSpecs _ _ _ _ \"\"       _  =\n  errorShortFormat\n\n-- Process a star argument in a format specification.\ngetStar :: [UPrintf] -> ([UPrintf], Int)\ngetStar us =\n  let ufmt = FieldFormat {\n        fmtWidth = Nothing,\n        fmtPrecision = Nothing,\n        fmtAdjust = Nothing,\n        fmtSign = Nothing,\n        fmtAlternate = False,\n        fmtModifiers = \"\",\n        fmtChar = 'd' } in\n  case us of\n    [] -> errorMissingArgument\n    (_, nu) : us' -> (us', read (nu ufmt \"\"))\n\n-- Format a RealFloat value.\ndfmt :: (RealFloat a) => Char -> Maybe Int -> Bool -> a -> (String, String)\ndfmt c p a d =\n  let caseConvert = if isUpper c then map toUpper else id\n      showFunction = case toLower c of\n        'e' -> showEFloat\n        'f' -> if a then showFFloatAlt else showFFloat\n        'g' -> if a then showGFloatAlt else showGFloat\n        _   -> perror \"internal error: impossible dfmt\"\n      result = caseConvert $ showFunction p d \"\"\n  in\n   case result of\n     '-' : cs -> (\"-\", cs)\n     cs       -> (\"\" , cs)\n\n\n-- | Raises an 'error' with a printf-specific prefix on the\n-- message string.\n--\n-- @since 4.7.0.0\nperror :: String -> a\nperror s = errorWithoutStackTrace $ \"printf: \" ++ s\n\n-- | Calls 'perror' to indicate an unknown format letter for\n-- a given type.\n--\n-- @since 4.7.0.0\nerrorBadFormat :: Char -> a\nerrorBadFormat c = perror $ \"bad formatting char \" ++ show c\n\nerrorShortFormat, errorMissingArgument, errorBadArgument :: a\n-- | Calls 'perror' to indicate that the format string ended\n-- early.\n--\n-- @since 4.7.0.0\nerrorShortFormat = perror \"formatting string ended prematurely\"\n-- | Calls 'perror' to indicate that there is a missing\n-- argument in the argument list.\n--\n-- @since 4.7.0.0\nerrorMissingArgument = perror \"argument list ended prematurely\"\n-- | Calls 'perror' to indicate that there is a type\n-- error or similar in the given argument.\n--\n-- @since 4.7.0.0\nerrorBadArgument = perror \"bad argument\"\n", "num_lines": 915}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Text.Read\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)\n--\n-- Converting strings to values.\n--\n-- The \"Text.Read\" library is the canonical library to import for\n-- 'Read'-class facilities.  For GHC only, it offers an extended and much\n-- improved 'Read' class, which constitutes a proposed alternative to the\n-- Haskell 2010 'Read'.  In particular, writing parsers is easier, and\n-- the parsers are much more efficient.\n--\n-----------------------------------------------------------------------------\n\nmodule Text.Read (\n   -- * The 'Read' class\n   Read(..),\n   ReadS,\n\n   -- * Haskell 2010 functions\n   reads,\n   read,\n   readParen,\n   lex,\n\n   -- * New parsing functions\n   module Text.ParserCombinators.ReadPrec,\n   L.Lexeme(..),\n   lexP,\n   parens,\n   readListDefault,\n   readListPrecDefault,\n   readEither,\n   readMaybe\n\n ) where\n\nimport GHC.Base\nimport GHC.Read\nimport Data.Either\nimport Text.ParserCombinators.ReadP as P\nimport Text.ParserCombinators.ReadPrec\nimport qualified Text.Read.Lex as L\n\n------------------------------------------------------------------------\n-- utility functions\n\n-- | equivalent to 'readsPrec' with a precedence of 0.\nreads :: Read a => ReadS a\nreads = readsPrec minPrec\n\n-- | Parse a string using the 'Read' instance.\n-- Succeeds if there is exactly one valid result.\n-- A 'Left' value indicates a parse error.\n--\n-- >>> readEither \"123\" :: Either String Int\n-- Right 123\n--\n-- >>> readEither \"hello\" :: Either String Int\n-- Left \"Prelude.read: no parse\"\n--\n-- @since 4.6.0.0\nreadEither :: Read a => String -> Either String a\nreadEither s =\n  case [ x | (x,\"\") <- readPrec_to_S read' minPrec s ] of\n    [x] -> Right x\n    []  -> Left \"Prelude.read: no parse\"\n    _   -> Left \"Prelude.read: ambiguous parse\"\n where\n  read' =\n    do x <- readPrec\n       lift P.skipSpaces\n       return x\n\n-- | Parse a string using the 'Read' instance.\n-- Succeeds if there is exactly one valid result.\n--\n-- >>> readMaybe \"123\" :: Maybe Int\n-- Just 123\n--\n-- >>> readMaybe \"hello\" :: Maybe Int\n-- Nothing\n--\n-- @since 4.6.0.0\nreadMaybe :: Read a => String -> Maybe a\nreadMaybe s = case readEither s of\n                Left _  -> Nothing\n                Right a -> Just a\n\n-- | The 'read' function reads input from a string, which must be\n-- completely consumed by the input process. 'read' fails with an 'error' if the\n-- parse is unsuccessful, and it is therefore discouraged from being used in\n-- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.\n--\n-- >>> read \"123\" :: Int\n-- 123\n--\n-- >>> read \"hello\" :: Int\n-- *** Exception: Prelude.read: no parse\nread :: Read a => String -> a\nread s = either errorWithoutStackTrace id (readEither s)\n", "num_lines": 111}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Text.Show\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Converting values to readable strings:\n-- the 'Show' class and associated functions.\n--\n-----------------------------------------------------------------------------\n\nmodule Text.Show (\n   ShowS,\n   Show(showsPrec, show, showList),\n   shows,\n   showChar,\n   showString,\n   showParen,\n   showListWith,\n ) where\n\nimport GHC.Show\n\n-- | Show a list (using square brackets and commas), given a function\n-- for showing elements.\nshowListWith :: (a -> ShowS) -> [a] -> ShowS\nshowListWith = showList__\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE DeriveFunctor #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Text.ParserCombinators.ReadP\n-- Copyright   :  (c) The University of Glasgow 2002\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (local universal quantification)\n--\n-- This is a library of parser combinators, originally written by Koen Claessen.\n-- It parses all alternatives in parallel, so it never keeps hold of\n-- the beginning of the input string, a common source of space leaks with\n-- other parsers.  The @('+++')@ choice combinator is genuinely commutative;\n-- it makes no difference which branch is \\\"shorter\\\".\n\n-----------------------------------------------------------------------------\n\nmodule Text.ParserCombinators.ReadP\n  (\n  -- * The 'ReadP' type\n  ReadP,\n\n  -- * Primitive operations\n  get,\n  look,\n  (+++),\n  (<++),\n  gather,\n\n  -- * Other operations\n  pfail,\n  eof,\n  satisfy,\n  char,\n  string,\n  munch,\n  munch1,\n  skipSpaces,\n  choice,\n  count,\n  between,\n  option,\n  optional,\n  many,\n  many1,\n  skipMany,\n  skipMany1,\n  sepBy,\n  sepBy1,\n  endBy,\n  endBy1,\n  chainr,\n  chainl,\n  chainl1,\n  chainr1,\n  manyTill,\n\n  -- * Running a parser\n  ReadS,\n  readP_to_S,\n  readS_to_P,\n\n  -- * Properties\n  -- $properties\n  )\n where\n\nimport GHC.Unicode ( isSpace )\nimport GHC.List ( replicate, null )\nimport GHC.Base hiding ( many )\n\nimport Control.Monad.Fail\n\ninfixr 5 +++, <++\n\n------------------------------------------------------------------------\n-- ReadS\n\n-- | A parser for a type @a@, represented as a function that takes a\n-- 'String' and returns a list of possible parses as @(a,'String')@ pairs.\n--\n-- Note that this kind of backtracking parser is very inefficient;\n-- reading a large structure may be quite slow (cf 'ReadP').\ntype ReadS a = String -> [(a,String)]\n\n-- ---------------------------------------------------------------------------\n-- The P type\n-- is representation type -- should be kept abstract\n\ndata P a\n  = Get (Char -> P a)\n  | Look (String -> P a)\n  | Fail\n  | Result a (P a)\n  | Final (NonEmpty (a,String))\n  deriving Functor -- ^ @since 4.8.0.0\n\n-- Monad, MonadPlus\n\n-- | @since 4.5.0.0\ninstance Applicative P where\n  pure x = Result x Fail\n  (<*>) = ap\n\n-- | @since 2.01\ninstance MonadPlus P\n\n-- | @since 2.01\ninstance Monad P where\n  (Get f)         >>= k = Get (\\c -> f c >>= k)\n  (Look f)        >>= k = Look (\\s -> f s >>= k)\n  Fail            >>= _ = Fail\n  (Result x p)    >>= k = k x <|> (p >>= k)\n  (Final (r:|rs)) >>= k = final [ys' | (x,s) <- (r:rs), ys' <- run (k x) s]\n\n  fail _ = Fail\n\n-- | @since 4.9.0.0\ninstance MonadFail P where\n  fail _ = Fail\n\n-- | @since 4.5.0.0\ninstance Alternative P where\n  empty = Fail\n\n  -- most common case: two gets are combined\n  Get f1     <|> Get f2     = Get (\\c -> f1 c <|> f2 c)\n\n  -- results are delivered as soon as possible\n  Result x p <|> q          = Result x (p <|> q)\n  p          <|> Result x q = Result x (p <|> q)\n\n  -- fail disappears\n  Fail       <|> p          = p\n  p          <|> Fail       = p\n\n  -- two finals are combined\n  -- final + look becomes one look and one final (=optimization)\n  -- final + sthg else becomes one look and one final\n  Final r       <|> Final t = Final (r <> t)\n  Final (r:|rs) <|> Look f  = Look (\\s -> Final (r:|(rs ++ run (f s) s)))\n  Final (r:|rs) <|> p       = Look (\\s -> Final (r:|(rs ++ run p s)))\n  Look f        <|> Final r = Look (\\s -> Final (case run (f s) s of\n                                []     -> r\n                                (x:xs) -> (x:|xs) <> r))\n  p             <|> Final r = Look (\\s -> Final (case run p s of\n                                []     -> r\n                                (x:xs) -> (x:|xs) <> r))\n\n  -- two looks are combined (=optimization)\n  -- look + sthg else floats upwards\n  Look f     <|> Look g     = Look (\\s -> f s <|> g s)\n  Look f     <|> p          = Look (\\s -> f s <|> p)\n  p          <|> Look f     = Look (\\s -> p <|> f s)\n\n-- ---------------------------------------------------------------------------\n-- The ReadP type\n\nnewtype ReadP a = R (forall b . (a -> P b) -> P b)\n\n-- | @since 2.01\ninstance Functor ReadP where\n  fmap h (R f) = R (\\k -> f (k . h))\n\n-- | @since 4.6.0.0\ninstance Applicative ReadP where\n    pure x = R (\\k -> k x)\n    (<*>) = ap\n    -- liftA2 = liftM2\n\n-- | @since 2.01\ninstance Monad ReadP where\n  fail _    = R (\\_ -> Fail)\n  R m >>= f = R (\\k -> m (\\a -> let R m' = f a in m' k))\n\n-- | @since 4.9.0.0\ninstance MonadFail ReadP where\n  fail _    = R (\\_ -> Fail)\n\n-- | @since 4.6.0.0\ninstance Alternative ReadP where\n  empty = pfail\n  (<|>) = (+++)\n\n-- | @since 2.01\ninstance MonadPlus ReadP\n\n-- ---------------------------------------------------------------------------\n-- Operations over P\n\nfinal :: [(a,String)] -> P a\nfinal []     = Fail\nfinal (r:rs) = Final (r:|rs)\n\nrun :: P a -> ReadS a\nrun (Get f)         (c:s) = run (f c) s\nrun (Look f)        s     = run (f s) s\nrun (Result x p)    s     = (x,s) : run p s\nrun (Final (r:|rs)) _     = (r:rs)\nrun _               _     = []\n\n-- ---------------------------------------------------------------------------\n-- Operations over ReadP\n\nget :: ReadP Char\n-- ^ Consumes and returns the next character.\n--   Fails if there is no input left.\nget = R Get\n\nlook :: ReadP String\n-- ^ Look-ahead: returns the part of the input that is left, without\n--   consuming it.\nlook = R Look\n\npfail :: ReadP a\n-- ^ Always fails.\npfail = R (\\_ -> Fail)\n\n(+++) :: ReadP a -> ReadP a -> ReadP a\n-- ^ Symmetric choice.\nR f1 +++ R f2 = R (\\k -> f1 k <|> f2 k)\n\n(<++) :: ReadP a -> ReadP a -> ReadP a\n-- ^ Local, exclusive, left-biased choice: If left parser\n--   locally produces any result at all, then right parser is\n--   not used.\nR f0 <++ q =\n  do s <- look\n     probe (f0 return) s 0#\n where\n  probe (Get f)        (c:s) n = probe (f c) s (n+#1#)\n  probe (Look f)       s     n = probe (f s) s n\n  probe p@(Result _ _) _     n = discard n >> R (p >>=)\n  probe (Final r)      _     _ = R (Final r >>=)\n  probe _              _     _ = q\n\n  discard 0# = return ()\n  discard n  = get >> discard (n-#1#)\n\ngather :: ReadP a -> ReadP (String, a)\n-- ^ Transforms a parser into one that does the same, but\n--   in addition returns the exact characters read.\n--   IMPORTANT NOTE: 'gather' gives a runtime error if its first argument\n--   is built using any occurrences of readS_to_P.\ngather (R m)\n  = R (\\k -> gath id (m (\\a -> return (\\s -> k (s,a)))))\n where\n  gath :: (String -> String) -> P (String -> P b) -> P b\n  gath l (Get f)      = Get (\\c -> gath (l.(c:)) (f c))\n  gath _ Fail         = Fail\n  gath l (Look f)     = Look (\\s -> gath l (f s))\n  gath l (Result k p) = k (l []) <|> gath l p\n  gath _ (Final _)    = errorWithoutStackTrace \"do not use readS_to_P in gather!\"\n\n-- ---------------------------------------------------------------------------\n-- Derived operations\n\nsatisfy :: (Char -> Bool) -> ReadP Char\n-- ^ Consumes and returns the next character, if it satisfies the\n--   specified predicate.\nsatisfy p = do c <- get; if p c then return c else pfail\n\nchar :: Char -> ReadP Char\n-- ^ Parses and returns the specified character.\nchar c = satisfy (c ==)\n\neof :: ReadP ()\n-- ^ Succeeds iff we are at the end of input\neof = do { s <- look\n         ; if null s then return ()\n                     else pfail }\n\nstring :: String -> ReadP String\n-- ^ Parses and returns the specified string.\nstring this = do s <- look; scan this s\n where\n  scan []     _               = do return this\n  scan (x:xs) (y:ys) | x == y = do _ <- get; scan xs ys\n  scan _      _               = do pfail\n\nmunch :: (Char -> Bool) -> ReadP String\n-- ^ Parses the first zero or more characters satisfying the predicate.\n--   Always succeeds, exactly once having consumed all the characters\n--   Hence NOT the same as (many (satisfy p))\nmunch p =\n  do s <- look\n     scan s\n where\n  scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)\n  scan _            = do return \"\"\n\nmunch1 :: (Char -> Bool) -> ReadP String\n-- ^ Parses the first one or more characters satisfying the predicate.\n--   Fails if none, else succeeds exactly once having consumed all the characters\n--   Hence NOT the same as (many1 (satisfy p))\nmunch1 p =\n  do c <- get\n     if p c then do s <- munch p; return (c:s)\n            else pfail\n\nchoice :: [ReadP a] -> ReadP a\n-- ^ Combines all parsers in the specified list.\nchoice []     = pfail\nchoice [p]    = p\nchoice (p:ps) = p +++ choice ps\n\nskipSpaces :: ReadP ()\n-- ^ Skips all whitespace.\nskipSpaces =\n  do s <- look\n     skip s\n where\n  skip (c:s) | isSpace c = do _ <- get; skip s\n  skip _                 = do return ()\n\ncount :: Int -> ReadP a -> ReadP [a]\n-- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of\n--   results is returned.\ncount n p = sequence (replicate n p)\n\nbetween :: ReadP open -> ReadP close -> ReadP a -> ReadP a\n-- ^ @between open close p@ parses @open@, followed by @p@ and finally\n--   @close@. Only the value of @p@ is returned.\nbetween open close p = do _ <- open\n                          x <- p\n                          _ <- close\n                          return x\n\noption :: a -> ReadP a -> ReadP a\n-- ^ @option x p@ will either parse @p@ or return @x@ without consuming\n--   any input.\noption x p = p +++ return x\n\noptional :: ReadP a -> ReadP ()\n-- ^ @optional p@ optionally parses @p@ and always returns @()@.\noptional p = (p >> return ()) +++ return ()\n\nmany :: ReadP a -> ReadP [a]\n-- ^ Parses zero or more occurrences of the given parser.\nmany p = return [] +++ many1 p\n\nmany1 :: ReadP a -> ReadP [a]\n-- ^ Parses one or more occurrences of the given parser.\nmany1 p = liftM2 (:) p (many p)\n\nskipMany :: ReadP a -> ReadP ()\n-- ^ Like 'many', but discards the result.\nskipMany p = many p >> return ()\n\nskipMany1 :: ReadP a -> ReadP ()\n-- ^ Like 'many1', but discards the result.\nskipMany1 p = p >> skipMany p\n\nsepBy :: ReadP a -> ReadP sep -> ReadP [a]\n-- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.\n--   Returns a list of values returned by @p@.\nsepBy p sep = sepBy1 p sep +++ return []\n\nsepBy1 :: ReadP a -> ReadP sep -> ReadP [a]\n-- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.\n--   Returns a list of values returned by @p@.\nsepBy1 p sep = liftM2 (:) p (many (sep >> p))\n\nendBy :: ReadP a -> ReadP sep -> ReadP [a]\n-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended\n--   by @sep@.\nendBy p sep = many (do x <- p ; _ <- sep ; return x)\n\nendBy1 :: ReadP a -> ReadP sep -> ReadP [a]\n-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended\n--   by @sep@.\nendBy1 p sep = many1 (do x <- p ; _ <- sep ; return x)\n\nchainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a\n-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.\n--   Returns a value produced by a /right/ associative application of all\n--   functions returned by @op@. If there are no occurrences of @p@, @x@ is\n--   returned.\nchainr p op x = chainr1 p op +++ return x\n\nchainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a\n-- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.\n--   Returns a value produced by a /left/ associative application of all\n--   functions returned by @op@. If there are no occurrences of @p@, @x@ is\n--   returned.\nchainl p op x = chainl1 p op +++ return x\n\nchainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a\n-- ^ Like 'chainr', but parses one or more occurrences of @p@.\nchainr1 p op = scan\n  where scan   = p >>= rest\n        rest x = do f <- op\n                    y <- scan\n                    return (f x y)\n                 +++ return x\n\nchainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a\n-- ^ Like 'chainl', but parses one or more occurrences of @p@.\nchainl1 p op = p >>= rest\n  where rest x = do f <- op\n                    y <- p\n                    rest (f x y)\n                 +++ return x\n\nmanyTill :: ReadP a -> ReadP end -> ReadP [a]\n-- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@\n--   succeeds. Returns a list of values returned by @p@.\nmanyTill p end = scan\n  where scan = (end >> return []) <++ (liftM2 (:) p scan)\n\n-- ---------------------------------------------------------------------------\n-- Converting between ReadP and Read\n\nreadP_to_S :: ReadP a -> ReadS a\n-- ^ Converts a parser into a Haskell ReadS-style function.\n--   This is the main way in which you can \\\"run\\\" a 'ReadP' parser:\n--   the expanded type is\n-- @ readP_to_S :: ReadP a -> String -> [(a,String)] @\nreadP_to_S (R f) = run (f return)\n\nreadS_to_P :: ReadS a -> ReadP a\n-- ^ Converts a Haskell ReadS-style function into a parser.\n--   Warning: This introduces local backtracking in the resulting\n--   parser, and therefore a possible inefficiency.\nreadS_to_P r =\n  R (\\k -> Look (\\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))\n\n-- ---------------------------------------------------------------------------\n-- QuickCheck properties that hold for the combinators\n\n{- $properties\nThe following are QuickCheck specifications of what the combinators do.\nThese can be seen as formal specifications of the behavior of the\ncombinators.\n\nFor some values, we only care about the lists contents, not their order,\n\n> (=~) :: Ord a => [a] -> [a] -> Bool\n> xs =~ ys = sort xs == sort ys\n\nHere follow the properties:\n\n>>> readP_to_S get []\n[]\n\nprop> \\c str -> readP_to_S get (c:str) == [(c, str)]\n\nprop> \\str -> readP_to_S look str == [(str, str)]\n\nprop> \\str -> readP_to_S pfail str == []\n\nprop> \\x str -> readP_to_S (return x) s == [(x,s)]\n\n> prop_Bind p k s =\n>    readP_to_S (p >>= k) s =~\n>      [ ys''\n>      | (x,s') <- readP_to_S p s\n>      , ys''   <- readP_to_S (k (x::Int)) s'\n>      ]\n\n> prop_Plus p q s =\n>   readP_to_S (p +++ q) s =~\n>     (readP_to_S p s ++ readP_to_S q s)\n\n> prop_LeftPlus p q s =\n>   readP_to_S (p <++ q) s =~\n>     (readP_to_S p s +<+ readP_to_S q s)\n>  where\n>   [] +<+ ys = ys\n>   xs +<+ _  = xs\n\n> prop_Gather s =\n>   forAll readPWithoutReadS $ \\p ->\n>     readP_to_S (gather p) s =~\n>       [ ((pre,x::Int),s')\n>       | (x,s') <- readP_to_S p s\n>       , let pre = take (length s - length s') s\n>       ]\n\nprop> \\this str -> readP_to_S (string this) (this ++ str) == [(this,str)]\n\n> prop_String_Maybe this s =\n>   readP_to_S (string this) s =~\n>     [(this, drop (length this) s) | this `isPrefixOf` s]\n\n> prop_Munch p s =\n>   readP_to_S (munch p) s =~\n>     [(takeWhile p s, dropWhile p s)]\n\n> prop_Munch1 p s =\n>   readP_to_S (munch1 p) s =~\n>     [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]\n\n> prop_Choice ps s =\n>   readP_to_S (choice ps) s =~\n>     readP_to_S (foldr (+++) pfail ps) s\n\n> prop_ReadS r s =\n>   readP_to_S (readS_to_P r) s =~ r s\n-}\n", "num_lines": 508}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Text.ParserCombinators.ReadPrec\n-- Copyright   :  (c) The University of Glasgow 2002\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)\n--\n-- This library defines parser combinators for precedence parsing.\n\n-----------------------------------------------------------------------------\n\nmodule Text.ParserCombinators.ReadPrec\n  (\n  ReadPrec,\n\n  -- * Precedences\n  Prec,\n  minPrec,\n\n  -- * Precedence operations\n  lift,\n  prec,\n  step,\n  reset,\n\n  -- * Other operations\n  -- | All are based directly on their similarly-named 'ReadP' counterparts.\n  get,\n  look,\n  (+++),\n  (<++),\n  pfail,\n  choice,\n\n  -- * Converters\n  readPrec_to_P,\n  readP_to_Prec,\n  readPrec_to_S,\n  readS_to_Prec,\n  )\n where\n\n\nimport Text.ParserCombinators.ReadP\n  ( ReadP\n  , ReadS\n  , readP_to_S\n  , readS_to_P\n  )\n\nimport qualified Text.ParserCombinators.ReadP as ReadP\n  ( get\n  , look\n  , (+++), (<++)\n  , pfail\n  )\n\nimport GHC.Num( Num(..) )\nimport GHC.Base\n\nimport qualified Control.Monad.Fail as MonadFail\n\n-- ---------------------------------------------------------------------------\n-- The readPrec type\n\nnewtype ReadPrec a = P (Prec -> ReadP a)\n\n-- Functor, Monad, MonadPlus\n\n-- | @since 2.01\ninstance Functor ReadPrec where\n  fmap h (P f) = P (\\n -> fmap h (f n))\n\n-- | @since 4.6.0.0\ninstance Applicative ReadPrec where\n    pure x  = P (\\_ -> pure x)\n    (<*>) = ap\n    liftA2 = liftM2\n\n-- | @since 2.01\ninstance Monad ReadPrec where\n  fail s    = P (\\_ -> fail s)\n  P f >>= k = P (\\n -> do a <- f n; let P f' = k a in f' n)\n\n-- | @since 4.9.0.0\ninstance MonadFail.MonadFail ReadPrec where\n  fail s    = P (\\_ -> MonadFail.fail s)\n\n-- | @since 2.01\ninstance MonadPlus ReadPrec\n\n-- | @since 4.6.0.0\ninstance Alternative ReadPrec where\n  empty = pfail\n  (<|>) = (+++)\n\n-- precedences\ntype Prec = Int\n\nminPrec :: Prec\nminPrec = 0\n\n-- ---------------------------------------------------------------------------\n-- Operations over ReadPrec\n\nlift :: ReadP a -> ReadPrec a\n-- ^ Lift a precedence-insensitive 'ReadP' to a 'ReadPrec'.\nlift m = P (\\_ -> m)\n\nstep :: ReadPrec a -> ReadPrec a\n-- ^ Increases the precedence context by one.\nstep (P f) = P (\\n -> f (n+1))\n\nreset :: ReadPrec a -> ReadPrec a\n-- ^ Resets the precedence context to zero.\nreset (P f) = P (\\_ -> f minPrec)\n\nprec :: Prec -> ReadPrec a -> ReadPrec a\n-- ^ @(prec n p)@ checks whether the precedence context is\n--   less than or equal to @n@, and\n--\n--   * if not, fails\n--\n--   * if so, parses @p@ in context @n@.\nprec n (P f) = P (\\c -> if c <= n then f n else ReadP.pfail)\n\n-- ---------------------------------------------------------------------------\n-- Derived operations\n\nget :: ReadPrec Char\n-- ^ Consumes and returns the next character.\n--   Fails if there is no input left.\nget = lift ReadP.get\n\nlook :: ReadPrec String\n-- ^ Look-ahead: returns the part of the input that is left, without\n--   consuming it.\nlook = lift ReadP.look\n\n(+++) :: ReadPrec a -> ReadPrec a -> ReadPrec a\n-- ^ Symmetric choice.\nP f1 +++ P f2 = P (\\n -> f1 n ReadP.+++ f2 n)\n\n(<++) :: ReadPrec a -> ReadPrec a -> ReadPrec a\n-- ^ Local, exclusive, left-biased choice: If left parser\n--   locally produces any result at all, then right parser is\n--   not used.\nP f1 <++ P f2 = P (\\n -> f1 n ReadP.<++ f2 n)\n\npfail :: ReadPrec a\n-- ^ Always fails.\npfail = lift ReadP.pfail\n\nchoice :: [ReadPrec a] -> ReadPrec a\n-- ^ Combines all parsers in the specified list.\nchoice ps = foldr (+++) pfail ps\n\n-- ---------------------------------------------------------------------------\n-- Converting between ReadPrec and Read\n\nreadPrec_to_P :: ReadPrec a -> (Int -> ReadP a)\nreadPrec_to_P (P f) = f\n\nreadP_to_Prec :: (Int -> ReadP a) -> ReadPrec a\nreadP_to_Prec f = P f\n\nreadPrec_to_S :: ReadPrec a -> (Int -> ReadS a)\nreadPrec_to_S (P f) n = readP_to_S (f n)\n\nreadS_to_Prec :: (Int -> ReadS a) -> ReadPrec a\nreadS_to_Prec f = P (\\n -> readS_to_P (f n))\n\n", "num_lines": 179}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Text.Read.Lex\n-- Copyright   :  (c) The University of Glasgow 2002\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)\n--\n-- The cut-down Haskell lexer, used by Text.Read\n--\n-----------------------------------------------------------------------------\n\nmodule Text.Read.Lex\n  -- lexing types\n  ( Lexeme(..), Number\n\n  , numberToInteger, numberToFixed, numberToRational, numberToRangedRational\n\n  -- lexer\n  , lex, expect\n  , hsLex\n  , lexChar\n\n  , readIntP\n  , readOctP\n  , readDecP\n  , readHexP\n\n  , isSymbolChar\n  )\n where\n\nimport Text.ParserCombinators.ReadP\n\nimport GHC.Base\nimport GHC.Char\nimport GHC.Num( Num(..), Integer )\nimport GHC.Show( Show(..) )\nimport GHC.Unicode\n  ( GeneralCategory(..), generalCategory, isSpace, isAlpha, isAlphaNum )\nimport GHC.Real( Rational, (%), fromIntegral, Integral,\n                 toInteger, (^), quot, even )\nimport GHC.List\nimport GHC.Enum( minBound, maxBound )\nimport Data.Maybe\n\n-- local copy to break import-cycle\n-- | @'guard' b@ is @'return' ()@ if @b@ is 'True',\n-- and 'mzero' if @b@ is 'False'.\nguard           :: (MonadPlus m) => Bool -> m ()\nguard True      =  return ()\nguard False     =  mzero\n\n-- -----------------------------------------------------------------------------\n-- Lexing types\n\n-- ^ Haskell lexemes.\ndata Lexeme\n  = Char   Char         -- ^ Character literal\n  | String String       -- ^ String literal, with escapes interpreted\n  | Punc   String       -- ^ Punctuation or reserved symbol, e.g. @(@, @::@\n  | Ident  String       -- ^ Haskell identifier, e.g. @foo@, @Baz@\n  | Symbol String       -- ^ Haskell symbol, e.g. @>>@, @:%@\n  | Number Number       -- ^ @since 4.6.0.0\n  | EOF\n deriving ( Eq   -- ^ @since 2.01\n          , Show -- ^ @since 2.01\n          )\n\n-- | @since 4.6.0.0\ndata Number = MkNumber Int              -- Base\n                       Digits           -- Integral part\n            | MkDecimal Digits          -- Integral part\n                        (Maybe Digits)  -- Fractional part\n                        (Maybe Integer) -- Exponent\n deriving ( Eq   -- ^ @since 4.6.0.0\n          , Show -- ^ @since 4.6.0.0\n          )\n\n-- | @since 4.5.1.0\nnumberToInteger :: Number -> Maybe Integer\nnumberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) iPart)\nnumberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 iPart)\nnumberToInteger _ = Nothing\n\n-- | @since 4.7.0.0\nnumberToFixed :: Integer -> Number -> Maybe (Integer, Integer)\nnumberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) iPart, 0)\nnumberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 iPart, 0)\nnumberToFixed p (MkDecimal iPart (Just fPart) Nothing)\n    = let i = val 10 iPart\n          f = val 10 (integerTake p (fPart ++ repeat 0))\n          -- Sigh, we really want genericTake, but that's above us in\n          -- the hierarchy, so we define our own version here (actually\n          -- specialised to Integer)\n          integerTake             :: Integer -> [a] -> [a]\n          integerTake n _ | n <= 0 = []\n          integerTake _ []        =  []\n          integerTake n (x:xs)    =  x : integerTake (n-1) xs\n      in Just (i, f)\nnumberToFixed _ _ = Nothing\n\n-- This takes a floatRange, and if the Rational would be outside of\n-- the floatRange then it may return Nothing. Not that it will not\n-- /necessarily/ return Nothing, but it is good enough to fix the\n-- space problems in #5688\n-- Ways this is conservative:\n-- * the floatRange is in base 2, but we pretend it is in base 10\n-- * we pad the floateRange a bit, just in case it is very small\n--   and we would otherwise hit an edge case\n-- * We only worry about numbers that have an exponent. If they don't\n--   have an exponent then the Rational won't be much larger than the\n--   Number, so there is no problem\n-- | @since 4.5.1.0\nnumberToRangedRational :: (Int, Int) -> Number\n                       -> Maybe Rational -- Nothing = Inf\nnumberToRangedRational (neg, pos) n@(MkDecimal iPart mFPart (Just exp))\n    -- if exp is out of integer bounds,\n    -- then the number is definitely out of range\n    | exp > fromIntegral (maxBound :: Int) ||\n      exp < fromIntegral (minBound :: Int)\n    = Nothing\n    | otherwise\n    = let mFirstDigit = case dropWhile (0 ==) iPart of\n                        iPart'@(_ : _) -> Just (length iPart')\n                        [] -> case mFPart of\n                              Nothing -> Nothing\n                              Just fPart ->\n                                  case span (0 ==) fPart of\n                                  (_, []) -> Nothing\n                                  (zeroes, _) ->\n                                      Just (negate (length zeroes))\n      in case mFirstDigit of\n         Nothing -> Just 0\n         Just firstDigit ->\n             let firstDigit' = firstDigit + fromInteger exp\n             in if firstDigit' > (pos + 3)\n                then Nothing\n                else if firstDigit' < (neg - 3)\n                then Just 0\n                else Just (numberToRational n)\nnumberToRangedRational _ n = Just (numberToRational n)\n\n-- | @since 4.6.0.0\nnumberToRational :: Number -> Rational\nnumberToRational (MkNumber base iPart) = val (fromIntegral base) iPart % 1\nnumberToRational (MkDecimal iPart mFPart mExp)\n = let i = val 10 iPart\n   in case (mFPart, mExp) of\n      (Nothing, Nothing)     -> i % 1\n      (Nothing, Just exp)\n       | exp >= 0            -> (i * (10 ^ exp)) % 1\n       | otherwise           -> i % (10 ^ (- exp))\n      (Just fPart, Nothing)  -> fracExp 0   i fPart\n      (Just fPart, Just exp) -> fracExp exp i fPart\n      -- fracExp is a bit more efficient in calculating the Rational.\n      -- Instead of calculating the fractional part alone, then\n      -- adding the integral part and finally multiplying with\n      -- 10 ^ exp if an exponent was given, do it all at once.\n\n-- -----------------------------------------------------------------------------\n-- Lexing\n\nlex :: ReadP Lexeme\nlex = skipSpaces >> lexToken\n\n-- | @since 4.7.0.0\nexpect :: Lexeme -> ReadP ()\nexpect lexeme = do { skipSpaces\n                   ; thing <- lexToken\n                   ; if thing == lexeme then return () else pfail }\n\nhsLex :: ReadP String\n-- ^ Haskell lexer: returns the lexed string, rather than the lexeme\nhsLex = do skipSpaces\n           (s,_) <- gather lexToken\n           return s\n\nlexToken :: ReadP Lexeme\nlexToken = lexEOF     +++\n           lexLitChar +++\n           lexString  +++\n           lexPunc    +++\n           lexSymbol  +++\n           lexId      +++\n           lexNumber\n\n\n-- ----------------------------------------------------------------------\n-- End of file\nlexEOF :: ReadP Lexeme\nlexEOF = do s <- look\n            guard (null s)\n            return EOF\n\n-- ---------------------------------------------------------------------------\n-- Single character lexemes\n\nlexPunc :: ReadP Lexeme\nlexPunc =\n  do c <- satisfy isPuncChar\n     return (Punc [c])\n\n-- | The @special@ character class as defined in the Haskell Report.\nisPuncChar :: Char -> Bool\nisPuncChar c = c `elem` \",;()[]{}`\"\n\n-- ----------------------------------------------------------------------\n-- Symbols\n\nlexSymbol :: ReadP Lexeme\nlexSymbol =\n  do s <- munch1 isSymbolChar\n     if s `elem` reserved_ops then\n        return (Punc s)         -- Reserved-ops count as punctuation\n      else\n        return (Symbol s)\n  where\n    reserved_ops   = [\"..\", \"::\", \"=\", \"\\\\\", \"|\", \"<-\", \"->\", \"@\", \"~\", \"=>\"]\n\nisSymbolChar :: Char -> Bool\nisSymbolChar c = not (isPuncChar c) && case generalCategory c of\n    MathSymbol              -> True\n    CurrencySymbol          -> True\n    ModifierSymbol          -> True\n    OtherSymbol             -> True\n    DashPunctuation         -> True\n    OtherPunctuation        -> not (c `elem` \"'\\\"\")\n    ConnectorPunctuation    -> c /= '_'\n    _                       -> False\n-- ----------------------------------------------------------------------\n-- identifiers\n\nlexId :: ReadP Lexeme\nlexId = do c <- satisfy isIdsChar\n           s <- munch isIdfChar\n           return (Ident (c:s))\n  where\n          -- Identifiers can start with a '_'\n    isIdsChar c = isAlpha c || c == '_'\n    isIdfChar c = isAlphaNum c || c `elem` \"_'\"\n\n-- ---------------------------------------------------------------------------\n-- Lexing character literals\n\nlexLitChar :: ReadP Lexeme\nlexLitChar =\n  do _ <- char '\\''\n     (c,esc) <- lexCharE\n     guard (esc || c /= '\\'')   -- Eliminate '' possibility\n     _ <- char '\\''\n     return (Char c)\n\nlexChar :: ReadP Char\nlexChar = do { (c,_) <- lexCharE; consumeEmpties; return c }\n    where\n    -- Consumes the string \"\\&\" repeatedly and greedily (will only produce one match)\n    consumeEmpties :: ReadP ()\n    consumeEmpties = do\n        rest <- look\n        case rest of\n            ('\\\\':'&':_) -> string \"\\\\&\" >> consumeEmpties\n            _ -> return ()\n\n\nlexCharE :: ReadP (Char, Bool)  -- \"escaped or not\"?\nlexCharE =\n  do c1 <- get\n     if c1 == '\\\\'\n       then do c2 <- lexEsc; return (c2, True)\n       else do return (c1, False)\n where\n  lexEsc =\n    lexEscChar\n      +++ lexNumeric\n        +++ lexCntrlChar\n          +++ lexAscii\n\n  lexEscChar =\n    do c <- get\n       case c of\n         'a'  -> return '\\a'\n         'b'  -> return '\\b'\n         'f'  -> return '\\f'\n         'n'  -> return '\\n'\n         'r'  -> return '\\r'\n         't'  -> return '\\t'\n         'v'  -> return '\\v'\n         '\\\\' -> return '\\\\'\n         '\\\"' -> return '\\\"'\n         '\\'' -> return '\\''\n         _    -> pfail\n\n  lexNumeric =\n    do base <- lexBaseChar <++ return 10\n       n    <- lexInteger base\n       guard (n <= toInteger (ord maxBound))\n       return (chr (fromInteger n))\n\n  lexCntrlChar =\n    do _ <- char '^'\n       c <- get\n       case c of\n         '@'  -> return '\\^@'\n         'A'  -> return '\\^A'\n         'B'  -> return '\\^B'\n         'C'  -> return '\\^C'\n         'D'  -> return '\\^D'\n         'E'  -> return '\\^E'\n         'F'  -> return '\\^F'\n         'G'  -> return '\\^G'\n         'H'  -> return '\\^H'\n         'I'  -> return '\\^I'\n         'J'  -> return '\\^J'\n         'K'  -> return '\\^K'\n         'L'  -> return '\\^L'\n         'M'  -> return '\\^M'\n         'N'  -> return '\\^N'\n         'O'  -> return '\\^O'\n         'P'  -> return '\\^P'\n         'Q'  -> return '\\^Q'\n         'R'  -> return '\\^R'\n         'S'  -> return '\\^S'\n         'T'  -> return '\\^T'\n         'U'  -> return '\\^U'\n         'V'  -> return '\\^V'\n         'W'  -> return '\\^W'\n         'X'  -> return '\\^X'\n         'Y'  -> return '\\^Y'\n         'Z'  -> return '\\^Z'\n         '['  -> return '\\^['\n         '\\\\' -> return '\\^\\'\n         ']'  -> return '\\^]'\n         '^'  -> return '\\^^'\n         '_'  -> return '\\^_'\n         _    -> pfail\n\n  lexAscii =\n    do choice\n         [ (string \"SOH\" >> return '\\SOH') <++\n           (string \"SO\"  >> return '\\SO')\n                -- \\SO and \\SOH need maximal-munch treatment\n                -- See the Haskell report Sect 2.6\n\n         , string \"NUL\" >> return '\\NUL'\n         , string \"STX\" >> return '\\STX'\n         , string \"ETX\" >> return '\\ETX'\n         , string \"EOT\" >> return '\\EOT'\n         , string \"ENQ\" >> return '\\ENQ'\n         , string \"ACK\" >> return '\\ACK'\n         , string \"BEL\" >> return '\\BEL'\n         , string \"BS\"  >> return '\\BS'\n         , string \"HT\"  >> return '\\HT'\n         , string \"LF\"  >> return '\\LF'\n         , string \"VT\"  >> return '\\VT'\n         , string \"FF\"  >> return '\\FF'\n         , string \"CR\"  >> return '\\CR'\n         , string \"SI\"  >> return '\\SI'\n         , string \"DLE\" >> return '\\DLE'\n         , string \"DC1\" >> return '\\DC1'\n         , string \"DC2\" >> return '\\DC2'\n         , string \"DC3\" >> return '\\DC3'\n         , string \"DC4\" >> return '\\DC4'\n         , string \"NAK\" >> return '\\NAK'\n         , string \"SYN\" >> return '\\SYN'\n         , string \"ETB\" >> return '\\ETB'\n         , string \"CAN\" >> return '\\CAN'\n         , string \"EM\"  >> return '\\EM'\n         , string \"SUB\" >> return '\\SUB'\n         , string \"ESC\" >> return '\\ESC'\n         , string \"FS\"  >> return '\\FS'\n         , string \"GS\"  >> return '\\GS'\n         , string \"RS\"  >> return '\\RS'\n         , string \"US\"  >> return '\\US'\n         , string \"SP\"  >> return '\\SP'\n         , string \"DEL\" >> return '\\DEL'\n         ]\n\n\n-- ---------------------------------------------------------------------------\n-- string literal\n\nlexString :: ReadP Lexeme\nlexString =\n  do _ <- char '\"'\n     body id\n where\n  body f =\n    do (c,esc) <- lexStrItem\n       if c /= '\"' || esc\n         then body (f.(c:))\n         else let s = f \"\" in\n              return (String s)\n\n  lexStrItem = (lexEmpty >> lexStrItem)\n               +++ lexCharE\n\n  lexEmpty =\n    do _ <- char '\\\\'\n       c <- get\n       case c of\n         '&'           -> do return ()\n         _ | isSpace c -> do skipSpaces; _ <- char '\\\\'; return ()\n         _             -> do pfail\n\n-- ---------------------------------------------------------------------------\n--  Lexing numbers\n\ntype Base   = Int\ntype Digits = [Int]\n\nlexNumber :: ReadP Lexeme\nlexNumber\n  = lexHexOct  <++      -- First try for hex or octal 0x, 0o etc\n                        -- If that fails, try for a decimal number\n    lexDecNumber        -- Start with ordinary digits\n\nlexHexOct :: ReadP Lexeme\nlexHexOct\n  = do  _ <- char '0'\n        base <- lexBaseChar\n        digits <- lexDigits base\n        return (Number (MkNumber base digits))\n\nlexBaseChar :: ReadP Int\n-- Lex a single character indicating the base; fail if not there\nlexBaseChar = do { c <- get;\n                   case c of\n                        'o' -> return 8\n                        'O' -> return 8\n                        'x' -> return 16\n                        'X' -> return 16\n                        _   -> pfail }\n\nlexDecNumber :: ReadP Lexeme\nlexDecNumber =\n  do xs    <- lexDigits 10\n     mFrac <- lexFrac <++ return Nothing\n     mExp  <- lexExp  <++ return Nothing\n     return (Number (MkDecimal xs mFrac mExp))\n\nlexFrac :: ReadP (Maybe Digits)\n-- Read the fractional part; fail if it doesn't\n-- start \".d\" where d is a digit\nlexFrac = do _ <- char '.'\n             fraction <- lexDigits 10\n             return (Just fraction)\n\nlexExp :: ReadP (Maybe Integer)\nlexExp = do _ <- char 'e' +++ char 'E'\n            exp <- signedExp +++ lexInteger 10\n            return (Just exp)\n where\n   signedExp\n     = do c <- char '-' +++ char '+'\n          n <- lexInteger 10\n          return (if c == '-' then -n else n)\n\nlexDigits :: Int -> ReadP Digits\n-- Lex a non-empty sequence of digits in specified base\nlexDigits base =\n  do s  <- look\n     xs <- scan s id\n     guard (not (null xs))\n     return xs\n where\n  scan (c:cs) f = case valDig base c of\n                    Just n  -> do _ <- get; scan cs (f.(n:))\n                    Nothing -> do return (f [])\n  scan []     f = do return (f [])\n\nlexInteger :: Base -> ReadP Integer\nlexInteger base =\n  do xs <- lexDigits base\n     return (val (fromIntegral base) xs)\n\nval :: Num a => a -> Digits -> a\nval = valSimple\n{-# RULES\n\"val/Integer\" val = valInteger\n  #-}\n{-# INLINE [1] val #-}\n\n-- The following algorithm is only linear for types whose Num operations\n-- are in constant time.\nvalSimple :: (Num a, Integral d) => a -> [d] -> a\nvalSimple base = go 0\n  where\n    go r [] = r\n    go r (d : ds) = r' `seq` go r' ds\n      where\n        r' = r * base + fromIntegral d\n{-# INLINE valSimple #-}\n\n-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b\n-- digits are combined into a single radix b^2 digit. This process is\n-- repeated until we are left with a single digit. This algorithm\n-- performs well only on large inputs, so we use the simple algorithm\n-- for smaller inputs.\nvalInteger :: Integer -> Digits -> Integer\nvalInteger b0 ds0 = go b0 (length ds0) $ map fromIntegral ds0\n  where\n    go _ _ []  = 0\n    go _ _ [d] = d\n    go b l ds\n        | l > 40 = b' `seq` go b' l' (combine b ds')\n        | otherwise = valSimple b ds\n      where\n        -- ensure that we have an even number of digits\n        -- before we call combine:\n        ds' = if even l then ds else 0 : ds\n        b' = b * b\n        l' = (l + 1) `quot` 2\n    combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)\n      where\n        d = d1 * b + d2\n    combine _ []  = []\n    combine _ [_] = errorWithoutStackTrace \"this should not happen\"\n\n-- Calculate a Rational from the exponent [of 10 to multiply with],\n-- the integral part of the mantissa and the digits of the fractional\n-- part. Leaving the calculation of the power of 10 until the end,\n-- when we know the effective exponent, saves multiplications.\n-- More importantly, this way we need at most one gcd instead of three.\n--\n-- frac was never used with anything but Integer and base 10, so\n-- those are hardcoded now (trivial to change if necessary).\nfracExp :: Integer -> Integer -> Digits -> Rational\nfracExp exp mant []\n  | exp < 0     = mant % (10 ^ (-exp))\n  | otherwise   = fromInteger (mant * 10 ^ exp)\nfracExp exp mant (d:ds) = exp' `seq` mant' `seq` fracExp exp' mant' ds\n  where\n    exp'  = exp - 1\n    mant' = mant * 10 + fromIntegral d\n\nvalDig :: (Eq a, Num a) => a -> Char -> Maybe Int\nvalDig 8 c\n  | '0' <= c && c <= '7' = Just (ord c - ord '0')\n  | otherwise            = Nothing\n\nvalDig 10 c = valDecDig c\n\nvalDig 16 c\n  | '0' <= c && c <= '9' = Just (ord c - ord '0')\n  | 'a' <= c && c <= 'f' = Just (ord c - ord 'a' + 10)\n  | 'A' <= c && c <= 'F' = Just (ord c - ord 'A' + 10)\n  | otherwise            = Nothing\n\nvalDig _ _ = errorWithoutStackTrace \"valDig: Bad base\"\n\nvalDecDig :: Char -> Maybe Int\nvalDecDig c\n  | '0' <= c && c <= '9' = Just (ord c - ord '0')\n  | otherwise            = Nothing\n\n-- ----------------------------------------------------------------------\n-- other numeric lexing functions\n\nreadIntP :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a\nreadIntP base isDigit valDigit =\n  do s <- munch1 isDigit\n     return (val base (map valDigit s))\n{-# SPECIALISE readIntP\n        :: Integer -> (Char -> Bool) -> (Char -> Int) -> ReadP Integer #-}\n\nreadIntP' :: (Eq a, Num a) => a -> ReadP a\nreadIntP' base = readIntP base isDigit valDigit\n where\n  isDigit  c = maybe False (const True) (valDig base c)\n  valDigit c = maybe 0     id           (valDig base c)\n{-# SPECIALISE readIntP' :: Integer -> ReadP Integer #-}\n\nreadOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a\nreadOctP = readIntP' 8\nreadDecP = readIntP' 10\nreadHexP = readIntP' 16\n{-# SPECIALISE readOctP :: ReadP Integer #-}\n{-# SPECIALISE readDecP :: ReadP Integer #-}\n{-# SPECIALISE readHexP :: ReadP Integer #-}\n", "num_lines": 586}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- This module deliberately declares orphan instances:\n{-# OPTIONS_GHC -Wno-orphans #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Text.Show.Functions\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- Optional instance of 'Text.Show.Show' for functions:\n--\n-- > instance Show (a -> b) where\n-- >    showsPrec _ _ = showString \"<function>\"\n--\n-----------------------------------------------------------------------------\n\nmodule Text.Show.Functions () where\n\n-- | @since 2.01\ninstance Show (a -> b) where\n        showsPrec _ _ = showString \"<function>\"\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE PatternSynonyms #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Type.Reflection\n-- Copyright   :  (c) The University of Glasgow, CWI 2001--2017\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (requires GADTs and compiler support)\n--\n-- This provides a type-indexed type representation mechanism, similar to that\n-- described by,\n--\n-- * Simon Peyton-Jones, Stephanie Weirich, Richard Eisenberg,\n-- Dimitrios Vytiniotis. \"A reflection on types.\"\n-- /Proc. Philip Wadler's 60th birthday Festschrift/, Edinburgh (April 2016).\n--\n-- The interface provides 'I.TypeRep', a type representation which can\n-- be safely decomposed and composed. See \"Data.Dynamic\" for an example of this.\n--\n-- @since 4.10.0.0\n--\n-----------------------------------------------------------------------------\nmodule Type.Reflection\n    ( -- * The Typeable class\n      I.Typeable\n    , I.typeRep\n    , I.withTypeable\n\n      -- * Propositional equality\n    , (:~:)(Refl)\n    , (:~~:)(HRefl)\n\n      -- * Type representations\n      -- ** Type-Indexed\n    , I.TypeRep\n    , I.typeOf\n    , pattern I.App, pattern I.Con, pattern I.Con', pattern I.Fun\n    , I.typeRepTyCon\n    , I.rnfTypeRep\n    , I.eqTypeRep\n    , I.typeRepKind\n    , I.splitApps\n\n      -- ** Quantified\n      --\n      -- \"Data.Typeable\" exports a variant of this interface (named differently\n      -- for backwards compatibility).\n    , I.SomeTypeRep(..)\n    , I.someTypeRep\n    , I.someTypeRepTyCon\n    , I.rnfSomeTypeRep\n\n      -- * Type constructors\n    , I.TyCon           -- abstract, instance of: Eq, Show, Typeable\n                        -- For now don't export Module, to avoid name clashes\n    , I.tyConPackage\n    , I.tyConModule\n    , I.tyConName\n    , I.rnfTyCon\n\n      -- * Module names\n    , I.Module\n    , I.moduleName, I.modulePackage, I.rnfModule\n    ) where\n\nimport qualified Data.Typeable.Internal as I\nimport Data.Type.Equality\n", "num_lines": 73}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Type.Reflection.Unsafe\n-- Copyright   :  (c) The University of Glasgow, CWI 2001--2015\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- The representations of the types 'TyCon' and 'TypeRep', and the function\n-- 'mkTyCon' which is used by derived instances of 'Typeable' to construct\n-- 'TyCon's.\n--\n-- Be warned, these functions can be used to construct ill-kinded\n-- type representations.\n--\n-----------------------------------------------------------------------------\n{-# LANGUAGE PolyKinds, DataKinds, ScopedTypeVariables #-}\n\nmodule Type.Reflection.Unsafe (\n      -- * Type representations\n      TypeRep, mkTrApp, mkTyCon, typeRepFingerprint, someTypeRepFingerprint\n      -- * Kind representations\n    , KindRep(..), TypeLitSort(..)\n      -- * Type constructors\n    , TyCon, mkTrCon, tyConKindRep, tyConKindArgs, tyConFingerprint\n  ) where\n\nimport Data.Typeable.Internal hiding (mkTrApp)\nimport qualified Data.Typeable.Internal as TI\n\n-- | Construct a representation for a type application.\nmkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n           TypeRep (a :: k1 -> k2)\n        -> TypeRep (b :: k1)\n        -> TypeRep (a b)\nmkTrApp = TI.mkTrAppChecked\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Unsafe.Coerce\n-- Copyright   :  Malcolm Wallace 2006\n-- License     :  BSD-style (see the LICENSE file in the distribution)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The highly unsafe primitive 'unsafeCoerce' converts a value from any\n-- type to any other type.  Needless to say, if you use this function,\n-- it is your responsibility to ensure that the old and new types have\n-- identical internal representations, in order to prevent runtime corruption.\n--\n-- The types for which 'unsafeCoerce' is representation-safe may differ\n-- from compiler to compiler (and version to version).\n--\n--   * Documentation for correct usage in GHC will be found under\n--     'unsafeCoerce#' in \"GHC.Base\" (around which 'unsafeCoerce' is just a\n--     trivial wrapper).\n--\n--   * In nhc98, the only representation-safe coercions are between\n--     'Prelude.Enum' types with the same range (e.g. 'Prelude.Int',\n--     'Data.Int.Int32', 'Prelude.Char', 'Data.Word.Word32'), or between a\n--     newtype and the type that it wraps.\n--\n-----------------------------------------------------------------------------\n\nmodule Unsafe.Coerce (unsafeCoerce) where\n\nimport GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base\nimport GHC.Natural () -- See Note [Depend on GHC.Natural] in GHC.Base\nimport GHC.Prim (unsafeCoerce#)\n\nlocal_id :: a -> a\nlocal_id x = x   -- See Note [Mega-hack for coerce]\n\n{- Note [Mega-hack for coerce]\n\nIf we just say\n  unsafeCoerce x = unsafeCoerce# x\nthen the simple-optimiser that the desugarer runs will eta-reduce to\n  unsafeCoerce :: forall (a:*) (b:*). a -> b\n  unsafeCoerce = unsafeCoerce#\nBut we shouldn't be calling unsafeCoerce# in a higher\norder way; it has a compulsory unfolding\n   unsafeCoerce# a b x = x |> UnsafeCo a b\nand we really rely on it being inlined pronto. But the simple-optimiser doesn't.\nThe identity function local_id delays the eta reduction just long enough\nfor unsafeCoerce# to get inlined.\n\nSigh. This is horrible, but then so is unsafeCoerce.\n-}\n\nunsafeCoerce :: a -> b\nunsafeCoerce x = local_id (unsafeCoerce# x)\n  -- See Note [Unsafe coerce magic] in basicTypes/MkId\n  -- NB: Do not eta-reduce this definition (see above)\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n-- | See @GHC.LanguageExtensions@ for an explanation\n-- on why this is needed\nmodule GHC.ForeignSrcLang\n  ( module GHC.ForeignSrcLang.Type\n  ) where\n\nimport Data.Binary\nimport GHC.ForeignSrcLang.Type\n\ninstance Binary ForeignSrcLang\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | See GHC #10762 and #15021.\nmodule GHC.HandleEncoding (configureHandleEncoding) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHC.IO.Encoding (textEncodingName)\nimport System.Environment\nimport System.IO\n\n-- | Handle GHC-specific character encoding flags, allowing us to control how\n-- GHC produces output regardless of OS.\nconfigureHandleEncoding :: IO ()\nconfigureHandleEncoding = do\n   env <- getEnvironment\n   case lookup \"GHC_CHARENC\" env of\n    Just \"UTF-8\" -> do\n     hSetEncoding stdout utf8\n     hSetEncoding stderr utf8\n    _ -> do\n     -- Avoid GHC erroring out when trying to display unhandled characters\n     hSetTranslit stdout\n     hSetTranslit stderr\n\n-- | Change the character encoding of the given Handle to transliterate\n-- on unsupported characters instead of throwing an exception\nhSetTranslit :: Handle -> IO ()\nhSetTranslit h = do\n    menc <- hGetEncoding h\n    case fmap textEncodingName menc of\n        Just name | '/' `notElem` name -> do\n            enc' <- mkTextEncoding $ name ++ \"//TRANSLIT\"\n            hSetEncoding h enc'\n        _ -> return ()\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n-- | This module re-exports the 'Extension' type along with an orphan 'Binary'\n-- instance for it.\n--\n-- Note that the @ghc-boot@ package has a large set of dependencies; for this\n-- reason the 'Extension' type itself is defined in the\n-- \"GHC.LanguageExtensions.Type\" module provided by the @ghc-boot-th@ package,\n-- which has no dependencies outside of @base@. For this reason\n-- @template-haskell@ depends upon @ghc-boot-th@, not @ghc-boot@.\n--\nmodule GHC.LanguageExtensions ( module GHC.LanguageExtensions.Type ) where\n\nimport Data.Binary\nimport GHC.LanguageExtensions.Type\n\ninstance Binary Extension\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveFoldable #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TupleSections #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.PackageDb\n-- Copyright   :  (c) The University of Glasgow 2009, Duncan Coutts 2014\n--\n-- Maintainer  :  ghc-devs@haskell.org\n-- Portability :  portable\n--\n-- This module provides the view of GHC's database of registered packages that\n-- is shared between GHC the compiler\\/library, and the ghc-pkg program. It\n-- defines the database format that is shared between GHC and ghc-pkg.\n--\n-- The database format, and this library are constructed so that GHC does not\n-- have to depend on the Cabal library. The ghc-pkg program acts as the\n-- gateway between the external package format (which is defined by Cabal) and\n-- the internal package format which is specialised just for GHC.\n--\n-- GHC the compiler only needs some of the information which is kept about\n-- registerd packages, such as module names, various paths etc. On the other\n-- hand ghc-pkg has to keep all the information from Cabal packages and be able\n-- to regurgitate it for users and other tools.\n--\n-- The first trick is that we duplicate some of the information in the package\n-- database. We essentially keep two versions of the datbase in one file, one\n-- version used only by ghc-pkg which keeps the full information (using the\n-- serialised form of the 'InstalledPackageInfo' type defined by the Cabal\n-- library); and a second version written by ghc-pkg and read by GHC which has\n-- just the subset of information that GHC needs.\n--\n-- The second trick is that this module only defines in detail the format of\n-- the second version -- the bit GHC uses -- and the part managed by ghc-pkg\n-- is kept in the file but here we treat it as an opaque blob of data. That way\n-- this library avoids depending on Cabal.\n--\nmodule GHC.PackageDb (\n       InstalledPackageInfo(..),\n       DbModule(..),\n       DbUnitId(..),\n       BinaryStringRep(..),\n       DbUnitIdModuleRep(..),\n       emptyInstalledPackageInfo,\n       PackageDbLock,\n       lockPackageDb,\n       unlockPackageDb,\n       DbMode(..),\n       DbOpenMode(..),\n       isDbOpenReadMode,\n       readPackageDbForGhc,\n       readPackageDbForGhcPkg,\n       writePackageDb\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Data.Version (Version(..))\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Char8 as BS.Char8\nimport qualified Data.ByteString.Lazy as BS.Lazy\nimport qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)\nimport qualified Data.Foldable as F\nimport qualified Data.Traversable as F\nimport Data.Binary as Bin\nimport Data.Binary.Put as Bin\nimport Data.Binary.Get as Bin\nimport Control.Exception as Exception\nimport Control.Monad (when)\nimport System.FilePath\nimport System.IO\nimport System.IO.Error\nimport GHC.IO.Exception (IOErrorType(InappropriateType))\nimport GHC.IO.Handle.Lock\nimport System.Directory\n\n\n-- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits\n-- that GHC is interested in.  See Cabal's documentation for a more detailed\n-- description of all of the fields.\n--\ndata InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod\n   = InstalledPackageInfo {\n       unitId             :: instunitid,\n       componentId        :: compid,\n       instantiatedWith   :: [(modulename, mod)],\n       sourcePackageId    :: srcpkgid,\n       packageName        :: srcpkgname,\n       packageVersion     :: Version,\n       sourceLibName      :: Maybe srcpkgname,\n       abiHash            :: String,\n       depends            :: [instunitid],\n       -- | Like 'depends', but each dependency is annotated with the\n       -- ABI hash we expect the dependency to respect.\n       abiDepends         :: [(instunitid, String)],\n       importDirs         :: [FilePath],\n       hsLibraries        :: [String],\n       extraLibraries     :: [String],\n       extraGHCiLibraries :: [String],\n       libraryDirs        :: [FilePath],\n       libraryDynDirs     :: [FilePath],\n       frameworks         :: [String],\n       frameworkDirs      :: [FilePath],\n       ldOptions          :: [String],\n       ccOptions          :: [String],\n       includes           :: [String],\n       includeDirs        :: [FilePath],\n       haddockInterfaces  :: [FilePath],\n       haddockHTMLs       :: [FilePath],\n       exposedModules     :: [(modulename, Maybe mod)],\n       hiddenModules      :: [modulename],\n       indefinite         :: Bool,\n       exposed            :: Bool,\n       trusted            :: Bool\n     }\n  deriving (Eq, Show)\n\n-- | A convenience constraint synonym for common constraints over parameters\n-- to 'InstalledPackageInfo'.\ntype RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =\n    (BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,\n     BinaryStringRep modulename, BinaryStringRep compid,\n     BinaryStringRep instunitid,\n     DbUnitIdModuleRep instunitid compid unitid modulename mod)\n\n-- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.\n-- There is only one type class because these types are mutually recursive.\n-- NB: The functional dependency helps out type inference in cases\n-- where types would be ambiguous.\nclass DbUnitIdModuleRep instunitid compid unitid modulename mod\n    | mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid\n    where\n  fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod\n  toDbModule :: mod -> DbModule instunitid compid unitid modulename mod\n  fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid\n  toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod\n\n-- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.\n-- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.\n-- It has phantom type parameters as this is the most convenient way\n-- to avoid undecidable instances.\ndata DbModule instunitid compid unitid modulename mod\n   = DbModule {\n       dbModuleUnitId :: unitid,\n       dbModuleName :: modulename\n     }\n   | DbModuleVar {\n       dbModuleVarName :: modulename\n     }\n  deriving (Eq, Show)\n\n-- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.\n-- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.\n-- It has phantom type parameters as this is the most convenient way\n-- to avoid undecidable instances.\ndata DbUnitId instunitid compid unitid modulename mod\n   = DbUnitId compid [(modulename, mod)]\n   | DbInstalledUnitId instunitid\n  deriving (Eq, Show)\n\nclass BinaryStringRep a where\n  fromStringRep :: BS.ByteString -> a\n  toStringRep   :: a -> BS.ByteString\n\nemptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g\n                          => InstalledPackageInfo a b c d e f g\nemptyInstalledPackageInfo =\n  InstalledPackageInfo {\n       unitId             = fromStringRep BS.empty,\n       componentId        = fromStringRep BS.empty,\n       instantiatedWith   = [],\n       sourcePackageId    = fromStringRep BS.empty,\n       packageName        = fromStringRep BS.empty,\n       packageVersion     = Version [] [],\n       sourceLibName      = Nothing,\n       abiHash            = \"\",\n       depends            = [],\n       abiDepends         = [],\n       importDirs         = [],\n       hsLibraries        = [],\n       extraLibraries     = [],\n       extraGHCiLibraries = [],\n       libraryDirs        = [],\n       libraryDynDirs     = [],\n       frameworks         = [],\n       frameworkDirs      = [],\n       ldOptions          = [],\n       ccOptions          = [],\n       includes           = [],\n       includeDirs        = [],\n       haddockInterfaces  = [],\n       haddockHTMLs       = [],\n       exposedModules     = [],\n       hiddenModules      = [],\n       indefinite         = False,\n       exposed            = False,\n       trusted            = False\n  }\n\n-- | Represents a lock of a package db.\nnewtype PackageDbLock = PackageDbLock Handle\n\n-- | Acquire an exclusive lock related to package DB under given location.\nlockPackageDb :: FilePath -> IO PackageDbLock\n\n-- | Release the lock related to package DB.\nunlockPackageDb :: PackageDbLock -> IO ()\n\n-- | Acquire a lock of given type related to package DB under given location.\nlockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock\nlockPackageDbWith mode file = do\n  -- We are trying to open the lock file and then lock it. Thus the lock file\n  -- needs to either exist or we need to be able to create it. Ideally we\n  -- would not assume that the lock file always exists in advance. When we are\n  -- dealing with a package DB where we have write access then if the lock\n  -- file does not exist then we can create it by opening the file in\n  -- read/write mode. On the other hand if we are dealing with a package DB\n  -- where we do not have write access (e.g. a global DB) then we can only\n  -- open in read mode, and the lock file had better exist already or we're in\n  -- trouble. So for global read-only DBs on platforms where we must lock the\n  -- DB for reading then we will require that the installer/packaging has\n  -- included the lock file.\n  --\n  -- Thus the logic here is to first try opening in read-write mode\n  -- and if that fails we try read-only (to handle global read-only DBs).\n  -- If either succeed then lock the file. IO exceptions (other than the first\n  -- open attempt failing due to the file not existing) simply propagate.\n  --\n  -- Note that there is a complexity here which was discovered in #13945: some\n  -- filesystems (e.g. NFS) will only allow exclusive locking if the fd was\n  -- opened for write access. We would previously try opening the lockfile for\n  -- read-only access first, however this failed when run on such filesystems.\n  -- Consequently, we now try read-write access first, falling back to read-only\n  -- if we are denied permission (e.g. in the case of a global database).\n  catchJust\n    (\\e -> if isPermissionError e then Just () else Nothing)\n    (lockFileOpenIn ReadWriteMode)\n    (const $ lockFileOpenIn ReadMode)\n  where\n    lock = file <.> \"lock\"\n\n    lockFileOpenIn io_mode = bracketOnError\n      (openBinaryFile lock io_mode)\n      hClose\n      -- If file locking support is not available, ignore the error and proceed\n      -- normally. Without it the only thing we lose on non-Windows platforms is\n      -- the ability to safely issue concurrent updates to the same package db.\n      $ \\hnd -> do hLock hnd mode `catch` \\FileLockingNotSupported -> return ()\n                   return $ PackageDbLock hnd\n\nlockPackageDb = lockPackageDbWith ExclusiveLock\nunlockPackageDb (PackageDbLock hnd) = do\n    hUnlock hnd\n    hClose hnd\n\n-- | Mode to open a package db in.\ndata DbMode = DbReadOnly | DbReadWrite\n\n-- | 'DbOpenMode' holds a value of type @t@ but only in 'DbReadWrite' mode.  So\n-- it is like 'Maybe' but with a type argument for the mode to enforce that the\n-- mode is used consistently.\ndata DbOpenMode (mode :: DbMode) t where\n  DbOpenReadOnly  ::      DbOpenMode 'DbReadOnly t\n  DbOpenReadWrite :: t -> DbOpenMode 'DbReadWrite t\n\nderiving instance Functor (DbOpenMode mode)\nderiving instance F.Foldable (DbOpenMode mode)\nderiving instance F.Traversable (DbOpenMode mode)\n\nisDbOpenReadMode :: DbOpenMode mode t -> Bool\nisDbOpenReadMode = \\case\n  DbOpenReadOnly    -> True\n  DbOpenReadWrite{} -> False\n\n-- | Read the part of the package DB that GHC is interested in.\n--\nreadPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>\n                       FilePath -> IO [InstalledPackageInfo a b c d e f g]\nreadPackageDbForGhc file =\n  decodeFromFile file DbOpenReadOnly getDbForGhc >>= \\case\n    (pkgs, DbOpenReadOnly) -> return pkgs\n  where\n    getDbForGhc = do\n      _version    <- getHeader\n      _ghcPartLen <- get :: Get Word32\n      ghcPart     <- get\n      -- the next part is for ghc-pkg, but we stop here.\n      return ghcPart\n\n-- | Read the part of the package DB that ghc-pkg is interested in\n--\n-- Note that the Binary instance for ghc-pkg's representation of packages\n-- is not defined in this package. This is because ghc-pkg uses Cabal types\n-- (and Binary instances for these) which this package does not depend on.\n--\n-- If we open the package db in read only mode, we get its contents. Otherwise\n-- we additionally receive a PackageDbLock that represents a lock on the\n-- database, so that we can safely update it later.\n--\nreadPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->\n                          IO (pkgs, DbOpenMode mode PackageDbLock)\nreadPackageDbForGhcPkg file mode =\n    decodeFromFile file mode getDbForGhcPkg\n  where\n    getDbForGhcPkg = do\n      _version    <- getHeader\n      -- skip over the ghc part\n      ghcPartLen  <- get :: Get Word32\n      _ghcPart    <- skip (fromIntegral ghcPartLen)\n      -- the next part is for ghc-pkg\n      ghcPkgPart  <- get\n      return ghcPkgPart\n\n-- | Write the whole of the package DB, both parts.\n--\nwritePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d e f g) =>\n                  FilePath -> [InstalledPackageInfo a b c d e f g] ->\n                  pkgs -> IO ()\nwritePackageDb file ghcPkgs ghcPkgPart =\n  writeFileAtomic file (runPut putDbForGhcPkg)\n  where\n    putDbForGhcPkg = do\n        putHeader\n        put               ghcPartLen\n        putLazyByteString ghcPart\n        put               ghcPkgPart\n      where\n        ghcPartLen :: Word32\n        ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)\n        ghcPart    = encode ghcPkgs\n\ngetHeader :: Get (Word32, Word32)\ngetHeader = do\n    magic <- getByteString (BS.length headerMagic)\n    when (magic /= headerMagic) $\n      fail \"not a ghc-pkg db file, wrong file magic number\"\n\n    majorVersion <- get :: Get Word32\n    -- The major version is for incompatible changes\n\n    minorVersion <- get :: Get Word32\n    -- The minor version is for compatible extensions\n\n    when (majorVersion /= 1) $\n      fail \"unsupported ghc-pkg db format version\"\n    -- If we ever support multiple major versions then we'll have to change\n    -- this code\n\n    -- The header can be extended without incrementing the major version,\n    -- we ignore fields we don't know about (currently all).\n    headerExtraLen <- get :: Get Word32\n    skip (fromIntegral headerExtraLen)\n\n    return (majorVersion, minorVersion)\n\nputHeader :: Put\nputHeader = do\n    putByteString headerMagic\n    put majorVersion\n    put minorVersion\n    put headerExtraLen\n  where\n    majorVersion   = 1 :: Word32\n    minorVersion   = 0 :: Word32\n    headerExtraLen = 0 :: Word32\n\nheaderMagic :: BS.ByteString\nheaderMagic = BS.Char8.pack \"\\0ghcpkg\\0\"\n\n\n-- TODO: we may be able to replace the following with utils from the binary\n-- package in future.\n\n-- | Feed a 'Get' decoder with data chunks from a file.\n--\ndecodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->\n                  IO (pkgs, DbOpenMode mode PackageDbLock)\ndecodeFromFile file mode decoder = case mode of\n  DbOpenReadOnly -> do\n  -- When we open the package db in read only mode, there is no need to acquire\n  -- shared lock on non-Windows platform because we update the database with an\n  -- atomic rename, so readers will always see the database in a consistent\n  -- state.\n#if defined(mingw32_HOST_OS)\n    bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \\_ -> do\n#endif\n      (, DbOpenReadOnly) <$> decodeFileContents\n  DbOpenReadWrite{} -> do\n    -- When we open the package db in read/write mode, acquire an exclusive lock\n    -- on the database and return it so we can keep it for the duration of the\n    -- update.\n    bracketOnError (lockPackageDb file) unlockPackageDb $ \\lock -> do\n      (, DbOpenReadWrite lock) <$> decodeFileContents\n  where\n    decodeFileContents = withBinaryFile file ReadMode $ \\hnd ->\n      feed hnd (runGetIncremental decoder)\n\n    feed hnd (Partial k)  = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize\n                               if BS.null chunk\n                                 then feed hnd (k Nothing)\n                                 else feed hnd (k (Just chunk))\n    feed _ (Done _ _ res) = return res\n    feed _ (Fail _ _ msg) = ioError err\n      where\n        err = mkIOError InappropriateType loc Nothing (Just file)\n              `ioeSetErrorString` msg\n        loc = \"GHC.PackageDb.readPackageDb\"\n\n-- Copied from Cabal's Distribution.Simple.Utils.\nwriteFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()\nwriteFileAtomic targetPath content = do\n  let (targetDir, targetFile) = splitFileName targetPath\n  Exception.bracketOnError\n    (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> \"tmp\")\n    (\\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)\n    (\\(tmpPath, handle) -> do\n        BS.Lazy.hPut handle content\n        hClose handle\n        renameFile tmpPath targetPath)\n\ninstance (RepInstalledPackageInfo a b c d e f g) =>\n         Binary (InstalledPackageInfo a b c d e f g) where\n  put (InstalledPackageInfo\n         unitId componentId instantiatedWith sourcePackageId\n         packageName packageVersion\n         sourceLibName\n         abiHash depends abiDepends importDirs\n         hsLibraries extraLibraries extraGHCiLibraries\n         libraryDirs libraryDynDirs\n         frameworks frameworkDirs\n         ldOptions ccOptions\n         includes includeDirs\n         haddockInterfaces haddockHTMLs\n         exposedModules hiddenModules\n         indefinite exposed trusted) = do\n    put (toStringRep sourcePackageId)\n    put (toStringRep packageName)\n    put packageVersion\n    put (fmap toStringRep sourceLibName)\n    put (toStringRep unitId)\n    put (toStringRep componentId)\n    put (map (\\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))\n             instantiatedWith)\n    put abiHash\n    put (map toStringRep depends)\n    put (map (\\(k,v) -> (toStringRep k, v)) abiDepends)\n    put importDirs\n    put hsLibraries\n    put extraLibraries\n    put extraGHCiLibraries\n    put libraryDirs\n    put libraryDynDirs\n    put frameworks\n    put frameworkDirs\n    put ldOptions\n    put ccOptions\n    put includes\n    put includeDirs\n    put haddockInterfaces\n    put haddockHTMLs\n    put (map (\\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))\n             exposedModules)\n    put (map toStringRep hiddenModules)\n    put indefinite\n    put exposed\n    put trusted\n\n  get = do\n    sourcePackageId    <- get\n    packageName        <- get\n    packageVersion     <- get\n    sourceLibName      <- get\n    unitId             <- get\n    componentId        <- get\n    instantiatedWith   <- get\n    abiHash            <- get\n    depends            <- get\n    abiDepends         <- get\n    importDirs         <- get\n    hsLibraries        <- get\n    extraLibraries     <- get\n    extraGHCiLibraries <- get\n    libraryDirs        <- get\n    libraryDynDirs     <- get\n    frameworks         <- get\n    frameworkDirs      <- get\n    ldOptions          <- get\n    ccOptions          <- get\n    includes           <- get\n    includeDirs        <- get\n    haddockInterfaces  <- get\n    haddockHTMLs       <- get\n    exposedModules     <- get\n    hiddenModules      <- get\n    indefinite         <- get\n    exposed            <- get\n    trusted            <- get\n    return (InstalledPackageInfo\n              (fromStringRep unitId)\n              (fromStringRep componentId)\n              (map (\\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))\n                instantiatedWith)\n              (fromStringRep sourcePackageId)\n              (fromStringRep packageName) packageVersion\n              (fmap fromStringRep sourceLibName)\n              abiHash\n              (map fromStringRep depends)\n              (map (\\(k,v) -> (fromStringRep k, v)) abiDepends)\n              importDirs\n              hsLibraries extraLibraries extraGHCiLibraries\n              libraryDirs libraryDynDirs\n              frameworks frameworkDirs\n              ldOptions ccOptions\n              includes includeDirs\n              haddockInterfaces haddockHTMLs\n              (map (\\(mod_name, mb_mod) ->\n                        (fromStringRep mod_name, fmap fromDbModule mb_mod))\n                   exposedModules)\n              (map fromStringRep hiddenModules)\n              indefinite exposed trusted)\n\ninstance (BinaryStringRep modulename, BinaryStringRep compid,\n          BinaryStringRep instunitid,\n          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>\n         Binary (DbModule instunitid compid unitid modulename mod) where\n  put (DbModule dbModuleUnitId dbModuleName) = do\n    putWord8 0\n    put (toDbUnitId dbModuleUnitId)\n    put (toStringRep dbModuleName)\n  put (DbModuleVar dbModuleVarName) = do\n    putWord8 1\n    put (toStringRep dbModuleVarName)\n  get = do\n    b <- getWord8\n    case b of\n      0 -> do dbModuleUnitId <- get\n              dbModuleName <- get\n              return (DbModule (fromDbUnitId dbModuleUnitId)\n                               (fromStringRep dbModuleName))\n      _ -> do dbModuleVarName <- get\n              return (DbModuleVar (fromStringRep dbModuleVarName))\n\ninstance (BinaryStringRep modulename, BinaryStringRep compid,\n          BinaryStringRep instunitid,\n          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>\n         Binary (DbUnitId instunitid compid unitid modulename mod) where\n  put (DbInstalledUnitId instunitid) = do\n    putWord8 0\n    put (toStringRep instunitid)\n  put (DbUnitId dbUnitIdComponentId dbUnitIdInsts) = do\n    putWord8 1\n    put (toStringRep dbUnitIdComponentId)\n    put (map (\\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod)) dbUnitIdInsts)\n  get = do\n    b <- getWord8\n    case b of\n      0 -> do\n        instunitid <- get\n        return (DbInstalledUnitId (fromStringRep instunitid))\n      _ -> do\n        dbUnitIdComponentId <- get\n        dbUnitIdInsts <- get\n        return (DbUnitId\n            (fromStringRep dbUnitIdComponentId)\n            (map (\\(mod_name, mod) -> ( fromStringRep mod_name\n                                      , fromDbModule mod))\n                 dbUnitIdInsts))\n", "num_lines": 578}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n\n--\n-- (c) The University of Glasgow 2002-2006\n--\n-- Serialized values\n\nmodule GHC.Serialized (\n    -- * Main Serialized data type\n    Serialized(..),\n\n    -- * Going into and out of 'Serialized'\n    toSerialized, fromSerialized,\n\n    -- * Handy serialization functions\n    serializeWithData, deserializeWithData,\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Data.Bits\nimport Data.Word        ( Word8 )\nimport Data.Data\n\n\n-- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types\ndata Serialized = Serialized TypeRep [Word8]\n\n-- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later\ntoSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized\ntoSerialized serialize what = Serialized (typeOf what) (serialize what)\n\n-- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that.\n-- Otherwise return @Nothing@.\nfromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a\nfromSerialized deserialize (Serialized the_type bytes)\n  | the_type == rep = Just (deserialize bytes)\n  | otherwise       = Nothing\n  where rep = typeRep (Proxy :: Proxy a)\n\n-- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData'\nserializeWithData :: Data a => a -> [Word8]\nserializeWithData what = serializeWithData' what []\n\nserializeWithData' :: Data a => a -> [Word8] -> [Word8]\nserializeWithData' what = fst $ gfoldl (\\(before, a_to_b) a -> (before . serializeWithData' a, a_to_b a))\n                                       (\\x -> (serializeConstr (constrRep (toConstr what)), x))\n                                       what\n\n-- | Use a 'Data' instance to implement a deserialization scheme dual to that of 'serializeWithData'\ndeserializeWithData :: Data a => [Word8] -> a\ndeserializeWithData = snd . deserializeWithData'\n\ndeserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a)\ndeserializeWithData' bytes = deserializeConstr bytes $ \\constr_rep bytes ->\n                             gunfold (\\(bytes, b_to_r) -> let (bytes', b) = deserializeWithData' bytes in (bytes', b_to_r b))\n                                     (\\x -> (bytes, x))\n                                     (repConstr (dataTypeOf (undefined :: a)) constr_rep)\n\n\nserializeConstr :: ConstrRep -> [Word8] -> [Word8]\nserializeConstr (AlgConstr ix)   = serializeWord8 1 . serializeInt ix\nserializeConstr (IntConstr i)    = serializeWord8 2 . serializeInteger i\nserializeConstr (FloatConstr r)  = serializeWord8 3 . serializeRational r\nserializeConstr (CharConstr c)   = serializeWord8 4 . serializeChar c\n\n\ndeserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a\ndeserializeConstr bytes k = deserializeWord8 bytes $ \\constr_ix bytes ->\n                            case constr_ix of\n                                1 -> deserializeInt      bytes $ \\ix -> k (AlgConstr ix)\n                                2 -> deserializeInteger  bytes $ \\i  -> k (IntConstr i)\n                                3 -> deserializeRational bytes $ \\r  -> k (FloatConstr r)\n                                4 -> deserializeChar     bytes $ \\c  -> k (CharConstr c)\n                                x -> error $ \"deserializeConstr: unrecognised serialized constructor type \" ++ show x ++ \" in context \" ++ show bytes\n\n\nserializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]\nserializeFixedWidthNum what = go (finiteBitSize what) what\n  where\n    go :: Int -> a -> [Word8] -> [Word8]\n    go size current rest\n      | size <= 0 = rest\n      | otherwise = fromIntegral (current .&. 255) : go (size - 8) (current `shiftR` 8) rest\n\ndeserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b\ndeserializeFixedWidthNum bytes k = go (finiteBitSize (undefined :: a)) bytes k\n  where\n    go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b\n    go size bytes k\n      | size <= 0 = k 0 bytes\n      | otherwise = case bytes of\n                        (byte:bytes) -> go (size - 8) bytes (\\x -> k ((x `shiftL` 8) .|. fromIntegral byte))\n                        []           -> error \"deserializeFixedWidthNum: unexpected end of stream\"\n\n\nserializeEnum :: (Enum a) => a -> [Word8] -> [Word8]\nserializeEnum = serializeInt . fromEnum\n\ndeserializeEnum :: Enum a => [Word8] -> (a -> [Word8] -> b) -> b\ndeserializeEnum bytes k = deserializeInt bytes (k . toEnum)\n\n\nserializeWord8 :: Word8 -> [Word8] -> [Word8]\nserializeWord8 x = (x:)\n\ndeserializeWord8 :: [Word8] -> (Word8 -> [Word8] -> a) -> a\ndeserializeWord8 (byte:bytes) k = k byte bytes\ndeserializeWord8 []           _ = error \"deserializeWord8: unexpected end of stream\"\n\n\nserializeInt :: Int -> [Word8] -> [Word8]\nserializeInt = serializeFixedWidthNum\n\ndeserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a\ndeserializeInt = deserializeFixedWidthNum\n\n\nserializeRational :: (Real a) => a -> [Word8] -> [Word8]\nserializeRational = serializeString . show . toRational\n\ndeserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b\ndeserializeRational bytes k = deserializeString bytes (k . fromRational . read)\n\n\nserializeInteger :: Integer -> [Word8] -> [Word8]\nserializeInteger = serializeString . show\n\ndeserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a\ndeserializeInteger bytes k = deserializeString bytes (k . read)\n\n\nserializeChar :: Char -> [Word8] -> [Word8]\nserializeChar = serializeString . show\n\ndeserializeChar :: [Word8] -> (Char -> [Word8] -> a) -> a\ndeserializeChar bytes k = deserializeString bytes (k . read)\n\n\nserializeString :: String -> [Word8] -> [Word8]\nserializeString = serializeList serializeEnum\n\ndeserializeString :: [Word8] -> (String -> [Word8] -> a) -> a\ndeserializeString = deserializeList deserializeEnum\n\n\nserializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]\nserializeList serialize_element xs = serializeInt (length xs) . foldr (.) id (map serialize_element xs)\n\ndeserializeList :: forall a b. (forall c. [Word8] -> (a -> [Word8] -> c) -> c)\n                -> [Word8] -> ([a] -> [Word8] -> b) -> b\ndeserializeList deserialize_element bytes k = deserializeInt bytes $ \\len bytes -> go len bytes k\n  where\n    go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b\n    go len bytes k\n      | len <= 0  = k [] bytes\n      | otherwise = deserialize_element bytes (\\elt bytes -> go (len - 1) bytes (k . (elt:)))\n", "num_lines": 159}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Lexeme\n-- Copyright   :  (c) The GHC Team\n--\n-- Maintainer  :  ghc-devs@haskell.org\n-- Portability :  portable\n--\n-- Functions to evaluate whether or not a string is a valid identifier.\n--\nmodule GHC.Lexeme (\n          -- * Lexical characteristics of Haskell names\n        startsVarSym, startsVarId, startsConSym, startsConId,\n        startsVarSymASCII, isVarSymChar, okSymChar\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Data.Char\n\n-- | Is this character acceptable in a symbol (after the first char)?\n-- See alexGetByte in Lexer.x\nokSymChar :: Char -> Bool\nokSymChar c\n  | c `elem` \"(),;[]`{}_\\\"'\"\n  = False\n  | otherwise\n  = case generalCategory c of\n      ConnectorPunctuation -> True\n      DashPunctuation      -> True\n      OtherPunctuation     -> True\n      MathSymbol           -> True\n      CurrencySymbol       -> True\n      ModifierSymbol       -> True\n      OtherSymbol          -> True\n      _                    -> False\n\nstartsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool\nstartsVarSym c = okSymChar c\u00c2\u00a0&& c /= ':' -- Infix Ids\nstartsConSym c = c == ':'                -- Infix data constructors\nstartsVarId c  = c == '_' || case generalCategory c of  -- Ordinary Ids\n  LowercaseLetter -> True\n  OtherLetter     -> True   -- See #1103\n  _               -> False\nstartsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors\n\nstartsVarSymASCII :: Char -> Bool\nstartsVarSymASCII c = c `elem` \"!#$%&*+./<=>?@\\\\^|~-\"\n\nisVarSymChar :: Char -> Bool\nisVarSymChar c = c == ':' || startsVarSym c\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\nmodule GHC.ForeignSrcLang.Type\n  ( ForeignSrcLang(..)\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHC.Generics (Generic)\n\n-- | Foreign formats supported by GHC via TH\ndata ForeignSrcLang\n  = LangC      -- ^ C\n  | LangCxx    -- ^ C++\n  | LangObjc   -- ^ Objective C\n  | LangObjcxx -- ^ Objective C++\n  | LangAsm    -- ^ Assembly language (.s)\n  | RawObject  -- ^ Object (.o)\n  deriving (Eq, Show, Generic)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.LanguageExtensions.Type\n-- Copyright   :  (c) The GHC Team\n--\n-- Maintainer  :  ghc-devs@haskell.org\n-- Portability :  portable\n--\n-- A data type defining the language extensions supported by GHC.\n--\n{-# LANGUAGE DeriveGeneric #-}\nmodule GHC.LanguageExtensions.Type ( Extension(..) ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHC.Generics\n\n-- | The language extensions known to GHC.\n--\n-- Note that there is an orphan 'Binary' instance for this type supplied by\n-- the \"GHC.LanguageExtensions\" module provided by @ghc-boot@. We can't provide\n-- here as this would require adding transitive dependencies to the\n-- @template-haskell@ package, which must have a minimal dependency set.\ndata Extension\n-- See Note [Updating flag description in the User's Guide] in DynFlags\n   = Cpp\n   | OverlappingInstances\n   | UndecidableInstances\n   | IncoherentInstances\n   | UndecidableSuperClasses\n   | MonomorphismRestriction\n   | MonoPatBinds\n   | MonoLocalBinds\n   | RelaxedPolyRec           -- Deprecated\n   | ExtendedDefaultRules     -- Use GHC's extended rules for defaulting\n   | ForeignFunctionInterface\n   | UnliftedFFITypes\n   | InterruptibleFFI\n   | CApiFFI\n   | GHCForeignImportPrim\n   | JavaScriptFFI\n   | ParallelArrays           -- Syntactic support for parallel arrays\n   | Arrows                   -- Arrow-notation syntax\n   | TemplateHaskell\n   | TemplateHaskellQuotes    -- subset of TH supported by stage1, no splice\n   | QuasiQuotes\n   | ImplicitParams\n   | ImplicitPrelude\n   | ScopedTypeVariables\n   | AllowAmbiguousTypes\n   | UnboxedTuples\n   | UnboxedSums\n   | BangPatterns\n   | TypeFamilies\n   | TypeFamilyDependencies\n   | TypeInType\n   | OverloadedStrings\n   | OverloadedLists\n   | NumDecimals\n   | DisambiguateRecordFields\n   | RecordWildCards\n   | RecordPuns\n   | ViewPatterns\n   | GADTs\n   | GADTSyntax\n   | NPlusKPatterns\n   | DoAndIfThenElse\n   | BlockArguments\n   | RebindableSyntax\n   | ConstraintKinds\n   | PolyKinds                -- Kind polymorphism\n   | DataKinds                -- Datatype promotion\n   | InstanceSigs\n   | ApplicativeDo\n\n   | StandaloneDeriving\n   | DeriveDataTypeable\n   | AutoDeriveTypeable       -- Automatic derivation of Typeable\n   | DeriveFunctor\n   | DeriveTraversable\n   | DeriveFoldable\n   | DeriveGeneric            -- Allow deriving Generic/1\n   | DefaultSignatures        -- Allow extra signatures for defmeths\n   | DeriveAnyClass           -- Allow deriving any class\n   | DeriveLift               -- Allow deriving Lift\n   | DerivingStrategies\n   | DerivingVia              -- Derive through equal representation\n\n   | TypeSynonymInstances\n   | FlexibleContexts\n   | FlexibleInstances\n   | ConstrainedClassMethods\n   | MultiParamTypeClasses\n   | NullaryTypeClasses\n   | FunctionalDependencies\n   | UnicodeSyntax\n   | ExistentialQuantification\n   | MagicHash\n   | EmptyDataDecls\n   | KindSignatures\n   | RoleAnnotations\n   | ParallelListComp\n   | TransformListComp\n   | MonadComprehensions\n   | GeneralizedNewtypeDeriving\n   | RecursiveDo\n   | PostfixOperators\n   | TupleSections\n   | PatternGuards\n   | LiberalTypeSynonyms\n   | RankNTypes\n   | ImpredicativeTypes\n   | TypeOperators\n   | ExplicitNamespaces\n   | PackageImports\n   | ExplicitForAll\n   | AlternativeLayoutRule\n   | AlternativeLayoutRuleTransitional\n   | DatatypeContexts\n   | NondecreasingIndentation\n   | RelaxedLayout\n   | TraditionalRecordSyntax\n   | LambdaCase\n   | MultiWayIf\n   | BinaryLiterals\n   | NegativeLiterals\n   | HexFloatLiterals\n   | DuplicateRecordFields\n   | OverloadedLabels\n   | EmptyCase\n   | PatternSynonyms\n   | PartialTypeSignatures\n   | NamedWildCards\n   | StaticPointers\n   | TypeApplications\n   | Strict\n   | StrictData\n   | MonadFailDesugaring\n   | EmptyDataDeriving\n   | NumericUnderscores\n   | QuantifiedConstraints\n   | StarIsType\n   deriving (Eq, Enum, Show, Generic)\n", "num_lines": 143}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-name-shadowing #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Compact\n-- Copyright   :  (c) The University of Glasgow 2001-2009\n--                (c) Giovanni Campagna <gcampagn@cs.stanford.edu> 2014\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  unstable\n-- Portability :  non-portable (GHC Extensions)\n--\n-- This module provides a data structure, called a 'Compact', for\n-- holding immutable, fully evaluated data in a consecutive block of memory.\n-- Compact regions are good for two things:\n--\n--  1. Data in a compact region is not traversed during GC; any\n--  incoming pointer to a compact region keeps the entire region\n--  live.  Thus, if you put a long-lived data structure in a compact\n--  region, you may save a lot of cycles during major collections,\n--  since you will no longer be (uselessly) retraversing this\n--  data structure.\n--\n--  2. Because the data is stored contiguously, you can easily\n--  dump the memory to disk and/or send it over the network.\n--  For applications that are not bandwidth bound (GHC's heap\n--  representation can be as much of a x4 expansion over a\n--  binary serialization), this can lead to substantial speedups.\n--\n-- For example, suppose you have a function @loadBigStruct :: IO BigStruct@,\n-- which loads a large data structure from the file system.  You can \"compact\"\n-- the structure with the following code:\n--\n-- @\n--      do r <- 'compact' =<< loadBigStruct\n--         let x = 'getCompact' r :: BigStruct\n--         -- Do things with x\n-- @\n--\n-- Note that 'compact' will not preserve internal sharing; use\n-- 'compactWithSharing' (which is 10x slower) if you have cycles and/or\n-- must preserve sharing.  The 'Compact' pointer @r@ can be used\n-- to add more data to a compact region; see 'compactAdd' or\n-- 'compactAddWithSharing'.\n--\n-- The implementation of compact regions is described by:\n--\n--  * Edward Z. Yang, Giovanni Campagna, \u00c3\u2013mer A\u00c4\u0178acan, Ahmed El-Hassany, Abhishek\n--    Kulkarni, Ryan Newton. \\\"/Efficient communication and Collection with Compact\n--    Normal Forms/\\\". In Proceedings of the 20th ACM SIGPLAN International\n--    Conference on Functional Programming. September 2015. <http://ezyang.com/compact.html>\n--\n-- This library is supported by GHC 8.2 and later.\n\nmodule GHC.Compact (\n  -- * The Compact type\n  Compact(..),\n\n  -- * Compacting data\n  compact,\n  compactWithSharing,\n  compactAdd,\n  compactAddWithSharing,\n\n  -- * Inspecting a Compact\n  getCompact,\n  inCompact,\n  isCompact,\n  compactSize,\n\n  -- * Other utilities\n  compactResize,\n\n  -- * Internal operations\n  mkCompact,\n  compactSized,\n  ) where\n\nimport Control.Concurrent.MVar\nimport GHC.Prim\nimport GHC.Types\n\n-- | A 'Compact' contains fully evaluated, pure, immutable data.\n--\n-- 'Compact' serves two purposes:\n--\n-- * Data stored in a 'Compact' has no garbage collection overhead.\n--   The garbage collector considers the whole 'Compact' to be alive\n--   if there is a reference to any object within it.\n--\n-- * A 'Compact' can be serialized, stored, and deserialized again.\n--   The serialized data can only be deserialized by the exact binary\n--   that created it, but it can be stored indefinitely before\n--   deserialization.\n--\n-- Compacts are self-contained, so compacting data involves copying\n-- it; if you have data that lives in two 'Compact's, each will have a\n-- separate copy of the data.\n--\n-- The cost of compaction is similar to the cost of GC for the same\n-- data, but it is performed only once.  However, because\n-- \"GHC.Compact.compact\" does not stop-the-world, retaining internal\n-- sharing during the compaction process is very costly. The user\n-- can choose whether to 'compact' or 'compactWithSharing'.\n--\n-- When you have a @'Compact' a@, you can get a pointer to the actual object\n-- in the region using \"GHC.Compact.getCompact\".  The 'Compact' type\n-- serves as handle on the region itself; you can use this handle\n-- to add data to a specific 'Compact' with 'compactAdd' or\n-- 'compactAddWithSharing' (giving you a new handle which corresponds\n-- to the same compact region, but points to the newly added object\n-- in the region).  At the moment, due to technical reasons,\n-- it's not possible to get the @'Compact' a@ if you only have an @a@,\n-- so make sure you hold on to the handle as necessary.\n--\n-- Data in a compact doesn't ever move, so compacting data is also a\n-- way to pin arbitrary data structures in memory.\n--\n-- There are some limitations on what can be compacted:\n--\n-- * Functions.  Compaction only applies to data.\n--\n-- * Pinned 'ByteArray#' objects cannot be compacted.  This is for a\n--   good reason: the memory is pinned so that it can be referenced by\n--   address (the address might be stored in a C data structure, for\n--   example), so we can't make a copy of it to store in the 'Compact'.\n--\n-- * Objects with mutable pointer fields (e.g. 'Data.IORef.IORef',\n--   'GHC.Array.MutableArray') also cannot be compacted, because subsequent\n--   mutation would destroy the property that a compact is self-contained.\n--\n-- If compaction encounters any of the above, a 'CompactionFailed'\n-- exception will be thrown by the compaction operation.\n--\ndata Compact a = Compact Compact# a (MVar ())\n    -- we can *read* from a Compact without taking a lock, but only\n    -- one thread can be writing to the compact at any given time.\n    -- The MVar here is to enforce mutual exclusion among writers.\n    -- Note: the MVar protects the Compact# only, not the pure value 'a'\n\n-- | Make a new 'Compact' object, given a pointer to the true\n-- underlying region.  You must uphold the invariant that @a@ lives\n-- in the compact region.\n--\nmkCompact\n  :: Compact# -> a -> State# RealWorld -> (# State# RealWorld, Compact a #)\nmkCompact compact# a s =\n  case unIO (newMVar ()) s of { (# s1, lock #) ->\n  (# s1, Compact compact# a lock #) }\n where\n  unIO (IO a) = a\n\n-- | Transfer @a@ into a new compact region, with a preallocated size,\n-- possibly preserving sharing or not.  If you know how big the data\n-- structure in question is, you can save time by picking an appropriate\n-- block size for the compact region.\n--\ncompactSized :: Int -> Bool -> a -> IO (Compact a)\ncompactSized (I# size) share a = IO $ \\s0 ->\n  case compactNew# (int2Word# size) s0 of { (# s1, compact# #) ->\n  case compactAddPrim compact# a s1 of { (# s2, pk #) ->\n  mkCompact compact# pk s2 }}\n where\n  compactAddPrim\n    | share = compactAddWithSharing#\n    | otherwise = compactAdd#\n\n-- | Retrieve a direct pointer to the value pointed at by a 'Compact' reference.\n-- If you have used 'compactAdd', there may be multiple 'Compact' references\n-- into the same compact region. Upholds the property:\n--\n-- > inCompact c (getCompact c) == True\n--\ngetCompact :: Compact a -> a\ngetCompact (Compact _ obj _) = obj\n\n-- | Compact a value. /O(size of unshared data)/\n--\n-- If the structure contains any internal sharing, the shared data\n-- will be duplicated during the compaction process.  This will\n-- not terminate if the structure contains cycles (use 'compactWithSharing'\n-- instead).\n--\n-- The object in question must not contain any functions or data with mutable\n-- pointers; if it does, 'compact' will raise an exception. In the future, we\n-- may add a type class which will help statically check if this is the case or\n-- not.\n--\ncompact :: a -> IO (Compact a)\ncompact = compactSized 31268 False\n\n-- | Compact a value, retaining any internal sharing and\n-- cycles. /O(size of data)/\n--\n-- This is typically about 10x slower than 'compact', because it works\n-- by maintaining a hash table mapping uncompacted objects to\n-- compacted objects.\n--\n-- The object in question must not contain any functions or data with mutable\n-- pointers; if it does, 'compact' will raise an exception. In the future, we\n-- may add a type class which will help statically check if this is the case or\n-- not.\n--\ncompactWithSharing :: a -> IO (Compact a)\ncompactWithSharing = compactSized 31268 True\n\n-- | Add a value to an existing 'Compact'.  This will help you avoid\n-- copying when the value contains pointers into the compact region,\n-- but remember that after compaction this value will only be deallocated\n-- with the entire compact region.\n--\n-- Behaves exactly like 'compact' with respect to sharing and what data\n-- it accepts.\n--\ncompactAdd :: Compact b -> a -> IO (Compact a)\ncompactAdd (Compact compact# _ lock) a = withMVar lock $ \\_ -> IO $ \\s ->\n  case compactAdd# compact# a s of { (# s1, pk #) ->\n  (# s1, Compact compact# pk lock #) }\n\n-- | Add a value to an existing 'Compact', like 'compactAdd',\n-- but behaving exactly like 'compactWithSharing' with respect to sharing and\n-- what data it accepts.\n--\ncompactAddWithSharing :: Compact b -> a -> IO (Compact a)\ncompactAddWithSharing (Compact compact# _ lock) a =\n  withMVar lock $ \\_ -> IO $ \\s ->\n    case compactAddWithSharing# compact# a s of { (# s1, pk #) ->\n    (# s1, Compact compact# pk lock #) }\n\n-- | Check if the second argument is inside the passed 'Compact'.\n--\ninCompact :: Compact b -> a -> IO Bool\ninCompact (Compact buffer _ _) !val =\n  IO (\\s -> case compactContains# buffer val s of\n         (# s', v #) -> (# s', isTrue# v #) )\n\n-- | Check if the argument is in any 'Compact'.  If true, the value in question\n-- is also fully evaluated, since any value in a compact region must\n-- be fully evaluated.\n--\nisCompact :: a -> IO Bool\nisCompact !val =\n  IO (\\s -> case compactContainsAny# val s of\n         (# s', v #) -> (# s', isTrue# v #) )\n\n-- | Returns the size in bytes of the compact region.\n--\ncompactSize :: Compact a -> IO Word\ncompactSize (Compact buffer _ lock) = withMVar lock $ \\_ -> IO $ \\s0 ->\n   case compactSize# buffer s0 of (# s1, sz #) -> (# s1, W# sz #)\n\n-- | *Experimental.*  This function doesn't actually resize a compact\n-- region; rather, it changes the default block size which we allocate\n-- when the current block runs out of space, and also appends a block\n-- to the compact region.\n--\ncompactResize :: Compact a -> Word -> IO ()\ncompactResize (Compact oldBuffer _ lock) (W# new_size) =\n  withMVar lock $ \\_ -> IO $ \\s ->\n    case compactResize# oldBuffer new_size s of\n      s' -> (# s', () #)\n", "num_lines": 267}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Compact.Serialized\n-- Copyright   :  (c) The University of Glasgow 2001-2009\n--                (c) Giovanni Campagna <gcampagn@cs.stanford.edu> 2015\n-- License     :  BSD-style (see the file LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  unstable\n-- Portability :  non-portable (GHC Extensions)\n--\n-- This module contains support for serializing a Compact for network\n-- transmission and on-disk storage.\n--\n-- /Since: 1.0.0/\n\nmodule GHC.Compact.Serialized(\n  SerializedCompact(..),\n  withSerializedCompact,\n  importCompact,\n  importCompactByteStrings,\n) where\n\nimport GHC.Prim\nimport GHC.Types\nimport GHC.Word (Word8)\n\nimport GHC.Ptr (Ptr(..), plusPtr)\n\nimport Control.Concurrent\nimport qualified Data.ByteString as ByteString\nimport Data.ByteString.Internal(toForeignPtr)\nimport Data.IORef(newIORef, readIORef, writeIORef)\nimport Foreign.ForeignPtr(withForeignPtr)\nimport Foreign.Marshal.Utils(copyBytes)\n\nimport GHC.Compact\n\n-- | A serialized version of the 'Compact' metadata (each block with\n-- address and size and the address of the root). This structure is\n-- meant to be sent alongside the actual 'Compact' data. It can be\n-- sent out of band in advance if the data is to be sent over RDMA\n-- (which requires both sender and receiver to have pinned buffers).\ndata SerializedCompact a = SerializedCompact\n  { serializedCompactBlockList :: [(Ptr a, Word)]\n  , serializedCompactRoot :: Ptr a\n  }\n\naddrIsNull :: Addr# -> Bool\naddrIsNull addr = isTrue# (nullAddr# `eqAddr#` addr)\n\ncompactGetFirstBlock :: Compact# -> IO (Ptr a, Word)\ncompactGetFirstBlock buffer =\n  IO (\\s -> case compactGetFirstBlock# buffer s of\n         (# s', addr, size #) -> (# s', (Ptr addr, W# size) #) )\n\ncompactGetNextBlock :: Compact# -> Addr# -> IO (Ptr a, Word)\ncompactGetNextBlock buffer block =\n  IO (\\s -> case compactGetNextBlock# buffer block s of\n         (# s', addr, size #) -> (# s', (Ptr addr, W# size) #) )\n\nmkBlockList :: Compact# -> IO [(Ptr a, Word)]\nmkBlockList buffer = compactGetFirstBlock buffer >>= go\n  where\n    go :: (Ptr a, Word) -> IO [(Ptr a, Word)]\n    go (Ptr block, _) | addrIsNull block = return []\n    go item@(Ptr block, _) = do\n      next <- compactGetNextBlock buffer block\n      rest <- go next\n      return $ item : rest\n\n-- We MUST mark withSerializedCompact as NOINLINE\n-- Otherwise the compiler will eliminate the call to touch#\n-- causing the Compact# to be potentially GCed too eagerly,\n-- before func had a chance to copy everything into its own\n-- buffers/sockets/whatever\n\n-- | Serialize the 'Compact', and call the provided function with\n-- with the 'Compact' serialized representation.  It is not safe\n-- to return the pointer from the action and use it after\n-- the action completes: all uses must be inside this bracket,\n-- since we cannot guarantee that the compact region will stay\n-- live from the 'Ptr' object.  For example, it would be\n-- unsound to use 'unsafeInterleaveIO' to lazily construct\n-- a lazy bytestring from the 'Ptr'.\n--\n{-# NOINLINE withSerializedCompact #-}\nwithSerializedCompact :: Compact a ->\n                         (SerializedCompact a -> IO c) -> IO c\nwithSerializedCompact (Compact buffer root lock) func = withMVar lock $ \\_ -> do\n  rootPtr <- IO (\\s -> case anyToAddr# root s of\n                    (# s', rootAddr #) -> (# s', Ptr rootAddr #) )\n  blockList <- mkBlockList buffer\n  let serialized = SerializedCompact blockList rootPtr\n  r <- func serialized\n  IO (\\s -> case touch# buffer s of\n         s' -> (# s', r #) )\n\nfixupPointers :: Addr# -> Addr# -> State# RealWorld ->\n                 (# State# RealWorld, Maybe (Compact a) #)\nfixupPointers firstBlock rootAddr s =\n  case compactFixupPointers# firstBlock rootAddr s of\n    (# s', buffer, adjustedRoot #) ->\n      if addrIsNull adjustedRoot then (# s', Nothing #)\n      else case addrToAny# adjustedRoot of\n        (# root #) -> case mkCompact buffer root s' of\n          (# s'', c #) -> (# s'', Just c #)\n\n-- | Deserialize a 'SerializedCompact' into a in-memory 'Compact'. The\n-- provided function will be called with the address and size of each\n-- newly allocated block in succession, and should fill the memory\n-- from the external source (eg. by reading from a socket or from disk)\n-- 'importCompact' can return Nothing if the 'Compact' was corrupt\n-- or it had pointers that could not be adjusted.\nimportCompact :: SerializedCompact a -> (Ptr b -> Word -> IO ()) ->\n                 IO (Maybe (Compact a))\n\n-- what we would like is\n{-\n importCompactPtrs ((firstAddr, firstSize):rest) = do\n   (firstBlock, compact) <- compactAllocateAt firstAddr firstSize\n #nullAddr\n   fillBlock firstBlock firstAddr firstSize\n   let go prev [] = return ()\n       go prev ((addr, size):rest) = do\n         (block, _) <- compactAllocateAt addr size prev\n         fillBlock block addr size\n         go block rest\n   go firstBlock rest\n   if isTrue# (compactFixupPointers compact) then\n     return $ Just compact\n     else\n     return Nothing\n\nBut we can't do that because IO Addr# is not valid (kind mismatch)\nThis check exists to prevent a polymorphic data constructor from using\nan unlifted type (which would break GC) - it would not a problem for IO\nbecause IO stores a function, not a value, but the kind check is there\nanyway.\nNote that by the reasoning, we cannot do IO (# Addr#, Word# #), nor\nwe can do IO (Addr#, Word#) (that would break the GC for real!)\n\nAnd therefore we need to do everything with State# explicitly.\n-}\n\n-- just do shut up GHC\nimportCompact (SerializedCompact [] _) _ = return Nothing\nimportCompact (SerializedCompact blocks root) filler = do\n  -- I'm not sure why we need a bang pattern here, given that\n  -- these are obviously strict lets, but ghc complains otherwise\n  let !((_, W# firstSize):otherBlocks) = blocks\n  let !(Ptr rootAddr) = root\n  IO $ \\s0 ->\n    case compactAllocateBlock# firstSize nullAddr# s0 of {\n      (# s1, firstBlock #) ->\n    case fillBlock firstBlock firstSize s1 of { s2 ->\n    case go firstBlock otherBlocks s2 of { s3 ->\n    fixupPointers firstBlock rootAddr s3\n    }}}\n  where\n    -- note that the case statements above are strict even though\n    -- they don't seem to inspect their argument because State#\n    -- is an unlifted type\n    fillBlock :: Addr# -> Word# -> State# RealWorld -> State# RealWorld\n    fillBlock addr size s = case filler (Ptr addr) (W# size) of\n      IO action -> case action s of\n        (# s', _ #) -> s'\n\n    go :: Addr# -> [(Ptr a, Word)] -> State# RealWorld -> State# RealWorld\n    go _ [] s = s\n    go previous ((_, W# size):rest) s =\n      case compactAllocateBlock# size previous s of\n        (# s', block #) -> case fillBlock block size s' of\n          s'' -> go block rest s''\n\nsanityCheckByteStrings :: SerializedCompact a -> [ByteString.ByteString] -> Bool\nsanityCheckByteStrings (SerializedCompact scl _) bsl = go scl bsl\n  where\n    go [] [] = True\n    go (_:_) [] = False\n    go [] (_:_) = False\n    go ((_, size):scs) (bs:bss) =\n      fromIntegral size == ByteString.length bs && go scs bss\n\n-- | Convenience function for importing a compact region that is represented\n-- by a list of strict 'ByteString's.\n--\nimportCompactByteStrings :: SerializedCompact a -> [ByteString.ByteString] ->\n                            IO (Maybe (Compact a))\nimportCompactByteStrings serialized stringList =\n  -- sanity check stringList first - if we throw an exception later we leak\n  -- memory!\n  if not (sanityCheckByteStrings serialized stringList) then\n    return Nothing\n  else do\n    state <- newIORef stringList\n    let filler :: Ptr Word8 -> Word -> IO ()\n        filler to size = do\n          -- this pattern match will never fail\n          (next:rest) <- readIORef state\n          let (fp, off, _) = toForeignPtr next\n          withForeignPtr fp $ \\from -> do\n            copyBytes to (from `plusPtr` off) (fromIntegral size)\n          writeIORef state rest\n    importCompact serialized filler\n", "num_lines": 211}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport System.Mem\n\nimport GHC.Compact\n\nassertFail :: String -> IO ()\nassertFail msg = throwIO $ AssertionFailed msg\n\nassertEquals :: (Eq a, Show a) => a -> a -> IO ()\nassertEquals expected actual =\n  if expected == actual then return ()\n  else assertFail $ \"expected \" ++ (show expected)\n       ++ \", got \" ++ (show actual)\n\nmain = do\n  let val = (\"hello\", Just 42) :: (String, Maybe Int)\n  str <- compactWithSharing val\n\n  let val2 = (\"world\", 42) :: (String, Int)\n  str2 <- compactAddWithSharing str val2\n\n  -- check that values where not corrupted\n  assertEquals (\"hello\", Just 42) val\n  assertEquals (\"world\", 42) val2\n  -- check the values in the compact\n  assertEquals (\"hello\", Just 42) (getCompact str)\n  assertEquals (\"world\", 42) (getCompact str2)\n\n  performMajorGC\n\n  -- same checks again\n  assertEquals (\"hello\", Just 42) val\n  assertEquals (\"world\", 42) val2\n  -- check the values in the compact\n  assertEquals (\"hello\", Just 42) (getCompact str)\n  assertEquals (\"world\", 42) (getCompact str2)\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport System.Mem\n\nimport GHC.Compact\n\nassertFail :: String -> IO ()\nassertFail msg = throwIO $ AssertionFailed msg\n\nassertEquals :: (Eq a, Show a) => a -> a -> IO ()\nassertEquals expected actual =\n  if expected == actual then return ()\n  else assertFail $ \"expected \" ++ (show expected)\n       ++ \", got \" ++ (show actual)\n\nmain = do\n  -- create a compact large 4096 bytes (minus the size of header)\n  -- add a value that is 1024 cons cells, pointing to 7 INTLIKE\n  -- each cons cell is 1 word header, 1 word data, 1 word next\n  -- so total 3072 words, 12288 bytes on x86, 24576 on x86_64\n  -- it should not fit in one block\n  let val = replicate 4096 7 :: [Int]\n  str <- compactSized 1 True val\n  assertEquals val (getCompact str)\n  performMajorGC\n  assertEquals val (getCompact str)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport GHC.Compact\nimport qualified Data.Map as Map\nimport Data.Time.Clock\nimport Text.Printf\nimport System.Environment\nimport System.Mem\nimport Control.DeepSeq\n\n-- Benchmark compact against compactWithSharing. e.g.\n--   ./compact_bench 1000000\n\nmain = do\n  [n] <- map read <$> getArgs\n  let m = Map.fromList [(x,[x*1000..x*1000+10]) | x <- [1..(n::Integer)]]\n  evaluate (force m)\n  timeIt \"compact\" $ compact m >>= compactSize >>= print\n  timeIt \"compactWithSharing\" $ compactWithSharing m >>= compactSize >>= print\n\ntimeIt :: String -> IO a -> IO a\ntimeIt str io = do\n  performMajorGC\n  t0 <- getCurrentTime\n  a <- io\n  t1 <- getCurrentTime\n  printf \"%s: %.2f\\n\" str (realToFrac (t1 `diffUTCTime` t0) :: Double)\n  return a\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified Data.ByteString.Char8 as B\nimport GHC.Compact\nimport qualified Data.Map as Map\n\nmain = do\n  c <- compact (Map.fromList [(B.pack (show x), x) | x <- [1..(10000::Int)]])\n  print (getCompact c)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport GHC.Compact\nimport qualified Data.Map as Map\nimport System.Exit\n\nmain = do\n  c <- compactWithSharing (cycle \"abc\") -- magic!\n  print (length (show (take 100 (getCompact c))))\n  print =<< compactSize c\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport GHC.Compact\n\ndata HiddenFunction = HiddenFunction (Int -> Int)\n\nmain = compact (HiddenFunction (+1))\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport GHC.Compact\nimport qualified Data.Map as Map\n\nmain = do\n  let m = Map.fromList [(x,show x) | x <- [1..(10000::Int)]]\n  c <- compactWithSharing m\n  print =<< compactSize c\n  c <- foldM (\\c _ -> do c <- compactWithSharing (getCompact c); print =<< compactSize c; return c) c [1..10]\n  print (length (show (getCompact c)))\n  print =<< compactSize c\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport Control.Monad\nimport System.Mem\n\nimport Control.Monad.ST\nimport Data.Array\nimport Data.Array.ST\nimport qualified Data.Array.Unboxed as U\n\nimport GHC.Compact\n\nassertFail :: String -> IO ()\nassertFail msg = throwIO $ AssertionFailed msg\n\nassertEquals :: (Eq a, Show a) => a -> a -> IO ()\nassertEquals expected actual =\n  if expected == actual then return ()\n  else assertFail $ \"expected \" ++ (show expected)\n       ++ \", got \" ++ (show actual)\n\narrTest :: (Monad m, MArray a e m, Num e) => m (a Int e)\narrTest = do\n  arr <- newArray (1, 10) 0\n  forM_ [1..10] $ \\j -> do\n    writeArray arr j (fromIntegral $ 2*j + 1)\n  return arr\n\n-- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO ()\ntest func = do\n  let fromList :: Array Int Int\n      fromList = listArray (1, 300000) [1..]\n      frozen :: Array Int Int\n      frozen = runST $ do\n        arr <- arrTest :: ST s (STArray s Int Int)\n        freeze arr\n      stFrozen :: Array Int Int\n      stFrozen = runSTArray arrTest\n      unboxedFrozen :: U.UArray Int Int\n      unboxedFrozen = runSTUArray arrTest\n\n  let val = (fromList, frozen, stFrozen, unboxedFrozen)\n  str <- func val\n\n  -- check that val is still good\n  assertEquals (fromList, frozen, stFrozen, unboxedFrozen) val\n  -- check the value in the compact\n  assertEquals val (getCompact str)\n  performMajorGC\n  -- check again the value in the compact\n  assertEquals val (getCompact str)\n\nmain = do\n  test (compactSized 4096 True)\n  test (compactSized 4096 False)\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.Compact\nimport qualified Data.Map as Map\n\nmain = do\n  let m = Map.fromList [(x,show x) | x <- [1..(10000::Integer)]]\n  c <- compactWithSharing m\n  print (length (show (getCompact c)))\n  c <- compact m\n  print (length (show (getCompact c)))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport System.Mem\nimport Text.Show\n\nimport GHC.Compact\n\nassertFail :: String -> IO ()\nassertFail msg = throwIO $ AssertionFailed msg\n\nassertEquals :: (Eq a, Show a) => a -> a -> IO ()\nassertEquals expected actual =\n  if expected == actual then return ()\n  else assertFail $ \"expected \" ++ (show expected)\n       ++ \", got \" ++ (show actual)\n\ndata Tree = Nil | Node Tree Tree Tree\n\ninstance Eq Tree where\n  Nil == Nil = True\n  Node _ l1 r1 == Node _ l2 r2 = l1 == l2 && r1 == r2\n  _ == _ = False\n\ninstance Show Tree where\n  showsPrec _ Nil = showString \"Nil\"\n  showsPrec _ (Node _ l r) = showString \"(Node \" . shows l .\n                             showString \" \" . shows r . showString \")\"\n\n{-# NOINLINE test #-}\ntest x = do\n  let a = Node Nil x b\n      b = Node a Nil Nil\n  str <- compactSized 4096 True a\n\n  -- check the value in the compact\n  assertEquals a (getCompact str)\n  performMajorGC\n  -- check again the value in the compact\n  assertEquals a (getCompact str)\n\nmain = test Nil\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport GHC.Compact\n\ndata HiddenMVar = HiddenMVar (MVar ())\n\nmain = do\n  m <- newEmptyMVar\n  compact (HiddenMVar m)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport qualified Data.ByteString.Char8 as B\nimport GHC.Compact\n\nmain = compact (B.pack ['a'..'c'])\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport Control.Monad\nimport System.Mem\n\nimport Data.IORef\nimport Data.ByteString (ByteString, packCStringLen)\nimport Foreign.Ptr\n\nimport GHC.Compact\nimport GHC.Compact.Serialized\n\nassertFail :: String -> IO ()\nassertFail msg = throwIO $ AssertionFailed msg\n\nassertEquals :: (Eq a, Show a) => a -> a -> IO ()\nassertEquals expected actual =\n  if expected == actual then return ()\n  else assertFail $ \"expected \" ++ (show expected)\n       ++ \", got \" ++ (show actual)\n\nserialize :: a -> IO (SerializedCompact a, [ByteString])\nserialize val = do\n  cnf <- compactSized 4096 True val\n\n  bytestrref <- newIORef undefined\n  scref <- newIORef undefined\n  withSerializedCompact cnf $ \\sc -> do\n    writeIORef scref sc\n    performMajorGC\n    bytestrs <- forM (serializedCompactBlockList sc) $ \\(ptr, size) -> do\n      packCStringLen (castPtr ptr, fromIntegral size)\n    writeIORef bytestrref bytestrs\n\n  performMajorGC\n\n  bytestrs <- readIORef bytestrref\n  sc <- readIORef scref\n  return (sc, bytestrs)\n\nmain = do\n  let val = (\"hello\", 1, 42, 42, Just 42) ::\n        (String, Int, Int, Integer, Maybe Int)\n\n  (sc, bytestrs) <- serialize val\n  performMajorGC\n\n  mcnf <- importCompactByteStrings sc bytestrs\n  case mcnf of\n    Nothing -> assertFail \"import failed\"\n    Just cnf -> assertEquals val (getCompact cnf)\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Char\nimport GHC.Compact\nimport qualified Data.Map as Map\n\nmain = do\n  let m1 = Map.fromList [(x,show x) | x <- ['a'..chr 10000]]\n      m2 = Map.fromList [(x,y) | x <- ['a'..chr 10000],\n                                 Just y <- [Map.lookup x m1]]\n  c <- compact (m1,m2)\n  print (length (show (getCompact c)))\n  print =<< compactSize c\n  c <- compactWithSharing (m1,m2)\n  print (length (show (getCompact c)))\n  print =<< compactSize c\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport System.Mem\n\nimport GHC.Compact\n\nassertFail :: String -> IO ()\nassertFail msg = throwIO $ AssertionFailed msg\n\nassertEquals :: (Eq a, Show a) => a -> a -> IO ()\nassertEquals expected actual =\n  if expected == actual then return ()\n  else assertFail $ \"expected \" ++ (show expected)\n       ++ \", got \" ++ (show actual)\n\n-- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO ()\ntest func = do\n  let val = (\"hello\", 1, 42, 42, Just 42) ::\n        (String, Int, Int, Integer, Maybe Int)\n  str <- func val\n\n  -- check that val is still good\n  assertEquals (\"hello\", 1, 42, 42, Just 42) val\n  -- check the value in the compact\n  assertEquals (\"hello\", 1, 42, 42, Just 42) (getCompact str)\n  performMajorGC\n  -- check again val\n  assertEquals (\"hello\", 1, 42, 42, Just 42) val\n  -- check again the value in the compact\n  assertEquals (\"hello\", 1, 42, 42, Just 42) (getCompact str)\n\n  print =<< compactSize str\n\nmain = do\n  test compactWithSharing\n  test compact\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport Control.Monad\nimport System.Mem\n\nimport Control.Monad.ST\nimport Data.Array\nimport Data.Array.ST\nimport qualified Data.Array.Unboxed as U\n\nimport GHC.Compact\n\nassertFail :: String -> IO ()\nassertFail msg = throwIO $ AssertionFailed msg\n\nassertEquals :: (Eq a, Show a) => a -> a -> IO ()\nassertEquals expected actual =\n  if expected == actual then return ()\n  else assertFail $ \"expected \" ++ (show expected)\n       ++ \", got \" ++ (show actual)\n\narrTest :: (Monad m, MArray a e m, Num e) => m (a Int e)\narrTest = do\n  arr <- newArray (1, 10) 0\n  forM_ [1..10] $ \\j -> do\n    writeArray arr j (fromIntegral $ 2*j + 1)\n  return arr\n\n-- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO ()\ntest func = do\n  let fromList :: Array Int Int\n      fromList = listArray (1, 10) [1..]\n      frozen :: Array Int Int\n      frozen = runST $ do\n        arr <- arrTest :: ST s (STArray s Int Int)\n        freeze arr\n      stFrozen :: Array Int Int\n      stFrozen = runSTArray arrTest\n      unboxedFrozen :: U.UArray Int Int\n      unboxedFrozen = runSTUArray arrTest\n\n  let val = (fromList, frozen, stFrozen, unboxedFrozen)\n  str <- func val\n\n  -- check that val is still good\n  assertEquals (fromList, frozen, stFrozen, unboxedFrozen) val\n  -- check the value in the compact\n  assertEquals val (getCompact str)\n  performMajorGC\n  -- check again the value in the compact\n  assertEquals val (getCompact str)\n\nmain = do\n  test (compactSized 4096 True)\n  test (compactSized 4096 False)\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.Compact\nimport Data.Primitive.SmallArray\n\nmain :: IO ()\nmain = do\n    arr <- newSmallArray 5 (Just 'a') >>= unsafeFreezeSmallArray\n    arr' <- compact arr\n    print $ getCompact arr'\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\nimport GHC.Compact\nimport qualified Data.Map as Map\nimport Data.Maybe\nimport System.Environment\n\nmain = do\n  [n] <- map read <$> getArgs\n  c <- compact ()\n  as <- forM [1..(n::Int)] $ \\i -> async (compactAdd c (Just i))\n  bs <- forM as $ \\a -> async (getCompact <$> takeMVar a)\n  xs <- mapM takeMVar bs\n  print (sum (catMaybes xs))\n\nasync :: IO a -> IO (MVar a)\nasync io = do\n  m <- newEmptyMVar\n  forkIO (io >>= putMVar m)\n  return m\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeFamilies #-}\n\n{-|\nModule      :  GHC.Exts.Heap\nCopyright   :  (c) 2012 Joachim Breitner\nLicense     :  BSD3\nMaintainer  :  Joachim Breitner <mail@joachim-breitner.de>\n\nWith this module, you can investigate the heap representation of Haskell\nvalues, i.e. to investigate sharing and lazy evaluation.\n-}\n\nmodule GHC.Exts.Heap (\n    -- * Closure types\n      Closure\n    , GenClosure(..)\n    , ClosureType(..)\n    , PrimType(..)\n    , HasHeapRep(getClosureData)\n\n    -- * Info Table types\n    , StgInfoTable(..)\n    , EntryFunPtr\n    , HalfWord\n    , ItblCodes\n    , itblSize\n    , peekItbl\n    , pokeItbl\n\n     -- * Closure inspection\n    , getBoxedClosureData\n    , allClosures\n\n    -- * Boxes\n    , Box(..)\n    , asBox\n    , areBoxesEqual\n    ) where\n\nimport Prelude\nimport GHC.Exts.Heap.Closures\nimport GHC.Exts.Heap.ClosureTypes\nimport GHC.Exts.Heap.Constants\n#if defined(PROFILING)\nimport GHC.Exts.Heap.InfoTableProf\n#else\nimport GHC.Exts.Heap.InfoTable\n#endif\nimport GHC.Exts.Heap.Utils\n\nimport Control.Monad\nimport Data.Bits\nimport GHC.Arr\nimport GHC.Exts\nimport GHC.Int\nimport GHC.Word\n\n#include \"ghcconfig.h\"\n\nclass HasHeapRep (a :: TYPE rep) where\n    getClosureData :: a -> IO Closure\n\ninstance HasHeapRep (a :: TYPE 'LiftedRep) where\n    getClosureData = getClosure\n\ninstance HasHeapRep (a :: TYPE 'UnliftedRep) where\n    getClosureData x = getClosure (unsafeCoerce# x)\n\ninstance Int# ~ a => HasHeapRep (a :: TYPE 'IntRep) where\n    getClosureData x = return $\n        IntClosure { ptipe = PInt, intVal = I# x }\n\ninstance Word# ~ a => HasHeapRep (a :: TYPE 'WordRep) where\n    getClosureData x = return $\n        WordClosure { ptipe = PWord, wordVal = W# x }\n\ninstance Int64# ~ a => HasHeapRep (a :: TYPE 'Int64Rep) where\n    getClosureData x = return $\n        Int64Closure { ptipe = PInt64, int64Val = I64# (unsafeCoerce# x) }\n\ninstance Word64# ~ a => HasHeapRep (a :: TYPE 'Word64Rep) where\n    getClosureData x = return $\n        Word64Closure { ptipe = PWord64, word64Val = W64# (unsafeCoerce# x) }\n\ninstance Addr# ~ a => HasHeapRep (a :: TYPE 'AddrRep) where\n    getClosureData x = return $\n        AddrClosure { ptipe = PAddr, addrVal = I# (unsafeCoerce# x) }\n\ninstance Float# ~ a => HasHeapRep (a :: TYPE 'FloatRep) where\n    getClosureData x = return $\n        FloatClosure { ptipe = PFloat, floatVal = F# x }\n\ninstance Double# ~ a => HasHeapRep (a :: TYPE 'DoubleRep) where\n    getClosureData x = return $\n        DoubleClosure { ptipe = PDouble, doubleVal = D# x }\n\n-- | This returns the raw representation of the given argument. The second\n-- component of the triple is the raw words of the closure on the heap, and the\n-- third component is those words that are actually pointers. Once back in the\n-- Haskell world, the raw words that hold pointers may be outdated after a\n-- garbage collector run, but the corresponding values in 'Box's will still\n-- point to the correct value.\ngetClosureRaw :: a -> IO (Ptr StgInfoTable, [Word], [Box])\ngetClosureRaw x = do\n    case unpackClosure# x of\n-- This is a hack to cover the bootstrap compiler using the old version of\n-- 'unpackClosure'. The new 'unpackClosure' return values are not merely\n-- a reordering, so using the old version would not work.\n#if MIN_VERSION_ghc_prim(0,5,3)\n        (# iptr, dat, pointers #) -> do\n#else\n        (# iptr, pointers, dat #) -> do\n#endif\n            let nelems = (I# (sizeofByteArray# dat)) `div` wORD_SIZE\n                end = fromIntegral nelems - 1\n                rawWds = [W# (indexWordArray# dat i) | I# i <- [0.. end] ]\n                pelems = I# (sizeofArray# pointers)\n                ptrList = amap' Box $ Array 0 (pelems - 1) pelems pointers\n            pure (Ptr iptr, rawWds, ptrList)\n\n-- From compiler/ghci/RtClosureInspect.hs\namap' :: (t -> b) -> Array Int t -> [b]\namap' f (Array i0 i _ arr#) = map g [0 .. i - i0]\n    where g (I# i#) = case indexArray# arr# i# of\n                          (# e #) -> f e\n\n-- | This function returns a parsed heap representation of the argument _at\n-- this moment_, even if it is unevaluated or an indirection or other exotic\n-- stuff.  Beware when passing something to this function, the same caveats as\n-- for 'asBox' apply.\ngetClosure :: a -> IO Closure\ngetClosure x = do\n    (iptr, wds, pts) <- getClosureRaw x\n    itbl <- peekItbl iptr\n    -- The remaining words after the header\n    let rawWds = drop (closureTypeHeaderSize (tipe itbl)) wds\n    -- For data args in a pointers then non-pointers closure\n    -- This is incorrect in non pointers-first setups\n    -- not sure if that happens\n        npts = drop (closureTypeHeaderSize (tipe itbl) + length pts) wds\n    case tipe itbl of\n        t | t >= CONSTR && t <= CONSTR_NOCAF -> do\n            (p, m, n) <- dataConNames iptr\n            if m == \"ByteCodeInstr\" && n == \"BreakInfo\"\n              then pure $ UnsupportedClosure itbl\n              else pure $ ConstrClosure itbl pts npts p m n\n\n        t | t >= THUNK && t <= THUNK_STATIC -> do\n            pure $ ThunkClosure itbl pts npts\n\n        THUNK_SELECTOR -> do\n            unless (length pts >= 1) $\n                fail \"Expected at least 1 ptr argument to THUNK_SELECTOR\"\n            pure $ SelectorClosure itbl (head pts)\n\n        t | t >= FUN && t <= FUN_STATIC -> do\n            pure $ FunClosure itbl pts npts\n\n        AP -> do\n            unless (length pts >= 1) $\n                fail \"Expected at least 1 ptr argument to AP\"\n            -- We expect at least the arity, n_args, and fun fields\n            unless (length rawWds >= 2) $\n                fail $ \"Expected at least 2 raw words to AP\"\n            let splitWord = rawWds !! 0\n            pure $ APClosure itbl\n#if defined(WORDS_BIGENDIAN)\n                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))\n                (fromIntegral splitWord)\n#else\n                (fromIntegral splitWord)\n                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))\n#endif\n                (head pts) (tail pts)\n\n        PAP -> do\n            unless (length pts >= 1) $\n                fail \"Expected at least 1 ptr argument to PAP\"\n            -- We expect at least the arity, n_args, and fun fields\n            unless (length rawWds >= 2) $\n                fail \"Expected at least 2 raw words to PAP\"\n            let splitWord = rawWds !! 0\n            pure $ PAPClosure itbl\n#if defined(WORDS_BIGENDIAN)\n                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))\n                (fromIntegral splitWord)\n#else\n                (fromIntegral splitWord)\n                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))\n#endif\n                (head pts) (tail pts)\n\n        AP_STACK -> do\n            unless (length pts >= 1) $\n                fail \"Expected at least 1 ptr argument to AP_STACK\"\n            pure $ APStackClosure itbl (head pts) (tail pts)\n\n        IND -> do\n            unless (length pts >= 1) $\n                fail \"Expected at least 1 ptr argument to IND\"\n            pure $ IndClosure itbl (head pts)\n\n        IND_STATIC -> do\n            unless (length pts >= 1) $\n                fail \"Expected at least 1 ptr argument to IND_STATIC\"\n            pure $ IndClosure itbl (head pts)\n\n        BLACKHOLE -> do\n            unless (length pts >= 1) $\n                fail \"Expected at least 1 ptr argument to BLACKHOLE\"\n            pure $ BlackholeClosure itbl (head pts)\n\n        BCO -> do\n            unless (length pts >= 3) $\n                fail $ \"Expected at least 3 ptr argument to BCO, found \"\n                        ++ show (length pts)\n            unless (length rawWds >= 4) $\n                fail $ \"Expected at least 4 words to BCO, found \"\n                        ++ show (length rawWds)\n            let splitWord = rawWds !! 3\n            pure $ BCOClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)\n#if defined(WORDS_BIGENDIAN)\n                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))\n                (fromIntegral splitWord)\n#else\n                (fromIntegral splitWord)\n                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))\n#endif\n                (drop 4 rawWds)\n\n        ARR_WORDS -> do\n            unless (length rawWds >= 1) $\n                fail $ \"Expected at least 1 words to ARR_WORDS, found \"\n                        ++ show (length rawWds)\n            pure $ ArrWordsClosure itbl (head rawWds) (tail rawWds)\n\n        t | t >= MUT_ARR_PTRS_CLEAN && t <= MUT_ARR_PTRS_FROZEN_CLEAN -> do\n            unless (length rawWds >= 2) $\n                fail $ \"Expected at least 2 words to MUT_ARR_PTRS_* \"\n                        ++ \"found \" ++ show (length rawWds)\n            pure $ MutArrClosure itbl (rawWds !! 0) (rawWds !! 1) pts\n\n        t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY ->\n            pure $ MutVarClosure itbl (head pts)\n\n        t | t == MVAR_CLEAN || t == MVAR_DIRTY -> do\n            unless (length pts >= 3) $\n                fail $ \"Expected at least 3 ptrs to MVAR, found \"\n                        ++ show (length pts)\n            pure $ MVarClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)\n\n        BLOCKING_QUEUE ->\n            pure $ OtherClosure itbl pts wds\n        --    pure $ BlockingQueueClosure itbl\n        --        (pts !! 0) (pts !! 1) (pts !! 2) (pts !! 3)\n\n        --  pure $ OtherClosure itbl pts wds\n        --\n        _ ->\n            pure $ UnsupportedClosure itbl\n\n-- | Like 'getClosureData', but taking a 'Box', so it is easier to work with.\ngetBoxedClosureData :: Box -> IO Closure\ngetBoxedClosureData (Box a) = getClosureData a\n", "num_lines": 273}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE GHCForeignImportPrim #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE DeriveTraversable #-}\n\nmodule GHC.Exts.Heap.Closures (\n    -- * Closures\n      Closure\n    , GenClosure(..)\n    , PrimType(..)\n    , allClosures\n\n    -- * Boxes\n    , Box(..)\n    , areBoxesEqual\n    , asBox\n    ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHC.Exts.Heap.Constants\n#if defined(PROFILING)\nimport GHC.Exts.Heap.InfoTableProf\n#else\nimport GHC.Exts.Heap.InfoTable\n\n-- `ghc -M` currently doesn't properly account for ways when generating\n-- dependencies (#15197). This import ensures correct build-ordering between\n-- this module and GHC.Exts.Heap.InfoTableProf. It should be removed when #15197\n-- is fixed.\nimport GHC.Exts.Heap.InfoTableProf ()\n#endif\n\nimport Data.Bits\nimport Data.Int\nimport Data.Word\nimport GHC.Exts\nimport GHC.Generics\nimport Numeric\n\n------------------------------------------------------------------------\n-- Boxes\n\nforeign import prim \"aToWordzh\" aToWord# :: Any -> Word#\n\nforeign import prim \"reallyUnsafePtrEqualityUpToTag\"\n    reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int#\n\n-- | An arbitrary Haskell value in a safe Box. The point is that even\n-- unevaluated thunks can safely be moved around inside the Box, and when\n-- required, e.g. in 'getBoxedClosureData', the function knows how far it has\n-- to evaluate the argument.\ndata Box = Box Any\n\ninstance Show Box where\n-- From libraries/base/GHC/Ptr.lhs\n   showsPrec _ (Box a) rs =\n    -- unsafePerformIO (print \"\u00e2\u2020\u201c\" >> pClosure a) `seq`\n    pad_out (showHex addr \"\") ++ (if tag>0 then \"/\" ++ show tag else \"\") ++ rs\n     where\n       ptr  = W# (aToWord# a)\n       tag  = ptr .&. fromIntegral tAG_MASK -- ((1 `shiftL` TAG_BITS) -1)\n       addr = ptr - tag\n        -- want 0s prefixed to pad it out to a fixed length.\n       pad_out ls =\n          '0':'x':(replicate (2*wORD_SIZE - length ls) '0') ++ ls\n\n-- |This takes an arbitrary value and puts it into a box.\n-- Note that calls like\n--\n-- > asBox (head list)\n--\n-- will put the thunk \\\"head list\\\" into the box, /not/ the element at the head\n-- of the list. For that, use careful case expressions:\n--\n-- > case list of x:_ -> asBox x\nasBox :: a -> Box\nasBox x = Box (unsafeCoerce# x)\n\n-- | Boxes can be compared, but this is not pure, as different heap objects can,\n-- after garbage collection, become the same object.\nareBoxesEqual :: Box -> Box -> IO Bool\nareBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of\n    0# -> pure False\n    _  -> pure True\n\n\n------------------------------------------------------------------------\n-- Closures\n\ntype Closure = GenClosure Box\n\n-- | This is the representation of a Haskell value on the heap. It reflects\n-- <http://ghc.haskell.org/trac/ghc/browser/includes/rts/storage/Closures.h>\n--\n-- The data type is parametrized by the type to store references in. Usually\n-- this is a 'Box' with the type synonym 'Closure'.\n--\n-- All Heap objects have the same basic layout. A header containing a pointer\n-- to the info table and a payload with various fields. The @info@ field below\n-- always refers to the info table pointed to by the header. The remaining\n-- fields are the payload.\n--\n-- See\n-- <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects>\n-- for more information.\ndata GenClosure b\n  = -- | A data constructor\n    ConstrClosure\n        { info       :: !StgInfoTable\n        , ptrArgs    :: ![b]            -- ^ Pointer arguments\n        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments\n        , pkg        :: !String         -- ^ Package name\n        , modl       :: !String         -- ^ Module name\n        , name       :: !String         -- ^ Constructor name\n        }\n\n    -- | A function\n  | FunClosure\n        { info       :: !StgInfoTable\n        , ptrArgs    :: ![b]            -- ^ Pointer arguments\n        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments\n        }\n\n    -- | A thunk, an expression not obviously in head normal form\n  | ThunkClosure\n        { info       :: !StgInfoTable\n        , ptrArgs    :: ![b]            -- ^ Pointer arguments\n        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments\n        }\n\n    -- | A thunk which performs a simple selection operation\n  | SelectorClosure\n        { info       :: !StgInfoTable\n        , selectee   :: !b              -- ^ Pointer to the object being\n                                        --   selected from\n        }\n\n    -- | An unsaturated function application\n  | PAPClosure\n        { info       :: !StgInfoTable\n        , arity      :: !HalfWord       -- ^ Arity of the partial application\n        , n_args     :: !HalfWord       -- ^ Size of the payload in words\n        , fun        :: !b              -- ^ Pointer to a 'FunClosure'\n        , payload    :: ![b]            -- ^ Sequence of already applied\n                                        --   arguments\n        }\n\n    -- In GHCi, if Linker.h would allow a reverse lookup, we could for exported\n    -- functions fun actually find the name here.\n    -- At least the other direction works via \"lookupSymbol\n    -- base_GHCziBase_zpzp_closure\" and yields the same address (up to tags)\n    -- | A function application\n  | APClosure\n        { info       :: !StgInfoTable\n        , arity      :: !HalfWord       -- ^ Always 0\n        , n_args     :: !HalfWord       -- ^ Size of payload in words\n        , fun        :: !b              -- ^ Pointer to a 'FunClosure'\n        , payload    :: ![b]            -- ^ Sequence of already applied\n                                        --   arguments\n        }\n\n    -- | A suspended thunk evaluation\n  | APStackClosure\n        { info       :: !StgInfoTable\n        , fun        :: !b              -- ^ Function closure\n        , payload    :: ![b]            -- ^ Stack right before suspension\n        }\n\n    -- | A pointer to another closure, introduced when a thunk is updated\n    -- to point at its value\n  | IndClosure\n        { info       :: !StgInfoTable\n        , indirectee :: !b              -- ^ Target closure\n        }\n\n   -- | A byte-code object (BCO) which can be interpreted by GHC's byte-code\n   -- interpreter (e.g. as used by GHCi)\n  | BCOClosure\n        { info       :: !StgInfoTable\n        , instrs     :: !b              -- ^ A pointer to an ArrWords\n                                        --   of instructions\n        , literals   :: !b              -- ^ A pointer to an ArrWords\n                                        --   of literals\n        , bcoptrs    :: !b              -- ^ A pointer to an ArrWords\n                                        --   of byte code objects\n        , arity      :: !HalfWord       -- ^ The arity of this BCO\n        , size       :: !HalfWord       -- ^ The size of this BCO in words\n        , bitmap     :: ![Word]         -- ^ An StgLargeBitmap describing the\n                                        --   pointerhood of its args/free vars\n        }\n\n    -- | A thunk under evaluation by another thread\n  | BlackholeClosure\n        { info       :: !StgInfoTable\n        , indirectee :: !b              -- ^ The target closure\n        }\n\n    -- | A @ByteArray#@\n  | ArrWordsClosure\n        { info       :: !StgInfoTable\n        , bytes      :: !Word           -- ^ Size of array in bytes\n        , arrWords   :: ![Word]         -- ^ Array payload\n        }\n\n    -- | A @MutableByteArray#@\n  | MutArrClosure\n        { info       :: !StgInfoTable\n        , mccPtrs    :: !Word           -- ^ Number of pointers\n        , mccSize    :: !Word           -- ^ ?? Closures.h vs ClosureMacros.h\n        , mccPayload :: ![b]            -- ^ Array payload\n        -- Card table ignored\n        }\n\n    -- | An @MVar#@, with a queue of thread state objects blocking on them\n  | MVarClosure\n        { info       :: !StgInfoTable\n        , queueHead  :: !b              -- ^ Pointer to head of queue\n        , queueTail  :: !b              -- ^ Pointer to tail of queue\n        , value      :: !b              -- ^ Pointer to closure\n        }\n\n    -- | A @MutVar#@\n  | MutVarClosure\n        { info       :: !StgInfoTable\n        , var        :: !b              -- ^ Pointer to contents\n        }\n\n    -- | An STM blocking queue.\n  | BlockingQueueClosure\n        { info       :: !StgInfoTable\n        , link       :: !b              -- ^ ?? Here so it looks like an IND\n        , blackHole  :: !b              -- ^ The blackhole closure\n        , owner      :: !b              -- ^ The owning thread state object\n        , queue      :: !b              -- ^ ??\n        }\n\n    ------------------------------------------------------------\n    -- Unboxed unlifted closures\n\n    -- | Primitive Int\n  | IntClosure\n        { ptipe      :: PrimType\n        , intVal     :: !Int }\n\n    -- | Primitive Word\n  | WordClosure\n        { ptipe      :: PrimType\n        , wordVal    :: !Word }\n\n    -- | Primitive Int64\n  | Int64Closure\n        { ptipe      :: PrimType\n        , int64Val   :: !Int64 }\n\n    -- | Primitive Word64\n  | Word64Closure\n        { ptipe      :: PrimType\n        , word64Val  :: !Word64 }\n\n    -- | Primitive Addr\n  | AddrClosure\n        { ptipe      :: PrimType\n        , addrVal    :: !Int }\n\n    -- | Primitive Float\n  | FloatClosure\n        { ptipe      :: PrimType\n        , floatVal   :: !Float }\n\n    -- | Primitive Double\n  | DoubleClosure\n        { ptipe      :: PrimType\n        , doubleVal  :: !Double }\n\n    -----------------------------------------------------------\n    -- Anything else\n\n    -- | Another kind of closure\n  | OtherClosure\n        { info       :: !StgInfoTable\n        , hvalues    :: ![b]\n        , rawWords   :: ![Word]\n        }\n\n  | UnsupportedClosure\n        { info       :: !StgInfoTable\n        }\n  deriving (Show, Generic, Functor, Foldable, Traversable)\n\n\ndata PrimType\n  = PInt\n  | PWord\n  | PInt64\n  | PWord64\n  | PAddr\n  | PFloat\n  | PDouble\n  deriving (Eq, Show, Generic)\n\n-- | For generic code, this function returns all referenced closures.\nallClosures :: GenClosure b -> [b]\nallClosures (ConstrClosure {..}) = ptrArgs\nallClosures (ThunkClosure {..}) = ptrArgs\nallClosures (SelectorClosure {..}) = [selectee]\nallClosures (IndClosure {..}) = [indirectee]\nallClosures (BlackholeClosure {..}) = [indirectee]\nallClosures (APClosure {..}) = fun:payload\nallClosures (PAPClosure {..}) = fun:payload\nallClosures (APStackClosure {..}) = fun:payload\nallClosures (BCOClosure {..}) = [instrs,literals,bcoptrs]\nallClosures (ArrWordsClosure {}) = []\nallClosures (MutArrClosure {..}) = mccPayload\nallClosures (MutVarClosure {..}) = [var]\nallClosures (MVarClosure {..}) = [queueHead,queueTail,value]\nallClosures (FunClosure {..}) = ptrArgs\nallClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue]\nallClosures (OtherClosure {..}) = hvalues\nallClosures _ = []\n", "num_lines": 324}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DeriveGeneric #-}\n\nmodule GHC.Exts.Heap.ClosureTypes\n    ( ClosureType(..)\n    , closureTypeHeaderSize\n    ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHC.Generics\n\n{- ---------------------------------------------\n-- Enum representing closure types\n-- This is a mirror of:\n-- includes/rts/storage/ClosureTypes.h\n-- ---------------------------------------------}\n\ndata ClosureType\n    = INVALID_OBJECT\n    | CONSTR\n    | CONSTR_1_0\n    | CONSTR_0_1\n    | CONSTR_2_0\n    | CONSTR_1_1\n    | CONSTR_0_2\n    | CONSTR_NOCAF\n    | FUN\n    | FUN_1_0\n    | FUN_0_1\n    | FUN_2_0\n    | FUN_1_1\n    | FUN_0_2\n    | FUN_STATIC\n    | THUNK\n    | THUNK_1_0\n    | THUNK_0_1\n    | THUNK_2_0\n    | THUNK_1_1\n    | THUNK_0_2\n    | THUNK_STATIC\n    | THUNK_SELECTOR\n    | BCO\n    | AP\n    | PAP\n    | AP_STACK\n    | IND\n    | IND_STATIC\n    | RET_BCO\n    | RET_SMALL\n    | RET_BIG\n    | RET_FUN\n    | UPDATE_FRAME\n    | CATCH_FRAME\n    | UNDERFLOW_FRAME\n    | STOP_FRAME\n    | BLOCKING_QUEUE\n    | BLACKHOLE\n    | MVAR_CLEAN\n    | MVAR_DIRTY\n    | TVAR\n    | ARR_WORDS\n    | MUT_ARR_PTRS_CLEAN\n    | MUT_ARR_PTRS_DIRTY\n    | MUT_ARR_PTRS_FROZEN_DIRTY\n    | MUT_ARR_PTRS_FROZEN_CLEAN\n    | MUT_VAR_CLEAN\n    | MUT_VAR_DIRTY\n    | WEAK\n    | PRIM\n    | MUT_PRIM\n    | TSO\n    | STACK\n    | TREC_CHUNK\n    | ATOMICALLY_FRAME\n    | CATCH_RETRY_FRAME\n    | CATCH_STM_FRAME\n    | WHITEHOLE\n    | SMALL_MUT_ARR_PTRS_CLEAN\n    | SMALL_MUT_ARR_PTRS_DIRTY\n    | SMALL_MUT_ARR_PTRS_FROZEN_DIRTY\n    | SMALL_MUT_ARR_PTRS_FROZEN_CLEAN\n    | COMPACT_NFDATA\n    | N_CLOSURE_TYPES\n deriving (Enum, Eq, Ord, Show, Generic)\n\n-- | Return the size of the closures header in words\nclosureTypeHeaderSize :: ClosureType -> Int\nclosureTypeHeaderSize closType =\n    case closType of\n        ct | THUNK <= ct && ct <= THUNK_0_2 -> thunkHeader\n        ct | ct == THUNK_SELECTOR -> thunkHeader\n        ct | ct == AP -> thunkHeader\n        ct | ct == AP_STACK -> thunkHeader\n        _ -> header\n  where\n    header = 1 + prof\n    thunkHeader = 2 + prof\n#if defined(PROFILING)\n    prof = 2\n#else\n    prof = 0\n#endif\n", "num_lines": 103}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The simplifier changes the shapes of closures that we expect.\n{-# OPTIONS_GHC -O0 #-}\n{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}\n\nimport GHC.Exts.Heap\n\nimport Control.Concurrent.MVar\nimport Control.DeepSeq\nimport Control.Monad\nimport GHC.Exts\nimport GHC.Int\nimport GHC.IO\nimport GHC.IORef\nimport GHC.MVar\nimport GHC.Stack\nimport GHC.STRef\nimport GHC.Word\nimport System.Environment\nimport System.Mem\n\nexData :: (Int,Int)\nexData = (1,2)\n\nexItbl :: StgInfoTable\nexItbl = StgInfoTable\n    { entry = Nothing\n    , ptrs = 0\n    , nptrs = 0\n    , tipe = toEnum 0\n    , srtlen = 0\n    , code = Nothing\n    }\n\nexConstrClosure :: Closure\nexConstrClosure = ConstrClosure\n    { info = exItbl{tipe=CONSTR_1_0, ptrs=1, nptrs=0}\n    , ptrArgs = []\n    , dataArgs = []\n    , pkg = \"base\"\n    , modl = \"GHC.Base\"\n    , name = \"Just\"\n    }\n\nexFunClosure :: Closure\nexFunClosure = FunClosure\n    { info = exItbl{tipe=FUN_0_1, ptrs=0, nptrs=1}\n    , ptrArgs = []\n    , dataArgs = [0]\n    }\n\nexThunkClosure :: Closure\nexThunkClosure = ThunkClosure\n    { info = exItbl{tipe=THUNK}\n    , ptrArgs = []\n    , dataArgs = []\n    }\n\nexSelectClosure :: Closure\nexSelectClosure = SelectorClosure\n    { info = exItbl\n    , selectee = asBox exData\n    }\n\nexPAPClosure :: Closure\nexPAPClosure = PAPClosure\n    { info = exItbl{tipe=PAP}\n    , arity = 1\n    , n_args = 1\n    , fun = asBox id\n    , payload = []\n    }\n\nexAPClosure :: Closure\nexAPClosure = APClosure\n    { info = exItbl{tipe=AP}\n    , arity = 0\n    , n_args = 0\n    , fun = asBox id\n    , payload = []\n    }\n\nexAPStackClosure :: Closure\nexAPStackClosure = APStackClosure\n    { info = exItbl{tipe=AP_STACK}\n    , fun = asBox id\n    , payload = []\n    }\n\nexIndClosure :: Closure\nexIndClosure = IndClosure\n    { info = exItbl{tipe=IND}\n    , indirectee = asBox []\n    }\n\nexBCOClosure :: Closure\nexBCOClosure = BCOClosure\n    { info = exItbl{tipe=BCO, ptrs=4}\n    , instrs = asBox []\n    , literals = asBox []\n    , bcoptrs = asBox []\n    , arity = 0\n    , size = 5\n    , bitmap = []\n    }\n\nexBlackholeClosure :: Closure\nexBlackholeClosure = BlackholeClosure\n    { info = exItbl{tipe=BLACKHOLE}\n    , indirectee = asBox []\n    }\n\nexArrWordsClosure :: Closure\nexArrWordsClosure = ArrWordsClosure\n    { info = exItbl{tipe=ARR_WORDS}\n    , bytes = 0\n    , arrWords = []\n    }\n\nexMutArrClosure :: Closure\nexMutArrClosure = MutArrClosure\n    { info = exItbl{tipe=MUT_ARR_PTRS_DIRTY}\n    , mccPtrs = 0\n    , mccSize = 0\n    , mccPayload = []\n    }\n\nexMVarClosure :: Closure\nexMVarClosure = MVarClosure\n    { info = exItbl{tipe=MVAR_DIRTY}\n    , queueHead = asBox []\n    , queueTail = asBox []\n    , value = asBox 0\n    }\n\nexMutVarClosure :: Closure\nexMutVarClosure = MutVarClosure\n    { info = exItbl{tipe=MUT_VAR_DIRTY}\n    , var = asBox []\n    }\n\nexBlockingQClosure :: Closure\nexBlockingQClosure = BlockingQueueClosure\n    { info = exItbl{tipe=BLOCKING_QUEUE}\n    , link = asBox []\n    , blackHole = asBox []\n    , owner = asBox []\n    , queue = asBox []\n    }\n\nexIntClosure :: Closure\nexIntClosure = IntClosure\n    { ptipe = PInt, intVal = 42 }\n\nexWordClosure :: Closure\nexWordClosure = WordClosure\n    { ptipe = PWord, wordVal = 42 }\n\nexInt64Closure :: Closure\nexInt64Closure = Int64Closure\n    { ptipe = PInt64, int64Val = 42 }\n\nexWord64Closure :: Closure\nexWord64Closure = Word64Closure\n    { ptipe = PWord64, word64Val = 42 }\n\nexAddrClosure :: Closure\nexAddrClosure = AddrClosure\n    { ptipe = PAddr, addrVal = 42 }\n\nexFloatClosure :: Closure\nexFloatClosure = FloatClosure\n    { ptipe = PFloat, floatVal = 42.0 }\n\nexDoubleClosure :: Closure\nexDoubleClosure = DoubleClosure\n    { ptipe = PDouble, doubleVal = 42.0 }\n\nexOtherClosure :: Closure\nexOtherClosure = OtherClosure\n    { info = exItbl\n    , hvalues = []\n    , rawWords = []\n    }\n\ndata A = A (Array# Int)\ndata MA = MA (MutableArray# RealWorld Int)\ndata BA = BA ByteArray#\ndata MBA = MBA (MutableByteArray# RealWorld)\ndata B = B BCO#\ndata APC a = APC a\n\nmain :: IO ()\nmain = do\n\n    --------------------------------------------\n    -- Objects to inspect\n\n    MA ma <- IO $ \\s ->\n        case newArray# 0# 0 s of\n            (# s1, x #) -> (# s1, MA x #)\n    A a <- IO $ \\s ->\n        case freezeArray# ma 0# 0# s of\n            (# s1, x #) -> (# s1, A x #)\n    MBA mba <- IO $ \\s ->\n        case newByteArray# 0# s of\n            (# s1, x #) -> (# s1, MBA x #)\n    BA ba <- IO $ \\s ->\n        case newByteArray# 0# s of\n            (# s1, x #) ->\n                case unsafeFreezeByteArray# x s1 of\n                    (# s2, y #) -> (# s2, BA y #)\n    B bco <- IO $ \\s ->\n        case newBCO# ba ba a 0# ba s of\n            (# s1, x #) -> (# s1, B x #)\n    APC apc <- IO $ \\s ->\n        case mkApUpd0# bco of\n            (# x #) -> (# s, APC x #)\n\n    --------------------------------------------\n    -- Closures\n\n    -- Constructor\n    let !con = Just 1\n    getClosureData con >>=\n        assertClosuresEq exConstrClosure\n\n    -- Function\n    let !fun = \\x -> x + 1\n    getClosureData fun >>=\n        assertClosuresEq exFunClosure\n\n    -- Thunk\n    let thunk = map (+2) [1,2,3]\n    getClosureData thunk >>=\n        assertClosuresEq exThunkClosure\n\n    -- Selector\n    -- FAILING: Getting THUNK not THUNK_SELECTOR\n    -- let sel = case exData of (a,_) -> a\n    -- getClosureData sel >>=\n    --     assertClosuresEq exSelectClosure\n\n    -- Partial application\n    let !f = map (+2)\n    getClosureData f >>=\n        assertClosuresEq exPAPClosure\n\n    -- Applied function\n    getClosureData apc >>=\n        assertClosuresEq exAPClosure\n\n    -- Suspended thunk evaluation\n    -- getClosureData (Just 1) >>=\n    --     assertClosuresEq exAPStackClosure\n\n    -- Indirection\n    -- getClosureData (Just 1) >>=\n    --     assertClosuresEq exIndClosure\n\n    -- ByteCode object\n    getClosureData bco >>=\n        assertClosuresEq exBCOClosure\n\n    -- Blackhole\n    -- getClosureData (Just 1) >>=\n    --     assertClosuresEq exBlackholeClosure\n\n    -- Byte array\n    getClosureData ba >>=\n        assertClosuresEq exArrWordsClosure\n\n    -- Mutable pointer array\n    getClosureData ma >>=\n        assertClosuresEq exMutArrClosure\n\n    -- MVar\n    (MVar v) <- newMVar 1\n    getClosureData (unsafeCoerce# v) >>=\n        assertClosuresEq exMVarClosure\n\n    -- MutVar\n    (IORef (STRef v)) <- newIORef 1\n    getClosureData v >>=\n        assertClosuresEq exMutVarClosure\n\n    -- Blocking queue\n    -- getClosureData (Just 1) >>=\n    --    assertClosuresEq exBlockingQClosure\n\n    -----------------------------------------------------\n    -- Unboxed unlifted types\n\n    -- Primitive Int\n    let (I# v) = 42\n    getClosureData v >>=\n        assertClosuresEq exIntClosure\n\n    -- Primitive Word\n    let (W# v) = 42\n    getClosureData v >>=\n        assertClosuresEq exWordClosure\n\n    -- Primitive Int64\n    -- FAILING: On 64-bit platforms, v is a regular Int\n    -- let (I64# v) = 42\n    -- getClosureData v >>=\n    --     assertClosuresEq exInt64Closure\n\n    -- Primitive Word64\n    -- FAILING: On 64-bit platforms, v is a regular Word\n    -- let (W64# v) = 42\n    -- getClosureData v >>=\n    --     assertClosuresEq exWord64Closure\n\n    -- Primitive Addr\n    let v = unsafeCoerce# 42# :: Addr#\n    getClosureData v >>=\n        assertClosuresEq exAddrClosure\n\n    -- Primitive Float\n    let (F# v) = 42.0\n    getClosureData v >>=\n        assertClosuresEq exFloatClosure\n\n    -- Primitive Double\n    let (D# v) = 42.0\n    getClosureData v >>=\n        assertClosuresEq exDoubleClosure\n\n    ------------------------------------------------------\n    -- Catch-all type\n\n    -- Other\n    -- getClosureData (Just 1) >>=\n    --    assertClosuresEq exOtherClosure\n\n    putStrLn \"Done. No errors.\"\n\n\n-- | Attempt to compare two closures\ncompareClosures :: Closure -> Closure -> Bool\ncompareClosures expected actual =\n    -- Determine which fields to compare based\n    -- upon expected closure type\n    let funcs = case expected of\n                    ConstrClosure{}         -> [ sEq (tipe . info)\n                                               , sEq (ptrs . info)\n                                               , sEq (nptrs . info)\n                                               , sEq dataArgs\n                                               , sEq name          ]\n                    FunClosure{}            -> [ sEq (tipe . info)\n                                               , sEq (ptrs . info)\n                                               , sEq (nptrs . info)\n                                               , sEq dataArgs      ]\n                    ThunkClosure{}          -> [ sEq (tipe . info)\n                                               , sEq (ptrs . info)\n                                               , sEq (nptrs . info)\n                                               , sEq dataArgs      ]\n                    SelectorClosure{}       -> [ sEq (tipe . info) ]\n                    PAPClosure{}            -> [ sEq (tipe . info)\n                                               , sEq arity\n                                               , sEq n_args        ]\n                    APClosure{}             -> [ sEq (tipe . info)\n                                               , sEq arity\n                                               , sEq n_args        ]\n                    APStackClosure{}        -> [ sEq (tipe . info) ]\n                    IndClosure{}            -> [ sEq (tipe . info) ]\n                    BCOClosure{}            -> [ sEq (tipe . info)\n                                               , sEq arity\n                                               , sEq bitmap        ]\n                    BlackholeClosure{}      -> [ sEq (tipe . info) ]\n                    ArrWordsClosure{}       -> [ sEq (tipe . info)\n                                               , sEq bytes\n                                               , sEq arrWords      ]\n                    MutArrClosure{}         -> [ sEq (tipe . info)\n                                               , sEq mccPtrs\n                                               , sEq mccSize       ]\n                    MVarClosure{}           -> [ sEq (tipe . info) ]\n                    MutVarClosure{}         -> [ sEq (tipe . info) ]\n                    BlockingQueueClosure{}  -> [ sEq (tipe . info) ]\n                    IntClosure{}            -> [ sEq ptipe\n                                               , sEq intVal    ]\n                    WordClosure{}           -> [ sEq ptipe\n                                               , sEq wordVal   ]\n                    Int64Closure{}          -> [ sEq ptipe\n                                               , sEq int64Val  ]\n                    Word64Closure{}         -> [ sEq ptipe\n                                               , sEq word64Val ]\n                    AddrClosure{}           -> [ sEq ptipe\n                                               , sEq addrVal   ]\n                    FloatClosure{}          -> [ sEq ptipe\n                                               , sEq floatVal  ]\n                    DoubleClosure{}         -> [ sEq ptipe\n                                               , sEq doubleVal ]\n                    _ -> error $ \"Don't know how to compare expected closure: \"\n                                 ++ show expected\n    in compareWith funcs expected actual\n  where\n    -- Take a list of closure comparisons and check all\n    compareWith :: [Closure -> Closure -> Bool] -> Closure -> Closure -> Bool\n    compareWith funcs c1 c2 = all (\\f -> f c1 c2) funcs\n\n    -- Create a comparison function from a selector\n    sEq :: Eq a => (Closure -> a) -> Closure -> Closure -> Bool\n    sEq select c1 c2 = select c1 == select c2\n\n-- | Assert two closures are equal, checking depending on closure type\nassertClosuresEq :: HasCallStack => Closure -> Closure -> IO ()\nassertClosuresEq _ c@UnsupportedClosure{} =\n    fail $ unlines [ \"Unsupported closure returned: \" ++ show c\n                   , \"\"\n                   , prettyCallStack callStack\n                   ]\nassertClosuresEq expected actual =\n    unless (compareClosures expected actual) $ fail $ unlines\n        [ \"assertClosuresEq: Closures do not match\"\n        , \"Expected: \" ++ show expected\n        , \"Actual:   \" ++ show actual\n        , \"\"\n        , prettyCallStack callStack\n        ]\n", "num_lines": 422}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- We need to do some ugly hacks here because of GHC magic\n\nmodule Main (main) where\n\nimport Control.Monad\nimport Data.List\nimport Data.Maybe\nimport Distribution.PackageDescription\nimport Distribution.Simple\nimport Distribution.Simple.LocalBuildInfo\nimport Distribution.Simple.Program\nimport Distribution.Simple.Utils\nimport Distribution.Text\nimport System.Cmd\nimport System.FilePath\nimport System.Exit\nimport System.Directory\n\nmain :: IO ()\nmain = do let hooks = simpleUserHooks {\n                  regHook = addPrimModule\n                          $ regHook simpleUserHooks,\n                  buildHook = build_primitive_sources\n                            $ buildHook simpleUserHooks,\n                  haddockHook = addPrimModuleForHaddock\n                              $ build_primitive_sources\n                              $ haddockHook simpleUserHooks }\n          defaultMainWithHooks hooks\n\ntype Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()\n\naddPrimModule :: Hook a -> Hook a\naddPrimModule f pd lbi uhs x =\n    do let -- I'm not sure which one of these we actually need to change.\n           -- It seems bad that there are two.\n           pd' = addPrimModuleToPD pd\n           lpd = addPrimModuleToPD (localPkgDescr lbi)\n           lbi' = lbi { localPkgDescr = lpd }\n       f pd' lbi' uhs x\n\naddPrimModuleForHaddock :: Hook a -> Hook a\naddPrimModuleForHaddock f pd lbi uhs x =\n    do let pc = withPrograms lbi\n           pc' = userSpecifyArgs \"haddock\" [\"GHC/Prim.hs\"] pc\n           lbi' = lbi { withPrograms = pc' }\n       f pd lbi' uhs x\n\naddPrimModuleToPD :: PackageDescription -> PackageDescription\naddPrimModuleToPD pd =\n    case library pd of\n    Just lib ->\n        let ems = fromJust (simpleParse \"GHC.Prim\") : exposedModules lib\n            lib' = lib { exposedModules = ems }\n        in pd { library = Just lib' }\n    Nothing ->\n        error \"Expected a library, but none found\"\n\nbuild_primitive_sources :: Hook a -> Hook a\nbuild_primitive_sources f pd lbi uhs x\n = do when (compilerFlavor (compiler lbi) == GHC) $ do\n          let genprimopcode = joinPath [\"..\", \"..\", \"utils\",\n                                        \"genprimopcode\", \"genprimopcode\"]\n              primops = joinPath [\"..\", \"..\", \"compiler\", \"prelude\",\n                                  \"primops.txt\"]\n              primhs = joinPath [\"GHC\", \"Prim.hs\"]\n              primopwrappers = joinPath [\"GHC\", \"PrimopWrappers.hs\"]\n              primhs_tmp = addExtension primhs \"tmp\"\n              primopwrappers_tmp = addExtension primopwrappers \"tmp\"\n          maybeExit $ system (genprimopcode ++ \" --make-haskell-source < \"\n                           ++ primops ++ \" > \" ++ primhs_tmp)\n          maybeUpdateFile primhs_tmp primhs\n          maybeExit $ system (genprimopcode ++ \" --make-haskell-wrappers < \"\n                           ++ primops ++ \" > \" ++ primopwrappers_tmp)\n          maybeUpdateFile primopwrappers_tmp primopwrappers\n      f pd lbi uhs x\n\n-- Replace a file only if the new version is different from the old.\n-- This prevents make from doing unnecessary work after we run 'setup makefile'\nmaybeUpdateFile :: FilePath -> FilePath -> IO ()\nmaybeUpdateFile source target = do\n  r <- rawSystem \"cmp\" [\"-s\" {-quiet-}, source, target]\n  case r of\n    ExitSuccess   -> removeFile source\n    ExitFailure _ -> do exists <- doesFileExist target\n                        when exists $ removeFile target\n                        renameFile source target\n\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,\n             KindSignatures, DataKinds, ConstraintKinds,\n              MultiParamTypeClasses, FunctionalDependencies #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n  -- ip :: IP x a => a  is strictly speaking ambiguous, but IP is magic\n{-# LANGUAGE UndecidableSuperClasses #-}\n  -- Because of the type-variable superclasses for tuples\n\n{-# OPTIONS_GHC -Wno-unused-imports #-}\n-- -Wno-unused-imports needed for the GHC.Tuple import below. Sigh.\n\n{-# OPTIONS_GHC -Wno-unused-top-binds #-}\n-- -Wno-unused-top-binds is there (I hope) to stop Haddock complaining\n-- about the constraint tuples being defined but not used\n\n{-# OPTIONS_HADDOCK not-home #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Classes\n-- Copyright   :  (c) The University of Glasgow, 1992-2002\n-- License     :  see libraries/base/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC extensions)\n--\n-- Basic classes.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Classes(\n    -- * Implicit paramaters\n    IP(..),\n\n    -- * Equality and ordering\n    Eq(..),\n    Ord(..),\n    -- ** Monomorphic equality operators\n    -- $matching_overloaded_methods_in_rules\n    eqInt, neInt,\n    eqWord, neWord,\n    eqChar, neChar,\n    eqFloat, eqDouble,\n    -- ** Monomorphic comparison operators\n    gtInt, geInt, leInt, ltInt, compareInt, compareInt#,\n    gtWord, geWord, leWord, ltWord, compareWord, compareWord#,\n\n    -- * Functions over Bool\n    (&&), (||), not,\n\n    -- * Integer arithmetic\n    divInt#, modInt#\n ) where\n\n-- GHC.Magic is used in some derived instances\nimport GHC.Magic ()\nimport GHC.IntWord64\nimport GHC.Prim\nimport GHC.Tuple\nimport GHC.CString (unpackCString#)\nimport GHC.Types\n\n#include \"MachDeps.h\"\n\ninfix  4  ==, /=, <, <=, >=, >\ninfixr 3  &&\ninfixr 2  ||\n\ndefault ()              -- Double isn't available yet\n\n-- | The syntax @?x :: a@ is desugared into @IP \"x\" a@\n-- IP is declared very early, so that libraries can take\n-- advantage of the implicit-call-stack feature\nclass IP (x :: Symbol) a | x -> a where\n  ip :: a\n\n{- $matching_overloaded_methods_in_rules\n\nMatching on class methods (e.g. @(==)@) in rewrite rules tends to be a bit\nfragile. For instance, consider this motivating example from the @bytestring@\nlibrary,\n\n@\nbreak :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)\nbreakByte :: Word8 -> ByteString -> (ByteString, ByteString)\n\\{\\-\\# RULES \"break -> breakByte\" forall a. break (== x) = breakByte x \\#\\-\\}\n@\n\nHere we have two functions, with @breakByte@ providing an optimized\nimplementation of @break@ where the predicate is merely testing for equality\nwith a known @Word8@. As written, however, this rule will be quite fragile as\nthe @(==)@ class operation rule may rewrite the predicate before our @break@\nrule has a chance to fire.\n\nFor this reason, most of the primitive types in @base@ have 'Eq' and 'Ord'\ninstances defined in terms of helper functions with inlinings delayed to phase\n1. For instance, @Word8@\\'s @Eq@ instance looks like,\n\n@\ninstance Eq Word8 where\n    (==) = eqWord8\n    (/=) = neWord8\n\neqWord8, neWord8 :: Word8 -> Word8 -> Bool\neqWord8 (W8# x) (W8# y) = ...\nneWord8 (W8# x) (W8# y) = ...\n\\{\\-\\# INLINE [1] eqWord8 \\#\\-\\}\n\\{\\-\\# INLINE [1] neWord8 \\#\\-\\}\n@\n\nThis allows us to save our @break@ rule above by rewriting it to instead match\nagainst @eqWord8@,\n\n@\n\\{\\-\\# RULES \"break -> breakByte\" forall a. break (`eqWord8` x) = breakByte x \\#\\-\\}\n@\n\nCurrently this is only done for @('==')@, @('/=')@, @('<')@, @('<=')@, @('>')@,\nand @('>=')@ for the types in \"GHC.Word\" and \"GHC.Int\".\n-}\n\n-- | The 'Eq' class defines equality ('==') and inequality ('/=').\n-- All the basic datatypes exported by the \"Prelude\" are instances of 'Eq',\n-- and 'Eq' may be derived for any datatype whose constituents are also\n-- instances of 'Eq'.\n--\n-- The Haskell Report defines no laws for 'Eq'. However, '==' is customarily\n-- expected to implement an equivalence relationship where two values comparing\n-- equal are indistinguishable by \"public\" functions, with a \"public\" function\n-- being one not allowing to see implementation details. For example, for a\n-- type representing non-normalised natural numbers modulo 100, a \"public\"\n-- function doesn't make the difference between 1 and 201. It is expected to\n-- have the following properties:\n--\n-- [__Reflexivity__]: @x == x@ = 'True'\n-- [__Symmetry__]: @x == y@ = @y == x@\n-- [__Transitivity__]: if @x == y && y == z@ = 'True', then @x == z@ = 'True'\n-- [__Substitutivity__]: if @x == y@ = 'True' and @f@ is a \"public\" function\n-- whose return type is an instance of 'Eq', then @f x == f y@ = 'True'\n-- [__Negation__]: @x /= y@ = @not (x == y)@\n--\n-- Minimal complete definition: either '==' or '/='.\n--\nclass  Eq a  where\n    (==), (/=)           :: a -> a -> Bool\n\n    {-# INLINE (/=) #-}\n    {-# INLINE (==) #-}\n    x /= y               = not (x == y)\n    x == y               = not (x /= y)\n    {-# MINIMAL (==) | (/=) #-}\n\nderiving instance Eq ()\nderiving instance (Eq  a, Eq  b) => Eq  (a, b)\nderiving instance (Eq  a, Eq  b, Eq  c) => Eq  (a, b, c)\nderiving instance (Eq  a, Eq  b, Eq  c, Eq  d) => Eq  (a, b, c, d)\nderiving instance (Eq  a, Eq  b, Eq  c, Eq  d, Eq  e) => Eq  (a, b, c, d, e)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)\n               => Eq (a, b, c, d, e, f)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)\n               => Eq (a, b, c, d, e, f, g)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h)\n               => Eq (a, b, c, d, e, f, g, h)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h, Eq i)\n               => Eq (a, b, c, d, e, f, g, h, i)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h, Eq i, Eq j)\n               => Eq (a, b, c, d, e, f, g, h, i, j)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h, Eq i, Eq j, Eq k)\n               => Eq (a, b, c, d, e, f, g, h, i, j, k)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h, Eq i, Eq j, Eq k, Eq l)\n               => Eq (a, b, c, d, e, f, g, h, i, j, k, l)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h, Eq i, Eq j, Eq k, Eq l, Eq m)\n               => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n)\n               => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)\nderiving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,\n                   Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o)\n               => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)\n\ninstance (Eq a) => Eq [a] where\n    {-# SPECIALISE instance Eq [[Char]] #-}\n    {-# SPECIALISE instance Eq [Char] #-}\n    {-# SPECIALISE instance Eq [Int] #-}\n    []     == []     = True\n    (x:xs) == (y:ys) = x == y && xs == ys\n    _xs    == _ys    = False\n\nderiving instance Eq Module\n\ninstance Eq TrName where\n    TrNameS a == TrNameS b = isTrue# (a `eqAddr#` b)\n    a == b = toString a == toString b\n      where\n        toString (TrNameS s) = unpackCString# s\n        toString (TrNameD s) = s\n\nderiving instance Eq Bool\nderiving instance Eq Ordering\n\ninstance Eq Word where\n    (==) = eqWord\n    (/=) = neWord\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n{-# INLINE [1] eqWord #-}\n{-# INLINE [1] neWord #-}\neqWord, neWord :: Word -> Word -> Bool\n(W# x) `eqWord` (W# y) = isTrue# (x `eqWord#` y)\n(W# x) `neWord` (W# y) = isTrue# (x `neWord#` y)\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\ninstance Eq Char where\n    (==) = eqChar\n    (/=) = neChar\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n{-# INLINE [1] eqChar #-}\n{-# INLINE [1] neChar #-}\neqChar, neChar :: Char -> Char -> Bool\n(C# x) `eqChar` (C# y) = isTrue# (x `eqChar#` y)\n(C# x) `neChar` (C# y) = isTrue# (x `neChar#` y)\n\n-- | Note that due to the presence of @NaN@, `Float`'s 'Eq' instance does not\n-- satisfy reflexivity.\n--\n-- >>> 0/0 == (0/0 :: Float)\n-- False\n--\n-- Also note that `Float`'s 'Eq' instance does not satisfy substitutivity:\n--\n-- >>> 0 == (-0 :: Float)\n-- True\n-- >>> recip 0 == recip (-0 :: Float)\n-- False\ninstance Eq Float where\n    (==) = eqFloat\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n{-# INLINE [1] eqFloat #-}\neqFloat :: Float -> Float -> Bool\n(F# x) `eqFloat` (F# y) = isTrue# (x `eqFloat#` y)\n\n-- | Note that due to the presence of @NaN@, `Double`'s 'Eq' instance does not\n-- satisfy reflexivity.\n--\n-- >>> 0/0 == (0/0 :: Double)\n-- False\n--\n-- Also note that `Double`'s 'Eq' instance does not satisfy substitutivity:\n--\n-- >>> 0 == (-0 :: Double)\n-- True\n-- >>> recip 0 == recip (-0 :: Double)\n-- False\ninstance Eq Double where\n    (==) = eqDouble\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n{-# INLINE [1] eqDouble #-}\neqDouble :: Double -> Double -> Bool\n(D# x) `eqDouble` (D# y) = isTrue# (x ==## y)\n\ninstance Eq Int where\n    (==) = eqInt\n    (/=) = neInt\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n{-# INLINE [1] eqInt #-}\n{-# INLINE [1] neInt #-}\neqInt, neInt :: Int -> Int -> Bool\n(I# x) `eqInt` (I# y) = isTrue# (x ==# y)\n(I# x) `neInt` (I# y) = isTrue# (x /=# y)\n\n#if WORD_SIZE_IN_BITS < 64\ninstance Eq TyCon where\n  (==) (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _)\n       = isTrue# (hi1 `eqWord64#` hi2) && isTrue# (lo1 `eqWord64#` lo2)\ninstance Ord TyCon where\n  compare (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _)\n    | isTrue# (hi1 `gtWord64#` hi2) = GT\n    | isTrue# (hi1 `ltWord64#` hi2) = LT\n    | isTrue# (lo1 `gtWord64#` lo2) = GT\n    | isTrue# (lo1 `ltWord64#` lo2) = LT\n    | True                = EQ\n#else\ninstance Eq TyCon where\n  (==) (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _)\n       = isTrue# (hi1 `eqWord#` hi2) && isTrue# (lo1 `eqWord#` lo2)\ninstance Ord TyCon where\n  compare (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _)\n    | isTrue# (hi1 `gtWord#` hi2) = GT\n    | isTrue# (hi1 `ltWord#` hi2) = LT\n    | isTrue# (lo1 `gtWord#` lo2) = GT\n    | isTrue# (lo1 `ltWord#` lo2) = LT\n    | True              = EQ\n#endif\n\n\n-- | The 'Ord' class is used for totally ordered datatypes.\n--\n-- Instances of 'Ord' can be derived for any user-defined datatype whose\n-- constituent types are in 'Ord'. The declared order of the constructors in\n-- the data declaration determines the ordering in derived 'Ord' instances. The\n-- 'Ordering' datatype allows a single comparison to determine the precise\n-- ordering of two objects.\n--\n-- The Haskell Report defines no laws for 'Ord'. However, '<=' is customarily\n-- expected to implement a non-strict partial order and have the following\n-- properties:\n--\n-- [__Transitivity__]: if @x <= y && y <= z@ = 'True', then @x <= z@ = 'True'\n-- [__Reflexivity__]: @x <= x@ = 'True'\n-- [__Antisymmetry__]: if @x <= y && y <= x@ = 'True', then @x == y@ = 'True'\n--\n-- Note that the following operator interactions are expected to hold:\n--\n-- 1. @x >= y@ = @y <= x@\n-- 2. @x < y@ = @x <= y && x /= y@\n-- 3. @x > y@ = @y < x@\n-- 4. @x < y@ = @compare x y == LT@\n-- 5. @x > y@ = @compare x y == GT@\n-- 6. @x == y@ = @compare x y == EQ@\n-- 7. @min x y == if x <= y then x else y@ = 'True'\n-- 8. @max x y == if x >= y then x else y@ = 'True'\n--\n-- Minimal complete definition: either 'compare' or '<='.\n-- Using 'compare' can be more efficient for complex types.\n--\nclass  (Eq a) => Ord a  where\n    compare              :: a -> a -> Ordering\n    (<), (<=), (>), (>=) :: a -> a -> Bool\n    max, min             :: a -> a -> a\n\n    compare x y = if x == y then EQ\n                  -- NB: must be '<=' not '<' to validate the\n                  -- above claim about the minimal things that\n                  -- can be defined for an instance of Ord:\n                  else if x <= y then LT\n                  else GT\n\n    x <  y = case compare x y of { LT -> True;  _ -> False }\n    x <= y = case compare x y of { GT -> False; _ -> True }\n    x >  y = case compare x y of { GT -> True;  _ -> False }\n    x >= y = case compare x y of { LT -> False; _ -> True }\n\n        -- These two default methods use '<=' rather than 'compare'\n        -- because the latter is often more expensive\n    max x y = if x <= y then y else x\n    min x y = if x <= y then x else y\n    {-# MINIMAL compare | (<=) #-}\n\nderiving instance Ord ()\nderiving instance (Ord a, Ord b) => Ord (a, b)\nderiving instance (Ord a, Ord b, Ord c) => Ord (a, b, c)\nderiving instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)\n               => Ord (a, b, c, d, e, f)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g)\n               => Ord (a, b, c, d, e, f, g)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h)\n               => Ord (a, b, c, d, e, f, g, h)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h, Ord i)\n               => Ord (a, b, c, d, e, f, g, h, i)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h, Ord i, Ord j)\n               => Ord (a, b, c, d, e, f, g, h, i, j)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h, Ord i, Ord j, Ord k)\n               => Ord (a, b, c, d, e, f, g, h, i, j, k)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h, Ord i, Ord j, Ord k, Ord l)\n               => Ord (a, b, c, d, e, f, g, h, i, j, k, l)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h, Ord i, Ord j, Ord k, Ord l, Ord m)\n               => Ord (a, b, c, d, e, f, g, h, i, j, k, l, m)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n)\n               => Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n)\nderiving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,\n                   Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n, Ord o)\n               => Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)\n\ninstance (Ord a) => Ord [a] where\n    {-# SPECIALISE instance Ord [[Char]] #-}\n    {-# SPECIALISE instance Ord [Char] #-}\n    {-# SPECIALISE instance Ord [Int] #-}\n    compare []     []     = EQ\n    compare []     (_:_)  = LT\n    compare (_:_)  []     = GT\n    compare (x:xs) (y:ys) = case compare x y of\n                                EQ    -> compare xs ys\n                                other -> other\n\nderiving instance Ord Bool\nderiving instance Ord Ordering\n\n-- We don't use deriving for Ord Char, because for Ord the derived\n-- instance defines only compare, which takes two primops.  Then\n-- '>' uses compare, and therefore takes two primops instead of one.\ninstance Ord Char where\n    (C# c1) >  (C# c2) = isTrue# (c1 `gtChar#` c2)\n    (C# c1) >= (C# c2) = isTrue# (c1 `geChar#` c2)\n    (C# c1) <= (C# c2) = isTrue# (c1 `leChar#` c2)\n    (C# c1) <  (C# c2) = isTrue# (c1 `ltChar#` c2)\n\n-- | Note that due to the presence of @NaN@, `Float`'s 'Ord' instance does not\n-- satisfy reflexivity.\n--\n-- >>> 0/0 <= (0/0 :: Float)\n-- False\n--\n-- Also note that, due to the same, `Ord`'s operator interactions are not\n-- respected by `Float`'s instance:\n--\n-- >>> (0/0 :: Float) > 1\n-- False\n-- >>> compare (0/0 :: Float) 1\n-- GT\ninstance Ord Float where\n    (F# x) `compare` (F# y)\n        = if      isTrue# (x `ltFloat#` y) then LT\n          else if isTrue# (x `eqFloat#` y) then EQ\n          else                                  GT\n\n    (F# x) <  (F# y) = isTrue# (x `ltFloat#` y)\n    (F# x) <= (F# y) = isTrue# (x `leFloat#` y)\n    (F# x) >= (F# y) = isTrue# (x `geFloat#` y)\n    (F# x) >  (F# y) = isTrue# (x `gtFloat#` y)\n\n-- | Note that due to the presence of @NaN@, `Double`'s 'Ord' instance does not\n-- satisfy reflexivity.\n--\n-- >>> 0/0 <= (0/0 :: Double)\n-- False\n--\n-- Also note that, due to the same, `Ord`'s operator interactions are not\n-- respected by `Double`'s instance:\n--\n-- >>> (0/0 :: Double) > 1\n-- False\n-- >>> compare (0/0 :: Double) 1\n-- GT\ninstance Ord Double where\n    (D# x) `compare` (D# y)\n        = if      isTrue# (x <##  y) then LT\n          else if isTrue# (x ==## y) then EQ\n          else                            GT\n\n    (D# x) <  (D# y) = isTrue# (x <##  y)\n    (D# x) <= (D# y) = isTrue# (x <=## y)\n    (D# x) >= (D# y) = isTrue# (x >=## y)\n    (D# x) >  (D# y) = isTrue# (x >##  y)\n\ninstance Ord Int where\n    compare = compareInt\n    (<)     = ltInt\n    (<=)    = leInt\n    (>=)    = geInt\n    (>)     = gtInt\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n{-# INLINE [1] gtInt #-}\n{-# INLINE [1] geInt #-}\n{-# INLINE [1] ltInt #-}\n{-# INLINE [1] leInt #-}\ngtInt, geInt, ltInt, leInt :: Int -> Int -> Bool\n(I# x) `gtInt` (I# y) = isTrue# (x >#  y)\n(I# x) `geInt` (I# y) = isTrue# (x >=# y)\n(I# x) `ltInt` (I# y) = isTrue# (x <#  y)\n(I# x) `leInt` (I# y) = isTrue# (x <=# y)\n\ncompareInt :: Int -> Int -> Ordering\n(I# x#) `compareInt` (I# y#) = compareInt# x# y#\n\ncompareInt# :: Int# -> Int# -> Ordering\ncompareInt# x# y#\n    | isTrue# (x# <#  y#) = LT\n    | isTrue# (x# ==# y#) = EQ\n    | True                = GT\n\ninstance Ord Word where\n    compare = compareWord\n    (<)     = ltWord\n    (<=)    = leWord\n    (>=)    = geWord\n    (>)     = gtWord\n\n-- See GHC.Classes#matching_overloaded_methods_in_rules\n{-# INLINE [1] gtWord #-}\n{-# INLINE [1] geWord #-}\n{-# INLINE [1] ltWord #-}\n{-# INLINE [1] leWord #-}\ngtWord, geWord, ltWord, leWord :: Word -> Word -> Bool\n(W# x) `gtWord` (W# y) = isTrue# (x `gtWord#` y)\n(W# x) `geWord` (W# y) = isTrue# (x `geWord#` y)\n(W# x) `ltWord` (W# y) = isTrue# (x `ltWord#` y)\n(W# x) `leWord` (W# y) = isTrue# (x `leWord#` y)\n\ncompareWord :: Word -> Word -> Ordering\n(W# x#) `compareWord` (W# y#) = compareWord# x# y#\n\ncompareWord# :: Word# -> Word# -> Ordering\ncompareWord# x# y#\n    | isTrue# (x# `ltWord#` y#) = LT\n    | isTrue# (x# `eqWord#` y#) = EQ\n    | True                      = GT\n\n-- OK, so they're technically not part of a class...:\n\n-- Boolean functions\n\n-- | Boolean \\\"and\\\"\n(&&)                    :: Bool -> Bool -> Bool\nTrue  && x              =  x\nFalse && _              =  False\n\n-- | Boolean \\\"or\\\"\n(||)                    :: Bool -> Bool -> Bool\nTrue  || _              =  True\nFalse || x              =  x\n\n-- | Boolean \\\"not\\\"\nnot                     :: Bool -> Bool\nnot True                =  False\nnot False               =  True\n\n\n------------------------------------------------------------------------\n-- These don't really belong here, but we don't have a better place to\n-- put them\n\n-- These functions have built-in rules.\n{-# NOINLINE [0] divInt# #-}\n{-# NOINLINE [0] modInt# #-}\ndivInt# :: Int# -> Int# -> Int#\nx# `divInt#` y#\n        -- Be careful NOT to overflow if we do any additional arithmetic\n        -- on the arguments...  the following  previous version of this\n        -- code has problems with overflow:\n--    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#\n--    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#\n    =      if isTrue# (x# ># 0#) && isTrue# (y# <# 0#) then ((x# -# 1#) `quotInt#` y#) -# 1#\n      else if isTrue# (x# <# 0#) && isTrue# (y# ># 0#) then ((x# +# 1#) `quotInt#` y#) -# 1#\n      else x# `quotInt#` y#\n\nmodInt# :: Int# -> Int# -> Int#\nx# `modInt#` y#\n    = if isTrue# (x# ># 0#) && isTrue# (y# <# 0#) ||\n         isTrue# (x# <# 0#) && isTrue# (y# ># 0#)\n      then if isTrue# (r# /=# 0#) then r# +# y# else 0#\n      else r#\n    where\n    !r# = x# `remInt#` y#\n\n\n{- *************************************************************\n*                                                              *\n*               Constraint tuples                              *\n*                                                              *\n************************************************************* -}\n\nclass ()\nclass (c1, c2)     => (c1, c2)\nclass (c1, c2, c3) => (c1, c2, c3)\nclass (c1, c2, c3, c4) => (c1, c2, c3, c4)\nclass (c1, c2, c3, c4, c5) => (c1, c2, c3, c4, c5)\nclass (c1, c2, c3, c4, c5, c6) => (c1, c2, c3, c4, c5, c6)\nclass (c1, c2, c3, c4, c5, c6, c7) => (c1, c2, c3, c4, c5, c6, c7)\nclass (c1, c2, c3, c4, c5, c6, c7, c8) => (c1, c2, c3, c4, c5, c6, c7, c8)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17,c18)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59, c60)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59, c60)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59, c60, c61)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59, c60, c61)\nclass (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59, c60, c61, c62)\n   => (c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16,\n       c17, c18, c19, c20, c21, c22, c23, c24, c25, c26, c27, c28, c29, c30,\n       c31, c32, c33, c34, c35, c36, c37, c38, c39, c40, c41, c42, c43, c44,\n       c45, c46, c47, c48, c49, c50, c51, c52, c53, c54, c55, c56, c57, c58,\n       c59, c60, c61, c62)\n", "num_lines": 889}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, NoImplicitPrelude, BangPatterns #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.CString\n-- Copyright   :  (c) The University of Glasgow 2011\n-- License     :  see libraries/ghc-prim/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- GHC C strings definitions (previously in GHC.Base).\n-- Use GHC.Exts from the base package instead of importing this\n-- module directly.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.CString (\n        unpackCString#, unpackAppendCString#, unpackFoldrCString#,\n        unpackCStringUtf8#, unpackNBytes#\n    ) where\n\nimport GHC.Types\nimport GHC.Prim\n\n-----------------------------------------------------------------------------\n-- Unpacking C strings\n-----------------------------------------------------------------------------\n\n-- This code is needed for virtually all programs, since it's used for\n-- unpacking the strings of error messages.\n\n-- Used to be in GHC.Base, but was moved to ghc-prim because the new generics\n-- stuff uses Strings in the representation, so to give representations for\n-- ghc-prim types we need unpackCString#\n\n{- Note [Inlining unpackCString#]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nThere's really no point in ever inlining things like unpackCString# as the loop\ndoesn't specialise in an interesting way and we can't deforest the list\nconstructors (we'd want to use unpackFoldrCString# for this). Moreover, it's\npretty small, so there's a danger that it'll be inlined at every literal, which\nis a waste.\n\nMoreover, inlining early may interfere with a variety of rules that are supposed\nto match unpackCString#,\n\n * BuiltInRules in PrelRules.hs; e.g.\n       eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)\n          = s1 == s2\n\n * unpacking rules; e.g. in GHC.Base,\n       unpackCString# a\n          = build (unpackFoldrCString# a)\n\n * stream fusion rules; e.g. in the `text` library,\n       unstream (S.map safe (S.streamList (GHC.unpackCString# a)))\n          = unpackCString# a\n\nMoreover, we want to make it CONLIKE, so that:\n\n* the rules in PrelRules will fire when the string is let-bound.\n  E.g. the eqString rule in PrelRules\n   eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2\n\n* exprIsConApp_maybe will see the string when we have\n     let x = unpackCString# \"foo\"#\n     ...(case x of algs)...\n\nAll of this goes for unpackCStringUtf8# too.\n-}\n\nunpackCString# :: Addr# -> [Char]\n{-# NOINLINE CONLIKE unpackCString# #-}\nunpackCString# addr\n  = unpack 0#\n  where\n    unpack nh\n      | isTrue# (ch `eqChar#` '\\0'#) = []\n      | True                         = C# ch : unpack (nh +# 1#)\n      where\n        !ch = indexCharOffAddr# addr nh\n\nunpackAppendCString# :: Addr# -> [Char] -> [Char]\n{-# NOINLINE unpackAppendCString# #-}\n     -- See the NOINLINE note on unpackCString#\nunpackAppendCString# addr rest\n  = unpack 0#\n  where\n    unpack nh\n      | isTrue# (ch `eqChar#` '\\0'#) = rest\n      | True                         = C# ch : unpack (nh +# 1#)\n      where\n        !ch = indexCharOffAddr# addr nh\n\nunpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a\n\n-- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#\n\n-- It also has a BuiltInRule in PrelRules.hs:\n--      unpackFoldrCString# \"foo\" c (unpackFoldrCString# \"baz\" c n)\n--        =  unpackFoldrCString# \"foobaz\" c n\n\n{-# NOINLINE unpackFoldrCString# #-}\n-- At one stage I had NOINLINE [0] on the grounds that, unlike\n-- unpackCString#, there *is* some point in inlining\n-- unpackFoldrCString#, because we get better code for the\n-- higher-order function call.  BUT there may be a lot of\n-- literal strings, and making a separate 'unpack' loop for\n-- each is highly gratuitous.  See nofib/real/anna/PrettyPrint.\n\nunpackFoldrCString# addr f z\n  = unpack 0#\n  where\n    unpack nh\n      | isTrue# (ch `eqChar#` '\\0'#) = z\n      | True                         = C# ch `f` unpack (nh +# 1#)\n      where\n        !ch = indexCharOffAddr# addr nh\n\n-- There's really no point in inlining this for the same reasons as\n-- unpackCString. See Note [Inlining unpackCString#] above for details.\nunpackCStringUtf8# :: Addr# -> [Char]\n{-# NOINLINE CONLIKE unpackCStringUtf8# #-}\nunpackCStringUtf8# addr\n  = unpack 0#\n  where\n    -- We take care to strictly evaluate the character decoding as\n    -- indexCharOffAddr# is marked with the can_fail flag and\n    -- consequently GHC won't evaluate the expression unless it is absolutely\n    -- needed.\n    unpack nh\n      | isTrue# (ch `eqChar#` '\\0'#  ) = []\n      | isTrue# (ch `leChar#` '\\x7F'#) = C# ch : unpack (nh +# 1#)\n      | isTrue# (ch `leChar#` '\\xDF'#) =\n          let !c = C# (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#\n                              (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#)))\n          in c : unpack (nh +# 2#)\n      | isTrue# (ch `leChar#` '\\xEF'#) =\n          let !c = C# (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#\n                             ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#\n                              (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#)))\n          in c : unpack (nh +# 3#)\n      | True                           =\n          let !c = C# (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#\n                             ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#\n                             ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#\n                              (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#)))\n          in c : unpack (nh +# 4#)\n      where\n        !ch = indexCharOffAddr# addr nh\n\n-- There's really no point in inlining this for the same reasons as\n-- unpackCString. See Note [Inlining unpackCString#] above for details.\nunpackNBytes# :: Addr# -> Int# -> [Char]\n{-# NOINLINE unpackNBytes# #-}\nunpackNBytes# _addr 0#   = []\nunpackNBytes#  addr len# = unpack [] (len# -# 1#)\n    where\n     unpack acc i#\n      | isTrue# (i# <# 0#)  = acc\n      | True                =\n         case indexCharOffAddr# addr i# of\n            ch -> unpack (C# ch : acc) (i# -# 1#)\n\n", "num_lines": 166}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples, UnliftedFFITypes #-}\n\nmodule GHC.Debug ( debugLn, debugErrLn ) where\n\nimport GHC.Prim\nimport GHC.Types\nimport GHC.Tuple ()\n\ndebugLn :: [Char] -> IO ()\ndebugLn xs = IO (\\s0 ->\n                 case mkMBA s0 xs of\n                 (# s1, mba #) ->\n                     case c_debugLn mba of\n                     IO f -> f s1)\n\ndebugErrLn :: [Char] -> IO ()\ndebugErrLn xs = IO (\\s0 ->\n                    case mkMBA s0 xs of\n                    (# s1, mba #) ->\n                        case c_debugErrLn mba of\n                        IO f -> f s1)\n\nforeign import ccall unsafe \"debugLn\"\n    c_debugLn :: MutableByteArray# RealWorld -> IO ()\n\nforeign import ccall unsafe \"debugErrLn\"\n    c_debugErrLn :: MutableByteArray# RealWorld -> IO ()\n\nmkMBA :: State# RealWorld -> [Char] ->\n         (# State# RealWorld, MutableByteArray# RealWorld #)\nmkMBA s0 xs = -- Start with 1 so that we have space to put in a \\0 at\n              -- the end\n              case len 1# xs of\n              l ->\n                  case newByteArray# l s0 of\n                  (# s1, mba #) ->\n                      case write mba 0# xs s1 of\n                      s2 -> (# s2, mba #)\n    where len l [] = l\n          len l (_ : xs') = len (l +# 1#) xs'\n\n          write mba offset [] s = writeCharArray# mba offset '\\0'# s\n          write mba offset (C# x : xs') s\n              = case writeCharArray# mba offset x s of\n                s' ->\n                    write mba (offset +# 1#) xs' s'\n\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, UnliftedFFITypes #-}\n{-# OPTIONS_HADDOCK not-home #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.IntWord64\n-- Copyright   :  (c) The University of Glasgow, 1997-2008\n-- License     :  see libraries/ghc-prim/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- Primitive operations on Int64# and Word64# on platforms where\n-- WORD_SIZE_IN_BITS < 64.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.IntWord64 (\n#if WORD_SIZE_IN_BITS < 64\n        Int64#, Word64#, module GHC.IntWord64\n#endif\n    ) where\n\nimport GHC.Types () -- Make implicit dependency known to build system\n\n#if WORD_SIZE_IN_BITS < 64\n\nimport GHC.Prim\n\nforeign import ccall unsafe \"hs_eqWord64\"    eqWord64#     :: Word64# -> Word64# -> Int#\nforeign import ccall unsafe \"hs_neWord64\"    neWord64#     :: Word64# -> Word64# -> Int#\nforeign import ccall unsafe \"hs_ltWord64\"    ltWord64#     :: Word64# -> Word64# -> Int#\nforeign import ccall unsafe \"hs_leWord64\"    leWord64#     :: Word64# -> Word64# -> Int#\nforeign import ccall unsafe \"hs_gtWord64\"    gtWord64#     :: Word64# -> Word64# -> Int#\nforeign import ccall unsafe \"hs_geWord64\"    geWord64#     :: Word64# -> Word64# -> Int#\n\nforeign import ccall unsafe \"hs_eqInt64\"     eqInt64#      :: Int64# -> Int64# -> Int#\nforeign import ccall unsafe \"hs_neInt64\"     neInt64#      :: Int64# -> Int64# -> Int#\nforeign import ccall unsafe \"hs_ltInt64\"     ltInt64#      :: Int64# -> Int64# -> Int#\nforeign import ccall unsafe \"hs_leInt64\"     leInt64#      :: Int64# -> Int64# -> Int#\nforeign import ccall unsafe \"hs_gtInt64\"     gtInt64#      :: Int64# -> Int64# -> Int#\nforeign import ccall unsafe \"hs_geInt64\"     geInt64#      :: Int64# -> Int64# -> Int#\nforeign import ccall unsafe \"hs_quotInt64\"   quotInt64#    :: Int64# -> Int64# -> Int64#\nforeign import ccall unsafe \"hs_remInt64\"    remInt64#     :: Int64# -> Int64# -> Int64#\n\nforeign import ccall unsafe \"hs_plusInt64\"   plusInt64#    :: Int64# -> Int64# -> Int64#\nforeign import ccall unsafe \"hs_minusInt64\"  minusInt64#   :: Int64# -> Int64# -> Int64#\nforeign import ccall unsafe \"hs_timesInt64\"  timesInt64#   :: Int64# -> Int64# -> Int64#\nforeign import ccall unsafe \"hs_negateInt64\" negateInt64#  :: Int64# -> Int64#\nforeign import ccall unsafe \"hs_quotWord64\"  quotWord64#   :: Word64# -> Word64# -> Word64#\nforeign import ccall unsafe \"hs_remWord64\"   remWord64#    :: Word64# -> Word64# -> Word64#\n\nforeign import ccall unsafe \"hs_and64\"       and64#        :: Word64# -> Word64# -> Word64#\nforeign import ccall unsafe \"hs_or64\"        or64#         :: Word64# -> Word64# -> Word64#\nforeign import ccall unsafe \"hs_xor64\"       xor64#        :: Word64# -> Word64# -> Word64#\nforeign import ccall unsafe \"hs_not64\"       not64#        :: Word64# -> Word64#\n\nforeign import ccall unsafe \"hs_uncheckedShiftL64\"   uncheckedShiftL64#   :: Word64# -> Int# -> Word64#\nforeign import ccall unsafe \"hs_uncheckedShiftRL64\"  uncheckedShiftRL64#  :: Word64# -> Int# -> Word64#\nforeign import ccall unsafe \"hs_uncheckedIShiftL64\"  uncheckedIShiftL64#  :: Int64# -> Int# -> Int64#\nforeign import ccall unsafe \"hs_uncheckedIShiftRA64\" uncheckedIShiftRA64# :: Int64# -> Int# -> Int64#\nforeign import ccall unsafe \"hs_uncheckedIShiftRL64\" uncheckedIShiftRL64# :: Int64# -> Int# -> Int64#\n\nforeign import ccall unsafe \"hs_int64ToWord64\"   int64ToWord64#   :: Int64# -> Word64#\nforeign import ccall unsafe \"hs_word64ToInt64\"   word64ToInt64#   :: Word64# -> Int64#\nforeign import ccall unsafe \"hs_intToInt64\"      intToInt64#      :: Int# -> Int64#\nforeign import ccall unsafe \"hs_int64ToInt\"      int64ToInt#      :: Int64# -> Int#\nforeign import ccall unsafe \"hs_wordToWord64\"    wordToWord64#    :: Word# -> Word64#\nforeign import ccall unsafe \"hs_word64ToWord\"    word64ToWord#    :: Word64# -> Word#\n\n#endif\n\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Magic\n-- Copyright   :  (c) The University of Glasgow 2009\n-- License     :  see libraries/ghc-prim/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- GHC magic.\n--\n-- Use GHC.Exts from the base package instead of importing this\n-- module directly.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Magic ( inline, noinline, lazy, oneShot, runRW# ) where\n\n--------------------------------------------------\n--        See Note [magicIds] in MkId.hs\n--------------------------------------------------\n\n-- Here import TYPE explicitely from GHC.Types and not from GHC.Prim. This is\n-- because TYPE is not exported by the source Haskell module generated by\n-- genprimops which Haddock will typecheck.\n-- Likewise, realWorld# is not generated by genprimops so we use CPP and only\n-- import/use it when not building haddock docs.\n#if !defined(__HADDOCK_VERSION__)\nimport GHC.Prim (realWorld#)\n#endif\nimport GHC.Prim (State#, RealWorld)\nimport GHC.CString ()\nimport GHC.Types (RuntimeRep, TYPE)\n\n-- | The call @inline f@ arranges that @f@ is inlined, regardless of\n-- its size. More precisely, the call @inline f@ rewrites to the\n-- right-hand side of @f@'s definition. This allows the programmer to\n-- control inlining from a particular call site rather than the\n-- definition site of the function (c.f. @INLINE@ pragmas).\n--\n-- This inlining occurs regardless of the argument to the call or the\n-- size of @f@'s definition; it is unconditional. The main caveat is\n-- that @f@'s definition must be visible to the compiler; it is\n-- therefore recommended to mark the function with an @INLINABLE@\n-- pragma at its definition so that GHC guarantees to record its\n-- unfolding regardless of size.\n--\n-- If no inlining takes place, the 'inline' function expands to the\n-- identity function in Phase zero, so its use imposes no overhead.\n{-# NOINLINE[0] inline #-}\ninline :: a -> a\ninline x = x\n\n-- | The call @noinline f@ arranges that @f@ will not be inlined.\n-- It is removed during CorePrep so that its use imposes no overhead\n-- (besides the fact that it blocks inlining.)\n{-# NOINLINE noinline #-}\nnoinline :: a -> a\nnoinline x = x\n\n-- | The 'lazy' function restrains strictness analysis a little. The\n-- call @lazy e@ means the same as @e@, but 'lazy' has a magical\n-- property so far as strictness analysis is concerned: it is lazy in\n-- its first argument, even though its semantics is strict. After\n-- strictness analysis has run, calls to 'lazy' are inlined to be the\n-- identity function.\n--\n-- This behaviour is occasionally useful when controlling evaluation\n-- order. Notably, 'lazy' is used in the library definition of\n-- 'Control.Parallel.par':\n--\n-- > par :: a -> b -> b\n-- > par x y = case (par# x) of _ -> lazy y\n--\n-- If 'lazy' were not lazy, 'Control.Parallel.par' would look strict in\n-- @y@ which would defeat the whole purpose of 'Control.Parallel.par'.\n--\n-- Like 'seq', the argument of 'lazy' can have an unboxed type.\nlazy :: a -> a\nlazy x = x\n-- Implementation note: its strictness and unfolding are over-ridden\n-- by the definition in MkId.hs; in both cases to nothing at all.\n-- That way, 'lazy' does not get inlined, and the strictness analyser\n-- sees it as lazy.  Then the worker/wrapper phase inlines it.\n-- Result: happiness\n\n\n-- | The 'oneShot' function can be used to give a hint to the compiler that its\n-- argument will be called at most once, which may (or may not) enable certain\n-- optimizations. It can be useful to improve the performance of code in continuation\n-- passing style.\n--\n-- If 'oneShot' is used wrongly, then it may be that computations whose result\n-- that would otherwise be shared are re-evaluated every time they are used. Otherwise,\n-- the use of `oneShot` is safe.\n--\n-- 'oneShot' is representation polymorphic: the type variables may refer to lifted\n-- or unlifted types.\noneShot :: forall (q :: RuntimeRep) (r :: RuntimeRep)\n                  (a :: TYPE q) (b :: TYPE r).\n           (a -> b) -> a -> b\noneShot f = f\n-- Implementation note: This is wired in in MkId.hs, so the code here is\n-- mostly there to have a place for the documentation.\n\n-- | Apply a function to a @'State#' 'RealWorld'@ token. When manually applying\n-- a function to `realWorld#`, it is necessary to use @NOINLINE@ to prevent\n-- semantically undesirable floating. `runRW#` is inlined, but only very late\n-- in compilation after all floating is complete.\n\n-- 'runRW#' is representation polymorphic: the result may have a lifted or\n-- unlifted type.\n\nrunRW# :: forall (r :: RuntimeRep) (o :: TYPE r).\n          (State# RealWorld -> o) -> o\n-- See Note [runRW magic] in CorePrep\n{-# NOINLINE runRW# #-}  -- runRW# is inlined manually in CorePrep\n#if !defined(__HADDOCK_VERSION__)\nrunRW# m = m realWorld#\n#else\nrunRW# = runRW#   -- The realWorld# is too much for haddock\n#endif\n", "num_lines": 133}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude, DeriveGeneric #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Tuple\n-- Copyright   :  (c) The University of Glasgow 2001\n-- License     :  BSD-style (see the file libraries/ghc-prim/LICENSE)\n-- \n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (GHC extensions)\n--\n-- The tuple data types\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Tuple where\n\nimport GHC.CString ()  -- Make sure we do it first, so that the\n                       -- implicit Typeable stuff can see GHC.Types.TyCon\n                       -- and unpackCString# etc\n\ndefault () -- Double and Integer aren't available yet\n\n-- | The unit datatype @()@ has one non-undefined member, the nullary\n-- constructor @()@.\ndata () = ()\n\n-- The desugarer uses 1-tuples,\n-- but \"()\" is already used up for 0-tuples\n-- See Note [One-tuples] in TysWiredIn\ndata Unit a = Unit a\n\ndata (a,b) = (a,b)\ndata (a,b,c) = (a,b,c)\ndata (a,b,c,d) = (a,b,c,d)\ndata (a,b,c,d,e) = (a,b,c,d,e)\ndata (a,b,c,d,e,f) = (a,b,c,d,e,f)\ndata (a,b,c,d,e,f,g) = (a,b,c,d,e,f,g)\ndata (a,b,c,d,e,f,g,h) = (a,b,c,d,e,f,g,h)\ndata (a,b,c,d,e,f,g,h,i) = (a,b,c,d,e,f,g,h,i)\ndata (a,b,c,d,e,f,g,h,i,j) = (a,b,c,d,e,f,g,h,i,j)\ndata (a,b,c,d,e,f,g,h,i,j,k) = (a,b,c,d,e,f,g,h,i,j,k)\ndata (a,b,c,d,e,f,g,h,i,j,k,l) = (a,b,c,d,e,f,g,h,i,j,k,l)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m) = (a,b,c,d,e,f,g,h,i,j,k,l,m)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z)\n\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,r1,s1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2)\ndata (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n      r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2)\n  = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,\n     r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2)\n\n{- Manuel says: Including one more declaration gives a segmentation fault.\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ \n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___  u___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___\ndata (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___  u___ v___\n = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ v___\n-}\n", "num_lines": 248}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples,\n             MultiParamTypeClasses, RoleAnnotations, CPP, TypeOperators,\n             PolyKinds #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Types\n-- Copyright   :  (c) The University of Glasgow 2009\n-- License     :  see libraries/ghc-prim/LICENSE\n--\n-- Maintainer  :  cvs-ghc@haskell.org\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- GHC type definitions.\n-- Use GHC.Exts from the base package instead of importing this\n-- module directly.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Types (\n        -- Data types that are built-in syntax\n        -- They are defined here, but not explicitly exported\n        --\n        --    Lists:          []( [], (:) )\n        --    Type equality:  (~)( Eq# )\n\n        Bool(..), Char(..), Int(..), Word(..),\n        Float(..), Double(..),\n        Ordering(..), IO(..),\n        isTrue#,\n        SPEC(..),\n        Nat, Symbol,\n        Any,\n        type (~~), Coercible,\n        TYPE, RuntimeRep(..), Type, Constraint,\n          -- The historical type * should ideally be written as\n          -- `type *`, without the parentheses. But that's a true\n          -- pain to parse, and for little gain.\n        VecCount(..), VecElem(..),\n\n        -- * Runtime type representation\n        Module(..), TrName(..), TyCon(..), TypeLitSort(..),\n        KindRep(..), KindBndr\n    ) where\n\nimport GHC.Prim\n\ninfixr 5 :\n\n{- *********************************************************************\n*                                                                      *\n                  Kinds\n*                                                                      *\n********************************************************************* -}\n\n-- | The kind of constraints, like @Show a@\ndata Constraint\n\n-- | The kind of types with values. For example @Int :: Type@.\ntype Type = TYPE 'LiftedRep\n\n{- *********************************************************************\n*                                                                      *\n                  Nat and Symbol\n*                                                                      *\n********************************************************************* -}\n\n-- | (Kind) This is the kind of type-level natural numbers.\ndata Nat\n\n-- | (Kind) This is the kind of type-level symbols.\n-- Declared here because class IP needs it\ndata Symbol\n\n{- *********************************************************************\n*                                                                      *\n                  Any\n*                                                                      *\n********************************************************************* -}\n\n-- | The type constructor 'Any' is type to which you can unsafely coerce any\n-- lifted type, and back. More concretely, for a lifted type @t@ and\n-- value @x :: t@, -- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent\n-- to @x@.\n--\ntype family Any :: k where { }\n-- See Note [Any types] in TysWiredIn. Also, for a bit of history on Any see\n-- #10886. Note that this must be a *closed* type family: we need to ensure\n-- that this can't reduce to a `data` type for the results discussed in\n-- Note [Any types].\n\n{- *********************************************************************\n*                                                                      *\n                  Lists\n\n   NB: lists are built-in syntax, and hence not explicitly exported\n*                                                                      *\n********************************************************************* -}\n\n-- | The builtin list type, usually written in its non-prefix form @[a]@.\n--\n-- ==== __Examples__\n--\n-- Unless the OverloadedLists extension is enabled, list literals are\n-- syntatic sugar for repeated applications of @:@ and @[]@.\n--\n-- >>> 1:2:3:4:[] == [1,2,3,4]\n-- True\n--\n-- Similarly, unless the OverloadedStrings extension is enabled, string\n-- literals are syntactic sugar for a lists of characters.\n--\n-- >>> ['h','e','l','l','o'] == \"hello\"\n-- True\n--\ndata [] a = [] | a : [a]\n\n\n{- *********************************************************************\n*                                                                      *\n                  Ordering\n*                                                                      *\n********************************************************************* -}\n\ndata Ordering = LT | EQ | GT\n\n\n{- *********************************************************************\n*                                                                      *\n                  Int, Char, Word, Float, Double\n*                                                                      *\n********************************************************************* -}\n\n{- | The character type 'Char' is an enumeration whose values represent\nUnicode (or equivalently ISO\\/IEC 10646) code points (i.e. characters, see\n<http://www.unicode.org/> for details).  This set extends the ISO 8859-1\n(Latin-1) character set (the first 256 characters), which is itself an extension\nof the ASCII character set (the first 128 characters).  A character literal in\nHaskell has type 'Char'.\n\nTo convert a 'Char' to or from the corresponding 'Int' value defined\nby Unicode, use 'Prelude.toEnum' and 'Prelude.fromEnum' from the\n'Prelude.Enum' class respectively (or equivalently 'Data.Char.ord' and\n'Data.Char.chr').\n-}\ndata {-# CTYPE \"HsChar\" #-} Char = C# Char#\n\n-- | A fixed-precision integer type with at least the range @[-2^29 .. 2^29-1]@.\n-- The exact range for a given implementation can be determined by using\n-- 'Prelude.minBound' and 'Prelude.maxBound' from the 'Prelude.Bounded' class.\ndata {-# CTYPE \"HsInt\" #-} Int = I# Int#\n\n-- |A 'Word' is an unsigned integral type, with the same size as 'Int'.\ndata {-# CTYPE \"HsWord\" #-} Word = W# Word#\n\n-- | Single-precision floating point numbers.\n-- It is desirable that this type be at least equal in range and precision\n-- to the IEEE single-precision type.\ndata {-# CTYPE \"HsFloat\" #-} Float = F# Float#\n\n-- | Double-precision floating point numbers.\n-- It is desirable that this type be at least equal in range and precision\n-- to the IEEE double-precision type.\ndata {-# CTYPE \"HsDouble\" #-} Double = D# Double#\n\n\n{- *********************************************************************\n*                                                                      *\n                    IO\n*                                                                      *\n********************************************************************* -}\n\n{- |\nA value of type @'IO' a@ is a computation which, when performed,\ndoes some I\\/O before returning a value of type @a@.\n\nThere is really only one way to \\\"perform\\\" an I\\/O action: bind it to\n@Main.main@ in your program.  When your program is run, the I\\/O will\nbe performed.  It isn't possible to perform I\\/O from an arbitrary\nfunction, unless that function is itself in the 'IO' monad and called\nat some point, directly or indirectly, from @Main.main@.\n\n'IO' is a monad, so 'IO' actions can be combined using either the do-notation\nor the 'Prelude.>>' and 'Prelude.>>=' operations from the 'Prelude.Monad'\nclass.\n-}\nnewtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))\ntype role IO representational\n\n{- The 'type role' role annotation for IO is redundant but is included\nbecause this role is significant in the normalisation of FFI\ntypes. Specifically, if this role were to become nominal (which would\nbe very strange, indeed!), changes elsewhere in GHC would be\nnecessary. See [FFI type roles] in TcForeign.  -}\n\n\n{- *********************************************************************\n*                                                                      *\n                    (~) and Coercible\n\n   NB: (~) is built-in syntax, and hence not explicitly exported\n*                                                                      *\n********************************************************************* -}\n\n{-\nNote [Kind-changing of (~) and Coercible]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n(~) and Coercible are tricky to define. To the user, they must appear as\nconstraints, but we cannot define them as such in Haskell. But we also cannot\njust define them only in GHC.Prim (like (->)), because we need a real module\nfor them, e.g. to compile the constructor's info table.\n\nFurthermore the type of MkCoercible cannot be written in Haskell\n(no syntax for ~#R).\n\nSo we define them as regular data types in GHC.Types, and do magic in TysWiredIn,\ninside GHC, to change the kind and type.\n-}\n\n\n-- | Lifted, heterogeneous equality. By lifted, we mean that it\n-- can be bogus (deferred type error). By heterogeneous, the two\n-- types @a@ and @b@ might have different kinds. Because @~~@ can\n-- appear unexpectedly in error messages to users who do not care\n-- about the difference between heterogeneous equality @~~@ and\n-- homogeneous equality @~@, this is printed as @~@ unless\n-- @-fprint-equality-relations@ is set.\nclass a ~~ b\n  -- See also Note [The equality types story] in TysPrim\n\n-- | Lifted, homogeneous equality. By lifted, we mean that it\n-- can be bogus (deferred type error). By homogeneous, the two\n-- types @a@ and @b@ must have the same kinds.\nclass a ~ b\n  -- See also Note [The equality types story] in TysPrim\n\n-- | @Coercible@ is a two-parameter class that has instances for types @a@ and @b@ if\n--      the compiler can infer that they have the same representation. This class\n--      does not have regular instances; instead they are created on-the-fly during\n--      type-checking. Trying to manually declare an instance of @Coercible@\n--      is an error.\n--\n--      Nevertheless one can pretend that the following three kinds of instances\n--      exist. First, as a trivial base-case:\n--\n--      @instance Coercible a a@\n--\n--      Furthermore, for every type constructor there is\n--      an instance that allows to coerce under the type constructor. For\n--      example, let @D@ be a prototypical type constructor (@data@ or\n--      @newtype@) with three type arguments, which have roles @nominal@,\n--      @representational@ resp. @phantom@. Then there is an instance of\n--      the form\n--\n--      @instance Coercible b b\\' => Coercible (D a b c) (D a b\\' c\\')@\n--\n--      Note that the @nominal@ type arguments are equal, the\n--      @representational@ type arguments can differ, but need to have a\n--      @Coercible@ instance themself, and the @phantom@ type arguments can be\n--      changed arbitrarily.\n--\n--      The third kind of instance exists for every @newtype NT = MkNT T@ and\n--      comes in two variants, namely\n--\n--      @instance Coercible a T => Coercible a NT@\n--\n--      @instance Coercible T b => Coercible NT b@\n--\n--      This instance is only usable if the constructor @MkNT@ is in scope.\n--\n--      If, as a library author of a type constructor like @Set a@, you\n--      want to prevent a user of your module to write\n--      @coerce :: Set T -> Set NT@,\n--      you need to set the role of @Set@\\'s type parameter to @nominal@,\n--      by writing\n--\n--      @type role Set nominal@\n--\n--      For more details about this feature, please refer to\n--      <http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf Safe Coercions>\n--      by Joachim Breitner, Richard A. Eisenberg, Simon Peyton Jones and Stephanie Weirich.\n--\n--      @since 4.7.0.0\nclass Coercible a b\n  -- See also Note [The equality types story] in TysPrim\n\n{- *********************************************************************\n*                                                                      *\n                   Bool, and isTrue#\n*                                                                      *\n********************************************************************* -}\n\ndata {-# CTYPE \"HsBool\" #-} Bool = False | True\n\n{-# INLINE isTrue# #-}\n-- | Alias for 'tagToEnum#'. Returns True if its parameter is 1# and False\n--   if it is 0#.\nisTrue# :: Int# -> Bool   -- See Note [Optimizing isTrue#]\nisTrue# x = tagToEnum# x\n\n{- Note [Optimizing isTrue#]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nCurrent definition of isTrue# is a temporary workaround. We would like to\nhave functions isTrue# and isFalse# defined like this:\n\n    isTrue# :: Int# -> Bool\n    isTrue# 1# = True\n    isTrue# _  = False\n\n    isFalse# :: Int# -> Bool\n    isFalse# 0# = True\n    isFalse# _  = False\n\nThese functions would allow us to safely check if a tag can represent True\nor False. Using isTrue# and isFalse# as defined above will not introduce\nadditional case into the code. When we scrutinize return value of isTrue#\nor isFalse#, either explicitly in a case expression or implicitly in a guard,\nthe result will always be a single case expression (given that optimizations\nare turned on). This results from case-of-case transformation. Consider this\ncode (this is both valid Haskell and Core):\n\ncase isTrue# (a ># b) of\n    True  -> e1\n    False -> e2\n\nInlining isTrue# gives:\n\ncase (case (a ># b) of { 1# -> True; _ -> False } ) of\n    True  -> e1\n    False -> e2\n\nCase-of-case transforms that to:\n\ncase (a ># b) of\n  1# -> case True of\n          True  -> e1\n          False -> e2\n  _  -> case False of\n          True  -> e1\n          False -> e2\n\nWhich is then simplified by case-of-known-constructor:\n\ncase (a ># b) of\n  1# -> e1\n  _  -> e2\n\nWhile we get good Core here, the code generator will generate very bad Cmm\nif e1 or e2 do allocation. It will push heap checks into case alternatives\nwhich results in about 2.5% increase in code size. Until this is improved we\njust make isTrue# an alias to tagToEnum#. This is a temporary solution (if\nyou're reading this in 2023 then things went wrong). See #8326.\n-}\n\n\n{- *********************************************************************\n*                                                                      *\n                    SPEC\n*                                                                      *\n********************************************************************* -}\n\n-- | 'SPEC' is used by GHC in the @SpecConstr@ pass in order to inform\n-- the compiler when to be particularly aggressive. In particular, it\n-- tells GHC to specialize regardless of size or the number of\n-- specializations. However, not all loops fall into this category.\n--\n-- Libraries can specify this by using 'SPEC' data type to inform which\n-- loops should be aggressively specialized.\ndata SPEC = SPEC | SPEC2\n\n\n{- *********************************************************************\n*                                                                      *\n                    Levity polymorphism\n*                                                                      *\n********************************************************************* -}\n\n\n-- | GHC maintains a property that the kind of all inhabited types\n-- (as distinct from type constructors or type-level data) tells us\n-- the runtime representation of values of that type. This datatype\n-- encodes the choice of runtime value.\n-- Note that 'TYPE' is parameterised by 'RuntimeRep'; this is precisely\n-- what we mean by the fact that a type's kind encodes the runtime\n-- representation.\n--\n-- For boxed values (that is, values that are represented by a pointer),\n-- a further distinction is made, between lifted types (that contain \u00e2\u0160\u00a5),\n-- and unlifted ones (that don't).\ndata RuntimeRep = VecRep VecCount VecElem   -- ^ a SIMD vector type\n                | TupleRep [RuntimeRep]     -- ^ An unboxed tuple of the given reps\n                | SumRep [RuntimeRep]       -- ^ An unboxed sum of the given reps\n                | LiftedRep       -- ^ lifted; represented by a pointer\n                | UnliftedRep     -- ^ unlifted; represented by a pointer\n                | IntRep          -- ^ signed, word-sized value\n                | Int8Rep         -- ^ signed,  8-bit value\n                | Int16Rep        -- ^ signed, 16-bit value\n                | Int64Rep        -- ^ signed, 64-bit value (on 32-bit only)\n                | WordRep         -- ^ unsigned, word-sized value\n                | Word8Rep        -- ^ unsigned,  8-bit value\n                | Word16Rep       -- ^ unsigned, 16-bit value\n                | Word64Rep       -- ^ unsigned, 64-bit value (on 32-bit only)\n                | AddrRep         -- ^ A pointer, but /not/ to a Haskell value\n                | FloatRep        -- ^ a 32-bit floating point number\n                | DoubleRep       -- ^ a 64-bit floating point number\n\n-- See also Note [Wiring in RuntimeRep] in TysWiredIn\n\n-- | Length of a SIMD vector type\ndata VecCount = Vec2\n              | Vec4\n              | Vec8\n              | Vec16\n              | Vec32\n              | Vec64\n-- Enum, Bounded instances in GHC.Enum\n\n-- | Element of a SIMD vector type\ndata VecElem = Int8ElemRep\n             | Int16ElemRep\n             | Int32ElemRep\n             | Int64ElemRep\n             | Word8ElemRep\n             | Word16ElemRep\n             | Word32ElemRep\n             | Word64ElemRep\n             | FloatElemRep\n             | DoubleElemRep\n-- Enum, Bounded instances in GHC.Enum\n\n{- *********************************************************************\n*                                                                      *\n             Runtime representation of TyCon\n*                                                                      *\n********************************************************************* -}\n\n{- Note [Runtime representation of modules and tycons]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe generate a binding for M.$modName and M.$tcT for every module M and\ndata type T.  Things to think about\n\n  - We want them to be economical on space; ideally pure data with no thunks.\n\n  - We do this for every module (except this module GHC.Types), so we can't\n    depend on anything else (eg string unpacking code)\n\nThat's why we have these terribly low-level representations.  The TrName\ntype lets us use the TrNameS constructor when allocating static data;\nbut we also need TrNameD for the case where we are deserialising a TyCon\nor Module (for example when deserialising a TypeRep), in which case we\ncan't conveniently come up with an Addr#.\n-}\n\n#include \"MachDeps.h\"\n\ndata Module = Module\n                TrName   -- Package name\n                TrName   -- Module name\n\ndata TrName\n  = TrNameS Addr#  -- Static\n  | TrNameD [Char] -- Dynamic\n\n-- | A de Bruijn index for a binder within a 'KindRep'.\ntype KindBndr = Int\n\n#if WORD_SIZE_IN_BITS < 64\n#define WORD64_TY Word64#\n#else\n#define WORD64_TY Word#\n#endif\n\n-- | The representation produced by GHC for conjuring up the kind of a\n-- 'Data.Typeable.TypeRep'.\n\n-- See Note [Representing TyCon kinds: KindRep] in TcTypeable.\ndata KindRep = KindRepTyConApp TyCon [KindRep]\n             | KindRepVar !KindBndr\n             | KindRepApp KindRep KindRep\n             | KindRepFun KindRep KindRep\n             | KindRepTYPE !RuntimeRep\n             | KindRepTypeLitS TypeLitSort Addr#\n             | KindRepTypeLitD TypeLitSort [Char]\n\ndata TypeLitSort = TypeLitSymbol\n                 | TypeLitNat\n\n-- Show instance for TyCon found in GHC.Show\ndata TyCon = TyCon WORD64_TY WORD64_TY   -- Fingerprint\n                   Module                -- Module in which this is defined\n                   TrName                -- Type constructor name\n                   Int#                  -- How many kind variables do we accept?\n                   KindRep               -- A representation of the type's kind\n", "num_lines": 495}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule Main (main) where\n\nimport GHC.Prim\nimport GHC.Types\n\nmain :: IO ()\nmain = print (I# (1# +# 2# *# 3# +# 4#))\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}\nmodule SizedSeq\n  ( SizedSeq(..)\n  , emptySS\n  , addToSS\n  , addListToSS\n  , ssElts\n  , sizeSS\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Control.DeepSeq\nimport Data.Binary\nimport Data.List\nimport GHC.Generics\n\ndata SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a]\n  deriving (Generic, Show)\n\ninstance Functor SizedSeq where\n  fmap f (SizedSeq sz l) = SizedSeq sz (fmap f l)\n\ninstance Foldable SizedSeq where\n  foldr f c ss = foldr f c (ssElts ss)\n\ninstance Traversable SizedSeq where\n  traverse f (SizedSeq sz l) = SizedSeq sz . reverse <$> traverse f (reverse l)\n\ninstance Binary a => Binary (SizedSeq a)\n\ninstance NFData a => NFData (SizedSeq a) where\n  rnf (SizedSeq _ xs) = rnf xs\n\nemptySS :: SizedSeq a\nemptySS = SizedSeq 0 []\n\naddToSS :: SizedSeq a -> a -> SizedSeq a\naddToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs)\n\naddListToSS :: SizedSeq a -> [a] -> SizedSeq a\naddListToSS (SizedSeq n r_xs) xs\n  = SizedSeq (n + genericLength xs) (reverse xs ++ r_xs)\n\nssElts :: SizedSeq a -> [a]\nssElts (SizedSeq _ r_xs) = reverse r_xs\n\nsizeSS :: SizedSeq a -> Word\nsizeSS (SizedSeq n _) = n\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, FlexibleContexts #-}\n-- | Efficient serialisation for GHCi Instruction arrays\n--\n-- Author: Ben Gamari\n--\nmodule GHCi.BinaryArray(putArray, getArray) where\n\nimport Prelude\nimport Foreign.Ptr\nimport Data.Binary\nimport Data.Binary.Put (putBuilder)\nimport qualified Data.Binary.Get.Internal as Binary\nimport qualified Data.ByteString.Builder as BB\nimport qualified Data.ByteString.Builder.Internal as BB\nimport qualified Data.Array.Base as A\nimport qualified Data.Array.IO.Internals as A\nimport qualified Data.Array.Unboxed as A\nimport GHC.Exts\nimport GHC.IO\n\n-- | An efficient serialiser of 'A.UArray'.\nputArray :: Binary i => A.UArray i a -> Put\nputArray (A.UArray l u _ arr#) = do\n    put l\n    put u\n    putBuilder $ byteArrayBuilder arr#\n\nbyteArrayBuilder :: ByteArray# -> BB.Builder\nbyteArrayBuilder arr# = BB.builder $ go 0 (I# (sizeofByteArray# arr#))\n  where\n    go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a\n    go !inStart !inEnd k (BB.BufferRange outStart outEnd)\n      -- There is enough room in this output buffer to write all remaining array\n      -- contents\n      | inRemaining <= outRemaining = do\n          copyByteArrayToAddr arr# inStart outStart inRemaining\n          k (BB.BufferRange (outStart `plusPtr` inRemaining) outEnd)\n      -- There is only enough space for a fraction of the remaining contents\n      | otherwise = do\n          copyByteArrayToAddr arr# inStart outStart outRemaining\n          let !inStart' = inStart + outRemaining\n          return $! BB.bufferFull 1 outEnd (go inStart' inEnd k)\n      where\n        inRemaining  = inEnd - inStart\n        outRemaining = outEnd `minusPtr` outStart\n\n    copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO ()\n    copyByteArrayToAddr src# (I# src_off#) (Ptr dst#) (I# len#) =\n        IO $ \\s -> case copyByteArrayToAddr# src# src_off# dst# len# s of\n                     s' -> (# s', () #)\n\n-- | An efficient deserialiser of 'A.UArray'.\ngetArray :: (Binary i, A.Ix i, A.MArray A.IOUArray a IO) => Get (A.UArray i a)\ngetArray = do\n    l <- get\n    u <- get\n    arr@(A.IOUArray (A.STUArray _ _ _ arr#)) <-\n        return $ unsafeDupablePerformIO $ A.newArray_ (l,u)\n    let go 0 _ = return ()\n        go !remaining !off = do\n            Binary.readNWith n $ \\ptr ->\n              copyAddrToByteArray ptr arr# off n\n            go (remaining - n) (off + n)\n          where n = min chunkSize remaining\n    go (I# (sizeofMutableByteArray# arr#)) 0\n    return $! unsafeDupablePerformIO $ unsafeFreezeIOUArray arr\n  where\n    chunkSize = 10*1024\n\n    copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld\n                        -> Int -> Int -> IO ()\n    copyAddrToByteArray (Ptr src#) dst# (I# dst_off#) (I# len#) =\n        IO $ \\s -> case copyAddrToByteArray# src# dst# dst_off# len# s of\n                     s' -> (# s', () #)\n\n-- this is inexplicably not exported in currently released array versions\nunsafeFreezeIOUArray :: A.IOUArray ix e -> IO (A.UArray ix e)\nunsafeFreezeIOUArray (A.IOUArray marr) = stToIO (A.unsafeFreezeSTUArray marr)\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}\n\n-------------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2007\n--\n-- | Break Arrays\n--\n-- An array of bytes, indexed by a breakpoint number (breakpointId in Tickish)\n-- There is one of these arrays per module.\n--\n-- Each byte is\n--   1 if the corresponding breakpoint is enabled\n--   0 otherwise\n--\n-------------------------------------------------------------------------------\n\nmodule GHCi.BreakArray\n    (\n      BreakArray\n#ifdef GHCI\n          (BA) -- constructor is exported only for ByteCodeGen\n    , newBreakArray\n    , getBreak\n    , setBreakOn\n    , setBreakOff\n    , showBreakArray\n#endif\n    ) where\n\n#ifdef GHCI\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Control.Monad\nimport Data.Word\nimport GHC.Word\n\nimport GHC.Exts\nimport GHC.IO ( IO(..) )\nimport System.IO.Unsafe ( unsafeDupablePerformIO )\n\ndata BreakArray = BA (MutableByteArray# RealWorld)\n\nbreakOff, breakOn :: Word8\nbreakOn  = 1\nbreakOff = 0\n\nshowBreakArray :: BreakArray -> IO ()\nshowBreakArray array = do\n    forM_ [0 .. (size array - 1)] $ \\i -> do\n        val <- readBreakArray array i\n        putStr $ ' ' : show val\n    putStr \"\\n\"\n\nsetBreakOn :: BreakArray -> Int -> IO Bool\nsetBreakOn array index\n    | safeIndex array index = do\n          writeBreakArray array index breakOn\n          return True\n    | otherwise = return False\n\nsetBreakOff :: BreakArray -> Int -> IO Bool\nsetBreakOff array index\n    | safeIndex array index = do\n          writeBreakArray array index breakOff\n          return True\n    | otherwise = return False\n\ngetBreak :: BreakArray -> Int -> IO (Maybe Word8)\ngetBreak array index\n    | safeIndex array index = do\n          val <- readBreakArray array index\n          return $ Just val\n    | otherwise = return Nothing\n\nsafeIndex :: BreakArray -> Int -> Bool\nsafeIndex array index = index < size array && index >= 0\n\nsize :: BreakArray -> Int\nsize (BA array) = size\n  where\n    -- We want to keep this operation pure. The mutable byte array\n    -- is never resized so this is safe.\n    size = unsafeDupablePerformIO $ sizeofMutableByteArray array\n\n    sizeofMutableByteArray :: MutableByteArray# RealWorld -> IO Int\n    sizeofMutableByteArray arr =\n        IO $ \\s -> case getSizeofMutableByteArray# arr s of\n                       (# s', n# #) -> (# s', I# n# #)\n\nallocBA :: Int -> IO BreakArray\nallocBA (I# sz) = IO $ \\s1 ->\n    case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }\n\n-- create a new break array and initialise elements to zero\nnewBreakArray :: Int -> IO BreakArray\nnewBreakArray entries@(I# sz) = do\n    BA array <- allocBA entries\n    case breakOff of\n        W8# off -> do\n           let loop n | isTrue# (n ==# sz) = return ()\n                      | otherwise = do writeBA# array n off; loop (n +# 1#)\n           loop 0#\n    return $ BA array\n\nwriteBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()\nwriteBA# array i word = IO $ \\s ->\n    case writeWord8Array# array i word s of { s -> (# s, () #) }\n\nwriteBreakArray :: BreakArray -> Int -> Word8 -> IO ()\nwriteBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word\n\nreadBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8\nreadBA# array i = IO $ \\s ->\n    case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }\n\nreadBreakArray :: BreakArray -> Int -> IO Word8\nreadBreakArray (BA array) (I# i) = readBA# array i\n#else\ndata BreakArray\n#endif\n", "num_lines": 122}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE RecordWildCards #-}\n\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- | Create real byte-code objects from 'ResolvedBCO's.\nmodule GHCi.CreateBCO (createBCOs) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHCi.ResolvedBCO\nimport GHCi.RemoteTypes\nimport GHCi.BreakArray\nimport SizedSeq\n\nimport System.IO (fixIO)\nimport Control.Monad\nimport Data.Array.Base\nimport Foreign hiding (newArray)\nimport GHC.Arr          ( Array(..) )\nimport GHC.Exts\nimport GHC.IO\nimport Control.Exception ( ErrorCall(..) )\n\ncreateBCOs :: [ResolvedBCO] -> IO [HValueRef]\ncreateBCOs bcos = do\n  let n_bcos = length bcos\n  hvals <- fixIO $ \\hvs -> do\n     let arr = listArray (0, n_bcos-1) hvs\n     mapM (createBCO arr) bcos\n  mapM mkRemoteRef hvals\n\ncreateBCO :: Array Int HValue -> ResolvedBCO -> IO HValue\ncreateBCO _   ResolvedBCO{..} | resolvedBCOIsLE /= isLittleEndian\n  = throwIO (ErrorCall $\n        unlines [ \"The endianness of the ResolvedBCO does not match\"\n                , \"the systems endianness. Using ghc and iserv in a\"\n                , \"mixed endianness setup is not supported!\"\n                ])\ncreateBCO arr bco\n   = do BCO bco# <- linkBCO' arr bco\n        -- Why do we need mkApUpd0 here?  Otherwise top-level\n        -- interpreted CAFs don't get updated after evaluation.  A\n        -- top-level BCO will evaluate itself and return its value\n        -- when entered, but it won't update itself.  Wrapping the BCO\n        -- in an AP_UPD thunk will take care of the update for us.\n        --\n        -- Furthermore:\n        --   (a) An AP thunk *must* point directly to a BCO\n        --   (b) A zero-arity BCO *must* be wrapped in an AP thunk\n        --   (c) An AP is always fully saturated, so we *can't* wrap\n        --       non-zero arity BCOs in an AP thunk.\n        --\n        if (resolvedBCOArity bco > 0)\n           then return (HValue (unsafeCoerce# bco#))\n           else case mkApUpd0# bco# of { (# final_bco #) ->\n                  return (HValue final_bco) }\n\n\ntoWordArray :: UArray Int Word64 -> UArray Int Word\ntoWordArray = amap fromIntegral\n\nlinkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO\nlinkBCO' arr ResolvedBCO{..} = do\n  let\n      ptrs   = ssElts resolvedBCOPtrs\n      n_ptrs = sizeSS resolvedBCOPtrs\n\n      !(I# arity#)  = resolvedBCOArity\n\n      !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array]\n\n      barr a = case a of UArray _lo _hi n b -> if n == 0 then empty# else b\n      insns_barr = barr resolvedBCOInstrs\n      bitmap_barr = barr (toWordArray resolvedBCOBitmap)\n      literals_barr = barr (toWordArray resolvedBCOLits)\n\n  PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs\n  IO $ \\s ->\n    case unsafeFreezeArray# marr s of { (# s, arr #) ->\n    case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io ->\n    io s\n    }}\n\n\n-- we recursively link any sub-BCOs while making the ptrs array\nmkPtrsArray :: Array Int HValue -> Word -> [ResolvedBCOPtr] -> IO PtrsArr\nmkPtrsArray arr n_ptrs ptrs = do\n  marr <- newPtrsArray (fromIntegral n_ptrs)\n  let\n    fill (ResolvedBCORef n) i =\n      writePtrsArrayHValue i (arr ! n) marr  -- must be lazy!\n    fill (ResolvedBCOPtr r) i = do\n      hv <- localRef r\n      writePtrsArrayHValue i hv marr\n    fill (ResolvedBCOStaticPtr r) i = do\n      writePtrsArrayPtr i (fromRemotePtr r)  marr\n    fill (ResolvedBCOPtrBCO bco) i = do\n      BCO bco# <- linkBCO' arr bco\n      writePtrsArrayBCO i bco# marr\n    fill (ResolvedBCOPtrBreakArray r) i = do\n      BA mba <- localRef r\n      writePtrsArrayMBA i mba marr\n  zipWithM_ fill ptrs [0..]\n  return marr\n\ndata PtrsArr = PtrsArr (MutableArray# RealWorld HValue)\n\nnewPtrsArray :: Int -> IO PtrsArr\nnewPtrsArray (I# i) = IO $ \\s ->\n  case newArray# i undefined s of (# s', arr #) -> (# s', PtrsArr arr #)\n\nwritePtrsArrayHValue :: Int -> HValue -> PtrsArr -> IO ()\nwritePtrsArrayHValue (I# i) hv (PtrsArr arr) = IO $ \\s ->\n  case writeArray# arr i hv s of s' -> (# s', () #)\n\nwritePtrsArrayPtr :: Int -> Ptr a -> PtrsArr -> IO ()\nwritePtrsArrayPtr (I# i) (Ptr a#) (PtrsArr arr) = IO $ \\s ->\n  case writeArrayAddr# arr i a# s of s' -> (# s', () #)\n\n-- This is rather delicate: convincing GHC to pass an Addr# as an Any but\n-- without making a thunk turns out to be surprisingly tricky.\n{-# NOINLINE writeArrayAddr# #-}\nwriteArrayAddr# :: MutableArray# s a -> Int# -> Addr# -> State# s -> State# s\nwriteArrayAddr# marr i addr s = unsafeCoerce# writeArray# marr i addr s\n\nwritePtrsArrayBCO :: Int -> BCO# -> PtrsArr -> IO ()\nwritePtrsArrayBCO (I# i) bco (PtrsArr arr) = IO $ \\s ->\n  case (unsafeCoerce# writeArray#) arr i bco s of s' -> (# s', () #)\n\ndata BCO = BCO BCO#\n\nwritePtrsArrayMBA :: Int -> MutableByteArray# s -> PtrsArr -> IO ()\nwritePtrsArrayMBA (I# i) mba (PtrsArr arr) = IO $ \\s ->\n  case (unsafeCoerce# writeArray#) arr i mba s of s' -> (# s', () #)\n\nnewBCO :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> IO BCO\nnewBCO instrs lits ptrs arity bitmap = IO $ \\s ->\n  case newBCO# instrs lits ptrs arity bitmap s of\n    (# s1, bco #) -> (# s1, BCO bco #)\n\n{- Note [BCO empty array]\n\nLots of BCOs have empty ptrs or nptrs, but empty arrays are not free:\nthey are 2-word heap objects.  So let's make a single empty array and\nshare it between all BCOs.\n-}\n\ndata EmptyArr = EmptyArr ByteArray#\n\n{-# NOINLINE emptyArr #-}\nemptyArr :: EmptyArr\nemptyArr = unsafeDupablePerformIO $ IO $ \\s ->\n  case newByteArray# 0# s of { (# s, arr #) ->\n  case unsafeFreezeByteArray# arr s of { (# s, farr #) ->\n  (# s, EmptyArr farr #)\n  }}\n", "num_lines": 164}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,\n    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}\n\n-- |\n-- Remote GHCi message types and serialization.\n--\n-- For details on Remote GHCi, see Note [Remote GHCi] in\n-- compiler/ghci/GHCi.hs.\n--\nmodule GHCi.Message\n  ( Message(..), Msg(..)\n  , THMessage(..), THMsg(..)\n  , QResult(..)\n  , EvalStatus_(..), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..)\n  , SerializableException(..)\n  , toSerializableException, fromSerializableException\n  , THResult(..), THResultType(..)\n  , ResumeContext(..)\n  , QState(..)\n  , getMessage, putMessage, getTHMessage, putTHMessage\n  , Pipe(..), remoteCall, remoteTHCall, readPipe, writePipe\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHCi.RemoteTypes\nimport GHCi.FFI\nimport GHCi.TH.Binary ()\nimport GHCi.BreakArray\n\nimport GHC.LanguageExtensions\nimport GHC.Exts.Heap\nimport GHC.ForeignSrcLang\nimport GHC.Fingerprint\nimport Control.Concurrent\nimport Control.Exception\nimport Data.Binary\nimport Data.Binary.Get\nimport Data.Binary.Put\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.Lazy as LB\nimport Data.Dynamic\nimport Data.Typeable (TypeRep)\nimport Data.IORef\nimport Data.Map (Map)\nimport Foreign\nimport GHC.Generics\nimport GHC.Stack.CCS\nimport qualified Language.Haskell.TH        as TH\nimport qualified Language.Haskell.TH.Syntax as TH\nimport System.Exit\nimport System.IO\nimport System.IO.Error\n\n-- -----------------------------------------------------------------------------\n-- The RPC protocol between GHC and the interactive server\n\n-- | A @Message a@ is a message that returns a value of type @a@.\n-- These are requests sent from GHC to the server.\ndata Message a where\n  -- | Exit the iserv process\n  Shutdown :: Message ()\n  RtsRevertCAFs :: Message ()\n\n  -- RTS Linker -------------------------------------------\n\n  -- These all invoke the corresponding functions in the RTS Linker API.\n  InitLinker :: Message ()\n  LookupSymbol :: String -> Message (Maybe (RemotePtr ()))\n  LookupClosure :: String -> Message (Maybe HValueRef)\n  LoadDLL :: String -> Message (Maybe String)\n  LoadArchive :: String -> Message () -- error?\n  LoadObj :: String -> Message () -- error?\n  UnloadObj :: String -> Message () -- error?\n  AddLibrarySearchPath :: String -> Message (RemotePtr ())\n  RemoveLibrarySearchPath :: RemotePtr () -> Message Bool\n  ResolveObjs :: Message Bool\n  FindSystemLibrary :: String -> Message (Maybe String)\n\n  -- Interpreter -------------------------------------------\n\n  -- | Create a set of BCO objects, and return HValueRefs to them\n  -- Note: Each ByteString contains a Binary-encoded [ResolvedBCO], not\n  -- a ResolvedBCO. The list is to allow us to serialise the ResolvedBCOs\n  -- in parallel. See @createBCOs@ in compiler/ghci/GHCi.hsc.\n  CreateBCOs :: [LB.ByteString] -> Message [HValueRef]\n\n  -- | Release 'HValueRef's\n  FreeHValueRefs :: [HValueRef] -> Message ()\n\n  -- | Add entries to the Static Pointer Table\n  AddSptEntry :: Fingerprint -> HValueRef -> Message ()\n\n  -- | Malloc some data and return a 'RemotePtr' to it\n  MallocData :: ByteString -> Message (RemotePtr ())\n  MallocStrings :: [ByteString] -> Message [RemotePtr ()]\n\n  -- | Calls 'GHCi.FFI.prepareForeignCall'\n  PrepFFI :: FFIConv -> [FFIType] -> FFIType -> Message (RemotePtr C_ffi_cif)\n\n  -- | Free data previously created by 'PrepFFI'\n  FreeFFI :: RemotePtr C_ffi_cif -> Message ()\n\n  -- | Create an info table for a constructor\n  MkConInfoTable\n   :: Int     -- ptr words\n   -> Int     -- non-ptr words\n   -> Int     -- constr tag\n   -> Int     -- pointer tag\n   -> ByteString -- constructor desccription\n   -> Message (RemotePtr StgInfoTable)\n\n  -- | Evaluate a statement\n  EvalStmt\n    :: EvalOpts\n    -> EvalExpr HValueRef {- IO [a] -}\n    -> Message (EvalStatus [HValueRef]) {- [a] -}\n\n  -- | Resume evaluation of a statement after a breakpoint\n  ResumeStmt\n   :: EvalOpts\n   -> RemoteRef (ResumeContext [HValueRef])\n   -> Message (EvalStatus [HValueRef])\n\n  -- | Abandon evaluation of a statement after a breakpoint\n  AbandonStmt\n   :: RemoteRef (ResumeContext [HValueRef])\n   -> Message ()\n\n  -- | Evaluate something of type @IO String@\n  EvalString\n    :: HValueRef {- IO String -}\n    -> Message (EvalResult String)\n\n  -- | Evaluate something of type @String -> IO String@\n  EvalStringToString\n    :: HValueRef {- String -> IO String -}\n    -> String\n    -> Message (EvalResult String)\n\n  -- | Evaluate something of type @IO ()@\n  EvalIO\n   :: HValueRef {- IO a -}\n   -> Message (EvalResult ())\n\n  -- | Create a set of CostCentres with the same module name\n  MkCostCentres\n   :: String     -- module, RemotePtr so it can be shared\n   -> [(String,String)] -- (name, SrcSpan)\n   -> Message [RemotePtr CostCentre]\n\n  -- | Show a 'CostCentreStack' as a @[String]@\n  CostCentreStackInfo\n   :: RemotePtr CostCentreStack\n   -> Message [String]\n\n  -- | Create a new array of breakpoint flags\n  NewBreakArray\n   :: Int                               -- size\n   -> Message (RemoteRef BreakArray)\n\n  -- | Enable a breakpoint\n  EnableBreakpoint\n   :: RemoteRef BreakArray\n   -> Int                               -- index\n   -> Bool                              -- on or off\n   -> Message ()\n\n  -- | Query the status of a breakpoint (True <=> enabled)\n  BreakpointStatus\n   :: RemoteRef BreakArray\n   -> Int                               -- index\n   -> Message Bool                      -- True <=> enabled\n\n  -- | Get a reference to a free variable at a breakpoint\n  GetBreakpointVar\n   :: HValueRef                         -- the AP_STACK from EvalBreak\n   -> Int\n   -> Message (Maybe HValueRef)\n\n  -- Template Haskell -------------------------------------------\n  -- For more details on how TH works with Remote GHCi, see\n  -- Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.\n\n  -- | Start a new TH module, return a state token that should be\n  StartTH :: Message (RemoteRef (IORef QState))\n\n  -- | Evaluate a TH computation.\n  --\n  -- Returns a ByteString, because we have to force the result\n  -- before returning it to ensure there are no errors lurking\n  -- in it.  The TH types don't have NFData instances, and even if\n  -- they did, we have to serialize the value anyway, so we might\n  -- as well serialize it to force it.\n  RunTH\n   :: RemoteRef (IORef QState)\n   -> HValueRef {- e.g. TH.Q TH.Exp -}\n   -> THResultType\n   -> Maybe TH.Loc\n   -> Message (QResult ByteString)\n\n  -- | Run the given mod finalizers.\n  RunModFinalizers :: RemoteRef (IORef QState)\n                   -> [RemoteRef (TH.Q ())]\n                   -> Message (QResult ())\n\n  -- | Remote interface to GHC.Exts.Heap.getClosureData. This is used by\n  -- the GHCi debugger to inspect values in the heap for :print and\n  -- type reconstruction.\n  GetClosure\n    :: HValueRef\n    -> Message (GenClosure HValueRef)\n\n  -- | Evaluate something. This is used to support :force in GHCi.\n  Seq\n    :: HValueRef\n    -> Message (EvalResult ())\n\nderiving instance Show (Message a)\n\n\n-- | Template Haskell return values\ndata QResult a\n  = QDone a\n    -- ^ RunTH finished successfully; return value follows\n  | QException String\n    -- ^ RunTH threw an exception\n  | QFail String\n    -- ^ RunTH called 'fail'\n  deriving (Generic, Show)\n\ninstance Binary a => Binary (QResult a)\n\n\n-- | Messages sent back to GHC from GHCi.TH, to implement the methods\n-- of 'Quasi'.  For an overview of how TH works with Remote GHCi, see\n-- Note [Remote Template Haskell] in GHCi.TH.\ndata THMessage a where\n  NewName :: String -> THMessage (THResult TH.Name)\n  Report :: Bool -> String -> THMessage (THResult ())\n  LookupName :: Bool -> String -> THMessage (THResult (Maybe TH.Name))\n  Reify :: TH.Name -> THMessage (THResult TH.Info)\n  ReifyFixity :: TH.Name -> THMessage (THResult (Maybe TH.Fixity))\n  ReifyInstances :: TH.Name -> [TH.Type] -> THMessage (THResult [TH.Dec])\n  ReifyRoles :: TH.Name -> THMessage (THResult [TH.Role])\n  ReifyAnnotations :: TH.AnnLookup -> TypeRep\n    -> THMessage (THResult [ByteString])\n  ReifyModule :: TH.Module -> THMessage (THResult TH.ModuleInfo)\n  ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness])\n\n  AddDependentFile :: FilePath -> THMessage (THResult ())\n  AddTempFile :: String -> THMessage (THResult FilePath)\n  AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ())\n  AddCorePlugin :: String -> THMessage (THResult ())\n  AddTopDecls :: [TH.Dec] -> THMessage (THResult ())\n  AddForeignFilePath :: ForeignSrcLang -> FilePath -> THMessage (THResult ())\n  IsExtEnabled :: Extension -> THMessage (THResult Bool)\n  ExtsEnabled :: THMessage (THResult [Extension])\n\n  StartRecover :: THMessage ()\n  EndRecover :: Bool -> THMessage ()\n  FailIfErrs :: THMessage (THResult ())\n\n  -- | Indicates that this RunTH is finished, and the next message\n  -- will be the result of RunTH (a QResult).\n  RunTHDone :: THMessage ()\n\nderiving instance Show (THMessage a)\n\ndata THMsg = forall a . (Binary a, Show a) => THMsg (THMessage a)\n\ngetTHMessage :: Get THMsg\ngetTHMessage = do\n  b <- getWord8\n  case b of\n    0  -> THMsg <$> NewName <$> get\n    1  -> THMsg <$> (Report <$> get <*> get)\n    2  -> THMsg <$> (LookupName <$> get <*> get)\n    3  -> THMsg <$> Reify <$> get\n    4  -> THMsg <$> ReifyFixity <$> get\n    5  -> THMsg <$> (ReifyInstances <$> get <*> get)\n    6  -> THMsg <$> ReifyRoles <$> get\n    7  -> THMsg <$> (ReifyAnnotations <$> get <*> get)\n    8  -> THMsg <$> ReifyModule <$> get\n    9  -> THMsg <$> ReifyConStrictness <$> get\n    10 -> THMsg <$> AddDependentFile <$> get\n    11 -> THMsg <$> AddTempFile <$> get\n    12 -> THMsg <$> AddTopDecls <$> get\n    13 -> THMsg <$> (IsExtEnabled <$> get)\n    14 -> THMsg <$> return ExtsEnabled\n    15 -> THMsg <$> return StartRecover\n    16 -> THMsg <$> EndRecover <$> get\n    17 -> THMsg <$> return FailIfErrs\n    18 -> return (THMsg RunTHDone)\n    19 -> THMsg <$> AddModFinalizer <$> get\n    20 -> THMsg <$> (AddForeignFilePath <$> get <*> get)\n    _  -> THMsg <$> AddCorePlugin <$> get\n\nputTHMessage :: THMessage a -> Put\nputTHMessage m = case m of\n  NewName a                   -> putWord8 0  >> put a\n  Report a b                  -> putWord8 1  >> put a >> put b\n  LookupName a b              -> putWord8 2  >> put a >> put b\n  Reify a                     -> putWord8 3  >> put a\n  ReifyFixity a               -> putWord8 4  >> put a\n  ReifyInstances a b          -> putWord8 5  >> put a >> put b\n  ReifyRoles a                -> putWord8 6  >> put a\n  ReifyAnnotations a b        -> putWord8 7  >> put a >> put b\n  ReifyModule a               -> putWord8 8  >> put a\n  ReifyConStrictness a        -> putWord8 9  >> put a\n  AddDependentFile a          -> putWord8 10 >> put a\n  AddTempFile a               -> putWord8 11 >> put a\n  AddTopDecls a               -> putWord8 12 >> put a\n  IsExtEnabled a              -> putWord8 13 >> put a\n  ExtsEnabled                 -> putWord8 14\n  StartRecover                -> putWord8 15\n  EndRecover a                -> putWord8 16 >> put a\n  FailIfErrs                  -> putWord8 17\n  RunTHDone                   -> putWord8 18\n  AddModFinalizer a           -> putWord8 19 >> put a\n  AddForeignFilePath lang a   -> putWord8 20 >> put lang >> put a\n  AddCorePlugin a             -> putWord8 21 >> put a\n\n\ndata EvalOpts = EvalOpts\n  { useSandboxThread :: Bool\n  , singleStep :: Bool\n  , breakOnException :: Bool\n  , breakOnError :: Bool\n  }\n  deriving (Generic, Show)\n\ninstance Binary EvalOpts\n\ndata ResumeContext a = ResumeContext\n  { resumeBreakMVar :: MVar ()\n  , resumeStatusMVar :: MVar (EvalStatus a)\n  , resumeThreadId :: ThreadId\n  }\n\n-- | We can pass simple expressions to EvalStmt, consisting of values\n-- and application.  This allows us to wrap the statement to be\n-- executed in another function, which is used by GHCi to implement\n-- :set args and :set prog.  It might be worthwhile to extend this\n-- little language in the future.\ndata EvalExpr a\n  = EvalThis a\n  | EvalApp (EvalExpr a) (EvalExpr a)\n  deriving (Generic, Show)\n\ninstance Binary a => Binary (EvalExpr a)\n\ntype EvalStatus a = EvalStatus_ a a\n\ndata EvalStatus_ a b\n  = EvalComplete Word64 (EvalResult a)\n  | EvalBreak Bool\n       HValueRef{- AP_STACK -}\n       Int {- break index -}\n       Int {- uniq of ModuleName -}\n       (RemoteRef (ResumeContext b))\n       (RemotePtr CostCentreStack) -- Cost centre stack\n  deriving (Generic, Show)\n\ninstance Binary a => Binary (EvalStatus_ a b)\n\ndata EvalResult a\n  = EvalException SerializableException\n  | EvalSuccess a\n  deriving (Generic, Show)\n\ninstance Binary a => Binary (EvalResult a)\n\n-- SomeException can't be serialized because it contains dynamic\n-- types.  However, we do very limited things with the exceptions that\n-- are thrown by interpreted computations:\n--\n-- * We print them, e.g. \"*** Exception: <something>\"\n-- * UserInterrupt has a special meaning\n-- * In ghc -e, exitWith should exit with the appropriate exit code\n--\n-- So all we need to do is distinguish UserInterrupt and ExitCode, and\n-- all other exceptions can be represented by their 'show' string.\n--\ndata SerializableException\n  = EUserInterrupt\n  | EExitCode ExitCode\n  | EOtherException String\n  deriving (Generic, Show)\n\ntoSerializableException :: SomeException -> SerializableException\ntoSerializableException ex\n  | Just UserInterrupt <- fromException ex  = EUserInterrupt\n  | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)\n  | otherwise = EOtherException (show (ex :: SomeException))\n\nfromSerializableException :: SerializableException -> SomeException\nfromSerializableException EUserInterrupt = toException UserInterrupt\nfromSerializableException (EExitCode c) = toException c\nfromSerializableException (EOtherException str) = toException (ErrorCall str)\n\ninstance Binary ExitCode\ninstance Binary SerializableException\n\ndata THResult a\n  = THException String\n  | THComplete a\n  deriving (Generic, Show)\n\ninstance Binary a => Binary (THResult a)\n\ndata THResultType = THExp | THPat | THType | THDec | THAnnWrapper\n  deriving (Enum, Show, Generic)\n\ninstance Binary THResultType\n\n-- | The server-side Template Haskell state.  This is created by the\n-- StartTH message.  A new one is created per module that GHC\n-- typechecks.\ndata QState = QState\n  { qsMap        :: Map TypeRep Dynamic\n       -- ^ persistent data between splices in a module\n  , qsLocation   :: Maybe TH.Loc\n       -- ^ location for current splice, if any\n  , qsPipe :: Pipe\n       -- ^ pipe to communicate with GHC\n  }\ninstance Show QState where show _ = \"<QState>\"\n\n-- Orphan instances of Binary for Ptr / FunPtr by conversion to Word64.\n-- This is to support Binary StgInfoTable which includes these.\ninstance Binary (Ptr a) where\n  put p = put (fromIntegral (ptrToWordPtr p) :: Word64)\n  get = (wordPtrToPtr . fromIntegral) <$> (get :: Get Word64)\n\ninstance Binary (FunPtr a) where\n  put = put . castFunPtrToPtr\n  get = castPtrToFunPtr <$> get\n\n-- Binary instances to support the GetClosure message\ninstance Binary StgInfoTable\ninstance Binary ClosureType\ninstance Binary PrimType\ninstance Binary a => Binary (GenClosure a)\n\ndata Msg = forall a . (Binary a, Show a) => Msg (Message a)\n\ngetMessage :: Get Msg\ngetMessage = do\n    b <- getWord8\n    case b of\n      0  -> Msg <$> return Shutdown\n      1  -> Msg <$> return InitLinker\n      2  -> Msg <$> LookupSymbol <$> get\n      3  -> Msg <$> LookupClosure <$> get\n      4  -> Msg <$> LoadDLL <$> get\n      5  -> Msg <$> LoadArchive <$> get\n      6  -> Msg <$> LoadObj <$> get\n      7  -> Msg <$> UnloadObj <$> get\n      8  -> Msg <$> AddLibrarySearchPath <$> get\n      9  -> Msg <$> RemoveLibrarySearchPath <$> get\n      10 -> Msg <$> return ResolveObjs\n      11 -> Msg <$> FindSystemLibrary <$> get\n      12 -> Msg <$> CreateBCOs <$> get\n      13 -> Msg <$> FreeHValueRefs <$> get\n      14 -> Msg <$> MallocData <$> get\n      15 -> Msg <$> MallocStrings <$> get\n      16 -> Msg <$> (PrepFFI <$> get <*> get <*> get)\n      17 -> Msg <$> FreeFFI <$> get\n      18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get)\n      19 -> Msg <$> (EvalStmt <$> get <*> get)\n      20 -> Msg <$> (ResumeStmt <$> get <*> get)\n      21 -> Msg <$> (AbandonStmt <$> get)\n      22 -> Msg <$> (EvalString <$> get)\n      23 -> Msg <$> (EvalStringToString <$> get <*> get)\n      24 -> Msg <$> (EvalIO <$> get)\n      25 -> Msg <$> (MkCostCentres <$> get <*> get)\n      26 -> Msg <$> (CostCentreStackInfo <$> get)\n      27 -> Msg <$> (NewBreakArray <$> get)\n      28 -> Msg <$> (EnableBreakpoint <$> get <*> get <*> get)\n      29 -> Msg <$> (BreakpointStatus <$> get <*> get)\n      30 -> Msg <$> (GetBreakpointVar <$> get <*> get)\n      31 -> Msg <$> return StartTH\n      32 -> Msg <$> (RunModFinalizers <$> get <*> get)\n      33 -> Msg <$> (AddSptEntry <$> get <*> get)\n      34 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)\n      35 -> Msg <$> (GetClosure <$> get)\n      36 -> Msg <$> (Seq <$> get)\n      37 -> Msg <$> return RtsRevertCAFs\n      _  -> error $ \"Unknown Message code \" ++ (show b)\n\nputMessage :: Message a -> Put\nputMessage m = case m of\n  Shutdown                    -> putWord8 0\n  InitLinker                  -> putWord8 1\n  LookupSymbol str            -> putWord8 2  >> put str\n  LookupClosure str           -> putWord8 3  >> put str\n  LoadDLL str                 -> putWord8 4  >> put str\n  LoadArchive str             -> putWord8 5  >> put str\n  LoadObj str                 -> putWord8 6  >> put str\n  UnloadObj str               -> putWord8 7  >> put str\n  AddLibrarySearchPath str    -> putWord8 8  >> put str\n  RemoveLibrarySearchPath ptr -> putWord8 9  >> put ptr\n  ResolveObjs                 -> putWord8 10\n  FindSystemLibrary str       -> putWord8 11 >> put str\n  CreateBCOs bco              -> putWord8 12 >> put bco\n  FreeHValueRefs val          -> putWord8 13 >> put val\n  MallocData bs               -> putWord8 14 >> put bs\n  MallocStrings bss           -> putWord8 15 >> put bss\n  PrepFFI conv args res       -> putWord8 16 >> put conv >> put args >> put res\n  FreeFFI p                   -> putWord8 17 >> put p\n  MkConInfoTable p n t pt d   -> putWord8 18 >> put p >> put n >> put t >> put pt >> put d\n  EvalStmt opts val           -> putWord8 19 >> put opts >> put val\n  ResumeStmt opts val         -> putWord8 20 >> put opts >> put val\n  AbandonStmt val             -> putWord8 21 >> put val\n  EvalString val              -> putWord8 22 >> put val\n  EvalStringToString str val  -> putWord8 23 >> put str >> put val\n  EvalIO val                  -> putWord8 24 >> put val\n  MkCostCentres mod ccs       -> putWord8 25 >> put mod >> put ccs\n  CostCentreStackInfo ptr     -> putWord8 26 >> put ptr\n  NewBreakArray sz            -> putWord8 27 >> put sz\n  EnableBreakpoint arr ix b   -> putWord8 28 >> put arr >> put ix >> put b\n  BreakpointStatus arr ix     -> putWord8 29 >> put arr >> put ix\n  GetBreakpointVar a b        -> putWord8 30 >> put a >> put b\n  StartTH                     -> putWord8 31\n  RunModFinalizers a b        -> putWord8 32 >> put a >> put b\n  AddSptEntry a b             -> putWord8 33 >> put a >> put b\n  RunTH st q loc ty           -> putWord8 34 >> put st >> put q >> put loc >> put ty\n  GetClosure a                -> putWord8 35 >> put a\n  Seq a                       -> putWord8 36 >> put a\n  RtsRevertCAFs               -> putWord8 37\n\n-- -----------------------------------------------------------------------------\n-- Reading/writing messages\n\ndata Pipe = Pipe\n  { pipeRead :: Handle\n  , pipeWrite ::  Handle\n  , pipeLeftovers :: IORef (Maybe ByteString)\n  }\n\nremoteCall :: Binary a => Pipe -> Message a -> IO a\nremoteCall pipe msg = do\n  writePipe pipe (putMessage msg)\n  readPipe pipe get\n\nremoteTHCall :: Binary a => Pipe -> THMessage a -> IO a\nremoteTHCall pipe msg = do\n  writePipe pipe (putTHMessage msg)\n  readPipe pipe get\n\nwritePipe :: Pipe -> Put -> IO ()\nwritePipe Pipe{..} put\n  | LB.null bs = return ()\n  | otherwise  = do\n    LB.hPut pipeWrite bs\n    hFlush pipeWrite\n where\n  bs = runPut put\n\nreadPipe :: Pipe -> Get a -> IO a\nreadPipe Pipe{..} get = do\n  leftovers <- readIORef pipeLeftovers\n  m <- getBin pipeRead get leftovers\n  case m of\n    Nothing -> throw $\n      mkIOError eofErrorType \"GHCi.Message.remoteCall\" (Just pipeRead) Nothing\n    Just (result, new_leftovers) -> do\n      writeIORef pipeLeftovers new_leftovers\n      return result\n\ngetBin\n  :: Handle -> Get a -> Maybe ByteString\n  -> IO (Maybe (a, Maybe ByteString))\n\ngetBin h get leftover = go leftover (runGetIncremental get)\n where\n   go Nothing (Done leftover _ msg) =\n     return (Just (msg, if B.null leftover then Nothing else Just leftover))\n   go _ Done{} = throwIO (ErrorCall \"getBin: Done with leftovers\")\n   go (Just leftover) (Partial fun) = do\n     go Nothing (fun (Just leftover))\n   go Nothing (Partial fun) = do\n     -- putStrLn \"before hGetSome\"\n     b <- B.hGetSome h (32*1024)\n     -- printf \"hGetSome: %d\\n\" (B.length b)\n     if B.null b\n        then return Nothing\n        else go Nothing (fun (Just b))\n   go _lft (Fail _rest _off str) =\n     throwIO (ErrorCall (\"getBin: \" ++ str))\n", "num_lines": 593}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, UnboxedTuples, MagicHash #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n--\n--  (c) The University of Glasgow 2002-2006\n--\n\n-- ---------------------------------------------------------------------------\n--      The dynamic linker for object code (.o .so .dll files)\n-- ---------------------------------------------------------------------------\n\n-- | Primarily, this module consists of an interface to the C-land\n-- dynamic linker.\nmodule GHCi.ObjLink\n  ( initObjLinker, ShouldRetainCAFs(..)\n  , loadDLL\n  , loadArchive\n  , loadObj\n  , unloadObj\n  , purgeObj\n  , lookupSymbol\n  , lookupClosure\n  , resolveObjs\n  , addLibrarySearchPath\n  , removeLibrarySearchPath\n  , findSystemLibrary\n  )  where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHCi.RemoteTypes\nimport Control.Exception (throwIO, ErrorCall(..))\nimport Control.Monad    ( when )\nimport Foreign.C\nimport Foreign.Marshal.Alloc ( free )\nimport Foreign          ( nullPtr )\nimport GHC.Exts\nimport System.Posix.Internals ( CFilePath, withFilePath, peekFilePath )\nimport System.FilePath  ( dropExtension, normalise )\n\n\n\n\n-- ---------------------------------------------------------------------------\n-- RTS Linker Interface\n-- ---------------------------------------------------------------------------\n\ndata ShouldRetainCAFs\n  = RetainCAFs\n    -- ^ Retain CAFs unconditionally in linked Haskell code.\n    -- Note that this prevents any code from being unloaded.\n    -- It should not be necessary unless you are GHCi or\n    -- hs-plugins, which needs to be able call any function\n    -- in the compiled code.\n  | DontRetainCAFs\n    -- ^ Do not retain CAFs.  Everything reachable from foreign\n    -- exports will be retained, due to the StablePtrs\n    -- created by the module initialisation code.  unloadObj\n    -- frees these StablePtrs, which will allow the CAFs to\n    -- be GC'd and the code to be removed.\n\ninitObjLinker :: ShouldRetainCAFs -> IO ()\ninitObjLinker RetainCAFs = c_initLinker_ 1\ninitObjLinker _ = c_initLinker_ 0\n\nlookupSymbol :: String -> IO (Maybe (Ptr a))\nlookupSymbol str_in = do\n   let str = prefixUnderscore str_in\n   withCAString str $ \\c_str -> do\n     addr <- c_lookupSymbol c_str\n     if addr == nullPtr\n        then return Nothing\n        else return (Just addr)\n\nlookupClosure :: String -> IO (Maybe HValueRef)\nlookupClosure str = do\n  m <- lookupSymbol str\n  case m of\n    Nothing -> return Nothing\n    Just (Ptr addr) -> case addrToAny# addr of\n      (# a #) -> Just <$> mkRemoteRef (HValue a)\n\nprefixUnderscore :: String -> String\nprefixUnderscore\n | cLeadingUnderscore = ('_':)\n | otherwise          = id\n\n-- | loadDLL loads a dynamic library using the OS's native linker\n-- (i.e. dlopen() on Unix, LoadLibrary() on Windows).  It takes either\n-- an absolute pathname to the file, or a relative filename\n-- (e.g. \"libfoo.so\" or \"foo.dll\").  In the latter case, loadDLL\n-- searches the standard locations for the appropriate library.\n--\nloadDLL :: String -> IO (Maybe String)\n-- Nothing      => success\n-- Just err_msg => failure\nloadDLL str0 = do\n  let\n     -- On Windows, addDLL takes a filename without an extension, because\n     -- it tries adding both .dll and .drv.  To keep things uniform in the\n     -- layers above, loadDLL always takes a filename with an extension, and\n     -- we drop it here on Windows only.\n     str | isWindowsHost = dropExtension str0\n         | otherwise     = str0\n  --\n  maybe_errmsg <- withFilePath (normalise str) $ \\dll -> c_addDLL dll\n  if maybe_errmsg == nullPtr\n        then return Nothing\n        else do str <- peekCString maybe_errmsg\n                free maybe_errmsg\n                return (Just str)\n\nloadArchive :: String -> IO ()\nloadArchive str = do\n   withFilePath str $ \\c_str -> do\n     r <- c_loadArchive c_str\n     when (r == 0) (throwIO (ErrorCall (\"loadArchive \" ++ show str ++ \": failed\")))\n\nloadObj :: String -> IO ()\nloadObj str = do\n   withFilePath str $ \\c_str -> do\n     r <- c_loadObj c_str\n     when (r == 0) (throwIO (ErrorCall (\"loadObj \" ++ show str ++ \": failed\")))\n\n-- | @unloadObj@ drops the given dynamic library from the symbol table\n-- as well as enables the library to be removed from memory during\n-- a future major GC.\nunloadObj :: String -> IO ()\nunloadObj str =\n   withFilePath str $ \\c_str -> do\n     r <- c_unloadObj c_str\n     when (r == 0) (throwIO (ErrorCall (\"unloadObj \" ++ show str ++ \": failed\")))\n\n-- | @purgeObj@ drops the symbols for the dynamic library from the symbol\n-- table. Unlike 'unloadObj', the library will not be dropped memory during\n-- a future major GC.\npurgeObj :: String -> IO ()\npurgeObj str =\n   withFilePath str $ \\c_str -> do\n     r <- c_purgeObj c_str\n     when (r == 0) (throwIO (ErrorCall (\"purgeObj \" ++ show str ++ \": failed\")))\n\naddLibrarySearchPath :: String -> IO (Ptr ())\naddLibrarySearchPath str =\n   withFilePath str c_addLibrarySearchPath\n\nremoveLibrarySearchPath :: Ptr () -> IO Bool\nremoveLibrarySearchPath = c_removeLibrarySearchPath\n\nfindSystemLibrary :: String -> IO (Maybe String)\nfindSystemLibrary str = do\n    result <- withFilePath str c_findSystemLibrary\n    case result == nullPtr of\n        True  -> return Nothing\n        False -> do path <- peekFilePath result\n                    free result\n                    return $ Just path\n\nresolveObjs :: IO Bool\nresolveObjs = do\n   r <- c_resolveObjs\n   return (r /= 0)\n\n-- ---------------------------------------------------------------------------\n-- Foreign declarations to RTS entry points which does the real work;\n-- ---------------------------------------------------------------------------\n\nforeign import ccall unsafe \"addDLL\"                  c_addDLL                  :: CFilePath -> IO CString\nforeign import ccall unsafe \"initLinker_\"             c_initLinker_             :: CInt -> IO ()\nforeign import ccall unsafe \"lookupSymbol\"            c_lookupSymbol            :: CString -> IO (Ptr a)\nforeign import ccall unsafe \"loadArchive\"             c_loadArchive             :: CFilePath -> IO Int\nforeign import ccall unsafe \"loadObj\"                 c_loadObj                 :: CFilePath -> IO Int\nforeign import ccall unsafe \"purgeObj\"                c_purgeObj                :: CFilePath -> IO Int\nforeign import ccall unsafe \"unloadObj\"               c_unloadObj               :: CFilePath -> IO Int\nforeign import ccall unsafe \"resolveObjs\"             c_resolveObjs             :: IO Int\nforeign import ccall unsafe \"addLibrarySearchPath\"    c_addLibrarySearchPath    :: CFilePath -> IO (Ptr ())\nforeign import ccall unsafe \"findSystemLibrary\"       c_findSystemLibrary       :: CFilePath -> IO CFilePath\nforeign import ccall unsafe \"removeLibrarySearchPath\" c_removeLibrarySearchPath :: Ptr() -> IO Bool\n\n-- -----------------------------------------------------------------------------\n-- Configuration\n\n#include \"ghcautoconf.h\"\n\ncLeadingUnderscore :: Bool\n#if defined(LEADING_UNDERSCORE)\ncLeadingUnderscore = True\n#else\ncLeadingUnderscore = False\n#endif\n\nisWindowsHost :: Bool\n#if defined(mingw32_HOST_OS)\nisWindowsHost = True\n#else\nisWindowsHost = False\n#endif\n", "num_lines": 196}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}\n\n-- |\n-- Types for referring to remote objects in Remote GHCi.  For more\n-- details, see Note [External GHCi pointers] in compiler/ghci/GHCi.hs\n--\n-- For details on Remote GHCi, see Note [Remote GHCi] in\n-- compiler/ghci/GHCi.hs.\n--\nmodule GHCi.RemoteTypes\n  ( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr\n  , HValue(..)\n  , RemoteRef, mkRemoteRef, localRef, freeRemoteRef\n  , HValueRef, toHValueRef\n  , ForeignRef, mkForeignRef, withForeignRef\n  , ForeignHValue\n  , unsafeForeignRefToRemoteRef, finalizeForeignRef\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Control.DeepSeq\nimport Data.Word\nimport Foreign hiding (newForeignPtr)\nimport Foreign.Concurrent\nimport Data.Binary\nimport Unsafe.Coerce\nimport GHC.Exts\nimport GHC.ForeignPtr\n\n-- -----------------------------------------------------------------------------\n-- RemotePtr\n\n-- Static pointers only; don't use this for heap-resident pointers.\n-- Instead use HValueRef. We will fix the remote pointer to be 64 bits. This\n-- should cover 64 and 32bit systems, and permits the exchange of remote ptrs\n-- between machines of different word size. For exmaple, when connecting to\n-- an iserv instance on a different architecture with different word size via\n-- -fexternal-interpreter.\nnewtype RemotePtr a = RemotePtr Word64\n\ntoRemotePtr :: Ptr a -> RemotePtr a\ntoRemotePtr p = RemotePtr (fromIntegral (ptrToWordPtr p))\n\nfromRemotePtr :: RemotePtr a -> Ptr a\nfromRemotePtr (RemotePtr p) = wordPtrToPtr (fromIntegral p)\n\ncastRemotePtr :: RemotePtr a -> RemotePtr b\ncastRemotePtr (RemotePtr a) = RemotePtr a\n\nderiving instance Show (RemotePtr a)\nderiving instance Binary (RemotePtr a)\nderiving instance NFData (RemotePtr a)\n\n-- -----------------------------------------------------------------------------\n-- HValueRef\n\nnewtype HValue = HValue Any\n\ninstance Show HValue where\n  show _ = \"<HValue>\"\n\n-- | A reference to a remote value.  These are allocated and freed explicitly.\nnewtype RemoteRef a = RemoteRef (RemotePtr ())\n  deriving (Show, Binary)\n\n-- We can discard type information if we want\ntoHValueRef :: RemoteRef a -> RemoteRef HValue\ntoHValueRef = unsafeCoerce\n\n-- For convenience\ntype HValueRef = RemoteRef HValue\n\n-- | Make a reference to a local value that we can send remotely.\n-- This reference will keep the value that it refers to alive until\n-- 'freeRemoteRef' is called.\nmkRemoteRef :: a -> IO (RemoteRef a)\nmkRemoteRef a = do\n  sp <- newStablePtr a\n  return $! RemoteRef (toRemotePtr (castStablePtrToPtr sp))\n\n-- | Convert an HValueRef to an HValue.  Should only be used if the HValue\n-- originated in this process.\nlocalRef :: RemoteRef a -> IO a\nlocalRef (RemoteRef w) =\n  deRefStablePtr (castPtrToStablePtr (fromRemotePtr w))\n\n-- | Release an HValueRef that originated in this process\nfreeRemoteRef :: RemoteRef a -> IO ()\nfreeRemoteRef (RemoteRef w) =\n  freeStablePtr (castPtrToStablePtr (fromRemotePtr w))\n\n-- | An HValueRef with a finalizer\nnewtype ForeignRef a = ForeignRef (ForeignPtr ())\n\ninstance NFData (ForeignRef a) where\n  rnf x = x `seq` ()\n\ntype ForeignHValue = ForeignRef HValue\n\n-- | Create a 'ForeignRef' from a 'RemoteRef'.  The finalizer\n-- should arrange to call 'freeHValueRef' on the 'HValueRef'.  (since\n-- this function needs to be called in the process that created the\n-- 'HValueRef', it cannot be called directly from the finalizer).\nmkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)\nmkForeignRef (RemoteRef hvref) finalizer =\n  ForeignRef <$> newForeignPtr (fromRemotePtr hvref) finalizer\n\n-- | Use a 'ForeignHValue'\nwithForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b\nwithForeignRef (ForeignRef fp) f =\n   withForeignPtr fp (f . RemoteRef . toRemotePtr)\n\nunsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a\nunsafeForeignRefToRemoteRef (ForeignRef fp) =\n  RemoteRef (toRemotePtr (unsafeForeignPtrToPtr fp))\n\nfinalizeForeignRef :: ForeignRef a -> IO ()\nfinalizeForeignRef (ForeignRef fp) = finalizeForeignPtr fp\n", "num_lines": 119}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving,\n    BangPatterns, CPP #-}\nmodule GHCi.ResolvedBCO\n  ( ResolvedBCO(..)\n  , ResolvedBCOPtr(..)\n  , isLittleEndian\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport SizedSeq\nimport GHCi.RemoteTypes\nimport GHCi.BreakArray\n\nimport Data.Array.Unboxed\nimport Data.Binary\nimport GHC.Generics\nimport GHCi.BinaryArray\n\n\n#include \"MachDeps.h\"\n\nisLittleEndian :: Bool\n#if defined(WORDS_BIGENDIAN)\nisLittleEndian = True\n#else\nisLittleEndian = False\n#endif\n\n-- -----------------------------------------------------------------------------\n-- ResolvedBCO\n\n-- | A 'ResolvedBCO' is one in which all the 'Name' references have been\n-- resolved to actual addresses or 'RemoteHValues'.\n--\n-- Note, all arrays are zero-indexed (we assume this when\n-- serializing/deserializing)\ndata ResolvedBCO\n   = ResolvedBCO {\n        resolvedBCOIsLE   :: Bool,\n        resolvedBCOArity  :: {-# UNPACK #-} !Int,\n        resolvedBCOInstrs :: UArray Int Word16,         -- insns\n        resolvedBCOBitmap :: UArray Int Word64,         -- bitmap\n        resolvedBCOLits   :: UArray Int Word64,         -- non-ptrs\n        resolvedBCOPtrs   :: (SizedSeq ResolvedBCOPtr)  -- ptrs\n   }\n   deriving (Generic, Show)\n\n-- | The Binary instance for ResolvedBCOs.\n--\n-- Note, that we do encode the endianness, however there is no support for mixed\n-- endianness setups.  This is primarily to ensure that ghc and iserv share the\n-- same endianness.\ninstance Binary ResolvedBCO where\n  put ResolvedBCO{..} = do\n    put resolvedBCOIsLE\n    put resolvedBCOArity\n    putArray resolvedBCOInstrs\n    putArray resolvedBCOBitmap\n    putArray resolvedBCOLits\n    put resolvedBCOPtrs\n  get = ResolvedBCO\n        <$> get <*> get <*> getArray <*> getArray <*> getArray <*> get\n\ndata ResolvedBCOPtr\n  = ResolvedBCORef {-# UNPACK #-} !Int\n      -- ^ reference to the Nth BCO in the current set\n  | ResolvedBCOPtr {-# UNPACK #-} !(RemoteRef HValue)\n      -- ^ reference to a previously created BCO\n  | ResolvedBCOStaticPtr {-# UNPACK #-} !(RemotePtr ())\n      -- ^ reference to a static ptr\n  | ResolvedBCOPtrBCO ResolvedBCO\n      -- ^ a nested BCO\n  | ResolvedBCOPtrBreakArray {-# UNPACK #-} !(RemoteRef BreakArray)\n      -- ^ Resolves to the MutableArray# inside the BreakArray\n  deriving (Generic, Show)\n\ninstance Binary ResolvedBCOPtr\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,\n    UnboxedTuples #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n\n-- |\n-- Execute GHCi messages.\n--\n-- For details on Remote GHCi, see Note [Remote GHCi] in\n-- compiler/ghci/GHCi.hs.\n--\nmodule GHCi.Run\n  ( run, redirectInterrupts\n  ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHCi.CreateBCO\nimport GHCi.InfoTable\nimport GHCi.FFI\nimport GHCi.Message\nimport GHCi.ObjLink\nimport GHCi.RemoteTypes\nimport GHCi.TH\nimport GHCi.BreakArray\nimport GHCi.StaticPtrTable\n\nimport Control.Concurrent\nimport Control.DeepSeq\nimport Control.Exception\nimport Control.Monad\nimport Data.Binary\nimport Data.Binary.Get\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString.Unsafe as B\nimport GHC.Exts\nimport GHC.Exts.Heap\nimport GHC.Stack\nimport Foreign hiding (void)\nimport Foreign.C\nimport GHC.Conc.Sync\nimport GHC.IO hiding ( bracket )\nimport System.Mem.Weak  ( deRefWeak )\nimport Unsafe.Coerce\n\n-- -----------------------------------------------------------------------------\n-- Implement messages\n\nforeign import ccall \"revertCAFs\" rts_revertCAFs  :: IO ()\n        -- Make it \"safe\", just in case\n\nrun :: Message a -> IO a\nrun m = case m of\n  InitLinker -> initObjLinker RetainCAFs\n  RtsRevertCAFs -> rts_revertCAFs\n  LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str\n  LookupClosure str -> lookupClosure str\n  LoadDLL str -> loadDLL str\n  LoadArchive str -> loadArchive str\n  LoadObj str -> loadObj str\n  UnloadObj str -> unloadObj str\n  AddLibrarySearchPath str -> toRemotePtr <$> addLibrarySearchPath str\n  RemoveLibrarySearchPath ptr -> removeLibrarySearchPath (fromRemotePtr ptr)\n  ResolveObjs -> resolveObjs\n  FindSystemLibrary str -> findSystemLibrary str\n  CreateBCOs bcos -> createBCOs (concatMap (runGet get) bcos)\n  FreeHValueRefs rs -> mapM_ freeRemoteRef rs\n  AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr\n  EvalStmt opts r -> evalStmt opts r\n  ResumeStmt opts r -> resumeStmt opts r\n  AbandonStmt r -> abandonStmt r\n  EvalString r -> evalString r\n  EvalStringToString r s -> evalStringToString r s\n  EvalIO r -> evalIO r\n  MkCostCentres mod ccs -> mkCostCentres mod ccs\n  CostCentreStackInfo ptr -> ccsToStrings (fromRemotePtr ptr)\n  NewBreakArray sz -> mkRemoteRef =<< newBreakArray sz\n  EnableBreakpoint ref ix b -> do\n    arr <- localRef ref\n    _ <- if b then setBreakOn arr ix else setBreakOff arr ix\n    return ()\n  BreakpointStatus ref ix -> do\n    arr <- localRef ref; r <- getBreak arr ix\n    case r of\n      Nothing -> return False\n      Just w -> return (w /= 0)\n  GetBreakpointVar ref ix -> do\n    aps <- localRef ref\n    mapM mkRemoteRef =<< getIdValFromApStack aps ix\n  MallocData bs -> mkString bs\n  MallocStrings bss -> mapM mkString0 bss\n  PrepFFI conv args res -> toRemotePtr <$> prepForeignCall conv args res\n  FreeFFI p -> freeForeignCallInfo (fromRemotePtr p)\n  MkConInfoTable ptrs nptrs tag ptrtag desc ->\n    toRemotePtr <$> mkConInfoTable ptrs nptrs tag ptrtag desc\n  StartTH -> startTH\n  GetClosure ref -> do\n    clos <- getClosureData =<< localRef ref\n    mapM (\\(Box x) -> mkRemoteRef (HValue x)) clos\n  Seq ref -> tryEval (void $ evaluate =<< localRef ref)\n  _other -> error \"GHCi.Run.run\"\n\nevalStmt :: EvalOpts -> EvalExpr HValueRef -> IO (EvalStatus [HValueRef])\nevalStmt opts expr = do\n  io <- mkIO expr\n  sandboxIO opts $ do\n    rs <- unsafeCoerce io :: IO [HValue]\n    mapM mkRemoteRef rs\n where\n  mkIO (EvalThis href) = localRef href\n  mkIO (EvalApp l r) = do\n    l' <- mkIO l\n    r' <- mkIO r\n    return ((unsafeCoerce l' :: HValue -> HValue) r')\n\nevalIO :: HValueRef -> IO (EvalResult ())\nevalIO r = do\n  io <- localRef r\n  tryEval (unsafeCoerce io :: IO ())\n\nevalString :: HValueRef -> IO (EvalResult String)\nevalString r = do\n  io <- localRef r\n  tryEval $ do\n    r <- unsafeCoerce io :: IO String\n    evaluate (force r)\n\nevalStringToString :: HValueRef -> String -> IO (EvalResult String)\nevalStringToString r str = do\n  io <- localRef r\n  tryEval $ do\n    r <- (unsafeCoerce io :: String -> IO String) str\n    evaluate (force r)\n\n-- When running a computation, we redirect ^C exceptions to the running\n-- thread.  ToDo: we might want a way to continue even if the target\n-- thread doesn't die when it receives the exception... \"this thread\n-- is not responding\".\n--\n-- Careful here: there may be ^C exceptions flying around, so we start the new\n-- thread blocked (forkIO inherits mask from the parent, #1048), and unblock\n-- only while we execute the user's code.  We can't afford to lose the final\n-- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946)\n\nsandboxIO :: EvalOpts -> IO a -> IO (EvalStatus a)\nsandboxIO opts io = do\n  -- We are running in uninterruptibleMask\n  breakMVar <- newEmptyMVar\n  statusMVar <- newEmptyMVar\n  withBreakAction opts breakMVar statusMVar $ do\n    let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io\n    if useSandboxThread opts\n       then do\n         tid <- forkIO $ do unsafeUnmask runIt >>= putMVar statusMVar\n                                -- empty: can't block\n         redirectInterrupts tid $ unsafeUnmask $ takeMVar statusMVar\n       else\n          -- GLUT on OS X needs to run on the main thread. If you\n          -- try to use it from another thread then you just get a\n          -- white rectangle rendered. For this, or anything else\n          -- with such restrictions, you can turn the GHCi sandbox off\n          -- and things will be run in the main thread.\n          --\n          -- BUT, note that the debugging features (breakpoints,\n          -- tracing, etc.) need the expression to be running in a\n          -- separate thread, so debugging is only enabled when\n          -- using the sandbox.\n         runIt\n\n-- We want to turn ^C into a break when -fbreak-on-exception is on,\n-- but it's an async exception and we only break for sync exceptions.\n-- Idea: if we catch and re-throw it, then the re-throw will trigger\n-- a break.  Great - but we don't want to re-throw all exceptions, because\n-- then we'll get a double break for ordinary sync exceptions (you'd have\n-- to :continue twice, which looks strange).  So if the exception is\n-- not \"Interrupted\", we unset the exception flag before throwing.\n--\nrethrow :: EvalOpts -> IO a -> IO a\nrethrow EvalOpts{..} io =\n  catch io $ \\se -> do\n    -- If -fbreak-on-error, we break unconditionally,\n    --  but with care of not breaking twice\n    if breakOnError && not breakOnException\n       then poke exceptionFlag 1\n       else case fromException se of\n               -- If it is a \"UserInterrupt\" exception, we allow\n               --  a possible break by way of -fbreak-on-exception\n               Just UserInterrupt -> return ()\n               -- In any other case, we don't want to break\n               _ -> poke exceptionFlag 0\n    throwIO se\n\n--\n-- While we're waiting for the sandbox thread to return a result, if\n-- the current thread receives an asynchronous exception we re-throw\n-- it at the sandbox thread and continue to wait.\n--\n-- This is for two reasons:\n--\n--  * So that ^C interrupts runStmt (e.g. in GHCi), allowing the\n--    computation to run its exception handlers before returning the\n--    exception result to the caller of runStmt.\n--\n--  * clients of the GHC API can terminate a runStmt in progress\n--    without knowing the ThreadId of the sandbox thread (#1381)\n--\n-- NB. use a weak pointer to the thread, so that the thread can still\n-- be considered deadlocked by the RTS and sent a BlockedIndefinitely\n-- exception.  A symptom of getting this wrong is that conc033(ghci)\n-- will hang.\n--\nredirectInterrupts :: ThreadId -> IO a -> IO a\nredirectInterrupts target wait = do\n  wtid <- mkWeakThreadId target\n  wait `catch` \\e -> do\n     m <- deRefWeak wtid\n     case m of\n       Nothing -> wait\n       Just target -> do throwTo target (e :: SomeException); wait\n\nmeasureAlloc :: IO (EvalResult a) -> IO (EvalStatus a)\nmeasureAlloc io = do\n  setAllocationCounter maxBound\n  a <- io\n  ctr <- getAllocationCounter\n  let allocs = fromIntegral (maxBound::Int64) - fromIntegral ctr\n  return (EvalComplete allocs a)\n\n-- Exceptions can't be marshaled because they're dynamically typed, so\n-- everything becomes a String.\ntryEval :: IO a -> IO (EvalResult a)\ntryEval io = do\n  e <- try io\n  case e of\n    Left ex -> return (EvalException (toSerializableException ex))\n    Right a -> return (EvalSuccess a)\n\n-- This function sets up the interpreter for catching breakpoints, and\n-- resets everything when the computation has stopped running.  This\n-- is a not-very-good way to ensure that only the interactive\n-- evaluation should generate breakpoints.\nwithBreakAction :: EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a\nwithBreakAction opts breakMVar statusMVar act\n = bracket setBreakAction resetBreakAction (\\_ -> act)\n where\n   setBreakAction = do\n     stablePtr <- newStablePtr onBreak\n     poke breakPointIOAction stablePtr\n     when (breakOnException opts) $ poke exceptionFlag 1\n     when (singleStep opts) $ setStepFlag\n     return stablePtr\n        -- Breaking on exceptions is not enabled by default, since it\n        -- might be a bit surprising.  The exception flag is turned off\n        -- as soon as it is hit, or in resetBreakAction below.\n\n   onBreak :: BreakpointCallback\n   onBreak ix# uniq# is_exception apStack = do\n     tid <- myThreadId\n     let resume = ResumeContext\n           { resumeBreakMVar = breakMVar\n           , resumeStatusMVar = statusMVar\n           , resumeThreadId = tid }\n     resume_r <- mkRemoteRef resume\n     apStack_r <- mkRemoteRef apStack\n     ccs <- toRemotePtr <$> getCCSOf apStack\n     putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (I# uniq#) resume_r ccs\n     takeMVar breakMVar\n\n   resetBreakAction stablePtr = do\n     poke breakPointIOAction noBreakStablePtr\n     poke exceptionFlag 0\n     resetStepFlag\n     freeStablePtr stablePtr\n\nresumeStmt\n  :: EvalOpts -> RemoteRef (ResumeContext [HValueRef])\n  -> IO (EvalStatus [HValueRef])\nresumeStmt opts hvref = do\n  ResumeContext{..} <- localRef hvref\n  withBreakAction opts resumeBreakMVar resumeStatusMVar $\n    mask_ $ do\n      putMVar resumeBreakMVar () -- this awakens the stopped thread...\n      redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar\n\n-- when abandoning a computation we have to\n--      (a) kill the thread with an async exception, so that the\n--          computation itself is stopped, and\n--      (b) fill in the MVar.  This step is necessary because any\n--          thunks that were under evaluation will now be updated\n--          with the partial computation, which still ends in takeMVar,\n--          so any attempt to evaluate one of these thunks will block\n--          unless we fill in the MVar.\n--      (c) wait for the thread to terminate by taking its status MVar.  This\n--          step is necessary to prevent race conditions with\n--          -fbreak-on-exception (see #5975).\n--  See test break010.\nabandonStmt :: RemoteRef (ResumeContext [HValueRef]) -> IO ()\nabandonStmt hvref = do\n  ResumeContext{..} <- localRef hvref\n  killThread resumeThreadId\n  putMVar resumeBreakMVar ()\n  _ <- takeMVar resumeStatusMVar\n  return ()\n\nforeign import ccall \"&rts_stop_next_breakpoint\" stepFlag      :: Ptr CInt\nforeign import ccall \"&rts_stop_on_exception\"    exceptionFlag :: Ptr CInt\n\nsetStepFlag :: IO ()\nsetStepFlag = poke stepFlag 1\nresetStepFlag :: IO ()\nresetStepFlag = poke stepFlag 0\n\ntype BreakpointCallback\n     = Int#    -- the breakpoint index\n    -> Int#    -- the module uniq\n    -> Bool    -- exception?\n    -> HValue  -- the AP_STACK, or exception\n    -> IO ()\n\nforeign import ccall \"&rts_breakpoint_io_action\"\n   breakPointIOAction :: Ptr (StablePtr BreakpointCallback)\n\nnoBreakStablePtr :: StablePtr BreakpointCallback\nnoBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction\n\nnoBreakAction :: BreakpointCallback\nnoBreakAction _ _ False _ = putStrLn \"*** Ignoring breakpoint\"\nnoBreakAction _ _ True  _ = return () -- exception: just continue\n\n-- Malloc and copy the bytes.  We don't have any way to monitor the\n-- lifetime of this memory, so it just leaks.\nmkString :: ByteString -> IO (RemotePtr ())\nmkString bs = B.unsafeUseAsCStringLen bs $ \\(cstr,len) -> do\n  ptr <- mallocBytes len\n  copyBytes ptr cstr len\n  return (castRemotePtr (toRemotePtr ptr))\n\nmkString0 :: ByteString -> IO (RemotePtr ())\nmkString0 bs = B.unsafeUseAsCStringLen bs $ \\(cstr,len) -> do\n  ptr <- mallocBytes (len+1)\n  copyBytes ptr cstr len\n  pokeElemOff (ptr :: Ptr CChar) len 0\n  return (castRemotePtr (toRemotePtr ptr))\n\nmkCostCentres :: String -> [(String,String)] -> IO [RemotePtr CostCentre]\n#if defined(PROFILING)\nmkCostCentres mod ccs = do\n  c_module <- newCString mod\n  mapM (mk_one c_module) ccs\n where\n  mk_one c_module (decl_path,srcspan) = do\n    c_name <- newCString decl_path\n    c_srcspan <- newCString srcspan\n    toRemotePtr <$> c_mkCostCentre c_name c_module c_srcspan\n\nforeign import ccall unsafe \"mkCostCentre\"\n  c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CostCentre)\n#else\nmkCostCentres _ _ = return []\n#endif\n\ngetIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)\ngetIdValFromApStack apStack (I# stackDepth) = do\n   case getApStackVal# apStack stackDepth of\n        (# ok, result #) ->\n            case ok of\n              0# -> return Nothing -- AP_STACK not found\n              _  -> return (Just (unsafeCoerce# result))\n", "num_lines": 367}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule GHCi.Signals (installSignalHandlers) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Control.Concurrent\nimport Control.Exception\nimport System.Mem.Weak  ( deRefWeak )\n\n#if !defined(mingw32_HOST_OS)\nimport System.Posix.Signals\n#endif\n\n#if defined(mingw32_HOST_OS)\nimport GHC.ConsoleHandler\n#endif\n\n-- | Install standard signal handlers for catching ^C, which just throw an\n--   exception in the target thread.  The current target thread is the\n--   thread at the head of the list in the MVar passed to\n--   installSignalHandlers.\ninstallSignalHandlers :: IO ()\ninstallSignalHandlers = do\n  main_thread <- myThreadId\n  wtid <- mkWeakThreadId main_thread\n\n  let interrupt = do\n        r <- deRefWeak wtid\n        case r of\n          Nothing -> return ()\n          Just t  -> throwTo t UserInterrupt\n\n#if !defined(mingw32_HOST_OS)\n  _ <- installHandler sigQUIT  (Catch interrupt) Nothing\n  _ <- installHandler sigINT   (Catch interrupt) Nothing\n#else\n  -- GHC 6.3+ has support for console events on Windows\n  -- NOTE: running GHCi under a bash shell for some reason requires\n  -- you to press Ctrl-Break rather than Ctrl-C to provoke\n  -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know\n  -- why --SDM 17/12/2004\n  let sig_handler ControlC = interrupt\n      sig_handler Break    = interrupt\n      sig_handler _        = return ()\n\n  _ <- installHandler (Catch sig_handler)\n#endif\n  return ()\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule GHCi.StaticPtrTable ( sptAddEntry ) where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Data.Word\nimport Foreign\nimport GHC.Fingerprint\nimport GHCi.RemoteTypes\n\n-- | Used by GHCi to add an SPT entry for a set of interactive bindings.\nsptAddEntry :: Fingerprint -> HValue -> IO ()\nsptAddEntry (Fingerprint a b) (HValue x) = do\n    -- We own the memory holding the key (fingerprint) which gets inserted into\n    -- the static pointer table and can't free it until the SPT entry is removed\n    -- (which is currently never).\n    fpr_ptr <- newArray [a,b]\n    sptr <- newStablePtr x\n    ent_ptr <- malloc\n    poke ent_ptr (castStablePtrToPtr sptr)\n    spt_insert_stableptr fpr_ptr ent_ptr\n\nforeign import ccall \"hs_spt_insert_stableptr\"\n    spt_insert_stableptr :: Ptr Word64 -> Ptr (Ptr ()) -> IO ()\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, DeriveGeneric,\n    TupleSections, RecordWildCards, InstanceSigs, CPP #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n\n-- |\n-- Running TH splices\n--\nmodule GHCi.TH\n  ( startTH\n  , runModFinalizerRefs\n  , runTH\n  , GHCiQException(..)\n  ) where\n\n{- Note [Remote Template Haskell]\n\nHere is an overview of how TH works with -fexternal-interpreter.\n\nInitialisation\n~~~~~~~~~~~~~~\n\nGHC sends a StartTH message to the server (see TcSplice.getTHState):\n\n   StartTH :: Message (RemoteRef (IORef QState))\n\nThe server creates an initial QState object, makes an IORef to it, and\nreturns a RemoteRef to this to GHC. (see GHCi.TH.startTH below).\n\nThis happens once per module, the first time we need to run a TH\nsplice.  The reference that GHC gets back is kept in\ntcg_th_remote_state in the TcGblEnv, and passed to each RunTH call\nthat follows.\n\n\nFor each splice\n~~~~~~~~~~~~~~~\n\n1. GHC compiles a splice to byte code, and sends it to the server: in\n   a CreateBCOs message:\n\n   CreateBCOs :: [LB.ByteString] -> Message [HValueRef]\n\n2. The server creates the real byte-code objects in its heap, and\n   returns HValueRefs to GHC.  HValueRef is the same as RemoteRef\n   HValue.\n\n3. GHC sends a RunTH message to the server:\n\n  RunTH\n   :: RemoteRef (IORef QState)\n        -- The state returned by StartTH in step1\n   -> HValueRef\n        -- The HValueRef we got in step 4, points to the code for the splice\n   -> THResultType\n        -- Tells us what kind of splice this is (decl, expr, type, etc.)\n   -> Maybe TH.Loc\n        -- Source location\n   -> Message (QResult ByteString)\n        -- Eventually it will return a QResult back to GHC.  The\n        -- ByteString here is the (encoded) result of the splice.\n\n4. The server runs the splice code.\n\n5. Each time the splice code calls a method of the Quasi class, such\n   as qReify, a message is sent from the server to GHC.  These\n   messages are defined by the THMessage type.  GHC responds with the\n   result of the request, e.g. in the case of qReify it would be the\n   TH.Info for the requested entity.\n\n6. When the splice has been fully evaluated, the server sends\n   RunTHDone back to GHC.  This tells GHC that the server has finished\n   sending THMessages and will send the QResult next.\n\n8. The server then sends a QResult back to GHC, which is notionally\n   the response to the original RunTH message.  The QResult indicates\n   whether the splice succeeded, failed, or threw an exception.\n\n\nAfter typechecking\n~~~~~~~~~~~~~~~~~~\n\nGHC sends a FinishTH message to the server (see TcSplice.finishTH).\nThe server runs any finalizers that were added by addModuleFinalizer.\n\n\nOther Notes on TH / Remote GHCi\n\n  * Note [Remote GHCi] in compiler/ghci/GHCi.hs\n  * Note [External GHCi pointers] in compiler/ghci/GHCi.hs\n  * Note [TH recover with -fexternal-interpreter] in\n    compiler/typecheck/TcSplice.hs\n-}\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport GHCi.Message\nimport GHCi.RemoteTypes\nimport GHC.Serialized\n\nimport Control.Exception\nimport qualified Control.Monad.Fail as Fail\nimport Control.Monad.IO.Class (MonadIO (..))\nimport Data.Binary\nimport Data.Binary.Put\nimport Data.ByteString (ByteString)\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.Lazy as LB\nimport Data.Data\nimport Data.Dynamic\nimport Data.Either\nimport Data.IORef\nimport Data.Map (Map)\nimport qualified Data.Map as M\nimport Data.Maybe\nimport GHC.Desugar\nimport qualified Language.Haskell.TH        as TH\nimport qualified Language.Haskell.TH.Syntax as TH\nimport Unsafe.Coerce\n\n-- | Create a new instance of 'QState'\ninitQState :: Pipe -> QState\ninitQState p = QState M.empty Nothing p\n\n-- | The monad in which we run TH computations on the server\nnewtype GHCiQ a = GHCiQ { runGHCiQ :: QState -> IO (a, QState) }\n\n-- | The exception thrown by \"fail\" in the GHCiQ monad\ndata GHCiQException = GHCiQException QState String\n  deriving Show\n\ninstance Exception GHCiQException\n\ninstance Functor GHCiQ where\n  fmap f (GHCiQ s) = GHCiQ $ fmap (\\(x,s') -> (f x,s')) . s\n\ninstance Applicative GHCiQ where\n  f <*> a = GHCiQ $ \\s ->\n    do (f',s')  <- runGHCiQ f s\n       (a',s'') <- runGHCiQ a s'\n       return (f' a', s'')\n  pure x = GHCiQ (\\s -> return (x,s))\n\ninstance Monad GHCiQ where\n  m >>= f = GHCiQ $ \\s ->\n    do (m', s')  <- runGHCiQ m s\n       (a,  s'') <- runGHCiQ (f m') s'\n       return (a, s'')\n#if !MIN_VERSION_base(4,13,0)\n  fail = Fail.fail\n#endif\n\ninstance Fail.MonadFail GHCiQ where\n  fail err  = GHCiQ $ \\s -> throwIO (GHCiQException s err)\n\ngetState :: GHCiQ QState\ngetState = GHCiQ $ \\s -> return (s,s)\n\nnoLoc :: TH.Loc\nnoLoc = TH.Loc \"<no file>\" \"<no package>\" \"<no module>\" (0,0) (0,0)\n\n-- | Send a 'THMessage' to GHC and return the result.\nghcCmd :: Binary a => THMessage (THResult a) -> GHCiQ a\nghcCmd m = GHCiQ $ \\s -> do\n  r <- remoteTHCall (qsPipe s) m\n  case r of\n    THException str -> throwIO (GHCiQException s str)\n    THComplete res -> return (res, s)\n\ninstance MonadIO GHCiQ where\n  liftIO m = GHCiQ $ \\s -> fmap (,s) m\n\ninstance TH.Quasi GHCiQ where\n  qNewName str = ghcCmd (NewName str)\n  qReport isError msg = ghcCmd (Report isError msg)\n\n  -- See Note [TH recover with -fexternal-interpreter] in TcSplice\n  qRecover (GHCiQ h) a = GHCiQ $ \\s -> mask $ \\unmask -> do\n    remoteTHCall (qsPipe s) StartRecover\n    e <- try $ unmask $ runGHCiQ (a <* ghcCmd FailIfErrs) s\n    remoteTHCall (qsPipe s) (EndRecover (isLeft e))\n    case e of\n      Left GHCiQException{} -> h s\n      Right r -> return r\n  qLookupName isType occ = ghcCmd (LookupName isType occ)\n  qReify name = ghcCmd (Reify name)\n  qReifyFixity name = ghcCmd (ReifyFixity name)\n  qReifyInstances name tys = ghcCmd (ReifyInstances name tys)\n  qReifyRoles name = ghcCmd (ReifyRoles name)\n\n  -- To reify annotations, we send GHC the AnnLookup and also the\n  -- TypeRep of the thing we're looking for, to avoid needing to\n  -- serialize irrelevant annotations.\n  qReifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a]\n  qReifyAnnotations lookup =\n    map (deserializeWithData . B.unpack) <$>\n      ghcCmd (ReifyAnnotations lookup typerep)\n    where typerep = typeOf (undefined :: a)\n\n  qReifyModule m = ghcCmd (ReifyModule m)\n  qReifyConStrictness name = ghcCmd (ReifyConStrictness name)\n  qLocation = fromMaybe noLoc . qsLocation <$> getState\n  qAddDependentFile file = ghcCmd (AddDependentFile file)\n  qAddTempFile suffix = ghcCmd (AddTempFile suffix)\n  qAddTopDecls decls = ghcCmd (AddTopDecls decls)\n  qAddForeignFilePath lang fp = ghcCmd (AddForeignFilePath lang fp)\n  qAddModFinalizer fin = GHCiQ (\\s -> mkRemoteRef fin >>= return . (, s)) >>=\n                         ghcCmd . AddModFinalizer\n  qAddCorePlugin str = ghcCmd (AddCorePlugin str)\n  qGetQ = GHCiQ $ \\s ->\n    let lookup :: forall a. Typeable a => Map TypeRep Dynamic -> Maybe a\n        lookup m = fromDynamic =<< M.lookup (typeOf (undefined::a)) m\n    in return (lookup (qsMap s), s)\n  qPutQ k = GHCiQ $ \\s ->\n    return ((), s { qsMap = M.insert (typeOf k) (toDyn k) (qsMap s) })\n  qIsExtEnabled x = ghcCmd (IsExtEnabled x)\n  qExtsEnabled = ghcCmd ExtsEnabled\n\n-- | The implementation of the 'StartTH' message: create\n-- a new IORef QState, and return a RemoteRef to it.\nstartTH :: IO (RemoteRef (IORef QState))\nstartTH = do\n  r <- newIORef (initQState (error \"startTH: no pipe\"))\n  mkRemoteRef r\n\n-- | Runs the mod finalizers.\n--\n-- The references must be created on the caller process.\nrunModFinalizerRefs :: Pipe -> RemoteRef (IORef QState)\n                    -> [RemoteRef (TH.Q ())]\n                    -> IO ()\nrunModFinalizerRefs pipe rstate qrefs = do\n  qs <- mapM localRef qrefs\n  qstateref <- localRef rstate\n  qstate <- readIORef qstateref\n  _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate { qsPipe = pipe }\n  return ()\n\n-- | The implementation of the 'RunTH' message\nrunTH\n  :: Pipe\n  -> RemoteRef (IORef QState)\n      -- ^ The TH state, created by 'startTH'\n  -> HValueRef\n      -- ^ The splice to run\n  -> THResultType\n      -- ^ What kind of splice it is\n  -> Maybe TH.Loc\n      -- ^ The source location\n  -> IO ByteString\n      -- ^ Returns an (encoded) result that depends on the THResultType\n\nrunTH pipe rstate rhv ty mb_loc = do\n  hv <- localRef rhv\n  case ty of\n    THExp -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q TH.Exp)\n    THPat -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q TH.Pat)\n    THType -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q TH.Type)\n    THDec -> runTHQ pipe rstate mb_loc (unsafeCoerce hv :: TH.Q [TH.Dec])\n    THAnnWrapper -> do\n      hv <- unsafeCoerce <$> localRef rhv\n      case hv :: AnnotationWrapper of\n        AnnotationWrapper thing -> return $!\n          LB.toStrict (runPut (put (toSerialized serializeWithData thing)))\n\n-- | Run a Q computation.\nrunTHQ\n  :: Binary a => Pipe -> RemoteRef (IORef QState) -> Maybe TH.Loc -> TH.Q a\n  -> IO ByteString\nrunTHQ pipe rstate mb_loc ghciq = do\n  qstateref <- localRef rstate\n  qstate <- readIORef qstateref\n  let st = qstate { qsLocation = mb_loc, qsPipe = pipe }\n  (r,new_state) <- runGHCiQ (TH.runQ ghciq) st\n  writeIORef qstateref new_state\n  return $! LB.toStrict (runPut (put r))\n", "num_lines": 275}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-orphans #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\n\n-- This module is full of orphans, unfortunately\nmodule GHCi.TH.Binary () where\n\nimport Prelude -- See note [Why do we import Prelude here?]\nimport Data.Binary\nimport qualified Data.ByteString as B\nimport GHC.Serialized\nimport qualified Language.Haskell.TH        as TH\nimport qualified Language.Haskell.TH.Syntax as TH\n-- Put these in a separate module because they take ages to compile\n\ninstance Binary TH.Loc\ninstance Binary TH.Name\ninstance Binary TH.ModName\ninstance Binary TH.NameFlavour\ninstance Binary TH.PkgName\ninstance Binary TH.NameSpace\ninstance Binary TH.Module\ninstance Binary TH.Info\ninstance Binary TH.Type\ninstance Binary TH.TyLit\ninstance Binary TH.TyVarBndr\ninstance Binary TH.Role\ninstance Binary TH.Lit\ninstance Binary TH.Range\ninstance Binary TH.Stmt\ninstance Binary TH.Pat\ninstance Binary TH.Exp\ninstance Binary TH.Dec\ninstance Binary TH.Overlap\ninstance Binary TH.DerivClause\ninstance Binary TH.DerivStrategy\ninstance Binary TH.Guard\ninstance Binary TH.Body\ninstance Binary TH.Match\ninstance Binary TH.Fixity\ninstance Binary TH.TySynEqn\ninstance Binary TH.FunDep\ninstance Binary TH.AnnTarget\ninstance Binary TH.RuleBndr\ninstance Binary TH.Phases\ninstance Binary TH.RuleMatch\ninstance Binary TH.Inline\ninstance Binary TH.Pragma\ninstance Binary TH.Safety\ninstance Binary TH.Callconv\ninstance Binary TH.Foreign\ninstance Binary TH.Bang\ninstance Binary TH.SourceUnpackedness\ninstance Binary TH.SourceStrictness\ninstance Binary TH.DecidedStrictness\ninstance Binary TH.FixityDirection\ninstance Binary TH.OccName\ninstance Binary TH.Con\ninstance Binary TH.AnnLookup\ninstance Binary TH.ModuleInfo\ninstance Binary TH.Clause\ninstance Binary TH.InjectivityAnn\ninstance Binary TH.FamilyResultSig\ninstance Binary TH.TypeFamilyHead\ninstance Binary TH.PatSynDir\ninstance Binary TH.PatSynArgs\n\n-- We need Binary TypeRep for serializing annotations\n\ninstance Binary Serialized where\n    put (Serialized tyrep wds) = put tyrep >> put (B.pack wds)\n    get = Serialized <$> get <*> (B.unpack <$> get)\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMainWithHooks autoconfUserHooks\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n#include \"MachDeps.h\"\n\n-- |\n-- Module      :  GHC.Integer.Type\n-- Copyright   :  (c) Herbert Valerio Riedel 2014\n-- License     :  BSD3\n--\n-- Maintainer  :  ghc-devs@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (GHC Extensions)\n--\n-- The 'Integer' type.\n--\n-- This module exposes the /portable/ 'Integer' API.  See\n-- \"GHC.Integer.GMP.Internals\" for the @integer-gmp@-specific internal\n-- representation of 'Integer' as well as optimized GMP-specific\n-- operations.\n\nmodule GHC.Integer (\n    Integer,\n\n    -- * Construct 'Integer's\n    mkInteger, smallInteger, wordToInteger,\n#if WORD_SIZE_IN_BITS < 64\n    word64ToInteger, int64ToInteger,\n#endif\n    -- * Conversion to other integral types\n    integerToWord, integerToInt,\n#if WORD_SIZE_IN_BITS < 64\n    integerToWord64, integerToInt64,\n#endif\n\n    -- * Helpers for 'RealFloat' type-class operations\n    encodeFloatInteger, floatFromInteger,\n    encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,\n\n    -- * Arithmetic operations\n    plusInteger, minusInteger, timesInteger, negateInteger,\n    absInteger, signumInteger,\n\n    divModInteger, divInteger, modInteger,\n    quotRemInteger, quotInteger, remInteger,\n\n    -- * Comparison predicates\n    eqInteger,  neqInteger,  leInteger,  gtInteger,  ltInteger,  geInteger,\n    compareInteger,\n\n    -- ** 'Int#'-boolean valued versions of comparison predicates\n    --\n    -- | These operations return @0#@ and @1#@ instead of 'False' and\n    -- 'True' respectively.  See\n    -- <https://ghc.haskell.org/trac/ghc/wiki/PrimBool PrimBool wiki-page>\n    -- for more details\n    eqInteger#, neqInteger#, leInteger#, gtInteger#, ltInteger#, geInteger#,\n\n\n    -- * Bit-operations\n    andInteger, orInteger, xorInteger,\n\n    complementInteger,\n    shiftLInteger, shiftRInteger, testBitInteger,\n\n    popCountInteger, bitInteger,\n\n    -- * Hashing\n    hashInteger,\n    ) where\n\nimport GHC.Integer.Type\n\ndefault ()\n", "num_lines": 76}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE BangPatterns #-}\n\nmodule GHC.Integer.Logarithms\n    ( wordLog2#\n    , integerLog2#\n    , integerLogBase#\n    ) where\n\n#include \"MachDeps.h\"\n\n#if WORD_SIZE_IN_BITS == 32\n# define LD_WORD_SIZE_IN_BITS 5\n#elif WORD_SIZE_IN_BITS == 64\n# define LD_WORD_SIZE_IN_BITS 6\n#else\n# error unsupported WORD_SIZE_IN_BITS\n#endif\n\nimport GHC.Integer.Type\n\nimport GHC.Prim\n\ndefault ()\n\n-- | Calculate the integer logarithm for an arbitrary base.\n--\n-- The base must be greater than @1@, the second argument, the number\n-- whose logarithm is sought, shall be positive, otherwise the\n-- result is meaningless.\n--\n-- The following property holds\n--\n-- @base ^ 'integerLogBase#' base m <= m < base ^('integerLogBase#' base m + 1)@\n--\n-- for @base > 1@ and @m > 0@.\n--\n-- Note: Internally uses 'integerLog2#' for base 2\nintegerLogBase# :: Integer -> Integer -> Int#\nintegerLogBase# (S# 2#) m = integerLog2# m\nintegerLogBase# b m = e'\n  where\n    !(# _, e' #) = go b\n\n    go pw | m `ltInteger` pw = (# m, 0# #)\n    go pw = case go (sqrInteger pw) of\n              (# q, e #) | q `ltInteger` pw -> (# q, 2# *# e #)\n              (# q, e #) -> (# q `quotInteger` pw, 2# *# e +# 1# #)\n\n\n-- | Calculate the integer base 2 logarithm of an 'Integer'.  The\n-- calculation is more efficient than for the general case, on\n-- platforms with 32- or 64-bit words much more efficient.\n--\n-- The argument must be strictly positive, that condition is /not/ checked.\nintegerLog2# :: Integer -> Int#\nintegerLog2# (S# i#) = wordLog2# (int2Word# i#)\nintegerLog2# (Jn#  _) = -1#\nintegerLog2# (Jp# bn) = go (s -# 1#)\n  where\n    s = sizeofBigNat# bn\n    go i = case indexBigNat# bn i of\n               0## -> go (i -# 1#)\n               w   -> wordLog2# w +# (uncheckedIShiftL# i LD_WORD_SIZE_IN_BITS#)\n\n-- | Compute base-2 log of 'Word#'\n--\n-- This is internally implemented as count-leading-zeros machine instruction.\nwordLog2# :: Word# -> Int#\nwordLog2# w# = (WORD_SIZE_IN_BITS# -# 1#) -# (word2Int# (clz# w#))\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GHCForeignImportPrim #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n{-# LANGUAGE RebindableSyntax #-}\n{-# LANGUAGE NegativeLiterals #-}\n{-# LANGUAGE ExplicitForAll #-}\n\n-- |\n-- Module      :  GHC.Integer.Type\n-- Copyright   :  (c) Herbert Valerio Riedel 2014\n-- License     :  BSD3\n--\n-- Maintainer  :  ghc-devs@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (GHC Extensions)\n--\n-- GHC needs this module to be named \"GHC.Integer.Type\" and provide\n-- all the low-level 'Integer' operations.\n\nmodule GHC.Integer.Type where\n\n#include \"MachDeps.h\"\n#include \"HsIntegerGmp.h\"\n\n-- Sanity check as CPP defines are implicitly 0-valued when undefined\n#if !(defined(SIZEOF_LONG) && defined(SIZEOF_HSWORD) \\\n           && defined(WORD_SIZE_IN_BITS))\n# error missing defines\n#endif\n\nimport GHC.Classes\nimport GHC.Magic\nimport GHC.Prim\nimport GHC.Types\n#if WORD_SIZE_IN_BITS < 64\nimport GHC.IntWord64\n#endif\n\ndefault ()\n\n-- Most high-level operations need to be marked `NOINLINE` as\n-- otherwise GHC doesn't recognize them and fails to apply constant\n-- folding to `Integer`-typed expression.\n--\n-- To this end, the CPP hack below allows to write the pseudo-pragma\n--\n--   {-# CONSTANT_FOLDED plusInteger #-}\n--\n-- which is simply expaned into a\n--\n--   {-# NOINLINE plusInteger #-}\n--\n#define CONSTANT_FOLDED NOINLINE\n\n----------------------------------------------------------------------------\n-- type definitions\n\n-- NB: all code assumes GMP_LIMB_BITS == WORD_SIZE_IN_BITS\n-- The C99 code in cbits/wrappers.c will fail to compile if this doesn't hold\n\n-- | Type representing a GMP Limb\ntype GmpLimb = Word -- actually, 'CULong'\ntype GmpLimb# = Word#\n\n-- | Count of 'GmpLimb's, must be positive (unless specified otherwise).\ntype GmpSize = Int  -- actually, a 'CLong'\ntype GmpSize# = Int#\n\nnarrowGmpSize# :: Int# -> Int#\n#if SIZEOF_LONG == SIZEOF_HSWORD\nnarrowGmpSize# x = x\n#elif (SIZEOF_LONG == 4) && (SIZEOF_HSWORD == 8)\n-- On IL32P64 (i.e. Win64), we have to be careful with CLong not being\n-- 64bit.  This is mostly an issue on values returned from C functions\n-- due to sign-extension.\nnarrowGmpSize# = narrow32Int#\n#endif\n\n\ntype GmpBitCnt = Word -- actually, 'CULong'\ntype GmpBitCnt# = Word# -- actually, 'CULong'\n\n-- Pseudo FFI CType\ntype CInt = Int\ntype CInt# = Int#\n\nnarrowCInt# :: Int# -> Int#\nnarrowCInt# = narrow32Int#\n\n-- | Bits in a 'GmpLimb'. Same as @WORD_SIZE_IN_BITS@.\ngmpLimbBits :: Word -- 8 `shiftL` gmpLimbShift\ngmpLimbBits = W# WORD_SIZE_IN_BITS##\n\n#if WORD_SIZE_IN_BITS == 64\n# define GMP_LIMB_SHIFT   3\n# define GMP_LIMB_BYTES   8\n# define GMP_LIMB_BITS    64\n# define INT_MINBOUND     -0x8000000000000000\n# define INT_MAXBOUND      0x7fffffffffffffff\n# define ABS_INT_MINBOUND  0x8000000000000000\n# define SQRT_INT_MAXBOUND 0xb504f333\n#elif WORD_SIZE_IN_BITS == 32\n# define GMP_LIMB_SHIFT   2\n# define GMP_LIMB_BYTES   4\n# define GMP_LIMB_BITS    32\n# define INT_MINBOUND     -0x80000000\n# define INT_MAXBOUND      0x7fffffff\n# define ABS_INT_MINBOUND  0x80000000\n# define SQRT_INT_MAXBOUND 0xb504\n#else\n# error unsupported WORD_SIZE_IN_BITS config\n#endif\n\n-- | Type representing /raw/ arbitrary-precision Naturals\n--\n-- This is common type used by 'Natural' and 'Integer'.  As this type\n-- consists of a single constructor wrapping a 'ByteArray#' it can be\n-- unpacked.\n--\n-- Essential invariants:\n--\n--  - 'ByteArray#' size is an exact multiple of 'Word#' size\n--  - limbs are stored in least-significant-limb-first order,\n--  - the most-significant limb must be non-zero, except for\n--  - @0@ which is represented as a 1-limb.\ndata BigNat = BN# ByteArray#\n\ninstance Eq BigNat where\n    (==) = eqBigNat\n\ninstance Ord BigNat where\n    compare = compareBigNat\n\n-- [Implementation notes]\n--\n-- Invariant: 'Jn#' and 'Jp#' are used iff value doesn't fit in 'S#'\n--\n-- Useful properties resulting from the invariants:\n--\n--  - @abs ('S#' _) <= abs ('Jp#' _)@\n--  - @abs ('S#' _) <  abs ('Jn#' _)@\n\n-- | Arbitrary precision integers. For more information about this datatype,\n-- see the comments in its implementation.\ndata Integer  = S#                !Int#\n                -- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range\n              | Jp# {-# UNPACK #-} !BigNat\n                -- ^ iff value in @]maxBound::'Int', +inf[@ range\n              | Jn# {-# UNPACK #-} !BigNat\n                -- ^ iff value in @]-inf, minBound::'Int'[@ range\n\n-- NOTE: the above representation is baked into the GHCi debugger in\n-- compiler/ghci/RtClosureInspect.hs. If you change it here, fixes\n-- will be required over there too. Tests for this are in\n-- testsuite/tests/ghci.debugger.\n\n-- TODO: experiment with different constructor-ordering\n\ninstance Eq Integer where\n    (==)    = eqInteger\n    (/=)    = neqInteger\n\ninstance Ord Integer where\n    compare = compareInteger\n    (>)     = gtInteger\n    (>=)    = geInteger\n    (<)     = ltInteger\n    (<=)    = leInteger\n\n----------------------------------------------------------------------------\n\n-- | Construct 'Integer' value from list of 'Int's.\n--\n-- This function is used by GHC for constructing 'Integer' literals.\nmkInteger :: Bool   -- ^ sign of integer ('True' if non-negative)\n          -> [Int]  -- ^ absolute value expressed in 31 bit chunks, least\n                    --   significant first (ideally these would be machine-word\n                    --   'Word's rather than 31-bit truncated 'Int's)\n          -> Integer\nmkInteger nonNegative is\n  | nonNegative = f is\n  | True        = negateInteger (f is)\n  where\n    f [] = S# 0#\n    f (I# i : is') = smallInteger (i `andI#` 0x7fffffff#) `orInteger`\n                         shiftLInteger (f is') 31#\n{-# CONSTANT_FOLDED mkInteger #-}\n\n-- | Test whether all internal invariants are satisfied by 'Integer' value\n--\n-- Returns @1#@ if valid, @0#@ otherwise.\n--\n-- This operation is mostly useful for test-suites and/or code which\n-- constructs 'Integer' values directly.\nisValidInteger# :: Integer -> Int#\nisValidInteger# (S#  _) = 1#\nisValidInteger# (Jp# bn)\n    = isValidBigNat# bn `andI#` (bn `gtBigNatWord#` INT_MAXBOUND##)\nisValidInteger# (Jn# bn)\n    = isValidBigNat# bn `andI#` (bn `gtBigNatWord#` ABS_INT_MINBOUND##)\n\n-- | Should rather be called @intToInteger@\nsmallInteger :: Int# -> Integer\nsmallInteger i# = S# i#\n{-# CONSTANT_FOLDED smallInteger #-}\n\n----------------------------------------------------------------------------\n-- Int64/Word64 specific primitives\n\n#if WORD_SIZE_IN_BITS < 64\nint64ToInteger :: Int64# -> Integer\nint64ToInteger i\n  | isTrue# (i `leInt64#` intToInt64#  0x7FFFFFFF#)\n  , isTrue# (i `geInt64#` intToInt64# -0x80000000#)\n    = S# (int64ToInt# i)\n  | isTrue# (i `geInt64#` intToInt64# 0#)\n    = Jp# (word64ToBigNat (int64ToWord64# i))\n  | True\n    = Jn# (word64ToBigNat (int64ToWord64# (negateInt64# i)))\n{-# CONSTANT_FOLDED int64ToInteger #-}\n\nword64ToInteger :: Word64# -> Integer\nword64ToInteger w\n  | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##)\n    = S# (int64ToInt# (word64ToInt64# w))\n  | True\n    = Jp# (word64ToBigNat w)\n{-# CONSTANT_FOLDED word64ToInteger #-}\n\nintegerToInt64 :: Integer -> Int64#\nintegerToInt64 (S# i#)  = intToInt64# i#\nintegerToInt64 (Jp# bn) = word64ToInt64# (bigNatToWord64 bn)\nintegerToInt64 (Jn# bn) = negateInt64# (word64ToInt64# (bigNatToWord64 bn))\n{-# CONSTANT_FOLDED integerToInt64 #-}\n\nintegerToWord64 :: Integer -> Word64#\nintegerToWord64 (S# i#)  = int64ToWord64# (intToInt64# i#)\nintegerToWord64 (Jp# bn) = bigNatToWord64 bn\nintegerToWord64 (Jn# bn)\n    = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64 bn)))\n{-# CONSTANT_FOLDED integerToWord64 #-}\n\n#if GMP_LIMB_BITS == 32\nword64ToBigNat :: Word64# -> BigNat\nword64ToBigNat w64 = wordToBigNat2 wh# wl#\n  where\n    wh# = word64ToWord# (uncheckedShiftRL64# w64 32#)\n    wl# = word64ToWord# w64\n\nbigNatToWord64 :: BigNat -> Word64#\nbigNatToWord64 bn\n  | isTrue# (sizeofBigNat# bn ># 1#)\n    = let wh# = wordToWord64# (indexBigNat# bn 1#)\n      in uncheckedShiftL64# wh# 32# `or64#` wl#\n  | True = wl#\n  where\n    wl# = wordToWord64# (bigNatToWord bn)\n#endif\n#endif\n\n-- End of Int64/Word64 specific primitives\n----------------------------------------------------------------------------\n\n-- | Truncates 'Integer' to least-significant 'Int#'\nintegerToInt :: Integer -> Int#\nintegerToInt (S# i#)  = i#\nintegerToInt (Jp# bn) = bigNatToInt bn\nintegerToInt (Jn# bn) = negateInt# (bigNatToInt bn)\n{-# CONSTANT_FOLDED integerToInt #-}\n\nhashInteger :: Integer -> Int#\nhashInteger = integerToInt -- emulating what integer-{simple,gmp} already do\n\nintegerToWord :: Integer -> Word#\nintegerToWord (S# i#)  = int2Word# i#\nintegerToWord (Jp# bn) = bigNatToWord bn\nintegerToWord (Jn# bn) = int2Word# (negateInt# (bigNatToInt bn))\n{-# CONSTANT_FOLDED integerToWord #-}\n\nwordToInteger :: Word# -> Integer\nwordToInteger w#\n  | isTrue# (i# >=# 0#) = S# i#\n  | True                = Jp# (wordToBigNat w#)\n  where\n    i# = word2Int# w#\n{-# CONSTANT_FOLDED wordToInteger #-}\n\nwordToNegInteger :: Word# -> Integer\nwordToNegInteger w#\n  | isTrue# (i# <=# 0#) = S# i#\n  | True                = Jn# (wordToBigNat w#)\n  where\n    i# = negateInt# (word2Int# w#)\n\n-- we could almost auto-derive Ord if it wasn't for the Jn#-Jn# case\ncompareInteger :: Integer -> Integer -> Ordering\ncompareInteger (Jn# x)  (Jn# y) = compareBigNat y x\ncompareInteger (S#  x)  (S#  y) = compareInt#   x y\ncompareInteger (Jp# x)  (Jp# y) = compareBigNat x y\ncompareInteger (Jn# _)  _       = LT\ncompareInteger (S#  _)  (Jp# _) = LT\ncompareInteger (S#  _)  (Jn# _) = GT\ncompareInteger (Jp# _)  _       = GT\n{-# CONSTANT_FOLDED compareInteger #-}\n\nisNegInteger# :: Integer -> Int#\nisNegInteger# (S# i#) = i# <# 0#\nisNegInteger# (Jp# _)  = 0#\nisNegInteger# (Jn# _)  = 1#\n\n-- | Not-equal predicate.\nneqInteger :: Integer -> Integer -> Bool\nneqInteger x y = isTrue# (neqInteger# x y)\n\neqInteger, leInteger, ltInteger, gtInteger, geInteger\n  :: Integer -> Integer -> Bool\neqInteger  x y = isTrue# (eqInteger#  x y)\nleInteger  x y = isTrue# (leInteger#  x y)\nltInteger  x y = isTrue# (ltInteger#  x y)\ngtInteger  x y = isTrue# (gtInteger#  x y)\ngeInteger  x y = isTrue# (geInteger#  x y)\n\neqInteger#, neqInteger#, leInteger#, ltInteger#, gtInteger#, geInteger#\n  :: Integer -> Integer -> Int#\neqInteger# (S# x#) (S# y#)   = x# ==# y#\neqInteger# (Jn# x) (Jn# y)   = eqBigNat# x y\neqInteger# (Jp# x) (Jp# y)   = eqBigNat# x y\neqInteger# _       _         = 0#\n{-# CONSTANT_FOLDED eqInteger# #-}\n\nneqInteger# (S# x#) (S# y#)  = x# /=# y#\nneqInteger# (Jn# x) (Jn# y)  = neqBigNat# x y\nneqInteger# (Jp# x) (Jp# y)  = neqBigNat# x y\nneqInteger# _       _        = 1#\n{-# CONSTANT_FOLDED neqInteger# #-}\n\n\ngtInteger# (S# x#) (S# y#)   = x# ># y#\ngtInteger# x y | inline compareInteger x y == GT  = 1#\ngtInteger# _ _                                    = 0#\n{-# CONSTANT_FOLDED gtInteger# #-}\n\nleInteger# (S# x#) (S# y#)   = x# <=# y#\nleInteger# x y | inline compareInteger x y /= GT  = 1#\nleInteger# _ _                             = 0#\n{-# CONSTANT_FOLDED leInteger# #-}\n\nltInteger# (S# x#) (S# y#)   = x# <# y#\nltInteger# x y | inline compareInteger x y == LT  = 1#\nltInteger# _ _                             = 0#\n{-# CONSTANT_FOLDED ltInteger# #-}\n\ngeInteger# (S# x#) (S# y#)   = x# >=# y#\ngeInteger# x y | inline compareInteger x y /= LT  = 1#\ngeInteger# _ _                             = 0#\n{-# CONSTANT_FOLDED geInteger# #-}\n\n-- | Compute absolute value of an 'Integer'\nabsInteger :: Integer -> Integer\nabsInteger (Jn# n)                       = Jp# n\nabsInteger (S# INT_MINBOUND#)            = Jp# (wordToBigNat ABS_INT_MINBOUND##)\nabsInteger (S# i#) | isTrue# (i# <# 0#)  = S# (negateInt# i#)\nabsInteger i@(S# _)                      = i\nabsInteger i@(Jp# _)                     = i\n{-# CONSTANT_FOLDED absInteger #-}\n\n-- | Return @-1@, @0@, and @1@ depending on whether argument is\n-- negative, zero, or positive, respectively\nsignumInteger :: Integer -> Integer\nsignumInteger j = S# (signumInteger# j)\n{-# CONSTANT_FOLDED signumInteger #-}\n\n-- | Return @-1#@, @0#@, and @1#@ depending on whether argument is\n-- negative, zero, or positive, respectively\nsignumInteger# :: Integer -> Int#\nsignumInteger# (Jn# _)  = -1#\nsignumInteger# (S# i#) = sgnI# i#\nsignumInteger# (Jp# _ ) =  1#\n\n-- | Negate 'Integer'\nnegateInteger :: Integer -> Integer\nnegateInteger (Jn# n)      = Jp# n\nnegateInteger (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##)\nnegateInteger (S# i#)             = S# (negateInt# i#)\nnegateInteger (Jp# bn)\n  | isTrue# (eqBigNatWord# bn ABS_INT_MINBOUND##) = S# INT_MINBOUND#\n  | True                                        = Jn# bn\n{-# CONSTANT_FOLDED negateInteger #-}\n\n-- one edge-case issue to take into account is that Int's range is not\n-- symmetric around 0.  I.e. @minBound+maxBound = -1@\n--\n-- Jp# is used iff n > maxBound::Int\n-- Jn# is used iff n < minBound::Int\n\n-- | Add two 'Integer's\nplusInteger :: Integer -> Integer -> Integer\nplusInteger x    (S# 0#)  = x\nplusInteger (S# 0#) y     = y\nplusInteger (S# x#) (S# y#)\n  = case addIntC# x# y# of\n    (# z#, 0# #) -> S# z#\n    (# 0#, _  #) -> Jn# (wordToBigNat2 1## 0##) -- 2*minBound::Int\n    (# z#, _  #)\n      | isTrue# (z# ># 0#) -> Jn# (wordToBigNat ( (int2Word# (negateInt# z#))))\n      | True               -> Jp# (wordToBigNat ( (int2Word# z#)))\nplusInteger y@(S# _) x = plusInteger x y\n-- no S# as first arg from here on\nplusInteger (Jp# x) (Jp# y) = Jp# (plusBigNat x y)\nplusInteger (Jn# x) (Jn# y) = Jn# (plusBigNat x y)\nplusInteger (Jp# x) (S# y#) -- edge-case: @(maxBound+1) + minBound == 0@\n  | isTrue# (y# >=# 0#) = Jp# (plusBigNatWord x (int2Word# y#))\n  | True                = bigNatToInteger (minusBigNatWord x (int2Word#\n                                                              (negateInt# y#)))\nplusInteger (Jn# x) (S# y#) -- edge-case: @(minBound-1) + maxBound == -2@\n  | isTrue# (y# >=# 0#) = bigNatToNegInteger (minusBigNatWord x (int2Word# y#))\n  | True                = Jn# (plusBigNatWord x (int2Word# (negateInt# y#)))\nplusInteger y@(Jn# _) x@(Jp# _) = plusInteger x y\nplusInteger (Jp# x) (Jn# y)\n    = case compareBigNat x y of\n      LT -> bigNatToNegInteger (minusBigNat y x)\n      EQ -> S# 0#\n      GT -> bigNatToInteger (minusBigNat x y)\n{-# CONSTANT_FOLDED plusInteger #-}\n\n-- | Subtract one 'Integer' from another.\nminusInteger :: Integer -> Integer -> Integer\nminusInteger x       (S# 0#)            = x\nminusInteger (S# x#) (S# y#)\n  = case subIntC# x# y# of\n    (# z#, 0# #) -> S# z#\n    (# 0#, _  #) -> Jn# (wordToBigNat2 1## 0##)\n    (# z#, _  #)\n      | isTrue# (z# ># 0#) -> Jn# (wordToBigNat ( (int2Word# (negateInt# z#))))\n      | True               -> Jp# (wordToBigNat ( (int2Word# z#)))\nminusInteger (S# x#) (Jp# y)\n  | isTrue# (x# >=# 0#) = bigNatToNegInteger (minusBigNatWord y (int2Word# x#))\n  | True                = Jn# (plusBigNatWord y (int2Word# (negateInt# x#)))\nminusInteger (S# x#) (Jn# y)\n  | isTrue# (x# >=# 0#) = Jp# (plusBigNatWord y (int2Word# x#))\n  | True                = bigNatToInteger (minusBigNatWord y (int2Word#\n                                                              (negateInt# x#)))\nminusInteger (Jp# x) (Jp# y)\n    = case compareBigNat x y of\n      LT -> bigNatToNegInteger (minusBigNat y x)\n      EQ -> S# 0#\n      GT -> bigNatToInteger (minusBigNat x y)\nminusInteger (Jp# x) (Jn# y) = Jp# (plusBigNat x y)\nminusInteger (Jn# x) (Jp# y) = Jn# (plusBigNat x y)\nminusInteger (Jn# x) (Jn# y)\n    = case compareBigNat x y of\n      LT -> bigNatToInteger (minusBigNat y x)\n      EQ -> S# 0#\n      GT -> bigNatToNegInteger (minusBigNat x y)\nminusInteger (Jp# x) (S# y#)\n  | isTrue# (y# >=# 0#) = bigNatToInteger (minusBigNatWord x (int2Word# y#))\n  | True                = Jp# (plusBigNatWord x (int2Word# (negateInt# y#)))\nminusInteger (Jn# x) (S# y#)\n  | isTrue# (y# >=# 0#) = Jn# (plusBigNatWord x (int2Word# y#))\n  | True                = bigNatToNegInteger (minusBigNatWord x\n                                              (int2Word# (negateInt# y#)))\n{-# CONSTANT_FOLDED minusInteger #-}\n\n-- | Multiply two 'Integer's\ntimesInteger :: Integer -> Integer -> Integer\ntimesInteger !_      (S# 0#) = S# 0#\ntimesInteger (S# 0#) _       = S# 0#\ntimesInteger x       (S# 1#) = x\ntimesInteger (S# 1#) y       = y\ntimesInteger x      (S# -1#) = negateInteger x\ntimesInteger (S# -1#) y      = negateInteger y\ntimesInteger (S# x#) (S# y#)\n  = case mulIntMayOflo# x# y# of\n    0# -> S# (x# *# y#)\n    _  -> timesInt2Integer x# y#\ntimesInteger x@(S# _) y      = timesInteger y x\n-- no S# as first arg from here on\ntimesInteger (Jp# x) (Jp# y) = Jp# (timesBigNat x y)\ntimesInteger (Jp# x) (Jn# y) = Jn# (timesBigNat x y)\ntimesInteger (Jp# x) (S# y#)\n  | isTrue# (y# >=# 0#) = Jp# (timesBigNatWord x (int2Word# y#))\n  | True       = Jn# (timesBigNatWord x (int2Word# (negateInt# y#)))\ntimesInteger (Jn# x) (Jn# y) = Jp# (timesBigNat x y)\ntimesInteger (Jn# x) (Jp# y) = Jn# (timesBigNat x y)\ntimesInteger (Jn# x) (S# y#)\n  | isTrue# (y# >=# 0#) = Jn# (timesBigNatWord x (int2Word# y#))\n  | True       = Jp# (timesBigNatWord x (int2Word# (negateInt# y#)))\n{-# CONSTANT_FOLDED timesInteger #-}\n\n-- | Square 'Integer'\nsqrInteger :: Integer -> Integer\nsqrInteger (S# INT_MINBOUND#) = timesInt2Integer INT_MINBOUND# INT_MINBOUND#\nsqrInteger (S# j#) | isTrue# (absI# j# <=# SQRT_INT_MAXBOUND#) = S# (j# *# j#)\nsqrInteger (S# j#) = timesInt2Integer j# j#\nsqrInteger (Jp# bn) = Jp# (sqrBigNat bn)\nsqrInteger (Jn# bn) = Jp# (sqrBigNat bn)\n\n-- | Construct 'Integer' from the product of two 'Int#'s\ntimesInt2Integer :: Int# -> Int# -> Integer\ntimesInt2Integer x# y# = case (# isTrue# (x# >=# 0#), isTrue# (y# >=# 0#) #) of\n    (# False, False #) -> case timesWord2# (int2Word# (negateInt# x#))\n                                     (int2Word# (negateInt# y#)) of\n        (# 0##,l #) -> inline wordToInteger l\n        (# h  ,l #) -> Jp# (wordToBigNat2 h l)\n\n    (#  True, False #) -> case timesWord2# (int2Word# x#)\n                                     (int2Word# (negateInt# y#)) of\n        (# 0##,l #) -> wordToNegInteger l\n        (# h  ,l #) -> Jn# (wordToBigNat2 h l)\n\n    (# False,  True #) -> case timesWord2# (int2Word# (negateInt# x#))\n                                     (int2Word# y#) of\n        (# 0##,l #) -> wordToNegInteger l\n        (# h  ,l #) -> Jn# (wordToBigNat2 h l)\n\n    (#  True,  True #) -> case timesWord2# (int2Word# x#)\n                                     (int2Word# y#) of\n        (# 0##,l #) -> inline wordToInteger l\n        (# h  ,l #) -> Jp# (wordToBigNat2 h l)\n\nbigNatToInteger :: BigNat -> Integer\nbigNatToInteger bn\n  | isTrue# ((sizeofBigNat# bn ==# 1#) `andI#` (i# >=# 0#)) = S# i#\n  | True                                                    = Jp# bn\n  where\n    i# = word2Int# (bigNatToWord bn)\n\nbigNatToNegInteger :: BigNat -> Integer\nbigNatToNegInteger bn\n  | isTrue# ((sizeofBigNat# bn ==# 1#) `andI#` (i# <=# 0#)) = S# i#\n  | True                                                    = Jn# bn\n  where\n    i# = negateInt# (word2Int# (bigNatToWord bn))\n\n-- | Count number of set bits. For negative arguments returns negative\n-- population count of negated argument.\npopCountInteger :: Integer -> Int#\npopCountInteger (S# i#)\n  | isTrue# (i# >=# 0#) = popCntI# i#\n  | True                = negateInt# (popCntI# (negateInt# i#))\npopCountInteger (Jp# bn)  = popCountBigNat bn\npopCountInteger (Jn# bn)  = negateInt# (popCountBigNat bn)\n{-# CONSTANT_FOLDED popCountInteger #-}\n\n-- | 'Integer' for which only /n/-th bit is set. Undefined behaviour\n-- for negative /n/ values.\nbitInteger :: Int# -> Integer\nbitInteger i#\n  | isTrue# (i# <# (GMP_LIMB_BITS# -# 1#)) = S# (uncheckedIShiftL# 1# i#)\n  | True = Jp# (bitBigNat i#)\n{-# CONSTANT_FOLDED bitInteger #-}\n\n-- | Test if /n/-th bit is set.\ntestBitInteger :: Integer -> Int# -> Bool\ntestBitInteger !_  n# | isTrue# (n# <# 0#) = False\ntestBitInteger (S# i#) n#\n  | isTrue# (n# <# GMP_LIMB_BITS#) = isTrue# (((uncheckedIShiftL# 1# n#)\n                                               `andI#` i#) /=# 0#)\n  | True                          = isTrue# (i# <# 0#)\ntestBitInteger (Jp# bn) n = testBitBigNat bn n\ntestBitInteger (Jn# bn) n = testBitNegBigNat bn n\n{-# CONSTANT_FOLDED testBitInteger #-}\n\n-- | Bitwise @NOT@ operation\ncomplementInteger :: Integer -> Integer\ncomplementInteger (S# i#) = S# (notI# i#)\ncomplementInteger (Jp# bn) = Jn# (plusBigNatWord  bn 1##)\ncomplementInteger (Jn# bn) = Jp# (minusBigNatWord bn 1##)\n{-# CONSTANT_FOLDED complementInteger #-}\n\n-- | Arithmetic shift-right operation\n--\n-- Even though the shift-amount is expressed as `Int#`, the result is\n-- undefined for negative shift-amounts.\nshiftRInteger :: Integer -> Int# -> Integer\nshiftRInteger x        0# = x\nshiftRInteger (S# i#)  n# = S# (iShiftRA# i# n#)\n  where\n    iShiftRA# a b\n      | isTrue# (b >=# WORD_SIZE_IN_BITS#) = (a <# 0#) *# (-1#)\n      | True                               = a `uncheckedIShiftRA#` b\nshiftRInteger (Jp# bn) n# = bigNatToInteger (shiftRBigNat bn n#)\nshiftRInteger (Jn# bn) n#\n    = case bigNatToNegInteger (shiftRNegBigNat bn n#) of\n        S# 0# -> S# -1#\n        r           -> r\n{-# CONSTANT_FOLDED shiftRInteger #-}\n\n-- | Shift-left operation\n--\n-- Even though the shift-amount is expressed as `Int#`, the result is\n-- undefined for negative shift-amounts.\nshiftLInteger :: Integer -> Int# -> Integer\nshiftLInteger x       0# = x\nshiftLInteger (S# 0#) _  = S# 0#\nshiftLInteger (S# 1#) n# = bitInteger n#\nshiftLInteger (S# i#) n#\n  | isTrue# (i# >=# 0#)  = bigNatToInteger (shiftLBigNat\n                                            (wordToBigNat (int2Word# i#)) n#)\n  | True                 = bigNatToNegInteger (shiftLBigNat\n                                               (wordToBigNat (int2Word#\n                                                              (negateInt# i#))) n#)\nshiftLInteger (Jp# bn) n# = Jp# (shiftLBigNat bn n#)\nshiftLInteger (Jn# bn) n# = Jn# (shiftLBigNat bn n#)\n{-# CONSTANT_FOLDED shiftLInteger #-}\n\n-- | Bitwise OR operation\norInteger :: Integer -> Integer -> Integer\n-- short-cuts\norInteger  (S# 0#)     y         = y\norInteger  x           (S# 0#)   = x\norInteger  (S# -1#)    _         = S# -1#\norInteger  _           (S# -1#)  = S# -1#\n-- base-cases\norInteger  (S# x#)     (S# y#)   = S# (orI# x# y#)\norInteger  (Jp# x)     (Jp# y)   = Jp# (orBigNat x y)\norInteger  (Jn# x)     (Jn# y)\n    = bigNatToNegInteger (plusBigNatWord (andBigNat\n                                          (minusBigNatWord x 1##)\n                                          (minusBigNatWord y 1##)) 1##)\norInteger  x@(Jn# _)   y@(Jp# _)  = orInteger y x -- retry with swapped args\norInteger  (Jp# x)     (Jn# y)\n    = bigNatToNegInteger (plusBigNatWord (andnBigNat (minusBigNatWord y 1##) x)\n                                         1##)\n-- TODO/FIXpromotion-hack\norInteger  x@(S# _)   y          = orInteger (unsafePromote x) y\norInteger  x           y {- S# -}= orInteger x (unsafePromote y)\n{-# CONSTANT_FOLDED orInteger #-}\n\n-- | Bitwise XOR operation\nxorInteger :: Integer -> Integer -> Integer\n-- short-cuts\nxorInteger (S# 0#)     y          = y\nxorInteger x           (S# 0#)    = x\n-- TODO: (S# -1) cases\n-- base-cases\nxorInteger (S# x#)     (S# y#)    = S# (xorI# x# y#)\nxorInteger (Jp# x)     (Jp# y)    = bigNatToInteger (xorBigNat x y)\nxorInteger (Jn# x)     (Jn# y)\n    = bigNatToInteger (xorBigNat (minusBigNatWord x 1##)\n                                 (minusBigNatWord y 1##))\nxorInteger x@(Jn# _)   y@(Jp# _)  = xorInteger y x -- retry with swapped args\nxorInteger (Jp# x)     (Jn# y)\n    = bigNatToNegInteger (plusBigNatWord (xorBigNat x (minusBigNatWord y 1##))\n                                         1##)\n-- TODO/FIXME promotion-hack\nxorInteger x@(S# _)    y          = xorInteger (unsafePromote x) y\nxorInteger x           y {- S# -} = xorInteger x (unsafePromote y)\n{-# CONSTANT_FOLDED xorInteger #-}\n\n-- | Bitwise AND operation\nandInteger :: Integer -> Integer -> Integer\n-- short-cuts\nandInteger (S# 0#)     !_        = S# 0#\nandInteger _           (S# 0#)   = S# 0#\nandInteger (S# -1#)   y          = y\nandInteger x           (S# -1#)  = x\n-- base-cases\nandInteger (S# x#)     (S# y#)   = S# (andI# x# y#)\nandInteger (Jp# x)     (Jp# y)   = bigNatToInteger (andBigNat x y)\nandInteger (Jn# x)     (Jn# y)\n    = bigNatToNegInteger (plusBigNatWord (orBigNat (minusBigNatWord x 1##)\n                                                   (minusBigNatWord y 1##)) 1##)\nandInteger x@(Jn# _)   y@(Jp# _)  = andInteger y x\nandInteger (Jp# x)     (Jn# y)\n    = bigNatToInteger (andnBigNat x (minusBigNatWord y 1##))\n-- TODO/FIXME promotion-hack\nandInteger x@(S# _)   y          = andInteger (unsafePromote x) y\nandInteger x           y {- S# -}= andInteger x (unsafePromote y)\n{-# CONSTANT_FOLDED andInteger #-}\n\n-- HACK warning! breaks invariant on purpose\nunsafePromote :: Integer -> Integer\nunsafePromote (S# x#)\n    | isTrue# (x# >=# 0#) = Jp# (wordToBigNat (int2Word# x#))\n    | True                = Jn# (wordToBigNat (int2Word# (negateInt# x#)))\nunsafePromote x = x\n\n-- | Simultaneous 'quotInteger' and 'remInteger'.\n--\n-- Divisor must be non-zero otherwise the GHC runtime will terminate\n-- with a division-by-zero fault.\nquotRemInteger :: Integer -> Integer -> (# Integer, Integer #)\nquotRemInteger n       (S# 1#) = (# n, S# 0# #)\nquotRemInteger n      (S# -1#) = let !q = negateInteger n in (# q, (S# 0#) #)\nquotRemInteger !_      (S# 0#) = (# S# (quotInt# 0# 0#),S# (remInt# 0# 0#) #)\nquotRemInteger (S# 0#) _       = (# S# 0#, S# 0# #)\nquotRemInteger (S# n#) (S# d#) = case quotRemInt# n# d# of\n    (# q#, r# #) -> (# S# q#, S# r# #)\nquotRemInteger (Jp# n)  (Jp# d)  = case quotRemBigNat n d of\n    (# q, r #) -> (# bigNatToInteger q, bigNatToInteger r #)\nquotRemInteger (Jp# n)  (Jn# d)  = case quotRemBigNat n d of\n    (# q, r #) -> (# bigNatToNegInteger q, bigNatToInteger r #)\nquotRemInteger (Jn# n)  (Jn# d)  = case quotRemBigNat n d of\n    (# q, r #) -> (# bigNatToInteger q, bigNatToNegInteger r #)\nquotRemInteger (Jn# n)  (Jp# d)  = case quotRemBigNat n d of\n    (# q, r #) -> (# bigNatToNegInteger q, bigNatToNegInteger r #)\nquotRemInteger (Jp# n)  (S# d#)\n  | isTrue# (d# >=# 0#) = case quotRemBigNatWord n (int2Word# d#) of\n      (# q, r# #) -> (# bigNatToInteger q, inline wordToInteger r# #)\n  | True               = case quotRemBigNatWord n (int2Word# (negateInt# d#)) of\n      (# q, r# #) -> (# bigNatToNegInteger q, inline wordToInteger r# #)\nquotRemInteger (Jn# n)  (S# d#)\n  | isTrue# (d# >=# 0#) = case quotRemBigNatWord n (int2Word# d#) of\n      (# q, r# #) -> (# bigNatToNegInteger q, wordToNegInteger r# #)\n  | True               = case quotRemBigNatWord n (int2Word# (negateInt# d#)) of\n      (# q, r# #) -> (# bigNatToInteger q, wordToNegInteger r# #)\nquotRemInteger n@(S# _) (Jn# _) = (# S# 0#, n #) -- since @n < d@\nquotRemInteger n@(S# n#) (Jp# d) -- need to account for (S# minBound)\n    | isTrue# (n# ># 0#)                                    = (# S# 0#, n #)\n    | isTrue# (gtBigNatWord# d (int2Word# (negateInt# n#))) = (# S# 0#, n #)\n    | True {- abs(n) == d -}                          = (# S# -1#, S# 0# #)\n{-# CONSTANT_FOLDED quotRemInteger #-}\n\n\nquotInteger :: Integer -> Integer -> Integer\nquotInteger n       (S# 1#) = n\nquotInteger n      (S# -1#) = negateInteger n\nquotInteger !_      (S# 0#) = S# (quotInt# 0# 0#)\nquotInteger (S# 0#) _       = S# 0#\nquotInteger (S# n#)  (S# d#) = S# (quotInt# n# d#)\nquotInteger (Jp# n)   (S# d#)\n  | isTrue# (d# >=# 0#) = bigNatToInteger    (quotBigNatWord n (int2Word# d#))\n  | True                = bigNatToNegInteger (quotBigNatWord n\n                                              (int2Word# (negateInt# d#)))\nquotInteger (Jn# n)   (S# d#)\n  | isTrue# (d# >=# 0#) = bigNatToNegInteger (quotBigNatWord n (int2Word# d#))\n  | True                = bigNatToInteger    (quotBigNatWord n\n                                              (int2Word# (negateInt# d#)))\nquotInteger (Jp# n) (Jp# d) = bigNatToInteger    (quotBigNat n d)\nquotInteger (Jp# n) (Jn# d) = bigNatToNegInteger (quotBigNat n d)\nquotInteger (Jn# n) (Jp# d) = bigNatToNegInteger (quotBigNat n d)\nquotInteger (Jn# n) (Jn# d) = bigNatToInteger    (quotBigNat n d)\n-- handle remaining non-allocating cases\nquotInteger n d = case inline quotRemInteger n d of (# q, _ #) -> q\n{-# CONSTANT_FOLDED quotInteger #-}\n\nremInteger :: Integer -> Integer -> Integer\nremInteger !_       (S# 1#) = S# 0#\nremInteger _       (S# -1#) = S# 0#\nremInteger _        (S# 0#) = S# (remInt# 0# 0#)\nremInteger (S# 0#) _        = S# 0#\nremInteger (S# n#) (S# d#) = S# (remInt# n# d#)\nremInteger (Jp# n)  (S# d#)\n    = wordToInteger    (remBigNatWord n (int2Word# (absI# d#)))\nremInteger (Jn# n)  (S# d#)\n    = wordToNegInteger (remBigNatWord n (int2Word# (absI# d#)))\nremInteger (Jp# n)  (Jp# d)  = bigNatToInteger    (remBigNat n d)\nremInteger (Jp# n)  (Jn# d)  = bigNatToInteger    (remBigNat n d)\nremInteger (Jn# n)  (Jp# d)  = bigNatToNegInteger (remBigNat n d)\nremInteger (Jn# n)  (Jn# d)  = bigNatToNegInteger (remBigNat n d)\n-- handle remaining non-allocating cases\nremInteger n d = case inline quotRemInteger n d of (# _, r #) -> r\n{-# CONSTANT_FOLDED remInteger #-}\n\n-- | Simultaneous 'divInteger' and 'modInteger'.\n--\n-- Divisor must be non-zero otherwise the GHC runtime will terminate\n-- with a division-by-zero fault.\ndivModInteger :: Integer -> Integer -> (# Integer, Integer #)\ndivModInteger n d\n  | isTrue# (signumInteger# r ==# negateInt# (signumInteger# d))\n     = let !q' = plusInteger q (S# -1#) -- TODO: optimize\n           !r' = plusInteger r d\n       in (# q', r' #)\n  | True = qr\n  where\n    !qr@(# q, r #) = quotRemInteger n d\n{-# CONSTANT_FOLDED divModInteger #-}\n\ndivInteger :: Integer -> Integer -> Integer\n-- same-sign ops can be handled by more efficient 'quotInteger'\ndivInteger n d | isTrue# (isNegInteger# n ==# isNegInteger# d) = quotInteger n d\ndivInteger n d = case inline divModInteger n d of (# q, _ #) -> q\n{-# CONSTANT_FOLDED divInteger #-}\n\nmodInteger :: Integer -> Integer -> Integer\n-- same-sign ops can be handled by more efficient 'remInteger'\nmodInteger n d | isTrue# (isNegInteger# n ==# isNegInteger# d) = remInteger n d\nmodInteger n d = case inline divModInteger n d of (# _, r #) -> r\n{-# CONSTANT_FOLDED modInteger #-}\n\n-- | Compute greatest common divisor.\ngcdInteger :: Integer -> Integer -> Integer\ngcdInteger (S# 0#)        b = absInteger b\ngcdInteger a        (S# 0#) = absInteger a\ngcdInteger (S# 1#)        _ = S# 1#\ngcdInteger (S# -1#)       _ = S# 1#\ngcdInteger _        (S# 1#) = S# 1#\ngcdInteger _       (S# -1#) = S# 1#\ngcdInteger (S# a#) (S# b#)\n    = wordToInteger (gcdWord# (int2Word# (absI# a#)) (int2Word# (absI# b#)))\ngcdInteger a@(S# _) b = gcdInteger b a\ngcdInteger (Jn# a) b = gcdInteger (Jp# a) b\ngcdInteger (Jp# a) (Jp# b) = bigNatToInteger (gcdBigNat a b)\ngcdInteger (Jp# a) (Jn# b) = bigNatToInteger (gcdBigNat a b)\ngcdInteger (Jp# a) (S# b#)\n    = wordToInteger (gcdBigNatWord a (int2Word# (absI# b#)))\n{-# CONSTANT_FOLDED gcdInteger #-}\n\n-- | Compute least common multiple.\nlcmInteger :: Integer -> Integer -> Integer\nlcmInteger (S# 0#) !_  = S# 0#\nlcmInteger (S# 1#)  b  = absInteger b\nlcmInteger (S# -1#) b  = absInteger b\nlcmInteger _ (S# 0#)   = S# 0#\nlcmInteger a (S# 1#)   = absInteger a\nlcmInteger a (S# -1#)  = absInteger a\nlcmInteger a b = (aa `quotInteger` (aa `gcdInteger` ab)) `timesInteger` ab\n  where\n    aa = absInteger a\n    ab = absInteger b\n{-# CONSTANT_FOLDED lcmInteger #-}\n\n-- | Compute greatest common divisor.\n--\n-- __Warning__: result may become negative if (at least) one argument\n-- is 'minBound'\ngcdInt :: Int# -> Int# -> Int#\ngcdInt x# y#\n    = word2Int# (gcdWord# (int2Word# (absI# x#)) (int2Word# (absI# y#)))\n\n-- | Compute greatest common divisor.\n--\n-- @since 1.0.0.0\ngcdWord :: Word# -> Word# -> Word#\ngcdWord = gcdWord#\n\n----------------------------------------------------------------------------\n-- BigNat operations\n\ncompareBigNat :: BigNat -> BigNat -> Ordering\ncompareBigNat x@(BN# x#) y@(BN# y#)\n  | isTrue# (nx# ==# ny#)\n      = compareInt# (narrowCInt# (c_mpn_cmp x# y# nx#)) 0#\n  | isTrue# (nx# <#  ny#) = LT\n  | True                  = GT\n  where\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\ncompareBigNatWord :: BigNat -> GmpLimb# -> Ordering\ncompareBigNatWord bn w#\n  | isTrue# (sizeofBigNat# bn ==# 1#) = cmpW# (bigNatToWord bn) w#\n  | True                              = GT\n\ngtBigNatWord# :: BigNat -> GmpLimb# -> Int#\ngtBigNatWord# bn w#\n    = (sizeofBigNat# bn ># 1#) `orI#` (bigNatToWord bn `gtWord#` w#)\n\neqBigNat :: BigNat -> BigNat -> Bool\neqBigNat x y = isTrue# (eqBigNat# x y)\n\neqBigNat# :: BigNat -> BigNat -> Int#\neqBigNat# x@(BN# x#) y@(BN# y#)\n  | isTrue# (nx# ==# ny#) = c_mpn_cmp x# y# nx# ==# 0#\n  | True                  = 0#\n  where\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\nneqBigNat# :: BigNat -> BigNat -> Int#\nneqBigNat# x@(BN# x#) y@(BN# y#)\n  | isTrue# (nx# ==# ny#) = c_mpn_cmp x# y# nx# /=# 0#\n  | True                  = 1#\n  where\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\neqBigNatWord :: BigNat -> GmpLimb# -> Bool\neqBigNatWord bn w# = isTrue# (eqBigNatWord# bn w#)\n\neqBigNatWord# :: BigNat -> GmpLimb# -> Int#\neqBigNatWord# bn w#\n    = (sizeofBigNat# bn ==# 1#) `andI#` (bigNatToWord bn `eqWord#` w#)\n\n\n-- | Same as @'indexBigNat#' bn 0\\#@\nbigNatToWord :: BigNat -> Word#\nbigNatToWord bn = indexBigNat# bn 0#\n\n-- | Equivalent to @'word2Int#' . 'bigNatToWord'@\nbigNatToInt :: BigNat -> Int#\nbigNatToInt (BN# ba#) = indexIntArray# ba# 0#\n\n-- | CAF representing the value @0 :: BigNat@\nzeroBigNat :: BigNat\nzeroBigNat = runS $ do\n    mbn <- newBigNat# 1#\n    _ <- svoid (writeBigNat# mbn 0# 0##)\n    unsafeFreezeBigNat# mbn\n{-# NOINLINE zeroBigNat #-}\n\n-- | Test if 'BigNat' value is equal to zero.\nisZeroBigNat :: BigNat -> Bool\nisZeroBigNat bn = eqBigNatWord bn 0##\n\n-- | CAF representing the value @1 :: BigNat@\noneBigNat :: BigNat\noneBigNat = runS $ do\n    mbn <- newBigNat# 1#\n    _ <- svoid (writeBigNat# mbn 0# 1##)\n    unsafeFreezeBigNat# mbn\n{-# NOINLINE oneBigNat #-}\n\nczeroBigNat :: BigNat\nczeroBigNat = runS $ do\n    mbn <- newBigNat# 1#\n    _ <- svoid (writeBigNat# mbn 0# (not# 0##))\n    unsafeFreezeBigNat# mbn\n{-# NOINLINE czeroBigNat #-}\n\n-- | Special 0-sized bigNat returned in case of arithmetic underflow\n--\n-- This is currently only returned by the following operations:\n--\n--  - 'minusBigNat'\n--  - 'minusBigNatWord'\n--\n-- Other operations such as 'quotBigNat' may return 'nullBigNat' as\n-- well as a dummy/place-holder value instead of 'undefined' since we\n-- can't throw exceptions. But that behaviour should not be relied\n-- upon.\n--\n-- NB: @isValidBigNat# nullBigNat@ is false\nnullBigNat :: BigNat\nnullBigNat = runS (newBigNat# 0# >>= unsafeFreezeBigNat#)\n{-# NOINLINE nullBigNat #-}\n\n-- | Test for special 0-sized 'BigNat' representing underflows.\nisNullBigNat# :: BigNat -> Int#\nisNullBigNat# (BN# ba#) = sizeofByteArray# ba# ==# 0#\n\n-- | Construct 1-limb 'BigNat' from 'Word#'\nwordToBigNat :: Word# -> BigNat\nwordToBigNat 0## = zeroBigNat\nwordToBigNat 1## = oneBigNat\nwordToBigNat w#\n  | isTrue# (not# w# `eqWord#` 0##) = czeroBigNat\n  | True = runS $ do\n    mbn <- newBigNat# 1#\n    _ <- svoid (writeBigNat# mbn 0# w#)\n    unsafeFreezeBigNat# mbn\n\n-- | Construct BigNat from 2 limbs.\n-- The first argument is the most-significant limb.\nwordToBigNat2 :: Word# -> Word# -> BigNat\nwordToBigNat2 0## lw# = wordToBigNat lw#\nwordToBigNat2 hw# lw# = runS $ do\n    mbn <- newBigNat# 2#\n    _ <- svoid (writeBigNat# mbn 0# lw#)\n    _ <- svoid (writeBigNat# mbn 1# hw#)\n    unsafeFreezeBigNat# mbn\n\nplusBigNat :: BigNat -> BigNat -> BigNat\nplusBigNat x y\n  | isTrue# (eqBigNatWord# x 0##) = y\n  | isTrue# (eqBigNatWord# y 0##) = x\n  | isTrue# (nx# >=# ny#) = go x nx# y ny#\n  | True                  = go y ny# x nx#\n  where\n    go (BN# a#) na# (BN# b#) nb# = runS $ do\n        mbn@(MBN# mba#) <- newBigNat# na#\n        (W# c#) <- liftIO (c_mpn_add mba# a# na# b# nb#)\n        case c# of\n              0## -> unsafeFreezeBigNat# mbn\n              _   -> unsafeSnocFreezeBigNat# mbn c#\n\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\nplusBigNatWord :: BigNat -> GmpLimb# -> BigNat\nplusBigNatWord x          0## = x\nplusBigNatWord x@(BN# x#) y# = runS $ do\n    mbn@(MBN# mba#) <- newBigNat# nx#\n    (W# c#) <- liftIO (c_mpn_add_1 mba# x# nx# y#)\n    case c# of\n        0## -> unsafeFreezeBigNat# mbn\n        _   -> unsafeSnocFreezeBigNat# mbn c#\n  where\n    nx# = sizeofBigNat# x\n\n-- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow\nminusBigNat :: BigNat -> BigNat -> BigNat\nminusBigNat x@(BN# x#) y@(BN# y#)\n  | isZeroBigNat y = x\n  | isTrue# (nx# >=# ny#) = runS $ do\n    mbn@(MBN# mba#) <- newBigNat# nx#\n    (W# b#) <- liftIO (c_mpn_sub mba# x# nx# y# ny#)\n    case b# of\n        0## -> unsafeRenormFreezeBigNat# mbn\n        _   -> return nullBigNat\n\n  | True = nullBigNat\n  where\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\n-- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow\nminusBigNatWord :: BigNat -> GmpLimb# -> BigNat\nminusBigNatWord x 0## = x\nminusBigNatWord x@(BN# x#) y# = runS $ do\n    mbn@(MBN# mba#) <- newBigNat# nx#\n    (W# b#) <- liftIO $ c_mpn_sub_1 mba# x# nx# y#\n    case b# of\n        0## -> unsafeRenormFreezeBigNat# mbn\n        _   -> return nullBigNat\n  where\n    nx# = sizeofBigNat# x\n\n\ntimesBigNat :: BigNat -> BigNat -> BigNat\ntimesBigNat x y\n  | isZeroBigNat x = zeroBigNat\n  | isZeroBigNat y = zeroBigNat\n  | isTrue# (nx# >=# ny#) = go x nx# y ny#\n  | True                  = go y ny# x nx#\n  where\n    go (BN# a#) na# (BN# b#) nb# = runS $ do\n        let n# = nx# +# ny#\n        mbn@(MBN# mba#) <- newBigNat# n#\n        (W# msl#) <- liftIO (c_mpn_mul mba# a# na# b# nb#)\n        case msl# of\n              0## -> unsafeShrinkFreezeBigNat# mbn (n# -# 1#)\n              _   -> unsafeFreezeBigNat# mbn\n\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\n-- | Square 'BigNat'\nsqrBigNat :: BigNat -> BigNat\nsqrBigNat x\n  | isZeroBigNat x = zeroBigNat\n  -- TODO: 1-limb BigNats below sqrt(maxBound::GmpLimb)\nsqrBigNat x = timesBigNat x x -- TODO: mpn_sqr\n\ntimesBigNatWord :: BigNat -> GmpLimb# -> BigNat\ntimesBigNatWord !_ 0## = zeroBigNat\ntimesBigNatWord x 1## = x\ntimesBigNatWord x@(BN# x#) y#\n  | isTrue# (nx# ==# 1#) =\n      let !(# !h#, !l# #) = timesWord2# (bigNatToWord x) y#\n      in wordToBigNat2 h# l#\n  | True = runS $ do\n        mbn@(MBN# mba#) <- newBigNat# nx#\n        (W# msl#) <- liftIO (c_mpn_mul_1 mba# x# nx# y#)\n        case msl# of\n              0## -> unsafeFreezeBigNat# mbn\n              _   -> unsafeSnocFreezeBigNat# mbn msl#\n\n  where\n    nx# = sizeofBigNat# x\n\n-- | Specialised version of\n--\n-- > bitBigNat = shiftLBigNat (wordToBigNat 1##)\n--\n-- avoiding a few redundant allocations\nbitBigNat :: Int# -> BigNat\nbitBigNat i#\n  | isTrue# (i#  <#  0#) = zeroBigNat -- or maybe 'nullBigNat'?\n  | isTrue# (i# ==#  0#) = oneBigNat\n  | True = runS $ do\n      mbn@(MBN# mba#) <- newBigNat# (li# +# 1#)\n      -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'?\n      -- clear all limbs (except for the most-significant limb)\n      _ <- svoid (clearWordArray# mba# 0# li#)\n      -- set single bit in most-significant limb\n      _ <- svoid (writeBigNat# mbn li# (uncheckedShiftL# 1## bi#))\n      unsafeFreezeBigNat# mbn\n  where\n    !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#\n\ntestBitBigNat :: BigNat -> Int# -> Bool\ntestBitBigNat bn i#\n  | isTrue# (i#  <#  0#) = False\n  | isTrue# (li# <# nx#) = isTrue# (testBitWord# (indexBigNat# bn li#) bi#)\n  | True                 = False\n  where\n    !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#\n    nx# = sizeofBigNat# bn\n\ntestBitNegBigNat :: BigNat -> Int# -> Bool\ntestBitNegBigNat bn i#\n  | isTrue# (i#  <#  0#)  = False\n  | isTrue# (li# >=# nx#) = True\n  | allZ li# = isTrue# ((testBitWord#\n                         (indexBigNat# bn li# `minusWord#` 1##) bi#) ==# 0#)\n  | True     = isTrue# ((testBitWord# (indexBigNat# bn li#) bi#) ==# 0#)\n  where\n    !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#\n    nx# = sizeofBigNat# bn\n\n    allZ 0# = True\n    allZ j | isTrue# (indexBigNat# bn (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#)\n           | True                 = False\n\n\nclearBitBigNat :: BigNat -> Int# -> BigNat\nclearBitBigNat bn i#\n  | not (inline testBitBigNat bn i#) = bn\n  | isTrue# (nx# ==# 1#)        = wordToBigNat (bigNatToWord bn `xor#` bitWord# bi#)\n  | isTrue# (li# +# 1# ==# nx#) = -- special case, operating on most-sig limb\n      case indexBigNat# bn li# `xor#` bitWord# bi# of\n        0## -> do -- most-sig limb became zero -> result has less limbs\n            case fmssl bn (li# -# 1#) of\n              0# -> zeroBigNat\n              n# -> runS $ do\n                  mbn <- newBigNat# n#\n                  _ <- copyWordArray bn 0# mbn 0# n#\n                  unsafeFreezeBigNat# mbn\n        newlimb# -> runS $ do -- no shrinking\n            mbn <- newBigNat# nx#\n            _ <- copyWordArray bn 0# mbn 0# li#\n            _ <- svoid (writeBigNat# mbn li# newlimb#)\n            unsafeFreezeBigNat# mbn\n\n  | True = runS $ do\n        mbn <- newBigNat# nx#\n        _ <- copyWordArray bn 0# mbn 0# nx#\n        let newlimb# = indexBigNat# bn li# `xor#` bitWord# bi#\n        _ <- svoid (writeBigNat# mbn li# newlimb#)\n        unsafeFreezeBigNat# mbn\n\n  where\n    !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#\n    nx# = sizeofBigNat# bn\n\n\n\nsetBitBigNat :: BigNat -> Int# -> BigNat\nsetBitBigNat bn i#\n  | inline testBitBigNat bn i# = bn\n  | isTrue# (d# ># 0#) = runS $ do -- result BigNat will have more limbs\n        mbn@(MBN# mba#) <- newBigNat# (li# +# 1#)\n        _ <- copyWordArray bn 0# mbn 0# nx#\n        _ <- svoid (clearWordArray# mba# nx# (d# -# 1#))\n        _ <- svoid (writeBigNat# mbn li# (bitWord# bi#))\n        unsafeFreezeBigNat# mbn\n\n  | True = runS $ do\n        mbn <- newBigNat# nx#\n        _ <- copyWordArray bn 0# mbn 0# nx#\n        _ <- svoid (writeBigNat# mbn li# (indexBigNat# bn li#\n                                          `or#` bitWord# bi#))\n        unsafeFreezeBigNat# mbn\n\n  where\n    !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#\n    nx# = sizeofBigNat# bn\n    d# = li# +# 1# -# nx#\n\n\ncomplementBitBigNat :: BigNat -> Int# -> BigNat\ncomplementBitBigNat bn i#\n  | testBitBigNat bn i# = clearBitBigNat bn i#\n  | True                = setBitBigNat bn i#\n\npopCountBigNat :: BigNat -> Int#\npopCountBigNat bn@(BN# ba#) = word2Int# (c_mpn_popcount ba# (sizeofBigNat# bn))\n\n\nshiftLBigNat :: BigNat -> Int# -> BigNat\nshiftLBigNat x 0# = x\nshiftLBigNat x _ | isZeroBigNat x = zeroBigNat\nshiftLBigNat x@(BN# xba#) n# = runS $ do\n    ymbn@(MBN# ymba#) <- newBigNat# yn#\n    W# ymsl <- liftIO (c_mpn_lshift ymba# xba# xn# (int2Word# n#))\n    case ymsl of\n        0## -> unsafeShrinkFreezeBigNat# ymbn (yn# -# 1#)\n        _   -> unsafeFreezeBigNat# ymbn\n  where\n    xn# = sizeofBigNat# x\n    yn# = xn# +# nlimbs# +# (nbits# /=# 0#)\n    !(# nlimbs#, nbits# #) = quotRemInt# n# GMP_LIMB_BITS#\n\n\n\nshiftRBigNat :: BigNat -> Int# -> BigNat\nshiftRBigNat x 0# = x\nshiftRBigNat x _ | isZeroBigNat x = zeroBigNat\nshiftRBigNat x@(BN# xba#) n#\n  | isTrue# (nlimbs# >=# xn#) = zeroBigNat\n  | True = runS $ do\n      ymbn@(MBN# ymba#) <- newBigNat# yn#\n      W# ymsl <- liftIO (c_mpn_rshift ymba# xba# xn# (int2Word# n#))\n      case ymsl of\n          0## -> unsafeRenormFreezeBigNat# ymbn -- may shrink more than one\n          _   -> unsafeFreezeBigNat# ymbn\n  where\n    xn# = sizeofBigNat# x\n    yn# = xn# -# nlimbs#\n    nlimbs# = quotInt# n# GMP_LIMB_BITS#\n\nshiftRNegBigNat :: BigNat -> Int# -> BigNat\nshiftRNegBigNat x 0# = x\nshiftRNegBigNat x _ | isZeroBigNat x = zeroBigNat\nshiftRNegBigNat x@(BN# xba#) n#\n  | isTrue# (nlimbs# >=# xn#) = zeroBigNat\n  | True = runS $ do\n      ymbn@(MBN# ymba#) <- newBigNat# yn#\n      W# ymsl <- liftIO (c_mpn_rshift_2c ymba# xba# xn# (int2Word# n#))\n      case ymsl of\n          0## -> unsafeRenormFreezeBigNat# ymbn -- may shrink more than one\n          _   -> unsafeFreezeBigNat# ymbn\n  where\n    xn# = sizeofBigNat# x\n    yn# = xn# -# nlimbs#\n    nlimbs# = quotInt# (n# -# 1#) GMP_LIMB_BITS#\n\n\norBigNat :: BigNat -> BigNat -> BigNat\norBigNat x@(BN# x#) y@(BN# y#)\n  | isZeroBigNat x = y\n  | isZeroBigNat y = x\n  | isTrue# (nx# >=# ny#) = runS (ior' x# nx# y# ny#)\n  | True                  = runS (ior' y# ny# x# nx#)\n  where\n    ior' a# na# b# nb# = do -- na >= nb\n        mbn@(MBN# mba#) <- newBigNat# na#\n        _ <- liftIO (c_mpn_ior_n mba# a# b# nb#)\n        _ <- case isTrue# (na# ==# nb#) of\n            False -> svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))\n            True  -> return ()\n        unsafeFreezeBigNat# mbn\n\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\n\nxorBigNat :: BigNat -> BigNat -> BigNat\nxorBigNat x@(BN# x#) y@(BN# y#)\n  | isZeroBigNat x = y\n  | isZeroBigNat y = x\n  | isTrue# (nx# >=# ny#) = runS (xor' x# nx# y# ny#)\n  | True                  = runS (xor' y# ny# x# nx#)\n  where\n    xor' a# na# b# nb# = do -- na >= nb\n        mbn@(MBN# mba#) <- newBigNat# na#\n        _ <- liftIO (c_mpn_xor_n mba# a# b# nb#)\n        case isTrue# (na# ==# nb#) of\n            False -> do _ <- svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))\n                        unsafeFreezeBigNat# mbn\n            True  -> unsafeRenormFreezeBigNat# mbn\n\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\n-- | aka @\\x y -> x .&. (complement y)@\nandnBigNat :: BigNat -> BigNat -> BigNat\nandnBigNat x@(BN# x#) y@(BN# y#)\n  | isZeroBigNat x = zeroBigNat\n  | isZeroBigNat y = x\n  | True = runS $ do\n      mbn@(MBN# mba#) <- newBigNat# nx#\n      _ <- liftIO (c_mpn_andn_n mba# x# y# n#)\n      _ <- case isTrue# (nx# ==# n#) of\n            False -> svoid (copyWordArray# x# n# mba# n# (nx# -# n#))\n            True  -> return ()\n      unsafeRenormFreezeBigNat# mbn\n  where\n    n# | isTrue# (nx# <# ny#) = nx#\n       | True                 = ny#\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\n\nandBigNat :: BigNat -> BigNat -> BigNat\nandBigNat x@(BN# x#) y@(BN# y#)\n  | isZeroBigNat x = zeroBigNat\n  | isZeroBigNat y = zeroBigNat\n  | True = runS $ do\n      mbn@(MBN# mba#) <- newBigNat# n#\n      _ <- liftIO (c_mpn_and_n mba# x# y# n#)\n      unsafeRenormFreezeBigNat# mbn\n  where\n    n# | isTrue# (nx# <# ny#) = nx#\n       | True                 = ny#\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\n-- | If divisor is zero, @(\\# 'nullBigNat', 'nullBigNat' \\#)@ is returned\nquotRemBigNat :: BigNat -> BigNat -> (# BigNat,BigNat #)\nquotRemBigNat n@(BN# nba#) d@(BN# dba#)\n  | isZeroBigNat d     = (# nullBigNat, nullBigNat #)\n  | eqBigNatWord d 1## = (# n, zeroBigNat #)\n  | n < d              = (# zeroBigNat, n #)\n  | True = case runS go of (!q,!r) -> (# q, r #)\n  where\n    nn# = sizeofBigNat# n\n    dn# = sizeofBigNat# d\n    qn# = 1# +# nn# -# dn#\n    rn# = dn#\n\n    go = do\n      qmbn@(MBN# qmba#) <- newBigNat# qn#\n      rmbn@(MBN# rmba#) <- newBigNat# rn#\n\n      _ <- liftIO (c_mpn_tdiv_qr qmba# rmba# 0# nba# nn# dba# dn#)\n\n      q <- unsafeRenormFreezeBigNat# qmbn\n      r <- unsafeRenormFreezeBigNat# rmbn\n      return (q, r)\n\nquotBigNat :: BigNat -> BigNat -> BigNat\nquotBigNat n@(BN# nba#) d@(BN# dba#)\n  | isZeroBigNat d     = nullBigNat\n  | eqBigNatWord d 1## = n\n  | n < d              = zeroBigNat\n  | True = runS $ do\n      let nn# = sizeofBigNat# n\n      let dn# = sizeofBigNat# d\n      let qn# = 1# +# nn# -# dn#\n      qmbn@(MBN# qmba#) <- newBigNat# qn#\n      _ <- liftIO (c_mpn_tdiv_q qmba# nba# nn# dba# dn#)\n      unsafeRenormFreezeBigNat# qmbn\n\nremBigNat :: BigNat -> BigNat -> BigNat\nremBigNat n@(BN# nba#) d@(BN# dba#)\n  | isZeroBigNat d     = nullBigNat\n  | eqBigNatWord d 1## = zeroBigNat\n  | n < d              = n\n  | True = runS $ do\n      let nn# = sizeofBigNat# n\n      let dn# = sizeofBigNat# d\n      rmbn@(MBN# rmba#) <- newBigNat# dn#\n      _ <- liftIO (c_mpn_tdiv_r rmba# nba# nn# dba# dn#)\n      unsafeRenormFreezeBigNat# rmbn\n\n-- | Note: Result of div/0 undefined\nquotRemBigNatWord :: BigNat -> GmpLimb# -> (# BigNat, GmpLimb# #)\nquotRemBigNatWord !_           0## = (# nullBigNat, 0## #)\nquotRemBigNatWord n            1## = (# n,          0## #)\nquotRemBigNatWord n@(BN# nba#) d# = case compareBigNatWord n d# of\n    LT -> (# zeroBigNat, bigNatToWord n #)\n    EQ -> (# oneBigNat, 0## #)\n    GT -> case runS go of (!q,!(W# r#)) -> (# q, r# #) -- TODO: handle word/word\n  where\n    go = do\n      let nn# = sizeofBigNat# n\n      qmbn@(MBN# qmba#) <- newBigNat# nn#\n      r <- liftIO (c_mpn_divrem_1 qmba# 0# nba# nn# d#)\n      q <- unsafeRenormFreezeBigNat# qmbn\n      return (q,r)\n\nquotBigNatWord :: BigNat -> GmpLimb# -> BigNat\nquotBigNatWord n d# = case inline quotRemBigNatWord n d# of (# q, _ #) -> q\n\n-- | div/0 not checked\nremBigNatWord :: BigNat -> GmpLimb# -> Word#\nremBigNatWord n@(BN# nba#) d# = c_mpn_mod_1 nba# (sizeofBigNat# n) d#\n\ngcdBigNatWord :: BigNat -> Word# -> Word#\ngcdBigNatWord bn@(BN# ba#) = c_mpn_gcd_1# ba# (sizeofBigNat# bn)\n\ngcdBigNat :: BigNat -> BigNat -> BigNat\ngcdBigNat x@(BN# x#) y@(BN# y#)\n  | isZeroBigNat x = y\n  | isZeroBigNat y = x\n  | isTrue# (nx# >=# ny#) = runS (gcd' x# nx# y# ny#)\n  | True                  = runS (gcd' y# ny# x# nx#)\n  where\n    gcd' a# na# b# nb# = do -- na >= nb\n        mbn@(MBN# mba#) <- newBigNat# nb#\n        I# rn'# <- liftIO (c_mpn_gcd# mba# a# na# b# nb#)\n        let rn# = narrowGmpSize# rn'#\n        case isTrue# (rn# ==# nb#) of\n            False -> unsafeShrinkFreezeBigNat# mbn rn#\n            True  -> unsafeFreezeBigNat# mbn\n\n    nx# = sizeofBigNat# x\n    ny# = sizeofBigNat# y\n\n-- | Extended euclidean algorithm.\n--\n-- For @/a/@ and @/b/@, compute their greatest common divisor @/g/@\n-- and the coefficient @/s/@ satisfying @/a//s/ + /b//t/ = /g/@.\n--\n-- @since 0.5.1.0\n{-# NOINLINE gcdExtInteger #-}\ngcdExtInteger :: Integer -> Integer -> (# Integer, Integer #)\ngcdExtInteger a b = case gcdExtSBigNat a' b' of\n    (# g, s #) -> let !g' = bigNatToInteger  g\n                      !s' = sBigNatToInteger s\n                  in (# g', s' #)\n  where\n    a' = integerToSBigNat a\n    b' = integerToSBigNat b\n\n-- internal helper\ngcdExtSBigNat :: SBigNat -> SBigNat -> (# BigNat, SBigNat #)\ngcdExtSBigNat x y = case runS go of (g,s) -> (# g, s #)\n  where\n    go = do\n        g@(MBN# g#) <- newBigNat# gn0#\n        -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext\n        -- abs(s) < abs(y) / (2 g)\n        s@(MBN# s#) <- newBigNat# (absI# yn#)\n        I# ssn_# <- liftIO (integer_gmp_gcdext# s# g# x# xn# y# yn#)\n        let ssn# = narrowGmpSize# ssn_#\n            sn#  = absI# ssn#\n        s' <- unsafeShrinkFreezeBigNat# s sn#\n        g' <- unsafeRenormFreezeBigNat# g\n        case isTrue# (ssn# >=# 0#) of\n            False -> return ( g', NegBN s' )\n            True  -> return ( g', PosBN s' )\n\n    !(BN# x#) = absSBigNat x\n    !(BN# y#) = absSBigNat y\n    xn# = ssizeofSBigNat# x\n    yn# = ssizeofSBigNat# y\n\n    gn0# = minI# (absI# xn#) (absI# yn#)\n\n----------------------------------------------------------------------------\n-- modular exponentiation\n\n-- | \\\"@'powModInteger' /b/ /e/ /m/@\\\" computes base @/b/@ raised to\n-- exponent @/e/@ modulo @abs(/m/)@.\n--\n-- Negative exponents are supported if an inverse modulo @/m/@\n-- exists.\n--\n-- __Warning__: It's advised to avoid calling this primitive with\n-- negative exponents unless it is guaranteed the inverse exists, as\n-- failure to do so will likely cause program abortion due to a\n-- divide-by-zero fault. See also 'recipModInteger'.\n--\n-- Future versions of @integer_gmp@ may not support negative @/e/@\n-- values anymore.\n--\n-- @since 0.5.1.0\n{-# NOINLINE powModInteger #-}\npowModInteger :: Integer -> Integer -> Integer -> Integer\npowModInteger (S# b#) (S# e#) (S# m#)\n  | isTrue# (b# >=# 0#), isTrue# (e# >=# 0#)\n  = wordToInteger (powModWord (int2Word# b#) (int2Word# e#)\n                              (int2Word# (absI# m#)))\npowModInteger b e m = case m of\n    (S# m#) -> wordToInteger (powModSBigNatWord b' e' (int2Word# (absI# m#)))\n    (Jp# m') -> bigNatToInteger (powModSBigNat b' e' m')\n    (Jn# m') -> bigNatToInteger (powModSBigNat b' e' m')\n  where\n    b' = integerToSBigNat b\n    e' = integerToSBigNat e\n\n-- | \\\"@'powModSecInteger' /b/ /e/ /m/@\\\" computes base @/b/@ raised to\n-- exponent @/e/@ modulo @/m/@. It is required that @/e/ >= 0@ and\n-- @/m/@ is odd.\n--\n-- This is a \\\"secure\\\" variant of 'powModInteger' using the\n-- @mpz_powm_sec()@ function which is designed to be resilient to side\n-- channel attacks and is therefore intended for cryptographic\n-- applications.\n--\n-- This primitive is only available when the underlying GMP library\n-- supports it (GMP >= 5). Otherwise, it internally falls back to\n-- @'powModInteger'@, and a warning will be emitted when used.\n--\n-- @since 1.0.2.0\n{-# NOINLINE powModSecInteger #-}\npowModSecInteger :: Integer -> Integer -> Integer -> Integer\npowModSecInteger b e m = bigNatToInteger (powModSecSBigNat b' e' m')\n  where\n    b' = integerToSBigNat b\n    e' = integerToSBigNat e\n    m' = absSBigNat (integerToSBigNat m)\n\n#if HAVE_SECURE_POWM == 0\n{-# WARNING powModSecInteger \"The underlying GMP library does not support a secure version of powModInteger which is side-channel resistant - you need at least GMP version 5 to support this\" #-}\n#endif\n\n-- | Version of 'powModInteger' operating on 'BigNat's\n--\n-- @since 1.0.0.0\npowModBigNat :: BigNat -> BigNat -> BigNat -> BigNat\npowModBigNat b e m = inline powModSBigNat (PosBN b) (PosBN e) m\n\n-- | Version of 'powModInteger' for 'Word#'-sized moduli\n--\n-- @since 1.0.0.0\npowModBigNatWord :: BigNat -> BigNat -> GmpLimb# -> GmpLimb#\npowModBigNatWord b e m# = inline powModSBigNatWord (PosBN b) (PosBN e) m#\n\n-- | Version of 'powModInteger' operating on 'Word#'s\n--\n-- @since 1.0.0.0\nforeign import ccall unsafe \"integer_gmp_powm_word\"\n  powModWord :: GmpLimb# -> GmpLimb# -> GmpLimb# -> GmpLimb#\n\n-- internal non-exported helper\npowModSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat\npowModSBigNat b e m@(BN# m#) = runS $ do\n    r@(MBN# r#) <- newBigNat# mn#\n    I# rn_# <- liftIO (integer_gmp_powm# r# b# bn# e# en# m# mn#)\n    let rn# = narrowGmpSize# rn_#\n    case isTrue# (rn# ==# mn#) of\n        False -> unsafeShrinkFreezeBigNat# r rn#\n        True  -> unsafeFreezeBigNat# r\n  where\n    !(BN# b#) = absSBigNat b\n    !(BN# e#) = absSBigNat e\n    bn# = ssizeofSBigNat# b\n    en# = ssizeofSBigNat# e\n    mn# = sizeofBigNat# m\n\nforeign import ccall unsafe \"integer_gmp_powm\"\n  integer_gmp_powm# :: MutableByteArray# RealWorld\n                       -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#\n                       -> ByteArray# -> GmpSize# -> IO GmpSize\n\n-- internal non-exported helper\npowModSBigNatWord :: SBigNat -> SBigNat -> GmpLimb# -> GmpLimb#\npowModSBigNatWord b e m# = integer_gmp_powm1# b# bn# e# en# m#\n  where\n    !(BN# b#) = absSBigNat b\n    !(BN# e#) = absSBigNat e\n    bn# = ssizeofSBigNat# b\n    en# = ssizeofSBigNat# e\n\nforeign import ccall unsafe \"integer_gmp_powm1\"\n  integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#\n                        -> GmpLimb# -> GmpLimb#\n\n-- internal non-exported helper\npowModSecSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat\npowModSecSBigNat b e m@(BN# m#) = runS $ do\n    r@(MBN# r#) <- newBigNat# mn#\n    I# rn_# <- liftIO (integer_gmp_powm_sec# r# b# bn# e# en# m# mn#)\n    let rn# = narrowGmpSize# rn_#\n    case isTrue# (rn# ==# mn#) of\n        False -> unsafeShrinkFreezeBigNat# r rn#\n        True  -> unsafeFreezeBigNat# r\n  where\n    !(BN# b#) = absSBigNat b\n    !(BN# e#) = absSBigNat e\n    bn# = ssizeofSBigNat# b\n    en# = ssizeofSBigNat# e\n    mn# = sizeofBigNat# m\n\nforeign import ccall unsafe \"integer_gmp_powm_sec\"\n  integer_gmp_powm_sec# :: MutableByteArray# RealWorld\n                           -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#\n                           -> ByteArray# -> GmpSize# -> IO GmpSize\n\n\n-- | \\\"@'recipModInteger' /x/ /m/@\\\" computes the inverse of @/x/@ modulo @/m/@. If\n-- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ <\n-- abs(/m/)@, otherwise the result is @0@.\n--\n-- @since 0.5.1.0\n{-# NOINLINE recipModInteger #-}\nrecipModInteger :: Integer -> Integer -> Integer\nrecipModInteger (S# x#) (S# m#)\n  | isTrue# (x# >=# 0#)\n  = wordToInteger (recipModWord (int2Word# x#) (int2Word# (absI# m#)))\nrecipModInteger x m = bigNatToInteger (recipModSBigNat x' m')\n  where\n    x' = integerToSBigNat x\n    m' = absSBigNat (integerToSBigNat m)\n\n-- | Version of 'recipModInteger' operating on 'BigNat's\n--\n-- @since 1.0.0.0\nrecipModBigNat :: BigNat -> BigNat -> BigNat\nrecipModBigNat x m = inline recipModSBigNat (PosBN x) m\n\n-- | Version of 'recipModInteger' operating on 'Word#'s\n--\n-- @since 1.0.0.0\nforeign import ccall unsafe \"integer_gmp_invert_word\"\n  recipModWord :: GmpLimb# -> GmpLimb# -> GmpLimb#\n\n-- internal non-exported helper\nrecipModSBigNat :: SBigNat -> BigNat -> BigNat\nrecipModSBigNat x m@(BN# m#) = runS $ do\n    r@(MBN# r#) <- newBigNat# mn#\n    I# rn_# <- liftIO (integer_gmp_invert# r# x# xn# m# mn#)\n    let rn# = narrowGmpSize# rn_#\n    case isTrue# (rn# ==# mn#) of\n        False -> unsafeShrinkFreezeBigNat# r rn#\n        True  -> unsafeFreezeBigNat# r\n  where\n    !(BN# x#) = absSBigNat x\n    xn# = ssizeofSBigNat# x\n    mn# = sizeofBigNat# m\n\nforeign import ccall unsafe \"integer_gmp_invert\"\n  integer_gmp_invert# :: MutableByteArray# RealWorld\n                         -> ByteArray# -> GmpSize#\n                         -> ByteArray# -> GmpSize# -> IO GmpSize\n\n----------------------------------------------------------------------------\n-- Conversions to/from floating point\n\ndecodeDoubleInteger :: Double# -> (# Integer, Int# #)\n-- decodeDoubleInteger 0.0## = (# S# 0#, 0# #)\n#if WORD_SIZE_IN_BITS == 64\ndecodeDoubleInteger x = case decodeDouble_Int64# x of\n                          (# m#, e# #) -> (# S# m#, e# #)\n#elif WORD_SIZE_IN_BITS == 32\ndecodeDoubleInteger x = case decodeDouble_Int64# x of\n                          (# m#, e# #) -> (# int64ToInteger m#, e# #)\n#endif\n{-# CONSTANT_FOLDED decodeDoubleInteger #-}\n\n-- provided by GHC's RTS\nforeign import ccall unsafe \"__int_encodeDouble\"\n  int_encodeDouble# :: Int# -> Int# -> Double#\n\nencodeDoubleInteger :: Integer -> Int# -> Double#\nencodeDoubleInteger (S# m#) 0# = int2Double# m#\nencodeDoubleInteger (S# m#) e# = int_encodeDouble# m# e#\nencodeDoubleInteger (Jp# bn@(BN# bn#)) e#\n    = c_mpn_get_d bn# (sizeofBigNat# bn) e#\nencodeDoubleInteger (Jn# bn@(BN# bn#)) e#\n    = c_mpn_get_d bn# (negateInt# (sizeofBigNat# bn)) e#\n{-# CONSTANT_FOLDED encodeDoubleInteger #-}\n\n-- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn)\nforeign import ccall unsafe \"integer_gmp_mpn_get_d\"\n  c_mpn_get_d :: ByteArray# -> GmpSize# -> Int# -> Double#\n\ndoubleFromInteger :: Integer -> Double#\ndoubleFromInteger (S# m#) = int2Double# m#\ndoubleFromInteger (Jp# bn@(BN# bn#))\n    = c_mpn_get_d bn# (sizeofBigNat# bn) 0#\ndoubleFromInteger (Jn# bn@(BN# bn#))\n    = c_mpn_get_d bn# (negateInt# (sizeofBigNat# bn)) 0#\n{-# CONSTANT_FOLDED doubleFromInteger #-}\n\n-- TODO: Not sure if it's worth to write 'Float' optimized versions here\nfloatFromInteger :: Integer -> Float#\nfloatFromInteger i = double2Float# (doubleFromInteger i)\n\nencodeFloatInteger :: Integer -> Int# -> Float#\nencodeFloatInteger m e = double2Float# (encodeDoubleInteger m e)\n\n----------------------------------------------------------------------------\n-- FFI ccall imports\n\nforeign import ccall unsafe \"integer_gmp_gcd_word\"\n  gcdWord# :: GmpLimb# -> GmpLimb# -> GmpLimb#\n\nforeign import ccall unsafe \"integer_gmp_mpn_gcd_1\"\n  c_mpn_gcd_1# :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#\n\nforeign import ccall unsafe \"integer_gmp_mpn_gcd\"\n  c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize#\n                -> ByteArray# -> GmpSize# -> IO GmpSize\n\nforeign import ccall unsafe \"integer_gmp_gcdext\"\n  integer_gmp_gcdext# :: MutableByteArray# s -> MutableByteArray# s\n                         -> ByteArray# -> GmpSize#\n                         -> ByteArray# -> GmpSize# -> IO GmpSize\n\n-- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,\n--                      mp_limb_t s2limb)\nforeign import ccall unsafe \"gmp.h __gmpn_add_1\"\n  c_mpn_add_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#\n                 -> IO GmpLimb\n\n-- mp_limb_t mpn_sub_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,\n--                      mp_limb_t s2limb)\nforeign import ccall unsafe \"gmp.h __gmpn_sub_1\"\n  c_mpn_sub_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#\n                 -> IO GmpLimb\n\n-- mp_limb_t mpn_mul_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,\n--                      mp_limb_t s2limb)\nforeign import ccall unsafe \"gmp.h __gmpn_mul_1\"\n  c_mpn_mul_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#\n                 -> IO GmpLimb\n\n-- mp_limb_t mpn_add (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,\n--                    const mp_limb_t *s2p, mp_size_t s2n)\nforeign import ccall unsafe \"gmp.h __gmpn_add\"\n  c_mpn_add :: MutableByteArray# s -> ByteArray# -> GmpSize#\n               -> ByteArray# -> GmpSize# -> IO GmpLimb\n\n-- mp_limb_t mpn_sub (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,\n--                    const mp_limb_t *s2p, mp_size_t s2n)\nforeign import ccall unsafe \"gmp.h __gmpn_sub\"\n  c_mpn_sub :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#\n               -> GmpSize# -> IO GmpLimb\n\n-- mp_limb_t mpn_mul (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,\n--                    const mp_limb_t *s2p, mp_size_t s2n)\nforeign import ccall unsafe \"gmp.h __gmpn_mul\"\n  c_mpn_mul :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#\n               -> GmpSize# -> IO GmpLimb\n\n-- int mpn_cmp (const mp_limb_t *s1p, const mp_limb_t *s2p, mp_size_t n)\nforeign import ccall unsafe \"gmp.h __gmpn_cmp\"\n  c_mpn_cmp :: ByteArray# -> ByteArray# -> GmpSize# -> CInt#\n\n-- void mpn_tdiv_qr (mp_limb_t *qp, mp_limb_t *rp, mp_size_t qxn,\n--                   const mp_limb_t *np, mp_size_t nn,\n--                   const mp_limb_t *dp, mp_size_t dn)\nforeign import ccall unsafe \"gmp.h __gmpn_tdiv_qr\"\n  c_mpn_tdiv_qr :: MutableByteArray# s -> MutableByteArray# s -> GmpSize#\n                   -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO ()\n\nforeign import ccall unsafe \"integer_gmp_mpn_tdiv_q\"\n  c_mpn_tdiv_q :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#\n                  -> GmpSize# -> IO ()\n\nforeign import ccall unsafe \"integer_gmp_mpn_tdiv_r\"\n  c_mpn_tdiv_r :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#\n                  -> GmpSize# -> IO ()\n\n-- mp_limb_t mpn_divrem_1 (mp_limb_t *r1p, mp_size_t qxn, mp_limb_t *s2p,\n--                         mp_size_t s2n, mp_limb_t s3limb)\nforeign import ccall unsafe \"gmp.h __gmpn_divrem_1\"\n  c_mpn_divrem_1 :: MutableByteArray# s -> GmpSize# -> ByteArray# -> GmpSize#\n                    -> GmpLimb# -> IO GmpLimb\n\n-- mp_limb_t mpn_mod_1 (const mp_limb_t *s1p, mp_size_t s1n, mp_limb_t s2limb)\nforeign import ccall unsafe \"gmp.h __gmpn_mod_1\"\n  c_mpn_mod_1 :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#\n\n-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],\n--                                   mp_size_t sn, mp_bitcnt_t count)\nforeign import ccall unsafe \"integer_gmp_mpn_rshift\"\n  c_mpn_rshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#\n                  -> IO GmpLimb\n\n-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],\n--                                   mp_size_t sn, mp_bitcnt_t count)\nforeign import ccall unsafe \"integer_gmp_mpn_rshift_2c\"\n  c_mpn_rshift_2c :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#\n                     -> IO GmpLimb\n\n-- mp_limb_t integer_gmp_mpn_lshift (mp_limb_t rp[], const mp_limb_t sp[],\n--                                   mp_size_t sn, mp_bitcnt_t count)\nforeign import ccall unsafe \"integer_gmp_mpn_lshift\"\n  c_mpn_lshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#\n                  -> IO GmpLimb\n\n-- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,\n--                 mp_size_t n)\nforeign import ccall unsafe \"integer_gmp_mpn_and_n\"\n  c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#\n                 -> IO ()\n\n-- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,\n--                  mp_size_t n)\nforeign import ccall unsafe \"integer_gmp_mpn_andn_n\"\n  c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#\n                  -> IO ()\n\n-- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,\n--                 mp_size_t n)\nforeign import ccall unsafe \"integer_gmp_mpn_ior_n\"\n  c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#\n                 -> IO ()\n\n-- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,\n--                 mp_size_t n)\nforeign import ccall unsafe \"integer_gmp_mpn_xor_n\"\n  c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#\n                 -> IO ()\n\n-- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n)\nforeign import ccall unsafe \"gmp.h __gmpn_popcount\"\n  c_mpn_popcount :: ByteArray# -> GmpSize# -> GmpBitCnt#\n\n----------------------------------------------------------------------------\n-- BigNat-wrapped ByteArray#-primops\n\n-- | Return number of limbs contained in 'BigNat'.\nsizeofBigNat# :: BigNat -> GmpSize#\nsizeofBigNat# (BN# x#)\n    = sizeofByteArray# x# `uncheckedIShiftRL#` GMP_LIMB_SHIFT#\n\ndata MutBigNat s = MBN# !(MutableByteArray# s)\n\ngetSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, GmpSize# #)\n--getSizeofMutBigNat# :: MutBigNat s -> S s GmpSize#\ngetSizeofMutBigNat# (MBN# x#) s =\n    case getSizeofMutableByteArray# x# s of\n        (# s', n# #) -> (# s', n# `uncheckedIShiftRL#` GMP_LIMB_SHIFT# #)\n\nnewBigNat# :: GmpSize# -> S s (MutBigNat s)\nnewBigNat# limbs# s =\n    case newByteArray# (limbs# `uncheckedIShiftL#` GMP_LIMB_SHIFT#) s of\n        (# s', mba# #) -> (# s', MBN# mba# #)\n\nwriteBigNat# :: MutBigNat s -> GmpSize# -> GmpLimb# -> State# s -> State# s\nwriteBigNat# (MBN# mba#) = writeWordArray# mba#\n\n-- | Extract /n/-th (0-based) limb in 'BigNat'.\n-- /n/ must be less than size as reported by 'sizeofBigNat#'.\nindexBigNat# :: BigNat -> GmpSize# -> GmpLimb#\nindexBigNat# (BN# ba#) = indexWordArray# ba#\n\nunsafeFreezeBigNat# :: MutBigNat s -> S s BigNat\nunsafeFreezeBigNat# (MBN# mba#) s = case unsafeFreezeByteArray# mba# s of\n                                      (# s', ba# #) -> (# s', BN# ba# #)\n\nresizeMutBigNat# :: MutBigNat s -> GmpSize# -> S s (MutBigNat s)\nresizeMutBigNat# (MBN# mba0#) nsz# s\n  | isTrue# (bsz# ==# n#) = (# s', MBN# mba0# #)\n  | True =\n    case resizeMutableByteArray# mba0# bsz# s' of\n        (# s'', mba# #) -> (# s'', MBN# mba# #)\n  where\n    bsz# = nsz# `uncheckedIShiftL#` GMP_LIMB_SHIFT#\n    !(# s', n# #) = getSizeofMutableByteArray# mba0# s\n\nshrinkMutBigNat# :: MutBigNat s -> GmpSize# -> State# s -> State# s\nshrinkMutBigNat# (MBN# mba0#) nsz# s\n  | isTrue# (bsz# ==# n#) = s' -- no-op\n  | True                  = shrinkMutableByteArray# mba0# bsz# s'\n  where\n    bsz# = nsz# `uncheckedIShiftL#` GMP_LIMB_SHIFT#\n    !(# s', n# #) = getSizeofMutableByteArray# mba0# s\n\nunsafeSnocFreezeBigNat# :: MutBigNat s -> GmpLimb# -> S s BigNat\nunsafeSnocFreezeBigNat# mbn0@(MBN# mba0#) limb# s = go s'\n  where\n    n#   = nb0# `uncheckedIShiftRL#` GMP_LIMB_SHIFT#\n    !(# s', nb0# #) = getSizeofMutableByteArray# mba0# s\n    go = do\n        (MBN# mba#) <- resizeMutBigNat# mbn0 (n# +# 1#)\n        _ <- svoid (writeWordArray# mba# n# limb#)\n        unsafeFreezeBigNat# (MBN# mba#)\n\n-- | May shrink underlyng 'ByteArray#' if needed to satisfy BigNat invariant\nunsafeRenormFreezeBigNat# :: MutBigNat s -> S s BigNat\nunsafeRenormFreezeBigNat# mbn s\n  | isTrue# (n0# ==# 0#)  = (# s'', nullBigNat #)\n  | isTrue# (n#  ==# 0#)  = (# s'', zeroBigNat #)\n  | isTrue# (n#  ==# n0#) = (unsafeFreezeBigNat# mbn) s''\n  | True                  = (unsafeShrinkFreezeBigNat# mbn n#) s''\n  where\n    !(# s', n0# #) = getSizeofMutBigNat# mbn s\n    !(# s'', n# #) = normSizeofMutBigNat'# mbn n0# s'\n\n-- | Shrink MBN\nunsafeShrinkFreezeBigNat# :: MutBigNat s -> GmpSize# -> S s BigNat\nunsafeShrinkFreezeBigNat# x@(MBN# xmba) 1#\n    = \\s -> case readWordArray# xmba 0# s of\n        (# s', w#   #) -> freezeOneLimb w# s'\n  where\n    freezeOneLimb 0## = return zeroBigNat\n    freezeOneLimb 1## = return oneBigNat\n    freezeOneLimb w# | isTrue# (not# w# `eqWord#` 0##) = return czeroBigNat\n    freezeOneLimb _   = do\n        _ <- svoid (shrinkMutBigNat# x 1#)\n        unsafeFreezeBigNat# x\nunsafeShrinkFreezeBigNat# x y# = do\n    _ <- svoid (shrinkMutBigNat# x y#)\n    unsafeFreezeBigNat# x\n\n\ncopyWordArray# :: ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int#\n                  -> State# s -> State# s\ncopyWordArray# src src_ofs dst dst_ofs len\n  = copyByteArray# src (src_ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#)\n                   dst (dst_ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#)\n                   (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#)\n\ncopyWordArray :: BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()\ncopyWordArray (BN# ba#) ofs_ba# (MBN# mba#) ofs_mba# len#\n  = svoid (copyWordArray# ba# ofs_ba# mba# ofs_mba# len#)\n\nclearWordArray# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s\nclearWordArray# mba ofs len\n  = setByteArray# mba (ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#)\n                      (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#\n\n-- | Version of 'normSizeofMutBigNat'#' which scans all allocated 'MutBigNat#'\nnormSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, Int# #)\nnormSizeofMutBigNat# mbn@(MBN# mba) s = normSizeofMutBigNat'# mbn sz# s'\n  where\n    !(# s', n# #) = getSizeofMutableByteArray# mba s\n    sz# = n# `uncheckedIShiftRA#` GMP_LIMB_SHIFT#\n\n-- | Find most-significant non-zero limb and return its index-position\n-- plus one. Start scanning downward from the initial limb-size\n-- (i.e. start-index plus one) given as second argument.\n--\n-- NB: The 'normSizeofMutBigNat' of 'zeroBigNat' would be @0#@\nnormSizeofMutBigNat'# :: MutBigNat s -> GmpSize#\n                         -> State# s -> (# State# s, GmpSize# #)\nnormSizeofMutBigNat'# (MBN# mba) = go\n  where\n    go  0# s = (# s, 0# #)\n    go i0# s = case readWordArray# mba (i0# -# 1#) s of\n        (# s', 0## #) -> go (i0# -# 1#) s'\n        (# s', _  #) -> (# s', i0# #)\n\n-- | Construct 'BigNat' from existing 'ByteArray#' containing /n/\n-- 'GmpLimb's in least-significant-first order.\n--\n-- If possible 'ByteArray#', will be used directly (i.e. shared\n-- /without/ cloning the 'ByteArray#' into a newly allocated one)\n--\n-- Note: size parameter (times @sizeof(GmpLimb)@) must be less or\n-- equal to its 'sizeofByteArray#'.\nbyteArrayToBigNat# :: ByteArray# -> GmpSize# -> BigNat\nbyteArrayToBigNat# ba# n0#\n  | isTrue# (n#  ==# 0#)    = zeroBigNat\n  | isTrue# (baszr# ==# 0#) -- i.e. ba# is multiple of limb-size\n  , isTrue# (baszq# ==# n#) = (BN# ba#)\n  | True = runS $ \\s ->\n      let !(# s', mbn@(MBN# mba#) #) = newBigNat# n# s\n          !(# s'', ba_sz# #) = getSizeofMutableByteArray# mba# s'\n          go = do _ <- svoid (copyByteArray# ba# 0# mba# 0# ba_sz# )\n                  unsafeFreezeBigNat# mbn\n      in go s''\n  where\n    !(# baszq#, baszr# #) = quotRemInt# (sizeofByteArray# ba#) GMP_LIMB_BYTES#\n\n    n#  = fmssl (BN# ba#) (n0# -# 1#)\n\n-- | Read 'Integer' (without sign) from memory location at @/addr/@ in\n-- base-256 representation.\n--\n-- @'importIntegerFromAddr' /addr/ /size/ /msbf/@\n--\n-- See description of 'importIntegerFromByteArray' for more details.\n--\n-- @since 1.0.0.0\nimportIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer\nimportIntegerFromAddr addr len msbf = IO $ do\n    bn <- liftIO (importBigNatFromAddr addr len msbf)\n    return (bigNatToInteger bn)\n\n-- | Version of 'importIntegerFromAddr' constructing a 'BigNat'\nimportBigNatFromAddr :: Addr# -> Word# -> Int# -> IO BigNat\nimportBigNatFromAddr _ 0## _ = IO (\\s -> (# s, zeroBigNat #))\nimportBigNatFromAddr addr len0 1# = IO $ do -- MSBF\n    W# ofs <- liftIO (c_scan_nzbyte_addr addr 0## len0)\n    let len = len0 `minusWord#` ofs\n        addr' = addr `plusAddr#` (word2Int# ofs)\n    importBigNatFromAddr# addr' len 1#\nimportBigNatFromAddr addr len0 _ = IO $ do -- LSBF\n    W# len <- liftIO (c_rscan_nzbyte_addr addr 0## len0)\n    importBigNatFromAddr# addr len 0#\n\nforeign import ccall unsafe \"integer_gmp_scan_nzbyte\"\n    c_scan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word\n\nforeign import ccall unsafe \"integer_gmp_rscan_nzbyte\"\n    c_rscan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word\n\n-- | Helper for 'importBigNatFromAddr'\nimportBigNatFromAddr# :: Addr# -> Word# -> Int# -> S RealWorld BigNat\nimportBigNatFromAddr# _ 0## _ = return zeroBigNat\nimportBigNatFromAddr# addr len msbf = do\n    mbn@(MBN# mba#) <- newBigNat# n#\n    () <- liftIO (c_mpn_import_addr mba# addr 0## len msbf)\n    unsafeFreezeBigNat# mbn\n  where\n    -- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required\n    n# = (word2Int# len +# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#\n\nforeign import ccall unsafe \"integer_gmp_mpn_import\"\n    c_mpn_import_addr :: MutableByteArray# RealWorld -> Addr# -> Word# -> Word#\n                      -> Int# -> IO ()\n\n-- | Read 'Integer' (without sign) from byte-array in base-256 representation.\n--\n-- The call\n--\n-- @'importIntegerFromByteArray' /ba/ /offset/ /size/ /msbf/@\n--\n-- reads\n--\n-- * @/size/@ bytes from the 'ByteArray#' @/ba/@ starting at @/offset/@\n--\n-- * with most significant byte first if @/msbf/@ is @1#@ or least\n--   significant byte first if @/msbf/@ is @0#@, and\n--\n-- * returns a new 'Integer'\n--\n-- @since 1.0.0.0\nimportIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer\nimportIntegerFromByteArray ba ofs len msbf\n    = bigNatToInteger (importBigNatFromByteArray ba ofs len msbf)\n\n-- | Version of 'importIntegerFromByteArray' constructing a 'BigNat'\nimportBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat\nimportBigNatFromByteArray _  _    0##  _  = zeroBigNat\nimportBigNatFromByteArray ba ofs0 len0 1# = runS $ do -- MSBF\n    W# ofs <- liftIO (c_scan_nzbyte_bytearray ba ofs0 len0)\n    let len = (len0 `plusWord#` ofs0) `minusWord#` ofs\n    importBigNatFromByteArray# ba ofs len 1#\nimportBigNatFromByteArray ba ofs  len0 _  = runS $ do -- LSBF\n    W# len <- liftIO (c_rscan_nzbyte_bytearray ba ofs len0)\n    importBigNatFromByteArray# ba ofs len 0#\n\nforeign import ccall unsafe \"integer_gmp_scan_nzbyte\"\n    c_scan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word\n\nforeign import ccall unsafe \"integer_gmp_rscan_nzbyte\"\n    c_rscan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word\n\n-- | Helper for 'importBigNatFromByteArray'\nimportBigNatFromByteArray# :: ByteArray# -> Word# -> Word# -> Int#\n                           -> S RealWorld BigNat\nimportBigNatFromByteArray# _ _ 0## _ = return zeroBigNat\nimportBigNatFromByteArray# ba ofs len msbf = do\n    mbn@(MBN# mba#) <- newBigNat# n#\n    () <- liftIO (c_mpn_import_bytearray mba# ba ofs len msbf)\n    unsafeFreezeBigNat# mbn\n  where\n    -- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required\n    n# = (word2Int# len +# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#\n\nforeign import ccall unsafe \"integer_gmp_mpn_import\"\n    c_mpn_import_bytearray :: MutableByteArray# RealWorld -> ByteArray# -> Word#\n                           -> Word# -> Int# -> IO ()\n\n-- | Test whether all internal invariants are satisfied by 'BigNat' value\n--\n-- Returns @1#@ if valid, @0#@ otherwise.\n--\n-- This operation is mostly useful for test-suites and/or code which\n-- constructs 'Integer' values directly.\nisValidBigNat# :: BigNat -> Int#\nisValidBigNat# (BN# ba#)\n  = (szq# ># 0#) `andI#` (szr# ==# 0#) `andI#` isNorm#\n  where\n    isNorm#\n      | isTrue# (szq# ># 1#) = (indexWordArray# ba# (szq# -# 1#)) `neWord#` 0##\n      | True                 = 1#\n\n    sz# = sizeofByteArray# ba#\n\n    !(# szq#, szr# #) = quotRemInt# sz# GMP_LIMB_BYTES#\n\n-- | Version of 'nextPrimeInteger' operating on 'BigNat's\n--\n-- @since 1.0.0.0\nnextPrimeBigNat :: BigNat -> BigNat\nnextPrimeBigNat bn@(BN# ba#) = runS $ do\n    mbn@(MBN# mba#) <- newBigNat# n#\n    (W# c#) <- liftIO (nextPrime# mba# ba# n#)\n    case c# of\n        0## -> unsafeFreezeBigNat# mbn\n        _   -> unsafeSnocFreezeBigNat# mbn c#\n  where\n    n# = sizeofBigNat# bn\n\nforeign import ccall unsafe \"integer_gmp_next_prime\"\n  nextPrime# :: MutableByteArray# RealWorld -> ByteArray# -> GmpSize#\n                -> IO GmpLimb\n\n----------------------------------------------------------------------------\n-- monadic combinators for low-level state threading\n\ntype S s a = State# s -> (# State# s, a #)\n\ninfixl 1 >>=\ninfixl 1 >>\ninfixr 0 $\n\n{-# INLINE ($) #-}\n($)                     :: (a -> b) -> a -> b\nf $ x                   =  f x\n\n{-# INLINE (>>=) #-}\n(>>=) :: S s a -> (a -> S s b) -> S s b\n(>>=) m k = \\s -> case m s of (# s', a #) -> k a s'\n\n{-# INLINE (>>) #-}\n(>>) :: S s a -> S s b -> S s b\n(>>) m k = \\s -> case m s of (# s', _ #) -> k s'\n\n{-# INLINE svoid #-}\nsvoid :: (State# s -> State# s) -> S s ()\nsvoid m0 = \\s -> case m0 s of s' -> (# s', () #)\n\n{-# INLINE return #-}\nreturn :: a -> S s a\nreturn a = \\s -> (# s, a #)\n\n{-# INLINE liftIO #-}\nliftIO :: IO a -> S RealWorld a\nliftIO (IO m) = m\n\n-- NB: equivalent of GHC.IO.unsafeDupablePerformIO, see notes there\nrunS :: S RealWorld a -> a\nrunS m = case runRW# m of (# _, a #) -> a\n\n-- stupid hack\nfail :: [Char] -> S s a\nfail s = return (raise# s)\n\n----------------------------------------------------------------------------\n\n-- | Internal helper type for \"signed\" 'BigNat's\n--\n-- This is a useful abstraction for operations which support negative\n-- mp_size_t arguments.\ndata SBigNat = NegBN !BigNat | PosBN !BigNat\n\n-- | Absolute value of 'SBigNat'\nabsSBigNat :: SBigNat -> BigNat\nabsSBigNat (NegBN bn) = bn\nabsSBigNat (PosBN bn) = bn\n\n-- | /Signed/ limb count. Negative sizes denote negative integers\nssizeofSBigNat# :: SBigNat -> GmpSize#\nssizeofSBigNat# (NegBN bn) = negateInt# (sizeofBigNat# bn)\nssizeofSBigNat# (PosBN bn) = sizeofBigNat# bn\n\n-- | Construct 'SBigNat' from 'Int#' value\nintToSBigNat# :: Int# -> SBigNat\nintToSBigNat# 0#     = PosBN zeroBigNat\nintToSBigNat# 1#     = PosBN oneBigNat\nintToSBigNat# (-1#)  = NegBN oneBigNat\nintToSBigNat# i# | isTrue# (i# ># 0#) = PosBN (wordToBigNat (int2Word# i#))\n                 | True   = NegBN (wordToBigNat (int2Word# (negateInt# i#)))\n\n-- | Convert 'Integer' into 'SBigNat'\nintegerToSBigNat :: Integer -> SBigNat\nintegerToSBigNat (S#  i#) = intToSBigNat# i#\nintegerToSBigNat (Jp# bn) = PosBN bn\nintegerToSBigNat (Jn# bn) = NegBN bn\n\n-- | Convert 'SBigNat' into 'Integer'\nsBigNatToInteger :: SBigNat -> Integer\nsBigNatToInteger (NegBN bn) = bigNatToNegInteger bn\nsBigNatToInteger (PosBN bn) = bigNatToInteger bn\n\n----------------------------------------------------------------------------\n-- misc helpers, some of these should rather be primitives exported by ghc-prim\n\ncmpW# :: Word# -> Word# -> Ordering\ncmpW# x# y#\n  | isTrue# (x# `ltWord#` y#) = LT\n  | isTrue# (x# `eqWord#` y#) = EQ\n  | True                      = GT\n{-# INLINE cmpW# #-}\n\nbitWord# :: Int# -> Word#\nbitWord# = uncheckedShiftL# 1##\n{-# INLINE bitWord# #-}\n\ntestBitWord# :: Word# -> Int# -> Int#\ntestBitWord# w# i# = (bitWord# i# `and#` w#) `neWord#` 0##\n{-# INLINE testBitWord# #-}\n\npopCntI# :: Int# -> Int#\npopCntI# i# = word2Int# (popCnt# (int2Word# i#))\n{-# INLINE popCntI# #-}\n\n-- branchless version\nabsI# :: Int# -> Int#\nabsI# i# = (i# `xorI#` nsign) -# nsign\n  where\n    -- nsign = negateInt# (i# <# 0#)\n    nsign = uncheckedIShiftRA# i# (WORD_SIZE_IN_BITS# -# 1#)\n\n-- branchless version\nsgnI# :: Int# -> Int#\nsgnI# x# = (x# ># 0#) -# (x# <# 0#)\n\ncmpI# :: Int# -> Int# -> Int#\ncmpI# x# y# = (x# ># y#) -# (x# <# y#)\n\nminI# :: Int# -> Int# -> Int#\nminI# x# y# | isTrue# (x# <=# y#) = x#\n            | True                = y#\n\n-- find most-sig set limb, starting at given index\nfmssl :: BigNat -> Int# -> Int#\nfmssl !bn i0# = go i0#\n  where\n    go i# | isTrue# (i# <# 0#)                         = 0#\n          | isTrue# (neWord# (indexBigNat# bn i#) 0##) = i# +# 1#\n          | True                                       = go (i# -# 1#)\n", "num_lines": 2182}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CApiFFI #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GHCForeignImportPrim #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n#include \"MachDeps.h\"\n\n-- |\n-- Module      :  GHC.Integer.GMP.Internals\n-- Copyright   :  (c) Herbert Valerio Riedel 2014\n-- License     :  BSD3\n--\n-- Maintainer  :  ghc-devs@haskell.org\n-- Stability   :  provisional\n-- Portability :  non-portable (GHC Extensions)\n--\n-- This modules provides access to the 'Integer' constructors and\n-- exposes some highly optimized GMP-operations.\n--\n-- Note that since @integer-gmp@ does not depend on `base`, error\n-- reporting via exceptions, 'error', or 'undefined' is not\n-- available. Instead, the low-level functions will crash the runtime\n-- if called with invalid arguments.\n--\n-- See also\n-- <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer GHC Commentary: Libraries/Integer>.\n\nmodule GHC.Integer.GMP.Internals\n    ( -- * The 'Integer' type\n      Integer(..)\n    , isValidInteger#\n\n      -- ** Basic 'Integer' operations\n\n    , module GHC.Integer\n\n      -- ** Additional 'Integer' operations\n    , gcdInteger\n    , gcdExtInteger\n    , lcmInteger\n    , sqrInteger\n    , powModInteger\n    , powModSecInteger\n    , recipModInteger\n\n      -- ** Additional conversion operations to 'Integer'\n    , wordToNegInteger\n    , bigNatToInteger\n    , bigNatToNegInteger\n\n      -- * The 'BigNat' type\n    , BigNat(..)\n\n    , GmpLimb, GmpLimb#\n    , GmpSize, GmpSize#\n\n      -- **\n\n    , isValidBigNat#\n    , sizeofBigNat#\n    , zeroBigNat\n    , oneBigNat\n    , nullBigNat\n\n      -- ** Conversions to/from 'BigNat'\n\n    , byteArrayToBigNat#\n    , wordToBigNat\n    , wordToBigNat2\n    , bigNatToInt\n    , bigNatToWord\n    , indexBigNat#\n\n      -- ** 'BigNat' arithmetic operations\n    , plusBigNat\n    , plusBigNatWord\n    , minusBigNat\n    , minusBigNatWord\n    , timesBigNat\n    , timesBigNatWord\n    , sqrBigNat\n\n    , quotRemBigNat\n    , quotRemBigNatWord\n    , quotBigNatWord\n    , quotBigNat\n    , remBigNat\n    , remBigNatWord\n\n    , gcdBigNat\n    , gcdBigNatWord\n\n    , powModBigNat\n    , powModBigNatWord\n\n    , recipModBigNat\n\n      -- ** 'BigNat' logic operations\n    , shiftRBigNat\n    , shiftLBigNat\n    , testBitBigNat\n    , clearBitBigNat\n    , complementBitBigNat\n    , setBitBigNat\n    , andBigNat\n    , xorBigNat\n    , popCountBigNat\n    , orBigNat\n    , bitBigNat\n\n      -- ** 'BigNat' comparison predicates\n    , isZeroBigNat\n    , isNullBigNat#\n\n    , compareBigNatWord\n    , compareBigNat\n    , eqBigNatWord\n    , eqBigNatWord#\n    , eqBigNat\n    , eqBigNat#\n    , gtBigNatWord#\n\n      -- * Miscellaneous GMP-provided operations\n    , gcdInt\n    , gcdWord\n    , powModWord\n    , recipModWord\n\n      -- * Primality tests\n    , testPrimeInteger\n    , testPrimeBigNat\n    , testPrimeWord#\n\n    , nextPrimeInteger\n    , nextPrimeBigNat\n    , nextPrimeWord#\n\n      -- * Import/export functions\n      -- ** Compute size of serialisation\n    , sizeInBaseBigNat\n    , sizeInBaseInteger\n    , sizeInBaseWord#\n\n      -- ** Export\n    , exportBigNatToAddr\n    , exportIntegerToAddr\n    , exportWordToAddr\n\n    , exportBigNatToMutableByteArray\n    , exportIntegerToMutableByteArray\n    , exportWordToMutableByteArray\n\n      -- ** Import\n\n    , importBigNatFromAddr\n    , importIntegerFromAddr\n\n    , importBigNatFromByteArray\n    , importIntegerFromByteArray\n    ) where\n\nimport GHC.Integer.Type\nimport GHC.Integer\nimport GHC.Prim\nimport GHC.Types\n\ndefault ()\n\n\n-- | Compute number of digits (without sign) in given @/base/@.\n--\n-- This function wraps @mpz_sizeinbase()@ which has some\n-- implementation pecularities to take into account:\n--\n-- * \\\"@'sizeInBaseInteger' 0 /base/ = 1@\\\"\n--   (see also comment in 'exportIntegerToMutableByteArray').\n--\n-- * This function is only defined if @/base/ >= 2#@ and @/base/ <= 256#@\n--   (Note: the documentation claims that only @/base/ <= 62#@ is\n--   supported, however the actual implementation supports up to base 256).\n--\n-- * If @/base/@ is a power of 2, the result will be exact. In other\n--   cases (e.g. for @/base/ = 10#@), the result /may/ be 1 digit too large\n--   sometimes.\n--\n-- * \\\"@'sizeInBaseInteger' /i/ 2#@\\\" can be used to determine the most\n--   significant bit of @/i/@.\n--\n-- @since 0.5.1.0\nsizeInBaseInteger :: Integer -> Int# -> Word#\nsizeInBaseInteger (S# i#)  = sizeInBaseWord# (int2Word# (absI# i#))\nsizeInBaseInteger (Jp# bn) = sizeInBaseBigNat bn\nsizeInBaseInteger (Jn# bn) = sizeInBaseBigNat bn\n\n-- | Version of 'sizeInBaseInteger' operating on 'BigNat'\n--\n-- @since 1.0.0.0\nsizeInBaseBigNat :: BigNat -> Int# -> Word#\nsizeInBaseBigNat bn@(BN# ba#) = c_mpn_sizeinbase# ba# (sizeofBigNat# bn)\n\nforeign import ccall unsafe \"integer_gmp_mpn_sizeinbase\"\n  c_mpn_sizeinbase# :: ByteArray# -> GmpSize# -> Int# -> Word#\n\n-- | Version of 'sizeInBaseInteger' operating on 'Word#'\n--\n-- @since 1.0.0.0\nforeign import ccall unsafe \"integer_gmp_mpn_sizeinbase1\"\n  sizeInBaseWord# :: Word# -> Int# -> Word#\n\n-- | Dump 'Integer' (without sign) to @/addr/@ in base-256 representation.\n--\n-- @'exportIntegerToAddr' /i/ /addr/ /e/@\n--\n-- See description of 'exportIntegerToMutableByteArray' for more details.\n--\n-- @since 1.0.0.0\nexportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word\nexportIntegerToAddr (S# i#)  = exportWordToAddr (W# (int2Word# (absI# i#)))\nexportIntegerToAddr (Jp# bn) = exportBigNatToAddr bn\nexportIntegerToAddr (Jn# bn) = exportBigNatToAddr bn\n\n-- | Version of 'exportIntegerToAddr' operating on 'BigNat's.\nexportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word\nexportBigNatToAddr bn@(BN# ba#) addr e\n  = c_mpn_exportToAddr# ba# (sizeofBigNat# bn) addr 0# e\n\nforeign import ccall unsafe \"integer_gmp_mpn_export\"\n  c_mpn_exportToAddr# :: ByteArray# -> GmpSize# -> Addr# -> Int# -> Int#\n                         -> IO Word\n\n-- | Version of 'exportIntegerToAddr' operating on 'Word's.\nexportWordToAddr :: Word -> Addr# -> Int# -> IO Word\nexportWordToAddr (W# w#) addr\n  = c_mpn_export1ToAddr# w# addr 0# -- TODO: we don't calling GMP for that\n\nforeign import ccall unsafe \"integer_gmp_mpn_export1\"\n  c_mpn_export1ToAddr# :: GmpLimb# -> Addr# -> Int# -> Int#\n                          -> IO Word\n\n-- | Dump 'Integer' (without sign) to mutable byte-array in base-256\n-- representation.\n--\n-- The call\n--\n-- @'exportIntegerToMutableByteArray' /i/ /mba/ /offset/ /msbf/@\n--\n-- writes\n--\n-- * the 'Integer' @/i/@\n--\n-- * into the 'MutableByteArray#' @/mba/@ starting at @/offset/@\n--\n-- * with most significant byte first if @msbf@ is @1#@ or least\n--   significant byte first if @msbf@ is @0#@, and\n--\n-- * returns number of bytes written.\n--\n-- Use \\\"@'sizeInBaseInteger' /i/ 256#@\\\" to compute the exact number of\n-- bytes written in advance for @/i/ /= 0@. In case of @/i/ == 0@,\n-- 'exportIntegerToMutableByteArray' will write and report zero bytes\n-- written, whereas 'sizeInBaseInteger' report one byte.\n--\n-- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small\n-- integers as this function would currently convert those to big\n-- integers in msbf to call @mpz_export()@.\n--\n-- @since 1.0.0.0\nexportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld\n                                -> Word# -> Int# -> IO Word\nexportIntegerToMutableByteArray (S# i#)\n    = exportWordToMutableByteArray (W# (int2Word# (absI# i#)))\nexportIntegerToMutableByteArray (Jp# bn) = exportBigNatToMutableByteArray bn\nexportIntegerToMutableByteArray (Jn# bn) = exportBigNatToMutableByteArray bn\n\n-- | Version of 'exportIntegerToMutableByteArray' operating on 'BigNat's.\n--\n-- @since 1.0.0.0\nexportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word#\n                               -> Int# -> IO Word\nexportBigNatToMutableByteArray bn@(BN# ba#)\n  = c_mpn_exportToMutableByteArray# ba# (sizeofBigNat# bn)\n\nforeign import ccall unsafe \"integer_gmp_mpn_export\"\n  c_mpn_exportToMutableByteArray# :: ByteArray# -> GmpSize#\n                                  -> MutableByteArray# RealWorld -> Word#\n                                  -> Int# -> IO Word\n\n-- | Version of 'exportIntegerToMutableByteArray' operating on 'Word's.\n--\n-- @since 1.0.0.0\nexportWordToMutableByteArray :: Word -> MutableByteArray# RealWorld -> Word#\n                             -> Int# -> IO Word\nexportWordToMutableByteArray (W# w#) = c_mpn_export1ToMutableByteArray# w#\n\nforeign import ccall unsafe \"integer_gmp_mpn_export1\"\n  c_mpn_export1ToMutableByteArray# :: GmpLimb# -> MutableByteArray# RealWorld\n                                   -> Word# -> Int# -> IO Word\n\n\n-- | Probalistic Miller-Rabin primality test.\n--\n-- \\\"@'testPrimeInteger' /n/ /k/@\\\" determines whether @/n/@ is prime\n-- and returns one of the following results:\n--\n-- * @2#@ is returned if @/n/@ is definitely prime,\n--\n-- * @1#@ if @/n/@ is a /probable prime/, or\n--\n-- * @0#@ if @/n/@ is definitely not a prime.\n--\n-- The @/k/@ argument controls how many test rounds are performed for\n-- determining a /probable prime/. For more details, see\n-- <http://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fprobab_005fprime_005fp-360 GMP documentation for `mpz_probab_prime_p()`>.\n--\n-- @since 0.5.1.0\n{-# NOINLINE testPrimeInteger #-}\ntestPrimeInteger :: Integer -> Int# -> Int#\ntestPrimeInteger (S# i#) = testPrimeWord# (int2Word# (absI# i#))\ntestPrimeInteger (Jp# n) = testPrimeBigNat n\ntestPrimeInteger (Jn# n) = testPrimeBigNat n\n\n-- | Version of 'testPrimeInteger' operating on 'BigNat's\n--\n-- @since 1.0.0.0\ntestPrimeBigNat :: BigNat -> Int# -> Int#\ntestPrimeBigNat bn@(BN# ba#) = c_integer_gmp_test_prime# ba# (sizeofBigNat# bn)\n\nforeign import ccall unsafe \"integer_gmp_test_prime\"\n  c_integer_gmp_test_prime# :: ByteArray# -> GmpSize# -> Int# -> Int#\n\n-- | Version of 'testPrimeInteger' operating on 'Word#'s\n--\n-- @since 1.0.0.0\nforeign import ccall unsafe \"integer_gmp_test_prime1\"\n  testPrimeWord# :: GmpLimb# -> Int# -> Int#\n\n\n-- | Compute next prime greater than @/n/@ probalistically.\n--\n-- According to the GMP documentation, the underlying function\n-- @mpz_nextprime()@ \\\"uses a probabilistic algorithm to identify\n-- primes. For practical purposes it's adequate, the chance of a\n-- composite passing will be extremely small.\\\"\n--\n-- @since 0.5.1.0\n{-# NOINLINE nextPrimeInteger #-}\nnextPrimeInteger :: Integer -> Integer\nnextPrimeInteger (S# i#)\n  | isTrue# (i# ># 1#)    = wordToInteger (nextPrimeWord# (int2Word# i#))\n  | True                  = S# 2#\nnextPrimeInteger (Jp# bn) = Jp# (nextPrimeBigNat bn)\nnextPrimeInteger (Jn# _)  = S# 2#\n\n-- | Version of 'nextPrimeInteger' operating on 'Word#'s\n--\n-- @since 1.0.0.0\nforeign import ccall unsafe \"integer_gmp_next_prime1\"\n  nextPrimeWord# :: GmpLimb# -> GmpLimb#\n", "num_lines": 365}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE CPP #-}\n\n{-# OPTIONS_HADDOCK not-home #-}\n\n#include \"MachDeps.h\"\n\n#if WORD_SIZE_IN_BITS == 32\n# define WSHIFT 5\n# define MMASK 31\n#elif WORD_SIZE_IN_BITS == 64\n# define WSHIFT 6\n# define MMASK 63\n#else\n# error unsupported WORD_SIZE_IN_BITS\n#endif\n\n-- | Fast 'Integer' logarithms to base 2.  'integerLog2#' and\n-- 'wordLog2#' are of general usefulness, the others are only needed\n-- for a fast implementation of 'fromRational'.  Since they are needed\n-- in \"GHC.Float\", we must expose this module, but it should not show\n-- up in the docs.\n--\n-- See https://ghc.haskell.org/trac/ghc/ticket/5122\n-- for the origin of the code in this module\nmodule GHC.Integer.Logarithms.Internals\n    ( wordLog2#\n    , integerLog2IsPowerOf2#\n    , integerLog2#\n    , roundingMode#\n    ) where\n\nimport GHC.Integer.Type\nimport GHC.Integer.Logarithms\n\nimport GHC.Types\nimport GHC.Prim\n\ndefault ()\n\n-- | Extended version of 'integerLog2#'\n--\n-- Assumption: Integer is strictly positive\n--\n-- First component of result is @log2 n@, second is @0#@ iff /n/ is a\n-- power of two.\nintegerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)\n-- The power of 2 test is n&(n-1) == 0, thus powers of 2\n-- are indicated bythe second component being zero.\nintegerLog2IsPowerOf2# (S# i#) = case int2Word# i# of\n      w -> (# wordLog2# w, word2Int# (w `and#` (w `minusWord#` 1##)) #)\nintegerLog2IsPowerOf2# (Jn# _) = (# -1#, -1# #)\n-- Find the log2 as above, test whether that word is a power\n-- of 2, if so, check whether only zero bits follow.\nintegerLog2IsPowerOf2# (Jp# bn) = check (s -# 1#)\n  where\n    s = sizeofBigNat# bn\n    check :: Int# -> (# Int#, Int# #)\n    check i = case indexBigNat# bn i of\n                0## -> check (i -# 1#)\n                w   -> (# wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)\n                        , case w `and#` (w `minusWord#` 1##) of\n                            0## -> test (i -# 1#)\n                            _   -> 1# #)\n    test :: Int# -> Int#\n    test i = if isTrue# (i <# 0#)\n                then 0#\n                else case indexBigNat# bn i of\n                        0## -> test (i -# 1#)\n                        _   -> 1#\n\n\n-- Assumption: Integer and Int# are strictly positive, Int# is less\n-- than logBase 2 of Integer, otherwise havoc ensues.\n-- Used only for the numerator in fromRational when the denominator\n-- is a power of 2.\n-- The Int# argument is log2 n minus the number of bits in the mantissa\n-- of the target type, i.e. the index of the first non-integral bit in\n-- the quotient.\n--\n-- 0# means round down (towards zero)\n-- 1# means we have a half-integer, round to even\n-- 2# means round up (away from zero)\nroundingMode# :: Integer -> Int# -> Int#\nroundingMode# (S# i#) t =\n    case int2Word# i# `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of\n      k -> case uncheckedShiftL# 1## t of\n            c -> if isTrue# (c `gtWord#` k)\n                    then 0#\n                    else if isTrue# (c `ltWord#` k)\n                            then 2#\n                            else 1#\n\nroundingMode# (Jn# bn) t = roundingMode# (Jp# bn) t -- dummy\nroundingMode# (Jp# bn) t =\n    case word2Int# (int2Word# t `and#` MMASK##) of\n      j ->      -- index of relevant bit in word\n        case uncheckedIShiftRA# t WSHIFT# of\n          k ->  -- index of relevant word\n            case indexBigNat# bn k `and#`\n                    ((uncheckedShiftL# 2## j) `minusWord#` 1##) of\n              r ->\n                case uncheckedShiftL# 1## j of\n                  c -> if isTrue# (c `gtWord#` r)\n                        then 0#\n                        else if isTrue# (c `ltWord#` r)\n\n\n                                then 2#\n                                else test (k -# 1#)\n  where\n    test i = if isTrue# (i <# 0#)\n                then 1#\n                else case indexBigNat# bn i of\n                        0## -> test (i -# 1#)\n                        _   -> 2#\n", "num_lines": 119}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Integer\n-- Copyright   :  (c) Ian Lynagh 2007-2012\n-- License     :  BSD3\n--\n-- Maintainer  :  igloo@earth.li\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- A simple definition of the 'Integer' type.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Integer (\n    Integer, mkInteger,\n    smallInteger, wordToInteger, integerToWord, integerToInt,\n#if WORD_SIZE_IN_BITS < 64\n    integerToWord64, word64ToInteger,\n    integerToInt64, int64ToInteger,\n#endif\n    plusInteger, minusInteger, timesInteger, negateInteger,\n    eqInteger, neqInteger, absInteger, signumInteger,\n    leInteger, gtInteger, ltInteger, geInteger, compareInteger,\n    eqInteger#, neqInteger#,\n    leInteger#, gtInteger#, ltInteger#, geInteger#,\n    divInteger, modInteger,\n    divModInteger, quotRemInteger, quotInteger, remInteger,\n    encodeFloatInteger, decodeFloatInteger, floatFromInteger,\n    encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,\n    gcdInteger, lcmInteger,\n    andInteger, orInteger, xorInteger, complementInteger,\n    shiftLInteger, shiftRInteger, testBitInteger,\n    popCountInteger, bitInteger,\n    hashInteger,\n ) where\n\nimport GHC.Integer.Type\n\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}\nmodule GHC.Integer.Logarithms\n    ( integerLogBase#\n    , integerLog2#\n    , wordLog2#\n    ) where\n\nimport GHC.Prim\nimport GHC.Integer\nimport qualified GHC.Integer.Logarithms.Internals as I\n\n-- | Calculate the integer logarithm for an arbitrary base.\n--   The base must be greater than 1, the second argument, the number\n--   whose logarithm is sought, should be positive, otherwise the\n--   result is meaningless.\n--\n-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)\n--\n-- for @base > 1@ and @m > 0@.\nintegerLogBase# :: Integer -> Integer -> Int#\nintegerLogBase# b m = case step b of\n                        (# _, e #) -> e\n  where\n    step pw =\n      if m `ltInteger` pw\n        then (# m, 0# #)\n        else case step (pw `timesInteger` pw) of\n               (# q, e #) ->\n                 if q `ltInteger` pw\n                   then (# q, 2# *# e #)\n                   else (# q `quotInteger` pw, 2# *# e +# 1# #)\n\n-- | Calculate the integer base 2 logarithm of an 'Integer'.\n--   The calculation is more efficient than for the general case,\n--   on platforms with 32- or 64-bit words much more efficient.\n--\n--  The argument must be strictly positive, that condition is /not/ checked.\nintegerLog2# :: Integer -> Int#\nintegerLog2# = I.integerLog2#\n\n-- | This function calculates the integer base 2 logarithm of a 'Word#'.\nwordLog2# :: Word# -> Int#\nwordLog2# = I.wordLog2#\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, BangPatterns, UnboxedTuples,\n             UnliftedFFITypes #-}\n\n-- Commentary of Integer library is located on the wiki:\n-- http://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer\n--\n-- It gives an in-depth description of implementation details and\n-- decisions.\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Integer.Type\n-- Copyright   :  (c) Ian Lynagh 2007-2012\n-- License     :  BSD3\n--\n-- Maintainer  :  igloo@earth.li\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- A simple definition of the 'Integer' type.\n--\n-----------------------------------------------------------------------------\n\n#include \"MachDeps.h\"\n\nmodule GHC.Integer.Type where\n\nimport GHC.Prim\nimport GHC.Classes\nimport GHC.Types\nimport GHC.Tuple ()\n#if WORD_SIZE_IN_BITS < 64\nimport GHC.IntWord64\n#endif\n\ndata Integer = Positive !Positive | Negative !Positive | Naught\n\n-------------------------------------------------------------------\n-- The hard work is done on positive numbers\n\n-- Least significant bit is first\n\n-- Positive's have the property that they contain at least one Bit,\n-- and their last Bit is One.\ntype Positive = Digits\ntype Positives = List Positive\n\ndata Digits = Some !Digit !Digits\n            | None\ntype Digit = Word#\n\n-- XXX Could move [] above us\ndata List a = Nil | Cons a (List a)\n\nmkInteger :: Bool   -- non-negative?\n          -> [Int]  -- absolute value in 31 bit chunks, least significant first\n                    -- ideally these would be Words rather than Ints, but\n                    -- we don't have Word available at the moment.\n          -> Integer\nmkInteger nonNegative is = let abs = f is\n                           in if nonNegative then abs else negateInteger abs\n    where f [] = Naught\n          f (I# i : is') = smallInteger i `orInteger` shiftLInteger (f is') 31#\n\nerrorInteger :: Integer\nerrorInteger = Positive errorPositive\n\nerrorPositive :: Positive\nerrorPositive = Some 47## None -- Random number\n\n{-# NOINLINE smallInteger #-}\nsmallInteger :: Int# -> Integer\nsmallInteger i = if isTrue# (i >=# 0#) then wordToInteger (int2Word# i)\n                 else -- XXX is this right for -minBound?\n                      negateInteger (wordToInteger (int2Word# (negateInt# i)))\n\n{-# NOINLINE wordToInteger #-}\nwordToInteger :: Word# -> Integer\nwordToInteger w = if isTrue# (w `eqWord#` 0##)\n                  then Naught\n                  else Positive (Some w None)\n\n{-# NOINLINE integerToWord #-}\nintegerToWord :: Integer -> Word#\nintegerToWord (Positive (Some w _)) = w\nintegerToWord (Negative (Some w _)) = 0## `minusWord#` w\n-- Must be Naught by the invariant:\nintegerToWord _ = 0##\n\n{-# NOINLINE integerToInt #-}\nintegerToInt :: Integer -> Int#\nintegerToInt i = word2Int# (integerToWord i)\n\n#if WORD_SIZE_IN_BITS == 64\n-- Nothing\n#elif WORD_SIZE_IN_BITS == 32\n{-# NOINLINE integerToWord64 #-}\nintegerToWord64 :: Integer -> Word64#\nintegerToWord64 i = int64ToWord64# (integerToInt64 i)\n\n{-# NOINLINE word64ToInteger #-}\nword64ToInteger:: Word64# -> Integer\nword64ToInteger w = if isTrue# (w `eqWord64#` wordToWord64# 0##)\n                    then Naught\n                    else Positive (word64ToPositive w)\n\n{-# NOINLINE integerToInt64 #-}\nintegerToInt64 :: Integer -> Int64#\nintegerToInt64 Naught = intToInt64# 0#\nintegerToInt64 (Positive p) = word64ToInt64# (positiveToWord64 p)\nintegerToInt64 (Negative p)\n    = negateInt64# (word64ToInt64# (positiveToWord64 p))\n\n{-# NOINLINE int64ToInteger #-}\nint64ToInteger :: Int64# -> Integer\nint64ToInteger i\n = if isTrue# (i `eqInt64#` intToInt64# 0#)\n   then Naught\n   else if isTrue# (i `gtInt64#` intToInt64# 0#)\n   then Positive (word64ToPositive (int64ToWord64# i))\n   else Negative (word64ToPositive (int64ToWord64# (negateInt64# i)))\n#else\n#error WORD_SIZE_IN_BITS not supported\n#endif\n\noneInteger :: Integer\noneInteger = Positive onePositive\n\nnegativeOneInteger :: Integer\nnegativeOneInteger = Negative onePositive\n\ntwoToTheThirtytwoInteger :: Integer\ntwoToTheThirtytwoInteger = Positive twoToTheThirtytwoPositive\n\n{-# NOINLINE encodeDoubleInteger #-}\nencodeDoubleInteger :: Integer -> Int# -> Double#\nencodeDoubleInteger (Positive ds0) e0 = f 0.0## ds0 e0\n    where f !acc None        (!_) = acc\n          f !acc (Some d ds) !e   = f (acc +## encodeDouble# d e)\n                                      ds\n                                      -- XXX We assume that this adding to e\n                                      -- isn't going to overflow\n                                      (e +# WORD_SIZE_IN_BITS#)\nencodeDoubleInteger (Negative ds) e\n    = negateDouble# (encodeDoubleInteger (Positive ds) e)\nencodeDoubleInteger Naught _ = 0.0##\n\nforeign import ccall unsafe \"__word_encodeDouble\"\n        encodeDouble# :: Word# -> Int# -> Double#\n\n{-# NOINLINE encodeFloatInteger #-}\nencodeFloatInteger :: Integer -> Int# -> Float#\nencodeFloatInteger (Positive ds0) e0 = f 0.0# ds0 e0\n    where f !acc None        (!_) = acc\n          f !acc (Some d ds) !e   = f (acc `plusFloat#` encodeFloat# d e)\n                                      ds\n                                      -- XXX We assume that this adding to e\n                                      -- isn't going to overflow\n                                      (e +# WORD_SIZE_IN_BITS#)\nencodeFloatInteger (Negative ds) e\n    = negateFloat# (encodeFloatInteger (Positive ds) e)\nencodeFloatInteger Naught _ = 0.0#\n\nforeign import ccall unsafe \"__word_encodeFloat\"\n    encodeFloat# :: Word# -> Int# -> Float#\n\n{-# NOINLINE decodeFloatInteger #-}\ndecodeFloatInteger :: Float# -> (# Integer, Int# #)\ndecodeFloatInteger f = case decodeFloat_Int# f of\n                       (# mant, exp #) -> (# smallInteger mant, exp #)\n\n-- XXX This could be optimised better, by either (word-size dependent)\n-- using single 64bit value for the mantissa, or doing the multiplication\n-- by just building the Digits directly\n{-# NOINLINE decodeDoubleInteger #-}\ndecodeDoubleInteger :: Double# -> (# Integer, Int# #)\ndecodeDoubleInteger d\n = case decodeDouble_2Int# d of\n   (# mantSign, mantHigh, mantLow, exp #) ->\n       (# (smallInteger mantSign) `timesInteger`\n          (  (wordToInteger mantHigh `timesInteger` twoToTheThirtytwoInteger)\n             `plusInteger` wordToInteger mantLow),\n          exp #)\n\n{-# NOINLINE doubleFromInteger #-}\ndoubleFromInteger :: Integer -> Double#\ndoubleFromInteger Naught = 0.0##\ndoubleFromInteger (Positive p) = doubleFromPositive p\ndoubleFromInteger (Negative p) = negateDouble# (doubleFromPositive p)\n\n{-# NOINLINE floatFromInteger #-}\nfloatFromInteger :: Integer -> Float#\nfloatFromInteger Naught = 0.0#\nfloatFromInteger (Positive p) = floatFromPositive p\nfloatFromInteger (Negative p) = negateFloat# (floatFromPositive p)\n\n{-# NOINLINE andInteger #-}\nandInteger :: Integer -> Integer -> Integer\nNaught     `andInteger` (!_)       = Naught\n(!_)       `andInteger` Naught     = Naught\nPositive x `andInteger` Positive y = digitsToInteger (x `andDigits` y)\n{-\nTo calculate x & -y we need to calculate\n    x & twosComplement y\nThe (imaginary) sign bits are 0 and 1, so &ing them give 0, i.e. positive.\nNote that\n    twosComplement y\nhas infinitely many 1s, but x has a finite number of digits, so andDigits\nwill return a finite result.\n-}\nPositive x `andInteger` Negative y = let y' = twosComplementPositive y\n                                         z = y' `andDigitsOnes` x\n                                     in digitsToInteger z\nNegative x `andInteger` Positive y = Positive y `andInteger` Negative x\n{-\nTo calculate -x & -y, naively we need to calculate\n    twosComplement (twosComplement x & twosComplement y)\nbut\n    twosComplement x & twosComplement y\nhas infinitely many 1s, so this won't work. Thus we use de Morgan's law\nto get\n    -x & -y = !(!(-x) | !(-y))\n            = !(!(twosComplement x) | !(twosComplement y))\n            = !(!(!x + 1) | (!y + 1))\n            = !((x - 1) | (y - 1))\nbut the result is negative, so we need to take the two's complement of\nthis in order to get the magnitude of the result.\n    twosComplement !((x - 1) | (y - 1))\n            = !(!((x - 1) | (y - 1))) + 1\n            = ((x - 1) | (y - 1)) + 1\n-}\n-- We don't know that x and y are /strictly/ greater than 1, but\n-- minusPositive gives us the required answer anyway.\nNegative x `andInteger` Negative y = let x' = x `minusPositive` onePositive\n                                         y' = y `minusPositive` onePositive\n                                         z = x' `orDigits` y'\n                                         -- XXX Cheating the precondition:\n                                         z' = succPositive z\n                                     in digitsToNegativeInteger z'\n\n{-# NOINLINE orInteger #-}\norInteger :: Integer -> Integer -> Integer\nNaught     `orInteger` (!i)       = i\n(!i)       `orInteger` Naught     = i\nPositive x `orInteger` Positive y = Positive (x `orDigits` y)\n{-\nx | -y = - (twosComplement (x | twosComplement y))\n       = - (twosComplement !(!x & !(twosComplement y)))\n       = - (twosComplement !(!x & !(!y + 1)))\n       = - (twosComplement !(!x & (y - 1)))\n       = - ((!x & (y - 1)) + 1)\n-}\nPositive x `orInteger` Negative y = let x' = flipBits x\n                                        y' = y `minusPositive` onePositive\n                                        z = x' `andDigitsOnes` y'\n                                        z' = succPositive z\n                                    in digitsToNegativeInteger z'\nNegative x `orInteger` Positive y = Positive y `orInteger` Negative x\n{-\n-x | -y = - (twosComplement (twosComplement x | twosComplement y))\n        = - (twosComplement !(!(twosComplement x) & !(twosComplement y)))\n        = - (twosComplement !(!(!x + 1) & !(!y + 1)))\n        = - (twosComplement !((x - 1) & (y - 1)))\n        = - (((x - 1) & (y - 1)) + 1)\n-}\nNegative x `orInteger` Negative y = let x' = x `minusPositive` onePositive\n                                        y' = y `minusPositive` onePositive\n                                        z = x' `andDigits` y'\n                                        z' = succPositive z\n                                    in digitsToNegativeInteger z'\n\n{-# NOINLINE xorInteger #-}\nxorInteger :: Integer -> Integer -> Integer\nNaught     `xorInteger` (!i)       = i\n(!i)       `xorInteger` Naught     = i\nPositive x `xorInteger` Positive y = digitsToInteger (x `xorDigits` y)\n{-\nx ^ -y = - (twosComplement (x ^ twosComplement y))\n       = - (twosComplement !(x ^ !(twosComplement y)))\n       = - (twosComplement !(x ^ !(!y + 1)))\n       = - (twosComplement !(x ^ (y - 1)))\n       = - ((x ^ (y - 1)) + 1)\n-}\nPositive x `xorInteger` Negative y = let y' = y `minusPositive` onePositive\n                                         z = x `xorDigits` y'\n                                         z' = succPositive z\n                                     in digitsToNegativeInteger z'\nNegative x `xorInteger` Positive y = Positive y `xorInteger` Negative x\n{-\n-x ^ -y = twosComplement x ^ twosComplement y\n        = (!x + 1) ^ (!y + 1)\n        = (!x + 1) ^ (!y + 1)\n        = !(!x + 1) ^ !(!y + 1)\n        = (x - 1) ^ (y - 1)\n-}\nNegative x `xorInteger` Negative y = let x' = x `minusPositive` onePositive\n                                         y' = y `minusPositive` onePositive\n                                         z = x' `xorDigits` y'\n                                     in digitsToInteger z\n\n{-# NOINLINE complementInteger #-}\ncomplementInteger :: Integer -> Integer\ncomplementInteger x = negativeOneInteger `minusInteger` x\n\n{-# NOINLINE shiftLInteger #-}\nshiftLInteger :: Integer -> Int# -> Integer\nshiftLInteger (Positive p) i = Positive (shiftLPositive p i)\nshiftLInteger (Negative n) i = Negative (shiftLPositive n i)\nshiftLInteger Naught       _ = Naught\n\n{-# NOINLINE shiftRInteger #-}\nshiftRInteger :: Integer -> Int# -> Integer\nshiftRInteger (Positive p)   i = shiftRPositive p i\nshiftRInteger j@(Negative _) i\n    = complementInteger (shiftRInteger (complementInteger j) i)\nshiftRInteger Naught         _ = Naught\n\n{-# NOINLINE popCountInteger #-}\npopCountInteger :: Integer -> Int#\npopCountInteger (Positive p) = popCountPositive p\npopCountInteger Naught       = 0#\npopCountInteger (Negative n) = negateInt# (popCountPositive n)\n\npopCountPositive :: Positive -> Int#\npopCountPositive p = word2Int# (go 0## p)\n  where\n  go :: Word# -> Positive -> Word#\n  go acc# None = acc#\n  go acc# (Some d ds) = go (popCnt# d `plusWord#` acc#) ds\n\n{-# NOINLINE bitInteger #-}\n-- | 'Integer' for which only /n/-th bit is set. Undefined behaviour\n-- for negative /n/ values.\nbitInteger :: Int# -> Integer\nbitInteger i# = if isTrue# (i# <# 0#)\n                then Naught\n                else Positive (bitPositive i#)\n\n-- Assumes 0 <= i\nbitPositive :: Int# -> Positive\nbitPositive i#\n    = if isTrue# (i# >=# WORD_SIZE_IN_BITS#)\n      then Some 0## (bitPositive (i# -# WORD_SIZE_IN_BITS#))\n      else Some (uncheckedShiftL# 1## i#) None\n\n{-# NOINLINE testBitInteger #-}\ntestBitInteger :: Integer -> Int# -> Bool\ntestBitInteger (!_) i# | isTrue# (i# <# 0#) = False\ntestBitInteger Naught       _  = False\ntestBitInteger (Positive p) i# = isTrue# (testBitPositive p i#)\n  where\n  -- Straightforward decrement of 'j#' by the word size stopping when\n  -- 'j#' is less than the word size or the number runs out.\n  testBitPositive :: Positive -> Int# -> Int#\n  testBitPositive None          _ = 0#\n  testBitPositive (Some w# ws)  j#\n    = if isTrue# (j# >=# WORD_SIZE_IN_BITS#)\n      then testBitPositive ws (j# -# WORD_SIZE_IN_BITS#)\n      else neWord# (uncheckedShiftL# 1## j# `and#` w#) 0##\ntestBitInteger (Negative n) i# = isTrue# (testBitNegative n i#)\n  where\n  -- For negative numbers, we want to inspect the correct bit of the two's\n  -- complement. Like for positive numbers, we walk down the words until\n  -- 'j#' is less than the word size (or the number runs out).\n  testBitNegative :: Positive -> Int# -> Int#\n  testBitNegative (Some 0## ws) j#\n    -- If the number starts (on the low end) with a bunch of '0##' and 'j#'\n    -- falls in those, we know that @n - 1@ would have flipped all those\n    -- bits, so @!(n - 1) & i@ is false.\n    = if isTrue# (j# >=# WORD_SIZE_IN_BITS#)\n      then testBitNegative ws (j# -# WORD_SIZE_IN_BITS#)\n      else 1#\n  testBitNegative (Some w# ws) j#\n    -- Yet, as soon as we find something that isn't a '0##', we can subtract\n    -- and forget about the 1 altogether!\n    = testBitNegativeMinus1 (Some (w# `minusWord#` 1##) ws) j#\n  testBitNegative None _ = 0# -- XXX Can't happen due to Positive's invariant\n\n  testBitNegativeMinus1 :: Positive -> Int# -> Int#\n  testBitNegativeMinus1 None         _ = 1#\n  testBitNegativeMinus1 (Some w# ws) j#\n    = if isTrue# (j# >=# WORD_SIZE_IN_BITS#)\n      then testBitNegativeMinus1 ws (j# -# WORD_SIZE_IN_BITS#)\n      else neWord# (uncheckedShiftL# 1## j# `and#` not# w#) 0##\n\ntwosComplementPositive :: Positive -> DigitsOnes\ntwosComplementPositive p = flipBits (p `minusPositive` onePositive)\n\nflipBits :: Digits -> DigitsOnes\nflipBits ds = DigitsOnes (flipBitsDigits ds)\n\nflipBitsDigits :: Digits -> Digits\nflipBitsDigits None = None\nflipBitsDigits (Some w ws) = Some (not# w) (flipBitsDigits ws)\n\n{-# NOINLINE negateInteger #-}\nnegateInteger :: Integer -> Integer\nnegateInteger (Positive p) = Negative p\nnegateInteger (Negative p) = Positive p\nnegateInteger Naught       = Naught\n\n-- Note [Avoid patError]\n{-# NOINLINE plusInteger #-}\nplusInteger :: Integer -> Integer -> Integer\nPositive p1    `plusInteger` Positive p2 = Positive (p1 `plusPositive` p2)\nNegative p1    `plusInteger` Negative p2 = Negative (p1 `plusPositive` p2)\nPositive p1    `plusInteger` Negative p2\n    = case p1 `comparePositive` p2 of\n      GT -> Positive (p1 `minusPositive` p2)\n      EQ -> Naught\n      LT -> Negative (p2 `minusPositive` p1)\nNegative p1    `plusInteger` Positive p2\n    = Positive p2 `plusInteger` Negative p1\nNaught         `plusInteger` Naught         = Naught\nNaught         `plusInteger` i@(Positive _) = i\nNaught         `plusInteger` i@(Negative _) = i\ni@(Positive _) `plusInteger` Naught         = i\ni@(Negative _) `plusInteger` Naught         = i\n\n{-# NOINLINE minusInteger #-}\nminusInteger :: Integer -> Integer -> Integer\ni1 `minusInteger` i2 = i1 `plusInteger` negateInteger i2\n\n{-# NOINLINE timesInteger #-}\ntimesInteger :: Integer -> Integer -> Integer\nPositive p1 `timesInteger` Positive p2 = Positive (p1 `timesPositive` p2)\nNegative p1 `timesInteger` Negative p2 = Positive (p1 `timesPositive` p2)\nPositive p1 `timesInteger` Negative p2 = Negative (p1 `timesPositive` p2)\nNegative p1 `timesInteger` Positive p2 = Negative (p1 `timesPositive` p2)\n(!_)        `timesInteger` (!_)        = Naught\n\n{-# NOINLINE divModInteger #-}\ndivModInteger :: Integer -> Integer -> (# Integer, Integer #)\nn `divModInteger` d =\n    case n `quotRemInteger` d of\n        (# q, r #) ->\n            if signumInteger r `eqInteger`\n               negateInteger (signumInteger d)\n            then (# q `minusInteger` oneInteger, r `plusInteger` d #)\n            else (# q, r #)\n\n{-# NOINLINE divInteger #-}\ndivInteger :: Integer -> Integer -> Integer\nn `divInteger` d = quotient\n    where (# quotient, _ #) = n `divModInteger` d\n\n{-# NOINLINE modInteger #-}\nmodInteger :: Integer -> Integer -> Integer\nn `modInteger` d = modulus\n    where (# _, modulus #) = n `divModInteger` d\n\n{-# NOINLINE quotRemInteger #-}\nquotRemInteger :: Integer -> Integer -> (# Integer, Integer #)\nNaught      `quotRemInteger` (!_)        = (# Naught, Naught #)\n(!_)        `quotRemInteger` Naught\n    = (# errorInteger, errorInteger #) -- XXX Can't happen\n-- XXX _            `quotRemInteger` Naught     = error \"Division by zero\"\nPositive p1 `quotRemInteger` Positive p2 = p1 `quotRemPositive` p2\nNegative p1 `quotRemInteger` Positive p2 = case p1 `quotRemPositive` p2 of\n                                           (# q, r #) ->\n                                               (# negateInteger q,\n                                                  negateInteger r #)\nPositive p1 `quotRemInteger` Negative p2 = case p1 `quotRemPositive` p2 of\n                                           (# q, r #) ->\n                                               (# negateInteger q, r #)\nNegative p1 `quotRemInteger` Negative p2 = case p1 `quotRemPositive` p2 of\n                                           (# q, r #) ->\n                                               (# q, negateInteger r #)\n\n{-# NOINLINE quotInteger #-}\nquotInteger :: Integer -> Integer -> Integer\nx `quotInteger` y = case x `quotRemInteger` y of\n                    (# q, _ #) -> q\n\n{-# NOINLINE remInteger #-}\nremInteger :: Integer -> Integer -> Integer\nx `remInteger` y = case x `quotRemInteger` y of\n                   (# _, r #) -> r\n\n{-# NOINLINE gcdInteger #-}\ngcdInteger :: Integer -> Integer -> Integer\ngcdInteger (Positive a) (Positive b) = Positive (gcdPositive a b)\ngcdInteger (Positive a) (Negative b) = Positive (gcdPositive a b)\ngcdInteger (Negative a) (Positive b) = Positive (gcdPositive a b)\ngcdInteger (Negative a) (Negative b) = Positive (gcdPositive a b)\ngcdInteger Naught                  b = absInteger b\ngcdInteger a                  Naught = absInteger a\n\ngcdPositive :: Positive -> Positive -> Positive\ngcdPositive p1 p2 = case p1 `quotRemPositive` p2 of\n                        (# _, Positive r #) -> gcdPositive p2 r\n                        (# _, Naught     #) -> p2\n                        (# _, Negative _ #) -> errorPositive -- XXX Can't happen\n\n\n{-# NOINLINE lcmInteger #-}\nlcmInteger :: Integer -> Integer -> Integer\nlcmInteger (Positive a) (Positive b) = Positive (lcmPositive a b)\nlcmInteger (Positive a) (Negative b) = Positive (lcmPositive a b)\nlcmInteger (Negative a) (Positive b) = Positive (lcmPositive a b)\nlcmInteger (Negative a) (Negative b) = Positive (lcmPositive a b)\nlcmInteger Naught                  _ = Naught\nlcmInteger _                  Naught = Naught\n\nlcmPositive :: Positive -> Positive -> Positive\nlcmPositive p1 p2 = case p1 `quotRemPositive` (p1 `gcdPositive` p2) of\n                        (# Positive q, _ #) -> q `timesPositive` p2\n                        (# _,          _ #) -> errorPositive -- XXX Can't happen\n\n\n{-# NOINLINE compareInteger #-}\ncompareInteger :: Integer -> Integer -> Ordering\nPositive x `compareInteger` Positive y = x `comparePositive` y\nPositive _ `compareInteger` (!_)       = GT\nNaught     `compareInteger` Naught     = EQ\nNaught     `compareInteger` Negative _ = GT\nNegative x `compareInteger` Negative y = y `comparePositive` x\n(!_)       `compareInteger` (!_)       = LT\n\n{-# NOINLINE eqInteger# #-}\neqInteger# :: Integer -> Integer -> Int#\nx `eqInteger#` y = case x `compareInteger` y of\n                        EQ -> 1#\n                        _  -> 0#\n\n{-# NOINLINE neqInteger# #-}\nneqInteger# :: Integer -> Integer -> Int#\nx `neqInteger#` y = case x `compareInteger` y of\n                         EQ -> 0#\n                         _  -> 1#\n\n{-# INLINE eqInteger  #-}\n{-# INLINE neqInteger #-}\neqInteger, neqInteger :: Integer -> Integer -> Bool\neqInteger  a b = isTrue# (a `eqInteger#`  b)\nneqInteger a b = isTrue# (a `neqInteger#` b)\n\ninstance  Eq Integer  where\n    (==) = eqInteger\n    (/=) = neqInteger\n\n{-# NOINLINE ltInteger# #-}\nltInteger# :: Integer -> Integer -> Int#\nx `ltInteger#` y = case x `compareInteger` y of\n                        LT -> 1#\n                        _  -> 0#\n\n{-# NOINLINE gtInteger# #-}\ngtInteger# :: Integer -> Integer -> Int#\nx `gtInteger#` y = case x `compareInteger` y of\n                        GT -> 1#\n                        _  -> 0#\n\n{-# NOINLINE leInteger# #-}\nleInteger# :: Integer -> Integer -> Int#\nx `leInteger#` y = case x `compareInteger` y of\n                        GT -> 0#\n                        _  -> 1#\n\n{-# NOINLINE geInteger# #-}\ngeInteger# :: Integer -> Integer -> Int#\nx `geInteger#` y = case x `compareInteger` y of\n                        LT -> 0#\n                        _  -> 1#\n\n{-# INLINE leInteger #-}\n{-# INLINE ltInteger #-}\n{-# INLINE geInteger #-}\n{-# INLINE gtInteger #-}\nleInteger, gtInteger, ltInteger, geInteger :: Integer -> Integer -> Bool\nleInteger a b = isTrue# (a `leInteger#` b)\ngtInteger a b = isTrue# (a `gtInteger#` b)\nltInteger a b = isTrue# (a `ltInteger#` b)\ngeInteger a b = isTrue# (a `geInteger#` b)\n\ninstance Ord Integer where\n    (<=) = leInteger\n    (>)  = gtInteger\n    (<)  = ltInteger\n    (>=) = geInteger\n    compare = compareInteger\n\n{-# NOINLINE absInteger #-}\nabsInteger :: Integer -> Integer\nabsInteger (Negative x) = Positive x\nabsInteger x = x\n\n{-# NOINLINE signumInteger #-}\nsignumInteger :: Integer -> Integer\nsignumInteger (Negative _) = negativeOneInteger\nsignumInteger Naught       = Naught\nsignumInteger (Positive _) = oneInteger\n\n{-# NOINLINE hashInteger #-}\nhashInteger :: Integer -> Int#\nhashInteger = integerToInt\n\n-------------------------------------------------------------------\n-- The hard work is done on positive numbers\n\nonePositive :: Positive\nonePositive = Some 1## None\n\nhalfBoundUp, fullBound :: () -> Digit\nlowHalfMask :: () -> Digit\nhighHalfShift :: () -> Int#\ntwoToTheThirtytwoPositive :: Positive\n#if WORD_SIZE_IN_BITS == 64\nhalfBoundUp   () = 0x8000000000000000##\nfullBound     () = 0xFFFFFFFFFFFFFFFF##\nlowHalfMask   () = 0xFFFFFFFF##\nhighHalfShift () = 32#\ntwoToTheThirtytwoPositive = Some 0x100000000## None\n#elif WORD_SIZE_IN_BITS == 32\nhalfBoundUp   () = 0x80000000##\nfullBound     () = 0xFFFFFFFF##\nlowHalfMask   () = 0xFFFF##\nhighHalfShift () = 16#\ntwoToTheThirtytwoPositive = Some 0## (Some 1## None)\n#else\n#error Unhandled WORD_SIZE_IN_BITS\n#endif\n\ndigitsMaybeZeroToInteger :: Digits -> Integer\ndigitsMaybeZeroToInteger None = Naught\ndigitsMaybeZeroToInteger ds = Positive ds\n\ndigitsToInteger :: Digits -> Integer\ndigitsToInteger ds = case removeZeroTails ds of\n                     None -> Naught\n                     ds' -> Positive ds'\n\ndigitsToNegativeInteger :: Digits -> Integer\ndigitsToNegativeInteger ds = case removeZeroTails ds of\n                             None -> Naught\n                             ds' -> Negative ds'\n\nremoveZeroTails :: Digits -> Digits\nremoveZeroTails (Some w ds) = if isTrue# (w `eqWord#` 0##)\n                              then case removeZeroTails ds of\n                                   None -> None\n                                   ds' -> Some w ds'\n                              else Some w (removeZeroTails ds)\nremoveZeroTails None = None\n\n#if WORD_SIZE_IN_BITS < 64\nword64ToPositive :: Word64# -> Positive\nword64ToPositive w\n = if isTrue# (w `eqWord64#` wordToWord64# 0##)\n   then None\n   else Some (word64ToWord# w) (word64ToPositive (w `uncheckedShiftRL64#` 32#))\n\npositiveToWord64 :: Positive -> Word64#\npositiveToWord64 None = wordToWord64# 0## -- XXX Can't happen\npositiveToWord64 (Some w None) = wordToWord64# w\npositiveToWord64 (Some low (Some high _))\n    = wordToWord64# low `or64#` (wordToWord64# high `uncheckedShiftL64#` 32#)\n#endif\n\n-- Note [Avoid patError]\ncomparePositive :: Positive -> Positive -> Ordering\nSome x xs `comparePositive` Some y ys = case xs `comparePositive` ys of\n                                        EQ ->      if isTrue# (x `ltWord#` y) then LT\n                                              else if isTrue# (x `gtWord#` y) then GT\n                                              else                                 EQ\n                                        res -> res\nNone      `comparePositive` None      = EQ\n(Some {}) `comparePositive` None      = GT\nNone      `comparePositive` (Some {}) = LT\n\nplusPositive :: Positive -> Positive -> Positive\nplusPositive x0 y0 = addWithCarry 0## x0 y0\n where -- digit `elem` [0, 1]\n       -- Note [Avoid patError]\n       addWithCarry :: Digit -> Positive -> Positive -> Positive\n       addWithCarry c None            None            = addOnCarry c None\n       addWithCarry c xs@(Some {})    None            = addOnCarry c xs\n       addWithCarry c None            ys@(Some {})    = addOnCarry c ys\n       addWithCarry c xs@(Some x xs') ys@(Some y ys')\n        = if isTrue# (x `ltWord#` y) then addWithCarry c ys xs\n          -- Now x >= y\n          else if isTrue# (y `geWord#` halfBoundUp ())\n               -- So they are both at least halfBoundUp, so we subtract\n               -- halfBoundUp from each and thus carry 1\n               then case x `minusWord#` halfBoundUp () of\n                    x' ->\n                     case y `minusWord#` halfBoundUp () of\n                     y' ->\n                      case x' `plusWord#` y' `plusWord#` c of\n                      this ->\n                       Some this withCarry\n          else if isTrue# (x `geWord#` halfBoundUp ())\n               then case x `minusWord#` halfBoundUp () of\n                    x' ->\n                     case x' `plusWord#` y `plusWord#` c of\n                     z ->\n                      -- We've taken off halfBoundUp, so now we need to\n                      -- add it back on\n                      if isTrue# (z `ltWord#` halfBoundUp ())\n                       then Some (z `plusWord#`  halfBoundUp ()) withoutCarry\n                       else Some (z `minusWord#` halfBoundUp ()) withCarry\n          else Some (x `plusWord#` y `plusWord#` c) withoutCarry\n           where withCarry    = addWithCarry 1## xs' ys'\n                 withoutCarry = addWithCarry 0## xs' ys'\n\n       -- digit `elem` [0, 1]\n       addOnCarry :: Digit -> Positive -> Positive\n       addOnCarry (!c) (!ws) = if isTrue# (c `eqWord#` 0##)\n                               then ws\n                               else succPositive ws\n\n-- digit `elem` [0, 1]\nsuccPositive :: Positive -> Positive\nsuccPositive None = Some 1## None\nsuccPositive (Some w ws) = if isTrue# (w `eqWord#` fullBound ())\n                           then Some 0## (succPositive ws)\n                           else Some (w `plusWord#` 1##) ws\n\n-- Requires x > y\n-- In recursive calls, x >= y and x == y => result is None\n-- Note [Avoid patError]\nminusPositive :: Positive -> Positive -> Positive\nSome x xs `minusPositive` Some y ys\n = if isTrue# (x `eqWord#` y)\n   then case xs `minusPositive` ys of\n        None -> None\n        s -> Some 0## s\n   else if isTrue# (x `gtWord#` y) then\n        Some (x `minusWord#` y) (xs `minusPositive` ys)\n   else case (fullBound () `minusWord#` y) `plusWord#` 1## of\n        z -> -- z = 2^n - y, calculated without overflow\n         case z `plusWord#` x of\n         z' -> -- z = 2^n + (x - y), calculated without overflow\n          Some z' ((xs `minusPositive` ys) `minusPositive` onePositive)\nxs@(Some {}) `minusPositive` None      = xs\nNone         `minusPositive` None      = None\nNone         `minusPositive` (Some {}) = errorPositive -- XXX Can't happen\n-- XXX None `minusPositive` _ = error \"minusPositive: Requirement x > y not met\"\n\n-- Note [Avoid patError]\ntimesPositive :: Positive -> Positive -> Positive\n-- XXX None's can't happen here:\nNone            `timesPositive` None        = errorPositive\nNone            `timesPositive` (Some {})   = errorPositive\n(Some {})       `timesPositive` None        = errorPositive\n-- x and y are the last digits in Positive numbers, so are not 0:\nxs@(Some x xs') `timesPositive` ys@(Some y ys')\n = case xs' of\n   None ->\n       case ys' of\n           None ->\n               x `timesDigit` y\n           Some {} ->\n               ys `timesPositive` xs\n   Some {} ->\n       case ys' of\n       None ->\n           -- y is the last digit in a Positive number, so is not 0.\n           let zs = Some 0## (xs' `timesPositive` ys)\n           in -- We could actually skip this test, and everything would\n              -- turn out OK. We already play tricks like that in timesPositive.\n              if isTrue# (x `eqWord#` 0##)\n              then zs\n              else (x `timesDigit` y) `plusPositive` zs\n       Some {} ->\n           (Some x None `timesPositive` ys) `plusPositive`\n           Some 0## (xs' `timesPositive` ys)\n\n{-\n-- Requires arguments /= 0\nSuppose we have 2n bits in a Word. Then\n    x = 2^n xh + xl\n    y = 2^n yh + yl\n    x * y = (2^n xh + xl) * (2^n yh + yl)\n          = 2^(2n) (xh yh)\n          + 2^n    (xh yl)\n          + 2^n    (xl yh)\n          +        (xl yl)\n                   ~~~~~~~ - all fit in 2n bits\n-}\ntimesDigit :: Digit -> Digit -> Positive\ntimesDigit (!x) (!y)\n = case splitHalves x of\n   (# xh, xl #) ->\n    case splitHalves y of\n    (# yh, yl #) ->\n     case xh `timesWord#` yh of\n     xhyh ->\n      case splitHalves (xh `timesWord#` yl) of\n      (# xhylh, xhyll #) ->\n       case xhyll `uncheckedShiftL#` highHalfShift () of\n       xhyll' ->\n        case splitHalves (xl `timesWord#` yh) of\n        (# xlyhh, xlyhl #) ->\n         case xlyhl `uncheckedShiftL#` highHalfShift () of\n         xlyhl' ->\n          case xl `timesWord#` yl of\n          xlyl ->\n           -- Add up all the high word results. As the result fits in\n           -- 4n bits this can't overflow.\n           case xhyh `plusWord#` xhylh `plusWord#` xlyhh of\n           high ->\n           -- low: xhyll<<n + xlyhl<<n + xlyl\n            -- From this point we might make (Some 0 None), but we know\n            -- that the final result will be positive and the addition\n            -- will work out OK, so everything will work out in the end.\n            -- One thing we do need to be careful of is avoiding returning\n            -- Some 0 (Some 0 None) + Some n None, as this will result in\n            -- Some n (Some 0 None) instead of Some n None.\n            let low = Some xhyll' None `plusPositive`\n                      Some xlyhl' None `plusPositive`\n                      Some xlyl   None\n            in if isTrue# (high `eqWord#` 0##)\n               then low\n               else Some 0## (Some high None) `plusPositive` low\n\nsplitHalves :: Digit -> (# {- High -} Digit, {- Low -} Digit #)\nsplitHalves (!x) = (# x `uncheckedShiftRL#` highHalfShift (),\n                      x `and#` lowHalfMask () #)\n\n-- Assumes 0 <= i\nshiftLPositive :: Positive -> Int# -> Positive\nshiftLPositive p i\n    = if isTrue# (i >=# WORD_SIZE_IN_BITS#)\n      then shiftLPositive (Some 0## p) (i -# WORD_SIZE_IN_BITS#)\n      else smallShiftLPositive p i\n\n-- Assumes 0 <= i < WORD_SIZE_IN_BITS#\nsmallShiftLPositive :: Positive -> Int# -> Positive\nsmallShiftLPositive (!p) 0# = p\nsmallShiftLPositive (!p) (!i) =\n    case WORD_SIZE_IN_BITS# -# i of\n    j -> let f carry None = if isTrue# (carry `eqWord#` 0##)\n                            then None\n                            else Some carry None\n             f carry (Some w ws) = case w `uncheckedShiftRL#` j of\n                                   carry' ->\n                                    case w `uncheckedShiftL#` i of\n                                    me ->\n                                     Some (me `or#` carry) (f carry' ws)\n         in f 0## p\n\n-- Assumes 0 <= i\nshiftRPositive :: Positive -> Int# -> Integer\nshiftRPositive None _ = Naught\nshiftRPositive p@(Some _ q) i\n    = if isTrue# (i >=# WORD_SIZE_IN_BITS#)\n      then shiftRPositive q (i -# WORD_SIZE_IN_BITS#)\n      else smallShiftRPositive p i\n\n-- Assumes 0 <= i < WORD_SIZE_IN_BITS#\nsmallShiftRPositive :: Positive -> Int# -> Integer\nsmallShiftRPositive (!p) (!i) =\n    if isTrue# (i ==# 0#)\n    then Positive p\n    else case smallShiftLPositive p (WORD_SIZE_IN_BITS# -# i) of\n         Some _ p'@(Some _ _) -> Positive p'\n         _                    -> Naught\n\n-- Long division\nquotRemPositive :: Positive -> Positive -> (# Integer, Integer #)\n(!xs) `quotRemPositive` (!ys)\n    = case f xs of\n      (# d, m #) -> (# digitsMaybeZeroToInteger d,\n                       digitsMaybeZeroToInteger m #)\n    where\n          subtractors :: Positives\n          subtractors = mkSubtractors (WORD_SIZE_IN_BITS# -# 1#)\n\n          mkSubtractors (!n) = if isTrue# (n ==# 0#)\n                               then Cons ys Nil\n                               else Cons (ys `smallShiftLPositive` n)\n                                         (mkSubtractors (n -# 1#))\n\n          -- The main function. Go the end of xs, then walk\n          -- back trying to divide the number we accumulate by ys.\n          f :: Positive -> (# Digits, Digits #)\n          f None = (# None, None #)\n          f (Some z zs)\n              = case f zs of\n                (# ds, m #) ->\n                    let -- We need to avoid making (Some Zero None) here\n                        m' = some z m\n                    in case g 0## subtractors m' of\n                       (# d, m'' #) ->\n                        (# some d ds, m'' #)\n\n          g :: Digit -> Positives -> Digits -> (# Digit, Digits #)\n          g (!d) Nil             (!m) = (# d, m #)\n          g (!d) (Cons sub subs) (!m)\n              = case d `uncheckedShiftL#` 1# of\n                d' ->\n                 case m `comparePositive` sub of\n                 LT -> g d' subs m\n                 _  -> g (d' `plusWord#` 1##)\n                         subs\n                         (m `minusPositive` sub)\n\nsome :: Digit -> Digits -> Digits\nsome (!w) None  = if isTrue# (w `eqWord#` 0##) then None else Some w None\nsome (!w) (!ws) = Some w ws\n\n-- Note [Avoid patError]\nandDigits :: Digits -> Digits -> Digits\nandDigits None          None          = None\nandDigits (Some {})     None          = None\nandDigits None          (Some {})     = None\nandDigits (Some w1 ws1) (Some w2 ws2) = Some (w1 `and#` w2) (andDigits ws1 ws2)\n\n-- DigitsOnes is just like Digits, only None is really 0xFFFFFFF...,\n-- i.e. ones off to infinity. This makes sense when we want to \"and\"\n-- a DigitOnes with a Digits, as the latter will bound the size of the\n-- result.\nnewtype DigitsOnes = DigitsOnes Digits\n\n-- Note [Avoid patError]\nandDigitsOnes :: DigitsOnes -> Digits -> Digits\nandDigitsOnes (DigitsOnes None)          None          = None\nandDigitsOnes (DigitsOnes None)          ws2@(Some {}) = ws2\nandDigitsOnes (DigitsOnes (Some {}))     None          = None\nandDigitsOnes (DigitsOnes (Some w1 ws1)) (Some w2 ws2)\n    = Some (w1 `and#` w2) (andDigitsOnes (DigitsOnes ws1) ws2)\n\n-- Note [Avoid patError]\norDigits :: Digits -> Digits -> Digits\norDigits None          None          = None\norDigits None          ds@(Some {})  = ds\norDigits ds@(Some {})  None          = ds\norDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `or#` w2) (orDigits ds1 ds2)\n\n-- Note [Avoid patError]\nxorDigits :: Digits -> Digits -> Digits\nxorDigits None          None          = None\nxorDigits None          ds@(Some {})  = ds\nxorDigits ds@(Some {})  None          = ds\nxorDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `xor#` w2) (xorDigits ds1 ds2)\n\n-- XXX We'd really like word2Double# for this\ndoubleFromPositive :: Positive -> Double#\ndoubleFromPositive None = 0.0##\ndoubleFromPositive (Some w ds)\n    = case splitHalves w of\n      (# h, l #) ->\n       (doubleFromPositive ds *## (2.0## **## WORD_SIZE_IN_BITS_FLOAT##))\n       +## (int2Double# (word2Int# h) *##\n              (2.0## **## int2Double# (highHalfShift ())))\n       +## int2Double# (word2Int# l)\n\n-- XXX We'd really like word2Float# for this\nfloatFromPositive :: Positive -> Float#\nfloatFromPositive None = 0.0#\nfloatFromPositive (Some w ds)\n    = case splitHalves w of\n      (# h, l #) ->\n       (floatFromPositive ds `timesFloat#` (2.0# `powerFloat#` WORD_SIZE_IN_BITS_FLOAT#))\n       `plusFloat#` (int2Float# (word2Int# h) `timesFloat#`\n             (2.0# `powerFloat#` int2Float# (highHalfShift ())))\n       `plusFloat#` int2Float# (word2Int# l)\n\n{-\nNote [Avoid patError]\n\nIf we use the natural set of definitions for functions, e.g.:\n\n    orDigits None          ds            = ds\n    orDigits ds            None          = ds\n    orDigits (Some w1 ds1) (Some w2 ds2) = Some ... ...\n\nthen GHC may not be smart enough (especially when compiling with -O0)\nto see that all the cases are handled, and will thus insert calls to\nbase:Control.Exception.Base.patError. But we are below base in the\npackage hierarchy, so this causes build failure!\n\nWe therefore help GHC out, by being more explicit about what all the\ncases are:\n\n    orDigits None          None          = None\n    orDigits None          ds@(Some {})  = ds\n    orDigits ds@(Some {})  None          = ds\n    orDigits (Some w1 ds1) (Some w2 ds2) = Some ... ...\n-}\n\n", "num_lines": 984}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}\n{-# OPTIONS_HADDOCK not-home #-}\n\n#include \"MachDeps.h\"\n\n-- (Hopefully) Fast integer logarithms to base 2.\n-- integerLog2# and wordLog2# are of general usefulness,\n-- the others are only needed for a fast implementation of\n-- fromRational.\n-- Since they are needed in GHC.Float, we must expose this\n-- module, but it should not show up in the docs.\n\nmodule GHC.Integer.Logarithms.Internals\n    ( integerLog2#\n    , integerLog2IsPowerOf2#\n    , wordLog2#\n    , roundingMode#\n    ) where\n\nimport GHC.Prim\nimport GHC.Integer.Type\nimport GHC.Types\n\ndefault ()\n\n-- When larger word sizes become common, add support for those,\n-- it's not hard, just tedious.\n#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)\n\n-- We don't know whether the word has 30 bits or 128 or even more,\n-- so we can't start from the top, although that would be much more\n-- efficient.\nwordLog2# :: Word# -> Int#\nwordLog2# w = go 8# w\n  where\n    go acc u = case u `uncheckedShiftRL#` 8# of\n                0## -> case leadingZeros of\n                        BA ba -> acc -# indexInt8Array# ba (word2Int# u)\n                v   -> go (acc +# 8#) v\n\n#else\n\n-- This one at least can also be done efficiently.\n-- wordLog2# 0## = -1#\n{-# INLINE wordLog2# #-}\nwordLog2# :: Word# -> Int#\nwordLog2# w =\n  case leadingZeros of\n   BA lz ->\n    let zeros u = indexInt8Array# lz (word2Int# u) in\n#if WORD_SIZE_IN_BITS == 64\n    case uncheckedShiftRL# w 56# of\n     a ->\n      if isTrue# (a `neWord#` 0##)\n       then 64# -# zeros a\n       else\n        case uncheckedShiftRL# w 48# of\n         b ->\n          if isTrue# (b `neWord#` 0##)\n           then 56# -# zeros b\n           else\n            case uncheckedShiftRL# w 40# of\n             c ->\n              if isTrue# (c `neWord#` 0##)\n               then 48# -# zeros c\n               else\n                case uncheckedShiftRL# w 32# of\n                 d ->\n                  if isTrue# (d `neWord#` 0##)\n                   then 40# -# zeros d\n                   else\n#endif\n                    case uncheckedShiftRL# w 24# of\n                     e ->\n                      if isTrue# (e `neWord#` 0##)\n                       then 32# -# zeros e\n                       else\n                        case uncheckedShiftRL# w 16# of\n                         f ->\n                          if isTrue# (f `neWord#` 0##)\n                           then 24# -# zeros f\n                           else\n                            case uncheckedShiftRL# w 8# of\n                             g ->\n                              if isTrue# (g `neWord#` 0##)\n                               then 16# -# zeros g\n                               else  8# -# zeros w\n\n#endif\n\n-- Assumption: Integer is strictly positive,\n-- otherwise return -1# arbitrarily\n-- Going up in word-sized steps should not be too bad.\nintegerLog2# :: Integer -> Int#\nintegerLog2# (Positive digits) = step 0# digits\n  where\n    step acc (Some dig None) = acc +# wordLog2# dig\n    step acc (Some _ digs)   =\n        step (acc +# WORD_SIZE_IN_BITS#) digs\n    step acc None = acc     -- should be impossible, throw error?\nintegerLog2# _ = negateInt# 1#\n\n-- Again, integer should be strictly positive\nintegerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)\nintegerLog2IsPowerOf2# (Positive digits) = couldBe 0# digits\n  where\n    couldBe acc (Some dig None) =\n        (# acc +# wordLog2# dig, word2Int# (and# dig (minusWord# dig 1##)) #)\n    couldBe acc (Some dig digs) =\n        if isTrue# (eqWord# dig 0##)\n           then couldBe (acc +# WORD_SIZE_IN_BITS#) digs\n           else noPower (acc +# WORD_SIZE_IN_BITS#) digs\n    couldBe acc None = (# acc, 1# #) -- should be impossible, error?\n    noPower acc (Some dig None) =\n        (# acc +# wordLog2# dig, 1# #)\n    noPower acc (Some _ digs)   =\n        noPower (acc +# WORD_SIZE_IN_BITS#) digs\n    noPower acc None = (# acc, 1# #) -- should be impossible, error?\nintegerLog2IsPowerOf2# _ = (# negateInt# 1#, 1# #)\n\n-- Assumption: Integer and Int# are strictly positive, Int# is less\n-- than logBase 2 of Integer, otherwise havoc ensues.\n-- Used only for the numerator in fromRational when the denominator\n-- is a power of 2.\n-- The Int# argument is log2 n minus the number of bits in the mantissa\n-- of the target type, i.e. the index of the first non-integral bit in\n-- the quotient.\n--\n-- 0# means round down (towards zero)\n-- 1# means we have a half-integer, round to even\n-- 2# means round up (away from zero)\n-- This function should probably be improved.\nroundingMode# :: Integer -> Int# -> Int#\nroundingMode# m h =\n    case oneInteger `shiftLInteger` h of\n      c -> case m `andInteger`\n                ((c `plusInteger` c) `minusInteger` oneInteger) of\n             r ->\n               if c `ltInteger` r\n                 then 2#\n                 else if c `gtInteger` r\n                        then 0#\n                        else 1#\n\n-- Lookup table\ndata BA = BA ByteArray#\n\nleadingZeros :: BA\nleadingZeros =\n    let mkArr s =\n          case newByteArray# 256# s of\n            (# s1, mba #) ->\n              case writeInt8Array# mba 0# 9# s1 of\n                s2 ->\n                  let fillA lim val idx st =\n                        if isTrue# (idx ==# 256#)\n                          then st\n                          else if isTrue# (idx <# lim)\n                                then case writeInt8Array# mba idx val st of\n                                        nx -> fillA lim val (idx +# 1#) nx\n                                else fillA (2# *# lim) (val -# 1#) idx st\n                  in case fillA 2# 8# 1# s2 of\n                      s3 -> case unsafeFreezeByteArray# mba s3 of\n                              (# _, ba #) -> ba\n    in case mkArr realWorld# of\n        b -> BA b\n", "num_lines": 167}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  GHC.Integer.Simple.Internals\n-- Copyright   :  (c) Ian Lynagh 2007-2008\n-- License     :  BSD3\n--\n-- Maintainer  :  igloo@earth.li\n-- Stability   :  internal\n-- Portability :  non-portable (GHC Extensions)\n--\n-- A simple definition of the 'Integer' type.\n--\n-----------------------------------------------------------------------------\n\nmodule GHC.Integer.Simple.Internals (\n    module GHC.Integer.Type\n ) where\n\nimport GHC.Integer.Type\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GADTs, OverloadedStrings #-}\n\n{-\nThis is the proxy portion of iserv.\n\nIt acts as local bridge for GHC to call\na remote slave. This all might sound\nconfusing, so let's try to get some\nnaming down.\n\nGHC is the actual Haskell compiler, that\nacts as frontend to the code to be compiled.\n\niserv is the slave, that GHC delegates compilation\nof TH to. As such it needs to be compiled for\nand run on the Target. In the special case\nwhere the Host and the Target are the same,\nno proxy is needed. GHC and iserv communicate\nvia pipes.\n\niserv-proxy is the proxy instance to iserv.\nThe following illustration should make this\nsomewhat clear:\n\n .----- Host -----.     .- Target -.\n | GHC <--> proxy<+-----+>  iserv  |\n '----------------'  ^  '----------'\n        ^            |\n        |            '-- communication via sockets\n        '--- communication via pipes\n\nFor now, we won't support multiple concurrent\ninvocations of the proxy instance, and that\nbehavior will be undefined, as this largely\ndepends on the capability of the iserv on the\ntarget to spawn multiple process.  Spawning\nmultiple threads won't be sufficient, as the\nGHC runtime has global state.\n\nAlso the GHC runtime needs to be able to\nuse the linker on the Target to link archives\nand object files.\n\n-}\n\nmodule Main (main) where\n\nimport System.IO\nimport GHCi.Message\nimport GHCi.Utils\nimport GHCi.Signals\n\nimport Remote.Message\n\nimport Network.Socket\nimport Data.IORef\nimport Control.Monad\nimport System.Environment\nimport System.Exit\nimport Text.Printf\nimport GHC.Fingerprint (getFileHash)\nimport System.Directory\nimport System.FilePath (isAbsolute)\n\nimport Data.Binary\nimport qualified Data.ByteString as BS\n\ndieWithUsage :: IO a\ndieWithUsage = do\n    prog <- getProgName\n    die $ prog ++ \": \" ++ msg\n  where\n#if defined(WINDOWS)\n    msg = \"usage: iserv <write-handle> <read-handle> <slave ip> [-v]\"\n#else\n    msg = \"usage: iserv <write-fd> <read-fd> <slave ip> [-v]\"\n#endif\n\nmain :: IO ()\nmain = do\n  args <- getArgs\n  (wfd1, rfd2, host_ip, port, rest) <-\n      case args of\n        arg0:arg1:arg2:arg3:rest -> do\n            let wfd1 = read arg0\n                rfd2 = read arg1\n                ip   = arg2\n                port = read arg3\n            return (wfd1, rfd2, ip, port, rest)\n        _ -> dieWithUsage\n\n  verbose <- case rest of\n    [\"-v\"] -> return True\n    []     -> return False\n    _      -> dieWithUsage\n\n  when verbose $\n    printf \"GHC iserv starting (in: %d; out: %d)\\n\"\n      (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)\n  inh  <- getGhcHandle rfd2\n  outh <- getGhcHandle wfd1\n  installSignalHandlers\n  lo_ref <- newIORef Nothing\n  let in_pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}\n\n  when verbose $\n    putStrLn (\"Trying to connect to \" ++ host_ip ++ \":\" ++ (show port))\n  out_pipe <- connectTo host_ip port >>= socketToPipe\n\n  when verbose $\n    putStrLn \"Starting proxy\"\n  proxy verbose in_pipe out_pipe\n\n-- | A hook, to transform outgoing (proxy -> slave)\n-- messages prior to sending them to the slave.\nhook :: Msg -> IO Msg\nhook = return\n\n-- | Forward a single @THMessage@ from the slave\n-- to ghc, and read back the result from GHC.\n--\n--  @Message@s go from ghc to the slave.\n--    ghc --- proxy --> slave               (@Message@)\n--  @THMessage@s go from the slave to ghc\n--    ghc <-- proxy --- slave               (@THMessage@)\n--\nfwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a\nfwdTHMsg local msg = do\n  writePipe local (putTHMessage msg)\n  readPipe local get\n\n-- | Fowarard a @Message@ call and handle @THMessages@.\nfwdTHCall :: (Binary a) => Bool -> Pipe -> Pipe -> Message a -> IO a\nfwdTHCall verbose local remote msg = do\n  writePipe remote (putMessage msg)\n  -- wait for control instructions\n  loopTH\n  readPipe remote get\n    where\n      loopTH :: IO ()\n      loopTH = do\n        THMsg msg' <- readPipe remote getTHMessage\n        when verbose $\n          putStrLn (\"| TH Msg: ghc <- proxy -- slave: \" ++ show msg')\n        res <- fwdTHMsg local msg'\n        when verbose $\n          putStrLn (\"| Resp.:  ghc -- proxy -> slave: \" ++ show res)\n        writePipe remote (put res)\n        case msg' of\n          RunTHDone -> return ()\n          _         -> loopTH\n\n-- | Forwards a @Message@ call, and handle @SlaveMessage@.\n-- Similar to @THMessages@, but @SlaveMessage@ are between\n-- the slave and the proxy, and are not forwarded to ghc.\n-- These message allow the Slave to query the proxy for\n-- files.\n--\n--  ghc --- proxy --> slave  (@Message@)\n--\n--          proxy <-- slave  (@SlaveMessage@)\n--\nfwdLoadCall :: (Binary a, Show a) => Bool -> Pipe -> Pipe -> Message a -> IO a\nfwdLoadCall verbose _ remote msg = do\n  writePipe remote (putMessage msg)\n  loopLoad\n  readPipe remote get\n  where\n    truncateMsg :: Int -> String -> String\n    truncateMsg n s | length s > n = take n s ++ \"...\"\n                    | otherwise    = s\n    reply :: (Binary a, Show a) => a -> IO ()\n    reply m = do\n      when verbose $\n        putStrLn (\"| Resp.:         proxy -> slave: \"\n                  ++ truncateMsg 80 (show m))\n      writePipe remote (put m)\n    loopLoad :: IO ()\n    loopLoad = do\n      SlaveMsg msg' <- readPipe remote getSlaveMessage\n      when verbose $\n        putStrLn (\"| Sl Msg:        proxy <- slave: \" ++ show msg')\n      case msg' of\n        Done -> return ()\n        Missing path -> do\n          reply =<< BS.readFile path\n          loopLoad\n        Have path remoteHash -> do\n          localHash <- getFileHash path\n          reply =<< if localHash == remoteHash\n                    then return Nothing\n                    else Just <$> BS.readFile path\n          loopLoad\n\n-- | The actual proxy. Conntect local and remote pipe,\n-- and does some message handling.\nproxy :: Bool -> Pipe -> Pipe -> IO ()\nproxy verbose local remote = loop\n  where\n    fwdCall :: (Binary a, Show a) => Message a -> IO a\n    fwdCall msg = do\n      writePipe remote (putMessage msg)\n      readPipe remote get\n\n    -- reply to ghc.\n    reply :: (Show a, Binary a) => a -> IO ()\n    reply msg = do\n      when verbose $\n        putStrLn (\"Resp.:    ghc <- proxy -- slave: \" ++ show msg)\n      writePipe local (put msg)\n\n    loop = do\n      (Msg msg) <- readPipe local getMessage\n      when verbose $\n        putStrLn (\"Msg:      ghc -- proxy -> slave: \" ++ show msg)\n      (Msg msg') <- hook (Msg msg)\n      case msg' of\n        -- TH might send some message back to ghc.\n        RunTH{} -> do\n          resp <- fwdTHCall verbose local remote msg'\n          reply resp\n          loop\n        RunModFinalizers{} -> do\n          resp <- fwdTHCall verbose local remote msg'\n          reply resp\n          loop\n        -- Load messages might send some messages back to the proxy, to\n        -- requrest files that are not present on the device.\n        LoadArchive{} -> do\n          resp <- fwdLoadCall verbose local remote msg'\n          reply resp\n          loop\n        LoadObj{} -> do\n          resp <- fwdLoadCall verbose local remote msg'\n          reply resp\n          loop\n        LoadDLL path | isAbsolute path -> do\n          resp <- fwdLoadCall verbose local remote msg'\n          reply resp\n          loop\n        Shutdown{}    -> fwdCall msg' >> return ()\n        _other        -> fwdCall msg' >>= reply >> loop\n\n\nconnectTo :: String -> PortNumber -> IO Socket\nconnectTo host port = do\n  let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV]\n                           , addrSocketType = Stream }\n  addr:_ <- getAddrInfo (Just hints) (Just host) (Just (show port))\n  sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)\n  putStrLn $ \"Created socket for \" ++ host ++ \":\" ++ show port\n  connect sock (addrAddress addr)\n  putStrLn \"connected\"\n  return sock\n\n-- | Turn a socket into an unbuffered pipe.\nsocketToPipe :: Socket -> IO Pipe\nsocketToPipe sock = do\n  hdl <- socketToHandle sock ReadWriteMode\n  hSetBuffering hdl NoBuffering\n\n  lo_ref <- newIORef Nothing\n  pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref }\n", "num_lines": 264}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, RecordWildCards, GADTs, ScopedTypeVariables #-}\nmodule Lib (serv) where\n\nimport GHCi.Run\nimport GHCi.TH\nimport GHCi.Message\n\nimport Control.DeepSeq\nimport Control.Exception\nimport Control.Monad\nimport Data.Binary\n\nimport Text.Printf\nimport System.Environment (getProgName)\n\ntype MessageHook = Msg -> IO Msg\n\ntrace :: String -> IO ()\ntrace s = getProgName >>= \\name -> printf \"[%20s] %s\\n\" name s\n\nserv :: Bool -> MessageHook -> Pipe -> (forall a .IO a -> IO a) -> IO ()\nserv verbose hook pipe restore = loop\n where\n  loop = do\n    when verbose $ trace \"reading pipe...\"\n    Msg msg <- readPipe pipe getMessage >>= hook\n\n    discardCtrlC\n\n    when verbose $ trace (\"msg: \" ++ (show msg))\n    case msg of\n      Shutdown -> return ()\n      RunTH st q ty loc -> wrapRunTH $ runTH pipe st q ty loc\n      RunModFinalizers st qrefs -> wrapRunTH $ runModFinalizerRefs pipe st qrefs\n      _other -> run msg >>= reply\n\n  reply :: forall a. (Binary a, Show a) => a -> IO ()\n  reply r = do\n    when verbose $ trace (\"writing pipe: \" ++ show r)\n    writePipe pipe (put r)\n    loop\n\n  -- Run some TH code, which may interact with GHC by sending\n  -- THMessage requests, and then finally send RunTHDone followed by a\n  -- QResult.  For an overview of how TH works with Remote GHCi, see\n  -- Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.\n  wrapRunTH :: forall a. (Binary a, Show a) => IO a -> IO ()\n  wrapRunTH io = do\n    when verbose $ trace \"wrapRunTH...\"\n    r <- try io\n    when verbose $ trace \"wrapRunTH done.\"\n    when verbose $ trace \"writing RunTHDone.\"\n    writePipe pipe (putTHMessage RunTHDone)\n    case r of\n      Left e\n        | Just (GHCiQException _ err) <- fromException e  -> do\n           when verbose $ trace (\"QFail \" ++ show err)\n           reply (QFail err :: QResult a)\n        | otherwise -> do\n           str <- showException e\n           when verbose $ trace (\"QException \" ++ str)\n           reply (QException str :: QResult a)\n      Right a -> do\n        when verbose $ trace \"QDone\"\n        reply (QDone a)\n\n  -- carefully when showing an exception, there might be other exceptions\n  -- lurking inside it.  If so, we return the inner exception instead.\n  showException :: SomeException -> IO String\n  showException e0 = do\n     when verbose $ trace \"showException\"\n     r <- try $ evaluate (force (show (e0::SomeException)))\n     case r of\n       Left e -> showException e\n       Right str -> return str\n\n  -- throw away any pending ^C exceptions while we're not running\n  -- interpreted code.  GHC will also get the ^C, and either ignore it\n  -- (if this is GHCi), or tell us to quit with a Shutdown message.\n  discardCtrlC = do\n    when verbose $ trace \"discardCtrlC\"\n    r <- try $ restore $ return ()\n    case r of\n      Left UserInterrupt -> return () >> discardCtrlC\n      Left e -> throwIO e\n      _ -> return ()\n", "num_lines": 87}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, StandaloneDeriving, ExistentialQuantification #-}\n\nmodule Remote.Message\n  ( SlaveMessage(..)\n  , SlaveMsg(..)\n  , putSlaveMessage\n  , getSlaveMessage )\nwhere\n\nimport GHC.Fingerprint (Fingerprint)\nimport Data.Binary\nimport Data.ByteString (ByteString)\n\n-- | A @SlaveMessage a@ is message from the iserv process on the\n-- target, requesting something from the Proxy of with result type @a@.\ndata SlaveMessage a where\n  -- sends either a new file, or nothing if the file is acceptable.\n  Have     :: FilePath -> Fingerprint -> SlaveMessage (Maybe ByteString)\n  Missing  :: FilePath -> SlaveMessage ByteString\n  Done     :: SlaveMessage ()\n\nderiving instance Show (SlaveMessage a)\n\nputSlaveMessage :: SlaveMessage a -> Put\nputSlaveMessage m = case m of\n  Have path sha  -> putWord8 0 >> put path >> put sha\n  Missing path   -> putWord8 1 >> put path\n  Done           -> putWord8 2\n\ndata SlaveMsg = forall a . (Binary a, Show a) => SlaveMsg (SlaveMessage a)\n\ngetSlaveMessage :: Get SlaveMsg\ngetSlaveMessage = do\n  b <- getWord8\n  case b of\n    0 -> SlaveMsg <$> (Have   <$> get <*> get)\n    1 -> SlaveMsg <$> Missing <$> get\n    2 -> return (SlaveMsg Done)\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, GADTs, LambdaCase #-}\nmodule Remote.Slave where\n\nimport Network.Socket\n\nimport Lib (serv)\nimport Remote.Message\n\nimport System.IO\nimport Control.Exception\nimport Control.Concurrent\nimport Control.Monad (when, forever)\nimport System.Directory\nimport System.FilePath (takeDirectory, (</>), dropTrailingPathSeparator,\n                        isAbsolute, joinPath, splitPath)\nimport GHCi.ResolvedBCO\n\nimport Data.IORef\nimport GHCi.Message (Pipe(..), Msg(..), Message(..), readPipe, writePipe)\n\nimport Foreign.C.String\n\nimport Data.Binary\nimport GHC.Fingerprint (getFileHash)\n\nimport qualified Data.ByteString as BS\n\nimport Text.Printf\nimport System.Environment (getProgName)\n\ntrace :: String -> IO ()\ntrace s = getProgName >>= \\name -> printf \"[%20s] %s\\n\" name s\n\ndropLeadingPathSeparator :: FilePath -> FilePath\ndropLeadingPathSeparator p | isAbsolute p = joinPath (drop 1 (splitPath p))\n                           | otherwise    = p\n\n-- | Path concatenation that prevents a double path separator to appear in the\n-- final path. \"/foo/bar/\" <//> \"/baz/quux\" == \"/foo/bar/baz/quux\"\n(<//>) :: FilePath -> FilePath -> FilePath\nlhs <//> rhs = dropTrailingPathSeparator lhs </> dropLeadingPathSeparator rhs\ninfixr 5 <//>\n\nforeign export ccall startSlave :: Bool -> Int -> CString -> IO ()\n\n-- | @startSlave@ is the exported slave function, that the\n-- hosting application on the target needs to invoce to\n-- start the slave process, and runs iserv.\nstartSlave :: Bool -> Int -> CString -> IO ()\nstartSlave verbose port s = do\n  base_path <- peekCString s\n  trace $ \"DocRoot: \" ++ base_path\n  _ <- forkIO $ startSlave' verbose base_path (toEnum port)\n  return ()\n\n-- | @startSlave'@ provdes a blocking haskell interface, that\n-- the hosting application on the target can use to start the\n-- slave process.\nstartSlave' :: Bool -> String -> PortNumber -> IO ()\nstartSlave' verbose base_path port = do\n  hSetBuffering stdin LineBuffering\n  hSetBuffering stdout LineBuffering\n\n  sock <- openSocket port\n\n  forever $ do\n    when verbose $ trace \"Opening socket\"\n    pipe <- acceptSocket sock >>= socketToPipe\n    putStrLn $ \"Listening on port \" ++ show port\n    when verbose $ trace \"Starting serv\"\n    uninterruptibleMask $ serv verbose (hook verbose base_path pipe) pipe\n    when verbose $ trace \"serv ended\"\n    return ()\n\n-- | The iserv library may need access to files, specifically\n-- archives and object files to be linked. If ghc and the slave\n-- are on the same host, this is trivial, as the underlying\n-- filestorage is the same.  If however the slave does not run\n-- on the same host, the filestorage is not identical and we\n-- need to request data from the host where ghc runs on.\n--\n-- If we however already have the requested file we need to make\n-- sure that this file is the same one ghc sees. Hence we\n-- calculate the Fingerprint of the file and send it back to the\n-- host for comparison. The proxy will then send back either @Nothing@\n-- indicating that the file on the host has the same Fingerprint, or\n-- Maybe ByteString containing the payload to replace the existing\n-- file with.\nhandleLoad :: Pipe -> FilePath -> FilePath -> IO ()\nhandleLoad pipe path localPath = do\n  exists <- doesFileExist localPath\n  if exists\n    then getFileHash localPath >>= \\hash -> proxyCall (Have path hash) >>= \\case\n      Nothing -> return ()\n      Just bs -> BS.writeFile localPath bs\n    else do\n      createDirectoryIfMissing True (takeDirectory localPath)\n      resp <- proxyCall (Missing path)\n      BS.writeFile localPath resp\n\n  proxyCall Done\n  where\n    proxyCall :: (Binary a, Show a) => SlaveMessage a -> IO a\n    proxyCall msg = do\n      writePipe pipe (putSlaveMessage msg)\n      readPipe pipe get\n\n-- | The hook we install in the @serv@ function from the\n-- iserv library, to request archives over the wire.\nhook :: Bool -> String -> Pipe -> Msg -> IO Msg\nhook verbose base_path pipe m = case m of\n  Msg (AddLibrarySearchPath p) -> do\n    when verbose $ putStrLn (\"Need Path: \" ++ (base_path <//> p))\n    createDirectoryIfMissing True (base_path <//> p)\n    return $ Msg (AddLibrarySearchPath (base_path <//> p))\n  Msg (LoadObj path) -> do\n    when verbose $ putStrLn (\"Need Obj: \" ++ (base_path <//> path))\n    handleLoad pipe path (base_path <//> path)\n    return $ Msg (LoadObj (base_path <//> path))\n  Msg (LoadArchive path) -> do\n    handleLoad pipe path (base_path <//> path)\n    return $ Msg (LoadArchive (base_path <//> path))\n  -- when loading DLLs (.so, .dylib, .dll, ...) and these are provided\n  -- as relative paths, the intention is to load a pre-existing system library,\n  -- therefore we hook the LoadDLL call only for absolute paths to ship the\n  -- dll from the host to the target.  On windows we assume that we don't\n  -- want to copy libraries that are referenced in C:\\ these are usually\n  -- system libraries.\n  Msg (LoadDLL path@('C':':':_)) -> do\n    return m\n  Msg (LoadDLL path) | isAbsolute path -> do\n    when verbose $ trace (\"Need DLL: \" ++ (base_path <//> path))\n    handleLoad pipe path (base_path <//> path)\n    return $ Msg (LoadDLL (base_path <//> path))\n  _other -> return m\n\n--------------------------------------------------------------------------------\n-- socket to pipe briding logic.\nsocketToPipe :: Socket -> IO Pipe\nsocketToPipe sock = do\n  hdl <- socketToHandle sock ReadWriteMode\n  hSetBuffering hdl NoBuffering\n\n  lo_ref <- newIORef Nothing\n  pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref }\n\nopenSocket :: PortNumber -> IO Socket\nopenSocket port = do\n  sock <- socket AF_INET Stream 0\n  setSocketOption sock ReuseAddr 1\n  bind sock (SockAddrInet port iNADDR_ANY)\n  listen sock 1\n  return sock\n\nacceptSocket :: Socket -> IO Socket\nacceptSocket = fmap fst . accept\n", "num_lines": 157}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- | The public face of Template Haskell\n\nFor other documentation, refer to:\n<http://www.haskell.org/haskellwiki/Template_Haskell>\n\n-}\nmodule Language.Haskell.TH(\n        -- * The monad and its operations\n        Q,\n        runQ,\n        -- ** Administration: errors, locations and IO\n        reportError,              -- :: String -> Q ()\n        reportWarning,            -- :: String -> Q ()\n        report,                   -- :: Bool -> String -> Q ()\n        recover,          -- :: Q a -> Q a -> Q a\n        location,         -- :: Q Loc\n        Loc(..),\n        runIO,            -- :: IO a -> Q a\n        -- ** Querying the compiler\n        -- *** Reify\n        reify,            -- :: Name -> Q Info\n        reifyModule,\n        Info(..), ModuleInfo(..),\n        InstanceDec,\n        ParentName,\n        SumAlt, SumArity,\n        Arity,\n        Unlifted,\n        -- *** Language extension lookup\n        Extension(..),\n        extsEnabled, isExtEnabled,\n        -- *** Name lookup\n        lookupTypeName,  -- :: String -> Q (Maybe Name)\n        lookupValueName, -- :: String -> Q (Maybe Name)\n        -- *** Fixity lookup\n        reifyFixity,\n        -- *** Instance lookup\n        reifyInstances,\n        isInstance,\n        -- *** Roles lookup\n        reifyRoles,\n        -- *** Annotation lookup\n        reifyAnnotations, AnnLookup(..),\n        -- *** Constructor strictness lookup\n        reifyConStrictness,\n\n        -- * Typed expressions\n        TExp, unType,\n\n        -- * Names\n        Name, NameSpace,        -- Abstract\n        -- ** Constructing names\n        mkName,         -- :: String -> Name\n        newName,        -- :: String -> Q Name\n        -- ** Deconstructing names\n        nameBase,       -- :: Name -> String\n        nameModule,     -- :: Name -> Maybe String\n        namePackage,    -- :: Name -> Maybe String\n        nameSpace,      -- :: Name -> Maybe NameSpace\n        -- ** Built-in names\n        tupleTypeName, tupleDataName,   -- Int -> Name\n        unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name\n        unboxedSumTypeName, -- :: SumArity -> Name\n        unboxedSumDataName, -- :: SumAlt -> SumArity -> Name\n\n    -- * The algebraic data types\n    -- | The lowercase versions (/syntax operators/) of these constructors are\n    -- preferred to these constructors, since they compose better with\n    -- quotations (@[| |]@) and splices (@$( ... )@)\n\n    -- ** Declarations\n        Dec(..), Con(..), Clause(..),\n        SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..),\n        Bang(..), Strict, Foreign(..), Callconv(..), Safety(..), Pragma(..),\n        Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),\n        FunDep(..), TySynEqn(..), TypeFamilyHead(..),\n        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,\n        PatSynDir(..), PatSynArgs(..),\n    -- ** Expressions\n        Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),\n    -- ** Patterns\n        Pat(..), FieldExp, FieldPat,\n    -- ** Types\n        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),\n        FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType,\n\n    -- * Library functions\n    module Language.Haskell.TH.Lib,\n\n    -- * Pretty-printer\n    Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType\n\n   ) where\n\nimport Language.Haskell.TH.Syntax as Syntax\nimport Language.Haskell.TH.Lib\nimport Language.Haskell.TH.Ppr\n", "num_lines": 98}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Language.Haskell.TH.LanguageExtensions\n-- Copyright   :  (c) The University of Glasgow 2015\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Language extensions known to GHC\n--\n-----------------------------------------------------------------------------\n\nmodule Language.Haskell.TH.LanguageExtensions\n   ( Extension(..)\n   ) where\n\n-- This module exists primarily to avoid inserting a massive list of language\n-- extensions into the already quite large Haddocks for Language.Haskell.TH\n\nimport GHC.LanguageExtensions.Type (Extension(..))\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- |\n-- Language.Haskell.TH.Lib contains lots of useful helper functions for\n-- generating and manipulating Template Haskell terms\n\n-- Note: this module mostly re-exports functions from\n-- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template\n-- Haskell which requires breaking the API offered in this module, we opt to\n-- copy the old definition here, and make the changes in\n-- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards\n-- compatibility while still allowing GHC to make changes as it needs.\n\nmodule Language.Haskell.TH.Lib (\n    -- All of the exports from this module should\n    -- be \"public\" functions.  The main module TH\n    -- re-exports them all.\n\n    -- * Library functions\n    -- ** Abbreviations\n        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ, TyVarBndrQ,\n        TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,\n        StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,\n        BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,\n        FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,\n        FamilyResultSigQ, DerivStrategyQ,\n\n    -- ** Constructors lifted to 'Q'\n    -- *** Literals\n        intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,\n        charL, stringL, stringPrimL, charPrimL,\n    -- *** Patterns\n        litP, varP, tupP, unboxedTupP, unboxedSumP, conP, uInfixP, parensP,\n        infixP, tildeP, bangP, asP, wildP, recP,\n        listP, sigP, viewP,\n        fieldPat,\n\n    -- *** Pattern Guards\n        normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,\n\n    -- *** Expressions\n        dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,\n        appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR,\n        lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE,\n        letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,\n    -- **** Ranges\n    fromE, fromThenE, fromToE, fromThenToE,\n\n    -- ***** Ranges with more indirection\n    arithSeqE,\n    fromR, fromThenR, fromToR, fromThenToR,\n    -- **** Statements\n    doE, mdoE, compE,\n    bindS, letS, noBindS, parS, recS,\n\n    -- *** Types\n        forallT, forallVisT, varT, conT, appT, appKindT, arrowT, infixT,\n        uInfixT, parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,\n        sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT,\n        promotedConsT, implicitParamT,\n    -- **** Type literals\n    numTyLit, strTyLit,\n    -- **** Strictness\n    noSourceUnpackedness, sourceNoUnpack, sourceUnpack,\n    noSourceStrictness, sourceLazy, sourceStrict,\n    isStrict, notStrict, unpacked,\n    bang, bangType, varBangType, strictType, varStrictType,\n    -- **** Class Contexts\n    cxt, classP, equalP,\n    -- **** Constructors\n    normalC, recC, infixC, forallC, gadtC, recGadtC,\n\n    -- *** Kinds\n    varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,\n\n    -- *** Type variable binders\n    plainTV, kindedTV,\n\n    -- *** Roles\n    nominalR, representationalR, phantomR, inferR,\n\n    -- *** Top Level Declarations\n    -- **** Data\n    valD, funD, tySynD, dataD, newtypeD,\n    derivClause, DerivClause(..),\n    stockStrategy, anyclassStrategy, newtypeStrategy,\n    viaStrategy, DerivStrategy(..),\n    -- **** Class\n    classD, instanceD, instanceWithOverlapD, Overlap(..),\n    sigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,\n\n    -- **** Role annotations\n    roleAnnotD,\n    -- **** Type Family / Data Family\n    dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,\n    newtypeInstD, tySynInstD,\n    tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,\n\n    -- **** Fixity\n    infixLD, infixRD, infixND,\n\n    -- **** Foreign Function Interface (FFI)\n    cCall, stdCall, cApi, prim, javaScript,\n    unsafe, safe, interruptible, forImpD,\n\n    -- **** Functional dependencies\n    funDep,\n\n    -- **** Pragmas\n    ruleVar, typedRuleVar,\n    valueAnnotation, typeAnnotation, moduleAnnotation,\n    pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,\n    pragLineD, pragCompleteD,\n\n    -- **** Pattern Synonyms\n    patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn,\n    infixPatSyn, recordPatSyn,\n\n    -- **** Implicit Parameters\n    implicitParamBindD,\n\n    -- ** Reify\n    thisModule\n\n   ) where\n\nimport Language.Haskell.TH.Lib.Internal hiding\n  ( tySynD\n  , dataD\n  , newtypeD\n  , classD\n  , pragRuleD\n  , dataInstD\n  , newtypeInstD\n  , dataFamilyD\n  , openTypeFamilyD\n  , closedTypeFamilyD\n  , tySynEqn\n  , forallC\n\n  , forallT\n  , sigT\n\n  , plainTV\n  , kindedTV\n  , starK\n  , constraintK\n\n  , noSig\n  , kindSig\n  , tyVarSig\n\n  , derivClause\n  , standaloneDerivWithStrategyD\n\n  , Role\n  , InjectivityAnn\n  )\nimport Language.Haskell.TH.Syntax\n\nimport Control.Monad (liftM2)\nimport Prelude\n\n-- All definitions below represent the \"old\" API, since their definitions are\n-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before\n-- deciding to change the APIs of the functions below, as they represent the\n-- public API (as opposed to the Internal module, which has no API promises.)\n\n-------------------------------------------------------------------------------\n-- *   Dec\n\ntySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ\ntySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }\n\ndataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]\n      -> DecQ\ndataD ctxt tc tvs ksig cons derivs =\n  do\n    ctxt1 <- ctxt\n    cons1 <- sequence cons\n    derivs1 <- sequence derivs\n    return (DataD ctxt1 tc tvs ksig cons1 derivs1)\n\nnewtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> [DerivClauseQ]\n         -> DecQ\nnewtypeD ctxt tc tvs ksig con derivs =\n  do\n    ctxt1 <- ctxt\n    con1 <- con\n    derivs1 <- sequence derivs\n    return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)\n\nclassD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ\nclassD ctxt cls tvs fds decs =\n  do\n    decs1 <- sequence decs\n    ctxt1 <- ctxt\n    return $ ClassD ctxt1 cls tvs fds decs1\n\npragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ\npragRuleD n bndrs lhs rhs phases\n  = do\n      bndrs1 <- sequence bndrs\n      lhs1   <- lhs\n      rhs1   <- rhs\n      return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases\n\ndataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]\n          -> DecQ\ndataInstD ctxt tc tys ksig cons derivs =\n  do\n    ctxt1 <- ctxt\n    ty1 <- foldl appT (conT tc) tys\n    cons1 <- sequence cons\n    derivs1 <- sequence derivs\n    return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)\n\nnewtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ]\n             -> DecQ\nnewtypeInstD ctxt tc tys ksig con derivs =\n  do\n    ctxt1 <- ctxt\n    ty1 <- foldl appT (conT tc) tys\n    con1  <- con\n    derivs1 <- sequence derivs\n    return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)\n\ndataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ\ndataFamilyD tc tvs kind\n    = return $ DataFamilyD tc tvs kind\n\nopenTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig\n                -> Maybe InjectivityAnn -> DecQ\nopenTypeFamilyD tc tvs res inj\n    = return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)\n\nclosedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig\n                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ\nclosedTypeFamilyD tc tvs result injectivity eqns =\n  do eqns1 <- sequence eqns\n     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)\n\ntySynEqn :: (Maybe [TyVarBndr]) -> TypeQ -> TypeQ -> TySynEqnQ\ntySynEqn tvs lhs rhs =\n  do\n    lhs1 <- lhs\n    rhs1 <- rhs\n    return (TySynEqn tvs lhs1 rhs1)\n\nforallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ\nforallC ns ctxt con = liftM2 (ForallC ns) ctxt con\n\n-------------------------------------------------------------------------------\n-- *   Type\n\nforallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ\nforallT tvars ctxt ty = do\n    ctxt1 <- ctxt\n    ty1   <- ty\n    return $ ForallT tvars ctxt1 ty1\n\nsigT :: TypeQ -> Kind -> TypeQ\nsigT t k\n  = do\n      t' <- t\n      return $ SigT t' k\n\n-------------------------------------------------------------------------------\n-- *   Kind\n\nplainTV :: Name -> TyVarBndr\nplainTV = PlainTV\n\nkindedTV :: Name -> Kind -> TyVarBndr\nkindedTV = KindedTV\n\nstarK :: Kind\nstarK = StarT\n\nconstraintK :: Kind\nconstraintK = ConstraintT\n\n-------------------------------------------------------------------------------\n-- *   Type family result\n\nnoSig :: FamilyResultSig\nnoSig = NoSig\n\nkindSig :: Kind -> FamilyResultSig\nkindSig = KindSig\n\ntyVarSig :: TyVarBndr -> FamilyResultSig\ntyVarSig = TyVarSig\n\n-------------------------------------------------------------------------------\n-- * Top Level Declarations\n\nderivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ\nderivClause mds p = do\n  p' <- cxt p\n  return $ DerivClause mds p'\n\nstandaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ\nstandaloneDerivWithStrategyD mds ctxt ty = do\n  ctxt' <- ctxt\n  ty'   <- ty\n  return $ StandaloneDerivD mds ctxt' ty'\n", "num_lines": 306}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | contains a prettyprinter for the\n-- Template Haskell datatypes\n\nmodule Language.Haskell.TH.Ppr where\n    -- All of the exports from this module should\n    -- be \"public\" functions.  The main module TH\n    -- re-exports them all.\n\nimport Text.PrettyPrint (render)\nimport Language.Haskell.TH.PprLib\nimport Language.Haskell.TH.Syntax\nimport Data.Word ( Word8 )\nimport Data.Char ( toLower, chr)\nimport GHC.Show  ( showMultiLineString )\nimport GHC.Lexeme( startsVarSym )\nimport Data.Ratio ( numerator, denominator )\nimport Prelude hiding ((<>))\n\nnestDepth :: Int\nnestDepth = 4\n\ntype Precedence = Int\nappPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence\nappPrec  = 4    -- Argument of a function application\nopPrec   = 3    -- Argument of an infix operator\nunopPrec = 2    -- Argument of an unresolved infix operator\nsigPrec  = 1    -- Argument of an explicit type signature\nnoPrec   = 0    -- Others\n\nparensIf :: Bool -> Doc -> Doc\nparensIf True d = parens d\nparensIf False d = d\n\n------------------------------\n\npprint :: Ppr a => a -> String\npprint x = render $ to_HPJ_Doc $ ppr x\n\nclass Ppr a where\n    ppr :: a -> Doc\n    ppr_list :: [a] -> Doc\n    ppr_list = vcat . map ppr\n\ninstance Ppr a => Ppr [a] where\n    ppr x = ppr_list x\n\n------------------------------\ninstance Ppr Name where\n    ppr v = pprName v\n\n------------------------------\ninstance Ppr Info where\n    ppr (TyConI d)     = ppr d\n    ppr (ClassI d is)  = ppr d $$ vcat (map ppr is)\n    ppr (FamilyI d is) = ppr d $$ vcat (map ppr is)\n    ppr (PrimTyConI name arity is_unlifted)\n      = text \"Primitive\"\n        <+> (if is_unlifted then text \"unlifted\" else empty)\n        <+> text \"type constructor\" <+> quotes (ppr name)\n        <+> parens (text \"arity\" <+> int arity)\n    ppr (ClassOpI v ty cls)\n      = text \"Class op from\" <+> ppr cls <> colon <+> ppr_sig v ty\n    ppr (DataConI v ty tc)\n      = text \"Constructor from\" <+> ppr tc <> colon <+> ppr_sig v ty\n    ppr (PatSynI nm ty) = pprPatSynSig nm ty\n    ppr (TyVarI v ty)\n      = text \"Type variable\" <+> ppr v <+> equals <+> ppr ty\n    ppr (VarI v ty mb_d)\n      = vcat [ppr_sig v ty,\n              case mb_d of { Nothing -> empty; Just d -> ppr d }]\n\nppr_sig :: Name -> Type -> Doc\nppr_sig v ty = pprName' Applied v <+> dcolon <+> ppr ty\n\npprFixity :: Name -> Fixity -> Doc\npprFixity _ f | f == defaultFixity = empty\npprFixity v (Fixity i d) = ppr_fix d <+> int i <+> ppr v\n    where ppr_fix InfixR = text \"infixr\"\n          ppr_fix InfixL = text \"infixl\"\n          ppr_fix InfixN = text \"infix\"\n\n-- | Pretty prints a pattern synonym type signature\npprPatSynSig :: Name -> PatSynType -> Doc\npprPatSynSig nm ty\n  = text \"pattern\" <+> pprPrefixOcc nm <+> dcolon <+> pprPatSynType ty\n\n-- | Pretty prints a pattern synonym's type; follows the usual\n-- conventions to print a pattern synonym type compactly, yet\n-- unambiguously. See the note on 'PatSynType' and the section on\n-- pattern synonyms in the GHC user's guide for more information.\npprPatSynType :: PatSynType -> Doc\npprPatSynType ty@(ForallT uniTys reqs ty'@(ForallT exTys provs ty''))\n  | null exTys,  null provs = ppr (ForallT uniTys reqs ty'')\n  | null uniTys, null reqs  = noreqs <+> ppr ty'\n  | null reqs               = forall uniTys <+> noreqs <+> ppr ty'\n  | otherwise               = ppr ty\n  where noreqs     = text \"() =>\"\n        forall tvs = text \"forall\" <+> (hsep (map ppr tvs)) <+> text \".\"\npprPatSynType ty            = ppr ty\n\n------------------------------\ninstance Ppr Module where\n  ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m)\n\ninstance Ppr ModuleInfo where\n  ppr (ModuleInfo imps) = text \"Module\" <+> vcat (map ppr imps)\n\n------------------------------\ninstance Ppr Exp where\n    ppr = pprExp noPrec\n\npprPrefixOcc :: Name -> Doc\n-- Print operators with parens around them\npprPrefixOcc n = parensIf (isSymOcc n) (ppr n)\n\nisSymOcc :: Name -> Bool\nisSymOcc n\n  = case nameBase n of\n      []    -> True  -- Empty name; weird\n      (c:_) -> startsVarSym c\n                   -- c.f. OccName.startsVarSym in GHC itself\n\npprInfixExp :: Exp -> Doc\npprInfixExp (VarE v) = pprName' Infix v\npprInfixExp (ConE v) = pprName' Infix v\npprInfixExp _        = text \"<<Non-variable/constructor in infix context>>\"\n\npprExp :: Precedence -> Exp -> Doc\npprExp _ (VarE v)     = pprName' Applied v\npprExp _ (ConE c)     = pprName' Applied c\npprExp i (LitE l)     = pprLit i l\npprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1\n                                              <+> pprExp appPrec e2\npprExp i (AppTypeE e t)\n = parensIf (i >= appPrec) $ pprExp opPrec e <+> char '@' <> pprParendType t\npprExp _ (ParensE e)  = parens (pprExp noPrec e)\npprExp i (UInfixE e1 op e2)\n = parensIf (i > unopPrec) $ pprExp unopPrec e1\n                         <+> pprInfixExp op\n                         <+> pprExp unopPrec e2\npprExp i (InfixE (Just e1) op (Just e2))\n = parensIf (i >= opPrec) $ pprExp opPrec e1\n                        <+> pprInfixExp op\n                        <+> pprExp opPrec e2\npprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1\n                                    <+> pprInfixExp op\n                                    <+> pprMaybeExp noPrec me2\npprExp i (LamE [] e) = pprExp i e -- #13856\npprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\\\' <> hsep (map (pprPat appPrec) ps)\n                                           <+> text \"->\" <+> ppr e\npprExp i (LamCaseE ms) = parensIf (i > noPrec)\n                       $ text \"\\\\case\" $$ nest nestDepth (ppr ms)\npprExp _ (TupE es) = parens (commaSep es)\npprExp _ (UnboxedTupE es) = hashParens (commaSep es)\npprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity\n-- Nesting in Cond is to avoid potential problems in do statements\npprExp i (CondE guard true false)\n = parensIf (i > noPrec) $ sep [text \"if\"   <+> ppr guard,\n                       nest 1 $ text \"then\" <+> ppr true,\n                       nest 1 $ text \"else\" <+> ppr false]\npprExp i (MultiIfE alts)\n  = parensIf (i > noPrec) $ vcat $\n      case alts of\n        []            -> [text \"if {}\"]\n        (alt : alts') -> text \"if\" <+> pprGuarded arrow alt\n                         : map (nest 3 . pprGuarded arrow) alts'\npprExp i (LetE ds_ e) = parensIf (i > noPrec) $ text \"let\" <+> pprDecs ds_\n                                             $$ text \" in\" <+> ppr e\n  where\n    pprDecs []  = empty\n    pprDecs [d] = ppr d\n    pprDecs ds  = braces (semiSep ds)\n\npprExp i (CaseE e ms)\n = parensIf (i > noPrec) $ text \"case\" <+> ppr e <+> text \"of\"\n                        $$ nest nestDepth (ppr ms)\npprExp i (DoE ss_) = parensIf (i > noPrec) $ text \"do\" <+> pprStms ss_\n  where\n    pprStms []  = empty\n    pprStms [s] = ppr s\n    pprStms ss  = braces (semiSep ss)\npprExp i (MDoE ss_) = parensIf (i > noPrec) $ text \"mdo\" <+> pprStms ss_\n  where\n    pprStms []  = empty\n    pprStms [s] = ppr s\n    pprStms ss  = braces (semiSep ss)\n\npprExp _ (CompE []) = text \"<<Empty CompExp>>\"\n-- This will probably break with fixity declarations - would need a ';'\npprExp _ (CompE ss) =\n    if null ss'\n       -- If there are no statements in a list comprehension besides the last\n       -- one, we simply treat it like a normal list.\n       then text \"[\" <> ppr s <> text \"]\"\n       else text \"[\" <> ppr s\n        <+> bar\n        <+> commaSep ss'\n         <> text \"]\"\n  where s = last ss\n        ss' = init ss\npprExp _ (ArithSeqE d) = ppr d\npprExp _ (ListE es) = brackets (commaSep es)\npprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e\n                                          <+> dcolon <+> ppr t\npprExp _ (RecConE nm fs) = ppr nm <> braces (pprFields fs)\npprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs)\npprExp i (StaticE e) = parensIf (i >= appPrec) $\n                         text \"static\"<+> pprExp appPrec e\npprExp _ (UnboundVarE v) = pprName' Applied v\npprExp _ (LabelE s) = text \"#\" <> text s\npprExp _ (ImplicitParamVarE n) = text ('?' : n)\n\npprFields :: [(Name,Exp)] -> Doc\npprFields = sep . punctuate comma . map (\\(s,e) -> ppr s <+> equals <+> ppr e)\n\npprMaybeExp :: Precedence -> Maybe Exp -> Doc\npprMaybeExp _ Nothing = empty\npprMaybeExp i (Just e) = pprExp i e\n\n------------------------------\ninstance Ppr Stmt where\n    ppr (BindS p e) = ppr p <+> text \"<-\" <+> ppr e\n    ppr (LetS ds) = text \"let\" <+> (braces (semiSep ds))\n    ppr (NoBindS e) = ppr e\n    ppr (ParS sss) = sep $ punctuate bar\n                         $ map commaSep sss\n    ppr (RecS ss) = text \"rec\" <+> (braces (semiSep ss))\n\n------------------------------\ninstance Ppr Match where\n    ppr (Match p rhs ds) = pprMatchPat p <+> pprBody False rhs\n                        $$ where_clause ds\n\npprMatchPat :: Pat -> Doc\n-- Everything except pattern signatures bind more tightly than (->)\npprMatchPat p@(SigP {}) = parens (ppr p)\npprMatchPat p           = ppr p\n\n------------------------------\npprGuarded :: Doc -> (Guard, Exp) -> Doc\npprGuarded eqDoc (guard, expr) = case guard of\n  NormalG guardExpr -> bar <+> ppr guardExpr <+> eqDoc <+> ppr expr\n  PatG    stmts     -> bar <+> vcat (punctuate comma $ map ppr stmts) $$\n                         nest nestDepth (eqDoc <+> ppr expr)\n\n------------------------------\npprBody :: Bool -> Body -> Doc\npprBody eq body = case body of\n    GuardedB xs -> nest nestDepth $ vcat $ map (pprGuarded eqDoc) xs\n    NormalB  e  -> eqDoc <+> ppr e\n  where eqDoc | eq        = equals\n              | otherwise = arrow\n\n------------------------------\ninstance Ppr Lit where\n  ppr = pprLit noPrec\n\npprLit :: Precedence -> Lit -> Doc\npprLit i (IntPrimL x)    = parensIf (i > noPrec && x < 0)\n                                    (integer x <> char '#')\npprLit _ (WordPrimL x)    = integer x <> text \"##\"\npprLit i (FloatPrimL x)  = parensIf (i > noPrec && x < 0)\n                                    (float (fromRational x) <> char '#')\npprLit i (DoublePrimL x) = parensIf (i > noPrec && x < 0)\n                                    (double (fromRational x) <> text \"##\")\npprLit i (IntegerL x)    = parensIf (i > noPrec && x < 0) (integer x)\npprLit _ (CharL c)       = text (show c)\npprLit _ (CharPrimL c)   = text (show c) <> char '#'\npprLit _ (StringL s)     = pprString s\npprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'\npprLit i (RationalL rat) = parensIf (i > noPrec) $\n                           integer (numerator rat) <+> char '/'\n                              <+> integer (denominator rat)\n\nbytesToString :: [Word8] -> String\nbytesToString = map (chr . fromIntegral)\n\npprString :: String -> Doc\n-- Print newlines as newlines with Haskell string escape notation,\n-- not as '\\n'.  For other non-printables use regular escape notation.\npprString s = vcat (map text (showMultiLineString s))\n\n------------------------------\ninstance Ppr Pat where\n    ppr = pprPat noPrec\n\npprPat :: Precedence -> Pat -> Doc\npprPat i (LitP l)     = pprLit i l\npprPat _ (VarP v)     = pprName' Applied v\npprPat _ (TupP ps)    = parens (commaSep ps)\npprPat _ (UnboxedTupP ps) = hashParens (commaSep ps)\npprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity\npprPat i (ConP s ps)  = parensIf (i >= appPrec) $ pprName' Applied s\n                                              <+> sep (map (pprPat appPrec) ps)\npprPat _ (ParensP p)  = parens $ pprPat noPrec p\npprPat i (UInfixP p1 n p2)\n                      = parensIf (i > unopPrec) (pprPat unopPrec p1 <+>\n                                                 pprName' Infix n   <+>\n                                                 pprPat unopPrec p2)\npprPat i (InfixP p1 n p2)\n                      = parensIf (i >= opPrec) (pprPat opPrec p1 <+>\n                                                pprName' Infix n <+>\n                                                pprPat opPrec p2)\npprPat i (TildeP p)   = parensIf (i > noPrec) $ char '~' <> pprPat appPrec p\npprPat i (BangP p)    = parensIf (i > noPrec) $ char '!' <> pprPat appPrec p\npprPat i (AsP v p)    = parensIf (i > noPrec) $ ppr v <> text \"@\"\n                                                      <> pprPat appPrec p\npprPat _ WildP        = text \"_\"\npprPat _ (RecP nm fs)\n = parens $     ppr nm\n            <+> braces (sep $ punctuate comma $\n                        map (\\(s,p) -> ppr s <+> equals <+> ppr p) fs)\npprPat _ (ListP ps) = brackets (commaSep ps)\npprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> dcolon <+> ppr t\npprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text \"->\" <+> pprPat noPrec p\n\n------------------------------\ninstance Ppr Dec where\n    ppr = ppr_dec True\n\nppr_dec :: Bool     -- declaration on the toplevel?\n        -> Dec\n        -> Doc\nppr_dec _ (FunD f cs)   = vcat $ map (\\c -> pprPrefixOcc f <+> ppr c) cs\nppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r\n                          $$ where_clause ds\nppr_dec _ (TySynD t xs rhs)\n  = ppr_tySyn empty (Just t) (hsep (map ppr xs)) rhs\nppr_dec _ (DataD ctxt t xs ksig cs decs)\n  = ppr_data empty ctxt (Just t) (hsep (map ppr xs)) ksig cs decs\nppr_dec _ (NewtypeD ctxt t xs ksig c decs)\n  = ppr_newtype empty ctxt (Just t) (sep (map ppr xs)) ksig c decs\nppr_dec _  (ClassD ctxt c xs fds ds)\n  = text \"class\" <+> pprCxt ctxt <+> ppr c <+> hsep (map ppr xs) <+> ppr fds\n    $$ where_clause ds\nppr_dec _ (InstanceD o ctxt i ds) =\n        text \"instance\" <+> maybe empty ppr_overlap o <+> pprCxt ctxt <+> ppr i\n                                  $$ where_clause ds\nppr_dec _ (SigD f t)    = pprPrefixOcc f <+> dcolon <+> ppr t\nppr_dec _ (ForeignD f)  = ppr f\nppr_dec _ (InfixD fx n) = pprFixity n fx\nppr_dec _ (PragmaD p)   = ppr p\nppr_dec isTop (DataFamilyD tc tvs kind)\n  = text \"data\" <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind\n  where\n    maybeFamily | isTop     = text \"family\"\n                | otherwise = empty\n    maybeKind | (Just k') <- kind = dcolon <+> ppr k'\n              | otherwise = empty\nppr_dec isTop (DataInstD ctxt bndrs ty ksig cs decs)\n  = ppr_data (maybeInst <+> ppr_bndrs bndrs)\n             ctxt Nothing (ppr ty) ksig cs decs\n  where\n    maybeInst | isTop     = text \"instance\"\n              | otherwise = empty\nppr_dec isTop (NewtypeInstD ctxt bndrs ty ksig c decs)\n  = ppr_newtype (maybeInst <+> ppr_bndrs bndrs)\n                ctxt Nothing (ppr ty) ksig c decs\n  where\n    maybeInst | isTop     = text \"instance\"\n              | otherwise = empty\nppr_dec isTop (TySynInstD (TySynEqn mb_bndrs ty rhs))\n  = ppr_tySyn (maybeInst <+> ppr_bndrs mb_bndrs)\n              Nothing (ppr ty) rhs\n  where\n    maybeInst | isTop     = text \"instance\"\n              | otherwise = empty\nppr_dec isTop (OpenTypeFamilyD tfhead)\n  = text \"type\" <+> maybeFamily <+> ppr_tf_head tfhead\n  where\n    maybeFamily | isTop     = text \"family\"\n                | otherwise = empty\nppr_dec _ (ClosedTypeFamilyD tfhead eqns)\n  = hang (text \"type family\" <+> ppr_tf_head tfhead <+> text \"where\")\n      nestDepth (vcat (map ppr_eqn eqns))\n  where\n    ppr_eqn (TySynEqn mb_bndrs lhs rhs)\n      = ppr_bndrs mb_bndrs <+> ppr lhs <+> text \"=\" <+> ppr rhs\nppr_dec _ (RoleAnnotD name roles)\n  = hsep [ text \"type role\", ppr name ] <+> hsep (map ppr roles)\nppr_dec _ (StandaloneDerivD ds cxt ty)\n  = hsep [ text \"deriving\"\n         , maybe empty ppr_deriv_strategy ds\n         , text \"instance\"\n         , pprCxt cxt\n         , ppr ty ]\nppr_dec _ (DefaultSigD n ty)\n  = hsep [ text \"default\", pprPrefixOcc n, dcolon, ppr ty ]\nppr_dec _ (PatSynD name args dir pat)\n  = text \"pattern\" <+> pprNameArgs <+> ppr dir <+> pprPatRHS\n  where\n    pprNameArgs | InfixPatSyn a1 a2 <- args = ppr a1 <+> ppr name <+> ppr a2\n                | otherwise                 = ppr name <+> ppr args\n    pprPatRHS   | ExplBidir cls <- dir = hang (ppr pat <+> text \"where\")\n                                           nestDepth (ppr name <+> ppr cls)\n                | otherwise            = ppr pat\nppr_dec _ (PatSynSigD name ty)\n  = pprPatSynSig name ty\nppr_dec _ (ImplicitParamBindD n e)\n  = hsep [text ('?' : n), text \"=\", ppr e]\n\nppr_deriv_strategy :: DerivStrategy -> Doc\nppr_deriv_strategy ds =\n  case ds of\n    StockStrategy    -> text \"stock\"\n    AnyclassStrategy -> text \"anyclass\"\n    NewtypeStrategy  -> text \"newtype\"\n    ViaStrategy ty   -> text \"via\" <+> pprParendType ty\n\nppr_overlap :: Overlap -> Doc\nppr_overlap o = text $\n  case o of\n    Overlaps      -> \"{-# OVERLAPS #-}\"\n    Overlappable  -> \"{-# OVERLAPPABLE #-}\"\n    Overlapping   -> \"{-# OVERLAPPING #-}\"\n    Incoherent    -> \"{-# INCOHERENT #-}\"\n\nppr_data :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]\n         -> Doc\nppr_data maybeInst ctxt t argsDoc ksig cs decs\n  = sep [text \"data\" <+> maybeInst\n            <+> pprCxt ctxt\n            <+> case t of\n                 Just n -> pprName' Applied n <+> argsDoc\n                 Nothing -> argsDoc\n            <+> ksigDoc <+> maybeWhere,\n         nest nestDepth (sep (pref $ map ppr cs)),\n         if null decs\n           then empty\n           else nest nestDepth\n              $ vcat $ map ppr_deriv_clause decs]\n  where\n    pref :: [Doc] -> [Doc]\n    pref xs | isGadtDecl = xs\n    pref []              = []      -- No constructors; can't happen in H98\n    pref (d:ds)          = (char '=' <+> d):map (bar <+>) ds\n\n    maybeWhere :: Doc\n    maybeWhere | isGadtDecl = text \"where\"\n               | otherwise  = empty\n\n    isGadtDecl :: Bool\n    isGadtDecl = not (null cs) && all isGadtCon cs\n        where isGadtCon (GadtC _ _ _   ) = True\n              isGadtCon (RecGadtC _ _ _) = True\n              isGadtCon (ForallC _ _ x ) = isGadtCon x\n              isGadtCon  _               = False\n\n    ksigDoc = case ksig of\n                Nothing -> empty\n                Just k  -> dcolon <+> ppr k\n\nppr_newtype :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause]\n            -> Doc\nppr_newtype maybeInst ctxt t argsDoc ksig c decs\n  = sep [text \"newtype\" <+> maybeInst\n            <+> pprCxt ctxt\n            <+> case t of\n                 Just n -> ppr n <+> argsDoc\n                 Nothing -> argsDoc\n            <+> ksigDoc,\n         nest 2 (char '=' <+> ppr c),\n         if null decs\n           then empty\n           else nest nestDepth\n                $ vcat $ map ppr_deriv_clause decs]\n  where\n    ksigDoc = case ksig of\n                Nothing -> empty\n                Just k  -> dcolon <+> ppr k\n\nppr_deriv_clause :: DerivClause -> Doc\nppr_deriv_clause (DerivClause ds ctxt)\n  = text \"deriving\" <+> pp_strat_before\n                    <+> ppr_cxt_preds ctxt\n                    <+> pp_strat_after\n  where\n    -- @via@ is unique in that in comes /after/ the class being derived,\n    -- so we must special-case it.\n    (pp_strat_before, pp_strat_after) =\n      case ds of\n        Just (via@ViaStrategy{}) -> (empty, ppr_deriv_strategy via)\n        _                        -> (maybe empty ppr_deriv_strategy ds, empty)\n\nppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc\nppr_tySyn maybeInst t argsDoc rhs\n  = text \"type\" <+> maybeInst\n    <+> case t of\n         Just n -> ppr n <+> argsDoc\n         Nothing -> argsDoc\n    <+> text \"=\" <+> ppr rhs\n\nppr_tf_head :: TypeFamilyHead -> Doc\nppr_tf_head (TypeFamilyHead tc tvs res inj)\n  = ppr tc <+> hsep (map ppr tvs) <+> ppr res <+> maybeInj\n  where\n    maybeInj | (Just inj') <- inj = ppr inj'\n             | otherwise          = empty\n\nppr_bndrs :: Maybe [TyVarBndr] -> Doc\nppr_bndrs (Just bndrs) = text \"forall\" <+> sep (map ppr bndrs) <> text \".\"\nppr_bndrs Nothing = empty\n\n------------------------------\ninstance Ppr FunDep where\n    ppr (FunDep xs ys) = hsep (map ppr xs) <+> text \"->\" <+> hsep (map ppr ys)\n    ppr_list [] = empty\n    ppr_list xs = bar <+> commaSep xs\n\n------------------------------\ninstance Ppr FamilyResultSig where\n    ppr NoSig           = empty\n    ppr (KindSig k)     = dcolon <+> ppr k\n    ppr (TyVarSig bndr) = text \"=\" <+> ppr bndr\n\n------------------------------\ninstance Ppr InjectivityAnn where\n    ppr (InjectivityAnn lhs rhs) =\n        bar <+> ppr lhs <+> text \"->\" <+> hsep (map ppr rhs)\n\n------------------------------\ninstance Ppr Foreign where\n    ppr (ImportF callconv safety impent as typ)\n       = text \"foreign import\"\n     <+> showtextl callconv\n     <+> showtextl safety\n     <+> text (show impent)\n     <+> ppr as\n     <+> dcolon <+> ppr typ\n    ppr (ExportF callconv expent as typ)\n        = text \"foreign export\"\n      <+> showtextl callconv\n      <+> text (show expent)\n      <+> ppr as\n      <+> dcolon <+> ppr typ\n\n------------------------------\ninstance Ppr Pragma where\n    ppr (InlineP n inline rm phases)\n       = text \"{-#\"\n     <+> ppr inline\n     <+> ppr rm\n     <+> ppr phases\n     <+> ppr n\n     <+> text \"#-}\"\n    ppr (SpecialiseP n ty inline phases)\n       =   text \"{-# SPECIALISE\"\n       <+> maybe empty ppr inline\n       <+> ppr phases\n       <+> sep [ ppr n <+> dcolon\n               , nest 2 $ ppr ty ]\n       <+> text \"#-}\"\n    ppr (SpecialiseInstP inst)\n       = text \"{-# SPECIALISE instance\" <+> ppr inst <+> text \"#-}\"\n    ppr (RuleP n ty_bndrs tm_bndrs lhs rhs phases)\n       = sep [ text \"{-# RULES\" <+> pprString n <+> ppr phases\n             , nest 4 $ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs\n                                               <+> ppr lhs\n             , nest 4 $ char '=' <+> ppr rhs <+> text \"#-}\" ]\n      where ppr_ty_forall Nothing      = empty\n            ppr_ty_forall (Just bndrs) = text \"forall\"\n                                         <+> fsep (map ppr bndrs)\n                                         <+> char '.'\n            ppr_tm_forall Nothing | null tm_bndrs = empty\n            ppr_tm_forall _ = text \"forall\"\n                              <+> fsep (map ppr tm_bndrs)\n                              <+> char '.'\n    ppr (AnnP tgt expr)\n       = text \"{-# ANN\" <+> target1 tgt <+> ppr expr <+> text \"#-}\"\n      where target1 ModuleAnnotation    = text \"module\"\n            target1 (TypeAnnotation t)  = text \"type\" <+> ppr t\n            target1 (ValueAnnotation v) = ppr v\n    ppr (LineP line file)\n       = text \"{-# LINE\" <+> int line <+> text (show file) <+> text \"#-}\"\n    ppr (CompleteP cls mty)\n       = text \"{-# COMPLETE\" <+> (fsep $ punctuate comma $ map ppr cls)\n                <+> maybe empty (\\ty -> dcolon <+> ppr ty) mty\n\n------------------------------\ninstance Ppr Inline where\n    ppr NoInline  = text \"NOINLINE\"\n    ppr Inline    = text \"INLINE\"\n    ppr Inlinable = text \"INLINABLE\"\n\n------------------------------\ninstance Ppr RuleMatch where\n    ppr ConLike = text \"CONLIKE\"\n    ppr FunLike = empty\n\n------------------------------\ninstance Ppr Phases where\n    ppr AllPhases       = empty\n    ppr (FromPhase i)   = brackets $ int i\n    ppr (BeforePhase i) = brackets $ char '~' <> int i\n\n------------------------------\ninstance Ppr RuleBndr where\n    ppr (RuleVar n)         = ppr n\n    ppr (TypedRuleVar n ty) = parens $ ppr n <+> dcolon <+> ppr ty\n\n------------------------------\ninstance Ppr Clause where\n    ppr (Clause ps rhs ds) = hsep (map (pprPat appPrec) ps) <+> pprBody True rhs\n                             $$ where_clause ds\n\n------------------------------\ninstance Ppr Con where\n    ppr (NormalC c sts) = ppr c <+> sep (map pprBangType sts)\n\n    ppr (RecC c vsts)\n        = ppr c <+> braces (sep (punctuate comma $ map pprVarBangType vsts))\n\n    ppr (InfixC st1 c st2) = pprBangType st1\n                         <+> pprName' Infix c\n                         <+> pprBangType st2\n\n    ppr (ForallC ns ctxt (GadtC c sts ty))\n        = commaSepApplied c <+> dcolon <+> pprForall ns ctxt\n      <+> pprGadtRHS sts ty\n\n    ppr (ForallC ns ctxt (RecGadtC c vsts ty))\n        = commaSepApplied c <+> dcolon <+> pprForall ns ctxt\n      <+> pprRecFields vsts ty\n\n    ppr (ForallC ns ctxt con)\n        = pprForall ns ctxt <+> ppr con\n\n    ppr (GadtC c sts ty)\n        = commaSepApplied c <+> dcolon <+> pprGadtRHS sts ty\n\n    ppr (RecGadtC c vsts ty)\n        = commaSepApplied c <+> dcolon <+> pprRecFields vsts ty\n\ninstance Ppr PatSynDir where\n  ppr Unidir        = text \"<-\"\n  ppr ImplBidir     = text \"=\"\n  ppr (ExplBidir _) = text \"<-\"\n    -- the ExplBidir's clauses are pretty printed together with the\n    -- entire pattern synonym; so only print the direction here.\n\ninstance Ppr PatSynArgs where\n  ppr (PrefixPatSyn args) = sep $ map ppr args\n  ppr (InfixPatSyn a1 a2) = ppr a1 <+> ppr a2\n  ppr (RecordPatSyn sels) = braces $ sep (punctuate comma (map ppr sels))\n\ncommaSepApplied :: [Name] -> Doc\ncommaSepApplied = commaSepWith (pprName' Applied)\n\npprForall :: [TyVarBndr] -> Cxt -> Doc\npprForall = pprForall' ForallInvis\n\npprForallVis :: [TyVarBndr] -> Cxt -> Doc\npprForallVis = pprForall' ForallVis\n\npprForall' :: ForallVisFlag -> [TyVarBndr] -> Cxt -> Doc\npprForall' fvf tvs cxt\n  -- even in the case without any tvs, there could be a non-empty\n  -- context cxt (e.g., in the case of pattern synonyms, where there\n  -- are multiple forall binders and contexts).\n  | [] <- tvs = pprCxt cxt\n  | otherwise = text \"forall\" <+> hsep (map ppr tvs)\n                              <+> separator <+> pprCxt cxt\n  where\n    separator = case fvf of\n                  ForallVis   -> text \"->\"\n                  ForallInvis -> char '.'\n\npprRecFields :: [(Name, Strict, Type)] -> Type -> Doc\npprRecFields vsts ty\n    = braces (sep (punctuate comma $ map pprVarBangType vsts))\n  <+> arrow <+> ppr ty\n\npprGadtRHS :: [(Strict, Type)] -> Type -> Doc\npprGadtRHS [] ty\n    = ppr ty\npprGadtRHS sts ty\n    = sep (punctuate (space <> arrow) (map pprBangType sts))\n  <+> arrow <+> ppr ty\n\n------------------------------\npprVarBangType :: VarBangType -> Doc\n-- Slight infelicity: with print non-atomic type with parens\npprVarBangType (v, bang, t) = ppr v <+> dcolon <+> pprBangType (bang, t)\n\n------------------------------\npprBangType :: BangType -> Doc\n-- Make sure we print\n--\n-- Con {-# UNPACK #-} a\n--\n-- rather than\n--\n-- Con {-# UNPACK #-}a\n--\n-- when there's no strictness annotation. If there is a strictness annotation,\n-- it's okay to not put a space between it and the type.\npprBangType (bt@(Bang _ NoSourceStrictness), t) = ppr bt <+> pprParendType t\npprBangType (bt, t) = ppr bt <> pprParendType t\n\n------------------------------\ninstance Ppr Bang where\n    ppr (Bang su ss) = ppr su <+> ppr ss\n\n------------------------------\ninstance Ppr SourceUnpackedness where\n    ppr NoSourceUnpackedness = empty\n    ppr SourceNoUnpack       = text \"{-# NOUNPACK #-}\"\n    ppr SourceUnpack         = text \"{-# UNPACK #-}\"\n\n------------------------------\ninstance Ppr SourceStrictness where\n    ppr NoSourceStrictness = empty\n    ppr SourceLazy         = char '~'\n    ppr SourceStrict       = char '!'\n\n------------------------------\ninstance Ppr DecidedStrictness where\n    ppr DecidedLazy   = empty\n    ppr DecidedStrict = char '!'\n    ppr DecidedUnpack = text \"{-# UNPACK #-} !\"\n\n------------------------------\n{-# DEPRECATED pprVarStrictType\n               \"As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'pprVarBangType' instead.\" #-}\npprVarStrictType :: (Name, Strict, Type) -> Doc\npprVarStrictType = pprVarBangType\n\n------------------------------\n{-# DEPRECATED pprStrictType\n               \"As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'pprBangType' instead.\" #-}\npprStrictType :: (Strict, Type) -> Doc\npprStrictType = pprBangType\n\n------------------------------\npprParendType :: Type -> Doc\npprParendType (VarT v)            = pprName' Applied v\n-- `Applied` is used here instead of `ppr` because of infix names (#13887)\npprParendType (ConT c)            = pprName' Applied c\npprParendType (TupleT 0)          = text \"()\"\npprParendType (TupleT n)          = parens (hcat (replicate (n-1) comma))\npprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma\npprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar\npprParendType ArrowT              = parens (text \"->\")\npprParendType ListT               = text \"[]\"\npprParendType (LitT l)            = pprTyLit l\npprParendType (PromotedT c)       = text \"'\" <> pprName' Applied c\npprParendType (PromotedTupleT 0)  = text \"'()\"\npprParendType (PromotedTupleT n)  = quoteParens (hcat (replicate (n-1) comma))\npprParendType PromotedNilT        = text \"'[]\"\npprParendType PromotedConsT       = text \"'(:)\"\npprParendType StarT               = char '*'\npprParendType ConstraintT         = text \"Constraint\"\npprParendType (SigT ty k)         = parens (ppr ty <+> text \"::\" <+> ppr k)\npprParendType WildCardT           = char '_'\npprParendType (InfixT x n y)      = parens (ppr x <+> pprName' Infix n <+> ppr y)\npprParendType t@(UInfixT {})      = parens (pprUInfixT t)\npprParendType (ParensT t)         = ppr t\npprParendType tuple | (TupleT n, args) <- split tuple\n                    , length args == n\n                    = parens (commaSep args)\npprParendType (ImplicitParamT n t)= text ('?':n) <+> text \"::\" <+> ppr t\npprParendType EqualityT           = text \"(~)\"\npprParendType t@(ForallT {})      = parens (ppr t)\npprParendType t@(ForallVisT {})   = parens (ppr t)\npprParendType t@(AppT {})         = parens (ppr t)\npprParendType t@(AppKindT {})     = parens (ppr t)\n\npprUInfixT :: Type -> Doc\npprUInfixT (UInfixT x n y) = pprUInfixT x <+> pprName' Infix n <+> pprUInfixT y\npprUInfixT t               = ppr t\n\ninstance Ppr Type where\n    ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty]\n    ppr (ForallVisT tvars ty)   = sep [pprForallVis tvars [], ppr ty]\n    ppr ty = pprTyApp (split ty)\n       -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind)\n       -- See Note [Pretty-printing kind signatures]\ninstance Ppr TypeArg where\n    ppr (TANormal ty) = ppr ty\n    ppr (TyArg ki) = char '@' <> ppr ki\n\npprParendTypeArg :: TypeArg -> Doc\npprParendTypeArg (TANormal ty) = pprParendType ty\npprParendTypeArg (TyArg ki) = char '@' <> pprParendType ki\n{- Note [Pretty-printing kind signatures]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nGHC's parser only recognises a kind signature in a type when there are\nparens around it.  E.g. the parens are required here:\n   f :: (Int :: *)\n   type instance F Int = (Bool :: *)\nSo we always print a SigT with parens (see Trac #10050). -}\n\npprTyApp :: (Type, [TypeArg]) -> Doc\npprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text \"->\", ppr arg2]\npprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) =\n    sep [pprFunArgType arg1 <+> text \"~\", ppr arg2]\npprTyApp (ListT, [TANormal arg]) = brackets (ppr arg)\npprTyApp (TupleT n, args)\n | length args == n = parens (commaSep args)\npprTyApp (PromotedTupleT n, args)\n | length args == n = quoteParens (commaSep args)\npprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args)\n\npprFunArgType :: Type -> Doc    -- Should really use a precedence argument\n-- Everything except forall and (->) binds more tightly than (->)\npprFunArgType ty@(ForallT {})                 = parens (ppr ty)\npprFunArgType ty@(ForallVisT {})              = parens (ppr ty)\npprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty)\npprFunArgType ty@(SigT _ _)                   = parens (ppr ty)\npprFunArgType ty                              = ppr ty\n\ndata ForallVisFlag = ForallVis   -- forall a -> {...}\n                   | ForallInvis -- forall a.   {...}\n  deriving Show\n\ndata TypeArg = TANormal Type\n             | TyArg Kind\n\nsplit :: Type -> (Type, [TypeArg])    -- Split into function and args\nsplit t = go t []\n    where go (AppT t1 t2) args = go t1 (TANormal t2:args)\n          go (AppKindT ty ki) args = go ty (TyArg ki:args)\n          go ty           args = (ty, args)\n\npprTyLit :: TyLit -> Doc\npprTyLit (NumTyLit n) = integer n\npprTyLit (StrTyLit s) = text (show s)\n\ninstance Ppr TyLit where\n  ppr = pprTyLit\n\n------------------------------\ninstance Ppr TyVarBndr where\n    ppr (PlainTV nm)    = ppr nm\n    ppr (KindedTV nm k) = parens (ppr nm <+> dcolon <+> ppr k)\n\ninstance Ppr Role where\n    ppr NominalR          = text \"nominal\"\n    ppr RepresentationalR = text \"representational\"\n    ppr PhantomR          = text \"phantom\"\n    ppr InferR            = text \"_\"\n\n------------------------------\npprCxt :: Cxt -> Doc\npprCxt [] = empty\npprCxt ts = ppr_cxt_preds ts <+> text \"=>\"\n\nppr_cxt_preds :: Cxt -> Doc\nppr_cxt_preds [] = empty\nppr_cxt_preds [t@ImplicitParamT{}] = parens (ppr t)\nppr_cxt_preds [t@ForallT{}] = parens (ppr t)\nppr_cxt_preds [t] = ppr t\nppr_cxt_preds ts = parens (commaSep ts)\n\n------------------------------\ninstance Ppr Range where\n    ppr = brackets . pprRange\n        where pprRange :: Range -> Doc\n              pprRange (FromR e) = ppr e <> text \"..\"\n              pprRange (FromThenR e1 e2) = ppr e1 <> text \",\"\n                                        <> ppr e2 <> text \"..\"\n              pprRange (FromToR e1 e2) = ppr e1 <> text \"..\" <> ppr e2\n              pprRange (FromThenToR e1 e2 e3) = ppr e1 <> text \",\"\n                                             <> ppr e2 <> text \"..\"\n                                             <> ppr e3\n\n------------------------------\nwhere_clause :: [Dec] -> Doc\nwhere_clause [] = empty\nwhere_clause ds = nest nestDepth $ text \"where\" <+> vcat (map (ppr_dec False) ds)\n\nshowtextl :: Show a => a -> Doc\nshowtextl = text . map toLower . show\n\nhashParens :: Doc -> Doc\nhashParens d = text \"(# \" <> d <> text \" #)\"\n\nquoteParens :: Doc -> Doc\nquoteParens d = text \"'(\" <> d <> text \")\"\n\n-----------------------------\ninstance Ppr Loc where\n  ppr (Loc { loc_module = md\n           , loc_package = pkg\n           , loc_start = (start_ln, start_col)\n           , loc_end = (end_ln, end_col) })\n    = hcat [ text pkg, colon, text md, colon\n           , parens $ int start_ln <> comma <> int start_col\n           , text \"-\"\n           , parens $ int end_ln <> comma <> int end_col ]\n\n-- Takes a list of printable things and prints them separated by commas followed\n-- by space.\ncommaSep :: Ppr a => [a] -> Doc\ncommaSep = commaSepWith ppr\n\n-- Takes a list of things and prints them with the given pretty-printing\n-- function, separated by commas followed by space.\ncommaSepWith :: (a -> Doc) -> [a] -> Doc\ncommaSepWith pprFun = sep . punctuate comma . map pprFun\n\n-- Takes a list of printable things and prints them separated by semicolons\n-- followed by space.\nsemiSep :: Ppr a => [a] -> Doc\nsemiSep = sep . punctuate semi . map ppr\n\n-- Prints out the series of vertical bars that wraps an expression or pattern\n-- used in an unboxed sum.\nunboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc\nunboxedSumBars d alt arity = hashParens $\n    bars (alt-1) <> d <> bars (arity - alt)\n  where\n    bars i = hsep (replicate i bar)\n\n-- Text containing the vertical bar character.\nbar :: Doc\nbar = char '|'\n", "num_lines": 918}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n\n-- | Monadic front-end to Text.PrettyPrint\n\nmodule Language.Haskell.TH.PprLib (\n\n        -- * The document type\n        Doc,            -- Abstract, instance of Show\n        PprM,\n\n        -- * Primitive Documents\n        empty,\n        semi, comma, colon, dcolon, space, equals, arrow,\n        lparen, rparen, lbrack, rbrack, lbrace, rbrace,\n\n        -- * Converting values into documents\n        text, char, ptext,\n        int, integer, float, double, rational,\n\n        -- * Wrapping documents in delimiters\n        parens, brackets, braces, quotes, doubleQuotes,\n\n        -- * Combining documents\n        (<>), (<+>), hcat, hsep,\n        ($$), ($+$), vcat,\n        sep, cat,\n        fsep, fcat,\n        nest,\n        hang, punctuate,\n\n        -- * Predicates on documents\n        isEmpty,\n\n    to_HPJ_Doc, pprName, pprName'\n  ) where\n\n\nimport Language.Haskell.TH.Syntax\n    (Name(..), showName', NameFlavour(..), NameIs(..))\nimport qualified Text.PrettyPrint as HPJ\nimport Control.Monad (liftM, liftM2, ap)\nimport Language.Haskell.TH.Lib.Map ( Map )\nimport qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )\nimport Prelude hiding ((<>))\n\ninfixl 6 <> \ninfixl 6 <+>\ninfixl 5 $$, $+$\n\n-- ---------------------------------------------------------------------------\n-- The interface\n\n-- The primitive Doc values\n\ninstance Show Doc where\n   show d = HPJ.render (to_HPJ_Doc d)\n\nisEmpty :: Doc    -> PprM Bool;  -- ^ Returns 'True' if the document is empty\n\nempty   :: Doc;                 -- ^ An empty document\nsemi    :: Doc;                 -- ^ A ';' character\ncomma   :: Doc;                 -- ^ A ',' character\ncolon   :: Doc;                 -- ^ A ':' character\ndcolon  :: Doc;                 -- ^ A \"::\" string\nspace   :: Doc;                 -- ^ A space character\nequals  :: Doc;                 -- ^ A '=' character\narrow   :: Doc;                 -- ^ A \"->\" string\nlparen  :: Doc;                 -- ^ A '(' character\nrparen  :: Doc;                 -- ^ A ')' character\nlbrack  :: Doc;                 -- ^ A '[' character\nrbrack  :: Doc;                 -- ^ A ']' character\nlbrace  :: Doc;                 -- ^ A '{' character\nrbrace  :: Doc;                 -- ^ A '}' character\n\ntext     :: String   -> Doc\nptext    :: String   -> Doc\nchar     :: Char     -> Doc\nint      :: Int      -> Doc\ninteger  :: Integer  -> Doc\nfloat    :: Float    -> Doc\ndouble   :: Double   -> Doc\nrational :: Rational -> Doc\n\n\nparens       :: Doc -> Doc;     -- ^ Wrap document in @(...)@\nbrackets     :: Doc -> Doc;     -- ^ Wrap document in @[...]@\nbraces       :: Doc -> Doc;     -- ^ Wrap document in @{...}@\nquotes       :: Doc -> Doc;     -- ^ Wrap document in @\\'...\\'@\ndoubleQuotes :: Doc -> Doc;     -- ^ Wrap document in @\\\"...\\\"@\n\n-- Combining @Doc@ values\n\n(<>)   :: Doc -> Doc -> Doc;     -- ^Beside\nhcat   :: [Doc] -> Doc;          -- ^List version of '<>'\n(<+>)  :: Doc -> Doc -> Doc;     -- ^Beside, separated by space\nhsep   :: [Doc] -> Doc;          -- ^List version of '<+>'\n\n($$)   :: Doc -> Doc -> Doc;     -- ^Above; if there is no\n                                 -- overlap it \\\"dovetails\\\" the two\n($+$)  :: Doc -> Doc -> Doc;     -- ^Above, without dovetailing.\nvcat   :: [Doc] -> Doc;          -- ^List version of '$$'\n\ncat    :: [Doc] -> Doc;          -- ^ Either hcat or vcat\nsep    :: [Doc] -> Doc;          -- ^ Either hsep or vcat\nfcat   :: [Doc] -> Doc;          -- ^ \\\"Paragraph fill\\\" version of cat\nfsep   :: [Doc] -> Doc;          -- ^ \\\"Paragraph fill\\\" version of sep\n\nnest   :: Int -> Doc -> Doc;     -- ^ Nested\n\n\n-- GHC-specific ones.\n\nhang :: Doc -> Int -> Doc -> Doc;      -- ^ @hang d1 n d2 = sep [d1, nest n d2]@\npunctuate :: Doc -> [Doc] -> [Doc]\n   -- ^ @punctuate p [d1, ... dn] = [d1 \\<> p, d2 \\<> p, ... dn-1 \\<> p, dn]@\n\n-- ---------------------------------------------------------------------------\n-- The \"implementation\"\n\ntype State = (Map Name Name, Int)\ndata PprM a = PprM { runPprM :: State -> (a, State) }\n\npprName :: Name -> Doc\npprName = pprName' Alone\n\npprName' :: NameIs -> Name -> Doc\npprName' ni n@(Name o (NameU _))\n = PprM $ \\s@(fm, i)\n        -> let (n', s') = case Map.lookup n fm of\n                         Just d -> (d, s)\n                         Nothing -> let n'' = Name o (NameU i)\n                                    in (n'', (Map.insert n n'' fm, i + 1))\n           in (HPJ.text $ showName' ni n', s')\npprName' ni n = text $ showName' ni n\n\n{-\ninstance Show Name where\n  show (Name occ (NameU u))    = occString occ ++ \"_\" ++ show (I# u)\n  show (Name occ NameS)        = occString occ\n  show (Name occ (NameG ns m)) = modString m ++ \".\" ++ occString occ\n\ndata Name = Name OccName NameFlavour\n\ndata NameFlavour\n  | NameU Int#                  -- A unique local name\n-}\n\nto_HPJ_Doc :: Doc -> HPJ.Doc\nto_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)\n\ninstance Functor PprM where\n      fmap = liftM\n\ninstance Applicative PprM where\n      pure x = PprM $ \\s -> (x, s)\n      (<*>) = ap\n\ninstance Monad PprM where\n    m >>= k  = PprM $ \\s -> let (x, s') = runPprM m s\n                            in runPprM (k x) s'\n\ntype Doc = PprM HPJ.Doc\n\n-- The primitive Doc values\n\nisEmpty = liftM HPJ.isEmpty\n\nempty = return HPJ.empty\nsemi = return HPJ.semi\ncomma = return HPJ.comma\ncolon = return HPJ.colon\ndcolon = return $ HPJ.text \"::\"\nspace = return HPJ.space\nequals = return HPJ.equals\narrow = return $ HPJ.text \"->\"\nlparen = return HPJ.lparen\nrparen = return HPJ.rparen\nlbrack = return HPJ.lbrack\nrbrack = return HPJ.rbrack\nlbrace = return HPJ.lbrace\nrbrace = return HPJ.rbrace\n\ntext = return . HPJ.text\nptext = return . HPJ.ptext\nchar = return . HPJ.char\nint = return . HPJ.int\ninteger = return . HPJ.integer\nfloat = return . HPJ.float\ndouble = return . HPJ.double\nrational = return . HPJ.rational\n\n\nparens = liftM HPJ.parens\nbrackets = liftM HPJ.brackets\nbraces = liftM HPJ.braces\nquotes = liftM HPJ.quotes\ndoubleQuotes = liftM HPJ.doubleQuotes\n\n-- Combining @Doc@ values\n\n(<>) = liftM2 (HPJ.<>)\nhcat = liftM HPJ.hcat . sequence\n(<+>) = liftM2 (HPJ.<+>)\nhsep = liftM HPJ.hsep . sequence\n\n($$) = liftM2 (HPJ.$$)\n($+$) = liftM2 (HPJ.$+$)\nvcat = liftM HPJ.vcat . sequence\n\ncat  = liftM HPJ.cat . sequence\nsep  = liftM HPJ.sep . sequence\nfcat = liftM HPJ.fcat . sequence\nfsep = liftM HPJ.fsep . sequence\n\nnest n = liftM (HPJ.nest n)\n\nhang d1 n d2 = do d1' <- d1\n                  d2' <- d2\n                  return (HPJ.hang d1' n d2')\n\n-- punctuate uses the same definition as Text.PrettyPrint\npunctuate _ []     = []\npunctuate p (d:ds) = go d ds\n                   where\n                     go d' [] = [d']\n                     go d' (e:es) = (d' <> p) : go e es\n", "num_lines": 227}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n{- |\nModule : Language.Haskell.TH.Quote\nDescription : Quasi-quoting support for Template Haskell\n\nTemplate Haskell supports quasiquoting, which permits users to construct\nprogram fragments by directly writing concrete syntax.  A quasiquoter is\nessentially a function with takes a string to a Template Haskell AST.\nThis module defines the 'QuasiQuoter' datatype, which specifies a\nquasiquoter @q@ which can be invoked using the syntax\n@[q| ... string to parse ... |]@ when the @QuasiQuotes@ language\nextension is enabled, and some utility functions for manipulating\nquasiquoters.  Nota bene: this package does not define any parsers,\nthat is up to you.\n-}\nmodule Language.Haskell.TH.Quote(\n        QuasiQuoter(..),\n        quoteFile,\n        -- * For backwards compatibility\n        dataToQa, dataToExpQ, dataToPatQ\n    ) where\n\nimport Language.Haskell.TH.Syntax\nimport Prelude\n\n-- | The 'QuasiQuoter' type, a value @q@ of this type can be used\n-- in the syntax @[q| ... string to parse ...|]@.  In fact, for\n-- convenience, a 'QuasiQuoter' actually defines multiple quasiquoters\n-- to be used in different splice contexts; if you are only interested\n-- in defining a quasiquoter to be used for expressions, you would\n-- define a 'QuasiQuoter' with only 'quoteExp', and leave the other\n-- fields stubbed out with errors.\ndata QuasiQuoter = QuasiQuoter {\n    -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@\n    quoteExp  :: String -> Q Exp,\n    -- | Quasi-quoter for patterns, invoked by quotes like @f $[q|...] = rhs@\n    quotePat  :: String -> Q Pat,\n    -- | Quasi-quoter for types, invoked by quotes like @f :: $[q|...]@\n    quoteType :: String -> Q Type,\n    -- | Quasi-quoter for declarations, invoked by top-level quotes\n    quoteDec  :: String -> Q [Dec]\n    }\n\n-- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read\n-- the data out of a file.  For example, suppose @asmq@ is an\n-- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]\n-- as an expression. Then if you define @asmq_f = quoteFile asmq@, then\n-- the quote [asmq_f|foo.s|] will take input from file @\"foo.s\"@ instead\n-- of the inline text\nquoteFile :: QuasiQuoter -> QuasiQuoter\nquoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd }) \n  = QuasiQuoter { quoteExp = get qe, quotePat = get qp, quoteType = get qt, quoteDec = get qd }\n  where\n   get :: (String -> Q a) -> String -> Q a\n   get old_quoter file_name = do { file_cts <- runIO (readFile file_name) \n                                 ; addDependentFile file_name\n                                 ; old_quoter file_cts }\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, DeriveDataTypeable,\n             DeriveGeneric, FlexibleInstances, DefaultSignatures,\n             RankNTypes, RoleAnnotations, ScopedTypeVariables,\n             Trustworthy #-}\n\n{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Language.Haskell.Syntax\n-- Copyright   :  (c) The University of Glasgow 2003\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Abstract syntax definitions for Template Haskell.\n--\n-----------------------------------------------------------------------------\n\nmodule Language.Haskell.TH.Syntax\n    ( module Language.Haskell.TH.Syntax\n      -- * Language extensions\n    , module Language.Haskell.TH.LanguageExtensions\n    , ForeignSrcLang(..)\n    ) where\n\nimport Data.Data hiding (Fixity(..))\nimport Data.IORef\nimport System.IO.Unsafe ( unsafePerformIO )\nimport Control.Monad (liftM)\nimport Control.Monad.IO.Class (MonadIO (..))\nimport System.IO        ( hPutStrLn, stderr )\nimport Data.Char        ( isAlpha, isAlphaNum, isUpper )\nimport Data.Int\nimport Data.List.NonEmpty ( NonEmpty(..) )\nimport Data.Void        ( Void, absurd )\nimport Data.Word\nimport Data.Ratio\nimport GHC.Generics     ( Generic )\nimport GHC.Lexeme       ( startsVarSym, startsVarId )\nimport GHC.ForeignSrcLang.Type\nimport Language.Haskell.TH.LanguageExtensions\nimport Numeric.Natural\nimport Prelude\n\nimport qualified Control.Monad.Fail as Fail\n\n-----------------------------------------------------\n--\n--              The Quasi class\n--\n-----------------------------------------------------\n\nclass (MonadIO m, Fail.MonadFail m) => Quasi m where\n  qNewName :: String -> m Name\n        -- ^ Fresh names\n\n        -- Error reporting and recovery\n  qReport  :: Bool -> String -> m ()    -- ^ Report an error (True) or warning (False)\n                                        -- ...but carry on; use 'fail' to stop\n  qRecover :: m a -- ^ the error handler\n           -> m a -- ^ action which may fail\n           -> m a               -- ^ Recover from the monadic 'fail'\n\n        -- Inspect the type-checker's environment\n  qLookupName :: Bool -> String -> m (Maybe Name)\n       -- True <=> type namespace, False <=> value namespace\n  qReify          :: Name -> m Info\n  qReifyFixity    :: Name -> m (Maybe Fixity)\n  qReifyInstances :: Name -> [Type] -> m [Dec]\n       -- Is (n tys) an instance?\n       -- Returns list of matching instance Decs\n       --    (with empty sub-Decs)\n       -- Works for classes and type functions\n  qReifyRoles         :: Name -> m [Role]\n  qReifyAnnotations   :: Data a => AnnLookup -> m [a]\n  qReifyModule        :: Module -> m ModuleInfo\n  qReifyConStrictness :: Name -> m [DecidedStrictness]\n\n  qLocation :: m Loc\n\n  qRunIO :: IO a -> m a\n  qRunIO = liftIO\n  -- ^ Input/output (dangerous)\n\n  qAddDependentFile :: FilePath -> m ()\n\n  qAddTempFile :: String -> m FilePath\n\n  qAddTopDecls :: [Dec] -> m ()\n\n  qAddForeignFilePath :: ForeignSrcLang -> String -> m ()\n\n  qAddModFinalizer :: Q () -> m ()\n\n  qAddCorePlugin :: String -> m ()\n\n  qGetQ :: Typeable a => m (Maybe a)\n\n  qPutQ :: Typeable a => a -> m ()\n\n  qIsExtEnabled :: Extension -> m Bool\n  qExtsEnabled :: m [Extension]\n\n-----------------------------------------------------\n--      The IO instance of Quasi\n--\n--  This instance is used only when running a Q\n--  computation in the IO monad, usually just to\n--  print the result.  There is no interesting\n--  type environment, so reification isn't going to\n--  work.\n--\n-----------------------------------------------------\n\ninstance Quasi IO where\n  qNewName s = do { n <- atomicModifyIORef' counter (\\x -> (x + 1, x))\n                  ; pure (mkNameU s n) }\n\n  qReport True  msg = hPutStrLn stderr (\"Template Haskell error: \" ++ msg)\n  qReport False msg = hPutStrLn stderr (\"Template Haskell error: \" ++ msg)\n\n  qLookupName _ _       = badIO \"lookupName\"\n  qReify _              = badIO \"reify\"\n  qReifyFixity _        = badIO \"reifyFixity\"\n  qReifyInstances _ _   = badIO \"reifyInstances\"\n  qReifyRoles _         = badIO \"reifyRoles\"\n  qReifyAnnotations _   = badIO \"reifyAnnotations\"\n  qReifyModule _        = badIO \"reifyModule\"\n  qReifyConStrictness _ = badIO \"reifyConStrictness\"\n  qLocation             = badIO \"currentLocation\"\n  qRecover _ _          = badIO \"recover\" -- Maybe we could fix this?\n  qAddDependentFile _   = badIO \"addDependentFile\"\n  qAddTempFile _        = badIO \"addTempFile\"\n  qAddTopDecls _        = badIO \"addTopDecls\"\n  qAddForeignFilePath _ _ = badIO \"addForeignFilePath\"\n  qAddModFinalizer _    = badIO \"addModFinalizer\"\n  qAddCorePlugin _      = badIO \"addCorePlugin\"\n  qGetQ                 = badIO \"getQ\"\n  qPutQ _               = badIO \"putQ\"\n  qIsExtEnabled _       = badIO \"isExtEnabled\"\n  qExtsEnabled          = badIO \"extsEnabled\"\n\nbadIO :: String -> IO a\nbadIO op = do   { qReport True (\"Can't do `\" ++ op ++ \"' in the IO monad\")\n                ; fail \"Template Haskell failure\" }\n\n-- Global variable to generate unique symbols\ncounter :: IORef Int\n{-# NOINLINE counter #-}\ncounter = unsafePerformIO (newIORef 0)\n\n\n-----------------------------------------------------\n--\n--              The Q monad\n--\n-----------------------------------------------------\n\nnewtype Q a = Q { unQ :: forall m. Quasi m => m a }\n\n-- \\\"Runs\\\" the 'Q' monad. Normal users of Template Haskell\n-- should not need this function, as the splice brackets @$( ... )@\n-- are the usual way of running a 'Q' computation.\n--\n-- This function is primarily used in GHC internals, and for debugging\n-- splices by running them in 'IO'.\n--\n-- Note that many functions in 'Q', such as 'reify' and other compiler\n-- queries, are not supported when running 'Q' in 'IO'; these operations\n-- simply fail at runtime. Indeed, the only operations guaranteed to succeed\n-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.\nrunQ :: Quasi m => Q a -> m a\nrunQ (Q m) = m\n\ninstance Monad Q where\n  Q m >>= k  = Q (m >>= \\x -> unQ (k x))\n  (>>) = (*>)\n#if !MIN_VERSION_base(4,13,0)\n  fail       = Fail.fail\n#endif\n\ninstance Fail.MonadFail Q where\n  fail s     = report True s >> Q (Fail.fail \"Q monad failure\")\n\ninstance Functor Q where\n  fmap f (Q x) = Q (fmap f x)\n\ninstance Applicative Q where\n  pure x = Q (pure x)\n  Q f <*> Q x = Q (f <*> x)\n  Q m *> Q n = Q (m *> n)\n\n-----------------------------------------------------\n--\n--              The TExp type\n--\n-----------------------------------------------------\n\ntype role TExp nominal   -- See Note [Role of TExp]\nnewtype TExp a = TExp\n  { unType :: Exp -- ^ Underlying untyped Template Haskell expression\n  }\n-- ^ Represents an expression which has type @a@. Built on top of 'Exp', typed\n-- expressions allow for type-safe splicing via:\n--\n--   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if\n--     that expression has type @a@, then the quotation has type\n--     @'Q' ('TExp' a)@\n--\n--   - typed splices inside of typed quotes, written as @$$(...)@ where @...@\n--     is an arbitrary expression of type @'Q' ('TExp' a)@\n--\n-- Traditional expression quotes and splices let us construct ill-typed\n-- expressions:\n--\n-- >>> fmap ppr $ runQ [| True == $( [| \"foo\" |] ) |]\n-- GHC.Types.True GHC.Classes.== \"foo\"\n-- >>> GHC.Types.True GHC.Classes.== \"foo\"\n-- <interactive> error:\n--     \u00e2\u20ac\u00a2 Couldn't match expected type \u00e2\u20ac\u02dcBool\u00e2\u20ac\u2122 with actual type \u00e2\u20ac\u02dc[Char]\u00e2\u20ac\u2122\n--     \u00e2\u20ac\u00a2 In the second argument of \u00e2\u20ac\u02dc(==)\u00e2\u20ac\u2122, namely \u00e2\u20ac\u02dc\"foo\"\u00e2\u20ac\u2122\n--       In the expression: True == \"foo\"\n--       In an equation for \u00e2\u20ac\u02dcit\u00e2\u20ac\u2122: it = True == \"foo\"\n--\n-- With typed expressions, the type error occurs when /constructing/ the\n-- Template Haskell expression:\n--\n-- >>> fmap ppr $ runQ [|| True == $$( [|| \"foo\" ||] ) ||]\n-- <interactive> error:\n--     \u00e2\u20ac\u00a2 Couldn't match type \u00e2\u20ac\u02dc[Char]\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dcBool\u00e2\u20ac\u2122\n--       Expected type: Q (TExp Bool)\n--         Actual type: Q (TExp [Char])\n--     \u00e2\u20ac\u00a2 In the Template Haskell quotation [|| \"foo\" ||]\n--       In the expression: [|| \"foo\" ||]\n--       In the Template Haskell splice $$([|| \"foo\" ||])\n\n-- | Discard the type annotation and produce a plain Template Haskell\n-- expression\nunTypeQ :: Q (TExp a) -> Q Exp\nunTypeQ m = do { TExp e <- m\n               ; return e }\n\n-- | Annotate the Template Haskell expression with a type\n--\n-- This is unsafe because GHC cannot check for you that the expression\n-- really does have the type you claim it has.\nunsafeTExpCoerce :: Q Exp -> Q (TExp a)\nunsafeTExpCoerce m = do { e <- m\n                        ; return (TExp e) }\n\n{- Note [Role of TExp]\n~~~~~~~~~~~~~~~~~~~~~~\nTExp's argument must have a nominal role, not phantom as would\nbe inferred (Trac #8459).  Consider\n\n  e :: TExp Age\n  e = MkAge 3\n\n  foo = $(coerce e) + 4::Int\n\nThe splice will evaluate to (MkAge 3) and you can't add that to\n4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}\n\n----------------------------------------------------\n-- Packaged versions for the programmer, hiding the Quasi-ness\n\n{- |\nGenerate a fresh name, which cannot be captured.\n\nFor example, this:\n\n@f = $(do\n  nm1 <- newName \\\"x\\\"\n  let nm2 = 'mkName' \\\"x\\\"\n  return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))\n )@\n\nwill produce the splice\n\n>f = \\x0 -> \\x -> x0\n\nIn particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,\nand is not captured by the binding @VarP nm2@.\n\nAlthough names generated by @newName@ cannot /be captured/, they can\n/capture/ other names. For example, this:\n\n>g = $(do\n>  nm1 <- newName \"x\"\n>  let nm2 = mkName \"x\"\n>  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))\n> )\n\nwill produce the splice\n\n>g = \\x -> \\x0 -> x0\n\nsince the occurrence @VarE nm2@ is captured by the innermost binding\nof @x@, namely @VarP nm1@.\n-}\nnewName :: String -> Q Name\nnewName s = Q (qNewName s)\n\n-- | Report an error (True) or warning (False),\n-- but carry on; use 'fail' to stop.\nreport  :: Bool -> String -> Q ()\nreport b s = Q (qReport b s)\n{-# DEPRECATED report \"Use reportError or reportWarning instead\" #-} -- deprecated in 7.6\n\n-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.\nreportError :: String -> Q ()\nreportError = report True\n\n-- | Report a warning to the user, and carry on.\nreportWarning :: String -> Q ()\nreportWarning = report False\n\n-- | Recover from errors raised by 'reportError' or 'fail'.\nrecover :: Q a -- ^ handler to invoke on failure\n        -> Q a -- ^ computation to run\n        -> Q a\nrecover (Q r) (Q m) = Q (qRecover r m)\n\n-- We don't export lookupName; the Bool isn't a great API\n-- Instead we export lookupTypeName, lookupValueName\nlookupName :: Bool -> String -> Q (Maybe Name)\nlookupName ns s = Q (qLookupName ns s)\n\n-- | Look up the given name in the (type namespace of the) current splice's scope. See \"Language.Haskell.TH.Syntax#namelookup\" for more details.\nlookupTypeName :: String -> Q (Maybe Name)\nlookupTypeName  s = Q (qLookupName True s)\n\n-- | Look up the given name in the (value namespace of the) current splice's scope. See \"Language.Haskell.TH.Syntax#namelookup\" for more details.\nlookupValueName :: String -> Q (Maybe Name)\nlookupValueName s = Q (qLookupName False s)\n\n{-\nNote [Name lookup]\n~~~~~~~~~~~~~~~~~~\n-}\n{- $namelookup #namelookup#\nThe functions 'lookupTypeName' and 'lookupValueName' provide\na way to query the current splice's context for what names\nare in scope. The function 'lookupTypeName' queries the type\nnamespace, whereas 'lookupValueName' queries the value namespace,\nbut the functions are otherwise identical.\n\nA call @lookupValueName s@ will check if there is a value\nwith name @s@ in scope at the current splice's location. If\nthere is, the @Name@ of this value is returned;\nif not, then @Nothing@ is returned.\n\nThe returned name cannot be \\\"captured\\\".\nFor example:\n\n> f = \"global\"\n> g = $( do\n>          Just nm <- lookupValueName \"f\"\n>          [| let f = \"local\" in $( varE nm ) |]\n\nIn this case, @g = \\\"global\\\"@; the call to @lookupValueName@\nreturned the global @f@, and this name was /not/ captured by\nthe local definition of @f@.\n\nThe lookup is performed in the context of the /top-level/ splice\nbeing run. For example:\n\n> f = \"global\"\n> g = $( [| let f = \"local\" in\n>            $(do\n>                Just nm <- lookupValueName \"f\"\n>                varE nm\n>             ) |] )\n\nAgain in this example, @g = \\\"global\\\"@, because the call to\n@lookupValueName@ queries the context of the outer-most @$(...)@.\n\nOperators should be queried without any surrounding parentheses, like so:\n\n> lookupValueName \"+\"\n\nQualified names are also supported, like so:\n\n> lookupValueName \"Prelude.+\"\n> lookupValueName \"Prelude.map\"\n\n-}\n\n\n{- | 'reify' looks up information about the 'Name'.\n\nIt is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'\nto ensure that we are reifying from the right namespace. For instance, in this context:\n\n> data D = D\n\nwhich @D@ does @reify (mkName \\\"D\\\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)\nTo ensure we get information about @D@-the-value, use 'lookupValueName':\n\n> do\n>   Just nm <- lookupValueName \"D\"\n>   reify nm\n\nand to get information about @D@-the-type, use 'lookupTypeName'.\n-}\nreify :: Name -> Q Info\nreify v = Q (qReify v)\n\n{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For\nexample, if the function @foo@ has the fixity declaration @infixr 7 foo@, then\n@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function\n@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns\n'Nothing', so you may assume @bar@ has 'defaultFixity'.\n-}\nreifyFixity :: Name -> Q (Maybe Fixity)\nreifyFixity nm = Q (qReifyFixity nm)\n\n{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is,\nif @nm@ is the name of a type class, then all instances of this class at the types @tys@\nare returned. Alternatively, if @nm@ is the name of a data family or type family,\nall instances of this family at the types @tys@ are returned.\n\nNote that this is a \\\"shallow\\\" test; the declarations returned merely have\ninstance heads which unify with @nm tys@, they need not actually be satisfiable.\n\n  - @reifyInstances ''Eq [ 'TupleT' 2 \\``AppT`\\` 'ConT' ''A \\``AppT`\\` 'ConT' ''B ]@ contains\n    the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and\n    @B@ themselves implement 'Eq'\n\n  - @reifyInstances ''Show [ 'VarT' ('mkName' \"a\") ]@ produces every available\n    instance of 'Eq'\n\nThere is one edge case: @reifyInstances ''Typeable tys@ currently always\nproduces an empty list (no matter what @tys@ are given).\n-}\nreifyInstances :: Name -> [Type] -> Q [InstanceDec]\nreifyInstances cls tys = Q (qReifyInstances cls tys)\n\n{- | @reifyRoles nm@ returns the list of roles associated with the parameters of\nthe tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.\nThe returned list should never contain 'InferR'.\n-}\nreifyRoles :: Name -> Q [Role]\nreifyRoles nm = Q (qReifyRoles nm)\n\n-- | @reifyAnnotations target@ returns the list of annotations\n-- associated with @target@.  Only the annotations that are\n-- appropriately typed is returned.  So if you have @Int@ and @String@\n-- annotations for the same target, you have to call this function twice.\nreifyAnnotations :: Data a => AnnLookup -> Q [a]\nreifyAnnotations an = Q (qReifyAnnotations an)\n\n-- | @reifyModule mod@ looks up information about module @mod@.  To\n-- look up the current module, call this function with the return\n-- value of 'Language.Haskell.TH.Lib.thisModule'.\nreifyModule :: Module -> Q ModuleInfo\nreifyModule m = Q (qReifyModule m)\n\n-- | @reifyConStrictness nm@ looks up the strictness information for the fields\n-- of the constructor with the name @nm@. Note that the strictness information\n-- that 'reifyConStrictness' returns may not correspond to what is written in\n-- the source code. For example, in the following data declaration:\n--\n-- @\n-- data Pair a = Pair a a\n-- @\n--\n-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most\n-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the\n-- @-XStrictData@ language extension was enabled.\nreifyConStrictness :: Name -> Q [DecidedStrictness]\nreifyConStrictness n = Q (qReifyConStrictness n)\n\n-- | Is the list of instances returned by 'reifyInstances' nonempty?\nisInstance :: Name -> [Type] -> Q Bool\nisInstance nm tys = do { decs <- reifyInstances nm tys\n                       ; return (not (null decs)) }\n\n-- | The location at which this computation is spliced.\nlocation :: Q Loc\nlocation = Q qLocation\n\n-- |The 'runIO' function lets you run an I\\/O computation in the 'Q' monad.\n-- Take care: you are guaranteed the ordering of calls to 'runIO' within\n-- a single 'Q' computation, but not about the order in which splices are run.\n--\n-- Note: for various murky reasons, stdout and stderr handles are not\n-- necessarily flushed when the compiler finishes running, so you should\n-- flush them yourself.\nrunIO :: IO a -> Q a\nrunIO m = Q (qRunIO m)\n\n-- | Record external files that runIO is using (dependent upon).\n-- The compiler can then recognize that it should re-compile the Haskell file\n-- when an external file changes.\n--\n-- Expects an absolute file path.\n--\n-- Notes:\n--\n--   * ghc -M does not know about these dependencies - it does not execute TH.\n--\n--   * The dependency is based on file content, not a modification time\naddDependentFile :: FilePath -> Q ()\naddDependentFile fp = Q (qAddDependentFile fp)\n\n-- | Obtain a temporary file path with the given suffix. The compiler will\n-- delete this file after compilation.\naddTempFile :: String -> Q FilePath\naddTempFile suffix = Q (qAddTempFile suffix)\n\n-- | Add additional top-level declarations. The added declarations will be type\n-- checked along with the current declaration group.\naddTopDecls :: [Dec] -> Q ()\naddTopDecls ds = Q (qAddTopDecls ds)\n\n-- |\naddForeignFile :: ForeignSrcLang -> String -> Q ()\naddForeignFile = addForeignSource\n{-# DEPRECATED addForeignFile\n               \"Use 'Language.Haskell.TH.Syntax.addForeignSource' instead\"\n  #-} -- deprecated in 8.6\n\n-- | Emit a foreign file which will be compiled and linked to the object for\n-- the current module. Currently only languages that can be compiled with\n-- the C compiler are supported, and the flags passed as part of -optc will\n-- be also applied to the C compiler invocation that will compile them.\n--\n-- Note that for non-C languages (for example C++) @extern \"C\"@ directives\n-- must be used to get symbols that we can access from Haskell.\n--\n-- To get better errors, it is recommended to use #line pragmas when\n-- emitting C files, e.g.\n--\n-- > {-# LANGUAGE CPP #-}\n-- > ...\n-- > addForeignSource LangC $ unlines\n-- >   [ \"#line \" ++ show (__LINE__ + 1) ++ \" \" ++ show __FILE__\n-- >   , ...\n-- >   ]\naddForeignSource :: ForeignSrcLang -> String -> Q ()\naddForeignSource lang src = do\n  let suffix = case lang of\n                 LangC      -> \"c\"\n                 LangCxx    -> \"cpp\"\n                 LangObjc   -> \"m\"\n                 LangObjcxx -> \"mm\"\n                 LangAsm    -> \"s\"\n                 RawObject  -> \"a\"\n  path <- addTempFile suffix\n  runIO $ writeFile path src\n  addForeignFilePath lang path\n\n-- | Same as 'addForeignSource', but expects to receive a path pointing to the\n-- foreign file instead of a 'String' of its contents. Consider using this in\n-- conjunction with 'addTempFile'.\n--\n-- This is a good alternative to 'addForeignSource' when you are trying to\n-- directly link in an object file.\naddForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()\naddForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)\n\n-- | Add a finalizer that will run in the Q monad after the current module has\n-- been type checked. This only makes sense when run within a top-level splice.\n--\n-- The finalizer is given the local type environment at the splice point. Thus\n-- 'reify' is able to find the local definitions when executed inside the\n-- finalizer.\naddModFinalizer :: Q () -> Q ()\naddModFinalizer act = Q (qAddModFinalizer (unQ act))\n\n-- | Adds a core plugin to the compilation pipeline.\n--\n-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc\n-- in the command line. The major difference is that the plugin module @m@\n-- must not belong to the current package. When TH executes, it is too late\n-- to tell the compiler that we needed to compile first a plugin module in the\n-- current package.\naddCorePlugin :: String -> Q ()\naddCorePlugin plugin = Q (qAddCorePlugin plugin)\n\n-- | Get state from the 'Q' monad. Note that the state is local to the\n-- Haskell module in which the Template Haskell expression is executed.\ngetQ :: Typeable a => Q (Maybe a)\ngetQ = Q qGetQ\n\n-- | Replace the state in the 'Q' monad. Note that the state is local to the\n-- Haskell module in which the Template Haskell expression is executed.\nputQ :: Typeable a => a -> Q ()\nputQ x = Q (qPutQ x)\n\n-- | Determine whether the given language extension is enabled in the 'Q' monad.\nisExtEnabled :: Extension -> Q Bool\nisExtEnabled ext = Q (qIsExtEnabled ext)\n\n-- | List all enabled language extensions.\nextsEnabled :: Q [Extension]\nextsEnabled = Q qExtsEnabled\n\ninstance MonadIO Q where\n  liftIO = runIO\n\ninstance Quasi Q where\n  qNewName            = newName\n  qReport             = report\n  qRecover            = recover\n  qReify              = reify\n  qReifyFixity        = reifyFixity\n  qReifyInstances     = reifyInstances\n  qReifyRoles         = reifyRoles\n  qReifyAnnotations   = reifyAnnotations\n  qReifyModule        = reifyModule\n  qReifyConStrictness = reifyConStrictness\n  qLookupName         = lookupName\n  qLocation           = location\n  qAddDependentFile   = addDependentFile\n  qAddTempFile        = addTempFile\n  qAddTopDecls        = addTopDecls\n  qAddForeignFilePath = addForeignFilePath\n  qAddModFinalizer    = addModFinalizer\n  qAddCorePlugin      = addCorePlugin\n  qGetQ               = getQ\n  qPutQ               = putQ\n  qIsExtEnabled       = isExtEnabled\n  qExtsEnabled        = extsEnabled\n\n\n----------------------------------------------------\n-- The following operations are used solely in DsMeta when desugaring brackets\n-- They are not necessary for the user, who can use ordinary return and (>>=) etc\n\nreturnQ :: a -> Q a\nreturnQ = return\n\nbindQ :: Q a -> (a -> Q b) -> Q b\nbindQ = (>>=)\n\nsequenceQ :: [Q a] -> Q [a]\nsequenceQ = sequence\n\n\n-----------------------------------------------------\n--\n--              The Lift class\n--\n-----------------------------------------------------\n\n-- | A 'Lift' instance can have any of its values turned into a Template\n-- Haskell expression. This is needed when a value used within a Template\n-- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@) but not\n-- at the top level. As an example:\n--\n-- > add1 :: Int -> Q Exp\n-- > add1 x = [| x + 1 |]\n--\n-- Template Haskell has no way of knowing what value @x@ will take on at\n-- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.\n--\n-- A 'Lift' instance must satisfy @$(lift x) \u00e2\u2030\u00a1 x@ for all @x@, where @$(...)@\n-- is a Template Haskell splice.\n--\n-- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@\n-- GHC language extension:\n--\n-- > {-# LANGUAGE DeriveLift #-}\n-- > module Foo where\n-- >\n-- > import Language.Haskell.TH.Syntax\n-- >\n-- > data Bar a = Bar1 a (Bar a) | Bar2 String\n-- >   deriving Lift\nclass Lift t where\n  -- | Turn a value into a Template Haskell expression, suitable for use in\n  -- a splice.\n  lift :: t -> Q Exp\n  lift = unTypeQ . liftTyped\n\n  -- | Turn a value into a Template Haskell typed expression, suitable for use\n  -- in a typed splice.\n  --\n  -- @since 2.16.0.0\n  liftTyped :: t -> Q (TExp t)\n  liftTyped = unsafeTExpCoerce . lift\n\n  {-# MINIMAL lift | liftTyped #-}\n\n\n-- If you add any instances here, consider updating test th/TH_Lift\ninstance Lift Integer where\n  lift x = return (LitE (IntegerL x))\n\ninstance Lift Int where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Int8 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Int16 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Int32 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Int64 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Word where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Word8 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Word16 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Word32 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Word64 where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Lift Natural where\n  lift x = return (LitE (IntegerL (fromIntegral x)))\n\ninstance Integral a => Lift (Ratio a) where\n  lift x = return (LitE (RationalL (toRational x)))\n\ninstance Lift Float where\n  lift x = return (LitE (RationalL (toRational x)))\n\ninstance Lift Double where\n  lift x = return (LitE (RationalL (toRational x)))\n\ninstance Lift Char where\n  lift x = return (LitE (CharL x))\n\ninstance Lift Bool where\n  lift True  = return (ConE trueName)\n  lift False = return (ConE falseName)\n\ninstance Lift a => Lift (Maybe a) where\n  lift Nothing  = return (ConE nothingName)\n  lift (Just x) = liftM (ConE justName `AppE`) (lift x)\n\ninstance (Lift a, Lift b) => Lift (Either a b) where\n  lift (Left x)  = liftM (ConE leftName  `AppE`) (lift x)\n  lift (Right y) = liftM (ConE rightName `AppE`) (lift y)\n\ninstance Lift a => Lift [a] where\n  lift xs = do { xs' <- mapM lift xs; return (ListE xs') }\n\nliftString :: String -> Q Exp\n-- Used in TcExpr to short-circuit the lifting for strings\nliftString s = return (LitE (StringL s))\n\n-- | @since 2.15.0.0\ninstance Lift a => Lift (NonEmpty a) where\n  lift (x :| xs) = do\n    x' <- lift x\n    xs' <- lift xs\n    return (InfixE (Just x') (ConE nonemptyName) (Just xs'))\n\n-- | @since 2.15.0.0\ninstance Lift Void where\n  lift = pure . absurd\n\ninstance Lift () where\n  lift () = return (ConE (tupleDataName 0))\n\ninstance (Lift a, Lift b) => Lift (a, b) where\n  lift (a, b)\n    = liftM TupE $ sequence [lift a, lift b]\n\ninstance (Lift a, Lift b, Lift c) => Lift (a, b, c) where\n  lift (a, b, c)\n    = liftM TupE $ sequence [lift a, lift b, lift c]\n\ninstance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where\n  lift (a, b, c, d)\n    = liftM TupE $ sequence [lift a, lift b, lift c, lift d]\n\ninstance (Lift a, Lift b, Lift c, Lift d, Lift e)\n      => Lift (a, b, c, d, e) where\n  lift (a, b, c, d, e)\n    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]\n\ninstance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)\n      => Lift (a, b, c, d, e, f) where\n  lift (a, b, c, d, e, f)\n    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]\n\ninstance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)\n      => Lift (a, b, c, d, e, f, g) where\n  lift (a, b, c, d, e, f, g)\n    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]\n\n-- TH has a special form for literal strings,\n-- which we should take advantage of.\n-- NB: the lhs of the rule has no args, so that\n--     the rule will apply to a 'lift' all on its own\n--     which happens to be the way the type checker\n--     creates it.\n{-# RULES \"TH:liftString\" lift = \\s -> return (LitE (StringL s)) #-}\n\n\ntrueName, falseName :: Name\ntrueName  = mkNameG DataName \"ghc-prim\" \"GHC.Types\" \"True\"\nfalseName = mkNameG DataName \"ghc-prim\" \"GHC.Types\" \"False\"\n\nnothingName, justName :: Name\nnothingName = mkNameG DataName \"base\" \"GHC.Maybe\" \"Nothing\"\njustName    = mkNameG DataName \"base\" \"GHC.Maybe\" \"Just\"\n\nleftName, rightName :: Name\nleftName  = mkNameG DataName \"base\" \"Data.Either\" \"Left\"\nrightName = mkNameG DataName \"base\" \"Data.Either\" \"Right\"\n\nnonemptyName :: Name\nnonemptyName = mkNameG DataName \"base\" \"GHC.Base\" \":|\"\n\n-----------------------------------------------------\n--\n--              Generic Lift implementations\n--\n-----------------------------------------------------\n\n-- | 'dataToQa' is an internal utility function for constructing generic\n-- conversion functions from types with 'Data' instances to various\n-- quasi-quoting representations.  See the source of 'dataToExpQ' and\n-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@\n-- and @appQ@ are overloadable to account for different syntax for\n-- expressions and patterns; @antiQ@ allows you to override type-specific\n-- cases, a common usage is just @const Nothing@, which results in\n-- no overloading.\ndataToQa  ::  forall a k q. Data a\n          =>  (Name -> k)\n          ->  (Lit -> Q q)\n          ->  (k -> [Q q] -> Q q)\n          ->  (forall b . Data b => b -> Maybe (Q q))\n          ->  a\n          ->  Q q\ndataToQa mkCon mkLit appCon antiQ t =\n    case antiQ t of\n      Nothing ->\n          case constrRep constr of\n            AlgConstr _ ->\n                appCon (mkCon funOrConName) conArgs\n              where\n                funOrConName :: Name\n                funOrConName =\n                    case showConstr constr of\n                      \"(:)\"       -> Name (mkOccName \":\")\n                                          (NameG DataName\n                                                (mkPkgName \"ghc-prim\")\n                                                (mkModName \"GHC.Types\"))\n                      con@\"[]\"    -> Name (mkOccName con)\n                                          (NameG DataName\n                                                (mkPkgName \"ghc-prim\")\n                                                (mkModName \"GHC.Types\"))\n                      con@('(':_) -> Name (mkOccName con)\n                                          (NameG DataName\n                                                (mkPkgName \"ghc-prim\")\n                                                (mkModName \"GHC.Tuple\"))\n\n                      -- Tricky case: see Note [Data for non-algebraic types]\n                      fun@(x:_)   | startsVarSym x || startsVarId x\n                                  -> mkNameG_v tyconPkg tyconMod fun\n                      con         -> mkNameG_d tyconPkg tyconMod con\n\n                  where\n                    tycon :: TyCon\n                    tycon = (typeRepTyCon . typeOf) t\n\n                    tyconPkg, tyconMod :: String\n                    tyconPkg = tyConPackage tycon\n                    tyconMod = tyConModule  tycon\n\n                conArgs :: [Q q]\n                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t\n            IntConstr n ->\n                mkLit $ IntegerL n\n            FloatConstr n ->\n                mkLit $ RationalL n\n            CharConstr c ->\n                mkLit $ CharL c\n        where\n          constr :: Constr\n          constr = toConstr t\n\n      Just y -> y\n\n\n{- Note [Data for non-algebraic types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nClass Data was originally intended for algebraic data types.  But\nit is possible to use it for abstract types too.  For example, in\npackage `text` we find\n\n  instance Data Text where\n    ...\n    toConstr _ = packConstr\n\n  packConstr :: Constr\n  packConstr = mkConstr textDataType \"pack\" [] Prefix\n\nHere `packConstr` isn't a real data constructor, it's an ordinary\nfunction.  Two complications\n\n* In such a case, we must take care to build the Name using\n  mkNameG_v (for values), not mkNameG_d (for data constructors).\n  See Trac #10796.\n\n* The pseudo-constructor is named only by its string, here \"pack\".\n  But 'dataToQa' needs the TyCon of its defining module, and has\n  to assume it's defined in the same module as the TyCon itself.\n  But nothing enforces that; Trac #12596 shows what goes wrong if\n  \"pack\" is defined in a different module than the data type \"Text\".\n  -}\n\n-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the\n-- same value, in the SYB style. It is generalized to take a function\n-- override type-specific cases; see 'liftData' for a more commonly\n-- used variant.\ndataToExpQ  ::  Data a\n            =>  (forall b . Data b => b -> Maybe (Q Exp))\n            ->  a\n            ->  Q Exp\ndataToExpQ = dataToQa varOrConE litE (foldl appE)\n    where\n          -- Make sure that VarE is used if the Constr value relies on a\n          -- function underneath the surface (instead of a constructor).\n          -- See Trac #10796.\n          varOrConE s =\n            case nameSpace s of\n                 Just VarName  -> return (VarE s)\n                 Just DataName -> return (ConE s)\n                 _ -> fail $ \"Can't construct an expression from name \"\n                          ++ showName s\n          appE x y = do { a <- x; b <- y; return (AppE a b)}\n          litE c = return (LitE c)\n\n-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which\n-- works for any type with a 'Data' instance.\nliftData :: Data a => a -> Q Exp\nliftData = dataToExpQ (const Nothing)\n\n-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same\n-- value, in the SYB style. It takes a function to handle type-specific cases,\n-- alternatively, pass @const Nothing@ to get default behavior.\ndataToPatQ  ::  Data a\n            =>  (forall b . Data b => b -> Maybe (Q Pat))\n            ->  a\n            ->  Q Pat\ndataToPatQ = dataToQa id litP conP\n    where litP l = return (LitP l)\n          conP n ps =\n            case nameSpace n of\n                Just DataName -> do\n                    ps' <- sequence ps\n                    return (ConP n ps')\n                _ -> fail $ \"Can't construct a pattern from name \"\n                         ++ showName n\n\n-----------------------------------------------------\n--              Names and uniques\n-----------------------------------------------------\n\nnewtype ModName = ModName String        -- Module name\n deriving (Show,Eq,Ord,Data,Generic)\n\nnewtype PkgName = PkgName String        -- package name\n deriving (Show,Eq,Ord,Data,Generic)\n\n-- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.\ndata Module = Module PkgName ModName -- package qualified module name\n deriving (Show,Eq,Ord,Data,Generic)\n\nnewtype OccName = OccName String\n deriving (Show,Eq,Ord,Data,Generic)\n\nmkModName :: String -> ModName\nmkModName s = ModName s\n\nmodString :: ModName -> String\nmodString (ModName m) = m\n\n\nmkPkgName :: String -> PkgName\nmkPkgName s = PkgName s\n\npkgString :: PkgName -> String\npkgString (PkgName m) = m\n\n\n-----------------------------------------------------\n--              OccName\n-----------------------------------------------------\n\nmkOccName :: String -> OccName\nmkOccName s = OccName s\n\noccString :: OccName -> String\noccString (OccName occ) = occ\n\n\n-----------------------------------------------------\n--               Names\n-----------------------------------------------------\n--\n-- For \"global\" names ('NameG') we need a totally unique name,\n-- so we must include the name-space of the thing\n--\n-- For unique-numbered things ('NameU'), we've got a unique reference\n-- anyway, so no need for name space\n--\n-- For dynamically bound thing ('NameS') we probably want them to\n-- in a context-dependent way, so again we don't want the name\n-- space.  For example:\n--\n-- > let v = mkName \"T\" in [| data $v = $v |]\n--\n-- Here we use the same Name for both type constructor and data constructor\n--\n--\n-- NameL and NameG are bound *outside* the TH syntax tree\n-- either globally (NameG) or locally (NameL). Ex:\n--\n-- > f x = $(h [| (map, x) |])\n--\n-- The 'map' will be a NameG, and 'x' wil be a NameL\n--\n-- These Names should never appear in a binding position in a TH syntax tree\n\n{- $namecapture #namecapture#\nMuch of 'Name' API is concerned with the problem of /name capture/, which\ncan be seen in the following example.\n\n> f expr = [| let x = 0 in $expr |]\n> ...\n> g x = $( f [| x |] )\n> h y = $( f [| y |] )\n\nA naive desugaring of this would yield:\n\n> g x = let x = 0 in x\n> h y = let x = 0 in y\n\nAll of a sudden, @g@ and @h@ have different meanings! In this case,\nwe say that the @x@ in the RHS of @g@ has been /captured/\nby the binding of @x@ in @f@.\n\nWhat we actually want is for the @x@ in @f@ to be distinct from the\n@x@ in @g@, so we get the following desugaring:\n\n> g x = let x' = 0 in x\n> h y = let x' = 0 in y\n\nwhich avoids name capture as desired.\n\nIn the general case, we say that a @Name@ can be captured if\nthe thing it refers to can be changed by adding new declarations.\n-}\n\n{- |\nAn abstract type representing names in the syntax tree.\n\n'Name's can be constructed in several ways, which come with different\nname-capture guarantees (see \"Language.Haskell.TH.Syntax#namecapture\" for\nan explanation of name capture):\n\n  * the built-in syntax @'f@ and @''T@ can be used to construct names,\n    The expression @'f@ gives a @Name@ which refers to the value @f@\n    currently in scope, and @''T@ gives a @Name@ which refers to the\n    type @T@ currently in scope. These names can never be captured.\n\n  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and\n     @''T@ respectively, but the @Name@s are looked up at the point\n     where the current splice is being run. These names can never be\n     captured.\n\n  * 'newName' monadically generates a new name, which can never\n     be captured.\n\n  * 'mkName' generates a capturable name.\n\nNames constructed using @newName@ and @mkName@ may be used in bindings\n(such as @let x = ...@ or @\\x -> ...@), but names constructed using\n@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.\n-}\ndata Name = Name OccName NameFlavour deriving (Data, Eq, Generic)\n\ninstance Ord Name where\n    -- check if unique is different before looking at strings\n  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`\n                                        (o1 `compare` o2)\n\ndata NameFlavour\n  = NameS           -- ^ An unqualified name; dynamically bound\n  | NameQ ModName   -- ^ A qualified name; dynamically bound\n  | NameU !Int      -- ^ A unique local name\n  | NameL !Int      -- ^ Local name bound outside of the TH AST\n  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:\n                -- An original name (occurrences only, not binders)\n                -- Need the namespace too to be sure which\n                -- thing we are naming\n  deriving ( Data, Eq, Ord, Show, Generic )\n\ndata NameSpace = VarName        -- ^ Variables\n               | DataName       -- ^ Data constructors\n               | TcClsName      -- ^ Type constructors and classes; Haskell has them\n                                -- in the same name space for now.\n               deriving( Eq, Ord, Show, Data, Generic )\n\ntype Uniq = Int\n\n-- | The name without its module prefix.\n--\n-- ==== __Examples__\n--\n-- >>> nameBase ''Data.Either.Either\n-- \"Either\"\n-- >>> nameBase (mkName \"foo\")\n-- \"foo\"\n-- >>> nameBase (mkName \"Module.foo\")\n-- \"foo\"\nnameBase :: Name -> String\nnameBase (Name occ _) = occString occ\n\n-- | Module prefix of a name, if it exists.\n--\n-- ==== __Examples__\n--\n-- >>> nameModule ''Data.Either.Either\n-- Just \"Data.Either\"\n-- >>> nameModule (mkName \"foo\")\n-- Nothing\n-- >>> nameModule (mkName \"Module.foo\")\n-- Just \"Module\"\nnameModule :: Name -> Maybe String\nnameModule (Name _ (NameQ m))     = Just (modString m)\nnameModule (Name _ (NameG _ _ m)) = Just (modString m)\nnameModule _                      = Nothing\n\n-- | A name's package, if it exists.\n--\n-- ==== __Examples__\n--\n-- >>> namePackage ''Data.Either.Either\n-- Just \"base\"\n-- >>> namePackage (mkName \"foo\")\n-- Nothing\n-- >>> namePackage (mkName \"Module.foo\")\n-- Nothing\nnamePackage :: Name -> Maybe String\nnamePackage (Name _ (NameG _ p _)) = Just (pkgString p)\nnamePackage _                      = Nothing\n\n-- | Returns whether a name represents an occurrence of a top-level variable\n-- ('VarName'), data constructor ('DataName'), type constructor, or type class\n-- ('TcClsName'). If we can't be sure, it returns 'Nothing'.\n--\n-- ==== __Examples__\n--\n-- >>> nameSpace 'Prelude.id\n-- Just VarName\n-- >>> nameSpace (mkName \"id\")\n-- Nothing -- only works for top-level variable names\n-- >>> nameSpace 'Data.Maybe.Just\n-- Just DataName\n-- >>> nameSpace ''Data.Maybe.Maybe\n-- Just TcClsName\n-- >>> nameSpace ''Data.Ord.Ord\n-- Just TcClsName\nnameSpace :: Name -> Maybe NameSpace\nnameSpace (Name _ (NameG ns _ _)) = Just ns\nnameSpace _                       = Nothing\n\n{- |\nGenerate a capturable name. Occurrences of such names will be\nresolved according to the Haskell scoping rules at the occurrence\nsite.\n\nFor example:\n\n> f = [| pi + $(varE (mkName \"pi\")) |]\n> ...\n> g = let pi = 3 in $f\n\nIn this case, @g@ is desugared to\n\n> g = Prelude.pi + 3\n\nNote that @mkName@ may be used with qualified names:\n\n> mkName \"Prelude.pi\"\n\nSee also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could\nbe rewritten using 'Language.Haskell.TH.Lib.dyn' as\n\n> f = [| pi + $(dyn \"pi\") |]\n-}\nmkName :: String -> Name\n-- The string can have a '.', thus \"Foo.baz\",\n-- giving a dynamically-bound qualified name,\n-- in which case we want to generate a NameQ\n--\n-- Parse the string to see if it has a \".\" in it\n-- so we know whether to generate a qualified or unqualified name\n-- It's a bit tricky because we need to parse\n--\n-- > Foo.Baz.x   as    Qual Foo.Baz x\n--\n-- So we parse it from back to front\nmkName str\n  = split [] (reverse str)\n  where\n    split occ []        = Name (mkOccName occ) NameS\n    split occ ('.':rev) | not (null occ)\n                        , is_rev_mod_name rev\n                        = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))\n        -- The 'not (null occ)' guard ensures that\n        --      mkName \"&.\" = Name \"&.\" NameS\n        -- The 'is_rev_mod' guards ensure that\n        --      mkName \".&\" = Name \".&\" NameS\n        --      mkName \"^..\" = Name \"^..\" NameS      -- Trac #8633\n        --      mkName \"Data.Bits..&\" = Name \".&\" (NameQ \"Data.Bits\")\n        -- This rather bizarre case actually happened; (.&.) is in Data.Bits\n    split occ (c:rev)   = split (c:occ) rev\n\n    -- Recognises a reversed module name xA.yB.C,\n    -- with at least one component,\n    -- and each component looks like a module name\n    --   (i.e. non-empty, starts with capital, all alpha)\n    is_rev_mod_name rev_mod_str\n      | (compt, rest) <- break (== '.') rev_mod_str\n      , not (null compt), isUpper (last compt), all is_mod_char compt\n      = case rest of\n          []             -> True\n          (_dot : rest') -> is_rev_mod_name rest'\n      | otherwise\n      = False\n\n    is_mod_char c = isAlphaNum c || c == '_' || c == '\\''\n\n-- | Only used internally\nmkNameU :: String -> Uniq -> Name\nmkNameU s u = Name (mkOccName s) (NameU u)\n\n-- | Only used internally\nmkNameL :: String -> Uniq -> Name\nmkNameL s u = Name (mkOccName s) (NameL u)\n\n-- | Used for 'x etc, but not available to the programmer\nmkNameG :: NameSpace -> String -> String -> String -> Name\nmkNameG ns pkg modu occ\n  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))\n\nmkNameS :: String -> Name\nmkNameS n = Name (mkOccName n) NameS\n\nmkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name\nmkNameG_v  = mkNameG VarName\nmkNameG_tc = mkNameG TcClsName\nmkNameG_d  = mkNameG DataName\n\ndata NameIs = Alone | Applied | Infix\n\nshowName :: Name -> String\nshowName = showName' Alone\n\nshowName' :: NameIs -> Name -> String\nshowName' ni nm\n = case ni of\n       Alone        -> nms\n       Applied\n        | pnam      -> nms\n        | otherwise -> \"(\" ++ nms ++ \")\"\n       Infix\n        | pnam      -> \"`\" ++ nms ++ \"`\"\n        | otherwise -> nms\n    where\n        -- For now, we make the NameQ and NameG print the same, even though\n        -- NameQ is a qualified name (so what it means depends on what the\n        -- current scope is), and NameG is an original name (so its meaning\n        -- should be independent of what's in scope.\n        -- We may well want to distinguish them in the end.\n        -- Ditto NameU and NameL\n        nms = case nm of\n                    Name occ NameS         -> occString occ\n                    Name occ (NameQ m)     -> modString m ++ \".\" ++ occString occ\n                    Name occ (NameG _ _ m) -> modString m ++ \".\" ++ occString occ\n                    Name occ (NameU u)     -> occString occ ++ \"_\" ++ show u\n                    Name occ (NameL u)     -> occString occ ++ \"_\" ++ show u\n\n        pnam = classify nms\n\n        -- True if we are function style, e.g. f, [], (,)\n        -- False if we are operator style, e.g. +, :+\n        classify \"\" = False -- shouldn't happen; . operator is handled below\n        classify (x:xs) | isAlpha x || (x `elem` \"_[]()\") =\n                            case dropWhile (/='.') xs of\n                                  (_:xs') -> classify xs'\n                                  []      -> True\n                        | otherwise = False\n\ninstance Show Name where\n  show = showName\n\n-- Tuple data and type constructors\n-- | Tuple data constructor\ntupleDataName :: Int -> Name\n-- | Tuple type constructor\ntupleTypeName :: Int -> Name\n\ntupleDataName 0 = mk_tup_name 0 DataName\ntupleDataName 1 = error \"tupleDataName 1\"\ntupleDataName n = mk_tup_name (n-1) DataName\n\ntupleTypeName 0 = mk_tup_name 0 TcClsName\ntupleTypeName 1 = error \"tupleTypeName 1\"\ntupleTypeName n = mk_tup_name (n-1) TcClsName\n\nmk_tup_name :: Int -> NameSpace -> Name\nmk_tup_name n_commas space\n  = Name occ (NameG space (mkPkgName \"ghc-prim\") tup_mod)\n  where\n    occ = mkOccName ('(' : replicate n_commas ',' ++ \")\")\n    tup_mod = mkModName \"GHC.Tuple\"\n\n-- Unboxed tuple data and type constructors\n-- | Unboxed tuple data constructor\nunboxedTupleDataName :: Int -> Name\n-- | Unboxed tuple type constructor\nunboxedTupleTypeName :: Int -> Name\n\nunboxedTupleDataName n = mk_unboxed_tup_name n DataName\nunboxedTupleTypeName n = mk_unboxed_tup_name n TcClsName\n\nmk_unboxed_tup_name :: Int -> NameSpace -> Name\nmk_unboxed_tup_name n space\n  = Name (mkOccName tup_occ) (NameG space (mkPkgName \"ghc-prim\") tup_mod)\n  where\n    tup_occ | n == 1    = \"Unit#\" -- See Note [One-tuples] in TysWiredIn\n            | otherwise = \"(#\" ++ replicate n_commas ',' ++ \"#)\"\n    n_commas = n - 1\n    tup_mod  = mkModName \"GHC.Tuple\"\n\n-- Unboxed sum data and type constructors\n-- | Unboxed sum data constructor\nunboxedSumDataName :: SumAlt -> SumArity -> Name\n-- | Unboxed sum type constructor\nunboxedSumTypeName :: SumArity -> Name\n\nunboxedSumDataName alt arity\n  | alt > arity\n  = error $ prefix ++ \"Index out of bounds.\" ++ debug_info\n\n  | alt <= 0\n  = error $ prefix ++ \"Alt must be > 0.\" ++ debug_info\n\n  | arity < 2\n  = error $ prefix ++ \"Arity must be >= 2.\" ++ debug_info\n\n  | otherwise\n  = Name (mkOccName sum_occ)\n         (NameG DataName (mkPkgName \"ghc-prim\") (mkModName \"GHC.Prim\"))\n\n  where\n    prefix     = \"unboxedSumDataName: \"\n    debug_info = \" (alt: \" ++ show alt ++ \", arity: \" ++ show arity ++ \")\"\n\n    -- Synced with the definition of mkSumDataConOcc in TysWiredIn\n    sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ \"#)\"\n    bars i = replicate i '|'\n    nbars_before = alt - 1\n    nbars_after  = arity - alt\n\nunboxedSumTypeName arity\n  | arity < 2\n  = error $ \"unboxedSumTypeName: Arity must be >= 2.\"\n         ++ \" (arity: \" ++ show arity ++ \")\"\n\n  | otherwise\n  = Name (mkOccName sum_occ)\n         (NameG TcClsName (mkPkgName \"ghc-prim\") (mkModName \"GHC.Prim\"))\n\n  where\n    -- Synced with the definition of mkSumTyConOcc in TysWiredIn\n    sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ \"#)\"\n\n-----------------------------------------------------\n--              Locations\n-----------------------------------------------------\n\ndata Loc\n  = Loc { loc_filename :: String\n        , loc_package  :: String\n        , loc_module   :: String\n        , loc_start    :: CharPos\n        , loc_end      :: CharPos }\n   deriving( Show, Eq, Ord, Data, Generic )\n\ntype CharPos = (Int, Int)       -- ^ Line and character position\n\n\n-----------------------------------------------------\n--\n--      The Info returned by reification\n--\n-----------------------------------------------------\n\n-- | Obtained from 'reify' in the 'Q' Monad.\ndata Info\n  =\n  -- | A class, with a list of its visible instances\n  ClassI\n      Dec\n      [InstanceDec]\n\n  -- | A class method\n  | ClassOpI\n       Name\n       Type\n       ParentName\n\n  -- | A \\\"plain\\\" type constructor. \\\"Fancier\\\" type constructors are returned\n  -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified\n  -- declaration will never have derived instances attached to it (if you wish\n  -- to check for an instance, see 'reifyInstances').\n  | TyConI\n        Dec\n\n  -- | A type or data family, with a list of its visible instances. A closed\n  -- type family is returned with 0 instances.\n  | FamilyI\n        Dec\n        [InstanceDec]\n\n  -- | A \\\"primitive\\\" type constructor, which can't be expressed with a 'Dec'.\n  -- Examples: @(->)@, @Int#@.\n  | PrimTyConI\n       Name\n       Arity\n       Unlifted\n\n  -- | A data constructor\n  | DataConI\n       Name\n       Type\n       ParentName\n\n  -- | A pattern synonym\n  | PatSynI\n       Name\n       PatSynType\n\n  {- |\n  A \\\"value\\\" variable (as opposed to a type variable, see 'TyVarI').\n\n  The @Maybe Dec@ field contains @Just@ the declaration which\n  defined the variable - including the RHS of the declaration -\n  or else @Nothing@, in the case where the RHS is unavailable to\n  the compiler. At present, this value is /always/ @Nothing@:\n  returning the RHS has not yet been implemented because of\n  lack of interest.\n  -}\n  | VarI\n       Name\n       Type\n       (Maybe Dec)\n\n  {- |\n  A type variable.\n\n  The @Type@ field contains the type which underlies the variable.\n  At present, this is always @'VarT' theName@, but future changes\n  may permit refinement of this.\n  -}\n  | TyVarI      -- Scoped type variable\n        Name\n        Type    -- What it is bound to\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | Obtained from 'reifyModule' in the 'Q' Monad.\ndata ModuleInfo =\n  -- | Contains the import list of the module.\n  ModuleInfo [Module]\n  deriving( Show, Eq, Ord, Data, Generic )\n\n{- |\nIn 'ClassOpI' and 'DataConI', name of the parent class or type\n-}\ntype ParentName = Name\n\n-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a\n-- particular data constructor. 'SumAlt's are one-indexed and should never\n-- exceed the value of its corresponding 'SumArity'. For example:\n--\n-- * @(\\#_|\\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)\n--\n-- * @(\\#|_\\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)\ntype SumAlt = Int\n\n-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of\n-- 'SumAlt's. For example, @(\\#|\\#)@ has a 'SumArity' of 2.\ntype SumArity = Int\n\n-- | In 'PrimTyConI', arity of the type constructor\ntype Arity = Int\n\n-- | In 'PrimTyConI', is the type constructor unlifted?\ntype Unlifted = Bool\n\n-- | 'InstanceDec' desribes a single instance of a class or type function.\n-- It is just a 'Dec', but guaranteed to be one of the following:\n--\n--   * 'InstanceD' (with empty @['Dec']@)\n--\n--   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)\n--\n--   * 'TySynInstD'\ntype InstanceDec = Dec\n\ndata Fixity          = Fixity Int FixityDirection\n    deriving( Eq, Ord, Show, Data, Generic )\ndata FixityDirection = InfixL | InfixR | InfixN\n    deriving( Eq, Ord, Show, Data, Generic )\n\n-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)\nmaxPrecedence :: Int\nmaxPrecedence = (9::Int)\n\n-- | Default fixity: @infixl 9@\ndefaultFixity :: Fixity\ndefaultFixity = Fixity maxPrecedence InfixL\n\n\n{-\nNote [Unresolved infix]\n~~~~~~~~~~~~~~~~~~~~~~~\n-}\n{- $infix #infix#\nWhen implementing antiquotation for quasiquoters, one often wants\nto parse strings into expressions:\n\n> parse :: String -> Maybe Exp\n\nBut how should we parse @a + b * c@? If we don't know the fixities of\n@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a\n+ b) * c@.\n\nIn cases like this, use 'UInfixE', 'UInfixP', or 'UInfixT', which stand for\n\\\"unresolved infix expression/pattern/type\\\", respectively. When the compiler\nis given a splice containing a tree of @UInfixE@ applications such as\n\n> UInfixE\n>   (UInfixE e1 op1 e2)\n>   op2\n>   (UInfixE e3 op3 e4)\n\nit will look up and the fixities of the relevant operators and\nreassociate the tree as necessary.\n\n  * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',\n    which are of use for parsing expressions like\n\n    > (a + b * c) + d * e\n\n  * 'InfixE', 'InfixP', and 'InfixT' expressions are never reassociated.\n\n  * The 'UInfixE' constructor doesn't support sections. Sections\n    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer\n    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the\n    outer-most section, and use 'UInfixE' constructors for all\n    other operators:\n\n    > InfixE\n    >   Just (UInfixE ...a + b * c...)\n    >   op\n    >   Nothing\n\n    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered\n    into 'Exp's differently:\n\n    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)\n    >                    -- will result in a fixity error if (+) is left-infix\n    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)\n    >                    -- no fixity errors\n\n  * Quoted expressions such as\n\n    > [| a * b + c |] :: Q Exp\n    > [p| a : b : c |] :: Q Pat\n    > [t| T + T |] :: Q Type\n\n    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'InfixT', 'ParensE',\n    'ParensP', or 'ParensT' constructors.\n\n-}\n\n-----------------------------------------------------\n--\n--      The main syntax data types\n--\n-----------------------------------------------------\n\ndata Lit = CharL Char\n         | StringL String\n         | IntegerL Integer     -- ^ Used for overloaded and non-overloaded\n                                -- literals. We don't have a good way to\n                                -- represent non-overloaded literals at\n                                -- the moment. Maybe that doesn't matter?\n         | RationalL Rational   -- Ditto\n         | IntPrimL Integer\n         | WordPrimL Integer\n         | FloatPrimL Rational\n         | DoublePrimL Rational\n         | StringPrimL [Word8]  -- ^ A primitive C-style string, type Addr#\n         | CharPrimL Char\n    deriving( Show, Eq, Ord, Data, Generic )\n\n    -- We could add Int, Float, Double etc, as we do in HsLit,\n    -- but that could complicate the\n    -- supposedly-simple TH.Syntax literal type\n\n-- | Pattern in Haskell given in @{}@\ndata Pat\n  = LitP Lit                        -- ^ @{ 5 or \\'c\\' }@\n  | VarP Name                       -- ^ @{ x }@\n  | TupP [Pat]                      -- ^ @{ (p1,p2) }@\n  | UnboxedTupP [Pat]               -- ^ @{ (\\# p1,p2 \\#) }@\n  | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\\#|p|\\#) }@\n  | ConP Name [Pat]                 -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@\n  | InfixP Pat Name Pat             -- ^ @foo ({x :+ y}) = e@\n  | UInfixP Pat Name Pat            -- ^ @foo ({x :+ y}) = e@\n                                    --\n                                    -- See \"Language.Haskell.TH.Syntax#infix\"\n  | ParensP Pat                     -- ^ @{(p)}@\n                                    --\n                                    -- See \"Language.Haskell.TH.Syntax#infix\"\n  | TildeP Pat                      -- ^ @{ ~p }@\n  | BangP Pat                       -- ^ @{ !p }@\n  | AsP Name Pat                    -- ^ @{ x \\@ p }@\n  | WildP                           -- ^ @{ _ }@\n  | RecP Name [FieldPat]            -- ^ @f (Pt { pointx = x }) = g x@\n  | ListP [ Pat ]                   -- ^ @{ [1,2,3] }@\n  | SigP Pat Type                   -- ^ @{ p :: t }@\n  | ViewP Exp Pat                   -- ^ @{ e -> p }@\n  deriving( Show, Eq, Ord, Data, Generic )\n\ntype FieldPat = (Name,Pat)\n\ndata Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@\n    deriving( Show, Eq, Ord, Data, Generic )\ndata Clause = Clause [Pat] Body [Dec]\n                                  -- ^ @f { p1 p2 = body where decs }@\n    deriving( Show, Eq, Ord, Data, Generic )\n\ndata Exp\n  = VarE Name                          -- ^ @{ x }@\n  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @\n  | LitE Lit                           -- ^ @{ 5 or \\'c\\'}@\n  | AppE Exp Exp                       -- ^ @{ f x }@\n  | AppTypeE Exp Type                  -- ^ @{ f \\@Int }@\n\n  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@\n\n    -- It's a bit gruesome to use an Exp as the\n    -- operator, but how else can we distinguish\n    -- constructors from non-constructors?\n    -- Maybe there should be a var-or-con type?\n    -- Or maybe we should leave it to the String itself?\n\n  | UInfixE Exp Exp Exp                -- ^ @{x + y}@\n                                       --\n                                       -- See \"Language.Haskell.TH.Syntax#infix\"\n  | ParensE Exp                        -- ^ @{ (e) }@\n                                       --\n                                       -- See \"Language.Haskell.TH.Syntax#infix\"\n  | LamE [Pat] Exp                     -- ^ @{ \\\\ p1 p2 -> e }@\n  | LamCaseE [Match]                   -- ^ @{ \\\\case m1; m2 }@\n  | TupE [Exp]                         -- ^ @{ (e1,e2) }  @\n  | UnboxedTupE [Exp]                  -- ^ @{ (\\# e1,e2 \\#) }  @\n  | UnboxedSumE Exp SumAlt SumArity    -- ^ @{ (\\#|e|\\#) }@\n  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@\n  | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@\n  | LetE [Dec] Exp                     -- ^ @{ let { x=e1; y=e2 } in e3 }@\n  | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@\n  | DoE [Stmt]                         -- ^ @{ do { p <- e1; e2 }  }@\n  | MDoE [Stmt]                        -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@\n  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@\n      --\n      -- The result expression of the comprehension is\n      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.\n      --\n      -- E.g. translation:\n      --\n      -- > [ f x | x <- xs ]\n      --\n      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]\n\n  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@\n  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@\n  | SigE Exp Type                      -- ^ @{ e :: t }@\n  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@\n  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@\n  | StaticE Exp                        -- ^ @{ static e }@\n  | UnboundVarE Name                   -- ^ @{ _x }@\n                                       --\n                                       -- This is used for holes or unresolved\n                                       -- identifiers in AST quotes. Note that\n                                       -- it could either have a variable name\n                                       -- or constructor name.\n  | LabelE String                      -- ^ @{ #x }@ ( Overloaded label )\n  | ImplicitParamVarE String           -- ^ @{ ?x }@ ( Implicit parameter )\n  deriving( Show, Eq, Ord, Data, Generic )\n\ntype FieldExp = (Name,Exp)\n\n-- Omitted: implicit parameters\n\ndata Body\n  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2\n                                 --      | e3 = e4 }\n                                 -- where ds@\n  | NormalB Exp              -- ^ @f p { = e } where ds@\n  deriving( Show, Eq, Ord, Data, Generic )\n\ndata Guard\n  = NormalG Exp -- ^ @f x { | odd x } = x@\n  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@\n  deriving( Show, Eq, Ord, Data, Generic )\n\ndata Stmt\n  = BindS Pat Exp -- ^ @p <- e@\n  | LetS [ Dec ]  -- ^ @{ let { x=e1; y=e2 } }@\n  | NoBindS Exp   -- ^ @e@\n  | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')\n  | RecS [Stmt]   -- ^ @rec { s1; s2 }@\n  deriving( Show, Eq, Ord, Data, Generic )\n\ndata Range = FromR Exp | FromThenR Exp Exp\n           | FromToR Exp Exp | FromThenToR Exp Exp Exp\n          deriving( Show, Eq, Ord, Data, Generic )\n\ndata Dec\n  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@\n  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@\n  | DataD Cxt Name [TyVarBndr]\n          (Maybe Kind)            -- Kind signature (allowed only for GADTs)\n          [Con] [DerivClause]\n                                  -- ^ @{ data Cxt x => T x = A x | B (T x)\n                                  --       deriving (Z,W)\n                                  --       deriving stock Eq }@\n  | NewtypeD Cxt Name [TyVarBndr]\n             (Maybe Kind)         -- Kind signature\n             Con [DerivClause]    -- ^ @{ newtype Cxt x => T x = A (B x)\n                                  --       deriving (Z,W Q)\n                                  --       deriving stock Eq }@\n  | TySynD Name [TyVarBndr] Type  -- ^ @{ type T x = (x,x) }@\n  | ClassD Cxt Name [TyVarBndr]\n         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@\n  | InstanceD (Maybe Overlap) Cxt Type [Dec]\n                                  -- ^ @{ instance {\\-\\# OVERLAPS \\#-\\}\n                                  --        Show w => Show [w] where ds }@\n  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@\n  | ForeignD Foreign              -- ^ @{ foreign import ... }\n                                  --{ foreign export ... }@\n\n  | InfixD Fixity Name            -- ^ @{ infix 3 foo }@\n\n  -- | pragmas\n  | PragmaD Pragma                -- ^ @{ {\\-\\# INLINE [1] foo \\#-\\} }@\n\n  -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')\n  | DataFamilyD Name [TyVarBndr]\n               (Maybe Kind)\n         -- ^ @{ data family T a b c :: * }@\n\n  | DataInstD Cxt (Maybe [TyVarBndr]) Type\n             (Maybe Kind)         -- Kind signature\n             [Con] [DerivClause]  -- ^ @{ data instance Cxt x => T [x]\n                                  --       = A x | B (T x)\n                                  --       deriving (Z,W)\n                                  --       deriving stock Eq }@\n\n  | NewtypeInstD Cxt (Maybe [TyVarBndr]) Type -- Quantified type vars\n                 (Maybe Kind)      -- Kind signature\n                 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x]\n                                   --        = A (B x)\n                                   --        deriving (Z,W)\n                                   --        deriving stock Eq }@\n  | TySynInstD TySynEqn            -- ^ @{ type instance ... }@\n\n  -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')\n  | OpenTypeFamilyD TypeFamilyHead\n         -- ^ @{ type family T a b c = (r :: *) | r -> a b }@\n\n  | ClosedTypeFamilyD TypeFamilyHead [TySynEqn]\n       -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@\n\n  | RoleAnnotD Name [Role]     -- ^ @{ type role T nominal representational }@\n  | StandaloneDerivD (Maybe DerivStrategy) Cxt Type\n       -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@\n  | DefaultSigD Name Type      -- ^ @{ default size :: Data a => a -> Int }@\n\n  -- | Pattern Synonyms\n  | PatSynD Name PatSynArgs PatSynDir Pat\n      -- ^ @{ pattern P v1 v2 .. vn <- p }@  unidirectional           or\n      --   @{ pattern P v1 v2 .. vn = p  }@  implicit bidirectional   or\n      --   @{ pattern P v1 v2 .. vn <- p\n      --        where P v1 v2 .. vn = e  }@  explicit bidirectional\n      --\n      -- also, besides prefix pattern synonyms, both infix and record\n      -- pattern synonyms are supported. See 'PatSynArgs' for details\n\n  | PatSynSigD Name PatSynType  -- ^ A pattern synonym's type signature.\n\n  | ImplicitParamBindD String Exp\n      -- ^ @{ ?x = expr }@\n      --\n      -- Implicit parameter binding declaration. Can only be used in let\n      -- and where clauses which consist entirely of implicit bindings.\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | Varieties of allowed instance overlap.\ndata Overlap = Overlappable   -- ^ May be overlapped by more specific instances\n             | Overlapping    -- ^ May overlap a more general instance\n             | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'\n             | Incoherent     -- ^ Both 'Overlappable' and 'Overlappable', and\n                              -- pick an arbitrary one if multiple choices are\n                              -- available.\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | A single @deriving@ clause at the end of a datatype.\ndata DerivClause = DerivClause (Maybe DerivStrategy) Cxt\n    -- ^ @{ deriving stock (Eq, Ord) }@\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | What the user explicitly requests when deriving an instance.\ndata DerivStrategy = StockStrategy    -- ^ A \\\"standard\\\" derived instance\n                   | AnyclassStrategy -- ^ @-XDeriveAnyClass@\n                   | NewtypeStrategy  -- ^ @-XGeneralizedNewtypeDeriving@\n                   | ViaStrategy Type -- ^ @-XDerivingVia@\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | A pattern synonym's type. Note that a pattern synonym's /fully/\n-- specified type has a peculiar shape coming with two forall\n-- quantifiers and two constraint contexts. For example, consider the\n-- pattern synonym\n--\n-- > pattern P x1 x2 ... xn = <some-pattern>\n--\n-- P's complete type is of the following form\n--\n-- > pattern P :: forall universals.   required constraints\n-- >           => forall existentials. provided constraints\n-- >           => t1 -> t2 -> ... -> tn -> t\n--\n-- consisting of four parts:\n--\n--   1. the (possibly empty lists of) universally quantified type\n--      variables and required constraints on them.\n--   2. the (possibly empty lists of) existentially quantified\n--      type variables and the provided constraints on them.\n--   3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively\n--   4. the type @t@ of @\\<some-pattern\\>@, mentioning only universals.\n--\n-- Pattern synonym types interact with TH when (a) reifying a pattern\n-- synonym, (b) pretty printing, or (c) specifying a pattern synonym's\n-- type signature explicitly:\n--\n--   * Reification always returns a pattern synonym's /fully/ specified\n--     type in abstract syntax.\n--\n--   * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates\n--     a pattern synonym's type unambiguously in concrete syntax: The rule of\n--     thumb is to print initial empty universals and the required\n--     context as @() =>@, if existentials and a provided context\n--     follow. If only universals and their required context, but no\n--     existentials are specified, only the universals and their\n--     required context are printed. If both or none are specified, so\n--     both (or none) are printed.\n--\n--   * When specifying a pattern synonym's type explicitly with\n--     'PatSynSigD' either one of the universals, the existentials, or\n--     their contexts may be left empty.\n--\n-- See the GHC user's guide for more information on pattern synonyms\n-- and their types:\n-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>.\ntype PatSynType = Type\n\n-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By\n-- analogy with \"head\" for type classes and type class instances as\n-- defined in /Type classes: an exploration of the design space/, the\n-- @TypeFamilyHead@ is defined to be the elements of the declaration\n-- between @type family@ and @where@.\ndata TypeFamilyHead =\n  TypeFamilyHead Name [TyVarBndr] FamilyResultSig (Maybe InjectivityAnn)\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | One equation of a type family instance or closed type family. The\n-- arguments are the left-hand-side type and the right-hand-side result.\n--\n-- For instance, if you had the following type family:\n--\n-- @\n-- type family Foo (a :: k) :: k where\n--   forall k (a :: k). Foo \\@k a = a\n-- @\n--\n-- The @Foo \\@k a = a@ equation would be represented as follows:\n--\n-- @\n-- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])\n--            ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))\n--            ('VarT' a)\n-- @\ndata TySynEqn = TySynEqn (Maybe [TyVarBndr]) Type Type\n  deriving( Show, Eq, Ord, Data, Generic )\n\ndata FunDep = FunDep [Name] [Name]\n  deriving( Show, Eq, Ord, Data, Generic )\n\ndata Foreign = ImportF Callconv Safety String Name Type\n             | ExportF Callconv        String Name Type\n         deriving( Show, Eq, Ord, Data, Generic )\n\n-- keep Callconv in sync with module ForeignCall in ghc/compiler/prelude/ForeignCall.hs\ndata Callconv = CCall | StdCall | CApi | Prim | JavaScript\n          deriving( Show, Eq, Ord, Data, Generic )\n\ndata Safety = Unsafe | Safe | Interruptible\n        deriving( Show, Eq, Ord, Data, Generic )\n\ndata Pragma = InlineP         Name Inline RuleMatch Phases\n            | SpecialiseP     Name Type (Maybe Inline) Phases\n            | SpecialiseInstP Type\n            | RuleP           String (Maybe [TyVarBndr]) [RuleBndr] Exp Exp Phases\n            | AnnP            AnnTarget Exp\n            | LineP           Int String\n            | CompleteP       [Name] (Maybe Name)\n                -- ^ @{ {\\-\\# COMPLETE C_1, ..., C_i [ :: T ] \\#-} }@\n        deriving( Show, Eq, Ord, Data, Generic )\n\ndata Inline = NoInline\n            | Inline\n            | Inlinable\n            deriving (Show, Eq, Ord, Data, Generic)\n\ndata RuleMatch = ConLike\n               | FunLike\n               deriving (Show, Eq, Ord, Data, Generic)\n\ndata Phases = AllPhases\n            | FromPhase Int\n            | BeforePhase Int\n            deriving (Show, Eq, Ord, Data, Generic)\n\ndata RuleBndr = RuleVar Name\n              | TypedRuleVar Name Type\n              deriving (Show, Eq, Ord, Data, Generic)\n\ndata AnnTarget = ModuleAnnotation\n               | TypeAnnotation Name\n               | ValueAnnotation Name\n              deriving (Show, Eq, Ord, Data, Generic)\n\ntype Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@\n\n-- | Since the advent of @ConstraintKinds@, constraints are really just types.\n-- Equality constraints use the 'EqualityT' constructor. Constraints may also\n-- be tuples of other constraints.\ntype Pred = Type\n\ndata SourceUnpackedness\n  = NoSourceUnpackedness -- ^ @C a@\n  | SourceNoUnpack       -- ^ @C { {\\-\\# NOUNPACK \\#-\\} } a@\n  | SourceUnpack         -- ^ @C { {\\-\\# UNPACK \\#-\\} } a@\n        deriving (Show, Eq, Ord, Data, Generic)\n\ndata SourceStrictness = NoSourceStrictness    -- ^ @C a@\n                      | SourceLazy            -- ^ @C {~}a@\n                      | SourceStrict          -- ^ @C {!}a@\n        deriving (Show, Eq, Ord, Data, Generic)\n\n-- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'\n-- refers to the strictness that the compiler chooses for a data constructor\n-- field, which may be different from what is written in source code. See\n-- 'reifyConStrictness' for more information.\ndata DecidedStrictness = DecidedLazy\n                       | DecidedStrict\n                       | DecidedUnpack\n        deriving (Show, Eq, Ord, Data, Generic)\n\n-- | A single data constructor.\n--\n-- The constructors for 'Con' can roughly be divided up into two categories:\n-- those for constructors with \\\"vanilla\\\" syntax ('NormalC', 'RecC', and\n-- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and\n-- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type\n-- variables and class contexts, can surround either variety of constructor.\n-- However, the type variables that it quantifies are different depending\n-- on what constructor syntax is used:\n--\n-- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the\n--   'ForallC' will only quantify /existential/ type variables. For example:\n--\n--   @\n--   data Foo a = forall b. MkFoo a b\n--   @\n--\n--   In @MkFoo@, 'ForallC' will quantify @b@, but not @a@.\n--\n-- * If a 'ForallC' surrounds a constructor with GADT syntax, then the\n--   'ForallC' will quantify /all/ type variables used in the constructor.\n--   For example:\n--\n--   @\n--   data Bar a b where\n--     MkBar :: (a ~ b) => c -> MkBar a b\n--   @\n--\n--   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.\ndata Con = NormalC Name [BangType]       -- ^ @C Int a@\n         | RecC Name [VarBangType]       -- ^ @C { v :: Int, w :: a }@\n         | InfixC BangType Name BangType -- ^ @Int :+ a@\n         | ForallC [TyVarBndr] Cxt Con   -- ^ @forall a. Eq a => C [a]@\n         | GadtC [Name] [BangType]\n                 Type                    -- See Note [GADT return type]\n                                         -- ^ @C :: a -> b -> T b Int@\n         | RecGadtC [Name] [VarBangType]\n                    Type                 -- See Note [GADT return type]\n                                         -- ^ @C :: { v :: Int } -> T b Int@\n        deriving (Show, Eq, Ord, Data, Generic)\n\n-- Note [GADT return type]\n-- ~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- The return type of a GADT constructor does not necessarily match the name of\n-- the data type:\n--\n-- type S = T\n--\n-- data T a where\n--     MkT :: S Int\n--\n--\n-- type S a = T\n--\n-- data T a where\n--     MkT :: S Char Int\n--\n--\n-- type Id a = a\n-- type S a = T\n--\n-- data T a where\n--     MkT :: Id (S Char Int)\n--\n--\n-- That is why we allow the return type stored by a constructor to be an\n-- arbitrary type. See also #11341\n\ndata Bang = Bang SourceUnpackedness SourceStrictness\n         -- ^ @C { {\\-\\# UNPACK \\#-\\} !}a@\n        deriving (Show, Eq, Ord, Data, Generic)\n\ntype BangType    = (Bang, Type)\ntype VarBangType = (Name, Bang, Type)\n\n-- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.\ntype Strict      = Bang\n\n-- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by\n-- 'BangType'.\ntype StrictType    = BangType\n\n-- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by\n-- 'VarBangType'.\ntype VarStrictType = VarBangType\n\n-- | A pattern synonym's directionality.\ndata PatSynDir\n  = Unidir             -- ^ @pattern P x {<-} p@\n  | ImplBidir          -- ^ @pattern P x {=} p@\n  | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | A pattern synonym's argument type.\ndata PatSynArgs\n  = PrefixPatSyn [Name]        -- ^ @pattern P {x y z} = p@\n  | InfixPatSyn Name Name      -- ^ @pattern {x P y} = p@\n  | RecordPatSyn [Name]        -- ^ @pattern P { {x,y,z} } = p@\n  deriving( Show, Eq, Ord, Data, Generic )\n\ndata Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \\<vars\\>. \\<ctxt\\> => \\<type\\>@\n          | ForallVisT [TyVarBndr] Type   -- ^ @forall \\<vars\\> -> \\<type\\>@\n          | AppT Type Type                -- ^ @T a b@\n          | AppKindT Type Kind            -- ^ @T \\@k t@\n          | SigT Type Kind                -- ^ @t :: k@\n          | VarT Name                     -- ^ @a@\n          | ConT Name                     -- ^ @T@\n          | PromotedT Name                -- ^ @'T@\n          | InfixT Type Name Type         -- ^ @T + T@\n          | UInfixT Type Name Type        -- ^ @T + T@\n                                          --\n                                          -- See \"Language.Haskell.TH.Syntax#infix\"\n          | ParensT Type                  -- ^ @(T)@\n\n          -- See Note [Representing concrete syntax in types]\n          | TupleT Int                    -- ^ @(,), (,,), etc.@\n          | UnboxedTupleT Int             -- ^ @(\\#,\\#), (\\#,,\\#), etc.@\n          | UnboxedSumT SumArity          -- ^ @(\\#|\\#), (\\#||\\#), etc.@\n          | ArrowT                        -- ^ @->@\n          | EqualityT                     -- ^ @~@\n          | ListT                         -- ^ @[]@\n          | PromotedTupleT Int            -- ^ @'(), '(,), '(,,), etc.@\n          | PromotedNilT                  -- ^ @'[]@\n          | PromotedConsT                 -- ^ @(':)@\n          | StarT                         -- ^ @*@\n          | ConstraintT                   -- ^ @Constraint@\n          | LitT TyLit                    -- ^ @0,1,2, etc.@\n          | WildCardT                     -- ^ @_@\n          | ImplicitParamT String Type    -- ^ @?x :: t@\n      deriving( Show, Eq, Ord, Data, Generic )\n\ndata TyVarBndr = PlainTV  Name            -- ^ @a@\n               | KindedTV Name Kind       -- ^ @(a :: k)@\n      deriving( Show, Eq, Ord, Data, Generic )\n\n-- | Type family result signature\ndata FamilyResultSig = NoSig              -- ^ no signature\n                     | KindSig  Kind      -- ^ @k@\n                     | TyVarSig TyVarBndr -- ^ @= r, = (r :: k)@\n      deriving( Show, Eq, Ord, Data, Generic )\n\n-- | Injectivity annotation\ndata InjectivityAnn = InjectivityAnn Name [Name]\n  deriving ( Show, Eq, Ord, Data, Generic )\n\ndata TyLit = NumTyLit Integer             -- ^ @2@\n           | StrTyLit String              -- ^ @\\\"Hello\\\"@\n  deriving ( Show, Eq, Ord, Data, Generic )\n\n-- | Role annotations\ndata Role = NominalR            -- ^ @nominal@\n          | RepresentationalR   -- ^ @representational@\n          | PhantomR            -- ^ @phantom@\n          | InferR              -- ^ @_@\n  deriving( Show, Eq, Ord, Data, Generic )\n\n-- | Annotation target for reifyAnnotations\ndata AnnLookup = AnnLookupModule Module\n               | AnnLookupName Name\n               deriving( Show, Eq, Ord, Data, Generic )\n\n-- | To avoid duplication between kinds and types, they\n-- are defined to be the same. Naturally, you would never\n-- have a type be 'StarT' and you would never have a kind\n-- be 'SigT', but many of the other constructors are shared.\n-- Note that the kind @Bool@ is denoted with 'ConT', not\n-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',\n-- not 'PromotedTupleT'.\n\ntype Kind = Type\n\n{- Note [Representing concrete syntax in types]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nHaskell has a rich concrete syntax for types, including\n  t1 -> t2, (t1,t2), [t], and so on\nIn TH we represent all of this using AppT, with a distinguished\ntype constructor at the head.  So,\n  Type              TH representation\n  -----------------------------------------------\n  t1 -> t2          ArrowT `AppT` t2 `AppT` t2\n  [t]               ListT `AppT` t\n  (t1,t2)           TupleT 2 `AppT` t1 `AppT` t2\n  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2\n\nBut if the original HsSyn used prefix application, we won't use\nthese special TH constructors.  For example\n  [] t              ConT \"[]\" `AppT` t\n  (->) t            ConT \"->\" `AppT` t\nIn this way we can faithfully represent in TH whether the original\nHsType used concrete syntax or not.\n\nThe one case that doesn't fit this pattern is that of promoted lists\n  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2\nbut it's very smelly because there really is no type constructor\ncorresponding to PromotedListT. So we encode HsExplicitListTy with\nPromotedConsT and PromotedNilT (which *do* have underlying type\nconstructors):\n  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`\n                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)\n-}\n\n-----------------------------------------------------\n--              Internal helper functions\n-----------------------------------------------------\n\ncmpEq :: Ordering -> Bool\ncmpEq EQ = True\ncmpEq _  = False\n\nthenCmp :: Ordering -> Ordering -> Ordering\nthenCmp EQ o2 = o2\nthenCmp o1 _  = o1\n", "num_lines": 2213}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- |\n-- Language.Haskell.TH.Lib.Internal exposes some additional functionality that\n-- is used internally in GHC's integration with Template Haskell. This is not a\n-- part of the public API, and as such, there are no API guarantees for this\n-- module from version to version.\n\n-- Why do we have both Language.Haskell.TH.Lib.Internal and\n-- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the\n-- former (which are tailored for GHC's use) need different type signatures\n-- than the ones in the latter. Syncing up the Internal type signatures would\n-- involve a massive amount of breaking changes, so for the time being, we\n-- relegate as many changes as we can to just the Internal module, where it\n-- is safe to break things.\n\nmodule Language.Haskell.TH.Lib.Internal where\n\nimport Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)\nimport qualified Language.Haskell.TH.Syntax as TH\nimport Control.Monad( liftM, liftM2 )\nimport Data.Word( Word8 )\nimport Prelude\n\n----------------------------------------------------------\n-- * Type synonyms\n----------------------------------------------------------\n\ntype InfoQ               = Q Info\ntype PatQ                = Q Pat\ntype FieldPatQ           = Q FieldPat\ntype ExpQ                = Q Exp\ntype TExpQ a             = Q (TExp a)\ntype DecQ                = Q Dec\ntype DecsQ               = Q [Dec]\ntype ConQ                = Q Con\ntype TypeQ               = Q Type\ntype KindQ               = Q Kind\ntype TyVarBndrQ          = Q TyVarBndr\ntype TyLitQ              = Q TyLit\ntype CxtQ                = Q Cxt\ntype PredQ               = Q Pred\ntype DerivClauseQ        = Q DerivClause\ntype MatchQ              = Q Match\ntype ClauseQ             = Q Clause\ntype BodyQ               = Q Body\ntype GuardQ              = Q Guard\ntype StmtQ               = Q Stmt\ntype RangeQ              = Q Range\ntype SourceStrictnessQ   = Q SourceStrictness\ntype SourceUnpackednessQ = Q SourceUnpackedness\ntype BangQ               = Q Bang\ntype BangTypeQ           = Q BangType\ntype VarBangTypeQ        = Q VarBangType\ntype StrictTypeQ         = Q StrictType\ntype VarStrictTypeQ      = Q VarStrictType\ntype FieldExpQ           = Q FieldExp\ntype RuleBndrQ           = Q RuleBndr\ntype TySynEqnQ           = Q TySynEqn\ntype PatSynDirQ          = Q PatSynDir\ntype PatSynArgsQ         = Q PatSynArgs\ntype FamilyResultSigQ    = Q FamilyResultSig\ntype DerivStrategyQ      = Q DerivStrategy\n\n-- must be defined here for DsMeta to find it\ntype Role                = TH.Role\ntype InjectivityAnn      = TH.InjectivityAnn\n\n----------------------------------------------------------\n-- * Lowercase pattern syntax functions\n----------------------------------------------------------\n\nintPrimL    :: Integer -> Lit\nintPrimL    = IntPrimL\nwordPrimL    :: Integer -> Lit\nwordPrimL    = WordPrimL\nfloatPrimL  :: Rational -> Lit\nfloatPrimL  = FloatPrimL\ndoublePrimL :: Rational -> Lit\ndoublePrimL = DoublePrimL\nintegerL    :: Integer -> Lit\nintegerL    = IntegerL\ncharL       :: Char -> Lit\ncharL       = CharL\ncharPrimL   :: Char -> Lit\ncharPrimL   = CharPrimL\nstringL     :: String -> Lit\nstringL     = StringL\nstringPrimL :: [Word8] -> Lit\nstringPrimL = StringPrimL\nrationalL   :: Rational -> Lit\nrationalL   = RationalL\n\nlitP :: Lit -> PatQ\nlitP l = return (LitP l)\n\nvarP :: Name -> PatQ\nvarP v = return (VarP v)\n\ntupP :: [PatQ] -> PatQ\ntupP ps = do { ps1 <- sequence ps; return (TupP ps1)}\n\nunboxedTupP :: [PatQ] -> PatQ\nunboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}\n\nunboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ\nunboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }\n\nconP :: Name -> [PatQ] -> PatQ\nconP n ps = do ps' <- sequence ps\n               return (ConP n ps')\ninfixP :: PatQ -> Name -> PatQ -> PatQ\ninfixP p1 n p2 = do p1' <- p1\n                    p2' <- p2\n                    return (InfixP p1' n p2')\nuInfixP :: PatQ -> Name -> PatQ -> PatQ\nuInfixP p1 n p2 = do p1' <- p1\n                     p2' <- p2\n                     return (UInfixP p1' n p2')\nparensP :: PatQ -> PatQ\nparensP p = do p' <- p\n               return (ParensP p')\n\ntildeP :: PatQ -> PatQ\ntildeP p = do p' <- p\n              return (TildeP p')\nbangP :: PatQ -> PatQ\nbangP p = do p' <- p\n             return (BangP p')\nasP :: Name -> PatQ -> PatQ\nasP n p = do p' <- p\n             return (AsP n p')\nwildP :: PatQ\nwildP = return WildP\nrecP :: Name -> [FieldPatQ] -> PatQ\nrecP n fps = do fps' <- sequence fps\n                return (RecP n fps')\nlistP :: [PatQ] -> PatQ\nlistP ps = do ps' <- sequence ps\n              return (ListP ps')\nsigP :: PatQ -> TypeQ -> PatQ\nsigP p t = do p' <- p\n              t' <- t\n              return (SigP p' t')\nviewP :: ExpQ -> PatQ -> PatQ\nviewP e p = do e' <- e\n               p' <- p\n               return (ViewP e' p')\n\nfieldPat :: Name -> PatQ -> FieldPatQ\nfieldPat n p = do p' <- p\n                  return (n, p')\n\n\n-------------------------------------------------------------------------------\n-- *   Stmt\n\nbindS :: PatQ -> ExpQ -> StmtQ\nbindS p e = liftM2 BindS p e\n\nletS :: [DecQ] -> StmtQ\nletS ds = do { ds1 <- sequence ds; return (LetS ds1) }\n\nnoBindS :: ExpQ -> StmtQ\nnoBindS e = do { e1 <- e; return (NoBindS e1) }\n\nparS :: [[StmtQ]] -> StmtQ\nparS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }\n\nrecS :: [StmtQ] -> StmtQ\nrecS ss = do { ss1 <- sequence ss; return (RecS ss1) }\n\n-------------------------------------------------------------------------------\n-- *   Range\n\nfromR :: ExpQ -> RangeQ\nfromR x = do { a <- x; return (FromR a) }\n\nfromThenR :: ExpQ -> ExpQ -> RangeQ\nfromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }\n\nfromToR :: ExpQ -> ExpQ -> RangeQ\nfromToR x y = do { a <- x; b <- y; return (FromToR a b) }\n\nfromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ\nfromThenToR x y z = do { a <- x; b <- y; c <- z;\n                         return (FromThenToR a b c) }\n-------------------------------------------------------------------------------\n-- *   Body\n\nnormalB :: ExpQ -> BodyQ\nnormalB e = do { e1 <- e; return (NormalB e1) }\n\nguardedB :: [Q (Guard,Exp)] -> BodyQ\nguardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }\n\n-------------------------------------------------------------------------------\n-- *   Guard\n\nnormalG :: ExpQ -> GuardQ\nnormalG e = do { e1 <- e; return (NormalG e1) }\n\nnormalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)\nnormalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }\n\npatG :: [StmtQ] -> GuardQ\npatG ss = do { ss' <- sequence ss; return (PatG ss') }\n\npatGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)\npatGE ss e = do { ss' <- sequence ss;\n                  e'  <- e;\n                  return (PatG ss', e') }\n\n-------------------------------------------------------------------------------\n-- *   Match and Clause\n\n-- | Use with 'caseE'\nmatch :: PatQ -> BodyQ -> [DecQ] -> MatchQ\nmatch p rhs ds = do { p' <- p;\n                      r' <- rhs;\n                      ds' <- sequence ds;\n                      return (Match p' r' ds') }\n\n-- | Use with 'funD'\nclause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ\nclause ps r ds = do { ps' <- sequence ps;\n                      r' <- r;\n                      ds' <- sequence ds;\n                      return (Clause ps' r' ds') }\n\n\n---------------------------------------------------------------------------\n-- *   Exp\n\n-- | Dynamically binding a variable (unhygenic)\ndyn :: String -> ExpQ\ndyn s = return (VarE (mkName s))\n\nvarE :: Name -> ExpQ\nvarE s = return (VarE s)\n\nconE :: Name -> ExpQ\nconE s =  return (ConE s)\n\nlitE :: Lit -> ExpQ\nlitE c = return (LitE c)\n\nappE :: ExpQ -> ExpQ -> ExpQ\nappE x y = do { a <- x; b <- y; return (AppE a b)}\n\nappTypeE :: ExpQ -> TypeQ -> ExpQ\nappTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }\n\nparensE :: ExpQ -> ExpQ\nparensE x = do { x' <- x; return (ParensE x') }\n\nuInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ\nuInfixE x s y = do { x' <- x; s' <- s; y' <- y;\n                     return (UInfixE x' s' y') }\n\ninfixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ\ninfixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;\n                                  return (InfixE (Just a) s' (Just b))}\ninfixE Nothing  s (Just y) = do { s' <- s; b <- y;\n                                  return (InfixE Nothing s' (Just b))}\ninfixE (Just x) s Nothing  = do { a <- x; s' <- s;\n                                  return (InfixE (Just a) s' Nothing)}\ninfixE Nothing  s Nothing  = do { s' <- s; return (InfixE Nothing s' Nothing) }\n\ninfixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ\ninfixApp x y z = infixE (Just x) y (Just z)\nsectionL :: ExpQ -> ExpQ -> ExpQ\nsectionL x y = infixE (Just x) y Nothing\nsectionR :: ExpQ -> ExpQ -> ExpQ\nsectionR x y = infixE Nothing x (Just y)\n\nlamE :: [PatQ] -> ExpQ -> ExpQ\nlamE ps e = do ps' <- sequence ps\n               e' <- e\n               return (LamE ps' e')\n\n-- | Single-arg lambda\nlam1E :: PatQ -> ExpQ -> ExpQ\nlam1E p e = lamE [p] e\n\nlamCaseE :: [MatchQ] -> ExpQ\nlamCaseE ms = sequence ms >>= return . LamCaseE\n\ntupE :: [ExpQ] -> ExpQ\ntupE es = do { es1 <- sequence es; return (TupE es1)}\n\nunboxedTupE :: [ExpQ] -> ExpQ\nunboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}\n\nunboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ\nunboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }\n\ncondE :: ExpQ -> ExpQ -> ExpQ -> ExpQ\ncondE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}\n\nmultiIfE :: [Q (Guard, Exp)] -> ExpQ\nmultiIfE alts = sequence alts >>= return . MultiIfE\n\nletE :: [DecQ] -> ExpQ -> ExpQ\nletE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }\n\ncaseE :: ExpQ -> [MatchQ] -> ExpQ\ncaseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }\n\ndoE :: [StmtQ] -> ExpQ\ndoE ss = do { ss1 <- sequence ss; return (DoE ss1) }\n\nmdoE :: [StmtQ] -> ExpQ\nmdoE ss = do { ss1 <- sequence ss; return (MDoE ss1) }\n\ncompE :: [StmtQ] -> ExpQ\ncompE ss = do { ss1 <- sequence ss; return (CompE ss1) }\n\narithSeqE :: RangeQ -> ExpQ\narithSeqE r = do { r' <- r; return (ArithSeqE r') }\n\nlistE :: [ExpQ] -> ExpQ\nlistE es = do { es1 <- sequence es; return (ListE es1) }\n\nsigE :: ExpQ -> TypeQ -> ExpQ\nsigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }\n\nrecConE :: Name -> [Q (Name,Exp)] -> ExpQ\nrecConE c fs = do { flds <- sequence fs; return (RecConE c flds) }\n\nrecUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ\nrecUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }\n\nstringE :: String -> ExpQ\nstringE = litE . stringL\n\nfieldExp :: Name -> ExpQ -> Q (Name, Exp)\nfieldExp s e = do { e' <- e; return (s,e') }\n\n-- | @staticE x = [| static x |]@\nstaticE :: ExpQ -> ExpQ\nstaticE = fmap StaticE\n\nunboundVarE :: Name -> ExpQ\nunboundVarE s = return (UnboundVarE s)\n\nlabelE :: String -> ExpQ\nlabelE s = return (LabelE s)\n\nimplicitParamVarE :: String -> ExpQ\nimplicitParamVarE n = return (ImplicitParamVarE n)\n\n-- ** 'arithSeqE' Shortcuts\nfromE :: ExpQ -> ExpQ\nfromE x = do { a <- x; return (ArithSeqE (FromR a)) }\n\nfromThenE :: ExpQ -> ExpQ -> ExpQ\nfromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }\n\nfromToE :: ExpQ -> ExpQ -> ExpQ\nfromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }\n\nfromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ\nfromThenToE x y z = do { a <- x; b <- y; c <- z;\n                         return (ArithSeqE (FromThenToR a b c)) }\n\n\n-------------------------------------------------------------------------------\n-- *   Dec\n\nvalD :: PatQ -> BodyQ -> [DecQ] -> DecQ\nvalD p b ds =\n  do { p' <- p\n     ; ds' <- sequence ds\n     ; b' <- b\n     ; return (ValD p' b' ds')\n     }\n\nfunD :: Name -> [ClauseQ] -> DecQ\nfunD nm cs =\n do { cs1 <- sequence cs\n    ; return (FunD nm cs1)\n    }\n\ntySynD :: Name -> [TyVarBndrQ] -> TypeQ -> DecQ\ntySynD tc tvs rhs =\n  do { tvs1 <- sequenceA tvs\n     ; rhs1 <- rhs\n     ; return (TySynD tc tvs1 rhs1)\n     }\n\ndataD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> [ConQ]\n      -> [DerivClauseQ] -> DecQ\ndataD ctxt tc tvs ksig cons derivs =\n  do\n    ctxt1   <- ctxt\n    tvs1    <- sequenceA tvs\n    ksig1   <- sequenceA ksig\n    cons1   <- sequence cons\n    derivs1 <- sequence derivs\n    return (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)\n\nnewtypeD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> ConQ\n         -> [DerivClauseQ] -> DecQ\nnewtypeD ctxt tc tvs ksig con derivs =\n  do\n    ctxt1   <- ctxt\n    tvs1    <- sequenceA tvs\n    ksig1   <- sequenceA ksig\n    con1    <- con\n    derivs1 <- sequence derivs\n    return (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)\n\nclassD :: CxtQ -> Name -> [TyVarBndrQ] -> [FunDep] -> [DecQ] -> DecQ\nclassD ctxt cls tvs fds decs =\n  do\n    tvs1  <- sequenceA tvs\n    decs1 <- sequenceA decs\n    ctxt1 <- ctxt\n    return $ ClassD ctxt1 cls tvs1 fds decs1\n\ninstanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ\ninstanceD = instanceWithOverlapD Nothing\n\ninstanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ\ninstanceWithOverlapD o ctxt ty decs =\n  do\n    ctxt1 <- ctxt\n    decs1 <- sequence decs\n    ty1   <- ty\n    return $ InstanceD o ctxt1 ty1 decs1\n\n\n\nsigD :: Name -> TypeQ -> DecQ\nsigD fun ty = liftM (SigD fun) $ ty\n\nforImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ\nforImpD cc s str n ty\n = do ty' <- ty\n      return $ ForeignD (ImportF cc s str n ty')\n\ninfixLD :: Int -> Name -> DecQ\ninfixLD prec nm = return (InfixD (Fixity prec InfixL) nm)\n\ninfixRD :: Int -> Name -> DecQ\ninfixRD prec nm = return (InfixD (Fixity prec InfixR) nm)\n\ninfixND :: Int -> Name -> DecQ\ninfixND prec nm = return (InfixD (Fixity prec InfixN) nm)\n\npragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ\npragInlD name inline rm phases\n  = return $ PragmaD $ InlineP name inline rm phases\n\npragSpecD :: Name -> TypeQ -> Phases -> DecQ\npragSpecD n ty phases\n  = do\n      ty1    <- ty\n      return $ PragmaD $ SpecialiseP n ty1 Nothing phases\n\npragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ\npragSpecInlD n ty inline phases\n  = do\n      ty1    <- ty\n      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases\n\npragSpecInstD :: TypeQ -> DecQ\npragSpecInstD ty\n  = do\n      ty1    <- ty\n      return $ PragmaD $ SpecialiseInstP ty1\n\npragRuleD :: String -> Maybe [TyVarBndrQ] -> [RuleBndrQ] -> ExpQ -> ExpQ\n          -> Phases -> DecQ\npragRuleD n ty_bndrs tm_bndrs lhs rhs phases\n  = do\n      ty_bndrs1 <- traverse sequence ty_bndrs\n      tm_bndrs1 <- sequence tm_bndrs\n      lhs1   <- lhs\n      rhs1   <- rhs\n      return $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases\n\npragAnnD :: AnnTarget -> ExpQ -> DecQ\npragAnnD target expr\n  = do\n      exp1 <- expr\n      return $ PragmaD $ AnnP target exp1\n\npragLineD :: Int -> String -> DecQ\npragLineD line file = return $ PragmaD $ LineP line file\n\npragCompleteD :: [Name] -> Maybe Name -> DecQ\npragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty\n\ndataInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> [ConQ]\n          -> [DerivClauseQ] -> DecQ\ndataInstD ctxt mb_bndrs ty ksig cons derivs =\n  do\n    ctxt1   <- ctxt\n    mb_bndrs1 <- traverse sequence mb_bndrs\n    ty1    <- ty\n    ksig1   <- sequenceA ksig\n    cons1   <- sequenceA cons\n    derivs1 <- sequenceA derivs\n    return (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1)\n\nnewtypeInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> ConQ\n             -> [DerivClauseQ] -> DecQ\nnewtypeInstD ctxt mb_bndrs ty ksig con derivs =\n  do\n    ctxt1   <- ctxt\n    mb_bndrs1 <- traverse sequence mb_bndrs\n    ty1    <- ty\n    ksig1   <- sequenceA ksig\n    con1    <- con\n    derivs1 <- sequence derivs\n    return (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1)\n\ntySynInstD :: TySynEqnQ -> DecQ\ntySynInstD eqn =\n  do\n    eqn1 <- eqn\n    return (TySynInstD eqn1)\n\ndataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ\ndataFamilyD tc tvs kind =\n  do tvs'  <- sequenceA tvs\n     kind' <- sequenceA kind\n     return $ DataFamilyD tc tvs' kind'\n\nopenTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ\n                -> Maybe InjectivityAnn -> DecQ\nopenTypeFamilyD tc tvs res inj =\n  do tvs' <- sequenceA tvs\n     res' <- res\n     return $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)\n\nclosedTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ\n                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ\nclosedTypeFamilyD tc tvs result injectivity eqns =\n  do tvs1    <- sequenceA tvs\n     result1 <- result\n     eqns1   <- sequenceA eqns\n     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)\n\nroleAnnotD :: Name -> [Role] -> DecQ\nroleAnnotD name roles = return $ RoleAnnotD name roles\n\nstandaloneDerivD :: CxtQ -> TypeQ -> DecQ\nstandaloneDerivD = standaloneDerivWithStrategyD Nothing\n\nstandaloneDerivWithStrategyD :: Maybe DerivStrategyQ -> CxtQ -> TypeQ -> DecQ\nstandaloneDerivWithStrategyD mdsq ctxtq tyq =\n  do\n    mds  <- sequenceA mdsq\n    ctxt <- ctxtq\n    ty   <- tyq\n    return $ StandaloneDerivD mds ctxt ty\n\ndefaultSigD :: Name -> TypeQ -> DecQ\ndefaultSigD n tyq =\n  do\n    ty <- tyq\n    return $ DefaultSigD n ty\n\n-- | Pattern synonym declaration\npatSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ\npatSynD name args dir pat = do\n  args'    <- args\n  dir'     <- dir\n  pat'     <- pat\n  return (PatSynD name args' dir' pat')\n\n-- | Pattern synonym type signature\npatSynSigD :: Name -> TypeQ -> DecQ\npatSynSigD nm ty =\n  do ty' <- ty\n     return $ PatSynSigD nm ty'\n\n-- | Implicit parameter binding declaration. Can only be used in let\n-- and where clauses which consist entirely of implicit bindings.\nimplicitParamBindD :: String -> ExpQ -> DecQ\nimplicitParamBindD n e =\n  do\n    e' <- e\n    return $ ImplicitParamBindD n e'\n\ntySynEqn :: (Maybe [TyVarBndrQ]) -> TypeQ -> TypeQ -> TySynEqnQ\ntySynEqn mb_bndrs lhs rhs =\n  do\n    mb_bndrs1 <- traverse sequence mb_bndrs\n    lhs1 <- lhs\n    rhs1 <- rhs\n    return (TySynEqn mb_bndrs1 lhs1 rhs1)\n\ncxt :: [PredQ] -> CxtQ\ncxt = sequence\n\nderivClause :: Maybe DerivStrategyQ -> [PredQ] -> DerivClauseQ\nderivClause mds p = do mds' <- sequenceA mds\n                       p'   <- cxt p\n                       return $ DerivClause mds' p'\n\nstockStrategy :: DerivStrategyQ\nstockStrategy = pure StockStrategy\n\nanyclassStrategy :: DerivStrategyQ\nanyclassStrategy = pure AnyclassStrategy\n\nnewtypeStrategy :: DerivStrategyQ\nnewtypeStrategy = pure NewtypeStrategy\n\nviaStrategy :: TypeQ -> DerivStrategyQ\nviaStrategy = fmap ViaStrategy\n\nnormalC :: Name -> [BangTypeQ] -> ConQ\nnormalC con strtys = liftM (NormalC con) $ sequence strtys\n\nrecC :: Name -> [VarBangTypeQ] -> ConQ\nrecC con varstrtys = liftM (RecC con) $ sequence varstrtys\n\ninfixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ\ninfixC st1 con st2 = do st1' <- st1\n                        st2' <- st2\n                        return $ InfixC st1' con st2'\n\nforallC :: [TyVarBndrQ] -> CxtQ -> ConQ -> ConQ\nforallC ns ctxt con = do\n  ns'   <- sequenceA ns\n  ctxt' <- ctxt\n  con'  <- con\n  pure $ ForallC ns' ctxt' con'\n\ngadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ\ngadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty\n\nrecGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ\nrecGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty\n\n-------------------------------------------------------------------------------\n-- *   Type\n\nforallT :: [TyVarBndrQ] -> CxtQ -> TypeQ -> TypeQ\nforallT tvars ctxt ty = do\n    tvars1 <- sequenceA tvars\n    ctxt1  <- ctxt\n    ty1    <- ty\n    return $ ForallT tvars1 ctxt1 ty1\n\nforallVisT :: [TyVarBndrQ] -> TypeQ -> TypeQ\nforallVisT tvars ty = ForallVisT <$> sequenceA tvars <*> ty\n\nvarT :: Name -> TypeQ\nvarT = return . VarT\n\nconT :: Name -> TypeQ\nconT = return . ConT\n\ninfixT :: TypeQ -> Name -> TypeQ -> TypeQ\ninfixT t1 n t2 = do t1' <- t1\n                    t2' <- t2\n                    return (InfixT t1' n t2')\n\nuInfixT :: TypeQ -> Name -> TypeQ -> TypeQ\nuInfixT t1 n t2 = do t1' <- t1\n                     t2' <- t2\n                     return (UInfixT t1' n t2')\n\nparensT :: TypeQ -> TypeQ\nparensT t = do t' <- t\n               return (ParensT t')\n\nappT :: TypeQ -> TypeQ -> TypeQ\nappT t1 t2 = do\n           t1' <- t1\n           t2' <- t2\n           return $ AppT t1' t2'\n\nappKindT :: TypeQ -> KindQ -> TypeQ\nappKindT ty ki = do\n               ty' <- ty\n               ki' <- ki\n               return $ AppKindT ty' ki'\n\narrowT :: TypeQ\narrowT = return ArrowT\n\nlistT :: TypeQ\nlistT = return ListT\n\nlitT :: TyLitQ -> TypeQ\nlitT l = fmap LitT l\n\ntupleT :: Int -> TypeQ\ntupleT i = return (TupleT i)\n\nunboxedTupleT :: Int -> TypeQ\nunboxedTupleT i = return (UnboxedTupleT i)\n\nunboxedSumT :: SumArity -> TypeQ\nunboxedSumT arity = return (UnboxedSumT arity)\n\nsigT :: TypeQ -> KindQ -> TypeQ\nsigT t k\n  = do\n      t' <- t\n      k' <- k\n      return $ SigT t' k'\n\nequalityT :: TypeQ\nequalityT = return EqualityT\n\nwildCardT :: TypeQ\nwildCardT = return WildCardT\n\nimplicitParamT :: String -> TypeQ -> TypeQ\nimplicitParamT n t\n  = do\n      t' <- t\n      return $ ImplicitParamT n t'\n\n{-# DEPRECATED classP \"As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'.\" #-}\nclassP :: Name -> [Q Type] -> Q Pred\nclassP cla tys\n  = do\n      tysl <- sequence tys\n      return (foldl AppT (ConT cla) tysl)\n\n{-# DEPRECATED equalP \"As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'.\" #-}\nequalP :: TypeQ -> TypeQ -> PredQ\nequalP tleft tright\n  = do\n      tleft1  <- tleft\n      tright1 <- tright\n      eqT <- equalityT\n      return (foldl AppT eqT [tleft1, tright1])\n\npromotedT :: Name -> TypeQ\npromotedT = return . PromotedT\n\npromotedTupleT :: Int -> TypeQ\npromotedTupleT i = return (PromotedTupleT i)\n\npromotedNilT :: TypeQ\npromotedNilT = return PromotedNilT\n\npromotedConsT :: TypeQ\npromotedConsT = return PromotedConsT\n\nnoSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ\nnoSourceUnpackedness = return NoSourceUnpackedness\nsourceNoUnpack       = return SourceNoUnpack\nsourceUnpack         = return SourceUnpack\n\nnoSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ\nnoSourceStrictness = return NoSourceStrictness\nsourceLazy         = return SourceLazy\nsourceStrict       = return SourceStrict\n\n{-# DEPRECATED isStrict\n    [\"Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. \",\n     \"Example usage: 'bang noSourceUnpackedness sourceStrict'\"] #-}\n{-# DEPRECATED notStrict\n    [\"Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. \",\n     \"Example usage: 'bang noSourceUnpackedness noSourceStrictness'\"] #-}\n{-# DEPRECATED unpacked\n    [\"Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. \",\n     \"Example usage: 'bang sourceUnpack sourceStrict'\"] #-}\nisStrict, notStrict, unpacked :: Q Strict\nisStrict = bang noSourceUnpackedness sourceStrict\nnotStrict = bang noSourceUnpackedness noSourceStrictness\nunpacked = bang sourceUnpack sourceStrict\n\nbang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ\nbang u s = do u' <- u\n              s' <- s\n              return (Bang u' s')\n\nbangType :: BangQ -> TypeQ -> BangTypeQ\nbangType = liftM2 (,)\n\nvarBangType :: Name -> BangTypeQ -> VarBangTypeQ\nvarBangType v bt = do (b, t) <- bt\n                      return (v, b, t)\n\n{-# DEPRECATED strictType\n               \"As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead.\" #-}\nstrictType :: Q Strict -> TypeQ -> StrictTypeQ\nstrictType = bangType\n\n{-# DEPRECATED varStrictType\n               \"As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead.\" #-}\nvarStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ\nvarStrictType = varBangType\n\n-- * Type Literals\n\nnumTyLit :: Integer -> TyLitQ\nnumTyLit n = if n >= 0 then return (NumTyLit n)\n                       else fail (\"Negative type-level number: \" ++ show n)\n\nstrTyLit :: String -> TyLitQ\nstrTyLit s = return (StrTyLit s)\n\n-------------------------------------------------------------------------------\n-- *   Kind\n\nplainTV :: Name -> TyVarBndrQ\nplainTV = pure . PlainTV\n\nkindedTV :: Name -> KindQ -> TyVarBndrQ\nkindedTV n = fmap (KindedTV n)\n\nvarK :: Name -> Kind\nvarK = VarT\n\nconK :: Name -> Kind\nconK = ConT\n\ntupleK :: Int -> Kind\ntupleK = TupleT\n\narrowK :: Kind\narrowK = ArrowT\n\nlistK :: Kind\nlistK = ListT\n\nappK :: Kind -> Kind -> Kind\nappK = AppT\n\nstarK :: KindQ\nstarK = pure StarT\n\nconstraintK :: KindQ\nconstraintK = pure ConstraintT\n\n-------------------------------------------------------------------------------\n-- *   Type family result\n\nnoSig :: FamilyResultSigQ\nnoSig = pure NoSig\n\nkindSig :: KindQ -> FamilyResultSigQ\nkindSig = fmap KindSig\n\ntyVarSig :: TyVarBndrQ -> FamilyResultSigQ\ntyVarSig = fmap TyVarSig\n\n-------------------------------------------------------------------------------\n-- *   Injectivity annotation\n\ninjectivityAnn :: Name -> [Name] -> InjectivityAnn\ninjectivityAnn = TH.InjectivityAnn\n\n-------------------------------------------------------------------------------\n-- *   Role\n\nnominalR, representationalR, phantomR, inferR :: Role\nnominalR          = NominalR\nrepresentationalR = RepresentationalR\nphantomR          = PhantomR\ninferR            = InferR\n\n-------------------------------------------------------------------------------\n-- *   Callconv\n\ncCall, stdCall, cApi, prim, javaScript :: Callconv\ncCall      = CCall\nstdCall    = StdCall\ncApi       = CApi\nprim       = Prim\njavaScript = JavaScript\n\n-------------------------------------------------------------------------------\n-- *   Safety\n\nunsafe, safe, interruptible :: Safety\nunsafe = Unsafe\nsafe = Safe\ninterruptible = Interruptible\n\n-------------------------------------------------------------------------------\n-- *   FunDep\n\nfunDep :: [Name] -> [Name] -> FunDep\nfunDep = FunDep\n\n-------------------------------------------------------------------------------\n-- *   RuleBndr\nruleVar :: Name -> RuleBndrQ\nruleVar = return . RuleVar\n\ntypedRuleVar :: Name -> TypeQ -> RuleBndrQ\ntypedRuleVar n ty = ty >>= return . TypedRuleVar n\n\n-------------------------------------------------------------------------------\n-- *   AnnTarget\nvalueAnnotation :: Name -> AnnTarget\nvalueAnnotation = ValueAnnotation\n\ntypeAnnotation :: Name -> AnnTarget\ntypeAnnotation = TypeAnnotation\n\nmoduleAnnotation :: AnnTarget\nmoduleAnnotation = ModuleAnnotation\n\n-------------------------------------------------------------------------------\n-- * Pattern Synonyms (sub constructs)\n\nunidir, implBidir :: PatSynDirQ\nunidir    = return Unidir\nimplBidir = return ImplBidir\n\nexplBidir :: [ClauseQ] -> PatSynDirQ\nexplBidir cls = do\n  cls' <- sequence cls\n  return (ExplBidir cls')\n\nprefixPatSyn :: [Name] -> PatSynArgsQ\nprefixPatSyn args = return $ PrefixPatSyn args\n\nrecordPatSyn :: [Name] -> PatSynArgsQ\nrecordPatSyn sels = return $ RecordPatSyn sels\n\ninfixPatSyn :: Name -> Name -> PatSynArgsQ\ninfixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2\n\n--------------------------------------------------------------\n-- * Useful helper function\n\nappsE :: [ExpQ] -> ExpQ\nappsE [] = error \"appsE []\"\nappsE [x] = x\nappsE (x:y:zs) = appsE ( (appE x y) : zs )\n\n-- | Return the Module at the place of splicing.  Can be used as an\n-- input for 'reifyModule'.\nthisModule :: Q Module\nthisModule = do\n  loc <- location\n  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)\n", "num_lines": 942}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\n-- This is a non-exposed internal module\n--\n-- The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost\n-- verbatimely to avoid a dependency of 'template-haskell' on the containers package.\n--\n-- [1] see https://hackage.haskell.org/package/containers-0.5.5.1\n--\n-- The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.\n\nmodule Language.Haskell.TH.Lib.Map\n    ( Map\n    , empty\n    , insert\n    , Language.Haskell.TH.Lib.Map.lookup\n    ) where\n\nimport Prelude\n\ndata Map k a  = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)\n              | Tip\n\ntype Size     = Int\n\nempty :: Map k a\nempty = Tip\n{-# INLINE empty #-}\n\nsingleton :: k -> a -> Map k a\nsingleton k x = Bin 1 k x Tip Tip\n{-# INLINE singleton #-}\n\nsize :: Map k a -> Int\nsize Tip              = 0\nsize (Bin sz _ _ _ _) = sz\n{-# INLINE size #-}\n\nlookup :: Ord k => k -> Map k a -> Maybe a\nlookup = go\n  where\n    go _ Tip = Nothing\n    go !k (Bin _ kx x l r) = case compare k kx of\n      LT -> go k l\n      GT -> go k r\n      EQ -> Just x\n{-# INLINABLE lookup #-}\n\n\ninsert :: Ord k => k -> a -> Map k a -> Map k a\ninsert = go\n  where\n    go :: Ord k => k -> a -> Map k a -> Map k a\n    go !kx x Tip = singleton kx x\n    go !kx x (Bin sz ky y l r) =\n        case compare kx ky of\n            LT -> balanceL ky y (go kx x l) r\n            GT -> balanceR ky y l (go kx x r)\n            EQ -> Bin sz kx x l r\n{-# INLINABLE insert #-}\n\nbalanceL :: k -> a -> Map k a -> Map k a -> Map k a\nbalanceL k x l r = case r of\n  Tip -> case l of\n           Tip -> Bin 1 k x Tip Tip\n           (Bin _ _ _ Tip Tip) -> Bin 2 k x l Tip\n           (Bin _ lk lx Tip (Bin _ lrk lrx _ _)) -> Bin 3 lrk lrx (Bin 1 lk lx Tip Tip) (Bin 1 k x Tip Tip)\n           (Bin _ lk lx ll@(Bin _ _ _ _ _) Tip) -> Bin 3 lk lx ll (Bin 1 k x Tip Tip)\n           (Bin ls lk lx ll@(Bin lls _ _ _ _) lr@(Bin lrs lrk lrx lrl lrr))\n             | lrs < ratio*lls -> Bin (1+ls) lk lx ll (Bin (1+lrs) k x lr Tip)\n             | otherwise -> Bin (1+ls) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+size lrr) k x lrr Tip)\n\n  (Bin rs _ _ _ _) -> case l of\n           Tip -> Bin (1+rs) k x Tip r\n\n           (Bin ls lk lx ll lr)\n              | ls > delta*rs  -> case (ll, lr) of\n                   (Bin lls _ _ _ _, Bin lrs lrk lrx lrl lrr)\n                     | lrs < ratio*lls -> Bin (1+ls+rs) lk lx ll (Bin (1+rs+lrs) k x lr r)\n                     | otherwise -> Bin (1+ls+rs) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+rs+size lrr) k x lrr r)\n                   (_, _) -> error \"Failure in Data.Map.balanceL\"\n              | otherwise -> Bin (1+ls+rs) k x l r\n{-# NOINLINE balanceL #-}\n\nbalanceR :: k -> a -> Map k a -> Map k a -> Map k a\nbalanceR k x l r = case l of\n  Tip -> case r of\n           Tip -> Bin 1 k x Tip Tip\n           (Bin _ _ _ Tip Tip) -> Bin 2 k x Tip r\n           (Bin _ rk rx Tip rr@(Bin _ _ _ _ _)) -> Bin 3 rk rx (Bin 1 k x Tip Tip) rr\n           (Bin _ rk rx (Bin _ rlk rlx _ _) Tip) -> Bin 3 rlk rlx (Bin 1 k x Tip Tip) (Bin 1 rk rx Tip Tip)\n           (Bin rs rk rx rl@(Bin rls rlk rlx rll rlr) rr@(Bin rrs _ _ _ _))\n             | rls < ratio*rrs -> Bin (1+rs) rk rx (Bin (1+rls) k x Tip rl) rr\n             | otherwise -> Bin (1+rs) rlk rlx (Bin (1+size rll) k x Tip rll) (Bin (1+rrs+size rlr) rk rx rlr rr)\n\n  (Bin ls _ _ _ _) -> case r of\n           Tip -> Bin (1+ls) k x l Tip\n\n           (Bin rs rk rx rl rr)\n              | rs > delta*ls  -> case (rl, rr) of\n                   (Bin rls rlk rlx rll rlr, Bin rrs _ _ _ _)\n                     | rls < ratio*rrs -> Bin (1+ls+rs) rk rx (Bin (1+ls+rls) k x l rl) rr\n                     | otherwise -> Bin (1+ls+rs) rlk rlx (Bin (1+ls+size rll) k x l rll) (Bin (1+rrs+size rlr) rk rx rlr rr)\n                   (_, _) -> error \"Failure in Data.Map.balanceR\"\n              | otherwise -> Bin (1+ls+rs) k x l r\n{-# NOINLINE balanceR #-}\n\ndelta,ratio :: Int\ndelta = 3\nratio = 2\n", "num_lines": 111}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule Foo where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\nimport System.IO\n\n$( do u1 <- runQ (dataToExpQ (const Nothing) ())\n      u2 <- runQ [| () |]\n      runIO $ print (u1 == u2)\n      runIO $ hFlush stdout\n      return []\n )\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\nimport System.Process\nimport Data.Maybe\n\nmain = do\n  [ghc] <- getArgs\n\n  info <- readProcess ghc [\"+RTS\", \"--info\"] \"\"\n  let fields = read info :: [(String,String)]\n  getGhcFieldOrFail fields \"HostOS\" \"Host OS\"\n  getGhcFieldOrFail fields \"WORDSIZE\" \"Word size\"\n  getGhcFieldOrFail fields \"TARGETPLATFORM\" \"Target platform\"\n  getGhcFieldOrFail fields \"TargetOS_CPP\" \"Target OS\"\n  getGhcFieldOrFail fields \"TargetARCH_CPP\" \"Target architecture\"\n\n  info <- readProcess ghc [\"--info\"] \"\"\n  let fields = read info :: [(String,String)]\n\n  getGhcFieldOrFail fields \"GhcStage\" \"Stage\"\n  getGhcFieldOrFail fields \"GhcDebugged\" \"Debug on\"\n  getGhcFieldOrFail fields \"GhcWithNativeCodeGen\" \"Have native code generator\"\n  getGhcFieldOrFail fields \"GhcWithInterpreter\" \"Have interpreter\"\n  getGhcFieldOrFail fields \"GhcUnregisterised\" \"Unregisterised\"\n  getGhcFieldOrFail fields \"GhcWithSMP\" \"Support SMP\"\n  getGhcFieldOrFail fields \"GhcRTSWays\" \"RTS ways\"\n  getGhcFieldOrDefault fields \"GhcDynamicByDefault\" \"Dynamic by default\" \"NO\"\n  getGhcFieldOrDefault fields \"GhcDynamic\" \"GHC Dynamic\" \"NO\"\n  getGhcFieldOrDefault fields \"GhcProfiled\" \"GHC Profiled\" \"NO\"\n  getGhcFieldProgWithDefault fields \"AR\" \"ar command\" \"ar\"\n  getGhcFieldProgWithDefault fields \"CLANG\" \"LLVM clang command\" \"clang\"\n  getGhcFieldProgWithDefault fields \"LLC\" \"LLVM llc command\" \"llc\"\n  getGhcFieldProgWithDefault fields \"TEST_CC\" \"C compiler command\" \"gcc\"\n\n  let pkgdb_flag = case lookup \"Project version\" fields of\n        Just v\n          | parseVersion v >= [7,5] -> \"package-db\"\n        _ -> \"package-conf\"\n  putStrLn $ \"GhcPackageDbFlag\" ++ '=':pkgdb_flag\n\n  let minGhcVersion711 = case lookup \"Project version\" fields of\n        Just v\n          | parseVersion v >= [7,11] -> \"YES\"\n        _ -> \"NO\"\n  putStrLn $ \"MinGhcVersion711\" ++ '=':minGhcVersion711\n\n  let minGhcVersion801 = case lookup \"Project version\" fields of\n        Just v\n          | parseVersion v >= [8,1] -> \"YES\"\n        _ -> \"NO\"\n  putStrLn $ \"MinGhcVersion801\" ++ '=':minGhcVersion801\n\n\ngetGhcFieldOrFail :: [(String,String)] -> String -> String -> IO ()\ngetGhcFieldOrFail fields mkvar key\n   = getGhcField fields mkvar key id (fail (\"No field: \" ++ key))\n\ngetGhcFieldOrDefault :: [(String,String)] -> String -> String -> String -> IO ()\ngetGhcFieldOrDefault fields mkvar key deflt\n  = getGhcField fields mkvar key id on_fail\n  where\n    on_fail = putStrLn (mkvar ++ '=' : deflt)\n\ngetGhcFieldProgWithDefault\n   :: [(String,String)]\n   -> String -> String -> String\n   -> IO ()\ngetGhcFieldProgWithDefault fields mkvar key deflt\n  = getGhcField fields mkvar key fix on_fail\n  where\n    fix val = fixSlashes (fixTopdir topdir val)\n    topdir = fromMaybe \"\" (lookup \"LibDir\" fields)\n    on_fail = putStrLn (mkvar ++ '=' : deflt)\n\ngetGhcField\n   :: [(String,String)] -> String -> String\n   -> (String -> String)\n   -> IO ()\n   -> IO ()\ngetGhcField fields mkvar key fix on_fail =\n   case lookup key fields of\n      Nothing  -> on_fail\n      Just val -> putStrLn (mkvar ++ '=' : fix val)\n\nfixTopdir :: String -> String -> String\nfixTopdir t \"\" = \"\"\nfixTopdir t ('$':'t':'o':'p':'d':'i':'r':s) = t ++ s\nfixTopdir t (c:s) = c : fixTopdir t s\n\nfixSlashes :: FilePath -> FilePath\nfixSlashes = map f\n    where f '\\\\' = '/'\n          f c    = c\n\nparseVersion :: String -> [Int]\nparseVersion v = case break (== '.') v of\n  (n, rest) -> read n : case rest of\n    [] -> []\n    ('.':v') -> parseVersion v'\n    _ -> error \"bug in parseVersion\"\n", "num_lines": 100}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, ApplicativeDo #-}\n{-# OPTIONS_GHC -foptimal-applicative-do #-}\nmodule Main where\n\nimport Control.Applicative\nimport Text.PrettyPrint as PP\n\n(a:b:c:d:e:f:g:h:_) = map (\\c -> doc [c]) ['a'..]\n\n-- This one requires -foptimal-applicative-do to find the best solution\n-- ((a; b) | (c; d)); e\ntest1 :: M ()\ntest1 = do\n  x1 <- a\n  x2 <- const b x1\n  x3 <- c\n  x4 <- const d x3\n  x5 <- const e (x1,x4)\n  return (const () x5)\n\n-- (a | c); (b | d); e\ntest2 :: M ()\ntest2 = do\n  x1 <- a\n  x3 <- c\n  x2 <- const b x1\n  x4 <- const d x3\n  x5 <- const e (x1,x4)\n  return (const () x5)\n\nmain = mapM_ run\n [ test1\n , test2\n ]\n\n-- Testing code, prints out the structure of a monad/applicative expression\n\nnewtype M a = M (Bool -> (Maybe Doc, a))\n\nmaybeParen True d = parens d\nmaybeParen _ d = d\n\nrun :: M a -> IO ()\nrun (M m) = print d where (Just d,_) = m False\n\ninstance Functor M where\n  fmap f m = m >>= return . f\n\ninstance Applicative M where\n  pure a = M $ \\_ -> (Nothing, a)\n  M f <*> M a = M $ \\p ->\n    let (Just d1, f') = f True\n        (Just d2, a') = a True\n    in\n        (Just (maybeParen p (d1 <+> char '|' <+> d2)), f' a')\n\ninstance Monad M where\n  return = pure\n  M m >>= k = M $ \\p ->\n    let (d1, a) = m True\n        (d2, b) = case k a of M f -> f True\n    in\n    case (d1,d2) of\n      (Nothing,Nothing) -> (Nothing, b)\n      (Just d, Nothing) -> (Just d, b)\n      (Nothing, Just d) -> (Just d, b)\n      (Just d1, Just d2) -> (Just (maybeParen p (d1 PP.<> semi <+> d2)), b)\n\ndoc :: String -> M ()\ndoc d = M $ \\_ -> (Just (text d), ())\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, ApplicativeDo #-}\nmodule Main where\n\nimport Control.Applicative\nimport Text.PrettyPrint as PP\n\n(a:b:c:d:e:f:g:h:_) = map (\\c -> doc [c]) ['a'..]\n\n-- a | b\ntest1 :: M ()\ntest1 = do\n  x1 <- a\n  x2 <- b\n  const (return ()) (x1,x2)\n\n-- no parallelism\ntest2 :: M ()\ntest2 = do\n  x1 <- a\n  x2 <- const g x1\n  const (return ()) (x1,x2)\n\n-- a | (b;g) | e\ntest3 :: M ()\ntest3 = do\n  x1 <- a\n  x2 <- b\n  x3 <- const g x2\n  x4 <- e\n  return () `const` (x1,x2,x3,x4)\n\n-- (a ; (b | g)) | c\n-- or\n-- ((a | b); g) | c\ntest4 :: M ()\ntest4 = do\n  x1 <- a\n  x2 <- b\n  x3 <- const g x1\n  x4 <- c\n  return () `const` (x2,x3,x4)\n\n-- (a | b | c); (g | h)\ntest5 :: M ()\ntest5 = do\n  x1 <- a\n  x2 <- b\n  x3 <- c\n  x4 <- const g x1\n  x5 <- const h x3\n  return () `const` (x3,x4,x5)\n\n-- b/c in parallel, e/f in parallel\n-- a; (b | (c; (d; (e | (f; g)))))\ntest6 :: M ()\ntest6 = do\n  x1 <- a\n  x2 <- const b x1\n  x3 <- const c x1\n  x4 <- const d x3\n  x5 <- const e x4\n  x6 <- const f x4\n  x7 <- const g x6\n  return () `const` (x1,x2,x3,x4,x5,x6,x7)\n\n-- (a | b); (c | d)\ntest7 :: M ()\ntest7 = do\n  x1 <- a\n  x2 <- b\n  x3 <- const c x1\n  x4 <- const d x2\n  return () `const` (x3,x4)\n\n-- a; (b | c | d)\n--\n-- alternative (but less good):\n-- ((a;b) | c); d\ntest8 :: M ()\ntest8 = do\n  x1 <- a\n  x2 <- const b x1\n  x3 <- c\n  x4 <- const d x1\n  return () `const` (x2,x3,x4)\n\n-- test that Lets don't get in the way\n-- ((a | (b; c)) | d) | e\ntest9 :: M ()\ntest9 = do\n  x1 <- a\n  let x = doc \"x\"  -- this shouldn't get in the way of grouping a/b\n  x2 <- b\n  x3 <- const c x2\n  x4 <- d\n  x5 <- e\n  let y = doc \"y\"\n  return ()\n\n-- ((a | b) ; (c | d)) | e\ntest10 :: M ()\ntest10 = do\n  x1 <- a\n  x2 <- b\n  let z1 = (x1,x2)\n  x3 <- const c x1\n  let z2 = (x1,x2)\n  x4 <- const d z1\n  x5 <- e\n  return (const () (x3,x4,x5))\n\n-- (a | b)\n-- This demonstrated a bug in RnExpr.segments (#11612)\ntest11 :: M ()\ntest11 = do\n  x1 <- a\n  let x2 = x1\n  x3 <- b\n  let x4 = c\n      x5 = x4\n  return (const () (x1,x2,x3,x4))\n\n-- (a | (b ; c))\n-- The strict pattern match forces (b;c), but a can still be parallel (#13875)\ntest12 :: M ()\ntest12 = do\n  x1 <- a\n  () <- b\n  x2 <- c\n  return (const () (x1,x2))\n\nmain = mapM_ run\n [ test1\n , test2\n , test3\n , test4\n , test5\n , test6\n , test7\n , test8\n , test9\n , test10\n , test11\n , test12\n ]\n\n-- Testing code, prints out the structure of a monad/applicative expression\n\nnewtype M a = M (Bool -> (Maybe Doc, a))\n\nmaybeParen True d = parens d\nmaybeParen _ d = d\n\nrun :: M a -> IO ()\nrun (M m) = print d where (Just d,_) = m False\n\ninstance Functor M where\n  fmap f m = m >>= return . f\n\ninstance Applicative M where\n  pure a = M $ \\_ -> (Nothing, a)\n  M f <*> M a = M $ \\p ->\n    let (Just d1, f') = f True\n        (Just d2, a') = a True\n    in\n        (Just (maybeParen p (d1 <+> char '|' <+> d2)), f' a')\n\ninstance Monad M where\n  return = pure\n  M m >>= k = M $ \\p ->\n    let (d1, a) = m True\n        (d2, b) = case k a of M f -> f True\n    in\n    case (d1,d2) of\n      (Nothing,Nothing) -> (Nothing, b)\n      (Just d, Nothing) -> (Just d, b)\n      (Nothing, Just d) -> (Just d, b)\n      (Just d1, Just d2) -> (Just (maybeParen p (d1 PP.<> semi <+> d2)), b)\n\ndoc :: String -> M ()\ndoc d = M $ \\_ -> (Just (text d), ())\n", "num_lines": 182}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo,ScopedTypeVariables #-}\nmodule Test where\n\n-- Test that type errors aren't affected by ApplicativeDo\nf :: IO Int\nf = do\n  x <- getChar\n  y <- getChar 'a' -- type error\n  print (x,y)\n\ng :: IO (Int,Int)\ng = do\n  x <- getChar\n  y <- getChar\n  return (y,x)\n\nh :: IO (Int,Int)\nh = do\n  x1 <- getChar\n  x2 <- getChar\n  x3 <- const (return ()) x1\n  x4 <- getChar\n  x5 <- getChar x4\n  return (x2,x4)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\nmodule ShouldFail where\n\ng :: IO ()\ng = do\n  x <- getChar\n  'a' <- return (3::Int) -- type error\n  return ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# OPTIONS_GHC -ddump-types #-}\nmodule Test where\n\n-- This is a do expression that typechecks with only an Applicative constraint\ntest1 :: Applicative f => (Int -> f Int) -> f Int\ntest1 f = do\n  x <- f 3\n  y <- f 4\n  return (x + y)\n\n-- The same using $\ntest1a :: Applicative f => (Int -> f Int) -> f Int\ntest1a f = do\n  x <- f 3\n  y <- f 4\n  return $ x + y\n\n-- When one of the statements is a BodyStmt\ntest1b :: Applicative f => (Int -> f Int) -> f Int\ntest1b f = do\n  x <- f 3\n  f 4\n  return x\n\ntest1c :: Applicative f => (Int -> f Int) -> f Int\ntest1c f = do\n  f 3\n  x <- f 4\n  return x\n\n-- Test we can also infer the Applicative version of the type\ntest2 f = do\n  x <- f 3\n  y <- f 4\n  return (x + y)\n\n-- Test we can also infer the Functor version of the type\ntest2a f = do\n  x <- f 3\n  return (x + 1)\n\n-- The same using $\ntest2c f = do\n  x <- f 3\n  return $ x + 1\n\n-- with a BodyStmt\ntest2d f = do\n  f 3\n  return 4\n\n-- Test for just one statement\ntest2b f = do\n  return (f 3)\n\n-- This one will use join\ntest3 f g = do\n  x <- f 3\n  y <- f 4\n  g y x\n\n-- This one needs a tuple\ntest4 f g = do\n  x <- f 3\n  y <- f 4\n  let r = g y x\n  r\n\n-- This one used to need a big tuple, now it compiles to ApplicativeLastStmt\ntest5 f g = do\n  x01 <- f 01\n  x02 <- f 02\n  x03 <- f 03\n  x04 <- f 04\n  x05 <- f 05\n  x06 <- f 06\n  x07 <- f 07\n  x08 <- f 08\n  x09 <- f 09\n  x11 <- f 11\n  x12 <- f 12\n  x13 <- f 13\n  x14 <- f 14\n  x15 <- f 15\n  x16 <- f 16\n  x17 <- f 17\n  x18 <- f 18\n  x19 <- f 19\n  x20 <- f 20\n  x21 <- f 21\n  x22 <- f 22\n  x23 <- f 23\n  x24 <- f 24\n  x25 <- f 25\n  x26 <- f 26\n  x27 <- f 27\n  x28 <- f 28\n  x29 <- f 29\n  x30 <- f 30\n  x31 <- f 31\n  x32 <- f 32\n  x33 <- f 33\n  x34 <- f 34\n  x35 <- f 35\n  x36 <- f 36\n  x37 <- f 37\n  x38 <- f 38\n  x39 <- f 39\n  x40 <- f 40\n  x41 <- f 41\n  x42 <- f 42\n  x43 <- f 43\n  x44 <- f 44\n  x45 <- f 45\n  x46 <- f 46\n  x47 <- f 47\n  x48 <- f 48\n  x49 <- f 49\n  x50 <- f 50\n  x51 <- f 51\n  x52 <- f 52\n  x53 <- f 53\n  x54 <- f 54\n  x55 <- f 55\n  x56 <- f 56\n  x57 <- f 57\n  x58 <- f 58\n  x59 <- f 59\n  x60 <- f 60\n  x61 <- f 61\n  x62 <- f 62\n  x63 <- f 63\n  x64 <- f 64\n  x65 <- f 65\n  x66 <- f 66\n  x67 <- f 67\n  x68 <- f 68\n  x69 <- f 69\n  x70 <- f 70\n  let r = g x70 x01\n  r\n\n-- This one needs a big tuple\ntest6 f g = do\n  x01 <- f 01\n  x02 <- f 02\n  x03 <- f 03\n  x04 <- f 04\n  x05 <- f 05\n  x06 <- f 06\n  x07 <- f 07\n  x08 <- f 08\n  x09 <- f 09\n  x11 <- f 11\n  x12 <- f 12\n  x13 <- f 13\n  x14 <- f 14\n  x15 <- f 15\n  x16 <- f 16\n  x17 <- f 17\n  x18 <- f 18\n  x19 <- f 19\n  x20 <- f 20\n  x21 <- f 21\n  x22 <- f 22\n  x23 <- f 23\n  x24 <- f 24\n  x25 <- f 25\n  x26 <- f 26\n  x27 <- f 27\n  x28 <- f 28\n  x29 <- f 29\n  x30 <- f 30\n  x31 <- f 31\n  x32 <- f 32\n  x33 <- f 33\n  x34 <- f 34\n  x35 <- f 35\n  x36 <- f 36\n  x37 <- f 37\n  x38 <- f 38\n  x39 <- f 39\n  x40 <- f 40\n  x41 <- f 41\n  x42 <- f 42\n  x43 <- f 43\n  x44 <- f 44\n  x45 <- f 45\n  x46 <- f 46\n  x47 <- f 47\n  x48 <- f 48\n  x49 <- f 49\n  x50 <- f 50\n  x51 <- f 51\n  x52 <- f 52\n  x53 <- f 53\n  x54 <- f 54\n  x55 <- f 55\n  x56 <- f 56\n  x57 <- f 57\n  x58 <- f 58\n  x59 <- f 59\n  x60 <- f 60\n  x61 <- f 61\n  x62 <- f 62\n  x63 <- f 63\n  x64 <- f 64\n  x65 <- f 65\n  x66 <- f 66\n  x67 <- f 67\n  x68 <- f 68\n  x69 <- f 69\n  x70 <- f x01\n  x71 <- f 70\n  x71 `const`\n   [ x01\n   , x02\n   , x03\n   , x04\n   , x05\n   , x06\n   , x07\n   , x08\n   , x09\n   , x11\n   , x12\n   , x13\n   , x14\n   , x15\n   , x16\n   , x17\n   , x18\n   , x19\n   , x20\n   , x21\n   , x22\n   , x23\n   , x24\n   , x25\n   , x26\n   , x27\n   , x28\n   , x29\n   , x30\n   , x31\n   , x32\n   , x33\n   , x34\n   , x35\n   , x36\n   , x37\n   , x38\n   , x39\n   , x40\n   , x41\n   , x42\n   , x43\n   , x44\n   , x45\n   , x46\n   , x47\n   , x48\n   , x49\n   , x50\n   , x51\n   , x52\n   , x53\n   , x54\n   , x55\n   , x56\n   , x57\n   , x58\n   , x59\n   , x60\n   , x61\n   , x62\n   , x63\n   , x64\n   , x65\n   , x66\n   , x67\n   , x68\n   , x69\n   , x70\n   , x71 ]\n", "num_lines": 287}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# OPTIONS_GHC -ddump-types #-}\nmodule Test where\n\n-- This should fail to typecheck because it needs Monad\ntest :: Applicative f => (Int -> f Int) -> f Int\ntest f = do\n  x <- f 3\n  y <- f x\n  return (x + y)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\nmodule Test where\n\n-- This exposed a bug in zonking ApplicativeLastStmt\ntest :: IO Int\ntest\n  = do\n      x <- return ()\n      h <- return (\\_ -> 3)\n      return (h ())\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# LANGUAGE RebindableSyntax #-}\nmodule Test where\n\nimport Control.Applicative\nimport Control.Monad\nimport Prelude\n\n-- Caused a -dcore-lint failure with an earlier version of\n-- ApplicativeDo due to the polymorphic let binding.\ntest :: IO [Char]\ntest = do\n  x <- return 'a'\n  y <- return 'b'\n  let f | y == 'c' = id | otherwise = id\n  return (map f [])\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nnewtype MaybeA a = MaybeA (Maybe a)\n                 deriving (Show, Functor, Applicative)\n\nmain :: IO ()\nmain = print $ do\n    x <- MaybeA $ Just 42\n    pure x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\n{-# LANGUAGE ApplicativeDo #-}\n\nmodule T12490 where\n\nimport Prelude (Int, String, Functor(..), ($), undefined, (+))\n\njoin :: Monad f => f (f a) -> f a\njoin = undefined\n\nclass Functor f => Applicative f where\n    pure :: a -> f a\n    (<*>) :: f (a -> b) -> f a -> f b\n\nclass Applicative f => Monad f where\n    return :: a -> f a\n    (>>=) :: f a -> (a -> f b) -> f b\n    fail :: String -> f a\n\nf_app :: Applicative f => f Int -> f Int -> f Int\nf_app a b = do\n    a' <- a\n    b' <- b\n    pure (a' + b')\n\nf_monad :: Monad f => f Int -> f Int -> f Int\nf_monad a b = do\n    a' <- a\n    b' <- b\n    return $ a' + b'\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs #-}\nmodule T13242 where\n\nimport Data.STRef\nimport Control.Monad.ST\n\ndata A = forall a. A a\n\nst :: ST s ()\nst = do\n      A _ <- pure $ A True\n      ref <- newSTRef 1\n      readSTRef ref\n      pure ()\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs #-}\nmodule T13242a where\n\ndata T where A :: forall a . Eq a => a -> T\n\ntest :: IO Bool\ntest = do\n  A x <- undefined\n  _ <- return 'a'\n  _ <- return 'b'\n  return (x == x)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\nmodule Main where\n\nimport Control.Exception\nimport Control.Monad\nimport Data.Maybe\nimport System.Exit\n\ntest0 :: Maybe ()\ntest0 = do\n  () <- Just undefined\n  () <- Just undefined\n  return ()\n\ntest1 :: Maybe ()\ntest1 = do\n  (_,_) <- Just undefined\n  return ()\n\ntest2 :: Maybe (Int,Int)\ntest2 = do\n  x <- return 1\n  () <- Just undefined\n  y <- return 2\n  return (x,y)\n\nmain = do\n  b <- (print (isJust test0) >> return True)\n   `catch` \\ErrorCall{} -> return False\n  when b $ die \"failed0\"\n  b <- (print (isJust test1) >> return True)\n   `catch` \\ErrorCall{} -> return False\n  when b $ die \"failed1\"\n  b <- (print (isJust test2) >> return True)\n   `catch` \\ErrorCall{} -> return False\n  when b $ die \"failed2\"\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language ApplicativeDo #-}\n\nimport GHC.Exts\n\nreadIt :: IO (Int, Int)\nreadIt = readLn\n\nmain :: IO ()\nmain = do\n  (_, _) <- readIt\n  (_, _) <- readIt\n  (_, _) <- readIt\n  print \"Done\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Ann01 where\n\n{-# ANN module (1 :: Int) #-}\n{-# ANN module (1 :: Integer) #-}\n{-# ANN module (1 :: Double) #-}\n{-# ANN module $([| 1 :: Int |]) #-}\n{-# ANN module \"Hello\" #-}\n{-# ANN module (Just (1 :: Int)) #-}\n{-# ANN module [1 :: Int, 2, 3] #-}\n{-# ANN module ([1..10] :: [Integer]) #-}\n{-# ANN module ''Foo #-}\n{-# ANN module (-1 :: Int) #-}\n\n{-# ANN type Foo (1 :: Int) #-}\n{-# ANN type Foo (1 :: Integer) #-}\n{-# ANN type Foo (1 :: Double) #-}\n{-# ANN type Foo $([| 1 :: Int |]) #-}\n{-# ANN type Foo \"Hello\" #-}\n{-# ANN type Foo (Just (1 :: Int)) #-}\n{-# ANN type Foo [1 :: Int, 2, 3] #-}\n{-# ANN type Foo ([1..10] :: [Integer]) #-}\n{-# ANN type Foo ''Foo #-}\n{-# ANN type Foo (-1 :: Int) #-}\ndata Foo = Bar Int\n\n{-# ANN f (1 :: Int) #-}\n{-# ANN f (1 :: Integer) #-}\n{-# ANN f (1 :: Double) #-}\n{-# ANN f $([| 1 :: Int |]) #-}\n{-# ANN f \"Hello\" #-}\n{-# ANN f (Just (1 :: Int)) #-}\n{-# ANN f [1 :: Int, 2, 3] #-}\n{-# ANN f ([1..10] :: [Integer]) #-}\n{-# ANN f 'f #-}\n{-# ANN f (-1 :: Int) #-}\nf x = x\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14129 where\n\n{-# ANN module \"KABOOM\" #-}\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nmodule A where\n\nimport Data.Typeable\nimport Data.Data\n\ndata FromA = FromA\n  deriving (Typeable, Data)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport A\n\n{-# ANN module FromA #-}\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module AnnHelper where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\ntraverseModuleAnnotations :: Q [String]\ntraverseModuleAnnotations = do\n  ModuleInfo children <- reifyModule =<< thisModule\n  go children [] []\n  where\n    go []     _visited acc = return acc\n    go (x:xs) visited  acc | x `elem` visited = go xs visited acc\n                           | otherwise = do\n                             ModuleInfo newMods <- reifyModule x\n                             newAnns <- reifyAnnotations $ AnnLookupModule x\n                             go (newMods ++ xs) (x:visited) (newAnns ++ acc)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\nimport AnnHelper\nimport TestModule\nimport TestModuleTH\nimport System.IO\n\nmain = do\n  $(do\n    anns <- traverseModuleAnnotations\n    runIO $ print (anns :: [String])\n    anns <- reifyAnnotations (AnnLookupName 'testValue)\n    runIO $ print (anns :: [String])\n    anns <- reifyAnnotations (AnnLookupName 'testValueTH)\n    runIO $ print (anns :: [String])\n    anns <- reifyAnnotations (AnnLookupName ''TestType)\n    runIO $ print (anns :: [String])\n    anns <- reifyAnnotations (AnnLookupName ''TestTypeTH)\n    runIO $ print (anns :: [String])\n    anns <- reifyAnnotations (AnnLookupName 'TestType)\n    runIO $ print (anns :: [String])\n    anns <- reifyAnnotations (AnnLookupName 'TestTypeTH)\n    runIO $ print (anns :: [String])\n    [| return () |] )\n  hFlush stdout\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TestModule where\n\n{-# ANN module \"Module annotation\" #-}\n\n{-# ANN type TestType \"Type annotation\" #-}\n{-# ANN TestType \"Constructor annotation\" #-}\ndata TestType = TestType\n\n{-# ANN testValue \"Value annotation\" #-}\ntestValue :: Int\ntestValue = 42\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule TestModuleTH where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax (addTopDecls)\n\n$(do\n     modAnn <- pragAnnD ModuleAnnotation\n                        (stringE \"TH module annotation\")\n     modAnn' <- pragAnnD ModuleAnnotation\n                         (stringE \"addTopDecls module annotation\")\n     [typ] <- [d| data TestTypeTH = TestTypeTH |]\n     conAnn <- pragAnnD (ValueAnnotation $ mkName \"TestTypeTH\")\n                        (stringE \"TH Constructor annotation\")\n     conAnn' <- pragAnnD (ValueAnnotation $ mkName \"TestTypeTH\")\n                         (stringE \"addTopDecls Constructor annotation\")\n     typAnn <- pragAnnD (TypeAnnotation $ mkName \"TestTypeTH\")\n                        (stringE \"TH Type annotation\")\n     typAnn' <- pragAnnD (TypeAnnotation $ mkName \"TestTypeTH\")\n                         (stringE \"addTopDecls Type annotation\")\n     valAnn <- pragAnnD (ValueAnnotation $ mkName \"testValueTH\")\n                        (stringE \"TH Value annotation\")\n     valAnn' <- pragAnnD (ValueAnnotation $ mkName \"testValueTH\")\n                         (stringE \"addTopDecls value annotation\")\n     [val] <- [d| testValueTH = (42 :: Int) |]\n     addTopDecls [modAnn', conAnn', typAnn', valAnn']\n     return [modAnn, conAnn, typAnn, typ, valAnn, val] )\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail01 where\n-- Testing annotating things that don't exist\n\n{-# ANN type Foo (1 :: Int) #-}\n{-# ANN f (1 :: Int) #-}", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail02 where\n-- Testing annotating things that don't exist in the right namespace\n\ndata Foo = Bar\n\n{-# ANN Foo (1 :: Int) #-}\n{-# ANN type Bar (2 :: Int) #-}", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule Annfail03 where\n-- Testing annotating something with a value defined + Typeabled / Dataed in same module\n\nimport Data.Data\nimport Data.Typeable\n\ndata InModule = InModule\n              deriving (Typeable, Data)\n\n{-# ANN module InModule #-}\n\n{-# ANN type Foo InModule #-}\ndata Foo = Bar\n\n{-# ANN f InModule #-}\nf x = x", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail04 where\n\nimport Annfail04_Help\n-- Testing that we detect the use of instances defined in the same module\n\ninstance Thing Int where\n  thing = 1\n\n{-# ANN module (thing :: Int) #-}\n\n{-# ANN type Foo (thing :: Int) #-}\ndata Foo = Bar\n\n{-# ANN f (thing :: Int) #-}\nf x = x", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail04_Help where\n\nclass Thing a where\n  thing :: a", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail05 where\n\nimport Annfail05_Help\n-- Testing annotating with a value that is not Typeable or Data-able\n\n{-# ANN module NoInstances #-}\n\n{-# ANN type Foo NoInstances #-}\ndata Foo = Bar\n\n{-# ANN f NoInstances #-}\nf x = x", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail05_Help where\n\ndata NoInstances = NoInstances", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}\n\nmodule Annfail06 where\n-- Testing that we don't accept Typeable or Data instances defined in the same module\n\nimport Annfail06_Help\n\nimport Data.Data\nimport Data.Typeable\n\nderiving instance Typeable InstancesInWrongModule\n\ninstance Data InstancesInWrongModule where\n    gfoldl = undefined\n    gunfold = undefined\n\n{-# ANN module InstancesInWrongModule #-}\n\n{-# ANN type Foo InstancesInWrongModule #-}\ndata Foo = Bar\n\n{-# ANN f InstancesInWrongModule #-}\nf x = x", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail06_Help where\n\ndata InstancesInWrongModule = InstancesInWrongModule", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail07 where\n-- Testing normal type errors in annotations\n\n{-# ANN module (head True) #-}\n\n{-# ANN type Foo (head True) #-}\ndata Foo = Bar\n\n{-# ANN f (head True) #-}\nf x = x", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail08 where\n-- Testing instance type errors in annotations\n\n{-# ANN module (id + 1) #-}\n\n{-# ANN type Foo (id + 1) #-}\ndata Foo = Bar\n\n{-# ANN f (id + 1) #-}\nf x = x", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail09 where\n-- Testing that we detect references to ids defined in module being compiled in annotations\n\ng = 10\n\n{-# ANN module g #-}\n\n{-# ANN type Foo g #-}\ndata Foo = Bar\n\n{-# ANN f g #-}\nf x = x", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail10 where\n-- Testing ambiguity in annotations\n\n{-# ANN module 1 #-}\n\n{-# ANN type Foo 1 #-}\ndata Foo = Bar\n\n{-# ANN f 1 #-}\nf x = x", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail11 where\n\n{-# ANN length \"Cannot annotate other modules yet\" #-}\n{-# ANN type Integer \"Cannot annotate other modules yet\" #-}", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail12 where\n\n-- Testing errors hidden in annotations\n\n{-# ANN f (error \"You were meant to see this error!\" :: Int) #-}\nf x = x", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Annfail13 where\n-- Testing that brackets are mandatory in the ANN syntax\n\n{-# ANN f id 1 #-}\n{-# ANN f 1 :: Int #-}\nf x = x", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Test (hook) where\n\nimport System.IO.Unsafe\n\n{-# ANN hook (unsafePerformIO (putStrLn \"Woops.\")) #-}\nhook = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Main where\n\nimport GHC\nimport MonadUtils  ( liftIO )\nimport Data.Maybe\nimport DynFlags    ( defaultFatalMessager, defaultFlushOut )\nimport Annotations ( AnnTarget(..), CoreAnnTarget )\nimport GHC.Serialized  ( deserializeWithData )\nimport Panic\n\nimport Config\nimport Annrun01_Help\n\nimport qualified Language.Haskell.TH as TH\nimport Data.List\nimport Data.Function\n\nmain :: IO ()\nmain = defaultErrorHandler defaultFatalMessager defaultFlushOut\n     $ runGhc (Just cTop) $ do\n    liftIO $ putStrLn \"Initializing Package Database\"\n    dflags <- getSessionDynFlags\n    let dflags' = dflags\n    setSessionDynFlags dflags'\n\n    let mod_nm = mkModuleName \"Annrun01_Help\"\n\n    liftIO $ putStrLn \"Setting Target\"\n    setTargets [Target (TargetModule mod_nm) True Nothing]\n    liftIO $ putStrLn \"Loading Targets\"\n    load LoadAllTargets\n\n    liftIO $ putStrLn \"Finding Module\"\n    mod <- findModule mod_nm Nothing\n    liftIO $ putStrLn \"Getting Module Info\"\n    mod_info <- fromJust <$> getModuleInfo mod\n\n    liftIO $ putStrLn \"Showing Details For Module\"\n    showTargetAnns (ModuleTarget mod)\n    liftIO $ putStrLn \"Showing Details For Exports\"\n    let exports = sortBy (compare `on` getOccName) $ modInfoExports mod_info\n    mapM_ (showTargetAnns . NamedTarget) exports\n\nshowTargetAnns :: CoreAnnTarget -> Ghc ()\nshowTargetAnns target = do\n    (int_anns     :: [Int])        <- findGlobalAnns deserializeWithData target\n    (mb_bool_anns :: [Maybe Bool]) <- findGlobalAnns deserializeWithData target\n    (string_anns  :: [String])     <- findGlobalAnns deserializeWithData target\n    (name_anns    :: [TH.Name])    <- findGlobalAnns deserializeWithData target\n    liftIO $ print (int_anns, mb_bool_anns, string_anns, name_anns)\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Annrun01_Help where\n\n{-# ANN module \"Module\" #-}\n{-# ANN module \"Annotations\" #-}\n{-# ANN module (10 :: Int) #-}\n{-# ANN module \"Rock!!!!\" #-}\n\n\n{-# ANN foo \"Hello\" #-}\n{-# ANN foo \"World!\" #-}\n{-# ANN bar 'foo #-}\nfoo = \"Never seen\"\n\n{-# ANN bar \"Hello World Again!\" #-}\n{-# ANN bar (1 :: Int) #-}\n{-# ANN bar 'bar #-}\nbar = \"Also never seen\"\n\nbaz = \"Especially never seen\"\n\n\n{-# ANN type Baz \"Type Annotation\" #-}\n{-# ANN type Baz (Just True) #-}\n{-# ANN type Baz ''Baz #-}\ndata Baz = Spqr", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F0 where\n\nf0 :: Int -> Int -> Int -> Int\nf0 x y = if (x>0) then let v = x + y\n                       in \\z -> v+z\n                  else \\z-> 1\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F1 where\n\nf1 = let h1 n x = if x<n then let v = h1 n (x+1)\n                              in \\y -> v (x+y)\n                         else \\y -> y\n     in h1 5 1 5\n\ng = \\x1-> \\x2-> \\x3-> \\x4-> \\x5-> x1+x2+x3+x4+x5\ns f = f 3\nh = s g 6 7 8\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F10 where\n\nf10f = \\h -> (h 1 2, h 3)\nf10g = \\x -> \\y -> x+y\nf10h = f10f f10g\nf10x1 = fst f10h\nf10x2 = snd f10h\nf10 = f10x2 f10x1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F11 where\n\nfib 0 = 1\nfib 1 = 1\nfib n = fib (n-1) + fib (n-2)\n\nf11f = \\z -> let x = fib 1000\n             in \\y -> x+y\n\nf11 = (f11f 5 6, f11f 7 8)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F12 where\n\nf12 = let f g x = g x\n          h = (+)\n      in f h 4 5\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F13 where\n\nf13 x y = let f13f = if (x>0) then \\z -> z x y\n                                else \\z -> y\n              f13h = let v = f13f 5\n                     in \\w -> w + v\n          in \\u -> f13h u\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F14 where\n\nf14 n x = if x<n then let v = f14 n (x+1)\n                      in \\y -> v (x+y)\n               else \\y -> y\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F15 where\n\nf15f = \\h -> h 1\nf15g = \\x -> x+1\nf15 = f15f f15g\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F2 where\n\nf2f = \\h -> \\x -> h x 0\nf2 = let g = \\x -> \\y -> if (x > 0)\n                                then g (x-1) (x+y)\n                                else y\n     in f2f g 5\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F3 where\n\nfac :: Int -> Int\nfac x = if (x==0) then 1\n                  else x*fac (x-1)\n\nf3 = let v = fac\n     in \\y -> v y\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F4 where\n\nf4h :: (Int -> Int) -> Int -> Int\nf4h f x = if x==0 then (f x)\n                 else f4h f (x-1) -- + (f x)\nf4g = \\y->y+1\nf4 = f4h f4g 9\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F5 where\n\n-- result not satisfiable\nf5g h z = (h z) + 1\nf5h f x g = f x + f5g g x -- + (f (x+1))\nf5y = (\\y -> y+1)\nf5 = f5h f5y 0 f5y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F6 where\n\nf6f = \\h -> \\x -> h x 0\nf6t = \\y -> \\z -> y + z\nf6 = f6f f6t 3\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F7 where\n\nf7f = \\x -> x\nf7g = \\z -> \\y -> z+y\nf7 = f7f f7g 2 3\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F8 where\n\nf8f b x y = let g = \\z -> x+y+z\n            in if b then y else g (x*x)\nf8 = f8f True 1 2\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F9 where\n\nf91 = let f = \\n -> if n<=100 then f (f (n+11)) else n-10\n      in f 10\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- Optimisation problem.  There are two missed opportunities for optimisation in alex_scan_tkn, below.\n\nmodule Main (main) where\n\nimport Data.Char ( ord )\nimport Control.Monad.ST\nimport Control.Monad (when)\nimport Data.STRef\nimport GHC.ST\nimport Data.Array\nimport Data.Char (ord)\nimport Data.Array.Base (unsafeAt)\nimport GHC.Exts\nalex_base :: AlexAddr\nalex_base = AlexA# \"\\xf8\\xff\\xfd\\xff\\x02\\x00\\x4c\\x00\"#\n\nalex_table :: AlexAddr\nalex_table = AlexA# \"\\x00\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x02\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x02\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x02\\x00\\x00\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x02\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nalex_check :: AlexAddr\nalex_check = AlexA# \"\\xff\\xff\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\x20\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\x20\\x00\\xff\\xff\\x27\\x00\\xff\\xff\\xff\\xff\\x20\\x00\\xff\\xff\\xff\\xff\\x2d\\x00\\xff\\xff\\xff\\xff\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x68\\x00\\x69\\x00\\x6a\\x00\\x6b\\x00\\x6c\\x00\\x6d\\x00\\x6e\\x00\\x6f\\x00\\x70\\x00\\x71\\x00\\x72\\x00\\x73\\x00\\x74\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x79\\x00\\x7a\\x00\\x27\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\x2d\\x00\\xff\\xff\\xff\\xff\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x68\\x00\\x69\\x00\\x6a\\x00\\x6b\\x00\\x6c\\x00\\x6d\\x00\\x6e\\x00\\x6f\\x00\\x70\\x00\\x71\\x00\\x72\\x00\\x73\\x00\\x74\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x79\\x00\\x7a\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\"#\n\nalex_deflt :: AlexAddr\nalex_deflt = AlexA# \"\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\"#\n\nalex_accept = listArray (0::Int,3) [[],[],[(AlexAcc 0 (alex_action_0) Nothing Nothing)],[(AlexAcc 1 (alex_action_1) Nothing Nothing)]]\nword (_,_,input) len = return (take len input)\n\nscanner str = runAlex str $ do\n  let loop i = do tok <- alexScan;\n                   if tok == \"stopped.\" || tok == \"error.\"\n                         then return i\n                         else do let i' = i+1 in i' `seq` loop i'\n  loop 0\n\nalexEOF (_,_,\"\")   = return \"stopped.\"\nalexEOF (_,_,rest) = return \"error.\"\n\nmain = do\n s <- getContents\n print (scanner s)\nalex_action_0 = skip\nalex_action_1 = word\n-- {-# LINE 1 \"GenericTemplate.hs\" #-}\n--\n------------------------------------------------------------------------\n-----\n-- ALEX TEMPLATE\n--\n-- (c) Chris Dornan and Simon Marlow 2003\n\n--\n------------------------------------------------------------------------\n-----\n-- Token positions\n\n-- `Posn' records the location of a token in the input text.  It has three\n-- fields: the address (number of chacaters preceding the token), line number\n-- and column of a token within the file. `start_pos' gives the position of the\n-- start of the file and `eof_pos' a standard encoding for the end of file.\n-- `move_pos' calculates the new position after traversing a given character,\n-- assuming the usual eight character tab stops.\n\ndata AlexPosn = AlexPn !Int !Int !Int\n         deriving (Eq,Show)\n\nalexStartPos :: AlexPosn\nalexStartPos = AlexPn 0 1 1\n\nalexMove :: AlexPosn -> Char -> AlexPosn\nalexMove (AlexPn a l c) '\\t' = AlexPn (a+1)  l     (((c+7) `div` 8)*8+1)\nalexMove (AlexPn a l c) '\\n' = AlexPn (a+1) (l+1)   1\nalexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)\n\n--\n------------------------------------------------------------------------\n-----\n-- The Alex monad\n--\n-- Compile with -funbox-strict-fields for best results!\n\ndata AlexState s = AlexState {\n         alex_pos :: !(STRef s AlexPosn),-- position at current input location\n         alex_inp :: !(STRef s String),  -- the current input\n         alex_chr :: !(STRef s Char),    -- the character before the input\n         alex_scd :: !(STRef s Int)      -- the current startcode\n    }\n\ntype AlexInput = (AlexPosn,Char,String)\n\nalexInputPrevChar :: AlexInput -> Char\nalexInputPrevChar (p,c,s) = c\n\nrunAlex :: String -> Alex a -> a\nrunAlex input (Alex f)\n   = runST (do\n       inp_r <- newSTRef input\n       chr_r <- newSTRef '\\n'\n       pos_r <- newSTRef alexStartPos\n       scd_r <- newSTRef 0\n       f (AlexState {alex_pos = pos_r,\n                      alex_inp = inp_r,\n                      alex_chr = chr_r,\n                      alex_scd = scd_r}))\n\n--TODO include error support\nnewtype Alex a = Alex { unAlex :: forall s. AlexState s -> ST s a }\n\ninstance Monad Alex where\n  (Alex m) >>= k  = Alex (\\s -> m s >>= \\a -> unAlex (k a) s)\n  return a = Alex (\\s -> return a)\n\nalexGetChar :: Alex (Maybe Char)\nalexGetChar = Alex (\\st@AlexState{ alex_inp=inp_r,\n                                     alex_chr=chr_r,\n                                     alex_pos=pos_r } -> do\n  inp <- readSTRef inp_r\n  pos <- readSTRef pos_r\n  case inp of\n     []    -> return Nothing\n     (c:s) -> do  writeSTRef inp_r s\n                  writeSTRef chr_r c\n                  let p' = alexMove pos c\n                  p' `seq` writeSTRef pos_r p'\n                  return (Just c)\n  )\n\nalexGetInput :: Alex AlexInput\nalexGetInput\n = Alex (\\s@AlexState{alex_pos=pos_r,alex_chr=chr_r,alex_inp=inp_r} -> do\n     inp <- readSTRef inp_r\n     chr <- readSTRef chr_r\n     pos <- readSTRef pos_r\n     return (pos,chr,inp)\n )\n\nalexSetInput :: AlexInput -> Alex ()\nalexSetInput (pos,chr,inp)\n = Alex (\\s@AlexState{alex_pos=pos_r,alex_chr=chr_r,alex_inp=inp_r} -> do\n    writeSTRef inp_r inp\n    writeSTRef pos_r pos\n    writeSTRef chr_r chr\n  )\n\nalexGetStartCode :: Alex Int\nalexGetStartCode = Alex (\\s@AlexState{alex_scd=scd_r} -> do\n  readSTRef scd_r)\n\nalexSetStartCode :: Int -> Alex ()\nalexSetStartCode sc = Alex (\\s@AlexState{alex_scd=scd_r} -> do\n  writeSTRef scd_r sc)\n\n--\n-----------------------------------------------------------------------------\n-- Useful token actions\n\n\n-- just ignore this token and scan another one\nskip input len = alexScan\n\n-- ignore this token, but set the start code to a new value\nbegin code input len = do alexSetStartCode code; alexScan\n\n-- perform an action for this token, and set the start code to a new value\n(token `andBegin` code) input len = do alexSetStartCode code; token input len\n\n--\n-----------------------------------------------------------------------------\n-- INTERNALS and main scanner engine\n\n-- {-# LINE 144 \"GenericTemplate.hs\" #-}\n\ndata AlexAddr = AlexA# Addr#\n\n{-# INLINE alexIndexShortOffAddr #-}\nalexIndexShortOffAddr (AlexA# arr) off =\n         narrow16Int# i\n  where\n         i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)\n         high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))\n         low  = int2Word# (ord# (indexCharOffAddr# arr off'))\n         off' = off *# 2#\n\n\n--\n-----------------------------------------------------------------------------\n-- Main lexing routines\n\n\n\n-- alexScan :: some a . Alex a\nalexScan = do\n  (I# (startcode)) <- alexGetStartCode  -- the startcode is the initial state\n  cur_input <- alexGetInput\n  let c = alexInputPrevChar cur_input\n  c `seq` do\n  r <- alex_scan_tkn c 0# startcode AlexNone\n  case r of\n    AlexNone ->\n\n\n\n         alexEOF cur_input\n    AlexLastAcc k input len -> do\n\n\n\n         alexSetInput input\n         k cur_input len\n\n-- {-# LINE 221 \"GenericTemplate.hs\" #-}\n\n\n-- Push the input through the DFA, remembering the most recent accepting\n-- state it encountered.\n\nalex_scan_tkn lc len (-1#) last_acc = return last_acc\nalex_scan_tkn lc len s last_acc = do\n  new_acc <- check_accs s lc len last_acc  --danaxu extends arguments\n  c <- alexGetChar\n  let {-# INLINE [0] join #-}\n      -- This is a *hack*, the compiler doesn't eliminate the Maybe return\n      -- from alexGetChar unless we extract this join point and inline\n      -- it later.\n      join c' =\n\n\n\n         alex_scan_tkn lc\n                 (len +# 1#) s' new_acc\n         where\n                 base   = alexIndexShortOffAddr alex_base s\n                 (I# (ord_c)) = ord c'\n                 offset = (base +# ord_c)\n                 check  = alexIndexShortOffAddr alex_check offset\n\n                 s' =\n                      if (offset >=# 0#) && (check ==# ord_c)\n                         then alexIndexShortOffAddr alex_table offset\n                         else alexIndexShortOffAddr alex_deflt s\n  case c of\n    Nothing -> return new_acc    -- end of input\n    Just c' -> join c'\n   -- where\n         -- OPTIMISATION PROBLEM.  We need to eta-expand\n         -- check_accs and check_accs1.  This needs a simple\n        -- one-shot analysis of some kind, but note that\n        -- check_accs1 is recursive.\ncheck_accs s lc len last_acc = check_accs1 (alex_accept `unsafeAt` (I# (s))) lc len last_acc\ncheck_accs1 accs lc len last_acc =\n           case accs of\n                 [] -> return last_acc\n                 (AlexAcc _ a lctx rctx : rest) ->\n\n                   case lctx of\n                     Nothing  -> check_rctx a rctx rest lc len last_acc\n                     Just arr | arr!lc    -> check_rctx a rctx rest lc len last_acc\n                              | otherwise -> check_accs1 rest lc len last_acc\n                    -- where\n\nok a len = do inp <- alexGetInput\n              return (AlexLastAcc a inp (I# (len)))\n\ncheck_rctx a rctx rest lc len last_acc =\n                         case rctx of\n                            Nothing -> ok a len\n                            Just (I# (sn)) -> do\n                               inp <- alexGetInput\n                               let c = alexInputPrevChar inp\n                               c `seq` do\n                               acc <- alex_scan_tkn c 0# sn AlexNone\n                               alexSetInput inp\n                               case acc of\n                                 AlexNone      -> check_accs1 rest lc len last_acc\n                                 AlexLastAcc{} -> ok a len\n                                 -- TODO: there's no need to find the longest\n                                 -- match when checking the right context, just\n                                 -- the first match will do.\n\ndata AlexLastAcc a = AlexNone | AlexLastAcc a !AlexInput !Int\n\ndata AlexAcc a = AlexAcc Int a (Maybe (Array Char Bool)) (Maybe Int)\n", "num_lines": 285}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Prim where\n\nmap2 f [] = []\nmap2 f (x:xs) = f x : map2 f xs\n\nzipWith2 f [] [] = []\nzipWith2 f (a:x) (b:y) = (f a b):zipWith2 f x y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Simple array creation\n\nimport Data.Array\n\nmain =\n let a1 = array (1,3) (zip [2,3,1] ['a'..'d']) in\n print a1\n\n-- Result:\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array creation, (index,value) list with duplicates.\n-- \n-- Haskell library report 1.3 (and earlier) specifies\n-- that `array' values created with lists containing dups,\n-- are undefined ( _|_ ).\n--\n-- GHC-2.02 (and earlier) does not flag this as such, the\n-- last (index,value) is instead used.\n--\n-- The report also specifies `array' is spine strict in\n-- the (index,value) list argument and to check the\n-- validity of the index values upon creation, it also\n-- strict for the indices. To test this, we do (a!1)\n-- twice, expecting to see the same value..\n--\nimport Data.Array\n\nmain =\n let a1 = array (1,3) (zip (1:[1..3]) ['a'..'d']) in\n print (a1!1) >>\n print a1     >>\n print (a1!1)\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array creation, (index,value) list with out of bound index.\n-- \n-- Haskell library report 1.3 (and earlier) specifies\n-- that `array' values created with lists containing out-of-bounds indices,\n-- are undefined ( _|_ ).\n--\n-- GHC implementation of `array' catches this (or, rather, \n-- `index' does) - the argument list to `array' is defined\n-- to have its spine be evaluated - so the indexing below\n-- should cause a failure.\n--\nimport Data.Array\n\nmain =\n let a1 = array (1::Int,3) (zip ([1..4]) ['a'..'d']) in\n print (a1!2)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - accessing undefined element\n-- \n-- Sample Haskell implementation in the 1.3 Lib report defines\n-- this as being undefined/error.\n\nimport Data.Array\n\nmain =\n let a1 = array (1,3) (zip ([1,2]) ['a'..'d']) in\n print (a1!3)\n\n-- output: Fail: (Array.!): undefined array element\n\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - recurrences\n-- \n-- array does not evaluate the elements.\n--\nimport Data.Array\n\nmain =\n let \n  a1 = array (1,100) ((1,1::Integer):[(i,i*a1!(i-1))|i<-[2..100]])\n in\n print a1\n\n--\n\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - empty arrays\n-- \n-- print a couple of them to try to expose empty arrays \n-- to a GC or two.\nimport Data.Array\n\nmain =\n let \n  a1 = array (1,0) []\n in\n print (take 300 $ repeat (a1 :: Array Int Int))\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - accessing empty arrays\n-- \n-- empty arrays are legal, but indexing them is undefined!\n--\nimport Data.Array\n\nmain =\n let \n  a1 = array (1::Int,0) [(1,'a')]\n in\n print (a1!0)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - out-of-range (index,value) pairs\n-- \n-- supplying a list containing one or more pairs \n-- with out-of-range index is undefined.\n--\n--\nimport Data.Array\n\nmain = \n let \n  a1 = array (1::Int,0) []\n  a2 = array (0::Int,1) (zip [0..] ['a'..'z'])\n in\n print (a1::Array Int Int) >> print a2\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - derived ops\n-- \n-- testing the well-behavedness of \n-- derived ops for empty and non-empty arrays\n--\nimport Data.Array\n\nmain = \n let \n  a1 = array (1,0) ([]::[(Int,Int)])\n  a2 = array (1,26) (zip [1..] ['a'..'z'])\n\n  dump a = (bounds a, indices a, elems a, assocs a)\n in\n print (dump a1) >>\n print (dump a2)\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - accumulated arrays\n-- \n--\nmodule Main(main) where\n\nimport Data.Array\nimport Data.Ix\n\nhist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b\nhist bnds is = accumArray (+) 0 bnds [(i,1) | i <- is , inRange bnds i]\n\nmain = \n let \n  a1 = hist (0,10) (concat $ take 2 $ repeat [1..20])\n in\n print a1\n\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array - array difference operator\n-- \n--\nmodule Main(main) where\n\nimport Data.Array\nimport Data.Ix\n\nhist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b\nhist bnds is = accumArray (+) 0 bnds [(i,1) | i <- is , inRange bnds i]\n\nmain = \n let \n  a1 = hist (0,10) (concat $ take 2 $ repeat [1..20])\n in\n print a1 >>\n print (a1 // [ (i,0) | i<-[0..10], odd i])\n\n\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array map operations\n-- \n--\nmodule Main(main) where\n\nimport Data.Array\nimport Data.Char\n\nmain = \n let \n  a1 = array (0,10) (zip [0..10] ['a'..'z'])\n in\n print a1 >>\n print (fmap (toUpper) a1) >>\n print (ixmap (3,8) (+1) a1)\n\n\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Ratio -- 1.3\nimport Data.Array -- 1.3\ninfix 1 =:\n(=:) a b = (a,b)\n\nmain = putStr (shows sub_b \"\\n\")\n    where\n        sub_b :: Array Int Double\n        sub_b = ixmap (102, 113) id b\n\n        b :: Array Int Double\n        b = fmap ( \\ r -> fromRational r / pi )\n                 (ixmap (101,200) (\\ i -> toInteger i - 100) a)\n\n        a :: Array Integer (Ratio Integer)\n        a = array (1,100) ((1 =: 1) : [i =: fromInteger i * a!(i-1)\n                                        | i <- [2..100]])\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! multi-dimensional arrays\n\nmodule Main ( main ) where\nimport Control.Monad.ST\nimport Data.Array.ST\n\ntype TwoD s = STArray s Int (STArray s Int Int)\n\nsetup :: ST s (TwoD s)\nsetup = let isz = 10\n            imax = isz - 1\n            osz = 2\n            omax = osz - 1 in\n        do\n            -- gives : undefined reference to `IOBase_error_closure'\n--          x <- newArray (0, omax) (error \"uninitialised\")\n            dmy <- newArray (0, imax) 0\n            x <- newArray (0, omax) dmy\n            as <- (sequence . replicate osz) (newArray (0, imax) 6)\n            mapM_ (\\(i,v) -> writeArray x i v) (zip [0..omax] as)\n            return x\n\nmain :: IO ()\nmain = do\n         a <- stToIO setup\n         return ()\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Array test\n-- This one fails in Hugs (Feb 2001)\n\nmodule Main where\n\nimport Data.Array\n\n-- All in main is only to show the strange behaviour.\n--\n-- arrS is the array that foo (NB (1.0,1)) shows in Hugs.\n-- But (foo (NB (1.0,1)))==arrS is False.\n\n-- If I write NB (f,p) -> hCMt [(p,listArray ((1,1),(1,1)) [f])] instead of line 16\n-- the bug disappears. That is also the reason why I have to keep the data declaration RD.\n-- If I put the type signature of line 18 in scope the bug also disappears.\n-- If I write hCMt po_arL = (accumArray (\\a _-> a) ZM ((1,1),(1,2)) []) //\n--                          (map (\\(po,ar) -> ((1,po),M ar)) po_arL)\n-- instead of line 19 and 20 it also vanishes.\n\ndata CM a = ZM | M (Array (Int,Int) a)  deriving (Show,Eq)\n\ndata RD =    NB !(Double,Int)\n\nmain  = do\n  let arr = foo (NB (1.0,1))\n        -- arr = { (1,1) -> M { (1,1) -> 1.0 }, (1,2) -> ZM }\n\n        -- All these should return True\n  putStr (\"arr==arrS \"++show (arr==arrS)++\"\\n\")\n  putStr (\"arrS==arr \"++show (arrS==arr)++\"\\n\")\n  putStr (\"bnds arr arrS \"++show ((bounds arr)==(bounds arrS))++\"\\n\")\n  putStr (\"bnds +id arr arrS \"++show (((bounds.id) arr)==((bounds) arrS))++\"\\n\")\n  putStr (\"id +bnds arr arrS \"++show (((id.bounds) arr)==((bounds) arrS))++\"\\n\")\n\n\nfoo :: RD -> Array (Int,Int) (CM Double)\nfoo rd = case rd of\n    NB (f,p) -> h where h = hCMt [(p,listArray ((1,1),(1,1)) [f])]\n                        -- h = { (1,p) -> M { (1,1) -> f }, other -> ZM }\n   where\n   --h0CMt :: Array (Int, Int) (CM Double)\n   -- h0CMt = { (1,1) -> ZM, (1,2) -> ZM }\n   h0CMt = accumArray (\\a _-> a) ZM ((1,1),(1,2)) []\n\n   hCMt prs = h0CMt // (map (\\(po,ar) -> ((1,po),M ar)) prs)\n                        -- [ (1,p), M { (1,1) -> f } ]\n\n\narrS :: Array (Int,Int) (CM Double)\narrS = listArray ((1,1),(1,2)) [M (listArray ((1,1),(1,1)) [1.0]),ZM]\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Main where\n\n{-\n - This is a test framework for Arrays, using QuickCheck\n -\n -}\n\nimport qualified Data.Array as Array\nimport Data.List\nimport Control.Monad ( liftM2, liftM3, liftM4 )\nimport System.Random\n\n\nimport Data.Ix\nimport Data.List( (\\\\) )\n\ninfixl 9  !, //\ninfixr 0 ==>\ninfix  1 `classify`\n\nprop_array =\n    forAll genBounds       $ \\ (b :: (Int,Int))     ->\n    forAll (genIVPs b 10)     $ \\ (vs :: [(Int,Int)]) ->\n    Array.array b vs\n         `same_arr`\n    array b vs\nprop_listArray =\n    forAll genBounds       $ \\ (b :: (Int,Int))     ->\n    forAll (vector (length [fst b..snd b]))\n                           $ \\ (vs :: [Bool]) ->\n    Array.listArray b vs == Array.array b (zipWith (\\ a b -> (a,b))\n                                                   (Array.range b) vs)\n\nprop_indices =\n    forAll genBounds       $ \\ (b :: (Int,Int))     ->\n    forAll (genIVPs b 10)     $ \\ (vs :: [(Int,Int)]) ->\n    let arr = Array.array b vs\n    in Array.indices arr == ((Array.range . Array.bounds) arr)\n\nprop_elems =\n    forAll genBounds       $ \\ (b :: (Int,Int))     ->\n    forAll (genIVPs b 10)     $ \\ (vs :: [(Int,Int)]) ->\n    let arr = Array.array b vs\n    in Array.elems arr == [arr Array.! i | i <- Array.indices arr]\n\nprop_assocs =\n    forAll genBounds       $ \\ (b :: (Int,Int))     ->\n    forAll (genIVPs b 10)     $ \\ (vs :: [(Int,Int)]) ->\n    let arr = Array.array b vs\n    in Array.assocs arr == [(i, arr Array.! i) | i <- Array.indices arr]\n\nprop_slashslash =\n    forAll genBounds       $ \\ (b :: (Int,Int))     ->\n    forAll (genIVPs b 10)     $ \\ (vs :: [(Int,Int)])  ->\n    let arr = Array.array b vs\n        us = []\n    in arr Array.// us == Array.array (Array.bounds arr)\n                          ([(i,arr Array.! i)\n                            | i <- Array.indices arr \\\\ [i | (i,_) <- us]]\n                             ++ us)\nprop_accum =\n    forAll genBounds          $ \\ (b :: (Int,Int))    ->\n    forAll (genIVPs b 10)     $ \\ (vs :: [(Int,Int)]) ->\n\n    forAll (genIVPs b 10)     $ \\ (us :: [(Int,Int)]) ->\n    forAll (choose (0,length us))\n                           $ \\ n ->\n    let us' = take n us in\n    forAll arbitrary       $ \\ (fn :: Int -> Int -> Int) ->\n    let arr = Array.array b vs\n    in Array.accum fn arr us'\n        == foldl (\\a (i,v) -> a Array.// [(i,fn (a Array.! i) v)]) arr us'\n\nprop_accumArray =\n    forAll arbitrary          $ \\ (f :: Int -> Int -> Int) ->\n    forAll arbitrary          $ \\ (z :: Int) ->\n    forAll genBounds          $ \\ (b :: (Int,Int))    ->\n    forAll (genIVPs b 10)     $ \\ (vs :: [(Int,Int)]) ->\n    Array.accumArray f z b vs == Array.accum f\n                (Array.array b [(i,z) | i <- Array.range b]) vs\n\n\nsame_arr :: (Eq b) => Array.Array Int b -> Array Int b -> Bool\nsame_arr a1 a2 = a == c && b == d\n                 && all (\\ n -> (a1 Array.! n) == (a2 ! n)) [a..b]\n    where (a,b) = Array.bounds a1 :: (Int,Int)\n          (c,d) = bounds a2 :: (Int,Int)\n\ngenBounds :: Gen (Int,Int)\ngenBounds = do m <- choose (0,20)\n               n <- choose (minBound,maxBound-m)\n               return (n,n+m-1)\n\ngenIVP :: Arbitrary a => (Int,Int) -> Gen (Int,a)\ngenIVP b = do { i <- choose b\n              ; v <- arbitrary\n              ; return (i,v)\n              }\n\ngenIVPs :: Arbitrary a => (Int,Int) -> Int -> Gen [(Int,a)]\ngenIVPs b@(low,high) s\n  = do { let is = [low..high]\n       ; vs <- vector (length is)\n       ; shuffle s (zip is vs)\n       }\n\nprop_id = forAll genBounds $ \\ (b :: (Int,Int)) ->\n          forAll (genIVPs b 10) $ \\ (ivps :: [(Int,Int)])  ->\n          label (show (ivps :: [(Int,Int)])) True\n\n-- rift takes a list, split it (using an Int argument),\n-- and then rifts together the split lists into one.\n-- Think: rifting a pack of cards.\nrift :: Int -> [a] -> [a]\nrift n xs = comb (drop n xs) (take n xs)\n   where\n      comb (a:as) (b:bs) = a : b : comb as bs\n      comb (a:as) []     = a : as\n      comb []     (b:bs) = b : bs\n      comb []     []     = []\n\n\n-- suffle makes n random rifts. Typically after\n-- log n rifts, the list is in a pretty random order.\n-- (where n is the number of elements in the list)\n\nshuffle :: Int -> [a] -> Gen [a]\nshuffle 0 m = return m\nshuffle n m = do { r <- choose (1,length m)\n                 ; shuffle (n-1) (rift r m)\n                 }\nprop_shuffle =\n    forAll (shuffle 10 [1..10::Int]) $ \\ lst ->\n    label (show lst) True\n\n------------------------------------------------------------------------------\n\nmain = do test prop_array\n          test prop_listArray\n          test prop_indices\n          test prop_elems\n          test prop_assocs\n          test prop_slashslash\n          test prop_accum\n          test prop_accumArray\n\n\ninstance Show (a -> b) where { show _ = \"<FN>\" }\n\n------------------------------------------------------------------------------\n\ndata Array a b = MkArray (a,a) (a -> b) deriving ()\n\narray       :: (Ix a) => (a,a) -> [(a,b)] -> Array a b\narray b ivs =\n    if and [inRange b i | (i,_) <- ivs]\n        then MkArray b\n                     (\\j -> case [v | (i,v) <- ivs, i == j] of\n                            [v]   -> v\n                            []    -> error \"Array.!: \\\n                                           \\undefined array element\"\n                            _     -> error \"Array.!: \\\n                                           \\multiply defined array element\")\n        else error \"Array.array: out-of-range array association\"\n\nlistArray             :: (Ix a) => (a,a) -> [b] -> Array a b\nlistArray b vs        =  array b (zipWith (\\ a b -> (a,b)) (range b) vs)\n\n(!)                   :: (Ix a) => Array a b -> a -> b\n(!) (MkArray _ f)     =  f\n\nbounds                :: (Ix a) => Array a b -> (a,a)\nbounds (MkArray b _)  =  b\n\nindices               :: (Ix a) => Array a b -> [a]\nindices               =  range . bounds\n\nelems                 :: (Ix a) => Array a b -> [b]\nelems a               =  [a!i | i <- indices a]\n\nassocs                :: (Ix a) => Array a b -> [(a,b)]\nassocs a              =  [(i, a!i) | i <- indices a]\n\n(//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b\na // us               =  array (bounds a)\n                            ([(i,a!i) | i <- indices a \\\\ [i | (i,_) <- us]]\n                             ++ us)\n\naccum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]\n                                   -> Array a b\naccum f               =  foldl (\\a (i,v) -> a // [(i,f (a!i) v)])\n\naccumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]\n                                   -> Array a b\naccumArray f z b      =  accum f (array b [(i,z) | i <- range b])\n\nixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c\n                                         -> Array a c\nixmap b f a           = array b [(i, a ! f i) | i <- range b]\n\ninstance  (Ix a)          => Functor (Array a) where\n    fmap fn (MkArray b f) =  MkArray b (fn . f)\n\ninstance  (Ix a, Eq b)  => Eq (Array a b)  where\n    a == a'             =  assocs a == assocs a'\n\ninstance  (Ix a, Ord b) => Ord (Array a b)  where\n    a <=  a'            =  assocs a <=  assocs a'\n\ninstance  (Ix a, Show a, Show b) => Show (Array a b)  where\n    showsPrec p a = showParen (p > 9) (\n                    showString \"array \" .\n                    shows (bounds a) . showChar ' ' .\n                    shows (assocs a)                  )\n\ninstance  (Ix a, Read a, Read b) => Read (Array a b)  where\n    readsPrec p = readParen (p > 9)\n           (\\r -> [(array b as, u) | (\"array\",s) <- lex r,\n                                     (b,t)       <- reads s,\n                                     (as,u)      <- reads t   ])\n--------------------------------------------------------------------\n\n-- QuickCheck v.0.2\n-- DRAFT implementation; last update 000104.\n-- Koen Claessen, John Hughes.\n-- This file represents work in progress, and might change at a later date.\n\n\n--------------------------------------------------------------------\n-- Generator\n\nnewtype Gen a\n  = Gen (Int -> StdGen -> a)\n\nsized :: (Int -> Gen a) -> Gen a\nsized fgen = Gen (\\n r -> let Gen m = fgen n in m n r)\n\nresize :: Int -> Gen a -> Gen a\nresize n (Gen m) = Gen (\\_ r -> m n r)\n\nrand :: Gen StdGen\nrand = Gen (\\n r -> r)\n\npromote :: (a -> Gen b) -> Gen (a -> b)\npromote f = Gen (\\n r -> \\a -> let Gen m = f a in m n r)\n\nvariant :: Int -> Gen a -> Gen a\nvariant v (Gen m) = Gen (\\n r -> m n (rands r !! (v+1)))\n where\n  rands r0 = r1 : rands r2 where (r1, r2) = split r0\n\ngenerate :: Int -> StdGen -> Gen a -> a\ngenerate n rnd (Gen m) = m size rnd'\n where\n  (size, rnd') = randomR (0, n) rnd\n\ninstance Functor Gen where\n  fmap f m = m >>= return . f\n\ninstance Applicative Gen where\n  pure  = return\n  (<*>) = liftM2 id\n\ninstance Monad Gen where\n  return a    = Gen (\\n r -> a)\n  Gen m >>= k =\n    Gen (\\n r0 -> let (r1,r2) = split r0\n                      Gen m'  = k (m n r1)\n                   in m' n r2)\n\n-- derived\n\n--choose :: Random a => (a, a) -> Gen a\nchoose bounds = ((fst . randomR bounds) `fmap` rand)\n\nelements :: [a] -> Gen a\nelements xs = (xs !!) `fmap` choose (0, length xs - 1)\n\nvector :: Arbitrary a => Int -> Gen [a]\nvector n = sequence [ arbitrary | i <- [1..n] ]\n\noneof :: [Gen a] -> Gen a\noneof gens = elements gens >>= id\n\nfrequency :: [(Int, Gen a)] -> Gen a\nfrequency xs = choose (1, tot) >>= (`pick` xs)\n where\n  tot = sum (map fst xs)\n\n  pick n ((k,x):xs)\n    | n <= k    = x\n    | otherwise = pick (n-k) xs\n\n-- general monadic\n\ntwo :: Monad m => m a -> m (a, a)\ntwo m = liftM2 (,) m m\n\nthree :: Monad m => m a -> m (a, a, a)\nthree m = liftM3 (,,) m m m\n\nfour :: Monad m => m a -> m (a, a, a, a)\nfour m = liftM4 (,,,) m m m m\n\n--------------------------------------------------------------------\n-- Arbitrary\n\nclass Arbitrary a where\n  arbitrary   :: Gen a\n  coarbitrary :: a -> Gen b -> Gen b\n\ninstance Arbitrary () where\n  arbitrary     = return ()\n  coarbitrary _ = variant 0\n\ninstance Arbitrary Bool where\n  arbitrary     = elements [True, False]\n  coarbitrary b = if b then variant 0 else variant 1\n\ninstance Arbitrary Int where\n  arbitrary     = sized $ \\n -> choose (-n,n)\n  coarbitrary n = variant (if n >= 0 then 2*n else 2*(-n) + 1)\n\ninstance Arbitrary Integer where\n  arbitrary     = sized $ \\n -> choose (-fromIntegral n,fromIntegral n)\n  coarbitrary n = variant (fromInteger (if n >= 0 then 2*n else 2*(-n) + 1))\n\ninstance Arbitrary Float where\n  arbitrary     = liftM3 fraction arbitrary arbitrary arbitrary\n  coarbitrary x = coarbitrary (decodeFloat x)\n\ninstance Arbitrary Double where\n  arbitrary     = liftM3 fraction arbitrary arbitrary arbitrary\n  coarbitrary x = coarbitrary (decodeFloat x)\n\nfraction a b c = fromInteger a + (fromInteger b / (abs (fromInteger c) + 1))\n\ninstance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where\n  arbitrary          = liftM2 (,) arbitrary arbitrary\n  coarbitrary (a, b) = coarbitrary a . coarbitrary b\n\ninstance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (a, b, c) where\n  arbitrary             = liftM3 (,,) arbitrary arbitrary arbitrary\n  coarbitrary (a, b, c) = coarbitrary a . coarbitrary b . coarbitrary c\n\ninstance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)\n      => Arbitrary (a, b, c, d)\n where\n  arbitrary = liftM4 (,,,) arbitrary arbitrary arbitrary arbitrary\n  coarbitrary (a, b, c, d) =\n    coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d\n\ninstance Arbitrary a => Arbitrary [a] where\n  arbitrary          = sized (\\n -> choose (0,n) >>= vector)\n  coarbitrary []     = variant 0\n  coarbitrary (a:as) = coarbitrary a . variant 1 . coarbitrary as\n\ninstance (Arbitrary a, Arbitrary b) => Arbitrary (a -> b) where\n  arbitrary         = promote (`coarbitrary` arbitrary)\n  coarbitrary f gen = arbitrary >>= ((`coarbitrary` gen) . f)\n\n--------------------------------------------------------------------\n-- Testable\n\ndata Result\n  = Result { ok :: Maybe Bool, stamp :: [String], arguments :: [String] }\n\nnothing :: Result\nnothing = Result{ ok = Nothing, stamp = [], arguments = [] }\n\nnewtype Property\n  = Prop (Gen Result)\n\nresult :: Result -> Property\nresult res = Prop (return res)\n\nevaluate :: Testable a => a -> Gen Result\nevaluate a = gen where Prop gen = property a\n\nclass Testable a where\n  property :: a -> Property\n\ninstance Testable () where\n  property _ = result nothing\n\ninstance Testable Bool where\n  property b = result (nothing{ ok = Just b })\n\ninstance Testable Result where\n  property res = result res\n\ninstance Testable Property where\n  property prop = prop\n\ninstance (Arbitrary a, Show a, Testable b) => Testable (a -> b) where\n  property f = forAll arbitrary f\n\nforAll :: (Show a, Testable b) => Gen a -> (a -> b) -> Property\nforAll gen body = Prop $\n  do a   <- gen\n     res <- evaluate (body a)\n     return (argument a res)\n where\n  argument a res = res{ arguments = show a : arguments res }\n\n(==>) :: Testable a => Bool -> a -> Property\nTrue  ==> a = property a\nFalse ==> a = property ()\n\nlabel :: Testable a => String -> a -> Property\nlabel s a = Prop (add `fmap` evaluate a)\n where\n  add res = res{ stamp = s : stamp res }\n\nclassify :: Testable a => Bool -> String -> a -> Property\nclassify True  name = label name\nclassify False _    = property\n\ntrivial :: Testable a => Bool -> a -> Property\ntrivial = (`classify` \"trivial\")\n\ncollect :: (Show a, Testable b) => a -> b -> Property\ncollect v = label (show v)\n\n--------------------------------------------------------------------\n-- Testing\n\ndata Config = Config\n  { configMaxTest :: Int\n  , configMaxFail :: Int\n  , configSize    :: Int -> Int\n  , configEvery   :: Int -> [String] -> String\n  }\n\nquick :: Config\nquick = Config\n  { configMaxTest = 100\n  , configMaxFail = 1000\n  , configSize    = (+ 3) . (`div` 2)\n  , configEvery   = \\n args -> let s = show n in s ++ \",\"\n  }\n\nverbose :: Config\nverbose = quick\n  { configEvery = \\n args -> show n ++ \":\\n\" ++ unlines args\n  }\n\ntest, quickCheck, verboseCheck :: Testable a => a -> IO ()\ntest         = check quick\nquickCheck   = check quick\nverboseCheck = check verbose\n\ncheck :: Testable a => Config -> a -> IO ()\ncheck config a =\n  do rnd <- newStdGen\n     tests config (evaluate a) rnd 0 0 []\n\ntests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()\ntests config gen rnd0 ntest nfail stamps\n  | ntest == configMaxTest config = do done \"OK, passed\" ntest stamps\n  | nfail == configMaxFail config = do done \"Arguments exhausted after\" ntest stamps\n  | otherwise               =\n      do putStr (configEvery config ntest (arguments result))\n         case ok result of\n           Nothing    ->\n             tests config gen rnd1 ntest (nfail+1) stamps\n           Just True  ->\n             tests config gen rnd1 (ntest+1) nfail (stamp result:stamps)\n           Just False ->\n             putStr ( \"Falsifiable, after \"\n                   ++ show ntest\n                   ++ \" tests:\\n\"\n                   ++ unlines (arguments result)\n                    )\n     where\n      result      = generate (configSize config ntest) rnd2 gen\n      (rnd1,rnd2) = split rnd0\n\ndone :: String -> Int -> [[String]] -> IO ()\ndone mesg ntest stamps =\n  do putStr ( mesg ++ \" \" ++ show ntest ++ \" tests\" ++ table )\n where\n  table = display\n        . map entry\n        . reverse\n        . sort\n        . map pairLength\n        . group\n        . sort\n        . filter (not . null)\n        $ stamps\n\n  display []  = \".\\n\"\n  display [x] = \" (\" ++ x ++ \").\\n\"\n  display xs  = \".\\n\" ++ unlines (map (++ \".\") xs)\n\n  pairLength xss@(xs:_) = (length xss, xs)\n  entry (n, xs)         = percentage n ntest\n                       ++ \" \"\n                       ++ concat (intersperse \", \" xs)\n\n  percentage n m        = show ((100 * n) `div` m) ++ \"%\"\n\n--------------------------------------------------------------------\n-- the end.\n\n{-\ninstance Observable StdGen where { observer = observeBase }\n\ninstance Observable a => Observable (Gen a) where\n  observer (Gen a) = send \"Gen\" (return (Gen) << a)\n\n-}\n", "num_lines": 516}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Caused a crash in GHC 6.4 when optimising, due to inlining of runST too early.\n\n-- Spectral Norm benchmark\n\nimport Data.Array\nimport System.Environment (getArgs)\n\nmain = do\n        --[arg] <- getArgs\n        --let n = (read arg) - 1 \n        let n = 80\n        let init = listArray (0,n) (repeat 1.0)\n        let (v:u:rest) = drop 19 $ iterate (eval_AtA_times_u n) init\n        let vBv = sum [(u!i)*(v!i) |i<-[0..n]]\n        let vv  = sum [(v!i)*(v!i) |i<-[0..n]]\n        print $ sqrt (vBv/vv)\n\neval_AtA_times_u n u = eval_At_times_u n v\n    where v = eval_A_times_u n u\n\neval_A x y = 1.0/((i+j)*(i+j+1)/2+i+1)\n    where i = fromIntegral x\n          j = fromIntegral y\n\neval_A_times_u n u = accumArray (+) 0 (0,n)\n                     [(i,(eval_A i j) * u!j)|i<-[0..n], j<-[0..n]]\n\neval_At_times_u n u = accumArray (+) 0 (0,n)\n                      [(i,(eval_A j i) * u!j)|i<-[0..n], j<-[0..n]]\n \n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for #1131\nimport Control.Monad.ST\nimport Data.Array.ST\nimport Data.Array\nimport System.Mem\n\ntickle :: Int\ntickle = runST (do {\n     x <- newArray_ (0,100) ;\n     (readArray :: STUArray s Int Int -> Int -> ST s Int) x 3\n   })\n\nmain :: IO ()\nmain = do print $ length (replicate 100000 'a')\n          performGC\n          print tickle\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test for trac #2158\n\nimport Data.Array\n\ndata Pos = Pos Integer Integer\n    deriving (Show, Eq, Ord, Ix)\n\nmyBounds :: (Pos, Pos)\nmyBounds = (Pos 0 0, Pos 2 3)\n\nmain :: IO ()\nmain = do print $ range myBounds\n          print $ index myBounds (Pos 0 0)\n          print $ index myBounds (Pos 0 1)\n          print $ index myBounds (Pos 0 2)\n          print $ index myBounds (Pos 0 3)\n          print $ index myBounds (Pos 1 0)\n          print $ index myBounds (Pos 1 1)\n          print $ index myBounds (Pos 1 2)\n          print $ index myBounds (Pos 1 3)\n          print $ index myBounds (Pos 2 0)\n          print $ index myBounds (Pos 2 1)\n          print $ index myBounds (Pos 2 2)\n          print $ index myBounds (Pos 2 3)\n          print $ listArray myBounds [(123 :: Integer) ..]\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples, ScopedTypeVariables #-}\n\nmodule Main where\n\nimport GHC.Prim\nimport GHC.Base\nimport GHC.ST\nimport GHC.Word\nimport Control.Monad\nimport System.Mem\n\ndata MutableByteArray s = MutableByteArray (MutableByteArray# s)\n\ndata ByteArray e = ByteArray ByteArray#\n\nnewByteArray :: Int -> ST s (MutableByteArray s)\nnewByteArray (I# n#)\n  = ST $ \\s# -> case newByteArray# n# s# of\n           (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #)\n\nwriteByteArray :: MutableByteArray s -> Int -> Word32 -> ST s ()\nwriteByteArray (MutableByteArray mba#) (I# i#) (W32# w#)\n  = ST $ \\s# -> case writeWord32Array# mba# i# w# s# of\n           s'# -> (# s'#, () #)\n\nindexArray :: ByteArray Word32 -> Int -> Word32\nindexArray (ByteArray arr#) (I# i#)\n  = W32# (indexWord32Array# arr# i#)\n\nunsafeFreezeByteArray :: MutableByteArray s -> ST s (ByteArray e)\nunsafeFreezeByteArray (MutableByteArray mba#)\n  = ST $ \\s# -> case unsafeFreezeByteArray# mba# s# of\n           (# s'#, ba# #)  -> (# s'#, ByteArray ba# #)\n\ndata MutableArrayArray s e = MutableArrayArray (MutableArrayArray# s)\n\ndata ArrayArray e = ArrayArray ArrayArray#\n\nnewArrayArray :: Int -> ST s (MutableArrayArray s e)\nnewArrayArray (I# n#)\n  = ST $ \\s# -> case newArrayArray# n# s# of\n           (# s'#, arr# #) -> (# s'#, MutableArrayArray arr# #)\n\nwriteArrayArrayMut :: MutableArrayArray s (MutableByteArray s) -> Int -> MutableByteArray s\n                -> ST s ()\nwriteArrayArrayMut (MutableArrayArray arrs#) (I# i#) (MutableByteArray mba#)\n  = ST $ \\s# -> case writeMutableByteArrayArray# arrs# i# mba# s# of\n           s'# -> (# s'#, () #)\n\nwriteArrayArray :: MutableArrayArray s (ByteArray s) -> Int -> ByteArray s\n                -> ST s ()\nwriteArrayArray (MutableArrayArray arrs#) (I# i#) (ByteArray ba#)\n  = ST $ \\s# -> case writeByteArrayArray# arrs# i# ba# s# of\n           s'# -> (# s'#, () #)\n\nreadArrayArray :: MutableArrayArray s (MutableByteArray s) -> Int -> ST s (MutableByteArray s)\nreadArrayArray (MutableArrayArray arrs#) (I# i#)\n  = ST $ \\s# -> case readMutableByteArrayArray# arrs# i# s# of\n           (# s'#, mba# #) -> (# s'#, MutableByteArray mba# #)\n\nindexArrayArray :: ArrayArray (ByteArray e) -> Int -> ByteArray e\nindexArrayArray (ArrayArray arrs#) (I# i#)\n  = ByteArray (indexByteArrayArray# arrs# i#)\n\nunsafeFreezeArrayArray :: MutableArrayArray s e -> ST s (ArrayArray e)\nunsafeFreezeArrayArray (MutableArrayArray marrs#)\n  = ST $ \\s# -> case unsafeFreezeArrayArray# marrs# s# of\n           (# s'#, arrs# #)  -> (# s'#, ArrayArray arrs# #)\n\nunsafeDeepFreezeArrayArray :: forall s e\n                           .  MutableArrayArray s (MutableByteArray s) \n                           -> ST s (ArrayArray (ByteArray e))\nunsafeDeepFreezeArrayArray marrs@(MutableArrayArray marrs#)\n  = do { let n = I# (sizeofMutableArrayArray# marrs#)\n             marrs_halfFrozen = MutableArrayArray marrs#  -- :: MutableArrayArray s (ByteArray e)\n       ; mapM_ (freezeSubArray marrs_halfFrozen) [0..n - 1]\n       ; unsafeFreezeArrayArray marrs_halfFrozen\n       }\n  where\n    freezeSubArray marrs_halfFrozen i\n      = do { mba <- readArrayArray marrs i\n           ; ba  <- unsafeFreezeByteArray mba\n           ; writeArrayArray marrs_halfFrozen i ba\n           }\n\nnewByteArrays :: [Int] -> ST s (MutableArrayArray s (MutableByteArray s))\nnewByteArrays ns\n  = do { arrs <- newArrayArray (length ns)\n       ; zipWithM_ (writeNewByteArray arrs) ns [0..]\n       ; return arrs\n       }\n  where\n    writeNewByteArray arrs n i\n      = do { mba <- newByteArray (n * 4)    -- we store 32-bit words\n           ; writeArrayArrayMut arrs i mba\n           }\n\ntype UnboxedArray2D e = ArrayArray (ByteArray e)\n\nnewUnboxedArray2D :: [[Word32]] -> UnboxedArray2D Word32\nnewUnboxedArray2D values\n  = runST $\n    do { marrs <- newByteArrays (map length values)\n       ; zipWithM_ (fill marrs) values [0..]\n       ; arrs <- unsafeDeepFreezeArrayArray marrs\n       ; return arrs\n       }\n  where\n    fill marrs vs i\n      = do { mba <- readArrayArray marrs i\n           ; zipWithM_ (writeByteArray mba) [0..] vs\n           }\n\nunboxedArray2D :: UnboxedArray2D Word32\nunboxedArray2D \n  = newUnboxedArray2D\n    [ [1..10]\n    , [11..200]\n    , []\n    , [1..1000] ++ [42] ++ [1001..2000]\n    , [1..100000]\n    ]\n\nindexUnboxedArray2D :: UnboxedArray2D Word32 -> (Int, Int) -> Word32\nindexUnboxedArray2D arr (i, j)\n  = indexArrayArray arr i `indexArray` j\n\nmain \n  = do { print $ unboxedArray2D `indexUnboxedArray2D` (3, 1000)\n       ; performGC\n       ; print $ unboxedArray2D `indexUnboxedArray2D` (3, 1000)\n       }\n", "num_lines": 133}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nf :: Arrow a => a (Int,Int,Int) Int\nf = proc (x,y,z) -> returnA -< x+y\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nf :: ArrowApply a => a (a Int Int,Int,Int) Int\nf = proc (x,y,z) -> x -<< 2+y\n\ng :: ArrowApply a => Int -> a (a Int Int,Int) Int\ng y = proc (x,z) -> x -<< 2+y\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\ng :: Arrow a => a Int c -> a Int c\ng f = proc b -> f -< b+2\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\n-- variables bound inside the left argument of -< should be in scope\n\nimport Control.Arrow\n\nf :: (Num b, Arrow a) => a b b\nf = proc x -> arr (\\y -> y-1) -< x\n\ng :: (Num b, Arrow a) => a b b\ng = proc x -> (proc y -> returnA -< y-1) -< x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nh :: ArrowChoice a => Int -> a (Int,Int) Int\nh x = proc (y,z) -> case compare x y of\n        LT -> returnA -< x\n        EQ -> returnA -< y+z\n        GT -> returnA -< z+x\n\ng :: ArrowChoice a => Int -> a (Int,Int) Int\ng x = proc (y,z) -> (case compare x y of\n        LT -> \\ a -> returnA -< x+a\n        EQ -> \\ b -> returnA -< y+z+b\n        GT -> \\ c -> returnA -< z+x\n    ) 1\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nf :: Arrow a => a (Int,Int,Int) Int\nf = proc (x,y,z) -> returnA -< x+y\n\ng :: Arrow a => Int -> a Int Int\ng x = proc y -> returnA -< x*y\n\nh :: Arrow a => Int -> a (Int,Int) Int\nh x = proc (y,z) -> do\n        a <- f -< (x,y,3)\n        b <- g (2+x) -< y+a\n        returnA -< a*b+z\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nf :: Arrow a => a (Int,Int) Int\nf = proc (x,y) -> do\n        let z = x*y\n        returnA -< y+z\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\n-- test for out-size tuples: takes a _long_ time to compile\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\ndata T1 = C1\ndata T2 = C2\ndata T3 = C3\ndata T4 = C4\ndata T5 = C5\ndata T6 = C6\ndata T7 = C7\ndata T8 = C8\ndata T9 = C9\ndata T10 = C10\ndata T11 = C11\ndata T12 = C12\ndata T13 = C13\ndata T14 = C14\ndata T15 = C15\ndata T16 = C16\ndata T17 = C17\ndata T18 = C18\ndata T19 = C19\ndata T20 = C20\ndata T21 = C21\ndata T22 = C22\ndata T23 = C23\ndata T24 = C24\ndata T25 = C25\ndata T26 = C26\ndata T27 = C27\ndata T28 = C28\ndata T29 = C29\ndata T30 = C30\ndata T31 = C31\ndata T32 = C32\ndata T33 = C33\ndata T34 = C34\ndata T35 = C35\ndata T36 = C36\ndata T37 = C37\ndata T38 = C38\ndata T39 = C39\ndata T40 = C40\ndata T41 = C41\ndata T42 = C42\ndata T43 = C43\ndata T44 = C44\ndata T45 = C45\ndata T46 = C46\ndata T47 = C47\ndata T48 = C48\ndata T49 = C49\ndata T50 = C50\ndata T51 = C51\ndata T52 = C52\ndata T53 = C53\ndata T54 = C54\ndata T55 = C55\ndata T56 = C56\ndata T57 = C57\ndata T58 = C58\ndata T59 = C59\ndata T60 = C60\ndata T61 = C61\ndata T62 = C62\ndata T63 = C63\ndata T64 = C64\ndata T65 = C65\ndata T66 = C66\ndata T67 = C67\ndata T68 = C68\ndata T69 = C69\ndata T70 = C70\n\nf :: Arrow a => a Int Int\nf = proc x0 -> do\n        x1 <- returnA -< C1\n        x2 <- returnA -< C2\n        x3 <- returnA -< C3\n        x4 <- returnA -< C4\n        x5 <- returnA -< C5\n        x6 <- returnA -< C6\n        x7 <- returnA -< C7\n        x8 <- returnA -< C8\n        x9 <- returnA -< C9\n        x10 <- returnA -< C10\n        x11 <- returnA -< C11\n        x12 <- returnA -< C12\n        x13 <- returnA -< C13\n        x14 <- returnA -< C14\n        x15 <- returnA -< C15\n        x16 <- returnA -< C16\n        x17 <- returnA -< C17\n        x18 <- returnA -< C18\n        x19 <- returnA -< C19\n        x20 <- returnA -< C20\n        x21 <- returnA -< C21\n        x22 <- returnA -< C22\n        x23 <- returnA -< C23\n        x24 <- returnA -< C24\n        x25 <- returnA -< C25\n        x26 <- returnA -< C26\n        x27 <- returnA -< C27\n        x28 <- returnA -< C28\n        x29 <- returnA -< C29\n        x30 <- returnA -< C30\n        x31 <- returnA -< C31\n        x32 <- returnA -< C32\n        x33 <- returnA -< C33\n        x34 <- returnA -< C34\n        x35 <- returnA -< C35\n        x36 <- returnA -< C36\n        x37 <- returnA -< C37\n        x38 <- returnA -< C38\n        x39 <- returnA -< C39\n        x40 <- returnA -< C40\n        x41 <- returnA -< C41\n        x42 <- returnA -< C42\n        x43 <- returnA -< C43\n        x44 <- returnA -< C44\n        x45 <- returnA -< C45\n        x46 <- returnA -< C46\n        x47 <- returnA -< C47\n        x48 <- returnA -< C48\n        x49 <- returnA -< C49\n        x50 <- returnA -< C50\n        x51 <- returnA -< C51\n        x52 <- returnA -< C52\n        x53 <- returnA -< C53\n        x54 <- returnA -< C54\n        x55 <- returnA -< C55\n        x56 <- returnA -< C56\n        x57 <- returnA -< C57\n        x58 <- returnA -< C58\n        x59 <- returnA -< C59\n        x60 <- returnA -< C60\n        x61 <- returnA -< C61\n        x62 <- returnA -< C62\n        x63 <- returnA -< C63\n        x64 <- returnA -< C64\n        x65 <- returnA -< C65\n        x66 <- returnA -< C66\n        x67 <- returnA -< C67\n        x68 <- returnA -< C68\n        x69 <- returnA -< C69\n        x70 <- returnA -< C70\n        returnA -< x70\n        returnA -< x69\n        returnA -< x68\n        returnA -< x67\n        returnA -< x66\n        returnA -< x65\n        returnA -< x64\n        returnA -< x63\n        returnA -< x62\n        returnA -< x61\n        returnA -< x60\n        returnA -< x59\n        returnA -< x58\n        returnA -< x57\n        returnA -< x56\n        returnA -< x55\n        returnA -< x54\n        returnA -< x53\n        returnA -< x52\n        returnA -< x51\n        returnA -< x50\n        returnA -< x49\n        returnA -< x48\n        returnA -< x47\n        returnA -< x46\n        returnA -< x45\n        returnA -< x44\n        returnA -< x43\n        returnA -< x42\n        returnA -< x41\n        returnA -< x40\n        returnA -< x39\n        returnA -< x38\n        returnA -< x37\n        returnA -< x36\n        returnA -< x35\n        returnA -< x34\n        returnA -< x33\n        returnA -< x32\n        returnA -< x31\n        returnA -< x30\n        returnA -< x29\n        returnA -< x28\n        returnA -< x27\n        returnA -< x26\n        returnA -< x25\n        returnA -< x24\n        returnA -< x23\n        returnA -< x22\n        returnA -< x21\n        returnA -< x20\n        returnA -< x19\n        returnA -< x18\n        returnA -< x17\n        returnA -< x16\n        returnA -< x15\n        returnA -< x14\n        returnA -< x13\n        returnA -< x12\n        returnA -< x11\n        returnA -< x10\n        returnA -< x9\n        returnA -< x8\n        returnA -< x7\n        returnA -< x6\n        returnA -< x5\n        returnA -< x4\n        returnA -< x3\n        returnA -< x2\n        returnA -< x1\n        returnA -< x0\n", "num_lines": 223}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nhandle :: ArrowPlus a => a (b,s) c -> a (b,(String,s)) c -> a (b,s) c\nhandle f h = proc (b,s) -> (f -< (b,s)) <+> (h -< (b,(\"FAIL\",s)))\n\nf :: ArrowPlus a => a (Int,Int) String\nf = proc (x,y) ->\n  (|handle\n    (returnA -< show y)\n    (\\s -> returnA -< s ++ show x)\n  |)\n\ng :: ArrowPlus a => a (Int,Int) String\ng = proc (x,y) ->\n  (|handle\n    (\\msg -> returnA -< msg ++ show y)\n    (\\s msg -> returnA -< s ++ show x)\n  |) (\"hello \" ++ show x)\n\nh :: ArrowPlus a => a (Int,Int) Int\nh = proc (x,y) ->\n  (\n    (\\z -> returnA -< x + z)\n    <+>\n    (\\z -> returnA -< y + z)\n  ) (x*y)\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nf :: ArrowChoice a => a (Int,Int,Int) Int\nf = proc (x,y,z) -> if x < y then returnA -< x+y else returnA -< x+z\n\ng :: ArrowChoice a => Int -> a (Int,Int) Int\ng x = proc (y,z) -> if x < y then returnA -< x+y else returnA -< x+z\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\n\nf :: Arrow a => a (Int,Int) Int\nf = proc (x,y) -> let z = x*y in returnA -< y+z\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n{-# OPTIONS -fno-warn-redundant-constraints #-}\n\n-- Test for Trac #1662\n\nmodule Arrow where\n\nimport Control.Arrow\n\nexpr' :: Arrow a => a Int Int\nexpr' = error \"urk\"\n\nterm :: Arrow a => a () Int\nterm = error \"urk\"\n\nexpr1 :: Arrow a => a () Int\nexpr1 = proc () -> do\n          x <- term -< ()\n          expr' -< x\n\nexpr2 :: Arrow a => a () Int\nexpr2 = proc y -> do\n          x <- term -< y\n          expr' -< x\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldCompile where\n\nimport Control.Arrow\nimport Data.Char\n\nf :: ArrowLoop a => a Char Int\nf = proc x -> do\n        a <- returnA -< ord x\n        rec     b <- returnA -< ord c - ord x\n                c <- returnA -< chr a\n        returnA -< b + ord c\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows, ViewPatterns #-}\n\nmodule T3964 where\n\nimport Control.Arrow\n\ntestF :: Eq a => a -> (Maybe (Maybe a)) -> Maybe a\ntestF v = proc x -> case x of\n     Just (Just ((==v) -> True)) -> returnA -< Just v\n     _                           -> returnA -< Nothing\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\nmodule T5022 ( pIterate ) where\n\nimport Prelude hiding ( init )\n\nreturnA :: b -> b\nreturnA = id\n\n------------\nnewtype State s a = State { unState :: [a] }\n\n------------\npIterate :: a -> [a]\npIterate =\n    proc x -> do\n      rec\n        as <- unState -< s\n        let s = State (x:as)\n      returnA -< as\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE Arrows, GeneralizedNewtypeDeriving #-}\n\nmodule T5267 where\n\nimport Prelude\nimport Control.Arrow\nimport Control.Category\n\nnewtype A a b c = A { unA :: a b c }\n    deriving (Category, Arrow)\n\nite :: ArrowChoice a\n    => a env Bool -> A a env d -> A a env d -> A a env d\nite iA tA eA = A $ proc env ->\n  do i <- iA -< env\n     if i then unA tA -< env else unA eA -< env\n\nite_perm tA eA i = ite i tA eA\n\n-- In 6.12, this worked:\nite' cA tA eA = proc x ->\n  do c <- cA -< x\n     (| (ite_perm tA eA) (returnA -< c) |)\n\n-- but this didn't:\nite'' cA tA eA = proc x ->\n  do c <- cA -< x\n     (| ite_perm' (returnA -< c) |)\n  where ite_perm' i = ite i tA eA\n\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n-- Failed in ghci\n\nmodule T where\n\nimport Prelude\nimport Control.Arrow\n\nmapAC :: Arrow arr => Int -> arr (env, (b,())) c -> arr (env, ([b],())) [c]  \nmapAC n farr = go 0\n  where\n    go i | i == n = arr (\\(_env, ([], ())) -> [])\n         | otherwise = proc ~(env, (b : bs, ())) ->\n             do c  <- farr -< (env, (b, ()))\n                cs <- go (i+1) -< (env, (bs, ()))\n                returnA -< c : cs\n\nt :: Arrow arr => arr [a] [a]\nt = proc ys ->\n     (| (mapAC 3) (\\y -> returnA -< y) |) ys\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}\nmodule T5333 where\n\nimport Prelude hiding ( id, (.) )\nimport Control.Arrow\n\ncc1 :: a e b -> a e b -> a e b\ncc1 = undefined\n\n-- With GHC < 7.10.1, the following compile failures occured:\n--\n-- ghc: panic! (the 'impossible' happened)\n--  (GHC version 7.8.4 for x86_64-unknown-linux):\n--  mkCmdEnv Not found: base:GHC.Desugar.>>>{v 02V}\n\n-- 'g' fails to compile.\ng = proc (x, y, z) ->\n   ((returnA -< x) &&& (returnA -< y) &&& (returnA -< z))\n\n-- 'f' compiles:\n--   - without an infix declaration\n--   - with the infixl declaration\n-- and fails with the infixr declaration\ninfixr 6 `cc1`\n-- infixl 6 `cc1`\n\nf = proc (x, y, z) ->\n  ((returnA -< x) `cc1` (returnA -< y) `cc1` (returnA -< z))\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE Arrows, ExistentialQuantification #-}\n\n-- Crashed GHC 6.4 with a lint error\n-- because of the existential\n\n-- Esa Pulkkinen <esa.pulkkinen@kotiposti.net>\n-- Thomas J\u00c3\u00a4ger <ThJaeger@gmail.com>\n\nmodule ShouldFail where\n\nclass Foo a where foo :: a -> ()\ndata Bar = forall a. Foo a => Bar a\n\nget :: Bar -> ()\nget = proc x -> case x of Bar a -> foo -< a\n\n-- This should be rejected because the left side of -< (here foo)\n-- should be treated as being outside the scope of the proc: it can't\n-- refer to the local variables x and a (this is enforced), nor the\n-- existentially quantified type variable introduced by unwrapping x.\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule ShouldFail where\n\ng :: Int -> Int\ng = proc x -> f x -< x+1\n  where f = (*)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n-- Arrow commands where an expression is expected\n\nmodule ShouldFail where\n\nimport Control.Arrow\n\nfoo = returnA -< []\nbar = (|zeroArrow|)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows, ExistentialQuantification #-}\n\n-- Trac #1662\n\nmodule ShouldFail where\n\nimport Control.Arrow\n\ndata T = forall a. T a\n\npanic :: (Arrow arrow) => arrow T T\npanic = proc (T x) -> do returnA -< T x", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XArrows -XRecursiveDo#-}\n-- Test Trac #2111\n\nmodule Foo where\n\nfoo = do { rec { x <- undefined -< x }; undefined -< x }\n\nbar1 = do { rec { x <- return ('a':x); }; putStrLn (take 20 x) }\n\nbar2 = mdo { rec { x <- return ('a':x); }; putStrLn (take 20 x) }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE Arrows #-}\n\nmodule T5380 where\n\ntestB :: not_bool -> (() -> ()) -> () -> not_unit\ntestB b f = proc () -> if b then f -< () else f -< ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\n-- Toy lambda-calculus interpreter from John Hughes's arrows paper (s5)\n\nmodule Main(main) where\n\nimport Data.Maybe(fromJust)\nimport Control.Arrow\n\ntype Id = String\ndata Val a = Num Int | Bl Bool | Fun (a (Val a) (Val a))\ndata Exp = Var Id | Add Exp Exp | If Exp Exp Exp | Lam Id Exp | App Exp Exp\n\neval :: (ArrowChoice a, ArrowApply a) => Exp -> a [(Id, Val a)] (Val a)\neval (Var s) = proc env ->\n                returnA -< fromJust (lookup s env)\neval (Add e1 e2) = proc env -> do\n                ~(Num u) <- eval e1 -< env\n                ~(Num v) <- eval e2 -< env\n                returnA -< Num (u + v)\neval (If e1 e2 e3) = proc env -> do\n                ~(Bl b) <- eval e1 -< env\n                if b    then eval e2 -< env\n                        else eval e3 -< env\neval (Lam x e) = proc env ->\n                returnA -< Fun (proc v -> eval e -< (x,v):env)\neval (App e1 e2) = proc env -> do\n                ~(Fun f) <- eval e1 -< env\n                v <- eval e2 -< env\n                f -<< v\n\n-- some tests\n\ni = Lam \"x\" (Var \"x\")\nk = Lam \"x\" (Lam \"y\" (Var \"x\"))\ndouble = Lam \"x\" (Add (Var \"x\") (Var \"x\"))\n\n-- if b then k (double x) x else x + x + x\n\ntext_exp = If (Var \"b\")\n                (App (App k (App double (Var \"x\"))) (Var \"x\"))\n                (Add (Var \"x\") (Add (Var \"x\") (Var \"x\")))\n\nunNum (Num n) = n\n\nmain = do\n        print (unNum (eval text_exp [(\"b\", Bl True), (\"x\", Num 5)]))\n        print (unNum (eval text_exp [(\"b\", Bl False), (\"x\", Num 5)]))\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\n-- Homogeneous (or depth-preserving) functions over perfectly balanced trees.\n\nmodule Main where\n\nimport Control.Arrow\nimport Control.Category\nimport Data.Complex\nimport Prelude hiding (id, (.))\n\ninfixr 4 :&:\n\n-- Consider the following non-regular type of perfectly balanced trees,\n-- or `powertrees' (cf Jayadev Misra's powerlists):\n\ndata Pow a = Zero a | Succ (Pow (Pair a))\n        deriving Show\n\ntype Pair a = (a, a)\n\n-- Here are some example elements:\n\ntree0 = Zero 1\ntree1 = Succ (Zero (1, 2))\ntree2 = Succ (Succ (Zero ((1, 2), (3, 4))))\ntree3 = Succ (Succ (Succ (Zero (((1, 2), (3, 4)), ((5, 6), (7, 8))))))\n\n-- The elements of this type have a string of constructors expressing\n-- a depth n as a Peano numeral, enclosing a nested pair tree of 2^n\n-- elements.  The type definition ensures that all elements of this type\n-- are perfectly balanced binary trees of this form.  (Such things arise\n-- in circuit design, eg Ruby, and descriptions of parallel algorithms.)\n-- And the type system will ensure that all legal programs preserve\n-- this structural invariant.\n--\n-- The only problem is that the type constraint is too restrictive, rejecting\n-- many of the standard operations on these trees.  Typically you want to\n-- split a tree into two subtrees, do some processing on the subtrees and\n-- combine the results.  But the type system cannot discover that the two\n-- results are of the same depth (and thus combinable).  We need a type\n-- that says a function preserves depth.  Here it is:\n\ndata Hom a b = (a -> b) :&: Hom (Pair a) (Pair b)\n\n-- A homogeneous (or depth-preserving) function is an infinite sequence of\n-- functions of type Pair^n a -> Pair^n b, one for each depth n.  We can\n-- apply a homogeneous function to a powertree by selecting the function\n-- for the required depth:\n\napply :: Hom a b -> Pow a -> Pow b\napply (f :&: fs) (Zero x) = Zero (f x)\napply (f :&: fs) (Succ t) = Succ (apply fs t)\n\n-- Having defined apply, we can forget about powertrees and do all our\n-- programming with Hom's.  Firstly, Hom is an arrow:\n\ninstance Category Hom where\n        id = id :&: id\n        (f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs)\n\ninstance Arrow Hom where\n        arr f = f :&: arr (f *** f)\n        first (f :&: fs) =\n                first f :&: (arr transpose >>> first fs >>> arr transpose)\n\ntranspose :: ((a,b), (c,d)) -> ((a,c), (b,d))\ntranspose ((a,b), (c,d)) = ((a,c), (b,d))\n\n-- arr maps f over the leaves of a powertree.\n\n-- The composition >>> composes sequences of functions pairwise.\n--\n-- The *** operator unriffles a powertree of pairs into a pair of powertrees,\n-- applies the appropriate function to each and riffles the results.\n-- It defines a categorical product for this arrow category.\n\n-- When describing algorithms, one often provides a pure function for the\n-- base case (trees of one element) and a (usually recursive) expression\n-- for trees of pairs.\n\n-- For example, a common divide-and-conquer pattern is the butterfly, where\n-- one recursive call processes the odd-numbered elements and the other\n-- processes the even ones (cf Geraint Jones and Mary Sheeran's Ruby papers):\n\nbutterfly :: (Pair a -> Pair a) -> Hom a a\nbutterfly f = id :&: proc (x, y) -> do\n                x' <- butterfly f -< x\n                y' <- butterfly f -< y\n                returnA -< f (x', y')\n\n-- The recursive calls operate on halves of the original tree, so the\n-- recursion is well-defined.\n\n-- Some examples of butterflies:\n\nrev :: Hom a a\nrev = butterfly swap\n        where   swap (x, y) = (y, x)\n\nunriffle :: Hom (Pair a) (Pair a)\nunriffle = butterfly transpose\n\n-- Batcher's sorter for bitonic sequences:\n\nbisort :: Ord a => Hom a a\nbisort = butterfly cmp\n        where   cmp (x, y) = (min x y, max x y)\n\n-- This can be used (with rev) as the merge phase of a merge sort.\n--\nsort :: Ord a => Hom a a\nsort = id :&: proc (x, y) -> do\n                x' <- sort -< x\n                y' <- sort -< y\n                yr <- rev -< y'\n                p <- unriffle -< (x', yr)\n                bisort2 -< p\n        where _ :&: bisort2 = bisort\n\n-- Here is the scan operation, using the algorithm of Ladner and Fischer:\n\nscan :: (a -> a -> a) -> a -> Hom a a\nscan op b = id :&: proc (x, y) -> do\n                y' <- scan op b -< op x y\n                l <- rsh b -< y'\n                returnA -< (op l x, y')\n\n-- The auxiliary function rsh b shifts each element in the tree one place to\n-- the right, placing b in the now-vacant leftmost position, and discarding\n-- the old rightmost element:\n\nrsh :: a -> Hom a a\nrsh b = const b :&: proc (x, y) -> do\n                w <- rsh b -< y\n                returnA -< (w, x)\n\n-- Finally, here is the Fast Fourier Transform:\n\ntype C = Complex Double\n\nfft :: Hom C C\nfft = id :&: proc (x, y) -> do\n                x' <- fft -< x\n                y' <- fft -< y\n                r <- roots (-1) -< ()\n                let z = r*y'\n                unriffle -< (x' + z, x' - z)\n\n-- The auxiliary function roots r (where r is typically a root of unity)\n-- populates a tree of size n (necessarily a power of 2) with the values\n-- 1, w, w^2, ..., w^(n-1), where w^n = r.\n\nroots :: C -> Hom () C\nroots r = const 1 :&: proc _ -> do\n                x <- roots r' -< ()\n                unriffle -< (x, x*r')\n        where   r' = if imagPart s >= 0 then -s else s\n                s = sqrt r\n\n-- Miscellaneous functions:\n\nrrot :: Hom a a\nrrot = id :&: proc (x, y) -> do\n                w <- rrot -< y\n                returnA -< (w, x)\n\nilv :: Hom a a -> Hom (Pair a) (Pair a)\nilv f = proc (x, y) -> do\n                x' <- f -< x\n                y' <- f -< y\n                returnA -< (x', y')\n\nscan' :: (a -> a -> a) -> a -> Hom a a\nscan' op b = proc x -> do\n                l <- rsh b -< x\n                (id :&: ilv (scan' op b)) -< op l x\n\nriffle :: Hom (Pair a) (Pair a)\nriffle = id :&: proc ((x1, y1), (x2, y2)) -> do\n                x <- riffle -< (x1, x2)\n                y <- riffle -< (y1, y2)\n                returnA -< (x, y)\n\ninvert :: Hom a a\ninvert = id :&: proc (x, y) -> do\n                x' <- invert -< x\n                y' <- invert -< y\n                unriffle -< (x', y')\n\ncarryLookaheadAdder :: Hom (Bool, Bool) Bool\ncarryLookaheadAdder = proc (x, y) -> do\n                carryOut <- rsh (Just False) -<\n                        if x == y then Just x else Nothing\n                Just carryIn <- scan plusMaybe Nothing -< carryOut\n                returnA -< x `xor` y `xor` carryIn\n        where   plusMaybe x Nothing = x\n                plusMaybe x (Just y) = Just y\n                False `xor` b = b\n                True `xor` b = not b\n\n-- Global conditional for SIMD\n\nifAll :: Hom a b -> Hom a b -> Hom (a, Bool) b\nifAll fs gs = ifAllAux snd (arr fst >>> fs) (arr fst >>> gs)\n        where   ifAllAux :: (a -> Bool) -> Hom a b -> Hom a b -> Hom a b\n                ifAllAux p (f :&: fs) (g :&: gs) =\n                        liftIf p f g :&: ifAllAux (liftAnd p) fs gs\n                liftIf p f g x = if p x then f x else g x\n                liftAnd p (x, y) = p x && p y\n\nmaybeAll :: Hom a c -> Hom (a, b) c -> Hom (a, Maybe b) c\nmaybeAll (n :&: ns) (j :&: js) =\n        choose :&: (arr dist >>> maybeAll ns (arr transpose >>> js))\n        where   choose (a, Nothing) = n a\n                choose (a, Just b) = j (a, b)\n                dist ((a1, b1), (a2, b2)) = ((a1, a2), zipMaybe b1 b2)\n                zipMaybe (Just x) (Just y) = Just (x, y)\n                zipMaybe _ _ = Nothing\n\nmain = do\n        print (apply rev tree3)\n        print (apply invert tree3)\n        print (apply (invert >>> sort) tree3)\n        print (apply (scan (+) 0) tree3)\n", "num_lines": 226}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule Main(main) where\n\nimport Control.Arrow\nimport Control.Category\nimport Prelude hiding (id, (.))\n\nclass ArrowLoop a => ArrowCircuit a where\n        delay :: b -> a b b\n\n-- stream map instance\n\ndata Stream a = Cons a (Stream a)\n\ninstance Functor Stream where\n        fmap f ~(Cons a as) = Cons (f a) (fmap f as)\n\nzipStream :: Stream a -> Stream b -> Stream (a,b)\nzipStream ~(Cons a as) ~(Cons b bs) = Cons (a,b) (zipStream as bs)\n\nunzipStream :: Stream (a,b) -> (Stream a, Stream b)\nunzipStream abs = (fmap fst abs, fmap snd abs)\n\nnewtype StreamMap a b = StreamMap (Stream a -> Stream b)\nunStreamMap (StreamMap f) = f\n\ninstance Category StreamMap where\n        id = StreamMap id\n        StreamMap f . StreamMap g = StreamMap (f . g)\n\ninstance Arrow StreamMap where\n        arr f = StreamMap (fmap f)\n        first (StreamMap f) =\n                StreamMap (uncurry zipStream . first f . unzipStream)\n\ninstance ArrowLoop StreamMap where\n        loop (StreamMap f) =\n                StreamMap (loop (unzipStream . f . uncurry zipStream))\n\ninstance ArrowCircuit StreamMap where\n        delay a = StreamMap (Cons a)\n\nlistToStream :: [a] -> Stream a\nlistToStream = foldr Cons undefined\n\nstreamToList :: Stream a -> [a]\nstreamToList (Cons a as) = a:streamToList as\n\nrunStreamMap :: StreamMap a b -> [a] -> [b]\nrunStreamMap (StreamMap f) as =\n        take (length as) (streamToList (f (listToStream as)))\n\n-- simple automaton instance\n\ndata Auto a b = Auto (a -> (b, Auto a b))\n\ninstance Category Auto where\n        id = Auto $ \\a -> (a, id)\n        Auto f . Auto g = Auto $ \\b ->\n                                let     (c, g') = g b\n                                        (d, f') = f c\n                                in      (d, f' . g')\n\ninstance Arrow Auto where\n        arr f = Auto $ \\a -> (f a, arr f)\n        first (Auto f) = Auto $ \\(b,d) -> let (c,f') = f b in ((c,d), first f')\n\ninstance ArrowLoop Auto where\n        loop (Auto f) = Auto $ \\b ->\n                let     (~(c,d), f') = f (b,d)\n                in      (c, loop f')\n\ninstance ArrowCircuit Auto where\n        delay a = Auto $ \\a' -> (a, delay a')\n\nrunAuto :: Auto a b -> [a] -> [b]\nrunAuto (Auto f) [] = []\nrunAuto (Auto f) (a:as) = let (b, f') = f a in b:runAuto f' as\n\n-- Some simple example circuits\n\n-- A resettable counter (first example in several Hawk papers):\n\ncounter :: ArrowCircuit a => a Bool Int\ncounter = proc reset -> do\n        rec     output <- returnA -< if reset then 0 else next\n                next <- delay 0 -< output+1\n        returnA -< output\n\n-- Some other basic circuits from the Hawk library.\n\n-- flush: when reset is True, return d for n ticks, otherwise copy value.\n-- (a variation on the resettable counter)\n\nflush :: ArrowCircuit a => Int -> b -> a (b, Bool) b\nflush n d = proc (value, reset) -> do\n        rec     count <- returnA -< if reset then n else max (next-1) 0\n                next <- delay 0 -< count\n        returnA -< if count > 0 then d else value\n\n-- latch: on each tick, return the last value for which reset was True,\n-- or init if there was none.\n--\nlatch :: ArrowCircuit a => b -> a (b, Bool) b\nlatch init = proc (value, reset) -> do\n        rec     out <- returnA -< if reset then value else last\n                last <- delay init -< out\n        returnA -< out\n\n-- Some tests using the counter\n\ntest_input = [True, False, True, False, False, True, False, True]\ntest_input2 = zip [1..] test_input\n\n-- A test of the resettable counter.\n\nmain = do\n        print (runStreamMap counter test_input)\n        print (runAuto counter test_input)\n        print (runStreamMap (flush 2 0) test_input2)\n        print (runAuto (flush 2 0) test_input2)\n        print (runStreamMap (latch 0) test_input2)\n        print (runAuto (latch 0) test_input2)\n\n-- A step function (cf current in Lustre)\n\nstep :: ArrowCircuit a => b -> a (Either b c) b\nstep b = proc x -> do\n                rec     last_b <- delay b -< getLeft last_b x\n                returnA -< last_b\n        where   getLeft _ (Left b) = b\n                getLeft b (Right _) = b\n", "num_lines": 134}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows, MultiParamTypeClasses, FlexibleInstances #-}\n\n-- Simple expression parser\n-- (uses do-notation and operators)\n\nmodule Main(main) where\n\nimport Control.Arrow\nimport Control.Category\nimport Data.Char\nimport Prelude hiding (id, (.))\n\n-- Parsers\n\nclass (Eq s, Show s, ArrowPlus a) => ArrowParser s a where\n        symbol :: s -> a b String\n\ndata Sym s = Sym { token :: s, value :: String }\n\n-- Simple backtracking instance\n\nnewtype BTParser s a b = BTParser (a -> [Sym s] -> [(b, [Sym s])])\n\ninstance Category (BTParser s) where\n        id = BTParser $ \\a ss -> [(a, ss)]\n        BTParser f . BTParser g = BTParser $ \\b ss ->\n                [(d, ss'') | (c, ss') <- g b ss, (d, ss'') <- f c ss']\n\ninstance Arrow (BTParser s) where\n        arr f = BTParser $ \\a ss -> [(f a, ss)]\n        first (BTParser f) = BTParser $ \\(b,d) ss ->\n                [((c,d), ss') | (c,ss') <- f b ss]\n\ninstance ArrowZero (BTParser s) where\n        zeroArrow = BTParser $ \\b ss -> []\n\ninstance ArrowPlus (BTParser s) where\n        BTParser f <+> BTParser g = BTParser $ \\b ss -> f b ss ++ g b ss\n\ninstance (Eq s, Show s) => ArrowParser s (BTParser s) where\n        symbol s = BTParser $ \\b ss ->\n                case ss of\n                Sym s' v:ss' | s' == s -> [(v, ss')]\n                _ -> []\n\nrunBTParser :: BTParser s () c -> [Sym s] -> c\nrunBTParser (BTParser parser) syms =\n        head [c | (c, []) <- parser () syms]\n\n-- Expressions\n\ndata ESym = LPar | RPar | Plus | Minus | Mult | Div | Number | Unknown\n        deriving (Show, Eq, Ord)\n\ntype ExprParser = BTParser ESym\ntype ExprSym = Sym ESym\n\n-- The grammar\n\nexpr :: ExprParser () Int\nexpr = proc () -> do\n                x <- term -< ()\n                expr' -< x\n\nexpr' :: ExprParser Int Int\nexpr' = proc x -> do\n                returnA -< x\n        <+> do\n                (|(symbol Plus)|)\n                y <- term -< ()\n                expr' -< x + y\n        <+> do\n                (|(symbol Minus)|)\n                y <- term -< ()\n                expr' -< x - y\n\nterm :: ExprParser () Int\nterm = proc () -> do\n                x <- factor -< ()\n                term' -< x\n\nterm' :: ExprParser Int Int\nterm' = proc x -> do\n                returnA -< x\n        <+> do\n                (|(symbol Mult)|)\n                y <- factor -< ()\n                term' -< x * y\n        <+> do\n                (|(symbol Div)|)\n                y <- factor -< ()\n                term' -< x `div` y\n\nfactor :: ExprParser () Int\nfactor = proc () -> do\n                v <- (|(symbol Number)|)\n                returnA -< read v::Int\n        <+> do\n                (|(symbol Minus)|)\n                v <- factor -< ()\n                returnA -< -v\n        <+> do\n                (|(symbol LPar)|)\n                v <- expr -< ()\n                (|(symbol RPar)|)\n                returnA -< v\n\n-- Lexical analysis\n\nlexer :: String -> [ExprSym]\nlexer [] = []\nlexer ('(':cs) = Sym LPar \"(\":lexer cs\nlexer (')':cs) = Sym RPar \")\":lexer cs\nlexer ('+':cs) = Sym Plus \"+\":lexer cs\nlexer ('-':cs) = Sym Minus \"-\":lexer cs\nlexer ('*':cs) = Sym Mult \"*\":lexer cs\nlexer ('/':cs) = Sym Div \"/\":lexer cs\nlexer (c:cs)\n        | isSpace c = lexer cs\n        | isDigit c = Sym Number (c:w):lexer cs'\n        | otherwise = Sym Unknown [c]:lexer cs\n                where (w,cs') = span isDigit cs\n\nparse = runBTParser expr . lexer\n\nmain = do\n        print (parse \"1+2*(3+4)\")\n        print (parse \"3*5-17/3+4\")\n", "num_lines": 129}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE Arrows #-}\n\nimport Control.Arrow\nimport qualified Control.Category as Cat\n\ntest :: Int -> Int\ntest = proc x -> do\n    let neg = x < 0\n    case x of\n        x | neg -> returnA -< 0           -- GHC panics\n        --x | x < 0 -> returnA -< 0       -- GHC doesn't panic\n        _       -> returnA -< 10\n\nmain = do\n    print $ test (-1)\n    print $ test 1\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Q\nmain = print out\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module H where\nx = True\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module I where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod where\nimport A\nh :: Int\nh = g\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M where\nimport A\nf :: T -> String\nf = show\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Indef where\nimport Sig\ndata T = MkT B\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P where\ntype B = Foo\nnewtype Foo = Foo Double\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule TH where\n$( return [] )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Stuff where\n\ndata family T a\n\ndata instance T Int = T Int\n\ntest :: String\ntest =\n  \"test\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Lib where\n\nimport Stuff\n\ndoSomeStuff :: String\ndoSomeStuff =\n  test\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport A.Sig\n\nexclaimA :: A -> String\nexclaimA = (++ \"!\") . showA\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nnewtype A = A { unA :: Int }\n\nshowA :: A -> String\nshowA = show . unA\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language TemplateHaskell #-}\nmodule C where\n\nimport Data.Char (toUpper)\n\nimport A.Sig\nimport B\n\nveryExclaimA :: A -> String\nveryExclaimA = fmap toUpper . exclaimA\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}\n\n-- Sept 16: now failing, beause I've furter reduced the scop\n--          of impredicative types\n\nmodule Base1 where\n-- basic examples of impredicative instantiation of variables\n\ndata MEither a b = MLeft a\n                 | MRight b\n                 | MEmpty\n\ntype Sid = forall a. a -> a\n\n-- no need for impredicativity\ntest0 = MRight id\n\n-- requires impredicativity\ntest1 :: Sid -> MEither Sid b\ntest1 fid = MLeft fid\n\ntest2 :: MEither b Sid -> Maybe (Sid,Sid)\ntest2 m = case (test1 id) of\n             MLeft x -> case m of\n                          MRight y -> Just (x,y)\n                          _ -> Nothing\n             _ -> Nothing\n\ntest3 :: MEither a b -> b\ntest3 (MRight x) = x\n\ntest4 = test3 (test1 id)\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags -XScopedTypeVariables #-}\n\nmodule ShouldCompile where\n\n\n{-------- Examples from the paper ---------}\n\nf :: (forall a. [a] -> a) -> (Int, Char)\nf get = (get [1,2], get ['a', 'b', 'c'])\n\ng :: Maybe (forall a. [a] -> a) -> (Int, Char)\ng Nothing = (0, '0')\ng (Just get) = (get [1,2], get ['a','b','c'])\n\nsing x = [x]\n\nid1 :: forall a. a -> a\nid1 = id\n\n{-\nids :: [forall a. a -> a]\nids = [id1,id1]\n\nt1 :: [forall a. a -> a]\nt1 = tail ids\n\nt2 :: [forall a. a -> a]\nt2 = sing id\n\nt3 :: forall a. a -> a\nt3 = head ids\n-}\n\n{--------------- Examples from QMLF paper -------------------}\n\nqF :: (forall a. a -> a -> a) -> (Bool, Char)\nqF choose = (choose True False, choose 'a' 'b')\n\nqG :: (forall a. a -> a -> a) -> (forall a. a -> a) -> (forall g. (g -> g) -> (g -> g))\nqG choose id = choose id\n\nqH :: (forall a. a -> a -> a) -> (forall a. a -> a) -> (forall b. b -> b) -> (forall b. b -> b)\nqH choose id = choose id\n\nchoose :: forall a. a -> a -> a\nchoose x y = x\n\n{-\nimpred1 :: (Bool, Char)\nimpred1 = qF $ choose  --- impredicative instantiation for $\n\nimpred2 :: (forall a. a -> a -> a) -> (Bool, Char)\nimpred2 = id qF\n-}\n\n{------ Examples for Garrique/Remy paper -------}\n\n--- all of these currently work in GHC with higher-rank types\n\nself1 :: (forall a. a -> a) -> (forall a. a -> a)\nself1 f = f f\n\nself2 :: (forall a. a -> a) -> b -> b\nself2 f = f f\n\ngr1 = self1 id\n\ngr2 = self2 id\n\ngr3 = (\\(u :: (forall a. a -> a) -> (forall a. a -> a)) -> u id) self1\n\n{------------ Church numerals ----------}\n\ntype Church = forall a. a -> (a -> a) -> a\n\nz :: Church\nz = \\z -> \\f -> z\n\ns :: Church -> Church\ns = \\n -> \\z -> \\f -> f (n z f)\n\nfold :: Church -> a -> (a -> a) -> a\nfold n f z = n f z\n\n{-\nmul :: Church -> Church -> Church\nmul m n = \\f -> \\a -> m (n f) a\n\nexp :: Church -> Church -> Church\nexp m n = n (mul m) (s z)\n\nidC :: Church -> Church\nidC x = fold x s z\n\ninc :: Church -> Church\ninc x = fold x s (s z)\n-}\n\n{------- fix for higher rank types ---------}\n\ndata Tree a = Branch a (Tree (a,a)) | Leaf\n\ntype MapTree = forall a b. (a -> b) -> Tree a -> Tree b\ncross f (a,b) = (f a,f b)\n\n-- I think this should work in GHC now, but it doesn't\n-- fix specialized to higher-rank type\nfixMT :: (MapTree -> MapTree) -> MapTree\nfixMT f = f (fixMT f)\n\nmapTree' = fixMT (\\ (mapTree :: MapTree) -> \\f tree -> case tree of\n                            Branch a t -> Branch (f a) (mapTree (cross f) t)\n                            Leaf -> Leaf)\n\n-- polymorphic fix\nfix :: (a -> a) -> a\nfix f = f (fix f)\n\n\n-- mapTree'' :: MapTree\nmapTree'' = (fix :: (MapTree -> MapTree) -> MapTree)\n               (\\ mapTree -> \\f tree -> case tree of\n                            Branch a t -> Branch (f a) (mapTree (cross f) t)\n                            Leaf -> Leaf)\n", "num_lines": 125}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule Church1 where \n-- Church numerals w/o extra type constructors \n\ntype CNat = forall a. (a->a) -> a -> a \n\nn0 :: CNat \nn0 = \\f z -> z\n\nn1 :: CNat \nn1 = \\f z -> f z \n\nnsucc :: CNat -> CNat \nnsucc n = \\f z -> f (n f z)\n\nadd, mul :: CNat -> CNat -> CNat\nadd m n = \\f -> \\a -> m f (n f a)\nmul m n = \\f -> \\a -> m (n f) a\n\n-- already works with GHC 6.4 \nexp0 :: CNat -> CNat -> CNat \nexp0 m n = n m\n\n\nexp1 :: CNat -> CNat -> CNat \nexp1 m n = (n::((CNat -> CNat) -> CNat -> CNat)) (mul m) n1  -- checks with app rule \n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule Church2 where \n-- Church numerals w/o extra type constructors: Should fail\n\ntype CNat = forall a. (a->a) -> a -> a \n\nn0 :: CNat \nn0 = \\f z -> z\n\nn1 :: CNat \nn1 = \\f z -> f z \n\nnsucc :: CNat -> CNat \nnsucc n = \\f z -> f (n f z)\n\nadd, mul :: CNat -> CNat -> CNat\nadd m n = \\f -> \\a -> m f (n f a)\nmul m n = \\f -> \\a -> m (n f) a\n\n-- already works with GHC 6.4 \nexp0 :: CNat -> CNat -> CNat \nexp0 m n = n m\n\n-- should fail! \nexp2 :: CNat -> CNat -> CNat \nexp2 m n = n (mul m) n1 \n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags -XEmptyDataDecls -XGADTs #-}\n\n-- Trac #1118\n\nmodule Compose where\n\ndata Z\ndata S n\n\ndata List n a where\n    Nil :: List Z a\n    (:-) :: a -> List n a -> List (S n) a\n\ndata Hold a = Hold (forall m . a m -> a (S m))\n\ncompose' :: List n (Hold a) -> a (S Z) -> a (S n)\ncompose' Nil x = x\ncompose' ((Hold f) :- fs) x = f (compose' fs x)\n\ncompose :: List n (forall m . a m -> a (S m)) -> a (S Z) -> a (S n)\ncompose Nil x = x\ncompose (f :- fs) x = f (compose fs x)\n\ncomposeS :: [forall m . a m -> a m] -> a n -> a n\ncomposeS [] x = x\ncomposeS (f:fs) x = f (composeS fs x)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}\n\nmodule PList1 where\n-- Polymorphic lists 1: requires smart-app-res\n\ntype Sid = forall a . a -> a\n\nids :: [Sid]\nids = []\n\n-- requires smart-app-res\ntest0 :: [Sid]\ntest0 = (\\x->x) : ids\n\ntest1 :: [Sid]  -- SLPJ added\ntest1 = ids ++ test0\n\ntest2 :: [Sid]\ntest2 = tail test1\n\n\ntest3 :: [Sid]  -- SLPJ added\ntest3 = reverse test2\ntest4 = (tail::([Sid]->[Sid])) test2\n\ntest5 = (head::([Sid]->Sid)) test2\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}\n\nmodule PList2 where\n-- Polymorphic lists 2: require smart-app-arg & smart-app-res: Should fail w/o smart-app-arg\n\ntype Sid = forall a. a -> a\n\nids :: [Sid]\nids = []\n\ntest0 :: [Sid]\ntest0 = (\\x -> x):ids  -- requires smart-app-res\n\ntest1 :: [Sid]  -- Added SLPJ\ntest1 = ids ++ test0\n\ntest2 :: [Sid]\ntest2 = tail test1 -- requires smart-app-arg\n\ntest3 :: [Sid]  -- Added SLPJ\ntest3 = reverse test2\n\ntest4 :: Sid\ntest4 = head ids  --requires smart-app-arg\n\ntest5 :: Sid\ntest5 = head ids  -- still requires smart-app-arg\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n\nmodule SystemF where \n-- System-F examples \n\n\ntype Sid = forall a. a -> a \n\napply :: forall a b . (a -> b) -> a -> b \napply f g = f g \n\nhr :: (forall a. a -> a) -> (Int,Bool)\nhr f = (f 3,f True)\n\ntest0 = apply hr id   -- requires smart-app-arg \n\nselfApp :: Sid -> Sid \nselfApp x = (x::(Sid -> Sid)) x \n\n\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags #-}\n\n-- Sept 16: now scraping through with -XImpredicateTypes\n\nmodule Main where\n\ndata Foo x y = Foo {foo1 :: x, foo2 :: y}\ninstance Functor (Foo x) where\n    fmap f (Foo x y) = Foo x (f y)\n\nbar :: a -> Foo (forall s. s) a\nbar a = Foo undefined a\n\nmain = print (foo2 (fmap (*2) (bar 2)))\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import A\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Data.Map where\n-- conflicts with module from containers package\nimport Data.Set\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\na = 42 :: Int\n\nmain2 = print a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport A\n\nmain = print a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "> import Distribution.Simple\n> main = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B.A where\na = 42 :: Int\n\nmain = print a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport A\n\nmain = print a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "> import Distribution.Simple\n> main = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P (p) where\np = ()\n\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE TemplateHaskell #-}\n module Library where\n\nimport TH\n\nmain = print ($(spliceMe) [1, 2])\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "> import Distribution.Simple\n> main = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule TH where\n\nimport Language.Haskell.TH\n\nspliceMe = [| (\\xs -> tail xs ++ init xs) |]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P where\ndata P = P\np = True\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P2 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Q where\nimport P\ndata Q = Q\nq = not p\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module R where\nimport P  -- p (exposed), q (reexport p:P)\nimport P2 -- q (reexport p:P)\nimport Q  -- q (exposed)\nimport qualified QP -- q (reexport p:P)\nimport qualified QQ -- q (reexport q:Q)\nimport qualified PMerge -- q (reexport p:P)\nimport qualified PMerge2 -- q (reexport p:P2)\nimport qualified QMerge -- q (reexport q:Q)\ndata R = R\nr = p && q\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module S where\n-- NB: package p is hidden!\nimport qualified QP     -- q (reexport p:P)\nimport qualified RP     -- r (reexport p:P)\nimport qualified Q      -- q (exposed), r (reexport q:Q)\nimport qualified R      -- r (exposed)\nimport qualified RR     -- r (reexport r:R)\nimport qualified RP     -- r (reexport p:P)\nimport qualified RQP    -- r (reexport p:P)\nimport qualified RQP2   -- r (reexport p:P)\nimport qualified PMerge  -- q (reexport p:P), r (reexport p:P)\nimport qualified PMerge2 -- q (reexport p:P2), r (reexport p:P2)\nimport qualified QMerge  -- q (reexport q:Q), r (reexport q:Q)\n\nx :: QP.P\nx = RP.P\n\ns = QP.p || Q.q || R.r\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T where\n\nimport Conflict -- should be ambiguous\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P where\np :: Int\np = 0\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P where\np :: Int\np = 1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Q where\nimport P\nq :: Int\nq = p + 10\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport Q\nmain = print q\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import P\nmain = putStrLn p\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P where\np = \"p1\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P where\np = \"p2\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.List.NonEmpty\nmain = return ()\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nimport Foreign -- a local module\nimport Foreign.C -- a package module\n\ny = Foreign.x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foreign (x) where\nx = \"test\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified P.Lazy\nimport qualified P.Strict\nmain = P.Lazy.foo >> P.Strict.foo\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P where\n\nimport Map\n\nfoo = do\n    let x = insert 0 \"foo\"\n          . delete 1\n          . insert 1 undefined\n          . insert (6 :: Int) \"foo\"\n          $ empty\n    print (member 1 x)\n    print (toList x)\n    print x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nmain = main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Q where\nimport P\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Q2 where\nimport Q\ninstance Show (IO a) where\n    show = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f2 :: Int -> Int -> Int\nf2 x1 = if x1 == 0 then (\\x0 -> x0) else let\n     y = x1 - 1\n     in f3 y y\nf3 :: Int -> Int -> Int -> Int\nf3 x2 = if x2 == 0 then f2 else let\n     y = x2 - 1\n     in f4 y y\nf4 :: Int -> Int -> Int -> Int -> Int\nf4 x3 = if x3 == 0 then f3 else let\n     y = x3 - 1\n     in \\x2 x1 x0 -> f4 y x2 x1 (y + x0)\nmain = print (f2 100 0)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n{-\nIf the (unboxed, hence strict) \"let thunk =\" would survive to the CallArity\nstage, it might yield wrong results (eta-expanding thunk and hence \"cond\" would\nbe called multiple times).\n\nIt does not actually happen (CallArity sees a \"case\"), so this test just\nsafe-guards against future changes here.\n-}\n\nimport Debug.Trace\nimport GHC.Exts\nimport System.Environment\n\ncond :: Int# -> Bool\ncond x = trace (\"cond called with \" ++ show (I# x)) True\n{-# NOINLINE cond #-}\n\n\nbar (I# x) =\n    let go n = let x = thunk n\n               in case n of\n                    100# -> I# x\n                    _    -> go (n +# 1#)\n    in go x\n  where thunk = if cond x then \\x -> (x +# 1#) else \\x -> (x -# 1#)\n\n\nmain = do\n    args <- getArgs\n    bar (length args) `seq` return ()\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections #-}\nimport CoreSyn\nimport CoreUtils\nimport Id\nimport Type\nimport MkCore\nimport CallArity (callArityRHS)\nimport MkId\nimport SysTools\nimport DynFlags\nimport ErrUtils\nimport Outputable\nimport TysWiredIn\nimport Literal\nimport GHC\nimport Control.Monad\nimport Control.Monad.IO.Class\nimport System.Environment( getArgs )\nimport VarSet\nimport PprCore\nimport Unique\nimport UniqSet\nimport CoreLint\nimport FastString\n\n-- Build IDs. use mkTemplateLocal, more predictable than proper uniques\ngo, go2, x, d, n, y, z, scrutf, scruta :: Id\n[go, go2, x,d, n, y, z, scrutf, scruta, f] = mkTestIds\n    (words \"go go2 x d n y z scrutf scruta f\")\n    [ mkVisFunTys [intTy, intTy] intTy\n    , mkVisFunTys [intTy, intTy] intTy\n    , intTy\n    , mkVisFunTys [intTy] intTy\n    , mkVisFunTys [intTy] intTy\n    , intTy\n    , intTy\n    , mkVisFunTys [boolTy] boolTy\n    , boolTy\n    , mkVisFunTys [intTy, intTy] intTy -- protoypical external function\n    ]\n\nexprs :: [(String, CoreExpr)]\nexprs =\n  [ (\"go2\",) $\n     mkRFun go [x]\n        (mkLetNonRec d (mkACase (Var go `mkVarApps` [x])\n                          (mkLams [y] $ Var y)\n                  ) $ mkLams [z] $ Var d `mkVarApps` [x]) $\n        go `mkLApps` [0, 0]\n  , (\"nested_go2\",) $\n     mkRFun go [x]\n        (mkLetNonRec n (mkACase (Var go `mkVarApps` [x])\n                          (mkLams [y] $ Var y))  $\n            mkACase (Var n) $\n                mkFun go2 [y]\n                    (mkLetNonRec d\n                        (mkACase (Var go `mkVarApps` [x])\n                                 (mkLams [y] $ Var y) ) $\n                        mkLams [z] $ Var d `mkVarApps` [x] )$\n                    Var go2 `mkApps` [mkLit 1] ) $\n        go `mkLApps` [0, 0]\n  , (\"d0 (go 2 would be bad)\",) $\n     mkRFun go [x]\n        (mkLetNonRec d (mkACase (Var go `mkVarApps` [x])\n                          (mkLams [y] $ Var y)\n                  ) $\n            mkLams [z] $ Var f `mkApps` [ Var d `mkVarApps` [x],  Var d `mkVarApps` [x] ]) $\n        go `mkLApps` [0, 0]\n  , (\"go2 (in case crut)\",) $\n     mkRFun go [x]\n        (mkLetNonRec d (mkACase (Var go `mkVarApps` [x])\n                          (mkLams [y] $ Var y)\n                  ) $ mkLams [z] $ Var d `mkVarApps` [x]) $\n        Case (go `mkLApps` [0, 0]) z intTy\n            [(DEFAULT, [], Var f `mkVarApps` [z,z])]\n  , (\"go2 (in function call)\",) $\n     mkRFun go [x]\n        (mkLetNonRec d (mkACase (Var go `mkVarApps` [x])\n                          (mkLams [y] $ Var y)\n                  ) $ mkLams [z] $ Var d `mkVarApps` [x]) $\n        f `mkLApps` [0] `mkApps` [go `mkLApps` [0, 0]]\n  , (\"go2 (using surrounding interesting let)\",) $\n     mkLetNonRec n (f `mkLApps` [0]) $\n         mkRFun go [x]\n            (mkLetNonRec d (mkACase (Var go `mkVarApps` [x])\n                              (mkLams [y] $ Var y)\n                      ) $ mkLams [z] $ Var d `mkVarApps` [x]) $\n            Var f `mkApps` [n `mkLApps` [0],  go `mkLApps` [0, 0]]\n  , (\"go2 (using surrounding boring let)\",) $\n     mkLetNonRec z (mkLit 0) $\n         mkRFun go [x]\n            (mkLetNonRec d (mkACase (Var go `mkVarApps` [x])\n                              (mkLams [y] $ Var y)\n                      ) $ mkLams [z] $ Var d `mkVarApps` [x]) $\n            Var f `mkApps` [Var z,  go `mkLApps` [0, 0]]\n  , (\"two calls, one from let and from body (d 1 would be bad)\",) $\n     mkLetNonRec  d (mkACase (mkLams [y] $ mkLit 0) (mkLams [y] $ mkLit 0)) $\n     mkFun go [x,y] (mkVarApps (Var d) [x]) $\n     mkApps (Var d) [mkLApps go [1,2]]\n  , (\"a thunk in a recursion (d 1 would be bad)\",) $\n     mkRLet n (mkACase (mkLams [y] $ mkLit 0) (Var n)) $\n     mkRLet d (mkACase (mkLams [y] $ mkLit 0) (Var d)) $\n         Var n `mkApps` [d `mkLApps` [0]]\n  , (\"two thunks, one called multiple times (both arity 1 would be bad!)\",) $\n     mkLetNonRec n (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $\n     mkLetNonRec d (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $\n         Var n `mkApps` [Var d `mkApps` [Var d `mkApps` [mkLit 0]]]\n  , (\"two functions, not thunks\",) $\n     mkLetNonRec go  (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $\n     mkLetNonRec go2 (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $\n         Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]\n  , (\"a thunk, called multiple times via a forking recursion (d 1 would be bad!)\",) $\n     mkLetNonRec  d   (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $\n     mkRLet go2 (mkLams [x] (mkACase (Var go2 `mkApps` [Var go2 `mkApps` [mkLit 0, mkLit 0]]) (Var d))) $\n         go2 `mkLApps` [0,1]\n  , (\"a function, one called multiple times via a forking recursion\",) $\n     mkLetNonRec go   (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $\n     mkRLet go2 (mkLams [x] (mkACase (Var go2 `mkApps` [Var go2 `mkApps` [mkLit 0, mkLit 0]]) (go `mkLApps` [0]))) $\n         go2 `mkLApps` [0,1]\n  , (\"two functions (recursive)\",) $\n     mkRLet go  (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x]))) $\n     mkRLet go2 (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go2 `mkVarApps` [x]))) $\n         Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]\n  , (\"mutual recursion (thunks), called mutiple times (both arity 1 would be bad!)\",) $\n     Let (Rec [ (n, mkACase (mkLams [y] $ mkLit 0) (Var d))\n              , (d, mkACase (mkLams [y] $ mkLit 0) (Var n))]) $\n         Var n `mkApps` [Var d `mkApps` [Var d `mkApps` [mkLit 0]]]\n  , (\"mutual recursion (functions), but no thunks\",) $\n     Let (Rec [ (go,  mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go2 `mkVarApps` [x])))\n              , (go2, mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x])))]) $\n         Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]\n  , (\"mutual recursion (functions), one boring (d 1 would be bad)\",) $\n     mkLetNonRec d (f `mkLApps` [0]) $\n         Let (Rec [ (go,  mkLams [x, y] (Var d `mkApps` [go2 `mkLApps` [1,2]]))\n                  , (go2, mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x])))]) $\n             Var d `mkApps` [go2 `mkLApps` [0,1]]\n  , (\"a thunk (non-function-type), called twice, still calls once\",) $\n    mkLetNonRec d (f `mkLApps` [0]) $\n        mkLetNonRec x (d `mkLApps` [1]) $\n            Var f `mkVarApps` [x, x]\n  , (\"a thunk (function type), called multiple times, still calls once\",) $\n    mkLetNonRec d (f `mkLApps` [0]) $\n        mkLetNonRec n (Var f `mkApps` [d `mkLApps` [1]]) $\n            mkLams [x] $ Var n `mkVarApps` [x]\n  , (\"a thunk (non-function-type), in mutual recursion, still calls once (d 1 would be good)\",) $\n    mkLetNonRec d (f `mkLApps` [0]) $\n        Let (Rec [ (x, Var d `mkApps` [go `mkLApps` [1,2]])\n                 , (go, mkLams [x] $ mkACase (mkLams [z] $ Var x) (Var go `mkVarApps` [x]) ) ]) $\n            Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]\n  , (\"a thunk (non-function-type), in mutual recursion, causes many calls (d 1 would be bad)\",) $\n    mkLetNonRec d (f `mkLApps` [0]) $\n        Let (Rec [ (x, Var go `mkApps` [go `mkLApps` [1,2], go `mkLApps` [1,2]])\n                 , (go, mkLams [x] $ mkACase (Var d) (Var go `mkVarApps` [x]) ) ]) $\n            Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]\n  , (\"a thunk (function type), in mutual recursion, still calls once (d 1 would be good)\",) $\n    mkLetNonRec d (f `mkLApps` [0]) $\n        Let (Rec [ (n, Var go `mkApps` [d `mkLApps` [1]])\n                 , (go, mkLams [x] $ mkACase (Var n) (Var go `mkApps` [Var n `mkVarApps` [x]]) ) ]) $\n            Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]\n  , (\"a thunk (non-function-type) co-calls with the body (d 1 would be bad)\",) $\n    mkLetNonRec d (f `mkLApps` [0]) $\n        mkLetNonRec x (d `mkLApps` [1]) $\n            Var d `mkVarApps` [x]\n  ]\n\nmain = do\n    [libdir] <- getArgs\n    runGhc (Just libdir) $ do\n        getSessionDynFlags >>= setSessionDynFlags . flip gopt_set Opt_SuppressUniques\n        dflags <- getSessionDynFlags\n        liftIO $ forM_ exprs $ \\(n,e) -> do\n            case lintExpr dflags [f,scrutf,scruta] e of\n                Just msg -> putMsg dflags (msg $$ text \"in\" <+> text n)\n                Nothing -> return ()\n            putMsg dflags (text n Outputable.<> char ':')\n            -- liftIO $ putMsg dflags (ppr e)\n            let e' = callArityRHS e\n            let bndrs = nonDetEltsUniqSet (allBoundIds e')\n              -- It should be OK to use nonDetEltsUniqSet here, if it becomes a\n              -- problem we should use DVarSet\n            -- liftIO $ putMsg dflags (ppr e')\n            forM_ bndrs $ \\v -> putMsg dflags $ nest 4 $ ppr v <+> ppr (idCallArity v)\n\n-- Utilities\nmkLApps :: Id -> [Integer] -> CoreExpr\nmkLApps v = mkApps (Var v) . map mkLit\n\nmkACase = mkIfThenElse (mkVarApps (Var scrutf) [scruta])\n\nmkTestId :: Int -> String -> Type -> Id\nmkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) ty\n\nmkTestIds :: [String] -> [Type] -> [Id]\nmkTestIds ns tys = zipWith3 mkTestId [0..] ns tys\n\nmkRLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr\nmkRLet v rhs body = mkLetRec [(v, rhs)] body\n\nmkFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr\nmkFun v xs rhs body = mkLetNonRec v (mkLams xs rhs) body\n\nmkRFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr\nmkRFun v xs rhs body = mkRLet v (mkLams xs rhs) body\n\nmkLit :: Integer -> CoreExpr\nmkLit i = Lit (mkLitInteger i intTy)\n\n-- Collects all let-bound IDs\nallBoundIds :: CoreExpr -> VarSet\nallBoundIds (Let (NonRec v rhs) body) = allBoundIds rhs `unionVarSet` allBoundIds body `extendVarSet` v\nallBoundIds (Let (Rec binds) body) =\n    allBoundIds body `unionVarSet` unionVarSets\n        [ allBoundIds rhs `extendVarSet` v | (v, rhs) <- binds ]\nallBoundIds (App e1 e2) = allBoundIds e1 `unionVarSet` allBoundIds e2\nallBoundIds (Case scrut _ _ alts) =\n    allBoundIds scrut `unionVarSet` unionVarSets\n        [ allBoundIds e | (_, _ , e) <- alts ]\nallBoundIds (Lam _ e)  = allBoundIds e\nallBoundIds (Tick _ e) = allBoundIds e\nallBoundIds (Cast e _) = allBoundIds e\nallBoundIds _ = emptyVarSet\n\n", "num_lines": 223}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Hoopl.Block\nimport Hoopl.Collections\nimport Hoopl.Graph\nimport Hoopl.Label\n\nimport Data.Maybe\n\ndata TestBlock e x = TB { label_ :: Label, successors_ :: [Label] }\n    deriving (Eq, Show)\n\ninstance NonLocal TestBlock where\n  entryLabel = label_\n  successors = successors_\n\n-- Test the classical diamond shape graph.\ntest_diamond :: LabelMap (TestBlock C C)\ntest_diamond = mapFromList $ map (\\b -> (label_ b, b)) blocks\n  where\n    blocks =\n        [ TB (mkHooplLabel 1) [mkHooplLabel 2, mkHooplLabel 3]\n        , TB (mkHooplLabel 2) [mkHooplLabel 4]\n        , TB (mkHooplLabel 3) [mkHooplLabel 4]\n        , TB (mkHooplLabel 4) []\n        ]\n\n-- Test that the backedge doesn't change anything.\ntest_diamond_backedge :: LabelMap (TestBlock C C)\ntest_diamond_backedge = mapFromList $ map (\\b -> (label_ b, b)) blocks\n  where\n    blocks =\n        [ TB (mkHooplLabel 1) [mkHooplLabel 2, mkHooplLabel 3]\n        , TB (mkHooplLabel 2) [mkHooplLabel 4]\n        , TB (mkHooplLabel 3) [mkHooplLabel 4]\n        , TB (mkHooplLabel 4) [mkHooplLabel 1]\n        ]\n\n-- Test that the \"bypass\" edge from 1 to 4 doesn't change anything.\ntest_3 :: LabelMap (TestBlock C C)\ntest_3 = mapFromList $ map (\\b -> (label_ b, b)) blocks\n  where\n    blocks =\n        [ TB (mkHooplLabel 1) [mkHooplLabel 2, mkHooplLabel 4]\n        , TB (mkHooplLabel 2) [mkHooplLabel 4]\n        , TB (mkHooplLabel 4) []\n        ]\n\n-- Like test_3 but with different order of successors for the entry point.\ntest_4 :: LabelMap (TestBlock C C)\ntest_4 = mapFromList $ map (\\b -> (label_ b, b)) blocks\n  where\n    blocks =\n        [ TB (mkHooplLabel 1) [mkHooplLabel 4, mkHooplLabel 2]\n        , TB (mkHooplLabel 2) [mkHooplLabel 4]\n        , TB (mkHooplLabel 4) []\n        ]\n\n\nmain :: IO ()\nmain = do\n    let result = revPostorderFrom test_diamond (mkHooplLabel 1)\n    putStrLn (show $ map label_ result)\n    let result = revPostorderFrom test_diamond_backedge (mkHooplLabel 1)\n    putStrLn (show $ map label_ result)\n    let result = revPostorderFrom test_3 (mkHooplLabel 1)\n    putStrLn (show $ map label_ result)\n    let result = revPostorderFrom test_4 (mkHooplLabel 1)\n    putStrLn (show $ map label_ result)\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule ShouldCompile where\n\nimport GHC.Exts\n\ndata STRef s a = STRef (MutVar# s a)\n\n-- ghc 4.08 had a problem with returning a MutVar#.\n\nfrom :: STRef s a -> MutVar# s a\nfrom (STRef x) = x\n\nto :: MutVar# s a -> STRef s a\nto x = STRef x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule M where\nimport Data.Char\n{-# INLINE f #-}\nf = map ord . map chr\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\n-- !!! caused compiler to generate bogus HC code, fixed in\n-- basicTypes/Literal.lhs rev. 1.36.\n\nf :: Double -> Int\nf x = round (x - (-5.0))\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n--              Killed GHC 6.0 in isCrossDllArg\n--\n-- ghc-6.0: panic! (the `impossible' happened, GHC version 6.0):\n--      coreSyn/CoreUtils.lhs:1188: Non-exhaustive patterns in function isCrossDllArg\n--\n-- The reason was that newST had the form\n--   newST = \\ @ v -> GHC.Base.:\n--                      @ (Environment.Scope v)\n--                      (case $fScopeOpersScope @ v\n--                       of tpl_B1 { Environment.:DScopeOpers tpl_B2 tpl_B3 ->\n--                       tpl_B2\n--                       })\n--                      (GHC.Base.[] @ (Environment.Scope v))\n\nclass ScopeOpers s where\n      emptyScope :: s\n      op :: s -> s\n\ndata Scope v = NewScope\n\ninstance ScopeOpers (Scope v) where\n      emptyScope = error \"emptyScope\"\n      op = error \"op\"\n\nnewtype SymbolTable v = SymbolTable [Scope v]\n\nnewST :: SymbolTable v\nnewST = SymbolTable [emptyScope]\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug where\n\nimport Foreign hiding ( unsafePerformIO )\nimport Foreign.ForeignPtr\nimport Data.Char\nimport System.IO.Unsafe\n\ndata PackedString = PS !(ForeignPtr Word8) !Int !Int\n\n(!) :: PackedString -> Int -> Word8\n(PS x s _l) ! i\n    = unsafePerformIO $ withForeignPtr x $ \\p -> peekElemOff p (s+i)\n\nw2c :: Word8 -> Char\nw2c = chr . fromIntegral\n\nindexPS :: PackedString -> Int -> Char\nindexPS theps i | i < 0 = error \"Negative index in indexPS\"\n                | otherwise = w2c $ theps ! i\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule ShouldCompile where\n\n-- exposed a bug in the NCG in 6.4.2\nimport GHC.Base\nclass Unboxable a where\n    writeUnboxable :: MutableByteArray# RealWorld -> a -> State# RealWorld -> State# RealWorld\n    writeUnboxable arr a s  =  writeInt8Array# arr 0# (getTag 0) s\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule ShouldCompile where\n\nimport Foreign.C.Types\n\n{-\nDuring 6.11, this was failing like this:\n\nIn file included from /ghc/includes/Stg.h:207,\n\n                 from /tmp/ghc2904_0/ghc2904_0.hc:3:0:\n/tmp/ghc2904_0/ghc2904_0.hc: In function `swM_ret':\n\n/tmp/ghc2904_0/ghc2904_0.hc:22:0:\n     error: `gamma' undeclared (first use in this function)\n\n/tmp/ghc2904_0/ghc2904_0.hc:22:0:\n     error: (Each undeclared identifier is reported only once\n\n/tmp/ghc2904_0/ghc2904_0.hc:22:0:\n     error: for each function it appears in.)\n-}\n\nforeign import ccall unsafe \"math.h gamma\"\n    gamma :: CDouble -> CDouble\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\n{-# OPTIONS_GHC -O0 #-}\n\n-- Variant of cgrun066; compilation as a module is different.\n\nmodule Cg008 (hashStr) where\n\nimport Foreign.C\nimport Data.Word\nimport Foreign.Ptr\nimport GHC.Exts\n\nimport Control.Exception\n\nhashStr  :: Ptr Word8 -> Int -> Int\nhashStr (Ptr a#) (I# len#) = loop 0# 0#\n   where\n    loop h n | isTrue# (n GHC.Exts.==# len#) = I# h\n             | otherwise  = loop h2 (n GHC.Exts.+# 1#)\n          where !c = ord# (indexCharOffAddr# a# n)\n                !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#` 4091#\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nfib :: Int -> Int\nfib 0 = 1 -- GHC should merge the blocks\nfib 1 = 1 -- of these two alternatives\nfib n = fib (n-1) + fib (n-2)\nmain = print $ fib 10\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\n\n{-\nThis funny module was reduced from a failing build of stage2 using\nthe new code generator and the linear register allocator, with this bug:\n\n\"inplace/bin/ghc-stage1\" -fPIC -dynamic  -H32m -O -Wall -H64m -O0    -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils   -optP-DGHCI -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0  -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts     -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf  dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o  -fforce-recomp -dno-debug-output -fno-warn-unused-binds\n\nghc-stage1: panic! (the 'impossible' happened)\n  (GHC version 7.1.20110414 for x86_64-unknown-linux):\n        Cannot patch JMP_TBL\n\nThis panic only appears to show up on x86-64 and with -fPIC.  I wasn't\nable to get the produced optimized C-- to crash the linear register\nallocator.  To see the bug, you need some extra patches for the new code\ngenerator, in particular, this set (which can be acquired from the\njmp_tbl_bug tag at <https://github.com/ezyang/ghc>):\n\n    commit 7b275c93df7944f0a9b51034cf1f64e3e70582a5\n    Author: Edward Z. Yang <ezyang@mit.edu>\n    Date:   Thu Apr 14 21:20:21 2011 +0100\n\n        Give manifestSP better information about the actual SP location.\n\n        This patch fixes silliness where the SP pointer is continually\n        bumped up and down.\n\n        Signed-off-by: Edward Z. Yang <ezyang@mit.edu>\n\n    commit 5b5add4246d3997670ae995f7d2a028db92fff95\n    Author: Edward Z. Yang <ezyang@mit.edu>\n    Date:   Wed Apr 13 11:16:36 2011 +0100\n\n        Generalized assignment rewriting pass.\n\n        This assignment rewriting pass subsumes the previous reload\n        sinking pass, and also performs basic inlining.\n\n        Signed-off-by: Edward Z. Yang <ezyang@mit.edu>\n\nThe ostensible cause is that the linear register allocator is getting\nreally unlucky and needs to insert a fixup block after precisely one\njump in a jump table, because the block it jumps to was processed\nalready.  As you can see, actually getting the linear register allocator\ninto this funk is /very/ difficult.\n\n-}\n\nmodule DriverPipeline (compileFile) where\n\nimport Control.Exception\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\ndata Phase\n        = Unlit ()\n        | Ccpp\n        | Cc\n        | Cobjc\n        | HCc\n        | SplitAs\n        | As\n        | LlvmOpt\n        | LlvmLlc\n        | LlvmMangle\n        | MergeStub\n        | StopLn\n  deriving (Show)\n\ndata PipeState = PipeState {\n       stop_phase   :: Phase,\n       src_basename :: String,\n       output_spec  :: (),\n       hsc_env      :: Maybe String,\n       maybe_loc    :: Maybe String\n  }\n\nnewtype CompPipeline a = P { unP :: PipeState -> IO (PipeState, a) }\n\ninstance Functor CompPipeline where\n    fmap = liftM\n\ninstance Applicative CompPipeline where\n    pure = return\n    (<*>) = ap\n\ninstance Monad CompPipeline where\n  return a = P $ \\state -> return (state, a)\n  P m >>= k = P $ \\state -> do (state',a) <- m state\n                               unP (k a) state'\n\neqPhase :: Phase -> Phase -> Bool\neqPhase (Unlit _)   (Unlit _)   = True\neqPhase Ccpp        Ccpp        = True\neqPhase Cc          Cc          = True\neqPhase HCc         HCc         = True\neqPhase SplitAs     SplitAs     = True\neqPhase As          As          = True\neqPhase LlvmOpt     LlvmOpt     = True\neqPhase LlvmLlc     LlvmLlc     = True\neqPhase LlvmMangle  LlvmMangle  = True\neqPhase MergeStub   MergeStub   = True\neqPhase StopLn      StopLn      = True\neqPhase _           _           = False\n\ncompileFile start_phase state = do\n  unP (pipeLoop start_phase) state\n  getOutputFilename undefined undefined undefined undefined undefined undefined\n\npipeLoop phase = do\n  dflags@PipeState{stop_phase} <- getPipeState\n  io $ evaluate (phase `eqPhase` stop_phase)\n  runPhase phase dflags\n  pipeLoop phase\n\ngetOutputFilename :: Phase -> () -> String -> Maybe String -> Phase -> Maybe String -> IO String\ngetOutputFilename p o b md p' ml\n   | p' `eqPhase` p, () <- o = undefined\n   | Just l <- ml = return l\n   | Just d <- md = return $ d ++ b\n   | otherwise    = undefined\n\nrunPhase p _ | p `eqPhase` Cc || p `eqPhase` Ccpp || p `eqPhase` HCc || p `eqPhase` Cobjc = undefined\nrunPhase LlvmMangle _ = undefined\nrunPhase SplitAs _ = undefined\nrunPhase LlvmOpt _ = undefined\nrunPhase LlvmLlc dflags = phaseOutputFilename >> io (evaluate dflags) >> return undefined\nrunPhase MergeStub _ = phaseOutputFilename >> undefined\nrunPhase other _ = io (evaluate (show other)) >> undefined\n\nphaseOutputFilename :: CompPipeline ()\nphaseOutputFilename = do\n  PipeState{stop_phase, src_basename, output_spec, maybe_loc, hsc_env} <- getPipeState\n  io $ getOutputFilename stop_phase output_spec src_basename hsc_env StopLn maybe_loc\n\ngetPipeState = P $ \\state -> return (state, state)\nio m = P $ \\state -> do a <- m; return (state, ())\n", "num_lines": 139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}\n\n-- This test breaks the linear register allocator when compiled the\n-- flags -fnew-codegen, -fPIC and -dynamic, running out of stack\n-- slots.  You actually don't need 500 elements; 32-bit fails\n-- with only about 260 or so.  Works for stage1 too!  It's a bit touchy\n-- about optimization flags; if you specify -O or -O0 in OPTIONS_GHC\n-- the bug goes away.  Shows up in GHC 7.0.3.\n--\n-- The -fno-ignore-interface-pragmas flag is pretty important! (Though I\n-- don't quite know why yet.)  Gigantic arrays like this show up in\n-- generated code, in particular Parser.hs from Happy in GHC.\n\nmodule MassiveArray where\n\nimport Data.Array\n\nf = array (0, 499)\n  $ [\n    (0, 0),\n    (1, 1),\n    (2, 2),\n    (3, 3),\n    (4, 4),\n    (5, 5),\n    (6, 6),\n    (7, 7),\n    (8, 8),\n    (9, 9),\n    (10, 10),\n    (11, 11),\n    (12, 12),\n    (13, 13),\n    (14, 14),\n    (15, 15),\n    (16, 16),\n    (17, 17),\n    (18, 18),\n    (19, 19),\n    (20, 20),\n    (21, 21),\n    (22, 22),\n    (23, 23),\n    (24, 24),\n    (25, 25),\n    (26, 26),\n    (27, 27),\n    (28, 28),\n    (29, 29),\n    (30, 30),\n    (31, 31),\n    (32, 32),\n    (33, 33),\n    (34, 34),\n    (35, 35),\n    (36, 36),\n    (37, 37),\n    (38, 38),\n    (39, 39),\n    (40, 40),\n    (41, 41),\n    (42, 42),\n    (43, 43),\n    (44, 44),\n    (45, 45),\n    (46, 46),\n    (47, 47),\n    (48, 48),\n    (49, 49),\n    (50, 50),\n    (51, 51),\n    (52, 52),\n    (53, 53),\n    (54, 54),\n    (55, 55),\n    (56, 56),\n    (57, 57),\n    (58, 58),\n    (59, 59),\n    (60, 60),\n    (61, 61),\n    (62, 62),\n    (63, 63),\n    (64, 64),\n    (65, 65),\n    (66, 66),\n    (67, 67),\n    (68, 68),\n    (69, 69),\n    (70, 70),\n    (71, 71),\n    (72, 72),\n    (73, 73),\n    (74, 74),\n    (75, 75),\n    (76, 76),\n    (77, 77),\n    (78, 78),\n    (79, 79),\n    (80, 80),\n    (81, 81),\n    (82, 82),\n    (83, 83),\n    (84, 84),\n    (85, 85),\n    (86, 86),\n    (87, 87),\n    (88, 88),\n    (89, 89),\n    (90, 90),\n    (91, 91),\n    (92, 92),\n    (93, 93),\n    (94, 94),\n    (95, 95),\n    (96, 96),\n    (97, 97),\n    (98, 98),\n    (99, 99),\n    (100, 100),\n    (101, 101),\n    (102, 102),\n    (103, 103),\n    (104, 104),\n    (105, 105),\n    (106, 106),\n    (107, 107),\n    (108, 108),\n    (109, 109),\n    (110, 110),\n    (111, 111),\n    (112, 112),\n    (113, 113),\n    (114, 114),\n    (115, 115),\n    (116, 116),\n    (117, 117),\n    (118, 118),\n    (119, 119),\n    (120, 120),\n    (121, 121),\n    (122, 122),\n    (123, 123),\n    (124, 124),\n    (125, 125),\n    (126, 126),\n    (127, 127),\n    (128, 128),\n    (129, 129),\n    (130, 130),\n    (131, 131),\n    (132, 132),\n    (133, 133),\n    (134, 134),\n    (135, 135),\n    (136, 136),\n    (137, 137),\n    (138, 138),\n    (139, 139),\n    (140, 140),\n    (141, 141),\n    (142, 142),\n    (143, 143),\n    (144, 144),\n    (145, 145),\n    (146, 146),\n    (147, 147),\n    (148, 148),\n    (149, 149),\n    (150, 150),\n    (151, 151),\n    (152, 152),\n    (153, 153),\n    (154, 154),\n    (155, 155),\n    (156, 156),\n    (157, 157),\n    (158, 158),\n    (159, 159),\n    (160, 160),\n    (161, 161),\n    (162, 162),\n    (163, 163),\n    (164, 164),\n    (165, 165),\n    (166, 166),\n    (167, 167),\n    (168, 168),\n    (169, 169),\n    (170, 170),\n    (171, 171),\n    (172, 172),\n    (173, 173),\n    (174, 174),\n    (175, 175),\n    (176, 176),\n    (177, 177),\n    (178, 178),\n    (179, 179),\n    (180, 180),\n    (181, 181),\n    (182, 182),\n    (183, 183),\n    (184, 184),\n    (185, 185),\n    (186, 186),\n    (187, 187),\n    (188, 188),\n    (189, 189),\n    (190, 190),\n    (191, 191),\n    (192, 192),\n    (193, 193),\n    (194, 194),\n    (195, 195),\n    (196, 196),\n    (197, 197),\n    (198, 198),\n    (199, 199),\n    (200, 200),\n    (201, 201),\n    (202, 202),\n    (203, 203),\n    (204, 204),\n    (205, 205),\n    (206, 206),\n    (207, 207),\n    (208, 208),\n    (209, 209),\n    (210, 210),\n    (211, 211),\n    (212, 212),\n    (213, 213),\n    (214, 214),\n    (215, 215),\n    (216, 216),\n    (217, 217),\n    (218, 218),\n    (219, 219),\n    (220, 220),\n    (221, 221),\n    (222, 222),\n    (223, 223),\n    (224, 224),\n    (225, 225),\n    (226, 226),\n    (227, 227),\n    (228, 228),\n    (229, 229),\n    (230, 230),\n    (231, 231),\n    (232, 232),\n    (233, 233),\n    (234, 234),\n    (235, 235),\n    (236, 236),\n    (237, 237),\n    (238, 238),\n    (239, 239),\n    (240, 240),\n    (241, 241),\n    (242, 242),\n    (243, 243),\n    (244, 244),\n    (245, 245),\n    (246, 246),\n    (247, 247),\n    (248, 248),\n    (249, 249),\n    (250, 250),\n    (251, 251),\n    (252, 252),\n    (253, 253),\n    (254, 254),\n    (255, 255),\n    (256, 256),\n    (257, 257),\n    (258, 258),\n    (259, 259),\n    (260, 260),\n    (261, 261),\n    (262, 262),\n    (263, 263),\n    (264, 264),\n    (265, 265),\n    (266, 266),\n    (267, 267),\n    (268, 268),\n    (269, 269),\n    (270, 270),\n    (271, 271),\n    (272, 272),\n    (273, 273),\n    (274, 274),\n    (275, 275),\n    (276, 276),\n    (277, 277),\n    (278, 278),\n    (279, 279),\n    (280, 280),\n    (281, 281),\n    (282, 282),\n    (283, 283),\n    (284, 284),\n    (285, 285),\n    (286, 286),\n    (287, 287),\n    (288, 288),\n    (289, 289),\n    (290, 290),\n    (291, 291),\n    (292, 292),\n    (293, 293),\n    (294, 294),\n    (295, 295),\n    (296, 296),\n    (297, 297),\n    (298, 298),\n    (299, 299),\n    (300, 300),\n    (301, 301),\n    (302, 302),\n    (303, 303),\n    (304, 304),\n    (305, 305),\n    (306, 306),\n    (307, 307),\n    (308, 308),\n    (309, 309),\n    (310, 310),\n    (311, 311),\n    (312, 312),\n    (313, 313),\n    (314, 314),\n    (315, 315),\n    (316, 316),\n    (317, 317),\n    (318, 318),\n    (319, 319),\n    (320, 320),\n    (321, 321),\n    (322, 322),\n    (323, 323),\n    (324, 324),\n    (325, 325),\n    (326, 326),\n    (327, 327),\n    (328, 328),\n    (329, 329),\n    (330, 330),\n    (331, 331),\n    (332, 332),\n    (333, 333),\n    (334, 334),\n    (335, 335),\n    (336, 336),\n    (337, 337),\n    (338, 338),\n    (339, 339),\n    (340, 340),\n    (341, 341),\n    (342, 342),\n    (343, 343),\n    (344, 344),\n    (345, 345),\n    (346, 346),\n    (347, 347),\n    (348, 348),\n    (349, 349),\n    (350, 350),\n    (351, 351),\n    (352, 352),\n    (353, 353),\n    (354, 354),\n    (355, 355),\n    (356, 356),\n    (357, 357),\n    (358, 358),\n    (359, 359),\n    (360, 360),\n    (361, 361),\n    (362, 362),\n    (363, 363),\n    (364, 364),\n    (365, 365),\n    (366, 366),\n    (367, 367),\n    (368, 368),\n    (369, 369),\n    (370, 370),\n    (371, 371),\n    (372, 372),\n    (373, 373),\n    (374, 374),\n    (375, 375),\n    (376, 376),\n    (377, 377),\n    (378, 378),\n    (379, 379),\n    (380, 380),\n    (381, 381),\n    (382, 382),\n    (383, 383),\n    (384, 384),\n    (385, 385),\n    (386, 386),\n    (387, 387),\n    (388, 388),\n    (389, 389),\n    (390, 390),\n    (391, 391),\n    (392, 392),\n    (393, 393),\n    (394, 394),\n    (395, 395),\n    (396, 396),\n    (397, 397),\n    (398, 398),\n    (399, 399),\n    (400, 400),\n    (401, 401),\n    (402, 402),\n    (403, 403),\n    (404, 404),\n    (405, 405),\n    (406, 406),\n    (407, 407),\n    (408, 408),\n    (409, 409),\n    (410, 410),\n    (411, 411),\n    (412, 412),\n    (413, 413),\n    (414, 414),\n    (415, 415),\n    (416, 416),\n    (417, 417),\n    (418, 418),\n    (419, 419),\n    (420, 420),\n    (421, 421),\n    (422, 422),\n    (423, 423),\n    (424, 424),\n    (425, 425),\n    (426, 426),\n    (427, 427),\n    (428, 428),\n    (429, 429),\n    (430, 430),\n    (431, 431),\n    (432, 432),\n    (433, 433),\n    (434, 434),\n    (435, 435),\n    (436, 436),\n    (437, 437),\n    (438, 438),\n    (439, 439),\n    (440, 440),\n    (441, 441),\n    (442, 442),\n    (443, 443),\n    (444, 444),\n    (445, 445),\n    (446, 446),\n    (447, 447),\n    (448, 448),\n    (449, 449),\n    (450, 450),\n    (451, 451),\n    (452, 452),\n    (453, 453),\n    (454, 454),\n    (455, 455),\n    (456, 456),\n    (457, 457),\n    (458, 458),\n    (459, 459),\n    (460, 460),\n    (461, 461),\n    (462, 462),\n    (463, 463),\n    (464, 464),\n    (465, 465),\n    (466, 466),\n    (467, 467),\n    (468, 468),\n    (469, 469),\n    (470, 470),\n    (471, 471),\n    (472, 472),\n    (473, 473),\n    (474, 474),\n    (475, 475),\n    (476, 476),\n    (477, 477),\n    (478, 478),\n    (479, 479),\n    (480, 480),\n    (481, 481),\n    (482, 482),\n    (483, 483),\n    (484, 484),\n    (485, 485),\n    (486, 486),\n    (487, 487),\n    (488, 488),\n    (489, 489),\n    (490, 490),\n    (491, 491),\n    (492, 492),\n    (493, 493),\n    (494, 494),\n    (495, 495),\n    (496, 496),\n    (497, 497),\n    (498, 498),\n    (499, 499)\n    ]\n", "num_lines": 521}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\n-- when used with '-g' debug generation option\n-- '*/*' leaked into a /* comment */ and broke\n-- GNU as.\nx */* y = 42\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule T12115 where\n\nimport GHC.Prim\nimport GHC.Types\n\nf :: (# Void#, (# #) #) -> String\nf = f\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GHCForeignImportPrim, UnliftedFFITypes, MagicHash #-}\n\nmodule Lib where\n\nimport GHC.Prim\n\nforeign import prim f1 :: Int# -> Int#\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M where\n\nf :: Double -> Double -> Bool\nf x y = if x < y then True else False\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15723A where\n\n{-# INLINE foo #-}\nfoo :: Int -> Int\nfoo x = {-# SCC foo1 #-} bar x\n\n{-# NOINLINE bar #-}\nbar :: Int -> Int\nbar x = x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15723B where\n\nimport T15723A\n\ntest :: Int -> Int\ntest x = {-# SCC test1 #-} foo $ foo x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug (tst) where\ntst :: Float -> Bool\ntst x = truncate x > (0::Int)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Q where\n\nimport Data.Bits\nimport Data.Word\nimport Data.Int\n\ntest1 :: Word32 -> Char\ntest1 w | w .&. 0x80000000 /= 0 = 'a'\ntest1 _ = 'b'\n\n-- this should use a testq instruction on x86_64\ntest2 :: Int64 -> Char\ntest2 w | w .&. (-3) /= 0 = 'a'\ntest2 _ = 'b'\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE EmptyDataDecls #-}\n\n-- This used to give warnings:\n--     ld: atom sorting error for _Main_MyType_closure_tbl and _Main_MyType2_closure_tbl in q.o\n--     ld: atom sorting error for _Main_MyType_closure_tbl and _Main_MyType2_closure_tbl in q.o\n--     ld: atom sorting error for _Main_MyType_closure_tbl and _Main_MyType2_closure_tbl in q.o\n-- when compiling on OS X (trac #2578).\n\nmodule Main (main) where\n\ndata MyType\ndata MyType2\n\nmain :: IO ()\nmain = print ()\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Spring where\n\nimport Data.Array.Unboxed\n\nstep :: UArray Int Double -> [Double]\nstep y = [y!1 + y!0]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fno-warn-redundant-constraints #-}\n\nmodule T3286 (train) where\n\nimport qualified Data.Map as M\nimport Data.List (groupBy, foldl')\nimport Data.Maybe (fromMaybe, fromJust)\nimport Data.Function (on)\nimport T3286b\n\ntype Prob = LogFloat\n\nlearn_states :: (Ord state) => [(observation, state)] -> M.Map state Prob\nlearn_states xs = histogram $ map snd xs\n\nlearn_observations ::  (Ord state, Ord observation) =>\n                       M.Map state Prob\n                    -> [(observation, state)]\n                    -> M.Map (observation, state) Prob\nlearn_observations state_prob = M.mapWithKey f . histogram\n    where f (_, state) prob = prob / (fromJust $ M.lookup state state_prob)\n\nhistogram :: (Ord a) => [a] -> M.Map a Prob\nhistogram xs = let hist = foldl' undefined M.empty xs in\n                M.map (/ M.foldrWithKey (\\_ a b -> a + b) 0 hist) hist\n\ntrain :: (Ord observation, Ord state) =>\n            [(observation, state)]\n         -> (observation -> [Prob])\ntrain sample = model\n    where\n        states = learn_states sample\n        state_list = M.keys states\n\n        observations = learn_observations states sample\n        observation_probs = fromMaybe (fill state_list []) . (flip M.lookup $\n                            M.fromList $ map (\\ (e, xs) -> (e, fill state_list xs)) $\n                                map (\\ xs -> (fst $ head xs, map snd xs)) $\n                                groupBy     ((==) `on` fst)\n                                            [(observation, (state, prob))\n                                                | ((observation, state), prob) <- M.toAscList observations])\n\n        model = observation_probs\n\n        fill :: Eq state => [state] -> [(state, Prob)] -> [Prob]\n        fill = undefined\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule T3286b (LogFloat) where\n\nnewtype LogFloat = LogFloat Double\n    deriving (Eq, Ord, Num, Show)\n\ninstance Fractional LogFloat where\n    (/) (LogFloat x) (LogFloat y)\n        |    x == 1\n          && y == 1 = error \"(/)\"\n        | otherwise                = LogFloat (x-y)\n    fromRational = LogFloat . fromRational\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug where\n\ncompose :: [a -> a] -> a -> a\ncompose =  foldr (.) id\n\nclass Compose a where\n    compose1 :: a -> a -> a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7237 where\n\nimport Data.List (foldl')\n\ndata SPair = SPair { pX, pY :: Double } deriving (Eq,Show)\n\ndata AList = AList { pairs :: [SPair] } deriving Show\n\nrnf' :: AList -> ()\nrnf' aList = foldl' (flip seq) () (pairs aList) `seq` ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T8205 where\n\nimport GHC.Exts\n\ndata Stack a = Stack a (Stack a)\n\ndropFromStack :: Int# -> Stack a -> Stack a\ndropFromStack 0# l = l\ndropFromStack n  (x `Stack` xs) = dropFromStack (n -# 1#) xs\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule M () where\n\nimport Data.Bits ((.&.))\n\nbitsSet :: Int -> Int -> Bool\nbitsSet mask i\n  = (i .&. mask == mask)\n\nclass Eq b => BitMask b where\n  assocBitMask :: [(b,Int)]\n\n  fromBitMask  :: Int -> b\n  fromBitMask i\n    = walk assocBitMask\n    where\n      walk []         = error \"Graphics.UI.WX.Types.fromBitMask: empty list\"\n      walk [(x,0)]    = x\n      walk ((x,m):xs) | bitsSet m i = x\n                      | otherwise   = walk xs\n\ndata Align   = AlignLeft\n             | AlignCentre\n             deriving Eq\n\ninstance BitMask Align where\n  assocBitMask\n    = [(AlignCentre,512)\n      ,(AlignLeft,  256)\n      ]\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M (f) where\n\nf :: Int -> Int\nf i = go [ 1, 0 ]\n    where\n      go :: [Int] -> Int\n      go []     = undefined\n      go [1]    = undefined\n      go (x:xs) | x == i    = 2\n                | otherwise = go xs\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\nmodule T9964 where\n\nimport GHC.Base\n\ncrash :: IO ()\ncrash = IO (\\s ->\n  let\n    {-# NOINLINE s' #-}\n    s' = s\n  in (# s', () #))\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE MagicHash #-}\nmodule Bug where\n\nimport GHC.Exts (TYPE, RuntimeRep, Weak#, State#, RealWorld, mkWeak# )\n\nclass Foo (a :: TYPE rep) where\n  bar :: forall rep2 (b :: TYPE rep2). (a -> a -> b) -> a -> a -> b\n\nbaz :: forall rep (a :: TYPE rep). Foo a => a -> a -> (# a, a #)\nbaz = bar (#,#)\n\nobscure :: (forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep)\n                   (a :: TYPE rep1) (b :: TYPE rep2).\n                   a -> b -> (# a, b #)) -> ()\nobscure _ = ()\n\nquux :: ()\nquux = obscure (#,#)\n\nprimop :: forall (rep :: RuntimeRep) (a :: TYPE rep) b c.\n          a -> b -> (State# RealWorld -> (# State# RealWorld, c #))\n       -> State# RealWorld -> (# State# RealWorld, Weak# b #)\nprimop = mkWeak#\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Bits\nimport GHC.Float\nimport GHC.Word\nimport Numeric\n\nmain :: IO ()\nmain = do\n    putStrLn \"Float\"\n    mapM_ print floats\n    putStrLn \"\\nDouble\"\n    mapM_ print doubles\n    putStrLn \"\\nWord32\"\n    mapM_ (printHex32 . castFloatToWord32) floats\n    putStrLn \"\\nWord64\"\n    mapM_ (printHex64 . castDoubleToWord64) doubles\n    putStrLn \"Done!\"\n\nfloats :: [Float]\nfloats = map castWord32ToFloat $ 0 : map (2^) [ 0 .. 31 ]\n\ndoubles :: [Double]\ndoubles = map castWord64ToDouble $ 0 : map (2^) [ 0 .. 63 ]\n\nprintHex32 :: Word32 -> IO ()\nprintHex32 w = putStrLn $ \"0x\" ++ showHex (0xffffffff .&. w) \"\"\n\nprintHex64 :: Word64 -> IO ()\nprintHex64 w = putStrLn $ \"0x\" ++ showHex w \"\"\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! cg001: main = -42 -- take 1\n\nmain = print ( f () )\n     where\n       f :: a -> Int\n       f x = -42\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print ((f id2) (10 + thirty_two))\n  where\n    f x = g x\n      where\n        g x = h x\n          where\n            h x = x\n\n    thirty_two :: Int\n    thirty_two = 32\n\nid2 x = x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print (id2 (id2 id2) (42::Int))\n--      where\n--      id2 = s k k\n\n-- id2 x = s k k x\n\nid2 = s k k\n\ns x y z = x z (y z)\n\nk x y = x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print (length ([9,8,7,6,5,4,3,2,1] :: [Int]))\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! answer: 65532\n\nmain = print foo\n\nfoo :: Int\nfoo = ((1 + 2 + 32767 - 4) * 6) --later? `div` 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print (length thirteen_ones)\n     where\n        thirteen_ones   = take (13::Int) ones\n\n        ones :: [Int]\n        ones            = 1 : ones\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data Tree a = Leaf a | Branch (Tree a) (Tree a)\n\nmain = print (height our_tree)\n    where\n      our_tree :: Tree Int\n      our_tree =\n        Branch (Branch (Leaf 1) (Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1)))\n               (Branch (Leaf 1) (Leaf 1))\n\n\nheight :: Tree a -> Int\n\nheight (Leaf _)         = 1\nheight (Branch t1 t2)   = 1 + max (height t1) (height t2)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print (length comp_list)\n where\n    comp_list :: [(Int,Int)]\n    comp_list = [ (elem1,elem2)\n                | elem1 <- given_list,\n                  elem2 <- given_list,\n                  elem1 >= (4::Int),\n                  elem2 <  (3::Int)\n                ]\n\n    given_list :: [Int]\n    given_list = [1,2,3,4,5,6,7,8,9]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print (length take_list)\n where\n    take_list :: [Int]\n    take_list = takeWhile (\\ x -> x < 6) given_list\n\n    given_list :: [Int]\n    given_list = [1,2,3,4,5,6,7,8,9]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print a\n  where\n    a :: Int\n    b :: Int\n    (a, b) = (3 + 4, 5 + 6)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! simple overloading example\n\nclass Foo a where\n    foo :: a -> a -> Bool\n\nclass (Foo a) => Bar a where\n    bar :: a -> a -> Bool\n\ninstance Foo Int where\n    foo a b = a /= b\n\ninstance Foo Bool where\n    foo a b = a /= b\n\ninstance Bar Int where\n    bar a b = a < b\n\ninstance Bar Bool where\n    bar a b = a < b\n\nfoO = if bar (2::Int) (3::Int) then\n            if bar False True then\n                (42::Int)\n            else\n                (888::Int)\n       else\n          (999::Int)\n\nmain = print foO\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !!! move arguments around on the stacks, mainly the B stack\n\nimport GHC.Base ( Float#, Double#, Int#, Int(..) )\n\n\nmain = print foo\n\nfoo = I#\n        ( f 1.1##\n            2.1#\n            True\n            3.1##\n            4.1#\n            5.1##\n            6.1##\n            42# -- the answer!\n            7.1#\n            8.1# )\n    where\n      f :: Double# -> Float# -> Bool -> Double# -> Float#\n        -> Double# -> Double# -> Int# -> Float# -> Float#\n        -> Int#\n      f b1 s2 t b3 s4 b5 b6 i42 s7 s8\n        -- evens, then odds\n        = g s2 b3 b5 i42 s8 b1 t s4 b6 s7\n\n      g :: Float# -> Double# -> Double# -> Int# -> Float#\n        -> Double# -> Bool -> Float# -> Double# -> Float#\n        -> Int#\n      g s2 b3 b5 i42 s8 b1 t s4 b6 s7\n        -- powers of 2 backwards, then others forwards\n        = h s7 b6 t b5 s2 b3 i42 s8 b1 s4\n\n      h :: Float# -> Double# -> Bool -> Double# -> Float#\n        -> Double# -> Int# -> Float# -> Double# -> Float#\n        -> Int#\n      h s7 b6 t b5 s2 b3 i42 s8 b1 s4\n        = i42\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom: Kevin Hammond <kh>\nTo: partain\nSubject: Nasty Overloading\nDate: Wed, 23 Oct 91 16:19:46 BST\n-}\nmodule Main where\n\nclass Foo a where\n        o1 :: a -> a -> Bool\n        o2 :: a -> Int\n\n--      o2 :: Int\n    -- Lennart: The type of method o2 does not contain the variable a\n    -- (and it must according to line 1 page 29 of the manual).\n\nclass Foo tyvar => Bar tyvar where\n        o3 :: a -> tyvar -> tyvar\n\n-- class (Eq a, Foo a) => Baz a where\nclass (Ord a, Foo a) => Baz a where\n        o4 :: a -> a -> (String,String,String,a)\n\ninstance (Ord a, Foo a) =>  Foo [a] where\n        o2 x = 100\n        o1 a b = a < b || o1 (head a) (head b)\n\n-- instance Bar [a] where\ninstance (Ord a, Foo a) => Bar [a] where\n        o3 x l = []\n    --\n    -- Lennart: I guess the instance declaration\n    --  instance Bar [w] where\n    --          o3 x l = []\n    -- is wrong because to be a Bar you have to be a Foo.  For [w] to\n    -- be a Foo, w has to be Ord and Foo.  But w is not Ord or Foo in\n    -- this instance declaration so it must be wrong.  (Page 31, line\n    -- 7: The context c' must imply ...)\n\ninstance Baz a => Baz [a] where\n        o4 [] [] = (\"Nil\", \"Nil\", \"Nil\", [])\n        o4 l1 l2 =\n                (if o1 l1 l2 then \"Y\" else \"N\",\n                 if l1 == l2 then \"Y\" else \"N\",\n--               if o4 (head l1) (head l2) then \"Y\" else \"N\",\n                 case o4 (head l1) (head l2) of\n                        (_,_,_,l3) -> if (o1 (head l1) l3) then \"Y\" else \"N\",\n                 l1 ++ l2 )\n\ninstance Foo Int where\n        o2 x = x\n        o1 i j = i == j\n\ninstance Bar Int where\n        o3 _ j = j + 1\n\ninstance Baz Int where\n--      o4 i j = i > j\n        o4 i j = (if i>j then \"Y\" else \"Z\", \"p\", \"q\", i+j)\n--simpl:o4 i j = (\"Z\", \"p\", \"q\", i+j)\n\n{- also works w/ glhc! -}\n\nmain =  if o4 [1,2,3] [1,3,2::Int] /= (\"Y\",\"N\",\"Y\",[1,2,3,1,3,2]) then\n                (print \"43\\n\")\n        else    (print \"144\\n\")\n\n{- works: glhc\nmain =  case o4 [1,2,3] [1,3,2::Int] of\n                (s1,s2,s3,x) -> print s1\n\nmain =  case o4 ([]::[Int]) ([]::[Int]) of\n                (s1,s2,s3,x) -> print s1\n-}\n\n{- simple main: breaks nhc, works w/ glhc\nmain = case o4 (3::Int) (4::Int) of (s1,s2,s3,x) -> print s1\n-}\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! cg014: main = -42 -- twice: in Float and Double\n\nmain = print ((show ( (-42) :: Float )) ++ \" \" ++ (show ( (-42) :: Double )) ++ \"\\n\")\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main ( main ) where\n\nimport Foreign\nimport Foreign.C\nimport GHC.Exts\n\ndata CList = CNil | CCons Int# CList\n\nmk :: Int# -> CList\nmk n  = if isTrue# (n ==# 0#)\n        then CNil\n        else CCons 1# (mk (n -# 1#))\n\nclen :: CList -> Int#\nclen CNil = 0#\nclen (CCons _ cl) = 1# +# (clen cl)\n\nmain = case (clen list4) of\n                len4 ->\n                  case (len4 +# len4) of\n                    8# -> finish 65#    -- 'A'\n                    _  -> finish 66#    -- 'B'\n      where\n      list4     = mk 4#\n\nfinish :: Int# -> IO ()\nfinish n = c_putchar (castCharToCChar (C# (chr# n))) >> return ()\n\nforeign import ccall unsafe \"putchar\"\n  c_putchar :: CChar -> IO CInt\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests calls of `error' (that make calls of `error'...)\n--\nmain = error (\"1st call to error\\n\"++(\n       error (\"2nd call to error\\n\"++(\n       error (\"3rd call to error\\n\"++(\n       error (\"4th call to error\\n\"++(\n       error (\"5th call to error\\n\"++(\n       error (\"6th call to error\"\n       )))))))))))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test of cyclic default methods\n--\nclass Foo a where\n    op1 :: Fractional b => a -> b -> Bool\n    op2 :: Fractional b => a -> b -> Bool\n    op3 :: Fractional b => a -> b -> Bool\n    op4 :: Fractional b => a -> b -> Bool\n    op5 :: Fractional b => a -> b -> Bool\n    op6 :: Fractional b => a -> b -> Bool\n\n    -- each depends on the next:\n    op1 a b = not (op2 a b)\n    op2 a b = not (op3 a b)\n    op3 a b = not (op4 a b)\n    op4 a b = not (op5 a b)\n    op5 a b = not (op6 a b)\n    op6 a b = not (op1 a b)\n\n-- now some instance decls to break the cycle:\ninstance Foo Int where\n    op1 a b = a == 42\n\ninstance Foo Char where\n    op1 a b = a == 'c'\n\ninstance Foo a => Foo [a] where\n    op1 a b = null a\n\n-- try it:\nmain = do\n    putStr (show (op2 (3::Int)    3.14159))\n    putStr (show (op2 'X'         3.14159))\n    putStr (show (op2 ([]::[Char])3.14159))\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !!! test of datatype with many unboxed fields\n--\nimport GHC.Base( Float# )\nimport GHC.Float\n\nmain = print (selectee1 + selectee2)\n\ndata Tfo = Tfo Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# Float#\n\nyyy = (Tfo (-0.0018#)  (-0.8207#)   (0.5714#)\n            (0.2679#)  (-0.5509#)  (-0.7904#)\n            (0.9634#)   (0.1517#)   (0.2209#)\n            (0.0073#)   (8.4030#)   (0.6232#))\n\nxxx = (Tfo (-0.8143#)  (-0.5091#)  (-0.2788#)\n           (-0.0433#)  (-0.4257#)   (0.9038#)\n           (-0.5788#)   (0.7480#)   (0.3246#)\n            (1.5227#)   (6.9114#)  (-7.0765#))\n\nselectee1 = F# (case xxx of\n                  Tfo _ _ _ _ _ _ _ x _ _ _ _ -> x)\n\nselectee2 = F# (case xxx of\n                  Tfo _ _ y _ _ _ _ _ _ _ _ _ -> y)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! printing of floating-pt numbers\n--\nmain = print (1.234e5 :: Float)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! reading/showing of Ints/Integers\n--\nmain = print ((read \"-1\") :: Integer)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Tests garbage collection in the branch of a case\n-- !!!  alternative where the constructor is returned in the heap.\n\n{- This is also a rather stressful test for another reason.\n   The mutual recursion between munch and f causes lots of\n   closures to be built, of the form (munch n s), for some n and s.\n   Now, all of these closures are entered and each has as its value\n   the result delivere by the next; so the result is that there is\n   a massive chain of identical updates.\n\n   As it turns out, they are mostly garbage, so the GC could eliminate\n   them (though this isn't implemented at present), but that isn't\n   necessarily the case.\n\n   The only correct solution is to spot that the updates are all\n   updating with the same value (update frames stacked on top of each\n   other), and update all but one with indirections to the last\n   remaining one.  This could be done by GC, or at the moment the\n   frame is pushed.\n\n   Incidentally, hbc won't have this particular problem, because it\n   updates immediately.\n\n   NOTE: [March 97]  Now that stack squeezing happens when GC happens,\n   the stack is squished at GC.  So this program uses a small stack\n   in a small heap (eg 4m heap 2m stack), but in a big heap (no GC)\n   it needs a much bigger stack (10m)!  It would be better to try GC/stack\n   squeezing on stack oflo.\n-}\n\nmodule Main where\n\nmain = munch 100000 (inf 3)\n\ndata Stream a\n  = MkStream a a a a a a a a a (Stream a)\n  | Empty\n\ninf :: Int -> Stream Int\ninf n = MkStream n n n n n n n n n (inf n)\n\nmunch :: Int -> Stream a -> IO ()\n\nmunch n Empty = return () -- error \"this never happens!\\n\"\n    -- this first equation mks it non-strict in \"n\"\n    -- (NB: call the \"error\" makes it strict)\n\nmunch 0 _ = putStr \"I succeeded!\\n\"\nmunch n s = case (f n s) of\n              (True, rest) -> rest\n              (False, _)   -> error \"this never happens either\\n\"\n\n--f :: Int -> Stream a -> (Bool, [Request])\n\nf n (MkStream _ _ _ _ _ _ _ _ _ rest)\n  = -- garbage collection *HERE*, please!\n    -- (forced by the closure for n-1)\n    (True, munch (n - 1) rest)\n\n-- munch and f are mutually recursive, just to be nasty\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests stack stubbing: if \"f\" doesn't stub \"ns\",\n-- !!! the program has a space leak.\n\nmodule Main where\n\nmain = f (putStr \"a\")\n         (take 1000000 (repeat True))\n         (putStr \"b\")\n\nf a ns b = if last ns then a else b\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test super-dictionary grabification\n--\n\nmain = putStr (show (is_one (1.2::Double)))\n\nis_one :: RealFloat a => a -> Bool\n\nis_one x = x == 1.0\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n-- !!! test various I/O Requests\n--\n--\nimport Control.Exception\nimport System.Environment\nimport System.IO\nimport Debug.Trace (trace)\nimport Text.Regex\nimport Data.Maybe\n\nmain = do\n    prog <- getProgName\n    let Just (name:_) = matchRegex (mkRegex \".*(cgrun025)\") prog\n    hPutStr stderr (shows name \"\\n\")\n    args <- getArgs\n    hPutStr stderr (shows args \"\\n\")\n    path <- getEnv \"PATH\"\n    hPutStr stderr (\"GOT PATH\\n\")\n    stdin_txt <- getContents\n    putStr stdin_txt\n    file_cts <- readFile (head args)\n    hPutStr  stderr file_cts\n    trace \"hello, trace\" $\n      catch (getEnv \"__WURBLE__\" >> return ()) (\\ (e :: SomeException) -> error \"hello, error\")\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- !!! simple tests of primitive arrays\n--\nmodule Main ( main ) where\n\nimport GHC.Exts\nimport Data.Char        ( chr )\n\nimport Control.Monad.ST\nimport Data.Array.ST\nimport Data.Array.Unboxed\n\nimport Data.Ratio\n\nmain = putStr\n         (test_chars    ++ \"\\n\"  ++\n          test_ints     ++ \"\\n\"  ++\n          test_addrs    ++ \"\\n\"  ++\n          test_floats   ++ \"\\n\"  ++\n          test_doubles  ++ \"\\n\"  ++\n          test_ptrs     ++ \"\\n\")\n\n\n-- Arr# Char# -------------------------------------------\n-- (main effort is in packString#)\n\ntest_chars :: String\ntest_chars\n  = let arr# = f 1000\n    in\n        shows (lookup_range arr# 42# 416#) \"\\n\"\n  where\n    f :: Int -> UArray Int Char\n\n    f size@(I# size#)\n      = runST (\n            -- allocate an array of the specified size\n          newArray_ (0, (size-1))       >>= \\ arr# ->\n\n            -- fill in all elements; elem i has \"i\" put in it\n          fill_in arr# 0# (size# -# 1#) >>\n\n            -- freeze the puppy:\n          freeze arr#\n        )\n\n    fill_in :: STUArray s Int Char -> Int# -> Int# -> ST s ()\n\n    fill_in arr_in# first# last#\n      = if isTrue# (first# ># last#)\n        then return ()\n        else writeArray arr_in# (I# first#) ((chr (I# first#))) >>\n             fill_in arr_in# (first# +# 1#) last#\n\n    lookup_range :: UArray Int Char -> Int# -> Int# -> [Char]\n    lookup_range arr from# to#\n      = if isTrue# (from# ># to#)\n        then []\n        else (arr ! (I# from#))\n             : (lookup_range arr (from# +# 1#) to#)\n\n-- Arr# Int# -------------------------------------------\n\ntest_ints :: String\ntest_ints\n  = let arr# = f 1000\n    in\n        shows (lookup_range arr# 42# 416#) \"\\n\"\n  where\n    f :: Int -> UArray Int Int\n\n    f size@(I# size#)\n      = runST (\n            -- allocate an array of the specified size\n          newArray_ (0, (size-1))       >>= \\ arr# ->\n\n            -- fill in all elements; elem i has i^2 put in it\n          fill_in arr# 0# (size# -# 1#) >>\n\n            -- freeze the puppy:\n          freeze arr#\n        )\n\n    fill_in :: STUArray s Int Int -> Int# -> Int# -> ST s ()\n\n    fill_in arr_in# first# last#\n      = if isTrue# (first# ># last#)\n        then return ()\n        else writeArray arr_in# (I# first#) (I# (first# *# first#)) >>\n             fill_in arr_in# (first# +# 1#) last#\n\n    lookup_range :: UArray Int Int -> Int# -> Int# -> [Int]\n    lookup_range arr from# to#\n      = if isTrue# (from# ># to#)\n        then []\n        else (arr ! (I# from#))\n             : (lookup_range arr (from# +# 1#) to#)\n\n-- Arr# Addr# -------------------------------------------\n\ntest_addrs :: String\ntest_addrs\n  = let arr# = f 1000\n    in\n        shows (lookup_range arr# 42# 416#) \"\\n\"\n  where\n    f :: Int -> UArray Int (Ptr ())\n\n    f size@(I# size#)\n      = runST (\n            -- allocate an array of the specified size\n          newArray_ (0, (size-1))       >>= \\ arr# ->\n\n            -- fill in all elements; elem i has i^2 put in it\n          fill_in arr# 0# (size# -# 1#) >>\n\n            -- freeze the puppy:\n          freeze arr#\n        )\n\n    fill_in :: STUArray s Int (Ptr ()) -> Int# -> Int# -> ST s ()\n\n    fill_in arr_in# first# last#\n      = if isTrue# (first# ># last#)\n        then return ()\n        else writeArray arr_in# (I# first#)\n                            (Ptr (int2Addr# (first# *# first#))) >>\n             fill_in arr_in# (first# +# 1#) last#\n\n    lookup_range :: UArray Int (Ptr ()) -> Int# -> Int# -> [ Int ]\n    lookup_range arr from# to#\n      = let\n            a2i (Ptr a#) = I# (addr2Int# a#)\n        in\n        if isTrue# (from# ># to#)\n        then []\n        else (a2i (arr ! (I# from#)))\n             : (lookup_range arr (from# +# 1#) to#)\n\n-- Arr# Float# -------------------------------------------\n\ntest_floats :: String\ntest_floats\n  = let arr# = f 1000\n    in\n        shows (lookup_range arr# 42# 416#) \"\\n\"\n  where\n    f :: Int -> UArray Int Float\n\n    f size@(I# size#)\n      = runST (\n            -- allocate an array of the specified size\n          newArray_ (0, (size-1))       >>= \\ arr# ->\n\n            -- fill in all elements; elem i has \"i * pi\" put in it\n          fill_in arr# 0# (size# -# 1#) >>\n\n            -- freeze the puppy:\n          freeze arr#\n        )\n\n    fill_in :: STUArray s Int Float -> Int# -> Int# -> ST s ()\n\n    fill_in arr_in# first# last#\n      = if isTrue# (first# ># last#)\n        then return ()\n{-      else let e = ((fromIntegral (I# first#)) * pi)\n             in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>\n             fill_in arr_in# (first# +# 1#) last#\n-}\n        else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>\n             fill_in arr_in# (first# +# 1#) last#\n\n    lookup_range :: UArray Int Float -> Int# -> Int# -> [Float]\n    lookup_range arr from# to#\n      = if isTrue# (from# ># to#)\n        then []\n        else (arr ! (I# from#))\n             : (lookup_range arr (from# +# 1#) to#)\n\n-- Arr# Double# -------------------------------------------\n\ntest_doubles :: String\ntest_doubles\n  = let arr# = f 1000\n    in\n        shows (lookup_range arr# 42# 416#) \"\\n\"\n  where\n    f :: Int -> UArray Int Double\n\n    f size@(I# size#)\n      = runST (\n            -- allocate an array of the specified size\n          newArray_ (0, (size-1))       >>= \\ arr# ->\n\n            -- fill in all elements; elem i has \"i * pi\" put in it\n          fill_in arr# 0# (size# -# 1#) >>\n\n            -- freeze the puppy:\n          freeze arr#\n        )\n\n    fill_in :: STUArray s Int Double -> Int# -> Int# -> ST s ()\n\n    fill_in arr_in# first# last#\n      = if isTrue# (first# ># last#)\n        then return ()\n        else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>\n             fill_in arr_in# (first# +# 1#) last#\n\n    lookup_range :: UArray Int Double -> Int# -> Int# -> [Double]\n    lookup_range arr from# to#\n      = if isTrue# (from# ># to#)\n        then []\n        else (arr ! (I# from#))\n             : (lookup_range arr (from# +# 1#) to#)\n\n-- Arr# (Ratio Int) (ptrs) ---------------------------------\n-- just like Int# test\n\ntest_ptrs :: String\ntest_ptrs\n  = let arr# = f 1000\n    in\n        shows (lookup_range arr# 42 416) \"\\n\"\n  where\n    f :: Int -> Array Int (Ratio Int)\n\n    f size\n      = runST (\n          newArray (1, size) (3 % 5)    >>= \\ arr# ->\n          -- don't fill in the whole thing\n          fill_in arr# 1 400            >>\n          freeze arr#\n        )\n\n    fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s ()\n\n    fill_in arr_in# first last\n      = if (first > last)\n        then return ()\n        else writeArray arr_in# first (fromIntegral (first * first)) >>\n             fill_in  arr_in# (first + 1) last\n\n    lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int]\n    lookup_range array from too\n      = if (from > too)\n        then []\n        else (array ! from) : (lookup_range array (from + 1) too)\n", "num_lines": 251}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! simple test of 0-method classes\n--\n\nclass (Num a, Integral a) => Foo a\n\nmain = putStr (shows (f ((fromInteger 21)::Int)\n                        ((fromInteger 37))) \"\\n\")\n\ninstance Foo Int\n\nf :: Foo a => a -> a -> Integer\n\nf a b = toInteger (a + b)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = putStr (shows (f (read \"42.0\")) \"\\n\")\n\n-- f compiled to bogus code with ghc 0.18 and earlier\n-- switch() on a DoubleReg\n\nf :: Double -> Int\nf 1.0 = 1\nf 2.0 = 2\nf 3.0 = 3\nf x = round x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !! test GEN reps w/ unboxed values in them\n-- !! NB: it was the static ones that were hosed...\n--\nmodule Main ( main ) where\n\n--import PrelBase\nimport GHC.Base\n\nmain = do\n    putStr (shows (sum ([1..1{-30-}]++[1..1{-40-}]++[11,22])) \"\\n\")\n    putStr (shows (prog 1{-30-} 1{-40-}) \"\\n\")\n\ndata Foo a\n  = MkFoo [a] Int# [Int] Int# [(a,Int)] Int#\n  -- The above will cause a *horrible* GEN rep'n.\n\nprog :: Int -> Int -> Int\n\nprog size_1 size_2\n  = let\n        list1 = static1 : (map mk_foo [1 .. size_1])\n        list2 = static2 : (map mk_foo [1 .. size_2])\n    in\n    I# (add_up 0# list1 (reverse list2))\n\nstatic1 = MkFoo (error \"static11\") 11# [] 11# (error \"static12\") 11#\nstatic2 = MkFoo (error \"static21\") 22# [] 22# (error \"static22\") 22#\n\none, two :: Int\none = 1; two = 2\n\nmk_foo i@(I# i#)\n  = MkFoo (error \"list1\") i# [i,i] i# (error \"list2\") i#\n\nadd_up :: Int# -> [Foo a] -> [Foo a] -> Int#\n\nadd_up acc [] [] = acc\nadd_up acc [] ys  = add_up acc ys []\nadd_up acc (x:xs) (y:ys) = add_up (acc +# add x y) xs ys\nadd_up acc (x:xs) [] = add_up acc xs []\n\nadd :: Foo a -> Foo a -> Int#\nadd (MkFoo _ _ _ _ _ x) (MkFoo _ _ _ _ _ y)\n  = x +# y\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !! pattern-matching failure on functions that return Int#\n\n--import PrelBase --ghc1.3\nimport GHC.Base\n\nmain = putStr (shows (I# (foo bar1 bar2)) \"\\n\")\n  where\n    bar1 = Bar1 40 (39,38) resps\n    bar2 = Bar1  2 ( 1, 0) resps\n    resps = error \"1.2 responses\"\n\ndata Response = Response -- stub\n\ndata Bar\n  = Bar1 Int (Int,Int) [Response]\n  | Bar2 Int Int#\n  | Bar3 Int\n\nfoo :: Bar -> Bar -> Int#\n\nfoo (Bar1 (I# i) _ _) (Bar1 (I# j) _ _) = i +# j\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !! worker/wrapper turns ( \\ <absent> -> Int# ) function\n-- !! into Int# -- WRONG\n\n--import PrelBase --ghc1.3\nimport GHC.Base\n\nmain = putStr (shows true_or_false \"\\n\")\n  where\n    true_or_false\n      = case (cmp_name True imp1 imp2) of\n          -1# -> False\n          0#  -> True\n          1#  -> False\n\n    imp1 = Imp s \"Imp1\" s s\n    imp2 = Imp s \"Imp2\" s s\n\n    s = \"String!\"\n\n-- taken from compiler: basicTypes/ProtoName.lhs\n\ncmp_name :: Bool -> ProtoName -> ProtoName -> Int#\n\ncmp_name by_local (Unk n1) (Unk n2)        = cmpString n1 n2\ncmp_name by_local (Unk n1) (Imp m n2 _ o2) = cmpString n1 (if by_local then o2 else n2)\ncmp_name by_local (Unk n1) (Prel nm)\n  =  let  (_, n2) = getOrigName nm  in\n     cmpString n1 n2\n\ncmp_name by_local (Prel n1) (Prel n2) = cmpName n1 n2\n\ncmp_name True  (Imp _ _ _ o1) (Imp _ _ _ o2) = cmpString o1 o2\n\ncmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _)\n  = case cmpString n1 n2 of {\n      -1# -> -1#;\n      0# -> case cmpString m1 m2 of {\n               0# -> 0#;\n               xxx -> if null m1 || null m2\n                      then 0#\n                      else xxx\n             };\n      _ -> 1#\n    }\n\ncmp_name True (Imp _ _ _ o1) (Prel nm)\n  = let\n        (_, n2) = getOrigName nm\n    in\n    cmpString o1 n2\n\ncmp_name False (Imp m1 n1 _ _) (Prel nm)\n  = case getOrigName nm   of { (m2, n2) ->\n    case cmpString n1 n2 of { -1# -> -1#; 0# -> cmpString m1 m2; _ -> 1# }}\n\ncmp_name by_local other_p1 other_p2\n  = case cmp_name by_local other_p2 other_p1 of -- compare the other way around\n      -1#  -> 1#\n      0#  -> 0#\n      _ -> -1#\n\ndata ProtoName\n  = Unk         String  -- local name in module\n\n  | Imp         String  -- name of defining module\n                String  -- name used in defining name\n                String  -- name of the module whose interface told me\n                        -- about this thing\n                String  -- occurrence name\n\n  | Prel        String{-Name-}\n\ncmpString, cmpName :: String -> String -> Int#\ncmpString a b = 0#\ncmpName = cmpString\n\ngetOrigName :: String -> (String, String)\ngetOrigName x = (\"MODULE\", x)\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! fromRational woes\nimport Data.Ratio -- 1.3\n\nmain = putStr (\n   shows tinyFloat  ( '\\n'\n : shows t_f        ( '\\n'\n : shows hugeFloat  ( '\\n'\n : shows h_f        ( '\\n'\n : shows tinyDouble ( '\\n'\n : shows t_d        ( '\\n'\n : shows hugeDouble ( '\\n'\n : shows h_d        ( '\\n'\n : shows x_f        ( '\\n'\n : shows x_d        ( '\\n'\n : shows y_f        ( '\\n'\n : shows y_d        ( \"\\n\"\n )))))))))))))\n  where\n    t_f :: Float\n    t_d :: Double\n    h_f :: Float\n    h_d :: Double\n    x_f :: Float\n    x_d :: Double\n    y_f :: Float\n    y_d :: Double\n    t_f = fromRationalX (toRational tinyFloat)\n    t_d = fromRationalX (toRational tinyDouble)\n    h_f = fromRationalX (toRational hugeFloat)\n    h_d = fromRationalX (toRational hugeDouble)\n    x_f = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational)\n    x_d = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational)\n    y_f = 1.82173691287639817263897126389712638972163e-300\n    y_d = 1.82173691287639817263897126389712638972163e-300\n\nfromRationalX :: (RealFloat a) => Rational -> a\nfromRationalX r =\n        let\n            h = ceiling (huge `asTypeOf` x)\n            b = toInteger (floatRadix x)\n            x = fromRat 0 r\n            fromRat e0 r' =\n                let d = denominator r'\n                    n = numerator r'\n                in  if d > h then\n                       let e = integerLogBase b (d `div` h) + 1\n                       in  fromRat (e0-e) (n % (d `div` (b^e)))\n                    else if abs n > h then\n                       let e = integerLogBase b (abs n `div` h) + 1\n                       in  fromRat (e0+e) ((n `div` (b^e)) % d)\n                    else\n                       scaleFloat e0 (rationalToRealFloat {-fromRational-} r')\n        in  x\n\n{-\nfromRationalX r =\n  rationalToRealFloat r\n{- Hmmm...\n        let\n            h = ceiling (huge `asTypeOf` x)\n            b = toInteger (floatRadix x)\n            x = fromRat 0 r\n\n            fromRat e0 r' =\n{--}            trace (shows e0 ('/' : shows r' ('/' : shows h \"\\n\"))) (\n                let d = denominator r'\n                    n = numerator r'\n                in  if d > h then\n                       let e = integerLogBase b (d `div` h) + 1\n                       in  fromRat (e0-e) (n % (d `div` (b^e)))\n                    else if abs n > h then\n                       let e = integerLogBase b (abs n `div` h) + 1\n                       in  fromRat (e0+e) ((n `div` (b^e)) % d)\n                    else\n                       scaleFloat e0 (rationalToRealFloat r')\n                       -- now that we know things are in-bounds,\n                       -- we use the \"old\" Prelude code.\n{--}            )\n        in  x\n-}\n-}\n\n-- Compute the discrete log of i in base b.\n-- Simplest way would be just divide i by b until it's smaller then b, but that would\n-- be very slow!  We are just slightly more clever.\nintegerLogBase :: Integer -> Integer -> Int\nintegerLogBase b i =\n     if i < b then\n        0\n     else\n        -- Try squaring the base first to cut down the number of divisions.\n        let l = 2 * integerLogBase (b*b) i\n            doDiv :: Integer -> Int -> Int\n            doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)\n        in  doDiv (i `div` (b^l)) l\n\n\n------------\n\n-- Compute smallest and largest floating point values.\ntiny :: (RealFloat a) => a\ntiny =\n        let (l, _) = floatRange x\n            x = encodeFloat 1 (l-1)\n        in  x\n\nhuge :: (RealFloat a) => a\nhuge =\n        let (_, u) = floatRange x\n            d = floatDigits x\n            x = encodeFloat (floatRadix x ^ d - 1) (u - d)\n        in  x\n\ntinyDouble = tiny :: Double\ntinyFloat  = tiny :: Float\nhugeDouble = huge :: Double\nhugeFloat  = huge :: Float\n\n{-\n[In response to a request by simonpj, Joe Fasel writes:]\n\nA quite reasonable request!  This code was added to the Prelude just\nbefore the 1.2 release, when Lennart, working with an early version\nof hbi, noticed that (read . show) was not the identity for\nfloating-point numbers.  (There was a one-bit error about half the time.)\nThe original version of the conversion function was in fact simply\na floating-point divide, as you suggest above.  The new version is,\nI grant you, somewhat denser.\n\nHow's this?\n\n--Joe\n-}\n\n\nrationalToRealFloat :: (RealFloat a) => Rational -> a\n\nrationalToRealFloat x   =  x'\n        where x'    = f e\n\n--              If the exponent of the nearest floating-point number to x\n--              is e, then the significand is the integer nearest xb^(-e),\n--              where b is the floating-point radix.  We start with a good\n--              guess for e, and if it is correct, the exponent of the\n--              floating-point number we construct will again be e.  If\n--              not, one more iteration is needed.\n\n              f e   = if e' == e then y else f e'\n                      where y      = encodeFloat (round (x * (1%b)^^e)) e\n                            (_,e') = decodeFloat y\n              b     = floatRadix x'\n\n--              We obtain a trial exponent by doing a floating-point\n--              division of x's numerator by its denominator.  The\n--              result of this division may not itself be the ultimate\n--              result, because of an accumulation of three rounding\n--              errors.\n\n              (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'\n                                        / fromInteger (denominator x))\n\n", "num_lines": 162}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Foreign.C\nimport System.IO.Unsafe ( unsafePerformIO )\n\nc :: Double -> Double\nc x = cos x\n  where\n    cos :: Double -> Double\n    cos x = realToFrac (unsafePerformIO (c_cos (realToFrac x)))\n\nforeign import ccall unsafe \"cos\"\n  c_cos :: CDouble -> IO CDouble\n\nmain = putStr (shows (c 0.0) \"\\n\")\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Won't compile unless the compile succeeds on\n-- !! the \"single occurrence of big thing in a duplicated small thing\"\n-- !! inlining old-chestnut.  WDP 95/03\n--\nmodule Main ( main, g ) where\n\nmain = putStr (shows (g 42 45 45) \"\\n\")\n\ng :: Int -> Int -> Int -> [Int]\n\ng x y z\n  = let\n        f a b = a + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b\n        g c = f c c\n    in\n    [g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Andy Gill bug report 95/08:\n-- Constant strings with '\\0' in them don't work :-\n--\nmain = putStrLn \"hello\\0 world\"\n--main = putStrLn \"hello0 world\"\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom: Rajiv Mirani <mirani>\nDate: Sat, 26 Aug 95 21:14:47 -0400\nSubject: GHC bug\n\nGHC can't parse the following program when there is no newline at the \nend of the last line:\n-}\n\nmodule Main where\nmain :: IO ()\nmain = return ()\n-- random comment", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! From a Rick Morgan bug report:\n-- !!! Single-method class with a locally-polymorphic\n-- !!! method.\n\nmodule Main where\n\nclass Poly a where\n   poly :: a -> b -> b\n\ninstance Poly [a] where\n   poly [] y = y\n   poly x  y = y\n\nmain = print (\"hurrah\" `poly` \"Hello, world!\\n\")\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\ndata Burble a = B1 { op1 :: a -> Int, op2 :: Int -> a, op3 :: Int}\n              | B2 { op2 :: Int -> a, op4 :: Int -> Int }\n\n\nf1 :: Int -> Burble Int\nf1 n = B1 { op1 = \\x->x+n, op2 = \\x -> x, op3 = n }\n\nf2 :: Burble a -> Int -> Int\nf2 r@(B1 {op1 = op1 , op2 = op2 }) n = op1 (op2 n) + op3 r\n\nf3 :: Burble a -> Burble a\nf3 x@(B1 {op3=op3}) = x {op3 = op3+1}\n\nmain = print (f2 (f3 (f1 3)) 4)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Tickled a bug in core2stg \n-- !!! (CoreSyn.Coerce constructors were not peeled off\n-- !!! when converting CoreSyn.App)\n\nmodule Main where\n\ngetData :: String -> IO ()\ngetData filename = case leng filename of {0 -> return ()}\nleng :: String -> Int\nleng [] = 0 --case ls of {[] -> 0 ; (_:xs) -> 1 + leng xs }\nleng ls = leng ls\n\nf [] [] = []\nf xs ys = f xs ys\n\nmain =\n     return ()  >>= \\ _ ->\n     case f [] [] of { [] -> getData [] }\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -cpp #-}\n-- !!! Testing IEEE Float and Double extremity predicates.\nmodule Main(main) where\n\nimport Data.Char\nimport Control.Monad.ST\nimport Data.Word\nimport Data.Array.Unsafe ( castSTUArray )\nimport Data.Array.ST\n\n#include \"ghcconfig.h\"\n\nreverse_if_bigendian :: [a] -> [a]\n#ifdef WORDS_BIGENDIAN\nreverse_if_bigendian = reverse\n#else\nreverse_if_bigendian = id\n#endif\n\n\nmain :: IO ()\nmain = do\n sequence_ (map putStrLn double_tests)\n sequence_ (map putStrLn float_tests)\n  where\n   double_tests = run_tests double_numbers\n   float_tests  = run_tests float_numbers\n\n   run_tests nums =\n    map ($ nums)\n        [ denorm\n        , pos_inf\n        , neg_inf\n        , nan\n        , neg_zero\n        , pos_zero\n        ]\n\n-------------\ndouble_numbers :: [Double]\ndouble_numbers =\n      [ 0\n      , encodeFloat 0 0     -- 0 using encodeFloat method\n      , mkDouble (reverse_if_bigendian [0,0,0,0,0,0, 0xf0, 0x7f])  -- +inf\n      , encodeFloat 1 2047  -- +Inf\n      , encodeFloat 1 2048\n      , encodeFloat 1  2047               -- signalling NaN\n      , encodeFloat 0xf000000000000 2047  -- quiet NaN\n      , 0/(0::Double)\n        -- misc\n      , 1.82173691287639817263897126389712638972163e-300\n      , 1.82173691287639817263897126389712638972163e+300\n      , 4.9406564558412465e-324  -- smallest possible denorm number\n                                 -- (as reported by enquire running\n                                 --  on a i686-pc-linux.)\n      , 2.2250738585072014e-308\n      , 0.11\n      , 0.100\n      , -3.4\n        -- smallest\n      , let (l, _) = floatRange x\n            x = encodeFloat 1 (l-1)\n        in x\n        -- largest\n      , let (_, u) = floatRange x\n            d = floatDigits x\n            x = encodeFloat (floatRadix x ^ d - 1) (u - d)\n        in x\n      ]\n\nfloat_numbers :: [Float]\nfloat_numbers =\n      [ 0\n      , encodeFloat 0 0     -- 0 using encodeFloat method\n      , encodeFloat 1 255  -- +Inf\n      , encodeFloat 1 256\n      , encodeFloat 11 255        -- signalling NaN\n      , encodeFloat 0xf00000 255  -- quiet NaN\n      , 0/(0::Float)\n        -- misc\n      , 1.82173691287639817263897126389712638972163e-300\n      , 1.82173691287639817263897126389712638972163e+300\n      , 1.40129846e-45\n      , 1.17549435e-38\n      , 2.98023259e-08\n      , 0.11\n      , 0.100\n      , -3.4\n        -- smallest\n      , let (l, _) = floatRange x\n            x = encodeFloat 1 (l-1)\n        in x\n        -- largest\n      , let (_, u) = floatRange x\n            d = floatDigits x\n            x = encodeFloat (floatRadix x ^ d - 1) (u - d)\n        in x\n      ]\n\n-------------\n\ndenorm :: (Show a, RealFloat a) => [a] -> String\ndenorm numbers =\n  unlines\n     ( \"\"\n     : \"*********************************\"\n     : (\"Denormalised numbers: \" ++ doubleOrFloat numbers)\n     : \"\"\n     : map showPerform numbers)\n where\n   showPerform = showAndPerform (isDenormalized) \"isDenormalised\"\n\npos_inf :: (Show a, RealFloat a) => [a] -> String\npos_inf numbers =\n  unlines\n     ( \"\"\n     : \"*********************************\"\n     : (\"Positive Infinity: \" ++ doubleOrFloat numbers)\n     : \"\"\n     : map showPerform numbers)\n where\n   showPerform = showAndPerform (isInfinite) \"isInfinite\"\n\nneg_inf :: (Show a, RealFloat a) => [a] -> String\nneg_inf numbers =\n  unlines\n     ( \"\"\n     : \"*********************************\"\n     : (\"Negative Infinity: \" ++ doubleOrFloat numbers)\n     : \"\"\n     : map showPerform numbers)\n where\n   showPerform = showAndPerform (\\ x -> isInfinite x && x < 0) \"isNegInfinite\"\n\nnan :: (Show a, RealFloat a) => [a] -> String\nnan numbers =\n  unlines\n     ( \"\"\n     : \"*********************************\"\n     : (\"NaN: \" ++ doubleOrFloat numbers)\n     : \"\"\n     : map showPerform numbers)\n where\n   showPerform = showAndPerform (isNaN) \"isNaN\"\n\npos_zero :: (Show a, RealFloat a) => [a] -> String\npos_zero numbers =\n  unlines\n     ( \"\"\n     : \"*********************************\"\n     : (\"Positive zero: \" ++ doubleOrFloat numbers)\n     : \"\"\n     : map showPerform numbers)\n where\n   showPerform = showAndPerform (==0) \"isPosZero\"\n\nneg_zero :: (Show a, RealFloat a) => [a] -> String\nneg_zero numbers =\n  unlines\n     ( \"\"\n     : \"*********************************\"\n     : (\"Negative zero: \" ++ doubleOrFloat numbers)\n     : \"\"\n     : map showPerform numbers)\n where\n   showPerform = showAndPerform (isNegativeZero) \"isNegativeZero\"\n\n-- what a hack.\ndoubleOrFloat :: RealFloat a => [a] -> String\ndoubleOrFloat ls\n | (floatDigits atType) == (floatDigits (0::Double)) = \"Double\"\n | (floatDigits atType) == (floatDigits (0::Float))  = \"Float\"\n | otherwise = \"unknown RealFloat type\"\n where\n   atType = undefined `asTypeOf` (head ls)\n\n-- make a double from a list of 8 bytes\n-- (caller deals with byte ordering.)\nmkDouble :: [Word8] -> Double\nmkDouble ls =\n runST (( do\n   arr <- newArray_ (0,7)\n   sequence (zipWith (writeArray arr) [(0::Int)..] (take 8 ls))\n   arr' <- castSTUArray arr\n   readArray arr' 0\n ) :: ST s Double )\n\nshowAndPerform :: (Show a, Show b)\n               => (a -> b)\n               -> String\n               -> a\n               -> String\nshowAndPerform fun name_fun val =\n  name_fun ++ ' ':show val ++ \" = \" ++ show (fun val)\n\n\n", "num_lines": 197}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main( main ) where\n\n\nmain :: IO ()\nmain = seq (error \"hello world!\" :: Int) (return ())\n\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport System.IO\n\n-- !!! CAF space leaks\n\nmain = lots_of_xs 10000\n\nlots_of_xs 0 = return ()\nlots_of_xs n = putChar 'x' >> lots_of_xs (n-1)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n--              GHC 4.04\n-- I've been having problems getting GHC to compile some code I'm working\n-- on with optimisation (-O) turned on.  Compilation is fine without -O\n-- specified.  Through a process of elimination I've managed to reproduce\n-- the problemin the following (much simpler) piece of code:\n\nimport Data.List\n\ntest es =\n  concat (groupBy eq (zip [0..(length es) - 1] es))\n  where\n  eq a b = (fst a) == (fst b)\n\nmain = putStr (show (test [1,2,3,4]))\n\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- The new register allocator in 4.08 had a bug wherein\n-- flow edges away from an insn which does a jump through\n-- a switch table were not being added to the flow graph,\n-- which causes computation of live ranges and thus register\n-- assignment to be wrong in the alternatives and default.\n-- This was fixed properly in the head branch (pre 4.09)\n-- and avoided in 4.08.1 by disabling jump table generation\n-- in the NCG -- it generates trees of ifs instead.\n\nmodule Main ( main ) where\n\nmain = print (map f [1 .. 7])\n\n\n\n{-# NOINLINE f #-}\nf :: Int -> Bool\nf 7 = False\nf 1 = False\nf 4 = False\nf 6 = False\nf 5 = False\nf x = if x * 10 == 20 then True else False\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Data constructors with strict fields\n-- This test should use -funbox-strict-fields\n\nmodule Main ( main ) where\n\nmain = print (g (f t))\n\nt = MkT 1 2 (3,4) (MkS 5 6)\n\ng (MkT x _ _ _) = x\n\ndata T = MkT Int !Int !(Int,Int) !(S Int)\n\ndata S a = MkS a a\n\n\n{-# NOINLINE f #-}\nf :: T -> T     -- Takes apart the thing and puts it\n                -- back together differently\nf (MkT x y (a,b) (MkS p q)) = MkT a b (p,q) (MkS x y)\n\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Test strict, recursive newtypes\n-- This test made a pre-5.02 fall over\n-- Reason: the seq arising from the !F didn't see that\n-- the represtation of F is a function.\n\n-- NB It's crucial to compile this test *without* -O\n-- The $ then prevents the 'F' from seeing the '\\x'\n-- and hence makes the evaluation happen at runtime\n\nmodule Main ( main ) where\n\nnewtype F = F (Int -> Val)      -- NB: F and Val are\ndata Val = VFn !F |  VInt !Int  -- mutually recursive\n\nf :: Val -> Val\nf (VFn (F f)) = f 4\n\nmain = print (f (VFn (F $ (\\x -> VInt (x+3)))))\n\ninstance Show Val where\n  show (VInt n) = show n\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\ndata T1         -- No constructors\ndata T2 = T2 !T1 Int\n\nmain = print (case (T2 (error \"OK\") 1) of { T2 x y -> y })\n\n-- We should hit the (error \"OK\") case\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Caused a crash in GHC 5.04.2, fixed in CoreToStg.lhs rev. 1.98\n\ndata T1 = T1\ndata T2 = C1 !T1 | C2\ndata T3 = C3 !T2 Int\n\n{-# NOINLINE f #-}\nf 0 = C3 (C1 T1) 42\nf n = C3 (C1 T1) n\n\nmain = case f 23 of\n          C3 y z -> case y of\n                        C1 T1 -> putStrLn \"ok\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- should run successfully and exit, i.e. without evaluating the\n-- argument to return.\nmain = return undefined\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata Y = X1 | X2 | X3 | X4 | X5 | X6 | X7 | X8\n        deriving( Show )\n\ndata X = WithY Y\n         | A1 | A2 | A3 | A4 | A5 | A6 | A7 | A8\n\nfoo :: X -> Y\nfoo A1 = X1\nfoo A2 = X2\nfoo A3 = X3\nfoo A4 = X4\nfoo A5 = X5\nfoo A6 = X6\nfoo A7 = X7\nfoo A8 = X8\nfoo (WithY _) = X1\n\nbar :: X -> Y\nbar (WithY x) = x\nbar y = foobar (foo y)  -- The WithY case can't occur, and in an\n                        -- earlier version that confused the code generator\n\n{-# NOINLINE foobar #-}\nfoobar x = x\n\n\nmain = print (map bar [WithY X2, A4, A5])\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This program broke GHC 6.3, because dataToTag was called with\n-- an unevaluated argument\n\nmodule Main where\n\nimport System.Environment (getArgs)\n\n-- NOTE: When if you remove Eight (or any other constructor) everything works\n-- Having at least 9 constructors has something to do with the bug\ndata Digit = Zero | One | Two | Three | Four | Five | Six | Seven | Eight\n    deriving (Eq,Enum)\n\ninstance Show Digit where\n    show Five = \"Five\"\n    show Six = \"Six\"\n    show _ = undefined\n\n-- Use either of these instances (instead of derived) and everything works\n{-instance Enum Digit where\n    fromEnum Five = 5\n    fromEnum _ = undefined\n    toEnum 6 = Six\n    toEnum _ = undefined-}\n\n{-instance Eq Digit where\n    Five == Five = True\n    Six == Six = True\n    _ == _ = undefined-}\n\nisFive :: Digit -> Bool\nisFive a = succ a == Six\n\nmain :: IO()\nmain = do\n    putStrLn (\"======\")\n    -- These next two lines are just here to keep ghc from optimizing away stuff\n    args <- getArgs\n    let x = if length args == -1 then undefined else Five\n    putStrLn (\"x: \" ++ show x)\n    let y = succ x\n    putStrLn (\"let y = succ x\")\n    putStrLn (\"y: \" ++ show y)\n    putStrLn (\"y == Six: \" ++ show (y == Six))\n    putStrLn (\"succ x == Six: \" ++ show (succ x == Six))\n    putStrLn (\"isFive x: \" ++ show (isFive x))\n\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Another test for the evaluated-ness of data2tag\n\nmodule Main where\n\n    data S e = A | B | C | D | E | F | G | H | I deriving (Eq)\n    newtype R = T (S R) deriving (Eq)\n\n    main = do { print (T A == T B) ; print (T I == T I) }\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- For testing +RTS -xc\nimport Control.Exception\nmain = try (evaluate (f ())) :: IO (Either SomeException ())\n\nf x = g x\n\ng x = error (show x)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Not really a code-gen test, but this program gave\n-- incorrect results in Hugs (Hugs Trac #37), so I\n-- thought I'd add it to GHC's test suite.\n\nmodule Main where\n\ndata MInt = Zero | Succ MInt | Pred MInt deriving Show\n\ntn :: Int -> MInt\ntn x | x<0 = Pred (tn (x+1))\ntn 0     =  Zero\ntn n     = Succ (tn (n - 1))\n\nti :: MInt -> Int\nti Zero = 0\nti (Succ x) = 1+(ti x)\nti (Pred x) = (ti x) -1\n\ntesti :: (MInt -> MInt -> MInt) -> (Int -> Int -> Int) -> Int -> Int -> Bool\ntesti f g x y = (ti (f (tn x) (tn y))) /= (g x y)\n\nmyMul x y = tn ((ti x) * (ti y))\n\n-- test should be empty!\ntest = [ (x,y,ti (myMul (tn x) (tn y)),x * y)\n       | x<-[-100, -99, -98, -97, -2, -1, 0, 1, 2, 97, 98, 99, 100],\n         y<-([-100..(-1)]++[1..100]),\n         testi myMul (*)  x y ]\n\nmain = print test\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- GHC 6.6 compiled YHC wrong; this is a cutdown testcase (from trac #1171).\n\nmodule Main where\n\nimport System.Directory\n\ndata Error\n    = ErrorFileNone\n    | ErrorFileMany \n        FilePath    -- file you were looking for\n\nraiseError ErrorFileNone = error \"Error: File not found\"\nraiseError (ErrorFileMany file) = error $ \"Error: Found file multiple times: \"++file\n\ndata PackageData = PackageData [FilePath] deriving Show\n\ngetModule :: PackageData -> String -> IO ()\ngetModule (PackageData rs@(root:rest)) file =\n        do local <- testPackage root\n           res <- testPackage root\n           print (local, res)\n           case (local,res) of\n                ([x], _) -> return ()\n                (_, [x]) -> return ()\n                ([], []) -> raiseError $ ErrorFileNone\n                (as, bs) -> if as++bs == [] then error \"Empty as++bs\" else raiseError $ ErrorFileMany file\n    where\n        testPackage pkg =\n            do\n                bHi <- doesFileExist \"/does/not/exist\"\n                return [(\"\",\"\") | bHi]\n\nmain = getModule (PackageData [\"7\"]) \"13\"\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- tickled a bug in stack squeezing in 6.8.2.  unsafePerformIO calls\n-- noDuplicate#, which marks the update frames on the stack, and was\n-- preventing subsequent update frames from being collapsed with the\n-- marked frame.\n\nmodule Main where\n\nimport System.IO.Unsafe\n\nmain = print (sim (replicate 100000 ()))\n\nsim []     = True\nsim (_:xs) = badStack (sim xs)\n\ngoodStack x = fromJust (Just x)          --no stack overflow\nbadStack  x = unsafePerformIO (return x) --stack overflow\n\nfromJust (Just x) = x\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nnewtype Test = Test { var :: String }\n\n{-\nhugs (Sept 2006) gives\nProgram error: pattern match failure: instShow_v16_v1443 (Test_Test \"a\")\nProgram error: pattern match failure: instShow_v16_v1443 (Test_Test \"b\")\nhugs trac #46\n-}\n\nmain = do print (var x)\n          print (var (y{var=\"b\"}))\n    where x = Test { var = \"a\" }\n          y = Test \"a\"\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nnewtype T = C { f :: String }\n\n{-\nhugs (Sept 2006) gives\n\"bc\"\nProgram error: Prelude.undefined\nhugs trac #48\n-}\n\nmain = do print $ case C \"abc\" of\n                  C { f = v } -> v\n          print $ case undefined of\n                  C {} -> True\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-\nCheck that we aren't making gcc misinterpret our strings as trigraphs.\nTrac #2968.\nhttp://gcc.gnu.org/onlinedocs/cpp/Initial-processing.html\n-}\n\nmodule Main where\n\nmain :: IO ()\nmain = do putStrLn \"??(\"\n          putStrLn \"??)\"\n          putStrLn \"??<\"\n          putStrLn \"??>\"\n          putStrLn \"??=\"\n          putStrLn \"??/\"\n          putStrLn \"??'\"\n          putStrLn \"??!\"\n          putStrLn \"??-\"\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\n-- !!! simple tests of copying/cloning primitive arrays\n--\n\nmodule Main ( main ) where\n\nimport GHC.Exts hiding (IsList(..))\nimport GHC.Prim\nimport GHC.ST\n\nmain :: IO ()\nmain = putStr\n       (test_copyArray\n        ++ \"\\n\" ++ test_copyMutableArray\n        ++ \"\\n\" ++ test_copyMutableArrayOverlap\n        ++ \"\\n\" ++ test_cloneArray\n        ++ \"\\n\" ++ test_cloneArrayStatic\n        ++ \"\\n\" ++ test_cloneMutableArray\n        ++ \"\\n\" ++ test_cloneMutableArrayEmpty\n        ++ \"\\n\" ++ test_cloneMutableArrayStatic\n        ++ \"\\n\" ++ test_freezeArray\n        ++ \"\\n\" ++ test_freezeArrayStatic\n        ++ \"\\n\" ++ test_thawArray\n        ++ \"\\n\" ++ test_thawArrayStatic\n        ++ \"\\n\"\n       )\n\n------------------------------------------------------------------------\n-- Constants\n\n-- All allocated arrays are of this size\nlen :: Int\nlen = 130\n\n-- We copy these many elements\ncopied :: Int\ncopied = len - 2\n\ncopiedStatic :: Int\ncopiedStatic = 16\n{-# INLINE copiedStatic #-}  -- to make sure optimization triggers\n\n------------------------------------------------------------------------\n-- copyArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyArray :: String\ntest_copyArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            dst <- newArray len (-1)\n            -- Leave the first and last element untouched\n            copyArray src 1 dst 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst len) \"\\n\"\n\n------------------------------------------------------------------------\n-- copyMutableArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyMutableArray :: String\ntest_copyMutableArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            dst <- newArray len (-1)\n            -- Leave the first and last element untouched\n            copyMutableArray src 1 dst 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst len) \"\\n\"\n\n-- Perform a copy where the source and destination part overlap.\ntest_copyMutableArrayOverlap :: String\ntest_copyMutableArrayOverlap =\n    let arr = runST $ do\n            marr <- fromList inp\n            -- Overlap of two elements\n            copyMutableArray marr 5 marr 7 8\n            unsafeFreezeArray marr\n    in shows (toList arr (length inp)) \"\\n\"\n  where\n     -- This case was known to fail at some point.\n     inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]\n\n------------------------------------------------------------------------\n-- cloneArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_cloneArray :: String\ntest_cloneArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            return $! cloneArray src 1 copied\n    in shows (toList dst copied) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_cloneArrayStatic :: String\ntest_cloneArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            return $! cloneArray src 1 copiedStatic\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- cloneMutableArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_cloneMutableArray :: String\ntest_cloneMutableArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            dst <- cloneMutableArray src 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst copied) \"\\n\"\n\n-- Check that zero-length clones work.\ntest_cloneMutableArrayEmpty :: String\ntest_cloneMutableArrayEmpty =\n    let dst = runST $ do\n            src <- newArray len 0\n            dst <- cloneMutableArray src 0 0\n            unsafeFreezeArray dst\n    in shows (toList dst 0) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_cloneMutableArrayStatic :: String\ntest_cloneMutableArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            dst <- cloneMutableArray src 1 copiedStatic\n            unsafeFreezeArray dst\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- freezeArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_freezeArray :: String\ntest_freezeArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            freezeArray src 1 copied\n    in shows (toList dst copied) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_freezeArrayStatic :: String\ntest_freezeArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            freezeArray src 1 copiedStatic\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- thawArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_thawArray :: String\ntest_thawArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            dst <- thawArray src 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst copied) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_thawArrayStatic :: String\ntest_thawArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            dst <- thawArray src 1 copiedStatic\n            unsafeFreezeArray dst\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- Test helpers\n\n-- Initialize the elements of this array, starting at the given\n-- offset.  The last parameter specifies the number of elements to\n-- initialize.  Element at index @i@ takes the value @i*i@ (i.e. the\n-- first actually modified element will take value @off*off@).\nfill :: MArray s Int -> Int -> Int -> ST s ()\nfill marr off count = go 0\n  where\n    go i\n        | i >= count = return ()\n        | otherwise = writeArray marr (off + i) (i*i) >> go (i + 1)\n\nfromList :: [Int] -> ST s (MArray s Int)\nfromList xs0 = do\n    marr <- newArray (length xs0) bottomElem\n    let go [] i = i `seq` return marr\n        go (x:xs) i = writeArray marr i x >> go xs (i + 1)\n    go xs0 0\n  where\n    bottomElem = error \"undefined element\"\n\n------------------------------------------------------------------------\n-- Convenience wrappers for Array# and MutableArray#\n\ndata Array a = Array { unArray :: Array# a }\ndata MArray s a = MArray { unMArray :: MutableArray# s a }\n\nnewArray :: Int -> a -> ST s (MArray s a)\nnewArray (I# n#) a = ST $ \\s# -> case newArray# n# a s# of\n    (# s2#, marr# #) -> (# s2#, MArray marr# #)\n\nindexArray :: Array a -> Int -> a\nindexArray arr i@(I# i#)\n  | i < 0 || i >= len =\n      error $ \"bounds error, offset \" ++ show i ++ \", length \" ++ show len\n  | otherwise = case indexArray# (unArray arr) i# of\n      (# a #) -> a\n  where len = lengthArray arr\n\nwriteArray :: MArray s a -> Int -> a -> ST s ()\nwriteArray marr i@(I# i#) a\n  | i < 0 || i >= len =\n      error $ \"bounds error, offset \" ++ show i ++ \", length \" ++ show len\n  | otherwise = ST $ \\ s# ->\n    case writeArray# (unMArray marr) i# a s# of\n        s2# -> (# s2#, () #)\n  where len = lengthMArray marr\n\nlengthArray :: Array a -> Int\nlengthArray arr = I# (sizeofArray# (unArray arr))\n\nlengthMArray :: MArray s a -> Int\nlengthMArray marr = I# (sizeofMutableArray# (unMArray marr))\n\nunsafeFreezeArray :: MArray s a -> ST s (Array a)\nunsafeFreezeArray marr = ST $ \\ s# ->\n    case unsafeFreezeArray# (unMArray marr) s# of\n        (# s2#, arr# #) -> (# s2#, Array arr# #)\n\ncopyArray :: Array a -> Int -> MArray s a -> Int -> Int -> ST s ()\ncopyArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \\ s# ->\n    case copyArray# (unArray src) six# (unMArray dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncopyMutableArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()\ncopyMutableArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \\ s# ->\n    case copyMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncloneArray :: Array a -> Int -> Int -> Array a\ncloneArray src (I# six#) (I# n#) = Array (cloneArray# (unArray src) six# n#)\n{-# INLINE cloneArray #-}  -- to make sure optimization triggers\n\ncloneMutableArray :: MArray s a -> Int -> Int -> ST s (MArray s a)\ncloneMutableArray src (I# six#) (I# n#) = ST $ \\ s# ->\n    case cloneMutableArray# (unMArray src) six# n# s# of\n        (# s2#, marr# #) -> (# s2#, MArray marr# #)\n{-# INLINE cloneMutableArray #-}  -- to make sure optimization triggers\n\nfreezeArray :: MArray s a -> Int -> Int -> ST s (Array a)\nfreezeArray src (I# six#) (I# n#) = ST $ \\ s# ->\n    case freezeArray# (unMArray src) six# n# s# of\n        (# s2#, arr# #) -> (# s2#, Array arr# #)\n{-# INLINE freezeArray #-}  -- to make sure optimization triggers\n\nthawArray :: Array a -> Int -> Int -> ST s (MArray s a)\nthawArray src (I# six#) (I# n#) = ST $ \\ s# ->\n    case thawArray# (unArray src) six# n# s# of\n        (# s2#, marr# #) -> (# s2#, MArray marr# #)\n{-# INLINE thawArray #-}  -- to make sure optimization triggers\n\ntoList :: Array a -> Int -> [a]\ntoList arr n = go 0\n  where\n    go i | i >= n = []\n         | otherwise = indexArray arr i : go (i+1)\n", "num_lines": 301}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule Main ( main ) where\n\nimport GHC.Exts\nimport GHC.Prim\nimport GHC.ST\n\nmain = putStr\n       (test_sizeofArray\n        ++ \"\\n\" ++ test_sizeofMutableArray\n        ++ \"\\n\"\n       )\n\ntest_sizeofArray :: String\ntest_sizeofArray = flip shows \"\\n\" $ runST $ ST $ \\ s# -> go 0 [] s#\n  where\n    go i@(I# i#) acc s#\n        | i < 1000 = case newArray# i# 0 s# of\n            (# s2#, marr# #) -> case unsafeFreezeArray# marr# s2# of\n                (# s3#, arr# #) -> case sizeofArray# arr# of\n                    j# -> go (i+1) ((I# j#):acc) s3#\n        | otherwise = (# s#, reverse acc #)\n\ntest_sizeofMutableArray :: String\ntest_sizeofMutableArray = flip shows \"\\n\" $ runST $ ST $ \\ s# -> go 0 [] s#\n  where\n    go i@(I# i#) acc s#\n        | i < 1000 = case newArray# i# 0 s# of\n            (# s2#, marr# #) -> case sizeofMutableArray# marr# of\n                    j# -> go (i+1) ((I# j#):acc) s2#\n        | otherwise = (# s#, reverse acc #)\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\n\nimport Foreign.C\nimport Data.Word\nimport Foreign.Ptr\nimport GHC.Exts\n\nimport Control.Exception\n\nhashStr  :: Ptr Word8 -> Int -> Int\nhashStr (Ptr a#) (I# len#) = loop 0# 0#\n   where\n    loop h n | isTrue# (n GHC.Exts.==# len#) = I# h\n             | otherwise  = loop h2 (n GHC.Exts.+# 1#)\n          where !c = ord# (indexCharOffAddr# a# n)\n                !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#` 4091#\n\n-- Infinite loops with new code generator + C-- optimizations\nmain = do\n    withCStringLen \"ff\" $ \\(ptr, l) -> do\n        print (hashStr (castPtr ptr) l)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test-case tickled a bug where an optimization pass incorrectly\n-- reloaded a stack slot before the slot was initialized.  It was a bit\n-- tricky to reproduce, and I don't really know why this particular\n-- harness was necessary.\n\n-- Miscompiled code must be in another module, otherwise problem doesn't\n-- show up.\nimport Cgrun067A (miscompiledFn)\nimport Foreign.C.String\n\nmain = withCString \"foobar\" $ \\p -> print =<< miscompiledFn p\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Cgrun067A (miscompiledFn) where\n\nimport Foreign.C\nimport Foreign\n\nmiscompiledFn :: CString -> IO String\nmiscompiledFn cp = do\n  l <- lengthArray0 0 cp\n  if l <= 0 then return \"\" else loop \"\" (l-1)\n  where\n    loop s i = do\n        xval <- peekElemOff cp i\n        let val = castCCharToChar xval\n        val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, MagicHash,\n             UnboxedTuples #-}\n\n-- !!! stress tests of copying/cloning primitive arrays\n\n-- Note: You can run this test manually with an argument\n-- (i.e. ./cgrun068 10000) if you want to run the stress test for\n-- longer.\n\n{-\nTest strategy\n=============\n\nWe create an array of arrays of integers. Repeatedly we then either\n\n* allocate a new array in place of an old, or\n\n* copy a random segment of an array into another array (which might be\n  the source array).\n\nBy running this process long enough we hope to trigger any bugs\nrelated to garbage collection or edge cases.\n\nWe only test copyMutableArray# and cloneArray# as they are\nrepresentative of all the primops.\n-}\n\nmodule Main ( main ) where\n\nimport Debug.Trace (trace)\n\nimport Control.Exception (assert)\nimport Control.Monad\nimport Control.Monad.Trans.State.Strict\nimport Control.Monad.Trans.Class\nimport GHC.Exts hiding (IsList(..))\nimport GHC.ST hiding (liftST)\nimport Prelude hiding (length, read)\nimport qualified Prelude as P\nimport qualified Prelude as P\nimport System.Environment\nimport System.Random\n\nmain :: IO ()\nmain = do\n    args <- getArgs\n    -- Number of copies to perform\n    let numMods = case args of\n            [] -> 100\n            [n] -> P.read n :: Int\n    putStr (test_copyMutableArray numMods ++ \"\\n\" ++\n            test_cloneMutableArray numMods ++ \"\\n\"\n           )\n\n-- Number of arrays\nnumArrays :: Int\nnumArrays = 100\n\n-- Maxmimum length of a sub-array\nmaxLen :: Int\nmaxLen = 1024\n\n-- Create an array of arrays, with each sub-array having random length\n-- and content.\nsetup :: Rng s (MArray s (MArray s Int))\nsetup = do\n    len <- rnd (1, numArrays)\n    marr <- liftST $ new_ len\n    let go i\n            | i >= len = return ()\n            | otherwise = do\n                n <- rnd (1, maxLen)\n                subarr <- liftST $ fromList [j*j | j <- [(0::Int)..n-1]]\n                liftST $ write marr i subarr\n                go (i+1)\n    go 0\n    return marr\n\n-- Replace one of the sub-arrays with a newly allocated array.\nallocate :: MArray s (MArray s Int) -> Rng s ()\nallocate marr = do\n    ix <- rnd (0, length marr - 1)\n    n <- rnd (1, maxLen)\n    subarr <- liftST $ fromList [j*j | j <- [(0::Int)..n-1]]\n    liftST $ write marr ix subarr\n\ntype CopyFunction s a =\n    MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()\n\n-- Copy a random segment of an array onto another array, using the\n-- supplied copy function.\ncopy :: MArray s (MArray s a) -> CopyFunction s a\n     -> Rng s (Int, Int, Int, Int, Int)\ncopy marr f = do\n    six <- rnd (0, length marr - 1)\n    dix <- rnd (0, length marr - 1)\n    src <- liftST $ read marr six\n    dst <- liftST $ read marr dix\n    let srcLen = length src\n    srcOff <- rnd (0, srcLen - 1)\n    let dstLen = length dst\n    dstOff <- rnd (0, dstLen - 1)\n    n <- rnd (0, min (srcLen - srcOff) (dstLen - dstOff))\n    liftST $ f src srcOff dst dstOff n\n    return (six, dix, srcOff, dstOff, n)\n\ntype CloneFunction s a = MArray s a -> Int -> Int -> ST s (MArray s a)\n\n-- Clone a random segment of an array, replacing another array, using\n-- the supplied clone function.\nclone :: MArray s (MArray s a) -> CloneFunction s a\n      -> Rng s (Int, Int, Int, Int)\nclone marr f = do\n    six <- rnd (0, length marr - 1)\n    dix <- rnd (0, length marr - 1)\n    src <- liftST $ read marr six\n    let srcLen = length src\n    -- N.B. The array length might be zero if we previously cloned\n    -- zero elements from some array.\n    srcOff <- rnd (0, max 0 (srcLen - 1))\n    n <- rnd (0, srcLen - srcOff)\n    dst <- liftST $ f src srcOff n\n    liftST $ write marr dix dst\n    return (six, dix, srcOff, n)\n\n------------------------------------------------------------------------\n-- copyMutableArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyMutableArray :: Int -> String\ntest_copyMutableArray numMods = runST $ run $ do\n    marr <- local setup\n    marrRef <- setup\n    let go i\n            | i >= numMods = return \"test_copyMutableArray: OK\"\n            | otherwise = do\n                -- Either allocate or copy\n                alloc <- rnd (True, False)\n                if alloc then doAlloc else doCopy\n                go (i+1)\n\n        doAlloc = do\n            local $ allocate marr\n            allocate marrRef\n\n        doCopy = do\n            inp <- liftST $ asList marr\n            _ <- local $ copy marr copyMArray\n            (six, dix, srcOff, dstOff, n) <- copy marrRef copyMArraySlow\n            el <- liftST $ asList marr\n            elRef <- liftST $ asList marrRef\n            when (el /= elRef) $\n                fail inp el elRef six dix srcOff dstOff n\n    go 0\n  where\n    fail inp el elRef six dix srcOff dstOff n =\n        error $ \"test_copyMutableArray: FAIL\\n\"\n        ++ \"   Input: \" ++ unlinesShow inp\n        ++ \"    Copy: six: \" ++ show six ++ \" dix: \" ++ show dix ++ \" srcOff: \"\n        ++ show srcOff ++ \" dstOff: \" ++ show dstOff ++ \" n: \" ++ show n ++ \"\\n\"\n        ++ \"Expected: \" ++ unlinesShow elRef\n        ++ \"  Actual: \" ++ unlinesShow el\n\nasList :: MArray s (MArray s a) -> ST s [[a]]\nasList marr = toListM =<< mapArrayM toListM marr\n\nunlinesShow :: Show a => [a] -> String\nunlinesShow =  concatMap (\\ x -> show x ++ \"\\n\")\n\n------------------------------------------------------------------------\n-- cloneMutableArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_cloneMutableArray :: Int -> String\ntest_cloneMutableArray numMods = runST $ run $ do\n    marr <- local setup\n    marrRef <- setup\n    let go i\n            | i >= numMods = return \"test_cloneMutableArray: OK\"\n            | otherwise = do\n                -- Either allocate or clone\n                alloc <- rnd (True, False)\n                if alloc then doAlloc else doClone\n                go (i+1)\n\n        doAlloc = do\n            local $ allocate marr\n            allocate marrRef\n\n        doClone = do\n            inp <- liftST $ asList marr\n            _ <- local $ clone marr cloneMArray\n            (six, dix, srcOff, n) <- clone marrRef cloneMArraySlow\n            el <- liftST $ asList marr\n            elRef <- liftST $ asList marrRef\n            when (el /= elRef) $\n                fail inp el elRef six dix srcOff n\n    go 0\n  where\n    fail inp el elRef six dix srcOff n =\n        error $ \"test_cloneMutableArray: FAIL\\n\"\n        ++ \"   Input: \" ++ unlinesShow inp\n        ++ \"   Clone: six: \" ++ show six ++ \" dix: \" ++ show dix ++ \" srcOff: \"\n        ++ show srcOff ++ \" n: \" ++ show n ++ \"\\n\"\n        ++ \"Expected: \" ++ unlinesShow elRef\n        ++ \"  Actual: \" ++ unlinesShow el\n\n------------------------------------------------------------------------\n-- Convenience wrappers for Array# and MutableArray#\n\ndata Array a = Array\n    { unArray :: Array# a\n    , lengthA :: {-# UNPACK #-} !Int}\n\ndata MArray s a = MArray\n    { unMArray :: MutableArray# s a\n    , lengthM :: {-# UNPACK #-} !Int}\n\nclass IArray a where\n    length :: a -> Int\ninstance IArray (Array a) where\n    length = lengthA\ninstance IArray (MArray s a) where\n    length = lengthM\n\ninstance Eq a => Eq (Array a) where\n    arr1 == arr2 = toList arr1 == toList arr2\n\nnew :: Int -> a -> ST s (MArray s a)\nnew n@(I# n#) a =\n    assert (n >= 0) $\n    ST $ \\s# -> case newArray# n# a s# of\n        (# s2#, marr# #) -> (# s2#, MArray marr# n #)\n\nnew_ :: Int -> ST s (MArray s a)\nnew_ n = new n (error \"Undefined element\")\n\nwrite :: MArray s a -> Int -> a -> ST s ()\nwrite marr i@(I# i#) a =\n    assert (i >= 0) $\n    assert (i < length marr) $\n    ST $ \\ s# ->\n    case writeArray# (unMArray marr) i# a s# of\n        s2# -> (# s2#, () #)\n\nread :: MArray s a -> Int -> ST s a\nread marr i@(I# i#) =\n    assert (i >= 0) $\n    assert (i < length marr) $\n    ST $ \\ s# ->\n    readArray# (unMArray marr) i# s#\n\nindex :: Array a -> Int -> a\nindex arr i@(I# i#) =\n    assert (i >= 0) $\n    assert (i < length arr) $\n    case indexArray# (unArray arr) i# of\n        (# a #) -> a\n\nunsafeFreeze :: MArray s a -> ST s (Array a)\nunsafeFreeze marr = ST $ \\ s# ->\n    case unsafeFreezeArray# (unMArray marr) s# of\n        (# s2#, arr# #) -> (# s2#, Array arr# (length marr) #)\n\ntoList :: Array a -> [a]\ntoList arr = go 0\n  where\n    go i | i >= length arr = []\n         | otherwise = index arr i : go (i+1)\n\nfromList :: [e] -> ST s (MArray s e)\nfromList es = do\n    marr <- new_ n\n    let go !_ [] = return ()\n        go i (x:xs) = write marr i x >> go (i+1) xs\n    go 0 es\n    return marr\n  where\n    n = P.length es\n\nmapArrayM :: (a -> ST s b) -> MArray s a -> ST s (MArray s b)\nmapArrayM f src = do\n    dst <- new_ n\n    let go i\n            | i >= n = return dst\n            | otherwise = do\n                el <- read src i\n                el' <- f el\n                write dst i el'\n                go (i+1)\n    go 0\n  where\n    n = length src\n\ntoListM :: MArray s e -> ST s [e]\ntoListM marr =\n    sequence [read marr i | i <- [0..(length marr)-1]]\n\n------------------------------------------------------------------------\n-- Wrappers around copy/clone primops\n\ncopyMArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()\ncopyMArray src six@(I# six#) dst dix@(I# dix#) n@(I# n#) =\n    assert (six >= 0) $\n    assert (six + n <= length src) $\n    assert (dix >= 0) $\n    assert (dix + n <= length dst) $\n    ST $ \\ s# ->\n    case copyMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncloneMArray :: MArray s a -> Int -> Int -> ST s (MArray s a)\ncloneMArray marr off@(I# off#) n@(I# n#) =\n    assert (off >= 0) $\n    assert (off + n <= length marr) $\n    ST $ \\ s# ->\n    case cloneMutableArray# (unMArray marr) off# n# s# of\n        (# s2#, marr2 #) -> (# s2#, MArray marr2 n #)\n\n------------------------------------------------------------------------\n-- Manual versions of copy/clone primops.  Used to validate the\n-- primops\n\ncopyMArraySlow :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()\ncopyMArraySlow !src !six !dst !dix n =\n    assert (six >= 0) $\n    assert (six + n <= length src) $\n    assert (dix >= 0) $\n    assert (dix + n <= length dst) $\n       if six < dix\n       then goB (six+n-1) (dix+n-1) 0  -- Copy backwards\n       else goF six dix 0  -- Copy forwards\n  where\n    goF !i !j c\n        | c >= n = return ()\n        | otherwise = do b <- read src i\n                         write dst j b\n                         goF (i+1) (j+1) (c+1)\n    goB !i !j c\n        | c >= n = return ()\n        | otherwise = do b <- read src i\n                         write dst j b\n                         goB (i-1) (j-1) (c+1)\n\ncloneMArraySlow :: MArray s a -> Int -> Int -> ST s (MArray s a)\ncloneMArraySlow !marr !off n =\n    assert (off >= 0) $\n    assert (off + n <= length marr) $ do\n        marr2 <- new_ n\n        let go !i !j c\n                | c >= n = return marr2\n                | otherwise = do\n                    b <- read marr i\n                    write marr2 j b\n                    go (i+1) (j+1) (c+1)\n        go off 0 0\n\n------------------------------------------------------------------------\n-- Utilities for simplifying RNG passing\n\nnewtype Rng s a = Rng { unRng :: StateT StdGen (ST s) a }\n                deriving (Functor, Applicative, Monad)\n\n-- Same as 'randomR', but using the RNG state kept in the 'Rng' monad.\nrnd :: Random a => (a, a) -> Rng s a\nrnd r = Rng $ do\n    g <- get\n    let (x, g') = randomR r g\n    put g'\n    return x\n\n-- Run a sub-computation without affecting the RNG state.\nlocal :: Rng s a -> Rng s a\nlocal m = Rng $ do\n    g <- get\n    x <- unRng m\n    put g\n    return x\n\nliftST :: ST s a -> Rng s a\nliftST m = Rng $ lift m\n\nrun :: Rng s a -> ST s a\nrun = flip evalStateT (mkStdGen 13) . unRng\n\n", "num_lines": 388}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash,GHCForeignImportPrim,UnliftedFFITypes #-}\nmodule Main where\n\nimport GHC.Exts\nimport Control.Exception\nimport System.IO\n\nforeign import prim \"memintrinTest\" basicTest :: Int# -> Int#\n\nforeign import prim \"testMemset8_0\" testMemset8_0 :: Int# -> Int#\nforeign import prim \"testMemset8_8\" testMemset8_8 :: Int# -> Int#\nforeign import prim \"testMemset8_9\" testMemset8_9 :: Int# -> Int#\nforeign import prim \"testMemset8_10\" testMemset8_10 :: Int# -> Int#\nforeign import prim \"testMemset8_11\" testMemset8_11 :: Int# -> Int#\nforeign import prim \"testMemset8_12\" testMemset8_12 :: Int# -> Int#\nforeign import prim \"testMemset8_13\" testMemset8_13 :: Int# -> Int#\nforeign import prim \"testMemset8_14\" testMemset8_14 :: Int# -> Int#\nforeign import prim \"testMemset8_15\" testMemset8_15 :: Int# -> Int#\nforeign import prim \"testMemset8_16\" testMemset8_16 :: Int# -> Int#\nforeign import prim \"testMemset4_0\" testMemset4_0 :: Int# -> Int#\nforeign import prim \"testMemset4_4\" testMemset4_4 :: Int# -> Int#\nforeign import prim \"testMemset4_5\" testMemset4_5 :: Int# -> Int#\nforeign import prim \"testMemset4_6\" testMemset4_6 :: Int# -> Int#\nforeign import prim \"testMemset4_7\" testMemset4_7 :: Int# -> Int#\nforeign import prim \"testMemset4_8\" testMemset4_8 :: Int# -> Int#\n\nforeign import prim \"testMemcpy8_0\" testMemcpy8_0 :: Int# -> Int#\nforeign import prim \"testMemcpy8_8\" testMemcpy8_8 :: Int# -> Int#\nforeign import prim \"testMemcpy8_9\" testMemcpy8_9 :: Int# -> Int#\nforeign import prim \"testMemcpy8_10\" testMemcpy8_10 :: Int# -> Int#\nforeign import prim \"testMemcpy8_11\" testMemcpy8_11 :: Int# -> Int#\nforeign import prim \"testMemcpy8_12\" testMemcpy8_12 :: Int# -> Int#\nforeign import prim \"testMemcpy8_13\" testMemcpy8_13 :: Int# -> Int#\nforeign import prim \"testMemcpy8_14\" testMemcpy8_14 :: Int# -> Int#\nforeign import prim \"testMemcpy8_15\" testMemcpy8_15 :: Int# -> Int#\nforeign import prim \"testMemcpy8_16\" testMemcpy8_16 :: Int# -> Int#\nforeign import prim \"testMemcpy4_0\" testMemcpy4_0 :: Int# -> Int#\nforeign import prim \"testMemcpy4_4\" testMemcpy4_4 :: Int# -> Int#\nforeign import prim \"testMemcpy4_5\" testMemcpy4_5 :: Int# -> Int#\nforeign import prim \"testMemcpy4_6\" testMemcpy4_6 :: Int# -> Int#\nforeign import prim \"testMemcpy4_7\" testMemcpy4_7 :: Int# -> Int#\nforeign import prim \"testMemcpy4_8\" testMemcpy4_8 :: Int# -> Int#\n\nmain = do\n    putStrLn \"Mem{cpy,set,move} Intrinsics Test...\"\n    _ <- evaluate (I# (basicTest 1#))\n    \n    _ <- evaluate (I# (testMemset8_0 1#))\n    _ <- evaluate (I# (testMemset8_8 1#))\n    _ <- evaluate (I# (testMemset8_9 1#))\n    _ <- evaluate (I# (testMemset8_10 1#))\n    _ <- evaluate (I# (testMemset8_11 1#))\n    _ <- evaluate (I# (testMemset8_12 1#))\n    _ <- evaluate (I# (testMemset8_13 1#))\n    _ <- evaluate (I# (testMemset8_14 1#))\n    _ <- evaluate (I# (testMemset8_15 1#))\n    _ <- evaluate (I# (testMemset8_16 1#))\n    _ <- evaluate (I# (testMemset4_0 1#))\n    _ <- evaluate (I# (testMemset4_4 1#))\n    _ <- evaluate (I# (testMemset4_5 1#))\n    _ <- evaluate (I# (testMemset4_6 1#))\n    _ <- evaluate (I# (testMemset4_7 1#))\n    _ <- evaluate (I# (testMemset4_8 1#))\n    \n    _ <- evaluate (I# (testMemcpy8_0 1#))\n    _ <- evaluate (I# (testMemcpy8_8 1#))\n    _ <- evaluate (I# (testMemcpy8_9 1#))\n    _ <- evaluate (I# (testMemcpy8_10 1#))\n    _ <- evaluate (I# (testMemcpy8_11 1#))\n    _ <- evaluate (I# (testMemcpy8_12 1#))\n    _ <- evaluate (I# (testMemcpy8_13 1#))\n    _ <- evaluate (I# (testMemcpy8_14 1#))\n    _ <- evaluate (I# (testMemcpy8_15 1#))\n    _ <- evaluate (I# (testMemcpy8_16 1#))\n    _ <- evaluate (I# (testMemcpy4_0 1#))\n    _ <- evaluate (I# (testMemcpy4_4 1#))\n    _ <- evaluate (I# (testMemcpy4_5 1#))\n    _ <- evaluate (I# (testMemcpy4_6 1#))\n    _ <- evaluate (I# (testMemcpy4_7 1#))\n    _ <- evaluate (I# (testMemcpy4_8 1#))\n    putStrLn \"Test Passed!\"\n    return ()\n", "num_lines": 83}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\n-- !!! simple tests of copying/cloning byte arrays\n--\n\nmodule Main ( main ) where\n\nimport GHC.Word\nimport GHC.Exts hiding (IsList(..))\nimport GHC.Prim\nimport GHC.ST\nimport GHC.IO\nimport GHC.Ptr\n\nmain = putStr\n       (test_copyByteArray\n        ++ \"\\n\" ++ test_copyMutableByteArray\n        ++ \"\\n\" ++ test_copyMutableByteArrayOverlap\n        ++ \"\\n\" ++ test_copyByteArrayToAddr\n        ++ \"\\n\" ++ test_copyMutableByteArrayToAddr\n        ++ \"\\n\" ++ test_copyAddrToByteArray\n        ++ \"\\n\"\n       )\n\n------------------------------------------------------------------------\n-- Constants\n\n-- All allocated arrays are of this size\nlen :: Int\nlen = 130\n\n-- We copy these many elements\ncopied :: Int\ncopied = len - 2\n\n------------------------------------------------------------------------\n-- copyByteArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyByteArray :: String\ntest_copyByteArray =\n    let dst = runST $ do\n            src <- newByteArray len\n            fill src 0 len\n            src <- unsafeFreezeByteArray src\n            dst <- newByteArray len\n            -- Markers to detect errors\n            writeWord8Array dst 0 255\n            writeWord8Array dst (len-1) 255\n            -- Leave the first and last element untouched\n            copyByteArray src 1 dst 1 copied\n            unsafeFreezeByteArray dst\n    in shows (toList dst len) \"\\n\"\n\n------------------------------------------------------------------------\n-- copyMutableByteArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyMutableByteArray :: String\ntest_copyMutableByteArray =\n    let dst = runST $ do\n            src <- newByteArray len\n            fill src 0 len\n            dst <- newByteArray len\n            -- Markers to detect errors\n            writeWord8Array dst 0 255\n            writeWord8Array dst (len-1) 255\n            -- Leave the first and last element untouched\n            copyMutableByteArray src 1 dst 1 copied\n            unsafeFreezeByteArray dst\n    in shows (toList dst len) \"\\n\"\n\n-- Perform a copy where the source and destination part overlap.\ntest_copyMutableByteArrayOverlap :: String\ntest_copyMutableByteArrayOverlap =\n    let arr = runST $ do\n            marr <- fromList inp\n            -- Overlap of two elements\n            copyMutableByteArray marr 5 marr 7 8\n            unsafeFreezeByteArray marr\n    in shows (toList arr (length inp)) \"\\n\"\n  where\n     -- This case was known to fail at some point.\n     inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]\n\n------------------------------------------------------------------------\n-- copyByteArrayToAddr#\n\n-- Copy a slice of the source array into a destination memory area and check\n-- that the copy succeeded.\ntest_copyByteArrayToAddr :: String\ntest_copyByteArrayToAddr =\n    let dst = runST $ do\n            src <- newByteArray len\n            fill src 0 len\n            src <- unsafeFreezeByteArray src\n            withNewPinnedByteArray len $ \\dst dst_marr -> do\n              -- Markers to detect errors\n              writeWord8Array dst_marr 0 255\n              writeWord8Array dst_marr (len-1) 255\n              -- Leave the first and last element untouched\n              copyByteArrayToAddr src 1 (dst `plusPtr` 1) copied\n              unsafeFreezeByteArray dst_marr\n    in shows (toList dst len) \"\\n\"\n\n------------------------------------------------------------------------\n-- copyMutableByteArrayToAddr#\n\n-- Copy a slice of the source array into a destination memory area and check\n-- that the copy succeeded.\ntest_copyMutableByteArrayToAddr :: String\ntest_copyMutableByteArrayToAddr =\n    let dst = runST $ do\n            src <- newByteArray len\n            fill src 0 len\n            withNewPinnedByteArray len $ \\dst dst_marr -> do\n              -- Markers to detect errors\n              writeWord8Array dst_marr 0 255\n              writeWord8Array dst_marr (len-1) 255\n              -- Leave the first and last element untouched\n              copyMutableByteArrayToAddr src 1 (dst `plusPtr` 1) copied\n              unsafeFreezeByteArray dst_marr\n    in shows (toList dst len) \"\\n\"\n\n------------------------------------------------------------------------\n-- copyAddrToByteArray#\n\n-- Copy a slice of the source memory area into a destination array and check\n-- that the copy succeeded.\ntest_copyAddrToByteArray :: String\ntest_copyAddrToByteArray =\n    let dst = runST $\n            withNewPinnedByteArray len $ \\src src_marr -> do\n              fill src_marr 0 len\n              dst <- newByteArray len\n              -- Markers to detect errors\n              writeWord8Array dst 0 255\n              writeWord8Array dst (len-1) 255\n              -- Leave the first and last element untouched\n              copyAddrToByteArray (src `plusPtr` 1) dst 1 copied\n              unsafeFreezeByteArray dst\n    in shows (toList dst len) \"\\n\"\n\n------------------------------------------------------------------------\n-- Test helpers\n\n-- Initialize the elements of this array, starting at the given\n-- offset.  The last parameter specifies the number of elements to\n-- initialize.  Element at index @i@ takes the value @i@ (i.e. the\n-- first actually modified element will take value @off@).\nfill :: MByteArray s -> Int -> Int -> ST s ()\nfill marr off count = go 0\n  where\n    go i\n        | i >= fromIntegral count = return ()\n        | otherwise = do writeWord8Array marr (off + i) (fromIntegral i)\n                         go (i + 1)\n\nfromList :: [Word8] -> ST s (MByteArray s)\nfromList xs0 = do\n    marr <- newByteArray (length xs0)\n    let go [] i = i `seq` return marr\n        go (x:xs) i = writeWord8Array marr i x >> go xs (i + 1)\n    go xs0 0\n\n------------------------------------------------------------------------\n-- Convenience wrappers for ByteArray# and MutableByteArray#\n\ndata ByteArray = ByteArray { unBA :: ByteArray# }\ndata MByteArray s = MByteArray { unMBA :: MutableByteArray# s }\n\nnewByteArray :: Int -> ST s (MByteArray s)\nnewByteArray (I# n#) = ST $ \\s# -> case newByteArray# n# s# of\n    (# s2#, marr# #) -> (# s2#, MByteArray marr# #)\n\nnewPinnedByteArray :: Int -> ST s (Ptr (), MByteArray s)\nnewPinnedByteArray (I# n#) = ST $ \\s# ->\n    case newPinnedByteArray# n# s# of\n        (# s2#, marr# #) ->\n          (# s2#, (Ptr (byteArrayContents# (unsafeCoerce# marr#)),\n                  MByteArray marr#) #)\n\nwithNewPinnedByteArray :: Int -> (Ptr () -> MByteArray s -> ST s a) -> ST s a\nwithNewPinnedByteArray n action = do\n    (ptr, marr) <- newPinnedByteArray n\n    x <- action ptr marr\n    touch marr\n    return x\n\ntouch :: a -> ST s ()\ntouch a = unsafeIOToST $ IO $ \\s# ->\n    case touch# a s# of\n        s2# -> (# s2#, () #)\n\nindexWord8Array :: ByteArray -> Int -> Word8\nindexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of\n    a -> W8# a\n\nwriteWord8Array :: MByteArray s -> Int -> Word8 -> ST s ()\nwriteWord8Array marr (I# i#) (W8# a) = ST $ \\ s# ->\n    case writeWord8Array# (unMBA marr) i# a s# of\n        s2# -> (# s2#, () #)\n\nunsafeFreezeByteArray :: MByteArray s -> ST s (ByteArray)\nunsafeFreezeByteArray marr = ST $ \\ s# ->\n    case unsafeFreezeByteArray# (unMBA marr) s# of\n        (# s2#, arr# #) -> (# s2#, ByteArray arr# #)\n\ncopyByteArray :: ByteArray -> Int -> MByteArray s -> Int -> Int -> ST s ()\ncopyByteArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \\ s# ->\n    case copyByteArray# (unBA src) six# (unMBA dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncopyMutableByteArray :: MByteArray s -> Int -> MByteArray s -> Int -> Int\n                     -> ST s ()\ncopyMutableByteArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \\ s# ->\n    case copyMutableByteArray# (unMBA src) six# (unMBA dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncopyAddrToByteArray :: Ptr () -> MByteArray s -> Int -> Int -> ST s ()\ncopyAddrToByteArray (Ptr src#) dst (I# dix#) (I# n#) = ST $ \\ s# ->\n    case copyAddrToByteArray# src# (unMBA dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncopyByteArrayToAddr :: ByteArray -> Int -> Ptr () -> Int -> ST s ()\ncopyByteArrayToAddr src (I# six#) (Ptr dst#) (I# n#) = ST $ \\ s# ->\n    case copyByteArrayToAddr# (unBA src) six# dst# n# s# of\n        s2# -> (# s2#, () #)\n\ncopyMutableByteArrayToAddr :: MByteArray s -> Int -> Ptr () -> Int -> ST s ()\ncopyMutableByteArrayToAddr src (I# six#) (Ptr dst#) (I# n#) = ST $ \\ s# ->\n    case copyMutableByteArrayToAddr# (unMBA src) six# dst# n# s# of\n        s2# -> (# s2#, () #)\n\ntoList :: ByteArray -> Int -> [Word8]\ntoList arr n = go 0\n  where\n    go i | i >= n = []\n         | otherwise = indexWord8Array arr i : go (i+1)\n", "num_lines": 242}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash #-}\n\nmodule Main ( main ) where\n\nimport Data.Bits\nimport GHC.Prim\nimport GHC.Word\n\n#include \"MachDeps.h\"\n\nmain = putStr\n       (test_popCnt ++ \"\\n\"\n        ++ test_popCnt8 ++ \"\\n\"\n        ++ test_popCnt16 ++ \"\\n\"\n        ++ test_popCnt32 ++ \"\\n\"\n        ++ test_popCnt64 ++ \"\\n\"\n        ++ \"\\n\"\n       )\n\npopcnt :: Word -> Word\npopcnt (W# w#) = W# (popCnt# w#)\n\npopcnt8 :: Word -> Word\npopcnt8 (W# w#) = W# (popCnt8# w#)\n\npopcnt16 :: Word -> Word\npopcnt16 (W# w#) = W# (popCnt16# w#)\n\npopcnt32 :: Word -> Word\npopcnt32 (W# w#) = W# (popCnt32# w#)\n\npopcnt64 :: Word64 -> Word\npopcnt64 (W64# w#) =\n#if SIZEOF_HSWORD == 4\n    W# (popCnt64# w#)\n#else\n    W# (popCnt# w#)\n#endif\n\n-- Cribbed from http://ghc.haskell.org/trac/ghc/ticket/3563\nslowPopcnt :: Word -> Word\nslowPopcnt x = count' (bitSize x) x 0\n  where\n    count' 0 _ !acc = acc\n    count' n x acc  = count' (n-1) (x `shiftR` 1)\n                      (acc + if x .&. 1 == 1 then 1 else 0)\n\ntest_popCnt = test popcnt slowPopcnt\ntest_popCnt8 = test popcnt8 (slowPopcnt . fromIntegral . (mask 8 .&.))\ntest_popCnt16 = test popcnt16 (slowPopcnt . fromIntegral . (mask 16 .&.))\ntest_popCnt32 = test popcnt32 (slowPopcnt . fromIntegral . (mask 32 .&.))\ntest_popCnt64 = test popcnt64 (slowPopcnt . fromIntegral . (mask 64 .&.))\n\nmask n = (2 ^ n) - 1\n\ntest :: (Show a, Num a) => (a -> Word) -> (a -> Word) -> String\ntest fast slow = case failing of\n    [] -> \"OK\"\n    ((_, e, a, i):xs) ->\n        \"FAIL\\n\" ++ \"   Input: \" ++ show i ++ \"\\nExpected: \" ++ show e ++\n        \"\\n  Actual: \" ++ show a\n  where\n    failing = dropWhile ( \\(b,_,_,_) -> b)\n              . map (\\ x -> (slow x == fast x, slow x, fast x, x)) $ cases\n    expected = map slow cases\n    actual = map fast cases\n    -- 10 random numbers\n#if SIZEOF_HSWORD == 4\n    cases = [1480294021,1626858410,2316287658,1246556957,3806579062,65945563,\n             1521588071,791321966,1355466914,2284998160]\n#elif SIZEOF_HSWORD == 8\n    cases = [11004539497957619752,5625461252166958202,1799960778872209546,\n             16979826074020750638,12789915432197771481,11680809699809094550,\n             13208678822802632247,13794454868797172383,13364728999716654549,\n             17516539991479925226]\n#else\n# error Unexpected word size\n#endif\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash #-}\n\n{- Note!\n   If you see output like\n\n        Expected: 48042\n          Actual: 48042\n\n   from this test, it means that the \"actual\" Word16 (or Word32)\n   has higher bits that are nonzero, which is not allowed!\n   See GHC.Word for an explanation.\n-}\n\nmodule Main ( main ) where\n\nimport Data.Bits\nimport GHC.Prim\nimport GHC.Word\n\n#include \"MachDeps.h\"\n\nmain :: IO ()\nmain = do putStrLn test_primop_bSwap16\n          putStrLn test_primop_bSwap32\n          putStrLn test_primop_bSwap64\n          putStrLn test_base_bSwap16\n          putStrLn test_base_bSwap32\n          putStrLn test_base_bSwap64\n          putStrLn test'_base_bSwap16\n          putStrLn test'_base_bSwap32\n          putStrLn test'_base_bSwap64\n\nbswap16 :: Word16 -> Word16\nbswap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#))\n\nbswap32 :: Word32 -> Word32\nbswap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#))\n\nbswap64 :: Word64 -> Word64\nbswap64 (W64# w#) = W64# (byteSwap64# w#)\n\nslowBswap64 :: Word64 -> Word64\nslowBswap64 w =\n        (w `shiftR` 56)                  .|. (w `shiftL` 56)\n    .|. ((w `shiftR` 40) .&. 0xff00)     .|. ((w .&. 0xff00) `shiftL` 40)\n    .|. ((w `shiftR` 24) .&. 0xff0000)   .|. ((w .&. 0xff0000) `shiftL` 24)\n    .|. ((w `shiftR` 8)  .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)\n\n-- | swap endianness on a Word32\nslowBswap32 :: Word32 -> Word32\nslowBswap32 w =\n         (w `shiftR` 24)             .|. (w `shiftL` 24)\n     .|. ((w `shiftR` 8) .&. 0xff00) .|. ((w .&. 0xff00) `shiftL` 8)\n\n-- | swap endianness on a Word16\nslowBswap16 :: Word16 -> Word16\nslowBswap16 w = (w `shiftR` 8) .|. (w `shiftL` 8)\n\n-- Test the primops directly.\ntest_primop_bSwap16 = test casesW16 bswap16 slowBswap16\ntest_primop_bSwap32 = test casesW32 bswap32 slowBswap32\ntest_primop_bSwap64 = test casesW64 bswap64 slowBswap64\n\n-- Test the wrappers in GHC.Word, inlined.\n-- Inlining matters because it means we are\n-- testing the backend used to run the test,\n-- rather than the backend used to build base.\ntest_base_bSwap16 = test casesW16 byteSwap16 slowBswap16\ntest_base_bSwap32 = test casesW32 byteSwap32 slowBswap32\ntest_base_bSwap64 = test casesW64 byteSwap64 slowBswap64\n\n-- Test the wrappers in GHC.Word, not inlined.\ntest'_base_bSwap16 = test' casesW16 byteSwap16 slowBswap16\ntest'_base_bSwap32 = test' casesW32 byteSwap32 slowBswap32\ntest'_base_bSwap64 = test' casesW64 byteSwap64 slowBswap64\n\n{-# INLINE test #-}\ntest :: (Eq a, Show a, Num a) => [a] -> (a -> a) -> (a -> a) -> String\ntest cases fast slow = case failing of\n    [] -> \"OK\"\n    ((_, e, a, i):xs) ->\n        \"FAIL\\n\" ++ \"   Input: \" ++ show i ++ \"\\nExpected: \" ++ show e ++\n        \"\\n  Actual: \" ++ show a\n  where\n    failing = dropWhile ( \\(b,_,_,_) -> b)\n              . map (\\ x -> (slow x == fast x, slow x, fast x, x)) $ cases\n    expected = map slow cases\n    actual = map fast cases\n\n{-# NOINLINE test' #-}\ntest' :: (Eq a, Show a, Num a) => [a] -> (a -> a) -> (a -> a) -> String\ntest' = test\n\ncasesW16 = [0xff00,0xf021,0x1234,0x5620,0x5463,0x0000,0xa00f,0x0201,0x2901,\n            0xaabb]\ncasesW32 = [1480294021,1626858410,2316287658,1246556957,3806579062,65945563,\n            1521588071,791321966,1355466914,2284998160]\ncasesW64 = [11004539497957619752,5625461252166958202,1799960778872209546,\n            16979826074020750638,12789915432197771481,11680809699809094550,\n            13208678822802632247,13794454868797172383,13364728999716654549,\n            17516539991479925226]\n", "num_lines": 102}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test exercises the \"large block\" allocation code in the\n-- scheduler, where the mutator requests more than a block's worth of\n-- memory.\n\nlonglistof x = [\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,\n  x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x\n  ]\n\nmain = print (sum (concat (map longlistof [1..100])))\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash #-}\n\nmodule Main ( main ) where\n\nimport Data.Bits\nimport GHC.Int\nimport GHC.Prim\nimport GHC.Word\nimport Data.Int\nimport Data.Word\n\n#include \"MachDeps.h\"\n\nmain = putStr\n        (   test_pdep   ++ \"\\n\"\n        ++  test_pdep8  ++ \"\\n\"\n        ++  test_pdep16 ++ \"\\n\"\n        ++  test_pdep32 ++ \"\\n\"\n        ++  test_pdep64 ++ \"\\n\"\n        ++  \"\\n\"\n        )\n\nclass Pdep a where\n  pdep :: a -> a -> a\n\ninstance Pdep Word where\n  pdep (W#   src#) (W#   mask#) = W#   (pdep#   src# mask#)\n\ninstance Pdep Word8 where\n  pdep (W8#  src#) (W8#  mask#) = W8#  (pdep8#  src# mask#)\n\ninstance Pdep Word16 where\n  pdep (W16# src#) (W16# mask#) = W16# (pdep16# src# mask#)\n\ninstance Pdep Word32 where\n  pdep (W32# src#) (W32# mask#) = W32# (pdep32# src# mask#)\n\ninstance Pdep Word64 where\n  pdep (W64# src#) (W64# mask#) = W64# (pdep64# src# mask#)\n\nclass SlowPdep a where\n  slowPdep :: a -> a -> a\n\ninstance SlowPdep Word where\n  slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPdep Word8 where\n  slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPdep Word16 where\n  slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPdep Word32 where\n  slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPdep Word64 where\n  slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))\n\nslowPdep64 :: Word64 -> Word64 -> Word64\nslowPdep64 = slowPdep64' 0\n\nslowPdep32 :: Word32 -> Word32 -> Word32\nslowPdep32 s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m))\n\nlsb :: Word64 -> Word64\nlsb src = fromIntegral ((fromIntegral (src `shiftL` 63) :: Int64) `shiftR` 63)\n\nslowPdep64' :: Word64 -> Word64 -> Word64 -> Word64\nslowPdep64' result src mask = if lowest /= 0\n  then slowPdep64' newResult (src `shiftR` 1) (mask .&. complement lowest)\n  else result\n  where lowest    = (-mask) .&. mask\n        newResult = (result .|. ((lsb src) .&. lowest))\n\ntest_pdep   = test (0 :: Word  ) pdep slowPdep\ntest_pdep8  = test (0 :: Word8 ) pdep slowPdep\ntest_pdep16 = test (0 :: Word16) pdep slowPdep\ntest_pdep32 = test (0 :: Word32) pdep slowPdep\ntest_pdep64 = test (0 :: Word64) pdep slowPdep\n\nmask n = (2 ^ n) - 1\n\nfst4 :: (a, b, c, d) -> a\nfst4 (a, _, _, _) = a\n\nrunCase :: Eq a\n        => (a -> a -> a)\n        -> (a -> a -> a)\n        -> (a, a)\n        -> (Bool, a, a, (a, a))\nrunCase fast slow (x, y) = (slow x y == fast x y, slow x y, fast x y, (x, y))\n\ntest :: (Show a, Num a, Eq a) => a -> (a -> a -> a) -> (a -> a -> a) -> String\ntest _ fast slow = case failing of\n    [] -> \"OK\"\n    ((_, e, a, i):xs) ->\n        \"FAIL\\n\" ++ \"   Input: \" ++ show i ++ \"\\nExpected: \" ++ show e ++\n        \"\\n  Actual: \" ++ show a\n  where failing = dropWhile fst4 . map (runCase fast slow) $ cases\n        cases   = (,) <$> numbers <*> numbers\n        -- 10 random numbers\n#if SIZEOF_HSWORD == 4\n        numbers = [ 1480294021, 1626858410, 2316287658, 1246556957, 3806579062\n                  , 65945563  , 1521588071, 791321966 , 1355466914, 2284998160\n                  ]\n#elif SIZEOF_HSWORD == 8\n        numbers = [ 11004539497957619752, 5625461252166958202\n                  , 1799960778872209546 , 16979826074020750638\n                  , 12789915432197771481, 11680809699809094550\n                  , 13208678822802632247, 13794454868797172383\n                  , 13364728999716654549, 17516539991479925226\n                  ]\n#else\n# error Unexpected word size\n#endif\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash #-}\n\nmodule Main ( main ) where\n\nimport Data.Bits\nimport GHC.Int\nimport GHC.Prim\nimport GHC.Word\nimport Data.Int\nimport Data.Word\n\n#include \"MachDeps.h\"\n\nmain = putStr\n        (   test_pext   ++ \"\\n\"\n        ++  test_pext8  ++ \"\\n\"\n        ++  test_pext16 ++ \"\\n\"\n        ++  test_pext32 ++ \"\\n\"\n        ++  test_pext64 ++ \"\\n\"\n        ++  \"\\n\"\n        )\n\nclass Pext a where\n  pext :: a -> a -> a\n\ninstance Pext Word where\n  pext (W#   src#) (W#   mask#) = W#   (pext#   src# mask#)\n\ninstance Pext Word8 where\n  pext (W8#  src#) (W8#  mask#) = W8#  (pext8#  src# mask#)\n\ninstance Pext Word16 where\n  pext (W16# src#) (W16# mask#) = W16# (pext16# src# mask#)\n\ninstance Pext Word32 where\n  pext (W32# src#) (W32# mask#) = W32# (pext32# src# mask#)\n\ninstance Pext Word64 where\n  pext (W64# src#) (W64# mask#) = W64# (pext64# src# mask#)\n\nclass SlowPext a where\n  slowPext :: a -> a -> a\n\ninstance SlowPext Word where\n  slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPext Word8 where\n  slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPext Word16 where\n  slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPext Word32 where\n  slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))\n\ninstance SlowPext Word64 where\n  slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))\n\nslowPext64 :: Word64 -> Word64 -> Word64\nslowPext64 = slowPext64' 0 0 0\n\nslowPext32 :: Word32 -> Word32 -> Word32\nslowPext32 s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m))\n\nslowPext64' :: Word64 -> Int -> Int -> Word64 -> Word64 -> Word64\nslowPext64' result offset index src mask = if index /= 64\n  then if maskBit /= 0\n          then slowPext64' nextResult (offset + 1) (index + 1) src mask\n          else slowPext64' result      offset      (index + 1) src mask\n  else result\n  where srcBit      = (src  `shiftR` index) .&. 1\n        maskBit     = (mask `shiftR` index) .&. 1\n        nextResult  = result .|. (srcBit `shiftL` offset)\n\ntest_pext   = test (0 :: Word  ) pext slowPext\ntest_pext8  = test (0 :: Word8 ) pext slowPext\ntest_pext16 = test (0 :: Word16) pext slowPext\ntest_pext32 = test (0 :: Word32) pext slowPext\ntest_pext64 = test (0 :: Word64) pext slowPext\n\nmask n = (2 ^ n) - 1\n\nfst4 :: (a, b, c, d) -> a\nfst4 (a, _, _, _) = a\n\nrunCase :: Eq a\n        => (a -> a -> a)\n        -> (a -> a -> a)\n        -> (a, a)\n        -> (Bool, a, a, (a, a))\nrunCase fast slow (x, y) = (slow x y == fast x y, slow x y, fast x y, (x, y))\n\ntest :: (Show a, Num a, Eq a) => a -> (a -> a -> a) -> (a -> a -> a) -> String\ntest _ fast slow = case failing of\n    [] -> \"OK\"\n    ((_, e, a, i):xs) ->\n        \"FAIL\\n\" ++ \"   Input: \" ++ show i ++ \"\\nExpected: \" ++ show e ++\n        \"\\n  Actual: \" ++ show a\n  where failing = dropWhile fst4 . map (runCase fast slow) $ cases\n        cases   = (,) <$> numbers <*> numbers\n        -- 10 random numbers\n#if SIZEOF_HSWORD == 4\n        numbers = [ 1480294021, 1626858410, 2316287658, 1246556957, 3806579062\n                  , 65945563  , 1521588071, 791321966 , 1355466914, 2284998160\n                  ]\n#elif SIZEOF_HSWORD == 8\n        numbers = [ 11004539497957619752, 5625461252166958202\n                  , 1799960778872209546 , 16979826074020750638\n                  , 12789915432197771481, 11680809699809094550\n                  , 13208678822802632247, 13794454868797172383\n                  , 13364728999716654549, 17516539991479925226\n                  ]\n#else\n# error Unexpected word size\n#endif\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash #-}\n\nmodule Main ( main ) where\n\nimport Data.Bits\nimport GHC.Prim\nimport GHC.Word\n\n#include \"MachDeps.h\"\n\nmain = putStr\n       (test_lzCnt ++ \"\\n\"\n        ++ test_lzCnt8 ++ \"\\n\"\n        ++ test_lzCnt16 ++ \"\\n\"\n        ++ test_lzCnt32 ++ \"\\n\"\n        ++ test_lzCnt64 ++ \"\\n\"\n        ++ \"\\n\"\n        ++ test_tzCnt ++ \"\\n\"\n        ++ test_tzCnt8 ++ \"\\n\"\n        ++ test_tzCnt16 ++ \"\\n\"\n        ++ test_tzCnt32 ++ \"\\n\"\n        ++ test_tzCnt64 ++ \"\\n\"\n        ++ \"\\n\"\n       )\n\nlzcnt :: Word -> Word\nlzcnt (W# w#) = W# (clz# w#)\n\nlzcnt8 :: Word -> Word\nlzcnt8 (W# w#) = W# (clz8# w#)\n\nlzcnt16 :: Word -> Word\nlzcnt16 (W# w#) = W# (clz16# w#)\n\nlzcnt32 :: Word -> Word\nlzcnt32 (W# w#) = W# (clz32# w#)\n\nlzcnt64 :: Word64 -> Word\nlzcnt64 (W64# w#) =\n#if SIZEOF_HSWORD == 4\n    W# (clz64# w#)\n#else\n    W# (clz# w#)\n#endif\n\nlzcnt_slow :: Int -> Word -> Word\nlzcnt_slow size x = fromIntegral $ min size $ length $ takeWhile (== False) $ reverse $ map (testBit x) [0 .. size - 1]\n\ntzcnt :: Word -> Word\ntzcnt (W# w#) = W# (ctz# w#)\n\ntzcnt8 :: Word -> Word\ntzcnt8 (W# w#) = W# (ctz8# w#)\n\ntzcnt16 :: Word -> Word\ntzcnt16 (W# w#) = W# (ctz16# w#)\n\ntzcnt32 :: Word -> Word\ntzcnt32 (W# w#) = W# (ctz32# w#)\n\ntzcnt64 :: Word64 -> Word\ntzcnt64 (W64# w#) =\n#if SIZEOF_HSWORD == 4\n    W# (ctz64# w#)\n#else\n    W# (ctz# w#)\n#endif\n\ntzcnt_slow :: Int -> Word -> Word\ntzcnt_slow size x = fromIntegral $ min size $ length $ takeWhile (== False) $ map (testBit x) [0 .. size - 1]\n\ntest_lzCnt = test \"lzcnt\" lzcnt (lzcnt_slow (8 * SIZEOF_HSWORD))\ntest_lzCnt8 = test \"lzcnt8\" lzcnt8 (lzcnt_slow 8 . fromIntegral . (mask 8 .&.))\ntest_lzCnt16 = test \"lzcnt16\" lzcnt16 (lzcnt_slow 16 . fromIntegral . (mask 16 .&.))\ntest_lzCnt32 = test \"lzcnt32\" lzcnt32 (lzcnt_slow 32 . fromIntegral . (mask 32 .&.))\ntest_lzCnt64 = test \"lzcnt64\" lzcnt64 (lzcnt_slow 64 . fromIntegral . (mask 64 .&.))\n\ntest_tzCnt = test \"tzcnt\" tzcnt (tzcnt_slow (8 * SIZEOF_HSWORD))\ntest_tzCnt8 = test \"tzcnt8\" tzcnt8 (tzcnt_slow 8 . fromIntegral . (mask 8 .&.))\ntest_tzCnt16 = test \"tzcnt16\" tzcnt16 (tzcnt_slow 16 . fromIntegral . (mask 16 .&.))\ntest_tzCnt32 = test \"tzcnt32\" tzcnt32 (tzcnt_slow 32 . fromIntegral . (mask 32 .&.))\ntest_tzCnt64 = test \"tzcnt64\" tzcnt64 (tzcnt_slow 64 . fromIntegral . (mask 64 .&.))\n\nmask n = (2 ^ n) - 1\n\ntest :: (Show a, Num a) => String -> (a -> Word) -> (a -> Word) -> String\ntest name fast slow = case failing of\n    [] -> \"OK\"\n    ((_, e, a, i):xs) ->\n        \"FAIL \" ++ name ++ \"\\n\" ++ \"   Input: \" ++ show i ++ \"\\nExpected: \" ++ show e ++\n        \"\\n  Actual: \" ++ show a\n  where\n    failing = dropWhile ( \\(b,_,_,_) -> b)\n              . map (\\ x -> (slow x == fast x, slow x, fast x, x)) $ cases\n    expected = map slow cases\n    actual = map fast cases\n#if SIZEOF_HSWORD == 4\n    cases = [0, 1, 2, 1480294021,1626858410,2316287658,1246556957,3806579062,65945563,\n             1521588071,791321966,1355466914,2284998160]\n#elif SIZEOF_HSWORD == 8\n    cases = [0, 1, 2, 11004539497957619752,5625461252166958202,1799960778872209546,\n             16979826074020750638,12789915432197771481,11680809699809094550,\n             13208678822802632247,13794454868797172383,13364728999716654549,\n             17516539991479925226]\n#else\n# error Unexpected word size\n#endif\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE LambdaCase         #-}\n{-# LANGUAGE StaticPointers     #-}\n\n-- | A test to use symbols produced by the static form.\nmodule Main(main) where\n\nimport Data.Typeable\nimport GHC.StaticPtr\n\nmain :: IO ()\nmain = do\n  lookupKey (static (id . id)) >>= \\f -> print $ f (1 :: Int)\n  lookupKey (static method :: StaticPtr (Char -> Int)) >>= \\f -> print $ f 'a'\n  print $ deRefStaticPtr (static g)\n  print $ deRefStaticPtr p0 'a'\n  print $ deRefStaticPtr (static t_field) $ T 'b'\n where\n  g :: String\n  g = \"found\"\n\nlookupKey :: StaticPtr a -> IO a\nlookupKey p = unsafeLookupStaticPtr (staticKey p) >>= \\case\n  Just p -> return $ deRefStaticPtr p\n  Nothing -> error $ \"couldn't find \" ++ show (staticPtrInfo p)\n\np0 :: Typeable a => StaticPtr (a -> a)\np0 = static (\\x -> x)\n\ndata T a = T { t_field :: a }\n  deriving Typeable\n\nclass C1 a where\n  method :: a -> Int\n\ninstance C1 Char where\n  method = const 0\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE LambdaCase         #-}\n{-# LANGUAGE StaticPointers     #-}\n\n-- | A test to use symbols produced by the static form.\nmodule Main(main) where\n\nimport Data.Typeable\nimport GHC.StaticPtr\n\nmain :: IO ()\nmain = do\n  lookupKey (static (id . id)) >>= \\f -> print $ f (1 :: Int)\n  lookupKey (static method :: StaticPtr (Char -> Int)) >>= \\f -> print $ f 'a'\n  print $ deRefStaticPtr (static g)\n  print $ deRefStaticPtr p0 'a'\n  print $ deRefStaticPtr (static t_field) $ T 'b'\n where\n  g :: String\n  g = \"found\"\n\nlookupKey :: StaticPtr a -> IO a\nlookupKey p = unsafeLookupStaticPtr (staticKey p) >>= \\case\n  Just p -> return $ deRefStaticPtr p\n  Nothing -> error $ \"couldn't find \" ++ show (staticPtrInfo p)\n\np0 :: Typeable a => StaticPtr (a -> a)\np0 = static (\\x -> x)\n\ndata T a = T { t_field :: a }\n  deriving Typeable\n\nclass C1 a where\n  method :: a -> Int\n\ninstance C1 Char where\n  method = const 0\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This file is generated from CmmSwitchTestGen! @generated\n{-# LANGUAGE MagicHash, NegativeLiterals #-}\nimport Control.Monad (unless, forM_)\nimport GHC.Exts\n{-# NOINLINE aa #-}\naa :: Int# -> Int#\naa 1# = 42#\naa 2# = 43#\naa 3# = 43#\naa 4# = 44#\naa 5# = 44#\naa 6# = 45#\naa 7# = 45#\naa 8# = 46#\naa 9# = 46#\naa 10# = 47#\naa _ = 1337#\n\n{-# NOINLINE ab #-}\nab :: Int# -> Int#\nab 0# = 42#\nab 1# = 42#\nab 2# = 43#\nab 3# = 43#\nab 4# = 44#\nab 5# = 44#\nab 6# = 45#\nab 7# = 45#\nab 8# = 46#\nab 9# = 46#\nab 10# = 47#\nab _ = 1337#\n\n{-# NOINLINE ac #-}\nac :: Int# -> Int#\nac 1# = 42#\nac 2# = 43#\nac 3# = 43#\nac _ = 1337#\n\n{-# NOINLINE ad #-}\nad :: Int# -> Int#\nad 1# = 42#\nad 2# = 43#\nad 3# = 43#\nad 4# = 44#\nad _ = 1337#\n\n{-# NOINLINE ae #-}\nae :: Int# -> Int#\nae 1# = 42#\nae 2# = 43#\nae 3# = 43#\nae 4# = 44#\nae 5# = 44#\nae _ = 1337#\n\n{-# NOINLINE af #-}\naf :: Int# -> Int#\naf -1# = 41#\naf 0# = 42#\naf 1# = 42#\naf 2# = 43#\naf 3# = 43#\naf 4# = 44#\naf 5# = 44#\naf 6# = 45#\naf 7# = 45#\naf 8# = 46#\naf 9# = 46#\naf 10# = 47#\naf _ = 1337#\n\n{-# NOINLINE ag #-}\nag :: Int# -> Int#\nag -10# = 37#\nag -9# = 37#\nag -8# = 38#\nag -7# = 38#\nag -6# = 39#\nag -5# = 39#\nag -4# = 40#\nag -3# = 40#\nag -2# = 41#\nag -1# = 41#\nag 0# = 42#\nag 1# = 42#\nag 2# = 43#\nag 3# = 43#\nag 4# = 44#\nag 5# = 44#\nag 6# = 45#\nag 7# = 45#\nag 8# = 46#\nag 9# = 46#\nag 10# = 47#\nag _ = 1337#\n\n{-# NOINLINE ah #-}\nah :: Int# -> Int#\nah -20# = 32#\nah -19# = 32#\nah -18# = 33#\nah -17# = 33#\nah -16# = 34#\nah -15# = 34#\nah -14# = 35#\nah -13# = 35#\nah -12# = 36#\nah -11# = 36#\nah -10# = 37#\nah 0# = 42#\nah 1# = 42#\nah 2# = 43#\nah 3# = 43#\nah 4# = 44#\nah 5# = 44#\nah 6# = 45#\nah 7# = 45#\nah 8# = 46#\nah 9# = 46#\nah 10# = 47#\nah _ = 1337#\n\n{-# NOINLINE ai #-}\nai :: Int# -> Int#\nai -20# = 32#\nai -19# = 32#\nai -18# = 33#\nai -17# = 33#\nai -16# = 34#\nai -15# = 34#\nai -14# = 35#\nai -13# = 35#\nai -12# = 36#\nai -11# = 36#\nai -10# = 37#\nai 1# = 42#\nai 2# = 43#\nai 3# = 43#\nai 4# = 44#\nai 5# = 44#\nai 6# = 45#\nai 7# = 45#\nai 8# = 46#\nai 9# = 46#\nai 10# = 47#\nai _ = 1337#\n\n{-# NOINLINE aj #-}\naj :: Int# -> Int#\naj -2147483648# = -1073741782#\naj 0# = 42#\naj 2147483647# = 1073741865#\naj _ = 1337#\n\n{-# NOINLINE ak #-}\nak :: Int# -> Int#\nak 2147483637# = 1073741860#\nak 2147483638# = 1073741861#\nak 2147483639# = 1073741861#\nak 2147483640# = 1073741862#\nak 2147483641# = 1073741862#\nak 2147483642# = 1073741863#\nak 2147483643# = 1073741863#\nak 2147483644# = 1073741864#\nak 2147483645# = 1073741864#\nak 2147483646# = 1073741865#\nak 2147483647# = 1073741865#\nak _ = 1337#\n\n{-# NOINLINE al #-}\nal :: Int# -> Int#\nal -2147483648# = -1073741782#\nal -2147483647# = -1073741782#\nal -2147483646# = -1073741781#\nal -2147483645# = -1073741781#\nal -2147483644# = -1073741780#\nal -2147483643# = -1073741780#\nal -2147483642# = -1073741779#\nal -2147483641# = -1073741779#\nal -2147483640# = -1073741778#\nal -2147483639# = -1073741778#\nal -2147483638# = -1073741777#\nal 2147483637# = 1073741860#\nal 2147483638# = 1073741861#\nal 2147483639# = 1073741861#\nal 2147483640# = 1073741862#\nal 2147483641# = 1073741862#\nal 2147483642# = 1073741863#\nal 2147483643# = 1073741863#\nal 2147483644# = 1073741864#\nal 2147483645# = 1073741864#\nal 2147483646# = 1073741865#\nal 2147483647# = 1073741865#\nal _ = 1337#\n\n{-# NOINLINE am #-}\nam :: Word# -> Word#\nam 0## = 42##\nam 1## = 42##\nam 2## = 43##\nam 3## = 43##\nam 4## = 44##\nam 5## = 44##\nam 6## = 45##\nam 7## = 45##\nam 8## = 46##\nam 9## = 46##\nam 10## = 47##\nam _ = 1337##\n\n{-# NOINLINE an #-}\nan :: Word# -> Word#\nan 1## = 42##\nan 2## = 43##\nan 3## = 43##\nan 4## = 44##\nan 5## = 44##\nan 6## = 45##\nan 7## = 45##\nan 8## = 46##\nan 9## = 46##\nan 10## = 47##\nan _ = 1337##\n\n{-# NOINLINE ao #-}\nao :: Word# -> Word#\nao 0## = 42##\nao _ = 1337##\n\n{-# NOINLINE ap #-}\nap :: Word# -> Word#\nap 0## = 42##\nap 1## = 42##\nap _ = 1337##\n\n{-# NOINLINE aq #-}\naq :: Word# -> Word#\naq 0## = 42##\naq 1## = 42##\naq 2## = 43##\naq _ = 1337##\n\n{-# NOINLINE ar #-}\nar :: Word# -> Word#\nar 0## = 42##\nar 1## = 42##\nar 2## = 43##\nar 3## = 43##\nar _ = 1337##\n\n{-# NOINLINE as #-}\nas :: Word# -> Word#\nas 0## = 42##\nas 1## = 42##\nas 2## = 43##\nas 3## = 43##\nas 4## = 44##\nas _ = 1337##\n\n{-# NOINLINE at #-}\nat :: Word# -> Word#\nat 1## = 42##\nat _ = 1337##\n\n{-# NOINLINE au #-}\nau :: Word# -> Word#\nau 1## = 42##\nau 2## = 43##\nau _ = 1337##\n\n{-# NOINLINE av #-}\nav :: Word# -> Word#\nav 1## = 42##\nav 2## = 43##\nav 3## = 43##\nav _ = 1337##\n\n{-# NOINLINE aw #-}\naw :: Word# -> Word#\naw 1## = 42##\naw 2## = 43##\naw 3## = 43##\naw 4## = 44##\naw _ = 1337##\n\n{-# NOINLINE ax #-}\nax :: Word# -> Word#\nax 1## = 42##\nax 2## = 43##\nax 3## = 43##\nax 4## = 44##\nax 5## = 44##\nax _ = 1337##\n\n{-# NOINLINE ay #-}\nay :: Word# -> Word#\nay 0## = 42##\nay 4294967295## = 2147483689##\nay _ = 1337##\n\n{-# NOINLINE az #-}\naz :: Word# -> Word#\naz 4294967285## = 2147483684##\naz 4294967286## = 2147483685##\naz 4294967287## = 2147483685##\naz 4294967288## = 2147483686##\naz 4294967289## = 2147483686##\naz 4294967290## = 2147483687##\naz 4294967291## = 2147483687##\naz 4294967292## = 2147483688##\naz 4294967293## = 2147483688##\naz 4294967294## = 2147483689##\naz 4294967295## = 2147483689##\naz _ = 1337##\n\n{-# NOINLINE ba #-}\nba :: Word# -> Word#\nba 0## = 42##\nba 1## = 42##\nba 2## = 43##\nba 3## = 43##\nba 4## = 44##\nba 5## = 44##\nba 6## = 45##\nba 7## = 45##\nba 8## = 46##\nba 9## = 46##\nba 10## = 47##\nba 4294967285## = 2147483684##\nba 4294967286## = 2147483685##\nba 4294967287## = 2147483685##\nba 4294967288## = 2147483686##\nba 4294967289## = 2147483686##\nba 4294967290## = 2147483687##\nba 4294967291## = 2147483687##\nba 4294967292## = 2147483688##\nba 4294967293## = 2147483688##\nba 4294967294## = 2147483689##\nba 4294967295## = 2147483689##\nba _ = 1337##\n\naa_check :: IO ()\naa_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (aa i)\n   unless (r == o) $ putStrLn $ \"ERR: aa (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nab_check :: IO ()\nab_check = forM_\n    [ (-1,1337)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ab i)\n   unless (r == o) $ putStrLn $ \"ERR: ab (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nac_check :: IO ()\nac_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,1337)] $ \\(I# i,o) -> do\n   let r = I# (ac i)\n   unless (r == o) $ putStrLn $ \"ERR: ac (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nad_check :: IO ()\nad_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,1337)] $ \\(I# i,o) -> do\n   let r = I# (ad i)\n   unless (r == o) $ putStrLn $ \"ERR: ad (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nae_check :: IO ()\nae_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,1337)] $ \\(I# i,o) -> do\n   let r = I# (ae i)\n   unless (r == o) $ putStrLn $ \"ERR: ae (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naf_check :: IO ()\naf_check = forM_\n    [ (-2,1337)\n    , (-1,41)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (af i)\n   unless (r == o) $ putStrLn $ \"ERR: af (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nag_check :: IO ()\nag_check = forM_\n    [ (-11,1337)\n    , (-10,37)\n    , (-9,37)\n    , (-8,38)\n    , (-7,38)\n    , (-6,39)\n    , (-5,39)\n    , (-4,40)\n    , (-3,40)\n    , (-2,41)\n    , (-1,41)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ag i)\n   unless (r == o) $ putStrLn $ \"ERR: ag (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nah_check :: IO ()\nah_check = forM_\n    [ (-21,1337)\n    , (-20,32)\n    , (-19,32)\n    , (-18,33)\n    , (-17,33)\n    , (-16,34)\n    , (-15,34)\n    , (-14,35)\n    , (-13,35)\n    , (-12,36)\n    , (-11,36)\n    , (-10,37)\n    , (-9,1337)\n    , (-1,1337)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ah i)\n   unless (r == o) $ putStrLn $ \"ERR: ah (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nai_check :: IO ()\nai_check = forM_\n    [ (-21,1337)\n    , (-20,32)\n    , (-19,32)\n    , (-18,33)\n    , (-17,33)\n    , (-16,34)\n    , (-15,34)\n    , (-14,35)\n    , (-13,35)\n    , (-12,36)\n    , (-11,36)\n    , (-10,37)\n    , (-9,1337)\n    , (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ai i)\n   unless (r == o) $ putStrLn $ \"ERR: ai (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naj_check :: IO ()\naj_check = forM_\n    [ (-2147483648,-1073741782)\n    , (-2147483647,1337)\n    , (-1,1337)\n    , (0,42)\n    , (1,1337)\n    , (2147483646,1337)\n    , (2147483647,1073741865)] $ \\(I# i,o) -> do\n   let r = I# (aj i)\n   unless (r == o) $ putStrLn $ \"ERR: aj (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nak_check :: IO ()\nak_check = forM_\n    [ (2147483636,1337)\n    , (2147483637,1073741860)\n    , (2147483638,1073741861)\n    , (2147483639,1073741861)\n    , (2147483640,1073741862)\n    , (2147483641,1073741862)\n    , (2147483642,1073741863)\n    , (2147483643,1073741863)\n    , (2147483644,1073741864)\n    , (2147483645,1073741864)\n    , (2147483646,1073741865)\n    , (2147483647,1073741865)] $ \\(I# i,o) -> do\n   let r = I# (ak i)\n   unless (r == o) $ putStrLn $ \"ERR: ak (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nal_check :: IO ()\nal_check = forM_\n    [ (-2147483648,-1073741782)\n    , (-2147483647,-1073741782)\n    , (-2147483646,-1073741781)\n    , (-2147483645,-1073741781)\n    , (-2147483644,-1073741780)\n    , (-2147483643,-1073741780)\n    , (-2147483642,-1073741779)\n    , (-2147483641,-1073741779)\n    , (-2147483640,-1073741778)\n    , (-2147483639,-1073741778)\n    , (-2147483638,-1073741777)\n    , (-2147483637,1337)\n    , (2147483636,1337)\n    , (2147483637,1073741860)\n    , (2147483638,1073741861)\n    , (2147483639,1073741861)\n    , (2147483640,1073741862)\n    , (2147483641,1073741862)\n    , (2147483642,1073741863)\n    , (2147483643,1073741863)\n    , (2147483644,1073741864)\n    , (2147483645,1073741864)\n    , (2147483646,1073741865)\n    , (2147483647,1073741865)] $ \\(I# i,o) -> do\n   let r = I# (al i)\n   unless (r == o) $ putStrLn $ \"ERR: al (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nam_check :: IO ()\nam_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(W# i,o) -> do\n   let r = W# (am i)\n   unless (r == o) $ putStrLn $ \"ERR: am (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nan_check :: IO ()\nan_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(W# i,o) -> do\n   let r = W# (an i)\n   unless (r == o) $ putStrLn $ \"ERR: an (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nao_check :: IO ()\nao_check = forM_\n    [ (0,42)\n    , (1,1337)] $ \\(W# i,o) -> do\n   let r = W# (ao i)\n   unless (r == o) $ putStrLn $ \"ERR: ao (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nap_check :: IO ()\nap_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,1337)] $ \\(W# i,o) -> do\n   let r = W# (ap i)\n   unless (r == o) $ putStrLn $ \"ERR: ap (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naq_check :: IO ()\naq_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,1337)] $ \\(W# i,o) -> do\n   let r = W# (aq i)\n   unless (r == o) $ putStrLn $ \"ERR: aq (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nar_check :: IO ()\nar_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,1337)] $ \\(W# i,o) -> do\n   let r = W# (ar i)\n   unless (r == o) $ putStrLn $ \"ERR: ar (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nas_check :: IO ()\nas_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,1337)] $ \\(W# i,o) -> do\n   let r = W# (as i)\n   unless (r == o) $ putStrLn $ \"ERR: as (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nat_check :: IO ()\nat_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,1337)] $ \\(W# i,o) -> do\n   let r = W# (at i)\n   unless (r == o) $ putStrLn $ \"ERR: at (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nau_check :: IO ()\nau_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,1337)] $ \\(W# i,o) -> do\n   let r = W# (au i)\n   unless (r == o) $ putStrLn $ \"ERR: au (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nav_check :: IO ()\nav_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,1337)] $ \\(W# i,o) -> do\n   let r = W# (av i)\n   unless (r == o) $ putStrLn $ \"ERR: av (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naw_check :: IO ()\naw_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,1337)] $ \\(W# i,o) -> do\n   let r = W# (aw i)\n   unless (r == o) $ putStrLn $ \"ERR: aw (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nax_check :: IO ()\nax_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,1337)] $ \\(W# i,o) -> do\n   let r = W# (ax i)\n   unless (r == o) $ putStrLn $ \"ERR: ax (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nay_check :: IO ()\nay_check = forM_\n    [ (0,42)\n    , (1,1337)\n    , (4294967294,1337)\n    , (4294967295,2147483689)] $ \\(W# i,o) -> do\n   let r = W# (ay i)\n   unless (r == o) $ putStrLn $ \"ERR: ay (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naz_check :: IO ()\naz_check = forM_\n    [ (4294967284,1337)\n    , (4294967285,2147483684)\n    , (4294967286,2147483685)\n    , (4294967287,2147483685)\n    , (4294967288,2147483686)\n    , (4294967289,2147483686)\n    , (4294967290,2147483687)\n    , (4294967291,2147483687)\n    , (4294967292,2147483688)\n    , (4294967293,2147483688)\n    , (4294967294,2147483689)\n    , (4294967295,2147483689)] $ \\(W# i,o) -> do\n   let r = W# (az i)\n   unless (r == o) $ putStrLn $ \"ERR: az (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nba_check :: IO ()\nba_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)\n    , (4294967284,1337)\n    , (4294967285,2147483684)\n    , (4294967286,2147483685)\n    , (4294967287,2147483685)\n    , (4294967288,2147483686)\n    , (4294967289,2147483686)\n    , (4294967290,2147483687)\n    , (4294967291,2147483687)\n    , (4294967292,2147483688)\n    , (4294967293,2147483688)\n    , (4294967294,2147483689)\n    , (4294967295,2147483689)] $ \\(W# i,o) -> do\n   let r = W# (ba i)\n   unless (r == o) $ putStrLn $ \"ERR: ba (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nmain = do\n    aa_check\n    ab_check\n    ac_check\n    ad_check\n    ae_check\n    af_check\n    ag_check\n    ah_check\n    ai_check\n    aj_check\n    ak_check\n    al_check\n    am_check\n    an_check\n    ao_check\n    ap_check\n    aq_check\n    ar_check\n    as_check\n    at_check\n    au_check\n    av_check\n    aw_check\n    ax_check\n    ay_check\n    az_check\n    ba_check\n\n\n", "num_lines": 792}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This file is generated from CmmSwitchTestGen! @generated\n{-# LANGUAGE MagicHash, NegativeLiterals #-}\nimport Control.Monad (unless, forM_)\nimport GHC.Exts\n{-# NOINLINE aa #-}\naa :: Int# -> Int#\naa 1# = 42#\naa 2# = 43#\naa 3# = 43#\naa 4# = 44#\naa 5# = 44#\naa 6# = 45#\naa 7# = 45#\naa 8# = 46#\naa 9# = 46#\naa 10# = 47#\naa _ = 1337#\n\n{-# NOINLINE ab #-}\nab :: Int# -> Int#\nab 0# = 42#\nab 1# = 42#\nab 2# = 43#\nab 3# = 43#\nab 4# = 44#\nab 5# = 44#\nab 6# = 45#\nab 7# = 45#\nab 8# = 46#\nab 9# = 46#\nab 10# = 47#\nab _ = 1337#\n\n{-# NOINLINE ac #-}\nac :: Int# -> Int#\nac 1# = 42#\nac 2# = 43#\nac 3# = 43#\nac _ = 1337#\n\n{-# NOINLINE ad #-}\nad :: Int# -> Int#\nad 1# = 42#\nad 2# = 43#\nad 3# = 43#\nad 4# = 44#\nad _ = 1337#\n\n{-# NOINLINE ae #-}\nae :: Int# -> Int#\nae 1# = 42#\nae 2# = 43#\nae 3# = 43#\nae 4# = 44#\nae 5# = 44#\nae _ = 1337#\n\n{-# NOINLINE af #-}\naf :: Int# -> Int#\naf -1# = 41#\naf 0# = 42#\naf 1# = 42#\naf 2# = 43#\naf 3# = 43#\naf 4# = 44#\naf 5# = 44#\naf 6# = 45#\naf 7# = 45#\naf 8# = 46#\naf 9# = 46#\naf 10# = 47#\naf _ = 1337#\n\n{-# NOINLINE ag #-}\nag :: Int# -> Int#\nag -10# = 37#\nag -9# = 37#\nag -8# = 38#\nag -7# = 38#\nag -6# = 39#\nag -5# = 39#\nag -4# = 40#\nag -3# = 40#\nag -2# = 41#\nag -1# = 41#\nag 0# = 42#\nag 1# = 42#\nag 2# = 43#\nag 3# = 43#\nag 4# = 44#\nag 5# = 44#\nag 6# = 45#\nag 7# = 45#\nag 8# = 46#\nag 9# = 46#\nag 10# = 47#\nag _ = 1337#\n\n{-# NOINLINE ah #-}\nah :: Int# -> Int#\nah -20# = 32#\nah -19# = 32#\nah -18# = 33#\nah -17# = 33#\nah -16# = 34#\nah -15# = 34#\nah -14# = 35#\nah -13# = 35#\nah -12# = 36#\nah -11# = 36#\nah -10# = 37#\nah 0# = 42#\nah 1# = 42#\nah 2# = 43#\nah 3# = 43#\nah 4# = 44#\nah 5# = 44#\nah 6# = 45#\nah 7# = 45#\nah 8# = 46#\nah 9# = 46#\nah 10# = 47#\nah _ = 1337#\n\n{-# NOINLINE ai #-}\nai :: Int# -> Int#\nai -20# = 32#\nai -19# = 32#\nai -18# = 33#\nai -17# = 33#\nai -16# = 34#\nai -15# = 34#\nai -14# = 35#\nai -13# = 35#\nai -12# = 36#\nai -11# = 36#\nai -10# = 37#\nai 1# = 42#\nai 2# = 43#\nai 3# = 43#\nai 4# = 44#\nai 5# = 44#\nai 6# = 45#\nai 7# = 45#\nai 8# = 46#\nai 9# = 46#\nai 10# = 47#\nai _ = 1337#\n\n{-# NOINLINE aj #-}\naj :: Int# -> Int#\naj -9223372036854775808# = -4611686018427387862#\naj 0# = 42#\naj 9223372036854775807# = 4611686018427387945#\naj _ = 1337#\n\n{-# NOINLINE ak #-}\nak :: Int# -> Int#\nak 9223372036854775797# = 4611686018427387940#\nak 9223372036854775798# = 4611686018427387941#\nak 9223372036854775799# = 4611686018427387941#\nak 9223372036854775800# = 4611686018427387942#\nak 9223372036854775801# = 4611686018427387942#\nak 9223372036854775802# = 4611686018427387943#\nak 9223372036854775803# = 4611686018427387943#\nak 9223372036854775804# = 4611686018427387944#\nak 9223372036854775805# = 4611686018427387944#\nak 9223372036854775806# = 4611686018427387945#\nak 9223372036854775807# = 4611686018427387945#\nak _ = 1337#\n\n{-# NOINLINE al #-}\nal :: Int# -> Int#\nal -9223372036854775808# = -4611686018427387862#\nal -9223372036854775807# = -4611686018427387862#\nal -9223372036854775806# = -4611686018427387861#\nal -9223372036854775805# = -4611686018427387861#\nal -9223372036854775804# = -4611686018427387860#\nal -9223372036854775803# = -4611686018427387860#\nal -9223372036854775802# = -4611686018427387859#\nal -9223372036854775801# = -4611686018427387859#\nal -9223372036854775800# = -4611686018427387858#\nal -9223372036854775799# = -4611686018427387858#\nal -9223372036854775798# = -4611686018427387857#\nal 9223372036854775797# = 4611686018427387940#\nal 9223372036854775798# = 4611686018427387941#\nal 9223372036854775799# = 4611686018427387941#\nal 9223372036854775800# = 4611686018427387942#\nal 9223372036854775801# = 4611686018427387942#\nal 9223372036854775802# = 4611686018427387943#\nal 9223372036854775803# = 4611686018427387943#\nal 9223372036854775804# = 4611686018427387944#\nal 9223372036854775805# = 4611686018427387944#\nal 9223372036854775806# = 4611686018427387945#\nal 9223372036854775807# = 4611686018427387945#\nal _ = 1337#\n\n{-# NOINLINE am #-}\nam :: Word# -> Word#\nam 0## = 42##\nam 1## = 42##\nam 2## = 43##\nam 3## = 43##\nam 4## = 44##\nam 5## = 44##\nam 6## = 45##\nam 7## = 45##\nam 8## = 46##\nam 9## = 46##\nam 10## = 47##\nam _ = 1337##\n\n{-# NOINLINE an #-}\nan :: Word# -> Word#\nan 1## = 42##\nan 2## = 43##\nan 3## = 43##\nan 4## = 44##\nan 5## = 44##\nan 6## = 45##\nan 7## = 45##\nan 8## = 46##\nan 9## = 46##\nan 10## = 47##\nan _ = 1337##\n\n{-# NOINLINE ao #-}\nao :: Word# -> Word#\nao 0## = 42##\nao _ = 1337##\n\n{-# NOINLINE ap #-}\nap :: Word# -> Word#\nap 0## = 42##\nap 1## = 42##\nap _ = 1337##\n\n{-# NOINLINE aq #-}\naq :: Word# -> Word#\naq 0## = 42##\naq 1## = 42##\naq 2## = 43##\naq _ = 1337##\n\n{-# NOINLINE ar #-}\nar :: Word# -> Word#\nar 0## = 42##\nar 1## = 42##\nar 2## = 43##\nar 3## = 43##\nar _ = 1337##\n\n{-# NOINLINE as #-}\nas :: Word# -> Word#\nas 0## = 42##\nas 1## = 42##\nas 2## = 43##\nas 3## = 43##\nas 4## = 44##\nas _ = 1337##\n\n{-# NOINLINE at #-}\nat :: Word# -> Word#\nat 1## = 42##\nat _ = 1337##\n\n{-# NOINLINE au #-}\nau :: Word# -> Word#\nau 1## = 42##\nau 2## = 43##\nau _ = 1337##\n\n{-# NOINLINE av #-}\nav :: Word# -> Word#\nav 1## = 42##\nav 2## = 43##\nav 3## = 43##\nav _ = 1337##\n\n{-# NOINLINE aw #-}\naw :: Word# -> Word#\naw 1## = 42##\naw 2## = 43##\naw 3## = 43##\naw 4## = 44##\naw _ = 1337##\n\n{-# NOINLINE ax #-}\nax :: Word# -> Word#\nax 1## = 42##\nax 2## = 43##\nax 3## = 43##\nax 4## = 44##\nax 5## = 44##\nax _ = 1337##\n\n{-# NOINLINE ay #-}\nay :: Word# -> Word#\nay 0## = 42##\nay 18446744073709551615## = 9223372036854775849##\nay _ = 1337##\n\n{-# NOINLINE az #-}\naz :: Word# -> Word#\naz 18446744073709551605## = 9223372036854775844##\naz 18446744073709551606## = 9223372036854775845##\naz 18446744073709551607## = 9223372036854775845##\naz 18446744073709551608## = 9223372036854775846##\naz 18446744073709551609## = 9223372036854775846##\naz 18446744073709551610## = 9223372036854775847##\naz 18446744073709551611## = 9223372036854775847##\naz 18446744073709551612## = 9223372036854775848##\naz 18446744073709551613## = 9223372036854775848##\naz 18446744073709551614## = 9223372036854775849##\naz 18446744073709551615## = 9223372036854775849##\naz _ = 1337##\n\n{-# NOINLINE ba #-}\nba :: Word# -> Word#\nba 0## = 42##\nba 1## = 42##\nba 2## = 43##\nba 3## = 43##\nba 4## = 44##\nba 5## = 44##\nba 6## = 45##\nba 7## = 45##\nba 8## = 46##\nba 9## = 46##\nba 10## = 47##\nba 18446744073709551605## = 9223372036854775844##\nba 18446744073709551606## = 9223372036854775845##\nba 18446744073709551607## = 9223372036854775845##\nba 18446744073709551608## = 9223372036854775846##\nba 18446744073709551609## = 9223372036854775846##\nba 18446744073709551610## = 9223372036854775847##\nba 18446744073709551611## = 9223372036854775847##\nba 18446744073709551612## = 9223372036854775848##\nba 18446744073709551613## = 9223372036854775848##\nba 18446744073709551614## = 9223372036854775849##\nba 18446744073709551615## = 9223372036854775849##\nba _ = 1337##\n\naa_check :: IO ()\naa_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (aa i)\n   unless (r == o) $ putStrLn $ \"ERR: aa (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nab_check :: IO ()\nab_check = forM_\n    [ (-1,1337)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ab i)\n   unless (r == o) $ putStrLn $ \"ERR: ab (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nac_check :: IO ()\nac_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,1337)] $ \\(I# i,o) -> do\n   let r = I# (ac i)\n   unless (r == o) $ putStrLn $ \"ERR: ac (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nad_check :: IO ()\nad_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,1337)] $ \\(I# i,o) -> do\n   let r = I# (ad i)\n   unless (r == o) $ putStrLn $ \"ERR: ad (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nae_check :: IO ()\nae_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,1337)] $ \\(I# i,o) -> do\n   let r = I# (ae i)\n   unless (r == o) $ putStrLn $ \"ERR: ae (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naf_check :: IO ()\naf_check = forM_\n    [ (-2,1337)\n    , (-1,41)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (af i)\n   unless (r == o) $ putStrLn $ \"ERR: af (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nag_check :: IO ()\nag_check = forM_\n    [ (-11,1337)\n    , (-10,37)\n    , (-9,37)\n    , (-8,38)\n    , (-7,38)\n    , (-6,39)\n    , (-5,39)\n    , (-4,40)\n    , (-3,40)\n    , (-2,41)\n    , (-1,41)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ag i)\n   unless (r == o) $ putStrLn $ \"ERR: ag (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nah_check :: IO ()\nah_check = forM_\n    [ (-21,1337)\n    , (-20,32)\n    , (-19,32)\n    , (-18,33)\n    , (-17,33)\n    , (-16,34)\n    , (-15,34)\n    , (-14,35)\n    , (-13,35)\n    , (-12,36)\n    , (-11,36)\n    , (-10,37)\n    , (-9,1337)\n    , (-1,1337)\n    , (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ah i)\n   unless (r == o) $ putStrLn $ \"ERR: ah (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nai_check :: IO ()\nai_check = forM_\n    [ (-21,1337)\n    , (-20,32)\n    , (-19,32)\n    , (-18,33)\n    , (-17,33)\n    , (-16,34)\n    , (-15,34)\n    , (-14,35)\n    , (-13,35)\n    , (-12,36)\n    , (-11,36)\n    , (-10,37)\n    , (-9,1337)\n    , (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(I# i,o) -> do\n   let r = I# (ai i)\n   unless (r == o) $ putStrLn $ \"ERR: ai (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naj_check :: IO ()\naj_check = forM_\n    [ (-9223372036854775808,-4611686018427387862)\n    , (-9223372036854775807,1337)\n    , (-1,1337)\n    , (0,42)\n    , (1,1337)\n    , (9223372036854775806,1337)\n    , (9223372036854775807,4611686018427387945)] $ \\(I# i,o) -> do\n   let r = I# (aj i)\n   unless (r == o) $ putStrLn $ \"ERR: aj (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nak_check :: IO ()\nak_check = forM_\n    [ (9223372036854775796,1337)\n    , (9223372036854775797,4611686018427387940)\n    , (9223372036854775798,4611686018427387941)\n    , (9223372036854775799,4611686018427387941)\n    , (9223372036854775800,4611686018427387942)\n    , (9223372036854775801,4611686018427387942)\n    , (9223372036854775802,4611686018427387943)\n    , (9223372036854775803,4611686018427387943)\n    , (9223372036854775804,4611686018427387944)\n    , (9223372036854775805,4611686018427387944)\n    , (9223372036854775806,4611686018427387945)\n    , (9223372036854775807,4611686018427387945)] $ \\(I# i,o) -> do\n   let r = I# (ak i)\n   unless (r == o) $ putStrLn $ \"ERR: ak (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nal_check :: IO ()\nal_check = forM_\n    [ (-9223372036854775808,-4611686018427387862)\n    , (-9223372036854775807,-4611686018427387862)\n    , (-9223372036854775806,-4611686018427387861)\n    , (-9223372036854775805,-4611686018427387861)\n    , (-9223372036854775804,-4611686018427387860)\n    , (-9223372036854775803,-4611686018427387860)\n    , (-9223372036854775802,-4611686018427387859)\n    , (-9223372036854775801,-4611686018427387859)\n    , (-9223372036854775800,-4611686018427387858)\n    , (-9223372036854775799,-4611686018427387858)\n    , (-9223372036854775798,-4611686018427387857)\n    , (-9223372036854775797,1337)\n    , (9223372036854775796,1337)\n    , (9223372036854775797,4611686018427387940)\n    , (9223372036854775798,4611686018427387941)\n    , (9223372036854775799,4611686018427387941)\n    , (9223372036854775800,4611686018427387942)\n    , (9223372036854775801,4611686018427387942)\n    , (9223372036854775802,4611686018427387943)\n    , (9223372036854775803,4611686018427387943)\n    , (9223372036854775804,4611686018427387944)\n    , (9223372036854775805,4611686018427387944)\n    , (9223372036854775806,4611686018427387945)\n    , (9223372036854775807,4611686018427387945)] $ \\(I# i,o) -> do\n   let r = I# (al i)\n   unless (r == o) $ putStrLn $ \"ERR: al (\" ++ show (I# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nam_check :: IO ()\nam_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(W# i,o) -> do\n   let r = W# (am i)\n   unless (r == o) $ putStrLn $ \"ERR: am (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nan_check :: IO ()\nan_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)] $ \\(W# i,o) -> do\n   let r = W# (an i)\n   unless (r == o) $ putStrLn $ \"ERR: an (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nao_check :: IO ()\nao_check = forM_\n    [ (0,42)\n    , (1,1337)] $ \\(W# i,o) -> do\n   let r = W# (ao i)\n   unless (r == o) $ putStrLn $ \"ERR: ao (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nap_check :: IO ()\nap_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,1337)] $ \\(W# i,o) -> do\n   let r = W# (ap i)\n   unless (r == o) $ putStrLn $ \"ERR: ap (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naq_check :: IO ()\naq_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,1337)] $ \\(W# i,o) -> do\n   let r = W# (aq i)\n   unless (r == o) $ putStrLn $ \"ERR: aq (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nar_check :: IO ()\nar_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,1337)] $ \\(W# i,o) -> do\n   let r = W# (ar i)\n   unless (r == o) $ putStrLn $ \"ERR: ar (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nas_check :: IO ()\nas_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,1337)] $ \\(W# i,o) -> do\n   let r = W# (as i)\n   unless (r == o) $ putStrLn $ \"ERR: as (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nat_check :: IO ()\nat_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,1337)] $ \\(W# i,o) -> do\n   let r = W# (at i)\n   unless (r == o) $ putStrLn $ \"ERR: at (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nau_check :: IO ()\nau_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,1337)] $ \\(W# i,o) -> do\n   let r = W# (au i)\n   unless (r == o) $ putStrLn $ \"ERR: au (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nav_check :: IO ()\nav_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,1337)] $ \\(W# i,o) -> do\n   let r = W# (av i)\n   unless (r == o) $ putStrLn $ \"ERR: av (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naw_check :: IO ()\naw_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,1337)] $ \\(W# i,o) -> do\n   let r = W# (aw i)\n   unless (r == o) $ putStrLn $ \"ERR: aw (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nax_check :: IO ()\nax_check = forM_\n    [ (0,1337)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,1337)] $ \\(W# i,o) -> do\n   let r = W# (ax i)\n   unless (r == o) $ putStrLn $ \"ERR: ax (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nay_check :: IO ()\nay_check = forM_\n    [ (0,42)\n    , (1,1337)\n    , (18446744073709551614,1337)\n    , (18446744073709551615,9223372036854775849)] $ \\(W# i,o) -> do\n   let r = W# (ay i)\n   unless (r == o) $ putStrLn $ \"ERR: ay (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\naz_check :: IO ()\naz_check = forM_\n    [ (18446744073709551604,1337)\n    , (18446744073709551605,9223372036854775844)\n    , (18446744073709551606,9223372036854775845)\n    , (18446744073709551607,9223372036854775845)\n    , (18446744073709551608,9223372036854775846)\n    , (18446744073709551609,9223372036854775846)\n    , (18446744073709551610,9223372036854775847)\n    , (18446744073709551611,9223372036854775847)\n    , (18446744073709551612,9223372036854775848)\n    , (18446744073709551613,9223372036854775848)\n    , (18446744073709551614,9223372036854775849)\n    , (18446744073709551615,9223372036854775849)] $ \\(W# i,o) -> do\n   let r = W# (az i)\n   unless (r == o) $ putStrLn $ \"ERR: az (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nba_check :: IO ()\nba_check = forM_\n    [ (0,42)\n    , (1,42)\n    , (2,43)\n    , (3,43)\n    , (4,44)\n    , (5,44)\n    , (6,45)\n    , (7,45)\n    , (8,46)\n    , (9,46)\n    , (10,47)\n    , (11,1337)\n    , (18446744073709551604,1337)\n    , (18446744073709551605,9223372036854775844)\n    , (18446744073709551606,9223372036854775845)\n    , (18446744073709551607,9223372036854775845)\n    , (18446744073709551608,9223372036854775846)\n    , (18446744073709551609,9223372036854775846)\n    , (18446744073709551610,9223372036854775847)\n    , (18446744073709551611,9223372036854775847)\n    , (18446744073709551612,9223372036854775848)\n    , (18446744073709551613,9223372036854775848)\n    , (18446744073709551614,9223372036854775849)\n    , (18446744073709551615,9223372036854775849)] $ \\(W# i,o) -> do\n   let r = W# (ba i)\n   unless (r == o) $ putStrLn $ \"ERR: ba (\" ++ show (W# i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"\n\nmain = do\n    aa_check\n    ab_check\n    ac_check\n    ad_check\n    ae_check\n    af_check\n    ag_check\n    ah_check\n    ai_check\n    aj_check\n    ak_check\n    al_check\n    am_check\n    an_check\n    ao_check\n    ap_check\n    aq_check\n    ar_check\n    as_check\n    at_check\n    au_check\n    av_check\n    aw_check\n    ax_check\n    ay_check\n    az_check\n    ba_check\n\n\n", "num_lines": 792}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections #-}\n\n-- Generates CmmSwitchTest.hs\n\nimport qualified Data.Set as S\nimport Data.Int\nimport Data.Word\nimport Data.List\nimport System.Environment\n\noutput :: Integer -> Integer\noutput n = n`div`2 + 42\n\ndef :: Integer\ndef = 1337\n\ndata Bits = X32 | X64\n    deriving Eq\ntype Spec = (String, Bool, [Integer], Bits)\n\nprimtyp True = \"Int#\"\nprimtyp False = \"Word#\"\n\ncon True = \"I#\"\ncon False = \"W#\"\n\nhash True = \"#\"\nhash False = \"##\"\n\nprimLit s v = show v ++ hash s\n\ngenSwitch :: Spec -> String\ngenSwitch (name, signed, values, _) = unlines $\n  [ \"{-# NOINLINE \" ++ name ++ \" #-}\" ] ++\n  [ name ++ \" :: \" ++ primtyp signed ++ \" -> \" ++ primtyp signed ] ++\n  [ name ++ \" \" ++ primLit signed v ++ \" = \" ++ primLit signed (output v)\n  | v <- values] ++\n  [ name ++ \" _ = \" ++ primLit signed def ]\n\ngenCheck :: Spec -> String\ngenCheck (name, signed, values, bits) = unlines $\n  [ checkName name ++ \" :: IO ()\"\n  , checkName name ++ \" = forM_\\n    [ \" ++ pairs ++ \"] $ \\\\(\" ++ con signed ++ \" i,o) -> do\"\n  , \"   let r = \" ++ con signed ++ \" (\" ++ name ++ \" i)\"\n  , \"   unless (r == o) $ putStrLn $ \\\"ERR: \" ++ name ++ \" (\\\" ++ show (\" ++ con signed ++ \" i)++ \\\") is \\\" ++ show r ++ \\\" and not \\\" ++ show o ++\\\".\\\"\"\n  ]\n  where\n    f x | x `S.member` range = output x\n        | otherwise          = def\n    range = S.fromList values\n    minS = if bits == X32 then minS32 else minS64\n    maxS = if bits == X32 then maxS32 else maxS64\n    maxU = if bits == X32 then maxU32 else maxU64\n    checkValues = S.toList $ S.fromList $\n        [ v' | v <- values, v' <- [v-1,v,v+1],\n               if signed then v' >= minS && v' <= maxS else v' >= minU && v' <= maxU ]\n    pairs = intercalate \"\\n    , \" [\"(\" ++ show v ++ \",\" ++ show (f v) ++ \")\" | v <- checkValues ]\n\ncheckName :: String -> String\ncheckName f = f ++ \"_check\"\n\ngenMain :: [Spec] -> String\ngenMain specs = unlines $ \"main = do\" : [ \"    \" ++ checkName n | (n,_,_,_) <- specs ]\n\ngenMod :: [Spec] -> String\ngenMod specs = unlines $\n    \"-- This file is generated from CmmSwitchTestGen! @generated\" :\n    \"{-# LANGUAGE MagicHash, NegativeLiterals #-}\" :\n    \"import Control.Monad (unless, forM_)\" :\n    \"import GHC.Exts\" :\n    map genSwitch specs ++\n    map genCheck specs ++\n    [ genMain specs ]\n\nmain = do\n    args <- getArgs\n    bits <- parse args\n    putStrLn $\n        genMod $ zipWith (\\n (s,v) -> (n,s,v,bits)) names $ signedChecks bits ++ unsignedChecks bits\n\nparse :: [String] -> IO Bits  -- Use IO to avoid lazy parsing\nparse [\"-32\"] = return X32\nparse [\"-64\"] = return X64\nparse _ = error \"Please, supply -32 or -64 option\"\n\nsignedChecks :: Bits -> [(Bool, [Integer])]\nsignedChecks bits = map (True,)\n    [ [1..10]\n    , [0..10]\n    , [1..3]\n    , [1..4]\n    , [1..5]\n    , [-1..10]\n    , [-10..10]\n    , [-20.. -10]++[0..10]\n    , [-20.. -10]++[1..10]\n    , [minS,0,maxS]\n    , [maxS-10 .. maxS]\n    , [minS..minS+10]++[maxS-10 .. maxS]\n    ]\n    where\n        minS = if bits == X32 then minS32 else minS64\n        maxS = if bits == X32 then maxS32 else maxS64\n\nminU, maxU32, maxU64, minS32, minS64, maxS32, maxS64 :: Integer\nminU = 0\nmaxU32 = fromIntegral (maxBound :: Word32)\nmaxU64 = fromIntegral (maxBound :: Word64)\n\nminS32 = fromIntegral (minBound :: Int32)\nminS64 = fromIntegral (minBound :: Int64)\nmaxS32 = fromIntegral (maxBound :: Int32)\nmaxS64 = fromIntegral (maxBound :: Int64)\n\n\nunsignedChecks :: Bits -> [(Bool, [Integer])]\nunsignedChecks bits = map (False,)\n    [ [0..10]\n    , [1..10]\n    , [0]\n    , [0..1]\n    , [0..2]\n    , [0..3]\n    , [0..4]\n    , [1]\n    , [1..2]\n    , [1..3]\n    , [1..4]\n    , [1..5]\n    , [minU,maxU]\n    , [maxU-10 .. maxU]\n    , [minU..minU+10]++[maxU-10 .. maxU]\n    ]\n    where\n        maxU = if bits == X32 then maxU32 else maxU64\n\nnames :: [String]\nnames = [ c1:c2:[] | c1 <- ['a'..'z'], c2 <- ['a'..'z']]\n", "num_lines": 139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash     #-}\n{-# LANGUAGE RankNTypes    #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n-- exercise the 'compareByteArray#' primitive\n\nmodule Main (main) where\n\nimport           Control.Monad\nimport           Control.Monad.ST\nimport           Data.List\nimport           GHC.Exts         (Int (..))\nimport           GHC.Prim\nimport           GHC.ST           (ST (ST))\nimport           GHC.Word         (Word8 (..))\nimport           Text.Printf\n\ndata BA    = BA#   ByteArray#\n\ninstance Show BA where\n  show xs = \"[\" ++ intercalate \",\" (map (printf \"0x%02x\") (unpack xs)) ++ \"]\"\n\ninstance Eq BA where\n  x == y = eqByteArray x 0 (sizeofByteArray x) y 0 (sizeofByteArray y)\n\ninstance Ord BA where\n  compare x y = ordByteArray x 0 (sizeofByteArray x) y 0 (sizeofByteArray y)\n\ncompareByteArrays :: BA -> Int -> BA -> Int -> Int -> Int\ncompareByteArrays (BA# ba1#) (I# ofs1#) (BA# ba2#) (I# ofs2#) (I# n#)\n  = I# (compareByteArrays# ba1# ofs1# ba2# ofs2# n#)\n\n{-\ncopyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()\ncopyByteArray (BA# src#) (I# srcOfs#) (MBA# dest#) (I# destOfs#) (I# n#)\n  = ST $ \\s -> case copyByteArray# src# srcOfs# dest# destOfs# n# s of\n                 s' -> (# s', () #)\n-}\n\nindexWord8Array :: BA -> Int -> Word8\nindexWord8Array (BA# ba#) (I# i#)\n  = W8# (indexWord8Array# ba# i#)\n\nsizeofByteArray :: BA -> Int\nsizeofByteArray (BA# ba#) = I# (sizeofByteArray# ba#)\n\n\ndata MBA s = MBA# (MutableByteArray# s)\n\nnewByteArray :: Int -> ST s (MBA s)\nnewByteArray (I# n#)\n  = ST $ \\s -> case newByteArray# n# s of\n                 (# s', mba# #) -> (# s', MBA# mba# #)\n\nwriteWord8Array :: MBA s -> Int -> Word8 -> ST s ()\nwriteWord8Array (MBA# mba#) (I# i#) (W8# j#)\n  = ST $ \\s -> case writeWord8Array# mba# i# j# s of\n                 s' -> (# s', () #)\n\nunsafeFreezeByteArray :: MBA s -> ST s BA\nunsafeFreezeByteArray (MBA# mba#)\n  = ST $ \\s -> case unsafeFreezeByteArray# mba# s of\n                 (# s', ba# #) -> (# s', BA# ba# #)\n\n----------------------------------------------------------------------------\n-- high-level operations\n\ncreateByteArray :: Int -> (forall s. MBA s -> ST s ()) -> BA\ncreateByteArray n go = runST $ do\n    mba <- newByteArray n\n    go mba\n    unsafeFreezeByteArray mba\n\npack :: [Word8] -> BA\npack xs = createByteArray (length xs) $ \\mba -> do\n    let  go _ [] = pure ()\n         go i (y:ys) = do\n           writeWord8Array mba i y\n           go (i+1) ys\n    go 0 xs\n\nunpack :: BA -> [Word8]\nunpack ba = go 0\n  where\n    go i | i < sz = indexWord8Array ba i : go (i+1)\n         | otherwise = []\n    sz = sizeofByteArray ba\n\neqByteArray :: BA -> Int -> Int -> BA -> Int -> Int -> Bool\neqByteArray ba1 ofs1 n1 ba2 ofs2 n2\n  | n1 /= n2  = False\n  | n1 == 0   = True\n  | otherwise = compareByteArrays ba1 ofs1 ba2 ofs2 n1 == 0\n\nordByteArray :: BA -> Int -> Int -> BA -> Int -> Int -> Ordering\nordByteArray ba1 ofs1 n1 ba2 ofs2 n2\n  | n == 0 = compare n1 n2\n  | otherwise = case compareByteArrays ba1 ofs1 ba2 ofs2 n of\n      r | r < 0     -> LT\n        | r > 0     -> GT\n        | n1 < n2   -> LT\n        | n1 > n2   -> GT\n        | otherwise -> EQ\n  where\n    n = n1 `min` n2\n\nmain :: IO ()\nmain = do\n    putStrLn \"BEGIN\"\n    -- a couple of low-level tests\n    print (compareByteArrays s1 0 s2 0 4 `compare` 0)\n    print (compareByteArrays s2 0 s1 0 4 `compare` 0)\n    print (compareByteArrays s1 0 s2 0 3 `compare` 0)\n    print (compareByteArrays s1 0 s2 1 3 `compare` 0)\n    print (compareByteArrays s1 3 s2 2 1 `compare` 0)\n\n    forM_ [(s1,s1),(s1,s2),(s2,s1),(s2,s2)] $ \\(x,y) -> do\n      print (x == y, compare x y)\n\n    -- realistic test\n    print (sort (map pack strs) == map pack (sort strs))\n\n    -- brute-force test\n    forM_ [1..15] $ \\n -> do\n      forM_ [0..rnglen-(n+1)] $ \\j -> do\n        forM_ [0..rnglen-(n+1)] $ \\k -> do\n          let iut = compareByteArrays srng j srng k n `compare` 0\n              ref = (take n (drop j rng) `compare` take n (drop k rng))\n          unless (iut == ref) $\n            print (\"FAIL\",n,j,k,iut,ref)\n\n    putStrLn \"END\"\n  where\n    s1, s2 :: BA\n    s1 = pack [0xca,0xfe,0xba,0xbe]\n    s2 = pack [0xde,0xad,0xbe,0xef]\n\n    strs = let go i xs = case splitAt (i `mod` 5) xs of\n                           ([],[]) -> []\n                           (y,ys)  -> y : go (i+1) ys\n           in go 1 rng\n\n    srng = pack rng\n\n    rnglen = length rng\n\n    rng :: [Word8]\n    rng = [ 0xc1, 0x60, 0x31, 0xb6, 0x46, 0x81, 0xa7, 0xc6, 0xa8, 0xf4, 0x1e, 0x5d, 0xb7, 0x7c, 0x0b, 0xcd\n          , 0x10, 0xfa, 0xe3, 0xdd, 0xf4, 0x26, 0xf9, 0x50, 0x4b, 0x9c, 0xdf, 0xc4, 0xda, 0xca, 0xc1, 0x60\n          , 0x91, 0xf8, 0x70, 0x1a, 0x53, 0x89, 0xf1, 0xd9, 0xee, 0xff, 0x52, 0xb8, 0x1c, 0x5e, 0x25, 0x69\n          , 0xd1, 0xa1, 0x08, 0x47, 0x93, 0x89, 0x71, 0x7a, 0xe4, 0x56, 0x24, 0x1b, 0xa1, 0x43, 0x63, 0xc0\n          , 0x4d, 0xec, 0x93, 0x30, 0xb7, 0x98, 0x19, 0x23, 0x4e, 0x00, 0x76, 0x7e, 0xf4, 0xcc, 0x8b, 0x92\n          , 0x19, 0xc5, 0x3d, 0xf4, 0xa0, 0x4f, 0xe3, 0x64, 0x1b, 0x4e, 0x01, 0xc9, 0xfc, 0x47, 0x3e, 0x16\n          , 0xa4, 0x78, 0xdd, 0x12, 0x20, 0xa6, 0x0b, 0xcd, 0x82, 0x06, 0xd0, 0x2a, 0x19, 0x2d, 0x2f, 0xf2\n          , 0x8a, 0xf0, 0xc2, 0x2d, 0x0e, 0xfb, 0x39, 0x55, 0xb2, 0xfb, 0x6e, 0xd0, 0xfa, 0xf0, 0x87, 0x57\n          , 0x93, 0xa3, 0xae, 0x36, 0x1f, 0xcf, 0x91, 0x45, 0x44, 0x11, 0x62, 0x7f, 0x18, 0x9a, 0xcb, 0x54\n          , 0x78, 0x3c, 0x04, 0xbe, 0x3e, 0xd4, 0x2c, 0xbf, 0x73, 0x38, 0x9e, 0xf5, 0xc9, 0xbe, 0xd9, 0xf8\n          , 0xe5, 0xf5, 0x41, 0xbb, 0x84, 0x03, 0x2c, 0xe2, 0x0d, 0xe5, 0x8b, 0x1c, 0x75, 0xf7, 0x4c, 0x49\n          , 0xfe, 0xac, 0x9f, 0xf4, 0x36, 0xf2, 0xba, 0x5f, 0xc0, 0xda, 0x24, 0xfc, 0x10, 0x61, 0xf0, 0xb6\n          , 0xa7, 0xc7, 0xba, 0xc6, 0xb0, 0x41, 0x04, 0x8c, 0xd0, 0xe8, 0x48, 0x41, 0x38, 0xa4, 0x84, 0x21\n          , 0xb6, 0xb1, 0x21, 0x33, 0x58, 0xf2, 0xa5, 0xe5, 0x73, 0xf2, 0xd7, 0xbc, 0xc7, 0x7e, 0x86, 0xee\n          , 0x81, 0xb1, 0xcd, 0x42, 0xc0, 0x2c, 0xd0, 0xa0, 0x8d, 0xb5, 0x4a, 0x5b, 0xc1, 0xfe, 0xcc, 0x92\n          , 0x59, 0xf4, 0x71, 0x96, 0x58, 0x6a, 0xb6, 0xa2, 0xf7, 0x67, 0x76, 0x01, 0xc5, 0x8b, 0xc9, 0x6f\n          , 0x38, 0x93, 0xf3, 0xaa, 0x89, 0xf7, 0xb2, 0x2a, 0x0f, 0x19, 0x7b, 0x48, 0xbe, 0x86, 0x37, 0xd1\n          , 0x30, 0xfa, 0xce, 0x72, 0xf4, 0x25, 0x64, 0xee, 0xde, 0x3a, 0x5c, 0x02, 0x32, 0xe6, 0x31, 0x3a\n          , 0x4b, 0x18, 0x47, 0x30, 0xa4, 0x2c, 0xf8, 0x4d, 0xc5, 0xee, 0x0b, 0x9c, 0x75, 0x43, 0x2a, 0xf9\n          ]\n", "num_lines": 168}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\n-- !!! simple tests of copying/cloning primitive arrays\n--\n\nmodule Main ( main ) where\n\nimport GHC.Exts hiding (IsList(..))\nimport GHC.Prim\nimport GHC.ST\n\nmain :: IO ()\nmain = putStr\n       (test_copyArray\n        ++ \"\\n\" ++ test_copyMutableArray\n        ++ \"\\n\" ++ test_copyMutableArrayOverlap\n        ++ \"\\n\" ++ test_cloneArray\n        ++ \"\\n\" ++ test_cloneArrayStatic\n        ++ \"\\n\" ++ test_cloneMutableArray\n        ++ \"\\n\" ++ test_cloneMutableArrayEmpty\n        ++ \"\\n\" ++ test_cloneMutableArrayStatic\n        ++ \"\\n\" ++ test_freezeArray\n        ++ \"\\n\" ++ test_freezeArrayStatic\n        ++ \"\\n\" ++ test_thawArray\n        ++ \"\\n\" ++ test_thawArrayStatic\n        ++ \"\\n\"\n       )\n\n------------------------------------------------------------------------\n-- Constants\n\n-- All allocated arrays are of this size\nlen :: Int\nlen = 130\n\n-- We copy these many elements\ncopied :: Int\ncopied = len - 2\n\ncopiedStatic :: Int\ncopiedStatic = 16\n{-# INLINE copiedStatic #-}  -- to make sure optimization triggers\n\n------------------------------------------------------------------------\n-- copySmallArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyArray :: String\ntest_copyArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            dst <- newArray len (-1)\n            -- Leave the first and last element untouched\n            copyArray src 1 dst 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst len) \"\\n\"\n\n------------------------------------------------------------------------\n-- copySmallMutableArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyMutableArray :: String\ntest_copyMutableArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            dst <- newArray len (-1)\n            -- Leave the first and last element untouched\n            copyMutableArray src 1 dst 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst len) \"\\n\"\n\n-- Perform a copy where the source and destination part overlap.\ntest_copyMutableArrayOverlap :: String\ntest_copyMutableArrayOverlap =\n    let arr = runST $ do\n            marr <- fromList inp\n            -- Overlap of two elements\n            copyMutableArray marr 5 marr 7 8\n            unsafeFreezeArray marr\n    in shows (toList arr (length inp)) \"\\n\"\n  where\n     -- This case was known to fail at some point.\n     inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]\n\n------------------------------------------------------------------------\n-- cloneSmallArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_cloneArray :: String\ntest_cloneArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            return $! cloneArray src 1 copied\n    in shows (toList dst copied) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_cloneArrayStatic :: String\ntest_cloneArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            return $! cloneArray src 1 copiedStatic\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- cloneMutableSmallArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_cloneMutableArray :: String\ntest_cloneMutableArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            dst <- cloneMutableArray src 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst copied) \"\\n\"\n\n-- Check that zero-length clones work.\ntest_cloneMutableArrayEmpty :: String\ntest_cloneMutableArrayEmpty =\n    let dst = runST $ do\n            src <- newArray len 0\n            dst <- cloneMutableArray src 0 0\n            unsafeFreezeArray dst\n    in shows (toList dst 0) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_cloneMutableArrayStatic :: String\ntest_cloneMutableArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            dst <- cloneMutableArray src 1 copiedStatic\n            unsafeFreezeArray dst\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- freezeSmallArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_freezeArray :: String\ntest_freezeArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            freezeArray src 1 copied\n    in shows (toList dst copied) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_freezeArrayStatic :: String\ntest_freezeArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            -- Don't include the first and last element.\n            freezeArray src 1 copiedStatic\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- thawSmallArray#\n\n-- Clone a slice of the source array into a destination array and\n-- check that the clone succeeded.\ntest_thawArray :: String\ntest_thawArray =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            dst <- thawArray src 1 copied\n            unsafeFreezeArray dst\n    in shows (toList dst copied) \"\\n\"\n\n--  Check that the static-size optimization works.\ntest_thawArrayStatic :: String\ntest_thawArrayStatic =\n    let dst = runST $ do\n            src <- newArray len 0\n            fill src 0 len\n            src <- unsafeFreezeArray src\n            -- Don't include the first and last element.\n            dst <- thawArray src 1 copiedStatic\n            unsafeFreezeArray dst\n    in shows (toList dst copiedStatic) \"\\n\"\n\n------------------------------------------------------------------------\n-- Test helpers\n\n-- Initialize the elements of this array, starting at the given\n-- offset.  The last parameter specifies the number of elements to\n-- initialize.  Element at index @i@ takes the value @i*i@ (i.e. the\n-- first actually modified element will take value @off*off@).\nfill :: MArray s Int -> Int -> Int -> ST s ()\nfill marr off count = go 0\n  where\n    go i\n        | i >= count = return ()\n        | otherwise = writeArray marr (off + i) (i*i) >> go (i + 1)\n\nfromList :: [Int] -> ST s (MArray s Int)\nfromList xs0 = do\n    marr <- newArray (length xs0) bottomElem\n    let go [] i = i `seq` return marr\n        go (x:xs) i = writeArray marr i x >> go xs (i + 1)\n    go xs0 0\n  where\n    bottomElem = error \"undefined element\"\n\n------------------------------------------------------------------------\n-- Convenience wrappers for SmallArray# and MutableSmallArray#\n\ndata Array a = Array { unArray :: SmallArray# a }\ndata MArray s a = MArray { unMArray :: SmallMutableArray# s a }\n\nnewArray :: Int -> a -> ST s (MArray s a)\nnewArray (I# n#) a = ST $ \\s# -> case newSmallArray# n# a s# of\n    (# s2#, marr# #) -> (# s2#, MArray marr# #)\n\nindexArray :: Array a -> Int -> a\nindexArray arr i@(I# i#)\n  | i < 0 || i >= len =\n      error $ \"bounds error, offset \" ++ show i ++ \", length \" ++ show len\n  | otherwise = case indexSmallArray# (unArray arr) i# of\n      (# a #) -> a\n  where len = lengthArray arr\n\nwriteArray :: MArray s a -> Int -> a -> ST s ()\nwriteArray marr i@(I# i#) a\n  | i < 0 || i >= len =\n      error $ \"bounds error, offset \" ++ show i ++ \", length \" ++ show len\n  | otherwise = ST $ \\ s# ->\n    case writeSmallArray# (unMArray marr) i# a s# of\n        s2# -> (# s2#, () #)\n  where len = lengthMArray marr\n\nlengthArray :: Array a -> Int\nlengthArray arr = I# (sizeofSmallArray# (unArray arr))\n\nlengthMArray :: MArray s a -> Int\nlengthMArray marr = I# (sizeofSmallMutableArray# (unMArray marr))\n\nunsafeFreezeArray :: MArray s a -> ST s (Array a)\nunsafeFreezeArray marr = ST $ \\ s# ->\n    case unsafeFreezeSmallArray# (unMArray marr) s# of\n        (# s2#, arr# #) -> (# s2#, Array arr# #)\n\ncopyArray :: Array a -> Int -> MArray s a -> Int -> Int -> ST s ()\ncopyArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \\ s# ->\n    case copySmallArray# (unArray src) six# (unMArray dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncopyMutableArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()\ncopyMutableArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \\ s# ->\n    case copySmallMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncloneArray :: Array a -> Int -> Int -> Array a\ncloneArray src (I# six#) (I# n#) = Array (cloneSmallArray# (unArray src) six# n#)\n{-# INLINE cloneArray #-}  -- to make sure optimization triggers\n\ncloneMutableArray :: MArray s a -> Int -> Int -> ST s (MArray s a)\ncloneMutableArray src (I# six#) (I# n#) = ST $ \\ s# ->\n    case cloneSmallMutableArray# (unMArray src) six# n# s# of\n        (# s2#, marr# #) -> (# s2#, MArray marr# #)\n{-# INLINE cloneMutableArray #-}  -- to make sure optimization triggers\n\nfreezeArray :: MArray s a -> Int -> Int -> ST s (Array a)\nfreezeArray src (I# six#) (I# n#) = ST $ \\ s# ->\n    case freezeSmallArray# (unMArray src) six# n# s# of\n        (# s2#, arr# #) -> (# s2#, Array arr# #)\n{-# INLINE freezeArray #-}  -- to make sure optimization triggers\n\nthawArray :: Array a -> Int -> Int -> ST s (MArray s a)\nthawArray src (I# six#) (I# n#) = ST $ \\ s# ->\n    case thawSmallArray# (unArray src) six# n# s# of\n        (# s2#, marr# #) -> (# s2#, MArray marr# #)\n{-# INLINE thawArray #-}  -- to make sure optimization triggers\n\ntoList :: Array a -> Int -> [a]\ntoList arr n = go 0\n  where\n    go i | i >= n = []\n         | otherwise = indexArray arr i : go (i+1)\n", "num_lines": 301}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, MagicHash,\n             UnboxedTuples #-}\n\n-- !!! stress tests of copying/cloning primitive arrays\n\n-- Note: You can run this test manually with an argument (i.e.\n-- ./CopySmallArrayStressTest 10000) if you want to run the stress\n-- test for longer.\n\n{-\nTest strategy\n=============\n\nWe create an array of arrays of integers. Repeatedly we then either\n\n* allocate a new array in place of an old, or\n\n* copy a random segment of an array into another array (which might be\n  the source array).\n\nBy running this process long enough we hope to trigger any bugs\nrelated to garbage collection or edge cases.\n\nWe only test copySmallMutableArray# and cloneSmallArray# as they are\nrepresentative of all the primops.\n-}\n\nmodule Main ( main ) where\n\nimport Debug.Trace (trace)\n\nimport Control.Exception (assert)\nimport Control.Monad\nimport Control.Monad.Trans.State.Strict\nimport Control.Monad.Trans.Class\nimport GHC.Exts hiding (IsList(..))\nimport GHC.ST hiding (liftST)\nimport Prelude hiding (length, read)\nimport qualified Prelude as P\nimport qualified Prelude as P\nimport System.Environment\nimport System.Random\n\nmain :: IO ()\nmain = do\n    args <- getArgs\n    -- Number of copies to perform\n    let numMods = case args of\n            [] -> 100\n            [n] -> P.read n :: Int\n    putStr (test_copyMutableArray numMods ++ \"\\n\" ++\n            test_cloneMutableArray numMods ++ \"\\n\"\n           )\n\n-- Number of arrays\nnumArrays :: Int\nnumArrays = 100\n\n-- Maxmimum length of a sub-array\nmaxLen :: Int\nmaxLen = 1024\n\n-- Create an array of arrays, with each sub-array having random length\n-- and content.\nsetup :: Rng s (MArray s (MArray s Int))\nsetup = do\n    len <- rnd (1, numArrays)\n    marr <- liftST $ new_ len\n    let go i\n            | i >= len = return ()\n            | otherwise = do\n                n <- rnd (1, maxLen)\n                subarr <- liftST $ fromList [j*j | j <- [(0::Int)..n-1]]\n                liftST $ write marr i subarr\n                go (i+1)\n    go 0\n    return marr\n\n-- Replace one of the sub-arrays with a newly allocated array.\nallocate :: MArray s (MArray s Int) -> Rng s ()\nallocate marr = do\n    ix <- rnd (0, length marr - 1)\n    n <- rnd (1, maxLen)\n    subarr <- liftST $ fromList [j*j | j <- [(0::Int)..n-1]]\n    liftST $ write marr ix subarr\n\ntype CopyFunction s a =\n    MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()\n\n-- Copy a random segment of an array onto another array, using the\n-- supplied copy function.\ncopy :: MArray s (MArray s a) -> CopyFunction s a\n     -> Rng s (Int, Int, Int, Int, Int)\ncopy marr f = do\n    six <- rnd (0, length marr - 1)\n    dix <- rnd (0, length marr - 1)\n    src <- liftST $ read marr six\n    dst <- liftST $ read marr dix\n    let srcLen = length src\n    srcOff <- rnd (0, srcLen - 1)\n    let dstLen = length dst\n    dstOff <- rnd (0, dstLen - 1)\n    n <- rnd (0, min (srcLen - srcOff) (dstLen - dstOff))\n    liftST $ f src srcOff dst dstOff n\n    return (six, dix, srcOff, dstOff, n)\n\ntype CloneFunction s a = MArray s a -> Int -> Int -> ST s (MArray s a)\n\n-- Clone a random segment of an array, replacing another array, using\n-- the supplied clone function.\nclone :: MArray s (MArray s a) -> CloneFunction s a\n      -> Rng s (Int, Int, Int, Int)\nclone marr f = do\n    six <- rnd (0, length marr - 1)\n    dix <- rnd (0, length marr - 1)\n    src <- liftST $ read marr six\n    let srcLen = length src\n    -- N.B. The array length might be zero if we previously cloned\n    -- zero elements from some array.\n    srcOff <- rnd (0, max 0 (srcLen - 1))\n    n <- rnd (0, srcLen - srcOff)\n    dst <- liftST $ f src srcOff n\n    liftST $ write marr dix dst\n    return (six, dix, srcOff, n)\n\n------------------------------------------------------------------------\n-- copySmallMutableArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_copyMutableArray :: Int -> String\ntest_copyMutableArray numMods = runST $ run $ do\n    marr <- local setup\n    marrRef <- setup\n    let go i\n            | i >= numMods = return \"test_copyMutableArray: OK\"\n            | otherwise = do\n                -- Either allocate or copy\n                alloc <- rnd (True, False)\n                if alloc then doAlloc else doCopy\n                go (i+1)\n\n        doAlloc = do\n            local $ allocate marr\n            allocate marrRef\n\n        doCopy = do\n            inp <- liftST $ asList marr\n            _ <- local $ copy marr copyMArray\n            (six, dix, srcOff, dstOff, n) <- copy marrRef copyMArraySlow\n            el <- liftST $ asList marr\n            elRef <- liftST $ asList marrRef\n            when (el /= elRef) $\n                fail inp el elRef six dix srcOff dstOff n\n    go 0\n  where\n    fail inp el elRef six dix srcOff dstOff n =\n        error $ \"test_copyMutableArray: FAIL\\n\"\n        ++ \"   Input: \" ++ unlinesShow inp\n        ++ \"    Copy: six: \" ++ show six ++ \" dix: \" ++ show dix ++ \" srcOff: \"\n        ++ show srcOff ++ \" dstOff: \" ++ show dstOff ++ \" n: \" ++ show n ++ \"\\n\"\n        ++ \"Expected: \" ++ unlinesShow elRef\n        ++ \"  Actual: \" ++ unlinesShow el\n\nasList :: MArray s (MArray s a) -> ST s [[a]]\nasList marr = toListM =<< mapArrayM toListM marr\n\nunlinesShow :: Show a => [a] -> String\nunlinesShow =  concatMap (\\ x -> show x ++ \"\\n\")\n\n------------------------------------------------------------------------\n-- cloneSmallMutableArray#\n\n-- Copy a slice of the source array into a destination array and check\n-- that the copy succeeded.\ntest_cloneMutableArray :: Int -> String\ntest_cloneMutableArray numMods = runST $ run $ do\n    marr <- local setup\n    marrRef <- setup\n    let go i\n            | i >= numMods = return \"test_cloneMutableArray: OK\"\n            | otherwise = do\n                -- Either allocate or clone\n                alloc <- rnd (True, False)\n                if alloc then doAlloc else doClone\n                go (i+1)\n\n        doAlloc = do\n            local $ allocate marr\n            allocate marrRef\n\n        doClone = do\n            inp <- liftST $ asList marr\n            _ <- local $ clone marr cloneMArray\n            (six, dix, srcOff, n) <- clone marrRef cloneMArraySlow\n            el <- liftST $ asList marr\n            elRef <- liftST $ asList marrRef\n            when (el /= elRef) $\n                fail inp el elRef six dix srcOff n\n    go 0\n  where\n    fail inp el elRef six dix srcOff n =\n        error $ \"test_cloneMutableArray: FAIL\\n\"\n        ++ \"   Input: \" ++ unlinesShow inp\n        ++ \"   Clone: six: \" ++ show six ++ \" dix: \" ++ show dix ++ \" srcOff: \"\n        ++ show srcOff ++ \" n: \" ++ show n ++ \"\\n\"\n        ++ \"Expected: \" ++ unlinesShow elRef\n        ++ \"  Actual: \" ++ unlinesShow el\n\n------------------------------------------------------------------------\n-- Convenience wrappers for SmallArray# and SmallMutableArray#\n\ndata Array a = Array\n    { unArray :: SmallArray# a\n    , lengthA :: {-# UNPACK #-} !Int}\n\ndata MArray s a = MArray\n    { unMArray :: SmallMutableArray# s a\n    , lengthM :: {-# UNPACK #-} !Int}\n\nclass IArray a where\n    length :: a -> Int\ninstance IArray (Array a) where\n    length = lengthA\ninstance IArray (MArray s a) where\n    length = lengthM\n\ninstance Eq a => Eq (Array a) where\n    arr1 == arr2 = toList arr1 == toList arr2\n\nnew :: Int -> a -> ST s (MArray s a)\nnew n@(I# n#) a =\n    assert (n >= 0) $\n    ST $ \\s# -> case newSmallArray# n# a s# of\n        (# s2#, marr# #) -> (# s2#, MArray marr# n #)\n\nnew_ :: Int -> ST s (MArray s a)\nnew_ n = new n (error \"Undefined element\")\n\nwrite :: MArray s a -> Int -> a -> ST s ()\nwrite marr i@(I# i#) a =\n    assert (i >= 0) $\n    assert (i < length marr) $\n    ST $ \\ s# ->\n    case writeSmallArray# (unMArray marr) i# a s# of\n        s2# -> (# s2#, () #)\n\nread :: MArray s a -> Int -> ST s a\nread marr i@(I# i#) =\n    assert (i >= 0) $\n    assert (i < length marr) $\n    ST $ \\ s# ->\n    readSmallArray# (unMArray marr) i# s#\n\nindex :: Array a -> Int -> a\nindex arr i@(I# i#) =\n    assert (i >= 0) $\n    assert (i < length arr) $\n    case indexSmallArray# (unArray arr) i# of\n        (# a #) -> a\n\nunsafeFreeze :: MArray s a -> ST s (Array a)\nunsafeFreeze marr = ST $ \\ s# ->\n    case unsafeFreezeSmallArray# (unMArray marr) s# of\n        (# s2#, arr# #) -> (# s2#, Array arr# (length marr) #)\n\ntoList :: Array a -> [a]\ntoList arr = go 0\n  where\n    go i | i >= length arr = []\n         | otherwise = index arr i : go (i+1)\n\nfromList :: [e] -> ST s (MArray s e)\nfromList es = do\n    marr <- new_ n\n    let go !_ [] = return ()\n        go i (x:xs) = write marr i x >> go (i+1) xs\n    go 0 es\n    return marr\n  where\n    n = P.length es\n\nmapArrayM :: (a -> ST s b) -> MArray s a -> ST s (MArray s b)\nmapArrayM f src = do\n    dst <- new_ n\n    let go i\n            | i >= n = return dst\n            | otherwise = do\n                el <- read src i\n                el' <- f el\n                write dst i el'\n                go (i+1)\n    go 0\n  where\n    n = length src\n\ntoListM :: MArray s e -> ST s [e]\ntoListM marr =\n    sequence [read marr i | i <- [0..(length marr)-1]]\n\n------------------------------------------------------------------------\n-- Wrappers around copy/clone primops\n\ncopyMArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()\ncopyMArray src six@(I# six#) dst dix@(I# dix#) n@(I# n#) =\n    assert (six >= 0) $\n    assert (six + n <= length src) $\n    assert (dix >= 0) $\n    assert (dix + n <= length dst) $\n    ST $ \\ s# ->\n    case copySmallMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of\n        s2# -> (# s2#, () #)\n\ncloneMArray :: MArray s a -> Int -> Int -> ST s (MArray s a)\ncloneMArray marr off@(I# off#) n@(I# n#) =\n    assert (off >= 0) $\n    assert (off + n <= length marr) $\n    ST $ \\ s# ->\n    case cloneSmallMutableArray# (unMArray marr) off# n# s# of\n        (# s2#, marr2 #) -> (# s2#, MArray marr2 n #)\n\n------------------------------------------------------------------------\n-- Manual versions of copy/clone primops.  Used to validate the\n-- primops\n\ncopyMArraySlow :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()\ncopyMArraySlow !src !six !dst !dix n =\n    assert (six >= 0) $\n    assert (six + n <= length src) $\n    assert (dix >= 0) $\n    assert (dix + n <= length dst) $\n       if six < dix\n       then goB (six+n-1) (dix+n-1) 0  -- Copy backwards\n       else goF six dix 0  -- Copy forwards\n  where\n    goF !i !j c\n        | c >= n = return ()\n        | otherwise = do b <- read src i\n                         write dst j b\n                         goF (i+1) (j+1) (c+1)\n    goB !i !j c\n        | c >= n = return ()\n        | otherwise = do b <- read src i\n                         write dst j b\n                         goB (i-1) (j-1) (c+1)\n\ncloneMArraySlow :: MArray s a -> Int -> Int -> ST s (MArray s a)\ncloneMArraySlow !marr !off n =\n    assert (off >= 0) $\n    assert (off + n <= length marr) $ do\n        marr2 <- new_ n\n        let go !i !j c\n                | c >= n = return marr2\n                | otherwise = do\n                    b <- read marr i\n                    write marr2 j b\n                    go (i+1) (j+1) (c+1)\n        go off 0 0\n\n------------------------------------------------------------------------\n-- Utilities for simplifying RNG passing\n\nnewtype Rng s a = Rng { unRng :: StateT StdGen (ST s) a }\n                deriving (Functor, Applicative, Monad)\n\n-- Same as 'randomR', but using the RNG state kept in the 'Rng' monad.\nrnd :: Random a => (a, a) -> Rng s a\nrnd r = Rng $ do\n    g <- get\n    let (x, g') = randomR r g\n    put g'\n    return x\n\n-- Run a sub-computation without affecting the RNG state.\nlocal :: Rng s a -> Rng s a\nlocal m = Rng $ do\n    g <- get\n    x <- unRng m\n    put g\n    return x\n\nliftST :: ST s a -> Rng s a\nliftST m = Rng $ lift m\n\nrun :: Rng s a -> ST s a\nrun = flip evalStateT (mkStdGen 13) . unRng\n\n", "num_lines": 388}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash,GHCForeignImportPrim,UnliftedFFITypes #-}\nmodule Main where\n\nimport GHC.Exts\n\nforeign import prim \"do_popcnt32\" popcnt32 :: Int# -> Int#\n\nmain = print (I# (popcnt32 0xffff#))\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Main ( main ) where\n\nimport GHC.Base\n\ndata BA = BA ByteArray#\n\n-- Checks that setByteArray# works\nmain :: IO ()\nmain = do BA ba <- IO $ \\s0 ->\n                        case newByteArray# 8# s0 of\n                        (# !s1, !mba #) ->\n                            case setByteArray# mba 0# 8# 65# s1 of\n                            !s2 ->\n                                case setByteArray# mba 1# 6# 67# s2 of\n                                !s3 ->\n                                    case unsafeFreezeByteArray# mba s3 of\n                                    (# s4, ba #) -> (# s4, BA ba #)\n          let f (I# i) = putStrLn [C# (indexCharArray# ba i)]\n          mapM_ f [0..7]\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule Main ( main ) where\n\nimport GHC.Exts\nimport GHC.Prim\nimport GHC.ST\n\nmain = putStr\n       (test_sizeofArray\n        ++ \"\\n\" ++ test_sizeofMutableArray\n        ++ \"\\n\"\n       )\n\ntest_sizeofArray :: String\ntest_sizeofArray = flip shows \"\\n\" $ runST $ ST $ \\ s# -> go 0 [] s#\n  where\n    go i@(I# i#) acc s#\n        | i < 1000 = case newSmallArray# i# 0 s# of\n            (# s2#, marr# #) -> case unsafeFreezeSmallArray# marr# s2# of\n                (# s3#, arr# #) -> case sizeofSmallArray# arr# of\n                    j# -> go (i+1) ((I# j#):acc) s3#\n        | otherwise = (# s#, reverse acc #)\n\ntest_sizeofMutableArray :: String\ntest_sizeofMutableArray = flip shows \"\\n\" $ runST $ ST $ \\ s# -> go 0 [] s#\n  where\n    go i@(I# i#) acc s#\n        | i < 1000 = case newSmallArray# i# 0 s# of\n            (# s2#, marr# #) -> case sizeofSmallMutableArray# marr# of\n                    j# -> go (i+1) ((I# j#):acc) s2#\n        | otherwise = (# s#, reverse acc #)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}\n\n-- Test allocation of statically sized arrays. There's an optimization\n-- that targets these and we want to make sure that the code generated\n-- in the optimized case is correct.\n--\n-- The tests proceeds by allocating a bunch of arrays of different\n-- sizes and reading elements from them, to try to provoke GC crashes,\n-- which would be a symptom of the optimization not generating correct\n-- code.\nmodule Main where\n\nimport Control.Monad\nimport GHC.Exts\nimport GHC.IO\nimport Prelude hiding (read)\n\nmain :: IO ()\nmain = do\n    loop 1000\n    putStrLn \"success\"\n  where\n    loop :: Int -> IO ()\n    loop 0 = return ()\n    loop i = do\n        -- Sizes have been picked to match the triggering of the\n        -- optimization and to match boundary conditions. Sizes are\n        -- given explicitly as to not rely on other optimizations to\n        -- make the static size known to the compiler.\n        marr0 <- newArray 0\n        marr1 <- newArray 1\n        marr2 <- newArray 2\n        marr3 <- newArray 3\n        marr4 <- newArray 4\n        marr5 <- newArray 5\n        marr6 <- newArray 6\n        marr7 <- newArray 7\n        marr8 <- newArray 8\n        marr9 <- newArray 9\n        marr10 <- newArray 10\n        marr11 <- newArray 11\n        marr12 <- newArray 12\n        marr13 <- newArray 13\n        marr14 <- newArray 14\n        marr15 <- newArray 15\n        marr16 <- newArray 16\n        marr17 <- newArray 17\n        let marrs = [marr0, marr1, marr2, marr3, marr4, marr5, marr6, marr7,\n                     marr8, marr9, marr10, marr11, marr12, marr13, marr14,\n                     marr15, marr16, marr17]\n        total <- sumManyArrays marrs\n        unless (total == 153) $\n            putStrLn \"incorrect sum\"\n        loop (i-1)\n\nsumManyArrays :: [MArray] -> IO Int\nsumManyArrays = go 0\n  where\n    go !acc [] = return acc\n    go acc (marr:marrs) = do\n        n <- sumArray marr\n        go (acc+n) marrs\n\nsumArray :: MArray -> IO Int\nsumArray marr = go 0 0\n  where\n    go :: Int -> Int -> IO Int\n    go !acc i\n      | i < len = do\n          k <- read marr i\n          go (acc + k) (i+1)\n      | otherwise = return acc\n    len = lengthM marr\n\ndata MArray = MArray { unMArray :: !(MutableArray# RealWorld Int) }\n\nnewArray :: Int -> IO MArray\nnewArray (I# sz#) = IO $ \\s -> case newArray# sz# 1 s of\n    (# s', marr #) -> (# s', MArray marr #)\n{-# INLINE newArray #-}  -- to make sure optimization triggers\n\nlengthM :: MArray -> Int\nlengthM marr = I# (sizeofMutableArray# (unMArray marr))\n\nread :: MArray -> Int -> IO Int\nread marr i@(I# i#)\n  | i < 0 || i >= len =\n      error $ \"bounds error, offset \" ++ show i ++ \", length \" ++ show len\n  | otherwise = IO $ \\ s -> readArray# (unMArray marr) i# s\n  where len = lengthM marr\n", "num_lines": 91}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\n-- Test allocation of statically sized byte arrays. There's an\n-- optimization that targets these and we want to make sure that the\n-- code generated in the optimized case is correct.\n--\n-- The tests proceeds by allocating a bunch of byte arrays of\n-- different sizes, to try to provoke GC crashes, which would be a\n-- symptom of the optimization not generating correct code.\nmodule Main where\n\nimport GHC.Exts\nimport GHC.IO\n\nmain :: IO ()\nmain = do\n    loop 1000\n    putStrLn \"success\"\n  where\n    loop :: Int -> IO ()\n    loop 0 = return ()\n    loop i = do\n        -- Sizes have been picked to match the triggering of the\n        -- optimization and to match boundary conditions. Sizes are\n        -- given explicitly as to not rely on other optimizations to\n        -- make the static size known to the compiler.\n        newByteArray 0\n        newByteArray 1\n        newByteArray 2\n        newByteArray 3\n        newByteArray 4\n        newByteArray 5\n        newByteArray 6\n        newByteArray 7\n        newByteArray 8\n        newByteArray 9\n        newByteArray 10\n        newByteArray 11\n        newByteArray 12\n        newByteArray 13\n        newByteArray 14\n        newByteArray 15\n        newByteArray 16\n        newByteArray 64\n        newByteArray 128\n        newByteArray 129\n        loop (i-1)\n\nnewByteArray :: Int -> IO ()\nnewByteArray (I# sz#) = IO $ \\s -> case newByteArray# sz# s of\n    (# s', _ #) -> (# s', () #)\n{-# INLINE newByteArray #-}  -- to make sure optimization triggers\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n#include \"MachDeps.h\"\n\nf :: Int -> String\nf n = case n of\n#if WORD_SIZE_IN_BITS == 64\n  0x8000000000000000 -> \"yes\"\n#else\n  0x80000000 -> \"yes\"\n#endif\n  _ -> \"no\"\n{-# NOINLINE f #-}\n\nmain = do\n#if WORD_SIZE_IN_BITS == 64\n    let string = \"0x8000000000000000\"\n#else\n    let string = \"0x80000000\"\n#endif\n    let i = read string :: Integer\n    let i' = fromIntegral i :: Int\n    print i\n    print i'\n    print (f i')\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f1 :: Int -> String\nf1 n = case n of\n  0 -> \"bar\"\n  0x10000000000000000 -> \"foo\"\n  _ -> \"c\"\n{-# NOINLINE f1 #-}\n\ng1 :: Int -> String\ng1 n = if n == 0 then \"bar\" else\n       if n == 0x10000000000000000 then  \"foo\" else\n       \"c\"\n{-# NOINLINE g1 #-}\n\nf2 :: Int -> String\nf2 n = case n of\n  0x10000000000000000 -> \"foo\"\n  0 -> \"bar\"\n  _ -> \"c\"\n{-# NOINLINE f2 #-}\n\ng2 :: Int -> String\ng2 n = if n == 0x10000000000000000 then  \"foo\" else\n       if n == 0 then \"bar\" else\n       \"c\"\n{-# NOINLINE g2 #-}\n\nmain = do\n    let i = read \"0\" :: Int\n    print (f1 i)\n    print (g1 i)\n    print (f2 i)\n    print (g2 i)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nimport GHC.Exts\nnewtype Eval a = Eval {runEval :: State# RealWorld -> (# State# RealWorld, a #)}\n\n-- inline sequence ::  [Eval a] -> Eval [a]\nwell_sequenced ::  [Eval a] -> Eval [a]\nwell_sequenced = foldr cons nil where\n  cons e es = Eval $ \\s -> case runEval e s of\n                       (# s', a #) -> case runEval es s' of\n                         (# s'', as #) -> (# s'', a : as #)\n  nil = Eval $ \\s -> (# s, [] #)\n\n-- seemingly demonic use of spark#\nill_sequenced ::  [Eval a] -> Eval [a]\nill_sequenced  as = Eval $ spark# (case well_sequenced as of\n             Eval f -> case f realWorld# of  (# _, a' #) -> a')\n\n-- 'parallelized' version of (show >=> show >=> show >=> show >=> show)\nmain :: IO ()\nmain = putStrLn ((layer . layer . layer . layer . layer) (:[]) 'y')\n  where\n  layer :: (Char -> String) -> (Char -> String)\n  layer f = (\\(Eval x) -> case x realWorld# of (# _, as #) -> concat as)\n        . well_sequenced    -- [Eval String] -> Eval [String]\n        . map ill_sequenced -- [[Eval Char]] -> [Eval String];\n                            -- 'map well_sequenced' is fine\n        . map (map (\\x -> Eval $ \\s -> (# s, x #))) -- wrap each Char in Eval\n        . chunk'            -- String -> [String]\n        . concatMap f\n        . show              -- add single quotes\n\n  chunk' ::  String -> [String]\n  chunk' [] = []\n  chunk' xs =  as : chunk' bs where (as,bs) = splitAt 3 xs\n\n  -- this doesn't work:\n  -- chunk (a:b:c:xs) = [a,b,c]:chunk xs\n  -- chunk xs = [xs]\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Word( Word8 )\n\ntoV :: Float -> Word8\ntoV d = let coeff = significand d *  255.9999 / d\n            a = truncate $ d * coeff\n            b = exponent d\n        in a `seq` (b `seq` a)\n\nmain :: IO ()\nmain =\n  print $ map toV [ 3.56158e-2, 0.7415215, 0.5383201, 0.1289829, 0.45520145 ]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\n\nf :: Float# -> Float#\nf x = x\n{-# NOINLINE f #-}\n\ng :: Double# -> Double#\ng x = x\n{-# NOINLINE g #-}\n\nh :: Float -> Float\nh (F# x) = let a = F# (f x)\n               b = D# (g (2.0##))\n           in a `seq` (b `seq` a)\n\nmain = print (h 1.0)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Bits\nimport Data.Int\nimport Data.Word\n\nunsafeShift32R :: (Bits a, Num a) => a -> a\nunsafeShift32R x = unsafeShiftR x 32\n\nmain :: IO ()\nmain = do\n    print $ map unsafeShift32R [ 123456, 0x7fffffff :: Int ]\n    print $ map unsafeShift32R [ -123456, -0x80000000 :: Int ]\n    print $ map unsafeShift32R [ 123456, 0xffffffff :: Word ]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n-- Test the function of the isPinnedByteArray# primop\n\nimport GHC.Exts\nimport GHC.IO\n\nmain :: IO ()\nmain = do\n    -- Unpinned MutableByteArray\n    r <- IO $ \\s0 ->\n      case newByteArray# 1024# s0 of\n        (# s1, mba #) ->\n           (# s1, isTrue# (isMutableByteArrayPinned# mba) #)\n    print r\n\n    -- Pinned MutableByteArray\n    r <- IO $ \\s0 ->\n      case newPinnedByteArray# 1024# s0 of\n        (# s1, mba #) ->\n           (# s1, isTrue# (isMutableByteArrayPinned# mba) #)\n    print r\n\n    -- Pinned, Aligned MutableByteArray\n    r <- IO $ \\s0 ->\n      case newAlignedPinnedByteArray# 1024# 16# s0 of\n        (# s1, mba #) ->\n           (# s1, isTrue# (isMutableByteArrayPinned# mba) #)\n    print r\n\n    -- Unpinned ByteArray\n    r <- IO $ \\s0 ->\n      case newByteArray# 1024# s0 of\n        (# s1, mba #) ->\n          case unsafeFreezeByteArray# mba s1 of\n             (# s2, ba #) ->\n                (# s2, isTrue# (isByteArrayPinned# ba) #)\n    print r\n\n    -- Pinned ByteArray\n    r <- IO $ \\s0 ->\n      case newPinnedByteArray# 1024# s0 of\n        (# s1, mba #) ->\n          case unsafeFreezeByteArray# mba s1 of\n             (# s2, ba #) ->\n                (# s2, isTrue# (isByteArrayPinned# ba) #)\n    print r\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f :: Int -> IO ()\nf p = case p of\n  0 -> return ()\n  1 -> return ()\n  2 -> return ()\n  3 -> return ()\n  4 -> return ()\n  10 -> return ()\n  11 -> return ()\n  _ -> print p\n{-# NOINLINE f #-}\n\nmain = f 8\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that static pointers still work when the users try\n-- to unpack StaticPtr fields.\n{-# LANGUAGE StaticPointers #-}\n{-# LANGUAGE LambdaCase #-}\n\nimport GHC.StaticPtr\nimport T12622_A\n\ng = True\n\nmain :: IO ()\nmain = do\n  let T s = sg :: T (Bool -> Bool)\n  lookupKey s >>= \\f -> print (f True)\n\nlookupKey :: StaticPtr a -> IO a\nlookupKey p = unsafeLookupStaticPtr (staticKey p) >>= \\case\n  Just p -> return $ deRefStaticPtr p\n  Nothing -> error $ \"couldn't find \" ++ show (staticPtrInfo p)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A.hs\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE StaticPointers #-}\nmodule T12622_A where\n\nimport Data.Typeable\nimport GHC.StaticPtr\n\ng :: a -> Bool\ng _ = True\n\ndata T a = T {-# UNPACK #-} !(StaticPtr a)\n\nsg :: Typeable a => T (a -> Bool)\nsg = T (static g)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n\nmodule Main (main) where\n\nimport           Data.ByteString        (ByteString)\nimport qualified Data.ByteString        as B\n\nanswers :: [ByteString]\nanswers = map (B.filter (/= 0x20))\n    [ \"e3b0c442 98fc1c14 9afbf4c8 996fb924 27ae41e4 649b934c a495991b 7852b855\"\n    , \"d7a8fbb3 07d78094 69ca9abc b0082e4f 8d5651e4 6d3cdb76 2d02d0bf 37c9e592\"\n    , \"e4c4d8f3 bf76b692 de791a17 3e053211 50f7a345 b46484fe 427f6acc 7ecc81be\"\n    , \"ba7816bf 8f01cfea 414140de 5dae2223 b00361a3 96177a9c b410ff61 f20015ad\"\n    , \"248d6a61 d20638b8 e5c02693 0c3e6039 a33ce459 64ff2167 f6ecedd4 19db06c1\"\n    , \"cf5b16a7 78af8380 036ce59e 7b049237 0b249b11 e8f07a51 afac4503 7afee9d1\"\n    , \"cdc76e5c 9914fb92 81a1c7e2 84d73e67 f1809a48 a497200e 046d39cc c7112cd0\"\n    ]\n\nx, y :: ByteString\nx = \"e3b0c442 98fc1c14 9afbf4c8 996fb924 27ae41e4 649b934c a495991b 7852b855\"\ny = B.filter (/= 0x20) x\n\nmain :: IO ()\nmain = do\n    print (seq x ())\n    print (seq y ())\n    print (length answers)\n    print (seq (head answers) ()) -- segfault!\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- # OPTIONS_GHC -Wall -Werror #-}\nmodule Main (main) where\n\nimport qualified Data.ByteString as S\nimport qualified Data.ByteString.Char8 as S8\n\nmain :: IO ()\nmain = (S8.concat (map S.singleton (S.unpack (S8.pack \"<foo>\"))) == S8.empty) `seq` return ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Bits ((.&.))\n\nflags :: Int -> Int\nflags x\n  | x .&. 128 > 0 = 12\n  | otherwise = 13\n{-# NOINLINE flags #-}\n\nmain :: IO ()\nmain = print (flags 255)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport DynFlags\nimport RepType\nimport SMRep\nimport StgCmmLayout\nimport StgCmmClosure\nimport GHC\nimport GhcMonad\nimport System.Environment\nimport Platform\n\nmain :: IO ()\nmain = do\n    [libdir] <- getArgs\n    runGhc (Just libdir) tests\n\n\n-- How to read tests:\n--   F(a,8) = field a at offset 8\n--   P(4,8) = 4 bytes of padding at offset 8\ntests :: Ghc ()\ntests = do\n      (_, _, off) <- runTest [(\"a\", FloatRep), (\"b\", DoubleRep)]\n      assert_32_64 (map fmt off)\n          [\"F(a,4)\", \"F(b,8)\"]\n          [\"F(a,8)\", \"P(4,12)\", \"F(b,16)\"]\n\n      (_, _, off) <- runTest [(\"a\", FloatRep), (\"b\", FloatRep)]\n      assert_32_64 (map fmt off)\n          [\"F(a,4)\", \"F(b,8)\"]\n          [\"F(a,8)\", \"F(b,12)\"]\n\n      (_, _, off) <- runTest [(\"a\", FloatRep), (\"b\", FloatRep), (\"c\", FloatRep)]\n      assert_32_64 (map fmt off)\n          [\"F(a,4)\", \"F(b,8)\", \"F(c,12)\"]\n          [\"F(a,8)\", \"F(b,12)\", \"F(c,16)\", \"P(4,20)\"]\n\n      (_, _, off) <- runTest [(\"a\", FloatRep), (\"b\", FloatRep), (\"c\", Int64Rep)]\n      assert_32_64 (map fmt off)\n          [\"F(a,4)\", \"F(b,8)\", \"F(c,12)\"]\n          [\"F(a,8)\", \"F(b,12)\", \"F(c,16)\"]\n\n      (_, _, off) <- runTest [(\"a\", Int64Rep), (\"b\", FloatRep), (\"c\", FloatRep)]\n      assert_32_64 (map fmt off)\n          [\"F(a,4)\", \"F(b,12)\", \"F(c,16)\"]\n          [\"F(a,8)\", \"F(b,16)\", \"F(c,20)\"]\n\n      (_, _, off) <- runTest [(\"a\", Int64Rep), (\"b\", FloatRep), (\"c\", Int64Rep)]\n      assert_32_64 (map fmt off)\n          [\"F(a,4)\", \"F(b,12)\", \"F(c,16)\"]\n          [\"F(a,8)\", \"F(b,16)\", \"P(4,20)\", \"F(c,24)\"]\n\n\nassert_32_64 :: (Eq a, Show a) => a -> a -> a -> Ghc ()\nassert_32_64 actual expected32 expected64 = do\n    dflags <- getDynFlags\n    let\n      expected\n          | word_size == 4 = expected32\n          | word_size == 8 = expected64\n      word_size = wORD_SIZE dflags\n    case actual == expected of\n        True -> return ()\n        False ->\n            error $ \"Expected:\\n\" ++ show expected\n                 ++ \"\\nBut got:\\n\" ++ show actual\n\nrunTest :: [(a, PrimRep)] -> Ghc (WordOff , WordOff, [FieldOffOrPadding a])\nrunTest prim_reps = do\n    dflags <- getDynFlags\n    return $ mkVirtHeapOffsetsWithPadding dflags StdHeader (mkNonVoids prim_reps)\n  where\n    mkNonVoids = map (\\(a, prim_rep) -> NonVoid (prim_rep, a))\n\nfmt :: FieldOffOrPadding String -> String\nfmt (FieldOff (NonVoid id) off) = \"F(\" ++ id ++ \",\" ++ show off ++ \")\"\nfmt (Padding len off) = \"P(\" ++ show len ++ \",\" ++ show off ++ \")\"\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\nmodule Main where\n\nimport GHC.Exts\n\n{-# NOINLINE f #-}\nf :: (Int# -> Float# -> Double# -> Float# -> Double# -> String) -> String\nf g = g 3# 4.0# 5.0## 6.0# 6.9## ++ \" World!\"\n\n{-# NOINLINE p #-}\np :: Int# -> Float# -> Double# -> Float# -> Double# -> String\np i j k l m = \"Hello\"\n\n{-# NOINLINE q #-}\nq :: Int# -> Int# -> Float# -> Double# -> Float# -> Double# -> String\nq _ i j k l m = \"Hello \" ++ show (F# l) ++ \" \" ++ show (D# m)\n\n{-# NOINLINE r #-}\nr :: Int# -> Float# -> Double# -> Float# -> Double# -> String\nr i = let !(I# z) = length [I# 1# .. I# i] in \\j k l m -> p z j k l m\n  -- ghc won't eta-expand around the length, because it has unknown cost\n\nmain = do\n  putStrLn (f p)    -- fast call\n  putStrLn (f r)    -- slow call: function but wrong arity\n  let g = last [q 1#]\n  putStrLn (f g)    -- slow call: thunk\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\nimport Control.Monad\nimport Data.Word\nimport Foreign.Marshal.Alloc\nimport Foreign.Storable\nimport Numeric\nimport GHC.Ptr\n\nmain :: IO ()\nmain = do\n    replicateM_ 49 $ threadDelay 1\n    _ <- forkIO $ do\n       allocaBytes 4 $ \\p -> do\n         forever $ do\n           poke p (0xDEADBEEF :: Word32)\n           threadDelay 10\n           x <- peek p\n           unless (x == 0xDEADBEEF) $ putStrLn (showHex x \"\")\n    threadDelay 1000000\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O1 #-}\n\n{-\n  On windows some xmm registers are callee saved. This means\n  they can't be used as scratch registers before a call to C.\n\n  In #14619 this wasn't respected which lead to a wrong value\n  ending up in xmm6 and being returned in the final result.\n\n  This code compiles to a non trivial fp computation followed\n  by a call to sqrt at O1+. If xmm6 isn't properly handled it\n  will be used as a scratch register failing the test.\n\n  The original code used regular sqrt which on 8.2 generated\n  a C call in the backend. To imitate this behaviour on 8.4+\n  we force a call to a C function instead.\n-}\n\nmodule Main (main) where\n\n\n\nimport Prelude hiding((*>), (<*))\nimport Foreign.C\nimport Unsafe.Coerce\n\nforeign import ccall unsafe \"sqrt\" call_sqrt :: CDouble -> CDouble\n\ntype V3 = (Double, Double, Double)\n\nabsf :: V3 -> V3 -> Double\nabsf (x, y, z) (x', y', z') = x*x' +y*y'+z*z'\n\n\n{-# NOINLINE sphereIntersection #-}\nsphereIntersection :: V3 -> V3 -> (V3)\nsphereIntersection orig dir@(_, _, dirz)\n  | b < 0  = undefined\n  | t1   > 0  = dir\n  | t1   < 0  = orig\n  | otherwise = undefined\n    where b  = orig `absf` dir\n          sqrtDisc = realToFrac . call_sqrt $ CDouble b\n          t1 = b - sqrtDisc\n\nmain = print $ sphereIntersection (11, 22, 33) (44, 55, 66)\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Debug.Trace\n\nmain :: IO ()\nmain = print (alg 3 1)\n\nalg :: Word -> Word -> Word\nalg a b\n  | traceShow (a, b) False = undefined\n  | c < b = alg b c\n  | c > b = alg c b\n  | otherwise = c\n  where\n    c = a - b\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\nimport GHC.Prim\n\nmain :: IO ()\nmain = print (cmpT a T2)\n  where\n    {-# NOINLINE f #-}\n    f = T2\n    {-# NOINLINE a #-}\n    a = f\n\ndata T = T1 | T2 | T3 | T4 | T5 | T6 | T7 | T8 | T9\n\ncmpT a b\n    = case dataToTag# a of\n        a' -> case dataToTag# b of\n                b' ->\n                      if tagToEnum# (a' <# b') :: Bool then\n                          LT -- used to return this\n                      else\n                          if tagToEnum# (a' ==# b') :: Bool then\n                              EQ -- should return this\n                          else\n                              GT\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\nimport GHC.Prim\n\nmain :: IO ()\nmain = do\n    print (I# (dataToTag# a))  -- used to print 0, should print 1\n    print (I# (dataToTag# f))  -- used to print 1 correctly\n\n  where\n    {-# NOINLINE f #-}\n    f = T2\n    {-# NOINLINE a #-}\n    a = f\n\ndata T = T1 | T2\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified Data.Set as S\n\nmain = print $\n  let {-# noinline f #-}\n      f () = T2\n  in  S.fromList [f (), f ()]\n\ndata T = T1 | T2 | T3 | T4 | T5 | T6 | T7 | T8 | T9\n  deriving (Show, Read, Eq, Ord, Bounded, Enum)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule Main (enumFromCallbackCatch, consume, next, main) where\n\nimport Control.Monad\nimport Foreign\nimport GHC.ForeignPtr\nimport GHC.Base (realWorld#)\nimport Data.Word (Word8)\nimport Foreign.Storable (peek)\nimport GHC.IO\n\ndata ByteString = PS {-# UNPACK #-} !(ForeignPtr Word8) {-# UNPACK #-} !Int\n\ninstance Show ByteString where\n  showsPrec p ps r = showsPrec p (unpackAppendCharsStrict ps []) r\n\nunpackAppendCharsStrict :: ByteString -> [Char] -> [Char]\nunpackAppendCharsStrict (PS fp len) xs =\n    unsafeDupablePerformIO $ withForeignPtr fp $ \\base ->\n      loop (base `plusPtr` (-1)) (base `plusPtr` 960) xs\n  where\n    loop !sentinal !p acc\n      | p == sentinal = return acc\n      | otherwise     = do x <- peek p\n                           loop sentinal (p `plusPtr` (-1)) (w2c x:acc)\n\nw2c :: Word8 -> Char\nw2c = toEnum . fromEnum\n\npackCStringLen :: Int -> IO ByteString\npackCStringLen l = do\n  p <- callocBytes bufsize\n  fp <- newForeignPtr finalizerFree p\n  return $! PS fp l\n{-# NOINLINE packCStringLen #-}\n\nbufsize :: Int\nbufsize = 8192\n\n{-# NOINLINE readFromPtr #-}\nreadFromPtr :: IO ByteString\nreadFromPtr = do\n    bs <- packCStringLen bufsize\n    length (show bs) `seq` return bs\n\nnewtype Iteratee s = Iteratee { runIter :: forall r.\n          ((s -> Iteratee s) -> IO r) ->\n          IO r}\n\nenumFromCallbackCatch :: IO ()\nenumFromCallbackCatch = produce 500 consume\n  where\n    produce 0 (Iteratee f) = return ()\n    produce n (Iteratee f) = f onCont\n      where onCont k = do bs <- readFromPtr; produce (n-1) (k bs)\n\nconsume = Iteratee $ \\onCont -> onCont next\nnext x = Iteratee $ \\onCont -> print x >> onCont (\\_ -> consume)\n\nmain :: IO ()\nmain = do\n  _ <- enumFromCallbackCatch\n  pure ()\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -funbox-strict-fields #-}\nimport Data.List\n\ndata Vec4 = Vec4 !Float !Float !Float !Float\n\n\nmain :: IO ()\nmain = print traceList\n\ntraceList = concatMap (\\(x,y) -> let (r,g,b,a) = getPixel (x,y) in [r,g,b,a])\n    [(0,0)]\n    where\n    getPixel (x,y) = (red,green,blue,alpha)\n        where\n        Vec4 fr fg fb fa = seq x (Vec4 1 2 3 4)\n        red = round fr\n        green = round fg\n        blue = round fb\n        alpha = round fa\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\nmain = do [x] <- getArgs\n          print (read x < (1e400 :: Double))\n          print (read x < (-1e400 :: Double))\n          print (read x == (0/0 :: Double))\n          -- the last doesn't get constant-folded to NaN, so we're not really\n          -- testing properly here.  Still, we might manage to constant fold\n          -- this in the future, so I'll leave it in place.\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XMagicHash #-}\nmodule Main where\nimport GHC.Base\n\nimport Foreign\nimport Foreign.C\nimport GHC.Ptr (Ptr(..))\n\nutf8DecodeChar# :: Addr# -> Bool -> Bool\n{-# NOINLINE utf8DecodeChar# #-}\nutf8DecodeChar# a# fred =\n  case () of\n    _ | isTrue# (word2Int# (indexWord8OffAddr# a# 0#) <=# 0x7F#) -> True\n\n-- Omitting the next line gives an ASSERT error:\n-- ghc-6.9: panic! (the 'impossible' happened)\n--   (GHC version 6.9 for x86_64-unknown-linux):\n--      ASSERT failed! file nativeGen/MachCodeGen.hs line 1049\n-- %MO_S_Le_I8(I8[R2], 127 :: I8)\n      | fred -> True\n\n      | otherwise -> False\n\nmain = print (utf8DecodeChar# \"\\128\"# False) -- should be False\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nmodule Main(main,complement) where\n\nimport GHC.Base\nimport GHC.Num\n\ncomplement (I# x#) = I# (word2Int# (int2Word# (4294967295#) `xor#` int2Word# (-1#)))\n\nmain = print (complement (-1))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Monad.ST.Lazy\nimport Data.STRef.Lazy\nimport Data.Array.ST\nimport Data.Int\nimport Debug.Trace\n\ndata Refs s = Refs\n    { memory    :: STArray s Int8 Int8\n    , pc        :: STRef s Int8\n    }\n\nmain :: IO ()\nmain = do\n    print $ runST m\n  where\n    m = do\n      m <- newArray_ (0,30)\n      p <- newSTRef 0\n      let r = Refs m p\n      writeArray m 0 0x4\n      v <- readSTRef p\n      modifySTRef p (+1)\n--      trace (\"v: \" ++ show v) $ return ()\n      op <- readArray m v\n      case {- trace (\"v: \" ++ show v) $ -} op of\n          0x4 -> modifySTRef p (+100) -- should run this\n          n   -> error (\"should never match this: \" ++ show n)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print $ pqr' 0 1\n\npqr' :: Int -> Int -> Integer\npqr' a b | a == b - 1 = rab\n         | otherwise = ram * rmb\n    where m = (a + b) `div` 2\n          ram = pqr' a m\n          rmb = pqr' m b\n          rab = toInteger (6 * b - 5) * toInteger (2 * b - 1) *\n                toInteger (6 * b - 1)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\nmain = print (take 2 (edi2 0))\n\n-- In 6.12, edi2 lead to a stack overflow (see #3677)\n\nedi :: Integer -> [Integer]\nedi x | x `mod` 1000000 == 0 = x : edi (x+1)\n      | otherwise             = edi (x+1)\n\nedi2 :: Integer -> [Integer]\nedi2 x | x `mod` 1000000 == 0 = x : y\n       | otherwise             = y\n       where\n         y = edi2 (x+1)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Numeric\nimport System.IO\n\nmain = do\n let d = read \"2.0e-2\" :: Double\n print $ \"Float Version : \" ++ (fToStr $ realToFrac d)\n print $ \"Double Version: \" ++ (dToStr d)\n\ndouble :: IO Double\ndouble = do\n   x <- getLine\n   return $ read x\n\ndToStr :: Double -> String\ndToStr d = show d\n\nfToStr :: Float -> String\nfToStr = (dToStr . realToFrac)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nimport Control.Exception as E\nimport Data.Typeable\n\nthrowIfNegative :: Int -> String\nthrowIfNegative n | n < 0     = error \"negative\"\n                  | otherwise = \"no worries\"\n{-# NOINLINE throwIfNegative #-}\n\ndata HUnitFailure = HUnitFailure String deriving (Show,Typeable)\ninstance Exception HUnitFailure\n\nassertFailure :: String -> a -- Not an IO function!\nassertFailure msg = E.throw (HUnitFailure msg)\n\nmain :: IO ()\nmain =\n    handleJust errorCalls (const (return ())) (do\n        evaluate (throwIfNegative (-1)) -- Pure expression evaluated in IO\n        assertFailure \"must throw when given a negative number\")\n  where errorCalls (ErrorCall _) = Just ()\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash,GHCForeignImportPrim,UnliftedFFITypes #-}\nmodule Main where\n\nimport GHC.Exts\n\nforeign import prim \"f5149\" f :: Int# -> Int# -> Double# -> Int#\n\nmain = print (I# (f 1# 2# 1.0##))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nwrap x = [x]!!0\n\nf :: [Int] -> a\nf a = foldr (\\b -> \\c -> c) (undefined ()) (a ++ a) 0\n\nmain = do\n  print $ (f [] :: String)\n  print $ wrap $ (f [] :: Int)\n  print $ wrap $ (f [] :: (Int, Int, Int, Int))\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print (cos 0)\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Int\nimport Data.Word\n\n-- Test case for bug #5785. The cause of this was that the LLVM backend\n-- converted all Int constants using (fromInteger :: Int) and so on 32bit a\n-- Int64 or Word32 would be truncated to 32bit! value before printing out.\nmain :: IO ()\nmain = do\n    -- first two should print as big numbers (as unsigned)\n    print (-1 :: Word8)\n    print (-1 :: Word16)\n    print (-1 :: Word32)\n    print (-1 :: Word64)\n    print (-1 :: Int8)\n    print (-1 :: Int16)\n    print (-1 :: Int32)\n    print (-1 :: Int64)\n\n    -- only requires 32 bits (unsigned)\n    print (2316287658 :: Word8)\n    print (2316287658 :: Word16)\n    print (2316287658 :: Word32)\n    print (2316287658 :: Word64)\n    print (2316287658 :: Int8)\n    print (2316287658 :: Int16)\n    print (2316287658 :: Int32)\n    print (2316287658 :: Int64)\n\n    -- this requries a 64 (unsigned) bit word to store correctly\n    print (32342316287658 :: Word8)\n    print (32342316287658 :: Word16)\n    print (32342316287658 :: Word32)\n    print (32342316287658 :: Word64)\n    print (32342316287658 :: Int8)\n    print (32342316287658 :: Int16)\n    print (32342316287658 :: Int32)\n    print (32342316287658 :: Int64)\n\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Bits\nimport Data.Word\nimport Debug.Trace\n\nfl :: Word64 -> Word64 -> Word64\nfl fin sk =\n        let (x1, x2) = w64tow32 fin in\n        let (k1, k2) = w64tow32 sk in\n        let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in\n        let y1 = x1 `xor` (y2 .|. k2) in\n        trace (show fin ++ \" \" ++ show sk ++ \" -> \" ++ show (w32tow64 (y1, y2))) $ w32tow64 (y1, y2)\n\nw64tow32 :: Word64 -> (Word32, Word32)\nw64tow32 w = (fromIntegral (w `shiftR` 32), fromIntegral (w .&. 0xffffffff))\n\nw32tow64 :: (Word32, Word32) -> Word64\nw32tow64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)\n\na, b :: Word64\na = 1238988323332265734\nb = 11185553392205053542\n\nmain :: IO ()\nmain =\n    putStrLn $ \"fl \" ++ show a ++ \" \" ++ show b ++ \" -> \" ++ show (fl a b)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\nmodule Main where\n\nimport GHC.Exts\n\n{-# NOINLINE f #-}\nf :: (Int# -> Float# -> Double# -> String) -> String\nf g = g 3# 4.0# 6.9## ++ \" World!\"\n\n{-# NOINLINE p #-}\np :: Int# -> Float# -> Double# -> String\np i j k = \"Hello\"\n\n{-# NOINLINE q #-}\nq :: Int# -> Int# -> Float# -> Double# -> String\nq _ i j k = \"Hello\"\n\n{-# NOINLINE r #-}\nr :: Int# -> Float# -> Double# -> String\nr i = let !(I# z) = length [I# 1# .. I# i] in \\j k -> p z j k\n  -- ghc won't eta-expand around the length, because it has unknown cost\n\nmain = do\n  putStrLn (f p)    -- fast call\n  putStrLn (f r)    -- slow call: function but wrong arity\n  let g = last [q 1#]\n  putStrLn (f g)    -- slow call: thunk\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test #6146 (a bug in -feager-blackholing) I couldn't reliably\n-- reproduce it, but this program occasionally triggers it so it's\n-- better than nothing.\n\nmodule Main (main) where\n\nimport System.IO\nimport Control.Concurrent\nimport System.Mem\n\nmain :: IO ()\nmain = do\n    putStrLn \"First number?  \"\n    num1 <- readLn :: IO Int\n    performGC -- provokes bug (sometimes)\n    putStrLn \"Second number? \"\n    num2 <- readLn :: IO Int\n    let total = num1 + num2\n    putStrLn $ \"The sum is \" ++ (show total) ++ \".\"\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nmain :: IO ()\nmain = putStrLn $ printFloat 100\n\nprintFloat :: Float -> String\nprintFloat x = f (show (round (x * 10)))\n    where f \"0\" = \"0\"\n          f _   = show (round x)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash #-}\nimport Control.Exception\nimport System.Environment\nimport GHC.Exts\n\nmain = do\n  args <- getArgs\n  foo args\n\nfoo _ = let !e = toException (ErrorCall \"test\") in\n        raise# e\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nimport GHC.Exts\n\nmain = print $ map f [1,256,65536,minBound,maxBound]\n\nf (I# x#) =\n      [ I# (narrow8Int#  (narrow16Int# x#))\n      , I# (narrow8Int#  (narrow32Int# x#))\n      , I# (narrow16Int# (narrow8Int#  x#))\n      , I# (narrow16Int# (narrow32Int# x#))\n      , I# (narrow32Int# (narrow8Int#  x#))\n      , I# (narrow32Int# (narrow16Int# x#))]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Bug # 7600.\n-- The LLVM backend can be tricky to get right with floating point constants\n-- and GHC. See Note [LLVM Float Types] in compiler/llvmGen/Llvm/Types.hs for\n-- why this is.\n--\n-- Two issues to watch for (that this bug tries to track):\n--\n-- 1) We need to narrow a double to a float but then expand back out (so that\n-- we end up with the precision of a float but in double precision byte form).\n-- GHC seems to optimize this away for some ways of doing this.\n--\n-- 2) The 'realToFrac' method returns different results at the byte level\n-- depending on if optimisations are on or off. We use the double2float and\n-- float2Double methods instead as they don't suffer from this.\n-- \n-- Also worth looking at ticket # 3676 about issues with 'realToFrac'.\nmodule Main (main) where\n\nimport T7600_A\n\n-- a fp constant that requires double precision, but we only use a single\n-- precision type.\n-- expected output: float 0x7FF0000000000000\nfloat_number :: Float\nfloat_number = 1.82173691287639817263897126389712638972163e+300\n\n-- as above but use double precision so we can represent it.\n-- expected output: double 0x7E45C3163C1ACF96\ndouble_number :: Double\ndouble_number = 1.82173691287639817263897126389712638972163e+300\n\n-- Test run\nmain :: IO ()\nmain = test_run float_number double_number\n\n\n\n-- XXX: We don't run below, but it can be useful to test how the optimizer is\n-- running... the NOINLINE pragmas are needed below generally, but often not\n-- for Bug31_A as the constant is in a different module...\n\n-- -- Test run\n-- test_run' :: Float -> Double -> IO ()\n-- test_run' float_number double_number = do\n--     print $ dToStr double_number\n--     print $ dToStr (widen $ narrow double_number)\n--     print $ dToStr (widen' $ narrow' double_number)\n--     let dd = case double_number of { (D# x) -> x }\n--     print $ dToStr (D# (float2Double# (double2Float# dd)))\n--\n-- -- use standard Haskell functions for type conversion... which are kind of\n-- -- insane (see ticket # 3676) [these fail when -O0 is used...]\n-- {-# NOINLINE narrow #-}\n-- narrow :: Double -> Float\n-- narrow = realToFrac\n-- \n-- {-# NOINLINE widen #-}\n-- widen :: Float -> Double\n-- widen = realToFrac\n-- \n-- -- use GHC specific functions which work as expected [work for both -O0 and -O]\n-- {-# NOINLINE narrow' #-}\n-- narrow' :: Double -> Float\n-- narrow' = double2Float\n-- \n-- {-# NOINLINE widen' #-}\n-- widen' :: Float -> Double\n-- widen' = float2Double\n-- \n-- doubleToBytes :: Double -> [Int]\n-- doubleToBytes d\n--    = runST (do\n--         arr <- newArray_ ((0::Int),7)\n--         writeArray arr 0 d\n--         arr <- castDoubleToWord8Array arr\n--         i0 <- readArray arr 0\n--         i1 <- readArray arr 1\n--         i2 <- readArray arr 2\n--         i3 <- readArray arr 3\n--         i4 <- readArray arr 4\n--         i5 <- readArray arr 5\n--         i6 <- readArray arr 6\n--         i7 <- readArray arr 7\n--         return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])\n--      )\n-- \n-- castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)\n-- castFloatToWord8Array = castSTUArray\n-- \n-- castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)\n-- castDoubleToWord8Array = castSTUArray\n-- \n-- dToStr :: Double -> String\n-- dToStr d\n--   = let bs     = doubleToBytes d\n--         hex d' = case showHex d' \"\" of\n--                      []    -> error \"dToStr: too few hex digits for float\"\n--                      [x]   -> ['0',x]\n--                      [x,y] -> [x,y]\n--                      _     -> error \"dToStr: too many hex digits for float\"\n-- \n--         str  = map toUpper $ concat . fixEndian . (map hex) $ bs\n--     in  \"0x\" ++ str\n-- \n-- fixEndian :: [a] -> [a]\n-- -- #ifdef WORDS_BIGENDIAN\n-- -- fixEndian = id\n-- -- #else\n-- fixEndian = reverse\n-- -- #endif\n\n", "num_lines": 112}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Bug # 7600.\n-- See file T7600 for main description.\nmodule T7600_A (test_run) where\n\nimport Control.Monad.ST\nimport Data.Array.Unsafe( castSTUArray )\nimport Data.Array.ST hiding( castSTUArray )\nimport Data.Char\nimport Data.Word\nimport Numeric\n\nimport GHC.Float\n\n-- Test run\ntest_run :: Float -> Double -> IO ()\ntest_run float_number double_number = do\n    print $ dToStr double_number\n    -- XXX: Below is the bad code due to changing with optimisation.\n    -- print $ dToStr (widen $ narrow double_number)\n    print $ dToStr (widen' $ narrow' double_number)\n\n-- use standard Haskell functions for type conversion... which are kind of\n-- insane (see ticket # 3676) [these fail when -O0 is used...]\nnarrow :: Double -> Float\n{-# NOINLINE narrow #-}\nnarrow = realToFrac\n\nwiden :: Float -> Double\n{-# NOINLINE widen #-}\nwiden = realToFrac\n\n-- use GHC specific functions which work as expected [work for both -O0 and -O]\nnarrow' :: Double -> Float\n{-# NOINLINE narrow' #-}\nnarrow' = double2Float\n\nwiden' :: Float -> Double\n{-# NOINLINE widen' #-}\nwiden' = float2Double\n\ndoubleToWord64 :: Double -> Word64\ndoubleToWord64 d\n   = runST (do\n        arr <- newArray_ ((0::Int),0)\n        writeArray arr 0 d\n        arr <- castDoubleToWord64Array arr\n        readArray arr 0\n     )\n\ncastFloatToWord64Array :: STUArray s Int Float -> ST s (STUArray s Int Word64)\ncastFloatToWord64Array = castSTUArray\n\ncastDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)\ncastDoubleToWord64Array = castSTUArray\n\ndToStr :: Double -> String\ndToStr d\n  = let bs     = doubleToWord64 d\n        hex d' = showHex d' \"\"\n\n        str  = map toUpper $ hex bs\n    in  \"0x\" ++ str\n\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Control.Monad\nimport System.IO\nimport System.Random\n\nmain :: IO ()\nmain = do\n    hSetBuffering stdout NoBuffering\n    let q = fold $ zip [1..] (take 200 [500.0,400.0..])\n    print q\n    putStrLn \"Before atMost\"\n    let (xs,q') = atMost 0.5 q -- this causes seqfault with -O2\n    print xs\n    print q'\n    putStrLn \"After atMost\"\n\nfold :: [(Key, Prio)] -> PSQ\nfold []         = Void\nfold ((u,r):xs) = insert u r $ fold xs\n\ndata Elem = E\n    { _key   :: Key\n    , prio   :: Prio\n    } deriving (Eq, Show)\n\ntype Prio = Double\ntype Key = Int\n\ndata PSQ = Void\n           | Winner Elem Tree\n           deriving (Eq, Show)\n\nsingleton :: Key -> Prio -> PSQ\nsingleton k p = Winner (E k p) Start\n\ninsert :: Key -> Prio -> PSQ -> PSQ\ninsert k p q = case q of\n    Void -> singleton k p\n    Winner e t -> Winner (E k p) (Fork e Start t)\n\natMost :: Prio -> PSQ -> ([Elem], PSQ)\natMost pt q = case q of\n    (Winner e _)\n        | prio e > pt -> ([], q)\n    Void              -> ([], Void)\n    Winner e Start    -> ([e], Void)\n    Winner e (Fork e' tl tr) ->\n        let (sequ, q')   = atMost pt (Winner e' tl)\n            (sequ', q'') = atMost pt (Winner e tr)\n        in (sequ ++ sequ', q' `play` q'')\n\ndata Tree = Start\n          | Fork Elem Tree Tree\n    deriving (Eq, Show)\n\nlloser :: Key -> Prio -> Tree -> Tree -> Tree\nlloser k p tl tr = Fork (E k p) tl tr\n\nplay :: PSQ -> PSQ -> PSQ\nVoid `play` t' = t'\nt `play` Void  = t\nWinner e@(E k p) t `play` Winner e'@(E k' p') t'\n    | p <= p'   = Winner e  (lloser k' p' t t')\n    | otherwise = Winner e' (lloser k  p  t t')\n\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\nimport T8103_A\n\nfloat_text = case (0.0## `foo` 1.2##) of\n               0.0## -> \"1\"\n               _     -> \"0\"\nmain = putStrLn (float_text)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T8103_A where\nimport GHC.Exts\n\n{-# NOINLINE foo #-}\nfoo  :: Double# -> Double# -> Double#\nfoo a b = (a +## b)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples , ScopedTypeVariables #-}\n\nmodule Main where\n\n\nimport GHC.Prim\nimport GHC.Types\nimport Foreign\nimport Foreign.Ptr\nimport GHC.Ptr\n\nwrapFetch :: (a -> State# RealWorld -> State# RealWorld) -> (a -> IO ())\nwrapFetch prefetch  a = IO (\\ s -> (# prefetch a s, ()#))\n\n\n\n\n\n\n\nmain :: IO ()\nmain = do\n    (ptr :: Ptr Int) <- malloc\n    wrapFetch (\\ (Ptr adr)-> prefetchAddr3# adr 0# ) ptr\n    wrapFetch prefetchValue1# (1 ::Int)\n    wrapFetch prefetchValue2# \"hiiii\"\n    wrapFetch prefetchValue3# (Just \"testing\")\n    wrapFetch prefetchValue0# (error \"this shouldn't get evaluated\")\n    --  -- ^^ this is to make sure it doesn't force thunks!\n    --incontrast,\n    --wrapFetch prefetchValue0#  $! (error \"this shouldn't get evaluated\")\n    -- would trigger an exception\n    putStrLn \"success\"\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nnewtype FMList = FM {unFM :: forall m. m -> m}\n\nmain = print (delete 2000 (FM id) :: Int)\n\ndelete 0 _ = 0\ndelete n (FM a) = a $ delete (n-1) $ FM $ \\g -> a (const g) undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Prim\nimport GHC.Word\n\nbig :: Word\nbig = maxBound\n\ncarry :: Word\ncarry = case big of\n  W# w -> case plusWord2# w w of\n    (# hi, lo #) -> W# hi\n\nmain = print carry\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport Control.Monad\nimport Data.Bits\nimport GHC.Exts\nimport GHC.Word\nimport Numeric (showHex)\n\n-- Reference Implementation\n\n-- count trailing zeros\nctzRI :: FiniteBits a => a -> Word\nctzRI x = fromIntegral $ go 0\n  where\n    go i | i >= w      = i\n         | testBit x i = i\n         | otherwise   = go (i+1)\n\n    w = finiteBitSize x\n\n-- count leading zeros\nclzRI :: FiniteBits a => a -> Word\nclzRI x = fromIntegral $ (w-1) - go (w-1)\n  where\n    go i | i < 0       = i -- no bit set\n         | testBit x i = i\n         | otherwise   = go (i-1)\n\n    w = finiteBitSize x\n\nclzRI32, ctzRI32 :: Word -> Word\nclzRI32 x = clzRI (fromIntegral x :: Word32)\nctzRI32 x = ctzRI (fromIntegral x :: Word32)\n\nclzRI16, ctzRI16 :: Word -> Word\nclzRI16 x = clzRI (fromIntegral x :: Word16)\nctzRI16 x = ctzRI (fromIntegral x :: Word16)\n\nclzRI8, ctzRI8 :: Word -> Word\nclzRI8 x = clzRI (fromIntegral x :: Word8)\nctzRI8 x = ctzRI (fromIntegral x :: Word8)\n\n-- Implementation Under Test\nctzIUT, clzIUT :: Word -> Word\nctzIUT (W# x#) = W# (ctz# x#)\nclzIUT (W# x#) = W# (clz# x#)\n\nctzIUT8, clzIUT8 :: Word -> Word\nctzIUT8 (W# x#) = W# (ctz8# x#)\nclzIUT8 (W# x#) = W# (clz8# x#)\n\nctzIUT16, clzIUT16 :: Word -> Word\nctzIUT16 (W# x#) = W# (ctz16# x#)\nclzIUT16 (W# x#) = W# (clz16# x#)\n\nctzIUT32, clzIUT32 :: Word -> Word\nctzIUT32 (W# x#) = W# (ctz32# x#)\nclzIUT32 (W# x#) = W# (clz32# x#)\n\nctzIUT64, clzIUT64 :: Word64 -> Word\nctzIUT64 (W64# x#) = W# (ctz64# x#)\nclzIUT64 (W64# x#) = W# (clz64# x#)\n\nmain :: IO ()\nmain = do\n    forM_ testpats $ \\w64 -> do\n        let w = fromIntegral w64 :: Word\n\n        check \"clz\"   clzRI   clzIUT   w\n        check \"clz8\"  clzRI8  clzIUT8  w\n        check \"clz16\" clzRI16 clzIUT16 w\n        check \"clz32\" clzRI32 clzIUT32 w\n        check \"clz64\" clzRI   clzIUT64 w64\n\n        check \"ctz\"   ctzRI   ctzIUT   w\n        check \"ctz8\"  ctzRI8  ctzIUT8  w\n        check \"ctz16\" ctzRI16 ctzIUT16 w\n        check \"ctz32\" ctzRI32 ctzIUT32 w\n        check \"ctz64\" ctzRI   ctzIUT64 w64\n\n    putStrLn $ concat [\"tested \", show (length testpats), \" patterns\"]\n\n  where\n    -- try to construct some interesting patterns\n    testpats :: [Word64]\n    testpats = [ bit i - 1 | i <- [0..63] ] ++\n               [ complement (bit i - 1) | i <- [0..63] ] ++\n               [ bit i .|. bit j | i <- [0..63], j <- [0..i] ]\n\n    check s fri fiut v = unless (vri == viut) $ do\n        putStrLn $ concat [ \"FAILED \", s, \" for x=0x\", showHex v \"\"\n                          , \" (RI=\", show vri, \" IUT=\", show viut, \")\"\n                          ]\n      where\n        vri = fri v\n        viut = fiut v\n", "num_lines": 97}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Word\n\nx :: Word\nx = 10\n\ny :: Word\ny = 11\n\ntest = case x - y of\n         5 -> \"C\"\n         -1 -> \"A\"\n         _  -> \"B\"\nmain = putStrLn $ show test\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test case of known literal with wraparound\ntest = case 1 :: Int of\n         0x10000000000000001 -> \"A\"\n         _  -> \"B\"\ntest2 = case 0x10000000000000001 :: Int of\n         1 -> \"A\"\n         _  -> \"B\"\nmain = putStrLn $ test ++ test2\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Don't wrap literals that will be used at type Integer\nf :: Integer -> Int\nf n = case n of\n  0x100000000000000000000000 -> 1\n  0 -> 2\n  _ -> 3\n\nmain = print (f (read \"0\"))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport T9577_A\n\nimport GHC.Exts (Ptr(..), Addr#)\n\nmain = print (foo == Ptr \"foo\"#)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n\nmodule T9577_A where\n\nimport GHC.Exts (Ptr(..), Addr#)\n\nfoo = Ptr \"foo\"#\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main (main) where\n\nimport GHC.Exts (Double(D#), Float(F#), word2Double#, word2Float#)\n\nmain :: IO ()\nmain = do\n    print (D# (word2Double# 0##))\n    -- 4294967295 is 2^32 - 1, the largest 32-bit integer, and can be\n    -- stored in a 64-bit IEEE floating-point value without loss of\n    -- precision.\n    print (D# (word2Double# 4294967295##))\n    print (F# (word2Float# 0##))\n    -- 16777216 is 2^24, which is the largest integer which can be\n    -- stored in a 32-bit IEEE floating-point value without loss of\n    -- precision\n    print (F# (word2Float# 16777216##))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main (main) where\n\nimport GHC.Exts (Double(D#), Float(F#), word2Double#, word2Float#)\n\nmain :: IO ()\nmain = do\n    print (D# (word2Double# 0##))\n    -- 9007199254740992 is 2^53, which is the largest integer which\n    -- can be stored in a 64-bit IEEE floating-point value without\n    -- loss of precision.\n    print (D# (word2Double# 9007199254740992##))\n    print (F# (word2Float# 0##))\n    -- 16777216 is 2^24, which is the largest integer which can be\n    -- stored in a 32-bit IEEE floating-point value without loss of\n    -- precision\n    print (F# (word2Float# 16777216##))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n\nmodule Data.Trie.Naive\n  ( Trie\n  , singleton\n  , singletonString\n  , lookup\n  , parser\n  , fromList\n  , fromListAppend\n  , fromStringList\n  ) where\n\nimport Prelude hiding (lookup)\n\nimport Data.Semigroup (Semigroup)\nimport Data.Word (Word8)\nimport Data.Map (Map)\nimport Data.Bifunctor (second)\nimport Packed.Bytes (Bytes)\nimport qualified Data.Char\nimport qualified GHC.OldList as L\nimport qualified Packed.Bytes.Parser as P\nimport qualified Packed.Bytes as B\nimport qualified Data.Semigroup as SG\nimport qualified Data.Map.Strict as M\n\ndata Trie a = Trie (Maybe a) (Map Word8 (Trie a))\n  deriving (Functor)\n\ninstance Semigroup a => Semigroup (Trie a) where\n  (<>) = append\n\ninstance Semigroup a => Monoid (Trie a) where\n  mempty = Trie Nothing M.empty\n  mappend = (SG.<>)\n\nappend :: Semigroup a => Trie a -> Trie a -> Trie a\nappend (Trie v1 m1) (Trie v2 m2) = Trie\n  (SG.getOption (SG.Option v1 SG.<> SG.Option v2))\n  (M.unionWith append m1 m2)\n\nsingleton :: Bytes -> a -> Trie a\nsingleton k v = B.foldr (\\b r -> Trie Nothing (M.singleton b r)) (Trie (Just v) M.empty) k\n\nsingletonString :: String -> a -> Trie a\nsingletonString k v = L.foldr (\\c r -> Trie Nothing (M.singleton (c2w c) r)) (Trie (Just v) M.empty) k\n\nlookup :: Bytes -> Trie a -> Maybe a\nlookup k t0 = case B.foldr lookupStep (Just t0) k of\n  Nothing -> Nothing\n  Just (Trie v _) -> v\n\nlookupStep :: Word8 -> Maybe (Trie a) -> Maybe (Trie a)\nlookupStep w Nothing = Nothing\nlookupStep w (Just (Trie _ m)) = M.lookup w m\n\nparser :: Trie (P.Parser a) -> P.Parser a\nparser (Trie mp m) = case mp of\n  Just p -> p\n  Nothing -> do\n    w <- P.any\n    case M.lookup w m of\n      Nothing -> P.failure\n      Just t -> parser t\n\nfromList :: [(Bytes,a)] -> Trie a\nfromList = fmap SG.getFirst . fromListAppend . map (second SG.First)\n\nfromListAppend :: Semigroup a => [(Bytes,a)] -> Trie a\nfromListAppend = foldMap (uncurry singleton)\n\nfromStringList :: [(String,a)] -> Trie a\nfromStringList = fmap SG.getFirst . fromStringListAppend . map (second SG.First)\n\nfromStringListAppend :: Semigroup a => [(String,a)] -> Trie a\nfromStringListAppend = foldMap (uncurry singletonString)\n\nc2w :: Char -> Word8\nc2w = fromIntegral . Data.Char.ord\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n{-# OPTIONS_GHC\n -fno-warn-unsafe\n -fno-warn-implicit-prelude\n -fno-warn-missing-import-lists\n -O2\n#-}\n\nmodule Packed.Bytes\n  ( Bytes(..)\n  , pack\n  , unpack\n  , length\n    -- * Folds\n  , foldr\n    -- * Unsliced Byte Arrays\n  , fromByteArray\n  ) where\n\nimport Prelude hiding (take,length,replicate,drop,null,concat,foldr)\n\nimport Data.Primitive (ByteArray(..))\nimport Data.Word (Word8)\nimport Control.Monad.ST (runST, ST)\nimport qualified Data.Primitive as PM\nimport qualified GHC.OldList as L\n\ndata Bytes = Bytes\n  {-# UNPACK #-} !ByteArray -- payload\n  {-# UNPACK #-} !Int -- offset\n  {-# UNPACK #-} !Int -- length\n\ninstance Show Bytes where\n  show x = \"pack \" ++ show (unpack x)\n\npack :: [Word8] -> Bytes\npack bs = let arr = packByteArray bs in Bytes arr 0 (lengthByteArray arr)\n\nunpack :: Bytes -> [Word8]\nunpack (Bytes arr off len) = go off\n  where\n  go :: Int -> [Word8]\n  go !ix = if ix < len + off\n    then PM.indexByteArray arr ix : go (ix + 1)\n    else []\n\nfromByteArray :: ByteArray -> Bytes\nfromByteArray ba = Bytes ba 0 (lengthByteArray ba)\n\nlength :: Bytes -> Int\nlength (Bytes _ _ len) = len\n\nfoldr :: (Word8 -> a -> a) -> a -> Bytes -> a\nfoldr f a0 (Bytes arr off0 len) = go off0 where\n  !end = off0 + len\n  go !ix = if ix < end\n    then f (PM.indexByteArray arr ix) (go (ix + 1))\n    else a0\n\npackByteArray :: [Word8] -> ByteArray\npackByteArray ws0 = runST $ do\n  marr <- PM.newByteArray (L.length ws0)\n  let go [] !_ = return ()\n      go (w : ws) !ix = PM.writeByteArray marr ix w >> go ws (ix + 1)\n  go ws0 0\n  PM.unsafeFreezeByteArray marr\n\nunpackByteArray :: ByteArray -> [Word8]\nunpackByteArray arr = go 0 where\n  go :: Int -> [Word8]\n  go !ix = if ix < lengthByteArray arr\n    then PM.indexByteArray arr ix : go (ix + 1)\n    else []\n\nlengthByteArray :: ByteArray -> Int\nlengthByteArray = PM.sizeofByteArray\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE UnboxedSums #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n{-# OPTIONS_GHC\n -Weverything\n -fno-warn-unsafe\n -fno-warn-implicit-prelude\n -fno-warn-missing-import-lists\n -fno-warn-noncanonical-monoid-instances\n -O2\n#-}\n\nmodule Packed.Bytes.Parser\n  ( Parser(..)\n  , Result(..)\n  , Leftovers(..)\n  , parseStreamST\n  , any\n  , failure\n  ) where\n\nimport Control.Applicative\nimport Data.Primitive (ByteArray(..))\nimport GHC.Int (Int(I#))\nimport GHC.ST (ST(..),runST)\nimport GHC.Types (TYPE)\nimport GHC.Word (Word8(W8#))\nimport Packed.Bytes (Bytes(..))\nimport Packed.Bytes.Stream.ST (ByteStream(..))\nimport Prelude hiding (any,replicate)\n\nimport qualified Data.Primitive as PM\nimport qualified Control.Monad\n\nimport GHC.Exts (Int#,ByteArray#,Word#,State#,(+#),(-#),(>#),indexWord8Array#)\n\ntype Bytes# = (# ByteArray#, Int#, Int# #)\ntype Maybe# (a :: TYPE r) = (# (# #) | a #)\ntype Leftovers# s = (# Bytes# , ByteStream s #)\ntype Result# s a = (# Maybe# (Leftovers# s), Maybe# a #)\n\ndata Result s a = Result\n  { resultLeftovers :: !(Maybe (Leftovers s))\n  , resultValue :: !(Maybe a)\n  }\n\ndata Leftovers s = Leftovers\n  { leftoversChunk :: {-# UNPACK #-} !Bytes\n    -- ^ The last chunk pulled from the stream\n  , leftoversStream :: ByteStream s\n    -- ^ The remaining stream\n  }\n\ndata PureResult a = PureResult\n  { pureResultLeftovers :: {-# UNPACK #-} !Bytes\n  , pureResultValue :: !(Maybe a)\n  } deriving (Show)\n\nemptyByteArray :: ByteArray\nemptyByteArray = runST (PM.newByteArray 0 >>= PM.unsafeFreezeByteArray)\n\nparseStreamST :: ByteStream s -> Parser a -> ST s (Result s a)\nparseStreamST stream (Parser f) = ST $ \\s0 ->\n  case f (# | (# (# unboxByteArray emptyByteArray, 0#, 0# #), stream #) #) s0 of\n    (# s1, r #) -> (# s1, boxResult r #)\n\nboxResult :: Result# s a -> Result s a\nboxResult (# leftovers, val #) = case val of\n  (# (# #) | #) -> Result (boxLeftovers leftovers) Nothing\n  (# | a #) -> Result (boxLeftovers leftovers) (Just a)\n\nboxLeftovers :: Maybe# (Leftovers# s) -> Maybe (Leftovers s)\nboxLeftovers (# (# #) | #) = Nothing\nboxLeftovers (# | (# theBytes, stream #) #) = Just (Leftovers (boxBytes theBytes) stream)\n\ninstance Functor Parser where\n  fmap = mapParser\n\n-- Remember to write liftA2 by hand at some point.\ninstance Applicative Parser where\n  pure = pureParser\n  (<*>) = Control.Monad.ap\n\ninstance Monad Parser where\n  return = pure\n  (>>=) = bindLifted\n\nnewtype Parser a = Parser\n  { getParser :: forall s.\n       Maybe# (Leftovers# s)\n    -> State# s\n    -> (# State# s, Result# s a #)\n  }\n\nnextNonEmpty :: ByteStream s -> State# s -> (# State# s, Maybe# (Leftovers# s) #)\nnextNonEmpty (ByteStream f) s0 = case f s0 of\n  (# s1, r #) -> case r of\n    (# (# #) | #) -> (# s1, (# (# #) | #) #)\n    (# | (# theBytes@(# _,_,len #), stream #) #) -> case len of\n      0# -> nextNonEmpty stream s1\n      _ -> (# s1, (# | (# theBytes, stream #) #) #)\n\nwithNonEmpty :: forall s b.\n     Maybe# (Leftovers# s)\n  -> State# s\n  -> (State# s -> (# State# s, Result# s b #))\n  -> (Word# -> Bytes# -> ByteStream s -> State# s -> (# State# s, Result# s b #))\n     -- The first argument is a Word8, not a full machine word.\n     -- The second argument is the complete,non-empty chunk\n     -- with the head byte still intact.\n  -> (# State# s, Result# s b #)\nwithNonEmpty (# (# #) | #) s0 g _ = g s0\nwithNonEmpty (# | (# bytes0@(# arr0,off0,len0 #), stream0 #) #) s0 g f = case len0 ># 0# of\n  1# -> f (indexWord8Array# arr0 off0) bytes0 stream0 s0\n  _ -> case nextNonEmpty stream0 s0 of\n    (# s1, r #) -> case r of\n      (# (# #) | #) -> g s1\n      (# | (# bytes1@(# arr1, off1, _ #), stream1 #) #) ->\n        f (indexWord8Array# arr1 off1) bytes1 stream1 s1\n\n-- | Consume the next byte from the input.\nany :: Parser Word8\nany = Parser go where\n  go :: Maybe# (Leftovers# s) -> State# s -> (# State# s, Result# s Word8 #)\n  go m s0 = withNonEmpty m s0\n    (\\s -> (# s, (# (# (# #) | #), (# (# #) | #) #) #))\n    (\\theByte theBytes stream s ->\n      (# s, (# (# | (# unsafeDrop# 1# theBytes, stream #) #), (# | W8# theByte #) #) #)\n    )\n\n-- TODO: improve this\nmapParser :: (a -> b) -> Parser a -> Parser b\nmapParser f p = bindLifted p (pureParser . f)\n\npureParser :: a -> Parser a\npureParser a = Parser $ \\leftovers0 s0 ->\n  (# s0, (# leftovers0, (# | a #) #) #)\n\nbindLifted :: Parser a -> (a -> Parser b) -> Parser b\nbindLifted (Parser f) g = Parser $ \\leftovers0 s0 -> case f leftovers0 s0 of\n  (# s1, (# leftovers1, val #) #) -> case val of\n    (# (# #) | #) -> (# s1, (# leftovers1, (# (# #) | #) #) #)\n    (# | x #) -> case g x of\n      Parser k -> k leftovers1 s1\n\n-- This assumes that the Bytes is longer than the index. It also does\n-- not eliminate zero-length references to byte arrays.\nunsafeDrop# :: Int# -> Bytes# -> Bytes#\nunsafeDrop# i (# arr, off, len #) = (# arr, off +# i, len -# i #)\n\nunboxByteArray :: ByteArray -> ByteArray#\nunboxByteArray (ByteArray arr) = arr\n\nboxBytes :: Bytes# -> Bytes\nboxBytes (# a, b, c #) = Bytes (ByteArray a) (I# b) (I# c)\n\nfailure :: Parser a\nfailure = Parser (\\m s -> (# s, (# m, (# (# #) | #) #) #))\n", "num_lines": 166}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE UnboxedSums #-}\n\n{-# OPTIONS_GHC -O2 #-}\n\nmodule Packed.Bytes.Stream.ST\n  ( ByteStream(..)\n  , empty\n  , unpack\n  , fromBytes\n  ) where\n\nimport Data.Primitive (Array,ByteArray(..))\nimport Data.Semigroup (Semigroup)\nimport Data.Word (Word8)\nimport GHC.Exts (RealWorld,State#,Int#,ByteArray#)\nimport GHC.Int (Int(I#))\nimport GHC.ST (ST(..))\nimport Packed.Bytes (Bytes(..))\nimport System.IO (Handle)\nimport qualified Data.Primitive as PM\nimport qualified Data.Semigroup as SG\nimport qualified Packed.Bytes as B\n\ntype Bytes# = (# ByteArray#, Int#, Int# #)\n\nnewtype ByteStream s = ByteStream\n  (State# s -> (# State# s, (# (# #) | (# Bytes# , ByteStream s #) #) #) )\n\nfromBytes :: Bytes -> ByteStream s\nfromBytes b = ByteStream\n  (\\s0 -> (# s0, (# | (# unboxBytes b, empty #) #) #))\n\nnextChunk :: ByteStream s -> ST s (Maybe (Bytes,ByteStream s))\nnextChunk (ByteStream f) = ST $ \\s0 -> case f s0 of\n  (# s1, r #) -> case r of\n    (# (# #) | #) -> (# s1, Nothing #)\n    (# | (# theBytes, theStream #) #) -> (# s1, Just (boxBytes theBytes, theStream) #)\n\nempty :: ByteStream s\nempty = ByteStream (\\s -> (# s, (# (# #) | #) #) )\n\nboxBytes :: Bytes# -> Bytes\nboxBytes (# a, b, c #) = Bytes (ByteArray a) (I# b) (I# c)\n\nunboxBytes :: Bytes -> Bytes#\nunboxBytes (Bytes (ByteArray a) (I# b) (I# c)) = (# a,b,c #)\n\nunpack :: ByteStream s -> ST s [Word8]\nunpack stream = ST (unpackInternal stream)\n\nunpackInternal :: ByteStream s -> State# s -> (# State# s, [Word8] #)\nunpackInternal (ByteStream f) s0 = case f s0 of\n  (# s1, r #) -> case r of\n    (# (# #) | #) -> (# s1, [] #)\n    (# | (# bytes, stream #) #) -> case unpackInternal stream s1 of\n      (# s2, ws #) -> (# s2, B.unpack (boxBytes bytes) ++ ws #)\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified Parser as Parser\n\nmain :: IO ()\nmain = print (iterate Parser.byteParserBadOnce 5 !! 100000)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE BinaryLiterals #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE UnboxedSums #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Parser\n  ( byteParserBadOnce\n  ) where\n\nimport Control.Monad.ST (runST)\nimport Data.Word (Word8)\nimport Packed.Bytes (Bytes)\nimport Packed.Bytes.Parser (Parser)\nimport Packed.Bytes.Stream.ST (ByteStream)\nimport qualified Data.Char\nimport qualified Packed.Bytes as B\nimport qualified Packed.Bytes.Parser as P\nimport qualified Packed.Bytes.Stream.ST as Stream\n\n-- from common directory\nimport qualified Data.Trie.Naive as Naive\n\nsnmptrapdNaive :: Naive.Trie (Parser Word)\nsnmptrapdNaive = Naive.fromStringList\n  [ (\"STRING: \", P.any >>= \\_ -> return 5)\n  ]\n\nrunExampleParser :: Parser a -> (forall s. ByteStream s) -> (Maybe a, Maybe String)\nrunExampleParser parser stream = runST $ do\n  P.Result mleftovers r <- P.parseStreamST stream parser\n  mextra <- case mleftovers of\n    Nothing -> return Nothing\n    Just (P.Leftovers chunk remainingStream) -> do\n      bs <- Stream.unpack remainingStream\n      return (Just (map word8ToChar (B.unpack chunk ++ bs)))\n  return (r,mextra)\n\nbyteParserBadOnce :: Int -> Int\nbyteParserBadOnce x = do\n  let sample = (\"STRING: _6_ \" ++ show x)\n      stream = Stream.fromBytes (s2b sample)\n      expected = 6\n      (r,mextra) = runExampleParser (Naive.parser snmptrapdNaive) stream\n      a1 = if Nothing == mextra then 1 else 0\n      a2 = if Just expected == r then 1 else 0\n   in a1 + (a2 + x)\n\ns2b :: String -> Bytes\ns2b = B.pack . map charToWord8\n\ncharToWord8 :: Char -> Word8\ncharToWord8 = fromIntegral . Data.Char.ord\n\nword8ToChar :: Word8 -> Char\nword8ToChar = Data.Char.chr . fromIntegral\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Arithmetic where\n\nimport Control.Concurrent\nimport Control.Concurrent.MVar\nimport System.IO.Unsafe\nimport Utilities\nimport Converter\nimport Stream\nimport Data.Ratio\nimport Trit\n\n\n-- Negate a stream of Gray code\nnegateGray :: Gray -> Gray\nnegateGray = fl\n\n\n-- Multiply a Gray code stream by 2\n-- The stream must represent a real number in (-1/2, 1/2) only\nmul2 :: Gray -> Gray\nmul2 (x:1:xs) = (x:fl xs)\n\n\n-- Division by 2, the result is to be in (-1/2, 1/2)\ndiv2 :: Gray -> Gray\ndiv2 (x:xs) = x:1:(fl xs)\n\n\n-- Addition by 1, the input must be in (-1,0)\nplusOne :: Gray -> Gray\nplusOne (0:xs) = 1:fl xs\n\n\n\n-- Substraction by 1, the input must be in (0,1)\nminusOne :: Gray -> Gray\nminusOne (1:xs) = 0:fl xs\n\n\n\n\nthreadTesting :: Gray -> Gray -> IO Int\nthreadTesting xs ys = do\n                    m <- newEmptyMVar\n                    c1 <- forkIO (t1 m xs ys)\n                    c2 <- forkIO (t2 m xs ys)\n                    c3 <- forkIO (t3 m xs ys)\n                    c4 <- forkIO (t4 m xs ys)\n                    c5 <- forkIO (t5 m xs ys)\n                    c6 <- forkIO (t6 m xs ys)\n                    c <- takeMVar m\n                    killThread c1\n                    killThread c2\n                    killThread c3\n                    killThread c4\n                    killThread c5\n                    killThread c6\n                    return c\n\n\n\n\naddition :: Gray -> Gray -> IO Gray\naddition xs ys = do\n                                        c <- threadTesting xs ys\n                                        case c of\n                                           1 -> do\n                                                   let tx = tail xs\n                                                   let ty = tail ys\n                                                   t <- unsafeInterleaveIO (addition  tx ty)\n                                                   return (0:t)\n                                           2 ->  do\n                                                   let tx = tail xs\n                                                   let ty = tail ys\n                                                   t <- unsafeInterleaveIO (addition tx ty)\n                                                   return (1:t)\n                                           3 ->  do\n                                                   let tx = tail xs\n                                                   let ty = tail ys\n                                                   cs <- unsafeInterleaveIO (addition tx (fl ty))\n                                                   let c1 = cs !! 0\n                                                   let c2 = tail cs\n                                                   return (c1:1:fl c2)\n                                           4 ->  do\n                                                   let tx = tail xs\n                                                   let ty = tail ys\n                                                   (cs) <- unsafeInterleaveIO (addition (fl tx) ty)\n                                                   let c1 = cs !! 0\n                                                   let c2 = tail cs\n                                                   return (c1:1:(fl c2))\n                                           5 ->  do\n                                                   let x1 = xs!!0\n                                                   let y1 = ys!!0\n                                                   let tx = (drop 2) xs\n                                                   let ty = (drop 2) ys\n                                                   cs <- unsafeInterleaveIO (addition (x1:(fl tx)) (y1:(fl ty)))\n                                                   let c1 = cs !! 0\n                                                   let c2 = tail cs\n                                                   return (c1:(1:(fl c2)))\n                                           6 ->  do\n                                                   let x1 = xs !! 0\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 2 ys\n                                                   t <- unsafeInterleaveIO (addition (x1:1:tx) (1:fl ty))\n                                                   return (0:t)\n                                           7 ->  do\n                                                   let x1 = xs !! 0\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 2 ys\n                                                   t <- unsafeInterleaveIO (addition (fl (x1:1:tx)) (1:(fl ty)))\n                                                   return (1:t)\n                                           8 ->  do\n                                                   let x1 = xs !! 0\n                                                   let y2 = ys !! 1\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   t <- unsafeInterleaveIO (addition (fl (x1:fl tx)) (fl (y2:fl ty)))\n                                                   return (0:1:t)\n                                           9 ->  do\n                                                   let x1 = xs !! 0\n                                                   let y2 = ys !! 1\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   t <- unsafeInterleaveIO (addition (x1:fl tx) (fl (y2:fl ty)))\n                                                   return (1:1:t)\n                                           10 ->  do\n                                                   let y1 = ys !! 0\n                                                   let ty = drop 3 ys\n                                                   let tx = drop 2 xs\n                                                   t <- unsafeInterleaveIO (addition (1:fl tx) (y1:1:ty))\n                                                   return (0:t)\n                                           11 ->  do\n                                                   let y1 = ys !! 0\n                                                   let ty = drop 3 ys\n                                                   let tx = drop 2 xs\n                                                   t <- unsafeInterleaveIO (addition (1:fl tx) (fl (y1:1:ty)))\n                                                   return (1:t)\n                                           12 ->  do\n                                                   let y1 = ys !! 0\n                                                   let x2 = xs !! 1\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   t <- unsafeInterleaveIO (addition (fl (x2:fl tx)) (fl (y1:fl ty)))\n                                                   return (0:1:t)\n                                           13 ->  do\n                                                   let y1 = ys !! 0\n                                                   let x2 = xs !! 1\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   t <- unsafeInterleaveIO (addition (fl (x2:fl tx)) (y1:fl ty))\n                                                   return (1:1:t)\n\n\n\n\n\n\n\n\n\n\n\n\n\n-- Compute (a-b)/2\nsubstraction :: Gray -> Gray -> IO Gray\nsubstraction xs ys = addition xs (negateGray ys)\n\n\n\n\n\nt1 :: MVar Int -> Stream -> Stream -> IO()\nt1 m (0:as) (0:bs) = putMVar m 1\nt1 m (1:as) (1:bs) = putMVar m 2\nt1 m (0:as) (1:bs) = putMVar m 3\nt1 m (1:as) (0:bs) = putMVar m 4\n\n\nt2 :: MVar Int -> Stream -> Stream -> IO()\nt2 m (a:1:x) (b:1:y) = putMVar m 5\nt2 m x y = yield\n\n\nt3 m (a:1:0:x) (0:0:y) = putMVar m 6\nt3 m (a:1:0:x) (1:0:y) = putMVar m 7\nt3 m x y = yield\n\n\nt4 m (a:1:0:x) (0:b:1:y) = putMVar m 8\nt4 m (a:1:0:x) (1:b:1:y) = putMVar m 9\nt4 m x y = yield\n\n\nt5 m (0:0:x) (b:1:0:y) = putMVar m 10\nt5 m (1:0:x) (b:1:0:y) = putMVar m 11\nt5 m x y = yield\n\n\nt6 m (0:a:1:x) (b:1:0:y) = putMVar m 12\nt6 m (1:a:1:x) (b:1:0:y) = putMVar m 13\nt6 m x y = yield\n\n\n\n\n\nmultiplyIO :: Gray -> Gray -> IO Gray\nmultiplyIO xs ys = do\n                    s1 <- unsafeInterleaveIO (grayToSignIO xs)\n                    s2 <- unsafeInterleaveIO (grayToSignIO ys)\n                    let s = Trit.multiply s1 s2\n                    let g = signToGray s\n                    return g\n\n\n\nstart :: IO()\nstart = do\n           c <- unsafeInterleaveIO(multiplyIO z1 z1)\n           putStrLn (show c)\n\n\nstartA :: IO()\nstartA = do\n           c <- unsafeInterleaveIO(addition (1:1:z0) (1:1:z0))\n           putStrLn (show (take 30 c))\n\nz0 = (0:z0)\nz1 = (1:z1)\n\nzl = 0:loop:z0\n\nloop = loop\nloop01 = 0:1:loop01\n", "num_lines": 236}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Converter (rationalToGray, grayToSignIO, signToGray, Gray, startF, startC) where\n\nimport Stream\nimport Data.Ratio\nimport Control.Concurrent\nimport Control.Concurrent.MVar\nimport System.IO.Unsafe\n\n\ntype Gray = [Integer]\ntype State = (Integer, Integer)\n\n\n-- Convert a rational number (in (-1,1)) to its Gray representation\nrationalToGray :: Rational -> Gray\nrationalToGray x\n                |x<0            = f (negate' (rationalToStream (-x))) (0,0)\n                |otherwise      = f (rationalToStream x) (0,0)\n\n\n-- Function to implement the two heads Turing machine that convert a\n-- signed-digit stream to the corresponding Gray-code representation\nf :: Stream -> State -> Stream\nf (x:xs) (0,0)\n            |x==(-1)    = 0:f xs (0,0)\n            |x==0       = c:1:ds\n            |x==1       = 1:f xs (1,0)\n            where c:ds = f xs (0,1)\n\nf (x:xs) (0,1)\n            |x==(-1)    = 0:f xs (1,0)\n            |x==0       = c:0:ds\n            |x==1       = 1:f xs (0,0)\n            where c:ds = f xs (0,1)\n\nf (x:xs) (1,0)\n            |x==(-1)    = 1:f xs (0,0)\n            |x==0       = c:1:ds\n            |x==1       = 0:f xs (1,0)\n            where c:ds = f xs (1,1)\n\nf (x:xs) (1,1)\n            |x==(-1)    = 1:f xs (1,0)\n            |x==0       = c:0:ds\n            |x==1       = 0:f xs (0,0)\n            where c:ds = f xs (1,1)\n\n\n\n\n-- Anotherway to convert from a rational to Gray code representation\n-- Behave exactly the same like above\nrationalToGray' :: Rational -> Gray\nrationalToGray' x\n                |x<0            = signToGray (negate' (rationalToStream (-x)))\n                |otherwise      = signToGray (rationalToStream x)\n\n\n-- Function to convert a signed-digit stream to Gray representation\n-- Is much shorter than above\nsignToGray :: Stream -> Stream\nsignToGray (1:xs)       = 1:f'(signToGray xs)\nsignToGray ((-1):xs)    = 0:signToGray xs\nsignToGray (0:xs)       = c:1:(f' ds)\n                        where c:ds = signToGray xs\n\n\n\n-- Convert a Gray-code stream to the corresponding signed-digit representation\n-- Make use of threads\ngrayToSignIO :: Stream -> IO Stream\ngrayToSignIO (x1:x2:xs) = do\n                        c <- threadTesting(x1:x2:xs)\n                        if (c==1)\n                           then (do  co <- unsafeInterleaveIO (grayToSignIO (f'(x2:xs)))\n                                     return (1:co))\n                           else if (c==2)\n                                   then (do co <- unsafeInterleaveIO (grayToSignIO (x2:xs))\n                                            return ((-1):co))\n                                   else (do co <- unsafeInterleaveIO (grayToSignIO (x1:f' xs))\n                                            return (0:co))\n\n-- Flip the first bit of an infinite stream\nf' (x:xs) = (f'' x):xs\n            where f'' 1 = 0\n                  f'' 0 = 1\n\n\n-- Launch two threads which run concurrently, test for the first digit of the stream (1, 0 or bottom)\n-- As soon as one thread terminate, grab that result and proceed\nthreadTesting :: Stream -> IO Int\nthreadTesting xs = do   m <- newEmptyMVar\n                        c1 <- forkIO (f1 m xs)\n                        c2 <- forkIO (f2 m xs)\n                        c <- takeMVar m\n                        killThread c1\n                        killThread c2\n                        return c\n\n-- Test case 1, when the first bit is either 1 or 0.\n-- In case of bottom, f1 will never terminate, then f2 will definitely terminate\nf1 :: MVar Int -> Stream -> IO()\nf1 m (0:xs) = putMVar m 2\nf1 m (1:xs) = putMVar m 1\n\n-- Test case 2, when the first bit is completely ignored, esp in case it was a bottom\n-- If the second bit is 1, then we can output, don't care value of the first bit\n-- If the second bit is 0, then loop forever, give chances to f1 to terminate\nf2 :: MVar Int -> Stream -> IO()\nf2 m (c1:c2:xs)\n                |c2==1          = putMVar m 3\n                |otherwise      = yield\n\n\n\n\n-- Testing\nstartC :: IO()\nstartC = do\n            c<- unsafeInterleaveIO (grayToSignIO (1:1:z0))\n            putStrLn (show (take 100 c))\n\n\nstartF = signToGray ((-1):1:z0)\n\n\nz0 = 0:z0\nloop' = loop'\nz1' = (1:z1')\n", "num_lines": 131}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Arithmetic\nimport Trit\nimport Converter\nimport System.IO.Unsafe\nimport Data.Ratio\nimport Utilities\nimport Thread\n\nmain = startM1\n\nstartM1 :: IO()\nstartM1 = do\n          c <- unsafeInterleaveIO (mult (rationalToGray (1%3)) (rationalToGray (0%1)))\n          putStrLn (show  (take 100 (drop 1 c)))\n\n\n\n\nmult :: Gray -> Gray -> IO Gray\nmult xs ys = do\n                                        c <- threadTesting1 xs ys\n                                        case c of\n\n                                           101 -> do\n                                                   --putStrLn (\"In case 101\")\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 2 ys\n                                                   t1 <- unsafeInterleaveIO (addition tx ty)\n                                                   t2 <- unsafeInterleaveIO (addition (fl t1) (1:t1))\n                                                   t3 <- unsafeInterleaveIO (mult tx ty)\n                                                   c' <- unsafeInterleaveIO (addition t2 (1:0:0:(fl t3)))\n                                                   return c'\n\n                                           102 -> do\n                                                   --putStrLn (\"In case 102\")\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 2 ys\n                                                   t1 <- unsafeInterleaveIO (addition (fl tx) ty)\n                                                   t2 <- unsafeInterleaveIO (addition tx ty)\n                                                   t0 <- unsafeInterleaveIO (addition t1 (1:fl t2))\n                                                   t3 <- unsafeInterleaveIO (mult tx ty)\n                                                   c' <- unsafeInterleaveIO (addition t0 (1:1:0:fl t3))\n                                                   return c'\n\n                                           103 -> do\n                                                   --putStrLn (\"In case 103\")\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 2 ys\n                                                   t <- unsafeInterleaveIO (mult (0:0:tx) (0:0:ty))\n                                                   return (fl t)\n\n                                           104 -> do\n                                                   --putStrLn (\"In case 104\")\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 2 ys\n                                                   t <- unsafeInterleaveIO (mult (0:0:tx) (0:1:ty))\n                                                   return (fl t)\n\n                                           201 -> do\n                                                   c' <- unsafeInterleaveIO (mult ys xs)\n                                                   return c'\n\n                                           202 -> do\n                                                   --putStrLn (\"In case 202\")\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 2 ys\n                                                   t1 <- unsafeInterleaveIO (addition tx ty)\n                                                   t2 <- unsafeInterleaveIO (addition t1 (0:fl t1))\n                                                   t3 <- unsafeInterleaveIO (mult tx ty)\n                                                   c' <- unsafeInterleaveIO (addition t2 (1:1:1:fl t3))\n                                                   return c'\n\n                                           203 -> do\n                                                   --putStrLn (\"In case 203\")\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 2 ys\n                                                   t <- unsafeInterleaveIO (mult (0:1:tx) (0:0:ty))\n                                                   return (fl t)\n\n                                           204 -> do\n                                                   --putStrLn (\"In case 204\")\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 2 ys\n                                                   t <- unsafeInterleaveIO (mult (0:1:tx) (0:1:ty))\n                                                   return (fl t)\n\n                                           30 ->  do\n                                                   --putStrLn (\"In case 30\")\n                                                   let y1 = ys !! 0\n                                                   let tx = drop 2 xs\n                                                   let ty = drop 3 ys\n                                                   t1 <- unsafeInterleaveIO (addition ((f0' y1):1:ty) ((f0' y1):1:0:ty))\n                                                   t0 <- unsafeInterleaveIO (mult tx (y1: fl ty))\n                                                   let c4 = head t0\n                                                   let d4 = fl (tail t0)\n                                                   c' <- unsafeInterleaveIO (addition t1 (c4:1:0:0:d4))\n                                                   return c'\n\n                                           31 -> do\n                                                  --putStrLn (\"In case 31\")\n                                                  let tx = drop 2 xs\n                                                  c' <- unsafeInterleaveIO (mult (0:0:tx) ys)\n                                                  return (fl c')\n\n                                           40 ->  do\n                                                   --putStrLn (\"In case 40\")\n                                                   let tx = drop 2 xs\n                                                   let y2 = ys !! 1\n                                                   let ty = drop 3 ys\n                                                   t1 <- unsafeInterleaveIO (addition (y2:fl ty) tx)\n                                                   t2 <- unsafeInterleaveIO (addition (fl t1) (1:y2:1:ty))\n                                                   t0 <- unsafeInterleaveIO (mult tx (y2:fl ty))\n                                                   let c2 = f0' (head t0)\n                                                   let d2 = fl (tail t0)\n                                                   c' <- unsafeInterleaveIO (addition t2 (1:c2:1:0:d2))\n                                                   return c'\n\n                                           41 ->  do\n                                                   --putStrLn (\"In case 41\")\n                                                   let tx = drop 2 xs\n                                                   let y2 = ys !! 1\n                                                   let ty = drop 3 ys\n                                                   c' <- unsafeInterleaveIO (mult (0:0:tx) (0:y2:1:ty))\n                                                   return (fl c')\n\n                                           50 ->  do\n                                                   --putStrLn (\"In case 50\")\n                                                   let tx = drop 2 xs\n                                                   let y2 = ys !! 1\n                                                   let ty = drop 3 ys\n                                                   t1 <- unsafeInterleaveIO (addition tx (fl (y2:fl ty)))\n                                                   t2 <- unsafeInterleaveIO (addition t1 (0:y2:1:ty))\n                                                   t0 <- unsafeInterleaveIO (mult (fl tx) (y2:fl ty))\n                                                   let c1 = f0' (head t0)\n                                                   let d1 = fl (tail t0)\n                                                   c' <- unsafeInterleaveIO (addition t2 (1:c1:1:0:d1))\n                                                   return c'\n\n                                           51 ->  do\n                                                   --putStrLn (\"In case 51\")\n                                                   let tx = drop 2 xs\n                                                   let y2 = ys !! 1\n                                                   let ty = drop 3 ys\n                                                   c' <- unsafeInterleaveIO (mult (0:1:tx) (0:y2:1:ty))\n                                                   return (fl c')\n\n\n                                           60 ->  do\n                                                   --putStrLn (\"In case 60\")\n                                                   let tx = drop 2 xs\n                                                   let y1 = ys !! 0\n                                                   let ty = drop 3 ys\n                                                   t1 <- unsafeInterleaveIO (addition ((f0' y1):1:ty) (y1:1:0:ty))\n                                                   t0 <- unsafeInterleaveIO (mult (fl tx) (y1:fl ty))\n                                                   let c1 = head t0\n                                                   let d1 = fl (tail t0)\n                                                   c' <- unsafeInterleaveIO (addition t1 (c1:1:0:0:d1))\n                                                   return c'\n\n                                           61 ->  do\n                                                   --putStrLn (\"In case 61\")\n                                                   let tx = drop 2 xs\n                                                   let y1 = ys !! 0\n                                                   let ty = drop 3 ys\n                                                   c' <- unsafeInterleaveIO (mult (0:1:tx) (y1:1:0:ty))\n                                                   return (fl c')\n\n\n                                           70 ->  do\n                                                   --putStrLn (\"In case 70\")\n                                                   c' <- unsafeInterleaveIO (mult ys xs)\n                                                   return c'\n\n                                           80 ->  do\n                                                   --putStrLn (\"In case 80\")\n                                                   let x2 = xs !! 1\n                                                   let y2 = ys !! 1\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   t1 <- unsafeInterleaveIO (addition (x2:fl tx) (y2:fl ty))\n                                                   t0 <- unsafeInterleaveIO (mult (x2:fl tx) (y2:fl ty))\n                                                   let c1 = head (fl t1)\n                                                   let d1 = tail (fl t1)\n                                                   let c2 = f0' (head t0)\n                                                   let d2 = fl (tail t0)\n                                                   c' <- unsafeInterleaveIO (addition (c1:1:(fl d1)) (1:c2:1:0:d2))\n                                                   return c'\n\n                                           81 ->  do\n                                                   --putStrLn (\"In case 81\")\n                                                   let x2 = xs !! 1\n                                                   let y2 = ys !! 1\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   c' <- unsafeInterleaveIO (mult (0:x2:1:tx) (0:y2:1:ty))\n                                                   return (fl c')\n\n                                           90 ->  do\n                                                   --putStrLn (\"In case 90\")\n                                                   let x2 = xs!!1\n                                                   let y1 = ys!!0\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   t0 <- unsafeInterleaveIO (mult (x2:fl tx) (y1:fl ty))\n                                                   let c1 = head t0\n                                                   let d1 = fl (tail t0)\n                                                   c' <- unsafeInterleaveIO (addition ((f0' y1):1:0:ty) (c1:1:0:0:d1))\n                                                   return c'\n\n                                           91 ->  do\n                                                   --putStrLn (\"In case 91\")\n                                                   let x2 = xs!!1\n                                                   let y1 = ys!!0\n                                                   let tx = drop 3 xs\n                                                   let ty = drop 3 ys\n                                                   c' <- unsafeInterleaveIO (mult (0:x2:1:tx) (y1:1:0:ty))\n                                                   return (fl c')\n\n                                           100 -> do\n                                                  --putStrLn (\"In case 100\")\n                                                  let x1 = head xs\n                                                  let y1 = head ys\n                                                  let tx = drop 3 xs\n                                                  let ty = drop 3 ys\n                                                  t0 <- unsafeInterleaveIO (mult (x1:fl tx) (y1:fl ty))\n                                                  let c4 = head t0\n                                                  let d4 = fl (tail t0)\n                                                  return (c4:1:0:0:0:d4)\n\n\n\nf0' 0 = 1\nf0' 1 = 0\n\n", "num_lines": 238}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Stream (Stream, carry, addStream, rationalToStream,\n                streamToFloat, addFiniteStream, negate', average) where\n\nimport Data.Ratio\n\n\ntype Digit = Integer\ntype Stream = [Integer]\n\n\n\n-- Convert from a Rational fraction to its stream representation\nrationalToStream :: Rational -> Stream\nrationalToStream x\n        |t<1            = 0:rationalToStream t\n        |otherwise      = 1:rationalToStream (t-1)\n        where t = 2*x\n\n\n\n\n-- Convert from a stream to the Float value\nstreamToFloat :: Stream -> Float\nstreamToFloat x =  f x (1)\n\nf :: Stream -> Integer -> Float\nf [] n = 0\nf (y:ys) n = (fromIntegral)y/(fromIntegral(2^n)) + f ys (n+1)\n\n\n\n\n\n-- Add two stream\naddStream :: Stream -> Stream -> Stream\naddStream (x1:x2:x3:xs) (y1:y2:y3:ys) = (u+c):(addStream (x2:x3:xs) (y2:y3:ys))\n                                where u = interim x1 x2 y1 y2\n                                      c = carry x2 x3 y2 y3\n\n\n\n-- Compute carry, the C(i) value, given x(i) and y(i)\ncarry :: Digit -> Digit -> Digit -> Digit -> Digit\ncarry x1 x2 y1 y2\n        |t>1                    =  1\n        |t<(-1)                 = -1\n        |t==1 && (minus1 x2 y2) =  0\n        |t==1 && not (minus1 x2 y2) = 1\n        |t==(-1) && (minus1 x2 y2) = -1\n        |t==(-1) && not (minus1 x2 y2) = 0\n        |t==0                           = 0\n        where t = x1+y1\n\n\n\n-- Computer the interim sum, the U(i) value, given x(i), y(i) and c(i)\ninterim :: Digit -> Digit -> Digit -> Digit -> Digit\ninterim x1 x2 y1 y2\n                |t>1                    =  0\n                |t<(-1)                 = 0\n                |t==1 && (minus1 x2 y2) =  1\n                |t==1 && not (minus1 x2 y2) = -1\n                |t==(-1) && (minus1 x2 y2) = 1\n                |t==(-1) && not (minus1 x2 y2) = -1\n                |t==0                           = 0\n                where t = x1+y1\n\n\n\n-- Check if at least one of 2 digits is -1\nminus1 :: Digit -> Digit -> Bool\nminus1 x y = (x==(-1))|| (y==(-1))\n\n\n\n\n\n\n-- Algin two stream so that they have the same length\nalign :: Stream -> Stream -> (Stream, Stream)\nalign xs ys\n        |x>y            = (xs, (copy 0 (x-y)) ++ys)\n        |otherwise      = ((copy 0 (y-x)) ++ xs, ys)\n        where x = toInteger(length xs)\n              y = toInteger(length ys)\n\n\n\n-- Generate a list of x\ncopy :: Integer -> Integer -> [Integer]\ncopy x n = [x| i<- [1..n]]\n\n\n\n\n\n\n\n-- Add two finite stream (to add the integral part)\naddFiniteStream :: Stream -> Stream -> Stream\naddFiniteStream xs ys = add' u v\n                        where (u,v) = align xs ys\n\n\n\n-- Utility function for addFinitieStream\nadd' :: Stream -> Stream -> Stream\nadd' u v = normalise (f u v)\n       where f [] [] = []\n             f (x:xs) (y:ys) = (x+y):f xs ys\n\n\n-- Normalise the sum\nnormalise :: Stream -> Stream\nnormalise = foldr f [0]\n            where f x (y:ys) = (u:v:ys)\n                              where u = (x+y) `div` 2\n                                    v = (x+y) `mod` 2\n\n\n-- Negate a stream\nnegate' :: Stream -> Stream\nnegate' = map (*(-1))\n\n\n\n-- Compute average of two stream\n-- Using [-2,-1,0,1,2] to add, and then divide by 2\naverage :: Stream -> Stream -> Stream\naverage xs ys = div2 (add xs ys)\n\n\n-- Addition of two streams, using [-2,-1,0,1,2]\nadd :: Stream -> Stream -> Stream\nadd (x:xs) (y:ys) = (x+y):(add xs ys)\n\n\n-- Then divided by 2, [-2,-1,0,1,2] -> [-1,0,1]\ndiv2 :: Stream -> Stream\ndiv2 (2:xs)             = 1:div2 xs\ndiv2 ((-2):xs)          = (-1):div2 xs\ndiv2 (0:xs)             = 0:div2 xs\ndiv2 (1:(-2):xs)        = div2 (0:0:xs)\ndiv2 (1:(-1):xs)        = div2 (0:1:xs)\ndiv2 (1:0:xs)           = div2 (0:2:xs)\ndiv2 (1:1:xs)           = div2 (2:(-1):xs)\ndiv2 (1:2:xs)           = div2 (2:0:xs)\ndiv2 ((-1):(-2):xs)     = div2 ((-2):0:xs)\ndiv2 ((-1):(-1):xs)     = div2 ((-2):1:xs)\ndiv2 ((-1):0:xs)        = div2 (0:(-2):xs)\ndiv2 ((-1):1:xs)        = div2 (0:(-1):xs)\ndiv2 ((-1):2:xs)        = div2 (0:0:xs)\n\n\n\ntest = take 100 (average (rationalToStream (1%2)) (rationalToStream (1%3)))\n", "num_lines": 157}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Thread (threadTesting1) where\n\nimport Control.Concurrent\nimport Control.Concurrent.MVar\nimport Stream\nimport Converter\n\nthreadTesting1 :: Gray -> Gray -> IO Int\nthreadTesting1 xs ys = do\n                    m <- newEmptyMVar\n                    c1 <- forkIO (t1 m xs ys)\n                    c2 <- forkIO (t2 m xs ys)\n                    c3 <- forkIO (t3 m xs ys)\n                    c4 <- forkIO (t4 m xs ys)\n                    c5 <- forkIO (t5 m xs ys)\n                    c6 <- forkIO (t6 m xs ys)\n                    c7 <- forkIO (t7 m xs ys)\n                    c8 <- forkIO (t8 m xs ys)\n                    c9 <- forkIO (t9 m xs ys)\n                    c <- takeMVar m\n                    killThread c1\n                    killThread c2\n                    killThread c3\n                    killThread c4\n                    killThread c5\n                    killThread c6\n                    killThread c7\n                    killThread c8\n                    killThread c9\n                    return c\n\n\n\n\n\n\n\n\nt1 :: MVar Int -> Stream -> Stream -> IO()\nt1 m (0:0:x) (0:0:y) = putMVar m 101\nt1 m (0:0:x) (0:1:y) = putMVar m 102\nt1 m (0:0:x) (1:0:y) = putMVar m 103\nt1 m (0:0:x) (1:1:y) = putMVar m 104\n\nt1 m (0:1:x) (0:0:y) = putMVar m 201\nt1 m (0:1:x) (0:1:y) = putMVar m 202\nt1 m (0:1:x) (1:0:y) = putMVar m 203\nt1 m (0:1:x) (1:1:y) = putMVar m 204\n\nt1 m (1:0:x) (0:0:y) = putMVar m 103\nt1 m (1:0:x) (0:1:y) = putMVar m 104\nt1 m (1:0:x) (1:0:y) = putMVar m 101\nt1 m (1:0:x) (1:1:y) = putMVar m 102\n\n\nt1 m (1:1:x) (0:0:y) = putMVar m 203\nt1 m (1:1:x) (0:1:y) = putMVar m 204\nt1 m (1:1:x) (1:0:y) = putMVar m 201\nt1 m (1:1:x) (1:1:y) = putMVar m 202\n\n\nt2 :: MVar Int -> Stream -> Stream -> IO()\nt2 m (0:0:x) (b:1:0:y) = putMVar m 30\nt2 m (1:0:x) (b:1:0:y) = putMVar m 31\nt2 m (0:1:x) (b:1:0:y) = putMVar m 60\nt2 m (1:1:x) (b:1:0:y) = putMVar m 61\nt2 m x y = yield\n\n\nt3 m (0:0:x) (0:b:1:y) = putMVar m 40\nt3 m (1:0:x) (1:b:1:y) = putMVar m 40\nt3 m (0:0:x) (1:b:1:y) = putMVar m 41\nt3 m (1:0:x) (0:b:1:y) = putMVar m 41\n\nt3 m (0:1:x) (0:b:1:y) = putMVar m 50\nt3 m (1:1:x) (1:b:1:y) = putMVar m 50\nt3 m (0:1:x) (1:b:1:y) = putMVar m 51\nt3 m (1:1:x) (0:b:1:y) = putMVar m 51\nt3 m x y = yield\n\nt4 m (0:a:1:y) (0:0:x) = putMVar m 70\nt4 m (1:a:1:y) (1:0:x) = putMVar m 70\nt4 m (1:a:1:y) (0:0:x) = putMVar m 70\nt4 m (0:a:1:y) (1:0:x) = putMVar m 70\nt4 m (0:a:1:y) (0:1:x) = putMVar m 70\nt4 m (1:a:1:y) (1:1:x) = putMVar m 70\nt4 m (1:a:1:y) (0:1:x) = putMVar m 70\nt4 m (0:a:1:y) (1:1:x) = putMVar m 70\nt4 m x y = yield\n\n\nt5 m (a:1:0:y) (0:0:x) = putMVar m 70\nt5 m (a:1:0:y) (1:0:x) = putMVar m 70\nt5 m (a:1:0:y) (0:1:x) = putMVar m 70\nt5 m (a:1:0:y) (1:1:x) = putMVar m 70\nt5 m x y = yield\n\nt6 m (0:a:1:x) (0:b:1:y) = putMVar m 80\nt6 m (1:a:1:x) (1:b:1:y) = putMVar m 80\nt6 m (0:a:1:x) (1:b:1:y) = putMVar m 81\nt6 m (1:a:1:x) (0:b:1:y) = putMVar m 81\nt6 m x y = yield\n\nt7 m (0:a:1:x) (b:1:0:y) = putMVar m 90\nt7 m (1:a:1:x) (b:1:0:y) = putMVar m 91\nt7 m x y = yield\n\nt8 m (a:1:0:x) (b:1:0:y) = putMVar m 100\nt8 m x y = yield\n\nt9 m (a:1:0:x) (0:b:1:y) = putMVar m 70\nt9 m (a:1:0:x) (1:b:1:y) = putMVar m 70\nt9 m x y = yield\n", "num_lines": 115}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Trit (Trit, rationalToTrit, getIntegral, getFraction, getFraction',\n                neg, addTrits, subTrits, shiftLeft, shiftRight, multiply\n                ) where\n\nimport Stream\nimport Utilities\nimport Data.Ratio\n\ntype Mantissa = Stream\ntype Fraction = Stream\ntype Trit     = (Mantissa, Fraction)\n\n\n-- Convert from a Rational number to its Trit representation (Integral, Fraction)\nrationalToTrit :: Rational -> Trit\nrationalToTrit x\n                |x<1            = ([0], rationalToStream x)\n                |otherwise      = (u', rationalToStream v)\n                where   u = n `div` d\n                        u' = toBinary u\n                        v = x - (toRational u)\n                        n = numerator x\n                        d = denominator x\n\n\n-- Get the integral part of Trit\ngetIntegral :: Trit -> Mantissa\ngetIntegral = fst\n\n\n\n-- Get the fraction part of Trit, with n digit of the stream\ngetFraction :: Int -> Trit -> Stream\ngetFraction n = take n. snd\n\n\n-- Get the fraction part of Trit\ngetFraction' :: Trit -> Stream\ngetFraction' = snd\n\n\n\n-- Negate a Trit\nneg :: Trit -> Trit\nneg (a, b) = (negate' a, negate' b)\n\n\n\n-- Add two Trits\naddTrits :: Trit -> Trit -> Trit\naddTrits (m1, (x1:x2:xs)) (m2, (y1:y2:ys)) = (u,addStream (x1:x2:xs) (y1:y2:ys))\n                                           where u' = addFiniteStream m1 m2\n                                                 c = [carry x1 x2 y1 y2]\n                                                 u = addFiniteStream u' c\n\n\n\n-- Substraction of 2 Trits\nsubTrits :: Trit -> Trit -> Trit\nsubTrits x y = addTrits x (neg y)\n\n\n\n-- Shift left = *2 operation with Trit\nshiftLeft :: Trit -> Trit\nshiftLeft (x, (y:ys)) = (x++ [y], ys)\n\n\n-- Shift right = /2 operation with Trit\nshiftRight :: Trit -> Integer -> Trit\nshiftRight (x, xs) 1 = (init x, (u:xs))\n                    where u = last x\nshiftRight (x, xs) n = shiftRight (init x, (u:xs)) (n-1)\n                    where u = last x\n\n\n\n-- Multiply a Trit stream by 1,0 or -1, simply return the stream\nmulOneDigit :: Integer -> Stream -> Stream\nmulOneDigit x xs\n              |x==1      = xs\n              |x==0      = zero'\n              |otherwise = negate' xs\n              where zero' = (0:zero')\n\n\n\n\n\n\n-- Multiplication of two streams\nmultiply :: Stream -> Stream -> Stream\nmultiply (a0:a1:x) (b0:b1:y) = average p q\n                               where p = average (a1*b0: (average (mulOneDigit b1 x)\n                                                                 (mulOneDigit a1 y)))\n                                                 (average (mulOneDigit b0 x)\n                                                          (mulOneDigit a0 y))\n                                     q = (a0*b0:a0*b1:a1*b1:(multiply x y))\n\n\n\n\nstart0 = take 30 (multiply (rationalToStream (1%2)) zo)\n\nzo :: Stream\nzo = 1:(-1):zero\n     where zero = 0:zero\n\nstart1 = take 30 (average (rationalToStream (1%2)) (negate' (rationalToStream (1%4))))\n\n\n\n", "num_lines": 113}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Utilities (toBinary, fl) where\n\nimport Stream\nimport Data.Ratio\n\n-- Convert from an Integer to its signed-digit representation\ntoBinary :: Integer -> Stream\ntoBinary 0 = [0]\ntoBinary x = toBinary t ++ [x `mod` 2]\n             where t = x `div` 2\n\n\n\nfl :: Stream -> Stream\nfl (x:xs) = (f x):xs\n          where f 0 = 1\n                f 1 = 0\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Event \nwhere\n\ndata SysReq = SysReq\n\ndata SysRsp = SysRsp\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Scheduler\n( runTIO\n, module Event\n, module Thread\n, TTree\n, TIO\n)\nwhere\n\nimport Event\nimport Thread\nimport Control.Concurrent\nimport System.IO\n\n--------------------------------\ntype TTree = ThreadTree SysReq SysRsp IO\ntype TIO   = ContM SysReq SysRsp IO\n\n\nrunTIO :: [TIO ()] -> IO ()\nrunTIO l = runThreads $ map buildThread l\n\ndata World = World\n    { mReadyQ :: ! (Chan (TTree))  }\n\nmax_steps = 1\nworker_pure world=\n  do\n      t <- readChan readyq\n      case t of\n        (Atom _) -> return ()\n        _ -> return ()\n      exec_thread max_steps t\n      return ()\n where\n readyq = mReadyQ world\n\n exec_thread 0 t =\n  do putStr \".\"; hFlush stdout\n     writeChan readyq t\n exec_thread c (Atom mx) =\n     do\n        x <- mx\n        exec_thread (c-1) x\n exec_thread c (Stop) = return ()\n\nrunThreads :: [TTree] -> IO ()\nrunThreads l =\n  do\n     mready <- newChan\n     writeList2Chan mready l\n     let world = World mready\n     multiloop world\n\nloop_p world = do worker_pure world; loop_p world\n\nmultiloop world =\n  do\n        -- a mixture of bound threads & lightweight threads\n        -- to make things interesting...\n     forkOS (loop_p world)\n     forkOS (loop_p world)\n     forkOS (loop_p world)\n     forkOS (loop_p world)\n     forkOS (loop_p world)\n     forkOS (loop_p world)\n     forkIO (loop_p world)\n     forkIO (loop_p world)\n     forkIO (loop_p world)\n     forkIO (loop_p world)\n     forkIO (loop_p world)\n     forkIO (loop_p world)\n     forkIO (loop_p world)\n     loop_p world\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Scheduler\nimport Foreign\nimport Foreign.C\nimport System.Random\nimport Control.Concurrent\n\nexpensive = f (500 :: Int)\n  where f 0 = stop\n        f n = do\n              r <- atom $ getStdRandom (randomR (0,99::Int))\n              r `seq` f $! n-1\n\nmain = do\n  m <- newEmptyMVar\n  forkIO (do\n          runTIO $ map (\\x->expensive) [1..500]\n          putMVar m ())\n  takeMVar m\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Thread \n( ThreadTree (..)\n, ContM (..)\n, atom\n, stop\n, buildThread\n)\nwhere\n\n----------------------------------\ndata ThreadTree req rsp m = \n        Atom (m (ThreadTree req rsp m))\n      | Stop\n----------------------------------\nnewtype ContM req rsp m a = ContM ((a-> ThreadTree req rsp m)-> ThreadTree req rsp m)\n\ninstance Functor (ContM req rsp m) where\n   fmap = undefined\n\ninstance Applicative (ContM req rsp m) where\n   pure  = undefined\n   (<*>) = undefined\n\ninstance Monad m => Monad (ContM req rsp m) where\n   m >>= f = contmBind m f\n   return  = contmReturn\n\ncontmBind :: (ContM req rsp m a) -> (a -> (ContM req rsp m b)) -> (ContM req rsp m b)\ncontmBind (ContM x) f =  \n    ContM(\\y-> x (\\z-> let ContM f' = f z in f' y))\ncontmReturn :: a -> (ContM req rsp m a)\ncontmReturn x = ContM(\\c -> c x)\n\n{-- how to build primitive ContM blocks... --}\n\natom :: Monad m => (m a) -> (ContM req rsp m a)\natom mx = ContM( \\c -> Atom( do x <- mx; return (c x) ))\n\nstop :: (ContM req rsp m a)\nstop = ContM( \\c -> Stop )\n\nbuildThread :: (ContM req rsp m a) -> ThreadTree req rsp m\nbuildThread (ContM f) = f (\\c->Stop)\n\n----------------------------------\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n> module BackList2 where\n\n> import Data.IORef\n> import Control.Concurrent\n> --import Control.Concurrent.STM\n\n> import RefInterface\n\n> data List r a = Node { val :: a, next :: (r (List r a)) }\n>               | Head { next :: r (List r a) }\n>               | DelNode (r (List r a))                  -- backpointer\n>               | Null\n\n> data ListHandle r a = ListHandle { headList :: r (r (List r a)),\n>                            tailList :: r (r (List r a)) }\n\n\n  abbreviations\n\n> newAtomic x = atomicRef (newRef x)\n\n> readAtomic x = atomicRef (readRef x)\n\n> writeAtomic ptr x = atomicRef (writeRef ptr x)\n\n\n> -- we create a new list\n> newList :: Ref r m => IO (ListHandle r a)\n> newList = \n>   do null <- newAtomic Null\n>      hd <- newAtomic (Head {next = null })\n>      hdPtr <- newAtomic hd\n>      tailPtr <- newAtomic null\n>      return (ListHandle {headList = hdPtr, tailList = tailPtr})\n\n\n\n> find :: (Eq a, Ref r m) => ListHandle r a -> a -> IO Bool\n> find (ListHandle {headList = ptrPtr})  i = \n>   do startPtr <- atomicRef (readRef ptrPtr)\n>      find2 startPtr i\n\n\nNOTE: I thought we can catch the 'head' case here,\n      so we don't need to check for 'head' in findNode,\n      but this leads to a non-exhaustive pattern failure\n\n> {-\n>  do startptr <- atomically (\n>          do ptr <- readTVar ptrPtr\n>             Head {next = startptr} <- readTVar ptr\n>             return startptr)\n>     find2 startptr i\n> -}\n\n> find2 :: (Eq a, Ref r m) => r (List r a) -> a -> IO Bool\n> find2 curNodePtr i =  \n>     do \n>     { comp <- atomicRef (findNode curNodePtr i)  \n>     ; comp }\n\n\nWe atomically check for lhs and guards\n\nf1 @ node(X,P,Next) \\ find(X,P,R) <=> R=tt..\nf2 @ nil(P) \\ find(Y,P,R) <=> R=ff.\nf3 @ node(X,P,Next) \\ find(Y,P,R) <=> X /= Y | find(Y,Next,R).\nf4 @ nodeDel(P,Q) \\ find(X,P,R) <=> find(X,Q,R).\n\n\n\n> findNode :: (Eq a, Ref r m) => r (List r a) -> a -> m (IO Bool)\n> findNode curNodePtr x = do \n>   { curNode <- readRef curNodePtr\n>   ; case curNode of\n>       Node {val = y, next = q} ->\n>         if (y == x) then return (return True) -- f1\n>         else return (find2 q x) -- f3       \n>       Null -> return (return False)    -- f2\n>       Head p-> return (find2 p x)  --error \"findNode: impossible\"\n>       DelNode p -> return (find2 p x)  -- f4\n>  }\n\n\n> -- we add a new node, by overwriting the null tail node\n> -- we only need to adjust tailList but not headList because\n> -- of the static Head\n> -- we return the location of the newly added node\n> addToTail :: Ref r m => ListHandle r a -> a -> IO (r (List r a))\n> addToTail (ListHandle {tailList = tailPtrPtr}) x =\n>   do tPtr <- atomicRef (\n>                do null <- newRef Null\n>                   tailPtr <- readRef tailPtrPtr\n>                   writeRef tailPtr (Node {val = x, next = null})\n>                   writeRef tailPtrPtr null\n>                   return tailPtr\n>              )\n>      return tPtr\n\n\n> delete :: (Eq a, Ref r m) => ListHandle r a -> a -> IO Bool\n> delete (ListHandle {headList = ptrPtr})  i = \n>  do prevPtr <- atomicRef (readRef ptrPtr)\n>     delete2 prevPtr i\n\n\n> delete2 :: (Eq a, Ref r m) => r (List r a) -> a -> IO Bool\n> delete2 prevPtr i = \n>     do \n>     { comp <- atomicRef (deleteNode prevPtr i)\n>     ; comp }\n\n\n> deleteNode :: (Eq a,Ref r m) => r (List r a) -> a -> m (IO Bool)\n> deleteNode prevPtr x = \n>     do\n>    { prevNode <- readRef prevPtr\n>    ; case prevNode of\n>        Null -> error \"impossible case\"\n>        DelNode q -> return (delete2 q x) \n>        nodeOrhead ->\n>         do let curPtr = next prevNode \n>            curNode <- readRef curPtr\n>            case curNode of\n>              Node {val = y, next= nextNode} ->\n>               if (y /= x) \n>               then return (delete2 curPtr x) \n>               else -- (delink node)\n>                 do writeRef curPtr (DelNode prevPtr)   -- add backpointer\n>                    case prevNode of\n>                      Head {} -> do writeRef prevPtr (Head {next = nextNode})\n>                                    return (return True)\n>                      Node {} -> do writeRef prevPtr\n>                                       (Node {val = val prevNode, next = nextNode})\n>                                    return (return True)\n>              Null -> return (return False)\n>              DelNode _ -> retryRef      \n>                   -- means that the prevNode points to next of delNode\n>                   -- we simply retry therefore\n>      }\n\n\nprinting and counting\n\n> printList :: (Show a, Ref r m) => ListHandle r a -> IO ()\n> printList (ListHandle {headList = ptrPtr}) =\n>  do startptr <- atomicRef (\n>          do ptr <- readRef ptrPtr\n>             Head {next = startptr} <- readRef ptr\n>             return startptr)\n>     printListHelp startptr\n\n\n> printListHelp :: (Show a, Ref r m) => r (List r a) -> IO ()\n> printListHelp curNodePtr =\n>   do { curNode <- atomicRef (readRef curNodePtr)\n>      ; case curNode of\n>          Null -> putStr \"Nil\"\n>          Node {val = curval, next = curnext} ->\n>             do { putStr (show curval  ++ \" -> \")\n>                ;  printListHelp curnext }\n>          DelNode curnext ->\n>             printListHelp curnext \n>      } \n\n> cntList :: (Show a, Ref r m) => ListHandle r a -> IO Int\n> cntList (ListHandle {headList = ptrPtr}) =\n>  do startptr <- atomicRef (\n>          do ptr <- readRef ptrPtr\n>             Head {next = startptr} <- readRef ptr\n>             return startptr)\n>     cntListHelp startptr 0\n\n> cntListHelp :: (Show a, Ref r m) => r (List r a) -> Int -> IO Int\n> cntListHelp curNodePtr i =\n>   do { curNode <- atomicRef (readRef curNodePtr)\n>      ; case curNode of\n>          Null -> return i\n>          Node {val = curval, next = curnext} ->\n>             cntListHelp curnext (i+1)\n>          DelNode curnext ->\n>             cntListHelp curnext i\n>      }\n\n", "num_lines": 186}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns,CPP #-}\nmodule CASList where\n\nimport Control.Monad\nimport Data.IORef\nimport Control.Concurrent\nimport Control.Concurrent.Chan\nimport System.Environment\nimport Data.Time\n\n-- #define USE_UNPACK\n-- #define USE_STRICT\n\n#if defined(USE_UNPACK)\n#define UNPACK(p) {-# UNPACK #-} !(p)\n#elif defined(USE_STRICT)\n#define UNPACK(p) !(p)\n#else\n#define UNPACK(p) p\n#endif\n\ndata List a = Node { val :: a\n                   , next :: UNPACK(IORef (List a)) }\n            | DelNode { next :: UNPACK(IORef (List a)) }\n            | Null\n            | Head { next :: UNPACK(IORef (List a)) } deriving Eq\n\ndata ListHandle a = ListHandle { headList :: UNPACK(IORef (IORef (List a))), \n                                 tailList :: UNPACK(IORef (IORef (List a))) }\n\n{-# INLINE myNext #-}\nmyNext :: List a -> IORef (List a)\nmyNext Node{next = n} = n\nmyNext DelNode{next = n} = n\nmyNext Head{next = n} = n\nmyNext _ = error \"myNext\"\n\n-- we assume a static head pointer, pointing to the first node which must be Head\n-- the deleted field of Head is always False, it's only there to make some of the code\n-- more uniform\n-- tail points to the last node which must be Null\n\n\ntype Iterator a = IORef (IORef (List a))\n\n\n-------------------------------------------\n-- auxiliary functions\n\n\n\nwhile b cmd = if b then do {cmd; while b cmd}\n              else return ()\n\nrepeatUntil cmd = do { b <- cmd; if b then return ()\n                                  else repeatUntil cmd }\n\natomCAS :: Eq a => IORef a -> a -> a -> IO Bool\natomCAS ptr old new =\n   atomicModifyIORef ptr (\\ cur -> if cur == old\n                                   then (new, True)\n                                   else (cur, False))\n\natomicWrite :: IORef a -> a -> IO ()\natomicWrite ptr x =\n   atomicModifyIORef ptr (\\ _ -> (x,()))\n\n\n----------------------------------------------\n-- functions operating on lists\n\n\n-- we create a new list\nnewList :: IO (ListHandle a)\nnewList = \n   do null <- newIORef Null\n      hd <- newIORef (Head {next = null })\n      hdPtr <- newIORef hd\n      tailPtr <- newIORef null\n      return (ListHandle {headList = hdPtr, tailList = tailPtr})\n\n\n-- we add a new node, by overwriting the null tail node\n-- we only need to adjust tailList but not headList because\n-- of the static Head\n-- we return the location of the newly added node\naddToTail :: Eq a => ListHandle a -> a -> IO ()\naddToTail (ListHandle {tailList = tailPtrPtr}) x =\n   do null <- newIORef Null\n      repeatUntil \n         (do tailPtr <- readIORef tailPtrPtr\n             b <- atomCAS tailPtr Null (Node {val = x, next = null})\n             return b )\n        -- we atomically update the tail\n        -- (by spinning on the tailPtr)\n      atomicWrite tailPtrPtr null\n\n\nfind :: Eq a => ListHandle a -> a -> IO Bool\nfind (ListHandle { headList = head }) x =\n  let go !prevPtr =\n           do prevNode <- readIORef prevPtr\n              let curPtr = myNext prevNode -- head/node/delnode have all next\n              curNode <- readIORef curPtr\n              case curNode of\n                Node {val = y, next = nextNode } ->\n                   if (x == y)\n                   then -- node found and alive \n                      return True\n                   else go curPtr -- continue\n                Null -> return False -- reached end of list\n                DelNode {next = nextNode } -> \n                         -- atomically delete curNode by setting the next of prevNode to next of curNode\n                         -- if this fails we simply move ahead\n                        case prevNode of\n                          Node {} -> do b <- atomCAS prevPtr prevNode (Node {val = val prevNode, \n                                                                             next = nextNode})\n                                        if b then go prevPtr\n                                         else go curPtr\n                          Head {} -> do b <- atomCAS prevPtr prevNode (Head {next = nextNode})\n                                        if b then go prevPtr \n                                         else go curPtr\n                          DelNode {} -> go curPtr    -- if parent deleted simply move ahead\n             {-\n                correct as well, but a deleted parent deleting a child is (for certain cases) a useless operation\n                                     do atomicModifyIORef prevPtr ( \\ cur -> (cur{next = nextNode},True))\n                                        go prevPtr\n              -}\n\n  in do startPtr <- readIORef head\n        go startPtr\n\n\n\n\ndelete :: Eq a => ListHandle a -> a -> IO Bool\ndelete (ListHandle { headList = head }) x =\n  let go prevPtr =\n        do do prevNode <- readIORef prevPtr\n              let curPtr = next prevNode -- head/node/delnode have all next\n              curNode <- readIORef curPtr\n              case curNode of\n                Node {val = y, next = nextNode } ->\n                   if (x == y)\n                   then -- node found and alive \n                      do b <- atomCAS curPtr curNode (DelNode {next = nextNode})\n                         if b then return True\n                          else go prevPtr -- spin\n                   else go curPtr -- continue\n                Null -> return False -- reached end of list\n                DelNode {next = nextNode } -> \n                         -- atomically delete curNode by setting the next of prevNode to next of curNode\n                         -- if this fails we simply move ahead\n                        case prevNode of\n                          Node {} -> do b <- atomCAS prevPtr prevNode (Node {val = val prevNode, \n                                                                             next = nextNode})\n                                        if b then go prevPtr\n                                         else go curPtr\n                          Head {} -> do b <- atomCAS prevPtr prevNode (Head {next = nextNode})\n                                        if b then go prevPtr \n                                         else go curPtr\n                          DelNode {} -> go curPtr    -- if parent deleted simply move ahead\n\n  in do startPtr <- readIORef head\n        go startPtr\n\n\n\n-- the iterator always points to the PREVIOUS node,\n-- recall that there's a static dummy new Head\n-- Assumption: iterators are private, \n-- ie they won't be shared among threads\nnewIterator :: ListHandle a -> IO (Iterator a)\nnewIterator (ListHandle {headList = hd}) =\n  do hdPtr <- readIORef hd\n     it <- newIORef hdPtr\n     return it\n\n-- we iterate through the list and return the first \"not deleted\" node\n-- we delink deleted nodes\n-- there's no need to adjust headList, tailList\n-- cause headList has a static Head and\n-- tailList points to Null\niterateList :: Eq a => Iterator a -> IO (Maybe (IORef (List a)))\niterateList itPtrPtr = \n  let go prevPtr =\n        do do prevNode <- readIORef prevPtr\n              let curPtr = next prevNode -- head/node/delnode have all next\n              curNode <- readIORef curPtr\n              case curNode of\n                Node {} -> do writeIORef itPtrPtr curPtr \n                                 -- adjust iterator\n                              return (Just curPtr)\n                Null -> return Nothing -- reached end of list\n                DelNode {next = nextNode} -> \n                         -- atomically delete curNode by setting the next of prevNode to next of curNode\n                         -- if this fails we simply move ahead\n                        case prevNode of\n                          Node {} -> do b <- atomCAS prevPtr prevNode (Node {val = val prevNode, \n                                                                             next = nextNode})\n                                        if b then go prevPtr\n                                         else go curPtr\n                          Head {} -> do b <- atomCAS prevPtr prevNode (Head {next = nextNode})\n                                        if b then go prevPtr \n                                         else go curPtr\n                          DelNode {} -> go curPtr    -- if parent deleted simply move ahead\n\n  in do startPtr <- readIORef itPtrPtr\n        go startPtr\n\n\n--printing and counting\n\nprintList :: Show a => ListHandle a -> IO ()\nprintList (ListHandle {headList = ptrPtr}) =\n  do startptr <- (\n          do ptr <- readIORef ptrPtr\n             Head {next = startptr} <- readIORef ptr\n             return startptr)\n     printListHelp startptr\n\n\nprintListHelp :: Show a => IORef (List a) -> IO ()\nprintListHelp curNodePtr =\n   do { curNode <- readIORef curNodePtr\n      ; case curNode of\n          Null -> putStr \"Nil\"\n          Node {val = curval, next = curnext} ->\n             do { putStr (show curval  ++ \" -> \")\n                ;  printListHelp curnext }\n          DelNode {next = curnext} ->\n             do { putStr (\"DEAD -> \")\n                ;  printListHelp curnext }\n      } \n\ncntList :: Show a => ListHandle a -> IO Int\ncntList (ListHandle {headList = ptrPtr}) =\n  do startptr <- (\n          do ptr <- readIORef ptrPtr\n             Head {next = startptr} <- readIORef ptr\n             return startptr)\n     cntListHelp startptr 0\n\n\ncntListHelp :: Show a => IORef (List a) -> Int -> IO Int\ncntListHelp curNodePtr i =\n   do { curNode <- readIORef curNodePtr\n      ; case curNode of\n          Null -> return i\n          Node {val = curval, next = curnext} -> \n                cntListHelp curnext (i+1)\n          DelNode {next = curnext} ->\n                cntListHelp curnext (i+1)\n      } \n", "num_lines": 255}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternGuards #-}\nmodule Main (main) where\n\nimport qualified Data.Map as M\nimport Data.Map (Map)\n\nimport System.Environment\nimport System.IO\nimport Text.Regex\nimport Data.List\nimport Control.Monad\nimport Data.Maybe\n\ntype RawResults = Map (String,Int) [Double]\n\nmain = do\n  [time,speedup] <- getArgs\n  s <- getContents\n  let raw = slurp_raw (lines s)\n      avg = M.map calc_average raw  \n\n  let keys = M.keys avg\n      modes = nub (map fst keys)\n      cores = sort (nub (map snd keys))\n  \n  h <- openFile time WriteMode\n  forM modes $ \\m -> do\n   hPutStrLn h (m ++ concatMap (',':) [ show (fromJust (M.lookup (m,n) avg))\n                                      | n <- cores ])\n  hClose h\n\n  let\n      baselines = M.fromList [ (m, fromJust (M.lookup (m,1) avg)) | m <- modes ]\n      spd = M.mapWithKey (calc_speedup baselines) avg\n\n  h <- openFile speedup WriteMode\n  forM modes $ \\m -> do\n   hPutStrLn h (m ++ concatMap (',':) [ show (fromJust (M.lookup (m,n) spd))\n                                      | n <- cores ])\n  hClose h\n\ncalc_average :: [Double] -> Double\ncalc_average = foldl f 0 . zip [(1::Int)..]\n  where f mean (i,x) = mean + (x - mean) / fromIntegral i\n\ncalc_speedup :: Map String Double -> (String,Int) -> Double -> Double\ncalc_speedup baselines (mode,_) result = base / result\n  where Just base = M.lookup mode baselines\n\nslurp_raw :: [String] -> RawResults\nslurp_raw lines = add_results (\"\",1) M.empty lines\n  where\n    add_results m results [] = results\n    add_results m results (line:lines)\n      | Just [mode,cores] <- matchRegex header line\n      = add_results (mode, read cores :: Int) results lines\n      | Just [time] <- matchRegex result line\n      = let t = read time :: Double in\n        add_results m (M.insertWith (\\_ o -> t:o) m [t] results) lines\n      | otherwise\n      = add_results m results lines\n\nheader = mkRegex \"run\\\\.([^\\\\.]*)\\\\.N([0-9]*)\"\nresult = mkRegex \"time: ([0-9\\\\.]+)s\"\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\nmodule Collection where\n\n\nclass Show e => Col c e | c -> e where\n   newCol :: IO c\n   insertCol :: c -> e -> IO ()\n   deleteCol :: c -> e -> IO Bool\n   findCol :: c -> e -> IO Bool\n   printCol :: c -> IO ()\n   cntCol :: c -> IO Int\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP,PatternGuards #-}\nmodule ImmList where\n\nimport Control.Concurrent\nimport Data.IORef\nimport qualified Data.Sequence as S\nimport Data.Sequence (Seq, (|>), (<|), (><), ViewL(..))\nimport Data.Maybe\nimport Data.Foldable\n\n#if 0\nnewtype ListHandle a = ListHandle (IORef (Seq a))\n\nnewList :: IO (ListHandle a)\nnewList = do\n  r <- newIORef S.empty\n  return (ListHandle r)\n\naddToTail :: Eq a => ListHandle a -> a -> IO ()\naddToTail (ListHandle r) x = \n  atomicModifyIORef r $ \\s -> (s |> x, ())\n\nfind :: Eq a => ListHandle a -> a -> IO Bool\nfind (ListHandle r) x = do\n  s <- readIORef r\n  return (isJust (S.elemIndexL x s))\n\ndelete :: Eq a => ListHandle a -> a -> IO Bool\ndelete (ListHandle r) x = atomicModifyIORef r $ \\s ->\n  case S.breakl (== x) s of\n    (xs, ys) | c :< zs <- S.viewl ys, c == x -> (xs >< zs, True)\n             | otherwise                     -> (xs >< ys, False)\n\nprintList :: Show a => ListHandle a -> IO ()\nprintList (ListHandle r) = do\n  s <- readIORef r\n  print (toList s)\n\ncntList :: Show a => ListHandle a -> IO Int\ncntList (ListHandle r) = readIORef r >>= return . S.length\n#else\nnewtype ListHandle a = ListHandle (IORef [a])\n\nnewList :: IO (ListHandle a)\nnewList = do\n  r <- newIORef []\n  return (ListHandle r)\n\naddToTail :: Eq a => ListHandle a -> a -> IO ()\naddToTail (ListHandle r) x = \n  atomicModifyIORef r $ \\s -> (s ++ [x], ())\n\nfind :: Eq a => ListHandle a -> a -> IO Bool\nfind (ListHandle r) x = do\n  s <- readIORef r\n  return (x `Prelude.elem` s)\n\ndelete :: Eq a => ListHandle a -> a -> IO Bool\ndelete (ListHandle r) x = atomicModifyIORef r $ \\s ->\n  case break (== x) s of\n    (xs, ys) | (c:zs) <- ys, c == x -> (xs ++ zs, True)\n             | otherwise            -> (xs ++ ys, False)\n\nprintList :: Show a => ListHandle a -> IO ()\nprintList (ListHandle r) = do\n  s <- readIORef r\n  print s\n\ncntList :: Show a => ListHandle a -> IO Int\ncntList (ListHandle r) = readIORef r >>= return . length\n#endif\n", "num_lines": 72}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "> {-# LANGUAGE BangPatterns,CPP #-}\n> module IOList where\n\n-- #define USE_UNPACK\n-- #define USE_STRICT\n\n#if defined(USE_UNPACK)\n#define UNPACK(p) {-# UNPACK #-} !(p)\n#elif defined(USE_STRICT)\n#define UNPACK(p) !(p)\n#else\n#define UNPACK(p) p\n#endif\n\n> import Data.IORef\n\n\n> data List a = Node { val :: a, next :: UNPACK(IORef (List a))}   \n>           | Null\n>           | Head {next :: UNPACK(IORef (List a)) }\n\n> data ListHandle a = ListHandle { headList :: UNPACK(IORef (IORef (List a))),\n>                            tailList :: UNPACK(IORef (IORef (List a))) }\n\n> atomically = \\x -> x\n\n\n> -- we create a new list\n> newList :: IO (ListHandle a)\n> newList = \n>   do null <- newIORef Null\n>      hd <- newIORef (Head {next = null })\n>      hdPtr <- newIORef hd\n>      tailPtr <- newIORef null\n>      return (ListHandle {headList = hdPtr, tailList = tailPtr})\n  \n> find ::  Eq a => ListHandle a -> a -> IO Bool\n> find (ListHandle {headList = ptrPtr})  i =  do \n>  ptr <- readIORef ptrPtr\n>  Head {next = startptr} <- readIORef ptr\n>  find2 startptr i \n>   where \n>    find2 :: Eq a => IORef (List a) -> a -> IO Bool\n>    find2 curNodePtr i = do\n>    { curNode <- readIORef curNodePtr\n>    ; case curNode of\n>        Null -> return False  -- we've reached the end of the list\n>                              -- element not found\n>        Node {val = curval, next = curnext} ->\n>          if (curval == i) then return True -- element found\n>          else find2 curnext i              -- keep searching\n>    }\n \n\n> -- we add a new node, by overwriting the null tail node\n> -- we only need to adjust tailList but not headList because\n> -- of the static Head\n> -- we return the location of the newly added node\n> addToTail :: ListHandle a -> a -> IO (IORef (List a))\n> addToTail (ListHandle {tailList = tailPtrPtr}) x =\n>   do tPtr <- atomically (\n>                do null <- newIORef Null\n>                   tailPtr <- readIORef tailPtrPtr\n>                   writeIORef tailPtr (Node {val = x, next = null})\n>                   writeIORef tailPtrPtr null\n>                   return tailPtr\n>              )\n>      return tPtr\n\n\n> delete :: Eq a => ListHandle a -> a -> IO Bool\n> delete (ListHandle {headList = ptrPtr})  i = \n>  atomically (\n>          do startptr <- readIORef ptrPtr\n>             delete2 startptr i)\n>   where\n>    delete2 :: Eq a => IORef (List a) -> a -> IO Bool\n>    delete2 prevPtr i =\n>     do\n>    { prevNode <- readIORef prevPtr\n>    ; let curNodePtr = next prevNode --  head/node have both next \n>    ; curNode <- readIORef curNodePtr\n>    ; case curNode of\n>        Null -> return False  -- we've reached the end of the list\n>                              -- element not found\n>        Node {val = curval, next = nextNode} ->\n>          if (curval /= i) \n>           then delete2 curNodePtr i         -- keep searching\n>           else \n>               -- delete element (ie delink node)\n>               do { case prevNode of\n>                      Head {} -> do writeIORef prevPtr (Head {next = nextNode})\n>                                    return True\n>                      Node {} -> do writeIORef prevPtr\n>                                       (Node {val = val prevNode, next = nextNode})\n>                                    return True\n>                  }\n>     }\n\n\nprinting and counting\n\n> printList :: Show a => ListHandle a -> IO ()\n> printList (ListHandle {headList = ptrPtr}) =\n>   do startptr <- (\n>          do ptr <- readIORef ptrPtr\n>             Head {next = startptr} <- readIORef ptr\n>             return startptr)\n>      printListHelp startptr\n\n\n> printListHelp :: Show a => IORef (List a) -> IO ()\n> printListHelp curNodePtr =\n>   do { curNode <- readIORef curNodePtr\n>      ; case curNode of\n>          Null -> putStr \"Nil\"\n>          Node {val = curval, next = curnext} ->\n>             do { putStr (show curval  ++ \" -> \")\n>                ;  printListHelp curnext }\n>      } \n\n> cntList :: Show a => ListHandle a -> IO Int\n> cntList (ListHandle {headList = ptrPtr}) =\n>  do startptr <- (\n>          do ptr <- readIORef ptrPtr\n>             Head {next = startptr} <- readIORef ptr\n>             return startptr)\n>     cntListHelp startptr 0\n\n\n> cntListHelp :: Show a => IORef (List a) -> Int -> IO Int\n> cntListHelp curNodePtr i =\n>   do { curNode <- readIORef curNodePtr\n>      ; case curNode of\n>          Null -> return i\n>          Node {val = curval, next = curnext} -> \n>                cntListHelp curnext (i+1)\n>      } \n", "num_lines": 139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n> {-# LANGUAGE UndecidableInstances, PatternSignatures, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}\n\n> module Main where\n\n> import Data.IORef\n> import Control.Concurrent\n> --import Control.Concurrent.STM\n> import System.Environment\n> import Data.Time\n\n> import System.Mem\n> import Data.List\n\n> import Collection\n> import RefInterface\n\n> import TestData\n> import TestRun\n\n-- the contenders (we can run stand-alone for a fixed test case mainPar)\n\n> import qualified CASList as CAS\n>-- import qualified CASusingSTMList as CASusingSTM\n> import qualified MVarListLockCoupling as MLC\n>-- import qualified MVarusingSTM as MLCusingSTM\n>-- import qualified LazyList2 as Lazy\n> import qualified IOList as I\n>-- import qualified STMList as S\n> import qualified ImmList as IMM\n\n\ncreate List\n\n> createList :: Col c e => [e] -> IO c\n> createList n = \n>   do nl <- newCol\n>      mapM (insertCol nl) n\n>      return nl\n\n\n\n> createTasks :: [a] -> [Op a]\n> createTasks xs = task 1 xs\n>   where\n>     insCnt = 5   -- every 5th op is insert\n>     delCnt = 9   -- ever 9th op is delete\n>     task _ [] = []\n>     task cnt (x:xs) \n>       | (cnt `mod` insCnt) == 0 = (Insert x) : task (cnt+1) xs\n>       | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs\n>       | otherwise             = (Find x) : task (cnt+1) xs\n\n\n\nmainly finds, some deletes which will be inserted again\n\n> specificTask1 :: [a] -> [Op a]\n> specificTask1 xs = task 1 xs []\n>   where\n>     delCnt = 6   -- every 6th op is delete\n>     insCnt = 50   -- after 5 deletes we'll insert them again\n>     task _ [] _ = []\n>     task cnt (x:xs) deletes \n>       | length deletes == insCnt =  map Insert deletes ++ task (cnt+1) (x:xs) []\n>       | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs (x:deletes)\n>       | otherwise             = (Find x) : task (cnt+1) xs deletes\n\n> executeTasks :: Col c e => c -> [Op e] -> IO ()\n> executeTasks lh ops =\n>  do mapM (\\ task -> \n>           case task of\n>              Find x -> do { findCol lh x; return () }\n>              Insert x -> do { insertCol lh x; return () }\n>              Delete x -> do { deleteCol lh x; return () })\n>          ops\n>     return ()\n\n  put number into threads buckets\n\n> distribution :: [Int] -> Int -> [[Int]]\n> distribution no threads =\n>   let init = map (\\ _ -> []) [1..threads]\n>       go :: [Int] -> Int -> [[Int]] -> [[Int]]\n>       go [] _ acc = acc\n>       go (x:xs) cnt acc = \n>          let idx = cnt `mod` threads\n>              acc' = take idx acc ++ [x : (acc !! idx)] ++ drop (idx+1) acc\n>          in go xs (cnt+1) acc'\n>  \n>   in go no 1 init           \n\n\nrunnable version\n\n main = mainPar\n\nparallel version\n\n> type RUN = CAS.ListHandle Int\n\n> main :: IO ()\n> main = \n>  do args <- getArgs\n>     case args of\n>      (mode:\"-t\":in_fname:rest) -> run_testdata in_fname mode\n>--      [mode, t, l] -> \n>--        do let len = read l :: Int\n>--           let threads = read t :: Int\n>--           let run nl = mainPar nl threads len\n>--           case mode of\n>--            \"CAS\"   -> do nl :: CAS.ListHandle Int <- createList [0..len]\n>--                          run nl\n>--            \"CASusingSTM\"   -> do nl :: CASusingSTM.ListHandle Int <- createList [0..len]\n>--                                  run nl\n>--            \"LAZY\" -> do nl :: Lazy.ListHandle Int <- createList [0..len]\n>--                         run nl\n>--            \"MLC\" -> do nl :: MLC.ListHandle Int <- createList [0..len] \n>--                        run nl\n>--            \"MLCusingSTM\" -> do nl :: MLCusingSTM.ListHandle Int <- createList [0..len] \n>--                                run nl\n>--            \"IO\" -> do nl  :: I.ListHandle Int <- createList [0..len]\n>--                       run nl\n>--            \"STM\" -> do nl  :: S.ListHandle Int <- createList [0..len]\n>--                        run nl\n>--            \"IMM\" -> do nl  :: IMM.ListHandle Int <- createList [0..len]\n>--                        run nl\n        \n\n\n mainPar :: Col c Int => c -> Int -> Int -> IO ()\n mainPar nl threads len =\n  do let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n                   ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n     let ds = distribution numbers threads\n     let ts = ds\n     wait <- atomically (newTVar 0)\n     putStrLn \"Start\"\n     start <- getCurrentTime\n     mapM (\\ t -> forkIO (do executeTasks nl (specificTask1 t)\n                             atomically(do counter <- readTVar wait\n                                           writeTVar wait (counter+1))))\n          ts\n     atomically ( do counter <- readTVar wait\n                     if counter < threads then retry \n                      else return () )\n     fin <- getCurrentTime\n     putStrLn \"Done\"\n     putStrLn $ \"Time: \" ++ show (diffUTCTime fin start)\n\n\n\n mainPar2 nl len =\n   do cnt <- atomically (newTVar 0)\n      printCol nl\n      mapM (\\ e -> forkIO ( do insertCol nl e\n                               atomically(do i <- readTVar cnt\n                                             writeTVar cnt (i+1))))\n           [6..len]\n\n      atomically ( do i <- readTVar cnt\n                      if i <= len-6 then retry \n                       else return () )\n\n      printCol nl\n      n <- cntCol nl\n      putStrLn $ \"Overall: \" ++ show n\n\n\nsequential version\n  \n> mainSeq nl len = \n>  do let threads = 4\n>     let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n>                   ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n>     let [d1,d2,d3,d4] = distribution numbers threads\n>     let t1 = d1++d2++d3++d4\n>     let t2 = d2++d3++d4++d1\n>     let t3 = d3++d4++d1++d2\n>     let t4 = d4++d1++d2++d3\n>     putStrLn \"Start\"\n>     start <- getCurrentTime\n>     mapM (\\ t -> executeTasks nl (specificTask1 t)) [t1,t2,t3,t4]\n>     fin <- getCurrentTime\n>     putStrLn \"Done\"\n>     putStrLn $ \"Time: \" ++ show (diffUTCTime fin start)\n\n\njust testing\n\n> mainTest nl len =\n>  do \n>     printCol nl   \n\n      r <- deleteCol nl 3\n      putStrLn (\"Result : \" ++ show r)\n      find nl 10\n\n>     insertCol nl 11\n\n>     deleteCol nl 3\n>     findCol nl 11\n\n\n>     mapM (\\x -> forkIO (insertCol nl x)) [12..50]\n\n>     threadDelay 1000000\n\n> {-\n>     putStrLn \"Start\"\n>     executeTasks nl $ createTasks [1..len]\n>     find nl (len+1) -- we try to find a non-existent element\n>                     -- this way, in the LazyList case, we will physically delete all (logically deleted) elements \n> -}\n>     putStrLn \"End\"\n>     printCol nl\n\n", "num_lines": 218}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n> module Main where\n\n> import Data.IORef\n> import Control.Concurrent\n> --import Control.Concurrent.STM\n> import System.Environment\n> import Data.Time\n\n\n> import MVarList\n\n\nprinting \n\n> printList :: Show a => ListHandle a -> IO ()\n> printList (ListHandle {headList = ptrPtr}) =\n>  do startptr <- (\n>          do ptr <- readIORef ptrPtr\n>             Head {next = startptr} <- readMVar ptr\n>             return startptr)\n>     printListHelp startptr\n\n\n> printListHelp :: Show a => MVar (List a) -> IO ()\n> printListHelp curNodePtr =\n>   do { curNode <- readMVar curNodePtr\n>      ; case curNode of\n>          Null -> putStr \"Nil\"\n>          Node {val = curval, next = curnext} ->\n>             do { putStr (show curval  ++ \" -> \")\n>                ;  printListHelp curnext }\n>          DelNode {val = curval, next = curnext} ->\n>             do { putStr (show curval  ++ \"DEAD -> \")\n>                ;  printListHelp curnext }\n>      } \n\n> cntList :: Show a => ListHandle a -> IO Int\n> cntList (ListHandle {headList = ptrPtr}) =\n>  do startptr <- (\n>          do ptr <- readIORef ptrPtr\n>             Head {next = startptr} <- readMVar ptr\n>             return startptr)\n>     cntListHelp startptr 0\n\n\n> cntListHelp :: Show a => MVar (List a) -> Int -> IO Int\n> cntListHelp curNodePtr i =\n>   do { curNode <- readMVar curNodePtr\n>      ; case curNode of\n>          Null -> return i\n>          Node {val = curval, next = curnext} -> \n>                cntListHelp curnext (i+1)\n>          DelNode {val = curval, next = curnext} ->\n>                cntListHelp curnext (i+1)\n>      } \n\n\ncreate List\n\n> createList :: Int -> IO (ListHandle Int)\n> createList n =\n>   do nl <- newList\n>      mapM (addToTail nl) [1..n]\n>      return nl\n\n\n> data Op a = Find a | Insert a | Delete a deriving Show\n        \n\n> createTasks :: [a] -> [Op a]\n> createTasks xs = task 1 xs\n>   where\n>     insCnt = 5   -- every 5th op is insert\n>     delCnt = 9   -- ever 9th op is delete\n>     task _ [] = []\n>     task cnt (x:xs) \n>       | (cnt `mod` insCnt) == 0 = (Insert x) : task (cnt+1) xs\n>       | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs\n>       | otherwise             = (Find x) : task (cnt+1) xs\n\n\n\nmainly finds, some deletes which will be inserted again\n\n> specificTask1 :: [a] -> [Op a]\n> specificTask1 xs = task 1 xs []\n>   where\n>     delCnt = 5   -- every 6th op is delete\n>     insCnt = 50   -- after 5 deletes we'll insert them again\n>     task _ [] _ = []\n>     task cnt (x:xs) deletes \n>       | length deletes == insCnt =  map Insert deletes ++ task (cnt+1) (x:xs) []\n>       | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs (x:deletes)\n>       | otherwise             = (Find x) : task (cnt+1) xs deletes\n\n> executeTasks :: Eq a => ListHandle a -> [Op a] -> IO ()\n> executeTasks lh ops =\n>  do mapM (\\ task -> \n>           case task of\n>              Find x -> do { find lh x; return () }\n>              Insert x -> do { addToTail lh x; return () }\n>              Delete x -> do { delete lh x; return () })\n>          ops\n>     return ()\n\n  put number into threads buckets\n\n> distribution :: [Int] -> Int -> [[Int]]\n> distribution no threads =\n>   let init = map (\\ _ -> []) [1..threads]\n>       go :: [Int] -> Int -> [[Int]] -> [[Int]]\n>       go [] _ acc = acc\n>       go (x:xs) cnt acc = \n>          let idx = cnt `mod` threads\n>              acc' = take idx acc ++ [x : (acc !! idx)] ++ drop (idx+1) acc\n>          in go xs (cnt+1) acc'\n>  \n>   in go no 1 init           \n\n> insert :: Eq a => ListHandle a -> a -> IO ()\n> insert = addToTail\n\n\nrunnable version\n\n> main = mainPar\n\nparallel version\n\n> mainPar :: IO ()\n> mainPar =\n>  do let len = 3000\n>     let threads = 4\n>     nl <- createList len\n>     let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n>                   ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n>     let [d1,d2,d3,d4] = distribution numbers threads\n>     let t1 = d1++d2++d3++d4\n>     let t2 = d2++d3++d4++d1\n>     let t3 = d3++d4++d1++d2\n>     let t4 = d4++d1++d2++d3\n>     wait <- atomically (newTVar 0)\n>     putStrLn \"Start\"\n>     start <- getCurrentTime\n>     mapM (\\ t -> forkIO (do executeTasks nl (specificTask1 t)\n>                             atomically(do counter <- readTVar wait\n>                                           writeTVar wait (counter+1))))\n>          [t1,t2,t3,t4]\n>     atomically ( do counter <- readTVar wait\n>                     if counter < 4 then retry \n>                      else return () )\n>     fin <- getCurrentTime\n>     putStrLn \"Done\"\n>     putStrLn $ \"Time: \" ++ show (diffUTCTime fin start)\n\n\n> mainPar2 :: IO ()\n> mainPar2 =\n>   do nl <- createList 5\n>      let len = 5 + 200\n>      cnt <- atomically (newTVar 0)\n>      printList nl\n>      mapM (\\ e -> forkIO ( do insert nl e\n>                               atomically(do i <- readTVar cnt\n>                                             writeTVar cnt (i+1))))\n>           [6..len]\n\n>      atomically ( do i <- readTVar cnt\n>                      if i <= len-6 then retry \n>                       else return () )\n\n>      printList nl\n>      n <- cntList nl\n>      putStrLn $ \"Overall: \" ++ show n\n\n\nsequential version \n  \n> mainSeq :: IO ()\n> mainSeq = \n>  do let len = 3000\n>     let threads = 4\n>     nl <- createList len\n>     let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n>                   ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])\n>     let [d1,d2,d3,d4] = distribution numbers threads\n>     let t1 = d1++d2++d3++d4\n>     let t2 = d2++d3++d4++d1\n>     let t3 = d3++d4++d1++d2\n>     let t4 = d4++d1++d2++d3\n>     putStrLn \"Start\"\n>     start <- getCurrentTime\n>     mapM (\\ t -> executeTasks nl (specificTask1 t)) [t1,t2,t3,t4]\n>     fin <- getCurrentTime\n>     putStrLn \"Done\"\n>     putStrLn $ \"Time: \" ++ show (diffUTCTime fin start)\n\n\njust testing\n\n> mainTest2 :: IO ()\n> mainTest2 =\n>  do let len = 10\n>     nl <- createList len\n>     printList nl\n>     addToTail nl 1\n>     printList nl   \n\n> mainTest :: IO ()\n> mainTest =\n>  do let len = 10\n>     nl <- createList len\n>     printList nl   \n\n      r <- delete nl 3\n      putStrLn (\"Result : \" ++ show r)\n      find nl 10\n\n>     insert nl 11\n\n>     delete nl 3\n>     find nl 11\n\n\n>     mapM (\\x -> forkIO (insert nl x)) [12..50]\n\n>     threadDelay 1000000\n\n> {-\n>     putStrLn \"Start\"\n>     executeTasks nl $ createTasks [1..len]\n>     find nl (len+1) -- we try to find a non-existent element\n>                     -- this way, in the LazyList case, we will physically delete all (logically deleted) elements \n> -}\n>     putStrLn \"End\"\n>     printList nl\n", "num_lines": 238}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns,CPP #-}\nmodule MVarListLockCoupling where\n\nimport Control.Monad\nimport Data.IORef\nimport Control.Concurrent\nimport Control.Concurrent.Chan\nimport System.Environment\nimport Data.Time\n\n\n-- #define USE_UNPACK\n-- #define USE_STRICT\n\n#if defined(USE_UNPACK)\n#define UNPACK(p) {-# UNPACK #-} !(p)\n#elif defined(USE_STRICT)\n#define UNPACK(p) !(p)\n#else\n#define UNPACK(p) p\n#endif\n\n\ndata List a = Node { val :: a\n                   , next :: UNPACK(MVar (List a)) }\n            | Null\n            | Head { next :: UNPACK(MVar (List a)) } deriving Eq\n\ndata ListHandle a = ListHandle { headList :: IORef (MVar (List a)), \n                             tailList :: IORef (MVar (List a)) }\n\n\n-- we assume a static head pointer, pointing to the first node which must be Head\n-- the deleted field of Head is always False, it's only there to make some of the code\n-- more uniform\n-- tail points to the last node which must be Null\n\n-- head is static, therefore IORef\n-- tail will be adjusted, therefore MVar\n\n\ntype Iterator a = IORef (MVar (List a))\n\n-- iterators are private\n\n-------------------------------------------\n-- auxiliary functions\n\n\n\nwhile b cmd = if b then do {cmd; while b cmd}\n              else return ()\n\nrepeatUntil cmd = do { b <- cmd; if b then return ()\n                                  else repeatUntil cmd }\n\natomCAS :: Eq a => IORef a -> a -> a -> IO Bool\natomCAS ptr old new =\n   atomicModifyIORef ptr (\\ cur -> if cur == old\n                                   then (new, True)\n                                   else (cur, False))\n\natomicWrite :: IORef a -> a -> IO ()\natomicWrite ptr x =\n   atomicModifyIORef ptr (\\ _ -> (x,()))\n\n\n----------------------------------------------\n-- functions operating on lists\n\n\n-- we create a new list\nnewList :: IO (ListHandle a)\nnewList = \n   do null <- newMVar Null\n      hd <- newMVar (Head {next = null })\n      hdPtr <- newIORef hd\n      tailPtr <- newIORef null\n      return (ListHandle {headList = hdPtr, tailList = tailPtr})\n\n\n-- we add a new node, by overwriting the null tail node\n-- we only need to adjust tailList but not headList because\n-- of the static Head\n-- we return the location of the newly added node\naddToTail :: Eq a => ListHandle a -> a -> IO ()\naddToTail (ListHandle {tailList = tailPtrPtr}) x =\n   do null <- newMVar Null\n      tailPtr <- readIORef tailPtrPtr\n      takeMVar tailPtr\n      writeIORef tailPtrPtr null \n      putMVar tailPtr (Node {val = x, next = null})\n\n\nfind :: Eq a => ListHandle a -> a -> IO Bool\nfind (ListHandle { headList = head }) x =\n  let go prevPtr prevNode =\n           do let curPtr = next prevNode -- head/node/delnode have all next\n              curNode <- takeMVar curPtr\n              case curNode of\n                Node {val = y, next = nextNode } ->\n                   if (x == y)\n                   then -- node found \n                      do putMVar prevPtr prevNode\n                         putMVar curPtr curNode\n                         return True\n                   else \n                      do putMVar prevPtr prevNode\n                         go curPtr curNode -- continue\n                Null -> do putMVar prevPtr prevNode\n                           putMVar curPtr curNode\n                           return False -- reached end of list\n  in do startPtr <- readIORef head\n        startNode <- takeMVar startPtr\n        go startPtr startNode\n\ndelete :: Eq a => ListHandle a -> a -> IO Bool\ndelete (ListHandle { headList = head }) x =\n  let go prevPtr prevNode =\n        do do let curPtr = next prevNode -- head/node/delnode have all next\n              curNode <- takeMVar curPtr\n              case curNode of\n                Node {val = y, next = nextNode } ->\n                   if (x == y)\n                   then -- delink node\n                     do case prevNode of\n                          Node {} -> do putMVar prevPtr (Node {val = val prevNode, \n                                                               next = nextNode})\n                                        putMVar curPtr curNode\n                                        return True\n                          Head {} -> do putMVar prevPtr (Head {next = nextNode})\n                                        putMVar curPtr curNode\n                                        return True\n                   else do putMVar prevPtr prevNode                         \n                           go curPtr curNode -- continue\n                Null -> do putMVar curPtr curNode\n                           putMVar prevPtr prevNode                         \n                           return False -- reached end of list\n\n  in do startPtr <- readIORef head\n        startNode <- takeMVar startPtr\n        go startPtr startNode\n\n\n\n--printing and counting\n\nprintList :: Show a => ListHandle a -> IO ()\nprintList (ListHandle {headList = ptrPtr}) =\n  do startptr <- (\n          do ptr <- readIORef ptrPtr\n             Head {next = startptr} <- readMVar ptr\n             return startptr)\n     printListHelp startptr\n\n\nprintListHelp :: Show a => MVar (List a) -> IO ()\nprintListHelp curNodePtr =\n   do { curNode <- readMVar curNodePtr\n      ; case curNode of\n          Null -> putStr \"Nil\"\n          Node {val = curval, next = curnext} ->\n             do { putStr (show curval  ++ \" -> \")\n                ;  printListHelp curnext }\n      } \n\ncntList :: Show a => ListHandle a -> IO Int\ncntList (ListHandle {headList = ptrPtr}) =\n  do startptr <- (\n          do ptr <- readIORef ptrPtr\n             Head {next = startptr} <- readMVar ptr\n             return startptr)\n     cntListHelp startptr 0\n\n\ncntListHelp :: Show a => MVar (List a) -> Int -> IO Int\ncntListHelp curNodePtr i =\n   do { curNode <- readMVar curNodePtr\n      ; case curNode of\n          Null -> return i\n          Node {val = curval, next = curnext} -> \n                cntListHelp curnext (i+1)\n      } \n", "num_lines": 184}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\nmodule RefInterface where\n\n\nimport Control.Monad\n\n\n\nclass Monad m => Ref r m | m -> r, r -> m where\n   newRef :: a -> m (r a)\n   readRef :: (r a) -> m a\n   writeRef :: (r a) -> a -> m ()\n   atomicRef :: m a -> IO a\n   retryRef :: m a\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TestData where\n\n-- Test Data Data Type\n\n-- Operation Tokens\ndata Op a = Find a | Delete a | Insert a deriving Show\n\n-- A test Data.\n--    t_name : Name of the test data.\n--    t_threads : Number of concurrent threads to run\n--    t_modes   : Concurrent modes selected. Multiple modes\n--               will be batch tested in specified sequence\n--    t_repeats : Number of runs to conduct on each mode.\n--    t_init_list : Elements of the initial list\n--    t_tasks : Sequence of operation each node\n--              executes. Note this must correspond to\n--              number of threads. \ndata TestData a = TestData { t_name      :: String\n                           , t_threads   :: Int\n                           , t_init_list :: [a]\n                           , t_tasks     :: [[Op a]] }         \n \ninstance Show a => Show (TestData a) where\n  show tc = \"Name: \" ++ (t_name tc) ++ \"\\n\" ++\n            \"Threads: \" ++ (show $ t_threads tc) ++ \"\\n\" ++\n            \"Initial-List:\\n\" ++ (show $ t_init_list tc) ++ \"\\n\" ++\n            \"Tasks:\\n\" ++ (printOps $ t_tasks tc) \n            where\n              printOps (op:ops) = (show op) ++ \"\\n\" ++ (printOps ops)\n              printOps [] = \"\"\n              \n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TestDataParser (\n   parse_testdata, -- Read a => FilePath -> IO (TestData a)\n   write_testdata  -- Show a => TestData -> IO ()\n) where\n\nimport TestData\n\n-- Parser for parsing TestData. The following is a sample of a test data: \n--\n--\n-- Name: sample\n-- Threads: 4\n-- Modes: [\"CAS\",\"IO\",\"BACK\"]\n-- Repeat: 6\n-- Initial-List: \n-- [4,5,6,7,8,4,5,754,345,23432,6547,4]\n-- Tasks: \n-- [Find 3,Delete 4,Insert 34,Find 45]\n-- [Delete 34,Insert 43,Delete 3,Delete 45,Find 87]\n-- [Insert 3 , Find 6]\n-- [Find 3,Find 67,  Insert 3]\n--\n--\n-- Some assumptions:\n--   - Number of tasks must correspond to number of threads.\n--   - Fields must come in the exact sequence specified above.\n\n-- Auxiliary Functions\n\npartitionAt :: Eq a => (a -> Bool) -> [a] -> [[a]]\npartitionAt f as = \n  filter (/=[]) (partitionAt' f as)\n  where\n    partitionAt' _ [] = []\n    partitionAt' f as = let (v,rest) = span f as\n                        in v:(partitionAt' f (drop 1 rest))\n              \nis_delimit :: Char -> Bool\nis_delimit ' '  = True\nis_delimit '\\n' = True\nis_delimit _    = False\n              \nnot_delimit :: Char -> Bool\nnot_delimit x = not (is_delimit x)\n\n-- Parsing Functions\n\nparse_token :: String -> (String,String)\nparse_token str = let str' = dropWhile is_delimit str \n                  in span not_delimit str'\n\nparse_list :: String -> ([String],String)\nparse_list str = \n   let str' = dropWhile is_delimit str\n   in parse_list (tail str')\n   where\n     parse_list str = let comma x = x == ','\n                          close x = x == ']'\n                          commaOrClose x = or [comma x,close x]\n                          (a,rest)   = span (\\x -> not $ commaOrClose x) str\n                      in case head rest of\n                           ',' -> let (as,rest') = parse_list (tail rest)\n                                  in (a:as,rest')\n                           ']' -> ([a],tail rest)                         \n\nparse_list_many :: Int -> String -> ([[String]],String)\nparse_list_many 0 str = ([],str)\nparse_list_many n str = let (a,rest)   = parse_list str\n                            (as,rest') = parse_list_many (n-1) rest\n                        in (a:as,rest')\n                    \ndrop_token :: String -> String\ndrop_token str = let (_,rest) = parse_token str\n                 in rest              \n      \n-- Main function for parseing testcases from file              \nparse_testdata :: Read a => FilePath -> IO (TestData a)\nparse_testdata fname = do\n  { input <- readFile fname\n  ; let (name,input1) = parse_token (drop_token input)\n        (t,input2)    = parse_token (drop_token input1)\n        (list,input3) = parse_list (drop_token input2)\n        (ops,_)       = parse_list_many (read t) (drop_token input3)\n  ; return $ TestData { t_name    = name\n                      , t_threads = read t\n                      , t_init_list = map read list\n                      , t_tasks   = map readops ops } }\n  where\n    readops (s:ss) = let (oper,rest) = parse_token s\n                         (arg,_)     = parse_token rest\n                         x  = read arg\n                         op = case oper of\n                               \"Find\"   -> Find x\n                               \"Delete\" -> Delete x\n                               \"Insert\" -> Insert x\n                               _        -> error (\"parse_testdata: \" ++ oper ++ \"\\n\" ++ rest ++ \"\\n\" ++ arg)\n                     in op:(readops ss) \n    readops [] = []\n    \n-- Main function for writing test data to file\nwrite_testdata :: Show a => TestData a -> IO ()\nwrite_testdata tc = writeFile (t_name tc) (show tc) \n", "num_lines": 104}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UndecidableInstances, PatternSignatures, FlexibleInstances, MultiParamTypeClasses #-}\n\nmodule TestRun (\n   run_testdata  -- FilePath -> FilePath -> IO ()\n) where\n\nimport TestData\nimport TestDataParser\nimport Collection\n\nimport Control.Monad\nimport GHC.Conc\nimport Text.Printf\nimport Data.List\nimport Data.IORef\nimport Control.Concurrent\n--import Control.Concurrent.STM\nimport System.Environment\nimport Data.Time\nimport System.Mem\nimport System.Random\nimport Control.Exception\n\n-- the contenders\nimport qualified CASList as CAS\nimport qualified ImmList as IMM\n--import qualified CASusingSTMList as CASusingSTM\nimport qualified MVarListLockCoupling as MLC\n--import qualified MVarusingSTM as MLCusingSTM\n--import qualified LazyList2 as Lazy\nimport qualified IOList as I\n--import qualified STMList as S\n\n\n\ninstance (Eq e, Show e) => Col (CAS.ListHandle e) e where\n   newCol = CAS.newList\n   insertCol c e = do CAS.addToTail c e\n                      return ()\n   deleteCol = CAS.delete\n   findCol = CAS.find\n   printCol = CAS.printList\n   cntCol = CAS.cntList\n\ninstance (Eq e, Show e) => Col (IMM.ListHandle e) e where\n   newCol = IMM.newList\n   insertCol c e = do IMM.addToTail c e\n                      return ()\n   deleteCol = IMM.delete\n   findCol = IMM.find\n   printCol = IMM.printList\n   cntCol = IMM.cntList\n\n--instance (Eq e, Show e) => Col (CASusingSTM.ListHandle e) e where\n--   newCol = CASusingSTM.newList\n--   insertCol c e = do CASusingSTM.addToTail c e\n--                      return ()\n--   deleteCol = CASusingSTM.delete\n--   findCol = CASusingSTM.find\n--   printCol = CASusingSTM.printList\n--   cntCol = CASusingSTM.cntList\n\n\n--instance (Eq e, Show e) => Col (Lazy.ListHandle e) e where\n--   newCol = Lazy.newList\n--   insertCol c e = do  Lazy.addToTail c e\n--                       return ()\n--   deleteCol =  Lazy.delete\n--   findCol =  Lazy.find\n--   printCol =  Lazy.printList\n--   cntCol =  Lazy.cntList\n\n\ninstance (Eq e, Show e) => Col (I.ListHandle e) e where\n   newCol = I.newList\n   insertCol c e = do I.addToTail c e\n                      return ()\n   deleteCol = I.delete\n   findCol = I.find\n   printCol = I.printList\n   cntCol = I.cntList\n\n--instance (Eq e, Show e) => Col (MLCusingSTM.ListHandle e) e where\n--   newCol = MLCusingSTM.newList\n--   insertCol c e = do MLCusingSTM.addToTail c e\n--                      return ()\n--   deleteCol = MLCusingSTM.delete\n--   findCol = MLCusingSTM.find\n--   printCol = MLCusingSTM.printList\n--   cntCol = MLCusingSTM.cntList\n\n\ninstance (Eq e, Show e) => Col (MLC.ListHandle e) e where\n   newCol = MLC.newList\n   insertCol c e = do MLC.addToTail c e\n                      return ()\n   deleteCol = MLC.delete\n   findCol = MLC.find\n   printCol = MLC.printList\n   cntCol = MLC.cntList\n\n--instance (Eq e, Show e) => Col (S.ListHandle e) e where\n--   newCol = S.newList\n--   insertCol c e = do S.addToTail c e\n--                      return ()\n--   deleteCol = S.delete\n--   findCol = S.find\n--   printCol = S.printList\n--   cntCol = S.cntList\n\n-- Auxiliary functions\n\ncreateList :: Col c e => [e] -> IO c\ncreateList n = \n  do nl <- newCol\n     mapM (insertCol nl) n\n     return nl\n\nexecuteTasks :: Col c e => c -> [Op e] -> IO ()\nexecuteTasks lh ops =\n do mapM (\\ task -> \n          case task of\n             Find x -> do { findCol lh x; return () }\n             Insert x -> do { insertCol lh x; return () }\n             Delete x -> do { deleteCol lh x; return () })\n         ops\n    return ()\n\nappendIORef :: IORef [a] -> a -> IO ()\nappendIORef ref a = do\n  { as <- readIORef ref\n  ; writeIORef ref (a:as) }\n    \nshowComma :: [String] -> String\nshowComma (s:ss) = \",\" ++ s ++ (showComma ss)\nshowComma [] = \"\"\n  \n-- Main interface\n    \nrun_testdata :: FilePath -> String -> IO ()\nrun_testdata testdata_fname mode = do\n    { tc <- parse_testdata testdata_fname\n    ; putStrLn \"Test Initiated: \"\n    ; let init_elems = t_init_list tc\n          works      = t_tasks tc\n    ; medians  <- newIORef []\n    ; highlows <- newIORef []\n    ; runtests mode init_elems works (medians,highlows)\n    }\n    where\n        runtests m elems works refs =\n          case m of\n             \"CAS\"   -> do nl :: CAS.ListHandle Int <- createList elems \n                           runtest m works nl refs\n             \"IMM\"   -> do nl :: IMM.ListHandle Int <- createList elems \n                           runtest m works nl refs\n--             \"CASusingSTM\"   -> do nl :: CASusingSTM.ListHandle Int <- createList elems \n--                                   runtest m works nl refs\n--             \"LAZY\" -> do nl :: Lazy.ListHandle Int <- createList elems\n--                          runtest m works nl refs\n             \"MLC\" -> do nl :: MLC.ListHandle Int <- createList elems \n                         runtest m works nl refs\n--             \"MLCusingSTM\" -> do nl :: MLCusingSTM.ListHandle Int <- createList elems \n--                                 runtest m works nl refs\n             \"IO\" -> do nl  :: I.ListHandle Int <- createList elems\n                        runtest m works nl refs\n--             \"STM\" -> do nl  :: S.ListHandle Int <- createList elems\n--                         runtest m works nl refs\n             trash -> fail $ \"Oi! No such concurrency mode: \" ++ trash \n           \n   \n        runtest m works nl (medians,highlows) = do\n          { putStrLn $ \"Test Started: \" ++ m\n          ; performGC \n--          ; wait <- atomically (newTVar 0)\n          ; wait <- newEmptyMVar\n          ; start <- getCurrentTime\n          ; zipWithM (\\n work -> forkOn n (do { executeTasks nl work\n                                              ; putMVar wait () }))\n                                              --atomically(do counter <- readTVar wait\n--                                                              writeTVar wait (counter+1)) }))\n            [0..] works\n          ; replicateM_ (length works) (takeMVar wait)\n--          ; atomically ( do { counter <- readTVar wait\n--                            ; if counter < length works then retry \n--                              else return () } )\n          ; fin <- getCurrentTime\n          ; let result = diffUTCTime fin start\n          ; -- printf \"time: %.2fs\\n\" (realToFrac result :: Double)\n          ; return () }\n\n        output_fname = \"out\"\n\n        write_output mod ms mref hlref = do\n          { if mod == 1 \n            then do { writeFile output_fname \"\"\n                    ; output_header output_fname ms\n                    ; appendFile output_fname \",,\"\n                    ; output_header output_fname ms\n                    ; appendFile output_fname \"\\n1Core\" }\n            else appendFile output_fname (\"\\n\" ++ (show mod) ++ \"Cores\") \n          ; medians  <- readIORef mref\n          ; highlows <- readIORef hlref\n          ; let mstr = reverse $ map show medians\n                hlstr = reverse $ highlows\n          ; appendFile output_fname (filter (/='s') (showComma mstr))\n          ; appendFile output_fname \",,\" \n          ; appendFile output_fname (filter (/='s') (showComma hlstr)) }\n          \n        output_header output_fname (m:ms) = do\n          { appendFile output_fname (\",\" ++ m)\n          ; output_header output_fname ms }\n        output_header output_fname [] = return ()\n          \n        high_low results =\n          let fst = head results\n              lst = head $ drop ((length results) - 1) results\n          in (fst,lst)\n", "num_lines": 220}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport GHC.Conc\n\nmain = do\n  setAllocationCounter (10*1024)\n  enableAllocationLimit\n  print (length [1..])\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport GHC.Conc\nimport Control.Concurrent\nimport Control.Exception\nimport System.Exit\n\nmain = do\n  m <- newEmptyMVar\n  let action =  do setAllocationCounter (10*1024)\n                   enableAllocationLimit\n                   print (length [1..])\n  forkFinally action (putMVar m)\n  r <- takeMVar m\n  case r of\n    Left e | Just AllocationLimitExceeded <- fromException e -> return ()\n    _ -> print r >> exitFailure\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport GHC.Conc\nimport Control.Concurrent\nimport Control.Exception\n\nmain = do\n  setAllocationCounter (10*1024)\n  enableAllocationLimit\n\n  -- alloc limit overflow while masked: should successfully print the\n  -- result, and then immediately raise the exception\n  r <- mask_ $ try $ print (length [1..100000])\n\n  print (r :: Either SomeException ())\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport GHC.Conc\nimport Control.Concurrent\nimport Control.Exception\nimport System.Exit\nimport Control.Monad\n\n-- check that +RTS -xq is doing the right thing: the test requires\n-- +RTS -xq300k\n-- Test does not work in GHCi as it load A Lot Of Things at start\n\nmain = do\n  m <- newEmptyMVar\n  let action = do\n         e <- try $ do\n          setAllocationCounter (10*1024)\n          enableAllocationLimit\n          print (length [1..])\n         case e of\n           Left AllocationLimitExceeded{} -> do\n             c <- getAllocationCounter\n             when (c < 250*1024 || c > 350*1024) $ fail $ \"wrong limit grace: \" ++ show c\n             print (length [2..])\n           Right _ ->\n             fail \"didn't catch AllocationLimitExceeded\"\n\n  forkFinally action (putMVar m)\n  r <- takeMVar m\n  case r of\n    Left e | Just AllocationLimitExceeded <- fromException e -> return ()\n    _ -> print r >> exitFailure\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Control.Concurrent\nimport GHC.Conc\nimport Control.Monad\n\nnfib n = if n < 2 then 1 else nfib (n-2) + nfib (n-1)\n\nmain = do\n   t <- mask_ $ forkIO $ forM_ [1..] $ \\n -> nfib n `seq` allowInterrupt\n   killThread t\n   let loop = do r <- threadStatus t\n                 when (r /= ThreadFinished) $ do yield; loop\n   loop\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception as E\nimport Control.Concurrent\nimport System.IO.Unsafe\n\n-- x is killed during evaluation with an asynchronous exception, but\n-- nevertheless gets overwritten with 'throw ThreadKilled' because the\n-- async exception is re-thrown as a synchrnonous exception by\n-- 'onException'.\n\nmain = do\n  let x = unsafePerformIO $ \n             (do threadDelay 1000000; return 42)\n             `onException` return ()\n\n  t <- forkIO $ do evaluate x; return ()\n  threadDelay 1000\n  killThread t\n\n  print x `E.catch` \\e -> putStrLn (\"main caught: \" ++ show (e::SomeException))\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main ( main ) where\n\nimport Control.Concurrent\nimport Control.Concurrent.MVar\nimport Control.Monad (when)\nimport Foreign.Storable\nimport GHC.Exts\nimport GHC.IO\n\n-- | Iterations per worker.\niters :: Int\niters = 1000000\n\nmain :: IO ()\nmain = do\n    fetchAddSubTest\n    fetchAndTest\n    fetchNandTest\n    fetchOrTest\n    fetchXorTest\n    casTest\n    readWriteTest\n\n-- | Test fetchAddIntArray# by having two threads concurrenctly\n-- increment a counter and then checking the sum at the end.\nfetchAddSubTest :: IO ()\nfetchAddSubTest = do\n    tot <- race 0\n        (\\ mba -> work fetchAddIntArray mba iters 2)\n        (\\ mba -> work fetchSubIntArray mba iters 1)\n    assertEq 1000000 tot \"fetchAddSubTest\"\n  where\n    work :: (MByteArray -> Int -> Int -> IO ()) -> MByteArray -> Int -> Int\n         -> IO ()\n    work op mba 0 val = return ()\n    work op mba n val = op mba 0 val >> work op mba (n-1) val\n\n-- | Test fetchXorIntArray# by having two threads concurrenctly XORing\n-- and then checking the result at the end. Works since XOR is\n-- commutative.\n--\n-- Covers the code paths for AND, NAND, and OR as well.\nfetchXorTest :: IO ()\nfetchXorTest = do\n    res <- race n0\n        (\\ mba -> work mba iters t1pat)\n        (\\ mba -> work mba iters t2pat)\n    assertEq expected res \"fetchXorTest\"\n  where\n    work :: MByteArray -> Int -> Int -> IO ()\n    work mba 0 val = return ()\n    work mba n val = fetchXorIntArray mba 0 val >> work mba (n-1) val\n\n    -- Initial value is a large prime and the two patterns are 1010...\n    -- and 0101...\n    (n0, t1pat, t2pat)\n        | sizeOf (undefined :: Int) == 8 =\n            (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999)\n        | otherwise = (0x0000ffff, 0x55555555, 0x99999999)\n    expected\n        | sizeOf (undefined :: Int) == 8 = 4294967295\n        | otherwise = 65535\n\n-- The tests for AND, NAND, and OR are trivial for two reasons:\n--\n--  * The code path is already well exercised by 'fetchXorTest'.\n--\n--  * It's harder to test these operations, as a long sequence of them\n--    convert to a single value but we'd like to write a test in the\n--    style of 'fetchXorTest' that applies the operation repeatedly,\n--    to make it likely that any race conditions are detected.\n--\n-- Right now we only test that they return the correct value for a\n-- single op on each thread.\n\n-- | Test an associative operation.\nfetchOpTest :: (MByteArray -> Int -> Int -> IO ())\n            -> Int -> String -> IO ()\nfetchOpTest op expected name = do\n    res <- race n0\n        (\\ mba -> work mba t1pat)\n        (\\ mba -> work mba t2pat)\n    assertEq expected res name\n  where\n    work :: MByteArray -> Int -> IO ()\n    work mba val = op mba 0 val\n\n-- | Initial value and operation arguments for race test.\n--\n-- Initial value is a large prime and the two patterns are 1010...\n-- and 0101...\nn0, t1pat, t2pat :: Int\n(n0, t1pat, t2pat)\n    | sizeOf (undefined :: Int) == 8 =\n        (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999)\n    | otherwise = (0x0000ffff, 0x55555555, 0x99999999)\n\nfetchAndTest :: IO ()\nfetchAndTest = fetchOpTest fetchAndIntArray expected \"fetchAndTest\"\n  where expected\n            | sizeOf (undefined :: Int) == 8 = 286331153\n            | otherwise = 4369\n\n-- | Test NAND without any race, as NAND isn't associative.\nfetchNandTest :: IO ()\nfetchNandTest = do\n    mba <- newByteArray (sizeOf (undefined :: Int))\n    writeIntArray mba 0 n0\n    fetchNandIntArray mba 0 t1pat\n    fetchNandIntArray mba 0 t2pat\n    res <- readIntArray mba 0\n    assertEq expected res \"fetchNandTest\"\n  where expected\n            | sizeOf (undefined :: Int) == 8 = 7378697629770151799\n            | otherwise = -2576976009\n\nfetchOrTest :: IO ()\nfetchOrTest = fetchOpTest fetchOrIntArray expected \"fetchOrTest\"\n  where expected\n            | sizeOf (undefined :: Int) == 8 = 15987178197787607039\n            | otherwise = 3722313727\n\n-- | Test casIntArray# by using it to emulate fetchAddIntArray# and\n-- then having two threads concurrenctly increment a counter,\n-- checking the sum at the end.\ncasTest :: IO ()\ncasTest = do\n    tot <- race 0\n        (\\ mba -> work mba iters 1)\n        (\\ mba -> work mba iters 2)\n    assertEq 3000000 tot \"casTest\"\n  where\n    work :: MByteArray -> Int -> Int -> IO ()\n    work mba 0 val = return ()\n    work mba n val = add mba 0 val >> work mba (n-1) val\n\n    -- Fetch-and-add implemented using CAS.\n    add :: MByteArray -> Int -> Int -> IO ()\n    add mba ix n = do\n        old <- readIntArray mba ix\n        old' <- casIntArray mba ix old (old + n)\n        when (old /= old') $ add mba ix n\n\n-- | Tests atomic reads and writes by making sure that one thread sees\n-- updates that are done on another. This test isn't very good at the\n-- moment, as this might work even without atomic ops, but at least it\n-- exercises the code.\nreadWriteTest :: IO ()\nreadWriteTest = do\n    mba <- newByteArray (sizeOf (undefined :: Int))\n    writeIntArray mba 0 0\n    latch <- newEmptyMVar\n    done <- newEmptyMVar\n    forkIO $ do\n        takeMVar latch\n        n <- atomicReadIntArray mba 0\n        assertEq 1 n \"readWriteTest\"\n        putMVar done ()\n    atomicWriteIntArray mba 0 1\n    putMVar latch ()\n    takeMVar done\n\n-- | Create two threads that mutate the byte array passed to them\n-- concurrently. The array is one word large.\nrace :: Int                    -- ^ Initial value of array element\n     -> (MByteArray -> IO ())  -- ^ Thread 1 action\n     -> (MByteArray -> IO ())  -- ^ Thread 2 action\n     -> IO Int                 -- ^ Final value of array element\nrace n0 thread1 thread2 = do\n    done1 <- newEmptyMVar\n    done2 <- newEmptyMVar\n    mba <- newByteArray (sizeOf (undefined :: Int))\n    writeIntArray mba 0 n0\n    forkIO $ thread1 mba >> putMVar done1 ()\n    forkIO $ thread2 mba >> putMVar done2 ()\n    mapM_ takeMVar [done1, done2]\n    readIntArray mba 0\n\n------------------------------------------------------------------------\n-- Test helper\n\nassertEq :: (Eq a, Show a) => a -> a -> String -> IO ()\nassertEq expected actual name\n    | expected == actual = putStrLn $ name ++ \": OK\"\n    | otherwise = do\n        putStrLn $ name ++ \": FAIL\"\n        putStrLn $ \"Expected: \" ++ show expected\n        putStrLn $ \"  Actual: \" ++ show actual\n\n------------------------------------------------------------------------\n-- Wrappers around MutableByteArray#\n\ndata MByteArray = MBA (MutableByteArray# RealWorld)\n\nfetchAddIntArray :: MByteArray -> Int -> Int -> IO ()\nfetchAddIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case fetchAddIntArray# mba# ix# n# s# of\n        (# s2#, _ #) -> (# s2#, () #)\n\nfetchSubIntArray :: MByteArray -> Int -> Int -> IO ()\nfetchSubIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case fetchSubIntArray# mba# ix# n# s# of\n        (# s2#, _ #) -> (# s2#, () #)\n\nfetchAndIntArray :: MByteArray -> Int -> Int -> IO ()\nfetchAndIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case fetchAndIntArray# mba# ix# n# s# of\n        (# s2#, _ #) -> (# s2#, () #)\n\nfetchNandIntArray :: MByteArray -> Int -> Int -> IO ()\nfetchNandIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case fetchNandIntArray# mba# ix# n# s# of\n        (# s2#, _ #) -> (# s2#, () #)\n\nfetchOrIntArray :: MByteArray -> Int -> Int -> IO ()\nfetchOrIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case fetchOrIntArray# mba# ix# n# s# of\n        (# s2#, _ #) -> (# s2#, () #)\n\nfetchXorIntArray :: MByteArray -> Int -> Int -> IO ()\nfetchXorIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case fetchXorIntArray# mba# ix# n# s# of\n        (# s2#, _ #) -> (# s2#, () #)\n\nnewByteArray :: Int -> IO MByteArray\nnewByteArray (I# n#) = IO $ \\ s# ->\n    case newByteArray# n# s# of\n        (# s2#, mba# #) -> (# s2#, MBA mba# #)\n\nwriteIntArray :: MByteArray -> Int -> Int -> IO ()\nwriteIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case writeIntArray# mba# ix# n# s# of\n        s2# -> (# s2#, () #)\n\nreadIntArray :: MByteArray -> Int -> IO Int\nreadIntArray (MBA mba#) (I# ix#) = IO $ \\ s# ->\n    case readIntArray# mba# ix# s# of\n        (# s2#, n# #) -> (# s2#, I# n# #)\n\natomicWriteIntArray :: MByteArray -> Int -> Int -> IO ()\natomicWriteIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \\ s# ->\n    case atomicWriteIntArray# mba# ix# n# s# of\n        s2# -> (# s2#, () #)\n\natomicReadIntArray :: MByteArray -> Int -> IO Int\natomicReadIntArray (MBA mba#) (I# ix#) = IO $ \\ s# ->\n    case atomicReadIntArray# mba# ix# s# of\n        (# s2#, n# #) -> (# s2#, I# n# #)\n\ncasIntArray :: MByteArray -> Int -> Int -> Int -> IO Int\ncasIntArray (MBA mba#) (I# ix#) (I# old#) (I# new#) = IO $ \\ s# ->\n    case casIntArray# mba# ix# old# new# s# of\n        (# s2#, old2# #) -> (# s2#, I# old2# #)\n", "num_lines": 257}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language MagicHash, UnboxedTuples  #-}\n\n-- | Note: extensive testing of atomic operations is performed in the\n-- \"atomic-primops\" library.  Only extremely rudimentary tests appear\n-- here.\n\nimport GHC.IO\nimport GHC.IORef\nimport GHC.ST\nimport GHC.STRef\nimport GHC.Prim\nimport GHC.Base\nimport Data.Primitive.Array\nimport Data.IORef\nimport Control.Monad\n\n------------------------------------------------------------------------\n\ncasArrayST :: MutableArray s a -> Int -> a -> a -> ST s (Bool, a)\ncasArrayST (MutableArray arr#) (I# i#) old new = ST$ \\s1# ->\n  case casArray# arr# i# old new s1# of \n    (# s2#, x#, res #) -> (# s2#, (isTrue# (x# ==# 0#), res) #)\n\ncasSTRef :: STRef s a -- ^ The 'STRef' containing a value 'current'\n         -> a -- ^ The 'old' value to compare\n         -> a -- ^ The 'new' value to replace 'current' if @old == current@\n         -> ST s (Bool, a) \ncasSTRef (STRef var#) old new = ST $ \\s1# ->\n   -- The primop treats the boolean as a sort of error code.\n   -- Zero means the CAS worked, one that it didn't.\n   -- We flip that here:\n    case casMutVar# var# old new s1# of\n      (# s2#, x#, res #) -> (# s2#, (isTrue# (x# ==# 0#), res) #)\n\n-- | Performs a machine-level compare and swap operation on an\n-- 'IORef'. Returns a tuple containing a 'Bool' which is 'True' when a\n-- swap is performed, along with the 'current' value from the 'IORef'.\n-- \n-- Note \\\"compare\\\" here means pointer equality in the sense of\n-- 'GHC.Prim.reallyUnsafePtrEquality#'.\ncasIORef :: IORef a -- ^ The 'IORef' containing a value 'current'\n         -> a -- ^ The 'old' value to compare\n         -> a -- ^ The 'new' value to replace 'current' if @old == current@\n         -> IO (Bool, a) \ncasIORef (IORef var) old new = stToIO (casSTRef var old new)\n\n\n------------------------------------------------------------------------\n-- Make sure this Int corresponds to a single object in memory (NOINLINE):\n{-# NOINLINE mynum #-}\nmynum :: Int\nmynum = 33\n\nmain = do\n  putStrLn \"Perform a CAS within an IORef\"\n  ref  <- newIORef mynum\n  res  <- casIORef ref mynum 44\n  res2 <- casIORef ref mynum 44\n  putStrLn$ \"  1st try should succeed: \"++show res\n  putStrLn$ \"  2nd should fail: \"++show res2\n\n  ------------------------------------------------------------\n  putStrLn \"Perform a CAS within a MutableArray#\"\n  arr <- newArray 5 mynum\n\n  res  <- stToIO$ casArrayST arr 3 mynum 44\n  res2 <- stToIO$ casArrayST arr 3 mynum 44\n  putStrLn$ \"  1st try should succeed: \"++show res\n  putStrLn$ \"  2nd should fail: \"++show res2\n\n  putStrLn \"Printing array:\"\n  forM_ [0..4] $ \\ i -> do\n    x <- readArray arr i \n    putStr (\"  \"++show x)\n  putStrLn \"\"\n\n  ------------------------------------------------------------\n  putStrLn \"Done.\"\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\n-- two processes, one MVar communication.\n\nmain = do\n  s <- newEmptyMVar\n  let\n    write = do\n        putMVar s \"hello world\\n\"\n\n  forkIO write\n  str <- takeMVar s\n  putStr str\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\nmain = do\n  c <- newChan\n  let  writer = writeList2Chan c \"Hello World\\n\"\n  forkIO writer\n  let  reader = do  char <- readChan c\n                    if (char == '\\n')\n                        then return ()\n                        else do putChar char; reader\n  reader\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\n-- simple handshaking using two MVars,\n-- must context switch twice for each character.\n\nmain = do\n  ready <- newEmptyMVar\n  datum <- newEmptyMVar\n  let\n    reader = do\n        putMVar ready ()\n        char <- takeMVar datum\n        if (char == '\\n')\n                then return ()\n                else do putChar char; reader\n\n    writer \"\" = do\n        takeMVar ready\n        putMVar datum '\\n'\n    writer (c:cs) = do\n        takeMVar ready\n        putMVar datum c\n        writer cs\n\n  forkIO reader\n  writer \"Hello World\"\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- Test thread creation.\n-- (from: Einar Wolfgang Karlsen <ewk@Informatik.Uni-Bremen.DE>)\n\nimport Control.Concurrent\n\nmain :: IO ()\nmain = do\n   mvar <- newEmptyMVar\n\n   let\n        spawner :: (IO () -> IO ThreadId) -> Int -> IO ()\n        spawner c 0 = putMVar mvar ()\n        spawner c n = do { c (spawner c (n-1)); return ()}\n\n   spawner forkIO 100000\n   takeMVar mvar\n   putStr \"done\"\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\n-- This test hopefully exercises the black hole code.  The main thread\n-- forks off another thread and starts on a large computation.\n-- The child thread attempts to get the result of the same large\n-- computation (and should get blocked doing so, because the parent\n-- won't have evaluated it yet).  When the result is available, the\n-- child passes it back to the parent who prints it out.\n\ntest = sum [1..10000]\n\nmain = do\n  x <- newEmptyMVar\n  forkIO (if test > 0\n                then putMVar x test\n                else error \"proc\"\n         )\n  if test > 0   -- evaluate test\n        then do result <- takeMVar x\n                print result\n        else error \"main\"\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception as E\n\nchoose :: a -> a -> IO a\nchoose a b = do\n   ready <- newMVar ()\n   answer <- newEmptyMVar\n   a_id <- forkIO (a `seq` takeMVar ready >> putMVar answer a)\n   b_id <- forkIO (b `seq` takeMVar ready >> putMVar answer b)\n   it <- takeMVar answer\n   killThread a_id\n   killThread b_id\n   return it\n\nmain = do\n   let big = sum [1..]\n       small = sum [1..42]\n   test1 <- choose big small\n   test2 <- choose small big\n   print (test1,test2)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\n\n-- Send ourselves a KillThread signal, catch it and recover.\n\nmain = do \n  id <- myThreadId\n  Control.Exception.catch (killThread id) $\n     \\e -> putStr (show (e::SomeException))\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\n\nmain = do \n  id <- myThreadId\n  throwTo id (ErrorCall \"hello\")\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\n\n-- Raise an exception in another thread.  We need a lot of synchronisation here:\n\n--   - an MVar for the second thread to block on which it waits for the\n--     signal (block)\n\n--   - an MVar to signal the main thread that the second thread is ready to\n--     accept the signal (ready)\n\n--   - an MVar to signal the main thread that the second thread has received\n--     the signal (ready2).  If we don't have this MVar, then the main\n--     thread could exit before the second thread has time to print\n--     the result.\n\nmain = do\n  block  <- newEmptyMVar\n  ready  <- newEmptyMVar\n  ready2 <- newEmptyMVar\n  id <- forkIO (Control.Exception.catch (putMVar ready () >> takeMVar block)\n                (\\e -> putStr (show (e::SomeException)) >> putMVar ready2 ()))\n  takeMVar ready\n  throwTo id (ErrorCall \"hello\")\n  takeMVar ready2\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\nimport Control.Exception\n--import GlaExts\n\ndata Result = Died SomeException | Finished\n\n-- Test stack overflow catching.  Should print \"Died: stack overflow\".\n\nstackoverflow :: Int -> Int\nstackoverflow 0 = 1\nstackoverflow n = n + stackoverflow n\n\nmain = do\n  let x = stackoverflow 1\n  result <- newEmptyMVar\n  forkIO $ Control.Exception.catch (evaluate x >> putMVar result Finished) $\n                     \\e -> putMVar result (Died e)\n  res <- takeMVar result\n  case res of\n        Died e -> putStr (\"Died: \" ++ show e ++ \"\\n\")\n        Finished -> putStr \"Ok.\\n\"\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- !!! test Eq and Ord instances over thread Ids.\n\nimport Control.Concurrent\n\nmain = do\n  tso1 <- forkIO (return ())\n  tso2 <- forkIO (return ())\n  print [compare tso1 tso2, compare tso1 tso1, compare tso2 tso1]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- Test blocking of async exceptions in an exception handler.\n-- The exception raised in the main thread should not be delivered\n-- until the first exception handler finishes.\nmain = do\n  main_thread <- myThreadId\n  m <- newEmptyMVar\n  forkIO (do { takeMVar m;  throwTo main_thread (ErrorCall \"foo\") })\n  (do { throwIO (ErrorCall \"wibble\")\n          `Control.Exception.catch`\n            (\\e -> let _ = e::ErrorCall in\n                   do putMVar m (); evaluate (sum [1..10000]); putStrLn \"done.\")\n       ; myDelay 500000 })\n    `Control.Exception.catch`\n       \\e -> putStrLn (\"caught: \" ++ show (e::SomeException))\n\n-- compensate for the fact that threadDelay is non-interruptible\n-- on Windows with the threaded RTS in 6.6.\nmyDelay usec = do\n  m <- newEmptyMVar\n  forkIO $ do threadDelay usec; putMVar m ()\n  takeMVar m\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- test blocking & unblocking of async exceptions.\n\n-- the first exception \"foo\" should be caught by the \"caught1\" handler,\n-- since async exceptions are blocked outside this handler.\n\n-- the second exception \"bar\" should be caught by the outer \"caught2\" handler,\n-- (i.e. this tests that async exceptions are properly unblocked after\n-- being blocked).\n\nmain = do\n  main_thread <- myThreadId\n  print =<< getMaskingState -- False\n  m <- newEmptyMVar\n  m2 <- newEmptyMVar\n  forkIO (do takeMVar m\n             throwTo main_thread (ErrorCall \"foo\")\n             throwTo main_thread (ErrorCall \"bar\")\n             putMVar m2 ()\n         )\n  ( do\n    mask $ \\restore -> do\n        putMVar m ()\n        print =<< getMaskingState -- True\n        sum [1..1] `seq` -- give 'foo' a chance to be raised\n          (restore $ myDelay 500000)\n                `Control.Exception.catch`\n                    \\e -> putStrLn (\"caught1: \" ++ show (e::SomeException))\n    threadDelay 10000\n    takeMVar m2\n   )\n    `Control.Exception.catch`\n       \\e -> do print =<< getMaskingState\n                putStrLn (\"caught2: \" ++ show (e::SomeException))\n\n-- compensate for the fact that threadDelay is non-interruptible\n-- on Windows with the threaded RTS in 6.6.\nmyDelay usec = do\n  m <- newEmptyMVar\n  forkIO $ do threadDelay usec; putMVar m ()\n  takeMVar m\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- version of conc015 using mask in place of the old deprecated\n-- block/unblock.\n\n-- test blocking & unblocking of async exceptions.\n\n-- the first exception \"foo\" should be caught by the \"caught1\" handler,\n-- since async exceptions are blocked outside this handler.\n\n-- the second exception \"bar\" should be caught by the outer \"caught2\" handler,\n-- (i.e. this tests that async exceptions are properly unblocked after\n-- being blocked).\n\nmain = do\n  main_thread <- myThreadId\n  print =<< getMaskingState\n  m <- newEmptyMVar\n  m2 <- newEmptyMVar\n  forkIO (do takeMVar m\n             throwTo main_thread (ErrorCall \"foo\")\n             throwTo main_thread (ErrorCall \"bar\")\n             putMVar m2 ()\n         )\n  ( do\n    mask $ \\restore -> do\n        putMVar m ()\n        print =<< getMaskingState\n        sum [1..100000] `seq` -- give 'foo' a chance to be raised\n          (restore (myDelay 500000)\n                `Control.Exception.catch`\n                    \\e -> putStrLn (\"caught1: \" ++ show (e::SomeException)))\n\n    threadDelay 10000\n    takeMVar m2\n   )\n    `Control.Exception.catch`\n       \\e -> do print =<< getMaskingState\n                putStrLn (\"caught2: \" ++ show (e::SomeException))\n\n-- compensate for the fact that threadDelay is non-interruptible\n-- on Windows with the threaded RTS in 6.6.\nmyDelay usec = do\n  m <- newEmptyMVar\n  forkIO $ do threadDelay usec; putMVar m ()\n  takeMVar m\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- check that we can still kill a thread that is blocked on\n-- delivering an exception to us.\n\n-- NB. this test is non-deterministic in the threaded2 way since 6.14,\n-- because throwTo is now always interruptible, so the main thread's\n-- killThread can be legitimately interrupted by the child thread's\n-- killThread, rather than the other way around.  This happens because\n-- the child thread is running on another processor, so the main\n-- thread's throwTo is blocked waiting for a response, and while\n-- waiting it is interruptible.\n\nmain = do\n  main_thread <- myThreadId\n  m <- newEmptyMVar\n  sub_thread <- forkIO (do\n                         takeMVar m\n                         throwTo main_thread (ErrorCall \"foo\")\n                        )\n  mask_ $ do\n    putMVar m ()\n    sum [1..10000] `seq` -- to be sure the other thread is now blocked\n      killThread sub_thread\n\n  putStrLn \"ok\"\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- check that async exceptions are restored to their previous\n-- state after an exception is raised and handled.\n\nmain = do\n  main_thread <- myThreadId\n  m1 <- newEmptyMVar\n  m2 <- newEmptyMVar\n  m3 <- newEmptyMVar\n  forkIO (do\n             takeMVar m1\n             throwTo main_thread (ErrorCall \"foo\")\n             takeMVar m2\n             throwTo main_thread (ErrorCall \"bar\")\n             putMVar m3 ()\n         )\n  (do\n    mask $ \\restore -> do\n        (do putMVar m1 ()\n            restore (\n                -- unblocked, \"foo\" delivered to \"caught1\"\n               myDelay 100000\n             )\n         ) `Control.Exception.catch`\n              \\e -> putStrLn (\"caught1: \" ++ show (e::SomeException))\n        putMVar m2 ()\n        -- blocked here, \"bar\" can't be delivered\n        (sum [1..10000] `seq` return ())\n          `Control.Exception.catch`\n              \\e -> putStrLn (\"caught2: \" ++ show (e::SomeException))\n    -- unblocked here, \"bar\" delivered to \"caught3\"\n    takeMVar m3\n   )\n   `Control.Exception.catch`\n       \\e -> putStrLn (\"caught3: \" ++ show (e::SomeException))\n\n-- compensate for the fact that threadDelay is non-interruptible\n-- on Windows with the threaded RTS in 6.6.\nmyDelay usec = do\n  m <- newEmptyMVar\n  forkIO $ do threadDelay usec; putMVar m ()\n  takeMVar m\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- check that async exceptions are restored to their previous\n-- state after an exception is raised and handled.\n\nmain = do\n  main_thread <- myThreadId\n  m1 <- newEmptyMVar\n  m2 <- newEmptyMVar\n  m3 <- newEmptyMVar\n  forkIO (do\n             takeMVar m1\n             throwTo main_thread (ErrorCall \"foo\")\n             takeMVar m2\n             throwTo main_thread (ErrorCall \"bar\")\n             putMVar m3 ()\n         )\n  (do\n    mask $ \\restore -> do\n        (do putMVar m1 ()\n            restore (\n                -- unblocked, \"foo\" delivered to \"caught1\"\n               myDelay 100000\n             )\n         ) `Control.Exception.catch`\n              \\e -> putStrLn (\"caught1: \" ++ show (e::SomeException))\n        putMVar m2 ()\n        -- blocked here, \"bar\" can't be delivered\n        (sum [1..10000] `seq` return ())\n          `Control.Exception.catch`\n              \\e -> putStrLn (\"caught2: \" ++ show (e::SomeException))\n    -- unblocked here, \"bar\" delivered to \"caught3\"\n    takeMVar m3\n   )\n   `Control.Exception.catch`\n       \\e -> putStrLn (\"caught3: \" ++ show (e::SomeException))\n\n-- compensate for the fact that threadDelay is non-interruptible\n-- on Windows with the threaded RTS in 6.6.\nmyDelay usec = do\n  m <- newEmptyMVar\n  forkIO $ do threadDelay usec; putMVar m ()\n  takeMVar m\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport GHC.Conc\nimport Foreign\n\n-- test that putMVar blocks on a full MVar rather than raising an\n-- exception.\n\nmain = do\n     -- In this test we want a thread to get BlockedIndefinitely; that\n     -- can't be the main thread because in GHCi the main thread\n     -- doesn't get BlockedIndefinitely.  So we have to use a\n     -- subthread, and \"prevent* the main thread from getting\n     -- BlockedIndefinitely when we're not in GHCi, which is what the\n     -- following hack does:\n  myThreadId >>= newStablePtr\n\n  m <- newEmptyMVar\n  t <- forkIO $ do\n            Control.Exception.catch (do\n                m <- newMVar ()\n                putMVar m ()\n             )\n             (\\e -> putMVar m (e::SomeException))\n  takeMVar m >>= print\n  -- should print \"thread blocked indefinitely\"\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport Data.List\nimport System.Mem\n\n-- !!! test that a child thread waiting on its own MVar will get killed by\n-- a signal.\n\nmain = do\n  forkIO (Control.Exception.catch (do { m <- newEmptyMVar; takeMVar m })\n                $ \\e -> putStrLn (\"caught: \" ++ show (e::SomeException)))\n  threadDelay 10000\n  System.Mem.performGC\n  threadDelay 10000\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\nmain = do\n  m <- newEmptyMVar\n  t <- forkIO (mask_ $ takeMVar m)\n  threadDelay 100000\n  throwTo t (ErrorCall \"I'm Interruptible\")\n  threadDelay 100000\n  putMVar m ()  -- to avoid t being garbage collected\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\n-- !!! test for uncaught exception\n\nforeign export ccall foo :: Int -> IO Int\nforeign import ccall safe \"foo\" foo_imported :: Int -> IO Int\n\nfoo n = error \"wurble\"\n\nmain = foo_imported 3\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !!! test tryTakeMVar\n\nimport Control.Concurrent\nimport Control.Exception\n\nimport GHC.Exts         ( fork# )\nimport GHC.IO           ( IO(..) )\nimport GHC.Conc         ( ThreadId(..) )\n\nmain = do\n  m <- newEmptyMVar\n  r <- timeout 5 (tryTakeMVar m) (putStrLn \"timed out!\" >> return Nothing)\n  print (r :: Maybe Int)\n\n  m <- newMVar True\n  r <- timeout 5 (tryTakeMVar m) (putStrLn \"timed out!\" >> return Nothing)\n  print r\n\ntimeout\n   :: Int       -- secs\n   -> IO a      -- action to run\n   -> IO a      -- action to run on timeout\n   -> IO a\n\ntimeout secs action on_timeout\n  = do\n    threadid <- myThreadId\n    timeout <- forkIO $ do threadDelay (secs * 1000000)\n                           throwTo threadid (ErrorCall \"__timeout\")\n    ( do result <- action\n         killThread timeout\n         return result\n      )\n      `Control.Exception.catch`\n        \\exception -> case fromException exception of\n                       Just (ErrorCall \"__timeout\") -> on_timeout\n                       _other -> do killThread timeout\n                                    throw exception\n\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n-- !!! test threadDelay, Random, and QSemN.\n\n-- start a large number (n) of threads each of which will wait for a\n-- random delay between 0 and m seconds.  We use a semaphore to wait\n-- for all the threads to finish.\n\nimport System.Random\nimport Control.Concurrent\nimport Control.Exception\nimport Control.Monad\n\nn = 5000  -- no. of threads\nm = 3000  -- maximum delay\n\nmain = do\n   v <- newEmptyMVar\n   is <- replicateM n $ getStdRandom (randomR (1,m))\n   mapM_ (fork_sleep v) is\n   replicateM_ n (takeMVar v)\n   where\n     fork_sleep v i = forkIO $ do threadDelay (i*1000); putMVar v ()\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule Main where\n\nimport Control.Exception\nimport Control.Concurrent\nimport System.Mem\n\n-- illustrates the BlockOnDeadMVar exception\n\nmain = do\n  id <- myThreadId\n  forkIO (catch (do m <- newEmptyMVar; takeMVar m)\n                (\\e -> throwTo id (e::SomeException)))\n  catch (do yield; performGC; threadDelay 1000000)\n        (\\e -> print (e::SomeException))\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Simple test of dupChan\n-- Embarrassingly, the published version fails!\n\nmodule Main where\n\nimport Control.Exception\nimport Control.Concurrent.Chan\n\nmain = do\n          chan <- newChan\n          ch <- dupChan chan\n          writeChan chan \"done\"\n          x <- readChan chan\n          y <- readChan ch\n          print (\"Got \"++x ++\" \"++y)\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for blocking putMVar\n\nimport Control.Concurrent\n\nmain = do\n  m <- newMVar ()\n  forkIO (threadDelay 100000 >> takeMVar m)\n  putMVar m ()  \n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Concurrent\n\nmain = do\n  m <- newEmptyMVar\n  end <- newEmptyMVar\n  forkIO (sequence_ [ putMVar m () | _ <- [1 .. 10000] ])\n  forkIO (sequence_ [ takeMVar m   | _ <- [1 .. 10000] ] >> putMVar end ())\n  takeMVar end\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test tryPutMVar\n\nimport Control.Concurrent\n\nmain = do\n  m <- newMVar ()\n  r <- tryPutMVar m ()\n  print r\n  takeMVar m\n  r <- tryPutMVar m ()\n  print r\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule Main where\n\nimport Control.Exception\nimport Control.Concurrent\n\n-- the BlockOnDeadMVar exception doesn't cause any output by default\n\nmain = do\n  forkIO (do m <- newEmptyMVar; takeMVar m)\n  print (sum [1..10000])\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule Main where\n\nimport Control.Exception\nimport Control.Concurrent\n\n-- the ThreadKilled exception doesn't cause any output by default\n\nmain = do\n  m <- newEmptyMVar\n  id <- forkIO (takeMVar m)\n  yield\n  killThread id\n  putMVar m ()\n  print (sum [1..50000])\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport System.Mem ( performGC )\nimport System.Mem.Weak ( addFinalizer )\n\ndata P = P (MVar Bool)\n\n-- Bug reported by Manuel Chakravarty, namely that we weren't checking\n-- for runnable finalizers before declaring that the program is\n-- deadlocked.\n\nmain = do\n--  gcThread  -- with this thread enabled, no error\n  mv <- newEmptyMVar\n  let p = P mv\n  addFinalizer p (set p)\n  takeMVar mv >>= print\n  putStrLn \"End.\"\n  where\n    set (P mv) = putMVar mv True\n    --\n    -- this is just to demonstrate that it is only about the GC timing\n    --\n    gcThread = forkIO $ let gc = do\n                                   putStrLn \"delay\"\n                                   threadDelay 100000\n                                   putStrLn \"gc\"\n                                   performGC\n                                   gc\n                        in gc\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! this test exposed a bug in the take/putMVar implementation in\n-- !!! GHC 5.00.  It involves multiple blocking takes & puts on the\n-- !!! same MVar.\n\nimport Control.Concurrent\nimport System.IO.Unsafe\n\nawk True  True  z     = 1\nawk False y     True  = 2\nawk x     False False = 3\n\nawk'1 True  True  z     = 1\nawk'2 False y     True  = 2\nawk'3 x     False False = 3\n\nawk' x y z | ppm [a1'1,a1'2,a1'3] (x,y,z) = awk'1 x y z\n           | ppm [a2'1,a2'2,a2'3] (x,y,z) = awk'2 x y z\n           | ppm [a3'1,a3'2,a3'3] (x,y,z) = awk'3 x y z\n           | otherwise                      = 0\n\na1'1 (True,y,z)  s = s True\na1'1 (x,y,z)     s = s False\n\na1'2 (x,True,z)  s = s True\na1'2 (x,y,z)     s = s False\n\na1'3 (x,y,z)     s = s True\n\na2'1 (False,y,z) s = s True\na2'1 (x,y,z)     s = s False\n\na2'2 (x,y,z)     s = s True\n\na2'3 (x,y,True)  s = s True\na2'3 (x,y,z)     s = s False\n\na3'1 (x,y,z)     s = s True\n\na3'2 (x,False,z) s = s True\na3'2 (x,y,z)     s = s False\n\na3'3 (x,y,False) s = s True\na3'3 (x,y,z)     s = s False\n\nppm fs as = unsafePerformIO (ppm' fs as)\n\nppm' fs as = do m <- newEmptyMVar\n                let s = putMVar m\n                hs <- sequence [forkIO (f as s)|f <- fs]\n                result <- assess (length fs) m\n                sequence (map killThread hs)\n                return result\n                  where assess 0 m = return True\n                        assess n m = do h <- takeMVar m\n                                        if h then (assess (n-1) m)\n                                             else return False\n\nmain = do sequence [putStrLn (show (awk' x y z))|(x,y,z) <- args]\n            where args = [\n                          (t,t,t),\n                          (t,t,f),\n                          (t,f,t),\n                          (t,f,f),\n                          (f,t,t),\n                          (f,t,f),\n                          (f,f,t),\n                          (f,f,f),\n                          (t,t,n)\n                          --(f,n,t),\n                          --(n,f,f),\n                         ]\n                  t    = True\n                  f    = False\n                  n    = odd (last [1..])\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- !!! test that deadlock is raised as an exception properly\nmain = do\n  r <- Control.Exception.try $ do\n          m <- newEmptyMVar\n          takeMVar m\n          return ()\n  print (r::Either SomeException ())\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nimport Control.Concurrent\nimport Control.Exception\nimport Foreign\n\nimport System.IO (hFlush,stdout)\n\n-- !!! Try to get two threads into a knot depending on each other.\n\n-- This should result in the main thread being sent a NonTermination\n-- exception (in GHC 5.02, the program is terminated with \"no threads\n-- to run\" instead).\n\nmain = do\n  Foreign.newStablePtr stdout\n        -- HACK, because when these two threads get blocked on each other,\n        -- there's nothing keeping stdout alive so it will get finalized.\n        -- SDM 12/3/2004\n  let a = last ([1..10000] ++ [b])\n      b = last ([2..10000] ++ [a])\n        -- we have to be careful to ensure that the strictness analyser\n        -- can't see that a and b are both bottom, otherwise the\n        -- simplifier will go to town here, resulting in something like\n        -- a = a and b = a.\n  forkIO (print a `catch` \\NonTermination -> return ())\n        -- we need to catch in the child thread too, because it might\n        -- get sent the NonTermination exception first.\n  r <- Control.Exception.try (print b)\n  print (r :: Either NonTermination ())\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\nimport qualified Control.Exception as E\n\ntrapHandler :: MVar Int -> MVar () -> IO ()\ntrapHandler inVar caughtVar =\n  (do E.mask_ $ do\n          trapMsg <- takeMVar inVar\n          putStrLn (\"Handler got: \" ++ show trapMsg)\n      trapHandler inVar caughtVar\n  )\n  `E.catch`\n  (trapExc inVar caughtVar)\n\ntrapExc :: MVar Int -> MVar () -> E.SomeException -> IO ()\n-- If we have been killed then we are done\ntrapExc inVar caughtVar  e\n  | Just E.ThreadKilled <- E.fromException e  = return ()\n-- Otherwise...\ntrapExc inVar caughtVar e =\n  do putStrLn (\"Exception: \" ++ show e)\n     putMVar caughtVar ()\n     trapHandler inVar caughtVar\n\nmain :: IO ()\nmain = do\n  inVar <- newEmptyMVar\n  caughtVar <- newEmptyMVar\n  tid <- forkIO (trapHandler inVar caughtVar)\n  yield\n  putMVar inVar 1\n  threadDelay 1000\n  throwTo tid (E.ErrorCall \"1st\")\n  takeMVar caughtVar\n  putMVar inVar 2\n  threadDelay 1000\n  throwTo tid (E.ErrorCall \"2nd\")\n        -- the second time around, exceptions will be blocked, because\n        -- the trapHandler is effectively \"still in the handler\" from the\n        -- first exception.  I'm not sure if this is by design or by\n        -- accident.  Anyway, the trapHandler will at some point block\n        -- in takeMVar, and thereby become interruptible, at which point\n        -- it will receive the second exception.\n  takeMVar caughtVar\n  -- Running the GHCi way complains that tid is blocked indefinitely if\n  -- it still exists, so kill it.\n  killThread tid\n  putStrLn \"All done\"\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# OPTIONS -cpp #-}\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\nimport Prelude hiding (catch)\nimport Foreign\nimport System.IO\n\n#ifdef mingw32_HOST_OS\nsleep n = sleepBlock (n*1000)\nforeign import stdcall unsafe \"Sleep\" sleepBlock :: Int -> IO ()\n#else\nsleep n = sleepBlock n\nforeign import ccall unsafe \"sleep\" sleepBlock :: Int -> IO ()\n#endif\n\nmain :: IO ()\nmain = do\n  newStablePtr stdout -- prevent stdout being finalized, sigh\n  th <- newEmptyMVar\n  forkIO $ do\n     putStrLn \"newThread started\"\n     sleep 1\n     putMVar th \"child\"\n  threadDelay 500000\n  yield -- another hack, just in case child yields right after \"sleep 1\"\n  putMVar th \"main\" `catch` (\\BlockedIndefinitelyOnMVar -> return ())\n        -- tests that the other thread doing an unsafe call to\n        -- sleep(3) has blocked this thread.  Not sure if this\n        -- is a useful test.\n  x <- takeMVar th\n  putStrLn x\n  putStrLn \"\\nshutting down\"\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -cpp #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\nimport Control.Concurrent\n\n#ifdef mingw32_HOST_OS\nforeign import stdcall safe \"Sleep\" _sleepBlock :: Int -> IO ()\nsleepBlock n = _sleepBlock (n*1000)\n#else\nforeign import ccall safe \"sleep\" sleepBlock :: Int -> IO ()\n#endif\n\nmain :: IO ()\nmain = do\n  th <- newEmptyMVar\n  forkIO $ do\n     putStrLn \"newThread started\"\n     sleepBlock 1\n     putStrLn \"newThread back again\"\n     putMVar th \"1 sec later\"\n  threadDelay 200000  -- make sure the newly created thread is run.\n  putStrLn \"mainThread\"\n  x <- takeMVar th\n  putStrLn x\n  putStrLn \"\\nshutting down\"\n  \n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -cpp #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\nimport Control.Concurrent\n\nhaskellFun :: Int -> IO ()\nhaskellFun c = putStrLn (\"Haskell: \" ++ show c)\n\nforeign export ccall \"hFun\"  haskellFun :: Int -> IO ()\nforeign import ccall safe \"hFun\"  hFun :: Int -> IO ()\n\n#ifdef mingw32_HOST_OS\nforeign import stdcall safe \"Sleep\" _sleepBlock :: Int -> IO ()\nsleepBlock n = _sleepBlock (n*1000)\n#else\nforeign import ccall safe \"sleep\" sleepBlock :: Int -> IO ()\n#endif\n\n\n\nmain :: IO ()\nmain = do\n  th <- newEmptyMVar\n  forkIO $ do\n     putStrLn \"newThread started\"\n     sleepBlock 1\n     putStrLn \"newThread back again\"\n     putMVar th \"1 sec later\"\n  threadDelay 500000 >> putStrLn \"mainThread\"\n        -- this will not be blocked in the threaded RTS\n  forkIO $ (hFun 2)\n        -- neither will this\n  x <- takeMVar th\n  putStrLn x\n  putStrLn \"\\nshutting down\"\n\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nimport Foreign\nimport System.IO.Unsafe\nimport System.Mem\nimport Control.Concurrent\n\nforeign export ccall \"performGC_\" performGC' :: IO ()\nperformGC' = do putMVar m (); yield; performGC\n\nforeign import ccall \"performGC_\" f :: IO ()\n\n{-# NOINLINE m #-}\nm = unsafePerformIO newEmptyMVar\n\nmain = do\n  forkIO f\n  takeMVar m\n\n-- This tests for a bug in the garbage collector, whereby a main\n-- thread that has completed may be GC'd before its return value is\n-- propagated back to the caller of rts_evalIO().\n--\n-- The sequence we hope to create is:\n--      - main thread (1) forks off thread (2)\n--      - thread (2) invokes new main thread (3) via a 'safe' ccall\n--      - thread (3) yields to thread (1)\n--      - thread (1) completes, but cannot return yet because (3)\n--        is the current main thread (unless we\n--        are in SMP or RTS_SUPPORTS_THREADS mode)\n--      - thread (3) invokes a GC\n--      - thread (1) is GC'd, unless we're careful!\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nimport Foreign\nimport Data.IORef\nimport Control.Concurrent\nimport Control.Exception\nimport System.IO.Unsafe\n\nforeign import ccall \"wrapper\"\n  wrap :: IO () -> IO (FunPtr (IO ()))\n\nforeign import ccall \"dynamic\" \n  invoke :: FunPtr (IO ()) -> IO ()\n\n{-# NOINLINE m #-}\nm :: IORef ThreadId\nm = unsafePerformIO (newIORef (error \"m\"))\n\nmain = do\n  id <- myThreadId\n  writeIORef m id\n  raise' <- wrap raise\n  invoke raise'\n\nraise = do\n  id <- readIORef m\n  me <- myThreadId\n  forkIO $ do threadDelay 10000; throwTo me (ErrorCall \"timeout\")\n  throwTo id (ErrorCall \"kapow!\")\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Conc\n\n-- Create a new TVar and never use it\nmain = do\n  putStr \"Before\\n\"\n  t <- atomically ( newTVar 42 )\n  putStr \"After\\n\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Conc\n\n-- Create a new TVar and check that it contains the expected value\nmain = do\n  putStr \"Before\\n\"\n  t <- atomically ( newTVar 42 )\n  r <- atomically ( readTVar t )\n  putStr (\"After \" ++ (show r) ++ \"\\n\")\n         \n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Conc\n\n-- Create a new TVar, update it and check that it contains the expected value after the \n-- transaction\nmain = do\n  putStr \"Before\\n\"\n  t <- atomically ( newTVar 42 )\n  atomically ( writeTVar t 17 )\n  r <- atomically ( readTVar t )\n  putStr (\"After \" ++ (show r) ++ \"\\n\")\n         \n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Conc\n\n-- Create a new TVar, update it and check that it contains the expected value within\n-- the transaction\nmain = do\n  putStr \"Before\\n\"\n  t <- atomically ( newTVar 42 )\n  r <- atomically ( do writeTVar t 17 \n                       readTVar t)\n  putStr (\"After \" ++ (show r) ++ \"\\n\")\n         \n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Conc\nimport Control.Concurrent\n\nsnapshot t1 t2 = atomically ( do v1 <- readTVar t1\n                                 v2 <- readTVar t2\n                                 return (v1, v2) )\n\ntwiddle mv _ _ 0 = putMVar mv ()\ntwiddle mv t1 t2 n = do atomically ( do v1 <- readTVar t1\n                                        v2 <- readTVar t2\n                                        writeTVar t2 (v1+1)\n                                        writeTVar t1 (v2+1) )\n                        twiddle mv t1 t2 (n-1)\n                  \n\n-- Contended updates to a pair of TVars \nmain = do\n  putStr \"Before\\n\"\n  (t1,t2) <- atomically ( do t1 <- newTVar 0\n                             t2 <- newTVar 1\n                             return (t1, t2))\n\n  -- MVars used to signal completion \n  t1c <- newEmptyMVar\n  t2c <- newEmptyMVar\n\n  forkIO (twiddle t1c t1 t2 1000)\n  forkIO (twiddle t2c t1 t2 1000)\n\n  -- Wait for threads to exit\n  takeMVar t1c\n  takeMVar t2c\n\n  -- Display final state\n  (r1,r2) <- snapshot t1 t2 \n  putStr (\"After \" ++ (show r1) ++ \" , \" ++ (show r2) ++ \"\\n\")\n         \n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport System.Environment\nimport Control.Concurrent\nimport Control.Monad\n\n-----------------------------------------------------------------------------\n-- test MVar throughput between the main thread and a child thread\n\n-- This test runs quite slowly on the threaded/SMP RTS vs. the normal RTS,\n-- because the main thread and child thread are run by different OS threads,\n-- so each MVar communication requires real OS thread switching.\n--\n-- Figures I get are about a factor of 10 difference in speed, at GHC 6.5.\n\nmain = chanTest 300000\n\nchanTest :: Int -> IO ()\nchanTest n = do\n  chan <- newEmptyMVar\n  forkIO (writer chan n)\n  reader chan n\n\nreader chan 0 = return ()\nreader chan n = do\n  takeMVar chan\n  reader chan (n-1)\n\nwriter chan 0 = return ()\nwriter chan n = do\n  putMVar chan ()\n  writer chan (n-1)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\n-- variation on conc020 that tests for threadDelay being interruptible.\n-- On Windows, with the threaded RTS, in 6.6 and earlier, threadDelay is \n-- not interruptible.\nmain = do\n  m <- newEmptyMVar\n  t <- forkIO (mask_ $ threadDelay 1000000)\n  threadDelay 100000\n  throwTo t (ErrorCall \"I'm Interruptible\")\n  threadDelay 100000\n  putMVar m ()  -- to avoid t being garbage collected\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, ForeignFunctionInterface #-}\nmodule Test where\n\nimport Control.Concurrent\nimport Control.Monad\nimport Foreign.C\n\n-- See also conc059_c.c\n--\n-- This test fires off some threads that will return after the RTS has\n-- shut down.  This should not crash or confuse the RTS.\n\nf :: Int -> IO ()\nf x = do\n  print x\n  replicateM_ 10 $ forkIO $ do usleep (fromIntegral x); putStrLn \"hello\"\n  return ()\n\nforeign export ccall \"f\" f :: Int -> IO ()\n\n#ifdef mingw32_HOST_OS\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n\nforeign import WINDOWS_CCONV safe \"Sleep\" _sleep :: Int -> IO ()\nusleep n = _sleep (n `quot` 1000)\n#else\nforeign import ccall safe \"usleep\" usleep  :: Int -> IO ()\n#endif\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for bug #1067\n\nimport Control.Concurrent\nimport Control.Exception\n\nmain = do\n         master <- myThreadId\n         test master 10\n         -- make sure we catch a final NonTermination exception to get\n         -- a consistent result.\n         threadDelay (10 * one_second)\n\ntest tid 0 = return ()\ntest tid n = do\n  e <- try threads\n  case e of\n    Left NonTermination -> test tid (n-1)\n    Right _ -> return ()\n where\n    threads = do sequence $ replicate 3 $\n                         forkIO $ do t <- myThreadId\n                                     --putStrLn (\"Start \" ++ show t)\n                                     threadDelay one_second\n                                     --putStrLn (\"End \" ++ show t)\n                                     throwTo tid NonTermination\n                                     --putStrLn (\"Thrown \" ++ show t)\n                 threadDelay (10 * one_second)\n\none_second :: Int\none_second = 100000\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for bug #1047\n\nimport Control.Concurrent\nimport Control.Exception\n\n-- This loop spends most of its time printing stuff, and very occasionally\n-- pops outside 'block'.  This test ensures that a thread trying to\n-- throwTo this thread will eventually succeed.\nloop = mask_ (print \"alive\") >> loop\n\nmain = do tid <- forkIO loop\n          threadDelay 1\n          killThread tid\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for bug #1047\n\nimport Control.Concurrent\nimport Control.Exception\n\n-- This loop spends most of its time printing stuff, and very occasionally\n-- executes 'unblock (return ())'.  This test ensures that a thread waiting\n-- to throwTo this thread is not blocked indefinitely.\nloop restore = do restore (return ()); print \"alive\"; loop restore\n\nmain = do tid <- forkIO (mask $ \\restore -> loop restore)\n          yield\n          killThread tid\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for bug #418\n\nmodule Main where\n\nimport Control.Concurrent\nimport System.IO.Unsafe (unsafeInterleaveIO)\n\nmain = do\n    v <- newEmptyMVar\n    a <- unsafeInterleaveIO (readMVar v)\n    t <- forkIO (print a)\n    threadDelay (100*1000)\n    killThread t\n    forkIO $ print a\n    putMVar v ()\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport GHC.Conc\n\n-- test forkBlockIO\nmain = do\n  main_thread <- myThreadId\n  m <- newEmptyMVar\n  sub_thread <- mask_ $ forkIO $\n                      sum [1..100000] `seq`\n                          throwTo main_thread (ErrorCall \"foo\")\n  killThread sub_thread\n  putStrLn \"oops\"\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\nmain = do\n  -- stat -- main thread is not bound in GHCi\n  m <- newEmptyMVar\n  forkIO (do stat; putMVar m ())\n  takeMVar m\n  mask_ $ forkIO (do stat; putMVar m ())\n  takeMVar m\n  forkOS (do stat; putMVar m ())\n  takeMVar m\n  mask_ $ forkOS (do stat; putMVar m ())\n  takeMVar m\n\nstat = do\n  x <- isCurrentThreadBound\n  y <- getMaskingState\n  print (x,y)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\n\nmain = do\n  -- stat -- main thread is not bound in GHCi\n  m <- newEmptyMVar\n  forkIO (do stat; putMVar m ())\n  takeMVar m\n  mask_ $ forkIO (do stat; putMVar m ())\n  takeMVar m\n  forkOS (do stat; putMVar m ())\n  takeMVar m\n  mask_ $ forkOS (do stat; putMVar m ())\n  takeMVar m\n\nstat = do\n  x <- isCurrentThreadBound\n  y <- getMaskingState\n  print (x,y)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport GHC.Conc\nimport Data.List\nimport Data.Maybe\n\nmain = do\n  t1 <- forkIO (threadDelay 100000000)\n  m <- newEmptyMVar\n  t2 <- forkIO (takeMVar m)\n  t3 <- forkIO (let loop = do r <- tryTakeMVar m; \n                              _ <- newEmptyMVar -- do some allocation :(\n                              if isNothing r then loop else return ()\n                in loop)\n  t4 <- forkIO (return ())\n  yield\n  threadDelay 10000\n  print =<< mapM threadStatus [t1,t2,t3,t4]\n  putMVar m ()\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\nmain = do\n  t <- forkIO (return ())\n  threadCapability t >>= print\n  t <- forkOn 0 (return ())\n  threadCapability t >>= print\n  t <- forkOn 1 (return ())\n  threadCapability t >>= print\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\nmain = do\n  t <- forkOn 0 (return ())\n  threadCapability t >>= print\n  t <- forkOn 1 (return ())\n  threadCapability t >>= print\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Control.Concurrent\n\nmain = do\n  m1 <- newEmptyMVar\n  m2 <- newEmptyMVar\n  t <- forkIO $ do\n    mask_ $ return ()\n    throwIO (ErrorCall \"test\") `catch`\n       \\e -> do\n         let _ = e::SomeException\n         print =<< getMaskingState\n         putMVar m1 ()\n         takeMVar m2\n  takeMVar m1\n  killThread t\n   -- in GHC 7.2 and earlier this call will deadlock due to bug #4988.\n   -- However, the RTS will resurrect the child thread, and in doing\n   -- so will unblock the main thread, so the main thread doesn't get\n   -- a BlockedIndefinitely exception.\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP,ForeignFunctionInterface,InterruptibleFFI #-}\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\nimport Foreign\nimport System.IO\n\n#ifdef mingw32_HOST_OS\nsleep n = sleepBlock (n*1000)\nforeign import stdcall interruptible \"Sleep\" sleepBlock :: Int -> IO ()\n#else\nsleep n = sleepBlock n\nforeign import ccall interruptible \"sleep\" sleepBlock :: Int -> IO ()\n#endif\n\nmain :: IO ()\nmain = do\n  newStablePtr stdout -- prevent stdout being finalized\n  th <- newEmptyMVar\n\n  tid <- forkIO $ do\n     putStrLn \"newThread started\"\n     (sleep 2 >> putStrLn \"fail\") `catch` (\\ThreadKilled -> putStrLn \"pass\")\n     putMVar th \"child\"\n\n  -- if the killThread below gets blocked for more than a second, then\n  -- this thread will kill the main thread and the test will fail.\n  main <- myThreadId\n  forkIO $ do threadDelay 1000000; throwTo main (ErrorCall \"still waiting\")\n\n  yield\n  threadDelay 500000\n  killThread tid\n  x <- takeMVar th\n  putStrLn x\n  putStrLn \"\\nshutting down\"\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\nimport Foreign\nimport Foreign.C\nimport GHC.Conc\nimport GHC.Prim\n\n-- Sample code demonstrating proper use of hs_try_putmvar()\n\nmain = do\n   makeExternalCall >>= print\n   threadDelay 100000\n\nmakeExternalCall :: IO CInt\nmakeExternalCall = mask_ $ do\n  mvar <- newEmptyMVar\n  sp <- newStablePtrPrimMVar mvar -- freed by hs_try_takemvar()\n  fp <- mallocForeignPtr\n  withForeignPtr fp $ \\presult -> do\n    (cap,_) <- threadCapability =<< myThreadId\n    scheduleCallback sp cap presult\n    takeMVar mvar `onException` forkIO (do takeMVar mvar; touchForeignPtr fp)\n      -- the C callback will still run if takeMVar is interrupted, so the\n      -- exception handler keeps the result memory alive long enough.\n    peek presult\n\nforeign import ccall \"scheduleCallback\"\n  scheduleCallback :: StablePtr PrimMVar\n                   -> Int\n                   -> Ptr CInt\n                   -> IO ()\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\nimport Control.Monad\nimport Foreign hiding (void)\nimport Foreign.C\nimport GHC.Conc\nimport GHC.Prim\nimport System.Environment\n\n-- Measure raw throughput, for M threads that each do N calls to C\n-- that call back to hs_try_putmvar() or the foreign export equivalent\n\nmain = do\n   args <- getArgs\n   case args of\n     [\"1\",n,m] -> experiment2 (read m) (experiment1 (read n))\n     [\"2\",n,m] -> experiment2 (read m) (experiment1FE (read n))\n\n-- -----------------------------------------------------------------------------\n\nexperiment1 :: Int -> IO ()\nexperiment1 n = mask_ $ do\n  mvar <- newEmptyMVar\n  (cap,_) <- threadCapability =<< myThreadId\n  replicateM_ n $ do\n    sp <- newStablePtrPrimMVar mvar\n    externalPutMVar sp cap\n    takeMVar mvar\n\nforeign import ccall \"externalPutMVar\"\n  externalPutMVar :: StablePtr PrimMVar\n                  -> Int\n                  -> IO ()\n\nexperiment1FE :: Int -> IO ()\nexperiment1FE n = do\n  mvar <- newEmptyMVar\n  (cap,_) <- threadCapability =<< myThreadId\n  bracket (newStablePtr mvar) freeStablePtr $ \\sp -> do\n    replicateM_ n $ do externalPutMVarFE sp cap; takeMVar mvar\n\nforeign import ccall \"externalPutMVarFE\"\n  externalPutMVarFE :: StablePtr (MVar ())\n                    -> Int\n                   -> IO ()\n\ncallbackPutMVar :: StablePtr (MVar ()) -> IO ()\ncallbackPutMVar sp = do\n  mvar <- deRefStablePtr sp\n  void $ tryPutMVar mvar ()\n\nforeign export ccall callbackPutMVar :: StablePtr (MVar ()) -> IO ()\n\n-- -----------------------------------------------------------------------------\n-- Perform M copies of experiment1 concurrently\n\nexperiment2 :: Int -> IO () -> IO ()\nexperiment2 m exp = do\n  mvars <- replicateM m $ do\n    m <- newEmptyMVar\n    forkFinally exp (\\_ -> putMVar m ())\n    return m\n  mapM_ takeMVar mvars\n", "num_lines": 67}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Exception\nimport Control.Monad\nimport Foreign hiding (void)\nimport Foreign.C\nimport GHC.Conc\nimport GHC.MVar (MVar(..))\nimport GHC.Prim\nimport System.Environment\nimport System.Exit\n\n-- Measure C to Haskell callback throughput under a workload with\n-- several dimensions:\n--\n--  * X callback queues (each managed by an OS thread in C)\n--  * each queue has Y Haskell threads, each making Z requests\n--\n-- And we can run the whole thing in two ways:\n--  * With the callbacks calling into a foreign export\n--  * With the callbacks using hs_try_putmvar()\n--\n-- Example results (using WAY=threaded2)\n--\n--  hs_try_putmvar003 1 64 16 500 +RTS -s -N4    1.10s\n--  hs_try_putmvar003 2 64 16 500 +RTS -s -N4    9.88s\n--\n-- hs_try_putmvar() is 9x faster with these parameters.\n\nmain = do\n   when (not rtsSupportsBoundThreads) $\n     die \"This test requires -threaded\"\n   args <- getArgs\n   case args of\n     [\"1\",x,y,z] -> experiment False (read x) (read y) (read z)\n     [\"2\",x,y,z] -> experiment True (read x) (read y) (read z)\n\nmakeExternalCall :: Ptr CallbackQueue -> IO CInt\nmakeExternalCall q = mask_ $ do\n  mvar <- newEmptyMVar\n  sp <- newStablePtrPrimMVar mvar\n  fp <- mallocForeignPtr\n  (cap,_) <- threadCapability =<< myThreadId\n  withForeignPtr fp $ \\presult -> do\n    scheduleCallback q sp cap presult\n    takeMVar mvar `onException` forkIO (do takeMVar mvar; touchForeignPtr fp)\n    peek presult\n\ndata CallbackQueue\n\nforeign import ccall \"mkCallbackQueue\"\n  mkCallbackQueue :: Int -> Int -> IO (Ptr CallbackQueue)\n\nforeign import ccall \"destroyCallbackQueue\"\n  destroyCallbackQueue :: Ptr CallbackQueue -> IO ()\n\nforeign import ccall \"scheduleCallback\"\n  scheduleCallback :: Ptr CallbackQueue\n                   -> StablePtr PrimMVar\n                   -> Int\n                   -> Ptr CInt\n                   -> IO ()\n\ncallbackPutMVar :: StablePtr PrimMVar -> IO ()\ncallbackPutMVar sp = do\n  mvar <- deRefStablePtr sp\n  void $ tryPutMVar (MVar (unsafeCoerce# mvar)) ()\n\nforeign export ccall callbackPutMVar :: StablePtr PrimMVar -> IO ()\n\n-- Make\n--   * x callback queues, each with\n--   * y threads, doing\n--   * z requests each\nexperiment :: Bool -> Int -> Int -> Int -> IO ()\nexperiment use_foreign_export x y z = do\n  mvars <- replicateM x $ async $ do\n    bracket (mkCallbackQueue (fromEnum use_foreign_export) (z*y))\n            destroyCallbackQueue $ \\q -> do\n      mvars <- replicateM y $ async $\n        replicateM_ z $ void $ makeExternalCall q\n      mapM_ takeMVar mvars\n  mapM_ takeMVar mvars\n\nasync :: IO () -> IO (MVar ())\nasync io = do\n  m <- newEmptyMVar\n  forkFinally io (\\_ -> putMVar m ())\n  return m\n", "num_lines": 92}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Text.Printf\n\n-- Test all the various combinations of nesting mask/uninterruptibleMask\n\nmain = do\n  stat 1 Unmasked\n  mask_ $ stat 2 MaskedInterruptible\n  mask $ \\restore -> do\n    stat 3 MaskedInterruptible\n    restore $ stat 4 Unmasked\n    restore $ restore $ stat 5 Unmasked\n    stat 6 MaskedInterruptible\n    uninterruptibleMask $ \\restore -> do\n      stat 7 MaskedUninterruptible\n      restore $ stat 8 MaskedInterruptible\n      restore $ restore $ stat 9 MaskedInterruptible\n      stat 10 MaskedUninterruptible\n      mask $ \\restore -> do\n        stat 11 MaskedUninterruptible\n        restore $ stat 12 MaskedUninterruptible\n        restore $ restore $ stat 13 MaskedUninterruptible\n        stat 14 MaskedUninterruptible\n      stat 15 MaskedUninterruptible\n    stat 16 MaskedInterruptible\n  stat 17 Unmasked\n\n  uninterruptibleMask $ \\restore -> do\n    stat 20 MaskedUninterruptible\n    restore $ stat 21 Unmasked\n    restore $ restore $ stat 22 Unmasked\n    stat 23 MaskedUninterruptible\n    mask $ \\restore -> do\n      stat 24 MaskedUninterruptible\n      restore $ stat 25 MaskedUninterruptible\n      restore $ restore $ stat 26 MaskedUninterruptible\n      stat 27 MaskedUninterruptible\n      uninterruptibleMask $ \\restore -> do\n        stat 28 MaskedUninterruptible\n        restore $ stat 29 MaskedUninterruptible\n        restore $ restore $ stat 30 MaskedUninterruptible\n        stat 31 MaskedUninterruptible\n      stat 32 MaskedUninterruptible\n    stat 33 MaskedUninterruptible\n  stat 34 Unmasked\n\n  -- it is possible to call a restore from a mask that is not the\n  -- innermost enclosing one, although this is not a recommended use\n  -- of the API.\n  mask $ \\restore0 -> do\n    stat 41 MaskedInterruptible \n    -- it is possible to call a restore from a mask that is not the\n    uninterruptibleMask $ \\restore1 -> do\n      stat 42 MaskedUninterruptible\n      restore0 $ stat 43 Unmasked\n      restore0 $ restore0 $ stat 44 Unmasked\n      restore1 $ stat 45 MaskedInterruptible\n      restore1 $ restore1 $ stat 46 MaskedInterruptible\n      restore0 $ restore1 $ stat 47 MaskedInterruptible\n      restore1 $ restore0 $ stat 48 Unmasked\n      stat 49 MaskedUninterruptible\n    stat 50 MaskedInterruptible\n  stat 51 Unmasked\n\nstat :: Int -> MaskingState -> IO ()\nstat n m = do \n s <- getMaskingState\n if (s /= m) \n    then error (printf \"%2d: %s\\n\" n (show s))\n    else return ()\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Control.Concurrent\nimport Text.Printf\n\n-- Test combinations of nesting mask/uninterruptibleMask with\n-- forkIO/forkIOWithUnmask\n\nmain = do\n  m <- newEmptyMVar\n  t1 <- mask_ $ forkIO $ do\n          takeMVar m `catch` \\e -> do stat 1 MaskedInterruptible\n                                      print (e::SomeException)\n                                      throwIO e\n  killThread t1\n  t2 <- uninterruptibleMask_ $ forkIO $ do\n          takeMVar m `catch` \\e -> do stat 2 MaskedUninterruptible\n                                      print (e::SomeException)\n                                      throwIO e\n  killThread t2\n  t3 <- mask_ $ forkIOWithUnmask $ \\unmask ->\n            unmask $ do stat 3 Unmasked; putMVar m ()\n  takeMVar m\n  t4 <- uninterruptibleMask_ $ forkIOWithUnmask $ \\unmask ->\n            unmask $ do stat 4 Unmasked; putMVar m ()\n  takeMVar m\n\nstat :: Int -> MaskingState -> IO ()\nstat n m = do \n s <- getMaskingState\n if (s /= m) \n    then error (printf \"%2d: %s\\n\" n (show s))\n    else return ()\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport GHC.Conc\n\nmain = do\n  let x = length [1..100]\n  numSparks >>= print\n  x `par` numSparks >>= print\n  x `par` numSparks >>= print\n  x `par` numSparks >>= print\n  x `par` numSparks >>= print\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\n-- Test for #10545\n\nimport System.Environment\nimport Control.Concurrent\nimport Control.Exception\nimport Control.Monad\nimport System.Random\nimport System.Mem\nimport qualified Data.Set as Set\n\nmain = do\n  [n] <- getArgs\n  forkIO $ doSomeWork\n  forM [1..read n] $ \\n -> do print n; threadDelay 1000; performMinorGC\n\ndoSomeWork :: IO ()\ndoSomeWork = forever $ do\n  ns <- replicateM 10000 randomIO :: IO [Int]\n  ms <- replicateM 1000 randomIO\n  let set = Set.fromList ns\n      elems = filter (`Set.member` set) ms\n  evaluate $ sum elems\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\nmain = do\n    let i = 1000000\n    m <- newMVar (0 :: Int)\n    let readloop 0 = return ()\n        readloop i = do\n            readMVar m\n            readloop (i-1)\n        writeloop 0 = return ()\n        writeloop i = do\n            readMVar m\n            writeloop (i-1)\n    forkIO $ readloop i\n    writeloop i\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\nmain = do\n    m <- newEmptyMVar\n    sync <- newEmptyMVar\n    let f = readMVar m\n    t1 <- forkIO (f >> error \"FAILURE\")\n    t2 <- forkIO (f >> putMVar sync ())\n    killThread t1\n    putMVar m (0 :: Int)\n    readMVar sync\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\n-- example from\n-- http://www.haskell.org/pipermail/glasgow-haskell-users/2008-November/015878.html\n\nmain = do\n    m <- newMVar (0 :: Int)\n    forkIO $ putMVar m 1\n    yield\n    r1 <- readMVar m\n    r2 <- takeMVar m\n    r3 <- takeMVar m\n    return ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Conc\nimport GHC.Prim\nimport System.Environment\nimport System.IO\nimport Control.Monad\nimport Text.Printf\nimport Data.Time.Clock\nimport Control.DeepSeq\n\nmain = do\n  [n,q,t] <- fmap (fmap read) getArgs\n  t <- forkIO $ do\n    forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \\m -> do\n      setNumCapabilities m\n      threadDelay t\n  printf \"%d\\n\" (nqueens q)\n  killThread t\n      -- If we don't kill the child thread, it might be about to\n      -- call setNumCapabilities() in C when the main thread exits,\n      -- and chaos can ensue.  See #12038\n\nnqueens :: Int -> Int\nnqueens nq = length (pargen 0 [])\n where\n    safe :: Int -> Int -> [Int] -> Bool\n    safe x d []    = True\n    safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l\n\n    gen :: [[Int]] -> [[Int]]\n    gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ]\n\n    pargen :: Int -> [Int] -> [[Int]]\n    pargen n b\n       | n >= threshold = iterate gen [b] !! (nq - n)\n       | otherwise      = concat bs\n       where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq\n\n    threshold = 3\n\nusing :: a -> Strategy a -> a\nx `using` strat = runEval (strat x)\n\ntype Strategy a = a -> Eval a\n\nnewtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))\n\nrunEval :: Eval a -> a\nrunEval (Eval x) = case x realWorld# of (# _, a #) -> a\n\ninstance Functor Eval where\n  fmap = liftM\n\ninstance Applicative Eval where\n  pure x = Eval $ \\s -> (# s, x #)\n  (<*>)  = ap\n\ninstance Monad Eval where\n  return = pure\n  Eval x >>= k = Eval $ \\s -> case x s of\n                                (# s', a #) -> case k a of\n                                                      Eval f -> f s'\n\nparList :: Strategy a -> Strategy [a]\nparList strat = traverse (rparWith strat)\n\nrpar :: Strategy a\nrpar  x = Eval $ \\s -> spark# x s\n\nrseq :: Strategy a\nrseq x = Eval $ \\s -> seq# x s\n\nrparWith :: Strategy a -> Strategy a\nrparWith s a = do l <- rpar r; return (case l of Lift x -> x)\n  where r = case s a of\n              Eval f -> case f realWorld# of\n                          (# _, a' #) -> Lift a'\n\ndata Lift a = Lift a\n\nrdeepseq :: NFData a => Strategy a\nrdeepseq x = do rseq (rnf x); return x\n", "num_lines": 84}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport Control.Concurrent\nimport Control.Exception\n\nmain = forkIO (error \"Successful exception\") >> threadDelay 100000\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.IORef\nimport System.IO.Unsafe\nimport Control.Concurrent.STM\nimport Control.Concurrent.Async\nimport Control.Concurrent\nimport System.IO\nimport System.Directory\nimport System.FilePath\nimport T13916_Bracket\n\ntype Thing = MVar Bool\n\nmain :: IO ()\nmain = do\n    withEnvCache limit spawner $ \\cache ->\n        forConcurrently_ [1..1000 :: Int] $ \\n -> withEnv cache (\\handle -> put handle n)\n    where\n        limit :: Limit\n        limit = Hard 1\n\n        put handle n = return ()\n\nspawner :: Spawner Thing\nspawner = Spawner\n    { maker  = mkhandle\n    , killer = \\thing -> takeMVar thing >> putMVar thing True\n    , isDead = \\thing -> readMVar thing\n    }\n\nmkhandle :: IO Thing\nmkhandle = newMVar False\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE RecordWildCards #-}\n{- |\nModule      : Bracket\nDescription : Handling multiple environments with bracket-like apis\nMaintainer  : robertkennedy@clearwateranalytics.com\nStability   : stable\n\nThis module is meant for ie Sql or mongo connections, where you may wish for some number of easy to grab\nenvironments. In particular, this assumes your connection has some initialization/release functions\n\nThis module creates bugs with any optimizations enabled. The bugs do not occur if the program is in the same\nmodule.\n-}\nmodule T13916_Bracket (\n    -- * Data Types\n    Spawner(..), Limit(..), Cache,\n    -- * Usage\n    withEnvCache, withEnv\n    ) where\n\nimport Control.Concurrent.STM\nimport Control.Concurrent.STM.TSem\nimport Control.Exception hiding (handle)\nimport Control.Monad\nimport Data.Vector (Vector)\nimport qualified Data.Vector as Vector\n\n-- * Data Types\n-- | Tells the program how many environments it is allowed to spawn.\n-- A `Lax` limit will spawn extra connections if the `Cache` is empty,\n-- while a `Hard` limit will not spawn any more than the given number of connections simultaneously.\n--\n-- @since 0.3.7\ndata Limit = Hard {getLimit :: {-# unpack #-} !Int}\n\ndata Spawner env = Spawner\n    { maker  :: IO env\n    , killer :: env -> IO ()\n    , isDead :: env -> IO Bool\n    }\n\ntype VCache env = Vector (TMVar env)\ndata Cache env = Unlimited { spawner :: Spawner env\n                           , vcache :: !(VCache env)\n                           }\n               | Limited   { spawner :: Spawner env\n                           , vcache :: !(VCache env)\n                           , envsem :: TSem\n                           }\n\n-- ** Initialization\nwithEnvCache :: Limit -> Spawner env -> (Cache env -> IO a) -> IO a\nwithEnvCache limit spawner = bracket starter releaseCache\n    where starter = case limit of\n            Hard n -> Limited spawner <$> initializeEmptyCache n <*> atomically (newTSem n)\n\n-- ** Using a single value\nwithEnv :: Cache env -> (env -> IO a) -> IO a\nwithEnv cache = case cache of\n    Unlimited{..} -> withEnvUnlimited spawner vcache\n    Limited{..}   -> withEnvLimited   spawner vcache envsem\n\n-- *** Unlimited\n-- | Takes an env and returns it on completion of the function.\n-- If all envs are already taken or closed, this will spin up a new env.\n-- When the function finishes, this will attempt to put the env into the cache. If it cannot,\n-- it will kill the env. Note this can lead to many concurrent connections.\n--\n-- @since 0.3.5\nwithEnvUnlimited :: Spawner env -> VCache env -> (env -> IO a) -> IO a\nwithEnvUnlimited Spawner{..} cache = bracket taker putter\n  where\n    taker = do\n        mpipe <- atomically $ tryTakeEnv cache\n        case mpipe of\n            Nothing  -> maker\n            Just env -> isDead env >>= \\b -> if not b then return env else killer env >> maker\n\n    putter env = do\n        accepted <- atomically $ tryPutEnv cache env\n        unless accepted $ killer env\n\n-- *** Limited\n-- | Takes an env and returns it on completion of the function.\n-- If all envs are already taken, this will wait. This should have a constant number of environments\n--\n-- @since 0.3.6\nwithEnvLimited :: Spawner env -> VCache env -> TSem -> (env -> IO a) -> IO a\nwithEnvLimited spawner vcache envsem = bracket taker putter\n  where\n    taker = limitMakeEnv spawner vcache envsem\n    putter env = atomically $ putEnv vcache env\n\nlimitMakeEnv :: Spawner env -> VCache env -> TSem -> IO env\nlimitMakeEnv Spawner{..} vcache envsem = go\n  where\n    go = do\n        eenvpermission <- atomically $ ( Left  <$> takeEnv  vcache )\n                              `orElse` ( Right <$> waitTSem envsem )\n        case eenvpermission of\n            Right () -> maker\n            Left env -> do\n                -- Given our env, we check if it's dead. If it's not, we are done and return it.\n                -- If it is dead, we release it, signal that a new env can be created, and then recurse\n                isdead <- isDead env\n                if not isdead then return env\n                    else do\n                         killer env\n                         atomically $ signalTSem envsem\n                         go\n\n-- * Low level\ninitializeEmptyCache :: Int -> IO (VCache env)\ninitializeEmptyCache n | n < 1     = return mempty\n                       | otherwise = Vector.replicateM n newEmptyTMVarIO\n\ntakeEnv :: VCache env -> STM env\ntakeEnv = Vector.foldl folding retry\n    where folding m stmenv = m `orElse` takeTMVar stmenv\n\ntryTakeEnv :: VCache env -> STM (Maybe env)\ntryTakeEnv cache = (Just <$> takeEnv cache) `orElse` pure Nothing\n\nputEnv :: VCache env -> env -> STM ()\nputEnv cache env = Vector.foldl folding retry cache\n    where folding m stmenv = m `orElse` putTMVar stmenv env\n\ntryPutEnv :: VCache env -> env -> STM Bool\ntryPutEnv cache env = (putEnv cache env *> return True) `orElse` pure False\n\nreleaseCache :: Cache env -> IO ()\nreleaseCache cache = Vector.mapM_ qkRelease (vcache cache)\n    where qkRelease tenv = atomically (tryTakeTMVar tenv)\n                       >>= maybe (return ()) (killer $ spawner cache)\n", "num_lines": 136}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Control.Concurrent\n\nmain = do\n  thr <- myThreadId\n  evaluate $ increase_stack 1000\n  throwTo thr ThreadKilled\n        `Control.Exception.catch` (\\e -> case e of\n                         ThreadKilled -> return ()\n                         _ -> throw e)\n where\n  increase_stack 0 = 1\n  increase_stack n = increase_stack (n-1) + n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport GHC.Conc\n  \nmain = do\n    t1 <- mask $ \\_ -> forkIO yield\n    t2 <- forkIO $ killThread t1\n    threadDelay 100000\n    threadStatus t1 >>= print\n    threadStatus t2 >>= print\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport GHC.Conc\n  \nmain = do\n    t1 <- mask_ $ forkIO yield\n    t2 <- forkIO $ killThread t1\n    threadDelay 100000\n    threadStatus t1 >>= print\n    threadStatus t2 >>= print\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for #3279\n\nimport System.IO.Unsafe\nimport GHC.Conc\nimport Control.Exception\nimport GHC.IO (unsafeUnmask)\n\nf :: Int\nf = (1 +) . unsafePerformIO $ do\n        throwIO (ErrorCall \"foo\") `catch` \\(SomeException e) -> do\n            myThreadId >>= flip throwTo e\n            -- point X\n            unsafeUnmask $ return 1\n\nmain :: IO ()\nmain = do\n    evaluate f `catch` \\(SomeException e) -> return 0\n    -- the evaluation of 'x' is now suspended at point X\n    tid <- mask_ $ forkIO (evaluate f >> return ())\n    killThread tid\n    -- now execute the 'unblock' above with a pending exception\n    yield\n    -- should print 1 + 1 = 2\n    print f\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport Control.Concurrent\nimport Control.Concurrent.MVar\nimport Control.Exception\nimport System.IO\n\nmain :: IO ()\nmain = do hSetBuffering stdout NoBuffering\n          replicateM_ 1000 doit\n\ndoit :: IO ()\ndoit = do v <- newMVar ()\n          t <- forkIO (foo v)\n          threadDelay 1000\n          killThread t\n          takeMVar v\n          putChar '.'\n\nfoo :: MVar () -> IO ()\nfoo v = do let loop = do withMVar v $ \\x -> evaluate x\n                         loop\n           loop\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport Control.Concurrent\nimport qualified Data.Vector as U\n\nmain = do\n    t <- forkIO (U.sum (U.enumFromTo 1 (1000000000 :: Int)) `seq` return ())\n    threadDelay 10\n    killThread t\n    putStrLn \"Done\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- Should be compiled with -O0\n\nimport Control.Concurrent\nimport GHC.Conc\nimport GHC.Prim\nimport GHC.Exts\n\nmain = do\n    t <- forkIO (f 0 `seq` return ())\n    threadDelay 10\n    killThread t\n    putStrLn \"Done\"\n\n-- Non-allocating let-no-escape infinite loop in fail\n{-# NOINLINE f #-}\nf :: Int -> Bool\nf i@(I# j) = let fail :: Int# -> Bool\n                 fail i = fail (i +# 1#)\n      in if (case i of\n            0 -> True\n            _ -> False) then fail j else False\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\nimport Control.Exception\n\nmain :: IO ()\nmain = do tid <- mask $ \\_ -> forkIO $ let x = x in x\n          killThread tid\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\n-- Tests that superfluous worker threads are discarded rather than\n-- being kept around by the RTS.\n\nimport Control.Concurrent\nimport Control.Monad\nimport Foreign.C.Types\nimport System.Mem\nimport System.Posix.Process\nimport System.Directory\nimport Control.Concurrent.QSem\n\nforeign import ccall safe sleep :: CUInt -> IO ()\n\nmain = do\n    let amount = 200\n    qsem <- newQSem 0\n    replicateM_ amount . forkIO $ (sleep 2 >> signalQSem qsem)\n    replicateM_ amount $ waitQSem qsem\n    -- POSIX only: check thread usage manually\n    pid <- getProcessID\n    let dir = \"/proc/\" ++ show pid ++ \"/task\"\n    contents <- getDirectoryContents dir\n    let status = length contents - 2 -- . and ..\n    print status\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\n\n-- tests for a bug where throwTo targets a thread just created by\n-- forkOn, which is still in the process of migrating to another CPU (#4811)\n\nmain = do\n  m <- newEmptyMVar\n  forkOn 0 $ do\n     replicateM_ 1000 $ do\n       t <- forkOn 1 $ return ()\n       killThread t\n     putMVar m ()\n  takeMVar m\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\nimport Control.Exception\nimport System.Mem\n\n-- caused an assertion failure with -debug in 7.0.1 (#4813)\n\nmain = do\n   m <- newEmptyMVar\n   ts <- replicateM 100 $ mask_ $ forkIO $ threadDelay 100000; putMVar m ()\n   mapM_ killThread (reverse (init ts))\n   takeMVar m\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad.Fix\n\ndata Client = Client\n        { clientLock :: MVar ()\n        }\n\nmain = do\n        mvar <- newMVar ()\n\n        client <- mfix $ \\client -> do\n                _ <- forkIO (mainLoop client)\n                threadDelay 200000\n                return (Client mvar)\n        return ()\n\nmainLoop client = withMVar (clientLock client) (\\_ -> return ())\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport Control.Monad\nimport System.IO.Unsafe\n\nmain :: IO ()\nmain = do\n     -- evaluate lock -- adding this line fixes the problem\n\n     fin1 <- newEmptyMVar\n     fin2 <- newEmptyMVar\n\n     forkIO $ ping >>= putMVar fin1\n     forkIO $ ping >>= putMVar fin2\n\n     takeMVar fin1\n     takeMVar fin2\n\n{-# NOINLINE lock #-}\nlock :: MVar ()\nlock = unsafePerformIO $ newMVar ()\n\nping = do\n     () <- takeMVar lock\n     putMVar lock ()\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP,ForeignFunctionInterface #-}\n\nimport Control.Concurrent\nimport Foreign.C\nimport System.IO\n\n#ifdef mingw32_HOST_OS\nsleep n = sleepBlock (n*1000)\nforeign import stdcall unsafe \"Sleep\" sleepBlock :: Int -> IO ()\n#else\nsleep n = sleepBlock n\nforeign import ccall unsafe \"sleep\" sleepBlock :: Int -> IO ()\n#endif\n\nmain :: IO ()\nmain = do\n     hSetBuffering stdout LineBuffering\n\n     tid <- forkIO $ do\n         putStrLn \"child: Sleeping\"\n         _ <- sleep 1\n\n         -- The following lines should not happen after the killThread from the\n         -- parent thread completes.  However, they do...\n         -- putStrLn \"child: Done sleeping\"\n         threadDelay 100000\n         putStrLn \"child: Done waiting\"\n\n     threadDelay 100000\n     -- putStrLn $ \"parent: Throwing exception to thread \" ++ show tid\n     throwTo tid $ userError \"Exception delivered successfully\"\n     putStrLn \"parent: Done throwing exception\"\n\n     threadDelay 200000\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.Conc\nimport Control.Exception\nimport System.IO.Unsafe\nimport System.Timeout\n\nmain :: IO ()\nmain = do\n    x <- unsafeInterleaveIO $ atomically retry\n    _ <- timeout 500000 $ evaluate x\n    evaluate x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception as E\nimport Data.IORef\nimport System.Mem.Weak\nimport Control.Concurrent\n\nmain :: IO ()\nmain = do\n    ref <- newIORef 'x'\n    weak <- mkWeakIORef ref $ putStrLn \"IORef finalized\"\n    let check = deRefWeak weak >>= \\m -> case m of\n            Nothing -> putStrLn \"IORef was GCed\"\n            Just ref' -> do\n                x <- readIORef ref'\n                putStrLn $ \"IORef still alive, and contains \" ++ show x\n    m <- newEmptyMVar\n    check\n    takeMVar m `catch` \\ex -> do\n        putStrLn $ \"caught exception: \" ++ show (ex :: SomeException)\n        check\n    readIORef ref >>= print\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Control.Concurrent\nimport GHC.Conc\nimport Foreign.StablePtr\n\nmain :: IO ()\nmain = do\n  tv <- atomically $ newTVar True\n  _ <- newStablePtr tv\n  t <- mask_ $ forkIO (blockSTM tv)\n  killThread t\n\ncheck b = if b then return () else retry\n\nblockSTM :: TVar Bool -> IO ()\nblockSTM tv = do\n  atomically $ do\n    v <- readTVar tv\n    check $ not v\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for threadstatus, checking (mvar read, mvar block reasons)\n-- created together with fixing GHC ticket #9333\n\nmodule Main where\n\nimport Control.Concurrent\nimport GHC.Conc\nimport GHC.Conc.Sync\n\nmain = do\n  -- create MVars to block on\n  v1 <- newMVar \"full\"\n  v2 <- newEmptyMVar\n  -- create a thread which fills both MVars\n  parent <- myThreadId\n  putStrLn \"p: forking child thread\"\n  child <- forkIO $\n           do putStrLn \"c: filling full MVar\" -- should block\n              putMVar v1 \"filled full var\"\n              yield\n              putStrLn \"c: filling empty MVar (expect parent to be blocked)\"\n              stat2 <- threadStatus parent\n              putStrLn (\"c: parent is \" ++ show stat2)\n              putMVar v2 \"filled empty var\"\n  yield\n  putStrLn \"p: emptying full MVar (expect child to be blocked on it)\"\n  stat1 <- threadStatus child\n  putStrLn (\"p: child is \" ++ show stat1)\n  s1 <- takeMVar v1 -- should unblock child\n  putStrLn (\"p: from MVar: \" ++ s1)\n  putStrLn \"p: reading empty MVar\"\n  s2 <- readMVar v2 -- should block\n  putStrLn (\"p: from MVar: \" ++ s2)\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport Data.Array\nimport System.Random\nimport System.Environment\nimport Control.Monad\nimport GHC.Conc\n\n-- A fiendish throwTo test.  A bunch of threads take random MVars from\n-- a shared array; if the MVar has Nothing in it, replace it with Just\n-- of the current thread's ThreadId.  If the MVar has another ThreadId\n-- in it, then killThread that thread, and replace it with the current\n-- thread's ThreadId.  We keep going until only one thread is left\n-- standing.\n--\n-- On multiple CPUs this should give throwTo a good workout.\n--\nmain = do\n  [m, t] <- fmap (fmap read) getArgs\n  ms <- replicateM m $ newMVar Nothing\n  let arr = listArray (1,m) ms\n  dead <- newTVarIO 0\n  ts <- replicateM t $ forkIO (thread m arr `onException` \n                                      (atomically $ do d <- readTVar dead\n                                                       writeTVar dead $! d+1))\n  atomically $ do\n    d <- readTVar dead\n    when (d < t-1) $ retry\n\nthread m arr = do\n  x <- randomIO\n  id <- myThreadId\n  modifyMVar_ (arr ! ((x `mod` m) + 1)) $ \\b ->\n    case b of\n      Nothing    -> return (Just id)\n      Just other -> do when (other /= id) $ killThread other\n                       return (Just id)\n  thread m arr\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}\nimport Control.Concurrent\nimport Control.Exception\nimport Data.Array\nimport System.Random\nimport System.Environment\nimport Control.Monad\nimport GHC.Conc\nimport Data.IORef\n\nmain = do\n  r <- newIORef 0\n  rec\n    t1 <- mask $ \\restore -> forkIO (thread restore r t2)\n    t2 <- mask $ \\restore -> forkIO (thread restore r t1)\n  threadDelay 1000000\n  readIORef r >>= print . (/= 0)\n\nthread restore r t = run\n  where\n    run = (restore $ forever $ do killThread t\n                                  i <- atomicModifyIORef r (\\i -> (i + 1, i))\n                                  evaluate i)\n             `catch` \\(e::SomeException) -> run\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DoRec, ScopedTypeVariables #-}\nimport Control.Concurrent\nimport Control.Exception\nimport Control.Monad\n\nmain = do\n  m <- newMVar 1\n  t1 <- mask $ \\restore -> forkIO $ thread restore m\n  t2 <- forkIO $ forever $ killThread t1\n  threadDelay 1000000\n  takeMVar m\n\nthread restore m = run\n  where \n    run = (restore $ forever $ modifyMVar_ m $ \\v -> if v `mod` 2 == 1 then return (v*2) else return (v-1))\n             `catch` \\(e::SomeException) -> run\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\nmain = do\n    m <- newMVar (0 :: Int)\n    Just 0 <- tryReadMVar m\n    takeMVar m\n    Nothing <- tryReadMVar m\n    return ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\nimport Control.Monad\n\nmain = do\n    m <- newEmptyMVar\n    done <- newEmptyMVar\n    let q = 200000\n    forkIO (do mapM (\\n -> putMVar m n) [1..q]; putMVar done ())\n    forkIO (do replicateM_ q $ readMVar m; putMVar done ())\n    forkIO (do replicateM_ q $ tryReadMVar m; putMVar done ())\n    forkIO (do replicateM_ q $ takeMVar m; putMVar done ())\n    replicateM_ 4 $ takeMVar done\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule Memo where\nimport Data.Bits\n\ntype Memo a = forall r. (a -> r) -> (a -> r)\n\n\nmemo2 :: Memo a -> Memo b -> (a -> b -> r) -> (a -> b -> r)\nmemo2 a b = a . (b .)\n\nwrap :: (a -> b) -> (b -> a) -> Memo a -> Memo b\nwrap i j m f = m (f . i) . j\n\n\npair :: Memo a -> Memo b -> Memo (a,b)\npair m m' f = uncurry (m (\\x -> m' (\\y -> f (x,y))))\n\n\nbits :: (Num a, Ord a, Bits a) => Memo a\nbits f = apply (fmap f identity)\n\ndata IntTrie a = IntTrie (BitTrie a) a (BitTrie a)  -- negative, 0, positive\ndata BitTrie a = BitTrie a (BitTrie a) (BitTrie a)\n\n\ninstance Functor BitTrie where\n    fmap f ~(BitTrie x l r) = BitTrie (f x) (fmap f l) (fmap f r)\n\n\n\ninstance Functor IntTrie where\n    fmap f ~(IntTrie neg z pos) = IntTrie (fmap f neg) (f z) (fmap f pos)\n\n-- | Apply the trie to an argument.  This is the semantic map.\napply :: (Ord b, Num b, Bits b) => IntTrie a -> b -> a\napply (IntTrie neg z pos) x =\n    case compare x 0 of\n        LT -> applyPositive neg (-x)\n        EQ -> z\n        GT -> applyPositive pos x\n\napplyPositive :: (Num b, Bits b) => BitTrie a -> b -> a\napplyPositive (BitTrie one eve od) x\n    | x == 1 = one\n    | testBit x 0 = applyPositive od (x `shiftR` 1)\n    | otherwise   = applyPositive eve (x `shiftR` 1)\n\nidentity :: (Num a, Bits a) => IntTrie a\nidentity = IntTrie (fmap negate identityPositive) 0 identityPositive\n\n\n\nidentityPositive :: (Num a, Bits a) => BitTrie a\nidentityPositive = go\n    where\n      go = BitTrie 1 (fmap (`shiftL` 1) go) (fmap (\\n -> (n `shiftL` 1) .|. 1) go)\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, DefaultSignatures, TypeOperators, FlexibleContexts #-}\n\nmodule Parallel\n    (NFData, parMap, rdeepseq) where\n\nimport Control.Monad\nimport GHC.Exts\nimport Control.DeepSeq\n\ninfixl 0 `using`\n\n\ntype Strategy a = a -> Eval a\n\nnewtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))\n\n\n\ninstance Functor Eval where\n  fmap = liftM\n\ninstance Applicative Eval where\n  pure x = Eval $ \\s -> (# s, x #)\n  (<*>)  = ap\n\ninstance Monad Eval where\n  return = pure\n  Eval x >>= k = Eval $ \\s -> case x s of\n                                (# s', a #) -> case k a of\n                                                      Eval f -> f s'\n\nrpar :: Strategy a\nrpar  x = Eval $ \\s -> spark# x s\n\nrparWith :: Strategy a -> Strategy a\nrparWith s a = do l <- rpar r; return (case l of Lift x -> x)\n  where r = case s a of\n              Eval f -> case f realWorld# of\n                          (# _, a' #) -> Lift a'\n\ndata Lift a = Lift a\n\nusing :: a -> Strategy a -> a\nx `using` strat = runEval (strat x)\n\n\nrdeepseq :: NFData a => Strategy a\nrdeepseq x = do rseq (rnf x); return x\n\nparList :: Strategy a -> Strategy [a]\nparList strat = traverse (rparWith strat)\n\nparMap :: Strategy b -> (a -> b) -> [a] -> [b]\nparMap strat f = (`using` parList strat) . map f\n\n\nrunEval :: Eval a -> a\nrunEval (Eval x) = case x realWorld# of (# _, a #) -> a\n\nrseq :: Strategy a\nrseq x = Eval $ \\s -> seq# x s\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule Main where\n\nimport Parallel\nimport qualified Memo\nimport qualified Data.Map.Lazy as M\nimport Control.DeepSeq\nimport Control.Monad.ST\nimport Data.STRef\n\nfight :: Int -> Int -> [Int]\nfight i a = map fst $ fightVanillaM i a\n\nfightVanillaM :: Int -> Int -> [(Int, Int)]\nfightVanillaM = Memo.memo2 Memo.bits Memo.bits fightVanilla\n\nfightVanilla :: Int -> Int -> [(Int, Int)]\nfightVanilla php ohp\n  | php <= 0 || ohp <= 0 = [(max 0 php, max 0 ohp)]\n  | otherwise = regroup $ do\n      (odmg, pdmg) <- [(9,3),(10,2),(11,2),(12,2),(14,1),(16,1),(18,0),(100,0),(100,0),(100,0)]\n      fightVanillaM (php - pdmg) (ohp - odmg)\n\nupdate :: Int -> Int -> [(Int, Int)]\nupdate i outcome = (,) outcome <$> fight i outcome\n\nmemoState :: Memo.Memo (Int, Int)\nmemoState = Memo.pair Memo.bits Memo.bits\n\nfibFight :: Int -> [Int]\nfibFight 0 = []\nfibFight 1 = []\nfibFight x = [(x - 1), (x - 2)]\n\n\n-----------------------------------------------------------------------------------\nregroup :: (NFData a, Show a, Eq a, Ord a) => [(a, Int)] -> [(a, Int)]\nregroup xs =\n    let xs' = M.toList $ M.fromListWith (+) xs\n        s' = addTheNumbers (map (\\(_,x) -> x) xs) -- sum (map snd xs')\n        s  = sum (map snd xs)\n     in if s' /= s\n            then if show s' == show s\n                    then error \"WAT????\"\n                    else error $ \"Those are expected to be equal\" ++ show (s', s)\n            else xs'\n----------------------------------------------------------------------------------\n\naddTheNumbers :: [Int] -> Int\naddTheNumbers xs0 = runST $ do\n  y <- newSTRef 0\n  let go [] = readSTRef y\n      go (x : xs) = do\n        modifySTRef y (+x)\n        go xs\n  go xs0\n\nmain :: IO ()\nmain = rnf (go (80, 250)) `seq` return ()\n    where\n        go = memoState (rnf . parMap rdeepseq (map go) . step)\nstep (cid, hp) = map (update hp) (fibFight cid)\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSignatures #-}\n\nimport Control.Monad\nimport Control.Parallel\nimport System.Environment\nimport System.Random\n\nsort (x:xs) = sort lesser ++ [x] ++ sort greater\n    where lesser = filter (<  x) xs\n          greater = filter (>= x) xs\nsort _ = []\n\n\npsort xs 10 = sort xs\npsort (x:xs) d = let d' = d + 1\n                     l = psort lesser d'\n                     g = psort greater d'\n              in l `par` g `par` (l ++ [x] ++ g)\n    where lesser = filter (<  x) xs\n          greater = filter (>= x) xs\npsort _ _ = []\n\nmain = do\n  args <- getArgs\n  let counts | null args = [100000]\n             | otherwise = map read args\n  rs :: [Int] <- randoms `fmap` getStdGen\n  forM_ counts $ \\k -> do\n    let xs = take k rs\n    print . length $ xs\n--    s <- getCurrentTime\n    print . length $ psort xs 0\n--    e <- getCurrentTime\n--    print (e `diffUTCTime` s)\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Cpr001\n    (intpInstr) where\n\nimport Cpr001_imp\n\n-- -------------------------------------------------------------------\n\nintpInstr       :: Instr -> MST ()\n\nintpInstr (SysCall \"exit\")\n    = setMTerminated\n\nintpInstr (SysCall call)\n    = setMSvc call\n\n-- -------------------------------------------------------------------\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- $Id: Cpr001_imp.hs,v 1.1 2001/08/22 12:21:15 simonmar Exp $\n\nmodule Cpr001_imp where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\ndata MS         = MS { instr    :: String\n                     , pc       :: Int\n                     , mem      :: String\n                     , stack    :: String\n                     , frames   :: [String]\n                     , status   :: Maybe String\n                     }\n\n\nnewtype StateTrans s a = ST ( s -> (s, Maybe a))\n\n-- state monad with error handling\n-- in case of an error, the state remains\n-- as it is and Nothing is returned as value\n-- else execution continues\n\ninstance Functor (StateTrans s) where\n    fmap = liftM\n\ninstance Applicative (StateTrans s) where\n    pure = return\n    (<*>) = ap\n\ninstance Monad (StateTrans s) where\n    (ST p) >>= k\n        = ST (\\s0 -> let\n                     (s1, r0)   = p s0\n                     in\n                     case r0 of\n                     Just v -> let\n                               (ST q) = k v\n                               in\n                               q s1\n                     Nothing -> (s1, Nothing)\n             )\n    return v\n        = ST (\\s -> (s, Just v))\n\n\n-- machine state transitions\n\ntype MachineStateTrans  = StateTrans MS\n\ntype MST = MachineStateTrans\n\n{-# NOINLINE setMTerminated #-}\nsetMTerminated\n    = ST (\\ms -> (ms { status = Just \"Terminated\" }, Just ()))\n\nsetMSvc call\n    = ST (\\ms -> (ms { status = Just \"Service\" }, Just ()))\n\n-- -------------------------------------------------------------------\n\ndata Instr\n    = LoadI             Int             -- load int const\n    | SysCall           String          -- system call (svc)\n\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "repeat' :: x -> [x]\nrepeat' x = x : repeat' x\n\nmain = print (repeat' () !! 10 )\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule Dep1 where\n\nimport Data.Kind\n\ndata Proxy k (a :: k) = P\n\nx :: Proxy Type Int\nx = P\n\ny :: Proxy Bool True\ny = P\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs #-}\n\nmodule Dep2 where\n\ndata G (a :: k) where\n  G1 :: G Int\n  G2 :: G Maybe\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, GADTs #-}\n\nmodule Dep3 where\n\nimport Data.Kind\nimport GHC.Exts ( Constraint )\n\ntype Star1 = Type\n\ndata Id1 (a :: Star1) where\n  Id1 :: a -> Id1 a\n\ndata Id1' :: Star1 -> Type where\n  Id1' :: a -> Id1' a\n\ntype family Star2 x where\n  Star2 x = Type\n\ndata Id2a (a :: Star2 Constraint) = Id2a a\n\n\ndata Id2 (a :: Star2 Constraint) where\n  Id2 :: a -> Id2 a\n\ndata Id2' :: Star2 Constraint -> Type where\n  Id2' :: a -> Id2' a\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}\n\nmodule DkNameRes where\n\nimport Data.Proxy\nimport Data.Kind\n\ntype family IfK (e :: Proxy (j :: Bool)) :: Type where\n   IfK (_ :: Proxy True) = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- This is the code extracted from \"A reflection on types\", by Simon PJ,\nStephanie Weirich, Richard Eisenberg, and Dimitrios Vytiniotis, 2016. -}\n\n-- NB: it includes a negative-recursive function (see delta1), and\n-- so will give \"simplifier ticks exhausted\", at least with -O\n\n{-#  LANGUAGE RankNTypes, PolyKinds, TypeOperators,\n             ScopedTypeVariables, GADTs, FlexibleInstances,\n             UndecidableInstances, RebindableSyntax,\n             DataKinds, MagicHash #-}\n{-# OPTIONS_GHC -Wno-missing-methods -Wno-redundant-constraints #-}\n{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}\n  -- Because we define a local Typeable class and have\n  --   instance Data.Typeable.Typeable a => Typeable a\n\nmodule Dynamic where\n\nimport Data.Map ( Map )\nimport qualified Data.Map as Map\nimport Unsafe.Coerce ( unsafeCoerce )\nimport Control.Monad ( (<=<) )\nimport Prelude hiding ( lookup, fromInteger, replicate )\nimport qualified Prelude\nimport qualified Data.Typeable\nimport qualified Data.Data\nimport Data.Kind\n\nlookupMap = Map.lookup\ninsertMap = Map.insert\n\n--  let's ignore overloaded numbers\nfromInteger :: Integer -> Int\nfromInteger = Prelude.fromInteger\n\ninsertStore = undefined\nschema = undefined\nwithTypeable = undefined\nthrow# = undefined\n\ntoDynamicST = undefined\nfromDynamicST = undefined\n\nextendStore  :: Typeable a => STRef s a -> a -> Store -> Store\nlookupStore  :: Typeable a => STRef s a -> Store -> Maybe a\n\ntype Key = Int\ndata STRef s a = STR Key\ntype Store = Map Key Dynamic\n\nextendStore (STR k) v  s =  insertMap k (toDynamicST v) s\nlookupStore (STR k)    s =  case lookupMap k s of\n                              Just d   -> fromDynamicST d\n                              Nothing  -> Nothing\n\ntoDynamicST    :: Typeable a => a -> Dynamic\nfromDynamicST  :: Typeable a => Dynamic -> Maybe a\n\neval = undefined\ndata Term\n\ndata DynamicSilly  =  DIntSilly  Int\n              |  DBoolSilly Bool\n              |  DCharSilly Char\n              |  DPairSilly DynamicSilly DynamicSilly\n\n\ntoDynInt :: Int -> DynamicSilly\ntoDynInt = DIntSilly\n\nfromDynInt :: DynamicSilly -> Maybe Int\nfromDynInt (DIntSilly n)  = Just n\nfromDynInt _         = Nothing\n\ntoDynPair :: DynamicSilly -> DynamicSilly -> DynamicSilly\ntoDynPair = DPairSilly\n\ndynFstSilly :: DynamicSilly -> Maybe DynamicSilly\ndynFstSilly (DPairSilly x1 x2) = Just x1\ndynFstSilly _             = Nothing\n\neval :: Term -> DynamicSilly\n\neqT = undefined\n\ninstance Typeable (->)\ninstance Typeable Maybe\ninstance Typeable Bool\ninstance Typeable Int\ninstance (Typeable a, Typeable b) => Typeable (a b)\ninstance Typeable (,)\n\ninstance Eq SomeTypeRep\n\ndata Dynamic where\n   Dyn :: TypeRep a -> a -> Dynamic\n\ntoDynamic :: Typeable a => a -> Dynamic\ntoDynamic x = Dyn typeRep x\n\neqTNoKind = undefined\n\neqTNoKind :: TypeRep a -> TypeRep b -> Maybe (a :***: b)\n   --  Primitive; implemented by compiler\n\ndata a :***: b where\n  ReflNoKind :: a :***: a\n\nfromDynamic :: forall d. Typeable d => Dynamic -> Maybe d\nfromDynamic (Dyn (ra :: TypeRep a) (x :: a))\n  =  case eqT ra (typeRep :: TypeRep d) of\n       Nothing    -> Nothing\n       Just Refl  -> Just x\n\nfromDynamicMonad :: forall d. Typeable d => Dynamic -> Maybe d\n\nfromDynamicMonad (Dyn ra x)\n  = do  Refl <- eqT ra (typeRep :: TypeRep d)\n        return x\n\ncast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b\ncast x = do  Refl <- eqT  (typeRep :: TypeRep a)\n                          (typeRep :: TypeRep b)\n             return x\n\ngcast :: forall a b c. (Typeable a, Typeable b) => c a -> Maybe (c b)\ngcast x = do  Refl <- eqT  (typeRep :: TypeRep a)\n                           (typeRep :: TypeRep b)\n              return x\n\ndata SameKind :: k -> k -> Type\ntype CheckAppResult = SameKind AppResult AppResultNoKind\n  --  not the most thorough check\nfoo :: AppResult x -> AppResultNoKind x\nfoo (App y z) = AppNoKind y z\n\nsplitApp :: TypeRep a -> Maybe (AppResult a)\nsplitApp = undefined\nsplitAppNoKind = undefined\nsplitAppNoKind :: TypeRep a -> Maybe (AppResultNoKind a)\n   --  Primitive; implemented by compiler\n\ndata AppResultNoKind t where\n  AppNoKind :: TypeRep a -> TypeRep b -> AppResultNoKind (a b)\n\ndynFstNoKind :: Dynamic -> Maybe Dynamic\ndynFstNoKind (Dyn rpab x)\n  = do  AppNoKind rpa rb  <- splitAppNoKind rpab\n        AppNoKind rp  ra  <- splitAppNoKind rpa\n        Refl        <- eqT rp (typeRep :: TypeRep (,))\n        return (Dyn ra (fst x))\n\ndynApply :: Dynamic -> Dynamic -> Maybe Dynamic\ndynApply (Dyn rf f) (Dyn rx x) = do\n    App ra rt2   <- splitApp rf\n    App rtc rt1  <- splitApp ra\n    Refl         <- eqT rtc (typeRep :: TypeRep (->))\n    Refl         <- eqT rt1 rx\n    return (Dyn rt2 (f x))\n\ndata TypeRepAbstract (a :: k)  --  primitive, indexed by type and kind\n\nclass Typeable (a :: k) where\n   typeRep :: TypeRep a\n\ndata AppResult (t :: k) where\n  App ::  forall k1 k (a :: k1 -> k) (b :: k1).\n          TypeRep a -> TypeRep b -> AppResult (a b)\n\ndynFst :: Dynamic -> Maybe Dynamic\ndynFst (Dyn (rpab :: TypeRep pab) (x :: pab))\n\n  = do  App (rpa  :: TypeRep pa ) (rb :: TypeRep b)  <- splitApp rpab\n            --  introduces kind |k2|, and types |pa :: k2 -> Type|, |b :: k2|\n\n        App (rp   :: TypeRep p  ) (ra :: TypeRep a)  <- splitApp rpa\n            --  introduces kind |k1|, and types |p :: k1 -> k2 -> Type|,\n            --                                  |a :: k1|\n\n        Refl       <- eqT rp (typeRep :: TypeRep (,))\n            --  introduces |p ~ (,)| and\n            --             |(k1 -> k2 -> Type) ~ (Type -> Type -> Type)|\n\n        return (Dyn ra (fst x))\n\neqT :: forall k1 k2 (a :: k1) (b :: k2).\n       TypeRep a -> TypeRep b -> Maybe (a :~: b)\n\ndata (a :: k1) :~: (b :: k2) where\n  Refl :: forall k (a :: k). a :~: a\n\ncastDance :: (Typeable a, Typeable b)  => a -> Maybe b\ncastDance = castR typeRep typeRep\n\nwithTypeable :: TypeRep a -> (Typeable a => r) -> r\n\ncastR :: TypeRep a -> TypeRep b -> a -> Maybe b\ncastR ta tb = withTypeable ta (withTypeable tb castDance)\n\ncmpT = undefined\ncompareTypeRep = undefined\n\ndata SomeTypeRep where\n   SomeTypeRep :: TypeRep a -> SomeTypeRep\n\ntype TyMapLessTyped = Map SomeTypeRep Dynamic\n\ninsertLessTyped :: forall a. Typeable a => a -> TyMapLessTyped -> TyMapLessTyped\ninsertLessTyped x\n  = Map.insert (SomeTypeRep (typeRep :: TypeRep a)) (toDynamic x)\n\nlookupLessTyped :: forall a. Typeable a => TyMapLessTyped -> Maybe a\nlookupLessTyped\n  = fromDynamic <=< Map.lookup (SomeTypeRep (typeRep :: TypeRep a))\n\ninstance Ord SomeTypeRep where\n  compare (SomeTypeRep tr1) (SomeTypeRep tr2) = compareTypeRep tr1 tr2\n\ncompareTypeRep :: TypeRep a -> TypeRep b -> Ordering  --  primitive\n\ndata TyMap = Empty | Node Dynamic TyMap TyMap\n\nlookup :: TypeRep a -> TyMap -> Maybe a\nlookup tr1 (Node (Dyn tr2 v) left right) =\n  case compareTypeRep tr1 tr2 of\n    LT  -> lookup tr1 left\n    EQ  -> castR tr2 tr1 v   --  know this cast will succeed\n    GT  -> lookup tr1 right\nlookup tr1 Empty = Nothing\n\ncmpT :: TypeRep a -> TypeRep b -> OrderingT a b\n  --  definition is primitive\n\ndata OrderingT a b where\n  LTT  :: OrderingT a b\n  EQT  :: OrderingT t t\n  GTT  :: OrderingT a b\n\ndata TypeRep (a :: k) where\n  TrApp    :: TypeRep a -> TypeRep b -> TypeRep (a b)\n  TrTyCon  :: TyCon -> TypeRep k -> TypeRep (a :: k)\n\ndata TyCon = TyCon { tc_module :: Module, tc_name :: String }\ndata Module = Module { mod_pkg :: String, mod_name :: String }\n\ntcMaybe  :: TyCon\ntcMaybe  = TyCon  { tc_module  = Module  { mod_pkg   = \"base\"\n                                               , mod_name  = \"Data.Maybe\" }\n                        , tc_name    = \"Maybe\" }\n\nrt = undefined\n\ndelta1 :: Dynamic -> Dynamic\n-- NB: this function behaves like a negative-recursive data type\n-- and hence leads compiler into an infinite inlining loop,\n-- and we get \"simplifier ticks exhausted\".\n-- See Section 7 of the paper \"A reflection on types\"\ndelta1 dn = case fromDynamic dn of\n             Just f   -> f dn\n             Nothing  -> dn\nloop1 = delta1 (toDynamic delta1)\n\ndata Rid = MkT (forall a. TypeRep a -> a -> a)\nrt :: TypeRep Rid\ndelta :: forall a. TypeRep a -> a -> a\ndelta ra x = case (eqT ra rt) of\n             Just Refl  -> case x of MkT y -> y rt x\n             Nothing    -> x\nloop = delta rt (MkT delta)\n\nthrow# :: SomeException -> a\n\ndata SomeException where\n  SomeException :: Exception e => e -> SomeException\n\nclass (Typeable e, Show e) => Exception e where {   }\n\ndata Company\ndata Salary\nincS :: Float -> Salary -> Salary\nincS = undefined\n\n--  some impedance matching with SYB\ninstance Data.Data.Data Company\ninstance {-#  INCOHERENT  #-} Data.Typeable.Typeable a => Typeable a\n\nmkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a\nmkT f x = case (cast f) of\n            Just g   -> g x\n            Nothing  -> x\n\ndata Expr a\nfrontEnd = undefined\n\ndata DynExp where\n  DE :: TypeRep a -> Expr a -> DynExp\n\nfrontEnd :: String -> DynExp\n\ndata TyConOld\n\ntypeOf = undefined\neqTOld = undefined\nfunTcOld = undefined :: TyConOld\nsplitTyConApp = undefined\nmkTyCon3 = undefined\nboolTcOld = undefined\ntupleTc = undefined\nmkTyConApp = undefined\ninstance Eq TypeRepOld\ninstance Eq TyConOld\n\ndata TypeRepOld       --  Abstract\n\nclass TypeableOld a where\n  typeRepOld :: proxy a -> TypeRepOld\n\ndata DynamicOld where\n   DynOld :: TypeRepOld -> a -> DynamicOld\n\ndata Proxy a = Proxy\n\nfromDynamicOld :: forall d. TypeableOld d => DynamicOld -> Maybe d\nfromDynamicOld (DynOld trx x)\n | typeRepOld (Proxy :: Proxy d) == trx  = Just (unsafeCoerce x)\n | otherwise                          = Nothing\n\ndynApplyOld :: DynamicOld -> DynamicOld -> Maybe DynamicOld\ndynApplyOld (DynOld trf f) (DynOld trx x) =\n  case splitTyConApp trf of\n      (tc, [t1,t2]) | tc == funTcOld && t1 == trx ->\n          Just (DynOld t2 ((unsafeCoerce f) x))\n      _ -> Nothing\n\ndata DynamicClosed where\n  DynClosed :: TypeRepClosed a -> a -> DynamicClosed\n\ndata TypeRepClosed (a :: Type) where\n  TBool  :: TypeRepClosed Bool\n  TFun   :: TypeRepClosed a -> TypeRepClosed b -> TypeRepClosed (a -> b)\n  TProd  :: TypeRepClosed a -> TypeRepClosed b -> TypeRepClosed (a, b)\n\n\nlookupPil = undefined\n\nlookupPil :: Typeable a => [Dynamic] -> Maybe a\n\ndata Dyn1 = Dyn1 Int\n         | DynFun (Dyn1 -> Dyn1)\n         | DynPair (Dyn1, Dyn1)\n\ndata TypeEnum = IntType | FloatType | BoolType | DateType | StringType\ndata Schema = Object [Schema] |\n              Field TypeEnum |\n              Array Schema\n\nschema :: Typeable a => a -> Schema\n", "num_lines": 357}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule InferDependency where\n\ndata Proxy k (a :: k)\ndata Proxy2 k a = P (Proxy k a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs, ExplicitForAll #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n\nmodule KindEqualities where\n\nimport Data.Kind\n\ndata TyRep1 :: Type -> Type where\n  TyInt1 :: TyRep1 Int\n  TyBool1 :: TyRep1 Bool\n\nzero1 :: forall a. TyRep1 a -> a\nzero1 TyInt1 = 0\nzero1 TyBool1 = False\n\ndata Proxy (a :: k) = P\n\ndata TyRep :: forall k. k -> Type where\n  TyInt :: TyRep Int\n  TyBool :: TyRep Bool\n  TyMaybe :: TyRep Maybe\n  TyApp :: TyRep a -> TyRep b -> TyRep (a b)\n\nzero :: forall (a :: Type). TyRep a -> a\nzero TyInt = 0\nzero TyBool = False\nzero (TyApp TyMaybe _) = Nothing\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, GADTs, PolyKinds, TypeFamilies, ExplicitForAll,\n             TemplateHaskell, UndecidableInstances, ScopedTypeVariables #-}\n\nmodule KindEqualities2 where\n\nimport Data.Kind\nimport GHC.Exts ( Any )\n\ndata Kind = Star | Arr Kind Kind\n\ndata Ty :: Kind -> Type where\n  TInt :: Ty Star\n  TBool :: Ty Star\n  TMaybe :: Ty (Arr Star Star)\n  TApp :: Ty (Arr k1 k2) -> Ty k1 -> Ty k2\n\n\ndata TyRep (k :: Kind) (t :: Ty k) where\n  TyInt :: TyRep Star TInt\n  TyBool :: TyRep Star TBool\n  TyMaybe :: TyRep (Arr Star Star) TMaybe\n  TyApp :: TyRep (Arr k1 k2) a -> TyRep k1 b -> TyRep k2 (TApp a b)\n\ntype family IK (k :: Kind)\ntype instance IK Star = Type\ntype instance IK (Arr k1 k2) = IK k1 -> IK k2\n\n$(return [])  -- necessary because the following instances depend on the\n              -- previous ones.\n\ntype family I (t :: Ty k) :: IK k\ntype instance I TInt = Int\ntype instance I TBool = Bool\ntype instance I TMaybe = Maybe\ntype instance I (TApp a b) = (I a) (I b)\n\nzero :: forall (a :: Ty 'Star). TyRep Star a -> I a\nzero TyInt = 0\nzero TyBool = False\nzero (TyApp TyMaybe TyInt) = Nothing\n\nmain = print $ zero (TyApp TyMaybe TyInt)\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule KindLevels where\n\nimport Data.Kind\n\ndata A\ndata B :: A -> Type\ndata C :: B a -> Type\ndata D :: C b -> Type\ndata E :: D c -> Type\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, PolyKinds #-}\n\nmodule GADTVars where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata T (k1 :: Type) (k2 :: Type) (a :: k2) (b :: k2) where\n  MkT :: T x1 Type (Proxy (y :: x1), z) z\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeOperators, PolyKinds, DataKinds,\n             TypeFamilies #-}\n\nmodule A where\n\nimport Data.Kind\n\ndata family Sing (k :: Type) :: k -> Type\ntype Sing' (x :: k) = Sing k x\ndata TyFun' (a :: Type) (b :: Type) :: Type\ntype TyFun (a :: Type) (b :: Type) = TyFun' a b -> Type\ntype family (a :: TyFun k1 k2) @@ (b :: k1) :: k2\ndata TyPi' (a :: Type) (b :: TyFun a Type) :: Type\ntype TyPi (a :: Type) (b :: TyFun a Type) = TyPi' a b -> Type\ntype family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b\n$(return [])\n\ndata A (a :: Type) (b :: a) (c :: TyFun' a Type)\n  -- A :: forall a -> a -> a ~> Type\ntype instance (@@) (A a b) c = Type\n$(return [])\ndata B (a :: Type) (b :: TyFun' a Type)\n  -- B :: forall a -> a ~> Type\ntype instance (@@) (B a) b = TyPi a (A a b)\n$(return [])\ndata C (a :: Type) (b :: TyPi a (B a)) (c :: a) (d :: a)\n       (e :: TyFun' (b @@@ c @@@ d) Type)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, GADTs, TypeOperators, TypeFamilies #-}\n{-# OPTIONS_GHC -fwarn-unticked-promoted-constructors #-}\n\nmodule RaeBlogPost where\n\nimport Data.Kind\n\n-- a Proxy type with an explicit kind\ndata Proxy k (a :: k) = P\nprox :: Proxy Type Bool\nprox = P\n\nprox2 :: Proxy Bool 'True\nprox2 = P\n\n-- implicit kinds still work\ndata A\ndata B :: A -> Type\ndata C :: B a -> Type\ndata D :: C b -> Type\ndata E :: D c -> Type\n-- note that E :: forall (a :: A) (b :: B a) (c :: C b). D c -> Type\n\n-- a kind-indexed GADT\ndata TypeRep (a :: k) where\n  TInt   :: TypeRep Int\n  TMaybe :: TypeRep Maybe\n  TApp   :: TypeRep a -> TypeRep b -> TypeRep (a b)\n\nzero :: TypeRep a -> a\nzero TInt            = 0\nzero (TApp TMaybe _) = Nothing\n\ndata Nat = Zero | Succ Nat\ntype family a + b where\n  'Zero     + b = b\n  ('Succ a) + b = 'Succ (a + b)\n\ndata Vec :: Type -> Nat -> Type where\n  Nil  :: Vec a 'Zero\n  (:>) :: a -> Vec a n -> Vec a ('Succ n)\ninfixr 5 :>\n\n-- promoted GADT, and using + as a \"kind family\":\ntype family (x :: Vec a n) ++ (y :: Vec a m) :: Vec a (n + m) where\n  'Nil      ++ y = y\n  (h ':> t) ++ y = h ':> (t ++ y)\n\n-- datatype that mentions Type\ndata U = Star (Type)\n       | Bool Bool\n\n-- kind synonym\ntype Monadish = Type -> Type\nclass MonadTrans (t :: Monadish -> Monadish) where\n  lift :: Monad m => m a -> t m a\ndata Free :: Monadish where\n  Return :: a -> Free a\n  Bind   :: Free a -> (a -> Free b) -> Free b\n\n-- yes, Type really does have type Type.\ntype Star = (Type :: (Type :: (Type :: Type)))\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- Copyright (c) 2016 Richard Eisenberg\n -}\n\n{-# LANGUAGE TypeOperators, TypeFamilies, TypeApplications, AllowAmbiguousTypes,\n             ExplicitForAll, ScopedTypeVariables, GADTs, TypeFamilyDependencies,\n             DataKinds, PolyKinds , ConstraintKinds, UndecidableInstances,\n             FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleContexts, StandaloneDeriving, InstanceSigs,\n             RankNTypes, UndecidableSuperClasses #-}\n\nmodule RaeJobTalk where\n\nimport Data.Type.Bool\nimport Data.Type.Equality hiding ((:~~:)(..))\nimport GHC.TypeLits\nimport Data.Proxy\nimport GHC.Exts\nimport Data.Kind\nimport Unsafe.Coerce\nimport Data.Char\nimport Data.Maybe\n\n-------------------------------\n-- Utilities\n\n-- Heterogeneous propositional equality\ndata (a :: k1) :~~: (b :: k2) where\n  HRefl :: a :~~: a\n\n-- Type-level inequality\ntype a /= b = Not (a == b)\n\n-- append type-level lists (schemas)\ntype family s1 ++ s2 where\n  '[]       ++ s2 = s2\n  (s ': s1) ++ s2 = s ': (s1 ++ s2)\n\n-- This is needed in order to prove disjointness, because GHC can't\n-- handle inequality well.\nassumeEquality :: forall a b r. ((a ~ b) => r) -> r\nassumeEquality thing = case unsafeCoerce Refl :: a :~: b of\n  Refl -> thing\n\n-- Shorter name for shorter example\neq :: TestEquality f => f a -> f b -> Maybe (a :~: b)\neq = testEquality\n\n-------------------------------\n-- Singleton lists\n\n-- Unlike in the singletons paper, we now have injective type\n-- families, so we use that to model singletons; it's a bit\n-- cleaner than the original approach\ntype family Sing = (r :: k -> Type) | r -> k\n\n-- Cute type synonym.\ntype \u00ce\u00a0 = Sing\n\n-- Really, just singleton lists. Named Schema for better output\n-- during example.\ndata Schema :: forall k. [k] -> Type where\n  Nil :: Schema '[]\n  (:>>) :: Sing h -> Schema t -> Schema (h ': t)\ninfixr 5 :>>\ntype instance Sing = Schema\n\n-- Append singleton lists\n(%:++) :: Schema a -> Schema b -> Schema (a ++ b)\nNil %:++ x = x\n(a :>> b) %:++ c = a :>> (b %:++ c)\n\n--------------------------------\n-- Type-indexed type representations\n-- Based on \"A reflection on types\"\n\ndata TyCon (a :: k) where\n  Int :: TyCon Int\n  Bool :: TyCon Bool\n  Char :: TyCon Char\n  List :: TyCon []\n  Maybe :: TyCon Maybe\n  Arrow :: TyCon (->)\n  TYPE  :: TyCon TYPE\n  RuntimeRep :: TyCon RuntimeRep\n  LiftedRep' :: TyCon 'LiftedRep\n  -- If extending, add to eqTyCon too\n\neqTyCon :: TyCon a -> TyCon b -> Maybe (a :~~: b)\neqTyCon Int Int = Just HRefl\neqTyCon Bool Bool = Just HRefl\neqTyCon Char Char = Just HRefl\neqTyCon List List = Just HRefl\neqTyCon Maybe Maybe = Just HRefl\neqTyCon Arrow Arrow = Just HRefl\neqTyCon TYPE TYPE = Just HRefl\neqTyCon RuntimeRep RuntimeRep = Just HRefl\neqTyCon LiftedRep' LiftedRep' = Just HRefl\neqTyCon _ _ = Nothing\n\n-- Check whether or not a type is really a plain old tycon;\n-- necessary to avoid warning in kindRep\ntype family Primitive (a :: k) :: Constraint where\n  Primitive (_ _) = ('False ~ 'True)\n  Primitive _     = (() :: Constraint)\n\ndata TypeRep (a :: k) where\n  TyCon :: forall k (a :: k). (Primitive a, Typeable k) => TyCon a -> TypeRep a\n  TyApp :: TypeRep a -> TypeRep b -> TypeRep (a b)\n\n-- Equality on TypeReps\neqT :: TypeRep a -> TypeRep b -> Maybe (a :~~: b)\neqT (TyCon tc1) (TyCon tc2) = eqTyCon tc1 tc2\neqT (TyApp f1 a1) (TyApp f2 a2) = do\n  HRefl <- eqT f1 f2\n  HRefl <- eqT a1 a2\n  return HRefl\neqT _ _ = Nothing\n\n\n--------------------------------------\n-- Existentials\n\ndata TyConX where\n  TyConX :: forall k (a :: k). (Primitive a, Typeable k) => TyCon a -> TyConX\n\ninstance Read TyConX where\n  readsPrec _ \"Int\" = [(TyConX Int, \"\")]\n  readsPrec _ \"Bool\" = [(TyConX Bool, \"\")]\n  readsPrec _ \"List\" = [(TyConX List, \"\")]\n  readsPrec _ _ = []\n\n-- This variant of SomeTypeRep allows you to specify an arbitrary\n-- constraint on the inner TypeRep\ndata SomeTypeRep :: (forall k. k -> Constraint) -> Type where\n  SomeTypeRep :: forall k (c :: forall k'. k' -> Constraint) (a :: k).\n              c a => TypeRep a -> SomeTypeRep c\n\n-- This constraint is always satisfied\nclass ConstTrue (a :: k) -- needs the :: k to make it a specified tyvar\ninstance ConstTrue a\n\ninstance Show (SomeTypeRep ConstTrue) where\n  show (SomeTypeRep tr) = show tr\n\n-- can't write Show (SomeTypeRep c) because c's kind mentions a forall,\n-- and the impredicativity check gets nervous. See #11519\ninstance Show (SomeTypeRep IsType) where\n  show (SomeTypeRep tr) = show tr\n\n-- Just enough functionality to get through example. No parentheses\n-- or other niceties.\ninstance Read (SomeTypeRep ConstTrue) where\n  readsPrec p s = do\n    let tokens = words s\n    tyreps <- mapM read_token tokens\n    return (foldl1 mk_app tyreps, \"\")\n\n    where\n      read_token :: String -> [SomeTypeRep ConstTrue]\n      read_token \"String\" = return (SomeTypeRep $ typeRep @String)\n      read_token other = do\n        (TyConX tc, _) <- readsPrec p other\n        return (SomeTypeRep (TyCon tc))\n\n      mk_app :: SomeTypeRep ConstTrue -> SomeTypeRep ConstTrue -> SomeTypeRep ConstTrue\n      mk_app (SomeTypeRep f) (SomeTypeRep a) = case kindRep f of\n        TyCon Arrow `TyApp` k1 `TyApp` _\n          | Just HRefl <- k1 `eqT` kindRep a -> SomeTypeRep (TyApp f a)\n        _ -> error \"ill-kinded type\"\n\n-- instance Read (SomeTypeRep ((~~) Type))  RAE: need (~~) :: forall k1. k1 -> forall k2. k2 -> Constraint\n-- RAE: need kind signatures on classes\n\n-- SomeTypeRep ((~~) Type)\n-- (~~) :: forall k1 k2. k1 -> k2 -> Constraint\n-- I need: (~~) :: forall k1. k1 -> forall k2. k2 -> Constraint\n\nclass k ~~ Type => IsType (x :: k)\ninstance k ~~ Type => IsType (x :: k)\n\ninstance Read (SomeTypeRep IsType) where\n  readsPrec p s = case readsPrec @(SomeTypeRep ConstTrue) p s of\n    [(SomeTypeRep tr, \"\")]\n      | Just HRefl <- eqT (kindRep tr) (typeRep @Type)\n      -> [(SomeTypeRep tr, \"\")]\n    _ -> error \"wrong kind\"\n\n-----------------------------\n-- Get the kind of a type\n\nkindRep :: TypeRep (a :: k) -> TypeRep k\nkindRep (TyCon _) = typeRep\nkindRep (TyApp (f :: TypeRep (tf :: k1 -> k)) _) = case kindRep f :: TypeRep (k1 -> k) of\n  TyApp _ res -> res\n\n-- Convert an explicit TypeRep into an implicit one. Doesn't require unsafeCoerce\n-- in Core\nwithTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r\nwithTypeable tr thing = unsafeCoerce (Don'tInstantiate thing :: DI a r) tr\nnewtype DI a r = Don'tInstantiate (Typeable a => r)\n\n-----------------------------\n-- Implicit TypeReps (Typeable)\n\nclass (Primitive a, Typeable k) => TyConAble (a :: k) where\n  tyCon :: TyCon a\n\ninstance TyConAble Int       where tyCon = Int\ninstance TyConAble Bool      where tyCon = Bool\ninstance TyConAble Char      where tyCon = Char\ninstance TyConAble []        where tyCon = List\ninstance TyConAble Maybe     where tyCon = Maybe\ninstance TyConAble (->)      where tyCon = Arrow\ninstance TyConAble TYPE      where tyCon = TYPE\ninstance TyConAble 'LiftedRep   where tyCon = LiftedRep'\ninstance TyConAble RuntimeRep    where tyCon = RuntimeRep\n\n-- Can't just define Typeable the way we want, because the instances\n-- overlap. So we have to mock up instance chains via closed type families.\nclass Typeable' a (b :: Bool) where\n  typeRep' :: TypeRep a\n\ntype family CheckPrim a where\n  CheckPrim (_ _) = 'False\n  CheckPrim _     = 'True\n\n-- NB: We need the ::k and the ::Constraint so that this has a CUSK, allowing\n-- the polymorphic recursion with TypeRep. See also #9200, though the requirement\n-- for the constraints is correct.\ntype Typeable (a :: k) = (Typeable' a (CheckPrim a) :: Constraint)\n\ninstance TyConAble a => Typeable' a 'True where\n  typeRep' = TyCon tyCon\n\ninstance (Typeable a, Typeable b) => Typeable' (a b) 'False where\n  typeRep' = TyApp typeRep typeRep\n\ntypeRep :: forall a. Typeable a => TypeRep a\ntypeRep = typeRep' @_ @(CheckPrim a)\n\n-----------------------------\n-- Useful instances\n\ninstance Show (TypeRep a) where\n  show (TyCon tc) = show tc\n  show (TyApp tr1 tr2) = show tr1 ++ \" \" ++ show tr2\n\nderiving instance Show (TyCon a)\n\ninstance TestEquality TypeRep where\n  testEquality tr1 tr2\n    | Just HRefl <- eqT tr1 tr2\n    = Just Refl\n    | otherwise\n    = Nothing\n\n---------------------------\n-- More singletons\n\n-- a TypeRep really is a singleton\ntype instance Sing = (TypeRep :: Type -> Type)\n\ndata SSymbol :: Symbol -> Type where\n  SSym :: KnownSymbol s => SSymbol s\ntype instance Sing = SSymbol\n\ninstance TestEquality SSymbol where\n  testEquality :: forall s1 s2. SSymbol s1 -> SSymbol s2 -> Maybe (s1 :~: s2)\n  testEquality SSym SSym = sameSymbol @s1 @s2 Proxy Proxy\n\ninstance Show (SSymbol name) where\n  show s@SSym = symbolVal s\n\n\n--------------\n-- Finds Read and Show instances for the example\ngetReadShowInstances :: TypeRep a\n                     -> ((Show a, Read a) => r)\n                     -> r\ngetReadShowInstances tr thing\n  | Just HRefl <- eqT tr (typeRep @Int) = thing\n  | Just HRefl <- eqT tr (typeRep @Bool) = thing\n  | Just HRefl <- eqT tr (typeRep @Char) = thing\n\n  | TyApp list_rep elt_rep <- tr\n  , Just HRefl <- eqT list_rep (typeRep @[])\n  = getReadShowInstances elt_rep $ thing\n\n  | otherwise = error $ \"I don't know how to read or show \" ++ show tr\n\n-------------------------\n-- A named column in our database\ndata Column = Attr Symbol Type\ntype Col = 'Attr\n\n-- Singleton for columns\ndata SColumn :: Column -> Type where\n  Col :: Sing s -> TypeRep ty -> SColumn (Col s ty)\ntype instance Sing = SColumn\n\n-- Extract the type of a column\ntype family ColType col where\n  ColType (Col _ ty) = ty\n\n-- A schema is an ordered list of named attributes\ntype TSchema = [Column]\n\n-- predicate to check that a schema is free of a certain attribute\ntype family ColNotIn name s where\n  ColNotIn _    '[]                    = 'True\n  ColNotIn name ((Col name' _) ': t) =\n    (name /= name') && (ColNotIn name t)\n\n-- predicate to check that two schemas are disjoint\ntype family Disjoint s1 s2 where\n  Disjoint '[]      _ = 'True\n  Disjoint ((Col name ty) ': t) s = (ColNotIn name s) && (Disjoint t s)\n\n-- A Row is one row of our database table, keyed by its schema.\ndata Row :: TSchema -> Type where\n  EmptyRow :: Row '[]\n  (::>) :: ColType col -> Row s -> Row (col ': s)\ninfixr 5 ::>\n\n-- Map a predicate over all the types in a schema\ntype family AllSchemaTys c sch where\n  AllSchemaTys _ '[] = (() :: Constraint)\n  AllSchemaTys c (col ': cols) = (c (ColType col), AllSchemaTys c cols)\n\n-- Convenient abbreviations for being to print and parse the types\n-- in a schema\ntype ShowSchema s = AllSchemaTys Show s\ntype ReadSchema s = AllSchemaTys Read s\n\n-- We can easily print out rows, as long as the data are printable\ninstance ShowSchema s => Show (Row s) where\n  show EmptyRow  = \"\"\n  show (h ::> t) = show h ++ \" \" ++ show t\n\n-- In our simplistic case, we just store the list of rows. A more\n-- sophisticated implementation could store some identifier to the connection\n-- to an external database.\ndata Table :: TSchema -> Type where\n  Table :: [Row s] -> Table s\n\ninstance ShowSchema s => Show (Table s) where\n  show (Table rows) = unlines (map show rows)\n\n-- The following functions parse our very simple flat file database format.\n\n-- The file, with a name ending in \".table\", consists of a sequence of lines,\n-- where each line contains one entry in the table. There is no row separator;\n-- if a row contains n pieces of data, that row is represented in n lines in\n-- the file.\n\n-- A schema is stored in a file ending in \".schema\".\n-- Each line is a column name followed by its type.\n\n-- Read a row of a table\nreadRow :: ReadSchema s => Schema s -> [String] -> (Row s, [String])\nreadRow Nil             strs    = (EmptyRow, strs)\nreadRow (_ :>> _)       []      = error \"Ran out of data while processing row\"\nreadRow (_ :>> schTail) (sh:st) = (read sh ::> rowTail, strTail)\n  where (rowTail, strTail) = readRow schTail st\n\n-- Read in a table\nreadRows :: ReadSchema s => Schema s -> [String] -> [Row s]\nreadRows _   []  = []\nreadRows sch lst = (row : tail)\n  where (row, strTail) = readRow  sch lst\n        tail           = readRows sch strTail\n\n-- Read in one line of a .schema file. Note that the type read must have kind *\nreadCol :: String -> (String, SomeTypeRep IsType)\nreadCol str = case break isSpace str of\n  (name, ' ' : ty) -> (name, read ty)\n  _                -> schemaError $ \"Bad parse of \" ++ str\n\n-- Load in a schema.\nwithSchema :: String\n           -> (forall (s :: TSchema). Schema s -> IO a)\n           -> IO a\nwithSchema filename thing_inside = do\n  schString <- readFile filename\n  let schEntries = lines schString\n      cols       = map readCol schEntries\n  go cols thing_inside\n  where\n    go :: [(String, SomeTypeRep IsType)]\n       -> (forall (s :: TSchema). Schema s -> IO a)\n       -> IO a\n    go []                           thing = thing Nil\n    go ((name, SomeTypeRep tr) : cols) thing\n      = go cols $ \\schema ->\n        case someSymbolVal name of\n          SomeSymbol (_ :: Proxy name) ->\n            thing (Col (SSym @name) tr :>> schema)\n\n-- Load in a table of a given schema\nloadTable :: ReadSchema s => String -> Schema s -> IO (Table s)\nloadTable name schema = do\n  dataString <- readFile name\n  return (Table $ readRows schema (lines dataString))\n\n-- In order to define strongly-typed projection from a row, we need to have a notion\n-- that one schema is a subset of another. We permit the schemas to have their columns\n-- in different orders. We define this subset relation via two inductively defined\n-- propositions. In Haskell, these inductively defined propositions take the form of\n-- GADTs. In their original form, they would look like this:\n{-\ndata InProof :: Column -> Schema -> Type where\n  InHere  :: InProof col (col ': schTail)\n  InThere :: InProof col cols -> InProof col (a ': cols)\n\ndata SubsetProof :: Schema -> Schema -> Type where\n  SubsetEmpty :: SubsetProof '[] s'\n  SubsetCons  :: InProof col s' -> SubsetProof cols s'\n              -> SubsetProof (col ': cols) s'\n-}\n-- However, it would be convenient to users of the database library not to require\n-- building these proofs manually. So, we define type classes so that the compiler\n-- builds the proofs automatically. To make everything work well together, we also\n-- make the parameters to the proof GADT constructors implicit -- i.e. in the form\n-- of type class constraints.\n\ndata InProof :: Column -> TSchema -> Type where\n  InHere  :: InProof col (col ': schTail)\n  InThere :: In name u cols => InProof (Col name u) (a ': cols)\n\nclass In (name :: Symbol) (u :: Type) (sch :: TSchema) where\n  inProof :: InProof (Col name u) sch\n\n-- These instances must be INCOHERENT because they overlap badly. The coherence\n-- derives from the fact that one schema will mention a name only once, but this\n-- is beyond our capabilities to easily encode, given the lack of a solver for\n-- type-level finite maps.\ninstance {-# INCOHERENT #-} In name u ((Col name u) ': schTail) where\n  inProof = InHere\ninstance {-# INCOHERENT #-} In name u cols => In name u (a ': cols) where\n  inProof = InThere\n\ndata SubsetProof :: TSchema -> TSchema -> Type where\n  SubsetEmpty :: SubsetProof '[] s'\n  SubsetCons :: (In name u s', Subset cols s')\n             => Proxy name -> Proxy u -> SubsetProof ((Col name u) ': cols) s'\n\nclass SubsetSupport s s' => Subset (s :: TSchema) (s' :: TSchema) where\n  subset :: SubsetProof s s'\n\n  -- The use of this constraint family allows us to assume a subset relationship\n  -- when we recur on the structure of s.\n  type SubsetSupport s s' :: Constraint\n\ninstance Subset '[] s' where\n  subset = SubsetEmpty\n  type SubsetSupport '[] s' = ()\n\ninstance (In name u s', Subset cols s') =>\n           Subset ((Col name u) ': cols) s' where\n  subset = SubsetCons Proxy Proxy\n  type SubsetSupport ((Col name u) ': cols) s' = Subset cols s'\n\n-- To access the data in a structured (and well-typed!) way, we use\n-- an RA (short for Relational Algebra). An RA is indexed by the schema\n-- of the data it produces.\n\ndata RA :: TSchema -> Type where\n  -- The RA includes all data represented by the handle.\n  Read :: Table s -> RA s\n\n  -- The RA is a Cartesian product of the two RAs provided. Note that\n  -- the schemas of the two provided RAs must be disjoint.\n  Product :: (Disjoint s s' ~ 'True) => RA s -> RA s' -> RA (s ++ s')\n\n  -- The RA is a projection conforming to the schema provided. The\n  -- type-checker ensures that this schema is a subset of the data\n  -- included in the provided RA.\n  Project :: Subset s' s => RA s -> RA s'\n\n  -- The RA contains only those rows of the provided RA for which\n  -- the provided expression evaluates to True. Note that the\n  -- schema of the provided RA and the resultant RA are the same\n  -- because the columns of data are the same. Also note that\n  -- the expression must return a Bool for this to type-check.\n  Select :: Expr s Bool -> RA s -> RA s\n\n-- Other constructors would be added in a more robust database\n-- implementation.\n\n-- An Expr is used with the Select constructor to choose some\n-- subset of rows from a table. Expressions are indexed by the\n-- schema over which they operate and the return value they\n-- produce.\ndata Expr :: TSchema -> Type -> Type where\n  (:+), (:-), (:*), (:/) :: Expr s Int -> Expr s Int -> Expr s Int\n\n  (:<), (:<=), (:>), (:>=), (:==), (:/=)\n    :: Ord a => Expr s a -> Expr s a -> Expr s Bool\n\n  -- A literal\n  Literal :: ty -> Expr s ty\n\n  -- element of a list\n  ElementOf :: Eq ty => Expr s ty -> Expr s [ty] -> Expr s Bool\n\n  -- Projection in an expression -- evaluates to the value\n  -- of the named column.\n  Element :: In name ty s => Proxy name -> Expr s ty\n\n-- Choose the elements of one list based on truth values in another\nchoose :: [Bool] -> [a] -> [a]\nchoose bs as = [ a | (a,True) <- zip as bs ]\n\n-- Project a component of one row, assuming that the desired projection\n-- is valid.\nprojectRow :: forall sub super.\n              Subset sub super => Row super -> Row sub\nprojectRow r = case subset @sub @super of\n  SubsetEmpty -> EmptyRow\n  SubsetCons (_ :: Proxy name) (_ :: Proxy ty) ->\n      find_datum inProof r ::> projectRow r\n    where\n      find_datum :: InProof (Col name ty) s -> Row s -> ty\n      find_datum InHere  (h ::> _) = h\n      find_datum InThere (_ ::> t) = find_datum inProof t\n\n-- Evaluate an Expr\neval :: Expr s ty -> Row s -> ty\neval (a :+ b)  r = eval a r +  eval b r\neval (a :- b)  r = eval a r -  eval b r\neval (a :* b)  r = eval a r *  eval b r\neval (a :/ b)  r = eval a r `div` eval b r\neval (a :< b)  r = eval a r <  eval b r\neval (a :<= b) r = eval a r <= eval b r\neval (a :> b)  r = eval a r >  eval b r\neval (a :>= b) r = eval a r >= eval b r\neval (a :== b) r = eval a r == eval b r\neval (a :/= b) r = eval a r /= eval b r\neval (Literal n)                 _ = n\neval (ElementOf elt list)        r = eval elt r `elem` eval list r\neval (Element (_ :: Proxy name)) r = get_element inProof r\n  where\n    get_element :: InProof (Col name ty) s -> Row s -> ty\n    get_element InHere (elt ::> _) = elt\n    get_element InThere (_ ::> tail) = get_element inProof tail\n\n-- Append two rows. Needed for Cartesian product.\nrowAppend :: Row s -> Row s' -> Row (s ++ s')\nrowAppend EmptyRow  r = r\nrowAppend (h ::> t) r = h ::> rowAppend t r\n\n-- The query function is the eliminator for an RA. It returns a list of\n-- rows containing the data produced by the RA. In the IO monad only\n-- because more sophisticated implementations would actually go out to\n-- a DB server for this.\nquery :: RA s -> IO [Row s]\nquery (Read (Table rows)) = return rows\nquery (Product ra rb) = do\n  rowsa <- query ra\n  rowsb <- query rb\n  return [ rowAppend rowa rowb | rowa <- rowsa, rowb <- rowsb ]\nquery (Project ra)     = map projectRow <$> query ra\nquery (Select expr ra) = filter (eval expr) <$> query ra\n\nfield :: forall name ty s. In name ty s => Expr s ty\nfield = Element (Proxy :: Proxy name)\n\n\n\n\n\n\n\n\n-- A schema is a list of columns, with\n-- data Column = Col String Type\n-- NB: Dependent type support is still experimental\ncheckIn :: \u00ce\u00a0 name -> \u00ce\u00a0 ty -> \u00ce\u00a0 schema\n        -> (In name ty schema => r)\n        -> r\ncheckIn name _  Nil                        _\n  = schemaError (\"Field \" ++ show name ++ \" not found.\")\ncheckIn name ty ((Col name' ty') :>> rest) callback\n  = case (name `eq` name', ty `eq` ty') of\n      (Just Refl, Just Refl) -> callback\n      (Just _,    _)         -> schemaError (\"Found \" ++ show name ++\n                                             \" but it maps to \" ++ show ty')\n      _                      -> checkIn name ty rest callback\n\n-- example call:\n-- checkIn \"id\" Int schema ({- access \"id\" and assume it has type Int -})\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n-- Establish a Subset constraint\ncheckSubset :: \u00ce\u00a0 sch1 -> \u00ce\u00a0 sch2 -> (Subset sch1 sch2 => r) -> r\ncheckSubset Nil                    _     callback = callback\ncheckSubset (Col name ty :>> rest) super callback\n  = checkSubset rest super $\n    checkIn name ty super $\n    callback\n\n-- Check that two names are distinct\ncheckNotEqual :: forall (name1 :: Symbol) name2 r.\n                 \u00ce\u00a0 name1 -> \u00ce\u00a0 name2\n              -> (((name1 /= name2) ~ 'True) => r) -> r\ncheckNotEqual name1 name2 callback\n  = case name1 `eq` name2 of\n      Just Refl -> schemaError $ \"Found \" ++ show name1 ++\n                          \" in both supposedly disjoint schemas.\"\n      Nothing   -> assumeEquality @(name1 /= name2) @'True $\n                   callback\n\n-- Establish a ColNotIn condition\ncheckColNotIn :: \u00ce\u00a0 name -> \u00ce\u00a0 sch2\n              -> ((ColNotIn name sch2 ~ 'True) => r) -> r\ncheckColNotIn _    Nil                    callback = callback\ncheckColNotIn name (Col name' _ :>> rest) callback\n  = checkNotEqual name name' $\n    checkColNotIn name rest $\n    callback\n\n-- Establish a Disjointness constraint\ncheckDisjoint :: \u00ce\u00a0 sch1 -> \u00ce\u00a0 sch2\n              -> ((Disjoint sch1 sch2 ~ 'True) => r) -> r\ncheckDisjoint Nil                   _    callback = callback\ncheckDisjoint (Col name _ :>> rest) sch2 callback\n  = checkColNotIn name sch2 $\n    checkDisjoint rest sch2 $\n    callback\n\n-- Establish a ShowSchema constraint\ncheckShowSchema :: \u00ce\u00a0 sch -> (ShowSchema sch => r) -> r\ncheckShowSchema Nil                 callback = callback\ncheckShowSchema (Col _ ty :>> rest) callback\n  = getReadShowInstances ty $\n    checkShowSchema rest $\n    callback\n\n-- Establish a ReadSchema constraint\ncheckReadSchema :: \u00ce\u00a0 sch -> (ReadSchema sch => r) -> r\ncheckReadSchema Nil                 callback = callback\ncheckReadSchema (Col _ ty :>> rest) callback\n  = getReadShowInstances ty $\n    checkReadSchema rest $\n    callback\n\n-- Terminate program with an easy-to-understand message\nschemaError :: String -> a\nschemaError str = errorWithoutStackTrace $ \"Schema validation error: \" ++ str\n\n-------------------------\ntype NameSchema = [ Col \"first\" String, Col \"last\" String ]\n\nprintName :: Row NameSchema -> IO ()\nprintName (first ::> last ::> _) = putStrLn (first ++ \" \" ++ last)\n\nreadDB classes_sch students_sch = do\n  classes_tab  <- loadTable \"classes.table\" classes_sch\n  students_tab <- loadTable \"students.table\" students_sch\n\n  putStr \"Whose students do you want to see? \"\n  prof <- getLine\n\n  let joined = Project (\n                Select (field @\"id\" @Int `ElementOf` field @\"students\") (\n                 Product (Select (field @\"prof\" :== Literal prof) (Read classes_tab))\n                         (Read students_tab)))\n  rows <- query joined\n  mapM_ printName rows\n\n------------------\nmain :: IO ()\nmain = withSchema \"classes.schema\" $ \\classes_sch ->\n       withSchema \"students.schema\" $ \\students_sch ->\n       checkDisjoint classes_sch students_sch $\n       checkIn (SSym @\"students\") (typeRep @[Int]) (classes_sch %:++ students_sch) $\n       checkIn (SSym @\"prof\") (typeRep @String) classes_sch $\n       checkIn (SSym @\"last\") (typeRep @String) (classes_sch %:++ students_sch) $\n       checkIn (SSym @\"id\") (typeRep @Int) (classes_sch %:++ students_sch) $\n       checkIn (SSym @\"first\") (typeRep @String) (classes_sch %:++ students_sch) $\n       checkReadSchema students_sch $\n       checkReadSchema classes_sch $\n       readDB classes_sch students_sch\n", "num_lines": 698}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilies, GADTs, DataKinds, PolyKinds,\n             RankNTypes, TypeOperators #-}\n\nmodule RAE_T32b where\n\nimport Data.Kind\n\ndata family Sing (k :: Type) :: k -> Type\n\ndata TyArr (a :: Type) (b :: Type) :: Type\ntype family (a :: TyArr k1 k2 -> Type) @@ (b :: k1) :: k2\n$(return [])\n\ndata Sigma (p :: Type) (r :: TyArr p Type -> Type) :: Type where\n  Sigma :: forall (p :: Type) (r :: TyArr p Type -> Type)\n                  (a :: p) (b :: r @@ a).\n           Sing Type p -> Sing (TyArr p Type -> Type) r -> Sing p a ->\n           Sing (r @@ a) b -> Sigma p r\n$(return [])\n\ndata instance Sing (Sigma p r) (x :: Sigma p r) :: Type where\n  SSigma :: forall (p :: Type) (r :: TyArr p Type -> Type)\n                   (a :: p) (b :: r @@ a)\n                   (sp :: Sing Type p) (sr :: Sing (TyArr p Type -> Type) r)\n                   (sa :: Sing p a) (sb :: Sing (r @@ a) b).\n            Sing (Sing (r @@ a) b) sb ->\n            Sing (Sigma p r) ('Sigma sp sr sa sb)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll, KindSignatures, PartialTypeSignatures #-}\n\nmodule T11241 where\n\nfoo :: forall (a :: _) . a -> a\nfoo = id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11311 where\n\nimport Data.Kind\n\nfoo :: ()\nfoo = (id :: Type -> Type) undefined `seq` ()\n\nmain = print foo\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, PolyKinds, ExplicitForAll #-}\n\nmodule T11405 where\n\nimport GHC.Exts\nimport GHC.Stack\n\nx :: forall (v :: RuntimeRep) (a :: TYPE v). (?callStack :: CallStack) => a\nx = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, KindSignatures, ExplicitForAll, RankNTypes #-}\n\nmodule T11635 where\n\nimport Data.Kind\n\ndata X (a :: forall k. k -> Type) b = X\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T11711 where\n\nimport Data.Kind (Type)\n\ndata (:~~:) (a :: k1) (b :: k2) where\n    HRefl :: a :~~: a\n\ndata TypeRep (a :: k) where\n    TrTyCon :: String -> TypeRep k -> TypeRep (a :: k)\n    TrApp   :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n               TypeRep (a :: k1 -> k2)\n            -> TypeRep (b :: k1)\n            -> TypeRep (a b)\n\nclass Typeable (a :: k) where\n    typeRep :: TypeRep a\n\ndata SomeTypeRep where\n    SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep\n\neqTypeRep :: TypeRep a -> TypeRep b -> Maybe (a :~~: b)\neqTypeRep = undefined\n\ntypeRepKind :: forall k (a :: k). TypeRep a -> TypeRep k\ntypeRepKind = undefined\n\ninstance Typeable Type where\n  typeRep = TrTyCon \"Type\" typeRep\n\nfunResultTy :: SomeTypeRep -> SomeTypeRep -> Maybe SomeTypeRep\nfunResultTy (SomeTypeRep f) (SomeTypeRep x)\n  | Just HRefl <- (typeRep :: TypeRep Type) `eqTypeRep` typeRepKind f\n  , TRFun arg res <- f\n  , Just HRefl <- arg `eqTypeRep` x\n  = Just (SomeTypeRep res)\n  | otherwise\n  = Nothing\n\ntrArrow :: TypeRep (->)\ntrArrow = undefined\n\npattern TRFun :: forall fun. ()\n              => forall arg res. (fun ~ (arg -> res))\n              => TypeRep arg\n              -> TypeRep res\n              -> TypeRep fun\npattern TRFun arg res <- TrApp (TrApp (eqTypeRep trArrow -> Just HRefl) arg) res\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TypeFamilies, TypeOperators, DataKinds, PolyKinds,\n             UndecidableInstances #-}\n\nmodule T11719 where\n\nimport Data.Kind\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\n\ntype family (f :: a ~> b) @@ (x :: a) :: b\n\ndata Null a = Nullable a | NotNullable a\n\ntype family ((f :: b ~> c) \u00e2\u02c6\u02dc (g :: a ~> b)) (x :: a) :: c where\n  (f \u00e2\u02c6\u02dc g) x = f @@ (g @@ x)\n\ntype family BaseType (k :: forall a. a ~> Type) (x :: b) :: Type where   -- this fails :(\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T11966 where\n\nimport Data.Kind (Type)\nimport GHC.TypeLits (Symbol)\n\n-- Simplification\ntype family Col (f :: k -> j) (x :: k) :: Type\n\n-- Base types\ndata PGBaseType = PGInteger | PGText\n\n-- Transformations\ndata Column t = Column Symbol t\nnewtype Nullable t = Nullable t\nnewtype HasDefault t = HasDefault t\n\n-- Interpretations\ndata Expr k\n\ndata Record (f :: forall k. k -> Type) =\n  Record {rX :: Col f ('Column \"x\" 'PGInteger)\n         ,rY :: Col f ('Column \"y\" ('Nullable 'PGInteger))\n         ,rZ :: Col f ('HasDefault 'PGText)}\n\nx :: Record Expr\nx = undefined\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, DataKinds, PolyKinds, GADTs, TypeFamilies #-}\n\nmodule T12176 where\n\nimport Data.Kind\n\ndata Proxy :: forall k. k -> Type where\n  MkProxy :: forall k (a :: k). Proxy a\n\ndata X where\n  MkX :: forall (k :: Type) (a :: k). Proxy a -> X\n\ntype Expr = (MkX :: forall (a :: Bool). Proxy a -> X)\n\ntype family Foo (x :: forall (a :: k). Proxy a -> X) where\n  Foo (MkX :: forall (a :: k). Proxy a -> X) = (MkProxy :: Proxy k)\n\ntype Bug = Foo Expr  -- this failed with #12176\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Based on https://github.com/idris-lang/Idris-dev/blob/v0.9.10/libs/effects/Effects.idr\n\n{-# LANGUAGE DataKinds, PolyKinds, ScopedTypeVariables, TypeOperators,\n             TypeApplications, GADTs, TypeFamilies, AllowAmbiguousTypes #-}\n\nmodule T12442 where\n\nimport Data.Kind\n\ndata family Sing (a :: k)\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\ntype family (a :: k1 ~> k2) @@ (b :: k1) :: k2\n\ndata TyCon1 :: (Type -> Type) -> (Type ~> Type)\ntype instance (TyCon1 t) @@ x = t x\n\ndata TyCon2 :: (Type -> Type -> Type) -> (Type ~> Type ~> Type)\ntype instance (TyCon2 t) @@ x = (TyCon1 (t x))\n\ndata TyCon3 :: (Type -> Type -> Type -> Type) -> (Type ~> Type ~> Type ~> Type)\ntype instance (TyCon3 t) @@ x = (TyCon2 (t x))\n\ntype Effect = Type ~> Type ~> Type ~> Type\n\ndata EFFECT :: Type where\n  MkEff :: Type -> Effect -> EFFECT\n\ndata EffElem :: (Type ~> Type ~> Type ~> Type) -> Type -> [EFFECT] -> Type where\n  Here :: EffElem x a (MkEff a x ': xs)\n\ndata instance Sing (elem :: EffElem x a xs) where\n  SHere :: Sing Here\n\ntype family UpdateResTy b t (xs :: [EFFECT]) (elem :: EffElem e a xs)\n                        (thing :: e @@ a @@ b @@ t) :: [EFFECT] where\n  UpdateResTy b _ (MkEff a e ': xs) Here n = MkEff b e ': xs\n\ndata EffM :: (Type ~> Type) -> [EFFECT] -> [EFFECT] -> Type -> Type\n\neffect :: forall e a b t xs prf eff m.\n          Sing (prf :: EffElem e a xs)\n       -> Sing (eff :: e @@ a @@ b @@ t)\n       -> EffM m xs (UpdateResTy b t xs prf eff) t\neffect = undefined\n\ndata State :: Type -> Type -> Type -> Type where\n  Get :: State a a a\n\ndata instance Sing (e :: State a b c) where\n  SGet :: Sing Get\n\ntype STATE t = MkEff t (TyCon3 State)\n\nget_ :: forall m x. EffM m '[STATE x] '[STATE x] x\nget_ = effect @(TyCon3 State) SHere SGet\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, TypeFamilies #-}\n\nmodule T12742 where\n\nimport Data.Kind\n\ntype family F :: forall k2. (k1, k2)\n\ndata T :: (forall k2. (Bool, k2)) -> Type\n\ntype S = T F\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}\n{-# LANGUAGE KindSignatures, DataKinds, PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE TypeApplications     #-}\nmodule T13538 where\n\nimport GHC.TypeLits\nimport Data.Proxy\n\n-- | Synonym for a type-level snoc (injective!)\ntype (ns :: [k]) +: (n :: k) = GetList1 (SinkFirst (n ': ns))\ninfixl 5 +:\n\n\n\n-- | A weird data type used to make `(+:)` operation injective.\n--   `List k [k]` must have at least two elements.\ndata List1 k = L1Single k | L1Head k [k]\n\n-- | Sink first element of a list to the end of the list\ntype family SinkFirst (xs :: [k]) = (ys :: List1 k) | ys -> xs where\n  SinkFirst '[y]       = 'L1Single y\n  -- SinkFirst (y ': x ': xs :: [Nat])\n  --     = ('L1Head x (GetList1Nat (SinkFirst (y ': xs))) :: List1 Nat)\n  SinkFirst (y ': x ': xs :: [k])\n      = ('L1Head x (GetList1    (SinkFirst (y ': xs))) :: List1 k)\n\ntype family GetList1 (ts :: List1 k) = (rs :: [k]) | rs -> ts where\n  GetList1 ('L1Single x) = '[x]\n  GetList1 ('L1Head y (x ':xs)) = y ': x ': xs\ntype family GetList1Nat (ts :: List1 Nat) = (rs :: [Nat]) | rs -> ts where\n  GetList1Nat ('L1Single x) = '[x]\n  GetList1Nat ('L1Head y (x ': xs)) = y ': x ': xs\n\ntype family (++) (as :: [k]) (bs :: [k]) :: [k] where\n  '[] ++ bs = bs\n  (a ': as) ++ bs = a ': (as ++ bs)\n\n\nff :: Proxy k -> Proxy (as +: k) -> Proxy (k ': bs) -> Proxy (as ++ bs)\nff _ _ _ = Proxy\n\nyy :: Proxy '[3,7,2]\nyy = ff (Proxy @5) (Proxy @'[3,7,5]) (Proxy @'[5,2])\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T13910 where\n\nimport Data.Kind\nimport Data.Type.Equality\n\ndata family Sing (a :: k)\n\nclass SingKind k where\n  type Demote k = (r :: Type) | r -> k\n  fromSing :: Sing (a :: k) -> Demote k\n  toSing   :: Demote k -> SomeSing k\n\ndata SomeSing k where\n  SomeSing :: Sing (a :: k) -> SomeSing k\n\nwithSomeSing :: forall k r\n              . SingKind k\n             => Demote k\n             -> (forall (a :: k). Sing a -> r)\n             -> r\nwithSomeSing x f =\n  case toSing x of\n    SomeSing x' -> f x'\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\ntype a @@ b = Apply a b\ninfixl 9 @@\n\ndata FunArrow = (:->) | (:~>)\n\nclass FunType (arr :: FunArrow) where\n  type Fun (k1 :: Type) arr (k2 :: Type) :: Type\n\nclass FunType arr => AppType (arr :: FunArrow) where\n  type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2\n\ntype FunApp arr = (FunType arr, AppType arr)\n\ninstance FunType (:->) where\n  type Fun k1 (:->) k2 = k1 -> k2\n\n$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter\n\ninstance AppType (:->) where\n  type App k1 (:->) k2 (f :: k1 -> k2) x = f x\n\ninstance FunType (:~>) where\n  type Fun k1 (:~>) k2 = k1 ~> k2\n\n$(return [])\n\ninstance AppType (:~>) where\n  type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x\n\ninfixr 0 -?>\ntype (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2\n\ndata instance Sing (z :: a :~: b) where\n  SRefl :: Sing Refl\n\ninstance SingKind (a :~: b) where\n  type Demote (a :~: b) = a :~: b\n  fromSing SRefl = Refl\n  toSing Refl = SomeSing SRefl\n\n(~>:~:) :: forall (k :: Type) (a :: k) (b :: k) (r :: a :~: b) (p :: forall (y :: k). a :~: y ~> Type).\n           Sing r\n        -> p @@ Refl\n        -> p @@ r\n(~>:~:) SRefl pRefl = pRefl\n\ntype WhyReplacePoly (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr)\n                    (y :: t) (e :: from :~: y) = App t arr Type p y\ndata WhyReplacePolySym (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr)\n  :: forall (y :: t). from :~: y ~> Type\ntype instance Apply (WhyReplacePolySym arr from p :: from :~: y ~> Type) x\n  = WhyReplacePoly arr from p y x\n\nreplace :: forall (t :: Type) (from :: t) (to :: t) (p :: t -> Type).\n           p from\n        -> from :~: to\n        -> p to\nreplace = replacePoly @(:->)\n\nreplaceTyFun :: forall (t :: Type) (from :: t) (to :: t) (p :: t ~> Type).\n                p @@ from\n             -> from :~: to\n             -> p @@ to\nreplaceTyFun = replacePoly @(:~>) @_ @_ @_ @p\n\nreplacePoly :: forall (arr :: FunArrow) (t :: Type) (from :: t) (to :: t)\n                      (p :: (t -?> Type) arr).\n               FunApp arr\n            => App t arr Type p from\n            -> from :~: to\n            -> App t arr Type p to\nreplacePoly from eq =\n  withSomeSing eq $ \\(singEq :: Sing r) ->\n    (~>:~:) @t @from @to @r @(WhyReplacePolySym arr from p) singEq from\n\ntype WhyLeibnizPoly (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t) (z :: t)\n  = App t arr Type f a -> App t arr Type f z\ndata WhyLeibnizPolySym (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t)\n  :: t ~> Type\ntype instance Apply (WhyLeibnizPolySym arr f a) z = WhyLeibnizPoly arr f a z\n\nleibnizPoly :: forall (arr :: FunArrow) (t :: Type) (f :: (t -?> Type) arr)\n                      (a :: t) (b :: t).\n               FunApp arr\n            => a :~: b\n            -> App t arr Type f a\n            -> App t arr Type f b\nleibnizPoly = replaceTyFun @t @a @b @(WhyLeibnizPolySym arr f a) id\n\nleibniz :: forall (t :: Type) (f :: t -> Type) (a :: t) (b :: t).\n           a :~: b\n        -> f a\n        -> f b\nleibniz = replaceTyFun @t @a @b @(WhyLeibnizPolySym (:->) f a) id\n-- The line above is what you get if you inline the definition of leibnizPoly.\n-- It causes a panic, however.\n--\n-- An equivalent implementation is commented out below, which does *not*\n-- cause GHC to panic.\n--\n-- leibniz = leibnizPoly @(:->)\n\nleibnizTyFun :: forall (t :: Type) (f :: t ~> Type) (a :: t) (b :: t).\n                a :~: b\n             -> f @@ a\n             -> f @@ b\nleibnizTyFun = leibnizPoly @(:~>) @_ @f\n", "num_lines": 149}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T13938 where\n\nimport T13938a\nimport Data.Kind\nimport Data.Type.Equality\nimport GHC.TypeLits\n\ntype family Length (l :: [a]) :: Nat where {}\ntype family Map (f :: a ~> b) (l :: [a]) :: [b] where {}\n\ntype WhyMapPreservesLength (f :: x ~> y) (l :: [x])\n  = Length l :~: Length (Map f l)\ndata WhyMapPreservesLengthSym1 (f :: x ~> y) :: [x] ~> Type\ntype instance Apply (WhyMapPreservesLengthSym1 f) l = WhyMapPreservesLength f l\n\nmapPreservesLength :: forall (x :: Type) (y :: Type) (f :: x ~> y) (l :: [x]).\n                      Length l :~: Length (Map f l)\nmapPreservesLength\n  = elimListTyFun @x @(WhyMapPreservesLengthSym1 f) @l undefined undefined undefined\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T13938a where\n\nimport Data.Kind (Type)\n\ndata family Sing (a :: k)\ndata instance Sing (z :: [a]) where\n  SNil  :: Sing '[]\n  SCons :: Sing x -> Sing xs -> Sing (x:xs)\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\ntype a @@ b = Apply a b\ninfixl 9 @@\n\ndata FunArrow = (:->) -- ^ '(->)'\n              | (:~>) -- ^ '(~>)'\n\nclass FunType (arr :: FunArrow) where\n  type Fun (k1 :: Type) arr (k2 :: Type) :: Type\n\nclass FunType arr => AppType (arr :: FunArrow) where\n  type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2\n\ntype FunApp arr = (FunType arr, AppType arr)\n\ninstance FunType (:->) where\n  type Fun k1 (:->) k2 = k1 -> k2\n\n$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter\n\ninstance AppType (:->) where\n  type App k1 (:->) k2 (f :: k1 -> k2) x = f x\n\ninstance FunType (:~>) where\n  type Fun k1 (:~>) k2 = k1 ~> k2\n\n$(return [])\n\ninstance AppType (:~>) where\n  type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x\n\ninfixr 0 -?>\ntype (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2\n\nelimList :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]).\n            Sing l\n         -> p '[]\n         -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs))\n         -> p l\nelimList = elimListPoly @(:->)\n\nelimListTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]).\n                 Sing l\n              -> p @@ '[]\n              -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs))\n              -> p @@ l\nelimListTyFun = elimListPoly @(:~>) @_ @p\n\nelimListPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]).\n                FunApp arr\n             => Sing l\n             -> App [a] arr Type p '[]\n             -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs))\n             -> App [a] arr Type p l\nelimListPoly SNil                      pNil _     = pNil\nelimListPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (elimListPoly @arr @a @p @xs xs pNil pCons)\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14038 where\n\nimport Data.Kind (Type)\n\ndata family Sing (a :: k)\ndata instance Sing (z :: [a]) where\n  SNil  :: Sing '[]\n  SCons :: Sing x -> Sing xs -> Sing (x:xs)\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\ntype a @@ b = Apply a b\ninfixl 9 @@\n\ndata FunArrow = (:->) -- ^ '(->)'\n              | (:~>) -- ^ '(~>)'\n\nclass FunType (arr :: FunArrow) where\n  type Fun (k1 :: Type) arr (k2 :: Type) :: Type\n\nclass FunType arr => AppType (arr :: FunArrow) where\n  type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2\n\ntype FunApp arr = (FunType arr, AppType arr)\n\ninstance FunType (:->) where\n  type Fun k1 (:->) k2 = k1 -> k2\n\ninstance AppType (:->) where\n  type App k1 (:->) k2 (f :: k1 -> k2) x = f x\n\ninstance FunType (:~>) where\n  type Fun k1 (:~>) k2 = k1 ~> k2\n\ninstance AppType (:~>) where\n  type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x\n\ninfixr 0 -?>\ntype (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2\n\nelimList :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]).\n            Sing l\n         -> p '[]\n         -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs))\n         -> p l\nelimList = elimListPoly @(:->)\n\nelimListTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]).\n                 Sing l\n              -> p @@ '[]\n              -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs))\n              -> p @@ l\nelimListTyFun = elimListPoly @(:~>) @_ @p\n\nelimListPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]).\n                FunApp arr\n             => Sing l\n             -> App [a] arr Type p '[]\n             -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs))\n             -> App [a] arr Type p l\nelimListPoly SNil                      pNil _     = pNil\nelimListPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (elimListPoly @arr @a @p @xs xs pNil pCons)\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, ExplicitForAll, GADTs,\n             UndecidableInstances, RankNTypes, ScopedTypeVariables #-}\n\nmodule T14066a where\n\nimport Data.Proxy\nimport Data.Kind\nimport Data.Type.Bool\n\n\ntype family Bar x y where\n  Bar (x :: a) (y :: b) = Int\n  Bar (x :: c) (y :: d) = Bool   -- a,b,c,d should be TyVarTvs and unify appropriately\n\n\n  -- the two k's, even though they have different scopes, should unify in the\n  -- kind-check and then work in the type-check because Prox3 has been generalized\n\ndata Prox3 a where\n  MkProx3a :: Prox3 (a :: k1)\n  MkProx3b :: Prox3 (a :: k2)\n\n  -- This probably should be rejected, as it's polymorphic recursion without a CUSK.\n  -- But GHC accepts it because the polymorphic occurrence is at a type variable.\ndata T0 a = forall k (b :: k). MkT0 (T0 b) Int\n\n  -- k and j should unify\ntype family G x a where\n  G Int (b :: k) = Int\n  G Bool (c :: j) = Bool\n\n-- this last example just checks that GADT pattern-matching on kinds still works.\n-- nothing new here.\ndata T (a :: k) where\n  MkT :: T (a :: Type -> Type)\n\ndata S (a :: Type -> Type) where\n  MkS :: S a\n\nf :: forall k (a :: k). Proxy a -> T a -> ()\nf _ MkT = let y :: S a\n              y = MkS\n          in ()\n\n-- This is questionable. Should we use the RHS to determine dependency? It works\n-- now, but if it stops working in the future, that's not a deal-breaker.\ntype P k a = Proxy (a :: k)\n\n\n-- This is a challenge. It should be accepted, but only because c's kind is learned\n-- to be Proxy True, allowing b to be assigned kind `a`. If we don't know c's kind,\n-- then GHC would need to be convinced that If (c's kind) b d always has kind `a`.\n-- Naively, we don't know about c's kind early enough.\n\ndata SameKind :: forall k. k -> k -> Type\ntype family IfK (e :: Proxy (j :: Bool)) (f :: m) (g :: n) :: If j m n where\n   IfK (_ :: Proxy True)  f _ = f\n   IfK (_ :: Proxy False) _ g = g\nx :: forall c. (forall a b (d :: a). SameKind (IfK c b d) d) -> (Proxy (c :: Proxy True))\nx _ = Proxy\n\n\nf2 :: forall b. b -> Proxy Maybe\nf2 x = fstOf3 y :: Proxy Maybe\n  where\n    y :: (Proxy a, Proxy c, b)\n    y = (Proxy, Proxy, x)\n\nfstOf3 (x, _, _) = x\n\nf3 :: forall b. b -> Proxy Maybe\nf3 x = fst y :: Proxy Maybe\n  where\n    y :: (Proxy a, b)\n    y = (Proxy, x)\n\n-- cf. dependent/should_fail/T14066h. Here, y's type does *not* capture any variables,\n-- so it is generalized, even with MonoLocalBinds.\nf4 x = (fst y :: Proxy Int, fst y :: Proxy Maybe)\n  where\n    y :: (Proxy a, Int)\n    y = (Proxy, x)\n", "num_lines": 83}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, PolyKinds, MonoLocalBinds #-}\n\nmodule T14066h where\n\nimport Data.Proxy\n\nf :: forall b. b -> (Proxy Int, Proxy Maybe)\nf x = (fst y :: Proxy Int, fst y :: Proxy Maybe)\n  where\n    y :: (Proxy a, b)  -- this generalizes over the kind of a\n    y = (Proxy, x)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language UndecidableInstances, DataKinds, TypeOperators, PolyKinds,\n             TypeFamilies, GADTs, LambdaCase, ScopedTypeVariables #-}\n\nmodule T14556 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata Fn a b where\n  IdSym :: Fn Type Type\n\ntype family\n  (@@) (f::Fn k k') (a::k)::k' where\n  IdSym @@ a = a\n\ndata KIND = X | FNARR KIND KIND\n\ndata TY :: KIND -> Type where\n  ID    :: TY (FNARR X X)\n  FNAPP :: TY (FNARR k k') -> TY k -> TY k'\n\ndata TyRep (kind::KIND) :: TY kind -> Type where\n  TID    :: TyRep (FNARR X X)  ID\n  TFnApp :: TyRep (FNARR k k') f\n         -> TyRep k            a\n         -> TyRep k'           (FNAPP f a)\n\ntype family\n  IK (kind::KIND) :: Type where\n  IK X            = Type\n  IK (FNARR k k') = Fn (IK k) (IK k')\n\ntype family\n  IT (ty::TY kind) :: IK kind where\n  IT ID          = IdSym\n  IT (FNAPP f x) = IT f @@ IT x\n\nzero :: TyRep X a -> IT a\nzero = undefined\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14720 where\n\nimport Data.Kind (Type)\nimport Data.Type.Equality ((:~:)(..), sym, trans)\nimport Data.Void\n\ndata family Sing (z :: k)\n\nclass Generic (a :: Type) where\n    type Rep a :: Type\n    from :: a -> Rep a\n    to :: Rep a -> a\n\nclass PGeneric (a :: Type) where\n  type PFrom (x :: a)     :: Rep a\n  type PTo   (x :: Rep a) :: a\n\nclass SGeneric k where\n  sFrom :: forall (a :: k).     Sing a -> Sing (PFrom a)\n  sTo   :: forall (a :: Rep k). Sing a -> Sing (PTo a :: k)\n\nclass (PGeneric k, SGeneric k) => VGeneric k where\n  sTof  :: forall (a :: k).     Sing a -> PTo (PFrom a) :~: a\n  sFot  :: forall (a :: Rep k). Sing a -> PFrom (PTo a :: k) :~: a\n\ndata Decision a = Proved a\n                | Disproved (a -> Void)\n\nclass SDecide k where\n  (%~) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Decision (a :~: b)\n  default (%~) :: forall (a :: k) (b :: k). (VGeneric k, SDecide (Rep k))\n               => Sing a -> Sing b -> Decision (a :~: b)\n  s1 %~ s2 = case sFrom s1 %~ sFrom s2 of\n    Proved (Refl :: PFrom a :~: PFrom b) ->\n      case (sTof s1, sTof s2) of\n          (Refl, Refl) -> Proved Refl\n    Disproved contra -> Disproved (\\Refl -> contra Refl)\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll, PolyKinds, TypeFamilies, DataKinds #-}\n\nmodule T14729 where\n\nimport Data.Kind\n\ndata P k :: k -> Type\n\ntype family F a\ntype instance F Int = Bool\n\nx :: forall (x :: Bool). P (F Int) x\nx = undefined\n\ny = x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeOperators, DataKinds, TypeFamilies, PolyKinds #-}\n\nmodule T14749 where\n\nimport Data.Kind\n\ndata KIND = STAR | KIND :> KIND\n\ndata Ty :: KIND -> Type where\n  TMaybe :: Ty (STAR :> STAR)\n  TApp   :: Ty (a :> b) -> (Ty a -> Ty b)\n\ntype family IK (k :: KIND) = (res :: Type) where\n  IK STAR   = Type\n  IK (a:>b) = IK a -> IK b\n\ntype family I (t :: Ty k) = (res :: IK k)  where\n  I TMaybe     = Maybe\n  I (TApp f a) = (I f) (I a)\n\ndata TyRep (k :: KIND) (t :: Ty k) where\n  TyMaybe :: TyRep (STAR:>STAR) TMaybe\n  TyApp   :: TyRep (a:>b) f -> TyRep a x -> TyRep b (TApp f x)\n\nzero :: TyRep STAR a -> I a\nzero x = case x of\n            TyApp TyMaybe _ -> Nothing\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds, DataKinds, KindSignatures, GADTs, TypeInType, ConstraintKinds #-}\n{-# Language FlexibleContexts #-}\n{-# Language RankNTypes #-}\n{-# Language TypeOperators #-}\nmodule T14845 where\n\nimport Data.Kind\nimport Data.Type.Equality\n\ndata A :: Type -> Type where\n  MkA1 :: a ~  Int => A a\n  MkA2 :: a ~~ Int => A a\n\ndata SA :: forall a. A a -> Type where\n  SMkA1 :: SA MkA1\n  SMkA2 :: SA MkA2\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE PartialTypeSignatures #-}\nmodule Bug where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata Foo (x :: Type) :: forall (a :: x). Proxy a -> Type\n\nquux :: forall arg. Proxy (Foo arg) -> ()\nquux (_ :: _) = ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\nmodule Bug where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata Foo (x :: Type) :: forall (a :: x). Proxy a -> Type\n\ndata Bar :: Type -> Type where\n    MkBar :: forall x arg.\n             -- Commenting out the line below makes the issue go away\n             Foo arg ~ Foo arg =>\n             Bar x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T14991 where\n\nimport Data.Kind\n\ntype family Promote (k :: Type) :: Type\ntype family PromoteX (a :: k) :: Promote k\n\ntype family Demote (k :: Type) :: Type\ntype family DemoteX (a :: k) :: Demote k\n\n-----\n-- Type\n-----\n\ntype instance Demote Type = Type\ntype instance Promote Type = Type\n\ntype instance DemoteX (a :: Type) = Demote a\ntype instance PromoteX (a :: Type) = Promote a\n\n-----\n-- Arrows\n-----\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype instance Demote  (a ~> b) = DemoteX  a -> DemoteX  b\ntype instance Promote (a -> b) = PromoteX a ~> PromoteX b\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE PartialTypeSignatures #-}\nmodule Bug where\n\nimport Data.Kind\nimport Data.Proxy\n\nfoo :: forall (a :: Type)\n              (f :: forall (x :: a). Proxy x -> Type).\n       Proxy f -> ()\nfoo (_ :: _) = ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeInType #-}\nmodule Bug where\n\nimport Data.Kind\nimport Data.Proxy\n\nfoo :: forall (a :: Type)\n              (f :: forall (x :: a). Proxy x -> Type).\n       Proxy f -> ()\nfoo _ = ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, MultiParamTypeClasses, GADTs, ScopedTypeVariables,\n             TypeOperators #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule Super where\n\nimport Data.Kind\nimport Data.Proxy\nimport GHC.Prim\n\nclass (a ~ b) => C a b\ndata SameKind :: k -> k -> Type where\n  SK :: SameKind a b\n\nbar :: forall (a :: Type) (b :: Type). C a b => Proxy a -> Proxy b -> ()\nbar _ _ = const () (undefined :: forall (x :: a) (y :: b). SameKind x y)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T15346 where\n\nimport Data.Kind\nimport Data.Proxy\n\n-----\n\ntype family Rep (a :: Type) :: Type\ntype instance Rep () = ()\n\ntype family PFrom (x :: a) :: Rep a\n\n-----\n\nclass SDecide k where\n  test :: forall (a :: k). Proxy a\n\ninstance SDecide () where\n  test = undefined\n\ntest1 :: forall k (a :: k). SDecide (Rep k) => Proxy a\ntest1 = seq (test @_ @(PFrom a)) Proxy\n\ntest2 :: forall (a :: ()). Proxy a\ntest2 = test1\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T15419 where\n\nimport Data.Kind\n\ndata Prod a b\ndata Proxy p = Proxy\n\n-----\n\ndata family Sing :: forall k. k -> Type\ndata instance Sing x = STuple\n\n-----\n\ntype family Rep1 (f :: k -> Type) :: k -> Type\ntype instance Rep1 ((,) a) = Prod a\n\ntype family From1 (f :: Type -> Type) a (z :: f a) :: Rep1 f a\ntype family To1 (f :: Type -> Type) a (z :: Rep1 f a) :: f a\n\nclass Generic1 (f :: Type -> Type) where\n  sFrom1 :: forall (a :: Type) (z :: f a).      Proxy z -> Sing (From1 f a z)\n  sTo1   :: forall (a :: Type) (r :: Rep1 f a). Proxy r -> Proxy (To1 f a r :: f a)\n\ninstance Generic1 ((,) a) where\n  sFrom1 Proxy = undefined\n  sTo1   Proxy = undefined\n\n-----\n\ntype family Fmap (g :: b) (x :: f a) :: f b\ntype instance Fmap (g :: b) (x :: (u, a)) = To1 ((,) u) b (Fmap g (From1 ((,) u) a x))\n\nclass PFunctor (f :: Type -> Type) where\n  sFmap         :: forall a b (g :: b) (x :: f a).\n                   Proxy g -> Sing x -> Proxy (Fmap g x)\n\ninstance PFunctor (Prod a) where\n  sFmap _ STuple = undefined\n\nsFmap1 :: forall (f :: Type -> Type) (u :: Type) (b :: Type) (g :: b) (x :: f u).\n                 (Generic1 f,\n                  PFunctor (Rep1 f),\n                  Fmap g x ~ To1 f b (Fmap g (From1 f u x)) )\n              => Proxy g -> Proxy x -> Proxy (Fmap g x)\nsFmap1 sg sx = sTo1 (sFmap sg (sFrom1 sx))\n\nsFmap2  :: forall (p :: Type) (a :: Type) (b :: Type) (g :: b) (x :: (p, a)).\n          Proxy g -> Proxy x -> Proxy (Fmap g x)\nsFmap2 = sFmap1\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n  NoImplicitPrelude,\n  TypeInType, PolyKinds, DataKinds,\n  ScopedTypeVariables,\n  TypeFamilies,\n  UndecidableInstances\n#-}\n\nmodule T15666 where\n\nimport Data.Kind(Type)\n\ndata PolyType k (t :: k)\n\ntype Wrap (t :: k) = PolyType k t\ntype Unwrap pt = (GetType pt :: GetKind pt)\n\ntype family GetKind (pt :: Type) :: Type where\n  GetKind (PolyType k t) = k\n\ntype family GetType (pt :: Type) :: k where\n  GetType (PolyType k t) = t\n\ndata Composite :: a -> b -> Type\n\ntype family RecursiveWrap expr where\n  RecursiveWrap (Composite a b) =\n    Wrap (Composite (Unwrap (RecursiveWrap a)) (Unwrap (RecursiveWrap b)))\n  RecursiveWrap x = Wrap x\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T15725 where\n\nimport Data.Functor.Identity (Identity(..))\nimport Data.Kind (Type)\nimport GHC.Exts (Any)\n\n-----\n-- The important bits\n-----\n\ntype instance Meth (x :: Identity a) = GenericMeth x\ninstance SC Identity\n\n-------------------------------------------------------------------------------\n\ndata family Sing :: forall k. k -> Type\ndata instance Sing :: forall a. Identity a -> Type where\n  SIdentity :: Sing x -> Sing ('Identity x)\n\nnewtype Par1 p = Par1 p\ndata instance Sing :: forall p. Par1 p -> Type where\n  SPar1 :: Sing x -> Sing ('Par1 x)\n\ntype family Rep1 (f :: Type -> Type) :: Type -> Type\n\nclass PGeneric1 (f :: Type -> Type) where\n  type From1 (z :: f a)      :: Rep1 f a\n  type To1   (z :: Rep1 f a) :: f a\n\nclass SGeneric1 (f :: Type -> Type) where\n  sFrom1 :: forall (a :: Type) (z :: f a).      Sing z -> Sing (From1 z)\n  sTo1   :: forall (a :: Type) (r :: Rep1 f a). Sing r -> Sing (To1 r :: f a)\n\ntype instance Rep1 Identity = Par1\n\ninstance PGeneric1 Identity where\n  type From1 ('Identity x) = 'Par1 x\n  type To1   ('Par1 x)     = 'Identity x\n\ninstance SGeneric1 Identity where\n  sFrom1 (SIdentity x) = SPar1 x\n  sTo1 (SPar1 x) = SIdentity x\n\ntype family GenericMeth (x :: f a) :: f a where\n  GenericMeth x = To1 (Meth (From1 x))\n\ntype family Meth (x :: f a) :: f a\n\nclass SC f where\n  sMeth         :: forall a (x :: f a).\n                   Sing x -> Sing (Meth x)\n  default sMeth :: forall a (x :: f a).\n                   ( SGeneric1 f, SC (Rep1 f)\n                   , Meth x ~ GenericMeth x\n                   )\n                => Sing x -> Sing (Meth x)\n  sMeth sx = sTo1 (sMeth (sFrom1 sx))\n\n  dummy :: f a -> ()\n  dummy _ = ()\n\ntype instance Meth (x :: Par1 p) = x\ninstance SC Par1 where\n  sMeth x = x\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies #-}\n\nmodule T15743 where\n\nimport Data.Proxy\n\ndata T (b :: Proxy (k2 :: k)) c (a :: k)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, GADTs #-}\n\nmodule T15743e where\n\nimport Data.Proxy\nimport Data.Kind\n\n-- NO CUSK.\ndata T k (a :: k) (b :: Proxy k2) f c :: forall k3. Proxy k3 -> forall (k4 :: k5). Proxy k4 -> Type where\n  MkT :: f c -> T k a b f c d e\n\n-- Want:\n-- T :: forall {k3} {k7} {k6} (k2 :: k3) (k5 :: Type).\n--      forall k -> k -> Proxy k2 -> (k7 -> Type) -> k4 ->\n--      forall (k3 :: k6). Proxy k3 -> forall (k4 :: k5). Proxy k4 -> Type\n--\n--\n\n-- CUSK\ndata T2 (k :: Type) (a :: k) (b :: Proxy k2) (f :: k7 -> Type) (c :: k7) :: forall k3. Proxy k3 -> forall k5 (k4 :: k5). Proxy k4 -> Type where\n  MkT2 :: f c -> T2 k a b f c d e\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T15829 where\n\nimport Data.Kind\n\ndata A :: Type -> Type\ndata B a :: A a -> Type\ntype C a = B a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UnicodeSyntax #-}\nmodule T16326_Compile1 where\n\nimport Data.Kind\n\ntype DApply a (b :: a -> Type) (f :: forall (x :: a) -> b x) (x :: a) =\n  f x\n\ntype DComp a\n           (b :: a -> Type)\n           (c :: forall (x :: a). b x -> Type)\n           (f :: forall (x :: a). forall (y :: b x) -> c y)\n           (g :: forall (x :: a) -> b x)\n           (x :: a) =\n  f (g x)\n\ntype family ElimList a\n                     (p :: [a] -> Type)\n                     (s :: [a])\n                     (pNil :: p '[])\n                     (pCons :: forall (x :: a) (xs :: [a]) -> p xs -> p (x:xs))\n                  :: p s where\n  forall a p pNil (pCons :: forall (x :: a) (xs :: [a]) -> p xs -> p (x:xs)).\n    ElimList a p '[] pNil pCons =\n      pNil\n  forall a p x xs pNil (pCons :: forall (x :: a) (xs :: [a]) -> p xs -> p (x:xs)).\n    ElimList a p (x:xs) pNil pCons =\n      pCons x xs (ElimList a p xs pNil pCons)\n\ndata Proxy' :: forall k -> k -> Type where\n  MkProxy' :: forall k (a :: k). Proxy' k a\n\ntype family Proxy2' \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac k \u00e2\u2020\u2019 k \u00e2\u2020\u2019 Type where\n  Proxy2' = Proxy'\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16326_Compile2 where\n\nimport Data.Kind\n\ntype family Wat :: forall a. a\ntype Lol = Wat @(forall a -> a) (forall a -> a) (forall a. a) @(forall a. a)\n               Type Bool\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16391a where\n\nimport Data.Kind\n\ntype Const (a :: Type) (b :: Type) = a\ntype family F :: Const Type a where\n  F = Int\ntype TS = (Int :: Const Type a)\ndata T1 :: Const Type a where\n  MkT1 :: T1\ndata T2 :: Const Type a -> Type where\n  MkT2 :: T2 b\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule T9632 where\n\nimport Data.Kind\n\ndata B = T | F\ndata P :: B -> Type\n\ntype B' = B\ndata P' :: B' -> Type\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, UnicodeSyntax, GADTs, NoImplicitPrelude,\n             TypeOperators, TypeFamilies #-}\n{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}\n\nmodule TypeLevelVec where\n\nimport Data.Kind\n\ndata \u00e2\u201e\u2022 \u00e2\u02c6\u00b7 Type where\n  O \u00e2\u02c6\u00b7 \u00e2\u201e\u2022\n  S \u00e2\u02c6\u00b7 \u00e2\u201e\u2022 \u00e2\u2020\u2019 \u00e2\u201e\u2022\n\ntype family x + y where\n  O   + n = n\n  S m + n = S (m + n)\ninfixl 5 +\n\ndata Vec \u00e2\u02c6\u00b7 \u00e2\u201e\u2022 \u00e2\u2020\u2019 Type \u00e2\u2020\u2019 Type where\n  Nil  \u00e2\u02c6\u00b7 Vec O a\n  (:>) \u00e2\u02c6\u00b7 a \u00e2\u2020\u2019 Vec n a \u00e2\u2020\u2019 Vec (S n) a\ninfixr 8 :>\n\ntype family (x \u00e2\u02c6\u00b7 Vec n a) ++ (y \u00e2\u02c6\u00b7 Vec m a) \u00e2\u02c6\u00b7 Vec (n + m) a where\n  Nil       ++ y = y\n  (x :> xs) ++ y = x :> (xs ++ y)\ninfixl 5 ++\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule BadTelescope where\n\nimport Data.Kind\n\ndata SameKind :: k -> k -> *\n\ndata X a k (b :: k) (c :: SameKind a b)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, ExplicitForAll #-}\n\nmodule BadTelescope2 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata SameKind :: k -> k -> *\n\nfoo :: forall a k (b :: k). SameKind a b\nfoo = undefined\n\nbar :: forall a k (b :: k) (c :: Proxy b) (d :: Proxy a). Proxy c -> SameKind b d\nbar = undefined\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, ExplicitForAll #-}\n\nmodule BadTelescope3 where\n\nimport Data.Kind\n\ndata SameKind :: k -> k -> *\n\ntype S a k (b :: k) = SameKind a b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, DataKinds, PolyKinds #-}\nmodule BadTelescope4 where\n\nimport Data.Proxy\nimport Data.Kind\n\ndata SameKind :: k -> k -> *\n\ndata Bad a (c :: Proxy b) (d :: Proxy a) (x :: SameKind b d)\n\ndata Borked a (b :: k) = forall (c :: k). B (Proxy c)\n  -- this last one is OK. But there was a bug involving renaming\n  -- that failed here, so the test case remains.\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule DepFail1 where\n\ndata Proxy k (a :: k) = P\n\nz :: Proxy Bool\nz = P\n\na :: Proxy Int Bool\na = P\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, GADTs #-}\n\nmodule PromotedClass where\n\nimport Data.Proxy\n\ndata X a where\n  MkX :: Show a => a -> X a\n\nfoo :: Proxy ('MkX 'True)\nfoo = Proxy\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds,\n             PolyKinds, TypeFamilies, GADTs #-}\n\nmodule RAE_T32a where\n\nimport Data.Kind\n\ndata family Sing (k :: Type) :: k -> Type\n\ndata TyArr' (a :: Type) (b :: Type) :: Type\ntype TyArr (a :: Type) (b :: Type) = TyArr' a b -> Type\ntype family (a :: TyArr k1 k2) @@ (b :: k1) :: k2\ndata TyPi' (a :: Type) (b :: TyArr a Type) :: Type\ntype TyPi (a :: Type) (b :: TyArr a Type) = TyPi' a b -> Type\ntype family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b\n$(return [])\n\ndata MkStar (p :: Type) (x :: TyArr' p Type)\ntype instance MkStar p @@ x = Type\n$(return [])\n\ndata Sigma (p :: Type) (r :: TyPi p (MkStar p)) :: Type where\n  Sigma ::\n    forall (p :: Type) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a).\n    Sing Type p -> Sing (TyPi p (MkStar p)) r -> Sing p a ->\n    Sing (r @@@ a) b -> Sigma p r\n$(return [])\n\ndata instance Sing Sigma (Sigma p r) x where\n  SSigma ::\n    forall (p :: Type) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a)\n           (sp :: Sing Type p) (sr :: Sing (TyPi p (MkStar p)) r)\n           (sa :: Sing p a) (sb :: Sing (r @@@ a) b).\n    Sing (Sing (r @@@ a) b) sb ->\n    Sing (Sigma p r) ('Sigma sp sr sa sb)\n\n-- I (RAE) believe this last definition is ill-typed.\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, NoStarIsType #-}\n\nmodule RenamingStar where\n\ndata Foo :: *\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n\nmodule SelfDep where\n\ndata T :: T -> *\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, NoPolyKinds #-}\n\nmodule T11334b where\n\nimport Data.Functor.Compose\nimport Data.Proxy\n\np = Proxy :: Proxy 'Compose\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T11407 where\n\nimport Data.Kind\n\ntype Const a b = a\n\ndata family UhOh (f :: k1) (a :: k2) (b :: k3)\ndata instance UhOh (f :: * -> * -> *) (a :: x a) (b :: Const * a) = UhOh\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, PolyKinds, TypeFamilies, AllowAmbiguousTypes #-}\n\nmodule T11471 where\n\nimport GHC.Exts\nimport Data.Proxy\n\ntype family F a :: k\n\ntype instance F Int = Int#\n\nf :: Proxy a -> F a -> F a\nf _ x = x\n\nbad = f (undefined :: Proxy Int#) 3#\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, MagicHash, DataKinds, RankNTypes #-}\n\nmodule T11473 where\n\nimport GHC.Exts\nimport GHC.Types\n\ntype family Boxed (a :: k) :: *\ntype instance Boxed Char# = Char\ntype instance Boxed Char  = Char\n\nclass BoxIt (a :: TYPE lev) where\n    boxed :: a -> Boxed a\n\ninstance BoxIt Char# where boxed x = C# x\ninstance BoxIt Char  where boxed = id\n\nhello :: forall (r :: RuntimeRep). forall (a :: TYPE r). BoxIt a => a -> Boxed a\nhello x = boxed x\n{-# NOINLINE hello #-}\n\nmain :: IO ()\nmain = do\n    print $ boxed 'c'#\n    print $ boxed 'c'\n    print $ hello 'c'\n    print $ hello 'c'#\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule T12081 where\n\ndata Nat = Z | S Nat\n\nclass C (n :: Nat) where\n  type T n :: Nat\n  f :: (a :: T n)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE KindSignatures #-}\nmodule T12174 where\n\ndata V a\ndata T = forall (a :: S). MkT (V a)\ndata S = forall (a :: T). MkS (V a)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n\n\n\nmodule T13135 where\n\n\nimport Data.Kind (Type)\n\n\nclass sub :<: sup\n  where\n    -- | Injection from @sub@ to @sup@\n    inj ::  sub sig -> sup sig\n\ninstance (sub :<: sup) => (sub :<: AST sup)\n  where\n    inj = Sym . inj\n\n\ndata Sig a = Full a | (:->) a (Sig a)\n\ninfixr :->\n\ntype Sym t = (Sig t -> Type)\n\ndata AST :: Sym t -> Sym t\n  where\n    Sym  :: sym sig -> AST sym sig\n    (:$) :: AST sym (a :-> sig) -> AST sym (Full a) -> AST sym sig\n\n-- | Generic N-ary syntactic construct\n--\n-- 'Construct' gives a quick way to introduce a syntactic construct by giving its name and semantic\n-- function.\ndata Constr sig = Constr String\n\nsmartSym :: (sub :<: sup) => sub sig -> SmartFun sup sig\nsmartSym = error \"urk\"\n\ntype family   SmartFun (sym :: Sig t -> Type) sig = f | f -> sym sig  where\n-- In full glory:\n-- type family SmartFun {t} (sym :: Sig t -> Type) (sig :: Sig t) :: *\n--            = f | f -> {t} sym sig  where\n  SmartFun sym (Full a)    = AST sym (Full a)\n  SmartFun sym (a :-> sig) = AST sym (Full a) -> SmartFun sym sig\n\n-- | Get the length of an array\narrLen ::  AST Constr (Full [a]) -> AST Constr (Full Int)\narrLen = smartSym sym where\n  sym = Constr \"arrLen\"\n\n\n\n{- The original bug was a failure to substitute\n   properly during type-function improvement.\n\n--------------------------------------\ndoTopReact\n  [WD] hole{a1y1} {0}:: (SmartFun\n                           t_a1x9[tau:2] sup_a1xb[tau:2] sig_a1xc[tau:2] :: *)\n                        GHC.Prim.~#\n                        (s_a1y0[fuv:0] :: *) (CFunEqCan)\nmatchFamTcM\n  Matching: SmartFun t_a1x9[tau:2] sup_a1xb[tau:2] sig_a1xc[tau:2]\n  Match failed\nimproveTopFunEqs\n  SmartFun [t_a1x9[tau:2], sup_a1xb[tau:2],\n            sig_a1xc[tau:2]] s_a1y0[fuv:0]\n  [* ~ t_a1x9[tau:2], Constr (Sig *) ~ sup_a1xb[tau:2],\n   (':->) * [a_a1wT[sk:2]] sig_a1y3[tau:2] ~ sig_a1xc[tau:2]]\n\nEmitting new derived equality\n  [D] _ {0}:: (* :: *) GHC.Prim.~# (t_a1x9[tau:2] :: *)\n  [D] _ {0}:: (Constr (Sig *) :: (Sig * -> *))\n                GHC.Prim.~#\n              (sup_a1xb[tau:2] :: (Sig t_a1x9[tau:2] -> *))\n  [D] _ {0}:: ((':->) * [a_a1wT[sk:2]] sig_a1y3[tau:2] :: Sig *)\n              GHC.Prim.~#\n              (sig_a1xc[tau:2] :: Sig t_a1x9[tau:2])\n\nbut sig_a1y3 :: Sig t   BAD\n--------------------------------------\n\nInstance\n  forall t (sig :: Sig t) (a :: t) (sym :: Sig t -> *).\n    SmartFun t sym ((:->) t a sig) = AST t sym (Full t a) -> SmartFun t sym sig\n\nWanted:\n  SmartFun t_a1x9[tau:2] sup_a1xb[tau:2] sig_a1xc[tau:2] ~ s_a1y0[fuv:0]\n  s_a1y0[fuv:0]  ~  AST * (Constr (Sig *))\n                          ('Full * [a_a1wT[sk:2]])\n                    -> AST * (Constr (Sig *)) ('Full * Int)\n\nSubstitution after matching RHSs\n  [ t -> *\n  , (sym :: Sig t -> *) -> Constr (Sig *)\n  , a -> a_a1wT ]\n\nadd sig -> sig0 :: Sig t   -- Or rather Sig *\n\nApply to LHS\n\n   SmartFun * (Constr (Sig *)) ((:->) * a_a1wT sig0)\n\n\nimproveTopFunEqs\n  SmartFun [t_a1x9[tau:2], sup_a1xb[tau:2],\n            sig_a1xc[tau:2]] s_a1y0[fuv:0]\n  [* ~ t_a1x9[tau:2], Constr (Sig *) ~ sup_a1xb[tau:2],\n   (':->) * [a_a1wT[sk:2]] sig_a1y3[tau:2] ~ sig_a1xc[tau:2]]\n-}\n", "num_lines": 123}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}\n\nimport GHC.Exts\nimport Prelude (Bool(True,False),Integer,Ordering,undefined)\nimport qualified Prelude\nimport Data.Kind\n\n--------------------\n-- class hierarchy\n\ntype family\n  Rep (rep :: RuntimeRep) :: RuntimeRep where\n  -- Rep IntRep         = IntRep\n  -- Rep DoubleRep      = IntRep\n  -- Rep PtrRepUnlifted = IntRep\n  -- Rep PtrRepLifted   = PtrRepLifted\n\nclass Boolean (Logic a) => Eq (a :: TYPE rep) where\n  type Logic (a :: TYPE rep) :: TYPE (Rep rep)\n  (==) :: a -> a -> Logic a\n\nclass Eq a => POrd (a :: TYPE rep) where\n  inf :: a -> a -> a\n\nclass POrd a => MinBound (a :: TYPE rep) where\n  minBound :: () -> a\n\nclass POrd a => Lattice (a :: TYPE rep) where\n  sup :: a -> a -> a\n\nclass (Lattice a, MinBound a) => Bounded (a :: TYPE rep) where\n  maxBound :: () -> a\n\nclass Bounded a => Complemented (a :: TYPE rep) where\n  not :: a -> a\n\nclass Bounded a => Heyting (a :: TYPE rep) where\n  infixr 3 ==>\n  (==>) :: a -> a -> a\n\nclass (Complemented a, Heyting a) => Boolean a\n\n(||) :: Boolean a => a -> a -> a\n(||) = sup\n\n(&&) :: Boolean a => a -> a -> a\n(&&) = inf\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T13780a where\n\ndata family Sing (a :: k)\n\ndata Foo a = a ~ Bool => MkFoo\ndata instance Sing (z :: Foo a) = (z ~ MkFoo) => SMkFoo\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T13780b where\n\ndata family Sing (a :: k)\n\ndata instance Sing (z :: Bool) =\n    z ~ False => SFalse\n  | z ~ True  => STrue\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T13780c where\n\nimport Data.Kind\nimport T13780b\n\ntype family ElimBool (p :: Bool -> Type) (b :: Bool) (s :: Sing b)\n                     (pFalse :: p False) (pTrue :: p True) :: p b where\n  ElimBool _ _ SFalse pFalse _ = pFalse\n  ElimBool _ _ STrue  _ pTrue  = pTrue\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeInType #-}\nmodule T13895 where\n\nimport Data.Data (Data, Typeable)\nimport Data.Kind\n\ndataCast1 :: forall (a :: Type).\n             Data a\n          => forall (c :: Type -> Type)\n                    (t :: forall (k :: Type). Typeable k => k -> Type).\n             Typeable t\n          => (forall d. Data d => c (t d))\n          -> Maybe (c a)\ndataCast1 _ = undefined\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PolyKinds #-}\n\n\n\nmodule T14066 where\n\nimport Data.Kind ( Type )\nimport Data.Type.Equality\nimport Data.Proxy\nimport GHC.Exts\n\ndata SameKind :: k -> k -> Type\n\nf (x :: Proxy a) = let g :: forall k (b :: k). SameKind a b\n                       g = undefined\n                   in ()\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, UndecidableInstances #-}\n\nmodule T14066c where\n\ntype family H a b where\n  H a b = H b a\n\ntype X = H True Nothing  -- this should fail to kind-check.\n                         -- if it's accepted, then we've inferred polymorphic recursion for H\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds #-}\n\nmodule T14066d where\n\nimport Data.Proxy\n\ng :: (forall c b (a :: c). (Proxy a, Proxy c, b)) -> ()\ng _ = ()\n\nf :: forall b. b -> (Proxy Maybe, ())\nf x = (fstOf3 y :: Proxy Maybe, g y)\n  where\n    y :: (Proxy a, Proxy c, b)  -- this should NOT generalize over b\n                                -- meaning the call to g is ill-typed\n    y = (Proxy, Proxy, x)\n\nfstOf3 (x, _, _) = x\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonoLocalBinds, PolyKinds, ScopedTypeVariables #-}\n\nmodule T14066e where\n\nimport Data.Proxy\n\n-- this should fail because the dependency between b and c can't be\n-- determined in the type signature\nh :: forall a. a -> ()\nh x = ()\n  where\n    j :: forall c b. Proxy a -> Proxy b -> Proxy c -> Proxy b\n    j _ (p1 :: Proxy b') (p2 :: Proxy c') = (p1 :: Proxy (b' :: c'))\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T14066f where\n\nimport Data.Proxy\n\n-- a can't come before k.\ntype P a k = Proxy (a :: k)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule T14066g where\n\nimport Data.Kind\n\ndata SameKind :: k -> k -> Type\n\ndata Q a (b :: a) (d :: SameKind c b)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds, DataKinds, KindSignatures, GADTs, TypeInType, ConstraintKinds #-}\nmodule T14845_fail1 where\n\nimport Data.Kind\n\ndata Struct :: (k -> Constraint) -> (k -> Type) where\n  S :: cls a => Struct cls a\n\ndata Foo a where\n  F :: Foo (S::Struct Eq a)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\nmodule T14845_fail2 where\n\nimport Data.Coerce\nimport Data.Kind\n\ndata A :: Type -> Type where\n  MkA :: Coercible a Int => A a\n\ndata SA :: forall a. A a -> Type where\n  SMkA :: SA MkA\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\nmodule T15215 where\n\nimport Data.Kind\n\ndata A :: Type -> Type where\n  MkA :: Show (Maybe a) => A a\n\ndata B :: Type -> Type where\n  MkB :: Show a => B a\n\ndata SA :: forall a. A a -> Type where\n  SMkA :: SA MkA\n  SMkB :: SA MkB\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, TypeApplications #-}\n\nmodule T15245 where\n\nimport Type.Reflection\n\ndata family K\ndata instance K = MkK\n\nmain = print (typeRep @'MkK)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll, PolyKinds #-}\n\nmodule T15264 where\n\nimport Data.Proxy\n\nbad1 :: forall (a :: k). Proxy a -> ()\nbad1 _ = ()\n\nbad2 :: forall (a :: k1) (b :: k2). Proxy a -> ()\nbad2 _ = ()\n\ngood :: forall k (a :: k). Proxy a -> ()\ngood _ = ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\nmodule T15308 where\n\nimport Data.Kind\n\ndata Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where\n  MkFoo :: Foo a f\n\nf :: Foo a f -> String\nf = show\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeInType #-}\nmodule T15343 where\n\nimport Data.Kind\n\nelimSing :: forall (p :: forall z. z). p\nelimSing = undefined\n\ndata WhySym :: Type -> Type\n\nhsym = elimSing @WhySym\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T15380 where\n\nimport Data.Kind\n\nclass Generic a where\n  type Rep a :: Type\n\nclass PGeneric a where\n  type To a (x :: Rep a) :: a\n\ntype family MDefault (x :: a) :: a where\n  MDefault x = To (M x)\n\nclass C a where\n  type M (x :: a) :: a\n  type M (x :: a) = MDefault x\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, MultiParamTypeClasses, DataKinds, TypeFamilies #-}\n\nmodule T15591b where\n\nimport Data.Proxy\nimport Data.Kind\n\nclass C2 (a :: Type) (b :: Proxy a) (c :: Proxy b) where\n  type T4 a c\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, MultiParamTypeClasses, DataKinds, TypeFamilies #-}\n\nmodule T15591c where\n\nimport Data.Proxy\nimport Data.Kind\n\nclass C3 (a :: Type) (b :: Proxy a) (c :: Proxy b) where\n  type T5 c a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, ExplicitForAll #-}\n\nmodule T15743 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type\n\ndata T k (c :: k) (a :: Proxy c) b (x :: SimilarKind a b)\ndata T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, ExplicitForAll #-}\n\nmodule T15743 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type\n\ndata T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes        #-}\n{-# Language PolyKinds         #-}\n{-# Language KindSignatures    #-}\n{-# Language DataKinds         #-}\n{-# Language FlexibleInstances #-}\n\n{-# Options_GHC -dcore-lint #-}\n\nmodule T15825 where\n\ntype C k = (forall (x::k). *)\n\nclass                         X (a :: *)\ninstance forall k (a :: C k). X (a :: *)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds          #-}\n{-# Language TypeApplications   #-}\n{-# Language ImpredicativeTypes #-}\n{-# Language LiberalTypeSynonyms #-}\n\nmodule T15859 where\n\nimport Data.Kind\n\ndata A k :: k -> Type\n\ntype KindOf (a :: k) = k\n\na = (undefined :: KindOf A) @Int\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail1 where\n\nid1 :: forall a -> a -> a\nid1 _ x = x\n\ntype Foo = forall a -> a -> a\nid2 :: Foo\nid2 _ x = x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail10 where\n\nimport Data.Kind\n\ntype Const a b = a\n\nflurmp :: a -> ()\nflurmp _ = ()\n{-# RULES \"flurmp\"\n    forall (x :: forall a -> a -> a). flurmp x = () #-}\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule T16326_Fail11 where\n\nclass C a where\n  m :: b -> a\n  default m :: (forall x -> x) ~ b => b -> a\n  m = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail12 where\n\nclass (forall a -> Show a) => C a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail2 where\n\nforeign import ccall \"blah\" blah :: forall a -> a -> IO ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail3 where\n\npattern Nil :: forall a -> [a]\npattern Nil <- undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail4 where\n\nfoo :: Maybe a -> Maybe a -> Maybe a\nfoo xs ys = zipWith ((<>) :: forall a -> Maybe a -> Maybe a -> Maybe a) xs ys\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule T16326_Fail5 where\n\nisJust :: Maybe a -> Bool\nisJust (Nothing :: forall a -> Maybe a) = False\nisJust (Just _)                         = True\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail6 where\n\nimport Data.Kind\n\ndata Foo :: Type -> Type where\n  MkFoo :: forall a -> a -> Foo a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\nmodule T16326_Fail7 where\n\nimport Data.Kind\n\n-- Make sure that this doesn't parse as something goofy like\n--  forall (forall :: Type -> Type) (k :: Type). forall k -> k -> Type\ndata Foo :: forall k -> k -> Type\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16326_Fail8 where\n\nclass C a\ndata Blah a\ninstance forall a -> C (Blah a)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T16326_Fail9 where\n\nlol :: forall a. a\nlol = undefined\n\nt :: Bool\nt = lol @(forall a -> a -> a) undefined True\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16391b where\n\nimport GHC.Exts\n\ntype family T (r :: RuntimeRep) :: TYPE r\n\nfoo :: T r\nfoo = foo\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, PolyKinds #-}\n-- NB: -fprint-explicit-runtime-reps enabled in all.T\n\nmodule TypeSkolEscape where\n\nimport GHC.Types\nimport GHC.Exts\n\ntype Bad = forall (v :: RuntimeRep) (a :: TYPE v). a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11311 where\n\nimport Data.Kind\n\nfoo :: ()\nfoo = (id :: Type -> Type) undefined `seq` ()\n\nmain = print foo\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11964 where\n\nimport Data.Kind\nimport T11964a\n\nt1 :: T Type Int\nt1 = T ()\n\nt2 :: T Star Int\nt2 = T ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\nmodule T11964a where\nimport Data.Kind\ntype Star = Type\nnewtype T k (t :: k) = T ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Prim\n\ndata TestData = First Int Double String Int Int Int Int\n              | Second Char# Int# Word# Double#\n              | Third TestData TestData TestData TestData\n              deriving (Eq, Ord)\n\nmain = return ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DataKinds          #-}\n{-# LANGUAGE PolyKinds          #-}\n\nmodule AutoDeriveTypeable where\n\nimport Data.Typeable\n\n\ndata A = A\n\ndata B = B deriving Typeable\n\ndata C = C\nderiving instance Typeable C\n\ntest = [ typeRep [A], typeRep [B], typeRep [C]\n       , typeRep (Proxy :: Proxy 'B), typeRep (Proxy :: Proxy 'C)]\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XDeriveDataTypeable #-}\n\n-- Trac #1935\n-- See Note [Superclasses of derived instance] in TcDeriv\n\n{-# OPTIONS -fno-warn-redundant-constraints #-}\n\nmodule Foo where\n\n import Data.Data\n\n data Foo a = Foo\n    deriving (Data, Typeable)\n\n data T a = MkT (S a) deriving( Ord )\n\n instance Num a => Eq (T a)\n\n data S a = S\n instance Eq (S a)\n instance Ord (S a)\n\n\n ", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE InstanceSigs #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule DerivingViaCompile where\n\nimport Data.Void\nimport Data.Complex\nimport Data.Functor.Const\nimport Data.Functor.Identity\nimport Data.Ratio\nimport Control.Monad.Reader\nimport Control.Monad.State\nimport Control.Monad.Writer\nimport Control.Applicative hiding (WrappedMonad(..))\n\nimport Data.Bifunctor\nimport Data.Monoid\nimport Data.Kind\n\ntype f ~> g = forall xx. f xx -> g xx\n\n-----\n-- Simple example\n-----\n\ndata Foo a = MkFoo a a\n  deriving Show\n       via (Identity (Foo a))\n\n-----\n-- Eta reduction at work\n-----\n\nnewtype Flip p a b = Flip { runFlip :: p b a }\n\ninstance Bifunctor p => Bifunctor (Flip p) where\n  bimap f g = Flip . bimap g f . runFlip\n\ninstance Bifunctor p => Functor (Flip p a) where\n  fmap f = Flip . first f . runFlip\n\nnewtype Bar a = MkBar (Either a Int)\n  deriving Functor\n       via (Flip Either Int)\n\n-----\n-- Monad transformers\n-----\n\ntype MTrans = (Type -> Type) -> (Type -> Type)\n\n-- From `constraints'\ndata Dict c where\n  Dict :: c => Dict c\n\nnewtype a :- b = Sub (a => Dict b)\n\ninfixl 1 \\\\\n(\\\\) :: a => (b => r) -> (a :- b) -> r\nr \\\\ Sub Dict = r\n\n-- With `-XQuantifiedConstraints' this just becomes\n--\n--    type Lifting cls  trans = forall mm. cls mm => cls (trans mm)\n--\n--    type LiftingMonad trans = Lifting Monad trans\n--\nclass LiftingMonad (trans :: MTrans) where\n  proof :: Monad m :- Monad (trans m)\n\ninstance LiftingMonad (StateT s :: MTrans) where\n  proof :: Monad m :- Monad (StateT s m)\n  proof = Sub Dict\n\ninstance Monoid w => LiftingMonad (WriterT w :: MTrans) where\n  proof :: Monad m :- Monad (WriterT w m)\n  proof = Sub Dict\n\ninstance (LiftingMonad trans, LiftingMonad trans') => LiftingMonad (ComposeT trans trans' :: MTrans) where\n  proof :: forall m. Monad m :- Monad (ComposeT trans trans' m)\n  proof = Sub (Dict \\\\ proof @trans @(trans' m) \\\\ proof @trans' @m)\n\nnewtype Stack :: MTrans where\n  Stack :: ReaderT Int (StateT Bool (WriterT String m)) a -> Stack m a\n  deriving newtype\n    ( Functor\n    , Applicative\n    , Monad\n    , MonadReader Int\n    , MonadState Bool\n    , MonadWriter String\n    )\n  deriving (MonadTrans, MFunctor)\n       via (ReaderT Int `ComposeT` StateT Bool `ComposeT` WriterT String)\n\nclass MFunctor (trans :: MTrans) where\n  hoist :: Monad m => (m ~> m') -> (trans m ~> trans m')\n\ninstance MFunctor (ReaderT r :: MTrans) where\n  hoist :: Monad m => (m ~> m') -> (ReaderT r m ~> ReaderT r m')\n  hoist nat = ReaderT . fmap nat . runReaderT\n\ninstance MFunctor (StateT s :: MTrans) where\n  hoist :: Monad m => (m ~> m') -> (StateT s m ~> StateT s m')\n  hoist nat = StateT . fmap nat . runStateT\n\ninstance MFunctor (WriterT w :: MTrans) where\n  hoist :: Monad m => (m ~> m') -> (WriterT w m ~> WriterT w m')\n  hoist nat = WriterT . nat . runWriterT\n\ninfixr 9 `ComposeT`\nnewtype ComposeT :: MTrans -> MTrans -> MTrans where\n  ComposeT :: { getComposeT :: f (g m) a } -> ComposeT f g m a\n  deriving newtype (Functor, Applicative, Monad)\n\ninstance (MonadTrans f, MonadTrans g, LiftingMonad g) => MonadTrans (ComposeT f g) where\n  lift :: forall m. Monad m => m ~> ComposeT f g m\n  lift = ComposeT . lift . lift\n    \\\\ proof @g @m\n\ninstance (MFunctor f, MFunctor g, LiftingMonad g) => MFunctor (ComposeT f g) where\n  hoist :: forall m m'. Monad m => (m ~> m') -> (ComposeT f g m ~> ComposeT f g m')\n  hoist f = ComposeT . hoist (hoist f) . getComposeT\n    \\\\ proof @g @m\n\n-----\n-- Using tuples in a `via` type\n-----\n\nnewtype X a = X (a, a)\n  deriving (Semigroup, Monoid)\n       via (Product a, Sum a)\n\n  deriving (Show, Eq)\n       via (a, a)\n\n-----\n-- Abstract data types\n-----\n\nclass C f where\n  c :: f a -> Int\n\nnewtype X2 f a = X2 (f a)\n\ninstance C (X2 f) where\n  c = const 0\n\nderiving via (X2 IO) instance C IO\n\n----\n-- Testing parser\n----\n\nnewtype P0 a = P0 a             deriving Show via a\nnewtype P1 a = P1 [a]           deriving Show via [a]\nnewtype P2 a = P2 (a, a)        deriving Show via (a, a)\nnewtype P3 a = P3 (Maybe a)     deriving Show via (First a)\nnewtype P4 a = P4 (Maybe a)     deriving Show via (First $ a)\nnewtype P5 a = P5 a             deriving Show via (Identity $ a)\nnewtype P6 a = P6 [a]           deriving Show via ([] $ a)\nnewtype P7 a = P7 (a, a)        deriving Show via (Identity $ (a, a))\nnewtype P8 a = P8 (Either () a) deriving Functor via (($) (Either ()))\n\nnewtype f $ a = APP (f a) deriving newtype Show deriving newtype Functor\n\n----\n-- From Baldur's notes\n----\n\n----\n-- 1\n----\nnewtype WrapApplicative f a = WrappedApplicative (f a)\n  deriving (Functor, Applicative)\n\ninstance (Applicative f, Num a) => Num (WrapApplicative f a) where\n  (+)         = liftA2 (+)\n  (*)         = liftA2 (*)\n  negate      = fmap negate\n  fromInteger = pure . fromInteger\n  abs         = fmap abs\n  signum      = fmap signum\n\ninstance (Applicative f, Fractional a) => Fractional (WrapApplicative f a) where\n  recip        = fmap recip\n  fromRational = pure . fromRational\n\ninstance (Applicative f, Floating a) => Floating (WrapApplicative f a) where\n  pi    = pure pi\n  sqrt  = fmap sqrt\n  exp   = fmap exp\n  log   = fmap log\n  sin   = fmap sin\n  cos   = fmap cos\n  asin  = fmap asin\n  atan  = fmap atan\n  acos  = fmap acos\n  sinh  = fmap sinh\n  cosh  = fmap cosh\n  asinh = fmap asinh\n  atanh = fmap atanh\n  acosh = fmap acosh\n\ninstance (Applicative f, Semigroup s) => Semigroup (WrapApplicative f s) where\n  (<>) = liftA2 (<>)\n\ninstance (Applicative f, Monoid m) => Monoid (WrapApplicative f m) where\n  mempty = pure mempty\n\n----\n-- 2\n----\nclass Pointed p where\n  pointed :: a -> p a\n\nnewtype WrapMonad f a = WrappedMonad (f a)\n  deriving newtype (Pointed, Monad)\n\ninstance (Monad m, Pointed m) => Functor (WrapMonad m) where\n  fmap = liftM\n\ninstance (Monad m, Pointed m) => Applicative (WrapMonad m) where\n  pure  = pointed\n  (<*>) = ap\n\n-- data\ndata Sorted a = Sorted a a a\n  deriving (Functor, Applicative)\n    via (WrapMonad Sorted)\n  deriving (Num, Fractional, Floating, Semigroup, Monoid)\n    via (WrapApplicative Sorted a)\n\n\ninstance Monad Sorted where\n  (>>=) :: Sorted a -> (a -> Sorted b) -> Sorted b\n  Sorted a b c >>= f = Sorted a' b' c' where\n    Sorted a' _  _  = f a\n    Sorted _  b' _  = f b\n    Sorted _  _  c' = f c\n\ninstance Pointed Sorted where\n  pointed :: a -> Sorted a\n  pointed a = Sorted a a a\n\n----\n-- 3\n----\nclass IsZero a where\n  isZero :: a -> Bool\n\nnewtype WrappedNumEq  a = WrappedNumEq a\nnewtype WrappedShow   a = WrappedShow  a\nnewtype WrappedNumEq2 a = WrappedNumEq2 a\n\ninstance (Num a, Eq a) => IsZero (WrappedNumEq a) where\n  isZero :: WrappedNumEq a -> Bool\n  isZero (WrappedNumEq a) = 0 == a\n\ninstance Show a => IsZero (WrappedShow a) where\n  isZero :: WrappedShow a -> Bool\n  isZero (WrappedShow a) = \"0\" == show a\n\ninstance (Num a, Eq a) => IsZero (WrappedNumEq2 a) where\n  isZero :: WrappedNumEq2 a -> Bool\n  isZero (WrappedNumEq2 a) = a + a == a\n\nnewtype INT = INT Int\n  deriving newtype Show\n  deriving IsZero via (WrappedNumEq Int)\n\nnewtype VOID = VOID Void deriving IsZero via (WrappedShow Void)\n\n----\n-- 4\n----\nclass Bifunctor p => Biapplicative p where\n  bipure :: a -> b -> p a b\n\n  biliftA2\n    :: (a  -> b  -> c)\n    -> (a' -> b' -> c')\n    -> p a a'\n    -> p b b'\n    -> p c c'\n\ninstance Biapplicative (,) where\n  bipure = (,)\n\n  biliftA2 f f' (a, a') (b, b') =\n    (f a b, f' a' b')\n\nnewtype WrapBiapp p a b = WrapBiap (p a b)\n  deriving newtype (Bifunctor, Biapplicative, Eq)\n\ninstance (Biapplicative p, Num a, Num b) => Num (WrapBiapp p a b) where\n  (+) = biliftA2 (+) (+)\n  (-) = biliftA2 (*) (*)\n  (*) = biliftA2 (*) (*)\n  negate = bimap negate negate\n  abs = bimap abs abs\n  signum = bimap signum signum\n  fromInteger n = fromInteger n `bipure` fromInteger n\n\nnewtype INT2 = INT2 (Int, Int)\n  deriving IsZero via (WrappedNumEq2 (WrapBiapp (,) Int Int))\n\n----\n-- 5\n----\nclass Monoid a => MonoidNull a where\n  null :: a -> Bool\n\nnewtype WrpMonNull a = WRM a deriving (Eq, Semigroup, Monoid)\n\ninstance (Eq a, Monoid a) => MonoidNull (WrpMonNull a) where\n  null :: WrpMonNull a -> Bool\n  null = (== mempty)\n\nderiving via (WrpMonNull Any) instance MonoidNull Any\nderiving via ()               instance MonoidNull ()\nderiving via Ordering         instance MonoidNull Ordering\n\n----\n-- 6\n----\n-- https://github.com/mikeizbicki/subhask/blob/f53fd8f465747681c88276c7dabe3646fbdf7d50/src/SubHask/Algebra.hs#L635\n\nclass Lattice a where\n  sup   :: a -> a -> a\n  (.>=) :: a -> a -> Bool\n  (.>)  :: a -> a -> Bool\n\nnewtype WrapOrd a = WrappedOrd a\n  deriving newtype (Eq, Ord)\n\ninstance Ord a => Lattice (WrapOrd a) where\n  sup   = max\n  (.>=) = (>=)\n  (.>)  = (>)\n\nderiving via [a]    instance Ord a          => Lattice [a]\nderiving via (a, b) instance (Ord a, Ord b) => Lattice (a, b)\n--mkLattice_(Bool)\nderiving via Bool instance Lattice Bool\n--mkLattice_(Char)\nderiving via Char instance Lattice Char\n--mkLattice_(Int)\nderiving via Int instance Lattice Int\n--mkLattice_(Integer)\nderiving via Integer instance Lattice Integer\n--mkLattice_(Float)\nderiving via Float instance Lattice Float\n--mkLattice_(Double)\nderiving via Double instance Lattice Double\n--mkLattice_(Rational)\nderiving via Rational instance Lattice Rational\n\n----\n-- 7\n----\n-- https://hackage.haskell.org/package/linear-1.20.7/docs/src/Linear-Affine.html\n\nclass Functor f => Additive f where\n  zero :: Num a => f a\n  (^+^) :: Num a => f a -> f a -> f a\n  (^+^) = liftU2 (+)\n  (^-^) :: Num a => f a -> f a -> f a\n  x ^-^ y = x ^+^ fmap negate y\n  liftU2 :: (a -> a -> a) -> f a -> f a -> f a\n\ninstance Additive [] where\n  zero = []\n  liftU2 f = go where\n    go (x:xs) (y:ys) = f x y : go xs ys\n    go [] ys = ys\n    go xs [] = xs\n\ninstance Additive Maybe where\n  zero = Nothing\n  liftU2 f (Just a) (Just b) = Just (f a b)\n  liftU2 _ Nothing ys = ys\n  liftU2 _ xs Nothing = xs\n\ninstance Applicative f => Additive (WrapApplicative f) where\n  zero   = pure 0\n  liftU2 = liftA2\n\nderiving via (WrapApplicative ((->) a)) instance Additive ((->) a)\nderiving via (WrapApplicative Complex)  instance Additive Complex\nderiving via (WrapApplicative Identity) instance Additive Identity\n\ninstance Additive ZipList where\n  zero = ZipList []\n  liftU2 f (ZipList xs) (ZipList ys) = ZipList (liftU2 f xs ys)\n\nclass Additive (Diff p) => Affine p where\n  type Diff p :: Type -> Type\n\n  (.-.) :: Num a => p a -> p a -> Diff p a\n  (.+^) :: Num a => p a -> Diff p a -> p a\n  (.-^) :: Num a => p a -> Diff p a -> p a\n  p .-^ v = p .+^ fmap negate v\n\n-- #define ADDITIVEC(CTX,T) instance CTX => Affine T where type Diff T = T ; \\\n--   (.-.) = (^-^) ; {-# INLINE (.-.) #-} ; (.+^) = (^+^) ; {-# INLINE (.+^) #-} ; \\\n--   (.-^) = (^-^) ; {-# INLINE (.-^) #-}\n-- #define ADDITIVE(T) ADDITIVEC((), T)\nnewtype WrapAdditive f a = WrappedAdditive (f a)\n\ninstance Additive f => Affine (WrapAdditive f) where\n  type Diff (WrapAdditive f) = f\n\n  WrappedAdditive a .-. WrappedAdditive b = a ^-^ b\n  WrappedAdditive a .+^ b = WrappedAdditive (a ^+^ b)\n  WrappedAdditive a .-^ b = WrappedAdditive (a ^-^ b)\n\n-- ADDITIVE(((->) a))\nderiving via (WrapAdditive ((->) a)) instance Affine ((->) a)\n-- ADDITIVE([])\nderiving via (WrapAdditive [])       instance Affine []\n-- ADDITIVE(Complex)\nderiving via (WrapAdditive Complex)  instance Affine Complex\n-- ADDITIVE(Maybe)\nderiving via (WrapAdditive Maybe)    instance Affine Maybe\n-- ADDITIVE(ZipList)\nderiving via (WrapAdditive ZipList)  instance Affine ZipList\n-- ADDITIVE(Identity)\nderiving via (WrapAdditive Identity) instance Affine Identity\n\n----\n-- 8\n----\n\nclass C2 a b c where\n  c2 :: a -> b -> c\n\ninstance C2 a b (Const a b) where\n  c2 x _ = Const x\n\nnewtype Fweemp a = Fweemp a\n  deriving (C2 a b)\n       via (Const a (b :: Type))\n", "num_lines": 460}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule DerivingViaStandalone where\n\nimport Data.Kind (Type)\nimport Control.Applicative\nimport Data.Functor.Compose\nimport Data.Proxy\nimport Data.Semigroup\n\nnewtype App (f :: Type -> Type) a = App (f a)\n  deriving newtype\n    (Functor, Applicative)\n\ninstance (Applicative f, Semigroup a) => Semigroup (App f a) where\n  (<>) = liftA2 (<>)\n\nderiving via (App (Compose (f :: Type -> Type) g) a)\n         instance (Applicative f, Applicative g, Semigroup a)\n               => Semigroup (Compose f g a)\n\nclass C (a :: k -> Type)\ninstance C Proxy\n\nnewtype MyProxy a = MyProxy (Proxy a)\nderiving via (Proxy :: Type -> Type) instance C MyProxy\n\nclass Z a b\ndata T a\ndata X1 a\ndata X2 a\ndata X3 a\n\nderiving via (forall a. T a) instance           Z a (X1 b)\nderiving via           (T a) instance forall b. Z a (X2 b)\nderiving via (forall a. T a) instance forall b. Z a (X3 b)\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n{-# LANGUAGE DeriveTraversable, DeriveGeneric, EmptyCase,\n    DeriveDataTypeable, StandaloneDeriving, DeriveLift #-}\n\nmodule DrvEmptyData where\nimport GHC.Generics (Generic, Generic1)\nimport Data.Data (Data)\nimport Language.Haskell.TH.Syntax (Lift)\n\ndata Void a deriving (Functor, Foldable, Traversable, Generic, Generic1, Lift)\n\n-- We don't want to invoke the special case for phantom types here.\ntype role Void nominal\n\nderiving instance Data a => Data (Void a)\nderiving instance Eq (Void a)\nderiving instance Ord (Void a)\nderiving instance Show (Void a)\nderiving instance Read (Void a)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE FlexibleContexts, DatatypeContexts #-}\n\nmodule ShouldCompile where\n\nimport Data.Foldable\nimport Data.Traversable\n\ndata Trivial a = Trivial\n   deriving (Functor,Foldable,Traversable)\n\n-- lots of different things\ndata Strange a b c\n    = T1 a b c\n    | T2 c c c\n    | T3 [a] [b] [c]         -- lists\n    | T4 [[a]] [[b]] [[c]]   -- nested lists\n    | T5 (c,(b,b),(c,c))     -- tuples\n    | T6 ([c],Strange a b c) -- tycons\n  deriving (Functor,Foldable,Traversable)\n\ndata NotPrimitivelyRecursive a\n    = S1 (NotPrimitivelyRecursive (a,a))\n    | S2 a\n  deriving (Functor,Foldable,Traversable)\n\ndata Eq a => StupidConstraint a b = Stupid a b\n  deriving (Functor,Foldable,Traversable)\n\n-- requires Foldable/Traversable constraint on f and g\ndata Compose f g a = Compose (f (g a))\n  deriving (Functor,Foldable,Traversable)\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE DatatypeContexts #-}\n\nmodule ShouldCompile where\n\ndata Trivial a = Trivial\n   deriving (Functor)\n\ndata Fun a = Fun (Int -> a)\n  deriving (Functor)\n\n-- lots of different things\ndata Strange a b c\n    = T1 a b c\n    | T2 [a] [b] [c]         -- lists\n    | T3 [[a]] [[b]] [[c]]   -- nested lists\n    | T4 (c,(b,b),(c,c))     -- tuples\n    | T5 ([c],Strange a b c) -- tycons\n    | T6 (Int -> c)          -- function types\n    | T7 (a -> (c,a))        -- functions and tuples \n    | T8 ((c -> a) -> a)     -- continuation\n  deriving (Functor)\n\ndata NotPrimitivelyRecursive a\n    = S1 (NotPrimitivelyRecursive (a,a))\n    | S2 a\n  deriving (Functor,Eq)\n\ndata Eq a => StupidConstraint a b = Stupid a b\n  deriving (Functor)\n\n-- requires Functor constraint on f and g\ndata Compose f g a = Compose (f (g a))\n  deriving (Functor)\n\n-- We can't derive Functor for the following type.\n-- it needs both (Functor (f Int)) and (Functor (f Bool))\n-- i.e.:\n--  instance (Functor (f Bool), Functor (f Int)) => Functor (ComplexConstraint f)\n-- This requires FlexibleContexts and UndecidableInstances\ndata ComplexConstraint f a = ComplexConstraint (f Int (f Bool a,a))\n--  deriving (Functor)\n\ndata Universal a\n    = Universal  (forall b. (b,[a]))\n    | Universal2 (forall f. Functor f => (f a))\n    | Universal3 (forall a. a -> Int) -- reuse a\n    | NotReallyUniversal (forall b. a)\n  deriving (Functor)\n\n-- Ghc doesn't allow deriving for non-Haskell98 data constructors\ndata Existential b\n    = forall a. ExistentialList [a]\n    | forall f. Functor f => ExistentialFunctor (f b)\n    | forall b. SneakyUseSameName (b -> Bool)\n  -- deriving (Functor)\n\n-- Don't get confused by synonyms\ntype IntFun a = Int -> a\ndata IntFunD a = IntFunD (IntFun a)\n  deriving (Functor)\n\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule ShouldCompile where\n\n-- Deriving Functor should still work with GeneralizedNewtypeDeriving instead of DeriveFunctor\n\nnewtype List a = List [a]\n  deriving (Functor)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n{-# LANGUAGE DeriveTraversable #-}\n\nmodule DrvPhantom where\nimport GHC.Generics (Generic, Generic1)\nimport Data.Data (Data)\nimport Language.Haskell.TH.Syntax (Lift)\n\ndata NotAList a = Nil | NotCons (NotAList a)\n  deriving (Functor, Foldable, Traversable)\n\ntype role NotAList phantom\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fno-warn-redundant-constraints #-}\n\n-- !!! canonical weird example for \"deriving\"\nmodule ShouldSucceed where\n\ndata X a b\n  = C1 (T a)\n  | C2 (Y b)\n  | C3 (X b a)\n  deriving (Read, Show)\n\ndata Y b\n  = D1\n  | D2 (X Int b)\n  deriving (Read, Show)\n\ndata T a\n  = E1\n\ninstance Eq a => Show (T a) where\n    showsPrec = error \"show\"\ninstance Eq a => Read (T a) where\n    readsPrec = error \"read\"\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fno-warn-redundant-constraints #-}\n\nmodule ShouldSucceed where\n\ndata Z a b\n  = C1 (T a)\n  | C2 (Z [a] [b])\n  deriving (Show, Read)\n\ndata T a\n  = E1\n\ninstance Eq a => Show (T a) where\n    showsPrec = error \"show\"\ninstance Eq a => Read (T a) where\n    readsPrec = error \"read\"\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fno-warn-redundant-constraints #-}\n\n-- !!! This is the example given in TcDeriv\n--\nmodule ShouldSucceed where\n\ndata T a b\n  = C1 (Foo a) (Bar b) \n  | C2 Int (T b a) \n  | C3 (T a a)\n  deriving Eq\n\ndata Foo a = MkFoo Double a deriving ()\ninstance (Eq a) => Eq (Foo a)\n\ndata Bar a = MkBar Int Int deriving ()\ninstance (Ping b) => Eq (Bar b)\n\nclass Ping a\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! simple example of deriving Ord and Eq simultaneously\n--\nmodule ShouldSucceed where\n\ndata Foo a b c\n  = C1 a Int\n  | C2 b Double\n  | C3 c String\n  deriving (Eq, Ord)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! simple example of deriving Enum\n--\nmodule ShouldSucceed where\n\ndata Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8\n         deriving Enum\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! simple examples of deriving Ix\n--\nmodule ShouldSucceed where\nimport Data.Ix\n\ndata Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8\n         deriving (Eq, Ord, Ix, Show)\n\ndata Bar a b = MkBar a Int b Integer a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! deriving Ord on d. type with a single nullary constructor.\n-- (from ghc-2.10 panic - as reported by Sergey Mechveliani <mechvel@botik.ru>)\n--  \nmodule ShouldSucceed where\n\ndata D = D deriving (Eq,Ord)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! deriving Ix on d. type with nullary constructors\nmodule ShouldSucceed where\n\nimport Data.Ix\n\ndata AD = A | B | C | D deriving (Show, Ord, Eq, Ix)\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! deriving Ix on d. type with one constructor\nmodule ShouldSucceed where\n\nimport Data.Ix\n\ndata Pair a b = Pair a b deriving (Show, Ord, Eq, Ix)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! deriving Enum on d. type with nullary constructors\nmodule ShouldSucceed where\n\ndata AD = A | B | C | D deriving (Enum)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! deriving Enum, but not Ord.\nmodule ShouldSucceed where\n\ndata ABC = A | B | C deriving Enum\n\nx = [A ..C]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- !!! deriving for GADTs which declare Haskell98 data types.\n-- bug reported as http://ghc.haskell.org/trac/ghc/ticket/902\nmodule ShouldSucceed where\n\ndata Maybe1 a where {\n      Nothing1 :: Maybe1 a ;\n      Just1    :: a -> Maybe1 a\n    } deriving (Eq,Ord)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\n-- Deriving Typeable has various special cases\nmodule Foo where\n\nimport Data.Typeable\n\ndata Foo1 = Foo1 deriving( Typeable )\ndata Foo2 a = Foo2 a deriving( Typeable )\ndata Foo3 a b = Foo3 a b deriving( Typeable )\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}\n\nmodule ShouldCompile where\n\ndata T a  = T1 a | T2\nnewtype N = MkN Int\n\nderiving instance Eq a => Eq (T a)\nderiving instance Num N\nderiving instance Eq N\nderiving instance Show N\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- July 07: I'm changing this from \"should_compile\" to \"should_fail\".\n-- It would generate an instance decl like\n--      instance (Show (f a), Show (g a)) => Show (Pair1 f g a)\n-- and that is not Haskell 98.\n--\n-- See Note [Exotic derived instance contexts] in TcSimplify.\n-- The rule is simple: the context of a derived instance decl must\n-- contain constraints of form (C tyvar) only, just as H98.\n\nmodule ShouldCompile where\n\nnewtype Pair1 f g a = Pair1 {unPair1 :: (f a, g a)}\n  deriving (Eq, Ord, Show)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, GeneralizedNewtypeDeriving #-}\n\n-- Test deriving of a multi-parameter class for\n-- one-argument newtype defined in the same module\nmodule ShouldSucceed where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\n-- library stuff\n\nclass Monad m => MonadState s m | m -> s where\n    get :: m s\n    put :: s -> m ()\n\nnewtype State s a = State {\n                           runState :: (s -> (a, s))\n                          }\n\ninstance Functor (State s) where\n    fmap = liftM\n\ninstance Applicative (State s) where\n    pure = return\n    (<*>) = ap\n\ninstance Monad (State s) where\n        return a = State $ \\s -> (a, s)\n        m >>= k  = State $ \\s -> let\n                (a, s') = runState m s\n                in runState (k a) s'\n\ninstance MonadState s (State s) where\n        get   = State $ \\s -> (s, s)\n        put s = State $ \\_ -> ((), s)\n\n-- test code\n\nnewtype Foo a = MkFoo (State Int a)\n deriving (Functor, Applicative, Monad, MonadState Int)\n\nf :: Foo Int\nf = get\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule ShouldCompile where\nimport Data.Typeable\n\ndata A a b c d e f g h i j = A deriving (Typeable)\n  -- Many args\n\ndata B a b = B (a b) deriving (Typeable)\n  -- Non type-kind args", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}\n\nmodule T10487 where\n\nimport GHC.Generics\n\nimport qualified T10487_M as M\n\ndata Name = Name\n\nderiving instance Generic Name\nderiving instance Generic M.Name\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10487_M where\n\ndata Name = Name\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T10524 where\n\nimport Data.Data\n\nnewtype WrappedFunctor f a = WrapFunctor (f a) deriving (Data, Typeable)\n\n-- WrappedFunctor :: forall k. (k -> *) -> k -> *\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DeriveFunctor, RankNTypes #-}\n\nmodule T10561 where\n\nnewtype Compose f g a = Compose (f (g a)) deriving Functor\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies       #-}\n{-# LANGUAGE DeriveFunctor      #-}\n{-# LANGUAGE FlexibleInstances  #-}\n\nmodule T11148 where\n\ndata family G a b c d\ndata instance G Int b Float d = G deriving Functor\n\ndata family H a b c d\ndata instance H [b] b d c = H deriving Functor\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor     #-}\n{-# LANGUAGE DeriveFoldable    #-}\n{-# LANGUAGE DeriveTraversable #-}\n{-# LANGUAGE MagicHash         #-}\nmodule T11174 where\n\nimport GHC.Prim (Int#)\n\ndata IntHash a = IntHash Int#\n  deriving (Functor, Foldable, Traversable)\ndata IntHashFun a = IntHashFun ((a -> Int#) -> a)\n  deriving Functor\ndata IntHashTuple a = IntHashTuple Int# a (a, Int, IntHashTuple (a, Int))\n  deriving (Functor, Foldable, Traversable)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule T1133 where\n\nimport T1133a\n\nnewtype X = X Int deriving Enum\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T1133a where\n\nimport {-# SOURCE #-} T1133\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T11357 where\n\nimport GHC.Generics (Generic1)\n\ndata family   ProxyFam (a :: k)\ndata instance ProxyFam (a :: k) = ProxyCon deriving Generic1\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\nmodule IfThenElseIx where\n\nimport Data.Ix (Ix, )\nimport Prelude\n\nifThenElse :: Bool -> a -> a -> a\nifThenElse True x _ = x\nifThenElse False _ x = x\n\ndata T = A | B deriving (Eq, Ord, Ix)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T11416 where\n\nimport Data.Kind\n\ntype ConstantT a b = a\n\nnewtype T f (a :: ConstantT Type f) = T (f a)\n  deriving Functor\n\ndata family TFam1 (f :: k1) (a :: k2)\nnewtype instance TFam1 f (ConstantT a f) = TFam1 (f a)\n  deriving Functor\n\ndata family TFam2 (f :: k1) (a :: k2)\nnewtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a)\n  deriving Functor\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T11509_2 where\n\nimport GHC.Exts (Constraint)\n\nclass C1 (a :: Constraint) where\nclass C2 where\n\nderiving instance C1 C2\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T11509_3 where\n\nimport System.IO (Handle) -- A data type whose constructors are hidden\n\nclass C a where\n\nderiving instance C Handle\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T11732a where\n\nimport GHC.Generics\n\ndata Proxy k (a :: k) deriving Generic1\n\ndata family ProxyFam (a :: y) (b :: z)\ndata instance ProxyFam k (a :: k) deriving Generic1\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T11732b where\n\ndata P1   (a :: k) = MkP1 deriving Functor\ndata P2 k (a :: k) = MkP2 deriving Functor\n\ndata family P1Fam (x :: y)\ndata family P2Fam (x :: y) (z :: w)\ndata instance P1Fam   (a :: k) deriving Functor\ndata instance P2Fam k (a :: k) deriving Functor\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T11732c where\n\nimport Data.Kind\n\nclass Cat k (cat :: k -> k -> Type) where\n  catId   :: cat a a\n  catComp :: cat b c -> cat a b -> cat a c\n\ninstance Cat Type (->) where\n  catId   = id\n  catComp = (.)\n\nnewtype Fun2 a b = Fun2 (a -> b) deriving (Cat Type)\n\n-- The ticket says this should work:\n--   newtype Fun1 a b = Fun1 (a -> b) deriving (Cat k)\n-- But that requires that the kind of (Cat k) to depend on k, where k is local\n-- This is all due for an update, anyway, when #14331 is done, and it's unclear\n-- what the correct behavior here is, anyway. (Richard thinks: reject!)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T11833 where\n\nimport Data.Kind (Type)\n\nclass Category (cat :: k -> k -> Type) where\n  catId   :: cat a a\n  catComp :: cat b c -> cat a b -> cat a c\n\nnewtype T (c :: Type -> Type -> Type) a b = MkT (c a b) deriving Category\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T11837 where\n\nclass Category (cat :: k -> k -> *) where\n  catId   :: cat a a\n  catComp :: cat b c -> cat a b -> cat a c\n\nnewtype T (c :: k -> k -> *) a b = MkT (c a b) deriving Category\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE KindSignatures #-}\nmodule T12144_1 where\n\nimport Data.Kind (Type)\n\nclass C (a :: Type -> Type)\ndata T a = MkT (a -> Int) deriving C\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\nmodule T12144_2 where\n\nclass C1 a\n\ninstance C1 a => C1 (Foo a)\n\nclass C1 a => C2 a where\n  c2 :: a -> String\n  c2 _ = \"C2 default\"\n\nnewtype Foo a = Foo a deriving C2\n\nfoo :: C1 a => Foo a -> String\nfoo = c2\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T12245 where\n\nimport Data.Data ( Data )\n\ndata Foo f = Foo (f Bool) (f Int)\n\nderiving instance Data (Foo [])\nderiving instance Data (Foo Maybe)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, MagicHash, UnboxedTuples #-}\nmodule T12399 where\n\nimport GHC.Exts\n\nnewtype RmLoopsM a = RmLoopsM { runRmLoops :: Int# -> (# Int#, a #) }\n  deriving Functor\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures, DeriveAnyClass #-}\nmodule T12423 where\n\nclass Eq1 f where\n  (==#) :: Eq a => f a -> f a -> Bool\n  default (==#) :: Eq (f a) => f a -> f a -> Bool\n  (==#) = (==)\n\ndata Foo a = Foo (Either a a)\n    deriving (Eq, Eq1)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T12583 where\n\nimport Data.Ix\n\ndata Foo a where\n  MkFoo :: (Eq a, Ord a, Ix a) => Foo a\nderiving instance Eq  (Foo a)\nderiving instance Ord (Foo a)\nderiving instance Ix  (Foo a)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T12594 where\n\nimport GHC.Generics\n\ndata Action = Action\n\nclass ToField a where\n  toField :: a -> Action\n\ninstance ToField Int where\n  -- Not the actual instance, but good enough for testing purposes\n  toField _ = Action\n\nclass ToRow a where\n    toRow :: a -> [Action]\n    default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]\n    toRow = gtoRow . from\n\nclass GToRow f where\n    gtoRow :: f p -> [Action]\n\ninstance GToRow f => GToRow (M1 c i f) where\n    gtoRow (M1 x) = gtoRow x\n\ninstance (GToRow f, GToRow g) => GToRow (f :*: g) where\n    gtoRow (f :*: g) = gtoRow f ++ gtoRow g\n\ninstance (ToField a) => GToRow (K1 R a) where\n    gtoRow (K1 a) = [toField a]\n\ninstance GToRow U1 where\n    gtoRow _ = []\n\ndata Foo = Foo { bar :: Int }\n  deriving (Generic, ToRow)\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T12616 where\n\ntype m ~> n = forall a. m a -> n a\n\nclass MonadTrans t where\n  -- > this line works:\n  -- lift :: (Monad m) => m a -> t m a\n  -- > this line doesn't:\n  lift :: (Monad m) => m ~> t m\n\ndata StateT s m a = StateT { runStateT :: s -> m (a, s) }\n\ninstance MonadTrans (StateT s) where\n  lift xM = StateT $ \\ s -> do { x <- xM ; return (x,s) }\n\nnewtype OtherStateT s m a = OtherStateT { runOtherStateT :: StateT s m a }\n  deriving (MonadTrans)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, OverloadedStrings #-}\nmodule T12688 where\n\nimport Prelude (String,Show(..))\n\nnewtype Text = Text String\n\nfromString :: String -> Text\nfromString = Text\n\nx :: Text\nx = \"x\"\n\nnewtype Foo = Foo ()\n  deriving (Show)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T12814 where\n\nclass C a where\n  type T a\n\nnewtype Identity a = Identity a\n  deriving C\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T13154a where\n\nimport GHC.Exts\n\nclass C1 a\nderiving instance C1 (a -> b)\n\nclass C2 (a :: TYPE 'IntRep)\nderiving instance C2 Int#\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T13272 where\n\nimport GHC.Generics\n\nclass TypeName a where\n  typeName         :: forall proxy.\n                      proxy a -> String\n  default typeName :: forall proxy d f.\n                      (Generic a, Rep a ~ D1 d f, Datatype d)\n                   => proxy a -> String\n  typeName _ = gtypeName $ from (undefined :: a)\n\ngtypeName :: Datatype d => D1 d f p -> String\ngtypeName = datatypeName\n\ndata T a = MkT a\n  deriving (Generic, TypeName)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T13272a where\n\nimport GHC.Generics\n\nclass TypeName a where\n  typeName         :: proxy a -> String\n  default typeName :: (Generic a, Rep a ~ gg, gg ~ D1 d f, Datatype d)\n                   => proxy a -> String\n  typeName _ = gtypeName $ from (undefined :: a)\n\ngtypeName :: Datatype d => D1 d f p -> String\ngtypeName = datatypeName\n\ndata T a = MkT a\n  deriving (Generic, TypeName)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TypeFamilies, StandaloneDeriving, GeneralizedNewtypeDeriving, UndecidableInstances #-}\nmodule T13297 where\n\nimport Data.Kind (Type)\n\nnewtype N p m a = N (((CT p) m) a)\nderiving instance (CT p ~ f, Functor (f m)) => Functor (N p m)\nderiving instance (CT p ~ f, Applicative (f m)) => Applicative (N p m) -- panic when this line added\n\nclass C p where\n    type CT p :: (Type -> Type) -> Type -> Type\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# Language ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n\n{-# OPTIONS -Wno-noncanonical-monoid-instances #-}\n\nmodule T13758 where\n\nimport Data.Coerce\nimport GHC.Generics\nimport Data.Semigroup\n\n-----\n\nclass Monoid' f where\n  mempty'  :: f x\n  mappend' :: f x -> f x -> f x\n\ninstance Monoid' U1 where\n  mempty' = U1\n  mappend' U1 U1 = U1\n\ninstance Monoid a => Monoid' (K1 i a) where\n  mempty' = K1 mempty\n  mappend' (K1 x) (K1 y) = K1 (x `mappend` y)\n\ninstance Monoid' f => Monoid' (M1 i c f) where\n  mempty' = M1 mempty'\n  mappend' (M1 x) (M1 y) = M1 (x `mappend'` y)\n\ninstance (Monoid' f, Monoid' h) => Monoid' (f :*: h) where\n  mempty' = mempty' :*: mempty'\n  mappend' (x1 :*: y1) (x2 :*: y2) = mappend' x1 x2 :*: mappend' y1 y2\n\nmemptydefault :: (Generic a, Monoid' (Rep a)) => a\nmemptydefault = to mempty'\n\nmappenddefault :: (Generic a, Monoid' (Rep a)) => a -> a -> a\nmappenddefault x y = to (mappend' (from x) (from y))\n\n-----\n\nnewtype GenericMonoid a = GenericMonoid a\n\ninstance (Generic a, Monoid' (Rep a)) => Semigroup (GenericMonoid a) where\n  (<>) = coerce (mappenddefault :: a -> a -> a)\n\ninstance (Generic a, Monoid' (Rep a)) => Monoid (GenericMonoid a) where\n  mempty  = coerce (memptydefault  :: a)\n  mappend = coerce (mappenddefault :: a -> a -> a)\n\ndata Urls = Urls String String String\n  deriving (Show, Generic)\n\nnewtype UrlsDeriv = UD (GenericMonoid Urls)\n  deriving (Semigroup, Monoid)\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T13813 where\n\nimport GHC.Exts (Constraint)\n\ntype C (a :: Constraint) b = a\n\ndata T a b = C (Show a) b => MkT b\nderiving instance Functor (T a)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# OPTIONS_GHC -Wunused-binds #-}\nmodule T13919 () where\n\nimport GHC.Generics\n\ndata Foo1 = Foo1 {bar1 :: String} deriving Show\ndata Foo2 = Foo2 {bar2 :: String} deriving Read\ndata Foo3 = Foo3 {bar3 :: String} deriving Generic\n\n-- Only this one should emit a \"Defined but not used\" warning for its\n-- record selector\ndata Foo4 = Foo4 {bar4 :: String} deriving Eq\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE GADTs #-}\n\nmodule T13998 where\n\nimport Data.Type.Equality\n\nclass EqForall f where\n  eqForall :: f a -> f a -> Bool\n\nclass EqForall f => EqForallPoly f where\n  eqForallPoly :: f a -> f b -> Bool\n  default eqForallPoly :: TestEquality f => f a -> f b -> Bool\n  eqForallPoly = defaultEqForallPoly\n\ndefaultEqForallPoly :: (TestEquality f, EqForall f) => f a -> f b -> Bool\ndefaultEqForallPoly x y = case testEquality x y of\n  Nothing -> False\n  Just Refl -> eqForall x y\n\n\ndata Atom = AtomInt | AtomString | AtomBool\n\ndata Value (a :: Atom) where\n  ValueInt :: Int -> Value 'AtomInt\n  ValueString :: String -> Value 'AtomString\n  ValueBool :: Bool -> Value 'AtomBool\n\ninstance TestEquality Value where\n  testEquality (ValueInt _) (ValueInt _) = Just Refl\n  testEquality (ValueString _) (ValueString _) = Just Refl\n  testEquality (ValueBool _) (ValueBool _) = Just Refl\n  testEquality _ _ = Nothing\n\ninstance EqForall Value where\n  eqForall (ValueInt a) (ValueInt b) = a == b\n  eqForall (ValueString a) (ValueString b) = a == b\n  eqForall (ValueBool a) (ValueBool b) = a == b\n\ninstance EqForallPoly Value\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, KindSignatures, GADTs, GeneralizedNewtypeDeriving #-}\n\nmodule T14045b where\n\nimport Data.Kind ( Type )\n\ndata family T a b :: Type\n\n-- newtype instance T Int d = MkT (IO d)\n\nnewtype instance T Int :: Type -> Type where\n   MkT :: IO d -> T Int d\n  deriving( Monad, Applicative, Functor )\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Bug where\n\nclass C a where\n  type T a\n  data D a\n  m :: a\n\ninstance C Int\nderiving instance C Bool\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE PolyKinds #-}\nmodule Bug where\n\nclass C p q\n\ndata D = D deriving (C (a :: k))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule Bug where\n\nimport GHC.TypeLits\n\nnewtype Baz = Baz Foo\n  deriving Bar\n\nnewtype Foo = Foo Int\n\nclass Bar a where\n  bar :: a\n\ninstance (TypeError (Text \"Boo\")) => Bar Foo where\n  bar = undefined\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\nmodule T14578 where\n\nimport Control.Applicative\nimport Data.Functor.Compose\nimport Data.Semigroup\n\nnewtype App f a = MkApp (f a)\n  deriving (Functor, Applicative)\n\ninstance (Applicative f, Semigroup a) => Semigroup (App f a) where\n  (<>) = liftA2 (<>)\n\nnewtype Wat f g a = MkWat (App (Compose f g) a)\n  deriving Semigroup\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T14579 where\n\nimport Data.Kind\nimport Data.Proxy\n\nnewtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)\n  deriving Eq\n\nnewtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a))\n  deriving Eq\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Bug where\n\nimport Data.Coerce\nimport Data.Kind\nimport Data.Proxy\n\nnewtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)\n  deriving Eq\n\nnewtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a))\n\ninstance Eq a => Eq (Glurp a) where\n  (==) = coerce @(Wat ('Proxy @a) -> Wat ('Proxy @a) -> Bool)\n                @(Glurp a         -> Glurp a         -> Bool)\n                (==)\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T14579b where\n\nimport Data.Kind\nimport Data.Proxy\n\n-- type P :: forall {k} {t :: k}. Proxy t\ntype P = 'Proxy\n\n-- type Wat :: forall a. Proxy a -> *\nnewtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)\n  deriving Eq\n\n-- type Wat2 :: forall {a}. Proxy a -> *\ntype Wat2 = Wat\n\n-- type Glurp :: * -> *\nnewtype Glurp a = MkGlurp (Wat2 (P :: Proxy a))\n  deriving Eq\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveLift #-}\nmodule T14682 where\n\nimport Data.Data\nimport Data.Ix\nimport Language.Haskell.TH.Syntax\n\ndata Foo = Foo Int Int\n  deriving (Show, Lift, Data, Eq, Ord, Ix)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE InstanceSigs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T14883 where\n\nimport Data.Coerce\nimport Data.Kind\n\ntype Representational1 m = (forall a b. Coercible a b => Coercible (m a) (m b) :: Constraint)\n\nclass Representational1 f => Functor' f where\n  fmap' :: (a -> b) -> f a -> f b\n\nclass Functor' f => Applicative' f where\n  pure'  :: a -> f a\n  (<*>@) :: f (a -> b) -> f a -> f b\n\nclass Functor' t => Traversable' t where\n  traverse' :: Applicative' f => (a -> f b) -> t a -> f (t b)\n\n-- Typechecks\nnewtype T1 m a = MkT1 (m a) deriving Functor'\nderiving instance Traversable' m => Traversable' (T1 m)\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14932 where\n\nimport Data.Kind (Constraint, Type)\n\nclass Zero a where\n zero :: a\n default zero :: (Code a ~ '[xs], All Zero xs) => a\n zero = undefined\n\ntype family All c xs :: Constraint where\n All c '[] = ()\n All c (x : xs) = (c x, All c xs)\n\ntype family Code (a :: Type) :: [[Type]]\ntype instance Code B1 = '[ '[ ] ]\n\ndata B1 = B1\n deriving Zero\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE DeriveAnyClass    #-}\n{-# LANGUAGE TypeFamilies      #-}\nmodule T14933 where\n\nimport Data.Kind (Type)\n\nclass Wrapped s where\n  type Unwrapped s :: Type\n\nclass Fork m where\n    fork :: (x, m)\n\n    default fork :: ( Wrapped m\n                    , Unwrapped m ~ t\n                    , Fork t\n                    ) => (x, m)\n    fork = undefined\n\nnewtype MyThing m = MyThing m\n    deriving Fork\n\ninstance Wrapped (MyThing m) where\n    type Unwrapped (MyThing m) = m\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-}\n\nmodule T15290c where\n\nimport Prelude hiding ( Monad(..) )\nimport Data.Coerce ( Coercible )\n\nclass Monad m where\n  (>>=) :: m a -> (a -> m b) -> m b\n  join  :: m (m a) -> m a\n\nnewtype StateT s m a = StateT { runStateT :: s -> m (s, a) }\n\ninstance Monad m => Monad (StateT s m) where\n  ma >>= fmb = StateT $ \\s -> runStateT ma s >>= \\(s1, a) -> runStateT (fmb a) s1\n  join ssa = StateT $ \\s -> runStateT ssa s >>= \\(s, sa) -> runStateT sa s\n\nnewtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a }\n\nderiving instance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q)) => Monad (IntStateT m)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T15290d where\n\nclass C a where\n  c :: Int -> forall b. b -> a\n\ninstance C Int where\n  c _ _ = 42\n\nnewtype Age = MkAge Int\n  deriving C\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\nmodule T15398 where\n\nnewtype Radius a = Radius a deriving (Eq, Ord)\n\ndata CourseLine\ndata OpenDistance\ndata EndOfSpeedSection\n\ndata Zone k a where\n    Point :: (Eq a, Ord a) => Zone CourseLine a\n    Vector :: (Eq a, Ord a) => Zone OpenDistance a\n    Conical :: (Eq a, Ord a) => Radius a -> Zone EndOfSpeedSection a\n\nderiving instance Eq a => Eq (Zone k a)\nderiving instance (Eq a, Ord a) => Ord (Zone k a)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE GeneralisedNewtypeDeriving #-}\nmodule T15637 where\n\nclass C a where f :: String\n\ninstance C () where f = \"foo\"\n\nnewtype T = T () deriving C\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass             #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule T16179 where\n\nclass C a\nnewtype T a = MkT a deriving C\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveLift #-}\nmodule T1830_2 where\n\nimport Language.Haskell.TH.Syntax (Lift)\n\ndata Nothing deriving Lift\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}\nmodule Foo( T ) where\n\n-- Trac 2378\n\nimport Data.Data\n\nnewtype T f = MkT Int\n\nderiving instance Typeable T\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE UndecidableInstances #-}\n-- Trac #2721\n\nmodule T2721 where\n\nclass C a where\n  type T a\n  foo :: a -> T a\n\ninstance C Int where\n  type T Int = Int\n  foo = id\n\nnewtype N = N Int deriving(C)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances #-}\n\n-- Test Trac #2856\n\nmodule T2856 where\n\nimport Data.Ratio\n\n----------------------\nclass C a where\n    data D a\n\ninstance C Bool where\n    newtype D Bool = DInt Int deriving (Eq, Show, Num)\n\ninstance C a => C [a] where\n    newtype D [a] = DList (Ratio a) deriving (Eq, Show, Num)\n\n----------------------\ndata family W a\nnewtype instance W Bool = WInt Int deriving( Eq, Show )\nnewtype instance W [a] = WList (Ratio a) deriving( Eq, Show )\n\nderiving instance Num (W Bool)\nderiving instance (Integral a, Num a) => Num (W [a])\n  -- Integral needed because superclass Eq needs it,\n  -- because of the stupid context on Ratio\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, StandaloneDeriving #-}\n\nmodule T3012 where\n\ndata T a where\n    Foo :: T Int\n    Bar :: T Bool\n\nderiving instance Show (T a)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DeriveFunctor #-}\nmodule T3057 where\n\nimport T3057A\n\nderiving instance Functor (MyType a)\n\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3057A where\n\ndata MyType a b = C1 a | C2 b\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, StandaloneDeriving, TypeOperators, UndecidableInstances #-}\nmodule T3965 where\n\nimport Data.Data\n\ndata T f e = Inl (f e) deriving (Data, Typeable, Eq)\n\nnewtype Expr f = In (f (Expr f)) deriving Typeable\n\nderiving instance (Typeable a, Data (a (Expr a))) => Data (Expr a)\n\ndata Var e = Var String deriving (Data, Eq, Typeable)\n\ndata Domain e g = Domain\n    (Expr (T Var))\n    deriving (Data, Typeable)\n\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}\nmodule T4220 where\n\nimport Data.Foldable\nimport Data.Traversable\n\ndata Void a deriving (Functor, Foldable, Traversable)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, EmptyDataDecls #-}  \nmodule T4302 where  \n\nimport Data.Ix\nimport Data.Typeable\nimport Data.Data\nimport Data.Foldable\nimport Data.Traversable\n\ndata Test a\n\nderiving instance Eq (Test a) \nderiving instance Ord (Test a) \nderiving instance Typeable Test\nderiving instance Data a => Data (Test a) \nderiving instance Functor Test \nderiving instance Foldable Test \nderiving instance Traversable Test  \n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\n\nmodule T4325 where\n\ndata Ord a => Heap a b = Empty | Node a b [Heap a b]\n    deriving Eq\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n\nmodule T4816 where\n\ndata Silly a = Silly a\n\ndata Baz o = Baz {\n     foo :: o,\n     bar :: Silly ()\n   } deriving (Functor)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, DeriveDataTypeable, StandaloneDeriving #-}\n\nmodule T4896 where\n\nimport Data.Data\nimport Data.Typeable\n\n--instance Typeable1 Bar where\n--  typeOf1 _ = mkTyConApp (mkTyCon \"Main.Bar\") []\nderiving instance Typeable Bar\n\nclass Foo a where\n  data Bar a\n\ndata D a b = D Int a deriving (Typeable, Data)\n\ninstance Foo (D a b) where\n  data Bar (D a b) = B { l :: a } deriving (Eq, Ord, Read, Show, Data)\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fno-warn-redundant-constraints #-}\n\n{-# LANGUAGE DatatypeContexts #-}\n{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule HTk.Toolkit.TreeList (getObjectFromTreeList) where\n\nclass Eq c => CItem c\n\n-- A bizarre instance decl!\n-- People who use instance decls like this are asking for trouble\ninstance {-# OVERLAPPABLE #-} GUIObject w => Eq w where\n  w1 == w2 = toGUIObject w1 == toGUIObject w2\n\ndata StateEntry a \n  = StateEntry (TreeListObject a) a -- Comment this 'a' out and it type checks\n  deriving Eq\n\n-- The delicate point about this test is that we want to \n-- infer a derived instance decl like this:\n--    instance (CItem a, Eq a) => Eq (StateEntry a)\n-- But note the instance decl for (Eq w) for any w!\n-- There's a danger than we'll use that instance decl\n-- to get the derived instance\n--    instance (CItem a, GUIObject a) => Eq (StateEntry a)\n-- And then that doesn't work subsequently\n\ngetObjectFromTreeList :: CItem a => StateEntry a -> Bool  \ngetObjectFromTreeList state = state == state\n\ndata CItem a => TreeListObject a\n\ninstance {-# OVERLAPPING #-} CItem a => Eq (TreeListObject a)\n\nclass GUIObject w where\n  toGUIObject     :: w -> GUIOBJECT\n\n\ndata GUIOBJECT\n\ninstance Eq GUIOBJECT where\n  (==) = undefined\n  (/=) = undefined\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T5939 where\n\nimport GHC.Generics\n\ndata T a = T a\nderiving instance Generic (T Bool)\n\ndata family TFam a b c\ndata instance TFam Int b c\nderiving instance Generic (TFam Int Bool c)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n\nmodule T6031 where\n\nimport T6031a\n\nderiving instance Show Empty\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6031a where\n\ndata Empty\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, GeneralizedNewtypeDeriving #-}\n\nmodule T7269 where\n\nclass C (a :: k)\n\ninstance C Int\n\nnewtype MyInt = MyInt Int deriving C\n\nnewtype YourInt = YourInt Int\nderiving instance C YourInt\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds          #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\nmodule T7704 where\n\nimport Data.Typeable\n\ndata A1 = A1 deriving Typeable\ndata A2 = A2\nderiving instance Typeable A2\n\ndata B1 a = B1 deriving Typeable\ndata B2 a = B2\nderiving instance Typeable B2\n\ndata C1 a = C1 deriving Typeable\ndata C2 a = C2\nderiving instance Typeable C2\n\ndata D1 f = D1 (f (D1 f)) deriving Typeable\ndata D2 f = D2 (f (D2 f))\nderiving instance Typeable D2\n\ndata E1 (a :: k) f = E1 (f Int) deriving Typeable\ndata E2 (a :: k) f = E2 (f Int)\nderiving instance Typeable E2\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T7710 where\n\nimport Data.Typeable\n\n\ntype T = Int\ntype family F a\ntype instance F Int = Int\ndata family D a\ndata instance D Int = DInt\ndata instance D Float = DFloat\n\ntest = [ typeRep ([] :: [T])\n       , typeRep ([] :: [F Int])\n       , typeRep (Proxy :: Proxy D)\n       , typeRep ([] :: [D Int]) ]\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\nmodule T7947 where\n\nimport Data.Data\nimport Data.Typeable\n\nimport T7947a\nimport qualified T7947b as B\n\nderiving instance Typeable A\nderiving instance Typeable B.B\n\nderiving instance Data A\nderiving instance Data B.B\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7947a where\n\ndata A = C1 | C2 | C\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7947b where\n\ndata B = D1 | D2 | C\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, GADTs, FlexibleInstances #-}\n\nmodule T8128 where\n\ndata T a where\n  MkT1 :: T Int\n  MkT2 :: Bool -> T Bool\n\nderiving instance Show (T Int)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Main where\n\nimport Control.Monad.ST\nimport Data.Primitive\n\nmain :: IO ()\nmain = do\n    let xs :: [Float] = runST $ do\n        barr <- mutableByteArrayFromList [1..fromIntegral n::Float]\n        peekByteArray n barr\n    print xs\n  where\n    n = 13\n\nmutableByteArrayFromList :: forall s a . (Prim a)\n                         => [a]\n                         -> ST s (MutableByteArray s)\nmutableByteArrayFromList xs = do\n    arr <- newByteArray (length xs*sizeOf (undefined :: a))\n    loop arr 0 xs\n    return arr\n  where\n    loop :: MutableByteArray s -> Int -> [a] -> ST s ()\n    loop _ _ [] = return ()\n\n    loop arr i (x : xs) = do\n        writeByteArray arr i x\n        loop arr (i+1) xs\n\npeekByteArray :: (Prim a)\n              => Int\n              -> MutableByteArray s\n              -> ST s [a]\npeekByteArray n arr =\n    loop 0 arr\n  where\n    loop :: (Prim a)\n         => Int\n         -> MutableByteArray s\n         -> ST s [a]\n    loop i _ | i >= n = return []\n\n    loop i arr = do\n        x  <- readByteArray arr i\n        xs <- loop (i+1) arr\n        return (x : xs)\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T8165 where\n\nimport Data.Kind (Type)\n\n-----------------------------------------------------------\n\nclass C a where\n    type T a\n\ninstance C Int where\n    type T Int = Bool\n\nnewtype NT = NT Int\n    deriving C\n\n-----------------------------------------------------------\n\nclass D a where\n  type U a\n\ninstance D Int where\n  type U Int = Int\n\nnewtype E = MkE Int\n  deriving D\n\n-----------------------------------------------------------\n\nclass C2 a b where\n  type F b c a :: Type\n  type G b (d :: Type -> Type) :: Type -> Type\n\ninstance C2 a y => C2 a (Either x y) where\n  type F (Either x y) c a = F y c a\n  type G (Either x y) d   = G y d\n\nnewtype N a = MkN (Either Int a)\n  deriving (C2 x)\n\n-----------------------------------------------------------\n\nclass HasRing a where\n    type Ring a\n\nnewtype L2Norm a = L2Norm a\n    deriving HasRing\n\nnewtype L1Norm a = L1Norm a\n    deriving HasRing\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RankNTypes #-}\n \nmodule T8631 where\n \nimport Control.Monad.Trans.Cont\nimport Control.Monad.Trans.State.Lazy\n \nnewtype AnyContT m a = AnyContT { unAnyContT :: forall r . ContT r m a }\n \nclass MonadAnyCont b m where\n  anyContToM :: (forall r . (a -> b r) -> b r) -> m a\n \ninstance MonadAnyCont b (AnyContT m) where\n  anyContToM _ = error \"foo\"\n \ndata DecodeState = DecodeState\n \nnewtype DecodeAST a = DecodeAST { unDecodeAST :: AnyContT (StateT DecodeState IO) a }\n  deriving (MonadAnyCont IO)", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, DeriveFunctor, FlexibleInstances, GADTs, KindSignatures, StandaloneDeriving #-}\nmodule T8678 where\n\nimport Data.Kind (Type)\n\ndata {- kind -} Nat = Z | S Nat\n\n-- GADT in parameter other than the last\ndata NonStandard :: Nat -> Type -> Type -> Type where\n    Standard :: a -> NonStandard (S n) a b\n    Non :: NonStandard n a b -> b -> NonStandard (S n) a b\n\nderiving instance (Show a, Show b) => Show (NonStandard n a b)\nderiving instance Functor (NonStandard n a)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T8740 where\n\ndata Abstract\ndata Reified\ndata Player\n\ndata Elect p a where\n    ElectRefAsTypeOf :: Int -> Elect Abstract a -> Elect Abstract a\n    ElectHandle :: a -> Elect Reified a\n    Controller :: Elect Abstract Player\n    Owner :: Elect Abstract Player\n    You :: Elect Abstract Player\n\nderiving instance (Eq a) => Eq (Elect p a)\nderiving instance (Ord a) => Ord (Elect p a)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T8758 where\n\nclass C m where\n  foo :: (forall b. b -> m b) -> c -> m c\n\ninstance C [] where\n  foo f c = f c", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule T8758a where\n\nimport T8758\n\nnewtype MyList a = Mk [a]\n  deriving C", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule T8865 where\nimport Control.Category\n\ninstance Category Either where\n  id  = error \"urk1\"\n  (.) = error \"urk2\"\n\nnewtype T a b = MkT (Either a b) deriving( Category )\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# Language DeriveFunctor #-}\n{-# Language PolyKinds #-}\n\nmodule T8893 where\n\ndata V a = V [a] deriving Functor\n\ndata C x a = C (V (P x a)) deriving Functor\n\ndata P x a = P (x a) deriving Functor\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, StandaloneDeriving #-}\n\nmodule T8950 where\n\nimport Data.Typeable\n\ndata Foo = Bar\n  deriving (Eq)\n\ndata Baz = Quux\n\nderiving instance Typeable Baz  -- shouldn't error\nderiving instance Typeable Quux\n\nrep1 = typeRep (Proxy :: Proxy Bool)\nrep2 = typeRep (Proxy :: Proxy 'True)\nrep3 = typeRep (Proxy :: Proxy Foo)\nrep4 = typeRep (Proxy :: Proxy Bar)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}\n\nmodule T8963 where\n\nclass C c where\n   data F c r\n\ninstance C Int where\n   newtype F Int r = F (IO r) deriving (Functor)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveTraversable #-}\n\nmodule T9069 where\n\nimport Data.Foldable\nimport Data.Traversable\n\ndata Trivial a = Trivial a\n   deriving (Functor,Foldable,Traversable)", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language GADTs, PolyKinds, TypeFamilies, DataKinds #-}\nmodule Fam where\n\nimport Data.Kind (Type)\n\ndata Cmp a where\n Sup ::      Cmp a\n V   :: a -> Cmp a\n deriving (Show, Eq)\n\ndata family   CmpInterval (a :: Cmp k) (b :: Cmp k) :: Type\ndata instance CmpInterval (V c)         Sup          = Starting c\n  deriving( Show )\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses #-}\n\nmodule T9968 where\n\nclass C a b\ndata X = X deriving (C Int)\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n\nmodule T9968 where\n\nimport Data.Bifunctor\n\ndata Blah a b = A a | B b\n  deriving (Bifunctor)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule DerivingViaFail where\n\nimport Control.Category\nimport Data.Functor.Identity\n\nnewtype Foo1 a = Foo1 a deriving Show via (Identity b)\n\nnewtype Foo2 a b = Foo2 (a -> b)\n  deriving Category\n    via fooo\n\ndata Foo3 deriving Eq via (forall a. a)\n\nnewtype Foo4 a = Foo4 a\nderiving via (Identity b)\n  instance Show (Foo4 a)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule DerivingViaFail2 where\n\nclass C a\ndata A = A\nderiving via Maybe instance C A\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DerivingViaFail3 where\n\ndata F deriving Eq via F\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule DerivingViaFail4 where\n\nclass C a b where\n  c :: a -> b -> Bool\n\ninstance C a a where\n  c _ _ = True\n\nnewtype F1 = F1 Int\n  deriving Eq via Char\n\nnewtype F2 a = MkF2 a\n  deriving (C a) via (forall a. a)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}\nmodule ShouldFail where\n\nimport Data.Foldable\nimport Data.Traversable\n\n-- Derive Traversable without Functor\ndata Trivial1 a = Trivial1 a\n   deriving (Foldable,Traversable)\n\n-- Derive Traversable without Foldable\ndata Trivial2 a = Trivial2 a\n   deriving (Functor,Traversable)\n\n-- Foldable with function type\ndata Infinite a = Infinite (Int -> a)\n   deriving (Functor,Foldable)\n\n-- Foldable with function type\ndata Cont r a = Cont ((a -> r) -> r)\n   deriving (Functor,Traversable)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- Derive Functor without a DeriveFunctor language pragma\n\ndata List a = Nil | Cons a (List a)\n    deriving Functor\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, DatatypeContexts #-}\nmodule ShouldFail where\n\n-- Derive Functor on a type that uses 'a' in the wrong places\n\nnewtype InFunctionArgument a = InFunctionArgument (a -> Int)\n   deriving (Functor)\n\nnewtype OnSecondArg a = OnSecondArg (Either a a)\n   deriving (Functor)\n\n-- Derive Functor on a type with no arguments\n\nnewtype NoArguments = NoArguments Int\n   deriving (Functor)\n\n-- Derive Functor on a type with extra stupid-constraints on 'a'\n\ndata Eq a => StupidConstraint a = StupidType a\n   deriving (Functor)\n\n-- A missing Functor instance\n\ndata NoFunctor a = NoFunctor\ndata UseNoFunctor a = UseNoFunctor (NoFunctor a)\n   deriving (Functor)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-  From: Ian Bayley\n    Sent: Tuesday, June 29, 1999 3:39 PM\n    To: hugs-bugs@haskell.org\n    Subject: Show for higher-order nested datatypes\n\n\n    Is \"deriving Show\" meant to work for higher-order nested datatypes ?\n    Hugs hangs when loading in the following file:\n-}\n\nmodule Foo where\n\ntype SqMat a = SM Nil a\n\ndata SM f a = ZeroS (f (f a)) | SuccS (SM (Cons f) a)\n                       deriving Show\n\n-- Show (f (f a)), Show (SM (Cons f) a) => Show (SM f a)\n\ndata Nil a = MkNil deriving Show\n\ndata Cons f a = MkCons a (f a)\n                       deriving Show\n\n\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- The Show instance for S would have form\n--      instance X T c => Show S\n-- which is hard to deal with.  It sent GHC 5.01 into\n-- an infinite loop; now it should be rejected.\n\nmodule ShouldFail where\n\ndata T = T Integer\n\nclass X a b | a -> b where\n    f :: a -> b\n\ninstance X T c => Show T where\n    show _ = \"\"\n\ndata S = S T deriving Show\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n-- Made GHC 5.02.2 go into a loop when doing the\n-- context inference for deriving.  It only happened with\n-- the -fglasgow-exts flag (it didn't diverge without),\n-- so hopefully FlexibleContexts is the relevant extension.\n\nmodule ShouldFail where\n\ndata Empty a = E\nnewtype Id a = I a\nnewtype Pair v w a = P ((v a), (w a))\ntype Square a = Square_ Empty Id a\ndata Square_ v w a =\n        End (v (v a))\n      | Zero (Square_ v (Pair w w) a)\n      | One (Square_ (Pair v w) (Pair w w) a) deriving Show\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! deriving Ord without deriving Eq\n--\nmodule ShouldFail where\n\ndata Foo a b\n  = C1 a Int\n  | C2 b Double\n  deriving Ord\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\ndata Test a = T a \n  deriving( Show a, Read )\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\n-- Testing the newtype-deriving stuff\n\nmodule ShouldFail where\n\nimport Control.Monad.State\n\nnewtype T a = T (StateT Int IO a) deriving( MonadState )\n        -- Here MonadState takes two type params,\n        -- but exactly one is needed.\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! buggy deriving with function type, reported by Sigbjorn Finne\nmodule ShouldFail where\n\ndata Foo = Foo (Int -> Int) deriving Eq\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Should fail without GeneralizedNewtypeDeriving\n-- Succeeds with GeneralizedNewtypeDeriving\n\nmodule ShouldFail where\n\nimport Control.Monad.State\n\ndata S = S Int\n\nnewtype M a = M (StateT S IO a) deriving( Monad )\n\n\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}\n\n-- Various newtype-deriving failures\n\nmodule ShouldFail where\n\n\nclass C a b\n\nnewtype T1 = T1 Int deriving( C )\n        -- Wrong arity\n\nnewtype T2 = T2 Int deriving( Monad )\n        -- Type constructor has wrong kind\n\nnewtype T3 a = T3 Int deriving( Monad )\n        -- Rep type has wrong kind\n\nnewtype T4 a = T4 (Either a a) deriving( Monad )\n        -- Eta fails\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n\nmodule ShouldFail where\n\ndata T a = T1 a | T2\n\n-- This fails as we need an (Eq a) context\nderiving instance Eq (T a)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #1608\n\nmodule ShouldFail where\n\nnewtype Ego a = Ego a deriving (Ord)\n\nf :: Ord a => Ego a -> Ego a -> Bool\nf e1 e2 = e1 < e2\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test for trac #1588: unrequested generalized newtype deriving?\n\nnewtype MaybeT  m a = MaybeT  { runMaybeT  :: m (Maybe a) } deriving Eq\n\ndata    MaybeT' m a = MaybeT' { runMaybeT' :: m (Maybe a) } deriving Eq\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XStandaloneDeriving #-}\n\nmodule ShouldFail where\n\nimport System.IO( Handle )\n\n\n-- T is a synonym\ntype T = Int\nderiving instance Eq T\n\n-- Handle is abstract\nderiving instance Eq Handle\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\nmodule T10598_fail1 where\n\nclass Z f where\n  z :: f a b\n\ndata    A     = A Int deriving newtype Show\nnewtype B     = B Int deriving stock   Num\ndata    C a b = C Int deriving anyclass Z\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingStrategies #-}\nmodule T10598_fail2 where\n\ndata    A = A Int deriving anyclass Eq\nnewtype B = B Int deriving newtype  Eq\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE Safe #-}\nmodule T10598_fail3 where\n\nimport GHC.Generics\n\ndata T = MkT Int deriving anyclass Generic\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10598_fail4 where\n\ndata Bar = Bar\n  deriving stock Eq\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10598_fail5 where\n\ndata Foo = Foo\n  deriving Eq\n  deriving Ord\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\nmodule T10598_fail6 where\n\nnewtype F x = F ([x], Maybe x) deriving Functor\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nimport GHC.Generics\ndata A = A deriving (Show, Generic)\ndata B = B A deriving (Show)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T1133A where\n\nimport T1133Aa\n\nnewtype X = X Int deriving Enum\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T1133Aa where\n\nimport {-# SOURCE #-} T1133A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds            #-}\n{-# LANGUAGE FlexibleInstances          #-}\n{-# LANGUAGE GADTs                      #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE KindSignatures             #-}\n{-# LANGUAGE ScopedTypeVariables        #-}\n{-# LANGUAGE StandaloneDeriving         #-}\n{-# LANGUAGE StaticPointers             #-}\n{-# LANGUAGE UndecidableInstances       #-}\n{-# LANGUAGE UndecidableSuperClasses    #-}\nmodule T11509 where\n\nimport Data.Kind\nimport Data.Typeable\nimport GHC.StaticPtr\n\n{-------------------------------------------------------------------------------\n  Standard Cloud-Haskell-like infrastructure\n\n  See <https://ghc.haskell.org/trac/ghc/wiki/TypeableT> for a dicussion of 'SC'.\n-------------------------------------------------------------------------------}\n\nclass Serializable a -- empty class, just for demonstration purposes\n\ninstance Serializable a => Serializable [a]\n\ndata Static :: * -> * where\n  StaticPtr :: StaticPtr a -> Static a\n  StaticApp :: Static (a -> b) -> Static a -> Static b\n\nstaticApp :: StaticPtr (a -> b) -> Static a -> Static b\nstaticApp = StaticApp .  StaticPtr\n\ndata Dict :: Constraint -> * where\n  Dict :: c => Dict c\n\nclass c => SC c where\n  dict :: Static (Dict c)\n\ninstance (Typeable a, SC (Serializable a)) => SC (Serializable [a]) where\n  dict = aux `staticApp` dict\n    where\n      aux :: StaticPtr (Dict (Serializable a) -> Dict (Serializable [a]))\n      aux = static (\\Dict -> Dict)\n\n{-------------------------------------------------------------------------------\n  Demonstrate the bug\n-------------------------------------------------------------------------------}\n\nnewtype MyList a = MyList [a]\n\nderiving instance (Typeable a, SC (Serializable a)) => SC (Serializable (MyList a))\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE DeriveFunctor #-}\n {-# LANGUAGE GADTs #-}\n\nmodule T12163 where\n\ndata T a b where\n     Mk :: Int -> b -> T Int b\n     deriving (Functor)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE UnboxedSums #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T12512 where\n\nimport GHC.Exts\n\nclass Wat1 (a :: TYPE ('TupleRep ['LiftedRep, 'LiftedRep]))\nderiving instance Wat1 (# a, b #)\n\nclass Wat2 (a :: TYPE ('SumRep ['LiftedRep, 'LiftedRep]))\nderiving instance Wat2 (# a | b #)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data Container\n  = Container [Wibble Int]\n  deriving (Eq, Show)\n\ndata Wibble a\n  = Wibble a\n  | Wobble\n  deriving (Eq, Functor, Show)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14365A where\n\nimport {-# SOURCE #-} T14365B\n\nmain = return ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14365B where\n\ndata Foo a = Foo a\n  deriving (Functor)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T14728a where\n\nimport Data.Functor.Identity\nimport Data.Kind\n\nclass C (a :: Type) where\n  type T a (x :: a) :: Type\n  type U z :: a\n\ninstance C () where\n  type T () '() = Bool\n\nderiving instance C (Identity a)\n\nf :: T (Identity ()) ('Identity '())\nf = True\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T14728b where\n\nimport Data.Functor.Identity\nimport Data.Kind\n\nclass C (a :: Type) where\n  type U z :: a\n\ninstance C () where\n  type U z = '()\n\nderiving instance C (Identity a)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\nmodule T14916 where\n\nimport Data.Coerce\nimport Data.Typeable\n\ndata A = MkA deriving ((~) A)\ndata B = MkB deriving (Coercible B)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}\n\nmodule T1496 where\n\ndata family Z :: * -> *\n\nnewtype instance Z Int = ZI Double\nnewtype instance Z Moo = ZM (Int,Int)\n\nnewtype Moo = Moo Int deriving(IsInt)\nclass IsInt t where\n    isInt :: c Int -> c t\n\ninstance IsInt Int where isInt = id\n\nmain = case isInt (ZI 4.0) of ZM tu -> print tu", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T15073 where\n\nimport T15073a\n\nnewtype Foo a = MkFoo a\n  deriving P\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\nmodule T15073a where\n\nclass P a where\n  p :: a -> (# a #)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T1830_1 where\n\nimport Language.Haskell.TH.Syntax (Lift)\n\ndata Foo a = Foo a deriving Lift\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XDeriveDataTypeable -XStandaloneDeriving #-}\n\n-- Test Trac #2394\n\nmodule Foo where\n\nimport Data.Data(Data)\n\nderiving instance (Data a,Data b) => Data (a->b)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, DeriveDataTypeable #-}\nmodule T2700 where\n\nimport GHC.Prim\n\nimport Data.Data\nimport Data.Typeable\n\ndata Foo = MkFoo Int#\n           deriving (Typeable, Data)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-- Test Trac #2851\n\nmodule T2851 where\n\ntype family F a :: *\n\ndata D a = D (F a)\n    deriving (Show)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE RankNTypes #-}\n\nmodule T3101 where\n\ntype family F a :: *\n\ndata Boom = Boom (forall a. a -> F a)\n  deriving Show\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, FlexibleContexts, UndecidableInstances, StandaloneDeriving #-}\nmodule T3621 where\n\n-- This one is ok, even though the deriving clause mentions 'a'\n-- which is not a parameter of 'T'\nclass C a b\ninstance C a S\ndata S = MkS\n\nnewtype T = MkT S deriving( C a )\n\n\n-- But this one fails, and should fail\nclass (Monad m) => MonadState s m | m -> s where\n  state :: (s -> (a, s)) -> m a\n\nnewtype State s a = State { runState :: s -> (a, s) }\ninstance Functor (State s) where {}\ninstance Applicative (State s) where {}\ninstance Monad (State s) where {}\ninstance MonadState s (State s) where {}\n\nnewtype WrappedState s a = WS { runWS :: State s a }\n   deriving (Functor, Applicative, Monad, MonadState state)\n--   deriving (Monad)\n\nderiving instance (MonadState state (State s))\n      => MonadState state (WrappedState s)\n\n-- ASSERT error\n-- deriving instance (MonadState state (State s), Monad (WrappedState s))\n--      => MonadState s (WrappedState s)\n\n\n-- We try\n--   instance MonadState state (State state a)\n--         => MonadState state (WrappedState state a)\n--\n-- Superclass needs (Monad (WrappedState state a))\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE StandaloneDeriving #-}\n-- {-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nimport Data.Monoid\n\nnewtype DecodeMap e = DecodeMap [e]\n\nderiving instance Monoid (DecodeMap e)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE StandaloneDeriving #-}\n\nclass C a\ninstance C Int\n\nnewtype T = T Int\nderiving instance C T\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T4083 where\n\ndata family F a\nnewtype instance F [a] = Maybe a\n\nclass C a where\n  data D a\n\nderiving instance C (Maybe a) => C (F [a])\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, StandaloneDeriving #-}\n\nmodule T4528 where\n\ndata Foo a where\n   A, B :: Foo Int\n   C :: Foo Bool\n\nderiving instance Enum (Foo a)\nderiving instance Bounded (Foo a)\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables, StandaloneDeriving, GADTs, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}\n\nmodule Main where\n\nimport Data.Typeable\n\ndata Expr a where\n    Lit :: Typeable a => a -> Expr a\n\nclass A a where\n    mk :: a\n\nclass (Typeable a, A a) => B a where\n    mkExpr :: Expr a\n    mkExpr = Lit mk\n\n-- dfunAE\ninstance B a => A (Expr a) where\n    mk = mkExpr\n\n-- dfunAB\ninstance A Bool where\n    mk = True\n\nnewtype BOOL = BOOL Bool\n  deriving (Typeable, A)\n\ninstance B Bool\nderiving instance B BOOL   --dfunBB\n\nshowType :: forall a . Expr a -> String\nshowType (Lit _) = show (typeOf (undefined :: a))\n\ntest1 = showType (mk     :: Expr BOOL) -- Prints \"Bool\" (wrong?)\ntest2 = showType (Lit mk :: Expr BOOL) -- Prints \"Main.BOOL\" (correct)\n\nmain = do { print test1; print test2 }\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}\nmodule Bug where\nclass A a oops\ndata D d = D d\n\ninstance A a oops => Read (D a)\n-- Actually this instance is ambiguous \n-- and is now rightly rejected\n\ndata E e = E (D e) deriving Read\n\ninstance A Int Bool\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T5478 where\n\nimport GHC.Exts\n\ndata Foo = Foo0 ByteArray#  deriving Show\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n-- | We use newtype to create an isomorphic type to Int\n-- with a reversed Ord dictionary. We now use the MinList\n-- API of MinList to create a new MinList. Then we use newtype\n-- deriving to convert the newtype MinList to an Int\n-- MinList. This final result breaks the invariants of\n-- MinList which shouldn't be possible with the exposed\n-- API of MinList.\nmodule T5498 where\n\ndata MinList a = MinList a [a]\n\nnewMinList :: Ord a => a -> MinList a\nnewMinList n = MinList n []\n\ninsertMinList :: Ord a => MinList a -> a -> MinList a\ninsertMinList s@(MinList m xs) n | n > m     = MinList m (n:xs)\n                                 | otherwise = s\n\nprintIntMinList :: MinList Int -> IO ()\nprintIntMinList (MinList min xs)\n  = putStrLn $ \"MinList Int :: MinList \" ++ show min ++ \" \" ++ show xs\n\nclass IntIso t where\n    intIso :: c t -> c Int\n\ninstance IntIso Int where\n    intIso = id\n\nnewtype Down a = Down a deriving (Eq, IntIso)\n\ninstance Ord a => Ord (Down a) where\n    compare (Down a) (Down b) = compare b a\n\nfine :: MinList (Down Int)\nfine = foldl (\\x y -> insertMinList x $ Down y)\n             (newMinList $ Down 0) [-1,-2,-3,-4,1,2,3,4]\n\nbad :: MinList Int\nbad = intIso fine\n\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DeriveFunctor #-}\nmodule T5686 where\n\ndata U a = U (G a) deriving Functor\n\nclass A a where\n   type G a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5922 where\n\ndata Proposition = Proposition deriving (show)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}\nmodule T6147 where\n\ndata family T a\ndata instance T Int = T_Int Int\n\nclass C a where\n  foo :: a -> T a\n\ninstance C Int where\n  foo = T_Int\n\nnewtype Foo = Foo Int deriving(C)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving, GADTs #-}\n\nmodule T7148 where\n\ndata SameType a b where\n  Refl :: SameType a a\n \ncoerce :: SameType a b -> a -> b\ncoerce Refl = id\n \ntrans :: SameType a b -> SameType b c -> SameType a c\ntrans Refl Refl = Refl\n \nsameUnit :: SameType () ()\nsameUnit = Refl\n\n\nclass IsoUnit a where\n  iso1 :: SameType () b -> SameType a b\n  iso2 :: SameType b () -> SameType b a\n \ninstance IsoUnit () where\n  iso1 = id\n  iso2 = id\n\n\nnewtype Tagged a b = Tagged b deriving IsoUnit\n\nsameTagged :: SameType (Tagged a b) (Tagged a' b') -> SameType a a'\nsameTagged Refl = Refl\n \nunsafe' :: SameType (Tagged a ()) (Tagged a' ())\nunsafe' = (iso1 sameUnit) `trans` (iso2 sameUnit)\n \nunsafe :: SameType a b\nunsafe = sameTagged unsafe'\n \n--once again inferred type is a -> b\nunsafeCoerce = coerce unsafe", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ScopedTypeVariables,\n             GeneralizedNewtypeDeriving #-}\n\nmodule T7148a where\n\nimport Control.Monad.ST\ndata Proxy a = Proxy\ntype family Result a b\n \nclass Convert a where\n  coerce :: Proxy b -> a -> Result a b\n \nnewtype SAFE a = SAFE a\ntype instance Result (SAFE a) b = a\n \ninstance Convert (SAFE a) where\n  coerce _ (SAFE a) = a\n\nnewtype IS_NO_LONGER a = IS_NO_LONGER a deriving Convert\ntype instance Result (IS_NO_LONGER a) b = b\n\n--infered type is \nunsafeCoerce :: forall a b. a -> b\nunsafeCoerce = coerce (Proxy :: Proxy b) . IS_NO_LONGER . SAFE\n\n--use it safely\nid' :: a -> a\nid' = unsafeCoerce\n \n--segfault (with high probability)\ncrash :: segfault \ncrash = unsafeCoerce . tail . tail . tail . unsafeCoerce $ True\n\n\n--time for side effects\nunsafePerformIO :: IO a -> a\nunsafePerformIO x = runST $ unsafeCoerce x", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7401_fail where\n\ndata D deriving Eq\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving #-}\nmodule T7959 where\n\nclass A\nderiving instance A\ndata B deriving A\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T8165_fail where\n\nimport Data.Kind\n\nclass C (a :: k) where\n  type T k :: Type\n\ninstance C Int where\n  type T Type = Int\n\nnewtype MyInt = MyInt Int\n  deriving C\n\n-----------------------------------------------------------\n\nclass D a where\n  type S a = r | r -> a\n\ninstance D Int where\n  type S Int = Char\n\nnewtype WrappedInt = WrapInt Int\n  deriving D\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T8165_fail2 where\n\nclass C a where\n  type T a\n\nnewtype Loop = MkLoop Loop\n  deriving C\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving, ConstrainedClassMethods #-}\n\nmodule T8851 where\n\nimport Control.Applicative\n\nclass Parsing m where\n  notFollowedBy :: (Monad m, Show a) => m a -> m ()\n\ndata Parser a\ninstance Parsing Parser where\n  notFollowedBy = undefined\n\ninstance Functor Parser where\n  fmap = undefined\ninstance Applicative Parser where\n  pure = undefined\n  (<*>) = undefined\ninstance Monad Parser where\n  return = undefined\n  (>>=) = undefined\n\nnewtype MyParser a = MkMP (Parser a)\n  deriving Parsing", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving #-}\nmodule T8984 where\n\nclass C a where\n    app :: a (a Int)\n\nnewtype N cat a b = MkN (cat a b)  deriving( C )\n-- The newtype coercion is   N cat ~R cat\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\nmodule T9071_2 where\n\nnewtype Mu f = Mu (f (Mu f))\n\nnewtype K1 a b = K1 a\nnewtype F1 a = F1 (Mu (K1 a)) deriving Functor\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\nmodule T9071 where\n\nimport T9071a\n\nnewtype K a b = K a\nnewtype F a = F (Mu (K a)) deriving Functor\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9071a where\n\nnewtype Mu f = Mu (f (Mu f))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\nmodule T9071_2 where\n\nnewtype Mu f = Mu (f (Mu f))\n\nnewtype K1 a b = K1 a\nnewtype F1 a = F1 (Mu (K1 a)) deriving Functor\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nimport Control.Applicative\n\nnewtype Foo a = Foo (a -> a) deriving Applicative\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Applicative\n\nnewtype Foo a = Foo (a -> a) deriving Applicative\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9687 where\nimport Data.Typeable\n\ninstance Typeable (a,b,c,d,e,f,g,h)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}\n\nmodule Main where\n\nimport Prelude hiding (sum)\nimport Data.Foldable\n\n-- Derive Foldable for a simple data type\n\ndata List a = Nil | Cons a (List a)\n    deriving (Functor,Foldable,Show)\n\nsomeList = Cons 1 (Cons 1 (Cons 2 (Cons 3 Nil)))\n\nmain = print (sum someList)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n\nmodule Main where\n\n-- Derive functor for a simple data type\n\ndata List a = Nil | Cons a (List a)\n    deriving (Functor,Show)\n\nsomeList   = Cons 1 (Cons 1 (Cons 2 (Cons 3 Nil)))\ndoubleList = fmap (*2) someList\n\ntest1 = do\n    putStr \"normal:  \" >> print someList\n    putStr \"double:  \" >> print doubleList\n\n-- Derive functor for a data type with functions and tuples\n\ndata ReaderWriter r w a = RW { runRW :: r -> (a,w) }\n    deriving (Functor)\n\ndata Cont r a = Cont { runCont :: (a -> r) -> r }\n    deriving (Functor)\n\ntest2 = do\n    let rw = RW (\\r -> (\"something\",r*3))\n    putStr \"normal:  \" >> print (runRW rw 123)\n    putStr \"reverse: \" >> print (runRW (fmap reverse rw) 456)\n    let five = Cont ($ 5)\n    putStr \"normal:  \" >> runCont five print\n    putStr \"double:  \" >> runCont (fmap (*2) five) print\n\n-- Derive functor in such a way that we need a constraint\n\nnewtype Compose f g a = Compose (f (g a))\n    deriving (Functor,Show)\n\nlistOfLists = Compose [[1,2,3],[7,8,9]]\n\ntest3 = do\n    putStr \"normal:  \" >> print listOfLists\n    putStr \"double:  \" >> print (fmap (*2) listOfLists)\n\n-- All tests\n\nmain = do\n    test1\n    test2\n    test3\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test newtype derived instances\n\nnewtype Age = MkAge Int deriving (Eq, Show)\n\ninstance Num Age where\n  (+) (MkAge a) (MkAge b) = MkAge (a+b)\n  (*)         = undefined\n  negate      = undefined\n  abs         = undefined\n  signum      = undefined\n  fromInteger = undefined\n\nmain = print (MkAge 3 + MkAge 5)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Deriving Show/Read for type with labelled fields.\n--     (based on a Hugs bug report.)\nmodule Main(main) where\n\ndata Options = \n   Options { s :: OptionKind } \n   deriving (Show, Read)\n\ndata OptionKind = \n   SpecialOptions { test :: Int }\n   deriving (Show, Read)\n\nx = Options{s=SpecialOptions{test=42}}\n\nmain = do\n  print x\n  print ((read (show x))::Options)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Deriving Show/Read for nullary constructors.\nmodule Main(main) where\n\ndata A = B | C deriving ( Show, Read )\n\ndata Opt = N | Y A deriving (Show, Read)\n\nx = Y B\n\n{-\n If the Haskell report's specification of how Show instances\n are to be derived is followed to the letter, the code for\n a nullary constructor would put parens around the constructor\n when (showsPrec 10) is used. This would cause\n\n      Y A\n\n to be showed as\n \n      Y (A)\n\n Overkill, so ghc's derived Show code treats nullary\n constructors specially.\n-}\n\nmain = do\n  print x\n  print ((read (show x))::Opt)\n  print ((read \"Y (B)\")::Opt)\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata Hash = Hash{ (#) :: Int }\n deriving (Show, Read)\n\nmain =\n  do print s\n     print (read s :: Hash)\n where\n  s = show (Hash 3)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n{-\n  If a fixity declaration hasn't been supplied for\n  an operator, it is defaulted to being \"infixl 9\".\n\n  OLD:   The derived Read instances for data types containing\n         left-assoc constructors produces code that causes\n         non-termination if you use 'read' to evaluate them\n         ( (head (reads x)) is cool tho.)\n\n          ==> The inferred assoc for :++ below left & the derived\n          Read instance should fail to terminate (with ghc-4.xx,\n          this is exemplified by having the stack overflow.)\n\n  NEW: the new H98 spec says that we ignore associativity when\n       parsing, so it terminates fine\n-}\n-- infixl 9 :++\ndata T = T1 |  T :++ T  deriving (Eq,Show, Read)\n\nt :: T\nt = read \"T1\"\n\nmain = do\n  print ((fst (head (reads \"T1\"))) :: T)\n  print t\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Show/Read deriving example given in the Haskell Report.\nmodule Main(main) where\n\ninfix 4 :^:\ndata Tree a\n  =  Leaf a  | (Tree a) :^: (Tree a)\n     deriving (Show, Read)\n\nval1 :: Tree Int\nval1 = Leaf 2\n\nval2 :: Tree Int\nval2 = Leaf 2 :^: Leaf (-1)\n\nmain = do\n  print val1\n  print val2\n\n  print ((read (show val1))::Tree Int)\n  print ((read (show val2))::Tree Int)\n  print ((read (show val1))::Tree Integer)\n  print ((read (show val2))::Tree Integer)\n\n{- What you'll want\ninstance (Show a) => Show (Tree a) where\n\n        showsPrec d (Leaf m) = showParen (d >= 10) showStr\n          where\n             showStr = showString \"Leaf \" . showsPrec 10 m\n\n        showsPrec d (u :^: v) = showParen (d > 4) showStr\n          where\n             showStr = showsPrec 5 u .\n                       showString \" :^: \" .\n                       showsPrec 5 v\n\ninstance (Read a) => Read (Tree a) where\n\n        readsPrec d r =  readParen (d > 4)\n                         (\\r -> [(u:^:v,w) |\n                                 (u,s) <- readsPrec 5 r,\n                                 (\":^:\",t) <- lex s,\n                                 (v,w) <- readsPrec 5 t]) r\n\n                      ++ readParen (d > 9)\n                         (\\r -> [(Leaf m,t) |\n                                 (\"Leaf\",s) <- lex r,\n                                 (m,t) <- readsPrec 10 s]) r\n-}\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main( main ) where\n-- This one crashed Hugs98\n\ndata X = X | X :\\ X  deriving Show\n\nmain = putStrLn (show (X :\\ X))\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check that -funbox-strict-fields doesn't mess up deriving (can't be in an options pragma, it's in the Makefile)\n-- !!!  (it did in 4.04)\n\nmodule Main( main ) where\n\ndata X = X !Int deriving Eq\n\nmain = putStrLn (show (X 2 == X 2))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check the Read instance for Array\n-- [Not strictly a 'deriving' issue]\n\nmodule Main( main ) where\nimport Data.Array\n\nbds :: ((Int,Int),(Int,Int))\nbds = ((1,4),(2,5))\n\ntype MyArr = Array (Int,Int) Int\n\na :: MyArr\na = array bds [ ((i,j), i+j) | (i,j) <- range bds ]\n\nmain = do { putStrLn (show a) ;\n            let { b :: MyArr ;\n                  b = read (show a) } ;\n            putStrLn (show b)\n          }\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata Test = Test { field :: Int } deriving (Eq,Show,Read)\n\nmain = putStrLn $\n       if read (show (Test {field=(-1)})) == Test (-1)\n       then \"works\" else \"not\"\n\n-- The point here is that if 'show' generates\n--      Test { field=-1 }\n-- the lexer things the '=-' is one lexeme, which does not work\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests some simple deriving stuff, and built-in instances\n\nmodule Main( main ) where\n\ndata Command = Commit (Maybe String) | Foo | Baz Bool | Boz Int\n             deriving (Read,Show)\n\ntype T = ([Command], [Command], [Command])\nval :: T\nval = ([Commit Nothing, Commit (Just \"foo\")],\n       [Foo, Baz True],\n       [Boz 3, Boz (-2)])\n\nmain = do { print val  ;\n            print ((read (show val)) :: T) }\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests readings of record syntax\n\nmodule Main where\n\ndata Foo = Foo { x :: Baz, y :: Maybe Int } deriving (Read,Show)\n\ninfix 0 :%%\ndata Baz = Int :%% Int deriving( Read,Show)\n\n\nmain = print (read \"Foo { x = 1 :%% 2, y = Just 4 }\" :: Foo)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test makes sure that the derivied instance for\n--      Eq A\n-- \"sees\" the non-derived instance for\n--      Eq B\n--\n-- In a version of GHC 5.05, this didn't happen, because the\n-- deriving mechanism looked through A's rep-type and found Int\n\nmodule Main where\n\nnewtype B = MkB Int\ninstance Eq B where\n  (MkB 1) == (MkB 2) = True     -- Non-standard equality\n  (MkB a) == (MkB b) = False\n\nnewtype A = MkA B deriving( Eq )\n\nmain = print (MkA (MkB 1) == MkA (MkB 2))\n-- Should say \"True\", because of B's non-standard instance\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one gave the wrong answer with ghci 5.02.3 (and 5.02.2)\n\nmodule Main where\n\ninfixr 3 :*\ninfixr 2 :+\n\ndata RE a = RE a :+ RE a\n          | RE a :* RE a\n          | Cat  [RE a]\n          | Star (RE a)\n          | Plus (RE a)\n          | Opt  (RE a)\n          | Comp (RE a)\n          | Empty\n          | Str  [a]\n            deriving (Show, Eq, Ord)\n\nmain = print (Str \"ab\" == (Str \"a\" :+ Str \"b\"))\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The leading underscore killed GHC 5.04\n\nmodule Main where\n\ndata Obj = Obj {_id, p1, p2::Int} deriving (Show, Read)\n\n\nmain = print (show (read \"Obj {_id=1,p1=10,p2=20}\" :: Obj))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Run with -funbox-strict-fields\n-- Bug in GHC 5.04.3\n\nmodule Main where\n\ndata Foo = Foo Int String\ndata Bar = Bar Int Foo\n\ninstance Ord Bar where \n    compare (Bar i _) (Bar j _) = compare i j\n\ninstance Eq Bar where\n    (Bar i _) == (Bar j _) = i == j\n\n\ndata Zot = Zot !Bar !String deriving (Ord,Eq)\n\nmain = putStrLn \"Success\"\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- Test Show on unboxed types\n\nmodule Main where\nimport GHC.Base\n\ndata Foo = MkFoo Int# Float# Int deriving( Show )\n\nmain = print (MkFoo 3# 4.3# 2)", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test Show on unboxed types\n\nmodule Main where\n\ndata Foo = Int `MkFoo` Int deriving( Read, Show )\n\nmain = do { print (MkFoo 4 5)\n          ; print (read \"3 `MkFoo` 5\" :: Foo) }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\n-- Tests newtype deriving with\n-- a non-type constructor in the representation\n\nmodule Main where\n\nnewtype Wrap m a = Wrap { unWrap :: m a }\n    deriving (Functor, Applicative, Monad, Eq)\n\nfoo :: Int -> Wrap IO a -> Wrap IO ()\nfoo 0 a = return ()\nfoo n a = do { a; foo (n-1) a }\n\nmain = do { unWrap (foo 3 (Wrap (putChar 'x'))); putChar '\\n' }\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A  nasty deriving test\n-- Note the \"T2 T1 { f1=3 }\" part!\n\nmodule Main where\n\n\ninfix 4 :%%\ndata T = Int :%% T\n         | T1 { f1 :: Int }\n         | T2 T\n        deriving( Show, Read )\n\nmain = print (read \"3 :%% T2 T1 { f1=3 }\" :: T)\n\n{- Here's the parser that is produced\n\nimport GHC.Read\nimport Text.ParserCombinators.ReadPrec\nimport Text.Read\n\ninstance Read T where\n  readPrec =\n    parens\n    ( prec 4 (\n        do x           <- step readPrec\n           Symbol \":%%\" <- lexP\n           y           <- step readPrec\n           return (x :%% y))\n      +++\n      prec (appPrec+1) (\n        do Ident \"T1\" <- lexP\n           Punc \"{\" <- lexP\n           Ident \"f1\" <- lexP\n           Punc \"=\" <- lexP\n           x          <- reset readPrec\n           Punc \"}\" <- lexP\n           return (T1 { f1 = x }))\n      +++\n      prec appPrec (\n        do Ident \"T2\" <- lexP\n           x          <- step readPrec\n           return (T2 x))\n    )\n\nappPrec = 10::Int\n-}\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nclass Show a => Foo a where\n  op :: a -> a\n\nnewtype Moose = MkMoose () deriving (Show, Eq, Ord)\n\nnewtype Noose = MkNoose () deriving (Ord)\n\ninstance Eq Noose where\n  a == b = False        -- Non-standard!\n\nf :: Ord a => a -> Bool\nf x = x==x\n\nmain = do print (MkNoose () == MkNoose ())      -- Eq Noose\n          print (f (MkNoose ()))                -- via Ord Noose\n          print (MkMoose () == MkMoose ())      -- Eq Moose\n          print (f (MkMoose ()))                -- via Ord Moose\n          putStrLn (show (MkMoose ()))          -- Should not use the show () method\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule Main where\n\n-- GHC 6.4.1 output \"testz\" in z-encoded form!\n\nimport Data.Generics\n\ndata TestZ = TestZ { testz :: Int }\n             deriving (Show, Read, Eq, Data, Typeable)\n\nmain = print $ constrFields . toConstr $ TestZ { testz = 2 }\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport GHC.Prim\n\ndata P = Positives Int# Float# Double# Char# Word# deriving Show\ndata N = Negatives Int# Float# Double# deriving Show\n\nmain = do\n  print $ Positives 42# 4.23# 4.23## '4'# 4##\n  print $ Negatives -4# -4.0# -4.0##\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFoldable, GADTs, StandaloneDeriving #-}\nmodule Main where\n\nclass (a ~ Int) => Foo a\ninstance Foo Int\n\ndata A a where\n  A1 :: Ord a            => a        -> A a\n  A2 ::                     Int      -> A Int\n  A3 :: b ~ Int          => b        -> A Int\n  A4 :: a ~ Int          => Int      -> A a\n  A5 :: a ~ Int          => a        -> A a\n  A6 :: (a ~ b, b ~ Int) => Int -> b -> A a\n  A7 :: Foo a            => Int -> a -> A a\n\nderiving instance Foldable A\n\ndata HK f a where\n  HK1 :: f a -> HK f (f a)\n  HK2 :: f a -> HK f a\n\nderiving instance Foldable f => Foldable (HK f)\n\none :: Int\none = 1\n\nmain :: IO ()\nmain = do\n  mapM_ (print . foldr (+) one)\n    [ A1 one\n    , A2 one\n    , A3 one\n    , A4 one\n    , A5 one\n    , A6 one one\n    , A7 one one\n    ]\n  mapM_ (print . foldr mappend Nothing)\n    [ HK1 (Just \"Hello\")\n    , HK2 (Just (Just \"World\"))\n    ]\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\nmodule Main where\n\nnewtype MyMaybe a = MyMaybe (Maybe a)\n  deriving (Functor, Show)\n\nmain :: IO ()\nmain = print $ fmap (+1) $ MyMaybe $ Just (10 :: Int)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule Main where\n\nimport Data.Proxy\n\nclass C a where\n  c :: proxy a -> Int\n  c _ = 42\n\ninstance C Int where\n  c _ = 27\n\nnewtype Foo = MkFoo Int\n  deriving          Eq\n  deriving anyclass C\nderiving newtype instance Show Foo\n\nmain :: IO ()\nmain = do\n  print $ MkFoo 100\n  print $ c (Proxy :: Proxy Foo)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\ndata T  a = MkT  { runT  :: a, (##)  :: a } deriving (Read, Show)\ndata T# a = MkT# { runT# :: a, (###) :: a } deriving (Read, Show)\n\nt1, t2 :: T Int\nt1 = MkT (-1) 1\nt2 = read $ show t1\n\nt1#, t2# :: T# Int\nt1# = MkT# (-1) 1\nt2# = read $ show t1#\n\nmain :: IO ()\nmain = do\n  print t2\n  print t2#\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2529\n-- The example below successfully performed the {{{show}}}, but {{{reads}}}\n-- returns an empty list. It fails in both GHCi and GHC. It succeeds if you\n-- replaces the infix symbol with a name.\n\nmodule Main where\n\ndata A = (:<>:) { x :: Int, y :: Int } deriving (Read, Show)\n\nt :: A\nt = 1 :<>: 2\n\ns :: String\ns = show t\n\nr :: [(A,String)]\nr = reads s\n\nmain :: IO ()\nmain = do putStrLn s\n          putStrLn (show r)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, DeriveDataTypeable #-}\n\nmodule Main where\n\nimport Data.Generics hiding (ext2Q)\n\ndata MyMaybe a = MyNothing | MyJust a deriving (Data, Typeable)\n\ntest1 :: ()\ntest1 = undefined `ext1Q` (\\ (Just _) -> ()) $ Just ()\n\ntest1' :: ()\ntest1' = undefined `ext1Q` (\\ (MyJust _) -> ()) $ MyJust ()\n\nnewtype Q r a = Q { unQ :: a -> r }\n\next2Q :: (Data d, Typeable t)\n      => (d -> q) -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)\n      -> d -> q\next2Q def ext arg =\n  case dataCast2 (Q ext) of\n    Just (Q ext') -> ext' arg\n    Nothing       -> def arg\n\ndata MyPair a b = MyPair a b deriving (Data, Typeable)\n\ntest2 :: ()\ntest2 = undefined `ext2Q` (\\(_,_) -> ()) $ ((),())\n\ntest2' :: ()\ntest2' = undefined `ext2Q` (\\(MyPair _ _) -> ()) $ MyPair () ()\n\nmain = do { print test1; print test1'; print test2; print test2' }\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata T = (:=:) {- | (:!=:) -} deriving (Show,Read)\n\nmain\n = do  putStrLn (\"show (:=:) = \" ++ show (:=:))\n       putStrLn (\"read (show (:=:)) :: T = \" ++\n                  show (read (show (:=:)) :: T))\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Crashed older GHCs when loaded into GHCi\n\nmodule Main where\n\ndata T a = A | B | C deriving( Enum, Show )\n\nmain = print [A ..]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\ndata T = T1# | T2# Int deriving( Read, Show )\n\nfoo :: [T]\nfoo = read \"[ T1#, T2# 4, T2# 5 ]\"\nmain = print foo\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, StandaloneDeriving #-}\nmodule Main where\n\ndata Z\nderiving instance Eq Z\n\ng :: Z\ng = g\n\nmain :: IO ()\nmain = print (g == g)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Main where\n\ninfix 5 :*: \ndata T a where\n  (:*:) :: Int -> a -> T a\n  (:+:) :: Char -> T a -> T a\n  deriving( Show )\n\n -- The Show should print (:*:) infix, but (:+:) prefix, \n -- since it lacks a fixity declaration\n\nmain = print ('x' :+: (3 :*: True))\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDeriving #-}\nmodule Main where\n\nimport Data.Function\n\ndata Foo\n  deriving (Eq, Ord, Read, Show)\n\nfoo1 :: Foo\nfoo1 = fix id\n\nfoo2 :: Foo\nfoo2 = let x = y\n           y = x\n        in y\n\nmain :: IO ()\nmain = do\n  print (foo1 ==        foo2)\n  print (foo1 `compare` foo2)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-} \nmodule Main where \n \ndata A \nderiving instance Read A \nderiving instance Show A \n \nmain = print (read \"[]\" :: [A])\n-- Should successfully read the empty list\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n\nmodule Main where\n\ndata Foo = MkFoo\ndata Bar = MkBar Foo deriving Show\n\nmain = do { print True; print (MkBar MkFoo) }\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\nmodule Main where\n\nimport T9830a\n\nderiving instance (Show a, Show b) => Show (ADT a b)\n\nmain :: IO ()\nmain = do\n    putStrLn $ \"Prec 6:  \" ++ showsPrec 6  (\"test\" :?: \"show\") \"\"\n    putStrLn $ \"Prec 7:  \" ++ showsPrec 7  (\"test\" :?: \"show\") \"\"\n    putStrLn $ \"Prec 9:  \" ++ showsPrec 9  (\"test\" :?: \"show\") \"\"\n    putStrLn $ \"Prec 10: \" ++ showsPrec 10 (\"test\" :?: \"show\") \"\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9830a where\n\ninfixr 6 :?:\ndata ADT a b = a :?: b deriving (Eq, Ord, Read)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nx@_ = x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds001 -- simple function and pattern bindings\n--\n-- this tests ultra-simple function and pattern bindings (no patterns)\n\nmodule ShouldCompile where\n\n-- simple function bindings\n\nf x = x\n\ng x y z = f z\n\nj w x y z = g w x z\n\nh x y = f y\n  where\n    f a b = a\n\n-- simple pattern bindings\n\na = b\n\nb = f\n\nc = c\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds002 -- overlapping equations and guards\n--\n-- this tests \"overlapping\" variables and guards\n\nmodule ShouldCompile where\n\nf x = x\nf y = y\nf z = z\n\ng x y z | True = f z\n        | True = f z\n        | True = f z\ng x y z | True = f z\n        | True = f z\n        | True = f z\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds003 -- list, tuple, lazy, as patterns\n--\nmodule ShouldCompile where\n\nf []            y        True  = []\nf x             a@(y,ys) ~z    = []\nf (x:x1:x2:x3)  ~(y,ys)  z     = []\nf x             y        True  = []\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds004 -- nodups from SLPJ p 79\n--\nmodule ShouldCompile where\n\n-- SLPJ, p 79\nnodups []                   = []\nnodups [x]                  = [x]\nnodups (y:x:xs) | y == x    = nodups (x:xs)\n                | True      = y : nodups (x:xs)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds005 -- mappairs from SLPJ Ch 5'\n--\n-- this simply tests a \"typical\" example\n\nmodule ShouldCompile where\n\n-- from SLPJ, p 78\nmappairs f []     ys     = []\nmappairs f (x:xs) []     = []\nmappairs f (x:xs) (y:ys) = f x y : mappairs f xs ys\n\n-- from p 80\nmappairs' f []     ys     = []\nmappairs' f x      []     = []\nmappairs' f (x:xs) (y:ys) = f x y : mappairs' f xs ys\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds006 -- v | True = v+1 | False = v (dead code elim)\n--\nmodule ShouldCompile where\n\nv | True  = v + 1\n  | False = v\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds007 -- simple local bindings\n\nmodule ShouldCompile where\n\nw = a where a = y\n            y = []\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds008 -- free tyvars on RHSs\n--\n-- these tests involve way-cool TyApps\n\nmodule ShouldCompile where\n\nf x = []\n\ng x = (f [],[],[],[])\n\nh x = g (1::Int)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds009 -- simple list comprehensions\n\nmodule ShouldCompile where\n\nf xs = [ x | x <- xs ]\n\ng xs ys zs = [ (x,y,z) | x <- xs, y <- ys, z <- zs, True ]\n\nh xs ys = [ [x,y] | x <- xs, y <- ys, False ]\n\ni xs = [ x | all@(x,y) <- xs, all == ([],[]) ]\n\nj xs = [ (a,b) | (a,b,c,d) <- xs ]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds010 -- deeply-nested list comprehensions\n\nmodule ShouldCompile where\n\nz = [ (a,b,c,d,e,f,g,h,i,j) | a <- \"12\",\n                              b <- \"12\",\n                              c <- \"12\",\n                              d <- \"12\",\n                              e <- \"12\",\n                              f <- \"12\",\n                              g <- \"12\",\n                              h <- \"12\",\n                              i <- \"12\",\n                              j <- \"12\"\n    ]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds011 -- uses of \"error\"\n\nmodule ShouldCompile where\n\nf = error []\n\ng = error \"\"\n\nh = error \"\\\"\"\n\ni = error \"foo\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds012 -- simple Integer arithmetic\n--\nmodule ShouldCompile where\n\nf x = 1 + 2 - 3 + 4 * 5\n\ng x = x + (f x)\n\nh x = 111111111111111111111111111111111111111111111111111111111111\n    + 222222222222222222222222222222222222222222222222222222222222\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds013 -- simple Rational arithmetic\n\nmodule ShouldCompile where\n\nf = 1.5 + 2.0 - 3.14159265 + 4.2 * 5.111111111111111111111111111\n\ng :: Float\ng = 1.5 + 2.0 - 3.14159265 + 4.2 * 5.111111111111111111111111111\n\nh :: Double\nh = 1.5 + 2.0 - 3.14159265 + 4.2 * 5.111111111111111111111111111\n\n{- later\ng x = x + (f x)\n\nh x = 1.0e1000000000 + 1.0e1000000000\n\ni x = 1.0e-1000000000 + 1.0e-1000000000\n\nj x = 1111111111.222222222222222e333333333333333\n    * 4444444444.555555555555555e-66666666666666\n-}\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds014 -- character and string literals\n-- !!!   really should add ALL weird forms...\n\nmodule ShouldCompile where\n\na = 'a'\nb = \"b\"\nc = a:b\nd = b ++ b\n\nb1 = \"\"         -- examples from the Haskell report\nb2 = \"\\&\"       -- the same thing\nb3 = \"\\SO\\&H\" ++ \"\\137\\&9\"\n\na000 = '\\NUL'\na001 = '\\SOH'\na002 = '\\STX'\na003 = '\\ETX'\na004 = '\\EOT'\na005 = '\\ENQ'\na006 = '\\ACK'\na007 = '\\BEL'\na010 = '\\BS'\na011 = '\\HT'\na012 = '\\LF'\na013 = '\\VT'\na014 = '\\FF'\na015 = '\\CR'\na016 = '\\SO'\na017 = '\\SI'\na020 = '\\DLE'\na021 = '\\DC1'\na022 = '\\DC2'\na023 = '\\DC3'\na024 = '\\DC4'\na025 = '\\NAK'\na026 = '\\SYN'\na027 = '\\ETB'\na030 = '\\CAN'\na031 = '\\EM'\na032 = '\\SUB'\na033 = '\\ESC'\na034 = '\\FS'\na035 = '\\GS'\na036 = '\\RS'\na037 = '\\US'\na040 = '\\SP'\na042 = '\"'\na047 = '\\''\na134 = '\\\\'\na177 = '\\DEL'\n\nascii = \"\\NUL\\SOH\\STX\\ETX\\EOT\\ENQ\\ACK\\BEL\\\n        \\\\BS\\HT\\LF\\VT\\FF\\CR\\SO\\SI\\\n        \\\\DLE\\DC1\\DC2\\DC3\\DC4\\NAK\\SYN\\ETB\\\n        \\\\CAN\\EM\\SUB\\ESC\\FS\\GS\\RS\\US\\\n        \\\\SP!\\\"#$%&'\\\n        \\()*+,-./\\\n        \\01234567\\\n        \\89:;<=>?\\\n        \\@ABCDEFG\\\n        \\HIJKLMNO\\\n        \\PQRSTUVW\\\n        \\XYZ[\\\\]^_\\\n        \\`abcdefg\\\n        \\hijklmno\\\n        \\pqrstuvw\\\n        \\xyz{|}~\\DEL\"\n\nna200 = '\\o200'\nna250 = '\\o250'\nna300 = '\\o300'\nna350 = '\\o350'\nna377 = '\\o377'\n\neightbit = \"\\o200\\o250\\o300\\o350\\o377\"\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds015 -- lambdas\n--\nmodule ShouldCompile where\n\nf x = ( \\ x -> x ) x\n\ng x y = ( \\ x y -> y x ) ( \\ x -> x ) x\n\nh x y = ( \\ (x:xs) -> x ) x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds016 -- case expressions\n--\nmodule ShouldCompile where\n\nf x y z =\n    case ( x ++ x ++ x ++ x ++ x ) of\n        []      -> []\n        [a]     -> error \"2\"\n        [a,b,c] ->\n                    case ( (y,z,y,z) ) of\n--                    (True, _, False, _) | True == False -> z\n--                    (True, _, False, _) | True == False -> z\n                      _ -> z\n\n        (a:bs)  -> error \"4\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds017 -- let expressions\n--\nmodule ShouldCompile where\n\nf x y z\n  = let\n        a = x : []\n        b = x : a\n        c = y (let d = (z, z) in d)\n        result = (c, b)\n    in\n        result\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds018 -- explicit lists and tuples (with disabled LARGE tuples!)\n--\nmodule ShouldCompile where\n\n-- exprs\n\nf x y z = [x,y,z,x,y,z]\nf2 x y  = []\n\ng1 x y  = ()\n\n{- Although GHC *should* provide arbitrary tuples, it currently doesn't\n   and probably won't in the near future, so this test is only a reminder.\n\ng x y z = (x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z,\n           x,y,z,x,y,z) -- hey, we love big tuples\n-}\n\n-- pats\n\nfa [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] = x\n\nfb [] = []\n\n{- See above\nga (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,\n    aa,ab,ac,ad,ae,af,ag,ah,ai,aj,ak,al,am,\n    an,ao,ap,aq,ar,as,at,au,av,aw,ax,ay,az) = x\n-}\n\ngb () x = x\ngb2 ()  = ()\n\n-- need to think of some better ones...\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds019 -- mixed var and uni-constructor pats\n\nmodule ShouldCompile where\n\nf (a,b,c) i     o = []\nf d       (j,k) p = []\nf (e,f,g) l     q = []\nf h       (m,n) r = []\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds020 -- lazy patterns (in detail)\n--\n\n{-# LANGUAGE NPlusKPatterns #-}\n\nmodule ShouldCompile where\n\na ~([],[],[])    = []\na ~(~[],~[],~[]) = []\n\nb ~(x:xs:ys)      = []\nb ~(~x: ~xs: ~ys) = []\n\nc ~x ~ _ ~11111 ~3.14159265 = x\n\nd 11        = 4\nd 12        = 3\nd ~(n+4)    = 2\nd ~(n+43)   = 1\nd ~(n+999)  = 0\n\nf ~(x@[]) = []\nf x@(~[]) = []\n\ng ~(~(~(~([])))) = []\n\n-- pattern bindings (implicitly lazy)\n\n([],[],[])    = ([],[],[])\n(~[],~[],~[]) = ([],[],[])\n\n(x1: xs1: ys1) = []\n(~x: ~xs: ~ys) = []\n\n(x2 : xs2: ys2) | eq2  = []\n                | eq3  = [x2]\n                | eq4  = [x2]\n                | True = []\n                where\n                  eq2 = (2::Int) == (4::Int)\n                  eq3 = (3::Int) == (3::Int)\n                  eq4 = (4::Int) == (2::Int)\n\n(x3,y3) | x3 >  3 = (4, 5)\n        | x3 <= 3 = (2, 3)\n-- above: x & y should both be \\bottom.\n\n(x4,(y4,(z4,a4))) | eq2  = ('a',('a',('a','a')))\n                  | eq3  = ('b',('b',('b','b')))\n                  | eq4  = ('c',('c',('c','c')))\n                  | True = ('d',('d',('d','d')))\n                  where\n                     eq2 = (2::Int) == (4::Int)\n                     eq3 = (3::Int) == (3::Int)\n                     eq4 = (4::Int) == (2::Int)\n\n\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds021 -- hairier uses of guards\n\nmodule ShouldCompile where\n\nf x y z | x == y     = []\n        | x /= z     = []\n        | True       = []\n        | False      = []\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds022 -- literal patterns (wimp version)\n--\n{-# OPTIONS_GHC -fwarn-overlapping-patterns #-}\n\nmodule ShouldCompile where\n\nf 1 1.1 = []\nf 2 2.2 = []\nf 3 3.3 = []\nf 4 4.4 = []\n\ng 11111111111111111111111 1.11111111111111111 = []\ng 22222222222222222222222 2.22222222222222222 = []\ng 33333333333333333333333 3.33333333333333333 = []\ng 44444444444444444444444 4.44444444444444444 = []\n\nh 'a'       \"\"                  = []\nh '\\''      \"foo\"               = []\nh '\"'       ('b':'a':'r':[])    = []\nh '\\o250'   blob                = []\n\ni 1 1.1     = []\ni 2 2.2     = []\ni 1 0.011e2 = []\ni 2 2.20000 = []\n\n{-\nj one@1 oneone@1.1\n  | ((fromFloat oneone) - (fromIntegral (fromInt one)))\n        /= (fromIntegral (fromInt 0)) = []\nj two@2 twotwo@2.2\n  | ((fromFloat twotwo) * (fromIntegral (fromInt 2)))\n        == (fromIntegral (fromInt 4.4)) = []\n-}\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds023 -- overloading eg from section 9.2\n--\nmodule ShouldCompile where\n\nf x     = g (x == x) x\ng b x   = abs (f x)\n--g b x = (f x) + (f x)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds024 -- correct types on ConPatOuts\n\n-- do all the right types get stuck on all the\n-- Nils and Conses?\n\nmodule ShouldCompile where\n\n\nf x = [[], []]\n\ng x = ([], [], [])\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds025 -- overloaded assoc -- AbsBinds\n\nmodule ShouldCompile where\n\nehead xs loc | null xs = error (\"4\"++loc)\n             | True = head xs\n\nassoc key lst loc\n   = if (null res) then error (\"1\"++loc++\"2\"++(show key))\n                   else (ehead res \"3\")\n     where res = [ val | (key',val) <- lst, key==key']\n\nassocMaybe :: (Eq a) => a -> [(a,b)] -> Maybe b\nassocMaybe key lst\n = if (null res) then Nothing else (Just (head res))\n   where res =  [ val | (key',val) <- lst, key==key']\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds026 -- classes -- incl. polymorphic method\n\nmodule ShouldCompile where\n\nclass Foo a where\n  op :: a -> a\n\nclass Foo a => Boo a where\n  op1 :: a -> a\n\nclass Boo a => Noo a where\n  op2 :: (Eq b) => a -> b -> a\n\nf x y = op (op2 x y)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds027 -- simple instances\n--\nmodule ShouldCompile where\n\ndata Foo = Bar | Baz\n\ninstance Eq Foo where\n  Bar == Baz = True\n  Bar /= Baz = False\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds028: failable pats in top row\n\nmodule ShouldCompile where\n\n\n-- when the first row of pats doesn't have convenient\n-- variables to grab...\n\nmAp f []        = []\nmAp f (x:xs)    = f x : mAp f xs\n\nTrue  |||| _    =  True\nFalse |||| x    =  x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds029: pattern binding with guards (dubious but valid)\n--\n\nmodule ShouldCompile where\n\nf x = y\n    where (y,z) | y < z     = (0,1)\n                | y > z     = (1,2)\n                | True      = (2,3)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ds030: checks that types substituted into binders\n--\nmodule ShouldCompile where\n\nf x = case x of [] -> (3::Int) ; _ -> (4::Int)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nfoldPair :: (a->a->a,b->b->b) -> (a,b) -> [(a,b)] -> (a,b)\nfoldPair fg       ab [] = ab\nfoldPair fg@(f,g) ab ((a,b):abs) = (f a u,g b v)\n                       where (u,v) = foldPair fg ab abs\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! recursive funs tangled in an AbsBind\n\nmodule ShouldCompile where\n\n\nflatten :: Int          -- Indentation\n        -> Bool         -- True => just had a newline\n        -> Float        -- Current seq to flatten\n        -> [(Int,Float)]-- Work list with indentation\n        -> String\n\nflatten n nlp 0.0 seqs = flattenS nlp seqs\nflatten n nlp 1.0 seqs = flatten n nlp 1.1 ((n,1.2) : seqs)\n\nflattenS :: Bool -> [(Int, Float)] -> String\nflattenS nlp [] = \"\"\nflattenS nlp ((col,seq):seqs) = flatten col nlp seq seqs\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! getting top-level dependencies right\n--\nmodule ShouldCompile where\n\nf1 x = g1 x\ng1 y = y\n\ng2 y = y\nf2 x = g2 x\n\nf3 x = g3 x\ng3 y = f3 y\n\ng4 y = f4 y\nf4 x = g4 x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! mutually-recursive methods in an instance declaration\n--\nmodule ShouldCompile where\n\nclass Foo a where\n    op1 :: a -> a \n    op2 :: a -> a \n\ninstance Foo Int where\n    op1 x = op2 x\n    op2 y = op1 y\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  MagicHash, BangPatterns #-}\nmodule ShouldCompile where\n\nimport GHC.Exts\n\ndata CList = CNil | CCons Int# CList\n\nmk :: Int# -> CList\nmk n = case isTrue# (n ==# 0#) of\n       False -> CNil\n       _     -> CCons 1# (mk (n -# 1#))\n\nclen :: CList -> Int#\nclen CNil = 0#\nclen (CCons _ cl) = 1# +# (clen cl)\n\nmain = putStr (case len4_twice of\n            8# -> \"bingo\\n\"\n            _  -> \"oops\\n\")\n  where\n    list4       = mk 4#\n    !len4       = clen list4\n    !len4_twice = len4 +# len4\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom dmc@minster.york.ac.uk Tue Mar 10 17:15:20 1992\nVia: uk.ac.york.minster; Tue, 10 Mar 92 17:15:14 GMT\nMessage-Id: <swordfish.700247842@minster.york.ac.uk>\nFrom: dmc@minster.york.ac.uk\nTo: partain\nDate:       10 Mar 1992 17:17:21 GMT\n\nWill,\n\nI have just started using Haskell at York and have found a compilation\nerror in the code below which disappears when the last line is\ncommented out\n-}\n\n{-# LANGUAGE NPlusKPatterns #-}\n\nmodule ShouldCompile where\n\n--brack :: (Eq a) => a -> a -> [a] -> ([a],[a])\n--brack open close = brack' open close (1 :: Int)\n\nbrack' :: (Eq a) => a -> a -> Int -> [a] -> ([a],[a])\nbrack' open close 0 xs = ([],xs)\nbrack' open close (n+1) [] = ([],[])\nbrack' open close (n+1) (h:t) | h == open = ([],[])\n\n{-\nIs this something I have done wrong or a fault with the compiler?\n\nCheers\nDave\n\n\n-----------------------------------------------------------------------\nDavid Cattrall                  Telephone +44 904 432777\nDepartment of Computer Science\nUniversity of York              JANET:  dmc@uk.ac.york.minster\nYORK Y01 5DD\nUnited Kingdom                  UUNET:  uucp!ukc!minster!dmc\n-----------------------------------------------------------------------\n-}\n\n-- and this was Kevin's idea, subsequently...\n\nkh (n+2) x | x > n = x * 2\nkh (x+1) (m+1) = m\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! AbsBinds with tyvars, no dictvars, but some dict binds\n--\nmodule ShouldCompile where\n\nf x y = (fst (g y x), x+(1::Int))\ng x y = (fst (f x y), y+(1::Int))\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Jon Hill reported a bug in desugaring this in 0.09\n-- !!! (recursive with n+k patts)\n--\n\n{-# LANGUAGE NPlusKPatterns #-}\n\nmodule ShouldCompile where\n\ntakeList :: Int -> [a] -> [a]\ntakeList 0     _      = []\ntakeList (n+1) []     = []\ntakeList (n+1) (x:xs) = x : takeList n xs\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! make sure correct type applications get put in\n-- !!!   when (:) is saturated.\n\nmodule ShouldCompile where\n\n\nf = (:)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NPlusKPatterns #-}\n\nmodule ShouldCompile where\n\n-- !!! Another bug in overloaded n+k patts\n--\n\nmain  = print ((4::Int) ^^^^ (6::Int))\n\n(^^^^)          :: (Num a, Integral b) => a -> b -> a\nx ^^^^ 0                =  1\nx ^^^^ (n+1)    =  f x n x\n                   where f _ 0 y = y\n                         f x n y = g x n  where\n                                   g x n | even n  = g (x*x) (n `quot` 2)\n                                         | otherwise = f x (n-1) (x*y)\n_ ^^^^ _                = error \"(^^^^){Prelude}: negative exponent\"\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\n{- In 2.05 this one crashed with\n\n        Fail: \"basicTypes/Id.lhs\", line 990: incomplete pattern(s)\n                to match in function \"dataConFieldLabels\"\n\n   Reason: dsExpr (RecordCon ...) didn't extract\n           the constructor properly.\n-}\n\nmodule ShouldCompile where\n\ndata Eq a => Foo a = Foo { x :: a }\n\nfoo :: Eq a => Foo a\nfoo = Foo{}\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Guard on a tuple pattern, broke 4.01 due to the\n-- !!! special handling of unboxed tuples in desugarer.\nmodule ShouldCompile where\n\nf :: Int -> (Int,Int)\nf x = \n  case f x of\n    (a,b) | a > 0 -> f (x-1)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking the exhaustiveness of constructor\n-- !!! with labelled fields.\nmodule ShouldCompile where\n\ndata E = B { a,b,c,d,e,f :: Bool }\n\nbug x =\n case x of\n  B _ _ _ _ True False    -> undefined\n  B {e=True, f=False}     -> undefined\n  B {a=a,f=False,e=False} -> undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Use of empty record patterns for constructors\n-- !!! that don't have any labelled fields. According\n-- !!! to the report, this isn't illegal.\nmodule ShouldCompile where\n\ndata F = F Int Int\n       | G\n\nisF F{} = True\nisF _   = False\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NPlusKPatterns #-}\n\n-- !!! N-plus-K pattern in binding\n\n-- From: Andreas Marth\n-- Sent: Monday, June 07, 1999 5:02 PM\n-- To: glasgow-haskell-bugs@majordomo.haskell.org\n-- Subject: compiler-bug\n\nmodule ShouldCompile where\n\nerroR :: Int\nerroR = n where\n                (n+1,_) = (5,2)\n\n-- Produced a -dcore-lint error in the desugarer output\n-- (Was a missing case in DsHsSyn.collectTypedPatBinders)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- Strict field unpacking tests: compile with -O -funbox-strict-fields.\n\n-- test 1: simple unboxed int field\ndata T = T !Int\nt (T i) = i + 1\n\n-- test 2: mutual recursion (should back off from unboxing either field)\ndata R = R !S\ndata S = S !R\n\nr (R s) = s\n\n-- test 3: multi-level unboxing\ndata A = A Int !B Int\ndata B = B !Int\n\nf = A 1 (B 2) 1\ng (A x (B y) z) = A x (B (y+2)) z\nh (A x (B y) z) = y + 2\n\n-- test 4: flattening nested tuples\ndata C = C !(Int,Int)\nj (C (a,b)) = a + b\n\n-- test 5: polymorphism, multiple strict fields\ndata D a b = D Int !(a,b) !(E Int)\ndata E a = E a\nk (D a (b,c) (E d)) = a + b + c + d\n\n-- test 6: records\ndata F a b = F { x :: !Int, y :: !(Float,Float), z :: !(a,b) }\nl F{x = a} = a\nm (F a b c) = a\nn F{z = (a,b)} = a\n\n-- test 7: newtypes\nnewtype G a b = G (F a b)\ndata H a b = H !Int !(G a b) !Int\no (H y (G (F{ x=x })) z) = x + z\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Nullary rec-pats for constructors that hasn't got any labelled\n-- !!! fields is legal Haskell, and requires extra care in the desugarer.\nmodule ShouldCompile where\n\ndata X = X Int [Int]\n\nf :: X -> Int\nf (X _ []) = 0\nf X{}      = 1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! newtypes with a labelled field.\nmodule ShouldCompile where\n\nnewtype Foo = Foo { x :: Int } deriving (Eq)\n\nf :: Foo -> Foo -> Int\nf a b = x a + x b\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldCompile where\n\ndata Q = Q {f :: forall a. a -> a}\ng1 = f\ng2 x = f x\ng3 x y = f x y\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- !!! test the overlapping patterns detection.\n\n-- f1 overlaps\nf1 \"ab\" = []\nf1 \"ab\" = []\nf1 _ = []\n\n-- f2 overlaps\nf2 \"ab\" = []\nf2 ('a':'b':[]) = []\nf2 _ = []\n\n-- f3 overlaps\nf3 ('a':'b':[]) = []\nf3 \"ab\" = []\nf3 _ = []\n\n-- f4 doesn't overlap\nf4 \"ab\" = []\nf4 ('a':'b':'c':[]) = []\nf4 _ = []\n\n-- f5 doesn't overlap\nf5 ('a':'b':'c':[]) = []\nf5 \"ab\" = []\nf5 _ = []\n\n-- f6 doesn't overlap\nf6 \"ab\" = []\nf6 ('a':[]) = []\nf6 _ = []\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-incomplete-patterns #-}\nmodule ShouldCompile where\n\n-- should *not* produce a warning about non-exhaustive patterns\nlazyZip:: [a] -> [b] -> [(a, b)]\nlazyZip []     _       = []\nlazyZip (x:xs) ~(y:ys) = (x, y):lazyZip xs ys\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-unused-binds #-}\nmodule ShouldCompile() where\n\n-- should warn about unused f, even though f is used in itself\nf = f\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- fails core-lint in 6.2\nmodule ShouldCompile where\n\nnewtype Foo = Foo [Foo]\nnewtype Bar = Bar Foo\n\nunBar :: Bar -> Foo\nunBar (Bar x) = x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}\n\n-- This module requires quite trick desugaring,\n-- because of the context in the existentials\n-- It broke a pre 6.4 GHC\n\nmodule Foo where\n\n   import Data.Data\n\n   data Item = forall a. (Data a) => Leaf Bool a\n             | forall a. (Data a) => Branch Bool a Int Int\n             deriving (Typeable)\n\n\n   instance Data Item where\n       gfoldl k z (Leaf b v) = z (Leaf b) `k` v\n       gfoldl k z (Branch b v a1 a2) = z (\\x -> Branch b x a1 a2) `k` v\n       gunfold _ _ _ = error \"urk\"\n       toConstr (Leaf _ _) = leafConstr\n       toConstr (Branch _ _ _ _) = branchConstr\n       dataTypeOf _ = itemDataType\n\n   itemDataType = mkDataType \"Subliminal.Item\" [leafConstr, branchConstr]\n   leafConstr = mkConstr itemDataType \"Leaf\" [] Prefix\n   branchConstr = mkConstr itemDataType \"Branch\" [] Prefix\n\n\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Check overlap in n+k patterns\n\n{-# LANGUAGE NPlusKPatterns #-}\n\nmodule Foo where\n\ng :: Int -> Int\ng (x+1) = x\ng y     = y\ng _     = 0     -- Overlapped\n\nh :: Int -> Int\nh (x+1) = x\nh _     = 0     -- Not overlapped\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns, UnboxedTuples #-}\nmodule ShouldCompile where\n\nimport Data.Word\nimport GHC.Ptr\nimport GHC.Exts\n\nf# :: Int# -> (# Char#, Int# #)\nf# a# = (# '\\0'#, a#  #)\n\ng :: Int -> (Char, Int)\ng (I# a#) = ( C# c#, I# b# )\n  where !(# c#, b# #) = f# a#\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test overlapping pattern warnings\n\nmodule ShouldCompile where\n\nf x = case x of\n        Just (~1) -> 0\n        Just _    -> 1  -- This one cannot match\n        Nothing   -> 2\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-incomplete-patterns #-}\n\n-- Test for incomplete-pattern warnings\n-- None should cause a warning\n\nmodule ShouldCompile where\n\n-- These ones gave bogus warnings in 6.2\n\ndata D = D1 { f1 :: Int } | D2\n\n-- Use pattern matching in the argument\nf :: D -> D\nf  d1@(D1 {f1 = n}) = d1 { f1 = f1 d1 + n } -- Warning here\nf  d = d\n\n-- Use case pattern matching\ng :: D -> D\ng  d1 = case d1 of\n           D1 { f1 = n } -> d1 { f1 = n + 1 } -- Warning here also\n           D2            -> d1\n\n-- These ones were from Neil Mitchell\n-- no warning\nex1 x = ss\n    where (_s:ss) = x\n\n-- no warning\nex2 x = let (_s:ss) = x in ss\n\n--    Warning: Pattern match(es) are non-exhaustive\n--             In a case alternative: Patterns not matched: []\nex3 x = case x of ~(_s:ss) -> ss\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n\nmodule ShouldCompile where\n\nf :: String -> Int\nf x | null x    = 1\n    | otherwise = 2\n\n-- Should not give a non-exhaustive-patterns error\n-- See Trac #1759\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule ShouldCompile where\n\nf :: Int -> Int\nf ((+1) -> 1) = 5\nf _           = 3\n\n-- Should not give an overlapping-patterns or non-exhaustive-patterns error\n-- See Trac #2395\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-uni-patterns #-}\n{-# LANGUAGE Strict #-}\nmodule DsStrictWarn where\n\n-- should warn about non-exhaustive pattern match\nw :: String -> String\nw x = let (_:_) = x in \"1\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Gadt where\n\ndata T a where\n   T1 :: T Int\n   T2 :: T a\n   T3 :: T Bool\n\nf :: T Int -> Bool\nf T1 = True\nf T2 = False\n\ng :: T Bool -> Bool\ng T2 = True\ng T3 = False\n\nh :: T a -> Bool\nh T1 = True\nh T2 = False\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_GHC -O #-}\nmodule T10251 where\n\ndata D = D\ndata E = E\n\nclass Storable a where\n    poke2 :: a -> E\ninstance Storable D where\n    poke2 = poke2 -- undefined\n\nclass Foo a where\ninstance Foo D where\n\nclass (Foo t, Storable t) => FooStorable t where\n\ninstance FooStorable D where\n    {-# SPECIALIZE instance FooStorable D #-}\n\n{-# SPECIALIZE bug :: D -> E #-}\n\nbug\n  :: FooStorable t\n  => t\n  -> E\nbug = poke2\n{-\nsf 9160 # ghc -c -fforce-recomp -Wall B.hs\n\nghc: panic! (the 'impossible' happened)\n  (GHC version 7.10.1 for x86_64-unknown-linux):\n        Template variable unbound in rewrite rule\n  $fFooStorableD_XU\n  [$fFooStorableD_XU]\n  [$fFooStorableD_XU]\n  []\n  []\n\nPlease report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n-}\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do\n  return $ let a = \"hello\" in a\n  return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}\n\nmodule Main where\n\n{- ghc-7.8.4 and ghc-7.10.2 showed a confusing warning:\n\nT10767.hs:43:1: Warning:\n    RULE left-hand side too complicated to desugar\n      Optimised lhs: case cobox_aWY\n                     of _ [Occ=Dead] { GHC.Types.Eq# cobox ->\n                     genLength @ Int $dSpecList_aWX\n                     }\n      Orig lhs: case cobox_aWY of cobox_aWY { GHC.Types.Eq# cobox ->\n                genLength @ Int $dSpecList_aWX\n                }\n-}\n\nimport Data.Proxy\nimport Data.Kind (Type)\n\nclass SpecList a where\n    type List a :: Type\n\n    slCase      :: List a -> b -> (a -> List a -> b) -> b\n\ndata IntList\n  = ILNil\n  | ILCons {-# UNPACK #-} !Int IntList\n  deriving (Show)\n\ninstance SpecList Int where\n  type List Int = IntList\n\n  slCase ILNil        n _  = n\n  slCase (ILCons i t) _ c  = c i t\n\nfromList :: [Int] -> IntList\nfromList []      = ILNil\nfromList (h : t) = ILCons h (fromList t)\n\nlst1 :: IntList\nlst1 = fromList [1..10]\n\n{-# SPECIALIZE genLength :: Proxy Int -> List Int -> Int #-}\ngenLength :: forall a . SpecList a => Proxy a -> List a -> Int\ngenLength p lst = slCase lst 0 (\\(_ :: a) tail -> 1 + genLength p tail)\n\nmain :: IO ()\nmain = print (genLength (Proxy :: Proxy Int) lst1)\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Strict #-}\n\nmain :: IO ()\nmain = print $ let x = undefined in True\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -O #-}\n\nmodule T12944 () where\n\nimport Data.Kind (Type)\n\nclass AdditiveGroup v where\n  (^+^) :: v -> v -> v\n  negateV :: v -> v\n  (^-^) :: v -> v -> v\n  v ^-^ v' = v ^+^ negateV v'\n\nclass AdditiveGroup v => VectorSpace v where\n  type Scalar v :: Type\n  (*^) :: Scalar v -> v -> v\n\ndata Poly1 a = Poly1 a a\n\ndata IntOfLog poly a = IntOfLog !a !(poly a)\n\ninstance Num a => AdditiveGroup (Poly1 a) where\n    {-# INLINE (^+^) #-}\n    {-# INLINE negateV #-}\n    Poly1 a b ^+^ Poly1 a' b' = Poly1 (a + a') (b + b')\n    negateV (Poly1 a b) = Poly1 (negate a) (negate b)\n\ninstance (AdditiveGroup (poly a), Num a) => AdditiveGroup (IntOfLog poly a) where\n    {-# INLINE (^+^) #-}\n    {-# INLINE negateV #-}\n    IntOfLog k p ^+^ IntOfLog k' p' = IntOfLog (k + k') (p ^+^ p')\n    negateV (IntOfLog k p) = IntOfLog (negate k) (negateV p)\n    {-# SPECIALISE instance Num a => AdditiveGroup (IntOfLog Poly1 a) #-}\n        -- This pragmas casued the crash\n\ninstance (VectorSpace (poly a), Scalar (poly a) ~ a, Num a) => VectorSpace (IntOfLog poly a) where\n    type Scalar (IntOfLog poly a) = a\n    s *^ IntOfLog k p = IntOfLog (s * k) (s *^ p)\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n{-# OPTIONS_GHC -O #-}\n\nmodule T12950 where\n\nclass C a where\n  type TF a; m :: a -> TF a\n\ninstance C Int where\n  type TF Int = String; m = show\n\noverloaded :: C a => a -> (a,TF a)\n{-# INLINABLE overloaded #-}\noverloaded a = (a,m a)\n\n{-# SPECIALIZE overloaded :: Int -> (Int,TF Int) #-}\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule T13043 (foo, bar) where\n\nimport Data.IORef (IORef, newIORef, readIORef, writeIORef)\nimport System.IO.Unsafe (unsafePerformIO)\n\n{-# NOINLINE scServerState #-}\nscServerState :: SCServerState\nscServerState = unsafePerformIO (return undefined)\n\ndata SCServerState = SCServerState\n     { scServer_socket :: IORef (Maybe Int)\n     }\n\nfoo :: IO Int\nfoo = do\n   let !_ = scServerState\n   readIORef (scServer_socket scServerState) >>= \\xs -> case xs of\n      Nothing -> do\n         s <- undefined\n         writeIORef (scServer_socket scServerState) (Just s)\n         return s\n      Just s -> return s\n\nbar :: IO ()\nbar = do\n   let !_ = scServerState\n   return ()\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13208 where\n\nf x = let g = \\x -> x in g True\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule T13215 where\n\nnewtype F = F Int\n\nfoo !(F {}) = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13257 where\n\n  import Data.Int\n\n  int8 = -128 :: Int8\n  word = -1 :: Word\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13290 where\n\ndata Foo = Bar Int Char | Baz Char\n\n{-# RULES\n\"BarBaz\" Bar 0 'a' = Baz 'b'\n #-}\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! T13870 -- missing-fields warnings for recprd-construction\n\nmodule ShouldCompile where\n\nimport Data.Functor.Identity\n\ntest1 :: Maybe Int\ntest1 = Just{}\n\ntest2 :: Maybe Int\ntest2 = Nothing{}\n\ntest3 :: Identity Int\ntest3 = Identity{}\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# OPTIONS_GHC -Wincomplete-patterns #-}\n{-# LANGUAGE GADTs #-}\nmodule T14135 where\n\ndata Foo a where\n  Foo1 :: a -> Foo a\n  Foo2 :: Int -> Foo Int\n\npattern MyFoo2 :: (a ~ Int) => Int -> Foo a\npattern MyFoo2 i = Foo2 i\n\n{-# COMPLETE Foo1, MyFoo2 #-}\n\nf :: Foo a -> a\nf (Foo1 x) = x\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do\n   case 0::Int of\n      0 -> putStrLn \"A\"\n      1 -> putStrLn \"B\"\n      _ -> putStrLn \"C\"\n\n   case 0::Int of\n      0 -> putStrLn \"A\"\n      1 -> putStrLn \"B\"\n      2 -> putStrLn \"C\"\n\n   case 0::Integer of\n      0 -> putStrLn \"A\"\n      1 -> putStrLn \"B\"\n      _ -> putStrLn \"C\"\n\n   case 0::Integer of\n      0 -> putStrLn \"A\"\n      1 -> putStrLn \"B\"\n      2 -> putStrLn \"C\"\n\n   case 0::Integer of\n      1 -> putStrLn \"B\"\n      2 -> putStrLn \"C\"\n\n   case 3::Integer of\n      1 -> putStrLn \"B\"\n      2 -> putStrLn \"C\"\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do\n   case \"foo\" of\n      ('f':_)     -> putStrLn \"A\"\n      ('f':'o':_) -> putStrLn \"B\"\n      \"bar\"       -> putStrLn \"C\"\n\n   case \"foo\" of\n      \"foo\" -> putStrLn \"A\"\n      \"bar\" -> putStrLn \"B\"\n      \"baz\" -> putStrLn \"C\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Data.ByteString as B\n\nmain :: IO ()\nmain = do\n   case \"foo\" of\n      ('f':_)     -> putStrLn \"A\"\n      ('f':'o':_) -> putStrLn \"B\"\n      \"bar\"       -> putStrLn \"C\"\n\n   case \"foo\" of\n      \"foo\" -> putStrLn \"A\"\n      \"bar\" -> putStrLn \"B\"\n      \"baz\" -> putStrLn \"C\"\n\n   case (\"foo\" :: B.ByteString) of\n      \"foo\" -> putStrLn \"A\"\n      \"bar\" -> putStrLn \"B\"\n      \"baz\" -> putStrLn \"C\"\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T14547 where\n\nclass Foo f where\n        type It f\n        foo :: [It f] -> f\n\ndata List a = Empty | a :! List a deriving Show\n\ninstance Foo (List a) where\n        type It (List a) = a\n        foo [] = Empty\n        foo (x : xs) = x :! foo xs\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiWayIf #-}\n\nmodule T14773a where\n\nfoo :: Bool -> Int\nfoo b = if | b -> 1\n\nbar :: Bool -> Int\nbar b = if | b         -> 1\n           | otherwise -> 2\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14773b where\n\nb :: Bool\n(Just b) | False = Nothing\n\nc :: Bool\n(Just c) | False = Nothing\n         | True = Just True\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Desugarer outputs of this program when compiled with and without -XStrict\n-- should be the same because this program has only one binder (`a` in function\n-- `primitive`), but the binder is annotated with a laziness annotation, so\n-- -XStrict should have no effect on that binder.\n--\n-- Derived methods are also effected by -XStrict, but in our case we derive via\n-- GND which just generates coercions like\n--\n--     instance Functor m => Functor (StateT s m) where\n--       fmap\n--         = coerce\n--             @(forall (a_aJ2 :: TYPE LiftedRep) (b_aJ3 :: TYPE LiftedRep).\n--               a_aJ2 -> b_aJ3\n--               -> StateT s_aDW m_aDX a_aJ2 -> StateT s_aDW m_aDX b_aJ3)\n--             @(forall (a_aJ2 :: TYPE LiftedRep) (b_aJ3 :: TYPE LiftedRep).\n--               a_aJ2 -> b_aJ3\n--               -> StateT s_aDW m_aDX a_aJ2 -> StateT s_aDW m_aDX b_aJ3)\n--             fmap\n--\n-- So really -XStrict shouldn't have any effect on this program.\n\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MagicHash                  #-}\n{-# LANGUAGE MultiParamTypeClasses      #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE UnboxedTuples              #-}\n\nmodule K where\n\nimport qualified Control.Monad.State.Strict as S\nimport Control.Monad.Trans\nimport GHC.Exts\n\nclass Monad m => PrimMonad m where\n  type PrimState m\n  primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a\n\nnewtype StateT s m a = StateT (S.StateT s m a)\n  deriving (Functor, Applicative, Monad, MonadTrans)\n\ninstance PrimMonad m => PrimMonad (StateT s m) where\n  type PrimState (StateT s m) = PrimState m\n  primitive ~a = lift (primitive a) ; {-# INLINE primitive #-}\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns #-}\n{-# OPTIONS_GHC -Wall #-}\n\n-- Pattern-match overlap warnings with view patterns\nmodule T2395 where\n\nfoo :: Int -> Int\nfoo (even -> True) = 4\nfoo _              = 5\n\nbar :: (a, (Int,Int)) -> Int\nbar (snd -> (x,y)) = x+y   -- Cannot fail, hence overlap warning should \nbar _              = 6     -- for second pattern\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2409\n\nmodule ShouldCompile where\n\n f :: Int -> Int\n f _ | () `seq` False = undefined\n     | otherwise = error \"XXX\"\n\n g :: Int -> Int\n g _ | () `seq` False = undefined\n     | otherwise = error \"XXX\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, GADTs, EmptyCase #-}\nmodule T2431 where\n\ndata a :~: b where\n  Refl :: a :~: a\n\nabsurd :: Int :~: Bool -> a\nabsurd x = case x of {}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #3263.  New kind of warning on ignored monadic bindings\n\nmodule T3263 where\n\nnullM :: IO ()\nnullM = return ()\n\nnonNullM :: IO Int\nnonNullM = return 10\n\n-- No warning\nt1 = do\n  nonNullM\n\n-- No warning\nt2 = nonNullM\n\n-- No warning\nt3 = do\n  nullM\n  nonNullM\n\n-- Warning\nt4 = do\n  nonNullM\n  nullM\n\n-- No warning\nt5 = do\n  _ <- nonNullM\n  nullM\n\n-- Warning\nt6 = mdo\n  nonNullM\n  nullM", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #3263.  New kind of warning on monadic bindings that discard a monadic result\n\nmodule T3263 where\n\nimport Control.Monad.Fix\n\n-- No warning\nt1 :: Monad m => m Int\nt1 = do\n  return 10\n\n-- No warning\nt2 :: Monad m => m (m Int)\nt2 = return (return 10)\n\n-- No warning\nt3 :: Monad m => m (m Int)\nt3 = do\n  return 10\n  return (return 10)\n\n-- Warning\nt4 :: forall m. Monad m => m Int\nt4 = do\n  return (return 10 :: m Int)\n  return 10\n\n-- No warning\nt5 :: forall m. Monad m => m Int\nt5 = do\n  _ <- return (return 10 :: m Int)\n  return 10\n\n-- Warning\nt6 :: forall m. MonadFix m => m Int\nt6 = mdo\n  return (return 10 :: m Int)\n  return 10", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns,DeriveDataTypeable #-}\nmodule T4371 where\n\nimport Data.Typeable\n\ndata E1 = E1 deriving Typeable\ndata E2 = E2 deriving Typeable\n\nf :: Typeable a => a-> ()\nf x = case x of\n  (cast -> Just E1) -> ()\n  (cast -> Just E2) -> ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns, ExistentialQuantification #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n\n-- None of these should give incomplete-pattern warnings\n\nmodule T4439 where\n\ndata Moo = Moo (Char -> Int)\nspqr (Moo _) = undefined      \nfoo (id -> Moo _) = undefined \n\n\ndata Exists = forall a. Exists (a -> Int)\nbar (Exists _) = undefined       \nbaz (id -> Exists _) = undefined \n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-identities #-}\n\n-- Test warnings about identities\n\nmodule T4488 where\n\n-- ok1 :: Int -> Float\nok1 x = fromIntegral x\n\nwarn1 :: Int -> Int\nwarn1 x = fromIntegral x\n\nok4 :: Int -> Integer\nok4 x = toInteger x\n\nwarn4 :: Integer -> Integer\nwarn4 x = toInteger x\n\nok5 :: Float -> Rational\nok5 x = toRational x\n\nwarn5 :: Rational -> Rational\nwarn5 x = toRational x\n\n-- ok6 :: Float -> Rational\nok6 x = realToFrac x\n\nwarn6 :: Float -> Float\nwarn6 x = realToFrac x\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4870 where\n\nimport T4870a\n\ndata D = D\n\ninstance C D where\n  c x = x\n\n{-# SPECIALIZE f :: D #-}\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4870a where\n\nclass C a where c :: a -> a\n\n{-# INLINABLE f #-}\nf :: (C a) => a\nf = c f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule T5001 where\n\nimport T5001a\n\ndata T = T\n\ninstance Comorphism Float Int Char T\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule T5001a (Comorphism(..)) where\n\nclass Show a => Comorphism a b c d where\n    map_sentence :: a -> b -> c -> Result d\n    map_sentence = f\n\nf :: Comorphism a b c d => a -> b -> c -> Result d\nf x _ _ = fatal_error (\"Unsupported sentence translation \" ++ show x)\n\ndata Result a = Result String\n\nfatal_error :: String -> Result a\nfatal_error s = Result s\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\nmodule BadWarning where\n\ndata MyString = MyString String\n\nf1 (MyString \"a\") = undefined\nf1 (MyString \"bb\") = undefined\nf1 _ = undefined\n\nf2 (MyString \"aa\") = undefined\nf2 (MyString \"bb\") = undefined\nf2 _ = undefined\n\n-- Genuine overlap here!\nf3(MyString ('a':_)) = undefined\nf3 (MyString \"a\") = undefined\nf3 _ = undefined\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #5252\n-- Killed 7.03 when compiled witout -O,\n-- because it could not see that x had a product type\n-- but MkS still unpacked it\n\nmodule T5252 where\nimport T5252a\n\nblah :: S -> T\nblah (MkS x _) = x\n\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5252a( S(..), T ) where\n\ndata T = MkT Int Int\n\ndata S = MkS {-# UNPACK #-}!T Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5252Take2 where\nimport qualified T5252Take2a as M\n\nwrite_message :: M.WriteMessage -> IO Bool\nwrite_message (M.WriteMessage _) = return True\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -funbox-strict-fields #-}\n \nmodule T5252Take2a ( WriteMessage(..) , WriteDevice ) where\n\nimport qualified Data.ByteString as ByteString\n\ndata WriteMessage = WriteMessage !WriteDevice\nnewtype WriteDevice = WriteDevice ByteString.ByteString\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-uni-patterns #-}\nmodule T5455 where\n\n-- No error message for this one:\n-- the pattern will never be demanded\n\nw :: String -> String\nw x = let (_:_) = x in \"1\"\n\n-- We should get just one error message here\n\nw2 :: String -> String\nw2 x2 = let (a:as) = x2 in (a:a:as)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}  \n\nmodule T7669 where\n\ndata Void\n\nfoo :: Void -> ()\nfoo x = case x of {}\n-- Should not get incomplete-pattern warning\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fwarn-unused-do-bind #-}\nmodule T8470 where\n\ndata User\ntype family MethodResult ev\ntype instance MethodResult User = ()\ntype EventResult a = MethodResult a\n\nfoo = do undefined :: IO (EventResult User)\n         return ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Strict #-}\nmodule Main where\n\nmain = let False = True\n       in return ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\n\nmodule Main where\n\nf = curry $ \\case (Just x,  Left y)            -> Just (x, y)\n                  (Nothing, Right y) | y == 99 -> Just (0, \"99\")\n                  _                            -> Nothing\n\nmain = print $ [ f (Just 1) (Left \"Y\") == Just (1, \"Y\")\n               , f (Just 1) (Right 99) == Nothing\n               , f Nothing  (Right 99) == Just (0, \"99\")\n               , f Nothing  (Right 9)  == Nothing\n               , f Nothing  (Left \"Y\") == Nothing ]\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiWayIf #-}\n\nmodule Main where\n\nimport Data.List (isSuffixOf)\nimport Control.Exception\n\nerrMsg = \"Non-exhaustive guards in multi-way if\\n\"\ntable  = [(1, \"one\"), (100, \"hundred\")]\n\nf t x = if | l <- length t, l > 2, l < 5 -> \"length is 3 or 4\"\n           | Just y <- lookup x t -> y\n           | False -> \"impossible\"\n           | null t -> \"empty\"\n\nmain = do\n  print $ [ f table 1   == \"one\"\n          , f table 100 == \"hundred\"\n          , f [] 1      == \"empty\"\n          , f [undefined, undefined, undefined] (undefined :: Bool) ==\n              \"length is 3 or 4\"\n          , f ((0, \"zero\") : table) 100 == \"length is 3 or 4\"\n          ]\n  r <- try $ evaluate $ f table 99\n  print $ case r of\n    Left (PatternMatchFail s) | errMsg `isSuffixOf` s -> True\n    _                                                 -> False\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-      Check that list comprehensions can be written\n        in do-notation. This actually broke 2.02, with\n        a pattern match failure in dsListComp!\n-}\n\nmodule Main where\n\nmain = putStrLn (show theList)\ntheList = do x <- [1..3]\n             y <- [1..3]\n             return (x,y)\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- Tests let-expressions in do-statements -}\n\nmodule Main( main ) where\n\nfoo = do\n        putStr \"a\"\n        let x = \"b\" in putStr x\n        putStr \"c\"\n\nmain = do\n         putStr \"a\"\n         foo\n         let x = \"b\" in putStrLn x\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests match on empty field lists\n\nmodule Main where\n\ndata Person     =  Female {firstName, lastName :: String}\n                |  Male   {firstName, lastName :: String}\n                deriving (Show)\n\nisFemale (Female{})   =  True\nisFemale (Male{})     =  False\n\nmain = print (isFemale (Female {firstName = \"Jane\", lastName = \"Smith\"}))\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test n+k patterns\n\n{-# LANGUAGE NPlusKPatterns #-}\n\nmodule Main where\n\nf (n+1) = n\n\ng :: Int -> Int\ng (n+4) = n\n\nmain = print (f 3)      >>\n       print (g 9)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nFrom: Olaf Chitil <chitil@Informatik.RWTH-Aachen.DE>\n\nIt is a problem with 0.29 (which we use for compiling 2.01), it is gone\nin 2.01.\n\n        f :: Eq a => a -> [b] -> [b] -> Bool\n        f a [] [] = (a==a)\n        main = print (f True \"\" \"Hallo\")\n\n\nwhen run after compilation with 0.29 you get:\nFail: \"test.hs\", line 6: incomplete pattern(s) to match in function \"ds.d5b4\"\n\nwhile 2.01 gives you as desired\nFail: In pattern-matching: function f{-aYw-}; at test.hs, line 6\n\nThe problem is the dictionary, because for the program\n\n        f :: a -> [b] -> [b] -> Bool\n        f a [] [] = True\n        main = print (f True \"\" \"Hallo\")\n\n0.29 gives the function name \"f\" as well.\n\nSo it's ok in 2.01, but why did you change the form of the error messages?\n\"incomplete pattern(s) to match\" is more informative then \"In pattern-matching\"!\nI even prefer the order of information in the 0.29 error messages.\n\nMay I finally repeat that in my opinion the compiler should warn about\nincomplete patterns during compilation. However, I suppose the\nincomplete patterns are just recognised by the desugarer which does\nnot produce error messages any more.\n\n-}\n\n\nmodule Main where\n\nf :: Eq a => a -> [b] -> [b] -> Bool\nf a [] [] = (a==a)\n\nmain = print (f True \"\" \"Hallo\")\n\n\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nDate: Tue, 20 May 1997 05:10:04 GMT\nFrom: Tomasz Cholewo <tjchol01@mecca.spd.louisville.edu>\n\nghc-2.03 cannot compile the following code, which I think is correct\naccording to the Report\n\n        data X = A {a :: Int} | B {a :: Int}\n\nThe error message is:\n\n    Conflicting definitions for:  a\n        Defined at bug4.lhs:2\n        Defined at bug4.lhs:2\n\nIn addition the following snippet\n\n        data X = A {a :: Int}\n        y = let A {a} = x\n            in a\n\nfails with:\n\n    bug4.lhs:4:5: Not a valid LHS on input: \"in\"\n-}\n--module Main(main) where\n\ndata X = A {a :: Int} | B {a :: Int}\n\nf x = let A {a=a} = x\n      in a\n\nmain = print (f (A {a = 3}))\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data T = C Int\n\nunpick (C i) = i + 1\n\nmain = print (unpick (C{}))", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Double irrefutable pattern (bug in Hugs98, 29/8/2001)\nmain = print (case (1,2) of ~(~(2,x)) -> x)\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test that 'negate' is used properly to construct negative literals\n\nmain = print (minusTwo,trueOrFalse)\n\nminusTwo = -2::N\n\ntrueOrFalse =\n    case minusTwo of\n      -2 -> True\n      _ -> False\n\ndata N = Negate N | FromInteger Integer deriving (Eq,Show)\n\ninstance Num N where\n  negate = Negate\n  fromInteger = FromInteger\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Check that pattern match failure in do-notation\n-- is reflected by calling the monadic 'fail', not by a\n-- runtime exception\n\n{-# LANGUAGE NoMonadFailDesugaring #-}\n{-# OPTIONS -Wno-missing-monadfail-instances #-}\n\nimport Control.Monad\nimport Data.Maybe\n\ntest :: (MonadPlus m) => [a] -> m Bool\ntest xs\n  =   do\n        (_:_) <- return xs\n                -- Should fail here\n        return True\n    `mplus`\n        -- Failure in LH arg should trigger RH arg\n      do\n        return False\n\nmain :: IO ()\nmain\n  = do  let x = fromJust (test [])\n        putStrLn (show x)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test desugaring of mutual recursion of many functions\n-- which generated a big-tuple link error in GHC 6.0\n\nmodule Main where\n\n\na1 :: (Num a, Eq a) => a -> a\n\na1 x | x==0 = x\na1 x = 1 + k8 (x-1)\n\na2 x = 1 + a1 x\na3 x = 1 + a2 x\na4 x = 1 + a3 x\na5 x = 1 + a4 x\na6 x = 1 + a5 x\na7 x = 1 + a6 x\na8 x = 1 + a7 x\n\nb1 x = 1 + a8 x\nb2 x = 1 + b1 x\nb3 x = 1 + b2 x\nb4 x = 1 + b3 x\nb5 x = 1 + b4 x\nb6 x = 1 + b5 x\nb7 x = 1 + b6 x\nb8 x = 1 + b7 x\n\nc1 x = 1 + b8 x\nc2 x = 1 + c1 x\nc3 x = 1 + c2 x\nc4 x = 1 + c3 x\nc5 x = 1 + c4 x\nc6 x = 1 + c5 x\nc7 x = 1 + c6 x\nc8 x = 1 + c7 x\n\nd1 x = 1 + c8 x\nd2 x = 1 + d1 x\nd3 x = 1 + d2 x\nd4 x = 1 + d3 x\nd5 x = 1 + d4 x\nd6 x = 1 + d5 x\nd7 x = 1 + d6 x\nd8 x = 1 + d7 x\n\ne1 x = 1 + d8 x\ne2 x = 1 + e1 x\ne3 x = 1 + e2 x\ne4 x = 1 + e3 x\ne5 x = 1 + e4 x\ne6 x = 1 + e5 x\ne7 x = 1 + e6 x\ne8 x = 1 + e7 x\n\nf1 x = 1 + e8 x\nf2 x = 1 + f1 x\nf3 x = 1 + f2 x\nf4 x = 1 + f3 x\nf5 x = 1 + f4 x\nf6 x = 1 + f5 x\nf7 x = 1 + f6 x\nf8 x = 1 + f7 x\n\ng1 x = 1 + f8 x\ng2 x = 1 + g1 x\ng3 x = 1 + g2 x\ng4 x = 1 + g3 x\ng5 x = 1 + g4 x\ng6 x = 1 + g5 x\ng7 x = 1 + g6 x\ng8 x = 1 + g7 x\n\nh1 x = 1 + g8 x\nh2 x = 1 + h1 x\nh3 x = 1 + h2 x\nh4 x = 1 + h3 x\nh5 x = 1 + h4 x\nh6 x = 1 + h5 x\nh7 x = 1 + h6 x\nh8 x = 1 + h7 x\n\nk1 x = 1 + h8 x\nk2 x = 1 + k1 x\nk3 x = 1 + k2 x\nk4 x = 1 + k3 x\nk5 x = 1 + k4 x\nk6 x = 1 + k5 x\nk7 x = 1 + k6 x\nk8 x = 1 + k7 x\n\n\nmain = print (a1 3)", "num_lines": 93}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Desugaring of massive pattern bindings\n-- Fails in GHC 6.0 without -O\n\nmodule Main where\n\n[a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,\n a18,a19,a20,a21,a22,a23,a24,a25,a26,a27,a28,a29,a30,a31,a32,\n a33,a34,a35,a36,a37,a38,a39,a40,a41,a42,a43,a44,a45,a46,a47,\n a48,a49,a50,a51,a52,a53,a54,a55,a56,a57,a58,a59,a60,a61,a62,a63] = \n   [0..63]\n\nmain = print a62\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\n-- This one killed GHC 6.4.1, because the pattern match on the\n-- unboxed tuple generates a failure case, which defeated the\n-- rather fragile code in the desugarer\n-- See DsExpr.lhs, the HsCase case\n\nmodule Main where\n\nfoo xs ys = case (# null xs, null ys #) of\n              (# True, False #) -> \"One\"\n              (# False, True #) -> \"Two\"\n\nmain :: IO ()\nmain = print (foo [] \"ok\")\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\nimport Debug.Trace\n\n{-# NOINLINE f #-}\nf :: a -> b -> (# a,b #)\nf x y = x `seq` y `seq` (# x,y #)\n\ng :: Int -> Int -> Int\ng v w = case f v w of\n          (# a,b #) -> a+b\n\nmain = print (g (trace \"one\" 1) (trace \"two\" 2))\n-- The args should be evaluated in the right order!\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XRecordWildCards -XNamedFieldPuns #-}\n\n-- This is a very partial test of the record-wildcard extension\n-- but better than nothing\n\nmodule Main where\n\ndata T = C { x :: Int, y :: Int }\n       | D { x :: Int, b :: Bool }\n\nselect :: T -> Int\nselect = x\n\nf :: (T,T) -> Int\nf v = let (C {..}, d) = v in Main.x d\n\nmkC a =\n    let x = a + 1\n        y = a * 2\n    in  C{..}\n\nsumC C{..} = x + y\n\nfoo x b =\n    let y = x+1\n    in  (C{..}, let x = 100 in D{..})\n\nbar a =\n    let (C{..}, d) = a\n    in  (x + y + Main.x d, let D{..} = d in b)\n\nmain = do\n    print $ sumC $ mkC 10\n    print $ bar $ foo 5 True\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests grouping WITH a using clause but WITHOUT a by clause\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(inits)\n\nmain = putStrLn (show output)\n  where\n    output = [ x\n             | y <- [1..3]\n             , x <- \"hello\"\n             , then group using inits ]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests grouping WITH a by clause\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nimport GHC.Exts(the,groupWith)\n\nmain = putStrLn (show output)\n  where\n    output = [ (the dept, sum salary, name)\n             | (dept, salary, name) <- [(\"A\", 1, \"Bob\"), (\"B\", 2, \"Fred\"), (\"A\", 5, \"Jim\"), (\"A\", 9, \"Jim\")]\n             , then group by dept using groupWith ]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test grouping with both a using and a by clause\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(groupBy)\nimport GHC.Exts(the)\n\ngroupRuns :: Eq b => (a -> b) -> [a] -> [[a]]\ngroupRuns f = groupBy (\\x y -> f x == f y)\n\nmain = putStrLn (show output)\n  where\n    output = [ (the x, product y)\n             | x <- ([1, 1, 1, 2, 2, 1, 3])\n             , y <- [4..6]\n             , then group by x using groupRuns ]", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test transform WITHOUT a by clause\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nmain = putStrLn (show output)\n  where\n    output = [ x \n             | x <- [1..10]\n             , then take 5 ]", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests transform WITH a by clause\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(takeWhile)\n\nmain = putStrLn (show output)\n  where\n    output = [ (x * 10) + y\n             | x <- [1..4]\n             , y <- [1..4]\n             , then takeWhile by (x + y) < 4]", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Transformation stress test\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(takeWhile)\nimport GHC.Exts(sortWith)\n\nemployees = [ (\"Simon\", \"MS\", 80)\n            , (\"Erik\", \"MS\", 100)\n            , (\"Phil\", \"Ed\", 40)\n            , (\"Gordon\", \"Ed\", 45)\n            , (\"Paul\", \"Yale\", 60)]\n\nmain = putStrLn (show output)\n  where\n    output = [ (dept, salary)\n             | (name, dept, salary) <- employees\n             , then sortWith by salary\n             , then filter by salary > 50\n             , then take 1 ]\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Transformation and grouping stress test\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nimport GHC.Exts(sortWith, the, groupWith)\n\nemployees = [ (\"Simon\", \"MS\", 80)\n            , (\"Erik\", \"MS\", 100)\n            , (\"Phil\", \"Ed\", 40)\n            , (\"Gordon\", \"Ed\", 45)\n            , (\"Paul\", \"Yale\", 60) ]\n\nmain = putStrLn (show can_still_use_group_function) >> putStrLn (show output)\n  where\n    output = [ (the dept, map sum salary, (show x) ++ \" and \" ++ (show y)) \n             | (name, dept, salary) <- employees\n             , then group by dept using groupWith\n             , x <- [1, 2, 3]\n             , y <- [4, 5, 6]\n             , then sortWith by sum salary\n             , then take 4\n             , then group using replicate 2 ]\n    group = const \"my group function called!\"\n    can_still_use_group_function = group \"Mississippi\"", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- \"Big tuple\" stress test for parallel and transform comprehensions\n\n{-# OPTIONS_GHC -XTransformListComp -XParallelListComp #-}\n\nmodule Main where\n\nmain = putStrLn (show output)\n  where\n    output = [ x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 +\n               x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 +\n               x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 +\n               x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 +\n               x40 + x41 + x42 + x43 + x44 + x45 + x46 + x47 + x48 + x49 +\n               x50 + x51 + x52 + x53 + x54 + x55 + x56 + x57 + x58 + x59 +\n               x60 + x61 + x62 + x63 + x64 + x65 + x66 + x67 + x68 + x69 +\n               x70 + x71 + x72 + x73 + x74 + x75 + x76 + x77 + x78 + x79 +\n               x80 + x81 + x82 + x83 + x84 + x85 + x86 + x87 + x88 + x89 +\n               x90 + x91 + x92 + x93 + x94 + x95 + x96 + x97 + x98 + x99 +\n               y\n             | x0 <- [0], x1 <- [1], x2 <- [2], x3 <- [3], x4 <- [4]\n             , x5 <- [5], x6 <- [6], x7 <- [7], x8 <- [8], x9 <- [9]\n             , x10 <- [0], x11 <- [1], x12 <- [2], x13 <- [3], x14 <- [4]\n             , x15 <- [5], x16 <- [6], x17 <- [7], x18 <- [8], x19 <- [9]\n             , x20 <- [0], x21 <- [1], x22 <- [2], x23 <- [3], x24 <- [4]\n             , x25 <- [5], x26 <- [6], x27 <- [7], x28 <- [8], x29 <- [9]\n             , x30 <- [0], x31 <- [1], x32 <- [2], x33 <- [3], x34 <- [4]\n             , x35 <- [5], x36 <- [6], x37 <- [7], x38 <- [8], x39 <- [9]\n             , x40 <- [0], x41 <- [1], x42 <- [2], x43 <- [3], x44 <- [4]\n             , x45 <- [5], x46 <- [6], x47 <- [7], x48 <- [8], x49 <- [9]\n             , x50 <- [0], x51 <- [1], x52 <- [2], x53 <- [3], x54 <- [4]\n             , x55 <- [5], x56 <- [6], x57 <- [7], x58 <- [8], x59 <- [9]\n             , x60 <- [0], x61 <- [1], x62 <- [2], x63 <- [3], x64 <- [4]\n             , x65 <- [5], x66 <- [6], x67 <- [7], x68 <- [8], x69 <- [9]\n             , x70 <- [0], x71 <- [1], x72 <- [2], x73 <- [3], x74 <- [4]\n             , x75 <- [5], x76 <- [6], x77 <- [7], x78 <- [8], x79 <- [9]\n             , x80 <- [0], x81 <- [1], x82 <- [2], x83 <- [3], x84 <- [4]\n             , x85 <- [5], x86 <- [6], x87 <- [7], x88 <- [8], x89 <- [9]\n             , x90 <- [0], x91 <- [1], x92 <- [2], x93 <- [3], x94 <- [4]\n             , x95 <- [5], x96 <- [6], x97 <- [7], x98 <- [8], x99 <- [9]\n             , then take 4\n             | y <- [10] ]", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE StaticPointers       #-}\n\nimport Data.Typeable\nimport GHC.StaticPtr\n\nmain = putStr $ unlines $ map show names\n  where\n    names =\n      [ staticPtrInfo $ static g\n      , staticPtrInfo $ (static id :: StaticPtr (Int -> Int))\n      , staticPtrInfo $ (p0 :: StaticPtr (Int -> Int))\n      , staticPtrInfo $ (static method :: StaticPtr (Char -> Int))\n      , staticPtrInfo $ (static t_field :: StaticPtr (T Int -> Int))\n      ]\n\ng :: Int -> Int\ng = id\n\np0 :: Typeable a => StaticPtr (a -> a)\np0 = static (\\x -> x)\n\ndata T a = T { t_field :: a }\n  deriving Typeable\n\nclass C1 a where\n  method :: a -> Int\n\ninstance C1 Char where\n  method = const 0\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Strict #-}\n{-# OPTIONS_GHC -fno-warn-unused-binds #-}\nmodule Main where\n\nimport Debug.Trace\n\nf0 a = \"fun\"\nf0' ~a = \"fun2\"\n\nf1 ~n =\n  case n of\n    a -> \"case\"\nf1' ~n =\n  case n of\n    ~a -> \"case2\"\n\nf2 = \\a -> \"lambda\"\nf2' = \\ ~a -> \"lambda2\"\n\nnewtype Age = MkAge Int\n\nf4, f4' :: Age -> String\nf4 (MkAge a) = \"newtype\"\nf4' ~(MkAge a) = \"newtype2\"\n\nmain :: IO ()\nmain = mapM_ (\\(what,f) -> putStrLn (f (v what))) fs\n  where fs =\n          [(\"fun\",f0 )\n          ,(\"fun lazy\",f0')\n          ,(\"case\",f1)\n          ,(\"case lazy\",f1')\n          ,(\"lambda\",f2)\n          ,(\"lambda lazy\",f2')\n          ,(\"newtype\",(\\ ~i -> f4 (MkAge i)))\n          ,(\"newtype lazy\",(\\ ~i -> f4' (MkAge i)))]\n        v n = trace (\"evaluated in \" ++ n) 1\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, StrictData, GADTs #-}\n\n-- | Tests the StrictData LANGUAGE pragma.\nmodule Main where\n\nimport qualified Control.Exception as E\nimport System.IO.Unsafe (unsafePerformIO)\n\ndata Strict a = S a\ndata Strict2 b = S2 !b\ndata Strict3 c where\n  S3 :: c -> Strict3 c\n\ndata UStrict = US {-# UNPACK #-} Int\n\ndata Lazy d = L ~d\ndata Lazy2 e where\n  L2 :: ~e -> Lazy2 e\n\nmain :: IO ()\nmain =\n  do print (isBottom (S bottom))\n     print (isBottom (S2 bottom))\n     print (isBottom (US bottom))\n     print (isBottom (S3 bottom))\n     putStrLn \"\"\n     print (not (isBottom (L bottom)))\n     print (not (isBottom (L2 bottom)))\n     print (not (isBottom (Just bottom))) -- sanity check\n\n------------------------------------------------------------------------\n-- Support for testing for bottom\n\nbottom :: a\nbottom = error \"_|_\"\n\nisBottom :: a -> Bool\nisBottom f = unsafePerformIO $\n  (E.evaluate f >> return False) `E.catches`\n    [ E.Handler (\\(_ :: E.ArrayException)   -> return True)\n    , E.Handler (\\(_ :: E.ErrorCall)        -> return True)\n    , E.Handler (\\(_ :: E.NoMethodError)    -> return True)\n    , E.Handler (\\(_ :: E.NonTermination)   -> return True)\n    , E.Handler (\\(_ :: E.PatternMatchFail) -> return True)\n    , E.Handler (\\(_ :: E.RecConError)      -> return True)\n    , E.Handler (\\(_ :: E.RecSelError)      -> return True)\n    , E.Handler (\\(_ :: E.RecUpdError)      -> return True)\n    ]\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Strict #-}\nmodule Main where\n\nimport Debug.Trace\n\nmain = let False = trace \"no binders\" False -- evaluated\n\n           a :: a -> a\n           a = trace \"polymorphic\" id -- evaluated\n\n           f :: Eq a => a -> a -> Bool\n           f = trace \"overloaded\" (==) -- not evaluated\n\n           xs :: [Int]\n           xs = (trace \"recursive\" (:) 1 xs) -- evaluated\n       in return ()\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Transformation and grouping stress test\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule Main where\n\nimport GHC.Exts(sortWith, the, groupWith)\n\nemployees = [ (\"Simon\", \"MS\", 80)\n            , (\"Erik\", \"MS\", 100)\n            , (\"Phil\", \"Ed\", 40)\n            , (\"Gordon\", \"Ed\", 45)\n            , (\"Paul\", \"Yale\", 60) ]\n\nmain = putStrLn (show can_still_use_group_function) >> putStrLn (show output)\n  where\n    output = [ (the dept, map sum salary, (show x) ++ \" and \" ++ (show y)) \n             | (name, dept, salary) <- employees\n             , then group by dept using groupWith\n             , x <- [1, 2, 3]\n             , y <- [4, 5, 6]\n             , then sortWith by sum salary\n             , then take 4\n             , then group using replicate 2 ]\n    group = const \"my group function called!\"\n    can_still_use_group_function = group \"Mississippi\"\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Transformation stress test\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(takeWhile)\nimport GHC.Exts(sortWith)\n\nemployees = [ (\"Simon\", \"MS\", 80)\n            , (\"Erik\", \"MS\", 100)\n            , (\"Phil\", \"Ed\", 40)\n            , (\"Gordon\", \"Ed\", 45)\n            , (\"Paul\", \"Yale\", 60)]\n\nmain = putStrLn (show output)\n  where\n    output = [ (dept, salary) \n             | (name, dept, salary) <- employees\n             , then sortWith by salary\n             , then filter by salary > 50\n             , then take 1 ]\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- \"Big tuple\" stress test for monad comprehensions\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp -XParallelListComp #-}\n\nmodule Main where\n\nmain = putStrLn (show output)\n  where\n    output = [ x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 +\n               x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 +\n               x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 +\n               x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 +\n               x40 + x41 + x42 + x43 + x44 + x45 + x46 + x47 + x48 + x49 +\n               x50 + x51 + x52 + x53 + x54 + x55 + x56 + x57 + x58 + x59 +\n               x60 + x61 + x62 + x63 + x64 + x65 + x66 + x67 + x68 + x69 +\n               x70 + x71 + x72 + x73 + x74 + x75 + x76 + x77 + x78 + x79 +\n               x80 + x81 + x82 + x83 + x84 + x85 + x86 + x87 + x88 + x89 +\n               x90 + x91 + x92 + x93 + x94 + x95 + x96 + x97 + x98 + x99 +\n               y\n             | x0 <- [0], x1 <- [1], x2 <- [2], x3 <- [3], x4 <- [4]\n             , x5 <- [5], x6 <- [6], x7 <- [7], x8 <- [8], x9 <- [9]\n             , x10 <- [0], x11 <- [1], x12 <- [2], x13 <- [3], x14 <- [4]\n             , x15 <- [5], x16 <- [6], x17 <- [7], x18 <- [8], x19 <- [9]\n             , x20 <- [0], x21 <- [1], x22 <- [2], x23 <- [3], x24 <- [4]\n             , x25 <- [5], x26 <- [6], x27 <- [7], x28 <- [8], x29 <- [9]\n             , x30 <- [0], x31 <- [1], x32 <- [2], x33 <- [3], x34 <- [4]\n             , x35 <- [5], x36 <- [6], x37 <- [7], x38 <- [8], x39 <- [9]\n             , x40 <- [0], x41 <- [1], x42 <- [2], x43 <- [3], x44 <- [4]\n             , x45 <- [5], x46 <- [6], x47 <- [7], x48 <- [8], x49 <- [9]\n             , x50 <- [0], x51 <- [1], x52 <- [2], x53 <- [3], x54 <- [4]\n             , x55 <- [5], x56 <- [6], x57 <- [7], x58 <- [8], x59 <- [9]\n             , x60 <- [0], x61 <- [1], x62 <- [2], x63 <- [3], x64 <- [4]\n             , x65 <- [5], x66 <- [6], x67 <- [7], x68 <- [8], x69 <- [9]\n             , x70 <- [0], x71 <- [1], x72 <- [2], x73 <- [3], x74 <- [4]\n             , x75 <- [5], x76 <- [6], x77 <- [7], x78 <- [8], x79 <- [9]\n             , x80 <- [0], x81 <- [1], x82 <- [2], x83 <- [3], x84 <- [4]\n             , x85 <- [5], x86 <- [6], x87 <- [7], x88 <- [8], x89 <- [9]\n             , x90 <- [0], x91 <- [1], x92 <- [2], x93 <- [3], x94 <- [4]\n             , x95 <- [5], x96 <- [6], x97 <- [7], x98 <- [8], x99 <- [9]\n             , then take 4\n             | y <- [10] ]\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests grouping WITH a using clause but WITHOUT a by clause\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(inits)\n\nmain = putStrLn (show output)\n  where\n    output = [ x\n             | y <- [1..3]\n             , x <- \"hello\"\n             , then group using inits ]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test transform WITHOUT a by clause\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule Main where\n\nmain = putStrLn (show output)\n  where\n    output = [ x \n             | x <- [1..10]\n             , then take 5 ]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test grouping with both a using and a by clause\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(groupBy)\nimport GHC.Exts(the)\n\ngroupRuns :: Eq b => (a -> b) -> [a] -> [[a]]\ngroupRuns f = groupBy (\\x y -> f x == f y)\n\nmain = putStrLn (show output)\n  where\n    output = [ (the x, product y)\n             | x <- ([1, 1, 1, 2, 2, 1, 3])\n             , y <- [4..6]\n             , then group by x using groupRuns ]\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests transform WITH a by clause\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule Main where\n\nimport Data.List(takeWhile)\n\nmain = putStrLn (show output)\n  where\n    output = [ (x * 10) + y\n             | x <- [1..4]\n             , y <- [1..4]\n             , then takeWhile by (x + y) < 4]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests grouping WITH a by clause\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule Main where\n\nimport GHC.Exts(the, groupWith)\n\nmain = putStrLn (show output)\n  where\n    output = [ (the dept, sum salary, name) \n             | (dept, salary, name) <- [(\"A\", 1, \"Bob\"), (\"B\", 2, \"Fred\"), (\"A\", 5, \"Jim\"), (\"A\", 9, \"Jim\")]\n             , then group by dept using groupWith]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "testF :: Float -> Bool\ntestF x = x == 0 && not (isNegativeZero x)\n\ntestD :: Double -> Bool\ntestD x = x == 0 && not (isNegativeZero x)\n\nmain :: IO ()\nmain = do print $ testF (-0.0)\n          print $ testD (-0.0)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Strict #-}\n\nmodule Main where\n\nmain = do\n  ~a <- return (error \"don't error here!\")\n  b <- return (error \"error here!\") -- this binding should be strict\n  print \"should never reach here\"\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\nmain :: IO ()\nmain = let !_ = (undefined :: ()) in print 2\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\n-- This should fail evern though y is unused\nf x = let !(Just (Just y)) = Just undefined in True\n\nmain = print (f False)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables, Strict, TypeApplications\n             #-}\n\nimport Data.Typeable\n\nzero :: forall x. Typeable x => Maybe x\nzero = do\n    Refl <- eqT @Int @x\n    pure 0\n\nmain :: IO ()\nmain = print (zero @())\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Main where\n\nimport GHC.Base\n\n-- In Trac #12595 a bogus desugaring led (bizarrely)\n-- to a top-level binding maxInt = maxInt\n-- This test just checks that doesn't happen again\n\nmain = print (let !x = maxInt in even x)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- Main.hs\nimport GHC.Stack\n\nmain :: IO ()\nmain = do\n  foo 23 42\n  (`foo` 23) 42\n\nfoo :: HasCallStack => Int -> Int -> IO ()\nfoo _ _ = print (length . getCallStack $ callStack)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n-- Test Trac #246\n\nmodule Main where\n\nimport Control.Exception\n\ndata T = T { x :: Bool, y :: Bool }\n\nf (T { y=True, x=True }) = \"Odd\"\nf _                      = \"OK\"\n\ng (T { x=True, y=True }) = \"Odd2\"\ng _                      = \"Odd3\"\n\nfunny = T { x = undefined, y = False }\n\nmain = do { print (f funny)  -- Should work, because we test\n                             -- y first, which fails, and falls\n                             -- through to \"OK\"\n\n          ; Control.Exception.catch\n                  (print (g funny))        -- Should fail, because we test\n                  (\\(_::SomeException) -> print \"caught\")   -- x first, and hit \"undefined\"\n          }\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Main where\nimport Data.String\n\n-- {{{ Num literals\nnewtype N = N Int deriving (Show,Eq)\n\ninstance Num N where\n  fromInteger 0 = error \"0\"\n  fromInteger 1 = N 0\n  fromInteger _ = N 1\n\nf x = case x of\n        1 -> False\n        0 -> True\n\ng x = case x of\n        1 -> False\n        _ -> case x of\n              0 -> True\n              _ -> error \"No match\"\n\ntestNum = do\n  print $ g (N 0)\n  print $ f (N 0)\n\n-- }}}\n\n-- {{{ IsString literals\nnewtype S = S String deriving Eq\n\ninstance IsString S where \n  fromString []    = error \"[]\"\n  fromString (_:_) = S \".\"\n\nfs x = case x of\n        \".\" -> False\n        \"\"  -> True\n\ngs x = case x of\n        \".\" -> False\n        _   -> case x of\n                 \"\" -> True\n                 _  -> error \"No match\"\n\ntestIsString = do\n  print $ gs (S \".\")\n  print $ fs (S \".\")\n\n-- }}}\n\nmain = do { testNum; testIsString }\n\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XOverloadedStrings #-}\nmodule Main where\n\nimport Data.String\n\ninstance IsString Int where\n         fromString x = 1337\n\nf :: Int -> String\nf \"hello\" = \"correct\"\nf _       = \"false\"\n\nmain = do print $ f 1337\n          print $ f 1338\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DoRec #-}\n\nmodule Main where\n\nmain = do { x <- foo; print x }\nfoo :: IO Int\nfoo = do rec \n             a1 <- return a2\n             a2 <- return a3\n             a3 <- return a4\n             a4 <- return a5\n             a5 <- return b1\n\n             b1 <- return b2\n             b2 <- return b3\n             b3 <- return b4\n             b4 <- return b5\n             b5 <- return c1\n\n             c1 <- return c2\n             c2 <- return c3\n             c3 <- return c4\n             c4 <- return c5\n             c5 <- return d1\n\n             d1 <- return d2\n             d2 <- return d3\n             d3 <- return d4\n             d4 <- return d5\n             d5 <- return a1x\n\n             a1x <- return a2x\n             a2x <- return a3x\n             a3x <- return a4x\n             a4x <- return a5x\n             a5x <- return b1x\n\n             b1x <- return b2x\n             b2x <- return b3x\n             b3x <- return b4x\n             b4x <- return b5x\n             b5x <- return c1x\n\n             c1x <- return c2x\n             c2x <- return c3x\n             c3x <- return c4x\n             c4x <- return c5x\n             c5x <- return d1x\n\n             d1x <- return d2x\n             d2x <- return d3x\n             d3x <- return d4x\n             d4x <- return d5x\n             d5x <- return a1y\n\n             a1y <- return a2y\n             a2y <- return a3y\n             a3y <- return a4y\n             a4y <- return a5y\n             a5y <- return b1y\n\n             b1y <- return b2y\n             b2y <- return b3y\n             b3y <- return b4y\n             b4y <- return b5y\n             b5y <- return c1y\n\n             c1y <- return c2y\n             c2y <- return c3y\n             c3y <- return c4y\n             c4y <- return c5y\n             c5y <- return d1y\n\n             d1y <- return d2y\n             d2y <- return d3y\n             d3y <- return d4y\n             d4y <- return d5y\n             d5y <- return a1z\n\n             a1z <- return a2z\n             a2z <- return a3z\n             a3z <- return a4z\n             a4z <- return a5z\n             a5z <- return b1z\n\n             b1z <- return b2z\n             b2z <- return b3z\n             b3z <- return b4z\n             b4z <- return b5z\n             b5z <- return c1z\n\n             c1z <- return c2z\n             c2z <- return c3z\n             c3z <- return c4z\n             c4z <- return c5z\n             c5z <- return d1z\n\n             d1z <- return d2z\n             d2z <- return d3z\n             d3z <- return d4z\n             d4z <- return d5z\n             d5z <- return 1\n\n         return a4\n\n", "num_lines": 106}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\nmain = print (case Nothing of\n                  !(~(Just x)) -> \"ok\"\n                  Nothing   -> \"bad\")\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "compareDouble :: Double -> Double -> Ordering\ncompareDouble x y =\n       case (isNaN x, isNaN y) of\n       (True, True)   -> EQ\n       (True, False)  -> LT\n       (False, True)  -> GT\n       (False, False) ->\n          -- Make -0 less than 0\n          case (x == 0, y == 0, isNegativeZero x, isNegativeZero y) of\n          (True, True, True, False) -> LT\n          (True, True, False, True) -> GT\n          _                         -> x `compare` y\n\nmain = do\n    let l = [-0, 0]\n    print [ (x, y, compareDouble x y) | x <- l, y <- l ]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Main where\nimport Debug.Trace\n\nnewtype N = N Int\n\nf0 :: N -> Int\nf0 n = case n of\n  !(N _) -> 0\n\nf1 :: N -> Int\nf1 n = n `seq` case n of\n  N _ -> 0\n\nf2 :: N -> Int\nf2 n = case n of\n  !(N {}) -> 0\n\nf3 :: N -> Int\nf3 n = n `seq` case n of\n  N {} -> 0\n\n\n\nmain = do\n  print $ f0 (trace \"evaluated f0\" (N 1))\n  print $ f1 (trace \"evaluated f1\" (N 1))\n\n  print $ f2 (trace \"evaluated f2\" (N 1))\n  print $ f3 (trace \"evaluated f3\" (N 1))\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Digraph\n\nmain = mapM_ print\n  [ test001\n  , test002\n  , test003\n  , test004\n  ]\n\n-- These check that the result of SCCs doesn't depend on the order of the key\n-- type (Int here).\n\ntest001 = testSCC [(\"a\", 1, []), (\"b\", 2, []), (\"c\", 3, [])]\n\ntest002 = testSCC [(\"a\", 2, []), (\"b\", 3, []), (\"c\", 1, [])]\n\ntest003 = testSCC [(\"b\", 1, []), (\"c\", 2, []), (\"a\", 3, [])]\n\ntest004 = testSCC [(\"b\", 2, []), (\"c\", 3, []), (\"a\", 1, [])]\n\ntestSCC = flattenSCCs . stronglyConnCompFromEdgedVerticesOrd . map toNode\n  where\n    toNode (a, b, c) = DigraphNode a b c\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\n-- This is a repro for the issue where to fingerprint a record, field labels\n-- were pulled from FastStringEnv in the order of Uniques which are known\n-- to have arbitrary order - see Note [Unique Determinism] in Unique.\n\ndata B = C\n  { e :: ()\n  , d :: ()\n  }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A () where\n\n-- This checks that the order of dictionary binds doesn't depend on the\n-- order of Uniques.\n-- Consider succ from Enum, it requires Num Int and Eq Int. The order of\n-- let binds used to depend on the order of Uniques. Consider:\n--\n--  let $dEq = GHC.Classes.$fEqInt in\n--  let $$dNum = GHC.Num.$fNumInt in ...\n--\n--  vs\n--\n--  let $dNum = GHC.Num.$fNumInt in\n--  let $dEq = GHC.Classes.$fEqInt in ...\n\ndata B = C\n  deriving (Enum)\n\nf :: Int -> Int\nf n\n  | n >= 0 = 0\n  | otherwise = 0\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, StarIsType\n           , DataKinds\n           , PolyKinds\n           , TypeFamilies\n           , GADTs\n           , UndecidableInstances\n           , RankNTypes\n           , ScopedTypeVariables\n  #-}\n\n{-# OPTIONS_GHC -Wall #-}\n{-# OPTIONS_GHC -Werror #-}\n{-# OPTIONS_GHC -O1 -fspec-constr #-}\n\n{-\n\nWith reversed order of allocated uniques the type variables would be in\nwrong order:\n\n*** Core Lint errors : in result of SpecConstr ***\ndeterm004.hs:88:12: warning:\n    [in body of lambda with binder m_azbFg :: a_afdP_azbON]\n    @ (a_afdP_azbON :: BOX) is out of scope\n*** Offending Program ***\n\n...\n\nRec {\n$s$wsFoldr1_szbtK\n  :: forall (m_azbFg :: a_afdP_azbON)\n            (x_azbOM :: TyFun\n                          a_afdP_azbON (TyFun a_afdP_azbON a_afdP_azbON -> *)\n                        -> *)\n            (a_afdP_azbON :: BOX)\n            (ipv_szbwN :: a_afdP_azbON)\n            (ipv_szbwO :: [a_afdP_azbON]).\n     R:Sing[]z (ipv_szbwN : ipv_szbwO)\n     ~R# Sing (Apply (Apply (:$) ipv_szbwN) ipv_szbwO)\n     -> Sing ipv_szbwO\n     -> Sing ipv_szbwN\n     -> (forall (t_azbNM :: a_afdP_azbON).\n         Sing t_azbNM -> Sing (Apply x_azbOM t_azbNM))\n     -> Sing\n          (Apply\n             (Apply Foldr1Sym0 x_azbOM)\n             (Let1627448493XsSym4 x_azbOM m_azbFg ipv_szbwN ipv_szbwO))\n[LclId,\n Arity=4,\n Str=<L,U><L,U><L,U><C(S(C(S))),C(U(1*C1(U)))>]\n$s$wsFoldr1_szbtK =\n  \\ (@ (m_azbFg :: a_afdP_azbON))\n    (@ (x_azbOM :: TyFun\n                     a_afdP_azbON (TyFun a_afdP_azbON a_afdP_azbON -> *)\n                   -> *))\n    (@ (a_afdP_azbON :: BOX))\n    (@ (ipv_szbwN :: a_afdP_azbON))\n    (@ (ipv_szbwO :: [a_afdP_azbON]))\n    (sg_szbtL\n       :: R:Sing[]z (ipv_szbwN : ipv_szbwO)\n          ~R# Sing (Apply (Apply (:$) ipv_szbwN) ipv_szbwO))\n    (sc_szbtM :: Sing ipv_szbwO)\n    (sc_szbtN :: Sing ipv_szbwN)\n    (sc_szbtP\n       :: forall (t_azbNM :: a_afdP_azbON).\n          Sing t_azbNM -> Sing (Apply x_azbOM t_azbNM)) ->\n    case (SCons\n            @ a_afdP_azbON\n            @ (ipv_szbwN : ipv_szbwO)\n            @ ipv_szbwO\n            @ ipv_szbwN\n            @~ (<ipv_szbwN : ipv_szbwO>_N\n                :: (ipv_szbwN : ipv_szbwO) ~# (ipv_szbwN : ipv_szbwO))\n            sc_szbtN\n            sc_szbtM)\n         `cast` (sg_szbtL\n                 ; TFCo:R:Sing[]z[0] <a_afdP_azbON>_N <Let1627448493XsSym4\n                                                         x_azbOM m_azbFg ipv_szbwN ipv_szbwO>_N\n                 :: R:Sing[]z (ipv_szbwN : ipv_szbwO)\n                    ~R# R:Sing[]z\n                          (Let1627448493XsSym4 x_azbOM m_azbFg ipv_szbwN ipv_szbwO))\n    of wild_XD {\n      SNil dt_dzbxX ->\n        (lvl_szbwi @ a_afdP_azbON)\n        `cast` ((Sing\n                   (Sym (TFCo:R:Foldr1[2] <a_afdP_azbON>_N <x_azbOM>_N)\n                    ; Sym\n                        (TFCo:R:Apply[]kFoldr1Sym1l_afe2[0]\n                           <a_afdP_azbON>_N <'[]>_N <x_azbOM>_N)\n                    ; (Apply\n                         (Sym\n                            (TFCo:R:Apply(->)(->)Foldr1Sym0l[0] <a_afdP_azbON>_N <x_azbOM>_N))\n                         (Sym dt_dzbxX))_N))_R\n                :: Sing (Apply ErrorSym0 \"Data.Singletons.List.foldr1: empty list\")\n                   ~R# Sing\n                         (Apply\n                            (Apply Foldr1Sym0 x_azbOM)\n                            (Let1627448493XsSym4 x_azbOM m_azbFg ipv_szbwN ipv_szbwO)));\n      SCons @ n_azbFh @ m_XzbGe dt_dzbxK _sX_azbOH\n            ds_dzbyu [Dmd=<S,1*U>] ->\n        case ds_dzbyu\n             `cast` (TFCo:R:Sing[]z[0] <a_afdP_azbON>_N <n_azbFh>_N\n                     :: Sing n_azbFh ~R# R:Sing[]z n_azbFh)\n        of wild_Xo {\n          SNil dt_dzbxk ->\n            (lvl_szbw1 @ a_afdP_azbON @ m_XzbGe)\n            `cast` ((Sing\n                       (Sym (TFCo:R:Foldr1[0] <a_afdP_azbON>_N <m_XzbGe>_N <x_azbOM>_N)\n                        ; Sym\n                            (TFCo:R:Apply[]kFoldr1Sym1l_afe2[0]\n                               <a_afdP_azbON>_N <'[m_XzbGe]>_N <x_azbOM>_N)\n                        ; (Apply\n                             (Sym\n                                (TFCo:R:Apply(->)(->)Foldr1Sym0l[0] <a_afdP_azbON>_N <x_azbOM>_N))\n                             ((<m_XzbGe>_N ': Sym dt_dzbxk)_N ; Sym dt_dzbxK))_N))_R\n                    :: Sing m_XzbGe\n                       ~R# Sing\n                             (Apply\n                                (Apply Foldr1Sym0 x_azbOM)\n                                (Let1627448493XsSym4 x_azbOM m_azbFg ipv_szbwN ipv_szbwO)));\n          SCons @ ipv_XzbxR @ ipv_XzbyV ipv_szbwM ipv_szbwL ipv_szbwK ->\n            case (sc_szbtP @ m_XzbGe _sX_azbOH)\n                 `cast` (TFCo:R:Sing(->)f[0]\n                           <a_afdP_azbON>_N <a_afdP_azbON>_N <Apply x_azbOM m_XzbGe>_N\n                         :: Sing (Apply x_azbOM m_XzbGe)\n                            ~R# R:Sing(->)f (Apply x_azbOM m_XzbGe))\n            of wild_X3X { SLambda ds_XzbBr [Dmd=<C(S),1*C1(U)>] ->\n            (ds_XzbBr\n               @ (Foldr1 x_azbOM (ipv_XzbyV : ipv_XzbxR))\n               (($wsFoldr1_szbuc\n                   @ a_afdP_azbON\n                   @ x_azbOM\n                   @ (Let1627448493XsSym4 x_azbOM m_XzbGe ipv_XzbyV ipv_XzbxR)\n                   sc_szbtP\n                   ((SCons\n                       @ a_afdP_azbON\n                       @ (ipv_XzbyV : ipv_XzbxR)\n                       @ ipv_XzbxR\n                       @ ipv_XzbyV\n                       @~ (<ipv_XzbyV : ipv_XzbxR>_N\n                           :: (ipv_XzbyV : ipv_XzbxR) ~# (ipv_XzbyV : ipv_XzbxR))\n                       ipv_szbwL\n                       ipv_szbwK)\n                    `cast` (Sym (TFCo:R:Sing[]z[0] <a_afdP_azbON>_N) (Sym\n                                                                        (TFCo:R:Apply[][]:$$i[0]\n                                                                           <a_afdP_azbON>_N\n                                                                           <ipv_XzbxR>_N\n                                                                           <ipv_XzbyV>_N)\n                                                                      ; (Apply\n                                                                           (Sym\n                                                                              (TFCo:R:Applyk(->):$l[0]\n                                                                                 <a_afdP_azbON>_N\n                                                                                 <ipv_XzbyV>_N))\n                                                                           <ipv_XzbxR>_N)_N)\n                            :: R:Sing[]z (ipv_XzbyV : ipv_XzbxR)\n                               ~R# Sing (Apply (Apply (:$) ipv_XzbyV) ipv_XzbxR))))\n                `cast` ((Sing\n                           ((Apply\n                               (TFCo:R:Apply(->)(->)Foldr1Sym0l[0] <a_afdP_azbON>_N <x_azbOM>_N)\n                               <Let1627448493XsSym4 x_azbOM m_XzbGe ipv_XzbyV ipv_XzbxR>_N)_N\n                            ; TFCo:R:Apply[]kFoldr1Sym1l_afe2[0]\n                                <a_afdP_azbON>_N\n                                ((Apply\n                                    (TFCo:R:Applyk(->):$l[0] <a_afdP_azbON>_N <ipv_XzbyV>_N)\n                                    <ipv_XzbxR>_N)_N\n                                 ; TFCo:R:Apply[][]:$$i[0]\n                                     <a_afdP_azbON>_N <ipv_XzbxR>_N <ipv_XzbyV>_N)\n                                <x_azbOM>_N))_R\n                        :: Sing\n                             (Apply\n                                (Apply Foldr1Sym0 x_azbOM)\n                                (Let1627448493XsSym4 x_azbOM m_XzbGe ipv_XzbyV ipv_XzbxR))\n                           ~R# Sing (Foldr1Sym2 x_azbOM (ipv_XzbyV : ipv_XzbxR)))))\n            `cast` ((Sing\n                       ((Apply\n                           <Apply x_azbOM m_XzbGe>_N\n                           (Sym\n                              (TFCo:R:Apply[]kFoldr1Sym1l_afe2[0]\n                                 <a_afdP_azbON>_N <ipv_XzbyV : ipv_XzbxR>_N <x_azbOM>_N)\n                            ; (Apply\n                                 (Sym\n                                    (TFCo:R:Apply(->)(->)Foldr1Sym0l[0]\n                                       <a_afdP_azbON>_N <x_azbOM>_N))\n                                 (Sym\n                                    (TFCo:R:Apply[][]:$$i[0]\n                                       <a_afdP_azbON>_N <ipv_XzbxR>_N <ipv_XzbyV>_N)\n                                  ; (Apply\n                                       (Sym\n                                          (TFCo:R:Applyk(->):$l[0] <a_afdP_azbON>_N <ipv_XzbyV>_N))\n                                       <ipv_XzbxR>_N)_N))_N))_N\n                        ; Sym\n                            (TFCo:R:Foldr1[1]\n                               <a_afdP_azbON>_N\n                               <ipv_XzbxR>_N\n                               <ipv_XzbyV>_N\n                               <m_XzbGe>_N\n                               <x_azbOM>_N)\n                        ; Sym\n                            (TFCo:R:Apply[]kFoldr1Sym1l_afe2[0]\n                               <a_afdP_azbON>_N <m_XzbGe : ipv_XzbyV : ipv_XzbxR>_N <x_azbOM>_N)\n                        ; (Apply\n                             (Sym\n                                (TFCo:R:Apply(->)(->)Foldr1Sym0l[0] <a_afdP_azbON>_N <x_azbOM>_N))\n                             ((<m_XzbGe>_N ': Sym ipv_szbwM)_N ; Sym dt_dzbxK))_N))_R\n                    :: Sing\n                         (Apply\n                            (Apply x_azbOM m_XzbGe)\n                            (Foldr1Sym2 x_azbOM (ipv_XzbyV : ipv_XzbxR)))\n                       ~R# Sing\n                             (Apply\n                                (Apply Foldr1Sym0 x_azbOM)\n                                (Let1627448493XsSym4 x_azbOM m_azbFg ipv_szbwN ipv_szbwO)))\n            }\n        }\n    }\n...\n-}\n\nmodule List (sFoldr1) where\n\nimport Data.Kind (Type)\n\ndata Proxy t\n\ndata family Sing (a :: k)\n\ndata TyFun (a :: Type) (b :: Type)\n\ntype family Apply (f :: TyFun k1 k2 -> Type) (x :: k1) :: k2\n\ndata instance Sing (f :: TyFun k1 k2 -> Type) =\n  SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) }\n\ntype SingFunction1 f = forall t. Sing t -> Sing (Apply f t)\n\ntype SingFunction2 f = forall t. Sing t -> SingFunction1 (Apply f t)\nsingFun2 :: Proxy f -> SingFunction2 f -> Sing f\nsingFun2 _ f = SLambda (\\x -> SLambda (f x))\n\ndata (:$$) (j :: a) (i :: TyFun [a] [a])\ntype instance Apply ((:$$) j) i = (:) j i\n\ndata (:$) (l :: TyFun a (TyFun [a] [a] -> Type))\ntype instance Apply (:$) l = (:$$) l\ndata instance Sing (z :: [a])\n  = z ~ '[] =>\n    SNil\n  | forall (m :: a)\n           (n :: [a]). z ~ (:) m n =>\n    SCons (Sing m) (Sing n)\n\ndata ErrorSym0 (t1 :: TyFun k1 k2)\n\ntype Let1627448493XsSym4 t_afee t_afef t_afeg t_afeh = Let1627448493Xs t_afee t_afef t_afeg t_afeh\n\ntype Let1627448493Xs f_afe9\n                     x_afea\n                     wild_1627448474_afeb\n                     wild_1627448476_afec =\n    Apply (Apply (:$) wild_1627448474_afeb) wild_1627448476_afec\ntype Foldr1Sym2 (t_afdY :: TyFun a_afdP (TyFun a_afdP a_afdP -> Type)\n                           -> Type)\n                (t_afdZ :: [a_afdP]) =\n    Foldr1 t_afdY t_afdZ\ndata Foldr1Sym1 (l_afe3 :: TyFun a_afdP (TyFun a_afdP a_afdP -> Type)\n                           -> Type)\n                (l_afe2 :: TyFun [a_afdP] a_afdP)\ntype instance Apply (Foldr1Sym1 l_afe3) l_afe2 = Foldr1Sym2 l_afe3 l_afe2\n\ndata Foldr1Sym0 (l_afe0 :: TyFun (TyFun a_afdP (TyFun a_afdP a_afdP\n                                                -> Type)\n                                  -> Type) (TyFun [a_afdP] a_afdP -> Type))\ntype instance Apply Foldr1Sym0 l = Foldr1Sym1 l\n\ntype family Foldr1 (a_afe5 :: TyFun a_afdP (TyFun a_afdP a_afdP\n                                            -> Type)\n                              -> Type)\n                   (a_afe6 :: [a_afdP]) :: a_afdP where\n  Foldr1 z_afe7 '[x_afe8] = x_afe8\n  Foldr1 f_afe9 ((:) x_afea ((:) wild_1627448474_afeb wild_1627448476_afec)) = Apply (Apply f_afe9 x_afea) (Apply (Apply Foldr1Sym0 f_afe9) (Let1627448493XsSym4 f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec))\n  Foldr1 z_afew '[] = Apply ErrorSym0 \"Data.Singletons.List.foldr1: empty list\"\n\nsFoldr1 ::\n  forall a_afdP.\n  forall (x :: TyFun a_afdP (TyFun a_afdP a_afdP -> Type) -> Type)\n         (y :: [a_afdP]).\n  Sing x\n  -> Sing y -> Sing (Apply (Apply Foldr1Sym0 x) y)\nsFoldr1 _ (SCons _sX SNil) = undefined\nsFoldr1 sF (SCons sX (SCons sWild_1627448474 sWild_1627448476))\n  = let\n      lambda_afeC ::\n        forall f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec.\n        Sing f_afe9\n        -> Sing x_afea\n           -> Sing wild_1627448474_afeb\n              -> Sing wild_1627448476_afec\n                 -> Sing (Apply (Apply Foldr1Sym0 f_afe9) (Apply (Apply (:$) x_afea) (Apply (Apply (:$) wild_1627448474_afeb) wild_1627448476_afec)))\n      lambda_afeC f_afeD x_afeE wild_1627448474_afeF wild_1627448476_afeG\n        = let\n            sXs ::\n              Sing (Let1627448493XsSym4 f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec)\n            sXs\n              = applySing\n                  (applySing\n                     (singFun2 (undefined :: Proxy (:$)) SCons) wild_1627448474_afeF)\n                  wild_1627448476_afeG\n          in\n            applySing\n              (applySing f_afeD x_afeE)\n              (applySing\n                 (applySing (singFun2 (undefined :: Proxy Foldr1Sym0) sFoldr1) f_afeD)\n                 sXs)\n    in lambda_afeC sF sX sWild_1627448474 sWild_1627448476\nsFoldr1 _ SNil = undefined\n", "num_lines": 315}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n  ) where\n\n-- This reproduces the issue where type variables would be lifted out in\n-- different orders. Compare:\n--\n-- lvl =\n--   \\ (@ (c :: * -> *)) (@ (t :: * -> *)) ->\n--     undefined\n--     @ ((forall d. Data d => c (t d))\n--        -> Maybe (c Node))\n--     (some Callstack thing)\n--\n-- $cdataCast1 =\n--   \\ (@ (c :: * -> *)) (@ (t :: * -> *)) _ [Occ=Dead] ->\n--     lvl @ c @ t\n--\n-- vs\n--\n-- lvl =\n--   \\ (@ (t :: * -> *)) (@ (c :: * -> *)) ->\n--     undefined\n--     @ ((forall d. Data d => c (t d))\n--        -> Maybe (c Node))\n--     (some Callstack thing)\n--\n-- $cdataCast1 =\n--   \\ (@ (c :: * -> *)) (@ (t :: * -> *)) _ [Occ=Dead] ->\n--     lvl @ t @ c\n\nimport Data.Data\n\ndata Node = Node (Maybe Int) [Node]\n\ninstance Data Node where\n\n  gfoldl = gfoldl\n  gunfold = gunfold\n  toConstr = toConstr\n  dataTypeOf = dataTypeOf\n\n  dataCast1 _ = undefined\n  dataCast2 = dataCast2\n\n  gmapT = gmapT\n  gmapQl = gmapQl\n  gmapQr = gmapQr\n  gmapQ = gmapQ\n  gmapQi = gmapQi\n  gmapM = gmapM\n  gmapMp = gmapMp\n  gmapMo = gmapMo\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Roman where\n\n-- This is a simplified version of simplCore/should_compile/spec-inline.hs\n--\n-- It reproduces a problem where workers get specialized in different ways\n-- depending on the values of uniques.\n--\n-- Compare:\n--\n--   $s$wgo_s1CN :: Int# -> Int -> Int#\n--   [LclId, Arity=2, Str=<L,U><L,U>]\n--   $s$wgo_s1CN =\n--     \\ (sc_s1CI :: Int#) (sc_s1CJ :: Int) ->\n--       case tagToEnum# @ Bool (<=# sc_s1CI 0#) of _ [Occ=Dead] {\n--         False ->\n--           $wgo_s1BU (Just @ Int (I# (-# sc_s1CI 1#))) (Just @ Int sc_s1CJ);\n--         True -> 0#\n--       }\n--\n-- vs\n--\n--   $s$wgo_s18mTj :: Int -> Int# -> Int#\n--   [LclId, Arity=2, Str=<L,U><L,U>]\n--   $s$wgo_s18mTj =\n--     \\ (sc_s18mTn :: Int) (sc_s18mTo :: Int#) ->\n--       case tagToEnum# @ Bool (<=# sc_s18mTo 0#) of _ [Occ=Dead] {\n--         False ->\n--           $wgo_s18mUc\n--             (Just @ Int (I# (-# sc_s18mTo 1#))) (Just @ Int sc_s18mTn);\n--         True -> 0#\n--       }\n\nfoo :: Int -> Int\nfoo n =\n  go (Just n) (Just (6::Int))\n  where\n  go Nothing (Just x) = go (Just 10) (Just x)\n  go (Just n) (Just x)\n    | n <= 0    = 0\n    | otherwise = go (Just (n-1)) (Just x)\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\ndata ADT a b = Z a b deriving Eq\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\ndata F a b = F { x :: !Int, y :: !(Float,Float), z :: !(a,b) }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nnewtype Pair1 f g a = Pair1 {unPair1 :: (f a, g a)}\n  deriving Eq\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule ShouldCompile where\n\n-- tests deterministic order of fixities in the interface file\n\ninfixl 1 `f`\ninfixr 2 \\\\\\\ninfix  3 :==>\ninfix  4 `MkFoo`\n\ndata Foo = MkFoo Int | Float :==> Double\n\nf :: a -> b -> a\nx `f` y = x\n\n(\\\\\\) :: (Eq a) => [a] -> [a] -> [a]\n(\\\\\\) xs ys =  xs\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\n-- Reproduces an issue where rules would abstract over typeclass dictionaries\n-- non-deterministically.\n--\n-- Compare:\n--\n-- RULES: \"SPECLOL $csize\" [ALWAYS]\n--            forall ($dOrd_a1sc :: Ord Int) ($dNum_a1sd :: Num Int).\n--              $csize_a1sg @ Int $dOrd_a1sc $dNum_a1sd\n--              = $s$csize_d1zr]\n-- with:\n--\n-- RULES: \"SPEC $csize\" [ALWAYS]\n--            forall ($dNum_a18n42 :: Num Int) ($dOrd_a18n43 :: Ord Int).\n--              $csize_a18n3Z @ Int $dOrd_a18n43 $dNum_a18n42\n--              = $s$csize_d18mWO]\n\nclass Size t where\n  size :: t -> t -> Int\n\ninstance (Ord a, Num a) => Size [a] where\n  {-# SPECIALISE instance Size [Int] #-}\n  size (x:xs) (y:ys) | x+y > 4   = size xs ys\n                     | otherwise = size xs ys\n  size _ _ = 0\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FunctionalDependencies,\n             UndecidableInstances, FlexibleInstances #-}\n\nmodule T10109 where\n\ndata Succ a\n\nclass Add (a :: k1) (b :: k2) (ab :: k3) | a b -> ab\ninstance (Add a b ab) => Add (Succ a) b (Succ ab)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators,\n             UndecidableInstances #-}\n\nmodule T9063 where\n\nimport Data.Type.Equality\nimport Data.Proxy\n\n-- reproduces an issue where type variables in the axiom are in\n-- non-deterministic order\n\nclass kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where\n  type FunnyEq (x :: a) (y :: a) :: Bool\n  type FunnyEq x y = x == y\n\ninstance PEq ('KProxy :: KProxy Bool)\n\nfoo :: Proxy (FunnyEq True True) -> Proxy (True == True)\nfoo = id\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n    ScopedTypeVariables\n  , DataKinds\n  , GADTs\n  , RankNTypes\n  , TypeOperators\n  , PolyKinds -- Comment out PolyKinds and the bug goes away.\n  #-}\n{-# OPTIONS_GHC -O #-}\n  -- The bug is in SimplUtils.abstractFloats, so we need -O to trigger it\n\nmodule KeyValue where\n\nimport Data.Kind\n\ndata AccValidation err a = AccFailure err | AccSuccess a\n\ndata KeyValueError = MissingValue\n\ntype WithKeyValueError = AccValidation [KeyValueError]\n\nmissing :: forall f rs. RecApplicative rs => Rec (WithKeyValueError :. f) rs\nmissing = rpure missingField\n  where\n    missingField :: forall x. (WithKeyValueError :. f) x\n    missingField = Compose $ AccFailure [MissingValue]\n\ndata Rec :: (u -> Type) -> [u] -> Type where\n  RNil :: Rec f '[]\n  (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)\n\nnewtype Compose (f :: l -> Type) (g :: k -> l) (x :: k)\n  = Compose { getCompose :: f (g x) }\n\ntype (:.) f g = Compose f g\n\nclass RecApplicative rs where\n  rpure\n    :: (forall x. f x)\n    -> Rec f rs\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax #-}\n{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule A where\n\ninfixr 7 :*\ninfix  8 :*:\n\ndata HNil\ndata \u00ce\u00b1 :* \u00ce\u00b2\ntype HSingle \u00ce\u00b1 = \u00ce\u00b1 :* HNil\ntype \u00ce\u00b1 :*: \u00ce\u00b2 = \u00ce\u00b1 :* \u00ce\u00b2 :* HNil\n\ndata HList l where\n  HNil  \u00e2\u02c6\u00b7 HList HNil\n  (:*) \u00e2\u02c6\u00b7 \u00ce\u00b1 \u00e2\u2020\u2019 HList t \u00e2\u2020\u2019 HList (\u00ce\u00b1 :* t)\n\ndata First\ndata Next p\n\ndata HIndex i where\n  First \u00e2\u02c6\u00b7 HIndex First\n  Next  \u00e2\u02c6\u00b7 HIndex p \u00e2\u2020\u2019 HIndex (Next p)\n\nclass (l ~ (HHead l :* HTail l)) \u00e2\u2021\u2019 HNonEmpty l where\n  type HHead l\n  type HTail l\n\ninstance HNonEmpty (h :* t) where\n  type HHead (h :* t) = h\n  type HTail (h :* t) = t\n\ndata HFromWitness n l where\n  HFromFirst \u00e2\u02c6\u00b7 HFromWitness First l\n  HFromNext  \u00e2\u02c6\u00b7 (HNonEmpty l, HFromClass p (HTail l),\n                HTail (HFrom (Next p) l) ~ HFrom (Next p) (HTail l))\n             \u00e2\u2021\u2019 HFromWitness (Next p) l\n\nclass HFromClass n l where\n  type HFrom n l\n  hFromWitness \u00e2\u02c6\u00b7 HFromWitness n l\n\ninstance HFromClass First l where\n  type HFrom First l = l\n  hFromWitness = HFromFirst\n\ninstance (HNonEmpty l, HFromClass p (HTail l)) \u00e2\u2021\u2019 HFromClass (Next p) l where\n  type HFrom (Next p) l = HFrom p (HTail l)\n  hFromWitness = case hFromWitness \u00e2\u02c6\u00b7 HFromWitness p (HTail l) of\n    HFromFirst \u00e2\u2020\u2019 HFromNext\n    HFromNext  \u00e2\u2020\u2019 HFromNext\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# OPTIONS -w #-}\n\nmodule A where\n\ndata PSum a b = Empty | Tree a b [(PSum a b)]\n\nextractMinX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 PSum a b \u00e2\u2020\u2019 ((a,b), PSum a b)\nextractMinX Empty = undefined\nextractMinX (Tree v r xs) = ((v,r), Empty)\n\ntoListX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 PSum a b \u00e2\u2020\u2019 [(a,b)]\ntoListX Empty = []\ntoListX x = let (y, z) = extractMinX x in y : toListX z\n\nmain \u00e2\u02c6\u00b7 IO ()\nmain = print $ take 20 $ toListX $ (Empty :: PSum Int Int)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n    Copyright 2009 Mario Blazevic\n\n    This file is part of the Streaming Component Combinators (SCC) project.\n\n    The SCC project is free software: you can redistribute it and/or\n    modify it under the terms of the GNU General Public License as\n    published by the Free Software Foundation, either version 3 of the\n    License, or (at your option) any later version.\n\n    SCC is distributed in the hope that it will be useful, but WITHOUT\n    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY\n    or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public\n    License for more details.\n\n    You should have received a copy of the GNU General Public License\n    along with SCC.  If not, see <http://www.gnu.org/licenses/>.\n-}\n\n-- | Module \"Trampoline\" defines the pipe computations and their basic building blocks.\n\n{-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses,\n             TypeFamilies, KindSignatures, FlexibleContexts, NoMonadFailDesugaring,\n             FlexibleInstances, OverlappingInstances, UndecidableInstances\n #-}\n\n{-   Somewhere we get:\n\n  Wanted: AncestorFunctor (EitherFunctor a (TryYield a)) d\n  This should not reduce because of overlapping instances\n\n  If it (erroneously) does reduce, via dfun2 we get\n  Wanted: Functor (EitherFunctor a (TryYield a)\n          Functor d'\n          Functor d\n          d ~ EitherFunctor d' s\n          AncestorFunctor (EitherFunctor a (TryYield a) d'\n\n\n  And that gives an infinite loop in the type checker!\n-}\n\n{-# OPTIONS -w #-}\n\nmodule A where\n\nimport Control.Monad (liftM, liftM2, when, ap)\n-- import Control.Monad.Identity\n\nimport Debug.Trace (trace)\n\n\n-------------\nclass (Functor a, Functor d) => AncestorFunctor a d where\n   liftFunctor :: a x -> d x\n\n-- dfun 1\ninstance Functor a => AncestorFunctor a a where\n   liftFunctor = trace \"liftFunctor id\" . id\n\n-- dfun 2\ninstance ( Functor a\n         , Functor d'\n         , Functor d\n         , d ~ EitherFunctor d' s\n         , AncestorFunctor a d')\n      => AncestorFunctor a d where\n   liftFunctor = LeftF . (trace \"liftFunctor other\" . liftFunctor :: a x -> d' x)\n\n-------------\nnewtype Identity a = Identity { runIdentity :: a }\n\ninstance Functor Identity where\n    fmap = liftM\n\ninstance Applicative Identity where\n    pure  = return\n    (<*>) = ap\n\ninstance Monad Identity where\n    return a = Identity a\n    m >>= k  = k (runIdentity m)\n\nnewtype Trampoline m s r = Trampoline {bounce :: m (TrampolineState m s r)}\ndata TrampolineState m s r = Done r | Suspend! (s (Trampoline m s r))\n\ninstance (Monad m, Functor s) => Functor (Trampoline m s) where\n  fmap = liftM\n\ninstance (Monad m, Functor s) => Applicative (Trampoline m s) where\n  pure  = return\n  (<*>) = ap\n\ninstance (Monad m, Functor s) => Monad (Trampoline m s) where\n   return x = Trampoline (return (Done x))\n   t >>= f = Trampoline (bounce t >>= apply f)\n      where apply f (Done x) = bounce (f x)\n            apply f (Suspend s) = return (Suspend (fmap (>>= f) s))\n\ndata Yield x y = Yield! x y\ninstance Functor (Yield x) where\n   fmap f (Yield x y) = trace \"fmap yield\" $ Yield x (f y)\n\ndata Await x y = Await! (x -> y)\ninstance Functor (Await x) where\n   fmap f (Await g) = trace \"fmap await\" $ Await (f . g)\n\ndata EitherFunctor l r x = LeftF (l x) | RightF (r x)\ninstance (Functor l, Functor r) => Functor (EitherFunctor l r) where\n   fmap f v = trace \"fmap Either\" $\n              case v of\n                LeftF l  -> trace \"fmap LeftF\" $ LeftF (fmap f l)\n                RightF r -> trace \"fmap RightF\" $ RightF (fmap f r)\n\ntype TryYield x = EitherFunctor (Yield x) (Await Bool)\n\nsuspend :: (Monad m, Functor s) => s (Trampoline m s x) -> Trampoline m s x\nsuspend s = Trampoline (return (Suspend s))\n\nyield :: forall m x. Monad m => x -> Trampoline m (Yield x) ()\nyield x = suspend (Yield x (return ()))\n\nawait :: forall m x. Monad m => Trampoline m (Await x) x\nawait = suspend (Await return)\n\ntryYield :: forall m x. Monad m => x -> Trampoline m (TryYield x) Bool\ntryYield x = suspend (LeftF (Yield x (suspend (RightF (Await return)))))\n\ncanYield :: forall m x. Monad m => Trampoline m (TryYield x) Bool\ncanYield = suspend (RightF (Await return))\n\nliftBounce :: Monad m => m x -> Trampoline m s x\nliftBounce = Trampoline . liftM Done\n\nfromTrampoline :: Monad m => Trampoline m s x -> m x\nfromTrampoline t = bounce t >>= \\(Done x)-> return x\n\nrunTrampoline :: Monad m => Trampoline m Maybe x -> m x\nrunTrampoline = fromTrampoline\n\ncoupleNestedFinite :: (Functor s, Monad m) =>\n                      Trampoline m (EitherFunctor s (TryYield a)) x\n                   -> Trampoline m (EitherFunctor s (Await (Maybe a))) y -> Trampoline m s (x, y)\ncoupleNestedFinite t1 t2 =\n   trace \"bounce start\" $\n   liftBounce (liftM2 (,) (bounce t1) (bounce t2))\n   >>= \\(s1, s2)-> trace \"bounce end\" $\n                   case (s1, s2)\n                   of (Done x, Done y) -> return (x, y)\n                      (Done x, Suspend (RightF (Await c2))) -> coupleNestedFinite (return x) (c2 Nothing)\n                      (Suspend (RightF (LeftF (Yield _ c1))), Done y) -> coupleNestedFinite c1 (return y)\n                      (Suspend (RightF (LeftF (Yield x c1))), Suspend (RightF (Await c2))) -> coupleNestedFinite c1 (c2 $ Just x)\n                      (Suspend (RightF (RightF (Await c1))), Suspend s2@(RightF Await{})) -> coupleNestedFinite (c1 True) (suspend s2)\n                      (Suspend (RightF (RightF (Await c1))), Done y) -> coupleNestedFinite (c1 False) (return y)\n                      (Suspend (LeftF s), Done y) -> suspend (fmap (flip coupleNestedFinite (return y)) s)\n                      (Done x, Suspend (LeftF s)) -> suspend (fmap (coupleNestedFinite (return x)) s)\n                      (Suspend (LeftF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNestedFinite $ suspend $ LeftF s1) s2)\n                      (Suspend (LeftF s1), Suspend (RightF s2)) -> suspend (fmap (flip coupleNestedFinite (suspend $ RightF s2)) s1)\n                      (Suspend (RightF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNestedFinite (suspend $ RightF s1)) s2)\n\nlocal :: forall m l r x. (Monad m, Functor r) => Trampoline m r x -> Trampoline m (EitherFunctor l r) x\nlocal (Trampoline mr) = Trampoline (liftM inject mr)\n   where inject :: TrampolineState m r x -> TrampolineState m (EitherFunctor l r) x\n         inject (Done x) = Done x\n         inject (Suspend r) = Suspend (RightF $ fmap local r)\n\nout :: forall m l r x. (Monad m, Functor l) => Trampoline m l x -> Trampoline m (EitherFunctor l r) x\nout (Trampoline ml) = Trampoline (liftM inject ml)\n   where inject :: TrampolineState m l x -> TrampolineState m (EitherFunctor l r) x\n         inject (Done x) = Done x\n         inject (Suspend l) = Suspend (LeftF $ fmap out l)\n\nliftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Trampoline m a x -> Trampoline m d x\nliftOut (Trampoline ma) = trace \"liftOut\" $ Trampoline (liftM inject ma)\n   where inject :: TrampolineState m a x -> TrampolineState m d x\n         inject (Done x) = Done x\n         inject (Suspend a) = trace \"inject suspend\" $ Suspend (liftFunctor $ trace \"calling fmap\" $\n                              fmap liftOut (trace \"poking a\" a))\n\ndata Sink (m :: * -> *) a x =\n   Sink   {put :: forall d. (AncestorFunctor (EitherFunctor a (TryYield x)) d) => x -> Trampoline m d Bool,\n           canPut :: forall d. (AncestorFunctor (EitherFunctor a (TryYield x)) d) => Trampoline m d Bool}\nnewtype Source (m :: * -> *) a x =\n   Source {get :: forall d. (AncestorFunctor (EitherFunctor a (Await (Maybe x))) d) => Trampoline m d (Maybe x)}\n\npipe :: forall m a x r1 r2. (Monad m, Functor a) =>\n        (Sink m a x -> Trampoline m (EitherFunctor a (TryYield x)) r1)\n     -> (Source m a x -> Trampoline m (EitherFunctor a (Await (Maybe x))) r2) -> Trampoline m a (r1, r2)\npipe producer consumer = coupleNestedFinite (producer sink) (consumer source) where\n   sink = Sink {put= liftOut . (local . tryYield :: x -> Trampoline m (EitherFunctor a (TryYield x)) Bool),\n                canPut= liftOut (local canYield :: Trampoline m (EitherFunctor a (TryYield x)) Bool)} :: Sink m a x\n   source = Source (liftOut (local await :: Trampoline m (EitherFunctor a (Await (Maybe x))) (Maybe x))) :: Source m a x\n\npipeProducer sink = do put sink 1\n                       (c, d) <- pipe\n                                    (\\sink'-> do put sink' 2\n                                                 put sink 3\n                                                 put sink' 4\n                                                 return 5)\n                                    (\\source'-> do Just n <- get source'\n                                                   put sink n\n                                                   put sink 6\n                                                   return n)\n                       put sink c\n                       put sink d\n                       return (c, d)\n\ntestPipe = print $\n           runIdentity $\n           runTrampoline $\n           do (a, b) <- pipe\n                           pipeProducer\n                           (\\source-> do Just n1 <- get source\n                                         return (n1, n1, n1))\n              return (a, b)\n", "num_lines": 216}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n    Arrows\n  , TypeOperators\n  #-}\n-- This is extracted from arrow-list package\n-- The problem was that some internal tuples that Arrows desugaring\n-- generates the components in different orders depending on the order\n-- of Uniques.\nmodule A\n(\n ifA\n)\nwhere\n\nimport Control.Arrow\nimport Prelude hiding (id, (.))\n\nclass Arrow arr => ArrowList arr where\n  arrL :: (a -> [b]) -> a `arr` b\n  mapL :: ([b] -> [c]) -> (a `arr` b) -> (a `arr` c)\n\n\nempty :: ArrowList arr => (a `arr` b) -> a `arr` Bool\nempty = mapL (\\xs -> [if null xs then True else False])\n\n\nifA :: (ArrowList arr, ArrowChoice arr)\n    => (a `arr` c)  -- ^ Arrow used as condition.\n    -> (a `arr` b)  -- ^ Arrow to use when condition has results.\n    -> (a `arr` b)  -- ^ Arrow to use when condition has no results.\n    -> a `arr` b\nifA c t e = proc i -> do x <- empty c -< i; if x then e -< i else t -< i\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE RecursiveDo #-}\n{-# LANGUAGE TupleSections #-}\nmodule A where\n\nimport Control.Arrow (first)\nimport Control.Monad.Fix\nimport Control.Monad\n\n-- Reduced example from rev-state package.\n-- Reproduces an issue where the tuples generated when desugaring\n-- mdo have nondeterministic order of components.\n--\n-- Consider:\n--\n--    do rec\n--      a <- f b\n--      b <- f a\n--      return a\n--\n-- Compare:\n--\n--  do\n--    (a, b) <- mfix $ \\ ~(a, b) -> do\n--      a <- f b\n--      b <- f a\n--      return (a, b)\n--    return a\n--\n-- vs\n--\n--  do\n--    (b, a) <- mfix $ \\ ~(b, a) -> do\n--      a <- f b\n--      b <- f a\n--      return (b, a)\n--    return a\n\nnewtype StateT s m a = StateT\n  { runStateT :: s -> m (a, s) }\n\ninstance MonadFix m => Monad (StateT s m) where\n  return x = StateT $ \\s -> pure (x, s)\n  m >>= f = StateT $ \\s -> do\n    rec\n      (x, s'') <- runStateT m s'\n      (x', s') <- runStateT (f x) s\n    return (x', s'')\n\ninstance MonadFix m => Applicative (StateT s m) where\n  (<*>) = ap\n  pure = return\n\ninstance Functor m => Functor (StateT s m) where\n  -- this instance is hand-written\n  -- so we don't have to rely on m being MonadFix\n  fmap f m = StateT $ \\s -> first f `fmap` runStateT m s\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# OPTIONS_GHC -ddump-types #-}\nmodule A where\n\ntest2 f = do\n  x <- f 3\n  y <- f 4\n  return (x + y)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Test that SPEC rules are named deterministically.\nmodule A where\n\ntest1 :: Num a => a -> a -> a\ntest1 x y = x + 42 * y\n{-# SPECIALISE test1 :: Int -> Int -> Int #-}\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule A ( mkStringWriter, (<>>) ) where\n\nimport Foreign.Ptr\nimport Prelude\n\n-- generated C wrappers used to use Unique values for the label\nforeign import ccall \"wrapper\" mkStringWriter :: Int -> IO (Ptr Int)\n-- make sure we properly z-encode the generated stubs\nforeign import ccall \"wrapper\" (<>>) :: Int -> IO (Ptr Int)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A011 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A012 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A013 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A014 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A015 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A031 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A032 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A033 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A061a where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A061b where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A063 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A064 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A065 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A066 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A067 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A070 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A071 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A200 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D063 where\nimport A063\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D200 where\nimport A200\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nmain :: IO ()\nmain = putStrLn \"Hello World\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule TestStub016 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule TestStub017 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule TestStub018 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule TestStub018 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule TestStub019 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule TestStub034 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule TestStub035 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module InlineCheck where\n\nfoo = (+1)\n\nfoo1 = (+1)\n{-# NOINLINE foo1 #-}\n\nqux = foo 3\n\nqux1 = foo1 3\n\ntoo = qux\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nimport Data.List\n\nid1 :: a -> a\nid1 = 5\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module JSON where\n\nfoo :: a -> a\nfoo = id\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n---------------------------------------------------------------------------\n\n-- There is enough comment to fill up one buffer (1024 bytes) of the code\n-- in GHC that looks for OPTIONS_GHC pragmas etc.\n\n{-# OPTIONS_GHC -w #-}\n\nmodule Pragma001 () where\n\n-- This will make a warning if the pragma isn't picked up\nfoo _ = ()\nfoo _ = ()\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- an options pragma that needs more than 1k of buffer to read\n{-# OPTIONS_GHC\n                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                -w #-}\n\nmodule Pragma002 () where\n\n-- This will make a warning if the pragma isn't picked up\nfoo _ = ()\nfoo _ = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = return ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print \"hello\"\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Shared001 where\n\n-- Test for building DLLs with ghc -shared, see #2745\n\nf :: Int -> Int\nf x = x+1\n\nforeign export ccall f :: Int -> Int\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport System.Environment\n\nmain :: IO ()\nmain = do args <- getArgs\n          mapM_ (putStrLn . f) args\n\nf :: String -> String\nf str = \"Arg: \" ++ show str\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Static001 where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10182 where\nimport T10182a\ninstance Show (a -> b) where\n    show _  = \"\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10182a where\nimport {-# SOURCE #-} T10182\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10220B where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Test file for issue #10320.\n\nmodule Main (main) where\n\nmain :: IO ()\nmain = print $ map (+1) (map (+1) [1, 2, 3])\n\n{-# RULES \"map/map\"    forall f g xs.  map f (map g xs) = map (f.g) xs #-}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T10600 where\n\nimport GHC.Prim\n\n-- This shouldn't compile as unlifted bindings aren't allowed at top-level.\n-- However, #10600 described the situation where an error isn't throw when we\n-- compile with -fno-code.\nfoo :: Int#\nfoo = 10600#\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule T10869 where\nimport T10869A\n\nmain :: IO()\n#if defined(__GLASGOW_HASKELL__)\nmain = writeMsg\n#endif\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule T10869A (writeMsg) where\n\nwriteMsg :: IO ()\n#if defined(__GLASGOW_HASKELL__)\nwriteMsg = putStrLn \"Hello HSPP File\"\n#endif\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10923 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmain = do\n    putStrLn VERSION_containers\n#if MIN_VERSION_base(3,0,0)\n    putStrLn \"OK\"\n#endif\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Strict #-}\n-- | Strict should imply StrictData\nmodule Main where\n\ndata Lazy a = Lazy ~a\n\nmain :: IO ()\nmain =\n  case Lazy undefined of\n    Lazy _ -> putStrLn \"Lazy\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T11381 where\n\n-- ensure that this code does not compile without TypeFamilyDependencies and that\n-- injectivity error is not reported.\ntype family F a = r | r -> a\ntype instance F Int = Bool\ntype instance F Int = Char\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"hello world\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"hello world\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"hello world\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmain = do\n#ifndef VERSION_containers\n    putStrLn \"OK\"\n#endif\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"hello world\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"hello world\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"hello world\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n#include \"T12135.h\"\nmain = print message\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12192 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO()\nmain = putStrLn \"T12625\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n#if SHOULD_PASS\nmessage :: String\nmessage = \"Hello!\"\n#endif\n\nmain :: IO ()\nmain = putStrLn message\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that setting the TMP environment variable to a path with non-ASCII\n-- characters works.\nmain :: IO ()\nmain = putStrLn \"hello world\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13604 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13604a where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CApiFFI #-}\n{-# OPTIONS_GHC -optc-O3 #-}\n\nmodule T14452 where\nforeign import capi unsafe \"stdlib.h exit\" c_exit :: Int -> IO ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\nimport Ar\n\n-- obtained from echo -n \\0 > x.o && ar -q b.a x.o && cat b.a\narchive = \"!<arch>\\nx.o/            0           0     0     644     1         \\\n\\`\\n0\\nx.o/            0           0     0     644     1         `\\n0\\n\"\n\nmain = print (parseAr archive)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2182 where\ninstance Read (IO a) where\n readsPrec = undefined\nx = read \"\" :: IO Bool\ny = show (\\x -> x)\nz = (\\x -> x) == (\\y -> y)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2182_A where\nimport Text.Show.Functions\ninstance Eq (a -> b) where\n    _ == _ = True\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# OPTIONS_GHC -DTEST #-}\n{-# OPTIONS_GHC -fffi #-} -- deprecation warning\n#ifdef TEST\n{-# LANGUAGE EmptyDataDecls #-}\n#endif\n\nmodule Test2464 where\ndata T\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -package blargh #-}\nmodule Test where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T2507 where\n\nfoo :: Int\nfoo = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CPP #-}\n{-# OPTIONS_GHC -optP -C -optP -ffreestanding #-}\n\n#define A 'a'\n\nmain :: IO ()\nmain = putStrLn [A,\n-- CPP treats this as the beginning of a multiline C-style comment: /usr/local/*\n                 'b',\n-- And */ close it. By passing `-optP -C` we tell CPP not to delete it.\n                 'c']\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -F -pgmF ./test_preprocessor.txt #-}\nmodule Main where\n\nmain = print \"Hello World\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -F -pgmF ./T3674_pre #-}\n\nmodule Test3674 where\n\ndata Foo a where MkFoo :: Foo a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\nmain = do \n [_,inf,outf] <- getArgs\n s <- readFile inf\n writeFile outf (\"{-# LANGUAGE GADTs #-}\\n\" ++ s)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test the flage `force-no-intermediates` (issue #4114)\nmodule Main (main) where\n\nimport T4114aSub\n\nkeep, nokeep :: [FilePath]\nkeep   = [\"T4114aSub.hi\", \"T4114aSub.o\", \"T4114a.hi\", \"T4114a.o\"]\nnokeep = [ ]\n\n\nmain :: IO ()\nmain = do\n  mapM_ assertNoKeep nokeep\n  mapM_ assertKeep keep\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4114aSub (assertKeep, assertNoKeep) where\n\nimport Control.Monad    (unless, when)\nimport System.Directory (doesFileExist)\n\nassertNoKeep :: FilePath -> IO ()\nassertNoKeep a =\n   whenM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' exists\")\n\nassertKeep :: FilePath -> IO ()\nassertKeep a =\n   unlessM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' is missing\")\n\nwhenM :: Monad m => m Bool -> m () -> m ()\nwhenM mp f = mp >>= \\p -> when p f\n\nunlessM :: Monad m => m Bool -> m () -> m ()\nunlessM mp f = mp >>= \\p -> unless p f\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test the flage `force-no-intermediates` (issue #4114)\nmodule Main (main) where\n\nimport T4114bSub\n\nkeep, nokeep :: [FilePath]\nkeep   = [\"T4114bSub.o\", \"T4114b.o\"]\nnokeep = [\"T4114bSub.hi\", \"T4114b.hi\"]\n\nmain :: IO ()\nmain = do\n  mapM_ assertNoKeep nokeep\n  mapM_ assertKeep keep\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4114bSub (assertKeep, assertNoKeep) where\n\nimport Control.Monad    (unless, when)\nimport System.Directory (doesFileExist)\n\nassertNoKeep :: FilePath -> IO ()\nassertNoKeep a =\n   whenM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' exists\")\n\nassertKeep :: FilePath -> IO ()\nassertKeep a =\n   unlessM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' is missing\")\n\nwhenM :: Monad m => m Bool -> m () -> m ()\nwhenM mp f = mp >>= \\p -> when p f\n\nunlessM :: Monad m => m Bool -> m () -> m ()\nunlessM mp f = mp >>= \\p -> unless p f\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test the flage `force-no-intermediates` (issue #4114)\nmodule Main (main) where\n\nimport T4114cSub\n\nkeep, nokeep :: [FilePath]\nkeep   = [\"T4114cSub.hi\", \"T4114c.hi\"]\nnokeep = [\"T4114cSub.o\", \"T4114c.o\"]\n\n\nmain :: IO ()\nmain = do\n  mapM_ assertNoKeep nokeep\n  mapM_ assertKeep keep\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4114cSub (assertKeep, assertNoKeep) where\n\nimport Control.Monad    (unless, when)\nimport System.Directory (doesFileExist)\n\nassertNoKeep :: FilePath -> IO ()\nassertNoKeep a =\n   whenM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' exists\")\n\nassertKeep :: FilePath -> IO ()\nassertKeep a =\n   unlessM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' is missing\")\n\nwhenM :: Monad m => m Bool -> m () -> m ()\nwhenM mp f = mp >>= \\p -> when p f\n\nunlessM :: Monad m => m Bool -> m () -> m ()\nunlessM mp f = mp >>= \\p -> unless p f\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test the flage `force-no-intermediates` (issue #4114)\nmodule Main (main) where\n\nimport T4114dSub\n\nkeep, nokeep :: [FilePath]\nkeep   = [\"T4114dSub.myhi\", \"T4114d.myhi\"]\nnokeep = [\"T4114dSub.myo\", \"T4114d.myo\"]\n\n\nmain :: IO ()\nmain = do\n  mapM_ assertNoKeep nokeep\n  mapM_ assertKeep keep\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4114dSub (assertKeep, assertNoKeep) where\n\nimport Control.Monad    (unless, when)\nimport System.Directory (doesFileExist)\n\nassertNoKeep :: FilePath -> IO ()\nassertNoKeep a =\n   whenM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' exists\")\n\nassertKeep :: FilePath -> IO ()\nassertKeep a =\n   unlessM (doesFileExist a) $\n       error (\"error: intermediate '\" ++ a ++ \"' is missing\")\n\nwhenM :: Monad m => m Bool -> m () -> m ()\nwhenM mp f = mp >>= \\p -> when p f\n\nunlessM :: Monad m => m Bool -> m () -> m ()\nunlessM mp f = mp >>= \\p -> unless p f\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | A test for ensuring that GHC's supporting language extensions remains in\n-- sync with Cabal's own extension list.\n--\n-- If you have ended up here due to a test failure, please see\n-- Note [Adding a language extension] in compiler/main/DynFlags.hs.\n\nmodule Main (main) where\n\nimport Control.Monad\nimport Data.List\nimport DynFlags\nimport Language.Haskell.Extension\n\nmain :: IO ()\nmain = do\n    let ghcExtensions = map flagSpecName xFlags\n        cabalExtensions = map show [ toEnum 0 :: KnownExtension .. ]\n        ghcOnlyExtensions = ghcExtensions \\\\ cabalExtensions\n        cabalOnlyExtensions = cabalExtensions \\\\ ghcExtensions\n    check \"GHC-only flags\" expectedGhcOnlyExtensions ghcOnlyExtensions\n    check \"Cabal-only flags\" expectedCabalOnlyExtensions cabalOnlyExtensions\n\ncheck :: String -> [String] -> [String] -> IO ()\ncheck title expected got\n    = do let unexpected = got \\\\ expected\n             missing = expected \\\\ got\n             showProblems problemType problems\n                 = unless (null problems) $\n                       do putStrLn (title ++ \": \" ++ problemType)\n                          putStrLn \"-----\"\n                          mapM_ putStrLn problems\n                          putStrLn \"-----\"\n                          putStrLn \"\"\n         showProblems \"Unexpected flags\" unexpected\n         showProblems \"Missing flags\" missing\n\n-- See Note [Adding a language extension] in compiler/main/DynFlags.hs.\nexpectedGhcOnlyExtensions :: [String]\nexpectedGhcOnlyExtensions = [\"RelaxedLayout\",\n                             \"AlternativeLayoutRule\",\n                             \"AlternativeLayoutRuleTransitional\",\n                             \"EmptyDataDeriving\",\n                             \"GeneralisedNewtypeDeriving\"]\n\nexpectedCabalOnlyExtensions :: [String]\nexpectedCabalOnlyExtensions = [\"Generics\",\n                               \"ExtensibleRecords\",\n                               \"RestrictedTypeSynonyms\",\n                               \"HereDocuments\",\n                               \"NewQualifiedOperators\",\n                               \"XmlSyntax\",\n                               \"RegularPatterns\",\n                               \"SafeImports\",\n                               \"Safe\",\n                               \"Unsafe\",\n                               \"Trustworthy\"]\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# OPTIONS_GHC -DFOO=\"bar baz\" #-}\nmain = print FOO\n\n-- Test that GHC can compile option pragmas containing spaces.\n-- When a .hsc contains `#define FOO \"bar baz\"`, hsc2hs emits:\n--\n--     {-# OPTIONS_GHC -optc-DFOO=\"bar baz\" #-}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T5198 where\n\nv :: ()\nv = ()\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified GHC\nimport System.Environment\n\nmain = do\n  (libdir:_) <- getArgs\n  GHC.runGhcT (Just libdir) $ do\n      -- begin initialize\n      df0 <- GHC.getSessionDynFlags\n      let df1 = df0{GHC.ghcMode    = GHC.CompManager,\n                    GHC.hscTarget  = GHC.HscInterpreted,\n                    GHC.ghcLink    = GHC.LinkInMemory,\n                    GHC.verbosity  = 0}\n      _ <- GHC.setSessionDynFlags df1\n      -- begin reset\n      GHC.setContext []\n      GHC.setTargets []\n      _ <- GHC.load GHC.LoadAllTargets\n      return ()\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T6037 where\n\nf\u00c3\u00b3o :: Int\nf\u00c3\u00b3o = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = return ()\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = print (f (3 + 4 :: Int))\n\nf :: Int -> Int\nf x = x\n{-# NOINLINE [1] f #-}\n\n{-# RULES \"rule\" forall x. f x = 8 #-}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Haskell2010 #-}\nmodule T706 where\n\nforeign export ccall f :: Int -> Int\n\nf :: Int -> Int\nf x = x + 1\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T706 where\n\ntest = \"testing\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7130 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain = return ()\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A where\n\ndata ABC = A | B | C\n\nabc :: ABC -> Int\nabc x = case x of\n    A -> 1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A where\n\ndata ABC = A | B | C\n\nabc :: ABC -> Int\nabc x = case x of\n    A -> 1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax #-}\nmodule T8959a where\n\nfoo :: Int -> Int\nfoo = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9776 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Monad\nimport Control.Monad.Trans.State\n\nsolve :: Int -> StateT () [] ()\nsolve carry | carry > 0 =\n  do guard (0 == carry)\n     solve (carry -1)\nsolve 0 = mzero\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Monad\nimport Control.Monad.Trans.State\n\nsolve :: Int -> StateT () [] ()\nsolve 0 = mzero\nsolve carry | carry > 0 =\n  do guard (0 == carry)\n     solve (carry -1)\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall -fwarn-tabs -Werror #-}\n\n-- check that all warnings are emitted before failing due to -Werror (#1666)\n\n-- missing type sig warning (type checker)\nmain = do\n        let main = main -- shadowing warning (renamer)\n\tputStrLn \"hello\" -- tab warning (lexer)\n\nf [] = []\nf [] = [] -- overlapping pattern\n-- incomplete pattern\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = return ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B021.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B022.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B023.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B024.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B025.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule B027.F where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule B028.F where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B041.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B042.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule B042stub.C where\n\nforeign export ccall foo :: IO ()\nfoo :: IO ()\nfoo = return ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B043.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule B044.F where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule B045.F where\nforeign export ccall f :: Int -> Int\nf :: Int -> Int\nf n = n + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B200.C where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bar where\nimport Foo\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "Module Foo where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P.Q where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P.Q where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module R.S where\nimport P.Q\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P.Q where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module R.S where\nimport P.Q\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module P.Q where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module R.S where\nimport P.Q\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A003 where\n\na :: Char\na = 'a'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A where\n\na :: Char\na = 'a'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B where\n\nb :: Char\nb = 'c'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B where\n\nb :: Char\nb = 'b'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B where\n\nb :: Char\nb = 'c'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport A\nimport B\n\nmain = do print a\n          print b\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A where\n\na :: Char\na = 'a'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B where\n\nb :: Char\nb = 'b'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule C where\n\nimport A\nimport B\n\nab :: String\nab = [a, b]\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport C\n\nmain :: IO ()\nmain = putStrLn c\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A where\n\na :: Char\na = 'a'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A where\n\na :: Char\na = 'x'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B where\n\nb :: Char\nb = 'b'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule C where\n\nimport A\nimport B\n\nc :: String\nc = [a, b]\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -fwarn-unused-binds #-}\n\nmodule A (a, a_type_default, a_missing_sig) where\n\na :: Int\na = 4\n\na_type_default :: Int\na_type_default = 2 ^ 2\n\na_missing_sig = ()\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -fwarn-type-defaults #-}\n\nmodule B (b, b_unused_bind, b_missing_sig) where\n\nb :: Int\nb = 5\n\nb_unused_bind :: Int -> Int\nb_unused_bind x = 2\n\nb_missing_sig = ()\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -fwarn-missing-signatures #-}\n\nmodule Main (main, c_type_default, c_unused_bind) where\n\nimport A (a)\nimport B (b)\n\nmain :: IO ()\nmain = print (a + b)\n\nc_type_default :: Int\nc_type_default = 2 ^ 2\n\nc_unused_bind :: Int -> Int\nc_unused_bind x = 2\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall -Werror #-}\n\nmodule A_First where\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A_Main where\n\nimport A_First  () -- Turns on -Wall -Werror\nimport A_Second () -- Is not -Wall clean\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A_Second where\n\n-- Not -Wall clean: Missing signature:\na = 'c'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B_First where\n\n-- Not -Wall clean: Missing signature:\na = 'c'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B_Main where\n\nimport B_First  () -- Is not -Wall clean\nimport B_Second () -- Turns on -Wall -Werror\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall -Werror #-}\n\nmodule B_Second where\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall -Werror #-}\n\nmodule C_Child where\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule C_Main where\n\nimport C_Child () -- Turns on -Wall -Werror\n\n-- Not -Wall clean: Missing signature:\na = 'c'\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule D_Child where\n\n-- Not -Wall clean: Missing signature:\na = 'c'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall -Werror #-}\n\nmodule D_Main where\n\nimport D_Child () -- Is not -Wall clean\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ManyFirst where\n\n-- Not -Wall clean: Missing signature:\na = 'c'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall -Werror #-}\n\nmodule ManySecond where\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ManyThird where\n\n-- Not -Wall clean: Missing signature:\na = 'c'\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Handles\n  ( hsNewSOHandle\n  ) where\n\nimport Foreign\n\nimport Types\n\nimport MyCode\n\nforeign export ccall \"hs_soHandles\"\n  hsNewSOHandle :: SOHandleExport\n\nhsNewSOHandle :: SOHandleExport\nhsNewSOHandle = newStablePtr SOHandles\n  { someData = \"I'm a shared object\"\n  , someFn = myFunction\n  }\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\nmodule Main (main) where\n\nimport Control.Exception\nimport Control.Monad\n\nimport Foreign\n\nimport Types\n\nimport System.Environment\nimport System.Posix.DynamicLinker\nimport GHCi.ObjLink\n\nrotateSO\n  :: (FunPtr (IO (StablePtr a)) -> (IO (StablePtr a)))\n  -> String\n  -> (Maybe FilePath, FilePath)\n  -> IO a\nrotateSO dynamicCall symName (old, newDLL) = do\n  -- initObjLinker is idempotent\n  initObjLinker DontRetainCAFs\n\n  loadObj newDLL\n  resolved <- resolveObjs\n  unless resolved $\n    throwIO (ErrorCall $ \"Unable to resolve objects for \" ++ newDLL)\n  c_sym <- lookupSymbol symName\n  h <- case c_sym of\n    Nothing -> throwIO (ErrorCall \"Could not find symbol\")\n    Just p_sym ->\n      bracket (dynamicCall $ castPtrToFunPtr p_sym) freeStablePtr deRefStablePtr\n  purgeObj newDLL\n  forM_ old unloadObj\n  return h\n\nforeign import ccall \"dynamic\"\n  mkCallable :: FunPtr SOHandleExport -> SOHandleExport\n\nmain :: IO ()\nmain = do\n  [file] <- getArgs\n  SOHandles{..} <- rotateSO mkCallable \"hs_soHandles\" (Nothing, file)\n  someFn 7\n  putStrLn $ \"someData = \" ++ show someData\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MyCode\n  ( myFunction\n  ) where\n\nmyFunction :: Int -> IO ()\nmyFunction i = putStrLn $ \"Adding to 20: \" ++ show (i + 20)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Types\n  ( SOHandles(..)\n  , SOHandleExport\n  ) where\n\nimport Foreign\n\ndata SOHandles = SOHandles\n  { someData :: String\n  , someFn :: Int -> IO ()\n  }\n\ntype SOHandleExport = IO (StablePtr SOHandles)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module List where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Overlap where\nimport List\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nfoo :: Int\nfoo = 4\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B (foo) where\n\nimport A (foo)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B () where\n\nimport A ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport B (foo)\n\nmain :: IO ()\nmain = print foo\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Q where\n\nimport {-# SOURCE #-} W\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule W where\n\nimport Q\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nimport Data.Char\n\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Main where\n\nmain :: IO ()\nmain = foo\n\nforeign import ccall unsafe \"c.h foo\" foo :: IO ()\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nf :: Int -> Int\nf x = x + 1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\ng :: Int -> Int\ng x = x * 2\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule C (f, g) where\n\nimport A\nimport B\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule C (f, g) where\n\nimport A\nimport B\n\n{-# RULES \"f/g\"  forall x . f (g x) = x #-}\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D () where\n\nimport C () -- so we don't get a dependency on C's export list\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module E where\n\nimport D  -- get the RULE from C via D\nimport A\nimport B\n\nz = f (g 3)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\nmodule A where\n\nimport B ((:-))\n\n-- assumes :- is right-associative\nf :: Int :- Int :- Int\nf = (1,(2,3))\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TypeOperators #-}\n\nmodule B where\n\ninfixr 9 :-\n\ntype a :- b = (a,b)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TypeOperators #-}\n\nmodule B where\n\ninfixl 9 :-\n\ntype a :- b = (a,b)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (a) where\n\na = \"1.0\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (a) where\n\na = \"2.0\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B (b) where\n\nimport A\n\nb = a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport B\n\nmain = print b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (T,t) where\n\ndata T = T\nt = T\n\ninstance Eq T where\n  t1 == t2 = True\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (T,t) where\n\ndata T = T\nt = T\n\ninstance Eq T where\n  t1 == t2 = False\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B (T,t) where\n\nimport A\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport B\n\nmain = print (t == t)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\nimport Sub\nmain = print $x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Sub where\nx = [| 1 |]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Sub where\nx = [| 2 |]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport X\n\nmain :: IO ()\nmain = print $ case f x of A -> True; B -> False\n\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module X (x, D1(..), D2(..))\nwhere\n\ndata D1 = D { f :: D2 } -- deriving Show\ndata D2 = A | B -- deriving Show\n\nx :: D1\nx = D { f = A }\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module X (x, D1(..), D2(..))\nwhere\n\ndata D1 = D { f :: D2 } -- deriving Show\ndata D2 = A | B -- deriving Show\n\nx :: D1\nx = D { f = B }\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule Main where\n\n#include \"A.hsinc\"\n#include \"B.hsinc\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad (forM_)\n\nmain :: IO ()\nmain = forM_ [0..0xffff] $ \\i -> do\n   putStrLn $ \".section s\" ++ show i ++ \",\\\"\\\",@progbits\"\n   putStrLn $ \".asciz \\\"Section \" ++ show i ++ \"\\\"\"\n   putStrLn \"\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule A where\ntype family F a\ntype instance F Int = Bool\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule A2 where\ntype family F a\ntype instance F Int = Bool\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\nimport B\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D where\nimport C\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module E where\nimport D\nimport B\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule A where\ntype family F a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule B where\nimport A\ndata B\ntype instance F (B,b) = ()\nb :: () -> F (B,b)\nb = id\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule C where\nimport A\ndata C\ntype instance F (a,C) = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule C where\nimport A\ndata C\ntype instance F (a,C) = Bool\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D (b) where\nimport B\nimport C\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\nmodule E where\nimport A\nimport B\nimport C\nimport D\nc :: F (a, C) -> Bool\nc = id\ne :: () -> Bool\ne = c . b @ C\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport B\nimport C\n\nfoo :: Int\nfoo = 4\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\ndata B a = B a\n\nb :: a -> B a\nb = B\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\ndata C a = C a\n\nc :: a -> C a\nc = C\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nfoo :: Int\nfoo = 4\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B (foo) where\n\nimport A (foo)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B () where\n\nimport A ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport B (foo)\n\nmain :: IO ()\nmain = print foo\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Q where\n\nimport {-# SOURCE #-} W\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module W where\n\nimport Q\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nimport Data.Char\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NotMain where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MisspelledFlagA where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MisspelledFlagB where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- This should fail to compile with \"ghc -Wcpp-undef -Werror ...\".\n#if this_cpp_identifier_does_not_exist\nmessage :: String\nmessage = \"This is wrong!\"\n#endif\n\nmain :: IO ()\nmain = putStrLn \"Hello\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nimport C\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\nimport Language.Haskell.TH\n\nimport {-# SOURCE #-} A\n\nnothing = return [] :: Q [Dec]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T12062 where\n\nimport C\n\n$(nothing)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, CPP #-}\nimport Foreign.C\nforeign import ccall unsafe \"test\" test :: CInt -> IO ()\n\nmain :: IO ()\n-- Use conditional language to test passing a file with a filename\n-- starting with a hyphen to the preprocessor.\n#if defined(__GLASGOW_HASKELL__)\nmain = test 3\n#endif\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\nmodule A where\nimport B\ndata E = MkE\np (H{..}) = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\nimport {-# SOURCE #-} A\ndata H = H { h :: E }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\ndata T = T\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\ndata T' = T'\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport A\n\nx = T\n\nmain = print \"ok\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule D (D) where\n\ntype family D a\ntype instance D Int = Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule E where\n\nimport                Data.Kind (Type, Constraint)\nimport {-# SOURCE #-} Y\n\ndata E\n\ntype family CF a :: Type -> Constraint\ntype instance CF E = Y\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Y where\n\nimport                D ()\nimport {-# SOURCE #-} E\n\nclass Y o\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception (assert)\n\nmain = assert False (putStrLn \"OK\")\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F () where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module O (O) where\n\nclass O a where\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module V () where\n\nimport {-# SOURCE #-} F ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- {-# OPTIONS_GHC -fno-full-laziness #-}\nmodule A (toTypedData, toTypedDataNoDef) where\n\ntoTypedData :: String -> IO Int\ntoTypedData s = wrapPrint \"yoyo\" $ toTypedDataNoDef s\n\nwrapPrint :: String -> IO Int -> IO Int\nwrapPrint s act = do\n    putStrLn s\n    act\n\ntoTypedDataNoDef  :: String -> IO Int\ntoTypedDataNoDef s = return $ length s\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-full-laziness #-}\nmodule A (toTypedData, toTypedDataNoDef) where\n\ntoTypedData :: String -> IO Int\ntoTypedData s = wrapPrint \"yoyo\" $ toTypedDataNoDef s\n\nwrapPrint :: String -> IO Int -> IO Int\nwrapPrint s act = do\n    putStrLn s\n    act\n\ntoTypedDataNoDef  :: String -> IO Int\ntoTypedDataNoDef s = return $ length s\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B ( TypeClass(..) ) where\n\nimport A\n\nclass Show a => TypeClass a where\n    getSize :: a -> IO Int\n    getSize a = toTypedData (show a)\n\n    printA :: a -> IO ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport B\n\ndata MyDataType = MyDataType String Int deriving Show\n\ninstance TypeClass MyDataType where\n    printA = putStrLn . show\n\nmain :: IO ()\nmain = do\n    let myValue = MyDataType \"haha\" 99\n    sz <- getSize myValue\n    putStrLn $ show sz\n    printA myValue\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport C (x)\nimport GHC.Exts (inline)\n\nmain = print (inline x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C (x) where\n\nimport D\n\nx = f 2\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D (f) where\n\nimport E\n\n{-# INLINE f #-}\nf :: Int -> Int\nf x = h x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module E (h) where\n\nh :: Int -> Int\nh x = x + x + x + x + x + x + x + x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module E (h) where\n\nh :: Int -> Int\nh x = x + x + x + x + x + x + x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n\n    A (A)\n\n) where\n\n    import Internal\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Internal (\n\n    A (A)\n\n) where\n\n    data A = A\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\n    import A\n    import {-# SOURCE #-} Internal\n\n    a :: A\n    a = A\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Internal where\n\n    import B\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nimport Test2 hiding (main)\n\nmain = doit\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test2 where\n\ndoit = print \"Test2.doit\"\nmain = print \"Test2.main\"\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport B\n\nshowField :: Fields v -> String\nshowField a = show a\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule B where\n\nclass Entity v where\n   data Fields v\n\ninstance Show (Fields v) where show = undefined\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule B where\n\nclass Entity v where\n   data Fields v\n\n-- Remove instance\n-- instance Show (Fields v) where show = undefined\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\nmodule D where\n\nimport A\nimport C\n\ntypeRepX :: Fingerprint\ntypeRepX = mkTyConApp Fingerprint\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\nmodule A where\n\ndata Fingerprint = Fingerprint\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\nmodule B (fingerprintFingerprints) where\n\nimport A\nimport C\n\nfingerprintFingerprints :: [Fingerprint] -> Fingerprint\nfingerprintFingerprints = undefined mkTyConApp\n\nundefined :: a\nundefined = undefined\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule C where\n\nimport A\nimport {-# SOURCE #-} B\n\nmkTyConApp :: Fingerprint -> Fingerprint\nmkTyConApp f = fingerprintFingerprints [f]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified TestPrim\n\nmain = print $ TestPrim.tpo 8 9\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GHCForeignImportPrim #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule TestPrim\n  (\n    tpo#\n  , tpo\n  ) where\n\nimport GHC.Base -- Int and I#\n\nforeign import prim \"test_prim_op\" tpo# :: Int# -> Int# -> Int#\n\ntpo :: Int -> Int -> Int\ntpo (I# a) (I# b) = I# (tpo# a b)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport {-# SOURCE #-} B\n\ndata X = X Y\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport A\n\ndata Y = Y Int Int\n\nthing :: X -> a\nthing (X (Y a b)) = thing (X (Y a b))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\nimport A\nimport B\n\npanic :: Int -> a\npanic x = thing (X (Y x x))\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule A where\n\n#include \"A.inc\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -F -pgmF ./t8602.sh -optF A -optF B -optF C #-}\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule A where\n\ntype family F a b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule B where\n\nimport A\nimport C\n\ntype instance F a b = b\n\noops :: F a b -> a -> b\noops = const\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C (oops) where\n\nimport {-# SOURCE #-} B\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule D where\n\nimport A\nimport C\n\ntype instance F a b = a\n\nunsafeCoerce :: a -> b\nunsafeCoerce x = oops x x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport D ( unsafeCoerce )\n\nmain = print $ (unsafeCoerce True :: Int)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nmain :: IO ()\nmain = putStrLn \"hello world\"\n\nforeign export ccall \"hello\" hello :: IO ()\n\nhello :: IO ()\nhello = putStrLn \"hello world again\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nimport Foreign\nimport System.Posix.DynamicLinker\n\nmain :: IO ()\nmain = do\n    dl <- dlopen \"./T13702\" [RTLD_NOW]\n    funptr <- dlsym dl \"hello\" :: IO (FunPtr (IO ()))\n    mkAction funptr\n\nforeign import ccall \"dynamic\" mkAction :: FunPtr (IO ()) -> IO ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE ForeignFunctionInterface #-}\nmodule T3807Export where\n\nimport Foreign.C\n\nfoo :: IO CInt\nfoo = return (3 + read \"123\")\n\nforeign export ccall foo :: IO CInt\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule T4464H where\n\nf :: Int -> Int\nf x = x + 1\n\nforeign export ccall f :: Int -> Int\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = return ()\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = return ()\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = return ()\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = return ()\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fglasgow-exts -O -ddump-stranal #-}\n\nmodule Foo(foo) where\n\nfoo :: Int -> Int\nfoo n = baz (n+1) (bar1 n)\n\n{-# NOINLINE bar1 #-}\nbar1 n = 1 + bar n\n\nbar :: Int -> Int\n{-# NOINLINE bar #-}\n{-# RULES\n\"bar/foo\" forall n. bar (foo n) = n\n   #-}\nbar n = n-1\n\nbaz :: Int -> Int -> Int\n{-# INLINE [0] baz #-}\nbaz m n = m\n\n\n{- Ronam writes (Feb08)\n\n    Note that bar becomes dead as soon as baz gets inlined. But strangely,\n    the simplifier only deletes it after full laziness and CSE. That is, it\n    is not deleted in the phase in which baz gets inlined. In fact, it is\n    still there after w/w and the subsequent simplifier run. It gets deleted\n    immediately if I comment out the rule.\n\n    I stumbled over this when I removed one simplifier run after SpecConstr\n    (at the moment, it runs twice at the end but I don't think that should\n    be necessary). With this change, the original version of a specialised\n    loop (the one with the rules) is not longer deleted even if it isn't\n    used any more. I'll reenable the second simplifier run for now but\n    should this really be necessary?\n\nNo, it should not be necessary.  A refactoring in OccurAnal makes\nthis work right. Look at the simplifier output just before strictness\nanalysis; there should be a binding for 'foo', but for nothing else.\n\n-}\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fglasgow-exts -O -ddump-prep #-}\nmodule Max(result) where\n\nfoo ys = foldr (\\x xs -> x : reverse xs) [] ys\n\nresult xs =\n    let stuff = [1, 1, 1, 1, 1, 1]\n    in foo (reverse stuff)\n\n-- What used to happen is that foldr got expanded by main simplification\n-- and the resulting \"go\" function got floated out but because we manufactured\n-- a new binder for it in newPolyBndrs we would lose its demand signature!\n-- This means that the later application of it in result did not use call by value :-(\n\n-- Eyeball test:\n--  Ensure that Max.poly_go has a demand signature\n--  Ensure that we use call by value to call Max.poly_go in result\n--      i.e. the call to Max.poly_go inside Max.result looks like this:\n--\n-- case GHC.List.poly_rev @ t1_a6x sat_seb (GHC.Base.[] @ t1_a6x)\n--        of sat_sed { __DEFAULT ->\n--        Max.poly_go @ t1_a6x sat_sed\n--        } } in\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fglasgow-exts -O -ddump-simpl -fno-method-sharing #-}\nmodule Roman where\n\nimport Control.Monad.ST\n\nnewtype T s a = T { unT :: Int -> ST s a }\n\ninstance Monad (T s) where\n   return = T . const . return\n   T p >>= f = T $ \\i -> do { x <- p i\n                            ; unT (f x) i }\n\nmyIndex :: T s Int\n{-# INLINE myIndex #-}\nmyIndex = T return\n\nfoo :: T s Int\nfoo = do { x <- myIndex\n         ; return (x + 1) }\n\n\n{-   At one stage we got code looking like this:\n\n    U.a3 =\n       \\ (@ s_a8E) (i_shA :: GHC.Base.Int) (eta_shB :: GHC.Prim.State# s_a8E) ->\n         case ((((U.myIndex @ s_a8E)\n                 `cast` ...)\n                  i_shA)\n               `cast` ...)\n                eta_shB\n         of wild_si5 { (# new_s_shF, r_shG #) -> ...\n\n    U.foo :: forall s_a5S. U.T s_a5S GHC.Base.Int\n    U.foo = U.a3 `cast` ...\n\n\nThe point is that myIndex should be inlined, else code is bad -}\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fglasgow-exts -O -dshow-passes #-}\n\nmodule Foo where\nimport GHC.Base\n\nfoo :: Int -> Int\nfoo (I# n#) = bar i i\n   where i# = n# +# 1#\n         i  = I# i#\n\nbar :: Int -> Int -> Int\n{-# INLINE [0] bar #-}\nbar _ n = n\n\n{-   The trouble here was\n\n    *** Simplify:\n         Result size = 25\n         Result size = 25\n         Result size = 25\n         Result size = 25\n         Result size = 25\n    *** Simplify:\n         Result size = 25\n         Result size = 25\n         Result size = 25\n         Result size = 25\n         Result size = 25\n\n\n    etc.\n\nThe reason was this:\n        x = n# +# 1#\n        i = I# x\n\nBeing an unboxed value, we were treating the argument context of x\nas interesting, and hence inlining x in the arg of I#. But then we just\nfloat it out again, giving an infinite loop.\n-}\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fglasgow-exts -O -ddump-simpl #-}\nmodule Roman where\n\nfoo :: Int -> Maybe Int -> Int\nfoo 0 (Just n) = n\nfoo 0 Nothing  = 1\nfoo n p = let f = foo (n-1+n-1+n-1+n-1+n-1+n-1+n-1+n-1)\n           in\n           case p of { Just m -> f (Just m); Nothing -> f Nothing }\n\n\n{-  At one time this oddly produced;\n\n     foo = \\n p ->\n          case n of ds {\n            __DEFAULT ->\n              let\n                x = ds -# 1 +# ds -# 1 +# ds -# 1 +# ds -# 1 +# ds -# 1\n              in\n              case p of {\n                Nothing ->\n                  foo (x +# ds -# 1 +# ds -# 1 +# ds -# 1) Nothing\n                ;\n                Just m ->\n                  foo (x +# ds -# 1 +# ds -# 1 +# ds -# 1) (Just m)\n              };\n            0 ->\n              case p of {\n                Nothing -> lvl_sbC; Just n -> n\n              }\n          }\n\nBut it shouldn't; and doesn't now.\n\n-}\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CmmTx where\n\ndata TxRes a = TxRes Bool a\n\ninstance Monad TxRes where\n    return = TxRes False\n\n{-  Here you can get a simplifier loop thus:\nNOTE: Simplifier still going after 4 iterations; bailing out.  Size = 52\nNOTE: Simplifier still going after 4 iterations; bailing out.  Size = 52\nNOTE: Simplifier still going after 4 iterations; bailing out.  Size = 52\nNOTE: Simplifier still going after 4 iterations; bailing out.  Size = 52\n\nReason: 'a' is inline (not pre/post unconditionally; just ordinary inlining)\nThen, since ($dm>>) has arity 3, the rhs of (>>) is a PAP, so the arg is\nfloated out, past the big lambdas.\n\nSee Note [Unsaturated functions] in SimplUtils\n\n------------------------------------------------------------\na_s9f{v} [lid] =\n  base:GHC.Base.:DMonad{v r5} [gid]\n    @ main:CmmTx.TxRes{tc rd}\n    >>={v a6E} [lid]\n    >>{v a6H} [lid]\n    return{v a6J} [lid]\n    fail{v a6M} [lid]\n>>{v a6H} [lid] [ALWAYS LoopBreaker Nothing] :: forall a{tv a6F} [tv]\n                                                       b{tv a6G} [tv].\n                                                main:CmmTx.TxRes{tc rd} a{tv a6F} [tv]\n                                                -> main:CmmTx.TxRes{tc rd} b{tv a6G} [tv]\n                                                -> main:CmmTx.TxRes{tc rd} b{tv a6G} [tv]\n[Arity 2\n Str: DmdType LL]\n>>{v a6H} [lid] =\n  \\ (@ a{tv a78} [sk] :: ghc-prim:GHC.Prim.*{(w) tc 34d})\n    (@ b{tv a79} [sk] :: ghc-prim:GHC.Prim.*{(w) tc 34d}) ->\n    base:GHC.Base.$dm>>{v r5f} [gid]\n      @ main:CmmTx.TxRes{tc rd} a_s9f{v} [lid] @ a{tv a78} [sk] @ b{tv a79} [sk]\n -}\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "> {-# LANGUAGE BangPatterns,CPP #-}\n> module IOList (delete) where\n\nGoal: we want all the IORef boxes to go away in the \"delete\" operation\nbelow.  There are two versions of the code: one using the record\nselector \"next\", the other using a hand-written record selector\n\"myNext\" (see the use in delete).  Currently (6.10), neither version\ngives good code, but for different reasons.  The record selector\nversion is not inlined, and the myNext version gives rise to a join\npoint that takes the reboxed IORef as an argument.\n\n#define USE_UNPACK\n-- #define USE_STRICT\n\n#if defined(USE_UNPACK)\n#define UNPACK(p) {-# UNPACK #-} !(p)\n#elif defined(USE_STRICT)\n#define UNPACK(p) !(p)\n#else\n#define UNPACK(p) p\n#endif\n\n> import Data.IORef\n\n> data List a = Node { val :: a, next :: UNPACK(IORef (List a))}   \n>           | Null\n>           | Head {next :: UNPACK(IORef (List a)) }\n\n> {-# INLINE [0] myNext #-}\n> myNext :: List a -> IORef (List a)\n> myNext Node{next=n} = n\n> myNext Head{next=n} = n\n> myNext Null = error \"null\"\n\n> data ListHandle a = ListHandle { headList :: UNPACK(IORef (IORef (List a))),\n>                            tailList :: UNPACK(IORef (IORef (List a))) }\n  \n> delete :: Eq a => ListHandle a -> a -> IO Bool\n> delete (ListHandle {headList = ptrPtr})  i = \n>          do startptr <- readIORef ptrPtr\n>             delete2 startptr i\n>   where\n>    delete2 :: Eq a => IORef (List a) -> a -> IO Bool\n>    delete2 prevPtr i =\n>     do\n>    { prevNode <- readIORef prevPtr\n>    ; let curNodePtr = next {- or: myNext -} prevNode --  head/node have both next \n>    ; curNode <- readIORef curNodePtr\n>    ; case curNode of\n>        Null -> return False  -- we've reached the end of the list\n>                              -- element not found\n>        Node {val = curval, next = nextNode} ->\n>          if (curval /= i) \n>           then delete2 curNodePtr i         -- keep searching\n>           else \n>               -- delete element (ie delink node)\n>               do { case prevNode of\n>                      Head {} -> do writeIORef prevPtr (Head {next = nextNode})\n>                                    return True\n>                      Node {} -> do writeIORef prevPtr\n>                                       (Node {val = val prevNode, next = nextNode})\n>                                    return True\n>                  }\n>     }\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Check that the record selector for maskMB unfolds in the body of f\n-- At one stage it didn't because the implicit unfolding looked too big\n\n-- Trac #2581\n\nmodule ShouldCompile where\nimport Data.Array.Base\n\ndata MBloom s a = MB {\n     shiftMB :: {-# UNPACK #-} !Int\n    , maskMB :: {-# UNPACK #-} !Int\n    , bitArrayMB :: {-# UNPACK #-} !(STUArray s Int Int)\n    }\n\nf a b c = case maskMB (MB a b c) of\n            3 -> True\n            _ -> False\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 -ddump-simpl  #-}\nmodule Roman where\n\n{- From: Roman Leshchinskiy [mailto:rl@cse.unsw.edu.au]\n   Sent: 07 February 2008 03:34\n   Subject: Quadratic SpecConstr\n\nHere is a program which makes SpecConstr generate a quadratic number of\niterations:\n-}\n\n\nbar :: Int -> Int -> Int\nbar m n = foo n (n,n) (n,n) (n,n) (n,n)\n   where\n     foo :: Int -> (Int,Int) -> (Int,Int) -> (Int,Int) -> (Int,Int) -> Int\n     foo n p q r s\n       | n == 0    = m\n       | n > 3000  = case p of { (p1,p2) -> foo (n-1) (p2,p1) q r s }\n       | n > 2000  = case q of { (q1,q2) -> foo (n-1) p (q2,q1) r s }\n       | n > 1000  = case r of { (r1,r2) -> foo (n-1) p q (r2,r1) s }\n       | otherwise = case s of { (s1,s2) -> foo (n-1) p q r (s2,s1) }\n\n{- For this particular function, I get 14 specialisations, one for each\n   possible combination of arguments.\n\n   However, since we can see all the call sites outside the loop, we could\n   use that to 'seed' the specialisation, and get just one specialisation.\n-}\n\n\n-- Eyeball guidance:\n--      There should be just one specialisation for foo\n--      Indeed, the original function should disappear,\n--              since it isn't used\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The question here is whether f gets eta-expanded\n-- (assuming the state hack).  It should, but\n-- didn't in GHC 6.10\n\nmodule Foo where\n\nimport GHC.Base\n\n{-# NOINLINE z #-}\nz :: State# a -> Bool\nz s = True\n\n{-# NOINLINE k #-}\nk :: Int -> State# a -> Bool\nk y s = False\n\n\nf []     = z\nf (x:xs) = k (length xs)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -O2 -XBangPatterns #-}\n\n-- The thing to look for here is that the implementation\n-- of 'length' does not allocate in the inner loop\n--\n-- See Trac #3116\n\nmodule T3116 where\n\nimport Foreign\n\ndata SByteString\n   = BS  {-# UNPACK #-} !(ForeignPtr Word8)  -- payload\n         {-# UNPACK #-} !Int                 -- offset\n         {-# UNPACK #-} !Int                 -- length\n\ndata ByteString\n    =  Empty\n    |  Chunk {-# UNPACK #-} !SByteString ByteString\n\nbnull :: ByteString -> Bool\nbnull Empty = True\nbnull _     = False\n\nbtail :: ByteString -> ByteString\nbtail Empty = error \"empty tail\"\nbtail (Chunk (BS fp s 1) cs) = cs\nbtail (Chunk (BS fp s l) cs) = Chunk (BS fp (s+1) (l-1)) cs\n\nlength :: ByteString -> Int\nlength = go 0\n  where\n    go !n bs  | bnull bs   = n\n              | otherwise  = go (n+1) (btail bs)\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cc001 -- ccall with standard boxed arguments and results\n\nmodule ShouldCompile where\n\n-- simple functions\n\nforeign import ccall unsafe \"a\" a :: IO Int\n\nforeign import ccall unsafe \"b\" b :: Int -> IO Int\n\nforeign import ccall unsafe \"c\"\n  c :: Int -> Char -> Float -> Double -> IO Float\n\n-- simple monadic code\n\nd =     a               >>= \\ x ->\n        b x             >>= \\ y ->\n        c y 'f' 1.0 2.0\n\n\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnliftedFFITypes #-}\n-- !!! cc004 -- foreign declarations\nmodule ShouldCompile where\n\nimport Foreign\nimport GHC.Exts\nimport Data.Int\nimport Data.Word\n\n-- importing functions\n\n-- We can't import the same function using both stdcall and ccall\n-- calling conventions in the same file when compiling via C (this is a\n-- restriction in the C backend caused by the need to emit a prototype\n-- for stdcall functions).\nforeign import stdcall        \"p\" m_stdcall :: StablePtr a -> IO (StablePtr b)\nforeign import ccall   unsafe \"q\" m_ccall   :: ByteArray# -> IO Int\n\n-- We can't redefine the calling conventions of certain functions (those from\n-- math.h).\nforeign import stdcall \"my_sin\" my_sin :: Double -> IO Double\nforeign import stdcall \"my_cos\" my_cos :: Double -> IO Double\n\nforeign import stdcall \"m1\" m8  :: IO Int8\nforeign import stdcall \"m2\" m16 :: IO Int16\nforeign import stdcall \"m3\" m32 :: IO Int32\nforeign import stdcall \"m4\" m64 :: IO Int64\n\nforeign import stdcall \"dynamic\" d8  :: FunPtr (IO Int8) -> IO Int8\nforeign import stdcall \"dynamic\" d16 :: FunPtr (IO Int16) -> IO Int16\nforeign import stdcall \"dynamic\" d32 :: FunPtr (IO Int32) -> IO Int32\nforeign import stdcall \"dynamic\" d64 :: FunPtr (IO Int64) -> IO Int64\n\nforeign import ccall unsafe \"kitchen\"\n   sink :: Ptr a\n        -> ByteArray#\n        -> MutableByteArray# RealWorld\n        -> Int\n        -> Int8\n        -> Int16\n        -> Int32\n        -> Int64\n        -> Word8\n        -> Word16\n        -> Word32\n        -> Word64\n        -> Float\n        -> Double\n        -> IO ()\n\n\ntype Sink2 b = Ptr b\n            -> ByteArray#\n            -> MutableByteArray# RealWorld\n            -> Int\n            -> Int8\n            -> Int16\n            -> Int32\n            -> Word8\n            -> Word16\n            -> Word32\n            -> Float\n            -> Double\n            -> IO ()\n\nforeign import ccall unsafe \"dynamic\"\n  sink2 :: Ptr (Sink2 b) -> Sink2 b\n\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cc005 -- foreign export declarations\nmodule ShouldCompile (d8) where\n\nimport Foreign.Ptr   --import Foreign\n                 --import GlaExts\n                 --import Int\n                 --import Word\ntype Addr = FunPtr (Int -> IO ())\nforeign import ccall \"wrapper\" d8  :: (Int -> IO ())  -> IO Addr\n\n-- exporting functions\n{-\nm_stdcall :: Int -> IO Int\nm_stdcall x = return x\n\nx = putChar\n\nforeign export ccall \"m1\" doo :: Int -> IO Int\n\ndoo :: Eq a => a -> IO Int\ndoo _ = return 2\n\nforeign export ccall \"listAppend\" plusplus :: StablePtr [a] -> StablePtr [a] -> IO (StablePtr [a])\n\nplusplus :: StablePtr [a] -> StablePtr [a] -> IO (StablePtr [a])\nplusplus x y = do\n  l1 <- deRefStablePtr x\n  l2 <- deRefStablePtr y\n  makeStablePtr (l1 ++ l2)\n\nforeign export ccall \"m11\" m_stdcall :: Int -> IO Int\n\nm_ccall :: Int -> Int -> IO Int\nm_ccall x y = return (x-y)\n\nforeign export ccall   \"m2\" m_ccall   :: Int -> Int -> IO Int\n\nforeign export ccall   \"putcha\" putChar :: Char -> IO ()\n\nforeign export stdcall \"Math\" \"sin\" my_sin :: Double -> IO Double\nforeign export stdcall \"Math\" \"cos\" my_cos :: Double -> IO Double\n\nmy_sin = undefined\nmy_cos = undefined\n\nforeign export stdcall \"m111\" m8  :: IO Int8\nforeign export stdcall \"m22\" m16 :: IO Int16\nforeign export stdcall \"m3\" m32 :: IO Int32\nforeign export stdcall \"m4\" m64 :: IO Int64\n\nm8 = undefined\nm16 = undefined\nm32 = undefined\nm64 = undefined\n\nforeign export stdcall dynamic d8  :: (Addr -> IO Int8)  -> IO Addr\nforeign export stdcall dynamic d16 :: (Addr -> IO Int16) -> IO Addr\nforeign export stdcall dynamic d32 :: (Addr -> IO Int32) -> IO Addr\nforeign export stdcall dynamic d64 :: (Addr -> IO Int64) -> IO Addr\n\n\nd8 = undefined\nd16 = undefined\nd32 = undefined\nd64 = undefined\n\n\nforeign export ccall \"kitchen\"\n   sink :: --ForeignObj\n--        -> ByteArray Int\n--      -> MutableByteArray Int RealWorld\n           Int\n        -> Int8\n        -> Int16\n        -> Int32\n        -> Int64\n        -> Word8\n        -> Word16\n        -> Word32\n        -> Word64\n        -> Float\n        -> Double\n        -> IO Int\n\nsink  = undefined\nsink2 = undefined\n\nforeign export ccall dynamic\n  sink2 :: (--ForeignObj\n--        -> ByteArray Int\n--      -> MutableByteArray Int RealWorld\n           StablePtr a\n        -> Int\n        -> Int8\n        -> Int16\n        -> Int32\n        -> Int64\n        -> Word8\n        -> Word16\n        -> Word32\n        -> Word64\n        -> Float\n        -> Double\n        -> IO ())\n        -> IO Addr\n\n\n-}\n", "num_lines": 109}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cc007 -- foreign import with external name equal to Haskell name.\nmodule ShouldCompile where\n\nforeign import ccall sine :: Double -> Double\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cc008 -- foreign export dynamic returning newtype of Addr\nmodule ShouldCompile where\n\nimport Foreign\ntype Addr = FunPtr (IO ())\nnewtype NPtr a = NPtr Addr\n\nforeign import ccall \"wrapper\" mkFoo :: IO () -> IO (NPtr Int)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cc009 -- foreign label returning newtype of Addr\nmodule ShouldCompile where\n\nimport Foreign\ntype Addr = Ptr ()\nnewtype NPtr a = NPtr Addr\n\nforeign import ccall \"&\" foo :: NPtr Int\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\nimport Foreign\nforeign import ccall \"dynamic\" imp :: FunPtr Int -> Int\nf1 a = imp a + 1\nf2 a = imp a + 2\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nimport Foreign\n\n-- !!! test that a recursive newtype can be used as an argument or result\n-- type of a foreign import. \n\nnewtype T = T (Ptr T)\nforeign import ccall foo :: T -> IO T\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n-- !!! test that infix operators can be exported with foreign export,\n-- and that we can export something which isn't defined in this module.\nmodule ShouldCompile where\nforeign export ccall \"plusInt\" (+) :: Int -> Int -> Int\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n-- !!! test that exporting the same thing multiple times works.\nmodule ShouldCompile where\n\nimport Data.Int\n\nforeign export ccall \"addByte\" (+) :: Int8  -> Int8  -> Int8\nforeign export ccall \"addInt\"  (+) :: Int16 -> Int16 -> Int16\nforeign export ccall \"addLong\" (+) :: Int32 -> Int32 -> Int32\n\nforeign export ccall \"divByte\" div :: Int8  -> Int8  -> Int8\nforeign export ccall \"divInt\"  div :: Int16 -> Int16 -> Int16\nforeign export ccall \"divLong\" div :: Int32 -> Int32 -> Int32\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Blah ( foo ) where\nimport Foreign.Ptr ( FunPtr )\ntype Bar = Int -> Double -> Double -> Double -> IO ()\nforeign import ccall unsafe \"dynamic\" foo :: FunPtr Bar -> Bar\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Cc015 where\n\nimport Foreign\nimport Foreign.C.Types\n\ntype S a = a\ntype IOS a = IO a\ntype SFunPtr a = FunPtr a\n\ntype family F a\ntype instance F Int = Int\ntype instance F Bool = G2\ntype instance F Char = FunPtr (Int -> IO Int)\n\nnewtype G1  = G1  Int\nnewtype G1F = G1F (F (S Int))\nnewtype G2  = G2  Char\nnewtype G3  = G3  (IO Int)\nnewtype G4  = G4  G3\nnewtype NIO a = NIO (IO a)\n\n-- Type synonyms should be transparent to the typechecker\nforeign import ccall f1       ::          S Int -> IOS Int\nforeign export ccall \"g1\"  f1 ::          S Int -> IOS Int\nforeign import ccall \"&h1\" h1 :: SFunPtr (S Int -> IOS Int)\n-- As should type functions\nforeign import ccall f2         ::         F Int -> IO (F Int)\nforeign export ccall \"g2\"   f2  ::         F Int -> IO (F Int)\nforeign import ccall \"&h2\"  h2  :: F Char\nforeign import ccall \"&h2b\" h2b :: FunPtr (F Int -> IO (F Int))\n-- And newtype\nforeign import ccall f3       ::         G1 -> G2 -> G4\nforeign export ccall \"g3\" f3  ::         G1 -> G2 -> G4\nforeign import ccall \"&h3\" h3 :: FunPtr (G1 -> G2 -> G4)\n-- And a combination\nforeign import ccall f4       ::         G1F -> F Bool -> S G4\nforeign export ccall \"g4\" f4  ::         G1F -> F Bool -> S G4\nforeign import ccall \"&h4\" h4 :: FunPtr (G1F -> F Bool -> S G4)\n-- And a newtyped IO\nforeign import ccall f5       ::         NIO Int\nforeign export ccall \"g5\" f5  ::         NIO Int\nforeign import ccall \"&h5\" h5 :: FunPtr (NIO Int)\n\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TypeFamilies, GHCForeignImportPrim, MagicHash,\n             UnliftedFFITypes #-}\n\nmodule Cc015 where\n\nimport Foreign\nimport Foreign.C.Types\nimport GHC.Prim\n\ntype family F a\ntype instance F Int = Int# -> Int#\n\nforeign import prim \"f\" f :: F Int\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\n-- Tests newtype unwrapping for the IO monad itself\n-- Notice the RenderM monad, which is used in the\n-- type of the callback function\n\nmodule ShouldCompile where\n\nimport Control.Applicative (Applicative)\n\nimport Foreign.Ptr\nnewtype RenderM a = RenderM (IO a) deriving (Functor, Applicative, Monad)\n\ntype RenderCallback = Int -> Int -> RenderM ()\n\nforeign import ccall duma_onRender :: FunPtr RenderCallback -> RenderM ()\n\nforeign import ccall \"wrapper\" mkRenderCallback\n     :: RenderCallback -> RenderM (FunPtr RenderCallback)\n\nonRender :: RenderCallback -> RenderM ()\nonRender f = mkRenderCallback f >>= duma_onRender\n\n\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GHCForeignImportPrim #-}\nmodule T10460 where\nimport GHC.Exts\n-- don't link me!\nforeign import prim \"f\" f :: Any -> Any\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule T11983 where\n\n{-# INCLUDE T11983.h #-}\n\nimport Foreign.Ptr\n\nforeign import ccall \"intptr_example\"\n    intPtrExample :: IntPtr -> IO ()\nforeign import ccall \"uintptr_example\"\n    wordPtrExample :: WordPtr -> IO ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule T where\n\nimport Foreign\nforeign import ccall \"f\" f :: FunPtr (Int -> IO ())\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14125 where\n\nimport Foreign.C.String\nimport Foreign.C.Types\n\ndata UnixReturn\n\ndata family IOErrno a\nnewtype instance IOErrno UnixReturn = UnixErrno CInt\n\nforeign import ccall unsafe \"string.h\"\n  strerror :: IOErrno UnixReturn -> IO CString\n\nforeign import ccall unsafe \"HsBase.h __hscore_get_errno\"\n  get_errno :: IO (IOErrno UnixReturn)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Test where\n\nforeign import ccall \"path/to/foo.h foo\" foo :: Int -> IO Float\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nimport Foreign\nimport Foreign.C\n\n-- extra space before the function name:\nforeign import ccall unsafe \" g_get_application_name\"\n  g_get_application_name :: (IO (Ptr CChar))\n\n-- and after:\nforeign import ccall unsafe \"g_get_application_name \"\n  g_get_application_name' :: (IO (Ptr CChar))\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CApiFFI #-}\n\nmodule M where\n\nimport Foreign.C\n\nforeign import capi \"math.h value sqrt\" f :: CInt -> CInt\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CApiFFI #-}\n\nmodule Main (main) where\n\nimport Foreign.C\n\nmain :: IO ()\nmain = print i\n\nforeign import ccall \"ccall_value_c.h value i\" i :: CInt\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE ForeignFunctionInterface, MagicHash #-}\n\n-- Trac #1037 \n\nmodule Foo where\n\nimport GHC.Prim\n\nforeign import ccall foo :: Int -> State# RealWorld\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE ForeignFunctionInterface, UnboxedTuples, MagicHash, UnliftedFFITypes #-}\n\n-- Test for Trac #1680\n\nmodule ShouldFail where\n\nimport GHC.Exts\n\nforeign import ccall unsafe \"foo\"\n        foo :: Int# -> Int# -> Int# -> (# Int# , Int#, Int# #)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnliftedFFITypes, MagicHash #-}\n-- !!! illegal types in foreign export delarations\nmodule ShouldFail where\n\nimport GHC.Exts\n\nforeign export ccall foo :: Int# -> IO ()\nfoo i | isTrue# (i ==# 0#) = return ()\n\nforeign export ccall bar :: Int -> Int#\nbar _ = 42#\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Ccfail004 where\n\nimport Ccfail004A\n\nnewtype NT = NT [NT]\n\n-- All these should be rejected as the newtype constructors aren't in scope\nforeign import ccall f1 :: NInt -> IO Int\nforeign import ccall f2 :: Int -> IO NInt\nforeign import ccall f3 :: Int -> NIO Int\n\n-- Both these should be rejected as NT is recursive\nforeign import ccall f4 :: NT -> IO ()\nforeign import ccall f5 :: IO NT\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Ccfail004A (NInt, NIO) where\n\nnewtype NInt = NInt Int\n\nnewtype NIO a = NIO (IO a)\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Ccfail005 where\n\ntype family F a\ntype instance F Bool = D -> IO Int\ntype instance F Char = Int -> IO D\ndata D = D\n\n-- These should be rejected as D isn't a type we can use with the FFI.\n-- Note that, in the signature the user writes, there aren't an\n-- \"argument type\" and \"result type\" to complain about, though.\nforeign import ccall f1 :: F Bool\nforeign import ccall f2 :: F Char\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, GHCForeignImportPrim #-}\n\nmodule T10461 where\nimport GHC.Exts\n\nforeign import prim cheneycopy :: Any -> Word#\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, RankNTypes #-}\nmodule Foo where\n\nimport Foreign\ntype X u = Ptr ()\nforeign import ccall bla :: (forall u. X u) -> IO ()\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5664 where\n\nimport Foreign\nimport Foreign.C\n\ndata D = D\nnewtype I = I CInt\n\nforeign import ccall \"dynamic\"\n  mkFun1 :: FunPtr (CInt -> IO ()) -> CInt -> IO ()\n\nforeign import ccall \"dynamic\"\n  mkFun2 :: FunPtr (I -> IO ()) -> CInt -> IO ()\n\nforeign import ccall \"dynamic\"\n  mkFun3 :: FunPtr (D -> IO ()) -> CInt -> IO ()\n\nforeign import ccall \"wrapper\"\n  mkCallBack1 :: IO CInt -> IO (FunPtr (IO CInt))\n\nforeign import ccall \"wrapper\"\n  mkCallBack2 :: IO CInt -> IO (FunPtr (IO I))\n\nforeign import ccall \"wrapper\"\n  mkCallBack3 :: IO CInt -> IO (FunPtr (IO D))\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7243 where\n\nimport Foreign.Ptr\nforeign import ccall \"wrapper\" foo :: IO (FunPtr ())\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nimport Foreign.Ptr\n\n-- foreign import ccall \"stdio.h &putchar\" c_putchar :: () -> FunPtr (Char -> IO ())\nforeign import ccall \"stdio.h &putchar\" c_putchar :: Int -> IO ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\n-- | Test that unsafe FFI calls crash the RTS if they attempt to re-enter\n-- Haskell-land\nmodule Main where\n\nimport Foreign\n\nforeign import ccall \"wrapper\" wrap_f :: IO () -> IO (FunPtr (IO ()))\nforeign import ccall unsafe hello :: FunPtr (IO ()) -> IO ()\n\nf :: IO ()\nf = putStrLn \"Back in Haskell\"\n\nmain :: IO ()\nmain = do\n    putStrLn \"In Haskell\"\n    wrap_f f >>= hello\n    putStrLn \"Finished\"\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CApiFFI #-}\n\nmodule Main (main) where\n\nimport Capi_Ctype_A_002\n\nimport Foreign\nimport Foreign.C\n\nmain :: IO ()\nmain = alloca $ \\p ->\n           do poke p (Foo 5 6 7)\n              r1 <- f p\n              print r1\n\nforeign import capi unsafe \"capi_ctype_002_B.h f\"\n    f :: Ptr Foo -> IO CInt\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CApiFFI #-}\n\nmodule Main (main) where\n\nimport Foreign.C\n\nmain :: IO ()\nmain = do print i\n          print j\n\nforeign import capi \"capi_value_c.h value i\" i :: CInt\nforeign import capi \"capi_value_c.h value j\" j :: CInt\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport Foreign\nimport Foreign.Ptr\n\ntype CInt  = Int32\ntype CSize = Word32\n\nforeign import ccall \"wrapper\"\n   mkComparator :: (Ptr Int -> Ptr Int -> IO CInt)\n                -> IO (Ptr (Ptr Int -> Ptr Int -> IO CInt))\n\nforeign import ccall\n   qsort :: Ptr Int -> CSize -> CSize -> Ptr (Ptr Int -> Ptr Int -> IO CInt)\n         -> IO ()\n\ncompareInts :: Ptr Int -> Ptr Int -> IO CInt\ncompareInts a1 a2 = do\n   i1 <- peek a1\n   i2 <- peek a2\n   return (fromIntegral (i1 - i2 :: Int))\n\nmain :: IO ()\nmain = do\n   let values = [ 12, 56, 90, 34, 78 ] :: [Int]\n       n      = length values\n   buf <- mallocArray n\n   zipWithM_ (pokeElemOff buf) [ 0 .. ] values\n   c <- mkComparator compareInts\n   qsort buf (fromIntegral n) (fromIntegral (sizeOf (head values))) c\n   mapM (peekElemOff buf) [ 0 .. n-1 ] >>= (print :: [Int] -> IO ())\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n-- !!! A simple FFI test\n\n-- This one provoked a bogus renamer error in 4.08.1:\n--      panic: tcLookupGlobalValue: <THIS>.PrelIOBase.returnIO{-0B,s-}\n-- (the error was actually in DsMonad.dsLookupGlobalValue!)\n\nmodule Main where\n\nimport Foreign\n\nforeign export ccall \"gccd\" mygcd :: Int -> Int -> Int\n\nmain = putStrLn \"No bug\"\n\nmygcd a b = if (a==b) then a\n            else if (a<b) then mygcd a (b-a)\n            else mygcd (a-b) a\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Foo where\n\nforeign export ccall foo :: Int -> IO Int\n\nfoo :: Int -> IO Int\nfoo n = return (length (f n))\n\nf :: Int -> [Int]\nf 0 = []\nf n = n:(f (n-1))\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test passing doubles to a ccall\n\nimport Foreign.C\n\nforeign import ccall unsafe \"math.h sin\"\n  c_sin :: CDouble -> IO CDouble\n\nmain = c_sin 1.0 >>= print\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test ccalls with large numbers of arguments\n\n-- In 0.19, we lost the ability to do ccalls with more than 6 arguments\n-- on the Sparc.  Just to make sure it never happens again...\n\nimport Foreign.C\n\nmain =\n  withCString \"Testing %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\\n\" $ \\cstr ->\n  printf cstr\n         0  1  2  3  4  5  6  7  8  9\n        10 11 12 13 14 15 16 17 18 19\n        20 21 22 23 24 25 26 27 28 29\n        30 31 32 33 34 35 36 37 38 39\n\nforeign import ccall unsafe\n  printf :: CString\n         -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n         -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n         -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n         -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n         -> IO ()\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test for foreign import dynamic/wrapper, originally by Alastair Reid,\n-- with a few changes to get it to run on GHC by Simon Marlow.\n\nimport Foreign hiding ( unsafePerformIO )\nimport Foreign.C\nimport Control.Exception\nimport System.IO.Unsafe\nimport Prelude hiding (read)\nimport System.IO (hFlush, stdout)\n\nmain = do\n\n  putStrLn \"\\nTesting sin==mysin (should return lots of Trues)\"\n  print (testSin sin mysin)\n\n-- disabled because errno is not necessarily a label these days\n\n--   putStrLn \"\\nTesting errno\"\n--   err <- peek errno\n--  putStrLn $ \"errno == \" ++ show err\n\n  putStrLn \"\\nTesting puts (and withString)\"\n  withCString \"Test successful\" puts\n\n  putStrLn \"\\nTesting peekArray0\"\n  s <- withCString \"Test successful\" (peekArray0 (castCharToCChar '\\0'))\n  putStr (map castCCharToChar s)\n\n-- disabled due to use of non-portable constants in arguments to open:\n\n--  putStrLn \"\\nTesting open, read and close\"\n--  s <- testRead \"ffi005.hs\" 200\n--  putStrLn (map castCCharToChar s)\n\n--  putStrLn \"\\nTesting open, write and close\"\n--  testWrite \"/tmp/test_write\" \"Test successful\"\n\n  putStrLn \"\\nTesting sin==dynamic_sin (should return lots of Trues)\"\n  print (testSin sin (dyn_sin sin_addr))\n\n  putStrLn \"\\nTesting sin==IO wrapped_sin (should return lots of Trues)\"\n  sin_addr2 <- wrapIO (return . sin)\n  print (testSin sin (unsafePerformIO . (dyn_sinIO sin_addr2)))\n  freeHaskellFunPtr sin_addr2\n\n  putStrLn \"\\nTesting sin==Id wrapped_sin (should return lots of Trues)\"\n  sin_addr3 <- wrapId sin\n  print (testSin sin (dyn_sin sin_addr3))\n  freeHaskellFunPtr sin_addr3\n\n  putStrLn \"\\nTesting exit\"\n  hFlush stdout\n  exit 3\n\ntestSin f g = [ (f x == g x) | x <- [0,0.01 .. 1] ]\n\nforeign import ccall \"sin\" mysin :: CDouble -> CDouble\nforeign import ccall \"dynamic\" dyn_sin :: FunPtr (CDouble -> CDouble) -> (CDouble -> CDouble)\nforeign import ccall \"dynamic\" dyn_sinIO :: FunPtr (CDouble -> IO CDouble) -> (CDouble -> IO CDouble)\nforeign import ccall \"&sin\" sin_addr :: FunPtr (CDouble -> CDouble)\nforeign import ccall \"wrapper\" wrapId :: (CDouble -> CDouble) -> IO (FunPtr (CDouble -> CDouble))\nforeign import ccall \"wrapper\" wrapIO :: (CDouble -> IO CDouble) -> IO (FunPtr (CDouble -> IO CDouble))\n\n-- foreign import ccall safe \"static stdlib.h &errno\" errno :: Ptr CInt\n\nwithBuffer sz m = do\n  b <- mallocArray sz\n  sz' <- m b\n  s <- peekArray sz' b\n  free b\n  return s\n\nforeign import ccall puts :: CString -> IO CInt\n\n-- foreign import ccall \"open\" open'  :: CString -> CInt -> IO CInt\n-- foreign import ccall \"open\" open2' :: CString -> CInt -> CInt -> IO CInt\n-- foreign import ccall \"creat\" creat' :: CString -> CInt -> IO CInt\n-- foreign import ccall        close :: CInt -> IO CInt\n-- foreign import ccall \"read\" read' :: CInt -> CString -> CInt -> IO CInt\n-- foreign import ccall \"write\" write' :: CInt -> CString -> CInt -> IO CInt\n\n-- creat s m   = withCString s $ \\s' -> unix \"creat\" $ creat' s' m\n-- open s m    = withCString s $ \\s' -> unix \"open\"  $ open' s' m\n-- open2 s m n = withCString s $ \\s' -> unix \"open2\" $ open2' s' m n\n-- write fd s  = withCString s $ \\s' -> unix \"write\" $ write' fd s' (fromIntegral (length s))\n-- read  fd sz = withBuffer sz $ \\s' -> unix \"read\"  $ read' fd s' (fromIntegral sz)\n\n-- unix s m = do\n--   x <- m\n--   if x < 0\n--    then do\n--      err <- peek errno\n--      ioError $ userError $ s ++ \": \" ++ show (x,err)\n--    else return (fromIntegral x)\n\n-- testRead fn sz = bracket (open fn 0) close (flip read sz)\n-- testWrite fn s = bracket (open2 fn (512+64+1) 511) close (flip write s)\n\nforeign import ccall exit :: Int -> IO ()\n\n-- Various bits of rubbish.\n-- foreign import ccall \"static stdlib.h exit\" (***) :: CString -> CString -> IO Int\n--\n-- foreign import ccall safe \"static stdlib.h printf\" (+++) :: CString -> CString -> IO Int\n-- foreign import ccall safe \"static stdlib.h &errno\" illegal_foo :: Ptr Int\n--\n-- foreign import ccall safe \"wrapper\" illegal_bar :: Char -> IO (FunCString)\n-- foreign import ccall safe \"dynamic\" illegal_baz :: FunCString -> Char\n\n-- foreign export ccall \"id_charstar\" id :: CString -> CString\n  \n", "num_lines": 112}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test that we can call a foreign import \"wrapper\" using foreign\n-- import \"dynamic\", in both IO and non-IO flavours.\n\nimport Foreign\nimport Foreign.C\n\ntype IOF = Int -> IO Int\ntype F   = Int ->    Int\n\nforeign import ccall \"wrapper\" wrap_f    :: F -> IO (FunPtr F)\nforeign import ccall \"wrapper\" wrap_f_io :: IOF -> IO (FunPtr IOF)\n\nforeign import ccall \"dynamic\" f    :: FunPtr F   -> F\nforeign import ccall \"dynamic\" f_io :: FunPtr IOF -> IOF\n\ndouble :: Int -> Int\ndouble x = x * 2\n\ndouble_io :: Int -> IO Int\ndouble_io x = return (x * 2)\n\nmain = do\n  double1 <- wrap_f double\n  print (f double1 42)\n  double2 <- wrap_f_io double_io\n  x <- f_io double2 42\n  print x\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test System.Exit.exitWith called from a foreign import \"wrapper\"\n\nimport Foreign\nimport Foreign.C\n\nimport System.Exit\n\ntype IOF = IO ()\nforeign import ccall \"wrapper\" wrap_f_io :: IOF -> IO (FunPtr IOF)\nforeign import ccall \"dynamic\" call_io :: FunPtr IOF -> IOF\n\nexit = do putStrLn \"exiting...\"; exitWith ExitSuccess\n\nmain = do f <- wrap_f_io exit; call_io f\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test exceptions in a foreign import \"wrapper\"\n\nimport Foreign\nimport Foreign.C\n\nimport System.Exit\n\ntype IOF = IO ()\nforeign import ccall \"wrapper\" wrap_f_io :: IOF -> IO (FunPtr IOF)\nforeign import ccall \"dynamic\" call_io :: FunPtr IOF -> IOF\n\nmk_error = error \"this is an error\"\n\nmain = do f <- wrap_f_io mk_error; call_io f\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport System.Random\n\n--------------------------------------------------------------------------------\n\ntype FunType5I = Int -> Int -> Int -> Int -> Int -> Int\n\nforeign import ccall \"dynamic\" callFun5I :: FunPtr FunType5I -> FunType5I\nforeign import ccall \"wrapper\" mkFun5I   :: FunType5I -> IO (FunPtr FunType5I)\n\nmanyArgs5I :: FunType5I\nmanyArgs5I a1 a2 a3 a4 a5 = (((a1 * 31 + a2) * 31 + a3) * 31 + a4) * 31 + a5\n\ntest5I :: IO ()\ntest5I = do\n  a1 <- randomIO\n  a2 <- randomIO\n  a3 <- randomIO\n  a4 <- randomIO\n  a5 <- randomIO\n  funAddr <- mkFun5I manyArgs5I\n  print (callFun5I funAddr a1 a2 a3 a4 a5 ==\n         manyArgs5I        a1 a2 a3 a4 a5)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunType11D = Double -> Double -> Double -> Double -> Double -> Double\n               -> Double -> Double -> Double -> Double -> Double -> Double\n\nforeign import ccall \"dynamic\" callFun11D :: FunPtr FunType11D -> FunType11D\nforeign import ccall \"wrapper\" mkFun11D   :: FunType11D -> IO (FunPtr FunType11D)\n\nmanyArgs11D :: FunType11D\nmanyArgs11D a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 = \n  ((((a1 * 31 + a2) * 31 + a3) * 31 + a4) * 31 + a5) * 31 + a6\n  + a7 + a8 + a9 + a10 + a11\n\ntest11D :: IO ()\ntest11D = do\n  a1 <- randomIO\n  a2 <- randomIO\n  a3 <- randomIO\n  a4 <- randomIO\n  a5 <- randomIO\n  a6 <- randomIO\n  a7 <- randomIO\n  a8 <- randomIO\n  a9 <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  funAddr <- mkFun11D manyArgs11D\n  let x = callFun11D funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11\n      y = manyArgs11D        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 \n  if x /= y then\n        print x >> print y\n     else\n       print True\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunType11M = Int -> Double -> Float -> Char -> Bool -> Int -> Float -> Int\n               -> Char -> Double -> Bool -> Double\n\nforeign import ccall \"dynamic\" callFun11M :: FunPtr FunType11M -> FunType11M\nforeign import ccall \"wrapper\" mkFun11M   :: FunType11M -> IO (FunPtr FunType11M)\n\nmanyArgs11M :: FunType11M\nmanyArgs11M a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 =\n   (((((((((fromIntegral           a1   * 31 +                         a2)  * 31 +\n            realToFrac             a3)  * 31 + fromIntegral (fromEnum  a4)) * 31 +\n            fromIntegral (fromEnum a5)) * 31 + fromIntegral            a6)  * 31 +\n            realToFrac             a7)  * 31 + fromIntegral            a8)  * 31 +\n            fromIntegral (fromEnum a9)) * 31 +                         a10) * 31 +\n            fromIntegral (fromEnum a11)\n\ntest11M :: IO ()\ntest11M = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  funAddr <- mkFun11M manyArgs11M\n  print (callFun11M funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 ==\n         manyArgs11M        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM1 = Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM1 :: FunPtr FunTypeM1 -> FunTypeM1\nforeign import ccall \"wrapper\" mkFunM1   :: FunTypeM1 -> IO (FunPtr FunTypeM1)\n\nmanyArgsM1 :: FunTypeM1\nmanyArgsM1 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((              a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM1 :: IO ()\ntestM1 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM1 manyArgsM1\n  print (callFunM1 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM1        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM2 = Int -> Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM2 :: FunPtr FunTypeM2 -> FunTypeM2\nforeign import ccall \"wrapper\" mkFunM2   :: FunTypeM2 -> IO (FunPtr FunTypeM2)\n\nmanyArgsM2 :: FunTypeM2\nmanyArgsM2 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 +               a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM2 :: IO ()\ntestM2 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM2 manyArgsM2\n  print (callFunM2 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM2        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM3 = Int -> Int -> Double -> Int -> Int -> Int -> Int -> Int -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM3 :: FunPtr FunTypeM3 -> FunTypeM3\nforeign import ccall \"wrapper\" mkFunM3   :: FunTypeM3 -> IO (FunPtr FunTypeM3)\n\nmanyArgsM3 :: FunTypeM3\nmanyArgsM3 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n                           a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM3 :: IO ()\ntestM3 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM3 manyArgsM3\n  print (callFunM3 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM3        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM4 = Int -> Int -> Int -> Double -> Int -> Int -> Int -> Int -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM4 :: FunPtr FunTypeM4 -> FunTypeM4\nforeign import ccall \"wrapper\" mkFunM4   :: FunTypeM4 -> IO (FunPtr FunTypeM4)\n\nmanyArgsM4 :: FunTypeM4\nmanyArgsM4 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 +               a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM4 :: IO ()\ntestM4 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM4 manyArgsM4\n  print (callFunM4 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM4        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM5 = Int -> Int -> Int -> Int -> Double -> Int -> Int -> Int -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM5 :: FunPtr FunTypeM5 -> FunTypeM5\nforeign import ccall \"wrapper\" mkFunM5   :: FunTypeM5 -> IO (FunPtr FunTypeM5)\n\nmanyArgsM5 :: FunTypeM5\nmanyArgsM5 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n                           a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM5 :: IO ()\ntestM5 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM5 manyArgsM5\n  print (callFunM5 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM5        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM6 = Int -> Int -> Int -> Int -> Int -> Double -> Int -> Int -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM6 :: FunPtr FunTypeM6 -> FunTypeM6\nforeign import ccall \"wrapper\" mkFunM6   :: FunTypeM6 -> IO (FunPtr FunTypeM6)\n\nmanyArgsM6 :: FunTypeM6\nmanyArgsM6 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 +               a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM6 :: IO ()\ntestM6 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM6 manyArgsM6\n  print (callFunM6 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM6        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM7 = Int -> Int -> Int -> Int -> Int -> Int -> Double -> Int -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM7 :: FunPtr FunTypeM7 -> FunTypeM7\nforeign import ccall \"wrapper\" mkFunM7   :: FunTypeM7 -> IO (FunPtr FunTypeM7)\n\nmanyArgsM7 :: FunTypeM7\nmanyArgsM7 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n                           a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM7 :: IO ()\ntestM7 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM7 manyArgsM7\n  print (callFunM7 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM7        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM8 = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Double -> Int\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM8 :: FunPtr FunTypeM8 -> FunTypeM8\nforeign import ccall \"wrapper\" mkFunM8   :: FunTypeM8 -> IO (FunPtr FunTypeM8)\n\nmanyArgsM8 :: FunTypeM8\nmanyArgsM8 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 +               a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM8 :: IO ()\ntestM8 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM8 manyArgsM8\n  print (callFunM8 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM8        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM9 = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Double\n              -> Int -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM9 :: FunPtr FunTypeM9 -> FunTypeM9\nforeign import ccall \"wrapper\" mkFunM9   :: FunTypeM9 -> IO (FunPtr FunTypeM9)\n\nmanyArgsM9 :: FunTypeM9\nmanyArgsM9 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n                           a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM9 :: IO ()\ntestM9 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM9 manyArgsM9\n  print (callFunM9 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM9        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM10 = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n               -> Double -> Int -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM10 :: FunPtr FunTypeM10 -> FunTypeM10\nforeign import ccall \"wrapper\" mkFunM10   :: FunTypeM10 -> IO (FunPtr FunTypeM10)\n\nmanyArgsM10 :: FunTypeM10\nmanyArgsM10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 +              a10) * 31 +\n             fromIntegral a11) * 31 + fromIntegral a12\n\ntestM10 :: IO ()\ntestM10 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM10 manyArgsM10\n  print (callFunM10 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM10        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM11 = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n               -> Int -> Double -> Int -> Double\n\nforeign import ccall \"dynamic\" callFunM11 :: FunPtr FunTypeM11 -> FunTypeM11\nforeign import ccall \"wrapper\" mkFunM11   :: FunTypeM11 -> IO (FunPtr FunTypeM11)\n\nmanyArgsM11 :: FunTypeM11\nmanyArgsM11 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n                          a11) * 31 + fromIntegral a12\n\ntestM11 :: IO ()\ntestM11 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM11 manyArgsM11\n  print (callFunM11 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM11        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\ntype FunTypeM12 = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int\n               -> Int -> Int -> Double -> Double\n\nforeign import ccall \"dynamic\" callFunM12 :: FunPtr FunTypeM12 -> FunTypeM12\nforeign import ccall \"wrapper\" mkFunM12   :: FunTypeM12 -> IO (FunPtr FunTypeM12)\n\nmanyArgsM12 :: FunTypeM12\nmanyArgsM12 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =\n   ((((((((((fromIntegral  a1  * 31 + fromIntegral  a2) * 31 +\n             fromIntegral  a3) * 31 + fromIntegral  a4) * 31 +\n             fromIntegral  a5) * 31 + fromIntegral  a6) * 31 +\n             fromIntegral  a7) * 31 + fromIntegral  a8) * 31 +\n             fromIntegral  a9) * 31 + fromIntegral a10) * 31 +\n             fromIntegral a11) * 31 +              a12\n\ntestM12 :: IO ()\ntestM12 = do\n  a1  <- randomIO\n  a2  <- randomIO\n  a3  <- randomIO\n  a4  <- randomIO\n  a5  <- randomIO\n  a6  <- randomIO\n  a7  <- randomIO\n  a8  <- randomIO\n  a9  <- randomIO\n  a10 <- randomIO\n  a11 <- randomIO\n  a12 <- randomIO\n  funAddr <- mkFunM12 manyArgsM12\n  print (callFunM12 funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 ==\n         manyArgsM12        a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12)\n  freeHaskellFunPtr funAddr\n\n--------------------------------------------------------------------------------\n\nrep :: String -> IO () -> IO ()\nrep msg tst = do\n   putStrLn (\"Testing \" ++ msg ++ \"...\")\n   sequence_ (replicate 10 tst)\n\nmain :: IO ()\nmain = do\n  setStdGen (mkStdGen 4711)\n  rep \"5 Int arguments\" test5I\n  rep \"11 Double arguments\" test11D\n  rep \"11 mixed arguments\" test11M\n  rep \"Double as 1st argument, rest Int\" testM1\n  rep \"Double as 2nd argument, rest Int\" testM2\n  rep \"Double as 3rd argument, rest Int\" testM3\n  rep \"Double as 4th argument, rest Int\" testM4\n  rep \"Double as 5th argument, rest Int\" testM5\n  rep \"Double as 6th argument, rest Int\" testM6\n  rep \"Double as 7th argument, rest Int\" testM7\n  rep \"Double as 8th argument, rest Int\" testM8\n  rep \"Double as 9th argument, rest Int\" testM9\n  rep \"Double as 10th argument, rest Int\" testM10\n  rep \"Double as 11th argument, rest Int\" testM11\n  rep \"Double as 12th argument, rest Int\" testM12\n", "num_lines": 553}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\n\n-- !!! GHC 5.04.2 was missing rts_mkFunPtr, which meant that this example\n-- !!! didn't link.\n\nforeign import ccall \"wrapper\" \n  makeHaskellFun :: (FunPtr a -> IO ()) -> IO (FunPtr (FunPtr a -> IO ()))\n\nmain = makeHaskellFun (const (return ()))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\n-- !!! returning a Bool from a foreign export confused GHCi 6.0.1.\n\nimport Foreign\n\nforeign import ccall \"wrapper\" \n  mkFoo :: (Int -> IO Bool) -> IO (FunPtr (Int -> IO Bool))\n\nfoo :: Int -> IO Bool\nfoo x = return (x == 42)\n\nforeign import ccall \"dynamic\"\n  call_foo :: FunPtr (Int -> IO Bool) -> Int -> IO Bool\n\nmain = do\n   foo_fun <- mkFoo foo\n   call_foo foo_fun 3 >>= print\n   call_foo foo_fun 42 >>= print\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Same as ffi006, but using the stdcall calling convention.\n\nimport Foreign\nimport Foreign.C\n\n-- With Ints: ---------------------------------\n\ntype IOF = Int -> IO Int\ntype F   = Int ->    Int\n\nforeign import stdcall \"wrapper\" wrap_f    :: F -> IO (FunPtr F)\nforeign import stdcall \"wrapper\" wrap_f_io :: IOF -> IO (FunPtr IOF)\n\nforeign import stdcall \"dynamic\" f    :: FunPtr F   -> F\nforeign import stdcall \"dynamic\" f_io :: FunPtr IOF -> IOF\n\nfn_int :: Int -> Int\nfn_int x = x * 2\n\nfn_int_io :: Int -> IO Int\nfn_int_io x = return (x * 2)\n\n-- With Doubles: ---------------------------------\n\ntype IOD = Double -> IO Double\ntype D   = Double ->    Double\n\nforeign import stdcall \"wrapper\" wrap_d    :: D -> IO (FunPtr D)\nforeign import stdcall \"wrapper\" wrap_d_io :: IOD -> IO (FunPtr IOD)\n\nforeign import stdcall \"dynamic\" d    :: FunPtr D   -> D\nforeign import stdcall \"dynamic\" d_io :: FunPtr IOD -> IOD\n\nfn_double :: Double -> Double\nfn_double x = x * 2\n\nfn_double_io :: Double -> IO Double\nfn_double_io x = return (x * 2)\n\n--------------------------------------------------\n\nmain = do\n  wrapped_fn_int <- wrap_f fn_int\n  print (f wrapped_fn_int 42)\n  wrapped_fn_int_io <- wrap_f_io fn_int_io\n  x <- f_io wrapped_fn_int_io 42\n  print x\n\n  wrapped_fn_double <- wrap_d fn_double\n  print (d wrapped_fn_double 42)\n  wrapped_fn_double_io <- wrap_d_io fn_double_io\n  x <- d_io wrapped_fn_double_io 42\n  print x\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Foreign.C.Types\n\nforeign import ccall \"wrapper\"\n   mkComparator :: (Ptr Int -> Ptr Int -> IO CInt)\n                -> IO (FunPtr (Ptr Int -> Ptr Int -> IO CInt))\n\nforeign import ccall\n   qsort :: Ptr Int -> CSize -> CSize -> FunPtr (Ptr Int -> Ptr Int -> IO CInt)\n         -> IO ()\n\ncompareInts :: Ptr Int -> Ptr Int -> IO CInt\ncompareInts a1 a2 = do\n   i1 <- peek a1\n   i2 <- peek a2\n   return (fromIntegral (i1 - i2 :: Int))\n\nmain :: IO ()\nmain = do\n   c <- mkComparator compareInts\n   let values = [ 12, 56, 90, 34, 78 ] :: [Int]\n       n      = length values\n   withArray values $ \\ buf -> do\n      qsort buf (fromIntegral n) (fromIntegral (sizeOf (head values))) c\n      values' <- peekArray n buf\n      print values'\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- exposed a bug in GHC 6.4 threaded RTS, fixed in Schedule.c rev. 1.232\n\nmodule Main where\n\nimport Control.Concurrent\nimport Control.Monad\nimport Foreign.Ptr\nimport Data.IORef\n\nmain = do\n  ms <- replicateM 100 $ do putStrLn \".\"\n                            m <- newEmptyMVar\n                            forkOS (thread >> putMVar m ())\n                            thread\n                            return m\n  mapM takeMVar ms\n\nthread = do var <- newIORef 0\n            let f = modifyIORef var (1+)\n            callC =<< mkFunc f\n\ntype FUNC  =  IO ()\n\nforeign import ccall unsafe \"wrapper\"\n   mkFunc :: FUNC -> IO (FunPtr FUNC)\n\nforeign import ccall safe \"ffi014_cbits.h callC\"\n   callC:: FunPtr FUNC -> IO ()\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -#include \"ffi015_cbits.h\" #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\n\nimport Foreign\nimport Foreign.C\n\nforeign import ccall \"&var\" var :: Ptr CInt\n\nmain = do\n  x <- peek var\n  print x\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests Foreign.Concurrent finalizers\n\nimport Text.Printf\nimport Foreign.Concurrent as Conc\nimport Foreign\nimport GHC.TopHandler\nimport Control.Concurrent\nimport Data.List\nimport System.Mem\n\n-- This finalizer calls back into Haskell, so we can't use\n-- the ordinary newForeignPtr.\nforeign export ccall fin :: Ptr Int -> Ptr Int -> IO ()\nforeign import ccall \"fin\" finptr :: Ptr Int -> Ptr Int -> IO ()\n\nfin :: Ptr Int -> Ptr Int -> IO ()\nfin envp ap = runIO $ do\n  env <- peek envp\n  a <- peek ap\n  printf \"%d %d\\n\" env a\n  return ()\n\nmain = do\n  a   <- new (55 :: Int)\n  env <- new (66 :: Int)\n  fp  <- Conc.newForeignPtr a (finptr env a)\n  performGC\n  threadDelay 100000\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test for trac #953\n\nmodule Main where\n\nimport System.Posix.Types\nimport Foreign.C\n\nforeign import ccall safe \"unistd.h lseek\" foo :: CInt -> COff -> CInt -> IO COff\n\nmain :: IO ()\nmain = return ()\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Data.Int\n\nmain :: IO ()\nmain = do x <- f\n          print (x == 0x123456789ABCDEF0)\n\nforeign import ccall \"ffi018.h f\"\n    f :: IO Int64\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Data.Int\n\nmain :: IO ()\nmain = do x <- f\n          print (x == 0x123456789ABCDEF0)\n\nforeign import ccall \"ffi018.h f\"\n    f :: IO Int64\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\n-- Test for #1648\n\nimport Foreign\nimport Data.Int\nimport Data.Word\n\nf :: Int64 -> IO Int64\nf x = return $ x + 1\n\ng :: Word64 -> IO Word64\ng x = return $ x + 2\n\ntype WCall = Word64 -> IO Word64\nforeign import ccall \"wrapper\" mkWCall :: WCall -> IO (FunPtr WCall)\nforeign import ccall \"dynamic\" call_w :: FunPtr WCall -> WCall\n\ntype ICall = Int64 -> IO Int64\nforeign import ccall \"wrapper\" mkICall :: ICall -> IO (FunPtr ICall)\nforeign import ccall \"dynamic\" call_i :: FunPtr ICall -> ICall\n\nmain = do\n  fp <- mkICall f\n  call_i fp 3 >>= print\n  fp <- mkWCall g\n  call_w fp 4 >>= print\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Data.Word\nimport Control.Monad\nimport System.Mem\n\nmain = do\n  let finalize p = do\n        putStrLn (\"finalize: \" ++ show p)\n        free p\n  allocToForeignPtr finalize (mallocBytes 4096)\n  forever performGC\n\nallocToForeignPtr :: (Ptr a -> IO ())    -- finalizer\n                  -> IO (Ptr a)          -- allocate\n                  -> IO (ForeignPtr a)\nallocToForeignPtr fin alloc = do\n  done <- asFinalizer fin\n  newForeignPtr done =<< alloc\n\nasFinalizer :: (Ptr a -> IO ()) -> IO (FinalizerPtr a)\nasFinalizer = mkFinalizer\nforeign import ccall \"wrapper\"\n  mkFinalizer :: (Ptr a -> IO ())\n              -> IO (FinalizerPtr a)\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nimport Foreign\nimport Foreign.C\n\n-- test for calling functions by importing them by address and then\n-- using dynamic calls.  In 6.10 and earlier, GHCi rejected the\n-- foreign import '&foo' declarations, for no apparently good reason.\n\ntype Malloc = CSize -> IO (Ptr ())\ntype Write = CInt -> Ptr CChar -> CSize -> IO CSize\n\nforeign import ccall unsafe \"&malloc\" pmalloc:: FunPtr Malloc\nforeign import ccall unsafe \"dynamic\" callMalloc :: FunPtr Malloc -> Malloc\n\nforeign import ccall unsafe \"&write\" pwrite:: FunPtr Write\nforeign import ccall unsafe \"dynamic\" callWrite :: FunPtr Write -> Write\n\nmain = do\n  p <- callMalloc pmalloc 32\n  free p\n  withCStringLen \"hello\\n\" $ \\(p,len) -> callWrite pwrite 1 p (fromIntegral len)\n  return ()\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nimport Foreign.C\nimport Foreign\n\ngetProgName :: IO String\ngetProgName =\n  alloca $ \\ p_argc ->\n  alloca $ \\ p_argv -> do\n     getProgArgv p_argc p_argv\n     argv <- peek p_argv\n     unpackProgName argv\n\nunpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]\nunpackProgName argv = do\n  s <- peekElemOff argv 0 >>= peekCString\n  return (basename s)\n  where\n   basename :: String -> String\n   basename f = go f f\n    where\n      go acc [] = acc\n      go acc (x:xs)\n        | isPathSeparator x = go xs xs\n        | otherwise         = go acc xs\n\n   isPathSeparator :: Char -> Bool\n   isPathSeparator '/'  = True\n   isPathSeparator '\\\\' = True\n   isPathSeparator _    = False\n\nforeign import ccall unsafe \"getProgArgv\"\n  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()\n\nmain :: IO ()\nmain = print =<< getProgName\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests for a bug fixed in\n\nmodule Main where\n\nimport System.Environment\nimport Control.Concurrent\nimport Control.Monad\n\nforeign import ccall safe \"out\"\n  out :: Int -> IO Int\n\nforeign export ccall \"incall\"  incall :: Int -> IO Int\n\nincall :: Int -> IO Int\nincall x = return $ x + 1\n\nmain = do\n  [n, m] <- fmap (fmap read) getArgs\n  ms <- replicateM m $ do\n    v <- newEmptyMVar\n    forkIO $ do mapM out [0..n]; putMVar v ()\n    return v\n  mapM_ takeMVar ms\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Foreign.C\n\n-- This should not be parsed as \"static foo\", importing \"foo\"\nforeign import ccall \"staticfoo\" x :: CInt\n\nmain :: IO ()\nmain = print x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Main where\n\nimport Foreign\n\n{-# INCLUDE \"fptr01.h\" #-}\n\nforeign import ccall \"&f\" fptr :: FunPtr (Ptr Int -> IO ())\nforeign import ccall \"&g\" gptr :: FunPtr (Ptr Int -> IO ())\nforeign import ccall \"&h\" hptr :: FunPtr (Ptr Int -> IO ())\n\nforeign import ccall \"&f_env\" fenvptr :: FunPtr (Ptr Int -> Ptr Int -> IO ())\n\nmain :: IO ()\nmain = do\n    with (33 :: Int) ((>>= finalizeForeignPtr) . test)\n    with (34 :: Int) ((>>  return ())          . test)\n    with (35 :: Int) ((>>= finalizeForeignPtr) . test_env)\n    with (36 :: Int) ((>>  return ())          . test_env)\n    -- finalizers must all be run at program exit.\n    where\n        -- the finalizers must be run in the correct order, starting with\n        -- the most recently-added.\n        test p = do\n            f <- newForeignPtr_ p\n            addForeignPtrFinalizer fptr f\n            addForeignPtrFinalizer gptr f\n            addForeignPtrFinalizer hptr f\n            return f\n\n        test_env p = do\n            f <- newForeignPtr_ p\n            envp1 <- new 1\n            envp2 <- new 2\n            envp3 <- new 3\n            addForeignPtrFinalizerEnv fenvptr envp1 f\n            addForeignPtrFinalizerEnv fenvptr envp2 f\n            addForeignPtrFinalizerEnv fenvptr envp3 f\n            return f\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Main where\n\nimport Foreign\nimport Control.Monad\n\nforeign import ccall \"&free\" pfree :: FunPtr (Ptr a -> IO ())\n\nmain = replicateM_ 1000000 $ newForeignPtr pfree nullPtr\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Main where\n\nimport Foreign\nimport GHC.ForeignPtr\n\n{-# INCLUDE \"fptrfail01.h\" #-}\n\nforeign import ccall \"&f\" fptr :: FunPtr (Ptr Int -> IO ())\n\nmain :: IO ()\nmain = do\n    with (33 :: Int) test\n    where\n        test p = do\n            f <- newForeignPtr_ p\n            addForeignPtrFinalizer fptr f\n            addForeignPtrConcFinalizer f (putStrLn \"Haskell finalizer\")\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n\nmodule Main where\n\nimport GHC.Exts\n\nforeign import ccall \"add_all_int16\"\n    add_all_int16\n        :: Int16# -> Int16# -> Int16# -> Int16# -> Int16#\n        -> Int16# -> Int16# -> Int16# -> Int16# -> Int16#\n        -> Int16#\n\nmain :: IO ()\nmain = do\n    let a = narrowInt16# 0#\n        b = narrowInt16# 1#\n        c = narrowInt16# 2#\n        d = narrowInt16# 3#\n        e = narrowInt16# 4#\n        f = narrowInt16# 5#\n        g = narrowInt16# 6#\n        h = narrowInt16# 7#\n        i = narrowInt16# 8#\n        j = narrowInt16# 9#\n        x = I# (extendInt16# (add_all_int16 a b c d e f g h i j))\n    print x\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n\nmodule Main where\n\nimport GHC.Exts\n\nforeign import ccall \"add_all_int8\"\n    add_all_int8\n        :: Int8# -> Int8# -> Int8# -> Int8# -> Int8#\n        -> Int8# -> Int8# -> Int8# -> Int8# -> Int8#\n        -> Int8#\n\nmain :: IO ()\nmain = do\n    let a = narrowInt8# 0#\n        b = narrowInt8# 1#\n        c = narrowInt8# 2#\n        d = narrowInt8# 3#\n        e = narrowInt8# 4#\n        f = narrowInt8# 5#\n        g = narrowInt8# 6#\n        h = narrowInt8# 7#\n        i = narrowInt8# 8#\n        j = narrowInt8# 9#\n        x = I# (extendInt8# (add_all_int8 a b c d e f g h i j))\n    print x\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n\nmodule Main where\n\nimport GHC.Exts\n\nforeign import ccall \"add_all_word16\"\n    add_all_word16\n        :: Word16# -> Word16# -> Word16# -> Word16# -> Word16#\n        -> Word16# -> Word16# -> Word16# -> Word16# -> Word16#\n        -> Word16#\n\nmain :: IO ()\nmain = do\n    let a = narrowWord16# 0##\n        b = narrowWord16# 1##\n        c = narrowWord16# 2##\n        d = narrowWord16# 3##\n        e = narrowWord16# 4##\n        f = narrowWord16# 5##\n        g = narrowWord16# 6##\n        h = narrowWord16# 7##\n        i = narrowWord16# 8##\n        j = narrowWord16# 9##\n        x = W# (extendWord16# (add_all_word16 a b c d e f g h i j))\n    print x\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnliftedFFITypes #-}\n\nmodule Main where\n\nimport GHC.Exts\n\nforeign import ccall \"add_all_word8\"\n    add_all_word8\n        :: Word8# -> Word8# -> Word8# -> Word8# -> Word8#\n        -> Word8# -> Word8# -> Word8# -> Word8# -> Word8#\n        -> Word8#\n\nmain :: IO ()\nmain = do\n    let a = narrowWord8# 0##\n        b = narrowWord8# 1##\n        c = narrowWord8# 2##\n        d = narrowWord8# 3##\n        e = narrowWord8# 4##\n        f = narrowWord8# 5##\n        g = narrowWord8# 6##\n        h = narrowWord8# 7##\n        i = narrowWord8# 8##\n        j = narrowWord8# 9##\n        x = W# (extendWord8# (add_all_word8 a b c d e f g h i j))\n    print x\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign.C.Types\n\nforeign import ccall \"many_floats\" many :: CFloat -> CFloat ->\n     CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat ->\n     CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat ->\n     CDouble -> IO ()\n\nmain = many 1.5 2.5 3.5 4.5 5.5 6.5 7.5 8.5 9.5 10.5 11.5 12.5 13.5 14.5 15.5\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\n{-# NOINLINE test_reg #-}\ntest_reg :: Int -> IO ()\ntest_reg x = c_foo 0 0 x (x + x `quot` 10) 0 0 0 0\n\n{-# NOINLINE test_stack #-}\ntest_stack :: Int -> IO ()\ntest_stack x = c_foo 0 0 x 0 0 0 (x + x `quot` 10) 0\n\nforeign import ccall unsafe \"foo\"\n   c_foo :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> IO ()\n\nmain :: IO ()\nmain = do\n    test_reg 202\n    test_reg 203\n    test_reg 204\n    test_stack 202\n    test_stack 203\n    test_stack 204\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Foreign.C\n\nforeign import stdcall \"test\" ctest :: CInt -> IO ()\n\nmain = ctest 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Foreign.C\n\nforeign import stdcall \"test\" ctest :: CInt -> IO ()\n\nmain = ctest 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nimport System.Mem\nimport Foreign\nimport Control.Exception\n\n-- Test for #1679.  If there's a GC during a foreign call, the\n-- interpreter could sometimes crash, because it was using the old\n-- pointer to the byte code instructions, which has now moved.  The\n-- tricky bit is allocating enough so that the old instructions are\n-- overwritten, hence performGC followed by sum [1..100000].\n\nforeign import ccall \"wrapper\" mkF :: IO () -> IO (FunPtr (IO ()))\nforeign import ccall \"dynamic\" call_F :: FunPtr (IO ()) -> IO ()\n\nmain = do\n  fun <- mkF (do performGC\n                 print (sum [1..100000]))\n  call_F fun\n  putStrLn \"ok\"\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Foreign.C\n\nforeign import stdcall \"&test\" ptest :: FunPtr (CInt -> IO ())\nforeign import stdcall \"dynamic\" ctest :: FunPtr (CInt -> IO ()) -> CInt -> IO ()\n\nmain = ctest ptest 3\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Foreign.C\n\nforeign import stdcall \"&test\" ptest :: FunPtr (CInt -> IO ())\nforeign import stdcall \"dynamic\" ctest :: FunPtr (CInt -> IO ()) -> CInt -> IO ()\n\nmain = ctest ptest 3\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Foreign.C\n\ntype IOF = Int -> IO Int\n\nforeign import ccall \"wrapper\" wrap_f_io :: IOF -> IO (FunPtr IOF)\nforeign import ccall \"dynamic\" f_io :: FunPtr IOF -> IOF\n\ndouble_io :: Int -> IO Int\ndouble_io x = return (x * 2)\n\nmain = do\n  double2 <- wrap_f_io double_io\n  x <- f_io double2 42\n  return ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# options -fffi #-}\n\nimport Foreign\nimport Foreign.C.Types\n\nmain = do\n    wprint <- wrap8 print\n    call8 wprint\n    wprint <- wrap16 print\n    call16 wprint\n    wprint <- wrap32 print\n    call32 wprint\n    wprint <- wrap64 print\n    call64 wprint\n\nforeign import ccall \"wrapper\"\n    wrap8 :: (Int8 -> IO ()) -> IO (FunPtr (Int8 -> IO ()))\n\nforeign import ccall \"FunPtrBug.h call8\"\n    call8 :: FunPtr (Int8 -> IO ()) -> IO ()\n\nforeign import ccall \"wrapper\"\n    wrap16 :: (Int16 -> IO ()) -> IO (FunPtr (Int16 -> IO ()))\n\nforeign import ccall \"FunPtrBug.h call16\"\n    call16 :: FunPtr (Int16 -> IO ()) -> IO ()\n\nforeign import ccall \"wrapper\"\n    wrap32 :: (Int32 -> IO ()) -> IO (FunPtr (Int32 -> IO ()))\n\nforeign import ccall \"FunPtrBug.h call32\"\n    call32 :: FunPtr (Int32 -> IO ()) -> IO ()\n\nforeign import ccall \"wrapper\"\n    wrap64 :: (Int64 -> IO ()) -> IO (FunPtr (Int64 -> IO ()))\n\nforeign import ccall \"FunPtrBug.h call64\"\n    call64 :: FunPtr (Int64 -> IO ()) -> IO ()\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign\nimport Control.Monad\n\n-- check that all pointers returned by allocaBytes and mallocBytes are\n-- 16-byte aligned\nmain = do\n    sequence [ allocaBytes x $ return | x <- [1..500] ] >>= check 16\n    (replicateM 500 (alloca $ return) :: IO [Ptr Align32])  >>= check 32\n    (replicateM 500 (alloca $ return) :: IO [Ptr Align64])  >>= check 64\n    (replicateM 500 (alloca $ return) :: IO [Ptr Align128]) >>= check 128\n    (replicateM 500 (alloca $ return) :: IO [Ptr Align256]) >>= check 256\n    -- mapM mallocBytes [1..500] >>= check 16\n\ncheck :: Int -> [Ptr a] -> IO ()\ncheck align xs = do\n    let bad = [ p | p <- xs,  (p `minusPtr` nullPtr) .&. (align-1) /= 0 ]\n    when (not $ null bad) $\n      putStrLn (\"FAIL: \" ++ show align ++ \" \" ++ show bad)\n\ndata Align32 = Align32\n\ninstance Storable Align32 where\n  sizeOf    _ = 32\n  alignment _ = 32\n\ndata Align64 = Align64\n\ninstance Storable Align64 where\n  sizeOf    _ = 64\n  alignment _ = 64\n\ndata Align128 = Align128\n\ninstance Storable Align128 where\n  sizeOf    _ = 128\n  alignment _ = 128\n\ndata Align256 = Align256\n\ninstance Storable Align256 where\n  sizeOf    _ = 256\n  alignment _ = 256\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport T4012_A\nimport T4012_B\n\nmain :: IO ()\nmain = do a\n          b\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CApiFFI #-}\n\nmodule T4012_A where\n\nimport Foreign.C\n\na :: IO ()\na = do withCString \"Double: %f\\n\" $ \\fstr -> printfa1 fstr 1.5\n       withCString \"Int: %d\\n\"    $ \\fstr -> printfa2 fstr 4\n\nforeign import capi \"stdio.h printf\" printfa1 :: CString -> CDouble -> IO ()\nforeign import capi \"stdio.h printf\" printfa2 :: CString -> CInt -> IO ()\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE CApiFFI #-}\n\nmodule T4012_B where\n\nimport Foreign.C\n\nb :: IO ()\nb = withCString \"Int: %d\\n\" $ \\fstr -> printfb fstr 9\n\nforeign import capi \"stdio.h printf\" printfb :: CString -> CInt -> IO ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, CPP #-}\nimport Foreign\nimport Foreign.C\n\ntype IOF = Int -> IO Int\n\nforeign import ccall \"wrapper\" wrap_f_io :: IOF -> IO (FunPtr IOF)\nforeign import ccall \"dynamic\" f_io :: FunPtr IOF -> IOF\n\n-- The value of n needs to be adjusted to avoid overflowing the\n-- C stack.  n is the number of times the f calls itself, and each\n-- C call allocates a bit over 16 kB on a 64 bit processor.\n-- (Remember that there is no tail call optimization of foreign functions.)\n-- A typical C stack is 8 MB, so n = 400 will allocate about 4.8 MB\n-- on a 64 bit system.  If you have a 128 bit processor you'll have to\n-- reduce it.\n--\n-- Under ghci this test segfaults for smaller n, probably\n-- because more of the C stack is allocated for other use than\n-- when compiled.\n--\n-- On *nix systems, the C stack size can be examined and changed by\n-- the \"ulimit -s\" command.\n\nn = 300\n\nf :: Int -> IO Int\nf 0 = return 42\nf n = do \n  f' <- wrap_f_io f\n  f_io f' (n-1)\n\nmain = f n >>= print\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}\nmodule Main(main) where\n\nimport Foreign.Ptr\nimport Foreign.ForeignPtr\nimport Foreign.C\n\ndata FnBlob\n\nforeign import ccall \"&free_fn_blob\" free_fn_blob :: FunPtr (Ptr FnBlob -> IO ())\n\nforeign import ccall safe \"call_fn_blob\" call_fn_blob :: Ptr FnBlob -> CDouble -> CDouble\n\ntype DoubleFn = CDouble -> CDouble\n\nforeign import ccall unsafe \"create_fn_blob\" create_fn_blob :: FunPtr DoubleFn -> FunPtr (FunPtr DoubleFn -> IO ()) -> IO (Ptr FnBlob)\n\nforeign import ccall unsafe \"&freeHaskellFunctionPtr\" free_fun_ptr :: FunPtr (FunPtr DoubleFn -> IO())\n\nforeign import ccall \"wrapper\" wrapDoubleFn :: DoubleFn -> IO (FunPtr DoubleFn)\n\ncreateFnBlob :: DoubleFn -> IO (ForeignPtr FnBlob)\ncreateFnBlob dfn = do\n  dfn_ptr <- wrapDoubleFn dfn\n  ptr_fnblob <- create_fn_blob dfn_ptr free_fun_ptr\n  newForeignPtr free_fn_blob ptr_fnblob\n\ncallFnBlob :: ForeignPtr FnBlob -> CDouble -> IO (CDouble)\ncallFnBlob fnblob d = withForeignPtr fnblob $ \n                        \\ptrblob -> return $! call_fn_blob ptrblob d\n\nmain = do\n  putStrLn \"start\"\n  step 0\n  putStrLn \"done\"\n\nstep n | n > 1000 = return ()\nstep n = do\n  fnBlob <- createFnBlob (+ n)\n  result <- callFnBlob fnBlob 0\n  putStrLn $ \"step \" ++ show n ++ \": \" ++ show result\n  step (n + 1)\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\nimport System.Exit\nforeign export ccall hsmain :: IO ()\nhsmain = exitWith (ExitFailure 42)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Lib (hello) where\n\nforeign export ccall \"hello\" hello :: IO ()\n\nhello :: IO ()\nhello = putStrLn \"Hello!\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nimport Control.Concurrent\nimport Control.Exception    (bracket)\nimport Foreign.Ptr          (Ptr, intPtrToPtr, ptrToIntPtr)\nimport Foreign.ForeignPtr   (ForeignPtr)\nimport qualified Foreign.Concurrent as FC\nimport qualified Foreign.ForeignPtr as FP\n\ntestForeignPtr_Concurrent :: Ptr a -> IO (ForeignPtr a)\ntestForeignPtr_Concurrent ptr = FC.newForeignPtr ptr (fin ptr)\n\nfin :: Ptr a -> IO ()\nfin ptr = putStrLn $ \"finalizing \" ++ show (fromIntegral (ptrToIntPtr ptr) :: Int)\n\nmain :: IO ()\nmain = do\n    mv <- newEmptyMVar\n    bracket (testForeignPtr_Concurrent $ intPtrToPtr 1)\n            FP.finalizeForeignPtr $ \\_ ->\n        -- hang, so the thread and foreign pointer get GCed\n        takeMVar mv\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Foreign\nimport Foreign.C\n-- import System.IO\n\nmain :: IO ()\nmain = do\n    -- hSetBuffering stdout NoBuffering\n    n <- peek pn\n    -- print n\n    case n of\n        1 -> do -- putStrLn \"Calling blah\"\n                blah\n        _ -> return ()\n\nforeign import ccall \"&n\" pn :: Ptr CInt\nforeign import ccall safe blah :: IO ()\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns      #-}\n{-# LANGUAGE CApiFFI           #-}\n{-# LANGUAGE MagicHash         #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE UnliftedFFITypes  #-}\n\nmodule Main where\n\nimport qualified Data.ByteString.Short.Internal as SBS\nimport           Foreign.C.Types\nimport           GHC.Exts\n\nforeign import capi  unsafe \"string.h strlen\"\n    c_strlen_capi :: ByteArray# -> IO CSize\n\nforeign import capi  unsafe \"string.h memset\"\n    c_memset_capi :: MutableByteArray# s -> CInt -> CSize -> IO ()\n\nmain :: IO ()\nmain = do\n    n <- c_strlen_capi ba#\n    print (n == 13)\n  where\n    !(SBS.SBS ba#) = \"Hello FFI!!!!\\NUL\"\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Arith where\n\ndata E a b = E (a -> b) (b -> a)\n\neqRefl :: E a a\neqRefl = E id id\n\n-- just to construct unique strings\ndata W\ndata M a\n\n-- terms\ndata Var a where\n  VarW :: Var W\n  VarM :: Var (M a)\n\n-- expose s in the type level making sure it is a string\ndata Abs s e1  where\n  Abs :: (Var s) -> e1 -> Abs (Var s) e1\n\ndata App e1 e2 = App e1 e2\ndata Lit       = Lit\n\ndata TyBase      = TyBase\ndata TyArr t1 t2 = TyArr t1 t2\n\n-- (x:ty) in G\ndata IN g p where\n  INOne :: IN (g,(x,ty)) (x,ty)\n  INShift :: IN g0 (x,ty) -> IN (g0,a) (x,ty)\n\ndata INEX g x where\n  INEX :: IN g (x,v) -> INEX g x\n\n\n-- G1 subseteq G2\ntype SUP g1 g2 = forall a. IN g1 a -> IN g2 a\n\n-- typing derivations\ndata DER g a ty where\n  DVar :: IN (g,g0) ((Var a),ty) -> DER (g,g0) (Var a) ty -- the g,g0 makes sure that env is non-empty\n  DApp :: DER g a1 (TyArr ty1 ty2) ->\n            DER g a2 ty1 -> DER g (App a1 a2) ty2\n  DAbs :: DER (g,(Var a,ty1)) e ty2 ->\n            DER g (Abs (Var a) e) (TyArr ty1 ty2)\n  DLit :: DER g Lit TyBase\n\n-- G |- \\x.x : a -> a\ntest1 :: DER g (Abs (Var W) (Var W)) (TyArr ty ty)\ntest1 = DAbs (DVar INOne)\n\n-- G |- (\\x.x) Lit : Lit\ntest2 :: DER g (App (Abs (Var W) (Var W)) Lit) TyBase\ntest2 = DApp (DAbs (DVar INOne)) DLit\n\n-- G |- \\x.\\y. x y : (C -> C) -> C -> C\ntest3 :: DER g (Abs (Var W) (Abs (Var (M W)) (App (Var W) (Var (M W))))) (TyArr (TyArr ty ty) (TyArr ty ty))\ntest3 = DAbs (DAbs (DApp (DVar (INShift INOne)) (DVar INOne)))\n\ndata ISVAL e where\n ISVALAbs :: ISVAL (Abs (Var v) e)\n ISVALLit :: ISVAL Lit\n\ndata React e1 e2 where\n  SUBSTReact :: React (Abs (Var y) e) v\n\n-- evaluation\ndata EDER e1 e2 where\n -- EVar    :: IN (a,val) -> ISVAL val -> EDER c a val\n EApp1   :: EDER e1 e1' -> EDER (App e1 e2) (App e1' e2)\n EApp2   :: ISVAL v1 -> EDER e2 e2' -> EDER (App v1 e2) (App v1 e2')\n EAppAbs :: ISVAL v2 -> React (Abs (Var v) e) v2 -> EDER (App (Abs (Var v) e) v2) e1\n\n-- (\\x.x) 3 -> 3\n-- test4 :: EDER (App (Abs (Var W) (Var W)) Lit) Lit\n-- test4 = EAppAbs ISVALLit SUBSTEqVar\n\n\n-- existential\ndata REDUCES e1 where\n   REDUCES :: EDER e1 e2 -> REDUCES e1\n\n-- data WFEnv x c g  where\n--  WFOne ::  ISVAL v -> DER g v ty -> WFEnv (Var x) (c,(Var x,v)) (g,(Var x,ty))\n--  WFShift :: WFEnv v c0 g0 -> WFEnv v (c0,(y,y1)) (g0,(z,z1))\n\n-- data WFENVWRAP c g where\n--    WFENVWRAP :: (forall v ty . IN g (v,ty) -> WFEnv v c g) -> WFENVWRAP c g\n\n\n-- data INEXVAL c x where\n--   INEXVAL :: IN c (x,v) -> ISVAL v -> INEXVAL c x\n\n-- -- the first cool theorem!\n-- fromTEnvToEnv :: IN g (x,ty) -> WFEnv x c g ->  INEXVAL c x\n-- fromTEnvToEnv INOne (WFOne isv _)  = INEXVAL INOne isv\n-- fromTEnvToEnv (INShift ind1) (WFShift ind2) =\n--           case (fromTEnvToEnv ind1 ind2) of\n--              INEXVAL i isv -> INEXVAL (INShift i) isv\n\n\ndata ISLAMBDA v where ISLAMBDA :: ISLAMBDA (Abs (Var x) e)\ndata ISLIT v where ISLIT :: ISLIT Lit\n\ndata EXISTAbs where\n  EXISTSAbs :: (Abs (Var x) e) -> EXISTAbs\n\nbot = bot\n\ncanFormsLam :: ISVAL v -> DER g v (TyArr ty1 ty2) -> ISLAMBDA v\ncanFormsLam ISVALAbs _ = ISLAMBDA\n-- canFormsLam ISVALLit _ = bot         <== unfortunately I cannot catch this ... requires some exhaustiveness check :-(\n\ncanFormsLit :: ISVAL v -> DER g v TyBase -> ISLIT v\ncanFormsLit ISVALLit _ = ISLIT\n\ndata NULL\n\nprogress :: DER NULL e ty -> Either (ISVAL e) (REDUCES e)\n\nprogress (DAbs prem)  = Left ISVALAbs\nprogress (DLit)       = Left ISVALLit\n-- progress (DVar iw)    = bot             <== here is the cool trick! I cannot even wite this down!\nprogress (DApp e1 e2)  =\n     case (progress e1) of\n         Right (REDUCES r1) -> Right (REDUCES (EApp1 r1))\n         Left  isv1         -> case (progress e2) of\n                                    Right (REDUCES r2) -> Right (REDUCES (EApp2 isv1 r2))\n                                    Left isv2 -> case (canFormsLam isv1 e1) of\n                                                    ISLAMBDA -> Right (REDUCES (EAppAbs isv2 SUBSTReact))\n\n\n--    case fromTEnvToEnv iw (f iw) of\n--      INEXVAL i isv -> Right (REDUCES (EVar i isv))\n-- progress (WFENVWRAP f) (DApp e1 e2) =\n--       case (progress (WFENVWRAP f) e1) of\n--          Right (REDUCES r1) -> Right (REDUCES (EApp1 r1))\n--          Left  isv1         -> case (progress (WFENVWRAP f) e2) of\n--                                  Right (REDUCES r2) -> Right (REDUCES (EApp2 isv1 r2))\n--                                  Left isv2 -> case (canFormsLam isv1 e1) of\n--                                                ISLAMBDA -> EAppAbs isv2 e1\n\n\n\n", "num_lines": 147}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Opt where\nimport Control.Arrow\nimport Control.Category\nimport Prelude hiding (id, (.))\n\ndata Opt arr a b where\n  Lift  :: arr a b -> Opt arr a b\n  First :: Opt arr a b -> Opt arr (a,c) (b,c)\n\nrunOpt :: Arrow arr => Opt arr a b -> arr a b\nrunOpt (Lift f) = f\nrunOpt (First f) = first (runOpt f)\n\ninstance Arrow arr => Category (Opt arr) where\n  id = Lift id\n  First f . First g = First (f . g)\n  f . g = Lift (runOpt f . runOpt g)\n\ninstance Arrow arr => Arrow (Opt arr) where\n  arr = Lift . arr\n\n  first = First\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}\n\n-- See Trac #1251 and the comments\n-- Note [Pruning dead case alternatives] in types/Unify.lhs\n\nmodule Main( main ) where\n\ndata T a where MkT :: T Int\n\nclass C a where ic :: T a\n\ninstance C Int where ic = MkT\n\nnewtype A = MkA Int deriving( C )\n\n-- axiom CoA : A ~ Int\n-- Hence C Int ~ C A\n\n-- instance C A where\n--    ic :: T A\n--    ic = MkT\n\nicA = ic :: T A  -- There are no (non-bot) values of this type\n\nmain = print (icA `seq` \"ok\")\n\n\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Trac #289\n\nmodule ShouldCompile where\n\nclass C a where\n  f :: a -> Bool\n\ndata T a where\n  MkT :: (C a) => a -> T a\n\ntf1 :: T Int -> Bool\ntf1 (MkT aa) = f aa\n\ntf2 :: T a -> Bool\ntf2 (MkT aa) = f aa\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification #-}\n\n-- Trac #289\n\nmodule ShouldCompile where\n\nclass Foo a where\n  foo :: a -> Int\n\ndata T = forall a. T (G a)\ndata G a where\n  A :: G a\n  B :: Foo a => a -> G a\n\ndoFoo :: T -> Int\ndoFoo (T A) = 2\ndoFoo (T (B x)) = foo x\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification, ScopedTypeVariables,\n             RankNTypes #-}\n\n-- Here's an example from Doaitse Swiestra (Sept 06)\n-- which requires use of scoped type variables\n-- \n-- It's a cut-down version of a larger program\n--\n-- It's also one which was sensitive to syntactic order\n-- in GHC 6.4; but not in 6.6\n\nmodule ShouldCompile where\n\ndata Exists f = forall a . Exists (f a)\n\ndata Ref env a where\n  Zero :: Ref (a,env') a\n  Suc  :: Ref env' a -> Ref (x,env') a\n\ndata Find env final = Find (forall a . Ref env a -> Maybe (Ref final a))\n\ndata Equal a b where\n  Eq :: Equal a a\n\nsym :: Equal a b -> Equal b a\nsym Eq = Eq\n\nmatch' :: Ref env' a -> Ref env'' a -> Bool\nmatch' _ _ = True\n\nmatch :: Ref env a -> Ref env b -> Maybe (Equal a b)\nmatch Zero Zero      = Just Eq\nmatch (Suc x)(Suc y) = match x y\nmatch _ _            = Nothing\n\n-- Notice the essential type sig for the argument to Exists\nf1 :: forall env.  (Exists (Ref env)) -> Exists (Find  env)\nf1 (Exists (ref1 :: Ref env b))\n  = Exists ( Find (\\ ref2 -> case match ref2 ref1 of\n                                Just Eq -> Just Zero\n                                _       -> Nothing\n                  ):: Find env (b,())\n   )\n\n\n-- same as 'f1' except that 'ref1' and 'ref2' are swapped in the  \n-- application of 'match'\nf2 :: forall env.  (Exists (Ref env)) -> Exists (Find  env)\nf2 (Exists (ref1 :: Ref env b))\n   = Exists (Find (\\ ref2 -> case match ref1 ref2 of\n                                    Just Eq -> Just Zero\n                                    _       -> Nothing\n                    ) :: Find env (b,())\n     )\n\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldCompile where\n\ndata Rep t where\n  Rint :: Rep Int\n  Rchar :: Rep Char\n  Runit :: Rep ()\n  Rpair :: Rep a -> Rep b -> Rep (a,b)\n  Rsum  :: Rep a -> Rep b -> Rep (Either a b)\n  Rcon  :: String -> Rep t -> Rep t\n\ndata Equal a b where\n   Eq :: Equal c c \n\ntest :: Rep a -> Rep b -> Maybe (Equal a b)\ntest Rint  Rint  = return Eq\ntest Rchar Rchar = return Eq\ntest Runit Runit = return Eq\ntest (Rpair x y) (Rpair a b)\n  = do { Eq <- test x a; Eq <- test y b; return Eq }\ntest (Rsum x y) (Rsum a b)\n  = do { Eq <- test x a; Eq <- test y b; return Eq }\ntest (Rcon s1 x) (Rcon s2 y)\n  = if s1==s2 then test x y else Nothing\ntest _ _ = Nothing\n\nf :: Equal a b -> a -> b -> b\nf Eq x y = x\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule FloatEq where \n\n\ndata T a where \n  T1 :: T Int\n  T2 :: T a\n  \n  \nh :: T a -> a -> Int\nh = undefined\n\n\nf x y = case x of \n          T1 -> y::Int\n          T2 -> h x y\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldCompile where\n\ndata T a where \n  C :: Int -> T Int \n  D :: Bool -> T Bool \n\nfoo :: T a -> a \nfoo (C x) = x \nfoo (D x) = x \n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldFail2 where \n\ndata T a where \n  C :: Int -> T Int \n  D :: Bool -> T Bool \n\n-- should fail because variable is wobbly \nfoo (C x) = x \nfoo (D b) = b \n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldSucceed5 where \n\n\ndata T a where \n  C :: T Bool \n  D :: T Int \n\n\ndata Y a where \n  E :: Y Bool \n\n\n-- should succeed, the first branch is simply inaccessible \nfoo :: T Bool -> Bool \nfoo (D) = True \nfoo (C) = False \n\n-- should succeed, the branch is inaccessible and not even type checked\nbaz :: Y Int -> Int \nbaz (E) = \"dimitris!\"   \n\n-- should fail => it is an attempt to call an inaccessible branch\ntest = baz (E) \n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldSucceed1 where \n\ndata T1 a where \n  C :: (T2 b) -> b -> T1 Int \n  D :: Bool -> T1 Bool \n\n -- should this work? \ndata T2 a where \n   F :: Int -> T2 Int\n\n\n-- Should work, even though we start as wobbly \n-- the existential makes us rigid again \nfoo x = case x of \n          C (F _) z -> (z + 1) \n\n\n\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldSucceed2 where \n\ndata T a where \n  C :: Int -> T Int \n  D :: Bool -> T Bool \n\n\nfoo :: T a -> a \nfoo (C x) = x + 1 \nfoo (D x) = True \n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldSucceed3 where \n\n\ndata T a where \n  C :: T b -> b -> T Int \n  D :: T Bool \n\n-- Tests scoped annotations \nfoo :: T a -> a -> a \nfoo (C y (x::b)) (z::a) = z + 1 \n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldSucceed4 where \n\ndata Z \ndata S a \n\n\ndata Add n m r where \n  PZero :: Add Z m m \n  PSucc :: Add n m p -> Add (S n) m (S p) \n\n\ndata XList n a where \n  XNil :: XList Z a  \n  XCons :: a -> XList n a -> XList (S n) a \n\n\n-- simple safe append function \nappend :: (Add n m r) -> XList n a -> XList m a -> XList r a \nappend PZero XNil l = l \nappend (PSucc prf) (XCons x xs) l = XCons x (append prf xs l)\n\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldSucceed5 where \n\n\ndata T a where \n  C :: T Bool \n  D :: T Int \n\n\ndata Y a where \n  E :: T Bool \n\n\n-- should succeed, the first branch is simply inaccessible \nfoo :: T Bool -> Bool \nfoo (D) = True \nfoo (C) = False \n\n-- should succeed, the branch is inaccessible and not een type checked\nbaz :: Y Int -> Int \nbaz (E) = \"dimitris!\"   \n\n\n\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification #-}\n\nmodule Escape where\n\ndata ExpGADT t where\n  ExpInt :: Int -> ExpGADT Int\n\ndata Hidden = forall t . Hidden (ExpGADT t) (ExpGADT t)\n\nhval = Hidden (ExpInt 0) (ExpInt 1)\n\n-- With the type sig this is ok, but without it maybe\n-- should be rejected because the result type is wobbly\n--    weird1 :: ExpGADT Int\n--\n-- And indeed it is rejected by GHC 7.8 because OutsideIn\n-- doesn't unify under an equality constraint.\n\nweird1 = case (hval :: Hidden) of Hidden (ExpInt _) a -> a\n  -- Hidden t (ExpInt (co :: t ~ Int) _ :: ExpGADT t) (a :: ExpGADT t)\n\nweird2 :: ExpGADT Int\nweird2 = case (hval :: Hidden) of Hidden (ExpInt _) a -> a\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\n-- Trac #345\n\nmodule ShouldCompile where\n\ndata Succ n\ndata Zero\n\nclass Plus x y z | x y -> z\ninstance Plus Zero x x\ninstance Plus x y z => Plus (Succ x) y (Succ z)\n\ninfixr 5 :::\n\ndata List :: * -> * -> * where\n              Nil :: List a Zero\n              (:::) :: a -> List a n -> List a (Succ n)\n\nappend :: Plus x y z => List a x -> List a y -> List a z\nappend Nil ys = ys\nappend (x ::: xs) ys = x ::: append xs ys\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes #-}\n\nmodule ShouldCompile where\n\n-- Checks for bindInstsOfPatId\nf :: (forall a. Eq a => a -> a) -> Bool\nf g = g True", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldFail where\n\n-- Kind error\ndata RInt a where R :: RInt\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldFail where\n\n-- Wrong return type\ndata T1 a where\n  K1 :: T1 Int\n  K2 :: T2 Int -> T1 Bool\n\ndata T2 a where\n  L1 :: T2 Int\n  L2 :: T1 Bool\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- This should fail, because there is no annotation on shw,\n-- but it succeeds in 6.4.1\n--\n-- It fails again with 7.8 because Outside in doesn't\n-- unify under an equality constraint\n\nmodule ShouldFail where\n\ndata Term a where\n   B :: Bool -> Term Bool\n   I :: Int  -> Term Int\n\nshw (I t) = (\"I \"++) . shows t\n-- shw (B t) = (\"B \"++) . shows t\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Check that trailing parens are ok in data con signatures\n\nmodule ShouldCompile where\n\ndata T where\n   MkT :: Int -> (Int -> T)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Triggered a desugaring bug in earlier version\n\nmodule Shouldcompile where\n\ndata T a where\n  T1 :: Int -> T Int\n\nf :: (T a, a) -> Int\nf (T1 x, z) = z\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n{- This code, courtesy of Markus Lauer (markus.lauer-2006@lauerit.de)\n   was rejected by the sophisticated wobbly-type impl in 6.4.1, and\n   with a terrible error message:\n     Sample.hs:22:40:\n       Couldn't match `MayFail' against `MayFail'\n         Expected type: Result s b\n         Inferred type: Result MayFail a\n       In the first argument of `Return', namely `Fail'\n       In a case alternative: Fail -> return Fail\n\n   Strangely it is accepted by the simplified impl in GHC 6.5. -}\n\nmodule Sample where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\ndata Safe\ndata MayFail\n\ndata Result s a where\n   Ok   :: a   -> Result s       a\n   Fail ::        Result MayFail a\n\nnewtype M s a = M { unM :: IO (Result s a) }\n\ninstance Functor (M s) where\n    fmap = liftM\n\ninstance Applicative (M s) where\n    pure = return\n    (<*>) = ap\n\ninstance Monad (M s) where  \n\n  return x = M (return (Ok x))\n  \n  {- this one gives a type error in 6.4.1 -}\n  M m >>= k = M (do res <- m\n                    case res of \n                         Ok x -> unM (k x)\n                         Fail -> return Fail\n                     )                    \n\n  {- while this one works -}  \n  -- M m >>= k = M (f m (unM . k))\n  --   where \n  --     f :: IO (Result s a) -> (a -> IO (Result s b)) -> IO (Result s b)\n  --     f m k = do res <- m\n  --                case res of\n  --                     Ok x -> k x\n  --                     Fail -> return Fail\n \n  \n\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -O #-}\n\n-- This one showed up a bug that required type refinement in TcIface\n-- See the call to coreRefineTys in TcIface\n--\n-- Tests for bug: http://ghc.haskell.org/trac/ghc/ticket/685\n\nmodule ShouldCompile where\n\nimport Gadt17_help ( TernOp (..), applyTernOp )\n\nliftTernOpObs :: TernOp a b c d -> a -> b -> c ->  d\nliftTernOpObs op x y z = applyTernOp op x y z\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -O -fno-warn-redundant-constraints #-}\n\nmodule Gadt17_help (\n      TernOp (..), applyTernOp\n    ) where\n\ndata TypeWitness a   where\n    TWInt    ::         TypeWitness Int\n    TWBool   ::         TypeWitness Bool\n    TWFloat  ::         TypeWitness Float\n    TWDouble ::         TypeWitness Double\n\ninstance (Eq a) => Eq (TypeWitness a) where\n  (==) TWInt     TWInt     = True\n  (==) TWBool    TWBool    = True\n  (==) TWFloat   TWFloat   = True\n  (==) TWDouble  TWDouble  = True\n\ndata TernOp a b c d where\n  OpIf       ::                   TypeWitness a                    ->    TernOp Bool   a      a      a\n  OpTernFunc ::  TypeWitness a -> TypeWitness b -> TypeWitness c\n                            -> TypeWitness d -> (a -> b -> c -> d) ->    TernOp a      b      c      d\n\ninstance Show (TernOp a b c d) where\n  show (OpIf       {})  = \"OpIf\"\n  show (OpTernFunc {})  = \"OpTernFunc <function>\"\n\n\napplyTernOp :: TernOp a b c d -> a -> b -> c -> d\napplyTernOp (OpIf       {})         cond x y = if (cond) then x else y\napplyTernOp (OpTernFunc _ _ _ _ f)  x    y z = f x y z\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n-- A simple GADT test from Roman\n-- which nevertheless showed up a bug at one stage\n\nmodule ShouldCompile where\n\ndata T a where\n  T1 :: () -> T ()\n  T2 :: T a -> T b -> T (a,b)\n\nclass C a where\n  f :: T a -> a\n\ninstance C () where\n  f (T1 x) = x\n\ninstance (C a, C b) => C (a,b) where\n  f (T2 x y) = (f x, f y)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Involves an equality that is not an existential\n\nmodule Foo2 where\n\ndata T t a where\n  T :: a -> T () a\n\nfoo :: (a -> a) -> T t a -> T t a\nfoo f (T x) = T (f x)\n\nbar :: T t Int -> T t Int\nbar t@(T _) = foo (+1) t\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll,GADTs #-}\n\n-- Pattern match uses dictionaries bound higher up in the pattern\n\nmodule Main where\n\ndata T = forall a. Integral a => T a\n\nf :: T -> Bool\nf (T 0) = True\nf (T n) = False\n\ng :: T -> Ordering\ng (T n) | n >= 3 = if n>3 then GT else EQ\ng (T n)     = LT\n\nmain = do   print [f (T 0), f (T 1)]\n            print [g (T 2), g (T 3), g (T 4)]\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures #-}\n\n-- Test for trac #810\n-- Should be able to infer bool :: Bool and integer :: Integer, so\n-- we should know that they both have Show instances.\n\nmodule Foo where\n\nimport Data.Kind (Type)\n\ndata Pair :: (Type -> Type) -> Type where\n    Pair :: a b -> b -> Pair a\n\ndata Sel :: Type -> Type where\n    A :: Sel Bool\n    B :: Sel Integer\n\nshowSnd :: Pair Sel -> String\nshowSnd (Pair A bool)    = show bool\nshowSnd (Pair B integer) = show integer\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification, KindSignatures, RankNTypes #-}\n\n-- Fails (needs the (Ord a) in TypeSet \n-- c.f. gadt22.hs\n\nmodule Expr where\n\nimport Data.Set (Set)\n\ndata Type a where\n    TypeInt     :: Type Int\n    TypeSet     :: {- Ord a => -} Type a -> Type (Set a)\n    TypeFun     :: Type a -> Type b -> Type (a -> b)\n\ndata Expr :: * -> * where\n    Const :: Type a -> a -> Expr a\n\ndata DynExpr = forall a. DynExpr (Expr a)\n\nwithOrdDynExpr :: DynExpr -> (forall a. Ord a => Expr a -> b) -> Maybe b\nwithOrdDynExpr (DynExpr e@(Const (TypeSet _) _)) f = Just (f e)\nwithOrdDynExpr (DynExpr e@(Const TypeInt _)) f = Just (f e)\nwithOrdDynExpr _ _ = Nothing\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification, KindSignatures, RankNTypes #-}\n\n-- Succeeds (needs the (Ord a) in TypeSet \n-- c.f. gadt21.hs\n\n-- However, it's a useful test because it unearthed a bug\n-- in free-variable-finding\n\nmodule Expr where\n\nimport qualified Data.Kind as K (Type)\nimport Data.Set (Set)\n\ndata Type a where\n    TypeInt     :: Type Int\n    TypeSet     :: Ord a => Type a -> Type (Set a)\n    TypeFun     :: Type a -> Type b -> Type (a -> b)\n\ndata Expr :: K.Type -> K.Type where\n    Const :: Type a -> a -> Expr a\n\ndata DynExpr = forall a. DynExpr (Expr a)\n\nwithOrdDynExpr :: DynExpr -> (forall a. Ord a => Expr a -> b) -> Maybe b\nwithOrdDynExpr (DynExpr e@(Const (TypeSet _) _)) f = Just (f e)\nwithOrdDynExpr (DynExpr e@(Const TypeInt _)) f = Just (f e)\nwithOrdDynExpr _ _ = Nothing\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Main where\n\nimport Gadt23_AST\n\ndata Foo = Foo { bar :: Int }\n\nconvert :: AST a tag -> AST a Foo\nconvert t = case t of\n  Var v     -> Tag (Foo 42) $ Var v\n  Tag t e   -> Tag (Foo 42) $ convert e\n\nmain = return ()\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures #-}\n\nmodule Gadt23_AST where\n\nimport Data.Kind (Type)\n\ndata Exp_;\n\ndata AST :: Type -> Type -> Type where\n  Var   :: String -> AST Exp_ tag\n  Tag   :: tag    -> AST a tag -> AST a tag\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Test for Trac #1396\n-- Panics in GHC 6.6.1\n\nmodule ShouldCompile where\n\ndata Right provides final where\n  RightNull :: Right final final\n  RightCons :: b -> Right a final -> Right (b -> a) final\n\ncollapse_right :: right -> Right right final -> final\n--collapse_right f (RightNull)     = f\ncollapse_right f (RightCons b r) = collapse_right (f b) r\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- From the ghc-users mailing list\n\nmodule Foo where\n\ndata TValue t where\n  TList :: [a] -> TValue [a]\n\ninstance (Eq b) => Eq (TValue b) where\n    (==) (TList p) (TList q) = (==) p q\n\n{- My reply to the list\n\nHere's the reasoning (I have done a bit of renaming).\n\n* The TList constructor really has type\n        TList :: forall a. forall x. (a~[x]) => [x] -> TValue a\n\n* So in the pattern match we have\n        (Eq b) available from the instance header\n        TList p :: TValue b\n        x is a skolem, existentially bound by the pattern\n        p :: [x]\n        b ~ [x] available from the pattern match\n\n* On the RHS we find we need (Eq [x]).\n\n* So the constraint problem we have is\n        (Eq b, b~[x]) => Eq [x]\n          [\"Given\"  =>  \"Wanted\"]\n  Can we prove this?  From the two given constraints we can see\n  that we also have Eq [x], and that certainly proves Eq [x].\n\n\nNevertheless, it's a bit delicate.  If we didn't notice all the\nconsequences of the \"given\" constraints, we might use the top-level Eq\na => Eq [a] instance to solve the wanted Eq [x].  And now we need Eq\nx, which *isn't* a consequence of (Eq b, b~[x]).\n\n-}\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldCompile where\n\ndata T where\n  T1 :: Int -> T\n  T2 :: Bool -> Bool -> T\n\ndata S a where\n  S1 :: a -> S a\n  S2 :: Int -> S Int\n\nf (T1 i) = i>0\nf (T2 a b) = a && b\n\ng :: S a -> a\ng (S1 x) = x\ng (S2 i) = i\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Main where\n\ndata Term a where\n   Lit    :: Int -> Term Int  \n   IsZero :: Term Int -> Term Bool\n   If     :: Term Bool -> Term a -> Term a -> Term a\n\n\neval :: Term a -> a\neval (Lit n)       = n  \neval (IsZero t)    = eval t == 0\neval (If t1 t2 t3) = if eval t1 then eval t2 else eval t3\n\nterm = If (IsZero (Lit 1)) (Lit 2) (Lit 3)\n\nmain = print (eval term)", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Main where\n\ndata Term a where\n   Lit    :: Int -> Term Int\n   IsZero :: Term Int -> Term Bool\n   If     :: Term Bool -> Term a -> Term a -> Term a\n   Pr     :: Term a -> Term b -> Term (a, b)\n   Fst    :: Term (a, b) -> Term a\n   Snd    :: Term (a, b) -> Term b\n\neval :: Term v -> v\neval (Lit n)       = n\neval (IsZero t)    = eval t == 0\neval (If t1 t2 t3) = if eval t1 then eval t2 else eval t3\neval (Pr t1 t2)    = (eval t1, eval t2)\neval (Fst t)       = case (eval t) of { (a,b) -> a }\neval (Snd t)       = case (eval t) of { (a,b) -> b }\n\nterm = If (IsZero (Lit 1)) (Pr (Lit 2) (Lit 3)) (Pr (Lit 3) (Lit 4))\n\nmain = print (eval term)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldCompile where\n\ndata T a where\n  T :: b -> (b->Int) -> a -> T a\n\nf (T b f a) = a\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables #-}\n\n-- From Yann Regis-Gianas at INRIA\n\nmodule ShouldCompile where\n\ndata T a where\n  K :: T Int\n\n-- Should fail\ni1 :: T a -> a -> Int\ni1 t y = (\\t1 y1 -> case t1 of K -> y1) t y\n\n-- No type signature; should not type-check,\n-- because we can't unify under the equalty constraint for K\ni1b t y = (\\t1 y1 -> case t1 of K -> y1) t y\n\ni2 :: T a -> a -> Int\ni2 t (y::b)  = case t of { K -> y+(1::Int) }\n\ni3 :: forall a. T a -> a -> Int\ni3 t y \n  = let t1 = t in\n    let y1 = y in\n    case t1 of K -> y1\n\ni4 :: forall a. T a -> a -> Int\ni4 (t :: T a) (y :: a)\n  = let t1 = t in\n    let y1 = y in\n    case t1 of K -> y1\n\n\n\n\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures #-}\n\n-- Test a couple of trivial things:\n--      explicit layout\n--      trailing semicolons\n--      kind signatures\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\ndata Expr :: Type -> Type where {\n   EInt    :: Int                                 -> Expr Int  ;\n   EBool   :: Bool                                -> Expr Bool ;\n   EIf     :: (Expr Bool) -> (Expr a) -> (Expr a) -> Expr a    ;\n                -- Note trailing semicolon, should be ok\n  }\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- This one requires careful handling in\n-- TcUnify.unifyTyConApp, to preserve rigidity.\n\nmodule ShouldCompile where\n\ndata X a b where\n    X :: X a a\n\ndata Y x a b where\n    Y :: x a b -> x b c -> Y x a c\n\ndoy :: Y X a b -> Y X a b\ndoy (Y X X) = Y X X\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE GADTSyntax #-}\n\nmodule GadtSyntax001 where\n\ndata Foo a b where\n    C1 :: a -> Int -> b -> Foo b a\n    C2 :: a -> Char -> Foo a b\n    Cs :: Foo a b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE GADTSyntax #-}\n\nmodule GadtSyntaxFail001 where\n\ndata Foo a b where\n    C1 :: a -> Int -> b -> Foo b a\n    C2 :: a -> Char -> Foo a Int\n    Cs :: Foo a b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE GADTSyntax #-}\n\nmodule GadtSyntaxFail002 where\n\ndata Foo a b where\n    C1 :: a -> Int -> b -> Foo b a\n    C2 :: a -> Char -> Foo a a\n    Cs :: Foo a b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE GADTSyntax #-}\n\nmodule GadtSyntaxFail003 where\n\ndata Foo a b where\n    C1 :: a -> Int -> c -> Foo b a\n    C2 :: a -> Char -> Foo a b\n    Cs :: Foo a b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- Program from Josef Svenningsson\n\n-- Just a short explanation of the program. It contains\n-- some class declarations capturing some definitions from\n-- category theory. Further down he have a data type for well typed\n-- lambda expressions using GADTs. Finally we have a\n-- function defining the semantics for lambda terms called\n-- 'interp'.\n\n-- Made GHC 6.4 bleat\n--    Quantified type variable `t' is unified with\n--        another quantified type variable `terminal'\n--    When trying to generalise the type inferred for `interp'\n\n\nmodule Bug where\n\nimport Data.Kind (Type)\n\nclass Category arr where\n  idA  :: arr a a\n  comp :: arr a b -> arr b c -> arr a c\n\nclass Category arr =>\n   Terminal terminal arr | arr -> terminal where\n  terminal :: arr a terminal\n\nclass Category arr =>\n      ProductCategory prod arr | arr -> prod  where\n  first  :: arr (prod a b) a\n  second :: arr (prod a b) b\n  pair   :: arr a b -> arr a c -> arr a (prod b c)\n\nclass Category arr =>\n      CoproductCategory coprod arr | arr -> coprod where\n  inLeft  :: arr a (coprod a b)\n  inRight :: arr b (coprod a b)\n  ccase   :: arr a c -> arr b c -> arr (coprod a b) c\n\nclass ProductCategory prod arr =>\n      Exponential exp prod arr | arr -> exp where\n  eval   :: arr (prod (exp a b) a) b\n  curryA :: arr (prod c a) b -> arr c (exp a b)\n\n\nclass (Exponential exp prod arr, Terminal terminal arr) =>\n  CartesianClosed terminal exp prod arr | arr -> terminal exp prod\n\ndata V prod env t where\n  Z :: V prod (prod env t) t\n  S :: V prod env t -> V prod (prod env x) t\n\ndata Lambda terminal (exp :: Type -> Type -> Type) prod env t where\n    Unit :: Lambda foo exp prod env foo\n    Var  :: V prod env t -> Lambda terminal exp prod env t\n{-    Lam  :: Lambda terminal exp prod (prod env a) t\n         -> Lambda terminal exp prod env (exp a t)\n    App  :: Lambda terminal exp prod env (exp t t')\n         -> Lambda terminal exp prod env t -> Lambda terminal exp prod env t'\n-}\n\ninterp :: CartesianClosed terminal exp prod arr =>\n          Lambda terminal exp prod s t -> arr s t\ninterp (Unit)       = terminal -- Terminal terminal arr => arr a terminal\n-- interp (Var Z)      = second\n-- interp (Var (S v))  = first `comp` interp (Var v)\n-- interp (Lam e)      = curryA (interp e)\n-- interp (App e1 e2)  = pair (interp e1) (interp e2) `comp` eval\n", "num_lines": 72}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures #-}\n\n-- See Trac #301\n-- This particular one doesn't use GADTs per se,\n-- but it does use dictionaries in constructors\n\nmodule Expr1 where\n\nimport Data.Kind (Type)\n\ndata Expr :: Type -> Type where       -- Not a GADT at all\n  Const :: Show a => a -> Expr a\n                -- Note the Show constraint here\n  Var   :: Var a -> Expr a\n\nnewtype Var a = V String\n\ninstance Show (Var a) where show (V s) = s\n\n--------------------------\ne1 :: Expr Int\ne1 = Const 42\n\ne2 :: Expr Bool\ne2 = Const True\n\ne3 :: Expr Integer\ne3 = Var (V \"mersenne100\")\n\n--------------------------\neval :: Expr a -> a\neval (Const c) = c\neval (Var v) = error (\"free variable `\" ++ shows v \"'\")\n\n{-\n    Up to here, everything works nicely:\n\n    \\begin{verbatim}\n    *Expr0> eval e1\n    42\n    *Expr0> eval e2\n    True\n    *Expr1> eval e3\n    *** Exception: free variable `mersenne100'\n    \\end{verbatim}\n\n    But let us now try to define a |shows| function.\n\n    In the following, without the type signature we get:\n    \\begin{verbatim}\n    *Expr1> :t showsExpr\n    showsExpr :: forall a. (Show a) => Expr a -> String -> String\n    *Expr1> showsExpr e1 \"\"\n    \"42\"\n    *Expr1> showsExpr e2 \"\"\n    \"True\"\n    *Expr1> showsExpr e3 \"\"\n    \"mersenne100\"\n    \\end{verbatim}\n\n    However, in the last case, the instance |Show Integer| was not used,\n    so should not have been required.\n    Therefore I would expect it to work as it is now, i.e.,\n    with the type signature:\n-}\n\nshowsExpr :: Expr a -> ShowS\nshowsExpr (Const c) = shows c\nshowsExpr (Var v) = shows v\n\n{-\n\nWe used to get a complaint about the |Const| alternative (then line\n63) that documents that the constraint in the type of |Const| must\nhave been ignored:\n\n    No instance for (Show a)\n      arising from use of `shows' at Expr1.lhs:63:22-26\n    Probable fix: add (Show a) to the type signature(s) for `showsExpr'\n    In the definition of `showsExpr': showsExpr (Const c) = shows c\n-}\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures #-}\n\nmodule Expr0 where\n\n-- See Trac #301\n-- This one *does* use GADTs (Fct)\n\nimport Data.Kind (Type)\n\ndata Expr :: Type -> Type where\n  Const :: Show a => a -> Expr a\n  Apply :: Fct a b -> Expr a -> Expr b\n\ndata Fct :: Type -> Type -> Type where\n  Succ :: Fct Int Int\n  EqZero :: Fct Int Bool\n  Add :: Fct Int (Int -> Int)\n\n------------------------------\ne1 :: Expr Int\ne1 = Apply Succ (Const 41)\n\ne2 :: Expr Bool\ne2 = Apply EqZero e1\n\ne3 :: Expr (Int -> Int)\ne3 = Apply Add e1\n\n------------------------------\neval :: Expr a -> a\neval (Const c) = c\neval (Apply f a) = evalFct f $ eval a\n\nevalFct :: Fct a b -> a -> b\nevalFct Succ = succ\nevalFct EqZero = (0 ==)\nevalFct Add = (+)\n\n\n{-  Up to here, everything works nicely:\n\n    \\begin{verbatim}\n    *Expr0> eval e1\n    42\n    *Expr0> eval e2\n    False\n    *Expr0> eval e3 5\n    47\n    \\end{verbatim}\n\n    But let us now try to define a |Show| instance.\n    For |Fct|, this is not a problem:\n-}\n\ninstance Show (Fct a b) where\n  show Succ = \"S\"\n  show EqZero = \"isZero\"\n  show Add = \"add\"\n\nshowsExpr :: Expr a -> ShowS\nshowsExpr (Const c) = shows c\nshowsExpr (Apply f a) =\n    ('(' :) . shows f . (' ' :) . showsExpr a . (')' :)\n\ninstance Show (Expr a) where\n  showsPrec _ (Const c) = shows c\n  showsPrec _ (Apply f a) =\n    ('(' :) . shows f . (' ' :) . shows a . (')' :)\n\n{- But we used to get a complaint about the |Const| alternative (then\n   line 56) that documents that the constraint in the type of |Const|\n   must have been ignored:\n\n   \\begin{verbatim}\n       No instance for (Show a)\n         arising from use of `shows' at Expr0.lhs:56:22-26\n       Probable fix: add (Show a) to the type signature(s) for `showsExpr'\n       In the definition of `showsExpr': showsExpr (Const c) = shows c\n   \\end{verbatim}\n\n   But if we do that, the recursive call is of course still unsatisfied:\n   \\begin{verbatim}\n       No instance for (Show a)\n         arising from use of `showsExpr' at Expr0.lhs:65:34-42\n       Probable fix: add (Show a) to the existential context for `Apply'\n       In the first argument of `(.)', namely `showsExpr a'\n       In the second argument of `(.)', namely `(showsExpr a) . ((')' :))'\n       In the second argument of `(.)', namely\n           `((' ' :)) . ((showsExpr a) . ((')' :)))'\n   \\end{verbatim}\n\n   Following also the advice given in this last error message\n   actually makes GHC accept this, and then we can say:\n\n   \\begin{verbatim}\n   *Expr0> showsExpr e1 \"\"\n   \"(S 41)\"\n   *Expr0> showsExpr e2 \"\"\n   \"(isZero (S 41))\"\n   \\end{verbatim}\n\n   However, following this advice is counterintuitive\n   and should be unnecessary\n   since the |Show| instance for argument types\n   is only ever used in the const case.\n   We get:\n\n   \\begin{verbatim}\n   *Expr0> showsExpr e3 \"\"\n\n   <interactive>:1:0:\n       No instance for (Show (Int -> Int))\n         arising from use of `showsExpr' at <interactive>:1:0-8\n       Probable fix: add an instance declaration for (Show (Int -> Int))\n       In the definition of `it': it = showsExpr e3 \"\"\n   \\end{verbatim}\n\n   But of course we would expect the following:\n\n   \\begin{verbatim}\n   *Expr0> showsExpr e3 \"\"\n   \"(add (S 41))\"\n   \\end{verbatim}\n\n\n   \\bigskip\n   The error messages are almost the same\n   if we define a |Show| instance directly\n   (line 90 was the |Const| alternative):\n\n   \\begin{verbatim}\n       Could not deduce (Show a) from the context (Show (Expr a))\n         arising from use of `shows' at Expr0.lhs:90:26-30\n       Probable fix: add (Show a) to the class or instance method `showsPrec'\n   \\end{verbatim}\n-}\n\n\n", "num_lines": 139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification #-}\n\nmodule ShouldFail where\n\ndata T = forall a. T a (a->Int)\n\nf ~(T x f) = f x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- It's not clear whether this one should succeed or fail,\n-- Arguably it should succeed because the type refinement on\n-- T1 should make (y::Int).  Currently, though, it fails.\n\nmodule ShouldFail where\n\ndata T a where\n  T1 :: Int -> T Int\n\nf :: (T a, a) -> Int\nf ~(T1 x, y) = x+y\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes #-}\n\nmodule Main where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\n-- abstract syntax -------------------------------------------------------------\ndata Ty t where\n  Bool :: Ty Bool\n  Arr  :: Ty a -> Ty b -> Ty (a -> b)\n\ndata Exp g t where\n  Var    :: Var g t -> Exp g t\n  Lam    :: Ty a -> Exp (g,a) b -> Exp g (a->b)\n  App    :: Exp g (s -> t) -> Exp g s -> Exp g t\n  If     :: Exp g Bool -> Exp g t -> Exp g t -> Exp g t\n  ETrue  :: Exp g Bool\n  EFalse :: Exp g Bool\n\ndata Var g t where\n  ZVar :: Var (h,t) t\n  SVar :: Var h t -> Var (h,s) t\n\n-- smart constructors ----------------------------------------------------------\nlamE :: Ty s -> (Exp (g,s) s -> Exp (g,s) t) -> Exp g (s -> t)\nlamE s f = Lam s (f (Var ZVar))\n\nifE :: Exp g Bool -> Exp g t -> Exp g t -> Exp g t\nifE t ETrue EFalse = t\nifE t e e' = if eqE e e' then e else If t e e'\n\n-- boring equality tests -------------------------------------------------------\neqB :: BoxExp t -> BoxExp s -> Bool\neqB (Box e) (Box e_) = eqE e e_\n\neqE :: Exp g t -> Exp h s -> Bool\neqE (Var x) (Var y) = eqV x y\neqE (Lam s e) (Lam s_ e_) = eqT s s_ && eqE e e_\neqE (App e1 e2) (App e1_ e2_) = eqE e1 e1_ && eqE e2 e2_\neqE (If e1 e2 e3) (If e1_ e2_ e3_) = eqE e1 e1_ && (eqE e2 e2_ && eqE e3 e3_)\neqE (ETrue) (ETrue) = True\neqE (EFalse) (EFalse) = True\neqE _ _ = False\n\neqT :: Ty t -> Ty s -> Bool\neqT (Arr s t) (Arr s_ t_) = eqT s s_ && eqT t t_\neqT Bool Bool = True\neqT _ _ = False\n\neqV :: Var g t -> Var h s -> Bool\neqV (SVar x) (SVar y) = eqV x y\neqV ZVar ZVar = True\neqV _ _ = False\n\n-- evaluation ------------------------------------------------------------------\nvar :: Var g t -> g -> t\nvar ZVar     (_,t) = t\nvar (SVar x) (h,s) = var x h\n\neval :: Exp g t -> g -> t\neval (Var x)    g = var x g\neval (Lam _ e)  g = \\a -> eval e (g,a)\neval (App e e') g = eval e g (eval e' g)\neval (ETrue)    g = True\neval (EFalse)   g = False\neval (If c t e) g = if eval c g then eval t g else eval e g\n\n-- type inference --------------------------------------------------------------\ndata TyEnv g where\n  Nil :: TyEnv g\n  Cons :: Ty t -> TyEnv h -> TyEnv (h,t)\n\ninfer :: TyEnv g -> Exp g t -> Ty t\ninfer g (Var x)         = inferVar g x\ninfer g (Lam t e)       = Arr t (infer (Cons t g) e)\ninfer g (App e e')      = case infer g e of Arr _ t -> t\ninfer g (ETrue)         = Bool\ninfer g (EFalse)        = Bool\ninfer g (If _ e _)      = infer g e\n\ninferVar :: TyEnv g -> Var g t -> Ty t\ninferVar (Cons t h) (SVar x) = inferVar h x\ninferVar (Cons t h) (ZVar)   = t\n\n-- tree monad ------------------------------------------------------------------\n\ndata Tree a = Val a | Choice (Tree a) (Tree a)\n-- doesn't yet force trees to be fully balanced:\n--      Val :: a -> Tree a Z\n--      Choice :: Tree a n -> Tree a n -> Tree a (S n)\n\ninstance Functor Tree where\n    fmap = liftM\n\ninstance Applicative Tree where\n    pure = return\n    (<*>) = ap\n\ninstance Monad Tree where\n  return x = Val x\n  (Val a) >>= f = f a\n  (Choice l r) >>= f = Choice (l >>= f) (r >>= f)\n\ntmap :: Monad m => (a->b) -> m a -> m b\ntmap f x = do { a <- x; return (f a) }\n\nflatten t = flatten_ t []\n where\n   flatten_ (Val a)      k = a:k\n   flatten_ (Choice l r) k = flatten_ l (flatten_ r k)\n\n\n-- quote & friends -------------------------------------------------------------\n\n-- for values --------------------------\nenumV           :: Ty t -> Tree t\nquestionsV      :: Ty t -> [t -> Bool]\n\n\nenumV Bool      = Choice (Val True) (Val False)\nenumV (Arr s t) = mkEnum (questionsV s) (enumV t)\n where\n   mkEnum [] t = tmap const t\n   mkEnum (q:qs) es = do\n                   f1 <- mkEnum qs es\n                   f2 <- mkEnum qs es\n                   return (\\d -> if q d then f1 d else f2 d)\n\nquestionsV Bool         = return (\\x -> x)\nquestionsV (Arr s t)    = do\n                          d <- flatten (enumV s)\n                          q <- questionsV t\n                          return (\\f -> q (f d))\n\n-- for expressions ---------------------\nenumE           :: Ty t -> Tree (Exp g t)\nquestionsE      :: Ty t -> [Exp g t -> Exp g Bool]\n\nenumE Bool      = Choice (Val ETrue) (Val EFalse)\nenumE (Arr s t) = tmap (lamE s) (mkEnumE (questionsE s) (enumE t))\n where\n   mkEnumE [] t = tmap const t\n   mkEnumE (q:qs) es = do\n                        f1 <- mkEnumE qs es\n                        f2 <- mkEnumE qs es\n                        return (\\d -> ifE (q d) (f1 d) (f2 d))\n\nquestionsE Bool         = return (\\x -> x)\nquestionsE (Arr s t)    = do\n                          d <- flatten (enumE s)\n                          q <- questionsE t\n                          return (\\f -> q (App f d))\n\n-- should be\n--      find (List (Exp g Bool) n) -> Tree (Exp g a) n -> Exp g a\nfind :: [Exp g Bool] -> Tree (Exp g a) -> Exp g a\nfind []         (Val a)         = a\nfind (b:bs)     (Choice l r)    = ifE b (find bs l) (find bs r)\nfind _          _               = error \"bad arguments to find\"\n\nquote :: Ty t -> t -> Exp g t\nquote Bool      t = case t of True -> ETrue; False -> EFalse\nquote (Arr s t) f = lamE s (\\e -> find (do q <- questionsE s; return (q e))\n                                        (tmap (quote t . f) (enumV s)))\n\n-- normalization (by evaluation) -----------------------------------------------\ndata BoxExp t = Box (forall g. Exp g t)\n\nnormalize :: Ty t -> BoxExp t -> BoxExp t\nnormalize s (Box e) = Box (quote s (eval e ()))\n\n-- examples --------------------------------------------------------------------\nb2b = Arr Bool Bool\nb22b = Arr b2b b2b\nzero = Var ZVar\none = Var (SVar ZVar)\nonce   = Box (Lam b2b (Lam Bool (App one zero)))\ntwice  = Box (Lam b2b (Lam Bool (App one (App one zero))))\nthrice = Box (Lam b2b (Lam Bool (App one (App one (App one zero)))))\n\ntest = [ eqB (nf b22b thrice) (nf b22b once)\n       , eqB (nf b22b twice)  (nf b22b once)]\n  where nf = normalize\n\nmain = print test\n", "num_lines": 187}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ScopedTypeVariables #-}\n\n-- Supplied by Henrik Nilsson, showed up a bug in GADTs\n\nmodule Nilsson where\n\ndata Event a = NoEvent | Event a\n\nfromEvent :: Event a -> a\nfromEvent = undefined\n\nusrErr :: String -> String -> String -> a\nusrErr = undefined\n\ntype DTime = Double     -- [s]\n\ndata SF a b = SF {sfTF :: a -> Transition a b}\n\ndata SF' a b where\n    SFArr   :: (DTime -> a -> Transition a b) -> FunDesc a b -> SF' a b\n\n    SFAcc   :: (DTime -> Event a -> Transition (Event a) b)\n               -> (c -> a -> (c, b)) -> c -> b\n               -> SF' (Event a) b\n    SFCpAXA :: (DTime -> a -> Transition a d)\n               -> FunDesc a b -> SF' b c -> FunDesc c d\n               -> SF' a d\n    SF' :: (DTime -> a -> Transition a b) -> SF' a b\n\n-- A transition is a pair of the next state (in the form of a signal\n-- function) and the output at the present time step.\n\ntype Transition a b = (SF' a b, b)\n\n\nsfTF' :: SF' a b -> (DTime -> a -> Transition a b)\nsfTF' (SFArr   tf _)     = tf\nsfTF' (SFAcc   tf _ _ _) = tf\n-- sfTF' (SFSScan ...)\nsfTF' (SFCpAXA tf _ _ _) = tf\nsfTF' (SF' tf)           = tf\n\n-- \"Smart\" constructors. The corresponding \"raw\" constructors should not\n-- be used directly for construction.\n\nsfArr :: FunDesc a b -> SF' a b\nsfArr FDI         = sfId\nsfArr (FDC b)     = sfConst b\nsfArr (FDE f fne) = sfArrE f fne\nsfArr (FDG f)     = sfArrG f\n\n\nsfId :: SF' a a\nsfId = sf\n    where\n        sf = SFArr (\\_ a -> (sf, a)) FDI\n\n\nsfConst :: b -> SF' a b\nsfConst b = sf\n    where\n        sf = SFArr (\\_ _ -> (sf, b)) (FDC b)\n\n\nsfNever :: SF' a (Event b)\nsfNever = sfConst NoEvent\n\n\n-- Assumption: fne = f NoEvent\nsfArrE :: (Event a -> b) -> b -> SF' (Event a) b\nsfArrE f fne = sf\n    where\n        sf  = SFArr (\\_ ea -> (sf, case ea of NoEvent -> fne ; _ -> f ea))\n                    (FDE f fne)\n\nsfArrG :: (a -> b) -> SF' a b\nsfArrG f = sf\n    where\n        sf = SFArr (\\_ a -> (sf, f a)) (FDG f)\n\n\nsfAcc :: (c -> a -> (c, b)) -> c -> b -> SF' (Event a) b\nsfAcc f c bne = sf\n    where\n        sf = SFAcc (\\dt ea -> case ea of\n                                  NoEvent -> (sf, bne)\n                                  Event a -> let\n                                                 (c', b) = f c a\n                                             in\n                                                 (sfAcc f c' bne, b))\n                   f\n                   c\n                   bne\n\n-- sfAccHld would be very similar. The only difference is that\n-- what's now called \"bne\" would be updated at each event.\n--\n-- So maybe one could use the SAME constructor, just different\n-- transition functions? It really depends on what assumptions\n-- one need to make when optimizing.\n\n\n-- Motivation for event-processing function type\n-- (alternative would be function of type a->b plus ensuring that it\n-- only ever gets invoked on events):\n-- * Now we need to be consistent with other kinds of arrows.\n-- * We still want to be able to get hold of the original function.\n\ndata FunDesc a b where\n    FDI :: FunDesc a a                                  -- Identity function\n    FDC :: b -> FunDesc a b                             -- Constant function\n    FDE :: (Event a -> b) -> b -> FunDesc (Event a) b   -- Event-processing fun\n    FDG :: (a -> b) -> FunDesc a b                      -- General function\n\nfdFun :: FunDesc a b -> (a -> b)\nfdFun FDI       = id\nfdFun (FDC b)   = const b\nfdFun (FDE f _) = f\nfdFun (FDG f)   = f\n\nfdComp :: FunDesc a b -> FunDesc b c -> FunDesc a c\nfdComp FDI           fd2     = fd2\nfdComp fd1           FDI     = fd1\nfdComp (FDC b)       fd2     = FDC ((fdFun fd2) b)\nfdComp _             (FDC c) = FDC c\nfdComp (FDE f1 f1ne) fd2 = FDE (f2 . f1) (f2 f1ne)\n    where\n        f2 = fdFun fd2\nfdComp (FDG f1) (FDE f2 f2ne) = FDG f\n    where\n        f a = case f1 a of\n                  NoEvent -> f2ne\n                  f1a     -> f2 f1a\nfdComp (FDG f1) fd2 = FDG (fdFun fd2 . f1)\n\n\n-- Verifies that the first argument is NoEvent. Returns the value of the\n-- second argument that is the case. Raises an error otherwise.\n-- Used to check that functions on events do not map NoEvent to Event\n-- wherever that assumption is exploited.\nvfyNoEv :: Event a -> b -> b\nvfyNoEv NoEvent b = b\nvfyNoEv _       _  = usrErr \"AFRP\" \"vfyNoEv\"\n                            \"Assertion failed: Functions on events must not \\\n                            \\map NoEvent to Event.\"\n\ncompPrim :: SF a b -> SF b c -> SF a c\ncompPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0}\n    where\n        tf0 a0 = (cpXX sf1 sf2, c0)\n            where\n                (sf1, b0) = tf10 a0\n                (sf2, c0) = tf20 b0\n\n        -- Naming convention: cp<X><Y> where  <X> and <Y> is one of:\n        -- X - arbitrary signal function\n        -- A - arbitrary pure arrow\n        -- C - constant arrow\n        -- E - event-processing arrow\n        -- G - arrow known not to be identity, constant (C) or\n        --     event-processing (E).\n\n        cpXX :: SF' a b -> SF' b c -> SF' a c\n        cpXX (SFArr _ fd1)       sf2               = cpAX fd1 sf2\n        cpXX sf1                 (SFArr _ fd2)     = cpXA sf1 fd2\n        cpXX (SFAcc _ f1 s1 bne) (SFAcc _ f2 s2 cne) =\n            sfAcc f (s1, s2) (vfyNoEv bne cne)\n            where\n                f (s1, s2) a =\n                    case f1 s1 a of\n                        (s1', NoEvent) -> ((s1', s2), cne)\n                        (s1', Event b) ->\n                            let (s2', c) = f2 s2 b in ((s1', s2'), c)\n        cpXX (SFCpAXA _ fd11 sf12 fd13) (SFCpAXA _ fd21 sf22 fd23) =\n            cpAXA fd11 (cpXX (cpXA sf12 (fdComp fd13 fd21)) sf22) fd23\n        cpXX sf1 sf2 = SF' tf\n            where\n                tf dt a = (cpXX sf1' sf2', c)\n                    where\n                        (sf1', b) = (sfTF' sf1) dt a\n                        (sf2', c) = (sfTF' sf2) dt b\n\n        cpAXA :: FunDesc a b -> SF' b c -> FunDesc c d -> SF' a d\n        cpAXA FDI     sf2 fd3     = cpXA sf2 fd3\n        cpAXA fd1     sf2 FDI     = cpAX fd1 sf2\n        cpAXA (FDC b) sf2 fd3     = cpCXA b sf2 fd3\n        cpAXA fd1     sf2 (FDC d) = sfConst d\n        cpAXA fd1 (SFArr _ fd2) fd3 = sfArr (fdComp (fdComp fd1 fd2) fd3)\n\n        cpAX :: FunDesc a b -> SF' b c -> SF' a c\n        cpAX FDI           sf2 = sf2\n        cpAX (FDC b)       sf2 = cpCX b sf2\n        cpAX (FDE f1 f1ne) sf2 = cpEX f1 f1ne sf2\n        cpAX (FDG f1)      sf2 = cpGX f1 sf2\n\n        cpXA :: SF' a b -> FunDesc b c -> SF' a c\n        cpXA sf1 FDI           = sf1\n        cpXA sf1 (FDC c)       = sfConst c\n        cpXA sf1 (FDE f2 f2ne) = cpXE sf1 f2 f2ne\n        cpXA sf1 (FDG f2)      = cpXG sf1 f2\n\n        cpCX :: b -> SF' b c -> SF' a c\n        cpCX b (SFArr _ fd2)              = sfConst ((fdFun fd2) b)\n        cpCX b (SFAcc _ _ _ cne)          = sfConst (vfyNoEv b cne)\n        cpCX b (SFCpAXA _ fd21 sf22 fd23) =\n            cpCXA ((fdFun fd21) b) sf22 fd23\n        cpCX b sf2 = SFCpAXA tf (FDC b) sf2 FDI\n            where\n                tf dt _ = (cpCX b sf2', c)\n                    where\n                        (sf2', c) = (sfTF' sf2) dt b\n\n-- For SPJ: The following version did not work.\n-- The commented out one below did work, by lambda-lifting cpCXAux\n        cpCXA :: b -> SF' b c -> FunDesc c d -> SF' a d\n        cpCXA b sf2 FDI     = cpCX b sf2\n        cpCXA _ _   (FDC c) = sfConst c\n        cpCXA b (sf2 :: SF' b c) (fd3 :: FunDesc c d) = cpCXAAux sf2\n            where\n                f3  = fdFun fd3\n\n                cpCXAAux :: SF' b c -> SF' a d\n                cpCXAAux (SFArr _ fd2) = sfConst (f3 ((fdFun fd2) b))\n                cpCXAAux (SFAcc _ _ _ cne) = sfConst (vfyNoEv b (f3 cne))\n                cpCXAAux (SFCpAXA _ fd21 sf22 fd23) = cpCXA ((fdFun fd21) b) sf22 (fdComp fd23 fd3)\n\n{- -- For SPJ: This version works\n        cpCXA :: b -> SF' b c -> FunDesc c d -> SF' a d\n        cpCXA b sf2 FDI     = cpCX b sf2\n        cpCXA _ _   (FDC c) = sfConst c\n        cpCXA b sf2 fd3 = cpCXAAux b fd3 (fdFun fd3) sf2\n            where\n                -- f3  = fdFun fd3\n                -- Really something like: cpCXAAux :: SF' b c -> SF' a d\n                cpCXAAux :: b -> FunDesc c d -> (c -> d) -> SF' b c -> SF' a d\n                cpCXAAux b fd3 f3 (SFArr _ fd2) = sfConst (f3 ((fdFun fd2) b))\n                cpCXAAux b fd3 f3 (SFAcc _ _ _ cne) = sfConst (vfyNoEv b (f3 cne))\n                cpCXAAux b fd3 f3 (SFCpAXA _ fd21 sf22 fd23) = cpCXA ((fdFun fd21) b) sf22 (fdComp fd23 fd3)\n-}\n\n        cpGX :: (a -> b) -> SF' b c -> SF' a c\n        cpGX f1 (SFArr _ fd2) = sfArr (fdComp (FDG f1) fd2)\n        cpGX f1 (SFCpAXA _ fd21 sf22 fd23) =\n            cpAXA (fdComp (FDG f1) fd21) sf22 fd23\n        cpGX f1 sf2 = SFCpAXA tf (FDG f1) sf2 FDI\n            where\n                tf dt a = (cpGX f1 sf2', c)\n                    where\n                        (sf2', c) = (sfTF' sf2) dt (f1 a)\n\n        cpXG :: SF' a b -> (b -> c) -> SF' a c\n        cpXG (SFArr _ fd1) f2 = sfArr (fdComp fd1 (FDG f2))\n        cpXG (SFAcc _ f1 s bne) f2 = sfAcc f s (f2 bne)\n            where\n                f s a = let (s', b) = f1 s a in (s', f2 b)\n        cpXG (SFCpAXA _ fd11 sf12 fd22) f2 =\n            cpAXA fd11 sf12 (fdComp fd22 (FDG f2))\n        cpXG sf1 f2 = SFCpAXA tf FDI sf1 (FDG f2)\n            where\n                tf dt a = (cpXG sf1' f2, f2 b)\n                    where\n                        (sf1', b) = (sfTF' sf1) dt a\n\n        cpEX :: (Event a -> b) -> b -> SF' b c -> SF' (Event a) c\n        cpEX f1 f1ne (SFArr _ fd2) = sfArr (fdComp (FDE f1 f1ne) fd2)\n        cpEX f1 f1ne (SFAcc _ f2 s cne) = sfAcc f s (vfyNoEv f1ne cne)\n            where\n                f s a = f2 s (fromEvent (f1 (Event a)))\n        cpEX f1 f1ne (SFCpAXA _ fd21 sf22 fd23) =\n            cpAXA (fdComp (FDE f1 f1ne) fd21) sf22 fd23\n        cpEX f1 f1ne sf2 = SFCpAXA tf (FDE f1 f1ne) sf2 FDI\n            where\n                tf dt ea = (cpEX f1 f1ne sf2', c)\n                    where\n                        (sf2', c) = case ea of\n                                        NoEvent -> (sfTF' sf2) dt f1ne\n                                        _       -> (sfTF' sf2) dt (f1 ea)\n\n        cpXE :: SF' a (Event b) -> (Event b -> c) -> c -> SF' a c\n        cpXE (SFArr _ fd1)   f2 f2ne = sfArr (fdComp fd1 (FDE f2 f2ne))\n        cpXE (SFAcc _ f1 s bne) f2 f2ne = sfAcc f s (vfyNoEv bne f2ne)\n            where\n                f s a = let (s', eb) = f1 s a\n                        in\n                            case eb of NoEvent -> (s', f2ne); _ -> (s', f2 eb)\n        cpXE (SFCpAXA _ fd11 sf12 fd13) f2 f2ne =\n            cpAXA fd11 sf12 (fdComp fd13 (FDE f2 f2ne))\n        cpXE sf1 f2 f2ne = SFCpAXA tf FDI sf1 (FDE f2 f2ne)\n            where\n                tf dt a = (cpXE sf1' f2 f2ne,\n                           case eb of NoEvent -> f2ne; _ -> f2 eb)\n                    where\n                        (sf1', eb) = (sfTF' sf1) dt a\n", "num_lines": 294}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Tests record syntax for GADTs\n\n-- Record syntax in GADTs has been deprecated since July 2009\n-- see commit 432b9c9322181a3644083e3c19b7e240d90659e7 by simonpj:\n-- \"New syntax for GADT-style record declarations, and associated refactoring\"\n-- and Trac #3306\n\n-- It's been removed in August 2015\n-- see Phab D1118\n\n-- test should result in a parse error\n\nmodule ShouldFail where\n\ndata T a where\n  T1 { x :: a, y :: b } :: T (a,b)\n  T4 { x :: Int } :: T [a]\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Tests record syntax for GADTs\n\nmodule Main where\n\ndata T a where\n  T1 :: { x :: a, y :: b } -> T (a,b)\n  T2 :: { x :: a }   -> T (a,b)\n  T3 :: { z :: Int } -> T Bool\n\nf xv yv = T1 { x = xv, y = yv }\n\ng :: T a -> T a\ng (T1 {x=xv, y=yv}) = T2 { x = xv }\n\n-- h :: Num a => T a any -> a\nh v = x v + 1\n\nmain = do { let t1 = T1 { y = \"foo\", x = 4 }\n                t2 = g t1\n          ; print (h (f 8 undefined))\n          ; print (h t2)\n        }\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ShouldCompile where\n\n-- data RBTree = forall n. Root (SubTree Black n)\n\n-- Kind Colour\ndata Red\ndata Black\n\n-- Kind Nat\ndata Z\ndata S a\n\ndata SubTree c n where\n  Leaf :: SubTree Black Z\n  RNode :: SubTree Black n -> Int -> SubTree Black n -> SubTree Red n\n  BNode :: SubTree cL m   ->  Int -> SubTree cR m    -> SubTree Black (S m)\n  Fix   :: SubTree Red n -> SubTree Black n\n\n\nins :: Int -> SubTree c n -> SubTree c n\nins n Leaf                   = (Fix (RNode Leaf n Leaf))\nins n (BNode x m y) | n <= m = black (ins n x) m y\nins n (BNode x m y) | n > m  = black x m (ins n y)\nins n (RNode x m y) | n <= m = RNode (ins n x) m y\nins n (RNode x m y) | n > m  = RNode x m (ins n y)\n\nblack :: SubTree c n -> Int -> SubTree d n -> SubTree Black (S n)\nblack (RNode (Fix u) v c) w (x@(RNode _ _ _)) = Fix(RNode (blacken u) v (BNode c w x))\n\nblack (RNode (Fix u) v c) w (x@(BNode _ _ _)) = BNode u v (RNode c w x)\nblack (RNode a v (Fix (RNode b u c))) w (x@(BNode _ _ _)) = BNode (RNode a v b) u (RNode c w x)\nblack (Fix x) n (Fix y) = BNode x n y\nblack x       n (Fix y) = BNode x n y\nblack (Fix x) n y       = BNode x n y\nblack x       n y       = BNode x n y\n\nblacken :: SubTree Red n -> SubTree Black (S n)\nblacken (RNode l e r) = (BNode l e r)\n\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Main where\n\nimport Data.IORef\n\ndata T a where\n  Li:: Int -> T Int\n  Lb:: Bool -> T Bool\n  La:: a -> T a\n\nwriteInt:: T a -> IORef a -> IO ()\nwriteInt v ref = case v of\n                   ~(Li x) -> writeIORef ref (1::Int)\n\nreadBool:: T a -> IORef a -> IO ()\nreadBool v ref = case v of\n                   ~(Lb x) ->\n                       readIORef ref >>= (print . not)\n\ntt::T a -> IO ()\ntt v = case v of\n         ~(Li x) ->  print \"OK\"\n\nmain = do\n        tt (La undefined)\n        ref <- newIORef undefined\n        writeInt (La undefined) ref\n        readBool (La undefined) ref\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ScopedTypeVariables #-}\n\n-- Tests for scoped type variables and GADTs\n\nmodule GADT where\n\ndata C x y where\n     C :: a -> C a a\n\ndata D x y where\n     D :: C b c -> D a c\n\n-------  All these should be ok\n\n-- Rejected!\ng1 :: forall x y . C x y -> ()\n-- C (..) :: C x y\n-- Inside match on C, x=y\ng1 (C (p :: y)) = ()\n\n-- OK!\ng2 :: forall x y . C x y -> ()\n-- C (..) :: C x y\n-- Inside match on C, x=y\ng2 (C (p :: x)) = ()\n\n-- Rejected!\ng3 :: forall x y . D x y -> ()\n-- D (..)  :: D x y\n-- C (..)  :: C sk y\n--      sk = y\n-- p :: sk\ng3 (D (C (p :: y))) = ()\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures #-}\n\n-- See Trac #1323; crashed GHC 6.6\n\nmodule Main where\n\nimport Data.Kind (Type)\n\ndata Zero = Zero\n            deriving (Show)\n\n-- Change this newtype to a data and all's well\n-- and it's not like the class restriction actually restricts\n-- the type rather than the constructor\nnewtype Succ p = Succ p deriving (Show)\n\nclass TyNum a where\ninstance TyNum Zero where\ninstance (TyNum p) => TyNum (Succ p) where\n\ndata List :: Type -> Type -> Type where\n             Nil :: List a Zero\n             Cons :: (TyNum p) => a -> List a p -> List a (Succ p)\n\ninstance (Show a) => Show (List a l) where\n    show Nil = \"Nil\"\n    show (Cons a t) = \"Cons \" ++ (show a) ++ \" (\" ++ (show t) ++ \")\"\n\nzipL :: List a l -> List b l -> List (a, b) l\nzipL Nil Nil = Nil -- this line is fine\nzipL (Cons l ls) (Cons r rs) = Cons (l,r) (zipL ls rs) -- this line blows up\n\nl1 = Cons 5 (Cons 3 Nil)\nl2 = Cons True (Cons False Nil)\n\nmain = print $ zipL l1 l2\n\n{-\n$ ghc --make Test.hs\n[1 of 1] Compiling Main             ( Test.hs, Test.o )\nghc-6.6: panic! (the 'impossible' happened)\n  (GHC version 6.6 for x86_64-unknown-linux):\n        Pattern match failure in do expression at simplCore/Simplify.lhs:1540:8-21\n\nPlease report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n-}\n\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Provoked by\n-- http://www.haskell.org/pipermail/haskell-cafe/2007-January/021086.html\n\nmodule ShouldCompile where\n\nimport Data.Set as Set\n\ndata Teq a b where Teq :: Teq a a\n\n---------------------\ndata SetM1 a where\n     SM1 :: Ord w => Teq w a -> Set.Set w -> SetM1 a\n\nunionA1 :: SetM1 a -> SetM1 a -> SetM1 a\nunionA1 (SM1 Teq m1) (SM1 Teq m2)\n  = SM1 Teq (m1 `Set.union` m2)\n\nunionB1 :: SetM1 a -> SetM1 a -> SetM1 a\nunionB1 (SM1 p1 m1) (SM1 p2 m2)\n  = case p1 of Teq -> case p2 of Teq -> SM1 Teq (m1 `Set.union` m2)\n\nunionC1 :: SetM1 a -> SetM1 a -> SetM1 a\nunionC1 (SM1 p1 m1) (SM1 p2 m2)\n  = case (p1,p2) of (Teq,Teq) -> SM1 Teq (m1 `Set.union` m2)\n\n\n---------------------\ndata SetM2 a where\n     SM2 :: Ord w => Teq a w -> Set.Set w -> SetM2 a\n        -- Different order of args in Teq\n\nunionA2 :: SetM2 a -> SetM2 a -> SetM2 a\nunionA2 (SM2 Teq m1) (SM2 Teq m2)\n  = SM2 Teq (m1 `Set.union` m2)\n\nunionB2 :: SetM2 a -> SetM2 a -> SetM2 a\nunionB2 (SM2 p1 m1) (SM2 p2 m2)\n  = case p1 of Teq -> case p2 of Teq -> SM2 Teq (m1 `Set.union` m2)\n\nunionC2 :: SetM2 a -> SetM2 a -> SetM2 a\nunionC2 (SM2 p1 m1) (SM2 p2 m2)\n  = case (p1,p2) of (Teq,Teq) -> SM2 Teq (m1 `Set.union` m2)\n\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T12087 where\n\ndata F1 a where\n  MkF1 :: Ord a => Eq a => a -> F1 a\n\ndata F2 a where\n  MkF2 :: Ord a => a -> Eq a => F2 a\n\ndata F3 a where\n  MkF3 :: forall a. Eq a => a -> forall b. Eq b => b -> F3 a\n\ndata F4 a where\n  MkF4 :: forall a b. Eq a => a -> Eq b => b -> F4 a\n\ndata F5 a where\n  MkF5 :: Int -> Int -> forall a. a -> Int -> Int -> forall b. b -> F5 a\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T12468 where\n\ndata T a where\n    I :: T Int\n\nf :: T a -> a\nf I = _\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, GADTs, KindSignatures #-}\nmodule T14320\nwhere\n\nimport Data.Kind (Type)\n\ndata Exp :: Type where\n  Lit  :: (Int -> Exp)\n\nnewtype TypedExp :: Type -> Type where\n  TEGood ::  forall a . (Exp -> (TypedExp a))\n\n-- The only difference here is that the type is wrapped in parentheses,\n-- but GHC 8.0.1 rejects this program\n--\nnewtype TypedExpToo :: Type -> Type where\n  TEBad  :: (forall a . (Exp -> (TypedExpToo a)))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule T14719 where\n\ndata Foo1 where\n  MkFoo1 :: Bool\n\nnewtype Foo2 where\n  MkFoo2 :: Foo2\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T14808 where\n\nimport Data.Kind\n\ndata ECC ctx f a where\n  ECC :: ctx => f a -> ECC ctx f a\n\nf :: [()] -> ECC () [] ()\nf = ECC @() @[] @()\n\ndata ECC2 f a ctx where\n  ECC2 :: ctx => f a -> ECC2 f a ctx\n\nf2 :: [()] -> ECC2 [] () ()\nf2 = ECC2 @() @[] @()\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T15009 where\n\n-- T2 is an ordinary H98 data type,\n-- and f2 should typecheck with no problem\ndata T2 a where\n  MkT2 :: a -> T2 a\n\nf2 (MkT2 x) = not x\n\n-- T1 is a GADT, but the equality is really just a 'let'\n-- so f1 should also typecheck no problem\ndata T1 a where\n  MkT1 :: b ~ a => b -> T1 a\n\nf1 (MkT1 x) = not x\n\n\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T15558 where\n\ndata T a where\n  MkT :: T Int\n\ndata Foo a = MkFoo ((a ~ Bool) => ())\n\nf :: T a -> Foo a\nf MkT = MkFoo ()\n\n-- g :: Foo Int\n-- g = f MkT\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs #-}\n\nmodule Bug where\n\nclass C a where\n  f :: G a -> ()\n\ninstance (C ()) => C (b c) where\n  f (G x) = f x where\n\ndata G a where\n  G  :: G () -> G (b c)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n-- Trac #1999\n\nmodule ShouldCompile where\n\ndata EqTypes a b where\n  EqConstr :: EqTypes a b -> EqTypes (s a) (s b)\n\neqUnConstr :: EqTypes (s a) (s b) -> EqTypes a b\neqUnConstr (EqConstr eq) = eq", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ScopedTypeVariables, FlexibleContexts,\n             MultiParamTypeClasses #-}\n{-# OPTIONS_GHC -Wall #-}\n\nmodule T2040 where\n\ndata Teq a b where Teq :: Teq a a\n\nclass C a b where proof :: Teq a b\n\ndata S a = S a\n\ndata W b where\n    -- This would make every version of GHC happy\n    -- W :: (C a c , c ~ S b) => W a -> W c\n    W :: C a (S b) => W a -> W (S b)\n\nfoo :: W (S ()) -> W (S ()) -> ()\nfoo (W (_ :: W a1)) (W (_ :: W a2)) =\n  case proof :: Teq a1 (S ()) of\n    Teq -> ()\n\nfoo2 :: W (S ()) -> W (S ()) -> ()\nfoo2 (W (_ :: W a1)) (W (_ :: W a2)) =\n  case proof :: Teq a1 (S ()) of\n    Teq -> case proof :: Teq a2 (S ()) of\n             Teq ->  ()", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T2151 where\n\ndata Type a where\n    Func :: Type a -> Type b -> Type (a -> b)\n    PF :: Type a -> Type (PF a)\n\ndata PF a where\n    ID :: PF (a -> a)\n\ntest :: Type a -> a -> a\ntest (PF (Func _ _)) ID = ID\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification #-}\n{-# OPTIONS_GHC -O -fno-warn-overlapping-patterns #-}\n\n-- Trac #2587\n-- Actually this bug related to free variables and\n-- type lets, but ostensibly it has a GADT flavour\n-- Hence being in the GADT directory.\n\nmodule GadtBug(bug) where\n\ndata Existential = forall a . Existential (Gadt a)\n\ndata Gadt a where Value :: Gadt Double\n\nbug = [ match undefined | ps <- undefined, _ <- ps ]\n  where\n        match (Existential _) = undefined\n        match (Existential _) = undefined\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n-- Trac 3013. \n-- This isn't strictly a GADT test, but it uses GADT syntax\n\nmodule T3013 where\n\ndata T where\n  A, B :: T\n  C :: T\n  D, E :: Int -> T\n\nf :: T -> T\nf A = D 3\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes, ImpredicativeTypes #-}\n\n-- Test Trac #3163\n\nmodule Report where\n\ndata Taker a where\n    Unreached :: Taker (forall s. s)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  TypeFamilies, ScopedTypeVariables #-}\nmodule T3169 where\n\nimport Prelude hiding ( lookup )\n\nclass Key k where\n  type Map k :: * -> *\n  lookup :: k -> Map k elt -> Maybe elt\n\ninstance (Key a, Key b) => Key (a,b) where\n  type Map (a,b) = MP a b\n  lookup (a,b) (m :: Map (a,b) elt)\n     = case lookup a m :: Maybe (Map b elt) of\n          Just (m2 :: Map b elt) -> lookup b m2 :: Maybe elt\n\ndata MP a b elt = MP (Map a (Map b elt))\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T3638 where\n\ndata T a where TInt :: T Int\n\nfoo :: T Int -> Int\n{-# NOINLINE [1] foo #-}\nfoo TInt = 0\n\n{-# RULES \"foo\"  forall x. foo x = case x of { TInt -> 0 } #-}\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T3651 where\n\ndata Z a where\n  U :: Z ()\n  B :: Z Bool\n\nunsafe1 :: Z a -> Z a -> a\nunsafe1 B U = ()\n\nunsafe2 :: a ~ b => Z b -> Z a -> a\nunsafe2 B U = ()\n\nunsafe3 :: a ~ b => Z a -> Z b -> a\nunsafe3 B U = True\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -Wall #-}\n\nmodule W where\n\nimport T5424a\n\ndata D a where\n     C1 :: D X\n     C2 :: D Y\n\nf :: D X -> Int\nf C1 = 1\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5424a where\n\ndata X\ndata Y\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}\nmodule T7205 where\n\ndata Abs env g v where\n  Abs :: g (a, env) h v -> Abs env (g (a, env) h v) (a -> v)\n\nclass Eval g env h v where\n  eval :: env -> g env h v -> v\n\nevalAbs :: Eval g2 (a2, env) h2 v2\n        => env\n        -> Abs env (g2 (a2, env) h2 v2) (a2->v2)\n        -> (a2->v2)\nevalAbs env (Abs e) x\n  = eval (x, env) e    -- e :: g (a,env) h v\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeFamilies,\n             TypeOperators, RankNTypes #-}\n\nmodule T7294 where\n\nimport Data.Kind (Type)\n\ndata Nat = Zero | Succ Nat\n\ndata Vec :: Type -> Nat -> Type where\n  Nil :: Vec a Zero\n  Cons :: a -> Vec a n -> Vec a (Succ n)\n\ntype family (m :: Nat) :< (n :: Nat) :: Bool\ntype instance m :< Zero = False\ntype instance Zero :< Succ n = True\ntype instance Succ n :< Succ m = n :< m\n\ndata SNat :: Nat -> Type where\n  SZero :: SNat Zero\n  SSucc :: forall (n :: Nat). SNat n -> SNat (Succ n)\n\nnth :: ((k :< n) ~ True) => Vec a n -> SNat k -> a\nnth (Cons x _) SZero = x\nnth (Cons _ xs) (SSucc k) = nth xs k\nnth Nil _ = undefined\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeFamilies,\n             TypeOperators, RankNTypes #-}\n\nmodule T7294 where\n\nimport Data.Kind (Type)\n\ndata Nat = Zero | Succ Nat\n\ndata Vec :: Type -> Nat -> Type where\n  Nil :: Vec a Zero\n  Cons :: a -> Vec a n -> Vec a (Succ n)\n\ntype family (m :: Nat) :< (n :: Nat) :: Bool\ntype instance m :< Zero = False\ntype instance Zero :< Succ n = True\ntype instance Succ n :< Succ m = n :< m\n\ndata SNat :: Nat -> Type where\n  SZero :: SNat Zero\n  SSucc :: forall (n :: Nat). SNat n -> SNat (Succ n)\n\nnth :: ((k :< n) ~ True) => Vec a n -> SNat k -> a\nnth (Cons x _) SZero = x\nnth (Cons _ xs) (SSucc k) = nth xs k\nnth Nil _ = undefined\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7321 where\n\nimport T7321a\n\nfoo :: Exp a\nfoo = error \"urk\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule T7321a where\n\ndata Exp a where\n   LamE :: (Exp a -> Exp b) -> Exp (Exp a -> Exp b)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule T7558 where\n\ndata T a b where\n  MkT :: (a~Maybe b) => a -> Maybe b -> T a b\n\nf :: T a a -> Bool\nf (MkT x y) = [x,y] `seq` True\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule T7974 where\n\ndata X a where\n   N :: (a ~ b) => X a\n\nk :: X a -> X b\nk N = N\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T9096 where\n\ndata Foo a where\n  MkFoo :: (->) a (Foo a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\nmodule Main where\n\nimport Data.Kind (Type)\nimport Foreign\nimport Unsafe.Coerce\n\ndata M = A | B deriving (Show, Eq)\n\nnewtype S (a :: M) = S Int\n\ndata SomeS = forall a . SomeS (S a)\n\ndata V0 :: M -> Type where\n  V0A :: Int -> V0 A\n  V0B :: Double -> V0 B\n\ndata V1 :: M -> Type where\n  V1A :: Int -> V1 A\n  V1B :: Double -> V1 B\n  V1a :: () -> V1 a\n\nviewV0 :: S a -> V0 a\nviewV0 (S i)\n  | even i = unsafeCoerce $ V0A 1\n  | otherwise = unsafeCoerce $ V0B 2\n\nviewV1 :: S a -> V1 a\nviewV1 (S i)\n  | even i = unsafeCoerce $ V1A 1\n  | otherwise = unsafeCoerce $ V1B 2\n\n\ntypeOf :: S a -> M\ntypeOf (S i) = if even i then A else B\n\ncast :: M -> SomeS -> S a\ncast ty (SomeS s@(S i))\n  | ty == typeOf s = S i\n  | otherwise = error \"cast\"\n\ntest0 :: IO ()\ntest0 =\n  let s = cast A (SomeS (S 0))\n  in case viewV0 s of\n       V0A{} -> putStrLn \"test0 - A\"\n       V0B{} -> putStrLn \"test0 - B\"\n\ntest1 :: IO ()\ntest1 =\n  let s = cast A (SomeS (S 2)) :: S A\n  in case viewV0 s of\n      V0A{} -> putStrLn \"test1 - A\"\n\ntest2 :: IO ()\ntest2 =\n  let s = cast A (SomeS (S 4))\n  in case viewV1 s of\n      V1A{} -> putStrLn \"test2 - A\"\n      V1B{} -> putStrLn \"test2 - B\"\n      V1a{} -> putStrLn \"test2 - O_o\"\n\nmain = do\n  test0 -- no output at all\n  test1 -- A\n  test2 -- O_o\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification #-}\n\n-- This typechecker, written by Stephanie Weirich at Dagstuhl (Sept 04)\n-- demonstrates that it's possible to write functions of type\n--      tc :: String -> Term a\n-- where Term a is our strongly-typed GADT.\n-- That is, generate a typed term from an untyped source; Lennart\n-- Augustsson set this as a challenge.\n--\n-- In fact the main function goes\n--      tc :: UTerm -> exists ty. (Ty ty, Term ty)\n-- so the type checker returns a pair of an expression and its type,\n-- wrapped, of course, in an existential.\n\nmodule Main where\n\n-- Untyped world --------------------------------------------\ndata UTerm = UVar String\n           | ULam String UType UTerm\n           | UApp UTerm UTerm\n           | UConBool Bool\n           | UIf UTerm UTerm UTerm\n\ndata UType = UBool | UArr UType UType\n\n-- Typed world -----------------------------------------------\ndata Ty t where\n  Bool :: Ty Bool\n  Arr  :: Ty a -> Ty b -> Ty (a -> b)\n\ndata Term g t where\n  Var :: Var g t -> Term g t\n  Lam :: Ty a -> Term (g,a) b -> Term g (a->b)\n  App :: Term g (s -> t) -> Term g s -> Term g t\n  ConBool :: Bool -> Term g Bool\n  If :: Term g Bool -> Term g a -> Term g a -> Term g a\n\ndata Var g t where\n  ZVar :: Var (h,t) t\n  SVar :: Var h t -> Var (h,s) t\n\ndata Typed thing = forall ty. Typed (Ty ty) (thing ty)\n\n-- Typechecking types\ndata ExType = forall t. ExType (Ty t)\n\ntcType :: UType -> ExType\ntcType UBool = ExType Bool\ntcType (UArr t1 t2) = case tcType t1 of { ExType t1' ->\n                      case tcType t2 of { ExType t2' ->\n                      ExType (Arr t1' t2') }}\n\n-- The type environment and lookup\ndata TyEnv g where\n  Nil :: TyEnv g\n  Cons :: String -> Ty t -> TyEnv h -> TyEnv (h,t)\n\nlookupVar :: String -> TyEnv g -> Typed (Var g)\nlookupVar _ Nil = error \"Variable not found\"\nlookupVar v (Cons s ty e)\n  | v==s      = Typed ty ZVar\n  | otherwise = case lookupVar v e of\n                   Typed ty v -> Typed ty (SVar v)\n\n-- Comparing types\nnewtype C1 c a2 d = C1 { unC1 :: c (d -> a2) }\nnewtype C2 c b1 d = C2 { unC2 :: c (b1 -> d) }\n\ncast2 :: Ty a -> Ty b -> (c a -> c b)\ncast2 Bool Bool x = x\ncast2 (Arr a1 a2) (Arr b1 b2) f\n  = let   C1 x = cast2 a1 b1 (C1 f)\n          C2 y = cast2 a2 b2 (C2 x)\n    in y\n\ndata Equal a b where\n  Equal :: Equal c c\n\ncmpTy :: Ty a -> Ty b -> Maybe (Equal a b)\ncmpTy Bool Bool = Just Equal\ncmpTy (Arr a1 a2) (Arr b1 b2)\n  = do  { Equal <- cmpTy a1 b1\n        ; Equal <- cmpTy a2 b2\n        ; return Equal }\n\n-- Typechecking terms\ntc :: UTerm -> TyEnv g -> Typed (Term g)\ntc (UVar v) env = case lookupVar v env of\n                    Typed ty v -> Typed ty (Var v)\ntc (UConBool b) env\n  = Typed Bool (ConBool b)\ntc (ULam s ty body) env\n  = case tcType ty of { ExType bndr_ty' ->\n    case tc body (Cons s bndr_ty' env) of { Typed body_ty' body' ->\n    Typed (Arr bndr_ty' body_ty')\n          (Lam bndr_ty' body') }}\ntc (UApp e1 e2) env\n  = case tc e1 env of { Typed (Arr bndr_ty body_ty) e1' ->\n    case tc e2 env of { Typed arg_ty e2' ->\n    case cmpTy arg_ty bndr_ty of\n        Nothing -> error \"Type error\"\n        Just Equal -> Typed body_ty (App e1' e2') }}\ntc (UIf e1 e2 e3) env\n  = case tc e1 env of { Typed Bool e1' ->\n    case tc e2 env of { Typed t2   e2' ->\n    case tc e3 env of { Typed t3   e3' ->\n    case cmpTy t2 t3 of\n        Nothing -> error \"Type error\"\n        Just Equal -> Typed t2 (If e1' e2' e3') }}}\n\nshowType :: Ty a -> String\nshowType Bool = \"Bool\"\nshowType (Arr t1 t2) = \"(\" ++ showType t1 ++ \") -> (\" ++ showType t2 ++ \")\"\n\nuNot = ULam \"x\" UBool (UIf (UVar \"x\") (UConBool False) (UConBool True))\n\ntest :: UTerm\ntest = UApp uNot (UConBool True)\n\nmain = putStrLn (case tc test Nil of\n                        Typed ty _ -> showType ty\n                )\n", "num_lines": 123}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Tdpe where\n\ndata Type t where\n    TBase :: Type Base\n    TFun  :: Type a -> Type b -> Type (a -> b)\n\nb :: Type Base\nb = TBase\n\nnewtype Base = In { out :: Term Base }\n\ndata Term t where\n    App :: Term (a->b) -> Term a -> Term b\n    Fun :: (Term a -> Term b) -> Term (a->b)\n\nreify :: Type t -> t -> Term t\nreify (TBase) v    = out v\nreify (TFun a b) v = Fun (\\x -> reify b (v (reflect a x)))\n\nreflect :: Type t -> Term t -> t\nreflect (TBase) e    = In e\nreflect (TFun a b) e = \\x -> reflect b (App e (reify a x))\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes #-}\n\nmodule Termination where\n\n{- Message from Jim Apple to Haskell-Cafe, 7/1/07\n\nTo show how expressive GADTs are, the datatype Terminating can hold\nany term in the untyped lambda calculus that terminates, and none that\ndon't. I don't think that an encoding of this is too surprising, but I\nthought it might be a good demonstration of the power that GADTs\nbring.\n\n\n   Using GADTs to encode normalizable and non-normalizable terms in\n   the lambda calculus. For definitions of normalizable and de Bruin\n   indices, I used:\n\n   Christian Urban and Stefan Berghofer - A Head-to-Head Comparison of\n   de Bruijn Indices and Names. In Proceedings of the International\n   Workshop on Logical Frameworks and Meta-Languages: Theory and\n   Practice (LFMTP 2006). Seattle, USA. ENTCS. Pages 46-59\n\n   http://www4.in.tum.de/~urbanc/Publications/lfmtp-06.ps\n\n   @incollection{ pierce97foundational,\n    author = \"Benjamin Pierce\",\n    title = \"Foundational Calculi for Programming Languages\",\n    booktitle = \"The Computer Science and Engineering Handbook\",\n    publisher = \"CRC Press\",\n    address = \"Boca Raton, FL\",\n    editor = \"Allen B. Tucker\",\n    year = \"1997\",\n    url = \"citeseer.ist.psu.edu/pierce95foundational.html\"\n   }\n\n> So it sounds to me like the (terminating) type checker solves the\n> halting problem.  Can you please explain which part of this I have\n> misunderstood?\n\nThe Terminating datatype takes three parameters:\n1. A term in the untyped lambda calculus\n2. A sequence of beta reductions\n3. A proof that the result of the beta reductions is normalized.\n\nNumber 2 is the hard part. For a term that calculated the factorial of\n5, the list in part 2 would be at least 120 items long, and each one\nis kind of a pain.\n\nGHC's type checker ends up doing exactly what it was doing before:\nchecking proofs.\n\n-}\n\n\n-- Terms in the untyped lambda-calculus with the de Bruijn representation\n\ndata Term t where\n    Var :: Nat n -> Term (Var n)\n    Lambda :: Term t -> Term (Lambda t)\n    Apply :: Term t1 -> Term t2 -> Term (Apply t1 t2)\n\n-- Natural numbers\n\ndata Nat n where\n    Zero :: Nat Z\n    Succ :: Nat n -> Nat (S n)\n\ndata Z\ndata S n\n\ndata Var t\ndata Lambda t\ndata Apply t1 t2\n\ndata Less n m where\n    LessZero :: Less Z (S n)\n    LessSucc :: Less n m -> Less (S n) (S m)\n\ndata Equal a b where\n    Equal :: Equal a a\n\ndata Plus a b c where\n    PlusZero :: Plus Z b b\n    PlusSucc :: Plus a b c -> Plus (S a) b (S c)\n\n{- We can reduce a term by function application, reduction under the lambda,\n   or reduction of either side of an application. We don't need this full\n   power, since we could get by with normal-order evaluation, but that\n   required a more complicated datatype for Reduce.\n-}\ndata Reduce t1 t2 where\n    ReduceSimple :: Replace Z t1 t2 t3 -> Reduce (Apply (Lambda t1) t2) t3\n    ReduceLambda :: Reduce t1 t2 -> Reduce (Lambda t1) (Lambda t2)\n    ReduceApplyLeft :: Reduce t1 t2 -> Reduce (Apply t1 t3) (Apply t2 t3)\n    ReduceApplyRight :: Reduce t1 t2 -> Reduce (Apply t3 t1) (Apply t3 t2)\n\n{- Lift and Replace use the de Bruijn operations as expressed in the Urban\n   and Berghofer paper. -}\ndata Lift n k t1 t2 where\n    LiftVarLess :: Less i k -> Lift n k (Var i) (Var i)\n    LiftVarGTE :: Either (Equal i k) (Less k i) -> Plus i n r -> Lift n k (Var i) (Var r)\n    LiftApply :: Lift n k t1 t1' -> Lift n k t2 t2' -> Lift n k (Apply t1 t2) (Apply t1' t2')\n    LiftLambda :: Lift n (S k) t1 t2 -> Lift n k (Lambda t1) (Lambda t2)\n\ndata Replace k t n r where\n    ReplaceVarLess :: Less i k -> Replace k (Var i) n (Var i)\n    ReplaceVarEq :: Equal i k -> Lift k Z n r -> Replace k (Var i) n r\n    ReplaceVarMore :: Less k (S i) -> Replace k (Var (S i)) n (Var i)\n    ReplaceApply :: Replace k t1 n r1 -> Replace k t2 n r2 -> Replace k (Apply t1 t2) n (Apply r1 r2)\n    ReplaceLambda :: Replace (S k) t n r -> Replace k (Lambda t) n (Lambda r)\n\n{- Reflexive transitive closure of the reduction relation. -}\ndata ReduceEventually t1 t2 where\n    ReduceZero :: ReduceEventually t1 t1\n    ReduceSucc :: Reduce t1 t2 -> ReduceEventually t2 t3 -> ReduceEventually t1 t3\n\n-- Definition of normal form: nothing with a lambda term applied to anything.\ndata Normal t where\n    NormalVar :: Normal (Var n)\n    NormalLambda :: Normal t -> Normal (Lambda t)\n    NormalApplyVar :: Normal t -> Normal (Apply (Var i) t)\n    NormalApplyApply :: Normal (Apply t1 t2) -> Normal t3 -> Normal (Apply (Apply t1 t2) t3)\n\n-- Something is terminating when it reduces to something normal\ndata Terminating where\n    Terminating :: Term t -> ReduceEventually t t' -> Normal t' -> Terminating\n\n{- We can encode terms that are non-terminating, even though this set is\n   only co-recursively enumerable, so we can't actually prove all of the\n   non-normalizable terms of the lambda calculus are non-normalizable.\n-}\n\ndata Reducible t1 where\n    Reducible :: Reduce t1 t2 -> Reducible t1\n-- A term is non-normalizable if, no matter how many reductions you have applied,\n-- you can still apply one more.\ntype Infinite t1 = forall t2 . ReduceEventually t1 t2 -> Reducible t2\n\ndata NonTerminating where\n    NonTerminating :: Term t -> Infinite t -> NonTerminating\n\n-- x\ntest1 :: Terminating\ntest1 = Terminating (Var Zero) ReduceZero NormalVar\n\n-- (\\x . x)@y\ntest2 :: Terminating\ntest2 = Terminating (Apply (Lambda (Var Zero))(Var Zero))\n        (ReduceSucc (ReduceSimple (ReplaceVarEq Equal (LiftVarGTE (Left Equal) PlusZero))) ReduceZero)\n        NormalVar\n\n-- omega = \\x.x@x\ntype Omega = Lambda (Apply (Var Z) (Var Z))\nomega = Lambda (Apply (Var Zero) (Var Zero))\n\n-- (\\x . \\y . y)@(\\z.z@z)\ntest3 :: Terminating\ntest3 = Terminating (Apply (Lambda (Lambda (Var Zero))) omega)\n        (ReduceSucc (ReduceSimple (ReplaceLambda (ReplaceVarLess LessZero))) ReduceZero)\n        (NormalLambda NormalVar)\n\n-- (\\x.x@x)(\\x.x@x)\ntest4 :: NonTerminating\ntest4 = NonTerminating (Apply omega omega) help3\n\nhelp1 :: Reducible (Apply Omega Omega)\nhelp1 = Reducible (ReduceSimple\n                (ReplaceApply (ReplaceVarEq Equal (LiftLambda\n                        (LiftApply (LiftVarLess LessZero) (LiftVarLess LessZero))))\n                (ReplaceVarEq Equal (LiftLambda (LiftApply\n                        (LiftVarLess LessZero) (LiftVarLess LessZero))))))\n\nhelp2 :: ReduceEventually (Apply Omega Omega) t -> Equal (Apply Omega Omega) t\nhelp2 ReduceZero = Equal\nhelp2 (ReduceSucc (ReduceSimple (ReplaceApply\n        (ReplaceVarEq _ (LiftLambda (LiftApply (LiftVarLess _) (LiftVarLess _))))\n        (ReplaceVarEq _ (LiftLambda (LiftApply (LiftVarLess _) (LiftVarLess _)))))) y)\n  = case help2 y of\n      Equal -> Equal\n\nhelp3 :: Infinite (Apply Omega Omega)\nhelp3 x = case help2 x of\n              Equal -> help1\n", "num_lines": 184}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Main where\n\ndata Rep t where\n  Rint :: Rep Int\n  Rchar :: Rep Char\n  Runit :: Rep ()\n  Rpair :: Rep a -> Rep b -> Rep (a,b)\n  Rsum  :: Rep a -> Rep b -> Rep (Either a b)\n  Rcon  :: String -> Rep t -> Rep t\n  Rdata :: Rep i -> (t -> i) -> (i -> t) -> Rep t\n\n\nint :: Rep Int\nint = Rint\n\nlist :: Rep a -> Rep [a]\nlist x = Rdata (Rsum (Rcon \"[]\" Runit) (Rcon \":\" (Rpair x (list x)))) h g\n  where \n    h [] = Left ()\n    h (x:xs) = Right (x,xs)\n\n    g (Left ()) = []\n    g (Right (x,xs)) = x:xs\n\n\naddUp :: Rep a -> a -> Int\naddUp Rint          n         = n\naddUp (Rpair r s)   (x,y)     = addUp r x + addUp s y\naddUp (Rsum r s)    (Left x)  = addUp r x\naddUp (Rsum r s)    (Right x) = addUp s x\naddUp (Rdata i f g) x         = addUp i (f x)\naddUp (Rcon s r)    x         = addUp r x\naddUp v             x         = 0\n\n\nmain = print (addUp (list int) [1,2,4])\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n\n-- Tests record selectors with unboxed fields for GADTs\n\nmodule Main where\n\ndata T a where\n  T1 :: { w :: !(Int, Int), x :: a, y :: b } -> T (a,b)\n  T2 :: { w :: !(Int, Int), x :: a } -> T (a,b)\n  T3 :: { z :: Int } -> T Bool\n\n-- T1 :: forall c a b. (c~(a,b)) => (Int,Int) -> a -> b -> T c\n\nf xv yv = T1 { w = (0,0), x = xv, y = yv }\n\ng :: T a -> T a\ng (T1 {x=xv, y=yv}) = T2 { w = (0,0), x = xv }\n\n-- h :: Num a => T a any -> a\nh v = x v + 1\n\ni v = let (x,y) = w v in x + y\n\nmain = do { let t1 = T1 { w = (0,0), y = \"foo\", x = 4 }\n                t2 = g t1\n          ; print (h (f 8 undefined))\n          ; print (h t2)\n          ; print (i t1)\n        }\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExistentialQuantification #-}\n\nmodule Main where\n\nsucceed :: a -> Maybe a\nsucceed = return\n\ndata V s t where\n  Z :: V (t,m) t\n  S :: V m t -> V (x,m) t\n\ndata Exp s t where\n  IntC  :: Int -> Exp s Int                     -- 5\n  BoolC :: Bool -> Exp s Bool                   -- True\n  Plus  :: Exp s Int -> Exp s Int -> Exp s Int  -- x + 3\n  Lteq  :: Exp s Int -> Exp s Int -> Exp s Bool -- x <= 3\n  Var   :: V s t -> Exp s t                     -- x\n\ndata Com s where\n  Set :: V s t -> Exp s t -> Com s              -- x := e\n  Seq :: Com s -> Com s -> Com s                -- { s1; s2; }\n  If :: Exp s Bool -> Com s -> Com s -> Com s   -- if e then x else y\n  While :: Exp s Bool -> Com s -> Com s         -- while e do s\n  Declare :: Exp s t -> Com (t,s) -> Com s      -- { int x = 5; s }\n\nupdate :: (V s t) -> t -> s -> s\nupdate Z n (x,y) = (n,y)\nupdate (S v) n (x,y) = (x,update v n y)\n\neval :: Exp s t -> s -> t\neval (IntC n) s = n\neval (BoolC b) s = b\neval (Plus x y) s = (eval x s) + (eval y s)\neval (Lteq x y) s = (eval x s) <= (eval y s)\neval (Var Z) (x,y) = x\neval (Var (S v)) (x,y) = eval (Var v) y\n\n\nexec :: (Com st) -> st -> st\nexec (Set v e) s = update v (eval e s) s\nexec (Seq x y) s = exec y (exec x s)\nexec (If test x1 x2) s =\n  if (eval test s) then exec x1 s else exec x2 s\nexec (While test body) s = loop s\n  where loop s = if (eval test s)\n                    then loop (exec body s)\n                    else s\nexec (Declare e body) s = store\n  where (_,store) = (exec body (eval e s,s))\n\nv0 = Z\nv1 = S Z\nv2 = S (S Z)\nv3 = S (S (S Z))\n\ne2 = Lteq (Plus (Var v0)(Var v1)) (Plus (Var v0) (IntC 1))\n\nsum_var = Z\nx = S Z\n\nprog :: Com (Int,(Int,a))\nprog =\n Seq (Set sum_var (IntC 0))\n     (Seq (Set x (IntC 1))\n     (While (Lteq (Var x) (IntC 5))\n            (Seq (Set sum_var (Plus (Var sum_var)(Var x)))\n                 (Set x (Plus (Var x) (IntC 1))))))\n\nans = exec prog (34,(12,1))\nmain = print ans\n{-\n{ sum = 0 ;\n  x = 1;\n  while (x <= 5)\n  { sum = sum + x;\n    x = x + 1;\n  }\n}\n-}\n\n\n---------------------------------------------------\n-- Untyped Annotated AST\n\ndata TyAst = I | B | P TyAst TyAst\n\ndata TypeR t where\n  IntR :: TypeR Int\n  BoolR :: TypeR Bool\n  PairR :: TypeR a -> TypeR b -> TypeR (a,b)\n\n-- Judgments for Types\ndata TJudgment = forall t . TJ (TypeR t)\n\ncheckT :: TyAst -> TJudgment\ncheckT I = TJ IntR\ncheckT B = TJ BoolR\ncheckT (P x y) =\n   case (checkT x,checkT y) of\n     (TJ a, TJ b) -> TJ(PairR a b)\n\n----------------------------------------------------\n-- Equality Proofs and Type representations\ndata Equal a b where\n  EqProof :: Equal a a\n\nmatch :: TypeR a -> TypeR b -> Maybe (Equal a b)\nmatch IntR IntR = succeed EqProof\nmatch BoolR BoolR = succeed EqProof\nmatch (PairR a b) (PairR c d) =\n  do { EqProof <- match a c\n     ; EqProof <- match b d\n     ; succeed EqProof }\nmatch _ _ = fail \"match fails\"\n\n\n----------------------------------------------\n-- checking Variables are consistent\n\ncheckV :: Int -> TypeR t -> TypeR s -> Maybe(V s t)\ncheckV 0 t1 (PairR t2 p) =\n  do { EqProof <- match t1 t2\n     ; return Z }\ncheckV n t1 (PairR ty p) =\n  do { v <- checkV (n-1) t1 p; return(S v)}\ncheckV n t1 sr = Nothing\n\n\n-----------------------------------------------------\ndata ExpAst\n  = IntCA Int\n  | BoolCA Bool\n  | PlusA ExpAst ExpAst\n  | LteqA ExpAst ExpAst\n  | VarA Int TyAst\n\n-- Judgments for Expressions\ndata EJudgment s = forall t . EJ (TypeR t) (Exp s t)\n\ncheckE :: ExpAst -> TypeR s -> Maybe (EJudgment s)\ncheckE (IntCA n) sr = succeed(EJ IntR (IntC n))\ncheckE (BoolCA b) sr = succeed(EJ BoolR (BoolC b))\ncheckE (PlusA x y) sr =\n  do { EJ t1 e1 <- checkE x sr\n     ; EqProof <- match t1 IntR\n     ; EJ t2 e2 <- checkE y sr\n     ; EqProof <- match t2 IntR\n     ; succeed(EJ IntR (Plus e1 e2))}\ncheckE (VarA n ty) sr =\n  do { TJ t <- succeed(checkT ty)\n     ; v <- checkV n t sr\n     ; return(EJ t (Var v)) }\n\n-----------------------------------------------------\ndata ComAst\n  = SetA Int TyAst ExpAst\n  | SeqA ComAst ComAst\n  | IfA ExpAst ComAst ComAst\n  | WhileA ExpAst ComAst\n  | DeclareA TyAst ExpAst ComAst\n\ndata CJudgment s = EC (Com s)\n\ncheckC :: ComAst -> TypeR s -> Maybe(CJudgment s)\ncheckC (SetA n ty e) sr =\n  do { TJ t1 <- succeed(checkT ty)\n     ; v <- checkV n t1 sr\n     ; EJ t2 e1 <- checkE e sr\n     ; EqProof <- match t1 t2\n     ; return(EC (Set v e1))}\ncheckC (SeqA x y) sr =\n  do { EC c1 <- checkC x sr\n     ; EC c2 <- checkC y sr\n     ; return(EC (Seq c1 c2)) }\ncheckC (IfA e x y) sr =\n  do { EJ t1 e1 <- checkE e sr\n     ; EqProof <- match t1 BoolR\n     ; EC c1 <- checkC x sr\n     ; EC c2 <- checkC y sr\n     ; return(EC(If e1 c1 c2)) }\ncheckC (WhileA e x) sr =\n  do { EJ t1 e1 <- checkE e sr\n     ; EqProof <- match t1 BoolR\n     ; EC c1 <- checkC x sr\n     ; return(EC(While e1 c1)) }\ncheckC (DeclareA ty e c) sr =\n  do { TJ t1 <- succeed(checkT ty)\n     ; EJ t2 e2 <- checkE e sr\n     ; EqProof <- match t1 t2\n     ; EC c2 <- checkC c (PairR t1 sr)\n     ; return(EC(Declare e2 c2)) }\n\n--------------------------------------------------------------\n\ne1 = Lteq (Plus (Var sum_var)(Var x)) (Plus (Var x) (IntC 1))\n\n{-\ndata Store s\n  = M (Code s)\n  | forall a b . N (Code a) (Store b) where s = (a,b)\n\neval2 :: Exp s t -> Store s -> Code t\neval2 (IntC n) s = lift n\neval2 (BoolC b) s = lift b\neval2 (Plus x y) s = [| $(eval2 x s) + $(eval2 y s) |]\neval2 (Lteq x y) s = [| $(eval2 x s) <= $(eval2 y s) |]\neval2 (Var Z) (N a b) = a\neval2 (Var (S v)) (N a b) = eval2 (Var v) b\neval2 (Var Z) (M x) = [| fst $x |]\neval2 (Var (S v)) (M x) = eval2 (Var v) (M [| snd $x |])\n\n\ntest e = [| \\ (x,(y,z)) -> $(eval2 e (N [|x|] (N [|y|] (M [|z|])))) |]\n\n-- test e1 --->  [| \\ (x,(y,z)) -> x + y <= y + 1 |]\n-}\n", "num_lines": 217}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE TypeFamilies  #-}\n\nmodule CanDoRep0 where\n\nimport GHC.Generics (Generic)\n\n\n-- We should be able to generate a generic representation for these types\ndata A                                          deriving Generic\n\ndata B a                                        deriving Generic\n\ndata C = C0 | C1                                deriving Generic\n\ndata D a = D0 | D1 { d11 :: a, d12 :: (D a) }   deriving Generic\n\ndata (:*:) a b = a :*: b                        deriving Generic\n\ndata family F a\ndata instance F Int = FInt                      deriving Generic\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule CanDoRep1 where\n\nimport GHC.Generics (Generic, Generic1)\n\n\n-- We should be able to generate a generic representation for these types\ndata A a                                deriving Generic1\n\ndata B a = B0 | B1                      deriving Generic1\n\ndata C a = C0 | C1 { c11 :: a, c12 :: (C a) }\n  deriving (Generic, Generic1)\n\ndata D a = D (Either Int a)             deriving Generic1\n\ndata E a = E (Either Int (E a))         deriving Generic1\n\ndata F c b a = F (c, b, a)              deriving Generic1\ndata G c b a = G [(c, c, c, c, b, a)]   deriving (Generic1, Show)\n\n\ndata Odd a = Odd a (Even a)             deriving Generic1\ndata Even a = NilEven | Even a (Odd a)  deriving Generic1\n\ndata Odd' a = Odd' a (Even' a)          deriving Generic1\ndata Even' a = NilEven' | Even' a (Odd' a)\n\ndata H b a = H0 | H1 (H b b)            deriving Generic1\n\ndata (:*:) a b = a :*: b                deriving (Generic, Generic1)\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric              #-}\n{-# LANGUAGE ExistentialQuantification  #-}\n{-# LANGUAGE StandaloneDeriving         #-}\n{-# LANGUAGE FlexibleInstances          #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE DatatypeContexts           #-}\n\nmodule CannotDoRep0_0 where\n\nimport GHC.Generics hiding (P, D)\n\n-- We do not support existential quantification\ndata Dynamic = forall a. Dynamic a deriving Generic\n\n-- Partial instantiation of types is not allowed\ndata P a = P a\nderiving instance Generic (P Int)\n\n-- This gets trickier for data families\ndata family D a b\ndata instance D Char b\ndata instance (Show b) => D Int b\ndata instance D () ()\n\n-- Bad: second argument is instantiated\nderiving instance Generic (D Char Char)\n-- Bad: has context\nderiving instance Generic (D Int a)\n-- Ok\nderiving instance Generic (D () ())\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric, DatatypeContexts #-}\n\nmodule CannotDoRep0_1 where\n\nimport GHC.Generics\n\n-- We do not support datatypes with context\ndata (Show a) => Context a = Context a deriving Generic\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric       #-}\n{-# LANGUAGE StandaloneDeriving  #-}\n{-# LANGUAGE GADTs               #-}\n\nmodule CannotDoRep0_2 where\n\nimport GHC.Generics\n\n-- We do not support GADTs\ndata Term a where\n  Int :: Term Int\n\nderiving instance Generic (Term a)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric              #-}\n{-# LANGUAGE ExistentialQuantification  #-}\n\nmodule CannotDoRep1_0 where\n\nimport GHC.Generics\n\n-- We do not support existential quantification\ndata Dynamic a = forall b. Dynamic b a deriving Generic1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric, DatatypeContexts #-}\n\nmodule CannotDoRep1_1 where\n\nimport GHC.Generics\n\n-- We do not support datatypes with context\ndata (Show a) => Context a = Context a deriving Generic1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric       #-}\n{-# LANGUAGE StandaloneDeriving  #-}\n{-# LANGUAGE GADTs               #-}\n\nmodule CannotDoRep1_2 where\n\nimport GHC.Generics\n\n-- We do not support GADTs\ndata Term a where\n  Int :: Term Int\n\nderiving instance Generic1 Term\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric       #-}\n\nmodule GenCannotDoRep1_3 where\n\nimport GHC.Generics\n\n-- We do not support occurrences of the type variable except as the last\n-- argument\ndata B a b = B (a, b)\n\ndata T a = T (B a Int) deriving Generic1\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric       #-}\n\nmodule GenCannotDoRep1_4 where\n\nimport GHC.Generics\n\n-- We do not support contravariant occurrences of the type variable\ndata T a = T (a -> Int) deriving Generic1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric       #-}\n\nmodule GenCannotDoRep1_6 where\n\nimport GHC.Generics\n\n-- We do not support occurrences of the type variable except as the last\n-- argument: == (->) ((->) a Int) Int\ndata T a = T ((a -> Int) -> Int) deriving Generic1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric       #-}\n\nmodule GenCannotDoRep1_7 where\n\nimport GHC.Generics\n\n-- We do not support occurrences of the type variable except as the last\n-- argument\ndata I a = I (a, Int) deriving Generic1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric, TypeFamilies      #-}\n\nmodule GenCannotDoRep1_8 where\n\nimport GHC.Generics\n\ndata B a = B (a -> Int)\n\ntype family TF (a :: *) :: *\n\n-- We do not support type families\ndata T a = T (TF a) deriving Generic1\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor   #-}\n{-# LANGUAGE DeriveGeneric   #-}\n{-# OPTIONS_GHC -ddump-deriv #-}\n\nmodule GenDerivOutput where\n\nimport GHC.Generics (Generic, Generic1)\n\ndata List a = Nil | Cons { element :: a, rest :: List a }\n  deriving (Generic, Generic1, Functor)\n\ndata Rose a = Empty | Rose a (List (Rose a))\n  deriving (Generic, Generic1)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric   #-}\n{-# OPTIONS_GHC -ddump-deriv #-}\n\nmodule GenDerivOutput1_0 where\n\nimport GHC.Generics (Generic1)\n\ndata List a = Nil | Cons { element :: a, rest :: List a } deriving Generic1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# OPTIONS_GHC -ddump-deriv #-}\n\nmodule CanDoRep1_1 where\n\nimport GHC.Generics (Generic, Generic1)\n\n\n-- We should be able to generate both generic representations for these types,\n-- without duplicating the meta ty cons\ndata Da a = D0 | D1 { d11a :: a, d12a :: (Da a) }\n  deriving (Generic, Generic1)\n\ndata Db a = D0b | D1b { d11b :: a, d12b :: (Db a) }\n  deriving (Generic)\nderiving instance Generic1 Db\n\ndata Dc a = D0c | D1c { d11c :: a, d12c :: (Dc a) }\n  deriving (Generic1)\nderiving instance Generic (Dc a)\n\ndata Dd a = D0d | D1d { d11d :: a, d12d :: (Dd a) }\nderiving instance Generic (Dd a)\nderiving instance Generic1 Dd\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n\nmodule Main where\n\nimport GHC.Generics\n\ndata    X = X   deriving Generic\nnewtype Y = Y X deriving Generic\n\nmain = print [isNewtype (from X), isNewtype (from (Y X))]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n\nmodule ShouldFail0 where\n\nimport GHC.Generics (Generic)\n\ndata X = X\n\nderiving instance Generic X\n\n-- Should fail (no XDeriveGeneric)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n\nmodule ShouldFail1_0 where\n\nimport GHC.Generics (Generic1)\n\ndata X a = X\n\nderiving instance Generic1 X\n\n-- Should fail (no XDeriveGeneric)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Main where\n\nimport Data.Proxy (Proxy(..))\nimport GHC.Generics\n\nmain :: IO ()\nmain = do\n  print (fullyStrict (Proxy :: Proxy (StrictMaybe Bool)))\n  print (fullyStrict (Proxy :: Proxy (Maybe Bool)))\n\ndata StrictMaybe a = StrictNothing | StrictJust !a\n  deriving (FullyStrict, Generic)\n\ninstance FullyStrict Bool\ninstance FullyStrict a => FullyStrict (Maybe a)\n\nclass FullyStrict a where\n  fullyStrict :: proxy a -> Bool\n  default fullyStrict :: (GFullyStrict (Rep a)) => proxy a -> Bool\n  fullyStrict _ = gfullyStrict (Proxy :: Proxy (Rep a p))\n\nclass GFullyStrict f where\n  gfullyStrict :: proxy (f p) -> Bool\n\ninstance GFullyStrict V1 where\n  gfullyStrict _ = True\n\ninstance GFullyStrict U1 where\n  gfullyStrict _ = True\n\ninstance FullyStrict c => GFullyStrict (Rec0 c) where\n  gfullyStrict _ = fullyStrict (Proxy :: Proxy c)\n\ninstance GFullyStrict f => GFullyStrict (D1 c f) where\n  gfullyStrict _ = gfullyStrict (Proxy :: Proxy (f p))\n\ninstance GFullyStrict f => GFullyStrict (C1 c f) where\n  gfullyStrict _ = gfullyStrict (Proxy :: Proxy (f p))\n\ninstance (GFullyStrict f, Selector c) => GFullyStrict (S1 c f) where\n  gfullyStrict _ = gfullyStrict (Proxy :: Proxy (f p))\n                && selDecidedStrictness (undefined :: S1 c f p) /= DecidedLazy\n\ninstance (GFullyStrict f, GFullyStrict g) => GFullyStrict (f :+: g) where\n  gfullyStrict _ =\n    gfullyStrict (Proxy :: Proxy (f p)) && gfullyStrict (Proxy :: Proxy (g p))\n\ninstance (GFullyStrict f, GFullyStrict g) => GFullyStrict (f :*: g) where\n  gfullyStrict _ =\n    gfullyStrict (Proxy :: Proxy (f p)) && gfullyStrict (Proxy :: Proxy (g p))\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Generics\n\nmain = do\n  putStrLn $ packageName $ from $ Just True\n  putStrLn $ packageName $ from $ True\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T10361a where\n\nclass C1 a where\n  type T1 a\n  type instance T1 a = Char\n\nclass C2 a where -- equivalent to C1\n  type T2 a\n  type instance T2 a = Char\n\nclass C3 a where -- equivalent to C1, C2\n  type T3 a\n  type instance T3 a = Char\n\ndata A = B\n  deriving C1\n\nderiving instance C2 A\n\ninstance C3 A\n\ntest1 :: T1 A\ntest1 = 'x'\n\ntest2 :: T2 A\ntest2 = 'x'\n\ntest3 :: T3 A\ntest3 = 'x'\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule T10361b where\n\nimport GHC.Generics\n\n---------------------------------------------------------------------\nclass Convert a where\n    type Result a\n    type instance Result a = GResult (Rep a)\n\n    convert :: a -> Result a\n    default convert\n            :: (Generic a, GConvert (Rep a), Result a ~ GResult (Rep a))\n            => a -> Result a\n    convert x = gconvert (from x)\n\ninstance Convert Float where\n    type Result Float = Float\n    convert = id\n\ninstance Convert Int where\n    type Result Int = Int\n    convert = id\n\n---------------------------------------------------------------------\nclass GConvert f where\n    type GResult f\n    gconvert :: f p -> GResult f\n\ninstance (Convert c) => GConvert (K1 i c) where\n    type GResult (K1 i c) = Result c\n    gconvert (K1 x) = convert x\n\ninstance (GConvert f) => GConvert (M1 i t f) where\n    type GResult (M1 i t f) = GResult f\n    gconvert (M1 x) = gconvert x\n\ninstance (GConvert f, GConvert g) => GConvert (f :*: g) where\n    type GResult (f :*: g) = (GResult f, GResult g)\n    gconvert (x :*: y) = (gconvert x, gconvert y)\n\n---------------------------------------------------------------------\n\ndata Data1 = Data1 Int Float\n    deriving (Generic)\n\ninstance Convert Data1\n\nval :: (Int, Float)\nval = convert $ Data1 0 0.0\n\ndata Data2 = Data2 Int Float\n    deriving (Generic, Convert)\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule Main (main) where\n\nimport GHC.Generics\n\ninfixr 1 `T`\ndata T a = T a a deriving Generic\ninstance HasFixity (T a)\n\ndata I a = a `I` a deriving Generic\ninstance HasFixity (I a)\n\nclass HasFixity a where\n  fixity :: a -> Fixity\n  default fixity :: (Generic a, GHasFixity (Rep a)) => a -> Fixity\n  fixity = gfixity . from\n\nclass GHasFixity f where\n  gfixity :: f a -> Fixity\n\ninstance GHasFixity f => GHasFixity (D1 d f) where\n  gfixity (M1 x) = gfixity x\n\ninstance Constructor c => GHasFixity (C1 c f) where\n  gfixity c = conFixity c\n\nmain :: IO ()\nmain = do\n  putStrLn $ show (fixity (T \"a\" \"b\")) ++ \", \" ++ show (fixity (\"a\" `I` \"b\"))\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-#LANGUAGE TypeApplications#-}\n{-#LANGUAGE MultiParamTypeClasses #-}\n{-#LANGUAGE AllowAmbiguousTypes #-}\n{-#LANGUAGE FlexibleInstances #-}\n{-#LANGUAGE ScopedTypeVariables #-}\n{-#LANGUAGE DefaultSignatures #-}\nmodule T12220 where\n\n-- | Type a is only used for\n-- type application.\nclass ToUse a where\n    toUse :: Int -> Int\n\n-- | The type used for\n-- type application\ndata Default\n\n\n-- | The instance using Default as type application.\n-- To call use:\n-- > toUse @Default\ninstance ToUse Default where\n    toUse a = 3*a\n\n-- | Typeclass whose methods work\n-- only with type application.\nclass Uses a b where\n    uses :: b -> [b]\n    -- | Default Signature, which generates the problem.\n    -- It is the same as the normal one\n    -- Comment it to 'fix' the bug.\n    default uses :: b -> [b]\n    uses v = [v]\n\n-- | But this one doesn't.\n-- Unless you comment the default signature.\ninstance (Uses t a, Uses t b, Uses t c) => Uses t (a,b,c)\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15012 where\n\nimport GHC.Generics\nimport T15012a\n\nblah :: IO ()\nblah = print $ from1 $ TyFamily 1 2\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15012a where\n\nimport GHC.Generics\n\ntype FakeOut a = Int\n\ndata family   TyFamily y z\ndata instance TyFamily a b = TyFamily Int (FakeOut b)\n  deriving Generic1\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts       #-}\n{-# LANGUAGE FlexibleInstances      #-}\n{-# LANGUAGE DeriveGeneric          #-}\n{-# LANGUAGE DeriveFunctor          #-}\n{-# LANGUAGE DefaultSignatures      #-}\n{-# LANGUAGE StandaloneDeriving     #-}\n{-# LANGUAGE UndecidableInstances   #-}\n\n-- DeriveAnyClass not enabled\n\nmodule T5462No1 where\n\nimport GHC.Generics hiding (C, C1, D)\nimport GFunctor\n\nclass C1 a where\n  c1 :: a -> Int\n\nclass C2 a where\n  c2 :: a -> Int\n  c2 _ = 0\n\nnewtype F a = F1 [a]\n  deriving (Show, Eq, Generic, Generic1, GFunctor)\n\ndata G = G1 deriving (C1)\ndata H = H1 deriving (C2)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts       #-}\n{-# LANGUAGE FlexibleInstances      #-}\n{-# LANGUAGE DeriveGeneric          #-}\n{-# LANGUAGE DeriveFunctor          #-}\n{-# LANGUAGE DefaultSignatures      #-}\n{-# LANGUAGE StandaloneDeriving     #-}\n{-# LANGUAGE UndecidableInstances   #-}\n{-# LANGUAGE DeriveAnyClass    #-}\n\nmodule Main where\n\nimport GHC.Generics hiding (C, C1, D)\nimport GEq1A\nimport Enum\nimport GFunctor\n\ndata A = A1\n  deriving (Show, Generic, GEq, GEnum)\n\ndata B a = B1 | B2 a (B a)\n  deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor)\n\ndata C phantom a = C1 | C2 a (C phantom a)\n  deriving (Show, Generic, Generic1, GEq, GEnum, GFunctor)\n\ndata D f a = D1 (f a) (f (D f a)) deriving (Generic, Generic1)\nderiving instance (Show (f a), Show (f (D f a))) => Show (D f a)\nderiving instance (GEq  (f a), GEq  (f (D f a))) => GEq  (D f a)\n\ndata E f a = E1 (f a)\n  deriving (Show, Eq, Generic, Generic1, GFunctor)\n\n\nmain = print (\n               geq A1 A1\n             , take 10 (genum :: [A])\n\n             , geq (B2 A1 B1) B1\n             , gmap (++ \"lo\") (B2 \"hel\" B1)\n             , take 3 (genum :: [B A])\n\n             , geq (C2 A1 C1) C1\n             , gmap (++ \"lo\") (C2 \"hel\" C1)\n\n             , geq (D1 \"a\" []) (D1 \"a\" [])\n\n             , gmap (++ \"lo\") (E1 [\"hel\"])\n             )\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts              #-}\n{-# LANGUAGE FlexibleInstances             #-}\n{-# LANGUAGE DeriveGeneric                 #-}\n{-# LANGUAGE DefaultSignatures             #-}\n{-# LANGUAGE StandaloneDeriving            #-}\n{-# LANGUAGE UndecidableInstances          #-}\n{-# LANGUAGE DeriveAnyClass                #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving    #-}\n\nmodule Main where\n\nimport GHC.Generics hiding (C, C1, D)\nimport GFunctor\n\nclass C1 a where\n  c1 :: a -> Int\n  c1 _ = 1\n\nclass C2 a where\n  c21 :: a -> Int\n  c21 = c22\n  c22 :: a -> Int\n  c22 = c21\n  {-# MINIMAL c21 | c22 #-}\n\nnewtype D = D Int deriving C1\n\ninstance C1 Int where c1 _ = 2\n\nnewtype F a = F1 [a]\n  deriving (Show, Eq, Generic, Generic1, GFunctor)\n\ndata G = G1 deriving (C1)\ndata H = H1 deriving (C2)\n\n\nmain = print (c1 (D 3))\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}\n\nmodule T5884 where\n\nimport GHC.Generics\nimport T5884Other\n\nderiving instance Generic (Pair a)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5884Other where\n\ndata Pair a = Pair a a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7878C where\n\nimport T7878A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\nmodule T7878A where\n\nimport T7878B\nimport GHC.Generics\n\ndata Test deriving Generic\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7878B where\n\nimport {-# SOURCE #-} T7878A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language DeriveGeneric, MagicHash #-}\n\nimport GHC.Generics\nimport GHC.Prim\n\ndata Array a = Array (Array# a) deriving Generic1\nnewtype Vec a = MkVec {unVec :: Array a} deriving Generic1\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# Language TypeFamilies #-}\n{-# Language DeriveGeneric #-}\n\nmodule T8479 where\n\nimport GHC.Generics\nimport Data.Kind (Type)\n\nclass Blah (a :: Type -> Type) where\n  type F a :: Type -> Type\n\ndata Foo (f :: Type -> Type) a = MkFoo ((F f) a) deriving Generic1\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies       #-}\n{-# LANGUAGE DeriveGeneric      #-}\n{-# LANGUAGE FlexibleInstances  #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\nmodule T9563 where\n\nimport Data.Kind (Type)\nimport GHC.Generics\n\ndata family F typ :: Type -> Type\ndata A\ndata instance F A a = AData a\n  deriving (Generic, Generic1)\n\ndata family G a b c d\ndata instance G Int b Float d = H deriving Generic\n\nderiving instance Generic1 (G Int b Float)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE DefaultSignatures #-}\n\nmodule Enum where\n\n\nimport GHC.Generics\n\n\n-----------------------------------------------------------------------------\n-- Utility functions for Enum'\n-----------------------------------------------------------------------------\n\ninfixr 5 |||\n\n-- | Interleave elements from two lists. Similar to (++), but swap left and\n-- right arguments on every recursive application.\n--\n-- From Mark Jones' talk at AFP2008\n(|||) :: [a] -> [a] -> [a]\n[]     ||| ys = ys\n(x:xs) ||| ys = x : ys ||| xs\n\n-- | Diagonalization of nested lists. Ensure that some elements from every\n-- sublist will be included. Handles infinite sublists.\n--\n-- From Mark Jones' talk at AFP2008\ndiag :: [[a]] -> [a]\ndiag = concat . foldr skew [] . map (map (\\x -> [x]))\n\nskew :: [[a]] -> [[a]] -> [[a]]\nskew []     ys = ys\nskew (x:xs) ys = x : combine (++) xs ys\n\ncombine :: (a -> a -> a) -> [a] -> [a] -> [a]\ncombine _ xs     []     = xs\ncombine _ []     ys     = ys\ncombine f (x:xs) (y:ys) = f x y : combine f xs ys\n\nfindIndex :: (a -> Bool) -> [a] -> Maybe Int\nfindIndex p xs = let l = [ i | (y,i) <- zip xs [(0::Int)..], p y]\n                 in if (null l)\n                    then Nothing\n                    else Just (head l)\n\n--------------------------------------------------------------------------------\n-- Generic enum\n--------------------------------------------------------------------------------\n\nclass Enum' f where\n  enum' :: [f a]\n\ninstance Enum' U1 where\n  enum' = [U1]\n\ninstance (GEnum c) => Enum' (K1 i c) where\n  enum' = map K1 genum\n\ninstance (Enum' f) => Enum' (M1 i c f) where\n  enum' = map M1 enum'\n\ninstance (Enum' f, Enum' g) => Enum' (f :+: g) where\n  enum' = map L1 enum' ||| map R1 enum'\n\ninstance (Enum' f, Enum' g) => Enum' (f :*: g) where\n  enum' = diag [ [ x :*: y | y <- enum' ] | x <- enum' ]\n\ninstance (GEnum a) => GEnum (Maybe a)\ninstance (GEnum a) => GEnum [a]\n\n\ngenumDefault :: (Generic a, Enum' (Rep a)) => [a]\ngenumDefault = map to enum'\n\nclass GEnum a where\n  genum :: [a]\n\n  default genum :: (Generic a, Enum' (Rep a)) => [a]\n  genum = genumDefault\n\ninstance GEnum Int where\n  genum = [0..] ||| (neg 0) where\n    neg n = (n-1) : neg (n-1)\n", "num_lines": 88}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, DeriveGeneric, TypeFamilies,\n             FlexibleInstances, MagicHash #-}\n\nmodule Main where\n\nimport Data.Kind\nimport GHC.Exts\nimport GHC.Generics hiding (C, D)\nimport GEq1A\n\n-- We should be able to generate a generic representation for these types\n\ndata C = C0 | C1\n  deriving Generic\n\ndata D a = D0 | D1 { d11 :: a, d12 :: (D a) }\n  deriving Generic\n\ndata (:**:) a b = a :**: b\n  deriving Generic\n\ndata family F a b :: Type -> Type\ndata instance F Int b c = F b Int c\n  deriving Generic\n\ndata U a = U a Addr# Char# Double# Float# Int# Word#\n  deriving Generic\n\ndata family UF a b :: Type -> Type\ndata instance UF Int b c = UF b c Addr# Char# Double# Float# Int# Word#\n  deriving Generic\n\n-- Example values\nc0 = C0\nc1 = C1\n\nd0 :: D Char\nd0 = D0\nd1 = D1 'p' D0\n\np1 :: Int :**: Char\np1 = 3 :**: 'p'\n\nf1 :: F Int Float Char\nf1 = F 0.0 3 'h'\nf2 = F 0.0 4 'h'\n\nu0 :: U Int\nu0 = U 1 \"1\"# '1'# 1.0## 1.0# 1# 1##\n{-# NOINLINE u0 #-}\n\nuf0 :: UF Int Int Int\nuf0 = UF 2 2 \"1\"# '2'# 2.0## 2.0# 2# 2##\n{-# NOINLINE uf0 #-}\n\n-- Generic instances\ninstance                   GEq C\ninstance (GEq a)        => GEq (D a)\ninstance (GEq a, GEq b) => GEq (a :**: b)\ninstance (GEq b, GEq c) => GEq (F Int b c)\ninstance (GEq a)        => GEq (U a)\ninstance (GEq b, GEq c) => GEq (UF Int b c)\n\n-- Tests\nteq0 = geq c0  c1\nteq1 = geq d0  d1\nteq2 = geq d0  d0\nteq3 = geq p1  p1\nteq4 = geq f1  f2\nteq5 = geq u0  u0\nteq6 = geq uf0 uf0\n\nmain = mapM_ print [teq0, teq1, teq2, teq3, teq4, teq5, teq6]\n", "num_lines": 74}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, DefaultSignatures,\n             FlexibleContexts, FlexibleInstances, MagicHash #-}\n\nmodule GEq1A where\n\nimport GHC.Exts\nimport GHC.Generics\n\nclass GEq' f where\n  geq' :: f a -> f a -> Bool\n\ninstance GEq' U1 where\n  geq' _ _ = True\n\ninstance (GEq c) => GEq' (K1 i c) where\n  geq' (K1 a) (K1 b) = geq a b\n\n-- No instances for P or Rec because geq is only applicable to types of kind *\n\ninstance (GEq' a) => GEq' (M1 i c a) where\n  geq' (M1 a) (M1 b) = geq' a b\n\ninstance (GEq' a, GEq' b) => GEq' (a :+: b) where\n  geq' (L1 a) (L1 b) = geq' a b\n  geq' (R1 a) (R1 b) = geq' a b\n  geq' _      _      = False\n\ninstance (GEq' a, GEq' b) => GEq' (a :*: b) where\n  geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2\n\n-- Unboxed types\ninstance GEq' UAddr where\n  geq' (UAddr a1) (UAddr a2)     = isTrue# (eqAddr# a1 a2)\ninstance GEq' UChar where\n  geq' (UChar c1) (UChar c2)     = isTrue# (eqChar# c1 c2)\ninstance GEq' UDouble where\n  geq' (UDouble d1) (UDouble d2) = isTrue# (d1 ==## d2)\ninstance GEq' UFloat where\n  geq' (UFloat f1) (UFloat f2)   = isTrue# (eqFloat# f1 f2)\ninstance GEq' UInt where\n  geq' (UInt i1) (UInt i2)       = isTrue# (i1 ==# i2)\ninstance GEq' UWord where\n  geq' (UWord w1) (UWord w2)     = isTrue# (eqWord# w1 w2)\n\nclass GEq a where\n  geq :: a -> a -> Bool\n  default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool\n  geq x y = geq' (from x) (from y)\n\n-- Base types instances (ad-hoc)\ninstance GEq Char   where geq = (==)\ninstance GEq Int    where geq = (==)\ninstance GEq Float  where geq = (==)\n\n-- Generic instances\ninstance (GEq a) => GEq (Maybe a)\ninstance (GEq a) => GEq [a]\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, DefaultSignatures, FlexibleInstances, DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule Main where\n\nimport GHC.Generics hiding (C, D)\n\nclass GEq' f where\n  geq' :: f a -> f a -> Bool\n\ninstance GEq' U1 where\n  geq' _ _ = True\n\ninstance (GEq c) => GEq' (K1 i c) where\n  geq' (K1 a) (K1 b) = geq a b\n\n-- No instances for P or Rec because geq is only applicable to types of kind *\n\ninstance (GEq' a) => GEq' (M1 i c a) where\n  geq' (M1 a) (M1 b) = geq' a b\n\ninstance (GEq' a, GEq' b) => GEq' (a :+: b) where\n  geq' (L1 a) (L1 b) = geq' a b\n  geq' (R1 a) (R1 b) = geq' a b\n  geq' _      _      = False\n\ninstance (GEq' a, GEq' b) => GEq' (a :*: b) where\n  geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2\n\n\nclass GEq a where \n  geq :: a -> a -> Bool\n  default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool\n  geq x y = geq' (from x) (from y)\n\n\n-- Base types instances (ad-hoc)\ninstance GEq Char   where geq = (==)\ninstance GEq Int    where geq = (==)\ninstance GEq Float  where geq = (==)\n{-\n-- Generic instances\ninstance (GEq a) => GEq (Maybe a)\ninstance (GEq a) => GEq [a]\n-}\n\ndata C = C0 | C1\n  deriving Generic\n\ndata D a = D0 | D1 { d11 :: a, d12 :: (D a) }\n  deriving Generic\n\ndata (:**:) a b = a :**: b\n  deriving Generic\n\n-- Example values\nc0 = C0\nc1 = C1\n\nd0 :: D Char\nd0 = D0\nd1 = D1 'p' D0\n\np1 :: Int :**: Char\np1 = 3 :**: 'p'\n\n-- Generic instances\ninstance                   GEq C\ninstance (GEq a)        => GEq (D a)\ninstance (GEq a, GEq b) => GEq (a :**: b)\n\n-- Tests\nteq0 = geq c0 c1\nteq1 = geq d0 d1\nteq2 = geq d0 d0\nteq3 = geq p1 p1\n\nmain = mapM_ print [teq0, teq1, teq2, teq3]\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators              #-}\n{-# LANGUAGE FlexibleContexts           #-}\n{-# LANGUAGE DefaultSignatures          #-}\n\nmodule GFunctor (\n  -- * Generic Functor class\n    GFunctor(..)\n  ) where\n\n\nimport GHC.Generics\n\n--------------------------------------------------------------------------------\n-- Generic fmap\n--------------------------------------------------------------------------------\n\nclass GFunctor' f where\n  gmap' :: (a -> b) -> f a -> f b\n\ninstance GFunctor' U1 where\n  gmap' _ U1 = U1\n\ninstance GFunctor' Par1 where\n  gmap' f (Par1 a) = Par1 (f a)\n\ninstance GFunctor' (K1 i c) where\n  gmap' _ (K1 a) = K1 a\n\ninstance (GFunctor f) => GFunctor' (Rec1 f) where\n  gmap' f (Rec1 a) = Rec1 (gmap f a)\n\ninstance (GFunctor' f) => GFunctor' (M1 i c f) where\n  gmap' f (M1 a) = M1 (gmap' f a)\n\ninstance (GFunctor' f, GFunctor' g) => GFunctor' (f :+: g) where\n  gmap' f (L1 a) = L1 (gmap' f a)\n  gmap' f (R1 a) = R1 (gmap' f a)\n\ninstance (GFunctor' f, GFunctor' g) => GFunctor' (f :*: g) where\n  gmap' f (a :*: b) = gmap' f a :*: gmap' f b\n\ninstance (GFunctor f, GFunctor' g) => GFunctor' (f :.: g) where\n  gmap' f (Comp1 x) = Comp1 (gmap (gmap' f) x)\n\n\nclass GFunctor f where\n  gmap :: (a -> b) -> f a -> f b\n  default gmap :: (Generic1 f, GFunctor' (Rep1 f))\n               => (a -> b) -> f a -> f b\n  gmap f = to1 . gmap' f . from1\n\n-- Base types instances\ninstance GFunctor Maybe\ninstance GFunctor []\ninstance GFunctor ((,) a)\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n\nmodule Main where\n\nimport GHC.Generics hiding (C, D)\nimport GFunctor\n\n-- We should be able to generate a generic representation for these types\ndata D a = D0 | D1 { d11 :: a, d12 :: (D a) }\n  deriving (Show, Generic, Generic1)\n\n-- Example values\nd0 :: D Char\nd0 = D0\nd1 = D1 (Just 'p') D0\n\nd2 :: (Fractional a) => D (a,a)\nd2 = D1 (3,0.14) D0\n\n-- Generic instances\ninstance GFunctor D\n\n-- Tests\nmain = print ( gmap (+1) (Just 2)\n             , gmap (+1) [0,1,2]\n             , gmap (+1) (0,0)\n             , gmap undefined d0 :: D ()\n             , gmap (const 'q') d1\n             , gmap (\\(a,b) -> a + b) d2 :: D Float)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators              #-}\n{-# LANGUAGE FlexibleContexts          #-}\n{-# LANGUAGE DefaultSignatures          #-}\n\nmodule GMap (\n  -- * Generic map class\n    GMap(..)\n  ) where\n\n\nimport GHC.Generics\n\n--------------------------------------------------------------------------------\n-- Generic map\n--------------------------------------------------------------------------------\n\nclass GMap t where\n  gmap :: (a -> b) -> t a -> t b\n  default gmap :: (Generic1 t, GMap (Rep1 t)) => (a -> b) -> t a -> t b\n  gmap f = to1 . gmap f . from1\n\ninstance GMap Par1 where gmap f (Par1 x) = Par1 $ f x\ninstance GMap f => GMap (Rec1 f) where gmap f (Rec1 x) = Rec1 $ gmap f x\n\ninstance GMap U1 where gmap _ U1 = U1\n\ninstance GMap (K1 i c) where gmap _ (K1 x) = K1 x\n\ninstance (GMap a) => GMap (M1 i d a) where gmap f (M1 x) = M1 $ gmap f x\n\ninstance (GMap a, GMap b) => GMap (a :+: b) where\n  gmap f (L1 x) = L1 $ gmap f x\n  gmap f (R1 x) = R1 $ gmap f x\n\ninstance (GMap a, GMap b) => GMap (a :*: b) where\n  gmap f (x :*: y) = gmap f x :*: gmap f y\n\n-- Base types instances\ninstance GMap []   where gmap = map\ninstance GMap Maybe    where gmap = fmap\ninstance GMap ((,) a)    where gmap f ~(x, y) = (x, f y)\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n\nmodule Main where\n\nimport GHC.Generics (Generic1)\nimport GMap\n\n-- We should be able to generate a generic representation for these types\ndata D a = D0 | D1 { d11 :: a, d12 :: (D a) } deriving (Show, Generic1)\n\n-- Example values\nd0 :: D Char\nd0 = D0\nd1 = D1 (Just 'p') D0\n\nd2 :: D (Int,Float)\nd2 = D1 (3,0.14) D0\n\n-- Generic instances\ninstance GMap D\n\n-- Tests\nmain = do\n  print $ gmap id d0\n  (let isJust (Just _) = True\n       isJust Nothing = False in print $ gmap isJust d1)\n  print $ gmap fst d2\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses      #-}\n{-# LANGUAGE TypeSynonymInstances       #-}\n{-# LANGUAGE FlexibleInstances          #-}\n{-# LANGUAGE FlexibleContexts           #-}\n{-# LANGUAGE TypeOperators              #-}\n{-# LANGUAGE DefaultSignatures          #-}\n{-# LANGUAGE MagicHash                  #-}\n{-# LANGUAGE PolyKinds                  #-}\n\nmodule GShow (\n  -- * Generic show class\n    GShow(..)\n  ) where\n\nimport GHC.Exts\nimport GHC.Generics\n\n--------------------------------------------------------------------------------\n-- Generic show\n--------------------------------------------------------------------------------\n\ndata Type = Rec | Tup | Pref | Inf String\n\nclass GShow' f where\n  gshowsPrec' :: Type -> Int -> f a -> ShowS\n  isNullary   :: f a -> Bool\n  isNullary = error \"generic show (isNullary): unnecessary case\"\n\ninstance GShow' U1 where\n  gshowsPrec' _ _ U1 = id\n  isNullary _ = True\n\ninstance (GShow c) => GShow' (K1 i c) where\n  gshowsPrec' _ n (K1 a) = gshowsPrec n a\n  isNullary _ = False\n\n-- No instances for P or Rec because gshow is only applicable to types of kind *\n\ninstance (GShow' a, Constructor c) => GShow' (M1 C c a) where\n  gshowsPrec' _ n c@(M1 x) =\n    case (fixity, conIsTuple c) of\n      (Prefix,False) -> showParen (n > 10 && not (isNullary x))\n                         ( showString (conName c)\n                         . if (isNullary x) then id else showChar ' '\n                         . showBraces t (gshowsPrec' t 10 x))\n      (Prefix,True)  -> showParen (n > 10) (showBraces t (gshowsPrec' t 10 x))\n      (Infix _ m,_)  -> showParen (n > m)  (showBraces t (gshowsPrec' t m  x))\n      where fixity = conFixity c\n            t = if (conIsRecord c) then Rec else\n                 if (conIsTuple c) then Tup else\n                  case fixity of\n                    Prefix    -> Pref\n                    Infix _ _ -> Inf (show (conName c))\n            showBraces :: Type -> ShowS -> ShowS\n            showBraces Rec     p = showChar '{' . p . showChar '}'\n            showBraces Tup     p = showChar '(' . p . showChar ')'\n            showBraces Pref    p = p\n            showBraces (Inf _) p = p\n            conIsTuple c = case conName c of\n                             ('(':',':_) -> True\n                             otherwise   -> False\n\n  isNullary (M1 x) = isNullary x\n\ninstance (Selector s, GShow' a) => GShow' (M1 S s a) where\n  gshowsPrec' t n s@(M1 x) | selName s == \"\" = showParen (n > 10)\n                                                 (gshowsPrec' t n x)\n                           | otherwise       =   showString (selName s)\n                                               . showString \" = \"\n                                               . gshowsPrec' t 0 x\n  isNullary (M1 x) = isNullary x\n\ninstance (GShow' a) => GShow' (M1 D d a) where\n  gshowsPrec' t n (M1 x) = gshowsPrec' t n x\n\ninstance (GShow' a, GShow' b) => GShow' (a :+: b) where\n  gshowsPrec' t n (L1 x) = gshowsPrec' t n x\n  gshowsPrec' t n (R1 x) = gshowsPrec' t n x\n\ninstance (GShow' a, GShow' b) => GShow' (a :*: b) where\n  gshowsPrec' t@Rec     n (a :*: b) =\n    gshowsPrec' t n     a . showString \", \" . gshowsPrec' t n     b\n  gshowsPrec' t@(Inf s) n (a :*: b) =\n    gshowsPrec' t n     a . showString s    . gshowsPrec' t n     b\n  gshowsPrec' t@Tup     n (a :*: b) =\n    gshowsPrec' t n     a . showChar ','    . gshowsPrec' t n     b\n  gshowsPrec' t@Pref    n (a :*: b) =\n    gshowsPrec' t (n+1) a . showChar ' '    . gshowsPrec' t (n+1) b\n\n  -- If we have a product then it is not a nullary constructor\n  isNullary _ = False\n\n-- Unboxed instances\ninstance GShow' UChar where\n  gshowsPrec' _ _ (UChar c)   = showsPrec 0 (C# c) . showChar '#'\ninstance GShow' UDouble where\n  gshowsPrec' _ _ (UDouble d) = showsPrec 0 (D# d) . showString \"##\"\ninstance GShow' UFloat where\n  gshowsPrec' _ _ (UFloat f)  = showsPrec 0 (F# f) . showChar '#'\ninstance GShow' UInt where\n  gshowsPrec' _ _ (UInt i)    = showsPrec 0 (I# i) . showChar '#'\ninstance GShow' UWord where\n  gshowsPrec' _ _ (UWord w)   = showsPrec 0 (W# w) . showString \"##\"\n\nclass GShow a where\n  gshowsPrec :: Int -> a -> ShowS\n  default gshowsPrec :: (Generic a, GShow' (Rep a)) => Int -> a -> ShowS\n  gshowsPrec n = gshowsPrec' Pref n . from\n\n  gshows :: a -> ShowS\n  gshows = gshowsPrec 0\n\n  gshow :: a -> String\n  gshow x = gshows x \"\"\n\n\n-- Base types instances\ninstance GShow Char   where gshowsPrec = showsPrec\ninstance GShow Double where gshowsPrec = showsPrec\ninstance GShow Int    where gshowsPrec = showsPrec\ninstance GShow Float  where gshowsPrec = showsPrec\ninstance {-# OVERLAPPING #-}\n         GShow String where gshowsPrec = showsPrec\ninstance GShow Word   where gshowsPrec = showsPrec\ninstance GShow Bool   where gshowsPrec = showsPrec\n\nintersperse :: a -> [a] -> [a]\nintersperse _ []    = []\nintersperse _ [h]   = [h]\nintersperse x (h:t) = h : x : (intersperse x t)\n\ninstance (GShow a) => GShow [a] where\n  gshowsPrec _ l =   showChar '['\n                   . foldr (.) id\n                      (intersperse (showChar ',') (map (gshowsPrec 0) l))\n                   . showChar ']'\n\ninstance (GShow a)          => GShow (Maybe a)\ninstance (GShow a, GShow b) => GShow (a,b)\n", "num_lines": 140}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric, MagicHash #-}\n\nmodule Main where\n\nimport GHC.Exts\nimport GHC.Generics hiding (C, D)\nimport GShow\n\n-- We should be able to generate a generic representation for these types\ndata D a = D0 | D1 { d11 :: a, d12 :: (D a) } deriving Generic\ndata U a = U a Char# Double# Float# Int# Word# deriving Generic\n\n-- Example values\nd0 :: D Char\nd0 = D0\nd1 = D1 (Just 'p') D0\n\nd2 :: D (Int,Float)\nd2 = D1 (3,0.14) D0\n\nu0 :: U Int\nu0 = U 1 '1'# -1.0## -1.0# -1# 1##\n\n-- Generic instances\ninstance (GShow a) => GShow (D a)\ninstance (GShow a) => GShow (U a)\n\n-- Tests\nmain = mapM_ putStrLn [gshow d0, gshow d1, gshow d2, gshow u0]\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T10604_Authenticated where\n\nimport GHC.Generics\n\ndata AuthParam = Prover | Verifier\n\nclass MapAuth f where\n    mapAuth :: f 'Prover -> f 'Verifier\n    default mapAuth :: (GMapAuth (Rep1 f), Generic1 f)\n                    => f 'Prover -> f 'Verifier\n    mapAuth = to1 . gmapAuth . from1\n\nclass GMapAuth f where\n    gmapAuth :: f 'Prover -> f 'Verifier\n\ninstance GMapAuth V1 where\n    gmapAuth = undefined\n\ninstance GMapAuth U1 where\n    gmapAuth U1 = U1\n\ninstance (GMapAuth l, GMapAuth r) => GMapAuth (l :+: r) where\n    gmapAuth (L1 x) = L1 (gmapAuth x)\n    gmapAuth (R1 x) = R1 (gmapAuth x)\n\ninstance (GMapAuth l, GMapAuth r) => GMapAuth (l :*: r) where\n    gmapAuth (x :*: y) = gmapAuth x :*: gmapAuth y\n\ninstance GMapAuth (K1 i c) where\n    gmapAuth (K1 c) = K1 c\n\ninstance (GMapAuth f) => GMapAuth (M1 i t f) where\n    gmapAuth (M1 x) = M1 (gmapAuth x)\n\ninstance (MapAuth f) => GMapAuth (Rec1 f) where\n    gmapAuth (Rec1 x) = Rec1 (mapAuth x)\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T10604_bad_variable_occurrence where\n\nimport GHC.Generics\n\nnewtype Fix f = In { out :: f (Fix f) }\n  deriving Generic1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE PolyKinds #-}\n{-# OPTIONS_GHC -ddump-deriv -fprint-explicit-kinds #-}\nmodule T10604_deriving where\n\nimport GHC.Generics\nimport Data.Kind (Type)\n\ndata Empty (a :: Bool)\n  deriving (Generic, Generic1)\ndata Proxy (a :: k) = Proxy\n  deriving (Functor, Generic, Generic1)\ndata Wrap (a :: Type -> Type) = Wrap (Proxy a)\n  deriving (Generic, Generic1)\ndata Wrap2 (a :: k -> Type) = Wrap2 (Proxy (Proxy a))\n  deriving (Generic, Generic1)\ndata SumOfProducts a = Prod1 (Proxy a) (Proxy a) | Prod2 (Proxy a) (Proxy a)\n  deriving (Generic, Generic1)\n\ndata Starify a = Starify1 a | Starify2 Int\n  deriving (Generic, Generic1)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE KindSignatures #-}\nmodule T10604_no_PolyKinds where\n\nimport GHC.Generics\n\ndata F (f :: * -> *) = F deriving Generic1\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses      #-}\n{-# LANGUAGE TypeSynonymInstances       #-}\n{-# LANGUAGE FlexibleInstances          #-}\n{-# LANGUAGE FlexibleContexts           #-}\n{-# LANGUAGE TypeOperators              #-}\n{-# LANGUAGE DefaultSignatures          #-}\n{- # LANGUAGE IncoherentInstances        #-} -- necessary, unfortunately\n{-# LANGUAGE OverlappingInstances        #-} \n\nmodule GUniplate where\n\nimport GHC.Generics\n\n--------------------------------------------------------------------------------\n-- Generic Uniplate\n--------------------------------------------------------------------------------\n\nclass Uniplate' f b where\n  children' :: f a -> [b]\n\ninstance Uniplate' U1 a where\n  children' U1 = []\n\ninstance {-# OVERLAPPING #-} Uniplate' (K1 i a) a where\n  -- overlaps the (Uniplate' (K1 i a) b) instance\n  children' (K1 a) = [a]\n\ninstance Uniplate' (K1 i a) b where\n  children' (K1 _) = []\n\ninstance (Uniplate' f b) => Uniplate' (M1 i c f) b where\n  children' (M1 a) = children' a\n\ninstance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :+: g) b where\n  children' (L1 a) = children' a\n  children' (R1 a) = children' a\n\ninstance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :*: g) b where\n  children' (a :*: b) = children' a ++ children' b \n\n\nclass Uniplate a where \n  children :: a -> [a]\n  default children :: (Generic a, Uniplate' (Rep a) a) => a -> [a]\n  children = children' . from\n\n\n-- Base types instances\ninstance Uniplate Char  where children _ = []\ninstance Uniplate Int   where children _ = []\ninstance Uniplate Float where children _ = []\n\ninstance Uniplate [a] where\n  children []    = []\n  children (_:t) = [t]\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n\nmodule Main where\n\nimport GHC.Generics\nimport GUniplate\n\n\ndata Tree     = Leaf | Node Int Tree Tree deriving (Show, Generic)\ndata Pair a b = Pair a b                  deriving (Show, Generic)\n\ninstance Uniplate Tree\ninstance Uniplate (Pair a b)\n\n-- Tests\nt1 = children ('p')\nt2 = children (Pair \"abc\" (Pair \"abc\" 2))\nt3 = children (Node 2 Leaf Leaf)\n\nmain = print (t1, t2, t3)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Config\n\nmain :: IO ()\nmain = putStrLn cProjectName\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport DynFlags\nimport GHC\nimport qualified GHC.LanguageExtensions as LangExt\n\nimport Control.Monad (forM_)\nimport Control.Monad.IO.Class (liftIO)\nimport System.Environment (getArgs)\n\nmain :: IO ()\nmain = do\n  [libdir] <- getArgs\n  runGhc (Just libdir) $ do\n    dflags <- getSessionDynFlags\n    setSessionDynFlags $ dflags\n      `gopt_unset` Opt_ImplicitImportQualified\n      `xopt_unset` LangExt.ImplicitPrelude\n\n    forM_ exprs $ \\expr ->\n      handleSourceError printException $ do\n        dyn <- dynCompileExpr expr\n        liftIO $ print dyn\n  where\n  exprs =\n    [ \"\"\n    , \"(),()\"\n    , \"()\"\n    , \"\\\"test\\\"\"\n    , unlines [ \"[()]\"\n              , \" :: [()]\"\n              ]\n    ]\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport DynFlags\nimport GHC\n\nimport Control.Monad.IO.Class (liftIO)\nimport System.Environment\nimport HeaderInfo\nimport Outputable\nimport StringBuffer\n\nmain :: IO ()\nmain = do\n  [libdir] <- getArgs\n  runGhc (Just libdir) $ do\n    dflags <- getSessionDynFlags\n    let dflags' = dflags `gopt_set` Opt_KeepRawTokenStream\n                         `gopt_set` Opt_Haddock\n        filename = \"T10942_A.hs\"\n    setSessionDynFlags dflags'\n    stringBuffer <- liftIO $ hGetStringBuffer filename\n    liftIO $ print (map unLoc (getOptions dflags' stringBuffer filename))\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nA normal comment, to check if we can still pick up the CPP directive after it.\n\n-}\n-- Check that we can parse a file with leading comments\n\n-- ^ haddock\n-- * haddock\n-- | haddock\n-- $ haddock\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE CPP #-}\nmodule T10942 where\n\nmain = return ()\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\nimport DynFlags\nimport FastString\nimport GHC\nimport StringBuffer\nimport Lexer\nimport SrcLoc\n\nmain :: IO ()\nmain = do\n    [libdir] <- getArgs\n\n    let stringBuffer = stringToStringBuffer \"-- $bar some\\n-- named chunk\"\n        loc = mkRealSrcLoc (mkFastString \"Foo.hs\") 1 1\n\n    token <- runGhc (Just libdir) $ do\n        dflags <- getSessionDynFlags\n        let pstate = mkPState (dflags `gopt_set` Opt_Haddock) stringBuffer loc\n        case unP (lexer False return) pstate of\n            POk _ token -> return (unLoc token)\n            _           -> error \"No token\"\n\n    -- #11579\n    -- Expected:                    \"ITdocCommentNamed \"bar some\\n named chunk\"\n    -- Actual (with ghc-8.0.1-rc2): \"ITdocCommentNamed \"bar some\"\n    print token\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport DynFlags\n\nimport Control.Monad\nimport Data.List\n\n-- Verify bogus flags aren't printed on flagsForCompletion and\n-- allNonDeprecatedFlags:\n--  * -fwarn-\n--  * -fno-warn-\n--\n-- Should print nothing\nmain :: IO ()\nmain = mapM_ print $ fwarnFlags (flagsForCompletion True) ++ nonDepFwarnFlags\n\n-- Get flags beginning with -fwarn- and -fno-warn-\nfwarnFlags :: [String] -> [String]\nfwarnFlags = filter isFwarn\n  where isFwarn flag = any (flip isPrefixOf $ flag) [\"-fwarn-\", \"-fno-warn\"]\n\n-- Get suggested flags for -fwarn-, -fno-warn-\nnonDepFwarnFlags :: [String]\nnonDepFwarnFlags = filter isFwarn allNonDeprecatedFlags\n  where isFwarn \"-fwarn-\"    = True\n        isFwarn \"-fno-warn-\" = True\n        isFwarn _            = False\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternGuards #-}\n{-# LANGUAGE ViewPatterns     #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies     #-}\nmodule Main where\n\nimport System.IO\nimport GHC\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\n\nmain::IO()\nmain = do\n        let c=\"module Test where\\ndata DataT=MkData {name :: String}\\n\"\n        writeFile \"Test.hs\" c\n        [libdir] <- getArgs\n        ok<-    runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        setSessionDynFlags dflags\n                        let mn =mkModuleName \"Test\"\n                        addTarget Target { targetId = TargetModule mn, targetAllowObjCode = True, targetContents = Nothing }\n                        load LoadAllTargets\n                        modSum <- getModSummary mn\n                        p <- parseModule modSum\n                        t <- typecheckModule p\n                        d <- desugarModule t\n                        l <- loadModule d\n                        let ts=typecheckedSource l\n--                        liftIO (putStr (showSDocDebug (ppr ts)))\n                        let fs=filterBag isDataCon ts\n                        return $ not $ isEmptyBag fs\n        removeFile \"Test.hs\"\n        print ok\n    where\n      isDataCon (dL->L _ (AbsBinds { abs_binds = bs }))\n        = not (isEmptyBag (filterBag isDataCon bs))\n      isDataCon (dL->L l (f@FunBind {}))\n        | (MG _ (dL->L _ (m:_)) _) <- fun_matches f,\n          ((dL->L _ (c@ConPatOut{})):_)<-hsLMatchPats m,\n          (dL->L l _)<-pat_con c\n        = isGoodSrcSpan l       -- Check that the source location is a good one\n      isDataCon _\n        = False\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport System.IO\nimport DynFlags\nimport GHC\nimport Exception\nimport Module\nimport FastString\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport PrelNames\n\nmain :: IO()\nmain\n  = do  [libdir] <- getArgs\n        ok <- runGhc (Just libdir) $ do\n          dflags <- getSessionDynFlags\n          setSessionDynFlags dflags\n          liftIO (setUnsafeGlobalDynFlags dflags)\n\n          setContext [ IIDecl (simpleImportDecl pRELUDE_NAME)\n                     , IIDecl (simpleImportDecl (mkModuleNameFS (fsLit \"System.IO\")))]\n          runDecls \"data X = Y ()\"\n          execStmt \"print True\" execOptions\n          gtry $ execStmt \"print (Y ())\" execOptions :: GhcMonad m => m (Either SomeException ExecResult)\n          runDecls \"data X = Y () deriving Show\"\n          _ <- dynCompileExpr \"'x'\"\n          execStmt \"print (Y ())\" execOptions\n          execStmt \"System.IO.hFlush System.IO.stdout\" execOptions\n        print \"done\"\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC\nimport GhcMonad\nimport Outputable\nimport System.IO\nimport System.Environment( getArgs )\n\nmain\n = do { [libdir] <- getArgs\n      ; runGhc (Just libdir) $ do\n           flags <- getSessionDynFlags\n           setSessionDynFlags (flags{ hscTarget = HscInterpreted, ghcLink = LinkInMemory})\n           target <- guessTarget \"T8639_api_a.hs\" Nothing\n           setTargets [target]\n           load LoadAllTargets\n           imps <- mapM parseImportDecl [\"import Prelude\", \"import System.IO\", \"import T8639_api_a\"]\n           setContext (map IIDecl imps)\n\n           -- With the next line, you get an \"Not in scope\" exception.\n           -- If you comment out this runStmt, it runs without error and prints the  type.\n           execStmt \"putStrLn (show 3)\" execOptions\n           execStmt \"hFlush stdout\" execOptions\n\n           ty <- exprType TM_Inst \"T8639_api_a.it\"\n           liftIO (putStrLn (showPpr flags ty))\n       ; hFlush stdout }\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8639_api_a where\n\nit = True\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC\nimport DynFlags\nimport System.Environment\nimport GhcMonad\n\ntestStrings = [\n    \"import Data.Maybe\"\n  , \"import qualified Data.Maybe\"\n  , \"import Data.Maybe (isJust)\"\n\n  , \"add a b = a+b\"\n  , \"data Foo = Foo String\"\n  , \"deriving instance Show Foo\"\n  , \"{-# WARNING Foo \\\"Just a warning\\\" #-}\"\n  , \"{-# ANN foo (Just \\\"Hello\\\") #-}\"\n  , \"{-# RULES \\\"map/map\\\" forall f g xs. map f (map g xs) = map (f.g) xs #-}\"\n  , \"class HasString a where\\n\\\n    \\  update :: a -> (String -> String) -> a\\n\\\n    \\  upcase :: a -> a\\n\\\n    \\  upcase x = update x (fmap toUpper)\\n\\\n    \\  content :: a -> String\\n\\\n    \\  default content :: Show a => a -> String\\n\\\n    \\  content = show\"\n  , \"instance HasString Foo where\\n\\\n    \\  update (Foo s) f = Foo (f s)\\n\\\n    \\  content (Foo s) = s\"\n\n  , \"add a b\"\n  , \"let foo = add a b\"\n  , \"x <- foo y\"\n  , \"5 + 8\"\n\n  , \"a <-\"\n  , \"2 +\"\n  , \"@#\"\n  ]\n\nmain = do\n  [libdir] <- getArgs\n  runGhc (Just libdir) $ do\n    liftIO (putStrLn \"Is import:\")\n    testWithParser isImport\n\n    liftIO (putStrLn \"Is declaration:\")\n    testWithParser isDecl\n\n    liftIO (putStrLn \"Is statement:\")\n    testWithParser isStmt\n\n  where\n    testWithParser parser = do\n      dflags <- getSessionDynFlags\n      liftIO . putStrLn . unlines $ map (testExpr (parser dflags)) testStrings\n\n    testExpr parser expr = do\n      expr ++ \": \" ++ show (parser expr)\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC\nimport Packages\nimport GhcMonad\nimport Outputable\nimport System.Environment\nimport DynFlags\nimport Module\n\nmain =\n  do [libdir] <- getArgs\n     _ <- runGhc (Just libdir) $ do\n                dflags <- getSessionDynFlags\n                setSessionDynFlags dflags\n                dflags <- getSessionDynFlags\n                liftIO $ print (mkModuleName \"Outputable\" `elem` listVisibleModuleNames dflags)\n     _ <- runGhc (Just libdir) $ do\n                dflags <- getSessionDynFlags\n                setSessionDynFlags (dflags {\n                    packageFlags = [ExposePackage \"-package ghc\"\n                                                  (PackageArg \"ghc\")\n                                                  (ModRenaming True [])]\n                    })\n                dflags <- getSessionDynFlags\n                liftIO $ print (mkModuleName \"Outputable\" `elem` listVisibleModuleNames dflags)\n     return ()\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\nmodule AnnotationLet (foo) where\n\n{\nimport qualified Data.List as DL\n;\nfoo = let\n        a 0 = 1\n        a _ = 2\n        b = 2\n      in a b\n;\ninfixr 8 +\n;\ndata ((f + g)) a = InL (f a) | InR (g a)\n;\n}\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\n-- import Data.Generics\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir] <- getArgs\n        testOneFile libdir \"AnnotationLet\"\n\ntestOneFile libdir fileName = do\n        p <- runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        setSessionDynFlags dflags\n                        let mn =mkModuleName fileName\n                        addTarget Target { targetId = TargetModule mn\n                                         , targetAllowObjCode = True\n                                         , targetContents = Nothing }\n                        load LoadAllTargets\n                        modSum <- getModSummary mn\n                        p <- parseModule modSum\n                        t <- typecheckModule p\n                        d <- desugarModule t\n                        l <- loadModule d\n                        let ts=typecheckedSource l\n                            r =renamedSource l\n                        -- liftIO (putStr (showSDocDebug (ppr ts)))\n                        return (pm_annotations p)\n\n        let anns = p\n            (l,_) = fst $ head $ Map.toList (fst anns)\n            annModule = (getAnnotation anns l AnnModule)\n            annLet    = (getAnnotation anns l AnnLet)\n\n        putStrLn (intercalate \"\\n\" [showAnns anns,pp annModule,pp annLet,pp l])\n\nshowAnns (anns,_) = \"[\\n\" ++ (intercalate \"\\n\"\n   $ map (\\((s,k),v)\n              -> (\"(AK \" ++ pp s ++ \" \" ++ show k ++\" = \" ++ pp v ++ \")\\n\"))\n   $ Map.toList anns)\n    ++ \"]\\n\"\n\npp a = showPpr unsafeGlobalDynFlags a\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections,TypeFamilies #-}\n{-# LANGUAGE PatternGuards,ScopedTypeVariables #-}\nmodule AnnotationTuple (foo) where\n\n{\nimport qualified Data.List as DL\n;\nfoo = let\n        a = 1\n        b = 2\n      in a + b\n\n;\nbar = print $ map (1, \"hello\"   , 6.5,, [5, 5, 6, 7]) [Just (), Nothing]\n;\nbaz = (1, \"hello\", 6.5,,,,) 'a' (Just ())\n;\ndata family GMap k :: * -> *\n;\nmatch n\n      | Just 5 <- Just n\n      , Just 6 <- Nothing\n      , Just 7 <- Just 9\n      = Just 8\n;\nboo :: Int = 3\n}\n-- Note: the trailing whitespace in this file is used to check that we\n-- have an annotation for it.\n\n\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule BundleExport(P(.., A), Q(B)) where\n\ndata P = P\n\ndata Q = Q\n\npattern A = P\npattern B = Q\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This program must be called with GHC's libdir and the file to be checked as\n-- the command line arguments.\nmodule CheckUtils where\n\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport BasicTypes\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport ApiAnnotation\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\n_main::IO()\n_main = do\n        [libdir,fileName] <- getArgs\n        testOneFile libdir fileName\n\ntestOneFile libdir fileName = do\n       ((anns,cs),p) <- runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        setSessionDynFlags dflags\n                        let mn =mkModuleName fileName\n                        addTarget Target { targetId = TargetModule mn\n                                         , targetAllowObjCode = True\n                                         , targetContents = Nothing }\n                        load LoadAllTargets\n                        modSum <- getModSummary mn\n                        p <- parseModule modSum\n                        return (pm_annotations p,p)\n\n       let spans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)\n\n           problems = filter (\\(s,a) -> not (Set.member s spans))\n                             $ getAnnSrcSpans (anns,cs)\n\n           exploded = [((kw,ss),[anchor])\n                      | ((anchor,kw),sss) <- Map.toList anns,ss <- sss]\n\n           exploded' = Map.toList $ Map.fromListWith (++) exploded\n\n           problems' = filter (\\(_,anchors)\n                                -> not (any (\\a -> Set.member a spans) anchors))\n                              exploded'\n\n       putStrLn \"---Problems---------------------\"\n       putStrLn (intercalate \"\\n\" [showAnns $ Map.fromList $ map snd problems])\n       putStrLn \"---Problems'--------------------\"\n       putStrLn (intercalate \"\\n\" [pp $ Map.fromList $ map fst problems'])\n       putStrLn \"--------------------------------\"\n       putStrLn (intercalate \"\\n\" [showAnns anns])\n\n    where\n      getAnnSrcSpans :: ApiAnns -> [(SrcSpan,(ApiAnnKey,[SrcSpan]))]\n      getAnnSrcSpans (anns,_) = map (\\a@((ss,_),_) -> (ss,a)) $ Map.toList anns\n\n      getAllSrcSpans :: (Data t) => t -> [SrcSpan]\n      getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast\n        where\n          getSrcSpan :: SrcSpan -> [SrcSpan]\n          getSrcSpan ss = [ss]\n\n\nshowAnns anns = \"[\\n\" ++ (intercalate \"\\n\"\n   $ map (\\((s,k),v)\n              -> (\"(AK \" ++ pp s ++ \" \" ++ show k ++\" = \" ++ pp v ++ \")\\n\"))\n   $ Map.toList anns)\n    ++ \"]\\n\"\n\npp a = showPpr unsafeGlobalDynFlags a\n\n\n-- ---------------------------------------------------------------------\n\n-- Copied from syb for the test\n\n\n-- | Generic queries of type \\\"r\\\",\n--   i.e., take any \\\"a\\\" and return an \\\"r\\\"\n--\ntype GenericQ r = forall a. Data a => a -> r\n\n\n-- | Make a generic query;\n--   start from a type-specific case;\n--   return a constant otherwise\n--\nmkQ :: ( Typeable a\n       , Typeable b\n       )\n    => r\n    -> (b -> r)\n    -> a\n    -> r\n(r `mkQ` br) a = case cast a of\n                        Just b  -> br b\n                        Nothing -> r\n\n\n\n-- | Summarise all nodes in top-down, left-to-right order\neverything :: (r -> r -> r) -> GenericQ r -> GenericQ r\n\n-- Apply f to x to summarise top-level node;\n-- use gmapQ to recurse into immediate subterms;\n-- use ordinary foldl to reduce list of intermediate results\n\neverything k f x = foldl k (f x) (gmapQ (everything k f) x)\n", "num_lines": 118}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\n-- import Data.Generics\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir] <- getArgs\n        testOneFile libdir \"CommentsTest\" True\n        testOneFile libdir \"CommentsTest\" False\n\ntestOneFile libdir fileName useHaddock = do\n    p <- runGhc (Just libdir) $ do\n        dflags <- getSessionDynFlags\n        let dflags' = if useHaddock\n                        then gopt_set (gopt_set dflags Opt_Haddock)\n                                       Opt_KeepRawTokenStream\n                        else gopt_set (gopt_unset dflags Opt_Haddock)\n                                       Opt_KeepRawTokenStream\n        setSessionDynFlags dflags'\n        let mn =mkModuleName fileName\n        addTarget Target { targetId = TargetModule mn\n                         , targetAllowObjCode = True\n                         , targetContents = Nothing }\n        load LoadAllTargets\n        modSum <- getModSummary mn\n        p <- parseModule modSum\n        t <- typecheckModule p\n        d <- desugarModule t\n        l <- loadModule d\n        let ts=typecheckedSource l\n            r =renamedSource l\n        -- liftIO (putStr (showSDocDebug (ppr ts)))\n        return (pm_annotations p)\n\n    let anns = p\n\n    putStrLn (intercalate \"\\n\" [showAnns anns])\n\nshowAnns (_,anns) = \"[\\n\" ++ (intercalate \"\\n\"\n   $ map (\\(s,v)\n              -> (\"( \" ++ pp s ++\" =\\n[\" ++ showToks v ++ \"])\\n\"))\n   $ Map.toList anns)\n    ++ \"]\\n\"\n\nshowToks ts = intercalate \",\\n\\n\"\n            $ map (\\(L p t) -> \"(\" ++ pp p ++ \",\" ++ show t ++ \")\") ts\n\npp a = showPpr unsafeGlobalDynFlags a\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFoldable #-}\nmodule CommentsTest (foo) where\n{-\nAn opening comment\n  {- with a nested one -}\n  {-# nested PRAGMA #-}\n-}\n\nimport qualified Data.List as DL\n\n-- | The function @foo@ does blah\nfoo = let\n        a = 1\n        b = 2 -- value 2\n      in a + b\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ParallelListComp,\n             TransformListComp,\n             RecordWildCards #-}\n--             MonadComprehensions,\n\nmodule ListComprehensions where\n\n\n\nimport GHC.Exts\nimport qualified Data.Map as M\nimport Data.Ord (comparing)\nimport Data.List (sortBy)\n\n-- Let\u00e2\u20ac\u2122s look at a simple, normal list comprehension to start:\n\nparallelListComp :: [Int]\nparallelListComp = [ x + y * z\n                   | x <- [0..10]\n                   | y <- [10..20]\n                   | z <- [20..30]\n                   ]\n\noldest :: [Int] -> [String]\noldest tbl = [ \"str\"\n             | n <- tbl\n             , then id\n             ]\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\n-- import Data.Generics\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport BasicTypes\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport ApiAnnotation\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport System.Exit\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir] <- getArgs\n        testOneFile libdir \"ListComprehensions\"\n        exitSuccess\n\ntestOneFile libdir fileName = do\n       ((anns,cs),p) <- runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        setSessionDynFlags dflags\n                        let mn =mkModuleName fileName\n                        addTarget Target { targetId = TargetModule mn\n                                         , targetAllowObjCode = True\n                                         , targetContents = Nothing }\n                        load LoadAllTargets\n                        modSum <- getModSummary mn\n                        p <- parseModule modSum\n                        t <- typecheckModule p\n                        d <- desugarModule t\n                        l <- loadModule d\n                        let ts=typecheckedSource l\n                            r =renamedSource l\n                        return (pm_annotations p,p)\n\n       let spans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)\n\n       putStrLn (pp spans)\n       putStrLn \"--------------------------------\"\n       putStrLn (intercalate \"\\n\" [showAnns anns])\n\n    where\n      getAnnSrcSpans :: ApiAnns -> [(SrcSpan,(ApiAnnKey,[SrcSpan]))]\n      getAnnSrcSpans (anns,_) = map (\\a@((ss,_),_) -> (ss,a)) $ Map.toList anns\n\n      getAllSrcSpans :: (Data t) => t -> [SrcSpan]\n      getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast\n        where\n          getSrcSpan :: SrcSpan -> [SrcSpan]\n          getSrcSpan ss = [ss]\n\nshowAnns anns = \"[\\n\" ++ (intercalate \"\\n\"\n   $ map (\\((s,k),v)\n              -> (\"(AK \" ++ pp s ++ \" \" ++ show k ++\" = \" ++ pp v ++ \")\\n\"))\n   $ Map.toList anns)\n    ++ \"]\\n\"\n\npp a = showPpr unsafeGlobalDynFlags a\n\n\n-- ---------------------------------------------------------------------\n\n-- Copied from syb for the test\n\n\n-- | Generic queries of type \\\"r\\\",\n--   i.e., take any \\\"a\\\" and return an \\\"r\\\"\n--\ntype GenericQ r = forall a. Data a => a -> r\n\n\n-- | Make a generic query;\n--   start from a type-specific case;\n--   return a constant otherwise\n--\nmkQ :: ( Typeable a\n       , Typeable b\n       )\n    => r\n    -> (b -> r)\n    -> a\n    -> r\n(r `mkQ` br) a = case cast a of\n                        Just b  -> br b\n                        Nothing -> r\n\n\n\n-- | Summarise all nodes in top-down, left-to-right order\neverything :: (r -> r -> r) -> GenericQ r -> GenericQ r\n\n-- Apply f to x to summarise top-level node;\n-- use gmapQ to recurse into immediate subterms;\n-- use ordinary foldl to reduce list of intermediate results\n\neverything k f x = foldl k (f x) (gmapQ (everything k f) x)\n", "num_lines": 110}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- Testing that check-api-annotations can load a main module file\nmain = putStrLn \"hello\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\n-- import Data.Generics\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport BasicTypes\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir] <- getArgs\n        testOneFile libdir \"AnnotationTuple\"\n\ntestOneFile libdir fileName = do\n       ((anns,cs),p) <- runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        setSessionDynFlags dflags\n                        let mn =mkModuleName fileName\n                        addTarget Target { targetId = TargetModule mn\n                                         , targetAllowObjCode = True\n                                         , targetContents = Nothing }\n                        load LoadAllTargets\n                        modSum <- getModSummary mn\n                        p <- parseModule modSum\n                        t <- typecheckModule p\n                        d <- desugarModule t\n                        l <- loadModule d\n                        let ts=typecheckedSource l\n                            r =renamedSource l\n                        return (pm_annotations p,p)\n\n       let tupArgs = gq (pm_parsed_source p)\n\n       putStrLn (pp tupArgs)\n       putStrLn (intercalate \"\\n\" [showAnns anns])\n\n    where\n     gq ast = everything (++) ([] `mkQ` doLHsTupArg) ast\n\n     doLHsTupArg :: LHsTupArg GhcPs -> [(SrcSpan,String,HsExpr GhcPs)]\n     doLHsTupArg (L l arg@(Present {}))\n                                = [(l,\"p\",ExplicitTuple noExt [L l arg] Boxed)]\n     doLHsTupArg (L l arg@(Missing {}))\n                                = [(l,\"m\",ExplicitTuple noExt [L l arg] Boxed)]\n\n\nshowAnns anns = \"[\\n\" ++ (intercalate \"\\n\"\n   $ map (\\((s,k),v)\n              -> (\"(AK \" ++ pp s ++ \" \" ++ show k ++\" = \" ++ pp v ++ \")\\n\"))\n   $ Map.toList anns)\n    ++ \"]\\n\"\n\npp a = showPpr unsafeGlobalDynFlags a\n\n\n-- ---------------------------------------------------------------------\n\n-- Copied from syb for the test\n\n\n-- | Generic queries of type \\\"r\\\",\n--   i.e., take any \\\"a\\\" and return an \\\"r\\\"\n--\ntype GenericQ r = forall a. Data a => a -> r\n\n\n-- | Make a generic query;\n--   start from a type-specific case;\n--   return a constant otherwise\n--\nmkQ :: ( Typeable a\n       , Typeable b\n       )\n    => r\n    -> (b -> r)\n    -> a\n    -> r\n(r `mkQ` br) a = case cast a of\n                        Just b  -> br b\n                        Nothing -> r\n\n\n\n-- | Summarise all nodes in top-down, left-to-right order\neverything :: (r -> r -> r) -> GenericQ r -> GenericQ r\n\n-- Apply f to x to summarise top-level node;\n-- use gmapQ to recurse into immediate subterms;\n-- use ordinary foldl to reduce list of intermediate results\n\neverything k f x = foldl k (f x) (gmapQ (everything k f) x)\n", "num_lines": 105}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, TypeFamilies #-}\n{-# OPTIONS -Wno-star-is-type #-}\n\nmodule X (type (X.*)) where\n\ntype family (*) a b where { (*) a b = Either b a }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\n-- import Data.Generics\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport BasicTypes\nimport DynFlags\nimport FastString\nimport ForeignCall\nimport MonadUtils\nimport Outputable\nimport HsDecls\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir,fileName] <- getArgs\n        testOneFile libdir fileName\n\ntestOneFile libdir fileName = do\n       ((anns,cs),p) <- runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        setSessionDynFlags dflags\n                        let mn =mkModuleName fileName\n                        addTarget Target { targetId = TargetModule mn\n                                         , targetAllowObjCode = True\n                                         , targetContents = Nothing }\n                        load LoadAllTargets\n                        modSum <- getModSummary mn\n                        p <- parseModule modSum\n                        return (pm_annotations p,p)\n\n       let tupArgs = gq (pm_parsed_source p)\n\n       putStrLn (pp tupArgs)\n       -- putStrLn (intercalate \"\\n\" [showAnns anns])\n\n    where\n     gq ast = everything (++) ([] `mkQ` doWarningTxt\n                               `extQ` doImportDecl\n                               `extQ` doCType\n                               `extQ` doRuleDecl\n                               `extQ` doCCallTarget\n                               `extQ` doHsExpr\n                              ) ast\n\n     doWarningTxt :: WarningTxt -> [(String,[Located (SourceText,FastString)])]\n     doWarningTxt ((WarningTxt _ ss))    = [(\"w\",map conv ss)]\n     doWarningTxt ((DeprecatedTxt _ ss)) = [(\"d\",map conv ss)]\n\n     doImportDecl :: ImportDecl GhcPs\n                  -> [(String,[Located (SourceText,FastString)])]\n     doImportDecl (ImportDecl _ _ _ Nothing _ _ _ _ _ _) = []\n     doImportDecl (ImportDecl _ _ _ (Just ss) _ _ _ _ _ _)\n                                                     = [(\"i\",[conv (noLoc ss)])]\n\n     doCType :: CType -> [(String,[Located (SourceText,FastString)])]\n     doCType (CType src (Just (Header hs hf)) c)\n                                    = [(\"c\",[noLoc (hs,hf),noLoc c])]\n     doCType (CType src Nothing  c) = [(\"c\",[noLoc c])]\n\n     doRuleDecl :: RuleDecl GhcPs\n                -> [(String,[Located (SourceText,FastString)])]\n     doRuleDecl (HsRule _ ss _ _ _ _ _) = [(\"r\",[ss])]\n\n     doCCallTarget :: CCallTarget\n                   -> [(String,[Located (SourceText,FastString)])]\n     doCCallTarget (StaticTarget s f _ _) = [(\"st\",[(noLoc (s,f))])]\n\n     doHsExpr :: HsExpr GhcPs -> [(String,[Located (SourceText,FastString)])]\n     doHsExpr (HsCoreAnn _ src ss _) = [(\"co\",[conv (noLoc ss)])]\n     doHsExpr (HsSCC     _ src ss _) = [(\"sc\",[conv (noLoc ss)])]\n     doHsExpr (HsTickPragma _ src (ss,_,_) _ss2 _) = [(\"tp\",[conv (noLoc ss)])]\n     doHsExpr _ = []\n\n     conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs)\n\nshowAnns anns = \"[\\n\" ++ (intercalate \"\\n\"\n   $ map (\\((s,k),v)\n              -> (\"(AK \" ++ pp s ++ \" \" ++ show k ++\" = \" ++ pp v ++ \")\\n\"))\n   $ Map.toList anns)\n    ++ \"]\\n\"\n\npp a = showPpr unsafeGlobalDynFlags a\n\n-- ---------------------------------------------------------------------\n\n-- Copied from syb for the test\n\n\n-- | Generic queries of type \\\"r\\\",\n--   i.e., take any \\\"a\\\" and return an \\\"r\\\"\n--\ntype GenericQ r = forall a. Data a => a -> r\n\n\n-- | Make a generic query;\n--   start from a type-specific case;\n--   return a constant otherwise\n--\nmkQ :: ( Typeable a\n       , Typeable b\n       )\n    => r\n    -> (b -> r)\n    -> a\n    -> r\n(r `mkQ` br) a = case cast a of\n                        Just b  -> br b\n                        Nothing -> r\n\n-- | Extend a generic query by a type-specific case\nextQ :: ( Typeable a\n        , Typeable b\n        )\n     => (a -> q)\n     -> (b -> q)\n     -> a\n     -> q\nextQ f g a = maybe (f a) g (cast a)\n\n\n-- | Summarise all nodes in top-down, left-to-right order\neverything :: (r -> r -> r) -> GenericQ r -> GenericQ r\n\n-- Apply f to x to summarise top-level node;\n-- use gmapQ to recurse into immediate subterms;\n-- use ordinary foldl to reduce list of intermediate results\n\neverything k f x = foldl k (f x) (gmapQ (everything k f) x)\n", "num_lines": 143}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\n-- import Data.Generics\nimport Data.Data hiding (Fixity)\nimport Data.List\nimport System.IO\nimport GHC\nimport BasicTypes\nimport DynFlags\nimport FastString\nimport ForeignCall\nimport MonadUtils\nimport Outputable\nimport HsDecls\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir,fileName] <- getArgs\n        testOneFile libdir fileName\n\ntestOneFile libdir fileName = do\n       ((anns,cs),p) <- runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        setSessionDynFlags dflags\n                        let mn =mkModuleName fileName\n                        addTarget Target { targetId = TargetModule mn\n                                         , targetAllowObjCode = True\n                                         , targetContents = Nothing }\n                        load LoadAllTargets\n                        modSum <- getModSummary mn\n                        p <- parseModule modSum\n                        return (pm_annotations p,p)\n\n       let tupArgs = gq (pm_parsed_source p)\n\n       putStrLn (intercalate \"\\n\" $ map show tupArgs)\n       -- putStrLn (pp tupArgs)\n       -- putStrLn (intercalate \"\\n\" [showAnns anns])\n\n    where\n     gq ast = everything (++) ([] `mkQ` doFixity\n                               `extQ` doRuleDecl\n                               `extQ` doHsExpr\n                               `extQ` doInline\n                              ) ast\n\n     doFixity :: Fixity -> [(String,[String])]\n     doFixity (Fixity (SourceText ss) _ _) = [(\"f\",[ss])]\n\n     doRuleDecl :: RuleDecl GhcPs\n                -> [(String,[String])]\n     doRuleDecl (HsRule _ _ (ActiveBefore (SourceText ss) _) _ _ _ _)\n       = [(\"rb\",[ss])]\n     doRuleDecl (HsRule _ _ (ActiveAfter (SourceText ss) _) _ _ _ _)\n       = [(\"ra\",[ss])]\n     doRuleDecl (HsRule _ _ _ _ _ _ _) = []\n\n     doHsExpr :: HsExpr GhcPs -> [(String,[String])]\n     doHsExpr (HsTickPragma _ src (_,_,_) ss _) = [(\"tp\",[show ss])]\n     doHsExpr _ = []\n\n     doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _)\n         = [(\"ib\",[ss])]\n     doInline (InlinePragma _ _ _ (ActiveAfter (SourceText ss) _) _)\n         = [(\"ia\",[ss])]\n     doInline (InlinePragma _ _ _ _ _ ) = []\n\nshowAnns anns = \"[\\n\" ++ (intercalate \"\\n\"\n   $ map (\\((s,k),v)\n              -> (\"(AK \" ++ pp s ++ \" \" ++ show k ++\" = \" ++ pp v ++ \")\\n\"))\n   $ Map.toList anns)\n    ++ \"]\\n\"\n\npp a = showPpr unsafeGlobalDynFlags a\n\n-- ---------------------------------------------------------------------\n\n-- Copied from syb for the test\n\n\n-- | Generic queries of type \\\"r\\\",\n--   i.e., take any \\\"a\\\" and return an \\\"r\\\"\n--\ntype GenericQ r = forall a. Data a => a -> r\n\n\n-- | Make a generic query;\n--   start from a type-specific case;\n--   return a constant otherwise\n--\nmkQ :: ( Typeable a\n       , Typeable b\n       )\n    => r\n    -> (b -> r)\n    -> a\n    -> r\n(r `mkQ` br) a = case cast a of\n                        Just b  -> br b\n                        Nothing -> r\n\n-- | Extend a generic query by a type-specific case\nextQ :: ( Typeable a\n        , Typeable b\n        )\n     => (a -> q)\n     -> (b -> q)\n     -> a\n     -> q\nextQ f g a = maybe (f a) g (cast a)\n\n\n-- | Summarise all nodes in top-down, left-to-right order\neverything :: (r -> r -> r) -> GenericQ r -> GenericQ r\n\n-- Apply f to x to summarise top-level node;\n-- use gmapQ to recurse into immediate subterms;\n-- use ordinary foldl to reduce list of intermediate results\n\neverything k f x = foldl k (f x) (gmapQ (everything k f) x)\n", "num_lines": 132}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule Test10255 where\n\nimport Data.Maybe\n\nfob (f :: (Maybe t -> Int)) =\n  undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell,TypeOperators,DataKinds #-}\n\nmodule Test10268 where\n\nth = $footemplate\n\ngive :: b -> Pattern '[b] a\ngive = undefined\n\npfail :: Pattern '[] a\npfail = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test10269 where\n\n\n(f =*= g) sa i = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule Test10276 where\n\nf1 = [| bar |]\nf2 = [e| bar |]\n\nclass QQExp a b where\n  qqExp x = [||fst $ runState $$(qqExpM x)\n                        ((0,M.empty) :: (Int,M.Map L.Name [L.Operand]))||]\n\nclass QQExp2 a b where\n  qqExp x = [e||fst $ runState $$(qqExpM x)\n                        ((0,M.empty) :: (Int,M.Map L.Name [L.Operand]))||]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables,GADTs #-}\nmodule Test10278 where\n\nextremumNewton :: forall tag. forall tag1. tag -> tag1 -> Int\nextremumNewton = undefined\n\nextremumNewton1 :: (Eq a, Fractional a) =>\n                  (forall tag. forall tag1.\n                          Tower tag1 (Tower tag a)\n                              -> Tower tag1 (Tower tag a))\n                      -> a -> [a]\nextremumNewton1 f x0 = zeroNewton (diffUU f) x0\n\ndata MaybeDefault v where\n    SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v\n    SetTo2:: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v\n    SetTo3 :: (Eq a) => forall v . ( Eq v, Show v ) => !v -> a -> MaybeDefault v\n    {-\n    SetTo4 :: forall v . (( Eq v, Show v ) => v -> MaybeDefault v -> a -> [a])\n    -}\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections #-}\nmodule Test10280 where\n\nfoo2 = atomicModifyIORef ciTokens ((,()) . f)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Test10307 where\n\nclass Foldable t where\n  type FoldableConstraint t x :: *\n  type FoldableConstraint t x = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule Test10309 where\n\ndata H1 a b where\n  C3 :: (Num a) => { field :: a -- ^ hello docs\n                   } -> H1 Int Int\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ParallelListComp,\n             TransformListComp,\n             RecordWildCards #-}\nmodule Test10312 where\n-- From\n-- https://ocharles.org.uk/blog/guest-posts/2014-12-07-list-comprehensions.html\n\nimport GHC.Exts\nimport qualified Data.Map as M\nimport Data.Ord (comparing)\nimport Data.List (sortBy)\n\n-- Let\u00e2\u20ac\u2122s look at a simple, normal list comprehension to start:\n\nregularListComp :: [Int]\nregularListComp = [ x + y * z\n                  | x <- [0..10]\n                  , y <- [10..20]\n                  , z <- [20..30]\n                  ]\n\nparallelListComp :: [Int]\nparallelListComp = [ x + y * z\n                   | x <- [0..10]\n                   | y <- [10..20]\n                   | z <- [20..30]\n                   ]\n\n-- fibs :: [Int]\n-- fibs = 0 : 1 : zipWith (+) fibs (tail fibs)\n\nfibs :: [Int]\nfibs = 0 : 1 : [ x + y\n               | x <- fibs\n               | y <- tail fibs\n               ]\n\nfiblikes :: [Int]\nfiblikes = 0 : 1 : [ x + y + z\n                   | x <- fibs\n                   | y <- tail fibs\n                   | z <- tail (tail fibs)\n                   ]\n\n-- TransformListComp\ndata Character = Character\n  { firstName :: String\n  , lastName :: String\n  , birthYear :: Int\n  } deriving (Show, Eq)\n\nfriends :: [Character]\nfriends = [ Character \"Phoebe\" \"Buffay\" 1963\n          , Character \"Chandler\" \"Bing\" 1969\n          , Character \"Rachel\" \"Green\" 1969\n          , Character \"Joey\" \"Tribbiani\" 1967\n          , Character \"Monica\" \"Geller\" 1964\n          , Character \"Ross\" \"Geller\" 1966\n          ]\n\noldest :: Int -> [Character] -> [String]\noldest k tbl = [ firstName ++ \" \" ++ lastName\n               | Character{..} <- tbl\n               , then sortWith by birthYear\n               , then take k\n               ]\n\ngroupByLargest :: Ord b => (a -> b) -> [a] -> [[a]]\ngroupByLargest f = sortBy (comparing (negate . length)) . groupWith f\n\nbestBirthYears :: [Character] -> [(Int, [String])]\nbestBirthYears tbl = [ (the birthYear, firstName)\n                     | Character{..} <- tbl\n                     , then group by birthYear using groupByLargest\n                     ]\n\nuniq_fs = [ (n, the p, the d') | (n, Fixity p d) <- fs\n                                   , let d' = ppDir d\n                                   , then group by Down (p,d') using groupWith ]\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PackageImports #-}\n{-# LANGUAGE MagicHash, UnliftedFFITypes #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Test10313 where\n\nimport \"b\\x61se\" Data.List\n\n{-# WARNING Logic\n          , solverCheckAndGetModel\n          \"New Z3 API support is still incomplete and fragile: \\\n          \\you may experience segmentation faults!\"\n  #-}\n\n{-# Deprecated Logic\n          , solverCheckAndGetModel\n          \"Deprecation: \\\n          \\you may experience segmentation faults!\"\n  #-}\n\ndata {-# Ctype \"foo\\x63\" \"b\\x61r\" #-} Logic = Logic\n\n-- Should warn\nfoo1 x = x\n{-# RULES \"foo1\\x67\" [ 1] forall x. foo1 x = x #-}\n\nforeign import prim unsafe \"a\\x62\" a :: IO Int\n\n{-# INLINE strictStream #-}\nstrictStream (Bitstream l v)\n    = {-# CORE \"Strict Bitstream stre\\x61m\" #-}\n      S.concatMap stream (GV.stream v)\n      `S.sized`\n      Exact l\n\nb = {-# SCC \"foo\\x64\"   #-} 006\n\nc = {-# GENERATED \"foob\\x61r\" 1 : 2  -  3 :   4 #-} 0.00\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule Test10354 where\n\nf :: ((Eq a, _)) => a -> a -> Bool\nf x y = x == y\n\nbar :: (   ) => a-> Bool\nbar = undefined\n\nbaz :: _ => a -> String\nbaz = undefined\n\nfoo :: ForceError\nfoo = undefined\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ParallelListComp #-}\nmodule Test10357 where\n\nlegendres = one : x :\n    [ multPoly\n        (poly LE [recip (n' + 1)])\n        (addPoly (poly LE [0, 2 * n' + 1] `multPoly` p_n)\n                 (poly LE           [-n'] `multPoly` p_nm1)\n        )\n    | n     <- [1..], let n' = fromInteger n\n    | p_n   <- tail legendres\n    | p_nm1 <- legendres\n    ]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Test10358 where\n\nmtGamma x v d =\n  let !x_2 = x*x; !x_4 = x_2*x_2\n      v3 = v*v*v\n      dv = d * v3\n  in 5\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule Test10396 where\n\nerrors :: IO ()\nerrors= do\n  let ls :: Int = undefined\n  return ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\nmodule Test10399 where\n\ntype MPI = ?mpi_secret :: MPISecret\n\nmkPoli = mkBila . map ((,,(),,()) <$> P.base <*> P.pos <*> P.form)\n\ndata MaybeDefault v where\n    SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v\n    SetTo4 :: forall v a. (( Eq v, Show v ) => v -> MaybeDefault v\n                                            -> a -> MaybeDefault [a])\n    TestParens :: (forall v . (Eq v) -> MaybeDefault v)\n\n[t| Map.Map T.Text $tc |]\n\nbar $( [p| x |] ) = x\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule Test10598 where\n\nclass C a where\n  c :: proxy a -> Int\n  c _ = 42\n\ninstance C Int where\n  c _ = 27\n\nnewtype Foo = MkFoo Int\n  deriving          Eq\n  deriving stock    Ord\n  deriving anyclass C\nderiving newtype instance Show Foo\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators\n           , DataKinds\n           , PolyKinds\n           , TypeFamilies\n           , GADTs\n           , UndecidableInstances\n           , RankNTypes\n           , ScopedTypeVariables\n  #-}\nmodule Test11321 where\n\ndata instance Sing (z :: [a])\n  = z ~ '[] =>\n    SNil\n  | forall (m :: a)\n           (n :: [a]). z ~ (:) m n =>\n    SCons (Sing m) (Sing n)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule Test11332 ( A(.., NoA), Q(F,..), G(T,..,U)) where\n\ndata A = A | B\n\npattern NoA = B\n\ndata Q a = Q a\n\npattern F a = Q a\n\ndata G = G | H\n\npattern T = G\n\npattern U = H\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test11430 where\n\n\ninfixl 0x1 `f`\n\nx `f` y = x\n\n\n{-# SPECIALISE [~ 001] x ::\n        Integer -> Integer -> Integer,\n        Integer -> Int -> Integer,\n        Int -> Int -> Int #-}\n{-# INLINABLE [1] x #-}\nx :: (Num a, Integral b) => a -> b -> a\nx = undefined\n\n{-# SPECIALISE INLINE [0x999] y ::\n        Integer -> Integer -> Integer,\n        Integer -> Int -> Integer,\n        Int -> Int -> Int #-}\n{-# INLINABLE [1] y #-}\ny :: (Num a, Integral b) => a -> b -> a\ny = undefined\n\nc = {-# GENERATED \"foob\\x61r\" 0x1 : 0x2  -  0x3 :   0x4 #-} 0.00\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash #-}\n\nmodule Test12417 where\n\nimport GHC.Prim\nimport GHC.Types\n\nimport System.Mem (performMajorGC)\n\ntype Either1 a b = (# a | b #)\n\nshowEither1 :: (Show a, Show b) => Either1 a b -> String\nshowEither1 (# left | #)  = \"Left \" ++ show left\nshowEither1 (# | right #) = \"Right \" ++ show right\n\ntype T = (# Int | Bool | String | Char | Either Int Bool | Int# | Float# #)\n\nshowEither4 :: T -> String\nshowEither4 (# | b | | | | | #) = \"Alt1: \" ++ show b\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ExplicitNamespaces #-}\nmodule T13163\n  ( Record(..)\n  , type (?)(..)\n  , f, type (+), pattern Single\n  ) where\n\nimport Data.Promotion.Prelude (type (:+$), type (:*$), type (:^$), type (:-$))\nimport Options.Generic (Generic, ParseRecord, type (<?>)(..))\nimport GHC.TypeLits\n\npattern Single x = [x]\n\nf = undefined\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds              #-}\n{-# LANGUAGE TypeOperators          #-}\n\n(~#) :: Comonad w => CascadeW w (t ': ts) -> w t -> Last (t ': ts)\n(~#) = cascadeW\ninfixr 0 ~#\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test16212 where\n\nclass LiftingMonad  (trans :: MTrans) where\n  proof :: Monad m :- Monad (trans m)\n\nclass LiftingMonad2  ((trans :: MTrans)) where\n  proof :: Monad m :- Monad (trans m)\n\ndata Nat (t :: NatKind) where\n    ZeroNat :: Nat Zero\n    SuccNat :: Nat t -> Nat (Succ t)\n\ndata Foo (a) b = Foo { av :: a, bv :: b }\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE DataKinds #-}\nmodule MoreExplicitForalls where\n\nimport Data.Proxy\n\ndata family F1 a\ndata instance forall (x :: Bool). F1 (Proxy x) = MkF\n\nclass C a where\n  type F2 a b\n\ninstance forall a. C [a] where\n  type forall b. F2 [a] b = Int\n\n\ntype family G a b where\n  forall x y. G [x] (Proxy y) = Double\n  forall z.   G z   z         = Bool\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies\n             , TypeApplications, TypeInType #-}\n\nmodule DumpParsedAst where\nimport Data.Kind\n\ndata Peano = Zero | Succ Peano\n\ntype family Length (as :: [k]) :: Peano where\n  Length (a : as) = Succ (Length as)\n  Length '[]      = Zero\n\n-- vis kind app\ndata T f (a :: k) = MkT (f a)\n\ntype family F1 (a :: k) (f :: k -> Type) :: Type where\n  F1 @Peano a f = T @Peano f a\n\ndata family DF3 (a :: k)\ndata instance DF3 @(K.Type -> K.Type) b = DF3Char\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AlternativeLayoutRule #-}\n{-# LANGUAGE LambdaCase            #-}\n-- duplicate of T13087.hs\n\nisOne :: Int -> Bool\nisOne = \\case 1 -> True\n              _ -> False\n\nmain = return ()\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TestBoolFormula where\n\nclass ManyOps a where\n    aOp :: a -> a -> Bool\n    aOp = undefined\n    bOp :: a -> a -> Bool\n    bOp = undefined\n    cOp :: a -> a -> Bool\n    cOp = undefined\n    dOp :: a -> a -> Bool\n    dOp = undefined\n    eOp :: a -> a -> Bool\n    eOp = undefined\n    fOp :: a -> a -> Bool\n    fOp = undefined\n    {-# MINIMAL  ( aOp)\n               | ( bOp   , cOp)\n               | ((dOp  |  eOp) , fOp)\n      #-}\n\nclass Foo a where\n    bar :: a -> a -> Bool\n    foo :: a -> a -> Bool\n    baq :: a -> a -> Bool\n    baq = undefined\n    baz :: a -> a -> Bool\n    baz = undefined\n    quux :: a -> a -> Bool\n    quux = undefined\n    {-# MINIMAL bar, (foo, baq | foo, quux) #-}\n\ninstance Foo Int where\n    bar = undefined\n    baz = undefined\n    quux = undefined\n    foo = undefined\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\n-- import Data.Generics\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir] <- getArgs\n        testOneFile libdir \"LiteralsTest\"\n\ntestOneFile libdir fileName = do\n    t <- runGhc (Just libdir) $ do\n        dflags <- getSessionDynFlags\n        setSessionDynFlags dflags\n        let mn =mkModuleName fileName\n        addTarget Target { targetId = TargetModule mn\n                         , targetAllowObjCode = True\n                         , targetContents = Nothing }\n        load LoadAllTargets\n        modSum <- getModSummary mn\n        toks <- getRichTokenStream (ms_mod modSum)\n        return toks\n\n    putStrLn (intercalate \"\\n\" [showToks t])\n\nshowToks ts = intercalate \",\\n\\n\"\n            $ map (\\((L p t),s) ->\n                         \"(\" ++ pp p ++ \",\" ++ show t ++ \",[\" ++ s ++ \"])\") ts\n\npp a = showPpr unsafeGlobalDynFlags a\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule LiteralsTest where\n\nx,y :: Int\nx = 0003\ny = 0x04\n\ns :: String\ns = \"\\x20\"\n\nc :: Char\nc = '\\x20'\n\nd :: Double\nd = 0.00\n\nblah = x\n  where\n    charH = '\\x41'#\n    intH = 0004#\n    wordH = 005##\n    floatH = 3.20#\n    doubleH = 04.16##\n    x = 1\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule LiteralsTest2 where\n\nx,y :: Int\nx = 0003\ny = 0x04\n\ns :: String\ns = \"\\x20\"\n\nc :: Char\nc = '\\x20'\n\nd :: Double\nd = 0.00\n\nblah = x\n  where\n    charH = '\\x41'#\n    intH = 0004#\n    wordH = 005##\n    floatH = 3.20#\n    doubleH = 04.16##\n    x = 1\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\nimport BasicTypes\nimport Data.Data\nimport Data.List\nimport System.IO\nimport GHC\nimport DynFlags\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\nimport qualified Data.Map as Map\nimport Data.Dynamic ( fromDynamic,Dynamic )\n\nmain::IO()\nmain = do\n        [libdir] <- getArgs\n        testOneFile libdir \"LiteralsTest2\"\n\ntestOneFile libdir fileName = do\n    p <- runGhc (Just libdir) $ do\n        dflags <- getSessionDynFlags\n        setSessionDynFlags dflags\n        let mn =mkModuleName fileName\n        addTarget Target { targetId = TargetModule mn\n                         , targetAllowObjCode = True\n                         , targetContents = Nothing }\n        load LoadAllTargets\n        modSum <- getModSummary mn\n        p <- GHC.parseModule modSum\n        return p\n\n    let res = gq (pm_parsed_source p)\n    putStrLn (intercalate \"\\n\" res)\n\n    where\n     gq ast = everything (++) ([] `mkQ` doHsLit `extQ` doOverLit) ast\n\n     doHsLit :: HsLit GhcPs -> [String]\n     doHsLit (HsChar       (SourceText src) c)\n       = [\"HsChar [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsCharPrim   (SourceText src) c)\n       = [\"HsCharPrim [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsString     (SourceText src) c)\n       = [\"HsString [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsStringPrim (SourceText src) c)\n       = [\"HsStringPrim [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsInt  _     (IL (SourceText src) _ c))\n       = [\"HsInt [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsIntPrim (SourceText src) c)\n       = [\"HsIntPrim [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsWordPrim   (SourceText src) c)\n       = [\"HsWordPrim [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsInt64Prim  (SourceText src) c)\n       = [\"HsInt64Prim [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsWord64Prim (SourceText src) c)\n       = [\"HsWord64Prim [\" ++ src ++ \"] \" ++ show c]\n     doHsLit (HsInteger  (SourceText src) c _)\n       = [\"HsInteger [\" ++ src ++ \"] \" ++ show c]\n     doHsLit _ = []\n\n     doOverLit :: OverLitVal -> [String]\n     doOverLit (HsIntegral  (IL (SourceText src) _ c))\n       = [\"HsIntegral [\" ++ src ++ \"] \" ++ show c]\n     doOverLit (HsIsString  (SourceText src) c)\n       = [\"HsIsString [\" ++ src ++ \"] \" ++ show c]\n     doOverLit _ = []\n\npp a = showPpr unsafeGlobalDynFlags a\n\n-- ---------------------------------------------------------------------\n\n-- Copied from syb for the test\n\n\n-- | Generic queries of type \\\"r\\\",\n--   i.e., take any \\\"a\\\" and return an \\\"r\\\"\n--\ntype GenericQ r = forall a. Data a => a -> r\n\n\n-- | Make a generic query;\n--   start from a type-specific case;\n--   return a constant otherwise\n--\nmkQ :: ( Typeable a\n       , Typeable b\n       )\n    => r\n    -> (b -> r)\n    -> a\n    -> r\n(r `mkQ` br) a = case cast a of\n                        Just b  -> br b\n                        Nothing -> r\n\n-- | Extend a generic query by a type-specific case\nextQ :: ( Typeable a\n        , Typeable b\n        )\n     => (a -> q)\n     -> (b -> q)\n     -> a\n     -> q\nextQ f g a = maybe (f a) g (cast a)\n\n\n\n-- | Summarise all nodes in top-down, left-to-right order\neverything :: (r -> r -> r) -> GenericQ r -> GenericQ r\n\n-- Apply f to x to summarise top-level node;\n-- use gmapQ to recurse into immediate subterms;\n-- use ordinary foldl to reduce list of intermediate results\n\neverything k f x = foldl k (f x) (gmapQ (everything k f) x)\n", "num_lines": 122}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule A where\n\nimport B\nimport System.IO\n\nmain = do\n    print answer_to_live_the_universe_and_everything\n    hFlush stdout\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule B where\n\nanswer_to_live_the_universe_and_everything =\n    length [1..23*2] - 4", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- 1. Load a set of modules with \"nothing\" target\n-- 2. Load it again with \"interpreted\" target\n-- 3. Execute some code\n--    a. If the recompilation checker is buggy this will die due to missing\n--       code\n--    b. If it's correct, it will recompile because the target has changed.\n--\n-- This program must be called with GHC's libdir as the single command line\n-- argument.\nmodule Main where\n\nimport GHC\nimport DynFlags\nimport MonadUtils ( MonadIO(..) )\nimport BasicTypes ( failed )\nimport Bag        ( bagToList )\nimport System.Environment\nimport Control.Monad\nimport System.IO\n\nmain = do\n  libdir : args <- getArgs\n  runGhc (Just libdir) $ do\n    dflags0 <- getSessionDynFlags\n    (dflags, _, _) <- parseDynamicFlags dflags0\n      (map (mkGeneralLocated \"on the commandline\") args)\n    setSessionDynFlags $ dflags { hscTarget = HscNothing\n                                , ghcLink  = LinkInMemory\n                                , verbosity = 0 -- silence please\n                                }\n    root_mod <- guessTarget \"A.hs\" Nothing\n    setTargets [root_mod]\n    ok <- load LoadAllTargets\n    when (failed ok) $ error \"Couldn't load A.hs in nothing mode\"\n    prn \"target nothing: ok\"\n\n    dflags <- getSessionDynFlags\n    setSessionDynFlags $ dflags { hscTarget = HscInterpreted }\n    ok <- load LoadAllTargets\n    when (failed ok) $ error \"Couldn't load A.hs in interpreted mode\"\n    prn \"target interpreted: ok\"\n\n    -- set context to module \"A\"\n    mg <- getModuleGraph\n    let [mod] = [ ms_mod_name m\n                | m <- mgModSummaries mg\n                , moduleNameString (ms_mod_name m) == \"A\" ]\n    setContext [IIModule mod]\n    liftIO $ hFlush stdout  -- make sure things above are printed before\n                            -- interactive output\n    r <- execStmt \"main\" execOptions\n    case r of\n      ExecComplete { execResult = Right _ } -> prn \"ok\"\n      ExecComplete { execResult = Left _ } -> prn \"exception\"\n      ExecBreak{} -> prn \"breakpoint\"\n    liftIO $ hFlush stdout\n    return ()\n\nprn :: MonadIO m => String -> m ()\nprn = liftIO . putStrLn\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport GHC\nimport MonadUtils\n\nimport System.Environment\n\nmain :: IO ()\nmain = do [libdir] <- getArgs\n          runGhc (Just libdir) doit\n\ndoit :: Ghc ()\ndoit = do\n  getSessionDynFlags >>= setSessionDynFlags\n  dyn <- dynCompileExpr \"()\"\n  liftIO $ print dyn\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Data\nimport System.IO\nimport GHC\nimport FastString\nimport SrcLoc\nimport MonadUtils\nimport Outputable\nimport Bag (filterBag,isEmptyBag)\nimport System.Directory (removeFile)\nimport System.Environment( getArgs )\n\nmain::IO()\nmain = do\n  let\n    loc1 = mkSrcLoc (mkFastString \"filename\") 1 3\n    loc2 = mkSrcLoc (mkFastString \"filename\") 1 5\n    loc3 = mkSrcLoc (mkFastString \"filename\") 10 1\n    badLoc = mkGeneralSrcLoc (mkFastString \"bad loc\")\n\n    pointSpan = mkSrcSpan loc1 loc1\n    lineSpan  = mkSrcSpan loc1 loc2\n    multiSpan = mkSrcSpan loc2 loc3\n    badSpan  = mkGeneralSrcSpan (mkFastString \"bad span\")\n\n  print $ show loc1\n  print $ show loc2\n  print $ show badLoc\n  print $ show pointSpan\n  print $ show lineSpan\n  print $ show multiSpan\n  print $ show badSpan\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = let (x :: String) = \"hello\" in putStrLn x\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Main where\n\nimport System.Environment\nimport GHC\n\nmain :: IO ()\nmain = do\n    flags <- getArgs\n    runGhc' flags $ do\n      setTargets [Target (TargetFile \"T10052-input.hs\" Nothing) True Nothing]\n      _success <- load LoadAllTargets\n      return ()\n\nrunGhc' :: [String] -> Ghc a -> IO a\nrunGhc' args act = do\n    let libdir = head args\n        flags  = map noLoc (tail args)\n    runGhc (Just libdir) $ do\n      dflags0 <- getSessionDynFlags\n      (dflags1, _leftover, _warns) <- parseDynamicFlags dflags0 flags\n      let dflags2 = dflags1 {\n              hscTarget = HscInterpreted\n            , ghcLink   = LinkInMemory\n            , verbosity = 1\n            }\n      _newPkgs <- setSessionDynFlags dflags2\n      act\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Main where\n\nimport ByteCodeLink\nimport CoreMonad\nimport Data.Array\nimport DataCon\nimport GHC\nimport GHC.Exts.Heap\nimport HscTypes\nimport Linker\nimport RtClosureInspect\nimport TcEnv\nimport Type\nimport TcRnMonad\nimport TcType\nimport Control.Applicative\nimport Name (getOccString)\nimport Unsafe.Coerce\nimport Control.Monad\nimport Data.Maybe\nimport Bag\nimport Outputable\nimport GhcMonad\nimport X\n\nimport System.Environment\n\nmain :: IO ()\nmain = do [libdir] <- getArgs\n          runGhc (Just libdir) doit\n\ndoit :: Ghc ()\ndoit = do\n  dflags' <- getSessionDynFlags\n  primPackages <- setSessionDynFlags dflags'\n  dflags <- getSessionDynFlags\n  target <- guessTarget \"X.hs\" Nothing\n  setTargets [target]\n  load LoadAllTargets\n\n  () <- chaseConstructor (unsafeCoerce False)\n  () <- chaseConstructor (unsafeCoerce [1,2,3])\n  () <- chaseConstructor (unsafeCoerce (3 :-> 2))\n  () <- chaseConstructor (unsafeCoerce (4 :->. 4))\n  () <- chaseConstructor (unsafeCoerce (4 :->.+ 4))\n  return ()\n\nchaseConstructor :: (GhcMonad m) => HValue -> m ()\nchaseConstructor !hv = do\n  dflags <- getDynFlags\n  liftIO $ putStrLn \"=====\"\n  closure <- liftIO $ getClosureData hv\n  case closure of\n    IndClosure{indirectee=ind} ->\n      (\\(Box a) -> chaseConstructor (unsafeCoerce a)) ind\n    ConstrClosure{} -> do\n      withSession $ \\hscEnv -> liftIO $ do\n        eDcname <- constrClosToName hscEnv closure\n        case eDcname of\n          Left _       -> return ()\n          Right dcName -> do\n            putStrLn $ \"Name: \"      ++ showPpr dflags dcName\n            putStrLn $ \"OccString: \" ++ \"'\" ++ getOccString dcName ++ \"'\"\n            dc <- ioLookupDataCon hscEnv dcName\n            putStrLn $ \"DataCon: \"   ++ showPpr dflags dc\n    _ -> return ()\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module X where\n\ndata X =  Int :-> Int\n       |  Int :->. Int\n       |  Int :->.+ Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport B\n\nmain :: IO ()\nmain = B.b >> 42\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nb :: IO ()\nb = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\nmodule Main (main) where\n\nimport Data.List ((\\\\))\nimport Control.Monad (void)\nimport System.Environment\n\nimport GHC\nimport qualified Config as GHC\nimport qualified Outputable as GHC\nimport GhcMonad (liftIO)\nimport Outputable (PprStyle, queryQual)\n\ncompileInGhc :: [FilePath]          -- ^ Targets\n             -> (String -> IO ())   -- ^ handler for each SevOutput message\n             -> Ghc ()\ncompileInGhc targets handlerOutput = do\n    -- Set flags\n    flags0 <- getSessionDynFlags\n    let flags = flags0 {verbosity = 1, log_action = collectSrcError handlerOutput}\n    setSessionDynFlags flags\n    -- Set up targets.\n    oldTargets <- getTargets\n    let oldFiles = map fileFromTarget oldTargets\n    mapM_ addSingle (targets \\\\ oldFiles)\n    mapM_ (removeTarget . targetIdFromFile) $ oldFiles \\\\ targets\n    -- Load modules to typecheck\n    void $ load LoadAllTargets\n  where\n    targetIdFromFile file = TargetFile file Nothing\n\n    addSingle filename =\n      addTarget Target\n        { targetId           = targetIdFromFile filename\n        , targetAllowObjCode = True\n        , targetContents     = Nothing\n        }\n\n    fileFromTarget Target{targetId} =\n      case targetId of\n        TargetFile file Nothing -> file\n        _ -> error \"fileFromTarget: not a known target\"\n\n    collectSrcError handlerOutput flags _ SevOutput _srcspan style msg\n      = handlerOutput $ GHC.showSDocForUser flags (queryQual style) msg\n    collectSrcError _ _ _ _ _ _ _\n      = return ()\n\nmain :: IO ()\nmain = do\n  [libdir] <- getArgs\n  runGhc (Just libdir) $ do\n\n  liftIO $ putStrLn \"----- 0 ------\"\n  compileInGhc [\"A.hs\", \"B.hs\"] $ \\msg -> print (0 :: Int, msg)\n\n  liftIO $ putStrLn \"----- 1 ------\"\n  compileInGhc [\"A.hs\", \"B.hs\"] $ \\msg -> print (1 :: Int, msg)\n\n  liftIO $ putStrLn \"----- 2 ------\"\n  compileInGhc [\"C.hs\"] $ \\msg -> print (2 :: Int, msg)\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = putStrLn \"This is main\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport System.Environment\nimport System.IO\n\nmain :: IO ()\nmain = error \"main got called\"\n\nfoo :: IO ()\nfoo = do putStrLn \"This is foo\"\n         getArgs >>= print\n         hFlush stdout\n         error \"foo\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO\nmain = do\n  hGetBuffering stdin >>= print\n  hGetBuffering stdout >>= print\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import MissingModule\nmain = print \"main\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport System.Exit\nimport System.IO\n\nmain :: IO ()\nmain = do putStrLn \"Q1\"\n          exitFailure\n          putStrLn \"Q2\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = return \"this should not be printed\"\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Used to present a consistent shell view for :! commands in GHCi\n-- scripts.  We're assuming that sh is in the path and that it\n-- is a Bourne-compatible shell.\n\nimport System.Exit\nimport System.Process (rawSystem)\n\nshell :: String -> IO ExitCode\nshell s = rawSystem \"sh\" [\"-c\", s]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = return ()\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15729 (main) where\n\nimport Foreign\nimport Foreign.C\n\nforeign import ccall unsafe \"readBss\"\n  readBss :: Int -> IO Int\n\nmain :: IO ()\nmain = do\n  prefix <- mapM readBss [0 .. 10]\n  print prefix\n  samples <- mapM readBss [0, 19 .. bit 20 - 1]\n  print $ foldr1 (.|.) samples\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module WeakTest where\n\nimport Foreign.C.Types\n\nforeign import ccall weak_test :: CInt -> IO CInt\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TestLink where\n\nimport Foreign.C\n\nforeign import ccall \"f\" f :: CInt -> IO CInt\n\ntest :: IO ()\ntest = f 42 >>= print\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "foreign import ccall \"foo\" c_foo :: IO Int\n\nmain = c_foo >>= print\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10458 (callSO) where\n\nimport Foreign\nimport Foreign.C.Types\nforeign import ccall \"foo\" dle :: IO CInt\n\ncallSO :: IO CInt\ncallSO = dle\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Foreign\nimport Foreign.C.Types\nforeign import ccall \"bar\" dle :: IO CInt\n\nmain = dle >>= print\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Foreign\nimport Foreign.C.Types\nforeign import ccall \"foo\" dle :: IO CInt\n\nmain = dle >>= print\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport B\n\nmain = print (\"hello world\" ++ show (f 42))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B (module B, module C) where\n\nimport C \n\nk x = x `mod` 11\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C (f, g, h) where\n\nimport D\n \ng x = f x + 1\n\nh x = x `div` 2\n\ndata C = C {x :: Int}\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D where\n\ndata T = A Int | B Float deriving Eq\n\nf x = x + x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D where\n\ndata T = A Int | B Float deriving Eq\n\nf x = x + 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\ndata T = A Int | B Float deriving Eq\n\nf :: Double -> Double\nf x = x + x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\ndata T = A Int | B Float deriving Eq\n\nf :: Int -> Int\nf x = x + 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B (f, g, h) where\n\nimport A\n \ng x = f x + 1\n\nh x = x `div` 2\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C (module B, module C) where\n\nimport B \n\nk x = x `mod` 11\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport C\n\nmain = print (\"hello world\" ++ show (f 42))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A(main,a) where\n\nimport B\nimport C(c)\n\nmain = print (a 42)\n\na x = b x + c x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport D\n\nb x = d x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\nimport D\n\nc x = d x\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D where\n\n-- data types and an instance\ndata D a = A Int | B Float deriving Eq\nnewtype N a = N Double\ntype T a = (Int,Double)\n\n-- a class\nclass C a where c :: a -> Int\n\n-- a function\nd :: Int -> Int\nd x = x * 2\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D where\n\n-- data types and an instance\ndata D a = A Int | B Float deriving Eq\nnewtype N a = N Double\ntype T a = (Int,Double)\n\n-- a class\nclass C a where c :: a -> Int\n\n-- a function\nd :: Float -> Float\nd x = x / 3\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nx = 1 :: Int\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B (y) where\nimport A\ny = 2 :: Int\nz = 3 :: Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport {-# source #-} Boot\n\nclass Class a where\n  method :: a -> Data -> a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Boot where\n\nimport A\n\ndata Data = forall n. Class n => D n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\nmodule Boot where\n\nimport A\n\ndata Data = forall n. Class n => D n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport {-# SOURCE #-} C\n\nclass Class1 a\n\ndata A = A deriving Show\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport A\n\ndata B = B deriving Show\n\ninstance Class1 B\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\nimport A\nimport B\n\nclass Class1 a => Class2 a\n\ninstance Class2 B\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, MultiParamTypeClasses #-}\n{-# LANGUAGE AllowAmbiguousTypes #-} -- c3 is ambiguous!\n\n-- Tests a bug spotted by Claus in which the type\n-- of c3 was wrongly displayed in GHCi as\n--      c3 :: C a b => a -> b\n-- Should be\n--      c3 :: C a b => a1 -> b\n\nmodule A where\n\nclass C a b where\n  c1 :: Num b => a -> b\n  c2 :: (Num b,Show b) => a -> b\n  c3 :: forall a. a -> b\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport B\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where where\n\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nyan = \"tan\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (f) where\n\nf x = [x]\n\ng x = Just x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bar where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bar where\n\nbar = nonexistent\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nfoo = \"foo\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module FooBar where\n\nimport Foo\nimport Bar\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "a = 1\nb = 2\nbad = '\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "a = 1\nb = 2\nc = 3\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GHCForeignImportPrim, MagicHash,\n             UnliftedFFITypes, UnboxedTuples #-}\n\nimport GHC.Exts\n\nforeign import prim \"dummy\"\n   dummy :: Word# -> Word#\n\nforeign import prim \"dummy2\"\n   dummy2 :: Any -> State# RealWorld -> (# State# RealWorld, Word# #)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Level1 where\n\nl1 = undefined :: ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TopLevel (module Level1, module Level2.Level2) where\n\nimport Level1\nimport Level2.Level2\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Level2.Level2 where\n\nl2 = undefined :: ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Level1 where\n\nlevel1Fun1 :: ()\nlevel1Fun1 = ()\n\nlevel1Fun2 :: ()\nlevel1Fun2 = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TopLevel (module Level1, module Level2.Level2) where\n\nimport Level1\nimport Level2.Level2\n\ntopLevelFun :: ()\ntopLevelFun = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Level2.Level2 where\n\nlevel2Fun1 :: ()\nlevel2Fun1 = ()\n\nlevel2Fun2 :: ()\nlevel2Fun2 = ()\n\nlevel2Fun3 :: ()\nlevel2Fun3 = ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Level1 where\n\n(..--) = undefined :: ()\n(..-+) = undefined :: ()\n(..++) = undefined :: ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Level2.Level2 where\n\n(..+=..) = undefined :: ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wincomplete-patterns -Wunused-matches #-}\nmodule A where\n\nincompletePattern :: Int -> Int\nincompletePattern 0 = 0\n\nunusedMatches :: Int -> Int\nunusedMatches x = 0\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wunused-imports #-}\nmodule B\n  ( module A\n  ) where\n\nimport A\nimport Data.List\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\nimport B\n\nfoo :: ()\nfoo = variableNotInScope\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\na :: Int\na = 'p'\n\nf :: Int\nf = _\n\nmain :: IO ()\nmain = print f\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.List\nmain = print (sort [100,99..1])\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Ghci006 where\n\ndata Q = forall x . Show x => Q x\nshowQ (Q x) = show x\n\n-- associated bug is that at the interpreter command line,\n--   showQ (Q \"foo\") crashed the interpreter.\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Test.QuickCheck.Batch\n\nprop_silly :: [()] -> Bool\nprop_silly xs = head xs == head xs \n\ndo_test = runTests \"test\" defOpt [ run prop_silly ]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Code from ticket #488\n\nmodule Test where \n \nimport Control.Concurrent.STM \nimport Control.Concurrent \nimport Control.Exception \nimport Prelude hiding (catch) \n \n \nrunTest loop = do \n    (tc1, tc2, tmv) <- atomically (do \n        tmv <- newEmptyTMVar \n        tc1 <- newTChan \n        tc2 <- newTChan \n        return (tc1, tc2, tmv) \n        ) \n    myTId <- myThreadId \n    forkIO (forked loop (tc1, tc2, tmv, myTId)) \n    atomically (writeTChan tc1 \"blah\") \n    atomically (writeTChan tc1 \"blah2\") \n    return \"done\" \n \n \nforked loop args@(tc1, tc2, tmv, hisTId) = catch ((loop args) >>= setTMV . Just) hndlr `finally` setTMV Nothing \n        where \n            setTMV x = atomically (tryPutTMVar tmv x >> return ()) \n            hndlr ThreadKilled = return ()\n            hndlr e            = throwTo hisTId e\n \ngoodLoop args@(tc1, tc2, tmv, hisTId) = do \n    x <- atomically (readTChan tc1) \n    x' <- return $ reverse x \n    atomically (writeTChan tc2 x') \n    if x == \"blah2\" \n        then return () \n        else goodLoop args \n \nbadLoop args@(tc1, tc2, tmv, hisTId) = do \n    x <- atomically (readTChan tc1) \n    x' <- return $ reverse x \n    atomically (writeTChan tc2 x') \n    badLoop args\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for trac #552\n\nmodule Test where\n\ndefault (T)\n\ndata T = T\n    deriving (Eq, Show)\n\ninstance Num T where\n    fromInteger _ = T\n    (+)    = error \"urk\"\n    (*)    = error \"urk\"\n    abs    = error \"urk\"\n    signum = error \"urk\"\n    negate = error \"urk\"\n\n-- Typing 3 at the ghci prompt should print T\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #1581\n-- Even though Eq is not in scope unqualified, we want to\n-- see the Eq instance of Foo when we say :i Foo\n\nmodule Foo where\nimport qualified Prelude\n\ndata Foo = Foo\ninstance Prelude.Eq Foo\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module GHCi022 where\n'a' '\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, MultiParamTypeClasses #-}\n{-# LANGUAGE AllowAmbiguousTypes #-} -- c3 is ambiguous!\n\nmodule T where\n\nimport qualified Prelude as T(length,Monad,Integer)\nimport qualified Data.ByteString as T(length)\nimport Prelude(length,(+),(=<<),Monad(..),Maybe(..),Eq)\nimport Data.Maybe\nimport Control.Monad(Monad(..),MonadPlus(..))\n\nlength :: T.Integer\nlength = 0\n\nclass N a\nclass S a\n\nclass C a b where\n  c1 :: N b => a -> b\n  c2 :: (N b,S b) => a -> b\n  c3 :: forall a. a -> b\n  c4 :: a1 -> b\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ghci025B (module Ghci025B, module Ghci025C) where\n\nimport Ghci025C\n\nk x = x `mod` 11\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ghci025C (f, g, h) where\n\nimport Ghci025D\n\ng x = f x + 1\n\nh x = x `div` 2\n\ndata C = C {x :: Int}\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ghci025D where\n\ndata T = A Int | B Float deriving Eq\n\nf x = x + x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for #1617\nmodule T1617 where\nimport Prelude ()\nimport Control.Monad (mplus)\nimport qualified Control.Monad (mplus)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for #1617\nmodule T1617 where\nimport Prelude ()\n--import Control.Monad (mplus)\nimport qualified Control.Monad (mplus)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2082\n-- If we :i D or C, we should see parentheses around (Int -> a)\n\n{-# LANGUAGE ExistentialQuantification #-}\n\nmodule Foo where\n\ndata D = forall a . C (Int -> a) Char\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\n-- Trac #2138\n-- If we :i D, we should see the Eq constraint\n\nmodule Foo where\n\ndata Eq a => D a = C a\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test Trac #1930: display of infix constructors\nmodule Test where\n\ndata Foo = Foo1 Int \n         | Int `InfixCon` Bool", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\nimport Data.List\nx = map\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--Testing flexible and Overlapping instances\nclass C a where { f :: a -> String; f _ = 3 }\ninstance C Int where { f = id }\n:set -XFlexibleInstances\ninstance C [Int] where f _ = \"First\"\nf [3::Int]\n-- Should override the identical one preceding\ninstance C [Int] where f _ = \"Second\"\nf [3::Int]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata T a where\n  C :: T Int\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "two_args :: [String] -> IO String\ntwo_args _ = return \"two_args> \"\n\nthree_args :: [String] -> Int -> IO String\nthree_args _ _ = return $ \"three_args> \"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule GhciKinds where\n\nimport Data.Kind (Type)\n\ntype family F a :: Type\ntype instance F [a] = a -> F a\ntype instance F Int = Bool\n\n-- test \":kind!\" in the presence of compatible overlap\ntype instance F (Maybe a) = Char\ntype instance F (Maybe Int) = Char\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers #-}\n\nmodule StaticPtr where\n\nimport GHC.StaticPtr\n\ntopLevelStatic :: StaticPtr String\ntopLevelStatic = static \"this is a top-level\"\n\nnestedStatic :: (StaticPtr String, Int)\nnestedStatic = (s, 42)\n  where\n    s = static \"nested static\"\n    {-# NOINLINE s #-}\n\ns1 :: StaticPtr Int\ns1 = static 3\n\ns2 :: StaticPtr String\ns2 = static \"hello world\"\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10110A (a) where\nimport Debug.Trace\n{-# NOINLINE a #-}\na :: Int\na = 3\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10110B (b) where\nb :: Int\nb = 5\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10110C (c) where\nimport T10110A (a)\nimport T10110B (b)\nc :: Int\nc = a+b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds      #-}\n{-# LANGUAGE GADTs          #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeOperators  #-}\n\nmodule T10321 where\n\nimport Data.Kind (Type)\nimport GHC.TypeLits\n\ndata Vec :: Nat -> Type -> Type where\n  Nil  :: Vec 0 a\n  (:>) :: a -> Vec n a -> Vec (n + 1) a\n\ninfixr 5 :>\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10322A (a) where\n{-# NOINLINE a #-}\na :: Int\na = 3\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10322B (b) where\nimport T10322A (a)\nb :: Int\nb = a+1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10322C (c) where\nimport T10322A (a)\nimport T10322B (b)\nc :: Int\nc = a+b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10576 where\n\n(\u00e2\u02dc\u20ac\u00e2\u02dc\u20ac) :: () -> () -> ()\n(\u00e2\u02dc\u20ac\u00e2\u02dc\u20ac) _ _ = ()\n\nx1 = undefined :: ()\nx2 = undefined :: ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11208 where\n\nimport qualified Prelude as P\n\nf n = n P.+ 1\n\ng h (P.Just x) = P.Just (h x)\ng _ P.Nothing  = P.Nothing\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n\nmodule T11456 where\n\na = show @Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, PatternSynonyms, GADTs #-}\n\nmodule T11728 where\n\nimport Data.Kind\nimport Data.Int\nimport GHC.TypeLits\nimport Text.Show.Functions\n\ndata Ty ty where\n  I  :: Ty Int\n  A  :: Ty a -> Ty [a]\n\nclass    GetTy ty  where getTy :: Ty ty\ninstance GetTy Int where getTy = I\ninstance GetTy ty => GetTy [ty] where\n  getTy = A getTy\n\ndata E a where\n  UnOp   :: Unary a b -> (E a -> E b)\n\npattern LEN :: () => (GetTy a) => E [a] -> E Int\npattern LEN xs <- UnOp (Un OpLen _) xs where\n        LEN xs = UnOp (Un OpLen length) xs\n\ndata Unary a b where\n  Un :: (GetTy a, GetTy b) => UnOp a b -> (a -> b) -> Unary a b\n\ndata UnOp a b where\n  OpLen :: GetTy a => UnOp [a] Int\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule T12007 where\n\ndata Foo a = Foo a a\n\npattern A a1 a2 = Foo a1 a2\npattern B a1 a2 = A a1 a2\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule Bug ( box, wrap, proxy ) where\n\nimport GHC.Prim\n\nbox :: (# Proxy# a, b #) -> b\nbox (# x, y #) = y\n\nwrap :: b -> Proxy# a -> (# Proxy# a, b #)\nwrap x = \\i# -> (# i#, x #)\n\nproxy :: () -> Proxy# a\nproxy () = proxy#\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Unsafe.Coerce\n\ndata D1 a = C11 a deriving Show\ndata D2 a b = C21 a | C22 b deriving Show\ndata D3 a b c = C31 a | C32 b | C33 c deriving Show\ndata D4 a b c d = C41 a | C42 b | C43 c | C44 d deriving Show\ndata D5 a b c d e = C51 a | C52 b | C53 c | C54 d | C55 e deriving Show\ndata D6 a b c d e f = C61 a | C62 b | C63 c | C64 d | C65 e | C66 f deriving Show\ndata D7 a b c d e f g = C71 a | C72 b | C73 c | C74 d | C75 e | C76 f | C77 g deriving Show\ndata D8 a b c d e f g h = C81 a | C82 b | C83 c | C84 d | C85 e | C86 f | C87 g | C88 h deriving Show\n\nd1 :: (Show a) => p a -> String\nd2 :: (Show a, Show b) => p a b -> String\nd3 :: (Show a, Show b, Show c) => p a b c -> String\nd4 :: (Show a, Show b, Show c, Show d) => p a b c d -> String\nd5 :: (Show a, Show b, Show c, Show d, Show e) => p a b c d e -> String\nd6 :: (Show a, Show b, Show c, Show d, Show e, Show f) => p a b c d e f -> String\nd7 :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => p a b c d e f g -> String\nd8 :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => p a b c d e f g h -> String\n\nd1 = show . (unsafeCoerce :: p a -> D1 a)\nd2 = show . (unsafeCoerce :: p a b -> D2 a b)\nd3 = show . (unsafeCoerce :: p a b c -> D3 a b c)\nd4 = show . (unsafeCoerce :: p a b c d -> D4 a b c d)\nd5 = show . (unsafeCoerce :: p a b c d e -> D5 a b c d e)\nd6 = show . (unsafeCoerce :: p a b c d e f -> D6 a b c d e f)\nd7 = show . (unsafeCoerce :: p a b c d e f g -> D7 a b c d e f g)\nd8 = show . (unsafeCoerce :: p a b c d e f g h -> D8 a b c d e f g h)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T13420 where\n\ntype family F a where\n  F [Int] = Bool\n  F [a]   = Double\n  F (a b) = Char\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13591A where\nimport Second\none :: Int\none = _\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13591B where\nimport {-# SOURCE #-} First\ntwo :: Int\ntwo = one + 1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13699 where\n\ndata Foo = Foo\n  { foo1 :: Int\n  , foo2 :: !Int\n  , foo3 :: Maybe Int\n  , foo4 :: !(Maybe Int)\n  }\n\ndata Bar = Bar Int !Int (Maybe Int) !(Maybe Int)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs #-}\n\nmodule T13988 where\n\nimport Data.Kind\n\ndata Foo (a :: k) where\n  MkFoo :: (k ~ Type) => Foo (a :: k)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule T15325 where\n\nclass PolyList e where\n     polyList :: e -> ()\n\nf :: PolyList e => e -> ()\nf x = polyList x\n\nplh :: ()\nplh = f 0\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15341 where\n\ntype family Foo (a :: k) :: k where\n  Foo a = a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15568 where\n\nimport Data.Proxy\n\ntype family F (a :: j) :: k\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\nmodule Foo where\n\nimport Data.Kind\nimport Data.Proxy\n\ntype family T1 (x :: f (a :: Type))\n\nclass C (a :: Type) where\n  type T2 (x :: f a)\n\nclass C2 (a :: Type) (b :: Proxy a) (c :: Proxy b) where\n  type T3 (x :: Proxy '(a, (c :: Proxy b)))\n     -- NB: we have to put (c :: Proxy b) so that 'b' is Specified\n     --     in the kind of T3; else 'b' is Inferred and comes\n     --     first, which is ill-scoped\n\n-- no CUSK\nclass C3 (a :: Type) (b :: Proxy a) (c :: Proxy b) d where\n  type T4 (x :: Proxy '(a, (c :: Proxy b)))\n     -- Ditto to T3\n\nclass C4 (a :: Type) b where\n  type T5 (x :: f a)\n\nclass C5 a where\n  type T6 (x :: f a)\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies #-}\n\nmodule T15743b where\n\nclass C (a :: k) where\n  type F a (b :: k2)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15827 where\n\nimport Data.Kind\nimport Data.Proxy\n\ntype family F1 (a :: k)\ntype instance forall k (a :: k). F1 a = Proxy a\n\ntype family F2 (a :: k) :: Type where\n  forall k (a :: k). F2 a = Proxy a\n\ndata family D (a :: k)\ndata instance forall k (a :: k). D a = MkD (Proxy a)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16030 where\n\nimport Data.Proxy\n\ndata Foo1 (a :: k) where\n  MkFoo1a :: Proxy a -> Int -> Foo1 a\n  MkFoo1b :: { a :: Proxy a, b :: Int } -> Foo1 a\n\ndata family Foo2 (a :: k)\ndata instance Foo2 (a :: k) where\n  MkFoo2a :: Proxy a -> Int -> Foo2 a\n  MkFoo2b :: { c :: Proxy a, d :: Int } -> Foo2 a\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2182ghci_A where\ndata T = T deriving (Show)\ninstance Show (a -> b) where\n    show _ = \"MyFunction\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2182ghci_B(T(..)) where\nimport T2182ghci_A\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2182ghci_C(T(..)) where\nimport T2182ghci_B\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n\n-- Test Trac #3263\n\nmodule T3263 where\n\nfoo :: IO ()\nfoo = do { getChar\n         ; return () }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test (R(..)) where  \n\ndata R = R { x :: Char, y :: Int, z :: Float }\n       | S { x :: Char }\n       | T { y :: Int, z:: Float }\n       | W\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module X' where\nx = 3\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T4087 where\n\ndata Equal a b where\n     Equal :: Equal a a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ConstraintKinds #-}\nmodule T4175 where\n\nimport Data.Kind\n\ntype family A a b\ntype instance A Int Int = ()\ntype instance A (Maybe a) a = a\ntype instance A (B a) b = ()\n\ndata family B a\ndata instance B () = MkB\n\nclass C a where\n    type D a b\n\ninstance C Int where\n    type D Int () = String\n\ninstance C () where\n    type D () () = Bool\n\ntype family E a where\n    E ()  = Bool\n    E Int = String\n\nclass Z a\n\nclass F (a :: Constraint)\ninstance F (Z a)\n\nclass G (a :: Type -> Type)\ninstance G B\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE Arrows, FunctionalDependencies, FlexibleContexts, \n             MultiParamTypeClasses, RecordWildCards  #-}\n\nmodule T5045 where\n\nimport Control.Arrow\n\nclass (Control.Arrow.Arrow a') => ArrowAddReader r a a' | a -> a' where\n  elimReader :: a (e, s) b -> a' (e, (r, s)) b\n\nnewtype ByteString = FakeByteString String\n\npathInfo :: Monad m => m String\npathInfo = undefined\n\nrequestMethod :: Monad m => m String\nrequestMethod = undefined\n\ngetInputsFPS :: Monad m => m [(String, ByteString)]  \ngetInputsFPS = undefined\n\nclass HTTPRequest r s | r -> s where\n    httpGetPath :: r -> String\n    httpSetPath :: r -> String -> r\n    httpGetMethod :: r -> String\n    httpGetInputs :: r -> [(String, s)]\n\ndata CGIDispatch = CGIDispatch {\n    dispatchPath :: String,\n    dispatchMethod :: String,\n    dispatchInputs :: [(String, ByteString)]  }\n\ninstance HTTPRequest CGIDispatch ByteString where\n    httpGetPath = dispatchPath\n    httpSetPath r s = r { dispatchPath = s }\n    httpGetMethod = dispatchMethod\n    httpGetInputs = dispatchInputs\n\nrunDispatch :: (Arrow a, ArrowAddReader CGIDispatch a a', Monad m) => a b  c -> m (a' b c)  \nrunDispatch a = do\n    dispatchPath <- pathInfo\n    dispatchMethod <- requestMethod\n    dispatchInputs <- getInputsFPS\n    return $ proc b -> (| elimReader (a -< b) |) CGIDispatch { .. }  \n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T5417 where\n  import qualified T5417a as C\n\n  data B1 a = B1 a\n\n  instance C.C1 (B1 a) where\n    data F (B1 a) = B2 a\n\n  data family D a\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T5417a where\n\n  import Data.Kind (Type)\n\n  class C1 a where\n    data F a :: Type\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5566 where\n\nclass C a where\n     c :: a\n\n$([d| instance C Int where c = 0 |] )\n\ndata D = D\n\n$([d| instance C D where c = D |] )\n\n$([d| instance Show D where show _ = \"D\" |] )\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5820 where\ndata Foo = Foo\ninstance Eq Foo\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6091 where\n\ninfixr 4 `foo`\nfoo :: Int -> Int -> Int\nfoo x y = x * y\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fforce-recomp #-}\nmodule T6105 where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Concurrent\nimport Data.ByteString as BS\nimport System.Environment\n\nmain :: IO ()\nmain = do args <- getArgs\n          case args of\n              [x, y, z] -> f x y z\n              _ -> error (\"Bad args: \" ++ show args)\n\nf :: String -> String -> String -> IO ()\nf x y z = do bs <- BS.readFile y\n             BS.writeFile z bs\n             threadDelay 1000000\n             Prelude.writeFile x \"FAIL\"\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule Tim where\n\ndata Proxy (t:: k) = Proxy\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\ntable = [\n    \"MARY\", \"PATRICIA\", \"LINDA\", \"BARBARA\", \"ELIZABETH\", \"JENNIFER\",\n    \"MARIA\", \"SUSAN\", \"MARGARET\", \"DOROTHY\", \"LISA\", \"NANCY\", \"KAREN\",\n    \"BETTY\", \"HELEN\", \"SANDRA\", \"DONNA\", \"CAROL\", \"RUTH\", \"SHARON\",\n    \"MICHELLE\", \"LAURA\", \"SARAH\", \"KIMBERLY\", \"DEBORAH\", \"JESSICA\",\n    \"SHIRLEY\", \"CYNTHIA\", \"ANGELA\", \"MELISSA\", \"BRENDA\", \"AMY\", \"ANNA\",\n    \"REBECCA\", \"VIRGINIA\", \"KATHLEEN\", \"PAMELA\", \"MARTHA\", \"DEBRA\",\n    \"AMANDA\", \"STEPHANIE\", \"CAROLYN\", \"CHRISTINE\", \"MARIE\", \"JANET\",\n    \"CATHERINE\", \"FRANCES\", \"ANN\", \"JOYCE\", \"DIANE\", \"ALICE\", \"JULIE\",\n    \"HEATHER\", \"TERESA\", \"DORIS\", \"GLORIA\", \"EVELYN\", \"JEAN\", \"CHERYL\",\n    \"MILDRED\", \"KATHERINE\", \"JOAN\", \"ASHLEY\", \"JUDITH\", \"ROSE\",\n    \"JANICE\", \"KELLY\", \"NICOLE\", \"JUDY\", \"CHRISTINA\", \"KATHY\",\n    \"THERESA\", \"BEVERLY\", \"DENISE\", \"TAMMY\", \"IRENE\", \"JANE\", \"LORI\",\n    \"RACHEL\", \"MARILYN\", \"ANDREA\", \"KATHRYN\", \"LOUISE\", \"SARA\", \"ANNE\",\n    \"JACQUELINE\", \"WANDA\", \"BONNIE\", \"JULIA\", \"RUBY\", \"LOIS\", \"TINA\",\n    \"PHYLLIS\", \"NORMA\", \"PAULA\", \"DIANA\", \"ANNIE\", \"LILLIAN\", \"EMILY\",\n    \"ROBIN\", \"PEGGY\", \"CRYSTAL\", \"GLADYS\", \"RITA\", \"DAWN\", \"CONNIE\",\n    \"FLORENCE\", \"TRACY\", \"EDNA\", \"TIFFANY\", \"CARMEN\", \"ROSA\", \"CINDY\",\n    \"GRACE\", \"WENDY\", \"VICTORIA\", \"EDITH\", \"KIM\", \"SHERRY\", \"SYLVIA\",\n    \"JOSEPHINE\", \"THELMA\", \"SHANNON\", \"SHEILA\", \"ETHEL\", \"ELLEN\",\n    \"ELAINE\", \"MARJORIE\", \"CARRIE\", \"CHARLOTTE\", \"MONICA\", \"ESTHER\",\n    \"PAULINE\", \"EMMA\", \"JUANITA\", \"ANITA\", \"RHONDA\", \"HAZEL\", \"AMBER\",\n    \"EVA\", \"DEBBIE\", \"APRIL\", \"LESLIE\", \"CLARA\", \"LUCILLE\", \"JAMIE\",\n    \"JOANNE\", \"ELEANOR\", \"VALERIE\", \"DANIELLE\", \"MEGAN\", \"ALICIA\",\n    \"SUZANNE\", \"MICHELE\", \"GAIL\", \"BERTHA\", \"DARLENE\", \"VERONICA\",\n    \"JILL\", \"ERIN\", \"GERALDINE\", \"LAUREN\", \"CATHY\", \"JOANN\", \"LORRAINE\",\n    \"LYNN\", \"SALLY\", \"REGINA\", \"ERICA\", \"BEATRICE\", \"DOLORES\",\n    \"BERNICE\", \"AUDREY\", \"YVONNE\", \"ANNETTE\", \"JUNE\", \"SAMANTHA\",\n    \"MARION\", \"DANA\", \"STACY\", \"ANA\", \"RENEE\", \"IDA\", \"VIVIAN\",\n    \"ROBERTA\", \"HOLLY\", \"BRITTANY\", \"MELANIE\", \"LORETTA\", \"YOLANDA\",\n    \"JEANETTE\", \"LAURIE\", \"KATIE\", \"KRISTEN\", \"VANESSA\", \"ALMA\", \"SUE\",\n    \"ELSIE\", \"BETH\", \"JEANNE\", \"VICKI\", \"CARLA\", \"TARA\", \"ROSEMARY\",\n    \"EILEEN\", \"TERRI\", \"GERTRUDE\", \"LUCY\", \"TONYA\", \"ELLA\", \"STACEY\",\n    \"WILMA\", \"GINA\", \"KRISTIN\", \"JESSIE\", \"NATALIE\", \"AGNES\", \"VERA\",\n    \"WILLIE\", \"CHARLENE\", \"BESSIE\", \"DELORES\", \"MELINDA\", \"PEARL\",\n    \"ARLENE\", \"MAUREEN\", \"COLLEEN\", \"ALLISON\", \"TAMARA\", \"JOY\",\n    \"GEORGIA\", \"CONSTANCE\", \"LILLIE\", \"CLAUDIA\", \"JACKIE\", \"MARCIA\",\n    \"TANYA\", \"NELLIE\", \"MINNIE\", \"MARLENE\", \"HEIDI\", \"GLENDA\", \"LYDIA\",\n    \"VIOLA\", \"COURTNEY\", \"MARIAN\", \"STELLA\", \"CAROLINE\", \"DORA\", \"JO\",\n    \"VICKIE\", \"MATTIE\", \"TERRY\", \"MAXINE\", \"IRMA\", \"MABEL\", \"MARSHA\",\n    \"MYRTLE\", \"LENA\", \"CHRISTY\", \"DEANNA\", \"PATSY\", \"HILDA\",\n    \"GWENDOLYN\", \"JENNIE\", \"NORA\", \"MARGIE\", \"NINA\", \"CASSANDRA\",\n    \"LEAH\", \"PENNY\", \"KAY\", \"PRISCILLA\", \"NAOMI\", \"CAROLE\", \"BRANDY\",\n    \"OLGA\", \"BILLIE\", \"DIANNE\", \"TRACEY\", \"LEONA\", \"JENNY\", \"FELICIA\",\n    \"SONIA\", \"MIRIAM\", \"VELMA\", \"BECKY\", \"BOBBIE\", \"VIOLET\", \"KRISTINA\",\n    \"TONI\", \"MISTY\", \"MAE\", \"SHELLY\", \"DAISY\", \"RAMONA\", \"SHERRI\",\n    \"ERIKA\", \"KATRINA\", \"CLAIRE\", \"LINDSEY\", \"LINDSAY\", \"GENEVA\",\n    \"GUADALUPE\", \"BELINDA\", \"MARGARITA\", \"SHERYL\", \"CORA\", \"FAYE\",\n    \"ADA\", \"NATASHA\", \"SABRINA\", \"ISABEL\", \"MARGUERITE\", \"HATTIE\",\n    \"HARRIET\", \"MOLLY\", \"CECILIA\", \"KRISTI\", \"BRANDI\", \"BLANCHE\",\n    \"SANDY\", \"ROSIE\", \"JOANNA\", \"IRIS\", \"EUNICE\", \"ANGIE\", \"INEZ\",\n    \"LYNDA\", \"MADELINE\", \"AMELIA\", \"ALBERTA\", \"GENEVIEVE\", \"MONIQUE\",\n    \"JODI\", \"JANIE\", \"MAGGIE\", \"KAYLA\", \"SONYA\", \"JAN\", \"LEE\",\n    \"KRISTINE\", \"CANDACE\", \"FANNIE\", \"MARYANN\", \"OPAL\", \"ALISON\",\n    \"YVETTE\", \"MELODY\", \"LUZ\", \"SUSIE\", \"OLIVIA\", \"FLORA\", \"SHELLEY\",\n    \"KRISTY\", \"MAMIE\", \"LULA\", \"LOLA\", \"VERNA\", \"BEULAH\", \"ANTOINETTE\",\n    \"CANDICE\", \"JUANA\", \"JEANNETTE\", \"PAM\", \"KELLI\", \"HANNAH\",\n    \"WHITNEY\", \"BRIDGET\", \"KARLA\", \"CELIA\", \"LATOYA\", \"PATTY\", \"SHELIA\",\n    \"GAYLE\", \"DELLA\", \"VICKY\", \"LYNNE\", \"SHERI\", \"MARIANNE\", \"KARA\",\n    \"JACQUELYN\", \"ERMA\", \"BLANCA\", \"MYRA\", \"LETICIA\", \"PAT\", \"KRISTA\",\n    \"ROXANNE\", \"ANGELICA\", \"JOHNNIE\", \"ROBYN\", \"FRANCIS\", \"ADRIENNE\",\n    \"ROSALIE\", \"ALEXANDRA\", \"BROOKE\", \"BETHANY\", \"SADIE\", \"BERNADETTE\",\n    \"TRACI\", \"JODY\", \"KENDRA\", \"JASMINE\", \"NICHOLE\", \"RACHAEL\",\n    \"CHELSEA\", \"MABLE\", \"ERNESTINE\", \"MURIEL\", \"MARCELLA\", \"ELENA\",\n    \"KRYSTAL\", \"ANGELINA\", \"NADINE\", \"KARI\", \"ESTELLE\", \"DIANNA\",\n    \"PAULETTE\", \"LORA\", \"MONA\", \"DOREEN\", \"ROSEMARIE\", \"ANGEL\",\n    \"DESIREE\", \"ANTONIA\", \"HOPE\", \"GINGER\", \"JANIS\", \"BETSY\",\n    \"CHRISTIE\", \"FREDA\", \"MERCEDES\", \"MEREDITH\", \"LYNETTE\", \"TERI\",\n    \"CRISTINA\", \"EULA\", \"LEIGH\", \"MEGHAN\", \"SOPHIA\", \"ELOISE\",\n    \"ROCHELLE\", \"GRETCHEN\", \"CECELIA\", \"RAQUEL\", \"HENRIETTA\", \"ALYSSA\",\n    \"JANA\", \"KELLEY\", \"GWEN\", \"KERRY\", \"JENNA\", \"TRICIA\", \"LAVERNE\",\n    \"OLIVE\", \"ALEXIS\", \"TASHA\", \"SILVIA\", \"ELVIRA\", \"CASEY\", \"DELIA\",\n    \"SOPHIE\", \"KATE\", \"PATTI\", \"LORENA\", \"KELLIE\", \"SONJA\", \"LILA\",\n    \"LANA\", \"DARLA\", \"MAY\", \"MINDY\", \"ESSIE\", \"MANDY\", \"LORENE\", \"ELSA\",\n    \"JOSEFINA\", \"JEANNIE\", \"MIRANDA\", \"DIXIE\", \"LUCIA\", \"MARTA\",\n    \"FAITH\", \"LELA\", \"JOHANNA\", \"SHARI\", \"CAMILLE\", \"TAMI\", \"SHAWNA\",\n    \"ELISA\", \"EBONY\", \"MELBA\", \"ORA\", \"NETTIE\", \"TABITHA\", \"OLLIE\",\n    \"JAIME\", \"WINIFRED\", \"KRISTIE\", \"MARINA\", \"ALISHA\", \"AIMEE\", \"RENA\",\n    \"MYRNA\", \"MARLA\", \"TAMMIE\", \"LATASHA\", \"BONITA\", \"PATRICE\", \"RONDA\",\n    \"SHERRIE\", \"ADDIE\", \"FRANCINE\", \"DELORIS\", \"STACIE\", \"ADRIANA\",\n    \"CHERI\", \"SHELBY\", \"ABIGAIL\", \"CELESTE\", \"JEWEL\", \"CARA\", \"ADELE\",\n    \"REBEKAH\", \"LUCINDA\", \"DORTHY\", \"CHRIS\", \"EFFIE\", \"TRINA\", \"REBA\",\n    \"SHAWN\", \"SALLIE\", \"AURORA\", \"LENORA\", \"ETTA\", \"LOTTIE\", \"KERRI\",\n    \"TRISHA\", \"NIKKI\", \"ESTELLA\", \"FRANCISCA\", \"JOSIE\", \"TRACIE\",\n    \"MARISSA\", \"KARIN\", \"BRITTNEY\", \"JANELLE\", \"LOURDES\", \"LAUREL\",\n    \"HELENE\", \"FERN\", \"ELVA\", \"CORINNE\", \"KELSEY\", \"INA\", \"BETTIE\",\n    \"ELISABETH\", \"AIDA\", \"CAITLIN\", \"INGRID\", \"IVA\", \"EUGENIA\",\n    \"CHRISTA\", \"GOLDIE\", \"CASSIE\", \"MAUDE\", \"JENIFER\", \"THERESE\",\n    \"FRANKIE\", \"DENA\", \"LORNA\", \"JANETTE\", \"LATONYA\", \"CANDY\", \"MORGAN\",\n    \"CONSUELO\", \"TAMIKA\", \"ROSETTA\", \"DEBORA\", \"CHERIE\", \"POLLY\",\n    \"DINA\", \"JEWELL\", \"FAY\", \"JILLIAN\", \"DOROTHEA\", \"NELL\", \"TRUDY\",\n    \"ESPERANZA\", \"PATRICA\", \"KIMBERLEY\", \"SHANNA\", \"HELENA\", \"CAROLINA\",\n    \"CLEO\", \"STEFANIE\", \"ROSARIO\", \"OLA\", \"JANINE\", \"MOLLIE\", \"LUPE\",\n    \"ALISA\", \"LOU\", \"MARIBEL\", \"SUSANNE\", \"BETTE\", \"SUSANA\", \"ELISE\",\n    \"CECILE\", \"ISABELLE\", \"LESLEY\", \"JOCELYN\", \"PAIGE\", \"JONI\",\n    \"RACHELLE\", \"LEOLA\", \"DAPHNE\", \"ALTA\", \"ESTER\", \"PETRA\", \"GRACIELA\",\n    \"IMOGENE\", \"JOLENE\", \"KEISHA\", \"LACEY\", \"GLENNA\", \"GABRIELA\",\n    \"KERI\", \"URSULA\", \"LIZZIE\", \"KIRSTEN\", \"SHANA\", \"ADELINE\", \"MAYRA\",\n    \"JAYNE\", \"JACLYN\", \"GRACIE\", \"SONDRA\", \"CARMELA\", \"MARISA\",\n    \"ROSALIND\", \"CHARITY\", \"TONIA\", \"BEATRIZ\", \"MARISOL\", \"CLARICE\",\n    \"JEANINE\", \"SHEENA\", \"ANGELINE\", \"FRIEDA\", \"LILY\", \"ROBBIE\",\n    \"SHAUNA\", \"MILLIE\", \"CLAUDETTE\", \"CATHLEEN\", \"ANGELIA\", \"GABRIELLE\",\n    \"AUTUMN\", \"KATHARINE\", \"SUMMER\", \"JODIE\", \"STACI\", \"LEA\", \"CHRISTI\",\n    \"JIMMIE\", \"JUSTINE\", \"ELMA\", \"LUELLA\", \"MARGRET\", \"DOMINIQUE\",\n    \"SOCORRO\", \"RENE\", \"MARTINA\", \"MARGO\", \"MAVIS\", \"CALLIE\", \"BOBBI\",\n    \"MARITZA\", \"LUCILE\", \"LEANNE\", \"JEANNINE\", \"DEANA\", \"AILEEN\",\n    \"LORIE\", \"LADONNA\", \"WILLA\", \"MANUELA\", \"GALE\", \"SELMA\", \"DOLLY\",\n    \"SYBIL\", \"ABBY\", \"LARA\", \"DALE\", \"IVY\", \"DEE\", \"WINNIE\", \"MARCY\",\n    \"LUISA\", \"JERI\", \"MAGDALENA\", \"OFELIA\", \"MEAGAN\", \"AUDRA\",\n    \"MATILDA\", \"LEILA\", \"CORNELIA\", \"BIANCA\", \"SIMONE\", \"BETTYE\",\n    \"RANDI\", \"VIRGIE\", \"LATISHA\", \"BARBRA\", \"GEORGINA\", \"ELIZA\",\n    \"LEANN\", \"BRIDGETTE\", \"RHODA\", \"HALEY\", \"ADELA\", \"NOLA\",\n    \"BERNADINE\", \"FLOSSIE\", \"ILA\", \"GRETA\", \"RUTHIE\", \"NELDA\",\n    \"MINERVA\", \"LILLY\", \"TERRIE\", \"LETHA\", \"HILARY\", \"ESTELA\",\n    \"VALARIE\", \"BRIANNA\", \"ROSALYN\", \"EARLINE\", \"CATALINA\", \"AVA\",\n    \"MIA\", \"CLARISSA\", \"LIDIA\", \"CORRINE\", \"ALEXANDRIA\", \"CONCEPCION\",\n    \"TIA\", \"SHARRON\", \"RAE\", \"DONA\", \"ERICKA\", \"JAMI\", \"ELNORA\",\n    \"CHANDRA\", \"LENORE\", \"NEVA\", \"MARYLOU\", \"MELISA\", \"TABATHA\",\n    \"SERENA\", \"AVIS\", \"ALLIE\", \"SOFIA\", \"JEANIE\", \"ODESSA\", \"NANNIE\",\n    \"HARRIETT\", \"LORAINE\", \"PENELOPE\", \"MILAGROS\", \"EMILIA\", \"BENITA\",\n    \"ALLYSON\", \"ASHLEE\", \"TANIA\", \"TOMMIE\", \"ESMERALDA\", \"KARINA\",\n    \"EVE\", \"PEARLIE\", \"ZELMA\", \"MALINDA\", \"NOREEN\", \"TAMEKA\", \"SAUNDRA\",\n    \"HILLARY\", \"AMIE\", \"ALTHEA\", \"ROSALINDA\", \"JORDAN\", \"LILIA\",\n    \"ALANA\", \"GAY\", \"CLARE\", \"ALEJANDRA\", \"ELINOR\", \"MICHAEL\", \"LORRIE\",\n    \"JERRI\", \"DARCY\", \"EARNESTINE\", \"CARMELLA\", \"TAYLOR\", \"NOEMI\",\n    \"MARCIE\", \"LIZA\", \"ANNABELLE\", \"LOUISA\", \"EARLENE\", \"MALLORY\",\n    \"CARLENE\", \"NITA\", \"SELENA\", \"TANISHA\", \"KATY\", \"JULIANNE\", \"JOHN\",\n    \"LAKISHA\", \"EDWINA\", \"MARICELA\", \"MARGERY\", \"KENYA\", \"DOLLIE\",\n    \"ROXIE\", \"ROSLYN\", \"KATHRINE\", \"NANETTE\", \"CHARMAINE\", \"LAVONNE\",\n    \"ILENE\", \"KRIS\", \"TAMMI\", \"SUZETTE\", \"CORINE\", \"KAYE\", \"JERRY\",\n    \"MERLE\", \"CHRYSTAL\", \"LINA\", \"DEANNE\", \"LILIAN\", \"JULIANA\", \"ALINE\",\n    \"LUANN\", \"KASEY\", \"MARYANNE\", \"EVANGELINE\", \"COLETTE\", \"MELVA\",\n    \"LAWANDA\", \"YESENIA\", \"NADIA\", \"MADGE\", \"KATHIE\", \"EDDIE\",\n    \"OPHELIA\", \"VALERIA\", \"NONA\", \"MITZI\", \"MARI\", \"GEORGETTE\",\n    \"CLAUDINE\", \"FRAN\", \"ALISSA\", \"ROSEANN\", \"LAKEISHA\", \"SUSANNA\",\n    \"REVA\", \"DEIDRE\", \"CHASITY\", \"SHEREE\", \"CARLY\", \"JAMES\", \"ELVIA\",\n    \"ALYCE\", \"DEIRDRE\", \"GENA\", \"BRIANA\", \"ARACELI\", \"KATELYN\",\n    \"ROSANNE\", \"WENDI\", \"TESSA\", \"BERTA\", \"MARVA\", \"IMELDA\", \"MARIETTA\",\n    \"MARCI\", \"LEONOR\", \"ARLINE\", \"SASHA\", \"MADELYN\", \"JANNA\",\n    \"JULIETTE\", \"DEENA\", \"AURELIA\", \"JOSEFA\", \"AUGUSTA\", \"LILIANA\",\n    \"YOUNG\", \"CHRISTIAN\", \"LESSIE\", \"AMALIA\", \"SAVANNAH\", \"ANASTASIA\",\n    \"VILMA\", \"NATALIA\", \"ROSELLA\", \"LYNNETTE\", \"CORINA\", \"ALFREDA\",\n    \"LEANNA\", \"CAREY\", \"AMPARO\", \"COLEEN\", \"TAMRA\", \"AISHA\", \"WILDA\",\n    \"KARYN\", \"CHERRY\", \"QUEEN\", \"MAURA\", \"MAI\", \"EVANGELINA\", \"ROSANNA\",\n    \"HALLIE\", \"ERNA\", \"ENID\", \"MARIANA\", \"LACY\", \"JULIET\", \"JACKLYN\",\n    \"FREIDA\", \"MADELEINE\", \"MARA\", \"HESTER\", \"CATHRYN\", \"LELIA\",\n    \"CASANDRA\", \"BRIDGETT\", \"ANGELITA\", \"JANNIE\", \"DIONNE\", \"ANNMARIE\",\n    \"KATINA\", \"BERYL\", \"PHOEBE\", \"MILLICENT\", \"KATHERYN\", \"DIANN\",\n    \"CARISSA\", \"MARYELLEN\", \"LIZ\", \"LAURI\", \"HELGA\", \"GILDA\", \"ADRIAN\",\n    \"RHEA\", \"MARQUITA\", \"HOLLIE\", \"TISHA\", \"TAMERA\", \"ANGELIQUE\",\n    \"FRANCESCA\", \"BRITNEY\", \"KAITLIN\", \"LOLITA\", \"FLORINE\", \"ROWENA\",\n    \"REYNA\", \"TWILA\", \"FANNY\", \"JANELL\", \"INES\", \"CONCETTA\", \"BERTIE\",\n    \"ALBA\", \"BRIGITTE\", \"ALYSON\", \"VONDA\", \"PANSY\", \"ELBA\", \"NOELLE\",\n    \"LETITIA\", \"KITTY\", \"DEANN\", \"BRANDIE\", \"LOUELLA\", \"LETA\",\n    \"FELECIA\", \"SHARLENE\", \"LESA\", \"BEVERLEY\", \"ROBERT\", \"ISABELLA\",\n    \"HERMINIA\", \"TERRA\", \"CELINA\", \"TORI\", \"OCTAVIA\", \"JADE\", \"DENICE\",\n    \"GERMAINE\", \"SIERRA\", \"MICHELL\", \"CORTNEY\", \"NELLY\", \"DORETHA\",\n    \"SYDNEY\", \"DEIDRA\", \"MONIKA\", \"LASHONDA\", \"JUDI\", \"CHELSEY\",\n    \"ANTIONETTE\", \"MARGOT\", \"BOBBY\", \"ADELAIDE\", \"NAN\", \"LEEANN\",\n    \"ELISHA\", \"DESSIE\", \"LIBBY\", \"KATHI\", \"GAYLA\", \"LATANYA\", \"MINA\",\n    \"MELLISA\", \"KIMBERLEE\", \"JASMIN\", \"RENAE\", \"ZELDA\", \"ELDA\", \"MA\",\n    \"JUSTINA\", \"GUSSIE\", \"EMILIE\", \"CAMILLA\", \"ABBIE\", \"ROCIO\",\n    \"KAITLYN\", \"JESSE\", \"EDYTHE\", \"ASHLEIGH\", \"SELINA\", \"LAKESHA\",\n    \"GERI\", \"ALLENE\", \"PAMALA\", \"MICHAELA\", \"DAYNA\", \"CARYN\", \"ROSALIA\",\n    \"SUN\", \"JACQULINE\", \"REBECA\", \"MARYBETH\", \"KRYSTLE\", \"IOLA\",\n    \"DOTTIE\", \"BENNIE\", \"BELLE\", \"AUBREY\", \"GRISELDA\", \"ERNESTINA\",\n    \"ELIDA\", \"ADRIANNE\", \"DEMETRIA\", \"DELMA\", \"CHONG\", \"JAQUELINE\",\n    \"DESTINY\", \"ARLEEN\", \"VIRGINA\", \"RETHA\", \"FATIMA\", \"TILLIE\",\n    \"ELEANORE\", \"CARI\", \"TREVA\", \"BIRDIE\", \"WILHELMINA\", \"ROSALEE\",\n    \"MAURINE\", \"LATRICE\", \"YONG\", \"JENA\", \"TARYN\", \"ELIA\", \"DEBBY\",\n    \"MAUDIE\", \"JEANNA\", \"DELILAH\", \"CATRINA\", \"SHONDA\", \"HORTENCIA\",\n    \"THEODORA\", \"TERESITA\", \"ROBBIN\", \"DANETTE\", \"MARYJANE\", \"FREDDIE\",\n    \"DELPHINE\", \"BRIANNE\", \"NILDA\", \"DANNA\", \"CINDI\", \"BESS\", \"IONA\",\n    \"HANNA\", \"ARIEL\", \"WINONA\", \"VIDA\", \"ROSITA\", \"MARIANNA\", \"WILLIAM\",\n    \"RACHEAL\", \"GUILLERMINA\", \"ELOISA\", \"CELESTINE\", \"CAREN\", \"MALISSA\",\n    \"LONA\", \"CHANTEL\", \"SHELLIE\", \"MARISELA\", \"LEORA\", \"AGATHA\",\n    \"SOLEDAD\", \"MIGDALIA\", \"IVETTE\", \"CHRISTEN\", \"ATHENA\", \"JANEL\",\n    \"CHLOE\", \"VEDA\", \"PATTIE\", \"TESSIE\", \"TERA\", \"MARILYNN\", \"LUCRETIA\",\n    \"KARRIE\", \"DINAH\", \"DANIELA\", \"ALECIA\", \"ADELINA\", \"VERNICE\",\n    \"SHIELA\", \"PORTIA\", \"MERRY\", \"LASHAWN\", \"DEVON\", \"DARA\", \"TAWANA\",\n    \"OMA\", \"VERDA\", \"CHRISTIN\", \"ALENE\", \"ZELLA\", \"SANDI\", \"RAFAELA\",\n    \"MAYA\", \"KIRA\", \"CANDIDA\", \"ALVINA\", \"SUZAN\", \"SHAYLA\", \"LYN\",\n    \"LETTIE\", \"ALVA\", \"SAMATHA\", \"ORALIA\", \"MATILDE\", \"MADONNA\",\n    \"LARISSA\", \"VESTA\", \"RENITA\", \"INDIA\", \"DELOIS\", \"SHANDA\",\n    \"PHILLIS\", \"LORRI\", \"ERLINDA\", \"CRUZ\", \"CATHRINE\", \"BARB\", \"ZOE\",\n    \"ISABELL\", \"IONE\", \"GISELA\", \"CHARLIE\", \"VALENCIA\", \"ROXANNA\",\n    \"MAYME\", \"KISHA\", \"ELLIE\", \"MELLISSA\", \"DORRIS\", \"DALIA\", \"BELLA\",\n    \"ANNETTA\", \"ZOILA\", \"RETA\", \"REINA\", \"LAURETTA\", \"KYLIE\",\n    \"CHRISTAL\", \"PILAR\", \"CHARLA\", \"ELISSA\", \"TIFFANI\", \"TANA\",\n    \"PAULINA\", \"LEOTA\", \"BREANNA\", \"JAYME\", \"CARMEL\", \"VERNELL\",\n    \"TOMASA\", \"MANDI\", \"DOMINGA\", \"SANTA\", \"MELODIE\", \"LURA\", \"ALEXA\",\n    \"TAMELA\", \"RYAN\", \"MIRNA\", \"KERRIE\", \"VENUS\", \"NOEL\", \"FELICITA\",\n    \"CRISTY\", \"CARMELITA\", \"BERNIECE\", \"ANNEMARIE\", \"TIARA\", \"ROSEANNE\",\n    \"MISSY\", \"CORI\", \"ROXANA\", \"PRICILLA\", \"KRISTAL\", \"JUNG\", \"ELYSE\",\n    \"HAYDEE\", \"ALETHA\", \"BETTINA\", \"MARGE\", \"GILLIAN\", \"FILOMENA\",\n    \"CHARLES\", \"ZENAIDA\", \"HARRIETTE\", \"CARIDAD\", \"VADA\", \"UNA\",\n    \"ARETHA\", \"PEARLINE\", \"MARJORY\", \"MARCELA\", \"FLOR\", \"EVETTE\",\n    \"ELOUISE\", \"ALINA\", \"TRINIDAD\", \"DAVID\", \"DAMARIS\", \"CATHARINE\",\n    \"CARROLL\", \"BELVA\", \"NAKIA\", \"MARLENA\", \"LUANNE\", \"LORINE\", \"KARON\",\n    \"DORENE\", \"DANITA\", \"BRENNA\", \"TATIANA\", \"SAMMIE\", \"LOUANN\",\n    \"LOREN\", \"JULIANNA\", \"ANDRIA\", \"PHILOMENA\", \"LUCILA\", \"LEONORA\",\n    \"DOVIE\", \"ROMONA\", \"MIMI\", \"JACQUELIN\", \"GAYE\", \"TONJA\", \"MISTI\",\n    \"JOE\", \"GENE\", \"CHASTITY\", \"STACIA\", \"ROXANN\", \"MICAELA\", \"NIKITA\",\n    \"MEI\", \"VELDA\", \"MARLYS\", \"JOHNNA\", \"AURA\", \"LAVERN\", \"IVONNE\",\n    \"HAYLEY\", \"NICKI\", \"MAJORIE\", \"HERLINDA\", \"GEORGE\", \"ALPHA\",\n    \"YADIRA\", \"PERLA\", \"GREGORIA\", \"DANIEL\", \"ANTONETTE\", \"SHELLI\",\n    \"MOZELLE\", \"MARIAH\", \"JOELLE\", \"CORDELIA\", \"JOSETTE\", \"CHIQUITA\",\n    \"TRISTA\", \"LOUIS\", \"LAQUITA\", \"GEORGIANA\", \"CANDI\", \"SHANON\",\n    \"LONNIE\", \"HILDEGARD\", \"CECIL\", \"VALENTINA\", \"STEPHANY\", \"MAGDA\",\n    \"KAROL\", \"GERRY\", \"GABRIELLA\", \"TIANA\", \"ROMA\", \"RICHELLE\", \"RAY\",\n    \"PRINCESS\", \"OLETA\", \"JACQUE\", \"IDELLA\", \"ALAINA\", \"SUZANNA\",\n    \"JOVITA\", \"BLAIR\", \"TOSHA\", \"RAVEN\", \"NEREIDA\", \"MARLYN\", \"KYLA\",\n    \"JOSEPH\", \"DELFINA\", \"TENA\", \"STEPHENIE\", \"SABINA\", \"NATHALIE\",\n    \"MARCELLE\", \"GERTIE\", \"DARLEEN\", \"THEA\", \"SHARONDA\", \"SHANTEL\",\n    \"BELEN\", \"VENESSA\", \"ROSALINA\", \"ONA\", \"GENOVEVA\", \"COREY\",\n    \"CLEMENTINE\", \"ROSALBA\", \"RENATE\", \"RENATA\", \"MI\", \"IVORY\",\n    \"GEORGIANNA\", \"FLOY\", \"DORCAS\", \"ARIANA\", \"TYRA\", \"THEDA\", \"MARIAM\",\n    \"JULI\", \"JESICA\", \"DONNIE\", \"VIKKI\", \"VERLA\", \"ROSELYN\", \"MELVINA\",\n    \"JANNETTE\", \"GINNY\", \"DEBRAH\", \"CORRIE\", \"ASIA\", \"VIOLETA\",\n    \"MYRTIS\", \"LATRICIA\", \"COLLETTE\", \"CHARLEEN\", \"ANISSA\", \"VIVIANA\",\n    \"TWYLA\", \"PRECIOUS\", \"NEDRA\", \"LATONIA\", \"LAN\", \"HELLEN\", \"FABIOLA\",\n    \"ANNAMARIE\", \"ADELL\", \"SHARYN\", \"CHANTAL\", \"NIKI\", \"MAUD\",\n    \"LIZETTE\", \"LINDY\", \"KIA\", \"KESHA\", \"JEANA\", \"DANELLE\", \"CHARLINE\",\n    \"CHANEL\", \"CARROL\", \"VALORIE\", \"LIA\", \"DORTHA\", \"CRISTAL\", \"SUNNY\",\n    \"LEONE\", \"LEILANI\", \"GERRI\", \"DEBI\", \"ANDRA\", \"KESHIA\", \"IMA\",\n    \"EULALIA\", \"EASTER\", \"DULCE\", \"NATIVIDAD\", \"LINNIE\", \"KAMI\",\n    \"GEORGIE\", \"CATINA\", \"BROOK\", \"ALDA\", \"WINNIFRED\", \"SHARLA\",\n    \"RUTHANN\", \"MEAGHAN\", \"MAGDALENE\", \"LISSETTE\", \"ADELAIDA\", \"VENITA\",\n    \"TRENA\", \"SHIRLENE\", \"SHAMEKA\", \"ELIZEBETH\", \"DIAN\", \"SHANTA\",\n    \"MICKEY\", \"LATOSHA\", \"CARLOTTA\", \"WINDY\", \"SOON\", \"ROSINA\",\n    \"MARIANN\", \"LEISA\", \"JONNIE\", \"DAWNA\", \"CATHIE\", \"BILLY\", \"ASTRID\",\n    \"SIDNEY\", \"LAUREEN\", \"JANEEN\", \"HOLLI\", \"FAWN\", \"VICKEY\", \"TERESSA\",\n    \"SHANTE\", \"RUBYE\", \"MARCELINA\", \"CHANDA\", \"CARY\", \"TERESE\",\n    \"SCARLETT\", \"MARTY\", \"MARNIE\", \"LULU\", \"LISETTE\", \"JENIFFER\",\n    \"ELENOR\", \"DORINDA\", \"DONITA\", \"CARMAN\", \"BERNITA\", \"ALTAGRACIA\",\n    \"ALETA\", \"ADRIANNA\", \"ZORAIDA\", \"RONNIE\", \"NICOLA\", \"LYNDSEY\",\n    \"KENDALL\", \"JANINA\", \"CHRISSY\", \"AMI\", \"STARLA\", \"PHYLIS\", \"PHUONG\",\n    \"KYRA\", \"CHARISSE\", \"BLANCH\", \"SANJUANITA\", \"RONA\", \"NANCI\",\n    \"MARILEE\", \"MARANDA\", \"CORY\", \"BRIGETTE\", \"SANJUANA\", \"MARITA\",\n    \"KASSANDRA\", \"JOYCELYN\", \"IRA\", \"FELIPA\", \"CHELSIE\", \"BONNY\",\n    \"MIREYA\", \"LORENZA\", \"KYONG\", \"ILEANA\", \"CANDELARIA\", \"TONY\",\n    \"TOBY\", \"SHERIE\", \"OK\", \"MARK\", \"LUCIE\", \"LEATRICE\", \"LAKESHIA\",\n    \"GERDA\", \"EDIE\", \"BAMBI\", \"MARYLIN\", \"LAVON\", \"HORTENSE\", \"GARNET\",\n    \"EVIE\", \"TRESSA\", \"SHAYNA\", \"LAVINA\", \"KYUNG\", \"JEANETTA\",\n    \"SHERRILL\", \"SHARA\", \"PHYLISS\", \"MITTIE\", \"ANABEL\", \"ALESIA\",\n    \"THUY\", \"TAWANDA\", \"RICHARD\", \"JOANIE\", \"TIFFANIE\", \"LASHANDA\",\n    \"KARISSA\", \"ENRIQUETA\", \"DARIA\", \"DANIELLA\", \"CORINNA\", \"ALANNA\",\n    \"ABBEY\", \"ROXANE\", \"ROSEANNA\", \"MAGNOLIA\", \"LIDA\", \"KYLE\",\n    \"JOELLEN\", \"ERA\", \"CORAL\", \"CARLEEN\", \"TRESA\", \"PEGGIE\", \"NOVELLA\",\n    \"NILA\", \"MAYBELLE\", \"JENELLE\", \"CARINA\", \"NOVA\", \"MELINA\",\n    \"MARQUERITE\", \"MARGARETTE\", \"JOSEPHINA\", \"EVONNE\", \"DEVIN\",\n    \"CINTHIA\", \"ALBINA\", \"TOYA\", \"TAWNYA\", \"SHERITA\", \"SANTOS\",\n    \"MYRIAM\", \"LIZABETH\", \"LISE\", \"KEELY\", \"JENNI\", \"GISELLE\",\n    \"CHERYLE\", \"ARDITH\", \"ARDIS\", \"ALESHA\", \"ADRIANE\", \"SHAINA\",\n    \"LINNEA\", \"KAROLYN\", \"HONG\", \"FLORIDA\", \"FELISHA\", \"DORI\", \"DARCI\",\n    \"ARTIE\", \"ARMIDA\", \"ZOLA\", \"XIOMARA\", \"VERGIE\", \"SHAMIKA\", \"NENA\",\n    \"NANNETTE\", \"MAXIE\", \"LOVIE\", \"JEANE\", \"JAIMIE\", \"INGE\", \"FARRAH\",\n    \"ELAINA\", \"CAITLYN\", \"STARR\", \"FELICITAS\", \"CHERLY\", \"CARYL\",\n    \"YOLONDA\", \"YASMIN\", \"TEENA\", \"PRUDENCE\", \"PENNIE\", \"NYDIA\",\n    \"MACKENZIE\", \"ORPHA\", \"MARVEL\", \"LIZBETH\", \"LAURETTE\", \"JERRIE\",\n    \"HERMELINDA\", \"CAROLEE\", \"TIERRA\", \"MIRIAN\", \"META\", \"MELONY\",\n    \"KORI\", \"JENNETTE\", \"JAMILA\", \"ENA\", \"ANH\", \"YOSHIKO\", \"SUSANNAH\",\n    \"SALINA\", \"RHIANNON\", \"JOLEEN\", \"CRISTINE\", \"ASHTON\", \"ARACELY\",\n    \"TOMEKA\", \"SHALONDA\", \"MARTI\", \"LACIE\", \"KALA\", \"JADA\", \"ILSE\",\n    \"HAILEY\", \"BRITTANI\", \"ZONA\", \"SYBLE\", \"SHERRYL\", \"RANDY\", \"NIDIA\",\n    \"MARLO\", \"KANDICE\", \"KANDI\", \"DEB\", \"DEAN\", \"AMERICA\", \"ALYCIA\",\n    \"TOMMY\", \"RONNA\", \"NORENE\", \"MERCY\", \"JOSE\", \"INGEBORG\", \"GIOVANNA\",\n    \"GEMMA\", \"CHRISTEL\", \"AUDRY\", \"ZORA\", \"VITA\", \"VAN\", \"TRISH\",\n    \"STEPHAINE\", \"SHIRLEE\", \"SHANIKA\", \"MELONIE\", \"MAZIE\", \"JAZMIN\",\n    \"INGA\", \"HOA\", \"HETTIE\", \"GERALYN\", \"FONDA\", \"ESTRELLA\", \"ADELLA\",\n    \"SU\", \"SARITA\", \"RINA\", \"MILISSA\", \"MARIBETH\", \"GOLDA\", \"EVON\",\n    \"ETHELYN\", \"ENEDINA\", \"CHERISE\", \"CHANA\", \"VELVA\", \"TAWANNA\",\n    \"SADE\", \"MIRTA\", \"LI\", \"KARIE\", \"JACINTA\", \"ELNA\", \"DAVINA\",\n    \"CIERRA\", \"ASHLIE\", \"ALBERTHA\", \"TANESHA\", \"STEPHANI\", \"NELLE\",\n    \"MINDI\", \"LU\", \"LORINDA\", \"LARUE\", \"FLORENE\", \"DEMETRA\", \"DEDRA\",\n    \"CIARA\", \"CHANTELLE\", \"ASHLY\", \"SUZY\", \"ROSALVA\", \"NOELIA\", \"LYDA\",\n    \"LEATHA\", \"KRYSTYNA\", \"KRISTAN\", \"KARRI\", \"DARLINE\", \"DARCIE\",\n    \"CINDA\", \"CHEYENNE\", \"CHERRIE\", \"AWILDA\", \"ALMEDA\", \"ROLANDA\",\n    \"LANETTE\", \"JERILYN\", \"GISELE\", \"EVALYN\", \"CYNDI\", \"CLETA\", \"CARIN\",\n    \"ZINA\", \"ZENA\", \"VELIA\", \"TANIKA\", \"PAUL\", \"CHARISSA\", \"THOMAS\",\n    \"TALIA\", \"MARGARETE\", \"LAVONDA\", \"KAYLEE\", \"KATHLENE\", \"JONNA\",\n    \"IRENA\", \"ILONA\", \"IDALIA\", \"CANDIS\", \"CANDANCE\", \"BRANDEE\",\n    \"ANITRA\", \"ALIDA\", \"SIGRID\", \"NICOLETTE\", \"MARYJO\", \"LINETTE\",\n    \"HEDWIG\", \"CHRISTIANA\", \"CASSIDY\", \"ALEXIA\", \"TRESSIE\", \"MODESTA\",\n    \"LUPITA\", \"LITA\", \"GLADIS\", \"EVELIA\", \"DAVIDA\", \"CHERRI\", \"CECILY\",\n    \"ASHELY\", \"ANNABEL\", \"AGUSTINA\", \"WANITA\", \"SHIRLY\", \"ROSAURA\",\n    \"HULDA\", \"EUN\", \"BAILEY\", \"YETTA\", \"VERONA\", \"THOMASINA\", \"SIBYL\",\n    \"SHANNAN\", \"MECHELLE\", \"LUE\", \"LEANDRA\", \"LANI\", \"KYLEE\", \"KANDY\",\n    \"JOLYNN\", \"FERNE\", \"EBONI\", \"CORENE\", \"ALYSIA\", \"ZULA\", \"NADA\",\n    \"MOIRA\", \"LYNDSAY\", \"LORRETTA\", \"JUAN\", \"JAMMIE\", \"HORTENSIA\",\n    \"GAYNELL\", \"CAMERON\", \"ADRIA\", \"VINA\", \"VICENTA\", \"TANGELA\",\n    \"STEPHINE\", \"NORINE\", \"NELLA\", \"LIANA\", \"LESLEE\", \"KIMBERELY\",\n    \"ILIANA\", \"GLORY\", \"FELICA\", \"EMOGENE\", \"ELFRIEDE\", \"EDEN\",\n    \"EARTHA\", \"CARMA\", \"BEA\", \"OCIE\", \"MARRY\", \"LENNIE\", \"KIARA\",\n    \"JACALYN\", \"CARLOTA\", \"ARIELLE\", \"YU\", \"STAR\", \"OTILIA\", \"KIRSTIN\",\n    \"KACEY\", \"JOHNETTA\", \"JOEY\", \"JOETTA\", \"JERALDINE\", \"JAUNITA\",\n    \"ELANA\", \"DORTHEA\", \"CAMI\", \"AMADA\", \"ADELIA\", \"VERNITA\", \"TAMAR\",\n    \"SIOBHAN\", \"RENEA\", \"RASHIDA\", \"OUIDA\", \"ODELL\", \"NILSA\", \"MERYL\",\n    \"KRISTYN\", \"JULIETA\", \"DANICA\", \"BREANNE\", \"AUREA\", \"ANGLEA\",\n    \"SHERRON\", \"ODETTE\", \"MALIA\", \"LORELEI\", \"LIN\", \"LEESA\", \"KENNA\",\n    \"KATHLYN\", \"FIONA\", \"CHARLETTE\", \"SUZIE\", \"SHANTELL\", \"SABRA\",\n    \"RACQUEL\", \"MYONG\", \"MIRA\", \"MARTINE\", \"LUCIENNE\", \"LAVADA\",\n    \"JULIANN\", \"JOHNIE\", \"ELVERA\", \"DELPHIA\", \"CLAIR\", \"CHRISTIANE\",\n    \"CHAROLETTE\", \"CARRI\", \"AUGUSTINE\", \"ASHA\", \"ANGELLA\", \"PAOLA\",\n    \"NINFA\", \"LEDA\", \"LAI\", \"EDA\", \"SUNSHINE\", \"STEFANI\", \"SHANELL\",\n    \"PALMA\", \"MACHELLE\", \"LISSA\", \"KECIA\", \"KATHRYNE\", \"KARLENE\",\n    \"JULISSA\", \"JETTIE\", \"JENNIFFER\", \"HUI\", \"CORRINA\", \"CHRISTOPHER\",\n    \"CAROLANN\", \"ALENA\", \"TESS\", \"ROSARIA\", \"MYRTICE\", \"MARYLEE\",\n    \"LIANE\", \"KENYATTA\", \"JUDIE\", \"JANEY\", \"IN\", \"ELMIRA\", \"ELDORA\",\n    \"DENNA\", \"CRISTI\", \"CATHI\", \"ZAIDA\", \"VONNIE\", \"VIVA\", \"VERNIE\",\n    \"ROSALINE\", \"MARIELA\", \"LUCIANA\", \"LESLI\", \"KARAN\", \"FELICE\",\n    \"DENEEN\", \"ADINA\", \"WYNONA\", \"TARSHA\", \"SHERON\", \"SHASTA\",\n    \"SHANITA\", \"SHANI\", \"SHANDRA\", \"RANDA\", \"PINKIE\", \"PARIS\", \"NELIDA\",\n    \"MARILOU\", \"LYLA\", \"LAURENE\", \"LACI\", \"JOI\", \"JANENE\", \"DOROTHA\",\n    \"DANIELE\", \"DANI\", \"CAROLYNN\", \"CARLYN\", \"BERENICE\", \"AYESHA\",\n    \"ANNELIESE\", \"ALETHEA\", \"THERSA\", \"TAMIKO\", \"RUFINA\", \"OLIVA\",\n    \"MOZELL\", \"MARYLYN\", \"MADISON\", \"KRISTIAN\", \"KATHYRN\", \"KASANDRA\",\n    \"KANDACE\", \"JANAE\", \"GABRIEL\", \"DOMENICA\", \"DEBBRA\", \"DANNIELLE\",\n    \"CHUN\", \"BUFFY\", \"BARBIE\", \"ARCELIA\", \"AJA\", \"ZENOBIA\", \"SHAREN\",\n    \"SHAREE\", \"PATRICK\", \"PAGE\", \"MY\", \"LAVINIA\", \"KUM\", \"KACIE\",\n    \"JACKELINE\", \"HUONG\", \"FELISA\", \"EMELIA\", \"ELEANORA\", \"CYTHIA\",\n    \"CRISTIN\", \"CLYDE\", \"CLARIBEL\", \"CARON\", \"ANASTACIA\", \"ZULMA\",\n    \"ZANDRA\", \"YOKO\", \"TENISHA\", \"SUSANN\", \"SHERILYN\", \"SHAY\",\n    \"SHAWANDA\", \"SABINE\", \"ROMANA\", \"MATHILDA\", \"LINSEY\", \"KEIKO\",\n    \"JOANA\", \"ISELA\", \"GRETTA\", \"GEORGETTA\", \"EUGENIE\", \"DUSTY\",\n    \"DESIRAE\", \"DELORA\", \"CORAZON\", \"ANTONINA\", \"ANIKA\", \"WILLENE\",\n    \"TRACEE\", \"TAMATHA\", \"REGAN\", \"NICHELLE\", \"MICKIE\", \"MAEGAN\",\n    \"LUANA\", \"LANITA\", \"KELSIE\", \"EDELMIRA\", \"BREE\", \"AFTON\", \"TEODORA\",\n    \"TAMIE\", \"SHENA\", \"MEG\", \"LINH\", \"KELI\", \"KACI\", \"DANYELLE\",\n    \"BRITT\", \"ARLETTE\", \"ALBERTINE\", \"ADELLE\", \"TIFFINY\", \"STORMY\",\n    \"SIMONA\", \"NUMBERS\", \"NICOLASA\", \"NICHOL\", \"NIA\", \"NAKISHA\", \"MEE\",\n    \"MAIRA\", \"LOREEN\", \"KIZZY\", \"JOHNNY\", \"JAY\", \"FALLON\", \"CHRISTENE\",\n    \"BOBBYE\", \"ANTHONY\", \"YING\", \"VINCENZA\", \"TANJA\", \"RUBIE\", \"RONI\",\n    \"QUEENIE\", \"MARGARETT\", \"KIMBERLI\", \"IRMGARD\", \"IDELL\", \"HILMA\",\n    \"EVELINA\", \"ESTA\", \"EMILEE\", \"DENNISE\", \"DANIA\", \"CARL\", \"CARIE\",\n    \"ANTONIO\", \"WAI\", \"SANG\", \"RISA\", \"RIKKI\", \"PARTICIA\", \"MUI\",\n    \"MASAKO\", \"MARIO\", \"LUVENIA\", \"LOREE\", \"LONI\", \"LIEN\", \"KEVIN\",\n    \"GIGI\", \"FLORENCIA\", \"DORIAN\", \"DENITA\", \"DALLAS\", \"CHI\", \"BILLYE\",\n    \"ALEXANDER\", \"TOMIKA\", \"SHARITA\", \"RANA\", \"NIKOLE\", \"NEOMA\",\n    \"MARGARITE\", \"MADALYN\", \"LUCINA\", \"LAILA\", \"KALI\", \"JENETTE\",\n    \"GABRIELE\", \"EVELYNE\", \"ELENORA\", \"CLEMENTINA\", \"ALEJANDRINA\",\n    \"ZULEMA\", \"VIOLETTE\", \"VANNESSA\", \"THRESA\", \"RETTA\", \"PIA\",\n    \"PATIENCE\", \"NOELLA\", \"NICKIE\", \"JONELL\", \"DELTA\", \"CHUNG\", \"CHAYA\",\n    \"CAMELIA\", \"BETHEL\", \"ANYA\", \"ANDREW\", \"THANH\", \"SUZANN\", \"SPRING\",\n    \"SHU\", \"MILA\", \"LILLA\", \"LAVERNA\", \"KEESHA\", \"KATTIE\", \"GIA\",\n    \"GEORGENE\", \"EVELINE\", \"ESTELL\", \"ELIZBETH\", \"VIVIENNE\", \"VALLIE\",\n    \"TRUDIE\", \"STEPHANE\", \"MICHEL\", \"MAGALY\", \"MADIE\", \"KENYETTA\",\n    \"KARREN\", \"JANETTA\", \"HERMINE\", \"HARMONY\", \"DRUCILLA\", \"DEBBI\",\n    \"CELESTINA\", \"CANDIE\", \"BRITNI\", \"BECKIE\", \"AMINA\", \"ZITA\", \"YUN\",\n    \"YOLANDE\", \"VIVIEN\", \"VERNETTA\", \"TRUDI\", \"SOMMER\", \"PEARLE\",\n    \"PATRINA\", \"OSSIE\", \"NICOLLE\", \"LOYCE\", \"LETTY\", \"LARISA\",\n    \"KATHARINA\", \"JOSELYN\", \"JONELLE\", \"JENELL\", \"IESHA\", \"HEIDE\",\n    \"FLORINDA\", \"FLORENTINA\", \"FLO\", \"ELODIA\", \"DORINE\", \"BRUNILDA\",\n    \"BRIGID\", \"ASHLI\", \"ARDELLA\", \"TWANA\", \"THU\", \"TARAH\", \"SUNG\",\n    \"SHEA\", \"SHAVON\", \"SHANE\", \"SERINA\", \"RAYNA\", \"RAMONITA\", \"NGA\",\n    \"MARGURITE\", \"LUCRECIA\", \"KOURTNEY\", \"KATI\", \"JESUS\", \"JESENIA\",\n    \"DIAMOND\", \"CRISTA\", \"AYANA\", \"ALICA\", \"ALIA\", \"VINNIE\", \"SUELLEN\",\n    \"ROMELIA\", \"RACHELL\", \"PIPER\", \"OLYMPIA\", \"MICHIKO\", \"KATHALEEN\",\n    \"JOLIE\", \"JESSI\", \"JANESSA\", \"HANA\", \"HA\", \"ELEASE\", \"CARLETTA\",\n    \"BRITANY\", \"SHONA\", \"SALOME\", \"ROSAMOND\", \"REGENA\", \"RAINA\", \"NGOC\",\n    \"NELIA\", \"LOUVENIA\", \"LESIA\", \"LATRINA\", \"LATICIA\", \"LARHONDA\",\n    \"JINA\", \"JACKI\", \"HOLLIS\", \"HOLLEY\", \"EMMY\", \"DEEANN\", \"CORETTA\",\n    \"ARNETTA\", \"VELVET\", \"THALIA\", \"SHANICE\", \"NETA\", \"MIKKI\", \"MICKI\",\n    \"LONNA\", \"LEANA\", \"LASHUNDA\", \"KILEY\", \"JOYE\", \"JACQULYN\",\n    \"IGNACIA\", \"HYUN\", \"HIROKO\", \"HENRY\", \"HENRIETTE\", \"ELAYNE\",\n    \"DELINDA\", \"DARNELL\", \"DAHLIA\", \"COREEN\", \"CONSUELA\", \"CONCHITA\",\n    \"CELINE\", \"BABETTE\", \"AYANNA\", \"ANETTE\", \"ALBERTINA\", \"SKYE\",\n    \"SHAWNEE\", \"SHANEKA\", \"QUIANA\", \"PAMELIA\", \"MIN\", \"MERRI\",\n    \"MERLENE\", \"MARGIT\", \"KIESHA\", \"KIERA\", \"KAYLENE\", \"JODEE\",\n    \"JENISE\", \"ERLENE\", \"EMMIE\", \"ELSE\", \"DARYL\", \"DALILA\", \"DAISEY\",\n    \"CODY\", \"CASIE\", \"BELIA\", \"BABARA\", \"VERSIE\", \"VANESA\", \"SHELBA\",\n    \"SHAWNDA\", \"SAM\", \"NORMAN\", \"NIKIA\", \"NAOMA\", \"MARNA\", \"MARGERET\",\n    \"MADALINE\", \"LAWANA\", \"KINDRA\", \"JUTTA\", \"JAZMINE\", \"JANETT\",\n    \"HANNELORE\", \"GLENDORA\", \"GERTRUD\", \"GARNETT\", \"FREEDA\",\n    \"FREDERICA\", \"FLORANCE\", \"FLAVIA\", \"DENNIS\", \"CARLINE\", \"BEVERLEE\",\n    \"ANJANETTE\", \"VALDA\", \"TRINITY\", \"TAMALA\", \"STEVIE\", \"SHONNA\",\n    \"SHA\", \"SARINA\", \"ONEIDA\", \"MICAH\", \"MERILYN\", \"MARLEEN\", \"LURLINE\",\n    \"LENNA\", \"KATHERIN\", \"JIN\", \"JENI\", \"HAE\", \"GRACIA\", \"GLADY\",\n    \"FARAH\", \"ERIC\", \"ENOLA\", \"EMA\", \"DOMINQUE\", \"DEVONA\", \"DELANA\",\n    \"CECILA\", \"CAPRICE\", \"ALYSHA\", \"ALI\", \"ALETHIA\", \"VENA\", \"THERESIA\",\n    \"TAWNY\", \"SONG\", \"SHAKIRA\", \"SAMARA\", \"SACHIKO\", \"RACHELE\",\n    \"PAMELLA\", \"NICKY\", \"MARNI\", \"MARIEL\", \"MAREN\", \"MALISA\", \"LIGIA\",\n    \"LERA\", \"LATORIA\", \"LARAE\", \"KIMBER\", \"KATHERN\", \"KAREY\",\n    \"JENNEFER\", \"JANETH\", \"HALINA\", \"FREDIA\", \"DELISA\", \"DEBROAH\",\n    \"CIERA\", \"CHIN\", \"ANGELIKA\", \"ANDREE\", \"ALTHA\", \"YEN\", \"VIVAN\",\n    \"TERRESA\", \"TANNA\", \"SUK\", \"SUDIE\", \"SOO\", \"SIGNE\", \"SALENA\",\n    \"RONNI\", \"REBBECCA\", \"MYRTIE\", \"MCKENZIE\", \"MALIKA\", \"MAIDA\",\n    \"LOAN\", \"LEONARDA\", \"KAYLEIGH\", \"FRANCE\", \"ETHYL\", \"ELLYN\", \"DAYLE\",\n    \"CAMMIE\", \"BRITTNI\", \"BIRGIT\", \"AVELINA\", \"ASUNCION\", \"ARIANNA\",\n    \"AKIKO\", \"VENICE\", \"TYESHA\", \"TONIE\", \"TIESHA\", \"TAKISHA\",\n    \"STEFFANIE\", \"SINDY\", \"SANTANA\", \"MEGHANN\", \"MANDA\", \"MACIE\",\n    \"LADY\", \"KELLYE\", \"KELLEE\", \"JOSLYN\", \"JASON\", \"INGER\", \"INDIRA\",\n    \"GLINDA\", \"GLENNIS\", \"FERNANDA\", \"FAUSTINA\", \"ENEIDA\", \"ELICIA\",\n    \"DOT\", \"DIGNA\", \"DELL\", \"ARLETTA\", \"ANDRE\", \"WILLIA\", \"TAMMARA\",\n    \"TABETHA\", \"SHERRELL\", \"SARI\", \"REFUGIO\", \"REBBECA\", \"PAULETTA\",\n    \"NIEVES\", \"NATOSHA\", \"NAKITA\", \"MAMMIE\", \"KENISHA\", \"KAZUKO\",\n    \"KASSIE\", \"GARY\", \"EARLEAN\", \"DAPHINE\", \"CORLISS\", \"CLOTILDE\",\n    \"CAROLYNE\", \"BERNETTA\", \"AUGUSTINA\", \"AUDREA\", \"ANNIS\", \"ANNABELL\",\n    \"YAN\", \"TENNILLE\", \"TAMICA\", \"SELENE\", \"SEAN\", \"ROSANA\", \"REGENIA\",\n    \"QIANA\", \"MARKITA\", \"MACY\", \"LEEANNE\", \"LAURINE\", \"KYM\", \"JESSENIA\",\n    \"JANITA\", \"GEORGINE\", \"GENIE\", \"EMIKO\", \"ELVIE\", \"DEANDRA\",\n    \"DAGMAR\", \"CORIE\", \"COLLEN\", \"CHERISH\", \"ROMAINE\", \"PORSHA\",\n    \"PEARLENE\", \"MICHELINE\", \"MERNA\", \"MARGORIE\", \"MARGARETTA\", \"LORE\",\n    \"KENNETH\", \"JENINE\", \"HERMINA\", \"FREDERICKA\", \"ELKE\", \"DRUSILLA\",\n    \"DORATHY\", \"DIONE\", \"DESIRE\", \"CELENA\", \"BRIGIDA\", \"ANGELES\",\n    \"ALLEGRA\", \"THEO\", \"TAMEKIA\", \"SYNTHIA\", \"STEPHEN\", \"SOOK\",\n    \"SLYVIA\", \"ROSANN\", \"REATHA\", \"RAYE\", \"MARQUETTA\", \"MARGART\",\n    \"LING\", \"LAYLA\", \"KYMBERLY\", \"KIANA\", \"KAYLEEN\", \"KATLYN\", \"KARMEN\",\n    \"JOELLA\", \"IRINA\", \"EMELDA\", \"ELENI\", \"DETRA\", \"CLEMMIE\", \"CHERYLL\",\n    \"CHANTELL\", \"CATHEY\", \"ARNITA\", \"ARLA\", \"ANGLE\", \"ANGELIC\", \"ALYSE\",\n    \"ZOFIA\", \"THOMASINE\", \"TENNIE\", \"SON\", \"SHERLY\", \"SHERLEY\",\n    \"SHARYL\", \"REMEDIOS\", \"PETRINA\", \"NICKOLE\", \"MYUNG\", \"MYRLE\",\n    \"MOZELLA\", \"LOUANNE\", \"LISHA\", \"LATIA\", \"LANE\", \"KRYSTA\",\n    \"JULIENNE\", \"JOEL\", \"JEANENE\", \"JACQUALINE\", \"ISAURA\", \"GWENDA\",\n    \"EARLEEN\", \"DONALD\", \"CLEOPATRA\", \"CARLIE\", \"AUDIE\", \"ANTONIETTA\",\n    \"ALISE\", \"ALEX\", \"VERDELL\", \"VAL\", \"TYLER\", \"TOMOKO\", \"THAO\",\n    \"TALISHA\", \"STEVEN\", \"SO\", \"SHEMIKA\", \"SHAUN\", \"SCARLET\", \"SAVANNA\",\n    \"SANTINA\", \"ROSIA\", \"RAEANN\", \"ODILIA\", \"NANA\", \"MINNA\", \"MAGAN\",\n    \"LYNELLE\", \"LE\", \"KARMA\", \"JOEANN\", \"IVANA\", \"INELL\", \"ILANA\",\n    \"HYE\", \"HONEY\", \"HEE\", \"GUDRUN\", \"FRANK\", \"DREAMA\", \"CRISSY\",\n    \"CHANTE\", \"CARMELINA\", \"ARVILLA\", \"ARTHUR\", \"ANNAMAE\", \"ALVERA\",\n    \"ALEIDA\", \"AARON\", \"YEE\", \"YANIRA\", \"VANDA\", \"TIANNA\", \"TAM\",\n    \"STEFANIA\", \"SHIRA\", \"PERRY\", \"NICOL\", \"NANCIE\", \"MONSERRATE\",\n    \"MINH\", \"MELYNDA\", \"MELANY\", \"MATTHEW\", \"LOVELLA\", \"LAURE\", \"KIRBY\",\n    \"KACY\", \"JACQUELYNN\", \"HYON\", \"GERTHA\", \"FRANCISCO\", \"ELIANA\",\n    \"CHRISTENA\", \"CHRISTEEN\", \"CHARISE\", \"CATERINA\", \"CARLEY\",\n    \"CANDYCE\", \"ARLENA\", \"AMMIE\", \"YANG\", \"WILLETTE\", \"VANITA\", \"TUYET\",\n    \"TINY\", \"SYREETA\", \"SILVA\", \"SCOTT\", \"RONALD\", \"PENNEY\", \"NYLA\",\n    \"MICHAL\", \"MAURICE\", \"MARYAM\", \"MARYA\", \"MAGEN\", \"LUDIE\", \"LOMA\",\n    \"LIVIA\", \"LANELL\", \"KIMBERLIE\", \"JULEE\", \"DONETTA\", \"DIEDRA\",\n    \"DENISHA\", \"DEANE\", \"DAWNE\", \"CLARINE\", \"CHERRYL\", \"BRONWYN\",\n    \"BRANDON\", \"ALLA\", \"VALERY\", \"TONDA\", \"SUEANN\", \"SORAYA\",\n    \"SHOSHANA\", \"SHELA\", \"SHARLEEN\", \"SHANELLE\", \"NERISSA\", \"MICHEAL\",\n    \"MERIDITH\", \"MELLIE\", \"MAYE\", \"MAPLE\", \"MAGARET\", \"LUIS\", \"LILI\",\n    \"LEONILA\", \"LEONIE\", \"LEEANNA\", \"LAVONIA\", \"LAVERA\", \"KRISTEL\",\n    \"KATHEY\", \"KATHE\", \"JUSTIN\", \"JULIAN\", \"JIMMY\", \"JANN\", \"ILDA\",\n    \"HILDRED\", \"HILDEGARDE\", \"GENIA\", \"FUMIKO\", \"EVELIN\", \"ERMELINDA\",\n    \"ELLY\", \"DUNG\", \"DOLORIS\", \"DIONNA\", \"DANAE\", \"BERNEICE\", \"ANNICE\",\n    \"ALIX\", \"VERENA\", \"VERDIE\", \"TRISTAN\", \"SHAWNNA\", \"SHAWANA\",\n    \"SHAUNNA\", \"ROZELLA\", \"RANDEE\", \"RANAE\", \"MILAGRO\", \"LYNELL\",\n    \"LUISE\", \"LOUIE\", \"LOIDA\", \"LISBETH\", \"KARLEEN\", \"JUNITA\", \"JONA\",\n    \"ISIS\", \"HYACINTH\", \"HEDY\", \"GWENN\", \"ETHELENE\", \"ERLINE\", \"EDWARD\",\n    \"DONYA\", \"DOMONIQUE\", \"DELICIA\", \"DANNETTE\", \"CICELY\", \"BRANDA\",\n    \"BLYTHE\", \"BETHANN\", \"ASHLYN\", \"ANNALEE\", \"ALLINE\", \"YUKO\", \"VELLA\",\n    \"TRANG\", \"TOWANDA\", \"TESHA\", \"SHERLYN\", \"NARCISA\", \"MIGUELINA\",\n    \"MERI\", \"MAYBELL\", \"MARLANA\", \"MARGUERITA\", \"MADLYN\", \"LUNA\",\n    \"LORY\", \"LORIANN\", \"LIBERTY\", \"LEONORE\", \"LEIGHANN\", \"LAURICE\",\n    \"LATESHA\", \"LARONDA\", \"KATRICE\", \"KASIE\", \"KARL\", \"KALEY\",\n    \"JADWIGA\", \"GLENNIE\", \"GEARLDINE\", \"FRANCINA\", \"EPIFANIA\", \"DYAN\",\n    \"DORIE\", \"DIEDRE\", \"DENESE\", \"DEMETRICE\", \"DELENA\", \"DARBY\",\n    \"CRISTIE\", \"CLEORA\", \"CATARINA\", \"CARISA\", \"BERNIE\", \"BARBERA\",\n    \"ALMETA\", \"TRULA\", \"TEREASA\", \"SOLANGE\", \"SHEILAH\", \"SHAVONNE\",\n    \"SANORA\", \"ROCHELL\", \"MATHILDE\", \"MARGARETA\", \"MAIA\", \"LYNSEY\",\n    \"LAWANNA\", \"LAUNA\", \"KENA\", \"KEENA\", \"KATIA\", \"JAMEY\", \"GLYNDA\",\n    \"GAYLENE\", \"ELVINA\", \"ELANOR\", \"DANUTA\", \"DANIKA\", \"CRISTEN\",\n    \"CORDIE\", \"COLETTA\", \"CLARITA\", \"CARMON\", \"BRYNN\", \"AZUCENA\",\n    \"AUNDREA\", \"ANGELE\", \"YI\", \"WALTER\", \"VERLIE\", \"VERLENE\", \"TAMESHA\",\n    \"SILVANA\", \"SEBRINA\", \"SAMIRA\", \"REDA\", \"RAYLENE\", \"PENNI\",\n    \"PANDORA\", \"NORAH\", \"NOMA\", \"MIREILLE\", \"MELISSIA\", \"MARYALICE\",\n    \"LARAINE\", \"KIMBERY\", \"KARYL\", \"KARINE\", \"KAM\", \"JOLANDA\", \"JOHANA\",\n    \"JESUSA\", \"JALEESA\", \"JAE\", \"JACQUELYNE\", \"IRISH\", \"ILUMINADA\",\n    \"HILARIA\", \"HANH\", \"GENNIE\", \"FRANCIE\", \"FLORETTA\", \"EXIE\", \"EDDA\",\n    \"DREMA\", \"DELPHA\", \"BEV\", \"BARBAR\", \"ASSUNTA\", \"ARDELL\", \"ANNALISA\",\n    \"ALISIA\", \"YUKIKO\", \"YOLANDO\", \"WONDA\", \"WEI\", \"WALTRAUD\", \"VETA\",\n    \"TEQUILA\", \"TEMEKA\", \"TAMEIKA\", \"SHIRLEEN\", \"SHENITA\", \"PIEDAD\",\n    \"OZELLA\", \"MIRTHA\", \"MARILU\", \"KIMIKO\", \"JULIANE\", \"JENICE\", \"JEN\",\n    \"JANAY\", \"JACQUILINE\", \"HILDE\", \"FE\", \"FAE\", \"EVAN\", \"EUGENE\",\n    \"ELOIS\", \"ECHO\", \"DEVORAH\", \"CHAU\", \"BRINDA\", \"BETSEY\", \"ARMINDA\",\n    \"ARACELIS\", \"APRYL\", \"ANNETT\", \"ALISHIA\", \"VEOLA\", \"USHA\",\n    \"TOSHIKO\", \"THEOLA\", \"TASHIA\", \"TALITHA\", \"SHERY\", \"RUDY\",\n    \"RENETTA\", \"REIKO\", \"RASHEEDA\", \"OMEGA\", \"OBDULIA\", \"MIKA\",\n    \"MELAINE\", \"MEGGAN\", \"MARTIN\", \"MARLEN\", \"MARGET\", \"MARCELINE\",\n    \"MANA\", \"MAGDALEN\", \"LIBRADA\", \"LEZLIE\", \"LEXIE\", \"LATASHIA\",\n    \"LASANDRA\", \"KELLE\", \"ISIDRA\", \"ISA\", \"INOCENCIA\", \"GWYN\",\n    \"FRANCOISE\", \"ERMINIA\", \"ERINN\", \"DIMPLE\", \"DEVORA\", \"CRISELDA\",\n    \"ARMANDA\", \"ARIE\", \"ARIANE\", \"ANGELO\", \"ANGELENA\", \"ALLEN\", \"ALIZA\",\n    \"ADRIENE\", \"ADALINE\", \"XOCHITL\", \"TWANNA\", \"TRAN\", \"TOMIKO\",\n    \"TAMISHA\", \"TAISHA\", \"SUSY\", \"SIU\", \"RUTHA\", \"ROXY\", \"RHONA\",\n    \"RAYMOND\", \"OTHA\", \"NORIKO\", \"NATASHIA\", \"MERRIE\", \"MELVIN\",\n    \"MARINDA\", \"MARIKO\", \"MARGERT\", \"LORIS\", \"LIZZETTE\", \"LEISHA\",\n    \"KAILA\", \"KA\", \"JOANNIE\", \"JERRICA\", \"JENE\", \"JANNET\", \"JANEE\",\n    \"JACINDA\", \"HERTA\", \"ELENORE\", \"DORETTA\", \"DELAINE\", \"DANIELL\",\n    \"CLAUDIE\", \"CHINA\", \"BRITTA\", \"APOLONIA\", \"AMBERLY\", \"ALEASE\",\n    \"YURI\", \"YUK\", \"WEN\", \"WANETA\", \"UTE\", \"TOMI\", \"SHARRI\", \"SANDIE\",\n    \"ROSELLE\", \"REYNALDA\", \"RAGUEL\", \"PHYLICIA\", \"PATRIA\", \"OLIMPIA\",\n    \"ODELIA\", \"MITZIE\", \"MITCHELL\", \"MISS\", \"MINDA\", \"MIGNON\", \"MICA\",\n    \"MENDY\", \"MARIVEL\", \"MAILE\", \"LYNETTA\", \"LAVETTE\", \"LAURYN\",\n    \"LATRISHA\", \"LAKIESHA\", \"KIERSTEN\", \"KARY\", \"JOSPHINE\", \"JOLYN\",\n    \"JETTA\", \"JANISE\", \"JACQUIE\", \"IVELISSE\", \"GLYNIS\", \"GIANNA\",\n    \"GAYNELLE\", \"EMERALD\", \"DEMETRIUS\", \"DANYELL\", \"DANILLE\", \"DACIA\",\n    \"CORALEE\", \"CHER\", \"CEOLA\", \"BRETT\", \"BELL\", \"ARIANNE\", \"ALESHIA\",\n    \"YUNG\", \"WILLIEMAE\", \"TROY\", \"TRINH\", \"THORA\", \"TAI\", \"SVETLANA\",\n    \"SHERIKA\", \"SHEMEKA\", \"SHAUNDA\", \"ROSELINE\", \"RICKI\", \"MELDA\",\n    \"MALLIE\", \"LAVONNA\", \"LATINA\", \"LARRY\", \"LAQUANDA\", \"LALA\",\n    \"LACHELLE\", \"KLARA\", \"KANDIS\", \"JOHNA\", \"JEANMARIE\", \"JAYE\", \"HANG\",\n    \"GRAYCE\", \"GERTUDE\", \"EMERITA\", \"EBONIE\", \"CLORINDA\", \"CHING\",\n    \"CHERY\", \"CAROLA\", \"BREANN\", \"BLOSSOM\", \"BERNARDINE\", \"BECKI\",\n    \"ARLETHA\", \"ARGELIA\", \"ARA\", \"ALITA\", \"YULANDA\", \"YON\", \"YESSENIA\",\n    \"TOBI\", \"TASIA\", \"SYLVIE\", \"SHIRL\", \"SHIRELY\", \"SHERIDAN\", \"SHELLA\",\n    \"SHANTELLE\", \"SACHA\", \"ROYCE\", \"REBECKA\", \"REAGAN\", \"PROVIDENCIA\",\n    \"PAULENE\", \"MISHA\", \"MIKI\", \"MARLINE\", \"MARICA\", \"LORITA\",\n    \"LATOYIA\", \"LASONYA\", \"KERSTIN\", \"KENDA\", \"KEITHA\", \"KATHRIN\",\n    \"JAYMIE\", \"JACK\", \"GRICELDA\", \"GINETTE\", \"ERYN\", \"ELINA\",\n    \"ELFRIEDA\", \"DANYEL\", \"CHEREE\", \"CHANELLE\", \"BARRIE\", \"AVERY\",\n    \"AURORE\", \"ANNAMARIA\", \"ALLEEN\", \"AILENE\", \"AIDE\", \"YASMINE\",\n    \"VASHTI\", \"VALENTINE\", \"TREASA\", \"TORY\", \"TIFFANEY\", \"SHERYLL\",\n    \"SHARIE\", \"SHANAE\", \"SAU\", \"RAISA\", \"PA\", \"NEDA\", \"MITSUKO\",\n    \"MIRELLA\", \"MILDA\", \"MARYANNA\", \"MARAGRET\", \"MABELLE\", \"LUETTA\",\n    \"LORINA\", \"LETISHA\", \"LATARSHA\", \"LANELLE\", \"LAJUANA\", \"KRISSY\",\n    \"KARLY\", \"KARENA\", \"JON\", \"JESSIKA\", \"JERICA\", \"JEANELLE\",\n    \"JANUARY\", \"JALISA\", \"JACELYN\", \"IZOLA\", \"IVEY\", \"GREGORY\", \"EUNA\",\n    \"ETHA\", \"DREW\", \"DOMITILA\", \"DOMINICA\", \"DAINA\", \"CREOLA\", \"CARLI\",\n    \"CAMIE\", \"BUNNY\", \"BRITTNY\", \"ASHANTI\", \"ANISHA\", \"ALEEN\", \"ADAH\",\n    \"YASUKO\", \"WINTER\", \"VIKI\", \"VALRIE\", \"TONA\", \"TINISHA\", \"THI\",\n    \"TERISA\", \"TATUM\", \"TANEKA\", \"SIMONNE\", \"SHALANDA\", \"SERITA\",\n    \"RESSIE\", \"REFUGIA\", \"PAZ\", \"OLENE\", \"NA\", \"MERRILL\", \"MARGHERITA\",\n    \"MANDIE\", \"MAN\", \"MAIRE\", \"LYNDIA\", \"LUCI\", \"LORRIANE\", \"LORETA\",\n    \"LEONIA\", \"LAVONA\", \"LASHAWNDA\", \"LAKIA\", \"KYOKO\", \"KRYSTINA\",\n    \"KRYSTEN\", \"KENIA\", \"KELSI\", \"JUDE\", \"JEANICE\", \"ISOBEL\",\n    \"GEORGIANN\", \"GENNY\", \"FELICIDAD\", \"EILENE\", \"DEON\", \"DELOISE\",\n    \"DEEDEE\", \"DANNIE\", \"CONCEPTION\", \"CLORA\", \"CHERILYN\", \"CHANG\",\n    \"CALANDRA\", \"BERRY\", \"ARMANDINA\", \"ANISA\", \"ULA\", \"TIMOTHY\",\n    \"TIERA\", \"THERESSA\", \"STEPHANIA\", \"SIMA\", \"SHYLA\", \"SHONTA\",\n    \"SHERA\", \"SHAQUITA\", \"SHALA\", \"SAMMY\", \"ROSSANA\", \"NOHEMI\", \"NERY\",\n    \"MORIAH\", \"MELITA\", \"MELIDA\", \"MELANI\", \"MARYLYNN\", \"MARISHA\",\n    \"MARIETTE\", \"MALORIE\", \"MADELENE\", \"LUDIVINA\", \"LORIA\", \"LORETTE\",\n    \"LORALEE\", \"LIANNE\", \"LEON\", \"LAVENIA\", \"LAURINDA\", \"LASHON\", \"KIT\",\n    \"KIMI\", \"KEILA\", \"KATELYNN\", \"KAI\", \"JONE\", \"JOANE\", \"JI\", \"JAYNA\",\n    \"JANELLA\", \"JA\", \"HUE\", \"HERTHA\", \"FRANCENE\", \"ELINORE\", \"DESPINA\",\n    \"DELSIE\", \"DEEDRA\", \"CLEMENCIA\", \"CARRY\", \"CAROLIN\", \"CARLOS\",\n    \"BULAH\", \"BRITTANIE\", \"BOK\", \"BLONDELL\", \"BIBI\", \"BEAULAH\", \"BEATA\",\n    \"ANNITA\", \"AGRIPINA\", \"VIRGEN\", \"VALENE\", \"UN\", \"TWANDA\", \"TOMMYE\",\n    \"TOI\", \"TARRA\", \"TARI\", \"TAMMERA\", \"SHAKIA\", \"SADYE\", \"RUTHANNE\",\n    \"ROCHEL\", \"RIVKA\", \"PURA\", \"NENITA\", \"NATISHA\", \"MING\", \"MERRILEE\",\n    \"MELODEE\", \"MARVIS\", \"LUCILLA\", \"LEENA\", \"LAVETA\", \"LARITA\",\n    \"LANIE\", \"KEREN\", \"ILEEN\", \"GEORGEANN\", \"GENNA\", \"GENESIS\", \"FRIDA\",\n    \"EWA\", \"EUFEMIA\", \"EMELY\", \"ELA\", \"EDYTH\", \"DEONNA\", \"DEADRA\",\n    \"DARLENA\", \"CHANELL\", \"CHAN\", \"CATHERN\", \"CASSONDRA\", \"CASSAUNDRA\",\n    \"BERNARDA\", \"BERNA\", \"ARLINDA\", \"ANAMARIA\", \"ALBERT\", \"WESLEY\",\n    \"VERTIE\", \"VALERI\", \"TORRI\", \"TATYANA\", \"STASIA\", \"SHERISE\",\n    \"SHERILL\", \"SEASON\", \"SCOTTIE\", \"SANDA\", \"RUTHE\", \"ROSY\", \"ROBERTO\",\n    \"ROBBI\", \"RANEE\", \"QUYEN\", \"PEARLY\", \"PALMIRA\", \"ONITA\", \"NISHA\",\n    \"NIESHA\", \"NIDA\", \"NEVADA\", \"NAM\", \"MERLYN\", \"MAYOLA\", \"MARYLOUISE\",\n    \"MARYLAND\", \"MARX\", \"MARTH\", \"MARGENE\", \"MADELAINE\", \"LONDA\",\n    \"LEONTINE\", \"LEOMA\", \"LEIA\", \"LAWRENCE\", \"LAURALEE\", \"LANORA\",\n    \"LAKITA\", \"KIYOKO\", \"KETURAH\", \"KATELIN\", \"KAREEN\", \"JONIE\",\n    \"JOHNETTE\", \"JENEE\", \"JEANETT\", \"IZETTA\", \"HIEDI\", \"HEIKE\",\n    \"HASSIE\", \"HAROLD\", \"GIUSEPPINA\", \"GEORGANN\", \"FIDELA\", \"FERNANDE\",\n    \"ELWANDA\", \"ELLAMAE\", \"ELIZ\", \"DUSTI\", \"DOTTY\", \"CYNDY\", \"CORALIE\",\n    \"CELESTA\", \"ARGENTINA\", \"ALVERTA\", \"XENIA\", \"WAVA\", \"VANETTA\",\n    \"TORRIE\", \"TASHINA\", \"TANDY\", \"TAMBRA\", \"TAMA\", \"STEPANIE\", \"SHILA\",\n    \"SHAUNTA\", \"SHARAN\", \"SHANIQUA\", \"SHAE\", \"SETSUKO\", \"SERAFINA\",\n    \"SANDEE\", \"ROSAMARIA\", \"PRISCILA\", \"OLINDA\", \"NADENE\", \"MUOI\",\n    \"MICHELINA\", \"MERCEDEZ\", \"MARYROSE\", \"MARIN\", \"MARCENE\", \"MAO\",\n    \"MAGALI\", \"MAFALDA\", \"LOGAN\", \"LINN\", \"LANNIE\", \"KAYCE\", \"KAROLINE\",\n    \"KAMILAH\", \"KAMALA\", \"JUSTA\", \"JOLINE\", \"JENNINE\", \"JACQUETTA\",\n    \"IRAIDA\", \"GERALD\", \"GEORGEANNA\", \"FRANCHESCA\", \"FAIRY\", \"EMELINE\",\n    \"ELANE\", \"EHTEL\", \"EARLIE\", \"DULCIE\", \"DALENE\", \"CRIS\", \"CLASSIE\",\n    \"CHERE\", \"CHARIS\", \"CAROYLN\", \"CARMINA\", \"CARITA\", \"BRIAN\",\n    \"BETHANIE\", \"AYAKO\", \"ARICA\", \"AN\", \"ALYSA\", \"ALESSANDRA\", \"AKILAH\",\n    \"ADRIEN\", \"ZETTA\", \"YOULANDA\", \"YELENA\", \"YAHAIRA\", \"XUAN\",\n    \"WENDOLYN\", \"VICTOR\", \"TIJUANA\", \"TERRELL\", \"TERINA\", \"TERESIA\",\n    \"SUZI\", \"SUNDAY\", \"SHERELL\", \"SHAVONDA\", \"SHAUNTE\", \"SHARDA\",\n    \"SHAKITA\", \"SENA\", \"RYANN\", \"RUBI\", \"RIVA\", \"REGINIA\", \"REA\",\n    \"RACHAL\", \"PARTHENIA\", \"PAMULA\", \"MONNIE\", \"MONET\", \"MICHAELE\",\n    \"MELIA\", \"MARINE\", \"MALKA\", \"MAISHA\", \"LISANDRA\", \"LEO\", \"LEKISHA\",\n    \"LEAN\", \"LAURENCE\", \"LAKENDRA\", \"KRYSTIN\", \"KORTNEY\", \"KIZZIE\",\n    \"KITTIE\", \"KERA\", \"KENDAL\", \"KEMBERLY\", \"KANISHA\", \"JULENE\", \"JULE\",\n    \"JOSHUA\", \"JOHANNE\", \"JEFFREY\", \"JAMEE\", \"HAN\", \"HALLEY\", \"GIDGET\",\n    \"GALINA\", \"FREDRICKA\", \"FLETA\", \"FATIMAH\", \"EUSEBIA\", \"ELZA\",\n    \"ELEONORE\", \"DORTHEY\", \"DORIA\", \"DONELLA\", \"DINORAH\", \"DELORSE\",\n    \"CLARETHA\", \"CHRISTINIA\", \"CHARLYN\", \"BONG\", \"BELKIS\", \"AZZIE\",\n    \"ANDERA\", \"AIKO\", \"ADENA\", \"YER\", \"YAJAIRA\", \"WAN\", \"VANIA\",\n    \"ULRIKE\", \"TOSHIA\", \"TIFANY\", \"STEFANY\", \"SHIZUE\", \"SHENIKA\",\n    \"SHAWANNA\", \"SHAROLYN\", \"SHARILYN\", \"SHAQUANA\", \"SHANTAY\", \"SEE\",\n    \"ROZANNE\", \"ROSELEE\", \"RICKIE\", \"REMONA\", \"REANNA\", \"RAELENE\",\n    \"QUINN\", \"PHUNG\", \"PETRONILA\", \"NATACHA\", \"NANCEY\", \"MYRL\",\n    \"MIYOKO\", \"MIESHA\", \"MERIDETH\", \"MARVELLA\", \"MARQUITTA\", \"MARHTA\",\n    \"MARCHELLE\", \"LIZETH\", \"LIBBIE\", \"LAHOMA\", \"LADAWN\", \"KINA\",\n    \"KATHELEEN\", \"KATHARYN\", \"KARISA\", \"KALEIGH\", \"JUNIE\", \"JULIEANN\",\n    \"JOHNSIE\", \"JANEAN\", \"JAIMEE\", \"JACKQUELINE\", \"HISAKO\", \"HERMA\",\n    \"HELAINE\", \"GWYNETH\", \"GLENN\", \"GITA\", \"EUSTOLIA\", \"EMELINA\",\n    \"ELIN\", \"EDRIS\", \"DONNETTE\", \"DONNETTA\", \"DIERDRE\", \"DENAE\",\n    \"DARCEL\", \"CLAUDE\", \"CLARISA\", \"CINDERELLA\", \"CHIA\", \"CHARLESETTA\",\n    \"CHARITA\", \"CELSA\", \"CASSY\", \"CASSI\", \"CARLEE\", \"BRUNA\",\n    \"BRITTANEY\", \"BRANDE\", \"BILLI\", \"BAO\", \"ANTONETTA\", \"ANGLA\",\n    \"ANGELYN\", \"ANALISA\", \"ALANE\", \"WENONA\", \"WENDIE\", \"VERONIQUE\",\n    \"VANNESA\", \"TOBIE\", \"TEMPIE\", \"SUMIKO\", \"SULEMA\", \"SPARKLE\",\n    \"SOMER\", \"SHEBA\", \"SHAYNE\", \"SHARICE\", \"SHANEL\", \"SHALON\", \"SAGE\",\n    \"ROY\", \"ROSIO\", \"ROSELIA\", \"RENAY\", \"REMA\", \"REENA\", \"PORSCHE\",\n    \"PING\", \"PEG\", \"OZIE\", \"ORETHA\", \"ORALEE\", \"ODA\", \"NU\", \"NGAN\",\n    \"NAKESHA\", \"MILLY\", \"MARYBELLE\", \"MARLIN\", \"MARIS\", \"MARGRETT\",\n    \"MARAGARET\", \"MANIE\", \"LURLENE\", \"LILLIA\", \"LIESELOTTE\", \"LAVELLE\",\n    \"LASHAUNDA\", \"LAKEESHA\", \"KEITH\", \"KAYCEE\", \"KALYN\", \"JOYA\",\n    \"JOETTE\", \"JENAE\", \"JANIECE\", \"ILLA\", \"GRISEL\", \"GLAYDS\", \"GENEVIE\",\n    \"GALA\", \"FREDDA\", \"FRED\", \"ELMER\", \"ELEONOR\", \"DEBERA\", \"DEANDREA\",\n    \"DAN\", \"CORRINNE\", \"CORDIA\", \"CONTESSA\", \"COLENE\", \"CLEOTILDE\",\n    \"CHARLOTT\", \"CHANTAY\", \"CECILLE\", \"BEATRIS\", \"AZALEE\", \"ARLEAN\",\n    \"ARDATH\", \"ANJELICA\", \"ANJA\", \"ALFREDIA\", \"ALEISHA\", \"ADAM\", \"ZADA\",\n    \"YUONNE\", \"XIAO\", \"WILLODEAN\", \"WHITLEY\", \"VENNIE\", \"VANNA\",\n    \"TYISHA\", \"TOVA\", \"TORIE\", \"TONISHA\", \"TILDA\", \"TIEN\", \"TEMPLE\",\n    \"SIRENA\", \"SHERRIL\", \"SHANTI\", \"SHAN\", \"SENAIDA\", \"SAMELLA\",\n    \"ROBBYN\", \"RENDA\", \"REITA\", \"PHEBE\", \"PAULITA\", \"NOBUKO\", \"NGUYET\",\n    \"NEOMI\", \"MOON\", \"MIKAELA\", \"MELANIA\", \"MAXIMINA\", \"MARG\", \"MAISIE\",\n    \"LYNNA\", \"LILLI\", \"LAYNE\", \"LASHAUN\", \"LAKENYA\", \"LAEL\", \"KIRSTIE\",\n    \"KATHLINE\", \"KASHA\", \"KARLYN\", \"KARIMA\", \"JOVAN\", \"JOSEFINE\",\n    \"JENNELL\", \"JACQUI\", \"JACKELYN\", \"HYO\", \"HIEN\", \"GRAZYNA\",\n    \"FLORRIE\", \"FLORIA\", \"ELEONORA\", \"DWANA\", \"DORLA\", \"DONG\", \"DELMY\",\n    \"DEJA\", \"DEDE\", \"DANN\", \"CRYSTA\", \"CLELIA\", \"CLARIS\", \"CLARENCE\",\n    \"CHIEKO\", \"CHERLYN\", \"CHERELLE\", \"CHARMAIN\", \"CHARA\", \"CAMMY\",\n    \"BEE\", \"ARNETTE\", \"ARDELLE\", \"ANNIKA\", \"AMIEE\", \"AMEE\", \"ALLENA\",\n    \"YVONE\", \"YUKI\", \"YOSHIE\", \"YEVETTE\", \"YAEL\", \"WILLETTA\", \"VONCILE\",\n    \"VENETTA\", \"TULA\", \"TONETTE\", \"TIMIKA\", \"TEMIKA\", \"TELMA\", \"TEISHA\",\n    \"TAREN\", \"TA\", \"STACEE\", \"SHIN\", \"SHAWNTA\", \"SATURNINA\", \"RICARDA\",\n    \"POK\", \"PASTY\", \"ONIE\", \"NUBIA\", \"MORA\", \"MIKE\", \"MARIELLE\",\n    \"MARIELLA\", \"MARIANELA\", \"MARDELL\", \"MANY\", \"LUANNA\", \"LOISE\",\n    \"LISABETH\", \"LINDSY\", \"LILLIANA\", \"LILLIAM\", \"LELAH\", \"LEIGHA\",\n    \"LEANORA\", \"LANG\", \"KRISTEEN\", \"KHALILAH\", \"KEELEY\", \"KANDRA\",\n    \"JUNKO\", \"JOAQUINA\", \"JERLENE\", \"JANI\", \"JAMIKA\", \"JAME\", \"HSIU\",\n    \"HERMILA\", \"GOLDEN\", \"GENEVIVE\", \"EVIA\", \"EUGENA\", \"EMMALINE\",\n    \"ELFREDA\", \"ELENE\", \"DONETTE\", \"DELCIE\", \"DEEANNA\", \"DARCEY\", \"CUC\",\n    \"CLARINDA\", \"CIRA\", \"CHAE\", \"CELINDA\", \"CATHERYN\", \"CATHERIN\",\n    \"CASIMIRA\", \"CARMELIA\", \"CAMELLIA\", \"BREANA\", \"BOBETTE\",\n    \"BERNARDINA\", \"BEBE\", \"BASILIA\", \"ARLYNE\", \"AMAL\", \"ALAYNA\",\n    \"ZONIA\", \"ZENIA\", \"YURIKO\", \"YAEKO\", \"WYNELL\", \"WILLOW\", \"WILLENA\",\n    \"VERNIA\", \"TU\", \"TRAVIS\", \"TORA\", \"TERRILYN\", \"TERICA\", \"TENESHA\",\n    \"TAWNA\", \"TAJUANA\", \"TAINA\", \"STEPHNIE\", \"SONA\", \"SOL\", \"SINA\",\n    \"SHONDRA\", \"SHIZUKO\", \"SHERLENE\", \"SHERICE\", \"SHARIKA\", \"ROSSIE\",\n    \"ROSENA\", \"RORY\", \"RIMA\", \"RIA\", \"RHEBA\", \"RENNA\", \"PETER\",\n    \"NATALYA\", \"NANCEE\", \"MELODI\", \"MEDA\", \"MAXIMA\", \"MATHA\",\n    \"MARKETTA\", \"MARICRUZ\", \"MARCELENE\", \"MALVINA\", \"LUBA\", \"LOUETTA\",\n    \"LEIDA\", \"LECIA\", \"LAURAN\", \"LASHAWNA\", \"LAINE\", \"KHADIJAH\",\n    \"KATERINE\", \"KASI\", \"KALLIE\", \"JULIETTA\", \"JESUSITA\", \"JESTINE\",\n    \"JESSIA\", \"JEREMY\", \"JEFFIE\", \"JANYCE\", \"ISADORA\", \"GEORGIANNE\",\n    \"FIDELIA\", \"EVITA\", \"EURA\", \"EULAH\", \"ESTEFANA\", \"ELSY\", \"ELIZABET\",\n    \"ELADIA\", \"DODIE\", \"DION\", \"DIA\", \"DENISSE\", \"DELORAS\", \"DELILA\",\n    \"DAYSI\", \"DAKOTA\", \"CURTIS\", \"CRYSTLE\", \"CONCHA\", \"COLBY\",\n    \"CLARETTA\", \"CHU\", \"CHRISTIA\", \"CHARLSIE\", \"CHARLENA\", \"CARYLON\",\n    \"BETTYANN\", \"ASLEY\", \"ASHLEA\", \"AMIRA\", \"AI\", \"AGUEDA\", \"AGNUS\",\n    \"YUETTE\", \"VINITA\", \"VICTORINA\", \"TYNISHA\", \"TREENA\", \"TOCCARA\",\n    \"TISH\", \"THOMASENA\", \"TEGAN\", \"SOILA\", \"SHILOH\", \"SHENNA\",\n    \"SHARMAINE\", \"SHANTAE\", \"SHANDI\", \"SEPTEMBER\", \"SARAN\", \"SARAI\",\n    \"SANA\", \"SAMUEL\", \"SALLEY\", \"ROSETTE\", \"ROLANDE\", \"REGINE\",\n    \"OTELIA\", \"OSCAR\", \"OLEVIA\", \"NICHOLLE\", \"NECOLE\", \"NAIDA\", \"MYRTA\",\n    \"MYESHA\", \"MITSUE\", \"MINTA\", \"MERTIE\", \"MARGY\", \"MAHALIA\",\n    \"MADALENE\", \"LOVE\", \"LOURA\", \"LOREAN\", \"LEWIS\", \"LESHA\", \"LEONIDA\",\n    \"LENITA\", \"LAVONE\", \"LASHELL\", \"LASHANDRA\", \"LAMONICA\", \"KIMBRA\",\n    \"KATHERINA\", \"KARRY\", \"KANESHA\", \"JULIO\", \"JONG\", \"JENEVA\",\n    \"JAQUELYN\", \"HWA\", \"GILMA\", \"GHISLAINE\", \"GERTRUDIS\", \"FRANSISCA\",\n    \"FERMINA\", \"ETTIE\", \"ETSUKO\", \"ELLIS\", \"ELLAN\", \"ELIDIA\", \"EDRA\",\n    \"DORETHEA\", \"DOREATHA\", \"DENYSE\", \"DENNY\", \"DEETTA\", \"DAINE\",\n    \"CYRSTAL\", \"CORRIN\", \"CAYLA\", \"CARLITA\", \"CAMILA\", \"BURMA\", \"BULA\",\n    \"BUENA\", \"BLAKE\", \"BARABARA\", \"AVRIL\", \"AUSTIN\", \"ALAINE\", \"ZANA\",\n    \"WILHEMINA\", \"WANETTA\", \"VIRGIL\", \"VI\", \"VERONIKA\", \"VERNON\",\n    \"VERLINE\", \"VASILIKI\", \"TONITA\", \"TISA\", \"TEOFILA\", \"TAYNA\",\n    \"TAUNYA\", \"TANDRA\", \"TAKAKO\", \"SUNNI\", \"SUANNE\", \"SIXTA\", \"SHARELL\",\n    \"SEEMA\", \"RUSSELL\", \"ROSENDA\", \"ROBENA\", \"RAYMONDE\", \"PEI\",\n    \"PAMILA\", \"OZELL\", \"NEIDA\", \"NEELY\", \"MISTIE\", \"MICHA\", \"MERISSA\",\n    \"MAURITA\", \"MARYLN\", \"MARYETTA\", \"MARSHALL\", \"MARCELL\", \"MALENA\",\n    \"MAKEDA\", \"MADDIE\", \"LOVETTA\", \"LOURIE\", \"LORRINE\", \"LORILEE\",\n    \"LESTER\", \"LAURENA\", \"LASHAY\", \"LARRAINE\", \"LAREE\", \"LACRESHA\",\n    \"KRISTLE\", \"KRISHNA\", \"KEVA\", \"KEIRA\", \"KAROLE\", \"JOIE\", \"JINNY\",\n    \"JEANNETTA\", \"JAMA\", \"HEIDY\", \"GILBERTE\", \"GEMA\", \"FAVIOLA\",\n    \"EVELYNN\", \"ENDA\", \"ELLI\", \"ELLENA\", \"DIVINA\", \"DAGNY\", \"COLLENE\",\n    \"CODI\", \"CINDIE\", \"CHASSIDY\", \"CHASIDY\", \"CATRICE\", \"CATHERINA\",\n    \"CASSEY\", \"CAROLL\", \"CARLENA\", \"CANDRA\", \"CALISTA\", \"BRYANNA\",\n    \"BRITTENY\", \"BEULA\", \"BARI\", \"AUDRIE\", \"AUDRIA\", \"ARDELIA\",\n    \"ANNELLE\", \"ANGILA\", \"ALONA\", \"ALLYN\", \"DOUGLAS\", \"ROGER\",\n    \"JONATHAN\", \"RALPH\", \"NICHOLAS\", \"BENJAMIN\", \"BRUCE\", \"HARRY\",\n    \"WAYNE\", \"STEVE\", \"HOWARD\", \"ERNEST\", \"PHILLIP\", \"TODD\", \"CRAIG\",\n    \"ALAN\", \"PHILIP\", \"EARL\", \"DANNY\", \"BRYAN\", \"STANLEY\", \"LEONARD\",\n    \"NATHAN\", \"MANUEL\", \"RODNEY\", \"MARVIN\", \"VINCENT\", \"JEFFERY\",\n    \"JEFF\", \"CHAD\", \"JACOB\", \"ALFRED\", \"BRADLEY\", \"HERBERT\",\n    \"FREDERICK\", \"EDWIN\", \"DON\", \"RICKY\", \"RANDALL\", \"BARRY\", \"BERNARD\",\n    \"LEROY\", \"MARCUS\", \"THEODORE\", \"CLIFFORD\", \"MIGUEL\", \"JIM\", \"TOM\",\n    \"CALVIN\", \"BILL\", \"LLOYD\", \"DEREK\", \"WARREN\", \"DARRELL\", \"JEROME\",\n    \"FLOYD\", \"ALVIN\", \"TIM\", \"GORDON\", \"GREG\", \"JORGE\", \"DUSTIN\",\n    \"PEDRO\", \"DERRICK\", \"ZACHARY\", \"HERMAN\", \"GLEN\", \"HECTOR\",\n    \"RICARDO\", \"RICK\", \"BRENT\", \"RAMON\", \"GILBERT\", \"MARC\", \"REGINALD\",\n    \"RUBEN\", \"NATHANIEL\", \"RAFAEL\", \"EDGAR\", \"MILTON\", \"RAUL\", \"BEN\",\n    \"CHESTER\", \"DUANE\", \"FRANKLIN\", \"BRAD\", \"RON\", \"ROLAND\", \"ARNOLD\",\n    \"HARVEY\", \"JARED\", \"ERIK\", \"DARRYL\", \"NEIL\", \"JAVIER\", \"FERNANDO\",\n    \"CLINTON\", \"TED\", \"MATHEW\", \"TYRONE\", \"DARREN\", \"LANCE\", \"KURT\",\n    \"ALLAN\", \"NELSON\", \"GUY\", \"CLAYTON\", \"HUGH\", \"MAX\", \"DWAYNE\",\n    \"DWIGHT\", \"ARMANDO\", \"FELIX\", \"EVERETT\", \"IAN\", \"WALLACE\", \"KEN\",\n    \"BOB\", \"ALFREDO\", \"ALBERTO\", \"DAVE\", \"IVAN\", \"BYRON\", \"ISAAC\",\n    \"MORRIS\", \"CLIFTON\", \"WILLARD\", \"ROSS\", \"ANDY\", \"SALVADOR\", \"KIRK\",\n    \"SERGIO\", \"SETH\", \"KENT\", \"TERRANCE\", \"EDUARDO\", \"TERRENCE\",\n    \"ENRIQUE\", \"WADE\", \"STUART\", \"FREDRICK\", \"ARTURO\", \"ALEJANDRO\",\n    \"NICK\", \"LUTHER\", \"WENDELL\", \"JEREMIAH\", \"JULIUS\", \"OTIS\", \"TREVOR\",\n    \"OLIVER\", \"LUKE\", \"HOMER\", \"GERARD\", \"DOUG\", \"KENNY\", \"HUBERT\",\n    \"LYLE\", \"MATT\", \"ALFONSO\", \"ORLANDO\", \"REX\", \"CARLTON\", \"ERNESTO\",\n    \"NEAL\", \"PABLO\", \"LORENZO\", \"OMAR\", \"WILBUR\", \"GRANT\", \"HORACE\",\n    \"RODERICK\", \"ABRAHAM\", \"WILLIS\", \"RICKEY\", \"ANDRES\", \"CESAR\",\n    \"JOHNATHAN\", \"MALCOLM\", \"RUDOLPH\", \"DAMON\", \"KELVIN\", \"PRESTON\",\n    \"ALTON\", \"ARCHIE\", \"MARCO\", \"WM\", \"PETE\", \"RANDOLPH\", \"GARRY\",\n    \"GEOFFREY\", \"JONATHON\", \"FELIPE\", \"GERARDO\", \"ED\", \"DOMINIC\",\n    \"DELBERT\", \"COLIN\", \"GUILLERMO\", \"EARNEST\", \"LUCAS\", \"BENNY\",\n    \"SPENCER\", \"RODOLFO\", \"MYRON\", \"EDMUND\", \"GARRETT\", \"SALVATORE\",\n    \"CEDRIC\", \"LOWELL\", \"GREGG\", \"SHERMAN\", \"WILSON\", \"SYLVESTER\",\n    \"ROOSEVELT\", \"ISRAEL\", \"JERMAINE\", \"FORREST\", \"WILBERT\", \"LELAND\",\n    \"SIMON\", \"CLARK\", \"IRVING\", \"BRYANT\", \"OWEN\", \"RUFUS\", \"WOODROW\",\n    \"KRISTOPHER\", \"MACK\", \"LEVI\", \"MARCOS\", \"GUSTAVO\", \"JAKE\", \"LIONEL\",\n    \"GILBERTO\", \"CLINT\", \"NICOLAS\", \"ISMAEL\", \"ORVILLE\", \"ERVIN\",\n    \"DEWEY\", \"AL\", \"WILFRED\", \"JOSH\", \"HUGO\", \"IGNACIO\", \"CALEB\",\n    \"TOMAS\", \"SHELDON\", \"ERICK\", \"STEWART\", \"DOYLE\", \"DARREL\",\n    \"ROGELIO\", \"TERENCE\", \"SANTIAGO\", \"ALONZO\", \"ELIAS\", \"BERT\",\n    \"ELBERT\", \"RAMIRO\", \"CONRAD\", \"NOAH\", \"GRADY\", \"PHIL\", \"CORNELIUS\",\n    \"LAMAR\", \"ROLANDO\", \"CLAY\", \"PERCY\", \"DEXTER\", \"BRADFORD\", \"DARIN\",\n    \"AMOS\", \"MOSES\", \"IRVIN\", \"SAUL\", \"ROMAN\", \"RANDAL\", \"TIMMY\",\n    \"DARRIN\", \"WINSTON\", \"BRENDAN\", \"ABEL\", \"DOMINICK\", \"BOYD\",\n    \"EMILIO\", \"ELIJAH\", \"DOMINGO\", \"EMMETT\", \"MARLON\", \"EMANUEL\",\n    \"JERALD\", \"EDMOND\", \"EMIL\", \"DEWAYNE\", \"WILL\", \"OTTO\", \"TEDDY\",\n    \"REYNALDO\", \"BRET\", \"JESS\", \"TRENT\", \"HUMBERTO\", \"EMMANUEL\",\n    \"STEPHAN\", \"VICENTE\", \"LAMONT\", \"GARLAND\", \"MILES\", \"EFRAIN\",\n    \"HEATH\", \"RODGER\", \"HARLEY\", \"ETHAN\", \"ELDON\", \"ROCKY\", \"PIERRE\",\n    \"JUNIOR\", \"FREDDY\", \"ELI\", \"BRYCE\", \"ANTOINE\", \"STERLING\", \"CHASE\",\n    \"GROVER\", \"ELTON\", \"CLEVELAND\", \"DYLAN\", \"CHUCK\", \"DAMIAN\",\n    \"REUBEN\", \"STAN\", \"AUGUST\", \"LEONARDO\", \"JASPER\", \"RUSSEL\", \"ERWIN\",\n    \"BENITO\", \"HANS\", \"MONTE\", \"BLAINE\", \"ERNIE\", \"CURT\", \"QUENTIN\",\n    \"AGUSTIN\", \"MURRAY\", \"JAMAL\", \"ADOLFO\", \"HARRISON\", \"TYSON\",\n    \"BURTON\", \"BRADY\", \"ELLIOTT\", \"WILFREDO\", \"BART\", \"JARROD\", \"VANCE\",\n    \"DENIS\", \"DAMIEN\", \"JOAQUIN\", \"HARLAN\", \"DESMOND\", \"ELLIOT\",\n    \"DARWIN\", \"GREGORIO\", \"BUDDY\", \"XAVIER\", \"KERMIT\", \"ROSCOE\",\n    \"ESTEBAN\", \"ANTON\", \"SOLOMON\", \"SCOTTY\", \"NORBERT\", \"ELVIN\",\n    \"WILLIAMS\", \"NOLAN\", \"ROD\", \"QUINTON\", \"HAL\", \"BRAIN\", \"ROB\",\n    \"ELWOOD\", \"KENDRICK\", \"DARIUS\", \"MOISES\", \"FIDEL\", \"THADDEUS\",\n    \"CLIFF\", \"MARCEL\", \"JACKSON\", \"RAPHAEL\", \"BRYON\", \"ARMAND\",\n    \"ALVARO\", \"JEFFRY\", \"DANE\", \"JOESPH\", \"THURMAN\", \"NED\", \"RUSTY\",\n    \"MONTY\", \"FABIAN\", \"REGGIE\", \"MASON\", \"GRAHAM\", \"ISAIAH\", \"VAUGHN\",\n    \"GUS\", \"LOYD\", \"DIEGO\", \"ADOLPH\", \"NORRIS\", \"MILLARD\", \"ROCCO\",\n    \"GONZALO\", \"DERICK\", \"RODRIGO\", \"WILEY\", \"RIGOBERTO\", \"ALPHONSO\",\n    \"TY\", \"NOE\", \"VERN\", \"REED\", \"JEFFERSON\", \"ELVIS\", \"BERNARDO\",\n    \"MAURICIO\", \"HIRAM\", \"DONOVAN\", \"BASIL\", \"RILEY\", \"NICKOLAS\",\n    \"MAYNARD\", \"SCOT\", \"VINCE\", \"QUINCY\", \"EDDY\", \"SEBASTIAN\",\n    \"FEDERICO\", \"ULYSSES\", \"HERIBERTO\", \"DONNELL\", \"COLE\", \"DAVIS\",\n    \"GAVIN\", \"EMERY\", \"WARD\", \"ROMEO\", \"JAYSON\", \"DANTE\", \"CLEMENT\",\n    \"COY\", \"MAXWELL\", \"JARVIS\", \"BRUNO\", \"ISSAC\", \"DUDLEY\", \"BROCK\",\n    \"SANFORD\", \"CARMELO\", \"BARNEY\", \"NESTOR\", \"STEFAN\", \"DONNY\", \"ART\",\n    \"LINWOOD\", \"BEAU\", \"WELDON\", \"GALEN\", \"ISIDRO\", \"TRUMAN\", \"DELMAR\",\n    \"JOHNATHON\", \"SILAS\", \"FREDERIC\", \"DICK\", \"IRWIN\", \"MERLIN\",\n    \"CHARLEY\", \"MARCELINO\", \"HARRIS\", \"CARLO\", \"TRENTON\", \"KURTIS\",\n    \"HUNTER\", \"AURELIO\", \"WINFRED\", \"VITO\", \"COLLIN\", \"DENVER\",\n    \"CARTER\", \"LEONEL\", \"EMORY\", \"PASQUALE\", \"MOHAMMAD\", \"MARIANO\",\n    \"DANIAL\", \"LANDON\", \"DIRK\", \"BRANDEN\", \"ADAN\", \"BUFORD\", \"GERMAN\",\n    \"WILMER\", \"EMERSON\", \"ZACHERY\", \"FLETCHER\", \"JACQUES\", \"ERROL\",\n    \"DALTON\", \"MONROE\", \"JOSUE\", \"EDWARDO\", \"BOOKER\", \"WILFORD\",\n    \"SONNY\", \"SHELTON\", \"CARSON\", \"THERON\", \"RAYMUNDO\", \"DAREN\",\n    \"HOUSTON\", \"ROBBY\", \"LINCOLN\", \"GENARO\", \"BENNETT\", \"OCTAVIO\",\n    \"CORNELL\", \"HUNG\", \"ARRON\", \"ANTONY\", \"HERSCHEL\", \"GIOVANNI\",\n    \"GARTH\", \"CYRUS\", \"CYRIL\", \"RONNY\", \"LON\", \"FREEMAN\", \"DUNCAN\",\n    \"KENNITH\", \"CARMINE\", \"ERICH\", \"CHADWICK\", \"WILBURN\", \"RUSS\",\n    \"REID\", \"MYLES\", \"ANDERSON\", \"MORTON\", \"JONAS\", \"FOREST\", \"MITCHEL\",\n    \"MERVIN\", \"ZANE\", \"RICH\", \"JAMEL\", \"LAZARO\", \"ALPHONSE\", \"RANDELL\",\n    \"MAJOR\", \"JARRETT\", \"BROOKS\", \"ABDUL\", \"LUCIANO\", \"SEYMOUR\",\n    \"EUGENIO\", \"MOHAMMED\", \"VALENTIN\", \"CHANCE\", \"ARNULFO\", \"LUCIEN\",\n    \"FERDINAND\", \"THAD\", \"EZRA\", \"ALDO\", \"RUBIN\", \"ROYAL\", \"MITCH\",\n    \"EARLE\", \"ABE\", \"WYATT\", \"MARQUIS\", \"LANNY\", \"KAREEM\", \"JAMAR\",\n    \"BORIS\", \"ISIAH\", \"EMILE\", \"ELMO\", \"ARON\", \"LEOPOLDO\", \"EVERETTE\",\n    \"JOSEF\", \"ELOY\", \"RODRICK\", \"REINALDO\", \"LUCIO\", \"JERROD\", \"WESTON\",\n    \"HERSHEL\", \"BARTON\", \"PARKER\", \"LEMUEL\", \"BURT\", \"JULES\", \"GIL\",\n    \"ELISEO\", \"AHMAD\", \"NIGEL\", \"EFREN\", \"ANTWAN\", \"ALDEN\", \"MARGARITO\",\n    \"COLEMAN\", \"DINO\", \"OSVALDO\", \"LES\", \"DEANDRE\", \"NORMAND\", \"KIETH\",\n    \"TREY\", \"NORBERTO\", \"NAPOLEON\", \"JEROLD\", \"FRITZ\", \"ROSENDO\",\n    \"MILFORD\", \"CHRISTOPER\", \"ALFONZO\", \"LYMAN\", \"JOSIAH\", \"BRANT\",\n    \"WILTON\", \"RICO\", \"JAMAAL\", \"DEWITT\", \"BRENTON\", \"OLIN\", \"FOSTER\",\n    \"FAUSTINO\", \"CLAUDIO\", \"JUDSON\", \"GINO\", \"EDGARDO\", \"ALEC\",\n    \"TANNER\", \"JARRED\", \"DONN\", \"TAD\", \"PRINCE\", \"PORFIRIO\", \"ODIS\",\n    \"LENARD\", \"CHAUNCEY\", \"TOD\", \"MEL\", \"MARCELO\", \"KORY\", \"AUGUSTUS\",\n    \"KEVEN\", \"HILARIO\", \"BUD\", \"SAL\", \"ORVAL\", \"MAURO\", \"ZACHARIAH\",\n    \"OLEN\", \"ANIBAL\", \"MILO\", \"JED\", \"DILLON\", \"AMADO\", \"NEWTON\",\n    \"LENNY\", \"RICHIE\", \"HORACIO\", \"BRICE\", \"MOHAMED\", \"DELMER\", \"DARIO\",\n    \"REYES\", \"MAC\", \"JONAH\", \"JERROLD\", \"ROBT\", \"HANK\", \"RUPERT\",\n    \"ROLLAND\", \"KENTON\", \"DAMION\", \"ANTONE\", \"WALDO\", \"FREDRIC\",\n    \"BRADLY\", \"KIP\", \"BURL\", \"WALKER\", \"TYREE\", \"JEFFEREY\", \"AHMED\",\n    \"WILLY\", \"STANFORD\", \"OREN\", \"NOBLE\", \"MOSHE\", \"MIKEL\", \"ENOCH\",\n    \"BRENDON\", \"QUINTIN\", \"JAMISON\", \"FLORENCIO\", \"DARRICK\", \"TOBIAS\",\n    \"HASSAN\", \"GIUSEPPE\", \"DEMARCUS\", \"CLETUS\", \"TYRELL\", \"LYNDON\",\n    \"KEENAN\", \"WERNER\", \"GERALDO\", \"COLUMBUS\", \"CHET\", \"BERTRAM\",\n    \"MARKUS\", \"HUEY\", \"HILTON\", \"DWAIN\", \"DONTE\", \"TYRON\", \"OMER\",\n    \"ISAIAS\", \"HIPOLITO\", \"FERMIN\", \"ADALBERTO\", \"BO\", \"BARRETT\",\n    \"TEODORO\", \"MCKINLEY\", \"MAXIMO\", \"GARFIELD\", \"RALEIGH\", \"LAWERENCE\",\n    \"ABRAM\", \"RASHAD\", \"KING\", \"EMMITT\", \"DARON\", \"SAMUAL\", \"MIQUEL\",\n    \"EUSEBIO\", \"DOMENIC\", \"DARRON\", \"BUSTER\", \"WILBER\", \"RENATO\", \"JC\",\n    \"HOYT\", \"HAYWOOD\", \"EZEKIEL\", \"CHAS\", \"FLORENTINO\", \"ELROY\",\n    \"CLEMENTE\", \"ARDEN\", \"NEVILLE\", \"EDISON\", \"DESHAWN\", \"NATHANIAL\",\n    \"JORDON\", \"DANILO\", \"CLAUD\", \"SHERWOOD\", \"RAYMON\", \"RAYFORD\",\n    \"CRISTOBAL\", \"AMBROSE\", \"TITUS\", \"HYMAN\", \"FELTON\", \"EZEQUIEL\",\n    \"ERASMO\", \"STANTON\", \"LONNY\", \"LEN\", \"IKE\", \"MILAN\", \"LINO\",\n    \"JAROD\", \"HERB\", \"ANDREAS\", \"WALTON\", \"RHETT\", \"PALMER\", \"DOUGLASS\",\n    \"CORDELL\", \"OSWALDO\", \"ELLSWORTH\", \"VIRGILIO\", \"TONEY\", \"NATHANAEL\",\n    \"DEL\", \"BENEDICT\", \"MOSE\", \"JOHNSON\", \"ISREAL\", \"GARRET\", \"FAUSTO\",\n    \"ASA\", \"ARLEN\", \"ZACK\", \"WARNER\", \"MODESTO\", \"FRANCESCO\", \"MANUAL\",\n    \"GAYLORD\", \"GASTON\", \"FILIBERTO\", \"DEANGELO\", \"MICHALE\",\n    \"GRANVILLE\", \"WES\", \"MALIK\", \"ZACKARY\", \"TUAN\", \"ELDRIDGE\",\n    \"CRISTOPHER\", \"CORTEZ\", \"ANTIONE\", \"MALCOM\", \"LONG\", \"KOREY\",\n    \"JOSPEH\", \"COLTON\", \"WAYLON\", \"VON\", \"HOSEA\", \"SHAD\", \"SANTO\",\n    \"RUDOLF\", \"ROLF\", \"REY\", \"RENALDO\", \"MARCELLUS\", \"LUCIUS\",\n    \"KRISTOFER\", \"BOYCE\", \"BENTON\", \"HAYDEN\", \"HARLAND\", \"ARNOLDO\",\n    \"RUEBEN\", \"LEANDRO\", \"KRAIG\", \"JERRELL\", \"JEROMY\", \"HOBERT\",\n    \"CEDRICK\", \"ARLIE\", \"WINFORD\", \"WALLY\", \"LUIGI\", \"KENETH\",\n    \"JACINTO\", \"GRAIG\", \"FRANKLYN\", \"EDMUNDO\", \"SID\", \"PORTER\", \"LEIF\",\n    \"JERAMY\", \"BUCK\", \"WILLIAN\", \"VINCENZO\", \"SHON\", \"LYNWOOD\", \"JERE\",\n    \"HAI\", \"ELDEN\", \"DORSEY\", \"DARELL\", \"BRODERICK\", \"ALONSO\"]\n\n", "num_lines": 809}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, TypeOperators #-}\nmodule T7939 where\nimport Data.Kind (Type)\n\nclass Foo a where\n   type Bar a b\n\ntype family F a\ntype instance F Int = Bool\n\ntype family G a where\n  G Int = Bool\n\ntype family H a where\n  H False = True\n\ntype family J a where\n  J '[] = False\n  J (h ': t) = True\n\ntype family K a where\n  K '[] = Nothing\n  K (h ': t) = Just h\n\ntype family L (a :: k) (b :: Type) :: k where\n  L Int Int = Bool\n  L Maybe Bool = IO\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "whnf :: a -> IO ()\nwhnf a = a `seq` (return ())\n\nfoo :: [Int]\nfoo = [1..]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T8357 where\n\nimport Data.Kind (Type)\nimport GHC.TypeLits \n\ndata (:::) (sy :: Symbol) ty \ndata Key (sy :: Symbol) \ndata Rec (rs :: [Type])\n\n(*=) :: Key sy -> ty -> Rec '[sy ::: ty]\n(*=) = undefined\n\n(.*.) :: (Union xs ys ~ rs) => Rec xs -> Rec ys -> Rec rs\n(.*.) = undefined\n\ntype family Union (xs :: [Type]) (ys :: [Type]) :: [Type]  where\n    Union ((sy ::: t) ': xs) ys = (sy ::: t) ': Union xs ys\n    Union '[] ys = ys\n\n\nfFoo :: Key \"foo\"\nfFoo = undefined\n\nfBar :: Key \"bar\"\nfBar = undefined\n\nfoo = fFoo *= \"foo\"\nbar = fBar *= \"bar\"\nboth = foo .*. bar\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T8383 where\nimport GHC.Exts\nf :: Int# -> Int#\nf x = x\nfoo = print $ (tagToEnum# (f 0#) :: Bool)\nbar = print $ (tagToEnum# (f 1#) :: Bool)\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8469 where\n\nimport T8469a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T8469a () where\n\ntype family F a\ntype instance F Int = Bool\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8639 where\n\nit = True\nbit = 'c'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}\nmodule T8557 where\n\ndata family Sing (a :: k)\ndata instance Sing (a :: [k]) = SNil\ndata instance Sing Bool = SBool\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8696A (a) where\n{-# NOINLINE a #-}\na :: Int\na = 3\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8696B (b) where\nimport T8696A (a)\nb :: Int\nb = a+1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, GADTs #-}\ndata A x y = (Num x, Eq y) => B\n\ndata R = R{ rX :: Int }\n\npattern P = B\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T8831 where\nfoo = [| 3 |]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-}\n\nmodule T8917 where\n\ndata Nat = Zero | Succ Nat\ntype family a + b where\n  Zero + a = a\n  (Succ n) + m = Succ (n + m)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax, Arrows, RankNTypes #-}\nmodule T8959b where\n\nfoo :: Int -> Int\nfoo = ()\n\nbar :: ()\nbar = proc x -> do return -< x\n\nbaz = () :: (forall a. a -> a) -> a\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata T a where\n  C :: T Int\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "x = \"abc\"\nmain = print x\n-- This file has Windows line endings (CRLF) on purpose. Do not remove.\n-- See #9367.\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9762A (a) where\n-- By marking a INLINE, we create a reference from B to A's tickboxes.\n{-# INLINE a #-}\na :: Int\na = 3\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9762B (b) where\nimport T9762A (a)\nb :: Int\nb = a+1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers #-}\nmodule T9878 where\n\nimport GHC.StaticPtr\n\nf = deRefStaticPtr (static True)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers #-}\nmodule T9878b where\n\nimport GHC.StaticPtr\n\nf = deRefStaticPtr (static True)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\ntest = \"test\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 #-}\n\n-- Verify that -O2 is rejected when this module is loaded by GHCi\nmodule T10549 where\n\nimport qualified Data.ByteString.Internal as Internal\nimport System.IO.Unsafe (unsafePerformIO)\nimport Data.Word (Word8)\nimport Foreign.Ptr (Ptr)\nimport Foreign.Storable (peek)\n\ntype S = Ptr Word8\n\nchr :: S -> Char\nchr x = Internal.w2c $ unsafePerformIO $ peek x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O #-}\nmodule Main(main) where\nimport GHC.Exts\nmain = print 1\ngo (Ptr a) = a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\nmodule T14608 where\n\ndata UnboxedTupleData = MkUTD (# (),() #)\n\ndoThings :: UnboxedTupleData -> ()\ndoThings (MkUTD t) = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\nimport Data.Binary.Get\nimport Data.Binary.Put\nimport Data.Array.Unboxed as AU\nimport Data.Array.IO (IOUArray)\nimport Data.Array.MArray (MArray)\nimport Data.Array as A\nimport GHCi.BinaryArray\nimport GHC.Word\n\nroundtripTest :: (IArray UArray a, MArray IOUArray a IO, Eq a)\n              => UArray Int a -> IO ()\nroundtripTest arr =\n    let ser  = Data.Binary.Put.runPut $ putArray arr\n    in case Data.Binary.Get.runGetOrFail getArray ser of\n         Right (_, _, arr')\n           | arr == arr'  -> return ()\n           | otherwise    -> putStrLn \"failed to round-trip\"\n         Left _           -> putStrLn \"deserialization failed\"\n\nmain :: IO ()\nmain = do\n    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Int)\n    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word)\n    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word8)\n    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word16)\n    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word32)\n    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word64)\n    roundtripTest (AU.listArray (1,500) ['a'..] :: UArray Int Char)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- This test used to fail in GHC 5.04.2.  See rev. 1.22 of\n-- libraries/base/GHC/Base.lhs for the fix.\n\ndata FourArrow = A | B | C | D | E | ABE | AC | BD | CDE\n                 deriving (Eq)\n\ndom E   = ABE\n\ncod A   = AC\ncod B   = BD\ncod C   = CDE\ncod D   = CDE\ncod E   = CDE\ncod ABE = ABE\ncod AC  = AC\ncod BD  = BD\ncod CDE = CDE\n\n----\nbceFour :: FourArrow -> FourArrow -> String\nbceFour f g\n    | dom f == dom g && cod f == cod g\n    = \"it works\"\n    | otherwise = error (\"Four.bceFour: precondition fails:\"\n                          ++ \"arrows not parallel\"\n                          ++ \"\\n\")\n\nmain = print (bceFour E E)\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Maybe\nimport Data.List\n\ndata Dir = R | D | L | U deriving (Show, Eq, Enum)\ntype Spiral = ([[Int]], Int, Dir) -- (rows, current row, next direction)\n\nrows :: Spiral -> [[Int]]\nrows (rs, i, d) = rs\ncurrentrow :: Spiral -> Int\ncurrentrow (rs, i, d) = i\nnextdir :: Spiral -> Dir\nnextdir (rs, i, d) = d\n\ngetrow :: Int -> [[Int]] -> Maybe [Int]\ngetrow i sp = if i < 0 || i >= length sp then Nothing else Just (sp!!i)\n\nndir :: Dir -> Dir\nndir d = if d == U then R else succ d\n\nnewsp :: Spiral\nnewsp = ([[1]], 0, R)\n\nmakeSpiral :: Int -> Spiral\nmakeSpiral i = makeSpiral' 2 newsp\n    where makeSpiral' j sp = if j > i\n                             then sp\n                             else makeSpiral' (j+1) (update j sp)\n\nupdate :: Int -> Spiral -> Spiral\nupdate i (sp, cr, d) = (sp', cr', d')\n    where oldrow  = if (d == U && cr' == cr && cr == 0) ||\n                    (d == D && cr' == length sp)\n                    then []\n                    else fromJust $ getrow cr' sp\n          cr'    | d == L || d == R = cr\n                 | d == U = if cr == 0 then 0 else cr-1\n                 | otherwise = cr+1\n          cr''   = if d == U && cr == 0 then -1 else cr'\n          sp'    = insertrow cr'' newrow sp\n          newrow = case d of\n                          R -> oldrow++[i]\n                          D -> oldrow++[i]\n                          L -> i:oldrow\n                          U -> i:oldrow\n          d' | d == R || d == L = if length oldrow == maximum (map length sp)\n                                  then ndir d\n                                  else d\n             | d == U = if cr'' == -1 then ndir d else d\n             | otherwise = if cr' == length sp then ndir d else d\n\n\n\ninsertrow :: Int -> [Int] -> [[Int]] -> [[Int]]\ninsertrow i r rs = if i == -1 then r:rs else front++[r]++back\n    where (front, rest) = splitAt i rs\n          back = if null rest then [] else tail rest\n\nprintSpiral :: Spiral -> IO ()\nprintSpiral (sp, i, d) = putStrLn (concat $ intersperse \"\\n\" (map show sp))\n\nsumdiags :: Spiral -> Int\nsumdiags (sp, i, d) = (sumdiags' 0 0 (+1)) + (sumdiags' 0 end (subtract 1)) - centre\n    where row1 = sp!!0\n          end = length row1 - 1\n          halfx = (length row1 `div` 2)\n          halfy = (length sp `div` 2)\n          centre = (sp!!halfy)!!halfx\n          sumdiags' row col f = if row == length sp\n                                then 0\n                                else (sp!!row)!!col + sumdiags' (row+1) (f col) f\n\nmain = print (makeSpiral 10000)\n", "num_lines": 73}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nmain :: IO ()\nmain = print ok\n\nok :: Bool\nok = map foo [10..72] == map bar [10..72]\n\nfoo :: Int -> [Int]\nfoo 12 = [12, 13, 14, 15, 16, 17]\nfoo 14 = [14, 15, 16, 17, 18, 19]\nfoo 16 = [16, 17, 18, 19, 20, 21]\nfoo 18 = [18, 19, 20, 21, 22, 23]\nfoo n | n == 20 = [20, 30, 40, 50, 60, 70, 80]\nfoo 22 = [22, 23, 24, 25, 26, 27]\nfoo 24 = [24, 25, 26, 27, 28, 29]\nfoo 26 = [26, 27, 28, 29, 30, 31]\nfoo 28 = [28, 29, 30, 31, 32, 33]\nfoo n | n == 30 = [30, 40, 50, 60, 70, 80, 90]\nfoo 32 = [32, 33, 34, 35, 36, 37]\nfoo 34 = [34, 35, 36, 37, 38, 39]\nfoo 36 = [36, 37, 38, 39, 40, 41]\nfoo 38 = [38, 39, 40, 41, 42, 43]\nfoo n | n == 40 = [40, 50, 60, 70, 80, 90, 100]\nfoo 42 = [42, 43, 44, 45, 46, 47]\nfoo 44 = [44, 45, 46, 47, 48, 49]\nfoo 46 = [46, 47, 48, 49, 50, 51]\nfoo 48 = [48, 49, 50, 51, 52, 53]\nfoo n | n == 50 = [50, 60, 70, 80, 90, 100, 110]\nfoo 52 = [52, 53, 54, 55, 56, 57]\nfoo 54 = [54, 55, 56, 57, 58, 59]\nfoo 56 = [56, 57, 58, 59, 60, 61]\nfoo 58 = [58, 59, 60, 61, 62, 63]\nfoo n | n == 60 = [60, 70, 80, 90, 100, 110, 120]\nfoo 62 = [62, 63, 64, 65, 66, 67]\nfoo 64 = [64, 65, 66, 67, 68, 69]\nfoo 66 = [66, 67, 68, 69, 70, 71]\nfoo 68 = [68, 69, 70, 71, 72, 73]\nfoo n | n == 70 = [70, 80, 90, 100, 110, 120, 130]\nfoo _ = []\n\nbar :: Int -> [Int]\nbar n\n | odd n           = []\n | n < 12          = []\n | n > 70          = []\n | n `mod` 10 == 0 = take 7 $ iterate (+ 10) n\n | otherwise       = take 6 $ iterate (+ 1) n\n\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- crashes in 7.2.1 and earlier, due to bogus calculations of label\n-- offsets in ByteCodeAsm for a BCO with large instructions.\n\nmain = print (map foo [1,50..5000] )\n\nfoo :: Int -> Int\nfoo 1 = 0\nfoo 2 = 1\nfoo 3 = 2\nfoo 4 = 3\nfoo 5 = 4\nfoo 6 = 5\nfoo 7 = 6\nfoo 8 = 7\nfoo 9 = 8\nfoo 10 = 9\nfoo 11 = 10\nfoo 12 = 11\nfoo 13 = 12\nfoo 14 = 13\nfoo 15 = 14\nfoo 16 = 15\nfoo 17 = 16\nfoo 18 = 17\nfoo 19 = 18\nfoo 20 = 19\nfoo 21 = 20\nfoo 22 = 21\nfoo 23 = 22\nfoo 24 = 23\nfoo 25 = 24\nfoo 26 = 25\nfoo 27 = 26\nfoo 28 = 27\nfoo 29 = 28\nfoo 30 = 29\nfoo 31 = 30\nfoo 32 = 31\nfoo 33 = 32\nfoo 34 = 33\nfoo 35 = 34\nfoo 36 = 35\nfoo 37 = 36\nfoo 38 = 37\nfoo 39 = 38\nfoo 40 = 39\nfoo 41 = 40\nfoo 42 = 41\nfoo 43 = 42\nfoo 44 = 43\nfoo 45 = 44\nfoo 46 = 45\nfoo 47 = 46\nfoo 48 = 47\nfoo 49 = 48\nfoo 50 = 49\nfoo 51 = 50\nfoo 52 = 51\nfoo 53 = 52\nfoo 54 = 53\nfoo 55 = 54\nfoo 56 = 55\nfoo 57 = 56\nfoo 58 = 57\nfoo 59 = 58\nfoo 60 = 59\nfoo 61 = 60\nfoo 62 = 61\nfoo 63 = 62\nfoo 64 = 63\nfoo 65 = 64\nfoo 66 = 65\nfoo 67 = 66\nfoo 68 = 67\nfoo 69 = 68\nfoo 70 = 69\nfoo 71 = 70\nfoo 72 = 71\nfoo 73 = 72\nfoo 74 = 73\nfoo 75 = 74\nfoo 76 = 75\nfoo 77 = 76\nfoo 78 = 77\nfoo 79 = 78\nfoo 80 = 79\nfoo 81 = 80\nfoo 82 = 81\nfoo 83 = 82\nfoo 84 = 83\nfoo 85 = 84\nfoo 86 = 85\nfoo 87 = 86\nfoo 88 = 87\nfoo 89 = 88\nfoo 90 = 89\nfoo 91 = 90\nfoo 92 = 91\nfoo 93 = 92\nfoo 94 = 93\nfoo 95 = 94\nfoo 96 = 95\nfoo 97 = 96\nfoo 98 = 97\nfoo 99 = 98\nfoo 100 = 99\nfoo 101 = 100\nfoo 102 = 101\nfoo 103 = 102\nfoo 104 = 103\nfoo 105 = 104\nfoo 106 = 105\nfoo 107 = 106\nfoo 108 = 107\nfoo 109 = 108\nfoo 110 = 109\nfoo 111 = 110\nfoo 112 = 111\nfoo 113 = 112\nfoo 114 = 113\nfoo 115 = 114\nfoo 116 = 115\nfoo 117 = 116\nfoo 118 = 117\nfoo 119 = 118\nfoo 120 = 119\nfoo 121 = 120\nfoo 122 = 121\nfoo 123 = 122\nfoo 124 = 123\nfoo 125 = 124\nfoo 126 = 125\nfoo 127 = 126\nfoo 128 = 127\nfoo 129 = 128\nfoo 130 = 129\nfoo 131 = 130\nfoo 132 = 131\nfoo 133 = 132\nfoo 134 = 133\nfoo 135 = 134\nfoo 136 = 135\nfoo 137 = 136\nfoo 138 = 137\nfoo 139 = 138\nfoo 140 = 139\nfoo 141 = 140\nfoo 142 = 141\nfoo 143 = 142\nfoo 144 = 143\nfoo 145 = 144\nfoo 146 = 145\nfoo 147 = 146\nfoo 148 = 147\nfoo 149 = 148\nfoo 150 = 149\nfoo 151 = 150\nfoo 152 = 151\nfoo 153 = 152\nfoo 154 = 153\nfoo 155 = 154\nfoo 156 = 155\nfoo 157 = 156\nfoo 158 = 157\nfoo 159 = 158\nfoo 160 = 159\nfoo 161 = 160\nfoo 162 = 161\nfoo 163 = 162\nfoo 164 = 163\nfoo 165 = 164\nfoo 166 = 165\nfoo 167 = 166\nfoo 168 = 167\nfoo 169 = 168\nfoo 170 = 169\nfoo 171 = 170\nfoo 172 = 171\nfoo 173 = 172\nfoo 174 = 173\nfoo 175 = 174\nfoo 176 = 175\nfoo 177 = 176\nfoo 178 = 177\nfoo 179 = 178\nfoo 180 = 179\nfoo 181 = 180\nfoo 182 = 181\nfoo 183 = 182\nfoo 184 = 183\nfoo 185 = 184\nfoo 186 = 185\nfoo 187 = 186\nfoo 188 = 187\nfoo 189 = 188\nfoo 190 = 189\nfoo 191 = 190\nfoo 192 = 191\nfoo 193 = 192\nfoo 194 = 193\nfoo 195 = 194\nfoo 196 = 195\nfoo 197 = 196\nfoo 198 = 197\nfoo 199 = 198\nfoo 200 = 199\nfoo 201 = 200\nfoo 202 = 201\nfoo 203 = 202\nfoo 204 = 203\nfoo 205 = 204\nfoo 206 = 205\nfoo 207 = 206\nfoo 208 = 207\nfoo 209 = 208\nfoo 210 = 209\nfoo 211 = 210\nfoo 212 = 211\nfoo 213 = 212\nfoo 214 = 213\nfoo 215 = 214\nfoo 216 = 215\nfoo 217 = 216\nfoo 218 = 217\nfoo 219 = 218\nfoo 220 = 219\nfoo 221 = 220\nfoo 222 = 221\nfoo 223 = 222\nfoo 224 = 223\nfoo 225 = 224\nfoo 226 = 225\nfoo 227 = 226\nfoo 228 = 227\nfoo 229 = 228\nfoo 230 = 229\nfoo 231 = 230\nfoo 232 = 231\nfoo 233 = 232\nfoo 234 = 233\nfoo 235 = 234\nfoo 236 = 235\nfoo 237 = 236\nfoo 238 = 237\nfoo 239 = 238\nfoo 240 = 239\nfoo 241 = 240\nfoo 242 = 241\nfoo 243 = 242\nfoo 244 = 243\nfoo 245 = 244\nfoo 246 = 245\nfoo 247 = 246\nfoo 248 = 247\nfoo 249 = 248\nfoo 250 = 249\nfoo 251 = 250\nfoo 252 = 251\nfoo 253 = 252\nfoo 254 = 253\nfoo 255 = 254\nfoo 256 = 255\nfoo 257 = 256\nfoo 258 = 257\nfoo 259 = 258\nfoo 260 = 259\nfoo 261 = 260\nfoo 262 = 261\nfoo 263 = 262\nfoo 264 = 263\nfoo 265 = 264\nfoo 266 = 265\nfoo 267 = 266\nfoo 268 = 267\nfoo 269 = 268\nfoo 270 = 269\nfoo 271 = 270\nfoo 272 = 271\nfoo 273 = 272\nfoo 274 = 273\nfoo 275 = 274\nfoo 276 = 275\nfoo 277 = 276\nfoo 278 = 277\nfoo 279 = 278\nfoo 280 = 279\nfoo 281 = 280\nfoo 282 = 281\nfoo 283 = 282\nfoo 284 = 283\nfoo 285 = 284\nfoo 286 = 285\nfoo 287 = 286\nfoo 288 = 287\nfoo 289 = 288\nfoo 290 = 289\nfoo 291 = 290\nfoo 292 = 291\nfoo 293 = 292\nfoo 294 = 293\nfoo 295 = 294\nfoo 296 = 295\nfoo 297 = 296\nfoo 298 = 297\nfoo 299 = 298\nfoo 300 = 299\nfoo 301 = 300\nfoo 302 = 301\nfoo 303 = 302\nfoo 304 = 303\nfoo 305 = 304\nfoo 306 = 305\nfoo 307 = 306\nfoo 308 = 307\nfoo 309 = 308\nfoo 310 = 309\nfoo 311 = 310\nfoo 312 = 311\nfoo 313 = 312\nfoo 314 = 313\nfoo 315 = 314\nfoo 316 = 315\nfoo 317 = 316\nfoo 318 = 317\nfoo 319 = 318\nfoo 320 = 319\nfoo 321 = 320\nfoo 322 = 321\nfoo 323 = 322\nfoo 324 = 323\nfoo 325 = 324\nfoo 326 = 325\nfoo 327 = 326\nfoo 328 = 327\nfoo 329 = 328\nfoo 330 = 329\nfoo 331 = 330\nfoo 332 = 331\nfoo 333 = 332\nfoo 334 = 333\nfoo 335 = 334\nfoo 336 = 335\nfoo 337 = 336\nfoo 338 = 337\nfoo 339 = 338\nfoo 340 = 339\nfoo 341 = 340\nfoo 342 = 341\nfoo 343 = 342\nfoo 344 = 343\nfoo 345 = 344\nfoo 346 = 345\nfoo 347 = 346\nfoo 348 = 347\nfoo 349 = 348\nfoo 350 = 349\nfoo 351 = 350\nfoo 352 = 351\nfoo 353 = 352\nfoo 354 = 353\nfoo 355 = 354\nfoo 356 = 355\nfoo 357 = 356\nfoo 358 = 357\nfoo 359 = 358\nfoo 360 = 359\nfoo 361 = 360\nfoo 362 = 361\nfoo 363 = 362\nfoo 364 = 363\nfoo 365 = 364\nfoo 366 = 365\nfoo 367 = 366\nfoo 368 = 367\nfoo 369 = 368\nfoo 370 = 369\nfoo 371 = 370\nfoo 372 = 371\nfoo 373 = 372\nfoo 374 = 373\nfoo 375 = 374\nfoo 376 = 375\nfoo 377 = 376\nfoo 378 = 377\nfoo 379 = 378\nfoo 380 = 379\nfoo 381 = 380\nfoo 382 = 381\nfoo 383 = 382\nfoo 384 = 383\nfoo 385 = 384\nfoo 386 = 385\nfoo 387 = 386\nfoo 388 = 387\nfoo 389 = 388\nfoo 390 = 389\nfoo 391 = 390\nfoo 392 = 391\nfoo 393 = 392\nfoo 394 = 393\nfoo 395 = 394\nfoo 396 = 395\nfoo 397 = 396\nfoo 398 = 397\nfoo 399 = 398\nfoo 400 = 399\nfoo 401 = 400\nfoo 402 = 401\nfoo 403 = 402\nfoo 404 = 403\nfoo 405 = 404\nfoo 406 = 405\nfoo 407 = 406\nfoo 408 = 407\nfoo 409 = 408\nfoo 410 = 409\nfoo 411 = 410\nfoo 412 = 411\nfoo 413 = 412\nfoo 414 = 413\nfoo 415 = 414\nfoo 416 = 415\nfoo 417 = 416\nfoo 418 = 417\nfoo 419 = 418\nfoo 420 = 419\nfoo 421 = 420\nfoo 422 = 421\nfoo 423 = 422\nfoo 424 = 423\nfoo 425 = 424\nfoo 426 = 425\nfoo 427 = 426\nfoo 428 = 427\nfoo 429 = 428\nfoo 430 = 429\nfoo 431 = 430\nfoo 432 = 431\nfoo 433 = 432\nfoo 434 = 433\nfoo 435 = 434\nfoo 436 = 435\nfoo 437 = 436\nfoo 438 = 437\nfoo 439 = 438\nfoo 440 = 439\nfoo 441 = 440\nfoo 442 = 441\nfoo 443 = 442\nfoo 444 = 443\nfoo 445 = 444\nfoo 446 = 445\nfoo 447 = 446\nfoo 448 = 447\nfoo 449 = 448\nfoo 450 = 449\nfoo 451 = 450\nfoo 452 = 451\nfoo 453 = 452\nfoo 454 = 453\nfoo 455 = 454\nfoo 456 = 455\nfoo 457 = 456\nfoo 458 = 457\nfoo 459 = 458\nfoo 460 = 459\nfoo 461 = 460\nfoo 462 = 461\nfoo 463 = 462\nfoo 464 = 463\nfoo 465 = 464\nfoo 466 = 465\nfoo 467 = 466\nfoo 468 = 467\nfoo 469 = 468\nfoo 470 = 469\nfoo 471 = 470\nfoo 472 = 471\nfoo 473 = 472\nfoo 474 = 473\nfoo 475 = 474\nfoo 476 = 475\nfoo 477 = 476\nfoo 478 = 477\nfoo 479 = 478\nfoo 480 = 479\nfoo 481 = 480\nfoo 482 = 481\nfoo 483 = 482\nfoo 484 = 483\nfoo 485 = 484\nfoo 486 = 485\nfoo 487 = 486\nfoo 488 = 487\nfoo 489 = 488\nfoo 490 = 489\nfoo 491 = 490\nfoo 492 = 491\nfoo 493 = 492\nfoo 494 = 493\nfoo 495 = 494\nfoo 496 = 495\nfoo 497 = 496\nfoo 498 = 497\nfoo 499 = 498\nfoo 500 = 499\nfoo 501 = 500\nfoo 502 = 501\nfoo 503 = 502\nfoo 504 = 503\nfoo 505 = 504\nfoo 506 = 505\nfoo 507 = 506\nfoo 508 = 507\nfoo 509 = 508\nfoo 510 = 509\nfoo 511 = 510\nfoo 512 = 511\nfoo 513 = 512\nfoo 514 = 513\nfoo 515 = 514\nfoo 516 = 515\nfoo 517 = 516\nfoo 518 = 517\nfoo 519 = 518\nfoo 520 = 519\nfoo 521 = 520\nfoo 522 = 521\nfoo 523 = 522\nfoo 524 = 523\nfoo 525 = 524\nfoo 526 = 525\nfoo 527 = 526\nfoo 528 = 527\nfoo 529 = 528\nfoo 530 = 529\nfoo 531 = 530\nfoo 532 = 531\nfoo 533 = 532\nfoo 534 = 533\nfoo 535 = 534\nfoo 536 = 535\nfoo 537 = 536\nfoo 538 = 537\nfoo 539 = 538\nfoo 540 = 539\nfoo 541 = 540\nfoo 542 = 541\nfoo 543 = 542\nfoo 544 = 543\nfoo 545 = 544\nfoo 546 = 545\nfoo 547 = 546\nfoo 548 = 547\nfoo 549 = 548\nfoo 550 = 549\nfoo 551 = 550\nfoo 552 = 551\nfoo 553 = 552\nfoo 554 = 553\nfoo 555 = 554\nfoo 556 = 555\nfoo 557 = 556\nfoo 558 = 557\nfoo 559 = 558\nfoo 560 = 559\nfoo 561 = 560\nfoo 562 = 561\nfoo 563 = 562\nfoo 564 = 563\nfoo 565 = 564\nfoo 566 = 565\nfoo 567 = 566\nfoo 568 = 567\nfoo 569 = 568\nfoo 570 = 569\nfoo 571 = 570\nfoo 572 = 571\nfoo 573 = 572\nfoo 574 = 573\nfoo 575 = 574\nfoo 576 = 575\nfoo 577 = 576\nfoo 578 = 577\nfoo 579 = 578\nfoo 580 = 579\nfoo 581 = 580\nfoo 582 = 581\nfoo 583 = 582\nfoo 584 = 583\nfoo 585 = 584\nfoo 586 = 585\nfoo 587 = 586\nfoo 588 = 587\nfoo 589 = 588\nfoo 590 = 589\nfoo 591 = 590\nfoo 592 = 591\nfoo 593 = 592\nfoo 594 = 593\nfoo 595 = 594\nfoo 596 = 595\nfoo 597 = 596\nfoo 598 = 597\nfoo 599 = 598\nfoo 600 = 599\nfoo 601 = 600\nfoo 602 = 601\nfoo 603 = 602\nfoo 604 = 603\nfoo 605 = 604\nfoo 606 = 605\nfoo 607 = 606\nfoo 608 = 607\nfoo 609 = 608\nfoo 610 = 609\nfoo 611 = 610\nfoo 612 = 611\nfoo 613 = 612\nfoo 614 = 613\nfoo 615 = 614\nfoo 616 = 615\nfoo 617 = 616\nfoo 618 = 617\nfoo 619 = 618\nfoo 620 = 619\nfoo 621 = 620\nfoo 622 = 621\nfoo 623 = 622\nfoo 624 = 623\nfoo 625 = 624\nfoo 626 = 625\nfoo 627 = 626\nfoo 628 = 627\nfoo 629 = 628\nfoo 630 = 629\nfoo 631 = 630\nfoo 632 = 631\nfoo 633 = 632\nfoo 634 = 633\nfoo 635 = 634\nfoo 636 = 635\nfoo 637 = 636\nfoo 638 = 637\nfoo 639 = 638\nfoo 640 = 639\nfoo 641 = 640\nfoo 642 = 641\nfoo 643 = 642\nfoo 644 = 643\nfoo 645 = 644\nfoo 646 = 645\nfoo 647 = 646\nfoo 648 = 647\nfoo 649 = 648\nfoo 650 = 649\nfoo 651 = 650\nfoo 652 = 651\nfoo 653 = 652\nfoo 654 = 653\nfoo 655 = 654\nfoo 656 = 655\nfoo 657 = 656\nfoo 658 = 657\nfoo 659 = 658\nfoo 660 = 659\nfoo 661 = 660\nfoo 662 = 661\nfoo 663 = 662\nfoo 664 = 663\nfoo 665 = 664\nfoo 666 = 665\nfoo 667 = 666\nfoo 668 = 667\nfoo 669 = 668\nfoo 670 = 669\nfoo 671 = 670\nfoo 672 = 671\nfoo 673 = 672\nfoo 674 = 673\nfoo 675 = 674\nfoo 676 = 675\nfoo 677 = 676\nfoo 678 = 677\nfoo 679 = 678\nfoo 680 = 679\nfoo 681 = 680\nfoo 682 = 681\nfoo 683 = 682\nfoo 684 = 683\nfoo 685 = 684\nfoo 686 = 685\nfoo 687 = 686\nfoo 688 = 687\nfoo 689 = 688\nfoo 690 = 689\nfoo 691 = 690\nfoo 692 = 691\nfoo 693 = 692\nfoo 694 = 693\nfoo 695 = 694\nfoo 696 = 695\nfoo 697 = 696\nfoo 698 = 697\nfoo 699 = 698\nfoo 700 = 699\nfoo 701 = 700\nfoo 702 = 701\nfoo 703 = 702\nfoo 704 = 703\nfoo 705 = 704\nfoo 706 = 705\nfoo 707 = 706\nfoo 708 = 707\nfoo 709 = 708\nfoo 710 = 709\nfoo 711 = 710\nfoo 712 = 711\nfoo 713 = 712\nfoo 714 = 713\nfoo 715 = 714\nfoo 716 = 715\nfoo 717 = 716\nfoo 718 = 717\nfoo 719 = 718\nfoo 720 = 719\nfoo 721 = 720\nfoo 722 = 721\nfoo 723 = 722\nfoo 724 = 723\nfoo 725 = 724\nfoo 726 = 725\nfoo 727 = 726\nfoo 728 = 727\nfoo 729 = 728\nfoo 730 = 729\nfoo 731 = 730\nfoo 732 = 731\nfoo 733 = 732\nfoo 734 = 733\nfoo 735 = 734\nfoo 736 = 735\nfoo 737 = 736\nfoo 738 = 737\nfoo 739 = 738\nfoo 740 = 739\nfoo 741 = 740\nfoo 742 = 741\nfoo 743 = 742\nfoo 744 = 743\nfoo 745 = 744\nfoo 746 = 745\nfoo 747 = 746\nfoo 748 = 747\nfoo 749 = 748\nfoo 750 = 749\nfoo 751 = 750\nfoo 752 = 751\nfoo 753 = 752\nfoo 754 = 753\nfoo 755 = 754\nfoo 756 = 755\nfoo 757 = 756\nfoo 758 = 757\nfoo 759 = 758\nfoo 760 = 759\nfoo 761 = 760\nfoo 762 = 761\nfoo 763 = 762\nfoo 764 = 763\nfoo 765 = 764\nfoo 766 = 765\nfoo 767 = 766\nfoo 768 = 767\nfoo 769 = 768\nfoo 770 = 769\nfoo 771 = 770\nfoo 772 = 771\nfoo 773 = 772\nfoo 774 = 773\nfoo 775 = 774\nfoo 776 = 775\nfoo 777 = 776\nfoo 778 = 777\nfoo 779 = 778\nfoo 780 = 779\nfoo 781 = 780\nfoo 782 = 781\nfoo 783 = 782\nfoo 784 = 783\nfoo 785 = 784\nfoo 786 = 785\nfoo 787 = 786\nfoo 788 = 787\nfoo 789 = 788\nfoo 790 = 789\nfoo 791 = 790\nfoo 792 = 791\nfoo 793 = 792\nfoo 794 = 793\nfoo 795 = 794\nfoo 796 = 795\nfoo 797 = 796\nfoo 798 = 797\nfoo 799 = 798\nfoo 800 = 799\nfoo 801 = 800\nfoo 802 = 801\nfoo 803 = 802\nfoo 804 = 803\nfoo 805 = 804\nfoo 806 = 805\nfoo 807 = 806\nfoo 808 = 807\nfoo 809 = 808\nfoo 810 = 809\nfoo 811 = 810\nfoo 812 = 811\nfoo 813 = 812\nfoo 814 = 813\nfoo 815 = 814\nfoo 816 = 815\nfoo 817 = 816\nfoo 818 = 817\nfoo 819 = 818\nfoo 820 = 819\nfoo 821 = 820\nfoo 822 = 821\nfoo 823 = 822\nfoo 824 = 823\nfoo 825 = 824\nfoo 826 = 825\nfoo 827 = 826\nfoo 828 = 827\nfoo 829 = 828\nfoo 830 = 829\nfoo 831 = 830\nfoo 832 = 831\nfoo 833 = 832\nfoo 834 = 833\nfoo 835 = 834\nfoo 836 = 835\nfoo 837 = 836\nfoo 838 = 837\nfoo 839 = 838\nfoo 840 = 839\nfoo 841 = 840\nfoo 842 = 841\nfoo 843 = 842\nfoo 844 = 843\nfoo 845 = 844\nfoo 846 = 845\nfoo 847 = 846\nfoo 848 = 847\nfoo 849 = 848\nfoo 850 = 849\nfoo 851 = 850\nfoo 852 = 851\nfoo 853 = 852\nfoo 854 = 853\nfoo 855 = 854\nfoo 856 = 855\nfoo 857 = 856\nfoo 858 = 857\nfoo 859 = 858\nfoo 860 = 859\nfoo 861 = 860\nfoo 862 = 861\nfoo 863 = 862\nfoo 864 = 863\nfoo 865 = 864\nfoo 866 = 865\nfoo 867 = 866\nfoo 868 = 867\nfoo 869 = 868\nfoo 870 = 869\nfoo 871 = 870\nfoo 872 = 871\nfoo 873 = 872\nfoo 874 = 873\nfoo 875 = 874\nfoo 876 = 875\nfoo 877 = 876\nfoo 878 = 877\nfoo 879 = 878\nfoo 880 = 879\nfoo 881 = 880\nfoo 882 = 881\nfoo 883 = 882\nfoo 884 = 883\nfoo 885 = 884\nfoo 886 = 885\nfoo 887 = 886\nfoo 888 = 887\nfoo 889 = 888\nfoo 890 = 889\nfoo 891 = 890\nfoo 892 = 891\nfoo 893 = 892\nfoo 894 = 893\nfoo 895 = 894\nfoo 896 = 895\nfoo 897 = 896\nfoo 898 = 897\nfoo 899 = 898\nfoo 900 = 899\nfoo 901 = 900\nfoo 902 = 901\nfoo 903 = 902\nfoo 904 = 903\nfoo 905 = 904\nfoo 906 = 905\nfoo 907 = 906\nfoo 908 = 907\nfoo 909 = 908\nfoo 910 = 909\nfoo 911 = 910\nfoo 912 = 911\nfoo 913 = 912\nfoo 914 = 913\nfoo 915 = 914\nfoo 916 = 915\nfoo 917 = 916\nfoo 918 = 917\nfoo 919 = 918\nfoo 920 = 919\nfoo 921 = 920\nfoo 922 = 921\nfoo 923 = 922\nfoo 924 = 923\nfoo 925 = 924\nfoo 926 = 925\nfoo 927 = 926\nfoo 928 = 927\nfoo 929 = 928\nfoo 930 = 929\nfoo 931 = 930\nfoo 932 = 931\nfoo 933 = 932\nfoo 934 = 933\nfoo 935 = 934\nfoo 936 = 935\nfoo 937 = 936\nfoo 938 = 937\nfoo 939 = 938\nfoo 940 = 939\nfoo 941 = 940\nfoo 942 = 941\nfoo 943 = 942\nfoo 944 = 943\nfoo 945 = 944\nfoo 946 = 945\nfoo 947 = 946\nfoo 948 = 947\nfoo 949 = 948\nfoo 950 = 949\nfoo 951 = 950\nfoo 952 = 951\nfoo 953 = 952\nfoo 954 = 953\nfoo 955 = 954\nfoo 956 = 955\nfoo 957 = 956\nfoo 958 = 957\nfoo 959 = 958\nfoo 960 = 959\nfoo 961 = 960\nfoo 962 = 961\nfoo 963 = 962\nfoo 964 = 963\nfoo 965 = 964\nfoo 966 = 965\nfoo 967 = 966\nfoo 968 = 967\nfoo 969 = 968\nfoo 970 = 969\nfoo 971 = 970\nfoo 972 = 971\nfoo 973 = 972\nfoo 974 = 973\nfoo 975 = 974\nfoo 976 = 975\nfoo 977 = 976\nfoo 978 = 977\nfoo 979 = 978\nfoo 980 = 979\nfoo 981 = 980\nfoo 982 = 981\nfoo 983 = 982\nfoo 984 = 983\nfoo 985 = 984\nfoo 986 = 985\nfoo 987 = 986\nfoo 988 = 987\nfoo 989 = 988\nfoo 990 = 989\nfoo 991 = 990\nfoo 992 = 991\nfoo 993 = 992\nfoo 994 = 993\nfoo 995 = 994\nfoo 996 = 995\nfoo 997 = 996\nfoo 998 = 997\nfoo 999 = 998\nfoo 1000 = 999\nfoo 1001 = 1000\nfoo 1002 = 1001\nfoo 1003 = 1002\nfoo 1004 = 1003\nfoo 1005 = 1004\nfoo 1006 = 1005\nfoo 1007 = 1006\nfoo 1008 = 1007\nfoo 1009 = 1008\nfoo 1010 = 1009\nfoo 1011 = 1010\nfoo 1012 = 1011\nfoo 1013 = 1012\nfoo 1014 = 1013\nfoo 1015 = 1014\nfoo 1016 = 1015\nfoo 1017 = 1016\nfoo 1018 = 1017\nfoo 1019 = 1018\nfoo 1020 = 1019\nfoo 1021 = 1020\nfoo 1022 = 1021\nfoo 1023 = 1022\nfoo 1024 = 1023\nfoo 1025 = 1024\nfoo 1026 = 1025\nfoo 1027 = 1026\nfoo 1028 = 1027\nfoo 1029 = 1028\nfoo 1030 = 1029\nfoo 1031 = 1030\nfoo 1032 = 1031\nfoo 1033 = 1032\nfoo 1034 = 1033\nfoo 1035 = 1034\nfoo 1036 = 1035\nfoo 1037 = 1036\nfoo 1038 = 1037\nfoo 1039 = 1038\nfoo 1040 = 1039\nfoo 1041 = 1040\nfoo 1042 = 1041\nfoo 1043 = 1042\nfoo 1044 = 1043\nfoo 1045 = 1044\nfoo 1046 = 1045\nfoo 1047 = 1046\nfoo 1048 = 1047\nfoo 1049 = 1048\nfoo 1050 = 1049\nfoo 1051 = 1050\nfoo 1052 = 1051\nfoo 1053 = 1052\nfoo 1054 = 1053\nfoo 1055 = 1054\nfoo 1056 = 1055\nfoo 1057 = 1056\nfoo 1058 = 1057\nfoo 1059 = 1058\nfoo 1060 = 1059\nfoo 1061 = 1060\nfoo 1062 = 1061\nfoo 1063 = 1062\nfoo 1064 = 1063\nfoo 1065 = 1064\nfoo 1066 = 1065\nfoo 1067 = 1066\nfoo 1068 = 1067\nfoo 1069 = 1068\nfoo 1070 = 1069\nfoo 1071 = 1070\nfoo 1072 = 1071\nfoo 1073 = 1072\nfoo 1074 = 1073\nfoo 1075 = 1074\nfoo 1076 = 1075\nfoo 1077 = 1076\nfoo 1078 = 1077\nfoo 1079 = 1078\nfoo 1080 = 1079\nfoo 1081 = 1080\nfoo 1082 = 1081\nfoo 1083 = 1082\nfoo 1084 = 1083\nfoo 1085 = 1084\nfoo 1086 = 1085\nfoo 1087 = 1086\nfoo 1088 = 1087\nfoo 1089 = 1088\nfoo 1090 = 1089\nfoo 1091 = 1090\nfoo 1092 = 1091\nfoo 1093 = 1092\nfoo 1094 = 1093\nfoo 1095 = 1094\nfoo 1096 = 1095\nfoo 1097 = 1096\nfoo 1098 = 1097\nfoo 1099 = 1098\nfoo 1100 = 1099\nfoo 1101 = 1100\nfoo 1102 = 1101\nfoo 1103 = 1102\nfoo 1104 = 1103\nfoo 1105 = 1104\nfoo 1106 = 1105\nfoo 1107 = 1106\nfoo 1108 = 1107\nfoo 1109 = 1108\nfoo 1110 = 1109\nfoo 1111 = 1110\nfoo 1112 = 1111\nfoo 1113 = 1112\nfoo 1114 = 1113\nfoo 1115 = 1114\nfoo 1116 = 1115\nfoo 1117 = 1116\nfoo 1118 = 1117\nfoo 1119 = 1118\nfoo 1120 = 1119\nfoo 1121 = 1120\nfoo 1122 = 1121\nfoo 1123 = 1122\nfoo 1124 = 1123\nfoo 1125 = 1124\nfoo 1126 = 1125\nfoo 1127 = 1126\nfoo 1128 = 1127\nfoo 1129 = 1128\nfoo 1130 = 1129\nfoo 1131 = 1130\nfoo 1132 = 1131\nfoo 1133 = 1132\nfoo 1134 = 1133\nfoo 1135 = 1134\nfoo 1136 = 1135\nfoo 1137 = 1136\nfoo 1138 = 1137\nfoo 1139 = 1138\nfoo 1140 = 1139\nfoo 1141 = 1140\nfoo 1142 = 1141\nfoo 1143 = 1142\nfoo 1144 = 1143\nfoo 1145 = 1144\nfoo 1146 = 1145\nfoo 1147 = 1146\nfoo 1148 = 1147\nfoo 1149 = 1148\nfoo 1150 = 1149\nfoo 1151 = 1150\nfoo 1152 = 1151\nfoo 1153 = 1152\nfoo 1154 = 1153\nfoo 1155 = 1154\nfoo 1156 = 1155\nfoo 1157 = 1156\nfoo 1158 = 1157\nfoo 1159 = 1158\nfoo 1160 = 1159\nfoo 1161 = 1160\nfoo 1162 = 1161\nfoo 1163 = 1162\nfoo 1164 = 1163\nfoo 1165 = 1164\nfoo 1166 = 1165\nfoo 1167 = 1166\nfoo 1168 = 1167\nfoo 1169 = 1168\nfoo 1170 = 1169\nfoo 1171 = 1170\nfoo 1172 = 1171\nfoo 1173 = 1172\nfoo 1174 = 1173\nfoo 1175 = 1174\nfoo 1176 = 1175\nfoo 1177 = 1176\nfoo 1178 = 1177\nfoo 1179 = 1178\nfoo 1180 = 1179\nfoo 1181 = 1180\nfoo 1182 = 1181\nfoo 1183 = 1182\nfoo 1184 = 1183\nfoo 1185 = 1184\nfoo 1186 = 1185\nfoo 1187 = 1186\nfoo 1188 = 1187\nfoo 1189 = 1188\nfoo 1190 = 1189\nfoo 1191 = 1190\nfoo 1192 = 1191\nfoo 1193 = 1192\nfoo 1194 = 1193\nfoo 1195 = 1194\nfoo 1196 = 1195\nfoo 1197 = 1196\nfoo 1198 = 1197\nfoo 1199 = 1198\nfoo 1200 = 1199\nfoo 1201 = 1200\nfoo 1202 = 1201\nfoo 1203 = 1202\nfoo 1204 = 1203\nfoo 1205 = 1204\nfoo 1206 = 1205\nfoo 1207 = 1206\nfoo 1208 = 1207\nfoo 1209 = 1208\nfoo 1210 = 1209\nfoo 1211 = 1210\nfoo 1212 = 1211\nfoo 1213 = 1212\nfoo 1214 = 1213\nfoo 1215 = 1214\nfoo 1216 = 1215\nfoo 1217 = 1216\nfoo 1218 = 1217\nfoo 1219 = 1218\nfoo 1220 = 1219\nfoo 1221 = 1220\nfoo 1222 = 1221\nfoo 1223 = 1222\nfoo 1224 = 1223\nfoo 1225 = 1224\nfoo 1226 = 1225\nfoo 1227 = 1226\nfoo 1228 = 1227\nfoo 1229 = 1228\nfoo 1230 = 1229\nfoo 1231 = 1230\nfoo 1232 = 1231\nfoo 1233 = 1232\nfoo 1234 = 1233\nfoo 1235 = 1234\nfoo 1236 = 1235\nfoo 1237 = 1236\nfoo 1238 = 1237\nfoo 1239 = 1238\nfoo 1240 = 1239\nfoo 1241 = 1240\nfoo 1242 = 1241\nfoo 1243 = 1242\nfoo 1244 = 1243\nfoo 1245 = 1244\nfoo 1246 = 1245\nfoo 1247 = 1246\nfoo 1248 = 1247\nfoo 1249 = 1248\nfoo 1250 = 1249\nfoo 1251 = 1250\nfoo 1252 = 1251\nfoo 1253 = 1252\nfoo 1254 = 1253\nfoo 1255 = 1254\nfoo 1256 = 1255\nfoo 1257 = 1256\nfoo 1258 = 1257\nfoo 1259 = 1258\nfoo 1260 = 1259\nfoo 1261 = 1260\nfoo 1262 = 1261\nfoo 1263 = 1262\nfoo 1264 = 1263\nfoo 1265 = 1264\nfoo 1266 = 1265\nfoo 1267 = 1266\nfoo 1268 = 1267\nfoo 1269 = 1268\nfoo 1270 = 1269\nfoo 1271 = 1270\nfoo 1272 = 1271\nfoo 1273 = 1272\nfoo 1274 = 1273\nfoo 1275 = 1274\nfoo 1276 = 1275\nfoo 1277 = 1276\nfoo 1278 = 1277\nfoo 1279 = 1278\nfoo 1280 = 1279\nfoo 1281 = 1280\nfoo 1282 = 1281\nfoo 1283 = 1282\nfoo 1284 = 1283\nfoo 1285 = 1284\nfoo 1286 = 1285\nfoo 1287 = 1286\nfoo 1288 = 1287\nfoo 1289 = 1288\nfoo 1290 = 1289\nfoo 1291 = 1290\nfoo 1292 = 1291\nfoo 1293 = 1292\nfoo 1294 = 1293\nfoo 1295 = 1294\nfoo 1296 = 1295\nfoo 1297 = 1296\nfoo 1298 = 1297\nfoo 1299 = 1298\nfoo 1300 = 1299\nfoo 1301 = 1300\nfoo 1302 = 1301\nfoo 1303 = 1302\nfoo 1304 = 1303\nfoo 1305 = 1304\nfoo 1306 = 1305\nfoo 1307 = 1306\nfoo 1308 = 1307\nfoo 1309 = 1308\nfoo 1310 = 1309\nfoo 1311 = 1310\nfoo 1312 = 1311\nfoo 1313 = 1312\nfoo 1314 = 1313\nfoo 1315 = 1314\nfoo 1316 = 1315\nfoo 1317 = 1316\nfoo 1318 = 1317\nfoo 1319 = 1318\nfoo 1320 = 1319\nfoo 1321 = 1320\nfoo 1322 = 1321\nfoo 1323 = 1322\nfoo 1324 = 1323\nfoo 1325 = 1324\nfoo 1326 = 1325\nfoo 1327 = 1326\nfoo 1328 = 1327\nfoo 1329 = 1328\nfoo 1330 = 1329\nfoo 1331 = 1330\nfoo 1332 = 1331\nfoo 1333 = 1332\nfoo 1334 = 1333\nfoo 1335 = 1334\nfoo 1336 = 1335\nfoo 1337 = 1336\nfoo 1338 = 1337\nfoo 1339 = 1338\nfoo 1340 = 1339\nfoo 1341 = 1340\nfoo 1342 = 1341\nfoo 1343 = 1342\nfoo 1344 = 1343\nfoo 1345 = 1344\nfoo 1346 = 1345\nfoo 1347 = 1346\nfoo 1348 = 1347\nfoo 1349 = 1348\nfoo 1350 = 1349\nfoo 1351 = 1350\nfoo 1352 = 1351\nfoo 1353 = 1352\nfoo 1354 = 1353\nfoo 1355 = 1354\nfoo 1356 = 1355\nfoo 1357 = 1356\nfoo 1358 = 1357\nfoo 1359 = 1358\nfoo 1360 = 1359\nfoo 1361 = 1360\nfoo 1362 = 1361\nfoo 1363 = 1362\nfoo 1364 = 1363\nfoo 1365 = 1364\nfoo 1366 = 1365\nfoo 1367 = 1366\nfoo 1368 = 1367\nfoo 1369 = 1368\nfoo 1370 = 1369\nfoo 1371 = 1370\nfoo 1372 = 1371\nfoo 1373 = 1372\nfoo 1374 = 1373\nfoo 1375 = 1374\nfoo 1376 = 1375\nfoo 1377 = 1376\nfoo 1378 = 1377\nfoo 1379 = 1378\nfoo 1380 = 1379\nfoo 1381 = 1380\nfoo 1382 = 1381\nfoo 1383 = 1382\nfoo 1384 = 1383\nfoo 1385 = 1384\nfoo 1386 = 1385\nfoo 1387 = 1386\nfoo 1388 = 1387\nfoo 1389 = 1388\nfoo 1390 = 1389\nfoo 1391 = 1390\nfoo 1392 = 1391\nfoo 1393 = 1392\nfoo 1394 = 1393\nfoo 1395 = 1394\nfoo 1396 = 1395\nfoo 1397 = 1396\nfoo 1398 = 1397\nfoo 1399 = 1398\nfoo 1400 = 1399\nfoo 1401 = 1400\nfoo 1402 = 1401\nfoo 1403 = 1402\nfoo 1404 = 1403\nfoo 1405 = 1404\nfoo 1406 = 1405\nfoo 1407 = 1406\nfoo 1408 = 1407\nfoo 1409 = 1408\nfoo 1410 = 1409\nfoo 1411 = 1410\nfoo 1412 = 1411\nfoo 1413 = 1412\nfoo 1414 = 1413\nfoo 1415 = 1414\nfoo 1416 = 1415\nfoo 1417 = 1416\nfoo 1418 = 1417\nfoo 1419 = 1418\nfoo 1420 = 1419\nfoo 1421 = 1420\nfoo 1422 = 1421\nfoo 1423 = 1422\nfoo 1424 = 1423\nfoo 1425 = 1424\nfoo 1426 = 1425\nfoo 1427 = 1426\nfoo 1428 = 1427\nfoo 1429 = 1428\nfoo 1430 = 1429\nfoo 1431 = 1430\nfoo 1432 = 1431\nfoo 1433 = 1432\nfoo 1434 = 1433\nfoo 1435 = 1434\nfoo 1436 = 1435\nfoo 1437 = 1436\nfoo 1438 = 1437\nfoo 1439 = 1438\nfoo 1440 = 1439\nfoo 1441 = 1440\nfoo 1442 = 1441\nfoo 1443 = 1442\nfoo 1444 = 1443\nfoo 1445 = 1444\nfoo 1446 = 1445\nfoo 1447 = 1446\nfoo 1448 = 1447\nfoo 1449 = 1448\nfoo 1450 = 1449\nfoo 1451 = 1450\nfoo 1452 = 1451\nfoo 1453 = 1452\nfoo 1454 = 1453\nfoo 1455 = 1454\nfoo 1456 = 1455\nfoo 1457 = 1456\nfoo 1458 = 1457\nfoo 1459 = 1458\nfoo 1460 = 1459\nfoo 1461 = 1460\nfoo 1462 = 1461\nfoo 1463 = 1462\nfoo 1464 = 1463\nfoo 1465 = 1464\nfoo 1466 = 1465\nfoo 1467 = 1466\nfoo 1468 = 1467\nfoo 1469 = 1468\nfoo 1470 = 1469\nfoo 1471 = 1470\nfoo 1472 = 1471\nfoo 1473 = 1472\nfoo 1474 = 1473\nfoo 1475 = 1474\nfoo 1476 = 1475\nfoo 1477 = 1476\nfoo 1478 = 1477\nfoo 1479 = 1478\nfoo 1480 = 1479\nfoo 1481 = 1480\nfoo 1482 = 1481\nfoo 1483 = 1482\nfoo 1484 = 1483\nfoo 1485 = 1484\nfoo 1486 = 1485\nfoo 1487 = 1486\nfoo 1488 = 1487\nfoo 1489 = 1488\nfoo 1490 = 1489\nfoo 1491 = 1490\nfoo 1492 = 1491\nfoo 1493 = 1492\nfoo 1494 = 1493\nfoo 1495 = 1494\nfoo 1496 = 1495\nfoo 1497 = 1496\nfoo 1498 = 1497\nfoo 1499 = 1498\nfoo 1500 = 1499\nfoo 1501 = 1500\nfoo 1502 = 1501\nfoo 1503 = 1502\nfoo 1504 = 1503\nfoo 1505 = 1504\nfoo 1506 = 1505\nfoo 1507 = 1506\nfoo 1508 = 1507\nfoo 1509 = 1508\nfoo 1510 = 1509\nfoo 1511 = 1510\nfoo 1512 = 1511\nfoo 1513 = 1512\nfoo 1514 = 1513\nfoo 1515 = 1514\nfoo 1516 = 1515\nfoo 1517 = 1516\nfoo 1518 = 1517\nfoo 1519 = 1518\nfoo 1520 = 1519\nfoo 1521 = 1520\nfoo 1522 = 1521\nfoo 1523 = 1522\nfoo 1524 = 1523\nfoo 1525 = 1524\nfoo 1526 = 1525\nfoo 1527 = 1526\nfoo 1528 = 1527\nfoo 1529 = 1528\nfoo 1530 = 1529\nfoo 1531 = 1530\nfoo 1532 = 1531\nfoo 1533 = 1532\nfoo 1534 = 1533\nfoo 1535 = 1534\nfoo 1536 = 1535\nfoo 1537 = 1536\nfoo 1538 = 1537\nfoo 1539 = 1538\nfoo 1540 = 1539\nfoo 1541 = 1540\nfoo 1542 = 1541\nfoo 1543 = 1542\nfoo 1544 = 1543\nfoo 1545 = 1544\nfoo 1546 = 1545\nfoo 1547 = 1546\nfoo 1548 = 1547\nfoo 1549 = 1548\nfoo 1550 = 1549\nfoo 1551 = 1550\nfoo 1552 = 1551\nfoo 1553 = 1552\nfoo 1554 = 1553\nfoo 1555 = 1554\nfoo 1556 = 1555\nfoo 1557 = 1556\nfoo 1558 = 1557\nfoo 1559 = 1558\nfoo 1560 = 1559\nfoo 1561 = 1560\nfoo 1562 = 1561\nfoo 1563 = 1562\nfoo 1564 = 1563\nfoo 1565 = 1564\nfoo 1566 = 1565\nfoo 1567 = 1566\nfoo 1568 = 1567\nfoo 1569 = 1568\nfoo 1570 = 1569\nfoo 1571 = 1570\nfoo 1572 = 1571\nfoo 1573 = 1572\nfoo 1574 = 1573\nfoo 1575 = 1574\nfoo 1576 = 1575\nfoo 1577 = 1576\nfoo 1578 = 1577\nfoo 1579 = 1578\nfoo 1580 = 1579\nfoo 1581 = 1580\nfoo 1582 = 1581\nfoo 1583 = 1582\nfoo 1584 = 1583\nfoo 1585 = 1584\nfoo 1586 = 1585\nfoo 1587 = 1586\nfoo 1588 = 1587\nfoo 1589 = 1588\nfoo 1590 = 1589\nfoo 1591 = 1590\nfoo 1592 = 1591\nfoo 1593 = 1592\nfoo 1594 = 1593\nfoo 1595 = 1594\nfoo 1596 = 1595\nfoo 1597 = 1596\nfoo 1598 = 1597\nfoo 1599 = 1598\nfoo 1600 = 1599\nfoo 1601 = 1600\nfoo 1602 = 1601\nfoo 1603 = 1602\nfoo 1604 = 1603\nfoo 1605 = 1604\nfoo 1606 = 1605\nfoo 1607 = 1606\nfoo 1608 = 1607\nfoo 1609 = 1608\nfoo 1610 = 1609\nfoo 1611 = 1610\nfoo 1612 = 1611\nfoo 1613 = 1612\nfoo 1614 = 1613\nfoo 1615 = 1614\nfoo 1616 = 1615\nfoo 1617 = 1616\nfoo 1618 = 1617\nfoo 1619 = 1618\nfoo 1620 = 1619\nfoo 1621 = 1620\nfoo 1622 = 1621\nfoo 1623 = 1622\nfoo 1624 = 1623\nfoo 1625 = 1624\nfoo 1626 = 1625\nfoo 1627 = 1626\nfoo 1628 = 1627\nfoo 1629 = 1628\nfoo 1630 = 1629\nfoo 1631 = 1630\nfoo 1632 = 1631\nfoo 1633 = 1632\nfoo 1634 = 1633\nfoo 1635 = 1634\nfoo 1636 = 1635\nfoo 1637 = 1636\nfoo 1638 = 1637\nfoo 1639 = 1638\nfoo 1640 = 1639\nfoo 1641 = 1640\nfoo 1642 = 1641\nfoo 1643 = 1642\nfoo 1644 = 1643\nfoo 1645 = 1644\nfoo 1646 = 1645\nfoo 1647 = 1646\nfoo 1648 = 1647\nfoo 1649 = 1648\nfoo 1650 = 1649\nfoo 1651 = 1650\nfoo 1652 = 1651\nfoo 1653 = 1652\nfoo 1654 = 1653\nfoo 1655 = 1654\nfoo 1656 = 1655\nfoo 1657 = 1656\nfoo 1658 = 1657\nfoo 1659 = 1658\nfoo 1660 = 1659\nfoo 1661 = 1660\nfoo 1662 = 1661\nfoo 1663 = 1662\nfoo 1664 = 1663\nfoo 1665 = 1664\nfoo 1666 = 1665\nfoo 1667 = 1666\nfoo 1668 = 1667\nfoo 1669 = 1668\nfoo 1670 = 1669\nfoo 1671 = 1670\nfoo 1672 = 1671\nfoo 1673 = 1672\nfoo 1674 = 1673\nfoo 1675 = 1674\nfoo 1676 = 1675\nfoo 1677 = 1676\nfoo 1678 = 1677\nfoo 1679 = 1678\nfoo 1680 = 1679\nfoo 1681 = 1680\nfoo 1682 = 1681\nfoo 1683 = 1682\nfoo 1684 = 1683\nfoo 1685 = 1684\nfoo 1686 = 1685\nfoo 1687 = 1686\nfoo 1688 = 1687\nfoo 1689 = 1688\nfoo 1690 = 1689\nfoo 1691 = 1690\nfoo 1692 = 1691\nfoo 1693 = 1692\nfoo 1694 = 1693\nfoo 1695 = 1694\nfoo 1696 = 1695\nfoo 1697 = 1696\nfoo 1698 = 1697\nfoo 1699 = 1698\nfoo 1700 = 1699\nfoo 1701 = 1700\nfoo 1702 = 1701\nfoo 1703 = 1702\nfoo 1704 = 1703\nfoo 1705 = 1704\nfoo 1706 = 1705\nfoo 1707 = 1706\nfoo 1708 = 1707\nfoo 1709 = 1708\nfoo 1710 = 1709\nfoo 1711 = 1710\nfoo 1712 = 1711\nfoo 1713 = 1712\nfoo 1714 = 1713\nfoo 1715 = 1714\nfoo 1716 = 1715\nfoo 1717 = 1716\nfoo 1718 = 1717\nfoo 1719 = 1718\nfoo 1720 = 1719\nfoo 1721 = 1720\nfoo 1722 = 1721\nfoo 1723 = 1722\nfoo 1724 = 1723\nfoo 1725 = 1724\nfoo 1726 = 1725\nfoo 1727 = 1726\nfoo 1728 = 1727\nfoo 1729 = 1728\nfoo 1730 = 1729\nfoo 1731 = 1730\nfoo 1732 = 1731\nfoo 1733 = 1732\nfoo 1734 = 1733\nfoo 1735 = 1734\nfoo 1736 = 1735\nfoo 1737 = 1736\nfoo 1738 = 1737\nfoo 1739 = 1738\nfoo 1740 = 1739\nfoo 1741 = 1740\nfoo 1742 = 1741\nfoo 1743 = 1742\nfoo 1744 = 1743\nfoo 1745 = 1744\nfoo 1746 = 1745\nfoo 1747 = 1746\nfoo 1748 = 1747\nfoo 1749 = 1748\nfoo 1750 = 1749\nfoo 1751 = 1750\nfoo 1752 = 1751\nfoo 1753 = 1752\nfoo 1754 = 1753\nfoo 1755 = 1754\nfoo 1756 = 1755\nfoo 1757 = 1756\nfoo 1758 = 1757\nfoo 1759 = 1758\nfoo 1760 = 1759\nfoo 1761 = 1760\nfoo 1762 = 1761\nfoo 1763 = 1762\nfoo 1764 = 1763\nfoo 1765 = 1764\nfoo 1766 = 1765\nfoo 1767 = 1766\nfoo 1768 = 1767\nfoo 1769 = 1768\nfoo 1770 = 1769\nfoo 1771 = 1770\nfoo 1772 = 1771\nfoo 1773 = 1772\nfoo 1774 = 1773\nfoo 1775 = 1774\nfoo 1776 = 1775\nfoo 1777 = 1776\nfoo 1778 = 1777\nfoo 1779 = 1778\nfoo 1780 = 1779\nfoo 1781 = 1780\nfoo 1782 = 1781\nfoo 1783 = 1782\nfoo 1784 = 1783\nfoo 1785 = 1784\nfoo 1786 = 1785\nfoo 1787 = 1786\nfoo 1788 = 1787\nfoo 1789 = 1788\nfoo 1790 = 1789\nfoo 1791 = 1790\nfoo 1792 = 1791\nfoo 1793 = 1792\nfoo 1794 = 1793\nfoo 1795 = 1794\nfoo 1796 = 1795\nfoo 1797 = 1796\nfoo 1798 = 1797\nfoo 1799 = 1798\nfoo 1800 = 1799\nfoo 1801 = 1800\nfoo 1802 = 1801\nfoo 1803 = 1802\nfoo 1804 = 1803\nfoo 1805 = 1804\nfoo 1806 = 1805\nfoo 1807 = 1806\nfoo 1808 = 1807\nfoo 1809 = 1808\nfoo 1810 = 1809\nfoo 1811 = 1810\nfoo 1812 = 1811\nfoo 1813 = 1812\nfoo 1814 = 1813\nfoo 1815 = 1814\nfoo 1816 = 1815\nfoo 1817 = 1816\nfoo 1818 = 1817\nfoo 1819 = 1818\nfoo 1820 = 1819\nfoo 1821 = 1820\nfoo 1822 = 1821\nfoo 1823 = 1822\nfoo 1824 = 1823\nfoo 1825 = 1824\nfoo 1826 = 1825\nfoo 1827 = 1826\nfoo 1828 = 1827\nfoo 1829 = 1828\nfoo 1830 = 1829\nfoo 1831 = 1830\nfoo 1832 = 1831\nfoo 1833 = 1832\nfoo 1834 = 1833\nfoo 1835 = 1834\nfoo 1836 = 1835\nfoo 1837 = 1836\nfoo 1838 = 1837\nfoo 1839 = 1838\nfoo 1840 = 1839\nfoo 1841 = 1840\nfoo 1842 = 1841\nfoo 1843 = 1842\nfoo 1844 = 1843\nfoo 1845 = 1844\nfoo 1846 = 1845\nfoo 1847 = 1846\nfoo 1848 = 1847\nfoo 1849 = 1848\nfoo 1850 = 1849\nfoo 1851 = 1850\nfoo 1852 = 1851\nfoo 1853 = 1852\nfoo 1854 = 1853\nfoo 1855 = 1854\nfoo 1856 = 1855\nfoo 1857 = 1856\nfoo 1858 = 1857\nfoo 1859 = 1858\nfoo 1860 = 1859\nfoo 1861 = 1860\nfoo 1862 = 1861\nfoo 1863 = 1862\nfoo 1864 = 1863\nfoo 1865 = 1864\nfoo 1866 = 1865\nfoo 1867 = 1866\nfoo 1868 = 1867\nfoo 1869 = 1868\nfoo 1870 = 1869\nfoo 1871 = 1870\nfoo 1872 = 1871\nfoo 1873 = 1872\nfoo 1874 = 1873\nfoo 1875 = 1874\nfoo 1876 = 1875\nfoo 1877 = 1876\nfoo 1878 = 1877\nfoo 1879 = 1878\nfoo 1880 = 1879\nfoo 1881 = 1880\nfoo 1882 = 1881\nfoo 1883 = 1882\nfoo 1884 = 1883\nfoo 1885 = 1884\nfoo 1886 = 1885\nfoo 1887 = 1886\nfoo 1888 = 1887\nfoo 1889 = 1888\nfoo 1890 = 1889\nfoo 1891 = 1890\nfoo 1892 = 1891\nfoo 1893 = 1892\nfoo 1894 = 1893\nfoo 1895 = 1894\nfoo 1896 = 1895\nfoo 1897 = 1896\nfoo 1898 = 1897\nfoo 1899 = 1898\nfoo 1900 = 1899\nfoo 1901 = 1900\nfoo 1902 = 1901\nfoo 1903 = 1902\nfoo 1904 = 1903\nfoo 1905 = 1904\nfoo 1906 = 1905\nfoo 1907 = 1906\nfoo 1908 = 1907\nfoo 1909 = 1908\nfoo 1910 = 1909\nfoo 1911 = 1910\nfoo 1912 = 1911\nfoo 1913 = 1912\nfoo 1914 = 1913\nfoo 1915 = 1914\nfoo 1916 = 1915\nfoo 1917 = 1916\nfoo 1918 = 1917\nfoo 1919 = 1918\nfoo 1920 = 1919\nfoo 1921 = 1920\nfoo 1922 = 1921\nfoo 1923 = 1922\nfoo 1924 = 1923\nfoo 1925 = 1924\nfoo 1926 = 1925\nfoo 1927 = 1926\nfoo 1928 = 1927\nfoo 1929 = 1928\nfoo 1930 = 1929\nfoo 1931 = 1930\nfoo 1932 = 1931\nfoo 1933 = 1932\nfoo 1934 = 1933\nfoo 1935 = 1934\nfoo 1936 = 1935\nfoo 1937 = 1936\nfoo 1938 = 1937\nfoo 1939 = 1938\nfoo 1940 = 1939\nfoo 1941 = 1940\nfoo 1942 = 1941\nfoo 1943 = 1942\nfoo 1944 = 1943\nfoo 1945 = 1944\nfoo 1946 = 1945\nfoo 1947 = 1946\nfoo 1948 = 1947\nfoo 1949 = 1948\nfoo 1950 = 1949\nfoo 1951 = 1950\nfoo 1952 = 1951\nfoo 1953 = 1952\nfoo 1954 = 1953\nfoo 1955 = 1954\nfoo 1956 = 1955\nfoo 1957 = 1956\nfoo 1958 = 1957\nfoo 1959 = 1958\nfoo 1960 = 1959\nfoo 1961 = 1960\nfoo 1962 = 1961\nfoo 1963 = 1962\nfoo 1964 = 1963\nfoo 1965 = 1964\nfoo 1966 = 1965\nfoo 1967 = 1966\nfoo 1968 = 1967\nfoo 1969 = 1968\nfoo 1970 = 1969\nfoo 1971 = 1970\nfoo 1972 = 1971\nfoo 1973 = 1972\nfoo 1974 = 1973\nfoo 1975 = 1974\nfoo 1976 = 1975\nfoo 1977 = 1976\nfoo 1978 = 1977\nfoo 1979 = 1978\nfoo 1980 = 1979\nfoo 1981 = 1980\nfoo 1982 = 1981\nfoo 1983 = 1982\nfoo 1984 = 1983\nfoo 1985 = 1984\nfoo 1986 = 1985\nfoo 1987 = 1986\nfoo 1988 = 1987\nfoo 1989 = 1988\nfoo 1990 = 1989\nfoo 1991 = 1990\nfoo 1992 = 1991\nfoo 1993 = 1992\nfoo 1994 = 1993\nfoo 1995 = 1994\nfoo 1996 = 1995\nfoo 1997 = 1996\nfoo 1998 = 1997\nfoo 1999 = 1998\nfoo 2000 = 1999\nfoo 2001 = 2000\nfoo 2002 = 2001\nfoo 2003 = 2002\nfoo 2004 = 2003\nfoo 2005 = 2004\nfoo 2006 = 2005\nfoo 2007 = 2006\nfoo 2008 = 2007\nfoo 2009 = 2008\nfoo 2010 = 2009\nfoo 2011 = 2010\nfoo 2012 = 2011\nfoo 2013 = 2012\nfoo 2014 = 2013\nfoo 2015 = 2014\nfoo 2016 = 2015\nfoo 2017 = 2016\nfoo 2018 = 2017\nfoo 2019 = 2018\nfoo 2020 = 2019\nfoo 2021 = 2020\nfoo 2022 = 2021\nfoo 2023 = 2022\nfoo 2024 = 2023\nfoo 2025 = 2024\nfoo 2026 = 2025\nfoo 2027 = 2026\nfoo 2028 = 2027\nfoo 2029 = 2028\nfoo 2030 = 2029\nfoo 2031 = 2030\nfoo 2032 = 2031\nfoo 2033 = 2032\nfoo 2034 = 2033\nfoo 2035 = 2034\nfoo 2036 = 2035\nfoo 2037 = 2036\nfoo 2038 = 2037\nfoo 2039 = 2038\nfoo 2040 = 2039\nfoo 2041 = 2040\nfoo 2042 = 2041\nfoo 2043 = 2042\nfoo 2044 = 2043\nfoo 2045 = 2044\nfoo 2046 = 2045\nfoo 2047 = 2046\nfoo 2048 = 2047\nfoo 2049 = 2048\nfoo 2050 = 2049\nfoo 2051 = 2050\nfoo 2052 = 2051\nfoo 2053 = 2052\nfoo 2054 = 2053\nfoo 2055 = 2054\nfoo 2056 = 2055\nfoo 2057 = 2056\nfoo 2058 = 2057\nfoo 2059 = 2058\nfoo 2060 = 2059\nfoo 2061 = 2060\nfoo 2062 = 2061\nfoo 2063 = 2062\nfoo 2064 = 2063\nfoo 2065 = 2064\nfoo 2066 = 2065\nfoo 2067 = 2066\nfoo 2068 = 2067\nfoo 2069 = 2068\nfoo 2070 = 2069\nfoo 2071 = 2070\nfoo 2072 = 2071\nfoo 2073 = 2072\nfoo 2074 = 2073\nfoo 2075 = 2074\nfoo 2076 = 2075\nfoo 2077 = 2076\nfoo 2078 = 2077\nfoo 2079 = 2078\nfoo 2080 = 2079\nfoo 2081 = 2080\nfoo 2082 = 2081\nfoo 2083 = 2082\nfoo 2084 = 2083\nfoo 2085 = 2084\nfoo 2086 = 2085\nfoo 2087 = 2086\nfoo 2088 = 2087\nfoo 2089 = 2088\nfoo 2090 = 2089\nfoo 2091 = 2090\nfoo 2092 = 2091\nfoo 2093 = 2092\nfoo 2094 = 2093\nfoo 2095 = 2094\nfoo 2096 = 2095\nfoo 2097 = 2096\nfoo 2098 = 2097\nfoo 2099 = 2098\nfoo 2100 = 2099\nfoo 2101 = 2100\nfoo 2102 = 2101\nfoo 2103 = 2102\nfoo 2104 = 2103\nfoo 2105 = 2104\nfoo 2106 = 2105\nfoo 2107 = 2106\nfoo 2108 = 2107\nfoo 2109 = 2108\nfoo 2110 = 2109\nfoo 2111 = 2110\nfoo 2112 = 2111\nfoo 2113 = 2112\nfoo 2114 = 2113\nfoo 2115 = 2114\nfoo 2116 = 2115\nfoo 2117 = 2116\nfoo 2118 = 2117\nfoo 2119 = 2118\nfoo 2120 = 2119\nfoo 2121 = 2120\nfoo 2122 = 2121\nfoo 2123 = 2122\nfoo 2124 = 2123\nfoo 2125 = 2124\nfoo 2126 = 2125\nfoo 2127 = 2126\nfoo 2128 = 2127\nfoo 2129 = 2128\nfoo 2130 = 2129\nfoo 2131 = 2130\nfoo 2132 = 2131\nfoo 2133 = 2132\nfoo 2134 = 2133\nfoo 2135 = 2134\nfoo 2136 = 2135\nfoo 2137 = 2136\nfoo 2138 = 2137\nfoo 2139 = 2138\nfoo 2140 = 2139\nfoo 2141 = 2140\nfoo 2142 = 2141\nfoo 2143 = 2142\nfoo 2144 = 2143\nfoo 2145 = 2144\nfoo 2146 = 2145\nfoo 2147 = 2146\nfoo 2148 = 2147\nfoo 2149 = 2148\nfoo 2150 = 2149\nfoo 2151 = 2150\nfoo 2152 = 2151\nfoo 2153 = 2152\nfoo 2154 = 2153\nfoo 2155 = 2154\nfoo 2156 = 2155\nfoo 2157 = 2156\nfoo 2158 = 2157\nfoo 2159 = 2158\nfoo 2160 = 2159\nfoo 2161 = 2160\nfoo 2162 = 2161\nfoo 2163 = 2162\nfoo 2164 = 2163\nfoo 2165 = 2164\nfoo 2166 = 2165\nfoo 2167 = 2166\nfoo 2168 = 2167\nfoo 2169 = 2168\nfoo 2170 = 2169\nfoo 2171 = 2170\nfoo 2172 = 2171\nfoo 2173 = 2172\nfoo 2174 = 2173\nfoo 2175 = 2174\nfoo 2176 = 2175\nfoo 2177 = 2176\nfoo 2178 = 2177\nfoo 2179 = 2178\nfoo 2180 = 2179\nfoo 2181 = 2180\nfoo 2182 = 2181\nfoo 2183 = 2182\nfoo 2184 = 2183\nfoo 2185 = 2184\nfoo 2186 = 2185\nfoo 2187 = 2186\nfoo 2188 = 2187\nfoo 2189 = 2188\nfoo 2190 = 2189\nfoo 2191 = 2190\nfoo 2192 = 2191\nfoo 2193 = 2192\nfoo 2194 = 2193\nfoo 2195 = 2194\nfoo 2196 = 2195\nfoo 2197 = 2196\nfoo 2198 = 2197\nfoo 2199 = 2198\nfoo 2200 = 2199\nfoo 2201 = 2200\nfoo 2202 = 2201\nfoo 2203 = 2202\nfoo 2204 = 2203\nfoo 2205 = 2204\nfoo 2206 = 2205\nfoo 2207 = 2206\nfoo 2208 = 2207\nfoo 2209 = 2208\nfoo 2210 = 2209\nfoo 2211 = 2210\nfoo 2212 = 2211\nfoo 2213 = 2212\nfoo 2214 = 2213\nfoo 2215 = 2214\nfoo 2216 = 2215\nfoo 2217 = 2216\nfoo 2218 = 2217\nfoo 2219 = 2218\nfoo 2220 = 2219\nfoo 2221 = 2220\nfoo 2222 = 2221\nfoo 2223 = 2222\nfoo 2224 = 2223\nfoo 2225 = 2224\nfoo 2226 = 2225\nfoo 2227 = 2226\nfoo 2228 = 2227\nfoo 2229 = 2228\nfoo 2230 = 2229\nfoo 2231 = 2230\nfoo 2232 = 2231\nfoo 2233 = 2232\nfoo 2234 = 2233\nfoo 2235 = 2234\nfoo 2236 = 2235\nfoo 2237 = 2236\nfoo 2238 = 2237\nfoo 2239 = 2238\nfoo 2240 = 2239\nfoo 2241 = 2240\nfoo 2242 = 2241\nfoo 2243 = 2242\nfoo 2244 = 2243\nfoo 2245 = 2244\nfoo 2246 = 2245\nfoo 2247 = 2246\nfoo 2248 = 2247\nfoo 2249 = 2248\nfoo 2250 = 2249\nfoo 2251 = 2250\nfoo 2252 = 2251\nfoo 2253 = 2252\nfoo 2254 = 2253\nfoo 2255 = 2254\nfoo 2256 = 2255\nfoo 2257 = 2256\nfoo 2258 = 2257\nfoo 2259 = 2258\nfoo 2260 = 2259\nfoo 2261 = 2260\nfoo 2262 = 2261\nfoo 2263 = 2262\nfoo 2264 = 2263\nfoo 2265 = 2264\nfoo 2266 = 2265\nfoo 2267 = 2266\nfoo 2268 = 2267\nfoo 2269 = 2268\nfoo 2270 = 2269\nfoo 2271 = 2270\nfoo 2272 = 2271\nfoo 2273 = 2272\nfoo 2274 = 2273\nfoo 2275 = 2274\nfoo 2276 = 2275\nfoo 2277 = 2276\nfoo 2278 = 2277\nfoo 2279 = 2278\nfoo 2280 = 2279\nfoo 2281 = 2280\nfoo 2282 = 2281\nfoo 2283 = 2282\nfoo 2284 = 2283\nfoo 2285 = 2284\nfoo 2286 = 2285\nfoo 2287 = 2286\nfoo 2288 = 2287\nfoo 2289 = 2288\nfoo 2290 = 2289\nfoo 2291 = 2290\nfoo 2292 = 2291\nfoo 2293 = 2292\nfoo 2294 = 2293\nfoo 2295 = 2294\nfoo 2296 = 2295\nfoo 2297 = 2296\nfoo 2298 = 2297\nfoo 2299 = 2298\nfoo 2300 = 2299\nfoo 2301 = 2300\nfoo 2302 = 2301\nfoo 2303 = 2302\nfoo 2304 = 2303\nfoo 2305 = 2304\nfoo 2306 = 2305\nfoo 2307 = 2306\nfoo 2308 = 2307\nfoo 2309 = 2308\nfoo 2310 = 2309\nfoo 2311 = 2310\nfoo 2312 = 2311\nfoo 2313 = 2312\nfoo 2314 = 2313\nfoo 2315 = 2314\nfoo 2316 = 2315\nfoo 2317 = 2316\nfoo 2318 = 2317\nfoo 2319 = 2318\nfoo 2320 = 2319\nfoo 2321 = 2320\nfoo 2322 = 2321\nfoo 2323 = 2322\nfoo 2324 = 2323\nfoo 2325 = 2324\nfoo 2326 = 2325\nfoo 2327 = 2326\nfoo 2328 = 2327\nfoo 2329 = 2328\nfoo 2330 = 2329\nfoo 2331 = 2330\nfoo 2332 = 2331\nfoo 2333 = 2332\nfoo 2334 = 2333\nfoo 2335 = 2334\nfoo 2336 = 2335\nfoo 2337 = 2336\nfoo 2338 = 2337\nfoo 2339 = 2338\nfoo 2340 = 2339\nfoo 2341 = 2340\nfoo 2342 = 2341\nfoo 2343 = 2342\nfoo 2344 = 2343\nfoo 2345 = 2344\nfoo 2346 = 2345\nfoo 2347 = 2346\nfoo 2348 = 2347\nfoo 2349 = 2348\nfoo 2350 = 2349\nfoo 2351 = 2350\nfoo 2352 = 2351\nfoo 2353 = 2352\nfoo 2354 = 2353\nfoo 2355 = 2354\nfoo 2356 = 2355\nfoo 2357 = 2356\nfoo 2358 = 2357\nfoo 2359 = 2358\nfoo 2360 = 2359\nfoo 2361 = 2360\nfoo 2362 = 2361\nfoo 2363 = 2362\nfoo 2364 = 2363\nfoo 2365 = 2364\nfoo 2366 = 2365\nfoo 2367 = 2366\nfoo 2368 = 2367\nfoo 2369 = 2368\nfoo 2370 = 2369\nfoo 2371 = 2370\nfoo 2372 = 2371\nfoo 2373 = 2372\nfoo 2374 = 2373\nfoo 2375 = 2374\nfoo 2376 = 2375\nfoo 2377 = 2376\nfoo 2378 = 2377\nfoo 2379 = 2378\nfoo 2380 = 2379\nfoo 2381 = 2380\nfoo 2382 = 2381\nfoo 2383 = 2382\nfoo 2384 = 2383\nfoo 2385 = 2384\nfoo 2386 = 2385\nfoo 2387 = 2386\nfoo 2388 = 2387\nfoo 2389 = 2388\nfoo 2390 = 2389\nfoo 2391 = 2390\nfoo 2392 = 2391\nfoo 2393 = 2392\nfoo 2394 = 2393\nfoo 2395 = 2394\nfoo 2396 = 2395\nfoo 2397 = 2396\nfoo 2398 = 2397\nfoo 2399 = 2398\nfoo 2400 = 2399\nfoo 2401 = 2400\nfoo 2402 = 2401\nfoo 2403 = 2402\nfoo 2404 = 2403\nfoo 2405 = 2404\nfoo 2406 = 2405\nfoo 2407 = 2406\nfoo 2408 = 2407\nfoo 2409 = 2408\nfoo 2410 = 2409\nfoo 2411 = 2410\nfoo 2412 = 2411\nfoo 2413 = 2412\nfoo 2414 = 2413\nfoo 2415 = 2414\nfoo 2416 = 2415\nfoo 2417 = 2416\nfoo 2418 = 2417\nfoo 2419 = 2418\nfoo 2420 = 2419\nfoo 2421 = 2420\nfoo 2422 = 2421\nfoo 2423 = 2422\nfoo 2424 = 2423\nfoo 2425 = 2424\nfoo 2426 = 2425\nfoo 2427 = 2426\nfoo 2428 = 2427\nfoo 2429 = 2428\nfoo 2430 = 2429\nfoo 2431 = 2430\nfoo 2432 = 2431\nfoo 2433 = 2432\nfoo 2434 = 2433\nfoo 2435 = 2434\nfoo 2436 = 2435\nfoo 2437 = 2436\nfoo 2438 = 2437\nfoo 2439 = 2438\nfoo 2440 = 2439\nfoo 2441 = 2440\nfoo 2442 = 2441\nfoo 2443 = 2442\nfoo 2444 = 2443\nfoo 2445 = 2444\nfoo 2446 = 2445\nfoo 2447 = 2446\nfoo 2448 = 2447\nfoo 2449 = 2448\nfoo 2450 = 2449\nfoo 2451 = 2450\nfoo 2452 = 2451\nfoo 2453 = 2452\nfoo 2454 = 2453\nfoo 2455 = 2454\nfoo 2456 = 2455\nfoo 2457 = 2456\nfoo 2458 = 2457\nfoo 2459 = 2458\nfoo 2460 = 2459\nfoo 2461 = 2460\nfoo 2462 = 2461\nfoo 2463 = 2462\nfoo 2464 = 2463\nfoo 2465 = 2464\nfoo 2466 = 2465\nfoo 2467 = 2466\nfoo 2468 = 2467\nfoo 2469 = 2468\nfoo 2470 = 2469\nfoo 2471 = 2470\nfoo 2472 = 2471\nfoo 2473 = 2472\nfoo 2474 = 2473\nfoo 2475 = 2474\nfoo 2476 = 2475\nfoo 2477 = 2476\nfoo 2478 = 2477\nfoo 2479 = 2478\nfoo 2480 = 2479\nfoo 2481 = 2480\nfoo 2482 = 2481\nfoo 2483 = 2482\nfoo 2484 = 2483\nfoo 2485 = 2484\nfoo 2486 = 2485\nfoo 2487 = 2486\nfoo 2488 = 2487\nfoo 2489 = 2488\nfoo 2490 = 2489\nfoo 2491 = 2490\nfoo 2492 = 2491\nfoo 2493 = 2492\nfoo 2494 = 2493\nfoo 2495 = 2494\nfoo 2496 = 2495\nfoo 2497 = 2496\nfoo 2498 = 2497\nfoo 2499 = 2498\nfoo 2500 = 2499\nfoo 2501 = 2500\nfoo 2502 = 2501\nfoo 2503 = 2502\nfoo 2504 = 2503\nfoo 2505 = 2504\nfoo 2506 = 2505\nfoo 2507 = 2506\nfoo 2508 = 2507\nfoo 2509 = 2508\nfoo 2510 = 2509\nfoo 2511 = 2510\nfoo 2512 = 2511\nfoo 2513 = 2512\nfoo 2514 = 2513\nfoo 2515 = 2514\nfoo 2516 = 2515\nfoo 2517 = 2516\nfoo 2518 = 2517\nfoo 2519 = 2518\nfoo 2520 = 2519\nfoo 2521 = 2520\nfoo 2522 = 2521\nfoo 2523 = 2522\nfoo 2524 = 2523\nfoo 2525 = 2524\nfoo 2526 = 2525\nfoo 2527 = 2526\nfoo 2528 = 2527\nfoo 2529 = 2528\nfoo 2530 = 2529\nfoo 2531 = 2530\nfoo 2532 = 2531\nfoo 2533 = 2532\nfoo 2534 = 2533\nfoo 2535 = 2534\nfoo 2536 = 2535\nfoo 2537 = 2536\nfoo 2538 = 2537\nfoo 2539 = 2538\nfoo 2540 = 2539\nfoo 2541 = 2540\nfoo 2542 = 2541\nfoo 2543 = 2542\nfoo 2544 = 2543\nfoo 2545 = 2544\nfoo 2546 = 2545\nfoo 2547 = 2546\nfoo 2548 = 2547\nfoo 2549 = 2548\nfoo 2550 = 2549\nfoo 2551 = 2550\nfoo 2552 = 2551\nfoo 2553 = 2552\nfoo 2554 = 2553\nfoo 2555 = 2554\nfoo 2556 = 2555\nfoo 2557 = 2556\nfoo 2558 = 2557\nfoo 2559 = 2558\nfoo 2560 = 2559\nfoo 2561 = 2560\nfoo 2562 = 2561\nfoo 2563 = 2562\nfoo 2564 = 2563\nfoo 2565 = 2564\nfoo 2566 = 2565\nfoo 2567 = 2566\nfoo 2568 = 2567\nfoo 2569 = 2568\nfoo 2570 = 2569\nfoo 2571 = 2570\nfoo 2572 = 2571\nfoo 2573 = 2572\nfoo 2574 = 2573\nfoo 2575 = 2574\nfoo 2576 = 2575\nfoo 2577 = 2576\nfoo 2578 = 2577\nfoo 2579 = 2578\nfoo 2580 = 2579\nfoo 2581 = 2580\nfoo 2582 = 2581\nfoo 2583 = 2582\nfoo 2584 = 2583\nfoo 2585 = 2584\nfoo 2586 = 2585\nfoo 2587 = 2586\nfoo 2588 = 2587\nfoo 2589 = 2588\nfoo 2590 = 2589\nfoo 2591 = 2590\nfoo 2592 = 2591\nfoo 2593 = 2592\nfoo 2594 = 2593\nfoo 2595 = 2594\nfoo 2596 = 2595\nfoo 2597 = 2596\nfoo 2598 = 2597\nfoo 2599 = 2598\nfoo 2600 = 2599\nfoo 2601 = 2600\nfoo 2602 = 2601\nfoo 2603 = 2602\nfoo 2604 = 2603\nfoo 2605 = 2604\nfoo 2606 = 2605\nfoo 2607 = 2606\nfoo 2608 = 2607\nfoo 2609 = 2608\nfoo 2610 = 2609\nfoo 2611 = 2610\nfoo 2612 = 2611\nfoo 2613 = 2612\nfoo 2614 = 2613\nfoo 2615 = 2614\nfoo 2616 = 2615\nfoo 2617 = 2616\nfoo 2618 = 2617\nfoo 2619 = 2618\nfoo 2620 = 2619\nfoo 2621 = 2620\nfoo 2622 = 2621\nfoo 2623 = 2622\nfoo 2624 = 2623\nfoo 2625 = 2624\nfoo 2626 = 2625\nfoo 2627 = 2626\nfoo 2628 = 2627\nfoo 2629 = 2628\nfoo 2630 = 2629\nfoo 2631 = 2630\nfoo 2632 = 2631\nfoo 2633 = 2632\nfoo 2634 = 2633\nfoo 2635 = 2634\nfoo 2636 = 2635\nfoo 2637 = 2636\nfoo 2638 = 2637\nfoo 2639 = 2638\nfoo 2640 = 2639\nfoo 2641 = 2640\nfoo 2642 = 2641\nfoo 2643 = 2642\nfoo 2644 = 2643\nfoo 2645 = 2644\nfoo 2646 = 2645\nfoo 2647 = 2646\nfoo 2648 = 2647\nfoo 2649 = 2648\nfoo 2650 = 2649\nfoo 2651 = 2650\nfoo 2652 = 2651\nfoo 2653 = 2652\nfoo 2654 = 2653\nfoo 2655 = 2654\nfoo 2656 = 2655\nfoo 2657 = 2656\nfoo 2658 = 2657\nfoo 2659 = 2658\nfoo 2660 = 2659\nfoo 2661 = 2660\nfoo 2662 = 2661\nfoo 2663 = 2662\nfoo 2664 = 2663\nfoo 2665 = 2664\nfoo 2666 = 2665\nfoo 2667 = 2666\nfoo 2668 = 2667\nfoo 2669 = 2668\nfoo 2670 = 2669\nfoo 2671 = 2670\nfoo 2672 = 2671\nfoo 2673 = 2672\nfoo 2674 = 2673\nfoo 2675 = 2674\nfoo 2676 = 2675\nfoo 2677 = 2676\nfoo 2678 = 2677\nfoo 2679 = 2678\nfoo 2680 = 2679\nfoo 2681 = 2680\nfoo 2682 = 2681\nfoo 2683 = 2682\nfoo 2684 = 2683\nfoo 2685 = 2684\nfoo 2686 = 2685\nfoo 2687 = 2686\nfoo 2688 = 2687\nfoo 2689 = 2688\nfoo 2690 = 2689\nfoo 2691 = 2690\nfoo 2692 = 2691\nfoo 2693 = 2692\nfoo 2694 = 2693\nfoo 2695 = 2694\nfoo 2696 = 2695\nfoo 2697 = 2696\nfoo 2698 = 2697\nfoo 2699 = 2698\nfoo 2700 = 2699\nfoo 2701 = 2700\nfoo 2702 = 2701\nfoo 2703 = 2702\nfoo 2704 = 2703\nfoo 2705 = 2704\nfoo 2706 = 2705\nfoo 2707 = 2706\nfoo 2708 = 2707\nfoo 2709 = 2708\nfoo 2710 = 2709\nfoo 2711 = 2710\nfoo 2712 = 2711\nfoo 2713 = 2712\nfoo 2714 = 2713\nfoo 2715 = 2714\nfoo 2716 = 2715\nfoo 2717 = 2716\nfoo 2718 = 2717\nfoo 2719 = 2718\nfoo 2720 = 2719\nfoo 2721 = 2720\nfoo 2722 = 2721\nfoo 2723 = 2722\nfoo 2724 = 2723\nfoo 2725 = 2724\nfoo 2726 = 2725\nfoo 2727 = 2726\nfoo 2728 = 2727\nfoo 2729 = 2728\nfoo 2730 = 2729\nfoo 2731 = 2730\nfoo 2732 = 2731\nfoo 2733 = 2732\nfoo 2734 = 2733\nfoo 2735 = 2734\nfoo 2736 = 2735\nfoo 2737 = 2736\nfoo 2738 = 2737\nfoo 2739 = 2738\nfoo 2740 = 2739\nfoo 2741 = 2740\nfoo 2742 = 2741\nfoo 2743 = 2742\nfoo 2744 = 2743\nfoo 2745 = 2744\nfoo 2746 = 2745\nfoo 2747 = 2746\nfoo 2748 = 2747\nfoo 2749 = 2748\nfoo 2750 = 2749\nfoo 2751 = 2750\nfoo 2752 = 2751\nfoo 2753 = 2752\nfoo 2754 = 2753\nfoo 2755 = 2754\nfoo 2756 = 2755\nfoo 2757 = 2756\nfoo 2758 = 2757\nfoo 2759 = 2758\nfoo 2760 = 2759\nfoo 2761 = 2760\nfoo 2762 = 2761\nfoo 2763 = 2762\nfoo 2764 = 2763\nfoo 2765 = 2764\nfoo 2766 = 2765\nfoo 2767 = 2766\nfoo 2768 = 2767\nfoo 2769 = 2768\nfoo 2770 = 2769\nfoo 2771 = 2770\nfoo 2772 = 2771\nfoo 2773 = 2772\nfoo 2774 = 2773\nfoo 2775 = 2774\nfoo 2776 = 2775\nfoo 2777 = 2776\nfoo 2778 = 2777\nfoo 2779 = 2778\nfoo 2780 = 2779\nfoo 2781 = 2780\nfoo 2782 = 2781\nfoo 2783 = 2782\nfoo 2784 = 2783\nfoo 2785 = 2784\nfoo 2786 = 2785\nfoo 2787 = 2786\nfoo 2788 = 2787\nfoo 2789 = 2788\nfoo 2790 = 2789\nfoo 2791 = 2790\nfoo 2792 = 2791\nfoo 2793 = 2792\nfoo 2794 = 2793\nfoo 2795 = 2794\nfoo 2796 = 2795\nfoo 2797 = 2796\nfoo 2798 = 2797\nfoo 2799 = 2798\nfoo 2800 = 2799\nfoo 2801 = 2800\nfoo 2802 = 2801\nfoo 2803 = 2802\nfoo 2804 = 2803\nfoo 2805 = 2804\nfoo 2806 = 2805\nfoo 2807 = 2806\nfoo 2808 = 2807\nfoo 2809 = 2808\nfoo 2810 = 2809\nfoo 2811 = 2810\nfoo 2812 = 2811\nfoo 2813 = 2812\nfoo 2814 = 2813\nfoo 2815 = 2814\nfoo 2816 = 2815\nfoo 2817 = 2816\nfoo 2818 = 2817\nfoo 2819 = 2818\nfoo 2820 = 2819\nfoo 2821 = 2820\nfoo 2822 = 2821\nfoo 2823 = 2822\nfoo 2824 = 2823\nfoo 2825 = 2824\nfoo 2826 = 2825\nfoo 2827 = 2826\nfoo 2828 = 2827\nfoo 2829 = 2828\nfoo 2830 = 2829\nfoo 2831 = 2830\nfoo 2832 = 2831\nfoo 2833 = 2832\nfoo 2834 = 2833\nfoo 2835 = 2834\nfoo 2836 = 2835\nfoo 2837 = 2836\nfoo 2838 = 2837\nfoo 2839 = 2838\nfoo 2840 = 2839\nfoo 2841 = 2840\nfoo 2842 = 2841\nfoo 2843 = 2842\nfoo 2844 = 2843\nfoo 2845 = 2844\nfoo 2846 = 2845\nfoo 2847 = 2846\nfoo 2848 = 2847\nfoo 2849 = 2848\nfoo 2850 = 2849\nfoo 2851 = 2850\nfoo 2852 = 2851\nfoo 2853 = 2852\nfoo 2854 = 2853\nfoo 2855 = 2854\nfoo 2856 = 2855\nfoo 2857 = 2856\nfoo 2858 = 2857\nfoo 2859 = 2858\nfoo 2860 = 2859\nfoo 2861 = 2860\nfoo 2862 = 2861\nfoo 2863 = 2862\nfoo 2864 = 2863\nfoo 2865 = 2864\nfoo 2866 = 2865\nfoo 2867 = 2866\nfoo 2868 = 2867\nfoo 2869 = 2868\nfoo 2870 = 2869\nfoo 2871 = 2870\nfoo 2872 = 2871\nfoo 2873 = 2872\nfoo 2874 = 2873\nfoo 2875 = 2874\nfoo 2876 = 2875\nfoo 2877 = 2876\nfoo 2878 = 2877\nfoo 2879 = 2878\nfoo 2880 = 2879\nfoo 2881 = 2880\nfoo 2882 = 2881\nfoo 2883 = 2882\nfoo 2884 = 2883\nfoo 2885 = 2884\nfoo 2886 = 2885\nfoo 2887 = 2886\nfoo 2888 = 2887\nfoo 2889 = 2888\nfoo 2890 = 2889\nfoo 2891 = 2890\nfoo 2892 = 2891\nfoo 2893 = 2892\nfoo 2894 = 2893\nfoo 2895 = 2894\nfoo 2896 = 2895\nfoo 2897 = 2896\nfoo 2898 = 2897\nfoo 2899 = 2898\nfoo 2900 = 2899\nfoo 2901 = 2900\nfoo 2902 = 2901\nfoo 2903 = 2902\nfoo 2904 = 2903\nfoo 2905 = 2904\nfoo 2906 = 2905\nfoo 2907 = 2906\nfoo 2908 = 2907\nfoo 2909 = 2908\nfoo 2910 = 2909\nfoo 2911 = 2910\nfoo 2912 = 2911\nfoo 2913 = 2912\nfoo 2914 = 2913\nfoo 2915 = 2914\nfoo 2916 = 2915\nfoo 2917 = 2916\nfoo 2918 = 2917\nfoo 2919 = 2918\nfoo 2920 = 2919\nfoo 2921 = 2920\nfoo 2922 = 2921\nfoo 2923 = 2922\nfoo 2924 = 2923\nfoo 2925 = 2924\nfoo 2926 = 2925\nfoo 2927 = 2926\nfoo 2928 = 2927\nfoo 2929 = 2928\nfoo 2930 = 2929\nfoo 2931 = 2930\nfoo 2932 = 2931\nfoo 2933 = 2932\nfoo 2934 = 2933\nfoo 2935 = 2934\nfoo 2936 = 2935\nfoo 2937 = 2936\nfoo 2938 = 2937\nfoo 2939 = 2938\nfoo 2940 = 2939\nfoo 2941 = 2940\nfoo 2942 = 2941\nfoo 2943 = 2942\nfoo 2944 = 2943\nfoo 2945 = 2944\nfoo 2946 = 2945\nfoo 2947 = 2946\nfoo 2948 = 2947\nfoo 2949 = 2948\nfoo 2950 = 2949\nfoo 2951 = 2950\nfoo 2952 = 2951\nfoo 2953 = 2952\nfoo 2954 = 2953\nfoo 2955 = 2954\nfoo 2956 = 2955\nfoo 2957 = 2956\nfoo 2958 = 2957\nfoo 2959 = 2958\nfoo 2960 = 2959\nfoo 2961 = 2960\nfoo 2962 = 2961\nfoo 2963 = 2962\nfoo 2964 = 2963\nfoo 2965 = 2964\nfoo 2966 = 2965\nfoo 2967 = 2966\nfoo 2968 = 2967\nfoo 2969 = 2968\nfoo 2970 = 2969\nfoo 2971 = 2970\nfoo 2972 = 2971\nfoo 2973 = 2972\nfoo 2974 = 2973\nfoo 2975 = 2974\nfoo 2976 = 2975\nfoo 2977 = 2976\nfoo 2978 = 2977\nfoo 2979 = 2978\nfoo 2980 = 2979\nfoo 2981 = 2980\nfoo 2982 = 2981\nfoo 2983 = 2982\nfoo 2984 = 2983\nfoo 2985 = 2984\nfoo 2986 = 2985\nfoo 2987 = 2986\nfoo 2988 = 2987\nfoo 2989 = 2988\nfoo 2990 = 2989\nfoo 2991 = 2990\nfoo 2992 = 2991\nfoo 2993 = 2992\nfoo 2994 = 2993\nfoo 2995 = 2994\nfoo 2996 = 2995\nfoo 2997 = 2996\nfoo 2998 = 2997\nfoo 2999 = 2998\nfoo 3000 = 2999\nfoo 3001 = 3000\nfoo 3002 = 3001\nfoo 3003 = 3002\nfoo 3004 = 3003\nfoo 3005 = 3004\nfoo 3006 = 3005\nfoo 3007 = 3006\nfoo 3008 = 3007\nfoo 3009 = 3008\nfoo 3010 = 3009\nfoo 3011 = 3010\nfoo 3012 = 3011\nfoo 3013 = 3012\nfoo 3014 = 3013\nfoo 3015 = 3014\nfoo 3016 = 3015\nfoo 3017 = 3016\nfoo 3018 = 3017\nfoo 3019 = 3018\nfoo 3020 = 3019\nfoo 3021 = 3020\nfoo 3022 = 3021\nfoo 3023 = 3022\nfoo 3024 = 3023\nfoo 3025 = 3024\nfoo 3026 = 3025\nfoo 3027 = 3026\nfoo 3028 = 3027\nfoo 3029 = 3028\nfoo 3030 = 3029\nfoo 3031 = 3030\nfoo 3032 = 3031\nfoo 3033 = 3032\nfoo 3034 = 3033\nfoo 3035 = 3034\nfoo 3036 = 3035\nfoo 3037 = 3036\nfoo 3038 = 3037\nfoo 3039 = 3038\nfoo 3040 = 3039\nfoo 3041 = 3040\nfoo 3042 = 3041\nfoo 3043 = 3042\nfoo 3044 = 3043\nfoo 3045 = 3044\nfoo 3046 = 3045\nfoo 3047 = 3046\nfoo 3048 = 3047\nfoo 3049 = 3048\nfoo 3050 = 3049\nfoo 3051 = 3050\nfoo 3052 = 3051\nfoo 3053 = 3052\nfoo 3054 = 3053\nfoo 3055 = 3054\nfoo 3056 = 3055\nfoo 3057 = 3056\nfoo 3058 = 3057\nfoo 3059 = 3058\nfoo 3060 = 3059\nfoo 3061 = 3060\nfoo 3062 = 3061\nfoo 3063 = 3062\nfoo 3064 = 3063\nfoo 3065 = 3064\nfoo 3066 = 3065\nfoo 3067 = 3066\nfoo 3068 = 3067\nfoo 3069 = 3068\nfoo 3070 = 3069\nfoo 3071 = 3070\nfoo 3072 = 3071\nfoo 3073 = 3072\nfoo 3074 = 3073\nfoo 3075 = 3074\nfoo 3076 = 3075\nfoo 3077 = 3076\nfoo 3078 = 3077\nfoo 3079 = 3078\nfoo 3080 = 3079\nfoo 3081 = 3080\nfoo 3082 = 3081\nfoo 3083 = 3082\nfoo 3084 = 3083\nfoo 3085 = 3084\nfoo 3086 = 3085\nfoo 3087 = 3086\nfoo 3088 = 3087\nfoo 3089 = 3088\nfoo 3090 = 3089\nfoo 3091 = 3090\nfoo 3092 = 3091\nfoo 3093 = 3092\nfoo 3094 = 3093\nfoo 3095 = 3094\nfoo 3096 = 3095\nfoo 3097 = 3096\nfoo 3098 = 3097\nfoo 3099 = 3098\nfoo 3100 = 3099\nfoo 3101 = 3100\nfoo 3102 = 3101\nfoo 3103 = 3102\nfoo 3104 = 3103\nfoo 3105 = 3104\nfoo 3106 = 3105\nfoo 3107 = 3106\nfoo 3108 = 3107\nfoo 3109 = 3108\nfoo 3110 = 3109\nfoo 3111 = 3110\nfoo 3112 = 3111\nfoo 3113 = 3112\nfoo 3114 = 3113\nfoo 3115 = 3114\nfoo 3116 = 3115\nfoo 3117 = 3116\nfoo 3118 = 3117\nfoo 3119 = 3118\nfoo 3120 = 3119\nfoo 3121 = 3120\nfoo 3122 = 3121\nfoo 3123 = 3122\nfoo 3124 = 3123\nfoo 3125 = 3124\nfoo 3126 = 3125\nfoo 3127 = 3126\nfoo 3128 = 3127\nfoo 3129 = 3128\nfoo 3130 = 3129\nfoo 3131 = 3130\nfoo 3132 = 3131\nfoo 3133 = 3132\nfoo 3134 = 3133\nfoo 3135 = 3134\nfoo 3136 = 3135\nfoo 3137 = 3136\nfoo 3138 = 3137\nfoo 3139 = 3138\nfoo 3140 = 3139\nfoo 3141 = 3140\nfoo 3142 = 3141\nfoo 3143 = 3142\nfoo 3144 = 3143\nfoo 3145 = 3144\nfoo 3146 = 3145\nfoo 3147 = 3146\nfoo 3148 = 3147\nfoo 3149 = 3148\nfoo 3150 = 3149\nfoo 3151 = 3150\nfoo 3152 = 3151\nfoo 3153 = 3152\nfoo 3154 = 3153\nfoo 3155 = 3154\nfoo 3156 = 3155\nfoo 3157 = 3156\nfoo 3158 = 3157\nfoo 3159 = 3158\nfoo 3160 = 3159\nfoo 3161 = 3160\nfoo 3162 = 3161\nfoo 3163 = 3162\nfoo 3164 = 3163\nfoo 3165 = 3164\nfoo 3166 = 3165\nfoo 3167 = 3166\nfoo 3168 = 3167\nfoo 3169 = 3168\nfoo 3170 = 3169\nfoo 3171 = 3170\nfoo 3172 = 3171\nfoo 3173 = 3172\nfoo 3174 = 3173\nfoo 3175 = 3174\nfoo 3176 = 3175\nfoo 3177 = 3176\nfoo 3178 = 3177\nfoo 3179 = 3178\nfoo 3180 = 3179\nfoo 3181 = 3180\nfoo 3182 = 3181\nfoo 3183 = 3182\nfoo 3184 = 3183\nfoo 3185 = 3184\nfoo 3186 = 3185\nfoo 3187 = 3186\nfoo 3188 = 3187\nfoo 3189 = 3188\nfoo 3190 = 3189\nfoo 3191 = 3190\nfoo 3192 = 3191\nfoo 3193 = 3192\nfoo 3194 = 3193\nfoo 3195 = 3194\nfoo 3196 = 3195\nfoo 3197 = 3196\nfoo 3198 = 3197\nfoo 3199 = 3198\nfoo 3200 = 3199\nfoo 3201 = 3200\nfoo 3202 = 3201\nfoo 3203 = 3202\nfoo 3204 = 3203\nfoo 3205 = 3204\nfoo 3206 = 3205\nfoo 3207 = 3206\nfoo 3208 = 3207\nfoo 3209 = 3208\nfoo 3210 = 3209\nfoo 3211 = 3210\nfoo 3212 = 3211\nfoo 3213 = 3212\nfoo 3214 = 3213\nfoo 3215 = 3214\nfoo 3216 = 3215\nfoo 3217 = 3216\nfoo 3218 = 3217\nfoo 3219 = 3218\nfoo 3220 = 3219\nfoo 3221 = 3220\nfoo 3222 = 3221\nfoo 3223 = 3222\nfoo 3224 = 3223\nfoo 3225 = 3224\nfoo 3226 = 3225\nfoo 3227 = 3226\nfoo 3228 = 3227\nfoo 3229 = 3228\nfoo 3230 = 3229\nfoo 3231 = 3230\nfoo 3232 = 3231\nfoo 3233 = 3232\nfoo 3234 = 3233\nfoo 3235 = 3234\nfoo 3236 = 3235\nfoo 3237 = 3236\nfoo 3238 = 3237\nfoo 3239 = 3238\nfoo 3240 = 3239\nfoo 3241 = 3240\nfoo 3242 = 3241\nfoo 3243 = 3242\nfoo 3244 = 3243\nfoo 3245 = 3244\nfoo 3246 = 3245\nfoo 3247 = 3246\nfoo 3248 = 3247\nfoo 3249 = 3248\nfoo 3250 = 3249\nfoo 3251 = 3250\nfoo 3252 = 3251\nfoo 3253 = 3252\nfoo 3254 = 3253\nfoo 3255 = 3254\nfoo 3256 = 3255\nfoo 3257 = 3256\nfoo 3258 = 3257\nfoo 3259 = 3258\nfoo 3260 = 3259\nfoo 3261 = 3260\nfoo 3262 = 3261\nfoo 3263 = 3262\nfoo 3264 = 3263\nfoo 3265 = 3264\nfoo 3266 = 3265\nfoo 3267 = 3266\nfoo 3268 = 3267\nfoo 3269 = 3268\nfoo 3270 = 3269\nfoo 3271 = 3270\nfoo 3272 = 3271\nfoo 3273 = 3272\nfoo 3274 = 3273\nfoo 3275 = 3274\nfoo 3276 = 3275\nfoo 3277 = 3276\nfoo 3278 = 3277\nfoo 3279 = 3278\nfoo 3280 = 3279\nfoo 3281 = 3280\nfoo 3282 = 3281\nfoo 3283 = 3282\nfoo 3284 = 3283\nfoo 3285 = 3284\nfoo 3286 = 3285\nfoo 3287 = 3286\nfoo 3288 = 3287\nfoo 3289 = 3288\nfoo 3290 = 3289\nfoo 3291 = 3290\nfoo 3292 = 3291\nfoo 3293 = 3292\nfoo 3294 = 3293\nfoo 3295 = 3294\nfoo 3296 = 3295\nfoo 3297 = 3296\nfoo 3298 = 3297\nfoo 3299 = 3298\nfoo 3300 = 3299\nfoo 3301 = 3300\nfoo 3302 = 3301\nfoo 3303 = 3302\nfoo 3304 = 3303\nfoo 3305 = 3304\nfoo 3306 = 3305\nfoo 3307 = 3306\nfoo 3308 = 3307\nfoo 3309 = 3308\nfoo 3310 = 3309\nfoo 3311 = 3310\nfoo 3312 = 3311\nfoo 3313 = 3312\nfoo 3314 = 3313\nfoo 3315 = 3314\nfoo 3316 = 3315\nfoo 3317 = 3316\nfoo 3318 = 3317\nfoo 3319 = 3318\nfoo 3320 = 3319\nfoo 3321 = 3320\nfoo 3322 = 3321\nfoo 3323 = 3322\nfoo 3324 = 3323\nfoo 3325 = 3324\nfoo 3326 = 3325\nfoo 3327 = 3326\nfoo 3328 = 3327\nfoo 3329 = 3328\nfoo 3330 = 3329\nfoo 3331 = 3330\nfoo 3332 = 3331\nfoo 3333 = 3332\nfoo 3334 = 3333\nfoo 3335 = 3334\nfoo 3336 = 3335\nfoo 3337 = 3336\nfoo 3338 = 3337\nfoo 3339 = 3338\nfoo 3340 = 3339\nfoo 3341 = 3340\nfoo 3342 = 3341\nfoo 3343 = 3342\nfoo 3344 = 3343\nfoo 3345 = 3344\nfoo 3346 = 3345\nfoo 3347 = 3346\nfoo 3348 = 3347\nfoo 3349 = 3348\nfoo 3350 = 3349\nfoo 3351 = 3350\nfoo 3352 = 3351\nfoo 3353 = 3352\nfoo 3354 = 3353\nfoo 3355 = 3354\nfoo 3356 = 3355\nfoo 3357 = 3356\nfoo 3358 = 3357\nfoo 3359 = 3358\nfoo 3360 = 3359\nfoo 3361 = 3360\nfoo 3362 = 3361\nfoo 3363 = 3362\nfoo 3364 = 3363\nfoo 3365 = 3364\nfoo 3366 = 3365\nfoo 3367 = 3366\nfoo 3368 = 3367\nfoo 3369 = 3368\nfoo 3370 = 3369\nfoo 3371 = 3370\nfoo 3372 = 3371\nfoo 3373 = 3372\nfoo 3374 = 3373\nfoo 3375 = 3374\nfoo 3376 = 3375\nfoo 3377 = 3376\nfoo 3378 = 3377\nfoo 3379 = 3378\nfoo 3380 = 3379\nfoo 3381 = 3380\nfoo 3382 = 3381\nfoo 3383 = 3382\nfoo 3384 = 3383\nfoo 3385 = 3384\nfoo 3386 = 3385\nfoo 3387 = 3386\nfoo 3388 = 3387\nfoo 3389 = 3388\nfoo 3390 = 3389\nfoo 3391 = 3390\nfoo 3392 = 3391\nfoo 3393 = 3392\nfoo 3394 = 3393\nfoo 3395 = 3394\nfoo 3396 = 3395\nfoo 3397 = 3396\nfoo 3398 = 3397\nfoo 3399 = 3398\nfoo 3400 = 3399\nfoo 3401 = 3400\nfoo 3402 = 3401\nfoo 3403 = 3402\nfoo 3404 = 3403\nfoo 3405 = 3404\nfoo 3406 = 3405\nfoo 3407 = 3406\nfoo 3408 = 3407\nfoo 3409 = 3408\nfoo 3410 = 3409\nfoo 3411 = 3410\nfoo 3412 = 3411\nfoo 3413 = 3412\nfoo 3414 = 3413\nfoo 3415 = 3414\nfoo 3416 = 3415\nfoo 3417 = 3416\nfoo 3418 = 3417\nfoo 3419 = 3418\nfoo 3420 = 3419\nfoo 3421 = 3420\nfoo 3422 = 3421\nfoo 3423 = 3422\nfoo 3424 = 3423\nfoo 3425 = 3424\nfoo 3426 = 3425\nfoo 3427 = 3426\nfoo 3428 = 3427\nfoo 3429 = 3428\nfoo 3430 = 3429\nfoo 3431 = 3430\nfoo 3432 = 3431\nfoo 3433 = 3432\nfoo 3434 = 3433\nfoo 3435 = 3434\nfoo 3436 = 3435\nfoo 3437 = 3436\nfoo 3438 = 3437\nfoo 3439 = 3438\nfoo 3440 = 3439\nfoo 3441 = 3440\nfoo 3442 = 3441\nfoo 3443 = 3442\nfoo 3444 = 3443\nfoo 3445 = 3444\nfoo 3446 = 3445\nfoo 3447 = 3446\nfoo 3448 = 3447\nfoo 3449 = 3448\nfoo 3450 = 3449\nfoo 3451 = 3450\nfoo 3452 = 3451\nfoo 3453 = 3452\nfoo 3454 = 3453\nfoo 3455 = 3454\nfoo 3456 = 3455\nfoo 3457 = 3456\nfoo 3458 = 3457\nfoo 3459 = 3458\nfoo 3460 = 3459\nfoo 3461 = 3460\nfoo 3462 = 3461\nfoo 3463 = 3462\nfoo 3464 = 3463\nfoo 3465 = 3464\nfoo 3466 = 3465\nfoo 3467 = 3466\nfoo 3468 = 3467\nfoo 3469 = 3468\nfoo 3470 = 3469\nfoo 3471 = 3470\nfoo 3472 = 3471\nfoo 3473 = 3472\nfoo 3474 = 3473\nfoo 3475 = 3474\nfoo 3476 = 3475\nfoo 3477 = 3476\nfoo 3478 = 3477\nfoo 3479 = 3478\nfoo 3480 = 3479\nfoo 3481 = 3480\nfoo 3482 = 3481\nfoo 3483 = 3482\nfoo 3484 = 3483\nfoo 3485 = 3484\nfoo 3486 = 3485\nfoo 3487 = 3486\nfoo 3488 = 3487\nfoo 3489 = 3488\nfoo 3490 = 3489\nfoo 3491 = 3490\nfoo 3492 = 3491\nfoo 3493 = 3492\nfoo 3494 = 3493\nfoo 3495 = 3494\nfoo 3496 = 3495\nfoo 3497 = 3496\nfoo 3498 = 3497\nfoo 3499 = 3498\nfoo 3500 = 3499\nfoo 3501 = 3500\nfoo 3502 = 3501\nfoo 3503 = 3502\nfoo 3504 = 3503\nfoo 3505 = 3504\nfoo 3506 = 3505\nfoo 3507 = 3506\nfoo 3508 = 3507\nfoo 3509 = 3508\nfoo 3510 = 3509\nfoo 3511 = 3510\nfoo 3512 = 3511\nfoo 3513 = 3512\nfoo 3514 = 3513\nfoo 3515 = 3514\nfoo 3516 = 3515\nfoo 3517 = 3516\nfoo 3518 = 3517\nfoo 3519 = 3518\nfoo 3520 = 3519\nfoo 3521 = 3520\nfoo 3522 = 3521\nfoo 3523 = 3522\nfoo 3524 = 3523\nfoo 3525 = 3524\nfoo 3526 = 3525\nfoo 3527 = 3526\nfoo 3528 = 3527\nfoo 3529 = 3528\nfoo 3530 = 3529\nfoo 3531 = 3530\nfoo 3532 = 3531\nfoo 3533 = 3532\nfoo 3534 = 3533\nfoo 3535 = 3534\nfoo 3536 = 3535\nfoo 3537 = 3536\nfoo 3538 = 3537\nfoo 3539 = 3538\nfoo 3540 = 3539\nfoo 3541 = 3540\nfoo 3542 = 3541\nfoo 3543 = 3542\nfoo 3544 = 3543\nfoo 3545 = 3544\nfoo 3546 = 3545\nfoo 3547 = 3546\nfoo 3548 = 3547\nfoo 3549 = 3548\nfoo 3550 = 3549\nfoo 3551 = 3550\nfoo 3552 = 3551\nfoo 3553 = 3552\nfoo 3554 = 3553\nfoo 3555 = 3554\nfoo 3556 = 3555\nfoo 3557 = 3556\nfoo 3558 = 3557\nfoo 3559 = 3558\nfoo 3560 = 3559\nfoo 3561 = 3560\nfoo 3562 = 3561\nfoo 3563 = 3562\nfoo 3564 = 3563\nfoo 3565 = 3564\nfoo 3566 = 3565\nfoo 3567 = 3566\nfoo 3568 = 3567\nfoo 3569 = 3568\nfoo 3570 = 3569\nfoo 3571 = 3570\nfoo 3572 = 3571\nfoo 3573 = 3572\nfoo 3574 = 3573\nfoo 3575 = 3574\nfoo 3576 = 3575\nfoo 3577 = 3576\nfoo 3578 = 3577\nfoo 3579 = 3578\nfoo 3580 = 3579\nfoo 3581 = 3580\nfoo 3582 = 3581\nfoo 3583 = 3582\nfoo 3584 = 3583\nfoo 3585 = 3584\nfoo 3586 = 3585\nfoo 3587 = 3586\nfoo 3588 = 3587\nfoo 3589 = 3588\nfoo 3590 = 3589\nfoo 3591 = 3590\nfoo 3592 = 3591\nfoo 3593 = 3592\nfoo 3594 = 3593\nfoo 3595 = 3594\nfoo 3596 = 3595\nfoo 3597 = 3596\nfoo 3598 = 3597\nfoo 3599 = 3598\nfoo 3600 = 3599\nfoo 3601 = 3600\nfoo 3602 = 3601\nfoo 3603 = 3602\nfoo 3604 = 3603\nfoo 3605 = 3604\nfoo 3606 = 3605\nfoo 3607 = 3606\nfoo 3608 = 3607\nfoo 3609 = 3608\nfoo 3610 = 3609\nfoo 3611 = 3610\nfoo 3612 = 3611\nfoo 3613 = 3612\nfoo 3614 = 3613\nfoo 3615 = 3614\nfoo 3616 = 3615\nfoo 3617 = 3616\nfoo 3618 = 3617\nfoo 3619 = 3618\nfoo 3620 = 3619\nfoo 3621 = 3620\nfoo 3622 = 3621\nfoo 3623 = 3622\nfoo 3624 = 3623\nfoo 3625 = 3624\nfoo 3626 = 3625\nfoo 3627 = 3626\nfoo 3628 = 3627\nfoo 3629 = 3628\nfoo 3630 = 3629\nfoo 3631 = 3630\nfoo 3632 = 3631\nfoo 3633 = 3632\nfoo 3634 = 3633\nfoo 3635 = 3634\nfoo 3636 = 3635\nfoo 3637 = 3636\nfoo 3638 = 3637\nfoo 3639 = 3638\nfoo 3640 = 3639\nfoo 3641 = 3640\nfoo 3642 = 3641\nfoo 3643 = 3642\nfoo 3644 = 3643\nfoo 3645 = 3644\nfoo 3646 = 3645\nfoo 3647 = 3646\nfoo 3648 = 3647\nfoo 3649 = 3648\nfoo 3650 = 3649\nfoo 3651 = 3650\nfoo 3652 = 3651\nfoo 3653 = 3652\nfoo 3654 = 3653\nfoo 3655 = 3654\nfoo 3656 = 3655\nfoo 3657 = 3656\nfoo 3658 = 3657\nfoo 3659 = 3658\nfoo 3660 = 3659\nfoo 3661 = 3660\nfoo 3662 = 3661\nfoo 3663 = 3662\nfoo 3664 = 3663\nfoo 3665 = 3664\nfoo 3666 = 3665\nfoo 3667 = 3666\nfoo 3668 = 3667\nfoo 3669 = 3668\nfoo 3670 = 3669\nfoo 3671 = 3670\nfoo 3672 = 3671\nfoo 3673 = 3672\nfoo 3674 = 3673\nfoo 3675 = 3674\nfoo 3676 = 3675\nfoo 3677 = 3676\nfoo 3678 = 3677\nfoo 3679 = 3678\nfoo 3680 = 3679\nfoo 3681 = 3680\nfoo 3682 = 3681\nfoo 3683 = 3682\nfoo 3684 = 3683\nfoo 3685 = 3684\nfoo 3686 = 3685\nfoo 3687 = 3686\nfoo 3688 = 3687\nfoo 3689 = 3688\nfoo 3690 = 3689\nfoo 3691 = 3690\nfoo 3692 = 3691\nfoo 3693 = 3692\nfoo 3694 = 3693\nfoo 3695 = 3694\nfoo 3696 = 3695\nfoo 3697 = 3696\nfoo 3698 = 3697\nfoo 3699 = 3698\nfoo 3700 = 3699\nfoo 3701 = 3700\nfoo 3702 = 3701\nfoo 3703 = 3702\nfoo 3704 = 3703\nfoo 3705 = 3704\nfoo 3706 = 3705\nfoo 3707 = 3706\nfoo 3708 = 3707\nfoo 3709 = 3708\nfoo 3710 = 3709\nfoo 3711 = 3710\nfoo 3712 = 3711\nfoo 3713 = 3712\nfoo 3714 = 3713\nfoo 3715 = 3714\nfoo 3716 = 3715\nfoo 3717 = 3716\nfoo 3718 = 3717\nfoo 3719 = 3718\nfoo 3720 = 3719\nfoo 3721 = 3720\nfoo 3722 = 3721\nfoo 3723 = 3722\nfoo 3724 = 3723\nfoo 3725 = 3724\nfoo 3726 = 3725\nfoo 3727 = 3726\nfoo 3728 = 3727\nfoo 3729 = 3728\nfoo 3730 = 3729\nfoo 3731 = 3730\nfoo 3732 = 3731\nfoo 3733 = 3732\nfoo 3734 = 3733\nfoo 3735 = 3734\nfoo 3736 = 3735\nfoo 3737 = 3736\nfoo 3738 = 3737\nfoo 3739 = 3738\nfoo 3740 = 3739\nfoo 3741 = 3740\nfoo 3742 = 3741\nfoo 3743 = 3742\nfoo 3744 = 3743\nfoo 3745 = 3744\nfoo 3746 = 3745\nfoo 3747 = 3746\nfoo 3748 = 3747\nfoo 3749 = 3748\nfoo 3750 = 3749\nfoo 3751 = 3750\nfoo 3752 = 3751\nfoo 3753 = 3752\nfoo 3754 = 3753\nfoo 3755 = 3754\nfoo 3756 = 3755\nfoo 3757 = 3756\nfoo 3758 = 3757\nfoo 3759 = 3758\nfoo 3760 = 3759\nfoo 3761 = 3760\nfoo 3762 = 3761\nfoo 3763 = 3762\nfoo 3764 = 3763\nfoo 3765 = 3764\nfoo 3766 = 3765\nfoo 3767 = 3766\nfoo 3768 = 3767\nfoo 3769 = 3768\nfoo 3770 = 3769\nfoo 3771 = 3770\nfoo 3772 = 3771\nfoo 3773 = 3772\nfoo 3774 = 3773\nfoo 3775 = 3774\nfoo 3776 = 3775\nfoo 3777 = 3776\nfoo 3778 = 3777\nfoo 3779 = 3778\nfoo 3780 = 3779\nfoo 3781 = 3780\nfoo 3782 = 3781\nfoo 3783 = 3782\nfoo 3784 = 3783\nfoo 3785 = 3784\nfoo 3786 = 3785\nfoo 3787 = 3786\nfoo 3788 = 3787\nfoo 3789 = 3788\nfoo 3790 = 3789\nfoo 3791 = 3790\nfoo 3792 = 3791\nfoo 3793 = 3792\nfoo 3794 = 3793\nfoo 3795 = 3794\nfoo 3796 = 3795\nfoo 3797 = 3796\nfoo 3798 = 3797\nfoo 3799 = 3798\nfoo 3800 = 3799\nfoo 3801 = 3800\nfoo 3802 = 3801\nfoo 3803 = 3802\nfoo 3804 = 3803\nfoo 3805 = 3804\nfoo 3806 = 3805\nfoo 3807 = 3806\nfoo 3808 = 3807\nfoo 3809 = 3808\nfoo 3810 = 3809\nfoo 3811 = 3810\nfoo 3812 = 3811\nfoo 3813 = 3812\nfoo 3814 = 3813\nfoo 3815 = 3814\nfoo 3816 = 3815\nfoo 3817 = 3816\nfoo 3818 = 3817\nfoo 3819 = 3818\nfoo 3820 = 3819\nfoo 3821 = 3820\nfoo 3822 = 3821\nfoo 3823 = 3822\nfoo 3824 = 3823\nfoo 3825 = 3824\nfoo 3826 = 3825\nfoo 3827 = 3826\nfoo 3828 = 3827\nfoo 3829 = 3828\nfoo 3830 = 3829\nfoo 3831 = 3830\nfoo 3832 = 3831\nfoo 3833 = 3832\nfoo 3834 = 3833\nfoo 3835 = 3834\nfoo 3836 = 3835\nfoo 3837 = 3836\nfoo 3838 = 3837\nfoo 3839 = 3838\nfoo 3840 = 3839\nfoo 3841 = 3840\nfoo 3842 = 3841\nfoo 3843 = 3842\nfoo 3844 = 3843\nfoo 3845 = 3844\nfoo 3846 = 3845\nfoo 3847 = 3846\nfoo 3848 = 3847\nfoo 3849 = 3848\nfoo 3850 = 3849\nfoo 3851 = 3850\nfoo 3852 = 3851\nfoo 3853 = 3852\nfoo 3854 = 3853\nfoo 3855 = 3854\nfoo 3856 = 3855\nfoo 3857 = 3856\nfoo 3858 = 3857\nfoo 3859 = 3858\nfoo 3860 = 3859\nfoo 3861 = 3860\nfoo 3862 = 3861\nfoo 3863 = 3862\nfoo 3864 = 3863\nfoo 3865 = 3864\nfoo 3866 = 3865\nfoo 3867 = 3866\nfoo 3868 = 3867\nfoo 3869 = 3868\nfoo 3870 = 3869\nfoo 3871 = 3870\nfoo 3872 = 3871\nfoo 3873 = 3872\nfoo 3874 = 3873\nfoo 3875 = 3874\nfoo 3876 = 3875\nfoo 3877 = 3876\nfoo 3878 = 3877\nfoo 3879 = 3878\nfoo 3880 = 3879\nfoo 3881 = 3880\nfoo 3882 = 3881\nfoo 3883 = 3882\nfoo 3884 = 3883\nfoo 3885 = 3884\nfoo 3886 = 3885\nfoo 3887 = 3886\nfoo 3888 = 3887\nfoo 3889 = 3888\nfoo 3890 = 3889\nfoo 3891 = 3890\nfoo 3892 = 3891\nfoo 3893 = 3892\nfoo 3894 = 3893\nfoo 3895 = 3894\nfoo 3896 = 3895\nfoo 3897 = 3896\nfoo 3898 = 3897\nfoo 3899 = 3898\nfoo 3900 = 3899\nfoo 3901 = 3900\nfoo 3902 = 3901\nfoo 3903 = 3902\nfoo 3904 = 3903\nfoo 3905 = 3904\nfoo 3906 = 3905\nfoo 3907 = 3906\nfoo 3908 = 3907\nfoo 3909 = 3908\nfoo 3910 = 3909\nfoo 3911 = 3910\nfoo 3912 = 3911\nfoo 3913 = 3912\nfoo 3914 = 3913\nfoo 3915 = 3914\nfoo 3916 = 3915\nfoo 3917 = 3916\nfoo 3918 = 3917\nfoo 3919 = 3918\nfoo 3920 = 3919\nfoo 3921 = 3920\nfoo 3922 = 3921\nfoo 3923 = 3922\nfoo 3924 = 3923\nfoo 3925 = 3924\nfoo 3926 = 3925\nfoo 3927 = 3926\nfoo 3928 = 3927\nfoo 3929 = 3928\nfoo 3930 = 3929\nfoo 3931 = 3930\nfoo 3932 = 3931\nfoo 3933 = 3932\nfoo 3934 = 3933\nfoo 3935 = 3934\nfoo 3936 = 3935\nfoo 3937 = 3936\nfoo 3938 = 3937\nfoo 3939 = 3938\nfoo 3940 = 3939\nfoo 3941 = 3940\nfoo 3942 = 3941\nfoo 3943 = 3942\nfoo 3944 = 3943\nfoo 3945 = 3944\nfoo 3946 = 3945\nfoo 3947 = 3946\nfoo 3948 = 3947\nfoo 3949 = 3948\nfoo 3950 = 3949\nfoo 3951 = 3950\nfoo 3952 = 3951\nfoo 3953 = 3952\nfoo 3954 = 3953\nfoo 3955 = 3954\nfoo 3956 = 3955\nfoo 3957 = 3956\nfoo 3958 = 3957\nfoo 3959 = 3958\nfoo 3960 = 3959\nfoo 3961 = 3960\nfoo 3962 = 3961\nfoo 3963 = 3962\nfoo 3964 = 3963\nfoo 3965 = 3964\nfoo 3966 = 3965\nfoo 3967 = 3966\nfoo 3968 = 3967\nfoo 3969 = 3968\nfoo 3970 = 3969\nfoo 3971 = 3970\nfoo 3972 = 3971\nfoo 3973 = 3972\nfoo 3974 = 3973\nfoo 3975 = 3974\nfoo 3976 = 3975\nfoo 3977 = 3976\nfoo 3978 = 3977\nfoo 3979 = 3978\nfoo 3980 = 3979\nfoo 3981 = 3980\nfoo 3982 = 3981\nfoo 3983 = 3982\nfoo 3984 = 3983\nfoo 3985 = 3984\nfoo 3986 = 3985\nfoo 3987 = 3986\nfoo 3988 = 3987\nfoo 3989 = 3988\nfoo 3990 = 3989\nfoo 3991 = 3990\nfoo 3992 = 3991\nfoo 3993 = 3992\nfoo 3994 = 3993\nfoo 3995 = 3994\nfoo 3996 = 3995\nfoo 3997 = 3996\nfoo 3998 = 3997\nfoo 3999 = 3998\nfoo 4000 = 3999\nfoo 4001 = 4000\nfoo 4002 = 4001\nfoo 4003 = 4002\nfoo 4004 = 4003\nfoo 4005 = 4004\nfoo 4006 = 4005\nfoo 4007 = 4006\nfoo 4008 = 4007\nfoo 4009 = 4008\nfoo 4010 = 4009\nfoo 4011 = 4010\nfoo 4012 = 4011\nfoo 4013 = 4012\nfoo 4014 = 4013\nfoo 4015 = 4014\nfoo 4016 = 4015\nfoo 4017 = 4016\nfoo 4018 = 4017\nfoo 4019 = 4018\nfoo 4020 = 4019\nfoo 4021 = 4020\nfoo 4022 = 4021\nfoo 4023 = 4022\nfoo 4024 = 4023\nfoo 4025 = 4024\nfoo 4026 = 4025\nfoo 4027 = 4026\nfoo 4028 = 4027\nfoo 4029 = 4028\nfoo 4030 = 4029\nfoo 4031 = 4030\nfoo 4032 = 4031\nfoo 4033 = 4032\nfoo 4034 = 4033\nfoo 4035 = 4034\nfoo 4036 = 4035\nfoo 4037 = 4036\nfoo 4038 = 4037\nfoo 4039 = 4038\nfoo 4040 = 4039\nfoo 4041 = 4040\nfoo 4042 = 4041\nfoo 4043 = 4042\nfoo 4044 = 4043\nfoo 4045 = 4044\nfoo 4046 = 4045\nfoo 4047 = 4046\nfoo 4048 = 4047\nfoo 4049 = 4048\nfoo 4050 = 4049\nfoo 4051 = 4050\nfoo 4052 = 4051\nfoo 4053 = 4052\nfoo 4054 = 4053\nfoo 4055 = 4054\nfoo 4056 = 4055\nfoo 4057 = 4056\nfoo 4058 = 4057\nfoo 4059 = 4058\nfoo 4060 = 4059\nfoo 4061 = 4060\nfoo 4062 = 4061\nfoo 4063 = 4062\nfoo 4064 = 4063\nfoo 4065 = 4064\nfoo 4066 = 4065\nfoo 4067 = 4066\nfoo 4068 = 4067\nfoo 4069 = 4068\nfoo 4070 = 4069\nfoo 4071 = 4070\nfoo 4072 = 4071\nfoo 4073 = 4072\nfoo 4074 = 4073\nfoo 4075 = 4074\nfoo 4076 = 4075\nfoo 4077 = 4076\nfoo 4078 = 4077\nfoo 4079 = 4078\nfoo 4080 = 4079\nfoo 4081 = 4080\nfoo 4082 = 4081\nfoo 4083 = 4082\nfoo 4084 = 4083\nfoo 4085 = 4084\nfoo 4086 = 4085\nfoo 4087 = 4086\nfoo 4088 = 4087\nfoo 4089 = 4088\nfoo 4090 = 4089\nfoo 4091 = 4090\nfoo 4092 = 4091\nfoo 4093 = 4092\nfoo 4094 = 4093\nfoo 4095 = 4094\nfoo 4096 = 4095\nfoo 4097 = 4096\nfoo 4098 = 4097\nfoo 4099 = 4098\nfoo 4100 = 4099\nfoo 4101 = 4100\nfoo 4102 = 4101\nfoo 4103 = 4102\nfoo 4104 = 4103\nfoo 4105 = 4104\nfoo 4106 = 4105\nfoo 4107 = 4106\nfoo 4108 = 4107\nfoo 4109 = 4108\nfoo 4110 = 4109\nfoo 4111 = 4110\nfoo 4112 = 4111\nfoo 4113 = 4112\nfoo 4114 = 4113\nfoo 4115 = 4114\nfoo 4116 = 4115\nfoo 4117 = 4116\nfoo 4118 = 4117\nfoo 4119 = 4118\nfoo 4120 = 4119\nfoo 4121 = 4120\nfoo 4122 = 4121\nfoo 4123 = 4122\nfoo 4124 = 4123\nfoo 4125 = 4124\nfoo 4126 = 4125\nfoo 4127 = 4126\nfoo 4128 = 4127\nfoo 4129 = 4128\nfoo 4130 = 4129\nfoo 4131 = 4130\nfoo 4132 = 4131\nfoo 4133 = 4132\nfoo 4134 = 4133\nfoo 4135 = 4134\nfoo 4136 = 4135\nfoo 4137 = 4136\nfoo 4138 = 4137\nfoo 4139 = 4138\nfoo 4140 = 4139\nfoo 4141 = 4140\nfoo 4142 = 4141\nfoo 4143 = 4142\nfoo 4144 = 4143\nfoo 4145 = 4144\nfoo 4146 = 4145\nfoo 4147 = 4146\nfoo 4148 = 4147\nfoo 4149 = 4148\nfoo 4150 = 4149\nfoo 4151 = 4150\nfoo 4152 = 4151\nfoo 4153 = 4152\nfoo 4154 = 4153\nfoo 4155 = 4154\nfoo 4156 = 4155\nfoo 4157 = 4156\nfoo 4158 = 4157\nfoo 4159 = 4158\nfoo 4160 = 4159\nfoo 4161 = 4160\nfoo 4162 = 4161\nfoo 4163 = 4162\nfoo 4164 = 4163\nfoo 4165 = 4164\nfoo 4166 = 4165\nfoo 4167 = 4166\nfoo 4168 = 4167\nfoo 4169 = 4168\nfoo 4170 = 4169\nfoo 4171 = 4170\nfoo 4172 = 4171\nfoo 4173 = 4172\nfoo 4174 = 4173\nfoo 4175 = 4174\nfoo 4176 = 4175\nfoo 4177 = 4176\nfoo 4178 = 4177\nfoo 4179 = 4178\nfoo 4180 = 4179\nfoo 4181 = 4180\nfoo 4182 = 4181\nfoo 4183 = 4182\nfoo 4184 = 4183\nfoo 4185 = 4184\nfoo 4186 = 4185\nfoo 4187 = 4186\nfoo 4188 = 4187\nfoo 4189 = 4188\nfoo 4190 = 4189\nfoo 4191 = 4190\nfoo 4192 = 4191\nfoo 4193 = 4192\nfoo 4194 = 4193\nfoo 4195 = 4194\nfoo 4196 = 4195\nfoo 4197 = 4196\nfoo 4198 = 4197\nfoo 4199 = 4198\nfoo 4200 = 4199\nfoo 4201 = 4200\nfoo 4202 = 4201\nfoo 4203 = 4202\nfoo 4204 = 4203\nfoo 4205 = 4204\nfoo 4206 = 4205\nfoo 4207 = 4206\nfoo 4208 = 4207\nfoo 4209 = 4208\nfoo 4210 = 4209\nfoo 4211 = 4210\nfoo 4212 = 4211\nfoo 4213 = 4212\nfoo 4214 = 4213\nfoo 4215 = 4214\nfoo 4216 = 4215\nfoo 4217 = 4216\nfoo 4218 = 4217\nfoo 4219 = 4218\nfoo 4220 = 4219\nfoo 4221 = 4220\nfoo 4222 = 4221\nfoo 4223 = 4222\nfoo 4224 = 4223\nfoo 4225 = 4224\nfoo 4226 = 4225\nfoo 4227 = 4226\nfoo 4228 = 4227\nfoo 4229 = 4228\nfoo 4230 = 4229\nfoo 4231 = 4230\nfoo 4232 = 4231\nfoo 4233 = 4232\nfoo 4234 = 4233\nfoo 4235 = 4234\nfoo 4236 = 4235\nfoo 4237 = 4236\nfoo 4238 = 4237\nfoo 4239 = 4238\nfoo 4240 = 4239\nfoo 4241 = 4240\nfoo 4242 = 4241\nfoo 4243 = 4242\nfoo 4244 = 4243\nfoo 4245 = 4244\nfoo 4246 = 4245\nfoo 4247 = 4246\nfoo 4248 = 4247\nfoo 4249 = 4248\nfoo 4250 = 4249\nfoo 4251 = 4250\nfoo 4252 = 4251\nfoo 4253 = 4252\nfoo 4254 = 4253\nfoo 4255 = 4254\nfoo 4256 = 4255\nfoo 4257 = 4256\nfoo 4258 = 4257\nfoo 4259 = 4258\nfoo 4260 = 4259\nfoo 4261 = 4260\nfoo 4262 = 4261\nfoo 4263 = 4262\nfoo 4264 = 4263\nfoo 4265 = 4264\nfoo 4266 = 4265\nfoo 4267 = 4266\nfoo 4268 = 4267\nfoo 4269 = 4268\nfoo 4270 = 4269\nfoo 4271 = 4270\nfoo 4272 = 4271\nfoo 4273 = 4272\nfoo 4274 = 4273\nfoo 4275 = 4274\nfoo 4276 = 4275\nfoo 4277 = 4276\nfoo 4278 = 4277\nfoo 4279 = 4278\nfoo 4280 = 4279\nfoo 4281 = 4280\nfoo 4282 = 4281\nfoo 4283 = 4282\nfoo 4284 = 4283\nfoo 4285 = 4284\nfoo 4286 = 4285\nfoo 4287 = 4286\nfoo 4288 = 4287\nfoo 4289 = 4288\nfoo 4290 = 4289\nfoo 4291 = 4290\nfoo 4292 = 4291\nfoo 4293 = 4292\nfoo 4294 = 4293\nfoo 4295 = 4294\nfoo 4296 = 4295\nfoo 4297 = 4296\nfoo 4298 = 4297\nfoo 4299 = 4298\nfoo 4300 = 4299\nfoo 4301 = 4300\nfoo 4302 = 4301\nfoo 4303 = 4302\nfoo 4304 = 4303\nfoo 4305 = 4304\nfoo 4306 = 4305\nfoo 4307 = 4306\nfoo 4308 = 4307\nfoo 4309 = 4308\nfoo 4310 = 4309\nfoo 4311 = 4310\nfoo 4312 = 4311\nfoo 4313 = 4312\nfoo 4314 = 4313\nfoo 4315 = 4314\nfoo 4316 = 4315\nfoo 4317 = 4316\nfoo 4318 = 4317\nfoo 4319 = 4318\nfoo 4320 = 4319\nfoo 4321 = 4320\nfoo 4322 = 4321\nfoo 4323 = 4322\nfoo 4324 = 4323\nfoo 4325 = 4324\nfoo 4326 = 4325\nfoo 4327 = 4326\nfoo 4328 = 4327\nfoo 4329 = 4328\nfoo 4330 = 4329\nfoo 4331 = 4330\nfoo 4332 = 4331\nfoo 4333 = 4332\nfoo 4334 = 4333\nfoo 4335 = 4334\nfoo 4336 = 4335\nfoo 4337 = 4336\nfoo 4338 = 4337\nfoo 4339 = 4338\nfoo 4340 = 4339\nfoo 4341 = 4340\nfoo 4342 = 4341\nfoo 4343 = 4342\nfoo 4344 = 4343\nfoo 4345 = 4344\nfoo 4346 = 4345\nfoo 4347 = 4346\nfoo 4348 = 4347\nfoo 4349 = 4348\nfoo 4350 = 4349\nfoo 4351 = 4350\nfoo 4352 = 4351\nfoo 4353 = 4352\nfoo 4354 = 4353\nfoo 4355 = 4354\nfoo 4356 = 4355\nfoo 4357 = 4356\nfoo 4358 = 4357\nfoo 4359 = 4358\nfoo 4360 = 4359\nfoo 4361 = 4360\nfoo 4362 = 4361\nfoo 4363 = 4362\nfoo 4364 = 4363\nfoo 4365 = 4364\nfoo 4366 = 4365\nfoo 4367 = 4366\nfoo 4368 = 4367\nfoo 4369 = 4368\nfoo 4370 = 4369\nfoo 4371 = 4370\nfoo 4372 = 4371\nfoo 4373 = 4372\nfoo 4374 = 4373\nfoo 4375 = 4374\nfoo 4376 = 4375\nfoo 4377 = 4376\nfoo 4378 = 4377\nfoo 4379 = 4378\nfoo 4380 = 4379\nfoo 4381 = 4380\nfoo 4382 = 4381\nfoo 4383 = 4382\nfoo 4384 = 4383\nfoo 4385 = 4384\nfoo 4386 = 4385\nfoo 4387 = 4386\nfoo 4388 = 4387\nfoo 4389 = 4388\nfoo 4390 = 4389\nfoo 4391 = 4390\nfoo 4392 = 4391\nfoo 4393 = 4392\nfoo 4394 = 4393\nfoo 4395 = 4394\nfoo 4396 = 4395\nfoo 4397 = 4396\nfoo 4398 = 4397\nfoo 4399 = 4398\nfoo 4400 = 4399\nfoo 4401 = 4400\nfoo 4402 = 4401\nfoo 4403 = 4402\nfoo 4404 = 4403\nfoo 4405 = 4404\nfoo 4406 = 4405\nfoo 4407 = 4406\nfoo 4408 = 4407\nfoo 4409 = 4408\nfoo 4410 = 4409\nfoo 4411 = 4410\nfoo 4412 = 4411\nfoo 4413 = 4412\nfoo 4414 = 4413\nfoo 4415 = 4414\nfoo 4416 = 4415\nfoo 4417 = 4416\nfoo 4418 = 4417\nfoo 4419 = 4418\nfoo 4420 = 4419\nfoo 4421 = 4420\nfoo 4422 = 4421\nfoo 4423 = 4422\nfoo 4424 = 4423\nfoo 4425 = 4424\nfoo 4426 = 4425\nfoo 4427 = 4426\nfoo 4428 = 4427\nfoo 4429 = 4428\nfoo 4430 = 4429\nfoo 4431 = 4430\nfoo 4432 = 4431\nfoo 4433 = 4432\nfoo 4434 = 4433\nfoo 4435 = 4434\nfoo 4436 = 4435\nfoo 4437 = 4436\nfoo 4438 = 4437\nfoo 4439 = 4438\nfoo 4440 = 4439\nfoo 4441 = 4440\nfoo 4442 = 4441\nfoo 4443 = 4442\nfoo 4444 = 4443\nfoo 4445 = 4444\nfoo 4446 = 4445\nfoo 4447 = 4446\nfoo 4448 = 4447\nfoo 4449 = 4448\nfoo 4450 = 4449\nfoo 4451 = 4450\nfoo 4452 = 4451\nfoo 4453 = 4452\nfoo 4454 = 4453\nfoo 4455 = 4454\nfoo 4456 = 4455\nfoo 4457 = 4456\nfoo 4458 = 4457\nfoo 4459 = 4458\nfoo 4460 = 4459\nfoo 4461 = 4460\nfoo 4462 = 4461\nfoo 4463 = 4462\nfoo 4464 = 4463\nfoo 4465 = 4464\nfoo 4466 = 4465\nfoo 4467 = 4466\nfoo 4468 = 4467\nfoo 4469 = 4468\nfoo 4470 = 4469\nfoo 4471 = 4470\nfoo 4472 = 4471\nfoo 4473 = 4472\nfoo 4474 = 4473\nfoo 4475 = 4474\nfoo 4476 = 4475\nfoo 4477 = 4476\nfoo 4478 = 4477\nfoo 4479 = 4478\nfoo 4480 = 4479\nfoo 4481 = 4480\nfoo 4482 = 4481\nfoo 4483 = 4482\nfoo 4484 = 4483\nfoo 4485 = 4484\nfoo 4486 = 4485\nfoo 4487 = 4486\nfoo 4488 = 4487\nfoo 4489 = 4488\nfoo 4490 = 4489\nfoo 4491 = 4490\nfoo 4492 = 4491\nfoo 4493 = 4492\nfoo 4494 = 4493\nfoo 4495 = 4494\nfoo 4496 = 4495\nfoo 4497 = 4496\nfoo 4498 = 4497\nfoo 4499 = 4498\nfoo 4500 = 4499\nfoo 4501 = 4500\nfoo 4502 = 4501\nfoo 4503 = 4502\nfoo 4504 = 4503\nfoo 4505 = 4504\nfoo 4506 = 4505\nfoo 4507 = 4506\nfoo 4508 = 4507\nfoo 4509 = 4508\nfoo 4510 = 4509\nfoo 4511 = 4510\nfoo 4512 = 4511\nfoo 4513 = 4512\nfoo 4514 = 4513\nfoo 4515 = 4514\nfoo 4516 = 4515\nfoo 4517 = 4516\nfoo 4518 = 4517\nfoo 4519 = 4518\nfoo 4520 = 4519\nfoo 4521 = 4520\nfoo 4522 = 4521\nfoo 4523 = 4522\nfoo 4524 = 4523\nfoo 4525 = 4524\nfoo 4526 = 4525\nfoo 4527 = 4526\nfoo 4528 = 4527\nfoo 4529 = 4528\nfoo 4530 = 4529\nfoo 4531 = 4530\nfoo 4532 = 4531\nfoo 4533 = 4532\nfoo 4534 = 4533\nfoo 4535 = 4534\nfoo 4536 = 4535\nfoo 4537 = 4536\nfoo 4538 = 4537\nfoo 4539 = 4538\nfoo 4540 = 4539\nfoo 4541 = 4540\nfoo 4542 = 4541\nfoo 4543 = 4542\nfoo 4544 = 4543\nfoo 4545 = 4544\nfoo 4546 = 4545\nfoo 4547 = 4546\nfoo 4548 = 4547\nfoo 4549 = 4548\nfoo 4550 = 4549\nfoo 4551 = 4550\nfoo 4552 = 4551\nfoo 4553 = 4552\nfoo 4554 = 4553\nfoo 4555 = 4554\nfoo 4556 = 4555\nfoo 4557 = 4556\nfoo 4558 = 4557\nfoo 4559 = 4558\nfoo 4560 = 4559\nfoo 4561 = 4560\nfoo 4562 = 4561\nfoo 4563 = 4562\nfoo 4564 = 4563\nfoo 4565 = 4564\nfoo 4566 = 4565\nfoo 4567 = 4566\nfoo 4568 = 4567\nfoo 4569 = 4568\nfoo 4570 = 4569\nfoo 4571 = 4570\nfoo 4572 = 4571\nfoo 4573 = 4572\nfoo 4574 = 4573\nfoo 4575 = 4574\nfoo 4576 = 4575\nfoo 4577 = 4576\nfoo 4578 = 4577\nfoo 4579 = 4578\nfoo 4580 = 4579\nfoo 4581 = 4580\nfoo 4582 = 4581\nfoo 4583 = 4582\nfoo 4584 = 4583\nfoo 4585 = 4584\nfoo 4586 = 4585\nfoo 4587 = 4586\nfoo 4588 = 4587\nfoo 4589 = 4588\nfoo 4590 = 4589\nfoo 4591 = 4590\nfoo 4592 = 4591\nfoo 4593 = 4592\nfoo 4594 = 4593\nfoo 4595 = 4594\nfoo 4596 = 4595\nfoo 4597 = 4596\nfoo 4598 = 4597\nfoo 4599 = 4598\nfoo 4600 = 4599\nfoo 4601 = 4600\nfoo 4602 = 4601\nfoo 4603 = 4602\nfoo 4604 = 4603\nfoo 4605 = 4604\nfoo 4606 = 4605\nfoo 4607 = 4606\nfoo 4608 = 4607\nfoo 4609 = 4608\nfoo 4610 = 4609\nfoo 4611 = 4610\nfoo 4612 = 4611\nfoo 4613 = 4612\nfoo 4614 = 4613\nfoo 4615 = 4614\nfoo 4616 = 4615\nfoo 4617 = 4616\nfoo 4618 = 4617\nfoo 4619 = 4618\nfoo 4620 = 4619\nfoo 4621 = 4620\nfoo 4622 = 4621\nfoo 4623 = 4622\nfoo 4624 = 4623\nfoo 4625 = 4624\nfoo 4626 = 4625\nfoo 4627 = 4626\nfoo 4628 = 4627\nfoo 4629 = 4628\nfoo 4630 = 4629\nfoo 4631 = 4630\nfoo 4632 = 4631\nfoo 4633 = 4632\nfoo 4634 = 4633\nfoo 4635 = 4634\nfoo 4636 = 4635\nfoo 4637 = 4636\nfoo 4638 = 4637\nfoo 4639 = 4638\nfoo 4640 = 4639\nfoo 4641 = 4640\nfoo 4642 = 4641\nfoo 4643 = 4642\nfoo 4644 = 4643\nfoo 4645 = 4644\nfoo 4646 = 4645\nfoo 4647 = 4646\nfoo 4648 = 4647\nfoo 4649 = 4648\nfoo 4650 = 4649\nfoo 4651 = 4650\nfoo 4652 = 4651\nfoo 4653 = 4652\nfoo 4654 = 4653\nfoo 4655 = 4654\nfoo 4656 = 4655\nfoo 4657 = 4656\nfoo 4658 = 4657\nfoo 4659 = 4658\nfoo 4660 = 4659\nfoo 4661 = 4660\nfoo 4662 = 4661\nfoo 4663 = 4662\nfoo 4664 = 4663\nfoo 4665 = 4664\nfoo 4666 = 4665\nfoo 4667 = 4666\nfoo 4668 = 4667\nfoo 4669 = 4668\nfoo 4670 = 4669\nfoo 4671 = 4670\nfoo 4672 = 4671\nfoo 4673 = 4672\nfoo 4674 = 4673\nfoo 4675 = 4674\nfoo 4676 = 4675\nfoo 4677 = 4676\nfoo 4678 = 4677\nfoo 4679 = 4678\nfoo 4680 = 4679\nfoo 4681 = 4680\nfoo 4682 = 4681\nfoo 4683 = 4682\nfoo 4684 = 4683\nfoo 4685 = 4684\nfoo 4686 = 4685\nfoo 4687 = 4686\nfoo 4688 = 4687\nfoo 4689 = 4688\nfoo 4690 = 4689\nfoo 4691 = 4690\nfoo 4692 = 4691\nfoo 4693 = 4692\nfoo 4694 = 4693\nfoo 4695 = 4694\nfoo 4696 = 4695\nfoo 4697 = 4696\nfoo 4698 = 4697\nfoo 4699 = 4698\nfoo 4700 = 4699\nfoo 4701 = 4700\nfoo 4702 = 4701\nfoo 4703 = 4702\nfoo 4704 = 4703\nfoo 4705 = 4704\nfoo 4706 = 4705\nfoo 4707 = 4706\nfoo 4708 = 4707\nfoo 4709 = 4708\nfoo 4710 = 4709\nfoo 4711 = 4710\nfoo 4712 = 4711\nfoo 4713 = 4712\nfoo 4714 = 4713\nfoo 4715 = 4714\nfoo 4716 = 4715\nfoo 4717 = 4716\nfoo 4718 = 4717\nfoo 4719 = 4718\nfoo 4720 = 4719\nfoo 4721 = 4720\nfoo 4722 = 4721\nfoo 4723 = 4722\nfoo 4724 = 4723\nfoo 4725 = 4724\nfoo 4726 = 4725\nfoo 4727 = 4726\nfoo 4728 = 4727\nfoo 4729 = 4728\nfoo 4730 = 4729\nfoo 4731 = 4730\nfoo 4732 = 4731\nfoo 4733 = 4732\nfoo 4734 = 4733\nfoo 4735 = 4734\nfoo 4736 = 4735\nfoo 4737 = 4736\nfoo 4738 = 4737\nfoo 4739 = 4738\nfoo 4740 = 4739\nfoo 4741 = 4740\nfoo 4742 = 4741\nfoo 4743 = 4742\nfoo 4744 = 4743\nfoo 4745 = 4744\nfoo 4746 = 4745\nfoo 4747 = 4746\nfoo 4748 = 4747\nfoo 4749 = 4748\nfoo 4750 = 4749\nfoo 4751 = 4750\nfoo 4752 = 4751\nfoo 4753 = 4752\nfoo 4754 = 4753\nfoo 4755 = 4754\nfoo 4756 = 4755\nfoo 4757 = 4756\nfoo 4758 = 4757\nfoo 4759 = 4758\nfoo 4760 = 4759\nfoo 4761 = 4760\nfoo 4762 = 4761\nfoo 4763 = 4762\nfoo 4764 = 4763\nfoo 4765 = 4764\nfoo 4766 = 4765\nfoo 4767 = 4766\nfoo 4768 = 4767\nfoo 4769 = 4768\nfoo 4770 = 4769\nfoo 4771 = 4770\nfoo 4772 = 4771\nfoo 4773 = 4772\nfoo 4774 = 4773\nfoo 4775 = 4774\nfoo 4776 = 4775\nfoo 4777 = 4776\nfoo 4778 = 4777\nfoo 4779 = 4778\nfoo 4780 = 4779\nfoo 4781 = 4780\nfoo 4782 = 4781\nfoo 4783 = 4782\nfoo 4784 = 4783\nfoo 4785 = 4784\nfoo 4786 = 4785\nfoo 4787 = 4786\nfoo 4788 = 4787\nfoo 4789 = 4788\nfoo 4790 = 4789\nfoo 4791 = 4790\nfoo 4792 = 4791\nfoo 4793 = 4792\nfoo 4794 = 4793\nfoo 4795 = 4794\nfoo 4796 = 4795\nfoo 4797 = 4796\nfoo 4798 = 4797\nfoo 4799 = 4798\nfoo 4800 = 4799\nfoo 4801 = 4800\nfoo 4802 = 4801\nfoo 4803 = 4802\nfoo 4804 = 4803\nfoo 4805 = 4804\nfoo 4806 = 4805\nfoo 4807 = 4806\nfoo 4808 = 4807\nfoo 4809 = 4808\nfoo 4810 = 4809\nfoo 4811 = 4810\nfoo 4812 = 4811\nfoo 4813 = 4812\nfoo 4814 = 4813\nfoo 4815 = 4814\nfoo 4816 = 4815\nfoo 4817 = 4816\nfoo 4818 = 4817\nfoo 4819 = 4818\nfoo 4820 = 4819\nfoo 4821 = 4820\nfoo 4822 = 4821\nfoo 4823 = 4822\nfoo 4824 = 4823\nfoo 4825 = 4824\nfoo 4826 = 4825\nfoo 4827 = 4826\nfoo 4828 = 4827\nfoo 4829 = 4828\nfoo 4830 = 4829\nfoo 4831 = 4830\nfoo 4832 = 4831\nfoo 4833 = 4832\nfoo 4834 = 4833\nfoo 4835 = 4834\nfoo 4836 = 4835\nfoo 4837 = 4836\nfoo 4838 = 4837\nfoo 4839 = 4838\nfoo 4840 = 4839\nfoo 4841 = 4840\nfoo 4842 = 4841\nfoo 4843 = 4842\nfoo 4844 = 4843\nfoo 4845 = 4844\nfoo 4846 = 4845\nfoo 4847 = 4846\nfoo 4848 = 4847\nfoo 4849 = 4848\nfoo 4850 = 4849\nfoo 4851 = 4850\nfoo 4852 = 4851\nfoo 4853 = 4852\nfoo 4854 = 4853\nfoo 4855 = 4854\nfoo 4856 = 4855\nfoo 4857 = 4856\nfoo 4858 = 4857\nfoo 4859 = 4858\nfoo 4860 = 4859\nfoo 4861 = 4860\nfoo 4862 = 4861\nfoo 4863 = 4862\nfoo 4864 = 4863\nfoo 4865 = 4864\nfoo 4866 = 4865\nfoo 4867 = 4866\nfoo 4868 = 4867\nfoo 4869 = 4868\nfoo 4870 = 4869\nfoo 4871 = 4870\nfoo 4872 = 4871\nfoo 4873 = 4872\nfoo 4874 = 4873\nfoo 4875 = 4874\nfoo 4876 = 4875\nfoo 4877 = 4876\nfoo 4878 = 4877\nfoo 4879 = 4878\nfoo 4880 = 4879\nfoo 4881 = 4880\nfoo 4882 = 4881\nfoo 4883 = 4882\nfoo 4884 = 4883\nfoo 4885 = 4884\nfoo 4886 = 4885\nfoo 4887 = 4886\nfoo 4888 = 4887\nfoo 4889 = 4888\nfoo 4890 = 4889\nfoo 4891 = 4890\nfoo 4892 = 4891\nfoo 4893 = 4892\nfoo 4894 = 4893\nfoo 4895 = 4894\nfoo 4896 = 4895\nfoo 4897 = 4896\nfoo 4898 = 4897\nfoo 4899 = 4898\nfoo 4900 = 4899\nfoo 4901 = 4900\nfoo 4902 = 4901\nfoo 4903 = 4902\nfoo 4904 = 4903\nfoo 4905 = 4904\nfoo 4906 = 4905\nfoo 4907 = 4906\nfoo 4908 = 4907\nfoo 4909 = 4908\nfoo 4910 = 4909\nfoo 4911 = 4910\nfoo 4912 = 4911\nfoo 4913 = 4912\nfoo 4914 = 4913\nfoo 4915 = 4914\nfoo 4916 = 4915\nfoo 4917 = 4916\nfoo 4918 = 4917\nfoo 4919 = 4918\nfoo 4920 = 4919\nfoo 4921 = 4920\nfoo 4922 = 4921\nfoo 4923 = 4922\nfoo 4924 = 4923\nfoo 4925 = 4924\nfoo 4926 = 4925\nfoo 4927 = 4926\nfoo 4928 = 4927\nfoo 4929 = 4928\nfoo 4930 = 4929\nfoo 4931 = 4930\nfoo 4932 = 4931\nfoo 4933 = 4932\nfoo 4934 = 4933\nfoo 4935 = 4934\nfoo 4936 = 4935\nfoo 4937 = 4936\nfoo 4938 = 4937\nfoo 4939 = 4938\nfoo 4940 = 4939\nfoo 4941 = 4940\nfoo 4942 = 4941\nfoo 4943 = 4942\nfoo 4944 = 4943\nfoo 4945 = 4944\nfoo 4946 = 4945\nfoo 4947 = 4946\nfoo 4948 = 4947\nfoo 4949 = 4948\nfoo 4950 = 4949\nfoo 4951 = 4950\nfoo 4952 = 4951\nfoo 4953 = 4952\nfoo 4954 = 4953\nfoo 4955 = 4954\nfoo 4956 = 4955\nfoo 4957 = 4956\nfoo 4958 = 4957\nfoo 4959 = 4958\nfoo 4960 = 4959\nfoo 4961 = 4960\nfoo 4962 = 4961\nfoo 4963 = 4962\nfoo 4964 = 4963\nfoo 4965 = 4964\nfoo 4966 = 4965\nfoo 4967 = 4966\nfoo 4968 = 4967\nfoo 4969 = 4968\nfoo 4970 = 4969\nfoo 4971 = 4970\nfoo 4972 = 4971\nfoo 4973 = 4972\nfoo 4974 = 4973\nfoo 4975 = 4974\nfoo 4976 = 4975\nfoo 4977 = 4976\nfoo 4978 = 4977\nfoo 4979 = 4978\nfoo 4980 = 4979\nfoo 4981 = 4980\nfoo 4982 = 4981\nfoo 4983 = 4982\nfoo 4984 = 4983\nfoo 4985 = 4984\nfoo 4986 = 4985\nfoo 4987 = 4986\nfoo 4988 = 4987\nfoo 4989 = 4988\nfoo 4990 = 4989\nfoo 4991 = 4990\nfoo 4992 = 4991\nfoo 4993 = 4992\nfoo 4994 = 4993\nfoo 4995 = 4994\nfoo 4996 = 4995\nfoo 4997 = 4996\nfoo 4998 = 4997\nfoo 4999 = 4998\nfoo 5000 = 4999\nfoo n = n + 1\n", "num_lines": 5008}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies #-}\n\nclass X a b | a -> b where\n  to :: a -> b\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n    This code produces an empty case statement, which\n    panics the bytecode generator after trac #11155.\n-}\n\nmodule ShouldCompile where\n\nimport GHC.TypeLits (Symbol)\nimport Unsafe.Coerce\n\ninstance Read Symbol where\n     readsPrec = unsafeCoerce (readsPrec :: Int -> ReadS String)\n\ndata Bar = TyCon !Symbol deriving (Read)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13825 where\n\nimport Data.Int\nimport Data.Word\n\ndata Packed =\n    Packed\n      {-# UNPACK #-} !Float\n      {-# UNPACK #-} !Float\n      {-# UNPACK #-} !Int8\n      {-# UNPACK #-} !Word16\n      {-# UNPACK #-} !Float\n      {-# UNPACK #-} !Int\n  deriving (Show)\n\n-- Test a top-level constant\npacked :: Packed\npacked = Packed 1.0 2.0 3 4 5 6\n\npackedAll :: [Packed]\npackedAll =\n    packed :\n    [ Packed\n        (fromIntegral i)\n        (fromIntegral (i + 1))\n        (fromIntegral (i + 2))\n        (fromIntegral (i + 3))\n        (fromIntegral (i + 3))\n        (fromIntegral (i + 4))\n    | i <- [1.. 4]\n    ]\n\naddOne :: Packed -> Packed\naddOne (Packed a b c d e f) =\n    Packed (a + 1.0) (b + 1.0) (c + 1) (d + 1) (e + 1.0) (f + 1)\n\nmapAddOne :: [Packed] -> [Packed]\nmapAddOne = map addOne\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "test :: IO Bool\ntest = return True\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "test :: IO Bool\ntest = return True\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n\ntest :: IO Bool\ntest = return True\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15369 where\nx :: Int\nx = 1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport GHC.Ptr\nimport GHC.Exts\nimport Foreign.Ptr\n\nmain = print (Ptr nullAddr# == nullPtr)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Word\nfib :: Word -> Word\nfib 0 = 1\nfib 1 = 1\nfib n = l + r \n  where l = fib (n-2); r = fib (n-1)\n\nmain = print (fib 20)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nimport System.Mem\nimport GHC.Base\n\nmain = do\n  let list = concatMap buildThunk [0..10000]\n  length list `seq` performGC\n  print $ last list\n\nbuildThunk :: Int -> [Int]\nbuildThunk (I# k) = [f k]\n\nf :: Int# -> Int\nf x = I# x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\n\nmain = defaultMain\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TcPluginGHCi where\n\nimport TcRnMonad ( TcPlugin(..), TcPluginResult(..) )\nimport Plugins ( defaultPlugin, Plugin(..), CommandLineOption )\nimport Debug.Trace\n\nplugin :: Plugin\nplugin = defaultPlugin { tcPlugin = Just . thePlugin }\n\nthePlugin :: [CommandLineOption] -> TcPlugin\nthePlugin opts = TcPlugin\n  { tcPluginInit  = trace \"TcPluginGHCi\" (return ())\n  , tcPluginSolve = \\_ _ _ _ -> return $ TcPluginOk [] []\n  , tcPluginStop  = \\_ -> return ()\n  }\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\ndata A = A\n\nf :: A -> Bool\nf C = False\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport {-# SOURCE #-} A\n\ndata B = B A\n\ng :: B -> Bool\ng (B a) = f a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (caf, c_two) where\n\nimport Debug.Trace (trace)\n\ndata C = C Int Int\n\ncaf :: C\ncaf = C 3 (trace \"value forced\" 4)\n\nc_two :: C -> Int\nc_two (C _ b) = b\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data Empty\ndata NonEmpty\n\ndata SafeList x y where\n     Nil :: SafeList x Empty\n     Cons:: Eq x => x -> SafeList x y  -> SafeList x NonEmpty\n     One :: Eq x => x -> SafeList x Empty -> SafeList x NonEmpty\n\nsafeHead :: SafeList x NonEmpty -> x\nsafeHead (Cons x _) = x\n\nfoo = Cons (3 :: Int) (Cons 6 (Cons 9 Nil))\n\n\ndata Dict x where\n        DictN :: Num x => x -> Dict x\n        DictE :: Eq x =>  x -> Dict x\n\ndata Exist where\n        Exist :: forall a. a -> Exist\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\n\nmain = getArgs >>= print\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash, BangPatterns #-}\nimport Data.Char\nimport Data.Array\nimport GHC.Exts\nimport System.IO\nimport System.IO.Unsafe\nimport Debug.Trace\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\n-- parser produced by Happy Version 1.16\n\ndata HappyAbsSyn\n\t= HappyTerminal Token\n\t| HappyErrorToken Int\n\t| HappyAbsSyn4 (Exp)\n\t| HappyAbsSyn5 (Exp1)\n\t| HappyAbsSyn6 (Term)\n\t| HappyAbsSyn7 (Factor)\n\nhappyActOffsets :: HappyAddr\nhappyActOffsets = HappyA# \"\\x01\\x00\\x25\\x00\\x1e\\x00\\x1b\\x00\\x1d\\x00\\x18\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\xf8\\xff\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x20\\x00\\x01\\x00\\x18\\x00\\x18\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x0a\\x00\\x01\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyGotoOffsets :: HappyAddr\nhappyGotoOffsets = HappyA# \"\\x1a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x16\\x00\\x00\\x00\\x07\\x00\\xfe\\xff\\x1c\\x00\\x06\\x00\\x00\\x00\\x12\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x0e\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyDefActions :: HappyAddr\nhappyDefActions = HappyA# \"\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xfd\\xff\\xfa\\xff\\xf7\\xff\\xf6\\xff\\xf5\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xfb\\xff\\xfc\\xff\\xf8\\xff\\xf9\\xff\\xf4\\xff\\x00\\x00\\x00\\x00\\xfe\\xff\"#\n\nhappyCheck :: HappyAddr\nhappyCheck = HappyA# \"\\xff\\xff\\x03\\x00\\x01\\x00\\x0b\\x00\\x03\\x00\\x04\\x00\\x03\\x00\\x04\\x00\\x02\\x00\\x03\\x00\\x03\\x00\\x0a\\x00\\x02\\x00\\x0a\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x02\\x00\\x03\\x00\\x08\\x00\\x09\\x00\\x04\\x00\\x06\\x00\\x07\\x00\\x05\\x00\\x01\\x00\\x0c\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\"#\n\nhappyTable :: HappyAddr\nhappyTable = HappyA# \"\\x00\\x00\\x13\\x00\\x03\\x00\\x16\\x00\\x08\\x00\\x09\\x00\\x08\\x00\\x09\\x00\\x11\\x00\\x06\\x00\\x14\\x00\\x0a\\x00\\x18\\x00\\x0a\\x00\\x18\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x16\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x0a\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x12\\x00\\x06\\x00\\x0c\\x00\\x0d\\x00\\x10\\x00\\x0e\\x00\\x0f\\x00\\x11\\x00\\x03\\x00\\xff\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyReduceArr = array (1, 11) [\n\t(1 , happyReduce_1),\n\t(2 , happyReduce_2),\n\t(3 , happyReduce_3),\n\t(4 , happyReduce_4),\n\t(5 , happyReduce_5),\n\t(6 , happyReduce_6),\n\t(7 , happyReduce_7),\n\t(8 , happyReduce_8),\n\t(9 , happyReduce_9),\n\t(10 , happyReduce_10),\n\t(11 , happyReduce_11)\n\t]\n\nhappy_n_terms = 13 :: Int\nhappy_n_nonterms = 4 :: Int\n\nhappyReduce_1 = happyReduce 6# 0# happyReduction_1\nhappyReduction_1 ((HappyAbsSyn4  happy_var_6) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn4  happy_var_4) `HappyStk`\n\t_ `HappyStk`\n\t(HappyTerminal (TokenVar happy_var_2)) `HappyStk`\n\t_ `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn4\n\t\t (Let happy_var_2 happy_var_4 happy_var_6\n\t) `HappyStk` happyRest\n\nhappyReduce_2 = happySpecReduce_1  0# happyReduction_2\nhappyReduction_2 (HappyAbsSyn5  happy_var_1)\n\t =  HappyAbsSyn4\n\t\t (Exp1 happy_var_1\n\t)\nhappyReduction_2 _  = notHappyAtAll\n\nhappyReduce_3 = happySpecReduce_3  1# happyReduction_3\nhappyReduction_3 (HappyAbsSyn6  happy_var_3)\n\t_\n\t(HappyAbsSyn5  happy_var_1)\n\t =  HappyAbsSyn5\n\t\t (Plus happy_var_1 happy_var_3\n\t)\nhappyReduction_3 _ _ _  = notHappyAtAll\n\nhappyReduce_4 = happySpecReduce_3  1# happyReduction_4\nhappyReduction_4 (HappyAbsSyn6  happy_var_3)\n\t_\n\t(HappyAbsSyn5  happy_var_1)\n\t =  HappyAbsSyn5\n\t\t (Minus happy_var_1 happy_var_3\n\t)\nhappyReduction_4 _ _ _  = notHappyAtAll\n\nhappyReduce_5 = happySpecReduce_1  1# happyReduction_5\nhappyReduction_5 (HappyAbsSyn6  happy_var_1)\n\t =  HappyAbsSyn5\n\t\t (Term happy_var_1\n\t)\nhappyReduction_5 _  = notHappyAtAll\n\nhappyReduce_6 = happySpecReduce_3  2# happyReduction_6\nhappyReduction_6 (HappyAbsSyn7  happy_var_3)\n\t_\n\t(HappyAbsSyn6  happy_var_1)\n\t =  HappyAbsSyn6\n\t\t (Times happy_var_1 happy_var_3\n\t)\nhappyReduction_6 _ _ _  = notHappyAtAll\n\nhappyReduce_7 = happySpecReduce_3  2# happyReduction_7\nhappyReduction_7 (HappyAbsSyn7  happy_var_3)\n\t_\n\t(HappyAbsSyn6  happy_var_1)\n\t =  HappyAbsSyn6\n\t\t (Div happy_var_1 happy_var_3\n\t)\nhappyReduction_7 _ _ _  = notHappyAtAll\n\nhappyReduce_8 = happySpecReduce_1  2# happyReduction_8\nhappyReduction_8 (HappyAbsSyn7  happy_var_1)\n\t =  HappyAbsSyn6\n\t\t (Factor happy_var_1\n\t)\nhappyReduction_8 _  = notHappyAtAll\n\nhappyReduce_9 = happySpecReduce_1  3# happyReduction_9\nhappyReduction_9 (HappyTerminal (TokenInt happy_var_1))\n\t =  HappyAbsSyn7\n\t\t (Int happy_var_1\n\t)\nhappyReduction_9 _  = notHappyAtAll\n\nhappyReduce_10 = happySpecReduce_1  3# happyReduction_10\nhappyReduction_10 (HappyTerminal (TokenVar happy_var_1))\n\t =  HappyAbsSyn7\n\t\t (Var happy_var_1\n\t)\nhappyReduction_10 _  = notHappyAtAll\n\nhappyReduce_11 = happySpecReduce_3  3# happyReduction_11\nhappyReduction_11 _\n\t(HappyAbsSyn4  happy_var_2)\n\t_\n\t =  HappyAbsSyn7\n\t\t (Brack happy_var_2\n\t)\nhappyReduction_11 _ _ _  = notHappyAtAll\n\nhappyNewToken action sts stk [] =\n\thappyDoAction 12# notHappyAtAll action sts stk []\n\nhappyNewToken action sts stk (tk:tks) =\n\tlet cont i = happyDoAction i tk action sts stk tks in\n\tcase tk of {\n\tTokenLet -> cont 1#;\n\tTokenIn -> cont 2#;\n\tTokenInt happy_dollar_dollar -> cont 3#;\n\tTokenVar happy_dollar_dollar -> cont 4#;\n\tTokenEq -> cont 5#;\n\tTokenPlus -> cont 6#;\n\tTokenMinus -> cont 7#;\n\tTokenTimes -> cont 8#;\n\tTokenDiv -> cont 9#;\n\tTokenOB -> cont 10#;\n\tTokenCB -> cont 11#;\n\t_ -> happyError' (tk:tks)\n\t}\n\nhappyError_ tk tks = happyError' (tk:tks)\n\nnewtype HappyIdentity a = HappyIdentity a\nhappyIdentity = HappyIdentity\nhappyRunIdentity (HappyIdentity a) = a\n\ninstance Functor HappyIdentity where\n    fmap = liftM\n\ninstance Applicative HappyIdentity where\n    pure = return\n    (<*>) = ap\n\ninstance Monad HappyIdentity where\n    return = HappyIdentity\n    (HappyIdentity p) >>= q = q p\n\nhappyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b\nhappyThen = (>>=)\nhappyReturn :: () => a -> HappyIdentity a\nhappyReturn = (return)\nhappyThen1 m k tks = (>>=) m (\\a -> k a tks)\nhappyReturn1 :: () => a -> b -> HappyIdentity a\nhappyReturn1 = \\a tks -> (return) a\nhappyError' :: () => [Token] -> HappyIdentity a\nhappyError' = HappyIdentity . happyError\n\ncalc tks = happyRunIdentity happySomeParser where\n  happySomeParser = happyThen (happyParse 0# tks) (\\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll })\n\nhappySeq = happyDontSeq\n\n\nhappyError tks = error \"Parse error\"\n\n\n\ndata Exp  = Let String Exp Exp | Exp1 Exp1\ndata Exp1 = Plus Exp1 Term | Minus Exp1 Term | Term Term\ndata Term = Times Term Factor | Div Term Factor | Factor Factor\ndata Factor = Int Int | Var String | Brack Exp\n\n\n\ndata Token\n\t= TokenLet\n\t| TokenIn\n\t| TokenInt Int\n\t| TokenVar String\n\t| TokenEq\n\t| TokenPlus\n\t| TokenMinus\n\t| TokenTimes\n\t| TokenDiv\n\t| TokenOB\n\t| TokenCB\n\n\n\nlexer :: String -> [Token]\nlexer [] = []\nlexer (c:cs)\n\t| isSpace c = lexer cs\n\t| isAlpha c = lexVar (c:cs)\n\t| isDigit c = lexNum (c:cs)\nlexer ('=':cs) = TokenEq : lexer cs\nlexer ('+':cs) = TokenPlus : lexer cs\nlexer ('-':cs) = TokenMinus : lexer cs\nlexer ('*':cs) = TokenTimes : lexer cs\nlexer ('/':cs) = TokenDiv : lexer cs\nlexer ('(':cs) = TokenOB : lexer cs\nlexer (')':cs) = TokenCB : lexer cs\n\nlexNum cs = TokenInt (read num) : lexer rest\n\twhere (num,rest) = span isDigit cs\n\nlexVar cs =\n   case span isAlpha cs of\n\t(\"let\",rest) -> TokenLet : lexer rest\n\t(\"in\",rest)  -> TokenIn : lexer rest\n\t(var,rest)   -> TokenVar var : lexer rest\n\n\n\n\nrunCalc :: String -> Exp\nrunCalc = calc . lexer\n\n\n\nmain = case runCalc \"1 + 2 + 3\" of {\n\t(Exp1 (Plus (Plus (Term (Factor (Int 1))) (Factor (Int 2))) (Factor (Int 3))))  ->\n\tcase runCalc \"1 * 2 + 3\" of {\n\t(Exp1 (Plus (Term (Times (Factor (Int 1)) (Int 2))) (Factor (Int 3)))) ->\n\tcase runCalc \"1 + 2 * 3\" of {\n\t(Exp1 (Plus (Term (Factor (Int 1))) (Times (Factor (Int 2)) (Int 3)))) ->\n\tcase runCalc \"let x = 2 in x * (x - 2)\" of {\n\t(Let \"x\" (Exp1 (Term (Factor (Int 2)))) (Exp1 (Term (Times (Factor (Var \"x\")) (Brack (Exp1 (Minus (Term (Factor (Var \"x\"))) (Factor (Int 2))))))))) -> print \"Test works\\n\";\n\t_ -> quit } ; _ -> quit } ; _ -> quit } ; _ -> quit }\nquit = print \"Test failed\\n\"\n{-# LINE 1 \"GenericTemplate.hs\" #-}\n{-# LINE 1 \"<built-in>\" #-}\n{-# LINE 1 \"<command line>\" #-}\n{-# LINE 1 \"GenericTemplate.hs\" #-}\n-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp\n\n{-# LINE 28 \"GenericTemplate.hs\" #-}\n\n\ndata Happy_IntList = HappyCons Int# Happy_IntList\n\n\n\n\n\n{-# LINE 49 \"GenericTemplate.hs\" #-}\n\n{-# LINE 59 \"GenericTemplate.hs\" #-}\n\n\n\nhappyTrace string expr = unsafePerformIO $ do\n    hPutStr stderr string\n    return expr\n\n\n\n\ninfixr 9 `HappyStk`\ndata HappyStk a = HappyStk a (HappyStk a)\n\n-----------------------------------------------------------------------------\n-- starting the parse\n\nhappyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll\n\n-----------------------------------------------------------------------------\n-- Accepting the parse\n\n-- If the current token is 0#, it means we've just accepted a partial\n-- parse (a %partial parser).  We must ignore the saved token on the top of\n-- the stack in this case.\nhappyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =\n\thappyReturn1 ans\nhappyAccept j tk st sts (HappyStk ans _) =\n\t(happyTcHack j (happyTcHack st)) (happyReturn1 ans)\n\n-----------------------------------------------------------------------------\n-- Arrays only: do the next action\n\n\n\nhappyDoAction i tk st\n\t= (happyTrace (\"state: \" ++ show (I# (st)) ++  \t\t      \",\\ttoken: \" ++ show (I# (i)) ++ \t\t      \",\\taction: \")) $\n\n\n\t  case action of\n\t\t0#\t\t  -> (happyTrace (\"fail.\\n\")) $\n\t\t\t\t     happyFail i tk st\n\t\t-1# \t  -> (happyTrace (\"accept.\\n\")) $\n\t\t\t\t     happyAccept i tk st\n\t\tn | isTrue# (n <# (0# :: Int#)) -> (happyTrace (\"reduce (rule \" ++ show rule \t\t\t\t\t\t ++ \")\")) $\n\n\t\t\t\t     (happyReduceArr ! rule) i tk st\n\t\t\t\t     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))\n\t\tn\t\t  -> (happyTrace (\"shift, enter state \" \t\t\t\t\t\t ++ show (I# (new_state)) \t\t\t\t\t\t ++ \"\\n\")) $\n\n\n\t\t\t\t     happyShift new_state i tk st\n\t\t\t\t     where new_state = (n -# (1# :: Int#))\n   where off    = indexShortOffAddr happyActOffsets st\n\t off_i  = (off +# i)\n\t check  = if isTrue# (off_i >=# (0# :: Int#))\n\t\t\tthen isTrue# (indexShortOffAddr happyCheck off_i ==#  i)\n\t\t\telse False\n \t action | check     = indexShortOffAddr happyTable off_i\n\t\t| otherwise = indexShortOffAddr happyDefActions st\n\n{-# LINE 127 \"GenericTemplate.hs\" #-}\n\n\nindexShortOffAddr (HappyA# arr) off =\n\tnarrow16Int# i\n  where\n\ti = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)\n\thigh = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))\n\tlow  = int2Word# (ord# (indexCharOffAddr# arr off'))\n\toff' = off *# 2#\n\n\n\n\n\ndata HappyAddr = HappyA# Addr#\n\n\n\n\n-----------------------------------------------------------------------------\n-- HappyState data type (not arrays)\n\n{-# LINE 170 \"GenericTemplate.hs\" #-}\n\n-----------------------------------------------------------------------------\n-- Shifting a token\n\nhappyShift new_state 0# tk st sts stk@(x `HappyStk` _) =\n     let i = (case x of { HappyErrorToken (I# (i)) -> i }) in\n--     trace \"shifting the error token\" $\n     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)\n\nhappyShift new_state i tk st sts stk =\n     happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk)\n\n-- happyReduce is specialised for the common cases.\n\nhappySpecReduce_0 i fn 0# tk st sts stk\n     = happyFail 0# tk st sts stk\nhappySpecReduce_0 nt fn j tk st@((action)) sts stk\n     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)\n\nhappySpecReduce_1 i fn 0# tk st sts stk\n     = happyFail 0# tk st sts stk\nhappySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')\n     = let r = fn v1 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_2 i fn 0# tk st sts stk\n     = happyFail 0# tk st sts stk\nhappySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')\n     = let r = fn v1 v2 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_3 i fn 0# tk st sts stk\n     = happyFail 0# tk st sts stk\nhappySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')\n     = let r = fn v1 v2 v3 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappyReduce k i fn 0# tk st sts stk\n     = happyFail 0# tk st sts stk\nhappyReduce k nt fn j tk st sts stk\n     = case happyDrop (k -# (1# :: Int#)) sts of\n\t !sts1@((HappyCons (st1@(action)) (_))) ->\n        \tlet r = fn stk in  -- it doesn't hurt to always seq here...\n       \t\thappyDoSeq r (happyGoto nt j tk st1 sts1 r)\n\nhappyMonadReduce k nt fn 0# tk st sts stk\n     = happyFail 0# tk st sts stk\nhappyMonadReduce k nt fn j tk st sts stk =\n        happyThen1 (fn stk tk) (\\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))\n       where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))\n             drop_stk = happyDropStk k stk\n\nhappyMonad2Reduce k nt fn 0# tk st sts stk\n     = happyFail 0# tk st sts stk\nhappyMonad2Reduce k nt fn j tk st sts stk =\n       happyThen1 (fn stk tk) (\\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))\n       where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))\n             drop_stk = happyDropStk k stk\n\n             off    = indexShortOffAddr happyGotoOffsets st1\n             off_i  = (off +# nt)\n             new_state = indexShortOffAddr happyTable off_i\n\n\n\n\nhappyDrop 0# l = l\nhappyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t\n\nhappyDropStk 0# l = l\nhappyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs\n\n-----------------------------------------------------------------------------\n-- Moving to a new state after a reduction\n\n\nhappyGoto nt j tk st =\n   (happyTrace (\", goto state \" ++ show (I# (new_state)) ++ \"\\n\")) $\n   happyDoAction j tk new_state\n   where off    = indexShortOffAddr happyGotoOffsets st\n\t off_i  = (off +# nt)\n \t new_state = indexShortOffAddr happyTable off_i\n\n\n\n\n-----------------------------------------------------------------------------\n-- Error recovery (0# is the error token)\n\n-- parse error if we are in recovery and we fail again\nhappyFail  0# tk old_st _ stk =\n--\ttrace \"failing\" $\n    \thappyError_ tk\n\n{-  We don't need state discarding for our restricted implementation of\n    \"error\".  In fact, it can cause some bogus parses, so I've disabled it\n    for now --SDM\n\n-- discard a state\nhappyFail  0# tk old_st (HappyCons ((action)) (sts))\n\t\t\t\t\t\t(saved_tok `HappyStk` _ `HappyStk` stk) =\n--\ttrace (\"discarding state, depth \" ++ show (length stk))  $\n\thappyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))\n-}\n\n-- Enter error recovery: generate an error token,\n--                       save the old token and carry on.\nhappyFail  i tk (action) sts stk =\n--      trace \"entering error recovery\" $\n\thappyDoAction 0# tk action sts ( (HappyErrorToken (I# (i))) `HappyStk` stk)\n\n-- Internal happy errors:\n\nnotHappyAtAll = error \"Internal Happy error\\n\"\n\n-----------------------------------------------------------------------------\n-- Hack to get the typechecker to accept our action functions\n\n\nhappyTcHack :: Int# -> a -> a\nhappyTcHack x y = y\n{-# INLINE happyTcHack #-}\n\n\n-----------------------------------------------------------------------------\n-- Seq-ing.  If the --strict flag is given, then Happy emits\n--\thappySeq = happyDoSeq\n-- otherwise it emits\n-- \thappySeq = happyDontSeq\n\nhappyDoSeq, happyDontSeq :: a -> b -> b\nhappyDoSeq   a b = a `seq` b\nhappyDontSeq a b = b\n\n-----------------------------------------------------------------------------\n-- Don't inline any functions from the template.  GHC has a nasty habit\n-- of deciding to inline happyGoto everywhere, which increases the size of\n-- the generated parser quite a bit.\n\n\n{-# NOINLINE happyDoAction #-}\n{-# NOINLINE happyTable #-}\n{-# NOINLINE happyCheck #-}\n{-# NOINLINE happyActOffsets #-}\n{-# NOINLINE happyGotoOffsets #-}\n{-# NOINLINE happyDefActions #-}\n\n{-# NOINLINE happyShift #-}\n{-# NOINLINE happySpecReduce_0 #-}\n{-# NOINLINE happySpecReduce_1 #-}\n{-# NOINLINE happySpecReduce_2 #-}\n{-# NOINLINE happySpecReduce_3 #-}\n{-# NOINLINE happyReduce #-}\n{-# NOINLINE happyMonadReduce #-}\n{-# NOINLINE happyGoto #-}\n{-# NOINLINE happyFail #-}\n\n-- end of Happy Template.\n", "num_lines": 526}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad.Fix\nimport Data.IORef\nimport Prelude hiding (traverse)\n\ndata N a = N (IORef Bool, N a, a, N a)\n\nnewNode :: N a -> a -> N a -> IO (N a)\nnewNode b c f = do v  <- newIORef False\n                   return (N (v, b, c, f))\n\nll = mdo n0 <- newNode n3 0 n1\n         n1 <- newNode n0 1 n2\n         n2 <- newNode n1 2 n3\n         n3 <- newNode n2 3 n0\n         return n0\n\ndata Dir = F | B deriving Eq\n\ntraverse :: Dir -> N a -> IO [a]\ntraverse d (N (v, b, i, f)) =\n    do visited <- readIORef v\n       if visited\n          then return []\n          else do writeIORef v True\n                  let next = if d == F then f else b\n                  is <- traverse d next\n                  return (i:is)\n\nl2dll :: [a] -> IO (N a)\nl2dll (x:xs) = mdo c      <- newNode l x f\n                   (f, l) <- l2dll' c xs\n                   return c\n\nl2dll' :: N a -> [a] -> IO (N a, N a)\nl2dll' p []     = return (p, p)\nl2dll' p (x:xs) = mdo c      <- newNode p x f\n                      (f, l) <- l2dll' c xs\n                      return (c, l)\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module QSort where\n\n\nqsort [] = [] \nqsort (a:as) = (qsort left) ++ [a] ++ (qsort right)\n where (left,right) = (filter (<=a) as, filter (>a) as)\n\nrun = qsort [8 :: Int, 4, 0, 3, 1, 23, 11, 18]\n\n-- > run\n-- [0,1,3,4,8,11,18,23]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test.Test2 where\nimport Data.Typeable\n\ndata Show1 = S1 Char Char Char\n deriving Typeable\n\ndata Strict = S2 Char !Char\n\ndata Opaque = forall a. O a\ndata List1 a = Nil | a :^ (List1 a)\n  deriving Show\n\nnewtype MyInt = My Int\n  deriving (Eq,Show,Num, Enum)\n\nnewtype MkT a = MkT a\n  deriving (Show)\n\nnewtype MkT2 a = MkT2 (MkT a)\n  deriving Show\n\ndata Param2 s r = P2 (FakeSTRef r (s(Param2 s r)))\n                | P2Nil\ndata FakeSTRef r s = Ref s\n\ntestParam2 = O (P2 (Ref P2Nil))\n\ninfixr 5 :^\n--test T{t=t1} = undefined\n\ninstance Show Show1 where\n show (S1 a b c) = show (a)\n\ntype Just1 = Maybe\n\n\ndata Unary = Unary deriving Show\n\npoly :: a -> ()\npoly x = seq x ()\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test2 where\n\nf x = g x\n\ng y = y\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "mymap f [] = []\nmymap f (x:xs) = f x:mymap f xs\n\nmain = mapM_ putStrLn $ mymap ('a':) [\"hello\",\"bye\"] \n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data T a b = T (a -> b)\n\nf g y = () where x = T g\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f xs = head xs\n\ng xs = f xs\n\nmain = g []\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nmain = evaluate (error \"foo\")\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data Unboxed1 = Unboxed1 (# Int, Bool #)\n\ndata Unboxed2 = Unboxed2 (# Int, (# Int, Bool #) #)\n\no1 = Unboxed1 (# 5, True #)\no2 = Unboxed2 (# 6, (# 7, False #) #)\n\nforce_them :: Int\nforce_them = x + (if b then 1 else 2) + y + z + (if c then 3 else 4)\n  where\n    Unboxed1 (# x, b #) = o1\n    Unboxed2 (# y, (# z, c #) #) = o2", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "mymap f [] = []\nmymap f (x:xs) = f x:mymap f xs\n\nmain = mapM_ putStrLn $ mymap ('a':) [\"hello\",\"bye\"]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "g i = let a = i + 1\n          b = id\n          c = ()\n          d = (+)\n      in (a,b,c,d)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "g i = (a,b,c)\n      where a = False\n            b = True\n            c = ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "g i = let a = False\n          b = True\n          c = (a,b)\n      in c\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f i = if ?flag then i*2 else i\n\ng i = let ?flag=False in f i\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f i = i :: Int\n\ng :: Int -> ()\ng i = ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Break020b\n\nline1 _ = return ()\nline2 _ = return ()\n\nin_another_decl _ = do line1 0\n                       line2 0\n\nmain = do\n  line1 0\n  line2 0\n  in_another_decl 0\n  in_another_module 0\n  line2 1\n  return ()", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Break020b where\n  \n  \nin_another_module _ = return ()", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception as CE\n\nexception_uncaught = ioError (userError \"error\")\nexception_caught   = CE.try exception_uncaught :: IO (Either CE.IOException ())\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nimport Prelude hiding (foldl)\n\nfoldl f c xs = go c xs\n  where go c []     = c\n        go c (x:xs) = go (f c x) xs\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}\n\ntype family Id x\ntype instance Id Int = Int\ntype instance Id Bool = Bool\n\nclass Convert x y where convert :: x -> y\ninstance Convert x x where convert = id\n\nf :: Convert a (Id a) => a -> Id a\nf x = convert x\n\ng :: Convert a (Id a) => a -> Id a\ng x = let x' = f x in x'", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n\nf :: Int -> IO Int\nf x = do\n  y <- return (x + 1)\n  return (y * 2)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import TupleN\n\ntuple3 x = $(tuple 3) x\n\nnormal_fn x = tuple3 x", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f :: Maybe Int\nf = do\n   i <- return 1\n   j <- return 2\n   k <- return 3\n   return i", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f :: Int -> [Int]\nf i = [ j | j <- [i], h <- [j], k <- [h]]\n\ng i = i", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\n\nimport GHC.Base\n\nf :: Int -> Int# ->  Int#\nf x i = i\n\ntest = let !(I# i) = 3 in I# (f 2 i)", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Directory\n\nmain = do\n  setCurrentDirectory \"..\"\n  putStrLn \"Hello World\"", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nimport GHC.Exts\ndata T = C Int# Word# Float# Double# Char# Int Float Double\ntest = C 1# 32## 1.2# 1.23## 'x'# 1 1.2 1.23\n\ndata TwoFields = TwoFields Char Int deriving Show\n\ndata T2 = C2 {-# UNPACK #-} !Int {-#UNPACK#-} !Word {-# UNPACK #-} !TwoFields deriving Show\ntest2 = C2 1 32 (TwoFields 'a' 3)\n\nf x = x", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data T a s = T a deriving Show\nf x = x\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "newtype MkT2 a = MkT2 [Maybe a] deriving Show\n\nf :: t Int -> t Int\nf x = x\n\nf2 :: t Int -> t Int -> (t Int, t Int)\nf2 x y = (x,y)", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Print031 where\n\nnewtype MkT2 a = MkT2 [Maybe a] deriving Show\ndata Phantom a = Phantom Int deriving Show\n\nf :: t (Phantom a) -> Bool\nf x = const False x -- const just to bring x into scope", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f xs = case map id xs of\n         [] -> True\n         x:xs -> False\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T13825 where\n\nimport GHC.Exts\nimport Data.Word\nimport Data.Int\n\ndata Packed1 = Packed1 Float# Float# Int# Float#\n    deriving Show\n\ndata Packed2 =\n    Packed2\n        {-# UNPACK #-} !Float\n        {-# UNPACK #-} !Float\n        {-# UNPACK #-} !Int\n        {-# UNPACK #-} !Float\n    deriving Show\n\ndata Packed3 =\n    Packed3\n        {-# UNPACK #-} !Word8\n        {-# UNPACK #-} !Int8\n        {-# UNPACK #-} !Int64\n        {-# UNPACK #-} !Word16\n        {-# UNPACK #-} !Word64\n        {-# UNPACK #-} !Word32\n        {-# UNPACK #-} !Float\n        {-# UNPACK #-} !Double\n    deriving Show\n\npacked1 = Packed1 12.34# 56.78# 42# 99.99#\npacked2 = Packed2 12.34 56.78 42 99.99\npacked3 = Packed3 1 2 3 4 5 6 7.8 9.0\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nf x y z | x<y       = z\n        | otherwise = z*y\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeFamilies, PolyKinds #-}\n\nmodule T7386 where\n\ndata Nat = Zero | Succ Nat\ndata family Sing (a :: k)\ndata instance Sing (a :: Nat) where\n   SZero :: Sing Zero\n   SSucc :: Sing n -> Sing (Succ n)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}\nmodule T8557 where\n\ndata family Sing (a :: k)\ndata instance Sing (a :: [k]) = SNil\n\nx :: Sing '[]\nx = SNil\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TupleN where\nimport Language.Haskell.TH\n\ntuple :: Int -> ExpQ\ntuple n = [|\\list -> $(tupE (exprs [|list|])) |]\n  where\n    exprs list = id [infixE (Just (list))\n                           (varE '(!!))\n                           (Just (litE $ integerL (toInteger num)))\n                      | num <- [0..(n - 1)]]", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nimport {-# SOURCE #-} B\n\na x = b x", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport A \n\nb x = x", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n  \nimport A\nimport B\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\nimport {-# SOURCE #-} B\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport A \n\nb x = x", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n  \nimport A\nimport B\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- #hide\nmodule Hidden where\nhidden :: Int -> Int\nhidden a = a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Test\n-- Copyright   :  (c) Simon Marlow 2002\n-- License     :  BSD-style\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- This module illustrates & tests most of the features of Haddock.\n-- Testing references from the description: 'T', 'f', 'g', 'Visible.visible'.\n--\n-----------------------------------------------------------------------------\n\n-- This is plain comment, ignored by Haddock.\n\nmodule Test (\n\n        -- Section headings are introduced with '-- *':\n        -- * Type declarations\n\n        -- Subsection headings are introduced with '-- **' and so on.\n        -- ** Data types\n        T(..), T2, T3(..), T4(..), T5(..), T6(..),\n        N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..),\n\n        -- ** Records\n        R(..), R1(..),\n\n        -- | test that we can export record selectors on their own:\n        p, q, u,\n\n        -- * Class declarations\n        C(a,b), D(..), E, F(..),\n\n        -- | Test that we can export a class method on its own:\n        a,\n\n        -- * Function types\n        f, g,\n\n        -- * Auxiliary stuff\n\n        -- $aux1\n\n        -- $aux2\n\n        -- $aux3\n\n        -- $aux4\n\n        -- $aux5\n\n        -- $aux6\n\n        -- $aux7\n\n        -- $aux8\n\n        -- $aux9\n\n        -- $aux10\n\n        -- $aux11\n\n        -- $aux12\n\n        -- | This is some inline documentation in the export list\n        --\n        -- > a code block using bird-tracks\n        -- > each line must begin with > (which isn't significant unless it\n        -- > is at the beginning of the line).\n\n        -- * A hidden module\n        module Hidden,\n\n        -- * A visible module\n        module Visible,\n\n        {-| nested-style doc comments -}\n\n        -- * Existential \\/ Universal types\n        Ex(..),\n\n        -- * Type signatures with argument docs\n        k, l, m, o,\n\n        -- * A section\n        -- and without an intervening comma:\n        -- ** A subsection\n\n{-|\n > a literal line\n\n $ a non /literal/ line $\n-}\n\n        f',\n   ) where\n\nimport Hidden\nimport Visible\n\n-- | This comment applies to the /following/ declaration\n-- and it continues until the next non-comment line\ndata T a b\n = A Int (Maybe Float) -- ^ This comment describes the 'A' constructor\n | -- | This comment describes the 'B' constructor\n   B (T a b, T Int Float) -- ^\n\n-- | An abstract data declaration\ndata T2 a b = T2 a b\n\n-- | A data declaration with no documentation annotations on the constructors\ndata T3 a b = A1 a | B1 b\n\n-- A data declaration with no documentation annotations at all\ndata T4 a b = A2 a | B2 b\n\n-- A data declaration documentation on the constructors only\ndata T5 a b\n  = A3 a -- ^ documents 'A3'\n  | B3 b -- ^ documents 'B3'\n\n-- | Testing alternative comment styles\ndata T6\n  -- | This is the doc for 'A4'\n  = A4\n  | B4\n  | -- ^ This is the doc for 'B4'\n\n    -- | This is the doc for 'C4'\n    C4\n\n-- | A newtype\nnewtype N1 a = N1 a\n\n-- | A newtype with a fieldname\nnewtype N2 a b = N2 {n :: a b}\n\n-- | A newtype with a fieldname, documentation on the field\nnewtype N3 a b = N3 {n3 :: a b -- ^ this is the 'n3' field\n                    }\n\n-- | An abstract newtype - we show this one as data rather than newtype because\n-- the difference isn\\'t visible to the programmer for an abstract type.\nnewtype N4 a b = N4 a\n\nnewtype N5 a b = N5 {n5 :: a b -- ^ no docs on the datatype or the constructor\n                    }\n\nnewtype N6 a b = N6 {n6 :: a b\n                    }\n                 -- ^ docs on the constructor only\n\n-- | docs on the newtype and the constructor\nnewtype N7 a b = N7 {n7 :: a b\n                    }\n                -- ^ The 'N7' constructor\n\n\nclass (D a) => C a  where\n   -- |this is a description of the 'a' method\n   a :: IO a\n   b :: [a]\n   -- ^ this is a description of the 'b' method\n   c :: a -- c is hidden in the export list\n\n-- ^ This comment applies to the /previous/ declaration (the 'C' class)\n\nclass D a where\n   d :: T a b\n   e :: (a,a)\n-- ^ This is a class declaration with no separate docs for the methods\n\ninstance D Int where\n  d = undefined\n  e = undefined\n\n-- instance with a qualified class name\ninstance Test.D Float where\n  d = undefined\n  e = undefined\n\nclass E a where\n  ee :: a\n-- ^ This is a class declaration with no methods (or no methods exported)\n\n-- This is a class declaration with no documentation at all\nclass F a where\n  ff :: a\n\n-- | This is the documentation for the 'R' record, which has four fields,\n-- 'p', 'q', 'r', and 's'.\ndata R =\n  -- | This is the 'C1' record constructor, with the following fields:\n  C1 { p :: Int -- ^ This comment applies to the 'p' field\n     , q :: forall a . a->a  -- ^ This comment applies to the 'q' field\n     , -- | This comment applies to both 'r' and 's'\n       r,s :: Int\n     }\n  | C2 { t :: T1 -> (T2 Int Int)-> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (),\n       u,v :: Int\n     }\n  -- ^ This is the 'C2' record constructor, also with some fields:\n\n-- | Testing different record commenting styles\ndata R1\n  -- | This is the 'C3' record constructor\n  = C3 {\n        -- | The 's1' record selector\n          s1 :: Int\n        -- | The 's2' record selector\n        , s2 :: Int\n        , s3 :: Int  -- NOTE: In the original examples/Test.hs in Haddock, there is an extra \",\" here.\n                     -- Since GHC doesn't allow that, I have removed it in this file.\n        -- ^ The 's3' record selector\n     }\n\n-- These section headers are only used when there is no export list to\n-- give the structure of the documentation:\n\n-- * This is a section header (level 1)\n-- ** This is a section header (level 2)\n-- *** This is a section header (level 3)\n\n{-|\nIn a comment string we can refer to identifiers in scope with\nsingle quotes like this: 'T', and we can refer to modules by\nusing double quotes: \"Foo\".  We can add emphasis /like this/.\n\n   * This is a bulleted list\n\n   - This is the next item (different kind of bullet)\n\n   (1) This is an ordered list\n\n   2. This is the next item (different kind of bullet)\n\n@\n     This is a block of code, which can include other markup: 'R'\n     formatting\n               is\n                 significant\n@\n\n> this is another block of code\n\nWe can also include URLs in documentation: <http://www.haskell.org/>.\n-}\n\nf :: C a => a -> Int\n\n-- | we can export foreign declarations too\nforeign import ccall \"header.h\" g :: Int -> IO CInt\n\n-- | this doc string has a parse error in it: \\'\nh :: Int\nh = 42\n\n\n-- $aux1 This is some documentation that is attached to a name ($aux1)\n-- rather than a source declaration.  The documentation may be\n-- referred to in the export list using its name.\n--\n-- @ code block in named doc @\n\n-- $aux2 This is some documentation that is attached to a name ($aux2)\n\n-- $aux3\n-- @ code block on its own in named doc @\n\n-- $aux4\n--\n-- @ code block on its own in named doc (after newline) @\n\n{- $aux5 a nested, named doc comment\n\n   with a paragraph,\n\n   @ and a code block @\n-}\n\n-- some tests for various arrangements of code blocks:\n\n{- $aux6\n>test\n>test1\n\n@ test2\n  test3\n@\n-}\n\n{- $aux7\n@\ntest1\ntest2\n@\n-}\n\n{- $aux8\n>test3\n>test4\n-}\n\n{- $aux9\n@\ntest1\ntest2\n@\n\n>test3\n>test4\n-}\n\n{- $aux10\n>test3\n>test4\n\n@\ntest1\ntest2\n@\n-}\n\n-- This one is currently wrong (Haddock 0.4).  The @...@ part is\n-- interpreted as part of the bird-tracked code block.\n{- $aux11\naux11:\n\n>test3\n>test4\n\n@\ntest1\ntest2\n@\n-}\n\n-- $aux12\n-- > foo\n--\n-- > bar\n--\n\n-- | A data-type using existential\\/universal types\ndata Ex a\n  = forall b . C b => Ex1 b\n  | forall b . Ex2 b\n  | forall b . C a => Ex3 b -- NOTE: I have added \"forall b\" here make GHC accept this file\n  | Ex4 (forall a . a -> a)\n\n-- | This is a function with documentation for each argument\nk :: T () ()      -- ^ This argument has type 'T'\n  -> (T2 Int Int) -- ^ This argument has type 'T2 Int Int'\n  -> (T3 Bool Bool -> T4 Float Float) -- ^ This argument has type @T3 Bool Bool -> T4 Float Float@\n  -> T5 () ()     -- ^ This argument has a very long description that should\n                  -- hopefully cause some wrapping to happen when it is finally\n                  -- rendered by Haddock in the generated HTML page.\n  -> IO ()        -- ^ This is the result type\n\n-- This function has arg docs but no docs for the function itself\nl :: (Int, Int, Float) -- ^ takes a triple\n  -> Int -- ^ returns an 'Int'\n\n-- | This function has some arg docs\nm :: R\n  -> N1 ()      -- ^ one of the arguments\n  -> IO Int     -- ^ and the return value\n\n-- | This function has some arg docs but not a return value doc\n\n-- can't use the original name ('n') with GHC\nnewn :: R               -- ^ one of the arguments, an 'R'\n     -> N1 ()           -- ^ one of the arguments\n     -> IO Int\nnewn = undefined\n\n\n-- | A foreign import with argument docs\nforeign import ccall unsafe \"header.h\"\n o :: Float  -- ^ The input float\n   -> IO Float  -- ^ The output float\n\n-- | We should be able to escape this: \\#\\#\\#\n\n-- p :: Int\n-- can't use the above original definition with GHC\nnewp :: Int\nnewp = undefined\n\n-- | a function with a prime can be referred to as 'f''\n-- but f' doesn't get link'd 'f\\''\nf' :: Int\n\n\n-- Add some definitions here so that this file can be compiled with GHC\n\ndata T1\nf = undefined\nf' = undefined\ntype CInt = Int\nk = undefined\nl = undefined\nm = undefined\n", "num_lines": 409}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Visible where\nvisible :: Int -> Int\nvisible a = a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{- | blabla -}\ndata Bla = Hej\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{- | blabla -}\nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n-- | blabla \nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n-- | blabla \u00f6qewjlaskjfdaskl\u00f6jfasl\u00f6kj\n-- aslfdjaskldaskldasjda\n-- xxxxxx\n-- end of the comment\nmain = undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "hej = undefined\n\n-- | 1l3i1j3 as\nmain = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-^ wealwwwwwwwwwwww\n\n\n-}\nmain = return ()\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{- |asd-}\nmain=undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{-| \nmain=undefined\n-}\nmain = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{-$ aslkdjasasd asdkjasdlaj {-weqw -}-}\nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{-| weoprjwer {- | qwoiejqwioe -}-}\nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n-- aslkdjasldkjasldkaj\n-- | awlkdajsads\n-- asdas\u00f6dlklas\n--qww\nmain=undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain=undefined\n\n-- | vkfja\nhej=main\n-- | ieasdkjahsdkjashd\nx = hej\n\n\n-- | eroiewuroieuwr\ny = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- ^ bla\nmain=undefined\n\n-- ^ vkfja\nhej=main\n-- ^ ieasdkjahsdkjashd\nx = hej\n\n\n-- ^ eroiewuroieuwr\ny = undefined\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | a header\nmodule HeaderTest where\n\n-- | bla bla\nx = 0\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | a header\nmodule HeaderTest where\n\n-- * A section\nx = 0\n\n-- ** A subsection\ny = 1\n\n-- *** A subsubsection\nmain = print x\n\n-- | bla bla\nz = 0\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- #hide, prune, ignore-exports\n\n-- |Module description\nmodule A where\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- #hide, prune, ignore-exports\nmodule A where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | module header bla bla \n\n-- #hide, prune, ignore-exports\nmodule A where\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n\n-- | bla bla\n\n{- | blabla -}\n\n) where\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n\n-- | bla bla\n\n{- | blabla -}\n\nx,\n\n-- ** qe\u00c3\u00b6qwke\u00c3\u00b6wqlkeq\u00c3\u00b6le\n\n-- | qweljqwelkqjwelqjkq\n\n) where\n\nx = True\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n\n-- | bla bla\n\n{- | blabla -}\n\nx,\n\n-- ** qe\u00c3\u00b6qwke\u00c3\u00b6wqlkeq\u00c3\u00b6le\n\n-- | qweljqwelkqjwelqjkq\n\ny,\n\n\n-- | dkashdakj\nz\n\n-- * asdjha\n\n) where\n\nx = True\ny = False\nz = True\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain = print (test::Int) \n  where\n    -- | kjfhaskd \n    test = 0\n    -- | xzczn\n    -- qwelkjqwelkqj\n    test2 = 1\n\n    -- | adlkjadajdldjad\n    test3 = 2\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule ShouldCompile where\n\ntest :: (Eq a) => [a] -- ^ doc1\n               -> [a] {-^ doc2 -}\n               -> [a] -- ^ doc3\ntest xs ys = xs\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ntest2 :: a -- ^ doc1 \n        -> b {-^ doc2 -} -> a -- ^ doc 3 \ntest2 x y = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ntest2 :: a -- ^ doc1 \n         -> a \ntest2 x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule ShouldCompile where\n\ntest :: (Eq a) => [a] -- ^ doc1\n               -> forall b . [b] {-^ doc2 -}\n               -> [a] -- ^ doc3\ntest xs ys = xs\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule ShouldCompile where\n\ntest :: [a] -- ^ doc1\n        -> forall b. (Ord b) => [b] {-^ doc2 -}\n        -> forall c. (Num c) => [c] -- ^ doc3\n        -> [a]\ntest xs ys zs = xs\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata a <--> b = Mk a b\n\ntest :: [a] -- ^ doc1 \n        -> a <--> b   \n        -> [a] -- ^ blabla\ntest xs ys = xs\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata A \n  -- | A comment that documents the first constructor\n  = A | B | C | D\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata A \n  -- | A comment that documents the first constructor\n  = A \n  -- | comment for B \n  | {-^ comment for A -} B \n  -- | comment for C  \n  | C \n  | D\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata A \n  = A \n  | {-| comment for B -} forall a. B a a \n  | forall a. Num a => C a {-^ comment for C -}\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata R a = R {\n    field1 :: a -- | comment for field2\n  , field2 :: a \n  , field3 :: a -- ^ comment for field3\n  , {-| comment for field4 -} field4 :: a\n}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- | dlkjasldkja\nf 0 = 1\n-- | falkajflksjfa\nf 1 = 2\n-- | slkdjasldkj\nf 3 = 6\n-- | asldfasl\u00c3\u00b6djas\n\n-- | blabla \n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Hi where\n\n-- | This is a GADT.\ndata Hi where\n    -- | This is a GADT constructor.\n    Hi :: () -> Hi\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Hi where\n\ndata Hi where\n    Hi :: () -- ^ This is a comment on the '()' field of 'Hi'\n       -> Int\n       -> String -- ^ This is a comment on the 'String' field of 'Hi'\n       -> Hi -- ^ This is a comment on the return type of 'Hi'\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ConstructorFields where\n\ndata Foo\n  = Bar Int String  -- ^ doc on `Bar` constructor\n\n  | Baz             -- ^ doc on the `Baz` constructor\n      Int           -- ^ doc on the `Int` field of `Baz`\n      String        -- ^ doc on the `String` field of `Baz`\n\n  | Int :+ String   -- ^ doc on the `:+` constructor\n\n  | Int             -- ^ doc on the `Int` field of the `:*` constructor\n      :*            -- ^ doc on the `:*` constructor\n    String          -- ^ doc on the `String` field of the `:*` constructor\n\n  | Boo { x :: () } -- ^ doc on the `Boo` record constructor\n\n  | Boa             -- ^ doc on the `Boa` record constructor\n      { y :: () }\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module UnamedConstructorFields where\n\ndata A = A\ndata B = B\ndata C = C\n\n-- Haddock on 'A' prevents the haddock on 'C' from being applied to 'MkFoo'\ndata Foo = MkFoo A -- ^ 'A' has a comment\n                 B -- This doesn't\n                 C -- ^ 'C' has a comment\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module UnamedConstructorStrictFields where\n-- See #15206\n\ndata A = A\ndata B = B\n\ndata Foo = MkFoo\n  {-# UNPACK #-} !A -- ^ Unpacked strict field\n                 B\n\ndata Bar =\n  {-# UNPACK #-} !A -- ^ Unpacked strict field\n    :%%\n                 B\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CommentsBeforeArguments where\n\ndata A = A\ndata B = B\n\nf1 :: {-| Comment before -}\n     () ->\n\n     ()\n     {-^ Comment after -} ->\n\n     ()\n     {-^ Result after -}\nf1 _ _ = ()\n\n\nf2 :: {-| Comment before -}\n     () ->\n\n     ()\n     {-^ Comment after -} ->\n\n     {-| Result after -}\n     ()\nf2 _ _ = ()\n\n\n\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo\n(\n  -- The reference to chunk2 should show up in the -ddump-parsed output.\n  -- $chunk1\n  -- $chunk2\n  foo,\n  -- $chunk3\n  bar\n)\nwhere\n\n{- $chunk1\nThis is chunk 1.\n-}\n\n{- $chunk2\nThis is chunk 2.\n-}\n\n{- $chunk3\nThis is chunk 3.\n-}\n\nfoo = 3\nbar = 7\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\nmodule T11768 where\n\ndata Foo = Foo\n  deriving Eq -- ^ Documenting a single type\n\ndata Bar = Bar\n  deriving ( Eq -- ^ Documenting one of multiple types\n           , Ord\n           )\n\n-- | Documenting a standalone deriving instance\nderiving instance Read Bar\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{- xc,zxcz -}\nmain = putStrLn \"hej\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-{--}-}\n\nmain=return()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "----------------------------------------------------------\nmain = undefined\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XNoImplicitPrelude #-}\n-----------------------------------------------------------------------------\n-- \n-- Module      :  Foreign\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A collection of data types, classes, and functions for interfacing\n-- with another programming language.\n--\n-----------------------------------------------------------------------------\n\nmodule Hej where\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{- | blabla -}\ndata Bla = Hej\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{- | blabla -}\nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n-- | blabla \nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n-- | blabla \u00f6qewjlaskjfdaskl\u00f6jfasl\u00f6kj\n-- aslfdjaskldaskldasjda\n-- xxxxxx\n-- end of the comment\nmain = undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "hej = undefined\n\n-- | 1l3i1j3 as\nmain = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-^ wealwwwwwwwwwwww\n\n\n-}\nmain = return ()\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompiler where\n\n{- |asd-}\nmain=undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{-| \nmain=undefined\n-}\nmain = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{-$ aslkdjasasd asdkjasdlaj {-weqw -}-}\nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n{-| weoprjwer {- | qwoiejqwioe -}-}\nmain = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n-- aslkdjasldkjasldkaj\n-- | awlkdajsads\n---asdas\u00f6dlklas\n--------------- qww\nmain=undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain=undefined\n\n-- | vkfja\nhej=main\n-- | ieasdkjahsdkjashd\nx = hej\n\n\n-- | eroiewuroieuwr\ny = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\n-- ^ bla\nmain=undefined\n\n-- ^ vkfja\nhej=main\n-- ^ ieasdkjahsdkjashd\nx = hej\n\n\n-- ^ eroiewuroieuwr\ny = undefined\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | a header\nmodule HeaderTest where\n\n-- | bla bla\nx = 0\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | a header\nmodule HeaderTest where\n\n-- * A section\nx = 0\n\n-- ** A subsection\ny = 1\n\n-- *** A subsubsection\nmain = print x\n\n-- | bla bla\nz = 0\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- #hide, prune, ignore-exports\n\n-- |Module description\nmodule A where\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- #hide, prune, ignore-exports\nmodule A where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | module header bla bla \n\n-- #hide, prune, ignore-exports\nmodule A where\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n\n-- | bla bla\n\n{- | blabla -}\n\n) where\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n\n-- | bla bla\n\n{- | blabla -}\n\nx,\n\n-- ** qe\u00c3\u00b6qwke\u00c3\u00b6wqlkeq\u00c3\u00b6le\n\n-- | qweljqwelkqjwelqjkq\n\n) where\n\nx = True\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (\n\n-- | bla bla\n\n{- | blabla -}\n\nx,\n\n-- ** qe\u00c3\u00b6qwke\u00c3\u00b6wqlkeq\u00c3\u00b6le\n\n-- | qweljqwelkqjwelqjkq\n\ny,\n\n\n-- | dkashdakj\nz\n\n-- * asdjha\n\n) where\n\nx = True\ny = False\nz = True\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain = print (test::Int) \n  where\n    -- | kjfhaskd \n    test = 0\n    -- | xzczn\n    -- qwelkjqwelkqj\n    test2 = 1\n\n    -- | adlkjadajdldjad\n    test3 = 2\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ntest2 :: a -- ^ doc1 \n        -> b {-^ doc2 -} -> a -- ^ doc 3 \ntest2 x y = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ntest2 :: a -- ^ doc1 \n        -> b {-^ doc2 -} -> a -- ^ doc 3 \ntest2 x y = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ntest2 :: a -- ^ doc1 \n         -> a \ntest2 x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule ShouldCompile where\n\ntest :: (Eq a) => [a] -- ^ doc1\n               -> forall b . [b] {-^ doc2 -}\n               -> [a] -- ^ doc3\ntest xs ys = xs\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule ShouldCompile where\n\n-- I bet this test is a mistake!  From the layout it \n-- looks as if 'test' takes three args, the latter two \n-- of higher rank.  But the parens around these args are\n-- missing, so it parses as\n--    test :: [a] \n--          -> forall a. Ord a \n--          => [b]\n--          -> forall c. Num c\n--          => [c]\n--          -> [a]\n--\n-- But maybe that what was intended; I'm not sure\n-- Anyway it should typecheck!\n\ntest :: [a] -- ^ doc1 \n        -> forall b. (Ord b) => [b] {-^ doc2 -} \n        -> forall c. (Num c) => [c] -- ^ doc3\n        -> [a]\ntest xs ys zs = xs\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata a <--> b = Mk a b\n\ntest :: [a] -- ^ doc1 \n        -> a <--> b   \n        -> [a] -- ^ doc3\ntest xs ys = xs\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata A \n  -- | A comment that documents the first constructor\n  = A | B | C | D\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata A \n  -- | A comment that documents the first constructor\n  = A \n  -- | comment for B \n  | {-^ comment for A -} B \n  -- | comment for C  \n  | C \n  | D\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata A \n  = A \n  | {-| comment for B -} forall a. B a a \n  | forall a. Num a => C a {-^ comment for C -}\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata R a = R {\n    field1 :: a -- | comment for field2\n  , field2 :: a \n  , field3 :: a -- ^ comment for field3\n  , {-| comment for field4 -} field4 :: a\n}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule Hi where\n\ndata Hi where\n    Hi :: () -- ^ This is a comment on the '()' field of 'Hi'\n       -> Int\n       -> String -- ^ This is a comment on the 'String' field of 'Hi'\n       -> Hi -- ^ This is a comment on the return type of 'Hi'\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ConstructorFields where\n\ndata Foo\n  = Bar Int String  -- ^ doc on `Bar` constructor\n\n  | Baz             -- ^ doc on the `Baz` constructor\n      Int           -- ^ doc on the `Int` field of `Baz`\n      String        -- ^ doc on the `String` field of `Baz`\n\n  | Int :+ String   -- ^ doc on the `:+` constructor\n\n  | Int             -- ^ doc on the `Int` field of the `:*` constructor\n      :*            -- ^ doc on the `:*` constructor\n    String          -- ^ doc on the `String` field of the `:*` constructor\n\n  | Boo { x :: () } -- ^ doc on the `Boo` record constructor\n\n  | Boa             -- ^ doc on the `Boa` record constructor\n      { y :: () }\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module UnamedConstructorFields where\n\ndata A = A\ndata B = B\ndata C = C\n\n-- Haddock on 'A' prevents the haddock on 'C' from being applied to 'MkFoo'\ndata Foo = MkFoo A -- ^ 'A' has a comment\n                 B -- This doesn't\n                 C -- ^ 'C' has a comment\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module UnamedConstructorStrictFields where\n-- See #15206\n\ndata A = A\ndata B = B\n\ndata Foo = MkFoo\n  {-# UNPACK #-} !A -- ^ Unpacked strict field\n                 B\n\ndata Bar =\n  {-# UNPACK #-} !A -- ^ Unpacked strict field\n    :%%\n                 B\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\npostInlineUnconditionally\n  = case Just \"Hey\" of\n        -- The point of examining occ_info here is that for *non-values*\n        -- that occur outside a lambda, the call-site inliner won't have\n        -- a chance (because it doesn't know that the thing\n        -- only occurs once).   The pre-inliner won't have gotten\n        -- it either, if the thing occurs in more than one branch\n        -- So the main target is things like\n        --      let x = f y in\n        --      case v of\n        --         True  -> case x of ...\n        --         False -> case x of ...\n        -- I'm not sure how important this is in practice\n      Just a    -- OneOcc => no work-duplication issue\n        -> True -- Small enough to dup\n                        -- ToDo: consider discount on smallEnoughToInline if int_cxt is true\n                        --\n                        -- NB: Do NOT inline arbitrarily big things, even if one_br is True\n                        -- Reason: doing so risks exponential behaviour.  We simplify a big\n                        --         expression, inline it, and simplify it again.  But if the\n                        --         very same thing happens in the big expression, we get\n                        --         exponential cost!\n                        -- PRINCIPLE: when we've already simplified an expression once,\n                        -- make sure that we only inline it if it's reasonably small.\n\n      _ -> False\n\n-- Here's an example that we don't handle well:\n--      let f = if b then Left (\\x.BIG) else Right (\\y.BIG)\n--      in \\y. ....case f of {...} ....\n-- Here f is used just once, and duplicating the case work is fine (exprIsCheap).\n-- But\n-- * We can't preInlineUnconditionally because that woud invalidate\n--   the occ info for b.\n-- * We can't postInlineUnconditionally because the RHS is big, and\n--   that risks exponential behaviour\n-- * We can't call-site inline, because the rhs is big\n-- Alas!\n\n  where\n    x = id\n\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{- xc,zxcz -}\nmain = putStrLn \"hej\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-{--}-}\n\nmain=return()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "----------------------------------------------------------\nmain = undefined\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XNoImplicitPrelude #-}\n-----------------------------------------------------------------------------\n-- \n-- Module      :  Foreign\n-- Copyright   :  (c) The FFI task force 2001\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n-- \n-- Maintainer  :  ffi@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- A collection of data types, classes, and functions for interfacing\n-- with another programming language.\n--\n-----------------------------------------------------------------------------\n\nmodule Hej where\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main=undefined\n-- | aksdjhaskdjhasdsakjhdajksda\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldFail where\n\n-- | aksdjhaskdjhasdsakjhdajksd\n\nmain=undefined\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldFail where\n\n-- aslkdjasldkjasldkaj\n-- | awlkdajsads\n-- asdas\u00f6dlklas\n---qww\n-----------------\nmain=undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- | awlkdajsads\nmain=undefined\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Constructors where\n\n\ndata Foo\n    = Bar\n    | Baz\n    | Quux Foo Int\n\nnewtype Norf = Norf (Foo, [Foo], Foo)\n\n\nbar, baz, quux :: Foo\nbar = Bar\nbaz = Baz\nquux = Quux quux 0\n\n\nunfoo :: Foo -> Int\nunfoo Bar = 0\nunfoo Baz = 0\nunfoo (Quux foo n) = 42 * n + unfoo foo\n\n\nunnorf :: Norf -> [Foo]\nunnorf (Norf (Bar, xs, Bar)) = xs\nunnorf (Norf (Baz, xs, Baz)) = reverse xs\nunnorf _ = undefined\n\n\nunnorf' :: Norf -> Int\nunnorf' x@(Norf (f1@(Quux _ n), _, f2@(Quux f3 _))) =\n    x' + n * unfoo f1 + aux f3\n  where\n    aux fx = unfoo f2 * unfoo fx * unfoo f3\n    x' = sum . map unfoo . unnorf $ x\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule CPP where\n\n#define SOMETHING1\n\nfoo :: String\nfoo = {-  \" single quotes are fine in block comments\n          {- nested block comments are fine -}\n       -} \"foo\"\n\n#define SOMETHING2\n\nbar :: String\nbar = \"block comment in a string is not a comment {- \"\n\n#define SOMETHING3\n\n-- \" single quotes are fine in line comments\n-- {- unclosed block comments are fine in line comments\n\n-- Multiline CPP is also fine\n#define FOO\\\n  1\n\nbaz :: String\nbaz = \"line comment in a string is not a comment --\"\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\ndata Foo = Bar { x :: Int, y :: Bool }\n\nfoo a = a{x=2}\n\nbar = Bar{ x = 1, y = False}\n\nfoobar = foo (id id bar)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -w #-}\n{-# OPTIONS -XMagicHash -XBangPatterns #-}\nmodule Grammar where\nimport qualified Data.Array as Happy_Data_Array\nimport qualified Data.Bits as Bits\nimport qualified GHC.Exts as Happy_GHC_Exts\nimport Control.Applicative(Applicative(..))\nimport Control.Monad (ap)\n\n-- The token type:\ndata Token = TokenLet\n           | TokenIn\n           | TokenInt Int\n           | TokenSym String\n           | TokenEq\n           | TokenPlus\n           | TokenMinus\n           | TokenTimes\n           | TokenDiv\n           | TokenLParen\n           | TokenRParen\n           | TokenLCurl\n           | TokenRCurl\n           | TokenLRect\n           | TokenRRect\n           deriving (Eq,Show)\n\n-- parser produced by Happy Version 1.19.8\n\nnewtype HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104 = HappyAbsSyn HappyAny\ntype HappyAny = Happy_GHC_Exts.Any\nhappyIn4 :: t4 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn4 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn4 #-}\nhappyOut4 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t4\nhappyOut4 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut4 #-}\nhappyIn5 :: t5 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn5 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn5 #-}\nhappyOut5 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t5\nhappyOut5 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut5 #-}\nhappyIn6 :: t6 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn6 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn6 #-}\nhappyOut6 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t6\nhappyOut6 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut6 #-}\nhappyIn7 :: t7 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn7 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn7 #-}\nhappyOut7 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t7\nhappyOut7 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut7 #-}\nhappyIn8 :: t8 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn8 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn8 #-}\nhappyOut8 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t8\nhappyOut8 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut8 #-}\nhappyIn9 :: t9 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn9 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn9 #-}\nhappyOut9 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t9\nhappyOut9 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut9 #-}\nhappyIn10 :: t10 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn10 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn10 #-}\nhappyOut10 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t10\nhappyOut10 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut10 #-}\nhappyIn11 :: t11 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn11 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn11 #-}\nhappyOut11 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t11\nhappyOut11 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut11 #-}\nhappyIn12 :: t12 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn12 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn12 #-}\nhappyOut12 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t12\nhappyOut12 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut12 #-}\nhappyIn13 :: t13 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn13 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn13 #-}\nhappyOut13 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t13\nhappyOut13 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut13 #-}\nhappyIn14 :: t14 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn14 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn14 #-}\nhappyOut14 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t14\nhappyOut14 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut14 #-}\nhappyIn15 :: t15 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn15 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn15 #-}\nhappyOut15 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t15\nhappyOut15 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut15 #-}\nhappyIn16 :: t16 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn16 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn16 #-}\nhappyOut16 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t16\nhappyOut16 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut16 #-}\nhappyIn17 :: t17 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn17 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn17 #-}\nhappyOut17 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t17\nhappyOut17 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut17 #-}\nhappyIn18 :: t18 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn18 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn18 #-}\nhappyOut18 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t18\nhappyOut18 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut18 #-}\nhappyIn19 :: t19 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn19 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn19 #-}\nhappyOut19 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t19\nhappyOut19 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut19 #-}\nhappyIn20 :: t20 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn20 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn20 #-}\nhappyOut20 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t20\nhappyOut20 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut20 #-}\nhappyIn21 :: t21 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn21 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn21 #-}\nhappyOut21 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t21\nhappyOut21 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut21 #-}\nhappyIn22 :: t22 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn22 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn22 #-}\nhappyOut22 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t22\nhappyOut22 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut22 #-}\nhappyIn23 :: t23 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn23 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn23 #-}\nhappyOut23 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t23\nhappyOut23 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut23 #-}\nhappyIn24 :: t24 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn24 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn24 #-}\nhappyOut24 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t24\nhappyOut24 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut24 #-}\nhappyIn25 :: t25 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn25 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn25 #-}\nhappyOut25 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t25\nhappyOut25 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut25 #-}\nhappyIn26 :: t26 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn26 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn26 #-}\nhappyOut26 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t26\nhappyOut26 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut26 #-}\nhappyIn27 :: t27 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn27 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn27 #-}\nhappyOut27 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t27\nhappyOut27 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut27 #-}\nhappyIn28 :: t28 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn28 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn28 #-}\nhappyOut28 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t28\nhappyOut28 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut28 #-}\nhappyIn29 :: t29 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn29 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn29 #-}\nhappyOut29 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t29\nhappyOut29 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut29 #-}\nhappyIn30 :: t30 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn30 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn30 #-}\nhappyOut30 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t30\nhappyOut30 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut30 #-}\nhappyIn31 :: t31 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn31 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn31 #-}\nhappyOut31 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t31\nhappyOut31 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut31 #-}\nhappyIn32 :: t32 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn32 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn32 #-}\nhappyOut32 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t32\nhappyOut32 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut32 #-}\nhappyIn33 :: t33 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn33 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn33 #-}\nhappyOut33 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t33\nhappyOut33 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut33 #-}\nhappyIn34 :: t34 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn34 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn34 #-}\nhappyOut34 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t34\nhappyOut34 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut34 #-}\nhappyIn35 :: t35 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn35 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn35 #-}\nhappyOut35 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t35\nhappyOut35 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut35 #-}\nhappyIn36 :: t36 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn36 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn36 #-}\nhappyOut36 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t36\nhappyOut36 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut36 #-}\nhappyIn37 :: t37 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn37 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn37 #-}\nhappyOut37 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t37\nhappyOut37 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut37 #-}\nhappyIn38 :: t38 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn38 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn38 #-}\nhappyOut38 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t38\nhappyOut38 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut38 #-}\nhappyIn39 :: t39 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn39 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn39 #-}\nhappyOut39 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t39\nhappyOut39 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut39 #-}\nhappyIn40 :: t40 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn40 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn40 #-}\nhappyOut40 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t40\nhappyOut40 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut40 #-}\nhappyIn41 :: t41 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn41 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn41 #-}\nhappyOut41 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t41\nhappyOut41 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut41 #-}\nhappyIn42 :: t42 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn42 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn42 #-}\nhappyOut42 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t42\nhappyOut42 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut42 #-}\nhappyIn43 :: t43 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn43 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn43 #-}\nhappyOut43 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t43\nhappyOut43 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut43 #-}\nhappyIn44 :: t44 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn44 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn44 #-}\nhappyOut44 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t44\nhappyOut44 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut44 #-}\nhappyIn45 :: t45 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn45 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn45 #-}\nhappyOut45 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t45\nhappyOut45 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut45 #-}\nhappyIn46 :: t46 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn46 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn46 #-}\nhappyOut46 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t46\nhappyOut46 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut46 #-}\nhappyIn47 :: t47 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn47 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn47 #-}\nhappyOut47 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t47\nhappyOut47 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut47 #-}\nhappyIn48 :: t48 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn48 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn48 #-}\nhappyOut48 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t48\nhappyOut48 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut48 #-}\nhappyIn49 :: t49 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn49 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn49 #-}\nhappyOut49 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t49\nhappyOut49 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut49 #-}\nhappyIn50 :: t50 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn50 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn50 #-}\nhappyOut50 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t50\nhappyOut50 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut50 #-}\nhappyIn51 :: t51 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn51 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn51 #-}\nhappyOut51 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t51\nhappyOut51 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut51 #-}\nhappyIn52 :: t52 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn52 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn52 #-}\nhappyOut52 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t52\nhappyOut52 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut52 #-}\nhappyIn53 :: t53 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn53 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn53 #-}\nhappyOut53 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t53\nhappyOut53 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut53 #-}\nhappyIn54 :: t54 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn54 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn54 #-}\nhappyOut54 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t54\nhappyOut54 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut54 #-}\nhappyIn55 :: t55 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn55 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn55 #-}\nhappyOut55 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t55\nhappyOut55 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut55 #-}\nhappyIn56 :: t56 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn56 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn56 #-}\nhappyOut56 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t56\nhappyOut56 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut56 #-}\nhappyIn57 :: t57 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn57 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn57 #-}\nhappyOut57 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t57\nhappyOut57 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut57 #-}\nhappyIn58 :: t58 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn58 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn58 #-}\nhappyOut58 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t58\nhappyOut58 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut58 #-}\nhappyIn59 :: t59 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn59 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn59 #-}\nhappyOut59 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t59\nhappyOut59 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut59 #-}\nhappyIn60 :: t60 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn60 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn60 #-}\nhappyOut60 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t60\nhappyOut60 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut60 #-}\nhappyIn61 :: t61 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn61 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn61 #-}\nhappyOut61 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t61\nhappyOut61 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut61 #-}\nhappyIn62 :: t62 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn62 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn62 #-}\nhappyOut62 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t62\nhappyOut62 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut62 #-}\nhappyIn63 :: t63 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn63 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn63 #-}\nhappyOut63 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t63\nhappyOut63 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut63 #-}\nhappyIn64 :: t64 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn64 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn64 #-}\nhappyOut64 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t64\nhappyOut64 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut64 #-}\nhappyIn65 :: t65 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn65 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn65 #-}\nhappyOut65 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t65\nhappyOut65 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut65 #-}\nhappyIn66 :: t66 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn66 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn66 #-}\nhappyOut66 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t66\nhappyOut66 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut66 #-}\nhappyIn67 :: t67 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn67 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn67 #-}\nhappyOut67 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t67\nhappyOut67 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut67 #-}\nhappyIn68 :: t68 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn68 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn68 #-}\nhappyOut68 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t68\nhappyOut68 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut68 #-}\nhappyIn69 :: t69 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn69 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn69 #-}\nhappyOut69 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t69\nhappyOut69 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut69 #-}\nhappyIn70 :: t70 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn70 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn70 #-}\nhappyOut70 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t70\nhappyOut70 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut70 #-}\nhappyIn71 :: t71 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn71 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn71 #-}\nhappyOut71 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t71\nhappyOut71 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut71 #-}\nhappyIn72 :: t72 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn72 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn72 #-}\nhappyOut72 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t72\nhappyOut72 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut72 #-}\nhappyIn73 :: t73 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn73 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn73 #-}\nhappyOut73 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t73\nhappyOut73 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut73 #-}\nhappyIn74 :: t74 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn74 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn74 #-}\nhappyOut74 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t74\nhappyOut74 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut74 #-}\nhappyIn75 :: t75 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn75 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn75 #-}\nhappyOut75 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t75\nhappyOut75 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut75 #-}\nhappyIn76 :: t76 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn76 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn76 #-}\nhappyOut76 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t76\nhappyOut76 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut76 #-}\nhappyIn77 :: t77 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn77 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn77 #-}\nhappyOut77 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t77\nhappyOut77 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut77 #-}\nhappyIn78 :: t78 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn78 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn78 #-}\nhappyOut78 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t78\nhappyOut78 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut78 #-}\nhappyIn79 :: t79 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn79 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn79 #-}\nhappyOut79 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t79\nhappyOut79 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut79 #-}\nhappyIn80 :: t80 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn80 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn80 #-}\nhappyOut80 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t80\nhappyOut80 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut80 #-}\nhappyIn81 :: t81 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn81 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn81 #-}\nhappyOut81 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t81\nhappyOut81 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut81 #-}\nhappyIn82 :: t82 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn82 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn82 #-}\nhappyOut82 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t82\nhappyOut82 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut82 #-}\nhappyIn83 :: t83 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn83 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn83 #-}\nhappyOut83 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t83\nhappyOut83 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut83 #-}\nhappyIn84 :: t84 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn84 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn84 #-}\nhappyOut84 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t84\nhappyOut84 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut84 #-}\nhappyIn85 :: t85 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn85 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn85 #-}\nhappyOut85 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t85\nhappyOut85 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut85 #-}\nhappyIn86 :: t86 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn86 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn86 #-}\nhappyOut86 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t86\nhappyOut86 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut86 #-}\nhappyIn87 :: t87 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn87 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn87 #-}\nhappyOut87 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t87\nhappyOut87 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut87 #-}\nhappyIn88 :: t88 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn88 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn88 #-}\nhappyOut88 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t88\nhappyOut88 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut88 #-}\nhappyIn89 :: t89 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn89 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn89 #-}\nhappyOut89 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t89\nhappyOut89 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut89 #-}\nhappyIn90 :: t90 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn90 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn90 #-}\nhappyOut90 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t90\nhappyOut90 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut90 #-}\nhappyIn91 :: t91 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn91 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn91 #-}\nhappyOut91 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t91\nhappyOut91 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut91 #-}\nhappyIn92 :: t92 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn92 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn92 #-}\nhappyOut92 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t92\nhappyOut92 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut92 #-}\nhappyIn93 :: t93 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn93 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn93 #-}\nhappyOut93 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t93\nhappyOut93 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut93 #-}\nhappyIn94 :: t94 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn94 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn94 #-}\nhappyOut94 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t94\nhappyOut94 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut94 #-}\nhappyIn95 :: t95 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn95 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn95 #-}\nhappyOut95 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t95\nhappyOut95 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut95 #-}\nhappyIn96 :: t96 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn96 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn96 #-}\nhappyOut96 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t96\nhappyOut96 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut96 #-}\nhappyIn97 :: t97 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn97 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn97 #-}\nhappyOut97 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t97\nhappyOut97 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut97 #-}\nhappyIn98 :: t98 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn98 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn98 #-}\nhappyOut98 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t98\nhappyOut98 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut98 #-}\nhappyIn99 :: t99 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn99 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn99 #-}\nhappyOut99 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t99\nhappyOut99 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut99 #-}\nhappyIn100 :: t100 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn100 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn100 #-}\nhappyOut100 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t100\nhappyOut100 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut100 #-}\nhappyIn101 :: t101 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn101 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn101 #-}\nhappyOut101 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t101\nhappyOut101 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut101 #-}\nhappyIn102 :: t102 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn102 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn102 #-}\nhappyOut102 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t102\nhappyOut102 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut102 #-}\nhappyIn103 :: t103 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn103 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn103 #-}\nhappyOut103 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t103\nhappyOut103 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut103 #-}\nhappyIn104 :: t104 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn104 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn104 #-}\nhappyOut104 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t104\nhappyOut104 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut104 #-}\nhappyInTok :: (Token) -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyInTok x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyInTok #-}\nhappyOutTok :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> (Token)\nhappyOutTok x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOutTok #-}\n\n\nhappyExpList :: HappyAddr\nhappyExpList = HappyA# \"\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x08\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe4\\x41\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x02\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe4\\x11\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x02\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe4\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x80\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x80\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe2\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x3a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x6a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\n{-# NOINLINE happyExpListPerState #-}\nhappyExpListPerState st =\n    token_strs_expected\n  where token_strs = [\"error\",\"%dummy\",\"%start_parseCalc\",\"Exp\",\"Rule0\",\"Rule1\",\"Rule2\",\"Rule3\",\"Rule4\",\"Rule5\",\"Rule6\",\"Rule7\",\"Rule8\",\"Rule9\",\"Rule10\",\"Rule11\",\"Rule12\",\"Rule13\",\"Rule14\",\"Rule15\",\"Rule16\",\"Rule17\",\"Rule18\",\"Rule19\",\"Rule20\",\"Rule21\",\"Rule22\",\"Rule23\",\"Rule24\",\"Rule25\",\"Rule26\",\"Rule27\",\"Rule28\",\"Rule29\",\"Rule30\",\"Rule31\",\"Rule32\",\"Rule33\",\"Rule34\",\"Rule35\",\"Rule36\",\"Rule37\",\"Rule38\",\"Rule39\",\"Rule40\",\"Rule41\",\"Rule42\",\"Rule43\",\"Rule44\",\"Rule45\",\"Rule46\",\"Rule47\",\"Rule48\",\"Rule49\",\"Rule50\",\"Rule51\",\"Rule52\",\"Rule53\",\"Rule54\",\"Rule55\",\"Rule56\",\"Rule57\",\"Rule58\",\"Rule59\",\"Rule60\",\"Rule61\",\"Rule62\",\"Rule63\",\"Rule64\",\"Rule65\",\"Rule66\",\"Rule67\",\"Rule68\",\"Rule69\",\"Rule70\",\"Rule71\",\"Rule72\",\"Rule73\",\"Rule74\",\"Rule75\",\"Rule76\",\"Rule77\",\"Rule78\",\"Rule79\",\"Rule80\",\"Rule81\",\"Rule82\",\"Rule83\",\"Rule84\",\"Rule85\",\"Rule86\",\"Rule87\",\"Rule88\",\"Rule89\",\"Rule90\",\"Rule91\",\"Rule92\",\"Rule93\",\"Rule94\",\"Rule95\",\"Rule96\",\"Rule97\",\"Rule98\",\"Rule99\",\"let\",\"in\",\"int\",\"var\",\"'='\",\"'+'\",\"'-'\",\"'*'\",\"'/'\",\"'('\",\"')'\",\"'{'\",\"'}'\",\"'['\",\"']'\",\"%eof\"]\n        bit_start = st * 120\n        bit_end = (st + 1) * 120\n        read_bit = readArrayBit happyExpList\n        bits = map read_bit [bit_start..bit_end - 1]\n        bits_indexed = zip bits [0..119]\n        token_strs_expected = concatMap f bits_indexed\n        f (False, _) = []\n        f (True, nr) = [token_strs !! nr]\n\nhappyActOffsets :: HappyAddr\nhappyActOffsets = HappyA# \"\\x6d\\x06\\x51\\x06\\x59\\x06\\xd5\\x06\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x6d\\x06\\x6d\\x06\\x79\\x06\\x85\\x06\\x9b\\x06\\x5a\\x07\\xcd\\x06\\x5c\\x07\\x21\\x07\\x00\\x00\\x91\\x06\\x91\\x06\\x91\\x06\\x91\\x06\\x63\\x06\\x91\\x06\\x00\\x00\\x00\\x00\\xbf\\x06\\xbf\\x06\\x20\\x07\\x00\\x00\\x91\\x06\\x91\\x06\\xcb\\x06\\x00\\x00\\x91\\x06\\x91\\x06\\x52\\x06\\x00\\x00\\x55\\x06\\x00\\x00\\x49\\x07\\x61\\x07\\xd4\\x06\\x00\\x00\\x55\\x07\\x65\\x07\\x2a\\x07\\x00\\x00\\x51\\x07\\x91\\x06\\x2b\\x07\\x00\\x00\\x5f\\x06\\xd6\\x06\\xdc\\x06\\x00\\x00\\x50\\x06\\x56\\x06\\x58\\x06\\x00\\x00\\x67\\x06\\x00\\x00\\x6f\\x06\\x00\\x00\\x70\\x06\\x00\\x00\\xdd\\x06\\x00\\x00\\xdf\\x06\\x00\\x00\\xe1\\x06\\x00\\x00\\x2c\\x07\\x00\\x00\\x69\\x07\\x2d\\x07\\x00\\x00\\xe3\\x06\\x00\\x00\\xe4\\x06\\x00\\x00\\xe5\\x06\\x00\\x00\\x72\\x06\\x00\\x00\\x75\\x06\\x00\\x00\\x7f\\x06\\x00\\x00\\x87\\x06\\x00\\x00\\x88\\x06\\x00\\x00\\x8a\\x06\\x00\\x00\\xe8\\x06\\x00\\x00\\xea\\x06\\x00\\x00\\xec\\x06\\x00\\x00\\x2e\\x07\\x00\\x00\\x2f\\x07\\x00\\x00\\xf0\\x06\\x00\\x00\\xf1\\x06\\x00\\x00\\xf3\\x06\\x00\\x00\\x8d\\x06\\x00\\x00\\x97\\x06\\x00\\x00\\x9d\\x06\\x00\\x00\\xa2\\x06\\x00\\x00\\xa4\\x06\\x00\\x00\\xa5\\x06\\x00\\x00\\xf5\\x06\\x00\\x00\\xf7\\x06\\x00\\x00\\xf8\\x06\\x00\\x00\\x30\\x07\\x00\\x00\\x31\\x07\\x00\\x00\\xf9\\x06\\x00\\x00\\xfc\\x06\\x00\\x00\\xfe\\x06\\x00\\x00\\xa6\\x06\\x00\\x00\\xa8\\x06\\x00\\x00\\xaa\\x06\\x00\\x00\\xab\\x06\\x00\\x00\\xac\\x06\\x00\\x00\\xad\\x06\\x00\\x00\\x00\\x07\\x00\\x00\\x04\\x07\\x00\\x00\\x05\\x07\\x00\\x00\\x3a\\x07\\x00\\x00\\x3b\\x07\\x00\\x00\\x07\\x07\\x00\\x00\\x09\\x07\\x00\\x00\\x0b\\x07\\x00\\x00\\xaf\\x06\\x00\\x00\\xb3\\x06\\x00\\x00\\xb5\\x06\\x00\\x00\\xba\\x06\\x00\\x00\\x47\\x06\\x00\\x00\\x60\\x06\\x00\\x00\\x0c\\x07\\x00\\x00\\x11\\x07\\x00\\x00\\x13\\x07\\x00\\x00\\x3c\\x07\\x00\\x00\\x3d\\x07\\x00\\x00\\x00\\x00\\x00\\x00\\x0d\\x07\\x00\\x00\\x00\\x00\\x00\\x00\\xbc\\x06\\x00\\x00\\xbd\\x06\\x00\\x00\\x10\\x07\\x00\\x00\\x3e\\x07\\x00\\x00\\x3f\\x07\\x00\\x00\\x12\\x07\\x00\\x00\\xbe\\x06\\x00\\x00\\xc0\\x06\\x00\\x00\\x14\\x07\\x00\\x00\\x40\\x07\\x00\\x00\\x41\\x07\\x00\\x00\\x18\\x07\\x00\\x00\\xc2\\x06\\x00\\x00\\xc3\\x06\\x00\\x00\\x19\\x07\\x00\\x00\\x4a\\x07\\x00\\x00\\x4b\\x07\\x00\\x00\\x15\\x07\\x00\\x00\\xbb\\x06\\x00\\x00\\x00\\x00\\x00\\x00\\x57\\x07\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyGotoOffsets :: HappyAddr\nhappyGotoOffsets = HappyA# \"\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x66\\x00\\xcb\\x00\\x30\\x01\\x95\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xfa\\x01\\x5f\\x02\\xc4\\x02\\x29\\x03\\x00\\x00\\x8e\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xf3\\x03\\x58\\x04\\x00\\x00\\x00\\x00\\xbd\\x04\\x22\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x87\\x05\\x00\\x00\\x00\\x00\\xec\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\xec\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int#\nhappyAdjustOffset off = off\n\nhappyDefActions :: HappyAddr\nhappyDefActions = HappyA# \"\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xf5\\xff\\xf4\\xff\\xf3\\xff\\xf2\\xff\\xf1\\xff\\xf0\\xff\\xef\\xff\\xee\\xff\\xed\\xff\\xec\\xff\\xeb\\xff\\xea\\xff\\xe9\\xff\\xe8\\xff\\xe7\\xff\\xe6\\xff\\xe5\\xff\\xe4\\xff\\xe3\\xff\\xe2\\xff\\xe1\\xff\\xe0\\xff\\xdf\\xff\\xde\\xff\\xdd\\xff\\xdc\\xff\\xdb\\xff\\xda\\xff\\xd9\\xff\\xd8\\xff\\xd7\\xff\\xd6\\xff\\xd5\\xff\\xd4\\xff\\xd3\\xff\\xd2\\xff\\xd1\\xff\\xd0\\xff\\xcf\\xff\\xce\\xff\\xcd\\xff\\xcc\\xff\\xcb\\xff\\xca\\xff\\xc9\\xff\\xc8\\xff\\xc7\\xff\\xc6\\xff\\xc5\\xff\\xc4\\xff\\xc3\\xff\\xc2\\xff\\xc1\\xff\\xc0\\xff\\xbf\\xff\\xbe\\xff\\xbd\\xff\\xbc\\xff\\xbb\\xff\\xba\\xff\\xb9\\xff\\xb8\\xff\\xb7\\xff\\xb6\\xff\\xb5\\xff\\xb4\\xff\\xb3\\xff\\xb2\\xff\\xb1\\xff\\xb0\\xff\\xaf\\xff\\xae\\xff\\xad\\xff\\xac\\xff\\xab\\xff\\xaa\\xff\\xa9\\xff\\xa8\\xff\\xa7\\xff\\xa6\\xff\\xa5\\xff\\xa4\\xff\\xa3\\xff\\xa2\\xff\\xa1\\xff\\xa0\\xff\\x9f\\xff\\x9e\\xff\\x9d\\xff\\x9c\\xff\\x9b\\xff\\x9a\\xff\\x99\\xff\\x98\\xff\\x97\\xff\\x96\\xff\\x95\\xff\\x94\\xff\\x93\\xff\\x92\\xff\\xf7\\xff\\xf6\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xf6\\xff\\x00\\x00\\xf6\\xff\\x00\\x00\\xf8\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xfa\\xff\\xfb\\xff\\xfc\\xff\\xfd\\xff\\x00\\x00\\xf9\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x91\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x69\\xff\\x00\\x00\\x68\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x90\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x7d\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x7c\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x8f\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x67\\xff\\x00\\x00\\x66\\xff\\x00\\x00\\x55\\xff\\xf7\\xff\\x41\\xff\\x00\\x00\\x8e\\xff\\x00\\x00\\x4b\\xff\\xf7\\xff\\x37\\xff\\x00\\x00\\x7b\\xff\\xfe\\xff\\x00\\x00\\x7a\\xff\\x00\\x00\\x36\\xff\\x00\\x00\\x4a\\xff\\x00\\x00\\x8d\\xff\\x00\\x00\\x40\\xff\\x00\\x00\\x54\\xff\\x00\\x00\\x65\\xff\\x00\\x00\\x64\\xff\\x00\\x00\\x53\\xff\\x00\\x00\\x3f\\xff\\x00\\x00\\x8c\\xff\\x00\\x00\\x49\\xff\\x00\\x00\\x35\\xff\\x00\\x00\\x79\\xff\\x00\\x00\\x78\\xff\\x00\\x00\\x34\\xff\\x00\\x00\\x48\\xff\\x00\\x00\\x8b\\xff\\x00\\x00\\x3e\\xff\\x00\\x00\\x52\\xff\\x00\\x00\\x63\\xff\\x00\\x00\\x62\\xff\\x00\\x00\\x51\\xff\\x00\\x00\\x3d\\xff\\x00\\x00\\x8a\\xff\\x00\\x00\\x47\\xff\\x00\\x00\\x33\\xff\\x00\\x00\\x77\\xff\\x00\\x00\\x76\\xff\\x00\\x00\\x32\\xff\\x00\\x00\\x46\\xff\\x00\\x00\\x89\\xff\\x00\\x00\\x3c\\xff\\x00\\x00\\x50\\xff\\x00\\x00\\x61\\xff\\x00\\x00\\x60\\xff\\x00\\x00\\x4f\\xff\\x00\\x00\\x3b\\xff\\x00\\x00\\x88\\xff\\x00\\x00\\x45\\xff\\x00\\x00\\x31\\xff\\x00\\x00\\x75\\xff\\x00\\x00\\x74\\xff\\x00\\x00\\x30\\xff\\x00\\x00\\x44\\xff\\x00\\x00\\x87\\xff\\x00\\x00\\x3a\\xff\\x00\\x00\\x4e\\xff\\x00\\x00\\x5f\\xff\\x00\\x00\\x5e\\xff\\x00\\x00\\x4d\\xff\\x00\\x00\\x39\\xff\\x00\\x00\\x86\\xff\\x00\\x00\\x43\\xff\\x00\\x00\\x2f\\xff\\x00\\x00\\x73\\xff\\x00\\x00\\x72\\xff\\x2e\\xff\\x42\\xff\\x00\\x00\\x85\\xff\\x38\\xff\\x4c\\xff\\x00\\x00\\x5d\\xff\\x00\\x00\\x5c\\xff\\x00\\x00\\x84\\xff\\x00\\x00\\x71\\xff\\x00\\x00\\x70\\xff\\x00\\x00\\x83\\xff\\x00\\x00\\x5b\\xff\\x00\\x00\\x5a\\xff\\x00\\x00\\x82\\xff\\x00\\x00\\x6f\\xff\\x00\\x00\\x6e\\xff\\x00\\x00\\x81\\xff\\x00\\x00\\x59\\xff\\x00\\x00\\x58\\xff\\x00\\x00\\x80\\xff\\x00\\x00\\x6d\\xff\\x00\\x00\\x6c\\xff\\x00\\x00\\x7f\\xff\\x00\\x00\\x57\\xff\\x56\\xff\\x7e\\xff\\x00\\x00\\x6b\\xff\\x6a\\xff\"#\n\nhappyCheck :: HappyAddr\nhappyCheck = HappyA# \"\\xff\\xff\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x01\\x00\\x01\\x00\\x03\\x00\\x04\\x00\\x03\\x00\\x0f\\x00\\x07\\x00\\x03\\x00\\x03\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x04\\x00\\x0e\\x00\\x0f\\x00\\x01\\x00\\x0f\\x00\\x03\\x00\\x04\\x00\\x0f\\x00\\x0f\\x00\\x07\\x00\\x0f\\x00\\x05\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x01\\x00\\x0f\\x00\\x03\\x00\\x04\\x00\\x03\\x00\\x03\\x00\\x07\\x00\\x03\\x00\\x0f\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x01\\x00\\x0e\\x00\\x03\\x00\\x04\\x00\\x0f\\x00\\x0f\\x00\\x07\\x00\\x0f\\x00\\x03\\x00\\x0a\\x00\\x0f\\x00\\x0c\\x00\\x01\\x00\\x0e\\x00\\x03\\x00\\x04\\x00\\x03\\x00\\x03\\x00\\x07\\x00\\x03\\x00\\x0f\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x01\\x00\\x0e\\x00\\x03\\x00\\x04\\x00\\x0f\\x00\\x0f\\x00\\x07\\x00\\x0f\\x00\\x03\\x00\\x0a\\x00\\x0f\\x00\\x0c\\x00\\x03\\x00\\x0e\\x00\\x03\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x08\\x00\\x09\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x0f\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x10\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0b\\x00\\x0b\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x03\\x00\\x03\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x02\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x05\\x00\\x0b\\x00\\x05\\x00\\x0b\\x00\\xff\\xff\\x0a\\x00\\xff\\xff\\x0a\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\"#\n\nhappyTable :: HappyAddr\nhappyTable = HappyA# \"\\x00\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x73\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x72\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x70\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x6e\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7d\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7c\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7b\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7a\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x92\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8f\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8e\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8b\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8a\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\xac\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7b\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x03\\x00\\x03\\x00\\xa3\\x00\\x6a\\x00\\x89\\x00\\x25\\x01\\x6b\\x00\\x9d\\x00\\xa1\\x00\\x6c\\x00\\x9f\\x00\\x6d\\x00\\x79\\x00\\x6e\\x00\\xa4\\x00\\x03\\x00\\x8a\\x00\\xa9\\x00\\x6a\\x00\\x9e\\x00\\xa2\\x00\\x6b\\x00\\xa0\\x00\\x7a\\x00\\x6c\\x00\\xba\\x00\\x6d\\x00\\xaa\\x00\\x6e\\x00\\x03\\x00\\x24\\x01\\x69\\x00\\x6a\\x00\\xb8\\x00\\xb6\\x00\\x6b\\x00\\xc0\\x00\\xbb\\x00\\x6c\\x00\\xbe\\x00\\x6d\\x00\\x03\\x00\\x6e\\x00\\x69\\x00\\x72\\x00\\xb9\\x00\\xb7\\x00\\x6b\\x00\\xc1\\x00\\xbc\\x00\\x6c\\x00\\xbf\\x00\\x6d\\x00\\x03\\x00\\x6e\\x00\\x69\\x00\\x70\\x00\\xd6\\x00\\xd4\\x00\\x6b\\x00\\xd2\\x00\\xbd\\x00\\x6c\\x00\\xdc\\x00\\x6d\\x00\\x03\\x00\\x6e\\x00\\x69\\x00\\x6a\\x00\\xd7\\x00\\xd5\\x00\\x6b\\x00\\xd3\\x00\\xda\\x00\\x6c\\x00\\xdd\\x00\\x6d\\x00\\x87\\x00\\x6e\\x00\\xd8\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\xf2\\x00\\xdb\\x00\\xf0\\x00\\xee\\x00\\xf8\\x00\\x88\\x00\\xf6\\x00\\xd9\\x00\\xf4\\x00\\x0e\\x01\\x0c\\x01\\x0a\\x01\\xf3\\x00\\x14\\x01\\xf1\\x00\\xef\\x00\\xf9\\x00\\x12\\x01\\xf7\\x00\\x10\\x01\\xf5\\x00\\x0f\\x01\\x0d\\x01\\x0b\\x01\\x26\\x01\\x15\\x01\\x28\\x01\\x32\\x01\\x34\\x01\\x13\\x01\\x3e\\x01\\x11\\x01\\x40\\x01\\x4a\\x01\\x77\\x00\\x78\\x00\\x27\\x01\\x4c\\x01\\x29\\x01\\x33\\x01\\x35\\x01\\x8d\\x00\\x3f\\x01\\x83\\x00\\x41\\x01\\x4b\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x99\\x00\\x8e\\x00\\xa7\\x00\\x84\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\xa5\\x00\\xb4\\x00\\x9a\\x00\\xb2\\x00\\xa8\\x00\\xb0\\x00\\xff\\xff\\xc6\\x00\\xc4\\x00\\xc2\\x00\\xa6\\x00\\xb5\\x00\\xd0\\x00\\xb3\\x00\\xce\\x00\\xb1\\x00\\xcc\\x00\\xc7\\x00\\xc5\\x00\\xc3\\x00\\xe2\\x00\\xe0\\x00\\xd1\\x00\\xde\\x00\\xcf\\x00\\xec\\x00\\xcd\\x00\\xea\\x00\\xe8\\x00\\xfe\\x00\\xe3\\x00\\xe1\\x00\\xfc\\x00\\xdf\\x00\\xfa\\x00\\xed\\x00\\x08\\x01\\xeb\\x00\\xe9\\x00\\xff\\x00\\x06\\x01\\x04\\x01\\xfd\\x00\\x1a\\x01\\xfb\\x00\\x18\\x01\\x09\\x01\\x16\\x01\\x22\\x01\\x2a\\x01\\x07\\x01\\x05\\x01\\x30\\x01\\x1b\\x01\\x36\\x01\\x19\\x01\\x3c\\x01\\x17\\x01\\x23\\x01\\x2b\\x01\\x42\\x01\\x48\\x01\\x31\\x01\\x21\\x01\\x37\\x01\\x20\\x01\\x3d\\x01\\x4d\\x01\\x91\\x00\\x7f\\x00\\x43\\x01\\x49\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x92\\x00\\x80\\x00\\x95\\x00\\xab\\x00\\xae\\x00\\xc8\\x00\\xca\\x00\\xe4\\x00\\xe6\\x00\\x00\\x01\\x96\\x00\\xac\\x00\\xaf\\x00\\xc9\\x00\\xcb\\x00\\xe5\\x00\\xe7\\x00\\x01\\x01\\x02\\x01\\x1c\\x01\\x1e\\x01\\x2c\\x01\\x2e\\x01\\x38\\x01\\x3a\\x01\\x44\\x01\\x03\\x01\\x1d\\x01\\x1f\\x01\\x2d\\x01\\x2f\\x01\\x39\\x01\\x3b\\x01\\x45\\x01\\x46\\x01\\x4e\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x94\\x00\\x9c\\x00\\x47\\x01\\x4f\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x85\\x00\\x98\\x00\\x81\\x00\\x50\\x01\\x00\\x00\\x86\\x00\\x00\\x00\\x82\\x00\\x75\\x00\\x76\\x00\\x9b\\x00\\x78\\x00\\x75\\x00\\x76\\x00\\x97\\x00\\x78\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyReduceArr = Happy_Data_Array.array (1, 209) [\n        (1 , happyReduce_1),\n        (2 , happyReduce_2),\n        (3 , happyReduce_3),\n        (4 , happyReduce_4),\n        (5 , happyReduce_5),\n        (6 , happyReduce_6),\n        (7 , happyReduce_7),\n        (8 , happyReduce_8),\n        (9 , happyReduce_9),\n        (10 , happyReduce_10),\n        (11 , happyReduce_11),\n        (12 , happyReduce_12),\n        (13 , happyReduce_13),\n        (14 , happyReduce_14),\n        (15 , happyReduce_15),\n        (16 , happyReduce_16),\n        (17 , happyReduce_17),\n        (18 , happyReduce_18),\n        (19 , happyReduce_19),\n        (20 , happyReduce_20),\n        (21 , happyReduce_21),\n        (22 , happyReduce_22),\n        (23 , happyReduce_23),\n        (24 , happyReduce_24),\n        (25 , happyReduce_25),\n        (26 , happyReduce_26),\n        (27 , happyReduce_27),\n        (28 , happyReduce_28),\n        (29 , happyReduce_29),\n        (30 , happyReduce_30),\n        (31 , happyReduce_31),\n        (32 , happyReduce_32),\n        (33 , happyReduce_33),\n        (34 , happyReduce_34),\n        (35 , happyReduce_35),\n        (36 , happyReduce_36),\n        (37 , happyReduce_37),\n        (38 , happyReduce_38),\n        (39 , happyReduce_39),\n        (40 , happyReduce_40),\n        (41 , happyReduce_41),\n        (42 , happyReduce_42),\n        (43 , happyReduce_43),\n        (44 , happyReduce_44),\n        (45 , happyReduce_45),\n        (46 , happyReduce_46),\n        (47 , happyReduce_47),\n        (48 , happyReduce_48),\n        (49 , happyReduce_49),\n        (50 , happyReduce_50),\n        (51 , happyReduce_51),\n        (52 , happyReduce_52),\n        (53 , happyReduce_53),\n        (54 , happyReduce_54),\n        (55 , happyReduce_55),\n        (56 , happyReduce_56),\n        (57 , happyReduce_57),\n        (58 , happyReduce_58),\n        (59 , happyReduce_59),\n        (60 , happyReduce_60),\n        (61 , happyReduce_61),\n        (62 , happyReduce_62),\n        (63 , happyReduce_63),\n        (64 , happyReduce_64),\n        (65 , happyReduce_65),\n        (66 , happyReduce_66),\n        (67 , happyReduce_67),\n        (68 , happyReduce_68),\n        (69 , happyReduce_69),\n        (70 , happyReduce_70),\n        (71 , happyReduce_71),\n        (72 , happyReduce_72),\n        (73 , happyReduce_73),\n        (74 , happyReduce_74),\n        (75 , happyReduce_75),\n        (76 , happyReduce_76),\n        (77 , happyReduce_77),\n        (78 , happyReduce_78),\n        (79 , happyReduce_79),\n        (80 , happyReduce_80),\n        (81 , happyReduce_81),\n        (82 , happyReduce_82),\n        (83 , happyReduce_83),\n        (84 , happyReduce_84),\n        (85 , happyReduce_85),\n        (86 , happyReduce_86),\n        (87 , happyReduce_87),\n        (88 , happyReduce_88),\n        (89 , happyReduce_89),\n        (90 , happyReduce_90),\n        (91 , happyReduce_91),\n        (92 , happyReduce_92),\n        (93 , happyReduce_93),\n        (94 , happyReduce_94),\n        (95 , happyReduce_95),\n        (96 , happyReduce_96),\n        (97 , happyReduce_97),\n        (98 , happyReduce_98),\n        (99 , happyReduce_99),\n        (100 , happyReduce_100),\n        (101 , happyReduce_101),\n        (102 , happyReduce_102),\n        (103 , happyReduce_103),\n        (104 , happyReduce_104),\n        (105 , happyReduce_105),\n        (106 , happyReduce_106),\n        (107 , happyReduce_107),\n        (108 , happyReduce_108),\n        (109 , happyReduce_109),\n        (110 , happyReduce_110),\n        (111 , happyReduce_111),\n        (112 , happyReduce_112),\n        (113 , happyReduce_113),\n        (114 , happyReduce_114),\n        (115 , happyReduce_115),\n        (116 , happyReduce_116),\n        (117 , happyReduce_117),\n        (118 , happyReduce_118),\n        (119 , happyReduce_119),\n        (120 , happyReduce_120),\n        (121 , happyReduce_121),\n        (122 , happyReduce_122),\n        (123 , happyReduce_123),\n        (124 , happyReduce_124),\n        (125 , happyReduce_125),\n        (126 , happyReduce_126),\n        (127 , happyReduce_127),\n        (128 , happyReduce_128),\n        (129 , happyReduce_129),\n        (130 , happyReduce_130),\n        (131 , happyReduce_131),\n        (132 , happyReduce_132),\n        (133 , happyReduce_133),\n        (134 , happyReduce_134),\n        (135 , happyReduce_135),\n        (136 , happyReduce_136),\n        (137 , happyReduce_137),\n        (138 , happyReduce_138),\n        (139 , happyReduce_139),\n        (140 , happyReduce_140),\n        (141 , happyReduce_141),\n        (142 , happyReduce_142),\n        (143 , happyReduce_143),\n        (144 , happyReduce_144),\n        (145 , happyReduce_145),\n        (146 , happyReduce_146),\n        (147 , happyReduce_147),\n        (148 , happyReduce_148),\n        (149 , happyReduce_149),\n        (150 , happyReduce_150),\n        (151 , happyReduce_151),\n        (152 , happyReduce_152),\n        (153 , happyReduce_153),\n        (154 , happyReduce_154),\n        (155 , happyReduce_155),\n        (156 , happyReduce_156),\n        (157 , happyReduce_157),\n        (158 , happyReduce_158),\n        (159 , happyReduce_159),\n        (160 , happyReduce_160),\n        (161 , happyReduce_161),\n        (162 , happyReduce_162),\n        (163 , happyReduce_163),\n        (164 , happyReduce_164),\n        (165 , happyReduce_165),\n        (166 , happyReduce_166),\n        (167 , happyReduce_167),\n        (168 , happyReduce_168),\n        (169 , happyReduce_169),\n        (170 , happyReduce_170),\n        (171 , happyReduce_171),\n        (172 , happyReduce_172),\n        (173 , happyReduce_173),\n        (174 , happyReduce_174),\n        (175 , happyReduce_175),\n        (176 , happyReduce_176),\n        (177 , happyReduce_177),\n        (178 , happyReduce_178),\n        (179 , happyReduce_179),\n        (180 , happyReduce_180),\n        (181 , happyReduce_181),\n        (182 , happyReduce_182),\n        (183 , happyReduce_183),\n        (184 , happyReduce_184),\n        (185 , happyReduce_185),\n        (186 , happyReduce_186),\n        (187 , happyReduce_187),\n        (188 , happyReduce_188),\n        (189 , happyReduce_189),\n        (190 , happyReduce_190),\n        (191 , happyReduce_191),\n        (192 , happyReduce_192),\n        (193 , happyReduce_193),\n        (194 , happyReduce_194),\n        (195 , happyReduce_195),\n        (196 , happyReduce_196),\n        (197 , happyReduce_197),\n        (198 , happyReduce_198),\n        (199 , happyReduce_199),\n        (200 , happyReduce_200),\n        (201 , happyReduce_201),\n        (202 , happyReduce_202),\n        (203 , happyReduce_203),\n        (204 , happyReduce_204),\n        (205 , happyReduce_205),\n        (206 , happyReduce_206),\n        (207 , happyReduce_207),\n        (208 , happyReduce_208),\n        (209 , happyReduce_209)\n        ]\n\nhappy_n_terms = 17 :: Int\nhappy_n_nonterms = 101 :: Int\n\nhappyReduce_1 = happyReduce 6# 0# happyReduction_1\nhappyReduction_1 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOutTok happy_x_2 of { (TokenSym happy_var_2) ->\n        case happyOut4 happy_x_4 of { happy_var_4 ->\n        case happyOut4 happy_x_6 of { happy_var_6 ->\n        happyIn4\n                 (Let happy_var_2 happy_var_4 happy_var_6\n        ) `HappyStk` happyRest}}}\n\nhappyReduce_2 = happySpecReduce_3  0# happyReduction_2\nhappyReduction_2 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Plus happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_3 = happySpecReduce_3  0# happyReduction_3\nhappyReduction_3 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Minus happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_4 = happySpecReduce_3  0# happyReduction_4\nhappyReduction_4 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Times happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_5 = happySpecReduce_3  0# happyReduction_5\nhappyReduction_5 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Div happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_6 = happySpecReduce_3  0# happyReduction_6\nhappyReduction_6 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn4\n                 (happy_var_2\n        )}\n\nhappyReduce_7 = happySpecReduce_2  0# happyReduction_7\nhappyReduction_7 happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn4\n                 (Negate happy_var_2\n        )}\n\nhappyReduce_8 = happySpecReduce_1  0# happyReduction_8\nhappyReduction_8 happy_x_1\n         =  case happyOutTok happy_x_1 of { (TokenInt happy_var_1) ->\n        happyIn4\n                 (Int happy_var_1\n        )}\n\nhappyReduce_9 = happySpecReduce_1  0# happyReduction_9\nhappyReduction_9 happy_x_1\n         =  case happyOutTok happy_x_1 of { (TokenSym happy_var_1) ->\n        happyIn4\n                 (Var happy_var_1\n        )}\n\nhappyReduce_10 = happySpecReduce_1  0# happyReduction_10\nhappyReduction_10 happy_x_1\n         =  case happyOut5 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_11 = happySpecReduce_1  0# happyReduction_11\nhappyReduction_11 happy_x_1\n         =  case happyOut6 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_12 = happySpecReduce_1  0# happyReduction_12\nhappyReduction_12 happy_x_1\n         =  case happyOut7 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_13 = happySpecReduce_1  0# happyReduction_13\nhappyReduction_13 happy_x_1\n         =  case happyOut8 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_14 = happySpecReduce_1  0# happyReduction_14\nhappyReduction_14 happy_x_1\n         =  case happyOut9 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_15 = happySpecReduce_1  0# happyReduction_15\nhappyReduction_15 happy_x_1\n         =  case happyOut10 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_16 = happySpecReduce_1  0# happyReduction_16\nhappyReduction_16 happy_x_1\n         =  case happyOut11 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_17 = happySpecReduce_1  0# happyReduction_17\nhappyReduction_17 happy_x_1\n         =  case happyOut12 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_18 = happySpecReduce_1  0# happyReduction_18\nhappyReduction_18 happy_x_1\n         =  case happyOut13 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_19 = happySpecReduce_1  0# happyReduction_19\nhappyReduction_19 happy_x_1\n         =  case happyOut14 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_20 = happySpecReduce_1  0# happyReduction_20\nhappyReduction_20 happy_x_1\n         =  case happyOut15 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_21 = happySpecReduce_1  0# happyReduction_21\nhappyReduction_21 happy_x_1\n         =  case happyOut16 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_22 = happySpecReduce_1  0# happyReduction_22\nhappyReduction_22 happy_x_1\n         =  case happyOut17 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_23 = happySpecReduce_1  0# happyReduction_23\nhappyReduction_23 happy_x_1\n         =  case happyOut18 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_24 = happySpecReduce_1  0# happyReduction_24\nhappyReduction_24 happy_x_1\n         =  case happyOut19 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_25 = happySpecReduce_1  0# happyReduction_25\nhappyReduction_25 happy_x_1\n         =  case happyOut20 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_26 = happySpecReduce_1  0# happyReduction_26\nhappyReduction_26 happy_x_1\n         =  case happyOut21 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_27 = happySpecReduce_1  0# happyReduction_27\nhappyReduction_27 happy_x_1\n         =  case happyOut22 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_28 = happySpecReduce_1  0# happyReduction_28\nhappyReduction_28 happy_x_1\n         =  case happyOut23 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_29 = happySpecReduce_1  0# happyReduction_29\nhappyReduction_29 happy_x_1\n         =  case happyOut24 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_30 = happySpecReduce_1  0# happyReduction_30\nhappyReduction_30 happy_x_1\n         =  case happyOut25 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_31 = happySpecReduce_1  0# happyReduction_31\nhappyReduction_31 happy_x_1\n         =  case happyOut26 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_32 = happySpecReduce_1  0# happyReduction_32\nhappyReduction_32 happy_x_1\n         =  case happyOut27 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_33 = happySpecReduce_1  0# happyReduction_33\nhappyReduction_33 happy_x_1\n         =  case happyOut28 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_34 = happySpecReduce_1  0# happyReduction_34\nhappyReduction_34 happy_x_1\n         =  case happyOut29 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_35 = happySpecReduce_1  0# happyReduction_35\nhappyReduction_35 happy_x_1\n         =  case happyOut30 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_36 = happySpecReduce_1  0# happyReduction_36\nhappyReduction_36 happy_x_1\n         =  case happyOut31 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_37 = happySpecReduce_1  0# happyReduction_37\nhappyReduction_37 happy_x_1\n         =  case happyOut32 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_38 = happySpecReduce_1  0# happyReduction_38\nhappyReduction_38 happy_x_1\n         =  case happyOut33 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_39 = happySpecReduce_1  0# happyReduction_39\nhappyReduction_39 happy_x_1\n         =  case happyOut34 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_40 = happySpecReduce_1  0# happyReduction_40\nhappyReduction_40 happy_x_1\n         =  case happyOut35 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_41 = happySpecReduce_1  0# happyReduction_41\nhappyReduction_41 happy_x_1\n         =  case happyOut36 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_42 = happySpecReduce_1  0# happyReduction_42\nhappyReduction_42 happy_x_1\n         =  case happyOut37 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_43 = happySpecReduce_1  0# happyReduction_43\nhappyReduction_43 happy_x_1\n         =  case happyOut38 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_44 = happySpecReduce_1  0# happyReduction_44\nhappyReduction_44 happy_x_1\n         =  case happyOut39 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_45 = happySpecReduce_1  0# happyReduction_45\nhappyReduction_45 happy_x_1\n         =  case happyOut40 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_46 = happySpecReduce_1  0# happyReduction_46\nhappyReduction_46 happy_x_1\n         =  case happyOut41 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_47 = happySpecReduce_1  0# happyReduction_47\nhappyReduction_47 happy_x_1\n         =  case happyOut42 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_48 = happySpecReduce_1  0# happyReduction_48\nhappyReduction_48 happy_x_1\n         =  case happyOut43 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_49 = happySpecReduce_1  0# happyReduction_49\nhappyReduction_49 happy_x_1\n         =  case happyOut44 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_50 = happySpecReduce_1  0# happyReduction_50\nhappyReduction_50 happy_x_1\n         =  case happyOut45 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_51 = happySpecReduce_1  0# happyReduction_51\nhappyReduction_51 happy_x_1\n         =  case happyOut46 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_52 = happySpecReduce_1  0# happyReduction_52\nhappyReduction_52 happy_x_1\n         =  case happyOut47 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_53 = happySpecReduce_1  0# happyReduction_53\nhappyReduction_53 happy_x_1\n         =  case happyOut48 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_54 = happySpecReduce_1  0# happyReduction_54\nhappyReduction_54 happy_x_1\n         =  case happyOut49 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_55 = happySpecReduce_1  0# happyReduction_55\nhappyReduction_55 happy_x_1\n         =  case happyOut50 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_56 = happySpecReduce_1  0# happyReduction_56\nhappyReduction_56 happy_x_1\n         =  case happyOut51 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_57 = happySpecReduce_1  0# happyReduction_57\nhappyReduction_57 happy_x_1\n         =  case happyOut52 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_58 = happySpecReduce_1  0# happyReduction_58\nhappyReduction_58 happy_x_1\n         =  case happyOut53 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_59 = happySpecReduce_1  0# happyReduction_59\nhappyReduction_59 happy_x_1\n         =  case happyOut54 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_60 = happySpecReduce_1  0# happyReduction_60\nhappyReduction_60 happy_x_1\n         =  case happyOut55 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_61 = happySpecReduce_1  0# happyReduction_61\nhappyReduction_61 happy_x_1\n         =  case happyOut56 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_62 = happySpecReduce_1  0# happyReduction_62\nhappyReduction_62 happy_x_1\n         =  case happyOut57 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_63 = happySpecReduce_1  0# happyReduction_63\nhappyReduction_63 happy_x_1\n         =  case happyOut58 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_64 = happySpecReduce_1  0# happyReduction_64\nhappyReduction_64 happy_x_1\n         =  case happyOut59 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_65 = happySpecReduce_1  0# happyReduction_65\nhappyReduction_65 happy_x_1\n         =  case happyOut60 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_66 = happySpecReduce_1  0# happyReduction_66\nhappyReduction_66 happy_x_1\n         =  case happyOut61 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_67 = happySpecReduce_1  0# happyReduction_67\nhappyReduction_67 happy_x_1\n         =  case happyOut62 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_68 = happySpecReduce_1  0# happyReduction_68\nhappyReduction_68 happy_x_1\n         =  case happyOut63 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_69 = happySpecReduce_1  0# happyReduction_69\nhappyReduction_69 happy_x_1\n         =  case happyOut64 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_70 = happySpecReduce_1  0# happyReduction_70\nhappyReduction_70 happy_x_1\n         =  case happyOut65 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_71 = happySpecReduce_1  0# happyReduction_71\nhappyReduction_71 happy_x_1\n         =  case happyOut66 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_72 = happySpecReduce_1  0# happyReduction_72\nhappyReduction_72 happy_x_1\n         =  case happyOut67 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_73 = happySpecReduce_1  0# happyReduction_73\nhappyReduction_73 happy_x_1\n         =  case happyOut68 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_74 = happySpecReduce_1  0# happyReduction_74\nhappyReduction_74 happy_x_1\n         =  case happyOut69 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_75 = happySpecReduce_1  0# happyReduction_75\nhappyReduction_75 happy_x_1\n         =  case happyOut70 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_76 = happySpecReduce_1  0# happyReduction_76\nhappyReduction_76 happy_x_1\n         =  case happyOut71 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_77 = happySpecReduce_1  0# happyReduction_77\nhappyReduction_77 happy_x_1\n         =  case happyOut72 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_78 = happySpecReduce_1  0# happyReduction_78\nhappyReduction_78 happy_x_1\n         =  case happyOut73 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_79 = happySpecReduce_1  0# happyReduction_79\nhappyReduction_79 happy_x_1\n         =  case happyOut74 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_80 = happySpecReduce_1  0# happyReduction_80\nhappyReduction_80 happy_x_1\n         =  case happyOut75 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_81 = happySpecReduce_1  0# happyReduction_81\nhappyReduction_81 happy_x_1\n         =  case happyOut76 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_82 = happySpecReduce_1  0# happyReduction_82\nhappyReduction_82 happy_x_1\n         =  case happyOut77 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_83 = happySpecReduce_1  0# happyReduction_83\nhappyReduction_83 happy_x_1\n         =  case happyOut78 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_84 = happySpecReduce_1  0# happyReduction_84\nhappyReduction_84 happy_x_1\n         =  case happyOut79 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_85 = happySpecReduce_1  0# happyReduction_85\nhappyReduction_85 happy_x_1\n         =  case happyOut80 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_86 = happySpecReduce_1  0# happyReduction_86\nhappyReduction_86 happy_x_1\n         =  case happyOut81 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_87 = happySpecReduce_1  0# happyReduction_87\nhappyReduction_87 happy_x_1\n         =  case happyOut82 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_88 = happySpecReduce_1  0# happyReduction_88\nhappyReduction_88 happy_x_1\n         =  case happyOut83 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_89 = happySpecReduce_1  0# happyReduction_89\nhappyReduction_89 happy_x_1\n         =  case happyOut84 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_90 = happySpecReduce_1  0# happyReduction_90\nhappyReduction_90 happy_x_1\n         =  case happyOut85 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_91 = happySpecReduce_1  0# happyReduction_91\nhappyReduction_91 happy_x_1\n         =  case happyOut86 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_92 = happySpecReduce_1  0# happyReduction_92\nhappyReduction_92 happy_x_1\n         =  case happyOut87 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_93 = happySpecReduce_1  0# happyReduction_93\nhappyReduction_93 happy_x_1\n         =  case happyOut88 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_94 = happySpecReduce_1  0# happyReduction_94\nhappyReduction_94 happy_x_1\n         =  case happyOut89 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_95 = happySpecReduce_1  0# happyReduction_95\nhappyReduction_95 happy_x_1\n         =  case happyOut90 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_96 = happySpecReduce_1  0# happyReduction_96\nhappyReduction_96 happy_x_1\n         =  case happyOut91 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_97 = happySpecReduce_1  0# happyReduction_97\nhappyReduction_97 happy_x_1\n         =  case happyOut92 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_98 = happySpecReduce_1  0# happyReduction_98\nhappyReduction_98 happy_x_1\n         =  case happyOut93 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_99 = happySpecReduce_1  0# happyReduction_99\nhappyReduction_99 happy_x_1\n         =  case happyOut94 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_100 = happySpecReduce_1  0# happyReduction_100\nhappyReduction_100 happy_x_1\n         =  case happyOut95 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_101 = happySpecReduce_1  0# happyReduction_101\nhappyReduction_101 happy_x_1\n         =  case happyOut96 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_102 = happySpecReduce_1  0# happyReduction_102\nhappyReduction_102 happy_x_1\n         =  case happyOut97 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_103 = happySpecReduce_1  0# happyReduction_103\nhappyReduction_103 happy_x_1\n         =  case happyOut98 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_104 = happySpecReduce_1  0# happyReduction_104\nhappyReduction_104 happy_x_1\n         =  case happyOut99 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_105 = happySpecReduce_1  0# happyReduction_105\nhappyReduction_105 happy_x_1\n         =  case happyOut100 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_106 = happySpecReduce_1  0# happyReduction_106\nhappyReduction_106 happy_x_1\n         =  case happyOut101 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_107 = happySpecReduce_1  0# happyReduction_107\nhappyReduction_107 happy_x_1\n         =  case happyOut102 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_108 = happySpecReduce_1  0# happyReduction_108\nhappyReduction_108 happy_x_1\n         =  case happyOut103 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_109 = happySpecReduce_1  0# happyReduction_109\nhappyReduction_109 happy_x_1\n         =  case happyOut104 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_110 = happySpecReduce_3  1# happyReduction_110\nhappyReduction_110 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn5\n                 (Dummy happy_var_2\n        )}\n\nhappyReduce_111 = happyReduce 4# 2# happyReduction_111\nhappyReduction_111 (happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn6\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_112 = happyReduce 5# 3# happyReduction_112\nhappyReduction_112 (happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn7\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_113 = happyReduce 6# 4# happyReduction_113\nhappyReduction_113 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn8\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_114 = happyReduce 7# 5# happyReduction_114\nhappyReduction_114 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn9\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_115 = happyReduce 8# 6# happyReduction_115\nhappyReduction_115 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn10\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_116 = happyReduce 9# 7# happyReduction_116\nhappyReduction_116 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn11\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_117 = happyReduce 10# 8# happyReduction_117\nhappyReduction_117 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn12\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_118 = happyReduce 11# 9# happyReduction_118\nhappyReduction_118 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn13\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_119 = happyReduce 12# 10# happyReduction_119\nhappyReduction_119 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn14\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_120 = happyReduce 13# 11# happyReduction_120\nhappyReduction_120 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn15\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_121 = happyReduce 14# 12# happyReduction_121\nhappyReduction_121 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn16\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_122 = happyReduce 15# 13# happyReduction_122\nhappyReduction_122 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn17\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_123 = happyReduce 16# 14# happyReduction_123\nhappyReduction_123 (happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn18\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_124 = happyReduce 17# 15# happyReduction_124\nhappyReduction_124 (happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn19\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_125 = happyReduce 18# 16# happyReduction_125\nhappyReduction_125 (happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn20\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_126 = happyReduce 19# 17# happyReduction_126\nhappyReduction_126 (happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn21\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_127 = happyReduce 20# 18# happyReduction_127\nhappyReduction_127 (happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn22\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_128 = happyReduce 21# 19# happyReduction_128\nhappyReduction_128 (happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn23\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_129 = happyReduce 22# 20# happyReduction_129\nhappyReduction_129 (happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn24\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_130 = happyReduce 4# 21# happyReduction_130\nhappyReduction_130 (happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn25\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_131 = happyReduce 5# 22# happyReduction_131\nhappyReduction_131 (happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn26\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_132 = happyReduce 6# 23# happyReduction_132\nhappyReduction_132 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn27\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_133 = happyReduce 7# 24# happyReduction_133\nhappyReduction_133 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn28\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_134 = happyReduce 8# 25# happyReduction_134\nhappyReduction_134 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn29\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_135 = happyReduce 9# 26# happyReduction_135\nhappyReduction_135 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn30\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_136 = happyReduce 10# 27# happyReduction_136\nhappyReduction_136 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn31\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_137 = happyReduce 11# 28# happyReduction_137\nhappyReduction_137 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn32\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_138 = happyReduce 12# 29# happyReduction_138\nhappyReduction_138 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn33\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_139 = happyReduce 13# 30# happyReduction_139\nhappyReduction_139 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn34\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_140 = happyReduce 14# 31# happyReduction_140\nhappyReduction_140 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn35\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_141 = happyReduce 15# 32# happyReduction_141\nhappyReduction_141 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn36\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_142 = happyReduce 16# 33# happyReduction_142\nhappyReduction_142 (happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn37\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_143 = happyReduce 17# 34# happyReduction_143\nhappyReduction_143 (happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn38\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_144 = happyReduce 18# 35# happyReduction_144\nhappyReduction_144 (happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn39\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_145 = happyReduce 19# 36# happyReduction_145\nhappyReduction_145 (happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn40\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_146 = happyReduce 20# 37# happyReduction_146\nhappyReduction_146 (happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn41\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_147 = happyReduce 21# 38# happyReduction_147\nhappyReduction_147 (happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn42\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_148 = happyReduce 22# 39# happyReduction_148\nhappyReduction_148 (happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn43\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_149 = happyReduce 23# 40# happyReduction_149\nhappyReduction_149 (happy_x_23 `HappyStk`\n        happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn44\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_150 = happySpecReduce_3  41# happyReduction_150\nhappyReduction_150 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn45\n                 (Dummy happy_var_2\n        )}\n\nhappyReduce_151 = happyReduce 4# 42# happyReduction_151\nhappyReduction_151 (happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn46\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_152 = happyReduce 5# 43# happyReduction_152\nhappyReduction_152 (happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn47\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_153 = happyReduce 6# 44# happyReduction_153\nhappyReduction_153 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn48\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_154 = happyReduce 7# 45# happyReduction_154\nhappyReduction_154 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn49\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_155 = happyReduce 8# 46# happyReduction_155\nhappyReduction_155 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn50\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_156 = happyReduce 9# 47# happyReduction_156\nhappyReduction_156 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn51\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_157 = happyReduce 10# 48# happyReduction_157\nhappyReduction_157 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn52\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_158 = happyReduce 11# 49# happyReduction_158\nhappyReduction_158 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn53\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_159 = happyReduce 12# 50# happyReduction_159\nhappyReduction_159 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn54\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_160 = happyReduce 13# 51# happyReduction_160\nhappyReduction_160 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn55\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_161 = happyReduce 14# 52# happyReduction_161\nhappyReduction_161 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn56\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_162 = happyReduce 15# 53# happyReduction_162\nhappyReduction_162 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn57\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_163 = happyReduce 16# 54# happyReduction_163\nhappyReduction_163 (happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn58\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_164 = happyReduce 17# 55# happyReduction_164\nhappyReduction_164 (happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn59\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_165 = happyReduce 18# 56# happyReduction_165\nhappyReduction_165 (happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn60\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_166 = happyReduce 19# 57# happyReduction_166\nhappyReduction_166 (happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn61\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_167 = happyReduce 20# 58# happyReduction_167\nhappyReduction_167 (happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn62\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_168 = happyReduce 21# 59# happyReduction_168\nhappyReduction_168 (happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn63\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_169 = happyReduce 22# 60# happyReduction_169\nhappyReduction_169 (happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn64\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_170 = happyReduce 6# 61# happyReduction_170\nhappyReduction_170 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn65\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_171 = happyReduce 7# 62# happyReduction_171\nhappyReduction_171 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn66\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_172 = happyReduce 8# 63# happyReduction_172\nhappyReduction_172 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn67\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_173 = happyReduce 9# 64# happyReduction_173\nhappyReduction_173 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn68\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_174 = happyReduce 10# 65# happyReduction_174\nhappyReduction_174 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn69\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_175 = happyReduce 11# 66# happyReduction_175\nhappyReduction_175 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn70\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_176 = happyReduce 12# 67# happyReduction_176\nhappyReduction_176 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn71\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_177 = happyReduce 13# 68# happyReduction_177\nhappyReduction_177 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn72\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_178 = happyReduce 14# 69# happyReduction_178\nhappyReduction_178 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn73\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_179 = happyReduce 15# 70# happyReduction_179\nhappyReduction_179 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn74\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_180 = happyReduce 6# 71# happyReduction_180\nhappyReduction_180 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn75\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_181 = happyReduce 7# 72# happyReduction_181\nhappyReduction_181 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn76\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_182 = happyReduce 8# 73# happyReduction_182\nhappyReduction_182 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn77\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_183 = happyReduce 9# 74# happyReduction_183\nhappyReduction_183 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn78\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_184 = happyReduce 10# 75# happyReduction_184\nhappyReduction_184 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn79\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_185 = happyReduce 11# 76# happyReduction_185\nhappyReduction_185 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn80\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_186 = happyReduce 12# 77# happyReduction_186\nhappyReduction_186 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn81\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_187 = happyReduce 13# 78# happyReduction_187\nhappyReduction_187 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn82\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_188 = happyReduce 14# 79# happyReduction_188\nhappyReduction_188 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn83\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_189 = happyReduce 15# 80# happyReduction_189\nhappyReduction_189 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn84\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_190 = happyReduce 6# 81# happyReduction_190\nhappyReduction_190 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn85\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_191 = happyReduce 7# 82# happyReduction_191\nhappyReduction_191 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn86\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_192 = happyReduce 8# 83# happyReduction_192\nhappyReduction_192 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn87\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_193 = happyReduce 9# 84# happyReduction_193\nhappyReduction_193 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn88\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_194 = happyReduce 10# 85# happyReduction_194\nhappyReduction_194 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn89\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_195 = happyReduce 11# 86# happyReduction_195\nhappyReduction_195 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn90\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_196 = happyReduce 12# 87# happyReduction_196\nhappyReduction_196 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn91\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_197 = happyReduce 13# 88# happyReduction_197\nhappyReduction_197 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn92\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_198 = happyReduce 14# 89# happyReduction_198\nhappyReduction_198 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn93\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_199 = happyReduce 15# 90# happyReduction_199\nhappyReduction_199 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn94\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_200 = happyReduce 6# 91# happyReduction_200\nhappyReduction_200 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn95\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_201 = happyReduce 7# 92# happyReduction_201\nhappyReduction_201 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn96\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_202 = happyReduce 8# 93# happyReduction_202\nhappyReduction_202 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn97\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_203 = happyReduce 9# 94# happyReduction_203\nhappyReduction_203 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn98\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_204 = happyReduce 10# 95# happyReduction_204\nhappyReduction_204 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn99\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_205 = happyReduce 11# 96# happyReduction_205\nhappyReduction_205 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn100\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_206 = happyReduce 12# 97# happyReduction_206\nhappyReduction_206 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn101\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_207 = happyReduce 13# 98# happyReduction_207\nhappyReduction_207 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn102\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_208 = happyReduce 14# 99# happyReduction_208\nhappyReduction_208 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn103\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_209 = happyReduce 15# 100# happyReduction_209\nhappyReduction_209 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn104\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyNewToken action sts stk [] =\n        happyDoAction 16# notHappyAtAll action sts stk []\n\nhappyNewToken action sts stk (tk:tks) =\n        let cont i = happyDoAction i tk action sts stk tks in\n        case tk of {\n        TokenLet -> cont 1#;\n        TokenIn -> cont 2#;\n        TokenInt happy_dollar_dollar -> cont 3#;\n        TokenSym happy_dollar_dollar -> cont 4#;\n        TokenEq -> cont 5#;\n        TokenPlus -> cont 6#;\n        TokenMinus -> cont 7#;\n        TokenTimes -> cont 8#;\n        TokenDiv -> cont 9#;\n        TokenLParen -> cont 10#;\n        TokenRParen -> cont 11#;\n        TokenLCurl -> cont 12#;\n        TokenRCurl -> cont 13#;\n        TokenLRect -> cont 14#;\n        TokenRRect -> cont 15#;\n        _ -> happyError' ((tk:tks), [])\n        }\n\nhappyError_ explist 16# tk tks = happyError' (tks, explist)\nhappyError_ explist _ tk tks = happyError' ((tk:tks), explist)\n\nnewtype HappyIdentity a = HappyIdentity a\nhappyIdentity = HappyIdentity\nhappyRunIdentity (HappyIdentity a) = a\n\ninstance Functor HappyIdentity where\n    fmap f (HappyIdentity a) = HappyIdentity (f a)\n\ninstance Applicative HappyIdentity where\n    pure  = HappyIdentity\n    (<*>) = ap\ninstance Monad HappyIdentity where\n    return = pure\n    (HappyIdentity p) >>= q = q p\n\nhappyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b\nhappyThen = (>>=)\nhappyReturn :: () => a -> HappyIdentity a\nhappyReturn = (return)\nhappyThen1 m k tks = (>>=) m (\\a -> k a tks)\nhappyReturn1 :: () => a -> b -> HappyIdentity a\nhappyReturn1 = \\a tks -> (return) a\nhappyError' :: () => ([(Token)], [String]) -> HappyIdentity a\nhappyError' = HappyIdentity . (\\(tokens, _) -> parseError tokens)\nparseCalc tks = happyRunIdentity happySomeParser where\n happySomeParser = happyThen (happyParse 0# tks) (\\x -> happyReturn (happyOut4 x))\n\nhappySeq = happyDontSeq\n\n\nparseError :: [Token] -> a\nparseError _ = error \"Parse error\"\n\ndata Exp = Let String Exp Exp\n         | Plus Exp Exp\n         | Minus Exp Exp\n         | Times Exp Exp\n         | Div Exp Exp\n         | Negate Exp\n         | Brack Exp\n         | Int Int\n         | Var String\n         | Dummy Exp\n         deriving Show\n\ndata Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList\n\ninfixr 9 `HappyStk`\ndata HappyStk a = HappyStk a (HappyStk a)\n\n-----------------------------------------------------------------------------\n-- starting the parse\n\nhappyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll\n\n-----------------------------------------------------------------------------\n-- Accepting the parse\n\n-- If the current token is 0#, it means we've just accepted a partial\n-- parse (a %partial parser).  We must ignore the saved token on the top of\n-- the stack in this case.\nhappyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =\n        happyReturn1 ans\nhappyAccept j tk st sts (HappyStk ans _) =\n        (happyTcHack j (happyTcHack st)) (happyReturn1 ans)\n\n-----------------------------------------------------------------------------\n-- Arrays only: do the next action\n\n\nhappyDoAction i tk st\n        = {- nothing -}\n          case action of\n                0#           -> {- nothing -}\n                                     happyFail (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Int)) i tk st\n                -1#          -> {- nothing -}\n                                     happyAccept i tk st\n                n | ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#))) :: Bool) -> {- nothing -}\n\n                                                   (happyReduceArr Happy_Data_Array.! rule) i tk st\n                                                   where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))\n                n                 -> {- nothing -}\n\n\n                                     happyShift new_state i tk st\n                                     where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))\n   where off    = happyAdjustOffset (indexShortOffAddr happyActOffsets st)\n         off_i  = (off Happy_GHC_Exts.+#  i)\n         check  = if ((Happy_GHC_Exts.tagToEnum# (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))) :: Bool)\n                  then ((Happy_GHC_Exts.tagToEnum# (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==#  i)) :: Bool)\n                  else False\n         action\n          | check     = indexShortOffAddr happyTable off_i\n          | otherwise = indexShortOffAddr happyDefActions st\n\nindexShortOffAddr (HappyA# arr) off =\n        Happy_GHC_Exts.narrow16Int# i\n  where\n        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)\n        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))\n        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))\n        off' = off Happy_GHC_Exts.*# 2#\n\n{-# INLINE happyLt #-}\nhappyLt x y = ((Happy_GHC_Exts.tagToEnum# (x Happy_GHC_Exts.<# y)) :: Bool)\n\nreadArrayBit arr bit =\n    Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `mod` 16)\n  where unbox_int (Happy_GHC_Exts.I# x) = x\n\ndata HappyAddr = HappyA# Happy_GHC_Exts.Addr#\n\n-----------------------------------------------------------------------------\n-- Shifting a token\n\nhappyShift new_state 0# tk st sts stk@(x `HappyStk` _) =\n     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in\n--     trace \"shifting the error token\" $\n     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)\n\nhappyShift new_state i tk st sts stk =\n     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)\n\n-- happyReduce is specialised for the common cases.\n\nhappySpecReduce_0 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_0 nt fn j tk st@((action)) sts stk\n     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)\n\nhappySpecReduce_1 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')\n     = let r = fn v1 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_2 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')\n     = let r = fn v1 v2 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_3 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')\n     = let r = fn v1 v2 v3 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappyReduce k i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappyReduce k nt fn j tk st sts stk\n     = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of\n         sts1@((HappyCons (st1@(action)) (_))) ->\n                let r = fn stk in  -- it doesn't hurt to always seq here...\n                happyDoSeq r (happyGoto nt j tk st1 sts1 r)\n\nhappyMonadReduce k nt fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappyMonadReduce k nt fn j tk st sts stk =\n      case happyDrop k (HappyCons (st) (sts)) of\n        sts1@((HappyCons (st1@(action)) (_))) ->\n          let drop_stk = happyDropStk k stk in\n          happyThen1 (fn stk tk) (\\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))\n\nhappyMonad2Reduce k nt fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappyMonad2Reduce k nt fn j tk st sts stk =\n      case happyDrop k (HappyCons (st) (sts)) of\n        sts1@((HappyCons (st1@(action)) (_))) ->\n         let drop_stk = happyDropStk k stk\n\n             off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1)\n             off_i = (off Happy_GHC_Exts.+#  nt)\n             new_state = indexShortOffAddr happyTable off_i\n\n\n\n\n          in\n          happyThen1 (fn stk tk) (\\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))\n\nhappyDrop 0# l = l\nhappyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t\n\nhappyDropStk 0# l = l\nhappyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs\n\n-----------------------------------------------------------------------------\n-- Moving to a new state after a reduction\n\n\nhappyGoto nt j tk st =\n   {- nothing -}\n   happyDoAction j tk new_state\n   where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st)\n         off_i = (off Happy_GHC_Exts.+#  nt)\n         new_state = indexShortOffAddr happyTable off_i\n\n\n\n\n-----------------------------------------------------------------------------\n-- Error recovery (0# is the error token)\n\n-- parse error if we are in recovery and we fail again\nhappyFail explist 0# tk old_st _ stk@(x `HappyStk` _) =\n     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in\n--      trace \"failing\" $\n        happyError_ explist i tk\n\n{-  We don't need state discarding for our restricted implementation of\n    \"error\".  In fact, it can cause some bogus parses, so I've disabled it\n    for now --SDM\n\n-- discard a state\nhappyFail  0# tk old_st (HappyCons ((action)) (sts))\n                                                (saved_tok `HappyStk` _ `HappyStk` stk) =\n--      trace (\"discarding state, depth \" ++ show (length stk))  $\n        happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))\n-}\n\n-- Enter error recovery: generate an error token,\n--                       save the old token and carry on.\nhappyFail explist i tk (action) sts stk =\n--      trace \"entering error recovery\" $\n        happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)\n\n-- Internal happy errors:\n\nnotHappyAtAll :: a\nnotHappyAtAll = error \"Internal Happy error\\n\"\n\n-----------------------------------------------------------------------------\n-- Hack to get the typechecker to accept our action functions\n\n\nhappyTcHack :: Happy_GHC_Exts.Int# -> a -> a\nhappyTcHack x y = y\n{-# INLINE happyTcHack #-}\n\n\n-----------------------------------------------------------------------------\n-- Seq-ing.  If the --strict flag is given, then Happy emits\n--      happySeq = happyDoSeq\n-- otherwise it emits\n--      happySeq = happyDontSeq\n\nhappyDoSeq, happyDontSeq :: a -> b -> b\nhappyDoSeq   a b = a `seq` b\nhappyDontSeq a b = b\n\n-----------------------------------------------------------------------------\n-- Don't inline any functions from the template.  GHC has a nasty habit\n-- of deciding to inline happyGoto everywhere, which increases the size of\n-- the generated parser quite a bit.\n\n\n{-# NOINLINE happyDoAction #-}\n{-# NOINLINE happyTable #-}\n{-# NOINLINE happyCheck #-}\n{-# NOINLINE happyActOffsets #-}\n{-# NOINLINE happyGotoOffsets #-}\n{-# NOINLINE happyDefActions #-}\n\n{-# NOINLINE happyShift #-}\n{-# NOINLINE happySpecReduce_0 #-}\n{-# NOINLINE happySpecReduce_1 #-}\n{-# NOINLINE happySpecReduce_2 #-}\n{-# NOINLINE happySpecReduce_3 #-}\n{-# NOINLINE happyReduce #-}\n{-# NOINLINE happyMonadReduce #-}\n{-# NOINLINE happyGoto #-}\n{-# NOINLINE happyFail #-}\n\n-- end of Happy Template.\n", "num_lines": 3870}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Classes where\n\n\nclass Foo a where\n    bar :: a -> Int\n    baz :: Int -> (a, a)\n\ninstance Foo Int where\n    bar = id\n    baz x = (x, x)\n\ninstance Foo [a] where\n    bar = length\n    baz _ = ([], [])\n\n\nclass Foo a => Foo' a where\n    quux :: (a, a) -> a\n    quux (x, y) = norf [x, y]\n\n    norf :: [a] -> a\n    norf = quux . baz . sum . map bar\n\ninstance Foo' Int where\n    norf = sum\n\ninstance Foo' [a] where\n    quux = uncurry (++)\n\n\nclass Plugh p where\n    plugh :: p a a -> p b b -> p (a -> b) (b -> a)\n\ninstance Plugh Either where\n    plugh (Left a) (Left {}) = Right $ const a\n    plugh (Right a) (Right {}) = Right $ const a\n    plugh _ (Left b) = Left $ const b\n    plugh _ (Right b) = Left $ const b\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Identifiers where\n\n\nfoo, bar, baz :: Int -> Int -> Int\nfoo x y = x + x * bar y x * y + y\nbar x y = y + x - baz x y - x + y\nbaz x y = x * y * y * y * x\n\nquux :: Int -> Int\nquux x = foo (bar x x) (bar x x)\n\nnorf :: Int -> Int -> Int -> Int\nnorf x y z\n    | x < 0 = quux x\n    | y < 0 = quux y\n    | z < 0 = quux z\n    | otherwise = norf (-x) (-y) (-z)\n\n\nmain :: IO ()\nmain = do\n    putStrLn . show $ foo x y\n    putStrLn . show $ quux z\n    putStrLn . show $ Identifiers.norf x y z\n  where\n    x = 10\n    y = 20\n    z = 30\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Literals where\n\n\nstr :: String\nstr = \"str literal\"\n\nnum :: Num a => a\nnum = 0 + 1 + 1010011 * 41231 + 12131\n\nfrac :: Fractional a => a\nfrac = 42.0000001\n\nlist :: [[[[a]]]]\nlist = [[], [[]], [[[]]]]\n\npair :: ((), ((), (), ()), ())\npair = ((), ((), (), ()), ())\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Operators where\n\n\n(+++) :: [a] -> [a] -> [a]\na +++ b = a ++ b ++ a\n\n($$$) :: [a] -> [a] -> [a]\na $$$ b = b +++ a\n\n(***) :: [a] -> [a] -> [a]\n(***) a [] = a\n(***) a (_:b) = a +++ (a *** b)\n\n(*/\\*) :: [[a]] -> [a] -> [a]\na */\\* b = concatMap (*** b) a\n\n(**/\\**) :: [[a]] -> [[a]] -> [[a]]\na **/\\** b = zipWith (*/\\*) [a +++ b] (a $$$ b)\n\n\n(#.#) :: a -> b -> (c -> (a, b))\na #.# b = const $ (a, b)\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n\nmodule Polymorphism where\n\n\nfoo :: a -> a -> a\nfoo = undefined\n\nfoo' :: forall a. a -> a -> a\nfoo' = undefined\n\nbar :: a -> b -> (a, b)\nbar = undefined\n\nbar' :: forall a b. a -> b -> (a, b)\nbar' = undefined\n\nbaz :: a -> (a -> [a -> a] -> b) -> b\nbaz = undefined\n\nbaz' :: forall a b. a -> (a -> [a -> a] -> b) -> b\nbaz' = undefined\n\nquux :: a -> (forall a. a -> a) -> a\nquux x f = f x\n\nquux' :: forall a. a -> (forall a. a -> a) -> a\nquux' x f = f x\n\n\nnum :: Num a => a -> a -> a\nnum = undefined\n\nnum' :: forall a. Num a => a -> a -> a\nnum' = undefined\n\neq :: (Eq a, Eq b) => [a] -> [b] -> (a, b)\neq = undefined\n\neq' :: forall a b. (Eq a, Eq b) => [a] -> [b] -> (a, b)\neq' = undefined\n\nmon :: Monad m => (a -> m a) -> m a\nmon = undefined\n\nmon' :: forall m a. Monad m => (a -> m a) -> m a\nmon' = undefined\n\n\nnorf :: a -> (forall a. Ord a => a -> a) -> a\nnorf x f = x\n\nnorf' :: forall a. a -> (forall a. Ord a => a -> a) -> a\nnorf' x f = x\n\n\nplugh :: forall a. a -> a\nplugh x = x :: a\n\nthud :: forall a b. (a -> b) -> a -> (a, b)\nthud f x =\n    (x :: a, y) :: (a, b)\n  where\n    y = (f :: a -> b) x :: b\n", "num_lines": 67}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE RecordWildCards #-}\n\n\nmodule Records where\n\n\ndata Point = Point\n    { x :: !Int\n    , y :: !Int\n    }\n\n\npoint :: Int -> Int -> Point\npoint x y = Point { x = x, y = y }\n\n\nlengthSqr :: Point -> Int\nlengthSqr (Point { x = x, y = y }) = x * x + y * y\n\nlengthSqr' :: Point -> Int\nlengthSqr' (Point { x, y }) = y * y + x * x\n\n\ntranslateX, translateY :: Point -> Int -> Point\ntranslateX p d = p { x = x p + d }\ntranslateY p d = p { y = y p + d }\n\ntranslate :: Int -> Int -> Point -> Point\ntranslate x y p =\n    aux p\n  where\n    (dx, dy) = (x, y)\n    aux Point{..} = p { x = x + dx, y = y + dy }\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n\nmodule Types where\n\n\ndata Quux = Bar | Baz\n\nnewtype Foo = Foo ()\n\ntype FooQuux = (Foo, Quux)\ntype QuuxFoo = (Quux, Foo)\n\n\ndata family Norf a b\n\ndata instance Norf Foo Quux = NFQ Foo Quux\ndata instance Norf Quux Foo = NQF Quux Foo\n\n\ntype family Norf' a b\n\ntype instance Norf' Foo Quux = (Foo, Quux)\ntype instance Norf' Quux Foo = (Quux, Foo)\n\n\nnorf1 :: Norf Foo Quux -> Int\nnorf1 (NFQ (Foo ()) Bar) = 0\nnorf1 (NFQ (Foo ()) Baz) = 1\n\nnorf2 :: Norf Quux Foo -> Int\nnorf2 (NQF Bar (Foo ())) = 0\nnorf2 (NQF Baz (Foo ())) = 1\n\n\nnorf1' :: Norf' Foo Quux -> Int\nnorf1' (Foo (), Bar) = 0\nnorf1' (Foo (), Baz) = 1\n\nnorf2' :: Norf' Quux Foo -> Int\nnorf2' (Bar, Foo ()) = 0\nnorf2' (Baz, Foo ()) = 1\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE DataKinds #-}\nmodule MoreExplicitForalls where\n\nimport Data.Proxy\n\ndata family F1 a\ndata instance forall (x :: Bool). F1 (Proxy x) = MkF\n\nclass C a where\n  type F2 a b\n\ninstance forall a. C [a] where\n  type forall b. F2 [a] b = Int\n\n\ntype family G a b where\n  forall x y. G [x] (Proxy y) = Double\n  forall z.   G z   z         = Bool\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15904 (main) where\n\nimport System.Environment\n\nmain :: IO ()\nmain = do\n  args <- getArgs\n  mapM_ putStrLn args\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11798 where\n\nf x = [x,x,x]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n-- Test that there are actually entries in the .mix file for an imported\n-- literate module generated with --make.\nimport T2991LiterateModule\nmain = return ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\\begin{code}\nmodule T2991LiterateModule where\ncover_me = 1\n\\end{code}\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 #-}\n\n-- Reading the interface file caused a black hole\n-- in earlier versions of GHC\n\n-- Also, foo should compile to very tight code with -O2\n-- (The O2 was nothing to do with the black hole though.)\n\nmodule ShouldCompile where\n\nimport ATLoop_help\n\nfoo :: FooT Int -> Int -> Int\nfoo t n = t `seq` bar n\n   where\n     bar 0 = 0\n     bar n | even n = bar (n `div` 2)\n     bar n          = bar (n - int t)\n\n\n\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule ATLoop_help where\n\nimport Data.Kind (Type)\n\nclass Foo a where\n   data FooT a :: Type\n   int :: FooT a -> Int\n\ninstance Foo Int where\n    data FooT Int = FooInt !Int\n    int (FooInt n) = n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\n-- Results in context reduction stack overflow\n\nmodule Class1 where\n\nimport Data.Kind (Type)\n\nclass C a where\n  foo :: a x -> a y\n\nclass C (T a) => D a where\n  type T a :: Type -> Type\n\n  bar :: a -> T a x -> T a y\n\ninstance C Maybe where\n  foo Nothing = Nothing\n\ninstance D () where\n  type T () = Maybe\n\n  bar x t = foo t\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Class2 where\n\ndata family T a\ndata instance T Int = TInt Int\n\ndata U = U (T Int)\n\ninstance Show a => Show (T a) where\n  showsPrec k t = showString \"T\"\n\ninstance Show U where\n  showsPrec k (U x) = showsPrec k x\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Class3 where\n\nclass C a where\n  foo :: a -> a\ninstance C ()\n\nbar :: (a ~ ()) => a -> a\nbar = foo\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}\n\nmodule ClassEqContext  where \n\nclass a ~ b => C a b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule ClassEqContext  where \n\nclass (Show a,a ~ b) => C a b\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule ClassEqContext  where \n\nclass a ~ b => C a b\n\ninstance C Char Char\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ClosedFam1 where\n\nimport ClosedFam1a\n\ntype family Foo a where\n  Foo Int = Bool\n  Foo [a] = Maybe a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ClosedFam1a where\n\nimport {-# SOURCE #-} ClosedFam1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ClosedFam2 where\n\nimport ClosedFam2a\n\ntype family Foo a where\n  Foo Int = Bool\n  Foo [a] = Maybe a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ClosedFam2a where\nimport {-# SOURCE #-} ClosedFam2\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Col  where \n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n singleton :: Elem c -> c\n add :: c -> Elem c -> c\n\ninstance Col [e] where\n singleton = \\x -> [x]\n add = flip (:)\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule Col  where\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass (Eq (Elem c)) => Col c where\n  count     :: Elem c -> c -> Int\n\ninstance Eq e => Col [e] where\n  count     x = length . filter (==x)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ColInference  where\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n isEmpty   :: c -> Bool\n add       :: c -> Elem c -> c\n headTail  :: c -> (Elem c,c)\n\naddAll :: (Col c1, Col c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2\naddAll c1 c2\n        | isEmpty c1\n        = c2\n        | otherwise\n        = let (x,c1') = headTail c1\n          in addAll c1' (add c2 x)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ColInference  where\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n isEmpty   :: c -> Bool\n add       :: c -> Elem c -> c\n headTail  :: c -> (Elem c,c)\n\n-- addAll :: (Col c1, Col c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2\n-- addAll c1 c2\n--      | isEmpty c1\n--      = c2\n--      | otherwise\n--      = let (x,c1') = headTail c1\n--        in addAll c1' (add c2 x)\n\nsumCol :: (Col c, Elem c ~ Int) => c -> Int\nsumCol c | isEmpty c\n         = 0\n         | otherwise\n         = let (x,xs) = headTail c\n           in x + (sumCol xs)\n\n-- data CP :: * -> * where\n--  CP :: (Col c1, Col c2, Elem c1 ~ Elem c2, Elem c2 ~ Int) => (c1,c2) -> CP Char\n\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ColInference  where\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n isEmpty   :: c -> Bool\n add       :: c -> Elem c -> c\n headTail  :: c -> (Elem c,c)\n\naddAll c1 c2\n        | isEmpty c1\n        = c2\n        | otherwise\n        = let (x,c1') = headTail c1\n          in addAll c1' (add c2 x)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ColInference  where\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n isEmpty   :: c -> Bool\n add       :: c -> Elem c -> c\n headTail  :: c -> (Elem c,c)\n\nsawpOne c1 c2\n        = let (x,c1') = headTail c1\n              (y,c2') = headTail c2\n          in (add c1' y,add c2' x)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Main where\n\ntype family Elem c\n\nclass Col c where\n isEmpty   :: c -> Bool\n add       :: c -> Elem c -> c\n headTail  :: c -> (Elem c,c)\n\n-- LIST\ninstance Col [a] where\n  isEmpty         = null\n  add             = flip (:)\n  headTail (x:xs) =  (x,xs)\n\ntype instance Elem [a] = a\n\n-- SEQUENCE\ndata Sequence a = Nil | Snoc (Sequence a) a deriving Show\n\ninstance Col (Sequence a) where\n  isEmpty Nil = True\n  isEmpty _   = False\n\n  add     s x = Snoc s x\n\n  headTail (Snoc s x) = (x,s)\n\ntype instance Elem (Sequence a) = a\n\n--\naddAll c1 c2\n        | isEmpty c1\n        = c2\n        | otherwise\n        = let (x,c1') = headTail c1\n          in addAll c1' (add c2 x)\n\n--\nmain = print $ addAll c1 c2\n       where c1 = ['a','b','c']\n             c2 = (Snoc (Snoc (Snoc Nil 'd') 'e') 'f')\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ColInference  where\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n isEmpty   :: c -> Bool\n add       :: c -> Elem c -> c\n headTail  :: c -> (Elem c,c)\n\nsawpOne c1 c2\n        = let (x,c1') = headTail c1\n              (y,c2') = headTail c2\n          in (add c1' y,add c1' x)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ColInference  where\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n isEmpty   :: c -> Bool\n add       :: c -> Elem c -> c\n headTail  :: c -> (Elem c,c)\n\nsawpOne c1 c2\n        = let (x,c1') = headTail c1\n              (y,c2') = headTail c2\n          in (add c1' y,add c1' y)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\nmodule ColInference6  where \n\ntype family Elem c\n\ntype instance Elem [e] = e\n\nclass Col c where\n  toList :: c -> [Elem c]\n\n\nsumCol c = sum . toList $ c\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n\n-- This test uses the PushC rule of the System FC operational semantics\n-- Written by Tom Schrijvers\n\nmodule CoTest3 where\n\ndata T a = K (a ~ Int => a -> Int)\n\n\n{-# INLINE[2] f #-}\nf :: T s1 ~ T s2 => T s1 -> T s2\nf x = x\n\n{-# INLINE[3] test #-}\ntest :: T s1 ~ T s2 => (s1 ~ Int => s1 -> Int) -> (s2 ~ Int => s2 -> Int)\ntest g = case f (K g) of\n           K r -> r\ne :: s ~ Int => s -> s -> Int\ne _ s = s\n\nfinal :: s1 ~ s2 => s1 -> (s2 ~ Int => s2 -> Int)\nfinal x = test (e x)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule DataFamDeriv where\n\ndata family Foo a\ndata Bar = Bar\ndata instance Foo Bar\n    = Bar1 | Bar2 | Bar3 | Bar4 | Bar5 | Bar6 | Bar7 | Bar8 | Bar9\n    deriving Eq\n\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances #-}\n\nmodule ShouldCompile where\n\ndata family T a\n\ndata instance T Int = A | B\n                    deriving Eq\n\nfoo :: T Int -> Bool\nfoo x = x == x\n\ndata instance T Char = C\n\ninstance Eq (T Char) where\n  C == C = False\n\ndata family R a\ndata instance R [a] = R\n\nderiving instance Eq (R [a])\n\nclass C a where\n  data S a\n\ninstance C Int where\n  data S Int = SInt deriving Eq\n\nbar :: S Int -> Bool\nbar x = x == x\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}\n\nmodule ShouldCompile where\n\nimport Control.Applicative (Applicative)\n\ndata family S a\n\nnewtype instance S Int = S Int\n                       deriving Eq\n\ndata family S2 a b\n\nnewtype instance S2 Int b = S2 (IO b)\n                          deriving (Functor, Applicative, Monad)\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Exp (C, C(type T), T, foo, S)\nwhere\n\nclass C a where\n  data T a :: *\n  foo :: a -> a\n\ndata family S a b :: *\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeInType #-}\n\nmodule ExplicitForAllFams where\n\nimport Data.Proxy\nimport Data.Kind\n\n-- From Proposal 0007\n\ndata family F a\ndata instance forall (x :: Bool). F (Proxy x) = MkF\n\nclass C a where\n  type G a b\ninstance forall a. C [a] where\n  type forall b. G [a] b = Int\n\ntype family H a b where\n  forall x y. H [x] (Proxy y) = Double\n  forall z.   H z   z         = Bool\n\n-- More tests\n\ntype family D a b where\n  forall (a :: Type -> Type) (b :: a Int) k (c :: k). D (Proxy b) (Proxy c) = ()\n  forall (a :: Bool) (b :: Proxy a). D (Proxy b) () = Int\n  forall (a :: Type). D a a = Maybe a\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule ExplicitForAllFams2 where\n\nimport Data.Kind (Type)\n\n-- Even more tests\n\ntype family CF a b where\n  forall x y.         CF [x] (Maybe y) = (x,y)\n  forall (z :: Type). CF z   z         = Bool\n  forall.             CF _   _         = ()\n\ntype family OF a\ntype instance forall a b. OF (Maybe a, Either a b) = Either [a] b\n\ndata family DF a\ndata instance forall a b. DF (Maybe a, Either a b) = DF a a b\n\ndata family NF a\nnewtype instance forall a b. NF (Maybe a, Either a b) = NF { unNF :: Either [a] b }\n\nclass Cl a where\n  type AT a b\n  data AD a b\ninstance forall a. Cl (Maybe a) where\n  type forall b. AT (Maybe a) b = b\n  data forall b. AD (Maybe a) b = AD b\n\n-- Should produce warnings\n\ntype family N a where\n  forall t a. N (t a) = [a]\n  forall a.   N a     = ()\n\ntype family N' a where\n  N' (t a) = [a]\n  N' a     = ()\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls #-}\n\n-- This wrongly fails with\n-- \n--   Can't construct the infinite type n = PLUS n ZERO\n\nmodule GADT1 where\n\ndata ZERO\ndata SUCC n\n\ndata Nat n where\n  Zero :: Nat ZERO\n  Succ :: Nat n -> Nat (SUCC n)\n\ntype family PLUS m n\ntype instance PLUS ZERO n = n\ntype instance PLUS (SUCC m) n = SUCC (PLUS m n)\n\ndata EQUIV x y where\n  EQUIV :: EQUIV x x\n\nplus_zero :: Nat n -> EQUIV (PLUS n ZERO) n\nplus_zero Zero = EQUIV\nplus_zero (Succ n) = case plus_zero n of\n                       EQUIV -> EQUIV \n\n{-\n\nFrom Succ branch of plus_zero\n\n[G] n ~ SUCC n1     -- n1 existentially bound\n[G] PLUS n1 ZERO ~ n1\n\n[W] PLUS n ZERO ~ n\n\n--> [W] PLUS (SUCC n1) ZERO ~ SUCC n1\n--> [W] SUCC (PLUS n1 ZERO) ~ SUCC n1\n--> [W] SUCC n1 ~ SUCC n1\n\n-}", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, RankNTypes #-}\n\nmodule GADT10 where\n\n-- [Sept 2010] Now works in GHC 7.0!\n\n-- This fails with\n--\n-- GADT10.hs:37:0:\n--     All of the type variables in the constraint `x ~\n--                                                  y' are already in scope\n--         (at least one must be universally quantified here)\n--     In the type signature for `foo':\n--       foo :: EQUAL x y -> ((x ~ y) => t) -> t\n-- \n-- GADT10.hs:38:4:\n--     Couldn't match expected type `y' against inferred type `x'\n--       `y' is a rigid type variable bound by\n--           the type signature for `foo' at GADT10.hs:8:15\n--       `x' is a rigid type variable bound by\n--           the type signature for `foo' at GADT10.hs:8:13\n--     In the pattern: EQUAL\n--     In the definition of `foo': foo EQUAL t = t\n--\n-- The first error can be fixed by using FlexibleContexts but I don't think that\n-- should be required here. In fact, if we remove RankNTypes, we get\n--\n--     Illegal polymorphic or qualified type: forall (co_wild_B1 :: x ~\n--                                                                  y).\n--                                            t\n--     In the type signature for `foo':\n--       foo :: EQUAL x y -> ((x ~ y) => t) -> t\n--\n-- which seems to contradict (at least sort of) the first error message.\n\ndata EQUAL x y where\n  EQUAL :: EQUAL x x\n\nfoo :: EQUAL x y -> (x~y => t) -> t\nfoo EQUAL t = t\n\nbar :: EQUAL x y -> x -> y\nbar equ x = foo equ x\n\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, RankNTypes, EmptyDataDecls #-}\n\nmodule ShouldCompile where\n\ndata Z\ndata S a\n\ntype family Sum n m\ntype instance Sum n Z = n\ntype instance Sum n (S m) = S (Sum n m)\n\ndata Nat n where\n  NZ :: Nat Z\n  NS :: (S n ~ sn) => Nat n -> Nat sn\n\ndata EQ a b = forall q . (a ~ b) => Refl\n\nzerol :: Nat n -> EQ n (Sum Z n)\nzerol NZ = Refl\n-- zerol (NS n) = case zerol n of Refl -> Refl\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, ScopedTypeVariables, KindSignatures #-}\n{-# LANGUAGE EmptyDataDecls #-}\n\n-- Tests whether a type signature can refine a type\n-- See the definition of bug2a\n\nmodule ShouldCompile where\n\nimport qualified Data.Kind as K (Type)\n\ndata Typed\ndata Untyped\n\ntype family TU a b :: K.Type\ntype instance TU Typed b = b\ntype instance TU Untyped b = ()\n\n-- A type witness type, use eg. for pattern-matching on types\ndata Type a where\n    TypeInt     :: Type Int\n    TypeBool    :: Type Bool\n    TypeString  :: Type String\n    TypeList    :: Type t -> Type [t]\n\ndata Expr :: K.Type -> K.Type -> K.Type {- tu a -} where\n    Const :: Type a -> a -> Expr tu (TU tu a)\n    Var2  :: a -> TU tu (Type a) -> Expr tu (TU tu a)\n\nbug1 :: Expr Typed Bool -> ()\nbug1 (Const TypeBool False) = ()\n\nbug2a :: Expr Typed Bool -> ()\nbug2a (Var2 x (TypeBool :: Type Bool)) = ()\n\nbug2c :: Expr Typed Bool -> ()\nbug2c (Var2 x TypeBool) = ()\n\nbug2b :: Expr Typed (TU Typed Bool) -> ()\nbug2b (Var2 x TypeBool) = ()\n\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule GADT13 where\n\nimport Data.Kind (Type)\n\ndata family HiThere a :: Type\n\ndata instance HiThere () where\n    HiThere :: HiThere ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeOperators, GADTs,  RankNTypes, FlexibleContexts #-}\nmodule Equality( (:=:), eq_elim, eq_refl ) where\n\ndata a:=: b where\n  EQUAL :: a :=: a\n\neq_refl :: a :=: a\neq_refl = EQUAL\n\neq_elim :: (a~b) => a :=: b -> (a~b => p) -> p\neq_elim EQUAL p = p \n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\n-- Fails with\n--\n--   Couldn't match expected type `y' against inferred type `x'\n\nmodule GADT2 where\n\ndata EQUAL x y where\n  EQUAL :: x~y => EQUAL x y\n\nfoo :: EQUAL x y -> x -> y\nfoo EQUAL x = x\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls #-}\n\n-- Panics in bind_args\n\nmodule GADT3 where\n\ndata EQUAL x y where\n  EQUAL :: x~y => EQUAL x y\n\ndata ZERO\ndata SUCC n\n\ndata Nat n where\n  Zero :: Nat ZERO\n  Succ :: Nat n -> Nat (SUCC n)\n\ntype family PLUS m n\ntype instance PLUS ZERO n = n\n\nplus_zero :: Nat n -> EQUAL (PLUS ZERO n) n\nplus_zero Zero = EQUAL\nplus_zero (Succ n) = EQUAL\n\ndata FOO n where\n  FOO_Zero :: FOO ZERO\n\nfoo :: Nat m -> Nat n -> FOO n -> FOO (PLUS m n)\nfoo Zero n s = case plus_zero n of EQUAL -> s\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule GADT4 where\n\ntype family F a\ntype instance F () = ()\n\ndata T a where\n  T :: T ()\n\nfoo :: T () -> T (F ()) -> ()\nfoo T T = ()\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule GADT5 where\n\ndata T a where\n  T :: T (a,b)\n  -- this works:\n  -- T :: p ~ (a,b) => T p\n\ntype family F a\n\nbar :: a -> T (F a) -> ()\nbar x T = ()\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule GADT6 where\n\ndata Pair p  where\n  Pair :: p~(a,b) => a -> b -> Pair p\n  -- this works:\n  -- Pair :: a -> b -> Pair (a,b)\n\nfoo :: Pair ((), ()) -> a\nfoo (Pair () ()) = undefined\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule GADT7 where\n\ndata Pair p  where\n  Pair :: p~(a,b) => a -> b -> Pair p\n  -- this works:\n--  Pair :: a -> b -> Pair (a,b)\n\nfoo :: a\nfoo = case Pair () () of\n   -- this works:\n--   case Pair () () :: Pair ((), ()) of\n        Pair x y -> undefined\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule GADT8 where\n\ndata Pair p  where\n  Pair :: p~(a,b) => a -> b -> Pair p\n  -- this works:\n  -- Pair :: a -> b -> Pair (a,b)\n\nfoo :: Pair ((), ()) -> Pair ((), ())\nfoo (Pair x y) = Pair x y\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\n-- Fails with\n--\n--   Couldn't match expected type `z' against inferred type `y'\n--\n-- See also GADT2\n\nmodule GADT2 where\n\ndata EQUAL x y where\n  EQUAL :: x~y => EQUAL x y\n\nfoo :: EQUAL x y -> EQUAL y z -> x -> z\nfoo EQUAL EQUAL x = x\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances,\n             UndecidableInstances #-}\n\n-- Rather exotic example posted to Haskell mailing list 17 Oct 07\n-- It concerns context reduction and functional dependencies\n\nmodule FooModule where\n\nclass Concrete a b | a -> b where\n        bar :: a -> String\n\nclass Wuggle b | -> b  -- To make the Concrete instance work\n\ninstance (Show a, Wuggle b) => Concrete a b where\n        bar = error \"urk\"\n\nwib :: Concrete a b => a -> String\n-- Weird test case: (Concrete a b) is simplifiable\nwib x = bar x\n\n-- Uncommenting this solves the problem:\n-- instance Concrete Bool Bool\n\n{- This is a nice example of the trickiness of functional dependencies.\nHere's what is happening.\n\nConsider type inference for 'wib'.  GHC 6.6 figures out that the call\nof 'bar' gives rise to the constraint (Concrete p q), where x has type\n'p'.  Ah, but x must have type 'a', so the constraint is (Concrete a\nq).\n\nNow GHC tries to satisfy (Concrete a q) from (Concrete a b). If it\napplied improvement right away it'd succeed, but sadly it first looks\nat instances declarations.  Success: we can get (Concrete a q) from\n(Show a).  So it uses the instance decl and now we can't get (Show a)\nfrom (Concrete a b).\n\n\nOK,  found that in GHC 6.6, adding\n        instance Concrete Bool Bool\nfixed the problem. That's weird isn't it?  The reason is this. When GHC looks\nat the instance decls, it now sees *two* instance decls matching\n(Concrete a q), and so it declines for now to use either of them\n(since it's not clear which would be the right one).  Once it has\nfinished with instance decls it tries improvement.  And, yes, it now\nsees that q=b, so all is well.\n\nYou might say that GHC should use improvement more vigorously, and\nperhaps you'd be right.  And indeed the upcoming GHC 6.8 does exactly\nthat.\n-}\n\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule GivenCheck where\n\ntype family S x\n\nf :: a -> S a\nf = undefined\n\ng :: S a ~ Char => a -> Char\ng y   | False           = f y\n      | otherwise       = 'a'\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule GivenCheckDecomp where\n\ntype family S x\n\nf :: a -> S a\nf = undefined\n\ng :: [S a] ~ [Char] => a -> Char\ng y   | 'a' == 'b'      = f y\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule GivenCheckSwapMain where\n\ntype family S x\n\nf :: a -> S a\nf = undefined\n\ng :: Char ~ S a => a -> Char\ng y   | False           = f y\n      | otherwise       = 'a'\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule GivenCheckTop where \n\ntype family S x\n\ntype instance S [e] = e \n\nf :: a -> S a\nf = undefined\n\ng :: S [a] ~ Char => a -> Char\ng y = y\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeOperators, RankNTypes #-}\n\nmodule HO where\n\nimport Data.IORef\nimport Data.Kind\n\ntype family SMRef    (m::(Type -> Type)) :: Type -> Type\ntype family SMMonad  (r::(Type -> Type)) :: Type -> Type\n\ntype instance SMRef   IO        = IORef\ntype instance SMMonad IORef     = IO\n\n\nclass SMMonad (SMRef m) ~ m => SM m where\n        new   :: forall a. a -> m (SMRef m a)\n        read  :: forall a. (SMRef m a) -> m a\n        write :: forall a. (SMRef m a) -> a -> m ()\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Imp\nwhere\n\nimport Exp (C, T, S)\n\ninstance C Int where\n  data T Int = TInt\n\ndata instance S Int Bool = SIntBool\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- Test type families\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\ndata family T a :: Type\n\ndata instance T Bool = TBool !Bool\n\nclass C a where\n  foo :: (a -> a) -> T a -> T a\n\ninstance C Bool where\n  foo f (TBool x) = TBool $ f (not x)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nimport Ind2_help(C(..))\n\nzipT :: (C a, C b) => T a -> T b -> T (a,b)\nzipT x y = mkT (unT x, unT y)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Ind2_help where\n\nimport Data.Kind (Type)\n\nclass C a where\n  data T a :: Type\n  unT :: T a -> a\n  mkT :: a -> T a\n\ninstance (C a, C b) => C (a,b) where\n  data T (a,b) = TProd (T a) (T b)\n  unT (TProd x y) = (unT x, unT y)\n  mkT (x,y)       = TProd (mkT x) (mkT y)\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This used lots of memory, and took a long time to compile, with GHC 6.12:\n-- http://www.haskell.org/pipermail/glasgow-haskell-users/2010-May/018835.html\n\n{-# LANGUAGE FlexibleContexts, TypeFamilies #-}\n\nmodule IndTypesPerf where\n\nimport IndTypesPerfMerge\n\ndata Rec1 = Rec1 !Int\n\nmkRec1 v = mk $ merge v () where mk (Tagged i :* ()) = Rec1 i\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, TypeFamilies, UndecidableInstances,\n             ScopedTypeVariables, TypeOperators,\n             FlexibleInstances, NoMonomorphismRestriction,\n             MultiParamTypeClasses, FlexibleContexts #-}\nmodule IndTypesPerfMerge where\n\ndata a :* b = a :* b\ninfixr 6 :*\n\ndata TRUE\ndata FALSE\ndata Zero\ndata Succ a\n\ntype family Equals m n\ntype instance Equals Zero Zero = TRUE\ntype instance Equals (Succ a) Zero = FALSE\ntype instance Equals Zero (Succ a) = FALSE\ntype instance Equals (Succ a) (Succ b) = Equals a b\n\ntype family LessThan m n\ntype instance LessThan Zero Zero = FALSE\ntype instance LessThan (Succ n) Zero = FALSE\ntype instance LessThan Zero (Succ n) = TRUE\ntype instance LessThan (Succ m) (Succ n) = LessThan m n\n\nnewtype Tagged n a = Tagged a deriving (Show,Eq)\n\ntype family Cond p a b\n\ntype instance Cond TRUE a b = a\ntype instance Cond FALSE a b = b\n\nclass Merger a where\n    type Merged a\n    type UnmergedLeft a\n    type UnmergedRight a\n    mkMerge :: a -> UnmergedLeft a -> UnmergedRight a -> Merged a\n\nclass Mergeable a b where\n    type MergerType a b\n    merger :: a -> b -> MergerType a b\n\n{-\nmerge ::\n    forall a b.\n    (Merger (MergerType a b), Mergeable a b,\n     UnmergedLeft (MergerType a b) ~ a,\n     UnmergedRight (MergerType a b) ~ b) =>\n    a -> b -> Merged (MergerType a b)\n-}\nmerge x y = mkMerge (merger x y) x y\n\n\n{- ------------- NASTY TYPE FOR merge -----------------\n   -- See Trac #11408\n\n   x:tx, y:ty\n   mkMerge @ gamma\n   merger @ alpha beta\n   merge :: tx -> ty -> tr\n\nConstraints generated:\n   gamma ~ MergerType alpha beta\n   UnmergedLeft gamma ~ tx\n   UnmergedRight gamma ~ ty\n   alpha ~ tx\n   beta ~ ty\n   tr ~ Merged gamma\n   Mergeable tx ty\n   Merger gamma\n\nOne solve path:\n  gamma := t\n  tx := alpha := UnmergedLeft t\n  ty := beta  := UnmergedRight t\n\n  Mergeable (UnmergedLeft t) (UnmergedRight t)\n  Merger t\n  t ~ MergerType (UnmergedLeft t) (UnmergedRight t)\n\n  LEADS TO AMBIGUOUS TYPE\n\nAnother solve path:\n  tx := alpha\n  ty := beta\n  gamma := MergerType alpha beta\n\n  UnmergedLeft (MergerType alpha beta) ~ alpha\n  UnmergedRight (MergerType alpha beta) ~ beta\n  Merger (MergerType alpha beta)\n  Mergeable alpha beta\n\n  LEADS TO NON-AMBIGUOUS TYPE\n---------------  -}\n\n\ndata TakeRight a\ndata TakeLeft a\ndata DiscardRightHead a b c d\ndata LeftHeadFirst a b c d\ndata RightHeadFirst a b c d\ndata EndMerge\n\ninstance Mergeable () () where\n    type MergerType () () = EndMerge\n    merger = undefined\n\ninstance Mergeable () (a :* b) where\n    type MergerType () (a :* b) = TakeRight (a :* b)\n    merger = undefined\ninstance Mergeable (a :* b) () where\n    type MergerType (a :* b) () = TakeLeft (a :* b)\n    merger = undefined\n\ninstance Mergeable (Tagged m a :* t1) (Tagged n b :* t2) where\n    type MergerType (Tagged m a :* t1) (Tagged n b :* t2) =\n        Cond (Equals m n) (DiscardRightHead (Tagged m a) t1 (Tagged n b) t2)\n           (Cond (LessThan m n) (LeftHeadFirst (Tagged m a) t1 (Tagged n b) t2)\n               (RightHeadFirst (Tagged m a ) t1 (Tagged n b) t2))\n    merger = undefined\n\ninstance Merger EndMerge where\n    type Merged EndMerge = ()\n    type UnmergedLeft EndMerge = ()\n    type UnmergedRight EndMerge = ()\n    mkMerge _ () () = ()\n\ninstance Merger (TakeRight a) where\n    type Merged (TakeRight a) = a\n    type UnmergedLeft (TakeRight a) = ()\n    type UnmergedRight (TakeRight a) = a\n    mkMerge _ () a = a\n\ninstance Merger (TakeLeft a) where\n    type Merged (TakeLeft a) = a\n    type UnmergedLeft (TakeLeft a) = a\n    type UnmergedRight (TakeLeft a) = ()\n    mkMerge _ a () = a\n\ninstance\n    (Mergeable t1 t2,\n     Merger (MergerType t1 t2),\n     t1 ~ UnmergedLeft (MergerType t1 t2),\n     t2 ~ UnmergedRight (MergerType t1 t2)) =>\n    Merger (DiscardRightHead h1 t1 h2 t2) where\n    type Merged (DiscardRightHead h1 t1 h2 t2) = h1 :* Merged (MergerType t1 t2)\n    type UnmergedLeft (DiscardRightHead h1 t1 h2 t2) = h1 :* t1\n    type UnmergedRight (DiscardRightHead h1 t1 h2 t2) = h2 :* t2\n    mkMerge _ (h1 :* t1) (h2 :* t2) = h1 :* mkMerge (merger t1 t2) t1 t2\n\ninstance\n    (Mergeable t1 (h2 :* t2),\n     Merger (MergerType t1 (h2 :* t2)),\n     t1 ~ UnmergedLeft (MergerType t1 (h2 :* t2)),\n     (h2 :* t2) ~ UnmergedRight (MergerType t1 (h2 :* t2))) =>\n    Merger (LeftHeadFirst h1 t1 h2 t2) where\n    type Merged (LeftHeadFirst h1 t1 h2 t2) = h1 :* Merged (MergerType t1 (h2 :* t2))\n    type UnmergedLeft (LeftHeadFirst h1 t1 h2 t2) = h1 :* t1\n    type UnmergedRight (LeftHeadFirst h1 t1 h2 t2) = h2 :* t2\n    mkMerge _ (h1 :* t1) (h2 :* t2) = h1 :* mkMerge (merger t1 (h2 :* t2)) t1 (h2 :* t2)\n\ninstance\n    (Mergeable (h1 :* t1) t2,\n     Merger (MergerType (h1 :* t1) t2),\n     (h1 :* t1) ~ UnmergedLeft (MergerType (h1 :* t1) t2),\n     t2 ~ UnmergedRight (MergerType (h1 :* t1) t2)) =>\n    Merger (RightHeadFirst h1 t1 h2 t2) where\n    type Merged (RightHeadFirst h1 t1 h2 t2) = h2 :* Merged (MergerType (h1 :* t1) t2)\n    type UnmergedLeft (RightHeadFirst h1 t1 h2 t2) = h1 :* t1\n    type UnmergedRight (RightHeadFirst h1 t1 h2 t2) = h2 :* t2\n    mkMerge _ (h1 :* t1) (h2 :* t2) = h2 :* mkMerge (merger (h1 :* t1) t2) (h1 :* t1) t2\n", "num_lines": 173}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeOperators #-}\n\n-- Test infix type constructors in type families\n\nmodule Infix where\n\ntype family x :+: y\ntype instance Int :+: Int = Int\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n{-# LANGUAGE EmptyDataDecls, FlexibleInstances, UndecidableInstances #-}\n\nmodule InstContextNorm\nwhere\n\nimport Data.Kind (Type)\n\ndata EX _x _y (p :: Type -> Type)\ndata ANY\n\nclass Base p\n\nclass Base (Def p) => Prop p where\n type Def p\n\ninstance Base ()\ninstance Prop () where\n type Def () = ()\n\ninstance (Base (Def (p ANY))) => Base (EX _x _y p)\ninstance (Prop (p ANY)) => Prop (EX _x _y p) where\n type Def (EX _x _y p) = EX _x _y p\n\n\ndata FOO x\n\ninstance Prop (FOO x) where\n type Def (FOO x) = ()\n\ndata BAR\n\ninstance Prop BAR where\n type Def BAR = EX () () FOO\n  \n  -- Needs Base (Def BAR)\n  -- And (Def Bar = Ex () () FOO)\n  -- so we need Base (Def (Foo ANY))\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule InstEqContext  where\n\n\n{- encoding of\n -      class C a | -> a\n -}\nclass a ~ Int => C a\n\ninstance C Int\n\nunC :: (C a) => a -> Int\nunC i = undefined\n\ntest :: Int\ntest = unC undefined\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies, EmptyDataDecls #-}\n\nmodule InstEqContext2  where \n\ndata E v a = E a\ndata RValue\n\ninstance (Eq a, v ~ RValue) => Eq (E v a) where\n    E x == E y  =  x == y\n\na :: E v Int\na = undefined\n\nfoo = a == a\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule InstEqContext  where\n\n\n{- encoding of\n -      class C a | -> a\n - with extra indirection\n -}\nclass a ~ Int => D a\ninstance D Int\n\nclass D a => C a\ninstance C Int\n\nunC :: (C a) => a -> Int\nunC i = undefined\n\ntest :: Int\ntest = unC undefined\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Kind where\n\nimport Data.Kind (Type)\n\nclass C (a :: Type -> Type) where\n  type T a\n\nfoo :: a x -> T a\nfoo = undefined\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule NewTyCo1 where\n\ndata family T a\nnewtype instance T Int = TInt Int\n\nfoo :: T Int -> Int\nfoo (TInt n) = n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule NewTyCo2 where\n\nimport NewTyCo1\n\nbar x = foo x + 1\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE TypeFamilies, EmptyDataDecls, FlexibleContexts #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}\n\nmodule NonLinearLHS where\n\ntype family E a b\ntype instance E a a = [a]\n\nfoo :: E [Int] (E Int Int) -> Int\nfoo = sum . concat\n\ndata family F a b\ndata instance F a a = MkF [a]\n\ngoo :: F Int Int -> F Bool Bool\ngoo (MkF xs) = MkF $ map odd xs\n\n\n-- HList-like type equality\n\ndata True; data False;\n\ntype family EqTy a b\ntype instance EqTy a a = True\n\nclass EqTyP a b result\ninstance (EqTy a b ~ isEq, Proxy isEq result) => EqTyP a b result\n\nclass Proxy inp out\ninstance (result ~ True) => Proxy True result\ninstance (result ~ False) => Proxy notTrue result\n\ntestTrue :: EqTyP Int Int r => r\n-- Weird test case: (EqTyP Int Int) is simplifiable\ntestTrue = undefined\n\ntestFalse :: EqTyP Int Bool r => r\n-- Weird test case: (EqTyP Int Bool) is simplifiable\ntestFalse = undefined\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule Numerals where\n\nimport Data.Kind\n\ndata Z          -- empty data type\ndata S a        -- empty data type\n\ndata SNat n where  -- natural numbers as singleton type\n  Zero :: SNat Z\n  Succ :: SNat n -> SNat (S n)\n\nzero  = Zero\none   = Succ zero\ntwo   = Succ one\nthree = Succ two\n-- etc...we really would like some nicer syntax here\n\ntype family (:+:) n m :: Type\ntype instance Z     :+: m = m\ntype instance (S n) :+: m = S (n :+: m)\n\nadd :: SNat n -> SNat m -> SNat (n :+: m)\nadd Zero     m = m\nadd (Succ n) m = Succ (add n m)\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap1 where\n\ntype family F a where\n  F Int = Int\n  F a = Bool\n\ng :: F Int\ng = 5\n\nh :: F Char\nh = False\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}\n\nmodule Overlap12 where\n\ntype family And (a :: Bool) (b :: Bool) :: Bool where\n  And False x = False\n  And True x = x\n  And x False = False\n  And x True = x\n  And x x = x\n\ndata Proxy p = P\n\na :: Proxy (And False x)\na = (P :: Proxy False)\n\nb :: Proxy x -> Proxy (And True x)\nb x = x\n\nc :: Proxy (And x False)\nc = (P :: Proxy False)\n\nd :: Proxy x -> Proxy (And x True)\nd x = x\n\ne :: Proxy x -> Proxy (And x x)\ne x = x\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap13 where\n\ntype family F a b where\n  F a a = Int\n  F a Int = Int\n  F a b = b\n\ng :: a -> F a Int\ng x = (5 :: Int)\n\n\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap14 where\n\nimport Data.Proxy\n\ntype family F a b c where\n  F a a Int = Int\n  F b c d   = Bool\n\nfoo :: Proxy b -> F b [b] Bool\nfoo _ = False\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap2 where\n\ntype family F a b where\n  F a a = Int\n  F a b = Bool\n\ng :: F Char Double\ng = False\n\nh :: F Double Double\nh = -2\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}\n\nmodule OversatDecomp where\n\nimport Data.Kind (Type)\n\nclass Blah f a where\n  blah :: a -> T f f a\n\nclass A (f :: Type -> Type) where\n  type T f :: (Type -> Type) -> Type -> Type\n\nwrapper :: Blah f a => a -> T f f a\nwrapper x = blah x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeFamilies #-}\nmodule PushedInAsGivens where\n\n\ntype family F a\n\n\n\nbar y = let foo :: (F Int ~ [a]) => a -> Int\n            foo x = length [x,y]\n        in (y,foo y)\n\n\n-- This example demonstrates why we need to push in\n-- an unsolved wanted as a given and not a given/solved.\n-- [Wanted] F Int ~ [beta]\n--- forall a. F Int ~ [a] => a ~ beta\n-- We push in the [Wanted] as given, it will interact and solve the implication\n-- constraint, and finally we quantify over F Int ~ [beta]. If we push it in as\n-- Given/Solved, it will be discarded when we meet the given (F Int ~ [a]) and\n-- we will not be able to solve the implication constraint.\n\n-- Oct 14: actually this example is _really_ strange, and doesn't illustrate\n-- the real issue in Trac #4935, for which there is a separate test\n--\n-- The example here requires us to infer a type\n--   bar :: F Int ~ [a] => ...\n-- which is a strange type to quantify over; better to complain about\n-- having no instance for F Int.\n\n\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- See Trac #1204\n\nmodule ShouldCompile where\n\ndata FooC = FooC\n\ndata family T c\ndata instance T FooC = MkT { moo :: Int }\n\nt1 :: Int -> T FooC\nt1 i = MkT { moo = i }\n\nt2 :: T FooC -> Int\nt2 (MkT { moo = i }) = i\n\nt3 :: T FooC -> Int\nt3 m = moo m\n\nf :: T FooC -> T FooC\nf r = r { moo = 3 }\n\n\n------------------------------------------------------------------------------\nclass D c where\n  data D1 c\n  works :: Int -> D1 c -> D1 c\n  buggy :: Int -> D1 c -> D1 c\n  buggy2 :: Int -> D1 c -> D1 c\n\ninstance D FooC where\n  data D1 FooC = D1F { noo :: Int }\n\n  works x d = d  -- d unchanged, so OK\n\n  buggy x d@(D1F { noo = k }) =\n    d { noo = k + x }\n\n  buggy2 x d@(D1F { noo = k }) =\n    (d :: D1 FooC) { noo = k + x }\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs, GADTs, StandaloneDeriving, DataKinds, KindSignatures, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}\n\n-- Implementation of deletion for red black trees by Matt Might\n-- Editing to preserve the red/black tree invariants by Stephanie Weirich,\n-- Dan Licata and John Hughes, at WG2.8 August 2014\n\n-- Original available from:\n--   http://matt.might.net/articles/red-black-delete/code/RedBlackSet.hs\n-- Slides:\n--   http://matt.might.net/papers/might2014redblack-talk.pdf\n\nmodule MightRedBlackGADT where\n\nimport Prelude hiding (max)\nimport Data.List(nub,sort)\nimport Control.Monad(liftM)\nimport Data.Type.Equality\nimport Data.Kind (Type)\nimport Data.Maybe(isJust)\n\n--\ndata Color = Red | Black | DoubleBlack | NegativeBlack\n\n-- Singleton type, connects the type level color to data\n-- not necessary in a full-spectrum dependently-typed language\ndata SColor (c :: Color) where\n   R  :: SColor Red -- red\n   B  :: SColor Black -- black\n   BB :: SColor DoubleBlack -- double black\n   NB :: SColor NegativeBlack -- negative black\n\n\n-- natural numbers for tracking the black height\ndata Nat = Z | S Nat\n\n-- Well-formed Red/Black trees\n-- n statically tracks the black height of the tree\n-- c statically tracks the color of the root node\ndata CT (n :: Nat) (c :: Color) (a :: Type) where\n   E  :: CT Z Black a\n   T  :: Valid c c1 c2 =>\n         SColor c -> (CT n c1 a) -> a -> (CT n c2 a) -> CT (Incr c n) c a\n\n-- this type class forces the children of red nodes to be black\n-- and also excludes double-black and negative-black nodes from\n-- a valid red-black tree.\nclass Valid (c :: Color) (c1 :: Color) (c2 :: Color) where\ninstance Valid Red Black Black\ninstance Valid Black c1 c2\n\n-- incrementing the black height, based on the color\ntype family Incr (c :: Color) (n :: Nat) :: Nat\ntype instance Incr Black n             = S n\ntype instance Incr DoubleBlack n       = S (S n)\ntype instance Incr Red   n             = n\ntype instance Incr NegativeBlack (S n) = n\n\n-- the top level type of red-black trees\n-- the data constructor forces the root to be black and\n-- hides the black height.\ndata RBSet a where\n  Root :: (CT n Black a) -> RBSet a\n\nderiving instance Show (SColor c)\nderiving instance Show a => Show (CT n c a)\ninstance Show a => Show (RBSet a) where\n  show (Root x) = show x\n\n\nshowT :: CT n c a -> String\nshowT E = \"E\"\nshowT (T c l x r) =\n    \"(T \" ++ show c ++ \" \" ++ showT l ++ \" \"\n          ++ \"...\" ++ \" \" ++ showT r ++ \")\"\n\n\n-- the test equality class gives us a proof that type level\n-- colors are equal.\n-- testEquality :: SColor c1 -> SColor c2 -> Maybe (c1 ~ c2)\ninstance TestEquality SColor where\n  testEquality R R   = Just Refl\n  testEquality B B   = Just Refl\n  testEquality BB BB = Just Refl\n  testEquality NB NB = Just Refl\n  testEquality _ _   = Nothing\n\n-- comparing two Red/Black trees for equality.\n-- unfortunately, because we have two instances, we can't\n-- use the testEquality class.\n(%==%) :: Eq a => CT n1 c1 a -> CT n2 c2 a -> Bool\nE %==% E = True\nT c1 a1 x1 b1 %==% T c2 a2 x2 b2 =\n  isJust (testEquality c1 c2) && a1 %==% a2 && x1 == x2 && b1 %==% b2\n\ninstance Eq a => Eq (RBSet a) where\n  (Root t1) == (Root t2) = t1 %==% t2\n\n\n -- Public operations --\n\nempty :: RBSet a\nempty = Root E\n\nmember :: (Ord a) => a -> RBSet a -> Bool\nmember x (Root t) = aux x t where\n  aux :: Ord a => a -> CT n c a -> Bool\n  aux x E = False\n  aux x (T _ l y r) | x < y     = aux x l\n                    | x > y     = aux x r\n                    | otherwise = True\n\nelements :: Ord a => RBSet a -> [a]\nelements (Root t) = aux t [] where\n      aux :: Ord a => CT n c a -> [a] -> [a]\n      aux E acc = acc\n      aux (T _ a x b) acc = aux a (x : aux b acc)\n\n -- INSERTION --\n\ninsert :: (Ord a) => a -> RBSet a -> RBSet a\ninsert x (Root s) = blacken (ins x s)\n where ins :: Ord a => a -> CT n c a -> IR n a\n       ins x E = IN R E x E\n       ins x s@(T color a y b) | x < y     = balanceL color (ins x a) y b\n                               | x > y     = balanceR color a y (ins x b)\n                               | otherwise = (IN color a y b)\n\n\n       blacken :: IR n a -> RBSet a\n       blacken (IN _ a x b) = Root (T B a x b)\n\n-- an intermediate data structure that temporarily violates the\n-- red-black tree invariants during insertion. (IR stands for infra-red).\n-- This tree must be non-empty, but is allowed to have two red nodes in\n-- a row.\ndata IR n a where\n   IN :: SColor c -> CT n c1 a -> a -> CT n c2 a -> IR (Incr c n) a\n\n-- `balance` rotates away coloring conflicts\n-- we separate it into two cases based on whether the infraction could\n-- be on the left or the right\n\nbalanceL :: SColor c -> IR n a -> a -> CT n c1 a -> IR (Incr c n) a\nbalanceL B (IN R (T R a x b) y c) z d = IN R (T B a x b) y (T B c z d)\nbalanceL B (IN R a x (T R b y c)) z d = IN R (T B a x b) y (T B c z d)\nbalanceL c (IN B a x b) z d           = IN c (T B a x b) z d\nbalanceL c (IN R a@(T B _ _ _) x b@(T B _ _ _)) z d = IN c (T R a x b) z d\nbalanceL c (IN R a@E x b@E) z d       = IN c (T R a x b) z d\n\n\nbalanceR :: SColor c -> CT n c1 a -> a -> IR n a -> IR (Incr c n) a\nbalanceR B a x (IN R (T R b y c) z d) = IN R (T B a x b) y (T B c z d)\nbalanceR B a x (IN R b y (T R c z d)) = IN R (T B a x b) y (T B c z d)\nbalanceR c a x (IN B b z d)           = IN c a x (T B b z d)\nbalanceR c a x (IN R b@(T B _ _ _) z d@(T B _ _ _)) = IN c a x (T R b z d)\nbalanceR c a x (IN R b@E z d@E)       = IN c a x (T R b z d)\n\n\n -- DELETION --\n\n-- like insert, delete relies on a helper function that may (slightly)\n-- violate the red-black tree invariant\n\ndelete :: (Ord a) => a -> RBSet a -> RBSet a\ndelete x (Root s) = blacken (del x s)\n where blacken :: DT n a -> RBSet a\n       blacken (DT B a x b)  = Root (T B a x b)\n       blacken (DT BB a x b) = Root (T B a x b)\n       blacken DE  = Root E\n       blacken DEE = Root E\n       -- note: del always produces a black or\n       -- double black tree. These last two cases are unreachable\n       -- but it may be difficult to prove it.\n       blacken (DT R a x b) = Root (T B a x b)\n       blacken (DT NB a x b) = Root (T B a x b)\n\n       del :: Ord a => a -> CT n c a -> DT n a\n       del x E = DE\n       del x s@(T color a y b) | x < y     = bubbleL color (del x a) y b\n                               | x > y     = bubbleR color a y (del x b)\n                               | otherwise = remove s\n\n\n-- deletion tree, the result of del\n-- could have a double black node\n-- (but only at the top or as a single leaf)\ndata DT n a where\n  DT  :: SColor c -> CT n c1 a -> a -> CT n c2 a -> DT (Incr c n) a\n  DE  :: DT Z a\n  DEE :: DT (S Z) a\n\n-- Note: we could unify this with the IR data structure by\n-- adding the DE and DEE data constructors. That would allow us to\n-- reuse the same balancing function (and blacken function)\n-- for both insertion and deletion.\n-- However, if an Agda version did that it might get into trouble,\n-- trying to show that insertion never produces a leaf.\n\n\ninstance Show a => Show (DT n a) where\n  show DE = \"DE\"\n  show DEE = \"DEE\"\n  show (DT c l x r) =\n    \"(DT \" ++ show c ++ \" \" ++ show l ++ \" \"\n           ++ \"...\" ++ \" \" ++ show r ++ \")\"\n\n-- Note: eliding a to make error easier below.\nshowDT :: DT n a -> String\nshowDT DE = \"DE\"\nshowDT DEE = \"DEE\"\nshowDT (DT c l x r) =\n    \"(DT \" ++ show c ++ \" \" ++ showT l ++ \" \"\n           ++ \"...\" ++ \" \" ++ showT r ++ \")\"\n\n\n-- maximum element from a red-black tree\nmax :: CT n c a -> a\nmax E = error \"no largest element\"\nmax (T _ _ x E) = x\nmax (T _ _ x r) = max r\n\n-- Remove the top node: it might leave behind a double black node\n-- if the removed node is black (note that the height is preserved)\nremove :: CT n c a -> DT n a\nremove (T R E _ E) = DE\nremove (T B E _ E) = DEE\nremove (T B E _ (T R a x b)) = DT B a x b\nremove (T B (T R a x b) _ E) = DT B a x b\nremove (T color l y r) = bubbleL color (removeMax l) (max l) r\n\n-- remove the maximum element of the tree\nremoveMax :: CT n c a -> DT n a\nremoveMax E                 = error \"no maximum to remove\"\nremoveMax s@(T _ _ _ E)     = remove s\nremoveMax s@(T color l x r) = bubbleR color l x (removeMax r)\n\n-- make a node more red (i.e. decreasing its black height)\n-- note that the color of the resulting node is not part of the\n-- result height because the result of this operation doesn't\n-- necessarily satisfy the RBT invariants\nredden :: CT (S n) c a -> DT n a\nredden (T B a x y)  = DT R a x y\nredden (T BB a x y) = DT B a x y\nredden (T R a x y)  = DT NB a x y\n\n-- assert that a tree is red. Dynamically fail otherwise\n-- this is a cheat that Haskell let's us get away with, but Agda\n-- would not\nassertRed :: DT n a -> CT n Red a\nassertRed (DT R (T B aa ax ay) x (T B ac az ad)) =\n  (T R (T B aa ax ay) x (T B ac az ad))\nassertRed t = error (\"not a red tree \" ++ showDT t)\n\ndbalanceL :: SColor c -> DT n a -> a -> CT n c1 a -> DT (Incr c n) a\n-- reshuffle (same as insert)\ndbalanceL B (DT R (T R a x b) y c) z d = DT R (T B a x b) y (T B c z d)\ndbalanceL B (DT R a x (T R b y c)) z d = DT R (T B a x b) y (T B c z d)\n-- double-black (new for delete)\ndbalanceL BB (DT R (T R a x b) y c) z d = DT B (T B a x b) y (T B c z d)\ndbalanceL BB (DT R a x (T R b y c)) z d = DT B (T B a x b) y (T B c z d)\ndbalanceL BB (DT NB a@(T B _ _ _) x (T B b y c)) z d =\n  case (dbalanceL B (redden a) x b) of\n    r@(DT R _ _ _)  -> DT B (assertRed r)  y (T B c z d)\n    (DT B a1 x1 y1) -> DT B (T B a1 x1 y1) y (T B c z d)\n-- fall through cases (same as insert)\ndbalanceL c (DT B a x b) z d                         = DT c (T B a x b) z d\ndbalanceL c (DT R a@(T B _ _ _) x b@(T B _ _ _)) z d = DT c (T R a x b) z d\ndbalanceL c (DT R a@E x b@E) z d                     = DT c (T R a x b) z d\n-- more fall through cases (new for delete)\ndbalanceL c DE x b = (DT c E x b)\ndbalanceL c a x b = error (\"no case for \" ++ showDT a)\n\n\ndbalanceR :: SColor c -> CT n c1 a -> a -> DT n a -> DT (Incr c n) a\ndbalanceR B a x (DT R (T R b y c) z d) = DT R (T B a x b) y (T B c z d)\ndbalanceR B a x (DT R b y (T R c z d)) = DT R (T B a x b) y (T B c z d)\ndbalanceR BB a x (DT R (T R b y c) z d) = DT B (T B a x b) y (T B c z d)\ndbalanceR BB a x (DT R b y (T R c z d)) = DT B (T B a x b) y (T B c z d)\ndbalanceR BB a x (DT NB (T B b y c) z d@(T B _ _ _)) =\n  case (dbalanceR B c z (redden d)) of\n        r@(DT R _ _ _)  -> DT B (T B a x b) y (assertRed r)\n        (DT B a1 x1 y1) -> DT B (T B a x b) y (T B a1 x1 y1)\n\ndbalanceR c a x (DT B b z d)           = DT c a x (T B b z d)\ndbalanceR c a x (DT R b@(T B _ _ _) z d@(T B _ _ _)) = DT c a x (T R b z d)\ndbalanceR c a x (DT R b@E z d@E) = DT c a x (T R b z d)\ndbalanceR c a x DE = DT c a x E\ndbalanceR c a x b = error (\"no case for \" ++ showDT b)\n\n\nbubbleL :: SColor c -> DT n a -> a -> CT n c1 a -> DT (Incr c n) a\n-- don't want to prove generally that\n-- (Incr (Blacker c) 'Z ~ Incr c ('S 'Z)) so expand by cases.\n-- (Note: Do we need all three of these cases?)\nbubbleL B DEE x r   = dbalanceR BB E x (redden r)\nbubbleL R DEE x r   = dbalanceR B E x (redden r)\nbubbleL NB DEE x r  = dbalanceR R E x (redden r)\n-- same thing here\nbubbleL B l@(DT BB a y b) x r  = dbalanceR BB (T B a y b) x (redden r)\nbubbleL R l@(DT BB a y b) x r  = dbalanceR B (T B a y b) x (redden r)\nbubbleL NB l@(DT BB a y b) x r = dbalanceR R (T B a y b) x (redden r)\n-- fall through case\nbubbleL color l x r = dbalanceL color l x r\n\n\nbubbleR :: SColor c -> CT n c1 a -> a -> DT n a -> DT (Incr c n) a\nbubbleR B r x DEE    = dbalanceL BB (redden r) x E\nbubbleR R r x DEE    = dbalanceL B  (redden r) x E\nbubbleR NB r x DEE   = dbalanceL R  (redden r) x E\n-- same thing here\nbubbleR B r x l@(DT BB a y b) = dbalanceL BB (redden r) x (T B a y b)\nbubbleR R r x l@(DT BB a y b)  = dbalanceL B (redden r) x (T B a y b)\nbubbleR NB r x l@(DT BB a y b) = dbalanceL R (redden r) x (T B a y b)\n-- fall through case\nbubbleR color l x r = dbalanceR color l x r\n\n", "num_lines": 317}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Refl where\n\nimport Data.Kind (Type)\n\ntype family T a :: Type -> Type\n\nfoo :: a x -> a y\nfoo = undefined\n\nbar :: a -> T a x -> T a y\nbar x t = foo t\n\n{- GHC complains that it could not deduce (T a x ~ T a x) where problem is\nthat with -dppr-debug, we get \"x{tv a7z} [sk]\" on the lhs and \"x{tv a7C}\n[box]\" on the rhs\n -}\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Refl2 where\n\nimport Data.Kind (Type)\n\ntype family T (a :: Type -> Type) :: Type -> Type\n\ndata U a x = U (T a x)\n\nmkU :: a x -> U a x\nmkU x = U undefined\n\n-- The first definition says \"Could not deduce (T a x ~ T a x)\", the other two\n-- work fine\n\nfoo :: a x -> U a x\nfoo x = case mkU x of U t -> id (U t)\n-- foo x = case mkU x of U t -> id ((U :: T a x -> U a x) t)\n-- foo x = case mkU x of U t -> U t\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule RelaxedExamples where\n\ntype family F1 a\ntype family F2 a\ntype family F3 a\ntype family F4 a\n\ntype instance F1 x      = x\ntype instance F2 [Bool] = F2 Char\ntype instance F3 (a, b) = (F3 a, F3 b)\ntype instance F4 x      = (x, x)", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes #-}\n\n-- This test made the type checker produce an\n-- ill-kinded coercion term.\n\nmodule Roman where\n\nimport Control.Monad.ST\nimport Data.Kind (Type)\n\ntype family Mut (v :: Type -> Type) :: Type -> Type -> Type\ntype family State (m :: Type -> Type)\ntype instance State (ST s) = s\n\nunsafeFreeze :: Mut v (State (ST s)) a -> ST s (v a)\nunsafeFreeze = undefined\n\nnew :: (forall v s. ST s (v s a)) -> v a\nnew p = runST (do\n                 mv <- p\n                 unsafeFreeze mv)\n\n---------------------------------------------\n-- Here's a simpler version that also failed\n\ntype family FMut :: Type -> Type      -- No args\n                                      -- Same thing happens with one arg\n\ntype family   FState (m :: Type)\ntype instance FState Char = Int\n\nfunsafeFreeze :: FMut (FState Char) -> ()\nfunsafeFreeze = undefined\n\nflop :: forall mv. mv Int\nflop = undefined\n\nnoo =  flop `rapp` funsafeFreeze\n\nrapp :: a -> (a->()) -> ()\nrapp arg fun = fun arg\n\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Rules1 where\n\nclass C a where\n  data T a\n\ninstance (C a, C b) => C (a,b) where\n  data T (a,b) = TPair (T a) (T b)\n\nmapT :: (C a, C b) => (a -> b) -> T a -> T b\n{-# NOINLINE mapT #-}  -- Otherwwise we get a warning from the rule\nmapT = undefined\n\nzipT :: (C a, C b) => T a -> T b -> T (a,b)\n{-# NOINLINE [1] zipT #-}\nzipT = undefined\n\n{-# RULES\n\n\"zipT/mapT\" forall f x y.\n  zipT (mapT f x) y = mapT (\\(x,y) -> (f x, y)) (zipT x y)\n\n #-}\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\nclass C a where\n  data Sd a :: Type\n  data Sn a :: Type\n  type St a :: Type\n\ninstance C Int where\n  data    Sd Int = SdC Char\n  newtype Sn Int = SnC Char\n  type    St Int = Char\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple10 where\n\ntype family T a\n\nfoo, bar :: T a -> a\nfoo = undefined\nbar x = foo x\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple11 where\n\ntype family F a\n\nsame :: a -> a -> a\nsame = undefined\n\nmkf :: a -> F a\nmkf p = undefined\n\n-- Works with explicit signature\n-- foo :: a -> a -> (F a, a)\nfoo p q = same (mkf p, p) (mkf q, q)\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple12 where\n\ntype family F a\n\nsame :: a -> a -> a\nsame = undefined\n\nmkf :: a -> F a\nmkf p = undefined\n\n-- works with either of these signatures\n-- foo :: a ~ F a => a -> a\n-- foo :: a ~ F a => a -> F a\nfoo p = same p (mkf p)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- This should fail, I think, because of the loopy equality,\n-- but the error message is hopeless\n\nmodule Simple13 where\n\ntype family F a\n\nsame :: a -> a -> a\nsame = undefined\n\nmkf :: a -> [F a]\nmkf p = undefined\n\nfoo :: a ~ [F a] => a -> a\nfoo p = same p (mkf p)\n\n{- p :: a\n\n  [G] g : a ~ [F a]\n  [W] w : a ~ [F a]\n\n---> \n  g' = g;[x]                g'=aq4\n  [G] g'  : a ~ [fsk]       g=aqW\n  [W] x : F a ~ fsk         x=aq3\n\n  [W] w : a ~ [F a]\n\n  --> subst a\n       x = F g' ; x2\n   [W] x2 : F fsk ~ fsk     x2=aq5\n\n  -->  (subst a)\n      w = g' ; w2\n  [W] w2 : [fsk] ~ [F a]\n\n  --> decompose \n       w2 = [w3]\n   [W] w3 : fsk ~ F a\n\n\n\ncycle is\n   aq3 = Sym (F aq4) ; aq5    x = Sym (F g') ; x2\n   aq4 = apw ; aq3            g' = \n-}\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleContexts, ScopedTypeVariables #-}\n\nmodule Simple14 where\n\ndata EQ_ x y = EQ_\n\n-- Nov 2014: actually eqE has an ambiguous type\neqE :: EQ_ x y -> (x~y => EQ_ z z) -> p\neqE = error \"eqE\"\n\neqI :: EQ_ x x\neqI = error \"eqI\"\n\nntI :: (forall p. EQ_ x y -> p) -> EQ_ x y\nntI = error \"ntI\" \n\nfoo :: forall m n. EQ_ (Maybe m) (Maybe n)\nfoo = ntI (`eqE` (eqI :: EQ_ m n))\n-- Alternative\n-- foo = ntI (\\eq -> eq `eqE` (eqI :: EQ_ m n))\n\n-- eq :: EQ_ (Maybe m) (Maybe n)\n-- Need (Maybe m ~ Maybe n) =>  EQ_ m n ~ EQ_ zeta zeta\n-- which redues to (m~n) => m ~ zeta\n-- but then we are stuck", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple15 where\n\n(<$) :: p -> (p -> q) -> q\nx <$ f = f x\n\ntype family Def p\n\ndef :: Def p -> p\ndef = undefined\n\ndata EQU a b = EQU\n\nequ_refl :: EQU a a\nequ_refl = EQU\n\ndata FOO = FOO\ntype instance Def FOO = EQU () ()\n\nfoo :: FOO\nfoo = equ_refl Simple15.<$ def\n-- This works:\n-- foo = def $ equ_refl\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-- submitted by g9ks157k@acme.softbase.org as #1713\nmodule TypeFamilyBug where\n\nimport Data.Kind (Type)\n\ntype family TestFamily a :: Type\n\ntype instance TestFamily () = [()]\n\ntestFunction :: value -> TestFamily value -> ()\ntestFunction = const (const ())\n\ntestApplication :: ()\ntestApplication = testFunction () (return ())\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Simple17 where\n\nfoo :: Int -> Int\nfoo n = bar n\n  where\n    bar :: t ~ Int => Int -> t\n    bar n = n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple18 where\n\ntype family F a\n\ntype instance F Int = [Int]\n\nfoo :: F Int\nfoo = [1]", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, LiberalTypeSynonyms #-}\n                           -- ^ crucial for exercising the code paths to be\n                           --   tested here\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\ntype family Element c :: Type\n\nf :: x -> Element x\nf x = undefined\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nclass C3 a where\n  data S3  a            -- kind is optional\n  data S3n a            -- kind is optional\n  foo3  :: a -> S3 a\n  foo3n :: a -> S3n a\n  bar3  :: S3 a -> a\n  bar3n :: S3n a -> a\n\ninstance C3 Int where\n  data    S3  Int  = D3Int\n  newtype S3n Int  = D3Intn ()\n  foo3  _          = D3Int\n  foo3n _          = D3Intn ()\n  bar3  D3Int      = 1\n  bar3n (D3Intn _) = 1\n\ninstance C3 Char where\n  data S3 Char = D3Char\n  foo3 _       = D3Char\n  bar3 D3Char  = 'c'\n\nbar3' :: S3 Char -> Char\nbar3' D3Char = 'a'\n\ninstance C3 Bool where\n  data S3 Bool = S3_1 | S3_2\n  foo3 False = S3_1\n  foo3 True  = S3_2\n  bar3 S3_1 = False\n  bar3 S3_2 = True\n\n-- It's ok to omit ATs in instances, as it is ok to omit method definitions,\n-- but similar to methods, \"undefined\" is the only inhabitant of these types,\n-- then.\ninstance C3 Float where\n  foo3 1.0 = undefined\n  bar3 _   = 1.0\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\ntype family F a \ntype instance F [a] = [F a]\n\nfoo :: (F [a] ~ a) => a\nfoo = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nimport Prelude hiding (foldr, foldr1)\n\nimport Data.Maybe\n\ntype family Elem x\n\nclass Foldable a where\n  foldr :: (Elem a -> b -> b) -> b -> a -> b\n\n  foldr1 :: (Elem a -> Elem a -> Elem a) -> a -> Elem a\n  foldr1 f xs = fromMaybe (error \"foldr1: empty structure\")\n                  (foldr mf Nothing xs)\n     where mf x Nothing  = Just x\n           mf x (Just y) = Just (f x y)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\ndata X1 = X1\n\nclass C t where\n    type D t\n    f :: t -> D t -> ()\n\ninstance C X1 where\n    type D X1 = Bool -> Bool\n    f _ h = ()\n\nfoo = f X1 (\\x -> x)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nplus :: (a ~ (Int -> Int)) => Int -> a\nplus x y = x + y\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}\n\nmodule Simple24 where\n\nimport Data.Kind (Type)\n\nlinear :: HasTrie (Basis v) => (Basis v, v)\nlinear =  basisValue\n \nclass HasTrie a where\n \ntype family Basis u :: Type\n \nbasisValue :: (Basis v,v)\nbasisValue = error \"urk\"\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\nclass C7 a b where\n  data S7 b :: Type\n\ninstance C7 Char (a, Bool) where\n  data S7 (a, Bool) = S7_1\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\nclass C8 a where\n  data S8 a :: Type -> Type\n\ninstance C8 Int where\n  data S8 Int a = S8Int a\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\ndata family C9 a b :: Type\ndata instance C9 Int Int = C9IntInt\ndata instance C9 [a] Int = C9ListInt\ndata instance C9 [Int] [a]   = C9ListList2\n\ntype family D a\ntype instance D (Int, a) = (Int, a)\ntype instance D (a, Int) = (Int, Int)\n\ntype family E a\ntype instance E (Char, b) = ([Char], b)\ntype instance E (a, Int)  = (String, Int)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nimport Data.IORef\nimport Data.Kind (Type)\n\ndata family T a\ndata instance T a = T\n\nfoo :: T Int -> T Char\nfoo T = T\n\ntype family S a\ntype instance S a = a\n\ntype family SMRef (m:: Type -> Type) :: Type -> Type\ntype instance SMRef IO = IORef\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\nclass C1 a where\n  data S1 a :: Type\n\n-- instance of data families can be data or newtypes\ninstance C1 Char where\n  newtype S1 Char = S1Char ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple8 where\n\ntype family F a\n\n-- Manuel says that duplicate instances are ok. This gives a strange error but\n-- works if one of the duplicates is removed.\n\ntype instance F () = ()\n-- type instance F () = ()\n\nfoo :: F () -> ()\nfoo x = x\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple9 where\n\nimport Data.Kind (Type)\n\n-- The test succeeds with\n--\n-- type family F a b\n-- type instance F () b = Maybe b\n\ntype family F a :: Type -> Type\ntype instance F () = Maybe\n\ntype family G a\ntype instance G (Maybe a) = Int\n\nfoo :: G (F () a) -> Int\nfoo x = x\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From the GHC users mailing list, 3/9/14\n\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Sock where\n\nimport Data.Proxy\nimport Data.Kind\n\ndata Message\n\ndata SocketType = Dealer | Push | Pull\n\ndata SocketOperation = Read | Write\n\ndata SockOp :: SocketType -> SocketOperation -> Type where\n    SRead :: Foo 'Read sock => SockOp sock 'Read\n    SWrite :: Foo Write sock => SockOp sock Write\n\ndata Socket :: SocketType -> Type where\n    Socket :: proxy sock\n           -> (forall op . Foo op sock => SockOp sock op -> Operation op)\n           -> Socket sock\n\ntype family Foo (op :: SocketOperation) (s :: SocketType) :: Constraint where\n    Foo 'Read s = Readable s\n    Foo Write s = Writable s\n\ntype family Operation (op :: SocketOperation) :: Type where\n    Operation 'Read = IO Message\n    Operation Write = Message -> IO ()\n\ntype family Readable (t :: SocketType) :: Constraint where\n    Readable Dealer = ()\n    Readable Pull = ()\n\ntype family Writable (t :: SocketType) :: Constraint where\n    Writable Dealer = ()\n    Writable Push = ()\n\ndealer :: Socket Dealer\ndealer = undefined\n\npush :: Socket Push\npush = undefined\n\npull :: Socket Pull\npull = undefined\n\nreadSocket :: forall sock . Readable sock => Socket sock -> IO Message\nreadSocket (Socket _ f) = f (SRead :: SockOp sock 'Read)\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}\nmodule T10020 where\n\nclass NullaryClass where\n    data NullaryData\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE FlexibleContexts #-}\nmodule T10079 where\n\nimport Control.Applicative\nimport Data.Coerce\n\nbroken :: Bizarre (->) w => w a b t -> ()\nbroken = getConst #. bazaar (Const #. const ())\n\nclass Profunctor p where\n  (#.) :: Coercible c b => (b -> c) -> p a b -> p a c\n\ninstance Profunctor (->) where\n  (#.) = (.)\n\nclass Bizarre p w | w -> p where \n  bazaar :: Applicative f => p a (f b) -> w a b t -> f t\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule T10139 where\n\nimport Data.Monoid\nimport Data.Kind\nimport Data.Coerce\n\nclass Monoid v => Measured v a | a -> v where\n  _measure :: v -> a\ndata FingerTree v a = Dummy v a\nsingleton :: Measured v a => a -> FingerTree v a\nsingleton = undefined\n\nclass DOps a where\n  plus :: a -> D a -> a\n\ntype family D a :: Type\ntype instance D (FingerTree (Size Int, v) (Sized a)) = [Diff (Normal a)]\n\ntype family Normal a :: Type\n\ndata Diff a = Add Int a\n\nnewtype Sized a = Sized a\nnewtype Size a = Size a\n\n-- This works:\n{-\ninstance (Measured (Size Int, v) (Sized a), Coercible (Normal a) (Sized a)) => DOps (FingerTree (Size Int, v) (Sized a)) where\n  plus = foldr (\\(Add index val) seq -> singleton ((coerce) val))\n-}\n\n-- This hangs:\ninstance (Measured (Size Int, v) (Sized a), Coercible (Normal a) (Sized a)) => DOps (FingerTree (Size Int, v) (Sized a)) where\n  plus = foldr (flip f)\n    where f _seq x = case x of\n            Add _index val -> singleton ((coerce) val)\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE AllowAmbiguousTypes #-} -- only necessary in 7.10\n{-# LANGUAGE FlexibleContexts #-}    -- necessary for showFromF' example\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule T10226 where\n\ntype family F    a\ntype family FInv a\n\n-- This definition is accepted in 7.8 without anything extra, but requires\n-- AllowAmbiguousTypes in 7.10 (this, by itself, is not a problem):\nshowFromF :: (Show a, FInv (F a) ~ a) => F a -> String\nshowFromF fa = undefined\n\n-- Consider what happens when we attempt to call `showFromF` at some type b.\n-- In order to check that this is valid, we have to find an a such that\n--\n-- > b ~ F a /\\ Show a /\\ FInv (F a) ~ a\n--\n-- Introducing an intermediate variable `x` for the result of `F a` gives us\n--\n-- > b ~ F a /\\ Show a /\\ FInv x ~ a /\\ F a ~ x\n--\n-- Simplifying\n--\n-- > b ~ x /\\ Show a /\\ FInv x ~ a /\\ F a ~ x\n--\n-- Set x := b\n--\n-- > Show a /\\ FInv b ~ a /\\ F a ~ b\n--\n-- Set a := FInv b\n--\n-- > Show (FInv b) /\\ FInv b ~ FInv b /\\ F (FInv b) ~ b\n--\n-- Simplifying\n--\n-- > Show (FInv b) /\\ F (FInv b) ~ b\n--\n-- Indeed, we can give this definition in 7.8, but not in 7.10:\nshowFromF' :: (Show (FInv b), F (FInv b) ~ b) => b -> String\nshowFromF' = showFromF\n\n{- [G] F (FInv b) ~ b\n   [W] FInv (F alpha) ~ alpha\n   [W] F alpha ~ b\n-->\n   [G] g1: FInv b ~ fsk1\n   [G] g2: F fsk1 ~ fsk2\n   [G} g3: fsk2 ~ b\n\n   [W] F alpha ~ fmv1\n   [W] FInv fmv1 ~ fmv2\n   [W] fmv2 ~ alpha\n   [W] fmv1 ~ b\n\n   [D] d1: F alpha ~ fmv1\n   [D] d2: FInv fmv1 ~ fmv2\n   [D] d3: fmv2 ~ alpha\n   [D] d4: fmv1 ~ b\n\n--> d2 + d4: [D] FInv b ~ fmv2\n       + g1: [D] fmv2 ~ b\n--> d3: b ~ alpha, and we are done\n\n-}\n\n{-------------------------------------------------------------------------------\n  In 7.10 the definition of showFromF' is not accepted, but it gets stranger.\n  In 7.10 we cannot _call_ showFromF at all, even at a concrete type. Below\n  we try to call it at type b ~ Int. It would need to show\n\n  > Show (FInv Int) /\\ F (FInt Int) ~ Int\n\n  all of which should easily get resolved, but somehow don't.\n-------------------------------------------------------------------------------}\n\ntype instance F    Int = Int\ntype instance FInv Int = Int\n\ntest :: String\ntest = showFromF (0 :: Int)\n\n{-\n\n  [WD] FInv (F alpha) ~ alpha\n  [WD] F alpha ~ Int\n\n-->\n  [WD] F alpha ~ fuv0\n* [WD] FInv fuv0 ~ fuv1\n  [WD] fuv1 ~ alpha\n  [WD] fuv0 ~ Int\n\n-->\n  [WD] F alpha ~ fuv0\n  [W] FInv fuv0 ~ fuv1\n*  [D] FInv Int ~ fuv1\n  [WD] fuv1 ~ alpha\n  [WD] fuv0 ~ Int\n\n-->\n  [WD] F alpha ~ fuv0\n  [W] FInv fuv0 ~ fuv1\n* [D] fuv1 ~ Int\n  [WD] fuv1 ~ alpha\n  [WD] fuv0 ~ Int\n\n-->\n  [WD] F alpha ~ fuv0\n  [W] FInv fuv0 ~ fuv1\n  [D] alpha := Int\n  [WD] fuv1 ~ alpha\n  [WD] fuv0 ~ Int\n-}\n", "num_lines": 117}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, TypeSynonymInstances,\n             FlexibleInstances, TypeFamilies,\n             UndecidableSuperClasses #-}\n\nmodule T10318 where\n\nimport Data.Kind (Type)\n\n-- | Product of non-zero elements always non-zero.\n-- Every integral domain has a field of fractions.\n-- The field of fractions of any field is itself.\nclass (Frac (Frac a) ~ Frac a, Fractional (Frac a), IntegralDomain (Frac a))\n  => IntegralDomain a where\n  type Frac a :: Type\n  embed :: a -> Frac a\n\ninstance IntegralDomain Integer where\n  type Frac Integer = Rational\n  embed = fromInteger\n\ninstance IntegralDomain Rational where\n  type Frac Rational = Rational\n  embed = id\n\ng :: IntegralDomain a => a -> a\ng x = g x\n\nh :: a -> Frac a\nh x = h x\n\n-- This is the test function\n\nf :: IntegralDomain a => a -> Frac a\nf x = g (h (h x))\n  -- Given: IntegralDomain (Frac a)\n  -- Wanted: IntegralDomain (Frac (Frac a))\n\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T10340 where\n\nimport GHC.Exts (Any)\n\nclass MonadState s m where\n  get :: m s\n\nnewtype State s a = State (s -> (s, a))\n\ninstance MonadState s (State s) where\n  get = State $ \\s -> (s, s)\n\nfoo :: State Any Any\nfoo = get\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE ExplicitNamespaces #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule T10507 where\n\nimport Data.Type.Equality ( (:~:)(Refl) )\nimport Prelude (Maybe(..), undefined)\nimport GHC.TypeLits ( Nat, type (<=))\n\ndata V (n::Nat)\n\ntestEq :: (m <= n) => V m -> V n -> Maybe (m :~: n)\ntestEq = undefined\n\n\nuext :: (1 <= m, m <= n) => V m -> V n -> V n\nuext e w =\n  case testEq e w of\n    Just Refl -> e\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T10634 where\n\nimport Data.Int (Int8, Int16, Int32)\n\ntype family Up a\ntype instance Up Int8  = Int16\ntype instance Up Int16 = Int32\n\nclass (Up (Down a) ~ a) => Convert a where\n   type Down a\n   down :: a -> Down a\n\ninstance Convert Int16 where\n   type Down Int16 = Int8\n   down = fromIntegral\n\ninstance Convert Int32 where\n   type Down Int32 = Int16\n   down = fromIntegral\n\nx :: Int8\nx = down 8\n\n{- From x = down 8\n\n[WD] Num alpha\n[WD] Convert alpha\n[WD] Down alpha ~ Int8\n\n--> superclasses\n[D] Up (Down alpha) ~ alpha\n\n--> substitute (Down alpha ~ Int8)\n[D] Up Int8 ~ alpha\n\n--> alpha := Int16\n-}\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-}\n\nmodule T10713 where\n\nimport Data.Proxy\n\ntype family TEq t s where\n  TEq t t = 'True\n  TEq t s = 'False\ndata family T a\n\nfoo :: Proxy (TEq (T Int) (T Bool)) -> Proxy 'False\nfoo = id\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}\n{-# LANGUAGE KindSignatures #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-missing-methods #-}\nmodule T10753 where\n\nimport Data.Kind (Type)\n\nclass MonadState s m | m -> s where\n  get :: m s\n\nnewtype StateT s m a = StateT { runStateT :: s -> m (a,s) }\ninstance (Monad m) => Monad (StateT s m) where\ninstance (Functor m, Monad m) => Applicative (StateT s m) where\ninstance (Functor m) => Functor (StateT s m) where\n\ninstance (Monad m) => MonadState s (StateT s m) where\n\nclass HasConns (m :: Type -> Type) where\n    type Conn m\n\nfoo :: (Monad m) => StateT (Conn m) m ()\nfoo =\n    do _ <- get\n       return ()\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExplicitNamespaces, TypeOperators, DataKinds  #-}\n\nmodule T10806 where\n\nimport GHC.TypeLits (Nat, type (<=))\n\ndata Q a where\n    Q :: (a <= b, b <= c) => proxy a -> proxy b -> Q c\n\ntriggersLoop :: Q b -> Q b -> Bool\ntriggersLoop (Q _ _) (Q _ _) = print 'x' 'y'\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-}\n\nmodule T10815 where\n\nimport Data.Proxy\n\ntype family Any :: k\n\nclass kproxy ~ 'KProxy => C (kproxy :: KProxy k) where\n  type F (a :: k)\n  type G a :: k\n\ninstance C ('KProxy :: KProxy Bool) where\n  type F a = Int\n  type G a = Any\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE RankNTypes #-}\n\n{-# OPTIONS_GHC -Wall #-}\n\nmodule T10931 ( BugC(..) ) where\n\nimport Data.Kind (Type)\n\ndata IdT f a = IdC (f a)\n\nclass ( m ~ Outer m (Inner m) ) => BugC (m :: Type -> Type) where\n    type Inner m :: Type -> Type\n    type Outer m :: (Type -> Type) -> Type -> Type\n\n    bug :: ( forall n. ( n ~ Outer n (Inner n)\n                       , Outer n ~ Outer m\n                       )\n            => Inner n a)\n        -> m a\n\ninstance BugC (IdT m) where\n    type Inner (IdT m) = m\n    type Outer (IdT m) = IdT\n\n    bug f = IdC f\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule T11067 where\n\nimport Data.Monoid\nimport GHC.Exts (Constraint)\n\ntype family Skolem (p :: k -> Constraint) :: k\ntype family SkolemF (p :: k2 -> Constraint) (f :: k1 -> k2) :: k1\n\n-- | A quantified constraint\ntype Forall (p :: k -> Constraint) = p (Skolem p)\ntype ForallF (p :: k2 -> Constraint) (f :: k1 -> k2) = p (f (SkolemF p f))\n\n-- These work\nclass ForallF Monoid t => Monoid1 t\ninstance ForallF Monoid t => Monoid1 t\n\nclass ForallF Monoid1 t => Monoid2 t\ninstance ForallF Monoid1 t => Monoid2 t\n-- In both declarations (Forall Monoid1 t) expands to\n-- (Monoid1 (t (SkolemF Monoid1 t))), which is simplifiable\n\n-- Changing f a ~ g a to, (Ord (f a), Ord (g a)), say, removes the error\nclass (f a ~ g a) => H f g a\ninstance (f a ~ g a) => H f g a\n\n-- This one gives a superclass cycle error.\nclass Forall (H f g) => H1 f g\ninstance Forall (H f g) => H1 f g\n-- In both declarations (Forall (H f g)) expands to\n-- H f g (Skolem (H f g)), which is simplifiable\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule T11187 where\nimport Data.Type.Coercion\n\ntype family X\n\ncoercionXX :: Coercion X X\ncoercionXX = Coercion\n\ncoercionXX1 :: Coercion X X\ncoercionXX1 = c where\n  c :: x ~ X => Coercion x x\n  c = Coercion\n\ncoercionXX2 :: Coercion X X\ncoercionXX2 = c where c = Coercion\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n  -- this is needed because |FamHelper a x| /< |Fam a x|\n  -- This file compiled with -dunique-increment=-1 made GHC crash before\n\nmodule T11361 where\n\nimport Data.Kind (Type)\n\nclass Cls a where\n    type Fam a b :: Type\n    -- Multiple defaults!\n    type Fam a x = FamHelper a x\n\ntype family FamHelper a x\ntype instance FamHelper a Bool = Maybe a\ntype instance FamHelper a Int  = (String, a)\n\ninstance Cls Int where\n    -- Gets type family from default\n\ninc :: (Fam a Bool ~ Maybe Int, Fam a Int ~ (String, Int)) => a -> Fam a Bool -> Fam a Int -> Fam a Bool\ninc _proxy (Just x) (_, y) = Just (x + y + 1)\ninc _proxy Nothing  (_, y) = Just y\n\nfoo :: Maybe Int -> (String, Int) -> Maybe Int\nfoo = inc (undefined :: Int)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\n\nmodule T11361a where\n\nclass C a where\n  type F (a :: k) :: *\n  type F (x :: *) = x    -- Not right!\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T11408 where\n\ntype family UL a\ntype family UR a\ntype family MT a b\n\nmkMerge :: a -> UL a -> UR a -> Int\nmkMerge = undefined\n\nmerger :: a -> b -> MT a b\nmerger = undefined\n\n{-\nmerge ::\n forall a b. (UL (MT a b) ~ a, UR (MT a b) ~ b) => a -> b -> Int\nor\n forall t. (MT (UL t) (UR t) ~ t) => UL t -> UR t -> Int\n\nThese types are equivalent, and in fact neither is ambiguous,\nbut the solver has to work quite hard to prove that.\n-}\nmerge x y = mkMerge (merger x y) x y\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T11581 where\n\nimport Data.Kind (Type)\n\ntype family F a :: Type -> Type\ntype family G a\n\ntype instance G [a] = F a (Int,Bool)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, TypeFamilies,\n             UndecidableInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule T12175 where\n\nimport GHC.Exts\n\nclass Foo a\ninstance Foo a => Foo (a,b)\n\ntype family TElt r :: Constraint\ntype instance TElt r = (Foo r, ())\n-- type TElt r = (Foo r, Eq r)\n\ndata CT r = CT [r]\n\ntoCT :: Foo r => CT r -> CT r\ntoCT = undefined\n\nfoo :: CT (a,b) -> (CT a, CT b)\nfoo = undefined\n\nunzipT :: TElt (a,b) => CT (a,b) -> (CT a, CT b)\nunzipT x = foo (toCT x)\n\n{-  Type checking for unzipT\n\n[G] TElt (a,b)\n    --> {by rewrite}                 (Foo (a,b), ())\n    --> {by superclasses of tuple}   Foo (a,b), ()\n\ntoCT @(a,b)\n    --> [W] Foo (a,b)\n    --> {by instance decl}  Foo a    (insoluble)\n -}\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language DataKinds, PolyKinds, GADTs, TypeFamilies, RankNTypes,\n             TypeOperators, ConstraintKinds #-}\n\nmodule T12369 where\n\nimport Data.Kind\n\ndata family Fix :: (k -> Type) -> k\nnewtype instance Fix f = In { out :: f (Fix f) }\n\ntype FREE k = (k -> Constraint) -> (k -> k)\ntype f  ~> g = forall a. f a -> g a\ntype f ~~> g = forall a b. f a b -> g a b\n\ndata    family   Free k :: FREE k\n\nnewtype instance Free Type k p where\n  Free0 :: (forall q. k q => (p  -> q) -> q) -> Free Type k p\n\nnewtype instance Free (j -> Type) k p a where\n  Free1 :: (forall q. k q => (p  ~> q) -> q a) -> Free (j -> Type) k p a\n\nnewtype instance Free (j1 -> j2 -> Type) k p a b where\n  Free2 :: (forall q. k q => (p ~~> q) -> q a b) -> Free (j1 -> j2 -> Type) k p a b\n\ndata family Free2 :: FREE k\n\nnewtype instance Free2 :: FREE Type where\n  Free20 :: (forall q. k q => (p  -> q) -> q) -> Free2 k p\n\nnewtype instance Free2 :: forall k. FREE (k -> Type) where\n  Free21 :: (forall q. k q => (p  ~> q) -> q a) -> Free2 k p a\n\nnewtype instance Free2 :: forall k1 k2. FREE (k1 -> k2 -> Type) where\n  Free22 :: (forall q. k q => (p ~~> q) -> q a b) -> Free2 k p a b\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, TypeFamilies, GADTs, DataKinds #-}\n\nmodule T12444a where\n\ntype family F a :: *\ntype instance F (Maybe x) = Maybe (F x)\n\nfoo :: a -> Maybe (F a)\nfoo = undefined\n\n-- bad :: (F (Maybe t) ~ t) => Maybe t -> [Maybe t]\nbad x = [x, foo x]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule T12522 where\n\nfoo = f (Just 'c')\n\ndata D1 x\ndata D2\n\ntype family TF x = t | t -> x\ntype instance TF (D1 x, a) = Maybe (TF (x, a))\ntype instance TF (D2, ()) = Char\n\nf :: TF (x, a) -> ()\nf _ = ()\n\nfoo1 = f_good (Just 'c')\nfoo2 = f_bad (Just 'c')\n\ntype family TF2 x y = t | t -> x y\ntype instance TF2 Int Float = Char\n\ntype family TF_Good x y = t | t -> x y\ntype instance TF_Good a (Maybe x) = Maybe (TF2 a x)\n\nf_good :: TF_Good a x -> ()\nf_good _ = ()\n\ntype family TF_Bad x y = t | t -> x y\ntype instance TF_Bad (Maybe x) a = Maybe (TF2 a x)\n\nf_bad :: TF_Bad x a -> ()\nf_bad _ = ()\n\n{-\n\nMaybe Char ~ TF (xx, aa)\n\n\nModel [D] s_aF4 ~ Maybe Char\n\n       [W] TF (x_aDY, a_aJn) ~ s_aF4    FunEq\n--> {aJn = aJp)\n       [W} TF (x_aDY, a_aJp) ~ s_aF4    FunEq\n--> {new derived equalities}\n       [D] x_aDY ~ D1 x_aJq\n       [D] a_aJp ~ a_aJR\n-}\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T12522b where\n\nimport Data.Kind (Type)\n\nnewtype I a = I a\n\ntype family Curry (as :: [Type]) b = f | f -> as b where\n    Curry '[] b = I b\n    Curry (a:as) b = a -> Curry as b\n\ndata Uncurried (as :: [Type]) b\n\ndef :: Curry as b -> Uncurried as b\ndef = undefined\n\n-- test2 :: Uncurried [Bool, Bool] Bool\ntest2 = def $ \\a b -> I $ a && b\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MonoLocalBinds #-}\nmodule T12526 where\n\nimport Data.Kind (Type)\n\ntype family P (s :: Type -> Type) :: Type -> Type -> Type\ntype instance P Signal = Causal\n\ntype family S (p :: Type -> Type -> Type) :: Type -> Type\ntype instance S Causal = Signal\n\nclass (P (S p) ~ p) => CP p\ninstance CP Causal\n\ndata Signal a = Signal\ndata Causal a b = Causal\n\nshapeModOsci :: CP p => p Float Float\nshapeModOsci = undefined\n\nf :: Causal Float Float -> Bool\nf = undefined\n\n-- This fails\nping :: Bool\nping = let osci = shapeModOsci in  f osci\n\n\n-- This works\n-- ping :: Bool\n-- ping = f shapeModOsci\n\n\n{-\n\n    osci :: p Float Float\n    [W] CP p, [D] P (S p) ~ p\n-->\n    [W] CP p, [D] P fuv1 ~ fuv2, S p ~ fuv1, fuv2 ~ p\n-->\n    p := fuv2\n    [W] CP fuv2, [D] P fuv1 ~ fuv2, S fuv2 ~ fuv1\n\n-}\n\n-- P (S p) ~ p\n-- p Float Float ~ Causal Float Float\n\n\n{-\n  P (S p) ~ p\n  p Float Float ~ Causal Float Float\n\n--->\n  S p ~ fuv1    (FunEq)\n  P fuv1 ~ fuv2 (FunEq)\n  fuv2 ~ p\n  p F F ~ Causal F F\n\n--->\n  p := fuv2\n\n  fuv2 ~ Causal\n  S fuv2 ~ fuv1 (FunEq)\n  P fuv1 ~ fuv2 (FunEq)\n\n---> unflatten\n  fuv1 := S fuv2\n  fuv2 := Causal\n\n-}\n", "num_lines": 72}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule T12538 where\n\ndata Tagged t a = Tagged a\n\ntype family Tag a where\n  Tag (Tagged t a) = Tagged t a\n  Tag a = Tagged Int a\n\nclass (r ~ Tag a) => TagImpl a r | a -> r where\n  tag :: a -> r\n\ninstance {-# OVERLAPPING #-} (r ~ Tag (Tagged t a)) => TagImpl (Tagged t a) r where\n  tag = id\n\n#ifdef WRONG\ninstance {-# OVERLAPPING #-} (r ~ Tagged t a, r ~ Tag a) => TagImpl a r where\n#else\ninstance {-# OVERLAPPING #-} (r ~ Tagged Int a, r ~ Tag a) => TagImpl a r where\n#endif\n  tag = Tagged @Int\n\ndata family   DF x\ndata instance DF (Tagged t a) = DF (Tagged t a)\n\nclass ToDF a b | a -> b where\n  df :: a -> b\n\ninstance (TagImpl a a', b ~ DF a') => ToDF a b where\n  df = DF . tag\n\nmain :: IO ()\nmain = pure ()\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TypeFamilies #-}\n\nmodule T12676 where\n\ndata family T a\ndata instance T () = MkT\n\nfoo :: (forall s. T ()) -> ()\nfoo MkT = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies #-}\n\nmodule Bug where\n\nimport GHC.Exts\n\nclass HasRep a where\n  type Rep a :: TYPE r\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, DataKinds, PolyKinds, TypeFamilies #-}\n\nmodule T13244 where\n\nimport Data.Int\nimport Data.Word\nimport GHC.Prim\nimport GHC.Types\n\ntype family Rep x where\n  Rep Int    = IntRep\n  Rep Int8   = IntRep\n  Rep Int16  = IntRep\n  Rep Int32  = IntRep\n  Rep Int64  = Int64Rep\n  Rep Bool   = IntRep\n  Rep Char   = IntRep\n  Rep Word   = WordRep\n  Rep Word8  = WordRep\n  Rep Word16 = WordRep\n  Rep Word32 = WordRep\n  Rep Word64 = Word64Rep\n  Rep Float  = FloatRep\n  Rep Double = DoubleRep\n\nclass Unbox x where\n  type Unboxed x :: TYPE (Rep x)\n  unbox :: x -> Unboxed x\n  box :: Unboxed x -> x\n\ninstance Unbox Int where\n  type Unboxed Int = Int#\n  unbox (I# i) = i\n  box = I#\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T13398a where\n\ndata Nat\ndata Rate\ndata StaticTicks where\n        (:/:) :: Nat -> Rate -> StaticTicks\ntype ticks :/ rate = ticks ':/: rate\n\nclass HasStaticDuration (s :: k) where\n  type SetStaticDuration s (pt :: StaticTicks) :: k\n\ninstance HasStaticDuration (t :/ r) where\n  type SetStaticDuration (t :/ r) (t' :/ r') = t' :/ r'\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T13398b where\n\nimport GHC.TypeLits\n\nclass C a where\n  type T a (b :: Bool) :: a\n\ninstance C Nat where\n  type T Nat 'True  = 1\n  type T Nat 'False = 0\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\nmodule T13662 (run) where\n\nimport Data.Kind (Type)\n\nnewtype Value a = Value a\n\ntype family Repr (f :: Type -> Type) a :: Type\ntype instance Repr f Int = f Int\n\nclass (Repr Value i ~ Value ir) => Native i ir where\n\ninstance Native Int Int where\n\n\nfromInt :: (Native i ir) => i -> a\nfromInt = undefined\n\napply :: (Int -> a -> a) -> a -> a\napply weight = id\n\nrun :: Float -> Float\nrun =\n   let weight = \\clip v -> fromInt clip * v\n   in  apply weight\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\n\nmodule T13705 where\n\ndata D x\n\ntype family F t = s | s -> t\ntype instance F (D t) = D (F t)\n\nf :: F s -> ()\nf _ = ()\n\ng :: D (F t) -> ()\ng x = f x\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeInType #-}\nmodule T13777 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata S :: forall k. Proxy k -> Type where\n  MkS :: S ('Proxy :: Proxy Maybe)\n\ndata T (a :: b) :: forall c (d :: Type) e.\n                   (forall f. Proxy f) -> Proxy c -> Proxy d -> Proxy e\n                -> Type where\n\n  -- NB: This was originally a failing test, but now that we have #15273, it works!\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-}\n\nmodule T14045 where\n\nimport Data.Kind\n\ndata family Sing (a :: k)\ndata instance Sing :: Bool -> Type where\n  SFalse :: Sing False\n  STrue  :: Sing True\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14131 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata family Nat :: k -> k -> Type\nnewtype instance Nat :: (k -> Type) -> (k -> Type) -> Type where\n  Nat :: (forall xx. f xx -> g xx) -> Nat f g\n\ntype family   F :: Maybe a\ntype instance F = (Nothing :: Maybe a)\n\nclass C k where\n  data CD :: k -> k -> Type\n  type CT :: k\n\ninstance C (Maybe a) where\n  data CD :: Maybe a -> Maybe a -> Type where\n    CD :: forall a (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n\n  type CT = (Nothing :: Maybe a)\n\nclass Z k where\n  type ZT :: Maybe k\n  type ZT = (Nothing :: Maybe k)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TypeOperators, KindSignatures, DataKinds, PolyKinds,\n             TypeFamilies, GADTs #-}\n\nmodule T14162 where\n\nimport Data.Kind\n\ndata SubList (a :: Maybe w) :: Type where\n  SubNil :: SubList 'Nothing\n\ndata family Sing (a :: k)\n\ndata instance Sing (x :: SubList ys) where\n  SSubNil :: Sing SubNil\n\n{-\nSubList :: forall (w::*). Maybe w -> *\nSubNil  :: forall (w::*). SubList w (Nothing w)\n\nwrkSubNil :: forall (w::*) (a :: Maybe w).\n             (a ~ Nothing w) =>\n             SubList w a\n\nSing :: forall k. k -> *\n\nRepTc :: forall (w_aSy : *)\n                (ys_aRW :: Maybe w_aSy)\n                (x_aRX :: SubList w_aSy ys_aRW).\n                *\n\naxiom forall (w : *) (ys : Maybe w) (x : SubList ys).\n   Sing (SubList ys) (x : SubList ys) ~ RepTc w ys x\n\ndata RepTc w ys x where\n  SSubNil :: RepTc w (Nothing w) (SubNil w)\n\nSSubNil :: forall (w :: *). Sing (SubList w (Nothing w)) (SubNil w)\n\nwrkSSubMil :: forall (w : *) (ys : Maybe w) (x : Sublist w ys).\n              () =>\n              RepTc w ys x\n-}\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14164 where\n\ndata G (x :: a) = GNil | GCons (G x)\n\ntype family F (xs :: [a]) (g :: G (z :: a)) = (res :: [a]) | res -> a where\n  F (x:xs) GNil         = x:xs\n  F (x:xs) (GCons rest) = x:F xs rest\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fwarn-redundant-constraints #-}\n\nmodule T14237 where\n\nf :: (Integer ~ a) => a -> Integer\nf = (+ 1)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language UndecidableInstances, DataKinds, TypeOperators, TypeFamilies,\n             PolyKinds, GADTs, LambdaCase, ScopedTypeVariables #-}\n\nmodule T14554 where\n\nimport Data.Kind\nimport Data.Proxy\n\ntype a ~> b = (a, b) -> Type\n\ndata IdSym0 :: (Type,Type) -> Type\n\ndata KIND = X | FNARR KIND KIND\n\ndata TY :: KIND -> Type where\n  ID    :: TY (FNARR X X)\n  FNAPP :: TY (FNARR k k') -> TY k -> TY k'\n\ndata TyRep (kind::KIND) :: TY kind -> Type where\n  TID    :: TyRep (FNARR X X)  ID\n  TFnApp :: TyRep (FNARR k k') f\n         -> TyRep k            a\n         -> TyRep k'           (FNAPP f a)\n\ntype family IK (kind::KIND) :: Type where\n  IK X            = Type\n  IK (FNARR k k') = IK k ~> IK k'\n\ntype family IT (ty::TY kind) :: IK kind\n\nzero :: TyRep X a -> IT a\nzero x = case x of\n            TFnApp TID a -> undefined\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -O1 #-}\nmodule T14680 where\n\nimport GHC.Base (getTag)\nimport GHC.Exts (Int(..), tagToEnum#)\n\ndata family TyFamilyEnum\ndata instance TyFamilyEnum = TyFamilyEnum1 | TyFamilyEnum2 | TyFamilyEnum3\n\nsuc :: TyFamilyEnum -> TyFamilyEnum\nsuc a_aaf8\n        = case getTag a_aaf8 of\n             a_aaf9\n               -> if 2 ==  I# a_aaf9\n                  then error \"succ{TyFamilyEnum}: tried to take `succ' of last tag in enumeration\"\n                  else case I# a_aaf9 + 1 of\n                         I# i_aafa -> tagToEnum# i_aafa :: TyFamilyEnum\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LiberalTypeSynonyms #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15057 where\n\ntype T f = f Int\ntype S a = a -> a\n\ntype family TF a\ntype instance TF Int = T S\n  -- Ensure that -dcore-lint doesn't trip up on this unsaturated use\n  -- of the type synonym S\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\nmodule T15122 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata IsStar (a :: k) where\n  IsStar :: IsStar (a :: Type)\n\ntype family F (a :: k) :: k\n\nfoo :: (F a ~ F b) => IsStar a -> Proxy b\n                   -> Proxy (F a) -> Proxy (F b)\nfoo IsStar _ p = p\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n\n\nmodule T15142 where\n\nimport Data.Kind\n\nclass ListTuple (tuple :: Type) (as :: [(k, Type)]) where\n  type ListToTuple as :: Type\n\nclass C (a :: Type) (b :: k) where\n  type T b\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15144 where\n\nimport Data.Coerce\nimport Data.Proxy\n\ntype family F x\n\nf :: Coercible (F a) b => Proxy a -> F a -> b\nf _ = coerce\n\n-- In #15144, we inferred the less-general type\n-- g :: Proxy a -> F a -> F a\ng p x = f p x\n\nh :: Coercible (F a) b => Proxy a -> F a -> b\nh p x = g p x\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15138 where\n\ndata family Sn a\nnewtype instance Sn (Either a b) where\n  SnC :: forall b a. Char -> Sn (Either a b)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds           #-}\n{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}\n{-# LANGUAGE TypeOperators       #-}\n\nmodule T15322 where\n\nimport Data.Proxy (Proxy (..))\nimport Type.Reflection\nimport GHC.TypeLits (KnownNat, type (+))\n\nf :: forall n . (Typeable (n+1), KnownNat n) => Proxy n -> TypeRep (n+1)\nf _ = typeRep\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds           #-}\n{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}\n{-# LANGUAGE TypeOperators       #-}\n\nmodule T15322a where\n\nimport Data.Proxy (Proxy (..))\nimport Type.Reflection\nimport GHC.TypeLits (KnownNat, type (+))\n\nf :: forall n . (KnownNat n) => Proxy n -> TypeRep (n+1)\nf _ = typeRep\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeInType #-} -- or PolyKinds\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T15352 where\n\nimport Data.Kind\n\nclass C (x :: Type) (y :: k) where\n  type F y\n\n\ntype Hom k = k -> k -> Type\n\ntype family Ob (p :: Hom k) :: k -> Constraint\n\nclass ( obP ~ Ob p\n      , opP ~ Dom p\n      , obQ ~ Ob q\n      , opQ ~ Dom q\n      , p ~ Dom f\n      , q ~ Cod f\n      ) => Functor' (obP :: i -> Constraint)\n                    (opP :: Hom i)\n                    (p :: Hom i)\n                    (obQ :: j -> Constraint)\n                    (opQ :: Hom j)\n                    (q :: Hom j)\n                    (f :: i -> j) where\n  type Dom f :: Hom i\n  type Cod f :: Hom j\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, TypeOperators, DataKinds, PolyKinds, GADTs, TypeInType, TypeFamilies #-}\n\nmodule T15664 where\n\nimport Data.Kind\n\ntype family Apply (kind) (f :: kind) :: Type\ndata        ApplyT(kind) :: kind -> Type \n\ntype f ~> g = (forall xx. f xx -> g xx)\n\nunravel :: ApplyT(k) ~> Apply(k)\nunravel = unravel\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\n\nmodule T15704 where\n\nimport Data.Kind\n\ndata family D :: k\n\ntype family F (a :: k) :: Type\n\ntype instance F D = Int\ntype instance F (D a) = Char\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-}\n\nmodule Bug where\n\nclass C a where\n  type F (x :: Maybe a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeInType, RankNTypes, TypeFamilies #-}\n\nmodule T15740a where\n\nimport Data.Kind\nimport Data.Proxy\n\ntype family F2 :: forall k. k -> Type\n\n-- This should succeed\ntype instance F2 = Proxy\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds #-}\n{-# Language TypeFamilies #-}\n{-# Language KindSignatures #-}\n{-# Language DataKinds #-}\n{-# Language MultiParamTypeClasses #-}\n\nmodule T15764a where\n\nimport Data.Kind\nimport Data.Proxy\nimport GHC.TypeLits\n\nclass C6 (k :: Type) (a :: k) (b :: Proxy (a :: k)) where\n type T6 (proxy :: Proxy '(k, (b :: Proxy a)))\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15852 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata family DF a (b :: k)\ndata instance DF (Proxy c) :: Proxy j -> Type\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes             #-}\n{-# Language DataKinds              #-}\n{-# Language KindSignatures         #-}\n{-# Language PolyKinds              #-}\n{-# Language TypeFamilyDependencies #-}\n{-# Language GADTs                  #-}\n{-# Language TypeSynonymInstances   #-}\n{-# Language FlexibleInstances      #-}\n{-# Language QuantifiedConstraints  #-}\n\nmodule T15943 where\n\nimport Data.Type.Equality\nimport Data.Coerce\nimport Data.Type.Coercion\nimport Data.Kind\n\nnewtype WrapFalse a b = WrapFalse (Hom False a b)\nnewtype WrapTrue  a b = WrapTrue  (Hom True  a b)\n\nclass\n  (forall (x :: ob) (y :: ob). Coercible (WrapFalse x y) (WrapTrue y x))\n  =>\n  R\u00c3\u00adki ob where\n\n  type Hom (or::Bool) = (res :: ob -> ob -> Type) | res -> or\n\ninstance R\u00c3\u00adki Type where\n  type Hom False = (->)\n  type Hom True  = Op\n\nnewtype Op :: Type -> Type -> Type where\n  Op :: (b -> a) -> Op a b\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, StandaloneDeriving, DeriveDataTypeable, FlexibleInstances #-}\n\nmodule T1769 where\n\nimport Data.Typeable\n\ndata family T a\nderiving instance Typeable T\n-- deriving instance Functor T\n\ndata instance T [b] = T1 | T2 b\nderiving instance Eq b => Eq (T [b])\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XTypeFamilies #-}\n\nmodule ShouldCompile where\n\ntype family T a\n\nf :: a -> T a -> Int\nf p x = x `seq` 3\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}\n\nmodule T2102 where\n\ntype family Cat ts0 ts\ntype instance Cat ()      ts' = ts'\ntype instance Cat (s, ts) ts' = (s, Cat ts ts')\n\nclass (Cat ts () ~ ts) => Valid ts\ninstance Valid () -- compiles OK\ninstance Valid ts => Valid (s, ts) -- fails to compile\n\n-- need to prove Cat (s, ts) () ~ (s, Cat ts ())\n-- for the superclass of class Valid.\n-- (1) From Valid ts: Cat ts () ~ ts\n-- (2) Therefore:     (s, Cat ts ()) ~ (s, ts)\n\ncoerce :: forall f ts. Valid ts => f (Cat ts ()) -> f ts\ncoerce x = x\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}\n\nmodule T2203b where\n\nclass Foo a where\n   type TheFoo a\n   foo :: TheFoo a -> a\n   foo' :: a -> Int\n\nclass Bar b where\n   bar :: b -> Int\n\ninstance (b ~ TheFoo a, Foo a) => Bar (Either a b) where\n   bar (Left a) = foo' a\n   bar (Right b) = foo' (foo b :: a)\n\ninstance Foo Int where\n   type TheFoo Int = Int\n   foo = id\n   foo' = id\n\nval :: Either Int Int\nval = Left 5\n\nres :: Int\nres = bar val", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls, TypeOperators #-}\n\nmodule Test where\n\nimport Data.Kind (Type)\n\ndata Zero\ndata Succ a\n\ndata FZ\ndata FS fn\n\ndata Fin n fn where\n  FZ :: Fin (Succ n) FZ\n  FS :: Fin n fn -> Fin (Succ n) (FS fn)\n\ndata Nil\ndata a ::: b\n\ntype family Lookup ts fn :: Type\ntype instance Lookup (t ::: ts) FZ = t\ntype instance Lookup (t ::: ts) (FS fn) = Lookup ts fn\n\ndata Tuple n ts where\n  Nil   :: Tuple Zero Nil\n  (:::) :: t -> Tuple n ts -> Tuple (Succ n) (t ::: ts)\n\nproj :: Fin n fn -> Tuple n ts -> Lookup ts fn\nproj FZ      (v ::: _)  = v\nproj (FS fn) (_ ::: vs) = proj fn vs\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\n-- Trac #2238\n-- Notice that class CTF has just one value field, but\n-- it also has an equality predicate. \n-- See Note [Class newtypes and equality predicates] in BuildTyCl\n\nmodule Foo where\n\ndata A\ndata B\n\n-- via functional dependencies\n\nclass HowFD a how | a -> how\n\nclass HowFD a how => CFD a how where\n  cfd :: a -> String\n  cfd _ = \"cfd\"\ninstance HowFD a how => CFD a how\n\ninstance HowFD Bool A\n\n-- via type families\n\ntype family HowTF a\n\nclass how ~ HowTF a => CTF a how where\n  ctf :: a -> String\n  ctf _ = \"ctf\"\n\ninstance how ~ HowTF a => CTF a how\n\ntype instance HowTF Bool = A\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Small where\n\nimport Data.Kind (Type)\n\nclass CoCCC k where\n        type Coexp k :: Type -> Type -> Type\n        type Sum k :: Type -> Type -> Type\n        coapply' :: k b (Sum k (Coexp k a b) a)\n        cocurry' :: k c (Sum k a b) -> k (Coexp k b c) a\n        uncocurry' :: k (Coexp k b c) a -> k c (Sum k a b)\n\ncoapply   :: CoCCC k => k b (Sum k (Coexp k a b) a)\n{-# INLINE [1] coapply #-}\ncoapply = coapply'\n\ncocurry   :: CoCCC k => k c (Sum k a b) -> k (Coexp k b c) a\n{-# INLINE [1] cocurry #-}\ncocurry = cocurry'\n\nuncocurry :: CoCCC k => k (Coexp k b c) a -> k c (Sum k a b)\n{-# INLINE [1] uncocurry #-}\nuncocurry = uncocurry'\n\n{-# RULES\n\"cocurry coapply\"               cocurry coapply = id\n\"cocurry . uncocurry\"           forall x. cocurry (uncocurry x) = x\n\"uncocurry . cocurry\"           forall x. uncocurry (cocurry x) = x\n #-}\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies, UndecidableInstances #-}\n\nmodule T2448 where\n\nimport Data.Kind (Type)\n\n-- Demonstrates a bug in propagating type equality constraints\n\nclass VectorSpace v where\n  type Scalar v :: Type\n\nclass VectorSpace v => InnerSpace v\n\ninstance (VectorSpace u,VectorSpace v, Scalar u ~ Scalar v) => \n  VectorSpace (u,v) \n  where\n  type Scalar (u,v) = Scalar u\n\ninstance (InnerSpace u,InnerSpace v, Scalar u ~ Scalar v) => InnerSpace (u,v)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies, EmptyDataDecls #-}\n\nmodule T2627 where\n\ndata R a b\ndata W a b\ndata Z\n\ntype family Dual a\ntype instance Dual Z = Z\ntype instance Dual (R a b) = W a (Dual b)\ntype instance Dual (W a b) = R a (Dual b)\n\ndata Comm a where\n    Rd :: (a -> Comm b) -> Comm (R a b)\n    Wr :: a  -> Comm b  -> Comm (W a b)\n    Fin :: Int -> Comm Z\n\nconn :: (Dual a ~ b, Dual b ~ a) => Comm a -> Comm b -> (Int, Int)\nconn (Fin x) (Fin y) = (x,y)\nconn (Rd k) (Wr a r) = conn (k a) r\nconn (Wr a r) (Rd k) = conn r (k a)", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, EmptyDataDecls #-}\n\nmodule T2639 where\n\ndata Eps\n\ndata family Work a v\ndata instance Work Eps v = Eps v\n\ntype family Dual a\ntype instance Dual Eps = Eps\n\nclass Connect s where\n    connect :: (Dual s ~ c, Dual c ~ s) => Work s a -> Work c b -> (a,b)\n\ninstance Connect Eps where\n    connect (Eps a) (Eps b) = (a,b)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n    -- The type of 'empty' is indeed ambiguous\n\nmodule T2715 where\n\nimport Data.Kind (Type)\n\ndata Interval v where\n   Intv :: (Ord v, Enum v) => (v,v) -> Interval v\n\ntype family Domain (d :: Type -> Type) :: Type -> Type\ntype instance Domain Interval = Interval \n\ntype family Value (d :: Type -> Type) :: Type\n\nclass IDomain d where\n   empty   :: (Ord (Value d), Enum (Value d)) => Domain d (Value d)\n\nclass (IDomain d1) -- (IDomain d1, IDomain d2, Value d1 ~ Value d2) \n   => IIDomain (d1 :: Type -> Type) (d2 :: Type -> Type ) where\n   equals  :: Domain d1 (Value d1) -> Domain d2 (Value d2) -> Bool\n\n\ninstance Ord (Value Interval) \n      => IDomain Interval where\n   empty = Intv (toEnum 1, toEnum 0)\n\ninstance Ord (Value Interval) \n      => IIDomain Interval Interval where\n   equals  (Intv ix) (Intv iy) = ix == iy\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, NoMonomorphismRestriction #-}\n\nmodule T2767a where\n\nimport Data.Kind (Type)\n\nmain = return ()\n\n-- eval' :: Solver solver => Tree solver a -> [(Label solver,Tree solver a)] -> solver [a]\neval' (NewVar f) wl = do v <- newvarSM\n                         eval' (f v) wl\neval' Fail       wl = continue wl\n\n-- continue :: Solver solver => [(Label solver,Tree solver a)] -> solver [a] \ncontinue ((past,t):wl) = do gotoSM past\n                            eval' t wl\ndata Tree s a\n                = Fail\n                | NewVar (Term s -> Tree s a)\n\nclass Monad solver => Solver solver where\n        type Term solver        :: Type\n        type Label solver       :: Type\n        newvarSM        :: solver (Term solver)\n        gotoSM          :: Label solver -> solver ()\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, FlexibleContexts, FlexibleInstances #-}\n\nmodule T2850 where\n\nimport Data.Kind (Type)\n\nclass K a where\n  bar :: a -> a\n\nclass K (B a) => M a where\n  data B a :: Type\n  foo :: B a -> B a\n\ninstance M Bool where\n  data B Bool = B1Bool Bool | B2Bool Bool\n  foo = id\n\ninstance K (B Bool) where\n  bar = id\n\n-- The 'deriving K' gives the (K (B Int)) instance\n-- needed for the superclasses of M\ninstance M Int where\n  newtype B Int = BInt (B Bool) deriving K\n  foo = id\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-- Test Trac #2944\n\nmodule T2944 where\n\nimport Data.Kind (Type)\n\ntype family T a :: Type\n\nf1 :: T a ~ () => a\nf1 = f2\n\nf2 :: T a ~ () => a\nf2 = f1\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- Trac #3017\n\nmodule Foo where\n class Coll c where\n   type Elem c\n   empty :: c\n   insert :: Elem c -> c -> c\n\n data ListColl a = L [a]\n instance Coll (ListColl a) where\n   type Elem (ListColl a) = a\n   empty = L []\n   insert x (L xs) = L (x:xs)\n\n emptyL :: ListColl a\n emptyL = empty\n\n test2 c = insert (0, 0) c\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# OPTIONS_GHC -fwarn-missing-signatures #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}\n\nmodule Bug where\n\nclass C a b | a -> b, b -> a where\n    f :: a -> b\n\ninstance C Int Bool where\n    f = undefined\ninstance (C a c, C b d) => C (a -> b) (c -> d) where\n    f = undefined\n\nfoo :: Int -> Int\nfoo = undefined\n\nbar = f foo\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T3208a where\n  \nclass SUBST s where\n    type STerm s\n\nclass OBJECT o where\n    type OTerm o\n    apply :: (SUBST s, OTerm o ~ STerm s) => s -> o\n\nfce' f = fce . apply $ f\n\nfce f = fce' f\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- This should fail\n\nmodule T3208b where\n  \nclass SUBST s where\n    type STerm s\n\nclass OBJECT o where\n    type OTerm o\n    apply :: (SUBST a, OTerm o ~ STerm a) => a -> o\n\nfce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c\nfce' f = fce (apply f)\n-- f :: a\n-- apply f :: (SUBST a, OBJECT o, OTerm o ~ STerm a) => o\n-- fce called with a=o, gives wanted (OTerm o ~ STerm o, OBJECT o, SUBST o)\n-- o is a unif var.\n\nfce :: (OTerm o ~ STerm o, OBJECT o, SUBST o) => o -> c\nfce f = fce' f\n\n\n{-  (OTerm a ~ STerm a, OBJECT a, SUBST a)\n => (SUBST a, OBJECT o, OTerm o ~ STerm a, OTerm o ~ STerm o, OBJECT o, SUBST o)\n    \n =     OTerm o ~ u1\n       STerm o ~ u1\n       Sterm a ~ u1\n\n =  (SUBST a, OBJECT o, STerm o ~ STerm a, OTerm o ~ STerm o, OBJECT o, SUBST o)\n-}", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ScopedTypeVariables#-}\n\nmodule T3220 where\n\nimport Data.Kind (Type)\n\nclass Foo m where\n    type Bar m :: Type\n    action :: m -> Bar m -> m\n\nright x m = action m (Right x)\n\nright' :: (Either a b ~ Bar m, Foo m) => b -> m -> m\nright' x m = action m (Right x)\n\ninstance Foo Int where\n    type Bar Int = Either Int Int\n    action m a = either (*) (+) a m\n\ninstance Foo Float where\n    type Bar Float = Either Float Float\n    action m a = either (*) (+) a m\n\nfoo = print $ right (1::Int) (3 :: Int)\nbar = print $ right (1::Float) (3 :: Float)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DatatypeContexts #-}\nmodule T3418 where\n\nnewtype (a ~ b) => S a b = S { unS :: a }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, UndecidableInstances, StandaloneDeriving #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T3423 where\n\nnewtype Trie m k a = Trie (Maybe a, m (SubKey k) (Trie m k a))\n\ntype family SubKey k\ntype instance SubKey [k] = k\n\nderiving instance (Eq (m k (Trie m [k] a)), Eq a)\n               => Eq (Trie m [k] a)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\nmodule T3460 where\n\nclass Nat n where\n    toInt :: n -> Int\n\nclass (Nat (Arity f)) => Model f where\n    type Arity f\n\nok :: Model f => f -> Arity f -> Int\nok _ n = toInt n\n\nbug :: (Model f, Arity f ~ n) => f -> n -> Int\nbug _ n = toInt n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall -fno-warn-redundant-constraints #-}\n{-# LANGUAGE GADTs, RankNTypes, TypeFamilies, FlexibleContexts, ScopedTypeVariables #-}\n\nmodule Absurd where\n\ndata Z = Z\nnewtype S n = S n\nclass Nat n where\n   caseNat :: (n ~ Z => r) -> (forall p. (n ~ S p, Nat p) => p -> r) -> n -> r\ninstance Nat Z where\n   caseNat _ _ = error \"urk1\"\ninstance Nat n => Nat (S n) where\n   caseNat _ _ = error \"urk2\"\n\n-- empty type\nnewtype Naught = Naught (forall a. a)\n-- types are equal!\ndata TEq a b where\n   TEq :: (a ~ b) => TEq a b\n\ntype family NatEqProves m n\ntype instance NatEqProves (S m) (S n) = TEq m n\n\nnoConf :: (Nat m, Nat n) => m -> TEq m n -> NatEqProves m n\nnoConf = undefined\npredEq :: TEq (S a) (S b) -> TEq a b\npredEq = undefined\n\ndata IsEq a b = Yes (TEq a b) | No (TEq a b -> Naught)\n\nnatEqDec :: forall m n. (Nat m, Nat n) => m -> n -> IsEq m n\nnatEqDec m n = caseNat undefined mIsS m where\n    mIsS :: forall pm. (m ~ S pm, Nat pm) => pm -> IsEq m n\n    mIsS pm = caseNat undefined nIsS n where\n        nIsS :: forall pn. (n ~ S pn, Nat pn) => pn -> IsEq m n\n        nIsS pn = case natEqDec pm pn of\n            Yes TEq -> Yes TEq\n            No contr -> No (contr . noConf m)\n--            No contr -> No (contr . predEq)\n\n-- strange things:\n-- (1) commenting out the \"Yes\" case or changing it to \"undefined\" makes compilation succeed\n-- (2) replacing the \"No\" line with with the commented out \"No\" line makes compilation succeed\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\n-- Trac #3590: a bug in typechecking of sections\n\nmodule T3590 where\n\nimport Data.Kind (Type)\n\nnewtype ListT m a =\n  ListT { runListT :: m (Maybe (a, ListT m a)) }\n\nclass Monad (ItemM l) => List l where\n  type ItemM l :: Type -> Type\n  joinL :: [ItemM l (l a) -> l a]\n\ninstance Monad m => List (ListT m) where\n  type ItemM (ListT m) = m\n  joinL = [ ListT . (>>= runListT)      -- Right section\n          , ListT . (runListT <<=)      -- Left section\n          ]\n\n(<<=) :: Monad m => (a -> m b) -> m a -> m b\n(<<=) k m = m >>= k\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- \n    Copyright 2009 Mario Blazevic\n\n    This file is part of the Streaming Component Combinators (SCC) project.\n\n    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public\n    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later\n    version.\n\n    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty\n    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.\n\n    You should have received a copy of the GNU General Public License along with SCC.  If not, see\n    <http://www.gnu.org/licenses/>.\n-}\n\n-- | Module \"Trampoline\" defines the trampoline computations and their basic building blocks.\n\n{-# LANGUAGE ScopedTypeVariables, RankNTypes, MultiParamTypeClasses, TypeFamilies, KindSignatures,\n             FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances\n #-}\n\nmodule T3787 where\n\nimport Control.Concurrent (forkIO)\nimport Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)\nimport Control.Monad (liftM, liftM2, when, ap)\nimport Control.Monad.Identity\nimport Control.Monad.Trans (MonadTrans(..))\n\nimport Data.Foldable (toList)\nimport Data.Maybe (maybe)\nimport Data.Sequence (Seq, viewl)\nimport Data.Kind (Type)\n\npar, pseq :: a -> b -> b\npar = error \"urk\"\npseq = error \"urk\"\n\n-- | Class of monads that can perform two computations in parallel.\nclass Monad m => ParallelizableMonad m where\n   -- | Combine two computations into a single parallel computation. Default implementation of `parallelize` is\n   -- @liftM2 (,)@\n   parallelize :: m a -> m b -> m (a, b)\n   parallelize = liftM2 (,)\n\n-- | Any monad that allows the result value to be extracted, such as `Identity` or `Maybe` monad, can implement\n-- `parallelize` by using `par`.\ninstance ParallelizableMonad Identity where\n   parallelize ma mb = let a = runIdentity ma\n                           b = runIdentity mb\n                       in  a `par` (b `pseq` a `pseq` Identity (a, b))\n\ninstance ParallelizableMonad Maybe where\n   parallelize ma mb = case ma `par` (mb `pseq` (ma, mb))\n                       of (Just a, Just b) -> Just (a, b)\n                          _ -> Nothing\n\n-- | IO is parallelizable by `forkIO`.\ninstance ParallelizableMonad IO where\n   parallelize ma mb = do va <- newEmptyMVar\n                          vb <- newEmptyMVar\n                          forkIO (ma >>= putMVar va)\n                          forkIO (mb >>= putMVar vb)\n                          a <- takeMVar va\n                          b <- takeMVar vb\n                          return (a, b)\n\n-- | Suspending monadic computations.\nnewtype Trampoline s m r = Trampoline {\n   -- | Run the next step of a `Trampoline` computation.\n   bounce :: m (TrampolineState s m r)\n   }\n\ndata TrampolineState s m r =\n   -- | Trampoline computation is finished with final value /r/.\n   Done r\n   -- | Computation is suspended, its remainder is embedded in the functor /s/.\n | Suspend! (s (Trampoline s m r))\n\ninstance (Functor s, Monad m) => Functor (Trampoline s m) where\n   fmap = liftM\n\ninstance (Functor s, Monad m) => Applicative (Trampoline s m) where\n   pure x = Trampoline (pure (Done x))\n   (<*>) = ap\n\ninstance (Functor s, Monad m) => Monad (Trampoline s m) where\n   return = pure\n   t >>= f = Trampoline (bounce t >>= apply f)\n      where apply f (Done x) = bounce (f x)\n            apply f (Suspend s) = return (Suspend (fmap (>>= f) s))\n\ninstance (Functor s, ParallelizableMonad m) => ParallelizableMonad (Trampoline s m) where\n   parallelize t1 t2 = Trampoline $ liftM combine $ parallelize (bounce t1) (bounce t2) where\n      combine (Done x, Done y) = Done (x, y)\n      combine (Suspend s, Done y) = Suspend (fmap (liftM $ \\x-> (x, y)) s)\n      combine (Done x, Suspend s) = Suspend (fmap (liftM $ (,) x) s)\n      combine (Suspend s1, Suspend s2) = Suspend (fmap (parallelize $ suspend s1) s2)\n\ninstance Functor s => MonadTrans (Trampoline s) where\n   lift = Trampoline . liftM Done\n\ndata Yield x y = Yield! x y\ninstance Functor (Yield x) where\n   fmap f (Yield x y) = Yield x (f y)\n\ndata Await x y = Await! (x -> y)\ninstance Functor (Await x) where\n   fmap f (Await g) = Await (f . g)\n\ndata EitherFunctor l r x = LeftF (l x) | RightF (r x)\ninstance (Functor l, Functor r) => Functor (EitherFunctor l r) where\n   fmap f (LeftF l) = LeftF (fmap f l)\n   fmap f (RightF r) = RightF (fmap f r)\n\nnewtype NestedFunctor l r x = NestedFunctor (l (r x))\ninstance (Functor l, Functor r) => Functor (NestedFunctor l r) where\n   fmap f (NestedFunctor lr) = NestedFunctor ((fmap . fmap) f lr)\n\ndata SomeFunctor l r x = LeftSome (l x) | RightSome (r x) | Both (NestedFunctor l r x)\ninstance (Functor l, Functor r) => Functor (SomeFunctor l r) where\n   fmap f (LeftSome l) = LeftSome (fmap f l)\n   fmap f (RightSome r) = RightSome (fmap f r)\n   fmap f (Both lr) = Both (fmap f lr)\n\ntype TryYield x = EitherFunctor (Yield x) (Await Bool)\n\nsuspend :: (Monad m, Functor s) => s (Trampoline s m x) -> Trampoline s m x\nsuspend s = Trampoline (return (Suspend s))\n\nyield :: forall m x. Monad m => x -> Trampoline (Yield x) m ()\nyield x = suspend (Yield x (return ()))\n\nawait :: forall m x. Monad m => Trampoline (Await x) m x\nawait = suspend (Await return)\n\ntryYield :: forall m x. Monad m => x -> Trampoline (TryYield x) m Bool\ntryYield x = suspend (LeftF (Yield x (suspend (RightF (Await return)))))\n\ncanYield :: forall m x. Monad m => Trampoline (TryYield x) m Bool\ncanYield = suspend (RightF (Await return))\n\nfromTrampoline :: Monad m => Trampoline s m x -> m x\nfromTrampoline t = bounce t >>= \\(Done x)-> return x\n\nrunTrampoline :: Monad m => Trampoline Identity m x -> m x\nrunTrampoline = fromTrampoline\n\npogoStick :: (Functor s, Monad m) => (s (Trampoline s m x) -> Trampoline s m x) -> Trampoline s m x -> m x\npogoStick reveal t = bounce t\n                     >>= \\s-> case s \n                              of Done result -> return result\n                                 Suspend c -> pogoStick reveal (reveal c)\n\npogoStickNested :: (Functor s1, Functor s2, Monad m) => \n                   (s2 (Trampoline (EitherFunctor s1 s2) m x) -> Trampoline (EitherFunctor s1 s2) m x)\n                   -> Trampoline (EitherFunctor s1 s2) m x -> Trampoline s1 m x\npogoStickNested reveal t = \n   Trampoline{bounce= bounce t\n                      >>= \\s-> case s\n                               of Done result -> return (Done result)\n                                  Suspend (LeftF s) -> return (Suspend (fmap (pogoStickNested reveal) s))\n                                  Suspend (RightF c) -> bounce (pogoStickNested reveal (reveal c))\n             }\n\nnest :: (Functor a, Functor b) => a x -> b y -> NestedFunctor a b (x, y)\nnest a b = NestedFunctor $ fmap (\\x-> fmap ((,) x) b) a\n\n-- couple :: (Monad m, Functor s1, Functor s2) => \n--           Trampoline s1 m x -> Trampoline s2 m y -> Trampoline (NestedFunctor s1 s2) m (x, y)\n-- couple t1 t2 = Trampoline{bounce= do ts1 <- bounce t1\n--                                      ts2 <- bounce t2\n--                                      case (ts1, ts2) of (Done x, Done y) -> return $ Done (x, y)\n--                                                         (Suspend s1, Suspend s2) -> return $ Suspend $ \n--                                                                                     fmap (uncurry couple) (nest s1 s2)\n--                          }\n\ncoupleAlternating :: (Monad m, Functor s1, Functor s2) => \n                     Trampoline s1 m x -> Trampoline s2 m y -> Trampoline (SomeFunctor s1 s2) m (x, y)\ncoupleAlternating t1 t2 = \n   Trampoline{bounce= do ts1 <- bounce t1\n                         ts2 <- bounce t2\n                         case (ts1, ts2) of (Done x, Done y) -> return $ Done (x, y)\n                                            (Suspend s1, Suspend s2) ->\n                                               return $ Suspend $ fmap (uncurry coupleAlternating) (Both $ nest s1 s2)\n                                            (Done x, Suspend s2) ->\n                                               return $ Suspend $ fmap (coupleAlternating (return x)) (RightSome s2)\n                                            (Suspend s1, Done y) ->\n                                               return $ Suspend $ fmap (flip coupleAlternating (return y)) (LeftSome s1)\n             }\n\ncoupleParallel :: (ParallelizableMonad m, Functor s1, Functor s2) => \n                  Trampoline s1 m x -> Trampoline s2 m y -> Trampoline (SomeFunctor s1 s2) m (x, y)\ncoupleParallel t1 t2 = \n   Trampoline{bounce= parallelize (bounce t1) (bounce t2)\n                      >>= \\pair-> case pair\n                                  of (Done x, Done y) -> return $ Done (x, y)\n                                     (Suspend s1, Suspend s2) ->\n                                        return $ Suspend $ fmap (uncurry coupleParallel) (Both $ nest s1 s2)\n                                     (Done x, Suspend s2) ->\n                                        return $ Suspend $ fmap (coupleParallel (return x)) (RightSome s2)\n                                     (Suspend s1, Done y) ->\n                                        return $ Suspend $ fmap (flip coupleParallel (return y)) (LeftSome s1)\n             }\n\ncoupleNested :: (Monad m, Functor s0, Functor s1, Functor s2) => \n                Trampoline (EitherFunctor s0 s1) m x -> Trampoline (EitherFunctor s0 s2) m y -> \n                Trampoline (EitherFunctor s0 (SomeFunctor s1 s2)) m (x, y)\ncoupleNested t1 t2 = \n   Trampoline{bounce= do ts1 <- bounce t1\n                         ts2 <- bounce t2\n                         case (ts1, ts2) of (Done x, Done y) -> return $ Done (x, y)\n                                            (Suspend (RightF s), Done y) -> \n                                               return $ Suspend $ RightF $ fmap (flip coupleNested (return y)) (LeftSome s)\n                                            (Done x, Suspend (RightF s)) -> \n                                               return $ Suspend $ RightF $ fmap (coupleNested (return x)) (RightSome s)\n                                            (Suspend (RightF s1), Suspend (RightF s2)) ->\n                                               return $ Suspend $ RightF $ fmap (uncurry coupleNested) (Both $ nest s1 s2)\n                                            (Suspend (LeftF s), Done y) ->\n                                               return $ Suspend $ LeftF $ fmap (flip coupleNested (return y)) s\n                                            (Done x, Suspend (LeftF s)) ->\n                                               return $ Suspend $ LeftF $ fmap (coupleNested (return x)) s\n                                            (Suspend (LeftF s1), Suspend (LeftF s2)) -> \n                                               return $ Suspend $ LeftF $ fmap (coupleNested $ suspend $ LeftF s1) s2\n             }\n\nseesaw :: (Monad m, Functor s1, Functor s2) => \n           (forall x y s t. (s ~ SomeFunctor s1 s2, t ~ Trampoline s m (x, y)) => s t -> t)\n           -> Trampoline s1 m x -> Trampoline s2 m y -> m (x, y)\nseesaw resolve t1 t2 = pogoStick resolve (coupleAlternating t1 t2)\n\nseesawParallel :: (ParallelizableMonad m, Functor s1, Functor s2) => \n                  (forall x y s t. (s ~ SomeFunctor s1 s2, t ~ Trampoline s m (x, y)) => s t -> t)\n                  -> Trampoline s1 m x -> Trampoline s2 m y -> m (x, y)\nseesawParallel resolve t1 t2 = pogoStick resolve (coupleParallel t1 t2)\n\nresolveProducerConsumer :: forall a s s0 t t' m x. \n                           (Functor s0, Monad m, s ~ SomeFunctor (TryYield a) (Await (Maybe a)), \n                            t ~ Trampoline (EitherFunctor s0 s) m x) => \n                           s t -> t\n-- Arg :: s t\n-- (LeftSome (LeftF ...)) : SomeFunctor (EitherFunctor .. ..) (...) t\nresolveProducerConsumer (LeftSome (LeftF (Yield _ c))) = c\nresolveProducerConsumer (LeftSome (RightF (Await c))) = c False\nresolveProducerConsumer (RightSome (Await c)) = c Nothing\nresolveProducerConsumer (Both (NestedFunctor (LeftF (Yield x (Await c))))) = c (Just x)\nresolveProducerConsumer (Both (NestedFunctor (RightF (Await c)))) = suspend (RightF $ RightSome $ c True)\n\ncouplePC :: ParallelizableMonad m => Trampoline (Yield a) m x -> Trampoline (Await (Maybe a)) m y -> m (x, y)\ncouplePC t1 t2 = parallelize (bounce t1) (bounce t2)\n                 >>= \\(s1, s2)-> case (s1, s2)\n                                 of (Done x, Done y) -> return (x, y)\n                                    (Suspend (Yield x c1), Suspend (Await c2)) -> couplePC c1 (c2 $ Just x)\n                                    (Suspend (Yield _ c1), Done y) -> couplePC c1 (return y)\n                                    (Done x, Suspend (Await c2)) -> couplePC (return x) (c2 Nothing)\n\ncoupleFinite :: ParallelizableMonad m => Trampoline (TryYield a) m x -> Trampoline (Await (Maybe a)) m y -> m (x, y)\ncoupleFinite t1 t2 =\n   parallelize (bounce t1) (bounce t2)\n   >>= \\(s1, s2)-> case (s1, s2)\n                   of (Done x, Done y) -> return (x, y)\n                      (Done x, Suspend (Await c2)) -> coupleFinite (return x) (c2 Nothing)\n                      (Suspend (LeftF (Yield x c1)), Suspend (Await c2)) -> coupleFinite c1 (c2 $ Just x)\n                      (Suspend (LeftF (Yield _ c1)), Done y) -> coupleFinite c1 (return y)\n                      (Suspend (RightF (Await c1)), Suspend s2@Await{}) -> coupleFinite (c1 True) (suspend s2)\n                      (Suspend (RightF (Await c1)), Done y) -> coupleFinite (c1 False) (return y)\n\ncoupleFiniteSequential :: Monad m => Trampoline (TryYield a) m x -> Trampoline (Await (Maybe a)) m y -> m (x, y)\ncoupleFiniteSequential t1 t2 =\n   bounce t1\n   >>= \\s1-> bounce t2\n             >>= \\s2-> case (s1, s2)\n                       of (Done x, Done y) -> return (x, y)\n                          (Done x, Suspend (Await c2)) -> coupleFiniteSequential (return x) (c2 Nothing)\n                          (Suspend (LeftF (Yield x c1)), Suspend (Await c2)) -> coupleFiniteSequential c1 (c2 $ Just x)\n                          (Suspend (LeftF (Yield _ c1)), Done y) -> coupleFiniteSequential c1 (return y)\n                          (Suspend (RightF (Await c1)), Suspend s2@Await{}) -> coupleFiniteSequential (c1 True) (suspend s2)\n                          (Suspend (RightF (Await c1)), Done y) -> coupleFiniteSequential (c1 False) (return y)\n\n-- coupleNested :: (Functor s, Monad m) =>\n--                 Trampoline (EitherFunctor s (Yield a)) m x\n--              -> Trampoline (EitherFunctor s (Await (Maybe a))) m y -> Trampoline s m (x, y)\n             \n-- coupleNested t1 t2 =\n--    lift (liftM2 (,) (bounce t1) (bounce t2))\n--    >>= \\(s1, s2)-> case (s1, s2)\n--                    of (Done x, Done y) -> return (x, y)\n--                       (Suspend (RightF (Yield _ c1)), Done y) -> coupleNested c1 (return y)\n--                       (Done x, Suspend (RightF (Await c2))) -> coupleNested (return x) (c2 Nothing)\n--                       (Suspend (RightF (Yield x c1)), Suspend (RightF (Await c2))) -> coupleNested c1 (c2 $ Just x)\n--                       (Suspend (LeftF s), Done y) -> suspend (fmap (flip coupleNested (return y)) s)\n--                       (Done x, Suspend (LeftF s)) -> suspend (fmap (coupleNested (return x)) s)\n--                       (Suspend (LeftF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNested $ suspend $ LeftF s1) s2)\n\ncoupleNestedFinite :: (Functor s, ParallelizableMonad m) =>\n                      Trampoline (SinkFunctor s a) m x -> Trampoline (SourceFunctor s a) m y -> Trampoline s m (x, y)\ncoupleNestedFinite t1 t2 = lift (parallelize (bounce t1) (bounce t2))\n                           >>= stepCouple coupleNestedFinite\n\ncoupleNestedFiniteSequential :: (Functor s, Monad m) =>\n                                Trampoline (SinkFunctor s a) m x\n                             -> Trampoline (SourceFunctor s a) m y\n                             -> Trampoline s m (x, y)\ncoupleNestedFiniteSequential producer consumer = \n   pogoStickNested resolveProducerConsumer (coupleNested producer consumer)\n-- coupleNestedFiniteSequential t1 t2 = lift (liftM2 (,) (bounce t1) (bounce t2))\n--                                      >>= stepCouple coupleNestedFiniteSequential\n\nstepCouple :: (Functor s, Monad m) =>\n              (Trampoline (EitherFunctor s (TryYield a)) m x\n                  -> Trampoline (EitherFunctor s (Await (Maybe a))) m y\n                  -> Trampoline s m (x, y))\n              -> (TrampolineState (EitherFunctor s (TryYield a)) m x,\n                  TrampolineState (EitherFunctor s (Await (Maybe a))) m y)\n              -> Trampoline s m (x, y)\nstepCouple f couple = case couple\n                      of (Done x, Done y) -> return (x, y)\n                         (Done x, Suspend (RightF (Await c2))) -> f (return x) (c2 Nothing)\n                         (Suspend (RightF (LeftF (Yield _ c1))), Done y) -> f c1 (return y)\n                         (Suspend (RightF (LeftF (Yield x c1))), Suspend (RightF (Await c2))) -> f c1 (c2 $ Just x)\n                         (Suspend (RightF (RightF (Await c1))), Suspend s2@(RightF Await{})) -> f (c1 True) (suspend s2)\n                         (Suspend (RightF (RightF (Await c1))), Done y) -> f (c1 False) (return y)\n                         (Suspend (LeftF s), Done y) -> suspend (fmap (flip f (return y)) s)\n                         (Done x, Suspend (LeftF s)) -> suspend (fmap (f (return x)) s)\n                         (Suspend (LeftF s1), Suspend (LeftF s2)) -> suspend (fmap (f $ suspend $ LeftF s1) s2)\n                         (Suspend (LeftF s1), Suspend (RightF s2)) -> suspend (fmap (flip f (suspend $ RightF s2)) s1)\n                         (Suspend (RightF s1), Suspend (LeftF s2)) -> suspend (fmap (f (suspend $ RightF s1)) s2)\n\nlocal :: forall m l r x. (Functor r, Monad m) => Trampoline r m x -> Trampoline (EitherFunctor l r) m x\nlocal (Trampoline mr) = Trampoline (liftM inject mr)\n   where inject :: TrampolineState r m x -> TrampolineState (EitherFunctor l r) m x\n         inject (Done x) = Done x\n         inject (Suspend r) = Suspend (RightF $ fmap local r)\n\nout :: forall m l r x. (Functor l, Monad m) => Trampoline l m x -> Trampoline (EitherFunctor l r) m x\nout (Trampoline ml) = Trampoline (liftM inject ml)\n   where inject :: TrampolineState l m x -> TrampolineState (EitherFunctor l r) m x\n         inject (Done x) = Done x\n         inject (Suspend l) = Suspend (LeftF $ fmap out l)\n\n-- | Class of functors that can be lifted.\nclass (Functor a, Functor d) => AncestorFunctor a d where\n   -- | Convert the ancestor functor into its descendant. The descendant functor typically contains the ancestor.\n   liftFunctor :: a x -> d x\n\ninstance Functor a => AncestorFunctor a a where\n   liftFunctor = id\ninstance (Functor a, Functor d', Functor d, d ~ EitherFunctor d' s, AncestorFunctor a d') => AncestorFunctor a d where\n   liftFunctor = LeftF . (liftFunctor :: a x -> d' x)\n\nliftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Trampoline a m x -> Trampoline d m x\nliftOut (Trampoline ma) = Trampoline (liftM inject ma)\n   where inject :: TrampolineState a m x -> TrampolineState d m x\n         inject (Done x) = Done x\n         inject (Suspend a) = Suspend (liftFunctor $ fmap liftOut a)\n\ntype SourceFunctor a x = EitherFunctor a (Await (Maybe x))\ntype SinkFunctor a x = EitherFunctor a (TryYield x)\n\n-- | A 'Sink' can be used to yield values from any nested `Trampoline` computation whose functor provably descends from\n-- the functor /a/. It's the write-only end of a 'Pipe' communication channel.\ndata Sink (m :: Type -> Type) a x =\n   Sink\n   {\n   -- | Function 'put' tries to put a value into the given `Sink`. The intervening 'Trampoline' computations suspend up\n   -- to the 'pipe' invocation that has created the argument sink. The result of 'put' indicates whether the operation\n   -- succeeded.\n   put :: forall d. (AncestorFunctor a d) => x -> Trampoline d m Bool,\n   -- | Function 'canPut' checks if the argument `Sink` accepts values, i.e., whether a 'put' operation would succeed on\n   -- the sink.\n   canPut :: forall d. (AncestorFunctor a d) => Trampoline d m Bool\n   }\n\n-- | A 'Source' can be used to read values into any nested `Trampoline` computation whose functor provably descends from\n-- the functor /a/. It's the read-only end of a 'Pipe' communication channel.\nnewtype Source (m :: Type -> Type) a x =\n   Source\n   {\n   -- | Function 'get' tries to get a value from the given 'Source' argument. The intervening 'Trampoline' computations\n   -- suspend all the way to the 'pipe' function invocation that created the source. The function returns 'Nothing' if\n   -- the argument source is empty.\n   get :: forall d. (AncestorFunctor a d) => Trampoline d m (Maybe x)\n   }\n\n-- | Converts a 'Sink' on the ancestor functor /a/ into a sink on the descendant functor /d/.\nliftSink :: forall m a d x. (Monad m, AncestorFunctor a d) => Sink m a x -> Sink m d x\nliftSink s = Sink {put= liftOut . (put s :: x -> Trampoline d m Bool),\n                   canPut= liftOut (canPut s :: Trampoline d m Bool)}\n\n-- | Converts a 'Source' on the ancestor functor /a/ into a source on the descendant functor /d/.\nliftSource :: forall m a d x. (Monad m, AncestorFunctor a d) => Source m a x -> Source m d x\nliftSource s = Source {get= liftOut (get s :: Trampoline d m (Maybe x))}\n\n-- | The 'pipe' function splits the computation into two concurrent parts, /producer/ and /consumer/. The /producer/ is\n-- given a 'Sink' to put values into, and /consumer/ a 'Source' to get those values from. Once producer and consumer\n-- both complete, 'pipe' returns their paired results.\npipe :: forall m a a1 a2 x r1 r2. (Monad m, Functor a, a1 ~ SinkFunctor a x, a2 ~ SourceFunctor a x) =>\n        (Sink m a1 x -> Trampoline a1 m r1) -> (Source m a2 x -> Trampoline a2 m r2) -> Trampoline a m (r1, r2)\npipe producer consumer = coupleNestedFiniteSequential (producer sink) (consumer source) where\n   sink = Sink {put= liftOut . (local . tryYield :: x -> Trampoline a1 m Bool),\n                canPut= liftOut (local canYield :: Trampoline a1 m Bool)} :: Sink m a1 x\n   source = Source (liftOut (local await :: Trampoline a2 m (Maybe x))) :: Source m a2 x\n\n-- | The 'pipeP' function is equivalent to 'pipe', except the /producer/ and /consumer/ are run in parallel.\npipeP :: forall m a a1 a2 x r1 r2. (ParallelizableMonad m, Functor a, a1 ~ SinkFunctor a x, a2 ~ SourceFunctor a x) =>\n         (Sink m a1 x -> Trampoline a1 m r1) -> (Source m a2 x -> Trampoline a2 m r2) -> Trampoline a m (r1, r2)\npipeP producer consumer = coupleNestedFinite (producer sink) (consumer source) where\n   sink = Sink {put= liftOut . (local . tryYield :: x -> Trampoline a1 m Bool),\n                canPut= liftOut (local canYield :: Trampoline a1 m Bool)} :: Sink m a1 x\n   source = Source (liftOut (local await :: Trampoline a2 m (Maybe x))) :: Source m a2 x\n\n-- | The 'pipePS' function acts either as 'pipeP' or as 'pipe', depending on the argument /parallel/.\npipePS :: forall m a a1 a2 x r1 r2. (ParallelizableMonad m, Functor a, a1 ~ SinkFunctor a x, a2 ~ SourceFunctor a x) =>\n          Bool -> (Sink m a1 x -> Trampoline a1 m r1) -> (Source m a2 x -> Trampoline a2 m r2) ->\n          Trampoline a m (r1, r2)\npipePS parallel = if parallel then pipeP else pipe\n\ngetSuccess :: forall m a d x . (Monad m, AncestorFunctor a d)\n              => Source m a x -> (x -> Trampoline d m ()) {- ^ Success continuation -} -> Trampoline d m ()\ngetSuccess source succeed = get source >>= maybe (return ()) succeed\n\n-- | Function 'get'' assumes that the argument source is not empty and returns the value the source yields. If the\n-- source is empty, the function throws an error.\nget' :: forall m a d x . (Monad m, AncestorFunctor a d) => Source m a x -> Trampoline d m x\nget' source = get source >>= maybe (error \"get' failed\") return\n\n-- | 'pour' copies all data from the /source/ argument into the /sink/ argument, as long as there is anything to copy\n-- and the sink accepts it.\npour :: forall m a1 a2 d x . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d)\n        => Source m a1 x -> Sink m a2 x -> Trampoline d m ()\npour source sink = fill'\n   where fill' = canPut sink >>= flip when (getSuccess source (\\x-> put sink x >> fill'))\n\n-- | 'pourMap' is like 'pour' that applies the function /f/ to each argument before passing it into the /sink/.\npourMap :: forall m a1 a2 d x y . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d)\n           => (x -> y) -> Source m a1 x -> Sink m a2 y -> Trampoline d m ()\npourMap f source sink = loop\n   where loop = canPut sink >>= flip when (get source >>= maybe (return ()) (\\x-> put sink (f x) >> loop))\n\n-- | 'pourMapMaybe' is to 'pourMap' like 'Data.Maybe.mapMaybe' is to 'Data.List.Map'.\npourMapMaybe :: forall m a1 a2 d x y . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d)\n                => (x -> Maybe y) -> Source m a1 x -> Sink m a2 y -> Trampoline d m ()\npourMapMaybe f source sink = loop\n   where loop = canPut sink >>= flip when (get source >>= maybe (return ()) (\\x-> maybe (return False) (put sink) (f x) >> loop))\n\n-- | 'tee' is similar to 'pour' except it distributes every input value from the /source/ arguments into both /sink1/\n-- and /sink2/.\ntee :: forall m a1 a2 a3 d x . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d, AncestorFunctor a3 d)\n       => Source m a1 x -> Sink m a2 x -> Sink m a3 x -> Trampoline d m ()\ntee source sink1 sink2 = distribute\n   where distribute = do c1 <- canPut sink1\n                         c2 <- canPut sink2\n                         when (c1 && c2)\n                            (get source >>= maybe (return ()) (\\x-> put sink1 x >> put sink2 x >> distribute))\n\n-- | 'putList' puts entire list into its /sink/ argument, as long as the sink accepts it. The remainder that wasn't\n-- accepted by the sink is the result value.\nputList :: forall m a d x. (Monad m, AncestorFunctor a d) => [x] -> Sink m a x -> Trampoline d m [x]\nputList [] sink = return []\nputList l@(x:rest) sink = put sink x >>= cond (putList rest sink) (return l)\n\n-- | 'getList' returns the list of all values generated by the source.\ngetList :: forall m a d x. (Monad m, AncestorFunctor a d) => Source m a x -> Trampoline d m [x]\ngetList source = getList' return\n   where getList' f = get source >>= maybe (f []) (\\x-> getList' (f . (x:)))\n\n-- | 'consumeAndSuppress' consumes the entire source ignoring the values it generates.\nconsumeAndSuppress :: forall m a d x. (Monad m, AncestorFunctor a d) => Source m a x -> Trampoline d m ()\nconsumeAndSuppress source = get source\n                            >>= maybe (return ()) (const (consumeAndSuppress source))\n\n-- | A utility function wrapping if-then-else, useful for handling monadic truth values\ncond :: a -> a -> Bool -> a\ncond x y test = if test then x else y\n\n-- | A utility function, useful for handling monadic list values where empty list means success\nwhenNull :: forall a m. Monad m => m [a] -> [a] -> m [a]\nwhenNull action list = if null list then action else return list\n\n-- | Like 'putList', except it puts the contents of the given 'Data.Sequence.Seq' into the sink.\nputQueue :: forall m a d x. (Monad m, AncestorFunctor a d) => Seq x -> Sink m a x -> Trampoline d m [x]\nputQueue q sink = putList (toList (viewl q)) sink\n", "num_lines": 484}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T3826 where\n\nclass C a where\n  type E a\n  c :: E a -> a -> a\n\ndata T a = MkT a\n-- MkT :: a -> T a\n\ninstance C (T b) where\n  type E (T b) = b\n  c x (MkT _) = MkT x\n\n\nf t@(MkT x) = c x t\n\n{- c :: E alpha -> alpha -> alpha\n   t :: T beta\n   x :: beta\n   f :: T beta -> gamma\n\n\n   [W] C alpha\n   [W] E alpha ~ beta\n   [W] alpha ~ T beta\n   [W] gamma ~ alpha\n\n--->                       beta = t_aqf  alpha = t_aqg\n   alpha := T beta\n   gamma := alpha\n\n   [W] E (T beta) ~ beta\n\n-->\n   [W] ufsk ~ beta\n   [W] E (T beta) ~ ufsk\n\n--> (swap and subst)\n   beta := ufsk\n   [W] x : E (T ufsk) ~ ufsk   (do not rewrite RHS)\n\ntake a step   ax: E (T beta) ~ beta\n\n-->\n   [W] ufsk\n--------------------------\n But what about this?\n--------------------------\n\naxiom F [a] = F [a]\n\n   x : F [a] ~ fsk\nstep\n   ax : F [a] ~ F [a]\nflatten\n   ax ; x : F [a] ~ fsk\n   x = ax ; x       Oh dear!\n-}\n\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies #-}\n\nmodule T3851 where\n\nimport Data.Kind (Type)\n\ntype family TF a :: Type -> Type\ntype instance TF () = App (Equ ())\n\ndata Equ ix ix' where Refl :: Equ ix ix\ndata App f x = App (f x)\n\n-- does not typecheck in 6.12.1 (but works in 6.10.4)\nbar :: TF () () -> ()\nbar (App Refl) = ()\n\n-- does typecheck in 6.12.1 and 6.10.4\nar :: App (Equ ()) () -> ()\nar (App Refl) = ()\n\n------------------\ndata family DF a :: Type -> Type\ndata instance DF () a = D (App (Equ ()) a)\n\nbar_df :: DF () () -> ()\nbar_df (D (App Refl)) = ()\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TypeFamilies #-}\n\n-- Unification yielding a coercion under a forall\n\nmodule Data.Vector.Unboxed where\n\nimport Control.Monad.ST ( ST )\nimport Data.Kind (Type)\n\n\ndata MVector s a = MV\ndata Vector a    = V\n\ntype family Mutable (v :: Type -> Type) :: Type -> Type -> Type\ntype instance Mutable Vector = MVector\n\ncreate :: (forall s. MVector s a) -> Int\ncreate = create1\n-- Here we get  Couldn't match expected type `forall s. MVector s a'\n--                          with actual type `forall s. Mutable Vector s a1'\n-- Reason: when unifying under a for-all we don't solve type\n--         equalities.  Think more about this.\n\ncreate1 :: (forall s. Mutable Vector s a) -> Int\ncreate1 _ = error \"urk\"\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n    -- The type of sizeT is indeed ambiguous\n\nmodule Foo where\n\nimport Data.Kind (Type)\n\ndata P f g r = f r :*: g r\ntype family TrieMapT (f :: Type -> Type) ::\n  Type -> (Type -> Type) -> Type -> Type\nnewtype PMap m1 (m2 :: Type -> (Type -> Type) -> Type -> Type)\n             k (a :: Type -> Type) ix\n  = PMap (m1 k (m2 k a) ix)\ntype instance TrieMapT (P f g) = PMap (TrieMapT f) (TrieMapT g)\n\nclass TrieKeyT f m where\n        unionT :: (TrieMapT f ~ m) => (f k -> a ix -> a ix -> a ix) ->\n                m k a ix -> m k a ix -> m k a ix\n        sizeT :: (TrieMapT f ~ m) => m k a ix -> Int\n\ninstance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (P f g) (PMap m1 m2) where\n        unionT f (PMap m1) (PMap m2) = PMap (uT  (\\ a -> unionT (\\ b -> f (a :*: b))) m1 m2)\n                where uT = unionT\n        sizeT = error \"urk\"\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n        FlexibleContexts,\n        RankNTypes,\n        TypeFamilies,\n        MultiParamTypeClasses,\n        FlexibleInstances #-}\n\n-- See Trac #4178\n\nmodule T4178 where\n\ndata True = T\ndata False = F\n\nclass Decide tf a b where\n  type If tf a b\n  nonFunctionalIf :: tf -> a -> b -> If tf a b\n\ninstance Decide True a b where\n  type If True a b = a\n  nonFunctionalIf T a b = a\n\ninstance Decide False a b where\n  type If False a b = b\n  nonFunctionalIf F a b = b\n\nuseRank2 :: (forall a . a -> b) -> b\nuseRank2 f = f \"foo\"\n\nhasTrouble a = nonFunctionalIf F a (2 :: Int)\nblurg = useRank2 hasTrouble\n\nhasNoTrouble :: a -> Int\nhasNoTrouble = hasTrouble\nblurg2 = useRank2 hasNoTrouble\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, StandaloneDeriving, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}\nmodule T4185 where\n\nimport Data.Kind (Type)\n\ndata family Foo k :: Type -> Type\n\n------------- Generalised newtype deriving of user class -----------\nclass Bar f where\n        bar :: f a -> Int\n        woo :: f a -> f a\n\ninstance Bar Maybe where\n        bar Nothing = 0\n        bar Just{} = 1\n        woo x = x\n\n-- Deriving clause\nnewtype instance Foo Int a = FooInt (Maybe a) deriving (Bar)\n\n-- Standalone deriving\nnewtype instance Foo Char a = FooChar (Maybe a)\nderiving instance Bar (Foo Char)\n\n{-\ndBarMaybe :: Bar Maybe\n\nnewtype FooInt a = FooInt (Maybe a)\naxiom ax7 a : Foo Int a ~ FooInt a   -- Family axiom\naxiom ax7   : FooInt ~ Maybe         -- Newtype axiom\n\ndBarFooInt :: Bar (Foo Int)\ndBarFooInt = dBarMaybe |> Bar ax7\n-}\n\n------------- Deriving on data types for Functor -----------\n\n-- Deriving clause\ndata instance Foo Bool a = FB1 a | FB2 a deriving( Functor )\n\n-- Standalone deriving\ndata instance Foo Float a = FB3 a\nderiving instance Functor (Foo Float)\n\n\n--instance Functor (Foo Bool) where\n--  fmap f (FB1 x) = FB1 (f x)\n--  fmap f (FB2 y) = FB2 (f y)\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T4200 where\n\nimport Data.Kind (Type)\n\nclass C a where\n  type In a :: Type\n  op :: In a -> a -> Int\n\n-- Should be ok; no -XUndecidableInstances required\ninstance (In c ~ Int) => C [c] where \n  type In [c] = In c\n  op _ _ = 3\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}\n\nmodule Main where\n\nclass (There a ~ b, BackAgain b ~ a) => Foo a b where\n     type There a\n     type BackAgain b\n     there :: a -> b\n     back :: b -> a\n     tickle :: b -> b\n\ninstance Foo Char Int where\n     type There Char = Int\n     type BackAgain Int = Char\n     there = fromEnum\n     back = toEnum\n     tickle = (+1)\n\ntest :: (Foo a b) => a -> a\ntest x = back (tickle (there x))\n\nmain :: IO ()\nmain = print $ test 'F'\n\n{-\n\n[G] Foo a b\n[G] There a ~ b\n[G] Back b ~ a\n\n[W] Foo a beta      -- from 'there'\n[W] Foo alpha beta  -- from tickle\n[W] Foo a beta      -- from back\n\n[D] There a ~ beta\n[D] Back beta ~ a\n\n[D] There alpha ~ beta\n[D] Back beta ~ alpha\n\n\n-- Hence beta = b\n--       alpha = a\n\n\n\n[W] Foo a (There t_a1jL)\n[W] Foo t_a1jL (There t_a1jL)\n[W] Back (There t_a1jL) ~ t_a1jL\n\n[D] There a ~ There t_a1jL\n     hence There t_a1jL ~ b\n[D] Back (There t_a1jL) ~ a\n[D] There t_a1jL ~ There t_a1jL\n[D] Back (There t_a1jL) ~ t_a1jL\n-}\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T4356 where\n\nimport Data.Kind (Type)\n\ntype family T t :: Type -> Type -> Type\ntype instance T Bool = (->)\n\nf :: T Bool Bool Bool\nf = not\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleContexts #-}\n\nmodule T4358 where\n\ntype family T a\n\nt2 :: forall a. ((T a ~ a) => a) -> a\nt2 = t\n  \nt :: forall a. ((T a ~ a) => a) -> a\nt = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, EmptyDataDecls, GADTs #-}\n\nmodule T4484 where\n\nimport Data.Kind (Type)\n\ntype family F f :: Type\n\ndata Id c = Id\ntype instance F (Id c) = c\n\ndata C :: Type -> Type where\n  C :: f -> C (W (F f))\n\ndata W :: Type -> Type\n\nfails :: C a -> C a\nfails (C _)\n  = -- We know (W (F f) ~ a)\n    C Id  -- We need (a ~ W (F (Id beta)))\n          --    ie   (a ~ W beta)\n          -- Use the equality; we need\n          --         (W (F f) ~ W beta)\n          --    ie   (F f ~ beta)\n          -- Solve with beta := f\n\nworks :: C (W a) -> C (W a)\nworks (C _)\n  = -- We know (W (F f) ~ W a)\n    C Id -- We need (W a ~ W (F (Id beta)))\n         --      ie (W a ~ W beta)\n         -- Solve with beta := a\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes #-}\n\nmodule T4492 where\n\ntype family F a b\ntype instance F (Maybe a) b = b -> F a b\n\nclass C a where\n   go :: (forall a. Maybe a -> b -> a) -> a -> F a b\n\ninstance C a => C (Maybe a) where\n   go f a b = go f (f a b)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleContexts,  ScopedTypeVariables #-}\n\nmodule T4494 where\n\ntype family H s\ntype family F v\n\nbar :: (forall t. Maybe t -> a) -> H a -> Int\nbar _ = error \"urk\"\n\ncall :: F Bool -> Int\ncall x = bar (\\_ -> x) (undefined :: H (F Bool))\n\n{-\n  [W] H (F Bool) ~ H alpha\n  [W] alpha ~ F Bool\n-->\n  F Bool  ~ fuv0\n  H fuv0  ~ fuv1\n  H alpha ~ fuv2\n\n  fuv1 ~ fuv2\n  alpha ~ fuv0\n\nflatten\n~~~~~~~\nfuv0 := alpha\nfuv1 := fuv2\n\nalpha := F Bool\n-}\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-}  \n\nmodule T4497 where\n\nnorm2PropR a = twiddle (norm2 a) a\n\ntwiddle :: Normed a => a -> a -> Double  \ntwiddle a b = undefined\n\nnorm2 :: e -> RealOf e\nnorm2 = undefined\n\nclass (Num (RealOf t)) => Normed t\n\ntype family RealOf x\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes, ScopedTypeVariables #-}\nmodule T4935 where\n\nimport Control.Applicative\n\ndata TFalse\ndata TTrue\n\ndata Tagged b a = Tagged {at :: a}\ntype At b = forall a. Tagged b a -> a\n\nclass TBool b where onTBool :: (b ~ TFalse => c) -> (b ~ TTrue => c) -> Tagged b c\ninstance TBool TFalse where onTBool f _ = Tagged $ f\ninstance TBool TTrue where onTBool _ t = Tagged $ t\n\ntype family CondV c f t\ntype instance CondV TFalse f t = f\ntype instance CondV TTrue f t = t\n\nnewtype Cond c f a = Cond {getCond :: CondV c a (f a)}\ncond :: forall c f a g. (TBool c, Functor g) => (c ~ TFalse => g a) -> (c ~ TTrue => g (f a)) -> g (Cond c f a)\ncond f t = (at :: At c) $ onTBool (fmap Cond f) (fmap Cond t)\ncondMap :: (TBool c, Functor f) => (a -> b) -> Cond c f a -> Cond c f b\ncondMap g (Cond n) = cond g (fmap g) n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}\n\nmodule Class ( cleverNamedResolve ) where\n\ndata FL p = FL p\n\nclass PatchInspect p where\ninstance PatchInspect p => PatchInspect (FL p) where\n\ntype family PrimOf p\ntype instance PrimOf (FL p) = PrimOf p\n\ndata WithName prim = WithName prim\n\ninstance PatchInspect prim => PatchInspect (WithName prim) where\n\nclass (PatchInspect (PrimOf p)) => Conflict p where\n    resolveConflicts :: p -> PrimOf p\n\ninstance Conflict p => Conflict (FL p) where\n    resolveConflicts = undefined\n\ntype family OnPrim p\n\nclass FromPrims p where\n\ninstance FromPrims (FL p) where\n\njoinPatches :: FromPrims p => p -> p\njoinPatches = id \n\ncleverNamedResolve :: (Conflict (OnPrim p)\n                      ,PrimOf (OnPrim p) ~ WithName (PrimOf p))\n                   => p -> FL (OnPrim p) -> WithName (PrimOf p)\ncleverNamedResolve x = resolveConflicts . joinPatches\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}\n\nmodule Class ( cleverNamedResolve ) where\n\ndata FL p = FL p\n\nclass PatchInspect p where\ninstance PatchInspect p => PatchInspect (FL p) where\n\ntype family PrimOf p\ntype instance PrimOf (FL p) = PrimOf p\n\ndata WithName prim = WithName prim\n\ninstance PatchInspect prim => PatchInspect (WithName prim) where\n\nclass (PatchInspect (PrimOf p)) => Conflict p where\n    resolveConflicts :: p -> PrimOf p\n\ninstance Conflict p => Conflict (FL p) where\n    resolveConflicts = undefined\n\ntype family OnPrim p\n\njoinPatches :: FL p -> FL p\n\njoinPatches = id\n\ncleverNamedResolve :: (Conflict (OnPrim p)\n                      ,PrimOf (OnPrim p) ~ WithName (PrimOf p))\n                   => p -> FL (OnPrim p) -> WithName (PrimOf p)\ncleverNamedResolve x = resolveConflicts . joinPatches\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}\n\nmodule Class ( cleverNamedResolve ) where\n\ndata FL p = FL p\n\nclass PatchInspect p where\ninstance PatchInspect p => PatchInspect (FL p) where\n\ntype family PrimOf p\ntype instance PrimOf (FL p) = PrimOf p\n\ndata WithName prim = WithName prim\n\ninstance PatchInspect prim => PatchInspect (WithName prim) where\n\nclass (PatchInspect (PrimOf p)) => Conflict p where\n    resolveConflicts :: p -> PrimOf p\n\ninstance Conflict p => Conflict (FL p) where\n    resolveConflicts = undefined\n\ntype family OnPrim p\n\njoinPatches :: p -> p\n\njoinPatches = id\n\ncleverNamedResolve :: (Conflict (OnPrim p)\n                      ,PrimOf (OnPrim p) ~ WithName (PrimOf p))\n                   => p -> FL (OnPrim p) -> WithName (PrimOf p)\ncleverNamedResolve x = resolveConflicts . joinPatches\n-- I added the parameter 'x' to make the signature unambiguous\n-- I don't think that ambiguity is essential to the original problem\n\n{-\nresolveConflicts :: q -> PrimOf q\n (w) FL (OnPrim p) ~ q\n (w) WithName (PrimOf p) ~ PrimOf q\n==>\n (w) PrimOf (OnPrim p) ~ PrimOf (FL (OnPrim p))\n==>\n (w) PrimOf (OnPrim p) ~ PrimOf (OnPrim p)\n\n-}\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances, FlexibleContexts #-}\n\nclass A a\nclass B a where b :: a -> ()\ninstance A a => B a where b = undefined\n\nnewtype Y a = Y (a -> ())\n\nokIn701 :: B a => Y a\n-- Weird test case: (B a) is simplifiable\nokIn701 = wrap $ const () . b\n\nokIn702 :: B a => Y a\n-- Weird test case: (B a) is simplifiable\nokIn702 = wrap $ b\n\nokInBoth :: B a => Y a\n-- Weird test case: (B a) is simplifiable\nokInBoth = Y $ const () . b\n\nclass Wrapper a where\n    type Wrapped a\n    wrap :: Wrapped a -> a\ninstance Wrapper (Y a) where\n  type Wrapped (Y a) = a -> ()\n  wrap = Y\n\nfromTicket3018 :: Eq [a] => a -> ()\n-- Weird test case: (Eq [a]) is simplifiable\nfromTicket3018 x = let {g :: Int -> Int; g = [x]==[x] `seq` id} in ()\n\nmain = undefined\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeOperators, TypeFamilies, ScopedTypeVariables #-}\nmodule T5591a where\n\ndata a :=: b where \n    Refl :: a :=: a\n\nsubst :: a :=: b -> f a -> f b\nsubst Refl = id \n\n-- Then this doesn't work (error message at the bottom):\n\ninj1 :: forall f a b. f a :=: f b -> a :=: b\ninj1 Refl = Refl\n\n-- But one can still construct it with a trick that Oleg used in the context of \n-- Leibniz equality:\n\ntype family Arg fa\n\ntype instance Arg (f a) = a\n\nnewtype Helper fa fa' = Helper { runHelper :: Arg fa :=: Arg fa' }\n\ninj2 :: forall f a b. f a :=: f b -> a :=: b\ninj2 p = runHelper (subst p (Helper Refl :: Helper (f a) (f a)))\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, KindSignatures, \n    GADTs, FlexibleInstances, FlexibleContexts #-}\nmodule T5591b where\n\nimport Data.Kind (Type)\n\nclass Monad m => Effect p e r m | p e m -> r where\n  fin :: p e m -> e -> m r\n\ndata ErrorEff :: Type -> (Type -> Type) -> Type where\n  CatchError :: (e -> m a) -> ErrorEff ((e -> m a) -> m a) m\n\ninstance Monad m => Effect ErrorEff ((e -> m a) -> m a) a m where\n  fin (CatchError h) = \\f -> f h\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5955 where\n\nimport T5955a\n\n\nfoo :: ()\nfoo = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T5955a where\n\n\nclass (Eq (Multi a)) => MultiPrim a where\n    data Multi a\n\ninstance MultiPrim Int where\n    newtype Multi Int = MultiInt Int deriving (Eq)\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE EmptyDataDecls #-}\n\nmodule T6088 where\n\nclass C a\n\nnewtype A n = A Int\n\ntype family Pos n\ndata True\n\ninstance (Pos n ~ True) => C (A n)\n\nnewtype B n = B (A n) deriving (C)\n  -- This should work, giving\n  -- instance C (B n)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeFamilies, GADTs #-}\n\nmodule T6152 where\n\ndata U = Unit\n\ndata SU (a :: U) where\n   SInt :: SU Unit\n\ntype family I (a :: U) :: U\ntype instance I Unit = Unit\n\ntype SUI a = SU (I a)\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T7082 where\n\nimport Data.Kind (Type)\n\nclass R m where\n  type D m a :: Type\n  type D m a = ()                -- (1)\n  f :: m a -> D m a -> ()\n\ninstance R Maybe where\n  -- type D Maybe a = ()         -- (2)\n  f = undefined\n\nx = f (Nothing :: Maybe Int) ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ExistentialQuantification #-}\n\nmodule T7156 where\n\ndata T a = (a ~ ()) => T\n\nf :: T a -> a\nf T = ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, MultiParamTypeClasses, FlexibleContexts,\n   TypeFamilies, ScopedTypeVariables #-}\n\nmodule T7280 where\n\nimport Data.Kind (Type)\n\ntype family Mutable (v :: Type -> Type) :: Type -> Type -> Type\nclass MVector (v :: Type -> Type -> Type) a\nclass MVector (Mutable v) a => Vector v a where\n   copy :: Monad m => Mutable v s a -> v a -> m ()\n\ndata Chunk v s a = Chunk (forall m. (Monad m, Vector v a) => Mutable v s a -> m ())\n\nvstep (v:vs) = Chunk (\\mv -> copy mv v)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# OPTIONS -XTypeFamilies -XDataKinds -XPolyKinds #-}\n\nmodule T7282 where\n\nimport Data.Kind (Type)\n\nclass Foo (xs :: [k]) where\n     type Bar xs :: Type\n\ninstance Foo '[] where\n     type Bar '[] = Int\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TypeFamilies, GADTs, FlexibleContexts, MultiParamTypeClasses #-}\n\nmodule T7474 where\n\nimport Data.Kind (Type)\n\ntype family T :: Type -> Type\n\ndata E :: Type -> Type where\n    E :: C p => T (T p) -> E p\n\nclass C' b a where c :: T b -> a\n\nclass C' (T a) a => C a\n\n-- f :: C' (T p) a => E p -> a\nf (E d) = c d\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, GADTs, TypeFamilies #-}\n\nmodule T7489 where\n\nimport Data.Kind (Type)\n\ndata Credit\ndata Debit\n\ndata family Account (s :: Type) (t :: Type)\n\ndata instance Account Int t where\n  CAccount :: Account Int Credit\n  DAccount :: {  debitAccountPostings :: [Int] } -> Account Int Debit\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes, KindSignatures, PolyKinds, TypeOperators, DataKinds,\n             TypeFamilies #-}\n\nmodule Bug where\n\nimport Data.Kind\n\ndata SBool :: Bool -> Type where\n  SFalse :: SBool False\n  STrue :: SBool True\n\ndata SList :: [Bool] -> Type where\n  SNil :: SList '[]\n  SCons :: SBool h -> SList t -> SList (h ': t)\n\ntype family (a :: [k]) :==: (b :: [k]) :: Bool where\n  '[] :==: '[] = True\n  (h1 ': t1) :==: (h2 ': t2) = True\n  a :==: b = False\n\n(%==%) :: SList ls1 -> SList ls2 -> SBool (ls1 :==: ls2)\nSNil %==% (SCons _ _) = SFalse\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ConstraintKinds,\n             PolyKinds, KindSignatures, DataKinds, TypeOperators,\n             TypeFamilies, UndecidableInstances,\n             FlexibleContexts, ScopedTypeVariables #-}\nmodule T7786 where\n\nimport Data.Kind (Type)\nimport GHC.TypeLits(Symbol,Nat)\n\ndata family Sing (a :: k)\n\ndata Inventory a = Empty | More (Inventory a) a\n\ndata instance Sing (l :: Inventory a) where\n  Nil :: Sing Empty\n  Snoc :: Sing bs -> Sing b -> Sing (More bs b)\n\ndata KeySegment = Numic Nat | Symic Symbol\n\ndata instance Sing (n :: KeySegment) where\n  Numic' :: Sing n -> Sing (Numic n)\n  Symic' :: Sing ss -> Sing (Symic ss)\n\ndata instance Sing (k :: [KeySegment]) where\n  Root' :: Sing ('[] :: [KeySegment])\n  Symic'' :: Sing p -> Sing k -> Sing (Symic k ': p)\n  Numic'' :: Sing p -> Sing k -> Sing (Numic k ': p)\n\ntype family Under (pre :: [KeySegment]) (post :: [KeySegment]) :: [KeySegment]\ntype instance Under '[] post = post\ntype instance Under (x ': xs) post = x ': xs `Under` post\n\nunder :: Sing (pre :: [KeySegment]) -> Sing (post :: [KeySegment]) -> Sing (pre `Under` post)\nunder Root' post = post\nunder (Symic'' ks k) post = under ks post `Symic''` k\nunder (Numic'' ks k) post = under ks post `Numic''` k\n\ndata Database :: Inventory [KeySegment] -> Type where\n  Clean :: Database Empty\n  Record :: (k `KeyNotIn` i) => Database i -> Sing k -> () -> Database (More i k)\n  Sub :: ((sub `UnderDisjoint` k) i) => Database i -> Sing k -> Database sub -> Database ((sub `BuriedUnder` k) i)\n\ndbKeys :: Database inv -> Sing inv\ndbKeys Clean = Nil\ndbKeys (Record db k _) = dbKeys db `Snoc` k\ndbKeys (Sub db k sub) = (dbKeys sub `buryUnder` k) (dbKeys db)\n\nburyUnder :: Sing sub -> Sing post -> Sing acc -> Sing ((sub `BuriedUnder` post) acc)\nburyUnder Nil _ acc = acc\nburyUnder (ps `Snoc` p) post acc = (ps `buryUnder` post) acc `Snoc` (p `under` post)\n\ntype key `KeyNotIn` inv = Intersect (More Empty key) inv ~ Empty\ntype (lhs `UnderDisjoint` post) rhs = Intersect ((lhs `BuriedUnder` post) Empty) rhs ~ Empty\n\ntype family Intersect (l :: Inventory a) (r :: Inventory a) :: Inventory a where\n  Intersect Empty r = Empty\n  Intersect l Empty = Empty\n  Intersect (More ls l) r = InterAppend (Intersect ls r) r l\n\ntype family InterAppend (l :: Inventory a)\n                        (r :: Inventory a)\n                        (one :: a)\n            :: Inventory a where\n  InterAppend acc Empty one = acc\n  InterAppend acc (More rs one) one = More acc one\n  InterAppend acc (More rs r) one = InterAppend acc rs one\n\ntype family BuriedUnder (sub :: Inventory [KeySegment])\n                        (post :: [KeySegment])\n                        (inv :: Inventory [KeySegment])\n            :: Inventory [KeySegment] where\n  BuriedUnder Empty post inv = inv\n  BuriedUnder (More ps p) post inv = More ((ps `BuriedUnder` post) inv) (p `Under` post)\n\n\nintersectPaths :: Sing (lhs :: Inventory [KeySegment]) -> Sing (rhs :: Inventory [KeySegment]) -> Sing (lhs `Intersect` rhs)\nintersectPaths = undefined\n\n{- This foo is ambiguous\nfoo :: Database inv\n    -> Sing post\n    -> Database sub\n    -> Sing (Intersect (BuriedUnder sub post 'Empty) rhs)\nfoo db k sub = buryUnder (dbKeys sub) k Nil `intersectPaths` dbKeys db\n-}\n\nfoogle :: Database inv\n       -> Sing post\n       -> Database sub\n       -> Maybe (Sing (Intersect (BuriedUnder sub post 'Empty) inv))\n\nfoogle db k sub = return (buryUnder (dbKeys sub) k Nil `intersectPaths` dbKeys db)\n\n\naddSub :: Database inv -> Sing k -> Database sub -> Maybe (Database ((sub `BuriedUnder` k) inv))\naddSub db k sub = do Nil :: Sing xxx <- foogle db k sub\n                     return $ Sub db k sub\n\n{-\naddSub :: Database inv -> Sing k -> Database sub -> Maybe (Database ((sub `BuriedUnder` k) inv))\naddSub db k sub = do Nil :: Sing xxx <- foogle db sub k\n                     -- Nil :: Sing ((sub `BuriedUnder` k) Empty `Intersect` inv) <- return (buryUnder (dbKeys sub) k Nil `intersectPaths` dbKeys db)\n                     -- Nil :: Sing Empty <- return (buryUnder (dbKeys sub) k Nil `intersectPaths` dbKeys db)\n                     -- Nil <- return (buryUnder (dbKeys sub) k Nil `intersectPaths` dbKeys db)\n                     return $ Sub db k sub\n-}\n", "num_lines": 107}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes #-}\n\nmodule T7804 where\n\ntype family F f a\n\ndata Proxy a = P\n\nsDFMap :: (forall a. Proxy f -> Proxy a -> Proxy (F f a)) -> Int\nsDFMap _ = 3\n\n\n{-\nflat cache\n [G] F f_aqh aqj ~ fsk_aqp\n [G] F f_aqg aqj ~ fsk_aqq\n\n [W] aqk : f_aqh[2] ~ f_aqg\n [w] aql : fsk_aqp ~ fsk_aqq\n\n [G] F f_agh a_aqj ~ F f_aqg\n-}", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\nmodule T7837 where\n\ntype family Scalar a\nclass Fractional (Scalar a) => Norm a where\n  norm :: a -> Scalar a\n\ntype instance Scalar Double = Double\ninstance Norm Double where norm = abs\n\nnormalize :: (Norm a, a ~ Scalar a) => a -> a\nnormalize x = x / norm x\n{-# NOINLINE normalize #-}\n\nnormalize_Double :: Double -> Double\nnormalize_Double = signum\n{-# NOINLINE normalize_Double #-}\n\n-- This rule should fire in 'foo'\n{-# RULES \"normalize/Double\" normalize = normalize_Double #-}\n\nfoo :: Double\nfoo = normalize (4 :: Double)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8002 where\n\nimport T8002a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T8002a where\n\nimport T8002b\n\nclass QA a where\n   type QRep a\n   type QRep a = QRep (Maybe a)\n\ninstance QA () where\n   type QRep () = ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8002b where\n\ntype family Rep a\ntype instance Rep Int = Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\nmodule T8011( clean )  where\n\nimport Data.Char (isAlphaNum)\nimport Data.List (dropWhile)\nimport T8011a ( ToURL(URLT, toURL) )\n\nclean :: (ToURL url, Show (URLT url)) => url -> String\nclean = filter isAlphaNum . show . toURL\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8011a ( ToURL(toURL, nullURL, errorURL, URLT) ) where\n\nclass ToURL a where\n     type URLT a\n     toURL :: a -> URLT a\n     nullURL :: a\n     errorURL :: a -> URLT a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T8018 where\n\ndata Foo a = Bar (F a)\n\ntype family F a where\n  F (Foo a) = Bool", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T8020 where\n\ntype family F a b where\n  F (Maybe a) [a] = Int\n  F b c           = Bool\n\ndata Proxy a = P\n\ntype family G\n\nfoo :: Proxy d -> F d d -> Bool\nfoo _ = not\n\nbar :: Bool -> Bool\nbar = foo (P :: Proxy G)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE TypeFamilies #-}\n\nmodule T8500 where\n\nimport T8500a\n\ninstance C Int where\n   type F Int = Double\n\ninstance C Bool\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T8500a where\n\nclass C a where\n   type F a\n   type F a = [a]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, FlexibleContexts, TypeFamilies #-}\nmodule T8651 where\n\nimport Data.Monoid\n\ntype family Id a\n\ntype instance Id a = a\n --type instance Id [a] = [Id a]\n\nfoo :: (Monoid (Id String) => r) -> r\nfoo x = x\n\nbar = foo \"Hello\"\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds #-}\n{-# OPTIONS_GHC -fwarn-missing-signatures #-}  -- Report f's inferred type\n\nmodule T8889 where\n\nimport GHC.Exts\n\nclass C f where\n  type C_fmap f a :: Constraint\n  foo :: C_fmap f a => (a -> b) -> f a -> f b\n\nf x = foo x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE PolyKinds #-}\n\nmodule T8913 where\n\nimport Data.Kind (Type)\n\nclass GCat f where\n   gcat :: f p -> Int\n\ncat :: (GCat (MyRep a), MyGeneric a) => a -> Int\ncat x = gcat (from x)\n\nclass MyGeneric a where\n   type MyRep a :: Type -> Type\n   from :: a -> (MyRep a) p\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, TypeFamilies #-}\nmodule T8978 where\n\nimport Data.Kind (Type)\n\ntype Syn a = Associated a\n\nclass Eq (Associated a) => Foo a where\n    type Associated a :: Type\n    foo :: a -> Syn a -> Bool\n\ninstance Foo () where\n    type Associated () = Int\n    foo _ x = x == x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8979 where\n\ntype family F a\ntype family G a\n\ntype H a = G a\n\nf :: F (G Char) -> F (H Char)\nf a = a\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T9085 where\n\ntype family F a where\n  F a = Int\n  F Bool = Bool\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes, ConstraintKinds, TypeFamilies #-}\n\nmodule T9090 where\n\nimport GHC.Exts (Constraint)\n\ntype family F (c :: Constraint) :: Constraint\ntype instance F (Eq a) = Eq a\n\n-- checks\nf :: Eq b => (forall a. F (Eq a) => f a -> Bool) -> f b -> Bool\nf _ = error \"urk\" -- g x = g x\n\n-- checks\nf' :: Eq b => (forall a. Eq a => f a -> Bool) -> f b -> Bool\nf' = f\n\n-- checks, so GHC seems to think that both types are interchangeable\nf'' :: Eq b => (forall a. F (Eq a) => f a -> Bool) -> f b -> Bool\nf'' = f'\n\n-- checks\ntest' y = f' (\\ (Just x) -> x /= x) y\n\n-- fails\ntest y = f (\\ (Just x) -> x /= x) y\n\n-- fails too, unsurprisingly\ntest'' y = f'' (\\ (Just x) -> x /= x) y\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T9211 where\n\n-- foo :: (forall f g. (Functor f) => f a -> f b) -> [a] -> [b]\nfoo :: (forall f g. (Functor f, g ~ f) => g a -> g b) -> [a] -> [b]\nfoo tr x = tr x\n\nt = foo (fmap not) [True]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule SingletonsBug where\n\nimport Control.Applicative\nimport Data.Traversable (for)\nimport Data.Kind (Type, Constraint)\n\n-----------------------------------\n-- From 'constraints' library\n-- import Data.Constraint (Dict(..))\ndata Dict :: Constraint -> Type where\n  Dict :: a => Dict a\n\n-----------------------------------\n-- From 'singletons' library\n-- import Data.Singletons hiding( withSomeSing )\n\nclass SingI (a :: k) where\n  -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@\n  -- extension to use this method the way you want.\n  sing :: Sing a\n\ndata family Sing (a :: k)\n\ndata KProxy (a :: Type) = KProxy\n\ndata SomeSing (kproxy :: KProxy k) where\n  SomeSing :: Sing (a :: k) -> SomeSing ('KProxy :: KProxy k)\n\n-- SingKind :: forall k. KProxy k -> Constraint\nclass (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where\n  -- | Get a base type from a proxy for the promoted kind. For example,\n  -- @DemoteRep ('KProxy :: KProxy Bool)@ will be the type @Bool@.\n  type DemoteRep kparam :: Type\n\n  -- | Convert a singleton to its unrefined version.\n  fromSing :: Sing (a :: k) -> DemoteRep kparam\n\n  -- | Convert an unrefined type to an existentially-quantified singleton type.\n  toSing   :: DemoteRep kparam -> SomeSing kparam\n\nwithSomeSing :: SingKind ('KProxy :: KProxy k)\n             => DemoteRep ('KProxy :: KProxy k)\n             -> (forall (a :: k). Sing a -> r)\n             -> r\nwithSomeSing _ _ = error \"urk\"\n\n-----------------------------------\n\ndata SubscriptionChannel = BookingsChannel\ntype BookingsChannelSym0 = BookingsChannel\ndata instance Sing (z_a5I7 :: SubscriptionChannel) where\n   SBookingsChannel :: Sing BookingsChannel\n\ninstance SingKind ('KProxy :: KProxy SubscriptionChannel) where\n  type DemoteRep ('KProxy :: KProxy SubscriptionChannel) = SubscriptionChannel\n  fromSing SBookingsChannel = BookingsChannel\n  toSing BookingsChannel = SomeSing SBookingsChannel\n\ninstance SingI BookingsChannel where\n  sing = SBookingsChannel\n\ntype family T (c :: SubscriptionChannel) :: Type\ntype instance T 'BookingsChannel = Bool\n\nwitnessC :: Sing channel -> Dict (Show (T channel), SingI channel)\nwitnessC SBookingsChannel = Dict\n\nforAllSubscriptionChannels\n  :: forall m r. (Applicative m)\n  => (forall channel. (SingI channel, Show (T channel)) => Sing channel -> m r)\n  -> m r\nforAllSubscriptionChannels f =\n  withSomeSing BookingsChannel $ \\(sChannel) ->\n    case witnessC sChannel of\n      Dict -> f sChannel\n", "num_lines": 88}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs, TypeFamilies #-}\nmodule T9582 where\n\nclass C a where\n  type T a\n  m :: a -> T a\n\ninstance C Int where\n  type T Int = String\n  m :: Int -> String\n  m _ = \"bla\"\n\n-- Method signature does not match class; it should be m :: T Int\n--    In the instance declaration for \u00e2\u20ac\u02dcC Int\u00e2\u20ac\u2122\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule T9662 where\n\ndata Exp a = Exp\ndata (a:.b) = a:.b\n\ntype family Plain e :: *\ntype instance Plain (Exp a) = a\ntype instance Plain (a:.b) = Plain a :. Plain b\n\nclass (Plain (Unlifted pattern) ~ Tuple pattern) => Unlift pattern where\n   type Unlifted pattern\n   type Tuple pattern\n\nmodify :: (Unlift pattern) =>\n   pattern ->\n   (Unlifted pattern -> a) ->\n   Exp (Tuple pattern) -> Exp (Plain a)\nmodify p f = undefined\n\n\ndata Atom a = Atom\n\natom :: Atom a\natom = Atom\n\n\ninstance (Unlift pa, int ~ Atom Int) => Unlift (pa :. int) where\n   type Unlifted (pa :. int) = Unlifted pa :. Exp Int\n   type Tuple (pa :. int) = Tuple pa :. Int\n\n\ndata Shape sh = Shape\n\nbackpermute ::\n   (Exp sh -> Exp sh') ->\n   (Exp sh' -> Exp sh) ->\n   Shape sh -> Shape sh'\nbackpermute = undefined\n\ntest :: Shape (sh:.k:.m:.n) -> Shape (sh:.m:.n:.k)\ntest =\n   backpermute\n      (modify (atom:.atom:.atom:.atom)\n         (\\(sh:.k:.m:.n) -> (sh:.m:.n:.k)))\n      id\n\n-- With this arg instead of just 'id', it worked\n--    (modify (atom:.atom:.atom:.atom)\n--       (\\(ix:.m:.n:.k) -> (ix:.k:.m:.n)))\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, TypeFamilies, TypeOperators #-}\n\nmodule T9747 where\nimport Data.List (intercalate)\nimport Data.Proxy\nimport Data.Kind (Type, Constraint)\n\ndata HList :: [Type] -> Type where\n  Nil :: HList '[]\n  Cons :: a -> HList as -> HList (a ': as)\n\ntype family HListAll (c :: Type -> Constraint)\n                     (ts :: [Type]) :: Constraint where\n  HListAll c '[] = ()\n  HListAll c (t ': ts) = (c t, HListAll c ts)\n\nshowHList :: HListAll Show ts => HList ts -> String\nshowHList = (\"[\" ++ ) . (++\"]\") . intercalate \", \" . go\n  where\n    go :: HListAll Show ts => HList ts -> [String]\n    go Nil = []\n    go (Cons x xs) = show x : go xs\n\n-- Things work okay up to this point\ntest :: String\ntest = showHList (Cons (2::Int)\n                 (Cons (3.1 :: Float)\n                 (Cons 'c' Nil)))\n\ntype family ConFun (t :: Type) :: Type -> Constraint\ndata Tag\ntype instance ConFun Tag = Group\n\nclass (Show a, Eq a, Ord a) => Group a\n\n-- This is notionally similar to showHList\nbar :: HListAll (ConFun l) ts => Proxy l -> HList ts -> ()\nbar _ _ = ()\n\nbaz :: (ConFun l a, ConFun l b) => Proxy l -> HList [a,b] -> ()\nbaz = bar\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T9840 where\n\nimport Data.Kind (Type)\nimport T9840a\n\ntype family X :: Type -> Type where\n\ntype family F (a :: Type -> Type) where\n\nfoo :: G (F X) -> G (F X)\nfoo x = x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T9840a where\n\nimport {-# SOURCE #-} T9840\n\ntype family G a where\n\nbar :: X a -> X a\nbar = id\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies #-}\n\nmodule TF_GADT where\n\n-- Check that type families can be declared in GADT syntax\n-- and indeed *be* GADTs\n\ndata family T a\n\ndata instance T [a] where\n  T1 :: a -> T [a]\n\n\ndata instance T (Maybe a) where\n  T3 :: Int -> T (Maybe Int)\n  T4 :: a -> b -> T (Maybe (a,b))\n\n\nf :: a -> T (Maybe a) -> T (Maybe a)\nf x (T3 i) = T3 x\nf x (T4 p q) = T4 p (snd x)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\n\n-- See Trac #10982\n\nmodule UnusedTyVarWarnings where\n\ntype family C a b where\n  C a b = a                 -- should warn\n\ntype family C2 a b\ntype instance C2 a b = a    -- should warn\n\ntype family D a b where\n  D a _b = a                -- should not warn\n\ntype family D2 a b\ntype instance D2 a _b = a   -- should not warn\n\ntype family E a b where\n  E a _ = a                 -- should not warn\n\ntype family E2 a b\ntype instance E2 a _ = a    -- should not warn\n\ntype family X a b where\n  X a a = Int               -- a is considered used, do not warn\n  X a Int = Bool            -- here a is unused\n\ntype family Y a b c where\n  Y a b b = a               -- b is used, do no warn\n\ndata family I a b c\ndata instance I a b c = IDC1 a | IDC2 c  -- should warn\n\ndata family J a b\ndata instance J a _b = JDC a  -- should not warn\n\ndata family K a b\ndata instance K a _ = KDC a   -- should not warn\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, NamedWildCards #-}\n\n-- See Trac #10982\n\nmodule UnusedTyVarWarningsNamedWCs where\n\ntype family C a b where\n  C a b = a                 -- should warn\n\ntype family C2 a b\ntype instance C2 a b = a    -- should warn\n\ntype family D a b where\n  D a _b = a                -- should not warn\n\ntype family D2 a b\ntype instance D2 a _b = a   -- should not warn\n\ntype family E a b where\n  E a _ = a                 -- should not warn\n\ntype family E2 a b\ntype instance E2 a _ = a    -- should not warn\n\ntype family X a b where\n  X a a = Int               -- a is considered used, do not warn\n  X a Int = Bool            -- here a is unused\n\ntype family Y a b c where\n  Y a b b = a               -- b is used, do no warn\n\ndata family I a b c\ndata instance I a b c = IDC1 a | IDC2 c  -- should warn\n\ndata family J a b\ndata instance J a _b = JDC a  -- should not warn\n\ndata family K a b\ndata instance K a _ = KDC a   -- should not warn\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DeriveGeneric #-}\n\nmodule T13092b_1 where\n\nimport GHC.Generics\n\ndata X = X deriving (Generic)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T13092b_2 where\n\nimport T13092b_1\n\nx :: X\nx = X\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From the GHC users mailing list, 3/9/14\n\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule BadSock where\n\nimport Data.Proxy\nimport GHC.Exts\n\ndata Message\n\ndata SocketType = Dealer | Push | Pull\n\ndata SocketOperation = Read | Write\n\ndata SockOp :: SocketType -> SocketOperation -> * where\n    SRead :: Foo 'Read sock => SockOp sock 'Read\n    SWrite :: Foo Write sock => SockOp sock Write\n\ndata Socket :: SocketType -> * where\n    Socket :: proxy sock\n           -> (forall op . Foo op sock => SockOp sock op -> Operation op)\n           -> Socket sock\n\ntype family Foo (op :: SocketOperation) :: SocketType -> Constraint where\n    Foo 'Read = Readable\n    Foo Write = Writable\n\ntype family Operation (op :: SocketOperation) :: * where\n    Operation 'Read = IO Message\n    Operation Write = Message -> IO ()\n\ntype family Readable (t :: SocketType) :: Constraint where\n    Readable Dealer = ()\n    Readable Pull = ()\n\ntype family Writable (t :: SocketType) :: Constraint where\n    Writable Dealer = ()\n    Writable Push = ()\n\n{-\ndealer :: Socket Dealer\ndealer = undefined\n\npush :: Socket Push\npush = undefined\n\npull :: Socket Pull\npull = undefined\n\nreadSocket :: forall sock . Readable sock => Socket sock -> IO Message\nreadSocket (Socket _ f) = f (SRead :: SockOp sock 'Read)\n-}\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ClosedFam3 where\n\nimport ClosedFam3a\n\ntype family Foo a where\n  Foo Int = Bool\n  Foo Double = Char\n\ntype family Bar a where\n  Bar Int = Bool\n  Bar Double = Double\n\ntype family Baz a where\n  Baz Int = Bool\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ClosedFam3a where\n\nimport {-# SOURCE #-} ClosedFam3\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ClosedFam4 where\n\ntype family Foo a where ..\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, StandaloneDeriving #-}\n\n-- Crashed 6.12\n\nmodule T1769 where\n\ndata family T a\nderiving instance Functor T\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule ExplicitForAllFams3 where\n\ntype family H a b where\n  forall a.   H [a] (Maybe b) = Double\n\ntype family J a\ntype instance forall a.   J (a, b) = Bool\n\ndata family K a\ndata instance forall a.   K (a, b)    = K4 Bool\n\ndata family L a\nnewtype instance forall a.   L (a, b)    = L4 { unL4 :: Bool    }\n\nclass C a where\n  type CT a b\n  data CD a b\ninstance C Int where\n  type forall a.   CT [a] (Maybe b) = Bool\n  data forall a.   CD [a] (Maybe b) = CD4 Bool\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule ExplicitForAllFams4a where\n\ntype family H a b where\n  forall a b. H [a] (a,a)     = Float\n  forall b.   H _ _           = Maybe b\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule ExplicitForAllFams4 where\n\ntype family J a\ntype instance forall a b. J [a]    = Float\ntype instance forall b.   J _      = Maybe b\n\ndata family K a\ndata instance forall a b. K (a, Bool) = K5 Float\ndata instance forall b.   K _         = K6 (Maybe b)\n\ndata family L a\nnewtype instance forall a b. L (a, Bool) = L5 { unL5 :: Float   }\nnewtype instance forall b.   L _         = L6 { unL56:: Maybe b }\n\nclass C a where\n  type CT a b\n  data CD a b\n\ninstance C Int where\n  type forall a b. CT [a] (a,a)     = Float\n  type forall b.   CT _ _           = Maybe b\n\n  data forall a b. CD [a] (a,a)     = CD5 Float\n  data forall b.   CD _ _           = CD6 (Maybe b)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FunctionalDependencies, FlexibleContexts, GADTs, ScopedTypeVariables #-}\n\nmodule ExtraTcsUntch where\n\n\nclass C x y | x -> y where\n op :: x -> y -> ()\n\ninstance C [a] [a]\n\ntype family F a :: *\n\nh :: F Int -> ()\nh = undefined\n\ndata TEx where\n  TEx :: a -> TEx\n\n\n\nf x =\n    let g1 :: forall b. b -> ()\n        g1 _ = h [x]\n\n        g2 z = case z of TEx y -> (h [[undefined]], op x [y])\n\n    in (g1 '3', g2 undefined)\n\n\n{- This example comes from Note [Extra TcS Untouchables] in TcSimplify. It demonstrates\n   why when floating equalities out of an implication constraint we must record the free\n   variables of the equalities as untouchables. With GHC 7.4.1 this program gives a Core\n   Lint error because of an existential escaping.\n\n    assuming x:beta\n\n    forall b. F Int ~ [beta]                          (from g1)\n    forall a. F Int ~ [[alpha]], C beta [a]           (from g2)\n\n-}\n\n\n\n\n{- Assume x:beta\n   From g1 we get [W]    (forall b.  F Int ~ [beta])\n\n   From g2 we get [W]   (forall c. 0 => F Int ~ [[alpha]] /\\ C beta [c])\n    (g2 is not generalised; the forall comes from the TEx pattern)\n\napproximateWC then gives the candidate constraints to quantify\n   F Int ~ [beta], F Int ~ [[alpha']]\n\n(alpha' is the promoted version of alpha)\n\nNow decide inferred sig for f :: F Int ~ [beta] => beta -> blah\nsince beta is mentioned in tau-type for f but alpha' is not\n\nPerhaps this is a stupid constraint to generalise over (we don't\ngeneralise over (C Int).\n-}", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, RankNTypes, ScopedTypeVariables #-}\n\nmodule ShouldFail where\n\ntype family Const a\ntype instance Const a = ()\n\ndata T a where T :: c -> T (Const c)\n\ncoerce :: forall a b . a -> b\ncoerce x = case T x :: T (Const b) of\n             T y -> y\n\n{-\n  T :: forall a. forall c. (a ~ Const c) => c -> T a\n\n  a ~ gamma        -- Instantiate T with a=alpha, c=gamma\n  alpha ~ Const b  -- Result of (T x)\n  alpha ~ Const gamma  -- Constraint from (T x)\n\n  y::c\n  forall c. (Const b ~ Const c) => c ~ b\n\n==> \n  Const b ~ Const a\n\n------------\n\ncase e of \n  T y -> y\n\n  e :: T alpha\n\n  Patterns\n   forall c. (alpha ~ Const c) => c ~ b\n   alpha ~ Const b\n\n-}  ", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\ntype family F a b\ntype instance F a a = Int\ntype instance F [a] a = Bool\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonomorphismRestriction #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- Type error message looks like\n--      TF.hs:12:11:\n--    Couldn't match expected type `Memo d'\n--           against inferred type `Memo d1'\n--      NB: `Memo' is a (non-injective) type function\n--\n-- Note the \"NB\", which helps point out the problem\n\nmodule Foo where\n\nclass Fun d where\n    type Memo d :: * -> *\n    abst :: (d -> a) -> Memo d a\n    appl :: Memo d a -> (d -> a)\n\nf ::  (Fun d) => Memo d a -> Memo d a    -- (1)\nf = abst . appl\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- This is actually perfectly ok!\n\nmodule NonLinearSigErr where\n\nimport Data.Kind (Type)\n\ntype family E a b\ntype instance E a (a :: Type) = [a]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule NotRelaxedExamples where\n\ntype family F1 a\ntype family F2 a\ntype family F3 a\n\ntype instance F1 Char = F1 (F1 Char)\ntype instance F2 [x]  = F2 [x]\ntype instance F3 Bool = F3 [Char]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule OverA (C, D)\nwhere\n\nimport Data.Kind (Type)\n\ndata family C a b :: Type\n\ntype family D a b :: Type\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule OverB\nwhere\nimport OverA (C, D)\n\ndata instance C [Int] [a] = CListList2\n\ntype instance D [Int] [a] = Int", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule OverC\nwhere\nimport OverA (C, D)\n\ndata instance C [a] [Int] = C9ListList\n\ntype instance D [a] [Int] = Char\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module OverD where\n-- Tests that we verify consistency of type families between\n-- transitive imports.\nimport OverB\nimport OverC\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule OverDirectThisModA (C, D)\nwhere\n\nimport Data.Kind (Type)\n\ndata family C a b :: Type\n\ntype family D a b :: Type\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule OverDirectThisModB\nwhere\nimport OverDirectThisModA (C, D)\n\ndata instance C [Int] [a] = CListList2\n\ntype instance D [Int] [a] = Int\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-- Tests that we check family instance consistency between\n-- type family instances defined in the currently compiled module\n-- and the direct imports.\nmodule OverDirectThisModC\nwhere\nimport OverDirectThisModB\nimport OverDirectThisModA (C, D)\n\ndata instance C [a] [Int] = C9ListList\n\ntype instance D [a] [Int] = Char\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule OverIndirectThisModA (C, D)\nwhere\n\nimport Data.Kind (Type)\n\ndata family C a b :: Type\n\ntype family D a b :: Type\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule OverIndirectThisModB\nwhere\nimport OverIndirectThisModA (C, D)\n\ndata instance C [Int] [a] = CListList2\n\ntype instance D [Int] [a] = Int\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module OverIndirectThisModC where\nimport OverIndirectThisModB\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-- Tests that we check family instance consistency between\n-- type family instances defined in the currently compiled module\n-- and the transitive imports.\nmodule OverIndirectThisModD\nwhere\nimport OverIndirectThisModC\n  -- imports OverIndirectThisModB with conflicting instances\nimport OverIndirectThisModA (C, D)\n\ndata instance C [a] [Int] = C9ListList\n\ntype instance D [a] [Int] = Char\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap10 where\n\ntype family F a b where\n  F a a = Int\n  F a b = b\n\ng :: a -> F a Bool\ng x = False\n\n\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap11 where\n\ntype family F a b where\n  F a a = Int\n  F a b = b\n\ng :: a -> F a Int\ng x = (5 :: Int)\n\n\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- In an ideal world, this would work. But, GHC doesn't implement\n-- a full infinite-type unifier, so it can't figure out that F b [b] Bool\n-- can safely reduce to Bool.\n\nmodule Overlap15 where\n\nimport Data.Proxy\n\ntype family F a b c where\n  F a a a    = Int\n  F b c Bool = Bool\n\nfoo :: Proxy b -> F b [b] Bool\nfoo _ = False\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap3 where\n\ntype family F a b where\n  F a a = Int\n  F a b = Bool\ntype instance F Char Char = Int\n\ng :: F Char Double\ng = False\n\nh :: F Double Double\nh = -2\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap4 where\n\ntype family F a b where\n  F Int Int = Bool\n  F Bool = Maybe\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap5 where\n\ntype family G a\ntype family F a where\n  F Int = Bool\n  G Int = Char\n  F a = Int", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}\n\nmodule Overlap6 where\n\ntype family And (a :: Bool) (b :: Bool) :: Bool where\n  And False x = False\n  And True x = False -- this is wrong!\n  And x False = False\n  And x True = x\n  And x x = x\n\ndata Proxy p = P\n\ng :: Proxy x -> Proxy (And x True)\ng x = x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap7 where\n\ntype family F a b where\n  F Int a = Int\n  F a b = Bool\ntype instance F a Int = Int\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Overlap9 where\n\ntype family F a where\n  F Int = Bool\n  F a   = Int\n\ng :: Show a => a -> F a\ng x = length (show x)\n\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\nimport Data.Kind (Type)\n\nclass C8 a where\n  data S8 a :: Type -> Type\n\ninstance C8 Int where\n  data S8 Int a = S8Int a\n\n-- Extra argument is not a variable; this is fine\ninstance C8 Bool where\n  data S8 Bool Char = S8Bool\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\ndata family C9 a b :: *\ndata instance C9 Int Int = C9IntInt\n-- must fail: conflicting\ndata instance C9 Int Int = C9IntInt2\n\ntype family D9 a b :: *\ntype instance D9 Int Int = Char\n-- must fail: conflicting\ntype instance D9 Int Int = Int\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\ndata family C9 a b :: *\ndata instance C9 Int Int = C9IntInt\ndata instance C9 [a] Int = C9ListInt\n-- must fail: conflicting\ndata instance C9 [a] Int = C9ListInt2\n\ntype family D9 a b :: *\ntype instance D9 Int Int = Int\ntype instance D9 [a] Int = [a]\n-- must fail: conflicting\ntype instance D9 [a] Int = Maybe a\n\ntype instance D9 Int [a] = [a]\ntype instance D9 Int [b] = [b]  -- must not conflict!\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\ndata family C9 a b :: *\ndata instance C9 Int Int = C9IntInt\ndata instance C9 [a] Int = C9ListInt\n-- must fail: conflicting\ndata instance C9 [Int] Int = C9ListInt2\n\ntype family D9 a b :: *\ntype instance D9 Int Int = Int\ntype instance D9 [a] Int = [a]\n-- must fail: conflicting\ntype instance D9 [Int] Int = [Bool]\n\ntype family E9 a b :: *\ntype instance E9 Int   Int = Int\ntype instance E9 [a]   Int = [a]\ntype instance E9 [Int] Int = [Int]   -- does *not* conflict!\ntype instance E9 b     Int = b\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\ndata family C9 a b :: *\ndata instance C9 Int Int = C9IntInt\ndata instance C9 [a] Int = C9ListInt\ndata instance C9 [Int] [a]   = C9ListList2\n-- must fail: conflicting\ndata instance C9 [a]   [Int] = C9ListList\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes #-}\n\n\nmodule ShouldFail where\n\ntype family C a :: *\n-- must fail: rhs is not a tau type\ntype instance C Int = forall a. [a]\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\ntype family C a :: *\n\ndata family D a :: *\n-- must fail: lhs contains a type family application\ndata instance D [C a] = DC\n\ntype family E a :: *\n-- must fail: lhs contains a type family application\ntype instance E [C a] = Int\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple14 where\n\ndata T a = T (a~a)\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\nfoo :: (a,b) -> (a~b => t) -> (a,b)\nfoo p x = p \n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\ntype family F a\n\nfoo :: p a -> p a\nfoo x = x\n\nbar = foo (undefined :: F ())\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\ndata family T1 a :: * -> *\ndata instance T1 Int           = T1_1   -- must fail: too few args\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\ndata family T1 a :: * -> *\ndata instance T1 Int Bool Char = T1_3   -- must fail: too many args\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Simple2a where\n\nclass C a where\n  data Sd a :: *\n  data Sn a :: *\n  type St a :: *\n\ninstance C Int where\n  data    Sd a = MkSd -- :: *   -- Looks like a nullary data instance decl\n  data    Sd Int = SdC Char\n  newtype Sn Int = SnC Char\n  type    St Int = Char\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nclass C a where\n  data Sd a :: *\n  data Sn a :: *\n  type St a :: *\n\ninstance C Int where\n  data    Sd Int = SdC1 Char    -- must fail: conflicting\n  data    Sd Int = SdC2 Char    --            declarations\n  newtype Sn Int = SnC Char\n  type    St Int = Char\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\nclass C1 a where\n  data S1 a :: *\n\n-- must fail: wrong category of type instance\ninstance C1 Int where\n  type S1 Int = Bool\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}\n\nmodule ShouldFail where\n\nimport Data.Kind (Type)\n\n-- must fail: defaults have no patterns\nclass C2 a b where\n  type S2 a :: Type\n  type S2 Int = Char\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\nclass C3 a where\n  data    S3  a :: *\n  data    S3n a :: *\n  foo3  :: a -> S3 a\n  foo3n :: a -> S3n a\n  bar3  :: S3 a -> a\n  bar3n :: S3n a -> a\n\ninstance C3 Int where\n  data    S3  Int  = D3Int\n  newtype S3n Int  = D3Intn ()\n  foo3  _          = D3Int\n  foo3n _          = D3Intn ()\n  bar3  D3Int      = 1\n  bar3n (D3Intn _) = 1\n\ninstance C3 Char where\n  data S3 Char = D3Char\n  foo3 _       = D3Char\n  bar3 D3Char  = 'c'\n\nbar3' :: S3 Char -> Char\nbar3' D3Char = 'a'\n\n-- must fail: signature too general\nbar3wrong :: S3 a -> a\nbar3wrong D3Int  = 1\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\nclass C3 a where\n  data    S3  a :: *\n  data    S3n a :: *\n  foo3  :: a -> S3 a\n  foo3n :: a -> S3n a\n  bar3  :: S3 a -> a\n  bar3n :: S3n a -> a\n\ninstance C3 Int where\n  data    S3  Int  = D3Int\n  newtype S3n Int  = D3Intn ()\n  foo3  _          = D3Int\n  foo3n _          = D3Intn ()\n  bar3  D3Int      = 1\n  bar3n (D3Intn _) = 1\n\ninstance C3 Char where\n  data S3 Char = D3Char\n  foo3 _       = D3Char\n  bar3 D3Char  = 'c'\n\nbar3' :: S3 Char -> Char\nbar3' D3Char = 'a'\n\n-- must fail: Can't match Int against Char\nbar3wrong' D3Int  = 1\nbar3wrong' D3Char = 'a'\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\n-- must fail: Repeated type variable\nclass C4 a where\n  data S4 a a :: *\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\n-- must fail: AT must be in class instance\nclass C5 a where\n  data S5 a :: *\ndata instance S5 Int = S5\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\n-- must fail: C6 has no ATs S3 and Map\nclass C6 a\n\ninstance C6 Integer where\n  data Map Integer v = MapInteger\n  data S3 Integer = S3Integer\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule ShouldFail where\n\nimport Data.Kind\n\nclass C7 a b where\n  data S7 b :: Type\n\ninstance C7 Char (a, Bool) where\n  data S7 (a, Bool) = S7_1\n\n-- Fails because the arg to S7 should be the\n-- same as that to C7\ninstance C7 Char (a, Int) where\n  data S7 (b, Int) = S7_2\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -ftype-function-depth=3 #-}\n{-# LANGUAGE TypeFamilies, FlexibleContexts, EmptyDataDecls #-}\n\nmodule SkolemOccursLoop where\n\n-- SkelemOccurs tests by Tom and Martin\n\ndata T x\ntype family F x\ntype instance F [x] = [T (F x)]\n\nt :: a -> a -> Bool\nt _ _ = True\n\nf :: a -> F [a]\nf = undefined\n\ntest1 :: (F [a] ~ a) => a -> Bool\ntest1 x = t x (f x)\n\n--\n\ndata S a\ntype family G x\ntype instance G (S x, y) = S (G (x,y))\n\ng :: a -> G [a]\ng = undefined\n\ntest2 :: (G (S a,a) ~ a) => a -> Bool\n-- inferred: G [a] ~ a => a -> Bool\ntest2 x = t x (g x)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\n\nmodule T10141 where\n\ntype family G (a :: k) where\n   G Int  = Bool\n   G Bool = Int\n   G a    = a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T10817 where\n\nimport Data.Proxy\n\nclass C a where\n  type F a\n  type F a = F a\n\ninstance C Bool\n\nx :: Proxy (F Bool)\nx = Proxy\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes #-}\n\nmodule T10899 where\n\nclass C a where\n  type F a\n  type F a = forall m. m a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T11136 where\n\nclass C a where\n  type D a\n  type instance D a x = x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T11450 where\n\nclass C x where\n  type T x\n\ninstance C (Either a b) where\n  type T (Either b a) = b -> a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds, TypeFamilies #-}\n\nmodule T12041 where\n\nimport Data.Kind\n\nclass Category (p :: i -> i -> Type) where\n  type Ob p :: i -> Constraint\n\ndata I a b\ninstance Category I where\n  type Ob I = (~) Int\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T12386 where\n\nclass C a where\n   type family F a t :: *\n\n   type family T a :: *\n   type T a = F a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T12522a where\n\nimport Data.Kind (Type)\n\nnewtype I a = I a\n\ntype family Curry (as :: [Type]) b = f | f -> as b where\n    Curry '[] b = I b\n    Curry (a:as) b = a -> Curry as b\n\ndata Uncurried (as :: [Type]) b\n\ndef :: Curry as b -> Uncurried as b\ndef = undefined\n\n-- test :: Uncurried [Int, String] String\ntest = def $ \\n s -> I $ show n ++ s\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule T12866 where\n\ntype Test2 a = (Eq (TestM a))\n\nclass Test a where\n    type TestM :: *\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n\nmodule T13271 where\n\nimport GHC.TypeLits\n\ndata T1 = T1\ntype T2 = TypeError (Text \"You can't do that!\")\n\ntype family X i = r | r -> i where\n  X 1 = T1\n  X 2 = T2\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T13674 where\n\nimport Data.Proxy\nimport Data.Kind (Constraint, Type)\nimport GHC.TypeLits\nimport Unsafe.Coerce (unsafeCoerce)\n\ndata Dict :: Constraint -> Type where\n  Dict :: a => Dict a\n\ninfixr 9 :-\nnewtype a :- b = Sub (a => Dict b)\n\n-- | Given that @a :- b@, derive something that needs a context @b@, using the context @a@\n(\\\\) :: a => (b => r) -> (a :- b) -> r\nr \\\\ Sub Dict = r\n\nnewtype Magic n = Magic (KnownNat n => Dict (KnownNat n))\n\nmagic :: forall n m o. (Integer -> Integer -> Integer) -> (KnownNat n, KnownNat m) :- KnownNat o\nmagic f = Sub $ unsafeCoerce (Magic Dict) (natVal (Proxy :: Proxy n) `f` natVal (Proxy :: Proxy m))\n\ntype family Lcm :: Nat -> Nat -> Nat where\n\naxiom :: forall a b. Dict (a ~ b)\naxiom = unsafeCoerce (Dict :: Dict (a ~ a))\n\nlcmNat :: forall n m. (KnownNat n, KnownNat m) :- KnownNat (Lcm n m)\nlcmNat = magic lcm\n\nlcmIsIdempotent :: forall n. Dict (n ~ Lcm n n)\nlcmIsIdempotent = axiom\n\nnewtype GF (n :: Nat) = GF Integer\n\nx :: GF 5\nx = GF 3\n\ny :: GF 5\ny = GF 4\n\nfoo :: (KnownNat m, KnownNat n) => GF m -> GF n -> GF (Lcm m n)\nfoo m@(GF x) n@(GF y) = GF $ (x*y) `mod` (lcm (natVal m) (natVal n))\n\nbar :: (KnownNat m)  => GF m -> GF m -> GF m\nbar (x :: GF m) y = foo x y - foo y x \\\\ lcmNat @m @m \\\\ Sub @() (lcmIsIdempotent @m)\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs #-}\n{-# LANGUAGE KindSignatures, MultiParamTypeClasses, TypeFamilies,\n             TypeOperators #-}\n\nmodule T13784 where\n\nimport Data.Kind (Type)\nimport Data.Monoid ((<>))\n\ndata Product :: [Type] -> Type where\n    (:*) :: a -> Product as -> Product (a : as)\n    Unit :: Product '[]\ninfixr 5 :*\n\ninstance Show (Product '[]) where\n    show Unit = \"Unit\"\n\ninstance (Show a, Show (Product as)) => Show (Product (a : as)) where\n    show (a :* as) = show a <> \" :* \" <> show as\n\nclass Divideable a as where\n    type Divide a as :: [Type]\n    divide :: Product as -> (a, Product (Divide a as))\n\ninstance Divideable a (a : as) where\n    -- type Divide a (a : as) = as\n    -- Conflicting type family instances, seems like OVERLAPS isn't a thing for\n    -- type families.\n    divide (a :* as) = (a, as)\n\ninstance Divideable b as => Divideable b (a : as) where\n    type Divide b (a : as) = a : Divide b as\n    divide (a :* as) = a :* divide as\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T13877 where\n\nimport Data.Kind\n\ndata family Sing (a :: k)\ndata instance Sing (z :: [a]) where\n  SNil  :: Sing '[]\n  SCons :: Sing x -> Sing xs -> Sing (x:xs)\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\ntype a @@ b = Apply a b\ninfixl 9 @@\n\ndata FunArrow = (:->) | (:~>)\n\nclass FunType (arr :: FunArrow) where\n  type Fun (k1 :: Type) arr (k2 :: Type) :: Type\n\nclass FunType arr => AppType (arr :: FunArrow) where\n  type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2\n\ntype FunApp arr = (FunType arr, AppType arr)\n\ninstance FunType (:->) where\n  type Fun k1 (:->) k2 = k1 -> k2\n\ninstance AppType (:->) where\n  type App k1 (:->) k2 (f :: k1 -> k2) x = f x\n\ninstance FunType (:~>) where\n  type Fun k1 (:~>) k2 = k1 ~> k2\n\ninstance AppType (:~>) where\n  type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x\n\ninfixr 0 -?>\ntype (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2\n\nlistElim :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]).\n            Sing l\n         -> p '[]\n         -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs))\n         -> p l\nlistElim = listElimPoly @(:->) @a @p @l\n\nlistElimTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]).\n                 Sing l\n              -> p @@ '[]\n              -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs))\n              -> p @@ l\nlistElimTyFun = listElimPoly @(:->) @a @p @l\n\nlistElimPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]).\n                FunApp arr\n             => Sing l\n             -> App [a] arr Type p '[]\n             -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs))\n             -> App [a] arr Type p l\nlistElimPoly SNil                      pNil _     = pNil\nlistElimPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (listElimPoly @arr @a @p @xs xs pNil pCons)\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Bug where\n\nimport Data.Kind\n\nclass C (a :: k) where\n  type T k :: Type\n\n-- This used to fail, with a mysterious error messate\n--    Type indexes must match class instance head\n--      Expected: T (a1 -> Either a1 b1)\n--      Actual: T (a -> Either a b)\n-- but now it succeeds fine\n\ninstance C Left where\n  type T (a -> Either a b) = Int\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T14033 where\n\nnewtype Zero = Zero\nnewtype Succ a = Succ a\n\ntype family Add n m :: * where\n     Add Zero m = m\n     Add (Succ n) m = Succ (Add n m)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs, FlexibleInstances #-}\n\nmodule T14045a where\n\nimport Data.Kind\n\nclass C (a :: k) where\n  data S (a :: k)\n\n-- This used to fail with the mysterious error\n--   Type indexes must match class instance head\n--     Expected: S z\n--     Actual: S a\n-- But now it is fine\ninstance C (z :: Bool) where\n  data S :: Bool -> Type where\n    SF :: S False\n    ST :: S True\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}\n\nmodule T14175 where\n\nimport Data.Kind\n\ntype family PComp (k :: j -> Type) (x :: k) :: ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14179 where\n\ndata family   Foo1 a\ndata instance Foo1 a\ndata instance Foo1 a\n\ndata family   Foo2 :: k -> *\ndata instance Foo2 :: * -> *\ndata instance Foo2 :: * -> *\n\ndata family Foo3 a\ndata instance Foo3 [a] where\n  Foo3a :: Foo3 [Int]\n  Foo3b :: Foo3 [Bool]\ndata instance Foo3 [a] where\n  Foo3c :: Foo3 [a]\n  Foo3d :: Foo3 [Char]\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14230 where\n\nclass C k where\n  data CD :: k -> k -> *\n\ninstance C (Maybe a) where\n  data CD :: (k -> *) -> (k -> *) -> *\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\nmodule T14230a where\n\nimport Data.Kind\n\nclass C a where\n  data CD k (a :: k) :: k -> *\n\ninstance C (Maybe a) where\n  data CD k (a :: k -> *) :: (k -> *) -> *\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, GADTs, TypeOperators, PolyKinds, DataKinds, TypeFamilies, AllowAmbiguousTypes, UndecidableInstances, TypeInType #-}\n\nmodule T14246 where\n\nimport Data.Kind\n\ndata Nat = Z | S Nat\n\ndata Vect :: Nat -> Type -> Type where\n  Nil  :: Vect Z a\n  Cons :: a -> Vect n a -> Vect (S n) a\n\ndata Label a = Label a\n\ndata L\n\ntype family KLN (n :: k) :: Nat where\n    KLN (f :: v -> k) = S (KLN (forall t. f t))\n    KLN (f :: Type) = Z\n\ntype family Reveal (n :: k) (l :: Vect (KLN n) L) :: Type where\n    Reveal (f :: v -> k) (Cons (Label (t :: v)) l) = Reveal (f t) l\n    Reveal (a :: Type) Nil = a\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14369 where\n\ndata family Sing (a :: k)\n\ndata instance Sing (z :: Maybe a) where\n  SNothing :: Sing Nothing\n  SJust :: Sing x -> Sing (Just x)\n\nclass SingKind k where\n  type Demote k = r | r -> k\n  fromSing :: Sing (a :: k) -> Demote k\n\ninstance SingKind a => SingKind (Maybe a) where\n  type Demote (Maybe a) = Maybe (Demote a)\n  fromSing SNothing = Nothing\n  fromSing (SJust x) = Just (fromSing x)\n\nf :: forall (x :: forall a. Maybe a) a. SingKind a => Sing x -> Maybe (Demote a)\nf = fromSing\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -fprint-explicit-kinds #-}\nmodule T14887 where\n\nimport Data.Kind\nimport Data.Type.Equality\n\ntype family Foo1 (e :: (a :: k) :~: (a :: k)) :: Type where\n  Foo1 (e :: a :~: a) = a :~: a\n\ntype family Foo2 (k :: Type) (e :: (a :: k) :~: (a :: k)) :: Type where\n  Foo2 k (e :: a :~: a) = a :~: a\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeInType, TypeFamilies, RankNTypes #-}\n\nmodule T14904 where\n\nimport Data.Kind\n\ntype family F f :: Type where\n   F ((f :: forall a. g a) :: forall a. g a) = Int\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds, FlexibleInstances #-}\nmodule ShouldFail where\n\nimport GHC.Exts( Constraint )\n\ntype family F a :: Constraint\n\nclass C a where\n\n-- Should be rejected because of the type family\ninstance (F a) => C [[a]] where\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeInType, TypeFamilies, KindSignatures, RankNTypes #-}\n\nmodule T15740 where\n\nimport Data.Kind\n\ntype family F2 :: forall k. k -> Type\ndata SBool :: Bool -> Type\ndata Nat\ndata SNat :: Nat -> Type\ntype instance F2 = SBool\ntype instance F2 = SNat\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds #-}\n{-# Language TypeFamilies #-}\n{-# Language KindSignatures #-}\n{-# Language DataKinds #-}\n{-# Language MultiParamTypeClasses #-}\n\nmodule T15764 where\n\nimport Data.Kind\nimport Data.Proxy\nimport GHC.TypeLits\n\nclass C6 (k :: Type) (a :: k) (b :: Proxy (a :: k)) where\n type T6 (proxy :: Proxy '(k, b))\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds              #-}\n{-# LANGUAGE FlexibleInstances      #-}\n{-# LANGUAGE GADTs                  #-}\n{-# LANGUAGE MultiParamTypeClasses  #-}\n{-# LANGUAGE PolyKinds              #-}\n{-# LANGUAGE ScopedTypeVariables    #-}\n{-# LANGUAGE TypeFamilies           #-}\n{-# LANGUAGE TypeOperators          #-}\n\nmodule T15870 where\n\ndata Optic a where\n  --Index :: Nat    -> Optic a\n  --Name  :: Symbol -> Optic a\n  (:.:) :: Optic a -> Optic b -> Optic a -- composition\n\nclass Gettable a (optic :: Optic a) where\n  type Get a (optic :: Optic a)\n\n{-\nsome basic instances, e.g.\ninstance Gettable (a,b) (Index 0) where\n  type Get (a,b) (Index 0) = a\n...\n-}\n\ninstance forall a b (g1 :: Optic a) (g2 :: Optic b).\n        ( Gettable a g1\n        , b ~ Get a g1\n        , Gettable b g2\n        ) => Gettable a (g1 :.: g2) where\n  type Get a (g1 :.: g2) = Get a g2\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T1897b where\n\nimport Control.Monad\nimport Data.Maybe\n\nclass Bug s where\n  type Depend s \n \n  next  :: s -> Depend s -> Maybe s\n  start :: s\n  \n-- isValid :: (Bug s) => [Depend s] -> Bool\n-- Inferred type should be rejected as ambiguous\nisValid ds = isJust $ foldM next start ds\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\nmodule Class4 where\n\nclass  (Eq (Depend s)) => Bug s where\n  type Depend s \n  trans :: Depend s -> Depend s\n  \ninstance Bug Int where\n  type Depend Int = ()\n  trans = (+1)\n\ncheck :: (Bug s) => Depend s -> Bool\ncheck d = d == trans d\n\n{-\n Given: (Bug s, Eq (Depend s))\n      = (Bug s, Eq fsk, Depend s ~ fsk)\n\n Wanted: (Eq alpha,                 (invocation of == at alpha)\n          Depend s ~ alpha          (first arg of ==)\n          Depend sigma ~ alpha      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n          Depend sigma ~ Depend s   (first arg of trans)\n\n          {der}Eq (Depend sigma)    (superclass of Bug sigma)\n\n==>\n Wanted: (Eq alpha,                 (invocation of == at alpha)\n          Depend s ~ alpha          (first arg of ==)\n          Depend sigma ~ alpha      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n          {der}Eq (Depend sigma)    (superclass of Bug sigma)\n\n==>\n Wanted: (Eq alpha,                 (invocation of == at alpha)\n          Depend s ~ alpha          (first arg of ==)\n          Depend sigma ~ alpha      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n\n          {der}Eq uf_ahj\n          Depend sigma ~ uf_ahj\n\n==> uf := alpha\n Wanted: (Eq alpha,                 (invocation of == at alpha)\n          Depend s ~ alpha          (first arg of ==)\n          Depend sigma ~ alpha      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n          {der}Eq alpha)\n==> discharge Eq alpha from {der}\n Wanted: (Depend s ~ alpha          (first arg of ==)\n          Depend sigma ~ alpha      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n          {der}Eq alpha)\n\n==> use given Depend s ~ fsk\n Wanted: (alpha ~ fsk\n          Depend sigma ~ alpha      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n          {der}Eq alpha)\n\n==> alpha := fsk\n Wanted: ({given}alpha ~ fsk\n          Depend sigma ~ alpha      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n          {der}Eq fsk)\n\n==> discharge {der} Eq fsk\n Wanted: ({given}uf ~ fsk\n          Depend sigma ~ uf      (second arg of ==)\n          Bug sigma,                (invocation of trans at sigma)\n\n-}\n", "num_lines": 74}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, LiberalTypeSynonyms #-}\n\nmodule T2157 where\n\ntype S a b = a\ntype family F a :: * -> *\ntype instance F a = S a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleInstances #-}\n\nmodule T2203a where\n\nclass Foo a where\n   type TheFoo a\n   foo :: TheFoo a -> a\n   foo' :: a -> Int\n\nclass Bar b where\n   bar :: b -> Int\n\ninstance Foo a => Bar (Either a (TheFoo a)) where\n   bar (Left a) = foo' a\n   bar (Right b) = foo' (foo b :: a)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE NoMonomorphismRestriction, RankNTypes #-}\n{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T2239 where\n\ndata A = A\ndata B = B\n\nclass C a where c :: a -> String\ninstance C Bool where c _ = \"Bool\"\ninstance C Char where c _ = \"Char\"\n\n-- via TFs\ntype family TF a\ntype instance TF A = Char\ntype instance TF B = Bool\n\ntf :: forall a b. (b ~ TF a,C b) => a -> String\ntf a = c (undefined:: b) \n\ntfa = tf A\ntfb = tf B\n\n-- via FDs\nclass FD a b | a -> b\ninstance FD A Char\ninstance FD B Bool\n\nfd :: forall a b. (FD a b,C b) => a -> String\nfd a = c (undefined:: b) \n\nfda = fd A\nfdb = fd B\n\n\nclass MyEq a b | a->b, b->a\ninstance MyEq a a\n\nsimpleFD = id :: (forall b. MyEq b Bool => b->b) \n\nsimpleTF = id :: (forall b. b~Bool => b->b)\n\n-- Actually these two do not involve impredicative instantiation,\n-- so they now succeed\ncomplexFD = id :: (forall b. MyEq b Bool => b->b)\n               -> (forall c. MyEq c Bool => c->c)\n\ncomplexTF = id :: (forall b. b~Bool => b->b)\n               -> (forall c. c~Bool => c->c)\n\n{- For example, here is how the subsumption check works for complexTF\n   when type-checking the expression\n      (id :: (forall b. b~Bool => b->b) -> (forall c. c~Bool => c->c))\n\n   First, deeply skolemise the type sig, (level 3) before calling\n   tcExpr on 'id'.  Then instantiate id's type:\n\n      b~Bool |-3  alpha[3] -> alpha <= (forall c. c~Bool => c->c) -> b -> b\n\n   Now decompose the ->\n\n      b~Bool |-3  alpha[3] ~ b->b,  (forall c. c~Bool => c->c) <= a\n\n   And this is perfectly soluble.  alpha is touchable; and c is instantiated.\n-}", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- Trac #2334\n\nmodule Test where\n\ndata family F r\n\nnewtype instance F ()  = F () () deriving Eq\nnewtype instance F Int  = H deriving Eq\n\ndata instance F Bool = K1\ndata instance F Bool = K2\n\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, TypeFamilies #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n    -- The type of 'empty' is indeed ambiguous\n\nmodule T2544 where\n\nimport Data.Kind\n\ndata (:|:) a b = Inl a | Inr b\n\nclass Ix i where\n   type IxMap i :: Type -> Type\n   empty  :: IxMap i [Int]\n\ndata BiApp a b c = BiApp (a c) (b c)\n\ninstance (Ix l, Ix r) => Ix (l :|: r) where\n   type IxMap (l :|: r) = BiApp (IxMap l) (IxMap r)\n   empty = BiApp empty empty\n\n-- [W] w1: a c ~ IxMap ii1 [Int]                  (from first 'empty')\n-- [W] w2: b c ~ IxMap ii2 [Int]                  (from second 'empty')\n-- [W] w3: BiApp a b c ~ IxMap (l :|: r) [Int]    (from call of BiApp\n--           ~ BiApp (IxMap l) (IxMap r) [Int]\n\n-- If we process w3 first, we'll rewrite it with w1, w2\n-- yielding two constraints (Ix io ~ IxMap l, Ix i1 ~ IxMap r)\n-- both with location of w3.  Then we report just one of them,\n-- because we suppress multiple errors from the same location\n--\n-- But if we process w1,w2 first, we'll get the same constraints\n-- but this time with different locations.\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies, EmptyDataDecls #-}\n\nmodule T2627b where\n\ndata R a b\ndata W a b\ndata Z\n\ntype family Dual a\ntype instance Dual Z = Z\ntype instance Dual (R a b) = W a (Dual b)\ntype instance Dual (W a b) = R a (Dual b)\n\ndata Comm a where\n    Rd :: (c -> Comm d) -> Comm (R c d)\n    Wr :: e  -> Comm f  -> Comm (W e f)\n    Fin :: Int -> Comm Z\n\nconn :: (Dual a ~ b, Dual b ~ a) => Comm a -> Comm b -> (Int, Int)\nconn (Rd k) (Wr a r) = conn undefined undefined\n\n{-\n [G] a ~ R c d\n [G] b ~ W e f\n [W] Dual alpha ~ beta, [W] Dual beta ~ alpha\n-}", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, TypeFamilies, TypeOperators, ScopedTypeVariables #-}\nmodule Overflow where\nimport Control.Concurrent\n\ndata (:*:) a b\ndata (:+:) a b\n\ndata family PChan a\ndata    instance PChan (a :+: b) = E (IO (PChan a)) (IO (PChan b))\nnewtype instance PChan (a :*: b) = O (IO (Either (PChan a) (PChan b)))\n\ntype family Dual a\ntype instance Dual (a :+: b) = Dual a :*: Dual b\ntype instance Dual (a :*: b) = Dual a :+: Dual b\n\nclass Connect s where\n    newPChan :: (s ~ Dual c, c ~ Dual s) => IO (PChan s, PChan c)\n\npchoose :: (t -> a) -> MVar a -> IO (t,b) -> IO b\npchoose = undefined\n\ninstance (Connect a, Connect b) => Connect (a :*: b) where\n    newPChan = do\n        v <- newEmptyMVar\n\n        -- This version is in T2664a\n        -- correct implementation:\n        -- return (O $ takeMVar v, E (pchoose Left v newPChan) (pchoose Right v newPChan))\n\n        -- type error leads to stack overflow (even without UndecidableInstances!)\n        return (O $ takeMVar v, E (pchoose Right v newPChan) (pchoose Left v newPChan))\n\n{- The last line gives rise to:\n\n  [G] (a :*: b) ~ Dual c\n  [G] c ~ Dual (a :*: b)\n-->\n  [G] c ~ Dual a :+: Dual b\n\n  [W] PChan c ~ PChan (Dual b :+: Dual a)\n--> decompose\n  [W] c ~ Dual b :+: Dual a\n--> subst\n  [W] Dual a :+: Dual b ~ Dual b :+: Dual a\n--> decompose\n  [W] Dual a ~ Dual b\n  [W] Dual b ~ Dual a\n-}", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, TypeFamilies, TypeOperators, ScopedTypeVariables #-}\nmodule Overflow where\nimport Control.Concurrent\n\ndata (:*:) a b\ndata (:+:) a b\n\ndata family PChan a\ndata    instance PChan (a :+: b) = E (IO (PChan a)) (IO (PChan b))\nnewtype instance PChan (a :*: b) = O (IO (Either (PChan a) (PChan b)))\n\ntype family Dual a\ntype instance Dual (a :+: b) = Dual a :*: Dual b\ntype instance Dual (a :*: b) = Dual a :+: Dual b\n\nclass Connect s where\n    newPChan :: (s ~ Dual c, c ~ Dual s) => IO (PChan s, PChan c)\n\npchoose :: (t -> a) -> MVar a -> IO (t,b) -> IO b\npchoose = undefined\n\ninstance (Connect a, Connect b) => Connect (a :*: b) where\n    newPChan = do\n        v <- newEmptyMVar\n        -- correct implementation:\n        return (O $ takeMVar v, E (pchoose Left v newPChan) (pchoose Right v newPChan))\n       \n        -- This version is in T2664\n        -- type error leads to stack overflow (even without UndecidableInstances!)\n        --return (O $ takeMVar v, E (pchoose Right v newPChan) (pchoose Left v newPChan))\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T2677 where\n\ntype family A x\ntype instance A a = Bool\ntype instance A Int = Char\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes, TypeFamilies #-}\n-- Type of x is ambiguous\n\nmodule T2693 where\n\ntype family TFn a :: *\n\n-- Boiled down version\nf :: Maybe ()\nf = do\n  let Just x = undefined :: Maybe (TFn a)\n  let n = fst x + fst x\n  return ()\n\nf2 :: Maybe ()\nf2 = do\n  let x :: TFn a\n      x = undefined \n  let n = fst x + snd x\n  return ()\n\n-- Close to the original report\ndata PVR a = PVR {pvrX :: Int} deriving (Eq)\n\ng :: () -> Maybe (TFn a)\ng _ = undefined\n\nh :: Maybe ()\nh = do pvs <- mapM g undefined\n       let n = (map pvrX pvs) `min` (map pvrX pvs)\n       undefined\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-- Test for no type indices\n\nmodule T2888 where\n\nclass C w where \n  data D:: * -> *\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T3092 where\n\ndata T a = T1 a\ndata instance T Int = T2 Char\n\ntype S b = b\ntype instance S Int = Char\n \n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- A very bogus program (multiple errors) but\n-- sent GHC 6.12 into a loop\n\nmodule T3330a where\n\nnewtype Writer w a = Writer { runWriter :: (a, w) }\nexecWriter :: Writer w a -> w\nexecWriter m = snd (runWriter m)\n\ndata AnyF (s :: * -> *) = AnyF\nclass HFunctor (f :: (* -> *) -> * -> *)\ntype family PF (phi :: * -> *) :: (* -> *) -> * -> *\n\nchildren :: s ix -> (PF s) r ix -> [AnyF s]\nchildren p x = execWriter (hmapM p collect x)\n\n{-\n0 from instantiating hmap\n2 from instantiating collect\n\n  (forall ixx. (phi0 ixx -> r0 ixx -> m0 (r'0 ixx) ~ s ix))\n  phi0 ix0 ~ s2 ix2 -> r2 ix2 -> Writer [AnyF s2] (r2 ix2)\n  f0 r0 ix0 ~ PF s r ix\n  m0 (f0 r'0 ix0) ~ Writer [AnyF s] a0\n\nHence ix0 := ix\n      r0  := r\n      f0  := PF s\n      phi0 := (->) s2 ix2\n      m0 := Writer [AnyF s]\n      a0 : = f0 r'0 ix0\n\n  (forall ixx. ((->) (s2 ix2 -> ixx) (r ixx -> Writer [AnyF s] (r'0 ixx)) ~ s ix))\n\n  s2 ix2 ix0 ~ (->) (s2 ix2) (r2 ix2 -> Writer [AnyF s2] (r2 ix2))\n\n-}\n\ncollect :: HFunctor (PF s) => s ix -> r ix -> Writer [AnyF s] (r ix)\ncollect = error \"collect\"\n\nhmapM :: (forall ix. phi ix -> r ix -> m (r' ix))\n      -> phi ix -> f r ix -> m (f r' ix)\nhmapM _ = error \"hmapM\"\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- Bizarrely this made 6.10 loop\n\nmodule T3330b where\n\nclass RFunctor c a b where\n    type Res c a b :: *\n    rmap :: (a -> b) -> c -> Res c a b\n\ninstance (a ~ c) => RFunctor c a b where\n    type Res c a b = b\n    rmap f = f\n\ninstance (RFunctor c a b, a ~ c) => RFunctor [c] a b where\n    type Res [c] a b = [b]\n    rmap f = map (map f)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, TypeFamilies, TypeOperators, GADTs, KindSignatures #-}\n\nmodule T3330c where\n\nimport Data.Kind\n\ndata (f :+: g) x = Inl (f x) | Inr (g x)\n\ndata R :: (Type -> Type) -> Type where\n  RSum  :: R f -> R g -> R (f :+: g)\n\nclass Rep f where\n  rep :: R f\n\ninstance (Rep f, Rep g) => Rep (f :+: g) where\n  rep = RSum rep rep\n\ntype family Der (f :: Type -> Type) :: Type -> Type\ntype instance Der (f :+: g) = Der f :+: Der g\n\nplug :: Rep f => Der f x -> x -> f x\nplug = plug' rep where\n\nplug' :: R f -> Der f x -> x -> f x\nplug' (RSum rf rg) (Inl df) x = Inl (plug rf df x)\n\n{-\nrf :: R f1, rg :: R g1\nGiven by GADT match: f ~ f1 :+: g1\n\nSecond arg has type (Der f x)\n    = (Der (f1:+:g1) x)\n    = (:+:) (Der f1) (Der g1) x\nHence df :: Der f1 x\n\nInl {f3,g3,x} (plug {f2,x1} rf df x)  gives rise to\n  result of Inl:   ((:+:) f3 g3 x ~ f x)\n  first arg (rf):  (R f1 ~ Der f2 x1)\n  second arg (df): (Der f1 x ~ x1)\n  result of plug:  (f2 x1 ~ x -> f3 x)\n\n  result of Inl: ((:+:) f3 g3 x ~ f x)\n       by given  ((:+:) f3 g3 x ~ (:+:) f1 g1 x)\n  hence need f3~f1, g3~g1\n\nSo we are left with\n   first arg:      (R f1 ~ Der f2 x1)\n   second arg:     (Der f1 x ~ x1)\n   result:         (f2 x1  ~  (->) x (f3 x))\n\nDecompose result:\n          f2 ~ (->) x\n          x1 ~ f1 x\nHence\n        first:  R f1 ~ Der ((->) x) (f1 x)\n  decompose  : R ~ Der ((->) x)\n               f1 ~ f1 x\n\n\n-}\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule T3440 where\n\ntype family Fam a :: *\n\ndata GADT :: * -> * where\n   GADT :: a -> Fam a -> GADT (Fam a)\n\nunwrap :: GADT (Fam a) -> (a, Fam a)\nunwrap (GADT x y) = (x, y)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T4093a where\n\ntype family Foo x\ntype instance Foo () = Maybe ()\n\nhang :: (Foo e ~ Maybe e) => Foo e\nhang = Just ()\n\n-- Type is not ambiguous; should get a complaint\n-- for (e ~ ()) arising from the Just ()\n\n{- Ambiguity check\n\n [G] Foo e ~ Maybe e\n [W] Foo e ~ Foo e0\n [W] Foo e0 ~ Maybe e0\n---\n [G] Foo e ~ fsk\n [G] fsk ~ Maybe e\n\n [W] Foo e ~ fmv1\n [W] Foo e0 ~ fmv2\n [W] fmv1 ~ fmv2\n [W] fmv2 ~ Maybe e0\n\n--->   fmv1 := fsk\n [G] Foo e ~ fsk\n [G] fsk ~ Maybe e\n\n [W] Foo e0 ~ fmv2\n [W] fsk ~ fmv2\n [W] fmv2 ~ Maybe e0\n\n--->\n [G] Foo e ~ fsk\n [G] fsk ~ Maybe e\n\n [W] Foo e0 ~ fmv2\n [W] fmv2 ~ Maybe e\n [W] fmv2 ~ Maybe e0\n\nNow the question is whether we get a derived equality e ~ e0.  Currently\nwe don't, but we easily could.  But then we'd need to be careful not to\nreport insoluble Int ~ Bool if we had\n   F a ~ Int, F a ~ Bool\n-}\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, EmptyDataDecls, ScopedTypeVariables, TypeFamilies #-}\n\nmodule T4093b where\n\ndata C\ndata O\n\ntype family   EitherCO e a b :: *\ntype instance EitherCO C a b = a\ntype instance EitherCO O a b = b\n\ndata MaybeC ex t where\n  JustC    :: t -> MaybeC C t\n  NothingC ::      MaybeC O t\n\ndata Block (n :: * -> * -> *) e x\n\n\nblockToNodeList ::\n  forall n e x. (EitherCO e (A C O n) (A O O n) ~ A e O n,\n                 EitherCO x (A C C n) (A C O n) ~ A C x n) =>\n    Block n e x -> A e x n\n\ntype A e x n = (MaybeC e (n C O), MaybeC x (n O C))\nblockToNodeList b = foldBlockNodesF (f, l) b z\n  where\n    z :: EitherCO e (EitherCO e (A C O n) (A O O n)) (EitherCO e (A C O n) (A O O n))\n    z = undefined\n\n    f :: n C O -> EitherCO e (A C O n) (A O O n) -> EitherCO e (A C O n) (A O O n)\n    f n _ = (JustC n, NothingC)\n\n    l :: n O C -> EitherCO e (A C O n) (A O O n) -> EitherCO e (A C C n) (A O C n)\n    l _ = undefined\n\nfoldBlockNodesF  :: forall n a b c e x .\n                   ( n C O       -> a -> b\n                   , n O C       -> b -> c)\n                 -> (Block n e x -> EitherCO e a b -> EitherCO x c b)\nfoldBlockNodesF _ = undefined\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T4099 where\n\ntype family T a\n\nfoo :: a -> T a -> Int\nfoo x = error \"urk\"\n\nbar1 :: b -> T b -> Int\nbar1 a x = foo (error \"urk\") x\n\nbar2 :: b -> Maybe b -> Int\nbar2 a x = foo (error \"urk\") x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeOperators, EmptyDataDecls #-}\n\nmodule T4174 where\n\nimport Data.Kind (Type)\n\ndata True\ndata False\n\ndata Minor1\n\ndata GHC6'8 m\ndata GHC6'10 m\n\ntype family a :<=: b :: {-Bool-} Type\ntype instance GHC6'10 m1 :<=: GHC6'8 m2 = False\n\ntype a :>=: b = b :<=: a\n\ndata Way ghcVersion tablesNextToCode profiling threaded\n\ntype family GHCVersion way :: {-GHCVersion-} Type\ntype instance GHCVersion (Way v n p t) = v\n\ntype family Threaded way :: {-Bool-} Type\ntype instance Threaded (Way v n p t) = t\n\ndata Field w s t\ndata SmStep\ndata RtsSpinLock\n\nfield :: String -> m (Field w a b)\nfield = undefined\n\ntype family WayOf (m :: Type -> Type) :: Type\n\nsync_large_objects :: (Monad m, \n                       (GHCVersion (WayOf m) :>=: GHC6'10 Minor1) ~ True, \n                       Threaded (WayOf m) ~ True) \n                   => m (Field (WayOf m) SmStep RtsSpinLock)\nsync_large_objects = field \"sync_large_objects\"\n\ntestcase :: Monad m => m (Field (Way (GHC6'8 minor) n t p) a b)\ntestcase = sync_large_objects\n\n{- Wanted constraints from the occurrence of sync_large_objects\n\n   (WayOf m) ~ (Way (GHC6'8 minor) n t p)\n   a ~ SmStep\n   b ~ RtsSpinLock\n\n   Threaded (WayOf m) ~ True \n     == Threaded (Way (GHC6'8 minor) n t p) ~ True \n     == p ~ True   \n\n   (GHCVersion (WayOf m) :>=: GHC6'10 Minor1) ~ True, \n     == (GHC6'10 Minor1 :<=: GHCVersion (WayOf m)) ~ True, \n     == (GHC6'10 Minor1 :<=: GHCVersion (Way (GHC6'8 minor) n t p))) ~ True, \n     == (GHC6'10 Minor1 :<=: GHC6'8 minor) ~ True\n     == False ~ True\n\n-}\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies  #-}\n\nmodule T4179 where\n\nclass DoC a where\n     type A2 a\n     type A3 a\n     op :: a -> A2 a -> A3 a\n\ndata Con x = InCon (x (Con x))\ntype FCon x = x (Con x)\n\n-- should have been changed to this, which works\n-- foldDoC :: Functor f => (f a -> a) -> A2 (FCon f) -> Con f -> a\n-- foldDoC f i (InCon t) = f (fmap (foldDoC f i) t)\n-- this original version causes GHC to hang \nfoldDoC :: Functor f => (f a -> a) -> Con f -> a \nfoldDoC f (InCon t) = f (fmap (foldDoC f) t)\n\ndoCon :: (DoC (FCon x)) => Con x -> A2 (FCon x) -> A3 (FCon x) \ndoCon (InCon x) = op x\n\n-- Note that if this is commented out then there's no hang: \n-- presumably because GHC doesn't have to perform type deduction for foldDoC.\nfCon :: (Functor x, DoC (FCon x)) => Con x -> A2 (FCon x) -> A3 (FCon x) \nfCon = foldDoC op\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleInstances #-}\nmodule T4246 where\n\nclass Stupid a where\n   type F a\n\ninstance {-# OVERLAPPABLE #-} Stupid a where\n   type F a = a\n\ninstance {-# OVERLAPPING #-} Stupid Int where\n   type F Int = Bool\n\ntype family G a :: *\ntype instance G Int = Int\ntype instance G Int = Bool\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FunctionalDependencies, RankNTypes, MultiParamTypeClasses #-}\nmodule T4254 where\n\nclass FD a b | a -> b where \n  op :: a -> b; \n  op = undefined \n\ninstance FD Int Bool\n\nok1   :: forall a b. (a~Int,FD a b) => a -> b\nok1    = op\n-- Should be OK: op has the right type\n\nok2   :: forall a b. (a~Int,FD a b,b~Bool) => a -> Bool\nok2    = op\n-- Should be OK: needs the b~Bool\n\nfails :: forall a b. (a~Int,FD a b) => a -> Bool \nfails  = op\n-- Could fail: no proof that b~Bool\n-- But can also succeed; it's not a *wanted* constraint\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE TypeFamilies, ScopedTypeVariables, FlexibleContexts #-}  \n\n-- See also Trac #5763 for why we don't really want to see\n-- an occurs-check error from this program\n\nmodule T4272 where\n\nclass Family f where\n   terms :: f a -> a\n\nclass Family (TermFamily a) => TermLike a where\n   type TermFamily a :: * -> *\n\nlaws :: forall a b. TermLike a => TermFamily a a -> b  \nlaws t = prune t (terms (undefined :: TermFamily a a))\n\nprune :: TermLike x => TermFamily x x -> TermFamily x x -> b\nprune = undefined  \n\n-- terms :: Family f => f a -> a\n--    Instantiate with f = TermFamily a\n-- terms :: Family (TermFamily a) => TermFamily a a -> a\n-- (terms (undefined::TermFamily a a) :: Family (TermFamily a) => a\n-- So the call to prune forces the equality\n--    TermFamily a a ~ a\n-- which triggers an occurs check", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The behavior of type-inference and OverlappingInstances has changed\n-- between GHC 6.12 and GHC 7.0 such that the following code\n-- type-checks under 6.12, but not 7.0rc2. I assume this change has\n-- something to do with the new type checker in GHC 7, but it is not\n-- clear to me if this change in behavior is intended. Nor am I clear\n-- how to achieve something similar to the old behavior. This is\n-- preventing HSP (and by extension, happstack) from migrating to GHC\n-- 7. I reported this earlier on the mailing lists, but I have further\n-- simplified the test case here.\n\n{-# LANGUAGE TypeFamilies, MultiParamTypeClasses\n  , FlexibleContexts, FlexibleInstances, UndecidableInstances\n  , TypeSynonymInstances, GeneralizedNewtypeDeriving\n  #-}\nmodule XMLGenerator where\n\nnewtype XMLGenT m a = XMLGenT (m a)\n   deriving (Functor, Applicative, Monad)\n\nclass Monad m => XMLGen m where\n type XML m\n data Child m\n genElement :: String -> XMLGenT m (XML m)\n\nclass XMLGen m => EmbedAsChild m c where\n    asChild :: c -> XMLGenT m [Child m]\n\ninstance {-# OVERLAPPING #-} (EmbedAsChild m c, m1 ~ m) => EmbedAsChild m (XMLGenT m1 c)\n\ninstance {-# OVERLAPPABLE #-} (XMLGen m,  XML m ~ x) => EmbedAsChild m x\n\ndata Xml = Xml\ndata IdentityT m a = IdentityT (m a)\ninstance Functor (IdentityT m)\ninstance Applicative (IdentityT m)\ninstance Monad (IdentityT m)\ninstance XMLGen (IdentityT m) where\n    type XML (IdentityT m) = Xml\n\ndata Identity a = Identity a\ninstance Functor Identity\ninstance Applicative Identity\ninstance Monad Identity\n\ninstance {-# OVERLAPPING #-} EmbedAsChild (IdentityT IO) (XMLGenT Identity ())\n\ndata FooBar = FooBar\n\ninstance {-# OVERLAPPING #-} EmbedAsChild (IdentityT IO) FooBar where\n  asChild b = asChild $ (genElement \"foo\")\n  -- asChild :: FooBar -> XMLGenT (XMLGenT (IdentityT IO) [Child (IdentityT IO)])\n\n{-     ---------- Deriving the constraints ----------\n asChild :: EmbedAsChild m c => c -> XMLGenT m [Child m]\n genElement :: XMLGen m => String -> XMLGenT m (XML m)\n\n Wanted: EmbedAsChild m c, with m = IdentityT IO\n                                c = XMLGenT meta (XML meta)\n         XMLGen meta\n\n  ie     EmbedAsChild (IdentityT IO) (XMLGen meta (XML meta)\n         XMLGen meta\n\nWe have instances\n    EmbedAsChild (IdentityT IO) FooBar\n    EmbedAsChild (IdentityT IO) (XMLGenT Identity ())\n    EmbedAsChild m              (XMLGenT m1 c)\n    EmbedAsChild m              x\n-}\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, FlexibleInstances, TypeFamilies,\n     MultiParamTypeClasses, FlexibleContexts, UndecidableInstances, ScopedTypeVariables #-}\nmodule T5515 where\n\n\nclass ctx (Arg ctx) => Bome ctx where \n  type BArg ctx\ninstance ctx a => Bome ctx where \n  type BArg ctx = a\n\nclass C f a\nclass C f (Arg f) => Some f where \n  type Arg f\ninstance C f a => Some f where \n  type Arg f = a\n\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes, RankNTypes, TypeFamilies, KindSignatures #-}\n\n-- The type of 'run' is actually ambiguous\n\nmodule T5934 where\nimport Control.Monad.ST\n\ndata Gen s\ntype GenST s = Gen (PrimState (ST s))\n\nrun :: (forall s. GenST s) -> Int\nrun = 0 \n\ntype family PrimState (m :: * -> *)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T6123 where\n\ntype family Id a\n\ncid :: a ~ Id a => a -> a\ncid x = x\n\ncundefined = cid undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T7010 where\n\ntype Vector = Serial Float\ndata Serial v = Serial\n\nclass MakeValueTuple a where\n   type ValueTuple a :: *\n\ninstance MakeValueTuple Float where\n   type ValueTuple Float = IO Float\n\ninstance (MakeValueTuple v) => MakeValueTuple (Serial v) where\n   type ValueTuple (Serial v) = Serial (ValueTuple v)\n\n\nstereoFromMono :: (v, v)\nstereoFromMono = undefined\n\nprocessIO ::\n   (MakeValueTuple a) =>\n   (ValueTuple a, ValueTuple a) ->\n   (a, a)\nprocessIO = undefined\n\n\nphoneme :: (Vector, Vector)\nphoneme = processIO stereoFromMono\n\n{-\n\n   ( MakeValueTuple Vector  =  MakeValueTuple (Serial Float)\n   , ValueTuple Vector ~ ValueTuple Vector    (agf))\n\n--> MakeValueTuple Float\n--> <solved>\n-}\n\n\nwithArgs ::\n   (MakeValueTuple b) =>\n   (a, ValueTuple b) ->\n   (a, b)\nwithArgs = undefined\n\nplug ::\n   (MakeValueTuple c) =>\n   (c, ValueTuple c)\nplug = undefined\n\nfilterFormants :: (Float, Vector)\nfilterFormants = withArgs plug\n\n{- Call to withArgs generates\n\n    (MakeValueTuple Vector, (c,ValueTuple c)~(Float,ValueTuple Vector), MakeValueTuple c)\n=   (MakeValueTuple (Serial Float), ValueTuple Float ~ ValueTuple (Serial Float), MakeValueTuple Float)\n=   (MakeValueTuple (Serial Float), MakeValueTuple Float,\n     IO Float ~ Serial (ValueTuple Float))\n\n     IO Float ~ Serial f, ValueTuple Float ~ f\n=    IO Float ~ Serial f, IO Float ~ f\n-}\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T7102A where\ntype family T a b\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T7102B where\nimport T7102A\ntype instance T a b = a\nfrom :: a -> T a b\nfrom = id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T7102C where\nimport T7102A\ntype instance T a b = b\nto :: T a b -> b\nto = id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} \n\n-- This one produced a Lint error in GHC 7.4 and 7.6\n\nmodule Foo where\n\ntype family F a\n\nclass C b where {}\n\nfoo :: a -> F a\nfoo x = error \"urk\"\n\nh :: (b -> ()) -> Int\nh = error \"urk\"\n\nf = h (\\x -> let g :: C (F a) => a -> Int\n                 g y = length [x, foo y]\n             in ())\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, TypeFamilies, Rank2Types, FlexibleContexts, FlexibleInstances, GADTs, StandaloneDeriving, UndecidableInstances #-}\n\nmodule T7354 where\n\ntype family Base t :: * -> *\ndata family Prim t :: * -> *\n\nclass Functor (Base t) => Unfoldable t where\n  embed :: Base t t -> t\n  ana\n    :: (a -> Base t a) -- ^ a (Base t)-coalgebra\n    -> a               -- ^ seed\n    -> t               -- ^ resulting fixed point\n  ana g = a where a = embed . fmap a . g\n\n\ndata instance Prim [a] b = Cons a b | Nil deriving (Eq,Ord,Show,Read)\n\ncoalg 0 = Nil\ncoalg n = Cons n (n-1)\nalg Nil = 1\nalg (Cons a b) = a * b\n\ninstance Functor (Prim [a]) where\n  fmap f (Cons a b) = Cons a (f b)\n  fmap _ Nil = Nil\n\nfoo = ana alg\n\nbar = foo  -- With 7.6, the definition of foo is simply discarded by\n           -- by the type checker, which makes Lint complain about bar\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7354a where\n\nimport T7354b\n\nfoo = embed ()\n\nbar = foo\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\nmodule T7354b where\n\nimport Data.Kind (Type)\n\ntype family Base t :: Type -> Type\n\nclass Unfoldable t where\n  embed :: Base t t -> t\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T7536 where\n\ntype T v = Int\n\ntype family TF a :: *\ntype instance TF (T a) = a\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, TypeFamilies #-}\nmodule T7729 where\nimport Control.Monad\n\nclass Monad m => PrimMonad m where\n  type PrimState m\n\nclass MonadTrans t where\n  lift :: Monad m => m a -> t m a\n\nclass (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where\n  type BasePrimMonad m :: * -> *\n  liftPrim :: BasePrimMonad m a -> m a\n\n\nnewtype Rand m a = Rand {\n  runRand :: Maybe (m ()) -> m a\n  }\n\ninstance Monad m => Functor (Rand m) where\n  fmap = liftM\n\ninstance Monad m => Applicative (Rand m) where\n  pure = return\n  (<*>) = ap\n\ninstance (Monad m) => Monad (Rand m) where\n  return           = Rand . const . return\n  (Rand rnd) >>= f = Rand $ \\g -> (\\x -> runRand (f x) g) =<< rnd g\n\ninstance MonadTrans Rand where\n  lift = Rand . const\n\ninstance MonadPrim m => MonadPrim (Rand m) where\n  type BasePrimMonad (Rand m) = BasePrimMonad m\n  liftPrim = liftPrim . lift\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, TypeFamilies #-}\nmodule T7729a where\nimport Control.Monad\n\nclass Monad m => PrimMonad m where\n  type PrimState m\n\nclass MonadTrans t where\n  lift :: Monad m => m a -> t m a\n\nclass (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where\n  type BasePrimMonad m :: * -> *\n  liftPrim :: BasePrimMonad m a -> m a\n\n\nnewtype Rand m a = Rand {\n  runRand :: Maybe (m ()) -> m a\n  }\n\ninstance Monad m => Functor (Rand m) where\n  fmap = liftM\n\ninstance Monad m => Applicative (Rand m) where\n  pure  = return\n  (<*>) = ap\n\ninstance (Monad m) => Monad (Rand m) where\n  return           = Rand . const . return\n  (Rand rnd) >>= f = Rand $ \\g -> (\\x -> runRand (f x) g) =<< rnd g\n\ninstance MonadTrans Rand where\n  lift = Rand . const\n\ninstance MonadPrim m => MonadPrim (Rand m) where\n  type BasePrimMonad (Rand m) = BasePrimMonad m\n  liftPrim x = liftPrim (lift x)   -- This line changed from T7729\n\n{-\n  liftPrim :: (MonadPrim m) => BasePrimMonad m a -> m a\n  lift :: MonadTrans t, Monad m => m a -> t m a\n\n  sig of liftPrim :: BasePrimMonad (Rand m) a -> Rand m a\n                   = BasePrimMonad m a -> Rand m a\n  \n  x :: BasePrimMonad (Rand m) a\n  lift @ t=tt @ m=m1\n  liftPrim @ m=m2 @ a=aa\n\n  forall m. (Monad m) => BasePrimMonad (Rand m) a ~ m1 a   -- x arg of lift\n\n                         tt m1 a    -- Result of lift\n                               ~ \n                            BasePrimMonad m2 a   -- Arg of liftPrim\n\n                         Rand m a      -- expected type of RHS\n                             ~\n                             m2 a  -- Result of liftPrim\n    m = m_and\n    m1 = m_aql\n    m2 = m_aqf\n    tt = t_aqj\n\n---->\n     m2 := Rand m\n\na)     BasePrimMonad (Rand m) ~ m1\nb)     tt m1 ~ BasePrimMonad (Rand m)\n\n--->  process (b) first\n    CFunEqCan   BasePrimMonad (Ramd m) ~ s_atH\n                s_atH ~ tt m1\n\n  \n--->  now process (a)\n    m1 ~ s_atH ~ tt m1    -- An obscure occurs check\n-}\n\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule T7788 where\n\ndata Proxy a = Proxy\n\nfoo :: Proxy (F (Fix Id)) -> ()\nfoo = undefined\n\nnewtype Fix a = Fix (a (Fix a))\nnewtype Id a = Id a\n\ntype family F a\ntype instance F (Fix a) = F (a (Fix a))\ntype instance F (Id a) = F a\n\nmain :: IO ()\nmain = print $ foo Proxy\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\n-- This used to fail because of the silent-superclass\n-- mechanism, but now it succeeds as it should\n\nmodule T7862 where\n\ntype family Scalar t\n\nnewtype Tower s a = Tower [a]\n\ntype instance Scalar (Tower s a) = a\n\nclass (Num (Scalar t), Num t) => Mode t where\n    (<+>) :: t -> t -> t\n\ninstance Num a => Mode (Tower s a) where\n    Tower as <+> _ = undefined\n      where\n        _ = (Tower as) <+> (Tower as)\n\ninstance Num a => Num (Tower s a) where\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, MultiParamTypeClasses,\n             FlexibleInstances, DataKinds #-}\n\nmodule T7938 where\n\ndata KProxy (a :: *) = KP\n\nclass Foo (a :: k1) (b :: k2) where\n  type Bar a\n\ninstance Foo (a :: k1) (b :: k2) where\n  type Bar a = (KP :: KProxy k2)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, GADTs #-}\nmodule T7967 where\n\nimport Data.Kind (Type)\n\ndata Nat = Zero | Succ Nat\n\ndata SNat :: Nat -> Type where\n  SZero :: SNat Zero\n  SSucc :: SNat n -> SNat (Succ n)\n\ndata HList :: [Type] -> Type where\n  HNil :: HList '[]\n  HCons :: h -> HList t -> HList (h ': t)\n\ndata Index :: Nat -> [Type] -> Type where\n  IZero :: Index Zero (h ': t)\n  ISucc :: Index n l -> Index (Succ n) (h ': l)\n\ntype family Lookup (n :: Nat) (l :: [Type]) :: Type\ntype instance Lookup Zero (h ': t) = h\ntype instance Lookup (Succ n) (h ': t) = Lookup n t\n\nhLookup :: Index n l -> HList l -> Lookup n l\nhLookup IZero (HCons h _) = h\nhLookup (ISucc n) (HCons _ t) = hLookup n t\nhLookup _ _ = undefined\n\n-- So far, so good. But, I wanted a way to convert `SNat`s to `Index`es. When\n-- I add the (wrong) code below, and got a bogus error above\n\nsNatToIndex :: SNat n -> HList l -> Index n l\nsNatToIndex SZero HNil = IZero\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}\n\nmodule T8129 where\n\ntype family F (x :: *) :: *\n\nclass (y ~ F x) => C x y\n\nz = () :: C x y => ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule Test where\n\n\ndata Vector a = Vector a\ndata Matrix a = Matrix a\n\nclass Build f where\n    build' :: BoundsOf f -> f -> ContainerOf f\n\n\n\ntype family BoundsOf x where\n    BoundsOf (a->a->a) = (Int,Int)\n    BoundsOf (a->a)    = Int\n\ntype family ContainerOf x where\n    ContainerOf (a->a)    = Vector a\n    ContainerOf (a->a->a) = Matrix a\n\n\n\ninstance (Num a) => Build (a->a) where\n    build' = buildV\n\n\nbuildV :: (Integral a, Num b) => a -> (b -> c) -> Vector c\nbuildV _ _ = undefined\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8227\n  ( \n    absoluteToParam\n  ) where\n\nimport Data.Kind (Type)\nimport T8227a\n\ntype family Scalar a :: Type\ntype instance Scalar (a -> v) = a -> Scalar v\n\narcLengthToParam :: Scalar (V p) -> p -> Scalar (V p) -> Scalar (V p)\narcLengthToParam = undefined\n\nabsoluteToParam :: Scalar (V a) -> a -> Scalar (V a)\nabsoluteToParam eps seg = arcLengthToParam eps eps\n\n{-\n\nScalar (V a) ~ Scalar (V p0)\nScalar (V a) ~ p0\nScalar (V a) ~ Scalar (V p0) -> Scalar (V p0)\n\n--->\nScalar (V a)  ~ fuv0\nScalar (V p0) ~ fuv1\nfuv0 ~ fuv1\nfuv0 ~ p0\nfuv0 ~ fuv1 -> fuv1\n\n---> p0 := fuv0\n\nScalar (V a)    ~ fuv0    (CFunEqCan)\nScalar (V fuv0) ~ fuv1    (CFunEqCan)\nfuv0 ~ fuv1\np0 ~ fuv0\nfuv0 ~ fuv1 -> fuv1\n\n\n-}\n\n\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8227a where\n\nimport Data.Kind (Type)\n\ntype family V a :: Type\n\ntype instance V Double    = Double\ntype instance V (a -> b)   = V b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule T8368 where\n\ndata Foo = Bar\n\ndata family Fam a\ndata instance Fam a where\n  MkFam :: Foo\n  ", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule T8368a where\n\ndata family Fam a b\ndata instance Fam Int b where\n  MkFam :: Fam Bool b\n  ", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8518 where\n\nimport Data.Maybe\nimport Control.Applicative\n\nclass Continuation c where\n    type Z c\n    type B c\n    type F c\n    continue ::  c -> (Z c) -> (B c) -> Maybe ((F c), c)\n\ncallCont :: Continuation c => c -> (Z c) -> (B c) -> Maybe (F c)\ncallCont c z b = rpt (4 :: Int) c z b\n    where\n        rpt 0 c' z' b' = fromJust (fst <$> (continue c' z' b'))\n        rpt i c' z' b' = let c'' = fromJust (snd <$> (continue c' z' b')) in rpt (i-1) c''\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, UndecidableInstances #-}\n\nmodule T8550 where\n\ntype family F a\ntype instance F () = F ()\ndata A where\n  A :: F () ~ () => A\nx :: A\nx = A\n\nmain :: IO ()\nmain = seq A (return ())\n\n-- Note: This worked in GHC 7.8, but I (Richard E) think this regression\n-- is acceptable.\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T9036 where\n\nimport Data.Kind\n\nclass UncurryM t where\n  type GetMonad t :: Type -> Type\n\nclass Curry a b where\n  type Curried a b :: Type\n\ngSimple :: String -> String -> [String]\ngSimple = simpleLogger (return ())\n\nsimpleLogger :: Maybe (GetMonad t after) -> t `Curried` [t]\nsimpleLogger _  _ = undefined\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds #-}\n\nmodule T9097 where\n\nimport GHC.Exts\n\ntype family Foo x where\n  Foo True = False\n  Foo False = False\n  Foo Any = True\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, TemplateHaskell, PolyKinds, TypeFamilies #-}\n\nmodule T9160 where\nimport Language.Haskell.TH\n\n$( do { cls_nm <- newName \"C\"\n      ; a_nm   <- newName \"a\"\n      ; k_nm   <- newName \"k\"\n      ; f_nm   <- newName \"F\"\n      ; return [ClassD [] cls_nm [KindedTV a_nm (VarT k_nm)] []\n                 [OpenTypeFamilyD\n                   (TypeFamilyHead f_nm [] (KindSig (VarT k_nm)) Nothing)]]})\n\n-- Splices in:\n--     class C (a :: k) where\n--       type F :: k\n\ninstance C (a :: *) where\n  type F = Maybe   -- Should be illegal\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE TypeFamilies #-}\n\nmodule T9167 where\n\nclass C a where\n   type F b\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies #-}\n\nmodule T9171 where\ndata Base\n\ntype family GetParam (p::k1) (t::k2) :: k3\n\ntype instance GetParam Base t = t\n\nfoo = undefined :: GetParam Base (GetParam Base Int)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, MagicHash, TypeFamilies, PolyKinds #-}\n\nmodule T9357 where\nimport GHC.Exts\n\ntype family F (a :: k1) :: k2\n\ntype instance F Int# = Int\n -- This one is actually OK (F is poly-kinded;\n -- c.f. Trac #11120 comment:19\n\ntype instance F (forall a. a->a) = Int\n -- But this one is not (impredicative)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule T9371 where\n\nimport Data.Monoid\n\nclass C x where\n    data D x :: *\n    makeD :: D x\n\ninstance {-# OVERLAPPABLE #-} Monoid x => C x where\n    data D x = D1 (Either x ())\n    makeD = D1 (Left mempty)\n\ninstance (Monoid x, Monoid y) => C (x, y) where\n    data D (x,y) = D2 (x,y)\n    makeD = D2 (mempty, mempty)\n\ninstance Show x => Show (D x) where\n    show (D1 x) = show x\n\n\nmain = print (makeD :: D (String, String))\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n     TypeFamilies\n   , KindSignatures\n   #-}\n\nmodule T9433 where\n\ntype family Id x :: *\ntype instance Id a = a\n\ntype family Map (f :: * -> *) x :: *\ntype instance Map f [a] = [f a]\n\nx :: Map Id [Bool]\nx = []\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, UndecidableInstances #-}\n\nmodule T9554 where\n\nimport Data.Proxy\n\ntype family F a where\n  F a = F (F a)\n\nfoo :: Proxy (F Bool) -> Proxy (F Int)\nfoo x = x\n\nmain = case foo Proxy of Proxy -> putStrLn \"Made it!\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9580 where\n\nimport T9580a\nimport Data.Coerce\n\nfoo :: Dimensional Int Double -> Double\nfoo x = coerce x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, TypeFamilies #-}\nmodule T9580a( Dimensional ) where\n\nimport Data.Kind (Type)\n\ndata family Dimensional var :: Type -> Type\nnewtype instance Dimensional Int v = Quantity' v\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule T9662 where\n\nimport Data.Kind (Type)\n\ndata Exp a = Exp\ndata (a:.b) = a:.b\n\ntype family Plain e :: Type\ntype instance Plain (Exp a) = a\ntype instance Plain (a:.b) = Plain a :. Plain b\n\nclass (Plain (Unlifted pattern) ~ Tuple pattern) => Unlift pattern where\n   type Unlifted pattern\n   type Tuple pattern\n\nmodify :: (Unlift pattern) =>\n   pattern ->\n   (Unlifted pattern -> a) ->\n   Exp (Tuple pattern) -> Exp (Plain a)\nmodify p f = undefined\n\n\ndata Atom a = Atom\n\natom :: Atom a\natom = Atom\n\n\ninstance (Unlift pa, int ~ Atom Int) => Unlift (pa :. int) where\n   type Unlifted (pa :. int) = Unlifted pa :. Exp Int\n   type Tuple (pa :. int) = Tuple pa :. Int\n\n\ndata Shape sh = Shape\n\nbackpermute ::\n   (Exp sh -> Exp sh') ->\n   (Exp sh' -> Exp sh) ->\n   Shape sh -> Shape sh'\nbackpermute = undefined\n\ntest :: Shape (sh:.k:.m:.n) -> Shape (sh:.m:.n:.k)\ntest =\n   backpermute\n      (modify (atom:.atom:.atom:.atom)\n         (\\(sh:.k:.m:.n) -> (sh:.m:.n:.k)))\n      id\n\n-- With this arg instead of just 'id', it worked\n--    (modify (atom:.atom:.atom:.atom)\n--       (\\(ix:.m:.n:.k) -> (ix:.k:.m:.n)))\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T9896 where\n\nclass Test a where\n  type TestT a :: *\n\ninstance Test Bool where\n  newtype TestT Bool = Int\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\ntype family T a b :: *\ntype instance T Int = IO   -- must fail: too few args\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\ntype family T a :: * -> *\ntype instance T Int Float = Char   -- must fail: extra arguments\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule ShouldFail where\n\ntype family T a\ntype instance T (a, [b])     = T (b, b)        -- var occurs more often\ntype instance T (a, Maybe b) = T (a, Maybe b)  -- not smaller\ntype instance T (a, IO [b])  = T (a, T b)      -- nested tyfam application\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule A where\ntype family A a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule B (A, X) where\nimport A\ndata X\ntype instance A (X, b) = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule C (x) where\nimport Data.Proxy\nimport B\nx :: Proxy b -> (forall t. Proxy t -> Bool -> A (t, b)) -> (Bool -> ())\nx _ f = f (undefined :: Proxy X)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Main where\n\nimport Data.Proxy\nimport A\nimport C\n\ndata Y\ntype instance A (a, Y) = Bool\n\ny :: Proxy a -> Bool -> A (a, Y)\ny _ = id\n\nz :: Bool -> ()\nz = x (undefined :: Proxy Y) y\n\nmain = print (z True)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T13092c_1 where\n\ntype family F a\ntype instance F Int = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T13092c_2 (F) where\n\nimport T13092c_1\n\ndata X\ntype instance F (X, b) = Bool\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T13092c_3 (F) where\n\nimport T13092c_2\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T13092c_4 where\n\nimport T13092c_3\n\ntype instance F (a, Char) = String\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport O\n\nx _ = 1 -- Generate a silly warning, so we know A was really compiled\nx _ = 2 -- (and thus the reason B fails is that the bug is fixed)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport F\n\nf :: F Int -> Bool\nf = id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule F where\n\ntype family F a :: *\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule O where\n\nimport F\n\ntype instance F Int = Bool\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Main where\n\nimport Prelude hiding (lookup)\nimport Data.Char (ord)\nimport qualified Data.Map as Map\nimport Data.Kind (Type)\n\n-- Generic maps as ATs\n-- -------------------\n\nclass GMapKey k where\n  data GMap k :: Type -> Type\n  empty       :: GMap k v\n  lookup      :: k -> GMap k v -> Maybe v\n  insert      :: k -> v -> GMap k v -> GMap k v\n\ninstance GMapKey Int where\n  data GMap Int v        = GMapInt (Map.Map Int v)\n  empty                  = GMapInt Map.empty\n  lookup k (GMapInt m)   = Map.lookup k m\n  insert k v (GMapInt m) = GMapInt (Map.insert k v m)\n\ninstance GMapKey Char where\n  data GMap Char v        = GMapChar (GMap Int v)\n  empty                   = GMapChar empty\n  lookup k (GMapChar m)   = lookup (ord k) m\n  insert k v (GMapChar m) = GMapChar (insert (ord k) v m)\n\ninstance GMapKey () where\n  data GMap () v           = GMapUnit (Maybe v)\n  empty                    = GMapUnit Nothing\n  lookup () (GMapUnit v)   = v\n  insert () v (GMapUnit _) = GMapUnit $ Just v\n\ninstance (GMapKey a, GMapKey b) => GMapKey (a, b) where\n  data GMap (a, b) v            = GMapPair (GMap a (GMap b v))\n  empty                         = GMapPair empty\n  lookup (a, b) (GMapPair gm)   = lookup a gm >>= lookup b\n  insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of\n                                    Nothing  -> insert a (insert b v empty) gm\n                                    Just gm2 -> insert a (insert b v gm2  ) gm\n\ninstance (GMapKey a, GMapKey b) => GMapKey (Either a b) where\n  data GMap (Either a b) v                = GMapEither (GMap a v) (GMap b v)\n  empty                                   = GMapEither empty empty\n  lookup (Left  a) (GMapEither gm1  _gm2) = lookup a gm1\n  lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2\n  insert (Left  a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2\n  insert (Right a) v (GMapEither gm1 gm2) = GMapEither gm1 (insert a v gm2)\n\n-- Test code\n-- ---------\n\nnonsence :: GMap Bool String\nnonsence = undefined\n\nmyGMap :: GMap (Int, Either Char ()) String\nmyGMap = insert (5, Left 'c') \"(5, Left 'c')\"    $\n         insert (4, Right ()) \"(4, Right ())\"    $\n         insert (5, Right ()) \"This is the one!\" $\n         insert (5, Right ()) \"This is the two!\" $\n         insert (6, Right ()) \"(6, Right ())\"    $\n         insert (5, Left 'a') \"(5, Left 'a')\"    $\n         empty\nmain = putStrLn $ maybe \"Couldn't find key!\" id $ lookup (5, Right ()) myGMap\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Main where\n\nimport Prelude hiding (lookup)\nimport Data.Char (ord)\nimport qualified Data.Map as Map\nimport Data.Kind (Type)\n\n\n-- Generic maps as toplevel indexed data types\n----------------------------------------------\n\ndata family GMap k :: Type -> Type\ndata instance GMap Int          v = GMapInt    (Map.Map Int v)\ndata instance GMap Char         v = GMapChar   (GMap Int v)\ndata instance GMap ()           v = GMapUnit   (Maybe v)\ndata instance GMap (a, b)       v = GMapPair   (GMap a (GMap b v))\ndata instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v)\n\nclass GMapKey k where\n  empty       :: GMap k v\n  lookup      :: k -> GMap k v -> Maybe v\n  insert      :: k -> v -> GMap k v -> GMap k v\n\ninstance GMapKey Int where\n  empty                  = GMapInt Map.empty\n  lookup k (GMapInt m)   = Map.lookup k m\n  insert k v (GMapInt m) = GMapInt (Map.insert k v m)\n\ninstance GMapKey Char where\n  empty                   = GMapChar empty\n  lookup k (GMapChar m)   = lookup (ord k) m\n  insert k v (GMapChar m) = GMapChar (insert (ord k) v m)\n\ninstance GMapKey () where\n  empty                    = GMapUnit Nothing\n  lookup () (GMapUnit v)   = v\n  insert () v (GMapUnit _) = GMapUnit $ Just v\n\ninstance (GMapKey a, GMapKey b) => GMapKey (a, b) where\n  empty                         = GMapPair empty\n  lookup (a, b) (GMapPair gm)   = lookup a gm >>= lookup b\n  insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of\n                                    Nothing  -> insert a (insert b v empty) gm\n                                    Just gm2 -> insert a (insert b v gm2  ) gm\n\ninstance (GMapKey a, GMapKey b) => GMapKey (Either a b) where\n  empty                                   = GMapEither empty empty\n  lookup (Left  a) (GMapEither gm1  _gm2) = lookup a gm1\n  lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2\n  insert (Left  a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2\n  insert (Right a) v (GMapEither gm1 gm2) = GMapEither gm1 (insert a v gm2)\n\n\n-- Test code\n-- ---------\n\nnonsence :: GMap Bool String\nnonsence = undefined\n\nmyGMap :: GMap (Int, Either Char ()) String\nmyGMap = insert (5, Left 'c') \"(5, Left 'c')\"    $\n         insert (4, Right ()) \"(4, Right ())\"    $\n         insert (5, Right ()) \"This is the one!\" $\n         insert (5, Right ()) \"This is the two!\" $\n         insert (6, Right ()) \"(6, Right ())\"    $\n         insert (5, Left 'a') \"(5, Left 'a')\"    $\n         empty\nmain = putStrLn $ maybe \"Couldn't find key!\" id $ lookup (5, Right ()) myGMap\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE DataKinds #-}\n\nimport GHC.Exts\nimport GHC.Types\n\nclass BoxIt (a :: TYPE 'WordRep) where\n    type Boxed a :: Type\n    boxed :: a -> Boxed a\n\ninstance BoxIt Char# where\n    type Boxed Char# = Char\n    boxed x = C# x\n\nmain :: IO ()\nmain = print $ boxed 'c'#\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, UndecidableInstances #-}\n{-# OPTIONS_GHC -Wnot #-}\n\nmodule Main where\n\n-- See http://article.gmane.org/gmane.comp.lang.haskell.general/16796\n-- and Trac #2985\n\ninstance (Num a, Num b, a ~ b) => Num (a,b) where\n    (x,y) * (u,v) = (x*u-y*v, x*v+y*u)\n\ntest1 = (1,1) * (2,2)\nmain = print test1\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, GADTs #-}\nmodule Main where\n\nimport Data.Ix\n\n-- Deriving Enum with phantom type parameter\ndata T a = R | S | T deriving( Enum, Show )\n\n-- Tests that deriving works for data families\ndata family Foo a\n\ndata instance Foo Int\n  = A | B | C | D\n  deriving (Eq, Enum)\n\nf :: Foo Int -> Bool\nf A = True\nf B = False\nf _ = True\n\n-- Tests that deriving works for GADTs\ndata Bar a where\n   P :: Int -> Bar Int\n   Q :: Bar Int\n\nderiving instance (Eq (Bar Int))\n\nmain = do { print [R .. T]\n          ; print (map f [B .. D])\n          ; print [P 3 == P 3, P 4 == Q] }\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, TypeFamilies, FlexibleInstances #-}\nmodule Main where\n\nimport GHC.Exts (Constraint)\n\nimport Prelude hiding (Functor, fmap)\n\nimport           Data.Set (Set)\nimport qualified Data.Set as S (map, fromList)\n\nclass Functor f where\n    type C f a :: Constraint\n    type C f a = ()\n\n    fmap :: (C f a, C f b) => (a -> b) -> f a -> f b\n\ninstance Functor Set where\n    type C Set a = Ord a\n    fmap = S.map\n\ninstance Functor [] where\n    fmap = map\n--    type C [] a = ()\n\ntestList = fmap (+1) [1,2,3]\ntestSet  = fmap (+1) (S.fromList [1,2,3])\n\nmain = do { print testList; print testSet }\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Lib where\n\nimport Language.Haskell.TH\n\nx :: Int -> ExpQ\nx n = [| 3 + n |]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nimport Lib (x)\n\nmain = putStrLn \"Hello World\" >> print $(x 10)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule M where\n\nf = case () of\n  () -> ()\n  where x = x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule M where\n\nf = if True then do undefined else undefined\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule M where\n\n-- The array package used to have things in this sort of pattern, where\n-- the \"parse error\" rule is needed to close the do block's layout\n\nf :: [IO ()]\nf = [do\n   undefined\n   undefined\n   | _ <- undefined]\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE PatternGuards #-}\n\nmodule M where\n\nf | Just x <- undefined,\n    let y = x,\n    undefined x y\n  = ()\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule M where\n\n-- GHC's Lexer.x had a piece of code like this\n\nf = if True then do\n        case () of\n            () -> ()\n            else ()\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule M where\n\n-- GHC's RdrHsSyn.lhs had a piece of code like this\n\nf :: IO ()\nf\n | True = do\n let x = ()\n     y = ()\n return ()\n | True = return ()\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule M where\n\n-- The paren here closes the open-splice - it doesn't match an\n-- opening paren\n\nf :: IO ()\nf = do print $( [| 'a' |] )\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE RecursiveDo, DoRec #-}\n{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}\n\nmodule M where\n\n-- do, mdo and rec should all open layouts\n\nf :: IO ()\nf = do print 'a'\n       print 'b'\n\ng :: IO ()\ng = mdo print 'a'\n        print 'b'\n\nh :: IO ()\nh = do print 'a'\n       rec print 'b'\n           print 'c'\n       print 'd'\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule M where\n\nf :: Char\nf = let {x = 'a'} in x\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash #-}\n\nmodule Q where\n\nimport GHC.Exts\nimport GHC.Integer\n\nv :: Int\nv = I# (integerToInt (smallInteger 3#))\n\nw :: Word\nw = W# (integerToWord (wordToInteger 3##))\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash #-}\n\nmodule Main (main) where\n\nimport GHC.Base\nimport GHC.Integer\n\nmain :: IO ()\nmain = case i of\n       I# i# ->\n           print (gcd (smallInteger i#) (smallInteger i#))\n\n{-# NOINLINE i #-}\ni :: Int\ni = minBound\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Data.Bits\n\n{-\nDo some bitwise operations on some large numbers.\nThese number are designed so that they are likely to exercise all the\ninteresting split-up cases for implementations that implement Integer\nas some sort of sequence of roughly word-sized values. They are\nessentially random apart from that.\n-}\n\npx, py, nx, ny :: Integer\npx =  0x03A4B5C281F6E9D7029C3FE81D6A4B75\nnx = -0x03A4B5C281F6E9D7029C3FE81D6A4B75\npy =  0x069AF53C4D1BE728\nny = -0x069AF53C4D1BE728\n    --  \\.. 64  bits ../\\.. 64  bits ../\n\n{-\npx        = 0 0000001110100100101101011100001010000001111101101110100111010111 0000001010011100001111111110100000011101011010100100101101110101\npy        = 0 0000000000000000000000000000000000000000000000000000000000000000 0000011010011010111101010011110001001101000110111110011100101000\npx and py = 0 0000000000000000000000000000000000000000000000000000000000000000 0000001010011000001101010010100000001101000010100100001100100000\n\npx        = 0 0000001110100100101101011100001010000001111101101110100111010111 0000001010011100001111111110100000011101011010100100101101110101\nny        = 1 1111111111111111111111111111111111111111111111111111111111111111 1111100101100101000010101100001110110010111001000001100011011000\npx and ny = 0 0000001110100100101101011100001010000001111101101110100111010111 0000000000000100000010101100000000010000011000000000100001010000\n\nnx        = 1 1111110001011011010010100011110101111110000010010001011000101000 1111110101100011110000000001011111100010100101011011010010001011\npy        = 0 0000000000000000000000000000000000000000000000000000000000000000 0000011010011010111101010011110001001101000110111110011100101000\nnx and py = 0 0000000000000000000000000000000000000000000000000000000000000000 0000010000000010110000000001010001000000000100011010010000001000\n\nnx        = 1 1111110001011011010010100011110101111110000010010001011000101000 1111110101100011110000000001011111100010100101011011010010001011\nny        = 1 1111111111111111111111111111111111111111111111111111111111111111 1111100101100101000010101100001110110010111001000001100011011000\nnx and ny = 1 1111110001011011010010100011110101111110000010010001011000101000 1111100101100001000000000000001110100010100001000001000010001000\n      = neg 0 0000001110100100101101011100001010000001111101101110100111010111 0000011010011110111111111111110001011101011110111110111101111000\n\npx        = 0 0000001110100100101101011100001010000001111101101110100111010111 0000001010011100001111111110100000011101011010100100101101110101\npy        = 0 0000000000000000000000000000000000000000000000000000000000000000 0000011010011010111101010011110001001101000110111110011100101000\npx or  py = 0 0000001110100100101101011100001010000001111101101110100111010111 0000011010011110111111111111110001011101011110111110111101111101\n\npx        = 0 0000001110100100101101011100001010000001111101101110100111010111 0000001010011100001111111110100000011101011010100100101101110101\nny        = 1 1111111111111111111111111111111111111111111111111111111111111111 1111100101100101000010101100001110110010111001000001100011011000\npx or  ny = 1 1111111111111111111111111111111111111111111111111111111111111111 1111101111111101001111111110101110111111111011100101101111111101\n      = neg 0 0000000000000000000000000000000000000000000000000000000000000000 0000010000000010110000000001010001000000000100011010010000000011\n\nnx        = 1 1111110001011011010010100011110101111110000010010001011000101000 1111110101100011110000000001011111100010100101011011010010001011\npy        = 0 0000000000000000000000000000000000000000000000000000000000000000 0000011010011010111101010011110001001101000110111110011100101000\nnx or  py = 1 1111110001011011010010100011110101111110000010010001011000101000 1111111111111011111101010011111111101111100111111111011110101011\n      = neg 0 0000001110100100101101011100001010000001111101101110100111010111 0000000000000100000010101100000000010000011000000000100001010101\n\nnx        = 1 1111110001011011010010100011110101111110000010010001011000101000 1111110101100011110000000001011111100010100101011011010010001011\nny        = 1 1111111111111111111111111111111111111111111111111111111111111111 1111100101100101000010101100001110110010111001000001100011011000\nnx or  ny = 1 1111111111111111111111111111111111111111111111111111111111111111 1111110101100111110010101101011111110010111101011011110011011011\n      = neg 0 0000000000000000000000000000000000000000000000000000000000000000 0000001010011000001101010010100000001101000010100100001100100101\n\npx        = 0 0000001110100100101101011100001010000001111101101110100111010111 0000001010011100001111111110100000011101011010100100101101110101\npy        = 0 0000000000000000000000000000000000000000000000000000000000000000 0000011010011010111101010011110001001101000110111110011100101000\npx xor py = 0 0000001110100100101101011100001010000001111101101110100111010111 0000010000000110110010101101010001010000011100011010110001011101\n\npx        = 0 0000001110100100101101011100001010000001111101101110100111010111 0000001010011100001111111110100000011101011010100100101101110101\nny        = 1 1111111111111111111111111111111111111111111111111111111111111111 1111100101100101000010101100001110110010111001000001100011011000\npx xor ny = 1 1111110001011011010010100011110101111110000010010001011000101000 1111101111111001001101010010101110101111100011100101001110101101\n      = neg 0 0000001110100100101101011100001010000001111101101110100111010111 0000010000000110110010101101010001010000011100011010110001010011\n\nnx        = 1 1111110001011011010010100011110101111110000010010001011000101000 1111110101100011110000000001011111100010100101011011010010001011\npy        = 0 0000000000000000000000000000000000000000000000000000000000000000 0000011010011010111101010011110001001101000110111110011100101000\nnx xor py = 1 1111110001011011010010100011110101111110000010010001011000101000 1111101111111001001101010010101110101111100011100101001110100011\n      = neg 0 0000001110100100101101011100001010000001111101101110100111010111 0000010000000110110010101101010001010000011100011010110001011101\n\nnx        = 1 1111110001011011010010100011110101111110000010010001011000101000 1111110101100011110000000001011111100010100101011011010010001011\nny        = 1 1111111111111111111111111111111111111111111111111111111111111111 1111100101100101000010101100001110110010111001000001100011011000\nnx xor ny = 0 0000001110100100101101011100001010000001111101101110100111010111 0000010000000110110010101101010001010000011100011010110001010011\n\n-}\n\npx_and_py :: Integer\npx_and_py = 0x29835280D0A4320\n\npx_and_ny :: Integer\npx_and_ny = 0x3A4B5C281F6E9D700040AC010600850\n\nnx_and_py :: Integer\nnx_and_py = 0x402C0144011A408\n\nnx_and_ny :: Integer\nnx_and_ny = -0x3A4B5C281F6E9D7069EFFFC5D7BEF78\n\npx_or_py :: Integer\npx_or_py = 0x3A4B5C281F6E9D7069EFFFC5D7BEF7D\n\npx_or_ny :: Integer\npx_or_ny = -0x402C0144011A403\n\nnx_or_py :: Integer\nnx_or_py = -0x3A4B5C281F6E9D700040AC010600855\n\nnx_or_ny :: Integer\nnx_or_ny = -0x29835280D0A4325\n\npx_xor_py :: Integer\npx_xor_py = 0x3A4B5C281F6E9D70406CAD45071AC5D\n\npx_xor_ny :: Integer\npx_xor_ny = -0x3A4B5C281F6E9D70406CAD45071AC53\n\nnx_xor_py :: Integer\nnx_xor_py = -0x3A4B5C281F6E9D70406CAD45071AC5D\n\nnx_xor_ny :: Integer\nnx_xor_ny = 0x3A4B5C281F6E9D70406CAD45071AC53\n\nmain :: IO ()\nmain = do putStrLn \"Start\"\n          test \"px and py\" px_and_py (px .&. py)\n          test \"px and ny\" px_and_ny (px .&. ny)\n          test \"nx and py\" nx_and_py (nx .&. py)\n          test \"nx and ny\" nx_and_ny (nx .&. ny)\n          test \"px or py\" px_or_py (px .|. py)\n          test \"px or ny\" px_or_ny (px .|. ny)\n          test \"nx or py\" nx_or_py (nx .|. py)\n          test \"nx or ny\" nx_or_ny (nx .|. ny)\n          test \"px xor py\" px_xor_py (px `xor` py)\n          test \"px xor ny\" px_xor_ny (px `xor` ny)\n          test \"nx xor py\" nx_xor_py (nx `xor` py)\n          test \"nx xor ny\" nx_xor_ny (nx `xor` ny)\n          putStrLn \"End\"\n\ntest :: String -> Integer -> Integer -> IO ()\ntest what want got\n | want == got = return ()\n | otherwise   = print (what, want, got)\n\n", "num_lines": 135}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Data.Bits\nimport Data.Int\nimport Data.Word\n\nmain :: IO ()\nmain = do p \"plusInteger\"        plusInteger\n          p \"timesInteger\"       timesInteger\n          p \"minusIntegerN\"      minusIntegerN\n          p \"minusIntegerP\"      minusIntegerP\n          p \"negateInteger\"      negateInteger\n          p \"eqIntegerE\"         eqIntegerE\n          p \"eqIntegerN\"         eqIntegerN\n          p \"neqIntegerE\"        neqIntegerE\n          p \"neqIntegerN\"        neqIntegerN\n          p \"absIntegerP\"        absIntegerP\n          p \"absIntegerZ\"        absIntegerZ\n          p \"absIntegerN\"        absIntegerN\n          p \"signumIntegerP\"    signumIntegerP\n          p \"signumIntegerZ\"    signumIntegerZ\n          p \"signumIntegerN\"    signumIntegerN\n          p \"leIntegerL\"        leIntegerL\n          p \"leIntegerE\"        leIntegerE\n          p \"leIntegerG\"        leIntegerG\n          p \"gtIntegerL\"        gtIntegerL\n          p \"gtIntegerE\"        gtIntegerE\n          p \"gtIntegerG\"        gtIntegerG\n          p \"ltIntegerL\"        ltIntegerL\n          p \"ltIntegerE\"        ltIntegerE\n          p \"ltIntegerG\"        ltIntegerG\n          p \"geIntegerL\"        geIntegerL\n          p \"geIntegerE\"        geIntegerE\n          p \"geIntegerG\"        geIntegerG\n          p \"compareIntegerL\"   compareIntegerL\n          p \"compareIntegerE\"   compareIntegerE\n          p \"compareIntegerG\"   compareIntegerG\n          p \"gcdInteger\"        gcdInteger\n          p \"lcmInteger\"        lcmInteger\n          p \"andInteger\"        andInteger\n          p \"orInteger\"         orInteger\n          p \"xorInteger\"        xorInteger\n          p \"complementInteger\" complementInteger\n          p \"quotRemInteger\"    quotRemInteger\n          p \"divModInteger\"     divModInteger\n          p \"shiftLInteger\"     shiftLInteger\n          p \"shiftRInteger\"     shiftRInteger\n          p \"quotInteger\"       quotInteger\n          p \"remInteger\"        remInteger\n          p \"divInteger\"        divInteger\n          p \"modInteger\"        modInteger\n          p \"doubleFromInteger\" doubleFromInteger\n          p \"floatFromInteger\"  floatFromInteger\n          p \"decodeIntegerDouble\" decodeIntegerDouble\n          p \"encodeIntegerDouble\" encodeIntegerDouble\n          p \"encodeIntegerFloat\"  encodeIntegerFloat\n          p \"integerToWord\"       integerToWord\n          p \"integerToInt\"        integerToInt\n          p \"wordToInteger\"       wordToInteger\n          p \"intToInteger\"        intToInteger\n          p \"word64ToInteger\"     word64ToInteger\n          p \"int64ToInteger\"      int64ToInteger\n\n    where p :: Show a => String -> a -> IO ()\n          p str x = putStrLn (str ++ \": \" ++ show x)\n\nplusInteger :: Integer\nplusInteger = 100003 + 100004\n\ntimesInteger :: Integer\ntimesInteger = 100005 * 6832\n\nminusIntegerN :: Integer\nminusIntegerN = 100007 - 100998\nminusIntegerP :: Integer\nminusIntegerP = 100999 - 100010\n\nnegateInteger :: Integer\nnegateInteger = negate 200011\n\neqIntegerE :: Bool\neqIntegerE = (100012 :: Integer) == 100012\neqIntegerN :: Bool\neqIntegerN = (100013 :: Integer) == 100014\n\nneqIntegerE :: Bool\nneqIntegerE = (100015 :: Integer) /= 100015\nneqIntegerN :: Bool\nneqIntegerN = (100016 :: Integer) /= 100017\n\nabsIntegerP :: Integer\nabsIntegerP = abs 200018\nabsIntegerZ :: Integer\nabsIntegerZ = abs 0\nabsIntegerN :: Integer\nabsIntegerN = abs (-200019)\n\nsignumIntegerP :: Integer\nsignumIntegerP = signum 100020\nsignumIntegerZ :: Integer\nsignumIntegerZ = signum 0\nsignumIntegerN :: Integer\nsignumIntegerN = signum (-100021)\n\nleIntegerL :: Bool\nleIntegerL = (100022 :: Integer) <= 100023\nleIntegerE :: Bool\nleIntegerE = (100024 :: Integer) <= 100024\nleIntegerG :: Bool\nleIntegerG = (100026 :: Integer) <= 100025\n\ngtIntegerL :: Bool\ngtIntegerL = (100026 :: Integer) > 100027\ngtIntegerE :: Bool\ngtIntegerE = (100028 :: Integer) > 100028\ngtIntegerG :: Bool\ngtIntegerG = (100030 :: Integer) > 100031\n\nltIntegerL :: Bool\nltIntegerL = (100032 :: Integer) < 100033\nltIntegerE :: Bool\nltIntegerE = (100034 :: Integer) < 100034\nltIntegerG :: Bool\nltIntegerG = (100036 :: Integer) < 100035\n\ngeIntegerL :: Bool\ngeIntegerL = (100037 :: Integer) >= 100038\ngeIntegerE :: Bool\ngeIntegerE = (100039 :: Integer) >= 100039\ngeIntegerG :: Bool\ngeIntegerG = (100041 :: Integer) >= 100040\n\ncompareIntegerL :: Ordering\ncompareIntegerL = (100042 :: Integer) `compare` 100043\ncompareIntegerE :: Ordering\ncompareIntegerE = (100044 :: Integer) `compare` 100044\ncompareIntegerG :: Ordering\ncompareIntegerG = (100046 :: Integer) `compare` 100045\n\ngcdInteger :: Integer\ngcdInteger = 100048 `gcd` 150072\n\nlcmInteger :: Integer\nlcmInteger = 100050 `lcm` 100060\n\nandInteger :: Integer\nandInteger = 100052 .&. 140053\n\norInteger :: Integer\norInteger = 100054 .|. 140055\n\nxorInteger :: Integer\nxorInteger = 100056 `xor` 140057\n\ncomplementInteger :: Integer\ncomplementInteger = complement 200058\n\nquotRemInteger :: (Integer, Integer)\nquotRemInteger = 100059 `quotRem` 123\n\ndivModInteger :: (Integer, Integer)\ndivModInteger = 100060 `divMod` 456\n\nshiftLInteger :: Integer\nshiftLInteger = 100061 `shiftL` 4\n\nshiftRInteger :: Integer\nshiftRInteger = 100062 `shiftR` 4\n\nquotInteger :: Integer\nquotInteger = 100063 `quot` 156\n\nremInteger :: Integer\nremInteger = 100064 `rem` 156\n\ndivInteger :: Integer\ndivInteger = 100286 `div` 156\n\nmodInteger :: Integer\nmodInteger = 100086 `mod` 156\n\n-- For the conversion functions, we can't just check that e.g. 100065\n-- is in the resulting core, because it will be regardless of whether\n-- the rules fire or not. So we add 100066, and thus rely on the\n-- Double addition rule also firing.\ndoubleFromInteger :: Double\ndoubleFromInteger = fromInteger 100065 + 100066\n\nfloatFromInteger :: Float\nfloatFromInteger = fromInteger 100067 + 100068\n\nencodeIntegerDouble :: Double\nencodeIntegerDouble = encodeFloat 100069 2\n\nencodeIntegerFloat :: Float\nencodeIntegerFloat = encodeFloat 100070 2\n\nintegerToWord :: Word\nintegerToWord = fromInteger 100071 + 100072\n\nintegerToInt :: Int\nintegerToInt = fromInteger 100073 + 100074\n\nwordToInteger :: Integer\nwordToInteger = toInteger (100075 :: Word) + 100076\n\nintToInteger :: Integer\nintToInteger = toInteger (100077 :: Int) + 100078\n\nword64ToInteger :: Integer\nword64ToInteger = toInteger (100079 :: Word64) + 100080\n\nint64ToInteger :: Integer\nint64ToInteger = toInteger (100081 :: Int64) + 100082\n\ndecodeIntegerDouble :: (Integer, Int)\ndecodeIntegerDouble = decodeFloat (100083 :: Double)\n\n", "num_lines": 220}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule IntegerConversionRules where\n\n#if __GLASGOW_HASKELL__ < 709\nimport Data.Word (Word)\n#endif\n\nf1 :: Int -> Double\nf1 = fi\n\nf2 :: Int -> Float\nf2 = fi\n\nf3 :: Int -> Int\nf3 = fi\n\nf4 :: Int -> Word\nf4 = fi\n\nfi :: (Integral a, Num b) => a -> b\nfi = fromIntegral\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Data.Int\nimport Data.Word\n\naround :: Integer -> [Integer]\naround i = [i - 2, i - 1, i, i + 1, i + 2]\n\ndump :: Show a => String -> [a] -> IO ()\ndump s xs = do putStrLn \"====================================\"\n               putStrLn s\n               mapM_ print xs\n\nmain :: IO ()\nmain = do let xs :: [[Integer]]\n              xs = [around 0,\n                    around (2^30),\n                    around (2^31),\n                    around (2^32),\n                    around (2^33),\n                    around (2^34),\n                    around (2^62),\n                    around (2^63),\n                    around (2^64),\n                    around (2^65),\n                    around (2^66),\n                    around (-(2^30)),\n                    around (-(2^31)),\n                    around (-(2^32)),\n                    around (-(2^33)),\n                    around (-(2^34)),\n                    around (-(2^62)),\n                    around (-(2^63)),\n                    around (-(2^64)),\n                    around (-(2^65)),\n                    around (-(2^66))]\n              xsInt :: [[Int]]\n              xsInt = map (map fromInteger) xs\n              xsIntInteger :: [[Integer]]\n              xsIntInteger = map (map toInteger) xsInt\n              xsInt32 :: [[Int32]]\n              xsInt32 = map (map fromInteger) xs\n              xsInt32Integer :: [[Integer]]\n              xsInt32Integer = map (map toInteger) xsInt32\n              xsInt64 :: [[Int64]]\n              xsInt64 = map (map fromInteger) xs\n              xsInt64Integer :: [[Integer]]\n              xsInt64Integer = map (map toInteger) xsInt64\n              xsWord :: [[Word]]\n              xsWord = map (map fromInteger) xs\n              xsWordInteger :: [[Integer]]\n              xsWordInteger = map (map toInteger) xsWord\n              xsWord32 :: [[Word32]]\n              xsWord32 = map (map fromInteger) xs\n              xsWord32Integer :: [[Integer]]\n              xsWord32Integer = map (map toInteger) xsWord32\n              xsWord64 :: [[Word64]]\n              xsWord64 = map (map fromInteger) xs\n              xsWord64Integer :: [[Integer]]\n              xsWord64Integer = map (map toInteger) xsWord64\n          dump \"xs\" xs\n          dump \"xsInt\" xsInt\n          dump \"xsIntInteger\" xsIntInteger\n          dump \"xsInt32\" xsInt32\n          dump \"xsInt32Integer\" xsInt32Integer\n          dump \"xsInt64\" xsInt64\n          dump \"xsInt64Integer\" xsInt64Integer\n          dump \"xsWord\" xsWord\n          dump \"xsWordInteger\" xsWordInteger\n          dump \"xsWord32\" xsWord32\n          dump \"xsWord32Integer\" xsWord32Integer\n          dump \"xsWord64\" xsWord64\n          dump \"xsWord64Integer\" xsWord64Integer\n\ntest :: String -> Integer -> Integer -> IO ()\ntest what want got\n | want == got = return ()\n | otherwise   = print (what, want, got)\n\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}\n\nmodule Main (main) where\n\nimport Data.List (group)\nimport Data.Bits\nimport Data.Word\nimport Control.Monad\n\nimport GHC.Word\nimport GHC.Base\nimport GHC.Integer.GMP.Internals (Integer(S#,Jp#,Jn#))\nimport qualified GHC.Integer.GMP.Internals as I\n\n-- NOTE: Some of the following operations were provided with\n-- integer-gmp-0.5.1, but were not ported to integer-gmp-1.0.0 (yet);\n-- so we use naive reference-implementations instead for the meantime\n-- in order to keep the reference-output untouched.\n\nrecipModInteger :: Integer -> Integer -> Integer\nrecipModInteger = I.recipModInteger\n\ngcdExtInteger :: Integer -> Integer -> (Integer, Integer)\ngcdExtInteger a b = case I.gcdExtInteger a b of (# g, s #) -> (g, s)\n\npowModSecInteger :: Integer -> Integer -> Integer -> Integer\npowModSecInteger = I.powModSecInteger\n\npowModInteger :: Integer -> Integer -> Integer -> Integer\npowModInteger = I.powModInteger\n\n-- FIXME: Lacks GMP2 version\npowInteger :: Integer -> Word -> Integer\npowInteger x e = x^e\n\nexportInteger :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word\nexportInteger = I.exportIntegerToMutableByteArray\n\nexportIntegerAddr :: Integer -> Addr# -> Int# -> IO Word\nexportIntegerAddr = I.exportIntegerToAddr\n\nimportInteger :: ByteArray# -> Word# -> Word# -> Int# -> Integer\nimportInteger = I.importIntegerFromByteArray\n\nimportIntegerAddr :: Addr# -> Word# -> Int# -> IO Integer\nimportIntegerAddr a l e = I.importIntegerFromAddr a l e\n\n-- helpers\ndata MBA = MBA { unMBA :: !(MutableByteArray# RealWorld) }\ndata BA  = BA  { unBA  :: !ByteArray# }\n\nnewByteArray :: Word# -> IO MBA\nnewByteArray sz = IO $ \\s -> case newPinnedByteArray# (word2Int# sz) s of (# s, arr #) -> (# s, MBA arr #)\n\nindexByteArray :: ByteArray# -> Word# -> Word8\nindexByteArray a# n# = W8# (indexWord8Array# a# (word2Int# n#))\n\n-- indexMutableByteArray :: MutableByteArray# RealWorld -> Word# -> IO Word8\n-- indexMutableByteArray a# n# = IO $ \\s -> case readWord8Array# a# (word2Int# n#) s of (# s', v #) -> (# s', W# v #)\n\nwriteByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()\nwriteByteArray arr i (W8# w) = IO $ \\s -> case writeWord8Array# arr i w s of s -> (# s, () #)\n\nlengthByteArray :: ByteArray# -> Word\nlengthByteArray ba = W# (int2Word# (sizeofByteArray# ba))\n\nunpackByteArray :: ByteArray# -> [Word8]\nunpackByteArray ba | n == 0    = []\n                   | otherwise = [ indexByteArray ba i | W# i <- [0 .. n-1] ]\n  where\n    n = lengthByteArray ba\n\nfreezeByteArray :: MutableByteArray# RealWorld -> IO BA\nfreezeByteArray arr = IO $ \\s -> case unsafeFreezeByteArray# arr s of (# s, arr #) -> (# s, BA arr #)\n\n----------------------------------------------------------------------------\nmain :: IO ()\nmain = do\n    print $ powModInteger b e m\n    print $ powModInteger b e (m-1)\n    print $ powModSecInteger b e (m-1)\n\n    putStrLn \"\\n# gcdExtInteger\"\n    print $ gcdExtInteger b e\n    print $ gcdExtInteger e b\n    print $ gcdExtInteger x y\n    print $ gcdExtInteger y x\n    print $ gcdExtInteger x (-y)\n    print $ gcdExtInteger (-x) y\n    print $ gcdExtInteger (-x) (-y)\n\n    -- see Trac #15350\n    do\n        let a = 2\n            b = 2^65 + 1\n        print $ gcdExtInteger a b\n        print $ gcdExtInteger a (-b)\n        print $ gcdExtInteger (-a) b\n        print $ gcdExtInteger (-a) (-b)\n        print $ gcdExtInteger b a\n        print $ gcdExtInteger b (-a)\n        print $ gcdExtInteger (-b) a\n        print $ gcdExtInteger (-b) (-a)\n\n    putStrLn \"\\n# powInteger\"\n    print $ powInteger 12345 0\n    print $ powInteger 12345 1\n    print $ powInteger 12345 30\n    print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ]\n\n    putStrLn \"\\n# nextPrimeInteger\"\n    print $ I.nextPrimeInteger b\n    print $ I.nextPrimeInteger e\n    print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ]\n    print $ rle [ S# (I.testPrimeInteger k 25#) | k <- [ x .. x + 1000 ] ]\n    print $ rle [ S# (I.testPrimeInteger k 25#) | k <- [ e .. e + 1000 ] ]\n\n    -- import/export primitives\n    print $ [ W# (I.sizeInBaseInteger x 2#)   | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]\n    print $ [ W# (I.sizeInBaseInteger x 256#) | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]\n\n    BA ba <- do\n        MBA mba <- newByteArray 128##\n        forM_ (zip [0..127] [0x01..]) $ \\(I# i, w) -> do\n            writeByteArray mba i w\n\n        let a = byteArrayContents# (unsafeCoerce# mba)\n\n        print =<< importIntegerAddr a 0## 1#\n        print =<< importIntegerAddr a 0## 0#\n\n        print =<< importIntegerAddr (plusAddr# a 22#) 1## 1#\n        print =<< importIntegerAddr (plusAddr# a 97#) 1## 0#\n\n        print =<< importIntegerAddr a 23## 1#\n        print =<< importIntegerAddr a 23## 0#\n\n        -- no-op\n        print =<< exportIntegerAddr 0 (plusAddr# a 0#) 1#\n\n        -- write into array\n        print =<< exportIntegerAddr b (plusAddr# a  5#) 1#\n        print =<< exportIntegerAddr e (plusAddr# a 50#) 0#\n\n        print =<< exportInteger m mba 85## 1#\n        print =<< exportInteger m mba 105## 0#\n\n        print =<< importIntegerAddr (plusAddr# a 85#)  17## 1#\n        print =<< importIntegerAddr (plusAddr# a 105#) 17## 0#\n\n        -- read back full array\n        print =<< importIntegerAddr a 128## 1#\n        print =<< importIntegerAddr a 128## 0#\n\n        freezeByteArray mba\n\n    print $ importInteger ba 0## 0## 1#\n    print $ importInteger ba 0## 0## 0#\n\n    print $ importInteger ba 5## 29## 1#\n    print $ importInteger ba 50## 29## 0#\n\n    print $ importInteger ba 0## 128## 1#\n    print $ importInteger ba 0## 128## 0#\n\n    return ()\n  where\n    b = 2988348162058574136915891421498819466320163312926952423791023078876139\n    e = 2351399303373464486466122544523690094744975233415544072992656881240319\n    m = 10^(40::Int)\n\n    x = 5328841272400314897981163497728751426\n    y = 32052182750761975518649228050096851724\n\n    b1024 = roll (map fromIntegral (take 128 [0x80::Int .. ]))\n\n    rle = map (\\x -> (length x, head x)) . group\n\n\n    roll :: [Word8] -> Integer\n    roll = GHC.Base.foldr (\\b a -> a `shiftL` 8 .|. fromIntegral b) 0\n", "num_lines": 182}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\n\nmain :: IO ()\nmain = do\n    print $ length vals\n\n  where\n    boundaries :: [Integer]\n    boundaries = [fromIntegral (maxBound :: Int) - 3,\n                  fromIntegral (maxBound :: Int) - 2,\n                  fromIntegral (maxBound :: Int) - 1,\n                  fromIntegral (maxBound :: Int),\n                  fromIntegral (maxBound :: Int) + 1,\n                  fromIntegral (maxBound :: Int) + 2,\n                  fromIntegral (maxBound :: Int) + 3,\n\n                  fromIntegral (minBound :: Int) - 3,\n                  fromIntegral (minBound :: Int) - 2,\n                  fromIntegral (minBound :: Int) - 1,\n                  fromIntegral (minBound :: Int),\n                  fromIntegral (minBound :: Int) + 1,\n                  fromIntegral (minBound :: Int) + 2,\n                  fromIntegral (minBound :: Int) + 3,\n\n                  fromIntegral (maxBound :: Word) - 3,\n                  fromIntegral (maxBound :: Word) - 2,\n                  fromIntegral (maxBound :: Word) - 1,\n                  fromIntegral (maxBound :: Word),\n                  fromIntegral (maxBound :: Word) + 1,\n                  fromIntegral (maxBound :: Word) + 2,\n                  fromIntegral (maxBound :: Word) + 3,\n\n                  -3, -2, -1, 0, 1, 2, 3]\n    vals = filter (\\(x, y) -> x /= y) [(x - y, x + negate y) |\n                                       x <- boundaries, y <- boundaries]\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\nmodule Test where\nimport GHC.Base\n\ndata U1 p = U1\n\ninstance Functor U1 where\n    fmap f U1 = U1\n\ninstance Applicative U1 where\n    pure _ = U1\n    U1 <*> U1 = U1\n\ninstance Alternative U1 where\n    empty = U1\n    U1 <|> U1 = U1\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,\n             BangPatterns, MagicHash #-}\n\n-- | Test case for Trac #5486\n-- Test case reduced from HsOpenSSL package BN module\nmodule Bad where\n\nimport           Control.Exception hiding (try)\nimport           Foreign\nimport qualified Data.ByteString as BS\n\nimport           Foreign.C.Types\nimport           GHC.Base\nimport           GHC.Integer.GMP.Internals\n\nnewtype BigNum = BigNum (Ptr BIGNUM)\ndata BIGNUM\n\ndata ByteArray = BA  !ByteArray#\ndata MBA       = MBA !(MutableByteArray# RealWorld)\n\nforeign import ccall unsafe \"BN_free\"\n        _free :: Ptr BIGNUM -> IO ()\n\nforeign import ccall unsafe \"BN_bn2mpi\"\n        _bn2mpi :: Ptr BIGNUM -> Ptr CChar -> IO CInt\n\nforeign import ccall unsafe \"memcpy\"\n        _copy_in :: ByteArray# -> Ptr () -> CSize -> IO ()\n\nforeign import ccall unsafe \"memcpy\"\n        _copy_out :: Ptr () -> ByteArray# -> CSize -> IO ()\n\nunwrapBN :: BigNum -> Ptr BIGNUM\nunwrapBN (BigNum p) = p\n\nwrapBN :: Ptr BIGNUM -> BigNum\nwrapBN = BigNum\n\nbnToInteger :: BigNum -> IO Integer\nbnToInteger bn = do\n  nlimbs <- ((\\hsc_ptr -> peekByteOff hsc_ptr 8)) (unwrapBN bn) :: IO CInt\n  case nlimbs of\n    0 -> return 0\n    1 -> do (I# i) <- ((\\hsc_ptr -> peekByteOff hsc_ptr 0)) (unwrapBN bn) >>= peek\n            negative <- ((\\hsc_ptr -> peekByteOff hsc_ptr 16)) (unwrapBN bn) :: IO CInt\n            if negative == 0\n               then return $ S# i\n               else return $ 0 - (S# i)\n    _ -> do\n      let !(I# nlimbsi) = fromIntegral nlimbs\n          !(I# limbsize) = ((8))\n      (MBA arr) <- newByteArray (nlimbsi *# limbsize)\n      (BA ba) <- freezeByteArray arr\n      limbs <- ((\\hsc_ptr -> peekByteOff hsc_ptr 0)) (unwrapBN bn)\n      _ <- _copy_in ba limbs $ fromIntegral $ nlimbs * ((8))\n      negative <- ((\\hsc_ptr -> peekByteOff hsc_ptr 16)) (unwrapBN bn) :: IO CInt\n      if negative == 0\n         then return $ J# nlimbsi ba\n         else return $ 0 - (J# nlimbsi ba)\n\nnewByteArray :: Int# -> IO MBA\nnewByteArray sz = IO $ \\s ->\n  case newByteArray# sz s of { (# s', arr #) ->\n  (# s', MBA arr #) }\n\nfreezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray\nfreezeByteArray arr = IO $ \\s ->\n  case unsafeFreezeByteArray# arr s of { (# s', arr' #) ->\n  (# s', BA arr' #) }\n\nintegerToBN :: Integer -> IO BigNum\nintegerToBN (S# 0#) = do\n  bnptr <- mallocBytes ((24))\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 0)) bnptr nullPtr\n  let one :: CInt\n      one = 1\n      zero :: CInt\n      zero = 0\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 20)) bnptr one\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 8)) bnptr zero\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 12)) bnptr zero\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 16)) bnptr zero\n  return (wrapBN bnptr)\n\nintegerToBN (S# v) = do\n  bnptr <- mallocBytes ((24))\n  limbs <- malloc :: IO (Ptr CULong)\n  poke limbs $ fromIntegral $ abs $ I# v\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 0)) bnptr limbs\n  let one :: CInt\n      one = 1\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 20)) bnptr one\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 8)) bnptr one\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 12)) bnptr one\n  ((\\hsc_ptr -> pokeByteOff hsc_ptr 16)) bnptr (if (I# v) < 0 then one else 0)\n  return (wrapBN bnptr)\n\nintegerToBN v@(J# nlimbs_ bytearray)\n  | v >= 0 = do\n      let nlimbs = (I# nlimbs_)\n      bnptr <- mallocBytes ((24))\n      limbs <- mallocBytes (((8)) * nlimbs)\n      ((\\hsc_ptr -> pokeByteOff hsc_ptr 0)) bnptr limbs\n      ((\\hsc_ptr -> pokeByteOff hsc_ptr 20)) bnptr (1 :: CInt)\n      _ <- _copy_out limbs bytearray (fromIntegral $ ((8)) * nlimbs)\n      ((\\hsc_ptr -> pokeByteOff hsc_ptr 8)) bnptr ((fromIntegral nlimbs) :: CInt)\n      ((\\hsc_ptr -> pokeByteOff hsc_ptr 12)) bnptr ((fromIntegral nlimbs) :: CInt)\n      ((\\hsc_ptr -> pokeByteOff hsc_ptr 16)) bnptr (0 :: CInt)\n      return (wrapBN bnptr)\n  | otherwise = do bnptr <- integerToBN (0-v)\n                   ((\\hsc_ptr -> pokeByteOff hsc_ptr 16)) (unwrapBN bnptr) (1 :: CInt)\n                   return bnptr\n\nintegerToMPI :: Integer -> IO BS.ByteString\nintegerToMPI v = bracket (integerToBN v) (_free . unwrapBN) bnToMPI\n\nbnToMPI :: BigNum -> IO BS.ByteString\nbnToMPI bn = do\n  bytes <- _bn2mpi (unwrapBN bn) nullPtr\n  allocaBytes (fromIntegral bytes) (\\buffer -> do\n    _ <- _bn2mpi (unwrapBN bn) buffer\n    BS.packCStringLen (buffer, fromIntegral bytes))\n\n", "num_lines": 125}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n-- Test case for Trac #5681\nmodule Main where\n\nimport GHC.Prim\n\nwork :: Int -> Int\nwork n = work (n-1)\n\nmain :: IO ()\nmain = case spark# (work 2) realWorld# of\n           (# _, _ #) -> case par# (work 1) of\n                             _ -> return ()\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M where\n\nimport Control.Monad.Primitive\nimport qualified Data.Vector.Unboxed.Mutable as V\nimport System.IO.Unsafe (unsafePerformIO)\n\nfoo :: ()\nfoo = unsafePerformIO $ do\n    _ <- V.replicate 1 0.0 :: IO (V.MVector RealWorld Double)\n    return ()\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE MagicHash, UnliftedFFITypes #-}\nmodule T7575 where\n\nimport GHC.Prim\nimport GHC.Word\nimport GHC.Types\n\nforeign import ccall unsafe \"hs_eqWord64\" dummy_eqWord64# :: Word64# -> Word64# -> Bool\n\ncheck :: Word64 -> Word64 -> Bool\ncheck (W64# x#) (W64# y#) = dummy_eqWord64# x# y#\n\ncheck2 :: Word64 -> Bool\ncheck2 x = check x 0\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nimport GHC.Prim\nimport GHC.IO\n\nmain = IO $ \\s ->\n  let (# s1, p0 #) = newByteArray# 10# s\n      (# s2, p #) = unsafeFreezeByteArray# p0 s1\n      (# s3, q #) = newByteArray# 10# s2\n  in (# copyByteArray# p 0# q 0# 10# s, () #)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule SymbolsViaSections where\nforeign export ccall test :: Int -> IO ()\ntest :: Int -> IO ()\ntest i = putStrLn (replicate i '.')\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- test that we have all the promised instances\n\nmodule Main(main) where\n\nimport Control.Monad.Fix\nimport qualified Control.Monad.ST      as SST\nimport qualified Control.Monad.ST.Lazy as LST\n\ngeneric :: MonadFix m => m [Int]\ngeneric = mdo xs <- return (1:xs)\n              return (take 4 xs)\n\nio :: IO [Int]\nio = generic\n\nsst :: SST.ST s [Int]\nsst = generic\n\nlst :: LST.ST s [Int]\nlst = generic\n\nmb :: Maybe [Int]\nmb = generic\n\nls :: [[Int]]\nls = generic\n\nmain :: IO ()\nmain = do\n        print   =<< io\n        print   $   SST.runST sst\n        print   $   LST.runST lst\n        print   $   mb\n        print   $   ls\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- test of user defined instance of MonadFix\n\nmodule Main (main) where\n\nimport Control.Monad\nimport Control.Monad.Fix\n\ndata X a = X a deriving Show\n\ninstance Functor X where\n  fmap f (X a) = X (f a)\n\ninstance Applicative X where\n  pure  = return\n  (<*>) = ap\n\ninstance Monad X where\n  return      = X\n  (X a) >>= f = f a\n\ninstance MonadFix X where\n  mfix f = fix (f . unX)\n         where unX ~(X x) = x\n\nz :: X [Int]\nz = mdo x <- return (1:x)\n        return (take 4 x)\n\nmain = print z\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- test let bindings\n\nmodule Main (main) where\n\nimport Control.Monad.Fix \n\nt :: IO Int\nt = mdo x <- return (l \"1\")\n        let l [] = 0\n            l (x:xs) = 1 + l xs\n        return x\n\nmain :: IO ()\nmain = t >>= print\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- test let bindings, polymorphism is ok provided they are not\n-- isolated in a recursive segment\n-- NB. this is not what Hugs does!\n\nmodule Main (main) where\n\nimport Control.Monad.Fix\n\nt :: IO (Int, Int)\nt = mdo let l [] = 0\n            l (x:xs) = 1 + l xs\n        return (l \"1\", l [1,2,3])\n\nmain :: IO ()\nmain = t >>= print\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- test scoping\n\nmodule Main (main) where\n\nimport Control.Monad.Fix\nimport Data.Maybe ( fromJust )\n\nt = mdo x <- fromJust (mdo x <- Just (1:x)\n                           return (take 4 x))\n        return x\n\nmain :: IO ()\nmain = print t\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- This test, from Iavor Diatchki, made GHC 6.2 loop (testLoop)\n-- or panic (testPanic); there was a Lint error.\n-- The reason was a missing bindInstsOfLocalFuns in tcStmtAndThen\n\nmodule ShouldCompile where\n\nimport Control.Monad.Fix\n\ntestLoop _  = mdo x <- mapM undefined (f x)\n                  let f _ = []\n                  return (f x)\n\ntestPanic _  = mdo x <- f x\n                   let f _ = return ()\n                   f x\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecursiveDo #-}\nmodule T10004 where\n\nbar :: IO ()\nbar = do rec {}\n         return ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- let bindings are monomorphic if used prior to their definition\n\nmodule Main (main) where\n\nimport Control.Monad.Fix \n\nt :: IO (Int, Int)\nt = mdo x <- return (l \"1\", l [1,2,3])\n        let l [] = 0\n            l (x:xs) = 1 + l xs\n        return x\n\nmain :: IO ()\nmain = t >>= print\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- shadowing is not allowed\n\nmodule Main (main) where\n\nimport Control.Monad.Fix \n\nt :: IO ()\nt = mdo x <- return 1\n        x <- return 2\n        return ()\n\nmain :: IO ()\nmain = t \n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- shadowing is not allowed II\n\nmodule Main (main) where\n\nimport Control.Monad.Fix \n\nt :: IO ()\nt = mdo x <- return 1\n        let x 0 = 4\n        return ()\n\nmain :: IO ()\nmain = t \n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\n-- OLD: mdo requires MonadFix instance, even\n--      if no recursion is present\n\n-- Dec 2010: Small change of behaviour\n--     MonadFix is only required if recursion is present\n\nmodule Main (main) where\n\nimport Control.Monad.Fix\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\ndata X a = X a deriving Show\n\ninstance Functor X where\n    fmap = liftM\n\ninstance Applicative X where\n    pure = return\n    (<*>) = ap\n\ninstance Monad X where\n  return      = X\n  (X a) >>= f = f a\n\nz :: X [Int]\nz = mdo { a <- return 1; return [a] }\n\nmain = print z\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n-- use of mdo requires an extension,\n-- so let's try not enabling it\n\nmodule Main (main) where\n\nimport Control.Monad.Fix\n\nmain :: IO ()\nmain = mdo x <- return (1:x)\n           return ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DoRec #-}\n\n-- check that do-rec does not perform segmentation\nt :: IO [Int]\nt = do rec xs <- return (1:xs)\n           print (length (take 10 xs))     -- would diverge without segmentation\n       return (take 10 xs)\n\n-- should diverge when run\n-- currently it exhibits itself via a blocked MVar operation\nmain :: IO ()\nmain = t >>= print\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo -XScopedTypeVariables #-}\n\nmodule Main(main) where\n\nimport Control.Monad.Fix\nimport Data.Array.IO\nimport Control.Monad\n\nnorm a = mdo (_, sz) <- getBounds a\n             s <- ioaA 1 s sz 0\n             return ()\n    where\n          ioaA i s sz acc\n           | i > sz = return acc\n           | True   = do v <- readArray a i\n                         writeArray a i (v / s)\n                         ioaA (i+1) s sz $! (v + acc)\n\ntoList a = do (_, sz) <- getBounds a\n              mapM (\\i -> readArray a i) [1..sz]\n\ntest    :: Int -> IO ()\ntest sz = do\n        (arr :: IOArray Int Float) <- newArray (1, sz) 12\n        putStrLn \"Before: \"\n        toList arr >>= print\n        norm arr\n        putStrLn \"After: \"\n        lst <- toList arr\n        print lst\n        putStrLn (\"Normalized sum: \" ++ show (sum lst))\n\nmain = test 10\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRecursiveDo #-}\n\nmodule Main(main) where\n\nimport Control.Monad.Fix\nimport Control.Monad.ST\nimport Data.STRef\nimport Prelude hiding (traverse)\n\nnewtype Node s a = N (STRef s Bool, Node s a, a, Node s a)\n\nnewNode       :: Node s a -> a -> Node s a -> ST s (Node s a)\nnewNode b c f = do v <- newSTRef False\n                   return (N (v, b, c, f))\n\nll :: ST s (Node s Int)\nll = mdo n0 <- newNode n3 0 n1\n         n1 <- newNode n0 1 n2\n         n2 <- newNode n1 2 n3\n         n3 <- newNode n2 3 n0\n         return n0\n\ndata Direction = Forward | Backward deriving Eq\n\ntraverse                      :: Direction -> Node s a -> ST s [a]\ntraverse dir (N (v, b, i, f)) =\n       do visited <- readSTRef v\n          if visited\n             then return []\n             else do writeSTRef v True\n                     let n = if dir == Forward then f else b\n                     is <- traverse dir n\n                     return (i:is)\n\nl2dll        :: [a] -> ST s (Node s a)\nl2dll (x:xs) = mdo c <- newNode l x f\n                   (f, l) <- l2dll' c xs\n                   return c\n\nl2dll'          :: Node s a -> [a] -> ST s (Node s a, Node s a)\nl2dll' p []     = return (p, p)\nl2dll' p (x:xs) = mdo c <- newNode p x f\n                      (f, l) <- l2dll' c xs\n                      return (c, l)\n\ninsertAfter :: Node s a -> a -> ST s (Node s a)\ninsertAfter cur@(N (v, prev, val, next)) i\n     = do vis <- newSTRef False\n          let newCell = N (vis, cur, i, next)\n          return (N (v, prev, val, newCell))\n\ntest = runST (do l   <- l2dll [1 .. 10]\n                 l'  <- insertAfter l  12\n                 l'' <- insertAfter l' 13\n                 traverse Forward l'')\n\nmain = print test\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DoRec #-}\n\nmain :: IO ()\nmain = do x <- return (length [1 .. 42 :: Int])\n          rec b <- return x\n              let a = const c\n              c <- print \"x\"\n          print (b, a b)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecursiveDo #-}\n\n-- check that mdo does perform segmentation\nt :: IO [Int]\nt = mdo xs <- return (1:xs)\n        print (length (take 10 xs))     -- would diverge without segmentation\n        return (take 10 xs)\n\nmain :: IO ()\nmain = t >>= print\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DoRec #-}\n\n-- check that do-rec does not perform segmentation\n-- compare with ../should_fail/mdofail006.hs\nt :: IO [Int]\nt = do rec xs <- return (1:xs)\n       print (length (take 10 xs))     -- would work since out of the segment\n       return (take 10 xs)\n\nmain :: IO ()\nmain = t >>= print\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing unknown module\nmodule M where\nimport N\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Exporting non-existent datatype transparently\nmodule M(T(K1)) where\nx = 'a' -- dummy definition to get round a separate bug\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Empty where declarations list\nmodule Mod100 where\n\ny = 3\n\nx = v where v = 2 where\n\n{- Example of a nested context not being further\n   indented than the enclosing - an error (from the\n   Sec B.2 of the H98 report).\n\nf x = let\n       h y = let\n     p z = z\n             in p\n      in h\n\n-}\n\nf e = let { x = e; y = x } in y\n\nz = 'a' where \n\nclass A a where\n\ninstance A Int where\n\ninstance A Char\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-exporting a subset of a alg. data type's constructors\nmodule Mod101 where\n\nimport Mod101_AuxB\n\n-- ConB is not imported by Mod101_AuxB, hence not exported either.\nx :: DataA\nx = ConB False\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Helper module for mod101.hs\nmodule Mod101_AuxA where\n\ndata DataA = ConA Int | ConB Bool\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Helper module for mod101.hs\n--\nmodule Mod101_AuxB ( DataA(..) ) where\n\nimport Mod101_AuxA ( DataA(ConA) )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Fixed bug: Re-exporting a subset of a class' methods\nmodule Mod102 where\n\nimport Mod102_AuxB\n\n-- methB is not imported by Mod102_AuxB, hence not exported either.\nx :: Bool -> ()\nx = methB False\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Helper module for mod102.hs\n--\nmodule Mod102_AuxA where\n\nclass ClassA a where\n  methA :: Int  -> a\n  methB :: Bool -> a\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Helper module for mod102.hs\n--\nmodule Mod102_AuxB ( ClassA(..) ) where\n\nimport Mod102_AuxA ( ClassA(methA) )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Layout rule extension (restricting empty do's).\nmodule Foo where\n\ng :: Int -> (Int -> IO a) -> IO a\ng x cont = cont x\n\nf :: Int -> IO Int\nf x = do \n  g x $ \\ y -> do\n  f y\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Redefining imported Prelude entities\nmodule A where\n--import Prelude\n\nhead = \"head\"\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-defining Prelude entities\nmodule Ring where\nimport qualified Prelude\nimport Data.List ( nub )\n\nl1 + l2 = l1 Prelude.++ l2\nl1 * l2 = nub (l1 + l2)\n\nsucc = (Prelude.+ 1)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! local aliases\nmodule M where\n\nimport qualified GHC.List as M\nimport qualified Data.Maybe as M\n\nx = M.length\nb = M.isJust\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Redefining and using Prelude entities\nmodule F where\n\nsin :: Float -> Float\nsin x = (x::Float)\nf x = Prelude.sin (F.sin x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Local alias same as module\nmodule F where\n\nimport Prelude as F\n\nx = 'a'\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! redefining and using Prelude entities\nmodule A( null, nonNull ) where\nimport Prelude hiding( null ) \nimport qualified Prelude\nnull, nonNull :: Int -> Bool\nnull    x = x == 0\nnonNull x = not (Prelude.null [x]) && not (null x)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Empty module body\nmodule M where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-defining Prelude class\nmodule M where\n\nimport Prelude\n--import qualified Prelude\n\nclass Eq a where\n equal  :: a -> a -> Prelude.Bool\n negate :: a -> a\n\ninstance Eq Prelude.Int where\n  equal x y = x Prelude.== y\n  negate x  = Prelude.negate x\nx = M.negate (2 :: Prelude.Int)\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Hiding an abstract (Prelude) type\nmodule M where\n\nimport Prelude   hiding ( Char )\nimport Data.Char hiding ( ord, Char )\nimport qualified Data.Char ( ord )\n\ntype Char = Int\n\nord :: Char -> Int\nord x = Data.Char.ord (chr x) + 1\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Hiding an abstract (Prelude) class\nmodule M where\n\nimport Prelude hiding ( Eq )\n\nclass Eq a where\n  equ :: a -> Bool\n\nf :: Eq a => a -> Bool\nf x = equ x\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! empty decls, alts and stmts\nmodule M where {\n;;;;;;;;import Data.Char;;x = 1;;y = 2;\nv = do {;;;;;;;;;;;;;;;;;;;;;;;x <- [1];;return x;;};\nf x = case x of { ;;;;;;2 -> 'a';;;;;;3->'b';;;;;;;;;;;};;;\ng x = case x of { ;;;;;;;;;; _ -> \"aa\"; }\n}\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Type re-exportation test\n-- (from bug reported by Ross Paterson.)\nmodule Mod114 (Stuff) where\nimport Mod114_Help hiding(Stuff(..))\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod114_Help(Stuff(Foo, Bar)) where data Stuff = Foo | Bar\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! class method (re-)exportation trickery\nmodule M where\n\nimport Mod115_B\n\nf = m1 (1::Int)\ng = m2 (2::Int)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- re-exporting m2 outside of C(..)\nmodule Mod115_A( C(m1), m2) where\n\nclass C a where\n  m1 :: a -> Int\n  m2 :: a -> Bool\n\ninstance C Int where\n  m1 _ = 1\n  m2 _ = True\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- re-export all of C\nmodule Mod115_B (C(..)) where\n\nimport Mod115_A (C(m1), m2)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! data ctor (re-)exportation \nmodule M (T(M1), M2) where\n\ndata T = M1 Int | M2 Int\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! field name (re-)exportation trickery\nmodule M where\n\nimport Mod117_B\n\nf = m1 undefined\ng = m2 undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- re-exporting m2 outside of T(..)\nmodule Mod117_A( T(T,m1), m2) where\n\ndata T = T { m1 :: Int, m2 :: Int}\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- re-export all of T\nmodule Mod117_B (T(..)) where\n\nimport Mod117_A ( T(T,m1),m2 )\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! more class method (re-)exportation trickery.\nmodule M where\n\nimport Mod118_B\n\ng = m2 (2::Int)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- re-exporting m2 outside of C(..)\nmodule Mod118_A( C(m1), m2) where\n\nclass C a where\n  m1 :: a -> Int\n  m2 :: a -> Bool\n\ninstance C Int where\n  m1 _ = 1\n  m2 _ = True\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- re-export all of C\nmodule Mod118_B (C(..)) where\n\nimport Mod118_A hiding (C(m1))\nimport Mod118_A (C)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! module re-exportation\nmodule M where\nimport Mod119_B(f)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod119_A(f) where\nf = id\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod119_B (module Mod119_A) where\nimport Mod119_A\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct class export\nmodule M(C(m1,m2,m3)) where\nclass C a where\n  m1 :: a\n  m2, m3 :: a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! (..) importation of partially exported types\n-- (test / bug report due to Ross Paterson.)\nmodule M where\nimport Mod120_A(T(..))\nf = Foo\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod120_A(T) where\n\ndata T = Foo\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! (..) importation of partially exported class\n-- (test / bug report due to Ross Paterson.)\nmodule M where\nimport Mod121_A(C(..))\nf = m2 (1::Int)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod121_A(C(m1)) where\n\nclass C a where\n  m1 :: a -> Int\n  m2 :: a -> Bool\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! exporting a method (but not its class)\nmodule M where\nimport Mod122_A\n\nf :: C a => a -> a\nf = m1 \n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod122_A (m1) where\n\nclass C a where m1 :: a -> a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! exporting a field name (but not its type)\nmodule M where\nimport Mod123_A\n\nf :: T -> Int\nf x = f1 x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod123_A (f1) where\n\ndata T = MkT { f1 :: Int }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding an entity T (where T is both a type and a dcon.)\nmodule M where\n\nimport Mod124_A hiding (T)\n\nx :: T\nx = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod124_A where\n\ndata T = T\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding an entity T (where T is both a type and a dcon.)\nmodule M where\n\nimport Mod125_A hiding (T)\n\n--x :: T\nx = T\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod125_A where\n\ndata T = T\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding an entity T (where T is both a class and a dcon.)\nmodule M where\n\nimport Mod126_A hiding (T)\n\n--x :: T\nx = T\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod126_A where\n\nclass T a where m1 :: a -> a\n\ndata T1 = T\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding an entity T (where T is both a class and a dcon.)\nmodule M where\n\nimport Mod127_A hiding (T)\n\nx :: T a => a -> a\nx = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod127_A where\n\nclass T a where m1 :: a -> a\n\ndata T1 = T\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Cumulative exportation\nmodule M where\nimport Mod128_A(T(..))\n\nf = Con\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- repeated exports of a type/class accumulate.\nmodule Mod128_A(T,T(Con)) where\n\ndata T = Con\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! hiding class members (but not class.)\nmodule M where\n\nimport Prelude hiding ( (<), (>))\n\nx :: Ord a => a -> a\nx = undefined\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Omitted member from export list\nmodule M(C(m1,m3)) where\nclass C a where\n  m1 :: a\n  m2, m3 :: a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding class members.\nmodule M where\n\nimport Prelude hiding ( (<), (>))\n\nx :: Int -> Int\nx = (<) 2\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! unqual name conflicts in export lists.  Should fail\nmodule C ( Mod131_A.f, g, module Mod131_B ) where\nimport Mod131_B(f)\nimport qualified Mod131_A(f)\ng = f \n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod131_A (f) where\n\nf x = x\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod131_B(f) where\n\nf = 'a'\n\n\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! dcon hiding (in the presence of identically named tycon.)\n-- (test contributed by Ross Paterson.)\nmodule M where\nimport Mod132_B\n\nfoo = Foo\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod132_A where\n\ndata Foo = Foo\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- exporting everything but the Foo dcon.\nmodule Mod132_B (module Mod132_A) where\n\nimport Mod132_A hiding (Foo)\nimport Mod132_A (Foo)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Control.Monad.Except re-exports Control.Monad.Fix.\n-- This test checks that the subordinate-name test\n-- for a class operation (when renaming the instance decl)\n-- works correctly.\n\nmodule ShouldCompile where\n\nimport Control.Monad\nimport Control.Monad.Except\n\ndata Foo a = Foo a\n\ninstance Functor Foo where\n  fmap = liftM\n\ninstance Applicative Foo where\n  pure = Foo\n  (<*>) = ap\n\ninstance Monad Foo where\n  return         = pure\n  (Foo a) >>= k  = k a\n\ninstance MonadFix Foo where\n         mfix = undefined\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that 'hiding' hides the qualified name too\n\nmodule Main where\nimport Prelude hiding (head)\n\nmain  = do print (Prelude.head [0..])\n           head\n\nhead = print \"head\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-exporting qualified import.\nmodule M (module Data.List) where \n\nimport Data.List as Data.Char\n\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-exporting qualified module.\nmodule M  where\n\nimport Prelude ()   -- Forces the import to come from Mod136_A\nimport Mod136_A\n\nx = zipWith5\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod136_A ( module Data.List ) where\n   -- Only things in scope unqualified (from the Prelude)\n   -- and qualified Data.List.x, will be exported\n\nimport qualified Data.List\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-exporting alias which maps to multiple mods.\nmodule M  where \n\nimport Mod137_A\n\nx = zipWith5\ny = isLatin1\n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod137_A (module Data.Char) where\n\nimport Data.Char\nimport Data.List as Data.Char\n\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-exporting alias which maps to multiple mods; some qualified.\nmodule M  where \n\nimport Mod138_A\n\nx = zipWith5\ny = isLatin1\n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod138_A (module Data.Char) where\n\nimport qualified Data.Char\nimport Data.List as Data.Char\n\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! re-exporting module alias, with hiding.\nmodule M where\n\nimport Mod139_B\n\nz = Bar\na = Mod139_B.x\n\ny = m1 (2::Int)\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod139_A where\n\ndata Foo = Bar\n\nclass C a where\n  m1 :: a -> Int\n  \ninstance C Int where\n  m1 _ = 2\n\nx = 'x'\n\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod139_B ( module A ) where\n\nimport Mod139_A as A hiding (C,Foo)\n\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate member in export list\nmodule M(C(m1,m2,m2,m3)) where\nclass C a where\n  m1 :: a\n  m2, m3 :: a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding tycon _only_.\nmodule M where\n\nimport Mod140_A\n\na = Bar\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod140_A where\n\ndata Foo = Bar\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! re-exportation to override select entities.\nmodule M where\n\nimport Mod141_A\n\na :: String\na = partition\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod141_A (partition, module Data.List) where\n\nimport Data.List hiding (partition)\n\npartition :: String\npartition = \"partition\"\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Conflicting re-exportation of var\nmodule M (module M, module Mod142_A) where\n\nimport Mod142_A\n\nx = 'x'\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod142_A where\n\nx = 'y'\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Conflicting re-exportation of tycon\nmodule M (module M, module Mod143_A) where\n\nimport Mod143_A\n\ndata Foo = Baz\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod143_A where\n\ndata Foo = Bar\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Conflicting re-exportation of dcon\nmodule M (module Mod144_A,module M) where\n\nimport Mod144_A\n\ndata Foo1 = Bar\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod144_A where\n\ndata Foo = Bar\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Conflicting re-exportation of class methods\nmodule Mod145(module Mod145, module Mod145_A) where\n\nimport Mod145_A\n\nclass C1 a where\n  m1 :: a -> Int\n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod145_A where\n\nclass C2 a where\n  m1 :: (a,a) -> Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Conflicting re-exportation of class methods\nmodule Mod146(module Mod146, module Mod145_A) where\n\nimport Mod145_A\n\nclass C1 a where\n  m1 :: a -> Int\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! exporting tycon (but not dcon with same name.)\nmodule M where\n\nimport Mod147_A\n\nx = D 4\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod147_A(D) where\n\ndata D = D Int\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! re-exportation and ambiguity\n-- should not fail as the absence of an export\n-- list spec means \"export all entities defined,\n-- but none imported\".\nmodule M where id x = [];\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! re-exportation and ambiguity again.\n-- Exporting M (=> id) is not ambiguous, as\n-- Prelude isn't also exported.\nmodule M (module M) where id x = x;\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct class export\nmodule M(C(..)) where\nclass C a where\n  m1 :: a\n  m2, m3 :: a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ambiguous re-exportation.\nmodule M (module M,module Prelude) where id x = x;\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ambiguous re-exportation.\nmodule M (module M,id) where id x = x;\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ambiguous re-exportation.\nmodule M (module Prelude,id) where id x = x;\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ambiguous re-exportation.\nmodule M (id) where id x = x;\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Default export list isn't the same as (module M)\n-- This should succeed, exporting only the local 'sort',\n-- and not being confused by the 'sort' from 'List'.\n-- (Hugs gets this wrong)\n\nmodule M where \n\nimport Data.List as M\nsort = \"foo\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! ambiguous re-exportation.\nmodule M(module M) where \n\nimport Prelude as M\nid x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! non-ambiguous re-exportation.\nmodule M (module Prelude) where id x = x;\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cumulative re-exportation of data constructors\nmodule M where\n\nimport Mod157_D\n\n-- Mod157_D re-exports the type T using (..). T is defined\n-- in Mod157_A, but (only) two of its constructors are visible\n-- in Mod157_D, one via Mod157_B, the other via Mod157_C.\na = A\nb = B\n\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod157_A (T(..)) where\n\ndata T = A | B | C\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod157_B (T(..)) where\n\nimport Mod157_A(T(A))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod157_C(T(..)) where\n\nimport Mod157_A(T(B))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod157_D(T(..)) where\n\nimport Mod157_B(T(..))\nimport Mod157_C(T(..))\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cumulative re-exportation of data constructors, pt 2.\nmodule M where\n\nimport Mod157_D\n\n-- Mod157_D re-exports the type T using (..). T is defined\n-- in Mod157_A, but (only) two of its constructors is visible\n-- in Mod157_D, one via Mod157_B, the other via Mod157_C.\na = A\nb = B\n-- C is out of scope.\nc = C\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cumulative re-exportation of class methods\nmodule M where\n\nimport Mod159_D\n\n-- Mod159_D re-exports the class C using (..). C is defined\n-- in Mod159_A, but (only) two of its methods are visible\n-- in Mod159_D, one via Mod159_B, the other via Mod159_C.\na = m1 'a'\nb = m2 'b'\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod159_A (C(..)) where\n\nclass C a where\n  m1 :: a -> Int\n  m2 :: a -> Int\n  m3 :: a -> Int\n\ninstance C Char where\n  m1 _ = 1\n  m2 _ = 2\n  m3 _ = 3\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod159_B (C(..)) where\n\nimport Mod159_A(C(m1))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod159_C(C(..)) where\n\nimport Mod159_A(C(m2))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod159_D(C(..)) where\n\nimport Mod159_B(C(..))\nimport Mod159_C(C(..))\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct abstract class export\nmodule M(C) where\nclass C a where\n  m1 :: a\n  m2, m3 :: a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cumulative re-exportation of class methods, pt 2.\nmodule M where\n\nimport Mod159_D\n\n-- Mod159_D re-exports the class C using (..). C is defined\n-- in Mod159_A, but (only) two of its methods are visible\n-- in Mod159_D, one via Mod159_B, the other via Mod159_C.\na = m1 'a'\nb = m2 'b'\n-- m3 isn't in scope\nc = m3 'c'\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing export of unknown name\nmodule Bar(bar) where\nfoo = foo", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding a type (but not dcon of same name)\nmodule M where\n\nimport Mod162_A hiding (T())\n\nx = T\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod162_A where\n\ndata T = T\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! lazy name conflict reporting for field labels/selectors.\nmodule M where\n\nimport Mod163_A\n\ndata T = MkT { f :: Int }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod163_A where\n\ndata C = MkC { f :: Char }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! lazy name conflict reporting for data constructors\nmodule M where\n\nimport Mod164_A\nimport Mod164_B\n\nf x = \n  case x of\n    D1 -> 'a'\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod164_A where\n\ndata T = D1 | D2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod164_B where\n\ndata S = D1 | D3\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! lazy name conflict reporting for data constructors (pt.2)\nmodule M where\n\nimport Mod164_A as A\nimport Mod164_B as A\n\nf x = \n  case x of\n    A.D1 -> 'a'\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! lazy name conflict reporting for data constructors (pt.3)\nmodule M where\n\nimport Mod164_A as A\nimport Mod164_B\n\nf x = \n  case x of\n    A.D1 -> 'a'\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! qualified + hiding type constructors (or classes)\nmodule M where\n\nimport qualified Mod164_A hiding (T)\n\ndata T = D1 | D3\n\nf = D1\ng = Mod164_A.D1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! hiding Prelude method names\n-- (based on bug report by Iavor Diatchi:\n--   http://haskell.org/pipermail/hugs-bugs/2003-October/001369.html\n-- )\nmodule M where\n\nimport Prelude hiding ( negate, enumFrom,\n                        enumFromThen, enumFromTo,\n                        enumFromThenTo )\nimport Data.Ix hiding ( rangeSize )\nnegate = undefined\nenumFrom = undefined\nenumFromThen = undefined\nenumFromTo = undefined\nenumFromThenTo = undefined\nrangeSize = undefined\n\nx = [negate,enumFrom, enumFromThen, enumFromTo, enumFromThenTo, rangeSize]\n\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Non-clashing local binding and occurrence.\nmodule M where\n\nm :: Int\nm = let length _ = 5 in length []\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing non-member function in explicit class export list\nmodule M(C(m1,m2,m3,Left)) where\nclass C a where\n  m1 :: a\n  m2, m3 :: a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Lone import of field label\n-- (contributed/reported by Ross Paterson.)\nmodule M where\n\nimport Mod170_A(field)\n\nx = field\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod170_A (Type(..)) where\n\ndata Type = Constr { field :: Int }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Test import-unused warnings on 'module M' exports\n-- This one should not generate any warnings\n\nmodule M (module Mod171_A, h) where\n\nimport Mod171_A -- This isn't unused...\nimport Mod171_B -- even though this imports all the same stuff\n\nh :: Int -> Int\nh = g\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod171_A where\n\nf :: Int -> Int\nf x = x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod171_B (g, module Mod171_A) where\nimport Mod171_A\n\ng :: Int -> Int\ng = f\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Hugs failed this test Jan06\n\nmodule Mod172 where\n\nimport Mod172_B (f,g)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod172_B( module Mod172_C ) where\n\nimport Mod172_C\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod172_C( f,g ) where\n\nclass A a where f :: a\ndata R = R { g :: Int }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nimport Mod173_Aux\n\nt1 = partition  -- From the import\n\nnub = True\nt2 = nub        -- Unambiguous; nub should not have been exported\n\nt3 = frob\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod173_Aux( module Mod173_Aux ) where\n\nimport qualified Data.List as Mod173_Aux( nub )\n        -- This should not be exported\n\nimport Data.List as Mod173_Aux( partition )\n        -- This one should be exported\n\nfrob x = Mod173_Aux.nub (x::[Int])      -- This one should\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nimport Prelude ()\nimport Control.Monad( Monad(return), unless )\n  -- Should report Monad and return as unused imports\nimport GHC.Base\n  -- But not their import from here\n\nx = True\ny x = unless\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nimport Prelude ()\nimport Data.Maybe( Maybe(..) )\nimport Data.Maybe\n\nf x = Just x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Mod178_2\n\nmain :: IO ()\nmain = print foo\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmmmodule Foo where\n\nfoo = 'c'\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main(main) where\nimport qualified Mod179_A hiding ()\nmain = print Mod179_A.x\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Mod179_A where\n\nx = True\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing duplicate type synonyms\ntype T = Int\ntype T = Float\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nimport qualified Mod180_B as Mod180_A\nimport Mod180_B (T)\nimport Mod180_A (x)\n\nz :: T\nz = x\n  -- fiendishly, this error message must mention Mod180_A.T (the type\n  -- of x), but in the current scope, Mod180_A.T means something different:\n  -- due to the 'import .. as' above, Mod180_A.T actually refers to Mod180_B.T.\n  -- GHC should notice this and use a fully qualified name \"main:Mod180_A.T\"\n  -- in the error message.\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod180_A where\n\ndata T = T\nx = T\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod180_B where\n\ndata T = U\nx = U\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing duplicate classes\nclass C a where m :: a\nclass C a where m :: a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Qualified import of unknown module\nmodule M where\nimport qualified N\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing duplicate members\nclass C1 a where m :: a\nclass C2 a where m :: a", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing duplicate type constructors\ndata T = K1\ndata T = K2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing duplicate data constructors\ndata T1 = K\ndata T2 = K\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n-- !!! Testing duplicate type variables\ntype T a a = Either a a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n-- !!! Testing duplicate type variables\ndata T a a = K a a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n-- !!! Testing bogus (or existential) type variables\ndata T a = K a b\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n-- !!! Testing bogus (or existential) type variables\ntype T a = Either a b\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n-- !!! Testing recursive type synonyms\ntype T1 = (Int,T2)\ntype T2 = (Int,T1)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing for out of scope Prelude types.\n-- was: Imported tycon clashes with local definition\n--      (but that's OK, as long as the type isn't _used_.)\nmodule M where\nimport Prelude(Int)\ntype Int = Char\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Exporting \"constructor\" of a type synonym\nmodule M(T(K1)) where\ntype T = T'\ndata T' = K1", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Imported class clashes with local class definition\nmodule M where\nimport Prelude(Eq,Bool)\nclass Eq a where (==) :: a -> a -> Bool\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Defining local type with same name as imported class\n-- was: Imported class clashes with local type definition\nmodule M where\nimport Prelude(Eq,Bool)\ntype Eq = Bool\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Defining local class with same name as imported type.\n-- was: Imported tycon clashes with local class definition\nmodule M where\nimport Prelude(Int,Bool)\nclass Int a where (==) :: a -> a -> Bool\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Redefining an imported name\n-- was: Imported var clashes with local var definition\nmodule M where\nimport Prelude(id)\nid x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Defining local value with same name as imported class member.\n-- was: Imported member fun clashes with local var definition\nmodule M where\nimport Data.Ix(Ix(..))\nindex x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Redefining imported data constructors\n-- was: Imported constructor clashes with local constructor\nmodule M where\nimport Prelude(Bool(True,False)) \ndata T = True\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Hiding lists \"intersect\" part 1\nmodule M where\nimport Prelude hiding (const,id) \nimport Prelude hiding (const) \nx = const\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Hiding lists \"intersect\" part 2\nmodule M where\nimport Prelude hiding (const,id) \nimport Prelude hiding (const) \nx = id\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Class decl clashes with type decl\nmodule M where\ntype C = Int\nclass C a where f :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Class variable constraints on member funs\nmodule M where\nclass C a where f :: Eq a => a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Exporting unknown constructor\nmodule M(T(K1,K2)) where\ndata T = K1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Cyclic class hierarchy\nmodule M where\nclass C2 a => C1 a where f :: a\nclass C1 a => C2 a where g :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Repeated variable in instance predicate\nmodule M where\ninstance Eq a => Eq (Either a a)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Not \"simple type\" in instance\nmodule M where\ninstance Eq a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Type synonym in instance\nmodule M where\ninstance Eq String\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Repeated instance decl\nmodule M where\ndata T = T Int\ninstance Eq T\ninstance Eq T\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Type sigs in instance decl\nmodule M where\ndata T = T Int\ninstance Eq T where\n  (==) :: T -> T -> Bool\n  T x == T y = x == y\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Instances of superclasses exist\nmodule M where\ndata T = T Int\ninstance Ord T\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Instance context can't satisfy class-hierarchy constraint\nmodule M where\nclass Foo a\nclass Foo a => Bar a\ninstance Num a => Foo [a]\ninstance (Eq a, Enum a) => Bar [a]\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Class decl can't use pattern bindings\nmodule M where\nclass C a where\n  x,y :: a\n  (x,y) = error \"foo\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Default decl for non-method\nmodule M where\nclass C a where\n  x :: a\n  y = error \"foo\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate export of constructor\nmodule M(T(K1,K1)) where\ndata T = K1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Default decl for non-method\nmodule M where\ndata T = C deriving (Foo)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate derived instance\nmodule M where\ndata T = C deriving (Eq,Eq)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate derived instance\nmodule M where\ndata T = C deriving (Eq)\ninstance Eq T\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate derived instance\nmodule M where\nclass C a\ndata T = K deriving (C)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate derived instance\nmodule M where\ndata T = K deriving (Ord)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Illegal deriving Enum \nmodule M where\ndata T = K Int deriving (Enum)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Illegal deriving Ix\nmodule M where\nimport Data.Ix(Ix)\ndata T = K1 Int | K2 deriving (Eq,Ord,Ix)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Multiple (identical) default decls\nmodule M where\ndefault (Int,Integer)\ndefault (Int,Integer)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Malformed pattern (unknown constructor)\nmodule M where\nf K = error \"foo\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Omitted constructor from export list\nmodule M(T(K1)) where\ndata T = K1|K2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Malformed pattern (arity)\nmodule M where\nf (Left) = error \"foo\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Malformed infix expression\nmodule M where\nf a b c = a==b==c\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Malformed binding (qualified)\nmodule M where\nx = let M.y = 'a' in M.y\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Bindings of different arities\nmodule M where\nf 0 = id\nf x y = x+y\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Pattern binding must bind (not an error in standard Haskell)\nmodule M where\nx = let ['a'] = \"a\" in 'a'\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Malformed lhs (pointless but legal in Haskell 1.3, rejected by Hugs)\nmodule M where\nx = let [] = \"a\" in 'a'\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Multiple value bindings\nmodule M where\nf x = 'a'\ng x = 'b'\nf x = 'c'", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Type decl but no body\nmodule M where\nf :: Int -> Bool", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Multiple type decls\nmodule M where\nf :: Int -> Bool\nf :: Int -> Bool\nf = even", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Illegal @ in expression\nmodule M where\nf x = x@1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Exporting non-existent type/class\nmodule M(T) where\nx = 'a' -- dummy definition to get round a separate bug\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Illegal ~ in expression\nmodule M where\nf x = x~1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-typed-holes #-}\n-- !!! Illegal _ in expression\nmodule M where\nf x = x _ 1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Undefined variable in expression\nmodule M where\nf x = g x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Undefined qualified variable in expression\nmodule M where\nf x = Prelude.g x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Undefined qualifier in expression\nmodule M where\nf x = N.g x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Qualifying with local module name\nmodule M where\nf x = M.f x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Multiple modules per file\nmodule M where\nfoo = 'a'\n\nmodule N where\nbar = 'b'\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Naked fixity declaration\nmodule M where\ninfix $$$\nx = 'a'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing unknown class/tycon\nmodule M where\nimport Prelude(C)\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Exporting non-existent module\nmodule M(module N) where\nx = 'a' -- dummy definition to get round a separate bug\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing unknown name\nmodule M where\nimport Prelude(f)\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing Tycon with bogus constructor\nmodule M where\nimport Prelude(Either(Left,Right,Foo))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing Tycon with missing constructor\nmodule M where\nimport Prelude(Either(Left))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing Tycon with duplicate constructor\nmodule M where\nimport Prelude(Either(Left,Right,Right))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct tycon import (explicit constructor list)\nmodule M where\nimport Prelude(Either(Left,Right))\nx = (Left 'a', Right 'a')\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct tycon import (implicit constructor list)\nmodule M where\nimport Prelude(Either(..))\nx = (Left 'a', Right 'a')\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct abstract tycon import\nmodule M where\nimport Prelude(Either)\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Trying to use constructors of abstractly imported type.\nmodule M where\nimport Prelude(Either)\nx = Left 'a'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Honouring qualified imports lists\n-- was: Known bug: Qualified import ignores import list\nmodule M where\nimport qualified Prelude (map)\nx = Prelude.Left 'a'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n\n-- !!! Sublist for non-class/tycon\nmodule M where\nimport Prelude(map(..))\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Exporting non-existent type transparently\nmodule M(T(..)) where\nx = 'a' -- dummy definition to get round a separate bug\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Sublist for non-class/tycon\nmodule M where\nimport Prelude(Left(..))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing Class with bogus member\nmodule M where\nimport Prelude(Eq((==),(/=),eq))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing Class with missing member\nmodule M where\nimport Prelude(Eq((==)))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Importing Class with duplicate member\nmodule M where\nimport Prelude(Eq((==),(/=),(==)))\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct Class import (explicit member list)\nmodule M where\nimport Prelude(Eq((==),(/=)))\nx = 'a' == 'b'\ny = 'a' /= 'b'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct Class import (explicit member list)\nmodule M where\nimport Prelude(Eq(..))\nx = 'a' == 'b'\ny = 'a' /= 'b'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Correct abstract class import\nmodule M where\nimport Prelude(Eq)\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Trying to use members of abstractly imported class\nmodule M where\nimport Prelude(Eq)\nx = 'a' == 'b'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Type signature for qualified name\nmodule M where\nM.x :: Char\nx = 'a'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Empty export list\nmodule M(,) where\n\nx = 2\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Foo ( A(x, x) ) where\n\ndata A = A  Int\n\npattern Pattern{x} = A x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10233 where\nimport T10233a( Constraint, Int )\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10233a ( module GHC.Exts ) where\nimport GHC.Exts ( Constraint, Int )\n\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-imports #-}\nmodule Test where\n\nimport qualified Control.Monad (ap)\n-- Test that GHC warns about the following unused import:\nimport qualified Control.Monad.Reader\n\nfoo :: IO ()\nfoo = return id `Control.Monad.ap` return ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-imports #-}\n\nmodule Test where\n\nimport qualified System.FilePath as FilePath.Native\n         ( joinPath )\nimport qualified System.FilePath.Posix as FilePath.Posix\n         ( joinPath, splitDirectories )\nimport qualified System.FilePath.Windows as FilePath.Windows\n         ( joinPath )\n\ndata TarPath = TarPath FilePath -- path name, 100 characters max.\n                       FilePath -- path prefix, 155 characters max.\n\nfromTarPath, fromTarPathToPosixPath\n           , fromTarPathToWindowsPath :: TarPath -> FilePath\n\nfromTarPath (TarPath name prefix) =\n  FilePath.Native.joinPath $ FilePath.Posix.splitDirectories prefix\n                          ++ FilePath.Posix.splitDirectories name\n\nfromTarPathToPosixPath (TarPath name prefix) =\n  FilePath.Posix.joinPath $ FilePath.Posix.splitDirectories prefix\n                         ++ FilePath.Posix.splitDirectories name\n\nfromTarPathToWindowsPath (TarPath name prefix) =\n  FilePath.Windows.joinPath $ FilePath.Posix.splitDirectories prefix\n                           ++ FilePath.Posix.splitDirectories name\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nWe expect to get a suggestion to add 'type' keyword\nand enable TypeOperators extension.\n-}\n\n{-# LANGUAGE TypeOperators #-}\nmodule T11432 ((-.->)(..)) where\n\nnewtype (f -.-> g) a = Fn { apFn :: f a -> g a }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nWe expect to get a suggestion to add 'type' keyword\nand enable TypeOperators extension.\n-}\n\n{-# LANGUAGE TypeOperators #-}\nmodule T11432a ((-.->)()) where\n\nnewtype (f -.-> g) a = Fn { apFn :: f a -> g a }\n\n(-.->) = id\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XFlexibleContexts -fwarn-unused-imports #-}\n\nmodule ArrayBoundedU\n   ( T\n   , create\n   , at\n   ) where\n\nimport Data.Ix\nimport qualified Data.Array.Unboxed as Array\nimport Data.Array.Base (unsafeAt)\n\nnewtype T i e = T (Array.UArray i e)\n\ncreate :: (Ix i, Bounded i, Array.IArray Array.UArray e) => [(i,e)] -> T i e\ncreate ies = T (Array.array (minBound, maxBound) ies)\n\nat :: (Ix i, Bounded i, Array.IArray Array.UArray e) => T i e -> i -> e\nat (T a) i = unsafeAt a (index (minBound, maxBound) i)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PatternSynonyms #-}\n\nmodule T11970(B(recSel), Foo((--.->)), C(C,P,x,Q, B, recSel)) where\n\npattern D = Nothing\n\nnewtype B = B { recSel :: Int }\n\nclass Foo a where\n  type (--.->) a\n\nnewtype C = C Int\n\npattern P x = C x\n\npattern Q{x} = C x\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11970A ( Fail(a) ) where\n\nimport T11970A1 ( Fail(a, b) )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11970A1 where\n\ndata Fail = Fail { a :: Int, b :: Int }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11970B ( A(f) ) where\n\ndata A = A\n\nf = A\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12026 where\n\nimport Prelude (map ())\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule T13528 (\n  GHC.Exts.IsList(\n      Item\n      , fromList\n      , toList\n      )\n  , Data.Bool.Bool(True, False)\n) where\n\nimport qualified GHC.Exts (IsList(..))\nimport qualified Data.Bool (Bool(..))\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug (Bits(Bits)) where\n\nimport qualified Data.Bits as Bits\n\nnewtype Bits = Bits Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "program = return ()\n\n-- meant to be compiled with 'ghc -main-is Main.program T13704.hs'\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = return ()\n\n-- wrapped by T13704b2.hs\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13704b2 where\nimport Main (main)\n\nprogram :: IO ()\nprogram = main\n\n-- meant to be compiled with '-main-is T13704b2.program'\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-imports -Werror #-}\n\nmodule T2267 where\n\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.UTF8 as BU\n\ntoString :: B.ByteString -> String\ntoString = BU.toString\n\nfromString :: String -> B.ByteString\nfromString = BU.fromString\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-imports -fno-warn-missing-methods #-}\n\n-- Check that although 'index' is apparently only used\n-- unqualified, we nevertheless do not get a redundant-import warning\n--   Trac #3776\n\nmodule T3776 where\n\nimport qualified Data.Ix( Ix(index) )\n\ninstance Data.Ix.Ix Float where\n  index = error \"urk\"\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- should fail, Main must *export* main (#414)\nmodule Main () where\nmain = return ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nmain = return ()\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (module Main) where\nmain = return ()\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-imports #-}\nmodule T9061 where\n\nimport Prelude hiding (log)\n\nf = log where log = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PackageImports #-}\nmodule Control.DeepSeq where\n\nimport \"deepseq\" Control.DeepSeq\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule GHC.Base (module GHC.Base, Bool(..)) where\n\nimport GHC.Prim\nimport GHC.Types\n\ndefault ()\n\nclass Eq a where\n    (==), (/=) :: a -> a -> Bool\n\n    x /= y = not (x == y)\n    x == y = not (x /= y)\n\ninstance Eq Bool where\n    False == False = True\n    True == True = True\n    _ == _ = False\n\nnot :: Bool -> Bool\nnot True  = False\nnot False = True\n\ninline x = x\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule GHC.Foo where\n\nimport GHC.Base\n\nfoo = True == True\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Test where\n\nimport Test2 hiding (main)\n\nmain = doit\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Test2 where\n\ndoit = putStrLn \"You have run Test2.doit\"\nmain = putStrLn \"You have run Test2.main\"\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n-- Break properly if MonadFail is live\n\n{-# LANGUAGE MonadFailDesugaring #-}\n\nmodule MonadFailWarnings where\n\nimport Control.Monad.Fail\nimport Control.Monad.ST\nimport Data.Functor.Identity\n\n\n\ngeneral :: Monad m => m a\ngeneral = do\n    Just x <- undefined\n    undefined\n\n\n\ngeneral' :: MonadFail m => m a\ngeneral' = do\n    Just x <- undefined\n    undefined\n\n\n\nidentity :: Identity a\nidentity = do\n    Just x <- undefined\n    undefined\n\n\n\nio :: IO a\nio = do\n    Just x <- undefined\n    undefined\n\n\n\nst :: ST s a\nst = do\n    Just x <- undefined\n    undefined\n\n\n\nreader :: r -> a\nreader = do\n    Just x <- undefined\n    undefined\n\n\n\nnewtype Newtype a = Newtype a\nnewtypeMatch :: Identity a\nnewtypeMatch = do\n    Newtype x <- undefined\n    undefined\n\n\n\ndata Data a = Data a\nsingleConMatch :: Identity a\nsingleConMatch = do\n    Data x <- undefined\n    undefined\n\n\n\ndata Maybe' a = Nothing' | Just' a\ninstance Functor Maybe' where fmap = undefined\ninstance Applicative Maybe' where pure = undefined; (<*>) = undefined\ninstance Monad Maybe' where (>>=) = undefined\ninstance MonadFail Maybe' where fail = undefined\ncustomFailable :: Maybe' a\ncustomFailable = do\n    Just x <- undefined\n    undefined\n\n\nwildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a\nwildcardx = do\n    x <- undefined\n    undefined\nexplicitlyIrrefutable = do\n    ~(x:y) <- undefined\n    undefined\nwildcard_ = do\n    _ <- undefined\n    undefined\ntuple = do\n    (a,b) <- undefined\n    undefined\n", "num_lines": 96}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n-- Ensure that MonadFail warnings are issued correctly if the warning flag\n-- is enabled\n{-# LANGUAGE NoMonadFailDesugaring #-}\n{-# OPTIONS_GHC -Wmissing-monadfail-instances -Wno-error=compat #-}\n\nmodule MonadFailWarnings where\n\nimport Control.Monad.Fail\nimport Control.Monad.ST\nimport Data.Functor.Identity\n\n\n\n-- should warn, because the do-block gets a general Monad constraint,\n-- but should have MonadFail\ngeneral :: Monad m => m a\ngeneral = do\n    Just x <- undefined\n    undefined\n\n\n\n-- should NOT warn, because the constraint is correct\ngeneral' :: MonadFail m => m a\ngeneral' = do\n    Just x <- undefined\n    undefined\n\n\n\n-- should warn, because Identity isn't MonadFail\nidentity :: Identity a\nidentity = do\n    Just x <- undefined\n    undefined\n\n\n\n-- should NOT warn, because IO is MonadFail\nio :: IO a\nio = do\n    Just x <- undefined\n    undefined\n\n\n\n-- should warn, because (ST s) is not MonadFail\nst :: ST s a\nst = do\n    Just x <- undefined\n    undefined\n\n\n\n-- should warn, because (r ->) is not MonadFail\nreader :: r -> a\nreader = do\n    Just x <- undefined\n    undefined\n\n\n\n-- should NOT warn, because matching against newtype\nnewtype Newtype a = Newtype a\nnewtypeMatch :: Identity a\nnewtypeMatch = do\n    Newtype x <- undefined\n    undefined\n\n\n\n-- should NOT warn, because Data has only one constructor\ndata Data a = Data a\nsingleConMatch :: Identity a\nsingleConMatch = do\n    Data x <- undefined\n    undefined\n\n\n\n-- should NOT warn, because Maybe' has a MonadFail instance\ndata Maybe' a = Nothing' | Just' a\ninstance Functor Maybe' where fmap = undefined\ninstance Applicative Maybe' where pure = undefined; (<*>) = undefined\ninstance Monad Maybe' where (>>=) = undefined\ninstance MonadFail Maybe' where fail = undefined\ncustomFailable :: Maybe' a\ncustomFailable = do\n    Just x <- undefined\n    undefined\n\n\n-- should NOT warn, because patterns always match\nwildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a\nwildcardx = do\n    x <- undefined\n    undefined\nexplicitlyIrrefutable = do\n    ~(x:y) <- undefined\n    undefined\nwildcard_ = do\n    _ <- undefined\n    undefined\ntuple = do\n    (a,b) <- undefined\n    undefined\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n-- Make sure that not enabling MonadFail warnings makes code compile just\n-- as it did in < 8.0\n\n-- NOTE: starting w/ GHC 8.6 sugaring is turned on by default; so we have\n--       to disable to keep supporting this test-case\n--\n{-# LANGUAGE NoMonadFailDesugaring #-}\n{-# OPTIONS -Wno-missing-monadfail-instances #-}\n\nmodule MonadFailWarnings where\n\nimport Control.Monad.Fail\nimport Control.Monad.ST\nimport Data.Functor.Identity\n\n\n\ngeneral :: Monad m => m a\ngeneral = do\n    Just x <- undefined\n    undefined\n\n\n\ngeneral' :: MonadFail m => m a\ngeneral' = do\n    Just x <- undefined\n    undefined\n\n\n\nidentity :: Identity a\nidentity = do\n    Just x <- undefined\n    undefined\n\n\n\nio :: IO a\nio = do\n    Just x <- undefined\n    undefined\n\n\n\nst :: ST s a\nst = do\n    Just x <- undefined\n    undefined\n\n\n\nreader :: r -> a\nreader = do\n    Just x <- undefined\n    undefined\n\n\n\nnewtype Newtype a = Newtype a\nnewtypeMatch :: Identity a\nnewtypeMatch = do\n    Newtype x <- undefined\n    undefined\n\n\n\ndata Data a = Data a\nsingleConMatch :: Identity a\nsingleConMatch = do\n    Data x <- undefined\n    undefined\n\n\n\ndata Maybe' a = Nothing' | Just' a\ninstance Functor Maybe' where fmap = undefined\ninstance Applicative Maybe' where pure = undefined; (<*>) = undefined\ninstance Monad Maybe' where (>>=) = undefined\ninstance MonadFail Maybe' where fail = undefined\ncustomFailable :: Maybe' a\ncustomFailable = do\n    Just x <- undefined\n    undefined\n\n\nwildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a\nwildcardx = do\n    x <- undefined\n    undefined\nexplicitlyIrrefutable = do\n    ~(x:y) <- undefined\n    undefined\nwildcard_ = do\n    _ <- undefined\n    undefined\ntuple = do\n    (a,b) <- undefined\n    undefined\n", "num_lines": 101}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n-- RebindableSyntax does not play that well with MonadFail, so here we ensure\n-- that when both settings are enabled we get the proper warning.\n\n{-# OPTIONS_GHC -Wmissing-monadfail-instances -Wno-error=compat #-}\n{-# LANGUAGE RebindableSyntax #-}\n\nmodule MonadFailWarningsWithRebindableSyntax where\n\nimport Prelude\n\ntest1 f g = do\n    Just x <- f\n    g\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10929 where\n\nx1 :: [Integer]\nx1 = [5 .. 3]\n\nx2 :: [Integer]\nx2 = [3 .. 5]\n\nx3 :: [Integer]\nx3 = [5, 3 .. 1]\n\nx4 :: [Integer]\nx4 = [5, (3+0) .. 1]\n\nx5 :: [Integer]\nx5 = [1, 3 .. 5]\n\nx6 :: [Integer]\nx6 = [1, (3+0) .. 5]\n\nx7 :: [Integer]\nx7 = [5, 7 .. 1]\n\nx8 :: [Integer]\nx8 = [5, (7+0) .. 1]\n\nx9 :: [Integer]\nx9 = [3, 1 .. 5]\n\nx10 :: [Integer]\nx10 = [3, (1+0) .. 5]\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications      #-}\n{-# LANGUAGE TypeInType            #-}\n\nmodule NatVal where\n\nimport Data.Proxy\nimport GHC.TypeLits\n\n-- test that Nat type literals are statically converted into Integer literals\n\nfoo :: Integer\nfoo = natVal $ Proxy @0\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications      #-}\n{-# LANGUAGE TypeInType            #-}\n\nmodule M where\n\nimport Numeric.Natural\nimport GHC.Natural\n\n-- test Natural literals\none :: Natural\none = fromInteger 1\n\nplusOne :: Natural -> Natural\nplusOne n = n + 1\n\n-- a built-in rule should convert this unfolding into a Natural literal in Core\nten :: Natural\nten = wordToNatural 10\n\n-- test basic constant folding for Natural\ntwoTimesTwo :: Natural\ntwoTimesTwo = 2 * 2\n\n-- test the overflow warning\nminusOne :: Natural\nminusOne = -1\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7116 where\n\n-- this module tests strength reduction, i.e. turning floating\n-- point multiplication by two into addition:\n--\n-- 2.0 * x -> x + x\n\ndl :: Double -> Double\ndl x = 2.0 * x\n\ndr :: Double -> Double\ndr x = x * 2.0\n\nfl :: Float -> Float\nfl x = 2.0 * x\n\nfr :: Float -> Float\nfr x = x * 2.0\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T7881 where\n\nimport Data.Int\n\nx1 :: [Int8]\nx1 = [5 .. 3]\n\nx2 :: [Int8]\nx2 = [3 .. 5]\n\nx3 :: [Int8]\nx3 = [5, 3 .. 1]\n\nx4 :: [Int8]\nx4 = [5, (3+0) .. 1]\n\nx5 :: [Int8]\nx5 = [1, 3 .. 5]\n\nx6 :: [Int8]\nx6 = [1, (3+0) .. 5]\n\nx7 :: [Int8]\nx7 = [5, 7 .. 1]\n\nx8 :: [Int8]\nx8 = [5, (7+0) .. 1]\n\nx9 :: [Int8]\nx9 = [3, 1 .. 5]\n\nx10 :: [Int8]\nx10 = [3, (1+0) .. 5]\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NegativeLiterals #-}\n\nmodule T7895 where\n\nimport Data.Int\nimport Data.Word\n\nv1 :: Word8\nv1 = 300\n\nv2 :: Int8\nv2 = -129\n\nv3 :: Int8\nv3 = -128\n\nv4 :: Int8\nv4 = -127\n\nv5 :: Int8\nv5 = -5\n\nv6 :: Int8\nv6 = 127\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8542 where\n\nimport GHC.Int\n\nx :: Int8\nx = -128\n\ny :: Int8\ny = 128\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Prim\nimport GHC.Word\nimport Data.Bits\n\nmain :: IO ()\nmain = do f 5 6\n          f maxBound 23\n          f maxBound maxBound\n\nf :: Word -> Word -> IO ()\nf wx@(W# x) wy@(W# y)\n    = do putStrLn \"-----\"\n         putStrLn (\"Doing \" ++ show wx ++ \" + \" ++ show wy)\n         case x `plusWord2#` y of\n             (# h, l #) ->\n                 do let wh = W# h\n                        wl = W# l\n                        r = shiftL (fromIntegral wh) (bitSize wh)\n                          + fromIntegral wl\n                    putStrLn (\"High: \" ++ show wh)\n                    putStrLn (\"Low: \" ++ show wl)\n                    putStrLn (\"Result: \" ++ show (r :: Integer))\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! conversions: Double <=> Rational/Integer things\n--\nimport Data.Ratio\n\nmain = putStr (show r42  ++ \"\\n\" ++\n               show nu42 ++ \", \" ++\n               show de42 ++ \"\\n\" ++\n               show nu42d ++ \", \" ++\n               show de42d ++ \"\\n\" ++\n               show s2 ++ \", \" ++\n               show e2 ++ \"\\n\" ++\n               show s ++ \", \" ++\n               show e ++ \"\\n\" )\n  where\n    d42 :: Double\n    r42 :: Rational\n    nu42, de42 :: Integer\n    nu42d, de42d :: Double\n\n    d42  = 42\n    r42  = toRational d42\n    nu42 = numerator   r42\n    de42 = denominator r42\n    nu42d= fromInteger nu42\n    de42d= fromInteger de42\n\n    (s,e)= decodeFloat (nu42d / de42d )\n    (s2,e2) = decodeFloat d42\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! basic Rational operations\n--\nimport Data.Ratio\n\nmain\n  = putStr\n       (-- Ratio Ints\n        show [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc]\n    ++  \"\\n\"\n        -- the Ints\n    ++  show ((map numerator   [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc])\n            ++(map denominator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc]))\n    ++  \"\\n\"\n        -- Booleans\n--  ++  show []\n--  ++  \"\\n\"\n\n        -- Rationals (Ratio Integers)\n    ++  show [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc]\n    ++  \"\\n\"\n        -- the Integers\n    ++  show ((map numerator   [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc])\n            ++(map denominator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc]))\n    ++  \"\\n\"\n        -- Booleans\n--  ++  show []\n--  ++  \"\\n\"\n        )\n  where\n    i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc :: Ratio Int\n\n    i0a     =    0 % 1\n    i0b     = (-0) % 1\n    i0c     =    0 % (-1)\n    i2a     =    4 % 2\n    i2b     = (-4) % (-2)\n    im2a    = (-4) % 2\n    im2b    =    4 % (-2)\n    i_pi    =   22 % 7\n    i_misc  =    2 % 10000\n\n    r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc :: Rational\n\n    r0a     =    0 % 1\n    r0b     = (-0) % 1\n    r0c     =    0 % (-1)\n    r2a     =    4 % 2\n    r2b     = (-4) % (-2)\n    rm2a    = (-4) % 2\n    rm2b    =    4 % (-2)\n    r_pi    =   22 % 7\n    r_misc  =    2 % 10000\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- $Id: arith003.hs,v 1.2 2002/01/25 13:40:39 simonmar Exp $\n--\n-- !!! test Int/Integer arithmetic operations from the Prelude.\n--\n\nmain\n  = putStr\n       (\n        showit (do_ops int_ops) ++\n        showit (do_ops integer_ops)\n        )\n\nshowit :: (Show a, Integral a) => [(String, a, a, a)] -> String\nshowit stuff = concat\n       [ str ++ \" \" ++ show l ++ \" \" ++ show r ++ \" = \" ++ show result ++ \"\\n\"\n         | (str, l, r, result) <- stuff\n       ]\n\ndo_ops :: Integral a => [((a -> a -> a), String, [(a,a)])]\n        -> [(String, a, a, a)]\ndo_ops ops = [ (str, l, r, l `op` r) | (op,str,args) <- ops, (l,r) <- args ]\n\nsmall_operands, non_min_operands, operands, non_max_operands\n   :: Integral a => [a]\nsmall_operands  = [ 0, 1, -1, 2, -2 ]\noperands = small_operands ++ [ fromIntegral minInt, fromIntegral maxInt ]\nnon_min_operands = small_operands ++ [ fromIntegral maxInt ]\nnon_max_operands = small_operands ++ [ fromIntegral minInt ]\n\nlarge_operands :: [ Integer ]\nlarge_operands = operands ++\n   [ fromIntegral minInt - 1,\n     fromIntegral maxInt + 1,\n     fromIntegral minInt * 2,\n     fromIntegral maxInt * 2,\n     fromIntegral minInt ^ 2,\n     fromIntegral maxInt ^ 2\n   ]\n\ninteger_ops :: [((Integer -> Integer -> Integer), String, [(Integer,Integer)])]\ninteger_ops = [\n  ((+),  \"(+)\",  both_large),\n  ((-),  \"(-)\",  both_large),\n  (div,  \"div\",  large_non_zero_r),\n  (mod,  \"mod\",  large_non_zero_r),\n  (quot, \"quot\", large_non_zero_r),\n  (rem,  \"rem\",  large_non_zero_r),\n  (gcd,  \"gcd\",  large_either_non_zero),\n  (lcm,  \"lcm\",  large_either_non_zero)\n  ]\n\nint_ops :: [((Int -> Int -> Int), String, [(Int,Int)])]\nint_ops = [\n  ((+),  \"(+)\",  both_small),\n  ((-),  \"(-)\",  both_small),\n  ((^),  \"(^)\",  small_non_neg_r),\n  (div,  \"div\",  non_min_l_or_zero_r),\n  (mod,  \"mod\",  non_min_l_or_zero_r),\n  (quot, \"quot\", non_min_l_or_zero_r),\n  (rem,  \"rem\",  non_min_l_or_zero_r),\n  (gcd,  \"gcd\",  non_min_either_non_zero),\n  (lcm,  \"lcm\",  non_max_r_either_non_zero)\n  ]\n\n-- NOTE: when abs(minInt) is undefined (it is in GHC, because\n-- abs(minInt) would be greater than maxInt), then gcd on Ints is also\n-- undefined when either operand is minInt.\n\nboth_small, non_zero_r, non_min_either_non_zero, non_min_l_or_zero_r,\n non_max_r_either_non_zero, small_non_neg_r\n  :: Integral a => [(a,a)]\n\nboth_small      = [ (l,r) | l <- operands, r <- operands ]\nboth_large      = [ (l,r) | l <- large_operands, r <- large_operands ]\nlarge_non_zero_r = [ (l,r) | l <- operands, r <- large_operands, r /= 0 ]\nnon_zero_r      = [ (l,r) | l <- operands, r <- operands, r /= 0 ]\nnon_min_either_non_zero = [ (l,r) | l <- non_min_operands, r <- non_min_operands, l /= 0 || r /= 0 ]\nlarge_either_non_zero = [ (l,r) | l <- operands, r <- operands, l /= 0 || r /= 0 ]\nsmall_non_neg_r = [ (l,r) | l <- operands, r <- small_operands, r >= 0 ]\nnon_min_l_or_zero_r = [ (l,r) | l <- non_min_operands, r <- operands, r /= 0 ]\nnon_max_r_either_non_zero = [ (l,r) | l <- operands, r <- non_max_operands, l /= 0 || r /= 0 ]\n\nminInt = minBound :: Int\nmaxInt = maxBound :: Int\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test quot/rem/div/mod functions on Ints and Integers\n--\nmain\n  = putStr\n       (-- w/ Ints and Integers\n        show (unzipWith div ints_list)\n        ++ \"\\n\"\n        ++ show (unzipWith div integers_list)\n        ++ \"\\n\"\n        ++ show (unzipWith rem ints_list)\n        ++ \"\\n\"\n        ++ show (unzipWith rem integers_list)\n        ++ \"\\n\"\n        ++ show (unzipWith quot ints_list)\n        ++ \"\\n\"\n        ++ show (unzipWith quot integers_list)\n        ++ \"\\n\"\n        ++ show (unzipWith mod ints_list)\n        ++ \"\\n\"\n        ++ show (unzipWith mod integers_list)\n        ++ \"\\n\"\n        ++ show (unzipWith law1 ints_list)\n        ++ \"\\n\"\n        ++ show (unzipWith law1 integers_list)\n        ++ \"\\n\"\n        ++ show (unzipWith law2 ints_list)\n        ++ \"\\n\"\n        ++ show (unzipWith law2 integers_list)\n        ++ \"\\n\"\n        )\n  where\n    ints_list :: [(Int, Int)]\n    integers_list :: [(Integer, Integer)]\n\n    ints_list = [\n        (0, 4),\n        (0, -8),\n        (7, 3),\n        (13, 4),\n        (13, -4),\n        (-13, 4),\n        (-13, -4),\n        (12345678, 10000),\n        (12345678, -10000),\n        (-12345678, 10000),\n        (-12345678, -10000),\n        (123456,10000),\n        (1234567,20000),\n        (12345678,-10000),\n        (123456789,10000),\n        (1234567890,-10000),\n        (-12345,10000),\n        (-123456789,-10000)\n        ]\n\n    integers_list = [\n        (0, 4),\n        (0, -8),\n        (7, 3),\n        (13, 4),\n        (13, -4),\n        (-13, 4),\n        (-13, -4),\n        (12345678, 10000),\n        (12345678, -10000),\n        (-12345678, 10000),\n        (-12345678, -10000),\n        (123456,10000),\n        (1234567,20000),\n        (12345678,-10000),\n        (123456789,10000),\n        (1234567890,-10000),\n        (-12345,10000),\n        (-123456789,-10000),\n        (12345678900,500000000),\n        (1234000000000000000000005678900,5001111111111111000000)\n        ]\n\nunzipWith :: (a -> b -> c) -> [(a,b)] -> [c]\nunzipWith f []         = []\nunzipWith f ((x,y):zs) = f x y : unzipWith f zs\n\nlaw1, law2 :: Integral a => a -> a -> Bool\n\nlaw1 x y = (x `quot` y)*y + (x `rem` y) == x\nlaw2 x y = (x `div`  y)*y + (x `mod` y) == x\n", "num_lines": 87}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test RealFrac ops (ceiling/floor/etc.) on Floats/Doubles\n--\nmain =\n putStr $\n  unlines\n    [  -- just for fun, we show the floats to\n       -- exercise the code responsible.\n      'A' : show (float_list :: [Float])\n    , 'B' : show (double_list :: [Double])\n       -- {Float,Double} inputs, {Int,Integer} outputs\n    , 'C' : show ((map ceiling small_float_list) :: [Int])\n    , 'D' : show ((map ceiling float_list) :: [Integer])\n    , 'E' : show ((map ceiling small_double_list) :: [Int])\n    , 'F' : show ((map ceiling double_list) :: [Integer])\n    , 'G' : show ((map floor small_float_list) :: [Int])\n    , 'H' : show ((map floor float_list) :: [Integer])\n    , 'I' : show ((map floor small_double_list) :: [Int])\n    , 'J' : show ((map floor double_list) :: [Integer])\n    , 'K' : show ((map truncate small_float_list) :: [Int])\n    , 'L' : show ((map truncate float_list) :: [Integer])\n    , 'M' : show ((map truncate small_double_list) :: [Int])\n    , 'N' : show ((map truncate double_list) :: [Integer])\n    , 'n' : show ((map round small_float_list) :: [Int])\n    , 'O' : show ((map round float_list) :: [Integer])\n    , 'P' : show ((map round small_double_list) :: [Int])\n    , 'Q' : show ((map round double_list) :: [Integer])\n    , 'R' : show ((map properFraction small_float_list) :: [(Int,Float)])\n    , 'S' : show ((map properFraction float_list) :: [(Integer,Float)])\n    , 'T' : show ((map properFraction small_double_list) :: [(Int,Double)])\n    , 'U' : show ((map properFraction double_list) :: [(Integer,Double)])\n    ]\n  where\n        -- these fit into an Int when truncated.  Truncation when the\n        -- result does not fit into the target is undefined - not explicitly\n        -- so in Haskell 98, but that's the interpretation we've taken in GHC.\n        -- See bug #1254\n    small_float_list :: [Float]\n    small_float_list = [\n        0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995,\n        -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25,\n        102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi\n      ]\n\n    float_list :: [Float]\n    float_list = small_float_list ++ [\n        1.18088e+11,    1.2111e+14\n      ]\n\n        -- these fit into an Int\n    small_double_list :: [Double]\n    small_double_list = [\n        0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995,\n        -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25,\n        102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi\n      ]\n\n    double_list :: [Double]\n    double_list = small_double_list ++ [\n        1.18088e+11,    1.2111e+14\n      ]\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! printing Floats; was a bug in hbc (reported by andy)\n--\n\nmain = print ((fromIntegral (42 :: Int)) :: Float)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test simple Integer things\n--\n\nf x y z = x y z\n\nmain = do\n  putStr (shows integer_list \"\\n\")\n where\n    int_list :: [Int]\n    integer_list :: [Integer]\n\n    int_list = (map fromInteger integer_list)\n\n    integer_list = (map (* 2)\n        [1,3,5,7,9,\n         11111111111111111111111111111,\n         2222222222222222222222222222222222222,\n         3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333,\n         -11111111111111111111111111111,\n         -2222222222222222222222222222222222222,\n         -3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333\n        ])\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! a random test from Nick North\n-- (got this in mid-1993; don't remember why.  WDP 95/02)\n--\n\nrandom_numbers :: (Int, Int, Int) -> [Float]\nrandom_numbers (s1,s2,s3)\n    =  map (snd . properFraction . combine) (iterate f (s1,s2,s3))\n       where\n       combine :: (Int,Int,Int) -> Float\n       combine (a,b,c)  =\n            fromIntegral(a)/30269 + fromIntegral(b)/30307\n            + fromIntegral(c)/30323\n       f (a,b,c)  =\n           ((171*a) `mod` 30269, (172*b) `mod` 30307, (170*c) `mod` 30323)\n\n-- partain: changed to cvt spaces into newlines (easier to see bugs)\n-- sof: define approp. version of showList to do this.\nmain = putStr (showL (showsPrec 0) (take 1000 (random_numbers (9807, 65, 32975))) \"\\n\")\n\nshowL showx []     = showString \"[]\"\nshowL showx (x:xs) = showChar '[' . showx x . showl xs\n  where\n    showl []     = showChar ']'\n    showl (x:xs) = showString \",\\n\" . showx x . showl xs\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- a prefix minus precedence test\n\nf :: Int -> Int -> Int -> Int\nf x y z = - x * y ^ z\n\nmain = putStr (shows (f 5 2 3) \"\\n\")\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--      Tests enumerations\n\nmain = do\n        print [1..10]\n        print [10..1]           -- []\n        print [1,3..10]\n        print [10,8..1]\n        print ['a'..'f']\n        print ['f'..'a']        -- []\n        print ['a','c'..'m']\n        print ['m','l'..'a']\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing Int and Word\nmodule Main(main) where\nimport Data.Int\nimport Data.Word\nimport Data.Bits\nimport Data.Ix -- added SOF\nimport Control.Exception\nimport Control.Monad\nimport Numeric.Natural\n\nmain :: IO ()\nmain = test\n\ntest :: IO ()\ntest = do\n   testIntlike \"Int\"    (0::Int)\n   testIntlike \"Int8\"   (0::Int8)\n   testIntlike \"Int16\"  (0::Int16)\n   testIntlike \"Int32\"  (0::Int32)\n   testIntlike \"Int64\"  (0::Int64)\n   testIntlike \"Word8\"  (0::Word8)\n   testIntlike \"Word16\" (0::Word16)\n   testIntlike \"Word32\" (0::Word32)\n   testIntlike \"Word64\" (0::Word64)\n   testInteger\n   testNatural\n\ntestIntlike :: (Bounded a, Integral a, Ix a, Show a, Read a, Bits a) => String -> a -> IO ()\ntestIntlike name zero = do\n  putStrLn $ \"--------------------------------\"\n  putStrLn $ \"--Testing \" ++ name\n  putStrLn $ \"--------------------------------\"\n  testBounded  zero\n  testEnum     zero\n  testReadShow zero\n  testEq       zero\n  testOrd      zero\n  testNum      zero\n  testReal     zero\n  testIntegral zero\n  testConversions zero\n  testBits     zero True\n\ntestInteger  = do\n  let zero = 0 :: Integer\n  putStrLn $ \"--------------------------------\"\n  putStrLn $ \"--Testing Integer\"\n  putStrLn $ \"--------------------------------\"\n  testEnum     zero\n  testReadShow zero\n  testEq       zero\n  testOrd      zero\n  testNum      zero\n  testReal     zero\n  testIntegral zero\n  testBits     zero False\n\ntestNatural  = do\n  let zero = 0 :: Natural\n  putStrLn $ \"--------------------------------\"\n  putStrLn $ \"--Testing Natural\"\n  putStrLn $ \"--------------------------------\"\n  testEnum     zero\n  testReadShow zero\n  testEq       zero\n  testOrd      zero\n  testNum      zero\n  testReal     zero\n  testIntegral zero\n  testBits     zero False\n\n-- In all these tests, zero is a dummy element used to get\n-- the overloading to work\n\ntestBounded zero = do\n  putStrLn \"testBounded\"\n  print $ (minBound-1, minBound, minBound+1) `asTypeOf` (zero,zero,zero)\n  print $ (maxBound-1, maxBound, maxBound+1) `asTypeOf` (zero,zero,zero)\n\ntestEnum zero = do\n  putStrLn \"testEnum\"\n  print $ take 10 [zero .. ]           -- enumFrom\n  print $ take 10 [zero, toEnum 2 .. ] -- enumFromThen\n  print [zero .. toEnum 20]            -- enumFromTo\n  print [zero, toEnum 2 .. toEnum 20]  -- enumFromThenTo\n\ntestConversions zero = do\n  putStrLn \"testConversions\"\n  putStr \"Integer : \" >> print (map fromIntegral numbers :: [Integer])\n  putStr \"Int     : \" >> print (map fromIntegral numbers :: [Int])\n  putStr \"Int8    : \" >> print (map fromIntegral numbers :: [Int8])\n  putStr \"Int16   : \" >> print (map fromIntegral numbers :: [Int16])\n  putStr \"Int32   : \" >> print (map fromIntegral numbers :: [Int32])\n  putStr \"Int64   : \" >> print (map fromIntegral numbers :: [Int64])\n  putStr \"Word8   : \" >> print (map fromIntegral numbers :: [Word8])\n  putStr \"Word16  : \" >> print (map fromIntegral numbers :: [Word16])\n  putStr \"Word32  : \" >> print (map fromIntegral numbers :: [Word32])\n  putStr \"Word64  : \" >> print (map fromIntegral numbers :: [Word64])\n  where numbers = [minBound, 0, maxBound] `asTypeOf` [zero]\n\nisNatural :: (Bits n) => n -> Bool\nisNatural zero = not (isSigned zero) && bitSizeMaybe zero == Nothing\n\nsamples :: (Bits a, Num a) => a -> [a]\nsamples zero\n  | isNatural zero = map fromInteger [0 .. 3]\n  | otherwise      = map fromInteger ([-3 .. -1]++[0 .. 3])\n\ntable1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO ()\ntable1 nm f xs = do\n  sequence [ f' x | x <- xs ]\n  putStrLn \"#\"\n where\n  f' x = putStrLn (nm ++ \" \" ++ show x ++ \" = \" ++ show (f x))\n\ntable2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO ()\ntable2 nm op xs ys = do\n  sequence [ sequence [ op' x y | y <- ys ] >> putStrLn \" \"\n           | x <- xs\n           ]\n  putStrLn \"#\"\n where\n  op' x y = do s <- Control.Exception.catch\n                        (evaluate (show (op x y)))\n                        (\\e -> return (show (e :: SomeException)))\n               putStrLn (show x ++ \" \" ++ nm ++ \" \" ++ show y ++ \" = \" ++ s)\n\ntestReadShow zero = do\n  putStrLn \"testReadShow\"\n  print xs\n  print (map read_show xs)\n where\n  xs = samples zero\n  read_show x = (read (show x) `asTypeOf` zero)\n\ntestEq zero = do\n  putStrLn \"testEq\"\n  table2 \"==\" (==) xs xs\n  table2 \"/=\" (/=) xs xs\n where\n  xs = samples zero\n\ntestOrd zero = do\n  putStrLn \"testOrd\"\n  table2 \"<=\"       (<=)    xs xs\n  table2 \"< \"       (<)     xs xs\n  table2 \"> \"       (>)     xs xs\n  table2 \">=\"       (>=)    xs xs\n  table2 \"`compare`\" compare xs xs\n where\n  xs = samples zero\n\ntestNum zero = do\n  putStrLn \"testNum\"\n  table2 \"+\"      (+)    xs xs\n  table2 \"-\"      (-)    xs xs\n  table2 \"*\"      (*)    xs xs\n  if (isNatural zero)\n  then table1 \"negate\" negate [0 `asTypeOf` zero]\n  else table1 \"negate\" negate xs\n where\n  xs = samples zero\n\ntestReal zero = do\n  putStrLn \"testReal\"\n  table1 \"toRational\" toRational xs\n where\n  xs = samples zero\n\ntestIntegral zero = do\n  putStrLn \"testIntegral\"\n  table2 \"`divMod` \" divMod  xs xs\n  table2 \"`div`    \" div     xs xs\n  table2 \"`mod`    \" mod     xs xs\n  table2 \"`quotRem`\" quotRem xs xs\n  table2 \"`quot`   \" quot    xs xs\n  table2 \"`rem`    \" rem     xs xs\n where\n  xs = samples zero\n\ntestBits zero do_bitsize = do\n  putStrLn \"testBits\"\n  table2 \".&.  \"            (.&.)         xs xs\n  table2 \".|.  \"            (.|.)         xs xs\n  table2 \"`xor`\"            xor           xs xs\n  unless (isNatural zero) $\n    table1 \"complement\"       complement    xs\n  table2 \"`shiftL`\"         shiftL        xs ([0..3] ++ [32,64])\n  table2 \"`shiftR`\"         shiftR        xs ([0..3] ++ [32,64])\n  table2 \"`rotate`\"         rotate        xs ([-3..3] ++ [-64,-32,32,64])\n  table1 \"bit\"              (\\ x -> (bit x) `asTypeOf` zero)   [(0::Int)..3]\n  table2 \"`setBit`\"         setBit        xs ([0..3] ++ [32,64])\n  table2 \"`clearBit`\"       clearBit      xs ([0..3] ++ [32,64])\n  table2 \"`complementBit`\"  complementBit xs ([0..3] ++ [32,64])\n  table2 \"`testBit`\"        testBit       xs ([0..3] ++ [32,64])\n  if do_bitsize then table1 \"bitSize\" bitSize xs else return ()\n  table1 \"isSigned\"         isSigned      xs\n where\n  xs = samples zero\n", "num_lines": 200}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing NumExts\nmodule Main(main) where\n\nimport Numeric\nimport Data.Char\n\nmain :: IO ()\nmain = tst\n\ntst :: IO ()\ntst = do\n  test_doubleToFloat\n  test_floatToDouble\n  test_showHex\n  test_showOct\n  test_showBin\n\n----\n-- Test data:\ndoubles :: [Double]\ndoubles = [ -1.2 , 0, 0.1, 0.5, 1.0, 1234.45454,\n           1.6053e4, 1.64022e12, 6.894e-4, 6.34543455634582173,\n           5342413403.40540423255]\nints :: [Int]\nints = [ 0, 1, 255, 65513, 6029, 1024, 256, 201357245]\n\nintegers :: [Integer]\nintegers = [ 0, 1, 255, 65513, 6029, 1024, 256,\n            2343243543500233, 656194962055457832]\n---\n\ntest_doubleToFloat :: IO ()\ntest_doubleToFloat = do\n  test_banner \"doubleToFloat\"\n  putStrLn (show doubles)\n  putStrLn (show $ map doubleToFloat doubles)\n\ndoubleToFloat :: Double -> Float\ndoubleToFloat = realToFrac\n\nfloatToDouble :: Float -> Double\nfloatToDouble = realToFrac\n\ntest_floatToDouble :: IO ()\ntest_floatToDouble = do\n  test_banner \"doubleToFloat\"\n  putStrLn (show doubles)\n  putStrLn (show $ map doubleToFloat doubles)\n  putStrLn (show $ map (floatToDouble.doubleToFloat) doubles)\n\ntest_showHex :: IO ()\ntest_showHex = do\n  test_banner \"showHex\"\n  putStrLn (show ints)\n  putStrLn (showList' (map showHex ints))\n  putStrLn (show integers)\n  putStrLn (showList' (map showHex integers))\n\ntest_showBin :: IO ()\ntest_showBin = do\n  test_banner \"showBin\"\n  putStrLn (show ints)\n  putStrLn (showList' (map showBin ints))\n  putStrLn (show integers)\n  putStrLn (showList' (map showBin integers))\n\nshowBin i = showIntAtBase 2 intToDigit i\n\nshowList' :: [ShowS] -> String\nshowList' [] = \"[]\"\nshowList' (x:xs) = showChar '[' . x $ showl xs \"\"\n      where\n       showl []     = showChar ']'\n       showl (x:xs) = showChar ',' . x . showl xs\n\n\ntest_showOct :: IO ()\ntest_showOct = do\n  test_banner \"showOct\"\n  putStrLn (show ints)\n  putStrLn (showList' (map showOct ints))\n  putStrLn (show integers)\n  putStrLn (showList' (map showOct integers))\n\n----\ntest_banner :: String -> IO ()\ntest_banner tst = do\n  putStrLn $ \"--------------------------------\"\n  putStrLn $ \"--Testing \" ++ tst\n  putStrLn $ \"--------------------------------\"\n", "num_lines": 91}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test gcd\n\nmain :: IO ()\nmain = do\n   test gcd ([                       -42, 0, 105             ] :: [Int])\n   test gcd ([-12193263111263526900, -42, 0, 105, 1234567890 ] :: [Integer])\n\n\ntest :: (Show a, Integral a) => (a -> a -> a) -> [a] -> IO ()\ntest f xs = mapM_ print [ (a, b, f a b) | a <- xs, b <- reverse xs, a /= 0  || b /= 0 ]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test behaviour of fromInteger when the target type is out of range.\n\nmain :: IO ()\nmain = \n  print [\n    fromInteger maxInt2 :: Int,\n    fromInteger minInt2 :: Int\n  ]  \n\nmaxInt2 = fromIntegral (maxBound :: Int)     * 2 :: Integer\nminInt2 = fromIntegral (minBound + 1 :: Int) * 2 :: Integer\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = do\n  print (map read strange_nums :: [Float]) \n  print (map read strange_nums :: [Double]) \n  where\n   strange_nums = [\"Infinity\",\"NaN\", \"-Infinity\"]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport GHC.Exts ( Float(F#),\n                   eqFloat#, neFloat#, ltFloat#,\n                   leFloat#, gtFloat#, geFloat#,\n                   isTrue#\n                 )\n\nfcmp_eq, fcmp_ne, fcmp_lt, fcmp_le, fcmp_gt, fcmp_ge :: (String, Float -> Float -> Bool)\nfcmp_eq = (\"==\", \\ (F# a) (F# b) -> isTrue# (a `eqFloat#` b))\nfcmp_ne = (\"/=\", \\ (F# a) (F# b) -> isTrue# (a `neFloat#` b))\nfcmp_lt = (\"< \", \\ (F# a) (F# b) -> isTrue# (a `ltFloat#` b))\nfcmp_le = (\"<=\", \\ (F# a) (F# b) -> isTrue# (a `leFloat#` b))\nfcmp_gt = (\"> \", \\ (F# a) (F# b) -> isTrue# (a `gtFloat#` b))\nfcmp_ge = (\">=\", \\ (F# a) (F# b) -> isTrue# (a `geFloat#` b))\n\nfloat_fns = [fcmp_eq, fcmp_ne, fcmp_lt, fcmp_le, fcmp_gt, fcmp_ge]\n\nfloat_vals :: [Float]\nfloat_vals = [0.0, 1.0, read \"NaN\"]\n\nfloat_text\n   = [show4 arg1 ++ \" \" ++ fn_name ++ \" \" ++ show4 arg2 ++ \"   = \" ++ show (fn arg1 arg2)\n      | (fn_name, fn) <- float_fns,\n        arg1 <- float_vals,\n        arg2 <- float_vals\n     ]\n     where\n        show4 x = take 4 (show x ++ repeat ' ')\n\nmain\n   = putStrLn (unlines float_text)\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test for a bug in integer->{Int,Word}64 conversion in GHC 5.04.x\n\nimport Data.Int\nimport Data.Word\n\nmain = do\n  print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer))\n                :: Data.Int.Int64)\n  print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer))\n                :: Data.Word.Word64)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- exposes a bug in the native code generator in GHC 6.4.1.  Division by\n-- a power of 2 was being mis-optimsed to a direct shift.\n\nmain = do\n  print (map f4 [(-20) .. (-1)])\n  print (map f8 [(-20) .. (-1)])\n\nf4 :: Int -> Int\nf4 x = x `quot` 4\n\nf8 :: Int -> Int\nf8 x = x `quot` 8\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- demonstrates a bug in mulIntMayOflo in GHC 6.5 on 64-bit arches\n-- (trac #867).\n-- It thought it could represent 3049800625 * 3049800625 in an I#.\n\ni :: Integer\ni = 3049800625\n\nmain :: IO ()\nmain = print (i * i)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Prim\nimport GHC.Word\nimport GHC.Exts\n\nimport Control.Monad\nimport Data.Bits\nimport Data.List\nimport System.Exit\n\nallEqual :: Eq a => [a] -> Bool\nallEqual [] = error \"allEqual: nothing to compare\"\nallEqual (x:xs) = all (== x) xs\n\ntestWords :: [Word]\ntestWords = map head . group . sort $\n            concatMap (\\w -> [w - 1, w, w + 1]) $\n            concatMap (\\w -> [w, maxBound - w]) $\n            trailingOnes ++ randoms\n  where trailingOnes = takeWhile (/= 0) $ iterate (`div` 2) $ maxBound\n        -- What would a Haskell program be without some Fibonacci numbers?\n        randoms = take 40 $ drop 100 fibs\n        fibs = 0 : 1 : zipWith (+) fibs (tail fibs)\n\n\nwordSizeInBits :: Int\nwordSizeInBits = length $ takeWhile (/= 0) $ iterate (`div` 2) (maxBound :: Word)\n\n\n-- plusWord2# (Word# carry)\n\nways_plusWord2# :: [Word -> Word -> Bool]\nways_plusWord2# = [ltTest, integerTest, primopTest]\n  where ltTest x y =\n          let r = x + y in r < x\n        integerTest x y =\n          let r = fromIntegral x + fromIntegral y :: Integer\n          in r > fromIntegral (maxBound :: Word)\n        primopTest (W# x) (W# y) = case plusWord2# x y of\n          (# 0##, _ #) -> False\n          (# 1##, _ #) -> True\n          _            -> error \"unexpected result from plusWord2#\"\n\n-- addIntC# (Int# addition overflow)\n\nways_addIntC# :: [Int -> Int -> Bool]\nways_addIntC# = [ltTest, integerTest, highBitTest, primopTest]\n  where ltTest x y =\n          let r = x + y in (y > 0 && r < x) || (y < 0 && r > x)\n        integerTest x y =\n          let r = fromIntegral x + fromIntegral y :: Integer\n          in r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int)\n        highBitTest x y =\n          let r = x + y in testBit ((x `xor` r) .&. (y `xor` r)) (wordSizeInBits - 1)\n        primopTest (I# x) (I# y) = case addIntC# x y of\n          (# _, 0# #) -> False\n          _ -> True\n\n-- subIntC# (Int# subtraction overflow)\n\nways_subIntC# :: [Int -> Int -> Bool]\nways_subIntC# = [ltTest, integerTest, highBitTest, primopTest]\n  where ltTest x y =\n          let r = x - y in (y > 0 && r > x) || (y < 0 && r < x)\n        integerTest x y =\n          let r = fromIntegral x - fromIntegral y :: Integer\n          in r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int)\n        highBitTest x y =\n          let r = x - y in testBit ((x `xor` r) .&. complement (y `xor` r)) (wordSizeInBits - 1)\n        primopTest (I# x) (I# y) = case subIntC# x y of\n          (# _, 0# #) -> False\n          _ -> True\n\nrunTest :: Show a => String -> [a -> a -> Bool] -> a -> a -> IO ()\nrunTest label ways x y = do\n  let results = map (\\f -> f x y) ways\n  unless (allEqual results) $ do\n    putStrLn $ \"Failed (\" ++ label ++ \"): \" ++ show (x,y) ++ \" \" ++ show results\n    exitWith (ExitFailure 1)\n\nmain :: IO ()\nmain = do\n  forM_ testWords $ \\x ->\n    forM_ testWords $ \\y -> do\n      runTest \"ways_plusWord2#\" ways_plusWord2# x y\n      runTest \"ways_addIntC#\" ways_addIntC# (fromIntegral x) (fromIntegral y)\n      runTest \"ways_subIntC#\" ways_subIntC# (fromIntegral x) (fromIntegral y)\n  putStrLn \"Passed\"\n", "num_lines": 90}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- tests that expFloat# works (had linking problems on Windows)\n\nimport GHC.Exts\n\nmain = do\n  print (F# (expFloat# 3.45#))\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Prim\nimport GHC.Word\nimport Data.Bits\n\nmain :: IO ()\nmain = do f 5 6\n          f 0xFD94E3B7FE36FB18 49\n          f 0xFD94E3B7FE36FB18 0xFC1D8A3BFB29FC6A\n\nf :: Word -> Word -> IO ()\nf wx@(W# x) wy@(W# y)\n    = do putStrLn \"-----\"\n         putStrLn (\"Doing \" ++ show wx ++ \" * \" ++ show wy)\n         case x `timesWord2#` y of\n             (# h, l #) ->\n                 do let wh = W# h\n                        wl = W# l\n                        r = shiftL (fromIntegral wh) (bitSize wh)\n                          + fromIntegral wl\n                    putStrLn (\"High: \" ++ show wh)\n                    putStrLn (\"Low: \" ++ show wl)\n                    putStrLn (\"Result: \" ++ show (r :: Integer))\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NumDecimals #-}\n\nmain :: IO ()\nmain = print (1.2e6 :: Integer)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests that minBound::Int is correctly handled (for Int & Integer\n\n-- (not necessarily Haskell 98: relies on Int being a 32-bit type.)\n\nmain = do\n  print (-2147483648 :: Int)                    -- -2147483648\n  print ((-2147483647)-1 :: Int)                -- -2147483648\n  print (-2147483648 :: Integer)                -- -2147483648\n  print ((-2147483648 :: Int) >= 0)             -- False\n  print ((-2147483648 :: Integer) >= 0)         -- False\n  print (-(-2147483648) :: Int)                 -- <undefined>\n  print (abs (-2147483648) :: Int)              -- <undefined>\n  print (abs ((-2147483647)-1) :: Int)          -- <undefined>\n  print (abs (-2147483648) :: Integer)          -- 2147483648\n  print (abs ((-2147483647)-1) :: Integer)      -- 2147483648 (wrong in 4.04)\n  print (fromInteger (-2147483648 :: Integer) :: Int)      -- -2147483648\n  print (fromInteger ((-2147483647)-1 :: Integer) :: Int)  -- -2147483648\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests that local fixity declarations work\n\n-- If local fixity decls don't work you get \"14\"\n-- The right answer is \"11\"\n\nval = 3 +! 4 *! 2\n    where (+!) = (+)\n          (*!) = (*)\n          infixl 6 +!\n          infixl 7 *!\n\nmain = print val\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Ratio\nmain = print (fromRational (1 % 85070591730234615865843651857942052864) :: Float)\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test for trac #921\n\nimport GHC.Float\nimport Foreign\nimport Control.Monad\n\nmain :: IO ()\nmain = do -- The reported case\n          putStrLn (show (map log2 vals))\n          -- Smaller failing cases\n          print (fromIntegral ((2^31) :: Int) :: Double)\n          if_not_32 $ print (round ((2^33) :: Double) :: Int)\n          print (fromIntegral ((2^31) :: Int) :: Float)\n          if_not_32 $ print (round ((2^33) :: Float) :: Int)\n          -- The underlying failing internal operations\n          print (int2Double (2^31))\n          if_not_32 $ print (double2Int (2^33))\n          print (int2Float (2^31))\n          if_not_32 $ print (float2Int (2^33))\n  where\n    -- the value of float2Int x where the result would be outside the\n    -- range of the target is undefined.  We also take the view in GHC\n    -- that round and truncate are similarly undefined when the result\n    -- would be outside the range of the target type (see #1254)\n    if_not_32 = when (sizeOf (undefined::Int) > 4)\n\nlog2 x = ceiling log_x\n    where log_x :: Double\n          log_x = logBase 2 (fromIntegral (max 1 x))\n\nvals = [1, 2, 17, 259, 1000, 10000,\n        2^30 + 9000, 2^31 - 1, 2^31 + 1,\n        2^32 - 1, 2^32 + 1]\n\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test for trac #1042\n\nimport Control.Exception\nimport Data.Int\n\nmain :: IO ()\nmain = do print ((minBound :: Int) `div` (-1))   `myCatch` print\n          print ((minBound :: Int8) `div` (-1))  `myCatch` print\n          print ((minBound :: Int16) `div` (-1)) `myCatch` print\n          print ((minBound :: Int32) `div` (-1)) `myCatch` print\n          print ((minBound :: Int64) `div` (-1)) `myCatch` print\n\nmyCatch :: IO a -> (ArithException -> IO a) -> IO a\nmyCatch = catch\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test that we don't have rules (or othre optimisations) doing the\n-- wrong thing for constant folding with Doubles.\n\nmodule Main (main) where\n\nzero :: Double\nzero = 0\n\none :: Double\none = 1\n\nnan :: Double\nnan = 0 / 0\n\ninf :: Double\ninf = 1 / 0\n\nneginf :: Double\nneginf = -1 / 0\n\nfzero :: Float\nfzero = 0\n\nfone :: Float\nfone = 1\n\nfnan :: Float\nfnan = 0 / 0\n\nfinf :: Float\nfinf = 1 / 0\n\nfneginf :: Float\nfneginf = -1 / 0\n\nmain :: IO ()\nmain = do putStrLn \"=== Subtraction ===\"\n          print (zero - zero)\n          print (zero - nan)\n          print (zero - inf)\n          print (zero - neginf)\n          print (nan - zero)\n          print (nan - nan)\n          print (nan - inf)\n          print (nan - neginf)\n          print (inf - zero)\n          print (inf - nan)\n          print (inf - inf)\n          print (inf - neginf)\n          print (neginf - zero)\n          print (neginf - nan)\n          print (neginf - inf)\n          print (neginf - neginf)\n          putStrLn \"=== Addition ===\"\n          print (zero + zero)\n          print (zero + nan)\n          print (zero + inf)\n          print (zero + neginf)\n          print (nan + zero)\n          print (nan + nan)\n          print (nan + inf)\n          print (nan + neginf)\n          print (inf + zero)\n          print (inf + nan)\n          print (inf + inf)\n          print (inf + neginf)\n          print (neginf + zero)\n          print (neginf + nan)\n          print (neginf + inf)\n          print (neginf + neginf)\n          putStrLn \"=== Mutiplication ===\"\n          print (zero * zero)\n          print (zero * one)\n          print (zero * nan)\n          print (zero * inf)\n          print (zero * neginf)\n          print (one * zero)\n          print (one * one)\n          print (one * nan)\n          print (one * inf)\n          print (one * neginf)\n          print (nan * zero)\n          print (nan * one)\n          print (nan * nan)\n          print (nan * inf)\n          print (nan * neginf)\n          print (inf * zero)\n          print (inf * one)\n          print (inf * nan)\n          print (inf * inf)\n          print (inf * neginf)\n          print (neginf * zero)\n          print (neginf * one)\n          print (neginf * nan)\n          print (neginf * inf)\n          print (neginf * neginf)\n          putStrLn \"=== Division ===\"\n          print (zero / zero)\n          print (zero / one)\n          print (zero / nan)\n          print (zero / inf)\n          print (zero / neginf)\n          print (one / zero)\n          print (one / one)\n          print (one / nan)\n          print (one / inf)\n          print (one / neginf)\n          print (nan / zero)\n          print (nan / one)\n          print (nan / nan)\n          print (nan / inf)\n          print (nan / neginf)\n          print (inf / zero)\n          print (inf / one)\n          print (inf / nan)\n          print (inf / inf)\n          print (inf / neginf)\n          print (neginf / zero)\n          print (neginf / one)\n          print (neginf / nan)\n          print (neginf / inf)\n          print (neginf / neginf)\n\n          putStrLn \"=== Subtraction ===\"\n          print (fzero - fzero)\n          print (fzero - fnan)\n          print (fzero - finf)\n          print (fzero - fneginf)\n          print (fnan - fzero)\n          print (fnan - fnan)\n          print (fnan - finf)\n          print (fnan - fneginf)\n          print (finf - fzero)\n          print (finf - fnan)\n          print (finf - finf)\n          print (finf - fneginf)\n          print (fneginf - fzero)\n          print (fneginf - fnan)\n          print (fneginf - finf)\n          print (fneginf - fneginf)\n          putStrLn \"=== Addition ===\"\n          print (fzero + fzero)\n          print (fzero + fnan)\n          print (fzero + finf)\n          print (fzero + fneginf)\n          print (fnan + fzero)\n          print (fnan + fnan)\n          print (fnan + finf)\n          print (fnan + fneginf)\n          print (finf + fzero)\n          print (finf + fnan)\n          print (finf + finf)\n          print (finf + fneginf)\n          print (fneginf + fzero)\n          print (fneginf + fnan)\n          print (fneginf + finf)\n          print (fneginf + fneginf)\n          putStrLn \"=== Mutiplication ===\"\n          print (fzero * fzero)\n          print (fzero * fone)\n          print (fzero * fnan)\n          print (fzero * finf)\n          print (fzero * fneginf)\n          print (fone * fzero)\n          print (fone * fone)\n          print (fone * fnan)\n          print (fone * finf)\n          print (fone * fneginf)\n          print (fnan * fzero)\n          print (fnan * fone)\n          print (fnan * fnan)\n          print (fnan * finf)\n          print (fnan * fneginf)\n          print (finf * fzero)\n          print (finf * fone)\n          print (finf * fnan)\n          print (finf * finf)\n          print (finf * fneginf)\n          print (fneginf * fzero)\n          print (fneginf * fone)\n          print (fneginf * fnan)\n          print (fneginf * finf)\n          print (fneginf * fneginf)\n          putStrLn \"=== Division ===\"\n          print (fzero / fzero)\n          print (fzero / fone)\n          print (fzero / fnan)\n          print (fzero / finf)\n          print (fzero / fneginf)\n          print (fone / fzero)\n          print (fone / fone)\n          print (fone / fnan)\n          print (fone / finf)\n          print (fone / fneginf)\n          print (fnan / fzero)\n          print (fnan / fone)\n          print (fnan / fnan)\n          print (fnan / finf)\n          print (fnan / fneginf)\n          print (finf / fzero)\n          print (finf / fone)\n          print (finf / fnan)\n          print (finf / finf)\n          print (finf / fneginf)\n          print (fneginf / fzero)\n          print (fneginf / fone)\n          print (fneginf / fnan)\n          print (fneginf / finf)\n          print (fneginf / fneginf)\n\n", "num_lines": 212}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that floating-point abs works correctly\n\nabsF :: Float -> Float\nabsF = abs\n\nabsD :: Double -> Double\nabsD = abs\n\nmain :: IO ()\nmain = do\n    print $ absF (1 / 0)\n    print $ absD (1 / 0)\n    print $ absF 1\n    print $ absD 1\n    print $ absF (-1)\n    print $ absD (-1)\n    print $ absF (-1 / 0)\n    print $ absD (-1 / 0)\n    print $ absF (0 / 0)\n    print $ absD (0 / 0)\n    print $ absD $ sqrt (-1)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for trac #8532\n\nimport Data.Complex\n\nmain :: IO ()\nmain = do\n    print $ acosh ((-1)::Complex Double)\n    print $ acosh ((-1)::Complex Float)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Prim\nimport GHC.Word\nimport Control.Monad\nimport Data.Bits\n\nmain :: IO ()\nmain = do f 5 6 23\n          f 0x80000000 0 0x80000001\n          f 0xFC1D8A3BFB29FC6A 49 0xFD94E3B7FE36FB18\n\nf :: Word -> Word -> Word -> IO ()\nf wxHigh@(W# xHigh) wxLow@(W# xLow) wy@(W# y)\n    = do when debugging $ putStrLn \"-----\"\n         when debugging $ putStrLn (\"Doing \" ++ show (wxHigh, wxLow)\n                                             ++ \" `quotRem` \" ++ show wy)\n         let ix = (toInteger wxHigh `shiftL` bitSize wxHigh)\n              .|. toInteger wxLow\n             wanted = ix `quotRem` toInteger wy\n         when debugging $ putStrLn (\"Wanted: \" ++ show wanted)\n         case quotRemWord2# xHigh xLow y of\n             (# q, r #) ->\n                 do let wq = W# q\n                        wr = W# r\n                        got = (toInteger wq, toInteger wr)\n                    when debugging $ putStrLn (\"Got: \" ++ show got)\n                    if wanted == got then putStrLn \"Worked\"\n                                     else putStrLn \"Failed\"\n\ndebugging :: Bool\ndebugging = False\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, TypeOperators, GADTs #-}\nmodule Main\n       ( main -- :: IO ()\n       ) where\nimport Data.Data\nimport Data.Ratio\n\nmain :: IO ()\nmain =\n  let bad = gmapT (\\(x :: b) ->\n              case eqT :: Maybe (b :~: Integer) of\n                Nothing -> x;\n                Just Refl -> x * 2) (1 % 2) :: Rational\n  in print (bad == numerator bad % denominator bad)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash     #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main (main) where\n\nimport GHC.Base\n\nunW# :: Word -> Word#\nunW# (W# w) = w\n\ntype WordOpC = Word# -> Word# -> (# Word#, Int# #)\n\ncheck :: WordOpC -> Word# -> Word# -> IO ()\ncheck op a b = do\n  let (# w, c #) = op a b\n  print (W# w, I# c)\n\ncheckSubInlNoInl :: WordOpC -> Word# -> Word# -> IO ()\ncheckSubInlNoInl op a b = do\n  inline check op a b   -- constant folding\n  noinline check op a b -- lowering of PrimOp\n{-# INLINE checkSubInlNoInl #-}\n\nmain :: IO ()\nmain = do\n  -- Overflow.\n  checkSubInlNoInl subWordC# 1## 3##\n  checkSubInlNoInl addWordC# (unW# (inline maxBound)) 3##\n\n  -- No overflow.\n  checkSubInlNoInl subWordC# 5## 2##\n  checkSubInlNoInl addWordC# (unW# (inline maxBound-1)) 1##\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ntestfn :: Word -> IO ()\ntestfn wseq = do\n  print $ wseq `mod` 1\n\nmain = do\n  testfn 5\n  print $ (5 :: Word) `mod` 1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n#include \"MachDeps.h\"\n\nmodule Main where\n\nimport Data.Bits\n\n#if WORD_SIZE_IN_BITS != 64 && WORD_SIZE_IN_BITS != 32\n# error unsupported WORD_SIZE_IN_BITS config\n#endif\n\n-- a negative integer the size of GMP_LIMB_BITS*2\nnegativeBigInteger :: Integer\nnegativeBigInteger = 1 - (1 `shiftL` (64 * 2))\n\nmain = do\n    -- rigt shift by GMP_LIMB_BITS\n    print $ negativeBigInteger `shiftR` 64\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = do\n  print 1e646457008\n  print 1e646457009 -- T15271: This incorrectly printed 0.0\n  print 1e1555550000 -- This is still infinity\n  print 1e1000000000 -- T15271: This incorrectly printed 0.0\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Numeric\nimport GHC.Natural\n\nmain = do\n   -- test that GHC correctly compiles big Natural literals\n   let x = 0xffffffffffffffffffffffff :: Natural\n   print (showHex x \"\" == \"ffffffffffffffffffffffff\")\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain = print (syn [-1])\n\nsyn :: [Int] -> [Int]\nsyn (d:ds) = rem d 0x40000000 : syn ds\nsyn [] = []\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test conversion of funny numbers through Rational (#3676)\n\nmain = mapM_ putStrLn $ concat $\n  [map (show.d2d) doubles1,\n   map (show.d2f) doubles1,\n   map (show.d2r) doubles1,\n   map (show.f2d) floats1,\n   map (show.f2f) floats1,\n   map (show.f2r) floats1,\n   map (show.d2d) doubles2,\n   map (show.d2f) doubles2,\n   map (show.d2r) doubles2,\n   map (show.f2d) floats2,\n   map (show.f2f) floats2,\n   map (show.f2r) floats2\n  ]\n\nd2d = realToFrac :: Double -> Double\nd2f = realToFrac :: Double -> Float\nd2r = realToFrac :: Double -> Rational\nf2d = realToFrac :: Float -> Double\nf2f = realToFrac :: Float -> Float\nf2r = realToFrac :: Float -> Rational\n\ndoubles1 = [0/0, 1/0, -1/0, 0/(-1)] :: [Double]\nfloats1  = [0/0, 1/0, -1/0, 0/(-1)] :: [Float]\n\ndoubles2 = names :: [Double]\nfloats2  = names :: [Float]\n\nnames :: Read a => [a]\nnames = map read [\"NaN\", \"Infinity\", \"-Infinity\", \"-0\"]\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain = do\n  print (scaleFloat 30000 1)\n  print (scaleFloat (maxBound :: Int) 1)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print (0.5 ^ 1030)\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Text.Printf\n\nmain :: IO ()\nmain = do\n  putStrLn $ printf \"%.1f\" (0.45 :: Double)\n  putStrLn $ printf \"%.1f\" (0.55 :: Double)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule Main where\n\nimport Data.Bits\n\ntest_and1 :: Word -> Word\ntest_and1 x = x .&. 0\n\ntest_and2 :: Word -> Word\ntest_and2 x = 0 .&. x\n\ntest_or1 :: Word -> Word\ntest_or1 x = x .|. 0\n\ntest_or2 :: Word -> Word\ntest_or2 x = 0 .|. x\n\ntest_shiftL :: Word -> Word\ntest_shiftL x = shiftL x 0\n\ntest_shiftR :: Word -> Word\ntest_shiftR x = shiftR x 0\n\ntest_add1 :: Int -> Int\ntest_add1 x = x + 0\n\ntest_add2 :: Int -> Int\ntest_add2 x = 0 + x\n\ntest_sub1 :: Int -> Int\ntest_sub1 x = x - 0\n\ntest_sub2 :: Int -> Int\ntest_sub2 x = x - x\n\ntest_mul1 :: Int -> Int\ntest_mul1 x = x * 1\n\ntest_mul2 :: Int -> Int\ntest_mul2 x = 1 * x\n\ntest_mul3 :: Int -> Int\ntest_mul3 x = x * 0\n\ntest_quot :: Int -> Int\ntest_quot x = x `quot` 1\n\ntest_rem :: Int -> Int\ntest_rem x = x `rem` 1\n\ntest_addf1 :: Float -> Float\ntest_addf1 x = x + 0\n\ntest_addf2 :: Float -> Float\ntest_addf2 x = 0 + x\n\ntest_subf :: Float -> Float\ntest_subf x = x - 0\n\ntest_mulf1 :: Float -> Float\ntest_mulf1 x = x * 1\n\ntest_mulf2 :: Float -> Float\ntest_mulf2 x = 1 * x\n\ntest_divf :: Float -> Float\ntest_divf x = x / 1\n\nmain :: IO ()\nmain = do\n  print $ test_and1 42\n  print $ test_and2 43\n  print $ test_or1 44\n  print $ test_or2 45\n  print $ test_shiftL 46\n  print $ test_shiftR 47\n  print $ test_add1 48\n  print $ test_add2 49\n  print $ test_sub1 50\n  print $ test_sub2 51\n  print $ test_mul1 52\n  print $ test_mul2 53\n  print $ test_mul3 54\n  print $ test_quot 55\n  print $ test_rem 56\n  print $ test_addf1 57\n  print $ test_addf2 58\n  print $ test_subf 59\n  print $ test_mulf1 60\n  print $ test_mulf2 61\n  print $ test_divf 62\n", "num_lines": 93}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Int\nimport Data.Word\n\nmain = do\n  print [5 `div` (minBound+k::Int)    | k <- [0 .. 10]]\n  print [5 `div` (minBound+k::Int8)   | k <- [0 .. 10]]\n  print [5 `div` (minBound+k::Int16)  | k <- [0 .. 10]]\n  print [5 `div` (minBound+k::Int32)  | k <- [0 .. 10]]\n  print [5 `div` (minBound+k::Int64)  | k <- [0 .. 10]]\n  print [5 `quot` (minBound+k::Int)    | k <- [0 .. 10]]\n  print [5 `quot` (minBound+k::Int8)   | k <- [0 .. 10]]\n  print [5 `quot` (minBound+k::Int16)  | k <- [0 .. 10]]\n  print [5 `quot` (minBound+k::Int32)  | k <- [0 .. 10]]\n  print [5 `quot` (minBound+k::Int64)  | k <- [0 .. 10]]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport Data.Bits\nimport Data.List\nimport Data.Ord\n\n-- | test-values to use as numerator/denominator\nposvals :: [Integer]\nposvals = [1,2,3,4,5,9,10,14,15,16,17] ++\n          [ n | e <- ([5..70]++[96,128,160,192,224])\n              , ofs <- [-1..1], let n = bit e + ofs ]\n\nposvalsSum :: Integer\nposvalsSum = 0x300000003000000030000000300000003000001800000000000000000\n\nvals :: [Integer]\nvals = sortBy (comparing abs) $ map negate posvals ++ [0] ++ posvals\n\n\nmain :: IO ()\nmain = do\n    unless (sum posvals == posvalsSum) $\n        fail $ \"sum posvals == \" ++ show (sum posvals)\n\n    forM_ [ (n,d) | n <- vals, d <- vals, d /= 0 ] $ \\(n,d) -> do\n        let check sp p = unless (p n d) $ fail (sp ++ \" \" ++ show n ++ \" \" ++ show d)\n\n        check \"rem0\"      prop_rem0\n        check \"mod0\"      prop_mod0\n\n        check \"divMod0\"   prop_divMod0\n        check \"divMod1\"   prop_divMod1\n        check \"divMod2\"   prop_divMod2\n\n        check \"quotRem0\"  prop_quotRem0\n        check \"quotRem1\"  prop_quotRem1\n        check \"quotRem2\"  prop_quotRem2\n\n    -- putStrLn \"passed\"\n\n-- QuickCheck style properties\n\nprop_rem0 :: Integer -> Integer -> Bool\nprop_rem0 n d\n  | n >= 0     = (n `rem` d) `inside` (-1,abs d)\n  | otherwise  = (n `rem` d) `inside` (-(abs d),1)\n  where\n    inside v (l,u) = l < v && v < u\n\nprop_mod0 :: Integer -> Integer -> Bool\nprop_mod0 n d\n  | d >= 0     = (n `mod` d) `inside` (-1,d)\n  | otherwise  = (n `mod` d) `inside` (d,1)\n  where\n    inside v (l,u) = l < v && v < u\n\n-- | Invariant from Haskell Report\nprop_divMod0 :: Integer -> Integer -> Bool\nprop_divMod0 n d = (n `div` d) * d + (n `mod` d) == n\n\nprop_divMod1 :: Integer -> Integer -> Bool\nprop_divMod1 n d = divMod n d == (n `div` d, n `mod` d)\n\n-- | Compare IUT to implementation of 'divMod' in terms of 'quotRem'\nprop_divMod2 :: Integer -> Integer -> Bool\nprop_divMod2 n d = divMod n d == divMod' n d\n  where\n    divMod' x y = if signum r == negate (signum y) then (q-1, r+y) else qr\n      where qr@(q,r) = quotRem x y\n\n-- | Invariant from Haskell Report\nprop_quotRem0 :: Integer -> Integer -> Bool\nprop_quotRem0 n d = (n `quot` d) * d + (n `rem` d) == n\n\nprop_quotRem1 :: Integer -> Integer -> Bool\nprop_quotRem1 n d = quotRem n d == (n `quot` d, n `rem` d)\n\n-- | Test symmetry properties of 'quotRem'\nprop_quotRem2 :: Integer -> Integer -> Bool\nprop_quotRem2 n d = (qr == negQ (quotRem n (-d))    &&\n                     qr == negR (quotRem (-n) (-d)) &&\n                     qr == (negQ . negR) (quotRem (-n) d))\n  where\n    qr = quotRem n d\n    negQ (q,r) = (-q,r)\n    negR (q,r) = (q,-r)\n", "num_lines": 86}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data Vec3 = Vec3 !Double !Double !Double\n    deriving (Show)\n\ninfixl 6 ^+^, ^-^\ninfixr 7 *^, <.>\n\nnegateV :: Vec3 -> Vec3\nnegateV (Vec3 x y z) = Vec3 (-x) (-y) (-z)\n\n(^+^), (^-^) :: Vec3 -> Vec3 -> Vec3\nVec3 x1 y1 z1 ^+^ Vec3 x2 y2 z2 = Vec3 (x1 + x2) (y1 + y2) (z1 + z2)\nv ^-^ v' = v ^+^ negateV v'\n\n(*^) :: Double -> Vec3 -> Vec3\ns *^ Vec3 x y z = Vec3 (s * x) (s * y) (s * z)\n\n(<.>) :: Vec3 -> Vec3 -> Double\nVec3 x1 y1 z1 <.> Vec3 x2 y2 z2 = x1 * x2 + y1 * y2 + z1 * z2\n\nmagnitudeSq :: Vec3 -> Double\nmagnitudeSq v = v <.> v\n\nnormalized :: Vec3 -> Vec3\nnormalized v = (1 / sqrt (magnitudeSq v)) *^ v\n\nclass Surface s where\n    intersectSurfaceWithRay :: s -> Vec3 -> Vec3 -> Maybe Vec3\n\ndata Sphere = Sphere Vec3 Double\n\ninstance Surface Sphere where\n    intersectSurfaceWithRay (Sphere c r) o d =\n        let c' = c ^-^ o\n            b = c' <.> d\n            det = b^2 - magnitudeSq c' + r^2\n            det' = sqrt det\n            t1 = b - det'\n            t2 = b + det'\n\n            returnIntersection t =\n                let x = o ^+^ t *^ d\n                in Just (normalized (x ^-^ c))\n        in if det < 0 then Nothing\n           else if t1 > 1e-6 then returnIntersection t1\n           else if t2 > 1e-6 then returnIntersection t2\n           else Nothing\n\niappend :: Maybe Vec3 -> Maybe Vec3 -> Maybe Vec3\nNothing `iappend` i2 = i2\ni1 `iappend` _ = i1\n\nmain :: IO ()\nmain = print $ foldl combine Nothing [Sphere (Vec3 0 0 0) 1]\n  where combine accum surf = accum `iappend`\n            intersectSurfaceWithRay surf (Vec3 0 0 5) (Vec3 0 0 (-1))\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = do\n    -- NOTE: the `abs` is to compensate for WAY=optllvm\n    --       having a positive sign for 0/0\n\n    putStrLn \"## Double ##\"\n    print $ idRational ( 1/0 :: Double)\n    print $ idRational (-1/0 :: Double)\n    print $ abs $ idRational ( 0/0 :: Double)\n    print $ idReencode ( 1/0 :: Double)\n    print $ idReencode (-1/0 :: Double)\n    print $ abs $ idReencode ( 0/0 :: Double)\n\n    putStrLn \"## Float ##\"\n    print $ idRational ( 1/0 :: Float)\n    print $ idRational (-1/0 :: Float)\n    print $ abs $ idRational ( 0/0 :: Float)\n    print $ idReencode ( 1/0 :: Float)\n    print $ idReencode (-1/0 :: Float)\n    print $ abs $ idReencode ( 0/0 :: Float)\n  where\n    idRational :: (Real a, Fractional a) => a -> a\n    idRational = fromRational . toRational\n\n    idReencode :: (RealFloat a) => a -> a\n    idReencode = uncurry encodeFloat . decodeFloat\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n\n-- This will fail because there is no type defaulting implemented as of yet.\n\nmain = print [1]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n\ndata Foo = Foo\n\ntest :: Foo\ntest = [7]\n\nmain = return ()", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n\nmain = print (length (['a',\"b\"] :: [Char]))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n\nmain = print ([\"a\"..\"b\"] :: [String])\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n\nmain = print (length (['a'..(10 :: Int)] :: [Int]))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists, RebindableSyntax #-}\n\nf [] = []\nf x = x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n\nmain = do print ([] :: [Int])\n          print ([1,2,3] :: [Int])\n          print ((take 10 [1..]) :: [Int])\n          print (['a'..'e'] :: [Char])\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists, TypeFamilies #-}\n\nimport qualified Data.Set as S\nimport GHC.Exts\n\nmain = do print ([] :: (S.Set Int))\n          print (['a','b','c'] :: (S.Set Char))\n          print (['a','c'..'g'] :: (S.Set Char))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists, TypeFamilies #-}\n\nimport GHC.Exts\n\n-- This nonsensical instance is used to test if fromListN is used properly in\n-- desugaring of explicit lists.\n\ninstance IsList Int where\n type Item Int = Int\n fromList _ = 0\n toList _ = []\n fromListN n _ = n\n \nmain = do print ([] :: Int)\n          print ([1,2,3,4,5] :: Int)\n          print ([1..3] :: Int)\n          print ([7] :: Int)\n          print ([1,3..] :: Int)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists, TypeFamilies #-}\n\nimport qualified Data.Set as S\nimport GHC.Exts\n\nmain = do putStrLn (f [])\n          putStrLn (f [1,2])\n          putStrLn (f [2,0])\n          putStrLn (f [3,2])\n          putStrLn (f [2,7])\n          putStrLn (f [2,2])\n          putStrLn (f [1..7])\n\n\nf :: S.Set Int -> String\nf [] = \"empty\"\nf [_] = \"one element\"\nf [2,_] = \"two elements, the smaller one is 2\"\nf [_,2] = \"two elements, the bigger one is 2\"\nf _ = \"else\"\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists, TypeFamilies, RebindableSyntax #-}\n\nimport Prelude\nimport Data.List\n\nmain = do print []       \n          print [0,3..20]    \n          print [3]     \n          print [2..7]\n          print [20,2]\n          print [1,2,37]\n\nfromListN _ = length \nfromList = length\n          \n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T11173 where\nimport T11173a (A(..))\n\n-- Check that the fixity declaration applied to the field 'foo' is used\nx b = b `foo` b `foo` 0\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T11173a where\n\ndata A = A { foo :: Int -> Int, bar :: Int -> Int }\nnewtype B = B { foo :: Int -> Int }\ninfixr 5 `foo`\ninfixr 5 `bar`\n\n-- This is well-typed only if the fixity is correctly applied\ny b = b `bar` b `bar` 0\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n{-# OPTIONS_GHC -Werror -Wunused-top-binds #-}\nmodule Main (main, T(MkT)) where\n\ndata T = MkT { _x :: Int }\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n{-# OPTIONS_GHC -Werror=duplicate-exports #-}\n\n-- This should warn about the duplicate export of foo, but not the\n-- exports of the two different bar fields.\nmodule Export (T(foo, bar), foo, S(bar)) where\n\ndata T = MkT { foo :: Int, bar :: Int }\ndata S = MkS { bar :: Int }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, MagicHash, TypeFamilies, TypeApplications #-}\n\nimport HasFieldFail01_A (T(MkT))\n\nimport GHC.Records (HasField(..))\n\n-- This should fail to solve the HasField constraint, because foo is\n-- not in scope.\nmain = print (getField @\"foo\" (MkT 42) :: Int)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HasFieldFail01_A where\n\ndata T = MkT { foo :: Int }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, ExistentialQuantification, MagicHash, RankNTypes,\n             TypeApplications #-}\n\nimport GHC.Records (HasField(..))\n\ndata T = MkT { foo :: forall a . a -> a }\ndata U = forall b . MkU { bar :: b }\n\n-- This should fail because foo is higher-rank.\nx = getField @\"foo\" (MkT id)\n\n-- This should fail because bar is a naughty record selector (it\n-- involves an existential).\ny = getField @\"bar\" (MkU True)\n\nmain = return ()\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses,\n             TypeFamilies #-}\n\nimport GHC.Records (HasField(..))\n\ndata T = MkT { foo :: Int, bar :: Int }\n\n-- This is far too polymorphic\ninstance HasField \"woo\" a Bool where\n  getField = const True\n\n-- This conflicts with the built-in instance\ninstance HasField \"foo\" T Int where\n  getField = foo\n\n-- So does this\ninstance HasField \"bar\" T Bool where\n  getField = const True\n\n-- This doesn't conflict because there is no \"baz\" field in T\ninstance HasField \"baz\" T Bool where\n  getField = const True\n\n-- Bool has no fields, so this is okay\ninstance HasField a Bool Bool where\n  getField = id\n\n\ndata family V a b c d\ndata instance V x Int y [z] = MkVInt { baz :: (x, y, z, Bool) }\n\n-- Data families cannot have HasField instances, because they may get\n-- fields defined later on\ninstance HasField \"baz\" (V a b c d) Bool where\n  getField = const True\n\n-- Function types can have HasField instances, in case it's useful\ninstance HasField \"woo\" (a -> b) Bool where\n  getField = const True\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-#\u00c2\u00a0LANGUAGE DuplicateRecordFields #-}\nmodule NoParent (A(x)) where\n\ndata A = A\ndata B = B { x :: Int }\ndata C = C { x :: String }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLabels, DataKinds, FlexibleContexts #-}\n\nimport GHC.OverloadedLabels\n\n-- No instance for (OverloadedLabel \"x\" t0)\na = #x\n\n-- No instance for (OverloadedLabel \"x\" Int)\nb :: Int\nb = #x\n\n-- Could not deduce (OverloadedLabel \"y\" t) from (OverloadedLabel \"x\" t)\nc :: IsLabel \"x\" t => t\nc = #y\n\nmain = return ()\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLabels, RebindableSyntax #-}\n\nmain = #oops\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLabels, RebindableSyntax #-}\n\nmain = #foo\n  where\n    fromLabel = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test ambiguous updates are rejected with appropriate error messages\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\ndata R = MkR { w :: Bool, x :: Int, y :: Bool }\ndata S = MkS { w :: Bool, x :: Int, y :: Bool }\ndata T = MkT { x :: Int, z :: Bool }\ndata U = MkU { y :: Bool }\n\n-- Straightforward ambiguous update\nupd1 r = r { x = 3 }\n\n-- No type has all these fields\nupd2 r = r { x = 3, y = True, z = False }\n\n-- User-specified type does not have these fields\nupd3 r = r { w = True, x = 3, y = True } :: U\n\nmain = return ()\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test selectors cannot be used ambiguously\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\ndata R = MkR { x :: Int, y :: Bool }\ndata S = MkS { x :: Int }\n\nmain = do print (x (MkS 42))\n          print (y (MkR 42 42))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that a top-level definition with the same name as a record\n-- field is rejected\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\nfoo = True\n\ndata T = MkT { foo :: Int }\n\nmain = print foo\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that importing an overloaded field and using it as a selector\n-- leads to a suitable error\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\nimport OverloadedRecFldsFail04_A as I\n\n-- Qualified overloaded fields are not allowed here\nx' = I.x\n\n-- But this is okay\nf e = e { I.x = True, I.y = False }\n\nmain = return ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n\nmodule OverloadedRecFldsFail04_A (U(..), V(MkV, x), Unused(..), u) where\n\ndata U = MkU { x :: Bool, y :: Bool }\ndata V = MkV { x :: Int }\ndata Unused = MkUnused { unused :: Bool }\n\nu = MkU False True\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n{-# OPTIONS_GHC -fwarn-unused-binds -Werror #-}\n\nmodule Main (main, T(MkT)) where\n\ndata S = MkS { foo :: Int }\ndata T = MkT { foo :: Int }\n\n-- This should count as a use of S(foo) but not T(foo)\nmain = print ((\\ MkS{foo=foo} -> foo) (MkS 3))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Check that unused imports are reported correctly in the presence of\n-- DuplicateRecordFields\n\n{-# LANGUAGE DuplicateRecordFields #-}\n{-# OPTIONS_GHC -Werror -fwarn-unused-imports #-}\n\nimport OverloadedRecFldsFail06_A (U(x, y), V(MkV, MkV2, x, y), Unused(unused), u, getY)\nimport qualified OverloadedRecFldsFail06_A as M (U(x))\nimport qualified OverloadedRecFldsFail06_A as N (V(x, y))\nimport qualified OverloadedRecFldsFail06_A as P (U(x), V(x))\n\nv = MkV2 True\n\n-- Check that this counts a use of U(x) and V(y) but not U(y) or V(x)...\nmain = do print (u { x = True } :: U)\n          print ((\\ MkV2{y=y} -> y) v)\n          print (N.x v)\n          print (getY (v { P.x = 3 }))\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n{-# OPTIONS_GHC -fwarn-unused-binds #-}\n\nmodule OverloadedRecFldsFail06_A (U(..), V(..), Unused(unused), u, getX, getY, z) where\n\ndata U = MkU { x :: Bool, y :: Bool } | MkU2 { used_locally :: Bool }\n  deriving Show\ndata V = MkV { x :: Int } | MkV2 { y :: Bool }\ndata Unused = MkUnused { unused :: Bool, unused2 :: Bool, used_locally :: Bool }\n\nu = MkU False True\n\nz MkU2{used_locally=used_locally} = used_locally\n\ngetX MkU{x=x} = x\ngetY MkV2{y=y} = y\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test type errors contain field names, not selector names\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\ndata T = MkT { x :: Int }\n\ny = x x\n\nmain = return ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}\n\ndata family F a\ndata instance F Int  = MkFInt  { x :: Int }\ndata instance F Bool = MkFBool { y :: Bool }\n\n-- No data type has both these fields, but they belong to the same\n-- lexical parent (F).  This used to confuse DuplicateRecordFields.\nfoo e = e { x = 3, y = True }\n\nmain = return ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields, TemplateHaskell #-}\n\ndata S = MkS { x :: Int }\ndata T = MkT { x :: Int }\n\n-- This tests what happens when an ambiguous record update is used in\n-- a splice: since it can't be represented in TH, it should error\n-- cleanly, rather than panicking or silently using one field.\nfoo = [e| (MkS 3) { x = 3 } |]\n\nmain = return ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Modules A and B both declare F(foo)\n-- Module C declares F($sel:foo:MkFChar) but exports A.F(foo) as well\n-- Thus we can't export F(..) even with DuplicateRecordFields enabled\n\n{-# LANGUAGE DuplicateRecordFields #-}\nmodule Main (main, F(..)) where\n\nimport OverloadedRecFldsFail10_B\nimport OverloadedRecFldsFail10_C\n\nmain = return ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule OverloadedRecFldsFail10_A where\n\ndata family F a\ndata instance F Int = MkFInt { foo :: Int }\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule OverloadedRecFldsFail10_B (F(..)) where\n\nimport OverloadedRecFldsFail10_A hiding (foo)\n\ndata instance F Bool = MkFBool { foo :: Int }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}\nmodule OverloadedRecFldsFail10_C (F(..)) where\n\nimport OverloadedRecFldsFail10_A\n\ndata instance F Char = MkFChar { foo :: Char }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n{-# OPTIONS_GHC -Werror #-}\nimport OverloadedRecFldsFail11_A\n\nmain = print (foo (MkS True :: S))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule OverloadedRecFldsFail11_A where\n\n{-# WARNING foo \"Warning on a record field\" #-}\ndata S = MkS { foo :: Bool }\ndata T = MkT { foo :: Int }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n{-# OPTIONS_GHC -Werror #-}\n\nimport OverloadedRecFldsFail12_A\n\ndata S = MkS { foo :: Bool }\n\n-- Use of foo and bar should give deprecation warnings\nf :: T -> T\nf e = e { foo = 3, bar = 3 }\n\ns :: T -> Int\ns = foo\n\nmain = return ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module OverloadedRecFldsFail12_A where\n\n{-# WARNING foo \"Deprecated foo\" #-}\n{-# WARNING bar \"Deprecated bar\" #-}\ndata T = MkT { foo :: Int, bar :: Int }\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that giving a stupid type annotation to an ambiguous field\n-- yields a sensible error message\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\ndata S = MkS { x :: Int }\ndata T = MkT { x :: Bool }\ndata U = MkU\n\na = x (MkU :: U)\n\nb = x (MkU :: a)\n\nc :: U -> Int\nc = x\n\nd :: a -> Int\nd = x\n\nmain = return ()\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n\n-- Test that we deal gracefully with non-fields in updates\n\ndata S = MkS { x :: Int }\ndata T = MkT { x :: Int }\n\ny :: Bool\ny = True\n\n-- y isn't a field\nf r = r { x = 3, y = False }\n\nmain = return ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- When using DuplicateRecordFields with TemplateHaskell, it is not possible to\n-- reify ambiguous names that are output by reifying field labels.\n-- See also overloadedrecflds/should_run/overloadedrecfldsrun04.hs\n\n{-# LANGUAGE DuplicateRecordFields, TemplateHaskell #-}\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\ndata R = MkR { foo :: Int, bar :: Int }\ndata S = MkS { foo :: Int }\n\n$(do info <- reify ''R\n     case info of\n       TyConI (DataD _ _ _ _ [RecC _ [(foo_n, _, _), (bar_n, _, _)]] _)\n         -> do { reify bar_n -- This is unambiguous\n               ; reify foo_n -- This is ambiguous\n               ; return []\n               }\n       _ -> error \"unexpected result of reify\")\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T11167_ambiguous_fixity where\nimport T11167_ambiguous_fixity_A\nimport T11167_ambiguous_fixity_B\n\nx a = (a :: A) `foo` 0\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T11167_ambiguous_fixity_A where\ndata A = MkA { foo :: Int -> Int }\ndata C = MkC { foo :: Int -> Int }\ninfixr 3 `foo`\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11167_ambiguous_fixity_B where\ndata B = MkB { foo :: Int -> Int }\ninfixl 5 `foo`\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule Bug where\n\nnewtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }\nnewtype ContT2 r m a = ContT2 { runContT :: (a -> m r) -> m r }\n\nfoo bar baz = (`runContT` bar.baz)\n\nwoo x y = (`runContT` x `y` x)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T14953 (module T14953_A, module T14953_B) where\nimport T14953_A\nimport T14953_B\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T14953_A where\ndata R = R {unR :: Int}\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T14953_B where\ndata R = R {unR :: Int}\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds\n           , DatatypeContexts\n           , FlexibleInstances\n           , GADTs\n           , MultiParamTypeClasses\n           , TypeFamilies\n           , TypeApplications\n  #-}\n\nimport GHC.Records (HasField(..))\n\ntype family B where B = Bool\n\ndata T = MkT { foo :: Int, bar :: B }\n\ndata U a b = MkU { baf :: a }\n\ndata family V a b c d\ndata instance V x Int y [z] = MkVInt { baz :: (x, y, z, Bool) }\n\ndata W a where\n  MkW :: { woo :: a } -> W [a]\n\ndata Eq a => X a = MkX { xoo :: a }\ndata Y a = Eq a => MkY { yoo :: a }\n\nt = MkT 42 True\n\nu :: U Char Char\nu = MkU 'x'\n\nv = MkVInt (42, 'x', True, False)\n\nw = MkW True\n\nx = MkX True\n\ny = MkY True\n\n-- A virtual foo field for U\ninstance HasField \"foo\" (U a b) [Char] where\n  getField _ = \"virtual\"\n\nmain = do print (getField @\"foo\" t)\n          print (getField @\"bar\" t)\n          print (getField @\"baf\" u)\n          print (getField @\"foo\" u)\n          print (getField @\"baz\" v)\n          print (getField @\"woo\" w)\n          print (getField @\"xoo\" x)\n          print (getField @\"yoo\" y)\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields, OverloadedLabels,\n             ExistentialQuantification,\n             FlexibleInstances, MultiParamTypeClasses,\n             ScopedTypeVariables, TypeApplications #-}\n\nimport GHC.OverloadedLabels\nimport GHC.Records\n\ndata S = MkS { foo :: Int }\ndata T x y z = forall b . MkT { foo :: y, bar :: b }\n\ninstance HasField x r a => IsLabel x (r -> a) where\n  fromLabel = getField @x\n\nmain = do print (#foo (MkS 42))\n          print (#foo (MkT True False))\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Basic tests of overloaded labels\n\n{-# LANGUAGE OverloadedLabels\n           , DataKinds\n           , FlexibleContexts\n           , FlexibleInstances\n           , MultiParamTypeClasses\n           , NoMonomorphismRestriction\n  #-}\n\nimport GHC.OverloadedLabels\n\ninstance IsLabel \"true\" Bool where\n  fromLabel = True\n\ninstance IsLabel \"false\" Bool where\n  fromLabel = False\n\na :: IsLabel \"true\" t => t\na = #true\n\nb = #false\n\nc :: Bool\nc = #true\n\nmain = do print (a :: Bool)\n          print (b :: Bool)\n          print c\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Using overloaded labels to provide nice syntactic sugar for a\n-- term representation using de Bruijn indices\n\n{-# LANGUAGE OverloadedLabels\n           , DataKinds\n           , FlexibleContexts\n           , FlexibleInstances\n           , GADTs\n           , KindSignatures\n           , MultiParamTypeClasses\n           , NoMonomorphismRestriction\n           , OverlappingInstances\n           , ScopedTypeVariables\n           , StandaloneDeriving\n           , TypeOperators\n  #-}\n\nimport GHC.OverloadedLabels\nimport Data.Proxy ( Proxy(..) )\nimport GHC.TypeLits ( Symbol )\n\ninstance x ~ y => IsLabel x (Proxy y) where\n  fromLabel = Proxy\n\ndata Elem (x :: Symbol) g where\n  Top :: Elem x (x ': g)\n  Pop :: Elem x g -> Elem x (y ': g)\nderiving instance Show (Elem x g)\n\n\nclass IsElem x g where\n  which :: Elem x g\n\ninstance IsElem x (x ': g) where\n  which = Top\n\ninstance IsElem x g => IsElem x (y ': g) where\n  which = Pop which\n\n\ndata Tm g where\n  Var :: Elem x g -> Tm g\n  App :: Tm g -> Tm g -> Tm g\n  Lam :: Tm (x ': g) -> Tm g\nderiving instance Show (Tm g)\n\ninstance IsElem x g => IsLabel x (Tm g) where\n  fromLabel = Var (which :: Elem x g)\n\nlam :: Proxy x -> Tm (x ': g) -> Tm g\nlam _ = Lam\n\ns = lam #x #x\nt = lam #x (lam #y (#x `App` #y))\n\nu :: IsElem \"z\" g => Tm g\nu = #z `App` #z\n\nmain = do print s\n          print t\n          print (u :: Tm '[\"z\"])\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Using overloaded labels as strings, slightly pointlessly\n\n{-# LANGUAGE OverloadedLabels\n           , DataKinds\n           , FlexibleContexts\n           , FlexibleInstances\n           , MultiParamTypeClasses\n           , ScopedTypeVariables\n           , TypeFamilies\n           , TypeSynonymInstances\n  #-}\n\nimport GHC.OverloadedLabels\nimport Data.Proxy ( Proxy(..) )\nimport GHC.TypeLits ( KnownSymbol, symbolVal )\n\ninstance (KnownSymbol x, c ~ Char) => IsLabel x [c] where\n  fromLabel = symbolVal (Proxy :: Proxy x)\n\nmain = do putStrLn #x\n          print $ #x ++ #y\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLabels, TemplateHaskell #-}\n\nimport OverloadedLabelsRun04_A\n\n-- Who knew that there were so many ways that a line could start with\n-- a # sign in Haskell? None of these are overloaded labels:\n#line 7 \"overloadedlabelsrun04.hs\"\n# 8 \"overloadedlabelsrun04.hs\"\n#!notashellscript\n#pragma foo\n\n-- But this one is:\n#foo\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TemplateHaskell #-}\nmodule OverloadedLabelsRun04_A where\n\nimport GHC.OverloadedLabels\nimport Language.Haskell.TH\n\ninstance IsLabel x (Q [Dec]) where\n  fromLabel = [d| main = putStrLn \"Ok\" |]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that unambiguous constructions remain valid when\n-- DuplicateRecordFields is enabled\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\ndata S = MkS { x :: Int }\n  deriving Show\n\ndata T = MkT { x :: Bool, y :: Bool -> Bool, tField :: Bool }\n\ndata U a = MkU { x :: a, y :: a }\n\n-- Construction is unambiguous\ns = MkS { x = 42 }\nt = MkT { x = True, y = id, tField = False }\n\n-- Pattern matching is unambiguous\nget_x MkS{x=x} = x\n\n-- Resolving ambiguous monomorphic updates\na = t { x = False, y = not, tField = True } -- only T has all these fields\nb = s { x = 3 } :: S         -- type being pushed in\nc = (t :: T) { x = False }   -- type signature on record expression\n\n-- Unambiguous selectors are in scope normally\nz = tField t\n\nmain = print (get_x b)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This module does not enable -XDuplicateRecordFields, but it should\n-- still be able to refer to non-overloaded fields like `y`\n\nimport OverloadedRecFldsRun02_A\n\nmain = print (y u)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n\nmodule OverloadedRecFldsRun02_A (U(..), V(MkV, x), Unused(..), u) where\n\ndata U = MkU { x :: Bool, y :: Bool }\ndata V = MkV { x :: Int }\ndata Unused = MkUnused { unused :: Bool }\n\nu = MkU False True\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that DuplicateRecordFields can be used along with\n-- TypeFamilies (with selectors only if unambiguous)\n\n{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}\n\ndata family F a\n\ndata instance F Int  = MkFInt  { foo :: Int }\ndata instance F Bool = MkFBool { bar :: Bool, baz :: Bool }\n\n\ndata family G a\n\ndata instance G Int = MkGInt { foo :: Int }\ndata instance G Bool = MkGBool { bar :: Bool }\n\nx = MkFBool { bar = False, baz = True }\n\ny :: F Bool\ny = x { bar = True }\n\nget_bar MkFBool{bar=bar} = bar\n\nmain = do print (baz y)\n          print (get_bar y)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that DuplicateRecordFields works with TemplateHaskell\n\n{-# LANGUAGE DuplicateRecordFields, TemplateHaskell #-}\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\n-- Splice in a datatype with field...\n$(return [DataD [] (mkName \"R\") [] Nothing\n  [RecC (mkName \"MkR\") [( mkName \"foo\"\n                        , Bang NoSourceUnpackedness NoSourceStrictness\n                        , ConT ''Int\n                        )]] []])\n\n-- New TH story means reify only sees R if we do this:\n$(return [])\n\n-- ... and check that we can inspect it\nmain = do  putStrLn $(do { info <- reify ''R\n                         ; case info of\n                             TyConI (DataD _ _ _ _ [RecC _ [(n, _, _)]] _) ->\n                                 do { info' <- reify n\n                                    ; lift (pprint info ++ \"\\n\" ++ pprint info')\n                                    }\n                             _ -> error \"unexpected result of reify\"\n                         })\n           putStrLn $(do { info <- reify 'foo\n                         ; case info of\n                             VarI n _ _ ->\n                                 do { info' <- reify n\n                                    ; lift (pprint info ++ \"\\n\" ++ pprint info')\n                                    }\n                         })\n           print (foo (MkR { foo = 42 }))\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that DuplicateRecordFields works with NamedFieldPuns and\n-- RecordWildCards\n\n{-# LANGUAGE DuplicateRecordFields, NamedFieldPuns, RecordWildCards #-}\n\ndata S = MkS { foo :: Int }\n  deriving Show\ndata T = MkT { foo :: Int }\n  deriving Show\n\nf MkS{foo} = MkT{foo}\n\ng MkT{..} = MkS{..}\n\nh e = let foo = 6 in e { foo } :: S\n\nmain = do print a\n          print b\n          print c\n          print d\n  where\n    foo = 42\n\n    a = MkS{foo}\n    b = f a\n    c = g b\n    d = h c\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that ambiguous selectors can be disambiguated by providing\n-- type signatures in various places\n\n{-# LANGUAGE DuplicateRecordFields #-}\n\ndata S = MkS { x :: Int }\ndata T = MkT { x :: Bool }\ndata U a = MkU { x :: a }\n\nx_for_s :: S -> Int\nx_for_s = x\n\nx_for_t = x :: T -> Bool\n\nx_for_u u = x (u :: U Int)\n\nk :: (T -> Bool) -> Bool\nk f = f (MkT True)\n\nmain = do print (x_for_s (MkS 42))\n          print (k x)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds\n           , PolyKinds\n           , FlexibleContexts\n           , FlexibleInstances\n           , GADTs\n           , MultiParamTypeClasses\n           , OverloadedLabels\n           , ScopedTypeVariables\n           , TypeApplications\n           , TypeOperators\n           , UndecidableInstances\n  #-}\n\nimport GHC.OverloadedLabels\nimport GHC.Records\nimport GHC.TypeLits\nimport Data.Kind\n\ndata Label (x :: Symbol) = Label\ndata Labelled x a = Label x := a\n\ndata Rec :: forall k. [(k, Type)] -> Type where\n  Nil  :: Rec '[]\n  (:>) :: Labelled x a -> Rec xs -> Rec ('(x, a) ': xs)\ninfixr 5 :>\n\ninstance {-# OVERLAPS #-} a ~ b => HasField foo (Rec ('(foo, a) ': xs)) b where\n  getField ((_ := v) :> _) = v\n\ninstance HasField foo (Rec xs) b => HasField foo (Rec ('(bar, a) ': xs)) b where\n  getField (_ :> vs) = getField @foo vs\n\ninstance y ~ x => IsLabel y (Label x) where\n  fromLabel = Label\n\ninstance HasField x r a => IsLabel x (r -> a) where\n  fromLabel = getField @x\n\nx :: Rec '[ '(\"foo\", Int), '(\"bar\", Bool)]\nx = #foo := 42 :> #bar := True :> Nil\n\ny = #bar := 'x' :> undefined\n\nmain = do print (#foo x)\n          print (#bar x)\n          print (#bar y)\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that DuplicateRecordFields doesn't affect the metadata\n-- generated by GHC.Generics or Data.Data\n\n-- Based on a Stack Overflow post by bennofs\n-- (http://stackoverflow.com/questions/24474581)\n-- licensed under cc by-sa 3.0\n\n{-# LANGUAGE DuplicateRecordFields #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE TypeFamilies #-}\n\nimport GHC.Generics\nimport Data.Data\nimport Data.Proxy\nimport Data.Kind\n\ntype family FirstSelector (f :: Type -> Type) :: Meta\ntype instance FirstSelector (M1 D x f) = FirstSelector f\ntype instance FirstSelector (M1 C x f) = FirstSelector f\ntype instance FirstSelector (a :*: b)  = FirstSelector a\ntype instance FirstSelector (M1 S s f) = s\n\ndata SelectorProxy (s :: Meta) (f :: Type -> Type) a = SelectorProxy\ntype SelectorProxy' (s :: Meta) = SelectorProxy s Proxy ()\n\n-- Extract the first selector name using GHC.Generics\nfirstSelectorName :: forall a. Selector (FirstSelector (Rep a))\n                  => Proxy a -> String\nfirstSelectorName _ =\n    selName (SelectorProxy :: SelectorProxy' (FirstSelector (Rep a)))\n\n-- Extract the list of selector names for a constructor using Data.Data\nselectorNames :: Data a => a -> [String]\nselectorNames = constrFields . toConstr\n\ndata T = MkT { foo :: Int } deriving (Data, Generic)\ndata U = MkU { foo :: Int, bar :: Bool } deriving (Data, Generic)\n\nmain = do -- This should yield \"foo\", not \"$sel:foo:MkT\"\n          print (firstSelectorName (Proxy :: Proxy T))\n          -- Similarly this should yield \"foo\"\n          print (firstSelectorName (Proxy :: Proxy U))\n          -- This should yield [\"foo\"]\n          print (selectorNames (MkT 3))\n          -- And this should yield [\"foo\",\"bar\"]\n          print (selectorNames (MkU 3 True))\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes\n           , DataKinds\n           , ExplicitForAll\n           , KindSignatures\n           , OverloadedLabels\n           , RebindableSyntax\n           , ScopedTypeVariables\n           , ImplicitPrelude\n  #-}\n\nimport GHC.TypeLits (Symbol, KnownSymbol, symbolVal)\nimport Data.Proxy\n\nfoo = #foo\n  where\n    fromLabel :: forall (x :: Symbol) . ()\n    fromLabel = ()\n\nbar = #bar\n  where\n    fromLabel :: forall (x :: Symbol) . KnownSymbol x => String\n    fromLabel = symbolVal (Proxy :: Proxy x)\n\nmain = do print foo\n          print bar\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n\nmain = print $ \"hello\" ++ \" world.\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package01 where\nimport Map\nimport Data.Set\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package01e where\nimport Data.Map\nimport Data.IntMap\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package02 where\nimport Data.Map\nimport Map\nimport Data.Set\nimport Data.IntMap\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package03 where\nimport Data.Map\nimport Map\nimport Data.Set\nimport Data.IntMap\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package04 where\nimport Data.Map\nimport Map\nimport Data.Set\nimport Data.IntMap\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package05 where\nimport HsTypes\nimport MyHsTypes\nimport HsUtils\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package06 where\nimport MyHsTypes\nimport HsUtils\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package06e where\nimport HsTypes\nimport UniqFM\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package07e where\nimport MyHsTypes\nimport HsTypes\nimport HsUtils\nimport UniqFM\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package08e where\nimport MyHsTypes\nimport HsTypes\nimport HsUtils\nimport UniqFM\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package09e where\nimport M\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Package10 where\nx = emptyUFM\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Map\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Map\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing handling of troublesome constructor name (:::)\nmodule Read006 (MyList(Empty, (:::))) where\n\ndata MyList a =   Empty\n                | (MyList a) ::: (MyList a)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nimport Read006\n\nmyLength :: MyList a -> Int\nmyLength Empty = 0\nmyLength (x ::: xs) = 1 + myLength xs\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BlockArguments #-}\n\nmodule BlockArguments where\n\nimport Control.Monad\n\nfoo :: IO ()\nfoo = when True do\n  return ()\n\nfoo' :: IO ()\nfoo' = do\n  forM [1 .. 10] \\x ->\n    print x\n\n  forM [1 .. 10] \\x -> do\n    print x\n    print x\n\n  return ()\n\nfoo'' :: IO ()\nfoo'' = when\n  do True\n  do return ()\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BlockArguments, LambdaCase #-}\n\nmodule BlockArgumentsLambdaCase where\n\nimport Control.Monad\n\nfoo' :: IO ()\nfoo' = do\n  forM [Just 3, Nothing] \\case\n    Just 3 -> print 3\n    _ -> print 5\n\n  return ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do\n  -- force an \"unrecognized pragma\" warning\n  -- to check if the column number is correct\n  {-# COLUMN 1000 #-}print \"Hello\"  {-# NONEXISTENTPRAGMA #-}\n  print \"world\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE DoAndIfThenElse #-}\n\nmodule DoAndIfThenElse where\n\nfoo :: IO ()\nfoo = do if True\n         then return ()\n         else return ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies\n             , TypeApplications, TypeInType #-}\n\nmodule DumpParsedAst where\nimport Data.Kind\n\ndata Peano = Zero | Succ Peano\n\ntype family Length (as :: [k]) :: Peano where\n  Length (a : as) = Succ (Length as)\n  Length '[]      = Zero\n\n-- vis kind app\ndata T f (a :: k) = MkT (f a)\n\ntype family F1 (a :: k) (f :: k -> Type) :: Type where\n  F1 @Peano a f = T @Peano f a\n\nmain = putStrLn \"hello\"\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, GADTs, PolyKinds, RankNTypes, TypeOperators,\n             TypeFamilies, StarIsType, TypeApplications #-}\n\nmodule DumpRenamedAst where\nimport Data.Kind\n\nimport Data.Kind (Type)\n\ndata Peano = Zero | Succ Peano\n\ntype family Length (as :: [k]) :: Peano where\n  Length (a : as) = Succ (Length as)\n  Length '[]      = Zero\n\ndata family Nat :: k -> k -> Type\n-- Ensure that the `k` in the type pattern and `k` in the kind signature have\n-- the same binding site.\nnewtype instance Nat (a :: k -> Type) :: (k -> Type) -> Type where\n  Nat :: (forall xx. f xx -> g xx) -> Nat f g\n\ndata T f (a :: k) = MkT (f a)\n\ntype family F1 (a :: k) (f :: k -> Type) :: Type where\n  F1 @Peano a f = T @Peano f a\n\nmain = putStrLn \"hello\"\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies\n             , TypeApplications #-}\n\nmodule DumpTypecheckedAst where\nimport Data.Kind\n\ndata Peano = Zero | Succ Peano\n\ntype family Length (as :: [k]) :: Peano where\n  Length (a : as) = Succ (Length as)\n  Length '[]      = Zero\n\ndata T f (a :: k) = MkT (f a)\n\ntype family F (a :: k) (f :: k -> Type) :: Type where\n  F @Peano a f = T @Peano f a\n\nmain = putStrLn \"hello\"\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where {\n\nf x = x;\n;\n;\ng y z = z;\n\nmain = print (g (f False) (f True));\n}\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE UnboxedSums #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule KindSigs where\n\nimport Data.Kind\n\n-- Kind annotation on type family instance equation\ntype family Foo a where\n  Foo a = Int :: Type\n\n-- Kind annotation on component of tuple type\ntype Bar a = ( Int :: Type, Bool, Maybe a :: Type )\ntype Bar' a = (# Int :: Type, Bool, Maybe a :: Type #)\n\n-- Kind annotation on type of list\ntype Baz = [ Int :: Type ]\n\n-- Kind annotation inside paren type\nqux :: (Int :: Type) -> Bool -> (() :: Type)\nqux _ _ = ()\n\n-- Kind annotation on promoted lists and tuples\ntype Quux = '[ True :: Bool ]\ntype Quux' = [ True :: Bool, False :: Bool  ]\ntype Quuux b = '( [Int, Bool] :: [Type], b )\n\n-- Kind annotation on the RHS of a type synonym\ntype Sarsaparilla = Int :: Type\n\n-- Note that 'true :: Bool :: Type' won't parse - you need some parens\ntrue :: (Bool :: Type)\ntrue = True\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MonadComprehensions, ParallelListComp #-}\n\nmodule Foo where\n\nimport Control.Monad.Zip\n\nfoo :: MonadZip m => m ()\nfoo = [ ()\n      | () <- foo\n      | () <- foo\n      ]\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule Foo where\n\nimport Data.List\nimport GHC.Exts\n\nfoo = [ ()\n      | x <- [1..10]\n      , then take 5\n      , then sortWith by x\n      , then group by x using groupWith\n      , then group using inits\n      , then group by x using groupWith\n      ]\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NoBlockArguments where\n\n-- Make sure things parse normally\nf  :: a -> a\nf = id\n\nfoo :: [Int]\nfoo = f [x | x <- [1 .. 10]]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NondecreasingIndentation #-}\n\nmodule ShouldCompile where\n\nf :: IO ()\nf = do if True then f else do\n       f\n       if True then f else do\n       f\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\n\nmodule ParserLambdaCase where\n\nf1 = \\case \"1\" -> 1\nf2 = \\ {- comment1 {- comment2 -} -} case \"1\" -> 1; \"2\" -> 2\nf3 = \\ -- comment\n       case \"1\" -> 1\n            \"2\" -> 2\nf4 = \\casex -> casex\nf5 = \\ case { \"1\" -> 1; \"2\" -> 2 }\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests that when the StaticPointers extension is not enabled\n-- the static identifier can be used as a regular Haskell\n-- identifier.\nmodule RdrNoStaticPointers01 where\n\nf :: Int -> Int\nf static = static\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! import qualified Prelude should leave (), [] etc in scope\n\nmodule ShouldCompile where\n\nimport qualified Prelude\n\nf :: Prelude.IO ()\nf = Prelude.return ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! tests fixity reading and printing\nmodule ShouldCompile where\n\ninfixl 1 `f`\ninfixr 2 \\\\\\\ninfix  3 :==>\ninfix  4 `MkFoo`\n\ndata Foo = MkFoo Int | Float :==> Double\n\nx `f` y = x\n\n(\\\\\\) :: (Eq a) => [a] -> [a] -> [a]\n(\\\\\\) xs ys =  xs\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing layout rule\nmodule ShouldCompile where\n\nl1 :: IO ()\nl1 = do\n  return a\n  where\n   a = ()\n\nl2 :: IO ()\nl2 = do\n  return a\n where\n  a = ()\n\nl3 :: IO ()\nl3 = do\n  return a\n   where\n   a = ()\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n{-\nFrom: Kevin Hammond <kh>\nTo: partain\nSubject: Re:  parsing problem w/ queens\nDate: Wed, 9 Oct 91 17:31:46 BST\n\nOK, I've fixed that little problem by disallowing,\n-}\n\nf x = x + if True then 1 else 2\ng x = x + 1::Int\n\n-- (the conditional/sig need to be parenthesised).  If this is\n-- problematic, let me know!\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- !!! Empty comments terminating a file..\nmain = print \"Hello\" --\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n{-# SPECIALISE f :: Int -> Int #-}\nf n = n + 1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! combining undeclared infix operators\nmodule ShouldCompile where\n\n-- should default to 'infixl 9'\n\ntest = let f x y = x+y in 1 `f` 2 `f` 3\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Infix record constructor.\nmodule ShouldCompile where\n\ndata Rec = (:<-:) { a :: Int, b :: Float }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! do & where interaction\nmodule ShouldCompile where\n\nf1 :: IO a -> IO [a]\nf1 x = do\n  v <- x\n  return [v]\n where\n  g x = [x,x]\n\nf2 :: IO a -> IO [a]\nf2 x = do\n  v <- x\n  return (g v)\n   where\n    g x = [x,x]\n\nf3 :: IO a -> IO [a]\nf3 x = do\n  v <- x\n  return (g v)\n  where\n   g x = [x,x]\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Empty export lists are legal (and useful.)\nmodule ShouldCompile () where\n\nng1 x y = negate y\n\ninstance (Num a, Num b) => Num (a,b)\n  where\n   negate (a,b) = (ng 'c' a, ng1 'c' b)   where  ng x y = negate y\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Testing whether the parser likes empty declarations..\nmodule ShouldCompile where { ;;;;;x=let{;;;;;y=2;;;;}in y;;;;;}\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that both import lists and 'hiding' lists might\n-- !!! be empty.\nmodule ShouldCompile where\n\nimport Data.List  ()\nimport Data.List  hiding ()\n\nx :: Int\nx = 1\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that empty declarations are permitted.\nmodule ShouldCompile where\n\n\nclass Foo a where\n\nclass Foz a\n\nx = 2 where \ny = 3\n\ninstance Foo Int where\n\nf = f where g = g where\ntype T = Int\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\n-- !!! Checking that empty contexts are permitted.\nmodule ShouldCompile where\n\ndata () => Foo a = Foo a\n\nnewtype () => Bar = Bar Int\n\nf :: () => Int -> Int\nf = (+1)\n\n\nclass () => Fob a where\n\ninstance () => Fob Int where\ninstance () => Fob Float\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking what's legal in the body of a class declaration.\nmodule ShouldCompile where\n\nclass Foo a where {\n  (--<>--) :: a -> a -> Int  ;\n  infixl 5 --<>-- ;\n  (--<>--) _ _ = 2 ; -- empty decl at the end.\n};\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Empty export list\n\nmodule ShouldCompile() where\n\ninstance Show (a->b) where\n  show f = \"<<function>>\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule ShouldCompile where\n\nf (x :: Int) = x + 1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- M.<keyword> isn't a qualified identifier\nf  = Just.let x=id in x\n\n-- ---------------------------------------------------------------------------\n-- we changed the behaviour of this one in GHC, but the following test\n-- is strictly speaking legal Haskell:\n\n-- f' = Just.\\1 where (.\\) = ($)\n\n-- -----------------------------------------------------\n-- M.{as,hiding,qualified} *are* qualified identifiers:\n\ng  = ShouldCompile.as\n\n-- ---------------------------------------------------------------------------\n-- special symbols (!, -) can be qualified to make varids.\n\ng' = (ShouldCompile.!)\n\nas x = x\n(!) x = x\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! checking that special ids are correctly handled.\nmodule ShouldCompile where\n\nas :: [as]\nas = [head as]\n\nqualified :: [qualified]\nqualified = [head qualified]\n\nhiding :: [hiding]\nhiding = [head hiding]\n\nexport :: [export]\nexport = [head export]\n\nlabel :: [label]\nlabel = [head label]\n\ndynamic :: [dynamic]\ndynamic = [head dynamic]\n\nunsafe :: [unsafe]\nunsafe = [head unsafe]\n\ninterruptible :: [interruptible]\ninterruptible = [head interruptible]\n\nstdcall :: [stdcall]\nstdcall = [head stdcall]\n\nccall :: [ccall]\nccall = [head ccall]\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check the handling of 'qualified' and 'as' clauses\nmodule ShouldCompile where\n\nimport Data.List as L ( intersperse ) \n\nx = L.intersperse\n\ny = intersperse\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nimport Prelude hiding ((<>))\n\n(<>)          :: (a -> Maybe b) -> (b -> Maybe c) -> (a -> Maybe c)\n(m1 <> m2) a1   =  case m1 a1 of\n                      Nothing -> Nothing\n                      Just a2 -> m2 a2\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ninfix 5 |- \ninfix 9 :=\n\ndata Equal = Char := Int\n\n-- fails in GHC (all versions), due to not doing fixity resolution on\n-- the lhs before deciding which is the function symbol.\n\n(|-) :: Int -> Equal -> Bool\n0 |- x:=y = 1 |- x:=y      -- XXX fails here\n2 |- (x:=y) = 0 |- x:=y\n_ |-  _     = False  \n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ndata T a b = (:^:) a b\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Special Ids and ops\n\n-- The special ids 'as', 'qualified' and 'hiding' should be\n-- OK in both qualified and unqualified form.\n-- Ditto special ops\n\nmodule ShouldCompile where\nimport Prelude hiding ( (-) )\n\nas        = ShouldCompile.as\nhiding    = ShouldCompile.hiding\nqualified = ShouldCompile.qualified\nx ! y     = x ShouldCompile.! y\nx - y     = x ShouldCompile.- y\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Infix decls w/ infix data constructors\n\n-- GHC used to barf on this...\n\nmodule ShouldCompile where\n\ninfix 2 |-, |+\n\nps  |-  q:qs   = undefined\nps  |+  p:q:qs = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! \"--\" can start a legal lexeme \n\nmodule ShouldCompile where\n\ninfix 2 --+, -->\n\nps  -->  True   = True\n\n(--+) a b = a && b \n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- !!! Record declarations with zero fields are allowed\ndata Foo = Foo{}\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nx = const 1.0e+x where e = 3\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\n-- !!! Section precedences\n\n-- infixl 6  +, -\n-- infixr 5  ++, :\n\nf = (++ [] ++ [])\ng = (3 + 4 +)\n\n-- prefix negation is like infixl 6.\nh x = (-x -)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\nf :: Double\nf = 42e42  -- this should be a float\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module\u00c2\u00a0ShouldCompile\u00c2\u00a0where\n\n--\u00c2\u00a0This\u00c2\u00a0file\u00c2\u00a0contains\u00c2\u00a0several\u00c2\u00a0non-breaking\u00c2\u00a0space\u00c2\u00a0characters,\n--\u00c2\u00a0aka\u00c2\u00a0'\\xa0'.\u00c2\u00a0\u00c2\u00a0The\u00c2\u00a0compiler\u00c2\u00a0should\u00c2\u00a0recognise\u00c2\u00a0these\u00c2\u00a0as\u00c2\u00a0whitespace.\n\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\u00c2\u00a0\nf\u00c2\u00a0=\u00c2\u00a0(\u00c2\u00a0+\u00c2\u00a0)\u00c2\u00a0\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\na ---> b = a + a\nfoo = 3\n ---> 4\n ---> 5\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, CPP #-}\n-- Test the LANGUAGE pragma\nmodule ShouldCompile where\n\n#if 1\nforeign import ccall \"foo\" foo :: Int -> IO Int\n#endif\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n-- A type signature on the LHS of a do-stmt was a parse\n-- error in 6.4.2, but ok thereafter\n\nmodule ShouldCompile where\n\nf () = do { x :: Bool <- return True\n          ; return x }\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests trac #210.\n\nmodule ShouldCompile where\n\n\\begin{code}\n  main = foo\n\\end{code}\n\n> foo = putStrLn \"Foo\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XBangPatterns #-}\n\n-- Various bang-pattern and lazy-pattern tests\n\nmodule ShouldCompile where\n\nmain1,main2,main3,main4,main5,main6,main7 :: IO ()\n\nmain1 = do\n    !c <- return ()\n    return ()\n\nmain2 = return () >>= \\ !c -> return ()\n\nmain3 = do\n    (!c) <- return ()\n    return ()\n\nmain4 = return () >>= \\ (!c) -> return ()\n\nmain5 = let !x = 1 in return ()\n\nmain6 = do\n    ~c <- return ()\n    return ()\n\nmain7 = return () >>= \\ ~c -> return ()\n\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS -fwarn-tabs #-}\n\n-- Check we get a warning for tabs\n\nmodule ShouldCompile where\n\ntab1\t= 'a'\nnotab   = 'b'\ntab2\t= 'c'\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test case from #1091\nmain =\n          case True of {- | -}\n            True  -> putStrLn \"Hello World\\n\"\n            False {- | -} -> putStrLn \"Goodbye Cruel World\\n\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{\nmain =\nputStr \"hello\";\n}\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XMagicHash #-}\n\nmodule Foo where\n\nfoo# = 'a'\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash #-}\n\nmodule Foo where\n\nfoo# = 'a'\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XEmptyDataDecls #-}\n\nmodule Foo where\n\ndata Foo\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE EmptyDataDecls #-}\n\nmodule Foo where\n\ndata Foo\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XKindSignatures #-}\n\nmodule Foo where\n\nimport Data.Kind (Type)\n\ndata Foo (a :: Type) = Foo a\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE KindSignatures #-}\n\nmodule Foo where\n\nimport Data.Kind (Type)\n\ndata Foo (a :: Type) = Foo a\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XMultiParamTypeClasses #-}\n\nmodule Foo where\n\nclass Foo a b\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule Foo where\n\nclass Foo a b\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XParallelListComp #-}\n\nmodule Foo where\n\nfoo = [ ()\n      | () <- foo\n      | () <- foo\n      ]\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE ParallelListComp #-}\n\nmodule Foo where\n\nfoo = [ ()\n      | () <- foo\n      | () <- foo\n      ]\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XGeneralizedNewtypeDeriving #-}\n\nmodule Foo where\n\nclass C a\ninstance C Int\n\nnewtype Foo = Foo Int\n    deriving C\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule Foo where\n\nclass C a\ninstance C Int\n\nnewtype Foo = Foo Int\n    deriving C\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XRecursiveDo #-}\n\nmodule Foo where\n\nimport Control.Monad.Fix\n\nz :: Maybe [Int]\nz = mdo x <- return (1:x)\n        return (take 4 x)\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE RecursiveDo #-}\n\nmodule Foo where\n\nimport Control.Monad.Fix\n\nz :: Maybe [Int]\nz = mdo x <- return (1:x)\n        return (take 4 x)\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XFunctionalDependencies #-}\n{-# OPTIONS_GHC -XMultiParamTypeClasses #-}\n\nmodule Foo where\n\nclass Foo a b | a -> b\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE FunctionalDependencies #-}\n{-# OPTIONS_GHC -XMultiParamTypeClasses #-}\n\nmodule Foo where\n\nclass Foo a b | a -> b\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule Foo where\n\nimport Data.List\nimport GHC.Exts\n\nfoo = [ ()\n      | x <- [1..10]\n      , then take 5\n      , then sortWith by x\n      , then group by x using groupWith\n      , then group using inits\n      , then group by x using groupWith\n      ]\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\n--module Foo where\n\nimport GHC.Exts\n\n--you can use this if you want to test running it...\nmain = print (I# (\n      f1pat 1# +# f1prepat 1#\n   +# f2pat 1# +# f2prepat 1#\n   +# f3pat 1# +# f3prepat 1#\n  ))\n\n--unboxed tuples are of sizes 1,2,3...\n--(normal tuples are 0,2,3...)\n\n--make sure it's really the _unboxed_ tuples\n--being used by putting unboxed values in,\n--which are forbidden in boxed tuples\n\nf1 :: Int# -> (# Int# #)\nf1 i = (# i #)\n-- a space is needed in (# #) so that it's not\n-- lexed/parsed as an operator named \"##\"\n--(even though the error message about mismatched\n--kinds for \"instance Functor (# #)\" names the type\n--as \"(##)\"\n--  Kind mis-match\n--  Expected kind `* -> *', but `(##)' has kind `? -> (#)'\n--  In the instance declaration for `Functor (##)'\nf1prefix :: Int# -> (# #)\nf1prefix i = (# #)\n--test that prefix and non-prefix versions\n--are the same type by switching the case-argument\nf1pat a = case f1prefix a of (# #) -> 1#\nf1prepat a = case f1 a of (# i #) -> i +# 1#\n\nf2 :: Int# -> (# Int#, Int# #)\nf2 i = (# i, i #)\nf2prefix :: Int# -> (#,#) Int# Int#\nf2prefix i = (#,#) i i\nf2pat a = case f2prefix a of (# i, j #) -> i +# j\nf2prepat a = case f2 a of (#,#) i j -> i +# j\n\nf3 :: Int# -> (# Int#, Int#, Int# #)\nf3 i = (# i, i, i #)\nf3prefix :: Int# -> (#,,#) Int# Int# Int#\nf3prefix i = (#,,#) i i i\nf3pat a = case f3prefix a of (# i, j, k #) -> i +# j +# k\nf3prepat a = case f3 a of (#,,#) i j k -> i +# j +# k\n\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\n{-# THISISATYPO foo #-}\nfoo :: ()\nfoo = ()\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_NO_SUCH_PRAGMA --no-such-flag #-}\n\n-- We should parse the above as an unrecognised pragma, not as an OPTIONS\n-- pragma containing \"_NO_SUCH_PRAGMA -wibble\". Trac #2847.\n\nmodule Test where\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_HUGS --some-hugs-flag #-}\n\n-- We should ignore the above pragma, as we recognise that it is\n-- hugs-specific. We shouldn't even warn about it.\n\nmodule Test where\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for trac #3079 - parsing fails if a LANGUAGE pragma straddles\n-- a 1024 byte boundary.\n-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n-- xxxxxxxxxxxxxxxxxxxxxxx\n-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n--\n--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n{-# LANGUAGE NoImplicitPrelude #-}\n\nimport Prelude\n\nmain :: IO ()\nmain = return ()\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RelaxedLayout #-}\n\nmodule ShouldFail where\n\nf x = case x of\n         False -> do\n    { return x; }\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Trac #1821\n\nmodule Par where\n\nf x = x\n  where\n-- ######### x86_64 machine code:\n    g y = y\n    h y = y\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies #-}\n\nmodule T10188 where\n\ndata Peano = Zero | Succ Peano\n\ntype family Length (as :: [k]) :: Peano where\n  Length (a : as) = Succ (Length as)\n  Length '[]      = Zero\n\ntype family Length' (as :: [k]) :: Peano where\n  Length' ((:) a as) = Succ (Length' as)\n  Length' '[]        = Zero\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10196 where\n\ndata X = X\u00e1\u00b5\u00a6 | X\u00e1\u00b5\u00a4 | X\u00e1\u00b5\u00a9 | X\u00e1\u00b5\u00a2 | X\u00e1\u00b5\u00aa | X\u00e1\u00b5\u00a3\n\nf :: Int\nf =\n  let x\u00e1\u00b5\u00a6 = 1\n      x\u00e1\u00b5\u00a4 = x\u00e1\u00b5\u00a6\n      x\u00e1\u00b5\u00a9 = x\u00e1\u00b5\u00a4\n      x\u00e1\u00b5\u00a2 = x\u00e1\u00b5\u00a9\n      x\u00e1\u00b5\u00aa = x\u00e1\u00b5\u00a2\n      x\u00e1\u00b5\u00a3 = x\u00e1\u00b5\u00aa\n  in x\u00e1\u00b5\u00a3\n\n-- Modifier letters are also allowed in the middle of an identifier.\n-- This should not be lexed as 2 separate identifiers.\nx\u00e1\u00b5\u00a6x :: Int\nx\u00e1\u00b5\u00a6x = 1\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, GADTs, DataKinds #-}\n{-# OPTIONS -Wno-star-is-type #-}\nmodule Foo where\n\ndata Foo1 :: [*] -> * where\n\n-- ghc <= 7.10 reported (before \"Add kind equalities to GHC\"):\n--\n--     T10379.hs:9:16: parse error on input \u00e2\u20ac\u02dc]\u00e2\u20ac\u2122\ndata Foo2 :: ([] *) -> * where\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\nmodule T10582 where\n\n(|:) :: Int -> Int -> Int\n(|:) = (+)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10855 where\n\nbool :: Int\nbool = - case 3 > 5 of False -> 0; True -> (-1)\nmain = print (- do 4)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T11622 where\n\nimport Data.Kind (Type)\n\ntype family F a where\n  F _ = Int :: Type\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language DataKinds             #-}\n{-# Language TypeApplications         #-}\n{-# Language PolyKinds             #-}\n\nmodule T12045e where\n\nimport Data.Kind\n\ndata Nat = Zero | Succ Nat\ndata T (n :: k) = MkT\ndata D1 n = T @Nat n :! ()\ndata D2 n = () :!! T @Nat n\ndata D3 n = T @Nat n :!!! T @Nat n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AlternativeLayoutRule #-}\n{-# LANGUAGE LambdaCase            #-}\n\nisOne :: Int -> Bool\nisOne = \\case 1 -> True\n              _ -> False\n\nmain = return ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13600a where\n\nf ! x = f !! x\n\nx = [1,2,3] ! 1\n  where\n    f ! x = f !! x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13600b where\n\nf !(Just x) = f !! x\nf !y = head f\n\nx = [1,2,3] ! Just 1\n  where\n    f !(Just x) = f !! x\n    f !y = head f\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GADTs #-}\n\nmodule T13747 where\n\nimport Data.Kind (Type)\n\nclass C a where\n  type family TC a :: Type\n\nclass D a where\n  data family TD a :: Type\n\ninstance C Int where\n  type instance TC Int = Int\n\ninstance D Double where\n  data instance TD Double = TDDouble\n\ninstance D Int where\n  newtype instance TD Int = TDInt Int\n\ninstance D Char where\n    data instance TD Char where\n        C1 :: TD Char\n        C2 :: TD Char\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14189\n  (\n  MyType (f,NT)\n  ) where\n\ndata MyType = MT Int | NT | F { f :: Int }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T15139 where\n\nimport Data.Type.Equality\n\ncan'tHappen :: Int :~: Bool\ncan'tHappen = undefined\n\nf1, f2, g :: Bool -> Bool\nf1 True = case can'tHappen of {}\nf2 True = case can'tHappen of\ng  True = case () of () -> True\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# OPTIONS_GHC -ddump-parsed-ast #-}\nmodule T15279 where\n\nfoo :: Char -> Char\n#include \"T15279.hs-incl\"\nfoo _ = 'a'\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs      #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T15323 where\n\ndata MaybeDefault v where\n    TestParens  :: (forall v . (Eq v) => MaybeDefault v)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\nmodule T15457 where\n\nimport Data.Type.Equality\n\ndata a ! b; infix 0 !\ndata a + b; infix 9 +\n\nfixityProof :: (Int ! Int + Int) :~: (Int ! (Int + Int))\nfixityProof = Refl\n\ndata Foo a b = MkFoo (a ! b) !Int !(Bool ! Bool)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, MultiParamTypeClasses, ExistentialQuantification #-}\n\nmodule T15675 where\n\nclass a + b\n\ndata D1 = forall a b. (a + b) => D1 a b\ndata D2 = forall a b.  a + b  => D2 a b\n\nclass a ! b\n\ndata D3 = forall a b. (a ! b) => D3 !a !b\ndata D4 = forall a b.  a ! b  => D4 !a !b\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\nmodule T15781 where\n\nimport Data.Kind\n\ntype F = Int :: Type\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitNamespaces, TypeOperators, RoleAnnotations #-}\n{-# OPTIONS -Wno-duplicate-exports #-}\n\nmodule T16339\n  (\n    type (!),\n    type (!)(Bang),\n    type (!)(..),\n    type (.),\n    type (.)(Dot),\n    type (.)(..),\n  ) where\n\ndata a ! b = Bang\ndata f . g = Dot\n\ntype role (!) phantom phantom\ntype role (.) phantom phantom\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "default (T)\n\ndata T = T deriving (Eq, Ord, Read, Show)\ninstance Num T\ninstance Fractional T\n\nmain = interact $ show . (< 1e400) . read", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3303 where\n\nimport T3303A\n\nbar :: Int\nbar = foo\n\nbar2 :: Int\nbar2 = foo2\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3303A where\n\n{-# DEPRECATED foo\n         [\"This is a multi-line\",\n          \"deprecation message\",\n          \"for foo\"] #-}\nfoo :: Int\nfoo = 4\n\n-- Empty list should work too (#11044).\n{-# DEPRECATED foo2 [] #-}\n\nfoo2 :: Int\nfoo2 = 4\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\u00e7\u00ac\u2018 :: Int\n\u00e7\u00ac\u2018 = 3\n\nmain = print \u00e7\u00ac\u2018\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "   { import T5243A; main = print bar }\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5243A where\nbar = True\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-}\n\nmodule T5682 where\n\nimport Data.Typeable\n\ndata a :+: b = Mk a b\ndata Foo = Bool :+: Bool\n\ntype X = True ':+: False\n\nderiving instance Typeable '(:+:)\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO (){-# LINE 8 \"\" #-}\nmain = print \"Hi\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T7776 where\n\nf :: Int -> Int -> Int\nf x y = let a ~# b = a + b\n        in x ~# y\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T8258 where\n\ndata T where\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\nmodule T808 where\n\nimport Data.Kind (Type)\n\nfoo :: (Int, Int :: Type)\nfoo = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS -fwarn-tabs #-}\n\n-- Check we get a warning for a single tab\n\nmodule ShouldCompile where\n\ntab1\t= 'a'\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS -fwarn-tabs #-}\n\n-- Check we get a warning for multiple tabs, with the correct number of tabs\n-- mentioned\n\nmodule ShouldCompile where\n\n-- tab in middle of line\ntab1\t= 'a'\n-- tab at end of line\ntab2 = 'b'\t\n-- two tabs in middle of line\ntab3\t\t= 'c'\n\ntab4 = if True\n-- tab at start of line\n\tthen 'd'\n-- tab at start of line\n\telse 'e'\n\n\t-- tab before a comment starts\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, RankNTypes, DataKinds, PolyKinds #-}\n\nmodule VtaParse where\n\nimport Data.Proxy\n\ndata Foo = Foo { first :: Int, second :: Bool} deriving Show\n\nf :: a -> b -> (a,b)\nf u v = (u, v)\n\ng :: Int -> Int -> (Int, Int)\ng u v = f @(Int) @Int u v\n\ndblTuple :: (a, b) -> ((a, b), b)\ndblTuple e@(_,y) = (e, y)\n\n\n-- interesting note:\n-- listpair :: forall a. [a] -> ([a], [a])\n-- therefore when explicitly applying, you do NOT put the type in \"[ ]\"\n\nlistpair :: [a] -> ([a], [a])\nlistpair [] = ([], [])\nlistpair b@(_:_) = (b, b)\n\n-- suggested two cases by R. Eisenberg\nnewtype N = MkN { unMkN :: forall a. Show a => a -> String }\nn = MkN show\nfoo :: Bool -> String\nfoo = unMkN n @Bool   -- Fails without parens! Not anymore!\n\n(&&) :: Bool -> Bool -> Bool\n(b@True) && True = True\n_ && _ = False\n\n(*@&) :: a -> a -> (a, a)\nx *@& y = (x, y)\n\n(@&) :: a -> a -> (a, a)\nx @& y = (x, y)\n\nmain :: IO ()\nmain = do\n         print $ g 5 12\n         print $ ((id @String (concat [\"hello \", \"world \", []])):\"Hamidhasan\":[])\n         print $ dblTuple @(Foo) @String ((Foo 5 True), \"hello\")\n         print $ listpair @(Maybe Int) [Just 12, Nothing]\n         print $ listpair @(Maybe Bool) $ (Just True) : (Just False) : (Nothing @Bool) : []\n         print $ dblTuple @Foo @[Maybe Int] ((Foo 7 False), ([Just 5, Nothing]))\n         print $ 12 @& 5\n\npro :: Proxy a -> ()\npro _ = ()\n\nx = pro @'True\n\n(@@) :: Int -> Int -> Int\n(@@) = (+)\n\nfive = 3 @@ 2\n\nsilly = pro {- hi! -}@Int\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Applicative\nmain = (pure 1 >>= print) <**> pure show\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ExportCommaComma (id, reverse,,) where\n\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = do\n  f $ do\n    a <- return 3\n      c <- do\n      return 5\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NoBlockArgumentsFail where\n\nimport Control.Monad\n\nfoo :: IO ()\nfoo = when True do\n  return ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NoBlockArgumentsFail2 where\n\nimport Control.Monad\n\nfoo :: IO ()\nfoo = forM [1 .. 10] \\x -> print x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\nmodule NoBlockArgumentsFail3 where\n\nimport Control.Monad\n\nfoo :: IO ()\nfoo = forM [1 .. 10] \\case\n  Just 3 -> print x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NoDoAndIfThenElse #-}\n\nmodule NoDoAndIfThenElse where\n\nfoo :: IO ()\nfoo = do if True\n         then return ()\n         else return ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NoNondecreasingIndentation #-}\n\nmodule ShouldCompile where\n\nf :: IO ()\nf = do if True then f else do\n       f\n       if True then f else do\n       f\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoNumericUnderscores #-}\n\n-- Test for NumericUnderscores extension.\n-- See Trac #14473\n-- This is a testcase for integer literal\n-- in NO NumericUnderscores extension.\n\nmodule NoNumericUnderscores0 where\n\nf :: Int -> ()\nf 1_000 = ()\nf _   = ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoNumericUnderscores #-}\n\n-- Test for NumericUnderscores extension.\n-- See Trac #14473\n-- This is a testcase for floating literal\n-- in NO NumericUnderscores extension.\n\nmodule NoNumericUnderscores1 where\n\nf :: Float -> ()\nf 1_000.0_1 = ()\nf _   = ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NoPatternSynonyms where\n\npattern P :: G Int\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NumericUnderscores #-}\n\n-- Test for NumericUnderscores extension.\n-- See Trac #14473\n-- This is a testcase for invalid case of NumericUnderscores.\n\nmain :: IO ()\nmain = do\n    print [\n            -- integer\n            1000000_,\n            _1000000\n          ]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NumericUnderscores #-}\n\n-- Test for NumericUnderscores extension.\n-- See Trac #14473\n-- This is a testcase for invalid case of NumericUnderscores.\n\nmain :: IO ()\nmain = do\n    print [\n            -- float\n            0_.0001,\n            _0.0001,\n            0.0001_,\n            0._0001,\n\n            -- float with exponent\n            1e_+23,\n            1e+23_,\n            1e+_23\n          ]\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ParserNoBinaryLiterals1 where\n\nf :: Int -> ()\nf 0b0 = ()\nf _   = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule ParserNoBinaryLiterals2 where\n\nimport GHC.Types\n\nf :: Word -> ()\nf (W# 0b0##) = ()\nf _          = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule ParserNoBinaryLiterals3 where\n\nimport GHC.Types\n\nf :: Int -> ()\nf (I# 0b0#) = ()\nf _         = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax #-}\n\nmodule ParserNoForallUnicode where\n\nid' :: \u00e2\u02c6\u20ac a . a \u00e2\u2020\u2019 a\nid' a = a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ParserNoLambdaCase where\n\nf = \\case \"1\" -> 1\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ParserNoMultiWayIf where\n\nx = 123\ny = if | x < 0     -> -1\n       | x == 0    -> 0\n       | otherwise -> 1\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T where\n\n-- We should get a parse error on column 33\n-- Indented with spaces:\nfoo = 123456                    module\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T where\n\n-- We should get a parse error on column 33\n-- Indented with tabs:\nfoo = 123456\t\t\tmodule\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! this module supposedly includes one of each Haskell construct\n\n-- HsImpExp stuff\n\nmodule OneOfEverything (\n        fixn,\n        FooData,\n        FooDataB(..),\n        FooDataC( .. ),\n        Tree(Leaf, Branch),\n        EqClass(..),\n        OrdClass(orda, ordb),\n        module OneC ,\n        module OneOfEverything\n    ) where\n\nimport Prelude\nimport System.IO ( putStr )\nimport System.Environment hiding ( getArgs )\nimport Control.Monad\n\n-- HsDecls stuff\n\ninfix   6 `fixn`\ninfixl  7 +#\ninfixr  8 `fixr`\n\nfixn x y = x\nfixl x y = x\nfixr x y = x\n\ntype Pair a b = (a, b)\n\ndata FooData = FooCon Int\n\ndata FooDataB = FooConB Double\n\ndata Tree a = Leaf a | Branch (Leaf a) (Leaf a)\n\nclass (Eq a) => EqClass a where\n    eqc :: a -> Char\n    eqc x = '?'\n\nclass (Ord a) => OrdClass a where\n    orda :: a -> Char\n    ordb :: a -> Char\n    ordc :: a -> Char\n\ninstance (Eq a) => EqClass (Tree a) where\n    eqc x = 'a'\n\ndefault (Integer, Rational)\n\n-- HsBinds stuff\n\nsinglebind x = x\n\nbindwith :: (OrdClass a, OrdClass b) => a -> b -> b\nbindwith a b = b\n\nreca a = recb a\nrecb a = reca a\n\n(~(a,b,c)) | nullity b  = a\n           | nullity c  = a\n           | otherwise  = a\n           where\n            nullity = null\n\n-- HsMatches stuff\n\nmat a b c d | foof a b = d\n            | foof a c = d\n            | foof b c = d\n            where\n                foof a b = a == b\n\n-- HsExpr stuff\nexpr a b c d\n  = a\n  + (:) a b\n  + (a : b)\n  + (1 - 'c' - \"abc\" - 1.293)\n  + ( \\ x y z -> x ) 42\n  + (9 *)\n  + (* 8)\n  + (case x of\n        [] | null x     -> 99\n           | otherwise  -> 98\n           | True       -> 97\n           where\n             null x = False\n    )\n  + [ z | z <- c, isSpace z ]\n  + let y = foo\n    in  y\n  + [1,2,3,4]\n  + (4,3,2,1)\n  + (4 :: Num a => a)\n  + (if 42 == 42.0 then 1 else 4)\n  + [1..]\n  + [2,4..]\n  + [3..5]\n  + [4,8..999]\n\n-- HsPat stuff\nf _ x 1 1.93 'c' \"dog\" ~y z@(Foo a b) (c `Bar` d) [1,2] (3,4) = y\n\n-- HsLit stuff -- done above\n\n-- HsTypes stuff\ng :: (Num a, Eq b) => Foo a -> [b] -> (a,a,a) -> b\ng x y z = head y\n", "num_lines": 114}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! newlines in strings aren't allowed\n\nf = \"\n\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Irrefutable patterns + guards\nmodule Read003 where\nimport GHC.List; import Prelude hiding (null)\n~(a,b,c) | nullity b    = a\n         | nullity c    = a\n         | otherwise    = a\n         where\n            nullity = null\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! string gaps\n-- !!!\nmodule Main(main) where\n\n-----------\n\nmain = putStr \"\\\n\n\\Some girls give me money\\n\\\n\n\\Some girls buy me clothes\\n\\\n\n\\...\"\n\n-----------\n\nmain2 = putStr \"\\\n\\ \\\n...\"\n\n-----------\n\nmain3 = putStr \"\\\n\n\\Some girls give me money\\n\\\n-- and here is a comment\n\\Some girls buy me clothes\\n\\\n\n\\...\"\n\n-----------\n\nmain3 = putStr \"\\\n{-\n    and here is a nested {- comment -}\n-}\n\\Some girls give me money\\n\\\n\n\\Some girls buy me clothes\\n\\\n\n\\...\"\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tests where\n\n-- this char is forbidden\nc = '\\&'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Using pattern syntax on RHS\nmodule ShouldFail where\n\nf :: Int -> Int\nf x = _\n\ng :: Int -> Int\ng x = 2 + 2@_\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Expressions as patterns inside do stmt blocks\nmodule ShouldFail where\n\nf :: Int -> IO Int\nf x = do\n  (2+2) <- 2\n  return x\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- strictness annotations on the argument to a newtype constructor\n-- are not allowed.\nnewtype N a = T ![a]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! Test for parse error in do/let expression\n\nfoo = do let foo = True\n             return ()\n\n\n-- Note the let binding at the end!\n-- This gave a pattern-match failure in tcStmts in ghc-4.04proto\n\nh x = x\n\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test line numbers in presence of string gaps.\n\nmain = print \"a\\\n             \\b\\\n             \\c\"\n\nwibble = = -- this is a parse error on line 7\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test parse errors due to tokens inserted by layout\n\n-- used to report \"Parse error on input `'\" in 4.04pl0.\n\nmain = let\n        f = (a,\n        g = 1\n        in f\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ReadFail013 where\n\n-- !!! unterminated ``\na = ``s``\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = f\n  where\n     f = f }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\n-- should fail; doesn't with happy 1.8.\nf = f where b = f\n            c = (b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Infix decls w/ infix data constructors\n\nmodule ShouldFail where\n\ninfix 6 |-\n\nps  |-  q:qs   = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- GHC < 5.01 used to get the line number wrong.\nf (f f) = f\n\ng = g\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! test the error message for an unterminated nested comment\n\n{-  <-- this one is unterminated (line 3)\n\n{-\n-}\n\n-- EOF\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cannot close an explicit layout context with a parse error\nmodule ShouldFail where\nf = let { x = 42 in x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! cannot close a layout context with an explicit close brace\nmodule ShouldFail where\nf = let x = 42 } in x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "", "num_lines": 1}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! a parenthesised lhs must have at least one parameter\n(a # b) = a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! Section precedences\n\n-- check that we're not translating out negative literals too early:\n-- the following should be an illegal section because prefix '-' has\n-- precedence 6:\n\nk = (-3 **)\n  where\n        (**) = const\n        infixl 7 **\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! this is not legal Haskell 98, but GHC parses it\nf = f where g = g where\n h = h\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M where\n\n-- This one actually compiled right the way up to GHC 5.04.3\n\ndata T String = T String\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\ndata T = T{a::Int}\nx = T{,a=42}\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoRelaxedLayout #-}\n\nmodule ShouldFail where\n\n-- Erroneously allowed by GHC 6.2.x\nf x = case x of\n         False -> do\n    { return x; }\n-- this line should close the 'case' context and cause the 'do' to be empty.\n\n-- Update: arguably this should be allowed.  The fix to the Haskell\n-- layout rule to allow it is simple: in Section 9.3 in the rules that\n-- govern the introduction of the <n> and {n} pseudo-tokens, we need\n-- to prevent <n> being inserted before {.  This could be a simple\n-- side-condition on the rule that introduces <n>.\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! do must end in an expression\nmain = do x <- return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE wibble wibble wibble #-}\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExtensibleRecords, RestrictedTypeSynonyms, HereDocuments, NamedFieldPuns #-}\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nclass Foo o where\n  (:+) :: o -> o -> o\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for trac #314\n\n{-\n/*\n  This\n  uses\n  up\n  some\n  lines\n  The\n  following\n  pragmas\n  should\n  not\n  be\n  parsed\n */\n# 23\n#pragma\n\n-}\n\nmodule ShouldFail where\n\ntype_error = \"Type error on line 25\":\"Type error on line 25\"\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- TAB character in a string literal is disallowed:\nx = \"\t\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\nfoo# = 'a'\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE Haskell98 #-}\n\nmodule Foo where\n\ndata Foo\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nimport Data.Kind (Type)\n\ndata Foo (a :: Type) = Foo a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\nclass Foo a b\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\nfoo = [ ()\n      | () <- foo\n      | () <- foo\n      ]\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\nclass C a\ninstance C Int\n\nnewtype Foo = Foo Int\n    deriving C\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\nimport Control.Monad.Fix\n\nz :: Maybe [Int]\nz = mdo x <- return (1:x)\n        return (take 4 x)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XMultiParamTypeClasses #-}\n\nmodule Foo where\n\nclass Foo a b | a -> b\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Check error message for transforms if we don't have the right extension turned on\n\nmodule Foo where\n\nimport Data.List\nimport GHC.Exts\n\nfoo = [ ()\n      | x <- [1..10]\n      , then take 5\n      , then sortWith by x\n      ]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Check error message for groups if we don't have the right extension turned on\n\nmodule Foo where\n\nimport Data.List\nimport GHC.Exts\n\nfoo = [ ()\n      | x <- [1..10]\n      , then group by x using groupWith\n      , then group by x using groupWith\n      , then group using inits\n      ]\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- We should get an error message, including a location, for these flags:\n{-# OPTIONS_GHC -this-flag-does-not-exist -nor-does-this-one #-}\n\nmodule Foo where\n\nfoo :: ()\nfoo = ()\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistientialQuantification #-}\n-- tests for mis-spelled LANGUAGE pragma error message\n\nmodule ShouldFail where\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldFail where\n\nfoo = let\n    x = (1, 2\n    y = 3\n  in\n  fst x + y\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for trac #314\n\n{-|\n/*\n  This\n  uses\n  up\n  some\n  lines\n  The\n  following\n  pragmas\n  should\n  not\n  be\n  parsed\n */\n# 23\n#pragma\n\n-}\n\nmodule ShouldFail where\n\ntype_error = \"Type error on line 25\":\"Type error on line 25\"\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NoTraditionalRecordSyntax #-}\n\nmodule ReadFailTraditionalRecords1 where\n\ndata Foo = Foo { i :: Int }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NoTraditionalRecordSyntax #-}\n\nmodule ReadFailTraditionalRecords2 where\n\nf (Foo { i = j }) = j\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NoTraditionalRecordSyntax #-}\n\nmodule ReadFailTraditionalRecords3 where\n\nf x = x { i = 3 }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "type T = MkT { a :: Int + ! }\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "type T = MkT { a :: Int + {-# UNPACK #-} }\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10196Fail1 where\n\n-- Constructors are not allowed to start with a modifier letter.\ndata Foo = \u00e1\u00b5\u00a6foo\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10196Fail2 where\n\n-- Variables are not allowed to start with a modifier letter.\n\u00e1\u00b5\u00a6 = 1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\nmodule T10498a where\n\n-- ghc-7.10 would show the unhelpful error message:\n--\n-- T10498a.hs:10:5:\n--     parse error in if statement: missing required else clause\n\nfoo =\n    if True\n    then\n        \\case ->\n            1 -> 2\n    else id\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10498b where\n\n-- ghc-7.10 would show the unhelpful error message:\n--\n-- T10498b.hs:7:5: parse error in if statement: naked if statement\n\nf = if module then True else False\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language DataKinds             #-}\n{-# Language TypeApplications         #-}\n{-# Language PolyKinds             #-}\n\nmodule Bug where\n\nimport Data.Kind\n\ndata Nat = Zero | Succ Nat\n\ndata D n = MkD @Nat Bool\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12051 where\n\ndata T = (+++) Int\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module X where\n  import Data.Text (pattern Y)\n  x = 3\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-tabs #-}\nmodule T12610 where\n\np = let  x = 4\n\ty = 5\n    in 12\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule Bug where\n\nfoo :: foral a. a -> a\nfoo x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T13260 where\n\n  g y = case y of\n    \"a\"# -> True\n    _    -> False\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env runhaskell\n> module T13414 where\n> main = invalid_ident_\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T1344a where\n\na = \"Hel\\x6c000000000000000 World\"\nb = \"Hel\\x6c0000000000000000 World\"\nc = '\\1114112'\n\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T1344b where\n\nb = \"Hel\\x6c0000000000000000 World\"\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T1344c where\n\nc = '\\1114112'\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13450 where\n\nexample = foo\n  where foo = ''\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T13450TH where\n\nexample = foo\n  where foo = ''\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14588 where\n\nmain = print (let !x = 1 + 2 in x)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule T14740 where\n\nx :: ((##)) => ()\nx = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O1 }\n\"\n  #-}\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeOperators #-}\nmodule T15209 where\n\nimport GHC.Prim\n\nfoo :: a ~# Int -> ()\nfoo = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15233 where\n\n-- ghc-8.6 would accept (but silently ignore) both of the following:\ninfixl 7 :\n{-# DEPRECATED (:) \"Deprecting cons\" #-}\n\n-- this was never accepted by ghc-8.6, but now that GHC.Prim emits a fixity\n-- declaration for `(->)`, we need to make sure it is disallowed elsewhere.\ninfixr 4 ->\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15849 where\n\nmain = return ()\n foo = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoTraditionalRecordSyntax, NoDoAndIfThenElse, NoMultiWayIf, NoLambdaCase, NoNumericUnderscores, MagicHash #-}\n{-# OPTIONS -Werror=missing-space-after-bang #-}\n\nmodule T16270 where\n\nc = do\n\tif c then\n\t\tFalse\n\telse\n\t\tTrue\n\nf = id do { 1 }\ng = id \\x -> x\n\ndata Num a => D a\n\ndata Pair a b = Pair { fst :: a, snd :: b }\nt = p { fst = 1, snd = True }\n\nz :: forall a. ()\nz = if True; then (); else ();\n\ndata G a where\n\nmultiWayIf !i = (a, b)\n  where\n    a = if | i -> True\n           | otherwise -> False\n    b = if | i -> False\n           | otherwise -> True\n\nw = \\case _ : _ -> True\n          _     -> False\n\nn = 123_456\n\ns = \"hello \u00cf\u2030orld\"#   -- note the omega\n\n-- a fatal error.\nk = let\n\n-- not reported, as the previous one was fatal.\nk = let\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- We can't test module header parsing errors using the same file as other\n-- parsing errors (in ../T16270.hs) because HeaderInfo.getImports fails fast\n-- on parsing imports:\n--\n--      if errorsFound dflags ms\n--        then throwIO $ mkSrcErr errs\n--\nmodule T16270h (type G) where\n\nimport \"pkg?\" M\nimport \"pkg!\" M\n\ndata G a\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n-- Trac #3095\nmodule T3095 where\n\nimport Data.Kind (Type)\n\nclass Bla (forall x . x :: Type) where\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n#\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nx = \"\\\u00c2\u00a7\"\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3811 where\n\nf x :: Char\nf x = 'c'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3811b where\n\ndata Foo a = !B\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3811c where\n\ndata D = D\n\ninstance !Show D\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3811d where\n\ndata D a = D a\n\nclass C b (D Char) b\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE NoDatatypeContexts #-}\n\nmodule T3811e where\n\ndata (Show a, Read a) => D a = D a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3811f where\n\nclass !Foo a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3811g where\n\nf :: IO ()\nf = do _ <- return ()\n       _ <- return ()\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- load into ghci\n\n\"\u00ce\u00bba: (Type[0] \u00e2\u2020\u2019 (Type[0] \u00e2\u2020\u2019 Type[0])).\\\n \u00ce\u00bbb: (Type[0] \u00e2\u2020\u2019 Type[0]). \u00ce\u00bbc: Type[0].\\\n   ((a c)(b c))\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T7848 where\n\ndata A = (:&&) Int Int | A Int Int\n\nx (+) ((&)@z) ((:&&) a b) (c :&& d) (e `A` f) (A g h) = y\n  where infixl 3 `y`\n        y _ = (&)\n        {-# INLINE (&) #-}\n        {-# SPECIALIZE (&) :: a #-}\n        (&) = 'c'\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8258NoGADTs where\n\ndata T where\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "This should not compile:\n\n\\end{code}\n\n> module T8430 where\n> main = putStr \"a\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": ")\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nfoo :: IO ()\nfoo = do\n  rec str <- return \"foo\"\n  putStrLn str\n\n-- Should fail\n-- foo' :: IO ()\n-- foo' = do\n--   rec {str <- return \"foo\" ;\n--   putStrLn str}\n--   return ()\n\n-- Should fail\n-- foo'' :: IO ()\n-- foo'' = do\n--   rec putStrLn \"test\"\n--   str <- return \"foo\"\n--   putStrLn str\n--   return ()\n\n-- Should compile\n-- foo'''' :: IO ()\n-- foo'''' = do\n--   rec <- return \"foo\"\n--   putStrLn \"test\"\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nbar :: IO ()\nbar = mdo\n    str <- return \"bar\"\n    putStrLn str\n\n-- Should fail\n-- bar' :: IO ()\n-- bar' = mdo {str <- return \"bar\" ; putStrLn str}\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nbaz :: IO ()\nbaz = mdo\n    putStrLn \"baz\"\n\n-- Should fail\n-- baz' :: IO ()\n-- baz' = mdo\n--     putStrLn \"baz\"\n--     str <- return \"test\"\n\n-- Should fail (and needs better error)\n-- baz' :: IO ()\n-- baz' = mdo {putStrLn \"baz\"}\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8506 where\n\nclass Shapable Int where\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9225 where\n-- Should be a parse error:\n-- version numbers not allowed in package qualified imports\nimport \"some-package-0.1.2.3\" Some.Module\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T984 where\n\nf _ = do\n        x <- computation\n        case () of\n                _ ->\n                        result <- computation\n                        case () of () -> undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data T = Int :+ Int :+ Int\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data T = Int + Int\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "type X = 1 +\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "type X = + 1\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "type X = 1 + + 2\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "type X = +\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n\nmodule UnpackBeforeOperator where\n\ndata a + b\ndata T = T { t :: {-# UNPACK #-} + Int }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module UnpackEmptyType where\n\ndata T = T { t :: {-# UNPACK #-} }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module UnpackInsideType where\n\ndata T = T { t :: Maybe {-# UNPACK #-} Int }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Anti-Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224)\n--\n-- NB: This code won't compile with -XBinaryLiterals enabled\n\n{-# LANGUAGE NegativeLiterals #-}\n\nmodule Main where\n\nmain :: IO ()\nmain = print lst\n  where\n    -- \"0b0\" is to be parsed as \"0 b0\"\n    lst = [ (,) 0b0, (,) 0b1, (,) 0b10, (,) 0b11\n          , (,) -0b0, (,) -0b1, (,) -0b10, (,) -0b11\n          ] :: [(Int,Int)]\n    b0 = 60\n    b1 = 61\n    b11 = 611\n    b10 = 610\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224)\n\n{-# LANGUAGE BinaryLiterals #-}\n{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport GHC.Types\n\nmain = do\n    print [ I# 0b0#, I# -0b0#, I# 0b1#, I# -0b1#\n          , I# 0b00000000000000000000000000000000000000000000000000000000000000000000000000001#\n          , I# -0b00000000000000000000000000000000000000000000000000000000000000000000000000001#\n          , I# -0b11001001#, I# -0b11001001#\n          , I# -0b11111111#, I# -0b11111111#\n          ]\n    print [ W# 0b0##, W# 0b1##, W# 0b11001001##, W# 0b11##, W# 0b11111111##\n          , W# 0b00000000000000000000000000000000000000000000000000000000000000000000000000001##\n          ]\n\n    print [ 0b0, 0b1, 0b10, 0b11, 0b100, 0b101, 0b110, 0b111 :: Integer\n          , -0b0, -0b1, -0b10, -0b11, -0b100, -0b101, -0b110, -0b111\n          , 0b11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111\n          , -0b11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111\n          ]\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224)\n\n{-# LANGUAGE BinaryLiterals #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NegativeLiterals #-}\n\nmodule Main where\n\nimport GHC.Types\nimport GHC.Int\n\nmain = do\n    print [ I# 0B0#, I# -0B0#, I# 0B1#, I# -0B1#\n          , I# 0B00000000000000000000000000000000000000000000000000000000000000000000000000001#\n          , I# -0B00000000000000000000000000000000000000000000000000000000000000000000000000001#\n          , I# -0B11001001#, I# -0B11001001#\n          , I# -0B11111111#, I# -0B11111111#\n          ]\n    print [ W# 0B0##, W# 0B1##, W# 0B11001001##, W# 0B11##, W# 0B11111111##\n          , W# 0B00000000000000000000000000000000000000000000000000000000000000000000000000001##\n          ]\n\n    print [ 0B0, 0B1, 0B10, 0B11, 0B100, 0B101, 0B110, 0B111 :: Integer\n          , -0B0, -0B1, -0B10, -0B11, -0B100, -0B101, -0B110, -0B111\n          , 0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111\n          , -0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111\n          ]\n\n    print [ I8# -0B10000000#, I8# 0B1111111# ]\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language HexFloatLiterals #-}\n\nimport Numeric(showHFloat)\n\nmain :: IO ()\nmain =\n  do print [ 0xF.0\n           , 0xF.1, 0xF.01\n           , 0xF1p-4, 0xF01p-8\n           , 0x0.F1p4, 0x0.00F01p12\n           ]\n\n     mapM_ putStrLn [ showHFloat (212.21 :: Double) \"\"\n                    , showHFloat (-12.76 :: Float) \"\"\n                    , showHFloat (-0 :: Double) \"\"\n                    ]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Test for @NegativeLiterals@ extension (see GHC #13211)\n\n{-# LANGUAGE NegativeLiterals #-}\n\nfloatZero0 = 0 :: Float\nfloatZero1 = 0.0 :: Float\n\nfloatNegZero0 = -0 :: Float\nfloatNegZero1 = -0.0 :: Float\n\ndoubleZero0 = 0 :: Double\ndoubleZero1 = 0.0 :: Double\n\ndoubleNegZero0 = -0 :: Double\ndoubleNegZero1 = -0.0 :: Double\n\nmain = do\n    print (isNegativeZero floatZero0)\n    print (isNegativeZero floatZero1)\n    print (isNegativeZero floatNegZero0)\n    print (isNegativeZero floatNegZero1)\n    print (isNegativeZero doubleZero0)\n    print (isNegativeZero doubleZero1)\n    print (isNegativeZero doubleNegZero0)\n    print (isNegativeZero doubleNegZero1)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NumericUnderscores #-}\n{-# LANGUAGE BinaryLiterals #-}\n{-# LANGUAGE HexFloatLiterals #-}\n{-# LANGUAGE NegativeLiterals #-}\n\n-- Test for NumericUnderscores extension.\n-- See Trac #14473\n-- This is a testcase for boxed literals.\n\nmain :: IO ()\nmain = do\n    -- Each case corresponds to the definition of Lexer.x\n    --\n    -- Normal integral literals\n    -- decimal\n    print [ 1_000_000 == 1000000,\n            1__0 == 10,\n            299_792_458 == 299792458,\n            8_04_1 == 8041,\n            2017_12_31 == 20171231\n          ]\n\n    -- binary\n    print [ 0b01_0000_0000 == 0b0100000000,\n            0b1_11_01_0000_0_111 == 0b1110100000111,\n            0b1100_1011__1110_1111__0101_0011 ==\n            0b110010111110111101010011\n          ]\n\n    -- octal\n    print [ 0o1_000_000 == 0o1000000,\n            0O1__0 == 0O10\n          ]\n\n    -- hexadecimal\n    print [ 0x1_000_000 == 0x1000000,\n            0x1__0 == 0x10,\n            0xff_00_00 == 0xff0000,\n            0X3fff_ffff == 0x3fffffff\n          ]\n\n    -- negative decimal\n    print [ -1_0 == -10\n          ]\n\n    -- negative binary\n    print [ -0b1_0 == -0b10\n          ]\n\n    -- negative octal\n    print [ -0o1_0 == -0o10\n          ]\n\n    -- negative hexadecimal\n    print [ -0x1_0 == -0x10\n          ]\n\n    ---- Normal rational literals\n    -- float\n    print [ 3.141_592_653_589_793 == 3.141592653589793,\n            96_485.332_89 == 96485.33289,\n            6.022_140_857e+23 == 6.022140857e+23\n          ]\n\n    -- negative float\n    print [ -1_0.0_1 == -10.01,\n            -1_0e+2 == -10e+2,\n            -1_0.0_1e+3 == -10.01e+3\n          ]\n\n    -- hexadecimal float\n    print [ 0xF_F.1F == 0xFF.1F,\n            0xF_01p-8 == 0xF01p-8,\n            0x0.F_1p4 == 0x0.F1p4\n          ]\n\n    -- negative hexadecimal float\n    print [ -0xF_F.F == -0xFF.F,\n            -0xF_01p-1 == -0xF01p-1,\n            -0x0.F_1p1 == -0x0.F1p1\n          ]\n\n    -- Additional testcase\n    --\n    -- Validity\n    print [ 0.000_1 == 0.0001,\n            1_0.000_1 == 10.0001,\n            1e+23 == 1e+23,\n            1_e+23 == 1e+23,\n            1__e+23 == 1e+23,\n            1.0_e+23 == 1.0e+23,\n            1.0_e+2_3 == 1.0e+23,\n            1_e23 == 1e23,\n            1_e-23 == 1e-23,\n            1_0_e23 == 10e23,\n            1_0_e-23 == 10e-23,\n            0b_01 == 0b01,\n            0b__11 == 0b11,\n            0x_ff == 0xff,\n            0x__ff == 0xff\n          ]\n", "num_lines": 102}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NumericUnderscores #-}\n{-# LANGUAGE BinaryLiterals #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE NegativeLiterals #-}\n\n-- Test for NumericUnderscores extension.\n-- See Trac #14473\n-- This is a testcase for unboxed literals.\n\nimport GHC.Types\n\nmain :: IO ()\nmain = do\n    -- Each case corresponds to the definition of Lexer.x\n    --\n    -- Unboxed ints and words\n    -- decimal int\n    print [ (I# 1_000_000#) == 1000000,\n            (I# 299_792_458#) == 299792458\n          ]\n\n    -- binary int\n    print [ (I# 0b01_0000_0000#) == 0b0100000000,\n            (I# 0b1_11_01_0000_0_111#) == 0b1110100000111\n          ]\n\n    -- octal int\n    print [ (I# 0o1_000_000#) == 0o1000000,\n            (I# 0O1__0#) == 0O10\n          ]\n\n    -- hexadecimal int\n    print [ (I# 0x1_000_000#) == 0x1000000,\n            (I# 0X3fff_ffff#) == 0x3fffffff\n          ]\n\n    -- negative decimal int\n    print [ (I# -1_000_000#) == -1000000\n          ]\n\n    -- negative binary int\n    print [ (I# -0b01_0000_0000#) == -0b0100000000\n          ]\n\n    -- negative octal int\n    print [ (I# -0o1_000_000#) == -0o1000000\n          ]\n\n    -- negative hexadecimal int\n    print [ (I# -0x1_000_000#) == -0x1000000\n          ]\n\n    -- decimal word\n    print [ (W# 1_000_000##) == 1000000,\n            (W# 299_792_458##) == 299792458\n          ]\n\n    -- binary word\n    print [ (W# 0b1_0##) == 0b10\n          ]\n\n    -- octal word\n    print [ (W# 0o1_0##) == 0o10\n          ]\n\n    -- hexadecimal word\n    print [ (W# 0x1_0##) == 0x10\n          ]\n\n    -- Unboxed floats and doubles\n    -- float\n    print [ (F# 3.141_592_653_589_793#) == 3.141592653589793,\n            (F# 3_14e-2#) == 314e-2,\n            (F# 96_485.332_89#) == 96485.33289,\n            (F# 6.022_140_857e+23#) == 6.022140857e+23,\n            (F# -3.141_592#) == -3.141592,\n            (F# -3_14e-2#) == -314e-2,\n            (F# -6.022_140e+23#) == -6.022140e+23\n          ]\n\n    -- double\n    print [ (D# 3_14e-2##) == 314e-2,\n            (D# 96_485.332_89##) == 96485.33289,\n            (D# 6.022_140_857e+23##) == 6.022140857e+23,\n            (D# -3.141_592##) == -3.141592,\n            (D# -3_14e-2##) == -314e-2,\n            (D# -6.022_140e+23##) == -6.022140e+23\n          ]\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata Hash = Hash { (#) :: Int }\n  deriving (Show,Read)\n\nmain = do\n  let h = Hash 3\n      s = show h\n      x = read s :: Hash\n      y = show x\n  print h\n  putStrLn s\n  print x\n  putStrLn y\n  let h' = Hash { (#) = 3 }\n      s' = show h'\n      x' = read s' :: Hash\n      y' = show x'\n  print h'\n  putStrLn s'\n  print x'\n  putStrLn y'\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n(|..) :: a -> a -> a\nx |.. y = y\n\nf = [2|..3]\n\nmain = putStrLn (show f)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiWayIf #-}\n\nmodule Main where\n\nx  = 10\nx1 = if | x < 10 -> \"< 10\" | otherwise -> \"\"\nx2 = if | x < 10 -> \"< 10\"\n        | otherwise -> \"\"\nx3 = if | x < 10 -> \"< 10\"\n        | otherwise -> \"\"\nx4 = if | True -> \"yes\"\nx5 = if | True -> if | False -> 1 | True -> 2\n\nx6 = if | x < 10 -> if | True -> \"yes\"\n                       | False -> \"no\"\n        | otherwise -> \"maybe\"\n\nx7 = (if | True -> 0)\n\nmain = print $ x5 == 2 && x6 == \"maybe\" && x7 == 0\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Haskell-98 prefix negate operator\n\n-- Make sure the parsing is actually the correct\n-- one by running this after it's compiled.\n\nnegatedExpression = - (3 + 4)\n\nnegatedTightlyBinding = -3^4\n\nnegatedNonSection = (- 3)\n\nnegatedNonSectionWithHighPrecedenceOp =\n  let { f = (+); infix 9 `f` } in ( -3 `f` 4 )\n\nnegatedNonSectionWithLowPrecedenceOp =\n  let { f = (+); infix 1 `f` } in ( -3 `f` 4 )\n\nnegatedRightHandSide =\n-- This is actually not legal syntax:  3 * - 4\n-- However, lower-precedence binary ops work.\n-- (see H98 syntax for exp, or imagine it's because it\n--  would parse differently as 3 * 0 - 4)\n  let { f = (+); infix 1 `f` } in ( 3 `f` - 4 )\n\n\nsubtractionNotNegation = 3 -4\n\nnegativePattern =\n    case -3 of { (- 3) ->\n    case -4 of { - 4 ->\n    True } }\n-- not legal H98 syntax:  case -4 of { _x @ -4 ->\n-- (parentheses needed)    case -5 of { ~ -5 ->\n\nsubtractionNotNegationPattern =\n    -- defines infix '-' (shadowing Prelude definition)\n    let { 3 -4 = True } in (3 - 4)\n\nprecedenceOfNegationCantBeChanged =\n    let { (-) = undefined; infix 9 - } in (- 3 * 4)\n\nnegationCantBeQualified =\n    (Prelude.-3) 4\n\nmain = do\n  print negatedExpression\n  print negatedTightlyBinding\n  print negatedNonSection\n  print negatedNonSectionWithHighPrecedenceOp\n  print negatedNonSectionWithLowPrecedenceOp\n  print negatedRightHandSide\n  print subtractionNotNegation\n  print negativePattern\n  print subtractionNotNegationPattern\n  print precedenceOfNegationCantBeChanged\n  print negationCantBeQualified\n\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !!! Negative unboxed literals, part 1\n-- They don't have to be as standards-compliant\n-- or follow so many weird cases as the normal\n-- boxed version.  In particular, normal unboxed\n-- subtraction is -#, `minusFloat#`, -##, `minusInteger#`\n-- and unboxed negation is negate{Int,Float,Double}#\n-- .  (-) and negate are kind errors.  So we will\n-- assume that we don't need to parse infix (-) nicely\n-- when unboxed numbers are involved (even though someone\n-- \"could\" hide the Prelude's version and define (-) themself).\n-- Also we won't care here whether having a space (- 3#) works.\n\n-- Make sure the parsing is actually the correct\n-- one by running this after it's compiled.\n\nimport GHC.Exts\n\n--is floating-point consistently safe to test like this,\n--if we stick to integral values?\nmain = do\n  --These work with any ghc\n  print (I# (negateInt# (-3# -# -4#)))\n  print (F# (negateFloat# (-3.0# `minusFloat#` -4.0#)))\n  print (D# (negateDouble# (-3.0## -## -4.0##)))\n  print (I# (-3# ^# 4#)) --different from (boxed) Haskell98 (-3 ^ 4)\n  print ( case -1# of { -1# -> True } )\n  print ( case 1# of { -1# -> True; _ -> False } )\n  print ( case -0# of { 0# -> True } )\n\ninfixr 8  ^#  --just like ^, binds tighter than - (which is infixl 6)\n( ^# ) :: Int# -> Int# -> Int#\nbase ^# 0# = 1#\nbase ^# exponent = base *# (base ^# ( exponent -# 1# ))\n\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- !!! Negative unboxed literals, part 2\n\nimport GHC.Exts\n\nmain = do\n  --Newly implemented: don't parse this as subtraction (Prelude.-):\n  print (I# (negateInt# -3#))\n  print (F# (negateFloat# -3.0#))\n  print (D# (negateDouble# -3.0##))\n  --nor this as  let (-) f 1# = ...\n  print (let { f -1# = True } in f (-1#))\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples, MagicHash #-}\n\n-- should_run to make sure linking succeeds\n-- (curried unboxed tuples with both boxed\n--  and unboxed components).\n-- See Trac #1509; also Note [Primop wrappers] in Id.lhs\n\nimport GHC.Exts\n\nmain = do\n  case curried 9.0## 't'# of\n    (# i#, u@(), d1#, c1#, f#, w#, d2#, c2# #)\n       -> print ( I# i#, u, D# d1#, C# c1#, F# f#, W# w#, D# d2#, C# c2# )\n  print $ map_ ((#,#) True) ['a','b','c']\n\n-- try NOINLINE to make sure the currying isn't eliminated\n-- too soon, but also test the other one without NOINLINE\n-- for variety of testing\n{-# NOINLINE curried #-}\ncurried :: Double# -> Char# ->\n   (# Int#, (), Double#, Char#, Float#, Word#, Double#, Char# #)\ncurried = (#,,,,,,,#) 3# () 4.0## 'f'# 5.0# 32##\n\nmap_ :: (a -> (# b, c #)) -> [a] -> [(b,c)]\nmap_ f [] = []\nmap_ f (a:as) = case f a of\n   (# b, c #) -> (b, c) : map_ f as\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiWayIf #-}\n\nmodule Main where\n\n-- This is how we had to use multi-way if previously. Not indenting lines after\n-- `|` was causing a parse error.\nf1 x = if | even x\n           , x /= 0\n           -> True\n          | otherwise\n           -> False\n\n-- This was previously causing a parse error, but actually it should work.\nf2 x = if | even x\n          , x /= 0\n          -> True\n          | otherwise\n          -> False\n\n-- If we don't generate {} in MultiWayIf we get a shift/reduce conflict here:\n-- It's not clear which guards belong to `case` and which ones belong to `if`.\n--\n-- This test is to make sure we parse it correctly.\n--\n-- - If we shift, we get a non-exhaustive pattern error when argument is odd.\n-- - If we reduce, we run the unreachable code when argument is odd.\nf3 x = case x of\n         x' | even x'   -> if | even x' -> 1 | otherwise -> error \"should be unreachable\"\n            | otherwise -> 3\n\n-- Testing line breaks\nf4 x = case x of\n         x' | even x'   -> if\n             | even x' -> 1\n             | otherwise -> error \"should be unreachable\"\n            | otherwise -> 3\n\nmain :: IO ()\nmain = do\n  print (f3 1)\n  print (f3 2)\n  print (f4 1)\n  print (f4 2)\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Just new test.  This would work without the bug being fixed.\n\na = '\\x10ffff'\nb = \"Hello\\x000000002c\\32World\\o00000000000000000000000000000000041\"\nc = \"\u00e2\u2122\u00af\\00\\&00\\0\"\n\nmain = do print a\n          putStrLn b\n          print c\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows          #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnicodeSyntax   #-}\n\n-- See Trac #10162 and #11743 for details\n\nmodule ShouldCompile where\n\nimport Control.Arrow\nimport Language.Haskell.TH\n\nhandle :: ArrowPlus a => a (b,s) c -> a (b,(String,s)) c -> a (b,s) c\nhandle f h = proc (b,s) -> (f -< (b,s)) <+> (h -< (b,(\"FAIL\",s)))\n\nf :: ArrowPlus a => a (Int,Int) String\nf = proc (x,y) ->\n  \u00e2\u00a6\u2021handle\n    (returnA -< show y)\n    (\\s -> returnA -< s ++ show x)\n  \u00e2\u00a6\u02c6\n\ng :: ArrowPlus a => a (Int,Int) String\ng = proc (x,y) ->\n  \u00e2\u00a6\u2021handle\n    (\\msg -> returnA -< msg ++ show y)\n    (\\s msg -> returnA -< s ++ show x)\n  \u00e2\u00a6\u02c6 (\"hello \" ++ show x)\n\nh :: ArrowPlus a => a (Int,Int) Int\nh = proc (x,y) ->\n  (\n    (\\z -> returnA -< x + z)\n    <+>\n    (\\z -> returnA -< y + z)\n  ) (x*y)\n\n\nmatches :: PatQ -> ExpQ\nmatches pat = \u00e2\u0178\u00a6\\x ->\n  case x of\n    $pat -> True\n    _    -> False\n  \u00e2\u0178\u00a7\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\u00ef\u00bb\u00bfmodule ByteOrderMark () where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2302 where\nf = \u00c3\u20ac\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\n\ntest = let v\u00e2\u201a\u201a = (+) in v\u00e2\u201a\u201a 1 3\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport Data.Char\nimport System.IO\n\nimport StringBuffer\n\ntwoBOMs = \"T6016-twoBOMs\"\n\nignoreFirstBOM = do\n  -- StringBuffer should not contain initial byte-order mark.\n  --\n  -- Just skipping over it, but leaving it in the Stringbuffer, is not\n  -- sufficient. The Lexer calls prevChar when a regular expression\n  -- starts with '^' (which is a shorthand for '\\n^'). It would never\n  -- match on the first line, since instead of '\\n', prevChar would\n  -- still return '\\xfeff'.\n  s <- hGetStringBuffer twoBOMs\n  assert (prevChar s '\\n' == '\\n') return ()\n\ndontIgnoreSecondBOM = do\n  -- U+FEFF is considered a BOM only if it appears as the first\n  -- character of a file.\n  h <- openBinaryFile twoBOMs ReadMode\n  hSeek h AbsoluteSeek 3\n  s <- hGetStringBufferBlock h 3\n  hClose h\n  assert (currentChar s == '\\xfeff') return ()\n\nmain = do\n  writeFile twoBOMs \"\\xfeff\\xfeff\"\n  ignoreFirstBOM\n  dontIgnoreSecondBOM\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print sp\u00c4\u00b1n\u00cc\u02c6alTap\n    where sp\u00c4\u00b1n\u00cc\u02c6alTap = 11\n\n-- n\u00cc\u02c6 is a combining character sequence. We now allow it to be used in\n-- identifiers (#7650).\n--\n-- > map generalCategory \"n\u00cc\u02c6\"\n-- [LowercaseLetter,NonSpacingMark]\n--\n-- > map show \"n\u00cc\u02c6\"\n-- [\"'n'\",\"'\\776'\"]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-#\u00c2\u00a0LANGUAGE EmptyDataDecls #-}\n-- ^ a U+00A0 no-break space\nmodule Foo where\n\nv = 5 +\u00c2\u00a0 3\n--     ^ a U+00A0 no-break space\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- 0x80 is an invalid character\nbad = '\u20ac'\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- buffer ends in 0xC0\n\u00c0", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- buffer ends in 0xD0\n\u00d0", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- buffer ends in 0xE0\n\u00e0", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- buffer ends in 0xF0\n\u00f0", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- 0x80 is an invalid character\nbad = '\u20ac'\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- 0xbf is an invalid character\nbad = '\u00bf'\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A start sequence byte (0xC0) followed by an invalid continuation: \nbad = \"\u00c0.\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A start sequence byte (0xE0) followed by an invalid continuation: \nbad = \"\u00e0.\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A start sequence byte (0xE0) followed by an invalid continuation: \nbad = \"\u00f0.\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- some incomplete sequences concatenated\nbad = \"\u00c0\u00e0\u20ac\u00f0\u20ac\u20ac\u00f8\u20ac\u20ac\u20ac\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule AddAndOr1 where\n\naddAndOr1 :: _\naddAndOr1 (a, b) (c, d) = (a `plus` d, b || c)\n  where plus :: Int -> Int -> Int\n        x `plus` y = x + y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule AddAndOr2 where\n\naddAndOr2 :: _ -> _\naddAndOr2 (a, b) (c, d) = (a `plus` d, b || c)\n  where plus :: Int -> Int -> Int\n        x `plus` y = x + y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule AddAndOr3 where\n\naddAndOr3 :: _ -> _ -> _\naddAndOr3 (a, b) (c, d) = (a `plus` d, b || c)\n  where plus :: Int -> Int -> Int\n        x `plus` y = x + y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule AddAndOr4 where\n\naddAndOr4 :: (_ _ _) -> (_ _ _) -> (_ _ _)\naddAndOr4 (a, b) (c, d) = (a `plus` d, b || c)\n  where plus :: Int -> Int -> Int\n        x `plus` y = x + y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule AddAndOr5 where\n\naddAndOr5 :: (_, _) -> (_, _) -> (_, _)\naddAndOr5 (a, b) (c, d) = (a `plus` d, b || c)\n  where plus :: Int -> Int -> Int\n        x `plus` y = x + y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule AddAndOr6 where\n\naddAndOr6 :: (Int, _) -> (Bool, _) -> (_ Int Bool)\naddAndOr6 (a, b) (c, d) = (a `plus` d, b || c)\n  where plus :: Int -> Int -> Int\n        x `plus` y = x + y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule ADT where\n\ndata Foo x y z = Foo x y z\n\nbar :: Int -> _ Int\nbar x = Foo True () x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule BoolToBool where\n\nbar :: _ -> _\nbar x = not x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, DataKinds, PolyKinds #-}\nmodule DataFamilyInstanceLHS where\n-- Test case from #10586\ndata MyKind = A | B\n\ndata family Sing (a :: k)\n\ndata instance Sing (_ :: MyKind) where\n    SingA :: Sing A\n    SingB :: Sing B\n\nfoo :: Sing A\nfoo = SingA\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE MonomorphismRestriction #-}\nmodule Defaulting1MROn where\n\nalpha :: _\nalpha = 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\nmodule Defaulting2MROff where\n\nbravo :: _ => _\nbravo = 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE MonomorphismRestriction #-}\nmodule Defaulting2MROn where\n\nbravo :: _ => _\nbravo = 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule Either where\n\nbarry :: _a -> (_b _a, _b _)\nbarry x = (Left \"x\", Right x)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, TypeFamilies #-}\nmodule EqualityConstraint where\n\nfoo :: a ~ Bool => (a, _)\nfoo = (True, False)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule Every where\n\nevery :: _ -> _ -> Bool\nevery _ [] = True\nevery p (x:xs) = p x && every p xs\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule EveryNamed where\n\nevery :: (_a -> Bool) -> [_a] -> Bool\nevery _ [] = True\nevery p (x:xs) = p x && every p xs\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule ExpressionSig where\n\nbar :: Bool -> Bool\nbar x = (x :: _)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule ExpressionSigNamed where\n\nbar :: _a -> _a\nbar True  = (False :: _a)\nbar False = (True :: _a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}\n\nmodule ExprSigLocal where\n\n-- We expect this to compile fine,\n-- reporting that '_' stands 'a'\n\ny :: forall b. b->b\ny  = ((\\x -> x) :: forall a. a -> _)\n\ng :: forall a. a -> _\ng x = x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule ExtraConstraints1 where\n\narbitCs1 :: _ => a -> String\narbitCs1 x = show (succ x) ++ show (x == x)\n\narbitCs2 :: (Show a, _) => a -> String\narbitCs2 x = arbitCs1 x\n\narbitCs3 :: (Show a, Enum a, _) => a -> String\narbitCs3 x = arbitCs1 x\n\narbitCs4 :: (Eq a, _) => a -> String\narbitCs4 x = arbitCs1 x\n\narbitCs5 :: (Eq a, Enum a, Show a, _) => a -> String\narbitCs5 x = arbitCs1 x\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE GADTs #-}\nmodule ExtraConstraints2 where\n\nfoo :: _ => String\nfoo = \"x\"\n\n-- No extra constraints\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\nmodule ExtraConstraints3 where\n\nimport qualified Prelude as P\n\nimport Prelude (Bool, Bounded, Char, Either, Enum, Eq, FilePath, Floating,\n                Fractional, Functor, IO, IOError, Int, Integer, Integral,\n                Maybe, Monad, Num, Ord, Ordering, Rational, Read, ReadS, Real,\n                RealFloat, RealFrac, Show, ShowS, String)\n\n-- Proof by enumeration! jk :p\n-- All of Prelude typechecks given the dummy type signature `_ => _`,\n-- which is the same as omitting the type signature entirely.\n\n(!!) :: _ => _\n(!!) = (P.!!)\n($!) :: _ => _\n($!) = (P.$!)\n($) :: _ => _\n($) = (P.$)\n(&&) :: _ => _\n(&&) = (P.&&)\n(*) :: _ => _\n(*) = (P.*)\n(**) :: _ => _\n(**) = (P.**)\n(+) :: _ => _\n(+) = (P.+)\n(++) :: _ => _\n(++) = (P.++)\n(-) :: _ => _\n(-) = (P.-)\n(.) :: _ => _\n(.) = (P..)\n(/) :: _ => _\n(/) = (P./)\n(/=) :: _ => _\n(/=) = (P./=)\n(<) :: _ => _\n(<) = (P.<)\n(<=) :: _ => _\n(<=) = (P.<=)\n(=<<) :: _ => _\n(=<<) = (P.=<<)\n(==) :: _ => _\n(==) = (P.==)\n(>) :: _ => _\n(>) = (P.>)\n(>=) :: _ => _\n(>=) = (P.>=)\n(>>) :: _ => _\n(>>) = (P.>>)\n(>>=) :: _ => _\n(>>=) = (P.>>=)\n(^) :: _ => _\n(^) = (P.^)\n(^^) :: _ => _\n(^^) = (P.^^)\n(||) :: _ => _\n(||) = (P.||)\nabs :: _ => _\nabs = P.abs\nacos :: _ => _\nacos = P.acos\nacosh :: _ => _\nacosh = P.acosh\nall :: _ => _\nall = P.all\nand :: _ => _\nand = P.and\nany :: _ => _\nany = P.any\nappendFile :: _ => _\nappendFile = P.appendFile\nasTypeOf :: _ => _\nasTypeOf = P.asTypeOf\nasin :: _ => _\nasin = P.asin\nasinh :: _ => _\nasinh = P.asinh\natan :: _ => _\natan = P.atan\natan2 :: _ => _\natan2 = P.atan2\natanh :: _ => _\natanh = P.atanh\nbreak :: _ => _\nbreak = P.break\nceiling :: _ => _\nceiling = P.ceiling\ncompare :: _ => _\ncompare = P.compare\nconcat :: _ => _\nconcat = P.concat\nconcatMap :: _ => _\nconcatMap = P.concatMap\nconst :: _ => _\nconst = P.const\ncos :: _ => _\ncos = P.cos\ncosh :: _ => _\ncosh = P.cosh\ncurry :: _ => _\ncurry = P.curry\ncycle :: _ => _\ncycle = P.cycle\ndecodeFloat :: _ => _\ndecodeFloat = P.decodeFloat\ndiv :: _ => _\ndiv = P.div\ndivMod :: _ => _\ndivMod = P.divMod\ndrop :: _ => _\ndrop = P.drop\ndropWhile :: _ => _\ndropWhile = P.dropWhile\neither :: _ => _\neither = P.either\nelem :: _ => _\nelem = P.elem\nencodeFloat :: _ => _\nencodeFloat = P.encodeFloat\nenumFrom :: _ => _\nenumFrom = P.enumFrom\nenumFromThen :: _ => _\nenumFromThen = P.enumFromThen\nenumFromThenTo :: _ => _\nenumFromThenTo = P.enumFromThenTo\nenumFromTo :: _ => _\nenumFromTo = P.enumFromTo\nerror :: _ => _\nerror = P.error\neven :: _ => _\neven = P.even\nexp :: _ => _\nexp = P.exp\nexponent :: _ => _\nexponent = P.exponent\nfail :: _ => _\nfail = P.fail\nfilter :: _ => _\nfilter = P.filter\nflip :: _ => _\nflip = P.flip\nfloatDigits :: _ => _\nfloatDigits = P.floatDigits\nfloatRadix :: _ => _\nfloatRadix = P.floatRadix\nfloatRange :: _ => _\nfloatRange = P.floatRange\nfloor :: _ => _\nfloor = P.floor\nfmap :: _ => _\nfmap = P.fmap\nfoldl :: _ => _\nfoldl = P.foldl\nfoldl1 :: _ => _\nfoldl1 = P.foldl1\nfoldr :: _ => _\nfoldr = P.foldr\nfoldr1 :: _ => _\nfoldr1 = P.foldr1\nfromEnum :: _ => _\nfromEnum = P.fromEnum\nfromInteger :: _ => _\nfromInteger = P.fromInteger\nfromIntegral :: _ => _\nfromIntegral = P.fromIntegral\nfromRational :: _ => _\nfromRational = P.fromRational\nfst :: _ => _\nfst = P.fst\ngcd :: _ => _\ngcd = P.gcd\ngetChar :: _ => _\ngetChar = P.getChar\ngetContents :: _ => _\ngetContents = P.getContents\ngetLine :: _ => _\ngetLine = P.getLine\nhead :: _ => _\nhead = P.head\nid :: _ => _\nid = P.id\ninit :: _ => _\ninit = P.init\ninteract :: _ => _\ninteract = P.interact\nioError :: _ => _\nioError = P.ioError\nisDenormalized :: _ => _\nisDenormalized = P.isDenormalized\nisIEEE :: _ => _\nisIEEE = P.isIEEE\nisInfinite :: _ => _\nisInfinite = P.isInfinite\nisNaN :: _ => _\nisNaN = P.isNaN\nisNegativeZero :: _ => _\nisNegativeZero = P.isNegativeZero\niterate :: _ => _\niterate = P.iterate\nlast :: _ => _\nlast = P.last\nlcm :: _ => _\nlcm = P.lcm\nlength :: _ => _\nlength = P.length\nlex :: _ => _\nlex = P.lex\nlines :: _ => _\nlines = P.lines\nlog :: _ => _\nlog = P.log\nlogBase :: _ => _\nlogBase = P.logBase\nlookup :: _ => _\nlookup = P.lookup\nmap :: _ => _\nmap = P.map\nmapM :: _ => _\nmapM = P.mapM\nmapM_ :: _ => _\nmapM_ = P.mapM_\nmax :: _ => _\nmax = P.max\nmaxBound :: _ => _\nmaxBound = P.maxBound\nmaximum :: _ => _\nmaximum = P.maximum\nmaybe :: _ => _\nmaybe = P.maybe\nmin :: _ => _\nmin = P.min\nminBound :: _ => _\nminBound = P.minBound\nminimum :: _ => _\nminimum = P.minimum\nmod :: _ => _\nmod = P.mod\nnegate :: _ => _\nnegate = P.negate\nnot :: _ => _\nnot = P.not\nnotElem :: _ => _\nnotElem = P.notElem\nnull :: _ => _\nnull = P.null\nodd :: _ => _\nodd = P.odd\nor :: _ => _\nor = P.or\notherwise :: _ => _\notherwise = P.otherwise\npi :: _ => _\npi = P.pi\npred :: _ => _\npred = P.pred\nprint :: _ => _\nprint = P.print\nproduct :: _ => _\nproduct = P.product\nproperFraction :: _ => _\nproperFraction = P.properFraction\nputChar :: _ => _\nputChar = P.putChar\nputStr :: _ => _\nputStr = P.putStr\nputStrLn :: _ => _\nputStrLn = P.putStrLn\nquot :: _ => _\nquot = P.quot\nquotRem :: _ => _\nquotRem = P.quotRem\nread :: _ => _\nread = P.read\nreadFile :: _ => _\nreadFile = P.readFile\nreadIO :: _ => _\nreadIO = P.readIO\nreadList :: _ => _\nreadList = P.readList\nreadLn :: _ => _\nreadLn = P.readLn\nreadParen :: _ => _\nreadParen = P.readParen\nreads :: _ => _\nreads = P.reads\nreadsPrec :: _ => _\nreadsPrec = P.readsPrec\nrealToFrac :: _ => _\nrealToFrac = P.realToFrac\nrecip :: _ => _\nrecip = P.recip\nrem :: _ => _\nrem = P.rem\nrepeat :: _ => _\nrepeat = P.repeat\nreplicate :: _ => _\nreplicate = P.replicate\nreturn :: _ => _\nreturn = P.return\nreverse :: _ => _\nreverse = P.reverse\nround :: _ => _\nround = P.round\nscaleFloat :: _ => _\nscaleFloat = P.scaleFloat\nscanl :: _ => _\nscanl = P.scanl\nscanl1 :: _ => _\nscanl1 = P.scanl1\nscanr :: _ => _\nscanr = P.scanr\nscanr1 :: _ => _\nscanr1 = P.scanr1\nseq :: _ => _\nseq = P.seq\nsequence :: _ => _\nsequence = P.sequence\nsequence_ :: _ => _\nsequence_ = P.sequence_\nshow :: _ => _\nshow = P.show\nshowChar :: _ => _\nshowChar = P.showChar\nshowList :: _ => _\nshowList = P.showList\nshowParen :: _ => _\nshowParen = P.showParen\nshowString :: _ => _\nshowString = P.showString\nshows :: _ => _\nshows = P.shows\nshowsPrec :: _ => _\nshowsPrec = P.showsPrec\nsignificand :: _ => _\nsignificand = P.significand\nsignum :: _ => _\nsignum = P.signum\nsin :: _ => _\nsin = P.sin\nsinh :: _ => _\nsinh = P.sinh\nsnd :: _ => _\nsnd = P.snd\nspan :: _ => _\nspan = P.span\nsplitAt :: _ => _\nsplitAt = P.splitAt\nsqrt :: _ => _\nsqrt = P.sqrt\nsubtract :: _ => _\nsubtract = P.subtract\nsucc :: _ => _\nsucc = P.succ\nsum :: _ => _\nsum = P.sum\ntail :: _ => _\ntail = P.tail\ntake :: _ => _\ntake = P.take\ntakeWhile :: _ => _\ntakeWhile = P.takeWhile\ntan :: _ => _\ntan = P.tan\ntanh :: _ => _\ntanh = P.tanh\ntoEnum :: _ => _\ntoEnum = P.toEnum\ntoInteger :: _ => _\ntoInteger = P.toInteger\ntoRational :: _ => _\ntoRational = P.toRational\ntruncate :: _ => _\ntruncate = P.truncate\nuncurry :: _ => _\nuncurry = P.uncurry\nundefined :: _ => _\nundefined = P.undefined\nunlines :: _ => _\nunlines = P.unlines\nuntil :: _ => _\nuntil = P.until\nunwords :: _ => _\nunwords = P.unwords\nunzip :: _ => _\nunzip = P.unzip\nunzip3 :: _ => _\nunzip3 = P.unzip3\nuserError :: _ => _\nuserError = P.userError\nwords :: _ => _\nwords = P.words\nwriteFile :: _ => _\nwriteFile = P.writeFile\nzip :: _ => _\nzip = P.zip\nzip3 :: _ => _\nzip3 = P.zip3\nzipWith :: _ => _\nzipWith = P.zipWith\nzipWith3 :: _ => _\nzipWith3 = P.zipWith3\n", "num_lines": 406}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\nmodule ExtraNumAMROff where\n\nfoo :: _ => a\nfoo = 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE MonomorphismRestriction #-}\nmodule ExtraNumAMROn where\n\nfoo :: _ => a\nfoo = 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, ScopedTypeVariables #-}\nmodule Forall1 where\n\nfall :: forall a. _ -> a\nfall v = v\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule GenNamed where\n\nbar :: _a -> _a\nbar x = not x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}\nmodule HigherRank1 where\n\nfoo :: (forall a. [a] -> [a]) -> _\nfoo x = (x [True, False], x ['a', 'b'])\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}\nmodule HigherRank2 where\n\nfoo :: (forall a. [a] -> [a]) -> (_, _ _)\nfoo x = (x [True, False], x ['a', 'b'])\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PartialTypeSignatures #-}\nmodule LocalDefinitionBug where\n\nmonoLoc :: forall a. a -> ((a, String), (a, _))\nmonoLoc x = (g True , g False)\n  where\n    g :: t -> (a, String)\n    g _ = (x, \"foo\")\n\n-- Test case for (fixed) bug that previously generated the following error message:\n\n-- LocalDefinitionBug.hs:9:16:\n--     GHC internal error: \u00e2\u20ac\u02dca\u00e2\u20ac\u2122 is not in scope during type checking, but it passed the renamer\n--     tcl_env of environment: [alA :-> Type variable \u00e2\u20ac\u02dc_\u00e2\u20ac\u2122 = _,\n--                              alC :-> Identifier[x::a, <NotTopLevel>],\n--                              alE :-> Type variable \u00e2\u20ac\u02dct\u00e2\u20ac\u2122 = t,\n--                              rjF :-> Identifier[monoLoc::a\n--                                                          -> ((a, String), (a, _)), <NotTopLevel>]]\n--     In the type signature for \u00e2\u20ac\u02dcg\u00e2\u20ac\u2122: g :: t -> (a, String)\n--     In an equation for \u00e2\u20ac\u02dcmonoLoc\u00e2\u20ac\u2122:\n--         monoLoc x\n--           = (g True, g False)\n--           where\n--               g :: t -> (a, String)\n--               g _ = (x, \"foo\")\n\n\n-- Fixed by using tcExtendTyVarEnv2 instead of tcExtendTyVarEnv\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, ScopedTypeVariables, NamedWildCards #-}\nmodule Meltdown where\n\nimport Control.Applicative\n\ndata NukeMonad a b c\n\ninstance Functor (NukeMonad a b) where\n  fmap = undefined\n\ninstance Applicative (NukeMonad a b) where\n  pure = undefined\n  (<*>) = undefined\n\ninstance Monad (NukeMonad a b) where\n  return = undefined\n  (>>=) = undefined\n\n\nisMeltdown :: NukeMonad param1 param2 Bool\nisMeltdown = undefined\n\nunlessMeltdown :: _nm () ->  _nm ()\nunlessMeltdown c = do m <- isMeltdown\n                      if m then return () else c\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonoLocalBinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule MonoLocalBinds where\n\nmonoLoc :: forall a. a -> ((a, String), (a, String))\nmonoLoc x = (g True , g 'v')\n  where\n    -- g :: b -> (a, String) -- #1\n    g :: b -> (a, _) -- #2\n    g y = (x, \"foo\")\n\n-- For #2, we should infer the same type as in #1.\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule NamedTyVar where\n\nfoo :: (_a, b) -> (a, _b)\nfoo (x, y) = (x, y)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, DataKinds, PolyKinds, NamedWildCards #-}\nmodule NamedWildcardInDataFamilyInstanceLHS where\n\ndata MyKind = A | B\n\ndata family Sing (a :: k)\n\ndata instance Sing (_a :: MyKind) where\n    SingA :: Sing A\n    SingB :: Sing B\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, NamedWildCards #-}\nmodule NamedWildcardInTypeFamilyInstanceLHS where\n\ntype family F a where\n  F _t = Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, NamedWildCards, PolyKinds #-}\n\n-- All declarations below are accepted when the NamedWildCards extension is not\n-- enabled and the identifiers starting with _ are parsed as type variables.\n-- They should remain valid when the extension is on.\n--\n-- See Trac #11098 and comments in #10982\n\nmodule NamedWildcardsAsTyVars where\n\ntype Synonym _a = _a -> _a\n\ndata A a _b = ACon a a Int\n\ndata B _a b = BCon _a (_a, Bool)\n\ntype family C a b where\n  C _a _b = _a -> _a\n\ntype family D a b where\n  D _a b = _a -> (_a, Int)\n\ndata family E a b\ndata instance E a _b = ECon a (a, Int)\n\ndata family F a b\ndata instance F _a b = FCon _a _a Bool\n\nclass G _a where\n    gfoo :: _a -> _a\n\ninstance G Int where\n    gfoo = (*2)\n\ntype family H a b where\n  H _a _a = Int\n  H _a _b = Bool\n\nhfoo :: H String String\nhfoo = 10\n\nhbar :: H String Int\nhbar = False\n\ntype family I (_a :: k) where\n    I _t = Int\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule ParensAroundContext where\n\nf :: (_) => a -> a -> Bool\nf x y = x == y\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule PatBind where\n\nfoo :: _\nJust foo = Just id\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule PatBind2 where\n\nfoo :: Bool -> _\nJust foo = Just id\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, ScopedTypeVariables #-}\nmodule PatternSig where\n\nbar :: Bool -> Bool\nbar (x :: _) = True\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule PatternSplice where\n\nfoo $( [p| (x :: _) |] ) = x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule Recursive where\n\norr :: a -> a -> a\norr = undefined\n\ng :: _\ng = f `orr` True\n\nf :: _\nf = g\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\n\nmodule ScopedNamedWildcards where\n\ntest3 :: _\ntest3 x = const (let x :: _b\n                     x = True in False) $\n          const (let x :: _b\n                     x = 'a' in True) $\n          not x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\n\nmodule ScopedNamedWildcardsGood where\n\n-- The named wildcards aren't scoped as the ScopedTypeVariables extension\n-- isn't enabled, of which the behaviour is copied. Thus, the _a annotation of\n-- x, which must be Bool, isn't the same as the _a in g, which is now\n-- generalised over.\nfoo :: _a -> _\nfoo x = let v = not x\n            g :: _a -> _a\n            g x = x\n        in (g 'x')\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule ShowNamed where\n\nshowTwo :: Show _a => _a -> String\nshowTwo x = show x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule SimpleGen where\n\nbar :: _ -> Bool\nbar _ = True\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule SkipMany where\n\ndata GenParser tok st a = GenParser tok st a\n\nskipMany' :: GenParser tok st a -> GenParser tok st ()\nskipMany' = undefined\n\nskipMany :: _ -> _ ()\nskipMany = skipMany'\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, PartialTypeSignatures, NamedWildCards #-}\nmodule SomethingShowable where\n\nsomethingShowable :: Show _x => _x -> _\nsomethingShowable x = show (not x)\n-- Inferred type: Bool -> String\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, NamedWildCards #-}\n\nmodule Splices where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Lib (wildCardT)\n\nmetaType1 :: TypeQ\nmetaType1 = wildCardT\n\nmetaType2 :: TypeQ\nmetaType2 = [t| _ |]\n\nmetaType3 :: TypeQ\nmetaType3 = [t| _ -> _ -> _ |]\n\nmetaDec1 :: Q [Dec]\nmetaDec1 = [d| foo :: _ => _\n               foo x y = x == y |]\n\nmetaDec2 :: Q [Dec]\nmetaDec2 = [d| bar :: _a -> _b -> (_a, _b)\n               bar x y = (not x, y) |]\n\n-- An expression with a partial type annotation\nmetaExp1 :: ExpQ\nmetaExp1 = [| Just True :: Maybe _ |]\n\nmetaExp2 :: ExpQ\nmetaExp2 = [| id :: _a -> _a |]\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, PartialTypeSignatures, NamedWildCards #-}\n\nmodule SplicesUsed where\n\nimport Splices\n\nmaybeBool :: $(metaType1)\nmaybeBool = $(metaExp2) $(metaExp1)\n\ncharA :: a -> $(metaType2)\ncharA x = ('x', x)\n\nfilter' :: $(metaType3)\nfilter' = filter\n\n$(metaDec1)\n\n$(metaDec2)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule SuperCls where\n\nf :: (Ord a, _) => a -> Bool\n-- We'd like to see that the wildcard _ unifies with ()\nf x = x == x\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule T10403 where\n\ndata I a = I a\ninstance Functor I where\n    fmap f (I a) = I (f a)\n\nnewtype B t a = B a\ninstance Functor (B t) where\n    fmap f (B a) = B (f a)\n\nnewtype H f = H (f ())\n\nh1 :: _ => _\n-- h :: Functor m => (a -> b) -> m a -> H m\nh1 f b = (H . fmap (const ())) (fmap f b)\n\nh2 :: _\n-- MR applies\n-- h2 :: Functor m => (a -> b) -> m a -> H m\nh2 f b = (H . fmap (const ())) (fmap f b)\n\napp1 :: H (B t)\napp1 = h1 (H . I) (B ())\n\napp2 :: H (B t)\napp2 = h2 (H . I) (B ())\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T10438 where\n\nfoo f = g\n  where g r = x\n          where x :: _\n                x = r\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, PartialTypeSignatures #-}\n\nmodule T10463 where\n\nf (x :: _) = x ++ \"\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE PartialTypeSignatures #-}\nmodule T10519 where\n\nfoo :: forall a. _ => a -> a -> Bool\nfoo x y = x == y\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, PartialTypeSignatures #-}\n\nmodule T11016 where\n\nf1 :: (?x :: Int, _) => Int\nf1 = ?x\n\nf2 :: (?x :: Int) => _\nf2 = ?x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule T11192 where\n\nfails :: a\nfails =\n   let go :: _\n       go 0 a = a\n   in go (0 :: Int) undefined\n\nsucceeds :: a\nsucceeds =\n   let go :: _\n       go _ a = a\n   in go (0 :: Int) undefined\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule T11399a where\n\nbar :: _\n(bar) = id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs, PartialTypeSignatures #-}\n\nmodule T11670 where\n\nimport Foreign.C.Types\nimport Foreign.Storable\nimport Foreign.Ptr\n\npeek :: Ptr a -> IO CLong\npeek ptr = peekElemOff undefined 0 :: IO _\n\npeek2 :: Ptr a -> IO CLong\npeek2 ptr = peekElemOff undefined 0 :: _ => IO _\n\n-- castPtr :: Ptr a -> Ptr b\n-- peekElemOff :: Storable a => Ptr a -> Int -> IO a\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PartialTypeSignatures #-}\n\n-- In Trac #12033 this was called HsakellBug.hs\n\nmodule T12033 where\ntripleStoreToRuleSet :: v -> v\ntripleStoreToRuleSet getAtom\n = makeTuple getAtom\n where\n   makeRule v = makeExpression v\n   makeTuple v = makeExpression v\n   makeExpression :: _\n   makeExpression v = makeTuple getAtom\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain = print v\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T12531 where\nimport GHC.Exts\n\nf x = I# (_ +# x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds             #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE PolyKinds             #-}\n{-# LANGUAGE TypeFamilies          #-}\n{-# LANGUAGE TypeOperators         #-}\n\nmodule T12844 where\n\nbarWraper :: ('(r,r') ~ Head rngs, Foo rngs) => FooData rngs\nbarWraper = bar\n\nbar :: (_) => FooData rngs\nbar = foo\n\ndata FooData rngs\n\nclass Foo xs where foo :: (Head xs ~ '(r,r')) => FooData xs\n\ntype family Head (xs :: [k]) where Head (x ': xs) = x\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds             #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables   #-}\n{-# LANGUAGE TypeFamilies          #-}\n{-# LANGUAGE TypeOperators         #-}\n\nmodule T12845 where\n\nimport Data.Proxy\n\ndata Foo (m :: Bool)\n\ntype family Head (xs :: [(Bool, Bool)]) where Head (x ': xs) = x\n\ntype family Bar (x :: Bool) (y :: Bool) :: Bool\n\n-- to trigger the bug, r and r' cannot *both* appear on the RHS\nbroken :: forall r r' rngs . ('(r,r') ~ Head rngs, Bar r r' ~ 'True, _)\n  => Foo r -> Proxy rngs -> ()\nbroken x _ = let y = requireBar x :: Foo r' in ()\n\nrequireBar :: (Bar m m' ~ 'True) => Foo m -> Foo m'\nrequireBar = undefined\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T13324_compile where\n\ndata Option a = None | Some a\n\nderiving instance _ => Show (Option a)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE KindSignatures #-}\n\nmodule T12382 where\n\nimport Data.Kind (Type)\n\nminimal1_noksig :: forall m. ( _ ) => Int -> Bool\nminimal1_noksig _ = (mempty :: m) == (mempty :: m)\n\nminimal1 :: forall (m :: Type). _ => Bool\nminimal1 = (mempty :: m) == (mempty :: m)\n\nminimal2 :: forall m. (Eq m, _) => Bool\nminimal2 = (mempty :: m) == (mempty :: m)\n\nminimal3 :: forall m. (Monoid m, _) => Bool\nminimal3 = (mempty :: m) == (mempty :: m)\n\nminimal4 :: forall m. (Monoid m, Eq m) => Bool\nminimal4 = (mempty :: m) == (mempty :: m)\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- # LANGUAGE PartialTypeSignatures #-}\n{-# OPTIONS_GHC -Wno-partial-type-signatures #-}\n\nmodule T14217 where\n\ndata Foo  a1  a2  a3  a4  a5  a6  a7  a8  a9 a10\n         a11 a12 a13 a14 a15 a16 a17 a18 a19 a20\n         a21 a22 a23 a24 a25 a26 a27 a28 a29 a30\n         a31 a32 a33 a34 a35 a36 a37 a38 a39 a40\n         a41 a42 a43 a44 a45 a46 a47 a48 a49 a50\n         a51 a52 a53 a54 a55 a56 a57 a58 a59 a60\n         a61 a62 a63\n = MkFoo\n\neq :: ( Eq a1,  Eq a2 , Eq a3 , Eq a4 , Eq a5 , Eq a6 , Eq a7 , Eq a8 , Eq a9, Eq a10\n      , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20\n      , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30\n      , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40\n      , Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47, Eq a48, Eq a49, Eq a50\n      , Eq a51, Eq a52, Eq a53, Eq a54, Eq a55, Eq a56, Eq a57, Eq a58, Eq a59, Eq a60\n      , Eq a61, Eq a62, Eq a63)\n  => Foo a1  a2  a3  a4  a5  a6  a7  a8  a9 a10\n         a11 a12 a13 a14 a15 a16 a17 a18 a19 a20\n         a21 a22 a23 a24 a25 a26 a27 a28 a29 a30\n         a31 a32 a33 a34 a35 a36 a37 a38 a39 a40\n         a41 a42 a43 a44 a45 a46 a47 a48 a49 a50\n         a51 a52 a53 a54 a55 a56 a57 a58 a59 a60\n         a61 a62 a63\n  -> Bool\neq = error \"urk\"\n\neqFoo :: (_)\n      => Foo  a1  a2  a3  a4  a5  a6  a7  a8  a9 a10\n             a11 a12 a13 a14 a15 a16 a17 a18 a19 a20\n             a21 a22 a23 a24 a25 a26 a27 a28 a29 a30\n             a31 a32 a33 a34 a35 a36 a37 a38 a39 a40\n             a41 a42 a43 a44 a45 a46 a47 a48 a49 a50\n             a51 a52 a53 a54 a55 a56 a57 a58 a59 a60\n             a61 a62 a63\n      -> Bool\neqFoo x = eq x\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule T14653 where\n\naf, ag :: (Num a,_) => a -> a\n-- It's important that one signature covers both\n\naf y = ag y\nag x = af (x-1)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule T14653a where\n\naf :: (Num a,_) => a -> a\naf y = ag y\n\nag :: (Num a,_) => a -> a\nag x = af (x-1)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14715 (bench_mulPublic) where\n\ndata Cyc r\ndata CT zp r'q\nclass Reduce a b\ntype family LiftOf b\n\nbench_mulPublic :: forall z zp zq . (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp,zq)\nbench_mulPublic pt sk = do\n  ct :: CT zp (Cyc zq) <- encrypt sk pt\n  undefined ct\n\nencrypt :: forall z zp zq. Reduce z zq => Cyc z -> Cyc zp -> IO (CT zp (Cyc zq))\nencrypt = undefined\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule T15039a where\n\nimport Data.Coerce\nimport Data.Kind\nimport Data.Type.Coercion\nimport Data.Type.Equality\n\ndata Dict :: Constraint -> Type where\n  Dict :: c => Dict c\n\nex1 :: Dict ((a :: Type) ~ (b :: Type)) -> ()\nex1 (Dict :: _) = ()\n\nex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> ()\nex2 (Dict :: _) = ()\n\nex3 :: Dict ((a :: Type) ~~ (b :: k)) -> ()\nex3 (Dict :: _) = ()\n\n-- Don't know how to make GHC print an unlifted, nominal equality in an error\n-- message.\n--\n-- ex4, ex5 :: ???\n\nex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> ()\nex6 (Dict :: _) = ()\n\nex7 :: _ => Coercion (a :: Type) (b :: Type)\nex7 = Coercion\n\n-- Don't know how to make GHC print an unlifted, heterogeneous,\n-- representational equality in an error message.\n--\n-- ex8 :: ???\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule T15039b where\n\nimport Data.Coerce\nimport Data.Kind\nimport Data.Type.Coercion\nimport Data.Type.Equality\n\ndata Dict :: Constraint -> Type where\n  Dict :: c => Dict c\n\nex1 :: Dict ((a :: Type) ~ (b :: Type)) -> ()\nex1 (Dict :: _) = ()\n\nex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> ()\nex2 (Dict :: _) = ()\n\nex3 :: Dict ((a :: Type) ~~ (b :: k)) -> ()\nex3 (Dict :: _) = ()\n\n-- Don't know how to make GHC print an unlifted, nominal equality in an error\n-- message.\n--\n-- ex4, ex5 :: ???\n\nex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> ()\nex6 (Dict :: _) = ()\n\nex7 :: _ => Coercion (a :: Type) (b :: Type)\nex7 = Coercion\n\n-- Don't know how to make GHC print an unlifted, heterogeneous,\n-- representational equality in an error message.\n--\n-- ex8 :: ???\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule T15039c where\n\nimport Data.Coerce\nimport Data.Kind\nimport Data.Type.Coercion\nimport Data.Type.Equality\n\ndata Dict :: Constraint -> Type where\n  Dict :: c => Dict c\n\nex1 :: Dict ((a :: Type) ~ (b :: Type)) -> ()\nex1 (Dict :: _) = ()\n\nex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> ()\nex2 (Dict :: _) = ()\n\nex3 :: Dict ((a :: Type) ~~ (b :: k)) -> ()\nex3 (Dict :: _) = ()\n\n-- Don't know how to make GHC print an unlifted, nominal equality in an error\n-- message.\n--\n-- ex4, ex5 :: ???\n\nex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> ()\nex6 (Dict :: _) = ()\n\nex7 :: _ => Coercion (a :: Type) (b :: Type)\nex7 = Coercion\n\n-- Don't know how to make GHC print an unlifted, heterogeneous,\n-- representational equality in an error message.\n--\n-- ex8 :: ???\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule T15039d where\n\nimport Data.Coerce\nimport Data.Kind\nimport Data.Type.Coercion\nimport Data.Type.Equality\n\ndata Dict :: Constraint -> Type where\n  Dict :: c => Dict c\n\nex1 :: Dict ((a :: Type) ~ (b :: Type)) -> ()\nex1 (Dict :: _) = ()\n\nex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> ()\nex2 (Dict :: _) = ()\n\nex3 :: Dict ((a :: Type) ~~ (b :: k)) -> ()\nex3 (Dict :: _) = ()\n\n-- Don't know how to make GHC print an unlifted, nominal equality in an error\n-- message.\n--\n-- ex4, ex5 :: ???\n\nex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> ()\nex6 (Dict :: _) = ()\n\nex7 :: _ => Coercion (a :: Type) (b :: Type)\nex7 = Coercion\n\n-- Don't know how to make GHC print an unlifted, heterogeneous,\n-- representational equality in an error message.\n--\n-- ex8 :: ???\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedWildCards, PartialTypeSignatures, PolyKinds, NoStarIsType #-}\n\nmodule T16334 where\n\nk :: (Int :: _t)\nk = 42\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE NamedWildCards #-}\n{-# LANGUAGE PartialTypeSignatures #-}\nmodule TypedSplice where\n\nimport Language.Haskell.TH\n\nmetaExp :: Q (TExp (Bool -> Bool))\nmetaExp = [|| not :: _ -> _b ||]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule TypeFamilyInstanceLHS where\n\nimport Data.Kind (Type)\n\ntype family F (a :: Type) (b :: Type) :: Type\ntype instance F Int  _ = Int\ntype instance F Bool _ = Bool\n\nfoo :: F Int Char -> Int\nfoo = id\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule Uncurry where\n\nunc :: (_ -> _ -> _) -> (_, _) -> _\nunc = uncurry\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}\nmodule UncurryNamed where\n\nunc :: (_a -> _b -> _c) -> (_a, _b) -> _c\nunc = uncurry\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards, ScopedTypeVariables, RankNTypes #-}\nmodule WildcardInstantiations where\n\n\nfoo :: (Show _a, _) => _a -> _\nfoo x = show (succ x)\n\nbar :: _ -> _ -> _\nbar x y = y x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule NamedWildcardsEnabled where\n\nfoo :: Eq a => a -> (a, _)\nfoo x = (x, x)\n\ntest = foo id\n\n-- As id (forall a. a -> a) doesn't implement Eq, the we cannot apply\n-- foo with it. This test checks that foo gets the annotated type,\n-- including constraints, not just the inferred type.\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule AnnotatedConstraintNotForgotten where\n\nfoo :: (Eq a, _) => a -> String\nfoo x = show x\n\n\ndata Foo = Foo deriving Show\n\n\n-- Foo doesn't implement Eq, so `foo Foo` should fail. This is to\n-- verify that the final type of foo didn't forget about the annotated\n-- `Eq a` constraint.\ntest :: String\ntest = foo Foo\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\nmodule Defaulting1MROff where\n\n-- Even without the MR, this signature forces monomorphism,\n-- because of the partial signature with no '=>'\nalpha :: _\nalpha = 3\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule ExtraConstraintsWildcardInExpressionSignature where\n\nfoo x y = ((==) :: _ => _) x y\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule ExtraConstraintsWildcardInPatternSignature where\n\nfoo (x :: _ => _) y = x == y\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule ExtraConstraintsWildcardInPatternSplice where\n\nfoo $( [p| (_ :: _) |] ) = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule ExtraConstraintsWildcardInTypeSplice where\n\nimport Language.Haskell.TH\n\nmetaType :: TypeQ\nmetaType = [t| _ => _ |]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, PartialTypeSignatures  #-}\nmodule ExtraConstraintsWildcardInTypeSplice2 where\n\nimport Language.Haskell.TH.Lib (wildCardT)\n\nshow' :: $(wildCardT) => a -> String\nshow' x = show x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule ExtraConstraintsWildcardInTypeSpliceUsed where\n\nimport ExtraConstraintsWildcardInTypeSplice\n\n-- An extra-constraints wild card is not supported in type splices\neq :: $(metaType)\neq x y = x == y\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ExtraConstraintsWildcardNotEnabled where\n\n\nshow' :: _ => a -> String\nshow' x = show x\n\n-- with the PartialTypeSignatures extension enabled this would lead to the\n-- type Show a => a -> String\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule ExtraConstraintsWildcardNotLast where\n\nfoo :: (_, Eq a) => a -> a\nfoo = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule ExtraConstraintsWildcardNotPresent where\n\n\nshow' :: a -> _\nshow' x = show x\n\n-- With an extra-constraints wildcard present, this would lead to the\n-- type Show a => a -> String.\n\n-- This test makes sure that not merely having a partial type\n-- signature is enough to generate extra constraints, an\n-- extra-constraints wildcard is needed.\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule ExtraConstraintsWildcardTwice where\n\nfoo :: ((_), _) => a -> a\nfoo = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, PartialTypeSignatures #-}\nmodule Forall1 where\n\nfall :: forall a. _ -> a\nfall v = v\n\n-- The wildcard should unify with a\ntest :: Char\ntest = fall True\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedWildCards #-}\nmodule InstantiatedNamedWildcardsInConstraints where\n\nfoo :: (Enum _a, _) => _a -> (String, b)\nfoo x = (show (succ x), x)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, PartialTypeSignatures, NamedWildCards #-}\nmodule NamedExtraConstraintsWildcard where\n\nfoo :: (Eq a, _a) => a -> a\nfoo = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, NamedWildCards #-}\n\n-- See Trac #11098\n\nmodule NamedWildcardExplicitForall where\n\nfoo :: forall _a . _a -> _a                -- _a is a type variable\nfoo = not\n\nbar :: _a -> _a                            -- _a is a named wildcard\nbar = not\n\nbaz :: forall _a . _a -> _b -> (_a, _b)    -- _a is a variable, _b is a wildcard\nbaz x y = (not x, not y)\n\nqux :: _a -> (forall _a . _a -> _a) -> _a  -- the _a bound by forall is a tyvar\nqux x f = let _ = f 7 in not x             -- the other _a are wildcards\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE NamedWildCards #-}\nmodule NamedWildcardInTypeSplice where\n\nimport Language.Haskell.TH\n\nmetaType :: TypeQ\nmetaType = [t| _a -> _a |]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedWildCards #-}\nmodule NamedWildcardsEnabled where\n\nfoo :: _a -> _b\nfoo x = not x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NamedWildcardsNotEnabled where\n\nfoo :: _a -> _b\nfoo x = not x\n\n-- with the NamedWildcards extension enabled this would lead to the\n-- type Bool -> Bool.\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, TypeFamilies, NamedWildCards, ConstraintKinds #-}\nmodule NamedWildcardsNotInMonotype where\n\nfoo :: (Show _a, Eq _c, Eq _b) => _a -> _b -> String\nfoo x y = show x ++ show (x == y)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, PartialTypeSignatures #-}\nmodule NestedExtraConstraintsWildcard where\n\nfoo :: Bool -> (Eq a, _) => a\nfoo = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, PartialTypeSignatures, NamedWildCards #-}\nmodule NestedNamedExtraConstraintsWildcard where\n\nfoo :: Bool -> (Eq a, _a) => a\nfoo = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule PartialClassMethodSignature where\n\n\nclass Foo a where\n  foo :: a -> _\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule PartialClassMethodSignature2 where\n\nclass Foo a where\n  foo :: (Eq a, _) => a -> a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module PartialTypeSignaturesEnabled where\n\n-- The PartialTypeSignatures extension should be enabled\nfoo :: _ -> _\nfoo x = not x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule PatBind3 where\n\n-- Oddly GHC 8.0 accepted this, but it should obviously fail!\nfoo :: (Bool, _) -> Char\nJust foo = Just id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards, ScopedTypeVariables #-}\n\nmodule ScopedNamedWildcardsBad where\n\n-- If named wildcards are properly scoped, this should lead to\n-- a constraint (Bool ~ Char)\nfoo :: _a -> _\nfoo x = let v = not x\n            g :: _a -> _a\n            g x = x\n        in (g 'x')\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10045 where\n\nnewtype Meta = Meta ()\n\nfoo (Meta ws1) =\n     let copy :: _\n         copy w from = copy w True\n     in copy ws1 False\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T10615 where\n\nf1 :: _ -> f\nf1 = const\n\nf2 :: _ -> _f\nf2 = const\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10999 where\n\nimport qualified Data.Set as Set\n\nf :: _ => () -> _\nf _ = Set.fromList undefined\n\ng = map fst $ Set.toList $ f ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonomorphismRestriction #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule T11122 where\n\ndata Parser a\n\ninstance Functor Parser where\n  fmap = undefined\n\nmany p = undefined\n\ndigit = undefined\n\nparseTest = undefined\n\n--------------------------------------------\n\nparser :: Parser _\n--parser :: Parser Int\nparser = read <$> many digit\n\ndata Wrapper = Wrapper Int deriving Show\n\nwrapperParser = Wrapper <$> parser\n\nmain :: IO ()\nmain = parseTest wrapperParser \"0\"\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, TypeFamilies #-}\n\nmodule T11515 where\n\ntype family ShowSyn a where ShowSyn a = Show a\n\nfoo :: (ShowSyn a, _) => a -> String\nfoo x = show x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}\n\nmodule T11976 where\n\ntype Lens s a = forall f. Functor f => (a -> f a) -> (s -> f s)\n\nfoo = undefined :: Lens _ _ _\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule T12039 where\n\nclass Num _ => B a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds           #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule T12634 where\n\ntwacePowDec :: t m' r -> t m r\ntwacePowDec = undefined\n\ndata Bench a\n\nbench :: (a -> b) -> a -> Bench params\nbench f = undefined\n\nbench_twacePow :: forall t m m' r . _ => t m' r -> Bench '(t,m,m',r)\nbench_twacePow = bench (twacePowDec :: t m' r -> t m r)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12732 where\n\n(a ... b) xs\n  | a == x\n  , (l, _:r) <- break (== x) xs\n  = l ++ [x]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T13324_fail1 where\n\ndata Option a = None | Some a\n\nderiving instance (Eq a, _) => Eq (Option a)\nderiving instance (Show _) => Show (Option a)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule T13324_fail2 where\n\nnewtype Foo f a = Foo (f (f a))\nderiving instance _ => Eq (Foo f a)\n\ndata T a where\n    MkT :: T Int\nderiving instance _ => Eq (T a)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T14040a where\n\nimport Data.Kind\n\ndata family Sing (a :: k)\n\ndata WeirdList :: Type -> Type where\n  WeirdNil  :: WeirdList a\n  WeirdCons :: a -> WeirdList (WeirdList a) -> WeirdList a\n\ndata instance Sing (z :: WeirdList a) where\n  SWeirdNil  :: Sing WeirdNil\n  SWeirdCons :: Sing w -> Sing wws -> Sing (WeirdCons w wws)\n\nelimWeirdList :: forall (a :: Type) (wl :: WeirdList a)\n                        (p :: forall (x :: Type). x -> WeirdList x -> Type).\n                 Sing wl\n              -> (forall (y :: Type). p _ WeirdNil)\n              -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)).\n                    Sing x -> Sing xs -> p _ xs\n                  -> p _ (WeirdCons x xs))\n              -> p _ wl\nelimWeirdList SWeirdNil pWeirdNil _ = pWeirdNil\nelimWeirdList (SWeirdCons (x :: Sing (x :: z))\n                          (xs :: Sing (xs :: WeirdList (WeirdList z))))\n              pWeirdNil pWeirdCons\n  = pWeirdCons @z @x @xs x xs\n      (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons)\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n\nmodule T14449 where\n\nf :: a -> b -> _\nf x y = [x, y]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, PartialTypeSignatures #-}\n\nmodule T14479 where\n\nfoo :: Num a => a -> a\nfoo xxx = g xxx\n  where\n    g :: forall b. Num b => _ -> b\n    g y = xxx + y\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}     -- Very important to this bug!\n{-# Language PartialTypeSignatures #-}\n{-# Language TypeFamilyDependencies, KindSignatures #-}\n{-# Language PolyKinds #-}\n{-# Language DataKinds #-}\n{-# Language TypeFamilies #-}\n{-# Language RankNTypes #-}\n{-# Language NoImplicitPrelude #-}\n{-# Language FlexibleContexts #-}\n{-# Language MultiParamTypeClasses #-}\n{-# Language GADTs #-}\n{-# Language ConstraintKinds #-}\n{-# Language FlexibleInstances #-}\n{-# Language TypeOperators #-}\n{-# Language ScopedTypeVariables #-}\n{-# Language DefaultSignatures #-}\n{-# Language FunctionalDependencies #-}\n{-# Language UndecidableSuperClasses #-}\n{-# Language UndecidableInstances #-}\n{-# Language AllowAmbiguousTypes #-}\n{-# Language InstanceSigs, TypeApplications #-}\n\n\nmodule T14584 where\n\nimport Data.Monoid\nimport Data.Kind\n\ndata family Sing (a::k)\n\nclass SingKind k where\n  type Demote k = (res :: Type) | res -> k\n  fromSing :: Sing (a::k) -> Demote k\n\nclass SingI (a::k) where\n  sing :: Sing a\n\ndata ACT  :: Type -> Type -> Type\ndata MHOM :: Type -> Type -> Type\n\ntype m %%-  a  = ACT  m a  -> Type\ntype m %%-> m' = MHOM m m' -> Type\n\nclass Monoid m => Action (act :: m %%- a) where\n  act :: m -> (a -> a)\n\nclass (Monoid m, Monoid m') => MonHom (mhom :: m %%-> m') where\n  monHom :: m -> m'\n\ndata MonHom_Distributive m :: (m %%- a) -> (a %%-> a)\n\ntype Good k = (Demote k ~ k, SingKind k)\n\ninstance (Action act, Monoid a, Good m) => MonHom (MonHom_Distributive m act :: a %%-> a) where\n  monHom :: a -> a\n  monHom = act @_ @_ @act (fromSing @m (sing @m @a :: Sing _))\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}     -- Very important to this bug!\n{-# Language PartialTypeSignatures #-}\n{-# Language KindSignatures #-}\n{-# Language PolyKinds #-}\n{-# Language ScopedTypeVariables #-}\n{-# Language AllowAmbiguousTypes #-}\n{-# Language TypeApplications #-}\n\nmodule T14584a where\n\nf :: forall m. ()\nf = id @m :: _\n\ng :: forall m. ()\ng = let h = id @m\n    in h\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TidyClash where\n\n-- Type variables originating from wildcards are normally given the name w_,\n-- but in this case there is already a type variable called w_. Tidying the\n-- types should result in w_1 and w_2 for the two new type variables\n-- originating from the wildcards.\n\nbar :: w_ -> (w_, _ -> _)\nbar x = (x, \\y -> undefined)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedWildCards, ScopedTypeVariables #-}\nmodule TidyClash2 where\n\n{-\nThe bug that TidyClash2 tries to tickle is the following: when GHC generalises\nover wild cards it uses t, t1, t2, ... as type variables. When the user already\nused the t type variable in the same signature, the tidier should respect this\nand use t1, t2, ... for generalised wild cards. So _ -> -> t should result\nin t1 -> t2 -> t. Before the bug fix, the actual output would have been\nsomething like t -> t1 -> t2.\n-}\n\nbarry :: forall t. _ -> _ -> t\nbarry (x :: _) (y :: _) = undefined :: _\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule UnnamedConstraintWildcard1 where\n\nfoo :: Show _ => a -> String\nfoo x = show x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule UnnamedConstraintWildcard2 where\n\nfoo :: _ a => a -> String\nfoo x = show x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInADT1 where\n\ndata Foo a = Foo (Either _ a)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInADT2 where\n\ndata Foo a = Foo { get :: Either _ a }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}\nmodule WildcardInADT3 where\n\ndata Foo a = Foo { get :: _ => a }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, DatatypeContexts #-}\nmodule WildcardInADTContext where\n\ndata (Eq a, _) => Foo a = Foo { getFoo :: a }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, NamedWildCards, DatatypeContexts #-}\nmodule WildcardInADTContext2 where\n\ndata (Eq _a) => Foo a = Foo { getFoo :: a }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInDefault where\n\ndefault (_)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\nmodule WildcardInDefaultSignature where\n\n\nclass C a where\n  f :: a\n  default f :: _\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInDeriving where\n\ndata Foo a = Foo a\n           deriving (_)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, ForeignFunctionInterface #-}\nmodule WildcardInForeignExport where\n\nimport Foreign.C\n\nforeign export ccall foo :: CInt -> _\nfoo = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, ForeignFunctionInterface #-}\nmodule WildcardInForeignImport where\n\nimport Foreign.C\n\nforeign import ccall \"sin\" c_sin :: CDouble -> _\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, GADTs #-}\nmodule WildcardInGADT1 where\n\ndata Foo a where\n  Foo :: Either a _ -> Foo a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, GADTs #-}\nmodule WildcardInGADT2 where\n\ndata Foo a where\n  Foo :: (Eq a, _) => Maybe a -> Foo a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInInstanceHead where\n\nclass Foo k where\n  bar :: k\n\ninstance Foo _ where\n  bar = 3\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs #-}\nmodule WildcardInInstanceSig where\n\ninstance Num Bool where\n  negate :: _\n  negate = undefined\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInNewtype where\n\n-- Currently handled by the same checks as for ADTs, but in case this\n-- changes in the future, add at least one test.\n\nnewtype Foo a = Foo (Either _ a)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule WildcardInPatSynSig where\n\npattern Single :: () => (Show a) => _ -> [a]\npattern Single x = [x]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\nmodule WildcardInStandaloneDeriving where\n\nderiving instance _\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedWildCards, ScopedTypeVariables, RankNTypes #-}\nmodule WildcardInstantiations where\n\n\nfoo :: (Show _a, _) => _a -> _\nfoo x = show (succ x)\n\nbar :: _ -> _ -> _\nbar x y = y x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures, TypeFamilies, InstanceSigs #-}\nmodule WildcardInTypeFamilyInstanceRHS where\n\nclass Foo k where\n  type Dual k :: *\n\ninstance Foo Int where\n  type Dual Int = Maybe _\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInTypeSynonymLHS where\n\ntype Foo _ = Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\nmodule WildcardInTypeSynonymRHS where\n\ntype Foo = Maybe _\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedWildCards, ScopedTypeVariables #-}\nmodule WildcardsInPatternAndExprSig where\n\nbar (Just ([x :: _a] :: _) :: Maybe [_b]) (z :: _c) = [x, z] :: [_d]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n\n{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern Single x = [x]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bundle(A(..)) where\n\nimport BundleInternal (A(..))\n\nfoo = MkA 5\nbaz = NoA\n\nqux (MkA x) = x\nqux NoA = 0\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Associated1(A(..)) where\n\nimport BundleInternal1 (A(..))\n\nfoo = MkA 5\nbaz = NoA\n\nqux (MkA x) = x\nqux NoA = 0\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule BundleInternal (A(NewA,MkA, NoA)) where\n\nnewtype A = NewA (Maybe Int)\n\npattern MkA n = NewA (Just n)\n\npattern NoA = NewA Nothing\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule BundleInternal1 (A(NewA,MkA, NoA)) where\n\nnewtype A = NewA (Maybe Int)\n\npattern MkA n = NewA (Just n)\n\npattern NoA = NewA Nothing\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n\n{-# LANGUAGE PatternSynonyms, GADTs #-}\nmodule ShouldCompile where\n\ndata T a where\n        MkT :: (Eq b) => a -> b -> T a\n\npattern P x <- MkT 42 x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n\n{-# LANGUAGE PatternSynonyms, GADTs #-}\nmodule ShouldCompile where\n\ndata T a where\n        MkT :: (Eq b) => a -> b -> T a\n\npattern P x y <- MkT x y\n\nf :: T Bool -> Bool\nf (P x y) = x && y == y\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE PatternSynonyms, GADTs, ViewPatterns #-}\n\n-- Pattern synonyms\n\nmodule ShouldCompile where\n\ndata T a where\n        MkT :: (Eq b) => a -> b -> T a\n\nf :: (Show a) => a -> Bool\nf = undefined\n\npattern P x <- MkT (f -> True) x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n-- Existentially-quantified type variables\n\n{-# LANGUAGE GADTs, PatternSynonyms #-}\nmodule ShouldCompile where\n\ndata T where\n    MkT :: b -> (b -> Bool) -> T\n\npattern P x f <- MkT x f\n\ntest :: T -> Bool\ntest (P x f) = f x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule Foo ( A(foo) ) where\n\ndata A a = A a\n\npattern P :: Int -> A Int\npattern P{foo} = A foo\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule Foo ( A(P) ) where\n\nclass (f ~ A) => C f a where\n  build :: a -> f a\n  destruct :: f a -> a\n\ndata A a = A a\n\ninstance C A Int where\n  build n = A n\n  destruct (A n) = n\n\n\npattern P :: C f a => a -> f a\npattern P x <- (destruct -> x)\n  where\n        P x = build x\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile (pattern Single) where\n\npattern Single x <- [x]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule ExportSyntax ( A(.., NoA), Q(F,..), G(T,..,U)) where\n\ndata A = A | B\n\npattern NoA = B\n\ndata Q a = Q a\n\npattern F a = Q a\n\ndata G = G | H\n\npattern T = G\n\npattern U = H\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ExportSyntaxImport where\n\nimport ExportSyntax\n\nfoo = NoA\n\nbaz = A\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ImpExp_Exp (pattern Single) where\n\npattern Single x <- [x]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nimport ImpExp_Exp\n\nsingle :: [a] -> Maybe a\nsingle (Single x) = Just x\nsingle _ = Nothing\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n-- Generated code doesn't emit overlapping pattern warnings\n\n{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern P <- Just True\n\ntest1 P = 2\ntest1 Nothing = 3\ntest1 (Just _) = 4\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, PatternSynonyms #-}\n\n-- Tests that for unidirectional pattern synonyms\n-- the pattern synonym can be more existential\n-- (i.e. lose information) wrt the original\n\nmodule MoreEx where\n\npattern ExCons :: a -> [a] -> [b]\npattern ExCons x xs <- x : xs\n\ndata T where\n  MkT1 :: ([a] -> Int) -> [a] -> T\n  MkT2 :: (a -> Int) -> a -> T\n\npattern ExT1 :: b -> (b -> Int) -> T\npattern ExT1 x f <- MkT1 f x\n\npattern ExT2 :: b -> (c -> Int) -> T\npattern ExT2 x f <- MkT2 f x\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule Foo (A(B, C)) where\n\ndata A a = A\n\npattern B :: A Int\npattern B = A\n\npattern C :: A String\npattern C = A\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n\n{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern P = 42\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n-- Generated code doesn't emit overlapping pattern warnings\n\n{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern P = ()\n\ntest P = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns #-}\nmodule Foo (Foo(P)) where\n\ndata Foo a = Foo a\n\ninstance C Foo where\n  build a = Foo a\n  destruct (Foo a) = a\n\nclass C f where\n  build :: a -> f a\n  destruct :: f a -> a\n\npattern P :: C f => a -> f a\npattern P x <- (destruct -> x)\n  where\n        P x = build x\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Foo (A(P,Q)) where\n\ndata A a = A a\n\npattern P :: Show a => a -> A a\npattern P a = A a\n\npattern Q :: (A ~ f) => a -> f a\npattern Q a = A a\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE PolyKinds #-}\n\n-- Testing polykindedness\n\nmodule Foo ( A(P) ) where\n\ndata A a = A\n\npattern P = A\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern Single{x} = [x]\n\n-- Selector\nselector :: Int\nselector = x [5]\n\nupdate :: [String]\nupdate = [\"String\"] { x = \"updated\" }\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule PolyPat where\n\n-- Testing whether type changing updates work correctly.\n\npattern MyTuple :: a -> b -> (a, b)\npattern MyTuple{mfst, msnd} = (mfst, msnd)\n\n\nexpr1 :: (Int, String) -> (Int, Int)\nexpr1 a = a { msnd = 2}\n\nexpr3 a = a { msnd = 2}\n\nexpr2 :: (a, b) -> a\nexpr2 a = mfst a\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns, GADTs, RankNTypes,\n StandaloneDeriving, FlexibleInstances #-}\nmodule ShouldCompile where\n\n-- Testing that selectors work properly with prov and req thetas\n\ndata T a b where\n  MkT :: (Show b) => a -> b -> T a b\n\nderiving instance Show (T Int A)\n\ndata G a b = MkG { care :: a,  y :: (Show b => b) }\n\npattern ExNumPat :: (Eq b) => (Show b) => b -> T Int b\npattern ExNumPat{x} = MkT 42 x\n\ndata A = A | B deriving (Show, Eq)\n\nf3 :: T Int A\nf3 = (MkT 42 A) { x = B }\n\nf5 :: T Int A\nf5 = (ExNumPat A) { x = B }\n\n\nf4 = (MkG 42 True) { y = False }\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE NoImplicitPrelude #-}\nmodule Main where\n\nimport Prelude (Maybe(..), Show(..), String, Bool(..), print)\n\npattern ReqNoProv :: Show a => a -> Maybe a\npattern ReqNoProv{j} = Just j\n\np1 = ReqNoProv True\n\np7 (ReqNoProv _) = ReqNoProv False\n\np6 = p1 {j = False}\n\nmain = print p6\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE PatternSynonyms, GADTs, ViewPatterns #-}\n\n-- Pattern synonyms\n\nmodule ShouldCompile where\n\ndata T a where\n  MkT :: (Eq b) => a -> b -> T a\n\nf :: (Show a) => a -> Bool\nf = undefined\n\npattern P{x} <- MkT (f -> True) x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T10747 where\n\npattern head `Cons` tail = head : tail\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10897 where\nimport T10897a\n\nSingle y = True\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule T10897a where\npattern Single :: a -> a\npattern Single x = x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10997 where\n\nimport T10997a\n\nfoo :: Exp a -> String\nfoo Tru = \"True\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, PatternSynonyms #-}\n\nmodule T10997a where\n\ndata Exp ty where\n  LitB :: Bool -> Exp Bool\n\npattern Tru :: () => b ~ Bool => Exp b\npattern Tru = LitB True\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10997_1 where\n\nimport T10997_1a\n\n{- With ghc-7.10.2:\n\n    The interface for \u00e2\u20ac\u02dcT10997a\u00e2\u20ac\u2122\n    Declaration for Just'\n    Pattern synonym Just':\n    Iface type variable out of scope:  k\n    Cannot continue after interface file error\n-}\n\nbar :: (Showable a) => Maybe a -> Maybe a\nbar (Just' a) = Just' a\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns, ConstraintKinds, TypeFamilies, PolyKinds, KindSignatures #-}\nmodule T10997_1a where\n\nimport Data.Kind\n\ntype family Showable (a :: k) :: Constraint where\n  Showable (a :: Type) = (Show a)\n  Showable a           = ()\n\nextractJust :: Maybe a -> (Bool, a)\nextractJust (Just a) = (True, a)\nextractJust _        = (False, undefined)\n\npattern Just' :: Showable a => a -> (Maybe a)\npattern Just' a <- (extractJust -> (True, a)) where\n  Just' a = Just a\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, GADTs #-}\n{-# OPTIONS_GHC -fwarn-missing-pattern-synonym-signatures #-}\n\n{-\nTest the printing of pattern synonym types (pprPatSynType)\nWe test all valid combinations of:\n    universal type variables      yes/no\n    \"required\" context            yes/no\n    existential type variables    yes/no\n    \"provided\" context            yes/no\n-}\n\nmodule T11213 where\n\ndata Ex         where MkEx       :: a -> Ex\ndata ExProv     where MkExProv   :: (Show a) => a -> ExProv\ndata UnivProv a where MkUnivProv :: (Show a) => a -> UnivProv a\n\npattern P         <-  True\npattern Pe    x   <-  MkEx x\npattern Pu    x   <-  x\npattern Pue   x y <- (x, MkEx y)\npattern Pur   x   <-  [x, 1]\npattern Purp  x y <- ([x, 1], MkUnivProv y)\npattern Pure  x y <- ([x, 1], MkEx y)\npattern Purep x y <- ([x, 1], MkExProv y)\npattern Pep   x   <-  MkExProv x\npattern Pup   x   <-  MkUnivProv x\npattern Puep  x y <- (MkExProv x, y)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, GADTs, RankNTypes #-}\n\nmodule T11224b where\n\ndata T b where\n  MkT :: a -> b -> T b\n\n-- Should be fine!\n-- pattern P :: c -> d -> T d\npattern P :: forall d. forall c. c -> d -> T d\npattern P x y <- MkT x y\n\n\n\n\n\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, RecordWildCards #-}\nmodule T11283 where\ndata P = MkP Bool\npattern S{x} = MkP x\nd = S{x = True}\ne = S{..}\nf S{x=x} = x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule Bug where\n\ndata AST s a\n  where\n    Sym  :: s a -> AST s a\n    (:$) :: AST s (a -> b) -> AST s a -> AST s b\n\ndata A sig where A :: A (a -> a)\ndata B sig where B :: B (a -> a)\n\ndata AB a\n  where\n    AA :: A a -> AB a\n    BB :: B a -> AB a\n\nclass Prj s where prj :: AB a -> Maybe (s a)\n\ninstance Prj A\n  where\n    prj (AA s) = Just s\n    prj _      = Nothing\n\ninstance Prj B\n  where\n    prj (BB s) = Just s\n    prj _      = Nothing\n\npattern SymP s <- Sym (prj -> Just s)\n\nfun :: AST AB a -> AST AB a\nfun (SymP A :$ _) = undefined\nfun (SymP B :$ _) = undefined\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, TypeApplications, ScopedTypeVariables, ViewPatterns,\n             AllowAmbiguousTypes #-}\n\nmodule T11351 where\n\nimport GHC.TypeLits\nimport Data.Proxy\n\nsymbol :: forall s. KnownSymbol s => String\nsymbol = symbolVal @s Proxy\n\n-- Not in scope: type variable \u00e2\u20ac\u02dcs\u00e2\u20ac\u2122\n-- Not in scope: type variable \u00e2\u20ac\u02dcs\u00e2\u20ac\u2122\npattern Symbol :: forall s. KnownSymbol s => String\npattern Symbol <- ((== symbol @s) -> True) where\n         Symbol = symbol @s\n\n-- \u00e2\u20ac\u00a2 Could not deduce (KnownSymbol n0)\n--     arising from a use of \u00e2\u20ac\u02dcsymbolVal\u00e2\u20ac\u2122\n--   from the context: KnownSymbol s\n--     bound by the type signature for pattern synonym \u00e2\u20ac\u02dcSymbol\u00e2\u20ac\u2122:\n--                String\npattern Symbol2 :: forall s. KnownSymbol s => String\npattern Symbol2 <- ((== symbolVal (Proxy :: Proxy s)) -> True)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns #-}\nmodule T11367 where\n\npattern A :: Int -> String\npattern A n <- (read -> n) where\n        A 0 = \"hi\"\n        A 1 = \"bye\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T11633 where\n\ndata ARecord = ARecord {anInt :: Int, aString :: String}\n\n-- This works...\npattern AGoodPat :: Int -> String -> ARecord\npattern AGoodPat n s = ARecord {anInt=n, aString=s}\n\npattern ABadPat :: Int -> String -> ARecord\npattern ABadPat n s = ARecord {aString=s, anInt=n}\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T11727 where\n\npattern A,B :: Int\npattern A = 5\npattern B = 5\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Main where\n\nimport T11959Lib (Vec2(..), pattern (:>))\n\nmain = return ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns #-}\nmodule T11959Lib (Vec2(Nil,(:>)), pattern (:>)) where\n\nnewtype Vec2 a = Vec2 {unvec2 :: [a]}\n\npattern Nil :: Vec2 a\npattern Nil = Vec2 []\n\npattern (:>) x xs <- ((\\ys -> (head $ unvec2 ys,Vec2 . tail $ unvec2 ys)) -> (x,xs))\n  where\n    (:>) x xs = Vec2 (x:unvec2 xs)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns, PatternSynonyms #-}\n\nmodule T11977 where\n\n-- A pattern synonym for a /function/\n\npattern F :: b -> Char -> b\npattern F a <- (($ 'a') -> a)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns, PatternSynonyms, RecordWildCards #-}\nmodule T11987 where\n\nimport T11987a\n\n-- works\nnamedFieldPuns :: (Int,Int)\nnamedFieldPuns = let { x = 1; y = 2 } in Point { x, y }\n\n-- error: Pattern synonym \u00e2\u20ac\u02dcPoint\u00e2\u20ac\u2122 used as a data constructor\nrecordWildCards :: (Int,Int)\nrecordWildCards = let { x = 1; y = 2 } in Point { .. }\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns, PatternSynonyms, RecordWildCards #-}\nmodule T11987a where\n\npattern Point :: Int -> Int -> (Int, Int)\npattern Point{x, y} = (x, y)\n\n-- works\nsameFile :: (Int,Int)\nsameFile = let { x = 1; y = 2 } in Point { .. }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule T12094 where\n\nimport GHC.Exts (Int#)\n\npattern Zero :: Int# -- commenting out this line works\npattern Zero <- 0#\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T12108 where\n\ntype Endo a = a -> a\n\npattern Id :: Endo a\npattern Id x = x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wmissing-pattern-synonym-signatures #-}\n{-# LANGUAGE PatternSynonyms #-}\n\nmodule T12484 where\n\npattern RP x = (x, True)\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns #-}\n\nmodule T12489 where\npattern P :: a -> b\npattern P a <- (undefined -> a)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude, PatternSynonyms #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Test where\n\nx :: ()\nx = ()\n\npattern Point2 :: () -> () -> ((), ())\npattern Point2 x y = (x, y)\n\npattern Point :: () -> () -> ((), ())\npattern Point{x1, y1} = (x1, y1)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language ViewPatterns, TypeOperators, KindSignatures, PolyKinds,\n             StandaloneDeriving, GADTs, RebindableSyntax,\n             RankNTypes, LambdaCase, PatternSynonyms, TypeApplications #-}\n\nmodule T12698 where\n\nimport GHC.Types\nimport Prelude hiding ( fromInteger )\nimport Data.Type.Equality hiding ((:~~:)(..))\nimport Data.Kind\nimport qualified Prelude\n\nclass Ty (a :: k) where ty :: T a\ninstance Ty Int where ty = TI\ninstance Ty Bool where ty = TB\ninstance Ty a => Ty [a] where ty = TA TL ty\ninstance Ty [] where ty = TL\ninstance Ty (,) where ty = TP\n\ndata AppResult (t :: k) where\n  App :: T a -> T b -> AppResult (a b)\n\ndata T :: forall k. k -> Type where\n  TI :: T Int\n  TB :: T Bool\n  TL :: T []\n  TP :: T (,)\n  TA :: T f -> T x -> T (f x)\nderiving instance Show (T a)\n\nsplitApp :: T a -> Maybe (AppResult a)\nsplitApp = \\case\n  TI -> Nothing\n  TB -> Nothing\n  TL -> Nothing\n  TP -> Nothing\n  TA f x -> Just (App f x)\n\ndata (a :: k1) :~~: (b :: k2) where\n  HRefl :: a :~~: a\n\neqT :: T a -> T b -> Maybe (a :~~: b)\neqT a b =\n  case (a, b) of\n    (TI, TI) -> Just HRefl\n    (TB, TB) -> Just HRefl\n    (TL, TL) -> Just HRefl\n    (TP, TP) -> Just HRefl\n\npattern List :: () => [] ~~ b => T b\npattern List <- (eqT (ty @(Type -> Type) @[]) -> Just HRefl)\n  where List = ty\n\npattern Int :: () => Int ~~ b => T b\npattern Int <- (eqT (ty @Type @Int) -> Just HRefl)\n  where Int = ty\n\npattern (:<->:) :: () => fx ~ f x => T f -> T x -> T fx\npattern f :<->: x <- (splitApp -> Just (App f x))\n  where f :<->: x = TA f x\n\npattern Foo <- List :<->: Int\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12746 where\n\nimport T12746A\n\nfoo a = case a of\n        Foo -> True\n        _ -> False\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, PatternSynonyms #-}\nmodule T12746A where\n\npattern Foo :: Int\npattern Foo = 0x00000001\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds , GADTs, ScopedTypeVariables, PatternSynonyms,\n      ViewPatterns #-}\n\nmodule T12968 where\n\ndata TypeRep (a :: k)\n\ndata TRAppG (fun :: k2) where\n  TRAppG :: forall k1 k2 (a :: k1 -> k2) (b :: k1) .\n            TypeRep a -> TypeRep b -> TRAppG (a b)\n\npattern TRApp :: forall k2 (fun :: k2). ()\n              => forall k1 (a :: k1 -> k2) (b :: k1). (fun ~ a b)\n              => TypeRep a -> TypeRep b -> TypeRep fun\npattern TRApp a b <- ((undefined :: TypeRep fun -> TRAppG fun) -> TRAppG a b)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T13349b where\n\npattern Nada = Nothing\n\n-- Not orphan because it mentions the locally-defined Nada.\n{-# COMPLETE Just, Nada #-}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, PatternSynonyms, DataKinds, PolyKinds,\n             GADTs, TypeOperators, TypeFamilies #-}\n\nmodule T13441 where\n\nimport Data.Functor.Identity\n\ndata FList f xs where\n  FNil :: FList f '[]\n  (:@) :: f x -> FList f xs -> FList f (x ': xs)\n\ndata Nat = Zero | Succ Nat\n\ntype family Length (xs :: [k]) :: Nat where\n  Length '[]       = Zero\n  Length (_ ': xs) = Succ (Length xs)\n\ntype family Replicate (n :: Nat) (x :: a) = (r :: [a]) where\n  Replicate Zero     _ = '[]\n  Replicate (Succ n) x = x ': Replicate n x\n\ntype Vec n a = FList Identity (Replicate n a)\n\n-- Using explicitly-bidirectional pattern\npattern (:>) :: forall n a. n ~ Length (Replicate n a)\n             => forall m. n ~ Succ m\n             => a -> Vec m a -> Vec n a\npattern x :> xs <- Identity x :@ xs\n  where\n    x :> xs = Identity x :@ xs\n\n-- Using implicitly-bidirectional pattern\npattern (:>>) :: forall n a. n ~ Length (Replicate n a)\n             => forall m. n ~ Succ m\n             => a -> Vec m a -> Vec n a\npattern x :>> xs = Identity x :@ xs\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, GADTs #-}\nmodule T13441a where\n\ndata S where\n  MkS :: Eq a => [a] -> S\n\n-- Unidirectional pattern binding;\n-- the existential is more specific than needed\n-- c.f. T13441b\npattern P :: () => Eq x => x -> S\npattern P x <- MkS x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, GADTs #-}\nmodule T13441a where\n\ndata S where\n  MkS :: Eq a => [a] -> S\n\n-- Implicitly-bidirectional pattern binding;\n-- the existential is more specific than needed,\n-- and hence should be rejected\n-- c.f. T13441a\npattern P :: () => Eq x => x -> S\npattern P x = MkS x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns #-}\nmodule T13454 where\n\npattern MkOp :: Op -> Exp -> Exp -> Exp\npattern MkOp {(\u00c2\u00b7), a, b} <- (splitOp -> Just ((\u00c2\u00b7), a, b))\n  where MkOp (\u00c2\u00b7) a b      = a \u00c2\u00b7 b\n\ndata Exp = Val Int | Add Exp Exp | Mul Exp Exp deriving Show\n\ntype Op = Exp -> Exp -> Exp\n\nsplitOp :: Exp -> Maybe (Op, Exp, Exp)\nsplitOp (Add a b) = Just (Add, a, b)\nsplitOp (Mul a b) = Just (Mul, a, b)\nsplitOp _         = Nothing\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds, PatternSynonyms, RankNTypes #-}\n\nmodule T13752 where\n\nnewtype Arrange = Arrange {getArrange :: [Int] -> [Int]}\n\npattern Heh :: (c ~ ((~) Int)) => (forall a. c a => [a] -> [a]) -> Arrange\n-- pattern Heh :: (forall a. (Int ~ a) => [a] -> [a]) -> Arrange\npattern Heh f <- Arrange f\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, RankNTypes #-}\n\nmodule T13752a where\n\ndata T = MkT (forall a. a->a)\n\npattern P :: (Int -> Int) -> T\npattern P x <- MkT x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE ViewPatterns #-}\nmodule T13768 where\n\nimport Data.Kind (Type)\n\ndata NS (f :: k -> Type) (xs :: [k]) = NS Int\n\ndata IsNS (f :: k -> Type) (xs :: [k]) where\n  IsZ :: f x -> IsNS f (x ': xs)\n  IsS :: NS f xs -> IsNS f (x ': xs)\n\nisNS :: NS f xs -> IsNS f xs\nisNS = undefined\n\npattern Z :: () => (xs' ~ (x ': xs)) => f x -> NS f xs'\npattern Z x <- (isNS -> IsZ x)\n\npattern S :: () => (xs' ~ (x ': xs)) => NS f xs -> NS f xs'\npattern S p <- (isNS -> IsS p)\n\n{-# COMPLETE Z, S #-}\n\ndata SList :: [k] -> Type where\n  SNil  :: SList '[]\n  SCons :: SList (x ': xs)\n\ngo :: SList ys -> NS f ys -> Int\ngo SCons (Z _) = 0\ngo SCons (S _) = 1\ngo SNil  _     = error \"inaccessible\"\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T14058 where\n\nimport T14058a (Sing(..))\n\nfoo :: Sing ('[ '[] ] :: [[a]])\nfoo = SCons SNil SNil\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14058a (Sing(.., SCons)) where\n\ndata family Sing (a :: k)\n\ndata instance Sing (z :: [a]) where\n  SNil :: Sing '[]\n  (:%) :: Sing x -> Sing xs -> Sing (x:xs)\n\npattern SCons :: forall a (z :: [a]). ()\n              => forall (x :: a) (xs :: [a]). z ~ (x:xs)\n              => Sing x -> Sing xs -> Sing z\npattern SCons x xs = (:%) x xs\n{-# COMPLETE SNil, SCons #-}\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ExplicitForAll #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\nmodule T14326 where\n\ndata E a b = L' a | R b\npattern L :: forall b a. a -> E a b\npattern L a = L' a\n{-# COMPLETE L, R #-}\n\ntestMono :: E (E Int Int) Int -> Int\ntestMono x = case x of\n  L (L _) -> 0\n  L (R _) -> 1\n  R _ -> 2\n\ntestPoly :: E (E a b) c -> Int\ntestPoly x = case x of\n  L (L _) -> 0\n  L (R _) -> 1\n  R _ -> 2\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PatternSynonyms, ViewPatterns, GADTs, ConstraintKinds, RankNTypes, KindSignatures, PolyKinds, ScopedTypeVariables, DataKinds #-}\n\nmodule T14498 where\n\nimport Type.Reflection\nimport Data.Kind\n\ndata Dict c where Dict :: c => Dict c\n\nasTypeable :: TypeRep a -> Dict (Typeable a)\nasTypeable rep =\n  withTypeable rep\n    Dict\n\npattern Typeable :: () => Typeable a => TypeRep a\npattern Typeable <- (asTypeable -> Dict)\n  where Typeable = typeRep\n\ndata N = O | S N\n\ntype SN = (TypeRep :: N -> Type)\n\npattern SO = (Typeable :: TypeRep (O::N))\n\npattern SS ::\n     forall k' (t :: k').\n     ()\n  => forall kk (a :: kk -> k') (n :: kk).\n     (t ~ a n)\n  =>\n  TypeRep n -> TypeRep t\npattern SS n <- (App (Typeable :: TypeRep (a ::kk -> k')) n)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, ViewPatterns, PatternSynonyms, TypeOperators, ScopedTypeVariables,\n             KindSignatures, PolyKinds, DataKinds, TypeFamilies, GADTs #-}\n\nmodule T14552 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata family Sing a\n\ntype a --> b = (a, b) -> Type\n\ntype family F (f::a --> b) (x::a) :: b\n\nnewtype Limit :: (k --> Type) -> Type where\n  Limit :: (forall xx. Proxy xx -> F f xx) -> Limit f\n\ndata Exp :: [Type] -> Type -> Type where\n  TLam :: (forall aa. Proxy aa -> Exp xs (F w aa))\n        -> Exp xs (Limit w)\n\npattern FOO f <- TLam (($ Proxy) -> f)\n\n\n{-\nTLam :: forall (xs::[Type]) (b::Type).   -- Universal\n         forall k (w :: k --> Type).      -- Existential\n         (b ~ Limit w) =>\n         => (forall (aa :: k). Proxy aa -> Exp xs (F w aa))\n         -> Exp xs b\n\n-}\n\n{-\nmfoo :: Exp xs b\n     -> (forall k (w :: k --> Type).\n         (b ~ Limit w)\n         => Exp xs (F w aa)\n         -> r)\n     -> r\nmfoo scrut k = case srcut of\n                 TLam g -> k (g Proxy)\n-}\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern Single :: a -> [a]\npattern Single x = [x]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE PatternSynonyms #-}\n\nmodule ShouldCompile where\n\npattern Single :: Show a => a -> [a]\npattern Single x = [x]\n\nf :: (Show a) => [a] -> a\nf (Single x) = x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern SinglePair :: (a, a) -> [(a, a)]\npattern SinglePair x = [x]\n\nf :: (Show a) => [(a, a)] -> String\nf (SinglePair x) = show x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, KindSignatures, PatternSynonyms, DataKinds, GADTs  #-}\n\nmodule T8966 where\n\nimport Data.Kind (Type)\n\ndata NQ :: [k] -> Type where\n   D :: NQ '[a]\n\npattern Q = D\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures, PatternSynonyms #-}\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\ndata X :: (Type -> Type) -> Type -> Type where\n  Y :: f a -> X f (Maybe a)\n\npattern C :: a -> X Maybe (Maybe a)\npattern C x = Y (Just x)\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures, PatternSynonyms, FlexibleContexts #-}\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\ndata X :: (Type -> Type) -> Type -> Type where\n  Y :: (Show a) => f a -> X f (Maybe a)\n\npattern C :: (Show (a, Bool)) => a -> X Maybe (Maybe (a, Bool))\npattern C x = Y (Just (x, True))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures, PatternSynonyms #-}\nmodule ShouldCompile where\n\ndata T a b where\n  MkT :: a -> T a Bool\n\npattern P :: T Bool b\npattern P <- MkT True\n\npattern D :: a -> T (Maybe a) Bool\npattern D x = MkT (Just x)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T9023 where\n\npattern P a b = Just (a, b)\nfoo P{} = True\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, MagicHash #-}\nmodule ShouldCompile where\n\npattern P = 0#\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n-----------------------------------------------------------------------------\n-- |\n-- Copyright   :  (C) 2014 Edward Kmett\n-- License     :  BSD-style (see the file LICENSE)\n-- Maintainer  :  Edward Kmett <ekmett@gmail.com>\n-- Stability   :  experimental\n-- Portability :  PatternSynonyms\n--\n-- Half-precision floating-point values. These arise commonly in GPU work\n-- and it is useful to be able to compute them and compute with them on the\n-- CPU as well.\n----------------------------------------------------------------------------\n\nmodule T9857 \n  ( Half(..)\n  , isZero\n  , fromHalf\n  , toHalf\n  , pattern POS_INF\n  , pattern NEG_INF\n  , pattern QNaN\n  , pattern SNaN\n  , pattern HALF_MIN\n  , pattern HALF_NRM_MIN\n  , pattern HALF_MAX\n  , pattern HALF_EPSILON\n  , pattern HALF_DIG\n  , pattern HALF_MIN_10_EXP\n  , pattern HALF_MAX_10_EXP\n  ) where\n\nimport Data.Bits\nimport Data.Function (on)\nimport Data.Typeable\nimport Foreign.C.Types\nimport Foreign.Storable\nimport Text.Read\n\n-- | Convert a 'Float' to a 'Half' with proper rounding, while preserving NaN and dealing appropriately with infinity\nforeign import ccall unsafe \"hs_floatToHalf\" toHalf :: Float -> Half\n{-# RULES \"toHalf\"  realToFrac = toHalf #-}\n\n-- | Convert a 'Half' to a 'Float' while preserving NaN\nforeign import ccall unsafe \"hs_halfToFloat\" fromHalf :: Half -> Float\n{-# RULES \"fromHalf\" realToFrac = fromHalf #-}\n\nnewtype {-# CTYPE \"unsigned short\" #-} Half = Half { getHalf :: CUShort } deriving (Storable, Typeable)\n\ninstance Show Half where\n  showsPrec d h = showsPrec d (fromHalf h)\n\ninstance Read Half where\n  readPrec = fmap toHalf readPrec\n\ninstance Eq Half where\n  (==) = (==) `on` fromHalf\n\ninstance Ord Half where\n  compare = compare `on` fromHalf\n\ninstance Real Half where\n  toRational = toRational . fromHalf\n\ninstance Fractional Half where\n  fromRational = toHalf . fromRational\n  recip = toHalf . recip . fromHalf\n  a / b = toHalf $ fromHalf a / fromHalf b\n\ninstance RealFrac Half where\n  properFraction a = case properFraction (fromHalf a) of\n    (b, c) -> (b, toHalf c)\n  truncate = truncate . fromHalf\n  round = round . fromHalf\n  ceiling = ceiling . fromHalf\n  floor = floor . fromHalf\n\ninstance Floating Half where\n  pi = toHalf pi\n  exp = toHalf . exp . fromHalf\n  sqrt = toHalf . sqrt . fromHalf\n  log = toHalf . log . fromHalf\n  a ** b = toHalf $ fromHalf a ** fromHalf b\n  logBase a b = toHalf $ logBase (fromHalf a) (fromHalf b)\n  sin = toHalf . sin . fromHalf\n  tan = toHalf . tan . fromHalf\n  cos = toHalf . cos . fromHalf\n  asin = toHalf . asin . fromHalf\n  atan = toHalf . atan . fromHalf\n  acos = toHalf . acos . fromHalf\n  sinh = toHalf . sinh . fromHalf\n  tanh = toHalf . tanh . fromHalf\n  cosh = toHalf . cosh . fromHalf\n  asinh = toHalf . asinh . fromHalf\n  atanh = toHalf . atanh . fromHalf\n  acosh = toHalf . acosh . fromHalf\n\ninstance RealFloat Half where\n  floatRadix  _ = 2\n  floatDigits _ = 11\n  decodeFloat = decodeFloat . fromHalf\n  isInfinite (Half h) = unsafeShiftR h 10 .&. 0x1f >= 32\n  isIEEE _ = isIEEE (undefined :: Float)\n  atan2 a b = toHalf $ atan2 (fromHalf a) (fromHalf b)\n  isDenormalized (Half h) = unsafeShiftR h 10 .&. 0x1f == 0 && h .&. 0x3ff /= 0\n  isNaN (Half h) = unsafeShiftR h 10 .&. 0x1f == 0x1f && h .&. 0x3ff /= 0\n  isNegativeZero (Half h) = h == 0x8000\n  floatRange _ = (16,-13)\n  encodeFloat i j = toHalf $ encodeFloat i j\n  exponent = exponent . fromHalf\n  significand = toHalf . significand . fromHalf\n  scaleFloat n = toHalf . scaleFloat n . fromHalf\n\n-- | Is this 'Half' equal to 0?\nisZero :: Half -> Bool\nisZero (Half h) = h .&. 0x7fff == 0\n\n-- | Positive infinity\npattern POS_INF = Half 0x7c00\n\n-- | Negative infinity\npattern NEG_INF = Half 0xfc00\n\n-- | Quiet NaN\npattern QNaN    = Half 0x7fff\n\n-- | Signalling NaN\npattern SNaN    = Half 0x7dff\n\n-- | Smallest positive half\npattern HALF_MIN = 5.96046448e-08 :: Half \n\n-- | Smallest positive normalized half\npattern HALF_NRM_MIN = 6.10351562e-05 :: Half\n\n-- | Largest positive half\npattern HALF_MAX = 65504.0 :: Half\n\n-- | Smallest positive e for which half (1.0 + e) != half (1.0)\npattern HALF_EPSILON = 0.00097656 :: Half\n\n-- | Number of base 10 digits that can be represented without change\npattern HALF_DIG = 2 \n\n-- Minimum positive integer such that 10 raised to that power is a normalized half\npattern HALF_MIN_10_EXP = -4\n\n-- Maximum positive integer such that 10 raised to that power is a normalized half\npattern HALF_MAX_10_EXP = 4\n\ninstance Num Half where\n  a * b = toHalf (fromHalf a * fromHalf b)\n  a - b = toHalf (fromHalf a - fromHalf b)\n  a + b = toHalf (fromHalf a + fromHalf b)\n  negate (Half a) = Half (xor 0x8000 a)\n  abs = toHalf . abs . fromHalf\n  signum = toHalf . signum . fromHalf\n  fromInteger a = toHalf (fromInteger a)\n", "num_lines": 163}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ScopedTypeVariables #-}\n\nmodule T9867 where\n\npattern Nil = [] :: [a]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern Id x = x\n\nId x = True\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule T9975a where\n\ndata Test = Test { x :: Int }\npattern Test wat = Test { x = wat }\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule T9975b where\n\ndata Test = Test { x :: Int }\npattern PTest wat = Test { x = wat }\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TransAssociated(A(..)) where\n\nimport Bundle (A(..))\n\nfoo = MkA 5\nbaz = NoA\n\nqux (MkA x) = x\nqux NoA = 0\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, MagicHash, BangPatterns #-}\nmodule ShouldCompile where\n\nimport GHC.Base\n\ndata Foo = MkFoo Int# Int#\n\npattern P x = MkFoo 0# x\n\nf x = let !(P arg) = x in arg\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n-- Universially-quantified type variables\n\n{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldCompile where\n\npattern Single x <- [x]\n\nsingleTuple :: [a] -> [b] -> Maybe (a, b)\nsingleTuple (Single x) (Single y) = Just (x, y)\nsingleTuple _          _          = Nothing\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wincomplete-patterns #-}\nmodule T13350 where\n\nimport Boolean\n\nbooleanToInt :: Boolean -> Int\nbooleanToInt F = 0\nbooleanToInt T = 1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Boolean (Boolean, pattern F, pattern T) where\n\nnewtype Boolean = Boolean Int\n\npattern F, T :: Boolean\npattern F = Boolean 0\npattern T = Boolean 1\n{-# COMPLETE F, T #-}\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldFail where\n\n-- This is now ok (following GHC proposal #94)\npattern P x y <- x@(Just y)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule Foo (MyClass(.., P)) where\n\npattern P = Nothing\n\nclass MyClass a where\n  foo :: a -> Int\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Foo( R(P,x)) where\n\ndata Q = Q Int\n\ndata R = R\n\npattern P{x} = Q x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule Foo ( B(P) ) where\n\nclass (f ~ A) => C f a where\n  build :: a -> f a\n  destruct :: f a -> a\n\ndata A a = A a\n\ndata B a = B a\n\ninstance C A Int where\n  build n = A n\n  destruct (A n) = n\n\n\npattern P :: C f a => a -> f a\npattern P x <- (destruct -> x)\n  where\n        P x = build x\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo(A(.., B)) where\n\ndata A = A | B\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule Foo ( A(P) ) where\n\ndata A = A\ndata B = B\n\ntype C = B\n\npattern P :: C\npattern P = B\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule Export (A(..,MyB), B(MyA), C(MyC)) where\n\ndata A = A\n\ndata B = B\n\npattern MyB = B\n\npattern MyA = A\n\ndata C a = C\n\npattern MyC = B\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Foo where\n\nimport ImportSyntax (A(.., B))\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldFail where\n\nvarWithLocalPatSyn x = case x of\n    P -> ()\n  where\n    pattern P = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Foo where\n\n\npattern A { a } = Just a\npattern B { b } = Just b\n\nfoo :: Maybe a -> Maybe Bool\nfoo x = x { a = True, b = False }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ScopedTypeVariables #-}\nmodule ShouldFail where\n\npattern Single x = [(x :: Int)]\n\nf :: [Bool] -> Bool\nf (Single x) = x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Foo (A(P)) where\n\ndata A = A\n\ndata B = B\n\npattern P :: () => (f ~ B) => f\npattern P = B\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Qux where\n\n-- Make sure selectors aren't generated for normal synonyms\n\npattern Uni a = Just a\n\npattern a :+: b = (a, b)\n\nqux = a (Just True)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ExistentialQuantification #-}\nmodule ExQuant where\n\ndata Showable = forall a . Show a => Showable a\n\npattern Nasty{a} = Showable a\n\nqux = a (Showable True)\n\nfoo = (Showable ()) { a = True }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\ndata MyRec = MyRec { foo :: Int, qux :: String }\n\npattern HisRec{f1, f2} = MyRec{foo = f1, qux=f2}\n\nupdater,updater1, updater2 :: MyRec -> MyRec\nupdater a = a {f1 = 1 }\n\nupdater1 a = a {f1 = 1, qux = \"two\" }\n\nupdater2 a = a {f1 = 1, foo = 2 }\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule RecordPats where\n\n-- No updates\npattern Uni{a,b} <- (a, b)\n\nfoo = (\"a\",\"b\") { a = \"b\" }\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule RecordPats where\n\n-- No updates\npattern Uni{a} <- Just a\n\nqux = a (Just True)\n\nqux2 (Uni b) = b\n\nfoo = Uni { a = \"b\" }\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Main where\n\npattern ReqNoProv :: Show a => a -> Maybe a\npattern ReqNoProv{j} = Just j\n\ndata A = A deriving Show\n\np1 = Just True\n\np6 = p1 {j = A}\n\nmain = print p6\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns, EmptyCase #-}\n\npattern Id <- (id -> _) where\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, GADTs #-}\n\nmodule T10873 where\n\npattern Pat1 :: () => Show a => a -> Maybe a\npattern Pat1 x <- Just x\n\ndata T a where MkT :: (Ord a) => a -> T a\npattern Pat2 :: (Enum a) => Show a => a -> T a\npattern Pat2 x <- MkT x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ExistentialQuantification, GADTSyntax, TypeFamilies #-}\n\nmodule T11010 where\n\ndata Expr a where\n  Fun :: String -> (a -> b) -> (Expr a -> Expr b)\n\npattern IntFun :: (a ~ Int) => String -> (a -> b) -> (Expr a -> Expr b)\npattern IntFun str f x = Fun str f x\n\n-- Alternative syntax for pattern synonyms:\n--   pattern\n--     Suc :: () => (a ~ Int) => Expr a -> Expr Int\n--     Suc n <- IntFun _     _     n where\n--     Suc n =  IntFun \"suc\" (+ 1) n\npattern Suc :: (a ~ Int) => Expr a -> Expr Int\npattern Suc n <- IntFun _     _     n where\n         Suc n =  IntFun \"suc\" (+ 1) n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, TypeFamilies #-}\nmodule T11039 where\n\ndata A a = A a\n\n-- This should fail\npattern Q :: () => (A ~ f) => a -> f a\npattern Q a = A a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, TypeFamilies #-}\nmodule T11039a where\n\ndata A a = A a\n\n-- This should succeed\npattern Q2 :: (A ~ f) => a -> f a\npattern Q2 a = A a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n-- turn on with -fwarn-missing-pattern-synonym-signatures\n\nmodule Foo where\n\n-- Should warn because of missing signature\npattern T = True\n\npattern J a = Just a\n\npattern J1 a <- Just a\n\npattern J2{b} = Just b\n\npattern J3{c} <- Just c\n\npattern F :: Bool\npattern F = False\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, DataKinds #-}\n\npattern A = True\n\nclass    F a\ninstance F A\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, GADTs #-}\nmodule T11667 where\n\n{-\nThe following four pattern synonym declarations should give valid\nerror messages\n-}\n\n-- Check if we mention no explicit type signature (or the correct\n-- signature \"Eq a => Maybe a\")\npattern Pat1 :: Eq a => Maybe a\npattern Pat1 <- Just 42\n\n-- Check if we mention no explicit type signature (or the correct\n-- signature \"forall b. () => forall a. b ~ Bool => a -> b -> (b, T)\")\ndata T where MkT :: a -> T\npattern Pat2 :: () => b ~ Bool => a -> b -> (b, T)\npattern Pat2 x y = (y, MkT x)\n\n-- Check if we do not tell the user that we could not deduce (Show a)\n-- from the \"required\" context. Also, check if we do not give the\n-- possible fix that suggests to add (Show a) to the \"required\" context.\npattern Pat3 :: Eq a => Show a => a -> Maybe a\npattern Pat3 x <- Just x\n\n-- Check if we return a valid error message concerning the missing\n-- constraint (Num a) when the bidirectional pattern synonym is used\n-- in an expression context\ndata S a where MkS :: (Num a, Show a) => a -> S a\npattern Pat4 :: (Eq a) => (Show a) => S a\npattern Pat4 = MkS 42\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldFail where\n\npattern P :: a -> b -> Maybe (a,b)\npattern P :: foo => bar => blah -> urgh\npattern P x y = Just (x, y)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, ViewPatterns, TypeFamilies, KindSignatures #-}\n\nmodule T12819 where\n\ntype family F a  -- F :: * -> *\ndata T :: (* -> *) -> *\n\npattern Q :: T F -> String\npattern Q x <- (undefined -> x)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T13349 where\n\n{-# COMPLETE False #-}\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PatternSynonyms #-}\nmodule T13470 where\n\n\n-- Used to suggest importing not\npattern XInstrProxy :: (Bool -> Bool) -> a\npattern XInstrProxy not <- _\n\n\n-- Used to suggest 'tan' from another module\npattern P nan <- _\n\n\n\n-- Should suggest the inscope similar variable\npattern P1 x12345 <- Just x123456\n\n\n-- But not this one\nx1234567 = True\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule T14112 where\n\npattern MyJust1 a = Just !a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule T14114 where\n\npattern Foo1 a <- (a,a)\npattern Foo2 a  = (a,a)\npattern Foo3 a <- (a,a) where\n  Foo3 a = (a,a)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE PatternSynonyms #-}\n\nmodule T14380 where\n\ndata Foo = Foo [Int]\npattern Bar :: Foo\npattern Bar = Foo []\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PatternSynonyms, ViewPatterns, GADTs, ConstraintKinds, RankNTypes,\n             PolyKinds, ScopedTypeVariables, DataKinds, TypeOperators,\n             TypeApplications, TypeFamilies, TypeFamilyDependencies #-}\n\nmodule T14507 where\n\nimport Type.Reflection\nimport Data.Kind\n\nfoo :: TypeRep a -> (Bool :~~: k, TypeRep a)\nfoo rep = error \"urk\"\n\ntype family SING :: k -> Type where\n  SING = (TypeRep :: Bool -> Type)\n\npattern RepN :: forall kk (a::kk). () => Bool~kk => SING a -> TypeRep (a::kk)\npattern RepN tr <- (foo -> ( HRefl :: Bool:~~:kk\n                           , tr :: TypeRep (a::Bool)))\n\npattern SO x <- RepN (id -> x)\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule Oops where\n\npattern What = True :: Maybe\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language DataKinds, TypeOperators, PolyKinds, GADTs, PatternSynonyms #-}\n\nmodule T15685 where\n\nimport Data.Kind\n\ndata NS f as where\n Here :: f a -> NS f (a:as)\n\ndata NP :: (k -> Type) -> ([k] -> Type) where\n Nil :: NP f '[]\n\npattern HereNil = Here Nil\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule T15692 where\n\ndata F x where\n  FS :: F (f a) -> F a\n\npattern FS' = FS False\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, PatternSynonyms, TypeOperators, DataKinds, PolyKinds, KindSignatures, GADTs #-}\n\nmodule T15694 where\n\nimport Data.Kind\nimport Data.Type.Equality\n\ndata Ctx :: Type -> Type where\n E     :: Ctx(Type)\n (:&:) :: a -> Ctx(as) -> Ctx(a -> as)\n\ndata ApplyT(kind::Type) :: kind ->  Ctx(kind) -> Type where\n AO :: a -> ApplyT(Type) a E\n AS :: ApplyT(ks)      (f a) ctx\n    -> ApplyT(k -> ks) f     (a:&:ctx)\n\n\npattern ASSO :: () => forall ks k (f :: k -> ks) (a1 :: k) (ctx :: Ctx ks)\n                             (ks1 :: Type) k1 (a2 :: k1) (ctx1 :: Ctx ks1) a3.\n                     (kind ~ (k -> ks), a ~~ f, b ~~ (a1 :&: ctx),\n                      ks ~ (k1 -> ks1), ctx ~~ (a2 :&: E),\n                      ks1 ~ Type, f a1 a2 ~~ a3)\n                   => a3 -> ApplyT kind a b\n\npattern ASSO a = AS (AS (AO a))\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, PatternSynonyms, DataKinds, PolyKinds, GADTs,\n             TypeOperators, MultiParamTypeClasses, TypeFamilies,\n             TypeSynonymInstances, FlexibleInstances, InstanceSigs, FlexibleContexts #-}\n\n{-# Options_GHC -fdefer-type-errors #-}\n\nmodule T15695 where\n\nimport Data.Kind\nimport Data.Type.Equality\n\ndata TyVar :: Type -> Type -> Type where\n VO :: TyVar (a -> as) a\n VS :: TyVar as a -> TyVar (b -> as) a\n\ndata NP :: (k -> Type) -> ([k] -> Type) where\n Nil :: NP f '[]\n (:*) :: f a -> NP f as -> NP f (a:as)\n\ndata NS :: (k -> Type) -> ([k] -> Type) where\n Here  :: f a     -> NS f (a:as)\n There :: NS f as -> NS f (a:as)\n\ninfixr 6 :&:\ndata Ctx :: Type -> Type where\n E     :: Ctx(Type)\n (:&:) :: a -> Ctx(as) -> Ctx(a -> as)\n\ndata NA a\n\ntype SOP(kind::Type) code = NS (NP NA) code\n\ndata ApplyT(kind::Type) :: kind ->  Ctx(kind) -> Type where\n AO :: a -> ApplyT(Type) a E\n AS :: ApplyT(ks)      (f a) ctx\n    -> ApplyT(k -> ks) f     (a:&:ctx)\n\nfrom' :: ApplyT(Type -> Type -> Type) Either ctx -> NS (NP NA) '[ '[VO] ]\nfrom' (ASSO (Left  a)) = Here  (a :* Nil)\nfrom' (ASSO (Right b)) = There (Here undefined)\n\npattern ASSO\n  :: () =>\n     forall (ks :: Type) k (f :: k -> ks) (a1 :: k) (ks1 :: Type) k1 (f1 :: k1 -> ks1) (a2 :: k1) a3.\n     (kind ~ (k -> k1 -> Type), a ~~ f, b ~~ (a1 :&: a2 :&: E),\n      f a1 ~~ f1, f1 a2 ~~ a3) =>\n     a3 -> ApplyT kind a b\npattern ASSO a = AS (AS (AO a))\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE DataKinds #-}\n\npattern PATTERN = ()\n\nwrongLift :: PATTERN\nwrongLift = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-}\n\npattern PATTERN = ()\n\ndata Proxy (tag :: k) (a :: *)\n\nwrongLift :: Proxy PATTERN ()\nwrongLift = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nclass C a where\n    pattern P = ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nclass C a where\n    method :: a\n\ninstance C Int where\n    pattern P = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, MagicHash #-}\n{-# OPTIONS_GHC -Wunbanged-strict-patterns -Werror=unbanged-strict-patterns #-}\nmodule ShouldFail where\n\nimport GHC.Base\n\ndata Foo = MkFoo Int# Int#\n\npattern P x = MkFoo 0# x\n\nf x = let P arg = x in arg\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, MagicHash #-}\nmodule ShouldFail where\n\nimport GHC.Base\n\npattern P1 = 42#\n\nx = P1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule ShouldFail where\n\npattern Head x = x:_\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This is testing the printing of the builder really.\n{-# LANGUAGE MagicHash, PatternSynonyms #-}\n{-# OPTIONS_GHC -Werror -Wunbanged-strict-patterns #-}\nmodule UnliftedPSBind where\n\nimport GHC.Exts\n\npattern P x = I# x\n\nx = ()\n  where P x = P 4#\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Main where\n\npattern First x <- x:_ where\n  First x = foo [x, x, x]\n\nfoo :: [a] -> [a]\nfoo xs@(First x) = replicate (length xs + 1) x\n\nmain = mapM_ print $ First ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Main where\n\npattern First x <- x:_ where\n  First x = [x]\n\nmain = mapM_ print $ First ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule Main where\n\npattern P x y <- [x, y]\n\nf (P True True) = True\nf _             = False\n\ng [True, True] = True\ng _            = False\n\n\nmain = do\n    mapM_ (print . f) tests\n    putStrLn \"\"\n    mapM_ (print . g) tests\n  where\n    tests = [ [True, True]\n            , [True, False]\n            , [True, True, True]\n            -- , False:undefined\n            ]\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n\n{-# LANGUAGE PatternSynonyms, GADTs #-}\nmodule Main where\n\ndata T a where\n        MkT :: (Eq b) => a -> b -> T a\n\npattern P x y <- MkT x y\n\nf :: T Bool -> Bool\nf (P x y) = x && y == y\n\ndata Crazy = Crazy\n\ninstance Eq Crazy where\n    _ == _ = False\n\nmain = do\n    print (f $ MkT True True)\n    print (f $ MkT True Crazy)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, MagicHash #-}\nmodule Main where\n\nimport GHC.Base\n\npattern P1 <- 0#\npattern P2 <- 1#\n\nf :: Int# -> Int#\nf P1 = 42#\nf P2 = 44#\n\ng :: Int# -> Int\ng P1 = 42\ng P2 = 44\n\nmain = do\n    print $ I# (f 0#)\n    print $ I# (f 1#)\n    print $ g 0#\n    print $ g 1#\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Pattern synonyms\n\n{-# LANGUAGE PatternSynonyms #-}\nmodule Main where\n\npattern Single x y = [(x,y)]\n\nfoo []                   = 0\nfoo [(True, True)]       = 1\nfoo (Single True True)   = 2\nfoo (Single False False) = 3\nfoo _                    = 4\n\nmain = mapM_ (print . foo) tests\n  where\n    tests = [ [(True, True)]\n            , []\n            , [(True, False)]\n            , [(False, False)]\n            , repeat (True, True)\n            ]\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule Main where\n\npattern Bi{a, b} = (a, b)\n\nfoo = (\"a\",\"b\")\n\npattern ReadP :: Read a => a -> String\npattern ReadP {readp} <- (read -> readp)\n\nmain = do\n  print foo\n  print (a foo)\n  print (b foo)\n  print (foo {a = \"c\"})\n  print (foo {a = \"fst\", b = \"snd\"})\n\n  print (readp @Int \"5\")\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  PatternSynonyms, ViewPatterns #-}\n\nmodule Main where\n\nimport Text.Read\n\npattern PRead :: Read a => () => a -> String\npattern PRead a <- (readMaybe -> Just a)\n\nfoo :: String -> Int\nfoo (PRead x)  = (x::Int)\nfoo (PRead xs) = sum (xs::[Int])\nfoo _ = 666\n\nbar :: String -> Int\nbar (readMaybe -> Just x)  = (x::Int)\nbar (readMaybe -> Just xs) = sum (xs::[Int])\nbar _ = 666\n\nmain :: IO ()\nmain = do\n  print $ foo \"1\"       -- 1\n  print $ foo \"[1,2,3]\" -- 666 -- ???\n  print $ foo \"xxx\"     -- 666\n\n  print $ bar \"1\"       -- 1\n  print $ bar \"[1,2,3]\" -- 6\n  print $ bar \"xxx\"     -- 666\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nimport T13688Quasi\n\npattern A = [aQuoter|hello world|]\n\npattern B <- [aQuoter|hello world|]\n  where B = [aQuoter|hello world|]\n\nmain :: IO ()\nmain = do\n    print A\n    case \"hello world\" of\n      A -> putStrLn \"good\"\n      _ -> putStrLn \"bad\"\n\n    print B\n    case \"hello world\" of\n      B -> putStrLn \"good\"\n      _ -> putStrLn \"bad\"\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13688Quasi where\n\nimport Language.Haskell.TH.Quote\nimport Language.Haskell.TH.Syntax\n\naQuoter :: QuasiQuoter\naQuoter =\n    QuasiQuoter { quotePat  = return . LitP . StringL\n                , quoteExp  = return . LitE . StringL\n                , quoteType = undefined\n                , quoteDec  = undefined\n                }\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule Main where\n\ntype Maybe' t = (# t | () #)\n\npattern Just' :: a -> Maybe' a\npattern Just' x = (# x | #)\n\npattern Nothing' :: Maybe' a\npattern Nothing' = (# | () #)\n\nfoo x = case x of\n  Nothing' -> putStrLn \"nothing\"\n  Just' _ -> putStrLn \"just\"\n\nmain = do\n  putStrLn \"Nothing'\"\n  foo Nothing'\n\n  putStrLn \"Just'\"\n  foo (Just' \"hello\")\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, MagicHash #-}\nmodule Main where\n\nimport GHC.Base\n\npattern P1 <- 0\npattern P2 <- 1\n\nf :: Int -> Int#\nf P1 = 42#\nf P2 = 44#\n\nmain = do\n    print $ I# (f 0)\n    print $ I# (f 1)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, MagicHash #-}\nmodule Main where\n\nimport GHC.Base\n\npattern P1 = 42#\n\nmain = do\n    print $ I# P1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This was added a general test of compiler performance.\n\n-- Author: Austin Seipp\n\n\n{-# OPTIONS_GHC -Wall #-}\n\n{-# LANGUAGE ConstraintKinds       #-}\n{-# LANGUAGE DataKinds             #-}\n{-# LANGUAGE DeriveGeneric         #-}\n{-# LANGUAGE DeriveTraversable     #-}\n{-# LANGUAGE FlexibleContexts      #-}\n{-# LANGUAGE FlexibleInstances     #-}\n{-# LANGUAGE GADTs                 #-}\n{-# LANGUAGE InstanceSigs          #-}\n{-# LANGUAGE MagicHash             #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedLists       #-}\n{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE PolyKinds             #-}\n{-# LANGUAGE RankNTypes            #-}\n{-# LANGUAGE ScopedTypeVariables   #-}\n{-# LANGUAGE StandaloneDeriving    #-}\n{-# LANGUAGE TypeFamilies          #-}\n{-# LANGUAGE TypeOperators         #-}\n{-# LANGUAGE UndecidableInstances  #-}\nmodule Naperian where\n\nimport qualified Prelude\nimport           Prelude hiding      ( lookup, length, replicate, zipWith )\n\nimport qualified Data.IntMap         as IntMap\nimport           Data.List           ( intercalate )\nimport           Data.Kind           ( Type, Constraint )\nimport           Control.Applicative ( liftA2 )\nimport qualified GHC.Exts            as L (IsList(..))\nimport           GHC.Prim\nimport           GHC.TypeLits\n\nimport qualified Data.Vector         as Vector\n\nimport           Data.Foldable       ( toList )\n\n--------------------------------------------------------------------------------\n-- Miscellaneous\n\n-- | The finite set of type-bounded Naturals. A value of type @'Fin' n@ has\n-- exactly @n@ inhabitants, the natural numbers from @[0..n-1]@.\ndata Finite :: Nat -> Type where\n  Fin :: Int -> Finite n\n  deriving (Eq, Show)\n\n-- | Create a type-bounded finite number @'Fin' n@ from a runtime integer,\n-- bounded to a statically known limit. If the input value @x > n@, then\n-- @'Nothing'@ is returned. Otherwise, returns @'Just' (x :: 'Fin' n)@.\nfinite :: forall n. KnownNat n => Int -> Maybe (Finite n)\nfinite x = case (x > y) of\n  True  -> Nothing\n  False -> Just (Fin x)\n  where y = fromIntegral (natVal' (proxy# :: Proxy# n))\n\n-- | \\\"'Applicative' zipping\\\".\nazipWith :: Applicative f => (a -> b -> c) -> f a -> f b -> f c\nazipWith h xs ys = (pure h <*> xs) <*> ys\n\n-- | Format a vector to make it look nice.\nshowVector :: [String] -> String\nshowVector xs = \"<\" ++ intercalate \",\" xs ++ \">\"\n\n--------------------------------------------------------------------------------\n-- Pairs\n\n-- | The cartesian product of @'a'@, equivalent to @(a, a)@.\ndata Pair a = Pair a a\n  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)\n\ninstance Applicative Pair where\n  pure a = Pair a a\n  Pair k g <*> Pair a b = Pair (k a) (g b)\n\n--------------------------------------------------------------------------------\n-- Vectors\n\nnewtype Vector (n :: Nat) a = Vector (Vector.Vector a)\n  deriving (Eq, Ord, Functor, Foldable, Traversable)\n\ninstance Show a => Show (Vector n a) where\n  show = showVector . map show . toList\n\ninstance KnownNat n => Applicative (Vector n) where\n  pure  = replicate\n  (<*>) = zipWith ($)\n\ninstance (KnownNat n, Traversable (Vector n)) => L.IsList (Vector n a) where\n  type Item (Vector n a) = a\n  toList = Data.Foldable.toList\n\n  fromList xs = case fromList xs of\n    Nothing -> error \"Demanded vector of a list that wasn't the proper length\"\n    Just ys -> ys\n\ntail :: Vector (n + 1) a -> Vector n a\ntail (Vector v) = Vector (Vector.tail v)\n\nfromList :: forall n a. KnownNat n => [a] -> Maybe (Vector n a)\nfromList xs = case (Prelude.length xs == sz) of\n  False -> Nothing\n  True  -> Just (Vector $ Vector.fromList xs)\n  where sz = fromIntegral (natVal' (proxy# :: Proxy# n)) :: Int\n\nzipWith :: (a -> b -> c) -> Vector n a -> Vector n b -> Vector n c\nzipWith f (Vector a) (Vector b) = Vector (Vector.zipWith f a b)\n\nlength :: forall n a. KnownNat n => Vector n a -> Int\nlength _ = fromIntegral $ natVal' (proxy# :: Proxy# n)\n\nreplicate :: forall n a. KnownNat n => a -> Vector n a\nreplicate v = Vector (Vector.replicate sz v) where\n  sz = fromIntegral (natVal' (proxy# :: Proxy# n)) :: Int\n\nindex :: Vector n a -> Finite n -> a\nindex (Vector v) (Fin n) = (Vector.!) v n\n\nviota :: forall n. KnownNat n => Vector n (Finite n)\nviota = Vector (fmap Fin (Vector.enumFromN 0 sz)) where\n  sz = fromIntegral (natVal' (proxy# :: Proxy# n)) :: Int\n\n--------------------------------------------------------------------------------\n-- Naperian functors\n\n-- | Naperian functors.\n\n-- A useful way of thinking about a Naperian functor is that if we have a value\n-- of type @v :: f a@ for some @'Naperian' f@, then we can think of @f a@ as a\n-- bag of objects, with the ability to pick out the @a@ values inside the bag,\n-- for each and every @a@ inside @f@. For example, in order to look up a value\n-- @a@ inside a list @[a]@, we could use a function @[a] -> Int -> a@, which is\n-- exactly @'(Prelude.!!)'@\n--\n-- The lookup function acts like a logarithm of the @'Functor' f@. Intuitively,\n-- a Haskell function @f :: a -> b@ acts like the exponential @b^a@ if we intuit\n-- types as an algebraic quantity. The logarithm of some value @x = b^a@ is\n-- defined as @log_b(x) = a@, so given @x@ and a base @b@, it finds the exponent\n-- @a@. In Haskell terms, this would be like finding the input value @a@ to a\n-- function @f :: a -> b@, given a @b@, so it is a reverse mapping from the\n-- outputs of @f@ back to its inputs.\n--\n-- A @'Naperian'@ functor @f@ is precisely a functor @f@ such that for any value\n-- of type @f a@, we have a way of finding every single @a@ inside.\nclass Functor f => Naperian f where\n  {-# MINIMAL lookup, (tabulate | positions) #-}\n\n  -- | The \\\"logarithm\\\" of @f@. This type represents the 'input' you use to\n  -- look up values inside @f a@. For example, if you have a list @[a]@, and\n  -- you want to look up a value, then you use an @'Int'@ to index into\n  -- the list. In this case, @'Log' [a] = Int@. If you have a type-bounded\n  -- Vector @'Vector' (n :: 'Nat') a@, then @'Log' ('Vector' n)@ is the\n  -- range of integers @[0..n-1]@ (represented here as @'Finite' n@.)\n  type Log f\n\n  -- | Look up an element @a@ inside @f a@. If you read this function type in\n  -- english, it says \\\"if you give me an @f a@, then I will give you a\n  -- function, so you can look up the elements of @f a@ and get back an @a@\\\"\n  lookup :: f a -> (Log f -> a)\n\n  -- | Tabulate a @'Naperian'@. This creates @f a@ values by mapping the logarithm\n  -- of @f@ onto every \\\"position\\\" inside @f a@\n  tabulate :: (Log f -> a) -> f a\n  tabulate h = fmap h positions\n\n  -- | Find every position in the \\\"space\\\" of the @'Naperian' f@.\n  positions :: f (Log f)\n  positions = tabulate id\n\n-- | The transposition of two @'Naperian'@ functors @f@ and @g@.\ntranspose :: (Naperian f, Naperian g) => f (g a) -> g (f a)\ntranspose = tabulate . fmap tabulate . flip . fmap lookup . lookup\n\ninstance Naperian Pair where\n  type Log Pair = Bool\n  lookup (Pair x y) b = if b then y else x\n\n  positions = Pair False True\n\ninstance KnownNat n => Naperian (Vector n) where\n  type Log (Vector n) = Finite n\n\n  lookup    = index\n  positions = viota\n\n--------------------------------------------------------------------------------\n-- Dimensions\n\nclass (Applicative f, Naperian f, Traversable f) => Dimension f where\n  size :: f a -> Int\n  size = Prelude.length . toList\n\ninstance               Dimension Pair       where size = const 2\ninstance KnownNat n => Dimension (Vector n) where size = length\n\ninner :: (Num a, Dimension f) => f a -> f a -> a\ninner xs ys = sum (liftA2 (*) xs ys)\n\nmatrix :: ( Num a\n          , Dimension f\n          , Dimension g\n          , Dimension h\n          ) => f (g a)\n            -> g (h a)\n            -> f (h a)\nmatrix xss yss = liftA2 (liftA2 inner) (fmap pure xss) (pure (transpose yss))\n\n--------------------------------------------------------------------------------\n-- Hyper-dimensional stuff\n\n-- | Arbitrary-rank Hypercuboids, parameterized over their dimension.\ndata Hyper :: [Type -> Type] -> Type -> Type where\n  Scalar :: a -> Hyper '[] a\n  Prism  :: (Dimension f, Shapely fs) => Hyper fs (f a) -> Hyper (f : fs) a\n\npoint :: Hyper '[] a -> a\npoint (Scalar a) = a\n\ncrystal :: Hyper (f : fs) a -> Hyper fs (f a)\ncrystal (Prism x) = x\n\ninstance Show a => Show (Hyper fs a) where\n  show = showHyper . fmap show where\n    showHyper :: Hyper gs String -> String\n    showHyper (Scalar s) = s\n    showHyper (Prism x)  = showHyper (fmap (showVector . toList) x)\n\n{--\nclass HyperLift f fs where\n  hyper :: (Shapely fs, Dimension f) => f a -> Hyper (f : fs) a\n\ninstance HyperLift f '[] where\n  hyper = Prism . Scalar\n\ninstance (Shapely fs, HyperLift f fs) => HyperLift f (f : fs) where\n  hyper = Prism . (\\x -> (hyper $ _ x))\n--}\n\nclass Shapely fs where\n  hreplicate :: a -> Hyper fs a\n  hsize      :: Hyper fs a -> Int\n\ninstance Shapely '[] where\n  hreplicate a = Scalar a\n  hsize        = const 1\n\ninstance (Dimension f, Shapely fs) => Shapely (f : fs) where\n  hreplicate a = Prism (hreplicate (pure a))\n  hsize (Prism x) = size (first x) * hsize x\n\ninstance Functor (Hyper fs) where\n  fmap f (Scalar a) = Scalar (f a)\n  fmap f (Prism x)  = Prism (fmap (fmap f) x)\n\ninstance Shapely fs => Applicative (Hyper fs) where\n  pure  = hreplicate\n  (<*>) = hzipWith ($)\n\nhzipWith :: (a -> b -> c) -> Hyper fs a -> Hyper fs b -> Hyper fs c\nhzipWith f (Scalar a) (Scalar b) = Scalar (f a b)\nhzipWith f (Prism x)  (Prism y)  = Prism (hzipWith (azipWith f) x y)\n\nfirst :: Shapely fs => Hyper fs a -> a\nfirst (Scalar a) = a\nfirst (Prism x)  = head (toList (first x))\n\n-- | Generalized transposition over arbitrary-rank hypercuboids.\ntransposeH :: Hyper (f : (g : fs)) a\n           -> Hyper (g : (f : fs)) a\ntransposeH (Prism (Prism x)) = Prism (Prism (fmap transpose x))\n\n-- | Fold over a single dimension of a Hypercuboid.\nfoldrH :: (a -> a -> a) -> a -> Hyper (f : fs) a -> Hyper fs a\nfoldrH f z (Prism x) = fmap (foldr f z) x\n\n-- | Lift an unary function from values to hypercuboids of values.\nunary :: Shapely fs => (a -> b) -> (Hyper fs a -> Hyper fs b)\nunary = fmap\n\n-- | Lift a binary function from values to two sets of hypercuboids, which can\n-- be aligned properly.\nbinary :: ( Compatible fs gs\n          , Max fs gs ~ hs\n          , Alignable fs hs\n          , Alignable gs hs\n          ) => (a -> b -> c)\n            -> Hyper fs a\n            -> Hyper gs b\n            -> Hyper hs c\nbinary f x y = hzipWith f (align x) (align y)\n\nup :: (Shapely fs, Dimension f) => Hyper fs a -> Hyper (f : fs) a\nup = Prism . fmap pure\n\n-- | Generalized, rank-polymorphic inner product.\ninnerH :: ( Max fs gs ~  (f : hs)\n          , Alignable fs (f : hs)\n          , Alignable gs (f : hs)\n          , Compatible fs gs\n          , Num a\n          ) => Hyper fs a\n            -> Hyper gs a\n            -> Hyper hs a\ninnerH xs ys = foldrH (+) 0 (binary (*) xs ys)\n\n-- | Generalized, rank-polymorphic matrix product.\nmatrixH :: ( Num a\n           , Dimension f\n           , Dimension g\n           , Dimension h\n           ) => Hyper '[ g, f ] a\n             -> Hyper '[ h, g ] a\n             -> Hyper '[ h, f ] a\nmatrixH x y = case (crystal x, transposeH y) of\n  (xs, Prism (Prism ys)) -> hzipWith inner (up xs) (Prism (up ys))\n\n--------------------------------------------------------------------------------\n-- Alignment\n\nclass (Shapely fs, Shapely gs) => Alignable fs gs where\n  align :: Hyper fs a -> Hyper gs a\n\ninstance Alignable '[] '[] where\n  align = id\n\ninstance (Dimension f, Alignable fs gs) => Alignable (f : fs) (f : gs) where\n  align (Prism x) = Prism (align x)\n\ninstance (Dimension f, Shapely fs) => Alignable '[] (f : fs) where\n  align (Scalar a) = hreplicate a\n\ntype family Max (fs :: [Type -> Type]) (gs :: [Type -> Type]) :: [Type -> Type] where\n  Max '[]      '[]      = '[]\n  Max '[]      (f : gs) = f : gs\n  Max (f : fs) '[]      = f : fs\n  Max (f : fs) (f : gs) = f : Max fs gs\n\ntype family Compatible (fs :: [Type -> Type]) (gs :: [Type -> Type]) :: Constraint where\n  Compatible '[] '[]           = ()\n  Compatible '[] (f : gs)      = ()\n  Compatible (f : fs) '[]      = ()\n  Compatible (f : fs) (f : gs) = Compatible fs gs\n  Compatible a b               = TypeError (\n         'Text \"Mismatched dimensions!\"\n   ':$$: 'Text \"The dimension \" ':<>: 'ShowType a ':<>: 'Text \" can't be aligned with\"\n   ':$$: 'Text \"the dimension \" ':<>: 'ShowType b)\n\n--------------------------------------------------------------------------------\n-- Flattened, sparse Hypercuboids\n\nelements :: Shapely fs => Hyper fs a -> [a]\nelements (Scalar a) = [a]\nelements (Prism a)  = concat (map toList (elements a))\n\ndata Flat fs a where\n  Flat :: Shapely fs => Vector.Vector a -> Flat fs a\n\ninstance Functor (Flat fs) where\n  fmap f (Flat v) = Flat (fmap f v)\n\ninstance Show a => Show (Flat fs a) where\n  show = showHyper . fmap show where\n    showHyper :: Flat gs String -> String\n    showHyper (Flat v) = showVector (toList v)\n\nflatten :: Shapely fs => Hyper fs a -> Flat fs a\nflatten hs = Flat (Vector.fromList (elements hs))\n\ndata Sparse fs a where\n  Sparse :: Shapely fs => a -> IntMap.IntMap a -> Sparse fs a\n\nunsparse :: forall fs a. Shapely fs => Sparse fs a -> Flat fs a\nunsparse (Sparse e xs) = Flat (Vector.unsafeAccum (flip const) vs as)\n  where\n    as     = IntMap.assocs xs\n    vs     = Vector.replicate l e\n    l      = hsize (hreplicate () :: Hyper fs ())\n\n--------------------------------------------------------------------------------\n-- Examples\n\ntype Matrix n m v = Vector n (Vector m v)\n\nexample1 :: Int\nexample1 = inner v1 v2 where\n  v1 = [ 1, 2, 3 ] :: Vector 3 Int\n  v2 = [ 4, 5, 6 ] :: Vector 3 Int\n\nexample2 :: Matrix 2 2 Int\nexample2 = matrix m1 m2 where\n  m1 = [ [ 1, 2, 3 ]\n       , [ 4, 5, 6 ]\n       ] :: Matrix 2 3 Int\n\n  m2 = [ [ 9, 8 ]\n       , [ 6, 5 ]\n       , [ 3, 2 ]\n       ] :: Matrix 3 2 Int\n\nexample3 :: Hyper '[] Int\nexample3 = innerH v1 v2 where\n  v1 = Prism (Scalar [1, 2, 3]) :: Hyper '[Vector 3] Int\n  v2 = Prism (Scalar [4, 5, 6]) :: Hyper '[Vector 3] Int\n\nexample4 :: Hyper '[Vector 2, Vector 2] Int\nexample4 = matrixH v1 v2 where\n  x = [ [ 1, 2, 3 ]\n      , [ 4, 5, 6 ]\n      ] :: Matrix 2 3 Int\n\n  y = [ [ 9, 8 ]\n      , [ 6, 5 ]\n      , [ 3, 2 ]\n      ] :: Matrix 3 2 Int\n\n  v1 = Prism (Prism (Scalar x)) :: Hyper '[Vector 3, Vector 2] Int\n  v2 = Prism (Prism (Scalar y)) :: Hyper '[Vector 2, Vector 3] Int\n", "num_lines": 423}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- lots of identifiers\n\nimport Wibble  -- this will make the build fail just after parsing\n\nx = a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n    a aa aaa aaaa aaaaa aaaaaa aaaaaaa aaaaaaaa aaaaaaaaa aaaaaaaaaa\n", "num_lines": 8414}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for ticket #830, simplifier taking too long on large do expression\n\nmain = do\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n", "num_lines": 1684}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Out where\nimport Control.Monad (forever)\na1 :: IO (); a1 = forever $ putStrLn \"a1\"\na2 :: IO (); a2 = forever $ putStrLn \"a2\"\na3 :: IO (); a3 = forever $ putStrLn \"a3\"\na4 :: IO (); a4 = forever $ putStrLn \"a4\"\na5 :: IO (); a5 = forever $ putStrLn \"a5\"\na6 :: IO (); a6 = forever $ putStrLn \"a6\"\na7 :: IO (); a7 = forever $ putStrLn \"a7\"\na8 :: IO (); a8 = forever $ putStrLn \"a8\"\na9 :: IO (); a9 = forever $ putStrLn \"a9\"\na10 :: IO (); a10 = forever $ putStrLn \"a10\"\na11 :: IO (); a11 = forever $ putStrLn \"a11\"\na12 :: IO (); a12 = forever $ putStrLn \"a12\"\na13 :: IO (); a13 = forever $ putStrLn \"a13\"\na14 :: IO (); a14 = forever $ putStrLn \"a14\"\na15 :: IO (); a15 = forever $ putStrLn \"a15\"\na16 :: IO (); a16 = forever $ putStrLn \"a16\"\na17 :: IO (); a17 = forever $ putStrLn \"a17\"\na18 :: IO (); a18 = forever $ putStrLn \"a18\"\na19 :: IO (); a19 = forever $ putStrLn \"a19\"\na20 :: IO (); a20 = forever $ putStrLn \"a20\"\na21 :: IO (); a21 = forever $ putStrLn \"a21\"\na22 :: IO (); a22 = forever $ putStrLn \"a22\"\na23 :: IO (); a23 = forever $ putStrLn \"a23\"\na24 :: IO (); a24 = forever $ putStrLn \"a24\"\na25 :: IO (); a25 = forever $ putStrLn \"a25\"\na26 :: IO (); a26 = forever $ putStrLn \"a26\"\na27 :: IO (); a27 = forever $ putStrLn \"a27\"\na28 :: IO (); a28 = forever $ putStrLn \"a28\"\na29 :: IO (); a29 = forever $ putStrLn \"a29\"\na30 :: IO (); a30 = forever $ putStrLn \"a30\"\na31 :: IO (); a31 = forever $ putStrLn \"a31\"\na32 :: IO (); a32 = forever $ putStrLn \"a32\"\na33 :: IO (); a33 = forever $ putStrLn \"a33\"\na34 :: IO (); a34 = forever $ putStrLn \"a34\"\na35 :: IO (); a35 = forever $ putStrLn \"a35\"\na36 :: IO (); a36 = forever $ putStrLn \"a36\"\na37 :: IO (); a37 = forever $ putStrLn \"a37\"\na38 :: IO (); a38 = forever $ putStrLn \"a38\"\na39 :: IO (); a39 = forever $ putStrLn \"a39\"\na40 :: IO (); a40 = forever $ putStrLn \"a40\"\na41 :: IO (); a41 = forever $ putStrLn \"a41\"\na42 :: IO (); a42 = forever $ putStrLn \"a42\"\na43 :: IO (); a43 = forever $ putStrLn \"a43\"\na44 :: IO (); a44 = forever $ putStrLn \"a44\"\na45 :: IO (); a45 = forever $ putStrLn \"a45\"\na46 :: IO (); a46 = forever $ putStrLn \"a46\"\na47 :: IO (); a47 = forever $ putStrLn \"a47\"\na48 :: IO (); a48 = forever $ putStrLn \"a48\"\na49 :: IO (); a49 = forever $ putStrLn \"a49\"\na50 :: IO (); a50 = forever $ putStrLn \"a50\"\na51 :: IO (); a51 = forever $ putStrLn \"a51\"\na52 :: IO (); a52 = forever $ putStrLn \"a52\"\na53 :: IO (); a53 = forever $ putStrLn \"a53\"\na54 :: IO (); a54 = forever $ putStrLn \"a54\"\na55 :: IO (); a55 = forever $ putStrLn \"a55\"\na56 :: IO (); a56 = forever $ putStrLn \"a56\"\na57 :: IO (); a57 = forever $ putStrLn \"a57\"\na58 :: IO (); a58 = forever $ putStrLn \"a58\"\na59 :: IO (); a59 = forever $ putStrLn \"a59\"\na60 :: IO (); a60 = forever $ putStrLn \"a60\"\na61 :: IO (); a61 = forever $ putStrLn \"a61\"\na62 :: IO (); a62 = forever $ putStrLn \"a62\"\na63 :: IO (); a63 = forever $ putStrLn \"a63\"\na64 :: IO (); a64 = forever $ putStrLn \"a64\"\na65 :: IO (); a65 = forever $ putStrLn \"a65\"\na66 :: IO (); a66 = forever $ putStrLn \"a66\"\na67 :: IO (); a67 = forever $ putStrLn \"a67\"\na68 :: IO (); a68 = forever $ putStrLn \"a68\"\na69 :: IO (); a69 = forever $ putStrLn \"a69\"\na70 :: IO (); a70 = forever $ putStrLn \"a70\"\na71 :: IO (); a71 = forever $ putStrLn \"a71\"\na72 :: IO (); a72 = forever $ putStrLn \"a72\"\na73 :: IO (); a73 = forever $ putStrLn \"a73\"\na74 :: IO (); a74 = forever $ putStrLn \"a74\"\na75 :: IO (); a75 = forever $ putStrLn \"a75\"\na76 :: IO (); a76 = forever $ putStrLn \"a76\"\na77 :: IO (); a77 = forever $ putStrLn \"a77\"\na78 :: IO (); a78 = forever $ putStrLn \"a78\"\na79 :: IO (); a79 = forever $ putStrLn \"a79\"\na80 :: IO (); a80 = forever $ putStrLn \"a80\"\na81 :: IO (); a81 = forever $ putStrLn \"a81\"\na82 :: IO (); a82 = forever $ putStrLn \"a82\"\na83 :: IO (); a83 = forever $ putStrLn \"a83\"\na84 :: IO (); a84 = forever $ putStrLn \"a84\"\na85 :: IO (); a85 = forever $ putStrLn \"a85\"\na86 :: IO (); a86 = forever $ putStrLn \"a86\"\na87 :: IO (); a87 = forever $ putStrLn \"a87\"\na88 :: IO (); a88 = forever $ putStrLn \"a88\"\na89 :: IO (); a89 = forever $ putStrLn \"a89\"\na90 :: IO (); a90 = forever $ putStrLn \"a90\"\na91 :: IO (); a91 = forever $ putStrLn \"a91\"\na92 :: IO (); a92 = forever $ putStrLn \"a92\"\na93 :: IO (); a93 = forever $ putStrLn \"a93\"\na94 :: IO (); a94 = forever $ putStrLn \"a94\"\na95 :: IO (); a95 = forever $ putStrLn \"a95\"\na96 :: IO (); a96 = forever $ putStrLn \"a96\"\na97 :: IO (); a97 = forever $ putStrLn \"a97\"\na98 :: IO (); a98 = forever $ putStrLn \"a98\"\na99 :: IO (); a99 = forever $ putStrLn \"a99\"\na100 :: IO (); a100 = forever $ putStrLn \"a100\"\na101 :: IO (); a101 = forever $ putStrLn \"a101\"\na102 :: IO (); a102 = forever $ putStrLn \"a102\"\na103 :: IO (); a103 = forever $ putStrLn \"a103\"\na104 :: IO (); a104 = forever $ putStrLn \"a104\"\na105 :: IO (); a105 = forever $ putStrLn \"a105\"\na106 :: IO (); a106 = forever $ putStrLn \"a106\"\na107 :: IO (); a107 = forever $ putStrLn \"a107\"\na108 :: IO (); a108 = forever $ putStrLn \"a108\"\na109 :: IO (); a109 = forever $ putStrLn \"a109\"\na110 :: IO (); a110 = forever $ putStrLn \"a110\"\na111 :: IO (); a111 = forever $ putStrLn \"a111\"\na112 :: IO (); a112 = forever $ putStrLn \"a112\"\na113 :: IO (); a113 = forever $ putStrLn \"a113\"\na114 :: IO (); a114 = forever $ putStrLn \"a114\"\na115 :: IO (); a115 = forever $ putStrLn \"a115\"\na116 :: IO (); a116 = forever $ putStrLn \"a116\"\na117 :: IO (); a117 = forever $ putStrLn \"a117\"\na118 :: IO (); a118 = forever $ putStrLn \"a118\"\na119 :: IO (); a119 = forever $ putStrLn \"a119\"\na120 :: IO (); a120 = forever $ putStrLn \"a120\"\na121 :: IO (); a121 = forever $ putStrLn \"a121\"\na122 :: IO (); a122 = forever $ putStrLn \"a122\"\na123 :: IO (); a123 = forever $ putStrLn \"a123\"\na124 :: IO (); a124 = forever $ putStrLn \"a124\"\na125 :: IO (); a125 = forever $ putStrLn \"a125\"\na126 :: IO (); a126 = forever $ putStrLn \"a126\"\na127 :: IO (); a127 = forever $ putStrLn \"a127\"\na128 :: IO (); a128 = forever $ putStrLn \"a128\"\na129 :: IO (); a129 = forever $ putStrLn \"a129\"\na130 :: IO (); a130 = forever $ putStrLn \"a130\"\na131 :: IO (); a131 = forever $ putStrLn \"a131\"\na132 :: IO (); a132 = forever $ putStrLn \"a132\"\na133 :: IO (); a133 = forever $ putStrLn \"a133\"\na134 :: IO (); a134 = forever $ putStrLn \"a134\"\na135 :: IO (); a135 = forever $ putStrLn \"a135\"\na136 :: IO (); a136 = forever $ putStrLn \"a136\"\na137 :: IO (); a137 = forever $ putStrLn \"a137\"\na138 :: IO (); a138 = forever $ putStrLn \"a138\"\na139 :: IO (); a139 = forever $ putStrLn \"a139\"\na140 :: IO (); a140 = forever $ putStrLn \"a140\"\na141 :: IO (); a141 = forever $ putStrLn \"a141\"\na142 :: IO (); a142 = forever $ putStrLn \"a142\"\na143 :: IO (); a143 = forever $ putStrLn \"a143\"\na144 :: IO (); a144 = forever $ putStrLn \"a144\"\na145 :: IO (); a145 = forever $ putStrLn \"a145\"\na146 :: IO (); a146 = forever $ putStrLn \"a146\"\na147 :: IO (); a147 = forever $ putStrLn \"a147\"\na148 :: IO (); a148 = forever $ putStrLn \"a148\"\na149 :: IO (); a149 = forever $ putStrLn \"a149\"\na150 :: IO (); a150 = forever $ putStrLn \"a150\"\na151 :: IO (); a151 = forever $ putStrLn \"a151\"\na152 :: IO (); a152 = forever $ putStrLn \"a152\"\na153 :: IO (); a153 = forever $ putStrLn \"a153\"\na154 :: IO (); a154 = forever $ putStrLn \"a154\"\na155 :: IO (); a155 = forever $ putStrLn \"a155\"\na156 :: IO (); a156 = forever $ putStrLn \"a156\"\na157 :: IO (); a157 = forever $ putStrLn \"a157\"\na158 :: IO (); a158 = forever $ putStrLn \"a158\"\na159 :: IO (); a159 = forever $ putStrLn \"a159\"\na160 :: IO (); a160 = forever $ putStrLn \"a160\"\na161 :: IO (); a161 = forever $ putStrLn \"a161\"\na162 :: IO (); a162 = forever $ putStrLn \"a162\"\na163 :: IO (); a163 = forever $ putStrLn \"a163\"\na164 :: IO (); a164 = forever $ putStrLn \"a164\"\na165 :: IO (); a165 = forever $ putStrLn \"a165\"\na166 :: IO (); a166 = forever $ putStrLn \"a166\"\na167 :: IO (); a167 = forever $ putStrLn \"a167\"\na168 :: IO (); a168 = forever $ putStrLn \"a168\"\na169 :: IO (); a169 = forever $ putStrLn \"a169\"\na170 :: IO (); a170 = forever $ putStrLn \"a170\"\na171 :: IO (); a171 = forever $ putStrLn \"a171\"\na172 :: IO (); a172 = forever $ putStrLn \"a172\"\na173 :: IO (); a173 = forever $ putStrLn \"a173\"\na174 :: IO (); a174 = forever $ putStrLn \"a174\"\na175 :: IO (); a175 = forever $ putStrLn \"a175\"\na176 :: IO (); a176 = forever $ putStrLn \"a176\"\na177 :: IO (); a177 = forever $ putStrLn \"a177\"\na178 :: IO (); a178 = forever $ putStrLn \"a178\"\na179 :: IO (); a179 = forever $ putStrLn \"a179\"\na180 :: IO (); a180 = forever $ putStrLn \"a180\"\na181 :: IO (); a181 = forever $ putStrLn \"a181\"\na182 :: IO (); a182 = forever $ putStrLn \"a182\"\na183 :: IO (); a183 = forever $ putStrLn \"a183\"\na184 :: IO (); a184 = forever $ putStrLn \"a184\"\na185 :: IO (); a185 = forever $ putStrLn \"a185\"\na186 :: IO (); a186 = forever $ putStrLn \"a186\"\na187 :: IO (); a187 = forever $ putStrLn \"a187\"\na188 :: IO (); a188 = forever $ putStrLn \"a188\"\na189 :: IO (); a189 = forever $ putStrLn \"a189\"\na190 :: IO (); a190 = forever $ putStrLn \"a190\"\na191 :: IO (); a191 = forever $ putStrLn \"a191\"\na192 :: IO (); a192 = forever $ putStrLn \"a192\"\na193 :: IO (); a193 = forever $ putStrLn \"a193\"\na194 :: IO (); a194 = forever $ putStrLn \"a194\"\na195 :: IO (); a195 = forever $ putStrLn \"a195\"\na196 :: IO (); a196 = forever $ putStrLn \"a196\"\na197 :: IO (); a197 = forever $ putStrLn \"a197\"\na198 :: IO (); a198 = forever $ putStrLn \"a198\"\na199 :: IO (); a199 = forever $ putStrLn \"a199\"\na200 :: IO (); a200 = forever $ putStrLn \"a200\"\na201 :: IO (); a201 = forever $ putStrLn \"a201\"\na202 :: IO (); a202 = forever $ putStrLn \"a202\"\na203 :: IO (); a203 = forever $ putStrLn \"a203\"\na204 :: IO (); a204 = forever $ putStrLn \"a204\"\na205 :: IO (); a205 = forever $ putStrLn \"a205\"\na206 :: IO (); a206 = forever $ putStrLn \"a206\"\na207 :: IO (); a207 = forever $ putStrLn \"a207\"\na208 :: IO (); a208 = forever $ putStrLn \"a208\"\na209 :: IO (); a209 = forever $ putStrLn \"a209\"\na210 :: IO (); a210 = forever $ putStrLn \"a210\"\na211 :: IO (); a211 = forever $ putStrLn \"a211\"\na212 :: IO (); a212 = forever $ putStrLn \"a212\"\na213 :: IO (); a213 = forever $ putStrLn \"a213\"\na214 :: IO (); a214 = forever $ putStrLn \"a214\"\na215 :: IO (); a215 = forever $ putStrLn \"a215\"\na216 :: IO (); a216 = forever $ putStrLn \"a216\"\na217 :: IO (); a217 = forever $ putStrLn \"a217\"\na218 :: IO (); a218 = forever $ putStrLn \"a218\"\na219 :: IO (); a219 = forever $ putStrLn \"a219\"\na220 :: IO (); a220 = forever $ putStrLn \"a220\"\na221 :: IO (); a221 = forever $ putStrLn \"a221\"\na222 :: IO (); a222 = forever $ putStrLn \"a222\"\na223 :: IO (); a223 = forever $ putStrLn \"a223\"\na224 :: IO (); a224 = forever $ putStrLn \"a224\"\na225 :: IO (); a225 = forever $ putStrLn \"a225\"\na226 :: IO (); a226 = forever $ putStrLn \"a226\"\na227 :: IO (); a227 = forever $ putStrLn \"a227\"\na228 :: IO (); a228 = forever $ putStrLn \"a228\"\na229 :: IO (); a229 = forever $ putStrLn \"a229\"\na230 :: IO (); a230 = forever $ putStrLn \"a230\"\na231 :: IO (); a231 = forever $ putStrLn \"a231\"\na232 :: IO (); a232 = forever $ putStrLn \"a232\"\na233 :: IO (); a233 = forever $ putStrLn \"a233\"\na234 :: IO (); a234 = forever $ putStrLn \"a234\"\na235 :: IO (); a235 = forever $ putStrLn \"a235\"\na236 :: IO (); a236 = forever $ putStrLn \"a236\"\na237 :: IO (); a237 = forever $ putStrLn \"a237\"\na238 :: IO (); a238 = forever $ putStrLn \"a238\"\na239 :: IO (); a239 = forever $ putStrLn \"a239\"\na240 :: IO (); a240 = forever $ putStrLn \"a240\"\na241 :: IO (); a241 = forever $ putStrLn \"a241\"\na242 :: IO (); a242 = forever $ putStrLn \"a242\"\na243 :: IO (); a243 = forever $ putStrLn \"a243\"\na244 :: IO (); a244 = forever $ putStrLn \"a244\"\na245 :: IO (); a245 = forever $ putStrLn \"a245\"\na246 :: IO (); a246 = forever $ putStrLn \"a246\"\na247 :: IO (); a247 = forever $ putStrLn \"a247\"\na248 :: IO (); a248 = forever $ putStrLn \"a248\"\na249 :: IO (); a249 = forever $ putStrLn \"a249\"\na250 :: IO (); a250 = forever $ putStrLn \"a250\"\na251 :: IO (); a251 = forever $ putStrLn \"a251\"\na252 :: IO (); a252 = forever $ putStrLn \"a252\"\na253 :: IO (); a253 = forever $ putStrLn \"a253\"\na254 :: IO (); a254 = forever $ putStrLn \"a254\"\na255 :: IO (); a255 = forever $ putStrLn \"a255\"\na256 :: IO (); a256 = forever $ putStrLn \"a256\"\na257 :: IO (); a257 = forever $ putStrLn \"a257\"\na258 :: IO (); a258 = forever $ putStrLn \"a258\"\na259 :: IO (); a259 = forever $ putStrLn \"a259\"\na260 :: IO (); a260 = forever $ putStrLn \"a260\"\na261 :: IO (); a261 = forever $ putStrLn \"a261\"\na262 :: IO (); a262 = forever $ putStrLn \"a262\"\na263 :: IO (); a263 = forever $ putStrLn \"a263\"\na264 :: IO (); a264 = forever $ putStrLn \"a264\"\na265 :: IO (); a265 = forever $ putStrLn \"a265\"\na266 :: IO (); a266 = forever $ putStrLn \"a266\"\na267 :: IO (); a267 = forever $ putStrLn \"a267\"\na268 :: IO (); a268 = forever $ putStrLn \"a268\"\na269 :: IO (); a269 = forever $ putStrLn \"a269\"\na270 :: IO (); a270 = forever $ putStrLn \"a270\"\na271 :: IO (); a271 = forever $ putStrLn \"a271\"\na272 :: IO (); a272 = forever $ putStrLn \"a272\"\na273 :: IO (); a273 = forever $ putStrLn \"a273\"\na274 :: IO (); a274 = forever $ putStrLn \"a274\"\na275 :: IO (); a275 = forever $ putStrLn \"a275\"\na276 :: IO (); a276 = forever $ putStrLn \"a276\"\na277 :: IO (); a277 = forever $ putStrLn \"a277\"\na278 :: IO (); a278 = forever $ putStrLn \"a278\"\na279 :: IO (); a279 = forever $ putStrLn \"a279\"\na280 :: IO (); a280 = forever $ putStrLn \"a280\"\na281 :: IO (); a281 = forever $ putStrLn \"a281\"\na282 :: IO (); a282 = forever $ putStrLn \"a282\"\na283 :: IO (); a283 = forever $ putStrLn \"a283\"\na284 :: IO (); a284 = forever $ putStrLn \"a284\"\na285 :: IO (); a285 = forever $ putStrLn \"a285\"\na286 :: IO (); a286 = forever $ putStrLn \"a286\"\na287 :: IO (); a287 = forever $ putStrLn \"a287\"\na288 :: IO (); a288 = forever $ putStrLn \"a288\"\na289 :: IO (); a289 = forever $ putStrLn \"a289\"\na290 :: IO (); a290 = forever $ putStrLn \"a290\"\na291 :: IO (); a291 = forever $ putStrLn \"a291\"\na292 :: IO (); a292 = forever $ putStrLn \"a292\"\na293 :: IO (); a293 = forever $ putStrLn \"a293\"\na294 :: IO (); a294 = forever $ putStrLn \"a294\"\na295 :: IO (); a295 = forever $ putStrLn \"a295\"\na296 :: IO (); a296 = forever $ putStrLn \"a296\"\na297 :: IO (); a297 = forever $ putStrLn \"a297\"\na298 :: IO (); a298 = forever $ putStrLn \"a298\"\na299 :: IO (); a299 = forever $ putStrLn \"a299\"\na300 :: IO (); a300 = forever $ putStrLn \"a300\"\na301 :: IO (); a301 = forever $ putStrLn \"a301\"\na302 :: IO (); a302 = forever $ putStrLn \"a302\"\na303 :: IO (); a303 = forever $ putStrLn \"a303\"\na304 :: IO (); a304 = forever $ putStrLn \"a304\"\na305 :: IO (); a305 = forever $ putStrLn \"a305\"\na306 :: IO (); a306 = forever $ putStrLn \"a306\"\na307 :: IO (); a307 = forever $ putStrLn \"a307\"\na308 :: IO (); a308 = forever $ putStrLn \"a308\"\na309 :: IO (); a309 = forever $ putStrLn \"a309\"\na310 :: IO (); a310 = forever $ putStrLn \"a310\"\na311 :: IO (); a311 = forever $ putStrLn \"a311\"\na312 :: IO (); a312 = forever $ putStrLn \"a312\"\na313 :: IO (); a313 = forever $ putStrLn \"a313\"\na314 :: IO (); a314 = forever $ putStrLn \"a314\"\na315 :: IO (); a315 = forever $ putStrLn \"a315\"\na316 :: IO (); a316 = forever $ putStrLn \"a316\"\na317 :: IO (); a317 = forever $ putStrLn \"a317\"\na318 :: IO (); a318 = forever $ putStrLn \"a318\"\na319 :: IO (); a319 = forever $ putStrLn \"a319\"\na320 :: IO (); a320 = forever $ putStrLn \"a320\"\na321 :: IO (); a321 = forever $ putStrLn \"a321\"\na322 :: IO (); a322 = forever $ putStrLn \"a322\"\na323 :: IO (); a323 = forever $ putStrLn \"a323\"\na324 :: IO (); a324 = forever $ putStrLn \"a324\"\na325 :: IO (); a325 = forever $ putStrLn \"a325\"\na326 :: IO (); a326 = forever $ putStrLn \"a326\"\na327 :: IO (); a327 = forever $ putStrLn \"a327\"\na328 :: IO (); a328 = forever $ putStrLn \"a328\"\na329 :: IO (); a329 = forever $ putStrLn \"a329\"\na330 :: IO (); a330 = forever $ putStrLn \"a330\"\na331 :: IO (); a331 = forever $ putStrLn \"a331\"\na332 :: IO (); a332 = forever $ putStrLn \"a332\"\na333 :: IO (); a333 = forever $ putStrLn \"a333\"\na334 :: IO (); a334 = forever $ putStrLn \"a334\"\na335 :: IO (); a335 = forever $ putStrLn \"a335\"\na336 :: IO (); a336 = forever $ putStrLn \"a336\"\na337 :: IO (); a337 = forever $ putStrLn \"a337\"\na338 :: IO (); a338 = forever $ putStrLn \"a338\"\na339 :: IO (); a339 = forever $ putStrLn \"a339\"\na340 :: IO (); a340 = forever $ putStrLn \"a340\"\na341 :: IO (); a341 = forever $ putStrLn \"a341\"\na342 :: IO (); a342 = forever $ putStrLn \"a342\"\na343 :: IO (); a343 = forever $ putStrLn \"a343\"\na344 :: IO (); a344 = forever $ putStrLn \"a344\"\na345 :: IO (); a345 = forever $ putStrLn \"a345\"\na346 :: IO (); a346 = forever $ putStrLn \"a346\"\na347 :: IO (); a347 = forever $ putStrLn \"a347\"\na348 :: IO (); a348 = forever $ putStrLn \"a348\"\na349 :: IO (); a349 = forever $ putStrLn \"a349\"\na350 :: IO (); a350 = forever $ putStrLn \"a350\"\na351 :: IO (); a351 = forever $ putStrLn \"a351\"\na352 :: IO (); a352 = forever $ putStrLn \"a352\"\na353 :: IO (); a353 = forever $ putStrLn \"a353\"\na354 :: IO (); a354 = forever $ putStrLn \"a354\"\na355 :: IO (); a355 = forever $ putStrLn \"a355\"\na356 :: IO (); a356 = forever $ putStrLn \"a356\"\na357 :: IO (); a357 = forever $ putStrLn \"a357\"\na358 :: IO (); a358 = forever $ putStrLn \"a358\"\na359 :: IO (); a359 = forever $ putStrLn \"a359\"\na360 :: IO (); a360 = forever $ putStrLn \"a360\"\na361 :: IO (); a361 = forever $ putStrLn \"a361\"\na362 :: IO (); a362 = forever $ putStrLn \"a362\"\na363 :: IO (); a363 = forever $ putStrLn \"a363\"\na364 :: IO (); a364 = forever $ putStrLn \"a364\"\na365 :: IO (); a365 = forever $ putStrLn \"a365\"\na366 :: IO (); a366 = forever $ putStrLn \"a366\"\na367 :: IO (); a367 = forever $ putStrLn \"a367\"\na368 :: IO (); a368 = forever $ putStrLn \"a368\"\na369 :: IO (); a369 = forever $ putStrLn \"a369\"\na370 :: IO (); a370 = forever $ putStrLn \"a370\"\na371 :: IO (); a371 = forever $ putStrLn \"a371\"\na372 :: IO (); a372 = forever $ putStrLn \"a372\"\na373 :: IO (); a373 = forever $ putStrLn \"a373\"\na374 :: IO (); a374 = forever $ putStrLn \"a374\"\na375 :: IO (); a375 = forever $ putStrLn \"a375\"\na376 :: IO (); a376 = forever $ putStrLn \"a376\"\na377 :: IO (); a377 = forever $ putStrLn \"a377\"\na378 :: IO (); a378 = forever $ putStrLn \"a378\"\na379 :: IO (); a379 = forever $ putStrLn \"a379\"\na380 :: IO (); a380 = forever $ putStrLn \"a380\"\na381 :: IO (); a381 = forever $ putStrLn \"a381\"\na382 :: IO (); a382 = forever $ putStrLn \"a382\"\na383 :: IO (); a383 = forever $ putStrLn \"a383\"\na384 :: IO (); a384 = forever $ putStrLn \"a384\"\na385 :: IO (); a385 = forever $ putStrLn \"a385\"\na386 :: IO (); a386 = forever $ putStrLn \"a386\"\na387 :: IO (); a387 = forever $ putStrLn \"a387\"\na388 :: IO (); a388 = forever $ putStrLn \"a388\"\na389 :: IO (); a389 = forever $ putStrLn \"a389\"\na390 :: IO (); a390 = forever $ putStrLn \"a390\"\na391 :: IO (); a391 = forever $ putStrLn \"a391\"\na392 :: IO (); a392 = forever $ putStrLn \"a392\"\na393 :: IO (); a393 = forever $ putStrLn \"a393\"\na394 :: IO (); a394 = forever $ putStrLn \"a394\"\na395 :: IO (); a395 = forever $ putStrLn \"a395\"\na396 :: IO (); a396 = forever $ putStrLn \"a396\"\na397 :: IO (); a397 = forever $ putStrLn \"a397\"\na398 :: IO (); a398 = forever $ putStrLn \"a398\"\na399 :: IO (); a399 = forever $ putStrLn \"a399\"\na400 :: IO (); a400 = forever $ putStrLn \"a400\"\na401 :: IO (); a401 = forever $ putStrLn \"a401\"\na402 :: IO (); a402 = forever $ putStrLn \"a402\"\na403 :: IO (); a403 = forever $ putStrLn \"a403\"\na404 :: IO (); a404 = forever $ putStrLn \"a404\"\na405 :: IO (); a405 = forever $ putStrLn \"a405\"\na406 :: IO (); a406 = forever $ putStrLn \"a406\"\na407 :: IO (); a407 = forever $ putStrLn \"a407\"\na408 :: IO (); a408 = forever $ putStrLn \"a408\"\na409 :: IO (); a409 = forever $ putStrLn \"a409\"\na410 :: IO (); a410 = forever $ putStrLn \"a410\"\na411 :: IO (); a411 = forever $ putStrLn \"a411\"\na412 :: IO (); a412 = forever $ putStrLn \"a412\"\na413 :: IO (); a413 = forever $ putStrLn \"a413\"\na414 :: IO (); a414 = forever $ putStrLn \"a414\"\na415 :: IO (); a415 = forever $ putStrLn \"a415\"\na416 :: IO (); a416 = forever $ putStrLn \"a416\"\na417 :: IO (); a417 = forever $ putStrLn \"a417\"\na418 :: IO (); a418 = forever $ putStrLn \"a418\"\na419 :: IO (); a419 = forever $ putStrLn \"a419\"\na420 :: IO (); a420 = forever $ putStrLn \"a420\"\na421 :: IO (); a421 = forever $ putStrLn \"a421\"\na422 :: IO (); a422 = forever $ putStrLn \"a422\"\na423 :: IO (); a423 = forever $ putStrLn \"a423\"\na424 :: IO (); a424 = forever $ putStrLn \"a424\"\na425 :: IO (); a425 = forever $ putStrLn \"a425\"\na426 :: IO (); a426 = forever $ putStrLn \"a426\"\na427 :: IO (); a427 = forever $ putStrLn \"a427\"\na428 :: IO (); a428 = forever $ putStrLn \"a428\"\na429 :: IO (); a429 = forever $ putStrLn \"a429\"\na430 :: IO (); a430 = forever $ putStrLn \"a430\"\na431 :: IO (); a431 = forever $ putStrLn \"a431\"\na432 :: IO (); a432 = forever $ putStrLn \"a432\"\na433 :: IO (); a433 = forever $ putStrLn \"a433\"\na434 :: IO (); a434 = forever $ putStrLn \"a434\"\na435 :: IO (); a435 = forever $ putStrLn \"a435\"\na436 :: IO (); a436 = forever $ putStrLn \"a436\"\na437 :: IO (); a437 = forever $ putStrLn \"a437\"\na438 :: IO (); a438 = forever $ putStrLn \"a438\"\na439 :: IO (); a439 = forever $ putStrLn \"a439\"\na440 :: IO (); a440 = forever $ putStrLn \"a440\"\na441 :: IO (); a441 = forever $ putStrLn \"a441\"\na442 :: IO (); a442 = forever $ putStrLn \"a442\"\na443 :: IO (); a443 = forever $ putStrLn \"a443\"\na444 :: IO (); a444 = forever $ putStrLn \"a444\"\na445 :: IO (); a445 = forever $ putStrLn \"a445\"\na446 :: IO (); a446 = forever $ putStrLn \"a446\"\na447 :: IO (); a447 = forever $ putStrLn \"a447\"\na448 :: IO (); a448 = forever $ putStrLn \"a448\"\na449 :: IO (); a449 = forever $ putStrLn \"a449\"\na450 :: IO (); a450 = forever $ putStrLn \"a450\"\na451 :: IO (); a451 = forever $ putStrLn \"a451\"\na452 :: IO (); a452 = forever $ putStrLn \"a452\"\na453 :: IO (); a453 = forever $ putStrLn \"a453\"\na454 :: IO (); a454 = forever $ putStrLn \"a454\"\na455 :: IO (); a455 = forever $ putStrLn \"a455\"\na456 :: IO (); a456 = forever $ putStrLn \"a456\"\na457 :: IO (); a457 = forever $ putStrLn \"a457\"\na458 :: IO (); a458 = forever $ putStrLn \"a458\"\na459 :: IO (); a459 = forever $ putStrLn \"a459\"\na460 :: IO (); a460 = forever $ putStrLn \"a460\"\na461 :: IO (); a461 = forever $ putStrLn \"a461\"\na462 :: IO (); a462 = forever $ putStrLn \"a462\"\na463 :: IO (); a463 = forever $ putStrLn \"a463\"\na464 :: IO (); a464 = forever $ putStrLn \"a464\"\na465 :: IO (); a465 = forever $ putStrLn \"a465\"\na466 :: IO (); a466 = forever $ putStrLn \"a466\"\na467 :: IO (); a467 = forever $ putStrLn \"a467\"\na468 :: IO (); a468 = forever $ putStrLn \"a468\"\na469 :: IO (); a469 = forever $ putStrLn \"a469\"\na470 :: IO (); a470 = forever $ putStrLn \"a470\"\na471 :: IO (); a471 = forever $ putStrLn \"a471\"\na472 :: IO (); a472 = forever $ putStrLn \"a472\"\na473 :: IO (); a473 = forever $ putStrLn \"a473\"\na474 :: IO (); a474 = forever $ putStrLn \"a474\"\na475 :: IO (); a475 = forever $ putStrLn \"a475\"\na476 :: IO (); a476 = forever $ putStrLn \"a476\"\na477 :: IO (); a477 = forever $ putStrLn \"a477\"\na478 :: IO (); a478 = forever $ putStrLn \"a478\"\na479 :: IO (); a479 = forever $ putStrLn \"a479\"\na480 :: IO (); a480 = forever $ putStrLn \"a480\"\na481 :: IO (); a481 = forever $ putStrLn \"a481\"\na482 :: IO (); a482 = forever $ putStrLn \"a482\"\na483 :: IO (); a483 = forever $ putStrLn \"a483\"\na484 :: IO (); a484 = forever $ putStrLn \"a484\"\na485 :: IO (); a485 = forever $ putStrLn \"a485\"\na486 :: IO (); a486 = forever $ putStrLn \"a486\"\na487 :: IO (); a487 = forever $ putStrLn \"a487\"\na488 :: IO (); a488 = forever $ putStrLn \"a488\"\na489 :: IO (); a489 = forever $ putStrLn \"a489\"\na490 :: IO (); a490 = forever $ putStrLn \"a490\"\na491 :: IO (); a491 = forever $ putStrLn \"a491\"\na492 :: IO (); a492 = forever $ putStrLn \"a492\"\na493 :: IO (); a493 = forever $ putStrLn \"a493\"\na494 :: IO (); a494 = forever $ putStrLn \"a494\"\na495 :: IO (); a495 = forever $ putStrLn \"a495\"\na496 :: IO (); a496 = forever $ putStrLn \"a496\"\na497 :: IO (); a497 = forever $ putStrLn \"a497\"\na498 :: IO (); a498 = forever $ putStrLn \"a498\"\na499 :: IO (); a499 = forever $ putStrLn \"a499\"\na500 :: IO (); a500 = forever $ putStrLn \"a500\"\na501 :: IO (); a501 = forever $ putStrLn \"a501\"\na502 :: IO (); a502 = forever $ putStrLn \"a502\"\na503 :: IO (); a503 = forever $ putStrLn \"a503\"\na504 :: IO (); a504 = forever $ putStrLn \"a504\"\na505 :: IO (); a505 = forever $ putStrLn \"a505\"\na506 :: IO (); a506 = forever $ putStrLn \"a506\"\na507 :: IO (); a507 = forever $ putStrLn \"a507\"\na508 :: IO (); a508 = forever $ putStrLn \"a508\"\na509 :: IO (); a509 = forever $ putStrLn \"a509\"\na510 :: IO (); a510 = forever $ putStrLn \"a510\"\na511 :: IO (); a511 = forever $ putStrLn \"a511\"\na512 :: IO (); a512 = forever $ putStrLn \"a512\"\na513 :: IO (); a513 = forever $ putStrLn \"a513\"\na514 :: IO (); a514 = forever $ putStrLn \"a514\"\na515 :: IO (); a515 = forever $ putStrLn \"a515\"\na516 :: IO (); a516 = forever $ putStrLn \"a516\"\na517 :: IO (); a517 = forever $ putStrLn \"a517\"\na518 :: IO (); a518 = forever $ putStrLn \"a518\"\na519 :: IO (); a519 = forever $ putStrLn \"a519\"\na520 :: IO (); a520 = forever $ putStrLn \"a520\"\na521 :: IO (); a521 = forever $ putStrLn \"a521\"\na522 :: IO (); a522 = forever $ putStrLn \"a522\"\na523 :: IO (); a523 = forever $ putStrLn \"a523\"\na524 :: IO (); a524 = forever $ putStrLn \"a524\"\na525 :: IO (); a525 = forever $ putStrLn \"a525\"\na526 :: IO (); a526 = forever $ putStrLn \"a526\"\na527 :: IO (); a527 = forever $ putStrLn \"a527\"\na528 :: IO (); a528 = forever $ putStrLn \"a528\"\na529 :: IO (); a529 = forever $ putStrLn \"a529\"\na530 :: IO (); a530 = forever $ putStrLn \"a530\"\na531 :: IO (); a531 = forever $ putStrLn \"a531\"\na532 :: IO (); a532 = forever $ putStrLn \"a532\"\na533 :: IO (); a533 = forever $ putStrLn \"a533\"\na534 :: IO (); a534 = forever $ putStrLn \"a534\"\na535 :: IO (); a535 = forever $ putStrLn \"a535\"\na536 :: IO (); a536 = forever $ putStrLn \"a536\"\na537 :: IO (); a537 = forever $ putStrLn \"a537\"\na538 :: IO (); a538 = forever $ putStrLn \"a538\"\na539 :: IO (); a539 = forever $ putStrLn \"a539\"\na540 :: IO (); a540 = forever $ putStrLn \"a540\"\na541 :: IO (); a541 = forever $ putStrLn \"a541\"\na542 :: IO (); a542 = forever $ putStrLn \"a542\"\na543 :: IO (); a543 = forever $ putStrLn \"a543\"\na544 :: IO (); a544 = forever $ putStrLn \"a544\"\na545 :: IO (); a545 = forever $ putStrLn \"a545\"\na546 :: IO (); a546 = forever $ putStrLn \"a546\"\na547 :: IO (); a547 = forever $ putStrLn \"a547\"\na548 :: IO (); a548 = forever $ putStrLn \"a548\"\na549 :: IO (); a549 = forever $ putStrLn \"a549\"\na550 :: IO (); a550 = forever $ putStrLn \"a550\"\na551 :: IO (); a551 = forever $ putStrLn \"a551\"\na552 :: IO (); a552 = forever $ putStrLn \"a552\"\na553 :: IO (); a553 = forever $ putStrLn \"a553\"\na554 :: IO (); a554 = forever $ putStrLn \"a554\"\na555 :: IO (); a555 = forever $ putStrLn \"a555\"\na556 :: IO (); a556 = forever $ putStrLn \"a556\"\na557 :: IO (); a557 = forever $ putStrLn \"a557\"\na558 :: IO (); a558 = forever $ putStrLn \"a558\"\na559 :: IO (); a559 = forever $ putStrLn \"a559\"\na560 :: IO (); a560 = forever $ putStrLn \"a560\"\na561 :: IO (); a561 = forever $ putStrLn \"a561\"\na562 :: IO (); a562 = forever $ putStrLn \"a562\"\na563 :: IO (); a563 = forever $ putStrLn \"a563\"\na564 :: IO (); a564 = forever $ putStrLn \"a564\"\na565 :: IO (); a565 = forever $ putStrLn \"a565\"\na566 :: IO (); a566 = forever $ putStrLn \"a566\"\na567 :: IO (); a567 = forever $ putStrLn \"a567\"\na568 :: IO (); a568 = forever $ putStrLn \"a568\"\na569 :: IO (); a569 = forever $ putStrLn \"a569\"\na570 :: IO (); a570 = forever $ putStrLn \"a570\"\na571 :: IO (); a571 = forever $ putStrLn \"a571\"\na572 :: IO (); a572 = forever $ putStrLn \"a572\"\na573 :: IO (); a573 = forever $ putStrLn \"a573\"\na574 :: IO (); a574 = forever $ putStrLn \"a574\"\na575 :: IO (); a575 = forever $ putStrLn \"a575\"\na576 :: IO (); a576 = forever $ putStrLn \"a576\"\na577 :: IO (); a577 = forever $ putStrLn \"a577\"\na578 :: IO (); a578 = forever $ putStrLn \"a578\"\na579 :: IO (); a579 = forever $ putStrLn \"a579\"\na580 :: IO (); a580 = forever $ putStrLn \"a580\"\na581 :: IO (); a581 = forever $ putStrLn \"a581\"\na582 :: IO (); a582 = forever $ putStrLn \"a582\"\na583 :: IO (); a583 = forever $ putStrLn \"a583\"\na584 :: IO (); a584 = forever $ putStrLn \"a584\"\na585 :: IO (); a585 = forever $ putStrLn \"a585\"\na586 :: IO (); a586 = forever $ putStrLn \"a586\"\na587 :: IO (); a587 = forever $ putStrLn \"a587\"\na588 :: IO (); a588 = forever $ putStrLn \"a588\"\na589 :: IO (); a589 = forever $ putStrLn \"a589\"\na590 :: IO (); a590 = forever $ putStrLn \"a590\"\na591 :: IO (); a591 = forever $ putStrLn \"a591\"\na592 :: IO (); a592 = forever $ putStrLn \"a592\"\na593 :: IO (); a593 = forever $ putStrLn \"a593\"\na594 :: IO (); a594 = forever $ putStrLn \"a594\"\na595 :: IO (); a595 = forever $ putStrLn \"a595\"\na596 :: IO (); a596 = forever $ putStrLn \"a596\"\na597 :: IO (); a597 = forever $ putStrLn \"a597\"\na598 :: IO (); a598 = forever $ putStrLn \"a598\"\na599 :: IO (); a599 = forever $ putStrLn \"a599\"\na600 :: IO (); a600 = forever $ putStrLn \"a600\"\na601 :: IO (); a601 = forever $ putStrLn \"a601\"\na602 :: IO (); a602 = forever $ putStrLn \"a602\"\na603 :: IO (); a603 = forever $ putStrLn \"a603\"\na604 :: IO (); a604 = forever $ putStrLn \"a604\"\na605 :: IO (); a605 = forever $ putStrLn \"a605\"\na606 :: IO (); a606 = forever $ putStrLn \"a606\"\na607 :: IO (); a607 = forever $ putStrLn \"a607\"\na608 :: IO (); a608 = forever $ putStrLn \"a608\"\na609 :: IO (); a609 = forever $ putStrLn \"a609\"\na610 :: IO (); a610 = forever $ putStrLn \"a610\"\na611 :: IO (); a611 = forever $ putStrLn \"a611\"\na612 :: IO (); a612 = forever $ putStrLn \"a612\"\na613 :: IO (); a613 = forever $ putStrLn \"a613\"\na614 :: IO (); a614 = forever $ putStrLn \"a614\"\na615 :: IO (); a615 = forever $ putStrLn \"a615\"\na616 :: IO (); a616 = forever $ putStrLn \"a616\"\na617 :: IO (); a617 = forever $ putStrLn \"a617\"\na618 :: IO (); a618 = forever $ putStrLn \"a618\"\na619 :: IO (); a619 = forever $ putStrLn \"a619\"\na620 :: IO (); a620 = forever $ putStrLn \"a620\"\na621 :: IO (); a621 = forever $ putStrLn \"a621\"\na622 :: IO (); a622 = forever $ putStrLn \"a622\"\na623 :: IO (); a623 = forever $ putStrLn \"a623\"\na624 :: IO (); a624 = forever $ putStrLn \"a624\"\na625 :: IO (); a625 = forever $ putStrLn \"a625\"\na626 :: IO (); a626 = forever $ putStrLn \"a626\"\na627 :: IO (); a627 = forever $ putStrLn \"a627\"\na628 :: IO (); a628 = forever $ putStrLn \"a628\"\na629 :: IO (); a629 = forever $ putStrLn \"a629\"\na630 :: IO (); a630 = forever $ putStrLn \"a630\"\na631 :: IO (); a631 = forever $ putStrLn \"a631\"\na632 :: IO (); a632 = forever $ putStrLn \"a632\"\na633 :: IO (); a633 = forever $ putStrLn \"a633\"\na634 :: IO (); a634 = forever $ putStrLn \"a634\"\na635 :: IO (); a635 = forever $ putStrLn \"a635\"\na636 :: IO (); a636 = forever $ putStrLn \"a636\"\na637 :: IO (); a637 = forever $ putStrLn \"a637\"\na638 :: IO (); a638 = forever $ putStrLn \"a638\"\na639 :: IO (); a639 = forever $ putStrLn \"a639\"\na640 :: IO (); a640 = forever $ putStrLn \"a640\"\na641 :: IO (); a641 = forever $ putStrLn \"a641\"\na642 :: IO (); a642 = forever $ putStrLn \"a642\"\na643 :: IO (); a643 = forever $ putStrLn \"a643\"\na644 :: IO (); a644 = forever $ putStrLn \"a644\"\na645 :: IO (); a645 = forever $ putStrLn \"a645\"\na646 :: IO (); a646 = forever $ putStrLn \"a646\"\na647 :: IO (); a647 = forever $ putStrLn \"a647\"\na648 :: IO (); a648 = forever $ putStrLn \"a648\"\na649 :: IO (); a649 = forever $ putStrLn \"a649\"\na650 :: IO (); a650 = forever $ putStrLn \"a650\"\na651 :: IO (); a651 = forever $ putStrLn \"a651\"\na652 :: IO (); a652 = forever $ putStrLn \"a652\"\na653 :: IO (); a653 = forever $ putStrLn \"a653\"\na654 :: IO (); a654 = forever $ putStrLn \"a654\"\na655 :: IO (); a655 = forever $ putStrLn \"a655\"\na656 :: IO (); a656 = forever $ putStrLn \"a656\"\na657 :: IO (); a657 = forever $ putStrLn \"a657\"\na658 :: IO (); a658 = forever $ putStrLn \"a658\"\na659 :: IO (); a659 = forever $ putStrLn \"a659\"\na660 :: IO (); a660 = forever $ putStrLn \"a660\"\na661 :: IO (); a661 = forever $ putStrLn \"a661\"\na662 :: IO (); a662 = forever $ putStrLn \"a662\"\na663 :: IO (); a663 = forever $ putStrLn \"a663\"\na664 :: IO (); a664 = forever $ putStrLn \"a664\"\na665 :: IO (); a665 = forever $ putStrLn \"a665\"\na666 :: IO (); a666 = forever $ putStrLn \"a666\"\na667 :: IO (); a667 = forever $ putStrLn \"a667\"\na668 :: IO (); a668 = forever $ putStrLn \"a668\"\na669 :: IO (); a669 = forever $ putStrLn \"a669\"\na670 :: IO (); a670 = forever $ putStrLn \"a670\"\na671 :: IO (); a671 = forever $ putStrLn \"a671\"\na672 :: IO (); a672 = forever $ putStrLn \"a672\"\na673 :: IO (); a673 = forever $ putStrLn \"a673\"\na674 :: IO (); a674 = forever $ putStrLn \"a674\"\na675 :: IO (); a675 = forever $ putStrLn \"a675\"\na676 :: IO (); a676 = forever $ putStrLn \"a676\"\na677 :: IO (); a677 = forever $ putStrLn \"a677\"\na678 :: IO (); a678 = forever $ putStrLn \"a678\"\na679 :: IO (); a679 = forever $ putStrLn \"a679\"\na680 :: IO (); a680 = forever $ putStrLn \"a680\"\na681 :: IO (); a681 = forever $ putStrLn \"a681\"\na682 :: IO (); a682 = forever $ putStrLn \"a682\"\na683 :: IO (); a683 = forever $ putStrLn \"a683\"\na684 :: IO (); a684 = forever $ putStrLn \"a684\"\na685 :: IO (); a685 = forever $ putStrLn \"a685\"\na686 :: IO (); a686 = forever $ putStrLn \"a686\"\na687 :: IO (); a687 = forever $ putStrLn \"a687\"\na688 :: IO (); a688 = forever $ putStrLn \"a688\"\na689 :: IO (); a689 = forever $ putStrLn \"a689\"\na690 :: IO (); a690 = forever $ putStrLn \"a690\"\na691 :: IO (); a691 = forever $ putStrLn \"a691\"\na692 :: IO (); a692 = forever $ putStrLn \"a692\"\na693 :: IO (); a693 = forever $ putStrLn \"a693\"\na694 :: IO (); a694 = forever $ putStrLn \"a694\"\na695 :: IO (); a695 = forever $ putStrLn \"a695\"\na696 :: IO (); a696 = forever $ putStrLn \"a696\"\na697 :: IO (); a697 = forever $ putStrLn \"a697\"\na698 :: IO (); a698 = forever $ putStrLn \"a698\"\na699 :: IO (); a699 = forever $ putStrLn \"a699\"\na700 :: IO (); a700 = forever $ putStrLn \"a700\"\na701 :: IO (); a701 = forever $ putStrLn \"a701\"\na702 :: IO (); a702 = forever $ putStrLn \"a702\"\na703 :: IO (); a703 = forever $ putStrLn \"a703\"\na704 :: IO (); a704 = forever $ putStrLn \"a704\"\na705 :: IO (); a705 = forever $ putStrLn \"a705\"\na706 :: IO (); a706 = forever $ putStrLn \"a706\"\na707 :: IO (); a707 = forever $ putStrLn \"a707\"\na708 :: IO (); a708 = forever $ putStrLn \"a708\"\na709 :: IO (); a709 = forever $ putStrLn \"a709\"\na710 :: IO (); a710 = forever $ putStrLn \"a710\"\na711 :: IO (); a711 = forever $ putStrLn \"a711\"\na712 :: IO (); a712 = forever $ putStrLn \"a712\"\na713 :: IO (); a713 = forever $ putStrLn \"a713\"\na714 :: IO (); a714 = forever $ putStrLn \"a714\"\na715 :: IO (); a715 = forever $ putStrLn \"a715\"\na716 :: IO (); a716 = forever $ putStrLn \"a716\"\na717 :: IO (); a717 = forever $ putStrLn \"a717\"\na718 :: IO (); a718 = forever $ putStrLn \"a718\"\na719 :: IO (); a719 = forever $ putStrLn \"a719\"\na720 :: IO (); a720 = forever $ putStrLn \"a720\"\na721 :: IO (); a721 = forever $ putStrLn \"a721\"\na722 :: IO (); a722 = forever $ putStrLn \"a722\"\na723 :: IO (); a723 = forever $ putStrLn \"a723\"\na724 :: IO (); a724 = forever $ putStrLn \"a724\"\na725 :: IO (); a725 = forever $ putStrLn \"a725\"\na726 :: IO (); a726 = forever $ putStrLn \"a726\"\na727 :: IO (); a727 = forever $ putStrLn \"a727\"\na728 :: IO (); a728 = forever $ putStrLn \"a728\"\na729 :: IO (); a729 = forever $ putStrLn \"a729\"\na730 :: IO (); a730 = forever $ putStrLn \"a730\"\na731 :: IO (); a731 = forever $ putStrLn \"a731\"\na732 :: IO (); a732 = forever $ putStrLn \"a732\"\na733 :: IO (); a733 = forever $ putStrLn \"a733\"\na734 :: IO (); a734 = forever $ putStrLn \"a734\"\na735 :: IO (); a735 = forever $ putStrLn \"a735\"\na736 :: IO (); a736 = forever $ putStrLn \"a736\"\na737 :: IO (); a737 = forever $ putStrLn \"a737\"\na738 :: IO (); a738 = forever $ putStrLn \"a738\"\na739 :: IO (); a739 = forever $ putStrLn \"a739\"\na740 :: IO (); a740 = forever $ putStrLn \"a740\"\na741 :: IO (); a741 = forever $ putStrLn \"a741\"\na742 :: IO (); a742 = forever $ putStrLn \"a742\"\na743 :: IO (); a743 = forever $ putStrLn \"a743\"\na744 :: IO (); a744 = forever $ putStrLn \"a744\"\na745 :: IO (); a745 = forever $ putStrLn \"a745\"\na746 :: IO (); a746 = forever $ putStrLn \"a746\"\na747 :: IO (); a747 = forever $ putStrLn \"a747\"\na748 :: IO (); a748 = forever $ putStrLn \"a748\"\na749 :: IO (); a749 = forever $ putStrLn \"a749\"\na750 :: IO (); a750 = forever $ putStrLn \"a750\"\na751 :: IO (); a751 = forever $ putStrLn \"a751\"\na752 :: IO (); a752 = forever $ putStrLn \"a752\"\na753 :: IO (); a753 = forever $ putStrLn \"a753\"\na754 :: IO (); a754 = forever $ putStrLn \"a754\"\na755 :: IO (); a755 = forever $ putStrLn \"a755\"\na756 :: IO (); a756 = forever $ putStrLn \"a756\"\na757 :: IO (); a757 = forever $ putStrLn \"a757\"\na758 :: IO (); a758 = forever $ putStrLn \"a758\"\na759 :: IO (); a759 = forever $ putStrLn \"a759\"\na760 :: IO (); a760 = forever $ putStrLn \"a760\"\na761 :: IO (); a761 = forever $ putStrLn \"a761\"\na762 :: IO (); a762 = forever $ putStrLn \"a762\"\na763 :: IO (); a763 = forever $ putStrLn \"a763\"\na764 :: IO (); a764 = forever $ putStrLn \"a764\"\na765 :: IO (); a765 = forever $ putStrLn \"a765\"\na766 :: IO (); a766 = forever $ putStrLn \"a766\"\na767 :: IO (); a767 = forever $ putStrLn \"a767\"\na768 :: IO (); a768 = forever $ putStrLn \"a768\"\na769 :: IO (); a769 = forever $ putStrLn \"a769\"\na770 :: IO (); a770 = forever $ putStrLn \"a770\"\na771 :: IO (); a771 = forever $ putStrLn \"a771\"\na772 :: IO (); a772 = forever $ putStrLn \"a772\"\na773 :: IO (); a773 = forever $ putStrLn \"a773\"\na774 :: IO (); a774 = forever $ putStrLn \"a774\"\na775 :: IO (); a775 = forever $ putStrLn \"a775\"\na776 :: IO (); a776 = forever $ putStrLn \"a776\"\na777 :: IO (); a777 = forever $ putStrLn \"a777\"\na778 :: IO (); a778 = forever $ putStrLn \"a778\"\na779 :: IO (); a779 = forever $ putStrLn \"a779\"\na780 :: IO (); a780 = forever $ putStrLn \"a780\"\na781 :: IO (); a781 = forever $ putStrLn \"a781\"\na782 :: IO (); a782 = forever $ putStrLn \"a782\"\na783 :: IO (); a783 = forever $ putStrLn \"a783\"\na784 :: IO (); a784 = forever $ putStrLn \"a784\"\na785 :: IO (); a785 = forever $ putStrLn \"a785\"\na786 :: IO (); a786 = forever $ putStrLn \"a786\"\na787 :: IO (); a787 = forever $ putStrLn \"a787\"\na788 :: IO (); a788 = forever $ putStrLn \"a788\"\na789 :: IO (); a789 = forever $ putStrLn \"a789\"\na790 :: IO (); a790 = forever $ putStrLn \"a790\"\na791 :: IO (); a791 = forever $ putStrLn \"a791\"\na792 :: IO (); a792 = forever $ putStrLn \"a792\"\na793 :: IO (); a793 = forever $ putStrLn \"a793\"\na794 :: IO (); a794 = forever $ putStrLn \"a794\"\na795 :: IO (); a795 = forever $ putStrLn \"a795\"\na796 :: IO (); a796 = forever $ putStrLn \"a796\"\na797 :: IO (); a797 = forever $ putStrLn \"a797\"\na798 :: IO (); a798 = forever $ putStrLn \"a798\"\na799 :: IO (); a799 = forever $ putStrLn \"a799\"\na800 :: IO (); a800 = forever $ putStrLn \"a800\"\na801 :: IO (); a801 = forever $ putStrLn \"a801\"\na802 :: IO (); a802 = forever $ putStrLn \"a802\"\na803 :: IO (); a803 = forever $ putStrLn \"a803\"\na804 :: IO (); a804 = forever $ putStrLn \"a804\"\na805 :: IO (); a805 = forever $ putStrLn \"a805\"\na806 :: IO (); a806 = forever $ putStrLn \"a806\"\na807 :: IO (); a807 = forever $ putStrLn \"a807\"\na808 :: IO (); a808 = forever $ putStrLn \"a808\"\na809 :: IO (); a809 = forever $ putStrLn \"a809\"\na810 :: IO (); a810 = forever $ putStrLn \"a810\"\na811 :: IO (); a811 = forever $ putStrLn \"a811\"\na812 :: IO (); a812 = forever $ putStrLn \"a812\"\na813 :: IO (); a813 = forever $ putStrLn \"a813\"\na814 :: IO (); a814 = forever $ putStrLn \"a814\"\na815 :: IO (); a815 = forever $ putStrLn \"a815\"\na816 :: IO (); a816 = forever $ putStrLn \"a816\"\na817 :: IO (); a817 = forever $ putStrLn \"a817\"\na818 :: IO (); a818 = forever $ putStrLn \"a818\"\na819 :: IO (); a819 = forever $ putStrLn \"a819\"\na820 :: IO (); a820 = forever $ putStrLn \"a820\"\na821 :: IO (); a821 = forever $ putStrLn \"a821\"\na822 :: IO (); a822 = forever $ putStrLn \"a822\"\na823 :: IO (); a823 = forever $ putStrLn \"a823\"\na824 :: IO (); a824 = forever $ putStrLn \"a824\"\na825 :: IO (); a825 = forever $ putStrLn \"a825\"\na826 :: IO (); a826 = forever $ putStrLn \"a826\"\na827 :: IO (); a827 = forever $ putStrLn \"a827\"\na828 :: IO (); a828 = forever $ putStrLn \"a828\"\na829 :: IO (); a829 = forever $ putStrLn \"a829\"\na830 :: IO (); a830 = forever $ putStrLn \"a830\"\na831 :: IO (); a831 = forever $ putStrLn \"a831\"\na832 :: IO (); a832 = forever $ putStrLn \"a832\"\na833 :: IO (); a833 = forever $ putStrLn \"a833\"\na834 :: IO (); a834 = forever $ putStrLn \"a834\"\na835 :: IO (); a835 = forever $ putStrLn \"a835\"\na836 :: IO (); a836 = forever $ putStrLn \"a836\"\na837 :: IO (); a837 = forever $ putStrLn \"a837\"\na838 :: IO (); a838 = forever $ putStrLn \"a838\"\na839 :: IO (); a839 = forever $ putStrLn \"a839\"\na840 :: IO (); a840 = forever $ putStrLn \"a840\"\na841 :: IO (); a841 = forever $ putStrLn \"a841\"\na842 :: IO (); a842 = forever $ putStrLn \"a842\"\na843 :: IO (); a843 = forever $ putStrLn \"a843\"\na844 :: IO (); a844 = forever $ putStrLn \"a844\"\na845 :: IO (); a845 = forever $ putStrLn \"a845\"\na846 :: IO (); a846 = forever $ putStrLn \"a846\"\na847 :: IO (); a847 = forever $ putStrLn \"a847\"\na848 :: IO (); a848 = forever $ putStrLn \"a848\"\na849 :: IO (); a849 = forever $ putStrLn \"a849\"\na850 :: IO (); a850 = forever $ putStrLn \"a850\"\na851 :: IO (); a851 = forever $ putStrLn \"a851\"\na852 :: IO (); a852 = forever $ putStrLn \"a852\"\na853 :: IO (); a853 = forever $ putStrLn \"a853\"\na854 :: IO (); a854 = forever $ putStrLn \"a854\"\na855 :: IO (); a855 = forever $ putStrLn \"a855\"\na856 :: IO (); a856 = forever $ putStrLn \"a856\"\na857 :: IO (); a857 = forever $ putStrLn \"a857\"\na858 :: IO (); a858 = forever $ putStrLn \"a858\"\na859 :: IO (); a859 = forever $ putStrLn \"a859\"\na860 :: IO (); a860 = forever $ putStrLn \"a860\"\na861 :: IO (); a861 = forever $ putStrLn \"a861\"\na862 :: IO (); a862 = forever $ putStrLn \"a862\"\na863 :: IO (); a863 = forever $ putStrLn \"a863\"\na864 :: IO (); a864 = forever $ putStrLn \"a864\"\na865 :: IO (); a865 = forever $ putStrLn \"a865\"\na866 :: IO (); a866 = forever $ putStrLn \"a866\"\na867 :: IO (); a867 = forever $ putStrLn \"a867\"\na868 :: IO (); a868 = forever $ putStrLn \"a868\"\na869 :: IO (); a869 = forever $ putStrLn \"a869\"\na870 :: IO (); a870 = forever $ putStrLn \"a870\"\na871 :: IO (); a871 = forever $ putStrLn \"a871\"\na872 :: IO (); a872 = forever $ putStrLn \"a872\"\na873 :: IO (); a873 = forever $ putStrLn \"a873\"\na874 :: IO (); a874 = forever $ putStrLn \"a874\"\na875 :: IO (); a875 = forever $ putStrLn \"a875\"\na876 :: IO (); a876 = forever $ putStrLn \"a876\"\na877 :: IO (); a877 = forever $ putStrLn \"a877\"\na878 :: IO (); a878 = forever $ putStrLn \"a878\"\na879 :: IO (); a879 = forever $ putStrLn \"a879\"\na880 :: IO (); a880 = forever $ putStrLn \"a880\"\na881 :: IO (); a881 = forever $ putStrLn \"a881\"\na882 :: IO (); a882 = forever $ putStrLn \"a882\"\na883 :: IO (); a883 = forever $ putStrLn \"a883\"\na884 :: IO (); a884 = forever $ putStrLn \"a884\"\na885 :: IO (); a885 = forever $ putStrLn \"a885\"\na886 :: IO (); a886 = forever $ putStrLn \"a886\"\na887 :: IO (); a887 = forever $ putStrLn \"a887\"\na888 :: IO (); a888 = forever $ putStrLn \"a888\"\na889 :: IO (); a889 = forever $ putStrLn \"a889\"\na890 :: IO (); a890 = forever $ putStrLn \"a890\"\na891 :: IO (); a891 = forever $ putStrLn \"a891\"\na892 :: IO (); a892 = forever $ putStrLn \"a892\"\na893 :: IO (); a893 = forever $ putStrLn \"a893\"\na894 :: IO (); a894 = forever $ putStrLn \"a894\"\na895 :: IO (); a895 = forever $ putStrLn \"a895\"\na896 :: IO (); a896 = forever $ putStrLn \"a896\"\na897 :: IO (); a897 = forever $ putStrLn \"a897\"\na898 :: IO (); a898 = forever $ putStrLn \"a898\"\na899 :: IO (); a899 = forever $ putStrLn \"a899\"\na900 :: IO (); a900 = forever $ putStrLn \"a900\"\na901 :: IO (); a901 = forever $ putStrLn \"a901\"\na902 :: IO (); a902 = forever $ putStrLn \"a902\"\na903 :: IO (); a903 = forever $ putStrLn \"a903\"\na904 :: IO (); a904 = forever $ putStrLn \"a904\"\na905 :: IO (); a905 = forever $ putStrLn \"a905\"\na906 :: IO (); a906 = forever $ putStrLn \"a906\"\na907 :: IO (); a907 = forever $ putStrLn \"a907\"\na908 :: IO (); a908 = forever $ putStrLn \"a908\"\na909 :: IO (); a909 = forever $ putStrLn \"a909\"\na910 :: IO (); a910 = forever $ putStrLn \"a910\"\na911 :: IO (); a911 = forever $ putStrLn \"a911\"\na912 :: IO (); a912 = forever $ putStrLn \"a912\"\na913 :: IO (); a913 = forever $ putStrLn \"a913\"\na914 :: IO (); a914 = forever $ putStrLn \"a914\"\na915 :: IO (); a915 = forever $ putStrLn \"a915\"\na916 :: IO (); a916 = forever $ putStrLn \"a916\"\na917 :: IO (); a917 = forever $ putStrLn \"a917\"\na918 :: IO (); a918 = forever $ putStrLn \"a918\"\na919 :: IO (); a919 = forever $ putStrLn \"a919\"\na920 :: IO (); a920 = forever $ putStrLn \"a920\"\na921 :: IO (); a921 = forever $ putStrLn \"a921\"\na922 :: IO (); a922 = forever $ putStrLn \"a922\"\na923 :: IO (); a923 = forever $ putStrLn \"a923\"\na924 :: IO (); a924 = forever $ putStrLn \"a924\"\na925 :: IO (); a925 = forever $ putStrLn \"a925\"\na926 :: IO (); a926 = forever $ putStrLn \"a926\"\na927 :: IO (); a927 = forever $ putStrLn \"a927\"\na928 :: IO (); a928 = forever $ putStrLn \"a928\"\na929 :: IO (); a929 = forever $ putStrLn \"a929\"\na930 :: IO (); a930 = forever $ putStrLn \"a930\"\na931 :: IO (); a931 = forever $ putStrLn \"a931\"\na932 :: IO (); a932 = forever $ putStrLn \"a932\"\na933 :: IO (); a933 = forever $ putStrLn \"a933\"\na934 :: IO (); a934 = forever $ putStrLn \"a934\"\na935 :: IO (); a935 = forever $ putStrLn \"a935\"\na936 :: IO (); a936 = forever $ putStrLn \"a936\"\na937 :: IO (); a937 = forever $ putStrLn \"a937\"\na938 :: IO (); a938 = forever $ putStrLn \"a938\"\na939 :: IO (); a939 = forever $ putStrLn \"a939\"\na940 :: IO (); a940 = forever $ putStrLn \"a940\"\na941 :: IO (); a941 = forever $ putStrLn \"a941\"\na942 :: IO (); a942 = forever $ putStrLn \"a942\"\na943 :: IO (); a943 = forever $ putStrLn \"a943\"\na944 :: IO (); a944 = forever $ putStrLn \"a944\"\na945 :: IO (); a945 = forever $ putStrLn \"a945\"\na946 :: IO (); a946 = forever $ putStrLn \"a946\"\na947 :: IO (); a947 = forever $ putStrLn \"a947\"\na948 :: IO (); a948 = forever $ putStrLn \"a948\"\na949 :: IO (); a949 = forever $ putStrLn \"a949\"\na950 :: IO (); a950 = forever $ putStrLn \"a950\"\na951 :: IO (); a951 = forever $ putStrLn \"a951\"\na952 :: IO (); a952 = forever $ putStrLn \"a952\"\na953 :: IO (); a953 = forever $ putStrLn \"a953\"\na954 :: IO (); a954 = forever $ putStrLn \"a954\"\na955 :: IO (); a955 = forever $ putStrLn \"a955\"\na956 :: IO (); a956 = forever $ putStrLn \"a956\"\na957 :: IO (); a957 = forever $ putStrLn \"a957\"\na958 :: IO (); a958 = forever $ putStrLn \"a958\"\na959 :: IO (); a959 = forever $ putStrLn \"a959\"\na960 :: IO (); a960 = forever $ putStrLn \"a960\"\na961 :: IO (); a961 = forever $ putStrLn \"a961\"\na962 :: IO (); a962 = forever $ putStrLn \"a962\"\na963 :: IO (); a963 = forever $ putStrLn \"a963\"\na964 :: IO (); a964 = forever $ putStrLn \"a964\"\na965 :: IO (); a965 = forever $ putStrLn \"a965\"\na966 :: IO (); a966 = forever $ putStrLn \"a966\"\na967 :: IO (); a967 = forever $ putStrLn \"a967\"\na968 :: IO (); a968 = forever $ putStrLn \"a968\"\na969 :: IO (); a969 = forever $ putStrLn \"a969\"\na970 :: IO (); a970 = forever $ putStrLn \"a970\"\na971 :: IO (); a971 = forever $ putStrLn \"a971\"\na972 :: IO (); a972 = forever $ putStrLn \"a972\"\na973 :: IO (); a973 = forever $ putStrLn \"a973\"\na974 :: IO (); a974 = forever $ putStrLn \"a974\"\na975 :: IO (); a975 = forever $ putStrLn \"a975\"\na976 :: IO (); a976 = forever $ putStrLn \"a976\"\na977 :: IO (); a977 = forever $ putStrLn \"a977\"\na978 :: IO (); a978 = forever $ putStrLn \"a978\"\na979 :: IO (); a979 = forever $ putStrLn \"a979\"\na980 :: IO (); a980 = forever $ putStrLn \"a980\"\na981 :: IO (); a981 = forever $ putStrLn \"a981\"\na982 :: IO (); a982 = forever $ putStrLn \"a982\"\na983 :: IO (); a983 = forever $ putStrLn \"a983\"\na984 :: IO (); a984 = forever $ putStrLn \"a984\"\na985 :: IO (); a985 = forever $ putStrLn \"a985\"\na986 :: IO (); a986 = forever $ putStrLn \"a986\"\na987 :: IO (); a987 = forever $ putStrLn \"a987\"\na988 :: IO (); a988 = forever $ putStrLn \"a988\"\na989 :: IO (); a989 = forever $ putStrLn \"a989\"\na990 :: IO (); a990 = forever $ putStrLn \"a990\"\na991 :: IO (); a991 = forever $ putStrLn \"a991\"\na992 :: IO (); a992 = forever $ putStrLn \"a992\"\na993 :: IO (); a993 = forever $ putStrLn \"a993\"\na994 :: IO (); a994 = forever $ putStrLn \"a994\"\na995 :: IO (); a995 = forever $ putStrLn \"a995\"\na996 :: IO (); a996 = forever $ putStrLn \"a996\"\na997 :: IO (); a997 = forever $ putStrLn \"a997\"\na998 :: IO (); a998 = forever $ putStrLn \"a998\"\na999 :: IO (); a999 = forever $ putStrLn \"a999\"\na1000 :: IO (); a1000 = forever $ putStrLn \"a1000\"\n", "num_lines": 1003}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Reported by sjcjoosten in T10547, this was taking forever because of a bug in\n-- the implementation. See bottom of the file for some notes.\n\nmodule Test where\n\ntype T12 = T11\ntype T11 = T10\ntype T10 = T9\ntype T9  = T8\ntype T8  = T7\ntype T7  = T6\ntype T6  = T5\ntype T5  = T4\ntype T4  = T3\ntype T3  = T2\ntype T2  = T1\ntype T1  = T0\ntype T0  = Int\n\ntype S12 = S11\ntype S11 = S10\ntype S10 = S9\ntype S9  = S8\ntype S8  = S7\ntype S7  = S6\ntype S6  = S5\ntype S5  = S4\ntype S4  = S3\ntype S3  = S2\ntype S2  = S1\ntype S1  = S0\ntype S0  = Int\n\ntest :: (T12, Char) -> (S12, Bool) -> Int\ntest a b = const 1 (f a b)\n\nf :: (a, b) -> (a, b) -> (a, b)\nf a _ = a\n\n-- 5416fad, before the fix:\n--\n--    16,990,408,080 bytes allocated in the heap\n--        49,762,144 bytes copied during GC\n--         4,295,384 bytes maximum residency (5 sample(s))\n--           186,272 bytes maximum slop\n--                12 MB total memory in use (0 MB lost due to fragmentation)\n--\n--                                       Tot time (elapsed)  Avg pause  Max pause\n--    Gen  0     26929 colls,     0 par    0.779s   0.779s     0.0000s    0.0009s\n--    Gen  1         5 colls,     0 par    0.040s   0.040s     0.0080s    0.0099s\n--\n--    TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1)\n--\n--    SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)\n--\n--    INIT    time    0.001s  (  0.001s elapsed)\n--    MUT     time    3.409s  (  3.409s elapsed)\n--    GC      time    0.819s  (  0.819s elapsed)\n--    EXIT    time    0.008s  (  0.012s elapsed)\n--    Total   time    4.256s  (  4.240s elapsed)\n--\n--    Alloc rate    4,984,597,832 bytes per MUT second\n--\n--    Productivity  80.7% of total user, 81.1% of total elapsed\n--\n-- After the fix:\n--\n--        39,165,544 bytes allocated in the heap\n--        19,516,400 bytes copied during GC\n--         4,460,568 bytes maximum residency (5 sample(s))\n--           244,640 bytes maximum slop\n--                11 MB total memory in use (0 MB lost due to fragmentation)\n--\n--                                       Tot time (elapsed)  Avg pause  Max pause\n--    Gen  0        44 colls,     0 par    0.009s   0.009s     0.0002s    0.0007s\n--    Gen  1         5 colls,     0 par    0.040s   0.040s     0.0080s    0.0099s\n--\n--    TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1)\n--\n--    SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)\n--\n--    INIT    time    0.001s  (  0.001s elapsed)\n--    MUT     time    0.009s  (  0.009s elapsed)\n--    GC      time    0.049s  (  0.049s elapsed)\n--    EXIT    time    0.008s  (  0.012s elapsed)\n--    Total   time    0.096s  (  0.070s elapsed)\n--\n--    Alloc rate    4,570,081,011 bytes per MUT second\n--\n--    Productivity  48.2% of total user, 65.9% of total elapsed\n", "num_lines": 91}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12150 where\n\ndata Result a = Success a | Error String\n\n{- 80 guards\n\n   ghc-7.10.3 -O :  0.3s\n   ghc-8.0.1 -O  :  1.8s\n-}\n\ninstance Functor Result where\n    {-# INLINE fmap #-}\n    fmap | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n         | bool = f\n\n      where\n        bool = undefined\n        f = undefined\n", "num_lines": 104}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE GADTs #-}\n\nmodule Crash where\n\nimport Data.Proxy (Proxy(..))\nimport Data.Type.Equality (type (==))\nimport Data.Kind\nimport GHC.Exts\nimport GHC.Generics\n\ndata Dict :: Constraint -> Type where\n  Dict :: a => Dict a\n\ninfixr 0 -->\n\ntype family (args :: [Type]) --> (ret :: Type) :: Type\n  where\n    '[]           --> ret = ret\n    (arg ': args) --> ret = arg -> (args --> ret)\n\ntype family AllArguments (func :: Type) :: [Type]\n  where\n    AllArguments (arg -> func) = arg ': AllArguments func\n    AllArguments ret           = '[]\n\ntype family FinalReturn (func :: Type) :: Type\n  where\n    FinalReturn (arg -> func) = FinalReturn func\n    FinalReturn ret           = ret\n\ntype IsFullFunction f\n  = (AllArguments f --> FinalReturn f) ~ f\n\ntype family SConstructor (struct :: Type) :: Type\n  where\n    SConstructor struct = GPrependFields (Rep struct ()) '[] --> struct\n\ntype family GPrependFields (gstruct :: Type) (tail :: [Type]) :: [Type]\n  where\n    GPrependFields (M1  i t f p) tail = GPrependFields (f p) tail\n    GPrependFields (K1    i c p) tail = c ': tail\n    GPrependFields ((:*:) f g p) tail =\n      GPrependFields (f p) (GPrependFields (g p) tail)\n\nclass (fields1 --> (fields2 --> r)) ~ (fields --> r)\n      => AppendFields fields1 fields2 fields r\n         | fields1 fields2 -> fields\n\ninstance AppendFields '[] fields fields r\n\ninstance AppendFields fields1 fields2 fields r\n         => AppendFields (f ': fields1) fields2 (f ': fields) r\n\nclass Generic struct\n      => GoodConstructor (struct :: Type)\n  where\n    goodConstructor :: Proxy struct\n                    -> Dict ( IsFullFunction (SConstructor struct)\n                            , FinalReturn (SConstructor struct) ~ struct\n                            )\n\ninstance ( Generic struct\n         , GoodConstructorEq (SConstructor struct == struct)\n                             (SConstructor struct)\n                             struct\n         ) => GoodConstructor struct\n  where\n    goodConstructor _ =\n        goodConstructorEq (Proxy :: Proxy (SConstructor struct == struct))\n                          (Proxy :: Proxy (SConstructor struct))\n                          (Proxy :: Proxy struct)\n    {-# INLINE goodConstructor #-}\n\nclass GoodConstructorEq (isEqual :: Bool) (ctor :: Type) (struct :: Type)\n  where\n    goodConstructorEq :: Proxy isEqual\n                      -> Proxy ctor\n                      -> Proxy struct\n                      -> Dict ( IsFullFunction ctor\n                              , FinalReturn ctor ~ struct\n                              )\n\ninstance ( FinalReturn struct ~ struct\n         , AllArguments struct ~ '[]\n         ) => GoodConstructorEq True struct struct\n  where\n    goodConstructorEq _ _ _ = Dict\n    {-# INLINE goodConstructorEq #-}\n\ninstance GoodConstructorEq (ctor == struct) ctor struct\n         => GoodConstructorEq False (arg -> ctor) struct\n  where\n    goodConstructorEq _ _ _ =\n      case goodConstructorEq (Proxy :: Proxy (ctor == struct))\n                             (Proxy :: Proxy ctor)\n                             (Proxy :: Proxy struct)\n      of\n        Dict -> Dict\n    {-# INLINE goodConstructorEq #-}\n\ndata Foo = Foo\n  { _01 :: Int\n  , _02 :: Int\n  , _03 :: Int\n  , _04 :: Int\n  , _05 :: Int\n  , _06 :: Int\n  , _07 :: Int\n  , _08 :: Int\n  , _09 :: Int\n  , _10 :: Int\n  , _11 :: Int\n  , _12 :: Int\n  , _13 :: Int\n  , _14 :: Int\n  , _15 :: Int\n  , _16 :: Int\n  }\n  deriving (Generic)\n\ncrash :: () -> Int\ncrash p1 = x + y\n  where\n    p2 = p1  -- This indirection is required to trigger the problem.\n    x = fst $ case goodConstructor (Proxy :: Proxy Foo) of\n      Dict -> (0, p2)\n    y = fst $ case goodConstructor (Proxy :: Proxy Foo) of\n      Dict -> (0, p2)\n{-# INLINE crash #-}  -- Even 'INLINABLE' is not enough to trigger the problem.\n", "num_lines": 139}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE UndecidableInstances #-}\n{- # OPTIONS_GHC -O1 #-}\n\nmodule T12234 () where\n\nimport Prelude (Eq)\n\ndata ExprF rT = ExprF rT rT deriving Eq\n\nnewtype Expr   = Expr (Fix ExprF) deriving Eq\nnewtype Fix fT = In (fT (Fix fT))\n\nderiving instance Eq (f (Fix f)) => Eq (Fix f)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n\nmodule T12425 where\n\nimport Control.Applicative\nimport Control.Monad\nimport Control.Monad.Trans.State.Lazy (StateT(..))\n\ndata Result a m b = RecurseOnly (Maybe (CondT a m b))\n                  | KeepAndRecurse b (Maybe (CondT a m b))\n\ninstance Monad m => Functor (Result a m) where\n    fmap f (RecurseOnly l)      = RecurseOnly (liftM (fmap f) l)\n    fmap f (KeepAndRecurse a l) = KeepAndRecurse (f a) (liftM (fmap f) l)\n    {-# INLINE fmap #-}\n\nnewtype CondT a m b = CondT (StateT a m (Result a m b))\n\ninstance Monad m => Functor (CondT a m) where\n    fmap f (CondT g) = CondT (liftM (fmap f) g)\n    {-# INLINE fmap #-}\n\ninstance Monad m => Applicative (CondT a m) where\n    pure  = undefined\n    (<*>) = undefined\n\ninstance Monad m => Monad (CondT a m) where\n    return = undefined\n    (>>=) = undefined\n\n-- liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule T12545 where\n\nimport T12545a\n\ndata A\n\ntype instance ElemsOf A = [ T1, T2, T3, T4, T5, T6, T7, T8\n                          , T9, T10, T11, T12, T13, T14, T15, T16\n                          , T17, T18, T19, T20, T21, T22, T23, T24\n                          , T25, T26, T27, T28, T29, T30, T31, T32\n                          ]\n\ndata T1; instance ElemOf A T1 where\ndata T2; instance ElemOf A T2 where\ndata T3; instance ElemOf A T3 where\ndata T4; instance ElemOf A T4 where\ndata T5; instance ElemOf A T5 where\ndata T6; instance ElemOf A T6 where\ndata T7; instance ElemOf A T7 where\ndata T8; instance ElemOf A T8 where\ndata T9; instance ElemOf A T9 where\ndata T10; instance ElemOf A T10 where\ndata T11; instance ElemOf A T11 where\ndata T12; instance ElemOf A T12 where\ndata T13; instance ElemOf A T13 where\ndata T14; instance ElemOf A T14 where\ndata T15; instance ElemOf A T15 where\ndata T16; instance ElemOf A T16 where\ndata T17; instance ElemOf A T17 where\ndata T18; instance ElemOf A T18 where\ndata T19; instance ElemOf A T19 where\ndata T20; instance ElemOf A T20 where\ndata T21; instance ElemOf A T21 where\ndata T22; instance ElemOf A T22 where\ndata T23; instance ElemOf A T23 where\ndata T24; instance ElemOf A T24 where\ndata T25; instance ElemOf A T25 where\ndata T26; instance ElemOf A T26 where\ndata T27; instance ElemOf A T27 where\ndata T28; instance ElemOf A T28 where\ndata T29; instance ElemOf A T29 where\ndata T30; instance ElemOf A T30 where\ndata T31; instance ElemOf A T31 where\ndata T32; instance ElemOf A T32 where\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T12545a\n  ( ElemWitness(..)\n  , ElemAt(..)\n  , JustElemPath\n  , FindElem\n  , IsElem\n  , ElemOf\n  , ElemsOf\n  ) where\n\nimport Data.Kind (Type)\nimport Data.Proxy (Proxy(..))\n\ndata ElemPath = HeadElem\n              | TailElem ElemPath\n\ndata MaybeElemPath = NotElem\n                   | Elem ElemPath\n\ntype family FindElem (p :: ElemPath) (a :: k) (l :: [k]) :: MaybeElemPath where\n  FindElem p a (a ': t) = 'Elem p\n  FindElem p a (b ': t) = FindElem ('TailElem p) a t\n  FindElem p a '[] = 'NotElem\n\ntype family JustElemPath (p :: MaybeElemPath) :: ElemPath where\n  JustElemPath ('Elem p) = p\n\ndata ElemWitness (p :: ElemPath) (a :: k) (l :: [k])  where\n  ElemHeadWitness :: ElemWitness 'HeadElem a (a ': t)\n  ElemTailWitness :: (ElemAt p a t,\n                      FindElem 'HeadElem a (b ': t) ~ 'Elem ('TailElem p))\n                  => ElemWitness p a t -> ElemWitness ('TailElem p) a (b ': t)\n\nclass (FindElem 'HeadElem a l ~ 'Elem p) => ElemAt p (a :: k) (l :: [k]) where\n  elemWitness :: Proxy a -> Proxy l -> ElemWitness p a l\n\ninstance ElemAt 'HeadElem a (a ': t) where\n  elemWitness _ _ = ElemHeadWitness\n\ninstance (ElemAt p a t, FindElem 'HeadElem a (b ': t) ~ 'Elem ('TailElem p))\n         => ElemAt ('TailElem p) a (b ': t) where\n  elemWitness pa _ = ElemTailWitness (elemWitness pa (Proxy :: Proxy t))\n\ntype IsElem a l = ElemAt (JustElemPath (FindElem 'HeadElem a l)) a l\n\nclass IsElem t (ElemsOf a) => ElemOf a t where\n\ntype family ElemsOf a :: [Type]\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures, FlexibleContexts, TypeOperators #-}\nmodule SpeedTest (Bar (..), Foo0 (..), Foo1 (..), Foo2 (..), Foo3 (..)) where\n\nimport GHC.Generics\nimport Data.Typeable (Typeable)\n\n-------------------------------------------------------------------------------\n-- Generic class\n-------------------------------------------------------------------------------\n\nclass Bar a where\n    bar :: a -> [String]\n    bar x = bar' x []\n\n    bar' :: a -> [String] -> [String]\n    default bar' :: (Generic a, GBar (Rep a)) => a -> [String] -> [String]\n    bar' x = gbar (from x)\n\nclass GBar f where\n    gbar :: f a -> [String] -> [String]\n\ninstance (GBar a, GBar b) => GBar (a :*: b) where\n    gbar (a :*: b) = gbar a . gbar b\n\ninstance GBar a => GBar (M1 i c a) where\n    gbar (M1 x) = gbar x\n\ninstance Bar a => GBar (K1 i a) where\n    gbar (K1 x) = bar' x\n\ninstance Bar a => Bar [a] where\n    bar' = foldr (.) id . map bar'\n\ninstance Bar a => Bar (Maybe a) where\n    bar' = maybe id bar'\n\ninstance Bar Bool where\n    bar' = (:) . show\n\ninstance Bar Char where\n    bar' = (:) . show\n\ninstance Bar Int where\n    bar' = (:) . show\n\n-------------------------------------------------------------------------------\n-- Another generic class\n-------------------------------------------------------------------------------\n\nclass Quu a where\n    quu :: a -> [String]\n    quu x = quu' x []\n\n    quu' :: a -> [String] -> [String]\n    default quu' :: (Generic a, GQuu (Rep a)) => a -> [String] -> [String]\n    quu' x = gquu (from x)\n\nclass GQuu f where\n    gquu :: f a -> [String] -> [String]\n\ninstance (GQuu a, GQuu b) => GQuu (a :*: b) where\n    gquu (a :*: b) = gquu a . gquu b\n\ninstance GQuu a => GQuu (M1 i c a) where\n    gquu (M1 x) = gquu x\n\ninstance Quu a => GQuu (K1 i a) where\n    gquu (K1 x) = quu' x\n\ninstance Quu a => Quu [a] where\n    quu' = foldr (.) id . map quu'\n\ninstance Quu a => Quu (Maybe a) where\n    quu' = maybe id quu'\n\ninstance Quu Bool where\n    quu' = (:) . show\n\ninstance Quu Char where\n    quu' = (:) . show\n\ninstance Quu Int where\n    quu' = (:) . show\n\n-------------------------------------------------------------------------------\n-- Data\n-------------------------------------------------------------------------------\n\ndata Foo0 = Foo0\n    { foo0Field00 :: !String -- Should really have Text\n    , foo0Field01 :: !Int\n    , foo0Field02 :: ![Int]\n    , foo0Field03 :: !(Maybe Bool)\n    , foo0Field04 :: !Bool\n    , foo0Field05 :: !String\n    , foo0Field06 :: !Int\n    , foo0Field07 :: ![Int]\n    , foo0Field08 :: !(Maybe Bool)\n    , foo0Field09 :: !Bool\n    , foo0Field10 :: !String\n    , foo0Field11 :: !Int\n    , foo0Field12 :: ![Int]\n    , foo0Field13 :: !(Maybe Bool)\n    , foo0Field14 :: !Bool\n    , foo0Field15 :: !String\n    , foo0Field16 :: !Int\n    , foo0Field17 :: ![Int]\n    , foo0Field18 :: !(Maybe Bool)\n    , foo0Field19 :: !Bool\n    }\n  deriving (Eq, Ord, Show, Typeable, Generic)\n\ninstance Bar Foo0\ninstance Quu Foo0\n\ndata Foo1 = Foo1\n    { foo1Field00 :: !String -- Should really have Text\n    , foo1Field01 :: !Int\n    , foo1Field02 :: ![Int]\n    , foo1Field03 :: !(Maybe Bool)\n    , foo1Field04 :: !Bool\n    , foo1Field05 :: !String\n    , foo1Field06 :: !Int\n    , foo1Field07 :: ![Int]\n    , foo1Field08 :: !(Maybe Bool)\n    , foo1Field09 :: !Bool\n    , foo1Field10 :: !String\n    , foo1Field11 :: !Int\n    , foo1Field12 :: ![Int]\n    , foo1Field13 :: !(Maybe Bool)\n    , foo1Field14 :: !Bool\n    , foo1Field15 :: !String\n    , foo1Field16 :: !Int\n    , foo1Field17 :: ![Int]\n    , foo1Field18 :: !(Maybe Bool)\n    , foo1Field19 :: !Bool\n    }\n  deriving (Eq, Ord, Show, Typeable, Generic)\n\ninstance Bar Foo1\ninstance Quu Foo1\n\ndata Foo2 = Foo2\n    { foo2Field00 :: !String -- Should really have Text\n    , foo2Field01 :: !Int\n    , foo2Field02 :: ![Int]\n    , foo2Field03 :: !(Maybe Bool)\n    , foo2Field04 :: !Bool\n    , foo2Field05 :: !String\n    , foo2Field06 :: !Int\n    , foo2Field07 :: ![Int]\n    , foo2Field08 :: !(Maybe Bool)\n    , foo2Field09 :: !Bool\n    , foo2Field10 :: !String\n    , foo2Field11 :: !Int\n    , foo2Field12 :: ![Int]\n    , foo2Field13 :: !(Maybe Bool)\n    , foo2Field14 :: !Bool\n    , foo2Field15 :: !String\n    , foo2Field16 :: !Int\n    , foo2Field17 :: ![Int]\n    , foo2Field18 :: !(Maybe Bool)\n    , foo2Field19 :: !Bool\n    }\n  deriving (Eq, Ord, Show, Typeable, Generic)\n\ninstance Bar Foo2\ninstance Quu Foo2\n\ndata Foo3 = Foo3\n    { foo3Field00 :: !String -- Should really have Text\n    , foo3Field01 :: !Int\n    , foo3Field02 :: ![Int]\n    , foo3Field03 :: !(Maybe Bool)\n    , foo3Field04 :: !Bool\n    , foo3Field05 :: !String\n    , foo3Field06 :: !Int\n    , foo3Field07 :: ![Int]\n    , foo3Field08 :: !(Maybe Bool)\n    , foo3Field09 :: !Bool\n    , foo3Field10 :: !String\n    , foo3Field11 :: !Int\n    , foo3Field12 :: ![Int]\n    , foo3Field13 :: !(Maybe Bool)\n    , foo3Field14 :: !Bool\n    , foo3Field15 :: !String\n    , foo3Field16 :: !Int\n    , foo3Field17 :: ![Int]\n    , foo3Field18 :: !(Maybe Bool)\n    , foo3Field19 :: !Bool\n    }\n  deriving (Eq, Ord, Show, Typeable, Generic)\n\ninstance Bar Foo3\ninstance Quu Foo3\n", "num_lines": 196}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeOperators, TypeFamilies,\n             GADTs, PartialTypeSignatures #-}\n\nmodule T13035 where\n\nimport Data.Kind\n\nnewtype MyAttr a b = MyAttr { _unMyAttr :: MyFun (a b) }\ntype MyRec a b = Rec (MyAttr a) b\n\ntype family MyFun (a :: k1) :: k2\n\ndata GY (a :: k1) (b :: k2) (c :: k1 -> k3) (d :: k1)\ndata GNone (a :: k1)\n\ntype family GYTF a where\n    GYTF (GY a b _ a) = b\n    GYTF (GY _ _ c d) = MyFun (c d)\n\ntype instance MyFun (GY a b c d) = GYTF (GY a b c d)\n\ntype family GNoneTF (a :: k1) :: k2 where\n\ntype instance MyFun (GNone a) = GNoneTF a\n\ntype (a :: k1) =: (b :: k2) = a `GY` b\ntype (a :: j1 -> j2) $ (b :: j1) = a b\n\ninfixr 0 $\ninfixr 9 =:\n\ndata FConst (a :: Type) (b :: Fields)\ndata FApply (a :: Type -> Type -> Type) b c (d :: Fields)\ndata FMap (a :: Type -> Type) b (d :: Fields)\n\ntype instance MyFun (FConst a b) = a\ntype instance MyFun (FApply b c d a) = b (MyFun (c a)) (MyFun (d a))\ntype instance MyFun (FMap b c a) = b (MyFun (c a))\n\ndata Fields = Name\n            | Author\n            | Image\n            | Description\n            | Ingredients\n            | Instructions\n            | CookTime\n            | PrepTime\n            | TotalTime\n            | Yield\n            | Nutrition\n            | Tags\n            | Url\n            | Section\n            | Items\n            | Subsections\n            | Calories\n            | Carbohydrates\n            | Cholesterol\n            | Fat\n            | Fiber\n            | Protien\n            | SaturatedFat\n            | Sodium\n            | Sugar\n            | TransFat\n            | UnsaturatedFat\n            | ServingSize\n\ndata Rec :: (u -> Type) -> [u] -> Type where\n  RNil :: Rec f '[]\n  (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)\n\ndata family Sing (a :: k)\ndata instance Sing (z_a6bn :: Fields)\n      = z_a6bn ~ Name => SName |\n        z_a6bn ~ Author => SAuthor |\n        z_a6bn ~ Image => SImage |\n        z_a6bn ~ Description => SDescription |\n        z_a6bn ~ Ingredients => SIngredients |\n        z_a6bn ~ Instructions => SInstructions |\n        z_a6bn ~ CookTime => SCookTime |\n        z_a6bn ~ PrepTime => SPrepTime |\n        z_a6bn ~ TotalTime => STotalTime |\n        z_a6bn ~ Yield => SYield |\n        z_a6bn ~ Nutrition => SNutrition |\n        z_a6bn ~ Tags => STags |\n        z_a6bn ~ Url => SUrl |\n        z_a6bn ~ Section => SSection |\n        z_a6bn ~ Items => SItems |\n        z_a6bn ~ Subsections => SSubsections |\n        z_a6bn ~ Calories => SCalories |\n        z_a6bn ~ Carbohydrates => SCarbohydrates |\n        z_a6bn ~ Cholesterol => SCholesterol |\n        z_a6bn ~ Fat => SFat |\n        z_a6bn ~ Fiber => SFiber |\n        z_a6bn ~ Protien => SProtien |\n        z_a6bn ~ SaturatedFat => SSaturatedFat |\n        z_a6bn ~ Sodium => SSodium |\n        z_a6bn ~ Sugar => SSugar |\n        z_a6bn ~ TransFat => STransFat |\n        z_a6bn ~ UnsaturatedFat => SUnsaturatedFat |\n        z_a6bn ~ ServingSize => SServingSize\n\n(=::) :: sing f -> MyFun (a f) -> MyAttr a f\n_ =:: x = MyAttr x\n\ntype NutritionT\n    = Calories       =: Maybe Int\n    $ Carbohydrates  =: Maybe Int\n    $ Cholesterol    =: Maybe Int\n    $ Fat            =: Maybe Int\n    $ Fiber          =: Maybe Int\n    $ Protien        =: Maybe Int\n    $ SaturatedFat   =: Maybe Int\n    $ Sodium         =: Maybe Int\n    $ Sugar          =: Maybe Int\n    $ TransFat       =: Maybe Int\n    $ UnsaturatedFat =: Maybe Int\n    $ ServingSize    =: String\n    $ GNone\n\ntype NutritionRec = MyRec NutritionT ['Calories, 'Carbohydrates,\n                                      'Cholesterol, 'Fat, 'Fiber,\n                                      'Protien, 'SaturatedFat, 'Sodium,\n                                      'Sugar, 'TransFat, 'UnsaturatedFat,\n                                      'ServingSize]\n\ntype RecipeT\n    = Name         =: String\n    $ Author       =: String\n    $ Image        =: String\n    $ Description  =: String\n    $ CookTime     =: Maybe Int\n    $ PrepTime     =: Maybe Int\n    $ TotalTime    =: Maybe Int\n    $ Yield        =: String\n    $ Nutrition    =: NutritionRec\n    $ Tags         =: [String]\n    $ Url          =: String\n    $ GNone\n\ntype RecipeFormatter = FApply (->) (FConst [String]) (FMap IO RecipeT)\n\ng :: MyRec RecipeFormatter _ --'[ 'Author ] Uncomment to prevent loop\ng = SAuthor =:: (\\a -> return \"Hi\")\n    :& RNil\n", "num_lines": 147}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE DeriveFoldable #-}\n{-# LANGUAGE RoleAnnotations #-}\n\nmodule Bug where\nimport Data.Typeable\nimport GHC.Generics\nimport Data.Data\n\ndata Condition v = Condition\n    deriving (Functor, Foldable)\n-- We don't want the phantom optimization to kick\n-- in here and confuse the test.\ntype role Condition representational\n\ndata CondTree v c a = CondNode\n    { condTreeData        :: a\n    , condTreeConstraints :: c\n    , condTreeComponents  :: [CondBranch v c a]\n    }\n    deriving (Functor, Foldable)\n\ndata CondBranch v c a = CondBranch\n    { condBranchCondition :: Condition v\n    , condBranchIfTrue    :: CondTree v c a\n    , condBranchIfFalse   :: Maybe (CondTree v c a)\n    }\n    deriving (Functor, Foldable)\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13379 where\n\ng bs =\n{-  Just add more lines to make this program take longer to compile\n    With GHC 8 it was very non-linear\n\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n-}\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >> f bs >>\n      f bs >> f bs >> f bs >> f bs >> f bs\n\nf :: String -> IO ()\n{-# INLINE f #-}\nf = putStrLn\n", "num_lines": 373}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -w #-}\n{-# OPTIONS -XMagicHash -XBangPatterns #-}\nmodule Grammar where\nimport qualified Data.Array as Happy_Data_Array\nimport qualified Data.Bits as Bits\nimport qualified GHC.Exts as Happy_GHC_Exts\nimport Control.Applicative(Applicative(..))\nimport Control.Monad (ap)\n\n-- The token type:\ndata Token = TokenLet\n           | TokenIn\n           | TokenInt Int\n           | TokenSym String\n           | TokenEq\n           | TokenPlus\n           | TokenMinus\n           | TokenTimes\n           | TokenDiv\n           | TokenLParen\n           | TokenRParen\n           | TokenLCurl\n           | TokenRCurl\n           | TokenLRect\n           | TokenRRect\n           deriving (Eq,Show)\n\n-- parser produced by Happy Version 1.19.8\n\nnewtype HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104 = HappyAbsSyn HappyAny\ntype HappyAny = Happy_GHC_Exts.Any\nhappyIn4 :: t4 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn4 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn4 #-}\nhappyOut4 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t4\nhappyOut4 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut4 #-}\nhappyIn5 :: t5 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn5 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn5 #-}\nhappyOut5 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t5\nhappyOut5 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut5 #-}\nhappyIn6 :: t6 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn6 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn6 #-}\nhappyOut6 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t6\nhappyOut6 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut6 #-}\nhappyIn7 :: t7 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn7 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn7 #-}\nhappyOut7 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t7\nhappyOut7 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut7 #-}\nhappyIn8 :: t8 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn8 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn8 #-}\nhappyOut8 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t8\nhappyOut8 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut8 #-}\nhappyIn9 :: t9 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn9 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn9 #-}\nhappyOut9 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t9\nhappyOut9 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut9 #-}\nhappyIn10 :: t10 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn10 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn10 #-}\nhappyOut10 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t10\nhappyOut10 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut10 #-}\nhappyIn11 :: t11 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn11 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn11 #-}\nhappyOut11 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t11\nhappyOut11 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut11 #-}\nhappyIn12 :: t12 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn12 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn12 #-}\nhappyOut12 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t12\nhappyOut12 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut12 #-}\nhappyIn13 :: t13 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn13 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn13 #-}\nhappyOut13 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t13\nhappyOut13 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut13 #-}\nhappyIn14 :: t14 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn14 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn14 #-}\nhappyOut14 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t14\nhappyOut14 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut14 #-}\nhappyIn15 :: t15 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn15 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn15 #-}\nhappyOut15 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t15\nhappyOut15 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut15 #-}\nhappyIn16 :: t16 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn16 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn16 #-}\nhappyOut16 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t16\nhappyOut16 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut16 #-}\nhappyIn17 :: t17 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn17 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn17 #-}\nhappyOut17 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t17\nhappyOut17 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut17 #-}\nhappyIn18 :: t18 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn18 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn18 #-}\nhappyOut18 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t18\nhappyOut18 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut18 #-}\nhappyIn19 :: t19 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn19 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn19 #-}\nhappyOut19 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t19\nhappyOut19 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut19 #-}\nhappyIn20 :: t20 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn20 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn20 #-}\nhappyOut20 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t20\nhappyOut20 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut20 #-}\nhappyIn21 :: t21 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn21 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn21 #-}\nhappyOut21 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t21\nhappyOut21 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut21 #-}\nhappyIn22 :: t22 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn22 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn22 #-}\nhappyOut22 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t22\nhappyOut22 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut22 #-}\nhappyIn23 :: t23 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn23 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn23 #-}\nhappyOut23 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t23\nhappyOut23 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut23 #-}\nhappyIn24 :: t24 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn24 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn24 #-}\nhappyOut24 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t24\nhappyOut24 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut24 #-}\nhappyIn25 :: t25 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn25 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn25 #-}\nhappyOut25 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t25\nhappyOut25 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut25 #-}\nhappyIn26 :: t26 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn26 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn26 #-}\nhappyOut26 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t26\nhappyOut26 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut26 #-}\nhappyIn27 :: t27 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn27 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn27 #-}\nhappyOut27 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t27\nhappyOut27 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut27 #-}\nhappyIn28 :: t28 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn28 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn28 #-}\nhappyOut28 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t28\nhappyOut28 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut28 #-}\nhappyIn29 :: t29 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn29 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn29 #-}\nhappyOut29 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t29\nhappyOut29 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut29 #-}\nhappyIn30 :: t30 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn30 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn30 #-}\nhappyOut30 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t30\nhappyOut30 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut30 #-}\nhappyIn31 :: t31 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn31 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn31 #-}\nhappyOut31 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t31\nhappyOut31 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut31 #-}\nhappyIn32 :: t32 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn32 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn32 #-}\nhappyOut32 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t32\nhappyOut32 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut32 #-}\nhappyIn33 :: t33 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn33 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn33 #-}\nhappyOut33 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t33\nhappyOut33 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut33 #-}\nhappyIn34 :: t34 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn34 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn34 #-}\nhappyOut34 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t34\nhappyOut34 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut34 #-}\nhappyIn35 :: t35 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn35 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn35 #-}\nhappyOut35 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t35\nhappyOut35 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut35 #-}\nhappyIn36 :: t36 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn36 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn36 #-}\nhappyOut36 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t36\nhappyOut36 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut36 #-}\nhappyIn37 :: t37 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn37 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn37 #-}\nhappyOut37 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t37\nhappyOut37 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut37 #-}\nhappyIn38 :: t38 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn38 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn38 #-}\nhappyOut38 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t38\nhappyOut38 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut38 #-}\nhappyIn39 :: t39 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn39 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn39 #-}\nhappyOut39 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t39\nhappyOut39 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut39 #-}\nhappyIn40 :: t40 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn40 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn40 #-}\nhappyOut40 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t40\nhappyOut40 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut40 #-}\nhappyIn41 :: t41 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn41 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn41 #-}\nhappyOut41 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t41\nhappyOut41 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut41 #-}\nhappyIn42 :: t42 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn42 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn42 #-}\nhappyOut42 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t42\nhappyOut42 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut42 #-}\nhappyIn43 :: t43 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn43 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn43 #-}\nhappyOut43 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t43\nhappyOut43 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut43 #-}\nhappyIn44 :: t44 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn44 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn44 #-}\nhappyOut44 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t44\nhappyOut44 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut44 #-}\nhappyIn45 :: t45 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn45 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn45 #-}\nhappyOut45 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t45\nhappyOut45 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut45 #-}\nhappyIn46 :: t46 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn46 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn46 #-}\nhappyOut46 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t46\nhappyOut46 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut46 #-}\nhappyIn47 :: t47 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn47 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn47 #-}\nhappyOut47 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t47\nhappyOut47 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut47 #-}\nhappyIn48 :: t48 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn48 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn48 #-}\nhappyOut48 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t48\nhappyOut48 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut48 #-}\nhappyIn49 :: t49 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn49 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn49 #-}\nhappyOut49 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t49\nhappyOut49 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut49 #-}\nhappyIn50 :: t50 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn50 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn50 #-}\nhappyOut50 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t50\nhappyOut50 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut50 #-}\nhappyIn51 :: t51 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn51 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn51 #-}\nhappyOut51 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t51\nhappyOut51 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut51 #-}\nhappyIn52 :: t52 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn52 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn52 #-}\nhappyOut52 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t52\nhappyOut52 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut52 #-}\nhappyIn53 :: t53 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn53 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn53 #-}\nhappyOut53 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t53\nhappyOut53 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut53 #-}\nhappyIn54 :: t54 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn54 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn54 #-}\nhappyOut54 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t54\nhappyOut54 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut54 #-}\nhappyIn55 :: t55 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn55 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn55 #-}\nhappyOut55 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t55\nhappyOut55 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut55 #-}\nhappyIn56 :: t56 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn56 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn56 #-}\nhappyOut56 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t56\nhappyOut56 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut56 #-}\nhappyIn57 :: t57 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn57 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn57 #-}\nhappyOut57 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t57\nhappyOut57 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut57 #-}\nhappyIn58 :: t58 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn58 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn58 #-}\nhappyOut58 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t58\nhappyOut58 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut58 #-}\nhappyIn59 :: t59 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn59 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn59 #-}\nhappyOut59 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t59\nhappyOut59 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut59 #-}\nhappyIn60 :: t60 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn60 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn60 #-}\nhappyOut60 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t60\nhappyOut60 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut60 #-}\nhappyIn61 :: t61 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn61 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn61 #-}\nhappyOut61 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t61\nhappyOut61 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut61 #-}\nhappyIn62 :: t62 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn62 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn62 #-}\nhappyOut62 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t62\nhappyOut62 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut62 #-}\nhappyIn63 :: t63 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn63 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn63 #-}\nhappyOut63 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t63\nhappyOut63 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut63 #-}\nhappyIn64 :: t64 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn64 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn64 #-}\nhappyOut64 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t64\nhappyOut64 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut64 #-}\nhappyIn65 :: t65 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn65 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn65 #-}\nhappyOut65 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t65\nhappyOut65 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut65 #-}\nhappyIn66 :: t66 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn66 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn66 #-}\nhappyOut66 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t66\nhappyOut66 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut66 #-}\nhappyIn67 :: t67 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn67 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn67 #-}\nhappyOut67 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t67\nhappyOut67 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut67 #-}\nhappyIn68 :: t68 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn68 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn68 #-}\nhappyOut68 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t68\nhappyOut68 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut68 #-}\nhappyIn69 :: t69 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn69 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn69 #-}\nhappyOut69 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t69\nhappyOut69 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut69 #-}\nhappyIn70 :: t70 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn70 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn70 #-}\nhappyOut70 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t70\nhappyOut70 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut70 #-}\nhappyIn71 :: t71 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn71 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn71 #-}\nhappyOut71 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t71\nhappyOut71 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut71 #-}\nhappyIn72 :: t72 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn72 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn72 #-}\nhappyOut72 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t72\nhappyOut72 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut72 #-}\nhappyIn73 :: t73 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn73 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn73 #-}\nhappyOut73 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t73\nhappyOut73 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut73 #-}\nhappyIn74 :: t74 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn74 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn74 #-}\nhappyOut74 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t74\nhappyOut74 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut74 #-}\nhappyIn75 :: t75 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn75 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn75 #-}\nhappyOut75 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t75\nhappyOut75 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut75 #-}\nhappyIn76 :: t76 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn76 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn76 #-}\nhappyOut76 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t76\nhappyOut76 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut76 #-}\nhappyIn77 :: t77 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn77 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn77 #-}\nhappyOut77 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t77\nhappyOut77 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut77 #-}\nhappyIn78 :: t78 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn78 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn78 #-}\nhappyOut78 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t78\nhappyOut78 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut78 #-}\nhappyIn79 :: t79 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn79 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn79 #-}\nhappyOut79 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t79\nhappyOut79 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut79 #-}\nhappyIn80 :: t80 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn80 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn80 #-}\nhappyOut80 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t80\nhappyOut80 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut80 #-}\nhappyIn81 :: t81 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn81 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn81 #-}\nhappyOut81 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t81\nhappyOut81 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut81 #-}\nhappyIn82 :: t82 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn82 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn82 #-}\nhappyOut82 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t82\nhappyOut82 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut82 #-}\nhappyIn83 :: t83 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn83 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn83 #-}\nhappyOut83 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t83\nhappyOut83 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut83 #-}\nhappyIn84 :: t84 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn84 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn84 #-}\nhappyOut84 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t84\nhappyOut84 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut84 #-}\nhappyIn85 :: t85 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn85 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn85 #-}\nhappyOut85 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t85\nhappyOut85 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut85 #-}\nhappyIn86 :: t86 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn86 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn86 #-}\nhappyOut86 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t86\nhappyOut86 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut86 #-}\nhappyIn87 :: t87 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn87 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn87 #-}\nhappyOut87 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t87\nhappyOut87 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut87 #-}\nhappyIn88 :: t88 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn88 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn88 #-}\nhappyOut88 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t88\nhappyOut88 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut88 #-}\nhappyIn89 :: t89 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn89 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn89 #-}\nhappyOut89 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t89\nhappyOut89 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut89 #-}\nhappyIn90 :: t90 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn90 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn90 #-}\nhappyOut90 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t90\nhappyOut90 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut90 #-}\nhappyIn91 :: t91 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn91 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn91 #-}\nhappyOut91 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t91\nhappyOut91 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut91 #-}\nhappyIn92 :: t92 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn92 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn92 #-}\nhappyOut92 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t92\nhappyOut92 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut92 #-}\nhappyIn93 :: t93 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn93 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn93 #-}\nhappyOut93 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t93\nhappyOut93 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut93 #-}\nhappyIn94 :: t94 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn94 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn94 #-}\nhappyOut94 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t94\nhappyOut94 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut94 #-}\nhappyIn95 :: t95 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn95 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn95 #-}\nhappyOut95 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t95\nhappyOut95 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut95 #-}\nhappyIn96 :: t96 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn96 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn96 #-}\nhappyOut96 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t96\nhappyOut96 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut96 #-}\nhappyIn97 :: t97 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn97 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn97 #-}\nhappyOut97 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t97\nhappyOut97 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut97 #-}\nhappyIn98 :: t98 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn98 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn98 #-}\nhappyOut98 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t98\nhappyOut98 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut98 #-}\nhappyIn99 :: t99 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn99 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn99 #-}\nhappyOut99 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t99\nhappyOut99 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut99 #-}\nhappyIn100 :: t100 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn100 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn100 #-}\nhappyOut100 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t100\nhappyOut100 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut100 #-}\nhappyIn101 :: t101 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn101 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn101 #-}\nhappyOut101 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t101\nhappyOut101 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut101 #-}\nhappyIn102 :: t102 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn102 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn102 #-}\nhappyOut102 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t102\nhappyOut102 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut102 #-}\nhappyIn103 :: t103 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn103 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn103 #-}\nhappyOut103 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t103\nhappyOut103 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut103 #-}\nhappyIn104 :: t104 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyIn104 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyIn104 #-}\nhappyOut104 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t104\nhappyOut104 x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOut104 #-}\nhappyInTok :: (Token) -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104)\nhappyInTok x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyInTok #-}\nhappyOutTok :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> (Token)\nhappyOutTok x = Happy_GHC_Exts.unsafeCoerce# x\n{-# INLINE happyOutTok #-}\n\n\nhappyExpList :: HappyAddr\nhappyExpList = HappyA# \"\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x08\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe4\\x41\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x02\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe4\\x11\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x02\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe4\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x80\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x80\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe2\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x2a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x3a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x4d\\x6a\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe0\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x40\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x04\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\n{-# NOINLINE happyExpListPerState #-}\nhappyExpListPerState st =\n    token_strs_expected\n  where token_strs = [\"error\",\"%dummy\",\"%start_parseCalc\",\"Exp\",\"Rule0\",\"Rule1\",\"Rule2\",\"Rule3\",\"Rule4\",\"Rule5\",\"Rule6\",\"Rule7\",\"Rule8\",\"Rule9\",\"Rule10\",\"Rule11\",\"Rule12\",\"Rule13\",\"Rule14\",\"Rule15\",\"Rule16\",\"Rule17\",\"Rule18\",\"Rule19\",\"Rule20\",\"Rule21\",\"Rule22\",\"Rule23\",\"Rule24\",\"Rule25\",\"Rule26\",\"Rule27\",\"Rule28\",\"Rule29\",\"Rule30\",\"Rule31\",\"Rule32\",\"Rule33\",\"Rule34\",\"Rule35\",\"Rule36\",\"Rule37\",\"Rule38\",\"Rule39\",\"Rule40\",\"Rule41\",\"Rule42\",\"Rule43\",\"Rule44\",\"Rule45\",\"Rule46\",\"Rule47\",\"Rule48\",\"Rule49\",\"Rule50\",\"Rule51\",\"Rule52\",\"Rule53\",\"Rule54\",\"Rule55\",\"Rule56\",\"Rule57\",\"Rule58\",\"Rule59\",\"Rule60\",\"Rule61\",\"Rule62\",\"Rule63\",\"Rule64\",\"Rule65\",\"Rule66\",\"Rule67\",\"Rule68\",\"Rule69\",\"Rule70\",\"Rule71\",\"Rule72\",\"Rule73\",\"Rule74\",\"Rule75\",\"Rule76\",\"Rule77\",\"Rule78\",\"Rule79\",\"Rule80\",\"Rule81\",\"Rule82\",\"Rule83\",\"Rule84\",\"Rule85\",\"Rule86\",\"Rule87\",\"Rule88\",\"Rule89\",\"Rule90\",\"Rule91\",\"Rule92\",\"Rule93\",\"Rule94\",\"Rule95\",\"Rule96\",\"Rule97\",\"Rule98\",\"Rule99\",\"let\",\"in\",\"int\",\"var\",\"'='\",\"'+'\",\"'-'\",\"'*'\",\"'/'\",\"'('\",\"')'\",\"'{'\",\"'}'\",\"'['\",\"']'\",\"%eof\"]\n        bit_start = st * 120\n        bit_end = (st + 1) * 120\n        read_bit = readArrayBit happyExpList\n        bits = map read_bit [bit_start..bit_end - 1]\n        bits_indexed = zip bits [0..119]\n        token_strs_expected = concatMap f bits_indexed\n        f (False, _) = []\n        f (True, nr) = [token_strs !! nr]\n\nhappyActOffsets :: HappyAddr\nhappyActOffsets = HappyA# \"\\x6d\\x06\\x51\\x06\\x59\\x06\\xd5\\x06\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x6d\\x06\\x6d\\x06\\x79\\x06\\x85\\x06\\x9b\\x06\\x5a\\x07\\xcd\\x06\\x5c\\x07\\x21\\x07\\x00\\x00\\x91\\x06\\x91\\x06\\x91\\x06\\x91\\x06\\x63\\x06\\x91\\x06\\x00\\x00\\x00\\x00\\xbf\\x06\\xbf\\x06\\x20\\x07\\x00\\x00\\x91\\x06\\x91\\x06\\xcb\\x06\\x00\\x00\\x91\\x06\\x91\\x06\\x52\\x06\\x00\\x00\\x55\\x06\\x00\\x00\\x49\\x07\\x61\\x07\\xd4\\x06\\x00\\x00\\x55\\x07\\x65\\x07\\x2a\\x07\\x00\\x00\\x51\\x07\\x91\\x06\\x2b\\x07\\x00\\x00\\x5f\\x06\\xd6\\x06\\xdc\\x06\\x00\\x00\\x50\\x06\\x56\\x06\\x58\\x06\\x00\\x00\\x67\\x06\\x00\\x00\\x6f\\x06\\x00\\x00\\x70\\x06\\x00\\x00\\xdd\\x06\\x00\\x00\\xdf\\x06\\x00\\x00\\xe1\\x06\\x00\\x00\\x2c\\x07\\x00\\x00\\x69\\x07\\x2d\\x07\\x00\\x00\\xe3\\x06\\x00\\x00\\xe4\\x06\\x00\\x00\\xe5\\x06\\x00\\x00\\x72\\x06\\x00\\x00\\x75\\x06\\x00\\x00\\x7f\\x06\\x00\\x00\\x87\\x06\\x00\\x00\\x88\\x06\\x00\\x00\\x8a\\x06\\x00\\x00\\xe8\\x06\\x00\\x00\\xea\\x06\\x00\\x00\\xec\\x06\\x00\\x00\\x2e\\x07\\x00\\x00\\x2f\\x07\\x00\\x00\\xf0\\x06\\x00\\x00\\xf1\\x06\\x00\\x00\\xf3\\x06\\x00\\x00\\x8d\\x06\\x00\\x00\\x97\\x06\\x00\\x00\\x9d\\x06\\x00\\x00\\xa2\\x06\\x00\\x00\\xa4\\x06\\x00\\x00\\xa5\\x06\\x00\\x00\\xf5\\x06\\x00\\x00\\xf7\\x06\\x00\\x00\\xf8\\x06\\x00\\x00\\x30\\x07\\x00\\x00\\x31\\x07\\x00\\x00\\xf9\\x06\\x00\\x00\\xfc\\x06\\x00\\x00\\xfe\\x06\\x00\\x00\\xa6\\x06\\x00\\x00\\xa8\\x06\\x00\\x00\\xaa\\x06\\x00\\x00\\xab\\x06\\x00\\x00\\xac\\x06\\x00\\x00\\xad\\x06\\x00\\x00\\x00\\x07\\x00\\x00\\x04\\x07\\x00\\x00\\x05\\x07\\x00\\x00\\x3a\\x07\\x00\\x00\\x3b\\x07\\x00\\x00\\x07\\x07\\x00\\x00\\x09\\x07\\x00\\x00\\x0b\\x07\\x00\\x00\\xaf\\x06\\x00\\x00\\xb3\\x06\\x00\\x00\\xb5\\x06\\x00\\x00\\xba\\x06\\x00\\x00\\x47\\x06\\x00\\x00\\x60\\x06\\x00\\x00\\x0c\\x07\\x00\\x00\\x11\\x07\\x00\\x00\\x13\\x07\\x00\\x00\\x3c\\x07\\x00\\x00\\x3d\\x07\\x00\\x00\\x00\\x00\\x00\\x00\\x0d\\x07\\x00\\x00\\x00\\x00\\x00\\x00\\xbc\\x06\\x00\\x00\\xbd\\x06\\x00\\x00\\x10\\x07\\x00\\x00\\x3e\\x07\\x00\\x00\\x3f\\x07\\x00\\x00\\x12\\x07\\x00\\x00\\xbe\\x06\\x00\\x00\\xc0\\x06\\x00\\x00\\x14\\x07\\x00\\x00\\x40\\x07\\x00\\x00\\x41\\x07\\x00\\x00\\x18\\x07\\x00\\x00\\xc2\\x06\\x00\\x00\\xc3\\x06\\x00\\x00\\x19\\x07\\x00\\x00\\x4a\\x07\\x00\\x00\\x4b\\x07\\x00\\x00\\x15\\x07\\x00\\x00\\xbb\\x06\\x00\\x00\\x00\\x00\\x00\\x00\\x57\\x07\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyGotoOffsets :: HappyAddr\nhappyGotoOffsets = HappyA# \"\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x66\\x00\\xcb\\x00\\x30\\x01\\x95\\x01\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xfa\\x01\\x5f\\x02\\xc4\\x02\\x29\\x03\\x00\\x00\\x8e\\x03\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xf3\\x03\\x58\\x04\\x00\\x00\\x00\\x00\\xbd\\x04\\x22\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x87\\x05\\x00\\x00\\x00\\x00\\xec\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\xec\\x05\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int#\nhappyAdjustOffset off = off\n\nhappyDefActions :: HappyAddr\nhappyDefActions = HappyA# \"\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xf5\\xff\\xf4\\xff\\xf3\\xff\\xf2\\xff\\xf1\\xff\\xf0\\xff\\xef\\xff\\xee\\xff\\xed\\xff\\xec\\xff\\xeb\\xff\\xea\\xff\\xe9\\xff\\xe8\\xff\\xe7\\xff\\xe6\\xff\\xe5\\xff\\xe4\\xff\\xe3\\xff\\xe2\\xff\\xe1\\xff\\xe0\\xff\\xdf\\xff\\xde\\xff\\xdd\\xff\\xdc\\xff\\xdb\\xff\\xda\\xff\\xd9\\xff\\xd8\\xff\\xd7\\xff\\xd6\\xff\\xd5\\xff\\xd4\\xff\\xd3\\xff\\xd2\\xff\\xd1\\xff\\xd0\\xff\\xcf\\xff\\xce\\xff\\xcd\\xff\\xcc\\xff\\xcb\\xff\\xca\\xff\\xc9\\xff\\xc8\\xff\\xc7\\xff\\xc6\\xff\\xc5\\xff\\xc4\\xff\\xc3\\xff\\xc2\\xff\\xc1\\xff\\xc0\\xff\\xbf\\xff\\xbe\\xff\\xbd\\xff\\xbc\\xff\\xbb\\xff\\xba\\xff\\xb9\\xff\\xb8\\xff\\xb7\\xff\\xb6\\xff\\xb5\\xff\\xb4\\xff\\xb3\\xff\\xb2\\xff\\xb1\\xff\\xb0\\xff\\xaf\\xff\\xae\\xff\\xad\\xff\\xac\\xff\\xab\\xff\\xaa\\xff\\xa9\\xff\\xa8\\xff\\xa7\\xff\\xa6\\xff\\xa5\\xff\\xa4\\xff\\xa3\\xff\\xa2\\xff\\xa1\\xff\\xa0\\xff\\x9f\\xff\\x9e\\xff\\x9d\\xff\\x9c\\xff\\x9b\\xff\\x9a\\xff\\x99\\xff\\x98\\xff\\x97\\xff\\x96\\xff\\x95\\xff\\x94\\xff\\x93\\xff\\x92\\xff\\xf7\\xff\\xf6\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xf6\\xff\\x00\\x00\\xf6\\xff\\x00\\x00\\xf8\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xfa\\xff\\xfb\\xff\\xfc\\xff\\xfd\\xff\\x00\\x00\\xf9\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x91\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x69\\xff\\x00\\x00\\x68\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x90\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x7d\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x7c\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x8f\\xff\\x00\\x00\\x00\\x00\\x00\\x00\\x67\\xff\\x00\\x00\\x66\\xff\\x00\\x00\\x55\\xff\\xf7\\xff\\x41\\xff\\x00\\x00\\x8e\\xff\\x00\\x00\\x4b\\xff\\xf7\\xff\\x37\\xff\\x00\\x00\\x7b\\xff\\xfe\\xff\\x00\\x00\\x7a\\xff\\x00\\x00\\x36\\xff\\x00\\x00\\x4a\\xff\\x00\\x00\\x8d\\xff\\x00\\x00\\x40\\xff\\x00\\x00\\x54\\xff\\x00\\x00\\x65\\xff\\x00\\x00\\x64\\xff\\x00\\x00\\x53\\xff\\x00\\x00\\x3f\\xff\\x00\\x00\\x8c\\xff\\x00\\x00\\x49\\xff\\x00\\x00\\x35\\xff\\x00\\x00\\x79\\xff\\x00\\x00\\x78\\xff\\x00\\x00\\x34\\xff\\x00\\x00\\x48\\xff\\x00\\x00\\x8b\\xff\\x00\\x00\\x3e\\xff\\x00\\x00\\x52\\xff\\x00\\x00\\x63\\xff\\x00\\x00\\x62\\xff\\x00\\x00\\x51\\xff\\x00\\x00\\x3d\\xff\\x00\\x00\\x8a\\xff\\x00\\x00\\x47\\xff\\x00\\x00\\x33\\xff\\x00\\x00\\x77\\xff\\x00\\x00\\x76\\xff\\x00\\x00\\x32\\xff\\x00\\x00\\x46\\xff\\x00\\x00\\x89\\xff\\x00\\x00\\x3c\\xff\\x00\\x00\\x50\\xff\\x00\\x00\\x61\\xff\\x00\\x00\\x60\\xff\\x00\\x00\\x4f\\xff\\x00\\x00\\x3b\\xff\\x00\\x00\\x88\\xff\\x00\\x00\\x45\\xff\\x00\\x00\\x31\\xff\\x00\\x00\\x75\\xff\\x00\\x00\\x74\\xff\\x00\\x00\\x30\\xff\\x00\\x00\\x44\\xff\\x00\\x00\\x87\\xff\\x00\\x00\\x3a\\xff\\x00\\x00\\x4e\\xff\\x00\\x00\\x5f\\xff\\x00\\x00\\x5e\\xff\\x00\\x00\\x4d\\xff\\x00\\x00\\x39\\xff\\x00\\x00\\x86\\xff\\x00\\x00\\x43\\xff\\x00\\x00\\x2f\\xff\\x00\\x00\\x73\\xff\\x00\\x00\\x72\\xff\\x2e\\xff\\x42\\xff\\x00\\x00\\x85\\xff\\x38\\xff\\x4c\\xff\\x00\\x00\\x5d\\xff\\x00\\x00\\x5c\\xff\\x00\\x00\\x84\\xff\\x00\\x00\\x71\\xff\\x00\\x00\\x70\\xff\\x00\\x00\\x83\\xff\\x00\\x00\\x5b\\xff\\x00\\x00\\x5a\\xff\\x00\\x00\\x82\\xff\\x00\\x00\\x6f\\xff\\x00\\x00\\x6e\\xff\\x00\\x00\\x81\\xff\\x00\\x00\\x59\\xff\\x00\\x00\\x58\\xff\\x00\\x00\\x80\\xff\\x00\\x00\\x6d\\xff\\x00\\x00\\x6c\\xff\\x00\\x00\\x7f\\xff\\x00\\x00\\x57\\xff\\x56\\xff\\x7e\\xff\\x00\\x00\\x6b\\xff\\x6a\\xff\"#\n\nhappyCheck :: HappyAddr\nhappyCheck = HappyA# \"\\xff\\xff\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x00\\x00\\x01\\x00\\x02\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x01\\x00\\x01\\x00\\x03\\x00\\x04\\x00\\x03\\x00\\x0f\\x00\\x07\\x00\\x03\\x00\\x03\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x04\\x00\\x0e\\x00\\x0f\\x00\\x01\\x00\\x0f\\x00\\x03\\x00\\x04\\x00\\x0f\\x00\\x0f\\x00\\x07\\x00\\x0f\\x00\\x05\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x01\\x00\\x0f\\x00\\x03\\x00\\x04\\x00\\x03\\x00\\x03\\x00\\x07\\x00\\x03\\x00\\x0f\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x01\\x00\\x0e\\x00\\x03\\x00\\x04\\x00\\x0f\\x00\\x0f\\x00\\x07\\x00\\x0f\\x00\\x03\\x00\\x0a\\x00\\x0f\\x00\\x0c\\x00\\x01\\x00\\x0e\\x00\\x03\\x00\\x04\\x00\\x03\\x00\\x03\\x00\\x07\\x00\\x03\\x00\\x0f\\x00\\x0a\\x00\\x03\\x00\\x0c\\x00\\x01\\x00\\x0e\\x00\\x03\\x00\\x04\\x00\\x0f\\x00\\x0f\\x00\\x07\\x00\\x0f\\x00\\x03\\x00\\x0a\\x00\\x0f\\x00\\x0c\\x00\\x03\\x00\\x0e\\x00\\x03\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x03\\x00\\x08\\x00\\x09\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x03\\x00\\x0f\\x00\\x0f\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x10\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x0d\\x00\\x03\\x00\\x03\\x00\\x0d\\x00\\x0d\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0b\\x00\\x0b\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x03\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x03\\x00\\x03\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x02\\x00\\x0b\\x00\\x0b\\x00\\x0b\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x05\\x00\\x0b\\x00\\x05\\x00\\x0b\\x00\\xff\\xff\\x0a\\x00\\xff\\xff\\x0a\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\\xff\"#\n\nhappyTable :: HappyAddr\nhappyTable = HappyA# \"\\x00\\x00\\x03\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x73\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x72\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x70\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x6e\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7d\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7c\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7b\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7a\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x92\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8f\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8e\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8b\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x8a\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\xac\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x7b\\x00\\x04\\x00\\x05\\x00\\x06\\x00\\x07\\x00\\x08\\x00\\x09\\x00\\x0a\\x00\\x0b\\x00\\x0c\\x00\\x0d\\x00\\x0e\\x00\\x0f\\x00\\x10\\x00\\x11\\x00\\x12\\x00\\x13\\x00\\x14\\x00\\x15\\x00\\x16\\x00\\x17\\x00\\x18\\x00\\x19\\x00\\x1a\\x00\\x1b\\x00\\x1c\\x00\\x1d\\x00\\x1e\\x00\\x1f\\x00\\x20\\x00\\x21\\x00\\x22\\x00\\x23\\x00\\x24\\x00\\x25\\x00\\x26\\x00\\x27\\x00\\x28\\x00\\x29\\x00\\x2a\\x00\\x2b\\x00\\x2c\\x00\\x2d\\x00\\x2e\\x00\\x2f\\x00\\x30\\x00\\x31\\x00\\x32\\x00\\x33\\x00\\x34\\x00\\x35\\x00\\x36\\x00\\x37\\x00\\x38\\x00\\x39\\x00\\x3a\\x00\\x3b\\x00\\x3c\\x00\\x3d\\x00\\x3e\\x00\\x3f\\x00\\x40\\x00\\x41\\x00\\x42\\x00\\x43\\x00\\x44\\x00\\x45\\x00\\x46\\x00\\x47\\x00\\x48\\x00\\x49\\x00\\x4a\\x00\\x4b\\x00\\x4c\\x00\\x4d\\x00\\x4e\\x00\\x4f\\x00\\x50\\x00\\x51\\x00\\x52\\x00\\x53\\x00\\x54\\x00\\x55\\x00\\x56\\x00\\x57\\x00\\x58\\x00\\x59\\x00\\x5a\\x00\\x5b\\x00\\x5c\\x00\\x5d\\x00\\x5e\\x00\\x5f\\x00\\x60\\x00\\x61\\x00\\x62\\x00\\x63\\x00\\x64\\x00\\x65\\x00\\x66\\x00\\x67\\x00\\x03\\x00\\x03\\x00\\xa3\\x00\\x6a\\x00\\x89\\x00\\x25\\x01\\x6b\\x00\\x9d\\x00\\xa1\\x00\\x6c\\x00\\x9f\\x00\\x6d\\x00\\x79\\x00\\x6e\\x00\\xa4\\x00\\x03\\x00\\x8a\\x00\\xa9\\x00\\x6a\\x00\\x9e\\x00\\xa2\\x00\\x6b\\x00\\xa0\\x00\\x7a\\x00\\x6c\\x00\\xba\\x00\\x6d\\x00\\xaa\\x00\\x6e\\x00\\x03\\x00\\x24\\x01\\x69\\x00\\x6a\\x00\\xb8\\x00\\xb6\\x00\\x6b\\x00\\xc0\\x00\\xbb\\x00\\x6c\\x00\\xbe\\x00\\x6d\\x00\\x03\\x00\\x6e\\x00\\x69\\x00\\x72\\x00\\xb9\\x00\\xb7\\x00\\x6b\\x00\\xc1\\x00\\xbc\\x00\\x6c\\x00\\xbf\\x00\\x6d\\x00\\x03\\x00\\x6e\\x00\\x69\\x00\\x70\\x00\\xd6\\x00\\xd4\\x00\\x6b\\x00\\xd2\\x00\\xbd\\x00\\x6c\\x00\\xdc\\x00\\x6d\\x00\\x03\\x00\\x6e\\x00\\x69\\x00\\x6a\\x00\\xd7\\x00\\xd5\\x00\\x6b\\x00\\xd3\\x00\\xda\\x00\\x6c\\x00\\xdd\\x00\\x6d\\x00\\x87\\x00\\x6e\\x00\\xd8\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\xf2\\x00\\xdb\\x00\\xf0\\x00\\xee\\x00\\xf8\\x00\\x88\\x00\\xf6\\x00\\xd9\\x00\\xf4\\x00\\x0e\\x01\\x0c\\x01\\x0a\\x01\\xf3\\x00\\x14\\x01\\xf1\\x00\\xef\\x00\\xf9\\x00\\x12\\x01\\xf7\\x00\\x10\\x01\\xf5\\x00\\x0f\\x01\\x0d\\x01\\x0b\\x01\\x26\\x01\\x15\\x01\\x28\\x01\\x32\\x01\\x34\\x01\\x13\\x01\\x3e\\x01\\x11\\x01\\x40\\x01\\x4a\\x01\\x77\\x00\\x78\\x00\\x27\\x01\\x4c\\x01\\x29\\x01\\x33\\x01\\x35\\x01\\x8d\\x00\\x3f\\x01\\x83\\x00\\x41\\x01\\x4b\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x99\\x00\\x8e\\x00\\xa7\\x00\\x84\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\xa5\\x00\\xb4\\x00\\x9a\\x00\\xb2\\x00\\xa8\\x00\\xb0\\x00\\xff\\xff\\xc6\\x00\\xc4\\x00\\xc2\\x00\\xa6\\x00\\xb5\\x00\\xd0\\x00\\xb3\\x00\\xce\\x00\\xb1\\x00\\xcc\\x00\\xc7\\x00\\xc5\\x00\\xc3\\x00\\xe2\\x00\\xe0\\x00\\xd1\\x00\\xde\\x00\\xcf\\x00\\xec\\x00\\xcd\\x00\\xea\\x00\\xe8\\x00\\xfe\\x00\\xe3\\x00\\xe1\\x00\\xfc\\x00\\xdf\\x00\\xfa\\x00\\xed\\x00\\x08\\x01\\xeb\\x00\\xe9\\x00\\xff\\x00\\x06\\x01\\x04\\x01\\xfd\\x00\\x1a\\x01\\xfb\\x00\\x18\\x01\\x09\\x01\\x16\\x01\\x22\\x01\\x2a\\x01\\x07\\x01\\x05\\x01\\x30\\x01\\x1b\\x01\\x36\\x01\\x19\\x01\\x3c\\x01\\x17\\x01\\x23\\x01\\x2b\\x01\\x42\\x01\\x48\\x01\\x31\\x01\\x21\\x01\\x37\\x01\\x20\\x01\\x3d\\x01\\x4d\\x01\\x91\\x00\\x7f\\x00\\x43\\x01\\x49\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x92\\x00\\x80\\x00\\x95\\x00\\xab\\x00\\xae\\x00\\xc8\\x00\\xca\\x00\\xe4\\x00\\xe6\\x00\\x00\\x01\\x96\\x00\\xac\\x00\\xaf\\x00\\xc9\\x00\\xcb\\x00\\xe5\\x00\\xe7\\x00\\x01\\x01\\x02\\x01\\x1c\\x01\\x1e\\x01\\x2c\\x01\\x2e\\x01\\x38\\x01\\x3a\\x01\\x44\\x01\\x03\\x01\\x1d\\x01\\x1f\\x01\\x2d\\x01\\x2f\\x01\\x39\\x01\\x3b\\x01\\x45\\x01\\x46\\x01\\x4e\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x94\\x00\\x9c\\x00\\x47\\x01\\x4f\\x01\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x85\\x00\\x98\\x00\\x81\\x00\\x50\\x01\\x00\\x00\\x86\\x00\\x00\\x00\\x82\\x00\\x75\\x00\\x76\\x00\\x9b\\x00\\x78\\x00\\x75\\x00\\x76\\x00\\x97\\x00\\x78\\x00\\x75\\x00\\x76\\x00\\x77\\x00\\x78\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"#\n\nhappyReduceArr = Happy_Data_Array.array (1, 209) [\n        (1 , happyReduce_1),\n        (2 , happyReduce_2),\n        (3 , happyReduce_3),\n        (4 , happyReduce_4),\n        (5 , happyReduce_5),\n        (6 , happyReduce_6),\n        (7 , happyReduce_7),\n        (8 , happyReduce_8),\n        (9 , happyReduce_9),\n        (10 , happyReduce_10),\n        (11 , happyReduce_11),\n        (12 , happyReduce_12),\n        (13 , happyReduce_13),\n        (14 , happyReduce_14),\n        (15 , happyReduce_15),\n        (16 , happyReduce_16),\n        (17 , happyReduce_17),\n        (18 , happyReduce_18),\n        (19 , happyReduce_19),\n        (20 , happyReduce_20),\n        (21 , happyReduce_21),\n        (22 , happyReduce_22),\n        (23 , happyReduce_23),\n        (24 , happyReduce_24),\n        (25 , happyReduce_25),\n        (26 , happyReduce_26),\n        (27 , happyReduce_27),\n        (28 , happyReduce_28),\n        (29 , happyReduce_29),\n        (30 , happyReduce_30),\n        (31 , happyReduce_31),\n        (32 , happyReduce_32),\n        (33 , happyReduce_33),\n        (34 , happyReduce_34),\n        (35 , happyReduce_35),\n        (36 , happyReduce_36),\n        (37 , happyReduce_37),\n        (38 , happyReduce_38),\n        (39 , happyReduce_39),\n        (40 , happyReduce_40),\n        (41 , happyReduce_41),\n        (42 , happyReduce_42),\n        (43 , happyReduce_43),\n        (44 , happyReduce_44),\n        (45 , happyReduce_45),\n        (46 , happyReduce_46),\n        (47 , happyReduce_47),\n        (48 , happyReduce_48),\n        (49 , happyReduce_49),\n        (50 , happyReduce_50),\n        (51 , happyReduce_51),\n        (52 , happyReduce_52),\n        (53 , happyReduce_53),\n        (54 , happyReduce_54),\n        (55 , happyReduce_55),\n        (56 , happyReduce_56),\n        (57 , happyReduce_57),\n        (58 , happyReduce_58),\n        (59 , happyReduce_59),\n        (60 , happyReduce_60),\n        (61 , happyReduce_61),\n        (62 , happyReduce_62),\n        (63 , happyReduce_63),\n        (64 , happyReduce_64),\n        (65 , happyReduce_65),\n        (66 , happyReduce_66),\n        (67 , happyReduce_67),\n        (68 , happyReduce_68),\n        (69 , happyReduce_69),\n        (70 , happyReduce_70),\n        (71 , happyReduce_71),\n        (72 , happyReduce_72),\n        (73 , happyReduce_73),\n        (74 , happyReduce_74),\n        (75 , happyReduce_75),\n        (76 , happyReduce_76),\n        (77 , happyReduce_77),\n        (78 , happyReduce_78),\n        (79 , happyReduce_79),\n        (80 , happyReduce_80),\n        (81 , happyReduce_81),\n        (82 , happyReduce_82),\n        (83 , happyReduce_83),\n        (84 , happyReduce_84),\n        (85 , happyReduce_85),\n        (86 , happyReduce_86),\n        (87 , happyReduce_87),\n        (88 , happyReduce_88),\n        (89 , happyReduce_89),\n        (90 , happyReduce_90),\n        (91 , happyReduce_91),\n        (92 , happyReduce_92),\n        (93 , happyReduce_93),\n        (94 , happyReduce_94),\n        (95 , happyReduce_95),\n        (96 , happyReduce_96),\n        (97 , happyReduce_97),\n        (98 , happyReduce_98),\n        (99 , happyReduce_99),\n        (100 , happyReduce_100),\n        (101 , happyReduce_101),\n        (102 , happyReduce_102),\n        (103 , happyReduce_103),\n        (104 , happyReduce_104),\n        (105 , happyReduce_105),\n        (106 , happyReduce_106),\n        (107 , happyReduce_107),\n        (108 , happyReduce_108),\n        (109 , happyReduce_109),\n        (110 , happyReduce_110),\n        (111 , happyReduce_111),\n        (112 , happyReduce_112),\n        (113 , happyReduce_113),\n        (114 , happyReduce_114),\n        (115 , happyReduce_115),\n        (116 , happyReduce_116),\n        (117 , happyReduce_117),\n        (118 , happyReduce_118),\n        (119 , happyReduce_119),\n        (120 , happyReduce_120),\n        (121 , happyReduce_121),\n        (122 , happyReduce_122),\n        (123 , happyReduce_123),\n        (124 , happyReduce_124),\n        (125 , happyReduce_125),\n        (126 , happyReduce_126),\n        (127 , happyReduce_127),\n        (128 , happyReduce_128),\n        (129 , happyReduce_129),\n        (130 , happyReduce_130),\n        (131 , happyReduce_131),\n        (132 , happyReduce_132),\n        (133 , happyReduce_133),\n        (134 , happyReduce_134),\n        (135 , happyReduce_135),\n        (136 , happyReduce_136),\n        (137 , happyReduce_137),\n        (138 , happyReduce_138),\n        (139 , happyReduce_139),\n        (140 , happyReduce_140),\n        (141 , happyReduce_141),\n        (142 , happyReduce_142),\n        (143 , happyReduce_143),\n        (144 , happyReduce_144),\n        (145 , happyReduce_145),\n        (146 , happyReduce_146),\n        (147 , happyReduce_147),\n        (148 , happyReduce_148),\n        (149 , happyReduce_149),\n        (150 , happyReduce_150),\n        (151 , happyReduce_151),\n        (152 , happyReduce_152),\n        (153 , happyReduce_153),\n        (154 , happyReduce_154),\n        (155 , happyReduce_155),\n        (156 , happyReduce_156),\n        (157 , happyReduce_157),\n        (158 , happyReduce_158),\n        (159 , happyReduce_159),\n        (160 , happyReduce_160),\n        (161 , happyReduce_161),\n        (162 , happyReduce_162),\n        (163 , happyReduce_163),\n        (164 , happyReduce_164),\n        (165 , happyReduce_165),\n        (166 , happyReduce_166),\n        (167 , happyReduce_167),\n        (168 , happyReduce_168),\n        (169 , happyReduce_169),\n        (170 , happyReduce_170),\n        (171 , happyReduce_171),\n        (172 , happyReduce_172),\n        (173 , happyReduce_173),\n        (174 , happyReduce_174),\n        (175 , happyReduce_175),\n        (176 , happyReduce_176),\n        (177 , happyReduce_177),\n        (178 , happyReduce_178),\n        (179 , happyReduce_179),\n        (180 , happyReduce_180),\n        (181 , happyReduce_181),\n        (182 , happyReduce_182),\n        (183 , happyReduce_183),\n        (184 , happyReduce_184),\n        (185 , happyReduce_185),\n        (186 , happyReduce_186),\n        (187 , happyReduce_187),\n        (188 , happyReduce_188),\n        (189 , happyReduce_189),\n        (190 , happyReduce_190),\n        (191 , happyReduce_191),\n        (192 , happyReduce_192),\n        (193 , happyReduce_193),\n        (194 , happyReduce_194),\n        (195 , happyReduce_195),\n        (196 , happyReduce_196),\n        (197 , happyReduce_197),\n        (198 , happyReduce_198),\n        (199 , happyReduce_199),\n        (200 , happyReduce_200),\n        (201 , happyReduce_201),\n        (202 , happyReduce_202),\n        (203 , happyReduce_203),\n        (204 , happyReduce_204),\n        (205 , happyReduce_205),\n        (206 , happyReduce_206),\n        (207 , happyReduce_207),\n        (208 , happyReduce_208),\n        (209 , happyReduce_209)\n        ]\n\nhappy_n_terms = 17 :: Int\nhappy_n_nonterms = 101 :: Int\n\nhappyReduce_1 = happyReduce 6# 0# happyReduction_1\nhappyReduction_1 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOutTok happy_x_2 of { (TokenSym happy_var_2) ->\n        case happyOut4 happy_x_4 of { happy_var_4 ->\n        case happyOut4 happy_x_6 of { happy_var_6 ->\n        happyIn4\n                 (Let happy_var_2 happy_var_4 happy_var_6\n        ) `HappyStk` happyRest}}}\n\nhappyReduce_2 = happySpecReduce_3  0# happyReduction_2\nhappyReduction_2 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Plus happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_3 = happySpecReduce_3  0# happyReduction_3\nhappyReduction_3 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Minus happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_4 = happySpecReduce_3  0# happyReduction_4\nhappyReduction_4 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Times happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_5 = happySpecReduce_3  0# happyReduction_5\nhappyReduction_5 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_1 of { happy_var_1 ->\n        case happyOut4 happy_x_3 of { happy_var_3 ->\n        happyIn4\n                 (Div happy_var_1 happy_var_3\n        )}}\n\nhappyReduce_6 = happySpecReduce_3  0# happyReduction_6\nhappyReduction_6 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn4\n                 (happy_var_2\n        )}\n\nhappyReduce_7 = happySpecReduce_2  0# happyReduction_7\nhappyReduction_7 happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn4\n                 (Negate happy_var_2\n        )}\n\nhappyReduce_8 = happySpecReduce_1  0# happyReduction_8\nhappyReduction_8 happy_x_1\n         =  case happyOutTok happy_x_1 of { (TokenInt happy_var_1) ->\n        happyIn4\n                 (Int happy_var_1\n        )}\n\nhappyReduce_9 = happySpecReduce_1  0# happyReduction_9\nhappyReduction_9 happy_x_1\n         =  case happyOutTok happy_x_1 of { (TokenSym happy_var_1) ->\n        happyIn4\n                 (Var happy_var_1\n        )}\n\nhappyReduce_10 = happySpecReduce_1  0# happyReduction_10\nhappyReduction_10 happy_x_1\n         =  case happyOut5 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_11 = happySpecReduce_1  0# happyReduction_11\nhappyReduction_11 happy_x_1\n         =  case happyOut6 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_12 = happySpecReduce_1  0# happyReduction_12\nhappyReduction_12 happy_x_1\n         =  case happyOut7 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_13 = happySpecReduce_1  0# happyReduction_13\nhappyReduction_13 happy_x_1\n         =  case happyOut8 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_14 = happySpecReduce_1  0# happyReduction_14\nhappyReduction_14 happy_x_1\n         =  case happyOut9 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_15 = happySpecReduce_1  0# happyReduction_15\nhappyReduction_15 happy_x_1\n         =  case happyOut10 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_16 = happySpecReduce_1  0# happyReduction_16\nhappyReduction_16 happy_x_1\n         =  case happyOut11 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_17 = happySpecReduce_1  0# happyReduction_17\nhappyReduction_17 happy_x_1\n         =  case happyOut12 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_18 = happySpecReduce_1  0# happyReduction_18\nhappyReduction_18 happy_x_1\n         =  case happyOut13 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_19 = happySpecReduce_1  0# happyReduction_19\nhappyReduction_19 happy_x_1\n         =  case happyOut14 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_20 = happySpecReduce_1  0# happyReduction_20\nhappyReduction_20 happy_x_1\n         =  case happyOut15 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_21 = happySpecReduce_1  0# happyReduction_21\nhappyReduction_21 happy_x_1\n         =  case happyOut16 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_22 = happySpecReduce_1  0# happyReduction_22\nhappyReduction_22 happy_x_1\n         =  case happyOut17 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_23 = happySpecReduce_1  0# happyReduction_23\nhappyReduction_23 happy_x_1\n         =  case happyOut18 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_24 = happySpecReduce_1  0# happyReduction_24\nhappyReduction_24 happy_x_1\n         =  case happyOut19 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_25 = happySpecReduce_1  0# happyReduction_25\nhappyReduction_25 happy_x_1\n         =  case happyOut20 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_26 = happySpecReduce_1  0# happyReduction_26\nhappyReduction_26 happy_x_1\n         =  case happyOut21 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_27 = happySpecReduce_1  0# happyReduction_27\nhappyReduction_27 happy_x_1\n         =  case happyOut22 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_28 = happySpecReduce_1  0# happyReduction_28\nhappyReduction_28 happy_x_1\n         =  case happyOut23 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_29 = happySpecReduce_1  0# happyReduction_29\nhappyReduction_29 happy_x_1\n         =  case happyOut24 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_30 = happySpecReduce_1  0# happyReduction_30\nhappyReduction_30 happy_x_1\n         =  case happyOut25 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_31 = happySpecReduce_1  0# happyReduction_31\nhappyReduction_31 happy_x_1\n         =  case happyOut26 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_32 = happySpecReduce_1  0# happyReduction_32\nhappyReduction_32 happy_x_1\n         =  case happyOut27 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_33 = happySpecReduce_1  0# happyReduction_33\nhappyReduction_33 happy_x_1\n         =  case happyOut28 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_34 = happySpecReduce_1  0# happyReduction_34\nhappyReduction_34 happy_x_1\n         =  case happyOut29 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_35 = happySpecReduce_1  0# happyReduction_35\nhappyReduction_35 happy_x_1\n         =  case happyOut30 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_36 = happySpecReduce_1  0# happyReduction_36\nhappyReduction_36 happy_x_1\n         =  case happyOut31 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_37 = happySpecReduce_1  0# happyReduction_37\nhappyReduction_37 happy_x_1\n         =  case happyOut32 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_38 = happySpecReduce_1  0# happyReduction_38\nhappyReduction_38 happy_x_1\n         =  case happyOut33 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_39 = happySpecReduce_1  0# happyReduction_39\nhappyReduction_39 happy_x_1\n         =  case happyOut34 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_40 = happySpecReduce_1  0# happyReduction_40\nhappyReduction_40 happy_x_1\n         =  case happyOut35 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_41 = happySpecReduce_1  0# happyReduction_41\nhappyReduction_41 happy_x_1\n         =  case happyOut36 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_42 = happySpecReduce_1  0# happyReduction_42\nhappyReduction_42 happy_x_1\n         =  case happyOut37 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_43 = happySpecReduce_1  0# happyReduction_43\nhappyReduction_43 happy_x_1\n         =  case happyOut38 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_44 = happySpecReduce_1  0# happyReduction_44\nhappyReduction_44 happy_x_1\n         =  case happyOut39 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_45 = happySpecReduce_1  0# happyReduction_45\nhappyReduction_45 happy_x_1\n         =  case happyOut40 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_46 = happySpecReduce_1  0# happyReduction_46\nhappyReduction_46 happy_x_1\n         =  case happyOut41 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_47 = happySpecReduce_1  0# happyReduction_47\nhappyReduction_47 happy_x_1\n         =  case happyOut42 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_48 = happySpecReduce_1  0# happyReduction_48\nhappyReduction_48 happy_x_1\n         =  case happyOut43 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_49 = happySpecReduce_1  0# happyReduction_49\nhappyReduction_49 happy_x_1\n         =  case happyOut44 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_50 = happySpecReduce_1  0# happyReduction_50\nhappyReduction_50 happy_x_1\n         =  case happyOut45 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_51 = happySpecReduce_1  0# happyReduction_51\nhappyReduction_51 happy_x_1\n         =  case happyOut46 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_52 = happySpecReduce_1  0# happyReduction_52\nhappyReduction_52 happy_x_1\n         =  case happyOut47 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_53 = happySpecReduce_1  0# happyReduction_53\nhappyReduction_53 happy_x_1\n         =  case happyOut48 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_54 = happySpecReduce_1  0# happyReduction_54\nhappyReduction_54 happy_x_1\n         =  case happyOut49 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_55 = happySpecReduce_1  0# happyReduction_55\nhappyReduction_55 happy_x_1\n         =  case happyOut50 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_56 = happySpecReduce_1  0# happyReduction_56\nhappyReduction_56 happy_x_1\n         =  case happyOut51 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_57 = happySpecReduce_1  0# happyReduction_57\nhappyReduction_57 happy_x_1\n         =  case happyOut52 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_58 = happySpecReduce_1  0# happyReduction_58\nhappyReduction_58 happy_x_1\n         =  case happyOut53 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_59 = happySpecReduce_1  0# happyReduction_59\nhappyReduction_59 happy_x_1\n         =  case happyOut54 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_60 = happySpecReduce_1  0# happyReduction_60\nhappyReduction_60 happy_x_1\n         =  case happyOut55 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_61 = happySpecReduce_1  0# happyReduction_61\nhappyReduction_61 happy_x_1\n         =  case happyOut56 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_62 = happySpecReduce_1  0# happyReduction_62\nhappyReduction_62 happy_x_1\n         =  case happyOut57 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_63 = happySpecReduce_1  0# happyReduction_63\nhappyReduction_63 happy_x_1\n         =  case happyOut58 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_64 = happySpecReduce_1  0# happyReduction_64\nhappyReduction_64 happy_x_1\n         =  case happyOut59 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_65 = happySpecReduce_1  0# happyReduction_65\nhappyReduction_65 happy_x_1\n         =  case happyOut60 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_66 = happySpecReduce_1  0# happyReduction_66\nhappyReduction_66 happy_x_1\n         =  case happyOut61 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_67 = happySpecReduce_1  0# happyReduction_67\nhappyReduction_67 happy_x_1\n         =  case happyOut62 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_68 = happySpecReduce_1  0# happyReduction_68\nhappyReduction_68 happy_x_1\n         =  case happyOut63 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_69 = happySpecReduce_1  0# happyReduction_69\nhappyReduction_69 happy_x_1\n         =  case happyOut64 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_70 = happySpecReduce_1  0# happyReduction_70\nhappyReduction_70 happy_x_1\n         =  case happyOut65 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_71 = happySpecReduce_1  0# happyReduction_71\nhappyReduction_71 happy_x_1\n         =  case happyOut66 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_72 = happySpecReduce_1  0# happyReduction_72\nhappyReduction_72 happy_x_1\n         =  case happyOut67 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_73 = happySpecReduce_1  0# happyReduction_73\nhappyReduction_73 happy_x_1\n         =  case happyOut68 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_74 = happySpecReduce_1  0# happyReduction_74\nhappyReduction_74 happy_x_1\n         =  case happyOut69 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_75 = happySpecReduce_1  0# happyReduction_75\nhappyReduction_75 happy_x_1\n         =  case happyOut70 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_76 = happySpecReduce_1  0# happyReduction_76\nhappyReduction_76 happy_x_1\n         =  case happyOut71 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_77 = happySpecReduce_1  0# happyReduction_77\nhappyReduction_77 happy_x_1\n         =  case happyOut72 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_78 = happySpecReduce_1  0# happyReduction_78\nhappyReduction_78 happy_x_1\n         =  case happyOut73 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_79 = happySpecReduce_1  0# happyReduction_79\nhappyReduction_79 happy_x_1\n         =  case happyOut74 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_80 = happySpecReduce_1  0# happyReduction_80\nhappyReduction_80 happy_x_1\n         =  case happyOut75 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_81 = happySpecReduce_1  0# happyReduction_81\nhappyReduction_81 happy_x_1\n         =  case happyOut76 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_82 = happySpecReduce_1  0# happyReduction_82\nhappyReduction_82 happy_x_1\n         =  case happyOut77 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_83 = happySpecReduce_1  0# happyReduction_83\nhappyReduction_83 happy_x_1\n         =  case happyOut78 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_84 = happySpecReduce_1  0# happyReduction_84\nhappyReduction_84 happy_x_1\n         =  case happyOut79 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_85 = happySpecReduce_1  0# happyReduction_85\nhappyReduction_85 happy_x_1\n         =  case happyOut80 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_86 = happySpecReduce_1  0# happyReduction_86\nhappyReduction_86 happy_x_1\n         =  case happyOut81 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_87 = happySpecReduce_1  0# happyReduction_87\nhappyReduction_87 happy_x_1\n         =  case happyOut82 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_88 = happySpecReduce_1  0# happyReduction_88\nhappyReduction_88 happy_x_1\n         =  case happyOut83 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_89 = happySpecReduce_1  0# happyReduction_89\nhappyReduction_89 happy_x_1\n         =  case happyOut84 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_90 = happySpecReduce_1  0# happyReduction_90\nhappyReduction_90 happy_x_1\n         =  case happyOut85 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_91 = happySpecReduce_1  0# happyReduction_91\nhappyReduction_91 happy_x_1\n         =  case happyOut86 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_92 = happySpecReduce_1  0# happyReduction_92\nhappyReduction_92 happy_x_1\n         =  case happyOut87 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_93 = happySpecReduce_1  0# happyReduction_93\nhappyReduction_93 happy_x_1\n         =  case happyOut88 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_94 = happySpecReduce_1  0# happyReduction_94\nhappyReduction_94 happy_x_1\n         =  case happyOut89 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_95 = happySpecReduce_1  0# happyReduction_95\nhappyReduction_95 happy_x_1\n         =  case happyOut90 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_96 = happySpecReduce_1  0# happyReduction_96\nhappyReduction_96 happy_x_1\n         =  case happyOut91 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_97 = happySpecReduce_1  0# happyReduction_97\nhappyReduction_97 happy_x_1\n         =  case happyOut92 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_98 = happySpecReduce_1  0# happyReduction_98\nhappyReduction_98 happy_x_1\n         =  case happyOut93 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_99 = happySpecReduce_1  0# happyReduction_99\nhappyReduction_99 happy_x_1\n         =  case happyOut94 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_100 = happySpecReduce_1  0# happyReduction_100\nhappyReduction_100 happy_x_1\n         =  case happyOut95 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_101 = happySpecReduce_1  0# happyReduction_101\nhappyReduction_101 happy_x_1\n         =  case happyOut96 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_102 = happySpecReduce_1  0# happyReduction_102\nhappyReduction_102 happy_x_1\n         =  case happyOut97 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_103 = happySpecReduce_1  0# happyReduction_103\nhappyReduction_103 happy_x_1\n         =  case happyOut98 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_104 = happySpecReduce_1  0# happyReduction_104\nhappyReduction_104 happy_x_1\n         =  case happyOut99 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_105 = happySpecReduce_1  0# happyReduction_105\nhappyReduction_105 happy_x_1\n         =  case happyOut100 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_106 = happySpecReduce_1  0# happyReduction_106\nhappyReduction_106 happy_x_1\n         =  case happyOut101 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_107 = happySpecReduce_1  0# happyReduction_107\nhappyReduction_107 happy_x_1\n         =  case happyOut102 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_108 = happySpecReduce_1  0# happyReduction_108\nhappyReduction_108 happy_x_1\n         =  case happyOut103 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_109 = happySpecReduce_1  0# happyReduction_109\nhappyReduction_109 happy_x_1\n         =  case happyOut104 happy_x_1 of { happy_var_1 ->\n        happyIn4\n                 (happy_var_1\n        )}\n\nhappyReduce_110 = happySpecReduce_3  1# happyReduction_110\nhappyReduction_110 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn5\n                 (Dummy happy_var_2\n        )}\n\nhappyReduce_111 = happyReduce 4# 2# happyReduction_111\nhappyReduction_111 (happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn6\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_112 = happyReduce 5# 3# happyReduction_112\nhappyReduction_112 (happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn7\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_113 = happyReduce 6# 4# happyReduction_113\nhappyReduction_113 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn8\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_114 = happyReduce 7# 5# happyReduction_114\nhappyReduction_114 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn9\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_115 = happyReduce 8# 6# happyReduction_115\nhappyReduction_115 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn10\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_116 = happyReduce 9# 7# happyReduction_116\nhappyReduction_116 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn11\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_117 = happyReduce 10# 8# happyReduction_117\nhappyReduction_117 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn12\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_118 = happyReduce 11# 9# happyReduction_118\nhappyReduction_118 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn13\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_119 = happyReduce 12# 10# happyReduction_119\nhappyReduction_119 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn14\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_120 = happyReduce 13# 11# happyReduction_120\nhappyReduction_120 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn15\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_121 = happyReduce 14# 12# happyReduction_121\nhappyReduction_121 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn16\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_122 = happyReduce 15# 13# happyReduction_122\nhappyReduction_122 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn17\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_123 = happyReduce 16# 14# happyReduction_123\nhappyReduction_123 (happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn18\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_124 = happyReduce 17# 15# happyReduction_124\nhappyReduction_124 (happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn19\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_125 = happyReduce 18# 16# happyReduction_125\nhappyReduction_125 (happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn20\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_126 = happyReduce 19# 17# happyReduction_126\nhappyReduction_126 (happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn21\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_127 = happyReduce 20# 18# happyReduction_127\nhappyReduction_127 (happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn22\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_128 = happyReduce 21# 19# happyReduction_128\nhappyReduction_128 (happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn23\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_129 = happyReduce 22# 20# happyReduction_129\nhappyReduction_129 (happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn24\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_130 = happyReduce 4# 21# happyReduction_130\nhappyReduction_130 (happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn25\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_131 = happyReduce 5# 22# happyReduction_131\nhappyReduction_131 (happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn26\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_132 = happyReduce 6# 23# happyReduction_132\nhappyReduction_132 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn27\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_133 = happyReduce 7# 24# happyReduction_133\nhappyReduction_133 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn28\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_134 = happyReduce 8# 25# happyReduction_134\nhappyReduction_134 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn29\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_135 = happyReduce 9# 26# happyReduction_135\nhappyReduction_135 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn30\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_136 = happyReduce 10# 27# happyReduction_136\nhappyReduction_136 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn31\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_137 = happyReduce 11# 28# happyReduction_137\nhappyReduction_137 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn32\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_138 = happyReduce 12# 29# happyReduction_138\nhappyReduction_138 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn33\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_139 = happyReduce 13# 30# happyReduction_139\nhappyReduction_139 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn34\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_140 = happyReduce 14# 31# happyReduction_140\nhappyReduction_140 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn35\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_141 = happyReduce 15# 32# happyReduction_141\nhappyReduction_141 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn36\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_142 = happyReduce 16# 33# happyReduction_142\nhappyReduction_142 (happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn37\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_143 = happyReduce 17# 34# happyReduction_143\nhappyReduction_143 (happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn38\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_144 = happyReduce 18# 35# happyReduction_144\nhappyReduction_144 (happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn39\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_145 = happyReduce 19# 36# happyReduction_145\nhappyReduction_145 (happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn40\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_146 = happyReduce 20# 37# happyReduction_146\nhappyReduction_146 (happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn41\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_147 = happyReduce 21# 38# happyReduction_147\nhappyReduction_147 (happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn42\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_148 = happyReduce 22# 39# happyReduction_148\nhappyReduction_148 (happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn43\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_149 = happyReduce 23# 40# happyReduction_149\nhappyReduction_149 (happy_x_23 `HappyStk`\n        happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn44\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_150 = happySpecReduce_3  41# happyReduction_150\nhappyReduction_150 happy_x_3\n        happy_x_2\n        happy_x_1\n         =  case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn45\n                 (Dummy happy_var_2\n        )}\n\nhappyReduce_151 = happyReduce 4# 42# happyReduction_151\nhappyReduction_151 (happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn46\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_152 = happyReduce 5# 43# happyReduction_152\nhappyReduction_152 (happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn47\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_153 = happyReduce 6# 44# happyReduction_153\nhappyReduction_153 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn48\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_154 = happyReduce 7# 45# happyReduction_154\nhappyReduction_154 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn49\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_155 = happyReduce 8# 46# happyReduction_155\nhappyReduction_155 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn50\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_156 = happyReduce 9# 47# happyReduction_156\nhappyReduction_156 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn51\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_157 = happyReduce 10# 48# happyReduction_157\nhappyReduction_157 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn52\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_158 = happyReduce 11# 49# happyReduction_158\nhappyReduction_158 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn53\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_159 = happyReduce 12# 50# happyReduction_159\nhappyReduction_159 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn54\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_160 = happyReduce 13# 51# happyReduction_160\nhappyReduction_160 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn55\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_161 = happyReduce 14# 52# happyReduction_161\nhappyReduction_161 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn56\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_162 = happyReduce 15# 53# happyReduction_162\nhappyReduction_162 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn57\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_163 = happyReduce 16# 54# happyReduction_163\nhappyReduction_163 (happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn58\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_164 = happyReduce 17# 55# happyReduction_164\nhappyReduction_164 (happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn59\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_165 = happyReduce 18# 56# happyReduction_165\nhappyReduction_165 (happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn60\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_166 = happyReduce 19# 57# happyReduction_166\nhappyReduction_166 (happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn61\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_167 = happyReduce 20# 58# happyReduction_167\nhappyReduction_167 (happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn62\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_168 = happyReduce 21# 59# happyReduction_168\nhappyReduction_168 (happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn63\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_169 = happyReduce 22# 60# happyReduction_169\nhappyReduction_169 (happy_x_22 `HappyStk`\n        happy_x_21 `HappyStk`\n        happy_x_20 `HappyStk`\n        happy_x_19 `HappyStk`\n        happy_x_18 `HappyStk`\n        happy_x_17 `HappyStk`\n        happy_x_16 `HappyStk`\n        happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_2 of { happy_var_2 ->\n        happyIn64\n                 (Dummy happy_var_2\n        ) `HappyStk` happyRest}\n\nhappyReduce_170 = happyReduce 6# 61# happyReduction_170\nhappyReduction_170 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn65\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_171 = happyReduce 7# 62# happyReduction_171\nhappyReduction_171 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn66\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_172 = happyReduce 8# 63# happyReduction_172\nhappyReduction_172 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn67\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_173 = happyReduce 9# 64# happyReduction_173\nhappyReduction_173 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn68\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_174 = happyReduce 10# 65# happyReduction_174\nhappyReduction_174 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn69\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_175 = happyReduce 11# 66# happyReduction_175\nhappyReduction_175 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn70\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_176 = happyReduce 12# 67# happyReduction_176\nhappyReduction_176 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn71\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_177 = happyReduce 13# 68# happyReduction_177\nhappyReduction_177 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn72\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_178 = happyReduce 14# 69# happyReduction_178\nhappyReduction_178 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn73\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_179 = happyReduce 15# 70# happyReduction_179\nhappyReduction_179 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn74\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_180 = happyReduce 6# 71# happyReduction_180\nhappyReduction_180 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn75\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_181 = happyReduce 7# 72# happyReduction_181\nhappyReduction_181 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn76\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_182 = happyReduce 8# 73# happyReduction_182\nhappyReduction_182 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn77\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_183 = happyReduce 9# 74# happyReduction_183\nhappyReduction_183 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn78\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_184 = happyReduce 10# 75# happyReduction_184\nhappyReduction_184 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn79\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_185 = happyReduce 11# 76# happyReduction_185\nhappyReduction_185 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn80\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_186 = happyReduce 12# 77# happyReduction_186\nhappyReduction_186 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn81\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_187 = happyReduce 13# 78# happyReduction_187\nhappyReduction_187 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn82\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_188 = happyReduce 14# 79# happyReduction_188\nhappyReduction_188 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn83\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_189 = happyReduce 15# 80# happyReduction_189\nhappyReduction_189 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn84\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_190 = happyReduce 6# 81# happyReduction_190\nhappyReduction_190 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn85\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_191 = happyReduce 7# 82# happyReduction_191\nhappyReduction_191 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn86\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_192 = happyReduce 8# 83# happyReduction_192\nhappyReduction_192 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn87\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_193 = happyReduce 9# 84# happyReduction_193\nhappyReduction_193 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn88\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_194 = happyReduce 10# 85# happyReduction_194\nhappyReduction_194 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn89\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_195 = happyReduce 11# 86# happyReduction_195\nhappyReduction_195 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn90\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_196 = happyReduce 12# 87# happyReduction_196\nhappyReduction_196 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn91\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_197 = happyReduce 13# 88# happyReduction_197\nhappyReduction_197 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn92\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_198 = happyReduce 14# 89# happyReduction_198\nhappyReduction_198 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn93\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_199 = happyReduce 15# 90# happyReduction_199\nhappyReduction_199 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn94\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_200 = happyReduce 6# 91# happyReduction_200\nhappyReduction_200 (happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn95\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_201 = happyReduce 7# 92# happyReduction_201\nhappyReduction_201 (happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn96\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_202 = happyReduce 8# 93# happyReduction_202\nhappyReduction_202 (happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn97\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_203 = happyReduce 9# 94# happyReduction_203\nhappyReduction_203 (happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn98\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_204 = happyReduce 10# 95# happyReduction_204\nhappyReduction_204 (happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn99\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_205 = happyReduce 11# 96# happyReduction_205\nhappyReduction_205 (happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn100\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_206 = happyReduce 12# 97# happyReduction_206\nhappyReduction_206 (happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn101\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_207 = happyReduce 13# 98# happyReduction_207\nhappyReduction_207 (happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn102\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_208 = happyReduce 14# 99# happyReduction_208\nhappyReduction_208 (happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn103\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyReduce_209 = happyReduce 15# 100# happyReduction_209\nhappyReduction_209 (happy_x_15 `HappyStk`\n        happy_x_14 `HappyStk`\n        happy_x_13 `HappyStk`\n        happy_x_12 `HappyStk`\n        happy_x_11 `HappyStk`\n        happy_x_10 `HappyStk`\n        happy_x_9 `HappyStk`\n        happy_x_8 `HappyStk`\n        happy_x_7 `HappyStk`\n        happy_x_6 `HappyStk`\n        happy_x_5 `HappyStk`\n        happy_x_4 `HappyStk`\n        happy_x_3 `HappyStk`\n        happy_x_2 `HappyStk`\n        happy_x_1 `HappyStk`\n        happyRest)\n         = case happyOut4 happy_x_4 of { happy_var_4 ->\n        happyIn104\n                 (Dummy happy_var_4\n        ) `HappyStk` happyRest}\n\nhappyNewToken action sts stk [] =\n        happyDoAction 16# notHappyAtAll action sts stk []\n\nhappyNewToken action sts stk (tk:tks) =\n        let cont i = happyDoAction i tk action sts stk tks in\n        case tk of {\n        TokenLet -> cont 1#;\n        TokenIn -> cont 2#;\n        TokenInt happy_dollar_dollar -> cont 3#;\n        TokenSym happy_dollar_dollar -> cont 4#;\n        TokenEq -> cont 5#;\n        TokenPlus -> cont 6#;\n        TokenMinus -> cont 7#;\n        TokenTimes -> cont 8#;\n        TokenDiv -> cont 9#;\n        TokenLParen -> cont 10#;\n        TokenRParen -> cont 11#;\n        TokenLCurl -> cont 12#;\n        TokenRCurl -> cont 13#;\n        TokenLRect -> cont 14#;\n        TokenRRect -> cont 15#;\n        _ -> happyError' ((tk:tks), [])\n        }\n\nhappyError_ explist 16# tk tks = happyError' (tks, explist)\nhappyError_ explist _ tk tks = happyError' ((tk:tks), explist)\n\nnewtype HappyIdentity a = HappyIdentity a\nhappyIdentity = HappyIdentity\nhappyRunIdentity (HappyIdentity a) = a\n\ninstance Functor HappyIdentity where\n    fmap f (HappyIdentity a) = HappyIdentity (f a)\n\ninstance Applicative HappyIdentity where\n    pure  = HappyIdentity\n    (<*>) = ap\ninstance Monad HappyIdentity where\n    return = pure\n    (HappyIdentity p) >>= q = q p\n\nhappyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b\nhappyThen = (>>=)\nhappyReturn :: () => a -> HappyIdentity a\nhappyReturn = (return)\nhappyThen1 m k tks = (>>=) m (\\a -> k a tks)\nhappyReturn1 :: () => a -> b -> HappyIdentity a\nhappyReturn1 = \\a tks -> (return) a\nhappyError' :: () => ([(Token)], [String]) -> HappyIdentity a\nhappyError' = HappyIdentity . (\\(tokens, _) -> parseError tokens)\nparseCalc tks = happyRunIdentity happySomeParser where\n happySomeParser = happyThen (happyParse 0# tks) (\\x -> happyReturn (happyOut4 x))\n\nhappySeq = happyDontSeq\n\n\nparseError :: [Token] -> a\nparseError _ = error \"Parse error\"\n\ndata Exp = Let String Exp Exp\n         | Plus Exp Exp\n         | Minus Exp Exp\n         | Times Exp Exp\n         | Div Exp Exp\n         | Negate Exp\n         | Brack Exp\n         | Int Int\n         | Var String\n         | Dummy Exp\n         deriving Show\n\ndata Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList\n\ninfixr 9 `HappyStk`\ndata HappyStk a = HappyStk a (HappyStk a)\n\n-----------------------------------------------------------------------------\n-- starting the parse\n\nhappyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll\n\n-----------------------------------------------------------------------------\n-- Accepting the parse\n\n-- If the current token is 0#, it means we've just accepted a partial\n-- parse (a %partial parser).  We must ignore the saved token on the top of\n-- the stack in this case.\nhappyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =\n        happyReturn1 ans\nhappyAccept j tk st sts (HappyStk ans _) =\n        (happyTcHack j (happyTcHack st)) (happyReturn1 ans)\n\n-----------------------------------------------------------------------------\n-- Arrays only: do the next action\n\n\nhappyDoAction i tk st\n        = {- nothing -}\n          case action of\n                0#           -> {- nothing -}\n                                     happyFail (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Int)) i tk st\n                -1#          -> {- nothing -}\n                                     happyAccept i tk st\n                n | ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#))) :: Bool) -> {- nothing -}\n\n                                                   (happyReduceArr Happy_Data_Array.! rule) i tk st\n                                                   where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))\n                n                 -> {- nothing -}\n\n\n                                     happyShift new_state i tk st\n                                     where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))\n   where off    = happyAdjustOffset (indexShortOffAddr happyActOffsets st)\n         off_i  = (off Happy_GHC_Exts.+#  i)\n         check  = if ((Happy_GHC_Exts.tagToEnum# (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))) :: Bool)\n                  then ((Happy_GHC_Exts.tagToEnum# (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==#  i)) :: Bool)\n                  else False\n         action\n          | check     = indexShortOffAddr happyTable off_i\n          | otherwise = indexShortOffAddr happyDefActions st\n\nindexShortOffAddr (HappyA# arr) off =\n        Happy_GHC_Exts.narrow16Int# i\n  where\n        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)\n        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))\n        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))\n        off' = off Happy_GHC_Exts.*# 2#\n\n{-# INLINE happyLt #-}\nhappyLt x y = ((Happy_GHC_Exts.tagToEnum# (x Happy_GHC_Exts.<# y)) :: Bool)\n\nreadArrayBit arr bit =\n    Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `mod` 16)\n  where unbox_int (Happy_GHC_Exts.I# x) = x\n\ndata HappyAddr = HappyA# Happy_GHC_Exts.Addr#\n\n-----------------------------------------------------------------------------\n-- Shifting a token\n\nhappyShift new_state 0# tk st sts stk@(x `HappyStk` _) =\n     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in\n--     trace \"shifting the error token\" $\n     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)\n\nhappyShift new_state i tk st sts stk =\n     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)\n\n-- happyReduce is specialised for the common cases.\n\nhappySpecReduce_0 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_0 nt fn j tk st@((action)) sts stk\n     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)\n\nhappySpecReduce_1 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')\n     = let r = fn v1 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_2 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')\n     = let r = fn v1 v2 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_3 i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')\n     = let r = fn v1 v2 v3 in\n       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))\n\nhappyReduce k i fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappyReduce k nt fn j tk st sts stk\n     = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of\n         sts1@((HappyCons (st1@(action)) (_))) ->\n                let r = fn stk in  -- it doesn't hurt to always seq here...\n                happyDoSeq r (happyGoto nt j tk st1 sts1 r)\n\nhappyMonadReduce k nt fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappyMonadReduce k nt fn j tk st sts stk =\n      case happyDrop k (HappyCons (st) (sts)) of\n        sts1@((HappyCons (st1@(action)) (_))) ->\n          let drop_stk = happyDropStk k stk in\n          happyThen1 (fn stk tk) (\\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))\n\nhappyMonad2Reduce k nt fn 0# tk st sts stk\n     = happyFail [] 0# tk st sts stk\nhappyMonad2Reduce k nt fn j tk st sts stk =\n      case happyDrop k (HappyCons (st) (sts)) of\n        sts1@((HappyCons (st1@(action)) (_))) ->\n         let drop_stk = happyDropStk k stk\n\n             off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1)\n             off_i = (off Happy_GHC_Exts.+#  nt)\n             new_state = indexShortOffAddr happyTable off_i\n\n\n\n\n          in\n          happyThen1 (fn stk tk) (\\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))\n\nhappyDrop 0# l = l\nhappyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t\n\nhappyDropStk 0# l = l\nhappyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs\n\n-----------------------------------------------------------------------------\n-- Moving to a new state after a reduction\n\n\nhappyGoto nt j tk st =\n   {- nothing -}\n   happyDoAction j tk new_state\n   where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st)\n         off_i = (off Happy_GHC_Exts.+#  nt)\n         new_state = indexShortOffAddr happyTable off_i\n\n\n\n\n-----------------------------------------------------------------------------\n-- Error recovery (0# is the error token)\n\n-- parse error if we are in recovery and we fail again\nhappyFail explist 0# tk old_st _ stk@(x `HappyStk` _) =\n     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in\n--      trace \"failing\" $\n        happyError_ explist i tk\n\n{-  We don't need state discarding for our restricted implementation of\n    \"error\".  In fact, it can cause some bogus parses, so I've disabled it\n    for now --SDM\n\n-- discard a state\nhappyFail  0# tk old_st (HappyCons ((action)) (sts))\n                                                (saved_tok `HappyStk` _ `HappyStk` stk) =\n--      trace (\"discarding state, depth \" ++ show (length stk))  $\n        happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))\n-}\n\n-- Enter error recovery: generate an error token,\n--                       save the old token and carry on.\nhappyFail explist i tk (action) sts stk =\n--      trace \"entering error recovery\" $\n        happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)\n\n-- Internal happy errors:\n\nnotHappyAtAll :: a\nnotHappyAtAll = error \"Internal Happy error\\n\"\n\n-----------------------------------------------------------------------------\n-- Hack to get the typechecker to accept our action functions\n\n\nhappyTcHack :: Happy_GHC_Exts.Int# -> a -> a\nhappyTcHack x y = y\n{-# INLINE happyTcHack #-}\n\n\n-----------------------------------------------------------------------------\n-- Seq-ing.  If the --strict flag is given, then Happy emits\n--      happySeq = happyDoSeq\n-- otherwise it emits\n--      happySeq = happyDontSeq\n\nhappyDoSeq, happyDontSeq :: a -> b -> b\nhappyDoSeq   a b = a `seq` b\nhappyDontSeq a b = b\n\n-----------------------------------------------------------------------------\n-- Don't inline any functions from the template.  GHC has a nasty habit\n-- of deciding to inline happyGoto everywhere, which increases the size of\n-- the generated parser quite a bit.\n\n\n{-# NOINLINE happyDoAction #-}\n{-# NOINLINE happyTable #-}\n{-# NOINLINE happyCheck #-}\n{-# NOINLINE happyActOffsets #-}\n{-# NOINLINE happyGotoOffsets #-}\n{-# NOINLINE happyDefActions #-}\n\n{-# NOINLINE happyShift #-}\n{-# NOINLINE happySpecReduce_0 #-}\n{-# NOINLINE happySpecReduce_1 #-}\n{-# NOINLINE happySpecReduce_2 #-}\n{-# NOINLINE happySpecReduce_3 #-}\n{-# NOINLINE happyReduce #-}\n{-# NOINLINE happyMonadReduce #-}\n{-# NOINLINE happyGoto #-}\n{-# NOINLINE happyFail #-}\n\n-- end of Happy Template.\n", "num_lines": 3870}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MonoLocalBinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule T15164 () where\n\ndata Version = VHDL1993\ndata T\ndata NT a\n\nclass Rule f a where\n  get :: Decorator f => f a\n\nclass Monad f => Decorator f where\n  n :: [Version] -> f a -> f (NT a) -- n stands for both NT as well as Node (in grammar tree)\n  chr :: Char -> [Version] -> f T\n  txt :: String -> [Version] -> f T -- token OPTIONALLY followed by spaces\n\n  -- combinators\n  m :: f a -> f [a]\n  c :: [f a] -> f a -- c stands for choose\n  o :: f a -> f (Maybe a) -- o stands for optional\n  trace :: String -> f a -> f a\n\n  -- helper functions in the grammar\n  n93 :: Rule f a => f (NT a)\n  n93 = n [VHDL1993] get\n\n\n  parenOpen :: f T\n  parenOpen = chr '(' [VHDL1993]\n\n  parenClose :: f T\n  parenClose = chr ')' [VHDL1993]\n\n  comma :: f T\n  comma = chr ',' [VHDL1993]\n\n  moreComma :: Rule f a => f [(T, NT a)]\n  moreComma = m $ do\n    cc <- comma\n    cont <- n93\n    return (cc, cont)\n\ntype P_MaybeActualParameterPart = (Maybe (T, (NT ActualParameterPart), T))\nmaybeActualParameterPart :: Decorator f => f (Maybe (T, NT ActualParameterPart, T))\nmaybeActualParameterPart = o $ do\n  po <- parenOpen\n  app <- (n93 :: Decorator f => f (NT ActualParameterPart))\n  pc <- parenClose\n  return (po, app, pc)\n-- helper function used with FormalPart and ActualPart\n-- dcon '(' actual_designator ')'\nmkNameOrTypeMark :: (Decorator m, Rule m a1, Rule m a) => (NT a -> T -> NT a1 -> T -> b) -> m b\nmkNameOrTypeMark dcon = do\n  name_typemark <- n93 -- either Name OR TypeMark depending on dcon !!\n  po <- parenOpen\n  fd  <- n93\n  pc <- parenClose\n  return $ dcon name_typemark po fd pc\n\n-- actual_designator\n--          ::= expression\n--            | name\n--            | 'OPEN'\ndata ActualDesignator = AD1 (NT Expression) | AD2 (NT Name) | AD3 T\ninstance Rule f ActualDesignator where\n  get = trace \"ActualDesignator\" $ {-# SCC \"get_ActualDesignator\" #-} c\n    [ AD3 <$> (txt \"open\" [VHDL1993]) -- order matters here\n    , AD2 <$> n93 -- try a simple name first\n    , AD1 <$> n93\n    -- [ AD3 <$> txt \"open\" [VHDL1993] -- order matters here\n    -- , AD2 <$> (n93 :: f (NT Name)) -- try a simple name first\n    -- , AD1 <$> (n93 :: f (NT Expression))\n    ]\n\n-- actual_parameter_part\n--          ::= association_list\nnewtype ActualParameterPart = APP (NT AssociationList)\ninstance Rule f AssociationList => Rule f ActualParameterPart where\n  get = APP <$> n93\n\n-- actual_part\n--          ::= actual_designator\n--            | ( name | type_mark ) '(' actual_designator ')'\ndata ActualPart = AP1 (NT ActualDesignator) | APName (NT Name) T (NT ActualDesignator) T | APTypeMark (NT TypeMark) T (NT ActualDesignator) T\ninstance (Rule f ActualDesignator, Rule f Name, Rule f TypeMark) => Rule f ActualPart where\n  get = trace \"ActualPart\" $ {-# SCC \"get_ActualPart\" #-} c\n    [ AP1 <$> n93\n    , mkNameOrTypeMark APName\n    , mkNameOrTypeMark APTypeMark\n    ]\n\n-- aggregate\n--          ::= '(' element_association ( ',' element_association )* ')'\ndata Aggregate = MkAggregate T (NT ElementAssociation) [(T, (NT ElementAssociation))] T\ninstance Rule f ElementAssociation => Rule f Aggregate where\n  get = do\n    po <- parenOpen\n    ea <- n93\n    rest <- moreComma\n    pc <- parenClose\n    return $ MkAggregate po ea rest pc\n\n-- allocator\n--          ::= 'NEW' ( subtype_indication | qualified_expression )\ndata Allocator = A1 T (NT SubtypeIndication) | A2 T (NT QualifiedExpression)\ninstance (Rule f SubtypeIndication, Rule f QualifiedExpression) => Rule f Allocator where\n  get = c\n    [ A1 <$> (txt \"new\" [VHDL1993]) <*> n93\n    , A2 <$> (txt \"new\" [VHDL1993]) <*> n93\n    ]\n\n-- association_element\n--          ::= ( formal_part '=>' )? actual_part\ndata AssociationElement = AE (Maybe (NT FormalPart, T)) (NT ActualPart)\ninstance (Rule f FormalPart, Rule f ActualPart) => Rule f AssociationElement where\n  get = do\n    fp <- o $ do\n      f <- n93\n      a <- txt \"=>\" [VHDL1993]\n      return (f, a)\n    ap <- n93\n    return $ AE fp ap\n\n-- association_list\n--          ::= association_element ( ',' association_element )*\ndata AssociationList = AL (NT AssociationElement) [(T, NT AssociationElement)]\ninstance Rule f AssociationElement => Rule f AssociationList where\n  get = do\n    ae <- n93\n    rest <- moreComma\n    return $ AL ae rest\n\n-- attribute_name\n--          ::= prefix signature? \"'\" attribute_designator ( '(' expression ')' )?\ndata AttributeName = AN (NT Prefix) (Maybe (NT TypeMark)) T (Maybe (T, (NT Expression), T))\ninstance (Rule f Prefix, Rule f TypeMark, Rule f Expression) => Rule f AttributeName where\n  get = do\n    pp <- n93\n    ss <- o n93\n    cc <- chr '\\'' [VHDL1993]\n    -- ad <- n93\n    ee <- o $ do\n      po <- parenOpen\n      e <- n93\n      pc <- parenClose\n      return (po, e, pc)\n    return $ AN pp ss cc ee\n\n-- choice   ::= simple_expression\n--            | discrete_range\n--            | simple_name\n--            | 'OTHERS'\ndata Choice =\n  CSmimpleExpression (NT SimpleExpression)\n  | CDiscreteRange (NT DiscreteRange)\n  -- | CSimpleName (NT SimpleName)\n  | COthers T\n\ninstance (Rule f SimpleExpression, Rule f DiscreteRange) => Rule f Choice where\n  get = c\n    [ CSmimpleExpression <$> n93\n    , CDiscreteRange     <$> n93\n    -- , CSimpleName        <$> n93\n    , COthers            <$> txt \"others\" [VHDL1993]\n    ]\n\n-- constraint\n--          ::= range_constraint\n--            | index_constraint\ndata Constraint = CRange (NT RangeConstraint) | CIndex (NT DiscreteRange)\ninstance (Rule f RangeConstraint, Rule f DiscreteRange) => Rule f Constraint where\n  get = c\n    [ CRange <$> n93\n    , CIndex <$> n93\n    ]\n\n-- discrete_range\n--          ::= subtype_indication\n--            | range\ndata DiscreteRange = DRSubtypeIndication (NT SubtypeIndication) | DRRange (NT Range)\ninstance (Rule f SubtypeIndication, Rule f Range) => Rule f DiscreteRange where\n  get = c\n    [ DRSubtypeIndication <$> n93\n    , DRRange <$> n93\n    ]\n\n-- element_association\n--          ::= ( choices '=>' )? expression\ndata ElementAssociation = EA (Maybe (NT Choice, T)) (NT Expression)\ninstance (Rule f Choice, Rule f Expression) => Rule f ElementAssociation where\n  get = do\n    c <- o $ do\n      c <- n93\n      a <- txt \"=>\" [VHDL1993]\n      return (c, a)\n    e <- n93\n    return $ EA c e\n\n-- expression\n--          ::= relation ( ( 'AND' relation )* | ( 'OR' relation )* | ( 'XOR' relation )* | ( 'NAND' | 'NOR' ) relation | ( 'XNOR' relation )* )\ndata Expression =\n  And (NT SimpleExpression) [(T, (NT SimpleExpression))]\n  | Or (NT SimpleExpression) [(T, (NT SimpleExpression))]\n  | Xor (NT SimpleExpression) [(T, (NT SimpleExpression))]\n  | Nand (NT SimpleExpression) (T, (NT SimpleExpression))\n  | Nor (NT SimpleExpression) (T, (NT SimpleExpression))\n  | Xnor (NT SimpleExpression) [(T, (NT SimpleExpression))]\n\ninstance Rule f SimpleExpression => Rule f Expression where\n  get = {-# SCC \"get_IndexedName\" #-} c\n    [ And  <$> n93 <*> emore \"and\"\n    , Or   <$> n93 <*> emore \"or\"\n    , Xor  <$> n93 <*> emore \"xor\"\n    , Nand <$> n93 <*> etwo \"nand\"\n    , Nor  <$> n93 <*> etwo \"nor\"\n    , Xnor <$> n93 <*> emore \"xnor\"\n    ]\n    where etwo tok = do\n            n1 <- txt tok [VHDL1993]\n            n2 <- n93\n            return (n1, n2)\n          emore tok = do\n            m $ do\n              n2 <- txt tok [VHDL1993]\n              n3 <- n93\n              return (n2, n3)\n\n-- factor   ::= ( primary '**' | 'ABS' | 'NOT' )? primary\ndata Factor = FPower (NT Primary) (Maybe (T, (NT Primary))) | FAbs T (NT Primary) | FNot T (NT Primary)\ninstance Rule f Primary => Rule f Factor where\n  get = trace \"Factor\" $ {-# SCC \"get_Factor\" #-} c -- c\n    [ do\n      p <- n93\n      rest <- o $ do\n        p <- txt \"**\" [VHDL1993]\n        p2 <- n93\n        return (p, p2)\n      return $ FPower p rest\n    , FAbs <$> (txt \"abs\" [VHDL1993]) <*> n93\n    , FNot <$> (txt \"not\" [VHDL1993]) <*> n93\n    ]\n\n-- formal_designator\n--          ::= name\nnewtype FormalDesignator = MkFormalDesignator (NT Name)\ninstance Rule f Name => Rule f FormalDesignator where\n  get = trace \"FormalDesignator\" $ {-# SCC \"get_FormalDesignator\" #-} MkFormalDesignator <$> n93\n\n-- formal_part\n--          ::= formal_designator\n--            | ( name | type_mark ) '(' formal_designator ')'\ndata FormalPart = FP1 (NT FormalDesignator) | FPName (NT Name) T (NT FormalDesignator) T | FPTypeMark (NT TypeMark) T (NT FormalDesignator) T\ninstance (Rule f FormalDesignator, Rule f Name, Rule f TypeMark) => Rule f FormalPart where\n  get = trace \"FormalPart\" $ {-# SCC \"get_FormalPart\" #-} c\n    [ FP1 <$> n93\n    , mkNameOrTypeMark FPName\n    , mkNameOrTypeMark FPTypeMark\n    ]\n\n-- function_call\n--          ::= name ( '(' actual_parameter_part ')' )?\ndata FunctionCall = FC (NT Name) P_MaybeActualParameterPart\n-- redundant: Rule f ActualParameterPart\ninstance Rule f Name => Rule f FunctionCall where\n  get = trace \"FunctionCall\" $ {-# SCC \"get_FunctionCall\" #-} do\n    nn <- n93\n    app <- maybeActualParameterPart\n    return $ FC nn app\n\n-- index_constraint\n--          ::= '(' discrete_range ( ',' discrete_range )* ')'\ndata IndexConstraint = IC T (NT DiscreteRange) [(T, NT DiscreteRange)] T\ninstance Rule f DiscreteRange => Rule f IndexConstraint where\n  get = do\n    po <- parenOpen\n    dr <- n93\n    rest <- moreComma\n    pc <- parenClose\n    return $ IC po dr rest pc\n\n-- indexed_name\n--          ::= prefix '(' expression ( ',' expression )* ')'\ndata IndexedName = IN (NT Prefix) T (NT Expression) [(T, NT Expression)] T\ninstance (Rule f Prefix, Rule f Expression) => Rule f IndexedName where\n  get = {-# SCC \"get_IndexedName\" #-} do\n    pp <- n93\n    po <- parenOpen\n    ee <- n93\n    ee2 <- moreComma\n    pc <- parenClose\n    return $ IN pp po ee ee2 pc\n\n-- literal  ::= numeric_literal\n--            | enumeration_literal\n--            | string_literal\n--            | bit_string_literal\n--            | 'NULL'\ndata Literal =\n  LNumericLiteral (NT Name)\n  -- | LEnumerationLiteral (NT EnumerationLiteral)\n  -- | LStringLiteral (NT StringLiteral)\n  -- | LBitStringLiteral (NT BitStringLiteral)\n  | LNull T\n\ninstance (Rule f Name) => Rule f Literal where\n  get = c\n    [ LNumericLiteral     <$> n93\n    -- , LEnumerationLiteral <$> n93\n    -- , LStringLiteral      <$> n93\n    -- , LBitStringLiteral   <$> n93\n    , LNull               <$> txt \"null\" [VHDL1993]\n    ]\n\n-- name     ::= simple_name\n--            | operator_symbol\n--            | selected_name\n--            | indexed_name\n--            | slice_name\n--            | attribute_name\ndata Name = N3 (NT Prefix) | N4 (NT IndexedName) | N6 (NT AttributeName)\ninstance (Rule f Prefix, Rule f IndexedName, Rule f AttributeName) => Rule f Name where\n  get = trace \"Name\" $ {-# SCC \"get_Name\" #-} c\n    [ N3 <$> n93\n    , N4 <$> n93\n    -- , N5 <$> n93\n    , N6 <$> n93\n    ]\n\n-- prefix   ::= name\n--            | function_call\ndata Prefix = PrefixName (NT Name) | PrefixFunctionCall (NT FunctionCall)\ninstance (Rule f Name, Rule f FunctionCall) => Rule f Prefix where\n  get = trace \"Prefix\" $ {-# SCC \"get_Prefix\" #-} c\n    [ PrefixName <$> n93\n    , PrefixFunctionCall <$> n93\n    ]\n\n-- primary  ::= name\n--            | literal\n--            | aggregate\n--            | function_call\n--            | qualified_expression\n--            | type_conversion\n--            | allocator\n--            | '(' expression ')'\ndata Primary =\n  PName (NT Name)\n  -- | PLiteral (NT Literal)\n  | PAggregate (NT Aggregate)\n  | PFunctionCall (NT FunctionCall)\n  | PQualifiedExpression (NT QualifiedExpression)\n  | PTypeConversion (NT TypeConversion)\n  | PAllocator (NT Allocator)\n  | PExpression T (NT Expression) T\n\n--get_levels: instance (Rule f Name, Rule f Aggregate, Rule f FunctionCall, Rule f QualifiedExpression, Rule f TypeConversion, Rule f Allocator, Rule f Expression) => Rule f Primary where\ninstance (Rule f Name, Rule f Aggregate, Rule f FunctionCall, Rule f QualifiedExpression\n         , Rule f TypeConversion, Rule f Allocator, Rule f Expression) => Rule f Primary where\n  get = trace \"Primary\" $ {-# SCC \"get_Primary\" #-} c\n    [ PName                <$> n93\n    -- , PLiteral             <$> n93\n    , PAggregate           <$> n93\n    , PFunctionCall        <$> n93\n    , PQualifiedExpression <$> n93\n    , PTypeConversion      <$> n93\n    , PAllocator           <$> n93\n    ,                          exp\n    -- [ PName <$> (n93 :: f (NT Name))\n    -- , PLiteral <$> (n93 :: f (NT Literal))\n    -- , PAggregate <$> (n93 :: f (NT Aggregate))\n    -- , PFunctionCall <$> (n93 :: f (NT FunctionCall))\n    -- , PQualifiedExpression <$> (n93 :: f (NT QualifiedExpression))\n    -- , PTypeConversion <$> (n93 :: f (NT TypeConversion))\n    -- , PAllocator <$> (n93 :: f (NT Allocator))\n    -- , PExpression <$> parenOpen <*> (n93 :: f (NT Expression)) <*> parenClose\n    -- , exp\n    ]\n    where exp = do\n            po <- parenOpen\n            ee  <- n93\n            pc <- parenClose\n            return $ PExpression po ee pc\n\n-- qualified_expression\n--          ::= type_mark \"'\" ( '(' expression ')' | aggregate )\ndata QualifiedExpression = QEExpression (NT TypeMark) T T (NT Expression) T | EQAggregate (NT TypeMark) T\ninstance (Rule f TypeMark, Rule f Expression) => Rule f QualifiedExpression where\n  get = c [qexp, qagg]\n    where qexp = do\n            tm <- n93\n            q  <- chr '\\'' [VHDL1993]\n            po <- parenOpen\n            ee  <- n93\n            pc <- parenClose\n            return $ QEExpression tm q po ee pc\n          qagg = do\n            tm <- n93\n            q  <- chr '\\'' [VHDL1993]\n            -- a  <- n93\n            return $ EQAggregate tm q\n\n-- range    ::= attribute_name\n--            | simple_expression direction simple_expression\ndata Range = R1 (NT AttributeName) | R2 (NT SimpleExpression) (NT SimpleExpression)\ninstance (Rule f AttributeName, Rule f SimpleExpression) => Rule f Range where\n  get = c\n    [ R1 <$> n93\n    , R2 <$> n93<*> n93\n    ]\n\n-- range_constraint\n--          ::= 'range' range\ndata RangeConstraint = RC T (NT Range)\ninstance Rule f Range => Rule f RangeConstraint where\n  get = do\n    r1 <- txt \"range\" [VHDL1993]\n    r2 <- n93\n    return $ RC r1 r2\n\n-- relation\n--          ::= shift_expression ( relational_operator shift_expression )?\ndata Relation = R (NT SimpleExpression) (Maybe ((NT SimpleExpression)))\ninstance (Rule f SimpleExpression) => Rule f Relation where\n  get = do\n    se <- n93\n    rest <- o $ do\n      -- ro <- n93\n      se <- n93\n      return se\n    return $ R se rest\n\n-- shift_expression\n--          ::= simple_expression ( shift_operator simple_expression )?\ndata ShiftExpression = ShiftE (NT SimpleExpression) (Maybe ((NT SimpleExpression)))\ninstance (Rule f SimpleExpression) => Rule f ShiftExpression where\n  get = do\n    se <- n93\n    rest <- o $ do\n      -- so <- n93\n      se <- n93\n      return se\n    return $ ShiftE se rest\n\n-- simple_expression\n--          ::= sign? term ( adding_operator term )*\ndata SimpleExpression = SimpleE (NT Primary) [(NT Primary)]\n-- data SimpleExpression = SimpleE T\ninstance (Rule f Primary) => Rule f SimpleExpression where\n  -- get = SimpleE <$> txt \"bla\" [VHDL1993]\n  get = do\n    -- ss <- o n93\n    tt <- n93\n    rest <- m $ do\n      -- ao <- n93\n      tt2 <- n93\n      return tt2\n    return $ SimpleE tt rest\n\n-- slice_name\n--          ::= prefix '(' discrete_range ')'\ndata SliceName = SliceNPrefix (NT DiscreteRange)\ninstance Rule f DiscreteRange => Rule f SliceName where\n  get = SliceNPrefix <$> n93\n\n-- subtype_indication\n--          ::= name? type_mark constraint?\ndata SubtypeIndication = SI (Maybe (NT Name)) (NT TypeMark) (Maybe (NT Constraint))\ninstance (Rule f Name, Rule f TypeMark, Rule f Constraint) => Rule f SubtypeIndication where\n  get = trace \"SubtypeIndication\" $ {-# SCC \"get_SubtypeIndication\" #-} do\n    nn <- o n93\n    tm <- n93\n    cc <- o n93\n    return $ SI nn tm cc\n\n-- type_conversion\n--          ::= type_mark '(' expression ')'\ndata TypeConversion = MkTypeConversion (NT TypeMark) T (NT Expression) T\ninstance (Rule f TypeMark, Rule f Expression) => Rule f TypeConversion where\n  get = do\n    tm <- n93\n    po <- parenOpen\n    e  <- n93\n    pc <- parenClose\n    return $ MkTypeConversion tm po e pc\n\n-- type_mark\n--          ::= type_name | subtype_name\ndata TypeMark = TM1 (NT Name) | TM2 (NT Name)\ninstance Rule f Name => Rule f TypeMark where\n  get = trace \"TypeMark\" $ {-# SCC \"get_TypeMark\" #-} c\n    [ TM1 <$> n93\n    , TM2 <$> n93\n    ]\n", "num_lines": 502}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Main where\n\nimport T16190_Embed\nimport Foreign.Ptr\nimport Foreign.Storable\nimport Data.Word\nimport GHC.Ptr\n\nptr :: Ptr Word32\nptr = Ptr $(embedBytes (replicate (3 * 1000 * 1000) 0x37))\n\nmain :: IO ()\nmain = do\n   w <- peek (ptr `plusPtr` 12) \n   print (w == (0x37373737 :: Word32))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16190_Embed where\n\nimport Data.Word\nimport Language.Haskell.TH\n\nembedBytes :: [Word8] -> Q Exp\nembedBytes bs = return (LitE (StringPrimL bs))\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T1969 where\n\nclass C a where\n    c :: a -> String\n    d :: a -> String\n    d x = c x\n    e :: a -> String\n    e x = c x\n\ndata A1 = A1\ninstance C A1 where\n    c A1 = \"A1\"\n\ndata A2 = A2\ninstance C A2 where\n    c A2 = \"A2\"\n\ndata A3 = A3\ninstance C A3 where\n    c A3 = \"A3\"\n\ndata A4 = A4\ninstance C A4 where\n    c A4 = \"A4\"\n\ndata A5 = A5\ninstance C A5 where\n    c A5 = \"A5\"\n\ndata A6 = A6\ninstance C A6 where\n    c A6 = \"A6\"\n\ndata A7 = A7\ninstance C A7 where\n    c A7 = \"A7\"\n\ndata A8 = A8\ninstance C A8 where\n    c A8 = \"A8\"\n\ndata A9 = A9\ninstance C A9 where\n    c A9 = \"A9\"\n\ndata A10 = A10\ninstance C A10 where\n    c A10 = \"A10\"\n\ndata A11 = A11\ninstance C A11 where\n    c A11 = \"A11\"\n\ndata A12 = A12\ninstance C A12 where\n    c A12 = \"A12\"\n\ndata A13 = A13\ninstance C A13 where\n    c A13 = \"A13\"\n\ndata A14 = A14\ninstance C A14 where\n    c A14 = \"A14\"\n\ndata A15 = A15\ninstance C A15 where\n    c A15 = \"A15\"\n\ndata A16 = A16\ninstance C A16 where\n    c A16 = \"A16\"\n\ndata A17 = A17\ninstance C A17 where\n    c A17 = \"A17\"\n\ndata A18 = A18\ninstance C A18 where\n    c A18 = \"A18\"\n\ndata A19 = A19\ninstance C A19 where\n    c A19 = \"A19\"\n\ndata A20 = A20\ninstance C A20 where\n    c A20 = \"A20\"\n\ndata A21 = A21\ninstance C A21 where\n    c A21 = \"A21\"\n\ndata A22 = A22\ninstance C A22 where\n    c A22 = \"A22\"\n\ndata A23 = A23\ninstance C A23 where\n    c A23 = \"A23\"\n\ndata A24 = A24\ninstance C A24 where\n    c A24 = \"A24\"\n\ndata A25 = A25\ninstance C A25 where\n    c A25 = \"A25\"\n\ndata A26 = A26\ninstance C A26 where\n    c A26 = \"A26\"\n\ndata A27 = A27\ninstance C A27 where\n    c A27 = \"A27\"\n\ndata A28 = A28\ninstance C A28 where\n    c A28 = \"A28\"\n\ndata A29 = A29\ninstance C A29 where\n    c A29 = \"A29\"\n\ndata A30 = A30\ninstance C A30 where\n    c A30 = \"A30\"\n\ndata A31 = A31\ninstance C A31 where\n    c A31 = \"A31\"\n\ndata A32 = A32\ninstance C A32 where\n    c A32 = \"A32\"\n\ndata A33 = A33\ninstance C A33 where\n    c A33 = \"A33\"\n\ndata A34 = A34\ninstance C A34 where\n    c A34 = \"A34\"\n\ndata A35 = A35\ninstance C A35 where\n    c A35 = \"A35\"\n\ndata A36 = A36\ninstance C A36 where\n    c A36 = \"A36\"\n\ndata A37 = A37\ninstance C A37 where\n    c A37 = \"A37\"\n\ndata A38 = A38\ninstance C A38 where\n    c A38 = \"A38\"\n\ndata A39 = A39\ninstance C A39 where\n    c A39 = \"A39\"\n\ndata A40 = A40\ninstance C A40 where\n    c A40 = \"A40\"\n\ndata A41 = A41\ninstance C A41 where\n    c A41 = \"A41\"\n\ndata A42 = A42\ninstance C A42 where\n    c A42 = \"A42\"\n\ndata A43 = A43\ninstance C A43 where\n    c A43 = \"A43\"\n\ndata A44 = A44\ninstance C A44 where\n    c A44 = \"A44\"\n\ndata A45 = A45\ninstance C A45 where\n    c A45 = \"A45\"\n\ndata A46 = A46\ninstance C A46 where\n    c A46 = \"A46\"\n\ndata A47 = A47\ninstance C A47 where\n    c A47 = \"A47\"\n\ndata A48 = A48\ninstance C A48 where\n    c A48 = \"A48\"\n\ndata A49 = A49\ninstance C A49 where\n    c A49 = \"A49\"\n\ndata A50 = A50\ninstance C A50 where\n    c A50 = \"A50\"\n\ndata A51 = A51\ninstance C A51 where\n    c A51 = \"A51\"\n\ndata A52 = A52\ninstance C A52 where\n    c A52 = \"A52\"\n\ndata A53 = A53\ninstance C A53 where\n    c A53 = \"A53\"\n\ndata A54 = A54\ninstance C A54 where\n    c A54 = \"A54\"\n\ndata A55 = A55\ninstance C A55 where\n    c A55 = \"A55\"\n\ndata A56 = A56\ninstance C A56 where\n    c A56 = \"A56\"\n\ndata A57 = A57\ninstance C A57 where\n    c A57 = \"A57\"\n\ndata A58 = A58\ninstance C A58 where\n    c A58 = \"A58\"\n\ndata A59 = A59\ninstance C A59 where\n    c A59 = \"A59\"\n\ndata A60 = A60\ninstance C A60 where\n    c A60 = \"A60\"\n\ndata A61 = A61\ninstance C A61 where\n    c A61 = \"A61\"\n\ndata A62 = A62\ninstance C A62 where\n    c A62 = \"A62\"\n\ndata A63 = A63\ninstance C A63 where\n    c A63 = \"A63\"\n\ndata A64 = A64\ninstance C A64 where\n    c A64 = \"A64\"\n\ndata A65 = A65\ninstance C A65 where\n    c A65 = \"A65\"\n\ndata A66 = A66\ninstance C A66 where\n    c A66 = \"A66\"\n\ndata A67 = A67\ninstance C A67 where\n    c A67 = \"A67\"\n\ndata A68 = A68\ninstance C A68 where\n    c A68 = \"A68\"\n\ndata A69 = A69\ninstance C A69 where\n    c A69 = \"A69\"\n\ndata A70 = A70\ninstance C A70 where\n    c A70 = \"A70\"\n\ndata A71 = A71\ninstance C A71 where\n    c A71 = \"A71\"\n\ndata A72 = A72\ninstance C A72 where\n    c A72 = \"A72\"\n\ndata A73 = A73\ninstance C A73 where\n    c A73 = \"A73\"\n\ndata A74 = A74\ninstance C A74 where\n    c A74 = \"A74\"\n\ndata A75 = A75\ninstance C A75 where\n    c A75 = \"A75\"\n\ndata A76 = A76\ninstance C A76 where\n    c A76 = \"A76\"\n\ndata A77 = A77\ninstance C A77 where\n    c A77 = \"A77\"\n\ndata A78 = A78\ninstance C A78 where\n    c A78 = \"A78\"\n\ndata A79 = A79\ninstance C A79 where\n    c A79 = \"A79\"\n\ndata A80 = A80\ninstance C A80 where\n    c A80 = \"A80\"\n\ndata A81 = A81\ninstance C A81 where\n    c A81 = \"A81\"\n\ndata A82 = A82\ninstance C A82 where\n    c A82 = \"A82\"\n\ndata A83 = A83\ninstance C A83 where\n    c A83 = \"A83\"\n\ndata A84 = A84\ninstance C A84 where\n    c A84 = \"A84\"\n\ndata A85 = A85\ninstance C A85 where\n    c A85 = \"A85\"\n\ndata A86 = A86\ninstance C A86 where\n    c A86 = \"A86\"\n\ndata A87 = A87\ninstance C A87 where\n    c A87 = \"A87\"\n\ndata A88 = A88\ninstance C A88 where\n    c A88 = \"A88\"\n\ndata A89 = A89\ninstance C A89 where\n    c A89 = \"A89\"\n\ndata A90 = A90\ninstance C A90 where\n    c A90 = \"A90\"\n\ndata A91 = A91\ninstance C A91 where\n    c A91 = \"A91\"\n\ndata A92 = A92\ninstance C A92 where\n    c A92 = \"A92\"\n\ndata A93 = A93\ninstance C A93 where\n    c A93 = \"A93\"\n\ndata A94 = A94\ninstance C A94 where\n    c A94 = \"A94\"\n\ndata A95 = A95\ninstance C A95 where\n    c A95 = \"A95\"\n\ndata A96 = A96\ninstance C A96 where\n    c A96 = \"A96\"\n\ndata A97 = A97\ninstance C A97 where\n    c A97 = \"A97\"\n\ndata A98 = A98\ninstance C A98 where\n    c A98 = \"A98\"\n\ndata A99 = A99\ninstance C A99 where\n    c A99 = \"A99\"\n\ndata A100 = A100\ninstance C A100 where\n    c A100 = \"A100\"\n\ndata A101 = A101\ninstance C A101 where\n    c A101 = \"A101\"\n\ndata A102 = A102\ninstance C A102 where\n    c A102 = \"A102\"\n\ndata A103 = A103\ninstance C A103 where\n    c A103 = \"A103\"\n\ndata A104 = A104\ninstance C A104 where\n    c A104 = \"A104\"\n\ndata A105 = A105\ninstance C A105 where\n    c A105 = \"A105\"\n\ndata A106 = A106\ninstance C A106 where\n    c A106 = \"A106\"\n\ndata A107 = A107\ninstance C A107 where\n    c A107 = \"A107\"\n\ndata A108 = A108\ninstance C A108 where\n    c A108 = \"A108\"\n\ndata A109 = A109\ninstance C A109 where\n    c A109 = \"A109\"\n\ndata A110 = A110\ninstance C A110 where\n    c A110 = \"A110\"\n\ndata A111 = A111\ninstance C A111 where\n    c A111 = \"A111\"\n\ndata A112 = A112\ninstance C A112 where\n    c A112 = \"A112\"\n\ndata A113 = A113\ninstance C A113 where\n    c A113 = \"A113\"\n\ndata A114 = A114\ninstance C A114 where\n    c A114 = \"A114\"\n\ndata A115 = A115\ninstance C A115 where\n    c A115 = \"A115\"\n\ndata A116 = A116\ninstance C A116 where\n    c A116 = \"A116\"\n\ndata A117 = A117\ninstance C A117 where\n    c A117 = \"A117\"\n\ndata A118 = A118\ninstance C A118 where\n    c A118 = \"A118\"\n\ndata A119 = A119\ninstance C A119 where\n    c A119 = \"A119\"\n\ndata A120 = A120\ninstance C A120 where\n    c A120 = \"A120\"\n\ndata A121 = A121\ninstance C A121 where\n    c A121 = \"A121\"\n\ndata A122 = A122\ninstance C A122 where\n    c A122 = \"A122\"\n\ndata A123 = A123\ninstance C A123 where\n    c A123 = \"A123\"\n\ndata A124 = A124\ninstance C A124 where\n    c A124 = \"A124\"\n\ndata A125 = A125\ninstance C A125 where\n    c A125 = \"A125\"\n\ndata A126 = A126\ninstance C A126 where\n    c A126 = \"A126\"\n\ndata A127 = A127\ninstance C A127 where\n    c A127 = \"A127\"\n\ndata A128 = A128\ninstance C A128 where\n    c A128 = \"A128\"\n\ndata A129 = A129\ninstance C A129 where\n    c A129 = \"A129\"\n\ndata A130 = A130\ninstance C A130 where\n    c A130 = \"A130\"\n\ndata A131 = A131\ninstance C A131 where\n    c A131 = \"A131\"\n\ndata A132 = A132\ninstance C A132 where\n    c A132 = \"A132\"\n\ndata A133 = A133\ninstance C A133 where\n    c A133 = \"A133\"\n\ndata A134 = A134\ninstance C A134 where\n    c A134 = \"A134\"\n\ndata A135 = A135\ninstance C A135 where\n    c A135 = \"A135\"\n\ndata A136 = A136\ninstance C A136 where\n    c A136 = \"A136\"\n\ndata A137 = A137\ninstance C A137 where\n    c A137 = \"A137\"\n\ndata A138 = A138\ninstance C A138 where\n    c A138 = \"A138\"\n\ndata A139 = A139\ninstance C A139 where\n    c A139 = \"A139\"\n\ndata A140 = A140\ninstance C A140 where\n    c A140 = \"A140\"\n\ndata A141 = A141\ninstance C A141 where\n    c A141 = \"A141\"\n\ndata A142 = A142\ninstance C A142 where\n    c A142 = \"A142\"\n\ndata A143 = A143\ninstance C A143 where\n    c A143 = \"A143\"\n\ndata A144 = A144\ninstance C A144 where\n    c A144 = \"A144\"\n\ndata A145 = A145\ninstance C A145 where\n    c A145 = \"A145\"\n\ndata A146 = A146\ninstance C A146 where\n    c A146 = \"A146\"\n\ndata A147 = A147\ninstance C A147 where\n    c A147 = \"A147\"\n\ndata A148 = A148\ninstance C A148 where\n    c A148 = \"A148\"\n\ndata A149 = A149\ninstance C A149 where\n    c A149 = \"A149\"\n\ndata A150 = A150\ninstance C A150 where\n    c A150 = \"A150\"\n\ndata A151 = A151\ninstance C A151 where\n    c A151 = \"A151\"\n\ndata A152 = A152\ninstance C A152 where\n    c A152 = \"A152\"\n\ndata A153 = A153\ninstance C A153 where\n    c A153 = \"A153\"\n\ndata A154 = A154\ninstance C A154 where\n    c A154 = \"A154\"\n\ndata A155 = A155\ninstance C A155 where\n    c A155 = \"A155\"\n\ndata A156 = A156\ninstance C A156 where\n    c A156 = \"A156\"\n\ndata A157 = A157\ninstance C A157 where\n    c A157 = \"A157\"\n\ndata A158 = A158\ninstance C A158 where\n    c A158 = \"A158\"\n\ndata A159 = A159\ninstance C A159 where\n    c A159 = \"A159\"\n\ndata A160 = A160\ninstance C A160 where\n    c A160 = \"A160\"\n\ndata A161 = A161\ninstance C A161 where\n    c A161 = \"A161\"\n\ndata A162 = A162\ninstance C A162 where\n    c A162 = \"A162\"\n\ndata A163 = A163\ninstance C A163 where\n    c A163 = \"A163\"\n\ndata A164 = A164\ninstance C A164 where\n    c A164 = \"A164\"\n\ndata A165 = A165\ninstance C A165 where\n    c A165 = \"A165\"\n\ndata A166 = A166\ninstance C A166 where\n    c A166 = \"A166\"\n\ndata A167 = A167\ninstance C A167 where\n    c A167 = \"A167\"\n\ndata A168 = A168\ninstance C A168 where\n    c A168 = \"A168\"\n\ndata A169 = A169\ninstance C A169 where\n    c A169 = \"A169\"\n\ndata A170 = A170\ninstance C A170 where\n    c A170 = \"A170\"\n\ndata A171 = A171\ninstance C A171 where\n    c A171 = \"A171\"\n\ndata A172 = A172\ninstance C A172 where\n    c A172 = \"A172\"\n\ndata A173 = A173\ninstance C A173 where\n    c A173 = \"A173\"\n\ndata A174 = A174\ninstance C A174 where\n    c A174 = \"A174\"\n\ndata A175 = A175\ninstance C A175 where\n    c A175 = \"A175\"\n\ndata A176 = A176\ninstance C A176 where\n    c A176 = \"A176\"\n\ndata A177 = A177\ninstance C A177 where\n    c A177 = \"A177\"\n\ndata A178 = A178\ninstance C A178 where\n    c A178 = \"A178\"\n\ndata A179 = A179\ninstance C A179 where\n    c A179 = \"A179\"\n\ndata A180 = A180\ninstance C A180 where\n    c A180 = \"A180\"\n\ndata A181 = A181\ninstance C A181 where\n    c A181 = \"A181\"\n\ndata A182 = A182\ninstance C A182 where\n    c A182 = \"A182\"\n\ndata A183 = A183\ninstance C A183 where\n    c A183 = \"A183\"\n\ndata A184 = A184\ninstance C A184 where\n    c A184 = \"A184\"\n\ndata A185 = A185\ninstance C A185 where\n    c A185 = \"A185\"\n\ndata A186 = A186\ninstance C A186 where\n    c A186 = \"A186\"\n\ndata A187 = A187\ninstance C A187 where\n    c A187 = \"A187\"\n\ndata A188 = A188\ninstance C A188 where\n    c A188 = \"A188\"\n\ndata A189 = A189\ninstance C A189 where\n    c A189 = \"A189\"\n\ndata A190 = A190\ninstance C A190 where\n    c A190 = \"A190\"\n\ndata A191 = A191\ninstance C A191 where\n    c A191 = \"A191\"\n\ndata A192 = A192\ninstance C A192 where\n    c A192 = \"A192\"\n\ndata A193 = A193\ninstance C A193 where\n    c A193 = \"A193\"\n\ndata A194 = A194\ninstance C A194 where\n    c A194 = \"A194\"\n\ndata A195 = A195\ninstance C A195 where\n    c A195 = \"A195\"\n\ndata A196 = A196\ninstance C A196 where\n    c A196 = \"A196\"\n\ndata A197 = A197\ninstance C A197 where\n    c A197 = \"A197\"\n\ndata A198 = A198\ninstance C A198 where\n    c A198 = \"A198\"\n\ndata A199 = A199\ninstance C A199 where\n    c A199 = \"A199\"\n\ndata A200 = A200\ninstance C A200 where\n    c A200 = \"A200\"\n\ndata A201 = A201\ninstance C A201 where\n    c A201 = \"A201\"\n\ndata A202 = A202\ninstance C A202 where\n    c A202 = \"A202\"\n\ndata A203 = A203\ninstance C A203 where\n    c A203 = \"A203\"\n\ndata A204 = A204\ninstance C A204 where\n    c A204 = \"A204\"\n\ndata A205 = A205\ninstance C A205 where\n    c A205 = \"A205\"\n\ndata A206 = A206\ninstance C A206 where\n    c A206 = \"A206\"\n\ndata A207 = A207\ninstance C A207 where\n    c A207 = \"A207\"\n\ndata A208 = A208\ninstance C A208 where\n    c A208 = \"A208\"\n\ndata A209 = A209\ninstance C A209 where\n    c A209 = \"A209\"\n\ndata A210 = A210\ninstance C A210 where\n    c A210 = \"A210\"\n\ndata A211 = A211\ninstance C A211 where\n    c A211 = \"A211\"\n\ndata A212 = A212\ninstance C A212 where\n    c A212 = \"A212\"\n\ndata A213 = A213\ninstance C A213 where\n    c A213 = \"A213\"\n\ndata A214 = A214\ninstance C A214 where\n    c A214 = \"A214\"\n\ndata A215 = A215\ninstance C A215 where\n    c A215 = \"A215\"\n\ndata A216 = A216\ninstance C A216 where\n    c A216 = \"A216\"\n\ndata A217 = A217\ninstance C A217 where\n    c A217 = \"A217\"\n\ndata A218 = A218\ninstance C A218 where\n    c A218 = \"A218\"\n\ndata A219 = A219\ninstance C A219 where\n    c A219 = \"A219\"\n\ndata A220 = A220\ninstance C A220 where\n    c A220 = \"A220\"\n\ndata A221 = A221\ninstance C A221 where\n    c A221 = \"A221\"\n\ndata A222 = A222\ninstance C A222 where\n    c A222 = \"A222\"\n\ndata A223 = A223\ninstance C A223 where\n    c A223 = \"A223\"\n\ndata A224 = A224\ninstance C A224 where\n    c A224 = \"A224\"\n\ndata A225 = A225\ninstance C A225 where\n    c A225 = \"A225\"\n\ndata A226 = A226\ninstance C A226 where\n    c A226 = \"A226\"\n\ndata A227 = A227\ninstance C A227 where\n    c A227 = \"A227\"\n\ndata A228 = A228\ninstance C A228 where\n    c A228 = \"A228\"\n\ndata A229 = A229\ninstance C A229 where\n    c A229 = \"A229\"\n\ndata A230 = A230\ninstance C A230 where\n    c A230 = \"A230\"\n\ndata A231 = A231\ninstance C A231 where\n    c A231 = \"A231\"\n\ndata A232 = A232\ninstance C A232 where\n    c A232 = \"A232\"\n\ndata A233 = A233\ninstance C A233 where\n    c A233 = \"A233\"\n\ndata A234 = A234\ninstance C A234 where\n    c A234 = \"A234\"\n\ndata A235 = A235\ninstance C A235 where\n    c A235 = \"A235\"\n\ndata A236 = A236\ninstance C A236 where\n    c A236 = \"A236\"\n\ndata A237 = A237\ninstance C A237 where\n    c A237 = \"A237\"\n\ndata A238 = A238\ninstance C A238 where\n    c A238 = \"A238\"\n\ndata A239 = A239\ninstance C A239 where\n    c A239 = \"A239\"\n\ndata A240 = A240\ninstance C A240 where\n    c A240 = \"A240\"\n\ndata A241 = A241\ninstance C A241 where\n    c A241 = \"A241\"\n\ndata A242 = A242\ninstance C A242 where\n    c A242 = \"A242\"\n\ndata A243 = A243\ninstance C A243 where\n    c A243 = \"A243\"\n\ndata A244 = A244\ninstance C A244 where\n    c A244 = \"A244\"\n\ndata A245 = A245\ninstance C A245 where\n    c A245 = \"A245\"\n\ndata A246 = A246\ninstance C A246 where\n    c A246 = \"A246\"\n\ndata A247 = A247\ninstance C A247 where\n    c A247 = \"A247\"\n\ndata A248 = A248\ninstance C A248 where\n    c A248 = \"A248\"\n\ndata A249 = A249\ninstance C A249 where\n    c A249 = \"A249\"\n\ndata A250 = A250\ninstance C A250 where\n    c A250 = \"A250\"\n\ndata A251 = A251\ninstance C A251 where\n    c A251 = \"A251\"\n\ndata A252 = A252\ninstance C A252 where\n    c A252 = \"A252\"\n\ndata A253 = A253\ninstance C A253 where\n    c A253 = \"A253\"\n\ndata A254 = A254\ninstance C A254 where\n    c A254 = \"A254\"\n\ndata A255 = A255\ninstance C A255 where\n    c A255 = \"A255\"\n\ndata A256 = A256\ninstance C A256 where\n    c A256 = \"A256\"\n\ndata A257 = A257\ninstance C A257 where\n    c A257 = \"A257\"\n\ndata A258 = A258\ninstance C A258 where\n    c A258 = \"A258\"\n\ndata A259 = A259\ninstance C A259 where\n    c A259 = \"A259\"\n\ndata A260 = A260\ninstance C A260 where\n    c A260 = \"A260\"\n\ndata A261 = A261\ninstance C A261 where\n    c A261 = \"A261\"\n\ndata A262 = A262\ninstance C A262 where\n    c A262 = \"A262\"\n\ndata A263 = A263\ninstance C A263 where\n    c A263 = \"A263\"\n\ndata A264 = A264\ninstance C A264 where\n    c A264 = \"A264\"\n\ndata A265 = A265\ninstance C A265 where\n    c A265 = \"A265\"\n\ndata A266 = A266\ninstance C A266 where\n    c A266 = \"A266\"\n\ndata A267 = A267\ninstance C A267 where\n    c A267 = \"A267\"\n\ndata A268 = A268\ninstance C A268 where\n    c A268 = \"A268\"\n\ndata A269 = A269\ninstance C A269 where\n    c A269 = \"A269\"\n\ndata A270 = A270\ninstance C A270 where\n    c A270 = \"A270\"\n\ndata A271 = A271\ninstance C A271 where\n    c A271 = \"A271\"\n\ndata A272 = A272\ninstance C A272 where\n    c A272 = \"A272\"\n\ndata A273 = A273\ninstance C A273 where\n    c A273 = \"A273\"\n\ndata A274 = A274\ninstance C A274 where\n    c A274 = \"A274\"\n\ndata A275 = A275\ninstance C A275 where\n    c A275 = \"A275\"\n\ndata A276 = A276\ninstance C A276 where\n    c A276 = \"A276\"\n\ndata A277 = A277\ninstance C A277 where\n    c A277 = \"A277\"\n\ndata A278 = A278\ninstance C A278 where\n    c A278 = \"A278\"\n\ndata A279 = A279\ninstance C A279 where\n    c A279 = \"A279\"\n\ndata A280 = A280\ninstance C A280 where\n    c A280 = \"A280\"\n\ndata A281 = A281\ninstance C A281 where\n    c A281 = \"A281\"\n\ndata A282 = A282\ninstance C A282 where\n    c A282 = \"A282\"\n\ndata A283 = A283\ninstance C A283 where\n    c A283 = \"A283\"\n\ndata A284 = A284\ninstance C A284 where\n    c A284 = \"A284\"\n\ndata A285 = A285\ninstance C A285 where\n    c A285 = \"A285\"\n\ndata A286 = A286\ninstance C A286 where\n    c A286 = \"A286\"\n\ndata A287 = A287\ninstance C A287 where\n    c A287 = \"A287\"\n\ndata A288 = A288\ninstance C A288 where\n    c A288 = \"A288\"\n\ndata A289 = A289\ninstance C A289 where\n    c A289 = \"A289\"\n\ndata A290 = A290\ninstance C A290 where\n    c A290 = \"A290\"\n\ndata A291 = A291\ninstance C A291 where\n    c A291 = \"A291\"\n\ndata A292 = A292\ninstance C A292 where\n    c A292 = \"A292\"\n\ndata A293 = A293\ninstance C A293 where\n    c A293 = \"A293\"\n\ndata A294 = A294\ninstance C A294 where\n    c A294 = \"A294\"\n\ndata A295 = A295\ninstance C A295 where\n    c A295 = \"A295\"\n\ndata A296 = A296\ninstance C A296 where\n    c A296 = \"A296\"\n\ndata A297 = A297\ninstance C A297 where\n    c A297 = \"A297\"\n\ndata A298 = A298\ninstance C A298 where\n    c A298 = \"A298\"\n\ndata A299 = A299\ninstance C A299 where\n    c A299 = \"A299\"\n\ndata A300 = A300\ninstance C A300 where\n    c A300 = \"A300\"\n\n", "num_lines": 1211}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE Rank2Types, TypeSynonymInstances, FlexibleInstances #-}\n{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}\n\nmodule T3064 where\nimport Control.Applicative\n\nnewtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }\n\ninstance Functor f => Functor (ReaderT r f) where\n  fmap f m = ReaderT $ (fmap f) . runReaderT m\n\ninstance Applicative f => Applicative (ReaderT r f) where\n  pure m   = ReaderT (const $ pure m)\n  f <*> v = ReaderT $ \\r -> runReaderT f r <*> runReaderT v r\n\ninstance (Monad m) => Monad (ReaderT r m) where\n    return a = ReaderT $ \\_ -> return a\n    m >>= k  = ReaderT $ \\r -> do\n        a <- runReaderT m r\n        runReaderT (k a) r\n    fail msg = ReaderT $ \\_ -> fail msg\n\nnewtype ResourceT r s m v = ResourceT { unResourceT :: ReaderT r m v }\n  deriving (Functor, Applicative, Monad)\n\ndata Ctx = Ctx\n\ndata Ch = Ch\n\ntype CAT s c = ResourceT [Ch] (s,c)\n\ntype CtxM c = ResourceT Ctx c IO\n\nnewtype CA s c v = CA { unCA :: CAT s c (CtxM c) v }\n  deriving (Functor, Applicative, Monad)\n\nclass (Monad m) => MonadCA m where\n  type CtxLabel m\n\ninstance MonadCA (CA s c) where\n  type CtxLabel (CA s c) = c\n\ninstance (Monad m, MonadCA m, c ~ CtxLabel m) => MonadCA  (CAT s c m) where\n  type CtxLabel (CAT s c m) = c\n\nrunCAT :: (forall s. CAT s c m v) -> m v\nrunCAT action = runReaderT (unResourceT action) []\n\nnewRgn :: MonadCA m => (forall s. CAT s (CtxLabel m) m v) -> m v\nnewRgn = runCAT\n\nrunCA :: (forall s c. CA s c v) -> IO v\nrunCA action = runCtxM (runCAT (unCA action))\n\nrunCtxM :: (forall c. CtxM c v) -> IO v\nrunCtxM action = runReaderT (unResourceT action) Ctx\n\n{-\n\ntest4 :: IO ()\ntest4 = runCA(newRgn(newRgn(newRgn(newRgn(return())))))\n\ntest11 :: IO ()\ntest11 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(return()))))))))))\n\ntest12 :: IO ()\ntest12 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(return())))))))))))\n\ntest13 :: IO ()\ntest13 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(return()))))))))))))\n\ntest14 :: IO ()\ntest14 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(return())))))))))))))\n\ntest28 :: IO ()\ntest28 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(return())))))))))))))))))))))))))\n-}\n\ntest56 :: IO ()\ntest56 = runCA(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(newRgn(\n               newRgn(newRgn(newRgn(newRgn(return())))))))))))))))))))))))))))))))))))))))))))))))))\n", "num_lines": 96}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata X = X\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  {-# UNPACK #-} !Double\n  deriving (Show)\n\nmain = print $ X 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1\n", "num_lines": 207}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4007 where\n\nf :: IO ()\nf = sequence_ (replicate 10 (putStrLn \"yes\"))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- main = print $ length [([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0)]\n\n-- 1.6G alloc\n-- main = print $ length [([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0)]\n\n-- 6G alloc\n-- main = print $ length [([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0)]\n\n-- 23G alloc\nmain = print $ length [([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0),([0,0,0],0)]\n\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, EmptyDataDecls, FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule SlowComp where\n\nimport Control.Monad\nimport Data.Kind\n\n-------------------------------------------------------------------------------\n-- Usual Peano integers.\n\n\nclass NatInt a where\n    natInt :: a -> Int\n\ndata D0 n = D0 {d0Arg :: n}\ndata D1 n = D1 {d1Arg :: n}\n\ndata C0\ndata C1\n\nclass DPosInt n where posInt :: n -> (Int,Int)\ninstance DPosInt () where posInt _ = (0,1)\ninstance DPosInt n => DPosInt (D0 n) where\n        posInt a = (dsum,w*2)\n                where\n                        (dsum,w) = posInt $ d0Arg a\ninstance DPosInt n => DPosInt (D1 n) where\n        posInt a = (dsum+w,w*2)\n                where\n                        (dsum,w) = posInt $ d1Arg a\n\ninstance NatInt () where natInt _ = 0\ninstance DPosInt n => NatInt (D0 n) where natInt a = fst $ posInt a\ninstance DPosInt n => NatInt (D1 n) where natInt a = fst $ posInt a\n\ntype family DRev a\ntype instance DRev a = DRev' a ()\n\ntype family DRev' x acc\ntype instance DRev' () acc = acc\ntype instance DRev' (D0 a) acc = DRev' a (D0 acc)\ntype instance DRev' (D1 a) acc = DRev' a (D1 acc)\n\ntype family DAddC c a b\ntype instance DAddC C0 (D0 a) (D0 b) = D0 (DAddC C0 a b)\ntype instance DAddC C0 (D1 a) (D0 b) = D1 (DAddC C0 a b)\ntype instance DAddC C0 (D0 a) (D1 b) = D1 (DAddC C0 a b)\ntype instance DAddC C0 (D1 a) (D1 b) = D0 (DAddC C1 a b)\ntype instance DAddC C1 (D0 a) (D0 b) = D1 (DAddC C0 a b)\ntype instance DAddC C1 (D1 a) (D0 b) = D0 (DAddC C1 a b)\ntype instance DAddC C1 (D0 a) (D1 b) = D0 (DAddC C1 a b)\ntype instance DAddC C1 (D1 a) (D1 b) = D1 (DAddC C1 a b)\ntype instance DAddC C0 ()     ()     = ()\ntype instance DAddC C1 ()     ()     = D1 ()\ntype instance DAddC c  (D0 a) ()     = DAddC c (D0 a) (D0 ())\ntype instance DAddC c  (D1 a) ()     = DAddC c (D1 a) (D0 ())\ntype instance DAddC c  ()     (D0 b) = DAddC c (D0 b) (D0 ())\ntype instance DAddC c  ()     (D1 b) = DAddC c (D1 b) (D0 ())\n\ntype family DNorm a\ntype instance DNorm () = D0 ()\ntype instance DNorm (D0 ()) = D0 ()\ntype instance DNorm (D0 (D1 a)) = D1 a\ntype instance DNorm (D0 (D0 a)) = DNorm a\ntype instance DNorm (D1 a) = D1 a\n\ntype family DPlus a b\ntype instance DPlus a b = DNorm (DRev (DAddC C0 (DRev a) (DRev b)))\n\ntype family DDepth a\ntype instance DDepth () = D0 ()\ntype instance DDepth (D0 ()) = D0 ()\ntype instance DDepth (D1 ()) = D1 ()\ntype instance DDepth (D1 (D0 n)) = DPlus ONE (DDepth (D1 n))\ntype instance DDepth (D1 (D1 n)) = DPlus ONE (DDepth (D1 n))\n\ntype family DLog2 a\ntype instance DLog2 a = DDepth a\n\ntype ZERO = D0 ()\n\ntype ONE = D1 ()\ntype TWO = DPlus ONE ONE\ntype THREE = DPlus ONE TWO\ntype FOUR = DPlus TWO TWO\ntype FIVE = DPlus ONE FOUR\ntype SIX = DPlus TWO FOUR\ntype SEVEN = DPlus ONE SIX\ntype EIGHT = DPlus FOUR FOUR\ntype NINE = DPlus FOUR FIVE\ntype TEN = DPlus EIGHT TWO\ntype SIZE8  = EIGHT\ntype SIZE9  = NINE\ntype SIZE10 = TEN\ntype SIZE12 = DPlus SIX SIX\ntype SIZE15 = DPlus EIGHT SEVEN\ntype SIZE16 = DPlus EIGHT EIGHT\ntype SIZE17 = DPlus ONE SIZE16\ntype SIZE24 = DPlus SIZE8 SIZE16\ntype SIZE32 = DPlus SIZE8 SIZE24\ntype SIZE30 = DPlus SIZE24 SIX\n\n-------------------------------------------------------------------------------\n-- Description of CPU.\n\nclass CPU cpu where\n        -- register address.\n        type RegAddrSize cpu\n        -- register width\n        type RegDataSize cpu\n        -- immediate width.\n        type ImmSize cpu\n        -- variables in CPU - register indices, command format variables, etc.\n        type CPUVars cpu :: Type -> Type\n\ndata Const size = Const Integer\n\ndata Var cpu size where\n        Temp :: Int -> Var cpu size\n        Var :: CPUVars cpu size -> Var cpu size\n\n-------------------------------------------------------------------------------\n-- Command description monad.\n\ndata Command cpu where\n        Command :: (Var cpu size) -> (Operation cpu size) -> Command cpu\n\ntype RegVar cpu = Var cpu (RegDataSize cpu)\ntype Immediate cpu = Const (ImmSize cpu)\n\ndata Operation cpu resultSize where\n        Add :: RegVar cpu -> Either (Immediate cpu) (RegVar cpu) -> Operation cpu (RegDataSize cpu)\n        Sub :: RegVar cpu -> Either (Immediate cpu) (RegVar cpu) -> Operation cpu (RegDataSize cpu)\n\ntype CDM cpu a = IO a\n\n($=) :: Var cpu size -> Operation cpu size -> CDM cpu ()\nvar $= op = undefined\n\ntempVar :: CDM cpu (Var cpu size)\ntempVar = do\n        cnt <- liftM fst undefined\n        return $ Temp cnt\n\nop :: Operation cpu size -> CDM cpu (Var cpu size)\nop operation = do\n        v <- tempVar\n        v $= operation\n        return v\n\n-------------------------------------------------------------------------------\n-- Dummy CPU.\n\ndata DummyCPU = DummyCPU\n\ndata DummyVar size where\n        DummyFlag :: Flag -> DummyVar ONE\n        DummyReg :: Int -> DummyVar SIZE16\n        DummyZero :: DummyVar SIZE16\n\ndata Flag = C | Z | N | V\n\ninstance CPU DummyCPU where\n        type RegAddrSize DummyCPU = FIVE\n        type RegDataSize DummyCPU = SIZE16\n        type ImmSize DummyCPU = SIZE12\n        type CPUVars DummyCPU = DummyVar\n\n-------------------------------------------------------------------------------\n-- Long compiling program.\n\n{-  cnst has very simple code, and should be fast to typecheck\n    But if you insist on normalising (Immediate DummyCPU) you get\n\n      Immediate DummyCPU =  Const (ImmSize DummyCPU)\n                         -> Const SIZE12\n                         =  Const (DPlus SIX SIX)\n                         ...etc...\n\nsimilarly for (RegVar DummyCPU).\n\nSo you get a lot of work and big coercions, for no gain.\n-}\n\ncnst :: Integer -> Either (Immediate DummyCPU) (RegVar DummyCPU)\ncnst x = Left (Const x)\n\nlongCompilingProgram :: CDM DummyCPU ()\nlongCompilingProgram = do\n-- the number of lines below greatly affects compilation time.\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        x10 <- op $ Add (Var DummyZero) (cnst 10)\n        return ()\n", "num_lines": 209}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -freduction-depth=1000 #-} \n{-# LANGUAGE \n     FlexibleContexts, FlexibleInstances, FunctionalDependencies, \n     MultiParamTypeClasses, TypeSynonymInstances, \n     TypeOperators, UndecidableInstances, TypeFamilies #-} \nmodule T5321FD where\n\n-------- USES FUNCTIONAL DEPENDENCIES -------------\n\n-- Our running example, for simplicity's sake, is a type-level map of a\n-- single function. For reference, here is the code for a simple\n-- value-level map of a single function.\n\n-- vfoo = id\n-- mapfoo (x : xs) = vfoo x : mapfoo xs\n-- mapfoo [] = []\n\n-- Because Haskell is a lazy language, this runs in O(n) time and constant stack.\n\n-- We now lift map to the type level, to operate over HLists.\n\n-- First, the basic HList types\n\ninfixr 3 :*\ndata x :* xs = x :* xs deriving Show\ndata HNil = HNil deriving Show\n\n-- Next, a large boring HList\n\n-- Adds ten cells\naddData x = i :* i :* d :* d :* s :* \n            i :* i :* d :* d :* s :* \n            x \n    where i = 1 :: Int \n          d = 1 :: Double \n          s = \"\" \n\n-- Has 70 cells. \nsampleData = addData $ addData $ addData $ addData $ addData $ \n             addData $ addData $ \n             HNil\n\n-- Next, a simple polymorphic function to map\n\nclass Foo x y | x -> y \n    where foo :: x -> y \n          foo = undefined\n\ninstance Foo Int Double\ninstance Foo Double Int\ninstance Foo String String\n\n------------------------\n-- Now, our map\n\nclass HMapFoo1 as bs | as -> bs where \n    hMapFoo1 :: as -> bs\n\ninstance (Foo a b, HMapFoo1 as bs) => HMapFoo1 (a :* as) (b :* bs) where \n    hMapFoo1 (x :* xs) = foo x :* hMapFoo1 xs\n\ninstance HMapFoo1 HNil HNil where \n    hMapFoo1 _ = HNil\n\n-- If we enable the following line, compilation time is ~ 9 seconds.\n\ntestHMapFoo1 = hMapFoo1 sampleData \n\n\n------------------------\nclass HMapFoo2 acc as bs | acc as -> bs where \n    hMapFoo2 :: acc -> as -> bs\n\ninstance (Foo a b, HMapFoo2 (b :* bs) as res) => HMapFoo2 bs (a :* as) res where \n    hMapFoo2 acc (x :* xs) = hMapFoo2 (foo x :* acc) xs\n\ninstance HMapFoo2 acc HNil acc where \n    hMapFoo2 acc _ = acc\n\n-- If we enable the following line, compilation time is a much more satisfying ~0.5s.\n\ntestHMapFoo2 = hMapFoo2 HNil sampleData \n\n------------------------\n-- But wait, there's trouble on the horizon! Consider the following version: \n\nclass HMapFoo3 acc as bs | acc as -> bs where \n    hMapFoo3 :: acc -> as -> bs\n\ninstance (HMapFoo3 (b :* bs) as res, Foo a b) => HMapFoo3 bs (a :* as) res where \n    hMapFoo3 acc (x :* xs) = hMapFoo3 (foo x :* acc) xs\n\ninstance HMapFoo3 acc HNil acc where \n    hMapFoo3 acc _ = acc\n\n-- The only difference between hMapFoo2 and hMapFoo3 is that the order of\n-- constraints on the inductive case has been reversed, with the\n-- recursive constraint first and the immediately checkable constraint\n-- second. Now, if we enable the following line, compilation time rockets\n-- to ~6s!\n\ntestHMapFoo3 = hMapFoo3 HNil sampleData \n", "num_lines": 103}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -freduction-depth=1000 #-} \n{-# LANGUAGE \n     FlexibleContexts, FlexibleInstances, FunctionalDependencies, \n     MultiParamTypeClasses, TypeSynonymInstances, \n     TypeOperators, UndecidableInstances, TypeFamilies #-} \nmodule T5321Fun where\n\n-- As the below code demonstrates, the same issues demonstrated with\n-- Functional Dependencies also appear with Type Families, although less\n--horribly, as their code-path seems more optimized in the current\n-- constraint solver:\n\n-- Our running example, for simplicity's sake, is a type-level map of a\n-- single function. For reference, here is the code for a simple\n-- value-level map of a single function.\n\n-- > vfoo = id\n-- > mapfoo (x : xs) = vfoo x : mapfoo xs\n-- > mapfoo [] = []\n\n-- Because Haskell is a lazy language, this runs in O(n) time and constant stack.\n\n-- We now lift map to the type level, to operate over HLists.\n\n-- First, the basic HList types\n\ninfixr 3 :*\ndata x :* xs = x :* xs deriving Show\ndata HNil = HNil deriving Show\n\n-- Next, a large boring HList\n\n-- Adds ten cells\naddData x = i :* i :* d :* d :* s :* \n            i :* i :* d :* d :* s :* \n            x \n    where i = 1 :: Int \n          d = 1 :: Double \n          s = \"\" \n\n-- Has 70 cells. \nsampleData = addData $ addData $ addData $ addData $ addData $ \n             addData $ addData $ \n             HNil\n\n\nclass TFoo x where \n     type TFooFun x \n     tfoo :: x -> TFooFun x \n     tfoo = undefined\n\ninstance TFoo Int where \n    type TFooFun Int = Double\ninstance TFoo Double where \n    type TFooFun Double = Int\ninstance TFoo String where \n    type TFooFun String = String\n\nclass THMapFoo1 as where \n      type THMapFoo1Res as \n      thMapFoo1 :: as -> THMapFoo1Res as\n\ninstance (TFoo a, THMapFoo1 as) => THMapFoo1 (a :* as) where \n    type THMapFoo1Res (a :* as) = TFooFun a :* THMapFoo1Res as \n    thMapFoo1 (x :* xs) = tfoo x :* thMapFoo1 xs\n\ninstance THMapFoo1 HNil where \n    type THMapFoo1Res HNil = HNil \n    thMapFoo1 _ = HNil\n\n-- The following, when enabled, takes ~3.5s. This demonstrates that slowdown occurs with type families as well.\n\ntestTHMapFoo1 = thMapFoo1 sampleData \n\nclass THMapFoo2 acc as where \n      type THMapFoo2Res acc as \n      thMapFoo2 :: acc -> as -> THMapFoo2Res acc as\n\ninstance (TFoo a, THMapFoo2 (TFooFun a :* acc) as) => THMapFoo2 acc (a :* as) where \n    type THMapFoo2Res acc (a :* as) = THMapFoo2Res (TFooFun a :* acc) as \n    thMapFoo2 acc (x :* xs) = thMapFoo2 (tfoo x :* acc) xs\n\ninstance THMapFoo2 acc HNil where \n    type THMapFoo2Res acc HNil = acc \n    thMapFoo2 acc _ = acc\n\n-- The following, when enabled, takes ~0.6s. This demonstrates that the\n-- tail recursive transform fixes the slowdown with type families just as\n-- with fundeps.\n\ntestTHMapFoo2 = thMapFoo2 HNil sampleData \n\nclass THMapFoo3 acc as where \n      type THMapFoo3Res acc as \n      thMapFoo3 :: acc -> as -> THMapFoo3Res acc as\n\ninstance (THMapFoo3 (TFooFun a :* acc) as, TFoo a) => THMapFoo3 acc (a :* as) where \n    type THMapFoo3Res acc (a :* as) = THMapFoo3Res (TFooFun a :* acc) as \n    thMapFoo3 acc (x :* xs) = thMapFoo3 (tfoo x :* acc) xs\n\ninstance THMapFoo3 acc HNil where \n    type THMapFoo3Res acc HNil = acc \n    thMapFoo3 acc _ = acc\n\n-- The following, when enabled, also takes ~0.6s. This demonstrates that,\n-- unlike the fundep case, the order of type class constraints does not,\n-- in this instance, affect the performance of type families.\n\ntestTHMapFoo3 = thMapFoo3 HNil sampleData \n", "num_lines": 110}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -w #-}\nimport Control.Monad(when)\nimport System.Exit\n\n-- parser produced by Happy Version 1.18.6\n\ndata HappyAbsSyn t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61\n\t= HappyTerminal (Char)\n\t| HappyErrorToken Int\n\t| HappyAbsSyn14 t14\n\t| HappyAbsSyn15 t15\n\t| HappyAbsSyn16 t16\n\t| HappyAbsSyn17 t17\n\t| HappyAbsSyn18 t18\n\t| HappyAbsSyn19 t19\n\t| HappyAbsSyn20 t20\n\t| HappyAbsSyn21 t21\n\t| HappyAbsSyn22 t22\n\t| HappyAbsSyn23 t23\n\t| HappyAbsSyn24 t24\n\t| HappyAbsSyn25 t25\n\t| HappyAbsSyn26 t26\n\t| HappyAbsSyn27 t27\n\t| HappyAbsSyn28 t28\n\t| HappyAbsSyn29 t29\n\t| HappyAbsSyn30 t30\n\t| HappyAbsSyn31 t31\n\t| HappyAbsSyn32 t32\n\t| HappyAbsSyn33 t33\n\t| HappyAbsSyn34 t34\n\t| HappyAbsSyn35 t35\n\t| HappyAbsSyn36 t36\n\t| HappyAbsSyn37 t37\n\t| HappyAbsSyn38 t38\n\t| HappyAbsSyn39 t39\n\t| HappyAbsSyn40 t40\n\t| HappyAbsSyn41 t41\n\t| HappyAbsSyn42 t42\n\t| HappyAbsSyn43 t43\n\t| HappyAbsSyn44 t44\n\t| HappyAbsSyn45 t45\n\t| HappyAbsSyn46 t46\n\t| HappyAbsSyn47 t47\n\t| HappyAbsSyn48 t48\n\t| HappyAbsSyn49 t49\n\t| HappyAbsSyn50 t50\n\t| HappyAbsSyn51 t51\n\t| HappyAbsSyn52 t52\n\t| HappyAbsSyn53 t53\n\t| HappyAbsSyn54 t54\n\t| HappyAbsSyn55 t55\n\t| HappyAbsSyn56 t56\n\t| HappyAbsSyn57 t57\n\t| HappyAbsSyn58 t58\n\t| HappyAbsSyn59 t59\n\t| HappyAbsSyn60 t60\n\t| HappyAbsSyn61 t61\n\naction_0 (62) = happyShift action_22\naction_0 (14) = happyGoto action_66\naction_0 (17) = happyGoto action_12\naction_0 (18) = happyGoto action_13\naction_0 (19) = happyGoto action_14\naction_0 (31) = happyGoto action_15\naction_0 (32) = happyGoto action_16\naction_0 (33) = happyGoto action_17\naction_0 (35) = happyGoto action_18\naction_0 (43) = happyGoto action_19\naction_0 (44) = happyGoto action_20\naction_0 (45) = happyGoto action_21\naction_0 _ = happyFail\n\naction_1 (62) = happyShift action_22\naction_1 (15) = happyGoto action_63\naction_1 (34) = happyGoto action_64\naction_1 (35) = happyGoto action_65\naction_1 _ = happyReduce_32\n\naction_2 (62) = happyShift action_62\naction_2 (16) = happyGoto action_56\naction_2 (25) = happyGoto action_57\naction_2 (36) = happyGoto action_58\naction_2 (46) = happyGoto action_59\naction_2 (53) = happyGoto action_60\naction_2 (60) = happyGoto action_61\naction_2 _ = happyReduce_35\n\naction_3 (62) = happyShift action_22\naction_3 (17) = happyGoto action_55\naction_3 (18) = happyGoto action_13\naction_3 (19) = happyGoto action_14\naction_3 (32) = happyGoto action_16\naction_3 (33) = happyGoto action_17\naction_3 (35) = happyGoto action_18\naction_3 (44) = happyGoto action_20\naction_3 (45) = happyGoto action_21\naction_3 _ = happyFail\n\naction_4 (62) = happyShift action_22\naction_4 (18) = happyGoto action_54\naction_4 (19) = happyGoto action_14\naction_4 (33) = happyGoto action_17\naction_4 (35) = happyGoto action_18\naction_4 (45) = happyGoto action_21\naction_4 _ = happyFail\n\naction_5 (62) = happyShift action_22\naction_5 (19) = happyGoto action_53\naction_5 (35) = happyGoto action_18\naction_5 _ = happyFail\n\naction_6 (62) = happyShift action_52\naction_6 (20) = happyGoto action_47\naction_6 (26) = happyGoto action_48\naction_6 (38) = happyGoto action_49\naction_6 (47) = happyGoto action_50\naction_6 (55) = happyGoto action_51\naction_6 _ = happyFail\n\naction_7 (62) = happyShift action_46\naction_7 (21) = happyGoto action_41\naction_7 (27) = happyGoto action_42\naction_7 (39) = happyGoto action_43\naction_7 (48) = happyGoto action_44\naction_7 (56) = happyGoto action_45\naction_7 _ = happyFail\n\naction_8 (62) = happyShift action_40\naction_8 (22) = happyGoto action_35\naction_8 (28) = happyGoto action_36\naction_8 (40) = happyGoto action_37\naction_8 (49) = happyGoto action_38\naction_8 (57) = happyGoto action_39\naction_8 _ = happyFail\n\naction_9 (62) = happyShift action_34\naction_9 (23) = happyGoto action_29\naction_9 (29) = happyGoto action_30\naction_9 (41) = happyGoto action_31\naction_9 (50) = happyGoto action_32\naction_9 (58) = happyGoto action_33\naction_9 _ = happyFail\n\naction_10 (62) = happyShift action_28\naction_10 (24) = happyGoto action_23\naction_10 (30) = happyGoto action_24\naction_10 (42) = happyGoto action_25\naction_10 (51) = happyGoto action_26\naction_10 (59) = happyGoto action_27\naction_10 _ = happyFail\n\naction_11 (62) = happyShift action_22\naction_11 (17) = happyGoto action_12\naction_11 (18) = happyGoto action_13\naction_11 (19) = happyGoto action_14\naction_11 (31) = happyGoto action_15\naction_11 (32) = happyGoto action_16\naction_11 (33) = happyGoto action_17\naction_11 (35) = happyGoto action_18\naction_11 (43) = happyGoto action_19\naction_11 (44) = happyGoto action_20\naction_11 (45) = happyGoto action_21\naction_11 _ = happyFail\n\naction_12 _ = happyReduce_43\n\naction_13 _ = happyReduce_45\n\naction_14 _ = happyReduce_47\n\naction_15 _ = happyReduce_11\n\naction_16 _ = happyReduce_14\n\naction_17 _ = happyReduce_15\n\naction_18 _ = happyReduce_16\n\naction_19 (62) = happyShift action_22\naction_19 (17) = happyGoto action_86\naction_19 (18) = happyGoto action_13\naction_19 (19) = happyGoto action_14\naction_19 (32) = happyGoto action_16\naction_19 (33) = happyGoto action_17\naction_19 (35) = happyGoto action_18\naction_19 (44) = happyGoto action_20\naction_19 (45) = happyGoto action_21\naction_19 _ = happyReduce_28\n\naction_20 (62) = happyShift action_22\naction_20 (18) = happyGoto action_85\naction_20 (19) = happyGoto action_14\naction_20 (33) = happyGoto action_17\naction_20 (35) = happyGoto action_18\naction_20 (45) = happyGoto action_21\naction_20 _ = happyReduce_29\n\naction_21 (62) = happyShift action_22\naction_21 (19) = happyGoto action_84\naction_21 (35) = happyGoto action_18\naction_21 _ = happyReduce_30\n\naction_22 (63) = happyShift action_83\naction_22 (37) = happyGoto action_79\naction_22 (52) = happyGoto action_80\naction_22 (54) = happyGoto action_81\naction_22 (61) = happyGoto action_82\naction_22 _ = happyReduce_37\n\naction_23 (64) = happyAccept\naction_23 _ = happyFail\n\naction_24 _ = happyReduce_21\n\naction_25 _ = happyReduce_27\n\naction_26 _ = happyReduce_66\n\naction_27 (62) = happyShift action_28\naction_27 (51) = happyGoto action_78\naction_27 _ = happyReduce_42\n\naction_28 (62) = happyShift action_22\naction_28 (19) = happyGoto action_77\naction_28 (35) = happyGoto action_18\naction_28 _ = happyFail\n\naction_29 (64) = happyAccept\naction_29 _ = happyFail\n\naction_30 _ = happyReduce_20\n\naction_31 _ = happyReduce_26\n\naction_32 _ = happyReduce_64\n\naction_33 (62) = happyShift action_34\naction_33 (50) = happyGoto action_76\naction_33 _ = happyReduce_41\n\naction_34 (62) = happyShift action_22\naction_34 (18) = happyGoto action_75\naction_34 (19) = happyGoto action_14\naction_34 (33) = happyGoto action_17\naction_34 (35) = happyGoto action_18\naction_34 (45) = happyGoto action_21\naction_34 _ = happyFail\n\naction_35 (64) = happyAccept\naction_35 _ = happyFail\n\naction_36 _ = happyReduce_19\n\naction_37 _ = happyReduce_25\n\naction_38 _ = happyReduce_62\n\naction_39 (62) = happyShift action_40\naction_39 (49) = happyGoto action_74\naction_39 _ = happyReduce_40\n\naction_40 (62) = happyShift action_22\naction_40 (17) = happyGoto action_73\naction_40 (18) = happyGoto action_13\naction_40 (19) = happyGoto action_14\naction_40 (32) = happyGoto action_16\naction_40 (33) = happyGoto action_17\naction_40 (35) = happyGoto action_18\naction_40 (44) = happyGoto action_20\naction_40 (45) = happyGoto action_21\naction_40 _ = happyFail\n\naction_41 (64) = happyAccept\naction_41 _ = happyFail\n\naction_42 _ = happyReduce_18\n\naction_43 _ = happyReduce_24\n\naction_44 _ = happyReduce_60\n\naction_45 (62) = happyShift action_46\naction_45 (48) = happyGoto action_72\naction_45 _ = happyReduce_39\n\naction_46 (62) = happyShift action_62\naction_46 (16) = happyGoto action_71\naction_46 (25) = happyGoto action_57\naction_46 (36) = happyGoto action_58\naction_46 (46) = happyGoto action_59\naction_46 (53) = happyGoto action_60\naction_46 (60) = happyGoto action_61\naction_46 _ = happyReduce_35\n\naction_47 (64) = happyAccept\naction_47 _ = happyFail\n\naction_48 _ = happyReduce_17\n\naction_49 _ = happyReduce_23\n\naction_50 _ = happyReduce_58\n\naction_51 (62) = happyShift action_52\naction_51 (47) = happyGoto action_70\naction_51 _ = happyReduce_38\n\naction_52 (62) = happyShift action_22\naction_52 (15) = happyGoto action_69\naction_52 (34) = happyGoto action_64\naction_52 (35) = happyGoto action_65\naction_52 _ = happyReduce_32\n\naction_53 (64) = happyAccept\naction_53 _ = happyFail\n\naction_54 (64) = happyAccept\naction_54 _ = happyFail\n\naction_55 (64) = happyAccept\naction_55 _ = happyFail\n\naction_56 (64) = happyAccept\naction_56 _ = happyFail\n\naction_57 _ = happyReduce_13\n\naction_58 _ = happyReduce_22\n\naction_59 _ = happyReduce_68\n\naction_60 _ = happyReduce_34\n\naction_61 (62) = happyShift action_62\naction_61 (46) = happyGoto action_68\naction_61 _ = happyReduce_56\n\naction_62 (63) = happyShift action_67\naction_62 _ = happyFail\n\naction_63 (64) = happyAccept\naction_63 _ = happyFail\n\naction_64 _ = happyReduce_12\n\naction_65 _ = happyReduce_31\n\naction_66 (64) = happyAccept\naction_66 _ = happyFail\n\naction_67 _ = happyReduce_49\n\naction_68 _ = happyReduce_69\n\naction_69 _ = happyReduce_50\n\naction_70 _ = happyReduce_59\n\naction_71 _ = happyReduce_51\n\naction_72 _ = happyReduce_61\n\naction_73 _ = happyReduce_52\n\naction_74 _ = happyReduce_63\n\naction_75 _ = happyReduce_53\n\naction_76 _ = happyReduce_65\n\naction_77 _ = happyReduce_54\n\naction_78 _ = happyReduce_67\n\naction_79 _ = happyReduce_33\n\naction_80 _ = happyReduce_70\n\naction_81 _ = happyReduce_36\n\naction_82 (63) = happyShift action_83\naction_82 (52) = happyGoto action_88\naction_82 _ = happyReduce_57\n\naction_83 (62) = happyShift action_87\naction_83 _ = happyFail\n\naction_84 _ = happyReduce_48\n\naction_85 _ = happyReduce_46\n\naction_86 _ = happyReduce_44\n\naction_87 _ = happyReduce_55\n\naction_88 _ = happyReduce_71\n\nhappyReduce_11 = happySpecReduce_1  14 happyReduction_11\nhappyReduction_11 (HappyAbsSyn31  happy_var_1)\n\t =  HappyAbsSyn14\n\t\t (happy_var_1\n\t)\nhappyReduction_11 _  = notHappyAtAll \n\nhappyReduce_12 = happySpecReduce_1  15 happyReduction_12\nhappyReduction_12 (HappyAbsSyn34  happy_var_1)\n\t =  HappyAbsSyn15\n\t\t (happy_var_1\n\t)\nhappyReduction_12 _  = notHappyAtAll \n\nhappyReduce_13 = happySpecReduce_1  16 happyReduction_13\nhappyReduction_13 (HappyAbsSyn25  happy_var_1)\n\t =  HappyAbsSyn16\n\t\t (happy_var_1\n\t)\nhappyReduction_13 _  = notHappyAtAll \n\nhappyReduce_14 = happySpecReduce_1  17 happyReduction_14\nhappyReduction_14 (HappyAbsSyn32  happy_var_1)\n\t =  HappyAbsSyn17\n\t\t (happy_var_1\n\t)\nhappyReduction_14 _  = notHappyAtAll \n\nhappyReduce_15 = happySpecReduce_1  18 happyReduction_15\nhappyReduction_15 (HappyAbsSyn33  happy_var_1)\n\t =  HappyAbsSyn18\n\t\t (happy_var_1\n\t)\nhappyReduction_15 _  = notHappyAtAll \n\nhappyReduce_16 = happySpecReduce_1  19 happyReduction_16\nhappyReduction_16 (HappyAbsSyn35  happy_var_1)\n\t =  HappyAbsSyn19\n\t\t (happy_var_1\n\t)\nhappyReduction_16 _  = notHappyAtAll \n\nhappyReduce_17 = happySpecReduce_1  20 happyReduction_17\nhappyReduction_17 (HappyAbsSyn26  happy_var_1)\n\t =  HappyAbsSyn20\n\t\t (happy_var_1\n\t)\nhappyReduction_17 _  = notHappyAtAll \n\nhappyReduce_18 = happySpecReduce_1  21 happyReduction_18\nhappyReduction_18 (HappyAbsSyn27  happy_var_1)\n\t =  HappyAbsSyn21\n\t\t (happy_var_1\n\t)\nhappyReduction_18 _  = notHappyAtAll \n\nhappyReduce_19 = happySpecReduce_1  22 happyReduction_19\nhappyReduction_19 (HappyAbsSyn28  happy_var_1)\n\t =  HappyAbsSyn22\n\t\t (happy_var_1\n\t)\nhappyReduction_19 _  = notHappyAtAll \n\nhappyReduce_20 = happySpecReduce_1  23 happyReduction_20\nhappyReduction_20 (HappyAbsSyn29  happy_var_1)\n\t =  HappyAbsSyn23\n\t\t (happy_var_1\n\t)\nhappyReduction_20 _  = notHappyAtAll \n\nhappyReduce_21 = happySpecReduce_1  24 happyReduction_21\nhappyReduction_21 (HappyAbsSyn30  happy_var_1)\n\t =  HappyAbsSyn24\n\t\t (happy_var_1\n\t)\nhappyReduction_21 _  = notHappyAtAll \n\nhappyReduce_22 = happySpecReduce_1  25 happyReduction_22\nhappyReduction_22 (HappyAbsSyn36  happy_var_1)\n\t =  HappyAbsSyn25\n\t\t (happy_var_1\n\t)\nhappyReduction_22 _  = notHappyAtAll \n\nhappyReduce_23 = happySpecReduce_1  26 happyReduction_23\nhappyReduction_23 (HappyAbsSyn38  happy_var_1)\n\t =  HappyAbsSyn26\n\t\t (happy_var_1\n\t)\nhappyReduction_23 _  = notHappyAtAll \n\nhappyReduce_24 = happySpecReduce_1  27 happyReduction_24\nhappyReduction_24 (HappyAbsSyn39  happy_var_1)\n\t =  HappyAbsSyn27\n\t\t (happy_var_1\n\t)\nhappyReduction_24 _  = notHappyAtAll \n\nhappyReduce_25 = happySpecReduce_1  28 happyReduction_25\nhappyReduction_25 (HappyAbsSyn40  happy_var_1)\n\t =  HappyAbsSyn28\n\t\t (happy_var_1\n\t)\nhappyReduction_25 _  = notHappyAtAll \n\nhappyReduce_26 = happySpecReduce_1  29 happyReduction_26\nhappyReduction_26 (HappyAbsSyn41  happy_var_1)\n\t =  HappyAbsSyn29\n\t\t (happy_var_1\n\t)\nhappyReduction_26 _  = notHappyAtAll \n\nhappyReduce_27 = happySpecReduce_1  30 happyReduction_27\nhappyReduction_27 (HappyAbsSyn42  happy_var_1)\n\t =  HappyAbsSyn30\n\t\t (happy_var_1\n\t)\nhappyReduction_27 _  = notHappyAtAll \n\nhappyReduce_28 = happySpecReduce_1  31 happyReduction_28\nhappyReduction_28 (HappyAbsSyn43  happy_var_1)\n\t =  HappyAbsSyn31\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_28 _  = notHappyAtAll \n\nhappyReduce_29 = happySpecReduce_1  32 happyReduction_29\nhappyReduction_29 (HappyAbsSyn44  happy_var_1)\n\t =  HappyAbsSyn32\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_29 _  = notHappyAtAll \n\nhappyReduce_30 = happySpecReduce_1  33 happyReduction_30\nhappyReduction_30 (HappyAbsSyn45  happy_var_1)\n\t =  HappyAbsSyn33\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_30 _  = notHappyAtAll \n\nhappyReduce_31 = happySpecReduce_1  34 happyReduction_31\nhappyReduction_31 (HappyAbsSyn35  happy_var_1)\n\t =  HappyAbsSyn34\n\t\t (happy_var_1\n\t)\nhappyReduction_31 _  = notHappyAtAll \n\nhappyReduce_32 = happySpecReduce_0  34 happyReduction_32\nhappyReduction_32  =  HappyAbsSyn34\n\t\t ([]\n\t)\n\nhappyReduce_33 = happySpecReduce_2  35 happyReduction_33\nhappyReduction_33 (HappyAbsSyn37  happy_var_2)\n\t(HappyTerminal happy_var_1)\n\t =  HappyAbsSyn35\n\t\t (happy_var_1 : happy_var_2\n\t)\nhappyReduction_33 _ _  = notHappyAtAll \n\nhappyReduce_34 = happySpecReduce_1  36 happyReduction_34\nhappyReduction_34 (HappyAbsSyn53  happy_var_1)\n\t =  HappyAbsSyn36\n\t\t (happy_var_1\n\t)\nhappyReduction_34 _  = notHappyAtAll \n\nhappyReduce_35 = happySpecReduce_0  36 happyReduction_35\nhappyReduction_35  =  HappyAbsSyn36\n\t\t ([]\n\t)\n\nhappyReduce_36 = happySpecReduce_1  37 happyReduction_36\nhappyReduction_36 (HappyAbsSyn54  happy_var_1)\n\t =  HappyAbsSyn37\n\t\t (happy_var_1\n\t)\nhappyReduction_36 _  = notHappyAtAll \n\nhappyReduce_37 = happySpecReduce_0  37 happyReduction_37\nhappyReduction_37  =  HappyAbsSyn37\n\t\t ([]\n\t)\n\nhappyReduce_38 = happySpecReduce_1  38 happyReduction_38\nhappyReduction_38 (HappyAbsSyn55  happy_var_1)\n\t =  HappyAbsSyn38\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_38 _  = notHappyAtAll \n\nhappyReduce_39 = happySpecReduce_1  39 happyReduction_39\nhappyReduction_39 (HappyAbsSyn56  happy_var_1)\n\t =  HappyAbsSyn39\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_39 _  = notHappyAtAll \n\nhappyReduce_40 = happySpecReduce_1  40 happyReduction_40\nhappyReduction_40 (HappyAbsSyn57  happy_var_1)\n\t =  HappyAbsSyn40\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_40 _  = notHappyAtAll \n\nhappyReduce_41 = happySpecReduce_1  41 happyReduction_41\nhappyReduction_41 (HappyAbsSyn58  happy_var_1)\n\t =  HappyAbsSyn41\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_41 _  = notHappyAtAll \n\nhappyReduce_42 = happySpecReduce_1  42 happyReduction_42\nhappyReduction_42 (HappyAbsSyn59  happy_var_1)\n\t =  HappyAbsSyn42\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_42 _  = notHappyAtAll \n\nhappyReduce_43 = happySpecReduce_1  43 happyReduction_43\nhappyReduction_43 (HappyAbsSyn17  happy_var_1)\n\t =  HappyAbsSyn43\n\t\t ([happy_var_1]\n\t)\nhappyReduction_43 _  = notHappyAtAll \n\nhappyReduce_44 = happySpecReduce_2  43 happyReduction_44\nhappyReduction_44 (HappyAbsSyn17  happy_var_2)\n\t(HappyAbsSyn43  happy_var_1)\n\t =  HappyAbsSyn43\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_44 _ _  = notHappyAtAll \n\nhappyReduce_45 = happySpecReduce_1  44 happyReduction_45\nhappyReduction_45 (HappyAbsSyn18  happy_var_1)\n\t =  HappyAbsSyn44\n\t\t ([happy_var_1]\n\t)\nhappyReduction_45 _  = notHappyAtAll \n\nhappyReduce_46 = happySpecReduce_2  44 happyReduction_46\nhappyReduction_46 (HappyAbsSyn18  happy_var_2)\n\t(HappyAbsSyn44  happy_var_1)\n\t =  HappyAbsSyn44\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_46 _ _  = notHappyAtAll \n\nhappyReduce_47 = happySpecReduce_1  45 happyReduction_47\nhappyReduction_47 (HappyAbsSyn19  happy_var_1)\n\t =  HappyAbsSyn45\n\t\t ([happy_var_1]\n\t)\nhappyReduction_47 _  = notHappyAtAll \n\nhappyReduce_48 = happySpecReduce_2  45 happyReduction_48\nhappyReduction_48 (HappyAbsSyn19  happy_var_2)\n\t(HappyAbsSyn45  happy_var_1)\n\t =  HappyAbsSyn45\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_48 _ _  = notHappyAtAll \n\nhappyReduce_49 = happySpecReduce_2  46 happyReduction_49\nhappyReduction_49 _\n\t(HappyTerminal happy_var_1)\n\t =  HappyAbsSyn46\n\t\t (happy_var_1\n\t)\nhappyReduction_49 _ _  = notHappyAtAll \n\nhappyReduce_50 = happySpecReduce_2  47 happyReduction_50\nhappyReduction_50 _\n\t(HappyTerminal happy_var_1)\n\t =  HappyAbsSyn47\n\t\t (happy_var_1\n\t)\nhappyReduction_50 _ _  = notHappyAtAll \n\nhappyReduce_51 = happySpecReduce_2  48 happyReduction_51\nhappyReduction_51 _\n\t(HappyTerminal happy_var_1)\n\t =  HappyAbsSyn48\n\t\t (happy_var_1\n\t)\nhappyReduction_51 _ _  = notHappyAtAll \n\nhappyReduce_52 = happySpecReduce_2  49 happyReduction_52\nhappyReduction_52 _\n\t(HappyTerminal happy_var_1)\n\t =  HappyAbsSyn49\n\t\t (happy_var_1\n\t)\nhappyReduction_52 _ _  = notHappyAtAll \n\nhappyReduce_53 = happySpecReduce_2  50 happyReduction_53\nhappyReduction_53 _\n\t(HappyTerminal happy_var_1)\n\t =  HappyAbsSyn50\n\t\t (happy_var_1\n\t)\nhappyReduction_53 _ _  = notHappyAtAll \n\nhappyReduce_54 = happySpecReduce_2  51 happyReduction_54\nhappyReduction_54 _\n\t(HappyTerminal happy_var_1)\n\t =  HappyAbsSyn51\n\t\t (happy_var_1\n\t)\nhappyReduction_54 _ _  = notHappyAtAll \n\nhappyReduce_55 = happySpecReduce_2  52 happyReduction_55\nhappyReduction_55 (HappyTerminal happy_var_2)\n\t_\n\t =  HappyAbsSyn52\n\t\t (happy_var_2\n\t)\nhappyReduction_55 _ _  = notHappyAtAll \n\nhappyReduce_56 = happySpecReduce_1  53 happyReduction_56\nhappyReduction_56 (HappyAbsSyn60  happy_var_1)\n\t =  HappyAbsSyn53\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_56 _  = notHappyAtAll \n\nhappyReduce_57 = happySpecReduce_1  54 happyReduction_57\nhappyReduction_57 (HappyAbsSyn61  happy_var_1)\n\t =  HappyAbsSyn54\n\t\t (reverse happy_var_1\n\t)\nhappyReduction_57 _  = notHappyAtAll \n\nhappyReduce_58 = happySpecReduce_1  55 happyReduction_58\nhappyReduction_58 (HappyAbsSyn47  happy_var_1)\n\t =  HappyAbsSyn55\n\t\t ([happy_var_1]\n\t)\nhappyReduction_58 _  = notHappyAtAll \n\nhappyReduce_59 = happySpecReduce_2  55 happyReduction_59\nhappyReduction_59 (HappyAbsSyn47  happy_var_2)\n\t(HappyAbsSyn55  happy_var_1)\n\t =  HappyAbsSyn55\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_59 _ _  = notHappyAtAll \n\nhappyReduce_60 = happySpecReduce_1  56 happyReduction_60\nhappyReduction_60 (HappyAbsSyn48  happy_var_1)\n\t =  HappyAbsSyn56\n\t\t ([happy_var_1]\n\t)\nhappyReduction_60 _  = notHappyAtAll \n\nhappyReduce_61 = happySpecReduce_2  56 happyReduction_61\nhappyReduction_61 (HappyAbsSyn48  happy_var_2)\n\t(HappyAbsSyn56  happy_var_1)\n\t =  HappyAbsSyn56\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_61 _ _  = notHappyAtAll \n\nhappyReduce_62 = happySpecReduce_1  57 happyReduction_62\nhappyReduction_62 (HappyAbsSyn49  happy_var_1)\n\t =  HappyAbsSyn57\n\t\t ([happy_var_1]\n\t)\nhappyReduction_62 _  = notHappyAtAll \n\nhappyReduce_63 = happySpecReduce_2  57 happyReduction_63\nhappyReduction_63 (HappyAbsSyn49  happy_var_2)\n\t(HappyAbsSyn57  happy_var_1)\n\t =  HappyAbsSyn57\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_63 _ _  = notHappyAtAll \n\nhappyReduce_64 = happySpecReduce_1  58 happyReduction_64\nhappyReduction_64 (HappyAbsSyn50  happy_var_1)\n\t =  HappyAbsSyn58\n\t\t ([happy_var_1]\n\t)\nhappyReduction_64 _  = notHappyAtAll \n\nhappyReduce_65 = happySpecReduce_2  58 happyReduction_65\nhappyReduction_65 (HappyAbsSyn50  happy_var_2)\n\t(HappyAbsSyn58  happy_var_1)\n\t =  HappyAbsSyn58\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_65 _ _  = notHappyAtAll \n\nhappyReduce_66 = happySpecReduce_1  59 happyReduction_66\nhappyReduction_66 (HappyAbsSyn51  happy_var_1)\n\t =  HappyAbsSyn59\n\t\t ([happy_var_1]\n\t)\nhappyReduction_66 _  = notHappyAtAll \n\nhappyReduce_67 = happySpecReduce_2  59 happyReduction_67\nhappyReduction_67 (HappyAbsSyn51  happy_var_2)\n\t(HappyAbsSyn59  happy_var_1)\n\t =  HappyAbsSyn59\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_67 _ _  = notHappyAtAll \n\nhappyReduce_68 = happySpecReduce_1  60 happyReduction_68\nhappyReduction_68 (HappyAbsSyn46  happy_var_1)\n\t =  HappyAbsSyn60\n\t\t ([happy_var_1]\n\t)\nhappyReduction_68 _  = notHappyAtAll \n\nhappyReduce_69 = happySpecReduce_2  60 happyReduction_69\nhappyReduction_69 (HappyAbsSyn46  happy_var_2)\n\t(HappyAbsSyn60  happy_var_1)\n\t =  HappyAbsSyn60\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_69 _ _  = notHappyAtAll \n\nhappyReduce_70 = happySpecReduce_1  61 happyReduction_70\nhappyReduction_70 (HappyAbsSyn52  happy_var_1)\n\t =  HappyAbsSyn61\n\t\t ([happy_var_1]\n\t)\nhappyReduction_70 _  = notHappyAtAll \n\nhappyReduce_71 = happySpecReduce_2  61 happyReduction_71\nhappyReduction_71 (HappyAbsSyn52  happy_var_2)\n\t(HappyAbsSyn61  happy_var_1)\n\t =  HappyAbsSyn61\n\t\t (happy_var_2 : happy_var_1\n\t)\nhappyReduction_71 _ _  = notHappyAtAll \n\nhappyNewToken action sts stk [] =\n\taction 64 64 notHappyAtAll (HappyState action) sts stk []\n\nhappyNewToken action sts stk (tk:tks) =\n\tlet cont i = action i i tk (HappyState action) sts stk tks in\n\tcase tk of {\n\t'a' -> cont 62;\n\t'b' -> cont 63;\n\t_ -> happyError' (tk:tks)\n\t}\n\nhappyError_ tk tks = happyError' (tk:tks)\n\nhappyThen :: () => Maybe a -> (a -> Maybe b) -> Maybe b\nhappyThen = ((>>=))\nhappyReturn :: () => a -> Maybe a\nhappyReturn = (return)\nhappyThen1 m k tks = ((>>=)) m (\\a -> k a tks)\nhappyReturn1 :: () => a -> b -> Maybe a\nhappyReturn1 = \\a tks -> (return) a\nhappyError' :: () => [(Char)] -> Maybe a\nhappyError' = happyError\n\ntest0 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_0 tks) (\\x -> case x of {HappyAbsSyn14 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest1 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_1 tks) (\\x -> case x of {HappyAbsSyn15 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest2 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_2 tks) (\\x -> case x of {HappyAbsSyn16 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest3 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_3 tks) (\\x -> case x of {HappyAbsSyn17 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest4 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_4 tks) (\\x -> case x of {HappyAbsSyn18 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest5 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_5 tks) (\\x -> case x of {HappyAbsSyn19 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest6 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_6 tks) (\\x -> case x of {HappyAbsSyn20 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest7 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_7 tks) (\\x -> case x of {HappyAbsSyn21 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest8 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_8 tks) (\\x -> case x of {HappyAbsSyn22 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest9 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_9 tks) (\\x -> case x of {HappyAbsSyn23 z -> happyReturn z; _other -> notHappyAtAll })\n\ntest10 tks = happySomeParser where\n  happySomeParser = happyThen (happyParse action_10 tks) (\\x -> case x of {HappyAbsSyn24 z -> happyReturn z; _other -> notHappyAtAll })\n\nhappySeq = happyDontSeq\n\n\nhappyError _  = Nothing\n\ntests         = [ test1 \"\"      == Just \"\"\n                , test1 \"a\"     == Just \"a\"\n                , test1 \"ab\"    == Nothing\n                , test1 \"aba\"   == Just \"aa\"\n                , test1 \"abab\"  == Nothing\n\n                , test2 \"\"      == Just \"\"\n                , test2 \"a\"     == Nothing\n                , test2 \"ab\"    == Just \"a\"\n                , test2 \"aba\"   == Nothing\n                , test2 \"abab\"  == Just \"aa\"\n                ]\n\nmain        = do let failed = filter (not . snd) (zip [0..] tests)\n                 when (not (null failed)) $\n                   do putStrLn (\"Failed tests: \" ++ show (map fst failed))\n                      exitFailure\n                 putStrLn \"Tests passed.\"\n{-# LINE 1 \"templates/GenericTemplate.hs\" #-}\n{-# LINE 1 \"templates/GenericTemplate.hs\" #-}\n{-# LINE 1 \"<built-in>\" #-}\n{-# LINE 1 \"<command-line>\" #-}\n{-# LINE 1 \"templates/GenericTemplate.hs\" #-}\n-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp \n\n{-# LINE 30 \"templates/GenericTemplate.hs\" #-}\n\n\n\n\n\n\n\n\n{-# LINE 51 \"templates/GenericTemplate.hs\" #-}\n\n{-# LINE 61 \"templates/GenericTemplate.hs\" #-}\n\n{-# LINE 70 \"templates/GenericTemplate.hs\" #-}\n\ninfixr 9 `HappyStk`\ndata HappyStk a = HappyStk a (HappyStk a)\n\n-----------------------------------------------------------------------------\n-- starting the parse\n\nhappyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll\n\n-----------------------------------------------------------------------------\n-- Accepting the parse\n\n-- If the current token is (1), it means we've just accepted a partial\n-- parse (a %partial parser).  We must ignore the saved token on the top of\n-- the stack in this case.\nhappyAccept (1) tk st sts (_ `HappyStk` ans `HappyStk` _) =\n\thappyReturn1 ans\nhappyAccept j tk st sts (HappyStk ans _) = \n\t (happyReturn1 ans)\n\n-----------------------------------------------------------------------------\n-- Arrays only: do the next action\n\n{-# LINE 148 \"templates/GenericTemplate.hs\" #-}\n\n-----------------------------------------------------------------------------\n-- HappyState data type (not arrays)\n\n\n\nnewtype HappyState b c = HappyState\n        (Int ->                    -- token number\n         Int ->                    -- token number (yes, again)\n         b ->                           -- token semantic value\n         HappyState b c ->              -- current state\n         [HappyState b c] ->            -- state stack\n         c)\n\n\n\n-----------------------------------------------------------------------------\n-- Shifting a token\n\nhappyShift new_state (1) tk st sts stk@(x `HappyStk` _) =\n     let (i) = (case x of { HappyErrorToken (i) -> i }) in\n--     trace \"shifting the error token\" $\n     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)\n\nhappyShift new_state i tk st sts stk =\n     happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)\n\n-- happyReduce is specialised for the common cases.\n\nhappySpecReduce_0 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk\n     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)\n\nhappySpecReduce_1 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')\n     = let r = fn v1 in\n       happySeq r (action nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_2 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')\n     = let r = fn v1 v2 in\n       happySeq r (action nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_3 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')\n     = let r = fn v1 v2 v3 in\n       happySeq r (action nt j tk st sts (r `HappyStk` stk'))\n\nhappyReduce k i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappyReduce k nt fn j tk st sts stk\n     = case happyDrop (k - ((1) :: Int)) sts of\n\t sts1@(((st1@(HappyState (action))):(_))) ->\n        \tlet r = fn stk in  -- it doesn't hurt to always seq here...\n       \t\thappyDoSeq r (action nt j tk st1 sts1 r)\n\nhappyMonadReduce k nt fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappyMonadReduce k nt fn j tk st sts stk =\n        happyThen1 (fn stk tk) (\\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))\n       where (sts1@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts))\n             drop_stk = happyDropStk k stk\n\nhappyMonad2Reduce k nt fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappyMonad2Reduce k nt fn j tk st sts stk =\n       happyThen1 (fn stk tk) (\\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))\n       where (sts1@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts))\n             drop_stk = happyDropStk k stk\n\n\n\n\n\n             new_state = action\n\n\nhappyDrop (0) l = l\nhappyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t\n\nhappyDropStk (0) l = l\nhappyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs\n\n-----------------------------------------------------------------------------\n-- Moving to a new state after a reduction\n\n{-# LINE 246 \"templates/GenericTemplate.hs\" #-}\nhappyGoto action j tk st = action j j tk (HappyState action)\n\n\n-----------------------------------------------------------------------------\n-- Error recovery ((1) is the error token)\n\n-- parse error if we are in recovery and we fail again\nhappyFail  (1) tk old_st _ stk =\n--\ttrace \"failing\" $ \n    \thappyError_ tk\n\n{-  We don't need state discarding for our restricted implementation of\n    \"error\".  In fact, it can cause some bogus parses, so I've disabled it\n    for now --SDM\n\n-- discard a state\nhappyFail  (1) tk old_st (((HappyState (action))):(sts)) \n\t\t\t\t\t\t(saved_tok `HappyStk` _ `HappyStk` stk) =\n--\ttrace (\"discarding state, depth \" ++ show (length stk))  $\n\taction (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))\n-}\n\n-- Enter error recovery: generate an error token,\n--                       save the old token and carry on.\nhappyFail  i tk (HappyState (action)) sts stk =\n--      trace \"entering error recovery\" $\n\taction (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk)\n\n-- Internal happy errors:\n\nnotHappyAtAll :: a\nnotHappyAtAll = error \"Internal Happy error\\n\"\n\n-----------------------------------------------------------------------------\n-- Hack to get the typechecker to accept our action functions\n\n\n\n\n\n\n\n-----------------------------------------------------------------------------\n-- Seq-ing.  If the --strict flag is given, then Happy emits \n--\thappySeq = happyDoSeq\n-- otherwise it emits\n-- \thappySeq = happyDontSeq\n\nhappyDoSeq, happyDontSeq :: a -> b -> b\nhappyDoSeq   a b = a `seq` b\nhappyDontSeq a b = b\n\n-----------------------------------------------------------------------------\n-- Don't inline any functions from the template.  GHC has a nasty habit\n-- of deciding to inline happyGoto everywhere, which increases the size of\n-- the generated parser quite a bit.\n\n{-# LINE 311 \"templates/GenericTemplate.hs\" #-}\n{-# NOINLINE happyShift #-}\n{-# NOINLINE happySpecReduce_0 #-}\n{-# NOINLINE happySpecReduce_1 #-}\n{-# NOINLINE happySpecReduce_2 #-}\n{-# NOINLINE happySpecReduce_3 #-}\n{-# NOINLINE happyReduce #-}\n{-# NOINLINE happyMonadReduce #-}\n{-# NOINLINE happyGoto #-}\n{-# NOINLINE happyFail #-}\n\n-- end of Happy Template.\n", "num_lines": 1121}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\n\nmodule GenBigTypes where\n\nimport GHC.Generics\n\ndata BigSum =\n            C0   |  C1  | C2   | C3   | C4   | C5   | C6   | C7   | C8   | C9\n          | C10  | C11  | C12  | C13  | C14  | C15  | C16  | C17  | C18  | C19\n          | C20  | C21  | C22  | C23  | C24  | C25  | C26  | C27  | C28  | C29\n          | C30  | C31  | C32  | C33  | C34  | C35  | C36  | C37  | C38  | C39\n          | C40  | C41  | C42  | C43  | C44  | C45  | C46  | C47  | C48  | C49\n          | C50  | C51  | C52  | C53  | C54  | C55  | C56  | C57  | C58  | C59\n          | C60  | C61  | C62  | C63  | C64  | C65  | C66  | C67  | C68  | C69\n          | C70  | C71  | C72  | C73  | C74  | C75  | C76  | C77  | C78  | C79\n          | C80  | C81  | C82  | C83  | C84  | C85  | C86  | C87  | C88  | C89\n          | C90  | C91  | C92  | C93  | C94  | C95  | C96  | C97  | C98  | C99\n    deriving Generic\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes, TypeFamilies #-}\n\nmodule T5837 where\n\nimport Data.Kind\n\ntype family TF a :: Type\ntype instance TF (a,b) = (TF a, TF b)\n\nt :: (a ~ TF (a,Int)) => Int\nt = undefined\n\n{-\n\n         [G] a ~ TF (a,Int)               -- a = a_am1\n-->\n         [G] TF (a,Int) ~ fsk             -- fsk = fsk_am8\n\ninert    [G] fsk ~ a\n\n---> reduce\n         [G] fsk ~ (TF a, TF Int)\n\ninert    [G] fsk ~ a\n\n---> substitute for fsk and flatten\n         [G] TF a ~ fsk1\n         [G] TF Int ~ fsk2\n\ninert    [G] fsk ~ a\n         [G] a ~ (fsk1, fsk2)\n\n---> (substitute for a in first constraint)\n         TF (fsk1, fsk2) ~ fsk1     (C1)\n         TF Int ~ fsk2\n\ninert    a ~ (fsk2, TF Int)\ninert    fsk ~ (fsk2, TF Int)\n\n\n------- At this point we are stuck because of\n--      the recursion in the first constraint C1\n--      Hooray\n\n-- Before, we reduced C1, which led to a loop\n\n---> (top-level reduction, re-orient)\n         fsk2 ~ (TF fsk2, TF Int)\ninert    a ~ (fsk2, TF Int)\ninert    fsk ~ (fsk2, TF Int)\n\n---> (attempt to flatten (TF fsk2) to get rid of fsk2\n         TF fsk2 ~ fsk3\n         fsk2 ~ (fsk3, TF Int)\ninert    a   ~ (fsk2, TF Int)\ninert    fsk ~ (fsk2, TF Int)\n\n--->\n         TF fsk2 ~ fsk3\ninert    fsk2 ~ (fsk3, TF Int)\ninert    a   ~ ((fsk3, TF Int), TF Int)\ninert    fsk ~ ((fsk3, TF Int), TF Int)\n\n-}\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6048 where\n\nimport Control.Applicative\n\ndata X = X\n  (Maybe String)\n  (Maybe String)\n  (Maybe String)\n  (Maybe String)\n  (Maybe String)\n  (Maybe String)\n  (Maybe String)\n  (Maybe String)\n  (Maybe String)\n\nmb :: (String -> Maybe a) -> String -> Maybe (Maybe a)\nmb _ \"\"  = Just Nothing\nmb _ \"-\" = Just Nothing\nmb p xs  = Just <$> p xs\n\nrun :: [String] -> Maybe X\nrun\n  [ x1\n  , x2\n  , x3\n  , x4\n  , x5\n  , x6\n  , x7\n  , x8\n  , x9\n  ] = X\n  <$> mb pure x1\n  <*> mb pure x2\n  <*> mb pure x3\n  <*> mb pure x4\n  <*> mb pure x5\n  <*> mb pure x6\n  <*> mb pure x7\n  <*> mb pure x8\n  <*> mb pure x9\n\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nfoo :: Double -> Int\nfoo x | x == 1 = 1\nfoo x | x == 2 = 2\nfoo x | x == 3 = 3\nfoo x | x == 4 = 4\nfoo x | x == 5 = 5\nfoo x | x == 6 = 6\nfoo x | x == 7 = 7\nfoo x | x == 8 = 8\nfoo x | x == 9 = 9\nfoo x | x == 10 = 10\nfoo x | x == 11 = 11\nfoo x | x == 12 = 12\nfoo x | x == 13 = 13\nfoo x | x == 14 = 14\nfoo x | x == 15 = 15\nfoo x | x == 16 = 16\nfoo x | x == 17 = 17\nfoo x | x == 18 = 18\nfoo x | x == 19 = 19\nfoo x | x == 20 = 20\nfoo x | x == 21 = 21\nfoo x | x == 22 = 22\nfoo x | x == 23 = 23\nfoo x | x == 24 = 24\nfoo x | x == 25 = 25\nfoo x | x == 26 = 26\nfoo x | x == 27 = 27\nfoo x | x == 28 = 28\nfoo x | x == 29 = 29\nfoo x | x == 30 = 30\nfoo x | x == 31 = 31\nfoo x | x == 32 = 32\nfoo x | x == 33 = 33\nfoo x | x == 34 = 34\nfoo x | x == 35 = 35\nfoo x | x == 36 = 36\nfoo x | x == 37 = 37\nfoo x | x == 38 = 38\nfoo x | x == 39 = 39\nfoo x | x == 40 = 40\nfoo x | x == 41 = 41\nfoo x | x == 42 = 42\nfoo x | x == 43 = 43\nfoo x | x == 44 = 44\nfoo x | x == 45 = 45\nfoo x | x == 46 = 46\nfoo x | x == 47 = 47\nfoo x | x == 48 = 48\nfoo x | x == 49 = 49\nfoo x | x == 50 = 50\nfoo x | x == 51 = 51\nfoo x | x == 52 = 52\nfoo x | x == 53 = 53\nfoo x | x == 54 = 54\nfoo x | x == 55 = 55\nfoo x | x == 56 = 56\nfoo x | x == 57 = 57\nfoo x | x == 58 = 58\nfoo x | x == 59 = 59\nfoo x | x == 60 = 60\nfoo x | x == 61 = 61\nfoo x | x == 62 = 62\nfoo x | x == 63 = 63\nfoo x | x == 64 = 64\nfoo x | x == 65 = 65\nfoo x | x == 66 = 66\nfoo x | x == 67 = 67\nfoo x | x == 68 = 68\nfoo x | x == 69 = 69\nfoo x | x == 70 = 70\nfoo x | x == 71 = 71\nfoo x | x == 72 = 72\nfoo x | x == 73 = 73\nfoo x | x == 74 = 74\nfoo x | x == 75 = 75\nfoo x | x == 76 = 76\nfoo x | x == 77 = 77\nfoo x | x == 78 = 78\nfoo x | x == 79 = 79\nfoo x | x == 80 = 80\nfoo x | x == 81 = 81\nfoo x | x == 82 = 82\nfoo x | x == 83 = 83\nfoo x | x == 84 = 84\nfoo x | x == 85 = 85\nfoo x | x == 86 = 86\nfoo x | x == 87 = 87\nfoo x | x == 88 = 88\nfoo x | x == 89 = 89\nfoo x | x == 90 = 90\nfoo x | x == 91 = 91\nfoo x | x == 92 = 92\nfoo x | x == 93 = 93\nfoo x | x == 94 = 94\nfoo x | x == 95 = 95\nfoo x | x == 96 = 96\nfoo x | x == 97 = 97\nfoo x | x == 98 = 98\nfoo x | x == 99 = 99\nfoo x | x == 100 = 100\nfoo x | x == 101 = 101\nfoo x | x == 102 = 102\nfoo x | x == 103 = 103\nfoo x | x == 104 = 104\nfoo x | x == 105 = 105\nfoo x | x == 106 = 106\nfoo x | x == 107 = 107\nfoo x | x == 108 = 108\nfoo x | x == 109 = 109\nfoo x | x == 110 = 110\nfoo x | x == 111 = 111\nfoo x | x == 112 = 112\nfoo x | x == 113 = 113\nfoo x | x == 114 = 114\nfoo x | x == 115 = 115\nfoo x | x == 116 = 116\nfoo x | x == 117 = 117\nfoo x | x == 118 = 118\nfoo x | x == 119 = 119\nfoo x | x == 120 = 120\nfoo x | x == 121 = 121\nfoo x | x == 122 = 122\nfoo x | x == 123 = 123\nfoo x | x == 124 = 124\nfoo x | x == 125 = 125\nfoo x | x == 126 = 126\nfoo x | x == 127 = 127\nfoo x | x == 128 = 128\nfoo x | x == 129 = 129\nfoo x | x == 130 = 130\nfoo x | x == 131 = 131\nfoo x | x == 132 = 132\nfoo x | x == 133 = 133\nfoo x | x == 134 = 134\nfoo x | x == 135 = 135\nfoo x | x == 136 = 136\nfoo x | x == 137 = 137\nfoo x | x == 138 = 138\nfoo x | x == 139 = 139\nfoo x | x == 140 = 140\nfoo x | x == 141 = 141\nfoo x | x == 142 = 142\nfoo x | x == 143 = 143\nfoo x | x == 144 = 144\nfoo x | x == 145 = 145\nfoo x | x == 146 = 146\nfoo x | x == 147 = 147\nfoo x | x == 148 = 148\nfoo x | x == 149 = 149\nfoo x | x == 150 = 150\nfoo x | x == 151 = 151\nfoo x | x == 152 = 152\nfoo x | x == 153 = 153\nfoo x | x == 154 = 154\nfoo x | x == 155 = 155\nfoo x | x == 156 = 156\nfoo x | x == 157 = 157\nfoo x | x == 158 = 158\nfoo x | x == 159 = 159\nfoo x | x == 160 = 160\nfoo x | x == 161 = 161\nfoo x | x == 162 = 162\nfoo x | x == 163 = 163\nfoo x | x == 164 = 164\nfoo x | x == 165 = 165\nfoo x | x == 166 = 166\nfoo x | x == 167 = 167\nfoo x | x == 168 = 168\nfoo x | x == 169 = 169\nfoo x | x == 170 = 170\nfoo x | x == 171 = 171\nfoo x | x == 172 = 172\nfoo x | x == 173 = 173\nfoo x | x == 174 = 174\nfoo x | x == 175 = 175\nfoo x | x == 176 = 176\nfoo x | x == 177 = 177\nfoo x | x == 178 = 178\nfoo x | x == 179 = 179\nfoo x | x == 180 = 180\nfoo x | x == 181 = 181\nfoo x | x == 182 = 182\nfoo x | x == 183 = 183\nfoo x | x == 184 = 184\nfoo x | x == 185 = 185\nfoo x | x == 186 = 186\nfoo x | x == 187 = 187\nfoo x | x == 188 = 188\nfoo x | x == 189 = 189\nfoo x | x == 190 = 190\nfoo x | x == 191 = 191\nfoo x | x == 192 = 192\nfoo x | x == 193 = 193\nfoo x | x == 194 = 194\nfoo x | x == 195 = 195\nfoo x | x == 196 = 196\nfoo x | x == 197 = 197\nfoo x | x == 198 = 198\nfoo x | x == 199 = 199\nfoo x | x == 200 = 200\nfoo x | x == 201 = 201\nfoo x | x == 202 = 202\nfoo x | x == 203 = 203\nfoo x | x == 204 = 204\nfoo x | x == 205 = 205\nfoo x | x == 206 = 206\nfoo x | x == 207 = 207\nfoo x | x == 208 = 208\nfoo x | x == 209 = 209\nfoo x | x == 210 = 210\nfoo x | x == 211 = 211\nfoo x | x == 212 = 212\nfoo x | x == 213 = 213\nfoo x | x == 214 = 214\nfoo x | x == 215 = 215\nfoo x | x == 216 = 216\nfoo x | x == 217 = 217\nfoo x | x == 218 = 218\nfoo x | x == 219 = 219\nfoo x | x == 220 = 220\nfoo x | x == 221 = 221\nfoo x | x == 222 = 222\nfoo x | x == 223 = 223\nfoo x | x == 224 = 224\nfoo x | x == 225 = 225\nfoo x | x == 226 = 226\nfoo x | x == 227 = 227\nfoo x | x == 228 = 228\nfoo x | x == 229 = 229\nfoo x | x == 230 = 230\nfoo x | x == 231 = 231\nfoo x | x == 232 = 232\nfoo x | x == 233 = 233\nfoo x | x == 234 = 234\nfoo x | x == 235 = 235\nfoo x | x == 236 = 236\nfoo x | x == 237 = 237\nfoo x | x == 238 = 238\nfoo x | x == 239 = 239\nfoo x | x == 240 = 240\nfoo x | x == 241 = 241\nfoo x | x == 242 = 242\nfoo x | x == 243 = 243\nfoo x | x == 244 = 244\nfoo x | x == 245 = 245\nfoo x | x == 246 = 246\nfoo x | x == 247 = 247\nfoo x | x == 248 = 248\nfoo x | x == 249 = 249\nfoo x | x == 250 = 250\nfoo x | x == 251 = 251\nfoo x | x == 252 = 252\nfoo x | x == 253 = 253\nfoo x | x == 254 = 254\nfoo x | x == 255 = 255\nfoo x | x == 256 = 256\nfoo x | x == 257 = 257\nfoo x | x == 258 = 258\nfoo x | x == 259 = 259\nfoo x | x == 260 = 260\nfoo x | x == 261 = 261\nfoo x | x == 262 = 262\nfoo x | x == 263 = 263\nfoo x | x == 264 = 264\nfoo x | x == 265 = 265\nfoo x | x == 266 = 266\nfoo x | x == 267 = 267\nfoo x | x == 268 = 268\nfoo x | x == 269 = 269\nfoo x | x == 270 = 270\nfoo x | x == 271 = 271\nfoo x | x == 272 = 272\nfoo x | x == 273 = 273\nfoo x | x == 274 = 274\nfoo x | x == 275 = 275\nfoo x | x == 276 = 276\nfoo x | x == 277 = 277\nfoo x | x == 278 = 278\nfoo x | x == 279 = 279\nfoo x | x == 280 = 280\nfoo x | x == 281 = 281\nfoo x | x == 282 = 282\nfoo x | x == 283 = 283\nfoo x | x == 284 = 284\nfoo x | x == 285 = 285\nfoo x | x == 286 = 286\nfoo x | x == 287 = 287\nfoo x | x == 288 = 288\nfoo x | x == 289 = 289\nfoo x | x == 290 = 290\nfoo x | x == 291 = 291\nfoo x | x == 292 = 292\nfoo x | x == 293 = 293\nfoo x | x == 294 = 294\nfoo x | x == 295 = 295\nfoo x | x == 296 = 296\nfoo x | x == 297 = 297\nfoo x | x == 298 = 298\nfoo x | x == 299 = 299\nfoo x | x == 300 = 300\nfoo x | x == 301 = 301\nfoo x | x == 302 = 302\nfoo x | x == 303 = 303\nfoo x | x == 304 = 304\nfoo x | x == 305 = 305\nfoo x | x == 306 = 306\nfoo x | x == 307 = 307\nfoo x | x == 308 = 308\nfoo x | x == 309 = 309\nfoo x | x == 310 = 310\nfoo x | x == 311 = 311\nfoo x | x == 312 = 312\nfoo x | x == 313 = 313\nfoo x | x == 314 = 314\nfoo x | x == 315 = 315\nfoo x | x == 316 = 316\nfoo x | x == 317 = 317\nfoo x | x == 318 = 318\nfoo x | x == 319 = 319\nfoo x | x == 320 = 320\nfoo x | x == 321 = 321\nfoo x | x == 322 = 322\nfoo x | x == 323 = 323\nfoo x | x == 324 = 324\nfoo x | x == 325 = 325\nfoo x | x == 326 = 326\nfoo x | x == 327 = 327\nfoo x | x == 328 = 328\nfoo x | x == 329 = 329\nfoo x | x == 330 = 330\nfoo x | x == 331 = 331\nfoo x | x == 332 = 332\nfoo x | x == 333 = 333\nfoo x | x == 334 = 334\nfoo x | x == 335 = 335\nfoo x | x == 336 = 336\nfoo x | x == 337 = 337\nfoo x | x == 338 = 338\nfoo x | x == 339 = 339\nfoo x | x == 340 = 340\nfoo x | x == 341 = 341\nfoo x | x == 342 = 342\nfoo x | x == 343 = 343\nfoo x | x == 344 = 344\nfoo x | x == 345 = 345\nfoo x | x == 346 = 346\nfoo x | x == 347 = 347\nfoo x | x == 348 = 348\nfoo x | x == 349 = 349\nfoo x | x == 350 = 350\nfoo x | x == 351 = 351\nfoo x | x == 352 = 352\nfoo x | x == 353 = 353\nfoo x | x == 354 = 354\nfoo x | x == 355 = 355\nfoo x | x == 356 = 356\nfoo x | x == 357 = 357\nfoo x | x == 358 = 358\nfoo x | x == 359 = 359\nfoo x | x == 360 = 360\nfoo x | x == 361 = 361\nfoo x | x == 362 = 362\nfoo x | x == 363 = 363\nfoo x | x == 364 = 364\nfoo x | x == 365 = 365\nfoo x | x == 366 = 366\nfoo x | x == 367 = 367\nfoo x | x == 368 = 368\nfoo x | x == 369 = 369\nfoo x | x == 370 = 370\nfoo x | x == 371 = 371\nfoo x | x == 372 = 372\nfoo x | x == 373 = 373\nfoo x | x == 374 = 374\nfoo x | x == 375 = 375\nfoo x | x == 376 = 376\nfoo x | x == 377 = 377\nfoo x | x == 378 = 378\nfoo x | x == 379 = 379\nfoo x | x == 380 = 380\nfoo x | x == 381 = 381\nfoo x | x == 382 = 382\nfoo x | x == 383 = 383\nfoo x | x == 384 = 384\nfoo x | x == 385 = 385\nfoo x | x == 386 = 386\nfoo x | x == 387 = 387\nfoo x | x == 388 = 388\nfoo x | x == 389 = 389\nfoo x | x == 390 = 390\nfoo x | x == 391 = 391\nfoo x | x == 392 = 392\nfoo x | x == 393 = 393\nfoo x | x == 394 = 394\nfoo x | x == 395 = 395\nfoo x | x == 396 = 396\nfoo x | x == 397 = 397\nfoo x | x == 398 = 398\nfoo x | x == 399 = 399\nfoo x | x == 400 = 400\nfoo x | x == 401 = 401\nfoo x | x == 402 = 402\nfoo x | x == 403 = 403\nfoo x | x == 404 = 404\nfoo x | x == 405 = 405\nfoo x | x == 406 = 406\nfoo x | x == 407 = 407\nfoo x | x == 408 = 408\nfoo x | x == 409 = 409\nfoo x | x == 410 = 410\nfoo x | x == 411 = 411\nfoo x | x == 412 = 412\nfoo x | x == 413 = 413\nfoo x | x == 414 = 414\nfoo x | x == 415 = 415\nfoo x | x == 416 = 416\nfoo x | x == 417 = 417\nfoo x | x == 418 = 418\nfoo x | x == 419 = 419\nfoo x | x == 420 = 420\nfoo x | x == 421 = 421\nfoo x | x == 422 = 422\nfoo x | x == 423 = 423\nfoo x | x == 424 = 424\nfoo x | x == 425 = 425\nfoo x | x == 426 = 426\nfoo x | x == 427 = 427\nfoo x | x == 428 = 428\nfoo x | x == 429 = 429\nfoo x | x == 430 = 430\nfoo x | x == 431 = 431\nfoo x | x == 432 = 432\nfoo x | x == 433 = 433\nfoo x | x == 434 = 434\nfoo x | x == 435 = 435\nfoo x | x == 436 = 436\nfoo x | x == 437 = 437\nfoo x | x == 438 = 438\nfoo x | x == 439 = 439\nfoo x | x == 440 = 440\nfoo x | x == 441 = 441\nfoo x | x == 442 = 442\nfoo x | x == 443 = 443\nfoo x | x == 444 = 444\nfoo x | x == 445 = 445\nfoo x | x == 446 = 446\nfoo x | x == 447 = 447\nfoo x | x == 448 = 448\nfoo x | x == 449 = 449\nfoo x | x == 450 = 450\nfoo x | x == 451 = 451\nfoo x | x == 452 = 452\nfoo x | x == 453 = 453\nfoo x | x == 454 = 454\nfoo x | x == 455 = 455\nfoo x | x == 456 = 456\nfoo x | x == 457 = 457\nfoo x | x == 458 = 458\nfoo x | x == 459 = 459\nfoo x | x == 460 = 460\nfoo x | x == 461 = 461\nfoo x | x == 462 = 462\nfoo x | x == 463 = 463\nfoo x | x == 464 = 464\nfoo x | x == 465 = 465\nfoo x | x == 466 = 466\nfoo x | x == 467 = 467\nfoo x | x == 468 = 468\nfoo x | x == 469 = 469\nfoo x | x == 470 = 470\nfoo x | x == 471 = 471\nfoo x | x == 472 = 472\nfoo x | x == 473 = 473\nfoo x | x == 474 = 474\nfoo x | x == 475 = 475\nfoo x | x == 476 = 476\nfoo x | x == 477 = 477\nfoo x | x == 478 = 478\nfoo x | x == 479 = 479\nfoo x | x == 480 = 480\nfoo x | x == 481 = 481\nfoo x | x == 482 = 482\nfoo x | x == 483 = 483\nfoo x | x == 484 = 484\nfoo x | x == 485 = 485\nfoo x | x == 486 = 486\nfoo x | x == 487 = 487\nfoo x | x == 488 = 488\nfoo x | x == 489 = 489\nfoo x | x == 490 = 490\nfoo x | x == 491 = 491\nfoo x | x == 492 = 492\nfoo x | x == 493 = 493\nfoo x | x == 494 = 494\nfoo x | x == 495 = 495\nfoo x | x == 496 = 496\nfoo x | x == 497 = 497\nfoo x | x == 498 = 498\nfoo x | x == 499 = 499\nfoo x | x == 500 = 500\n", "num_lines": 504}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for ticket #830, simplifier taking too long on large do expression\n\nmain = do\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n  return ()\n", "num_lines": 1684}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9233 where\n\nimport T9233a\nimport Data.Functor.Identity\n\nupds :: (Monad m) => [String -> Options -> m Options]\nupds = [\n  \\a o -> return o { flags = (flags o) { f1 = splitComma a ++ \" \" ++ f1 (flags o) } }\n  ]\n\nsetAll :: Options -> Options\nsetAll _ = (getOpt upds :: Identity ()) `seq` undefined\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9233a where\n\n\ndata X = X {\n  f1 :: String,\n  f2 :: !Bool,\n  f3 :: !Bool,\n  f4 :: !Bool,\n  f5 :: !Bool,\n  f6 :: !Bool,\n  f7 :: !Bool,\n  f8 :: !Bool,\n  f9 :: !Bool,\n  f10 :: !Bool,\n  f11 :: !Bool,\n  f12 :: !Bool,\n  f13 :: !Bool,\n  f14 :: !Bool,\n  f15 :: !Bool,\n  f16 :: !Bool,\n  f17 :: !Bool,\n  f18 :: !Bool,\n  f19 :: !Bool,\n  f20 :: !Bool,\n  f21 :: !Bool,\n  f22 :: !Bool,\n  f23 :: !Bool,\n  f24 :: !Bool,\n  f25 :: !Bool,\n  f26 :: !Bool,\n  f27 :: !Bool,\n  f28 :: !Bool,\n  f29 :: !Bool,\n  f30 :: !Bool,\n  f31 :: !Bool,\n  f32 :: !Bool,\n  f33 :: !Bool,\n  f34 :: !Bool,\n  f35 :: !Bool,\n  f36 :: !Bool,\n  f37 :: !Bool,\n  f38 :: !Bool,\n  f39 :: !Bool,\n  f40 :: !Bool,\n  f41 :: !Bool,\n  f42 :: !Bool,\n  f43 :: !Bool,\n  f44 :: !Bool,\n  f45 :: !Bool,\n  f46 :: !Bool,\n  f47 :: !Bool,\n  f48 :: !Bool,\n  f49 :: !Bool,\n  f50 :: !Bool,\n  f51 :: !Bool,\n  f52 :: !Bool,\n  f53 :: !Bool,\n  f54 :: !Bool,\n  f55 :: !Bool,\n  f56 :: !Bool,\n  f57 :: !Bool,\n  f58 :: !Bool,\n  f59 :: !Bool,\n  f60 :: !Bool,\n  f61 :: !Bool,\n  f62 :: !Bool,\n  f63 :: !Bool,\n  f64 :: !Bool,\n  f65 :: !Bool,\n  f66 :: !Bool,\n  f67 :: !Bool,\n  f68 :: !Bool,\n  f69 :: !Bool,\n  f70 :: !Bool,\n  f71 :: !Bool,\n  f72 :: !Bool,\n  f73 :: !Bool,\n  f74 :: !Bool,\n  f75 :: !Bool,\n  f76 :: !Bool,\n  f77 :: !Bool,\n  f78 :: !Bool,\n  f79 :: !Bool,\n  f80 :: !Bool,\n  f81 :: !Bool,\n  f82 :: !Bool,\n  f83 :: !Bool,\n  f84 :: !Bool,\n  f85 :: !Bool,\n  f86 :: !Bool,\n  f87 :: !Bool,\n  f88 :: !Bool,\n  f89 :: !Bool,\n  f90 :: !Bool,\n  f91 :: !Bool,\n  f92 :: !Bool,\n  f93 :: !Bool,\n  f94 :: !Bool,\n  f95 :: !Bool,\n  f96 :: !Bool,\n  f97 :: !Bool,\n  f98 :: !Bool,\n  f99 :: !Bool,\n  f100 :: !Bool\n  }\n\ndata Options = Options {\n  flags :: !X,\n  o2 :: !Bool,\n  o3 :: !Bool,\n  o4 :: !Bool,\n  o5 :: !Bool,\n  o6 :: !Bool,\n  o7 :: !Bool,\n  o8 :: !Bool,\n  o9 :: !Bool,\n  o10 :: !Bool,\n  o11 :: !Bool,\n  o12 :: !Bool\n  }\n\nsplitComma :: String -> String\nsplitComma _ = \"a\"\n{-# NOINLINE splitComma #-}\n\ngetOpt :: Monad m => [String -> Options -> m Options] -> m ()\ngetOpt _ = return ()\n{-# NOINLINE getOpt #-}\n", "num_lines": 129}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric #-}\nmodule T9630 where\nimport T9630a\nimport GHC.Generics\nimport Control.Applicative\n\ndata T = T () () () ()\n          ()()()()()()()\n          ()()()()()()()()()()()()()()()()\n          ()()()()()()()()()()()()()()()()\n          ()()()()()()()()()()()()()()()()\n          ()()()()()()()()()()()()()()()()\n          ()()()()()()()()()()()()()()()()\n          ()()()()()()()()()()()()()()()()\n          ()()()()()()()()()()()()()()()()\n          ()()()()()()()()()()()()()()()()\n  deriving Generic\n\ninstance Serialize T where\n  get = to <$> gGet\n  put = gPut . from\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE RankNTypes #-}\n\n-----------------------------------------------------------------------------\n-- | Modified from cereal, which is\n-- Copyright   : Lennart Kolmodin, Galois Inc. 2009\n-- License     : BSD3-style\n\nmodule T9630a (\n      Serialize(..), GSerialize (..), Putter, Get\n    ) where\n\nimport Data.ByteString.Builder (Builder)\nimport Data.ByteString as B\nimport GHC.Generics\nimport Control.Applicative (Applicative (..), (<$>))\n\nclass Serialize t where\n    put :: Putter t\n    get :: Get t\n\ninstance Serialize () where\n    put ()  = pure ()\n    get     = pure ()\n\n-- Generics\n\nclass GSerialize f where\n    gPut :: Putter (f a)\n    gGet :: Get (f a)\n\ninstance (GSerialize a, GSerialize b) => GSerialize (a :*: b) where\n    gPut (a :*: b) = gPut a *> gPut b\n    gGet = (:*:) <$> gGet  <*> gGet\n\ninstance GSerialize a => GSerialize (M1 i c a) where\n    gPut = gPut . unM1\n    gGet = M1 <$> gGet\n\ninstance Serialize a => GSerialize (K1 i a) where\n    gPut = put . unK1\n    gGet = K1 <$> get\n\n\n-- Put\n\ndata PairS a = PairS a !Builder\n\nnewtype PutM a = Put { unPut :: PairS a }\n\ntype Put = PutM ()\n\ntype Putter a = a -> Put\n\ninstance Functor PutM where\n        fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w\n\ninstance Applicative PutM where\n        pure a = Put (PairS a mempty)\n\n        m <*> k = Put $\n            let PairS f w  = unPut m\n                PairS x w' = unPut k\n            in PairS (f x) (w `mappend` w')\n\n-- Get\n\ndata Result r = Fail String B.ByteString\n              | Partial (B.ByteString -> Result r)\n              | Done r B.ByteString\n\n\nnewtype Get a = Get\n  { unGet :: forall r. Input -> Buffer -> More\n                    -> Failure r -> Success a r\n                    -> Result r }\n\ntype Input  = B.ByteString\ntype Buffer = Maybe B.ByteString\n\ntype Failure   r = Input -> Buffer -> More -> [String] -> String -> Result r\ntype Success a r = Input -> Buffer -> More -> a                  -> Result r\n\ndata More\n  = Complete\n  | Incomplete (Maybe Int)\n    deriving (Eq)\n\n\ninstance Functor Get where\n    fmap p m =        Get $ \\ s0 b0 m0 kf ks ->\n      unGet m s0 b0 m0 kf $ \\ s1 b1 m1 a     -> ks s1 b1 m1 (p a)\n\ninstance Applicative Get where\n    pure a = Get $ \\ s0 b0 m0 _ ks -> ks s0 b0 m0 a\n\n    f <*> x =         Get $ \\ s0 b0 m0 kf ks ->\n      unGet f s0 b0 m0 kf $ \\ s1 b1 m1 g     ->\n      unGet x s1 b1 m1 kf $ \\ s2 b2 m2 y     -> ks s2 b2 m2 (g y)\n", "num_lines": 101}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6975 where\ndata Foo = Foo\n  { field1 :: Int -> Int\n  , field2 :: Int -> Int\n  , field3 :: Int -> Int\n  , field4 :: Int -> Int\n  , field5 :: Int -> Int\n  , field6 :: Int -> Int\n  , field7 :: Int -> Int\n  , field8 :: Int -> Int\n  , field9 :: Int -> Int\n  , field10 :: Int -> Int\n  , field11 :: Int -> Int\n  , field12 :: Int -> Int\n  , field13 :: Int -> Int\n  , field14 :: Int -> Int\n  , field15 :: Int -> Int\n  , field16 :: Int -> Int\n  , field17 :: Int -> Int\n  , field18 :: Int -> Int\n  , field19 :: Int -> Int\n  , field20 :: Int -> Int\n  , field21 :: Int -> Int\n  , field22 :: Int -> Int\n  , field23 :: Int -> Int\n  , field24 :: Int -> Int\n  , field25 :: Int -> Int\n  , field26 :: Int -> Int\n  , field27 :: Int -> Int\n  , field28 :: Int -> Int\n  , field29 :: Int -> Int\n  , field30 :: Int -> Int\n  , field31 :: Int -> Int\n  , field32 :: Int -> Int\n  , field33 :: Int -> Int\n  , field34 :: Int -> Int\n  , field35 :: Int -> Int\n  , field36 :: Int -> Int\n  , field37 :: Int -> Int\n  , field38 :: Int -> Int\n  , field39 :: Int -> Int\n  , field40 :: Int -> Int\n  , field41 :: Int -> Int\n  , field42 :: Int -> Int\n  , field43 :: Int -> Int\n  , field44 :: Int -> Int\n  , field45 :: Int -> Int\n  , field46 :: Int -> Int\n  , field47 :: Int -> Int\n  , field48 :: Int -> Int\n  , field49 :: Int -> Int\n  , field50 :: Int -> Int\n  , field51 :: Int -> Int\n  , field52 :: Int -> Int\n  , field53 :: Int -> Int\n  , field54 :: Int -> Int\n  , field55 :: Int -> Int\n  , field56 :: Int -> Int\n  , field57 :: Int -> Int\n  , field58 :: Int -> Int\n  , field59 :: Int -> Int\n  , field60 :: Int -> Int\n  , field61 :: Int -> Int\n  , field62 :: Int -> Int\n  , field63 :: Int -> Int\n  , field64 :: Int -> Int\n  , field65 :: Int -> Int\n  , field66 :: Int -> Int\n  , field67 :: Int -> Int\n  , field68 :: Int -> Int\n  , field69 :: Int -> Int\n  , field70 :: Int -> Int\n  , field71 :: Int -> Int\n  , field72 :: Int -> Int\n  , field73 :: Int -> Int\n  , field74 :: Int -> Int\n  , field75 :: Int -> Int\n  , field76 :: Int -> Int\n  , field77 :: Int -> Int\n  , field78 :: Int -> Int\n  , field79 :: Int -> Int\n  , field80 :: Int -> Int\n  , field81 :: Int -> Int\n  , field82 :: Int -> Int\n  , field83 :: Int -> Int\n  , field84 :: Int -> Int\n  , field85 :: Int -> Int\n  , field86 :: Int -> Int\n  , field87 :: Int -> Int\n  , field88 :: Int -> Int\n  , field89 :: Int -> Int\n  , field90 :: Int -> Int\n  , field91 :: Int -> Int\n  , field92 :: Int -> Int\n  , field93 :: Int -> Int\n  , field94 :: Int -> Int\n  , field95 :: Int -> Int\n  , field96 :: Int -> Int\n  , field97 :: Int -> Int\n  , field98 :: Int -> Int\n  , field99 :: Int -> Int\n  , field100 :: Int -> Int\n }\n", "num_lines": 104}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n - Instant Insanity using Type Families.\n -\n - See:  The Monad Read, Issue #8 - http://www.haskell.org/wikiupload/d/dd/TMR-Issue8.pdf\n -}\n\n{-# OPTIONS_GHC -freduction-depth=400 #-}\n\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nimport Prelude hiding (all, flip, map, filter )\n\ndata Proxy a = Proxy\nmain = print (Proxy :: Proxy (Solutions Cubes))\n\ndata R -- Red\ndata G -- Green\ndata B -- Blue\ndata W -- White\n\ndata Cube u f r b l d\n\ndata True\ndata False\n\ntype family And b1 b2 :: *\ntype instance And True True   = True\ntype instance And True False  = False\ntype instance And False False = False\ntype instance And False True  = False\n\ntype family NE x y :: *\ntype instance NE R R = False\ntype instance NE R G = True\ntype instance NE R B = True\ntype instance NE R W = True\ntype instance NE G R = True\ntype instance NE G G = False\ntype instance NE G B = True\ntype instance NE G W = True\ntype instance NE B R = True\ntype instance NE B G = True\ntype instance NE B B = False\ntype instance NE B W = True\ntype instance NE W R = True\ntype instance NE W G = True\ntype instance NE W B = True\ntype instance NE W W = False\n\ntype family EQ x y :: *\n\ntype instance EQ R R = True\ntype instance EQ R G = False\ntype instance EQ R B = False\ntype instance EQ R W = False\ntype instance EQ G R = False\ntype instance EQ G G = True\ntype instance EQ G B = False\ntype instance EQ G W = False\ntype instance EQ B R = False\ntype instance EQ B G = False\ntype instance EQ B B = True\ntype instance EQ B W = False\ntype instance EQ W R = False\ntype instance EQ W G = False\ntype instance EQ W B = False\ntype instance EQ W W = True\n\ndata Nil = Nil\ndata Cons x xs = Cons x xs\n\ntype family All l :: *\ntype instance All Nil = True\ntype instance All (Cons False xs) = False\ntype instance All (Cons True xs) = All xs\n\ntype family ListConcat xs ys :: *\ntype instance ListConcat Nil ys = ys\ntype instance ListConcat (Cons x xs) ys = Cons x (ListConcat xs ys)\n\ntype family AppendIf b a as :: *\ntype instance AppendIf False a as = as\ntype instance AppendIf True a as = Cons a as\n\ndata Rotate\ndata Twist\ndata Flip\n\ntype family Apply f a :: *\ntype instance Apply Rotate (Cube u f r b l d) = (Cube u r b l f d)\ntype instance Apply Twist  (Cube u f r b l d) = (Cube f r u l d b)\ntype instance Apply Flip   (Cube u f r b l d) = (Cube d l b r f u)\n\n-- orientations c = [ z | x <- [ c, flip c ], y <- [ x, twist x, twist (twist x) ], z <- [y, rot y, rot(rot y), rot(rot(rot(y))) ] ]\n\ntype family Map f as :: *\ntype instance Map f Nil = Nil\ntype instance Map f (Cons a as) = Cons (Apply f a) (Map f as)\n\ntype family MapAppend f as :: *\ntype instance MapAppend f xs = ListConcat xs (Map f xs)\n\ntype family MapAppend2 f as :: *\ntype instance MapAppend2 f xs = ListConcat xs (MapAppend f (Map f xs))\n\ntype family MapAppend3 f as :: *\ntype instance MapAppend3 f xs = ListConcat xs (MapAppend2 f (Map f xs))\n\ntype family Iterate2 f as :: *\ntype instance Iterate2 f Nil = Nil\ntype instance Iterate2 f (Cons a as) = ListConcat (Cons (Apply f a) (Cons a Nil)) (Iterate2 f as)\n\ntype family Iterate3 f as :: *\ntype instance Iterate3 f (Cons a as) =\n  ListConcat (Cons a\n             (Cons (Apply f a)\n             (Cons (Apply f (Apply f a))\n              Nil)))\n             (Iterate3 f as)\n\ntype family Iterate4 f as :: *\ntype instance Iterate4 f Nil = Nil\ntype instance Iterate4 f (Cons a as) =\n   ListConcat (Cons a\n              (Cons (Apply f a)\n              (Cons (Apply f (Apply f a))\n              (Cons (Apply f (Apply f (Apply f a)))\n               Nil))))\n              (Iterate4 f as)\n\ntype family Orientations c :: *\n-- type instance Orientations c = Iterate4 Rotate (Iterate3 Twist (Iterate2 Flip (Cons c Nil)))\ntype instance Orientations c = MapAppend3 Rotate (MapAppend2 Twist (MapAppend Flip (Cons c Nil)))\n\ntype Cube1 = Cube B G W G B R\ntype Cube2 = Cube W G B W R R\ntype Cube3 = Cube G W R B R R\ntype Cube4 = Cube B R G G W W\n\ntype Cubes = Cons Cube1 (Cons Cube2 (Cons Cube3 (Cons Cube4 Nil)))\n\ntype family Compatible c d :: *\ntype instance Compatible (Cube u1 f1 r1 b1 l1 d1) (Cube u2 f2 r2 b2 l2 d2) =\n  All (Cons (NE f1 f2) (Cons (NE r1 r2) (Cons (NE b1 b2) (Cons (NE l1 l2) Nil))))\n\ntype family Allowed c cs :: *\ntype instance Allowed c Nil = True\ntype instance Allowed c (Cons s ss) = And (Compatible c s) (Allowed c ss)\n\ntype family MatchingOrientations as sol :: *\ntype instance MatchingOrientations Nil sol = Nil\ntype instance MatchingOrientations (Cons o os) sol = AppendIf (Allowed o sol) (Cons o sol) (MatchingOrientations os sol)\n\ntype family AllowedCombinations os sols :: *\ntype instance AllowedCombinations os Nil = Nil\ntype instance AllowedCombinations os (Cons sol sols) = ListConcat (MatchingOrientations os sol) (AllowedCombinations os sols)\n\ntype family Solutions c :: *\ntype instance Solutions Nil = Cons Nil Nil\ntype instance Solutions (Cons c cs) = AllowedCombinations (Orientations c) (Solutions cs)\n\n{-\n - solutions [] = [ [] ]\n - solutions (c:cs) = [ (o:sol) | sol <- solutions cs, o <- orientations c, allowed o \n-}\n", "num_lines": 168}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n - Instant Insanity using Closed Type Families and DataKinds.\n -\n - See:  http://stackoverflow.com/questions/26538595\n -}\n\n{-# OPTIONS_GHC -freduction-depth=400 #-}\n\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n\nimport Prelude hiding (all, flip, map, filter )\n\ndata Proxy (a :: k) = Proxy\n\nmain = print (Proxy :: Proxy (Solutions Cubes))\n\ndata Color = R | G | B | W\n\ndata Cube = Cube Color Color Color Color Color Color\n\ntype family And (b1 :: Bool) (b2 :: Bool) :: Bool where\n    And True True = True\n    And b1 b2 = False\n\ntype family NE (x :: Color) (y :: Color) :: Bool where\n    NE x x = False\n    NE x y = True\n\ntype family EQ (x :: Color) (y :: Color) :: Bool where\n    EQ a a = True\n    EQ a b = False\n\ntype family All (l :: [Bool]) :: Bool where\n    All '[] = True\n    All (False ': xs) = False\n    All (True ': xs) = All xs\n\ntype family ListConcat (xs :: [k]) (ys :: [k]) :: [k] where\n    ListConcat '[] ys = ys\n    ListConcat (x ': xs) ys = x ': ListConcat xs ys\n\ntype family AppendIf (b :: Bool) (a :: [Cube]) (as :: [[Cube]]) :: [[Cube]] where\n    AppendIf False a as = as\n    AppendIf True a as = a ': as\n\ndata Transform = Rotate | Twist | Flip\n\ntype family Apply (f :: Transform) (a :: Cube) :: Cube where\n    Apply Rotate ('Cube u f r b l d) = ('Cube u r b l f d)\n    Apply Twist  ('Cube u f r b l d) = ('Cube f r u l d b)\n    Apply Flip   ('Cube u f r b l d) = ('Cube d l b r f u)\n\ntype family Map (f :: Transform) (as :: [Cube]) :: [Cube] where\n    Map f '[] = '[]\n    Map f (a ': as) = (Apply f a) ': (Map f as)\n\ntype family MapAppend (f :: Transform) (as :: [Cube]) :: [Cube] where\n    MapAppend f xs = ListConcat xs (Map f xs)\n\ntype family MapAppend2 (f :: Transform) (as :: [Cube]) :: [Cube] where\n    MapAppend2 f xs = ListConcat xs (MapAppend f (Map f xs))\n\ntype family MapAppend3 (f :: Transform) (as :: [Cube]) :: [Cube] where\n    MapAppend3 f xs = ListConcat xs (MapAppend2 f (Map f xs))\n\ntype family Iterate2 (f :: Transform) (as :: [Cube]) :: [Cube] where\n    Iterate2 f '[] = '[]\n    Iterate2 f (a ': as) = ListConcat [Apply f a, a] (Iterate2 f as)\n\ntype family Iterate3 (f :: Transform) (as :: [Cube]) :: [Cube] where\n    Iterate3 f '[] = '[]\n    Iterate3 f (a ': as) =\n        ListConcat [a, Apply f a, Apply f (Apply f a)] (Iterate3 f as)\n\ntype family Iterate4 (f :: Transform) (as :: [Cube]) :: [Cube] where\n    Iterate4 f '[] = '[]\n    Iterate4 f (a ': as) =\n        ListConcat [a, Apply f a, Apply f (Apply f a), Apply f (Apply f (Apply f a))]\n                   (Iterate4 f as)\n\ntype family Orientations (c :: Cube) :: [Cube] where\n    Orientations c = MapAppend3 Rotate (MapAppend2 Twist (MapAppend Flip '[c]))\n\ntype Cube1 = 'Cube B G W G B R\ntype Cube2 = 'Cube W G B W R R\ntype Cube3 = 'Cube G W R B R R\ntype Cube4 = 'Cube B R G G W W\n\ntype Cubes = [Cube1, Cube2, Cube3, Cube4]\n\ntype family Compatible (c :: Cube) (d :: Cube) :: Bool where\n    Compatible ('Cube u1 f1 r1 b1 l1 d1) ('Cube u2 f2 r2 b2 l2 d2) =\n        All [NE f1 f2, NE r1 r2, NE b1 b2, NE l1 l2]\n\ntype family Allowed (c :: Cube) (cs :: [Cube]) :: Bool where\n    Allowed c '[] = True\n    Allowed c (s ': ss) = And (Compatible c s) (Allowed c ss)\n\ntype family MatchingOrientations (as :: [Cube]) (sol :: [Cube]) :: [[Cube]] where\n    MatchingOrientations '[] sol = '[]\n    MatchingOrientations (o ': os) sol =\n        AppendIf (Allowed o sol) (o ': sol) (MatchingOrientations os sol)\n\ntype family AllowedCombinations (os :: [Cube]) (sols :: [[Cube]]) where\n    AllowedCombinations os '[] = '[]\n    AllowedCombinations os (sol ': sols) =\n        ListConcat (MatchingOrientations os sol) (AllowedCombinations os sols)\n\ntype family Solutions (cs :: [Cube]) :: [[Cube]] where\n    Solutions '[] = '[ '[] ]\n    Solutions (c ': cs) = AllowedCombinations (Orientations c) (Solutions cs)\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n - Instant Insanity using Closed Type Families, but no DataKinds\n -\n - See:  http://stackoverflow.com/questions/26538595\n -}\n\n{-# OPTIONS_GHC -freduction-depth=400 #-}\n\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nimport Prelude hiding (all, flip, map, filter )\n\ndata Proxy a = Proxy\n\nmain = print (Proxy :: Proxy (Solutions Cubes))\n\ndata R -- Red\ndata G -- Green\ndata B -- Blue\ndata W -- White\n\ndata Cube u f r b l d\n\ndata True\ndata False\n\ntype family And b1 b2 :: * where\n    And True True = True\n    And b1 b2 = False\n\ntype family NE x y :: * where\n    NE x x = False\n    NE x y = True\n\ntype family EQ x y :: * where\n    EQ a a = True\n    EQ a b = False\n\ndata Nil = Nil\ndata Cons x xs = Cons x xs\n\ntype family All l :: * where\n    All Nil = True\n    All (Cons False xs) = False\n    All (Cons True xs) = All xs\n\ntype family ListConcat xs ys :: * where\n    ListConcat Nil ys = ys\n    ListConcat (Cons x xs) ys = Cons x (ListConcat xs ys)\n\ntype family AppendIf b a as :: * where\n    AppendIf False a as = as\n    AppendIf True a as = Cons a as\n\ndata Rotate\ndata Twist\ndata Flip\n\ntype family Apply f a :: * where\n    Apply Rotate (Cube u f r b l d) = (Cube u r b l f d)\n    Apply Twist  (Cube u f r b l d) = (Cube f r u l d b)\n    Apply Flip   (Cube u f r b l d) = (Cube d l b r f u)\n\ntype family Map f as :: * where\n    Map f Nil = Nil\n    Map f (Cons a as) = Cons (Apply f a) (Map f as)\n\ntype family MapAppend f as :: * where\n    MapAppend f xs = ListConcat xs (Map f xs)\n\ntype family MapAppend2 f as :: * where\n    MapAppend2 f xs = ListConcat xs (MapAppend f (Map f xs))\n\ntype family MapAppend3 f as :: * where\n    MapAppend3 f xs = ListConcat xs (MapAppend2 f (Map f xs))\n\ntype family Iterate2 f as :: * where\n    Iterate2 f Nil = Nil\n    Iterate2 f (Cons a as) = ListConcat (Cons (Apply f a) (Cons a Nil)) (Iterate2 f as)\n\ntype family Iterate3 f as :: * where\n    Iterate3 f (Cons a as) =\n        ListConcat (Cons a\n                    (Cons (Apply f a)\n                     (Cons (Apply f (Apply f a))\n                      Nil)))\n                   (Iterate3 f as)\n\ntype family Iterate4 f as :: * where\n    Iterate4 f Nil = Nil\n    Iterate4 f (Cons a as) =\n        ListConcat (Cons a\n                    (Cons (Apply f a)\n                     (Cons (Apply f (Apply f a))\n                      (Cons (Apply f (Apply f (Apply f a)))\n                       Nil))))\n                   (Iterate4 f as)\n\ntype family Orientations c :: * where\n    Orientations c = MapAppend3 Rotate (MapAppend2 Twist (MapAppend Flip (Cons c Nil)))\n\ntype Cube1 = Cube B G W G B R\ntype Cube2 = Cube W G B W R R\ntype Cube3 = Cube G W R B R R\ntype Cube4 = Cube B R G G W W\n\ntype Cubes = Cons Cube1 (Cons Cube2 (Cons Cube3 (Cons Cube4 Nil)))\n\ntype family Compatible c d :: * where\n    Compatible (Cube u1 f1 r1 b1 l1 d1) (Cube u2 f2 r2 b2 l2 d2) =\n        All (Cons (NE f1 f2) (Cons (NE r1 r2) (Cons (NE b1 b2) (Cons (NE l1 l2) Nil))))\n\ntype family Allowed c cs :: * where\n    Allowed c Nil = True\n    Allowed c (Cons s ss) = And (Compatible c s) (Allowed c ss)\n\ntype family MatchingOrientations as sol :: * where\n    MatchingOrientations Nil sol = Nil\n    MatchingOrientations (Cons o os) sol =\n        AppendIf (Allowed o sol) (Cons o sol) (MatchingOrientations os sol)\n\ntype family AllowedCombinations os sols :: * where\n    AllowedCombinations os Nil = Nil\n    AllowedCombinations os (Cons sol sols) =\n        ListConcat (MatchingOrientations os sol) (AllowedCombinations os sols)\n\ntype family Solutions c :: * where\n    Solutions Nil = Cons Nil Nil\n    Solutions (Cons c cs) = AllowedCombinations (Orientations c) (Solutions cs)\n", "num_lines": 132}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# OPTIONS_GHC -freduction-depth=0 #-}   -- this should terminate!\n\nmodule T9872d where\n-- Code from Jan Stolarek, labelled \"exp-tyfams.hs\" on Trac #9872,\n-- generated by a Template Haskell program\n\n\n-- This file demonstrates exponential compile times with type\n-- families. Code in this file was extracted from encoding generated\n-- automatically with Template Haskell by singletons library.\n\nimport Data.Kind\nimport GHC.TypeLits\n\n-- encoding of type-level partially applied functions\ndata TyFun :: Type -> Type -> Type\ntype family Apply (f :: TyFun k1 k2 -> Type) (x :: k1) :: k2\ntype a @@ b = Apply a b\n\n-- some boilerplate\ntype family Error (a :: k) :: k1\ntype ErrorSym1 a = Error a\ndata ErrorSym0 :: TyFun a b -> Type\ntype instance Apply ErrorSym0 e = Error e\ndata Proxy a = Proxy\ndata KProxy (a :: Type) = KProxy\ntype KindOf (a :: k) = ('KProxy :: KProxy k)\n\n-- type-level addition\ntype (:+$$$) (t1 :: Nat) (t2 :: Nat) = t1 + t2\n\ndata (:+$$) (l :: Nat) (tf :: TyFun Nat Nat)\n  = forall a. (KindOf (Apply ((:+$$) l) a)) ~ (KindOf ((:+$$$) l a)) =>\n    (:+$$###)\ntype instance Apply ((:+$$) l1) l2 = (:+$$$) l1 l2\n\ndata (:+$) (l :: TyFun Nat (TyFun Nat Nat -> Type))\n  = forall a. (KindOf (Apply (:+$) a)) ~ (KindOf ((:+$$) a)) => (:+$###)\ntype instance Apply (:+$) l = (:+$$) l\n\n-- type-level lists\ntype NilSym0 = '[]\n\ntype ConsSym2 (x :: a) (xs :: [a]) = x ': xs\n\ndata ConsSym1 (x :: a) (l_a3t6 :: TyFun [a] [a])\n  = forall b. (KindOf (Apply (ConsSym1 x) b)) ~ (KindOf (ConsSym2 x b)) =>\n    (:$$###)\ntype instance Apply (ConsSym1 x) xs = ConsSym2 x xs\n\ndata ConsSym0 (l :: TyFun a (TyFun [a] [a] -> Type))\n  = forall a. (KindOf (Apply ConsSym0 a)) ~ (KindOf (ConsSym1 a)) => (:$###)\ntype instance Apply ConsSym0 l = ConsSym1 l\n\ntype Let_1627403919Scrutinee_1627403894Sym4 t1 t2 t3 t4 =\n    Let_1627403919Scrutinee_1627403894 t1 t2 t3 t4\n\ndata Let_1627403919Scrutinee_1627403894Sym3 l_a3Dx\n                                            l_a3Dy\n                                            l_a3Dz\n                                            l_a3Dw\n  = forall arg_a3DA. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym3\n                                     l_a3Dx l_a3Dy l_a3Dz) arg_a3DA)) ~\n                     (KindOf (Let_1627403919Scrutinee_1627403894Sym4\n                              l_a3Dx l_a3Dy l_a3Dz arg_a3DA)) =>\n    Let_1627403919Scrutinee_1627403894Sym3KindInference\ntype instance Apply (Let_1627403919Scrutinee_1627403894Sym3\n                     l_a3Dx l_a3Dy l_a3Dz) l_a3Dw =\n  Let_1627403919Scrutinee_1627403894Sym4 l_a3Dx l_a3Dy l_a3Dz l_a3Dw\n\ndata Let_1627403919Scrutinee_1627403894Sym2 l_a3Dt l_a3Du l_a3Ds\n  = forall arg_a3Dv. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym2\n                                     l_a3Dt l_a3Du) arg_a3Dv)) ~\n                     (KindOf (Let_1627403919Scrutinee_1627403894Sym3\n                              l_a3Dt l_a3Du arg_a3Dv)) =>\n    Let_1627403919Scrutinee_1627403894Sym2KindInference\ntype instance Apply\n    (Let_1627403919Scrutinee_1627403894Sym2 l_a3Dt l_a3Du) l_a3Ds =\n  Let_1627403919Scrutinee_1627403894Sym3 l_a3Dt l_a3Du l_a3Ds\ndata Let_1627403919Scrutinee_1627403894Sym1 l_a3Dq l_a3Dp\n  = forall arg_a3Dr. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym1\n                                     l_a3Dq) arg_a3Dr)) ~\n                     (KindOf (Let_1627403919Scrutinee_1627403894Sym2\n                              l_a3Dq arg_a3Dr)) =>\n    Let_1627403919Scrutinee_1627403894Sym1KindInference\ntype instance Apply (Let_1627403919Scrutinee_1627403894Sym1 l_a3Dq)\n                    l_a3Dp\n  = Let_1627403919Scrutinee_1627403894Sym2 l_a3Dq l_a3Dp\ndata Let_1627403919Scrutinee_1627403894Sym0 l_a3Dn\n  = forall arg_a3Do. (KindOf (Apply Let_1627403919Scrutinee_1627403894Sym0\n                              arg_a3Do)) ~\n                     (KindOf (Let_1627403919Scrutinee_1627403894Sym1\n                              arg_a3Do)) =>\n    Let_1627403919Scrutinee_1627403894Sym0KindInference\ntype instance Apply Let_1627403919Scrutinee_1627403894Sym0 l_a3Dn\n  = Let_1627403919Scrutinee_1627403894Sym1 l_a3Dn\ntype Let_1627403919Scrutinee_1627403894 f_a3Dd\n                                        q0_a3De\n                                        x_a3Df\n                                        xs_a3Dg =\n    Apply (Apply (Apply ScanrSym0 f_a3Dd) q0_a3De) xs_a3Dg\n\ntype family Case f q0 x xs t :: [k] where\n  Case f q0 x xs '[]       = ErrorSym0 @@ \"empty list\"\n  Case f q0 x xs (q ': qs) = ConsSym0 @@ (f @@ x @@ q) @@ (ConsSym0 @@ q @@ qs)\n\n-- type-level scanr\ntype ScanrSym3 (t1 :: TyFun a (TyFun b b -> Type) -> Type)\n               (t2 :: b)\n               (t3 :: [a]) =\n    Scanr t1 t2 t3\n\ndata ScanrSym2 (l1 :: TyFun a (TyFun b b -> Type) -> Type)\n               (l2 :: b)\n               (l3 :: TyFun [a] [b])\n  = forall a. (KindOf (Apply (ScanrSym2 l1 l2) a)) ~\n              (KindOf (ScanrSym3 l1 l2 a)) =>\n    ScanrSym2KindInference\ntype instance Apply (ScanrSym2 l1 l2) l3 = ScanrSym3 l1 l2 l3\n\ndata ScanrSym1 (l_a3D0 :: TyFun a_a3CJ (TyFun b_a3CK b_a3CK -> Type) -> Type)\n               (l_a3CZ :: TyFun b_a3CK (TyFun ([a_a3CJ]) ([b_a3CK])\n                                        -> Type))\n  = forall arg_a3D1. (KindOf (Apply (ScanrSym1 l_a3D0) arg_a3D1)) ~\n                     (KindOf (ScanrSym2 l_a3D0 arg_a3D1)) =>\n    ScanrSym1KindInference\ntype instance Apply (ScanrSym1 l_a3D0) l_a3CZ = ScanrSym2 l_a3D0 l_a3CZ\n\ndata ScanrSym0 (l :: TyFun (TyFun a (TyFun  b   b  -> Type) -> Type)\n                           (TyFun b (TyFun [a] [b] -> Type) -> Type))\n  = forall a. (KindOf (Apply ScanrSym0 a)) ~ (KindOf (ScanrSym1 a)) =>\n    ScanrSym0KindInference\ntype instance Apply ScanrSym0 l1 = ScanrSym1 l1\n\ntype family Scanr (a_a3D6 :: TyFun a_a3CJ (TyFun b_a3CK b_a3CK -> Type) -> Type)\n                  (a_a3D7 :: b_a3CK)\n                  (a_a3D8 :: [a_a3CJ]) :: [b_a3CK] where\n  Scanr _z_1627403911_a3Db q0_a3Dc '[] = Apply (Apply ConsSym0 q0_a3Dc) NilSym0\n  Scanr f_a3Dd q0_a3De (x_a3Df ': xs_a3Dg) =\n    Case f_a3Dd q0_a3De x_a3Df xs_a3Dg (Let_1627403919Scrutinee_1627403894Sym4\n                                        f_a3Dd q0_a3De x_a3Df xs_a3Dg)\n\n\n{-\nfoo32 :: Proxy ('[528,527,525,522,518,513,507,500,492,483,473,462,450,437,423,\n                  408,392,375,357,338,318,297,275,252,228,203,177,150,122,93,\n                  63,32,0])\nfoo32 = Proxy\n\nbar32 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,\n                                             15,16,17,18,19,20,21,22,23,24,25,\n                                             26,27,28,29,30,31,32])\nbar32 = foo32\n\n-}\n{-\nfoo64 :: Proxy ('[2080,2079,2077,2074,2070,2065,2059,2052,2044,2035,2025,2014,\n                  2002,1989,1975,1960,1944,1927,1909,1890,1870,1849,1827,1804,\n                  1780,1755,1729,1702,1674,1645,1615,1584,1552,1519,1485,1450,\n                  1414,1377,1339,1300,1260,1219,1177,1134,1090,1045,999,952,904,\n                  855,805,754,702,649,595,540,484,427,369,310,250,189,127,64,0])\nfoo64 = Proxy\n\nbar64 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,\n                                             15,16,17,18,19,20,21,22,23,24,25,\n                                             26,27,28,29,30,31,32,33,34,35,36,\n                                             37,38,39,40,41,42,43,44,45,46,47,\n                                             48,49,50,51,52,53,54,55,56,57,58,\n                                             59,60,61,62,63,64])\nbar64 = foo64\n\n\nfoo128 :: Proxy ('[8256,8255,8253,8250,8246,8241,8235,8228,8220,8211,8201,8190,\n                   8178,8165,8151,8136,8120,8103,8085,8066,8046,8025,8003,7980,\n                   7956,7931,7905,7878,7850,7821,7791,7760,7728,7695,7661,7626,\n                   7590,7553,7515,7476,7436,7395,7353,7310,7266,7221,7175,7128,\n                   7080,7031,6981,6930,6878,6825,6771,6716,6660,6603,6545,6486,\n                   6426,6365,6303,6240,6176,6111,6045,5978,5910,5841,5771,5700,\n                   5628,5555,5481,5406,5330,5253,5175,5096,5016,4935,4853,4770,\n                   4686,4601,4515,4428,4340,4251,4161,4070,3978,3885,3791,3696,\n                   3600,3503,3405,3306,3206,3105,3003,2900,2796,2691,2585,2478,\n                   2370,2261,2151,2040,1928,1815,1701,1586,1470,1353,1235,1116,\n                   996,875,753,630,506,381,255,128,0])\nfoo128 = Proxy\n\nbar128 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,\n                                              15,16,17,18,19,20,21,22,23,24,25,\n                                              26,27,28,29,30,31,32,33,34,35,36,\n                                              37,38,39,40,41,42,43,44,45,46,47,\n                                              48,49,50,51,52,53,54,55,56,57,58,\n                                              59,60,61,62,63,64,65,66,67,68,69,\n                                              70,71,72,73,74,75,76,77,78,79,80,\n                                              81,82,83,84,85,86,87,88,89,90,91,\n                                              92,93,94,95,96,97,98,99,100,101,\n                                              102,103,104,105,106,107,108,109,\n                                              110,111,112,113,114,115,116,117,\n                                              118,119,120,121,122,123,124,125,\n                                              126,127,128])\nbar128 = foo128\n-}\n\nfoo256 :: Proxy ('[32896,32895,32893,32890,32886,32881,32875,32868,32860,32851,\n                   32841,32830,32818,32805,32791,32776,32760,32743,32725,32706,\n                   32686,32665,32643,32620,32596,32571,32545,32518,32490,32461,\n                   32431,32400,32368,32335,32301,32266,32230,32193,32155,32116,\n                   32076,32035,31993,31950,31906,31861,31815,31768,31720,31671,\n                   31621,31570,31518,31465,31411,31356,31300,31243,31185,31126,\n                   31066,31005,30943,30880,30816,30751,30685,30618,30550,30481,\n                   30411,30340,30268,30195,30121,30046,29970,29893,29815,29736,\n                   29656,29575,29493,29410,29326,29241,29155,29068,28980,28891,\n                   28801,28710,28618,28525,28431,28336,28240,28143,28045,27946,\n                   27846,27745,27643,27540,27436,27331,27225,27118,27010,26901,\n                   26791,26680,26568,26455,26341,26226,26110,25993,25875,25756,\n                   25636,25515,25393,25270,25146,25021,24895,24768,24640,24511,\n                   24381,24250,24118,23985,23851,23716,23580,23443,23305,23166,\n                   23026,22885,22743,22600,22456,22311,22165,22018,21870,21721,\n                   21571,21420,21268,21115,20961,20806,20650,20493,20335,20176,\n                   20016,19855,19693,19530,19366,19201,19035,18868,18700,18531,\n                   18361,18190,18018,17845,17671,17496,17320,17143,16965,16786,\n                   16606,16425,16243,16060,15876,15691,15505,15318,15130,14941,\n                   14751,14560,14368,14175,13981,13786,13590,13393,13195,12996,\n                   12796,12595,12393,12190,11986,11781,11575,11368,11160,10951,\n                   10741,10530,10318,10105,9891,9676,9460,9243,9025,8806,\n                   8586,8365,8143,7920,7696,7471,7245,7018,6790,6561,6331,6100,\n                   5868,5635,5401,5166,4930,4693,4455,4216,3976,3735,3493,3250,\n                   3006,2761,2515,2268,2020,1771,1521,1270,1018,765,511,256,0])\nfoo256 = Proxy\n\nbar256 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,\n                                              15,16,17,18,19,20,21,22,23,24,25,\n                                              26,27,28,29,30,31,32,33,34,35,36,\n                                              37,38,39,40,41,42,43,44,45,46,47,\n                                              48,49,50,51,52,53,54,55,56,57,58,\n                                              59,60,61,62,63,64,65,66,67,68,69,\n                                              70,71,72,73,74,75,76,77,78,79,80,\n                                              81,82,83,84,85,86,87,88,89,90,91,\n                                              92,93,94,95,96,97,98,99,100,101,\n                                              102,103,104,105,106,107,108,109,\n                                              110,111,112,113,114,115,116,117,\n                                              118,119,120,121,122,123,124,125,\n                                              126,127,128,129,130,131,132,133,\n                                              134,135,136,137,138,139,140,141,\n                                              142,143,144,145,146,147,148,149,\n                                              150,151,152,153,154,155,156,157,\n                                              158,159,160,161,162,163,164,165,\n                                              166,167,168,169,170,171,172,173,\n                                              174,175,176,177,178,179,180,181,\n                                              182,183,184,185,186,187,188,189,\n                                              190,191,192,193,194,195,196,197,\n                                              198,199,200,201,202,203,204,205,\n                                              206,207,208,209,210,211,212,213,\n                                              214,215,216,217,218,219,220,221,\n                                              222,223,224,225,226,227,228,229,\n                                              230,231,232,233,234,235,236,237,\n                                              238,239,240,241,242,243,244,245,\n                                              246,247,248,249,250,251,252,253,\n                                              254,255,256])\nbar256 = foo256\n", "num_lines": 266}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Lexer (alex_table) where\n\nimport Data.Array\n\nalex_table :: Array Int Int\nalex_table = listArray (0,1109) [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,18,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,20,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,22,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,25,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,28,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\nfindDivBy :: Int -> [Int] -> Maybe Int\nfindDivBy p ns\n    -- go should be a join point and should get worker/wrappered; the worker\n    -- must also be a join point (since it's mutually recursive with one).\n  = let go !p ns = case ns of n:ns' -> case n `mod` p of 0 -> Just n\n                                                         _ -> go p ns'\n                              []    -> Nothing\n    in case p of\n         0 -> error \"div by zero\"\n         _ -> go p ns\n\nmain = print $ findDivBy 7 [1..10]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.List\n\n-- These four functions should all wind up the same; they represent successive\n-- simplifications that should happen. (Actual details may vary, since find\n-- isn't quite defined this way, but the differences disappear by the end.)\n\nfirstEvenIsPositive1 :: [Int] -> Bool\nfirstEvenIsPositive1 = maybe False (> 0) . find even\n\n-- After inlining:\n\nfirstEvenIsPositive2 :: [Int] -> Bool\nfirstEvenIsPositive2 xs =\n  let go xs = case xs of x:xs' -> if even x then Just x else go xs'\n                         []    -> Nothing\n  in case go xs of Just n  -> n > 0\n                   Nothing -> False\n\n-- Note that go *could* be a join point if it were declared inside the scrutinee\n-- instead of outside. So it's now Float In's job to move the binding inward a\n-- smidge. *But* if it goes too far inward (as it would until recently), it will\n-- wrap only \"go\" instead of \"go xs\", which won't let us mark go as a join point\n-- since join points can't be partially invoked.\n--\n-- After Float In:\n\nfirstEvenIsPositive3 :: [Int] -> Bool\nfirstEvenIsPositive3 xs =\n  case let {-join-} go xs = case xs of x:xs' -> if even x then Just x\n                                                          else go xs'\n                                       []    -> Nothing\n       in go xs of\n    Just n  -> n > 0\n    Nothing -> False\n\n-- After the simplifier:\n\nfirstEvenIsPositive4 :: [Int] -> Bool\nfirstEvenIsPositive4 xs =\n  let {-join-} go xs = case xs of x:xs' -> if even x then x > 0 else go xs'\n                                  []    -> False\n  in go xs\n\n-- This only worked because go was a join point so that the case gets moved\n-- inside.\n\n{-# NOINLINE firstEvenIsPositive1 #-}\n\nmain = print $ or $ [firstEvenIsPositive1 [1,3..n] | n <- [1..10000]]\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n - A variation on join002.hs that avoids Float Out issues. The join points in\n - join002.hs may get floated to top level, which is necessary to allow in\n - general, but which makes them into functions rather than join points, thus\n - messing up the test.\n -}\n\nmodule Main (\n  firstMultIsPositive1, firstMultIsPositive2, firstMultIsPositive3,\n  firstMultIsPositive4,\n\n  main\n) where\n\nimport Data.List\n\ndivides :: Int -> Int -> Bool\np `divides` n = n `mod` p == 0\n\ninfix 4 `divides`\n\n-- These four functions should all wind up the same; they represent successive\n-- simplifications that should happen. (Actual details may vary, since find\n-- isn't quite defined this way, but the differences disappear by the end.)\n\nfirstMultIsPositive1 :: Int -> [Int] -> Bool\nfirstMultIsPositive1 p = maybe False (> 0) . find (p `divides`)\n\n-- After inlining:\n\nfirstMultIsPositive2 :: Int -> [Int] -> Bool\nfirstMultIsPositive2 p xs =\n  let go xs = case xs of x:xs' -> if p `divides` x then Just x else go xs'\n                         []    -> Nothing\n  in case go xs of Just n  -> n > 0\n                   Nothing -> False\n\n-- Note that go *could* be a join point if it were declared inside the scrutinee\n-- instead of outside. So it's now Float In's job to move the binding inward a\n-- smidge. *But* if it goes too far inward (as it would until recently), it will\n-- wrap only \"go\" instead of \"go xs\", which won't let us mark go as a join point\n-- since join points can't be partially invoked.\n--\n-- After Float In:\n\nfirstMultIsPositive3 :: Int -> [Int] -> Bool\nfirstMultIsPositive3 p xs =\n  case let {-join-} go xs = case xs of x:xs' -> if p `divides` x then Just x\n                                                                 else go xs'\n                                       []    -> Nothing\n       in go xs of\n    Just n  -> n > 0\n    Nothing -> False\n\n-- After the simplifier:\n\nfirstMultIsPositive4 :: Int -> [Int] -> Bool\nfirstMultIsPositive4 p xs =\n  let {-join-} go xs = case xs of x:xs' -> if p `divides` x then x > 0\n                                                            else go xs'\n                                  []    -> False\n  in go xs\n\n-- This only worked because go was a join point so that the case gets moved\n-- inside.\n\n{-# NOINLINE firstMultIsPositive1 #-}\n\nmain = print $ or $ [firstMultIsPositive1 2 [1,3..n] | n <- [1..10000]]\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n - A rather contrived example demonstrating the virtues of not floating join\n - points outward.\n -}\n\nmodule Main (main) where\n\n-- Calculate n `div` d `div` d by looping.\n\n{-# NOINLINE slowDivDiv #-}\nslowDivDiv :: Int -> Int -> Int\nslowDivDiv n d\n  = let {-# NOINLINE divPos #-}\n        divPos :: Int -> Int\n        divPos n0\n          = -- This function is a join point (all calls are tail calls), so it\n            -- never causes a closure allocation, so it doesn't help to float it\n            -- out. Thus -fno-join-points causes a ~25% jump in allocations.\n            let go n' i\n                  = case n' >= d of True  -> go (n' - d) (i + 1)\n                                    False -> i\n            in go n0 0\n    in case n >= 0 of True  -> divPos (divPos n)\n                      False -> divPos (-(divPos (-n)))\n                                 -- It's important that divPos be called twice\n                                 -- because otherwise it'd be a one-shot lambda\n                                 -- and so the join point would be floated\n                                 -- back in again.\n\nmain = print $ sum [slowDivDiv n d | n <- [1..1000], d <- [1..1000]]\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- Test of Worker/Wrapper operating on join points -}\n\nmodule Main where\n\nsumOfMultiplesOf :: Int -> [Int] -> Int\nsumOfMultiplesOf p ns\n  = {- This is a join point (and it will stay that way---it won't get floated to\n       top level because p occurs free). It should get worker/wrappered. -}\n    let go ns acc\n          = case ns of []    -> acc\n                       n:ns' -> case n `mod` p of 0 -> go ns' (acc + n)\n                                                  _ -> go ns'  acc\n    in go ns 0\n\n{-\nIt's hard to test for this, but what should happen is that go gets W/W'd and the\nworker is a join point (else Core Lint will complain). Interestingly, go is\n*not* CPR'd, because then the worker couldn't be a join point, but once the\nsimplifier runs, the worker ends up returning Int# anyway. See Note [Don't CPR\njoin points] in WorkWrap.hs.\n-}\n\nmain = print $ sumOfMultiplesOf 2 [1..10]\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n{-# NOINLINE foo #-}\nfoo :: Int -> Int\nfoo x = x\n\n{-# RULES \"foo/5\" forall (f :: Int -> Int). foo (f 5) = foo (f 42) #-}\n-- highly suspect, of course!\n\nmain = print $ foo (let {-# NOINLINE j #-}\n                        j :: Int -> Int\n                        j n = n + 1 in j 5)\n\n{-\nIf we're not careful, this will get rewritten to\n\n  main = print $ let <join> j n = n + 1 in foo (j 42)\n\nwhich violates the join point invariant (can't invoke a join point from\nnon-tail context). Solution is to refuse to float join points when matching\nRULES.\n-}\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test of fusion in unfold/destroy style. Originally, unfold/destroy supported\n-- filter, but the constructors (here Done and Yield) couldn't be compiled away.\n-- Join points let us do this by pulling the case from sumS into the loop in\n-- filterS.\n\n{-# LANGUAGE GADTs #-}\n\nmodule Main (main) where\n\ndata Stream a where Stream :: (s -> Step a s) -> s -> Stream a\ndata Step a s = Done | Yield a s\n\n{-# INLINE sumS #-}\nsumS :: Stream Int -> Int\nsumS (Stream next s0) = go s0 0\n  where\n    go s acc = case next s of Done       -> acc\n                              Yield a s' -> go s' (acc + a)\n\n{-# INLINE filterS #-}\nfilterS :: (a -> Bool) -> Stream a -> Stream a\nfilterS p (Stream next s0) = Stream fnext s0\n  where\n    fnext s = seek s\n      where\n        -- should be a join point!\n        seek s = case next s of Done                   -> Done\n                                Yield a s' | p a       -> Yield a s'\n                                           | otherwise -> seek s'\n\n{-# INLINE enumFromToS #-}\nenumFromToS :: Int -> Int -> Stream Int\nenumFromToS lo hi = Stream next lo\n  where\n    next n | n > hi    = Done\n           | otherwise = Yield n (n+1)\n\n{-# NOINLINE test #-} -- for -ddump-simpl\ntest :: Int -> Int -> Int\ntest lo hi = sumS (filterS even (enumFromToS lo hi))\n\n-- Note that this overflows on 32-bit machines and therefore we have two stdout\n-- files\nmain = print $ test 1 10000000\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\n-- | Tests that conversions between various primitive types (e.g.\n-- Word, Double, etc) doesn't allocate.\nmodule Main (main) where\n\nimport Data.Word\n\n-- Repeatedly convert Words to Doubles\nloop :: Floating a => Word -> a\nloop n = go 0 0.0\n  where\n    go i !acc | i < n = go (i+1) (acc + fromIntegral i)\n              | otherwise = acc\n{-# SPECIALISE loop :: Word -> Float #-}\n{-# SPECIALISE loop :: Word -> Double #-}\n\nmain :: IO ()\nmain = do\n    print (loop 1000000 :: Float)\n    print (loop 1000000 :: Double)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFoldable #-}\n\nmodule Main where\nimport Data.Semigroup\n\n-- Just a list without any special fusion rules.\ndata List a = Nil | Cons a (List a) deriving Foldable\n\ninstance Semigroup (List a) where\n  Nil <> ys = ys\n  Cons x xs <> ys = Cons x (xs <> ys)\n\nreplicateList :: Int -> a -> List a\nreplicateList 0 x = Nil\nreplicateList n x = Cons x (replicateList (n - 1) x)\n\nnewtype ListList a = ListList (List (List a)) deriving Foldable\n\nlong :: Int -> Bool\nlong n = null $ ListList $ replicateList n Nil <> Cons (Cons () Nil) Nil\n\nmain :: IO ()\nmain = print $ long (10^(6 :: Int))\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFoldable #-}\n\nmodule Main where\n\n-- Trying to check if this is null from left to right or right to left\n-- will produce an infinite loop.\ndata Ouch a = Ouch (Ouch a) a (Ouch a) deriving Foldable\n\nouch :: a -> Ouch a\nouch a = v where v = Ouch v a v\n\nnewtype Tuplouch a = Tuplouch (Ouch (a, Int)) deriving Foldable\n\nmain :: IO ()\nmain = do\n  print $ null (ouch ())\n  print $ null (Tuplouch (ouch ((), 3)))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}\nmodule Main where\n\nimport GHC.Exts\nimport GHC.IO\n\nmain :: IO ()\nmain = loop 10000000\n  where\n    loop :: Int -> IO ()\n    loop 0 = return ()\n    loop i = newArray >> loop (i-1)\n\nnewArray :: IO ()\nnewArray = IO $ \\s -> case newArray# 16# () s of\n    (# s', _ #) -> (# s', () #)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nmodule Main where\n\nimport GHC.Exts\nimport GHC.IO\n\nmain :: IO ()\nmain = loop 10000000\n  where\n    loop :: Int -> IO ()\n    loop 0 = return ()\n    loop i = newByteArray >> loop (i-1)\n\nnewByteArray :: IO ()\nnewByteArray = IO $ \\s -> case newByteArray# 128# s of\n    (# s', _ #) -> (# s', () #)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nmodule Main where\n\nimport GHC.Exts\nimport GHC.IO\n\nmain :: IO ()\nmain = do\n    marr <- newArray\n    loop 10000000 (unMArray marr)\n  where\n    loop :: Int -> MutableArray# RealWorld () -> IO ()\n    loop 0 _    = return ()\n    loop i marr = freezeArray marr >> loop (i-1) marr\n\ndata MArray = MArray { unMArray :: !(MutableArray# RealWorld ()) }\n\nnewArray :: IO MArray\nnewArray = IO $ \\s -> case newArray# 16# () s of\n    (# s', marr# #) -> (# s', MArray marr# #)\n\nfreezeArray :: MutableArray# RealWorld () -> IO ()\nfreezeArray marr# = IO $ \\s -> case freezeArray# marr# 0# 16# s of\n    (# s', _ #) -> (# s', () #)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport System.Environment (getArgs)\nimport qualified Data.ByteString.Lazy as L\n\nmain :: IO ()\nmain = do\n    (file : _) <- getArgs\n    L.readFile file >>= L.putStr\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- This test works efficiently because the full laziness\n-- pass now floats out applications\n--      \\x -> f y (x+1)\n-- It'll float out the (f y) if that's a redex\n\nloop :: Double -> [Int] -> Double\n{-# NOINLINE loop #-}\nloop x [] = x\nloop x (n:ns) = x `seq` loop (x ^ n) ns\n\nmain = print $ loop 1 (replicate 10000000 5)\n\n----------------------------------------------------\n{-  Roman's message of May 2010\n\nI tried running nofib with -fno-method-sharing (we discussed this at some point). These are the results:\n\n--------------------------------------------------------------------------------\n        Program           Size    Allocs   Runtime   Elapsed\n--------------------------------------------------------------------------------\n\n            Min          -0.3%    -25.0%    -12.5%     -9.9%\n            Max          +0.2%   +159.1%    +90.0%    +84.7%\n Geometric Mean          -0.0%     +2.2%     +6.8%     +5.1%\n\nThis is the worst program:\n\n         simple          +0.2%   +159.1%    +65.3%    +63.9%\n\nI looked at it a bit and came up with this small example:\n\n----\nloop :: Double -> [Int] -> Double\n{-# NOINLINE loop #-}\nloop x [] = x\nloop x (n:ns) = x `seq` loop (x ^ n) ns\n\nmain = print $ loop 1 (replicate 10000000 5)\n----\n\nThis is over 2x slower with -fno-method-sharing. The culprit is, of\ncourse, (^). Here is the difference:\n\nWithout -fno-method-sharing:\n\n----\n^_rVB :: GHC.Types.Double -> GHC.Types.Int -> GHC.Types.Double ^_rVB =\n  GHC.Real.^\n    @ GHC.Types.Double\n    @ GHC.Types.Int\n    GHC.Float.$fNumDouble\n    GHC.Real.$fIntegralInt\n\nMain.loop [InlPrag=NOINLINE (sat-args=2), Occ=LoopBreaker]\n  :: GHC.Types.Double -> [GHC.Types.Int] -> GHC.Types.Double Main.loop =\n  \\ (x1_aat :: GHC.Types.Double) (ds_drG :: [GHC.Types.Int]) ->\n    case ds_drG of _ {\n      [] -> x1_aat;\n      : n_aav ns_aaw ->\n        case x1_aat of x2_aau { GHC.Types.D# ipv_srQ ->\n        Main.loop (^_rVB x2_aau n_aav) ns_aaw\n        }\n    }\n----\n\nWith:\n\n----\nMain.loop [InlPrag=NOINLINE (sat-args=2), Occ=LoopBreaker]\n  :: GHC.Types.Double -> [GHC.Types.Int] -> GHC.Types.Double Main.loop =\n  \\ (x1_aat :: GHC.Types.Double) (ds_drD :: [GHC.Types.Int]) ->\n    case ds_drD of _ {\n      [] -> x1_aat;\n      : n_aav ns_aaw ->\n        case x1_aat of x2_aau { GHC.Types.D# ipv_srN ->\n        Main.loop\n          (GHC.Real.^\n             @ GHC.Types.Double\n             @ GHC.Types.Int\n             GHC.Float.$fNumDouble\n             GHC.Real.$fIntegralInt\n             x2_aau\n             n_aav)\n          ns_aaw\n        }\n    }\n----\n\nThis is a bit disappointing. I would have expected GHC to float out\nthe application of (^) to the two dictionaries during full laziness\n(note that (^) has arity 2 so the application is oversaturated). Why\ndoesn't that happen? SetLevels (if this is the right place to look)\nhas this:\n\n-}\n", "num_lines": 98}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ConstraintKinds #-}\n\nmodule Main( main, boo ) where\n\nimport Prelude hiding (repeat)\n\nboo xs f = (\\x -> f x, xs)\n\nrepeat :: Int -> (a -> a) -> a -> a\nrepeat 1 f x = f x\nrepeat n f x = n `seq` x `seq` repeat (n-1) f $ f x\n\n---- Buggy version\n------------------\n\ntype Numerical a = (Fractional a, Real a)\n\ndata Box a = Box\n    { func :: forall dum. (Numerical dum) => dum -> a -> a\n    , obj :: !a }\n\ndo_step :: (Numerical num) => num -> Box a -> Box a\ndo_step number Box{..} = Box{ obj = func number obj, .. }\n\nstart :: Box Double\nstart = Box { func = \\x y -> realToFrac x + y\n            , obj = 0 }\n\ntest :: Int -> IO ()\ntest steps = putStrLn $ show $ obj $ repeat steps (do_step 1) start\n\n---- Driver\n-----------\n\nmain :: IO ()\nmain = test 2000 -- compare test2 10000000 or test3 10000000, but test4 20000\n\n\n{-\n---- No tuple constraint synonym is better\n------------------------------------------\n\ndata Box2 a = Box2\n    { func2 :: forall num. (Fractional num, Real num) => num -> a -> a\n    , obj2 :: !a }\n\ndo_step2 :: (Fractional num, Real num) => num -> Box2 a -> Box2 a\ndo_step2 number Box2{..} = Box2{ obj2 = func2 number obj2, ..}\n\nstart2 :: Box2 Double\nstart2 = Box2 { func2 = \\x y -> realToFrac x + y\n              , obj2 = 0 }\n\ntest2 :: Int -> IO ()\ntest2 steps = putStrLn $ show $ obj2 $ repeat steps (do_step2 1) start2\n\n---- Not copying the function field works too\n---------------------------------------------\n\ndo_step3 :: (Numerical num) => num -> Box a -> Box a\ndo_step3 number b@Box{..} = b{ obj = func number obj }\n\ntest3 :: Int -> IO ()\ntest3 steps = putStrLn $ show $ obj $ repeat steps (do_step3 1) start\n\n---- But record wildcards are not at fault\n------------------------------------------\n\ndo_step4 :: (Numerical num) => num -> Box a -> Box a\ndo_step4 number Box{func = f, obj = x} = Box{ obj = f number x, func = f }\n\ntest4 :: Int -> IO ()\ntest4 steps = putStrLn $ show $ obj $ repeat steps (do_step4 1) start\n-}\n\n\n{-\nFirst of all, very nice example. Thank you for making it so small and easy to work with.\n\nI can see what's happening. The key part is what happens here:\n{{{\ndo_step4 :: (Numerical num) => num -> Box a -> Box a\ndo_step4 number Box{ func = f, obj = x}\n              = Box{ func = f, obj = f number x }\n}}}\nAfter elaboration (ie making dictionaries explicit) we get this:\n{{{\ndo_step4 dn1 number (Box {func = f, obj = x })\n  = Box { func = \\dn2 -> f ( case dn2 of (f,r) -> f\n                           , case dn2 of (f,r) -> r)\n        , obj = f dn1 number x }\n}}}\nThat's odd!  We expected this:\n{{{\ndo_step4 dn1 number (Box {func = f, obj = x })\n  = Box { func = f\n        , obj = f dn1 number x }\n}}}\nAnd indeed, the allocation of all those `\\dn2` closures is what is causing the problem.\nSo we are missing this optimisation:\n{{{\n   (case dn2 of (f,r) -> f, case dn2 of (f,r) -> r)\n===>\n   dn2\n}}}\nIf we did this, then the lambda would look like `\\dn2 -> f dn2` which could eta-reduce to `f`.\nBut there are at least three problems:\n * The tuple transformation above is hard to spot\n * The tuple transformation is not quite semantically right; if `dn2` was bottom, the LHS and RHS are different\n * The eta-reduction isn't quite semantically right: if `f` ws bottom, the LHS and RHS are different.\n\nYou might argue that the latter two can be ignored because dictionary arguments are special;\nindeed we often toy with making them strict.\n\nBut perhaps a better way to avoid the tuple-transformation issue would be not to construct that strange expression in the first place. Where is it coming from?  It comes from the call to `f` (admittedly applied to no arguments) in `Box { ..., func = f }`.  GHC needs a dictionary for `(Numerical dum)` (I changed the name of the type variable in `func`'s type in the definition of `Box`).  Since it's just a pair GHC says \"fine, I'll build a pair, out of `Fractional dum` and `Real dum`.  How does it get those dictionaries?  By selecting the components of the `Franctional dum` passed to `f`.\n\nIf GHC said instead \"I need `Numerical dum` and behold I have one in hand, it'd be much better. It doesn't because tuple constraints are treated specially.  But if we adopted the idea in #10362, we would (automatically) get to re-use the `Numerical dum` constraint.  That would leave us with eta reduction, which is easier.\n\nAs to what will get you rolling, a good solution is `test3`, which saves instantiating and re-generalising `f`. The key thing is to update all the fields ''except'' the polymorphic `func` field. I'm surprised you say that it doesn't work.  Can you give a (presumably more complicated) example to demonstrate? Maybe there's a separate bug!\n\n-}\n\n\n", "num_lines": 126}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}\nmodule Main ( main ) where\n\nclass Foldable f => C f a where\n  m :: f a -> a\n\ninstance C [] Int where\n  m = foldr (+) 0\n\n{-# NOINLINE go #-}\ngo :: C [] b => b -> Int -> Int\ngo _ i = foldr (+) 0 [1..i]\n\nmain :: IO ()\nmain = print $ go (0 :: Int) 20000\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- We used to inline constructor wrapper functions only when fully applied.\n-- This led to unnecessary boxing when partially applying to unpacked fields.\n\nmodule Main where\nimport Control.DeepSeq\nimport Data.Functor.Identity\nimport Control.Exception (evaluate)\n\ndata AList = Cons !Int !Int !Int !Int !Int !Int !Int !Int !Int AList | Nil\n\n-- We need to write this instance manually because the Generic-derived\n-- instance allocates a ton of intermediate junk, obscuring the interesting\n-- differences.\ninstance NFData AList where\n  rnf Nil = ()\n  rnf (Cons _1 _2 _3 _4 _5 _6 _7 _8 _9 xs) = rnf xs\n\n-- If GHC is allowed to specialize it to Identity, the partial application of\n-- Cons will become a fully saturated one, defeating the test. So we NOINLINE\n-- it.\nbuildalist :: Applicative f => Int -> f AList\nbuildalist n\n  | n <= 0 = pure Nil\n  | otherwise = Cons n (n+1) (n+2) (n+3) (n+4) (n+5) (n+6) (n+7) (n+8) <$>\n                  buildalist (n - 1)\n{-# NOINLINE buildalist #-}\n\nmain = evaluate . rnf . runIdentity $ buildalist 100000\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-full-laziness #-}\n\nmodule Main where\n\nimport Control.Monad (unless)\nimport Data.Time.Clock\nimport System.IO\n\ndata AppState = AppState [Int]\n\ncycleState :: [Int] -> [Int]\ncycleState w =  filter (check w) w\n\ncheck :: [Int] -> Int -> Bool\ncheck world pos = pos `elem` world\n\ninitialSet :: [Int]\ninitialSet = [1]\n\nmain :: IO ()\nmain = appLoop 24 (AppState initialSet)\n\nappLoop :: Int -> AppState -> IO ()\nappLoop n s\n  | n == 0 = return ()\n  | otherwise = do let AppState state = s\n                   print state\n                   appLoop (n-1) $ AppState (cycleState state)\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.IORef\n\nmain :: IO ()\nmain = do\n  ref <- newIORef 10000\n  n <- readIORef ref\n  print $ length $ [0::Int, 2 .. n]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveTraversable #-}\n\nimport Data.Monoid (Endo (..))\nimport Control.Exception (evaluate)\n\ndata Tree a = Bin !(Tree a) a !(Tree a) | Tip\n  deriving (Functor, Foldable)\n\nt1, t2, t3, t4, t5 :: Tree ()\nt1 = Bin Tip () Tip\nt2 = Bin t1 () t1\nt3 = Bin t2 () t2\nt4 = Bin t3 () t3\nt5 = Bin t4 () t4\nt6 = Bin t5 () t5\nt7 = Bin t6 () t6\n\nreplaceManyTimes :: Functor f => f a -> f Int\nreplaceManyTimes xs = appEndo\n  (foldMap (\\x -> Endo (x <$)) [1..20000])\n  (0 <$ xs)\n\nmain :: IO ()\nmain = do\n  evaluate $ sum $ replaceManyTimes t7\n  pure ()\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, GADTs, ExistentialQuantification #-}\n{-# OPTIONS_GHC -cpp #-}\n\nmodule Main where\n\n\nimport Data.Int\nimport GHC.Types\n\n\nfoo :: Int -> Int -> IO Int\nfoo = \\i j -> sfoldl' (+) 0 $ xs i j +++ ys i j\n  where xs k l = senumFromStepN k l 200000\n        ys k l = senumFromStepN k l 300000\n        {-# Inline xs #-}\n        {-# Inline ys #-}\n{-# Inline foo #-}\n\n\n-- We narrow the result to 32-bits to account for the fact that this overflows\n-- on 32-bit machines.\nmain = do { n <- foo 1 1; print (fromIntegral n :: Int32) }\n\n\n\n-------------------------------------------------------------------------------\n-- vector junk\n-------------------------------------------------------------------------------\n\n#define PHASE_FUSED [1]\n#define PHASE_INNER [0]\n\n#define INLINE_FUSED INLINE PHASE_FUSED\n#define INLINE_INNER INLINE PHASE_INNER\n\ndata Stream m a = forall s. Stream (s -> m (Step s a)) s\n\ndata Step s a where\n  Yield :: a -> s -> Step s a\n  Skip  :: s -> Step s a\n  Done  :: Step s a\n\nsenumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a\n{-# INLINE_FUSED senumFromStepN #-}\nsenumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n)\n  where\n    {-# INLINE_INNER step #-}\n    step (w,m) | m > 0     = return $ Yield w (w+y,m-1)\n               | otherwise = return $ Done\n\nsfoldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a\n{-# INLINE sfoldl' #-}\nsfoldl' f = sfoldlM' (\\a b -> return (f a b))\n\nsfoldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a\n{-# INLINE_FUSED sfoldlM' #-}\nsfoldlM' m w (Stream step t) = foldlM'_loop SPEC w t\n  where\n    foldlM'_loop !_ z s\n      = z `seq`\n        do\n          r <- step s\n          case r of\n            Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }\n            Skip    s' -> foldlM'_loop SPEC z s'\n            Done       -> return z\n\ninfixr 5 +++\n(+++) :: Monad m => Stream m a -> Stream m a -> Stream m a\n{-# INLINE_FUSED (+++) #-}\nStream stepa ta +++ Stream stepb tb = Stream step (Left ta)\n  where\n    {-# INLINE_INNER step #-}\n    step (Left  sa) = do\n                        r <- stepa sa\n                        case r of\n                          Yield x sa' -> return $ Yield x (Left  sa')\n                          Skip    sa' -> return $ Skip    (Left  sa')\n                          Done        -> return $ Skip    (Right tb)\n    step (Right sb) = do\n                        r <- stepb sb\n                        case r of\n                          Yield x sb' -> return $ Yield x (Right sb')\n                          Skip    sb' -> return $ Skip    (Right sb')\n                          Done        -> return $ Done\n", "num_lines": 86}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14052 where\n\nexample :: Char\nexample = 'a'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule Main where\n\nimport Prelude\nimport qualified Foreign.Storable as Storable\nimport qualified Control.Monad.State.Strict as S\nimport Control.Monad.IO.Class\nimport Foreign.Marshal.Alloc       (mallocBytes)\n\nnewtype Foo a = Foo a\n\nintSize :: Int\nintSize = Storable.sizeOf (undefined :: Int)\n\n-- This 'go' loop should allocate nothing, because it specialises\n-- for the shape of the state.  But in 8.4 it did (Trac #14936)\n\nslow :: Int -> IO ()\nslow i = do let go 0 = pure ()\n                go j = do Foo (!a, !off) <- S.get\n                          S.put (Foo (a+1, off))\n                          go (j - 1)\n            S.evalStateT (go i) (Foo ((0::Int),(intSize::Int)))\n\nmain = do { slow (10 ^ 7); print \"Done\" }\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport T14955a\n\n--test1 :: [Bool] -> Bool\n--test1 = ors\n\n--test2 :: [Bool] -> Bool\n--test2 = dors boolDict\n\n--test2a :: [Bool] -> Bool\n--test2a xs = dors boolDict xs\n\ntest3 :: [Bool] -> Bool\ntest3 xs = pors xs\n\n--test4 :: [Bool] -> Bool\n--test4 xs = porsProxy xs\n\nmain = print (test3 (replicate 1000000 False))\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\nmodule T14955a where\n\nimport Prelude (Bool(..), (||), (&&))\n\n-- Implementation 1\n\nclass Prop r where\n  or :: r -> r -> r\n  and :: r -> r -> r\n  true :: r\n  false :: r\n\ninstance Prop Bool where\n  or = (||)\n  and = (&&)\n  true = True\n  false = False\n\n-- Implementation 2\n\ndata PropDict r = PropDict {\n  dor :: r -> r -> r\n  , dand :: r -> r -> r\n  , dtrue :: r\n  , dfalse :: r\n  }\n\nboolDict = PropDict {\n  dor = (||)\n  , dand = (&&)\n  , dtrue = True\n  , dfalse = False }\n\n-- Implementation 3\n\nclass PropProxy r where\n  propDict :: PropDict r\n\ninstance PropProxy Bool where\n  propDict = boolDict\n\n-- Implementation 4\n\nclass PropProxy2 r where\n  propDict2 :: PropDict r\n  dummy :: ()\n\ninstance PropProxy2 Bool where\n  propDict2 = boolDict\n  dummy = ()\n\n\nors :: Prop r => [r] -> r\nors [] = true\nors (o:os) = o `or` ors os\n{-# INLINABLE ors #-}\n\ndors :: PropDict r -> [r] -> r\ndors pd [] = dtrue pd\ndors pd (o:os) = dor pd o (dors pd os)\n\npors :: PropProxy r => [r] -> r\npors [] = dtrue propDict\npors (o:os) = dor propDict o (pors os)\n{-# INLINABLE pors #-}\n\nporsProxy :: PropProxy2 r => [r] -> r\nporsProxy [] = dtrue propDict2\nporsProxy (o:os) = dor propDict2 o (porsProxy os)\n{-# INLINABLE porsProxy #-}\n", "num_lines": 73}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\n-- See Trac #149\n\n-- Currently (with GHC 7.0) the CSE works, just,\n-- but it's delicate.\n\n\nimport System.CPUTime\n\nmain :: IO ()\nmain = print $ playerMostOccur1 [1..m]\n\nm :: Int\nm = 22\n\nplayerMostOccur1 :: [Int] -> Int\nplayerMostOccur1 [a] = a\nplayerMostOccur1 (x:xs)\n | numOccur x (x:xs) > numOccur (playerMostOccur1 xs) xs = x\n | otherwise = playerMostOccur1 xs\n\nnumOccur :: Int -> [Int] -> Int\nnumOccur i is = length is\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\n-- See Trac #149\n\n-- Currently (with GHC 7.0) the CSE works, just,\n-- but it's delicate.\n\n\nimport System.CPUTime\n\nmain :: IO ()\nmain = print $ playerMostOccur2 [1..m]\n\nm :: Int\nm = 22\n\nplayerMostOccur2 :: [Int] -> Int\nplayerMostOccur2 [a] = a\nplayerMostOccur2 (x:xs)\n | numOccur x (x:xs) > numOccur pmo xs = x\n | otherwise = pmo\n    where pmo = playerMostOccur2 xs\n\nnumOccur :: Int -> [Int] -> Int\nnumOccur i is = length is\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- T15226\nimport Control.Exception (evaluate)\n\n-- Just in case Prelude.repeat changes for some reason.\nimport Prelude hiding (repeat)\n\n-- We want to be sure that the compiler *doesn't* know that\n-- all the elements of the list are in WHNF, because if it\n-- does, PrelRules may erase the seq#'s altogether.\nrepeat :: a -> [a]\nrepeat a = res\n  where res = a : res\n{-# NOINLINE repeat #-}  -- Belt *and* suspenders\n\nsilly :: [Int] -> IO ()\nsilly = foldr go (pure ())\n  where\n    go x r = do\n      x' <- evaluate x\n      evaluate (x' + 3)  -- GHC should know that x' has been evaluated,\n                         -- so this calculation will be erased entirely.\n                         -- Otherwise, we'll create a thunk to pass to\n                         -- evaluate.\n      r\n\nmain :: IO ()\n-- 10,000,000 repetitions take only a twentieth of a second,\n-- but allocations go up dramatically if the result is not\n-- known evaluated.\nmain = silly $ take 10000000 $ repeat 1\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- T15226\nimport Control.Exception (evaluate)\n\n-- Just in case Prelude.repeat changes for some reason.\nimport Prelude hiding (repeat)\nimport Data.Coerce\n\n-- We want to be sure that the compiler *doesn't* know that\n-- all the elements of the list are in WHNF, because if it\n-- does, PrelRules may erase the seq#'s altogether.\nrepeat :: a -> [a]\nrepeat a = res\n  where res = a : res\n{-# NOINLINE repeat #-}  -- Belt *and* suspenders\n\nnewtype Foo = Foo Int\n\nsilly :: [Int] -> IO ()\nsilly = foldr go (pure ())\n  where\n    go x r = do\n      x' <- (coerce (evaluate :: Foo -> IO Foo) :: Int -> IO Int) x\n      evaluate (x' + 3)  -- GHC should know that x' has been evaluated,\n                         -- so this calculation will be erased entirely.\n                         -- Otherwise, we'll create a thunk to pass to\n                         -- evaluate.\n      r\n\nmain :: IO ()\n-- 10,000,000 repetitions take only a twentieth of a second,\n-- but allocations go up dramatically if the result is not\n-- known evaluated.\nmain = silly $ take 10000000 $ repeat 1\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.List\n\nexpensive :: [Word]\nexpensive = [1 .. 10000]\n\ncheap :: [Word]\ncheap = repeat 2\n\ntest_zipWith :: IO ()\ntest_zipWith = do\n    let zw3 = sum $ zipWith3 (\\a b c -> a*b*c) expensive cheap cheap\n        zw4 = sum $ zipWith4 (\\a b c d -> a*b*c*d) expensive cheap cheap cheap\n        zw5 = sum $ zipWith5 (\\a b c d e ->\n            a*b*c*d*e) expensive cheap cheap cheap cheap\n        zw6 = sum $ zipWith6 (\\a b c d e f ->\n            a*b*c*d*e*f) expensive cheap cheap cheap cheap cheap\n        zw7 = sum $ zipWith7 (\\a b c d e f g ->\n            a*b*c*d*e*f*g) expensive cheap cheap cheap cheap cheap cheap\n\n    putStrLn (\"zipWith3: \" ++ show zw3)\n    putStrLn (\"zipWith4: \" ++ show zw4)\n    putStrLn (\"zipWith5: \" ++ show zw5)\n    putStrLn (\"zipWith6: \" ++ show zw6)\n    putStrLn (\"zipWith7: \" ++ show zw7)\n\ntest_zip3 :: IO ()\ntest_zip3 = do\n    let z3 = foldr (\\(x,y,z) acc -> x*y*z+acc) 0 (zip3 expensive cheap cheap)\n\n    putStrLn (\"zip3: \" ++ show z3)\n\nmain :: IO ()\nmain = do\n    test_zip3\n    test_zipWith\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception (evaluate)\nimport Data.List\n\n-- The following will fuse with minimal heap usage provided\n-- `findIndices` is marked `INLINABLE` instead of `INLINE`.\n\nunsafeFindIndex p = head . findIndices p\n\nmain = do evaluate $ elemIndex 999999 [(1::Int)..1000000]\n          evaluate $ elemIndices 999999 [(1::Int)..1000000]\n          evaluate $ findIndex (>=999999) [(1::Int)..1000000]\n          evaluate $ findIndices (>=999999) [(1::Int)..1000000]\n          evaluate $ unsafeFindIndex (>=999999) [(1::Int)..1000000]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE Strict            #-}\n{-# LANGUAGE BangPatterns      #-}\n{-# LANGUAGE DeriveGeneric     #-}\n\nmodule Main where\n\nimport qualified Data.Set  as Set\nimport qualified Data.Text as Text\n\nimport Data.Set              (Set)\nimport Data.Text             (Text)\nimport System.IO             (BufferMode (NoBuffering), hSetBuffering, stdout)\nimport GHC.Generics          (Generic)\nimport Control.DeepSeq       (force, NFData)\nimport Control.Exception     (evaluate)\n\n\n--------------------------------\n-- === Running benchmarks === --\n--------------------------------\n\niters :: Int\niters = 100000000\n\nsrc1 :: Text\nsrc1 = Text.replicate iters \"tttt\"\n\ndata Grammar a\n    = Tokens !(Set a) !(a -> Bool)\n    | Many   !(Grammar a)\n    | X      !(Grammar a)\n\ninstance Ord a => Semigroup (Grammar a) where\n    Tokens s f <> Tokens s' g = Tokens (s <> s') $ \\c -> f c || g c\n    {-# INLINE (<>) #-}\n\ntoken :: Eq a => a -> Grammar a\ntoken = \\a -> Tokens (Set.singleton a) (a ==)\n{-# INLINE token #-}\n\nmany :: Grammar a -> Grammar a\nmany = Many\n{-# INLINE many #-}\n\ndata Result\n    = Success Text Text\n    | Fail\n    deriving (Show, Generic)\n\ninstance NFData Result\n\nrunTokenParser :: Grammar Char -> Text -> Result\nrunTokenParser = \\grammar stream -> case grammar of\n    Tokens _ tst -> let\n        head = Text.head stream\n        in if tst head\n            then Success (Text.tail stream) (Text.singleton head)\n            else Fail\n    Many (Tokens _ tst) -> let\n        (!consumed, !rest) = Text.span tst stream\n        in Success rest consumed\n    X !grammar -> runTokenParser grammar stream\n\ntestGrammar1 :: Grammar Char\ntestGrammar1 = let\n    s1 = token 't'\n    in many s1\n{-# INLINE testGrammar1 #-}\n\ntest3 :: Text -> Result\ntest3 src =\n  runTokenParser testGrammar1 src\n{-# NOINLINE test3 #-}\n\nmain :: IO ()\nmain = do\n    srcx <- evaluate $ force src1\n    evaluate $ force $ test3 srcx\n    pure ()\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}\n\nmodule Main (main) where\n\nimport T2902_A_PairingSum\n\nf :: Int -> PSum Int Int\nf n = unions $ fmap g [1..n]\n  where\n    g m = unions $ fmap fromList\n      [ zip [m..n] $ repeat 1\n      , zip [m,2+m..n] $ repeat 2\n      , zip [m,3+m..n] $ repeat 3\n      ]\n\nmain \u00e2\u02c6\u00b7 IO ()\nmain = print $ take 20 $ toList $ f 20\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule T2902_A_PairingSum (Sum(..), PSum) where\n\nimport T2902_Sum\n\ndata PSum a b = Empty | Tree a b [(PSum a b)]\n\ninstance (Ord a, Eq b, Num b) \u00e2\u2021\u2019 Sum PSum a b where\n  insert     = insertX\n  union      = unionX\n  unions     = unionsX\n  extractMin = extractMinX\n  fromList   = fromListX\n  toList     = toListX\n\ninsertX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 a \u00e2\u2020\u2019 b \u00e2\u2020\u2019 PSum a b \u00e2\u2020\u2019 PSum a b\ninsertX v r = unionX $ Tree v r []\n\nunionX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 PSum a b \u00e2\u2020\u2019 PSum a b \u00e2\u2020\u2019 PSum a b\nunionX x Empty = x\nunionX Empty x = x\nunionX x@(Tree v r xs) y@(Tree w s ys) =\n  case compare v w of\n    LT \u00e2\u2020\u2019 Tree v r (y:xs)\n    GT \u00e2\u2020\u2019 Tree w s (x:ys)\n    EQ \u00e2\u2020\u2019 case r + s of\n      0 \u00e2\u2020\u2019 z\n      t \u00e2\u2020\u2019 insertX v t z\n  where z = unionX (unionsX xs) (unionsX ys)\n\nunionsX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 [PSum a b] \u00e2\u2020\u2019 PSum a b\nunionsX [] = Empty\nunionsX [x] = x\nunionsX (x : y : zs) = unionX (unionX x y) (unionsX zs)\n\nextractMinX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 PSum a b \u00e2\u2020\u2019 ((a,b), PSum a b)\nextractMinX Empty = undefined\nextractMinX (Tree v r xs) = ((v,r), unionsX xs)\n\nfromListX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 [(a,b)] \u00e2\u2020\u2019 PSum a b\nfromListX [] = Empty\nfromListX ((v,r):xs) = insertX v r $ fromListX xs\n\ntoListX \u00e2\u02c6\u00b7 (Ord a, Eq b, Num b) \u00e2\u2021\u2019 PSum a b \u00e2\u2020\u2019 [(a,b)]\ntoListX Empty = []\ntoListX x = let (y, z) = extractMinX x in y : toListX z\n\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}\n\nmodule Main (main) where\n\nimport T2902_B_PairingSum\n\nf :: Int -> PSum Int Int\nf n = unions $ fmap g [1..n]\n  where\n    g m = unions $ fmap fromList\n      [ zip [m..n] $ repeat 1\n      , zip [m,2+m..n] $ repeat 2\n      , zip [m,3+m..n] $ repeat 3\n      ]\n\nmain \u00e2\u02c6\u00b7 IO ()\nmain = print $ take 20 $ toList $ f 20\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule T2902_B_PairingSum (Sum(..), PSum) where\n\nimport T2902_Sum\n\ndata PSum a b = Empty | Tree a b [PSum a b]\n\ninstance (Ord a, Eq b, Num b) \u00e2\u2021\u2019 Sum PSum a b where\n\n  insert v r = union $ Tree v r []\n\n  union x Empty = x\n  union Empty x = x\n  union x@(Tree v r xs) y@(Tree w s ys) =\n    case compare v w of\n      LT \u00e2\u2020\u2019 Tree v r (y:xs)\n      GT \u00e2\u2020\u2019 Tree w s (x:ys)\n      EQ \u00e2\u2020\u2019 case r + s of\n        0 \u00e2\u2020\u2019 z\n        t \u00e2\u2020\u2019 insert v t z\n    where z = union (unions xs) (unions ys)\n\n  unions [] = Empty\n  unions [x] = x\n  unions (x : y : zs) = union (union x y) (unions zs)\n\n  extractMin Empty = undefined\n  extractMin (Tree v r xs) = ((v,r), unions xs)\n\n  fromList [] = Empty\n  fromList ((v,r):xs) = insert v r $ fromList xs\n\n  toList Empty = []\n  toList x = let (y, z) = extractMin x in y : toList z\n\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses #-}\n\nmodule T2902_Sum (Sum(..)) where\n\nclass Sum c a b where\n  insert     \u00e2\u02c6\u00b7 a \u00e2\u2020\u2019 b \u00e2\u2020\u2019 c a b \u00e2\u2020\u2019 c a b\n  union      \u00e2\u02c6\u00b7 c a b \u00e2\u2020\u2019 c a b \u00e2\u2020\u2019 c a b\n  unions     \u00e2\u02c6\u00b7 [c a b] \u00e2\u2020\u2019 c a b\n  extractMin \u00e2\u02c6\u00b7 c a b \u00e2\u2020\u2019 ((a,b), c a b)\n\n  fromList   \u00e2\u02c6\u00b7 [(a,b)] \u00e2\u2020\u2019 c a b\n  toList     \u00e2\u02c6\u00b7 c a b \u00e2\u2020\u2019 [(a,b)]\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}\n\n-- The second version (count2) took ages with GHC 6.12\n-- because the typeOf function was not properly memoised\n\nimport Data.Typeable\nimport System.CPUTime\n\nsize :: Int\nsize = 40000    -- This was big enough to take 5 seconds in\n                -- the bad case on my machine.\n\ndata Any = forall a. (Typeable a) => Any a\n\nint_type, int_list_type :: TypeRep\nint_type = typeOf (undefined :: Int)\nint_list_type = typeOf (undefined :: [Int])\n\ncount1 :: [Any] -> Int\ncount1 [] = 0\ncount1 (Any x:xs) = count1 xs + (if typeOf x == int_type then 1 else 0)\n\ndoTime x = do\n  start <- getCPUTime\n  putStr \"Result: \"\n  print x\n  stop <- getCPUTime\n  putStr \"Time(sec): \"\n  print (round $ fromIntegral (stop - start) / 1e12)\n    -- The 'round' rounds to an integral number of seconds\n    -- Should be zero if things are working right!\n\nmain = do\n  let list = [MkT | i <- [1..size  :: Int]]\n  putStrLn \"count1\"\n  let x = map Any list\n  doTime $ count1 x\n  doTime $ count1 x\n  doTime $ count1 x\n  putStrLn \"\"\n  putStrLn \"count2\"\n  let x = map (Any . (:[])) list\n  doTime $ count1 x\n  doTime $ count1 x\n  doTime $ count1 x\n\ndata T = MkT deriving Typeable\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# OPTIONS -fvia-C -optc-O3 -fexcess-precision -optc-msse3 #-}\n\nimport Control.Monad.ST\nimport Data.Array.ST\nimport Data.Array.Base\n\nmain = print $ runST\n          (do arr <- newArray (1,2000000) 137.0 :: ST s (STUArray s Int Double)\n              go arr 2000000 0.0 )\n\n\ngo :: STUArray s Int Double -> Int -> Double -> ST s Double\ngo !a i !acc\n    | i < 1     = return acc\n    | otherwise = do\n         b <- unsafeRead a i\n         unsafeWrite a i (b+3.0)\n         c <- unsafeRead a i\n         go a (i-1) (c+acc)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -funbox-strict-fields -O #-}\n{-# LANGUAGE ExistentialQuantification #-}\n\n{- OPTIONS_GHC -ddump-simpl -ddump-asm -}\n\nmodule Main (main) where\n\nimport GHC.Float (float2Int, int2Float)\n\nimport System.Environment\n\nimport Prelude hiding           (null\n                                ,lines,unlines\n                                ,writeFile\n                                )\n\nimport Control.Exception        (assert, bracket, )\n\nimport Foreign.Marshal.Array    (advancePtr)\nimport Foreign.Ptr              (minusPtr)\nimport Foreign.Storable         (Storable(..))\n\nimport Control.Monad            (when)\n\nimport System.IO                (openBinaryFile, hClose,\n                                 hPutBuf,\n                                 Handle, IOMode(..))\n\nimport System.IO.Unsafe         (unsafePerformIO)\n\nimport Foreign.Ptr              (Ptr)\nimport Foreign.ForeignPtr       (ForeignPtr, withForeignPtr, )\nimport Foreign.Marshal.Array    (copyArray)\n\nimport qualified Foreign.ForeignPtr as F\n\nmain :: IO ()\nmain = do args <- getArgs\n          case args of\n              [\"1\"] -> mainMonolithic1Generator\n              [\"2\"] -> mainMonolithic1Composed\n              _ -> error \"Huh?\"\n\ntype Phase = (Float, Float, Float)\n\n{-# INLINE saw #-}\nsaw :: Num a => a -> a\nsaw t = 1-2*t\n\n{-# INLINE fraction #-}\nfraction :: Float -> Float\nfraction x = x - int2Float (float2Int x)\n\n{-# INLINE generator0Freq #-}\ngenerator0Freq :: Float -> Float -> Maybe (Float, Float)\ngenerator0Freq freq =\n   \\p -> Just (saw p, fraction (p+freq))\n\ninfixl 6 `mix`, `mixGen`\n\n{-# INLINE mix #-}\nmix ::\n   (Num y) =>\n   (s -> Maybe (y, s)) ->\n   (t -> Maybe (y, t)) ->\n   ((s,t) -> Maybe (y, (s,t)))\nmix f g (s0,t0) =\n   do (a,s1) <- f s0\n      (b,t1) <- g t0\n      return ((a+b), (s1,t1))\n\ndata Generator a =\n   forall s.\n      Generator (s -> Maybe (a, s)) s\n\n{-# INLINE runGeneratorMonolithic #-}\nrunGeneratorMonolithic :: Int -> Generator Float -> Vector Float\nrunGeneratorMonolithic size' (Generator f s) =\n   fst $ unfoldrN size' f s\n\n{- SPECIALISE INLINE generator0Gen :: Float -> Float -> Generator Float -}\n{-# INLINE generator0Gen #-}\ngenerator0Gen :: Float -> Float -> Generator Float\ngenerator0Gen freq phase =\n   Generator (\\p -> Just (saw p, fraction (p+freq))) phase\n\n{- SPECIALISE INLINE mixGen :: Generator Float -> Generator Float -> Generator Float -}\n{-# INLINE mixGen #-}\nmixGen ::\n   (Num y) =>\n   Generator y ->\n   Generator y ->\n   Generator y\nmixGen (Generator f s) (Generator g t) =\n   Generator (\\(s0,t0) ->\n      do (a,s1) <- f s0\n         (b,t1) <- g t0\n         return ((a+b), (s1,t1))) (s,t)\n\n{-# INLINE dl #-}\ndl :: Phase\ndl = (0.01008, 0.01003, 0.00990)\n\n{-# INLINE initPhase2 #-}\ninitPhase2 :: (Phase, Phase)\ninitPhase2 =\n   ((0,0.7,0.1), (0.3,0.4,0.6))\n\n\nsize :: Int\nsize = 10000000\n\n\nmainMonolithic1Composed :: IO ()\nmainMonolithic1Composed =\n   writeFile \"T3736.speed.f32\"\n      (fst $ unfoldrN size\n          (let (f0,f1,f2) = dl\n           in  generator0Freq f0 `mix`\n               generator0Freq f1 `mix`\n               generator0Freq f2)\n          (let (p0,p1,p2) = fst initPhase2\n           in  ((p0,p1),p2)))\n\nmainMonolithic1Generator :: IO ()\nmainMonolithic1Generator =\n   writeFile \"T3736.speed.f32\"\n      (runGeneratorMonolithic size\n          (let (f0,f1,f2) = dl\n               (p0,p1,p2) = fst initPhase2\n           in  generator0Gen f0 p0 `mixGen`\n               generator0Gen f1 p1 `mixGen`\n               generator0Gen f2 p2))\n\nempty :: (Storable a) => Vector a\nempty = unsafeCreate 0 $ const $ return ()\n{-# NOINLINE empty #-}\n\nnull :: Vector a -> Bool\nnull (SV _ _ l) = assert (l >= 0) $ l <= 0\n{-# INLINE null #-}\n\nunfoldrN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)\nunfoldrN n f x0 =\n   if n <= 0\n     then (empty, Just x0)\n     else unsafePerformIO $ createAndTrim' n $ \\p -> go p n x0\n       where\n          go = arguments2 $ \\p i -> \\x ->\n             if i == 0\n               then return (0, n-i, Just x)\n               else\n                 case f x of\n                   Nothing     -> return (0, n-i, Nothing)\n                   Just (w,x') -> do poke p w\n                                     go (incPtr p) (i-1) x'\n{-# INLINE unfoldrN #-}\n\nhPut :: (Storable a) => Handle -> Vector a -> IO ()\nhPut h v =\n   when (not (null v)) $\n      withStartPtr v $ \\ ptrS l ->\n         let ptrE = advancePtr ptrS l\n         in  hPutBuf h ptrS (minusPtr ptrE ptrS)\n\nwriteFile :: (Storable a) => FilePath -> Vector a -> IO ()\nwriteFile f txt =\n   bracket (openBinaryFile f WriteMode) hClose\n      (\\h -> hPut h txt)\n\ndata Vector a = SV {-# UNPACK #-} !(ForeignPtr a)\n                   {-# UNPACK #-} !Int                -- offset\n                   {-# UNPACK #-} !Int                -- length\n\nwithStartPtr :: Storable a => Vector a -> (Ptr a -> Int -> IO b) -> IO b\nwithStartPtr (SV x s l) f =\n   withForeignPtr x $ \\p -> f (p `advancePtr` s) l\n{-# INLINE withStartPtr #-}\n\nincPtr :: (Storable a) => Ptr a -> Ptr a\nincPtr v = advancePtr v 1\n{-# INLINE incPtr #-}\n\nunsafeCreate :: (Storable a) => Int -> (Ptr a -> IO ()) -> Vector a\nunsafeCreate l f = unsafePerformIO (create l f)\n{-# INLINE unsafeCreate #-}\n\ncreate :: (Storable a) => Int -> (Ptr a -> IO ()) -> IO (Vector a)\ncreate l f = do\n    fp <- mallocForeignPtrArray l\n    withForeignPtr fp $ \\p -> f p\n    return $! SV fp 0 l\n\ncreateAndTrim' :: (Storable a) => Int\n                               -> (Ptr a -> IO (Int, Int, b))\n                               -> IO (Vector a, b)\ncreateAndTrim' l f = do\n    fp <- mallocForeignPtrArray l\n    withForeignPtr fp $ \\p -> do\n        (off, l', res) <- f p\n        if assert (l' <= l) $ l' >= l\n            then return $! (SV fp 0 l, res)\n            else do ps <- create l' $ \\p' -> copyArray p' (p `advancePtr` off) l'\n                    return $! (ps, res)\n\n{-# INLINE arguments2 #-}\narguments2 :: (a -> b -> x) -> a -> b -> x\narguments2 f = \\a b -> (f $! a) $! b\n\n{-# INLINE mallocForeignPtrArray #-}\nmallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)\nmallocForeignPtrArray = F.mallocForeignPtrArray\n", "num_lines": 213}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport T3738a\n\n{-# INLINE bar #-}\nbar :: Int -> [Int]\nbar x = map (+ 2) (foo x)\n\nmain = print (bar 2 !! 10000)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3738a where\n\n{-# INLINE foo #-}\nfoo :: Num a => a -> [a]\nfoo x = map (+ 1) (repeat x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data Tree a = Leaf | Node a !(Tree a) !(Tree a)\n\n{-\n\nThis should produce a walker with unboxed integers.\n\nBad:\n\nRec {\ngo_r1us\n  :: GHC.Types.Int -> Main.Tree GHC.Types.Int -> GHC.Types.Int\n[GblId, Arity=2, Caf=NoCafRefs, Str=SS]\ngo_r1us =\n  \\ (z_aeS :: GHC.Types.Int) (ds_dmD :: Main.Tree GHC.Types.Int) ->\n    case ds_dmD of _ {\n      Main.Leaf -> z_aeS;\n      Main.Node a1_aeU l_aeV r_aeW ->\n        case go_r1us z_aeS l_aeV of _ { GHC.Types.I# ipv_snn ->\n        case a1_aeU of _ { GHC.Types.I# y_anh ->\n        go_r1us (GHC.Types.I# (GHC.Prim.+# ipv_snn y_anh)) r_aeW\n        }\n        }\n    }\nend Rec }\n\n\nGood:\n\nRec {\n$wgo_r2fS\n  :: GHC.Prim.Int# -> Main.Tree GHC.Types.Int -> GHC.Prim.Int#\n[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><S,1*U>]\n$wgo_r2fS =\n  \\ (ww_s2eZ :: GHC.Prim.Int#) (w_s2eW :: Main.Tree GHC.Types.Int) ->\n    case w_s2eW of _ [Occ=Dead] {\n      Main.Leaf -> ww_s2eZ;\n      Main.Node a1_aqv l_aqw r_aqx ->\n        case $wgo_r2fS ww_s2eZ l_aqw of ww1_s2f3 { __DEFAULT ->\n        case a1_aqv of _ [Occ=Dead] { GHC.Types.I# y_aTz ->\n        $wgo_r2fS (GHC.Prim.+# ww1_s2f3 y_aTz) r_aqx\n        }\n        }\n    }\nend Rec }\n\n-}\n\n-- Strict, pre-order fold.\nfold' :: (a -> b -> a) -> a -> Tree b -> a\nfold' f = go\n  where\n    go z Leaf = z\n    go z (Node a l r) = let z'  = go z l\n                            z'' = f z' a\n                        in z' `seq` z'' `seq` go z'' r\n\n\nsumTree :: Int -> Tree Int -> Int\nsumTree = fold' (+)\n\n\ntree = Node 0 (Node 0 Leaf Leaf) (Node 0 Leaf Leaf)\n\nmain = sum [sumTree n tree | n <- [0..1000]] `seq` return ()\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- In 6.13 this stack overflowed\n\nmodule Main (main) where\n\nmain :: IO ()\nmain = let n = 1000000\n       in print $ integrate n (1 / fromIntegral n)\n\nintegrate :: Int -> Double -> Double\nintegrate n h = h * (sum (map area [1..n]))\n    where area :: Int -> Double\n          area i = let x = h * (fromIntegral i - 0.5)\n                   in 4 / (1 + x*x)\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\ndata Tree = Leaf !Int | Fork !Tree !Tree deriving Show\n\nfullTree 0 = Leaf 1\nfullTree n = let t = fullTree (n - 1) in Fork t t\n\nflatListNaive (Leaf n)   = [n]\nflatListNaive (Fork a b) = flatListNaive a ++ flatListNaive b\n\nflatListCons t = flat t []\n  where\n  flat (Leaf n)   ns = n : ns\n  flat (Fork a b) ns = flat a (flat b ns)\n\nflatListCons2 t = flat t []\n  where\n  flat (Leaf n)   = \\ns -> n : ns\n  flat (Fork a b) = \\ns -> flat a (flat b ns)\n\nflatListCons3 t = flat t []\n  where\n  flat (Leaf n)   = (n :)\n  flat (Fork a b) = flat a . flat b\n\nflatDList (Leaf n)   = (n :)\nflatDList (Fork a b) = flatDList a . flatDList b\n\nsumList l = loop 0 l\n  where loop !c [] = c\n        loop !c (h:t) = loop (c + h) t\n\nsumDList l = loop 0 (l [])\n  where loop !c []      = c\n        loop !c (h : t) = loop (c + h) t\n\nmain = print $ sumList  $ flatListCons  $ fullTree 26\n\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\ndata Tree = Leaf !Int | Fork !Tree !Tree deriving Show\n\nfullTree 0 = Leaf 1\nfullTree n = let t = fullTree (n - 1) in Fork t t\n\nflatListNaive (Leaf n)   = [n]\nflatListNaive (Fork a b) = flatListNaive a ++ flatListNaive b\n\nflatListCons t = flat t []\n  where\n  flat (Leaf n)   ns = n : ns\n  flat (Fork a b) ns = flat a (flat b ns)\n\nflatListCons2 t = flat t []\n  where\n  flat (Leaf n)   = \\ns -> n : ns\n  flat (Fork a b) = \\ns -> flat a (flat b ns)\n\nflatListCons3 t = flat t []\n  where\n  flat (Leaf n)   = (n :)\n  flat (Fork a b) = flat a . flat b\n\nflatDList (Leaf n)   = (n :)\nflatDList (Fork a b) = flatDList a . flatDList b\n\nsumList l = loop 0 l\n  where loop !c [] = c\n        loop !c (h:t) = loop (c + h) t\n\nsumDList l = loop 0 (l [])\n  where loop !c []      = c\n        loop !c (h : t) = loop (c + h) t\n\nmain = print $ sumList  $ flatListCons2 $ fullTree 26\n\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\ndata Tree = Leaf !Int | Fork !Tree !Tree deriving Show\n\nfullTree 0 = Leaf 1\nfullTree n = let t = fullTree (n - 1) in Fork t t\n\nflatListNaive (Leaf n)   = [n]\nflatListNaive (Fork a b) = flatListNaive a ++ flatListNaive b\n\nflatListCons t = flat t []\n  where\n  flat (Leaf n)   ns = n : ns\n  flat (Fork a b) ns = flat a (flat b ns)\n\nflatListCons2 t = flat t []\n  where\n  flat (Leaf n)   = \\ns -> n : ns\n  flat (Fork a b) = \\ns -> flat a (flat b ns)\n\nflatListCons3 t = flat t []\n  where\n  flat (Leaf n)   = (n :)\n  flat (Fork a b) = flat a . flat b\n\nflatDList (Leaf n)   = (n :)\nflatDList (Fork a b) = flatDList a . flatDList b\n\nsumList l = loop 0 l\n  where loop !c [] = c\n        loop !c (h:t) = loop (c + h) t\n\nsumDList l = loop 0 (l [])\n  where loop !c []      = c\n        loop !c (h : t) = loop (c + h) t\n\nmain = print $ sumList  $ flatListCons3 $ fullTree 26\n\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Compile with O2; SpecConstr should fire nicely\n-- and eliminate all allocation in inner loop\n\nmodule Main where\n\nfoo :: Int -> Maybe (Double,Double) -> Double\nfoo _ Nothing      = 0\nfoo 0 (Just (x,y)) = x+y\nfoo n (Just (x,y)) = let r = f x y in r `seq` foo (n-1) (Just r)\n  where\n    f x y | x <= y    = (x,y)\n          | otherwise = (y,x)\n\nmain = print (foo 1000000 (Just (1,2)))\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport qualified Data.ByteString as S\nimport qualified Data.ByteString.Lazy as L\nimport Data.ByteString.Internal (inlinePerformIO)\nimport qualified Data.ByteString.Internal as S\nimport Data.Semigroup\nimport Data.Monoid\nimport Foreign\nimport System.IO.Unsafe\n\nnewtype Builder = Builder {\n        runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]\n    }\n\ninstance Semigroup Builder where\n    (<>) = append\n    {-# INLINE (<>) #-}\n\ninstance Monoid Builder where\n    mempty  = empty\n    {-# INLINE mempty #-}\n    mconcat = foldr mappend mempty\n    {-# INLINE mconcat #-}\n\nempty :: Builder\nempty = Builder (\\ k b -> b `seq` k b)\n{-# INLINE empty #-}\n\nsingleton :: Word8 -> Builder\nsingleton = writeN 1 . flip poke\n{-# INLINE singleton #-}\n\nappend :: Builder -> Builder -> Builder\nappend (Builder f) (Builder g) = Builder (f . g)\n{-# INLINE [0] append #-}\n\n-- Our internal buffer type\ndata Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)\n                     {-# UNPACK #-} !Int                -- offset\n                     {-# UNPACK #-} !Int                -- used bytes\n                     {-# UNPACK #-} !Int                -- length left\n\n-- | /O(1)./ Pop the 'S.ByteString' we have constructed so far, if any,\n-- yielding a new chunk in the result lazy 'L.ByteString'.\nflush :: Builder\nflush = Builder $ \\ k buf@(Buffer p o u l) ->\n    if u == 0\n      then k buf\n      else S.PS p o u : k (Buffer p (o+u) 0 l)\n\n-- | /O(n)./ Extract a lazy 'L.ByteString' from a 'Builder'.\n-- The construction work takes place if and when the relevant part of\n-- the lazy 'L.ByteString' is demanded.\n--\ntoLazyByteString :: Builder -> L.ByteString\ntoLazyByteString m = L.fromChunks $ unsafePerformIO $ do\n    buf <- newBuffer defaultSize\n    return (runBuilder (m `append` flush) (const []) buf)\n{-# INLINE toLazyByteString #-}\n\ndefaultSize :: Int\ndefaultSize = 32 * k - overhead\n    where k = 1024\n          overhead = 2 * sizeOf (undefined :: Int)\n\n-- | Sequence an IO operation on the buffer\nunsafeLiftIO :: (Buffer -> IO Buffer) -> Builder\nunsafeLiftIO f =  Builder $ \\ k buf -> inlinePerformIO $ do\n    buf' <- f buf\n    return (k buf')\n{-# INLINE unsafeLiftIO #-}\n\n-- | Get the size of the buffer\nwithSize :: (Int -> Builder) -> Builder\nwithSize f = Builder $ \\ k buf@(Buffer _ _ _ l) -> runBuilder (f l) k buf\n\n-- | Ensure that there are at least @n@ many bytes available.\nensureFree :: Int -> Builder\nensureFree n = n `seq` withSize $ \\ l ->\n    if n <= l then empty else\n        flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize)))\n{-# INLINE [0] ensureFree #-}\n\n-- | Ensure that @n@ many bytes are available, and then use @f@ to write some\n-- bytes into the memory.\nwriteN :: Int -> (Ptr Word8 -> IO ()) -> Builder\nwriteN n f = ensureFree n `append` unsafeLiftIO (writeNBuffer n f)\n{-# INLINE [0] writeN #-}\n\nwriteNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer\nwriteNBuffer n f (Buffer fp o u l) = do\n    withForeignPtr fp (\\p -> f (p `plusPtr` (o+u)))\n    return (Buffer fp o (u+n) (l-n))\n{-# INLINE writeNBuffer #-}\n\nnewBuffer :: Int -> IO Buffer\nnewBuffer size = do\n    fp <- S.mallocByteString size\n    return $! Buffer fp 0 0 size\n{-# INLINE newBuffer #-}\n\n-- Merge buffer bounds checks.\n{-# RULES\n\"append/writeN\" forall a b (f::Ptr Word8 -> IO ())\n                           (g::Ptr Word8 -> IO ()) ws.\n    append (writeN a f) (append (writeN b g) ws) =\n        append (writeN (a+b) (\\p -> f p >> g (p `plusPtr` a))) ws\n\n\"writeN/writeN\" forall a b (f::Ptr Word8 -> IO ())\n                           (g::Ptr Word8 -> IO ()).\n    append (writeN a f) (writeN b g) =\n        writeN (a+b) (\\p -> f p >> g (p `plusPtr` a))\n\n\"ensureFree/ensureFree\" forall a b .\n    append (ensureFree a) (ensureFree b) = ensureFree (max a b)\n #-}\n\n-- Test case\n\n-- Argument must be a multiple of 4.\ntest :: Int -> Builder\ntest 0 = mempty\ntest n = singleton 1 `mappend`\n         (singleton 2 `mappend`\n          (singleton 3 `mappend`\n           (singleton 4 `mappend` test (n-4))))\n\nmain = print $ L.length $ toLazyByteString $ test 10000000\n", "num_lines": 130}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, FlexibleContexts #-}\nmodule Main where\n\nimport Data.Array.Base (unsafeRead, unsafeWrite)\nimport Data.Array.ST\nimport Data.Array.Unboxed\nimport Control.Monad.ST\n\nmain = print (divisorCounts 1000000 ! 342)\n\nisqrt :: Int -> Int\nisqrt n = floor (sqrt $ fromIntegral n)\n\ndivisorCounts :: Int -> UArray Int Int\ndivisorCounts n = runSTUArray $ do\n    let !rt = isqrt n\n    darr <- newArray (0,n) 1 :: ST s (STUArray s Int Int)\n    let inc i = unsafeRead darr i >>= \\k -> unsafeWrite darr i (k+1)\n        note step i\n            | i > n     = return ()\n            | otherwise = do\n                inc i\n                note step (i+step)\n        count j\n            | j > rt    = return ()\n            | otherwise = do\n                note (2*j) (j*j)\n                count (j+2)\n    note 2 4\n    count 3\n    return darr\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Concurrent\nimport Control.Monad\n\nmain :: IO ()\nmain = do t <- forkIO (x >> x)\n          threadDelay 1000000\n          killThread t\n          putStrLn \"Done\"\n\nx :: IO ()\nx = forever yield\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Main (main) where\n\n-- Test that the rewrite rules for small exponents fire (#5237).\n-- If they don't fire, this will allocate much.\n\nfun :: Double -> Double\nfun x = go 0 1.0\n  where\n    go !acc z\n      | x < z   = acc\n      | otherwise = go (acc + 1/z^4) (z+1.0)\n\nmain :: IO ()\nmain = print (fun 1e7)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmain :: IO ()\nmain = do writeFile \"T5536.data\" (replicate 10000000 'a')\n          readFile \"T5536.data\" >>= putStr\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n-- See Trac #5549\n-- The issue here is allocating integer constants inside a loop\n\n\nlcs3 :: Eq a => [a] -> [a] -> [a]\nlcs3 a b = fst $ aux (a, length a) (b, length b)\n  where\n    aux (_,0) _ = ([],0)\n    aux _ (_,0) = ([],0)\n    aux (a@(ha:as),la) (b@(hb:bs), lb)\n      | ha == hb  = let (s,n) = aux (as,la-1) (bs,lb-1) in (ha : s, n+1)\n      | otherwise =\n        let (sa,na) = aux (as,la-1) (b,lb)\n            (sb,nb) = aux (a,la) (bs,lb-1) in\n        if na > nb then (sa,na) else (sb,nb)\n\nf :: Integer -> Integer -> Integer\nf acc 0 = acc\nf acc n = g (acc + 1) (n-1)\n\ng :: Integer -> Integer -> Integer\ng acc 0 = acc\ng acc n = f (acc -1) (n-1)\n\nmain = do putStrLn . show $ f 0 100000000\n          putStrLn . show $ lcs3 [1..20] [10..20]\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule Main where\n\ndata T t a where\n  T :: (Foldable t, Eq a) => t a -> T t a\n\n{-# NOINLINE go #-}\ngo :: T [] a -> Int -> Int\ngo (T _) i = foldr (+) 0 [1..i]\n\nmain = print (go (T [1::Int]) 20000)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.List\n\n{-\nThis should get a worker that takes three arguments.\n\nbad:\n\nRec {\n$we_r1z8\n  :: (GHC.Types.Int, GHC.Types.Int)\n     -> GHC.Prim.Int# -> (# GHC.Types.Int, GHC.Types.Int #)\n[GblId, Arity=2, Caf=NoCafRefs, Str=S(AA)L]\n$we_r1z8 =\n  \\ (w_s1yf :: (GHC.Types.Int, GHC.Types.Int))\n    (ww_s1yi :: GHC.Prim.Int#) ->\n    case GHC.Prim.># ww_s1yi 10 of _ {\n      GHC.Types.False -> $we_r1z8 w_s1yf (GHC.Prim.+# ww_s1yi 1);\n      GHC.Types.True ->\n        case w_s1yf of _ { (ww2_s1yp, ww3_s1yq) ->\n        (# ww2_s1yp, ww3_s1yq #)\n        }\n    }\nend Rec }\n\nGood:\n\nRec {\n$we_r2qK\n  :: GHC.Types.Int\n     -> GHC.Types.Int\n     -> GHC.Prim.Int#\n     -> (# GHC.Types.Int, GHC.Types.Int #)\n[GblId, Arity=3, Caf=NoCafRefs, Str=<L,U><L,U><L,U>]\n$we_r2qK =\n  \\ (ww_s2pS :: GHC.Types.Int)\n    (ww1_s2pT :: GHC.Types.Int)\n    (ww2_s2pX :: GHC.Prim.Int#) ->\n    case GHC.Prim.tagToEnum# @ GHC.Types.Bool (GHC.Prim.># ww2_s2pX 10)\n    of _ [Occ=Dead] {\n      GHC.Types.False ->\n        $we_r2qK ww_s2pS ww1_s2pT (GHC.Prim.+# ww2_s2pX 1);\n      GHC.Types.True -> (# ww_s2pS, ww1_s2pT #)\n    }\nend Rec }\n\n-}\n\n\n\ne :: (Int, Int) -> Int -> (Int, Int)\ne x y = x `seq` if y > 10\n        then x\n        else e x (y + 1)\n\n\nmain = foldr (seq) 0 [e (n,0) 0| n <- [0..10000]] `seq` return ()\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Main where\n\nimport qualified Data.ByteString as S\nimport Data.IORef\nimport Control.Monad\n\nmakeBs :: Int -> S.ByteString\nmakeBs n = S.replicate n (fromIntegral n)\n\ndoStuff :: IORef [S.ByteString] -> Int -> IO ()\ndoStuff ref n = do\n    let !bs = makeBs n\n    modifyIORef ref (bs:)\n{-# NOINLINE doStuff #-}\n\nundo :: IORef [S.ByteString] -> IO ()\nundo ref = do\n    h <- atomicModifyIORef ref (\\(x:xs) -> (xs,x))\n    S.length h `seq` return ()\n\nmain = do\n    ref <- newIORef [S.empty]\n    let fn n = do\n        doStuff ref n\n        when (rem 5 n /= 0 ) $ undo ref\n\n    mapM_ fn (take 5000000 $ cycle [1..100])\n    var <- readIORef ref\n    print $ length var\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}\nmodule Main where\n\nimport Prelude hiding (foldr)\nimport Data.Foldable\n\ndata List a = Nil | Cons a (List a)\n    deriving (Functor, Foldable)\n\nmkList :: Int -> List Int\nmkList 0 = Nil\nmkList n = Cons n (mkList (n-1))\n\nmain :: IO ()\nmain = print $ foldr (\\x y -> y) \"end\" (mkList n)\n  where n = 40000\n  -- Increase this to increase the difference between good and bad\n  -- Eg 6000 takes a lot longer\n  -- The biggest difference is not allocation or bytes used,\n  -- but execution time!\n\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Int\nimport System.Environment\n\nbitcount x = if x > 0 \n    then let (d,m) = divMod x 2 in  bitcount d + m\n    else 0\n\nmain = print $ sum  $ map bitcount \n       [ 0 :: Int64 .. 2^20 - 1 ]\n\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Main where\ndata family Foo a\n\ndata instance Foo Int = FooInt Int Int\n\nfoo :: Foo Int -> Int\nfoo (FooInt a 0) = 0\nfoo (FooInt a b) = foo (FooInt a (b-1))\n\nmain :: IO ()\nmain = foo (FooInt 0 10000) `seq` return ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\nmodule Main where\n\nimport T7797a \n\ndata Box = forall a. (Size a) => Box a a \n\nbox = Box (go 10000000) (go 10000000) where\n  go :: Int -> [Int]\n  go 0 = []\n  go n = 1 : go (n - 1)\n{-# NOINLINE box #-}\n\nmain = print $ case box of\n  Box l r -> size l r\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7797a where\n\nclass Size t where\n  size :: t -> t -> Int\n  burg :: t -> t\n\ninstance (Ord a, Num a) => Size [a] where\n  {-# SPECIALISE instance Size [Int] #-}\n  size (x:xs) (y:ys) | x+y > 4   = size xs ys\n                     | otherwise = size xs ys\n  size _ _ = 0\n  burg = error \"urk\"\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE BangPatterns #-}\n\nmain :: IO ()\nmain = print $ ack 4 1\n\nack :: Int -> Int -> Int\nack 0 !n = n+1\nack m  0 = ack (m-1) 1\nack m  n = ack (m-1) $ ack m (n-1)\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nnorm ::  [Double] -> Double\nnorm = sqrt . sum . map (\\x -> x*x)\n   \nmain :: IO ()\nmain = print (norm (enumFromTo 0 10000000) > 100) \n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule Main (f, main) where\n\nimport GHC.Exts(Ptr(..))\nimport Foreign.Ptr\n\n-- We should be able to inline this function.\nf :: Ptr Int -> Int -> Int\nf =\n  let x = \"foo\"#\n  in \\p n -> n + (Ptr x `minusPtr` p)\n\nmain :: IO ()\nmain = print $ x `mod` 2 == (x + 4) `mod` 2\n  where\n    x = go (10000::Int) 4\n    go 0 a = a\n    go n a = go (n-1) (f nullPtr a)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test allocates a lot more if length is\n-- not a good consumer\n\nmodule Main where\nimport System.Environment (getArgs)\n\nfoo :: Int -> Int\nfoo n = sum [ length [i..n] | i <- [1..n] ]\n\nmain = do { [arg] <- getArgs\n          ; print (foo (read arg)) }\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | The fusion helper for @enumFromThenTo \\@Int@ had multiple\n-- occurences of @c@, which made the simplifier refuse to inline it.\n-- The new implementation for @efdtInt{Up,Dn}FB@ only have a single\n-- occurence of @c@ which the simplifier inlines unconditionally.\nmodule Main  (main) where\n\nimport Control.Monad (when, forM_)\nimport GHC.ST\n\nnop :: Monad m => a -> m ()\nnop _ = return ()\n{-# NOINLINE nop #-}\n\n-- This is the baseline, using @enumFromTo@ which already had only a\n-- single occurence of @c@.\nf :: Int -> ST s ()\nf n =\n    do\n      forM_ [2..n] $ \\p -> do\n        let isPrime = p == (p - 1)\n        when isPrime $\n          forM_ [p + p, p + p + p .. n] $ \\k ->  do\n            nop k\n{-# NOINLINE f #-}\n\ng :: Int -> ST s ()\ng n =\n    do\n      forM_ [2,3..n] $ \\p -> do\n        -- This do block should be too big to get inlined multiple times.\n        -- Pad with @nop@s as necessary if this doesn't reproduce anymore.\n        let isPrime = p == (p - 1)\n        when isPrime $\n          forM_ [p + p, p + p + p .. n] $ \\k ->  do\n            nop k\n{-# NOINLINE g #-}\n\nmain :: IO ()\nmain = do\n  -- runST (f 40000000) `seq` return ()\n  runST (g 40000000) `seq` return ()\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Typeable\n\nf :: Typeable a => Int -> a -> TypeRep\nf 0 a = typeOf a\nf n a = f (n-1) [a]\n\nmain = print (f 50000 () == f 50001 ())\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests that `last` successfully fuses.\n\nmain :: IO ()\nmain = print $ last $ filter odd $ [1::Int ..10000000]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Data.List\n\nmain :: IO ()\nmain = print $ length $ show (foldl' (*) 1 [1..100000] :: Integer)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport T2762A\n\nmain :: IO ()\nmain = do\n          let content1 = concat (replicate 1000000 \"1x\") ++ \"0\"\n          let i1 = fst $ input content1\n          view i1\n\n          let content2 = concat (replicate 1000001 \"1y\") ++ \"0\"\n          let i2 = fst $ input content2\n          view i2\n\nview :: [Char] -> IO ()\nview [] = return ()\nview (i : is) = i `seq` view is\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T2762A (input) where\n\nclass InputOutput a where\n    input :: String -> (a, String)\n\ninstance InputOutput Char where\n    input (x : bs) = (x, bs)\n\ninstance InputOutput a => InputOutput [a] where\n    input ('0':bs) = ([], bs)\n    input ('1':bs) = case input bs of\n                     (x, bs') ->\n                         case input bs' of\n                         ~(xs, bs'') -> (x : xs, bs'')\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\n import Foreign\n import Control.Concurrent\n\n -- always space-leaks with 6.12.x and -fno-state-hack, see #4018\n {-\n always :: Monad m => m a -> m b\n always a = a >> always a\n -}\n always :: Monad m => m a -> m b\n always a = do\n     _ <- a\n     always a\n\n spawner :: IO ()\n spawner = always $ do\n     forkIO $ always $ allocaBytes 4 $ \\p -> return ()\n     -- putStrLn \"Delaying\"\n     threadDelay 1000000\n\n main :: IO ()\n main = do\n     -- putStrLn \"Spawning\"\n     forkIO spawner\n     -- putStrLn \"Delaying main\"\n     threadDelay 3000000\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4029a where\n\ndata A = A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4029b where\n\n\ndata A01 = A01 deriving (Eq,Ord,Show,Read)\ndata A02 = A02 deriving (Eq,Ord,Show,Read)\ndata A03 = A03 deriving (Eq,Ord,Show,Read)\ndata A04 = A04 deriving (Eq,Ord,Show,Read)\ndata A05 = A05 deriving (Eq,Ord,Show,Read)\ndata A06 = A06 deriving (Eq,Ord,Show,Read)\ndata A07 = A07 deriving (Eq,Ord,Show,Read)\ndata A08 = A08 deriving (Eq,Ord,Show,Read)\ndata A09 = A09 deriving (Eq,Ord,Show,Read)\ndata A10 = A10 deriving (Eq,Ord,Show,Read)\ndata A11 = A11 deriving (Eq,Ord,Show,Read)\ndata A12 = A12 deriving (Eq,Ord,Show,Read)\ndata A13 = A13 deriving (Eq,Ord,Show,Read)\ndata A14 = A14 deriving (Eq,Ord,Show,Read)\ndata A15 = A15 deriving (Eq,Ord,Show,Read)\ndata A16 = A16 deriving (Eq,Ord,Show,Read)\ndata A17 = A17 deriving (Eq,Ord,Show,Read)\ndata A18 = A18 deriving (Eq,Ord,Show,Read)\ndata A19 = A19 deriving (Eq,Ord,Show,Read)\ndata A20 = A20 deriving (Eq,Ord,Show,Read)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport System.Environment (getArgs)\n\nmkText :: Int -> Int -> Char -> String\nmkText ll ln c =\n    unlines $ [replicate k c | k <- [ll .. ll+ln]]\n\nmain :: IO ()\nmain = do\n    args <- getArgs\n    let (ll, ln, c) =\n          case args of\n            (a1:a2:a3:_) -> (read a1, read a2, head a3)\n            (a1:a2:_)    -> (read a1, read a2, 'a')\n            (a1:_)       -> (read a1, 3, 'b')\n            _            -> (100000, 5, 'c')\n    mapM_ (print . length) (lines $ mkText ll ln c)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = putStrLn \"hello world\"\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module FrontendPlugin where\n\nimport GhcPlugins\nimport qualified GHC\nimport GHC              ( Ghc, LoadHowMuch(..) )\n\nimport DriverPipeline hiding ( hsc_env )\nimport DriverPhases\nimport System.Exit\nimport Control.Monad\nimport Data.List\n\nfrontendPlugin :: FrontendPlugin\nfrontendPlugin = defaultFrontendPlugin {\n        frontend = doMake\n    }\n\n-- Copypasted from ghc/Main.hs\ndoMake :: [String] -> [(String,Maybe Phase)] -> Ghc ()\ndoMake opts srcs  = do\n    liftIO $ print opts\n    let (hs_srcs, non_hs_srcs) = partition haskellish srcs\n\n        haskellish (f,Nothing) =\n          looksLikeModuleName f || isHaskellUserSrcFilename f || '.' `notElem` f\n        haskellish (_,Just phase) =\n          phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm\n                          , StopLn]\n\n    hsc_env <- GHC.getSession\n\n    -- if we have no haskell sources from which to do a dependency\n    -- analysis, then just do one-shot compilation and/or linking.\n    -- This means that \"ghc Foo.o Bar.o -o baz\" links the program as\n    -- we expect.\n    if (null hs_srcs)\n       then liftIO (oneShot hsc_env StopLn srcs)\n       else do\n\n    o_files <- mapM (\\x -> liftIO $ compileFile hsc_env StopLn x)\n                 non_hs_srcs\n    dflags <- GHC.getSessionDynFlags\n    let dflags' = dflags { ldInputs = map (FileOption \"\") o_files\n                                      ++ ldInputs dflags }\n    _ <- GHC.setSessionDynFlags dflags'\n\n    targets <- mapM (uncurry GHC.guessTarget) hs_srcs\n    GHC.setTargets targets\n    ok_flag <- GHC.load LoadAllTargets\n\n    when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))\n    return ()\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HomePackagePlugin where\n\nimport GhcPlugins\n\nplugin :: Plugin\nplugin = defaultPlugin {\n        installCoreToDos = install\n    }\n\ninstall :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]\ninstall _options todos = do\n    return $ (CoreDoPluginPass \"String replacement\" $ bindsOnlyPass stringReplacementPass) : todos\n\nstringReplacementPass :: [CoreBind] -> CoreM [CoreBind]\nstringReplacementPass binds = return $ map replaceInBind binds\n\nreplaceInBind :: CoreBind -> CoreBind\nreplaceInBind (NonRec b e) = NonRec b (replaceInExpr e)\nreplaceInBind (Rec bes) = Rec [(b, replaceInExpr e) | (b, e) <- bes]\n\nreplaceInExpr :: CoreExpr -> CoreExpr\nreplaceInExpr (Var x) = Var x\nreplaceInExpr (Lit (LitString _)) = mkStringLit \"Hello From The Plugin\" -- The payload\nreplaceInExpr (Lit l) = Lit l\nreplaceInExpr (Lam b e) = Lam b (replaceInExpr e)\nreplaceInExpr (App e1 e2) = App (replaceInExpr e1) (replaceInExpr e2)\nreplaceInExpr (Let bi e) = Let (replaceInBind bi) (replaceInExpr e)\nreplaceInExpr (Tick t e) = Tick t (replaceInExpr e)\nreplaceInExpr (Cast e co) = Cast (replaceInExpr e) co\nreplaceInExpr (Case e b ty alts) = Case (replaceInExpr e) b ty (map replaceInAlt alts)\nreplaceInExpr (Type ty) = Type ty\n\nreplaceInAlt :: CoreAlt -> CoreAlt\nreplaceInAlt (ac, bs, e) = (ac, bs, replaceInExpr e)\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module LinkerTicklingPlugin where\n\nimport GhcPlugins\nimport DynFlags\n\nplugin :: Plugin\nplugin = defaultPlugin {\n        installCoreToDos = install\n    }\n\n-- This tests whether plugins are linking against the *running* GHC or a new\n-- instance of it. If it is a new instance (settings unsafeGlobalDynFlags) won't\n-- have been initialised, so we'll get a GHC panic here:\ninstall :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]\ninstall _options todos = settings unsafeGlobalDynFlags `seq` return todos\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MetaRemoveHelper where\n\nimport Language.Haskell.TH\n\nclear :: Q [Dec] -> Q [Dec]\nclear _ = return []\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Intended to test that the plugins have basic functionality --\n--  * Can modify the program\n--  * Get to see command line options\nmodule Main where\n\nmain = do\n    putStrLn \"Program Started\"\n    putStrLn \"Program Ended\"\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:typecheck #-}\n-- testing that the plugin can alter the parsed representation\nmodule PluginFilteredExport where\n\nmap :: ()\nmap = ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Intended to test that the plugins have basic functionality --\n--  * Can modify the program\n--  * Get to see command line options\nmodule Main where\n\nimport Simple.DataStructures\n\n{-# ANN theMessage (ReplaceWith \"Right\") #-}\n{-# NOINLINE theMessage #-}\ntheMessage = \"Wrong\"\n\nmain = do\n    putStrLn \"Program Started\"\n    putStrLn theMessage\n    putStrLn \"Program Ended\"", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Just used to test that badly typed plugins raise an error\nmodule Main where\n-- The contents of this file are actually irrelevant\n\nmain = return ()", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Just used to test that we correctly handle non-existent plugins\nmodule Main where\n-- The contents of this file are actually irrelevant\n\nmain = return ()", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests home-package plugins from command line\nmodule Main where\n\nmain :: IO ()\nmain = putStrLn \"Hello From The Program\"", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin HomePackagePlugin #-}\n\n-- Tests home-package plugins from OPTIONS pragma\nmodule Main where\n\nmain :: IO ()\nmain = putStrLn \"Hello From The Program\"", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin LinkerTicklingPlugin #-}\n\nmodule Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n{-# NOINLINE x #-}\nx = \"foo\"\n\nmain = putStrLn (show x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests a plugin added with TH.addCorePlugin\n{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Simple.DataStructures\nimport Language.Haskell.TH.Syntax\n\ndo addCorePlugin \"Simple.Plugin\"\n   return []\n\n{-# ANN theMessage (ReplaceWith \"Right\") #-}\n{-# NOINLINE theMessage #-}\ntheMessage = \"Wrong\"\n\nmain = do\n    putStrLn \"Program Started\"\n    putStrLn theMessage\n    putStrLn \"Program Ended\"\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin-opt Simple.SourcePlugin:a #-}\n{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}\nmodule B where\n\nimport QuasiQuotation\n\n$(return [])\n\nx = [stringify|x|]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin Simple.SourcePlugin #-}\nmodule A where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:parse #-}\n-- testing that the plugin can alter the parsed representation\nmodule A where\n\nmap x = ()\n\nx = map show [1,2,3]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport PluginFilteredExport\n\nx = map show [1,2,3]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:interface #-}\nmodule A where\n-- test if a definition can be removed from loaded interface\n\nmap :: ()\nmap = ()\n\nx :: ()\nx = map\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:clear #-}\n{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:meta #-}\n{-# LANGUAGE TemplateHaskell #-}\n-- testing that the plugin can alter the evaluated splice\nmodule A where\n\nimport MetaRemoveHelper\n\n$(clear [d| a = () |])\n\nx = a\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module QuasiQuotation where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\nstringify :: QuasiQuoter\nstringify =  QuasiQuoter { quoteExp = return . LitE . StringL\n                         , quotePat = return . LitP . StringL\n                         , quoteType = return . LitT . StrTyLit\n                         , quoteDec = const (return [])\n                         }\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nmain = print \"Hello world!\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Avail\nimport Control.Monad.IO.Class\nimport DynFlags\n  (getDynFlags, parseDynamicFlagsCmdLine, defaultFatalMessager, defaultFlushOut)\nimport GHC\nimport GHC.Fingerprint.Type\nimport HsDecls\nimport HsDoc\nimport HsExpr\nimport HsExtension\nimport HsImpExp\nimport HscTypes\nimport Outputable\nimport Plugins\nimport System.Environment\nimport TcRnTypes\n\nimport Simple.SourcePlugin (plugin)\n\nmain = do\n  libdir:args <- getArgs\n  defaultErrorHandler defaultFatalMessager defaultFlushOut $ do\n    runGhc (Just libdir) $ do\n      dflags <- getSessionDynFlags\n      -- liftIO $ print args\n      -- (dflags,_,_)\n      --     <- parseDynamicFlagsCmdLine dflags (map noLoc args)\n      -- we need to LinkInMemory otherwise `setTarget [] >> load LoadAllTargets`\n      -- below will fail.\n      setSessionDynFlags dflags { ghcLink = LinkInMemory}\n\n      -- Start with a pure plugin, this should trigger recomp.\n      liftIO $ putStrLn \"==pure.0\"\n      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]\n\n      -- The same (or a different) pure plugin shouldn't trigger recomp.\n      liftIO $ putStrLn \"==pure.1\"\n      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]\n\n      -- Next try with a fingerprint plugin, should trigger recomp.\n      liftIO $ putStrLn \"==fp0.0\"\n      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp0 []]\n\n      -- With the same fingerprint plugin, should not trigger recomp.\n      liftIO $ putStrLn \"==fp0.1\"\n      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp0 []]\n\n      -- Change the plugin fingerprint, should trigger recomp.\n      liftIO $ putStrLn \"==fp1\"\n      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp1 []]\n\n      -- TODO: this currently doesn't work, patch pending\n      -- -- Even though the plugin is now pure we should still recomp since we\n      -- -- used a potentially impure plugin before\n      -- liftIO $ putStrLn \"pure.2\"\n      -- loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]\n\n  where\n    loadWithPlugins the_plugins = do\n      -- first unload (like GHCi :load does)\n      GHC.setTargets []\n      _ <- GHC.load LoadAllTargets\n\n      target <- guessTarget \"static-plugins-module.hs\" Nothing\n      setTargets [target]\n\n      dflags <- getSessionDynFlags\n      setSessionDynFlags dflags { staticPlugins = the_plugins\n                                , outputFile = Nothing }\n      load LoadAllTargets\n\n\nplugin_fp0   =\n  plugin { pluginRecompile = \\_ -> pure $ MaybeRecompile $ Fingerprint 0 0 }\nplugin_fp1   =\n  plugin { pluginRecompile = \\_ -> pure $ MaybeRecompile $ Fingerprint 0 1 }\nplugin0_pure =\n  plugin { pluginRecompile = \\_ -> pure $ NoForceRecompile }\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10294 where\n\nimport SayAnnNames\n\n{-# ANN foo SomeAnn #-}\nfoo :: ()\nfoo = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10294a where\n\nimport SayAnnNames\nimport Data.Data\n\nbaz :: Constr\nbaz = toConstr SomeAnn\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport T10420a\n\nimport RuleDefiningPlugin\n\n{-# NOINLINE x #-}\nx = \"foo\"\n\nmain = putStrLn (show x)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin RuleDefiningPlugin #-}\nmodule T10420a where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fplugin Simple.Plugin  #-}\n\nmodule T12567a where\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12567b where\n\nimport T12567a\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14335 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin T16104_Plugin #-}\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16260 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nmodule SayAnnNames (plugin, SomeAnn(..)) where\nimport GhcPlugins\nimport Control.Monad (unless)\nimport Data.Data\n\ndata SomeAnn = SomeAnn deriving (Data, Typeable)\n\nplugin :: Plugin\nplugin = defaultPlugin {\n  installCoreToDos = install\n  }\n\ninstall :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]\ninstall _ todo = do\n  return (CoreDoPluginPass \"Say name\" pass : todo)\n\npass :: ModGuts -> CoreM ModGuts\npass g = do\n          dflags <- getDynFlags\n          mapM_ (printAnn dflags g) (mg_binds g) >> return g\n  where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind\n        printAnn dflags guts bndr@(NonRec b _) = do\n          anns <- annotationsOn guts b :: CoreM [SomeAnn]\n          unless (null anns) $ putMsgS $\n            \"Annotated binding found: \" ++  showSDoc dflags (ppr b)\n          return bndr\n        printAnn _ _ bndr = return bndr\n\nannotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a]\nannotationsOn guts bndr = do\n  anns <- getAnnotations deserializeWithData guts\n  return $ lookupWithDefaultUFM anns [] (varUnique bndr)\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule Common where\n\nimport GhcPlugins\n\ninstall :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]\ninstall options todos = do\n    putMsgS $ \"Simple Plugin Passes Queried\"\n    putMsgS $ \"Got options: \" ++ unwords options\n\n    -- Create some actual passes to continue the test.\n    return $ CoreDoPluginPass \"Main pass\" mainPass\n             : todos\n\nmainPass :: ModGuts -> CoreM ModGuts\nmainPass guts = do\n#if defined(RUN2)\n    putMsgS \"Simple Plugin Pass Run 2\"\n#else\n    putMsgS \"Simple Plugin Pass Run\"\n#endif\n    return guts\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module FingerprintPlugin where\n\nimport GhcPlugins\nimport Common\n\nplugin :: Plugin\nplugin = defaultPlugin {\n    installCoreToDos = install,\n    pluginRecompile = flagRecompile\n  }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ImpurePlugin where\n\nimport GhcPlugins\nimport Common\n\nplugin :: Plugin\nplugin = defaultPlugin {\n    installCoreToDos = install,\n    pluginRecompile = impurePlugin\n  }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module PurePlugin where\n\nimport GhcPlugins\nimport Common\n\nplugin :: Plugin\nplugin = defaultPlugin {\n    installCoreToDos = install,\n    pluginRecompile  = purePlugin\n  }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\n\nmain = defaultMain\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module RuleDefiningPlugin where\n\nimport GhcPlugins\n\n{-# RULES \"unsound\" forall x. show x = \"SHOWED\" #-}\n\nplugin :: Plugin\nplugin = defaultPlugin\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\n\nmain = defaultMain\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\n\nmain = defaultMain\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Simple.BadlyTypedPlugin where\n\nplugin :: Int\nplugin = 1", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule Simple.DataStructures where\n\nimport Data.Data\nimport Data.Typeable\n\ndata ReplaceWith = ReplaceWith String\n                 deriving (Data, Typeable)", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Simple.Plugin(plugin) where\n\nimport UniqFM\nimport GhcPlugins\nimport qualified ErrUtils\n\n-- For annotation tests\nimport Simple.DataStructures\n\nimport Control.Monad\nimport Data.Monoid\nimport Data.Dynamic\nimport qualified Language.Haskell.TH as TH\n\nplugin :: Plugin\nplugin = defaultPlugin {\n    installCoreToDos = install,\n    pluginRecompile  = purePlugin\n  }\n\ninstall :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]\ninstall options todos = do\n    putMsgS $ \"Simple Plugin Passes Queried\"\n    putMsgS $ \"Got options: \" ++ unwords options\n\n    -- Create some actual passes to continue the test.\n    return $ CoreDoPluginPass \"Main pass\" mainPass\n             : todos\n\nfindNameBinds :: String -> [CoreBind] -> First Name\nfindNameBinds target = mconcat . map (findNameBind target)\n\nfindNameBind :: String -> CoreBind -> First Name\nfindNameBind target (NonRec b e) = findNameBndr target b\nfindNameBind target (Rec bes) = mconcat (map (findNameBndr target . fst) bes)\n\nfindNameBndr :: String -> CoreBndr -> First Name\nfindNameBndr target b\n  = if getOccString (varName b) == target\n    then First (Just (varName b))\n    else First Nothing\n\n\nmainPass :: ModGuts -> CoreM ModGuts\nmainPass guts = do\n    putMsgS \"Simple Plugin Pass Run\"\n    anns <- getAnnotations deserializeWithData guts\n    bindsOnlyPass (mapM (changeBind anns Nothing)) guts\n\nchangeBind :: UniqFM [ReplaceWith] -> Maybe String -> CoreBind -> CoreM CoreBind\nchangeBind anns mb_replacement (NonRec b e) = changeBindPr anns mb_replacement b e >>= (return . uncurry NonRec)\nchangeBind anns mb_replacement (Rec bes) = liftM Rec $ mapM (uncurry (changeBindPr anns mb_replacement)) bes\n\nchangeBindPr :: UniqFM [ReplaceWith] -> Maybe String -> CoreBndr -> CoreExpr -> CoreM (CoreBndr, CoreExpr)\nchangeBindPr anns mb_replacement b e = do\n    case lookupWithDefaultUFM anns [] b of\n        [] -> do\n                e' <- changeExpr anns mb_replacement e\n                return (b, e')\n        [ReplaceWith replace_string] -> do\n                e' <- changeExpr anns (Just replace_string) e\n                return (b, e')\n        _ -> do dflags <- getDynFlags\n                error (\"Too many change_anns on one binder:\" ++ showPpr dflags b)\n\nchangeExpr :: UniqFM [ReplaceWith] -> Maybe String -> CoreExpr -> CoreM CoreExpr\nchangeExpr anns mb_replacement e = let go = changeExpr anns mb_replacement in case e of\n        Lit (LitString _) -> case mb_replacement of\n                Nothing -> return e\n                Just replacement -> do\n                        putMsgS \"Performing Replacement\"\n                        return $ Lit (LitString (bytesFS (mkFastString replacement)))\n        App e1 e2 -> liftM2 App (go e1) (go e2)\n        Lam b e -> liftM (Lam b) (go e)\n        Let bind e -> liftM2 Let (changeBind anns mb_replacement bind) (go e)\n        Case e b ty alts -> liftM4 Case (go e) (return b) (return ty) (mapM (changeAlt anns mb_replacement) alts)\n        Cast e coerce -> liftM2 Cast (go e) (return coerce)\n        Tick t e -> liftM (Tick t) (go e)\n        _ -> return e\n\nchangeAlt :: UniqFM [ReplaceWith] -> Maybe String -> CoreAlt -> CoreM CoreAlt\nchangeAlt anns mb_replacement (con, bs, e) = liftM (\\e' -> (con, bs, e')) (changeExpr anns mb_replacement e)\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\nmodule Simple.RemovePlugin where\n\nimport Control.Monad.IO.Class\nimport Data.List (intercalate)\nimport Plugins\nimport Bag\nimport HscTypes\nimport TcRnTypes\nimport HsExtension\nimport HsExpr\nimport Outputable\nimport SrcLoc\nimport HsSyn\nimport HsBinds\nimport OccName\nimport RdrName\nimport Name\nimport Avail\n\nplugin :: Plugin\nplugin = defaultPlugin { parsedResultAction = parsedPlugin\n                       , typeCheckResultAction = typecheckPlugin\n                       , spliceRunAction = metaPlugin'\n                       , interfaceLoadAction = interfaceLoadPlugin'\n                       }\n\nparsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule\n                  -> Hsc HsParsedModule\nparsedPlugin [name, \"parse\"] _ pm\n  = return $ pm { hpm_module = removeParsedBinding name (hpm_module pm) }\nparsedPlugin _ _ pm = return pm\n\nremoveParsedBinding :: String -> Located (HsModule GhcPs)\n                         -> Located (HsModule GhcPs)\nremoveParsedBinding name (L l m)\n  = (L l (m { hsmodDecls = filter (notNamedAs name) (hsmodDecls m) } ))\n  where notNamedAs name (L _ (ValD _ (FunBind { fun_id = L _ fid })))\n          = occNameString (rdrNameOcc fid) /= name\n        notNamedAs _ _ = True\n\ntypecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv\ntypecheckPlugin [name, \"typecheck\"] _ tc\n  = return $ tc { tcg_exports = filter (availNotNamedAs name) (tcg_exports tc)\n                , tcg_binds = filterBag (notNamedAs name) (tcg_binds tc)\n                }\n  where notNamedAs name (L _ FunBind { fun_id = L _ fid })\n          = occNameString (getOccName fid) /= name\n        notNamedAs name (L _ AbsBinds { abs_binds = bnds })\n          = all (notNamedAs name) bnds\n        notNamedAs _ (L _ b) = True\ntypecheckPlugin _ _ tc = return tc\n\nmetaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)\nmetaPlugin' [name, \"meta\"] (L _ (HsApp noExt (L l (HsVar _ (L _ id))) e))\n  | occNameString (getOccName id) == name\n  = return e\nmetaPlugin' _ meta = return meta\n\ninterfaceLoadPlugin' :: [CommandLineOption] -> ModIface -> IfM lcl ModIface\ninterfaceLoadPlugin' [name, \"interface\"] iface\n  = return $ iface { mi_exports = filter (availNotNamedAs name)\n                                         (mi_exports iface)\n                   }\ninterfaceLoadPlugin' _ iface = return iface\n\navailNotNamedAs :: String -> AvailInfo -> Bool\navailNotNamedAs name avail\n  = occNameString (getOccName (availName avail)) /= name\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Simple.SourcePlugin where\n\nimport Control.Monad.IO.Class\nimport Data.List (intercalate)\nimport Data.Maybe (isJust)\nimport Plugins\nimport HscTypes\nimport TcRnTypes\nimport HsExtension\nimport Avail\nimport HsExpr\nimport Outputable\nimport HsImpExp\nimport HsDecls\nimport HsDoc\n\nplugin :: Plugin\nplugin = defaultPlugin { parsedResultAction = parsedPlugin\n                       , typeCheckResultAction = typecheckPlugin\n                       , spliceRunAction = metaPlugin'\n                       , interfaceLoadAction = interfaceLoadPlugin'\n                       , renamedResultAction = renamedAction\n                       }\n\nparsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule\n                  -> Hsc HsParsedModule\nparsedPlugin opts _ pm\n  = do liftIO $ putStrLn $ \"parsePlugin(\" ++ intercalate \",\" opts ++ \")\"\n       return pm\n\nrenamedAction :: [CommandLineOption]\n                    -> TcGblEnv -> HsGroup GhcRn\n                    -> TcM (TcGblEnv, HsGroup GhcRn)\nrenamedAction _ env grp\n  = do liftIO $ putStrLn \"typeCheckPlugin (rn)\"\n       return (env, grp)\n\ntypecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv\ntypecheckPlugin _ _ tc\n  = do liftIO $ putStrLn \"typeCheckPlugin (tc)\"\n       return tc\n\nmetaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)\nmetaPlugin' _ meta\n  = do liftIO $ putStrLn $ \"metaPlugin: \" ++ (showSDocUnsafe $ ppr meta)\n       return meta\n\ninterfaceLoadPlugin' :: [CommandLineOption] -> ModIface -> IfM lcl ModIface\ninterfaceLoadPlugin' _ iface\n  = do liftIO $ putStrLn $ \"interfacePlugin: \"\n                              ++ (showSDocUnsafe $ ppr $ mi_module iface)\n       return iface\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Simple.TrustworthyPlugin (plugin) where\n\nimport GhcPlugins\nimport TcRnMonad\n\nplugin :: Plugin\nplugin = defaultPlugin\n  { renamedResultAction = keepRenamedSource\n  , typeCheckResultAction = printHaskellSafeMode\n  }\n  where\n    printHaskellSafeMode _ ms tcg = liftIO $ do\n      let dflags = ms_hspp_opts ms\n      safe <- finalSafeMode dflags tcg\n      print $ gopt Opt_PluginTrustworthy dflags\n      putStrLn $ showPpr dflags safe\n      return tcg\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\n\nmain = defaultMain\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T16104_Plugin (plugin) where\n\nimport GhcPlugins\nimport Data.Bits\n\nplugin :: Plugin\nplugin = defaultPlugin {installCoreToDos = install}\n  where install _ todos = return (test : todos)\n\n        test = CoreDoPluginPass \"Test\" check\n\n        check :: ModGuts -> CoreM ModGuts\n        check m = do mbN <- thNameToGhcName 'complement\n                     case mbN of\n                       Just _  -> liftIO $ putStrLn \"Found complement!\"\n                       Nothing -> error \"Failed to locate complement\"\n\n                     return m\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Simple where\n\npattern Foo :: ()\npattern Foo = ()\n\na :: () -> ()\na Foo = ()\n\ndata A = B | C | D\n\n{-#\u00c2\u00a0COMPLETE Foo #-}\n{-#\u00c2\u00a0COMPLETE B,C #-}\n{-#\u00c2\u00a0COMPLETE B #-}\n\nb :: A -> A\nb B = B\nb C = C\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Empty where\n\npattern Foo :: ()\npattern Foo = ()\n\na :: () -> ()\na Foo = ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule Module where\n\nimport Completesig03A\n\nfoo :: A -> ()\nfoo A = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Completesig03A where\n\ndata A = A | B\n\n{-#\u00c2\u00a0COMPLETE A #-}\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that a COMPLETE pragma over constructors of different types fails.\nmodule TyMismatch where\n\ndata E = L | R\n\n{-# COMPLETE Just, L #-}\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule Completesig05 where\n\n-- Matching against multiple arguments\n\ndata T = A | B | C\ndata S = D | E | F\n\n{-# COMPLETE A, B #-}\n{-# COMPLETE D #-}\n\nmatch :: T -> S -> ()\nmatch A D = ()\nmatch B D = ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-#\u00c2\u00a0OPTIONS_GHC -Wall #-}\nmodule Completesig06 where\n\n-- Some non-exhaustive examples\n\ndata T = A | B | C\ndata S = D | E | F\n\n{-# COMPLETE A, B #-}\n{-# COMPLETE D #-}\n\nm1 :: T -> ()\nm1 A = ()\n\nm2 :: T -> ()\nm2 B = ()\nm2 C = ()\n\nm3 :: T -> ()\nm3 C = ()\n\nm4 :: T -> S -> ()\nm4 A E = ()\nm4 A F = ()\nm4 B F = ()\nm4 B E = ()\n\nm5 :: T -> S -> ()\nm5 C D = ()\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule Completesig07 where\n\n-- Some overlapping examples\n\ndata T = A | B | C\ndata S = D | E | F\n\n{-# COMPLETE A, B #-}\n{-# COMPLETE D #-}\n\nm1 :: T -> ()\nm1 A = ()\nm1 A = ()\nm1 B = ()\n\nm2 :: T -> S -> ()\nm2 A D = ()\nm2 B D = ()\nm2 A D = ()\n\nm3 :: T -> ()\nm3 C = ()\nm3 C = ()\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule Completesig08 where\n\n-- Some redundant examples\n\ndata T = A | B | C\ndata S = D | E | F\n\n{-# COMPLETE A, B #-}\n{-# COMPLETE D #-}\n\nm1 :: T -> ()\nm1 A = ()\nm1 B = ()\nm1 C = ()\n\nm2 :: T -> S -> ()\nm2 A D = ()\nm2 B D = ()\nm2 C D = ()\n\nm3 :: T -> S -> ()\nm3 A D = ()\nm3 B D = ()\nm3 A E = ()\nm3 A F = ()\n\nm4 :: S -> ()\nm4 D = ()\nm4 E = ()\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule Completesig08 where\n\n-- Nested matching\n\ndata T = A S | B\ndata S = D | E\n\n{-# COMPLETE A #-}\n{-# COMPLETE D #-}\n\nm1 :: T -> ()\nm1 (A D) = ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule Completesig10 where\n\n-- Multiple competing COMPLETE sigs AHHH!!\n\ndata T = A | B | C | D | E\n\n{-# COMPLETE A,B #-}\n{-# COMPLETE C,D #-}\n\n-- Completely overlapping\nm1 :: T -> ()\nm1 A = ()\nm1 B = ()\nm1 C = ()\nm1 D = ()\n\n-- Incomplete overlap\nm2 :: T -> ()\nm2 B = ()\nm2 D = ()\n\n-- Redundant incomplete overlap\nm3 :: T -> ()\nm3 B = ()\nm3 C = ()\nm3 D = ()\n\n-- One matches\n\nm4 :: T -> ()\nm4 C = ()\nm4 D = ()\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule Completesig11 where\n\ndata T = A | B | C\n{-# COMPLETE A,B #-}\n{-# COMPLETE A,C #-}\n\npattern BS :: T\npattern BS = B\n{-# COMPLETE A,BS #-}\n\nm1  :: T -> ()\nm1 A = ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, PatternSynonyms #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Completesig11 where\ndata G a where\n  G1' :: G Int\n  G2' :: G Bool\n\npattern G1 :: () => (a ~ Int) => G a\npattern G1 = G1'\n\npattern G2 :: () => (a ~ Bool) => G a\npattern G2 = G2'\n\n{-# COMPLETE G1, G2 #-}\n\nfa :: G a -> Int   -- exhaustive function\nfa G1 = 1\nfa G2 = 2\n\nfb :: G Int -> Int -- exhaustive function\nfb G1 = 1\n-- fb G2 = 2       -- inaccessible clause\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Completesig11 where\n\nclass LL f where\n  go :: f a -> ()\n\ninstance LL [] where\n  go _ = ()\n\npattern T :: LL f => f a\npattern T <- (go -> ())\n\n{-# COMPLETE T :: [] #-}\n\nfoo :: [a] -> Int\nfoo T = 5\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\nmodule Completesig11 where\n\ndata A = A | B\n\n{-#\u00c2\u00a0COMPLETE A, B #-}\n\nfoo :: A -> ()\nfoo A = ()\nfoo B = ()\nfoo A = ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ViewPatterns #-}\nmodule Completesig15 where\n\nclass C f where\n  foo :: f a -> ()\n\npattern P :: C f => f a\npattern P <- (foo -> ())\n\n{-#\u00c2\u00a0COMPLETE P #-}\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -Wincomplete-patterns #-}\nmodule T14059a where\n\ndata SBool (z :: Bool) where\n  SFalse :: SBool False\n  STrue  :: SBool True\n\npattern STooGoodToBeTrue :: forall (z :: Bool). ()\n                         => z ~ True\n                         => SBool z\npattern STooGoodToBeTrue = STrue\n{-# COMPLETE SFalse, STooGoodToBeTrue #-}\n\nwibble :: SBool z -> Bool\nwibble STrue = True\n\nwobble :: SBool z -> Bool\nwobble STooGoodToBeTrue = True\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE PolyKinds #-}\n\nmodule T14253 where\n\nimport GHC.Exts\nimport Data.Kind\n\ndata TypeRep (a :: k) where\n    Con :: TypeRep (a :: k)\n    TrFun   :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                      (a :: TYPE r1) (b :: TYPE r2).\n               TypeRep a\n            -> TypeRep b\n            -> TypeRep (a -> b)\n\npattern Fun :: forall k (fun :: k). ()\n            => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                      (arg :: TYPE r1) (res :: TYPE r2).\n               (k ~ Type, fun ~~ (arg -> res))\n            => TypeRep arg\n            -> TypeRep res\n            -> TypeRep fun\npattern Fun arg res <- TrFun arg res\n\ndata Dynamic where\n    Dynamic :: forall a. TypeRep a -> a -> Dynamic\n\n-- Adding this results in failure\n{-# COMPLETE Con #-}\n\ndynApply :: Dynamic -> Dynamic -> Maybe Dynamic\n-- Changing TrFun to Fun also results in failure\ndynApply (Dynamic (Fun ta tr) f) (Dynamic ta' x) = undefined\ndynApply _ _ = Nothing\n\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns  #-}\n{-# LANGUAGE EmptyCase, LambdaCase          #-}\n\n-- Check some predefined types\nmodule EmptyCase001 where\n\n-- Non-exhaustive with *infinite* inhabitants\nf1 :: Int -> a\nf1 = \\case\n\n-- Non-exhaustive. Since a string is just a list of characters\n-- (that is, an algebraic type), we have [] and (_:_) as missing.\nf2 :: String -> a\nf2 x = case x of {}\n\n-- Non-exhaustive (do not unfold the alternatives)\nf3 :: Char -> a\nf3 x = case x of {}\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns  #-}\n{-# LANGUAGE EmptyCase, LambdaCase          #-}\n{-# LANGUAGE GADTs, TypeFamilies            #-}\n\n-- Check some newtypes, in combination with GADTs and TypeFamilies\nmodule EmptyCase002 where\n\nimport Data.Kind (Type)\n\nnewtype T = MkT H\nnewtype G = MkG T\nnewtype H = MkH G\n\n-- Exhaustive but it cannot be detected.\nf1 :: T -> a\nf1 = \\case\n\ndata A\n\ndata B = B1 | B2\n\ndata C :: Type -> Type where\n  C1 :: C Int\n  C2 :: C Bool\n\ndata D :: Type -> Type -> Type where\n  D1 :: D Int  Bool\n  D2 :: D Bool Char\n\ntype family E (a :: Type) :: Type where\n  E Int  = Bool\n  E Bool = Char\n\nnewtype T1 a = MkT1 a\nnewtype T2 b = MkT2 b\n\n-- Exhaustive\nf2 :: T1 A -> z\nf2 = \\case\n\n-- Non-exhaustive. Missing cases: MkT1 B1, MkT1 B2\nf3 :: T1 B -> z\nf3 = \\case\n\n-- Non-exhaustive. Missing cases: MkT1 False, MkT1 True\nf4 :: T1 (E Int) -> z\nf4 = \\case\n\n-- Non-exhaustive. Missing cases: MkT1 (MkT2 (MkT1 D2))\nf5 :: T1 (T2 (T1 (D (E Int) (E (E Int))))) -> z\nf5 = \\case\n\n-- Exhaustive. Not an EmptyCase but good to have for\n-- comparison with the example above\nf6 :: T1 (T2 (T1 (D (E Int) (E (E Int))))) -> ()\nf6 = \\case MkT1 (MkT2 (MkT1 D2)) -> ()\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns      #-}\n{-# LANGUAGE EmptyCase, LambdaCase              #-}\n{-# LANGUAGE TypeFamilies, UndecidableInstances #-}\n\n-- Check some type families and type synonyms\nmodule EmptyCase003 where\n\nimport Data.Kind (Type)\n\ntype family A (a :: Type) :: Type\n\n-- Conservatively considered non-exhaustive (A a missing),\n-- since A a does not reduce to anything.\nf1 :: A a -> a -> b\nf1 = \\case\n\ndata Void\n\ntype family B (a :: Type) :: Type\ntype instance B a = Void\n\n-- Exhaustive\nf2 :: B a -> b\nf2 = \\case\n\ntype family C (a :: Type) :: Type\ntype instance C Int  = Char\ntype instance C Bool = Void\n\n-- Non-exhaustive (C a missing, no info about `a`)\nf3 :: C a -> a -> b\nf3 = \\case\n\n-- Non-exhaustive (_ :: Char missing): C Int rewrites\n-- to Char (which is trivially inhabited)\nf4 :: C Int -> a\nf4 = \\case\n\n-- Exhaustive: C Bool rewrites to Void\nf5 :: C Bool -> a\nf5 = \\case\n\n-- type family D (a :: Type) :: Type\n-- type instance D x = D x -- non-terminating\n--\n-- -- Exhaustive but *impossible* to detect that, since rewriting\n-- -- D Int does not terminate (the checker should loop).\n-- f6 :: D Int -> a\n-- f6 = \\case\n\ndata Zero\ndata Succ n\n\ntype TenC n = Succ (Succ (Succ (Succ (Succ\n             (Succ (Succ (Succ (Succ (Succ n)))))))))\n\ntype Ten = TenC Zero\n\ntype Hundred = TenC (TenC (TenC (TenC (TenC\n              (TenC (TenC (TenC (TenC (TenC Zero)))))))))\n\ntype family E (n :: Type) (a :: Type) :: Type\ntype instance E Zero     b = b\ntype instance E (Succ n) b = E n b\n\n-- Exhaustive (10 rewrites)\nf7 :: E Ten Void -> b\nf7 = \\case\n\n-- Exhaustive (100 rewrites)\nf8 :: E Hundred Void -> b\nf8 = \\case\n\ntype family Add (a :: Type) (b :: Type) :: Type\ntype instance Add Zero     m = m\ntype instance Add (Succ n) m = Succ (Add n m)\n\ntype family Mult (a :: Type) (b :: Type) :: Type\ntype instance Mult Zero     m = Zero\ntype instance Mult (Succ n) m = Add m (Mult n m)\n\ntype Five = Succ (Succ (Succ (Succ (Succ Zero))))\ntype Four = Succ (Succ (Succ (Succ Zero)))\n\n-- Exhaustive (80 rewrites)\nf9 :: E (Mult Four (Mult Four Five)) Void -> a\nf9 = \\case\n\n-- This gets killed on my dell\n--\n-- -- Exhaustive (390625 rewrites)\n-- f10 :: E (Mult (Mult (Mult Five Five)\n--                      (Mult Five Five))\n--                (Mult (Mult Five Five)\n--                      (Mult Five Five)))\n--          Void -> a\n-- f10 = \\case\n", "num_lines": 98}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE GADTs, KindSignatures, EmptyCase, LambdaCase #-}\n\n-- Check some GADTs\nmodule EmptyCase004 where\n\nimport Data.Kind (Type)\n\ndata A :: Type -> Type where\n  A1 :: A Int\n  A2 :: A Bool\n\n-- Non-exhaustive: Missing A2\nf1 :: A Bool -> a\nf1 = \\case\n\n-- Non-exhaustive: missing both A1 & A2\nf2 :: A a -> b\nf2 = \\case\n\n-- Exhaustive\nf3 :: A [a] -> b\nf3 = \\case\n\ndata B :: Type -> Type -> Type where\n  B1 :: Int -> B Bool Bool\n  B2 ::        B Int  Bool\n\n-- Non-exhaustive: missing (B1 _)\ng1 :: B a a -> b\ng1 x = case x of\n\n-- Non-exhaustive: missing both (B1 _) & B2\ng2 :: B a b -> c\ng2 = \\case\n\n-- Exhaustive\ng3 :: B Char a -> b\ng3 = \\case\n\n-- NOTE: A lambda-case always has ONE scrutinee and a lambda case refers\n-- always to the first of the arguments. Hence, the following warnings are\n-- valid:\n\n-- Non-exhaustive: Missing both A1 & A2\nh1 :: A a -> A a -> b\nh1 = \\case\n\nh2 :: A a -> B a b -> ()\nh2 A1 = \\case -- Non-exhaustive, missing B2\nh2 A2 = \\case -- Non-exhaustive, missing (B1 _)\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE TypeFamilies, EmptyCase, LambdaCase #-}\n{-# LANGUAGE UndecidableInstances #-}\n\n-- Check some DataFamilies, warning appearance and other stuff\nmodule EmptyCase005 where\n\ndata Void\n\nnewtype Void2 = Void2 Void\ndata    Void3 = Void3 Void\n\n-- Exhaustive\nf1 :: Void2 -> Bool\nf1 x = case x of {}\n-- > f1 undefined\n-- *** Exception: Prelude.undefined\n--\n-- > f1 (Void2 undefined)\n-- *** Exception: Prelude.undefined\n\n-- Non-exhaustive: missing (Void3 _)\nf2 :: Void3 -> Bool\nf2 x = case x of {}\n-- > f2 undefined\n-- *** Exception: Prelude.undefined\n--\n-- > f2 (Void3 undefined)\n-- *** Exception: Void.hs:31:7-10: Non-exhaustive patterns in case\n\nnewtype V1 = V1 Void\nnewtype V2 = V2 V1\nnewtype V3 = V3 V2\nnewtype V4 = V4 V3\n\n-- Exhaustive\nf3 :: V4 -> Bool\nf3 x = case x of {}\n-- > v undefined\n-- *** Exception: Prelude.undefined\n--\n-- > v (V4 undefined)\n-- *** Exception: Prelude.undefined\n--\n-- > v (V4 (V3 undefined))\n-- *** Exception: Prelude.undefined\n--\n-- > v (V4 (V3 (V2 undefined)))\n-- *** Exception: Prelude.undefined\n--\n-- > v (V4 (V3 (V2 (V1 undefined))))\n-- *** Exception: Prelude.undefined\n\n-- Exhaustive\ntype family A a\ntype instance A Bool = V4\n\nf4 :: A Bool -> Bool\nf4 x = case x of {}\n\ndata family T a\n\ndata instance T () = T1 | T2\n\n-- Non-exhaustive: missing both T1 & T2\nf5 :: T () -> Bool\nf5 x = case x of {}\n\nnewtype instance T Bool = MkTBool Bool\n\n-- Non-exhaustive: missing both (MkTBool True) & (MkTBool False)\nf6 :: T Bool -> Bool\nf6 x = case x of {}\n\nnewtype instance T Int = MkTInt Char\n\n-- Non-exhaustive: missing (MkTInt _)\nf7 :: T Int -> Bool\nf7 x = case x of {}\n\nnewtype V = MkV Bool\n\ntype family F a\ntype instance F Bool = V\n\ntype family G a\ntype instance G Int = F Bool\n\n-- Non-exhaustive: missing MkV True & MkV False\nf8 :: G Int -> Bool\nf8 x = case x of {}\n\ntype family H a\ntype instance H Int  = H Bool\ntype instance H Bool = H Char\n\n-- Non-exhaustive: missing (_ :: H Char)\n-- (H Int), (H Bool) and (H Char) are all the same and stuck, but we want to\n-- show the latest rewrite, that is, (H Char) and not (H Int) or (H Bool).\nf9 :: H Int -> Bool\nf9 x = case x of {}\n", "num_lines": 102}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE GADTs, KindSignatures, EmptyCase, LambdaCase #-}\n\n-- Check interaction between Newtypes and GADTs\nmodule EmptyCase006 where\n\nimport Data.Kind (Type)\n\ndata GA :: Type -> Type where\n  MkGA1 :: GA Int\n  MkGA2 :: GA a -> GA [a]\n  MkGA3 :: GA (a,a)\n\nnewtype Foo1 a = Foo1 (GA a)\n\n-- Non-exhaustive. Missing: Foo1 MkGA1\nf01 :: Foo1 Int -> ()\nf01 = \\case\n\n-- Exhaustive\nf02 :: Foo1 (Int, Bool) -> ()\nf02 = \\case\n\n-- Non-exhaustive. Missing: Foo1 MkGA1, Foo1 (MkGA2 _), Foo1 MkGA3\nf03 :: Foo1 a -> ()\nf03 = \\case\n\n-- Exhaustive\nf04 :: Foo1 () -> ()\nf04 = \\case\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE TypeFamilies, EmptyCase, LambdaCase #-}\n\n-- Check interaction between Newtypes and Type Families\nmodule EmptyCase007 where\n\nimport Data.Kind (Type)\n\ntype family FA a :: Type -- just an open type family\ntype instance FA Int     = (Char, Bool)\ntype instance FA Char    = Char\ntype instance FA [a]     = [FA a]\ntype instance FA (a,b,b) = Void1\n\nnewtype Foo2 a = Foo2 (FA a)\n\ndata Void1\n\n-- Non-exhaustive. Missing: (_ :: Foo2 a) (no info about a)\nf05 :: Foo2 a -> ()\nf05 = \\case\n\n-- Non-exhaustive. Missing: (_ :: Foo2 (a, a)) (does not reduce)\nf06 :: Foo2 (a, a) -> ()\nf06 = \\case\n\n-- Exhaustive (reduces to Void)\nf07 :: Foo2 (Int, Char, Char) -> ()\nf07 = \\case\n\n-- Non-exhaustive. Missing: Foo2 (_, _)\nf08 :: Foo2 Int -> ()\nf08 = \\case\n\n-- Non-exhaustive. Missing: Foo2 _\nf09 :: Foo2 Char -> ()\nf09 = \\case\n\n-- Non-exhaustive. Missing: (_ :: Char)\n-- This is a more general trick: If the warning gives you a constructor form\n-- and you don't know what the type of the underscore is, just match against\n-- the constructor form, and the warning you'll get will fill the type in.\nf09' :: Foo2 Char -> ()\nf09' (Foo2 x) = case x of {}\n\n-- Non-exhaustive. Missing: Foo2 [], Foo2 (_:_)\nf10 :: Foo2 [Int] -> ()\nf10 = \\case\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE TypeFamilies, GADTs, EmptyCase, LambdaCase #-}\n\n-- Check interaction between Newtypes and DataFamilies\nmodule EmptyCase008 where\n\nimport Data.Kind (Type)\n\ndata family DA a\n\nnewtype Foo3 a = Foo3 (DA a)\n\ndata instance DA Int = MkDA1 Char | MkDA2\n\n-- Non-exhaustive. Missing: MkDA1 Char, MkDA2\nf11 :: Foo3 Int -> ()\nf11 = \\case\n\n-- Non-exhaustive. (no info about a)\nf12 :: Foo3 a -> ()\nf12 = \\case\n\ndata instance DA () -- Empty data type\n\n-- Exhaustive.\nf13 :: Foo3 () -> ()\nf13 = \\case\n\n-- ----------------\ndata family DB a :: Type -> Type\n\ndata instance DB Int a where\n  MkDB1 :: DB Int ()\n  MkDB2 :: DB Int Bool\n\nnewtype Foo4 a b = Foo4 (DB a b)\n\n-- Non-exhaustive. Missing: Foo4 MkDB1\nf14 :: Foo4 Int () -> ()\nf14 = \\case\n\n-- Exhaustive\nf15 :: Foo4 Int [a] -> ()\nf15 = \\case\n\n-- Non-exhaustive. Missing: (_ :: Foo4 a b) (no information about a or b)\nf16 :: Foo4 a b -> ()\nf16 = \\case\n\ndata instance DB Char Bool -- Empty data type\n\n-- Exhaustive (empty data type)\nf17 :: Foo4 Char Bool -> ()\nf17 = \\case\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE TypeFamilies, GADTs, EmptyCase, LambdaCase #-}\n\n-- Arrow Kind, Newtypes, GADTs, DataFamilies\nmodule EmptyCase009 where\n\nimport Data.Kind (Type)\n\ndata family DB a :: Type -> Type\n\ndata instance DB Int a where\n  MkDB1 :: DB Int ()\n  MkDB2 :: DB Int Bool\n\ndata instance DB Char Bool -- Empty data type\n\nnewtype Bar f = Bar (f Int)\n\n-- Non-exhaustive. Missing: (_ :: Bar f)\nf17 :: Bar f -> ()\nf17 x = case x of {}\n\n-- Exhaustive (Bar (DB Int) ~ DB Int Int, incompatible with both MkDB1 & MkDB2)\nf18 :: Bar (DB Int) -> ()\nf18 x = case x of {}\n\ndata instance DB () a where\n  MkDB1_u :: DB () ()\n  MkDB2_u :: DB () Int\n\n-- Non-exhaustive. Missing: Bar MkDB2_u\nf19 :: Bar (DB ()) -> ()\nf19 = \\case\n\ndata GB :: Type -> Type where\n  MkGB1 :: Int -> GB ()\n  MkGB2 :: GB (a,a)\n  MkGB3 :: GB b\n\n-- Non-exhaustive. Missing: Bar MkGB3\nf20 :: Bar GB -> ()\nf20 = \\case\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE TypeFamilies, GADTs, PolyKinds, DataKinds\n           , EmptyCase, LambdaCase #-}\n\n-- Newtypes, PolyKinds, DataKinds, GADTs, DataFamilies\nmodule EmptyCase010 where\n\nimport Data.Kind (Type)\n\nnewtype Baz (f :: k -> Type) (a :: k) = Baz (f a)\n\ndata T = T1 | T2 T | T3 T T | T4 () -- only promoted\n\ndata GC :: T -> Type where\n  MkGC1 :: GC 'T1\n  MkGC2 :: T -> GC (T4 '())\n\n-- Exhaustive: GC ('T2 'T1) is not strictly inhabited\nf21 :: Baz GC ('T2 'T1) -> ()\nf21 = \\case\n\n-- Non-exhaustive. Missing: Baz MkGC1, Baz (MkGC2 _)\nf22 :: Baz GC a -> ()\nf22 = \\case\n\n-- Non-exhaustive. Missing: Baz MkGC1\nf23 :: Baz GC 'T1 -> ()\nf23 = \\case\n\ndata GD :: (Type -> Type) -> Type where\n  MkGD1 :: GD Maybe\n  MkGD2 :: GD []\n  MkGD3 :: GD f\n\n-- Non-exhaustive. Missing: Baz MkGD1, Baz MkGD3\nf24 :: Baz GD Maybe -> ()\nf24 = \\case\n\n-- Non-exhaustive. Missing: Baz MkGD3\nf25 :: Baz GD (Either Int) -> ()\nf25 x = case x of {}\n\n-- Non-exhaustive. Missing: Baz MkGD1, Baz MkGD2, Baz MkGD3\nf26 :: Baz GD f -> ()\nf26 = \\case\n\ndata family DC a :: Type -> Type\n\ndata instance DC () Int -- Empty type\n\n-- Exhaustive\nf27 :: Baz (DC ()) Int -> ()\nf27 = \\case\n\n-- Non-exhaustive. Missing: _ :: Baz (DC ()) a (a is unknown)\nf28 :: Baz (DC ()) a -> ()\nf28 = \\case\n\ndata instance DC Bool a where\n  MkDC1 :: DC Bool Int\n  MkDC2 :: DC Bool [a]\n\n-- Exhaustive. (DC Bool Char) is not strictly inhabited\nf29 :: Baz (DC Bool) Char -> ()\nf29 = \\case\n\n-- Non-exhaustive. Missing: Baz MkDC2\nf30 :: Baz (DC Bool) [Int] -> ()\nf30 = \\case\n\n-- Non-exhaustive. Missing: Baz f a (a and f unknown (and the kind too))\nf31 :: Baz f a -> ()\nf31 x = case x of {}\n", "num_lines": 74}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule PMC001 where\n\ndata family T a\n\ndata instance T [a] where\n  MkT1 :: T [Int]\n  MkT2 :: Char -> T [Char]\n  MkT3 :: T [a]\n\nf :: T [a] -> T [a] -> Bool\nf MkT1     MkT1     = True\nf (MkT2 _) (MkT2 _) = True\nf MkT3     MkT3     = True\n\ng :: T [a] -> T [a] -> Bool\ng x y\n  | MkT1     <- x, MkT1     <- y = True\n  | (MkT2 _) <- x, (MkT2 _) <- y = True\n  | MkT3     <- x, MkT3     <- y = True\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule PMC002 where\n\nf :: [a] -> Bool\nf []              = True\nf x  | (_:_) <- x = False -- exhaustive\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule PMC003 where\n\nf :: Bool -> Bool -> ()\nf _    False = ()\nf True False = ()\nf _    _     = ()\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n{-# LANGUAGE GADTs #-}\n\nmodule PMC004 where\n\ndata F a where\n  F1 :: F Int\n  F2 :: F Bool\n\ndata G a where\n  G1 :: G Int\n  G2 :: G Char\n\nh :: F a -> G a -> ()\nh F1 G1 = ()\nh _  G1 = ()\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n{-# LANGUAGE GADTs #-}\n\nmodule PMC005 where\n\ndata T a where\n  TList :: T [a]\n  TBool :: T Bool\n\nfoo :: T c -> T c -> ()\nfoo TList _     = ()\nfoo _     TList = ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule PMC006 where\n\nlen :: [a] -> Int\nlen xs = case xs of\n           []     -> 0\n           (_:ys) -> case () of\n                       () | (_:_) <- xs -> 1 + len ys\n\n-- -- we would like these to work too but they don't yet\n--\n-- len :: [a] -> Int\n-- len [] = 0\n-- len xs = case xs of\n--            (_:ys) -> 1 + len ys\n--\n-- len :: [a] -> Int\n-- len xs = case xs of\n--            [] -> 0\n--            ys -> case ys of\n--                    (_:zs) -> 1 + len zs\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule PMC007 where\n\n-- overloaded\nf \"ab\" = ()\nf \"ac\" = ()\n\n-- non-overloaded\ng :: String -> ()\ng \"ab\" = ()\ng \"ac\" = ()\n\n-- non-overloaded due to type inference\nh :: String -> ()\nh s = let s' = s\n      in  case s' of\n            \"ab\" -> ()\n            \"ac\" -> ()\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns  #-}\n{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE GADTs, DataKinds #-}\n\nmodule Test where\n\n-- Non-exhaustive (missing True & False)\ntest :: Bool -> Int\ntest a = case a of\n\ndata Void\n\n-- Exhaustive\nabsurd :: Void -> a\nabsurd a = case a of {}\n\ndata Nat = Zero | Succ Nat\n\ndata Fin n where\n  FZ ::          Fin (Succ n)\n  FS :: Fin n -> Fin (Succ n)\n\n-- Exhaustive\nf :: Fin Zero -> a\nf x = case x of {}\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Woverlapping-patterns -Wincomplete-patterns #-}\n{-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}\n\nmodule T11195 where\n\nimport TyCoRep\nimport Coercion\nimport Type hiding( substTyVarBndr, substTy, extendTCvSubst )\nimport TcType       ( exactTyCoVarsOfType )\nimport CoAxiom\nimport VarSet\nimport VarEnv\nimport Pair\nimport InstEnv\n\ntype NormalCo    = Coercion\ntype NormalNonIdCo = NormalCo  -- Extra invariant: not the identity\ntype SymFlag = Bool\ntype ReprFlag = Bool\n\nchooseRole :: ReprFlag -> Role -> Role\nchooseRole = undefined\n\nwrapRole :: ReprFlag -> Role -> Coercion -> Coercion\nwrapRole = undefined\n\nwrapSym :: SymFlag -> Coercion -> Coercion\nwrapSym = undefined\n\noptForAllCoBndr :: LiftingContext -> Bool\n                -> TyVar -> Coercion -> (LiftingContext, TyVar, Coercion)\noptForAllCoBndr = undefined\n\nopt_trans :: InScopeSet -> NormalCo -> NormalCo -> NormalCo\nopt_trans = undefined\n\nopt_univ :: LiftingContext -> SymFlag -> UnivCoProvenance -> Role\n         -> Type -> Type -> Coercion\nopt_univ = undefined\n\nopt_co3 :: LiftingContext -> SymFlag -> Maybe Role\n        -> Role -> Coercion -> NormalCo\nopt_co3 = undefined\n\nopt_co2 :: LiftingContext -> SymFlag -> Role -> Coercion -> NormalCo\nopt_co2 = undefined\n\ncompatible_co :: Coercion -> Coercion -> Bool\ncompatible_co = undefined\n\netaTyConAppCo_maybe = undefined\netaAppCo_maybe = undefined\netaForAllCo_maybe = undefined\n\nmatchAxiom = undefined\ncheckAxInstCo = undefined\nisAxiom_maybe = undefined\nisCohLeft_maybe = undefined\nisCohRight_maybe = undefined\n\nopt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo]\nopt_transList is = zipWith (opt_trans is)\n\nopt_trans_rule :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo\nopt_trans_rule is in_co1@(NthCo r1 d1 co1) in_co2@(NthCo r2 d2 co2)\n  | d1 == d2\n  , co1 `compatible_co` co2 = undefined\n\nopt_trans_rule is in_co1@(LRCo d1 co1) in_co2@(LRCo d2 co2)\n  | d1 == d2\n  , co1 `compatible_co` co2 = undefined\n\n-- Push transitivity inside instantiation\nopt_trans_rule is in_co1@(InstCo co1 ty1) in_co2@(InstCo co2 ty2)\n  | ty1 `eqCoercion` ty2\n  , co1 `compatible_co` co2 = undefined\n\nopt_trans_rule is in_co1@(UnivCo p1 r1 tyl1 _tyr1)\n                  in_co2@(UnivCo p2 r2 _tyl2 tyr2)\n  | Just prov' <- opt_trans_prov p1 p2 = undefined\n  where\n    -- if the provenances are different, opt'ing will be very confusing\n    opt_trans_prov UnsafeCoerceProv UnsafeCoerceProv\n      = Just UnsafeCoerceProv\n    opt_trans_prov (PhantomProv kco1) (PhantomProv kco2)\n      = Just $ PhantomProv $ opt_trans is kco1 kco2\n    opt_trans_prov (ProofIrrelProv kco1) (ProofIrrelProv kco2)\n      = Just $ ProofIrrelProv $ opt_trans is kco1 kco2\n    opt_trans_prov (PluginProv str1) (PluginProv str2)\n      | str1 == str2 = Just p1\n    opt_trans_prov _ _ = Nothing\n\n-- Push transitivity down through matching top-level constructors.\nopt_trans_rule is in_co1@(TyConAppCo r1 tc1 cos1)\n                  in_co2@(TyConAppCo r2 tc2 cos2)\n  | tc1 == tc2 = undefined\n\nopt_trans_rule is in_co1@(AppCo co1a co1b) in_co2@(AppCo co2a co2b)\n  = undefined\n\n-- Eta rules\nopt_trans_rule is co1@(TyConAppCo r tc cos1) co2\n  | Just cos2 <- etaTyConAppCo_maybe tc co2 = undefined\n\nopt_trans_rule is co1 co2@(TyConAppCo r tc cos2)\n  | Just cos1 <- etaTyConAppCo_maybe tc co1 = undefined\n\nopt_trans_rule is co1@(AppCo co1a co1b) co2\n  | Just (co2a,co2b) <- etaAppCo_maybe co2 = undefined\n\nopt_trans_rule is co1 co2@(AppCo co2a co2b)\n  | Just (co1a,co1b) <- etaAppCo_maybe co1 = undefined\n\n-- Push transitivity inside forall\nopt_trans_rule is co1 co2\n  | ForAllCo tv1 eta1 r1 <- co1\n  , Just (tv2,eta2,r2) <- etaForAllCo_maybe co2 = undefined\n\n  | ForAllCo tv2 eta2 r2 <- co2\n  , Just (tv1,eta1,r1) <- etaForAllCo_maybe co1 = undefined\n\n  where\n  push_trans tv1 eta1 r1 tv2 eta2 r2 = undefined\n\n-- Push transitivity inside axioms\nopt_trans_rule is co1 co2\n  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe\n  , True <- sym\n  , Just cos2 <- matchAxiom sym con ind co2\n  , let newAxInst = AxiomInstCo con ind\n                      (opt_transList is (map mkSymCo cos2) cos1)\n  , Nothing <- checkAxInstCo newAxInst\n  = undefined\n\n  -- TrPushAxR\n  | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe\n  , False <- sym\n  , Just cos2 <- matchAxiom sym con ind co2\n  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)\n  , Nothing <- checkAxInstCo newAxInst\n  = undefined\n\n  -- TrPushSymAxL\n  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe\n  , True <- sym\n  , Just cos1 <- matchAxiom (not sym) con ind co1\n  , let newAxInst = AxiomInstCo con ind\n                      (opt_transList is cos2 (map mkSymCo cos1))\n  , Nothing <- checkAxInstCo newAxInst\n  = undefined\n\n  -- TrPushAxL\n  | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe\n  , False <- sym\n  , Just cos1 <- matchAxiom (not sym) con ind co1\n  , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2)\n  , Nothing <- checkAxInstCo newAxInst\n  = undefined\n\n  -- TrPushAxSym/TrPushSymAx\n  | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe\n  , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe\n  , con1 == con2\n  , ind1 == ind2\n  , sym1 == not sym2\n  , let branch = coAxiomNthBranch con1 ind1\n        qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch\n        lhs  = coAxNthLHS con1 ind1\n        rhs  = coAxBranchRHS branch\n        pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs)\n  , all (`elemVarSet` pivot_tvs) qtvs\n  = undefined\n  where\n    co1_is_axiom_maybe = isAxiom_maybe co1\n    co2_is_axiom_maybe = isAxiom_maybe co2\n    role = coercionRole co1 -- should be the same as coercionRole co2!\n\nopt_trans_rule is co1 co2\n  | Just (lco, lh) <- isCohRight_maybe co1\n  , Just (rco, rh) <- isCohLeft_maybe co2\n  , (coercionType lh) `eqType` (coercionType rh)\n  = undefined\n\nopt_trans_rule _ co1 co2        -- Identity rule\n  | (Pair ty1 _, r) <- coercionKindRole co1\n  , Pair _ ty2 <- coercionKind co2\n  , ty1 `eqType` ty2\n  = undefined\n\nopt_trans_rule _ _ _ = Nothing\n", "num_lines": 191}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11245 where\n\n\nfoo x = do\n  let a | Just i <- x\n        , odd i\n        = True\n\n        | Nothing <- x\n        = False\n\n  print x\n  print a\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule Hang where\nimport Control.Monad\nimport Data.Char\n\ndata Event\n  = EventBeginDocument\n  | EventEndDocument\n  | EventBeginDoctype\n  | EventEndDoctype\n  | EventInstruction\n  | EventBeginElement\n  | EventEndElement\n  | EventContent Content\n  | EventComment\n  | EventCDATA\n\ndata Content\n  = ContentText String\n  | ContentEntity String\n\n\npeek :: Monad m => Consumer a m (Maybe a)\npeek = undefined\n\ntype Consumer i m r = forall o. ConduitM i o m r\n\ntag :: forall m a b c o . Monad m =>\n    ConduitM Event o m (Maybe c)\ntag = do\n    _ <- dropWS\n    return undefined\n  where\n-- Add this and it works\n--     dropWS :: Monad m => ConduitM Event o m (Maybe Event)\n    dropWS = do\n-- Swap these two lines and it works\n        -- let x = undefined\n        x <- peek\n        let isWS =\n                case x of\n                    -- Remove some of these and it works\n                    Just EventBeginDocument -> True\n                    Just EventEndDocument -> True\n                    Just EventBeginDoctype{} -> True\n                    Just EventEndDoctype -> True\n                    Just EventInstruction{} -> True\n                    Just EventBeginElement{} -> False\n                    Just EventEndElement{} -> False\n                    Just (EventContent (ContentText t))\n                        | all isSpace t -> True\n                        | otherwise -> False\n                    Just (EventContent ContentEntity{}) -> False\n                    Just EventComment{} -> True\n                    Just EventCDATA{} -> False\n                    Nothing -> False\n        if isWS then dropWS else return x\n\n\n-- Inlined Instances\n\ninstance Functor (ConduitM i o m) where\n    fmap f (ConduitM c) = ConduitM $ \\rest -> c (rest . f)\n\ninstance Applicative (ConduitM i o m) where\n    pure x = ConduitM ($ x)\n    {-# INLINE pure #-}\n    (<*>) = ap\n    {-# INLINE (<*>) #-}\n\ninstance Monad (ConduitM i o m) where\n    return = pure\n    ConduitM f >>= g = ConduitM $ \\h -> f $ \\a -> unConduitM (g a) h\n\ninstance Monad m => Functor (Pipe l i o u m) where\n    fmap = liftM\n    {-# INLINE fmap #-}\n\ninstance Monad m => Applicative (Pipe l i o u m) where\n    pure = Done\n    {-# INLINE pure #-}\n    (<*>) = ap\n    {-# INLINE (<*>) #-}\n\ninstance Monad m => Monad (Pipe l i o u m) where\n    return = pure\n    {-# INLINE return #-}\n\n    HaveOutput p c o >>= fp = HaveOutput (p >>= fp)            c          o\n    NeedInput p c    >>= fp = NeedInput  (p >=> fp)            (c >=> fp)\n    Done x           >>= fp = fp x\n    PipeM mp         >>= fp = PipeM      ((>>= fp) `liftM` mp)\n    Leftover p i     >>= fp = Leftover   (p >>= fp)            i\n\nnewtype ConduitM i o m r = ConduitM\n    { unConduitM :: forall b.\n                    (r -> Pipe i i o () m b) -> Pipe i i o () m b\n    }\n\ndata Pipe l i o u m r =\n    HaveOutput (Pipe l i o u m r) (m ()) o\n  | NeedInput (i -> Pipe l i o u m r) (u -> Pipe l i o u m r)\n  | Done r\n  | PipeM (m (Pipe l i o u m r))\n  | Leftover (Pipe l i o u m r) l\n", "num_lines": 106}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\n\n-- This covers #11303, wherein the pattern checker would explode\n-- when it encountered patterns sharing a prefix.\n\nmain :: IO ()\nmain = do\n  args <- getArgs\n  print $ case head args of\n                      \"--primop-primop-info\"  -> \"turtle\"\n                      \"--primop-tag\" -> \"asdf\"\n                      \"--primop-list\"  -> \"casdhf\"\n                      \"--primop-vector-uniques\"  -> \"this\"\n                      \"--primop-vector-tys\"  -> \"is\"\n                      \"--primop-vector-tys-exports\"  -> \"silly\"\n                      \"--primop-vector-tycons\"  -> \"hmmm\"\n                      \"--primop-vector-turtles\"  -> \"hmmm\"\n                      \"--primop-vector-plugs\"  -> \"hmmm\"\n                      \"--primop-vector-caps\"  -> \"hmmm\"\n                      \"--primop-vector-wires\"  -> \"hmmm\"\n                      \"--primop-vector-tornado\"  -> \"hmmm\"\n                      \"--primop-vector-tomato\"  -> \"hmmm\"\n                      \"--primop-vector-maps\"  -> \"hmmm\"\n                      \"--primop-vector-paper\"  -> \"hmmm\"\n                      \"--make-haskell-wrappers\" -> \"123512\"\n                      \"--make-haskell-source\"  -> \"as;dg\"\n                      \"--make-latex-doc\" -> \"adghiw\"\n                      _ -> error \"Should not happen, known_args out of sync?\"\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -Wincomplete-patterns -Woverlapping-patterns #-}\n\nmodule T11303b where\n\ndata family Letter a\n\ndata instance Letter a = A | B | C | D | E | F | G | H | I | J\n\nf :: [Letter a] -> Int\nf = foldl go 0\n  where\n    go n letter = n + n'\n      where\n        n' = case letter of\n                  A -> 0\n                  B -> 1\n                  C -> 2\n                  D -> 3\n                  E -> 4\n                  F -> 5\n                  G -> 6\n                  H -> 7\n                  I -> 8\n                  J -> 9\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Haskell2010 #-}\n{-# OPTIONS_GHC -Woverlapping-patterns -Wincomplete-patterns #-}\n\nmodule T11374 where\n\ndata Type   = TCon TCon [Type]\n            | TUser String [Type] Type\n            | TRec [(String,Type)]\n            deriving (Show,Eq,Ord)\n\ndata TCon   = TC TC\n            | TF TFun\n            deriving (Show,Eq,Ord)\n\ndata TC     = TCNum Integer\n            | TCInf\n            | TCBit\n            | TCSeq\n            | TCFun\n            | TCTuple Int\n            deriving (Show,Eq,Ord)\n\ndata TFun   = TCAdd\n            | TCSub\n            | TCMul\n            | TCDiv\n            | TCMod\n            | TCLg2\n            | TCExp\n            | TCWidth\n            | TCMin\n            | TCMax\n            | TCLenFromThen\n            | TCLenFromThenTo\n            deriving (Show, Eq, Ord, Bounded, Enum)\n\nsimpFinTy :: Type -> Maybe [Type]\nsimpFinTy ty = case ty of\n    TCon (TC (TCNum _)) _ -> Just []\n\n    TCon (TF tf) [t1]\n      | TCLg2    <- tf -> Just [t1]\n      | TCWidth  <- tf -> Just [t1]\n\n    TCon (TF tf) [t1,t2]\n      | TCAdd <- tf -> Just [t1, t2]\n      | TCSub <- tf -> Just [t1]\n      | TCMul <- tf -> Just [t1, t2]\n      | TCDiv <- tf -> Just [t1]\n      | TCMod <- tf -> Just []\n      | TCExp <- tf -> Just [t1, t2]\n      | TCMin <- tf -> Nothing\n      | TCMax <- tf -> Just [t1, t2]\n\n    TCon (TF tf) [_,_,_]\n      | TCLenFromThen   <- tf -> Just []\n      | TCLenFromThenTo <- tf -> Just []\n\n    _ -> Nothing\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeOperators, DataKinds, TypeFamilies, GADTs #-}\n\nmodule T11984 where\n\ndata family Sing (a :: k)\n\ndata Schema = Sch [Bool]\n\ndata instance Sing (x :: Schema) where\n  SSch :: Sing x -> Sing ('Sch x)\n\ndata instance Sing (x :: [k]) where\n  SNil :: Sing '[]\n  SCons :: Sing a -> Sing b -> Sing (a ': b)\n\ndata G a where\n  GCons :: G ('Sch (a ': b))\n\neval :: G s -> Sing s -> ()\neval GCons s =\n        case s of\n          -- SSch SNil -> undefined\n          SSch (SCons _ _) -> undefined\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12957 where\n\ndata A = N | A { b :: Bool }\nf = case [] of (_:_) -> case () of\n                          a -> undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n\n-- The original test case for Trac #12957\n\nmodule T12957a where\n\ndata T = A | B\n\ndata Fields (t :: T) where\n  BFields :: { list :: [()] } -> Fields 'B\n\n  AFields :: Fields 'A\n\n  EmptyFields :: Fields t\n\nemptyA :: Fields 'A\nemptyA = AFields\n\ndata S t = S { sFields :: Fields t }\n\nf :: () -> S 'A\nf a = (S EmptyFields) { sFields = emptyA { list = [ a ] } }\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language EmptyCase #-}\nmodule T14086 where\nimport Data.Kind\n\nf :: Type -> Int\nf x = case x of\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language GADTs #-}\nmodule T14098 where\n\ndata App f a where\n  App :: f a -> App f (Maybe a)\n\ndata Ty a where\n  TBool :: Ty Bool\n  TInt  :: Ty Int\n\ndata T f a where\n  C :: T Ty (Maybe Bool)\n\nf1 :: T f a -> App f a -> ()\nf1 C (App TBool) = ()\n\nf2 :: T f a -> App f a -> ()\nf2 C (App x)\n  | TBool <- x\n  = ()\n\ng :: T f a -> App f a -> ()\ng C (App x) = case x of\n                TBool -> ()\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule T14813 where\n\nimport Data.Kind\nimport Data.Void\n\ndata SBool (z :: Bool) where\n  SFalse :: SBool 'False\n  STrue  :: SBool 'True\n\ntype family F (b :: Bool) (a :: Type) :: Type where\n  F 'True  a = a\n  F 'False _ = Void\n\ndispatch :: forall (b :: Bool) (a :: Type). SBool b -> F b a -> a\ndispatch STrue  x = x\ndispatch SFalse x = case x of {}\n\ntype family G a\ntype instance G Int = Void\n\nfun :: i ~ Int => G i -> a\nfun x = case x of {}\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T15305 where\n\nimport Data.Void\n\n-- Example 1\n\ndata (:+:) f g a = Inl !(f a) | Inr !(g a)\n\ndata A\ndata B\n\ndata Foo l where\n  Foo :: Foo A\n\ndata Bar l where\n  Bar :: Bar B\n\ntype Sig = Foo :+: Bar\n\nfun :: Sig B -> Int\nfun (Inr Bar) = 1\n\n-- Example 2\n\ndata GhcPass c\ntype family XXHsImplicitBndrs x\ntype instance XXHsImplicitBndrs (GhcPass _) = Void\n\ndata HsImplicitBndrs pass\n  = UsefulConstructor\n  | XHsImplicitBndrs !(XXHsImplicitBndrs pass)\n\nfun2 :: HsImplicitBndrs (GhcPass pass) -> ()\nfun2 UsefulConstructor = ()\n\nfun2' :: (p ~ GhcPass pass) => HsImplicitBndrs p -> ()\nfun2' UsefulConstructor = ()\n\n-- Example 3\n\ndata Abyss = MkAbyss !Abyss\n\nstareIntoTheAbyss :: Abyss -> a\nstareIntoTheAbyss x = case x of {}\n{-\nAlas, this function is marked non-exhaustive, since the way GHC solves\nNonVoid constraints at the moment isn't sophisticated enough to handle\nrecursive strict argument types like MkAbyss exhibits. Maybe some day.\n-}\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -Wincomplete-patterns #-}\nmodule T15385 where\n\nimport Data.Type.Equality\n\ndata T a where\n  TInt  :: T Int\n  TBool :: T Bool\n\nf1, f2 :: a :~: Int -> T a -> ()\nf1 eq t\n  | Refl <- eq\n  = case t of\n      TInt -> ()\nf2 eq t\n  = if |  Refl <- eq\n       -> case t of\n            TInt -> ()\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE GADTs #-}\nmodule T15450 where\n\nf :: (Int ~ Bool) => Bool -> a\nf x = case x of {}\n\ng :: (Int ~ Bool) => Bool -> a\ng x = case x of True -> undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# OPTIONS -Wincomplete-patterns #-}\nmodule T15584 where\n\nimport Data.Void\n\ndata V = MkV !Void\ndata    S1 = MkS1 !V\nnewtype S2 = MkS2 V\n\ns1 :: S1 -> a\ns1 x = case x of {}\n\ns2 :: S2 -> a\ns2 x = case x of {}\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n{-# LANGUAGE GADTs #-}\n\nmodule T2006 where\n\ndata Expr a vs where\n    EPrim   :: String -> a -> Expr a vs\n    EVar    :: Expr a (a,vs)\n\ninterpret :: Expr a () -> a\ninterpret (EPrim _ a) = a\n-- interpret EVar = error \"unreachable\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T2204 where\n\nf :: String -> Int\nf \"01\" = 0\n\ng :: Int -> Int\ng 0 = 0\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternGuards #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T3078 where\n\ndata T = A Int | B Int\n\nfunny :: T -> Int\nfunny t = n\n    where\n      n | A x <- t = x\n        | B x <- t = x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-incomplete-patterns -fwarn-overlapping-patterns -Werror #-}\n\nmodule T322 where\n\ninstance (Num a) => Num (Maybe a) where\n  (Just a) + (Just b) = Just (a + b)\n  _ + _ = Nothing\n\n  (Just a) - (Just b) = Just (a - b)\n  _ - _ = Nothing\n\n  (Just a) * (Just b) = Just (a * b)\n  _ * _ = Nothing\n\n  negate (Just a) = Just (negate a)\n  negate _ = Nothing\n\n  abs (Just a) = Just (abs a)\n  abs _ = Nothing\n\n  signum (Just a) = Just (signum a)\n  signum _ = Nothing\n\n  fromInteger = Just . fromInteger\n\nf :: Maybe Int -> Int\nf 1       = 1\nf Nothing = 2\nf _       = 3\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XGADTs -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T366 where\n\ndata T a where\n  C1 :: T Char\n  C2 :: T Float\n\nexhaustive :: T Char -> Char\nexhaustive C1 = ' '\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T3927 where\n\ndata T a where\n  T1 :: T Int\n  T2 :: T Bool\n\n-- f1 is exhaustive\nf1 :: T a -> T a -> Bool\nf1 T1 T1 = True\nf1 T2 T2 = False\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n{-# LANGUAGE GADTs, TypeFamilies #-}\n\nmodule T3927a where\n\ntype family F a\ntype instance F a = ()\n\ndata Foo a where\n  FooA :: Foo ()\n  FooB :: Foo Int\n\nf :: a -> Foo (F a) -> () -- F a can only be () so only FooA is accepted\nf _ FooA = ()\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE UndecidableSuperClasses #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T3927b where\n\nimport Data.Kind (Type, Constraint)\nimport Data.Proxy\n\ndata Message\n\ndata SocketType = Dealer | Push | Pull\n\ndata SocketOperation = Read | Write\n\ntype family Restrict (a :: SocketOperation) (as :: [SocketOperation]) :: Constraint where\n    Restrict a (a ': as) = ()\n    Restrict x (a ': as) = Restrict x as\n    Restrict x '[] = (\"Error!\" ~ \"Tried to apply a restricted type!\")\n\ntype family Implements (t :: SocketType) :: [SocketOperation] where\n    Implements Dealer = ['Read, Write]\n    Implements Push = '[Write]\n    Implements Pull = '[ 'Read]\n\ndata SockOp :: SocketType -> SocketOperation -> Type where\n    SRead :: SockOp sock 'Read\n    SWrite :: SockOp sock Write\n\ndata Socket :: SocketType -> Type where\n    Socket :: proxy sock\n           -> (forall op . Restrict op (Implements sock) => SockOp sock op -> Operation op)\n           -> Socket sock\n\ntype family Operation (op :: SocketOperation) :: Type where\n    Operation 'Read = IO Message\n    Operation Write = Message -> IO ()\n\nclass Restrict 'Read (Implements t) => Readable t where\n    readSocket :: Socket t -> Operation 'Read\n    readSocket (Socket _ f) = f (SRead :: SockOp t 'Read)\n\ninstance Readable Dealer\n\ntype family Writable (t :: SocketType) :: Constraint where\n    Writable Dealer = ()\n    Writable Push = ()\n\ndealer :: Socket Dealer\ndealer = Socket (Proxy :: Proxy Dealer) f\n  where\n    f :: Restrict op (Implements Dealer) => SockOp Dealer op -> Operation op\n    f SRead = undefined\n    f SWrite = undefined\n\npush :: Socket Push\npush = Socket (Proxy :: Proxy Push) f\n  where\n    f :: Restrict op (Implements Push) => SockOp Push op -> Operation op\n    f SWrite = undefined\n-- Seeing that this pattern match is exhaustive\n-- requires a reasonably vigorous effort on given\n-- superclass expansion.\n\npull :: Socket Pull\npull = Socket (Proxy :: Proxy Pull) f\n  where\n    f :: Restrict op (Implements Pull) => SockOp Pull op -> Operation op\n    f SRead = undefined\n\nfoo :: IO Message\nfoo = readSocket dealer\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n\nmodule T4139 where\n\ndata F a where\n  FInt :: F Int\n  FBool :: F Bool\n\nclass Baz a where\n  baz :: F a -> G a\ninstance Baz Int where\n  baz _ = GInt\ninstance Baz Bool where\n  baz _ = GBool\n\ndata G a where\n  GInt :: G Int\n  GBool :: G Bool\n\nbar :: Baz a => F a -> ()\nbar a@(FInt) =\n  case baz a of\n    GInt -> ()\n    -- GBool -> ()\nbar _ = ()\n\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n\nmodule T6124 where\n\nnewtype A = MkA Int\nnewtype B = MkB Char\n\ndata T a where\n    A :: T A\n    B :: T B\n\nf :: T A -> A\nf A = undefined\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n\nmodule T7669 where\n\ndata Void\n\nfoo :: Void -> ()\nfoo x = case x of {}\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, KindSignatures, GADTs, TypeFamilies #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T8970 where\n\nimport Data.Kind (Type)\n\ndata K = Foo\n       | Bar\n\ndata D1 :: K -> Type where\n    F1 :: D1 Foo\n    B1 :: D1 Bar\n\nclass C (a :: K -> Type) where\n    data D2 a :: K -> Type\n    foo :: a k -> D2 a k -> Bool\n\ninstance C D1 where\n    data D2 D1 k where\n              F2 :: D2 D1 Foo\n              B2 :: D2 D1 Bar\n    foo F1 F2 = True\n    foo B1 B2 = True\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedLists #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T9951 where\n\nf :: [a] -> ()\nf x = case x of\n  [] -> ()\n  (_:_) -> ()\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T9951b where\n\nf :: String -> Bool\nf \"ab\" = True\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, KindSignatures #-}\n\nmodule Foo where\n\nimport Data.Proxy\n\n-- Should be illegal without PolyKinds\nf :: forall k (a :: k). Proxy a\nf = f\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From the blog post Fun With XPolyKinds : Polykinded Folds\n--   http://www.typesandotherdistractions.com/2012/02/fun-with-xpolykinds-polykinded-folds.html\n\n{-\nIn the following, I will write a polykinded version of the combinators\nfold and unfold, along with three examples: folds for regular\ndatatypes (specialized to kind Type), folds for nested datatypes\n(specialized to kind Type -> Type), and folds for mutually recursive data\ntypes (specialized to the product kind (Type, Type)). The approach should\ngeneralise easily enough to things such as types indexed by another\nkind (e.g. by specializing to kind Nat -> Type, using the XDataKinds\nextension), or higher order nested datatypes (e.g. by specializing to\nkind (Type -> Type) -> (Type -> Type)).\n\nThe following will compile in the new GHC 7.4.1 release. We require\nthe following GHC extensions:\n-}\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\nmodule Main where\n\nimport Data.Kind (Type)\n\n{- The basic fold and unfold combinators can be written as follows:\n\nfold phi = phi . fmap (fold phi) . out\nunfold psi = in . fmap (unfold psi) . psi\n\nThe idea now is to generalize these combinators by working over\ndifferent categories. We can capture the basic operations in a\ncategory with a typeclass: -}\n\nclass Category hom where\n  ident :: hom a a\n  compose :: hom a b -> hom b c -> hom a c\n\n{- A category has two operations: an identity morphism for every\nobject, and for every two compatible morphisms, the composition of\nthose morphisms.\n\nIn earlier versions of GHC, the type hom would have been specialized\nto kind Type -> Type -> Type, but with the new PolyKinds extension, hom is\npolykinded, and the Category typeclass can be instantiated to k -> k\n-> Type for any kind k. This means that in addition to all of the\nCategory instances that we could have written before, we can now write\ninstances of Category for type constructors, type constructor\nconstructors, etc.\n\nHere is the instance for the category Hask of Haskell types. Objects\nare Haskell types and morphisms are functions between types. The\nidentity is the regular polymorphic identity function id, and\ncomposition is given by the (flipped) composition operator (.) -}\n\ninstance Category (->) where\n  ident = id\n  compose = flip (.)\n\n{- Another example is the category of type constructors and natural\ntransformations. A natural transformation is defined as follows: -}\n\nnewtype Nat f g = Nat { nu :: (forall a. f a -> g a) } \n\n{- Here is the Category instance for natural transformations. This\ntime the type hom is inferred to have kind (Type -> Type) -> (Type -> Type) ->\nType. Identity and composition are both defined pointwise. -}\n\ninstance Category (Nat :: (Type -> Type) -> (Type -> Type) -> Type) where\n  ident = Nat id\n  compose f g = Nat (nu g . nu f)\n\n{- Let's define a type class which will capture the idea of a fixed point\nin a category. This generalizes the idea of recursive types in Hask: -}\n\nclass Rec hom f t where\n  _in :: hom (f t) t\n  out :: hom t (f t)\n\n{- The class Rec defines two morphisms: _in, which is the constructor of\nthe fixed point type t, and out, its destructor.\n\nThe final piece is the definition of a higher order functor, which\ngeneralizes the typeclass Functor: -}\n\nclass HFunctor hom f where\n  hmap :: hom a b -> hom (f a) (f b)\n\n{- Note the similarity with the type signature of the function fmap ::\n(Functor f) => (a -> b) -> f a -> f b. Indeed, specializing hom to\n(->) in the definition of HFunctor gives back the type signature of\nfmap. \n\nFinally, we can define folds and unfolds in a category. The\ndefinitions are as before, but with explicit composition, constructors\nand destructors replaced with the equivalent type class methods, and\nhmap in place of fmap: -}\n\nfold :: (Category hom, HFunctor hom f, Rec hom f rec) => hom (f t) t -> hom rec t\nfold phi = compose out (compose (hmap (fold phi)) phi)\n\nunfold :: (Category hom, HFunctor hom f, Rec hom f rec) => hom t (f t) -> hom t rec\nunfold phi = compose phi (compose (hmap (unfold phi)) _in)\n\n-- Now for some examples.\n\n-- The first example is a regular recursive datatype of binary leaf\n-- trees. The functor FTree is the base functor of this recursive type:\n\ndata FTree a b = FLeaf a | FBranch b b\ndata Tree a = Leaf a | Branch (Tree a) (Tree a)\n\n-- An instance of Rec shows the relationship between the defining functor\n-- and the recursive type itself:\n\ninstance Rec (->) (FTree a) (Tree a) where\n  _in (FLeaf a) = Leaf a\n  _in (FBranch a b) = Branch a b\n  out (Leaf a) = FLeaf a\n  out (Branch a b) = FBranch a b\n\n-- FTree is indeed a functor, so it is also a HFunctor:\n\ninstance HFunctor (->) (FTree a) where\n  hmap f (FLeaf a) = FLeaf a\n  hmap f (FBranch a b) = FBranch (f a) (f b)\n\n-- These instances are enough to define folds and unfolds for this\n-- type. The following fold calculates the depth of a tree:\n\ndepth :: Tree a -> Int\ndepth = (fold :: (FTree a Int -> Int) -> Tree a -> Int) phi where\n  phi :: FTree a Int -> Int\n  phi (FLeaf a) = 1\n  phi (FBranch a b) = 1 + max a b\n\n-- The second example is a fold for the nested (or non-regular)\n-- datatype of complete binary leaf trees. The higher order functor\n-- FCTree defines the type constructor CTree as its fixed point:\n\ndata FCTree f a = FCLeaf a | FCBranch (f (a, a))\n  -- FCTree :: (Type -> Type) -> Type -> Type\n\ndata CTree a = CLeaf a | CBranch (CTree (a, a))\n\n-- Again, we define type class instances for HFunctor and Rec:\n\ninstance HFunctor Nat FCTree where\n  hmap (f :: Nat (f :: Type -> Type) (g :: Type -> Type)) = Nat ff where\n    ff :: forall a. FCTree f a -> FCTree g a\n    ff (FCLeaf a) = FCLeaf a\n    ff (FCBranch a) = FCBranch (nu f a)\n\ninstance Rec Nat FCTree CTree where\n  _in = Nat inComplete where\n    inComplete (FCLeaf a) = CLeaf a\n    inComplete (FCBranch a) = CBranch a\n  out = Nat outComplete where\n    outComplete(CLeaf a) = FCLeaf a\n    outComplete(CBranch a) = FCBranch a\n\n-- Morphisms between type constructors are natural transformations, so we\n-- need a type constructor to act as the target of the fold. For our\n-- purposes, a constant functor will do:\n\ndata K a b = K a  -- K :: forall k. Type -> k -> Type\n\n\n-- And finally, the following fold calculates the depth of a complete binary leaf tree:\n\ncdepth :: CTree a -> Int\ncdepth c = let (K d) = nu (fold (Nat phi)) c in d where\n  phi :: FCTree (K Int) a -> K Int a\n  phi (FCLeaf a) = K 1\n  phi (FCBranch (K n)) = K (n + 1)\n\n{- The final example is a fold for the pair of mutually recursive\ndatatype of lists of even and odd lengths. The fold will take a list\nof even length and produce a list of pairs.\n\nWe cannot express type constructors in Haskell whose return kind is\nanything other than Type, so we cheat a little and emulate the product\nkind using an arrow kind Choice -> Type, where Choice is a two point\nkind, lifted using the XDataKinds extension: -}\n\ndata Choice = Fst | Snd\n\n-- A morphism of pairs of types is just a pair of morphisms. For\n-- technical reasons, we represent this using a Church-style encoding,\n-- along with helper methods, as follows:\n\nnewtype PHom h1 h2 p1 p2 = PHom { runPHom :: forall r. (h1 (p1 Fst) (p2 Fst) -> h2 (p1 Snd) (p2 Snd) -> r) -> r }\n\nmkPHom f g = PHom (\\h -> h f g)\nfstPHom p = runPHom p (\\f -> \\g -> f)\nsndPHom p = runPHom p (\\f -> \\g -> g)\n\n-- Now, PHom allows us to take two categories and form the product category:\n\ninstance (Category h1, Category h2) => Category (PHom h1 h2) where\n  ident = mkPHom ident ident\n  compose p1 p2 = mkPHom (compose (fstPHom p1) (fstPHom p2)) (compose (sndPHom p1) (sndPHom p2))\n\n-- We can define the types of lists of even and odd length as\n-- follows. Note that the kind annotation indicates the appearance of the\n-- kind Choice -> Type:\n\ndata FAlt :: Type -> (Choice -> Type) -> Choice -> Type where\n  FZero :: FAlt a p Fst\n  FSucc1 :: a -> (p Snd) -> FAlt a p Fst\n  FSucc2 :: a -> (p Fst) -> FAlt a p Snd\n\ndata Alt :: Type -> Choice -> Type where\n  Zero :: Alt a Fst\n  Succ1 :: a -> Alt a Snd -> Alt a Fst\n  Succ2 :: a -> Alt a Fst -> Alt a Snd\n\nderiving instance Show a => Show (Alt a b)\n\n-- Again, we need to define instances of Rec and HFunctor:\n\ninstance Rec (PHom (->) (->)) (FAlt a) (Alt a) where\n  _in = mkPHom f g where\n    f,g :: FAlt a (Alt a) s -> Alt a s\n    f FZero = Zero\n    f (FSucc1 a b) = Succ1 a b\n    g (FSucc2 a b) = Succ2 a b\n\n  out = mkPHom f g where\n    f,g :: Alt a s -> FAlt a (Alt a) s\n    f Zero = FZero\n    f (Succ1 a b) = FSucc1 a b\n    g (Succ2 a b) = FSucc2 a b\n\ninstance HFunctor (PHom (->) (->)) (FAlt a) where\n  hmap p = mkPHom hf hg where\n    hf FZero = FZero\n    hf (FSucc1 a x) = FSucc1 a (sndPHom p x)\n    hg (FSucc2 a x) = FSucc2 a (fstPHom p x)\n\n-- As before, we create a target type for our fold, and this time a type synonym as well:\n\ndata K2 :: Type -> Type -> Choice -> Type where\n  K21 :: a -> K2 a b Fst\n  K22 :: b -> K2 a b Snd\n\ntype PairUpResult a = K2 [(a, a)] (a, [(a, a)])\n\n-- At last, here is the fold pairUp, taking even length lists to lists of pairs:\n\npairUp :: Alt a Fst -> [(a, a)]\npairUp xs = let (K21 xss) = (fstPHom (fold (mkPHom phi psi))) xs in xss \n where\n   phi :: FAlt y (K2 v (r,[(y,r)])) s -> K2 [(y,r)] (y,z) s\n   phi FZero                       = K21 []\n   phi (FSucc1 x1 (K22 (x2, xss))) = K21 ((x1, x2):xss) \n\n   psi :: FAlt y (K2 z w) s -> K2 [x] (y,z) s\n   psi (FSucc2 x (K21 xss)) = K22 (x, xss) \n\nmain = print (Succ1 (0::Int) $ Succ2 1 $ Succ1 2 $ Succ2 3 $ Succ1 4 $ Succ2 5 Zero)\n", "num_lines": 268}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module KindVType where\n\n-- test printing of \"type\" in output, not \"kind\"\n\nimport Data.Proxy\n\nfoo :: Proxy Maybe\nfoo = (Proxy :: Proxy Int)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From a blog post: http://www.jonmsterling.com/posts/2012-01-12-unifying-monoids-and-monads-with-polymorphic-kinds.html\n\n-------------------- FUNCTIONAL DEPENDENCY VERSION ----------------\n\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE UnicodeSyntax #-}\n\nmodule Main where\nimport Control.Monad (Monad(..), join, ap)\nimport Data.Monoid (Monoid(..))\nimport Data.Semigroup (Semigroup(..))\n\n-- First we define the type class Monoidy:\n\nclass Monoidy to comp id m | m to \u00e2\u2020\u2019 comp id where\n  munit :: id `to` m\n  mjoin :: (m `comp` m) `to` m\n\n-- We use functional dependencies to help the typechecker understand that\n-- m and ~> uniquely determine comp (times) and id.\n-- \n-- This kind of type class would not have been possible in previous\n-- versions of GHC; with the new kind system, however, we can abstract\n-- over kinds!2 Now, let\u00e2\u20ac\u2122s create types for the additive and\n-- multiplicative monoids over the natural numbers:\n\nnewtype Sum a = Sum a deriving Show\nnewtype Product a = Product a deriving Show\ninstance Num a \u00e2\u2021\u2019 Monoidy (\u00e2\u2020\u2019) (,) () (Sum a) where\n  munit _ = Sum 0\n  mjoin (Sum x, Sum y) = Sum $ x + y\ninstance Num a \u00e2\u2021\u2019 Monoidy (\u00e2\u2020\u2019) (,) () (Product a) where\n  munit _ = Product 1\n  mjoin (Product x, Product y) = Product $ x * y\n\n-- It will be slightly more complicated to make a monadic instance with\n-- Monoidy. First, we need to define the identity functor, a type for\n-- natural transformations, and a type for functor composition:\n\ndata Id \u00ce\u00b1 = Id { runId :: \u00ce\u00b1 } deriving Functor\n\n-- A natural transformation (\u00ce\u203a\u00e2\u20ac\u2020f g \u00ce\u00b1.\u00e2\u20ac\u2020(f \u00ce\u00b1)\u00e2\u20ac\u201e\u00e2\u2020\u2019\u00e2\u20ac\u201e(g \u00ce\u00b1)) may be encoded in Haskell as follows:\n\ndata NT f g = NT { runNT :: \u00e2\u02c6\u20ac \u00ce\u00b1. f \u00ce\u00b1 \u00e2\u2020\u2019 g \u00ce\u00b1 }\n\n-- Functor composition (\u00ce\u203a\u00e2\u20ac\u2020f g \u00ce\u00b1.\u00e2\u20ac\u2020f (g \u00ce\u00b1)) is encoded as follows:\n\ndata FC f g \u00ce\u00b1 = FC { runFC :: f (g \u00ce\u00b1) }\n\n-- Now, let us define some type T which should be a monad:\n\ndata Wrapper a = Wrapper { runWrapper :: a } deriving (Show, Functor)\ninstance Monoidy NT FC Id Wrapper where\n  munit = NT $ Wrapper . runId\n  mjoin = NT $ runWrapper . runFC\n\n-- With these defined, we can use them as follows:\n\ntest1 = do { print (mjoin (munit (), Sum 2))\n                 -- Sum 2\n           ; print (mjoin (Product 2, Product 3))\n                 -- Product 6\n           ; print (runNT mjoin $ FC $ Wrapper (Wrapper \"hello, world\"))\n                 -- Wrapper {runWrapper = \"hello, world\" }\n           }\n\n-- We can even provide a special binary operator for the appropriate monoids as follows:\n\n(<+>) :: Monoidy (\u00e2\u2020\u2019) (,) () m \u00e2\u2021\u2019 m \u00e2\u2020\u2019 m \u00e2\u2020\u2019 m\n(<+>) = curry mjoin\n\ntest2 = print (Sum 1 <+> Sum 2 <+> Sum 4)  -- Sum 7\n\n-- Now, all the extra wrapping that Haskell requires for encoding this is\n-- rather cumbersome in actual use. So, we can give traditional Monad and\n-- Monoid instances for instances of Monoidy:\n\ninstance Monoidy (\u00e2\u2020\u2019) (,) () m \u00e2\u2021\u2019 Semigroup m where\n  (<>) = curry mjoin\n\ninstance Monoidy (\u00e2\u2020\u2019) (,) () m \u00e2\u2021\u2019 Monoid m where\n  mempty = munit ()\n\ninstance Applicative Wrapper where\n  pure  = return\n  (<*>) = ap\n\n-- instance (Functor m, Monoidy NT FC Id m) \u00e2\u2021\u2019 Monad m where\ninstance Monad Wrapper where\n   return x = runNT munit $ Id x\n   x >>= f = runNT mjoin $ FC (f `fmap` x)\n\n-- And so the following works:\n\ntest3\n = do { print (mappend mempty (Sum 2))  \n             -- Sum 2\n      ; print (mappend (Product 2) (Product 3))\n             -- Product 6\n      ; print (join $ Wrapper $ Wrapper \"hello\")\n             -- Wrapper {runWrapper = \"hello\" }\n      ; print (Wrapper \"hello, world\" >>= return)\n             -- Wrapper {runWrapper = \"hello, world\" }\n      }\n\nmain = test1 >> test2 >> test3\n", "num_lines": 114}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From a blog post: http://www.jonmsterling.com/posts/2012-01-12-unifying-monoids-and-monads-with-polymorphic-kinds.html\n\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE UnicodeSyntax #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Main where\n\nimport Data.Kind\nimport Control.Monad (Monad(..), join, ap, liftM)\nimport Data.Monoid (Monoid(..))\nimport Data.Semigroup (Semigroup(..))\n\n-- First we define the type class Monoidy:\n\nclass Monoidy (to :: k0 -> k1 -> Type) (m :: k1)  where\n  type MComp to m :: k1 -> k1 -> k0\n  type MId   to m :: k0\n  munit :: MId to m `to` m\n  mjoin :: MComp to m m m `to` m\n\n-- We use functional dependencies to help the typechecker understand that\n-- m and ~> uniquely determine comp (times) and id.\n\n-- This kind of type class would not have been possible in previous\n-- versions of GHC; with the new kind system, however, we can abstract\n-- over kinds!2 Now, let\u00e2\u20ac\u2122s create types for the additive and\n-- multiplicative monoids over the natural numbers:\n\nnewtype Sum a = Sum a deriving Show\nnewtype Product a = Product a deriving Show\ninstance Num a \u00e2\u2021\u2019 Monoidy (\u00e2\u2020\u2019) (Sum a) where\n  type MComp (\u00e2\u2020\u2019) (Sum a) = (,)\n  type MId   (\u00e2\u2020\u2019) (Sum a) = ()\n  munit _ = Sum 0\n  mjoin (Sum x, Sum y) = Sum $ x + y\n\ninstance Num a \u00e2\u2021\u2019 Monoidy (\u00e2\u2020\u2019) (Product a) where\n  type MComp (\u00e2\u2020\u2019) (Product a) = (,)\n  type MId   (\u00e2\u2020\u2019) (Product a) = ()\n  munit _ = Product 1\n  mjoin (Product x, Product y) = Product $ x * y\n\n-- It will be slightly more complicated to make a monadic instance with\n-- Monoidy. First, we need to define the identity functor, a type for\n-- natural transformations, and a type for functor composition:\n\ndata Id \u00ce\u00b1 = Id { runId :: \u00ce\u00b1 } deriving Functor\n\n-- A natural transformation (\u00ce\u203a\u00e2\u20ac\u2020f g \u00ce\u00b1.\u00e2\u20ac\u2020(f \u00ce\u00b1)\u00e2\u20ac\u201e\u00e2\u2020\u2019\u00e2\u20ac\u201e(g \u00ce\u00b1)) may be encoded in Haskell as follows:\n\ndata NT f g = NT { runNT :: \u00e2\u02c6\u20ac \u00ce\u00b1. f \u00ce\u00b1 \u00e2\u2020\u2019 g \u00ce\u00b1 }\n\n-- Functor composition (\u00ce\u203a\u00e2\u20ac\u2020f g \u00ce\u00b1.\u00e2\u20ac\u2020f (g \u00ce\u00b1)) is encoded as follows:\n\ndata FC f g \u00ce\u00b1 = FC { runFC :: f (g \u00ce\u00b1) }\n\n-- Now, let us define some type T which should be a monad:\n\ndata Wrapper a = Wrapper { runWrapper :: a } deriving (Show, Functor)\ninstance Monoidy NT Wrapper where\n  type MComp NT Wrapper = FC\n  type MId   NT Wrapper = Id\n  munit = NT $ Wrapper . runId\n  mjoin = NT $ runWrapper . runFC\n\n\n-- With these defined, we can use them as follows:\n\ntest1 = do { print (mjoin (munit (), Sum 2))\n                 -- Sum 2\n           ; print (mjoin (Product 2, Product 3))\n                 -- Product 6\n           ; print (runNT mjoin $ FC $ Wrapper (Wrapper \"hello, world\"))\n                 -- Wrapper {runWrapper = \"hello, world\" }\n           }\n\n-- We can even provide a special binary operator for the appropriate monoids as follows:\n\n(<+>) :: (Monoidy (\u00e2\u2020\u2019) m, MId (\u00e2\u2020\u2019) m ~ (), MComp (\u00e2\u2020\u2019) m ~ (,)) \n       \u00e2\u2021\u2019 m \u00e2\u2020\u2019 m \u00e2\u2020\u2019 m\n(<+>) = curry mjoin\n\ntest2 = print (Sum 1 <+> Sum 2 <+> Sum 4)  -- Sum 7\n\n-- Now, all the extra wrapping that Haskell requires for encoding this is\n-- rather cumbersome in actual use. So, we can give traditional Monad and\n-- Monoid instances for instances of Monoidy:\n\ninstance (MId (\u00e2\u2020\u2019) m ~ (), MComp (\u00e2\u2020\u2019) m ~ (,), Monoidy (\u00e2\u2020\u2019) m)\n       \u00e2\u2021\u2019 Semigroup m where\n  (<>) = curry mjoin\n\ninstance (MId (\u00e2\u2020\u2019) m ~ (), MComp (\u00e2\u2020\u2019) m ~ (,), Monoidy (\u00e2\u2020\u2019) m)\n       \u00e2\u2021\u2019 Monoid m where\n  mempty = munit ()\n\ninstance Applicative Wrapper where\n  pure  = return\n  (<*>) = ap\n\ninstance Monad Wrapper where\n  return x = runNT munit $ Id x\n  x >>= f = runNT mjoin $ FC (f `fmap` x)\n\n-- And so the following works:\n\ntest3\n = do { print (mappend mempty (Sum 2))  \n             -- Sum 2\n      ; print (mappend (Product 2) (Product 3))\n             -- Product 6\n      ; print (join $ Wrapper $ Wrapper \"hello\")\n             -- Wrapper {runWrapper = \"hello\" }\n      ; print (Wrapper \"hello, world\" >>= return)\n             -- Wrapper {runWrapper = \"hello, world\" }\n      }\n\nmain = test1 >> test2 >> test3\n", "num_lines": 127}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, FlexibleInstances, ScopedTypeVariables,\n             UndecidableInstances #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule PolyInstances where\n\nimport Data.Kind\nimport Data.Proxy\n\nclass C (a :: k)\n\ninstance (C a, C b) => C (a b)\n\ndata Dict :: Constraint -> Type\n\ninstance C Dict\n\nfoo :: C p => proxy p -> ()\nfoo = undefined\n\nbar :: forall (p :: Constraint) proxy. C p => proxy p -> ()\nbar _ = foo (Proxy :: Proxy (Dict p))\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                  #-}\n{-# LANGUAGE KindSignatures             #-}\n{-# LANGUAGE GADTs                      #-}\n\nmodule PolyKinds01 where\n\nimport Data.Kind (Type)\n\ndata Nat = Ze | Su Nat\n\ndata Vec :: Type -> Nat -> Type where\n  VNil  :: Vec a Ze\n  VCons :: a -> Vec a n -> Vec a (Su n)\n\nvec :: Vec Nat (Su Ze)\nvec = VCons Ze VNil\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                  #-}\n{-# LANGUAGE KindSignatures             #-}\n{-# LANGUAGE GADTs                      #-}\n\nmodule PolyKinds02 where\n\ndata Nat = Ze | Su Nat\n\ndata Vec :: * -> Nat -> * where\n  VNil  :: Vec a Ze\n  VCons :: a -> Vec a n -> Vec a (Su n)\n\nvec :: Vec Nat Nat -- Kind error\nvec = vec\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances          #-}\n{-# LANGUAGE PolyKinds                  #-}\n\nmodule PolyKinds03 where\n\ndata Proxy t\ndata TypeRep = TypeRep\n\nclass MyTypeable t where\n  myTypeOf :: Proxy t -> TypeRep\n\ninstance MyTypeable Int  where myTypeOf _ = TypeRep\ninstance MyTypeable []   where myTypeOf _ = TypeRep\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule PolyKinds04 where\n\ndata A f\ndata B = B1 (A Maybe)\n\n-- Should fail. `A` is kind checked alone, and its kind is defaulted to * -> *.\n-- The constructor `B1` then uses `A` with the wrong kind.\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds                  #-}\n\nmodule PolyKinds05 where\n\ndata A f\ndata B = B1 (A Maybe)\n\n-- Should work. We have -XPolyKinds on, so `A` gets the polymorphic kind \n--   forall k. k -> *\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, KindSignatures  #-}\n{-# LANGUAGE GADTs                      #-}\n\nmodule PolyKinds06 where\n\n\ndata A = A1 | A2 (B 'B1)\n\ndata B :: A -> * where\n  B1 :: B 'A1\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                  #-}\n{-# LANGUAGE GADTs                      #-}\n\nmodule PolyKinds07 where\n\n\ndata A = A1 | A2 (B 'B1)\n\ndata B a where\n  B1 :: B 'A1\n\n-- We correctly fail, but should probably provide a better error message\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE PolyKinds                  #-}\n\nmodule PolyKinds08 where\n\n\ndata U a = U\n\ninstance Functor U where\n  fmap f U = U\n\ninstance (Show a) => Show (U a) where\n  show U = \"\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                  #-}\n{-# LANGUAGE DefaultSignatures          #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE GADTs                      #-}\n{-# LANGUAGE FlexibleContexts           #-}\n\nmodule Main where\n\nimport Data.Kind (Type)\n\n--------------------------------------------------------------------------------\n-- Simple generic programming (instant-generics-like library)\n--------------------------------------------------------------------------------\ndata U a = UNIT | SUM (U a) (U a) | PRODUCT (U a) (U a) | REC a\n\n-- GADT interpretation\ndata I :: U Type -> Type where\n  Unit          :: I UNIT\n  Inl           :: I a -> I (SUM a b)\n  Inr           :: I b -> I (SUM a b)\n  Product       :: I a -> I b -> I (PRODUCT a b)\n  Rec           :: a -> I (REC a)\n\n-- Class embedding types and their generic representation\nclass Generic (a :: Type) where\n  type Rep a :: U Type\n  from :: a -> I (Rep a)\n  to   :: I (Rep a) -> a\n\n-- Generic size on representations\nclass GSize (a :: U Type) where\n  gsize :: I a -> Int\n\ninstance GSize UNIT where\n  gsize Unit = 0\n\ninstance (GSize a, GSize b) => GSize (SUM a b) where\n  gsize (Inl x) = gsize x\n  gsize (Inr x) = gsize x\n\ninstance (GSize a, GSize b) => GSize (PRODUCT a b) where\n  gsize (Product a b) = gsize a + gsize b\n\ninstance (Size a) => GSize (REC a) where\n  gsize (Rec x) = 1 + size x\n\n-- Size on datatypes\nclass Size (a :: Type) where\n  size :: a -> Int\n  default size :: (Generic a, GSize (Rep a)) => a -> Int\n  size = gsize . from\n\ninstance (Size a) => Size [a] -- default\ninstance Size Char where size _ = 1 -- adhoc\n\n-- Example encoding: lists\ninstance Generic [a] where\n  type Rep [a] = SUM UNIT (PRODUCT (REC a) (REC [a]))\n  from []    = Inl Unit\n  from (h:t) = Inr (Product (Rec h) (Rec t))\n  to (Inl Unit)                      = []\n  to (Inr (Product (Rec h) (Rec t))) = h:t\n\n-- Testing size\ntest1 = size \"abc\"\n\nmain = print test1\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures             #-}\n{-# LANGUAGE TypeOperators              #-}\n{-# LANGUAGE GADTs                      #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE RankNTypes                 #-}\n{-# LANGUAGE ScopedTypeVariables        #-}\n{-# LANGUAGE FlexibleContexts           #-}\n{-# LANGUAGE DataKinds                  #-}\n\nmodule Main where\n\nimport Data.Kind\n\n-- Type-level peano naturals (value-level too, but we don't use those)\ndata Nat = Ze | Su Nat\n\ntype T0 = Ze\ntype T1 = Su T0\ntype T2 = Su T1\n\n-- (!) at the type level\ntype family El (n :: Nat) (l :: [Type]) :: Type\ntype instance El Ze     (h ': t) = h\ntype instance El (Su n) (h ': t) = El n t\n\n{-\n-- The following might be useful, but are not used at the moment\n-- ($) at the type level (well, not quite ($), in fact...)\nclass Apply (fs :: [Type]) (es :: [Type]) where\n  type ApplyT (fs :: [Type]) (es :: [Type]) :: [Type]\n  apply :: ListV fs -> ListV es -> ListV (ApplyT fs es)\n\ninstance Apply '[] '[] where\n  type ApplyT '[] '[] = '[]\n  apply NilV NilV = NilV\n\ninstance (Apply fs es) => Apply ((e1 -> e2) ': fs) (e1 ': es) where\n  type ApplyT ((e1 -> e2) ': fs) (e1 ': es) = e2 ': ApplyT fs es\n  apply (ConsV f fs) (ConsV e es) = ConsV (f e) (apply fs es)\n-}\n\n-- Value mirror for the list kind\ndata ListV :: [Type] -> Type where\n  NilV  :: ListV '[]\n  ConsV :: a -> ListV t -> ListV (a ': t)\n  \ndata ListV2 :: [[Type]] -> Type where\n  NilV2  :: ListV2 '[]\n  ConsV2 :: ListV a -> ListV2 t -> ListV2 (a ': t)\n  \nlistv1 :: ListV (Int ': '[])\nlistv1 = ConsV 3 NilV\n\nlistv2 :: ListV2 ((Int ': '[]) ': '[])\nlistv2 = ConsV2 listv1 NilV2\n\n--data ListVX :: Maybe -> Type where\n\ndata TripleV :: (Type, Type -> Type, Type) -> Type where\n  TripleV :: a -> c -> TripleV '(a, [], c)\n\n-- Value mirror for the Nat kind\ndata NatV :: Nat -> Type where\n  ZeW :: NatV Ze\n  SuW :: NatV n -> NatV (Su n)\n\n-- Generic universe\ndata MultiP x = UNIT\n              | KK x -- wish I could just write Type instead of x\n              | SUM  (MultiP x) (MultiP x)\n              | PROD (MultiP x) (MultiP x)\n              | PAR Nat\n              | REC\n\n-- Universe interpretation\ndata Interprt :: MultiP Type -> [Type] -> Type -> Type where\n  Unit  :: Interprt UNIT lp r\n  K     :: x -> Interprt (KK x) lp r\n  L     :: Interprt a lp r -> Interprt (SUM a b) lp r\n  R     :: Interprt b lp r -> Interprt (SUM a b) lp r\n  Prod  :: Interprt a lp r -> Interprt b lp r -> Interprt (PROD a b) lp r\n  Par   :: NatV n -> El n lp -> Interprt (PAR n) lp r\n  Rec   :: r -> Interprt REC lp r\n\n-- Embedding values into the universe\nclass Generic a where\n  type Rep a :: MultiP Type\n  type Es a  :: [Type]\n  from :: a -> Interprt (Rep a) (Es a) a\n  to   :: Interprt (Rep a) (Es a) a -> a\n\n-- Parameter map over the universe\nclass PMap (rep :: MultiP Type) where\n  pmap :: (forall n. NatV n -> El n lp1 -> El n lp2)\n       -> (r -> s) -> Interprt rep lp1 r -> Interprt rep lp2 s\n\ninstance PMap UNIT where\n  pmap _ _ Unit = Unit\n\ninstance PMap (KK x) where\n  pmap _ _ (K x) = K x\n\ninstance (PMap a, PMap b) => PMap (SUM a b) where\n  pmap f g (L x) = L (pmap f g x)\n  pmap f g (R x) = R (pmap f g x)\n\ninstance (PMap a, PMap b) => PMap (PROD a b) where\n  pmap f g (Prod x y) = Prod (pmap f g x) (pmap f g y)\n\ninstance PMap (PAR p) where\n  pmap f _ (Par n p) = Par n (f n p)\n\ninstance PMap REC where\n  pmap _ g (Rec p) = Rec (g p)\n\n-- User-facing function\npmapu :: (Generic a, Generic b, PMap (Rep a), Rep a ~ Rep b)\n      => (forall n. NatV n -> El n (Es a)-> El n (Es b)) -> a -> b\npmapu f = to . pmap f (pmapu f). from\n\n\n-- Example: lists\ninstance Generic [a] where\n  type Rep [a] = SUM UNIT (PROD (PAR T0) REC)\n  type Es  [a] = a ': '[]\n  from [] = L Unit\n  from (h:t) = R (Prod (Par ZeW h) (Rec t))\n  to (L Unit) = []\n  to (R (Prod (Par ZeW h) (Rec t))) = h:t\n  \n-- Map on lists: we can define an auxiliary function with the usual type...\npmapList :: forall a b. (a -> b) -> [a] -> [b]\npmapList f l = pmapu g l where\n  g :: forall n. NatV n -> El n (Es [a]) -> El n (Es [b])\n  g ZeW x = f x\n\n-- ... or use pmapu directly\npmapExample1 :: [String]\npmapExample1 = pmapu f [1..10::Int] where\n  f :: forall n. NatV n -> El n (Es [Int]) -> El n (Es [String])\n  f ZeW = show\n\n-- Example: Either\ninstance Generic (Either a b) where\n  type Rep (Either a b) = SUM (PAR T0) (PAR T1)\n  type Es  (Either a b) = a ': b ': '[]\n  from (Left  a) = L (Par ZeW a)\n  from (Right b) = R (Par (SuW ZeW) b)\n  to (L (Par ZeW a)) = Left a\n  to (R (Par (SuW ZeW) b)) = Right b\n\npmapEither :: forall a1 a2 b1 b2.\n              (a1 -> a2) -> (b1 -> b2) -> Either a1 b1 -> Either a2 b2\npmapEither f g = pmapu h where\n  h :: forall n. NatV n -> El n (Es (Either a1 b1)) -> El n (Es (Either a2 b2))\n  h ZeW = f\n  h (SuW ZeW) = g\n\n\nmain = print pmapExample1\n", "num_lines": 161}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                  #-}\n{-# LANGUAGE GADTs                      #-}\n\nmodule PolyKinds11 where\n\n-- Test inference\n\ndata Nat = Ze | Su Nat\n\ndata Vec a n where -- Vec :: * -> Nat -> *\n  VNil  :: Vec a Ze\n  VCons :: a -> Vec a n -> Vec a (Su n)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs #-}\n\nmodule PolyKinds12 where\n\ntype family If1 (b::Bool) (t::k) (f::k) :: k\ntype instance If1 True t f = t\ntype instance If1 False t f = f\n\ndata SBool b where\n  STrue :: SBool True\n  SFalse :: SBool False\n\ntest1 :: SBool b -> If1 b Int Char\ntest1 STrue = 42\ntest1 SFalse = 'H'\n\ntest2 :: SBool b -> If1 b Int Char\ntest2 STrue = 42\ntest2 SFalse = 'H'\n\ntype family Apply (f :: k1 -> k2) (x :: k1) :: k2\ntype instance Apply f x = f x\n\nhigher1v1 :: SBool b -> (If1 b Maybe []) Char\nhigher1v1 STrue = Just 'H'\nhigher1v1 SFalse = \"Hello\"\n\nhigher1v2 :: SBool b -> Apply (If1 b Maybe []) Char\nhigher1v2 STrue = Just 'H'\nhigher1v2 SFalse = \"Hello\"\n\nhigher2 :: SBool b -> If1 b Maybe [] Int\nhigher2 STrue  = Just 42\nhigher2 SFalse = [45]\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds          #-}\n{-# LANGUAGE FlexibleInstances  #-}\n\nmodule PolyKinds13 where\n\n\ndata Proxy a = Proxy\n\ninstance Show (Proxy a) where\n  show _ = \"Proxy\"\n\ninstance Functor Proxy where\n  fmap _ Proxy = Proxy\n\n\ndata TypeRep = TypeRep\n\nclass MyTypeable t where\n-- MyTypeable :: forall k. k -> Constraint\n  myTypeOf :: Proxy t -> TypeRep\n  myTypeOf _ = TypeRep\n\ndata Apply f t = Apply (f t)\n-- Apply :: forall k.  (k -> *) -> k -> * \n\ninstance MyTypeable Apply\n-- df :: forall k. MyTypeable ((k -> *) -> k -> *) (Apply k)\ninstance MyTypeable Int\ninstance MyTypeable Maybe\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From  http://www.reddit.com/r/haskell/comments/ti5il/redblack_trees_in_haskell_using_gadts_existential/\n\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DataKinds#-}\n{-# LANGUAGE KindSignatures#-}\nmodule RedBlackTree where\n\nimport Data.Kind (Type)\n\ndata Nat = Zero | Succ Nat deriving (Eq, Ord, Show)\ntype One = Succ Zero\n\ndata RedBlack = Black | Red deriving (Eq, Ord, Show)\n\n-- red-black trees are rooted at a black node\ndata RedBlackTree a = forall n. T ( Node Black n a )\nderiving instance Show a => Show (RedBlackTree a)\n\n-- all paths from a node to a leaf have exactly n black nodes\ndata Node :: RedBlack -> Nat -> Type -> Type where\n  -- all leafs are black\n  Leaf  :: Node Black One a \n  -- internal black nodes can have children of either color\n  B     :: Node cL n a    -> a -> Node cR n a    -> Node Black (Succ n) a \n  -- internal red nodes can only have black children\n  R     :: Node Black n a -> a -> Node Black n a -> Node Red n a\nderiving instance Show a => Show (Node c n a)\n\n-- one-hole context for red-black trees\ndata Context :: Nat -> RedBlack -> Nat -> Type -> Type  where\n  -- if we're at the root, the hole is a black node\n  Root :: Context n Black n a\n  -- we can go left or right from a red node hole, creating a hole for a black node\n  BC   :: Bool -> a -> Node Black n a -> Context m Red n a          -> Context m Black n a\n  -- we can go left or right from a black node hole, creating a hole for either\n  EC   :: Bool -> a -> Node cY n a    -> Context m Black (Succ n) a -> Context m cX n a\nderiving instance Show a => Show (Context m c n a)\n\ndata Zipper m a = forall c n. Zipper (Node c n a) (Context m c n a)\nderiving instance Show a => Show (Zipper m a)\n\n-- create a zipper\nunZip :: Node Black n a -> Zipper n a\nunZip = flip Zipper Root\n\n-- destroy a zipper\nzipUp :: Zipper m a -> Node Black m a\nzipUp (Zipper x Root) = x\nzipUp (Zipper x (BC goLeft a y c)) = zipUp $ Zipper (if goLeft then R x a y else R y a x) c\nzipUp (Zipper x (EC goLeft a y c)) = zipUp $ Zipper (if goLeft then B x a y else B y a x) c\n\n-- locate the node that should contain a in the red-black tree\nzipTo :: Ord a => a -> Zipper n a -> Zipper n a\nzipTo _ z@(Zipper Leaf _) = z\nzipTo a z@(Zipper (R l a' r) c) = case compare a a' of\n  EQ -> z\n  LT -> zipTo a $ Zipper l (BC True a' r c)\n  GT -> zipTo a $ Zipper r (BC False a' l c)\nzipTo a z@(Zipper (B l a' r) c) = case compare a a' of\n  EQ -> z\n  LT -> zipTo a $ Zipper l (EC True a' r c)\n  GT -> zipTo a $ Zipper r (EC False a' l c)\n\n-- create a red-black tree\nempty :: RedBlackTree a\nempty =  T Leaf\n\n-- insert a node into a red-black tree \n-- (see http://en.wikipedia.org/wiki/Red%E2%80%93black_tree#Insertion)\ninsert :: Ord a => a -> RedBlackTree a -> RedBlackTree a\ninsert a t@(T root) = case zipTo a (unZip root) of\n    -- find matching leaf and replace with red node (pointing to two leaves)\n    Zipper Leaf c -> insertAt (R Leaf a Leaf) c\n    -- if it's already in the tree, there's no need to modify it\n    _ -> t\n\ninsertAt :: Node Red n a -> Context m c n a -> RedBlackTree a\n-- 1) new node is root => paint it black and done\ninsertAt (R l a r) Root = T $ B l a r\n-- 2) new node's parent is black => done\ninsertAt x (EC b a y c) = T . zipUp $ Zipper x (EC b a y c)\n-- 3) uncle is red => paint parent/uncle black, g'parent red.  recurse on g'parent\ninsertAt x (BC pb pa py (EC gb ga (R ul ua ur) gc)) = insertAt g gc\n  where p = if pb then B x pa py else B py pa x\n        u = B ul ua ur\n        g = if gb then R p ga u else R u ga p\n-- 4) node is between parent and g'parent => inner rotation\ninsertAt (R l a r) (BC False pa py pc@(EC True _ _ _)) = insertAt (R py pa l) (BC True a r pc)\ninsertAt (R l a r) (BC True pa py pc@(EC False _ _ _)) = insertAt (R r pa py) (BC False a l pc)\n\n-- 5) otherwise => outer rotation\ninsertAt x (BC True pa py (EC True ga gy@Leaf gc)) = \n T . zipUp $ Zipper (B x pa $ R py ga gy) gc\ninsertAt x (BC True pa py (EC True ga gy@(B _ _ _) gc)) = \n  T . zipUp $ Zipper (B x pa $ R py ga gy) gc\n-- XXX: GHC seems unable to infer that gy is Black so I have to do both cases\n--      explicitly, rather than\n-- insertAt x (BC False pa py (EC False ga gy gc)) = \n--   T . zipUp $ Zipper (B (R gy ga py) pa x) gc\n--\n-- insertAt x (BC True pa py (EC True ga gy gc)) = \n--    T . zipUp $ Zipper (B x pa $ R py ga gy) gc\n{-\n  BC   :: Bool -> a -> Node Black n a -> Context m Red n a          -> Context m Black n a\n  EC   :: Bool -> a -> Node cY n a    -> Context m Black (Succ n) a -> Context m cX n a\n\n\n  BC True pa py (EC True ga gy gc) :: Context m c n a\n  Hence c~Black\n        EC True ga gy gc :: Context m Red n a\n        gy :: Node cY n a\n-} \n\ninsertAt x (BC False pa py (EC False ga gy@Leaf gc)) = \n  T . zipUp $ Zipper (B (R gy ga py) pa x) gc\ninsertAt x (BC False pa py (EC False ga gy@(B _ _ _) gc)) = \n  T . zipUp $ Zipper (B (R gy ga py) pa x) gc\n\n-- can't derive, since we abstract over n, so we have to manually\n-- check for identical structure\ninstance Eq a => Eq (RedBlackTree a) where\n  T Leaf == T Leaf = True\n  T (B l@(B _ _ _) a r@(B _ _ _)) == T (B l'@(B _ _ _) a' r'@(B _ _ _)) = \n      a == a' && T l == T l' && T r == T r'\n  T (B (R ll la lr) a r@(B _ _ _)) == T (B (R ll' la' lr') a' r'@(B _ _ _)) = \n      a == a' && la == la' && \n      T ll == T ll' && T lr == T lr' && T r == T r'\n  T (B l@(B _ _ _) a r@(R rl ra rr)) == T (B l'@(B _ _ _) a' r'@(R rl' ra' rr')) = \n      a == a' && ra == ra' && \n      T l == T l' && T rl == T rl' && T rr == T rr'\n  T (B (R ll la lr) a r@(R rl ra rr)) == T (B (R ll' la' lr') a' r'@(R rl' ra' rr')) = \n      a == a' && la == la' && ra == ra' &&\n      T ll == T ll' && T lr == T lr' && T rl == T rl' && T rr == T rr'\n  _ == _ = False\n\n-- can't derive, since B abstracts over child node colors, so\n-- manually check for identical structure\ninstance (Eq a) => Eq (Node c n a)  where\n  Leaf == Leaf                = True\n  R l a r == R l' a' r'       = a == a' && l == l' && r == r'\n  b@(B _ _ _) == b'@(B _ _ _) = T b == T b'\n  _ == _                      = False \n", "num_lines": 145}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, DataKinds #-}\n{-# LANGUAGE TypeOperators, GADTs, InstanceSigs #-}\n\nmodule T10041 where\n\ndata family Sing (a :: k)\ndata instance Sing (xs :: [k]) where\n  SNil :: Sing '[]\n\nclass SingI (a :: \u00c4\u00b8) where", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, ConstraintKinds, TypeFamilies, NoMonoLocalBinds, NoMonomorphismRestriction #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule T10134 where\n\nimport GHC.TypeLits as L\nimport T10134a\nimport Prelude\n\ntype Positive n = ((n-1)+1)~n\n\ndata Dummy n d = Dummy { vec :: Vec n (Vec d Bool) }\n\nnextDummy :: Positive (2 L.* (n+d)) => Dummy n d -> Dummy n d\nnextDummy d = Dummy { vec = vec dFst }\n   where (dFst,dSnd) = nextDummy' d\n\nnextDummy' :: Positive (2 L.* (n+d)) => Dummy n d -> ( Dummy n d, Bool )\nnextDummy' _ = undefined\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T10134a where\n\nimport Data.Kind (Type)\nimport GHC.TypeLits\n\ndata Vec :: Nat -> Type -> Type where\n  Nil  :: Vec 0 a\n  (:>) :: a -> Vec n a -> Vec (n + 1) a\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n\nmodule T10451 where\n\ntype S a = ( Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a )\n\ntype T a = ( Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a\n           , Eq a, Eq a, Eq a, Eq a)\n\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-}\nmodule GHCBug where\n\ndata Proxy p = Proxy\n\ndata KProxy (a :: *) = KProxy\n\nh :: forall k r . (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy *) => r) -> r\nh = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\nmodule T10516 where\n\ntype App f a = f a\n\nnewtype X f a = X (f a)\n\nf :: f a -> X (App f) a\nf = X\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies, PolyKinds, FlexibleInstances #-}\n\nmodule T10570 where\n\nimport Data.Proxy\n\nclass ConsByIdx2 x a m cls | x -> m where\n    consByIdx2 :: x -> a -> m cls\n\ninstance ConsByIdx2 Int a Proxy cls where\n    consByIdx2 _ _ = Proxy\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, RankNTypes, GADTs, PolyKinds #-}\n\nmodule T10670 where\n\nimport Unsafe.Coerce\nimport Data.Kind (Type)\n\ndata TypeRepT (a::k) where\n  TRCon :: TypeRepT a\n\ndata G2 c a where\n  G2 :: TypeRepT a -> TypeRepT b -> G2 c (c a b)\n\ngetT2 :: TypeRepT (c :: k2 -> k1 -> k) -> TypeRepT (a :: k) -> Maybe (G2 c a)\n{-# NOINLINE getT2 #-}\ngetT2 c t = Nothing\n\ntyRepTArr :: TypeRepT (->)\n{-# NOINLINE tyRepTArr #-}\ntyRepTArr = TRCon\n\ns :: forall a x. TypeRepT (a :: Type) -> Maybe x\ns tf = case getT2 tyRepTArr tf :: Maybe (G2 (->) a) of\n          Just (G2 _ _) -> Nothing\n          _ -> Nothing\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs , PolyKinds #-}\n\nmodule Bug2 where\n\nimport Unsafe.Coerce\n\ndata TyConT (a::k) = TyConT String\n\neqTyConT :: TyConT a -> TyConT b -> Bool\neqTyConT (TyConT a) (TyConT b) = a == b\n\n\n\ntyConTArr :: TyConT (->)\ntyConTArr = TyConT \"(->)\"\n\n\ndata TypeRepT (a::k) where\n  TRCon :: TyConT a -> TypeRepT a\n  TRApp :: TypeRepT a -> TypeRepT b -> TypeRepT (a b)\n\n\ndata GetAppT a where\n  GA :: TypeRepT a -> TypeRepT b -> GetAppT (a b)\n\ngetAppT :: TypeRepT a -> Maybe (GetAppT a)\ngetAppT (TRApp a b) = Just $ GA a b\ngetAppT _ = Nothing\n\n\n\neqTT :: TypeRepT (a::k1) -> TypeRepT (b::k2) -> Bool\neqTT (TRCon a) (TRCon b) = eqTyConT a b\neqTT (TRApp c a) (TRApp d b) = eqTT c d && eqTT a b\neqTT _ _ = False\n\n\ndata G2 c a where\n  G2 :: TypeRepT a -> TypeRepT b -> G2 c (c a b)\n\n\ngetT2 :: TypeRepT (c :: k2 -> k1 -> k) -> TypeRepT (a :: k) -> Maybe (G2 c a)\ngetT2 c t = do GA t' b <- getAppT t\n               GA c' a <- getAppT t'\n               if eqTT c c'\n                 then Just (unsafeCoerce $ G2 a b :: G2 c a)\n                 else Nothing\n\ntyRepTArr :: TypeRepT (->)\ntyRepTArr = TRCon tyConTArr\n\ns tf = case getT2 tyRepTArr tf\n       of Just (G2 _ _) -> Nothing\n          _ -> Nothing\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule T10742 where\n\nimport GHC.TypeLits\n\ndata T a where MkT :: T Int\n\ntest :: ((x <=? y) ~ 'True, (y <=? z) ~ 'True)\n     => proxy x y z -> ()\ntest _ = case MkT of MkT -> ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n    ScopedTypeVariables\n  , DataKinds\n  , GADTs\n  , RankNTypes\n  , TypeOperators\n  , PolyKinds -- Comment out PolyKinds and the bug goes away.\n  #-}\n{-# OPTIONS_GHC -O #-}\n  -- The bug is in SimplUtils.abstractFloats, so we need -O to trigger it\n\nmodule KeyValue where\n\nimport Data.Kind\n\ndata AccValidation err a = AccFailure err | AccSuccess a\n\ndata KeyValueError = MissingValue\n\ntype WithKeyValueError = AccValidation [KeyValueError]\n\nmissing :: forall f rs. RecApplicative rs => Rec (WithKeyValueError :. f) rs\nmissing = rpure missingField\n  where\n    missingField :: forall x. (WithKeyValueError :. f) x\n    missingField = Compose $ AccFailure [MissingValue]\n\ndata Rec :: (u -> Type) -> [u] -> Type where\n  RNil :: Rec f '[]\n  (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)\n\nnewtype Compose (f :: l -> Type) (g :: k -> l) (x :: k)\n  = Compose { getCompose :: f (g x) }\n\ntype (:.) f g = Compose f g\n\nclass RecApplicative rs where\n  rpure\n    :: (forall x. f x)\n    -> Rec f rs\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, RankNTypes #-}\n\nmodule T11142 where\n\nimport Data.Kind\n\ndata SameKind :: k -> k -> *\n\nfoo :: forall b. (forall k (a :: k). SameKind a b) -> ()\nfoo = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, KindSignatures #-}\n\nmodule T11203 where\n\ndata SameKind :: k -> k -> *\n\ndata Q (a :: k1) (b :: k2) c = MkQ (SameKind a b)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O #-}\n  -- Trac #11248, comment:6 showed that this tests failed with -O\n\n{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies,\n             KindSignatures, ConstraintKinds #-}\n\nmodule T11248 where\n\nimport GHC.TypeLits\n\ntype a / b = FDiv a b\ntype a ** b = FMul a b\n\ntype family FDiv a b where\n  FDiv 11648 128 = 91\n\ntype family FMul a b where\n  FMul 64 91 = 5824\n\ntype family FGCD a b where\n  FGCD 128 448 = 64\n  FGCD 128 5824 = 64\n\ntype family FLCM a b where\n  FLCM 128 5824 = 11648\n\ndata CT (m :: Nat) (m' :: Nat)\ntype H0 = 128\ntype H1 = 448\ntype H0' = 11648\ntype H1' = 5824\n\nmain' = let x = undefined :: CT H0 H0'\n        in foo x :: CT H1 H1'\n\nfoo x = bug x\n\ntype Ctx2 e r s e' r' =\n  (e ~ FGCD r e', r' ~ FLCM r e', e ~ FGCD r s)\n\ntype Ctx1 e r s e' r' =\n  (Ctx2 e r s e' r', e' ~ (e ** (r' / r)))\n\nbug :: (Ctx1 e r s e' r')\n  => CT r r' -> CT s s'\nbug = undefined\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies,\n             KindSignatures, ConstraintKinds #-}\n\nmodule T11249 where\n\nimport GHC.TypeLits\n\ntype a / b = FDiv a b\ntype a ** b = FMul a b\n\ntype family FDiv a b where\n  FDiv 11648 128 = 91\n\ntype family FMul a b where\n  FMul 64 91 = 5824\n\ntype family FGCD a b where\n  FGCD 128 448 = 64\n  FGCD 128 5824 = 64\n\ntype family FLCM a b where\n  FLCM 128 5824 = 11648\n\ndata CT (m :: Nat) (m' :: Nat)\ntype H0 = 128\ntype H1 = 448\ntype H0' = 11648\ntype H1' = 5824\n\nmain' = let x = undefined :: CT H0 H0'\n        in foo x :: CT H1 H1'\n\nfoo x = bug x\n\ntype Ctx2 e r s e' r' =\n  (e ~ FGCD r e', r' ~ FLCM r e', e ~ FGCD r s)\n\nbug :: (Ctx2 e r s e' r', e' ~ (e ** (FDiv r' r)))\n  => CT r r' -> CT s s'\nbug = undefined\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, UndecidableInstances #-}\n\nmodule T11255 where\n\ntype family Default :: k\ntype instance Default = '(Default, Default)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n\nmodule A where\n\ntype K a = (Show a, Read a)\nclass K a => C a where\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GADTs #-}\n\nmodule T11362 where\n-- this file when compiled with -dunique-increment=-1 made GHC crash\n\nimport Data.Kind (Type)\n\ndata Sum a b = L a | R b\n\ndata Sum1 (a :: k1 -> Type) (b :: k2 -> Type) :: Sum k1 k2 -> Type where\n  LL :: a i -> Sum1 a b (L i)\n  RR :: b i -> Sum1 a b (R i)\n\ndata Code i o = F (Code (Sum i o) o)\n\n-- An interpretation for `Code` using a data family works:\ndata family In (f :: Code i o) :: (i -> Type) -> (o -> Type)\n\ndata instance In (F f) r o where\n  MkIn :: In f (Sum1 r (In (F f) r)) o -> In (F f) r o\n\n-- Requires polymorphic recursion\ndata In' (f :: Code i o) :: (i -> Type) -> o -> Type where\n  MkIn' :: In' g (Sum1 r (In' (F g) r)) t -> In' (F g) r t\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, PolyKinds #-}\nmodule T11399 where\n\nimport Data.Kind\n\nnewtype UhOh (k :: * -> *) (a :: k *) = UhOh (k *)\n\n-- UhOh :: forall (k : * -> *). k * -> *\n\ninstance Functor a => Functor (UhOh a) where\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  PolyKinds, RankNTypes #-}\n\nmodule T11459 where\n\n\ntype Failure f r   = String -> f r\ntype Success a f r = a -> f r\n\nnewtype Parser a = Parser {\n      unParser :: forall f r.\n                  Failure f r\n               -> Success a f r\n               -> f r\n    }\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, ConstraintKinds #-}\n\nmodule T11466 where\n\n-- This should be ok\ntype Bla = ?x::Int\n\n-- This should be ook\nf :: Bla => Int -> Int\nf y = ?x + y\n\ndata T = T\n\n-- But this should be rejected\ninstance Bla => Eq T\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language KindSignatures, PolyKinds, TypeFamilies,\n  NoImplicitPrelude, FlexibleContexts,\n  MultiParamTypeClasses, GADTs,\n  ConstraintKinds, FlexibleInstances, UndecidableInstances,\n  FunctionalDependencies, UndecidableSuperClasses #-}\n\nmodule T11480a where\n\nimport Data.Kind (Type, Constraint)\nimport qualified Prelude\n\ndata Nat (c :: i -> i -> Type) (d :: j -> j -> Type) (f :: i -> j) (g :: i -> j)\n\nclass Functor p (Nat p (->)) p => Category (p :: i -> i -> Type)\n\nclass (Category dom, Category cod)\n   => Functor (dom :: i -> i -> Type) (cod :: j -> j -> Type) (f :: i -> j)\n    | f -> dom cod\n\ninstance (Category c, Category d) => Category (Nat c d)\ninstance (Category c, Category d) => Functor (Nat c d) (Nat (Nat c d) (->)) (Nat c d)\ninstance (Category c, Category d) => Functor (Nat c d) (->) (Nat c d f)\n\ninstance Category (->)\ninstance Functor (->) (->) ((->) e)\ninstance Functor (->) (Nat (->) (->)) (->)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language KindSignatures #-}\n{-# language PolyKinds #-}\n{-# language DataKinds #-}\n{-# language TypeFamilies #-}\n{-# language RankNTypes #-}\n{-# language NoImplicitPrelude #-}\n{-# language FlexibleContexts #-}\n{-# language MultiParamTypeClasses #-}\n{-# language GADTs #-}\n{-# language ConstraintKinds #-}\n{-# language FlexibleInstances #-}\n{-# language TypeOperators #-}\n{-# language ScopedTypeVariables #-}\n{-# language DefaultSignatures #-}\n{-# language FunctionalDependencies #-}\n{-# language UndecidableSuperClasses #-}\n\n-- This code, supplied by Edward Kmett, uses UndecidableSuperClasses along\n-- with a bunch of other stuff, so it's a useful stress test.\n-- See Trac #11480 comment:12.\n\nmodule T11480b where\n\nimport Data.Kind (Constraint, Type)\nimport Data.Type.Equality as Equality\nimport Data.Type.Coercion as Coercion\nimport qualified Prelude\nimport Prelude (Either(..))\n\nnewtype Y (p :: i -> j -> Type) (a :: j) (b :: i) = Y { getY :: p b a }\n\ntype family Op (p :: i -> j -> Type) :: j -> i -> Type where\n  Op (Y p) = p\n  Op p = Y p\n\nclass Vacuous (p :: i -> i -> Type) (a :: i)\ninstance Vacuous p a\n\ndata Dict (p :: Constraint) where\n  Dict :: p => Dict p\n\nclass Functor (Op p) (Nat p (->)) p => Category (p :: i -> i -> Type) where\n  type Ob p :: i -> Constraint\n  type Ob p = Vacuous p\n\n  id :: Ob p a => p a a\n  (.) :: p b c -> p a b -> p a c\n\n  source :: p a b -> Dict (Ob p a)\n  default source :: (Ob p ~ Vacuous p) => p a b -> Dict (Ob p a)\n  source _ = Dict\n\n  target :: p a b -> Dict (Ob p b)\n  default target :: (Ob p ~ Vacuous p) => p a b -> Dict (Ob p b)\n  target _ = Dict\n\n  op :: p b a -> Op p a b\n  default op :: Op p ~ Y p => p b a -> Op p a b\n  op = Y\n\n  unop :: Op p b a -> p a b\n  default unop :: Op p ~ Y p => Op p b a -> p a b\n  unop = getY\n\nclass (Category p, Category q) =>\n      Functor (p :: i -> i -> Type)\n              (q :: j -> j -> Type)\n              (f :: i -> j) | f -> p q where\n  fmap :: p a b -> q (f a) (f b)\n\ndata Nat (p :: i -> i -> Type)\n         (q :: j -> j -> Type) (f :: i -> j) (g :: i -> j) where\n  Nat :: (Functor p q f, Functor p q g) =>\n         { runNat :: forall a. Ob p a => q (f a) (g a) } -> Nat p q f g\n\ninstance (Category p, Category q) => Category (Nat p q) where\n  type Ob (Nat p q) = Functor p q\n  id = Nat id1 where\n    id1 :: forall f x. (Functor p q f, Ob p x) => q (f x) (f x)\n    id1 = id \\\\ (ob :: Ob p x :- Ob q (f x))\n  Nat f . Nat g = Nat (f . g)\n  source Nat{} = Dict\n  target Nat{} = Dict\n\nob :: forall p q f a. Functor p q f => Ob p a :- Ob q (f a)\nob = Sub (case source (fmap (id :: p a a) :: q (f a) (f a)) of Dict -> Dict)\n\ninstance (Category p, Category q) =>\n         Functor (Y (Nat p q)) (Nat (Nat p q) (->)) (Nat p q) where\n  fmap (Y f) = Nat (. f)\n\ninstance (Category p, Category q) => Functor (Nat p q) (->) (Nat p q f) where\n  fmap = (.)\n\ncontramap :: Functor p q f => Op p b a -> q (f a) (f b)\ncontramap = fmap . unop\n\ninstance Category (->) where\n  id = Prelude.id\n  (.) = (Prelude..)\n\ninstance Functor (->) (->) ((->) e) where\n  fmap = (.)\n\ninstance Functor (Y (->)) (Nat (->) (->)) (->) where\n  fmap (Y f) = Nat (. f)\n\ninstance (Category p, Op p ~ Y p) => Category (Y p) where\n  type Ob (Y p) = Ob p\n  id = Y id\n  Y f . Y g = Y (g . f)\n  source (Y f) = target f\n  target (Y f) = source f\n  unop = Y\n  op = getY\n\ninstance (Category p, Op p ~ Y p) => Functor (Y p) (->) (Y p a) where\n  fmap = (.)\n\ninstance (Category p, Op p ~ Y p) => Functor p (Nat (Y p) (->)) (Y p) where\n  fmap f = Nat (. Y f)\n\n--------------------------------------------------------------------------------\n-- * Constraints\n--------------------------------------------------------------------------------\n\ninfixl 1 \\\\ -- comment required for cpp\n(\\\\) :: a => (b => r) -> (a :- b) -> r\nr \\\\ Sub Dict = r\n\nnewtype p :- q = Sub (p => Dict q)\n\ninstance Functor (:-) (->) Dict where\n  fmap p Dict = case p of\n    Sub q -> q\n\ninstance Category (:-) where\n  id = Sub Dict\n  f . g = Sub (Dict \\\\ f \\\\ g)\n\ninstance Functor (:-) (->) ((:-) e) where\n  fmap = (.)\n\ninstance Functor (Y (:-)) (Nat (:-) (->)) (:-) where\n  fmap (Y f) = Nat (. f)\n\n--------------------------------------------------------------------------------\n-- * Common Functors\n--------------------------------------------------------------------------------\n\ninstance Functor (->) (->) ((,) e) where\n  fmap f ~(a,b) = (a, f b)\n\ninstance Functor (->) (->) (Either e) where\n  fmap _ (Left a) = Left a\n  fmap f (Right b) = Right (f b)\n\ninstance Functor (->) (->) [] where\n  fmap = Prelude.fmap\n\ninstance Functor (->) (->) Prelude.Maybe where\n  fmap = Prelude.fmap\n\ninstance Functor (->) (->) Prelude.IO where\n  fmap = Prelude.fmap\n\ninstance Functor (->) (Nat (->) (->)) (,) where\n  fmap f = Nat (\\(a,b) -> (f a, b))\n\ninstance Functor (->) (Nat (->) (->)) Either where\n  fmap f0 = Nat (go f0) where\n    go :: (a -> b) -> Either a c -> Either b c\n    go f (Left a)  = Left (f a)\n    go _ (Right b) = Right b\n\n--------------------------------------------------------------------------------\n-- * Type Equality\n--------------------------------------------------------------------------------\n\ninstance Category (:~:) where\n  id = Refl\n  (.) = Prelude.flip Equality.trans\n\ninstance Functor (Y (:~:)) (Nat (:~:) (->)) (:~:) where\n  fmap (Y f) = Nat (. f)\n\ninstance Functor (:~:) (->) ((:~:) e) where\n  fmap = (.)\n\n--------------------------------------------------------------------------------\n-- * Type Coercions\n--------------------------------------------------------------------------------\n\ninstance Category Coercion where\n  id = Coercion\n  (.) = Prelude.flip Coercion.trans\n\ninstance Functor (Y Coercion) (Nat Coercion (->)) Coercion where\n  fmap (Y f) = Nat (. f)\n\ninstance Functor Coercion (->) (Coercion e) where\n  fmap = (.)\n", "num_lines": 203}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language PolyKinds #-}\n{-# language FlexibleContexts #-}\n{-# language ConstraintKinds #-}\n{-# language FlexibleInstances #-}\n{-# language FunctionalDependencies #-}\n{-# language UndecidableInstances #-}\n\nimport GHC.Exts (Constraint)\n\nclass R\u00c3\u00adki (p :: i -> i -> *)\nclass (R\u00c3\u00adki p) => Varpi p q f | f -> p q\ninstance Varpi () () f => Varpi (->) (->) (Either f) where\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, PolyKinds, GADTs, UndecidableSuperClasses, UndecidableInstances #-}\n\nmodule T11520 where\n\nimport GHC.Types hiding (TyCon)\n\ndata TypeRep (a :: k)\n\nclass Typeable k => Typeable (a :: k) where\n    typeRep :: TypeRep a\n\ndata Compose (f :: k1 -> *) (g :: k2 -> k1) (a :: k2) = Compose (f (g a))\n\n-- Note how the kind signature on g is incorrect\ninstance (Typeable f, Typeable (g :: k), Typeable k) => Typeable (Compose f g) where\n    typeRep = undefined\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language KindSignatures #-}\n{-# language PolyKinds #-}\n{-# language DataKinds #-}\n{-# language TypeFamilies #-}\n{-# language RankNTypes #-}\n{-# language NoImplicitPrelude #-}\n{-# language FlexibleContexts #-}\n{-# language MultiParamTypeClasses #-}\n{-# language GADTs #-}\n{-# language ConstraintKinds #-}\n{-# language FlexibleInstances #-}\n{-# language TypeOperators #-}\n{-# language ScopedTypeVariables #-}\n{-# language DefaultSignatures #-}\n{-# language FunctionalDependencies #-}\n{-# language UndecidableSuperClasses #-}\n{-# language UndecidableInstances #-}\n\nmodule T11523 where\n\nimport GHC.Types (Constraint, Type)\nimport qualified Prelude\n\ntype Cat i = i -> i -> Type\n\nnewtype Y (p :: i -> j -> Type) (a :: j) (b :: i) = Y { getY :: p b a }\n\nclass Vacuous (a :: i)\ninstance Vacuous a\n\nclass (Functor p, Dom p ~ Op p, Cod p ~ Nat p (->)) => Category (p :: Cat i) where\n  type Op p :: Cat i\n  type Op p = Y p\n  type Ob p :: i -> Constraint\n  type Ob p = Vacuous\n\nclass (Category (Dom f), Category (Cod f)) => Functor (f :: i -> j) where\n  type Dom f :: Cat i\n  type Cod f :: Cat j\n\nclass    (Functor f, Dom f ~ p, Cod f ~ q) => Fun (p :: Cat i) (q :: Cat j) (f :: i -> j) | f -> p q\ninstance (Functor f, Dom f ~ p, Cod f ~ q) => Fun (p :: Cat i) (q :: Cat j) (f :: i -> j)\n\ndata Nat (p :: Cat i) (q :: Cat j) (f :: i -> j) (g :: i -> j)\n\ninstance (Category p, Category q) => Category (Nat p q) where\n  type Ob (Nat p q) = Fun p q\n\ninstance (Category p, Category q) => Functor (Nat p q) where\n  type Dom (Nat p q) = Y (Nat p q)\n  type Cod (Nat p q) = Nat (Nat p q) (->)\n\ninstance (Category p, Category q) => Functor (Nat p q f) where\n  type Dom (Nat p q f) = Nat p q\n  type Cod (Nat p q f) = (->)\n\ninstance Category (->)\n\ninstance Functor ((->) e) where\n  type Dom ((->) e) = (->)\n  type Cod ((->) e) = (->)\n\ninstance Functor (->) where\n  type Dom (->) = Y (->)\n  type Cod (->) = Nat (->) (->)\n\ninstance (Category p, Op p ~ Y p) => Category (Y p) where\n  type Op (Y p) = p\n\ninstance (Category p, Op p ~ Y p) => Functor (Y p a) where\n  type Dom (Y p a) = Y p\n  type Cod (Y p a) = (->)\n\ninstance (Category p, Op p ~ Y p) => Functor (Y p) where\n  type Dom (Y p) = p\n  type Cod (Y p) = Nat (Y p) (->)\n\n\n{-\nGiven:  Category p, Op p ~ Y p\n\n   -->  Category p, Op p ~ Y p\n        Functor p, Dom p ~ Op p, Cod p ~ Nat p (->)\n\n   -->  Category p, Op p ~ Y p\n        Functor p, Dom p ~ Op p, Cod p ~ Nat p (->)\n        Category (Dom p), Category (Cod p)\n-}\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-}\n\nmodule T11554 where\n\nimport Data.Kind\n\ndata P (x :: k) = Q\n\ndata A :: Type where\n  B :: forall (a :: A). P a -> A\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, StandaloneDeriving, TypeOperators, GADTs, FlexibleInstances #-}\n\nmodule T11611 where\n\ndata A a where\n  A :: A (a:as) -> a -> A as\n\nderiving instance Show a => Show (A a)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T11616 where\n\nclass Whoami a where\n  whoami :: String\n\ninstance Whoami Int where\n  whoami = \"int\"\n\ninstance Whoami Bool where\n  whoami = \"[y/n]\"\n\ninstance Whoami Maybe where\n  whoami = \"call me maybe\"\n\nwhoisint :: String\nwhoisint = whoami @Int\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes, PolyKinds #-}\n\nmodule T11640 where\n\nimport Data.Kind\n\ndata HEq :: forall k1. k1 -> forall k2. k2 -> Type where\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeOperators, TypeFamilies,\n             MultiParamTypeClasses #-}\n\nmodule T11648 where\n\nimport Data.Kind\n\nclass Monoidy (to :: k0 -> k1 -> Type) (m :: k1)  where\n  type MComp to m :: k1 -> k1 -> k0\n  mjoin :: MComp to m m m `to` m\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule T11648b where\n\nimport Data.Proxy\n\ndata X (a :: Proxy k)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, DataKinds, PolyKinds, GADTs, TypeFamilies, UndecidableInstances #-}\nmodule NotInScope where\n\nimport Data.Proxy\nimport Data.Kind (Type)\n\ntype KindOf (a :: k) = ('KProxy :: KProxy k)\ndata TyFun :: Type -> Type -> Type\ntype family Apply (f :: TyFun k1 k2 -> Type) (x :: k1) :: k2\n\ndata Lgo2 l1\n          l2\n          l3\n          (l4 :: b)\n          (l5 :: TyFun [a] b)\n  = forall (arg :: [a]) . KindOf (Apply (Lgo2 l1 l2 l3 l4) arg) ~ KindOf (Lgo l1 l2 l3 l4 arg) =>\n    Lgo2KindInference\n\ndata Lgo1 l1\n          l2\n          l3\n          (l4 :: TyFun b (TyFun [a] b -> Type))\n  = forall (arg :: b) . KindOf (Apply (Lgo1 l1 l2 l3) arg) ~ KindOf (Lgo2 l1 l2 l3 arg) =>\n    Lgo1KindInference\n\ntype family Lgo f\n                z0\n                xs0\n                (a1 :: b)\n                (a2 :: [a]) :: b where\n  Lgo f z0 xs0 z '[]         = z\n  Lgo f z0 xs0 z ('(:) x xs) = Apply (Apply (Lgo1 f z0 xs0) (Apply (Apply f z) x)) xs\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DataKinds, PolyKinds, ConstraintKinds #-}\nmodule T11821a where\nimport Data.Proxy\ntype SameKind (a :: k1) (b :: k2) = ('Proxy :: Proxy k1) ~ ('Proxy :: Proxy k2)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n\n-- The code from the ticket lacked these extensions,\n-- but crashed the compiler with \"GHC internal error\"\n-- It doesn't crash now; and in this test case I've added\n-- the extensions, which makes it compile cleanly\n{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances, FunctionalDependencies #-}\n\n\nmodule T12055 where\n\nimport GHC.Base ( Constraint, Type )\nimport GHC.Exts ( type (~~) )\n\ntype Cat k = k -> k -> Type\n\nclass Category (p :: Cat k) where\n    type Ob p :: k -> Constraint\n\nclass (Category (Dom f), Category (Cod f)) => Functor (f :: j -> k) where\n    type Dom f :: Cat j\n    type Cod f :: Cat k\n    functor :: forall a b.\n               Iso Constraint (:-) (:-)\n               (Ob (Dom f) a)     (Ob (Dom f) b)\n               (Ob (Cod f) (f a)) (Ob (Cod f) (f b))\n\nclass (Functor f , Dom f ~ p, Cod f ~ q) =>\n    Fun (p :: Cat j) (q :: Cat k) (f :: j -> k) | f -> p q\ninstance (Functor f , Dom f ~ p, Cod f ~ q) =>\n    Fun (p :: Cat j) (q :: Cat k) (f :: j -> k)\n\ndata Nat (p :: Cat j) (q :: Cat k) (f :: j -> k) (g :: j -> k)\n\ntype Iso k (c :: Cat k) (d :: Cat k) s t a b =\n    forall p. (Cod p ~~ Nat d (->)) => p a b -> p s t\n\ndata (p :: Constraint) :- (q :: Constraint)\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n\n{-# LANGUAGE FlexibleInstances, UndecidableInstances, FunctionalDependencies #-}\n\n-- The code from the ticket lacked necessary extension FlexibleContexts\n-- which crashed the compiler with \"GHC internal error\"\n-- This test case reproduces that scenario\n{- # LANGUAGE FlexibleContexts #-}\n\nmodule T12055a where\n\nimport GHC.Base ( Constraint, Type )\nimport GHC.Exts ( type (~~) )\n\ntype Cat k = k -> k -> Type\n\nclass Category (p :: Cat k) where\n    type Ob p :: k -> Constraint\n\nclass (Category (Dom f), Category (Cod f)) => Functor (f :: j -> k) where\n    type Dom f :: Cat j\n    type Cod f :: Cat k\n    functor :: forall a b.\n               Iso Constraint (:-) (:-)\n               (Ob (Dom f) a)     (Ob (Dom f) b)\n               (Ob (Cod f) (f a)) (Ob (Cod f) (f b))\n\nclass (Functor f , Dom f ~ p, Cod f ~ q) =>\n    Fun (p :: Cat j) (q :: Cat k) (f :: j -> k) | f -> p q\ninstance (Functor f , Dom f ~ p, Cod f ~ q) =>\n    Fun (p :: Cat j) (q :: Cat k) (f :: j -> k)\n\ndata Nat (p :: Cat j) (q :: Cat k) (f :: j -> k) (g :: j -> k)\n\ntype Iso k (c :: Cat k) (d :: Cat k) s t a b =\n    forall p. (Cod p ~~ Nat d (->)) => p a b -> p s t\n\ndata (p :: Constraint) :- (q :: Constraint)\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T12444 where\n\ndata Nat = Zero | Succ Nat\n\ndata SNat (n :: Nat) where\n  SZero :: SNat Zero\n  SSucc :: SNat n -> SNat (Succ n)\n\ntype family (:+:) (a :: Nat) (b :: Nat) :: Nat where\n  m :+: Zero = m\n  m :+: (Succ n) = Succ (m :+: n)\n\nfoo :: SNat (Succ c) -> SNat b -> SNat (Succ (c :+: b))\nfoo _ x = x\n\n\n{-\nsadd :: ((Succ n1 :+: n) ~ Succ (n1 :+: n), (Succ n1) ~ m)\n     => SNat m -> SNat n -> SNat (m :+: n)\nsadd SZero n = n\n-}\n\n{- [G]  a ~ Succ c\n        Succ c + b ~ Succ (c+b)\n        a ~ Zero\n\n-->\n        Zero ~ Succ c            TyEq\n        fsk1 ~ Succ fsk2         TyEq\n        fsk1 ~ (Succ c) + b      FunEq\n        fsk2 ~ c+b               FunEq\n----\n[W] b ~ a+b  --->   b ~ Succ (c+b)\n\n\nDerived\n       a ~ Succ c\n       fsk1 ~ Succ fsk2\n       b ~ Succ fsk2\n\nwork   (Succ c) + b ~ fsk1\n       c+b ~ fsk2\n\n\n-}\n\n{-\n\n[G] a ~ [b]\n--> Derived shadow [D] a ~ [b]\n    When adding this to the model\n    don't kick out a derived shadow again!\n\n[G] (a ~ b)  --> sc   a ~~ b, a ~# b\n  Silly to then kick out (a~b) and (a~~b)\n  and rewrite them to (a~a) and (a~~a)\n\nInsoluble constraint does not halt solving;\nindeed derived version stays. somehow\n-}\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ConstraintKinds, PolyKinds, KindSignatures, RankNTypes #-}\n\nmodule T12593 where\n\nimport Data.Kind\n\nnewtype Free k p a b where\n   Free :: (forall q. k q => (forall c d. p c d -> q c d) -> q a b)\n        -> Free k p a b\n\nrun :: k2 q => Free k k1 k2 p a b\n             -> (forall (c :: k) (d :: k1). p c d -> q c d)\n             -> q a b\nrun (Free cat) = cat\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n\nmodule T12668 where\n\nimport GHC.Exts\n\ndata Some r = Some (TYPE r -> TYPE r)\n\ndoSomething :: forall (r :: RuntimeRep). forall (a :: TYPE r). ()\n            => Int -> (a -> Int) -> a -> a\ndoSomething n f =\n    case n of\n      1 -> error \"hello\"\n      3 -> error \"hello\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RebindableSyntax, NoImplicitPrelude, MagicHash, RankNTypes,\n             PolyKinds, ViewPatterns, FlexibleInstances #-}\n\nmodule Main where\n\nimport Prelude hiding (Eq (..), Num(..))\nimport qualified Prelude as P\nimport GHC.Prim\nimport GHC.Types\n\nclass XNum (a :: TYPE rep) where\n  (+) :: a -> a -> a\n  fromInteger :: Integer -> a\n\ninstance P.Num a => XNum a where\n  (+) = (P.+)\n  fromInteger = P.fromInteger\n\ninstance XNum Int# where\n  (+) = (+#)\n  fromInteger i = case fromInteger i of\n                   I# n -> n\n\nu :: Bool\nu = isTrue# v_\n  where\n    v_ :: forall rep (a :: TYPE rep). XNum a => a\n    v_ = fromInteger 10\n\nmain = print u\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds  #-}\n\nmodule Foo where\n\nimport GHC.Exts\n\nf :: F [a] => a -> Bool\nf x = x == x\n\ntype family F a :: Constraint\ntype instance F [a] = (Show a, (Show a, (Show a, (Show a, (Show a,\n                       Show a, (Show a, (Show a, (Show a, (Show a, Eq a)))))))))\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}\nmodule T13267 where\n\ntype C1 a = (Show (a -> Bool))\n\ninstance C1 Int where\n\ntype C2 a = (Show Bool, Show Int)\n\ninstance C2 Int where\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n  MonoLocalBinds,\n  PolyKinds,\n\n  FunctionalDependencies,\n  FlexibleContexts #-}\n\n-- reduced version of\n-- http://code.haskell.org/~aavogt/HList_dredge_ghc802/Data/HList/Dredge.hs\n--\n-- F ~ EnsureLabel\n-- g_f  ~ dredge\n-- g_f' ~ dredge'\n\n{- ghc-8.0.2\n\ntoo_eager.hs:25:14: warning: [-Wdeferred-type-errors]\n    \u00e2\u20ac\u00a2 No instance for (F t0 (Proxy b0)) arising from a use of \u00e2\u20ac\u02dcg_f\u00e2\u20ac\u2122\n    \u00e2\u20ac\u00a2 In the first argument of \u00e2\u20ac\u02dcid\u00e2\u20ac\u2122, namely \u00e2\u20ac\u02dc(g_f a)\u00e2\u20ac\u2122\n      In the expression: id (g_f a)\n      In an equation for \u00e2\u20ac\u02dcg_f'\u00e2\u20ac\u2122: g_f' a = id (g_f a)\n\n\nghc-7.10.3 can wait to select the instance for F\n\n-}\n\nmodule T13371 where\n\nimport Data.Proxy\n\nclass F a b | a -> b where\n  f :: a -> b\n\ng ::  Proxy b -> c\ng _ = undefined\n\n-- a type signature (what ghc infers) makes it work\n-- g_f :: F a (Proxy b) => a -> c\ng_f a = g (f a)\n\ng_f' a = id (g_f a)\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule T13391a where\n\n-- this caused a panic during the work on T13391.\n\ndata A a where\n  A3 :: b ~ Int => b -> A Int\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T13393 ( ) where\n\nimport Control.Monad.Trans.RWS.Strict (RWST)\nimport Data.Functor.Identity (Identity)\nimport Data.Kind (Type)\nimport Data.Word (Word16)\n\ndata Rate\ndata Audio (sampleRate :: Rate) (channelLayout :: Type) (encoding :: Type)\ndata EncodeResult = MkEncodeResult\n  { encodeResultLeftOverInput :: !(Maybe [Word16])\n  }\ndata EncodeFailure\ndata AacEncErrorCode\ndata Aac (aot :: AacCodec)\ndata AacCodec\nnewtype AacEncSt (rate :: Rate) channels (codec :: AacCodec) = MkAacEncSt\n  { _leftOvers :: Maybe [Word16]\n  }\n\n-- makeLenses ''AacEncSt\n\ntype Iso s t a b = forall p f. (Functor f) => (a -> f b) -> s -> (f t)\ninstance (Monad m, Monoid w) => MonadState s (RWST r w s m) where\n\niso :: (s -> a) -> (b -> t) -> Iso s t a b\niso sa bt x = fmap bt . x . sa\n{-# INLINE iso #-}\n\nleftOvers ::\n  forall rate_a750\n         channels_a753\n         codec_a757\n         rate_aaYK\n         channels_aaYL\n         codec_aaYM.\n  Iso (AacEncSt rate_a750 channels_a753 codec_a757) (AacEncSt rate_aaYK channels_aaYL codec_aaYM) (Maybe [Word16]) (Maybe [Word16])\nleftOvers = (iso (\\ (MkAacEncSt x_aaYN) -> x_aaYN)) MkAacEncSt\n{-# INLINE leftOvers #-}\n\ntype ASetter s t a b = (a -> Identity b) -> s -> Identity t\nclass Monad m => MonadState s m | m -> s where\n\n(.=) :: MonadState s m => ASetter s s a b -> b -> m ()\nl .= b = undefined\n{-# INLINE (.=) #-}\n\ntype AacEncT rate channels codec m a = RWST Int () (AacEncSt rate channels codec) m a\n\nencodeLinearToAac\n  :: AacEncT rate channels codec IO (Either EncodeFailure (Maybe (Audio rate channels (Aac codec))))\nencodeLinearToAac = do\n  mapM putBackLeftOverInputAndReturnOutput undefined\n  undefined\n  where\n    putBackLeftOverInputAndReturnOutput (MkEncodeResult x) = do\n      leftOvers .= x\n      undefined\n", "num_lines": 67}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule T13394 where\n\nimport Data.ByteString\n\nnewtype ProperName =\n  ProperName { runProperName :: ByteString\n               -- purescript actually uses the Text type, but this works\n               -- just as well for the purposes of illustrating the bug\n             }\nnewtype ModuleName = ModuleName [ProperName]\n\npattern TypeDataSymbol :: ModuleName\npattern TypeDataSymbol = ModuleName [ProperName \"Type\"]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule T13394 where\n\nimport Data.ByteString\n\nnewtype ProperName =\n  ProperName { runProperName :: ByteString\n               -- purescript actually uses the Text type, but this works\n               -- just as well for the purposes of illustrating the bug\n             }\nnewtype ModuleName = ModuleName [ProperName]\n\npattern TypeDataSymbol :: ModuleName\npattern TypeDataSymbol = ModuleName [ProperName \"Type\", ProperName \"Data\"]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE InstanceSigs #-}\n{-# LANGUAGE MonoLocalBinds #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T13555 where\n\nimport Data.Functor.Identity (Identity(..))\n\ndata T a\ntype Polynomial a = T a\nnewtype GF fp d = GF (Polynomial fp)\ntype CRTInfo r = (Int -> r, r)\ntype Tagged s b = TaggedT s Identity b\nnewtype TaggedT s m b = TagT { untagT :: m b }\n\nclass Reflects a i where\n  value :: Tagged a i\n\nclass CRTrans mon r where\n  crtInfo :: Reflects m Int => TaggedT m mon (CRTInfo r)\n\ninstance CRTrans Maybe (GF fp d) where\n  crtInfo :: forall m . (Reflects m Int) => TaggedT m Maybe (CRTInfo (GF fp d))\n  crtInfo = undefined\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule T13625 where\n\ndata X :: Y where Y :: X\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, EmptyDataDecls, TypeFamilies, TypeOperators, DataKinds, FlexibleInstances #-}\n\n{- Defines a C-like printf function using DataKinds extensions. -}\n\nmodule T13659 where\n\nimport Data.Kind (Type)\n\n-- format string parameterized by a list of types\ndata Format (fmt :: [Type]) where\n  X :: Format '[]                   -- empty string, i.e. \"\"\n  L :: a -> String -> Format '[]    -- string literal, e.g. \"hello\"\n  S :: a -> Format '[String]        -- \"%s\"\n  I :: Format a -> Format '[Int, a] -- \"%d\"\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n\n\nmodule T13738 where\n\nimport Data.Coerce\nimport Data.Proxy\n\nfoo x = coerce @(forall (a :: k). Proxy a -> Int)\n               @(forall (a :: k). Proxy a -> Int)\n        x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T13985 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata family Fam\ndata instance Fam = MkFam (forall (a :: k). Proxy a)\n\ntype family T\ntype instance T = Proxy (Nothing :: Maybe a)\n\nclass C k where\n  data CD :: k\n  type CT :: k\n\ninstance C Type where\n  data CD = forall (a :: k). CD (Proxy a)\n  type CT = Proxy (Nothing :: Maybe a)\n\nclass Z a where\n  type ZT a\n  type ZT a = Proxy (Nothing :: Maybe x)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TypeFamilies, ScopedTypeVariables, PolyKinds, DataKinds #-}\n\nimport Data.Kind\n\nclass R (c :: k -> Constraint) where\n  type R_ (c :: k -> Constraint) :: k -> Type\n\ninstance R Eq where\n  type R_ Eq a = a -> a -> Bool\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14172 where\n\nimport Data.Functor.Compose\nimport T14172a\n\ntraverseCompose :: (a -> f b) -> g a -> f (h _)\ntraverseCompose = _Wrapping Compose . traverse\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T14172a where\n\nimport Data.Kind\nimport Data.Coerce\nimport Data.Functor.Compose\nimport Data.Functor.Identity\n\nclass Profunctor p where\n  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d\n  (#.) :: Coercible c b => (b -> c) -> p a b -> p a c\n\ninstance Profunctor (->) where\n  dimap ab cd bc = cd . bc . ab\n  {-# INLINE dimap #-}\n  (#.) _ = coerce (\\x -> x :: b) :: forall a b. Coercible b a => a -> b\n  {-# INLINE (#.) #-}\n\ntype Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)\ntype Iso' s a = Iso s s a a\n\niso :: (s -> a) -> (b -> t) -> Iso s t a b\niso sa bt = dimap sa (fmap bt)\n{-# INLINE iso #-}\n\ntype AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t)\n\ndata Exchange a b s t = Exchange (s -> a) (b -> t)\n\ninstance Profunctor (Exchange a b) where\n  dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt)\n  {-# INLINE dimap #-}\n  (#.) _ = coerce\n  {-# INLINE ( #. ) #-}\n\nwithIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r\nwithIso ai k = case ai (Exchange id Identity) of\n  Exchange sa bt -> k sa (runIdentity #. bt)\n{-# INLINE withIso #-}\n\nclass Wrapped s where\n  type Unwrapped s :: Type\n  _Wrapped' :: Iso' s (Unwrapped s)\n\nclass Wrapped s => Rewrapped (s :: Type) (t :: Type)\n\nclass    (Rewrapped s t, Rewrapped t s) => Rewrapping s t\ninstance (Rewrapped s t, Rewrapped t s) => Rewrapping s t\n\ninstance (t ~ Compose f' g' a') => Rewrapped (Compose f g a) t\ninstance Wrapped (Compose f g a) where\n  type Unwrapped (Compose f g a) = f (g a)\n  _Wrapped' = iso getCompose Compose\n\n_Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t)\n_Wrapping _ = _Wrapped\n{-# INLINE _Wrapping #-}\n\n_Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)\n_Wrapped = withIso _Wrapped' $ \\ sa _ -> withIso _Wrapped' $ \\ _ bt -> iso sa bt\n{-# INLINE _Wrapped #-}\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, KindSignatures, PolyKinds #-}\nmodule T14174 where\n\ndata T k (x :: k) = MkT\n\ndata S x = MkS (T (x Int) x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T14174a where\n\nimport Data.Kind\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\ntype a @@ b = Apply a b\ninfixl 9 @@\n\ndata FunArrow = (:->) | (:~>)\n\nclass FunType (arr :: FunArrow) where\n  type Fun (k1 :: Type) arr (k2 :: Type) :: Type\n\nclass FunType arr => AppType (arr :: FunArrow) where\n  type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2\n\ntype FunApp arr = (FunType arr, AppType arr)\n\ninstance FunType (:->) where\n  type Fun k1 (:->) k2 = k1 -> k2\n\ninstance AppType (:->) where\n  type App k1 (:->) k2 (f :: k1 -> k2) x = f x\n\ninstance FunType (:~>) where\n  type Fun k1 (:~>) k2 = k1 ~> k2\n\ninstance AppType (:~>) where\n  type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x\n\ninfixr 0 -?>\ntype (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2\n\ntype family ElimBool (p :: Bool -> Type)\n                     (z :: Bool)\n                     (pFalse :: p False)\n                     (pTrue  :: p True)\n            :: p z where\n  -- Commenting out the line below makes the panic go away\n  ElimBool p z pFalse pTrue = ElimBoolPoly (:->) p z pFalse pTrue\n\ntype family ElimBoolPoly (arr :: FunArrow)\n                         (p :: (Bool -?> Type) arr)\n                         (z :: Bool)\n                         (pFalse :: App Bool arr Type p False)\n                         (pTrue  :: App Bool arr Type p True)\n            :: App Bool arr Type p z\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T14209 where\n\ndata MyProxy k (a :: k) = MyProxy\ndata Foo (z :: MyProxy k (a :: k))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T124265 where\n\nimport Control.Monad.Trans.State( StateT )\n\nf :: proxy _ -> ()\nf _ = ()\n\nfoo :: StateT _ _ ()\nfoo = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T14270 (pattern App) where\n\nimport Data.Kind (Type)\nimport GHC.Fingerprint (Fingerprint, fingerprintFingerprints)\nimport GHC.Types (RuntimeRep, TYPE, TyCon)\n\ndata (a :: k1) :~~: (b :: k2) where\n  HRefl :: a :~~: a\n\ndata TypeRep (a :: k) where\n    TrTyCon :: {-# UNPACK #-} !Fingerprint -> !TyCon -> [SomeTypeRep]\n            -> TypeRep (a :: k)\n\n    TrApp   :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n               {-# UNPACK #-} !Fingerprint\n            -> TypeRep (a :: k1 -> k2)\n            -> TypeRep (b :: k1)\n            -> TypeRep (a b)\n\n    TrFun   :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                      (a :: TYPE r1) (b :: TYPE r2).\n               {-# UNPACK #-} !Fingerprint\n            -> TypeRep a\n            -> TypeRep b\n            -> TypeRep (a -> b)\n\ndata SomeTypeRep where\n    SomeTypeRep :: forall k (a :: k). !(TypeRep a) -> SomeTypeRep\n\ntypeRepFingerprint :: TypeRep a -> Fingerprint\ntypeRepFingerprint = undefined\n\nmkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n           TypeRep (a :: k1 -> k2)\n        -> TypeRep (b :: k1)\n        -> TypeRep (a b)\nmkTrApp rep@(TrApp _ (TrTyCon _ con _) (x :: TypeRep x)) (y :: TypeRep y)\n  | con == funTyCon  -- cheap check first\n  , Just (IsTYPE (rx :: TypeRep rx)) <- isTYPE (typeRepKind x)\n  , Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y)\n  , Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry\n                  $ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep\n  = undefined\nmkTrApp a b = TrApp fpr a b\n  where\n    fpr_a = typeRepFingerprint a\n    fpr_b = typeRepFingerprint b\n    fpr   = fingerprintFingerprints [fpr_a, fpr_b]\n\npattern App :: forall k2 (t :: k2). ()\n            => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b)\n            => TypeRep a -> TypeRep b -> TypeRep t\npattern App f x <- (splitApp -> Just (IsApp f x))\n  where App f x = mkTrApp f x\n\ndata IsApp (a :: k) where\n    IsApp :: forall k k' (f :: k' -> k) (x :: k'). ()\n          => TypeRep f -> TypeRep x -> IsApp (f x)\n\nsplitApp :: forall k (a :: k). ()\n         => TypeRep a\n         -> Maybe (IsApp a)\nsplitApp (TrApp _ f x)     = Just (IsApp f x)\nsplitApp rep@(TrFun _ a b) = Just (IsApp (mkTrApp arr a) b)\n  where arr = bareArrow rep\nsplitApp (TrTyCon{})       = Nothing\n\nwithTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r\nwithTypeable = undefined\n\neqTypeRep :: forall k1 k2 (a :: k1) (b :: k2).\n             TypeRep a -> TypeRep b -> Maybe (a :~~: b)\neqTypeRep = undefined\n\ntypeRepKind :: TypeRep (a :: k) -> TypeRep k\ntypeRepKind = undefined\n\nbareArrow :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)\n                    (a :: TYPE r1) (b :: TYPE r2). ()\n          => TypeRep (a -> b)\n          -> TypeRep ((->) :: TYPE r1 -> TYPE r2 -> Type)\nbareArrow = undefined\n\ndata IsTYPE (a :: Type) where\n    IsTYPE :: forall (r :: RuntimeRep). TypeRep r -> IsTYPE (TYPE r)\n\nisTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a)\nisTYPE = undefined\n\nclass Typeable (a :: k) where\n\ntypeRep :: Typeable a => TypeRep a\ntypeRep = undefined\n\nfunTyCon :: TyCon\nfunTyCon = undefined\n\ninstance (Typeable f, Typeable a) => Typeable (f a)\ninstance Typeable ((->) :: TYPE r -> TYPE s -> Type)\ninstance Typeable TYPE\n", "num_lines": 111}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language KindSignatures, TypeOperators, PolyKinds, TypeOperators,\n             ConstraintKinds, TypeFamilies, DataKinds, GADTs,\n             AllowAmbiguousTypes, InstanceSigs #-}\n\nmodule T14450 where\n\nimport Data.Kind\n\ndata TyFun :: Type -> Type -> Type\n\ntype a ~> b = TyFun a b -> Type\n\ntype Cat ob = ob -> ob -> Type\n\ntype SameKind (a :: k) (b :: k) = (() :: Constraint)\n\ntype family Apply (f :: a ~> b) (x :: a) :: b where\n  Apply IddSym0 x = Idd x\n\nclass Varpi (f :: i ~> j) where\n  type Dom (f :: i ~> j) :: Cat i\n  type Cod (f :: i ~> j) :: Cat j\n\n  varpa :: Dom f a a' -> Cod f (Apply f a) (Apply f a')\n\ntype family Idd (a::k) :: k where\n  Idd (a::k) = a\n\ndata IddSym0 :: k ~> k where\n  IddSym0KindInference :: IddSym0 l\n\ninstance Varpi (IddSym0 :: k ~> k) where\n  type Dom (IddSym0 :: Type ~> Type) = (->)\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\nmodule Bug where\n\nimport Data.Kind\n\ntype HRank1 ty = forall k1. k1 -> ty\ntype HRank2 ty = forall k2. k2 -> ty\n\ndata HREFL11 :: HRank1 (HRank1 Type) -- FAILS\ndata HREFL12 :: HRank1 (HRank2 Type)\ndata HREFL21 :: HRank2 (HRank1 Type)\ndata HREFL22 :: HRank2 (HRank2 Type) -- FAILS\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language DataKinds, PolyKinds, TypeFamilies, TypeOperators, AllowAmbiguousTypes #-}\n\nmodule T14520 where\n\nimport Data.Kind\n\ntype a ~>> b = (a, b) -> Type\n\ndata family Sing (a::k)\n\ntype family XXX (f::a~>>b) (x::a) :: b\n\ntype family Id   :: (kat :: a ~>> (a ~>> Type)) `XXX` (b :: a) `XXX` b\n\nsId :: Sing w -> Sing (Id :: bat w w)\nsId = sId\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TypeOperators, DataKinds, PolyKinds, GADTs #-}\n\n\nmodule T14555 where\n\nimport Data.Kind\nimport GHC.Types (TYPE, Type)\n\ndata Exp :: [TYPE rep] -> TYPE rep -> Type where\n--data Exp (x :: [TYPE rep]) (y :: TYPE rep) where\n--data Exp (x :: [TYPE rep]) y where\n  Lam :: Exp (a:xs) b -> Exp xs (a -> b)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE MagicHash #-}\n\nmodule T14561 where\n\nimport GHC.Types\nimport GHC.Prim\n\nbadId :: forall r (a :: TYPE r). a -> a\nbadId = unsafeCoerce#\n-- Un-saturated application of a levity-polymorphic\n-- function that must be eta-expanded\n\ngoodId :: forall (a :: Type). a -> a\ngoodId = unsafeCoerce#\n-- But this one is OK\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, KindSignatures, PolyKinds #-}\n{-# OPTIONS_GHC -fprint-explicit-runtime-reps #-}\n\nimport GHC.Types (TYPE)\nimport Data.Kind\n\ndata Lan (g::TYPE rep -> TYPE rep') (h::TYPE rep -> TYPE rep'') a where\n  Lan :: forall rep rep' xx (g::TYPE rep -> TYPE rep') (h::TYPE rep -> Type) a.\n         (g xx -> a) -> h xx -> Lan g h a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeOperators #-}\nmodule T14580 where\nimport Data.Kind\n\ntype Cat ob = ob -> ob -> Type\ndata ISO' :: Cat i -> i -> i -> Type\ntype ISO cat a b = ISO' cat a b -> Type\ntype (a <--> b) iso cat = ISO (iso :: cat a b)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule T14710 where\n\nimport Data.Proxy\n\nclass C a b where\n  c1 :: Proxy (x :: a) -> b\n  c2 :: forall (x :: a). Proxy x -> b\n\nf :: forall a. a -> a\nf x = const x (const g1 g2)\n  where\n    g1 :: Proxy (x :: a)\n    g1 = Proxy\n\n    g2 :: forall (x :: a). Proxy x\n    g2 = Proxy\n\nh1 :: forall k a. Proxy (a :: k)\nh1 = Proxy\n\nh2 :: forall k (a :: k). Proxy a\nh2 = Proxy\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule T14723 () where\n\nimport Data.Coerce( coerce )\nimport Data.Kind (Type)\nimport Data.Proxy (Proxy(..))\nimport Data.String (fromString)\nimport Data.Int (Int64)\nimport GHC.Stack (HasCallStack)\nimport GHC.TypeLits (Nat, Symbol)\n\ndata JType = Iface Symbol\n\ndata J (a :: JType)\n\nnewIterator\n  :: IO (J ('Iface \"java.util.Iterator\"))\nnewIterator = do\n    let tblPtr :: Int64\n        tblPtr = undefined\n    iterator <-\n         (qqMarker (Proxy :: Proxy \"wuggle\")\n                   (Proxy :: Proxy \"waggle\")\n                   (Proxy :: Proxy \"tblPtr\")\n                   (Proxy :: Proxy 106)\n                   (tblPtr, ())\n                   Proxy\n                   (undefined :: IO Int))\n    undefined\n\nclass Coercible (a :: Type) where\n  type Ty a :: JType\n\ninstance Coercible Int64 where\n  type Ty Int64 = Iface \"Int64\"\ninstance Coercible Int where\n  type Ty Int = Iface \"Int\"\n\nclass Coercibles xs (tys :: k) | xs -> tys\ninstance Coercibles () ()\ninstance (ty ~ Ty x, Coercible x, Coercibles xs tys) => Coercibles (x, xs) '(ty, tys)\n\nqqMarker\n  :: forall\n     k                   -- the kind variable shows up in Core\n     (args_tys :: k)     -- JType's of arguments\n     tyres               -- JType of result\n     (input :: Symbol)   -- input string of the quasiquoter\n     (mname :: Symbol)   -- name of the method to generate\n     (antiqs :: Symbol)  -- antiquoted variables as a comma-separated list\n     (line :: Nat)       -- line number of the quasiquotation\n     args_tuple          -- uncoerced argument types\n     b.                  -- uncoerced result type\n     (tyres ~ Ty b, Coercibles args_tuple args_tys, Coercible b, HasCallStack)\n  => Proxy input\n  -> Proxy mname\n  -> Proxy antiqs\n  -> Proxy line\n  -> args_tuple\n  -> Proxy args_tys\n  -> IO b\n  -> IO b\nqqMarker = undefined\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE InstanceSigs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule T14846 where\n\nimport Data.Kind\nimport Data.Proxy\n\ntype Cat ob = ob -> ob -> Type\n\ndata Struct :: (k -> Constraint) -> Type where\n  S :: Proxy (a::k) -> Struct (cls::k -> Constraint)\n\ntype Structured a cls = (S ('Proxy :: Proxy a)::Struct cls)\n\ndata AStruct :: Struct cls -> Type where\n  AStruct :: cls a => AStruct (Structured a cls)\n\nclass StructI xx (structured::Struct (cls :: k -> Constraint)) where\n  struct :: AStruct structured\n\ninstance (Structured xx cls ~ structured, cls xx) => StructI xx structured where\n  struct :: AStruct (Structured xx cls)\n  struct = AStruct\n\ndata Hom :: Cat k -> Cat (Struct cls) where\n\nclass Category (cat::Cat ob) where\n  i :: StructI xx a => r\u00c3\u00adki a a\n\ninstance Category riki => Category (Hom riki :: Cat (Struct cls)) where\n  i :: forall xx a. StructI xx a => Hom riki a a\n  i = case struct :: AStruct (Structured a cls) of\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\nmodule T14847 where\n\ndata Proxy k (a :: k) = MkProxy\ndata Proxy2 k a = MkP (Proxy k a)\n\ndata Proxy2' k a where\n  MkP' :: Proxy k a -> Proxy2' k a\n\ndata T a where\n  T :: Int -> T Bool\n\ntype family F a where\n  F Int = True\n  F _   = False\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T14873 where\n\nimport Data.Kind (Type)\n\ndata family Sing (a :: k)\n\nnewtype instance Sing (f :: k1 ~> k2) =\n  SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) }\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\n\nclass SingI (a :: k) where\n  sing :: Sing a\n\ndata ColSym1 :: f a -> a ~> Bool\ntype instance Apply (ColSym1 x) y = Col x y\n\nclass PColumn (f :: Type -> Type) where\n  type Col (x :: f a) (y :: a) :: Bool\n\nclass SColumn (f :: Type -> Type) where\n  sCol :: forall a (x :: f a) (y :: a).\n    Sing x -> Sing y -> Sing (Col x y :: Bool)\n\ninstance (SColumn f, SingI x) => SingI (ColSym1 (x :: f a) :: a ~> Bool) where\n  sing = SLambda (sCol (sing @_ @x))\n\n{-  When the bug was present, this smaller kind-incorrect version also\n    elicited the same piResultTy crash\n\n    But it's kind-incorrect, whereas the main test case should compile file\n\nclass SingI (a :: k) where\n\nclass SColumn (f :: Type -> Type) where\n\ninstance -- forall (f :: Type -> Type) a (x :: f a).\n         SColumn f => SingI (x :: f a)\n-}\n\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\n{-# OPTIONS_GHC -Wno-partial-type-signatures #-}\nmodule Bug where\n\nimport Data.Proxy\n\nf2 :: forall a (x :: a). Proxy (x :: _)\nf2 = Proxy\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, ConstraintKinds, TypeInType, GADTs #-}\n\nmodule T14939 where\n\nimport Data.Kind\n\ntype Cat ob = ob -> ob -> Type\n\ntype Alg cls ob = ob\n\nnewtype Fr\u00c3\u00ad (cls::Type -> Constraint) :: (Type -> Alg cls Type) where\n  Fr\u00c3\u00ad :: { with :: forall x. cls x => (a -> x) -> x }\n      -> Fr\u00c3\u00ad cls a\n\ndata AlgCat (cls::Type -> Constraint) :: Cat (Alg cls Type) where\n  AlgCat :: (cls a, cls b) => (a -> b) -> AlgCat cls a b\n\nleftAdj :: AlgCat cls (Fr\u00c3\u00ad cls a) b -> (a -> b)\nleftAdj (AlgCat f) a = undefined", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, PolyKinds, DataKinds #-}\nmodule T15116 where\n\nimport Data.Proxy\n\ndata A (a :: k) where\n  MkA :: A MkA\n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds #-}\nmodule T15116a where\n\nimport Data.Proxy\n\ndata B = MkB (Proxy 'MkB)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T15170  where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\ntype f @@ x = Apply f x\ninfixl 9 @@\n\nwat :: forall (a :: Type)\n              (b :: a ~> Type)\n              (c :: forall (x :: a). Proxy x ~> b @@ x ~> Type)\n              (f :: forall (x :: a) (y :: b @@ x). Proxy x ~> Proxy y ~> c @@ ('Proxy :: Proxy x) @@ y)\n              (x :: a).\n      (forall (xx :: a) (yy :: b @@ xx). Proxy (f @@ ('Proxy :: Proxy xx) @@ ('Proxy :: Proxy yy)))\n   -> ()\nwat _ = ()\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Bug where\n\nimport Data.Kind\nimport Data.Proxy\nimport Data.Type.Equality\n\ntype family F (x :: f (a :: k)) :: f a\n\nf :: forall k (f :: k -> Type) (a :: k) (r :: f a). Proxy r -> F r :~: r\nf = undefined\n\ng :: forall (f :: Type -> Type) (a :: Type) (r :: f a). Proxy r -> F r :~: r\ng r | Refl <- f -- Uncommenting the line below makes it work again\n                -- @Type\n                @f @a @r r\n    = Refl\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies #-}\n{-# OPTIONS_GHC -ddump-types -fprint-explicit-foralls #-}\nmodule T15592 where\n\ndata T f (a::k1) b = MkT (f a b) (T f a b)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15592b where\n\nimport Data.Kind\n\nclass C a where\n  type T (x :: (f :: k -> Type) a)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes #-}\n{-# Language TypeApplications #-}\n{-# Language DataKinds        #-}\n{-# Language PolyKinds        #-}\n{-# Language GADTs            #-}\n{-# Language TypeFamilies     #-}\n\nimport Data.Kind\n\nclass R\u00c3\u00adki (ob :: Type) where\n type Hom :: ob -> ob -> Type\n\ndata\n  Kl_kind :: forall ob . (ob -> ob) -> ob -> Type where\n  Kl      :: k -> Kl_kind (m :: ob -> ob) k\n\ntype family\n  UnKl (kl :: Kl_kind m k) = (res :: k) where\n  UnKl (Kl a) = a\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language LiberalTypeSynonyms #-}\n{-# Language PolyKinds           #-}\n{-# Language RankNTypes          #-}\n{-# Language DataKinds           #-}\n\nimport Data.Kind\n\ntype Cat ob = ob -> ob -> Type\n\ndata Zero :: forall (cat :: forall xx. xx -> Type) a. forall b. Cat (forall b. cat b u)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule T15795 where\n\nimport Data.Kind\n\ntype KindOf (a :: k) = k\n\ndata T :: forall j (a :: j). KindOf a -> Type where\n  MkT :: forall k (b :: k). T b\n\nf :: forall k (b :: k). T b\nf = error \"urk\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language    RankNTypes       #-}\n{-# Language    PolyKinds        #-}\n{-# Language    GADTs            #-}\n\nmodule T15795a where\nimport Data.Kind\n\ndata F :: forall (cat1 :: ob1). ob1 -> Type where\n  Prod :: F (a :: u)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds #-}\n\nmodule T15804 where\n\ndata T :: (a :: k) -> *\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes       #-}\n{-# Language PolyKinds        #-}\n{-# Language TypeFamilies     #-}\n\nmodule T15817 where\n\nimport Data.Kind\n\ndata family   X :: forall (a :: Type). Type\ndata instance X = MkX\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes   #-}\n{-# Language DataKinds    #-}\n{-# Language PolyKinds    #-}\n{-# Language GADTs        #-}\n{-# Language TypeFamilies #-}\n\nmodule T15874 where\n\nimport Data.Kind\n\ndata Var where\n  Op :: Var\n  Id :: Var\n\ntype Varianced = (forall (var :: Var). Type)\n\ndata family   Parser :: Varianced\ndata instance Parser = P\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language KindSignatures #-}\n{-# Language PolyKinds      #-}\n\nmodule T15881 where\n\nimport Data.Kind\n\ndata A n (a :: n n) :: Type\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language KindSignatures #-}\n{-# Language PolyKinds      #-}\n\nmodule T15881a where\n\nimport Data.Kind\n\ndata A n (a :: n) :: a -> Type\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeInType, ExistentialQuantification #-}\n\nmodule T16221 where\n\n-- Failed Lint\ndata T3 a = forall k (b :: k). MkT3 (T3 b) !Int\n\n-- Works with GADT\ndata T4 a where\n   MkT4 :: T4 b -> !Int -> T4 a\n\n-- Works with CUSK\ndata T5 (a :: j) = forall k (b :: k). MkT5 (T5 b) !Int\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeInType, ExistentialQuantification #-}\n\nmodule T16221a where\n\ndata SameKind :: k -> k -> *\ndata T2 a = forall k (b :: k). MkT2 (SameKind a b) !Int\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeInType, EmptyDataDecls #-}\n\nmodule T16263 where\n\nimport Data.Kind\n\ndata Q :: Eq a => Type where {}\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeInType, ConstrainedClassMethods, ScopedTypeVariables #-}\n\nmodule T16342 where\n\nimport Data.Proxy\n\nclass C (a::ka) x where\n  cop :: D a x => x -> Proxy a -> Proxy a\n  cop _ x = x :: Proxy (a::ka)\n\nclass D (b::kb) y where\n  dop :: C b y => y -> Proxy b -> Proxy b\n  dop _ x = x :: Proxy (b::kb)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs                      #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE PolyKinds, DataKinds       #-}\n\nmodule T5716 where\n\nimport Data.Kind (Type)\n\ndata family DF a\ndata instance DF Int = DFInt\n\ndata U = U1 (DF Int)\n\ndata I :: U -> Type where I1 :: I (U1 DFInt)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs                      #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE PolyKinds                  #-}\n{-# LANGUAGE DataKinds                  #-}\n\nmodule T5716a where\n\n\ndata family DF a \ndata instance DF a = Bar (Bar a)\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables        #-}\n{-# LANGUAGE PolyKinds                  #-}\n\nmodule T5717 where\n\n\ndata TypeRep = TypeRep\n\ndata Proxy t = Proxy\n\ntypeRep :: Proxy a -> TypeRep\ntypeRep Proxy = TypeRep\n\n-- This one works fine:\ntypeOf :: forall a. a -> TypeRep\ntypeOf _ = typeRep (Proxy :: Proxy a)\n\n-- But this one panics!\ntypeOf1 :: forall t a. t a -> TypeRep\ntypeOf1 _ = typeRep (Proxy :: Proxy t)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies,\n             PolyKinds,\n             ScopedTypeVariables\n #-}\n\nmodule T5770 where\n\nconvert :: a -> b\nconvert = convert\n\ntype family Foo a \ntype instance Foo Int = Bool\n\nbarT5770 :: forall a b c dummya. (b -> c) -> Foo a -> a\nbarT5770 f = (convert f :: Foo a -> a)\n\nbarT5769 :: forall b a. b -> (a, Foo a)\nbarT5769 f = (convert f :: (a, Foo a))\n\nbarT5768 :: forall a b. b -> (a, Foo a)\nbarT5768 f = (convert f :: (a, Foo a))\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, GADTs, TypeOperators #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule T5771 where\n\nclass IndexedMonad m where\n  unit :: a -> m i i a\n  bind :: m i j a -> (a -> m j k b) -> m i k b\n\nnewtype IndexedIO i j a = IndexedIO {runIndexedIO :: IO a}\n\n-- i and j are both *; instance is accepted\ninstance IndexedMonad IndexedIO where\n  unit = IndexedIO . return\n  bind m k = IndexedIO $ runIndexedIO m >>= runIndexedIO . k\ninfixl 1 `bind`\n\ndata HList xs where\n  N    :: HList '[]\n  (:>) :: a -> HList as -> HList (a ': as)\ninfixr 5 :>\n\nnewtype HLState xs ys a = HLState {runHLState :: HList xs -> (a, HList ys)}\n\n-- i and j are now [*]; rejected with the MPTCs message\ninstance IndexedMonad HLState where\n  unit x = HLState $ \\s -> (x, s)\n  bind (HLState f) k = HLState $ \\xs ->\n    case f xs of (a, ys) -> runHLState (k a) ys\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds #-}\n\nmodule T5798 where\n\ndata Proxy t = ProxyC\n\ntest :: Proxy '[Int, Bool]\ntest = ProxyC\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds,\n             TypeFamilies,\n             GADTs,\n             DataKinds,\n             KindSignatures\n #-}\n\nmodule T5862 where\n\nimport Data.Kind (Type)\n\ndata Nat = Zero | Succ Nat\n\ndata SNat a where\n  SZero :: SNat 'Zero\n  SSucc :: SNat n -> SNat ('Succ n)\n\ndata SBool a where\n  SFalse :: SBool 'False\n  STrue :: SBool 'True\n\ndata SMaybe a where\n  SNothing :: SMaybe 'Nothing\n  SJust :: Sing a -> SMaybe ('Just a)\n\ntype family Sing (a :: k)\ntype instance Sing (a :: Nat) = SNat a\ntype instance Sing (a :: Bool) = SBool a\ntype instance Sing (a :: Maybe Type) = SMaybe a -- want to say Maybe k\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5881 where\n\nimport T5881a (T')\n\ntype DOne = T'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\nmodule T5881a where\ndata K = T\ntype T' = T\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n\n-- This bug related to type trimming, and\n-- hence showed up only with -O0\n\nmodule Bug() where\n\ndata UnaryTypeC a = UnaryDataC a\n\ntype Bug = 'UnaryDataC\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds,\n             GADTs,\n             DataKinds,\n             KindSignatures\n #-}\n\nmodule T5935 where\n\ndata SList a where\n  SNil :: SList '[]\n\nx :: SList ('[] :: [Bool])\nx = SNil\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, KindSignatures, DataKinds, GADTs #-}\nmodule T5937 where\n\nimport Data.Kind (Type)\n\ndata SMaybe :: (k -> Type) -> Maybe k -> Type where\n   SNothing :: SMaybe s 'Nothing\n   SJust :: s a -> SMaybe s ('Just a)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, DataKinds #-}\nmodule T5938 where\n\nimport Data.Kind (Type)\n\ntype family KindFam (a :: k)\ntype instance KindFam (a :: Type) = Int\ntype instance KindFam (a :: Bool) = Bool\ntype instance KindFam (a :: Maybe k) = Char -- doesn't work\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators #-}\n\nmodule T5948 where\n\ntype Foo = (Int ': '[])\n\ntype Bar = Int ': '[]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This module should compile with -XIncoherentInstances, but didn't in 7.4\n\n\n{- Here we define all the stuff that is needed for our singleton\n   types:\n - phantom types (when GHC 7.4 arrives, the user-defined kinds)\n - corresponding singleton types\n\nThese are basically the constructs from Omega,\nreimplemented in Haskell for our purposes. -}\n\n{-# LANGUAGE GADTs, KindSignatures, StandaloneDeriving,\n             RankNTypes, TypeFamilies, FlexibleInstances, IncoherentInstances #-}\nmodule TypeMachinery where\n\nimport Data.Kind (Type)\n\n-- The natural numbers:\n--  o first the phantom types\n\ndata Z; data S n\n\n-- o the using the above the singleton type Nat'\n\ndata Nat' :: Type -> Type where\n  Z :: Nat' Z\n  S :: Nat' n -> Nat' (S n)\n\nderiving instance Show (Nat' a)\n\n-- Type-level addition\n\ntype family Plus m n :: Type\ntype instance Plus Z n = n\ntype instance Plus (S m) n = S (Plus m n)\n\n-- Nat' addition\n\nplus :: Nat' a -> Nat' b -> Nat' (Plus a b)\nplus Z n = n\nplus (S m) n = S (plus m n)\n\n-- Equality on Nat'\n\nsameNat' :: Nat' a -> Nat' b -> Bool\nsameNat' Z Z = True\nsameNat' (S m) (S n) = sameNat' m n\nsameNat' _ _ = False\n\n-- A data type for existentially hiding\n-- (e.g.) Nat' values\n\ndata Hidden :: (Type -> Type) -> Type where\n  Hide :: Show (a n) => a n -> Hidden a\n\nderiving instance Show (Hidden t)\n\ntoNat' :: Integral i => i -> Hidden Nat'\ntoNat' 0 = Hide Z\ntoNat' n = case toNat' (n - 1) of\n           Hide n -> Hide (S n)\n\n-- Now we are ready to make Hidden Nat' an Integral type\n\ninstance Eq (Hidden Nat') where\n  Hide a == Hide b = sameNat' a b\n\ninstance Ord (Hidden Nat') where\n  Hide Z `compare` Hide Z = EQ\n  Hide Z `compare` Hide _ = LT\n  Hide _ `compare` Hide Z = GT\n  Hide (S m) `compare` Hide (S n) = Hide m `compare` Hide n\n\ninstance Enum (Hidden Nat') where\n  toEnum = toEnum . fromIntegral\n  fromEnum = fromIntegral\n\ninstance Num (Hidden Nat') where\n  fromInteger = toNat'\n  signum (Hide Z) = 0\n  signum _ = 1\n  abs n = n\n  Hide a + Hide b = Hide $ plus a b\n  a * b = fromInteger $ toInteger a * toInteger b\n  negate a = error \"negate(Hidden Nat')\"\n\ninstance Real (Hidden Nat') where\n  toRational = toRational . toInteger\n\ninstance Integral (Hidden Nat') where\n  toInteger (Hide Z) = 0\n  toInteger (Hide (S n)) = 1 + toInteger (Hide n)\n  quotRem a b = let (a', b') = toInteger a `quotRem` toInteger b in (fromInteger a', fromInteger b')\n\n-- McBride's Fin data type. By counting backwards from the\n-- result index, it only admits a fixed number of inhabitants.\n\ndata Fin :: Type -> Type where\n    Stop :: Fin (S Z)\n    Retreat :: Fin s -> Fin (S s)\n\nderiving instance Show (Fin a)\n\n", "num_lines": 104}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, MultiParamTypeClasses, FunctionalDependencies,\n             PolyKinds, UndecidableInstances, ScopedTypeVariables #-}\n\nmodule T6015 where\n\ndata Proxy a = Proxy\n\nclass Value a t | a -> t where value :: Proxy a -> t\n\ninstance Value True Bool where value _ = True\n\ninstance Value a t => Value (Just a) (Maybe t)\n    where value _ = Just (value (Proxy :: Proxy a))\n\ntest = value (Proxy :: Proxy (Just True))\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE PolyKinds, KindSignatures, FunctionalDependencies,  FlexibleInstances,\n              UndecidableInstances, TypeOperators, DataKinds,  FlexibleContexts #-}\n\nmodule T6015a where\n\nimport Prelude hiding ((++))\n\ndata T a = T\n\nclass ((a :: [k]) ++ (b :: [k])) (c :: [k]) | a b -> c  \ninstance ('[] ++ b) b  \ninstance (a ++ b) c => ((x ': a) ++ b) (x ': c)\n\ntest = T :: ('[True] ++ '[]) l => T l\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, FunctionalDependencies, FlexibleInstances,\n             UndecidableInstances, PolyKinds, KindSignatures,\n             ConstraintKinds, FlexibleContexts #-}\n\nmodule T6020 where\n\nclass Id (a :: k) (b :: k) | a -> b\ninstance Id a a\n\nf :: Id x y => x -> y\nf = f\n\n--class Test (x :: a) (y :: a) | x -> y\n--instance (Id x y, Id y z) => Test x z\n\n-- (Id x0 y0, Id y0 z0, x~x0, z~z0)\n-- (Id x y0, Id y0 z, y0~z, y0~y)\n\n--test :: Test True True => ()\n--test = ()\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE DataKinds, FunctionalDependencies, FlexibleInstances,\n              UndecidableInstances, PolyKinds, KindSignatures,\n              ConstraintKinds, FlexibleContexts, GADTs #-}\n\nmodule T6020a where\n\nclass Id (a :: k) (b :: k) | b -> a\ninstance a ~ b => Id a b\n\nclass Test (x :: a) (y :: a)\ninstance (Id x y, Id y z) => Test x z\n-- Weird test case: (Id x y) and (Id y z) are both simplifiable\n\ntest :: Test True True => ()\n-- Weird test case: (Test True True) is simplifiable\ntest = ()\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, PolyKinds, MultiParamTypeClasses, FlexibleInstances #-}\nmodule T6021 where\n\nclass Panic a b\ninstance Panic (a :: b) b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6025 where\n\nimport T6025a\n\nother = OTrue\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, GADTs #-}\nmodule T6025a (Other (..)) where\n\ndata Other a where\n  OTrue :: Other True\n  OFalse :: Other False\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, KindSignatures, GADTs,  TypeOperators\n  #-}\n\nmodule T6035 where\n\nimport Data.Kind (Type)\n\ndata Nat = Zero | Succ Nat\n\ntype family Sing (a :: k) :: k -> Type\n\ndata SNat n where\n  SZero :: SNat Zero\n  SSucc :: SNat n -> SNat (Succ n)\n\ndata SList (a :: [k]) where\n  SNil :: SList '[]\n  SCons :: Sing h h -> SList t -> SList (h ': t)\n\ntype instance Sing (a :: Nat) = SNat\ntype instance Sing (a :: [k]) = SList\n\nnil :: SList '[]\nnil = SNil\n\nzero :: SList '[ '[] ]\nzero = SCons SNil SNil\n\nterm :: SList '[ '[Zero], '[]]\nterm = SCons (SCons SZero SNil) (SCons SNil SNil)\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeFamilies, PolyKinds, GADTs #-}\n\nmodule T6036 where\n\ndata family Sing (a :: k)\n\ndata instance Sing (a :: Maybe k) where\n  SNothing :: Sing 'Nothing\n  SJust :: Sing b -> Sing ('Just b)\n\ndata Nat = Zero | Succ Nat\n\ndata instance Sing (a :: Nat) where\n  SZero :: Sing Zero\n  SSucc :: Sing n -> Sing (Succ n)\n\nterm = SJust SZero\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, KindSignatures #-}\n\nmodule Foo where\n\ndata T (a :: j k) = MkT\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, KindSignatures #-}\n\nmodule T6044 where\n\ntype family Foo (a :: k) :: Maybe k\ntype instance Foo a = Just a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, KindSignatures, PolyKinds, GADTs,  ExistentialQuantification #-}\n\nmodule T6049 where\n\nimport Data.Kind (Type)\n\ndata SMaybe :: (k -> Type) -> Maybe k -> Type where\n   SNothing :: forall k (s :: k -> Type). SMaybe s Nothing\n   SJust :: forall k (s :: k -> Type) (a :: k). SMaybe s (Just a)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, DataKinds #-}\n\nmodule T6054 where\n\nimport T6054a\n\nfoo = print (Proxy :: Bar '() a => Proxy a)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, DataKinds #-}\n\nmodule T6054a where\n\nclass Bar a (p :: Bool) | a -> p\ndata Proxy a = Proxy deriving Show\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, GADTs, MultiParamTypeClasses, KindSignatures,\n             FunctionalDependencies, FlexibleInstances, UndecidableInstances, ExistentialQuantification #-}\n\nmodule T6068 where\n\nimport Prelude hiding (Maybe, Nothing)\nimport Data.Kind (Type)\n\ndata Maybe :: Type -> Type where\n  Nothing :: Maybe a\n\ndata family Sing (a :: k)\n\ndata instance Sing (a :: Maybe k) where\n  SNothing :: Sing Nothing\n\ndata KProxy (a :: Type) = KProxy\ndata Existential (p :: KProxy k) =\n  forall (a :: k). Exists (Sing a)\n\nclass HasSingleton a (kp :: KProxy k) | a -> kp where\n  exists :: a -> Existential kp\n\nclass Floop a b | a -> b\n\ninstance Floop a (mp :: KProxy (Maybe ak)) => HasSingleton (Maybe a) mp where\n  exists Nothing = Exists SNothing\n\n-- instance forall (a ::Type) (mp :: KProxy (Maybe ak)).\n--          HasSingleton (Maybe ak) (Maybe a) mp where\n--   exists Nothing = Exists SNothing\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, PolyKinds, DataKinds, RankNTypes #-}\n\nmodule T6081 where\n\nimport Data.Kind (Type)\n\ndata KProxy (a :: Type) = KP\n\nclass KindClass (kp :: KProxy k)\ninstance KindClass (KP :: KProxy [k])\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes, PolyKinds #-}\nmodule T6093 where\n\nimport qualified Data.Kind as K (Type)\n\n-- Polymorphic kind recursion\ndata R :: forall k. k -> K.Type where\n    MkR :: R f -> R (f ())\n\ndata IOWitness (a :: k) = IOW\n\ndata Type :: forall k. k -> K.Type where\n  SimpleType :: IOWitness a -> Type a\n  ConstructedType :: Type f -> Type a -> Type (f a)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, KindSignatures, RankNTypes,\n             TypeFamilies, FlexibleInstances, UndecidableInstances #-}\n\nmodule T6118 where\n\nimport GHC.Exts (Any)\nimport Data.Kind (Type)\n\ndata Nat = Zero | Succ Nat\ndata List a = Nil | Cons a (List a)\n\nclass SingE (a :: k) where\n  type Demote a :: Type\n\ninstance SingE (a :: Bool) where\n  type Demote a = Bool\ninstance SingE (a :: Nat) where\n  type Demote a = Nat\n\ninstance SingE (a :: Maybe k) where\n  type Demote (a :: Maybe k) = Maybe (Demote (Any :: k))\n\ninstance SingE (a :: List k) where\n  type Demote (a :: List k) = List (Demote (Any :: k))\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs        #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds    #-}\n{-# LANGUAGE DataKinds    #-}\n\nmodule T6129 where\n\ndata family D a\ndata instance D a = DInt\n\ndata X a where\n  X1 :: X DInt\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GADTs #-}\n\nmodule T6137 where\n\nimport Data.Kind (Type)\n\ndata Sum a b = L a | R b\n\ndata Sum1 (a :: k1 -> Type) (b :: k2 -> Type) :: Sum k1 k2 -> Type where\n  LL :: a i -> Sum1 a b (L i)\n  RR :: b i -> Sum1 a b (R i)\n\ndata Code i o = F (Code (Sum i o) o)\n\n-- An interpretation for `Code` using a data family works:\ndata family In (f :: Code i o) :: (i -> Type) -> (o -> Type)\n\ndata instance In (F f) r x where\n  MkIn :: In f (Sum1 r (In (F f) r)) x -> In (F f) r x\n\n\n{- data R:InioFrx o i f r x where\n     where  MkIn :: forall o i (f :: Code (Sum i o) o)\n                               (r :: i -> Type)\n                               (x :: o).\n                    In (Sum i o) o f (Sum1 o i r (In i o ('F i o f) r)) x\n                    -> R:InioFrx o i f r x\n\n   So  R:InioFrx :: forall o i. Code i o -> (i -> Type) -> o -> Type\n\n  data family In i o (f :: Code i o) (a :: i -> Type) (b :: o)\n\n  axiom D:R:InioFrx0 ::\n    forall o i (f :: Code (Sum i o) o).\n      In i o ('F i o f) = R:InioFrx o i f\n\n\n  D:R:InioFrx0 ::    R:InioFrx o i f ~ In i o ('F i o f)\n-}\n-- Requires polymorphic recursion\ndata In' (f :: Code i o) :: (i -> Type) -> o -> Type where\n  MkIn' :: In' g (Sum1 r (In' (F g) r)) t -> In' (F g) r t\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, RankNTypes, PolyKinds, GADTs,\n              FlexibleContexts, DataKinds, TypeFamilies #-}\n\nmodule T7020 where\n\nimport GHC.Exts\n\ndata family Sing (a :: k)\n\nclass SingKind (Any :: k) => SingI (s :: k) where\n   sing :: Sing s\n\ndata SingInstance (a :: k) where\n   SingInstance :: SingI a => SingInstance a\n\nclass (b ~ Any) => SingKind (b :: k) where\n   singInstance :: forall (a :: k). Sing a -> SingInstance a\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, DataKinds, TemplateHaskell #-}\n\nmodule T7022 where\n\nimport T7022b\n\nfoo :: SList a -> Bool\nfoo = undefined\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7022a where\n\nimport Language.Haskell.TH\n\nmakeSList :: Q [Dec]\n-- makes \"type SList (a :: [k]) = Sing a\"\nmakeSList = do\n   a <- newName \"a\"\n   k <- newName \"k\"\n   return [TySynD (mkName \"SList\") [KindedTV a (AppT ListT (VarT k))]\n                  (AppT (ConT (mkName \"Sing\")) (VarT a))]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, DataKinds, TemplateHaskell #-}\n\nmodule T7022b where\n\nimport T7022a\n\ndata family Sing (a :: k)\n\n$( makeSList )\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs #-}\n\nmodule T7053 where\n\ndata TypeRep (a :: k) where\n   TyApp   :: TypeRep a -> TypeRep b -> TypeRep (a b)\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs #-}\n\nmodule T7053a where\n\nimport Data.Kind (Type)\n\n-- This time with a fully-specified kind signature\ndata TypeRep (a :: k) :: Type where\n   TyApp   :: TypeRep a -> TypeRep b -> TypeRep (a b)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies #-}\n\nmodule T7073 where\n\nclass Foo a where\n   type Bar a\n   type Bar a = Int\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE GADTs, ConstraintKinds, TypeFamilies, \n    DataKinds, ScopedTypeVariables, TypeOperators #-}\n\nmodule T7090 where\n\nimport GHC.Exts\n\ndata Dict c where\n  Dict :: c => Dict c\n\ndata Nat = Zero | Succ Nat\n\ntype family Plus (a :: Nat) (b :: Nat) :: Nat\ntype instance Plus Zero b = b\ntype instance Plus (Succ a) b = Succ (Plus a b)\n\ntype One = Succ Zero\n\ntype family (a :: Nat) :==: (b :: Nat) :: Bool\n\nboolToProp :: (a :==: b) ~ True => Dict (a ~ b)\nboolToProp = undefined\n\ndata T (n :: Nat) = MkT\n\nfoo :: forall n. (Succ n :==: Plus n One) ~ True => T n\nfoo = case (boolToProp :: Dict (Succ n ~ Plus n One)) of\n           Dict -> MkT\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, PolyKinds, FlexibleInstances, FlexibleContexts #-}\n\nmodule T7095 where\n\ndata Wrapped t = Wrapped \n\nclass Len l where\n    len :: l -> Int\n\ninstance Len (Wrapped '[]) where\n    len = const 0\n\ninstance (Len (Wrapped xs)) => Len (Wrapped (x ': xs)) where\n    len x = 1 + (len $ wrappedTail x)   \n\nwrappedTail :: Wrapped (x ': xs) -> Wrapped xs\nwrappedTail = const Wrapped  \n\n-- | test1 == zero just as excepted. \ntest1 = len (undefined  :: Wrapped '[])\n\n-- | Since I have typeclasses defined for Wrapped (* ': [*]) and for (Wrapped '[])\n-- I except to get 1 here, but this does not typecheck with following  message:\n-- No instance for (Len (Wrapped [*] ([] *)))  \ntest2 = len (undefined  :: Wrapped '[Int]) \n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, MultiParamTypeClasses,\n              FunctionalDependencies\n  #-}\n\nmodule T7128 where\n\nclass Foo a (b :: k) | a -> k\ninstance Foo Bool False\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7151 where\n\ntype Foo = [Int, String]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, GADTs, RankNTypes #-}\n\nmodule T7176 where\n\ntype family Sing (a :: b)\n\ndata SMaybe (a :: Maybe c) where\n   SNothing :: SMaybe Nothing\n   SJust :: Sing a -> SMaybe (Just a)\ntype instance Sing (a :: Maybe d) = SMaybe a\n\nsIsJust :: forall e (a :: Maybe e). Sing a -> ()\nsIsJust SNothing = ()\nsIsJust (SJust _) = ()\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T7224 where\n\nclass PMonad' (m :: i -> i -> * -> *) where\n  ret'  :: a -> m i i a\n  bind' :: m i j a -> (a -> m j k b) -> m i k b\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n{-# LANGUAGE DataKinds, PolyKinds, GADTs, TypeFamilies #-}\n{-# LANGUAGE TypeOperators, UndecidableInstances #-}\nmodule T7230 where\n\ndata Nat = Zero | Succ Nat deriving (Show, Eq, Ord)\n\ndata family Sing (x :: k)\n\ndata instance Sing (n :: Nat) where\n  SZero :: Sing Zero\n  SSucc :: Sing n -> Sing (Succ n)\n\ntype SNat (n :: Nat) = Sing n\n\ndata instance Sing (b :: Bool) where\n  STrue  :: Sing True\n  SFalse :: Sing False\n\ntype SBool (b :: Bool) = Sing b\n\ndata instance Sing (xs :: [k]) where\n  SNil  :: Sing ('[] :: [k])\n  SCons :: Sing x -> Sing xs -> Sing (x ': xs)\n\ntype SList (xs :: [k]) = Sing (xs :: [k])\n\ntype family (:<<=) (n :: Nat) (m :: Nat) :: Bool\ntype instance Zero   :<<= n      = True\ntype instance Succ n :<<= Zero   = False\ntype instance Succ n :<<= Succ m = n :<<= m\n\n(%:<<=) :: SNat n -> SNat m -> SBool (n :<<= m)\nSZero   %:<<= _       = STrue\nSSucc _ %:<<= SZero   = SFalse\nSSucc n %:<<= SSucc m = n %:<<= m\n\ntype family   (b :: Bool) :&& (b' :: Bool) :: Bool\ntype instance True  :&& b = b\ntype instance False :&& b = False\n\ntype family   Increasing (xs :: [Nat]) :: Bool\ntype instance Increasing '[]  = True\ntype instance Increasing '[n] = True\ntype instance Increasing (n ': m ': ns) = n :<<= m :&& Increasing (m ': ns)\n\ncrash :: (Increasing xs) ~ True => SList xs -> SBool (Increasing xs)\ncrash (SCons x (SCons y xs)) = x %:<<= y\ncrash _                      = STrue\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, TypeFamilies #-}\nmodule T7238 where\n\nimport GHC.Exts\n\nclass Pair p where\n        type Ctxt p a :: Constraint\n        l :: Ctxt p a => p a -> a\n\ndata Unit a = Unit\n\ninstance Pair Unit where\n        type Ctxt Unit a = a ~ ()\n        l _ = ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T7272 where\n\nimport T7272a\n\nclass C (a :: k)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T7272a where\n\nimport {-# SOURCE #-} T7272\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, MultiParamTypeClasses, FlexibleContexts,\n             AllowAmbiguousTypes #-}\nmodule T7278 where\n \ntype family TF (t  :: k) :: * -> * -> *\n\nclass C (t :: k) (dcs :: * -> * -> *)\n\nf :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0\nf = undefined -- panic caused by (t :: k) in the signature's context\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs, AllowAmbiguousTypes #-}\n\nmodule T7328 where\n\ndata Proxy a\n\nclass Foo a where\n    foo :: a ~ f i => Proxy (Foo f)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonomorphismRestriction #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule T7332 where\n\nimport GHC.Exts( IsString(..) )\nimport Data.Kind (Type)\nimport Data.Monoid\nimport Data.Semigroup\n\nnewtype DC d = DC d\n    deriving (Show, Semigroup, Monoid)\n\ninstance IsString (DC String) where\n    fromString = DC\n\n\nclass Monoid acc => Build acc r where\n    type BuildR r :: Type       -- Result type\n    build :: (acc -> BuildR r) -> acc -> r\n\ninstance Monoid dc => Build dc (DC dx) where\n    type BuildR (DC dx) = DC dx\n    build tr acc = tr acc\n\ninstance (Build dc r, a ~ dc) => Build dc (a->r) where\n    type BuildR (a->r) = BuildR r\n    build tr acc s = build tr (acc `mappend` s)\n\n\n-- The type is inferred\n-- tspan :: (Monoid d, Build (DC d) r, BuildR r ~ DC d) => r\ntspan :: (Build (DC d) r, BuildR r ~ DC d) => r\ntspan = build (id :: DC d -> DC d) mempty\n\n{- Solving 'tspan'\n\nGiven:    Build (DC d) r, BuildR r ~ DC d\n (by sc)  Monoid (DC d)\n\n   Wanted:\n       Build acc0 r0\n       Monid acc0\n       acc0 ~ DC d0\n       DC d0 ~ BuildR r0\n       r ~ r0\n==>\n       Build (DC d0) r\n       Monoid (DC d0)  -->  Monoid d0\n       DC d0 ~ BuildR r\n\nFrom Given: BuildR r = DC d, hence\n       DC d0 ~ DC d\nhence\n       d0 ~ d\n\n===>\n       Build (DC d) r\n       Monoid (DC d)\n\nNow things are delicate.  Either the instance Monoid (DC d) will fire or,\nif we are lucky, we might spot that (Monoid (DC d)) is a superclass of\na given.  But now (Decl 15) we add superclasses lazily, so that is less\nlikely to happen, and was always fragile.  So include (Monoid d) in the\nsignature, as was the case in the original ticket.\n-}\n\n\nfoo = tspan \"aa\"\n\nfoo1 = tspan (tspan \"aa\")\n\nbar = tspan \"aa\" :: DC String\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, TypeFamilies, PolyKinds, FlexibleInstances #-}\n\nmodule T7341 where\n\ndata Proxy a = Proxy\n\nclass C a where\n  type F (a :: *) :: *\n  op :: Proxy a -> Int\n\ninstance C [] where\n  op _ = 5\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                 #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs                     #-}\n{-# LANGUAGE KindSignatures            #-}\n\nmodule T7347 where\n\nimport Data.Kind (Type)\n\ndata K = forall a. T a  -- Existential: promotion gives 'T :: forall k. k -> K                          \n\ndata G :: K -> Type where\n  D :: G (T [])         -- Uses existential\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, ScopedTypeVariables #-}\nmodule T7404 where\n\nimport Data.Kind (Type)\n\ntype family Foo (x :: Type) (y :: x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving, DataKinds, KindSignatures, DeriveGeneric, GADTs#-}\n\nmodule T7422 where\n\nimport GHC.Generics\n\ntype CellId = Int\ntype Ident = String\ntype LabelName = String\n\ndata ExprTag = TagAst | TagEval\n\ndata Expr (tag :: ExprTag) where\n  Var :: Ident -> Expr tag\n  Label :: LabelName -> Expr tag -> Expr tag\n\nderiving instance Generic (Expr a)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data N = Z\ntype T = 'Z\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs, KindSignatures, DataKinds, FlexibleInstances #-}\n\nmodule T7438 where\nimport T7438a\n\ngo Nil acc = acc\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs, KindSignatures, DataKinds, FlexibleInstances #-}\n\nmodule T7438a where\n\nimport Data.Kind (Type)\n\ndata Thrist :: k -> k -> Type where\n  Nil :: Thrist a a\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE DataKinds, PolyKinds, RankNTypes, GADTs #-}\n\nmodule T7481 where\n\nimport Data.Kind (Type)\nimport Data.Proxy\n\ndata D a where\n  D1 :: a -> D a\n  D2 :: (a~Int) => D a\n  D3 :: forall k (a::k) b. Proxy a -> D b\n\ndata Foo :: D Type -> Type\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds          #-}\n{-# LANGUAGE KindSignatures     #-}\n{-# LANGUAGE GADTs              #-}\n\nmodule T7488 where\n\nnewtype A = A Bool\ndata B (x :: A)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\nmodule T7502 where\n\ntype S = [1,2]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\nmodule T7524 where\n\ntype family F (a :: k1) (b :: k2)\ntype instance F a a = Int\ntype instance F a b = Bool\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances     #-}\n{-# LANGUAGE UndecidableInstances  #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE UndecidableSuperClasses #-}\n{-# LANGUAGE KindSignatures        #-}\n{-# LANGUAGE TypeOperators         #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs           #-}\n{-# LANGUAGE Rank2Types      #-}\n\nmodule T7594 where\n\nimport Data.Kind (Constraint, Type)\n\nclass    (c1 t, c2 t) => (:&:) (c1 :: Type -> Constraint)\n                               (c2 :: Type -> Constraint)\n                               (t :: Type)\ninstance (c1 t, c2 t) => (:&:) c1 c2 t\n\ndata ColD c where\n  ColD :: (c a) => a -> ColD c\n\napp :: (forall a. (c a) => a -> b) -> ColD c -> b\napp f (ColD x) = f x\n\nq :: ColD (Show :&: Real)\nq = ColD (1.2 :: Double)\n\nbar = app print q\n-- This one works, as a result of fixing Trac #8644,\n-- because the given constraint is\n--   (Show :&: Real) a, which has no equality superclasses\n\nq2 :: ColD (c :&: Real)\nq2 = error \"urk\"\n\nbar2 = app print q2\n-- This one fail, because the given constraint is\n--   (c :&: Real) a, which might have equality superclasses\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds              #-}\n{-# LANGUAGE TypeFamilies           #-}\n\nmodule T7601 where\n\nimport Data.Kind\n\nclass C (a :: k) where\n   type F (a :: k)\n\nclass Category (c :: k -> k -> Type) where\n   type Ob c :: k -> Constraint\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies #-}\nmodule T7805 where\n\ndata HigherRank = HR (forall a. a -> a)\n\ntype family F (x :: HigherRank)\ntype instance F (HR x) = Bool\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, InstanceSigs, DataKinds, PolyKinds, RankNTypes, LambdaCase #-}\n\nmodule T7908 where\n\nimport Data.Kind (Type)\n\nclass Monad' (m :: (k -> Type) -> Type) where\n  return' :: c a -> m c\n  (>>>=) :: m c -> (forall a . c a -> m d) -> m d\n  (>>-) :: m c -> (forall a . c a -> d) -> d\n\n\ndata Nat = Z' | S' Nat\n\ndata Nat' (n :: Nat) where\n  Z :: Nat' Z'\n  S :: Nat' n -> Nat' (S' n)\n\ndata Hidden :: (k -> Type) -> Type where\n  Hide :: m a -> Hidden m\n\ninstance Monad' Hidden where\n  return' :: forall k (c :: k -> Type) (a :: k) . c a -> Hidden c\n  return' = Hide\n  (>>>=) :: forall k (c :: k -> Type) (d :: k -> Type) .\n            Hidden c -> (forall (a :: k) . c a -> Hidden d) -> Hidden d\n  Hide a >>>= f = f a\n  (>>-) :: forall k (c :: k -> Type) d .\n           Hidden c -> (forall (a :: k) . c a -> d) -> d\n  Hide a >>- f = f a\n\n\nint2nat' 0 = return' Z\nint2nat' i = (int2nat' $ i - 1) >>>= (\\n -> return' $ S n)\n\n\ndata Fin (m :: Nat)  (n :: Nat) where\n  Fz :: Fin (S' m) Z'\n  Fs :: Fin m n -> Fin (S' m) (S' n)\n\n-- N.B. not total!\nnat2fin :: Nat' f -> Hidden Nat' -> Hidden (Fin f)\nnat2fin (S _) (Hide Z) = return' Fz\nnat2fin (S f) n = n >>>= (\\case S n -> (nat2fin f (return' n) >>>= (\\fn -> return' $ Fs fn)))\n\nfin2int :: Hidden (Fin f) -> Int\nfin2int f = f >>- go\n  where go :: Fin f n -> Int\n        go Fz = 0\n        go (Fs f) = 1 + go f\n\n\ntest = fin2int (nat2fin (S $ S Z) $ return' (S Z))\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, ExplicitForAll #-}\nmodule T7916 where\n\nimport Data.Kind (Type)\n\nf :: forall k (m :: k -> Type) (a :: k). m a -> m a\nf = id\n\n-- g :: forall (m :: k -> Type) (a :: k). m a -> m a\ng x = f x\n\ndata M f = M (f Int)\n\n-- Test that g :: forall (m :: k -> Type) (a :: k). m a -> m a\ng1 = g :: [Int] -> [Int]\ng2 = g :: M [] -> M []\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\n\nmodule T7939a where\n\ntype family F a where\n  F Int = Bool\n  F Maybe = Char\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, KindSignatures #-}\n{-# LANGUAGE ExistentialQuantification, UndecidableInstances, TypeFamilies #-}\n\nmodule Test where\n\nimport Data.Kind (Type)\n\n-- Kind-level proxies.\ndata {-kind-} K (a :: Type) = KP\n\n-- A type with 1 kind-polymorphic type argument.\ndata T (n :: k)\n\n-- A type with 1 kind argument.\ndata F (kp :: K k)\n\n-- A class with 1 kind argument.\nclass (kp ~ KP) => C (kp :: K k) where\n  f :: T (a :: k) -> F kp\n\n-- A type with 1 kind argument.\n-- Contains an existentially quantified type-variable of this kind.\ndata SomeT (kp :: K k) = forall (n :: k). Mk (T n)\n\n-- Show `SomeT` by converting it to `F`, using `C`.\ninstance (C kp, Show (F kp)) => Show (SomeT kp) where\n  show (Mk x) = show (f x)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nimport Data.Typeable\n\ndata K = K\n\n-- This used to have a RHS but now we hide typeRep#\ninstance Typeable K -- where typeRep# _ = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ConstraintKinds, MultiParamTypeClasses #-}\n\nmodule T8359 where\n\nclass DifferentTypes a b\n\ntype DifferentTypes3 a b c = (DifferentTypes a b, DifferentTypes b c, DifferentTypes a c)\n\nclass Foo a\n\nclass Bar a\n\n-- Buggy instance requires UndecidableInstances to compile\n\ninstance (DifferentTypes3 a b c, Bar a, Bar b, Bar c) => Foo (a, b, c)\n\n-- Equivalent instance compiles when manually expanding constraint type\n-- instance (DifferentTypes a b, DifferentTypes b c, DifferentTypes a c, Bar a, Bar b, Bar c) => Foo (a, b, c)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies, FlexibleInstances, \n             TypeFamilies,\n             PolyKinds #-}\n\nmodule T8391 where\n\ntype  Foo a = a\n\nclass Bar a b | a -> b\n\ninstance Bar a (Foo a)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE GADTs, PolyKinds, DataKinds, TypeFamilies #-}\n\nmodule T8449 where\n\nimport T8449a\n\nfoo = SNil\n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies, DataKinds, PolyKinds #-}\n\nmodule T8449a where\n\ndata Lst a = Nil | Cons a (Lst a)\n\ndata family SList (a :: k)\ndata instance SList (a :: Lst k) where\n   SNil :: SList 'Nil\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, PolyKinds #-}\nmodule T8534 where\ndata A a = A deriving Functor\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}  -- 'c' is ambiguous\n\nmodule T8566 where\n\nimport Data.Kind (Type)\n\ndata U (s :: Type) = forall v. AA v [U s]\n-- AA :: forall (s:*) (v:*). v -> [U s] -> U s\n\ndata I (u :: U Type) (r :: [Type]) :: Type where\n   A :: I (AA t as) r                  -- Existential k\n\n-- A :: forall (u:U *) (r:[*])                  Universal\n--             (k:BOX) (t:k) (as:[U *]).        Existential\n--             (u ~ AA * k t as) =>\n--             I u r\n\n-- fs unused, but needs to be present for the bug\nclass C (u :: U Type) (r :: [Type]) (fs :: [Type]) where\n   c :: I u r -> I u r\n\n-- c :: forall (u :: U *) (r :: [*]) (fs :: [*]). C u r fs => I u r -> I u r\n\ninstance (C (AA (t (I a ps)) as) ps fs) => C (AA t (a ': as)) ps fs where\n-- instance C (AA t (a ': as)) ps fs where\n  c A = c undefined\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                  #-}\n{-# LANGUAGE PolyKinds                  #-}\n{-# LANGUAGE TypeFamilies               #-}\n{-# LANGUAGE GADTs                      #-}\n{-# LANGUAGE ScopedTypeVariables        #-}\n{-# LANGUAGE TypeOperators              #-}\nmodule T8566a where\n\nimport Data.Kind (Type)\n\ndata Field = forall k. APP k [Field]\n\ndata InField (u :: Field) :: Type where\n  A :: AppVars t (ExpandField args) -> InField (APP t args)\n\ntype family ExpandField (args :: [Field]) :: [Type]\ntype family AppVars (t :: k) (vs :: [Type]) :: Type\n\n-- This function fails to compile, because we discard\n-- 'given' kind equalities.  See comment 7 in Trac #8566\n-- This is really a bug, I claim\nunA :: InField (APP t args) -> AppVars t (ExpandField args)\nunA (A x) = x\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, RankNTypes, ScopedTypeVariables #-}\nmodule T8616 where\n\nimport Data.Proxy\nimport GHC.Exts\n\nwithSomeSing :: forall k (kproxy :: k). Proxy kproxy\nwithSomeSing = undefined :: (Any :: k)\n  -- The 'k' is bought into scope by the type signature\n  -- This is a type error, but should not crash GHC\n\nfoo = (undefined :: Proxy (a :: k)) :: forall k (a :: k). Proxy a\n  -- Again, the 'k' is bought into scope by the type signature\n  -- No type error though\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, DataKinds, PolyKinds,\n             MultiParamTypeClasses, GADTs, ConstraintKinds, TypeFamilies #-}\nmodule T8705 where\n\ndata family Sing (a :: k)\ndata Proxy a = Proxy\n\ndata instance Sing (a :: Maybe k) where\n  SJust :: Sing h -> Sing (Just h)\n\ndata Dict c where\n  Dict :: c => Dict c\n\n-- A less-than-or-equal relation among naturals\nclass a :<=: b\n\nsLeq :: Sing n -> Sing n2 -> Dict (n :<=: n2)\nsLeq = undefined\n\ninsert_ascending :: (lst ~ Just n1) => Proxy n1 -> Sing n -> Sing lst -> Dict (n :<=: n1)\ninsert_ascending _ n (SJust h)\n  = case sLeq n h of\n      Dict -> Dict\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators #-}\n\nmodule T8985 where\n\nimport Data.Kind (Type)\n\ndata X (xs :: [k]) = MkX\ndata Y :: (k -> Type) -> [k] -> Type where\n  MkY :: f x -> Y f (x ': xs)\n\ntype family F (a :: [[Type]]) :: Type\ntype instance F xss = Y X xss\n\nworks :: Y X '[ '[ ] ] -> ()\nworks (MkY MkX) = ()\n\nfails :: F '[ '[ ] ] -> ()\nfails (MkY MkX) = ()\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T9017 where\n\nimport Control.Arrow\n\nfoo :: a b (m b)\nfoo = arr return\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators,\n             UndecidableInstances #-}\n\nmodule T9063 where\n\nimport Data.Type.Equality\nimport Data.Proxy\n\nclass kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where\n  type (:==) (x :: a) (y :: a) :: Bool\n  type x :== y = x == y\n\ninstance PEq ('KProxy :: KProxy Bool)\n\nfoo :: Proxy (True :== True) -> Proxy (True == True)\nfoo = id\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, DataKinds, FunctionalDependencies,\n   KindSignatures, PolyKinds, FlexibleInstances, FlexibleContexts,\n   UndecidableInstances #-}\n\nmodule T9106 where\n\nimport GHC.TypeLits\n\nclass FunctorN (n :: Nat) f (a :: *) (fa :: *) | n f a -> fa where\n\ninstance FunctorN 0 f a a where\n\ninstance FunctorN n f a (f fa)\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, GADTs, RankNTypes #-}\n\nmodule T9144 where\n\nimport Data.Proxy\nimport GHC.TypeLits\n\ndata family Sing (a :: k)\n\ndata SomeSing :: KProxy k -> * where\n  SomeSing :: forall k (a :: k). Sing a -> SomeSing ('KProxy :: KProxy k)\n\nclass kproxy ~ 'KProxy => SingKind (kproxy :: KProxy k) where\n  fromSing :: forall (a :: k). Sing a -> DemoteRep ('KProxy :: KProxy k)\n  toSing :: DemoteRep ('KProxy :: KProxy k) -> SomeSing ('KProxy :: KProxy k)\n\ntype family DemoteRep (kproxy :: KProxy k) :: *\n\ndata Foo = Bar Nat\ndata FooTerm = BarTerm Integer\n\ndata instance Sing (x :: Foo) where\n  SBar :: Sing n -> Sing (Bar n)\n\ntype instance DemoteRep ('KProxy :: KProxy Nat) = Integer\ntype instance DemoteRep ('KProxy :: KProxy Foo) = FooTerm\n\ninstance SingKind ('KProxy :: KProxy Nat) where\n  fromSing = undefined\n  toSing = undefined\n\ninstance SingKind ('KProxy :: KProxy Foo) where\n  fromSing (SBar n) = BarTerm (fromSing n)\n  toSing n = case toSing n of SomeSing n' -> SomeSing (SBar n')\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds,\n             TypeFamilies #-}\n\nmodule T9200 where\n\nimport Data.Kind (Type)\nimport Data.Proxy\n\n------\n-- test CUSK on classes\n\nclass C (f :: k) (a :: k2) where\n  c_meth :: D a => Proxy f -> Proxy a -> ()\n  \nclass C () a => D a\n\n\n---------\n--- test CUSK on type synonyms\ndata T1 a b c = MkT1 (S True b c)\ndata T2 p q r = MkT2 (S p 5 r)\ndata T3 x y q = MkT3 (S x y '())\ntype S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: Type)\n\n\n----------\n-- test CUSK on closed type families\ntype family F (a :: k) :: k where\n  F True = False\n  F False = True\n  F x = x\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-}\n\nmodule T9200b where\n\n---------\n--- test CUSK on closed type families\ntype family F (a :: k) where\n  F True = False\n  F False = True\n  F x = x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, GADTs, DataKinds, PolyKinds, TypeOperators, TypeFamilies #-}\nmodule T9222 where\n\nimport Data.Kind\nimport Data.Proxy\n\n-- Nov 2014: actually the type of Want is ambiguous if we\n--           do the full co/contra thing for subtyping,\n--           which we now do\n-- So this program is erroneous.  (But the original ticket was\n-- a crash, and that's still fixed!)\n\ndata Want :: (i,j) -> Type where\n  Want :: (a ~ '(b,c) => Proxy b) -> Want a\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9263 where\n  import T9263a\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, KindSignatures, TypeFamilies #-}\nmodule T9263a where\n\nimport T9263b\nimport Data.Proxy\n\ndata Void\n\ninstance PEq ('KProxy :: KProxy Void)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-}\nmodule T9263b where\n\nimport Data.Proxy\n\nclass kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where\n   type F (x :: a) :: Bool\n   type F (x :: a) = False\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, ScopedTypeVariables #-}\nmodule T9264 where\n\nclass C (a :: k) where\n   type F (a :: k)\n   type F (a :: k) = Int\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes, ConstraintKinds, KindSignatures, DataKinds, TypeFamilies #-}\nmodule T9569 where\n\nimport GHC.Exts\n\ndata Proxy (c :: Constraint)\n\nclass Deferrable (c :: Constraint) where\n  defer :: Proxy c -> (c => a) -> a\n\ndeferPair :: (Deferrable c1, Deferrable c2) =>\n                  Proxy (c1,c2) -> ((c1,c2) => a) -> a\ndeferPair = undefined\n\ninstance (Deferrable c1, Deferrable c2) => Deferrable (c1,c2) where\n    -- defer p f = deferPair p f     -- Succeeds\n    defer = deferPair                -- Fails\n\n{-\n  [G] Deferrable c1, Deferrable c2\n\n  [W] Proxy (c1,c2) -> ((c1,c2) => a) -> a ~ Proxy (c1x,c2x) -> ((c1x,c2x) => ax) -> ax\n  [w] Deferrable c1x\n  [w] Deferrable c2x\n-}\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, ScopedTypeVariables, GADTs, RankNTypes #-}\nmodule T9574 where\n\nimport Data.Kind (Type)\n\ndata KProxy (t :: Type) = KProxy\ndata Proxy p\n\nclass Funct f where\n    type Codomain f :: Type\n\ninstance Funct ('KProxy :: KProxy o) where\n    type Codomain 'KProxy = NatTr (Proxy :: o -> Type)\n\ndata NatTr (c :: o -> Type) where\n    M :: (forall (a :: o). Proxy a) -> NatTr (c :: o -> Type)\n\np :: forall o (c :: o -> Type). NatTr c\np = M t where\n    M t = undefined :: Codomain ('KProxy :: KProxy o)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DataKinds, KindSignatures, PolyKinds, FlexibleContexts, RankNTypes, ScopedTypeVariables #-}\nmodule T9725 where\n\nimport Data.Kind (Type)\n\ndata En = M Bool\nclass Kn (l :: En)\n\ninstance Kn (M b)\n\ndata Fac :: En -> Type where\n  Mo :: Kn (M b) => Fac (M b)\n\ndata Fm :: Type -> Type where\n  HiF :: Kn (ent b) => Fm (Fac (ent b)) -> Fm (O ent)\n  MoF :: Kn (M b) => Fm (Fac (M b))\n\ndata O :: (k -> En) -> Type where\n  Hi :: Fac (ent k) -> O ent\n\ndata Co :: (Type -> Type) -> Type -> Type where\n  Ab :: (t -> f t) -> Co f t\n\n-- Restricted kind signature:\n--test :: forall (ent :: Bool -> En) . (forall i . Kn (ent i) => Fm (Fac (ent i))) -> Co Fm (O ent)\n\ntest :: forall ent . (forall i . Kn (ent i) => Fm (Fac (ent i))) -> Co Fm (O ent)\ntest de = Ab h\n    where h :: O ent -> Fm (O ent)\n          h (Hi m@Mo) = HiF (d m)\n          d :: Kn (ent i) => Fac (ent i) -> Fm (Fac (ent i))\n          d _ = de\n\n{-\n9725.hs:27:25:\n    Could not deduce (Kn (ent k1)) arising from a use of \u00e2\u20ac\u02dcHiF\u00e2\u20ac\u2122\n    from the context (ent k1 ~ 'M b, Kn ('M b))\n      bound by a pattern with constructor\n                 Mo :: forall (b :: Bool). Kn ('M b) => Fac ('M b),\n               in an equation for \u00e2\u20ac\u02dch\u00e2\u20ac\u2122\n      at 9725.hs:27:19-20\n    In the expression: HiF (d m)\n    In an equation for \u00e2\u20ac\u02dch\u00e2\u20ac\u2122: h (Hi m@Mo) = HiF (d m)\n    In an equation for \u00e2\u20ac\u02dctest\u00e2\u20ac\u2122:\n        test de\n          = Ab h\n          where\n              h :: O ent -> Fm (O ent)\n              h (Hi m@Mo) = HiF (d m)\n              d :: Kn (ent i) => Fac (ent i) -> Fm (Fac (ent i))\n              d _ = de\nFailed, modules loaded: none.\n-}\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleInstances      #-}\n{-# LANGUAGE TypeFamilies           #-}\n{-# LANGUAGE DataKinds              #-}\n{-# LANGUAGE ScopedTypeVariables    #-}\n\nmodule T9750 where\n\nimport Data.Kind (Type)\nimport GHC.TypeLits ( Symbol, KnownSymbol )\n\n--------------------------------------------------------------------------------\n\ndata Meta = MetaCons Symbol\ndata M1 (c :: Meta) = M1\n\nclass Generic a where\n  type Rep a :: Type\n  from  :: a -> Rep a\n\n--------------------------------------------------------------------------------\n\ndata A = A1\n\ninstance Generic A where\n  type Rep A = M1 ('MetaCons \"test\")\n  from A1 = M1\n\nclass GShow' f where\n  gshowsPrec' :: f -> ShowS\n\ninstance (KnownSymbol c) => GShow' (M1 ('MetaCons c)) where\n  gshowsPrec' = error \"urk\"\n\ninstance GShow' A where\n  gshowsPrec' = gshowsPrec' . from\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs, PolyKinds #-}\n\nmodule T9833 where\n\nimport Control.Applicative\n\ndata NullableInterp a = NullI Bool\n\ninstance Functor     NullableInterp where\n  fmap = undefined\ninstance Applicative NullableInterp where\n  pure  = undefined\n  (<*>) = undefined\n\ninstance Alternative NullableInterp where\n  empty :: NullableInterp a\n  empty = undefined\n  (<|>) = undefined", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9838 where\n\nimport T9838a\n\nfoo :: EqShow a => a -> String\nfoo x = show x ++ show (x == x)\n\nbar :: F Int -> Bool\nbar x = x", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds #-}\n\nmodule T9838a where\n\ntype EqShow a = (Eq a, Show a)\n\ntype family F a\ntype instance F Int = Bool", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, PolyKinds #-}\n{-# OPTIONS_GHC -fprint-explicit-kinds #-}\n\nmodule TidyClassKinds where\n\nimport Data.Proxy\n\nclass Poly a b\n\ntype ProxySyn = Proxy\n\ninstance Poly ProxySyn ProxySyn\n  -- output should really talk about k1 and k2, not about k and k!\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule TyVarTvKinds where\n\ndata T (a :: k1) x = MkT (S a ())\ndata S (b :: k2) y = MkS (T b ())\n  -- tests TcTyClsDecls.no_sig_tv\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule TyVarTvKinds2 where\n\ndata SameKind :: k -> k -> *\n\ndata Q (a :: k1) (b :: k2) c = MkQ (SameKind a b)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExplicitForAll, PolyKinds #-}\n\nmodule TyVarTvKinds3 where\n\nimport Data.Kind\n\ndata SameKind :: k -> k -> Type\ndata Bad a where\n  MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T16293a where\n\nimport Data.Coerce\nimport Data.Proxy\nimport GHC.Exts\n\ntest1a :: () -> Proxy Int\ntest1a _ = Proxy @Int\n\ntest1b :: () -> Proxy# Int\ntest1b _ = proxy# @Int\n\ntest2a :: (() -> Proxy a) -> (() -> Proxy b)\ntest2a = coerce\n\ntest2b :: (() -> Proxy# a) -> (() -> Proxy# b)\ntest2b = coerce\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests created by Jan Stolarek <jan.stolarek@p.lodz.pl>\n\n{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n  print (h 3.0##)\n  print g\n  print 3.14159\n\nh :: Double# -> String\nh n = if tagToEnum# (n ==## 3.0##) || tagToEnum# (n ==## 4.0##)\n      then \"First branch\"\n      else \"Second branch\"\n\ng :: String\ng = if ((fromInteger 1 :: Integer) == 1)\n    then \"First branch\"\n    else \"Second branch\"\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\nimport Data.Int\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n\n    --\n    -- Check if passing Int16# on the stack works (16 parameter function will\n    -- need to use stack for some of the them)\n    --\n    let input =\n            [ ( (a + 0), (a + 1), (a + 2), (a + 3),\n                (a + 4), (a + 5), (a + 6), (a + 7),\n                (a + 8), (a + 9), (a + 10), (a + 11),\n                (a + 12), (a + 13), (a + 14), (a + 15) )\n            | a <- allInt16\n            ]\n        expected =\n            [ toInt16\n                  (a + b + c + d + e + f + g + h +\n                   i + j + k + l + m + n + o + p)\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n        actual =\n            [ addMany a b c d e f g h i j k l m n o p\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n    checkResults \"passing Int16# on the stack\" input expected actual\n\n    --\n    -- negateInt16#\n    --\n    let input = allInt16\n        expected = [ toInt16 (negate a) | a <- input ]\n        actual = [ apply1 negateInt16# a | a <- input ]\n    checkResults \"negateInt16#\" input expected actual\n\n    --\n    -- plusInt16#\n    --\n    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]\n        expected = [ toInt16 (a + b) | (a, b) <- input ]\n        actual = [ apply2 plusInt16# a b | (a, b) <- input ]\n    checkResults \"plusInt16#\" input expected actual\n\n    -- --\n    -- -- subInt16#\n    -- --\n    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]\n        expected = [ toInt16 (a - b) | (a, b) <- input ]\n        actual = [ apply2 subInt16# a b | (a, b) <- input ]\n    checkResults \"subInt16#\" input expected actual\n\n    --\n    -- timesInt16#\n    --\n    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]\n        expected = [ toInt16 (a * b) | (a, b) <- input ]\n        actual = [ apply2 timesInt16# a b | (a, b) <- input ]\n    checkResults \"timesInt16#\" input expected actual\n\n    --\n    -- remInt16#\n    --\n    let input =\n            [ (a, b) | a <- allInt16, b <- allInt16\n            -- Don't divide by 0 or cause overflow\n            , b /= 0, not (a == -32768 && b == -1)\n            ]\n        expected = [ toInt16 (a `rem` b) | (a, b) <- input ]\n        actual = [ apply2 remInt16# a b | (a, b) <- input ]\n    checkResults \"remInt16#\" input expected actual\n\n    --\n    -- quotInt16#\n    --\n    let input =\n            [ (a, b) | a <- allInt16, b <- allInt16\n            , b /= 0, not (a == -32768 && b == -1)\n            ]\n        expected = [ toInt16 (a `quot` b) | (a, b) <- input ]\n        actual = [ apply2 quotInt16# a b | (a, b) <- input ]\n    checkResults \"quotInt16#\" input expected actual\n\n    --\n    -- quotRemInt16#\n    --\n    let input =\n            [ (a, b) | a <- allInt16, b <- allInt16\n            , b /= 0, not (a == -32768 && b == -1)\n            ]\n        expected =\n            [ (toInt16 q, toInt16 r)  | (a, b) <- input\n            , let (q, r) = a `quotRem` b\n            ]\n        actual = [ apply3 quotRemInt16# a b | (a, b) <- input ]\n    checkResults \"quotRemInt16#\" input expected actual\n\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\n-- testing across the entire Int16 range blows the memory,\n-- hence choosing a smaller range\nallInt16 :: [Int]\nallInt16 = [ -50 .. 50 ]\n\ntoInt16 :: Int -> Int\ntoInt16 a = fromIntegral (fromIntegral a :: Int16)\n\naddMany#\n    :: Int16# -> Int16# -> Int16# -> Int16#\n    -> Int16# -> Int16# -> Int16# -> Int16#\n    -> Int16# -> Int16# -> Int16# -> Int16#\n    -> Int16# -> Int16# -> Int16# -> Int16#\n    -> Int16#\naddMany# a b c d e f g h i j k l m n o p =\n    a `plusInt16#` b `plusInt16#` c `plusInt16#` d `plusInt16#`\n    e `plusInt16#` f `plusInt16#` g `plusInt16#` h `plusInt16#`\n    i `plusInt16#` j `plusInt16#` k `plusInt16#` l `plusInt16#`\n    m `plusInt16#` n `plusInt16#` o `plusInt16#` p\n{-# NOINLINE addMany# #-}\n\naddMany\n    :: Int -> Int -> Int -> Int\n    -> Int -> Int -> Int -> Int\n    -> Int -> Int -> Int -> Int\n    -> Int -> Int -> Int -> Int\n    -> Int\naddMany (I# a) (I# b) (I# c) (I# d)\n        (I# e) (I# f) (I# g) (I# h)\n        (I# i) (I# j) (I# k) (I# l)\n        (I# m) (I# n) (I# o) (I# p)\n            = I# (extendInt16# int16)\n  where\n    !int16 = addMany#\n                (narrowInt16# a) (narrowInt16# b) (narrowInt16# c) (narrowInt16# d)\n                (narrowInt16# e) (narrowInt16# f) (narrowInt16# g) (narrowInt16# h)\n                (narrowInt16# i) (narrowInt16# j) (narrowInt16# k) (narrowInt16# l)\n                (narrowInt16# m) (narrowInt16# n) (narrowInt16# o) (narrowInt16# p)\n{-# NOINLINE addMany #-}\n\n-- Convenient and also tests higher order functions on Int16#\napply1 :: (Int16# -> Int16#) -> Int -> Int\napply1 opToTest (I# a) = I# (extendInt16# (opToTest (narrowInt16# a)))\n{-# NOINLINE apply1 #-}\n\napply2 :: (Int16# -> Int16# -> Int16#) -> Int -> Int -> Int\napply2 opToTest (I# a) (I# b) =\n    let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #)\n        r = opToTest sa sb\n    in I# (extendInt16# r)\n{-# NOINLINE apply2 #-}\n\napply3 :: (Int16# -> Int16# -> (# Int16#, Int16# #)) -> Int -> Int -> (Int, Int)\napply3 opToTest (I# a) (I# b) =\n    let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #)\n        (# ra, rb #) = opToTest sa sb\n    in (I# (extendInt16# ra), I# (extendInt16# rb))\n{-# NOINLINE apply3 #-}\n\ninstance\n        (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h,\n         Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p)\n      => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) ==\n        (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) =\n            a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 &&\n            e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 &&\n            i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 &&\n            m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2\n\ninstance\n        (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,\n         Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p)\n      => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) =\n        \"(\" ++ show a ++ \",\" ++ show b ++ \",\" ++ show c ++ \",\" ++ show d ++\n        \",\" ++ show e ++ \",\" ++ show f ++ \",\" ++ show g ++ \",\" ++ show h ++\n        \",\" ++ show i ++ \",\" ++ show j ++ \",\" ++ show k ++ \",\" ++ show l ++\n        \",\" ++ show m ++ \",\" ++ show n ++ \",\" ++ show o ++ \",\" ++ show p ++\n        \")\"\n", "num_lines": 198}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\nimport Data.Int\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n\n    --\n    -- Check if passing Int8# on the stack works (16 parameter function will\n    -- need to use stack for some of the them)\n    --\n    let input =\n            [ ( (a + 0), (a + 1), (a + 2), (a + 3),\n                (a + 4), (a + 5), (a + 6), (a + 7),\n                (a + 8), (a + 9), (a + 10), (a + 11),\n                (a + 12), (a + 13), (a + 14), (a + 15) )\n            | a <- allInt8\n            ]\n        expected =\n            [ toInt8\n                  (a + b + c + d + e + f + g + h +\n                   i + j + k + l + m + n + o + p)\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n        actual =\n            [ addMany a b c d e f g h i j k l m n o p\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n    checkResults \"passing Int8# on the stack\" input expected actual\n\n    --\n    -- negateInt8#\n    --\n    let input = allInt8\n        expected = [ toInt8 (negate a) | a <- input ]\n        actual = [ apply1 negateInt8# a | a <- input ]\n    checkResults \"negateInt8#\" input expected actual\n\n    --\n    -- plusInt8#\n    --\n    let input = [ (a, b) | a <- allInt8, b <- allInt8 ]\n        expected = [ toInt8 (a + b) | (a, b) <- input ]\n        actual = [ apply2 plusInt8# a b | (a, b) <- input ]\n    checkResults \"plusInt8#\" input expected actual\n\n    --\n    -- subInt8#\n    --\n    let input = [ (a, b) | a <- allInt8, b <- allInt8 ]\n        expected = [ toInt8 (a - b) | (a, b) <- input ]\n        actual = [ apply2 subInt8# a b | (a, b) <- input ]\n    checkResults \"subInt8#\" input expected actual\n\n    --\n    -- timesInt8#\n    --\n    let input = [ (a, b) | a <- allInt8, b <- allInt8 ]\n        expected = [ toInt8 (a * b) | (a, b) <- input ]\n        actual = [ apply2 timesInt8# a b | (a, b) <- input ]\n    checkResults \"timesInt8#\" input expected actual\n\n    --\n    -- remInt8#\n    --\n    let input =\n            [ (a, b) | a <- allInt8, b <- allInt8\n            -- Don't divide by 0 or cause overflow\n            , b /= 0, not (a == -128 && b == -1)\n            ]\n        expected = [ toInt8 (a `rem` b) | (a, b) <- input ]\n        actual = [ apply2 remInt8# a b | (a, b) <- input ]\n    checkResults \"remInt8#\" input expected actual\n\n    --\n    -- quotInt8#\n    --\n    let input =\n            [ (a, b) | a <- allInt8, b <- allInt8\n            , b /= 0, not (a == -128 && b == -1)\n            ]\n        expected = [ toInt8 (a `quot` b) | (a, b) <- input ]\n        actual = [ apply2 quotInt8# a b | (a, b) <- input ]\n    checkResults \"quotInt8#\" input expected actual\n\n    --\n    -- quotRemInt8#\n    --\n    let input =\n            [ (a, b) | a <- allInt8, b <- allInt8\n            , b /= 0, not (a == -128 && b == -1)\n            ]\n        expected =\n            [ (toInt8 q, toInt8 r)  | (a, b) <- input\n            , let (q, r) = a `quotRem` b\n            ]\n        actual = [ apply3 quotRemInt8# a b | (a, b) <- input ]\n    checkResults \"quotRemInt8#\" input expected actual\n\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\nallInt8 :: [Int]\nallInt8 = [ minInt8 .. maxInt8 ]\n\nminInt8 :: Int\nminInt8 = fromIntegral (minBound :: Int8)\n\nmaxInt8 :: Int\nmaxInt8 = fromIntegral (maxBound :: Int8)\n\ntoInt8 :: Int -> Int\ntoInt8 a = fromIntegral (fromIntegral a :: Int8)\n\naddMany#\n    :: Int8# -> Int8# -> Int8# -> Int8#\n    -> Int8# -> Int8# -> Int8# -> Int8#\n    -> Int8# -> Int8# -> Int8# -> Int8#\n    -> Int8# -> Int8# -> Int8# -> Int8#\n    -> Int8#\naddMany# a b c d e f g h i j k l m n o p =\n    a `plusInt8#` b `plusInt8#` c `plusInt8#` d `plusInt8#`\n    e `plusInt8#` f `plusInt8#` g `plusInt8#` h `plusInt8#`\n    i `plusInt8#` j `plusInt8#` k `plusInt8#` l `plusInt8#`\n    m `plusInt8#` n `plusInt8#` o `plusInt8#` p\n{-# NOINLINE addMany# #-}\n\naddMany\n    :: Int -> Int -> Int -> Int\n    -> Int -> Int -> Int -> Int\n    -> Int -> Int -> Int -> Int\n    -> Int -> Int -> Int -> Int\n    -> Int\naddMany (I# a) (I# b) (I# c) (I# d)\n        (I# e) (I# f) (I# g) (I# h)\n        (I# i) (I# j) (I# k) (I# l)\n        (I# m) (I# n) (I# o) (I# p)\n            = I# (extendInt8# int8)\n  where\n    !int8 = addMany#\n                (narrowInt8# a) (narrowInt8# b) (narrowInt8# c) (narrowInt8# d)\n                (narrowInt8# e) (narrowInt8# f) (narrowInt8# g) (narrowInt8# h)\n                (narrowInt8# i) (narrowInt8# j) (narrowInt8# k) (narrowInt8# l)\n                (narrowInt8# m) (narrowInt8# n) (narrowInt8# o) (narrowInt8# p)\n{-# NOINLINE addMany #-}\n\n-- Convenient and also tests higher order functions on Int8#\napply1 :: (Int8# -> Int8#) -> Int -> Int\napply1 opToTest (I# a) = I# (extendInt8# (opToTest (narrowInt8# a)))\n{-# NOINLINE apply1 #-}\n\napply2 :: (Int8# -> Int8# -> Int8#) -> Int -> Int -> Int\napply2 opToTest (I# a) (I# b) =\n    let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #)\n        r = opToTest sa sb\n    in I# (extendInt8# r)\n{-# NOINLINE apply2 #-}\n\napply3 :: (Int8# -> Int8# -> (# Int8#, Int8# #)) -> Int -> Int -> (Int, Int)\napply3 opToTest (I# a) (I# b) =\n    let (# sa, sb #) = (# narrowInt8# a, narrowInt8# b #)\n        (# ra, rb #) = opToTest sa sb\n    in (I# (extendInt8# ra), I# (extendInt8# rb))\n{-# NOINLINE apply3 #-}\n\ninstance\n        (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h,\n         Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p)\n      => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) ==\n        (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) =\n            a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 &&\n            e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 &&\n            i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 &&\n            m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2\n\ninstance\n        (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,\n         Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p)\n      => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) =\n        \"(\" ++ show a ++ \",\" ++ show b ++ \",\" ++ show c ++ \",\" ++ show d ++\n        \",\" ++ show e ++ \",\" ++ show f ++ \",\" ++ show g ++ \",\" ++ show h ++\n        \",\" ++ show i ++ \",\" ++ show j ++ \",\" ++ show k ++ \",\" ++ show l ++\n        \",\" ++ show m ++ \",\" ++ show n ++ \",\" ++ show o ++ \",\" ++ show p ++\n        \")\"\n", "num_lines": 202}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\nimport Data.Word\nimport Data.Bits\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n\n    --\n    -- Check if passing Word16# on the stack works (16 parameter function will\n    -- need to use stack for some of the them)\n    --\n    let input =\n            [ ( (a + 0), (a + 1), (a + 2), (a + 3),\n                (a + 4), (a + 5), (a + 6), (a + 7),\n                (a + 8), (a + 9), (a + 10), (a + 11),\n                (a + 12), (a + 13), (a + 14), (a + 15) )\n            | a <- allWord16\n            ]\n        expected =\n            [ toWord16\n                  (a + b + c + d + e + f + g + h +\n                   i + j + k + l + m + n + o + p)\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n        actual =\n            [ addMany a b c d e f g h i j k l m n o p\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n    checkResults \"passing Word16# on the stack\" input expected actual\n\n    --\n    -- notWord16#\n    --\n    let input = allWord16\n        expected = [ toWord16 (complement a) | a <- input ]\n        actual = [ apply1 notWord16# a | a <- input ]\n    checkResults \"notWord16#\" input expected actual\n\n    --\n    -- plusWord16#\n    --\n    let input = [ (a, b) | a <- allWord16, b <- allWord16 ]\n        expected = [ toWord16 (a + b) | (a, b) <- input ]\n        actual = [ apply2 plusWord16# a b | (a, b) <- input ]\n    checkResults \"plusWord16#\" input expected actual\n\n    --\n    -- subWord16#\n    --\n    let input = [ (a, b) | a <- allWord16, b <- allWord16 ]\n        expected = [ toWord16 (a - b) | (a, b) <- input ]\n        actual = [ apply2 subWord16# a b | (a, b) <- input ]\n    checkResults \"subWord16#\" input expected actual\n\n    --\n    -- timesWord16#\n    --\n    let input = [ (a, b) | a <- allWord16, b <- allWord16 ]\n        expected = [ toWord16 (a * b) | (a, b) <- input ]\n        actual = [ apply2 timesWord16# a b | (a, b) <- input ]\n    checkResults \"timesWord16#\" input expected actual\n\n    --\n    -- remWord16#\n    --\n    let input =\n            -- Don't divide by 0.\n            [ (a, b) | a <- allWord16, b <- allWord16 , b /= 0 ]\n        expected = [ toWord16 (a `rem` b) | (a, b) <- input ]\n        actual = [ apply2 remWord16# a b | (a, b) <- input ]\n    checkResults \"remWord16#\" input expected actual\n\n    --\n    -- quotWord16#\n    --\n    let input =\n            [ (a, b) | a <- allWord16, b <- allWord16, b /= 0 ]\n        expected = [ toWord16 (a `quot` b) | (a, b) <- input ]\n        actual = [ apply2 quotWord16# a b | (a, b) <- input ]\n    checkResults \"quotWord16#\" input expected actual\n\n    --\n    -- quotRemWord16#\n    --\n    let input =\n            [ (a, b) | a <- allWord16, b <- allWord16, b /= 0 ]\n        expected =\n            [ (toWord16 q, toWord16 r)  | (a, b) <- input\n            , let (q, r) = a `quotRem` b\n            ]\n        actual = [ apply3 quotRemWord16# a b | (a, b) <- input ]\n    checkResults \"quotRemWord16#\" input expected actual\n\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\n-- testing across the entire Word16 range blows the memory,\n-- hence choosing a smaller range\nallWord16 :: [Word]\nallWord16 = [ 0 .. 100 ]\n\ntoWord16 :: Word -> Word\ntoWord16 a = fromIntegral (fromIntegral a :: Word16)\n\naddMany#\n    :: Word16# -> Word16# -> Word16# -> Word16#\n    -> Word16# -> Word16# -> Word16# -> Word16#\n    -> Word16# -> Word16# -> Word16# -> Word16#\n    -> Word16# -> Word16# -> Word16# -> Word16#\n    -> Word16#\naddMany# a b c d e f g h i j k l m n o p =\n    a `plusWord16#` b `plusWord16#` c `plusWord16#` d `plusWord16#`\n    e `plusWord16#` f `plusWord16#` g `plusWord16#` h `plusWord16#`\n    i `plusWord16#` j `plusWord16#` k `plusWord16#` l `plusWord16#`\n    m `plusWord16#` n `plusWord16#` o `plusWord16#` p\n{-# NOINLINE addMany# #-}\n\naddMany\n    :: Word -> Word -> Word -> Word\n    -> Word -> Word -> Word -> Word\n    -> Word -> Word -> Word -> Word\n    -> Word -> Word -> Word -> Word\n    -> Word\naddMany (W# a) (W# b) (W# c) (W# d)\n        (W# e) (W# f) (W# g) (W# h)\n        (W# i) (W# j) (W# k) (W# l)\n        (W# m) (W# n) (W# o) (W# p)\n            = W# (extendWord16# word16)\n  where\n    !word16 =\n        addMany#\n            (narrowWord16# a) (narrowWord16# b) (narrowWord16# c) (narrowWord16# d)\n            (narrowWord16# e) (narrowWord16# f) (narrowWord16# g) (narrowWord16# h)\n            (narrowWord16# i) (narrowWord16# j) (narrowWord16# k) (narrowWord16# l)\n            (narrowWord16# m) (narrowWord16# n) (narrowWord16# o) (narrowWord16# p)\n{-# NOINLINE addMany #-}\n\n-- Convenient and also tests higher order functions on Word16#\napply1 :: (Word16# -> Word16#) -> Word -> Word\napply1 opToTest (W# a) = W# (extendWord16# (opToTest (narrowWord16# a)))\n{-# NOINLINE apply1 #-}\n\napply2 :: (Word16# -> Word16# -> Word16#) -> Word -> Word -> Word\napply2 opToTest (W# a) (W# b) =\n    let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #)\n        r = opToTest sa sb\n    in W# (extendWord16# r)\n{-# NOINLINE apply2 #-}\n\napply3\n  :: (Word16# -> Word16# -> (# Word16#, Word16# #)) -> Word -> Word -> (Word, Word)\napply3 opToTest (W# a) (W# b) =\n    let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #)\n        (# ra, rb #) = opToTest sa sb\n    in (W# (extendWord16# ra), W# (extendWord16# rb))\n{-# NOINLINE apply3 #-}\n\ninstance\n        (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h,\n         Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p)\n      => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) ==\n        (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) =\n            a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 &&\n            e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 &&\n            i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 &&\n            m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2\n\ninstance\n        (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,\n         Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p)\n      => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) =\n        \"(\" ++ show a ++ \",\" ++ show b ++ \",\" ++ show c ++ \",\" ++ show d ++\n        \",\" ++ show e ++ \",\" ++ show f ++ \",\" ++ show g ++ \",\" ++ show h ++\n        \",\" ++ show i ++ \",\" ++ show j ++ \",\" ++ show k ++ \",\" ++ show l ++\n        \",\" ++ show m ++ \",\" ++ show n ++ \",\" ++ show o ++ \",\" ++ show p ++\n        \")\"\n", "num_lines": 195}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\nimport Data.Word\nimport Data.Bits\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n\n    --\n    -- Check if passing Word8# on the stack works (16 parameter function will\n    -- need to use stack for some of the them)\n    --\n    let input =\n            [ ( (a + 0), (a + 1), (a + 2), (a + 3),\n                (a + 4), (a + 5), (a + 6), (a + 7),\n                (a + 8), (a + 9), (a + 10), (a + 11),\n                (a + 12), (a + 13), (a + 14), (a + 15) )\n            | a <- allWord8\n            ]\n        expected =\n            [ toWord8\n                  (a + b + c + d + e + f + g + h +\n                   i + j + k + l + m + n + o + p)\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n        actual =\n            [ addMany a b c d e f g h i j k l m n o p\n            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input\n            ]\n    checkResults \"passing Word8# on the stack\" input expected actual\n\n    --\n    -- notWord8#\n    --\n    let input = allWord8\n        expected = [ toWord8 (complement a) | a <- input ]\n        actual = [ apply1 notWord8# a | a <- input ]\n    checkResults \"notWord8#\" input expected actual\n\n    --\n    -- plusWord8#\n    --\n    let input = [ (a, b) | a <- allWord8, b <- allWord8 ]\n        expected = [ toWord8 (a + b) | (a, b) <- input ]\n        actual = [ apply2 plusWord8# a b | (a, b) <- input ]\n    checkResults \"plusWord8#\" input expected actual\n\n    --\n    -- subWord8#\n    --\n    let input = [ (a, b) | a <- allWord8, b <- allWord8 ]\n        expected = [ toWord8 (a - b) | (a, b) <- input ]\n        actual = [ apply2 subWord8# a b | (a, b) <- input ]\n    checkResults \"subWord8#\" input expected actual\n\n    --\n    -- timesWord8#\n    --\n    let input = [ (a, b) | a <- allWord8, b <- allWord8 ]\n        expected = [ toWord8 (a * b) | (a, b) <- input ]\n        actual = [ apply2 timesWord8# a b | (a, b) <- input ]\n    checkResults \"timesWord8#\" input expected actual\n\n    --\n    -- remWord8#\n    --\n    let input =\n            -- Don't divide by 0.\n            [ (a, b) | a <- allWord8, b <- allWord8 , b /= 0 ]\n        expected = [ toWord8 (a `rem` b) | (a, b) <- input ]\n        actual = [ apply2 remWord8# a b | (a, b) <- input ]\n    checkResults \"remWord8#\" input expected actual\n\n    --\n    -- quotWord8#\n    --\n    let input =\n            [ (a, b) | a <- allWord8, b <- allWord8, b /= 0 ]\n        expected = [ toWord8 (a `quot` b) | (a, b) <- input ]\n        actual = [ apply2 quotWord8# a b | (a, b) <- input ]\n    checkResults \"quotWord8#\" input expected actual\n\n    --\n    -- quotRemWord8#\n    --\n    let input =\n            [ (a, b) | a <- allWord8, b <- allWord8, b /= 0 ]\n        expected =\n            [ (toWord8 q, toWord8 r)  | (a, b) <- input\n            , let (q, r) = a `quotRem` b\n            ]\n        actual = [ apply3 quotRemWord8# a b | (a, b) <- input ]\n    checkResults \"quotRemWord8#\" input expected actual\n\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\nallWord8 :: [Word]\nallWord8 = [ minWord8 .. maxWord8 ]\n\nminWord8 :: Word\nminWord8 = fromIntegral (minBound :: Word8)\n\nmaxWord8 :: Word\nmaxWord8 = fromIntegral (maxBound :: Word8)\n\ntoWord8 :: Word -> Word\ntoWord8 a = fromIntegral (fromIntegral a :: Word8)\n\naddMany#\n    :: Word8# -> Word8# -> Word8# -> Word8#\n    -> Word8# -> Word8# -> Word8# -> Word8#\n    -> Word8# -> Word8# -> Word8# -> Word8#\n    -> Word8# -> Word8# -> Word8# -> Word8#\n    -> Word8#\naddMany# a b c d e f g h i j k l m n o p =\n    a `plusWord8#` b `plusWord8#` c `plusWord8#` d `plusWord8#`\n    e `plusWord8#` f `plusWord8#` g `plusWord8#` h `plusWord8#`\n    i `plusWord8#` j `plusWord8#` k `plusWord8#` l `plusWord8#`\n    m `plusWord8#` n `plusWord8#` o `plusWord8#` p\n{-# NOINLINE addMany# #-}\n\naddMany\n    :: Word -> Word -> Word -> Word\n    -> Word -> Word -> Word -> Word\n    -> Word -> Word -> Word -> Word\n    -> Word -> Word -> Word -> Word\n    -> Word\naddMany (W# a) (W# b) (W# c) (W# d)\n        (W# e) (W# f) (W# g) (W# h)\n        (W# i) (W# j) (W# k) (W# l)\n        (W# m) (W# n) (W# o) (W# p)\n            = W# (extendWord8# word8)\n  where\n    !word8 =\n        addMany#\n            (narrowWord8# a) (narrowWord8# b) (narrowWord8# c) (narrowWord8# d)\n            (narrowWord8# e) (narrowWord8# f) (narrowWord8# g) (narrowWord8# h)\n            (narrowWord8# i) (narrowWord8# j) (narrowWord8# k) (narrowWord8# l)\n            (narrowWord8# m) (narrowWord8# n) (narrowWord8# o) (narrowWord8# p)\n{-# NOINLINE addMany #-}\n\n-- Convenient and also tests higher order functions on Word8#\napply1 :: (Word8# -> Word8#) -> Word -> Word\napply1 opToTest (W# a) = W# (extendWord8# (opToTest (narrowWord8# a)))\n{-# NOINLINE apply1 #-}\n\napply2 :: (Word8# -> Word8# -> Word8#) -> Word -> Word -> Word\napply2 opToTest (W# a) (W# b) =\n    let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #)\n        r = opToTest sa sb\n    in W# (extendWord8# r)\n{-# NOINLINE apply2 #-}\n\napply3\n  :: (Word8# -> Word8# -> (# Word8#, Word8# #)) -> Word -> Word -> (Word, Word)\napply3 opToTest (W# a) (W# b) =\n    let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #)\n        (# ra, rb #) = opToTest sa sb\n    in (W# (extendWord8# ra), W# (extendWord8# rb))\n{-# NOINLINE apply3 #-}\n\ninstance\n        (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h,\n         Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p)\n      => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) ==\n        (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) =\n            a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 &&\n            e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 &&\n            i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 &&\n            m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2\n\ninstance\n        (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,\n         Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p)\n      => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where\n    show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) =\n        \"(\" ++ show a ++ \",\" ++ show b ++ \",\" ++ show c ++ \",\" ++ show d ++\n        \",\" ++ show e ++ \",\" ++ show f ++ \",\" ++ show g ++ \",\" ++ show h ++\n        \",\" ++ show i ++ \",\" ++ show j ++ \",\" ++ show k ++ \",\" ++ show l ++\n        \",\" ++ show m ++ \",\" ++ show n ++ \",\" ++ show o ++ \",\" ++ show p ++\n        \")\"\n", "num_lines": 199}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport Data.Int\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\n\n-- Having a wrapper gives us two things:\n-- * it's easier to test everything (no need for code using raw primops)\n-- * we test the deriving mechanism for Int16#\ndata TestInt16 = T16 Int16#\n    deriving (Eq, Ord)\n\nmkT16 :: Int -> TestInt16\nmkT16 (I# a) = T16 (narrowInt16# a)\n\nmain :: IO ()\nmain = do\n    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]\n\n    --\n    -- (==)\n    --\n    let expected = [ a == b | (a, b) <- input ]\n        actual = [ mkT16 a == mkT16 b | (a, b) <- input ]\n    checkResults \"(==)\" input expected actual\n\n    --\n    -- (/=)\n    --\n    let expected = [ a /= b | (a, b) <- input ]\n        actual = [ mkT16 a /= mkT16 b | (a, b) <- input ]\n    checkResults \"(/=)\" input expected actual\n\n    --\n    -- (<)\n    --\n    let expected = [ a < b | (a, b) <- input ]\n        actual = [ mkT16 a < mkT16 b | (a, b) <- input ]\n    checkResults \"(<)\" input expected actual\n\n    --\n    -- (>)\n    --\n    let expected = [ a > b | (a, b) <- input ]\n        actual = [ mkT16 a > mkT16 b | (a, b) <- input ]\n    checkResults \"(>)\" input expected actual\n\n    --\n    -- (<=)\n    --\n    let expected = [ a <= b | (a, b) <- input ]\n        actual = [ mkT16 a <= mkT16 b | (a, b) <- input ]\n    checkResults \"(<=)\" input expected actual\n\n    --\n    -- (>=)\n    --\n    let expected = [ a >= b | (a, b) <- input ]\n        actual = [ mkT16 a >= mkT16 b | (a, b) <- input ]\n    checkResults \"(>=)\" input expected actual\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\n-- testing across the entire Int16 range blows the memory,\n-- hence choosing a smaller range\nallInt16 :: [Int]\nallInt16 = [ -50 .. 50 ]\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport Data.Int\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\n\n-- Having a wrapper gives us two things:\n-- * it's easier to test everything (no need for code using raw primops)\n-- * we test the deriving mechanism for Int8#\ndata TestInt8 = T8 Int8#\n    deriving (Eq, Ord)\n\nmkT8 :: Int -> TestInt8\nmkT8 (I# a) = T8 (narrowInt8# a)\n\nmain :: IO ()\nmain = do\n    let input = [ (a, b) | a <- allInt8, b <- allInt8 ]\n\n    --\n    -- (==)\n    --\n    let expected = [ a == b | (a, b) <- input ]\n        actual = [ mkT8 a == mkT8 b | (a, b) <- input ]\n    checkResults \"(==)\" input expected actual\n\n    --\n    -- (/=)\n    --\n    let expected = [ a /= b | (a, b) <- input ]\n        actual = [ mkT8 a /= mkT8 b | (a, b) <- input ]\n    checkResults \"(/=)\" input expected actual\n\n    --\n    -- (<)\n    --\n    let expected = [ a < b | (a, b) <- input ]\n        actual = [ mkT8 a < mkT8 b | (a, b) <- input ]\n    checkResults \"(<)\" input expected actual\n\n    --\n    -- (>)\n    --\n    let expected = [ a > b | (a, b) <- input ]\n        actual = [ mkT8 a > mkT8 b | (a, b) <- input ]\n    checkResults \"(>)\" input expected actual\n\n    --\n    -- (<=)\n    --\n    let expected = [ a <= b | (a, b) <- input ]\n        actual = [ mkT8 a <= mkT8 b | (a, b) <- input ]\n    checkResults \"(<=)\" input expected actual\n\n    --\n    -- (>=)\n    --\n    let expected = [ a >= b | (a, b) <- input ]\n        actual = [ mkT8 a >= mkT8 b | (a, b) <- input ]\n    checkResults \"(>=)\" input expected actual\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\nallInt8 :: [Int]\nallInt8 = [ minInt8 .. maxInt8 ]\n\nminInt8 :: Int\nminInt8 = fromIntegral (minBound :: Int8)\n\nmaxInt8 :: Int\nmaxInt8 = fromIntegral (maxBound :: Int8)\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport Data.Word\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\n\n-- Having a wrapper gives us two things:\n-- * it's easier to test everything (no need for code using raw primops)\n-- * we test the deriving mechanism for Word16#\ndata TestWord16 = T16 Word16#\n    deriving (Eq, Ord)\n\nmkT16 :: Word -> TestWord16\nmkT16 (W# a) = T16 (narrowWord16# a)\n\nmain :: IO ()\nmain = do\n    let input = [ (a, b) | a <- allWord16, b <- allWord16 ]\n\n    --\n    -- (==)\n    --\n    let expected = [ a == b | (a, b) <- input ]\n        actual = [ mkT16 a == mkT16 b | (a, b) <- input ]\n    checkResults \"(==)\" input expected actual\n\n    --\n    -- (/=)\n    --\n    let expected = [ a /= b | (a, b) <- input ]\n        actual = [ mkT16 a /= mkT16 b | (a, b) <- input ]\n    checkResults \"(/=)\" input expected actual\n\n    --\n    -- (<)\n    --\n    let expected = [ a < b | (a, b) <- input ]\n        actual = [ mkT16 a < mkT16 b | (a, b) <- input ]\n    checkResults \"(<)\" input expected actual\n\n    --\n    -- (>)\n    --\n    let expected = [ a > b | (a, b) <- input ]\n        actual = [ mkT16 a > mkT16 b | (a, b) <- input ]\n    checkResults \"(>)\" input expected actual\n\n    --\n    -- (<=)\n    --\n    let expected = [ a <= b | (a, b) <- input ]\n        actual = [ mkT16 a <= mkT16 b | (a, b) <- input ]\n    checkResults \"(<=)\" input expected actual\n\n    --\n    -- (>=)\n    --\n    let expected = [ a >= b | (a, b) <- input ]\n        actual = [ mkT16 a >= mkT16 b | (a, b) <- input ]\n    checkResults \"(>=)\" input expected actual\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\n-- testing across the entire Word16 range blows the memory,\n-- hence choosing a smaller range\nallWord16 :: [Word]\nallWord16 = [ 0 .. 100 ]\n", "num_lines": 81}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport Data.Word\nimport Data.List\nimport GHC.Prim\nimport GHC.Exts\n\n\n-- Having a wrapper gives us two things:\n-- * it's easier to test everything (no need for code using raw primops)\n-- * we test the deriving mechanism for Word8#\ndata TestWord8 = T8 Word8#\n    deriving (Eq, Ord)\n\nmkT8 :: Word -> TestWord8\nmkT8 (W# a) = T8 (narrowWord8# a)\n\nmain :: IO ()\nmain = do\n    let input = [ (a, b) | a <- allWord8, b <- allWord8 ]\n\n    --\n    -- (==)\n    --\n    let expected = [ a == b | (a, b) <- input ]\n        actual = [ mkT8 a == mkT8 b | (a, b) <- input ]\n    checkResults \"(==)\" input expected actual\n\n    --\n    -- (/=)\n    --\n    let expected = [ a /= b | (a, b) <- input ]\n        actual = [ mkT8 a /= mkT8 b | (a, b) <- input ]\n    checkResults \"(/=)\" input expected actual\n\n    --\n    -- (<)\n    --\n    let expected = [ a < b | (a, b) <- input ]\n        actual = [ mkT8 a < mkT8 b | (a, b) <- input ]\n    checkResults \"(<)\" input expected actual\n\n    --\n    -- (>)\n    --\n    let expected = [ a > b | (a, b) <- input ]\n        actual = [ mkT8 a > mkT8 b | (a, b) <- input ]\n    checkResults \"(>)\" input expected actual\n\n    --\n    -- (<=)\n    --\n    let expected = [ a <= b | (a, b) <- input ]\n        actual = [ mkT8 a <= mkT8 b | (a, b) <- input ]\n    checkResults \"(<=)\" input expected actual\n\n    --\n    -- (>=)\n    --\n    let expected = [ a >= b | (a, b) <- input ]\n        actual = [ mkT8 a >= mkT8 b | (a, b) <- input ]\n    checkResults \"(>=)\" input expected actual\n\ncheckResults\n    :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO ()\ncheckResults test inputs expected actual =\n    case findIndex (\\(e, a) -> e /= a) (zip expected actual) of\n        Nothing -> putStrLn $ \"Pass: \" ++ test\n        Just i -> error $\n            \"FAILED: \" ++ test ++ \" for input: \" ++ show (inputs !! i)\n              ++ \" expected: \" ++ show (expected !! i)\n              ++ \" but got: \" ++ show (actual !! i)\n\nallWord8 :: [Word]\nallWord8 = [ minWord8 .. maxWord8 ]\n\nminWord8 :: Word\nminWord8 = fromIntegral (minBound :: Word8)\n\nmaxWord8 :: Word\nmaxWord8 = fromIntegral (maxBound :: Word8)\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport GHC.Exts\n\ndata Test1 = Test1 Int8# Word8#\n    deriving (Show)\n\ndata Test2 = Test2 Int16# Word16#\n    deriving (Show)\n\ntest1 :: Test1\ntest1 = Test1 (narrowInt8# 1#) (narrowWord8# 2##)\n\ntest2 :: Test2\ntest2 = Test2 (narrowInt16# 1#) (narrowWord16# 2##)\n\nmain :: IO ()\nmain = do\n  print test1\n  print test2\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\nimport Control.Exception\n\nf :: ArithException -> Int#\nf x = raise# (toException x)\n\nmain = print (I# (f Overflow))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Prim\n\nmain :: IO ()\nmain = go 1000000# 10 (2^100)\n\ngo :: Int# -> Integer -> Integer -> IO ()\ngo 0# _ _ = return ()\ngo n# a b = (a + b) `seq` go (n# -# 1#) a b\n{-# NOINLINE go #-}\n\n{-\nThis test is based on a strategy from rwbarton relying on the inefficiency\nof `Integer` addition as defined by `integer-gmp` without `runRW#`.\n\n    When I was testing the patch interactively, I measured allocations for,\n    say, a million (large Integer) + (small Integer) additions.  If that\n    addition allocates, say, 6 words, then one can fairly reliably write the\n    program so that it will allocate between 6 million and 7 million words,\n    total.\n-}\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nimport Control.Monad (unless)\nimport GHC.Exts\nimport GHC.Types\n\ndata ByteArray s = BA (MutableByteArray# s)\n\nmain :: IO ()\nmain = do\n    ba# <- IO (\\s0 -> case newByteArray# 256# s0 of\n                        (# s1, ba# #) -> (# s1, BA ba# #))\n    let go n = do\n            shrink ba# n\n            sz <- getSize ba#\n            unless (sz == n) $ print (sz, n)\n    mapM go [128, 64, 63, 32, 2, 1]\n    return ()\n\nshrink :: ByteArray RealWorld -> Int -> IO ()\nshrink (BA ba#) (I# n#) = IO (\\s ->\n    case shrinkMutableByteArray# ba# n# s of\n      s' -> (# s', () #))\n\ngetSize :: ByteArray RealWorld -> IO Int\ngetSize (BA ba#) = IO (\\s ->\n    case getSizeofMutableByteArray# ba# s of\n      (# s', n# #) -> (# s', I# n# #))\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport GHC.Exts\nimport Data.Word\nimport Data.Int\n\ndata Packed1 = Packed1 Float# Float# Int# Float#\n    deriving Show\n\ndata Packed2 =\n    Packed2\n        {-# UNPACK #-} !Float\n        {-# UNPACK #-} !Float\n        {-# UNPACK #-} !Int\n        {-# UNPACK #-} !Float\n    deriving Show\n\ndata Packed3 =\n    Packed3\n        {-# UNPACK #-} !Word8\n        {-# UNPACK #-} !Int8\n        {-# UNPACK #-} !Int64\n        {-# UNPACK #-} !Float\n        {-# UNPACK #-} !Word64\n        {-# UNPACK #-} !Word32\n        {-# UNPACK #-} !Float\n        {-# UNPACK #-} !Double\n    deriving Show\n\npacked1 = go 0.0# 1.0# 2# 3.0#\n  where\n    go a b c d =\n        Packed1 a b c d\n            : go (a `plusFloat#` 1.0#)\n                 (b `plusFloat#` 1.0#)\n               (c +# 1#)\n               (d `plusFloat#` 1.0#)\n\npacked2 =\n    [ Packed2\n        (fromIntegral i)\n        (fromIntegral (i + 1))\n        (fromIntegral (i + 2))\n        (fromIntegral (i + 3))\n    | i <- [0..]\n    ]\n\npacked3 =\n    [ Packed3\n        (fromIntegral i)\n        (fromIntegral (i + 1))\n        (fromIntegral (i + 2))\n        (fromIntegral (i + 3))\n        (fromIntegral (i + 4))\n        (fromIntegral (i + 5))\n        (fromIntegral (i + 6))\n        (fromIntegral (i + 6))\n    | i <- [0..]\n    ]\n\nmain :: IO ()\nmain = do\n    print (take 3 packed1)\n    print (take 3 packed2)\n    print (take 3 packed3)\n", "num_lines": 67}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples, CPP #-}\nmodule Main where\n\n#include \"MachDeps.h\"\n\nimport GHC.Ptr(Ptr(..), nullPtr, plusPtr, minusPtr)\nimport GHC.Stable(\n  StablePtr(..), castStablePtrToPtr, castPtrToStablePtr, newStablePtr)\nimport GHC.Exts\nimport Data.Char(ord)\n#if WORD_SIZE_IN_BITS < 64\nimport GHC.Int (Int64(..))\nimport GHC.Word (Word64(..))\n#endif\n\nassertEqual :: (Show a, Eq a) => a -> a -> IO ()\nassertEqual a b\n  | a /= b = putStrLn (show a ++ \" /= \" ++ show b)\n  | otherwise = return ()\n\nreadBytes :: MutableByteArray# s -> State# s -> Int# -> (# State# s, [Int] #)\nreadBytes marr s0 len = go s0 len []\n where\n  go s 0# bs = (# s, bs #)\n  go s i  bs = case readWord8Array# marr (i -# 1#) s of\n    (# s', b #) -> go s' (i -# 1#) (I# (word2Int# b):bs)\n\nindexBytes :: ByteArray# -> Int# -> [Int]\nindexBytes arr len  =\n  [I# (word2Int# (indexWord8Array# arr i)) | I# i <- [0..I# len - 1]]\n\nfillByteArray :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s\nfillByteArray arr len (I# a) = go len\n where\n  go 0# s = s\n  go i s = go (i -# 1#) (writeInt8Array# arr (i -# 1#) a s)\n\ntest :: (Eq a, Show a)\n  => String\n  -> (ByteArray# -> Int# -> a)\n  -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld\n      -> (# State# RealWorld, a #))\n  -> (MutableByteArray# RealWorld -> Int# -> a -> State# RealWorld\n      -> State# RealWorld)\n  -> a\n  -> [Int]\n  -> Int\n  -> IO ()\ntest name index read write val valBytes len = do\n  putStrLn name\n  mapM_ testAtOffset [0..16]\n where\n  arrLen :: Int#\n  arrLen = 24#\n\n  fillerByte :: Int\n  fillerByte = 0x34\n\n  expectedArrayBytes :: Int -> [Int]\n  expectedArrayBytes offset =\n       replicate offset fillerByte\n    ++ valBytes\n    ++ replicate (I# arrLen - len - offset) fillerByte\n\n  testAtOffset :: Int -> IO ()\n  testAtOffset offset@(I# offset#) = runRW# (\\s0 -> let\n    (# s1, marr #) = newByteArray# arrLen s0\n    s2 = fillByteArray marr arrLen fillerByte s1\n    s3 = write marr offset# val s2\n    (# s4, actual0 #) = read marr offset# s3\n    (# s5, actualBytes0 #) = readBytes marr s4 arrLen\n    (# _, arr #) = unsafeFreezeByteArray# marr s5\n    actual1 = index arr offset#\n    actualBytes1 = indexBytes arr arrLen\n   in do\n       assertEqual actual0 val\n       assertEqual actual1 val\n       assertEqual actualBytes0 (expectedArrayBytes offset)\n       assertEqual actualBytes1 (expectedArrayBytes offset)\n   )\n\nintToBytes :: Int -> Int -> [Int]\nintToBytes (I# val0) (I# len0) = let\n    result = go val0 len0\n    go v 0# = []\n    go v len =\n      I# (v `andI#` 0xff#) : go (v `uncheckedIShiftRL#` 8#) (len -# 1#)\n  in\n#if defined(WORDS_BIGENDIAN)\n    reverse result\n#else\n    result\n#endif\n\ntestIntArray ::\n     String\n  -> (ByteArray# -> Int# -> Int#)\n  -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld\n        -> (# State# RealWorld, Int# #))\n  -> (MutableByteArray# RealWorld -> Int# -> Int# -> State# RealWorld\n        -> State# RealWorld)\n  -> Int\n  -> Int\n  -> IO ()\ntestIntArray name0 index read write val0 len = do\n  doOne (name0 ++ \" positive\") val0\n  doOne (name0 ++ \" negative\") (negate val0)\n where\n  doOne name val = test\n    name\n    (\\arr i -> I# (index arr i))\n    (\\arr i s -> case read arr i s of (# s', a #) -> (# s', I# a #))\n    (\\arr i (I# a) s -> write arr i a s)\n    val\n    (intToBytes val len)\n    len\n\n#if WORD_SIZE_IN_BITS == 64\ntestInt64Array = testIntArray\n#else\ntestInt64Array ::\n     String\n  -> (ByteArray# -> Int# -> Int64#)\n  -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld\n        -> (# State# RealWorld, Int64# #))\n  -> (MutableByteArray# RealWorld -> Int# -> Int64# -> State# RealWorld\n        -> State# RealWorld)\n  -> Int64\n  -> Int\n  -> IO ()\ntestInt64Array name0 index read write val0 len = do\n  doOne (name0 ++ \" positive\") val0\n  doOne (name0 ++ \" negative\") (negate val0)\n where\n  doOne :: String -> Int64 -> IO ()\n  doOne name val = test\n    name\n    (\\arr i -> I64# (index arr i))\n    (\\arr i s -> case read arr i s of (# s', a #) -> (# s', I64# a #))\n    (\\arr i (I64# a) s -> write arr i a s)\n    val\n    (intToBytes (fromIntegral val) len)\n    len\n#endif\n\ntestWordArray ::\n     String\n  -> (ByteArray# -> Int# -> Word#)\n  -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld\n        -> (# State# RealWorld, Word# #))\n  -> (MutableByteArray# RealWorld -> Int# -> Word# -> State# RealWorld\n        -> State# RealWorld)\n  -> Word\n  -> Int\n  -> IO ()\ntestWordArray name index read write val len = test\n  name\n  (\\arr i -> W# (index arr i))\n  (\\arr i s -> case read arr i s of (# s', a #) -> (# s', W# a #))\n  (\\arr i (W# a) s -> write arr i a s)\n  val\n  (intToBytes (fromIntegral val) len)\n  len\n\n#if WORD_SIZE_IN_BITS == 64\ntestWord64Array = testWordArray\n#else\ntestWord64Array ::\n     String\n  -> (ByteArray# -> Int# -> Word64#)\n  -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld\n        -> (# State# RealWorld, Word64# #))\n  -> (MutableByteArray# RealWorld -> Int# -> Word64# -> State# RealWorld\n        -> State# RealWorld)\n  -> Word64\n  -> Int\n  -> IO ()\ntestWord64Array name index read write val len = test\n  name\n  (\\arr i -> W64# (index arr i))\n  (\\arr i s -> case read arr i s of (# s', a #) -> (# s', W64# a #))\n  (\\arr i (W64# a) s -> write arr i a s)\n  val\n  (intToBytes (fromIntegral val) len)\n  len\n#endif\n\nwordSizeInBytes :: Int\nwordSizeInBytes = WORD_SIZE_IN_BITS `div` 8\n\nint :: Int\nint\n  | WORD_SIZE_IN_BITS == 32 = 12345678\n  | otherwise = 1234567890123\n\nword :: Word\nword = fromIntegral int\n\nfloat :: Float\nfloat = 123.456789\n\n-- Test pattern generated by this python code:\n-- >>> import struct\n-- >>> import binascii\n-- >>> binascii.hexlify(struct.pack('>f', 123.456789))\nfloatBytes :: Int\nfloatBytes = 0x42f6e9e0\n\ndouble :: Double\ndouble = 123.45678901234\n\n-- Test pattern generated by this python code:\n-- >>> import struct\n-- >>> import binascii\n-- >>> binascii.hexlify(struct.pack('>d', 123.45678901234))\ndoubleBytes :: Int\ndoubleBytes = 0x405edd3c07fb4b09\n\nmain :: IO ()\nmain = do\n  testIntArray \"Int8#\"\n    indexInt8Array# readInt8Array# writeInt8Array#\n    123 1\n  testIntArray \"Int16#\"\n    indexWord8ArrayAsInt16# readWord8ArrayAsInt16# writeWord8ArrayAsInt16#\n    12345 2\n  testIntArray \"Int32#\"\n    indexWord8ArrayAsInt32# readWord8ArrayAsInt32# writeWord8ArrayAsInt32#\n    12345678 4\n  testInt64Array \"Int64#\"\n    indexWord8ArrayAsInt64# readWord8ArrayAsInt64# writeWord8ArrayAsInt64#\n    1234567890123 8\n  testIntArray \"Int#\"\n    indexWord8ArrayAsInt# readWord8ArrayAsInt# writeWord8ArrayAsInt#\n    int wordSizeInBytes\n\n  testWordArray \"Word8#\"\n    indexWord8Array# readWord8Array# writeWord8Array#\n    123 1\n  testWordArray \"Word16#\"\n    indexWord8ArrayAsWord16# readWord8ArrayAsWord16# writeWord8ArrayAsWord16#\n    12345 2\n  testWordArray \"Word32#\"\n    indexWord8ArrayAsWord32# readWord8ArrayAsWord32# writeWord8ArrayAsWord32#\n    12345678 4\n  testWord64Array \"Word64#\"\n    indexWord8ArrayAsWord64# readWord8ArrayAsWord64# writeWord8ArrayAsWord64#\n    1234567890123 8\n  testWordArray \"Word#\"\n    indexWord8ArrayAsWord# readWord8ArrayAsWord# writeWord8ArrayAsWord#\n    word wordSizeInBytes\n\n  test\n    \"Char#\"\n    (\\arr i -> C# (indexWord8ArrayAsChar# arr i))\n    (\\arr i s ->\n        case readWord8ArrayAsChar# arr i s of (# s', a #) -> (# s', C# a #))\n    (\\arr i (C# a) s -> writeWord8ArrayAsChar# arr i a s)\n    'z'\n    [ord 'z']\n    1\n  test\n    \"WideChar#\"\n    (\\arr i -> C# (indexWord8ArrayAsWideChar# arr i))\n    (\\arr i s ->\n        case readWord8ArrayAsWideChar# arr i s of (# s', a #) -> (# s', C# a #))\n    (\\arr i (C# a) s -> writeWord8ArrayAsWideChar# arr i a s)\n    '\u00f0\u00a0\u0153\u017d'  -- See http://www.i18nguy.com/unicode/supplementary-test.html\n    (intToBytes (ord '\u00f0\u00a0\u0153\u017d') 4)\n    4\n  test\n    \"Addr#\"\n    (\\arr i -> Ptr (indexWord8ArrayAsAddr# arr i))\n    (\\arr i s ->\n        case readWord8ArrayAsAddr# arr i s of (# s', a #) -> (# s', Ptr a #))\n    (\\arr i (Ptr a) s -> writeWord8ArrayAsAddr# arr i a s)\n    (nullPtr `plusPtr` int)\n    (intToBytes int wordSizeInBytes)\n    wordSizeInBytes\n\n  stablePtr <- newStablePtr ()\n  test\n    \"StablePtr#\"\n    (\\arr i ->\n        castStablePtrToPtr (StablePtr (indexWord8ArrayAsStablePtr# arr i)))\n    (\\arr i s -> case readWord8ArrayAsStablePtr# arr i s of\n                   (# s', a #) -> (# s', castStablePtrToPtr (StablePtr a) #))\n    (\\arr i p s -> case castPtrToStablePtr p of\n                     (StablePtr a) -> writeWord8ArrayAsStablePtr# arr i a s)\n    (castStablePtrToPtr stablePtr)\n    (intToBytes (castStablePtrToPtr stablePtr `minusPtr` nullPtr)\n                wordSizeInBytes)\n    wordSizeInBytes\n\n  test\n    \"Float#\"\n    (\\arr i -> F# (indexWord8ArrayAsFloat# arr i))\n    (\\arr i s ->\n        case readWord8ArrayAsFloat# arr i s of (# s', a #) -> (# s', F# a #))\n    (\\arr i (F# a) s -> writeWord8ArrayAsFloat# arr i a s)\n    float\n    (intToBytes floatBytes 4)\n    4\n  test\n    \"Double#\"\n    (\\arr i -> D# (indexWord8ArrayAsDouble# arr i))\n    (\\arr i s ->\n        case readWord8ArrayAsDouble# arr i s of (# s', a #) -> (# s', D# a #))\n    (\\arr i (D# a) s -> writeWord8ArrayAsDouble# arr i a s)\n    double\n    (intToBytes doubleBytes 8)\n    8\n", "num_lines": 313}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests created by Jan Stolarek <jan.stolarek@p.lodz.pl>\n\n{-# LANGUAGE BangPatterns, MagicHash #-}\nmodule Main where\n\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n  -- PrimOps for comparing Char#\n  putStrLn \"=== testing gtChar# ===\"\n  test \"gtChar#\" (a#    `gtChar#` a#   ) -- False\n  test \"gtChar#\" (b#    `gtChar#` a#   ) -- True\n  test \"gtChar#\" (a#    `gtChar#` b#   ) -- False\n  test \"gtChar#\" (minC# `gtChar#` minC#) -- False\n  test \"gtChar#\" (maxC# `gtChar#` maxC#) -- False\n  test \"gtChar#\" (minC# `gtChar#` maxC#) -- False\n  test \"gtChar#\" (maxC# `gtChar#` minC#) -- True\n\n  putStrLn \"=== testing geChar# ===\"\n  test \"geChar#\" (a#    `geChar#` a#   ) -- True\n  test \"geChar#\" (b#    `geChar#` a#   ) -- True\n  test \"geChar#\" (a#    `geChar#` b#   ) -- False\n  test \"geChar#\" (minC# `geChar#` minC#) -- True\n  test \"geChar#\" (maxC# `geChar#` maxC#) -- True\n  test \"geChar#\" (minC# `geChar#` maxC#) -- False\n  test \"geChar#\" (maxC# `geChar#` minC#) -- True\n\n  putStrLn \"=== testing ltChar# ===\"\n  test \"ltChar#\" (a#    `ltChar#` a#   ) -- False\n  test \"ltChar#\" (b#    `ltChar#` a#   ) -- False\n  test \"ltChar#\" (a#    `ltChar#` b#   ) -- True\n  test \"ltChar#\" (minC# `ltChar#` minC#) -- False\n  test \"ltChar#\" (maxC# `ltChar#` maxC#) -- False\n  test \"ltChar#\" (minC# `ltChar#` maxC#) -- True\n  test \"ltChar#\" (maxC# `ltChar#` minC#) -- False\n\n  putStrLn \"=== testing leChar# ===\"\n  test \"leChar#\" (a#    `leChar#` a#   ) -- True\n  test \"leChar#\" (b#    `leChar#` a#   ) -- False\n  test \"leChar#\" (a#    `leChar#` b#   ) -- True\n  test \"leChar#\" (minC# `leChar#` minC#) -- True\n  test \"leChar#\" (maxC# `leChar#` maxC#) -- True\n  test \"leChar#\" (minC# `leChar#` maxC#) -- True\n  test \"leChar#\" (maxC# `leChar#` minC#) -- False\n\n  putStrLn \"=== testing eqChar# ===\"\n  test \"eqChar#\" (a#    `eqChar#` a#   ) -- True\n  test \"eqChar#\" (b#    `eqChar#` a#   ) -- False\n  test \"eqChar#\" (a#    `eqChar#` b#   ) -- False\n  test \"eqChar#\" (minC# `eqChar#` minC#) -- True\n  test \"eqChar#\" (maxC# `eqChar#` maxC#) -- True\n  test \"eqChar#\" (minC# `eqChar#` maxC#) -- False\n  test \"eqChar#\" (maxC# `eqChar#` minC#) -- False\n\n  putStrLn \"=== testing neChar# ===\"\n  test \"neChar#\" (a#    `neChar#` a#   ) -- False\n  test \"neChar#\" (b#    `neChar#` a#   ) -- True\n  test \"neChar#\" (a#    `neChar#` b#   ) -- True\n  test \"neChar#\" (minC# `neChar#` minC#) -- False\n  test \"neChar#\" (maxC# `neChar#` maxC#) -- False\n  test \"neChar#\" (minC# `neChar#` maxC#) -- True\n  test \"neChar#\" (maxC# `neChar#` minC#) -- True\n\n  -- PrimOps for comparing Int#\n  putStrLn \"=== testing ># ===\"\n  test \">#\" (0#          ># 0#         ) -- False\n  test \">#\" (1#          ># 0#         ) -- True\n  test \">#\" (0#          ># 1#         ) -- False\n  test \">#\" (minI#       ># minI#      ) -- False\n  test \">#\" (maxI#       ># maxI#      ) -- False\n  test \">#\" (minI# +# 1# ># minI#      ) -- True\n  test \">#\" (minI#       ># minI# -# 1#) -- False (overflow)\n  test \">#\" (maxI# +# 1# ># maxI#      ) -- False (overflow)\n  test \">#\" (maxI#       ># maxI# -# 1#) -- True\n\n  putStrLn \"=== testing <# ===\"\n  test \"<#\" (0#          <# 0#         ) -- False\n  test \"<#\" (1#          <# 0#         ) -- False\n  test \"<#\" (0#          <# 1#         ) -- True\n  test \"<#\" (minI#       <# minI#      ) -- False\n  test \"<#\" (maxI#       <# maxI#      ) -- False\n  test \"<#\" (minI#       <# minI# +# 1#) -- True\n  test \"<#\" (minI# -# 1# <# minI#      ) -- False (overflow)\n  test \"<#\" (maxI#       <# maxI# +# 1#) -- False (overflow)\n  test \"<#\" (maxI# -# 1# <# maxI#      ) -- True\n\n  putStrLn \"=== testing >=# ===\"\n  test \">=#\" (0#          >=# 0#         ) -- True\n  test \">=#\" (1#          >=# 0#         ) -- True\n  test \">=#\" (0#          >=# 1#         ) -- False\n  test \">=#\" (minI#       >=# minI#      ) -- True\n  test \">=#\" (maxI#       >=# maxI#      ) -- True\n  test \">=#\" (minI# +# 1# >=# minI#      ) -- True\n  test \">=#\" (minI#       >=# minI# -# 1#) -- False (overflow)\n  test \">=#\" (maxI# +# 1# >=# maxI#      ) -- False (overflow)\n  test \">=#\" (maxI#       >=# maxI# -# 1#) -- True\n\n  putStrLn \"=== testing <=# ===\"\n  test \"<=#\" (0#          <=# 0#         ) -- True\n  test \"<=#\" (1#          <=# 0#         ) -- False\n  test \"<=#\" (0#          <=# 1#         ) -- True\n  test \"<=#\" (minI#       <=# minI#      ) -- True\n  test \"<=#\" (maxI#       <=# maxI#      ) -- True\n  test \"<=#\" (minI#       <=# minI# +# 1#) -- True\n  test \"<=#\" (minI# -# 1# <=# minI#      ) -- False (overflow)\n  test \"<=#\" (maxI#       <=# maxI# +# 1#) -- False (overflow)\n  test \"<=#\" (maxI# -# 1# <=# maxI#      ) -- True\n\n  putStrLn \"=== testing ==# ===\"\n  test \"==#\" (0#          ==# 0#         ) -- True\n  test \"==#\" (1#          ==# 0#         ) -- False\n  test \"==#\" (0#          ==# 1#         ) -- False\n  test \"==#\" (maxI#       ==# maxI#      ) -- True\n  test \"==#\" (maxI# -# 1# ==# maxI#      ) -- False\n  test \"==#\" (minI#       ==# minI#      ) -- True\n  test \"==#\" (minI#       ==# minI# +# 1#) -- False\n  test \"==#\" (minI#       ==# maxI# +# 1#) -- True (overflow)\n  test \"==#\" (maxI# +# 1# ==# minI#      ) -- True (overflow)\n  test \"==#\" (maxI#       ==# minI# -# 1#) -- True (overflow)\n  test \"==#\" (minI# -# 1# ==# maxI#      ) -- True (overflow)\n\n  putStrLn \"=== testing /=# ===\"\n  test \"/=#\" (0#          /=# 0#         ) -- False\n  test \"/=#\" (1#          /=# 0#         ) -- True\n  test \"/=#\" (0#          /=# 1#         ) -- True\n  test \"/=#\" (maxI#       /=# maxI#      ) -- False\n  test \"/=#\" (maxI# -# 1# /=# maxI#      ) -- True\n  test \"/=#\" (minI#       /=# minI#      ) -- False\n  test \"/=#\" (minI#       /=# minI# +# 1#) -- True\n  test \"/=#\" (minI#       /=# maxI# +# 1#) -- False (overflow)\n  test \"/=#\" (maxI# +# 1# /=# minI#      ) -- False (overflow)\n  test \"/=#\" (maxI#       /=# minI# -# 1#) -- False (overflow)\n  test \"/=#\" (minI# -# 1# /=# maxI#      ) -- False (overflow)\n\n  -- PrimOps for comparing Word#\n  putStrLn \"=== testing gtWord# ===\"\n  test \"gtWord#\" (zeroW#                    `gtWord#` zeroW#                    ) -- False\n  test \"gtWord#\" (oneW#                     `gtWord#` zeroW#                    ) -- True\n  test \"gtWord#\" (zeroW#                    `gtWord#` oneW#                     ) -- False\n  test \"gtWord#\" (minW#                     `gtWord#` minW#                     ) -- False\n  test \"gtWord#\" (maxW#                     `gtWord#` maxW#                     ) -- False\n  test \"gtWord#\" ((minW# `plusWord#` oneW#) `gtWord#` minW#                     ) -- True\n  test \"gtWord#\" (minW#                     `gtWord#` (minW# `minusWord#` oneW#)) -- False (overflow)\n  test \"gtWord#\" ((maxW# `plusWord#` oneW#) `gtWord#` maxW#                     ) -- False (overflow)\n  test \"gtWord#\" (maxW#                     `gtWord#` (maxW# `minusWord#` oneW#)) -- True\n\n  putStrLn \"=== testing ltWord# ===\"\n  test \"ltWord#\" (zeroW#                     `ltWord#` zeroW#                   ) -- False\n  test \"ltWord#\" (oneW#                      `ltWord#` zeroW#                   ) -- False\n  test \"ltWord#\" (zeroW#                     `ltWord#` oneW#                    ) -- True\n  test \"ltWord#\" (minW#                      `ltWord#` minW#                    ) -- False\n  test \"ltWord#\" (maxW#                      `ltWord#` maxW#                    ) -- False\n  test \"ltWord#\" (minW#                      `ltWord#` (minW# `plusWord#` oneW#)) -- True\n  test \"ltWord#\" ((minW# `minusWord#` oneW#) `ltWord#` minW#                    ) -- False (overflow)\n  test \"ltWord#\" (maxW#                      `ltWord#` (maxW# `plusWord#` oneW#)) -- False (overflow)\n  test \"ltWord#\" ((maxW# `minusWord#` oneW#) `ltWord#` maxW#                    ) -- True\n\n  putStrLn \"=== testing geWord# ===\"\n  test \"geWord#\" (zeroW#                    `geWord#` zeroW#                    ) -- True\n  test \"geWord#\" (oneW#                     `geWord#` zeroW#                    ) -- True\n  test \"geWord#\" (zeroW#                    `geWord#` oneW#                     ) -- False\n  test \"geWord#\" (minW#                     `geWord#` minW#                     ) -- True\n  test \"geWord#\" (maxW#                     `geWord#` maxW#                     ) -- True\n  test \"geWord#\" ((minW# `plusWord#` oneW#) `geWord#` minW#                     ) -- True\n  test \"geWord#\" (minW#                     `geWord#` (minW# `minusWord#` oneW#)) -- False (overflow)\n  test \"geWord#\" ((maxW# `plusWord#` oneW#) `geWord#` maxW#                     ) -- False (overflow)\n  test \"geWord#\" (maxW#                     `geWord#` (maxW# `minusWord#` oneW#)) -- True\n\n  putStrLn \"=== testing leWord# ===\"\n  test \"leWord#\" (zeroW#                     `leWord#` zeroW#                   ) -- True\n  test \"leWord#\" (oneW#                      `leWord#` zeroW#                   ) -- False\n  test \"leWord#\" (zeroW#                     `leWord#` oneW#                    ) -- True\n  test \"leWord#\" (minW#                      `leWord#` minW#                    ) -- True\n  test \"leWord#\" (maxW#                      `leWord#` maxW#                    ) -- True\n  test \"leWord#\" (minW#                      `leWord#` (minW# `plusWord#` oneW#)) -- True\n  test \"leWord#\" ((minW# `minusWord#` oneW#) `leWord#` minW#                    ) -- False (overflow)\n  test \"leWord#\" (maxW#                      `leWord#` (maxW# `plusWord#` oneW#)) -- False (overflow)\n  test \"leWord#\" ((maxW# `minusWord#` oneW#) `leWord#` maxW#                    ) -- True\n\n  putStrLn \"=== testing eqWord# ===\"\n  test \"eqWord#\" (zeroW#                     `eqWord#` zeroW#                    ) -- True\n  test \"eqWord#\" (oneW#                      `eqWord#` zeroW#                    ) -- False\n  test \"eqWord#\" (zeroW#                     `eqWord#` oneW#                     ) -- False\n  test \"eqWord#\" (maxW#                      `eqWord#` maxW#                     ) -- True\n  test \"eqWord#\" ((maxW# `minusWord#` oneW#) `eqWord#` maxW#                     ) -- False\n  test \"eqWord#\" (minW#                      `eqWord#` minW#                     ) -- True\n  test \"eqWord#\" (minW#                      `eqWord#` (minW# `plusWord#` oneW#) ) -- False\n  test \"eqWord#\" (minW#                      `eqWord#` (maxW# `plusWord#` oneW#) ) -- True (overflow)\n  test \"eqWord#\" ((maxW# `plusWord#` oneW#)  `eqWord#` minW#                     ) -- True (overflow)\n  test \"eqWord#\" (maxW#                      `eqWord#` (minW# `minusWord#` oneW#)) -- True (overflow)\n  test \"eqWord#\" ((minW# `minusWord#` oneW#) `eqWord#` maxW#                     ) -- True (overflow)\n\n  putStrLn \"=== testing neWord# ===\"\n  test \"neWord#\" (zeroW#                     `neWord#` zeroW#                    ) -- False\n  test \"neWord#\" (oneW#                      `neWord#` zeroW#                    ) -- True\n  test \"neWord#\" (zeroW#                     `neWord#` oneW#                     ) -- True\n  test \"neWord#\" (maxW#                      `neWord#` maxW#                     ) -- False\n  test \"neWord#\" ((maxW# `minusWord#` oneW#) `neWord#` maxW#                     ) -- True\n  test \"neWord#\" (minW#                      `neWord#` minW#                     ) -- False\n  test \"neWord#\" (minW#                      `neWord#` (minW# `plusWord#` oneW#) ) -- True\n  test \"neWord#\" (minW#                      `neWord#` (maxW# `plusWord#` oneW#) ) -- False (overflow)\n  test \"neWord#\" ((maxW# `plusWord#` oneW#)  `neWord#` minW#                     ) -- False (overflow)\n  test \"neWord#\" (maxW#                      `neWord#` (minW# `minusWord#` oneW#)) -- False (overflow)\n  test \"neWord#\" ((minW# `minusWord#` oneW#) `neWord#` maxW#                     ) -- False (overflow)\n\n  -- PrimOps for comparing Double#\n  putStrLn \"=== testing >## ===\"\n  test \">##\" (0.0##  >## 0.0## ) -- False\n  test \">##\" (1.0##  >## 0.0## ) -- True\n  test \">##\" (0.0##  >## 1.0## ) -- False\n  test \">##\" (0.0##  >## nan## ) -- False\n  test \">##\" (nan##  >## 0.0## ) -- False\n  test \">##\" (nan##  >## nan## ) -- False\n  test \">##\" (infp## >## infp##) -- False\n  test \">##\" (infn## >## infn##) -- False\n  test \">##\" (infp## >## infn##) -- True\n  test \">##\" (infn## >## infp##) -- False\n  test \">##\" (infp## >## nan## ) -- False\n  test \">##\" (infn## >## nan## ) -- False\n  test \">##\" (nan##  >## infp##) -- False\n  test \">##\" (nan##  >## infn##) -- False\n\n  putStrLn \"=== testing <## ===\"\n  test \"<##\" (0.0##  <## 0.0## ) -- False\n  test \"<##\" (1.0##  <## 0.0## ) -- False\n  test \"<##\" (0.0##  <## 1.0## ) -- True\n  test \"<##\" (0.0##  <## nan## ) -- False\n  test \"<##\" (nan##  <## 0.0## ) -- False\n  test \"<##\" (nan##  <## nan## ) -- False\n  test \"<##\" (infp## <## infp##) -- False\n  test \"<##\" (infn## <## infn##) -- False\n  test \"<##\" (infp## <## infn##) -- False\n  test \"<##\" (infn## <## infp##) -- True\n  test \"<##\" (infp## <## nan## ) -- False\n  test \"<##\" (infn## <## nan## ) -- False\n  test \"<##\" (nan##  <## infp##) -- False\n  test \"<##\" (nan##  <## infn##) -- False\n\n  putStrLn \"=== testing >=## ===\"\n  test \">=##\" (0.0##  >=## 0.0## ) -- True\n  test \">=##\" (1.0##  >=## 0.0## ) -- True\n  test \">=##\" (0.0##  >=## 1.0## ) -- False\n  test \">=##\" (0.0##  >=## nan## ) -- False\n  test \">=##\" (nan##  >=## 0.0## ) -- False\n  test \">=##\" (nan##  >=## nan## ) -- False\n  test \">=##\" (infp## >=## infp##) -- True\n  test \">=##\" (infn## >=## infn##) -- True\n  test \">=##\" (infp## >=## infn##) -- True\n  test \">=##\" (infn## >=## infp##) -- False\n  test \">=##\" (infp## >=## nan## ) -- False\n  test \">=##\" (infn## >=## nan## ) -- False\n  test \">=##\" (nan##  >=## infp##) -- False\n  test \">=##\" (nan##  >=## infn##) -- False\n\n  putStrLn \"=== testing <=## ===\"\n  test \"<=##\" (0.0##  <=## 0.0## ) -- True\n  test \"<=##\" (1.0##  <=## 0.0## ) -- False\n  test \"<=##\" (0.0##  <=## 1.0## ) -- True\n  test \"<=##\" (0.0##  <=## nan## ) -- False\n  test \"<=##\" (nan##  <=## 0.0## ) -- False\n  test \"<=##\" (nan##  <=## nan## ) -- False\n  test \"<=##\" (infp## <=## infp##) -- True\n  test \"<=##\" (infn## <=## infn##) -- True\n  test \"<=##\" (infp## <=## infn##) -- False\n  test \"<=##\" (infn## <=## infp##) -- True\n  test \"<=##\" (infp## <=## nan## ) -- False\n  test \"<=##\" (infn## <=## nan## ) -- False\n  test \"<=##\" (nan##  <=## infp##) -- False\n  test \"<=##\" (nan##  <=## infn##) -- False\n\n  putStrLn \"=== testing ==## ===\"\n  test \"==##\" (0.0##  ==## 0.0## ) -- True\n  test \"==##\" (1.0##  ==## 0.0## ) -- False\n  test \"==##\" (0.0##  ==## 1.0## ) -- False\n  test \"==##\" (0.0##  ==## nan## ) -- False\n  test \"==##\" (nan##  ==## 0.0## ) -- False\n  test \"==##\" (nan##  ==## nan## ) -- False\n  test \"==##\" (infp## ==## infp##) -- True\n  test \"==##\" (infn## ==## infn##) -- True\n  test \"==##\" (infp## ==## infn##) -- False\n  test \"==##\" (infn## ==## infp##) -- False\n  test \"==##\" (infp## ==## nan## ) -- False\n  test \"==##\" (infn## ==## nan## ) -- False\n  test \"==##\" (nan##  ==## infp##) -- False\n  test \"==##\" (nan##  ==## infn##) -- False\n\n  putStrLn \"=== testing /=## ===\"\n  test \"/=##\" (0.0##  /=## 0.0## ) -- False\n  test \"/=##\" (1.0##  /=## 0.0## ) -- True\n  test \"/=##\" (0.0##  /=## 1.0## ) -- True\n  test \"/=##\" (0.0##  /=## nan## ) -- True\n  test \"/=##\" (nan##  /=## 0.0## ) -- True\n  test \"/=##\" (nan##  /=## nan## ) -- True\n  test \"/=##\" (infp## /=## infp##) -- False\n  test \"/=##\" (infn## /=## infn##) -- False\n  test \"/=##\" (infp## /=## infn##) -- True\n  test \"/=##\" (infn## /=## infp##) -- True\n  test \"/=##\" (infp## /=## nan## ) -- True\n  test \"/=##\" (infn## /=## nan## ) -- True\n  test \"/=##\" (nan##  /=## infp##) -- True\n  test \"/=##\" (nan##  /=## infn##) -- True\n\n  -- PrimOps for comparing Float#\n  putStrLn \"=== testing gtFloat# ===\"\n  test \"gtFloat#\" (zeroF# `gtFloat#` zeroF#) -- False\n  test \"gtFloat#\" (oneF#  `gtFloat#` zeroF#) -- True\n  test \"gtFloat#\" (zeroF# `gtFloat#` oneF# ) -- False\n  test \"gtFloat#\" (zeroF# `gtFloat#` nanF# ) -- False\n  test \"gtFloat#\" (nanF#  `gtFloat#` zeroF#) -- False\n  test \"gtFloat#\" (nanF#  `gtFloat#` nanF# ) -- False\n  test \"gtFloat#\" (infpF# `gtFloat#` infpF#) -- False\n  test \"gtFloat#\" (infnF# `gtFloat#` infnF#) -- False\n  test \"gtFloat#\" (infpF# `gtFloat#` infnF#) -- True\n  test \"gtFloat#\" (infnF# `gtFloat#` infpF#) -- False\n  test \"gtFloat#\" (infpF# `gtFloat#` nanF# ) -- False\n  test \"gtFloat#\" (infnF# `gtFloat#` nanF# ) -- False\n  test \"gtFloat#\" (nanF#  `gtFloat#` infpF#) -- False\n  test \"gtFloat#\" (nanF#  `gtFloat#` infnF#) -- False\n\n  putStrLn \"=== testing ltFloat# ===\"\n  test \"ltFloat#\" (zeroF# `ltFloat#` zeroF#) -- False\n  test \"ltFloat#\" (oneF#  `ltFloat#` zeroF#) -- False\n  test \"ltFloat#\" (zeroF# `ltFloat#` oneF# ) -- True\n  test \"ltFloat#\" (zeroF# `ltFloat#` nanF# ) -- False\n  test \"ltFloat#\" (nanF#  `ltFloat#` zeroF#) -- False\n  test \"ltFloat#\" (nanF#  `ltFloat#` nanF# ) -- False\n  test \"ltFloat#\" (infpF# `ltFloat#` infpF#) -- False\n  test \"ltFloat#\" (infnF# `ltFloat#` infnF#) -- False\n  test \"ltFloat#\" (infpF# `ltFloat#` infnF#) -- False\n  test \"ltFloat#\" (infnF# `ltFloat#` infpF#) -- True\n  test \"ltFloat#\" (infpF# `ltFloat#` nanF# ) -- False\n  test \"ltFloat#\" (infnF# `ltFloat#` nanF# ) -- False\n  test \"ltFloat#\" (nanF#  `ltFloat#` infpF#) -- False\n  test \"ltFloat#\" (nanF#  `ltFloat#` infnF#) -- False\n\n  putStrLn \"=== testing geFloat# ===\"\n  test \"geFloat#\" (zeroF# `geFloat#` zeroF#) -- True\n  test \"geFloat#\" (oneF#  `geFloat#` zeroF#) -- True\n  test \"geFloat#\" (zeroF# `geFloat#` oneF# ) -- False\n  test \"geFloat#\" (zeroF# `geFloat#` nanF# ) -- False\n  test \"geFloat#\" (nanF#  `geFloat#` zeroF#) -- False\n  test \"geFloat#\" (nanF#  `geFloat#` nanF# ) -- False\n  test \"geFloat#\" (infpF# `geFloat#` infpF#) -- True\n  test \"geFloat#\" (infnF# `geFloat#` infnF#) -- True\n  test \"geFloat#\" (infpF# `geFloat#` infnF#) -- True\n  test \"geFloat#\" (infnF# `geFloat#` infpF#) -- False\n  test \"geFloat#\" (infpF# `geFloat#` nanF# ) -- False\n  test \"geFloat#\" (infnF# `geFloat#` nanF# ) -- False\n  test \"geFloat#\" (nanF#  `geFloat#` infpF#) -- False\n  test \"geFloat#\" (nanF#  `geFloat#` infnF#) -- False\n\n  putStrLn \"=== testing leFloat# ===\"\n  test \"leFloat#\" (zeroF# `leFloat#` zeroF#) -- True\n  test \"leFloat#\" (oneF#  `leFloat#` zeroF#) -- False\n  test \"leFloat#\" (zeroF# `leFloat#` oneF# ) -- True\n  test \"leFloat#\" (zeroF# `leFloat#` nanF# ) -- False\n  test \"leFloat#\" (nanF#  `leFloat#` zeroF#) -- False\n  test \"leFloat#\" (nanF#  `leFloat#` nanF# ) -- False\n  test \"leFloat#\" (infpF# `leFloat#` infpF#) -- True\n  test \"leFloat#\" (infnF# `leFloat#` infnF#) -- True\n  test \"leFloat#\" (infpF# `leFloat#` infnF#) -- False\n  test \"leFloat#\" (infnF# `leFloat#` infpF#) -- True\n  test \"leFloat#\" (infpF# `leFloat#` nanF# ) -- False\n  test \"leFloat#\" (infnF# `leFloat#` nanF# ) -- False\n  test \"leFloat#\" (nanF#  `leFloat#` infpF#) -- False\n  test \"leFloat#\" (nanF#  `leFloat#` infnF#) -- False\n\n  putStrLn \"=== testing eqFloat# ===\"\n  test \"eqFloat#\" (zeroF# `eqFloat#` zeroF#) -- True\n  test \"eqFloat#\" (oneF#  `eqFloat#` zeroF#) -- False\n  test \"eqFloat#\" (zeroF# `eqFloat#` oneF# ) -- False\n  test \"eqFloat#\" (zeroF# `eqFloat#` nanF# ) -- False\n  test \"eqFloat#\" (nanF#  `eqFloat#` zeroF#) -- False\n  test \"eqFloat#\" (nanF#  `eqFloat#` nanF# ) -- False\n  test \"eqFloat#\" (infpF# `eqFloat#` infpF#) -- True\n  test \"eqFloat#\" (infnF# `eqFloat#` infnF#) -- True\n  test \"eqFloat#\" (infpF# `eqFloat#` infnF#) -- False\n  test \"eqFloat#\" (infnF# `eqFloat#` infpF#) -- False\n  test \"eqFloat#\" (infpF# `eqFloat#` nanF# ) -- False\n  test \"eqFloat#\" (infnF# `eqFloat#` nanF# ) -- False\n  test \"eqFloat#\" (nanF#  `eqFloat#` infpF#) -- False\n  test \"eqFloat#\" (nanF#  `eqFloat#` infnF#) -- False\n\n  putStrLn \"=== testing neFloat# ===\"\n  test \"neFloat#\" (zeroF# `neFloat#` zeroF#) -- False\n  test \"neFloat#\" (oneF#  `neFloat#` zeroF#) -- True\n  test \"neFloat#\" (zeroF# `neFloat#` oneF# ) -- True\n  test \"neFloat#\" (zeroF# `neFloat#` nanF# ) -- True\n  test \"neFloat#\" (nanF#  `neFloat#` zeroF#) -- True\n  test \"neFloat#\" (nanF#  `neFloat#` nanF# ) -- True\n  test \"neFloat#\" (infpF# `neFloat#` infpF#) -- False\n  test \"neFloat#\" (infnF# `neFloat#` infnF#) -- False\n  test \"neFloat#\" (infpF# `neFloat#` infnF#) -- True\n  test \"neFloat#\" (infnF# `neFloat#` infpF#) -- True\n  test \"neFloat#\" (infpF# `neFloat#` nanF# ) -- True\n  test \"neFloat#\" (infnF# `neFloat#` nanF# ) -- True\n  test \"neFloat#\" (nanF#  `neFloat#` infpF#) -- True\n  test \"neFloat#\" (nanF#  `neFloat#` infnF#) -- True\n    where\n      -- every integer is compared to 1 representing True. This\n      -- results in printing \"True\" when the primop should return True\n      -- and printing \"False\" when it should return False\n      test :: String -> Int# -> IO ()\n      test str x = putStrLn $ str ++ \" \" ++ (show (I# x == 1))\n      a            = 'a'\n      b            = 'b'\n      !(C# a#)     = a\n      !(C# b#)     = b\n      zeroW        = 0 :: Word\n      oneW         = 1 :: Word\n      !(W# zeroW#) =  zeroW\n      !(W# oneW#)  =  oneW\n      nan          =  0.0 / 0.0 :: Double\n      infp         =  1.0 / 0.0 :: Double\n      infn         = -1.0 / 0.0 :: Double\n      !(D# nan##)  =  0.0 / 0.0\n      !(D# infp##) =  1.0 / 0.0\n      !(D# infn##) = -1.0 / 0.0\n      zeroF        = 0.0 :: Float\n      oneF         = 1.0 :: Float\n      nanF         = 0.0 / 0.0 :: Float\n      infpF        = 1.0 / 0.0 :: Float\n      infnF        = -1.0 / 0.0 :: Float\n      !(F# zeroF#) =  0.0\n      !(F# oneF#)  =  1.0\n      !(F# nanF#)  =  0.0 / 0.0\n      !(F# infpF#) =  1.0 / 0.0\n      !(F# infnF#) = -1.0 / 0.0\n      minC         = minBound :: Char\n      maxC         = maxBound :: Char\n      !(C# minC#)  = minC\n      !(C# maxC#)  = maxC\n      minI         = minBound :: Int\n      maxI         = maxBound :: Int\n      !(I# minI#)  = minI\n      !(I# maxI#)  = maxI\n      minW         = minBound :: Word\n      maxW         = maxBound :: Word\n      !(W# minW#)  = minW\n      !(W# maxW#)  = maxW\n", "num_lines": 442}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash #-}\nmodule Main where\n\nimport Data.Bits (finiteBitSize)\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n  -- 0 is the annihilator of andI#\n  print (I# (maxI# `andI#`    0#) == 0)\n  print (I# (minI# `andI#`    0#) == 0)\n  print (I# (0#    `andI#` maxI#) == 0)\n  print (I# (0#    `andI#` minI#) == 0)\n  print (I# (0#    `andI#`    0#) == 0)\n  -- integer with all bits set to 1 is the neutral element of orI#,\n  -- in two's complement this is -1\n  print (I# (maxI# `andI#`   -1#) == maxI)\n  print (I# (minI# `andI#`   -1#) == minI)\n  print (I# (-1#   `andI#` maxI#) == maxI)\n  print (I# (-1#   `andI#` minI#) == minI)\n  print (I# (-1#   `andI#`   -1#) == -1)\n  -- these two numbers have every other bit set, they should give 0\n  print (I# (magicInt1# `andI#` magicInt2#) == 0)\n\n  -- integer with all bits set to 1 is the annihilator of orI#,\n  print (I# (maxI# `orI#`    -1#) == -1)\n  print (I# (minI# `orI#`    -1#) == -1)\n  print (I# (-1#   `orI#`  maxI#) == -1)\n  print (I# (-1#   `orI#`  minI#) == -1)\n  print (I# (-1#   `orI#`    -1#) == -1)\n  -- 0 is the neutral element of orI#\n  print (I# (maxI# `orI#`     0#) == maxI)\n  print (I# (minI# `orI#`     0#) == minI)\n  print (I# (0#    `orI#`  maxI#) == maxI)\n  print (I# (0#    `orI#`  minI#) == minI)\n  print (I# (0#    `orI#`     0#) == 0)\n  -- this time we should get an integer with all bits set, that is -1\n  print (I# (magicInt1# `orI#` magicInt2#) == -1)\n\n  -- surprising as the first two tests may look, this is what we expect from\n  -- bitwise negation in two's complement enccoding\n  print (I# (notI#  0#) == -1)\n  print (I# (notI# -1#) ==  0)\n  -- magic int numbers are bitwise complementary\n  print (I# (notI# magicInt1#) == magicInt2)\n  print (I# (notI# magicInt2#) == magicInt1)\n\n  -- 0 is the identity of xor\n  print (I# (minI# `xorI#`    0#) == minI)\n  print (I# (maxI# `xorI#`    0#) == maxI)\n  print (I# (0#    `xorI#` minI#) == minI)\n  print (I# (0#    `xorI#` maxI#) == maxI)\n  -- anything xored with itself is 0\n  print (I# (maxI# `xorI#` maxI#) == 0)\n  print (I# (minI# `xorI#` minI#) == 0)\n  -- xoring with -1 is like bitwise negation (because -1 has all bits set to 1)\n  print (I# (minI# `xorI#`   -1#) == maxI)\n  print (I# (maxI# `xorI#`   -1#) == minI)\n  print (I# (-1#   `xorI#` minI#) == maxI)\n  print (I# (-1#   `xorI#` maxI#) == minI)\n  -- since these two have exactly the opposite bits turned on they should\n  -- give an int with all bits set, and that is -1 as you probably already\n  -- remember by now\n  print (I# (magicInt1# `xorI#` magicInt2#) == -1)\n    where\n      intBitSize = finiteBitSize (undefined :: Int)\n      minI  = minBound :: Int\n      maxI  = maxBound :: Int\n      minI# = x\n          where !(I# x) = minBound\n      maxI# = x\n          where !(I# x) = maxBound\n      magicInt1 = sum $ map (2^) [0,2..intBitSize] :: Int\n      magicInt2 = sum $ map (2^) [1,3..intBitSize] :: Int\n      magicInt1# = x\n          where !(I# x) = magicInt1\n      magicInt2# = x\n          where !(I# x) = magicInt2\n", "num_lines": 79}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\nimport Data.Bits\nimport GHC.Exts\n\nwordWidth :: Int\nwordWidth = finiteBitSize (0 :: Word)\n\ncheckI\n    :: (Int, Int)                          -- ^ expected results\n    -> (Int# -> Int# -> (# Int#, Int# #))  -- ^ primop\n    -> Int                                 -- ^ first argument\n    -> Int                                 -- ^ second argument\n    -> Maybe String                        -- ^ maybe error\ncheckI (expX, expY) op (I# a) (I# b) =\n  case op a b of\n      (# x, y #)\n          | I# x == expX && I# y == expY -> Nothing\n          | otherwise ->\n              Just $\n                  \"Expected \" ++ show expX ++ \" and \" ++ show expY\n                      ++ \" but got \" ++ show (I# x) ++ \" and \" ++ show (I# y)\ncheckW\n    :: (Word, Word)                            -- ^ expected results\n    -> (Word# -> Word# -> (# Word#, Word# #))  -- ^ primop\n    -> Word                                    -- ^ first argument\n    -> Word                                    -- ^ second argument\n    -> Maybe String                            -- ^ maybe error\ncheckW (expX, expY) op (W# a) (W# b) =\n    case op a b of\n        (# x, y #)\n            | W# x == expX && W# y == expY -> Nothing\n            | otherwise ->\n                Just $\n                    \"Expected \" ++ show expX ++ \" and \" ++ show expY\n                        ++ \" but got \" ++ show (W# x) ++ \" and \" ++ show (W# y)\n\ncheckW2\n    :: (Word, Word)  -- ^ expected results\n    -> (Word# -> Word# -> Word# -> (# Word#, Word# #))\n                     -- ^ primop\n    -> Word          -- ^ first argument\n    -> Word          -- ^ second argument\n    -> Word          -- ^ third argument\n    -> Maybe String  -- ^ maybe error\ncheckW2 (expX, expY) op (W# a) (W# b) (W# c) =\n    case op a b c of\n        (# x, y #)\n            | W# x == expX && W# y == expY -> Nothing\n            | otherwise ->\n                Just $\n                    \"Expected \" ++ show expX ++ \" and \" ++ show expY\n                        ++ \" but got \" ++ show (W# x) ++ \" and \" ++ show (W# y)\n\ncheck :: String -> Maybe String -> IO ()\ncheck s (Just err) = error $ \"Error for \" ++ s ++ \": \" ++ err\ncheck _ Nothing    = return ()\n\nmain :: IO ()\nmain = do\n    -- First something trivial\n    check \"addIntC# maxBound 0\" $ checkI (maxBound, 0) addIntC# maxBound 0\n    check \"addIntC# 0 maxBound\" $ checkI (maxBound, 0) addIntC# 0 maxBound\n    -- Overflows\n    check \"addIntC# maxBound 1\" $ checkI (minBound, 1) addIntC# maxBound 1\n    check \"addIntC# 1 maxBound\" $ checkI (minBound, 1) addIntC# 1 maxBound\n    check \"addIntC# maxBound 2\" $ checkI (minBound + 1, 1) addIntC# maxBound 2\n    check \"addIntC# 2 maxBound\" $ checkI (minBound + 1, 1) addIntC# 2 maxBound\n    check \"addIntC# minBound minBound\" $\n      checkI (0, 1) addIntC# minBound minBound\n\n    -- First something trivial\n    check \"subIntC# minBound 0\" $ checkI (minBound, 0) subIntC# minBound 0\n    -- Overflows\n    check \"subIntC# minBound 1\" $ checkI (maxBound, 1) subIntC# minBound 1\n    check \"subIntC# minBound 1\" $ checkI (maxBound - 1, 1) subIntC# minBound 2\n    check \"subIntC# 0 minBound\" $ checkI (minBound, 1) subIntC# 0 minBound\n    check \"subIntC# -1 minBound\" $ checkI (maxBound, 0) subIntC# (-1) minBound\n    check \"subIntC# minBound -1\" $\n      checkI (minBound + 1, 0) subIntC# minBound (-1)\n\n    -- First something trivial (note that the order of results is different!)\n    check \"plusWord2# maxBound 0\" $ checkW (0, maxBound) plusWord2# maxBound 0\n    check \"plusWord2# 0 maxBound\" $ checkW (0, maxBound) plusWord2# 0 maxBound\n    -- Overflows\n    check \"plusWord2# maxBound 1\" $\n      checkW (1, minBound) plusWord2# maxBound 1\n    check \"plusWord2# 1 maxBound\" $\n      checkW (1, minBound) plusWord2# 1 maxBound\n    check \"plusWord2# maxBound 2\" $\n      checkW (1, minBound + 1) plusWord2# maxBound 2\n    check \"plusWord2# 2 maxBound\" $\n      checkW (1, minBound + 1) plusWord2# 2 maxBound\n\n    check \"timesWord2# maxBound 0\" $ checkW (0, 0) timesWord2# maxBound 0\n    check \"timesWord2# 0 maxBound\" $ checkW (0, 0) timesWord2# 0 maxBound\n    check \"timesWord2# maxBound 1\" $ checkW (0, maxBound) timesWord2# maxBound 1\n    check \"timesWord2# 1 maxBound\" $ checkW (0, maxBound) timesWord2# 1 maxBound\n    -- Overflows\n    check \"timesWord2# (2^(N-1)) 2\"   $ checkW (1, 0) timesWord2# (2 ^ (wordWidth-1)) 2\n    check \"timesWord2# (2^(N-1)) 2^2\" $ checkW (2, 0) timesWord2# (2 ^ (wordWidth-1)) (2 ^ 2)\n    check \"timesWord2# (2^(N-1)) 2^3\" $ checkW (4, 0) timesWord2# (2 ^ (wordWidth-1)) (2 ^ 3)\n    check \"timesWord2# (2^(N-1)) 2^4\" $ checkW (8, 0) timesWord2# (2 ^ (wordWidth-1)) (2 ^ 4)\n    check \"timesWord2# maxBound 2\" $\n      checkW (1, maxBound - 1) timesWord2# maxBound 2\n    check \"timesWord2# 2 maxBound\" $\n      checkW (1, maxBound - 1) timesWord2# 2 maxBound\n    check \"timesWord2# maxBound 3\" $\n      checkW (2, maxBound - 2) timesWord2# maxBound 3\n    check \"timesWord2# 3 maxBound\" $\n      checkW (2, maxBound - 2) timesWord2# 3 maxBound\n\n    check \"quotRemWord2# 0 0 1\" $ checkW2 (0, 0) quotRemWord2# 0 0 1\n    check \"quotRemWord2# 0 4 2\" $ checkW2 (2, 0) quotRemWord2# 0 4 2\n    check \"quotRemWord2# 0 7 3\" $ checkW2 (2, 1) quotRemWord2# 0 7 3\n    check \"quotRemWord2# 1 0 (2^(N-1))\" $\n      checkW2 (2, 0) quotRemWord2# 1 0 (2 ^ (wordWidth-1))\n    check \"quotRemWord2# 1 1 (2^(N-1))\" $\n      checkW2 (2, 1) quotRemWord2# 1 1 (2 ^ (wordWidth-1))\n    check \"quotRemWord2# 1 0 maxBound\" $\n      checkW2 (1, 1) quotRemWord2# 1 0 maxBound\n    check \"quotRemWord2# 2 0 maxBound\" $\n      checkW2 (2, 2) quotRemWord2# 2 0 maxBound\n    check \"quotRemWord2# 1 maxBound maxBound\" $\n      checkW2 (2, 1) quotRemWord2# 1 maxBound maxBound\n    check \"quotRemWord2# (2^(N-1)) 0 maxBound\" $\n      checkW2 (2 ^ (wordWidth-1), 2 ^ (wordWidth-1)) quotRemWord2# (2 ^ (wordWidth-1)) 0 maxBound\n    check \"quotRemWord2# (2^(N-1)) maxBound maxBound\" $\n      checkW2 (2 ^ (wordWidth-1) + 1, 2 ^ (wordWidth-1)) quotRemWord2# (2 ^ (wordWidth-1)) maxBound maxBound\n", "num_lines": 133}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ppr001 where\n\nmain = putStrLn \"hello\"\n\nfoo x = y + 3\n  where\n    y = 2 ^ x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\nmodule Arrow where\n\nimport Control.Arrow\nimport qualified Control.Category as Cat\n\naddA :: Arrow a => a b Int -> a b Int -> a b Int\naddA f g = proc x -> do\n                y <- f -< x\n                z <- g -< x\n                returnA -< y + z\n\nnewtype Circuit a b = Circuit { unCircuit :: a -> (Circuit a b, b) }\n\ninstance Cat.Category Circuit where\n    id = Circuit $ \\a -> (Cat.id, a)\n    (.) = dot\n      where\n        (Circuit cir2) `dot` (Circuit cir1) = Circuit $ \\a ->\n            let (cir1', b) = cir1 a\n                (cir2', c) = cir2 b\n            in  (cir2' `dot` cir1', c)\n\ninstance Arrow Circuit where\n    arr f = Circuit $ \\a -> (arr f, f a)\n    first (Circuit cir) = Circuit $ \\(b, d) ->\n        let (cir', c) = cir b\n        in  (first cir', (c, d))\n\n-- | Accumulator that outputs a value determined by the supplied function.\naccum :: acc -> (a -> acc -> (b, acc)) -> Circuit a b\naccum acc f = Circuit $ \\input ->\n    let (output, acc') = input `f` acc\n    in  (accum acc' f, output)\n\n-- | Accumulator that outputs the accumulator value.\naccum' :: b -> (a -> b -> b) -> Circuit a b\naccum' acc f = accum acc (\\a b -> let b' = a `f` b in (b', b'))\n\ntotal :: Num a => Circuit a a\ntotal = accum' 0 (+)\n\nmean3 :: Fractional a => Circuit a a\nmean3 = proc value -> do\n    (t, n) <- (| (&&&) (total -< value) (total -< 1) |)\n    returnA -< t / n\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = putStrLn \"hello\"\n\nfoo x =\n  case x of\n   { ;;; -- leading\n     0 -> 'a';  -- case 0\n     1 -> 'b'   -- case 1\n   ; 2 -> 'c' ; -- case 2\n   ; 3 -> 'd'   -- case 3\n          ;;;   -- case 4\n   }\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GADTs #-}\n\n-- From https://www.haskell.org/haskellwiki/GHC/Type_families#An_associated_data_type_example\n\nimport qualified Data.IntMap\nimport Prelude hiding (lookup)\nimport Data.Char (ord)\n\nclass GMapKey k where\n  data GMap k :: * -> *\n  empty       :: GMap k v\n  lookup      :: k -> GMap k v -> Maybe v\n  insert      :: k -> v -> GMap k v -> GMap k v\n\n-- An Int instance\ninstance GMapKey Int where\n  data GMap Int v        = GMapInt (Data.IntMap.IntMap v)\n  empty                  = GMapInt Data.IntMap.empty\n  lookup k   (GMapInt m) = Data.IntMap.lookup k m\n  insert k v (GMapInt m) = GMapInt (Data.IntMap.insert k v m)\n\n-- A Char instance\ninstance GMapKey Char where\n  data GMap Char v        = GMapChar (GMap Int v)\n  empty                   = GMapChar empty\n  lookup k (GMapChar m)   = lookup (ord k) m\n  insert k v (GMapChar m) = GMapChar (insert (ord k) v m)\n\n-- A Unit instance\ninstance GMapKey () where\n  data GMap () v           = GMapUnit (Maybe v)\n  empty                    = GMapUnit Nothing\n  lookup () (GMapUnit v)   = v\n  insert () v (GMapUnit _) = GMapUnit $ Just v\n\n-- Product and sum instances\ninstance (GMapKey a, GMapKey b) => GMapKey (a, b) where\n  data GMap (a, b) v            = GMapPair (GMap a (GMap b v))\n  empty                         = GMapPair empty\n  lookup (a, b) (GMapPair gm)   = lookup a gm >>= lookup b\n  insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of\n                                    Nothing  -> insert a (insert b v empty) gm\n                                    Just gm2 -> insert a (insert b v gm2  ) gm\n\ninstance (GMapKey a, GMapKey b) => GMapKey (Either a b) where\n  data GMap (Either a b) v                = GMapEither (GMap a v) (GMap b v)\n  empty                                   = GMapEither empty empty\n  lookup (Left  a) (GMapEither gm1  _gm2) = lookup a gm1\n  lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2\n  insert (Left  a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2\n  insert (Right b) v (GMapEither gm1 gm2) = GMapEither gm1 (insert b v gm2)\n\nmyGMap :: GMap (Int, Either Char ()) String\nmyGMap = insert (5, Left 'c') \"(5, Left 'c')\"    $\n         insert (4, Right ()) \"(4, Right ())\"    $\n         insert (5, Right ()) \"This is the one!\" $\n         insert (5, Right ()) \"This is the two!\" $\n         insert (6, Right ()) \"(6, Right ())\"    $\n         insert (5, Left 'a') \"(5, Left 'a')\"    $\n         empty\n\nmain = putStrLn $ maybe \"Couldn't find key!\" id $ lookup (5, Right ()) myGMap\n\n-- (Type) Synonym Family\n\ntype family Elem c\n\ntype instance Elem [e] = e\n\n-- type instance Elem BitSet = Char\n\n\ndata family T a\ndata    instance T Int  = T1 Int | T2 Bool\nnewtype instance T Char = TC Bool\n\ndata family G a b\ndata instance G [a] b where\n   G1 :: c -> G [Int] b\n   G2 :: G [a] Bool\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ppr005 where\n\nimport Data.List\n\nfoo = do\n  let x = 1\n  Just 5\n\nf = undefined\ngo = undefined\ne = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Ppr006 where\n\ncommands :: [Command]\ncommands = [\n    command \"help\" \"display a list of all commands, and their current keybindings\" $ do\n      macroGuesses <- Macro.guessCommands commandNames <$> getMacros\n      addTab (Other \"Help\") (makeHelpWidget commands macroGuesses) AutoClose\n\n  , command \"log\" \"show the error log\" $ do\n      messages <- gets logMessages\n      let widget = ListWidget.moveLast (ListWidget.new $ reverse messages)\n      addTab (Other \"Log\") (AnyWidget . LogWidget $ widget) AutoClose\n\n  , command \"map\" \"display a list of all commands that are currently bound to keys\" $ do\n      showMappings\n\n  , command \"map\" \"display the command that is currently bound to the key {name}\" $ do\n      showMapping\n\n  , command \"map\" [help|\n        Bind the command {expansion} to the key {name}.  The same command may\n        be bound to different keys.\n        |] $ do\n      addMapping\n\n  , command \"unmap\" \"remove the binding currently bound to the key {name}\" $ do\n      \\(MacroName m) -> removeMacro m\n\n  , command \"mapclear\" \"\" $ do\n      clearMacros\n\n  , command \"exit\" \"exit vimus\" $ do\n      eval \"quit\"\n\n  , command \"quit\" \"exit vimus\" $ do\n      liftIO exitSuccess :: Vimus ()\n\n  , command \"close\" \"close the current window (not all windows can be closed)\" $ do\n      void closeTab\n\n  , command \"source\" \"read the file {path} and interprets all lines found there as if they were entered as commands.\" $ do\n      \\(Path p) -> liftIO (expandHome p) >>= either printError source_\n\n  , command \"runtime\" \"\" $\n      \\(Path p) -> liftIO (getDataFileName p) >>= source_\n\n  , command \"color\" \"define the fore- and background color for a thing on the screen.\" $ do\n      \\color fg bg -> liftIO (defineColor color fg bg) :: Vimus ()\n\n  , command \"repeat\" \"set the playlist option *repeat*. When *repeat* is set, the playlist will start over when the last song has finished playing.\" $ do\n      MPD.repeat  True :: Vimus ()\n\n  , command \"norepeat\" \"Unset the playlist option *repeat*.\" $ do\n      MPD.repeat  False :: Vimus ()\n\n  , command \"consume\" \"set the playlist option *consume*. When *consume* is set, songs that have finished playing are automatically removed from the playlist.\" $ do\n      MPD.consume True :: Vimus ()\n\n  , command \"noconsume\" \"Unset the playlist option *consume*.\" $ do\n      MPD.consume False :: Vimus ()\n\n  , command \"random\" \"set the playlist option *random*. When *random* is set, songs in the playlist are played in random order.\" $ do\n      MPD.random  True :: Vimus ()\n\n  , command \"norandom\" \"Unset the playlist option *random*.\" $ do\n      MPD.random  False :: Vimus ()\n\n  , command \"single\" \"Set the playlist option *single*. When *single* is set, playback does not advance automatically to the next item in the playlist. Combine with *repeat* to repeatedly play the same song.\" $ do\n      MPD.single  True :: Vimus ()\n\n  , command \"nosingle\" \"Unset the playlist option *single*.\" $ do\n      MPD.single  False :: Vimus ()\n\n  , command \"autotitle\" \"Set the *autotitle* option.  When *autotitle* is set, the console window title is automatically set to the currently playing song.\" $ do\n      setAutoTitle True\n\n  , command \"noautotitle\" \"Unset the *autotitle* option.\" $ do\n      setAutoTitle False\n\n  , command \"volume\" \"[+-] set volume to  or adjust by [+-] num\" $ do\n      volume :: Volume -> Vimus ()\n\n , command \"toggle-repeat\" \"Toggle the *repeat* option.\" $ do\n      MPD.status >>= MPD.repeat  . not . MPD.stRepeat :: Vimus ()\n\n  , command \"toggle-consume\" \"Toggle the *consume* option.\" $ do\n      MPD.status >>= MPD.consume . not . MPD.stConsume :: Vimus ()\n\n  , command \"toggle-random\" \"Toggle the *random* option.\" $ do\n      MPD.status >>= MPD.random  . not . MPD.stRandom :: Vimus ()\n\n  , command \"toggle-single\" \"Toggle the *single* option.\" $ do\n      MPD.status >>= MPD.single  . not . MPD.stSingle :: Vimus ()\n\n  , command \"set-library-path\" \"While MPD knows where your songs are stored, vimus doesn't. If you want to use the *%* feature of the command :! you need to tell vimus where your songs are stored.\" $ do\n      \\(Path p) -> setLibraryPath p\n\n  , command \"next\" \"stop playing the current song, and starts the next one\" $ do\n      MPD.next :: Vimus ()\n\n  , command \"previous\" \"stop playing the current song, and starts the previous one\" $ do\n      MPD.previous :: Vimus ()\n\n  , command \"toggle\" \"toggle between play and pause\" $ do\n      MPDE.toggle :: Vimus ()\n\n  , command \"stop\" \"stop playback\" $ do\n      MPD.stop :: Vimus ()\n\n  , command \"update\" \"tell MPD to update the music database. You must update your database when you add or delete files in your music directory, or when you edit the metadata of a song.  MPD will only rescan a file already in the database if its modification time has changed.\" $ do\n      void (MPD.update Nothing) :: Vimus ()\n\n  , command \"rescan\" \"\" $ do\n      void (MPD.rescan Nothing) :: Vimus ()\n\n  , command \"clear\" \"delete all songs from the playlist\" $ do\n      MPD.clear :: Vimus ()\n\n  , command \"search-next\" \"jump to the next occurrence of the search string in the current window\"\n      searchNext\n\n  , command \"search-prev\" \"jump to the previous occurrence of the search string in the current window\"\n      searchPrev\n\n\n  , command \"window-library\" \"open the *Library* window\" $\n      selectTab Library\n\n  , command \"window-playlist\" \"open the *Playlist* window\" $\n      selectTab Playlist\n\n  , command \"window-search\" \"open the *SearchResult* window\" $\n      selectTab SearchResult\n\n  , command \"window-browser\" \"open the *Browser* window\" $\n      selectTab Browser\n\n  , command \"window-next\" \"open the window to the right of the current one\"\n      nextTab\n\n  , command \"window-prev\" \"open the window to the left of the current one\"\n      previousTab\n\n  , command \"!\" \"execute {cmd} on the system shell. See chapter \\\"Using an external tag editor\\\" for an example.\"\n      runShellCommand\n\n  , command \"seek\" \"jump to the given position in the current song\"\n      seek\n\n  , command \"visual\" \"start visual selection\" $\n      sendEventCurrent EvVisual\n\n  , command \"novisual\" \"cancel visual selection\" $\n      sendEventCurrent EvNoVisual\n\n  -- Remove current song from playlist\n  , command \"remove\" \"remove the song under the cursor from the playlist\" $\n      sendEventCurrent EvRemove\n\n  , command \"paste\" \"add the last deleted song after the selected song in the playlist\" $\n      sendEventCurrent EvPaste\n\n  , command \"paste-prev\" \"\" $\n      sendEventCurrent EvPastePrevious\n\n  , command \"copy\" \"\" $\n      sendEventCurrent EvCopy\n\n  , command \"shuffle\" \"shuffle the current playlist\" $ do\n      MPD.shuffle Nothing :: Vimus ()\n\n  , command \"add\" \"append selected songs to the end of the playlist\" $ do\n      sendEventCurrent EvAdd\n\n  -- insert a song right after the current song\n  , command \"insert\" [help|\n      inserts a song to the playlist. The song is inserted after the currently\n      playing song.\n      |] $ do\n      st <- MPD.status\n      case MPD.stSongPos st of\n        Just n -> do\n          -- there is a current song, insert after\n          sendEventCurrent (EvInsert (n + 1))\n        _ -> do\n          -- there is no current song, just add\n          sendEventCurrent EvAdd\n\n  -- Playlist: play selected song\n  -- Library:  add song to playlist and play it\n  -- Browse:   either add song to playlist and play it, or :move-in\n  , command \"default-action\" [help|\n      depending on the item under the cursor, something different happens:\n\n      - *Playlist* start playing the song under the cursor\n\n      - *Library* append the song under the cursor to the playlist and start playing it\n\n      - *Browser* on a song: append the song to the playlist and play it. On a directory: go down to that directory.\n      |] $ do\n      sendEventCurrent EvDefaultAction\n\n  , command \"add-album\" \"add all songs of the album of the selected song to the playlist\" $ do\n      songs <- fromCurrent MPD.Album [MPD.Disc, MPD.Track]\n      maybe (printError \"Song has no album metadata!\") (MPDE.addMany \"\" . map MPD.sgFilePath) songs\n\n  , command \"add-artist\" \"add all songs of the artist of the selected song to the playlist\" $ do\n      songs <- fromCurrent MPD.Artist [MPD.Date, MPD.Album, MPD.Disc, MPD.Track]\n      maybe (printError \"Song has no artist metadata!\") (MPDE.addMany \"\" . map MPD.sgFilePath) songs\n\n  -- movement\n  , command \"move-up\" \"move the cursor one line up\" $\n      sendEventCurrent EvMoveUp\n\n  , command \"move-down\" \"move the cursor one line down\" $\n      sendEventCurrent EvMoveDown\n\n  , command \"move-album-prev\" \"move the cursor up to the first song of an album\" $\n      sendEventCurrent EvMoveAlbumPrev\n\n  , command \"move-album-next\" \"move the cursor down to the first song of an album\" $\n      sendEventCurrent EvMoveAlbumNext\n\n  , command \"move-in\" \"go down one level the directory hierarchy in the *Browser* window\" $\n      sendEventCurrent EvMoveIn\n\n  , command \"move-out\" \"go up one level in the directory hierarchy in the *Browser* window\" $\n      sendEventCurrent EvMoveOut\n\n  , command \"move-first\" \"go to the first line in the current window\" $\n      sendEventCurrent EvMoveFirst\n\n  , command \"move-last\" \"go to the last line in the current window\" $\n      sendEventCurrent EvMoveLast\n\n  , command \"scroll-up\" \"scroll the contents of the current window up one line\" $\n      sendEventCurrent (EvScroll (-1))\n\n  , command \"scroll-down\" \"scroll the contents of the current window down one line\" $\n      sendEventCurrent (EvScroll 1)\n\n  , command \"scroll-page-up\" \"scroll the contents of the current window up one page\" $\n      pageScroll >>= sendEventCurrent . EvScroll . negate\n\n  , command \"scroll-half-page-up\" \"scroll the contents of the current window up one half page\" $\n      pageScroll >>= sendEventCurrent . EvScroll . negate . (`div` 2)\n\n  , command \"scroll-page-down\" \"scroll the contents of the current window down one page\" $\n      pageScroll >>= sendEventCurrent . EvScroll\n\n  , command \"scroll-half-page-down\" \"scroll the contents of the current window down one half page\" $\n      pageScroll >>= sendEventCurrent . EvScroll . (`div` 2)\n\n  , command \"song-format\" \"set song rendering format\" $\n      sendEvent . EvChangeSongFormat\n  ]\n", "num_lines": 258}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\nmodule Ppr007 where\n\ng :: IO ()\ng = do\n  x <- getChar\n  'a' <- return (3::Int) -- type error\n  return ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE CPP\n           , NoImplicitPrelude\n           , ScopedTypeVariables\n           , BangPatterns\n  #-}\n\nmodule Ppr008\n    (\n    -- * Managing the IO manager\n      Signal\n    , ControlMessage(..)\n    , Control\n    , newControl\n    , closeControl\n    -- ** Control message reception\n    , readControlMessage\n    -- *** File descriptors\n    , controlReadFd\n    , controlWriteFd\n    , wakeupReadFd\n    -- ** Control message sending\n    , sendWakeup\n    , sendDie\n    -- * Utilities\n    , setNonBlockingFD\n    ) where\n\n#include \"EventConfig.h\"\n\nimport Foreign.ForeignPtr (ForeignPtr)\nimport GHC.Base\nimport GHC.Conc.Signal (Signal)\nimport GHC.Real (fromIntegral)\nimport GHC.Show (Show)\nimport GHC.Word (Word8)\nimport Foreign.C.Error (throwErrnoIfMinus1_)\nimport Foreign.C.Types (CInt(..), CSize(..))\nimport Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr)\nimport Foreign.Marshal (alloca, allocaBytes)\nimport Foreign.Marshal.Array (allocaArray)\nimport Foreign.Ptr (castPtr)\nimport Foreign.Storable (peek, peekElemOff, poke)\nimport System.Posix.Internals (c_close, c_pipe, c_read, c_write,\n                               setCloseOnExec, setNonBlockingFD)\nimport System.Posix.Types (Fd)\n\n#if defined(HAVE_EVENTFD)\nimport Foreign.C.Error (throwErrnoIfMinus1)\nimport Foreign.C.Types (CULLong(..))\n#else\nimport Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno)\n#endif\n\ndata ControlMessage = CMsgWakeup\n                    | CMsgDie\n                    | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)\n                                 {-# UNPACK #-} !Signal\n    deriving (Eq, Show)\n\n-- | The structure used to tell the IO manager thread what to do.\ndata Control = W {\n      controlReadFd  :: {-# UNPACK #-} !Fd\n    , controlWriteFd :: {-# UNPACK #-} !Fd\n#if defined(HAVE_EVENTFD)\n    , controlEventFd :: {-# UNPACK #-} !Fd\n#else\n    , wakeupReadFd   :: {-# UNPACK #-} !Fd\n    , wakeupWriteFd  :: {-# UNPACK #-} !Fd\n#endif\n    , didRegisterWakeupFd :: !Bool\n    } deriving (Show)\n\n#if defined(HAVE_EVENTFD)\nwakeupReadFd :: Control -> Fd\nwakeupReadFd = controlEventFd\n{-# INLINE wakeupReadFd #-}\n#endif\n\n-- | Create the structure (usually a pipe) used for waking up the IO\n-- manager thread from another thread.\nnewControl :: Bool -> IO Control\nnewControl shouldRegister = allocaArray 2 $ \\fds -> do\n  let createPipe = do\n        throwErrnoIfMinus1_ \"pipe\" $ c_pipe fds\n        rd <- peekElemOff fds 0\n        wr <- peekElemOff fds 1\n        -- The write end must be non-blocking, since we may need to\n        -- poke the event manager from a signal handler.\n        setNonBlockingFD wr True\n        setCloseOnExec rd\n        setCloseOnExec wr\n        return (rd, wr)\n  (ctrl_rd, ctrl_wr) <- createPipe\n#if defined(HAVE_EVENTFD)\n  ev <- throwErrnoIfMinus1 \"eventfd\" $ c_eventfd 0 0\n  setNonBlockingFD ev True\n  setCloseOnExec ev\n  when shouldRegister $ c_setIOManagerWakeupFd ev\n#else\n  (wake_rd, wake_wr) <- createPipe\n  when shouldRegister $ c_setIOManagerWakeupFd wake_wr\n#endif\n  return W { controlReadFd  = fromIntegral ctrl_rd\n           , controlWriteFd = fromIntegral ctrl_wr\n#if defined(HAVE_EVENTFD)\n           , controlEventFd = fromIntegral ev\n#else\n           , wakeupReadFd   = fromIntegral wake_rd\n           , wakeupWriteFd  = fromIntegral wake_wr\n#endif\n           , didRegisterWakeupFd = shouldRegister\n           }\n\n-- | Close the control structure used by the IO manager thread.\n-- N.B. If this Control is the Control whose wakeup file was registered with\n-- the RTS, then *BEFORE* the wakeup file is closed, we must call\n-- c_setIOManagerWakeupFd (-1), so that the RTS does not try to use the wakeup\n-- file after it has been closed.\ncloseControl :: Control -> IO ()\ncloseControl w = do\n  _ <- c_close . fromIntegral . controlReadFd $ w\n  _ <- c_close . fromIntegral . controlWriteFd $ w\n  when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1)\n#if defined(HAVE_EVENTFD)\n  _ <- c_close . fromIntegral . controlEventFd $ w\n#else\n  _ <- c_close . fromIntegral . wakeupReadFd $ w\n  _ <- c_close . fromIntegral . wakeupWriteFd $ w\n#endif\n  return ()\n\nio_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8\nio_MANAGER_WAKEUP = 0xff\nio_MANAGER_DIE    = 0xfe\n\nforeign import ccall \"__hscore_sizeof_siginfo_t\"\n    sizeof_siginfo_t :: CSize\n\nreadControlMessage :: Control -> Fd -> IO ControlMessage\nreadControlMessage ctrl fd\n    | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \\p -> do\n                    throwErrnoIfMinus1_ \"readWakeupMessage\" $\n                      c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize)\n                    return CMsgWakeup\n    | otherwise =\n        alloca $ \\p -> do\n            throwErrnoIfMinus1_ \"readControlMessage\" $\n                c_read (fromIntegral fd) p 1\n            s <- peek p\n            case s of\n                -- Wakeup messages shouldn't be sent on the control\n                -- file descriptor but we handle them anyway.\n                _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup\n                _ | s == io_MANAGER_DIE    -> return CMsgDie\n                _ -> do  -- Signal\n                    fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t)\n                    withForeignPtr fp $ \\p_siginfo -> do\n                        r <- c_read (fromIntegral fd) (castPtr p_siginfo)\n                             sizeof_siginfo_t\n                        when (r /= fromIntegral sizeof_siginfo_t) $\n                            error \"failed to read siginfo_t\"\n                        let !s' = fromIntegral s\n                        return $ CMsgSignal fp s'\n\n  where wakeupBufferSize =\n#if defined(HAVE_EVENTFD)\n            8\n#else\n            4096\n#endif\n\nsendWakeup :: Control -> IO ()\n#if defined(HAVE_EVENTFD)\nsendWakeup c =\n  throwErrnoIfMinus1_ \"sendWakeup\" $\n  c_eventfd_write (fromIntegral (controlEventFd c)) 1\n#else\nsendWakeup c = do\n  n <- sendMessage (wakeupWriteFd c) CMsgWakeup\n  case n of\n    _ | n /= -1   -> return ()\n      | otherwise -> do\n                   errno <- getErrno\n                   when (errno /= eAGAIN && errno /= eWOULDBLOCK) $\n                     throwErrno \"sendWakeup\"\n#endif\n\nsendDie :: Control -> IO ()\nsendDie c = throwErrnoIfMinus1_ \"sendDie\" $\n            sendMessage (controlWriteFd c) CMsgDie\n\nsendMessage :: Fd -> ControlMessage -> IO Int\nsendMessage fd msg = alloca $ \\p -> do\n  case msg of\n    CMsgWakeup        -> poke p io_MANAGER_WAKEUP\n    CMsgDie           -> poke p io_MANAGER_DIE\n    CMsgSignal _fp _s -> error \"Signals can only be sent from within the RTS\"\n  fromIntegral `fmap` c_write (fromIntegral fd) p 1\n\n#if defined(HAVE_EVENTFD)\nforeign import ccall unsafe \"sys/eventfd.h eventfd\"\n   c_eventfd :: CInt -> CInt -> IO CInt\n\nforeign import ccall unsafe \"sys/eventfd.h eventfd_write\"\n   c_eventfd_write :: CInt -> CULLong -> IO CInt\n#endif\n\nforeign import ccall unsafe \"setIOManagerWakeupFd\"\n   c_setIOManagerWakeupFd :: CInt -> IO ()\n\nforeign import ccall unsafe \"static baz\"\n   c_baz :: CInt -> IO ()\n", "num_lines": 214}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ppr009 where\n\n\n{-# INLINE strictStream #-}\nstrictStream (Bitstream l v)\n    = {-# CORE \"Strict Bitstream stream\" #-}\n      S.concatMap stream (GV.stream v)\n      `S.sized`\n      Exact l\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language CPP #-}\nmodule Ppr010 where\n\n#if __GLASGOW_HASKELL__ > 704\nfoo :: Int\n#else\nfoo :: Integer\n#endif\nfoo = 3\n\nbar :: (\n#if __GLASGOW_HASKELL__ > 704\n    Int)\n#else\n    Integer)\n#endif\nbar = 4\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language DatatypeContexts #-}\n{-# Language ExistentialQuantification #-}\n{-# LAnguage GADTs #-}\n{-# LAnguage KindSignatures #-}\n\ndata Foo = A\n         | B\n         | C\n\n--         | data_or_newtype capi_ctype tycl_hdr constrs deriving\ndata {-# Ctype \"Foo\" \"bar\" #-} F1 = F1\ndata {-# Ctype       \"baz\" #-} Eq a =>  F2 a = F2 a\n\ndata (Eq a,Ord a) => F3 a = F3 Int a\n\ndata F4 a = forall x y. (Eq x,Eq y) => F4 a x y\n          | forall x y. (Eq x,Eq y) => F4b a x y\n\n\ndata G1 a :: * where\n  G1A,  G1B :: Int -> G1 a\n  G1C :: Double -> G1 a\n\ndata G2 a :: * where\n  G2A :: { g2a :: a, g2b :: Int } -> G2 a\n  G2C :: Double -> G2 a\n\n\n\ndata (Eq a,Ord a) => G3 a = G3\n  { g3A :: Int\n  , g3B :: Bool\n  , g3a :: a\n  } deriving (Eq,Ord)\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Dead1(foo) where\n\nfoo :: Int -> Int\nfoo n = baz (n+1) (bar1 n)\n\n{-# NOINLINE bar1 #-}\nbar1 n = 1 + bar n\n\nbar :: Int -> Int\n{-# NOINLINE bar #-}\n{-# RULES\n\"bar/foo\" forall n. bar (foo n) = n\n   #-}\nbar n = n-1\n\nbaz :: Int -> Int -> Int\n{-# INLINE [0] baz #-}\nbaz m n = m\n\n\n{- Ronam writes (Feb08)\n\n    Note that bar becomes dead as soon as baz gets inlined. But strangely,\n    the simplifier only deletes it after full laziness and CSE. That is, it\n    is not deleted in the phase in which baz gets inlined. In fact, it is\n    still there after w/w and the subsequent simplifier run. It gets deleted\n    immediately if I comment out the rule.\n\n    I stumbled over this when I removed one simplifier run after SpecConstr\n    (at the moment, it runs twice at the end but I don't think that should\n    be necessary). With this change, the original version of a specialised\n    loop (the one with the rules) is not longer deleted even if it isn't\n    used any more. I'll reenable the second simplifier run for now but\n    should this really be necessary?\n\nNo, it should not be necessary.  A refactoring in OccurAnal makes\nthis work right. Look at the simplifier output just before strictness\nanalysis; there should be a binding for 'foo', but for nothing else.\n\n-}\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n\nimport Data.Data\n\ndata Foo = FooA | FooB\n\nderiving instance Show Foo\n\nderiving instance {-# Overlappable #-} Eq Foo\nderiving instance {-# Overlapping  #-} Ord Foo\nderiving instance {-# Overlaps     #-} Typeable Foo\nderiving instance {-# Incoherent   #-} Data Foo\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- from https://ocharles.org.uk/blog/guest-posts/2014-12-19-existential-quantification.html\n\ndata HashMap k v = HM  -- ... -- actual implementation\n\nclass Hashable v where\n  h :: v -> Int\n\ndata HashMapM hm = HashMapM\n  { empty  :: forall k v . hm k v\n  , lookup :: Hashable k => k -> hm k v -> Maybe v\n  , insert :: Hashable k => k -> v -> hm k v -> hm k v\n  , union  :: Hashable k => hm k v -> hm k v -> hm k v\n  }\n\n\ndata HashMapE = forall hm . HashMapE (HashMapM hm)\n\n-- public\nmkHashMapE :: Int -> HashMapE\nmkHashMapE = HashMapE . mkHashMapM\n\n-- private\nmkHashMapM :: Int -> HashMapM HashMap\nmkHashMapM salt = HashMapM { {- implementation -} }\n\ninstance Hashable String where\n\ntype Name = String\ndata Gift = G String\n\ngiraffe :: Gift\ngiraffe = G \"giraffe\"\n\naddGift :: HashMapM hm -> hm Name Gift -> hm Name Gift\naddGift mod gifts =\n  let\n    HashMapM{..} = mod\n  in\n    insert \"Ollie\" giraffe gifts\n\n-- -------------------------------\n\nsanta'sSecretSalt = undefined\nsendGiftToOllie = undefined\ntraverse_ = undefined\n\nsendGifts =\n  case mkHashMapE santa'sSecretSalt of\n    HashMapE (mod@HashMapM{..}) ->\n      let\n        gifts = addGift mod empty\n      in\n        traverse_ sendGiftToOllie $ lookup \"Ollie\" gifts\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ExprPragmas where\n\na = {-# SCC \"name\"   #-}  0x5\n\nb = {-# SCC foo   #-} 006\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\nexplicit :: ((?above :: q, ?below :: a -> q) => b) -> q -> (a -> q) -> b\nexplicit x ab be = x where ?above = ab; ?below = be\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ExplicitNamespaces #-}\nmodule Imports( f, type (+), pattern Single ) where\n\nimport GHC.TypeLits\n\npattern Single x = [x]\n\nf = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE DeriveAnyClass #-}\n\ndata Foo a = F Int | A a\n  deriving Show\n\ndata Foo1 a = F1 Int | A1 a\n  deriving (Show)\n\ndata Foo2 a = F2 Int | A2 a\n  deriving (Show, Eq)\n\ndata FooStock = FS Int\n  deriving stock Show\n\ndata FooAnyClass = Fa Int\n  deriving anyclass Show\n\nnewtype FooNewType = Fn Int\n  deriving newtype (Show)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses,\n             CPP #-}\n#if __GLASGOW_HASKELL__ >= 708\n{-# LANGUAGE RoleAnnotations #-}\n#endif\n\n{-# OPTIONS_HADDOCK hide #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Array.IO.Internal\n-- Copyright   :  (c) The University of Glasgow 2001-2012\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  experimental\n-- Portability :  non-portable (uses Data.Array.Base)\n--\n-- Mutable boxed and unboxed arrays in the IO monad.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Array.IO.Internals (\n    IOArray(..),         -- instance of: Eq, Typeable\n    IOUArray(..),        -- instance of: Eq, Typeable\n    castIOUArray,        -- :: IOUArray ix a -> IO (IOUArray ix b)\n    unsafeThawIOUArray,\n  ) where\n\nimport Data.Int\nimport Data.Word\nimport Data.Typeable\n\nimport Control.Monad.ST         ( RealWorld, stToIO )\nimport Foreign.Ptr              ( Ptr, FunPtr )\nimport Foreign.StablePtr        ( StablePtr )\n\n#if __GLASGOW_HASKELL__ < 711\nimport Data.Ix\n#endif\nimport Data.Array.Base\n\nimport GHC.IOArray (IOArray(..))\n\n-----------------------------------------------------------------------------\n-- Flat unboxed mutable arrays (IO monad)\n\n-- | Mutable, unboxed, strict arrays in the 'IO' monad.  The type\n-- arguments are as follows:\n--\n--  * @i@: the index type of the array (should be an instance of 'Ix')\n--\n--  * @e@: the element type of the array.  Only certain element types\n--    are supported: see \"Data.Array.MArray\" for a list of instances.\n--\nnewtype IOUArray i e = IOUArray (STUArray RealWorld i e)\n                       deriving Typeable\n#if __GLASGOW_HASKELL__ >= 708\n-- Both parameters have class-based invariants. See also #9220.\ntype role IOUArray nominal nominal\n#endif\n\ninstance Eq (IOUArray i e) where\n    IOUArray s1 == IOUArray s2  =  s1 == s2\n\ninstance MArray IOUArray Bool IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Char IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Int IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Word IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray (Ptr a) IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray (FunPtr a) IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Float IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Double IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray (StablePtr a) IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Int8 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Int16 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Int32 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Int64 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Word8 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Word16 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Word32 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\ninstance MArray IOUArray Word64 IO where\n    {-# INLINE getBounds #-}\n    getBounds (IOUArray arr) = stToIO $ getBounds arr\n    {-# INLINE getNumElements #-}\n    getNumElements (IOUArray arr) = stToIO $ getNumElements arr\n    {-# INLINE newArray #-}\n    newArray lu initialValue = stToIO $ do\n        marr <- newArray lu initialValue; return (IOUArray marr)\n    {-# INLINE unsafeNewArray_ #-}\n    unsafeNewArray_ lu = stToIO $ do\n        marr <- unsafeNewArray_ lu; return (IOUArray marr)\n    {-# INLINE newArray_ #-}\n    newArray_ = unsafeNewArray_\n    {-# INLINE unsafeRead #-}\n    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)\n    {-# INLINE unsafeWrite #-}\n    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)\n\n-- | Casts an 'IOUArray' with one element type into one with a\n-- different element type.  All the elements of the resulting array\n-- are undefined (unless you know what you\\'re doing...).\ncastIOUArray :: IOUArray ix a -> IO (IOUArray ix b)\ncastIOUArray (IOUArray marr) = stToIO $ do\n    marr' <- castSTUArray marr\n    return (IOUArray marr')\n\n{-# INLINE unsafeThawIOUArray #-}\n#if __GLASGOW_HASKELL__ >= 711\nunsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e)\n#else\nunsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)\n#endif\nunsafeThawIOUArray arr = stToIO $ do\n    marr <- unsafeThawSTUArray arr\n    return (IOUArray marr)\n\n{-# RULES\n\"unsafeThaw/IOUArray\" unsafeThaw = unsafeThawIOUArray\n    #-}\n\n#if __GLASGOW_HASKELL__ >= 711\nthawIOUArray :: UArray ix e -> IO (IOUArray ix e)\n#else\nthawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)\n#endif\nthawIOUArray arr = stToIO $ do\n    marr <- thawSTUArray arr\n    return (IOUArray marr)\n\n{-# RULES\n\"thaw/IOUArray\" thaw = thawIOUArray\n    #-}\n\n{-# INLINE unsafeFreezeIOUArray #-}\n#if __GLASGOW_HASKELL__ >= 711\nunsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e)\n#else\nunsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)\n#endif\nunsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)\n\n{-# RULES\n\"unsafeFreeze/IOUArray\" unsafeFreeze = unsafeFreezeIOUArray\n    #-}\n\n#if __GLASGOW_HASKELL__ >= 711\nfreezeIOUArray :: IOUArray ix e -> IO (UArray ix e)\n#else\nfreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)\n#endif\nfreezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)\n\n{-# RULES\n\"freeze/IOUArray\" freeze = freezeIOUArray\n    #-}\n", "num_lines": 428}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\n\nfoo = f >>= \\case\n        Just h -> loadTestDB (h ++ \"/.testdb\")\n        Nothing -> fmap S.Right initTestDB\n\n{-| Is the alarm set - i.e. will it go off at some point in the future even if\n   `setAlarm` is not called? -}\nisAlarmSetSTM :: AlarmClock -> STM Bool\nisAlarmSetSTM AlarmClock{..} = readTVar acNewSetting\n  >>= \\case { AlarmNotSet -> readTVar acIsSet; _ -> return True }\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# Language DeriveFoldable #-}\n{-# LANGUAGE Safe #-}\n{-# options_ghc -w #-}\n\n-- | A simple let expression, to ensure the layout is detected\n-- With some haddock in the top\n{- And a normal\n   multiline comment too -}\n  module {- brah -}  LetExpr        ( foo -- foo does ..\n                                    , bar -- bar does ..\n                                    , Baz () -- baz does ..\n                                 , Ba   ( ..),Ca(Cc,Cd)   ,\n                                     bbb ,  aaa\n                                  , module  Data.List\n                                    , pattern  Bar\n                                    )\n    where\n\nimport Data.List\n-- A comment in the middle\nimport {-# SOURCE #-} BootImport ( Foo(..) )\nimport {-# SoURCE  #-} safe   qualified  BootImport   as    BI\nimport qualified Data.Map as {- blah -}  Foo.Map\n\nimport Control.Monad  (   )\nimport Data.Word (Word8)\nimport Data.Tree hiding  (  drawTree   )\n\nimport qualified Data.Maybe as M hiding    ( maybe  , isJust  )\n\n\n-- comment\nfoo = let x = 1\n          y = 2\n      in x + y\n\nbar = 3\nbbb x\n | x == 1 = ()\n | otherwise = ()\n\n\naaa [ ] _   = 0\naaa x  _unk = 1\n\naba () = 0\n\nx `ccc` 1 = x + 1\nx `ccc` y = x + y\n\nx !@# y = x + y\n\ndata Baz = Baz1 | Baz2\n\ndata Ba = Ba | Bb\n\ndata Ca = Cc | Cd\n\npattern Foo a <- RealFoo a\npattern Bar a <- RealBar a\n\ndata Thing = RealFoo Thing | RealBar Int\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TemplateHaskell #-}\n\napplicate :: Bool -> [Stmt] -> ExpQ\napplicate rawPatterns stmt = do\n    return $ foldl (\\g e -> VarE '(<**>) `AppE` e `AppE` g)\n                    (VarE 'pure `AppE` f')\n                    es\n\ntuple :: Int -> ExpQ\ntuple n = do\n    ns <- replicateM n (newName \"x\")\n    lamE [foldr (\\x y -> conP '(:) [varP x,y]) wildP ns] (tupE $ map varE ns)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "class AwsType a where\n    toText :: a -> b\n\n\n    {-# MINIMAL toText #-}\n\nclass Minimal a where\n  toText :: a -> b\n  {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-}\n\nclass Minimal a where\n  toText :: a -> b\n  {-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-}\n\nclass Minimal a where\n  toText :: a -> b\n  {-# MINIMAL (toSample | toSamples) #-}\n\nclass ManyOps a where\n    aOp :: a -> a -> Bool\n    bOp :: a -> a -> Bool\n    cOp :: a -> a -> Bool\n    dOp :: a -> a -> Bool\n    eOp :: a -> a -> Bool\n    fOp :: a -> a -> Bool\n    {-# MINIMAL  ( aOp)\n               | ( bOp   , cOp)\n               | ((dOp  |  eOp) , fOp)\n      #-}\n\nclass Foo a where\n    bar :: a -> a -> Bool\n    foo :: a -> a -> Bool\n    baq :: a -> a -> Bool\n    baz :: a -> a -> Bool\n    quux :: a -> a -> Bool\n    {-# MINIMAL bar, (foo, baq | foo, quux) #-}\n\nclass Foo2 a where\n  f :: a\n  {-# MiNiMaL f #-}\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.List  ()\nimport Data.List  hiding ()\n\ninfixl 1 `f`\n-- infixr 2 `\\\\\\`\ninfix  3 :==>\ninfix  4 `MkFoo`\n\ndata Foo = MkFoo Int | Float :==> Double\n\nx `f` y = x\n\n(\\\\\\) :: (Eq a) => [a] -> [a] -> [a]\n(\\\\\\) xs ys =  xs\n\ng x = x + if True then 1 else 2\nh x = x + 1::Int\n\n{-# SPECIALISe j :: Int -> Int\n                  , Integer -> Integer #-}\n\nj n = n + 1\n\ntest = let k x y = x+y in 1 `k` 2 `k` 3\n\ndata Rec = (:<-:) { a :: Int, b :: Float }\n\nng1 x y = negate y\n\ninstance (Num a, Num b) => Num (a,b)\n  where\n   {-# Specialise instance Num (Int,Int) #-}\n   negate (a,b) = (ng 'c' a, ng1 'c' b)   where  ng x y = negate y\n\n\n\nclass Foo1 a where\n\nclass Foz a\n\nx = 2 where\ny = 3\n\ninstance Foo1 Int where\n\nff = ff where g = g where\ntype T = Int\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows #-}\n\noperator = describe \"Operators on ProcessA\"$\n  do\n    describe \"feedback\" $\n      do\n        it \"acts like local variable with hold.\" $\n          do\n            let\n                pa = proc evx ->\n                  do\n                    (\\evy -> hold 10 -< evy)\n                      `feedback` \\y ->\n                      do\n                        returnA -< ((+y) <$> evx, (y+1) <$ evx)\n            run pa [1, 2, 3] `shouldBe` [11, 13, 15]\n\n        it \"correctly handles stream end.\" $\n          do\n            let\n                pa = proc x ->\n                    (\\asx -> returnA -< asx)\n                  `feedback`\n                    (\\asy -> returnA -< (asy::Event Int, x))\n                comp = mkProc (PgPush PgStop) >>> pa\n            stateProc comp [0, 0] `shouldBe` ([], [0])\n\n        it \"correctly handles stream end.(2)\" $\n          do\n            pendingWith \"many utilities behave incorrectly at end of stream.\"\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language OverloadedStrings #-}\n-- from https://ocharles.org.uk/blog/posts/2014-12-17-overloaded-strings.html\n\nimport Data.String\n\nn :: Num a => a\nn = 43\n\nf  :: Fractional a => a\nf = 03.1420\n\n-- foo :: Text\nfoo :: Data.String.IsString a => a\nfoo = \"hello\\n there\"\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XTemplateHaskell #-}\nmodule TH( x ) where\nimport Language.Haskell.TH\n\nx = $(return (LitE (StringL \"hello\\ngoodbye\\nand then\")))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-#LANGUAGE Arrows, RankNTypes, ScopedTypeVariables, FlexibleContexts,\n  TypeSynonymInstances, NoMonomorphismRestriction, FlexibleInstances #-}\n\nvalForm initVal vtor label = withInput $\n    proc ((),nm,fi) -> do\n      s_curr <- keepState initVal -< fi\n      valid <- vtor -< s_curr\n      case valid of\n         Left err -> returnA -< (textField label (Just err) s_curr nm,\n                                                   Nothing)\n         Right x -> returnA -< (textField label Nothing s_curr nm,\n                                Just x)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rules where\n\nimport Data.Char\n\n{-# RULES \"map-loop\" [ ~  ]  forall f . map' f = map' (id . f) #-}\n\n{-# NOINLINE map' #-}\nmap' f [] = []\nmap' f (x:xs) = f x : map' f xs\n\nmain = print (map' toUpper \"Hello, World\")\n\n-- Should warn\nfoo1 x = x\n{-# RULES \"foo1\" [ 1] forall x. foo1 x = x #-}\n\n-- Should warn\nfoo2 x = x\n{-# INLINE foo2 #-}\n{-# RULES \"foo2\" [~ 1 ] forall x. foo2 x = x #-}\n\n-- Should not warn\nfoo3 x = x\n{-# NOINLINE foo3 #-}\n{-# RULES \"foo3\" forall x. foo3 x = x #-}\n\n{-# NOINLINE f #-}\nf :: Int -> String\nf x = \"NOT FIRED\"\n\n{-# NOINLINE neg #-}\nneg :: Int -> Int\nneg = negate\n\n{-# RULES\n     \"f\" forall (c::Char->Int) (x::Char). f (c x) = \"RULE FIRED\"\n #-}\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# RULES\n  \"cFloatConv/Float->Float\"    forall (x::Float).  cFloatConv x = x;\n  \"cFloatConv/Double->Double\"  forall (x::Double). cFloatConv x = x;\n  \"cFloatConv/Float->CFloat\"   forall (x::Float).  cFloatConv x = CFloat x;\n  \"cFloatConv/CFloat->Float\"   forall (x::Float).  cFloatConv CFloat x = x;\n  \"cFloatConv/Double->CDouble\" forall (x::Double). cFloatConv x = CDouble x;\n  \"cFloatConv/CDouble->Double\" forall (x::Double). cFloatConv CDouble x = x\n #-};\n\ncFloatConv = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards #-}\nspec :: Spec\nspec = do\n  describe \"split4'8\" $ do\n    it \"0xabc\" $ do\n      split4'8 0xabc `shouldBe` (0x0a, 0xbc)\n    it \"0xfff\" $ do\n      split4'8 0xfff `shouldBe` (0x0f, 0xff)\n\n    describe \"(x, y) = split4'8 z\" $ do\n      prop \"x <= 0x0f\" $\n        \\z -> let (x, _) =  split4'8 z in x <= 0x0f\n      prop \"x << 8 | y == z\" $ do\n        \\z -> let (x, y) = split4'8 z in\n          fromIntegral x `shiftL` 8 .|. fromIntegral y == z\n\nmatch s@Status{ pos, flips, captureAt, captureLen }\n  | isOne ?pat = ite (pos .>= strLen) __FAIL__ one\n  | otherwise = ite (pos + (toEnum $ minLen ?pat) .> strLen) __FAIL__ $ case ?pat of\n    POr ps -> choice flips $ map (\\p -> \\b -> let ?pat = p in match s{ flips = b }) ps\n\nfoo = 1\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule Sigs where\n\n-- TypeSig\nf :: Num a => a -> a\nf = undefined\n\npattern Single :: () => (Show a) => a -> [a]\npattern Single x = [x]\n\ng :: (Show a) => [a] -> a\ng (Single x) = x\n\n-- Fixities\n\ninfixr  6 +++\ninfixr  7 ***,///\n\n(+++) :: Int -> Int -> Int\na +++ b = a + 2*b\n\n(***) :: Int -> Int -> Int\na *** b = a - 4*b\n\n(///) :: Int -> Int -> Int\na /// b = 2*a - 3*b\n\n-- Inline signatures\n\n{-# Inline g #-}\n{-# INLINE [~34] f #-}\n\n-- Specialise signature\n\n-- Multiple sigs\nx,y,z :: Int\nx = 0\ny = 0\nz = 0\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell            #-}\n\nimport Language.Haskell.TH\n\nmakeLenses '' PostscriptFont\n\nty :: Q Type\nty = [t| Int |]\n\nf :: $ty\nf = undefined\n\ng :: $(ty)\ng = undefined\n\nthb = $(do { let x = mkName \"x\"\n                 v = return (LamE [VarP x] $ VarE x)\n           ; [| $v . id |] })\n\nfoo2 :: A Bool\nfoo2 = $$(y)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\nmodule Algebra.Additive (\n    -- * Class\n    C,\n    zero,\n    (+), (-),\n    negate, subtract,\n\n    -- * Complex functions\n    sum, sum1,\n    sumNestedAssociative,\n    sumNestedCommutative,\n\n    -- * Instance definition helpers\n    elementAdd, elementSub, elementNeg,\n    (<*>.+), (<*>.-), (<*>.-$),\n\n    -- * Instances for atomic types\n    propAssociative,\n    propCommutative,\n    propIdentity,\n    propInverse,\n  ) where\n\nimport qualified Algebra.Laws as Laws\n\nimport Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )\nimport Data.Word (Word, Word8, Word16, Word32, Word64, )\n\nimport qualified NumericPrelude.Elementwise as Elem\nimport Control.Applicative (Applicative(pure, (<*>)), )\nimport Data.Tuple.HT (fst3, snd3, thd3, )\nimport qualified Data.List.Match as Match\n\nimport qualified Data.Complex as Complex98\nimport qualified Data.Ratio as Ratio98\nimport qualified Prelude as P\nimport Prelude (Integer, Float, Double, fromInteger, )\nimport NumericPrelude.Base\n\n\ninfixl 6  +, -\n\n{- |\nAdditive a encapsulates the notion of a commutative group, specified\nby the following laws:\n\n@\n          a + b === b + a\n    (a + b) + c === a + (b + c)\n       zero + a === a\n   a + negate a === 0\n@\n\nTypical examples include integers, dollars, and vectors.\n\nMinimal definition: '+', 'zero', and ('negate' or '(-)')\n-}\n\nclass C a where\n    {-# MINIMAL zero, (+), ((-) | negate) #-}\n    -- | zero element of the vector space\n    zero     :: a\n    -- | add and subtract elements\n    (+), (-) :: a -> a -> a\n    -- | inverse with respect to '+'\n    negate   :: a -> a\n\n    {-# INLINE negate #-}\n    negate a = zero - a\n    {-# INLINE (-) #-}\n    a - b    = a + negate b\n\n{- |\n'subtract' is @(-)@ with swapped operand order.\nThis is the operand order which will be needed in most cases\nof partial application.\n-}\nsubtract :: C a => a -> a -> a\nsubtract = flip (-)\n\n\n\n\n{- |\nSum up all elements of a list.\nAn empty list yields zero.\n\nThis function is inappropriate for number types like Peano.\nMaybe we should make 'sum' a method of Additive.\nThis would also make 'lengthLeft' and 'lengthRight' superfluous.\n-}\nsum :: (C a) => [a] -> a\nsum = foldl (+) zero\n\n{- |\nSum up all elements of a non-empty list.\nThis avoids including a zero which is useful for types\nwhere no universal zero is available.\n-}\nsum1 :: (C a) => [a] -> a\nsum1 = foldl1 (+)\n\n\n{- |\nSum the operands in an order,\nsuch that the dependencies are minimized.\nDoes this have a measurably effect on speed?\n\nRequires associativity.\n-}\nsumNestedAssociative :: (C a) => [a] -> a\nsumNestedAssociative [] = zero\nsumNestedAssociative [x] = x\nsumNestedAssociative xs = sumNestedAssociative (sum2 xs)\n\n{-\nMake sure that the last entries in the list\nare equally often part of an addition.\nMaybe this can reduce rounding errors.\nThe list that sum2 computes is a breadth-first-flattened binary tree.\n\nRequires associativity and commutativity.\n-}\nsumNestedCommutative :: (C a) => [a] -> a\nsumNestedCommutative [] = zero\nsumNestedCommutative xs@(_:rs) =\n   let ys = xs ++ Match.take rs (sum2 ys)\n   in  last ys\n\n_sumNestedCommutative :: (C a) => [a] -> a\n_sumNestedCommutative [] = zero\n_sumNestedCommutative xs@(_:rs) =\n   let ys = xs ++ take (length rs) (sum2 ys)\n   in  last ys\n\n{-\n[a,b,c, a+b,c+(a+b)]\n[a,b,c,d, a+b,c+d,(a+b)+(c+d)]\n[a,b,c,d,e, a+b,c+d,e+(a+b),(c+d)+e+(a+b)]\n[a,b,c,d,e,f, a+b,c+d,e+f,(a+b)+(c+d),(e+f)+((a+b)+(c+d))]\n-}\n\nsum2 :: (C a) => [a] -> [a]\nsum2 (x:y:rest) = (x+y) : sum2 rest\nsum2 xs = xs\n\n\n\n{- |\nInstead of baking the add operation into the element function,\nwe could use higher rank types\nand pass a generic @uncurry (+)@ to the run function.\nWe do not do so in order to stay Haskell 98\nat least for parts of NumericPrelude.\n-}\n{-# INLINE elementAdd #-}\nelementAdd ::\n   (C x) =>\n   (v -> x) -> Elem.T (v,v) x\nelementAdd f =\n   Elem.element (\\(x,y) -> f x + f y)\n\n{-# INLINE elementSub #-}\nelementSub ::\n   (C x) =>\n   (v -> x) -> Elem.T (v,v) x\nelementSub f =\n   Elem.element (\\(x,y) -> f x - f y)\n\n{-# INLINE elementNeg #-}\nelementNeg ::\n   (C x) =>\n   (v -> x) -> Elem.T v x\nelementNeg f =\n   Elem.element (negate . f)\n\n\n-- like <*>\ninfixl 4 <*>.+, <*>.-, <*>.-$\n\n{- |\n> addPair :: (Additive.C a, Additive.C b) => (a,b) -> (a,b) -> (a,b)\n> addPair = Elem.run2 $ Elem.with (,) <*>.+  fst <*>.+  snd\n-}\n{-# INLINE (<*>.+) #-}\n(<*>.+) ::\n   (C x) =>\n   Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a\n(<*>.+) f acc =\n   f <*> elementAdd acc\n\n{-# INLINE (<*>.-) #-}\n(<*>.-) ::\n   (C x) =>\n   Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a\n(<*>.-) f acc =\n   f <*> elementSub acc\n\n{-# INLINE (<*>.-$) #-}\n(<*>.-$) ::\n   (C x) =>\n   Elem.T v (x -> a) -> (v -> x) -> Elem.T v a\n(<*>.-$) f acc =\n   f <*> elementNeg acc\n\n\n-- * Instances for atomic types\n\ninstance C Integer where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Float   where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Double  where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\n\ninstance C Int     where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Int8    where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Int16   where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Int32   where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Int64   where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\n\ninstance C Word    where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Word8   where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Word16  where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Word32  where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\ninstance C Word64  where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = P.fromInteger 0\n   negate = P.negate\n   (+)    = (P.+)\n   (-)    = (P.-)\n\n\n\n\n-- * Instances for composed types\n\ninstance (C v0, C v1) => C (v0, v1) where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = (,) zero zero\n   (+)    = Elem.run2 $ pure (,) <*>.+  fst <*>.+  snd\n   (-)    = Elem.run2 $ pure (,) <*>.-  fst <*>.-  snd\n   negate = Elem.run  $ pure (,) <*>.-$ fst <*>.-$ snd\n\ninstance (C v0, C v1, C v2) => C (v0, v1, v2) where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero   = (,,) zero zero zero\n   (+)    = Elem.run2 $ pure (,,) <*>.+  fst3 <*>.+  snd3 <*>.+  thd3\n   (-)    = Elem.run2 $ pure (,,) <*>.-  fst3 <*>.-  snd3 <*>.-  thd3\n   negate = Elem.run  $ pure (,,) <*>.-$ fst3 <*>.-$ snd3 <*>.-$ thd3\n\n\ninstance (C v) => C [v] where\n   zero   = []\n   negate = map negate\n   (+) (x:xs) (y:ys) = (+) x y : (+) xs ys\n   (+) xs     []     = xs\n   (+) []     ys     = ys\n   (-) (x:xs) (y:ys) = (-) x y : (-) xs ys\n   (-) xs     []     = xs\n   (-) []     ys     = negate ys\n\n\ninstance (C v) => C (b -> v) where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero       _ = zero\n   (+)    f g x = (+) (f x) (g x)\n   (-)    f g x = (-) (f x) (g x)\n   negate f   x = negate (f x)\n\n-- * Properties\n\npropAssociative :: (Eq a, C a) => a -> a -> a -> Bool\npropCommutative :: (Eq a, C a) => a -> a -> Bool\npropIdentity    :: (Eq a, C a) => a -> Bool\npropInverse     :: (Eq a, C a) => a -> Bool\n\npropCommutative  =  Laws.commutative (+)\npropAssociative  =  Laws.associative (+)\npropIdentity     =  Laws.identity (+) zero\npropInverse      =  Laws.inverse (+) negate zero\n\n\n\n-- legacy\n\ninstance (P.Integral a) => C (Ratio98.Ratio a) where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero                =  P.fromInteger 0\n   (+)                 =  (P.+)\n   (-)                 =  (P.-)\n   negate              =  P.negate\n\ninstance (P.RealFloat a) => C (Complex98.Complex a) where\n   {-# INLINE zero #-}\n   {-# INLINE negate #-}\n   {-# INLINE (+) #-}\n   {-# INLINE (-) #-}\n   zero                =  P.fromInteger 0\n   (+)                 =  (P.+)\n   (-)                 =  (P.-)\n   negate              =  P.negate\n", "num_lines": 424}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Warning\n{-# WARNINg [\"This is a module warning\",\n             \"multi-line\"] #-}\n  where\n\n{-# Warning   foo ,  bar\n         [\"This is a multi-line\",\n          \"deprecation message\",\n          \"for foo\"] #-}\nfoo :: Int\nfoo = 4\n\nbar :: Char\nbar = 'c'\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Deprecation\n{-# Deprecated [\"This is a module \\\"deprecation\\\"\",\n             \"multi-line\",\n             \"with unicode: Fr\u00c3\u00a8re\" ] #-}\n   ( foo )\n where\n\n{-# DEPRECATEd   foo\n         [\"This is a multi-line\",\n          \"deprecation message\",\n          \"for foo\"] #-}\nfoo :: Int\nfoo = 4\n\n{-# DEPRECATED withBool        \"The C2HS module will soon stop providing unnecessary\\nutility functions. Please use standard FFI library functions instead.\" #-}\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies,\n             RankNTypes, FlexibleContexts, TemplateHaskell,\n             UndecidableInstances, GADTs, DefaultSignatures #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.Singletons.Prelude.Eq\n-- Copyright   :  (C) 2013 Richard Eisenberg\n-- License     :  BSD-style (see LICENSE)\n-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)\n-- Stability   :  experimental\n-- Portability :  non-portable\n--\n-- Defines the SEq singleton version of the Eq type class.\n--\n-----------------------------------------------------------------------------\n\nmodule Data.Singletons.Prelude.Eq (\n  PEq(..), SEq(..),\n  (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$)\n  ) where\n\nimport Data.Singletons.Prelude.Bool\nimport Data.Singletons\nimport Data.Singletons.Single\nimport Data.Singletons.Prelude.Instances\nimport Data.Singletons.Util\nimport Data.Singletons.Promote\nimport Data.Type.Equality\n\n-- NB: These must be defined by hand because of the custom handling of the\n-- default for (:==) to use Data.Type.Equality.==\n\n-- | The promoted analogue of 'Eq'. If you supply no definition for '(:==)',\n-- then it defaults to a use of '(==)', from @Data.Type.Equality@.\nclass kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where\n  type (:==) (x :: a) (y :: a) :: Bool\n  type (:/=) (x :: a) (y :: a) :: Bool\n\n  type (x :: a) :== (y :: a) = x == y\n  type (x :: a) :/= (y :: a) = Not (x :== y)\n\ninfix 4 :==\ninfix 4 :/=\n\n$(genDefunSymbols [''(:==), ''(:/=)])\n\n-- | The singleton analogue of 'Eq'. Unlike the definition for 'Eq', it is\n-- required that instances define a body for '(%:==)'. You may also supply a\n-- body for '(%:/=)'.\nclass (kparam ~ 'KProxy) => SEq (kparam :: KProxy k) where\n  -- | Boolean equality on singletons\n  (%:==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :== b)\n  infix 4 %:==\n\n  -- | Boolean disequality on singletons\n  (%:/=) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :/= b)\n  default (%:/=) :: forall (a :: k) (b :: k).\n                    ((a :/= b) ~ Not (a :== b))\n                 => Sing a -> Sing b -> Sing (a :/= b)\n  a %:/= b = sNot (a %:== b)\n  infix 4 %:/=\n\n$(singEqInstances basicTypes)\n$singEqInstances basicTypes\nsingEqInstances basicTypes\n", "num_lines": 67}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule LiteralsTest2 where\n\nx,y :: Int\nx = 0003\ny = 0x04\n\ns :: String\ns = \"\\x20\"\n\nc :: Char\nc = '\\x20'\n\nd :: Double\nd = 0.00\n\nblah = x\n  where\n    charH = '\\x41'#\n    intH = 0004#\n    wordH = 005##\n    floatH = 3.20#\n    doubleH = 04.16##\n    -- int64H = 00456L#\n    -- word64H = 00456L##\n    x = 1\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiWayIf #-}\nmodule MultiWayIf where\n\nfoo = if | test1 -> e1\n         | test2 witharg -> e2\n         | otherwise -> def\n\nbar = if { | test1 -> if { | test2 -> e1\n                           | test3 -> e2 }\n           | test4 -> e3\n         }\n\n-- taken from GHC's test suite\nx  = 10\nx1 = if | x < 10 -> \"< 10\" | otherwise -> \"\"\nx2 = if | x < 10 -> \"< 10\"\n        | otherwise -> \"\"\nx3 = if | x < 10 -> \"< 10\"\n        | otherwise -> \"\"\nx4 = if | True -> \"yes\"\nx5 = if | True -> if | False -> 1 | True -> 2\n\nx6 = if | x < 10 -> if | True -> \"yes\"\n                       | False -> \"no\"\n        | otherwise -> \"maybe\"\n\nx7 = (if | True -> 0)\n\n-- issue #98\nspam = if | () <- () -> ()\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds,\n             PolyKinds, TypeFamilies, GADTs, StarIsType #-}\n\nmodule RAE_T32a where\n\nimport Data.Kind\n\ndata family Sing (k :: *) :: k -> *\n\ndata TyArr' (a :: *) (b :: *) :: *\ntype TyArr (a :: *) (b :: *) = TyArr' a b -> *\ntype family (a :: TyArr k1 k2) @@ (b :: k1) :: k2\ndata TyPi' (a :: *) (b :: TyArr a *) :: *\ntype TyPi (a :: *) (b :: TyArr a *) = TyPi' a b -> *\ntype family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b\n$(return [])\n\ndata MkStar (p :: *) (x :: TyArr' p *)\ntype instance MkStar p @@ x = *\n$(return [])\n\ntype instance (MkStar p) @@ x = *\n$(return [])\n\nfoo :: forall p x . MkStar p @@ x\nfoo = undefined\n\ndata Sigma (p :: *) (r :: TyPi p (MkStar p)) :: * where\n  Sigma ::\n    forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a).\n    Sing * p -> Sing (TyPi p (MkStar p)) r -> Sing p a -> Sing (r @@@ a) b\n        -> Sigma p r\n$(return [])\n\ndata instance Sing Sigma (Sigma p r) x where\n  SSigma ::\n    forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a)\n    (sp :: Sing * p) (sr :: Sing (TyPi p (MkStar p)) r) (sa :: Sing p a)\n      (sb :: Sing (r @@@ a) b).\n    Sing (Sing (r @@@ a) b) sb ->\n    Sing (Sigma p r) ('Sigma sp sr sa sb)\n\n-- I (RAE) believe this last definition is ill-typed.\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport GHC.Prim\n\ndata P = Positives Int# Float# Double# Char# Word# deriving Show\ndata N = Negatives Int# Float# Double# deriving Show\n\nmain = do\n  print $ Positives 42# 4.23# 4.23## '4'# 4##\n  print $ Negatives -4# -4.0# -4.0##\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, GHCForeignImportPrim #-}\n\nmodule T10461 where\nimport GHC.Exts\n\nforeign import prim cheneycopy :: Any -> Word#\n\nforeign import prim \"foo\" foo :: Any -> Word#\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = do\n    putStrLn $([| 'a'#   |] >>= stringE . show)\n    putStrLn $([| \"abc\"# |] >>= stringE . show)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveLift #-}\nmodule T1830_2 where\n\nimport Language.Haskell.TH.Syntax (Lift)\n\ndata Nothing deriving Lift\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE StarIsType #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE UndecidableSuperClasses #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-}\n\nmodule T3927b where\n\nimport Data.Proxy\nimport GHC.Exts\n\ndata Message\n\ndata SocketType = Dealer | Push | Pull\n\ndata SocketOperation = Read | Write\n\ntype family Restrict (a :: SocketOperation) (as :: [SocketOperation])\n            :: Constraint where\n    Restrict a (a ': as) = ()\n    Restrict x (a ': as) = Restrict x as\n    Restrict x '[] = (\"Error!\" ~ \"Tried to apply a restricted type!\")\n\ntype family Implements (t :: SocketType) :: [SocketOperation] where\n    Implements Dealer = ['Read, Write]\n    Implements Push = '[Write]\n    Implements Pull = '[ 'Read]\n\ndata SockOp :: SocketType -> SocketOperation -> * where\n    SRead :: SockOp sock 'Read\n    SWrite :: SockOp sock Write\n\ndata Socket :: SocketType -> * where\n    Socket :: proxy sock\n           -> (forall op . Restrict op (Implements sock)\n                 => SockOp sock op -> Operation op)\n           -> Socket sock\n\ntype family Operation (op :: SocketOperation) :: * where\n    Operation 'Read = IO Message\n    Operation Write = Message -> IO ()\n\nclass Restrict 'Read (Implements t) => Readable t where\n    readSocket :: Socket t -> Operation 'Read\n    readSocket (Socket _ f) = f (SRead :: SockOp t 'Read)\n\ninstance Readable Dealer\n\ntype family Writable (t :: SocketType) :: Constraint where\n    Writable Dealer = ()\n    Writable Push = ()\n\ndealer :: Socket Dealer\ndealer = Socket (Proxy :: Proxy Dealer) f\n  where\n    f :: Restrict op (Implements Dealer) => SockOp Dealer op -> Operation op\n    f SRead = undefined\n    f SWrite = undefined\n\npush :: Socket Push\npush = Socket (Proxy :: Proxy Push) f\n  where\n    f :: Restrict op (Implements Push) => SockOp Push op -> Operation op\n    f SWrite = undefined\n\npull :: Socket Pull\npull = Socket (Proxy :: Proxy Pull) f\n  where\n    f :: Restrict op (Implements Pull) => SockOp Pull op -> Operation op\n    f SRead = undefined\n\nfoo :: IO Message\nfoo = readSocket dealer\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PackageImports #-}\n{-# LANGUAGE MagicHash, UnliftedFFITypes #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Test10313 where\n\nimport \"b\\x61se\" Data.List\n\n{-# WARNING Logic\n          , solverCheckAndGetModel\n          \"New Z3 API support is still incomplete and fragile: \\\n          \\you may experience segmentation faults!\"\n  #-}\n\n{-# Deprecated Logic\n          , solverCheckAndGetModel\n          \"Deprecation: \\\n          \\you may experience segmentation faults!\"\n  #-}\n\ndata {-# ctype \"foo\\x63\" \"b\\x61r\" #-} Logic = Logic\n\n-- Should warn\nfoo1 x = x\n{-# RULEs \"foo1\\x67\" [ 1] forall x. foo1 x = x #-}\n\nforeign import prim unsafe \"a\\x62\" a :: IO Int\n\n{-# INLINe strictStream #-}\nstrictStream (Bitstream l v)\n    = {-# CORe \"Strict Bitstream stre\\x61m\" #-}\n      S.concatMap stream (GV.stream v)\n      `S.sized`\n      Exact l\n\nb = {-# SCc \"foo\\x64\"   #-} 006\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ExprPragmas where\n\n-- Should it be possible to ppr the following annotation?\nc = {-# GENERATED \"foobar\" 1 : 2  -  3 :   4 #-} 0.00\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ppr048 where\n\n{-# SCc foo #-}\nfoo :: Int -> Int\nfoo       x = x\n\n{-# SCc foo2 \"label\" #-}\nfoo2 :: ()\nfoo2 = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HolesInfix where\n\nf, g, q :: Int -> Int -> Int\nf x y = _ x y\ng x y = x `_` y\nq x y = x `_a` y\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE ViewPatterns #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\nmodule Bug where\n\nclass C a b c\ndata B a b = B { aa :: a, bb :: b }\n\n-- Types requiring parens.\n$([d| instance C (Maybe a) (Maybe b) c\n    |])\n\n-- ---------------------------------------------------------------------\n-- Patterns requiring parens according to hsPatNeedsParens\n\n-- SigPatIn. What about SigPatOut?\n$([d| g (a :: (Int -> Int) -> Int) = True |])\n\n-- ViewPat\n$([d| h (id -> x) = True |])\n\n-- PrefixCon with non-null args\n$([d| f (Just (Just False)) = True |])\n\n-- InfixCon for ConPatIn\n$([d| i (B (a `B` c) d) = True |])\n\n-- RecCon does not\n$([d| j B { aa = a} = True |])\n\n\n$([d| k = id @(Maybe Int) |])\n\n$([d| l = case Just 'a' of Just a -> Just ((\\x -> x) a) |])\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\nmodule Bug where\n\n$([d| type family Foo a b\n      type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)\n\n      data family Bar a b\n      data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b)\n    |])\n\n{-\n    type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)\n\nbecomes\n\n[TySynInstD Bug.Foo\n  (TySynEqn\n    [AppT\n      (ConT GHC.Base.Maybe)\n      (VarT a_6989586621679027317)\n     ,VarT b_6989586621679027318]\n    (AppT\n      (AppT\n        (ConT Data.Either.Either)\n        (AppT\n          (ConT GHC.Base.Maybe)\n          (VarT a_6989586621679027317)\n        )\n      )\n      (AppT (ConT GHC.Base.Maybe) (VarT b_6989586621679027318))\n    )\n  )\n]\n\n    data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b)\n\nbecomes\n\n[DataInstD [] Bug.Bar\n  [AppT\n    (ConT GHC.Base.Maybe)\n    (VarT a_6989586621679027707)\n  ,VarT b_6989586621679027708\n  ]\n  Nothing\n  [NormalC\n    BarMaybe_6989586621679027706\n    [(Bang\n        NoSourceUnpackedness\n        NoSourceStrictness\n      ,AppT\n        (ConT GHC.Base.Maybe)\n         (VarT a_6989586621679027707)\n      )\n    ,(Bang\n       NoSourceUnpackedness\n       NoSourceStrictness\n     ,AppT\n       (ConT GHC.Base.Maybe)\n       (VarT b_6989586621679027708)\n     )\n    ]\n  ]\n  []]\n\n\n-}\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\nmodule T13942 where\n\n$([d| f :: Either Int (Int -> Int)\n      f = undefined\n    |])\n\n{-\n\nNote: to debug\n\n~/inplace/bin/ghc-stage2 --interactive\nload the following\n--------------------------------------\nimport Language.Haskell.TH\n\nfoo :: IO ()\nfoo = do\n  r <- runQ ([d| f :: Either Int (Int -> Int)\n                 f = undefined\n             |])\n  print r\n\n----------------------------------------\nfoo\n[SigD f_0 (AppT (AppT (ConT Data.Either.Either) (ConT GHC.Types.Int)) (AppT (AppT ArrowT (ConT GHC.Types.Int)) (ConT GHC.Types.Int)))\n,ValD (VarP f_0) (NormalB (VarE GHC.Err.undefined)) []]\n\n[SigD f_0\n  (AppT (AppT (ConT Data.Either.Either)\n              (ConT GHC.Types.Int))\n        (AppT (AppT ArrowT\n                    (ConT GHC.Types.Int))\n              (ConT GHC.Types.Int)))\n-}\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\n\nimport Language.Haskell.TH\n\nclass C a b\n\n$([d| data Foo a = Foo a deriving (C a) |])\n\n{-\n\nNote: to debug\n\n~/inplace/bin/ghc-stage2 --interactive\nload the following\n----------------------------------------\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\n\nimport Language.Haskell.TH\n\nclass C a b\n\nmain :: IO ()\nmain = putStrLn $([d| data Foo a = Foo a deriving (C a) |] >>= stringE . show)\n\n----------------------------------------\n\n-}\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\n\nimport Language.Haskell.TH\n\nclass (a `C` b) c\n\n$([d| data Foo a = Foo a deriving (y `C` z) |])\n\n{-\n\nNote: to debug\n\n~/inplace/bin/ghc-stage2 --interactive\nload the following\n----------------------------------------\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\n\nimport Language.Haskell.TH\n\nclass (a `C` b) c\n\nmain :: IO ()\nmain\n  = putStrLn $([d| data Foo a = Foo a deriving (y `C` z) |] >>= stringE . show)\n\n----------------------------------------\nBceomes\n\n\n[DataD [] Foo_0 [PlainTV a_2] Nothing\n  [NormalC Foo_1 [(Bang NoSourceUnpackedness NoSourceStrictness,VarT a_2)]]\n  [DerivClause Nothing\n      [AppT (AppT (ConT Main.C) (VarT y_6989586621679027885))\n            (VarT z_6989586621679027886)]]]\n\n-}\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeOperators #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\n\nimport Language.Haskell.TH\n\n$([d| data Foo a = Foo a deriving (a ~ a) |])\n\n{-\n\nNote: to debug\n\n~/inplace/bin/ghc-stage2 --interactive\nload the following\n----------------------------------------\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\n\nimport Language.Haskell.TH\n\nclass (a `C` b) c\n\nmain :: IO ()\nmain\n  = putStrLn $([d| data Foo a = Foo a deriving (a ~ a) |] >>= stringE . show)\n\n----------------------------------------\nBecomes\n\n[DataD [] Foo_0 [PlainTV a_2] Nothing\n  [NormalC Foo_1 [(Bang NoSourceUnpackedness NoSourceStrictness,VarT a_2)]]\n  [DerivClause Nothing\n    [AppT (AppT EqualityT (VarT a_2))\n          (VarT a_2)]]]\n\n\n-}\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\nmodule T14306 where\n\nclass (a `C` b) c\n\nclass (a `D` b) c d\n\nclass (a `E` b)\n\nclass a `F` b\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# OPTIONS_GHC -Werror=typed-holes #-}\n\nmain :: IO ()\nmain = undefined\n\ndata Proxy k = Proxy\n\ntest1 = _ :: Proxy '[ 'True ]\ntest2 = _ :: Proxy '[ '[ 1 ] ]\ntest3 = _ :: Proxy '[ '( \"Symbol\", 1 ) ]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# OPTIONS_GHC -Werror=typed-holes #-}\n\nmain :: IO ()\nmain = undefined\n\ndata Proxy k = Proxy\n\ntest1 = _ :: Proxy '( 'True, 'False )\ntest2 = _ :: Proxy '( '( 'True, 'False ), 'False )\ntest3 = _ :: Proxy '( '[ 1 ], 'False )\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeOperators #-}\n\ndata family (a + b) c d\n\ndata instance (Int + Bool) Double = Float\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This tests trac #249\n\nmain = return ()\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This tests trac #931\n\nmodule Main where\n\nx = f [1..5] (f [2..] [3..])\n\nf xs ys = l\n    where\n    l = [ if s then x else y | (x, y) <- zip xs ys ]\n    s = g xs ys\n    g [] _ = True\n    g _ [] = False\n    g (x:xs) (y:ys) = g xs ys\n\nmain = print (show x)\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12790 (list) where\n\nimport Data.Foldable (asum)\nimport Text.ParserCombinators.Parsec (Parser, sepBy, try)\n\ndata Expr\n  = Var Fixity String\n  | App Expr Expr\n\ndata Fixity = Pref | Inf\n\ncons, nil :: Expr\ncons = Var Inf  \":\"\nnil  = Var Pref \"[]\"\n\nbrackets :: Parser a -> Parser a\nbrackets = undefined\n\nsymbol :: String -> Parser String\nsymbol = undefined\n\nlist :: Parser Expr\nlist = asum (map (try . brackets) plist) where\n  plist = [\n    foldr (\\e1 e2 -> cons `App` e1 `App` e2) nil `fmap`\n      (myParser False `sepBy` symbol \",\"),\n    do e <- myParser False\n       _ <- symbol \"..\"\n       return $ Var Pref \"enumFrom\" `App` e,\n    do e  <- myParser False\n       _  <- symbol \",\"\n       e' <- myParser False\n       _  <- symbol \"..\"\n       return $ Var Pref \"enumFromThen\" `App` e `App` e',\n    do e  <- myParser False\n       _  <- symbol \"..\"\n       e' <- myParser False\n       return $ Var Pref \"enumFromTo\" `App` e `App` e',\n    do e   <- myParser False\n       _   <- symbol \",\"\n       e'  <- myParser False\n       _   <- symbol \"..\"\n       e'' <- myParser False\n       return $ Var Pref \"enumFromThenTo\" `App` e `App` e' `App` e''\n    ]\n\nmyParser :: Bool -> Parser Expr\nmyParser = undefined\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T14931_Bug where\n\nimport Prelude (Int, IO, Bool(..), Num(..), Monad(..), not, print)\nimport qualified Language.Haskell.TH.Syntax as TH\nimport T14931_State\n\nwat :: IO ()\nwat = print $(let playGame []     = do\n                      (_, score) <- get\n                      return score\n                  playGame (x:xs) = do\n                      (on, score) <- get\n                      case x of\n                           'a' | on -> put (on, score + 1)\n                           'b' | on -> put (on, score - 1)\n                           'c'      -> put (not on, score)\n                           _        -> put (on, score)\n                      playGame xs\n\n                  startState :: (Bool, Int)\n                  startState = (False, 0)\n              in TH.lift (evalState (playGame \"abcaaacbbcabbab\") startState) )\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T14931_State (MonadState(..), Lazy.evalState) where\n\nimport qualified Control.Monad.Trans.State.Lazy as Lazy (StateT, get, put, evalState)\n\nclass Monad m => MonadState s m | m -> s where\n    get :: m s\n    put :: s -> m ()\n\ninstance Monad m => MonadState s (Lazy.StateT s m) where\n    get = Lazy.get\n    put = Lazy.put\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = do\n  _ <- return $ getInt Circle\n  return ()\n\nnewtype MyInt = MyInt Int\n\ndata Shape = Circle | Square\n\ngetInt :: Shape -> MyInt\ngetInt sh =\n  case sh of\n    Circle ->\n        let (MyInt i) = MyInt 3\n        in myInt i\n    Square ->\n        let (MyInt i) = MyInt 2\n        in myInt i\n    where\n      myInt = MyInt\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-missing-methods -fno-warn-deprecations #-}\nmodule C where\n\n data Complex a = !a :+ !a\n     deriving (Eq, Show)\n\n instance  (RealFloat a) => Num (Complex a)  where\n     {-# SPECIALISE instance Num (Complex Float) #-}\n     {-# SPECIALISE instance Num (Complex Double) #-}\n     (x :+ y) + (x' :+ y')   =  (x + x') :+ (y + y')\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n-- Main.hs\nmodule Main (main) where\n\nimport NetworkRequestHeader\n\nimport Control.Monad\n\nmain :: IO ()\nmain = void $ parseHeaderLines []\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n-- NetworkRequestHeader.hs\nmodule NetworkRequestHeader (parseHeaderLines, parseRequestLine) where\n\nimport Control.Exception\nimport Control.Monad\nimport Data.ByteString.Internal (ByteString(..), memchr)\nimport Data.Word\nimport Foreign.ForeignPtr (withForeignPtr)\nimport Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)\nimport Foreign.Storable (peek)\n\n-- | Error types for bad 'Request'.\ndata InvalidRequest = NonHttp\n\ninstance Show InvalidRequest where show _ = \"\"\ninstance Exception InvalidRequest\n\nparseHeaderLines :: [ByteString]\n                 -> IO (ByteString\n                       ,ByteString  --  Path\n                       ,ByteString  --  Path, parsed\n                       )\nparseHeaderLines [] = throwIO $ NonHttp\nparseHeaderLines (firstLine:_) = do\n    (method, path') <- parseRequestLine firstLine\n    let path = path'\n    return (method, path', path)\n\nparseRequestLine :: ByteString\n                 -> IO (ByteString\n                       ,ByteString)\nparseRequestLine (PS fptr off len) = withForeignPtr fptr $ \\ptr -> do\n    when (len < 14) $ throwIO NonHttp\n    let methodptr = ptr `plusPtr` off\n        limptr = methodptr `plusPtr` len\n        lim0 = fromIntegral len\n\n    pathptr0 <- memchr methodptr 32 lim0 -- ' '\n    when (pathptr0 == nullPtr || (limptr `minusPtr` pathptr0) < 11) $\n        throwIO NonHttp\n    let pathptr = pathptr0 `plusPtr` 1\n        lim1 = fromIntegral (limptr `minusPtr` pathptr0)\n\n    httpptr0 <- memchr pathptr 32 lim1 -- ' '\n    when (httpptr0 == nullPtr || (limptr `minusPtr` httpptr0) < 9) $\n        throwIO NonHttp\n    let httpptr = httpptr0 `plusPtr` 1\n        lim2 = fromIntegral (httpptr0 `minusPtr` pathptr)\n\n    checkHTTP httpptr\n    queryptr <- memchr pathptr 63 lim2 -- '?'\n\n    let !method = bs ptr methodptr pathptr0\n        !path\n          | queryptr == nullPtr = bs ptr pathptr httpptr0\n          | otherwise           = bs ptr pathptr queryptr\n\n    return (method,path)\n  where\n    check :: Ptr Word8 -> Int -> Word8 -> IO ()\n    check p n w = do\n        w0 <- peek $ p `plusPtr` n\n        when (w0 /= w) $ throwIO NonHttp\n    checkHTTP httpptr = do\n        check httpptr 0 72 -- 'H'\n        check httpptr 1 84 -- 'T'\n        check httpptr 2 84 -- 'T'\n        check httpptr 3 80 -- 'P'\n        check httpptr 4 47 -- '/'\n        check httpptr 6 46 -- '.'\n    bs ptr p0 p1 = PS fptr o l\n      where\n        o = p0 `minusPtr` ptr\n        l = p1 `minusPtr` p0\n\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import B\n\n-- See B.hs for an explanation on how this bug is triggered.\n\n-- This is a linker error, so we have to define a main and link\nmain :: IO ()\nmain = putStrLn $ show $ bar 100 Nothing\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fprof-auto #-}\nmodule B where\n\nplus_noinline :: Integer -> Integer -> Integer\nplus_noinline x y = x + y\n{-# NOINLINE plus_noinline #-}\n\n-- | This is the key function. We do not want this to be inlined into bar, but\n-- we DO want it to be inlined into main (in A.hs). Moreover, when it is inlined\n-- into main, we don't want the values inside the tuple to be inlined. To\n-- achieve this, in main we call bar with Nothing allowing split to be inlined\n-- with the first case, where the values in tuple are calls to NOINLINE\n-- functions.\nsplit :: Integer -> Maybe Integer -> (Integer, Integer)\nsplit n Nothing = (n `plus_noinline` 1, n `plus_noinline` 2)\nsplit n (Just m) =\n  if n == 0 then (m, m) else split (n - 1) (Just m)\n\n\n{- | The simplified core for bar is:\n\n[GblId,\n Arity=2,\n Str=<L,U><S,1*U>,\n Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,\n         WorkFree=True, Expandable=True,\n         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)\n         Tmpl= \\ (n_a1Gq [Occ=OnceL] :: Integer)\n                 (m_a1Gr [Occ=OnceL] :: Maybe Integer) ->\n                 scc<bar>\n                 let {\n                   ds_s2rg :: (Integer, Integer)\n                   [LclId]\n                   ds_s2rg = scc<bar.(...)> split n_a1Gq m_a1Gr } in\n                 plus_noinline\n                   (scc<bar.y>\n                    case ds_s2rg of { (y_a2ps [Occ=Once], _ [Occ=Dead])\n                      -> y_a2ps })\n                   (scc<bar.z>\n                    case ds_s2rg of { (_ [Occ=Dead], z_a2pu [Occ=Once])\n                      -> z_a2pu })}]\nbar\n  = \\ (n_a1Gq :: Integer) (m_a1Gr :: Maybe Integer) ->\n      scc<bar>\n      case scc<bar.(...)> split n_a1Gq m_a1Gr of\n      { (ww1_s2s7, ww2_s2s8) ->\n      plus_noinline ww1_s2s7 ww2_s2s8\n      }\n\nNote that there are sccs around the (x,y) pattern match in the unfolding, but\nnot in the simplified function. See #5889 for a discussion on why the sccs are\npresent in one but not the other, and whether this is correct.\n\nsplit is not inlined here, because it is a recursive function.\n\nIn A.hs, bar is called with m = Nothing, allowing split to be inlined (as it is\nnot recursive in that case) and the sccs ARE present in the simplified core of\nmain (as they are around function calls, not ids). This triggers the linker\nerror.\n\n-}\nbar :: Integer -> Maybe Integer -> Integer\nbar n m = y `plus_noinline` z\n  where\n    (y, z) = split n m\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\nwibble :: a\nwibble = {-# SCC \"foo bar\" #-} wibble\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Stack\nimport Prelude hiding (mapM)\n\nf :: Int -> IO Int\nf x = do currentCallStack >>= print; return (x+1)\n\nmapM :: Monad m => (a -> m b) -> [a] -> m [b]\nmapM f xs = go xs\n  where go []     = return []\n        go (x:xs) = do\n          x' <- f x\n          xs' <- mapM f xs\n          return (x':xs')\n\nmain = mapM f [42,42]\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Main where\n\nimport Debug.Trace\nimport Text.Printf\nimport Prelude hiding (map)\nimport GHC.Stack\n\nf :: Int -> Int\nf x = traceStack (printf \"f: %d\" x) (x * 2)\n\nmap :: (a -> b) -> [a] -> [b]\nmap f xs = go xs\n  where go [] = []\n        go (x:xs) = f x : map f xs\n\nmain = do\n  let xs = map f [42,43]\n  print xs\n  putStrLn =<< renderStack `fmap` (whoCreated $! head xs)\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom: dw@minster.york.ac.uk\nTo: partain\nSubject:    a compiler test\nDate:        3 Mar 1992 12:31:00 GMT\n\nWill,\n   One of the decisions taken at the FLARE meeting yesterday was that we\n(FLARE people) should send you (GRASP people) interesting Haskell programs\nto test your new compiler. So allow me to present the following program,\nwritten by Colin Runciman in various functional languages over the years,\nwhich puts propositions into clausal form. The original program was\ninteractive, but I've made it batch so that you can run it over night.\nHere is an example run with the prototype compiler. Note the result is\n\"a <=\".\n\n        hc clausify.hs\n        Haskell-0.41 (EXPERIMENTAL)\n        Glasgow University Haskell Compiler, version 0.41\n        G-Code version\n        -71$ a.out\n        a <=\n        -71$\n\nCheers,\n\nDavid\n-}\n\n------------------------------------------------------------------------------\n-- reducing propositions to clausal form\n-- Colin Runciman, University of York, 18/10/90\n\n-- an excellent benchmark is: (a = a = a) = (a = a = a) = (a = a = a)\n-- batch mode version David Wakeling, February 1992\n\nmodule Main(main) where\n\nimport Data.Ix\nimport System.Environment\n\nmain = do\n  (n:_) <- getArgs\n  putStr (res (read n))\n\nres n = concat (map clauses xs)\n where xs = take n (repeat \"(a = a = a) = (a = a = a) = (a = a = a)\")\n       {-# NOINLINE xs #-}\n\ndata StackFrame = Ast Formula | Lex Char\n\ndata Formula =\n  Sym Char |\n  Not Formula |\n  Dis Formula Formula |\n  Con Formula Formula |\n  Imp Formula Formula |\n  Eqv Formula Formula\n\n-- separate positive and negative literals, eliminating duplicates\nclause p = clause' p ([] , [])\n           where\n           clause' (Dis p q)       x   = clause' p (clause' q x)\n           clause' (Sym s)       (c,a) = (insert s c , a)\n           clause' (Not (Sym s)) (c,a) = (c , insert s a)\n\n-- the main pipeline from propositional formulae to printed clauses\nclauses = concat . map disp . unicl . split . disin . negin . elim . parse\n\nconjunct (Con p q) = True\nconjunct p = False\n\n-- shift disjunction within conjunction\ndisin (Dis p (Con q r)) = Con (disin (Dis p q)) (disin (Dis p r))\ndisin (Dis (Con p q) r) = Con (disin (Dis p r)) (disin (Dis q r))\ndisin (Dis p q) =\n  if conjunct dp || conjunct dq then disin (Dis dp dq)\n  else (Dis dp dq)\n  where\n  dp = disin p\n  dq = disin q\ndisin (Con p q) = Con (disin p) (disin q)\ndisin p = p\n\n-- format pair of lists of propositional symbols as clausal axiom\ndisp (l,r) = interleave l spaces ++ \"<=\" ++ interleave spaces r ++ \"\\n\"\n\n-- eliminate connectives other than not, disjunction and conjunction\nelim (Sym s) = Sym s\nelim (Not p) = Not (elim p)\nelim (Dis p q) = Dis (elim p) (elim q)\nelim (Con p q) = Con (elim p) (elim q)\nelim (Imp p q) = Dis (Not (elim p)) (elim q)\nelim (Eqv f f') = Con (elim (Imp f f')) (elim (Imp f' f))\n\n-- the priorities of propositional expressions\n{- UNUSED:\nfpri   (Sym c) = 6\nfpri   (Not p) = 5\nfpri (Con p q) = 4\nfpri (Dis p q) = 3\nfpri (Imp p q) = 2\nfpri (Eqv p q) = 1\n-}\n\n-- insertion of an item into an ordered list\n-- Note: this is a corrected version from Colin (94/05/03 WDP)\ninsert x [] = [x]\ninsert x p@(y:ys) =\n  if x < y then x : p\n  else if x > y then y : insert x ys\n  else p\n\n\ninterleave (x:xs) ys = x : interleave ys xs\ninterleave []     _  = []\n\n-- shift negation to innermost positions\nnegin (Not (Not p)) = negin p\nnegin (Not (Con p q)) = Dis (negin (Not p)) (negin (Not q))\nnegin (Not (Dis p q)) = Con (negin (Not p)) (negin (Not q))\nnegin (Dis p q) = Dis (negin p) (negin q)\nnegin (Con p q) = Con (negin p) (negin q)\nnegin p = p\n\n-- the priorities of symbols during parsing\nopri '(' = 0\nopri '=' = 1\nopri '>' = 2\nopri '|' = 3\nopri '&' = 4\nopri '~' = 5\n\n-- parsing a propositional formula\nparse t = f where [Ast f] = parse' t []\n\nparse' [] s = redstar s\nparse' (' ':t) s = parse' t s\nparse' ('(':t) s = parse' t (Lex '(' : s)\nparse' (')':t) s = parse' t (x:s')\n                   where\n                   (x : Lex '(' : s') = redstar s\nparse' (c:t) s = if inRange ('a','z') c then parse' t (Ast (Sym c) : s)\n                 else if spri s > opri c then parse' (c:t) (red s)\n                 else parse' t (Lex c : s)\n\n-- reduction of the parse stack\nred (Ast p : Lex '=' : Ast q : s) = Ast (Eqv q p) : s\nred (Ast p : Lex '>' : Ast q : s) = Ast (Imp q p) : s\nred (Ast p : Lex '|' : Ast q : s) = Ast (Dis q p) : s\nred (Ast p : Lex '&' : Ast q : s) = Ast (Con q p) : s\nred (Ast p : Lex '~' : s) = Ast (Not p) : s\n\n-- iterative reduction of the parse stack\nredstar = while ((/=) 0 . spri) red\n\n-- old: partain:\n--redstar = while ((/=) (0::Int) . spri) red\n\nspaces = repeat ' '\n\n-- split conjunctive proposition into a list of conjuncts\nsplit p = split' p []\n          where\n          split' (Con p q) a = split' p (split' q a)\n          split' p a = p : a\n\n-- priority of the parse stack\nspri (Ast x : Lex c : s) = opri c\nspri s = 0\n\n-- does any symbol appear in both consequent and antecedent of clause\ntautclause (c,a) = [x | x <- c, x `elem` a] /= []\n\n-- form unique clausal axioms excluding tautologies\nunicl a = foldr unicl' [] a\n          where\n          unicl' p x = if tautclause cp then x else insert cp x\n                       where\n                       cp = clause p\n\nwhile p f x = if p x then while p f (f x) else x\n", "num_lines": 183}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport Control.Monad (ap, liftM)\nimport Control.Applicative\n\ntype S = String\n\nnewtype M s a = M { unM :: s -> (s,a) }\n\ninstance Monad (M s) where\n  (M m) >>= k = M $ \\s -> case m s of\n                            (s',a) -> unM (k a) s'\n  return a = M $ \\s -> (s,a)\n\ninstance Functor (M s) where\n    fmap = liftM\n\ninstance Applicative (M s) where\n    pure  = return\n    (<*>) = ap\n\nerrorM :: String -> M s a\nerrorM s = M $ \\_ -> error s\n\nrunM :: M s a -> s -> a\nrunM (M m) s = case m s of (_,a) -> a\n\nmain = print (runM (bar [\"a\",\"b\"]) \"state\")\n\nbar :: [String] -> M s [String]\nbar xs = mapM foo xs\n\nfoo :: String -> M s String\nfoo x = errorM x\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This example is from the User's Guide, so we better make sure it\n-- produces the correct output.\n\nmain = print (f 30 + g 30)\n  where\n    f n  = fib n\n    g n  = fib (n `div` 2)\n\nfib n = if n < 2 then 1 else fib (n-1) + fib (n-2)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do let xs = [1..1000000]\n          let ys = [1..2000000]\n          print $ {-# SCC \"last_xs\" #-} last xs\n          print $ {-# SCC \"last_init_xs\" #-} last $ init xs\n          print $ {-# SCC \"last_ys\" #-} last ys\n          print $ {-# SCC \"last_init_ys\" #-}last $ init ys\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main, f, g, h, i) where\n\nmain = print (f 42)\n\nf, g, h, i :: Int -> Int\nf x = g x + h x + i x\n\ng x = x + 1\n\n{-# INLINE h #-}\nh x = x + 2\n\n{-# INLINABLE i #-}\ni x = x + 3\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nmain :: IO ()\nmain = do print $ f True\n          print $ g 3\n          print $ h 'a'\n\nf :: a -> a\nf x = x\n\ng :: Int -> Int\ng x = x\n\nh :: Char -> Char\nJust h = Just id\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Data.Array.Unboxed\nimport System.Environment\n\nmain :: IO ()\nmain = print (yan 30 + yan 40)\n\n{- we're looking for:\nMAIN        MAIN                    106           0    0.0    0.0     0.0  100.0\n CAF        Main                    211           0    0.0    0.0     0.0   99.1\n  yan       Main                    213           2    0.0    0.0     0.0   98.9\n   yan.e    Main                    217           1    0.0    0.0     0.0   98.9\n    big     Main                    218           1    0.0   98.9     0.0   98.9\n  main      Main                    212           1    0.0    0.2     0.0    0.2\n   yan      Main                    214           0    0.0    0.0     0.0    0.0\n    yan.\\   Main                    215           2    0.0    0.0     0.0    0.0\n     yan1   Main                    216           2    0.0    0.0     0.0    0.0\n\nNote the 2 entries for yan.\\, the lambda expression inside yan.\n-}\n\nbig :: Int -> Int\nbig x = (array (0,1000000) [(0,x)] :: UArray Int Int) ! 0\n\nyan = let e = big 20 in \\x -> {-# SCC yan1 #-} x + e\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmain = print (f 20 30)\n\n{-# NOINLINE f #-}\nf x = let !x' = fib x in \\y -> x' + fib y\n\nfib :: Int -> Int\nfib n = if n < 2 then 1 else fib (n-1) + fib (n-2)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f :: Int -> Int -> Int\n{-# NOINLINE f #-}\nf x _ = x\n\ng :: Int -> Int -> Int\n{-# NOINLINE g #-}\ng x = f (1+1) -- slightly non-trivial so it will float\n\nmain :: IO Int\nmain = return $! g 3 5\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = return ()\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Original test case for #11627 (space_leak_001.hs)\n\nimport Data.List\n\nmain :: IO ()\nmain = print $ length $ show (foldl' (*) 1 [1..100000] :: Integer)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash     #-}\n{-# LANGUAGE UnboxedTuples #-}\n\n\n-- A reduced test case for #11627\n\n\nimport GHC.Prim\nimport GHC.Types (Int(..),IO(..))\nimport System.Mem\n\n\nmain :: IO ()\nmain = do\n    -- Allocate a large object (size >= 8/10 of one block = 8/10 * 4096 B)\n    let nBytes = 123 * 4096\n    b <- newBlob nBytes\n\n    -- Shrink it by at least one word\n    let delta = 100\n    shrinkBlob b $ nBytes - delta\n\n    -- Perform a heap census (assumes we are running with -i0, so a census is\n    -- run after every GC)\n    performGC\n\n    -- Hold on to b so it is not GCed before the census\n    shrinkBlob b $ nBytes - delta\n\n------------------------------------------------------------------------------\n\ndata Blob = Blob# !(MutableByteArray# RealWorld)\n\nnewBlob :: Int -> IO Blob\nnewBlob (I# n#) =\n    IO $ \\s -> case newByteArray# n# s of\n                   (# s', mba# #) -> (# s', Blob# mba# #)\n\nshrinkBlob :: Blob -> Int -> IO ()\nshrinkBlob (Blob# mba#) (I# n#) =\n    IO $ \\s -> case shrinkMutableByteArray# mba# n# s of\n                   s' -> (# s', () #)\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"Hello!\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fprof-auto-top #-}\n\n-- We want to make sure that 'foo' gets a cost center\n-- automatically even though it is INLINABLE. INLINE functions\n-- do not get cost centers automatically.\n\nimport Data.List (zipWith3)\nimport Control.Exception (evaluate)\n\n{-# INLINABLE foo #-}\nfoo :: Num a => a -> a -> a -> a\nfoo a b c = a * b + c\n\n{-# NOINLINE niz3 #-}\nniz3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]\nniz3 x y z = zipWith3 x y z\n\nblah :: [Int]\nblah = replicate 100 1\n\nmain = evaluate $ sum $ niz3 foo blah blah blah\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule Main where\n\neval :: forall a b. (a -> b -> b) -> b -> [a] -> b\neval f b xs = load xs []\n  where\n    load :: [a] -> [a] -> b\n    load [] stk          = unload b stk\n    load (x:xs) stk      = load xs (x : stk)\n\n    unload :: b -> [a] -> b\n    unload  v []         = v\n    unload  v (x  : stk) = unload ((f $! x) $! v) stk\n\nmain :: IO ()\nmain = print (eval (||) False (True : replicate 10000000 False))\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad\nimport Data.IORef\nimport System.Environment\n\nmain = do\n    [n] <- getArgs\n    replicateM (read n) (newIORef [1,2,3])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "fib1 n = fib1' n\n  where\n    fib1' n = {-# SCC \"nfib'\" #-} nfib n -- %time: 0 (both individual and inherited)\n      where\n        nfib n = if n < 2 then 1 else nfib (n-1) + nfib (n-2)\n\nfib2 n = fib2' n\nfib2' n = nfib n -- %time: 100 (both individual and inherited)\n  where\n    nfib n = if n < 2 then 1 else nfib (n-1) + nfib (n-2)\n\nfib3 = fib3'\nfib3' n = nfib n -- %time: 100 (both individual and inherited)\n  where\n    nfib n = if n < 2 then 1 else nfib (n-1) + nfib (n-2)\n\nmain = do\n  print (fib1 28)\n  print (fib2 28)\n  print (fib3 28)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = let xs = [1..] in print (length (xs ++ xs))\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- A second test for trac #3001, which segfaults when compiled by\n-- GHC 6.10.1 and run with +RTS -hb. Most of the code is from the\n-- binary 0.4.4 package.\n\n{-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts, MagicHash #-}\n\nmodule Main (main) where\n\nimport Data.Semigroup\n\nimport Data.ByteString.Internal (inlinePerformIO)\n\nimport qualified Data.ByteString      as S\nimport qualified Data.ByteString.Internal      as S\nimport qualified Data.ByteString.Lazy as L\nimport qualified Data.ByteString.Lazy.Internal as L\n\nimport GHC.Exts\nimport GHC.Word\n\nimport Control.Monad\nimport Foreign\nimport System.IO.Unsafe\nimport System.IO\n\nimport Data.Char    (chr,ord)\n\nimport Control.Applicative\n\nmain :: IO ()\nmain = do\n  encodeFile \"test.bin\" $ replicate 10000 'x'\n  print =<< (decodeFile \"test.bin\" :: IO String)\n\nclass Binary t where\n    put :: t -> Put\n    get :: Get t\n\nencodeFile :: Binary a => FilePath -> a -> IO ()\nencodeFile f v = L.writeFile f $ runPut $ put v\n\ndecodeFile :: Binary a => FilePath -> IO a\ndecodeFile f = do\n    s <- L.readFile f\n    return $ runGet (do v <- get\n                        m <- isEmpty\n                        m `seq` return v) s\n\ninstance Binary Word8 where\n    put     = putWord8\n    get     = getWord8\n\ninstance Binary Word32 where\n    put     = putWord32be\n    get     = getWord32be\n\ninstance Binary Int32 where\n    put i   = put (fromIntegral i :: Word32)\n    get     = liftM fromIntegral (get :: Get Word32)\n\ninstance Binary Int where\n    put i   = put (fromIntegral i :: Int32)\n    get     = liftM fromIntegral (get :: Get Int32)\n\ninstance Binary Char where\n    put a = put (ord a)\n    get = do w <- get\n             return $! chr w\n\ninstance Binary a => Binary [a] where\n    put l  = put (length l) >> mapM_ put l\n    get    = do n <- get\n                replicateM n get\n\ndata PairS a = PairS a !Builder\n\nsndS :: PairS a -> Builder\nsndS (PairS _ b) = b\n\nnewtype PutM a = Put { unPut :: PairS a }\n\ntype Put = PutM ()\n\ninstance Functor PutM where\n        fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w\n\ninstance Monad PutM where\n    return a = Put $ PairS a mempty\n\n    m >>= k  = Put $\n        let PairS a w  = unPut m\n            PairS b w' = unPut (k a)\n        in PairS b (w `mappend` w')\n\n    m >> k  = Put $\n        let PairS _ w  = unPut m\n            PairS b w' = unPut k\n        in PairS b (w `mappend` w')\n\ninstance Applicative PutM where\n    pure  = return\n    (<*>) = ap\n\ntell :: Builder -> Put\ntell b = Put $ PairS () b\n\nrunPut :: Put -> L.ByteString\nrunPut = toLazyByteString . sndS . unPut\n\nputWord8            :: Word8 -> Put\nputWord8            = tell . singletonB\n\nputWord32be         :: Word32 -> Put\nputWord32be         = tell . putWord32beB\n\n-----\n\nnewtype Get a = Get { unGet :: S -> (a, S) }\n\ndata S = S {-# UNPACK #-} !S.ByteString  -- current chunk\n           L.ByteString                  -- the rest of the input\n           {-# UNPACK #-} !Int64         -- bytes read\n\nrunGet :: Get a -> L.ByteString -> a\nrunGet m str = case unGet m (initState str) of (a, _) -> a\n\nisEmpty :: Get Bool\nisEmpty = do\n    S s ss _ <- getZ\n    return (S.null s && L.null ss)\n\ninitState :: L.ByteString -> S\ninitState xs = mkState xs 0\n\ngetWord32be :: Get Word32\ngetWord32be = do\n    s <- readN 4 id\n    return $! (fromIntegral (s `S.index` 0) `shiftl_w32` 24) .|.\n              (fromIntegral (s `S.index` 1) `shiftl_w32` 16) .|.\n              (fromIntegral (s `S.index` 2) `shiftl_w32`  8) .|.\n              (fromIntegral (s `S.index` 3) )\n\ngetWord8 :: Get Word8\ngetWord8 = getPtr (sizeOf (undefined :: Word8))\n\nmkState :: L.ByteString -> Int64 -> S\nmkState l = case l of\n    L.Empty      -> S S.empty L.empty\n    L.Chunk x xs -> S x xs\n\nreadN :: Int -> (S.ByteString -> a) -> Get a\nreadN n f = fmap f $ getBytes n\n\nshiftl_w32 :: Word32 -> Int -> Word32\nshiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#`   i)\n\ngetPtr :: Storable a => Int -> Get a\ngetPtr n = do\n    (fp,o,_) <- readN n S.toForeignPtr\n    return . S.inlinePerformIO $ withForeignPtr fp $ \\p -> peek (castPtr $ p `plusPtr` o)\n\ngetBytes :: Int -> Get S.ByteString\ngetBytes n = do\n    S s ss bytes <- getZ\n    if n <= S.length s\n        then do let (consume,rest) = S.splitAt n s\n                putZ $! S rest ss (bytes + fromIntegral n)\n                return $! consume\n        else\n              case L.splitAt (fromIntegral n) (s `joinZ` ss) of\n                (consuming, rest) ->\n                    do let now = S.concat . L.toChunks $ consuming\n                       putZ $! mkState rest (bytes + fromIntegral n)\n                       -- forces the next chunk before this one is returned\n                       if (S.length now < n)\n                         then\n                            fail \"too few bytes\"\n                         else\n                            return now\n\njoinZ :: S.ByteString -> L.ByteString -> L.ByteString\njoinZ bb lb\n    | S.null bb = lb\n    | otherwise = L.Chunk bb lb\n\ninstance Monad Get where\n    return a  = Get (\\s -> (a, s))\n    {-# INLINE return #-}\n\n    m >>= k   = Get (\\s -> let (a, s') = unGet m s\n                           in unGet (k a) s')\n    {-# INLINE (>>=) #-}\n\n    fail      = error \"failDesc\"\n\ninstance Applicative Get where\n    pure  = return\n    (<*>) = ap\n\ngetZ :: Get S\ngetZ   = Get (\\s -> (s, s))\n\nputZ :: S -> Get ()\nputZ s = Get (\\_ -> ((), s))\n\n\ninstance Functor Get where\n    fmap f m = Get (\\s -> case unGet m s of\n                             (a, s') -> (f a, s'))\n\n-----\n\nsingletonB :: Word8 -> Builder\nsingletonB = writeN 1 . flip poke\n\nwriteN :: Int -> (Ptr Word8 -> IO ()) -> Builder\nwriteN n f = ensureFree n `append` unsafeLiftIO (writeNBuffer n f)\n\nunsafeLiftIO :: (Buffer -> IO Buffer) -> Builder\nunsafeLiftIO f =  Builder $ \\ k buf -> inlinePerformIO $ do\n    buf' <- f buf\n    return (k buf')\n\nappend :: Builder -> Builder -> Builder\nappend (Builder f) (Builder g) = Builder (f . g)\n\nwriteNBuffer :: Int -> (Ptr Word8 -> IO ()) -> Buffer -> IO Buffer\nwriteNBuffer n f (Buffer fp o u l) = do\n    withForeignPtr fp (\\p -> f (p `plusPtr` (o+u)))\n    return (Buffer fp o (u+n) (l-n))\n\nnewtype Builder = Builder {\n        -- Invariant (from Data.ByteString.Lazy):\n        --      The lists include no null ByteStrings.\n        runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString]\n    }\n\ndata Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)\n                     {-# UNPACK #-} !Int                -- offset\n                     {-# UNPACK #-} !Int                -- used bytes\n                     {-# UNPACK #-} !Int                -- length left\n\ntoLazyByteString :: Builder -> L.ByteString\ntoLazyByteString m = L.fromChunks $ unsafePerformIO $ do\n    buf <- newBuffer defaultSize\n    return (runBuilder (m `append` flush) (const []) buf)\n\nensureFree :: Int -> Builder\nensureFree n = n `seq` withSize $ \\ l ->\n    if n <= l then emptyBuilder else\n        flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize)))\n\nwithSize :: (Int -> Builder) -> Builder\nwithSize f = Builder $ \\ k buf@(Buffer _ _ _ l) ->\n    runBuilder (f l) k buf\n\ndefaultSize :: Int\ndefaultSize = 32 * k - overhead\n    where k = 1024\n          overhead = 2 * sizeOf (undefined :: Int)\n\nnewBuffer :: Int -> IO Buffer\nnewBuffer size = do\n    fp <- S.mallocByteString size\n    return $! Buffer fp 0 0 size\n\nputWord32beB :: Word32 -> Builder\nputWord32beB w = writeN 4 $ \\p -> do\n    poke p               (fromIntegral (shiftr_w32 w 24) :: Word8)\n    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)\n    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w  8) :: Word8)\n    poke (p `plusPtr` 3) (fromIntegral (w)               :: Word8)\n\nshiftr_w32 :: Word32 -> Int -> Word32\nshiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)\n\nflush :: Builder\nflush = Builder $ \\ k buf@(Buffer p o u l) ->\n    if u == 0\n      then k buf\n      else S.PS p o u : k (Buffer p (o+u) 0 l)\n\nemptyBuilder :: Builder\nemptyBuilder = Builder id\n\ninstance Semigroup Builder where\n    (<>) = append\n\ninstance Monoid Builder where\n    mempty  = emptyBuilder\n    mappend = (<>)\n\n", "num_lines": 294}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This caused 6.10.1 to segfault when run with +RTS -hb\n-- trac #3001\n\nmodule Main (main) where\n\nmain :: IO ()\nmain = print $ replicate 40000 'x'\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad (forever)\n\nmain = do\n    empty <- newEmptyMVar\n    exit <- newEmptyMVar\n    _ <- forkIO $ threadDelay 200000 >> putMVar exit ()\n    _ <- forkIO $ takeMVar empty >> return ()\n    _ <- forkIO $ print (sum [1..10000])\n    takeMVar exit\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Array.Unboxed\n\nmain = do\n  let l1 = [1..10] :: [Int]\n  let l2 = [ map (i+) l1 | i <- [1..500000] ]\n  let l3 = map (\\l -> listArray (1,length l) l) l2 :: [UArray Int Int]\n  print $ accumulate l3 0\n\naccumulate [] rv = rv\naccumulate (h:t) rv =\n  let nextRv = (rv + sum (elems h)) in\n  accumulate t $! nextRv\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f\u00c3\u00b8b :: Integer -> Integer\nf\u00c3\u00b8b n\n  | n == 0 = 0\n  | n == 1 = 1\n  | n >= 2 = f\u00c3\u00b8b (n - 1) + f\u00c3\u00b8b (n - 2)\n\nmain :: IO ()\nmain = print (f\u00c3\u00b8b 26)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests for a bug in the handling of cost-centre stacks in the\n-- runtime, where we lose the current cost-centre stack when\n-- evaluating a function.\n\n{-# NOINLINE f #-}\nf :: Int -> Int\nf = g   -- here we should remember the stack under which g was evaluated\n\n{-# NOINLINE g #-}\ng :: Int -> Int\ng x = x + 1\n\nmain =  return $! f 3\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests for a bug in the handling of cost-centre stacks in the\n-- runtime, where we lose the current cost-centre stack when\n-- evaluating a function.\n\n{-# NOINLINE f #-}\nf :: Int -> Int\nf = g   -- here we should remember the stack under which g was evaluated\n\n{-# NOINLINE g #-}\ng :: Int -> Int\ng x = x + 1\n\nmain =  return $! f 3\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A variant of T5654 where instead of evaluating directly to a\n-- function, f evaluates to a new PAP.  This exposes a slightly\n-- different but related bug, where when we create a new PAP by\n-- applying arguments to an existing PAP, we should take into account\n-- the stack on the original PAP.\n\n-- The stack we should see is main->f->g->h, but if we get this wrong\n-- (GHC 7.10) then the stack is main->f->h.\n\n{-# NOINLINE f #-}\nf :: Int -> Int\nf = g 3\n\n{-# NOINLINE g #-}\ng :: Int -> Int -> Int\ng = h 4\n\n{-# NOINLINE h #-}\nh :: Int -> Int -> Int -> Int\nh x y z = x + y + z\n\nmain =  return $! f 5\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A variant of T5654 where instead of evaluating directly to a\n-- function, f evaluates to a new PAP.  This exposes a slightly\n-- different but related bug, where when we create a new PAP by\n-- applying arguments to an existing PAP, we should take into account\n-- the stack on the original PAP.\n\n-- The stack we should see is main->f->g->h, but if we get this wrong\n-- (GHC 7.10) then the stack is main->f->h.\n\n{-# NOINLINE f #-}\nf :: Int -> Int\nf = g 3\n\n{-# NOINLINE g #-}\ng :: Int -> Int -> Int\ng = h 4\n\n{-# NOINLINE h #-}\nh :: Int -> Int -> Int -> Int\nh x y z = x + y + z\n\nmain =  return $! f 5\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A variant of T5654 where instead of evaluating directly to a\n-- function, f evaluates to a new PAP.  This exposes a slightly\n-- different but related bug, where when we create a new PAP by\n-- applying arguments to an existing PAP, we should take into account\n-- the stack on the original PAP.\n\n-- The stack we should see is main->f->g->h, but if we get this wrong\n-- (GHC 7.10) then the stack is main->f->h.\n\n{-# NOINLINE f #-}\nf :: Int -> Int\nf = g 3\n\n{-# NOINLINE g #-}\ng :: Int -> Int -> Int\ng = h 4\n\n{-# NOINLINE h #-}\nh :: Int -> Int -> Int -> Int\nh x y z = x + y + z\n\nmain =  return $! f 5\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "foo :: (() -> () -> [()] -> [()]) -> () -> [()] -> [()]\nfoo k =\n  \\_ xs -> concatMap ($ [head xs]) [bar]\n where\n  bar =\n    let k' = k undefined undefined\n    in  \\xs ->\n          let k'' = [k' xs]\n          in  (() : (foldr1 (>>) k''))\n\nk :: () -> [()] -> [()]\nk = foo (\\_ -> k)\n\n--k a = foo (\\_ -> k) a\n\n-- all the work should happen in r\nr :: ()\nr = k undefined [] !! 4000\n\nmain = print r\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for #949: the -hy heap profile should not include\n-- \"stg_ap_2_upd\" or similar\n\nmain = length xs `seq` return xs\n  where xs = map (+1) [1..1000000]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nf1 :: Int -> Int\nf1 = (+ 1)\n\nf2 :: Int -> Int\nf2 = f3 . f3 . f3\n  where\n    f3 :: Int -> Int\n    f3 = (* 123)\n    {-# SCC f3 \"bar\" #-}\n    {-# NOINLINE f3 #-}\n\n\n\nmain :: IO ()\nmain = readLn >>= print . f2 . f1\n\n{-# NOINLINE f1 #-}\n{-# NOINLINE f2 #-}\n\n{-# SCC f1 #-}\n{-# SCC f2 \"foo\" #-}\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) -- q\nwhere {\n--import Fast2haskell;\n\n    f_queens a_n=f_queens' (enumFromTo (1 :: Int) a_n) a_n;\n    f_queens' a_positions 0=(:) [] [];\n    f_queens' a_positions a_n=c_concat (f_map (f_place (f_queens' a_positions (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)))) a_positions);\n    f_place a_boards a_q=[(:) a_q a_bs|a_bs<-a_boards,f_safe (1 :: Int) a_q a_bs];\n    f_safe a_d a_q []=True;\n    f_safe a_d a_q (a_h:a_t)=\n        if (((==) :: (Int -> Int -> Bool)) a_q a_h)\n        then False\n        else \n        if (((==) :: (Int -> Int -> Bool)) (f_absi (((-) :: (Int -> Int -> Int)) a_q a_h)) a_d)\n        then False\n        else \n            (f_safe (((+) :: (Int -> Int -> Int)) a_d (1 :: Int)) a_q a_t);\n    f_absi a_n=\n        if (((<) :: (Int -> Int -> Bool)) a_n (0 :: Int))\n        then (((negate) :: (Int -> Int)) a_n)\n        else \n            a_n;\n    f_main a_n=(++) (show (length (f_queens a_n))) \"\\n\";\n    c_input=(10 :: Int);\n    c_concat=f_foldr (++) [];\n    f_foldr a_op a_r []=a_r;\n    f_foldr a_op a_r (a_a:a_x)=a_op a_a (f_foldr a_op a_r a_x);\n    f_map a_f a_x=[a_f a_a|a_a<-a_x];\n    main = putStr (f_main c_input)\n}\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Evaluator in a monad: with execution counts\n-- Phil Wadler, 11 October 1991\n\n-- Types are optional.  Some must be commented out to\n-- work around a bug in Gofer.\n\n-- The count monad\n\ntype  M a               =  (a, Int)\n\nunit                    :: a -> M a\nunit a                  =  (a, 0)\n\nbind                    :: M a -> (a -> M b) -> M b\nm `bind` k              =  case m of\n                             (a,i) -> case k a of\n                                        (b,j) -> (b,i+j)\n\n-- disp                 :: Text a => M a -> String\ndisp (a,i)              =  show a ++ \"\\nCount: \" ++ show i\n\ntick                    :: M ()\ntick                    =  ((), 1)\n\n-- The evaluator\n-- Lines with * are only change from evalIdent\n\ndata  Op                =  Add | Sub | Mul | Quo\ndata  Term              =  Con Int | Bin Op Term Term\n\neval                    :: Term -> M Int\neval (Con i)            =  unit i\neval (Bin op u v)       =  eval u     `bind` (\\a  ->\n                           eval v     `bind` (\\b  ->\n                           go op a b  `bind` (\\c  ->    -- *\n                           tick       `bind` (\\ () ->   -- *\n                           unit c))))                   -- *\n\ngo                      :: Op -> Int -> Int -> M Int\ngo Add a b              =  unit (a+b)\ngo Sub a b              =  unit (a-b)\ngo Mul a b              =  unit (a*b)\ngo Quo a b              =  unit (a `quot` b) -- WDP: was \"div\"\n\ntest                    :: Term -> String\ntest t                  =  disp (eval t)\n\n-- Test data\n\nadd, sub, mul, quo      :: Term -> Term -> Term\nu `add` v               =  Bin Add u v\nu `sub` v               =  Bin Sub u v\nu `mul` v               =  Bin Mul u v\nu `quo` v               =  Bin Quo u v\n\nterm0,term1,term2       :: Term\nterm0                   =  Con 6 `mul` Con 9\nterm1                   =  (Con 4 `mul` Con 13) `add` Con 2\nterm2                   =  (Con 1 `quo` Con 2) `add` Con 2\nterm3                   =  ((((((((((((((((((((((((((((((((\n                           ((((((((((((((((((((((((((((((\n                                 Con 7777 `mul` Con  13) `quo` Con  13)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n                           `mul` Con 755) `quo` Con 755) `mul` Con 333)\n                           `quo` Con 755) `mul` Con 755) `mul` Con 333)\n\nsb 0 = term2\nsb n = if (n `mod` 2) == 0\n       then term2 `add` (sb (n-1))\n       else term2 `sub` (sb (n-1))\n\nmain = print (show (eval (sb 5000)))\n", "num_lines": 90}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n module DataTypes where\n\n import GenUtils\n import Data.Array -- 1.3\n import Data.Ix\n import Data.Char\n infix 1 =: -- 1.3\n (=:) a b = (a,b)\n\n\n\n\n\n class Presentable a where\n       userFormat :: a -> String       -- in prefered display format\n\n\n\n\n\n instance (Presentable a) => Presentable [a] where\n     userFormat xs = unlines (map userFormat xs)\n\n\n\n\n data Piece\n       = King\n       | Queen\n       | Rook\n       | Knight\n       | Bishop\n       | Pawn deriving(Eq)\n\n instance Presentable Piece where\n   userFormat King   = \"K\"\n   userFormat Queen  = \"Q\"\n   userFormat Rook   = \"R\"\n   userFormat Knight = \"N\"\n   userFormat Bishop = \"B\"\n   userFormat Pawn   = \"P\"\n\n\n\n\n castleK = \"O-O\"\n castleQ = \"O-O-O\"\n\n\n\n\n\n data Colour = Black | White deriving (Eq)\n\n instance Presentable Colour where\n       userFormat White = \"White\"\n       userFormat Black = \"Black\"\n\n changeColour :: Colour -> Colour\n changeColour White = Black\n changeColour Black = White\n\n\n\n\n\n type ChessRank = Int  -- 1-8\n type ChessFile = Int  -- 1-8\n\n type BoardPos = (ChessFile,ChessRank) -- ChessFile (0-7) and ChessRank (0-7)\n type ExBoardPos = (Maybe ChessFile,Maybe ChessRank)\n\n extendBP :: BoardPos -> ExBoardPos \n extendBP (a,b) = (Just a,Just b)\n\n compExBPandBP :: ExBoardPos -> BoardPos -> Bool\n compExBPandBP (a,b) (c,d) = a `cmp` c && b `cmp` d\n    where \n       cmp Nothing  _ = True\n       cmp (Just x) y = x == y\n\n userFormatBoardPos :: BoardPos -> String\n userFormatBoardPos (f,r) = userFormatFile f ++ userFormatRank r\n userFormatExBoardPos :: ExBoardPos -> String\n userFormatExBoardPos (Just f,Just r)  = userFormatFile f ++ userFormatRank r\n userFormatExBoardPos (Just f,Nothing) = userFormatFile f \n userFormatExBoardPos (Nothing,Just r) = userFormatRank r\n userFormatExBoardPos _ = \"\"\n userFormatRank r = [toEnum (r + 48)]\n userFormatFile f = [toEnum (f + 96)]\n\n\n\n\n\n data MoveTok \n       = PieceTok Piece        -- Q,K,R,B,N\n       | RankTok ChessRank     -- 1 .. 8\n       | FileTok ChessFile     -- a .. h\n       | PartCastleTok         -- 0 | O | o\n       | CaptureTok            -- x\n       | MoveToTok             -- -\n       | QueensWith            -- =\n       | CheckTok              -- +\n       | MateTok               -- #\n\n charToMoveTok 'Q' = Just (PieceTok Queen)\n charToMoveTok 'K' = Just (PieceTok King)\n charToMoveTok 'R' = Just (PieceTok Rook)\n charToMoveTok 'B' = Just (PieceTok Bishop)\n charToMoveTok 'N' = Just (PieceTok Knight)\n charToMoveTok '1' = Just (RankTok 1)\n charToMoveTok '2' = Just (RankTok 2)\n charToMoveTok '3' = Just (RankTok 3)\n charToMoveTok '4' = Just (RankTok 4)\n charToMoveTok '5' = Just (RankTok 5)\n charToMoveTok '6' = Just (RankTok 6)\n charToMoveTok '7' = Just (RankTok 7)\n charToMoveTok '8' = Just (RankTok 8)\n charToMoveTok 'a' = Just (FileTok 1)\n charToMoveTok 'b' = Just (FileTok 2)\n charToMoveTok 'c' = Just (FileTok 3)\n charToMoveTok 'd' = Just (FileTok 4)\n charToMoveTok 'e' = Just (FileTok 5)\n charToMoveTok 'f' = Just (FileTok 6)\n charToMoveTok 'g' = Just (FileTok 7)\n charToMoveTok 'h' = Just (FileTok 8)\n charToMoveTok '0' = Just (PartCastleTok)\n charToMoveTok 'O' = Just (PartCastleTok)\n charToMoveTok 'o' = Just (PartCastleTok)\n charToMoveTok 'x' = Just (CaptureTok)\n charToMoveTok '-' = Just (MoveToTok)\n charToMoveTok '=' = Just (QueensWith)\n charToMoveTok '+' = Just (CheckTok)\n charToMoveTok '#' = Just (MateTok)\n charToMoveTok _   = Nothing\n\n\n\n data Quantum \n       = QuantumMove   String          -- Short Description of move\n                       String          -- Check or Mate (+ or #)\n                       String          -- !,??,?!, etc\n                       Board           -- Snap Shot of Board\n       | QuantumNAG Int                -- !,??,?! stuff\n       | QuantumComment [String]       -- { comment }\n       | QuantumResult String          -- 1-0, etc (marks end of game)\n       | QuantumAnalysis [Quantum]     -- ( analysis )\n       | QuantumPrintBoard             -- {^D}\n\n instance Presentable Quantum where\n       userFormat (QuantumMove mv ch ann _) \n               = mv ++ ch ++ ann\n       userFormat (QuantumNAG nag) = \"$\" ++ show nag\n       userFormat (QuantumComment comment) \n               = \"[\" ++ unwords comment ++ \"]\"\n       --userFormat (QuantumNumber num)  = userFormat num\n       userFormat (QuantumResult str) = str\n       userFormat (QuantumAnalysis anal) =\n               \"( \" ++ unwords (map userFormat anal) ++ \" )\"\n\n\n\n data Result = Win | Draw | Loss | Unknown\n\n instance Presentable Result where\n       userFormat Win     = \"1-0\"\n       userFormat Draw    = \"1/2-1/2\"\n       userFormat Loss    = \"0-1\"\n       userFormat Unknown = \"*\"\n\n mkResult :: String -> Result\n mkResult \"1-0\"     = Win\n mkResult \"1/2-1/2\" = Draw\n mkResult \"0-1\"     = Loss\n mkResult _         = Unknown\n\n\n\n data TagStr = TagStr String String\n\n instance Presentable TagStr where\n       userFormat (TagStr tag str) = \"[\" ++ tag ++ \" \\\"\" ++ str ++ \"\\\"]\"\n\n getTagStr :: String -> String -> [TagStr] -> String\n getTagStr str def [] = def\n getTagStr str def (TagStr st ans:rest) \n               | str == st = ans\n               | otherwise = getTagStr str def rest\n\n getHeaderInfo \n       :: [TagStr]\n       -> (\n               String,         -- Date\n               String,         -- Site\n               Maybe Int,      -- Game Number\n               Result,         -- W/D/L\n               String,         -- White\n               String,         -- Black\n               String          -- Opening\n       )\n getHeaderInfo tags = (\n               date,\n               site,\n               gameno,\n               result,\n               white `par` whiteElo,\n               black `par` blackElo,\n               opening)\n   where\n       date   = case getTagStr \"Date\" \"?\" tags of\n                  [a,b,c,d,'.','?','?','.','?','?'] -> [a,b,c,d]\n                  [a,b,c,d,'.',x,y,'.','?','?'] -> getMonth [x,y] ++ \" \" ++ [a,b,c,d]\n                  def -> \"?\"\n       site     = getTagStr \"Site\" \"?\" tags\n       gameno   = case getTagStr \"GameNumber\" \"\" tags of\n                       xs | all isDigit xs && not (null xs) -> Just (read xs)\n                       _ -> Nothing\n       result   = mkResult (getTagStr \"Result\" \"*\" tags)\n       white    = canon (getTagStr \"White\" \"?\" tags)\n       whiteElo = getTagStr \"WhiteElo\" \"\" tags\n       black    = canon (getTagStr \"Black\" \"?\" tags)\n       blackElo = getTagStr \"BlackElo\" \"\" tags\n       opening  = getOpening (getTagStr \"ECO\" \"\" tags)\n\n       par xs \"\" = xs\n       par xs ys = xs ++ \" (\" ++ ys ++ \")\"\n\n       getMonth \"01\" = \"Jan\"\n       getMonth \"02\" = \"Feb\"\n       getMonth \"03\" = \"Mar\"\n       getMonth \"04\" = \"Apr\"\n       getMonth \"05\" = \"May\"\n       getMonth \"06\" = \"Jun\"\n       getMonth \"07\" = \"Jul\"\n       getMonth \"08\" = \"Aug\"\n       getMonth \"09\" = \"Sep\"\n       getMonth \"10\" = \"Oct\"\n       getMonth \"11\" = \"Nov\"\n       getMonth \"12\" = \"Dec\"\n\n       canon name = case span (/= ',') name of\n                       (a,[',',' ',b]) -> b : \". \" ++ a\n                       (a,[',',b]) -> b : \". \" ++ a\n                       (a,',':' ':b) -> b ++ \" \" ++ a\n                       (a,',':b) -> b ++ \" \" ++ a\n                       _ -> name\n\n\n getOpening eco@[a,b,c] |  a >= 'A' && a <= 'E' && isDigit b && isDigit c \n    = getOpenName ((fromEnum a - fromEnum 'A') * 100 \n               + (fromEnum b - fromEnum '0') * 10 \n               + (fromEnum c - fromEnum '0')) ++ \" \" ++ eco\n getOpening other = other\n\n getOpenName :: Int -> String\n getOpenName eco \n       | otherwise = \"Foo\"\n {-\n       | eco == 000 = \"Irregular Openings\"\n       | eco == 001 = \"Larsen Opening\"\n       | eco == 002 = \"From's Gambit and Bird's Open\"\n       | eco == 003 = \"Bird's Opening\"\n       | eco == 004 = \"Dutch System\"\n       | eco == 005 = \"Transposition to various Open\"\n       | eco == 006 = \"Zukertort Opening\"\n       | eco >= 007 && eco <= 008\n                    = \"Barcza System\"\n       | eco == 009 = \"Reti Opening\"\n       | eco == 010 = \"Variations of Dutch, QI, KI\"\n       | eco >= 011 && eco <= 014\n                    = \"Reti Opening\"\n       | eco == 015 = \"English counter King's Fianch\"\n       | eco >= 016 && eco <= 039\n                    = \"English Opening\"\n       | eco == 040 = \"Unusual replies to 1.d4\"\n       | eco == 041 = \"Modern Defence counter 1.d4\"\n       | eco == 042 = \"Modern Defence with c2-c4\"\n       | eco >= 043 && eco <= 044\n                    = \"Old Benoni\"\n       | eco == 045 = \"Queen's Pawn-Trompowski Var\"\n       | eco == 046 = \"Queen's Pawn Opening\"\n       | eco == 047 = \"Queen's Indian\"\n       | eco >= 048 && eco <= 049\n                    = \"King's Indian\"\n       | eco == 050 = \"Queen's Indian\"\n       | eco >= 051 && eco <= 052\n                    = \"Budapest Defence\"\n       | eco >= 053 && eco <= 056\n                    = \"Old Indian Defence\"\n       | eco >= 057 && eco <= 059\n                    = \"Volga-Benko Gambit\"\n       | eco >= 060 && eco <= 079\n                    = \"Benoni\"\n       | eco >= 080 && eco <= 099\n                    = \"Dutch Defence\"\n       | eco == 100 = \"Owen Def, Nimzowitsch Def\"\n       | eco == 101 = \"Center Counter\"\n       | eco >= 102 && eco <= 105\n                    = \"Alekhine's Defence\"\n       | eco == 106 = \"Modern Defence\"\n       | eco >= 107 && eco <= 109\n                    = \"Pirc Defence\"\n       | eco >= 110 && eco <= 119\n                    = \"Caro-Kann Defence\"\n       | eco >= 120 && eco <= 199\n                    = \"Sicilian Defence\"\n       | eco >= 200 && eco <= 219\n                    = \"French Defence\"\n       | eco == 220 = \"Rare moves\"\n       | eco == 221 = \"Nordic Gambit\"\n       | eco == 222 = \"Central Gambit\"\n       | eco >= 223 && eco <= 224\n                    = \"Bishop's Opening\"\n       | eco >= 225 && eco <= 229\n                    = \"Vienna Game\"\n       | eco == 230 = \"King's Gambit Declined\"\n       | eco >= 231 && eco <= 232\n                    = \"Falkbeer Counter Gambit\"\n       | eco >= 233 && eco <= 239\n                    = \"King's Gambit\"\n       | eco == 240 = \"Latvian Gambit\"\n       | eco == 241 = \"Philidor Defence\"\n       | eco >= 242 && eco <= 243\n                    = \"Russian Defence-Petrov\"\n       | eco >= 244 && eco <= 245\n                    = \"Scotch Opening\"\n       | eco >= 246 && eco <= 249\n                    = \"Four Knight's\"\n       | eco == 250 = \"Italian Opening\"\n       | eco >= 251 && eco <= 252\n                    = \"Evans Gambit\"\n       | eco >= 253 && eco <= 254\n                    = \"Italian Opening\"\n       | eco >= 255 && eco <= 259\n                    = \"Two Knight's Play\"\n       | eco >= 260 && eco <= 299\n                    = \"Ruy Lopez\"\n       | eco >= 300 && eco <= 305\n                    = \"Queen Pawn's Opening\"\n       | eco >= 306 && eco <= 307\n                    = \"Queen's Gambit\"\n       | eco >= 308 && eco <= 309\n                    = \"Albins Counter Gambit\"\n       | eco >= 310 && eco <= 319\n                    = \"Slav Defence\"\n       | eco >= 320 && eco <= 329\n                    = \"Queen's Gambit Accepted\"\n       | eco >= 330 && eco <= 369\n                    = \"Queen's Gambit\"\n       | eco >= 370 && eco <= 399\n                    = \"Gruenfeld Defence\"\n       | eco >= 400 && eco <= 409\n                    = \"Catalan\"\n       | eco == 410 = \"Blumenfeld Gambit\"\n       | eco >= 411 && eco <= 419\n                    = \"Queen's Indian\"\n       | eco >= 420 && eco <= 459\n                    = \"Nimzo Indian\"\n       | eco >= 460 && eco <= 499\n                    = \"King's Indian\"\n -}\n\n\n\n data MoveNumber = MoveNumber Int Colour\n instance Presentable MoveNumber where\n       userFormat (MoveNumber n White)  = show n ++ \".\"\n       userFormat (MoveNumber n Black)  = show n ++ \"...\"\n\n initMoveNumber = MoveNumber 1 White\n incMove (MoveNumber i White) = MoveNumber i Black\n incMove (MoveNumber i Black) = MoveNumber (i+1) White\n decMove (MoveNumber i White) = MoveNumber (i-1) Black\n decMove (MoveNumber i Black) = MoveNumber i White\n getMoveColour :: MoveNumber -> Colour\n getMoveColour (MoveNumber _ c) = c\n\n\n\n data Token \n\n\n\n       = StringToken   String\n       | AsterixToken\n       | LeftABToken           -- ??\n       | RightABToken          -- ??\n       | NAGToken      Int     -- `normal' NAGS\n       | NAGAnnToken   Int String\n                               -- `special' move annotating NAGS (1-6)\n       | SymbolToken   String\n       | CommentToken  [String] -- list of words\n       | LeftSBToken\n       | RightSBToken\n       | LeftRBToken\n       | RightRBToken\n       | IntToken      Int\n       | PeriodToken\n\n\n\n       | AnalToken     [Token]\n\n instance Presentable Token where\n       userFormat (StringToken str) = show str\n       userFormat (IntToken n)      = show n\n       userFormat (PeriodToken)     = \".\"\n       userFormat (AsterixToken)    = \"*\"\n       userFormat (LeftSBToken)     = \"[\"\n       userFormat (RightSBToken)    = \"]\"\n       userFormat (LeftRBToken)     = \"(\"\n       userFormat (RightRBToken)    = \")\"\n       userFormat (LeftABToken)     = \"<\"\n       userFormat (RightABToken)    = \">\"\n       userFormat (NAGToken i)      = \"$\" ++ show i\n       userFormat (NAGAnnToken i s) = \"$\" ++ show i\n       userFormat (SymbolToken str) = str\n       userFormat (CommentToken str) = \"{\" ++ unwords str ++ \"}\"\n       userFormat (AnalToken toks) = \"( \" ++ unwords (map userFormat toks)\n                                       ++ \" )\"\n\n\n\n\n\n data Game a = Game [TagStr] [a]\n\n type AbsGame = Game Token\n type RealGame = Game Quantum\n\n instance (Presentable a) => Presentable (Game a) where\n       userFormat (Game tags toks) = \n               unlines (map userFormat tags \n                  ++ formatText 78 (map userFormat toks))\n\n\n\n\n\n\n data PlayMove\n       = PlayMove\n               Piece           -- with this\n               BoardPos        -- from here\n               BoardPos        -- to here (possibly capturing)\n               SpecialMove\n\n mkPlayMove p f t = PlayMove p f t NothingSpecial\n\n data SpecialMove \n       = NothingSpecial        \n       | BigPawnMove           -- allows e.p. next move\n       | Queening Piece        -- queen with this\n       | EnPassant             -- capture e.p.\n    deriving (Eq)\n\n instance Presentable PlayMove where\n       userFormat (PlayMove piece pos pos' sp) = \n               userFormat piece ++\n               userFormatBoardPos pos ++ \"-\" ++\n               userFormatBoardPos pos' ++ \n               userFormat sp\n\n instance Presentable SpecialMove where\n       userFormat (NothingSpecial) = \"\"\n       userFormat (BigPawnMove) = \"{b.p.m.}\"\n       userFormat (Queening p) = \"=\" ++ userFormat p\n       userFormat (EnPassant) = \"e.p.\"\n\n extractSrcFromPlayMove :: PlayMove -> BoardPos\n extractSrcFromPlayMove (PlayMove _ src _ _) = src\n\n extractDestFromPlayMove :: PlayMove -> BoardPos\n extractDestFromPlayMove (PlayMove _ _ dest _)       = dest\n\n extractSpecialFromPlayMove :: PlayMove -> SpecialMove\n extractSpecialFromPlayMove (PlayMove _ _ _ sp)       = sp\n\n\n\n\n\n\n data BoardSquare\n       = VacantSq\n       | WhitesSq Piece\n       | BlacksSq Piece\n\n data SquareContent\n       = Vacant\n       | Friendly\n       | Baddy\n       | OffBoard deriving (Eq)\n\n instance Presentable SquareContent where\n       userFormat Vacant   = \".\"\n       userFormat Friendly = \"*\"\n       userFormat Baddy    = \"#\"\n       userFormat OffBoard = \"?\"\n\n\n\n\n\n\n data Board \n       = Board (Array BoardPos BoardSquare)\n               MoveNumber              -- current player & and move\n               (Maybe ChessFile)       -- e.p. possibilities.\n\n\n\n displayBoard :: Colour -> Board -> [String]\n displayBoard col (Board arr _ ep) = \n       ([cjustify 33 (userFormat (changeColour col)),\"\"] ++\n       [\n   concat [ (case (even x,even y) of\n       (True,True)   -> showSq (x `div` 2) (y `div` 2)\n       (False,False) -> \"+\"\n       (True,False)  -> \"---\"\n       (False,True)  -> (if x == 17 then \"| \" ++ show (y `div` 2) else \"|\"))\n               | x <- [1..17::Int]]\n               | y <- reverse [1..17::Int]] ++\n       [concat [ \"  \" ++ [x] ++ \" \" | x <- \"abcdefgh\" ]] ++\n       [\"\",cjustify 33 (userFormat col),\"\",\n               case ep of\n                Nothing -> \"\"\n                Just p -> \"EnPassant:\" ++ userFormatFile p ])\n    where\n       make n str = take n (str ++ repeat ' ')\n       lookupPlace :: Int -> Int -> BoardSquare\n       lookupPlace x' y' = arr ! (x',y')\n\n       bold :: String -> String\n       bold str = map toLower str\n\n       showSq x y = case lookupPlace x y of\n               VacantSq     -> [if_dot,if_dot,if_dot]\n               (WhitesSq p) -> (if_dot : userFormat p) ++ [if_dot]\n               (BlacksSq p)  -> (if_dot : bold (userFormat p)) ++ [if_dot]\n          where\n               if_dot = if (x - y) `rem` 2 == 0 then '.' else ' '\n\n instance Presentable Board where\n   userFormat = unlines . displayBoard White\n\n boardSize :: (BoardPos,BoardPos)\n boardSize = ((1,1),(8,8))\n\n\n\n\n buildBoard :: String -> Board\n buildBoard str = Board brd initMoveNumber Nothing\n    where\n       brd = array boardSize (zipWith (=:) allSq (mkPieces str))\n       allSq = [ (x,y) | y <- reverse [1..8::Int],x <- [1..8::Int]]\n       mkPieces :: String -> [BoardSquare]\n       mkPieces (hd:rest) | hd `elem` \"KQRNBPkqrnbp\" = pc : mkPieces rest\n          where\n               pc = case hd of\n                       'K' -> WhitesSq King    \n                       'Q' -> WhitesSq Queen\n                       'R' -> WhitesSq Rook\n                       'N' -> WhitesSq Knight\n                       'B' -> WhitesSq Bishop  \n                       'P' -> WhitesSq Pawn\n                       'k' -> BlacksSq King    \n                       'q' -> BlacksSq Queen\n                       'r' -> BlacksSq Rook\n                       'n' -> BlacksSq Knight\n                       'b' -> BlacksSq Bishop  \n                       'p' -> BlacksSq Pawn\n       mkPieces ('/':rest) = mkPieces rest\n       mkPieces (c:rest) | isDigit c =\n               case span isDigit rest of\n                 (cs,rest') -> take (read (c:cs)) (repeat VacantSq) \n                                       ++ mkPieces rest'\n       mkPieces [] = []\n\n startBoard :: Board   -- the uni before the big bang.\n startBoard = buildBoard \"rnbqkbnr/pppppppp/32/PPPPPPPP/RNBQKBNR\"\n\n lookupSquare :: Colour -> BoardSquare -> SquareContent\n lookupSquare _      VacantSq    = Vacant\n lookupSquare White (WhitesSq p) = Friendly\n lookupSquare Black (WhitesSq p) = Baddy\n lookupSquare White (BlacksSq p) = Baddy\n lookupSquare Black (BlacksSq p) = Friendly\n\n lookupBoard :: Board -> BoardPos -> SquareContent\n lookupBoard (Board arr col _) pos = \n       if inRange boardSize pos\n       then lookupSquare (getMoveColour col) (arr ! pos)\n       else OffBoard\n\n lookupBoardSquare :: Board -> BoardPos -> BoardSquare\n lookupBoardSquare (Board arr _ _) pos = arr ! pos\n\n getSquarePiece :: BoardSquare -> Maybe Piece\n getSquarePiece VacantSq    = Nothing\n getSquarePiece (WhitesSq p) = Just p\n getSquarePiece (BlacksSq p) = Just p\n\n lookupBoardPiece :: Board -> BoardPos -> Maybe Piece\n lookupBoardPiece (Board arr _ _) pos = \n     case arr ! pos of\n       VacantSq -> Nothing\n       WhitesSq piece -> Just piece\n       BlacksSq piece -> Just piece\n\n\n\n {-# INLINE mkColBoardSq #-}\n mkColBoardSq :: Colour -> Piece -> BoardSquare\n mkColBoardSq White p = WhitesSq p\n mkColBoardSq Black p = BlacksSq p\n\n getBoardColour (Board _ mv _) = getMoveColour mv\n\n", "num_lines": 623}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n\n\n\n\n\n\n\nmodule GenUtils (\n\n        trace,\n\n      assocMaybe, assocMaybeErr,\n      arrElem,\n      arrCond,\n      memoise,\n      Maybe(..),\n      MaybeErr(..),\n      mapMaybe,\n      mapMaybeFail,\n      maybeToBool,\n      maybeToObj,\n      maybeMap,\n      joinMaybe,\n      mkClosure,\n      foldb,\n\n      mapAccumL,\n\n      sortWith,\n      sort,\n      cjustify,\n      ljustify,\n      rjustify,\n      space,\n      copy,\n      combinePairs,\n      formatText ) where\n\nimport Data.Array -- 1.3\nimport Data.Ix    -- 1.3\n\nimport Debug.Trace ( trace )\n\n\n-- -------------------------------------------------------------------------\n\n-- Here are two defs that everyone seems to define ...\n-- HBC has it in one of its builtin modules\n\ninfix 1 =: -- 1.3\ntype Assoc a b = (a,b) -- 1.3\n(=:) a b = (a,b)\n\nmapMaybe :: (a -> Maybe b) -> [a] -> [b]\nmapMaybe f [] = []\nmapMaybe f (a:r) = case f a of\n                      Nothing -> mapMaybe f r\n                      Just b  -> b : mapMaybe f r\n\n-- This version returns nothing, if *any* one fails.\n\nmapMaybeFail f (x:xs) = case f x of\n                        Just x' -> case mapMaybeFail f xs of\n                                    Just xs' -> Just (x':xs')\n                                    Nothing -> Nothing\n                        Nothing -> Nothing\nmapMaybeFail f [] = Just []\n\nmaybeToBool :: Maybe a -> Bool\nmaybeToBool (Just _) = True\nmaybeToBool _        = False\n\nmaybeToObj  :: Maybe a -> a\nmaybeToObj (Just a) = a\nmaybeToObj _        = error \"Trying to extract object from a Nothing\"\n\nmaybeMap :: (a -> b) -> Maybe a -> Maybe b\nmaybeMap f (Just a) = Just (f a)\nmaybeMap f Nothing  = Nothing\n\n\njoinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a\njoinMaybe _ Nothing  Nothing  = Nothing\njoinMaybe _ (Just g) Nothing  = Just g\njoinMaybe _ Nothing  (Just g) = Just g\njoinMaybe f (Just g) (Just h) = Just (f g h)\n\ndata MaybeErr a err = Succeeded a | Failed err deriving (Eq,Show{-was:Text-})\n\n-- @mkClosure@ makes a closure, when given a comparison and iteration loop.\n-- Be careful, because if the functional always makes the object different,\n-- This will never terminate.\n\nmkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a\nmkClosure eq f = match . iterate f\n  where\n      match (a:b:c) | a `eq` b = a\n      match (_:c)              = match c\n\n-- fold-binary.\n-- It combines the element of the list argument in balanced mannerism.\n\nfoldb :: (a -> a -> a) -> [a] -> a\nfoldb f [] = error \"can't reduce an empty list using foldb\"\nfoldb f [x] = x\nfoldb f l  = foldb f (foldb' l)\n   where\n      foldb' (x:y:x':y':xs) = f (f x y) (f x' y') : foldb' xs\n      foldb' (x:y:xs) = f x y : foldb' xs\n      foldb' xs = xs\n\n-- Merge two ordered lists into one ordered list.\n\nmergeWith               :: (a -> a -> Bool) -> [a] -> [a] -> [a]\nmergeWith _ []     ys      = ys\nmergeWith _ xs     []      = xs\nmergeWith le (x:xs) (y:ys)\n       | x `le` y  = x : mergeWith le xs (y:ys)\n       | otherwise = y : mergeWith le (x:xs) ys\n\ninsertWith              :: (a -> a -> Bool) -> a -> [a] -> [a]\ninsertWith _ x []          = [x]\ninsertWith le x (y:ys)\n       | x `le` y     = x:y:ys\n       | otherwise    = y:insertWith le x ys\n\n-- Sorting is something almost every program needs, and this is the\n-- quickest sorting function I know of.\n\nsortWith :: (a -> a -> Bool) -> [a] -> [a]\nsortWith le [] = []\nsortWith le lst = foldb (mergeWith le) (splitList lst)\n  where\n      splitList (a1:a2:a3:a4:a5:xs) =\n               insertWith le a1\n              (insertWith le a2\n              (insertWith le a3\n              (insertWith le a4 [a5]))) : splitList xs\n      splitList [] = []\n      splitList (r:rs) = [foldr (insertWith le) [r] rs]\n\nsort :: (Ord a) => [a] -> [a]\nsort = sortWith (<=)\n\n-- Gofer-like stuff:\n\ncjustify, ljustify, rjustify :: Int -> String -> String\ncjustify n s = space halfm ++ s ++ space (m - halfm)\n               where m     = n - length s\n                     halfm = m `div` 2\nljustify n s = s ++ space (max 0 (n - length s))\nrjustify n s = space (max 0 (n - length s)) ++ s\n\nspace       :: Int -> String\nspace n      = copy n ' '\n\ncopy  :: Int -> a -> [a]      -- make list of n copies of x\ncopy n x = take n xs where xs = x:xs\n\ncombinePairs :: (Ord a) => [(a,b)] -> [(a,[b])]\ncombinePairs xs =\n        combine [ (a,[b]) | (a,b) <- sortWith (\\ (a,_) (b,_) -> a <= b) xs]\n where\n        combine [] = []\n        combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r)\n        combine (a:r) = a : combine r\n\nassocMaybe :: (Eq a) => [(a,b)] -> a -> Maybe b\nassocMaybe env k = case [ val | (key,val) <- env, k == key] of\n               [] -> Nothing\n               (val:vs) -> Just val\n\nassocMaybeErr :: (Eq a) => [(a,b)] -> a -> MaybeErr b String\nassocMaybeErr env k = case [ val | (key,val) <- env, k == key] of\n                       [] -> Failed \"assoc: \"\n                       (val:vs) -> Succeeded val\n\n\ndeSucc (Succeeded e) = e\n\nmapAccumL :: (a -> b -> (c,a)) -> a -> [b] -> ([c],a)\nmapAccumL f s [] = ([],s)\nmapAccumL f s (b:bs) = (c:cs,s'')\n        where\n                (c,s') = f s b\n                (cs,s'') = mapAccumL f s' bs\n\n\n\n-- Now some utilities involving arrays.\n-- Here is a version of @elem@ that uses partial application\n-- to optimise lookup.\n\narrElem :: (Ix a) => [a] -> a -> Bool\narrElem obj = \\x -> inRange size x && arr ! x\n  where\n      size = (maximum obj,minimum obj)\n      arr = listArray size [ i `elem` obj | i <- range size ]\n\n-- Here is the functional version of a multi-way conditional,\n-- again using arrays, of course. Remember @b@ can be a function !\n-- Note again the use of partiual application.\n\narrCond :: (Ix a)\n        => (a,a)                      -- the bounds\n        -> [(Assoc [a] b)]            -- the simple lookups\n        -> [(Assoc (a -> Bool) b)]    -- the functional lookups\n        -> b                          -- the default\n        -> a -> b                     -- the (functional) result\n\narrCond bds pairs fnPairs def = (!) arr'\n  where\n      arr' = array bds [ t =: head\n                      ([ r | (p, r) <- pairs, elem t p ] ++\n                       [ r | (f, r) <- fnPairs, f t ] ++\n                       [ def ])\n              | t <- range bds ]\n\nmemoise :: (Ix a) => (a,a) -> (a -> b) -> a -> b\nmemoise bds f = (!) arr\n  where arr = array bds [ t =: f t | t <- range bds ]\n\n-- Quite neat this. Formats text to fit in a column.\n\nformatText :: Int -> [String] -> [String]\nformatText n = map unwords . cutAt n []\n  where\n        cutAt :: Int -> [String] -> [String] -> [[String]]\n        cutAt m wds [] = [reverse wds]\n        cutAt m wds (wd:rest) = if len <= m || null wds\n                                then cutAt (m-(len+1)) (wd:wds) rest\n                                else reverse wds : cutAt n [] (wd:rest)\n          where len = length wd\n\n\n\n", "num_lines": 239}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n module Interp (runInterp) where\n\n import GenUtils\n import DataTypes\n import InterpUtils\n import Parser (pgnLexer)\n\n\n\n runInterp :: AbsGame -> RealGame\n runInterp (Game tags toks) = Game tags (pgnInterp toks initParState)\n\n\n\n initParState = (FirstBoard startBoard)\n\n type Par a = StoreBoard -> a\n thenP :: Par a -> (a -> Par b) -> Par b\n returnP :: a -> Par a\n\n returnP a = \\s -> a\n thenP m k s = case m s of\n                 r -> k r s\n                 \n failP a = \\s -> error a\n consP q rest = \\s -> q : pgnInterp rest s\n thenP' :: Par StoreBoard -> Par a -> Par a\n thenP' m k s = case m s of\n                 r -> k r \n newGameP :: Par a -> Par a\n newGameP m = \\ _ -> m initParState\n\n getCurrColour :: Par Colour\n getCurrColour = \n       getBoard                `thenP` \\ (Board _ (MoveNumber _ col) _) ->\n       returnP col\n\n checkColour :: MoveNumber -> Par ()\n checkColour (MoveNumber i col) =\n       getBoard                `thenP` \\ (Board _ (MoveNumber i' col') _) ->\n       if i == i' && col == col' \n       then returnP ()\n       else failP (\"number mis-match: \" \n               ++ userFormat (MoveNumber i col) \n               ++ \" (looking for \" \n               ++ userFormat (MoveNumber i' col') \n               ++ \")\\n\")\n\n\n\n data StoreBoard \n       = FirstBoard Board\n       | UndoableBoard Board {- new -} Board {- back one -}\n\n updateBoard :: Board -> Par StoreBoard\n updateBoard brd (FirstBoard old_brd) \n       = UndoableBoard brd old_brd\n updateBoard brd (UndoableBoard old_brd _) \n       = UndoableBoard brd old_brd\n\n getBoard :: Par Board\n getBoard s@(FirstBoard brd) \n       = brd\n getBoard s@(UndoableBoard brd _) \n       = brd\n\n undoBoard :: Par StoreBoard\n undoBoard (FirstBoard _) \n       = error \"Incorrect start to some analysis\"\n undoBoard (UndoableBoard _ old_brd)\n       = FirstBoard old_brd\n\n\n\n pgnInterp :: [Token] -> Par [Quantum]\n pgnInterp (IntToken n:PeriodToken:PeriodToken:PeriodToken:rest) =\n       checkColour (MoveNumber n Black)                `thenP` \\ () ->\n       pgnInterp rest\n pgnInterp (IntToken n:PeriodToken:rest) =\n       checkColour (MoveNumber n White)                `thenP` \\ () ->\n       pgnInterp rest\n\n pgnInterp (SymbolToken str:CommentToken (ann:rs):r)\n       | all (flip elem \"!?\") ann =\n       pgnInterp (SymbolToken str:pgnLexer ann ++ (CommentToken rs:r))\n\n\n\n\n pgnInterp (CommentToken (n:tag:rest):r)\n       | head tag == '(' && take 2 (reverse tag) == \":)\" && length rest > 1 =\n       getCurrColour                           `thenP` \\ col ->\n       let \n           invert Black r   = r -- because the move has *already* happend\n           invert _ \"0.00\"  = \"0.00\"   -- don't negate 0\n           invert _ ('-':r) = r\n           invert _ r       = '-':r\n       in \n       pgnInterp (LeftRBToken:map SymbolToken (take (length rest-1) rest)\n               ++ [CommentToken [\"Score:\",invert col n],RightRBToken] ++ r)\n\n\n pgnInterp (CommentToken []:rest) = pgnInterp rest\n pgnInterp (CommentToken comm:rest) =\n       consP (QuantumComment comm) rest\n pgnInterp (NAGToken nag:rest) =\n       consP (QuantumNAG nag) rest\n pgnInterp (NAGAnnToken nag _:rest) =\n       consP (QuantumNAG nag) rest\n pgnInterp (SymbolToken \"0-1\":rest) =\n       consP (QuantumResult \"0-1\") rest\n pgnInterp (SymbolToken \"1-0\":rest) =\n       consP (QuantumResult \"1-0\") rest\n pgnInterp (SymbolToken \"1/2-1/2\":rest) =\n       consP (QuantumResult \"1/2-1/2\") rest\n pgnInterp (AsterixToken:rest) =\n       consP (QuantumResult \"*\") rest\n pgnInterp (SymbolToken move:rest@(NAGAnnToken _ str:_)) =\n       getBoard                `thenP` \\ brd ->\n       parseMove move brd      `thenP` \\ (mv,ch,corrMv,new_brd) ->\n       updateBoard new_brd     `thenP'`\n       consP (QuantumMove mv ch str new_brd) rest\n pgnInterp (SymbolToken move:rest) =\n       getBoard                `thenP` \\ brd ->\n       parseMove move brd      `thenP` \\ (mv,ch,corrMv,new_brd) ->\n       updateBoard new_brd     `thenP'`\n       consP (QuantumMove mv ch \"\" new_brd) rest\n pgnInterp (LeftRBToken:rest) =\n       getAnalysis rest 0 []   `thenP` \\ (anal,rest) -> \n       (undoBoard              `thenP'`\n       pgnInterp anal)         `thenP` \\ anal' ->\n       consP (QuantumAnalysis anal') rest\n pgnInterp [] = returnP []\n pgnInterp toks = failP (\"when reading: \" \n               ++ unwords (map userFormat (take 10 toks)))\n\n\n\n getAnalysis (t@LeftRBToken:r) n anal = getAnalysis r (n+1) (t:anal)\n getAnalysis (t@RightRBToken:r) n anal \n       | n == (0 :: Int) = returnP (reverse anal,r)\n       | otherwise = getAnalysis r (n-1) (t:anal)\n getAnalysis (t:r) n anal = getAnalysis r n (t:anal)\n getAnalysis [] n anal = failP \"no closing ')'\"\n\n\n\n\n parseMove :: String -> Board -> Par (String,String,String,Board)\n parseMove move brd@(Board _ (MoveNumber _ col) _) = \n   case mapMaybeFail charToMoveTok move of\n    Nothing -> failP (\"strange move:\" ++ move)\n    Just mv_toks ->\n       let \n          (chs,mv_toks') = getChecks (reverse mv_toks)\n          (queen,mv_toks'') = getQueen mv_toks'\n       in \n       case parseAlgMove mv_toks'' queen brd of \n         (the_mv,new_brd) -> returnP (the_mv,chs,\"$$\",new_brd)\n\n\n\n parseAlgMove \n       :: [MoveTok]\n       -> Maybe Piece \n       -> Board \n       -> (String,Board)\n parseAlgMove [PartCastleTok,MoveToTok,PartCastleTok] Nothing\n               = findCastleKMove\n parseAlgMove [PartCastleTok,MoveToTok,PartCastleTok,\n                   MoveToTok,PartCastleTok] Nothing\n               = findCastleQMove\n\n parseAlgMove (PieceTok King:r) Nothing   = parsePieceMove r King \n parseAlgMove (PieceTok Queen:r) Nothing  = parsePieceMove r Queen \n parseAlgMove (PieceTok Rook:r) Nothing   = parsePieceMove r Rook \n parseAlgMove (PieceTok Knight:r) Nothing  = parsePieceMove r Knight \n parseAlgMove (PieceTok Bishop:r) Nothing  = parsePieceMove r Bishop \n\n\n\n parseAlgMove [FileTok sf,RankTok sr,MoveToTok,FileTok df,RankTok dr] q  =\n       findAPawnMove (extendBP (sf,sr)) (extendBP (df,dr)) q \n parseAlgMove [FileTok sf,RankTok sr,CaptureTok,FileTok df,RankTok dr] q  =\n       findAPawnMove (extendBP (sf,sr)) (extendBP (df,dr)) q \n\n\n\n parseAlgMove [FileTok sf,RankTok sr,FileTok df,RankTok dr] q = \\ brd -> \n   case lookupBoardPiece brd (sf,sr) of\n       Nothing -> error (\"cant find piece at: \" ++ userFormatBoardPos (sf,sr))\n       Just Pawn -> findAPawnMove (extendBP (sf,sr)) (extendBP (df,dr)) q brd\n       Just King | sf == 5 && df == 7 -> findCastleKMove brd\n       Just King | sf == 5 && df == 3 -> findCastleQMove brd\n       Just p -> findAMove p (extendBP (sf,sr)) (extendBP (df,dr)) brd\n\n -- later !\n\n\n\n parseAlgMove [FileTok df,RankTok dr] q =\n       findAPawnMove (Nothing,Nothing) (extendBP (df,dr)) q \n\n\n\n parseAlgMove [FileTok sf,CaptureTok,FileTok df,RankTok dr] q  =\n       findAPawnMove (Just sf,Nothing) (extendBP (df,dr)) q \n\n\n\n parseAlgMove [FileTok sf,FileTok df] q  =\n       findAPawnMove (Just sf,Nothing) (Just df,Nothing) q \n\n\n\n parseAlgMove [FileTok sf,CaptureTok,FileTok df] q  =\n       findAPawnMove (Just sf,Nothing) (Just df,Nothing) q \n parseAlgMove _ _ = error \"!>!\"\n\n\n\n parsePieceMove [FileTok df,RankTok dr] p\n       = findAMove p (Nothing,Nothing) (extendBP (df,dr)) \n\n\n\n parsePieceMove [CaptureTok,FileTok df,RankTok dr] p\n       = findAMove p (Nothing,Nothing) (extendBP (df,dr))\n\n\n\n parsePieceMove [RankTok sr,FileTok df,RankTok dr] p \n       = findAMove p (Nothing,Just sr) (extendBP (df,dr))\n parsePieceMove [RankTok sr,CaptureTok,FileTok df,RankTok dr] p\n       = findAMove p (Nothing,Just sr) (extendBP (df,dr))\n\n\n\n parsePieceMove [FileTok sf,FileTok df,RankTok dr] p \n       = findAMove p (Just sf,Nothing) (extendBP (df,dr))\n parsePieceMove [FileTok sf,CaptureTok,FileTok df,RankTok dr] p\n       = findAMove p (Just sf,Nothing) (extendBP (df,dr))\n\n\n\n parsePieceMove [FileTok sf,RankTok sr,MoveToTok,FileTok df,RankTok dr] p\n       = findAMove p (extendBP (sf,sr)) (extendBP (df,dr))\n parsePieceMove [FileTok sf,RankTok sr,CaptureTok,FileTok df,RankTok dr] p\n       = findAMove p (extendBP (sf,sr)) (extendBP (df,dr))\n parsePieceMove _ p = failP (\"syntax error in move:\")\n\n getChecks (CheckTok:CheckTok:r) = (\"#\",r)\n getChecks (CheckTok:r) = (\"+\",r)\n getChecks (MateTok:r)  = (\"#\",r)\n getChecks r            = (\"\",r)\n\n getQueen (PieceTok p:QueensWith:r) = (Just p,reverse r)\n getQueen r = (Nothing,reverse r)\n\n\n", "num_lines": 263}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n module InterpUtils where\n\n import GenUtils\n import DataTypes\n import Data.Array -- 1.3\n\n\n\n\n\n findCastleKMove brd = (castleK,makeACastleK brd)\n findCastleQMove brd = (castleQ,makeACastleQ brd)\n\n findAPawnMove\n       :: ExBoardPos \n       -> ExBoardPos \n       -> Maybe Piece \n       -> Board\n       -> (String,Board)\n\n\n\n\n\n findAPawnMove move_src move_dest queen brd@(Board arr mv _) \n       = debug (move_txt,new_brd)\n   where\n\n       move_colour = getMoveColour mv\n\n       debug   = {- trace (\n               {- userFormat brd ++ -}\n               userFormat (getMoveColour mv) ++ \n               -- \" (\" ++ userFormat absmove ++ \")\" ++\n               \"\\nALL   :\" ++ unwords (map userFormat all_moves) ++\n               \"\\n\") -} id \n\n\n\n\n       correct_src = concat (map (getAllMovesFor brd) currPieces)\n\n       currPieces  =\n               [ (Pawn,x,y) |\n                       (x,y) <- start_range,\n                       r <- [arr ! (x,y)],\n                       lookupSquare move_colour r == Friendly,\n                       (Just Pawn) <- [getSquarePiece r]]\n\n\n\n       start_range\n          = case (move_src,move_dest) of\n               ((Just f,Just r),_) -> [(f,r)]\n               ((Just f,_),_) -> [(f,r) | r <- [2..7]]\n               -- no capture !\n               (_,(Just f,_)) -> [(f,r) | r <- [2..7]]\n               _ -> error \"strange pawn move:\"\n\n       the_correct_move = if (length correct_move /= 1)\n                          then error (\"\\nAmbiguous move:\"\n               ++ show (unwords (map userFormat correct_move))\n               ++ \":\" ++ {- userFormat absmove ++ -} \"\\n\"\n               ++ userFormat brd)\n               else head correct_move\n\n       correct_move = \n               filter (sameQueening queen.extractSpecialFromPlayMove)\n               (filter (compExBPandBP move_dest.extractDestFromPlayMove)\n                       correct_src)\n       sameQueening (Just p) (Queening p') = p == p'\n       sameQueening Nothing  (Queening p') = Queen == p'\n       sameQueening _ _ = True\n\n       move_txt = createShortMove the_correct_move \"\" brd\n       corr_txt = \n           userFormatBoardPos \n               (extractSrcFromPlayMove the_correct_move) ++\n           userFormatBoardPos\n               (extractDestFromPlayMove the_correct_move) \n               {- queening ?? -}\n       new_brd = makeAMove brd the_correct_move\n\n\n\n\n\n findAMove\n       :: Piece\n       -> ExBoardPos \n       -> ExBoardPos \n       -> Board\n       -> (String,Board)\n\n findAMove move_piece move_src move_dest brd@(Board arr mv _) \n       = debug (move_txt,new_brd)\n   where\n\n\n\n       move_colour = getMoveColour mv\n\n       debug   = {- trace (\n               {- userFormat brd ++ -}\n               userFormat (getMoveColour mv) ++ \n               \" (\" ++ {- userFormat absmove ++ -} \")\" ++\n               \"\\nALL   :\" ++ unwords (map userFormat all_moves) ++\n               \"\\nDEST  :\" ++ unwords (map userFormat correct_dest) ++\n               \"\\nSRC   :\" ++ unwords (map userFormat correct_move) ++\n               \"\\n\") -} id \n               \n\n\n\n\n       all_moves = allValidMoves brd move_piece (const True)\n\n\n\n       correct_dest = filter\n               (compExBPandBP move_dest.extractDestFromPlayMove)\n                       all_moves\n       correct_move = filter\n               (compExBPandBP move_src.extractSrcFromPlayMove)\n                       correct_dest\n       the_correct_move = if (length correct_move /= 1)\n                          then error (\"\\nAmbiguous move:\"\n               ++ show (unwords (map userFormat correct_move))\n               ++ \":\" {- ++ userFormat absmove -} ++ \"\\n\"\n               ++ userFormat brd)\n               else head correct_move\n       disamb = case move_dest of\n                 (Just _,Nothing) -> \"\"        -- fg => fxg4, no disambig.\n                 _ -> disAmb\n                    (extractSrcFromPlayMove the_correct_move)\n                    (map (extractSrcFromPlayMove) correct_dest)\n\n       move_txt = createShortMove the_correct_move disamb brd\n       corr_txt = \n           userFormatBoardPos \n               (extractSrcFromPlayMove the_correct_move) ++\n           userFormatBoardPos\n               (extractDestFromPlayMove the_correct_move) \n               {- queening -}\n       new_brd = makeAMove brd the_correct_move\n --partain: findAMove _ _ _ brd = error (\"strange move: \")\n\n allValidMoves :: Board -> Piece -> (ChessFile -> Bool) -> [PlayMove]\n allValidMoves brd piece corr_file\n   = concat (map (getAllMovesFor brd) (getCurrPieces brd piece corr_file)) \n\n getCurrPieces \n       :: Board \n       -> Piece \n       -> (ChessFile -> Bool)\n       -> [(Piece,ChessFile,ChessRank)]\n getCurrPieces (Board arr (MoveNumber _ col) _) pc corr_file =\n       [ (p,x,y) |\n               ((x,y), r) <- assocs arr,\n               lookupSquare col r == Friendly,\n               (Just p) <- [getSquarePiece r],\n               p == pc,\n               corr_file x\n                ]\n\n\n\n\n\n\n getAllMovesFor :: Board -> (Piece,Int,Int) -> [PlayMove]\n\n\n\n getAllMovesFor brd (Rook,x,y) = \n       [ mkPlayMove Rook (x,y) (x',y')\n         | (x',y') <- (\n               movePiece 0    1 brd x y ++\n               movePiece 0 (-1) brd x y ++\n               movePiece 1    0 brd x y ++\n               movePiece (-1) 0 brd x y) ]\n getAllMovesFor brd (Bishop,x,y) = \n       [ mkPlayMove Bishop (x,y) (x',y')\n         | (x',y') <- (\n               movePiece 1      1  brd x y ++\n               movePiece 1    (-1) brd x y ++\n               movePiece (-1)   1  brd x y ++\n               movePiece (-1) (-1) brd x y) ]\n getAllMovesFor brd (Queen,x,y) = \n       [ mkPlayMove Queen (x,y) (x',y')\n         | (x',y') <- (\n               movePiece 0    1    brd x y ++\n               movePiece 0 (-1)    brd x y ++\n               movePiece 1    0    brd x y ++\n               movePiece (-1) 0    brd x y ++\n               movePiece 1      1  brd x y ++\n               movePiece 1    (-1) brd x y ++\n               movePiece (-1)   1  brd x y ++\n               movePiece (-1) (-1) brd x y) ]\n\n\n\n getAllMovesFor brd (Knight,x,y) =\n       [ mkPlayMove Knight (x,y) (x',y')\n           | (xd,yd) <- concat \n                       [ [(d1,d2 * 2),(d1 * 2,d2)]\n                               | d1 <- [1,-1], d2 <- [1,-1]],\n               x' <- [xd + x],\n               y' <- [yd + y],\n               case lookupBoard brd (x',y') of\n                 Vacant -> True\n                 Friendly -> False\n                 Baddy -> True\n                 OffBoard -> False]\n\n getAllMovesFor brd (King,x,y) =\n       [ mkPlayMove King (x,y) (x',y')\n           | (xd,yd) <- [(1,1),(1,0),(1,-1),(0,1),\n                         (0,-1),(-1,1),(-1,0),(-1,-1)],\n               x' <- [xd + x],\n               y' <- [yd + y],\n               case lookupBoard brd (x',y') of\n                 Vacant -> True\n                 Friendly -> False\n                 Baddy -> True\n                 OffBoard -> False]\n\n\n\n\n getAllMovesFor brd@(Board _ (MoveNumber _ col) may_ep) (Pawn,x,y) \n       = real_pawn_moves\n   where\n       pawn_moves = \n               case lookupBoard brd (x,y+del) of\n                 Friendly -> []\n                 Baddy -> []\n                 Vacant -> (mkPlayMove Pawn (x,y) (x,y+del) :\n                    if y /= sta then [] else\n                    case lookupBoard brd (x,y+del*2) of\n                       Friendly -> []\n                       Baddy -> []\n                       Vacant -> \n                         [ PlayMove Pawn (x,y) (x,y+del*2) BigPawnMove])\n       left_pc = case lookupBoard brd (x-1,y+del) of\n                        Baddy -> [mkPlayMove Pawn (x,y) (x-1,y+del) ]\n                        _ -> []\n       right_pc = case lookupBoard brd (x+1,y+del) of\n                        Baddy -> [mkPlayMove Pawn (x,y) (x+1,y+del) ]\n                        _ -> []\n       all_pawn_moves = pawn_moves ++ left_pc ++ right_pc \n       real_pawn_moves = en_passant ++\n               (if y + del == qn       -- if can queens\n               then concat [ let fn = PlayMove Pawn f t . Queening\n                             in\n                               [ fn Queen,\n                                 fn Rook,\n                                 fn Bishop,\n                                 fn Knight ]\n                               | PlayMove _ f t _ <- all_pawn_moves ]\n                 else all_pawn_moves)\n       en_passant = \n           case (y == ep,may_ep) of\n               (True,Just f) | f == x+1 || f == x-1 \n                 -> [PlayMove Pawn (x,y) (f,y+del) EnPassant]\n               _ -> []\n       del,sta,qn,ep :: Int\n       (del,sta,qn,ep) -- delta (direction), start, Queening and E.P. Rank\n           = case col of\n               White -> (1,2,8,5)\n               Black -> (-1,7,1,4)\n\n movePiece xd yd brd x y = \n       case lookupBoard brd (x',y') of\n         OffBoard -> []\n         Friendly -> []\n         Baddy    -> [(x',y')]\n         Vacant   ->  (x',y') : movePiece xd yd brd x' y'\n       where\n           x' = x + xd\n           y' = y + yd \n\n\n\n\n makeAMove :: Board -> PlayMove -> Board\n makeAMove board@(Board brd mv@(MoveNumber _ col) _)\n       move@(PlayMove piece pos pos' NothingSpecial)  =\n       Board (brd //  [ pos =: VacantSq,\n                       pos' =: mkColBoardSq col piece ])\n                       (incMove mv) Nothing\n makeAMove board@(Board brd mv@(MoveNumber _ col) _)\n       move@(PlayMove piece pos@(f,_) pos' BigPawnMove)  =\n       Board (brd //  [ pos =: VacantSq,\n                       pos' =: mkColBoardSq col piece ])\n                       (incMove mv) (Just f)\n makeAMove board@(Board brd mv@(MoveNumber _ col) _)\n       move@(PlayMove piece pos@(f,_) pos' (Queening q))  =\n       Board (brd //  [ pos =: VacantSq,\n                       pos' =: mkColBoardSq col q])\n                       (incMove mv) (Just f)\n makeAMove board@(Board brd mv@(MoveNumber _ col) _)   -- ASSERT ?\n       move@(PlayMove piece (f,_) (f',_) EnPassant) =\n       Board (brd // [ (f,st) =: VacantSq,\n                       (f',fn) =: mkColBoardSq col Pawn,\n                       (f',st) =: VacantSq ])\n                       (incMove mv) Nothing\n   where (st,fn) = case col of\n                     White -> (5,6)\n                     Black -> (4,3)\n\n makeACastleK (Board brd mv@(MoveNumber _ White) _) =\n       Board (brd //\n             [ (5,1) =: VacantSq,\n               (6,1) =: mkColBoardSq White Rook,\n               (7,1) =: mkColBoardSq White King,\n               (8,1) =: VacantSq ]) (incMove mv) Nothing\n makeACastleK (Board brd mv@(MoveNumber _ Black) _) =\n\n       Board (brd //\n             [ (5,8) =: VacantSq,\n               (6,8) =: mkColBoardSq Black Rook,\n               (7,8) =: mkColBoardSq Black King,\n               (8,8) =: VacantSq ]) (incMove mv) Nothing\n makeACastleQ (Board brd mv@(MoveNumber _ White) _) =\n       Board (brd //\n             [ (5,1) =: VacantSq,\n               (4,1) =: mkColBoardSq White Rook,\n               (3,1) =: mkColBoardSq White King,\n               (1,1) =: VacantSq ]) (incMove mv) Nothing\n makeACastleQ (Board brd mv@(MoveNumber _ Black) _) =\n       Board (brd //\n             [ (5,8) =: VacantSq,\n               (4,8) =: mkColBoardSq Black Rook,\n               (3,8) =: mkColBoardSq Black King,\n               (1,8) =: VacantSq ]) (incMove mv) Nothing\n\n disAmb _ [_] = \"\"\n disAmb (a,b) t@[(n,m),(x,y)] \n       | n == x    = userFormatRank b\n       | otherwise = userFormatFile a\n disAmb src lst = error (\"PANIC: cant disambiguate: \" ++ show src ++ show lst)\n\n createShortMove :: PlayMove -> String -> Board -> String\n createShortMove (PlayMove Pawn (f,r) dest q) \"\" brd = \n       (if lookupBoard brd dest == Baddy || EnPassant == q\n        then userFormatFile f ++ \"x\" ++ userFormatBoardPos dest\n        else userFormatBoardPos dest) ++\n       case q of\n         Queening p -> \"=\" ++ userFormat p\n         _ -> \"\"\n createShortMove (PlayMove p _ dest _) extra brd =\n       userFormat p ++ extra ++ capt ++ userFormatBoardPos dest\n   where\n       capt = if lookupBoard brd dest == Baddy\n              then \"x\"\n              else \"\"\n\n getEPStart :: Colour -> ChessFile\n getEPStart White = 5\n getEPStart Black = 4\n\n getEPEnd :: Colour -> ChessFile\n getEPEnd White = 6\n getEPEnd Black = 3\n\n getHomeRank :: Colour -> ChessRank\n getHomeRank White = 1\n getHomeRank Black = 8\n\n", "num_lines": 372}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n module Main (main) where\n\n import GenUtils\n import DataTypes\n import Parser\n import Interp\n import PrintTEX\n\n import System.Environment -- 1.3 (partain)\n import Data.Char -- 1.3\n\n --fakeArgs = \"game001.txt\"\n --fakeArgs = \"pca2.pgn\"\n --fakeArgs = \"silly.pgn\"\n --fakeArgs = \"small.pgn\"\n --fakeArgs = \"sicil.pgn\"\n --fakeArgs = \"badgame.pgn\"\n --fakeArgs = \"mycgames.pgn\"\n fakeArgs = \"rab.pgn\"\n\n version = \"0.3\"\n\n\n main = do\n       [test_dir] <- getArgs\n       let (style,fn,filename) = interpArgs (words \"-d tex mygames.pgn\")\n       file <- readFile (test_dir ++ \"/\" ++filename)\n       std_in <- getContents\n       let games = pgnParser fn file   -- parse relevant pgn games\n       putStr (prog style std_in games)\n\n{- OLD 1.2:\n main = \n       getArgs         abort                           $ \\ args ->\n       --let args = (words \"-d tex analgames.pgn\") in\n       let (style,fn,filename) = interpArgs args in\n       readFile filename abort                         $ \\ file ->\n       readChan stdin abort                            $ \\ std_in ->\n       let games = pgnParser fn file   -- parse relevant pgn games\n       in\n       appendChan stdout (prog style std_in games) abort done\n-}\n\n interpArgs :: [String] -> (OutputStyle,Int -> Bool,String)\n --interpArgs [] = (ViewGame,const True,fakeArgs)\n interpArgs [] = interpArgs (words \"-d pgn analgames.pgn\")\n interpArgs files = interpArgs' OutputPGN (const True) files\n\n interpArgs' style fn (\"-d\":\"pgn\":xs)    = interpArgs' OutputPGN    fn xs\n interpArgs' style fn (\"-d\":\"rawpgn\":xs) = interpArgs' OutputRawPGN fn xs\n interpArgs' style fn (\"-d\":\"play\":xs)   = interpArgs' ViewGame     fn xs\n interpArgs' style fn (\"-d\":\"parser\":xs) = interpArgs' OutputParser fn xs\n interpArgs' style fn (\"-d\":\"tex\":xs)    = interpArgs' OutputTEX    fn xs\n interpArgs' style fn (\"-d\":\"head\":xs)   = interpArgs' OutputHeader fn xs\n interpArgs' style fn (\"-g\":range:xs) \n       = interpArgs' style (changeFn (parse range)) xs\n    where\n       changeFn (Digit n:Line:Digit m:r) x = moreChangeFn r x || x >= n && x <= m \n       changeFn (Line:Digit m:r) x = moreChangeFn r x || x <= m \n       changeFn (Digit n:Line:r) x = moreChangeFn r x || x >= n \n       changeFn (Digit n:r) x = moreChangeFn r x || x == n\n       changeFn _ _ = rangeError\n       moreChangeFn [] = const False\n       moreChangeFn (Comma:r) = changeFn r\n       moreChangeFn _ = rangeError\n       parse xs@(n:_) \n               | isDigit n = case span isDigit xs of\n                               (dig,rest) -> Digit (read dig) : parse rest\n       parse ('-':r) = Line : parse r\n       parse (',':r) = Comma : parse r\n       parse [] = []\n       parse _ = rangeError\n       rangeError = error (\"incorrect -g option (\" ++ range ++ \")\\n\")\n\n interpArgs' style fn [file] = (style,fn,file)\n interpArgs' style fn args = error (\"bad args: \" ++ unwords args)\n\n data Tok \n       = Digit Int             -- n\n       | Line                  -- -\n       | Comma                 -- ,\n\n data OutputStyle\n\n       = OutputPGN             -- pgn\n       | OutputRawPGN          -- rawpgn\n       | OutputHeader          -- header\n       | ViewGame              -- play\n       | ViewGameEmacs         -- emacs\n       | TwoColumn             -- 2col\n       | TestGames             -- test\n       | OutputTEX\n\n\n\n       | OutputParser  -- simply dump out the string read in.\n       | CmpGen        -- cmp 2nd and 3rd generations of output \n\n\n\n prog  :: OutputStyle          -- style of action\n       -> String               -- stdin (for interactive bits)\n       -> [AbsGame]            -- input games\n       -> String               -- result\n prog OutputPGN _\n               = pgnPrinter True       -- print out game(s)\n               . map runInterp         -- interprete all games\n prog OutputRawPGN _\n               = pgnPrinter False      -- print out game(s)\n               . map runInterp         -- interprete all games\n prog OutputHeader _\n               = pgnHeadPrinter        -- print out game(s) headers\n               . map runInterp         -- interprete all games\n prog OutputTEX _\n               = texPrinter            -- print out game(s)\n               . map runInterp         -- interprete all games\n prog ViewGame std_in\n               = interactViewer std_in -- print out game(s)\n               . runInterp             -- interprete the game\n               . head                  -- should check for only *one* object\n prog OutputParser _ \n               = userFormat\n\n\n\n\n\n\n\n\n\n type PrintState = (Bool,MoveNumber) \n\n pgnPrinter :: Bool -> [RealGame] -> String\n pgnPrinter detail = unlines . concat . map printGame\n   where\n       printMoveNumber :: Bool -> MoveNumber -> String\n       printMoveNumber False (MoveNumber _ Black) = \"\"\n       printMoveNumber _     mvnum = userFormat mvnum ++ \" \"\n\n       printQuantums :: PrintState -> [Quantum] -> [String]\n       printQuantums ps = concat . fst . mapAccumL printQuantum ps\n\n       printQuantum :: PrintState -> Quantum -> ([String],PrintState)\n       printQuantum (pnt,mv) (QuantumMove move ch an brd) =\n               ([printMoveNumber pnt mv ++ move ++ ch],(False,incMove mv))\n       printQuantum (pnt,mv) (QuantumNAG i) = \n               if detail\n               then ([\"$\" ++ show i],(False,mv))\n               else ([],(False,mv))\n       printQuantum (pnt,mv) (QuantumComment comms) = \n               if detail\n               then (\"{\" : comms ++ [\"}\"],(True,mv))\n               else ([],(False,mv))\n       printQuantum (pnt,mv) (QuantumAnalysis anal) = \n               if detail\n               then (\"(\" : printQuantums (True,decMove mv) anal ++ [\")\"],\n                       (True,mv))\n               else ([],(False,mv))\n       printQuantum (pnt,mv) (QuantumResult str) = ([str],(True,mv))\n       printQuantum _ _ = error \"PANIC: strange Quantum\"\n\n       printGame :: RealGame -> [String]\n       printGame (Game tags qu) = \n               [ userFormat tag | tag <- tags] ++\n               formatText 75 (printQuantums (False,initMoveNumber) qu)\n\n\n\n printHeadGame :: RealGame -> [String]\n printHeadGame (Game tags qu) = [\n       rjustify 4 gameno ++ \" \" ++\n       take 20 (rjustify 20 white) ++ \" - \" ++ \n       take 20 (ljustify 20 black) ++ \" \" ++ \n       take 26 (ljustify 28 site) ++ \" \" ++ result ]\n   where\n       (date,site,game_no,res,white,black,opening) = getHeaderInfo tags\n       gameno = case game_no of\n                 Nothing -> \"\"\n                 Just n -> show n\n       result = userFormat res\n\n pgnHeadPrinter :: [RealGame] -> String\n pgnHeadPrinter = unlines . concat . map printHeadGame\n\n\n\n\n\n interactViewer :: String -> RealGame -> String\n interactViewer stdin (Game tags qu) = replayQ qu (lines stdin)\n\n replayQ (QuantumMove _ _ _ brd:rest) std_in \n       = \"\\027[H\" ++ userFormat brd ++ waitQ rest std_in\n replayQ (_:rest) std_in = replayQ rest std_in\n replayQ [] _ = []\n\n waitQ game std_in = \">>\" ++ \n    (case std_in of\n       [] -> \"\"\n       (q:qs) -> replayQ game qs)\n\n\n", "num_lines": 205}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n module Parser (pgnLexer,pgnParser) where\n\n import GenUtils\n import DataTypes\n import Data.Char -- 1.3\n\n\n\n pgnLexer :: String -> [Token]\n pgnLexer ('.':r) = PeriodToken  : pgnLexer r\n pgnLexer ('*':r) = AsterixToken : pgnLexer r\n pgnLexer ('[':r) = LeftSBToken  : pgnLexer r\n pgnLexer (']':r) = RightSBToken : pgnLexer r\n pgnLexer ('(':r) = LeftRBToken  : pgnLexer r\n pgnLexer (')':r) = RightRBToken : pgnLexer r\n pgnLexer ('<':r) = LeftABToken  : pgnLexer r\n pgnLexer ('>':r) = RightABToken : pgnLexer r\n pgnLexer ('\"':r) = readString r \"\"\n pgnLexer ('{':r) = readComment r \"\"\n pgnLexer ('$':r) = readNAG r \"\"\n pgnLexer ('!':'?':r) = mkNAGToken 5 : pgnLexer r\n pgnLexer ('!':'!':r) = mkNAGToken 3 : pgnLexer r\n pgnLexer ('!':r)     = mkNAGToken 1 : pgnLexer r\n pgnLexer ('?':'?':r) = mkNAGToken 4 : pgnLexer r\n pgnLexer ('?':'!':r) = mkNAGToken 6 : pgnLexer r\n pgnLexer ('?':r)     = mkNAGToken 2 : pgnLexer r\n pgnLexer ('%':r) = pgnLexer (dropWhile (/= '\\n') r)\n pgnLexer (c:r)\n       | isSpace c = pgnLexer r\n       | isAlpha c || isDigit c = pgnSymbolLexer r [c]\n       | otherwise = error (\"Error lexing: \" ++ takeWhile (/= '\\n') (c:r))\n pgnLexer [] = []\n\n pgnSymbolLexer (c:r) sym \n       | isAlpha c \n       || isDigit c \n       || elem c \"_+#=:-/\" = pgnSymbolLexer r (c:sym)\n pgnSymbolLexer r sym \n       | all isDigit sym = IntToken (read (reverse sym)) : pgnLexer r\n pgnSymbolLexer r sym   = SymbolToken (reverse sym) : pgnLexer r\n\n readString ('\\\\':'\\\\':r) str = readString r ('\\\\':str)\n readString ('\\\\':'\"':r) str = readString r ('\"':str)\n readString ('\"':r) str     = StringToken (reverse str) : pgnLexer r\n readString (c:r) str       = readString r (c:str)\n\n readComment ('}':r) str = CommentToken (revwords str []) : pgnLexer r\n readComment (c:r) str = readComment r (c:str)\n\n revwords (c:r) wds\n    | isSpace c = revwords r wds\n    | otherwise = revwords' r [c] wds\n revwords [] wds = wds\n revwords' (c:r) wd wds \n    | isSpace c = revwords r (wd:wds)\n    | otherwise = revwords' r (c:wd) wds\n revwords' [] wd wds = wd : wds\n\n readNAG (c:r) str\n       | isDigit c = readNAG r (c:str)\n readNAG r str = mkNAGToken (read (reverse str)) : pgnLexer r\n\n mkNAGToken 1 = NAGAnnToken 1 \"!\" \n mkNAGToken 2 = NAGAnnToken 2 \"?\" \n mkNAGToken 3 = NAGAnnToken 3 \"!!\"\n mkNAGToken 4 = NAGAnnToken 4 \"??\"\n mkNAGToken 5 = NAGAnnToken 5 \"!?\"\n mkNAGToken 6 = NAGAnnToken 6 \"?!\"\n mkNAGToken n = NAGToken n\n\n\n\n\n pgnParser :: (Int -> Bool) -> String -> [AbsGame]\n pgnParser fn str = \n       [ game | (no,game) <- zip [1..] (parseTags (pgnLexer str) id),\n                fn no]\n\n type FL a = [a] -> [a]\n\n parseTags :: [Token] -> FL TagStr -> [AbsGame]\n parseTags (LeftSBToken:SymbolToken sym:StringToken str:RightSBToken:rest) \n           other_tags = parseTags rest (other_tags . ((:) (TagStr sym str)))\n parseTags toks@(LeftSBToken:_) _\n       = error (\"BAD Token:\" ++ unwords (map userFormat (take 10 toks)))\n parseTags toks tags = parseToks toks id tags\n\n parseToks :: [Token] \n       -> FL Token \n       -> FL TagStr\n       -> [AbsGame]\n parseToks next@(LeftSBToken:_)     = \\ toks tags ->\n       Game (tags []) (toks []) : parseTags next id\n parseToks (tk:r)                    = pushToken tk r \n parseToks [] = \\ toks tags -> [Game (tags []) (toks [])]\n\n pushToken tok r toks = parseToks r (toks . ((:) tok))\n", "num_lines": 99}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n module PrintTEX (texPrinter) where\n\n import GenUtils\n import DataTypes\n import Data.Array -- 1.3\n import Data.Char -- 1.3\n\n\n\n\n\n\n\n splitUpQuantum :: [Quantum] -> [[Quantum]]\n splitUpQuantum q = splitUpQuantums q []\n   where\n       splitUpQuantums [] [] = []\n       splitUpQuantums [] mvs = [reverse mvs]\n       splitUpQuantums (mv@(QuantumMove _ _ _ _):rest) mvs\n               = splitUpQuantums rest (mv:mvs)\n       splitUpQuantums (mv@(QuantumNAG _):rest) mvs\n               = splitUpQuantums rest mvs\n       splitUpQuantums (x:xs) [] = [x] : splitUpQuantums xs []\n       splitUpQuantums (x:xs) mvs \n               = [reverse mvs,[x]] ++ splitUpQuantums xs []\n\n type TeXState = \n       (Bool,          -- if Top level !\n       Board,          -- current board\n       MoveNumber)     -- the Current Move Number\n\n printTeXQuantums :: TeXState -> [Quantum] -> [String]\n printTeXQuantums ps\n       = concat . fst . mapAccumL printTeXQuantum ps . splitUpQuantum\n\n printTeXQuantum :: TeXState -> [Quantum] -> ([String],TeXState)\n printTeXQuantum state@(_,board,_) [QuantumComment [\"\\004\"]] = \n       (mkTeXBoard board,state)\n printTeXQuantum state@(_,board,_) [QuantumComment (('\\004':comm):comms)] = \n       (mkTeXBoard board ++ formatText 70 (parseSquiggles (comm:comms)),state)\n printTeXQuantum state [QuantumComment comms] = \n       (formatText 70 (parseSquiggles comms),state)\n printTeXQuantum (pnt,brd,mv) [QuantumAnalysis anal] =\n       (printTeXQuantums (False,err,decMove mv) anal,(pnt,brd,mv))\n   where err = error \"Syntax error using ^D\"\n printTeXQuantum state@(_,board,_) [QuantumResult str] = \n       (mkTeXBoard board ++ [printTeXResult (mkResult str)],state)\n printTeXQuantum state mvs@(QuantumMove _ _ _ _:_) =\n       printTeXMoves state mvs\n printTeXQuantum _ _ = error \"PANIC: strange Quantum\"\n\n\n parseSquiggles = map parseSquiggle\n parseSquiggle ('<':'s':'a':'w':'>':r) = \"\\\\wbetter{}\" ++ r\n parseSquiggle ('<':'a':'w':'>':r)     = \"\\\\wupperhand{}\" ++ r\n parseSquiggle ('<':'w':'a':'w':'>':r) = \"\\\\wdecisive{}\" ++ r\n parseSquiggle ('<':'s':'a':'b':'>':r) = \"\\\\bbetter{}\" ++ r\n parseSquiggle ('<':'a':'b':'>':r)     = \"\\\\bupperhand{}\" ++ r\n parseSquiggle ('<':'w':'a':'b':'>':r) = \"\\\\bdecisive{}\" ++ r\n parseSquiggle wd = wd\n\n\n printTeXResult :: Result -> String\n printTeXResult Win     = \"$1\\\\!-\\\\!0$\"\n printTeXResult Loss    = \"$0\\\\!-\\\\!1$\"\n printTeXResult Draw    = \"${1 \\\\over 2}\\\\!-\\\\!{1 \\\\over 2}$\"\n printTeXResult Unknown = \"$*$\"\n\n printTeXMoves (tl,_,mv) mvs \n       = ([text],(True,brd,incMove last_mv_num))\n    where\n       aux_mvs = zip3 mvs (iterate incMove mv) (False:repeat True)\n\n       (QuantumMove _ _ _ brd,last_mv_num,_) = last aux_mvs\n       text = initText tl\n           ++ concat (fst (mapAccumL (pntMove tl) (mv,False) mvs))\n           ++ endText tl \n\n       initText False = \n            case mv of\n               MoveNumber i Black -> \"|\" ++ show i ++ \"\\\\ldots~\"\n               _ -> \"|\"\n       initText True = \n               \"\\\\begin{center}|\\n\" ++\n               \"{\\\\bf\" ++\n               \"\\\\begin{tabular}{rp{50pt}p{50pt}}\\n\" ++\n            case mv of\n               MoveNumber i Black -> show i ++ \" & \\\\ldots\"\n               _ -> \"\"\n\n       endText True = case getMoveColour last_mv_num of\n               White -> \"&\\\\\\\\\\n\\\\end{tabular}}|\\n\\\\end{center}\"\n               Black -> \"\\\\end{tabular}}|\\n\\\\end{center}\"\n       endText False =  \"|\"\n\n\n\n       pntMove True (mv@(MoveNumber i White),bl) move\n               = (show i ++ \" & \" \n               ++ printableMove move,\n                 (incMove mv,True))\n       pntMove True (mv@(MoveNumber i Black),bl) move\n               = (\" & \" ++ printableMove move ++ \"\\\\\\\\\\n\",\n                 (incMove mv,True))\n       pntMove False (mv@(MoveNumber i White),bl) move\n               = ((if bl then \"; \" else \"\") ++ show i ++ \".~\"\n                       ++ printableMove move,\n                 (incMove mv,True))\n       pntMove False (mv@(MoveNumber i Black),bl) move\n               = ((if bl then \", \" else \"\") ++ printableMove move,\n                 (incMove mv,True))\n\n printableMove :: Quantum -> String\n printableMove (QuantumMove move ch an _) = map fn move ++ rest\n    where\n       fn 'x' = '*'\n       fn 'O' = '0'\n       fn c   = c\n       rest = case ch of\n               \"#\" -> an ++ \" mate\"\n               _   -> ch ++ an\n\n mkTeXBoard :: Board -> [String]\n mkTeXBoard (Board arr _ _) = \n       [\"\\n\\\\board\"] ++\n       [\"{\" ++ [ fn ((x-y) `rem` 2 == 0) (arr ! (x,y)) | x <- [1..8]] ++ \"}\" \n                       | y <- reverse [1..8]] ++\n       [\"$$\\\\showboard$$\"]\n  where\n       fn _ (WhitesSq p) = head (userFormat p)\n       fn _ (BlacksSq p) = toLower (head (userFormat p))\n       fn True VacantSq = '*'\n       fn False VacantSq = ' '\n\n printTeXGame :: RealGame -> [String]\n printTeXGame (Game tags qu) = [\n       \"\\\\clearpage\",\n       \"\\\\begin{center}\",\n       \"\\\\fbox{\\\\fbox{\\\\large\\\\begin{tabular}{l}\",\n       (\"Game \" ++ gameno ++ \" \\\\hspace{.3 in} \" \n               ++ date \n               ++ \" \\\\hspace{.3 in} \" \n               ++ result \n               ++ \"\\\\\\\\\"),\n       \"\\\\hline\" ++ (if null opening then \"\" else \"\\n\" ++ opening ++ \"\\\\\\\\\"),\n       \"\\\\raisebox{2.5pt}[11pt]{\\\\framebox[11pt]{\\\\rule{0pt}{4.25pt}}} \"\n               ++ white ++ \"\\\\\\\\\",\n       \"\\\\rule[-1pt]{11pt}{11pt} \"++ black ++ \"\\\\\\\\\",\n       site,\n       \"\\\\end{tabular}}}\",\n       \"\\\\end{center}\"] ++\n       (printTeXQuantums (True,startBoard,initMoveNumber) qu)\n   where\n       (date,site,game_no,res,white,black,opening) = getHeaderInfo tags\n       gameno = case game_no of\n                 Nothing -> \"\"\n                 Just n -> show n\n       result = printTeXResult res\n\n texPrinter :: [RealGame] -> String\n texPrinter games = \n          texHeader \n       ++ (unlines(concat(map printTeXGame games)))\n       ++ texFooter\n\n texHeader =\n       \"\\\\documentstyle[twocolumn,a4wide,chess]{article}\\n\" ++\n       \"\\\\textwidth 7.0 in\\n\" ++\n       \"\\\\textheight 63\\\\baselineskip\\n\" ++\n       \"\\\\columnsep .4 in\\n\" ++\n       \"\\\\columnseprule .5 pt\\n\" ++\n       \"\\\\topmargin -0.5 in\\n\" ++\n       \"\\\\headheight 0 pt\\n\" ++\n       \"\\\\headsep 0 pt\\n\" ++\n       \"\\\\oddsidemargin -0.3 in\\n\" ++\n       \"\\\\font\\\\sc=cmcsc10\\n\\\\pagestyle{empty}\\n\" ++\n       \"\\\\begin{document}\\n\\\\thispagestyle{empty}\\n\\n\"\n\n texFooter = \"\\n\\\\end{document}\\n\"\n\n\n", "num_lines": 183}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Basic where\nimport TypesettingTricks\n--import Int( Num(fromInt) )\nimport Physical\n--import GHC( (->) )\ninfixr 7 |>\nclass Signal s where\n  mapSignal:: (Physical a, Physical b) => (s a b) -> a -> b\n  mapSigList:: (Physical a, Physical b) => (s a b) -> [a] -> [b]\n  toSig:: (Physical a, Physical b) => (s a b) -> SignalRep a b\n  mapSignal = mapSignal . toSig\n  mapSigList = map . mapSignal\n  toSig = FunctionRep . mapSignal\ninstance Signal (->) where\n  mapSignal f = f\n  toSig = FunctionRep\ndata {- (Physical a, Physical b) => -} SignalRep a b =\n   FunctionRep (a -> b) |\n   PieceContRep (PieceCont a b)\n\ninstance Eq (SignalRep a b) where\n  (==) a b = error \"No equality for SignalRep\"\n\ninstance Show (SignalRep a b) where\n  show sr = error \"No show for SignalRep\"\n\ninstance Signal SignalRep where\n  mapSignal (FunctionRep f) = mapSignal f\n  mapSignal (PieceContRep f) = mapSignal f\n  mapSigList (FunctionRep f) = mapSigList f\n  mapSigList (PieceContRep f) = mapSigList f\n  toSig = id\ninstance (Physical a, Physical b) => Eq (a -> b) where\n  a == b = error \"Attempt to apply equality to functions\"\nbinop:: (Physical a, Physical b) => (Float -> Float -> Float) ->\n                                    (a -> b) -> (a -> b) -> a -> b\nbinop op f g t = toPhysical ((fromPhysical (f t)) `op` (fromPhysical (g t)))\nunop:: (Physical a, Physical b ) => (Float -> Float) ->\n                                    (a -> b) -> a -> b\nunop op f t = toPhysical (op (fromPhysical (f t)))\ninstance (Physical a, Physical b) => Num (SignalRep a b) where\n  f + g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))\n  f * g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))\n  negate f = FunctionRep (unop negate (mapSignal f))\n  abs f = FunctionRep (unop abs (mapSignal f))\n  signum f = FunctionRep (unop abs (mapSignal f))\n  fromInteger i = FunctionRep (\\t -> toPhysical (fromInteger i))\n  --fromInt i = FunctionRep (\\t -> toPhysical (fromInt i))\ninstance (Physical a, Physical b) =>\n         Fractional (SignalRep a b) where\n  f / g = FunctionRep (binop (/) (mapSignal f) (mapSignal g))\n  fromRational r = FunctionRep (\\t -> (toPhysical (fromRational r)))\ninstance (Physical a, Physical b) =>\n          Floating (SignalRep a b) where\n  pi = FunctionRep (\\t -> (toPhysical pi))\n  exp   f = FunctionRep (unop exp (mapSignal f))\n  log   f = FunctionRep (unop log (mapSignal f))\n  sin   f = FunctionRep (unop sin (mapSignal f))\n  cos   f = FunctionRep (unop cos (mapSignal f))\n  asin  f = FunctionRep (unop asin (mapSignal f))\n  acos  f = FunctionRep (unop acos (mapSignal f))\n  atan  f = FunctionRep (unop atan (mapSignal f))\n  sinh  f = FunctionRep (unop sinh (mapSignal f))\n  cosh  f = FunctionRep (unop cosh (mapSignal f))\n  asinh f = FunctionRep (unop asinh (mapSignal f))\n  acosh f = FunctionRep (unop acosh (mapSignal f))\n  atanh f = FunctionRep (unop atanh (mapSignal f))\ndata Event =\n  TimeEvent Float |\n  FunctionEvent (Float -> Bool) |\n  BurstEvent Int Event\n\ninstance Show Event where\n  show (TimeEvent f) = \"TimeEvent \" ++ show f\n  show (FunctionEvent _) = \"FunctionEvent\"\n  show (BurstEvent i e)  = \"BurstEvent \" ++ show i ++ \" \" ++ show e\n\ninstance Eq Event where\n  (TimeEvent x) == (TimeEvent y) = x == y\n  (BurstEvent i e) == (BurstEvent i' e') = (i' == i) && (e' == e)\neventOccurs:: Event -> Float -> Float\neventOccurs (TimeEvent t) x = if x < t then x else t\neventOccurs (FunctionEvent f) x = stepEval f x\neventOccurs (BurstEvent i e) x =\n          if i == 1 then\n            eventOccurs e x\n          else\n            eventOccurs (BurstEvent (i-1) e) ((eventOccurs e x) + eventEps x)\nstepEval:: (Float -> Bool) -> Float -> Float\nstepEval f x = if f x then x else stepEval f (x + eventEps x)\ndata ZeroIndicator = LocalZero | GlobalZero deriving (Eq, Show)\ndata {- (Physical a, Physical b) => -} FunctionWindow a b =\n     Window ZeroIndicator Event (SignalRep a b)\n     deriving (Eq, Show)\ndata PieceCont a b = Windows [FunctionWindow a b]\n     deriving (Eq, Show)\ninstance Signal PieceCont where\n  mapSignal (Windows []) t = toPhysical 0.0\n  mapSignal (Windows wl) t = (mapSignal s) (toPhysical t')\n      where (t', (Window z e s), wl') = getWindow 0.0 (fromPhysical t) wl\n  toSig = PieceContRep\ngetWindow:: (Physical a, Physical b) =>\n            Float -> Float -> [ FunctionWindow a b ] ->\n            (Float, FunctionWindow a b, [ FunctionWindow a b ])\ngetWindow st t [] = (t, Window LocalZero e f, [])\n                    where e = TimeEvent (realmul 2 t)\n                          f = FunctionRep (\\t -> toPhysical 0.0)\ngetWindow st t (w:wl) = if t' <= wt then (t',w,w:wl)\n                        else getWindow (st+wt) t wl\n    where wt = eventOccurs e t'\n          (Window z e s) = w\n          t' = if z == LocalZero then t-st else t\n(|>) :: (Physical a, Physical b) => FunctionWindow a b ->\n        PieceCont a b -> PieceCont a b\nw |> (Windows wl) = Windows (w:wl)\nnullWindow = Windows []\ncycleWindows:: (Physical a, Physical b) =>\n                PieceCont a b -> PieceCont a b\ncycleWindows (Windows wl) = Windows (cycle wl)\nconstant:: (Physical a, Physical b) => b -> SignalRep a b\nconstant x = FunctionRep (\\t -> x)\nlinear:: (Physical a, Physical b) => Float -> b -> SignalRep a b\nlinear m b  = FunctionRep (\\x -> toPhysical (realmul m (fromPhysical x) + (fromPhysical b)))\nsine:: (Physical a, Physical b) =>\n       b -> Frequency -> Float -> SignalRep a b\nsine mag omeg phase = FunctionRep (\\x -> toPhysical (realmul (fromPhysical mag) (sin (realmul (realmul (realmul 2 pi) (fromPhysical omeg)) (fromPhysical x) + phase))))\nwaveform:: (Physical a, Physical b) => a -> [b] -> SignalRep a b\nwaveform samp ampls =\n  let stepSlope y y' = realdiv ((fromPhysical y') - (fromPhysical y)) (fromPhysical samp)\n      makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp))\n                       (linear (stepSlope v v') v)\n      points = cycle ampls\n  in PieceContRep (Windows (map makeWin (zip points (tail points))))\nrandom:: (Physical a, Physical b) =>\n         Integer -> a -> SignalRep a b\nrandom i s = waveform s (map toPhysical (rand i))\nramp:: (Physical a, Physical b) => a -> b -> SignalRep a b\nramp per v =\n  let sig = linear (realdiv (fromPhysical v) (fromPhysical per)) (toPhysical 0.0)\n  in PieceContRep (Windows (cycle ([Window LocalZero (TimeEvent (fromPhysical per)) sig ])))\ntriangle:: (Physical a, Physical b) => a -> b -> SignalRep a b\ntriangle per v =\n  let sl = realmul 2.0 (realdiv (fromPhysical v) (fromPhysical per))\n      qper = realdiv (fromPhysical v) 4.0\n      wins =  (Window LocalZero (TimeEvent qper) (linear sl (toPhysical 0.0))) |>\n              (Window LocalZero (TimeEvent (realmul 2.0 qper)) (linear (- sl) v)) |>\n              (Window LocalZero (TimeEvent qper) (linear sl (toPhysical (- (fromPhysical v))))) |>\n               nullWindow\n  in PieceContRep (cycleWindows wins)\nstep:: (Physical a, Physical b) => a -> b -> SignalRep a b\nstep tr lvl = FunctionRep (\\t -> if (fromPhysical t) < (fromPhysical tr) then (toPhysical 0.0) else lvl)\nsquare:: (Physical a, Physical b) => a -> b -> SignalRep a b\nsquare per lvl =\n  let trans = realdiv (fromPhysical per) 2.0\n      nlvl = asTypeOf (toPhysical (- (fromPhysical lvl))) lvl\n      f t = if (fromPhysical t) < trans then lvl else nlvl\n      wins = Windows [Window LocalZero (TimeEvent (fromPhysical per)) (FunctionRep f)]\n  in PieceContRep (cycleWindows wins)\npulse:: (Physical a, Physical b) => a -> a -> b -> SignalRep a b\npulse st wid lvl =\n  let tr = (fromPhysical st) + (fromPhysical wid)\n      f t = if (fromPhysical t) < (fromPhysical st) then (toPhysical 0.0)\n            else if (fromPhysical t) < tr then lvl else (toPhysical 0.0)\n  in FunctionRep f\ntrap:: (Physical a, Physical b) => a -> a -> a -> a -> b ->\n                                   SignalRep a b\ntrap st r wid f lvl =\n  let stepSlope y y' t = realdiv (y' -  y) (fromPhysical t)\n      bigwin = realmul 10000000 ((fromPhysical st) + (fromPhysical wid))\n      wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>\n             Window LocalZero (TimeEvent (fromPhysical r)) (linear (stepSlope 0.0 (fromPhysical lvl) r) (toPhysical 0.0)) |>\n             Window LocalZero (TimeEvent (fromPhysical wid)) (constant lvl) |>\n             Window LocalZero (TimeEvent (fromPhysical f)) (linear (stepSlope (fromPhysical lvl) 0.0 f) lvl) |>\n             Window LocalZero (TimeEvent bigwin) (constant (toPhysical 0.0)) |>\n             nullWindow\n  in PieceContRep wins\nexpc:: (Physical a, Physical b) => Float -> SignalRep a b\nexpc damp = FunctionRep (\\t -> toPhysical (exp (- (realmul (fromPhysical t) damp))))\ndata {- (Physical indep, Physical dep) => -} BasicSignal indep dep =\n    Overshoot {start_delay::indep,\n               pulse_width::indep,\n               ringing::dep,\n               oscillation::Frequency,\n               damp_fac::Float}\n  | Pulse_dc {start_delay::indep,\n              pulse_width::indep,\n              rise_time::indep,\n              fall_time::indep,\n              period::indep,\n              dc_offset::dep,\n              amplitude::dep,\n              over::BasicSignal indep dep,\n              under::BasicSignal indep dep}\n  | Pulse_ac {start_delay::indep,\n              pulse_width::indep,\n              period::indep,\n              dc_offset::dep,\n              amplitude::dep,\n              frequency::Frequency,\n              phase::Float}\n  deriving (Eq, Show)\n\ndata {- (Eq a, Eq b) => -} Foo a b = Foo { x :: a, y :: b}\n\nfoo :: (Eq a, Eq b) => Foo a b\nfoo = Foo{}\n\n{-\novershoot:: (Physical a, Physical b) => BasicSignal a b\novershoot = Overshoot{}\npulse_dc:: (Physical a, Physical b) => BasicSignal a b\npulse_dc = Pulse_dc {over = Overshoot{start_delay=toPhysical 0.0,\n                                            ringing=(toPhysical 0.0),\n                                            oscillation=toPhysical 1.0,\n                                            damp_fac=1.0},\n                     under = Overshoot{start_delay=toPhysical 0.0,\n                                             ringing=(toPhysical 0.0),\n                                             oscillation=toPhysical 1.0,\n                                             damp_fac=1.0},\n                     start_delay = toPhysical 0.0,\n                     dc_offset = toPhysical 0.0}\n\npulse_ac:: (Physical a, Physical b) => BasicSignal a b\npulse_ac = Pulse_ac {dc_offset = toPhysical 0.0,\n                     amplitude = toPhysical 0.0}\n-}\n\nmakeWin:: (Physical a, Physical b) => a -> a ->\n           SignalRep a b -> SignalRep a b\nmakeWin st wid sig =\n  let wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>\n             Window LocalZero (TimeEvent (fromPhysical wid)) sig |>\n             nullWindow\n  in PieceContRep wins\ninstance Signal BasicSignal where\n  toSig (Overshoot start_delay pulse_width ringing oscillation damp_fac) =\n    let ring = sine ringing oscillation 0.0\n        cond = asTypeOf (expc damp_fac) ring\n        sig = temp ring cond\n        temp:: (Physical a, Physical b) => SignalRep a b ->\n                SignalRep a b -> SignalRep a b\n        temp f g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))\n--        temp f g = f * g\n--        temp f g = asTypeOf (f * g) ring\n        wins = Window LocalZero (TimeEvent (fromPhysical start_delay)) (constant (toPhysical 0.0)) |>\n               Window LocalZero (TimeEvent (fromPhysical pulse_width)) sig |>\n               nullWindow\n    in PieceContRep wins\n  toSig Pulse_dc{ start_delay = start_delay\n                , rise_time   = rise_time\n                , pulse_width = pulse_width\n                , fall_time   = fall_time\n                , dc_offset   = dc_offset\n                , period      = period\n                , amplitude   = amplitude\n                , over        = over\n                , under       = under\n                } =\n    let pul = trap start_delay rise_time pulse_width fall_time amplitude\n        so = toPhysical ((fromPhysical start_delay) + (fromPhysical rise_time))\n        su = toPhysical ((fromPhysical so) + (fromPhysical pulse_width) + (fromPhysical fall_time))\n        oversh = toSig over{start_delay=so}\n        undersh = toSig under{start_delay=su}\n        off = constant dc_offset\n        temp:: (Physical a, Physical b) => SignalRep a b ->\n                SignalRep a b -> SignalRep a b\n        temp f g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))\n        sig = temp (temp (temp pul oversh) undersh) off\n        wins = (Window LocalZero (TimeEvent (fromPhysical period)) sig) |>\n                nullWindow\n    in PieceContRep (cycleWindows wins)\nsumSig:: (Physical a, Physical b, Signal s, Signal s') =>\n         (s a b) -> (s' a b) -> SignalRep a b\nsumSig f f' =\n   let s1 t = fromPhysical (mapSignal f t)\n       s2 t = fromPhysical (mapSignal f' t)\n   in FunctionRep (\\t -> toPhysical ((s1 t) + (s2 t)))\nmulSig:: (Physical a, Physical b, Signal s, Signal s') =>\n         (s a b) -> (s' a b) -> SignalRep a b\nmulSig f f' =\n   let f1 t = fromPhysical (mapSignal f t)\n       f2 t = fromPhysical (mapSignal f' t)\n   in FunctionRep (\\t -> toPhysical ((f1 t) * (f2 t)))\n\neventEps:: Float -> Float\neventEps x = let eps = realdiv x 1000 in if 0.01 < eps then 0.01 else eps\n", "num_lines": 288}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug where\n\ndata Eq a => Foo a = Foo { x :: a }\n\nfoo :: Foo Int\nfoo = Foo{}\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Expected (sinExpected, pieceExpected) where\n\nsinExpected :: [(Float, Float)]\nsinExpected = [\n (0.0, 0.0),\n (4.0e-4, 5.0260194e-2),\n (8.0e-4, 0.10048864),\n (1.1999999e-3, 0.1506536),\n (1.6e-3, 0.20072344),\n (1.9999999e-3, 0.25066644),\n (2.3999999e-3, 0.30045116),\n (2.8e-3, 0.35004613),\n (3.2e-3, 0.39941996),\n (3.6e-3, 0.44854155),\n (3.9999997e-3, 0.49737975),\n (4.3999995e-3, 0.54590386),\n (4.7999993e-3, 0.5940831),\n (5.199999e-3, 0.6418871),\n (5.599999e-3, 0.68928576),\n (5.9999987e-3, 0.736249),\n (6.3999984e-3, 0.7827472),\n (6.799998e-3, 0.82875097),\n (7.199998e-3, 0.87423134),\n (7.599998e-3, 0.9191595),\n (7.999998e-3, 0.96350706),\n (8.399998e-3, 1.0072463),\n (8.799998e-3, 1.0503491),\n (9.199998e-3, 1.0927886),\n (9.599999e-3, 1.1345378),\n (9.999999e-3, 1.1755705),\n (1.0399999e-2, 1.2158606),\n (1.0799999e-2, 1.2553827),\n (1.12e-2, 1.294112),\n (1.16e-2, 1.3320237),\n (1.2e-2, 1.3690943),\n (1.24e-2, 1.4053),\n (1.2800001e-2, 1.4406182),\n (1.3200001e-2, 1.4750264),\n (1.3600001e-2, 1.5085028),\n (1.4000001e-2, 1.5410266),\n (1.4400002e-2, 1.572577),\n (1.4800002e-2, 1.6031342),\n (1.5200002e-2, 1.6326787),\n (1.5600002e-2, 1.661192),\n (1.6000003e-2, 1.6886561),\n (1.6400002e-2, 1.7150536),\n (1.6800001e-2, 1.7403677),\n (1.72e-2, 1.7645825),\n (1.76e-2, 1.7876829),\n (1.8e-2, 1.8096541),\n (1.8399999e-2, 1.8304824),\n (1.8799998e-2, 1.8501544),\n (1.9199997e-2, 1.8686578),\n (1.9599997e-2, 1.885981),\n (1.9999996e-2, 1.902113),\n (2.0399995e-2, 1.9170434),\n (2.0799994e-2, 1.9307631),\n (2.1199994e-2, 1.9432633),\n (2.1599993e-2, 1.9545361),\n (2.1999992e-2, 1.9645743),\n (2.2399992e-2, 1.9733717),\n (2.2799991e-2, 1.9809227),\n (2.319999e-2, 1.9872226),\n (2.359999e-2, 1.9922671),\n (2.3999989e-2, 1.9960533),\n (2.4399988e-2, 1.9985789),\n (2.4799988e-2, 1.999842),\n (2.5199987e-2, 1.999842),\n (2.5599986e-2, 1.998579),\n (2.5999986e-2, 1.9960536),\n (2.6399985e-2, 1.9922674),\n (2.6799984e-2, 1.9872228),\n (2.7199984e-2, 1.980923),\n (2.7599983e-2, 1.9733722),\n (2.7999982e-2, 1.9645749),\n (2.8399982e-2, 1.9545367),\n (2.879998e-2, 1.943264),\n (2.919998e-2, 1.930764),\n (2.959998e-2, 1.9170443),\n (2.9999979e-2, 1.9021138),\n (3.0399978e-2, 1.8859819),\n (3.0799977e-2, 1.8686588),\n (3.1199977e-2, 1.8501555),\n (3.1599976e-2, 1.8304834),\n (3.1999975e-2, 1.8096554),\n (3.2399975e-2, 1.7876841),\n (3.2799974e-2, 1.7645838),\n (3.3199973e-2, 1.7403691),\n (3.3599973e-2, 1.715055),\n (3.3999972e-2, 1.6886578),\n (3.439997e-2, 1.6611936),\n (3.479997e-2, 1.6326804),\n (3.519997e-2, 1.6031361),\n (3.559997e-2, 1.5725791),\n (3.599997e-2, 1.541029),\n (3.6399968e-2, 1.5085055),\n (3.6799967e-2, 1.4750288),\n (3.7199967e-2, 1.4406208),\n (3.7599966e-2, 1.4053029),\n (3.7999965e-2, 1.3690974),\n (3.8399965e-2, 1.3320271),\n (3.8799964e-2, 1.2941151),\n (3.9199963e-2, 1.2553861),\n (3.9599963e-2, 1.2158642),\n (3.999996e-2, 1.1755743),\n (4.039996e-2, 1.1345419),\n (4.079996e-2, 1.0927929),\n (4.119996e-2, 1.0503532),\n (4.159996e-2, 1.0072505),\n (4.199996e-2, 0.9635117),\n (4.2399958e-2, 0.9191643),\n (4.2799957e-2, 0.87423635),\n (4.3199956e-2, 0.82875574),\n (4.3599956e-2, 0.7827521),\n (4.3999955e-2, 0.7362541),\n (4.4399954e-2, 0.68929106),\n (4.4799954e-2, 0.6418926),\n (4.5199953e-2, 0.5940888),\n (4.5599952e-2, 0.5459092),\n (4.599995e-2, 0.49738535),\n (4.639995e-2, 0.4485473),\n (4.679995e-2, 0.39942592),\n (4.719995e-2, 0.3500523),\n (4.759995e-2, 0.30045706),\n (4.799995e-2, 0.25067255),\n (4.8399948e-2, 0.2007297),\n (4.8799947e-2, 0.15066005),\n (4.9199946e-2, 0.100495264),\n (4.9599946e-2, 5.0266996e-2),\n (4.9999945e-2, 6.500875e-6),\n (5.0399944e-2, -5.025352e-2),\n (5.0799944e-2, -0.1004818),\n (5.1199943e-2, -0.15064661),\n (5.1599942e-2, -0.20071629),\n (5.199994e-2, -0.25065964),\n (5.239994e-2, -0.30044422),\n (5.279994e-2, -0.350039),\n (5.319994e-2, -0.39941272),\n (5.359994e-2, -0.44853416),\n (5.3999938e-2, -0.4973723),\n (5.4399937e-2, -0.5458967),\n (5.4799937e-2, -0.5940759),\n (5.5199936e-2, -0.64187986),\n (5.5599935e-2, -0.6892784),\n (5.5999935e-2, -0.7362416),\n (5.6399934e-2, -0.7827402),\n (5.6799933e-2, -0.82874393),\n (5.7199933e-2, -0.87422425),\n (5.7599932e-2, -0.9191523),\n (5.799993e-2, -0.9634999),\n (5.839993e-2, -1.0072393),\n (5.879993e-2, -1.0503422),\n (5.919993e-2, -1.0927815),\n (5.959993e-2, -1.1345308),\n (5.9999928e-2, -1.1755633),\n (6.0399927e-2, -1.2158535),\n (6.0799927e-2, -1.255376),\n (6.1199926e-2, -1.2941052),\n (6.1599925e-2, -1.332017),\n (6.1999924e-2, -1.3690875),\n (6.2399924e-2, -1.4052932),\n (6.279992e-2, -1.4406117),\n (6.319992e-2, -1.4750199),\n (6.359992e-2, -1.5084965),\n (6.399992e-2, -1.5410206),\n (6.439992e-2, -1.5725712),\n (6.479992e-2, -1.6031283),\n (6.519992e-2, -1.6326729),\n (6.559992e-2, -1.6611863),\n (6.599992e-2, -1.6886505),\n (6.639992e-2, -1.7150481),\n (6.679992e-2, -1.7403624),\n (6.7199916e-2, -1.7645775),\n (6.7599915e-2, -1.7876781),\n (6.7999914e-2, -1.8096495),\n (6.839991e-2, -1.8304783),\n (6.879991e-2, -1.8501506),\n (6.919991e-2, -1.8686541),\n (6.959991e-2, -1.8859775),\n (6.999991e-2, -1.9021097),\n (7.039991e-2, -1.9170405),\n (7.079991e-2, -1.9307604),\n (7.119991e-2, -1.9432608),\n (7.159991e-2, -1.9545338),\n (7.199991e-2, -1.9645723),\n (7.239991e-2, -1.97337),\n (7.2799906e-2, -1.9809214),\n (7.3199905e-2, -1.9872214),\n (7.3599905e-2, -1.9922662),\n (7.3999904e-2, -1.9960527),\n (7.43999e-2, -1.9985785),\n (7.47999e-2, -1.9998419),\n (7.51999e-2, -1.9998423),\n (7.55999e-2, -1.9985794),\n (7.59999e-2, -1.9960542),\n (7.63999e-2, -1.9922683),\n (7.67999e-2, -1.9872241),\n (7.71999e-2, -1.9809245),\n (7.75999e-2, -1.9733739),\n (7.79999e-2, -1.9645768),\n (7.83999e-2, -1.9545388),\n (7.8799896e-2, -1.9432664),\n (7.9199895e-2, -1.9307666),\n (7.9599895e-2, -1.9170473),\n (7.9999894e-2, -1.902117),\n (8.039989e-2, -1.8859855),\n (8.079989e-2, -1.8686627),\n (8.119989e-2, -1.8501595),\n (8.159989e-2, -1.8304875),\n (8.199989e-2, -1.8096596),\n (8.239989e-2, -1.7876887),\n (8.279989e-2, -1.7645887),\n (8.319989e-2, -1.7403742),\n (8.359989e-2, -1.7150604),\n (8.399989e-2, -1.6886632),\n (8.439989e-2, -1.6611996),\n (8.4799886e-2, -1.6326867),\n (8.5199885e-2, -1.6031425),\n (8.5599884e-2, -1.5725858),\n (8.599988e-2, -1.5410352),\n (8.639988e-2, -1.5085119),\n (8.679988e-2, -1.4750358),\n (8.719988e-2, -1.4406279),\n (8.759988e-2, -1.4053102),\n (8.799988e-2, -1.3691049),\n (8.839988e-2, -1.3320347),\n (8.879988e-2, -1.2941233),\n (8.919988e-2, -1.2553945),\n (8.959988e-2, -1.2158726),\n (8.999988e-2, -1.175583),\n (9.0399876e-2, -1.13455),\n (9.0799876e-2, -1.0928011),\n (9.1199875e-2, -1.050362),\n (9.1599874e-2, -1.0072595),\n (9.199987e-2, -0.96352077),\n (9.239987e-2, -0.9191735),\n (9.279987e-2, -0.87424564),\n (9.319987e-2, -0.8287656),\n (9.359987e-2, -0.78276205),\n (9.399987e-2, -0.73626417),\n (9.439987e-2, -0.6893012),\n (9.479987e-2, -0.64190197),\n (9.519987e-2, -0.59409815),\n (9.559987e-2, -0.5459192),\n (9.599987e-2, -0.49739534),\n (9.6399866e-2, -0.44855735),\n (9.6799865e-2, -0.39943603),\n (9.7199865e-2, -0.35006243),\n (9.7599864e-2, -0.30046773),\n (9.799986e-2, -0.25068325),\n (9.839986e-2, -0.20074043),\n (9.879986e-2, -0.15067083),\n (9.919986e-2, -0.10050509),\n (9.959986e-2, -5.027683e-2),\n (9.999986e-2, -1.6816446e-5),\n (0.10039986, 5.024321e-2),\n (0.10079986, 0.100471504),\n (0.10119986, 0.15063633),\n (0.10159986, 0.20070602),\n (0.10199986, 0.25064895),\n (0.102399856, 0.30043355),\n (0.102799855, 0.3500284),\n (0.103199854, 0.39940214),\n (0.103599854, 0.44852456),\n (0.10399985, 0.49736276),\n (0.10439985, 0.5458868),\n (0.10479985, 0.5940661),\n (0.10519985, 0.6418701),\n (0.10559985, 0.6892687),\n (0.10599985, 0.736232),\n (0.10639985, 0.7827302),\n (0.10679985, 0.8287341),\n (0.10719985, 0.87421453),\n (0.10759985, 0.9191428),\n (0.10799985, 0.9634913),\n (0.108399846, 1.0072304),\n (0.108799845, 1.0503334),\n (0.109199844, 1.092773),\n (0.10959984, 1.1345222),\n (0.10999984, 1.175555),\n (0.11039984, 1.2158452),\n (0.11079984, 1.2553675),\n (0.11119984, 1.294097),\n (0.11159984, 1.332009),\n (0.11199984, 1.3690796),\n (0.11239984, 1.4052863),\n (0.11279984, 1.4406046),\n (0.11319984, 1.475013),\n (0.11359984, 1.5084898),\n (0.113999836, 1.5410138),\n (0.114399835, 1.5725645),\n (0.114799835, 1.6031219),\n (0.115199834, 1.6326667),\n (0.11559983, 1.6611804),\n (0.11599983, 1.6886448),\n (0.11639983, 1.7150426),\n (0.11679983, 1.7403576),\n (0.11719983, 1.7645729),\n (0.11759983, 1.7876737),\n (0.11799983, 1.8096453),\n (0.11839983, 1.8304739),\n (0.11879983, 1.8501464),\n (0.11919983, 1.8686503),\n (0.11959983, 1.8859739),\n (0.119999826, 1.9021064),\n (0.120399825, 1.9170374),\n (0.120799825, 1.9307575),\n (0.121199824, 1.9432585),\n (0.12159982, 1.9545318),\n (0.12199982, 1.9645705),\n (0.12239982, 1.9733684),\n (0.12279982, 1.9809198),\n (0.12319982, 1.9872202),\n (0.12359982, 1.9922652),\n (0.12399982, 1.996052),\n (0.12439982, 1.9985781),\n (0.12479982, 1.9998418),\n (0.12519982, 1.9998424),\n (0.12559983, 1.9985797),\n (0.12599984, 1.9960546),\n (0.12639984, 1.9922688),\n (0.12679985, 1.9872246),\n (0.12719986, 1.9809252),\n (0.12759987, 1.9733747),\n (0.12799987, 1.9645776),\n (0.12839988, 1.9545392),\n (0.12879989, 1.9432665),\n (0.12919989, 1.9307665),\n (0.1295999, 1.9170468),\n (0.1299999, 1.9021163),\n (0.13039991, 1.8859843),\n (0.13079992, 1.868661),\n (0.13119993, 1.8501575),\n (0.13159993, 1.8304853),\n (0.13199994, 1.8096569),\n (0.13239995, 1.7876855),\n (0.13279995, 1.7645848),\n (0.13319996, 1.7403696),\n (0.13359997, 1.7150551),\n (0.13399997, 1.6886573),\n (0.13439998, 1.6611929),\n (0.13479999, 1.6326791),\n (0.1352, 1.6031342),\n (0.1356, 1.5725766),\n (0.136, 1.5410256),\n (0.13640001, 1.5085014),\n (0.13680002, 1.4750243),\n (0.13720003, 1.4406155),\n (0.13760003, 1.4052968),\n (0.13800004, 1.3690904),\n (0.13840005, 1.3320193),\n (0.13880005, 1.2941068),\n (0.13920006, 1.2553754),\n (0.13960007, 1.2158525),\n (0.14000008, 1.1755617),\n (0.14040008, 1.1345282),\n (0.14080009, 1.0927782),\n (0.1412001, 1.0503379),\n (0.1416001, 1.0072342),\n (0.14200011, 0.9634943),\n (0.14240012, 0.9191458),\n (0.14280012, 0.87421674),\n (0.14320013, 0.8287355),\n (0.14360014, 0.78273076),\n (0.14400014, 0.7362316),\n (0.14440015, 0.68926746),\n (0.14480016, 0.64186794),\n (0.14520016, 0.5940629),\n (0.14560017, 0.54588276),\n (0.14600018, 0.49735776),\n (0.14640018, 0.4485186),\n (0.14680019, 0.39939615),\n (0.1472002, 0.35002142),\n (0.1476002, 0.30042562),\n (0.14800021, 0.25064003),\n (0.14840022, 0.20069614),\n (0.14880022, 0.15062548),\n (0.14920023, 0.10045967),\n (0.14960024, 5.0230417e-2),\n (0.15000024, -3.2472628e-5),\n (0.15040025, -5.0293438e-2),\n (0.15080026, -0.10052263),\n (0.15120026, -0.15068834),\n (0.15160027, -0.20075886),\n (0.15200028, -0.25070256),\n (0.15240029, -0.30048794),\n (0.15280029, -0.3500835),\n (0.1532003, -0.39945793),\n (0.1536003, -0.44858003),\n (0.15400031, -0.49741882),\n (0.15440032, -0.5459434),\n (0.15480033, -0.5941231),\n (0.15520033, -0.6419276),\n (0.15560034, -0.68932664),\n (0.15600035, -0.7362902),\n (0.15640035, -0.78278875),\n (0.15680036, -0.8287928),\n (0.15720037, -0.8742734),\n (0.15760037, -0.9192018),\n (0.15800038, -0.96354955),\n (0.15840039, -1.0072887),\n (0.1588004, -1.0503916),\n (0.1592004, -1.092831),\n (0.1596004, -1.1345801),\n (0.16000041, -1.1756126),\n (0.16040042, -1.2159026),\n (0.16080043, -1.2554245),\n (0.16120043, -1.2941549),\n (0.16160044, -1.3320663),\n (0.16200045, -1.3691365),\n (0.16240045, -1.4053416),\n (0.16280046, -1.4406593),\n (0.16320047, -1.4750669),\n (0.16360047, -1.5085428),\n (0.16400048, -1.5410659),\n (0.16440049, -1.5726155),\n (0.1648005, -1.6031718),\n (0.1652005, -1.6327156),\n (0.16560051, -1.661228),\n (0.16600052, -1.688691),\n (0.16640052, -1.7150875),\n (0.16680053, -1.7404007),\n (0.16720054, -1.7646145),\n (0.16760054, -1.7877138),\n (0.16800055, -1.8096838),\n (0.16840056, -1.8305107),\n (0.16880056, -1.8501815),\n (0.16920057, -1.8686836),\n (0.16960058, -1.8860053),\n (0.17000058, -1.9021357),\n (0.17040059, -1.9170648),\n (0.1708006, -1.9307829),\n (0.1712006, -1.9432814),\n (0.17160061, -1.9545525),\n (0.17200062, -1.9645894),\n (0.17240062, -1.973385),\n (0.17280063, -1.980934),\n (0.17320064, -1.9872319),\n (0.17360064, -1.9922745),\n (0.17400065, -1.9960587),\n (0.17440066, -1.9985821),\n (0.17480066, -1.9998431),\n (0.17520067, -1.999841),\n (0.17560068, -1.9985757),\n (0.17600068, -1.996048),\n (0.17640069, -1.9922595),\n (0.1768007, -1.9872127),\n (0.1772007, -1.9809105),\n (0.17760071, -1.9733572),\n (0.17800072, -1.9645574),\n (0.17840073, -1.9545168),\n (0.17880073, -1.9432416),\n (0.17920074, -1.9307389),\n (0.17960075, -1.9170167),\n (0.18000075, -1.9020836),\n (0.18040076, -1.8859491),\n (0.18080077, -1.8686235),\n (0.18120077, -1.8501174),\n (0.18160078, -1.8304428),\n (0.18200079, -1.8096119),\n (0.1824008, -1.7876381),\n (0.1828008, -1.7645352),\n (0.1832008, -1.7403166),\n (0.18360081, -1.7149998),\n (0.18400082, -1.6885997),\n (0.18440083, -1.661133),\n (0.18480083, -1.6326171),\n (0.18520084, -1.6030699),\n (0.18560085, -1.5725102),\n (0.18600085, -1.5409572),\n (0.18640086, -1.5084308),\n (0.18680087, -1.4749517),\n (0.18720087, -1.440541),\n (0.18760088, -1.4052204),\n (0.18800089, -1.3690121),\n (0.1884009, -1.3319391),\n (0.1888009, -1.2940248),\n (0.18920091, -1.2552933),\n (0.18960091, -1.2157687),\n (0.19000092, -1.1754762),\n (0.19040093, -1.1344413),\n (0.19080094, -1.0926898),\n (0.19120094, -1.0502481),\n (0.19160095, -1.007143),\n (0.19200096, -0.9634018),\n (0.19240096, -0.91905206),\n (0.19280097, -0.8741218),\n (0.19320098, -0.8286394),\n (0.19360098, -0.7826336),\n (0.19400099, -0.73613167),\n (0.194401, -0.68916655),\n (0.194801, -0.64176613),\n (0.19520101, -0.59396034),\n (0.19560102, -0.54577935),\n (0.19600102, -0.49725366),\n (0.19640103, -0.44841388),\n (0.19680104, -0.39929086),\n (0.19720104, -0.34991562),\n (0.19760105, -0.30031937),\n (0.19800106, -0.2505334),\n (0.19840106, -0.20058921),\n (0.19880107, -0.15051831),\n (0.19920108, -0.10035235),\n (0.19960108, -5.0122987e-2),\n (0.20000109, 1.3802848e-4),\n (0.2004011, 5.0398957e-2),\n (0.2008011, 0.100628056),\n (0.20120111, 0.1507936),\n (0.20160112, 0.20086388),\n (0.20200112, 0.2508073),\n (0.20240113, 0.30059227),\n (0.20280114, 0.35018742),\n (0.20320114, 0.39956135),\n (0.20360115, 0.4486829),\n (0.20400116, 0.49752104),\n (0.20440117, 0.54604495),\n (0.20480117, 0.59422576),\n (0.20520118, 0.6420294),\n (0.20560119, 0.6894275),\n (0.20600119, 0.7363901),\n (0.2064012, 0.78288764),\n (0.2068012, 0.8288906),\n (0.20720121, 0.8743701),\n (0.20760122, 0.9192972),\n (0.20800123, 0.9636437),\n (0.20840123, 1.0073816),\n (0.20880124, 1.050483),\n (0.20920125, 1.092921),\n (0.20960125, 1.1346686),\n (0.21000126, 1.1756996),\n (0.21040127, 1.2159879),\n (0.21080127, 1.2555081),\n (0.21120128, 1.2942353),\n (0.21160129, 1.3321451),\n (0.2120013, 1.3692133),\n (0.2124013, 1.4054167),\n (0.2128013, 1.4407325),\n (0.21320131, 1.4751382),\n (0.21360132, 1.5086122),\n (0.21400133, 1.5411332),\n (0.21440133, 1.5726807),\n (0.21480134, 1.603235),\n (0.21520135, 1.6327765),\n (0.21560135, 1.6612867),\n (0.21600136, 1.6887486),\n (0.21640137, 1.7151428),\n (0.21680138, 1.7404536),\n (0.21720138, 1.7646651),\n (0.21760139, 1.7877619),\n (0.2180014, 1.8097295),\n (0.2184014, 1.830554),\n (0.21880141, 1.8502222),\n (0.21920142, 1.8687218),\n (0.21960142, 1.886041),\n (0.22000143, 1.902169),\n (0.22040144, 1.9170954),\n (0.22080144, 1.9308109),\n (0.22120145, 1.9433068),\n (0.22160146, 1.9545753),\n (0.22200146, 1.9646091),\n (0.22240147, 1.9734021),\n (0.22280148, 1.9809486),\n (0.22320148, 1.9872438),\n (0.22360149, 1.9922837),\n (0.2240015, 1.9960653),\n (0.2244015, 1.998586),\n (0.22480151, 1.9998444),\n (0.22520152, 1.9998397),\n (0.22560152, 1.9985718),\n (0.22600153, 1.9960413),\n (0.22640154, 1.9922502),\n (0.22680154, 1.9872005),\n (0.22720155, 1.9808956),\n (0.22760156, 1.9733397),\n (0.22800156, 1.9645373),\n (0.22840157, 1.954494),\n (0.22880158, 1.9432161),\n (0.22920159, 1.9307109),\n (0.22960159, 1.9169861),\n (0.2300016, 1.9020505),\n (0.2304016, 1.8859134),\n (0.23080161, 1.8685851),\n (0.23120162, 1.8500766),\n (0.23160163, 1.8303995),\n (0.23200163, 1.8095663),\n (0.23240164, 1.7875899),\n (0.23280165, 1.7644845),\n (0.23320165, 1.7402647),\n (0.23360166, 1.7149456),\n (0.23400167, 1.6885431),\n (0.23440167, 1.6610742),\n (0.23480168, 1.6325561),\n (0.23520169, 1.6030068),\n (0.2356017, 1.5724449),\n (0.2360017, 1.5408899),\n (0.2364017, 1.5083616),\n (0.23680171, 1.4748805),\n (0.23720172, 1.4404678),\n (0.23760173, 1.4051453),\n (0.23800173, 1.3689338),\n (0.23840174, 1.331859),\n (0.23880175, 1.2939429),\n (0.23920175, 1.2552096),\n (0.23960176, 1.2156833),\n (0.24000177, 1.1753893),\n (0.24040177, 1.1343528),\n (0.24080178, 1.0925997),\n (0.24120179, 1.0501566),\n (0.2416018, 1.0070502),\n (0.2420018, 0.9633076),\n (0.24240181, 0.9189566),\n (0.24280182, 0.8740251),\n (0.24320182, 0.8285416),\n (0.24360183, 0.7825347),\n (0.24400184, 0.73603356),\n (0.24440184, 0.6890675),\n (0.24480185, 0.6416662),\n (0.24520186, 0.59385955),\n (0.24560186, 0.54567784),\n (0.24600187, 0.49715143),\n (0.24640188, 0.448311),\n (0.24680188, 0.39918742),\n (0.24720189, 0.3498117),\n (0.2476019, 0.300215),\n (0.2480019, 0.25042868),\n (0.24840191, 0.20048419),\n (0.24880192, 0.15041116),\n (0.24920192, 0.10024502),\n (0.24960193, 5.001556e-2),\n (0.25000194, -2.4549168e-4),\n (0.25040194, -5.0506387e-2),\n (0.25080195, -0.10073538),\n (0.25120196, -0.15090075),\n (0.25160196, -0.2009708),\n (0.25200197, -0.25091392),\n (0.25240198, -0.30069852),\n (0.25280198, -0.35029322),\n (0.253202, -0.39966664),\n (0.253602, -0.44878763),\n (0.254002, -0.49762514),\n (0.254402, -0.5461483),\n (0.25480202, -0.59432656),\n (0.25520203, -0.64212936),\n (0.25560203, -0.6895266),\n (0.25600204, -0.7364883),\n (0.25640205, -0.7829848),\n (0.25680205, -0.8289867),\n (0.25720206, -0.874465),\n (0.25760207, -0.919391),\n (0.25800207, -0.9637362),\n (0.25840208, -1.0074726),\n (0.2588021, -1.0505729),\n (0.2592021, -1.0930094),\n (0.2596021, -1.1347555),\n (0.2600021, -1.175785),\n (0.2604021, -1.2160717),\n (0.26080212, -1.2555903),\n (0.26120213, -1.2943158),\n (0.26160213, -1.3322238),\n (0.26200214, -1.3692902),\n (0.26240215, -1.4054918),\n (0.26280215, -1.4408057),\n (0.26320216, -1.4752095),\n (0.26360217, -1.5086814),\n (0.26400217, -1.5412004),\n (0.26440218, -1.5727459),\n (0.2648022, -1.6032981),\n (0.2652022, -1.6328397),\n (0.2656022, -1.6613476),\n (0.2660022, -1.6888062),\n (0.2664022, -1.715198),\n (0.26680222, -1.7405065),\n (0.26720223, -1.7647157),\n (0.26760224, -1.7878101),\n (0.26800224, -1.8097752),\n (0.26840225, -1.8305973),\n (0.26880226, -1.8502631),\n (0.26920226, -1.8687601),\n (0.26960227, -1.8860768),\n (0.27000228, -1.9022021),\n (0.27040228, -1.917126),\n (0.2708023, -1.930839),\n (0.2712023, -1.9433322),\n (0.2716023, -1.9545981),\n (0.2720023, -1.9646293),\n (0.27240232, -1.9734195),\n (0.27280232, -1.9809633),\n (0.27320233, -1.9872558),\n (0.27360234, -1.9922931),\n (0.27400234, -1.996072),\n (0.27440235, -1.9985901),\n (0.27480236, -1.9998459),\n (0.27520236, -1.9998384),\n (0.27560237, -1.9985676),\n (0.27600238, -1.9960346),\n (0.27640238, -1.9922408),\n (0.2768024, -1.9871886),\n (0.2772024, -1.9808811),\n (0.2776024, -1.9733225),\n (0.2780024, -1.9645175),\n (0.27840242, -1.9544716),\n (0.27880242, -1.9431912),\n (0.27920243, -1.9306833),\n (0.27960244, -1.916956),\n (0.28000244, -1.9020178),\n (0.28040245, -1.8858782),\n (0.28080246, -1.8685476),\n (0.28120247, -1.8500365),\n (0.28160247, -1.830357),\n (0.28200248, -1.8095212),\n (0.2824025, -1.7875426),\n (0.2828025, -1.7644348),\n (0.2832025, -1.7402126),\n (0.2836025, -1.7148912),\n (0.2840025, -1.6884866),\n (0.28440252, -1.6610154),\n (0.28480253, -1.6324952),\n (0.28520253, -1.6029437),\n (0.28560254, -1.5723797),\n (0.28600255, -1.5408226),\n (0.28640255, -1.5082922),\n (0.28680256, -1.4748092),\n (0.28720257, -1.4403919),\n (0.28760257, -1.4050674),\n (0.28800258, -1.3688555),\n (0.2884026, -1.3317788),\n (0.2888026, -1.293861),\n (0.2892026, -1.2551259),\n (0.2896026, -1.215598),\n (0.2900026, -1.1753024),\n (0.29040262, -1.1342642),\n (0.29080263, -1.0925097),\n (0.29120263, -1.0500652),\n (0.29160264, -1.0069573),\n (0.29200265, -0.96321344),\n (0.29240265, -0.91886115),\n (0.29280266, -0.8739285),\n (0.29320267, -0.82844377),\n (0.29360268, -0.78243583),\n (0.29400268, -0.7359336),\n (0.2944027, -0.6889666),\n (0.2948027, -0.64156437),\n (0.2952027, -0.5937569),\n (0.2956027, -0.5455744),\n (0.29600272, -0.49704733),\n (0.29640272, -0.44820628),\n (0.29680273, -0.39908212),\n (0.29720274, -0.34970587),\n (0.29760274, -0.30010876),\n (0.29800275, -0.25032207),\n (0.29840276, -0.20037727),\n (0.29880276, -0.1503059),\n (0.29920277, -0.100139596),\n (0.29960278, -4.9910035e-2),\n (0.30000278, 3.5104755e-4),\n (0.3004028, 5.061191e-2),\n (0.3008028, 0.10084081),\n (0.3012028, 0.151006),\n (0.3016028, 0.20107582),\n (0.30200282, 0.25101864),\n (0.30240282, 0.3008029),\n (0.30280283, 0.35039714),\n (0.30320284, 0.39977008),\n (0.30360284, 0.44889048),\n (0.30400285, 0.49772736),\n (0.30440286, 0.54624987),\n (0.30480286, 0.59442735),\n (0.30520287, 0.6422293),\n (0.30560288, 0.6896257),\n (0.3060029, 0.7365864),\n (0.3064029, 0.7830819),\n (0.3068029, 0.8290828),\n (0.3072029, 0.87455994),\n (0.3076029, 0.9194847),\n (0.30800292, 0.9638287),\n (0.30840293, 1.0075638),\n (0.30880293, 1.0506626),\n (0.30920294, 1.093101),\n (0.30960295, 1.1348456),\n (0.31000295, 1.1758734),\n (0.31040296, 1.2161585),\n (0.31080297, 1.2556754),\n (0.31120297, 1.2943991),\n (0.31160298, 1.3323053),\n (0.312003, 1.36937),\n (0.312403, 1.4055697),\n (0.312803, 1.4408816),\n (0.313203, 1.4752833),\n (0.313603, 1.5087532),\n (0.31400302, 1.5412701),\n (0.31440303, 1.5728135),\n (0.31480303, 1.6033634),\n (0.31520304, 1.6329006),\n (0.31560305, 1.6614064),\n (0.31600305, 1.6888628),\n (0.31640306, 1.7152524),\n (0.31680307, 1.7405585),\n (0.31720307, 1.7647653),\n (0.31760308, 1.7878574),\n (0.3180031, 1.8098202),\n (0.3184031, 1.8306398),\n (0.3188031, 1.8503032),\n (0.3192031, 1.8687978),\n (0.31960312, 1.886112),\n (0.32000312, 1.9022348),\n (0.32040313, 1.9171561),\n (0.32080314, 1.9308665),\n (0.32120314, 1.9433572),\n (0.32160315, 1.9546204),\n (0.32200316, 1.9646491),\n (0.32240316, 1.9734367),\n (0.32280317, 1.9809779),\n (0.32320318, 1.9872677),\n (0.32360318, 1.9923024),\n (0.3240032, 1.9960786),\n (0.3244032, 1.998594),\n (0.3248032, 1.9998472),\n (0.3252032, 1.9998369),\n (0.32560322, 1.9985636),\n (0.32600322, 1.996028),\n (0.32640323, 1.9922315),\n (0.32680324, 1.9871767),\n (0.32720324, 1.9808666),\n (0.32760325, 1.9733053),\n (0.32800326, 1.9644977),\n (0.32840326, 1.9544492),\n (0.32880327, 1.9431661),\n (0.32920328, 1.9306557),\n (0.32960328, 1.9169259),\n (0.3300033, 1.9019852),\n (0.3304033, 1.8858432),\n (0.3308033, 1.8685085),\n (0.3312033, 1.8499949),\n (0.33160332, 1.8303128),\n (0.33200333, 1.8094747),\n (0.33240333, 1.7874936),\n (0.33280334, 1.7643833),\n (0.33320335, 1.7401587),\n (0.33360335, 1.7148349),\n (0.33400336, 1.6884279),\n (0.33440337, 1.6609545),\n (0.33480337, 1.632432),\n (0.33520338, 1.6028782),\n (0.3356034, 1.5723121),\n (0.3360034, 1.5407529),\n (0.3364034, 1.5082204),\n (0.3368034, 1.4747353),\n (0.3372034, 1.4403187),\n (0.33760342, 1.4049923),\n (0.33800343, 1.3687785),\n (0.33840343, 1.3317001),\n (0.33880344, 1.2937804),\n (0.33920345, 1.2550437),\n (0.33960345, 1.2155142),\n (0.34000346, 1.1752169),\n (0.34040347, 1.1341773),\n (0.34080347, 1.0924213),\n (0.34120348, 1.0499753),\n (0.3416035, 1.0068661),\n (0.3420035, 0.96312094),\n (0.3424035, 0.9187674),\n (0.3428035, 0.87383354),\n (0.3432035, 0.8283477),\n (0.34360352, 0.7823387),\n (0.34400353, 0.7358355),\n (0.34440354, 0.6888675),\n (0.34480354, 0.6414644),\n (0.34520355, 0.5936561),\n (0.34560356, 0.54547286),\n (0.34600356, 0.49694508),\n (0.34640357, 0.4481034),\n (0.34680358, 0.39897868),\n (0.34720358, 0.34960195),\n (0.3476036, 0.3000044),\n (0.3480036, 0.25021735),\n (0.3484036, 0.20027225),\n (0.3488036, 0.15020065),\n (0.34920362, 0.10003417),\n (0.34960362, 4.9804512e-2),\n (0.35000363, -4.566034e-4),\n (0.35040364, -5.0717432e-2),\n (0.35080364, -0.100946225),\n (0.35120365, -0.15111126),\n (0.35160366, -0.20118085),\n (0.35200366, -0.25112334),\n (0.35240367, -0.30090722),\n (0.35280368, -0.35050482),\n (0.35320368, -0.39987722),\n (0.3536037, -0.44899708),\n (0.3540037, -0.4978333),\n (0.3544037, -0.54635507),\n (0.3548037, -0.5945318),\n (0.35520372, -0.6423329),\n (0.35560372, -0.6897283),\n (0.35600373, -0.7366881),\n (0.35640374, -0.78318256),\n (0.35680375, -0.82918227),\n (0.35720375, -0.8746583),\n (0.35760376, -0.91958183),\n (0.35800377, -0.9639245),\n (0.35840377, -1.0076584),\n (0.35880378, -1.0507557),\n (0.3592038, -1.0931894),\n (0.3596038, -1.1349325),\n (0.3600038, -1.1759588),\n (0.3604038, -1.2162423),\n (0.3608038, -1.2557576),\n (0.36120382, -1.2944796),\n (0.36160383, -1.3323841),\n (0.36200383, -1.369447),\n (0.36240384, -1.4056448),\n (0.36280385, -1.4409548),\n (0.36320385, -1.4753546),\n (0.36360386, -1.5088226),\n (0.36400387, -1.5413374),\n (0.36440387, -1.5728787),\n (0.36480388, -1.6034266),\n (0.3652039, -1.6329616),\n (0.3656039, -1.6614652),\n (0.3660039, -1.6889193),\n (0.3664039, -1.7153066),\n (0.3668039, -1.7406105),\n (0.36720392, -1.764815),\n (0.36760393, -1.7879047),\n (0.36800393, -1.8098651),\n (0.36840394, -1.8306823),\n (0.36880395, -1.8503432),\n (0.36920395, -1.8688353),\n (0.36960396, -1.886147),\n (0.37000397, -1.9022673),\n (0.37040398, -1.9171861),\n (0.37080398, -1.9308939),\n (0.371204, -1.9433821),\n (0.371604, -1.9546428),\n (0.372004, -1.9646688),\n (0.372404, -1.9734539),\n (0.37280402, -1.9809924),\n (0.37320402, -1.9872797),\n (0.37360403, -1.9923117),\n (0.37400404, -1.9960853),\n (0.37440404, -1.998598),\n (0.37480405, -1.9998485),\n (0.37520406, -1.9998356),\n (0.37560406, -1.9985595),\n (0.37600407, -1.996021),\n (0.37640408, -1.9922218),\n (0.37680408, -1.9871643),\n (0.3772041, -1.9808515),\n (0.3776041, -1.9732876),\n (0.3780041, -1.9644772),\n (0.3784041, -1.9544259),\n (0.37880412, -1.9431403),\n (0.37920412, -1.9306272),\n (0.37960413, -1.9168947),\n (0.38000414, -1.9019513),\n (0.38040414, -1.8858067),\n (0.38080415, -1.8684709),\n (0.38120416, -1.8499548),\n (0.38160416, -1.8302703),\n (0.38200417, -1.8094296),\n (0.38240418, -1.7874461),\n (0.3828042, -1.7643336),\n (0.3832042, -1.7401067),\n (0.3836042, -1.7147806),\n (0.3840042, -1.6883714),\n (0.3844042, -1.6608957),\n (0.38480422, -1.632371),\n (0.38520423, -1.6028152),\n (0.38560423, -1.5722469),\n (0.38600424, -1.5406855),\n (0.38640425, -1.508151),\n (0.38680425, -1.474664),\n (0.38720426, -1.4402454),\n (0.38760427, -1.4049171),\n (0.38800427, -1.3687015),\n (0.38840428, -1.3316213),\n (0.3888043, -1.2937),\n (0.3892043, -1.2549615),\n (0.3896043, -1.2154304),\n (0.3900043, -1.1751316),\n (0.3904043, -1.1340904),\n (0.39080432, -1.092333),\n (0.39120433, -1.0498855),\n (0.39160433, -1.0067749),\n (0.39200434, -0.96302843),\n (0.39240435, -0.91867363),\n (0.39280435, -0.8737386),\n (0.39320436, -0.8282516),\n (0.39360437, -0.7822415),\n (0.39400437, -0.7357373),\n (0.39440438, -0.6887684),\n (0.3948044, -0.6413644),\n (0.3952044, -0.59355533),\n (0.3956044, -0.54537135),\n (0.3960044, -0.49684283),\n (0.39640442, -0.44800055),\n (0.39680442, -0.3988715),\n (0.39720443, -0.34949428),\n (0.39760444, -0.29989627),\n (0.39800444, -0.25010884),\n (0.39840445, -0.20016342),\n (0.39880446, -0.15009159),\n (0.39920446, -9.992494e-2),\n (0.39960447, -4.9695175e-2),\n (0.40000448, 5.659739e-4),\n (0.40040448, 5.0826766e-2),\n (0.4008045, 0.10105546),\n (0.4012045, 0.15122032),\n (0.4016045, 0.20128965),\n (0.4020045, 0.25123185),\n (0.40240452, 0.30101538),\n (0.40280452, 0.35060874),\n (0.40320453, 0.39998066),\n (0.40360454, 0.44909993),\n (0.40400454, 0.49793553),\n (0.40440455, 0.54645663),\n (0.40480456, 0.59463257),\n (0.40520456, 0.64243287),\n (0.40560457, 0.68982744),\n (0.40600458, 0.73678625),\n (0.40640458, 0.78327966),\n (0.4068046, 0.82927835),\n (0.4072046, 0.87475324),\n (0.4076046, 0.9196756),\n (0.4080046, 0.96401703),\n (0.40840462, 1.0077496),\n (0.40880463, 1.0508455),\n (0.40920463, 1.0932778),\n (0.40960464, 1.1350194),\n (0.41000465, 1.1760442),\n (0.41040465, 1.2163261),\n (0.41080466, 1.2558397),\n (0.41120467, 1.2945601),\n (0.41160467, 1.3324628),\n (0.41200468, 1.3695239),\n (0.4124047, 1.4057199),\n (0.4128047, 1.441028),\n (0.4132047, 1.4754258),\n (0.4136047, 1.5088918),\n (0.4140047, 1.5414046),\n (0.41440472, 1.5729439),\n (0.41480473, 1.6034896),\n (0.41520473, 1.6330225),\n (0.41560474, 1.6615239),\n (0.41600475, 1.6889758),\n (0.41640475, 1.7153609),\n (0.41680476, 1.7406625),\n (0.41720477, 1.7648647),\n (0.41760477, 1.787952),\n (0.41800478, 1.80991),\n (0.4184048, 1.8307248),\n (0.4188048, 1.8503847),\n (0.4192048, 1.8688743),\n (0.4196048, 1.8861834),\n (0.4200048, 1.9023011),\n (0.42040482, 1.9172173),\n (0.42080483, 1.9309224),\n (0.42120484, 1.9434079),\n (0.42160484, 1.9546659),\n (0.42200485, 1.9646893),\n (0.42240486, 1.9734716),\n (0.42280486, 1.9810075),\n (0.42320487, 1.9872919),\n (0.42360488, 1.9923213),\n (0.42400488, 1.9960921),\n (0.4244049, 1.9986022),\n (0.4248049, 1.9998498),\n (0.4252049, 1.9998342),\n (0.4256049, 1.9985555),\n (0.42600492, 1.9960144),\n (0.42640492, 1.9922125),\n (0.42680493, 1.9871523),\n (0.42720494, 1.9808369),\n (0.42760494, 1.9732703),\n (0.42800495, 1.9644574),\n (0.42840496, 1.9544035),\n (0.42880496, 1.9431152),\n (0.42920497, 1.9305997),\n (0.42960498, 1.9168645),\n (0.43000498, 1.9019186),\n (0.430405, 1.8857715),\n (0.430805, 1.8684332),\n (0.431205, 1.8499147),\n (0.431605, 1.8302277),\n (0.43200502, 1.8093847),\n (0.43240502, 1.7873988),\n (0.43280503, 1.7642839),\n (0.43320504, 1.7400546),\n (0.43360505, 1.7147262),\n (0.43400505, 1.6883148),\n (0.43440506, 1.6608369),\n (0.43480507, 1.6323099),\n (0.43520507, 1.602752),\n (0.43560508, 1.5721817),\n (0.4360051, 1.5406183),\n (0.4364051, 1.5080818),\n (0.4368051, 1.4745927),\n (0.4372051, 1.4401722),\n (0.4376051, 1.404842),\n (0.43800512, 1.3686246),\n (0.43840513, 1.3315425),\n (0.43880513, 1.2936195),\n (0.43920514, 1.2548794),\n (0.43960515, 1.2153466),\n (0.44000515, 1.1750461),\n (0.44040516, 1.1340003),\n (0.44080517, 1.0922413),\n (0.44120517, 1.0497924),\n (0.44160518, 1.0066804),\n (0.4420052, 0.9629326),\n (0.4424052, 0.9185765),\n (0.4428052, 0.8736402),\n (0.4432052, 0.82815206),\n (0.4436052, 0.78214085),\n (0.44400522, 0.73563564),\n (0.44440523, 0.6886657),\n (0.44480523, 0.6412608),\n (0.44520524, 0.5934509),\n (0.44560525, 0.5452661),\n (0.44600525, 0.4967369),\n (0.44640526, 0.44789395),\n (0.44680527, 0.39876807),\n (0.44720528, 0.34939033),\n (0.44760528, 0.2997919),\n (0.4480053, 0.2500041),\n (0.4484053, 0.2000584),\n (0.4488053, 0.14998633),\n (0.4492053, 9.981951e-2),\n (0.44960532, 4.9589653e-2),\n (0.45000532, -6.715298e-4),\n (0.45040533, -5.093229e-2),\n (0.45080534, -0.10116088),\n (0.45120534, -0.15132557),\n (0.45160535, -0.20139468),\n (0.45200536, -0.25133657),\n (0.45240536, -0.30111971),\n (0.45280537, -0.35071266),\n (0.45320538, -0.40008408),\n (0.45360538, -0.4492028),\n (0.4540054, -0.49803776),\n (0.4544054, -0.54655814),\n (0.4548054, -0.5947333),\n (0.4552054, -0.6425328),\n (0.45560542, -0.6899265),\n (0.45600542, -0.73688436),\n (0.45640543, -0.7833768),\n (0.45680544, -0.8293744),\n (0.45720544, -0.8748481),\n (0.45760545, -0.9197693),\n (0.45800546, -0.9641095),\n (0.45840546, -1.0078408),\n (0.45880547, -1.0509354),\n (0.45920548, -1.0933661),\n (0.4596055, -1.1351063),\n (0.4600055, -1.1761296),\n (0.4604055, -1.2164099),\n (0.4608055, -1.2559218),\n (0.4612055, -1.2946405),\n (0.46160552, -1.3325415),\n (0.46200553, -1.3696008),\n (0.46240553, -1.4057977),\n (0.46280554, -1.4411038),\n (0.46320555, -1.4754996),\n (0.46360555, -1.5089636),\n (0.46400556, -1.5414743),\n (0.46440557, -1.5730115),\n (0.46480557, -1.603555),\n (0.46520558, -1.6330856),\n (0.4656056, -1.6615847),\n (0.4660056, -1.6890345),\n (0.4664056, -1.7154171),\n (0.4668056, -1.7407163),\n (0.4672056, -1.7649161),\n (0.46760562, -1.7880011),\n (0.46800563, -1.8099566),\n (0.46840563, -1.8307688),\n (0.46880564, -1.8504248),\n (0.46920565, -1.8689119),\n (0.46960565, -1.8862185),\n (0.47000566, -1.9023337),\n (0.47040567, -1.9172473),\n (0.47080567, -1.9309499),\n (0.47120568, -1.9434329),\n (0.4716057, -1.9546883),\n (0.4720057, -1.964709),\n (0.4724057, -1.9734887),\n (0.4728057, -1.9810219),\n (0.47320572, -1.9873039),\n (0.47360572, -1.9923304),\n (0.47400573, -1.9960986),\n (0.47440574, -1.9986061),\n (0.47480574, -1.9998511),\n (0.47520575, -1.9998329),\n (0.47560576, -1.9985515),\n (0.47600576, -1.9960077),\n (0.47640577, -1.9922032),\n (0.47680578, -1.9871403),\n (0.47720578, -1.9808223),\n (0.4776058, -1.9732531),\n (0.4780058, -1.9644376),\n (0.4784058, -1.9543811),\n (0.4788058, -1.9430903),\n (0.47920582, -1.930572),\n (0.47960582, -1.9168345),\n (0.48000583, -1.9018861),\n (0.48040584, -1.8857363),\n (0.48080584, -1.8683956),\n (0.48120585, -1.8498746),\n (0.48160586, -1.8301852),\n (0.48200586, -1.8093398),\n (0.48240587, -1.7873515),\n (0.48280588, -1.7642342),\n (0.48320588, -1.7400026),\n (0.4836059, -1.714672),\n (0.4840059, -1.6882582),\n (0.4844059, -1.6607759),\n (0.4848059, -1.6322467),\n (0.48520592, -1.6026865),\n (0.48560593, -1.572114),\n (0.48600593, -1.5405486),\n (0.48640594, -1.5080099),\n (0.48680595, -1.4745188),\n (0.48720595, -1.4400963),\n (0.48760596, -1.4047642),\n (0.48800597, -1.3685448),\n (0.48840597, -1.331461),\n (0.48880598, -1.2935361),\n (0.489206, -1.2547941),\n (0.489606, -1.2152597),\n (0.490006, -1.1749576),\n (0.490406, -1.1339134),\n (0.490806, -1.0921528),\n (0.49120602, -1.0497025),\n (0.49160603, -1.0065892),\n (0.49200603, -0.96284),\n (0.49240604, -0.9184827),\n (0.49280605, -0.8735452),\n (0.49320605, -0.828056),\n (0.49360606, -0.7820437),\n (0.49400607, -0.73553747),\n (0.49440607, -0.6885666),\n (0.49480608, -0.64116085),\n (0.4952061, -0.5933501),\n (0.4956061, -0.5451645),\n (0.4960061, -0.49663466),\n (0.4964061, -0.44779107),\n (0.49680611, -0.39866465),\n (0.49720612, -0.3492864),\n (0.49760613, -0.29968753),\n (0.49800614, -0.24989937),\n (0.49840614, -0.19995338),\n (0.49880615, -0.14988106),\n (0.49920616, -9.971409e-2),\n (0.49960616, -4.948413e-2),\n (0.50000614, 7.7327096e-4),\n (0.50040615, 5.1033996e-2),\n (0.50080615, 0.10126249),\n (0.50120616, 0.15142702),\n (0.50160617, 0.2014959),\n (0.5020062, 0.25143752),\n (0.5024062, 0.3012203),\n (0.5028062, 0.35081282),\n (0.5032062, 0.40018377),\n (0.5036062, 0.44930193),\n (0.5040062, 0.4981363),\n (0.5044062, 0.546656),\n (0.5048062, 0.59483045),\n (0.5052062, 0.6426292),\n (0.50560623, 0.690022),\n (0.50600624, 0.73698246),\n (0.50640625, 0.7834739),\n (0.50680625, 0.82947046),\n (0.50720626, 0.8749431),\n (0.50760627, 0.91986305),\n (0.5080063, 0.964202),\n (0.5084063, 1.0079318),\n (0.5088063, 1.0510252),\n (0.5092063, 1.0934545),\n (0.5096063, 1.1351901),\n (0.5100063, 1.1762149),\n (0.5104063, 1.2164906),\n (0.5108063, 1.256004),\n (0.5112063, 1.2947181),\n (0.51160634, 1.3326203),\n (0.51200634, 1.3696749),\n (0.51240635, 1.4058701),\n (0.51280636, 1.4411718),\n (0.51320636, 1.4755684),\n (0.51360637, 1.5090278),\n (0.5140064, 1.5415392),\n (0.5144064, 1.573072),\n (0.5148064, 1.6036158),\n (0.5152064, 1.6331422),\n (0.5156064, 1.6616414),\n (0.5160064, 1.6890868),\n (0.5164064, 1.7154695),\n (0.5168064, 1.7407683),\n (0.51720643, 1.764964),\n (0.51760644, 1.7880483),\n (0.51800644, 1.8099998),\n (0.51840645, 1.8308114),\n (0.51880646, 1.8504634),\n (0.51920646, 1.8689494),\n (0.5196065, 1.8862523),\n (0.5200065, 1.9023663),\n (0.5204065, 1.9172763),\n (0.5208065, 1.9309775),\n (0.5212065, 1.9434569),\n (0.5216065, 1.9547106),\n (0.5220065, 1.964728),\n (0.5224065, 1.9735059),\n (0.5228065, 1.981036),\n (0.52320653, 1.9873157),\n (0.52360654, 1.9923394),\n (0.52400655, 1.9961053),\n (0.52440655, 1.9986099),\n (0.52480656, 1.9998523),\n (0.52520657, 1.9998316),\n (0.5256066, 1.9985474),\n (0.5260066, 1.9960012),\n (0.5264066, 1.9921939),\n (0.5268066, 1.9871289),\n (0.5272066, 1.9808078),\n (0.5276066, 1.9732366),\n (0.5280066, 1.9644177),\n (0.5284066, 1.9543595),\n (0.5288066, 1.9430653),\n (0.52920663, 1.9305454),\n (0.52960664, 1.9168043),\n (0.53000665, 1.9018546),\n (0.53040665, 1.8857012),\n (0.53080666, 1.8683592),\n (0.53120667, 1.8498344),\n (0.5316067, 1.8301442),\n (0.5320067, 1.8092948),\n (0.5324067, 1.7873058),\n (0.5328067, 1.7641845),\n (0.5332067, 1.7399524),\n (0.5336067, 1.7146176),\n (0.5340067, 1.6882037),\n (0.5344067, 1.6607193),\n (0.5348067, 1.6321901),\n (0.53520674, 1.6026257),\n (0.53560674, 1.5720536),\n (0.53600675, 1.5404836),\n (0.53640676, 1.5079455),\n (0.53680676, 1.4744501),\n (0.53720677, 1.4400283),\n (0.5376068, 1.4046918),\n (0.5380068, 1.3684734),\n (0.5384068, 1.331385),\n (0.5388068, 1.2934556),\n (0.5392068, 1.254715),\n (0.5396068, 1.2151759),\n (0.5400068, 1.1748753),\n (0.5404068, 1.1338264),\n (0.54080683, 1.0920676),\n (0.54120684, 1.0496128),\n (0.54160684, 1.0065013),\n (0.54200685, 0.9627475),\n (0.54240686, 0.91839236),\n (0.54280686, 0.8734503),\n (0.5432069, 0.82796335),\n (0.5436069, 0.78194654),\n (0.5440069, 0.7354429),\n (0.5444069, 0.6884675),\n (0.5448069, 0.64106447),\n (0.5452069, 0.59324926),\n (0.5456069, 0.54506665),\n (0.5460069, 0.4965324),\n (0.5464069, 0.44769192),\n (0.54680693, 0.3985612),\n (0.54720694, 0.3491862),\n (0.54760695, 0.29958317),\n (0.54800695, 0.24979843),\n (0.54840696, 0.19984834),\n (0.54880697, 0.1497796),\n (0.549207, 9.960867e-2),\n (0.549607, 4.938242e-2),\n (0.550007, -8.826415e-4),\n (0.550407, -5.113952e-2),\n (0.550807, -0.10137172),\n (0.551207, -0.15153226),\n (0.551607, -0.20160471),\n (0.552007, -0.25154224),\n (0.552407, -0.30132842),\n (0.55280703, -0.35091674),\n (0.55320704, -0.40029094),\n (0.55360705, -0.44940478),\n (0.55400705, -0.49824223),\n (0.55440706, -0.5467576),\n (0.55480707, -0.5949349),\n (0.5552071, -0.64272916),\n (0.5556071, -0.69012463),\n (0.5560071, -0.73707706),\n (0.5564071, -0.783571),\n (0.5568071, -0.829563),\n (0.5572071, -0.87503797),\n (0.5576071, -0.91995335),\n (0.5580071, -0.96429443),\n (0.5584071, -1.0080198),\n (0.55880713, -1.0511149),\n (0.55920714, -1.0935397),\n (0.55960715, -1.1352801),\n (0.56000715, -1.1762972),\n (0.56040716, -1.2165774),\n (0.56080717, -1.2560891),\n (0.5612072, -1.2948015),\n (0.5616072, -1.3327018),\n (0.5620072, -1.3697547),\n (0.5624072, -1.4059478),\n (0.5628072, -1.4412476),\n (0.5632072, -1.4756422),\n (0.5636072, -1.5090996),\n (0.5640072, -1.5416088),\n (0.5644072, -1.5731394),\n (0.56480724, -1.6036812),\n (0.56520724, -1.6332053),\n (0.56560725, -1.6617023),\n (0.56600726, -1.6891454),\n (0.56640726, -1.7155256),\n (0.56680727, -1.7408185),\n (0.5672073, -1.7650154),\n (0.5676073, -1.7880939),\n (0.5680073, -1.8100463),\n (0.5684073, -1.8308523),\n (0.5688073, -1.8505049),\n (0.5692073, -1.8689857),\n (0.5696073, -1.8862886),\n (0.5700073, -1.9023976),\n (0.57040733, -1.9173074),\n (0.57080734, -1.9310039),\n (0.57120734, -1.9434828),\n (0.57160735, -1.9547322),\n (0.57200736, -1.9647485),\n (0.57240736, -1.9735223),\n (0.5728074, -1.981051),\n (0.5732074, -1.9873271),\n (0.5736074, -1.9923489),\n (0.5740074, -1.9961116),\n (0.5744074, -1.998614),\n (0.5748074, -1.9998536),\n (0.5752074, -1.9998301),\n (0.5756074, -1.9985436),\n (0.5760074, -1.9959943),\n (0.57640743, -1.9921849),\n (0.57680744, -1.9871165),\n (0.57720745, -1.9807937),\n (0.57760745, -1.9732187),\n (0.57800746, -1.9643986),\n (0.57840747, -1.9543363),\n (0.5788075, -1.9430412),\n (0.5792075, -1.930517),\n (0.5796075, -1.9167752),\n (0.5800075, -1.9018208),\n (0.5804075, -1.8856673),\n (0.5808075, -1.8683202),\n (0.5812075, -1.8497958),\n (0.5816075, -1.8301),\n (0.5820075, -1.8092514),\n (0.58240753, -1.7872567),\n (0.58280754, -1.764133),\n (0.58320755, -1.7398984),\n (0.58360755, -1.7145612),\n (0.58400756, -1.688145),\n (0.58440757, -1.6606584),\n (0.5848076, -1.6321269),\n (0.5852076, -1.6025603),\n (0.5856076, -1.5719858),\n (0.5860076, -1.5404139),\n (0.5864076, -1.5078738),\n (0.5868076, -1.4743762),\n (0.5872076, -1.4399525),\n (0.5876076, -1.404614),\n (0.5880076, -1.3683937),\n (0.58840764, -1.3313034),\n (0.58880764, -1.293378),\n (0.58920765, -1.2546297),\n (0.58960766, -1.215095),\n (0.59000766, -1.1747867),\n (0.59040767, -1.1337426),\n (0.5908077, -1.091976),\n (0.5912077, -1.0495261),\n (0.5916077, -1.0064068),\n (0.5920077, -0.96265835),\n (0.5924077, -0.9182952),\n (0.5928077, -0.8733587),\n (0.5932077, -0.8278638),\n (0.5936077, -0.7818529),\n (0.59400773, -0.73534113),\n (0.59440774, -0.688372),\n (0.59480774, -0.6409609),\n (0.59520775, -0.5931521),\n (0.59560776, -0.5449614),\n (0.59600776, -0.49643385),\n (0.5964078, -0.4475853),\n (0.5968078, -0.3984615),\n (0.5972078, -0.34907854),\n (0.5976078, -0.29948258),\n (0.5980078, -0.24968992),\n (0.5984078, -0.19974712),\n (0.5988078, -0.14967054),\n (0.5992078, -9.950705e-2),\n (0.5996078, -4.927308e-2),\n (0.60000783, 9.843827e-4),\n (0.60040784, 5.1248852e-2),\n (0.60080785, 0.10147333),\n (0.60120785, 0.15164132),\n (0.60160786, 0.20170593),\n (0.60200787, 0.25165072),\n (0.6024079, 0.301429),\n (0.6028079, 0.35102442),\n (0.6032079, 0.4003906),\n (0.6036079, 0.44951135),\n (0.6040079, 0.49834076),\n (0.6044079, 0.5468628),\n (0.6048079, 0.5950393),\n (0.6052079, 0.6428327),\n (0.6056079, 0.69022727),\n (0.60600793, 0.73717874),\n (0.60640794, 0.7836717),\n (0.60680795, 0.82966256),\n (0.60720795, 0.8751363),\n (0.60760796, 0.9200505),\n (0.60800797, 0.9643903),\n (0.608408, 1.0081142),\n (0.608808, 1.051208),\n (0.609208, 1.0936313),\n (0.609608, 1.1353701),\n (0.610008, 1.1763856),\n (0.610408, 1.2166643),\n (0.610808, 1.2561682),\n (0.611208, 1.2948848),\n (0.611608, 1.3327776),\n (0.61200804, 1.3698343),\n (0.61240804, 1.4060202),\n (0.61280805, 1.4413234),\n (0.61320806, 1.4757109),\n (0.61360806, 1.5091714),\n (0.61400807, 1.5416737),\n (0.6144081, 1.573207),\n (0.6148081, 1.6037419),\n (0.6152081, 1.6332685),\n (0.6156081, 1.6617589),\n (0.6160081, 1.689204),\n (0.6164081, 1.715578),\n (0.6168081, 1.7408723),\n (0.6172081, 1.7650633),\n (0.61760813, 1.7881429),\n (0.61800814, 1.8100896),\n (0.61840814, 1.8308963),\n (0.61880815, 1.8505435),\n (0.61920816, 1.8690246),\n (0.61960816, 1.8863225),\n (0.6200082, 1.9024315),\n (0.6204082, 1.9173363),\n (0.6208082, 1.9310324),\n (0.6212082, 1.9435067),\n (0.6216082, 1.9547553),\n (0.6220082, 1.9647675),\n (0.6224082, 1.9735401),\n (0.6228082, 1.9810649),\n (0.6232082, 1.9873394),\n (0.62360823, 1.9923579),\n (0.62400824, 1.9961184),\n (0.62440825, 1.9986178),\n (0.62480825, 1.9998549),\n (0.62520826, 1.9998288),\n (0.62560827, 1.9985394),\n (0.6260083, 1.9959879),\n (0.6264083, 1.9921752),\n (0.6268083, 1.987104),\n (0.6272083, 1.9807786),\n (0.6276083, 1.9732009),\n (0.6280083, 1.9643781),\n (0.6284083, 1.954313),\n (0.6288083, 1.9430152),\n (0.6292083, 1.9304883),\n (0.62960833, 1.916744),\n (0.63000834, 1.9017869),\n (0.63040835, 1.8856308),\n (0.63080835, 1.8682812),\n (0.63120836, 1.8497542),\n (0.63160837, 1.830056),\n (0.6320084, 1.8092048),\n (0.6324084, 1.7872076),\n (0.6328084, 1.764085),\n (0.6332084, 1.7398446),\n (0.6336084, 1.7145089),\n (0.6340084, 1.6880864),\n (0.6344084, 1.6606016),\n (0.6348084, 1.6320637),\n (0.6352084, 1.6024994),\n (0.63560843, 1.5719182),\n (0.63600844, 1.540349),\n (0.63640845, 1.5078019),\n (0.63680845, 1.4743074),\n (0.63720846, 1.4398766),\n (0.63760847, 1.4045415),\n (0.6380085, 1.3683138),\n (0.6384085, 1.3312274),\n (0.6388085, 1.2932945),\n (0.6392085, 1.2545506),\n (0.6396085, 1.2150081),\n (0.6400085, 1.1747044),\n (0.6404085, 1.1336524),\n (0.6408085, 1.0918908),\n (0.6412085, 1.049433),\n (0.64160854, 1.0063188),\n (0.64200854, 0.9625625),\n (0.64240855, 0.9182048),\n (0.64280856, 0.8732604),\n (0.64320856, 0.8277712),\n (0.64360857, 0.7817522),\n (0.6440086, 0.73524654),\n (0.6444086, 0.6882693),\n (0.6448086, 0.6408645),\n (0.6452086, 0.5930477),\n (0.6456086, 0.5448635),\n (0.6460086, 0.4963279),\n (0.6464086, 0.44748616),\n (0.6468086, 0.39835432),\n (0.64720863, 0.34897834),\n (0.64760864, 0.29937443),\n (0.64800864, 0.24958897),\n (0.64840865, 0.19963829),\n (0.64880866, 0.14956148),\n (0.64920866, 9.9397816e-2),\n (0.6496087, 4.9163744e-2),\n (0.6500087, -1.0937531e-3),\n (0.6504087, -5.135819e-2),\n (0.6508087, -0.10158256),\n (0.6512087, -0.15175039),\n (0.6516087, -0.20181474),\n (0.6520087, -0.25175923),\n (0.6524087, -0.30153713),\n (0.6528087, -0.3511321),\n (0.65320873, -0.40049776),\n (0.65360874, -0.44961792),\n (0.65400875, -0.49844667),\n (0.65440875, -0.546968),\n (0.65480876, -0.59513646),\n (0.65520877, -0.6429363),\n (0.6556088, -0.69032276),\n (0.6560088, -0.7372804),\n (0.6564088, -0.78376526),\n (0.6568088, -0.82976204),\n (0.6572088, -0.8752278),\n (0.6576088, -0.9201476),\n (0.6580088, -0.9644794),\n (0.6584088, -1.0082086),\n (0.6588088, -1.0512946),\n (0.65920883, -1.0937228),\n (0.65960884, -1.1354539),\n (0.66000885, -1.1764741),\n (0.66040885, -1.216745),\n (0.66080886, -1.2562534),\n (0.66120887, -1.2949624),\n (0.6616089, -1.3328592),\n (0.6620089, -1.3699085),\n (0.6624089, -1.406098),\n (0.6628089, -1.4413939),\n (0.6632089, -1.4757847),\n (0.6636089, -1.5092381),\n (0.6640089, -1.5417433),\n (0.6644089, -1.5732698),\n (0.6648089, -1.6038073),\n (0.66520894, -1.6333271),\n (0.66560894, -1.6618198),\n (0.66600895, -1.6892585),\n (0.66640896, -1.7156342),\n (0.66680896, -1.7409223),\n (0.66720897, -1.7651147),\n (0.667609, -1.7881885),\n (0.668009, -1.8101362),\n (0.668409, -1.8309373),\n (0.668809, -1.850585),\n (0.669209, -1.8690609),\n (0.669609, -1.8863589),\n (0.670009, -1.9024628),\n (0.670409, -1.9173675),\n (0.67080903, -1.9310609),\n (0.67120904, -1.9435326),\n (0.67160904, -1.9547784),\n (0.67200905, -1.964788),\n (0.67240906, -1.9735578),\n (0.67280906, -1.9810799),\n (0.6732091, -1.9873518),\n (0.6736091, -1.9923674),\n (0.6740091, -1.9961252),\n (0.6744091, -1.9986218),\n (0.6748091, -1.9998562),\n (0.6752091, -1.9998274),\n (0.6756091, -1.9985352),\n (0.6760091, -1.995981),\n (0.6764091, -1.9921656),\n (0.67680913, -1.9870925),\n (0.67720914, -1.9807634),\n (0.67760915, -1.9731842),\n (0.67800915, -1.9643575),\n (0.67840916, -1.9542915),\n (0.67880917, -1.9429893),\n (0.6792092, -1.9304618),\n (0.6796092, -1.9167128),\n (0.6800092, -1.9017553),\n (0.6804092, -1.8855944),\n (0.6808092, -1.8682449),\n (0.6812092, -1.8497126),\n (0.6816092, -1.830015),\n (0.6820092, -1.8091582),\n (0.6824092, -1.787162),\n (0.68280923, -1.7640334),\n (0.68320924, -1.7397944),\n (0.68360925, -1.7144526),\n (0.68400925, -1.6880318),\n (0.68440926, -1.6605407),\n (0.68480927, -1.632005),\n (0.6852093, -1.6024339),\n (0.6856093, -1.5718554),\n (0.6860093, -1.5402793),\n (0.6864093, -1.507735),\n (0.6868093, -1.4742335),\n (0.6872093, -1.439806),\n (0.6876093, -1.4044636),\n (0.6880093, -1.3682396),\n (0.6884093, -1.3311459),\n (0.68880934, -1.293217),\n (0.68920934, -1.2544653),\n (0.68960935, -1.2149273),\n (0.69000936, -1.1746159),\n (0.69040936, -1.1335686),\n (0.69080937, -1.0917991),\n (0.6912094, -1.0493463),\n (0.6916094, -1.0062243),\n (0.6920094, -0.9624666),\n (0.6924094, -0.9181076),\n (0.6928094, -0.873162),\n (0.6932094, -0.82767165),\n (0.6936094, -0.78165156),\n (0.6940094, -0.7351448),\n (0.69440943, -0.6881666),\n (0.69480944, -0.6407609),\n (0.69520944, -0.5929432),\n (0.69560945, -0.5447583),\n (0.69600946, -0.49622196),\n (0.69640946, -0.44737956),\n (0.6968095, -0.39824715),\n (0.6972095, -0.34887066),\n (0.6976095, -0.2992663),\n (0.6980095, -0.24948046),\n (0.6984095, -0.19952947),\n (0.6988095, -0.14946003),\n (0.6992095, -9.9288575e-2),\n (0.6996095, -4.9062036e-2),\n (0.7000095, 1.2031237e-3),\n (0.70040953, 5.1459894e-2),\n (0.70080954, 0.10169179),\n (0.70120955, 0.15185183),\n (0.70160955, 0.20192356),\n (0.70200956, 0.25186017),\n (0.70240957, 0.30164525),\n (0.7028096, 0.35123226),\n (0.7032096, 0.4006049),\n (0.7036096, 0.44971707),\n (0.7040096, 0.4985526),\n (0.7044096, 0.54706585),\n (0.7048096, 0.59524083),\n (0.7052096, 0.6430326),\n (0.7056096, 0.69042546),\n (0.7060096, 0.73737496),\n (0.70640963, 0.78386587),\n (0.70680964, 0.8298546),\n (0.70720965, 0.87532616),\n (0.70760965, 0.9202379),\n (0.70800966, 0.96457523),\n (0.70840967, 1.0082965),\n (0.7088097, 1.0513875),\n (0.7092097, 1.093808),\n (0.7096097, 1.135544),\n (0.7100097, 1.1765563),\n (0.7104097, 1.2168318),\n (0.7108097, 1.2563325),\n (0.7112097, 1.2950457),\n (0.7116097, 1.3329351),\n (0.7120097, 1.3699881),\n (0.71240973, 1.4061702),\n (0.71280974, 1.4414697),\n (0.71320975, 1.4758533),\n (0.71360976, 1.5093099),\n (0.71400976, 1.541813),\n (0.71440977, 1.5733373),\n (0.7148098, 1.6038727),\n (0.7152098, 1.6333903),\n (0.7156098, 1.6618806),\n (0.7160098, 1.689317),\n (0.7164098, 1.7156904),\n (0.7168098, 1.7409762),\n (0.7172098, 1.765166),\n (0.7176098, 1.7882375),\n (0.7180098, 1.8101827),\n (0.71840984, 1.8309813),\n (0.71880984, 1.8506265),\n (0.71920985, 1.8690997),\n (0.71960986, 1.8863952),\n (0.72000986, 1.9024966),\n (0.72040987, 1.9173986),\n (0.7208099, 1.9310874),\n (0.7212099, 1.9435583),\n (0.7216099, 1.9547999),\n (0.7220099, 1.9648083),\n (0.7224099, 1.9735743),\n (0.7228099, 1.981095),\n (0.7232099, 1.9873631),\n (0.7236099, 1.9923769),\n (0.72400993, 1.9961315),\n (0.72440994, 1.9986259),\n (0.72480994, 1.9998574),\n (0.72520995, 1.999826),\n (0.72560996, 1.9985313),\n (0.72600996, 1.9959741),\n (0.72641, 1.9921566),\n (0.72681, 1.9870801),\n (0.72721, 1.9807494),\n (0.72761, 1.9731665),\n (0.72801, 1.9643384),\n (0.72841, 1.9542682),\n (0.72881, 1.9429651),\n (0.72921, 1.9304332),\n (0.72961, 1.9166838),\n (0.73001003, 1.9017215),\n (0.73041004, 1.8855605),\n (0.73081005, 1.8682058),\n (0.73121005, 1.8496739),\n (0.73161006, 1.8299707),\n (0.73201007, 1.8091148),\n (0.7324101, 1.7871128),\n (0.7328101, 1.7639855),\n (0.7332101, 1.7397404),\n (0.7336101, 1.7144002),\n (0.7340101, 1.6879731),\n (0.7344101, 1.660484),\n (0.7348101, 1.6319417),\n (0.7352101, 1.6023731),\n (0.7356101, 1.5717877),\n (0.73601013, 1.5402094),\n (0.73641014, 1.5076631),\n (0.73681015, 1.4741596),\n (0.73721015, 1.43973),\n (0.73761016, 1.4043858),\n (0.73801017, 1.3681599),\n (0.7384102, 1.3310642),\n (0.7388102, 1.2931335),\n (0.7392102, 1.2543802),\n (0.7396102, 1.2148404),\n (0.7400102, 1.1745274),\n (0.7404102, 1.1334785),\n (0.7408102, 1.0917075),\n (0.7412102, 1.0492532),\n (0.7416102, 1.0061299),\n (0.74201024, 0.9623774),\n (0.74241024, 0.9180105),\n (0.74281025, 0.8730704),\n (0.74321026, 0.82757205),\n (0.74361026, 0.7815579),\n (0.74401027, 0.7350431),\n (0.7444103, 0.6880711),\n (0.7448103, 0.6406573),\n (0.7452103, 0.59284604),\n (0.7456103, 0.54465306),\n (0.7460103, 0.49612337),\n (0.7464103, 0.44727296),\n (0.7468103, 0.39814743),\n (0.7472103, 0.34876296),\n (0.74761033, 0.2991657),\n (0.74801034, 0.24937195),\n (0.74841034, 0.19942823),\n (0.74881035, 0.14935096),\n (0.74921036, 9.9186964e-2),\n (0.74961036, 4.89527e-2),\n (0.7500104, -1.3048649e-3),\n (0.7504104, -5.156923e-2),\n (0.7508104, -0.10179339),\n (0.7512104, -0.15196088),\n (0.7516104, -0.20202479),\n (0.7520104, -0.25196865),\n (0.7524104, -0.30174583),\n (0.7528104, -0.3513399),\n (0.7532104, -0.4007046),\n (0.75361043, -0.44982365),\n (0.75401044, -0.49865112),\n (0.75441045, -0.54717106),\n (0.75481045, -0.595338),\n (0.75521046, -0.6431362),\n (0.75561047, -0.69052094),\n (0.7560105, -0.73747665),\n (0.7564105, -0.78395945),\n (0.7568105, -0.82995415),\n (0.7572105, -0.87541765),\n (0.7576105, -0.92033505),\n (0.7580105, -0.964671),\n (0.7584105, -1.008391),\n (0.7588105, -1.0514807),\n (0.7592105, -1.0938996),\n (0.75961053, -1.1356341),\n (0.76001054, -1.1766448),\n (0.76041055, -1.2169186),\n (0.76081055, -1.2564176),\n (0.76121056, -1.2951291),\n (0.76161057, -1.3330166),\n (0.7620106, -1.3700678),\n (0.7624106, -1.4062481),\n (0.7628106, -1.4415455),\n (0.7632106, -1.4759271),\n (0.7636106, -1.5093817),\n (0.7640106, -1.5418777),\n (0.7644106, -1.5734049),\n (0.7648106, -1.6039335),\n (0.7652106, -1.6334534),\n (0.76561064, -1.6619372),\n (0.76601064, -1.6893755),\n (0.76641065, -1.7157427),\n (0.76681066, -1.74103),\n (0.76721066, -1.765214),\n (0.76761067, -1.7882864),\n (0.7680107, -1.810226),\n (0.7684107, -1.8310252),\n (0.7688107, -1.850665),\n (0.7692107, -1.8691386),\n (0.7696107, -1.886429),\n (0.7700107, -1.9025303),\n (0.7704107, -1.9174275),\n (0.7708107, -1.9311159),\n (0.77121073, -1.9435823),\n (0.77161074, -1.954823),\n (0.77201074, -1.9648273),\n (0.77241075, -1.973592),\n (0.77281076, -1.9811089),\n (0.77321076, -1.9873754),\n (0.7736108, -1.9923857),\n (0.7740108, -1.9961383),\n (0.7744108, -1.9986296),\n (0.7748108, -1.9998587),\n (0.7752108, -1.9998245),\n (0.7756108, -1.9985272),\n (0.7760108, -1.9959676),\n (0.7764108, -1.9921468),\n (0.7768108, -1.9870685),\n (0.77721083, -1.9807342),\n (0.77761084, -1.9731498),\n (0.77801085, -1.9643178),\n (0.77841085, -1.9542465),\n (0.77881086, -1.9429393),\n (0.77921087, -1.9304066),\n (0.7796109, -1.9166526),\n (0.7800109, -1.9016876),\n (0.7804109, -1.885524),\n (0.7808109, -1.8681668),\n (0.7812109, -1.8496323),\n (0.7816109, -1.8299266),\n (0.7820109, -1.8090682),\n (0.7824109, -1.7870637),\n (0.7828109, -1.763934),\n (0.78321093, -1.7396865),\n (0.78361094, -1.7143439),\n (0.78401095, -1.6879145),\n (0.78441095, -1.660423),\n (0.78481096, -1.6318785),\n (0.78521097, -1.6023077),\n (0.785611, -1.5717201),\n (0.786011, -1.5401446),\n (0.786411, -1.5075914),\n (0.786811, -1.4740908),\n (0.787211, -1.4396541),\n (0.787611, -1.4043133),\n (0.788011, -1.3680801),\n (0.788411, -1.3309883),\n (0.788811, -1.29305),\n (0.78921103, -1.254301),\n (0.78961104, -1.2147536),\n (0.79001105, -1.174445),\n (0.79041106, -1.1333884),\n (0.79081106, -1.0916222),\n (0.79121107, -1.0491601),\n (0.7916111, -1.0060419),\n (0.7920111, -0.9622815),\n (0.7924111, -0.91792005),\n (0.7928111, -0.872972),\n (0.7932111, -0.8274794),\n (0.7936111, -0.78145725),\n (0.7940111, -0.73494846),\n (0.7944111, -0.6879684),\n (0.7948111, -0.6405609),\n (0.79521114, -0.5927416),\n (0.79561114, -0.5445552),\n (0.79601115, -0.49601743),\n (0.79641116, -0.4471738),\n (0.79681116, -0.39804026),\n (0.79721117, -0.3486628),\n (0.7976112, -0.29905757),\n (0.7980112, -0.24927099),\n (0.7984112, -0.1993194),\n (0.7988112, -0.14924951),\n (0.7992112, -9.9077724e-2),\n (0.7996112, -4.8850987e-2),\n (0.8000112, 1.4142354e-3),\n (0.8004112, 5.1670935e-2),\n (0.80081123, 0.10190263),\n (0.80121124, 0.15206233),\n (0.80161124, 0.2021336),\n (0.80201125, 0.25207716),\n (0.80241126, 0.30185392),\n (0.80281126, 0.35144758),\n (0.8032113, 0.40081176),\n (0.8036113, 0.44993022),\n (0.8040113, 0.49875703),\n (0.8044113, 0.5472762),\n (0.8048113, 0.5954424),\n (0.8052113, 0.64323974),\n (0.8056113, 0.6906236),\n (0.8060113, 0.73757833),\n (0.8064113, 0.7840601),\n (0.80681133, 0.8300536),\n (0.80721134, 0.87551594),\n (0.80761135, 0.92043215),\n (0.80801135, 0.9647601),\n (0.80841136, 1.0084854),\n (0.80881137, 1.0515672),\n (0.8092114, 1.0939912),\n (0.8096114, 1.1357177),\n (0.8100114, 1.1767333),\n (0.8104114, 1.2169993),\n (0.8108114, 1.2565027),\n (0.8112114, 1.2952065),\n (0.8116114, 1.3330982),\n (0.8120114, 1.370142),\n (0.8124114, 1.4063258),\n (0.81281143, 1.441616),\n (0.81321144, 1.476001),\n (0.81361145, 1.5094484),\n (0.81401145, 1.5419475),\n (0.81441146, 1.5734677),\n (0.81481147, 1.6039988),\n (0.8152115, 1.6335121),\n (0.8156115, 1.661998),\n (0.8160115, 1.68943),\n (0.8164115, 1.7157989),\n (0.8168115, 1.74108),\n (0.8172115, 1.7652653),\n (0.8176115, 1.788332),\n (0.8180115, 1.8102725),\n (0.8184115, 1.8310661),\n (0.81881154, 1.8507065),\n (0.81921154, 1.8691748),\n (0.81961155, 1.8864653),\n (0.82001156, 1.9025617),\n (0.82041156, 1.9174587),\n (0.82081157, 1.9311423),\n (0.8212116, 1.9436082),\n (0.8216116, 1.9548445),\n (0.8220116, 1.9648478),\n (0.8224116, 1.9736085),\n (0.8228116, 1.9811239),\n (0.8232116, 1.9873868),\n (0.8236116, 1.9923953),\n (0.8240116, 1.9961451),\n (0.82441163, 1.9986336),\n (0.82481164, 1.99986),\n (0.82521164, 1.9998231),\n (0.82561165, 1.9985229),\n (0.82601166, 1.9959607),\n (0.82641166, 1.9921372),\n (0.8268117, 1.9870561),\n (0.8272117, 1.9807191),\n (0.8276117, 1.9731319),\n (0.8280117, 1.9642973),\n (0.8284117, 1.9542233),\n (0.8288117, 1.9429133),\n (0.8292117, 1.930378),\n (0.8296117, 1.9166213),\n (0.8300117, 1.9016562),\n (0.83041173, 1.8854876),\n (0.83081174, 1.8681304),\n (0.83121175, 1.8495907),\n (0.83161175, 1.8298856),\n (0.83201176, 1.8090215),\n (0.83241177, 1.7870181),\n (0.8328118, 1.7638824),\n (0.8332118, 1.7396363),\n (0.8336118, 1.7142875),\n (0.8340118, 1.6878599),\n (0.8344118, 1.660362),\n (0.8348118, 1.6318196),\n (0.8352118, 1.6022421),\n (0.8356118, 1.5716572),\n (0.8360118, 1.5400748),\n (0.83641183, 1.5075245),\n (0.83681184, 1.4740169),\n (0.83721185, 1.4395834),\n (0.83761185, 1.4042355),\n (0.83801186, 1.3680059),\n (0.83841187, 1.3309066),\n (0.8388119, 1.2929724),\n (0.8392119, 1.2542157),\n (0.8396119, 1.2146728),\n (0.8400119, 1.1743565),\n (0.8404119, 1.1333046),\n (0.8408119, 1.0915306),\n (0.8412119, 1.0490736),\n (0.8416119, 1.0059474),\n (0.8420119, 0.96219236),\n (0.84241194, 0.9178229),\n (0.84281194, 0.8728805),\n (0.84321195, 0.8273799),\n (0.84361196, 0.7813636),\n (0.84401196, 0.7348468),\n (0.84441197, 0.6878728),\n (0.844812, 0.6404573),\n (0.845212, 0.5926444),\n (0.845612, 0.5444499),\n (0.846012, 0.49591148),\n (0.846412, 0.4470672),\n (0.846812, 0.39793307),\n (0.847212, 0.3485551),\n (0.847612, 0.29894942),\n (0.84801203, 0.24916248),\n (0.84841204, 0.19921057),\n (0.84881204, 0.14914043),\n (0.84921205, 9.896849e-2),\n (0.84961206, 4.874165e-2),\n (0.85001206, -1.5236059e-3),\n (0.8504121, -5.1780272e-2),\n (0.8508121, -0.10201185),\n (0.8512121, -0.15217139),\n (0.8516121, -0.2022424),\n (0.8520121, -0.25217807),\n (0.8524121, -0.30196205),\n (0.8528121, -0.35154775),\n (0.8532121, -0.4009189),\n (0.8536121, -0.45002934),\n (0.85401213, -0.49886295),\n (0.85441214, -0.54737407),\n (0.85481215, -0.5955468),\n (0.85521215, -0.64333606),\n (0.85561216, -0.6907262),\n (0.85601217, -0.73767287),\n (0.8564122, -0.78416073),\n (0.8568122, -0.8301462),\n (0.8572122, -0.8756143),\n (0.8576122, -0.92052245),\n (0.8580122, -0.9648559),\n (0.8584122, -1.0085733),\n (0.8588122, -1.0516602),\n (0.8592122, -1.0940763),\n (0.8596122, -1.1358078),\n (0.86001223, -1.1768155),\n (0.86041224, -1.2170861),\n (0.86081225, -1.2565819),\n (0.86121225, -1.2952899),\n (0.86161226, -1.333174),\n (0.86201227, -1.3702216),\n (0.8624123, -1.4063982),\n (0.8628123, -1.4416919),\n (0.8632123, -1.4760696),\n (0.8636123, -1.5095202),\n (0.8640123, -1.5420122),\n (0.8644123, -1.5735352),\n (0.8648123, -1.6040595),\n (0.8652123, -1.6335752),\n (0.8656123, -1.6620547),\n (0.86601233, -1.6894885),\n (0.86641234, -1.7158512),\n (0.86681235, -1.7411339),\n (0.86721236, -1.7653131),\n (0.86761236, -1.788381),\n (0.86801237, -1.810319),\n (0.8684124, -1.8311101),\n (0.8688124, -1.850748),\n (0.8692124, -1.8692137),\n (0.8696124, -1.8865017),\n (0.8700124, -1.9025954),\n (0.8704124, -1.9174898),\n (0.8708124, -1.9311707),\n (0.8712124, -1.9436339),\n (0.8716124, -1.9548676),\n (0.87201244, -1.9648682),\n (0.87241244, -1.9736263),\n (0.87281245, -1.9811388),\n (0.87321246, -1.9873991),\n (0.87361246, -1.9924048),\n (0.8740125, -1.9961514),\n (0.8744125, -1.9986377),\n (0.8748125, -1.9998612),\n (0.8752125, -1.9998217),\n (0.8756125, -1.9985191),\n (0.8760125, -1.9959537),\n (0.8764125, -1.9921283),\n (0.8768125, -1.9870437),\n (0.8772125, -1.9807049),\n (0.87761253, -1.973114),\n (0.87801254, -1.9642781),\n (0.87841254, -1.9542),\n (0.87881255, -1.9428892),\n (0.87921256, -1.9303493),\n (0.87961257, -1.9165922),\n (0.8800126, -1.9016223),\n (0.8804126, -1.8854536),\n (0.8808126, -1.8680915),\n (0.8812126, -1.849552),\n (0.8816126, -1.8298414),\n (0.8820126, -1.8089781),\n (0.8824126, -1.786969),\n (0.8828126, -1.7638345),\n (0.8832126, -1.7395823),\n (0.88361263, -1.7142351),\n (0.88401264, -1.6878012),\n (0.88441265, -1.6603053),\n (0.88481265, -1.6317564),\n (0.88521266, -1.6021813),\n (0.88561267, -1.5715896),\n (0.8860127, -1.5400099),\n (0.8864127, -1.5074526),\n (0.8868127, -1.4739481),\n (0.8872127, -1.4395076),\n (0.8876127, -1.404163),\n (0.8880127, -1.3679261),\n (0.8884127, -1.3308307),\n (0.8888127, -1.292889),\n (0.8892127, -1.2541305),\n (0.88961273, -1.2145859),\n (0.89001274, -1.174268),\n (0.89041275, -1.1332145),\n (0.89081275, -1.091439),\n (0.89121276, -1.0489805),\n (0.89161277, -1.0058528),\n (0.8920128, -0.96209645),\n (0.8924128, -0.91772574),\n (0.8928128, -0.8727821),\n (0.8932128, -0.8272803),\n (0.8936128, -0.78126293),\n (0.8940128, -0.734745),\n (0.8944128, -0.6877701),\n (0.8948128, -0.6403537),\n (0.8952128, -0.59253997),\n (0.89561284, -0.54434466),\n (0.89601284, -0.49581292),\n (0.89641285, -0.4469606),\n (0.89681286, -0.39783338),\n (0.89721286, -0.34844738),\n (0.89761287, -0.29884884),\n (0.8980129, -0.24905396),\n (0.8984129, -0.19910935),\n (0.8988129, -0.14903137),\n (0.8992129, -9.886687e-2),\n (0.8996129, -4.863231e-2),\n (0.9000129, 1.6253471e-3),\n (0.9004129, 5.1889606e-2),\n (0.9008129, 0.10211346),\n (0.90121293, 0.15228043),\n (0.90161294, 0.20234363),\n (0.90201294, 0.25228658),\n (0.90241295, 0.30206263),\n (0.90281296, 0.35165542),\n (0.90321296, 0.40101856),\n (0.903613, 0.45013592),\n (0.904013, 0.49896148),\n (0.904413, 0.5474793),\n (0.904813, 0.59564394),\n (0.905213, 0.64343965),\n (0.905613, 0.6908217),\n (0.906013, 0.73777455),\n (0.906413, 0.7842543),\n (0.906813, 0.83024573),\n (0.90721303, 0.8757058),\n (0.90761304, 0.92061955),\n (0.90801305, 0.9649451),\n (0.90841305, 1.0086677),\n (0.90881306, 1.0517467),\n (0.90921307, 1.0941678),\n (0.9096131, 1.1358916),\n (0.9100131, 1.176904),\n (0.9104131, 1.2171669),\n (0.9108131, 1.256667),\n (0.9112131, 1.2953732),\n (0.9116131, 1.3332555),\n (0.9120131, 1.3703012),\n (0.9124131, 1.4064759),\n (0.9128131, 1.4417677),\n (0.91321313, 1.4761434),\n (0.91361314, 1.5095919),\n (0.91401315, 1.542082),\n (0.91441315, 1.5736027),\n (0.91481316, 1.6041248),\n (0.91521317, 1.6336383),\n (0.9156132, 1.6621155),\n (0.9160132, 1.6895471),\n (0.9164132, 1.7159073),\n (0.9168132, 1.7411877),\n (0.9172132, 1.7653645),\n (0.9176132, 1.7884299),\n (0.9180132, 1.8103621),\n (0.9184132, 1.8311541),\n (0.9188132, 1.8507864),\n (0.91921324, 1.8692527),\n (0.91961324, 1.8865354),\n (0.92001325, 1.9026291),\n (0.92041326, 1.9175186),\n (0.92081326, 1.9311992),\n (0.92121327, 1.9436579),\n (0.9216133, 1.9548907),\n (0.9220133, 1.9648871),\n (0.9224133, 1.9736439),\n (0.9228133, 1.9811528),\n (0.9232133, 1.9874114),\n (0.9236133, 1.9924138),\n (0.9240133, 1.9961582),\n (0.9244133, 1.9986415),\n (0.92481333, 1.9998626),\n (0.92521334, 1.9998202),\n (0.92561334, 1.9985148),\n (0.92601335, 1.9959472),\n (0.92641336, 1.9921185),\n (0.92681336, 1.9870322),\n (0.9272134, 1.9806898),\n (0.9276134, 1.9730974),\n (0.9280134, 1.9642575),\n (0.9284134, 1.9541783),\n (0.9288134, 1.9428632),\n (0.9292134, 1.9303228),\n (0.9296134, 1.9165609),\n (0.9300134, 1.9015907),\n (0.9304134, 1.8854171),\n (0.93081343, 1.8680551),\n (0.93121344, 1.8495104),\n (0.93161345, 1.8298004),\n (0.93201345, 1.8089315),\n (0.93241346, 1.7869233),\n (0.93281347, 1.763783),\n (0.9332135, 1.7395283),\n (0.9336135, 1.7141788),\n (0.9340135, 1.6877425),\n (0.9344135, 1.6602443),\n (0.9348135, 1.6316931),\n (0.9352135, 1.6021158),\n (0.9356135, 1.5715219),\n (0.9360135, 1.5399401),\n (0.9364135, 1.5073807),\n (0.93681353, 1.4738742),\n (0.93721354, 1.4394317),\n (0.93761355, 1.4040852),\n (0.93801355, 1.3678463),\n (0.93841356, 1.330749),\n (0.93881357, 1.2928056),\n (0.9392136, 1.2540513),\n (0.9396136, 1.214499),\n (0.9400136, 1.1741856),\n (0.9404136, 1.1331244),\n (0.9408136, 1.0913537),\n (0.9412136, 1.0488873),\n (0.9416136, 1.0057648),\n (0.9420136, 0.96200055),\n (0.9424136, 0.9176353),\n (0.94281363, 0.8726837),\n (0.94321364, 0.82718766),\n (0.94361365, 0.78116226),\n (0.94401366, 0.73465043),\n (0.94441366, 0.6876674),\n (0.94481367, 0.6402573),\n (0.9452137, 0.5924355),\n (0.9456137, 0.5442468),\n (0.9460137, 0.49570695),\n (0.9464137, 0.44686142),\n (0.9468137, 0.39772618),\n (0.9472137, 0.3483472),\n (0.9476137, 0.29874068),\n (0.9480137, 0.248953),\n (0.9484137, 0.19900051),\n (0.94881374, 0.14892991),\n (0.94921374, 9.875764e-2),\n (0.94961375, 4.8530597e-2),\n (0.95001376, -1.7347175e-3),\n (0.95041376, -5.199131e-2),\n (0.9508138, -0.10222269),\n (0.9512138, -0.15238188),\n (0.9516138, -0.20245244),\n (0.9520138, -0.25238752),\n (0.9524138, -0.30217075),\n (0.9528138, -0.35175556),\n (0.9532138, -0.40112573),\n (0.9536138, -0.45023504),\n (0.9540138, -0.4990674),\n (0.95441383, -0.54757714),\n (0.95481384, -0.5957483),\n (0.95521384, -0.6435432),\n (0.95561385, -0.69092435),\n (0.95601386, -0.7378762),\n (0.95641387, -0.7843549),\n (0.9568139, -0.8303452),\n (0.9572139, -0.87580407),\n (0.9576139, -0.92071664),\n (0.9580139, -0.96504086),\n (0.9584139, -1.0087622),\n (0.9588139, -1.0518397),\n (0.9592139, -1.0942594),\n (0.9596139, -1.1359816),\n (0.9600139, -1.1769924),\n (0.96041393, -1.2172537),\n (0.96081394, -1.2567521),\n (0.96121395, -1.2954508),\n (0.96161395, -1.333337),\n (0.96201396, -1.3703754),\n (0.96241397, -1.4065537),\n (0.962814, -1.4418381),\n (0.963214, -1.4762172),\n (0.963614, -1.5096587),\n (0.964014, -1.5421516),\n (0.964414, -1.5736655),\n (0.964814, -1.6041901),\n (0.965214, -1.633697),\n (0.965614, -1.6621763),\n (0.966014, -1.6896015),\n (0.96641403, -1.7159635),\n (0.96681404, -1.7412378),\n (0.96721405, -1.7654159),\n (0.96761405, -1.7884754),\n (0.96801406, -1.8104086),\n (0.96841407, -1.8311951),\n (0.9688141, -1.8508279),\n (0.9692141, -1.8692888),\n (0.9696141, -1.8865718),\n (0.9700141, -1.9026605),\n (0.9704141, -1.9175497),\n (0.9708141, -1.9312257),\n (0.9712141, -1.9436836),\n (0.9716141, -1.9549122),\n (0.9720141, -1.9649075),\n (0.97241414, -1.9736603),\n (0.97281414, -1.9811678),\n (0.97321415, -1.9874227),\n (0.97361416, -1.9924232),\n (0.97401416, -1.9961646),\n (0.97441417, -1.9986454),\n (0.9748142, -1.9998637),\n (0.9752142, -1.9998188),\n (0.9756142, -1.9985108),\n (0.9760142, -1.9959403),\n (0.9764142, -1.9921095),\n (0.9768142, -1.9870197),\n (0.9772142, -1.9806746),\n (0.9776142, -1.9730796),\n (0.97801423, -1.964237),\n (0.97841424, -1.9541551),\n (0.97881424, -1.9428372),\n (0.97921425, -1.9302942),\n (0.97961426, -1.9165297),\n (0.98001426, -1.9015568),\n (0.9804143, -1.8853806),\n (0.9808143, -1.868016),\n (0.9812143, -1.8494687),\n (0.9816143, -1.8297563),\n (0.9820143, -1.8088849),\n (0.9824143, -1.7868742),\n (0.9828143, -1.7637314),\n (0.9832143, -1.7394781),\n (0.9836143, -1.7141224),\n (0.98401433, -1.6876879),\n (0.98441434, -1.6601833),\n (0.98481435, -1.6316344),\n (0.98521435, -1.6020503),\n (0.98561436, -1.5714589),\n (0.98601437, -1.5398703),\n (0.9864144, -1.5073138),\n (0.9868144, -1.4738003),\n (0.9872144, -1.439361),\n (0.9876144, -1.4040072),\n (0.9880144, -1.3677721),\n (0.9884144, -1.3306674),\n (0.9888144, -1.292728),\n (0.9892144, -1.2539661),\n (0.9896144, -1.2144182),\n (0.99001443, -1.1740971),\n (0.99041444, -1.1330405),\n (0.99081445, -1.0912621),\n (0.99121445, -1.0488007),\n (0.99161446, -1.0056703),\n (0.99201447, -0.9619114),\n (0.9924145, -0.91753817),\n (0.9928145, -0.87259215),\n (0.9932145, -0.8270881),\n (0.9936145, -0.78106856),\n (0.9940145, -0.7345487),\n (0.9944145, -0.6875719),\n (0.9948145, -0.6401537),\n (0.9952145, -0.5923383),\n (0.9956145, -0.54414153),\n (0.99601454, -0.4956084),\n (0.99641454, -0.4467548),\n (0.99681455, -0.39762646),\n (0.99721456, -0.3482395),\n (0.99761456, -0.29864007),\n (0.99801457, -0.24884449),\n (0.9984146, -0.19889928),\n (0.9988146, -0.14882085),\n (0.9992146, -9.86484e-2),\n (0.9996146, -4.842126e-2)]\n\npieceExpected :: [(Float, Float)]\npieceExpected = [\n (0.0, -1.0),\n (8.0e-3, -1.0),\n (1.6e-2, -1.0),\n (2.4e-2, -1.0),\n (3.2e-2, -1.0),\n (4.0000003e-2, -1.0),\n (4.8000004e-2, -1.0),\n (5.6000005e-2, -1.0),\n (6.4e-2, -1.0),\n (7.2000004e-2, -1.0),\n (8.0000006e-2, -1.0),\n (8.800001e-2, -1.0),\n (9.600001e-2, -1.0),\n (0.10400001, -1.0),\n (0.11200001, -1.0),\n (0.12000001, -1.0),\n (0.128, -1.0),\n (0.136, -1.0),\n (0.14400001, -1.0),\n (0.15200001, -1.0),\n (0.16000001, -1.0),\n (0.16800001, -1.0),\n (0.17600001, -1.0),\n (0.18400002, -1.0),\n (0.19200002, -1.0),\n (0.20000002, -1.0),\n (0.20800002, -1.0),\n (0.21600002, -1.0),\n (0.22400002, -1.0),\n (0.23200002, -1.0),\n (0.24000002, -1.0),\n (0.24800003, -1.0),\n (0.256, -1.0),\n (0.264, -1.0),\n (0.27199998, -1.0),\n (0.27999997, -1.0),\n (0.28799996, -1.0),\n (0.29599994, -1.0),\n (0.30399993, -1.0),\n (0.31199992, -1.0),\n (0.3199999, -1.0),\n (0.3279999, -1.0),\n (0.33599988, -1.0),\n (0.34399986, -1.0),\n (0.35199985, -1.0),\n (0.35999984, -1.0),\n (0.36799982, -1.0),\n (0.3759998, -1.0),\n (0.3839998, -1.0),\n (0.39199978, -1.0),\n (0.39999977, -1.0),\n (0.40799975, -1.0),\n (0.41599974, -1.0),\n (0.42399973, -1.0),\n (0.4319997, -1.0),\n (0.4399997, -1.0),\n (0.4479997, -1.0),\n (0.45599967, -1.0),\n (0.46399966, -1.0),\n (0.47199965, -1.0),\n (0.47999963, -1.0),\n (0.48799962, -1.0),\n (0.4959996, -1.0),\n (0.5039996, -1.0),\n (0.5119996, -1.0),\n (0.5199996, -1.0),\n (0.52799964, -1.0),\n (0.53599966, -1.0),\n (0.5439997, -1.0),\n (0.5519997, -1.0),\n (0.5599997, -1.0),\n (0.5679997, -1.0),\n (0.57599974, -1.0),\n (0.58399975, -1.0),\n (0.59199977, -1.0),\n (0.5999998, -1.0),\n (0.6079998, -1.0),\n (0.6159998, -1.0),\n (0.62399983, -1.0),\n (0.63199985, -1.0),\n (0.63999987, -1.0),\n (0.6479999, -1.0),\n (0.6559999, -1.0),\n (0.6639999, -1.0),\n (0.67199993, -1.0),\n (0.67999995, -1.0),\n (0.68799996, -1.0),\n (0.696, -1.0),\n (0.704, -1.0),\n (0.712, -1.0),\n (0.72, -1.0),\n (0.72800004, -1.0),\n (0.73600006, -1.0),\n (0.7440001, -1.0),\n (0.7520001, -1.0),\n (0.7600001, -1.0),\n (0.7680001, -1.0),\n (0.77600014, -1.0),\n (0.78400016, -1.0),\n (0.7920002, -1.0),\n (0.8000002, -1.0),\n (0.8080002, -1.0),\n (0.8160002, -1.0),\n (0.82400024, -1.0),\n (0.83200026, -1.0),\n (0.8400003, -1.0),\n (0.8480003, -1.0),\n (0.8560003, -1.0),\n (0.8640003, -1.0),\n (0.87200034, -1.0),\n (0.88000035, -1.0),\n (0.88800037, -1.0),\n (0.8960004, -1.0),\n (0.9040004, -1.0),\n (0.9120004, -1.0),\n (0.92000043, -1.0),\n (0.92800045, -1.0),\n (0.93600047, -1.0),\n (0.9440005, -1.0),\n (0.9520005, -1.0),\n (0.9600005, -1.0),\n (0.96800053, -1.0),\n (0.97600055, -1.0),\n (0.98400056, -1.0),\n (0.9920006, -1.0),\n (1.0000006, -0.9999851),\n (1.0080006, -0.7999847),\n (1.0160006, -0.5999843),\n (1.0240006, -0.39998388),\n (1.0320007, -0.19998348),\n (1.0400007, 1.692772e-5),\n (1.0480007, 0.20001733),\n (1.0560007, 0.40001774),\n (1.0640007, 0.60001814),\n (1.0720007, 0.80001855),\n (1.0800008, 1.0000191),\n (1.0880008, 1.2000194),\n (1.0960008, 1.4000196),\n (1.1040008, 1.6000202),\n (1.1120008, 1.8000207),\n (1.1200008, 2.000021),\n (1.1280009, 2.2000213),\n (1.1360009, 2.4000218),\n (1.1440009, 2.6000223),\n (1.1520009, 2.8000226),\n (1.1600009, 3.000023),\n (1.1680009, 3.2000237),\n (1.176001, 3.400024),\n (1.184001, 3.6000242),\n (1.192001, 3.8000245),\n (1.200001, 4.0000024),\n (1.208001, 4.0199146),\n (1.216001, 4.0393105),\n (1.224001, 4.058002),\n (1.2320011, 4.075812),\n (1.2400011, 4.092575),\n (1.2480011, 4.1081386),\n (1.2560011, 4.122365),\n (1.2640011, 4.1351323),\n (1.2720011, 4.1463346),\n (1.2800012, 4.155884),\n (1.2880012, 4.16371),\n (1.2960012, 4.1697617),\n (1.3040012, 4.174006),\n (1.3120012, 4.1764283),\n (1.3200012, 4.177034),\n (1.3280013, 4.175845),\n (1.3360013, 4.1729026),\n (1.3440013, 4.168264),\n (1.3520013, 4.1620026),\n (1.3600013, 4.154207),\n (1.3680013, 4.144981),\n (1.3760014, 4.13444),\n (1.3840014, 4.1227107),\n (1.3920014, 4.1099305),\n (1.4000014, 4.0962453),\n (1.4080014, 4.0818067),\n (1.4160014, 4.066773),\n (1.4240015, 4.0513043),\n (1.4320015, 4.035564),\n (1.4400015, 4.0197153),\n (1.4480015, 4.003919),\n (1.4560015, 3.9883342),\n (1.4640015, 3.9731145),\n (1.4720016, 3.9584074),\n (1.4800016, 3.9443526),\n (1.4880016, 3.9310822),\n (1.4960016, 3.9187174),\n (1.5040016, 3.9073682),\n (1.5120016, 3.8971329),\n (1.5200016, 3.8880968),\n (1.5280017, 3.8803325),\n (1.5360017, 3.8738976),\n (1.5440017, 3.8688364),\n (1.5520017, 3.8651776),\n (1.5600017, 3.862936),\n (1.5680017, 3.8621116),\n (1.5760018, 3.8626904),\n (1.5840018, 3.8646445),\n (1.5920018, 3.8679318),\n (1.6000018, 3.8724985),\n (1.6080018, 3.8782783),\n (1.6160018, 3.8851929),\n (1.6240019, 3.8931556),\n (1.6320019, 3.9020686),\n (1.6400019, 3.9118276),\n (1.6480019, 3.9223208),\n (1.6560019, 3.9334302),\n (1.664002, 3.9450345),\n (1.672002, 3.9570084),\n (1.680002, 3.969226),\n (1.688002, 3.9815598),\n (1.696002, 3.9938836),\n (1.704002, 4.0060735),\n (1.712002, 4.0180087),\n (1.720002, 4.029573),\n (1.7280021, 4.0406556),\n (1.7360021, 4.0511527),\n (1.7440021, 4.060967),\n (1.7520021, 4.070011),\n (1.7600021, 4.078206),\n (1.7680022, 4.085482),\n (1.7760022, 4.091781),\n (1.7840022, 4.097055),\n (1.7920022, 4.101267),\n (1.8000022, 4.104391),\n (1.8080022, 4.106413),\n (1.8160022, 4.1073303),\n (1.8240023, 4.1071506),\n (1.8320023, 4.105894),\n (1.8400023, 4.1035895),\n (1.8480023, 4.100278),\n (1.8560023, 4.0960073),\n (1.8640023, 4.090837),\n (1.8720024, 4.0848327),\n (1.8800024, 4.0780687),\n (1.8880024, 4.0706253),\n (1.8960024, 4.0625877),\n (1.9040024, 4.054047),\n (1.9120024, 4.045097),\n (1.9200025, 4.0358343),\n (1.9280025, 4.026357),\n (1.9360025, 4.016765),\n (1.9440025, 4.0071564),\n (1.9520025, 3.9976277),\n (1.9600025, 3.988274),\n (1.9680026, 3.9791875),\n (1.9760026, 3.9704547),\n (1.9840026, 3.9621587),\n (1.9920026, 3.9543757),\n (2.0000026, 3.947176),\n (2.0080025, 3.9406233),\n (2.0160024, 3.934773),\n (2.0240023, 3.9296732),\n (2.0320022, 3.9253635),\n (2.040002, 3.9218745),\n (2.048002, 3.9192286),\n (2.056002, 3.9174385),\n (2.0640018, 3.9165092),\n (2.0720017, 3.9164367),\n (2.0800016, 3.9172072),\n (2.0880015, 3.9188004),\n (2.0960014, 3.921187),\n (2.1040013, 3.9243298),\n (2.1120012, 3.928186),\n (2.120001, 3.9327044),\n (2.128001, 3.93783),\n (2.1360009, 3.9435005),\n (2.1440008, 3.9496508),\n (2.1520007, 3.956211),\n (2.1600006, 3.9631085),\n (2.1680005, 3.9702682),\n (2.1760004, 3.9776144),\n (2.1840003, 3.9850693),\n (2.1920002, 3.9925566),\n (2.2, 4.0),\n (2.208, 4.007325),\n (2.2159998, 4.0144606),\n (2.2239997, 4.0213366),\n (2.2319996, 4.0278883),\n (2.2399995, 4.034055),\n (2.2479994, 4.0397806),\n (2.2559993, 4.0450144),\n (2.2639992, 4.049711),\n (2.2719991, 4.0538325),\n (2.279999, 4.0573454),\n (2.287999, 4.060225),\n (2.2959988, 4.0624514),\n (2.3039987, 4.0640125),\n (2.3119986, 4.064904),\n (2.3199985, 4.0651274),\n (2.3279984, 4.06469),\n (2.3359983, 4.0636077),\n (2.3439982, 4.0619016),\n (2.351998, 4.0595984),\n (2.359998, 4.0567307),\n (2.367998, 4.053337),\n (2.3759978, 4.0494595),\n (2.3839977, 4.045145),\n (2.3919976, 4.0404434),\n (2.3999975, 4.035409),\n (2.4079974, 4.030098),\n (2.4159973, 4.024567),\n (2.4239972, 4.018877),\n (2.431997, 4.0130863),\n (2.439997, 4.007256),\n (2.4479969, 4.0014453),\n (2.4559968, 3.9957118),\n (2.4639966, 3.9901128),\n (2.4719965, 3.984702),\n (2.4799964, 3.9795318),\n (2.4879963, 3.97465),\n (2.4959962, 3.9701009),\n (2.5039961, 3.9659252),\n (2.511996, 3.9621596),\n (2.519996, 3.9588351),\n (2.5279958, 3.9559789),\n (2.5359957, 3.953611),\n (2.5439956, 3.9517488),\n (2.5519955, 3.9504023),\n (2.5599954, 3.9495773),\n (2.5679953, 3.9492736),\n (2.5759952, 3.9494863),\n (2.583995, 3.9502048),\n (2.591995, 3.9514136),\n (2.599995, 3.953093),\n (2.6079948, 3.9552188),\n (2.6159947, 3.9577622),\n (2.6239946, 3.9606915),\n (2.6319945, 3.9639702),\n (2.6399944, 3.9675598),\n (2.6479943, 3.9714198),\n (2.6559942, 3.9755063),\n (2.663994, 3.979775),\n (2.671994, 3.98418),\n (2.6799939, 3.9886742),\n (2.6879938, 3.9932117),\n (2.6959937, 3.997745),\n (2.7039936, 4.0022297),\n (2.7119935, 4.0066204),\n (2.7199934, 4.0108747),\n (2.7279932, 4.014952),\n (2.7359931, 4.0188136),\n (2.743993, 4.0224247),\n (2.751993, 4.025752),\n (2.7599928, 4.028767),\n (2.7679927, 4.031444),\n (2.7759926, 4.033762),\n (2.7839925, 4.0357027),\n (2.7919924, 4.0372524),\n (2.7999923, 4.038402),\n (2.8079922, 4.0391464),\n (2.815992, 4.0394845),\n (2.823992, 4.0394187),\n (2.831992, 4.038957),\n (2.8399918, 4.03811),\n (2.8479917, 4.036892),\n (2.8559916, 4.035321),\n (2.8639915, 4.0334196),\n (2.8719914, 4.0312114),\n (2.8799913, 4.0287237),\n (2.8879912, 4.0259857),\n (2.895991, 4.0230293),\n (2.903991, 4.0198874),\n (2.911991, 4.016595),\n (2.9199908, 4.013188),\n (2.9279907, 4.0097017),\n (2.9359906, 4.0061727),\n (2.9439905, 4.002638),\n (2.9519904, 3.9991326),\n (2.9599903, 3.9956918),\n (2.9679902, 3.9923487),\n (2.97599, 3.9891357),\n (2.98399, 3.9860835),\n (2.9919899, 3.98322),\n (2.9999897, 3.9805713),\n (3.0079896, 3.9781604),\n (3.0159895, 3.9760075),\n (3.0239894, 3.974131),\n (3.0319893, 3.9725451),\n (3.0399892, 3.971261),\n (3.0479891, 3.9702873),\n (3.055989, 3.9696283),\n (3.063989, 3.969286),\n (3.0719888, 3.9692583),\n (3.0799887, 3.9695415),\n (3.0879886, 3.970127),\n (3.0959885, 3.9710045),\n (3.1039884, 3.9721603),\n (3.1119883, 3.9735785),\n (3.1199882, 3.9752407),\n (3.127988, 3.9771256),\n (3.135988, 3.9792113),\n (3.143988, 3.981474),\n (3.1519878, 3.9838867),\n (3.1599877, 3.9864244),\n (3.1679876, 3.989058),\n (3.1759875, 3.9917603),\n (3.1839874, 3.994503),\n (3.1919873, 3.9972572),\n (3.1999872, 3.9999957),\n (3.207987, 4.002691),\n (3.215987, 4.005316),\n (3.2239869, 4.0078454),\n (3.2319868, 4.010256),\n (3.2399867, 4.0125246),\n (3.2479866, 4.0146313),\n (3.2559865, 4.016557),\n (3.2639863, 4.0182853),\n (3.2719862, 4.0198016),\n (3.2799861, 4.0210943),\n (3.287986, 4.022154),\n (3.295986, 4.0229735),\n (3.3039858, 4.023548),\n (3.3119857, 4.0238767),\n (3.3199856, 4.023959),\n (3.3279855, 4.0237985),\n (3.3359854, 4.023401),\n (3.3439853, 4.0227737),\n (3.3519852, 4.0219264),\n (3.359985, 4.020872),\n (3.367985, 4.0196238),\n (3.375985, 4.0181975),\n (3.3839848, 4.0166106),\n (3.3919847, 4.014881),\n (3.3999846, 4.0130296),\n (3.4079845, 4.0110755),\n (3.4159844, 4.0090413),\n (3.4239843, 4.006948),\n (3.4319842, 4.0048175),\n (3.439984, 4.0026727),\n (3.447984, 4.000535),\n (3.4559839, 3.998426),\n (3.4639838, 3.996366),\n (3.4719837, 3.9943752),\n (3.4799836, 3.9924731),\n (3.4879835, 3.9906769),\n (3.4959834, 3.9890032),\n (3.5039833, 3.9874668),\n (3.5119832, 3.9860816),\n (3.519983, 3.984858),\n (3.527983, 3.983807),\n (3.5359828, 3.982936),\n (3.5439827, 3.9822502),\n (3.5519826, 3.9817548),\n (3.5599825, 3.981451),\n (3.5679824, 3.981339),\n (3.5759823, 3.9814167),\n (3.5839822, 3.9816809),\n (3.5919821, 3.9821253),\n (3.599982, 3.9827428),\n (3.607982, 3.9835248),\n (3.6159818, 3.9844599),\n (3.6239817, 3.9855375),\n (3.6319816, 3.9867435),\n (3.6399815, 3.9880638),\n (3.6479814, 3.9894834),\n (3.6559813, 3.9909868),\n (3.6639812, 3.992557),\n (3.671981, 3.9941773),\n (3.679981, 3.995831),\n (3.687981, 3.9975),\n (3.6959808, 3.999168),\n (3.7039807, 4.000818),\n (3.7119806, 4.002433),\n (3.7199805, 4.0039983),\n (3.7279804, 4.0054984),\n (3.7359803, 4.006919),\n (3.7439802, 4.0082474),\n (3.75198, 4.009472),\n (3.75998, 4.010581),\n (3.7679799, 4.011566),\n (3.7759798, 4.012419),\n (3.7839797, 4.013133),\n (3.7919796, 4.013704),\n (3.7999794, 4.014127),\n (3.8079793, 4.014401),\n (3.8159792, 4.0145254),\n (3.8239791, 4.0145016),\n (3.831979, 4.014332),\n (3.839979, 4.0140204),\n (3.8479788, 4.0135727),\n (3.8559787, 4.0129952),\n (3.8639786, 4.0122957),\n (3.8719785, 4.0114837),\n (3.8799784, 4.010568),\n (3.8879783, 4.009561),\n (3.8959782, 4.008474),\n (3.903978, 4.007318),\n (3.911978, 4.006107),\n (3.919978, 4.0048537),\n (3.9279778, 4.003571),\n (3.9359777, 4.002273),\n (3.9439776, 4.0009727),\n (3.9519775, 3.999683),\n (3.9599774, 3.998417),\n (3.9679773, 3.9971871),\n (3.9759772, 3.996005),\n (3.983977, 3.994882),\n (3.991977, 3.9938288),\n (3.9999769, 3.992854),\n (4.007977, 3.9919667),\n (4.015977, 3.9911747),\n (4.023977, 3.9904842),\n (4.0319767, 3.9899006),\n (4.0399766, 3.989428),\n (4.0479765, 3.98907),\n (4.0559764, 3.9888272),\n (4.0639763, 3.9887009),\n (4.071976, 3.9886909),\n (4.079976, 3.9887948),\n (4.087976, 3.9890099),\n (4.095976, 3.9893327),\n (4.103976, 3.9897575),\n (4.1119757, 3.9902792),\n (4.1199756, 3.9908905),\n (4.1279755, 3.9915838),\n (4.1359754, 3.992351),\n (4.1439753, 3.9931831),\n (4.151975, 3.994071),\n (4.159975, 3.9950042),\n (4.167975, 3.995973),\n (4.175975, 3.9969673),\n (4.1839747, 3.9979763),\n (4.1919746, 3.9989896),\n (4.1999745, 3.9999967),\n (4.2079744, 3.8670897),\n (4.2159743, 3.733758),\n (4.223974, 3.6004262),\n (4.231974, 3.467095),\n (4.239974, 3.3337631),\n (4.247974, 3.2004313),\n (4.255974, 3.0671),\n (4.2639737, 2.9337683),\n (4.2719736, 2.8004367),\n (4.2799735, 2.6671052),\n (4.2879734, 2.5337734),\n (4.2959733, 2.400442),\n (4.303973, 2.2671103),\n (4.311973, 2.1337786),\n (4.319973, 2.000447),\n (4.327973, 1.8671155),\n (4.335973, 1.7337837),\n (4.3439727, 1.6004522),\n (4.3519726, 1.4671206),\n (4.3599725, 1.3337889),\n (4.3679724, 1.2004573),\n (4.3759723, 1.0671258),\n (4.383972, 0.933794),\n (4.391972, 0.8004625),\n (4.399972, 0.66713095),\n (4.407972, 0.5337994),\n (4.4159718, 0.40046763),\n (4.4239717, 0.2671361),\n (4.4319715, 0.13380456),\n (4.4399714, 4.7278404e-4),\n (4.4479713, -0.13285875),\n (4.4559712, -0.26619053),\n (4.463971, -0.39952183),\n (4.471971, -0.5328536),\n (4.479971, -0.6661854),\n (4.487971, -0.7995167),\n (4.4959707, -0.93284845),\n (4.5039706, -1.0130347),\n (4.5119705, -1.0388085),\n (4.5199704, -1.0637013),\n (4.5279703, -1.0874522),\n (4.53597, -1.1098169),\n (4.54397, -1.1305714),\n (4.55197, -1.1495129),\n (4.55997, -1.1664628),\n (4.56797, -1.1812674),\n (4.5759697, -1.1937997),\n (4.5839696, -1.2039601),\n (4.5919695, -1.211677),\n (4.5999694, -1.2169073),\n (4.6079693, -1.2196363),\n (4.615969, -1.2198772),\n (4.623969, -1.217671),\n (4.631969, -1.2130848),\n (4.639969, -1.206211),\n (4.647969, -1.1971657),\n (4.6559687, -1.1860877),\n (4.6639686, -1.1731353),\n (4.6719685, -1.1584852),\n (4.6799684, -1.1423297),\n (4.6879683, -1.1248746),\n (4.695968, -1.1063366),\n (4.703968, -1.0869405),\n (4.711968, -1.0669167),\n (4.719968, -1.0464988),\n (4.7279677, -1.0259204),\n (4.7359676, -1.0054132),\n (4.7439675, -0.9852034),\n (4.7519674, -0.9655106),\n (4.7599673, -0.94654465),\n (4.767967, -0.92850345),\n (4.775967, -0.91157144),\n (4.783967, -0.89591736),\n (4.791967, -0.88169277),\n (4.799967, -0.86903095),\n (4.8079667, -0.8580451),\n (4.8159666, -0.84882826),\n (4.8239665, -0.8414518),\n (4.8319664, -0.83596575),\n (4.8399663, -0.83239794),\n (4.847966, -0.83075464),\n (4.855966, -0.8310205),\n (4.863966, -0.83315915),\n (4.871966, -0.83711433),\n (4.879966, -0.84281033),\n (4.8879657, -0.85015345),\n (4.8959656, -0.85903347),\n (4.9039655, -0.8693248),\n (4.9119654, -0.8808886),\n (4.9199653, -0.893574),\n (4.927965, -0.90722066),\n (4.935965, -0.92166007),\n (4.943965, -0.936718),\n (4.951965, -0.95221645),\n (4.9599648, -0.9679753),\n (4.9679646, -0.98381513),\n (4.9759645, -0.9995585),\n (4.9839644, -1.015032),\n (4.9919643, -1.0300686),\n (4.999964, -1.0445088),\n (5.007964, -1.0582025),\n (5.015964, -1.0710107),\n (5.023964, -1.0828063),\n (5.031964, -1.0934762),\n (5.0399637, -1.1029212),\n (5.0479636, -1.111058),\n (5.0559635, -1.1178188),\n (5.0639634, -1.1231527),\n (5.0719633, -1.1270251),\n (5.079963, -1.1294185),\n (5.087963, -1.1303322),\n (5.095963, -1.129782),\n (5.103963, -1.1277993),\n (5.111963, -1.1244311),\n (5.1199627, -1.1197392),\n (5.1279626, -1.1137987),\n (5.1359625, -1.1066976),\n (5.1439624, -1.0985346),\n (5.1519623, -1.0894194),\n (5.159962, -1.0794696),\n (5.167962, -1.0688103),\n (5.175962, -1.0575726),\n (5.183962, -1.0458912),\n (5.191962, -1.0339036),\n (5.1999617, -1.0217485),\n (5.2079616, -1.0095638),\n (5.2159615, -0.99748534),\n (5.2239614, -0.98564565),\n (5.2319613, -0.97417194),\n (5.239961, -0.96318537),\n (5.247961, -0.9527996),\n (5.255961, -0.94311935),\n (5.263961, -0.93424004),\n (5.2719607, -0.92624635),\n (5.2799606, -0.9192115),\n (5.2879605, -0.91319704),\n (5.2959604, -0.908252),\n (5.3039603, -0.9044126),\n (5.31196, -0.9017023),\n (5.31996, -0.90013146),\n (5.32796, -0.8996976),\n (5.33596, -0.90038586),\n (5.34396, -0.90216887),\n (5.3519597, -0.9050078),\n (5.3599596, -0.90885264),\n (5.3679595, -0.9136431),\n (5.3759594, -0.9193096),\n (5.3839593, -0.9257737),\n (5.391959, -0.93294984),\n (5.399959, -0.9407457),\n (5.407959, -0.94906396),\n (5.415959, -0.9578031),\n (5.423959, -0.9668585),\n (5.4319587, -0.9761243),\n (5.4399586, -0.98549366),\n (5.4479585, -0.9948607),\n (5.4559584, -1.0041215),\n (5.4639583, -1.013175),\n (5.471958, -1.021924),\n (5.479958, -1.0302769),\n (5.487958, -1.0381477),\n (5.495958, -1.0454572),\n (5.5039577, -1.0521342),\n (5.5119576, -1.0581155),\n (5.5199575, -1.0633465),\n (5.5279574, -1.0677826),\n (5.5359573, -1.0713881),\n (5.543957, -1.0741376),\n (5.551957, -1.0760152),\n (5.559957, -1.0770156),\n (5.567957, -1.0771428),\n (5.575957, -1.0764107),\n (5.5839567, -1.0748423),\n (5.5919566, -1.0724697),\n (5.5999565, -1.0693333),\n (5.6079564, -1.0654812),\n (5.6159563, -1.0609688),\n (5.623956, -1.0558577),\n (5.631956, -1.0502151),\n (5.639956, -1.0441129),\n (5.647956, -1.0376272),\n (5.655956, -1.0308366),\n (5.6639557, -1.0238217),\n (5.6719556, -1.0166645),\n (5.6799555, -1.0094471),\n (5.6879554, -1.0022506),\n (5.6959553, -0.9951546),\n (5.703955, -0.98823625),\n (5.711955, -0.98156935),\n (5.719955, -0.97522354),\n (5.727955, -0.9692637),\n (5.7359548, -0.9637493),\n (5.7439547, -0.9587339),\n (5.7519546, -0.9542646),\n (5.7599545, -0.9503814),\n (5.7679543, -0.9471172),\n (5.7759542, -0.9444976),\n (5.783954, -0.9425403),\n (5.791954, -0.9412556),\n (5.799954, -0.9406461),\n (5.807954, -0.9407067),\n (5.8159537, -0.94142497),\n (5.8239536, -0.94278157),\n (5.8319535, -0.9447503),\n (5.8399534, -0.9472985),\n (5.8479533, -0.95038784),\n (5.855953, -0.9539745),\n (5.863953, -0.95801),\n (5.871953, -0.9624417),\n (5.879953, -0.96721333),\n (5.887953, -0.9722661),\n (5.8959527, -0.97753865),\n (5.9039526, -0.982969),\n (5.9119525, -0.98849374),\n (5.9199524, -0.99405),\n (5.9279523, -0.99957544),\n (5.935952, -1.005009),\n (5.943952, -1.0102924),\n (5.951952, -1.0153692),\n (5.959952, -1.0201865),\n (5.967952, -1.0246956),\n (5.9759517, -1.0288517),\n (5.9839516, -1.0326146),\n (5.9919515, -1.0359496),\n (5.9999514, -1.0388268),\n (6.0079513, -1.0412226),\n (6.015951, -1.0431185),\n (6.023951, -1.0445021),\n (6.031951, -1.0453672),\n (6.039951, -1.0457132),\n (6.0479507, -1.0455452),\n (6.0559506, -1.0448741),\n (6.0639505, -1.0437161),\n (6.0719504, -1.0420926),\n (6.0799503, -1.0400296),\n (6.08795, -1.037558),\n (6.09595, -1.0347121),\n (6.10395, -1.0315301),\n (6.11195, -1.0280534),\n (6.11995, -1.0243256),\n (6.1279497, -1.0203927),\n (6.1359496, -1.0163016),\n (6.1439495, -1.0121008),\n (6.1519494, -1.007839),\n (6.1599493, -1.0035642),\n (6.167949, -0.9993246),\n (6.175949, -0.9951664),\n (6.183949, -0.9911344),\n (6.191949, -0.9872713),\n (6.199949, -0.98361695),\n (6.2079487, -0.9802085),\n (6.2159486, -0.97707933),\n (6.2239485, -0.97425944),\n (6.2319484, -0.97177476),\n (6.2399483, -0.969647),\n (6.247948, -0.96789366),\n (6.255948, -0.96652764),\n (6.263948, -0.96555734),\n (6.271948, -0.9649867),\n (6.2799478, -0.96481496),\n (6.2879477, -0.9650372),\n (6.2959476, -0.96564406),\n (6.3039474, -0.96662205),\n (6.3119473, -0.9679538),\n (6.3199472, -0.96961844),\n (6.327947, -0.9715916),\n (6.335947, -0.97384596),\n (6.343947, -0.97635156),\n (6.351947, -0.97907627),\n (6.3599467, -0.98198587),\n (6.3679466, -0.98504496),\n (6.3759465, -0.98821676),\n (6.3839464, -0.9914642),\n (6.3919463, -0.9947497),\n (6.399946, -0.9980363),\n (6.407946, -1.0012875),\n (6.415946, -1.0044675),\n (6.423946, -1.0075425),\n (6.431946, -1.01048),\n (6.4399457, -1.0132498),\n (6.4479456, -1.0158241),\n (6.4559455, -1.0181776),\n (6.4639454, -1.0202881),\n (6.4719453, -1.0221364),\n (6.479945, -1.0237064),\n (6.487945, -1.0249858),\n (6.495945, -1.0259651),\n (6.503945, -1.0266389),\n (6.511945, -1.0270048),\n (6.5199447, -1.0270644),\n (6.5279446, -1.0268223),\n (6.5359445, -1.0262864),\n (6.5439444, -1.0254676),\n (6.5519443, -1.0243802),\n (6.559944, -1.023041),\n (6.567944, -1.021469),\n (6.575944, -1.019686),\n (6.583944, -1.0177153),\n (6.5919437, -1.0155822),\n (6.5999436, -1.0133132),\n (6.6079435, -1.0109358),\n (6.6159434, -1.0084784),\n (6.6239433, -1.0059696),\n (6.631943, -1.0034382),\n (6.639943, -1.0009129),\n (6.647943, -0.9984215),\n (6.655943, -0.99599105),\n (6.663943, -0.9936476),\n (6.6719427, -0.99141556),\n (6.6799426, -0.98931783),\n (6.6879425, -0.98737544),\n (6.6959424, -0.98560715),\n (6.7039423, -0.98402965),\n (6.711942, -0.98265713),\n (6.719942, -0.9815013),\n (6.727942, -0.9805711),\n (6.735942, -0.979873),\n (6.743942, -0.97941077),\n (6.7519417, -0.9791853),\n (6.7599416, -0.97919506),\n (6.7679415, -0.97943586),\n (6.7759414, -0.9799009),\n (6.7839413, -0.98058116),\n (6.791941, -0.98146534),\n (6.799941, -0.98253995),\n (6.807941, -0.98378986),\n (6.815941, -0.98519814),\n (6.8239408, -0.98674625),\n (6.8319407, -0.9884146),\n (6.8399405, -0.99018264),\n (6.8479404, -0.99202883),\n (6.8559403, -0.9939314),\n (6.8639402, -0.9958682),\n (6.87194, -0.99781716),\n (6.87994, -0.9997564),\n (6.88794, -1.0016644),\n (6.89594, -1.0035207),\n (6.9039397, -1.0053055),\n (6.9119396, -1.0070002),\n (6.9199395, -1.0085876),\n (6.9279394, -1.0100518),\n (6.9359393, -1.0113788),\n (6.943939, -1.0125563),\n (6.951939, -1.0135736),\n (6.959939, -1.0144224),\n (6.967939, -1.0150962),\n (6.975939, -1.0155905),\n (6.9839387, -1.0159029),\n (6.9919386, -1.0160332),\n (6.9999385, -1.015983),\n (7.0079384, -1.0157561),\n (7.0159383, -1.0153582),\n (7.023938, -1.0147965),\n (7.031938, -1.0140803),\n (7.039938, -1.0132201),\n (7.047938, -1.0122279),\n (7.055938, -1.0111173),\n (7.0639377, -1.0099025),\n (7.0719376, -1.0085988),\n (7.0799375, -1.0072224),\n (7.0879374, -1.0057898),\n (7.0959373, -1.0043178),\n (7.103937, -1.0028235),\n (7.111937, -1.0013238),\n (7.119937, -0.99983567),\n (7.127937, -0.9983753),\n (7.1359367, -0.99695843),\n (7.1439366, -0.9956001),\n (7.1519365, -0.9943144),\n (7.1599364, -0.99311423),\n (7.1679363, -0.99201155),\n (7.175936, -0.99101686),\n (7.183936, -0.99013937),\n (7.191936, -0.9893867),\n (7.199936, -0.9887651),\n (7.207936, -0.98827916),\n (7.2159357, -0.98793197),\n (7.2239356, -0.98772484),\n (7.2319355, -0.9876578),\n (7.2399354, -0.987729),\n (7.2479353, -0.98793536),\n (7.255935, -0.98827213),\n (7.263935, -0.98873335),\n (7.271935, -0.9893117),\n (7.279935, -0.9899987),\n (7.287935, -0.9907849),\n (7.2959347, -0.9916597),\n (7.3039346, -0.99261194),\n (7.3119345, -0.99362963),\n (7.3199344, -0.99470043),\n (7.3279343, -0.99581134),\n (7.335934, -0.99694943),\n (7.343934, -0.9981016),\n (7.351934, -0.99925476),\n (7.359934, -1.000396),\n (7.3679338, -1.001513),\n (7.3759336, -1.0025938),\n (7.3839335, -1.0036267),\n (7.3919334, -1.0046015),\n (7.3999333, -1.005508),\n (7.407933, -1.0063375),\n (7.415933, -1.0070822),\n (7.423933, -1.0077353),\n (7.431933, -1.0082909),\n (7.439933, -1.0087447),\n (7.4479327, -1.0090934),\n (7.4559326, -1.009335),\n (7.4639325, -1.0094688),\n (7.4719324, -1.0094949),\n (7.4799323, -1.0094151),\n (7.487932, -1.009232),\n (7.495932, -1.0089496),\n (7.503932, -1.0),\n (7.511932, -1.0),\n (7.519932, -1.0),\n (7.5279317, -1.0),\n (7.5359316, -1.0),\n (7.5439315, -1.0),\n (7.5519314, -1.0),\n (7.5599313, -1.0),\n (7.567931, -1.0),\n (7.575931, -1.0),\n (7.583931, -1.0),\n (7.591931, -1.0),\n (7.599931, -1.0),\n (7.6079307, -1.0),\n (7.6159306, -1.0),\n (7.6239305, -1.0),\n (7.6319304, -1.0),\n (7.6399302, -1.0),\n (7.64793, -1.0),\n (7.65593, -1.0),\n (7.66393, -1.0),\n (7.67193, -1.0),\n (7.6799297, -1.0),\n (7.6879296, -1.0),\n (7.6959295, -1.0),\n (7.7039294, -1.0),\n (7.7119293, -1.0),\n (7.719929, -1.0),\n (7.727929, -1.0),\n (7.735929, -1.0),\n (7.743929, -1.0),\n (7.751929, -1.0),\n (7.7599287, -1.0),\n (7.7679286, -1.0),\n (7.7759285, -1.0),\n (7.7839284, -1.0),\n (7.7919283, -1.0),\n (7.799928, -1.0),\n (7.807928, -1.0),\n (7.815928, -1.0),\n (7.823928, -1.0),\n (7.831928, -1.0),\n (7.8399277, -1.0),\n (7.8479276, -1.0),\n (7.8559275, -1.0),\n (7.8639274, -1.0),\n (7.8719273, -1.0),\n (7.879927, -1.0),\n (7.887927, -1.0),\n (7.895927, -1.0),\n (7.903927, -1.0),\n (7.9119267, -1.0),\n (7.9199266, -1.0),\n (7.9279265, -1.0),\n (7.9359264, -1.0),\n (7.9439263, -1.0),\n (7.951926, -1.0),\n (7.959926, -1.0),\n (7.967926, -1.0),\n (7.975926, -1.0),\n (7.983926, -1.0),\n (7.9919257, -1.0),\n (7.9999256, -1.0),\n (8.007926, -1.0),\n (8.015926, -1.0),\n (8.023927, -1.0),\n (8.031927, -1.0),\n (8.0399275, -1.0),\n (8.047928, -1.0),\n (8.055928, -1.0),\n (8.063929, -1.0),\n (8.071929, -1.0),\n (8.079929, -1.0),\n (8.08793, -1.0),\n (8.09593, -1.0),\n (8.10393, -1.0),\n (8.111931, -1.0),\n (8.119931, -1.0),\n (8.127932, -1.0),\n (8.135932, -1.0),\n (8.143932, -1.0),\n (8.151933, -1.0),\n (8.159933, -1.0),\n (8.167933, -1.0),\n (8.175934, -1.0),\n (8.183934, -1.0),\n (8.191935, -1.0),\n (8.199935, -1.0),\n (8.207935, -1.0),\n (8.215936, -1.0),\n (8.223936, -1.0),\n (8.231936, -1.0),\n (8.239937, -1.0),\n (8.247937, -1.0),\n (8.255938, -1.0),\n (8.263938, -1.0),\n (8.271938, -1.0),\n (8.279939, -1.0),\n (8.287939, -1.0),\n (8.295939, -1.0),\n (8.30394, -1.0),\n (8.31194, -1.0),\n (8.319941, -1.0),\n (8.327941, -1.0),\n (8.335941, -1.0),\n (8.343942, -1.0),\n (8.351942, -1.0),\n (8.359942, -1.0),\n (8.367943, -1.0),\n (8.375943, -1.0),\n (8.383944, -1.0),\n (8.391944, -1.0),\n (8.399944, -1.0),\n (8.407945, -1.0),\n (8.415945, -1.0),\n (8.423945, -1.0),\n (8.431946, -1.0),\n (8.439946, -1.0),\n (8.447947, -1.0),\n (8.455947, -1.0),\n (8.463947, -1.0),\n (8.471948, -1.0),\n (8.479948, -1.0),\n (8.487948, -1.0),\n (8.495949, -1.0),\n (8.503949, -1.0),\n (8.51195, -1.0),\n (8.51995, -1.0),\n (8.52795, -1.0),\n (8.535951, -1.0),\n (8.543951, -1.0),\n (8.551951, -1.0),\n (8.559952, -1.0),\n (8.567952, -1.0),\n (8.575953, -1.0),\n (8.583953, -1.0),\n (8.591953, -1.0),\n (8.599954, -1.0),\n (8.607954, -1.0),\n (8.615954, -1.0),\n (8.623955, -1.0),\n (8.631955, -1.0),\n (8.6399555, -1.0),\n (8.647956, -1.0),\n (8.655956, -1.0),\n (8.663957, -1.0),\n (8.671957, -1.0),\n (8.679957, -1.0),\n (8.687958, -1.0),\n (8.695958, -1.0),\n (8.7039585, -1.0),\n (8.711959, -1.0),\n (8.719959, -1.0),\n (8.72796, -1.0),\n (8.73596, -1.0),\n (8.74396, -1.0),\n (8.751961, -1.0),\n (8.759961, -1.0),\n (8.7679615, -1.0),\n (8.775962, -1.0),\n (8.783962, -1.0),\n (8.791963, -1.0),\n (8.799963, -1.0),\n (8.807963, -1.0),\n (8.815964, -1.0),\n (8.823964, -1.0),\n (8.8319645, -1.0),\n (8.839965, -1.0),\n (8.847965, -1.0),\n (8.855966, -1.0),\n (8.863966, -1.0),\n (8.871966, -1.0),\n (8.879967, -1.0),\n (8.887967, -1.0),\n (8.8959675, -1.0),\n (8.903968, -1.0),\n (8.911968, -1.0),\n (8.919969, -1.0),\n (8.927969, -1.0),\n (8.935969, -1.0),\n (8.94397, -1.0),\n (8.95197, -1.0),\n (8.95997, -1.0),\n (8.967971, -1.0),\n (8.975971, -1.0),\n (8.983972, -1.0),\n (8.991972, -1.0),\n (8.999972, -1.0),\n (9.007973, -1.0),\n (9.015973, -1.0),\n (9.023973, -1.0),\n (9.031974, -1.0),\n (9.039974, -1.0),\n (9.047975, -1.0),\n (9.055975, -1.0),\n (9.063975, -1.0),\n (9.071976, -1.0),\n (9.079976, -1.0),\n (9.087976, -1.0),\n (9.095977, -1.0),\n (9.103977, -1.0),\n (9.111978, -1.0),\n (9.119978, -1.0),\n (9.127978, -1.0),\n (9.135979, -1.0),\n (9.143979, -1.0),\n (9.151979, -1.0),\n (9.15998, -1.0),\n (9.16798, -1.0),\n (9.175981, -1.0),\n (9.183981, -1.0),\n (9.191981, -1.0),\n (9.199982, -1.0),\n (9.207982, -1.0),\n (9.215982, -1.0),\n (9.223983, -1.0),\n (9.231983, -1.0),\n (9.239984, -1.0),\n (9.247984, -1.0),\n (9.255984, -1.0),\n (9.263985, -1.0),\n (9.271985, -1.0),\n (9.279985, -1.0),\n (9.287986, -1.0),\n (9.295986, -1.0),\n (9.303987, -1.0),\n (9.311987, -1.0),\n (9.319987, -1.0),\n (9.327988, -1.0),\n (9.335988, -1.0),\n (9.343988, -1.0),\n (9.351989, -1.0),\n (9.359989, -1.0),\n (9.36799, -1.0),\n (9.37599, -1.0),\n (9.38399, -1.0),\n (9.391991, -1.0),\n (9.399991, -1.0),\n (9.407991, -1.0),\n (9.415992, -1.0),\n (9.423992, -1.0),\n (9.431993, -1.0),\n (9.439993, -1.0),\n (9.447993, -1.0),\n (9.455994, -1.0),\n (9.463994, -1.0),\n (9.471994, -1.0),\n (9.479995, -1.0),\n (9.487995, -1.0),\n (9.4959955, -1.0),\n (9.503996, -1.0),\n (9.511996, -1.0),\n (9.519997, -1.0),\n (9.527997, -1.0),\n (9.535997, -1.0),\n (9.543998, -1.0),\n (9.551998, -1.0),\n (9.5599985, -1.0),\n (9.567999, -1.0),\n (9.575999, -1.0),\n (9.584, -1.0),\n (9.592, -1.0),\n (9.6, -1.0),\n (9.608001, -1.0),\n (9.616001, -1.0),\n (9.6240015, -1.0),\n (9.632002, -1.0),\n (9.640002, -1.0),\n (9.648003, -1.0),\n (9.656003, -1.0),\n (9.664003, -1.0),\n (9.672004, -1.0),\n (9.680004, -1.0),\n (9.6880045, -1.0),\n (9.696005, -1.0),\n (9.704005, -1.0),\n (9.712006, -1.0),\n (9.720006, -1.0),\n (9.728006, -1.0),\n (9.736007, -1.0),\n (9.744007, -1.0),\n (9.7520075, -1.0),\n (9.760008, -1.0),\n (9.768008, -1.0),\n (9.776009, -1.0),\n (9.784009, -1.0),\n (9.792009, -1.0),\n (9.80001, -1.0),\n (9.80801, -1.0),\n (9.81601, -1.0),\n (9.824011, -1.0),\n (9.832011, -1.0),\n (9.840012, -1.0),\n (9.848012, -1.0),\n (9.856012, -1.0),\n (9.864013, -1.0),\n (9.872013, -1.0),\n (9.880013, -1.0),\n (9.888014, -1.0),\n (9.896014, -1.0),\n (9.904015, -1.0),\n (9.912015, -1.0),\n (9.920015, -1.0),\n (9.928016, -1.0),\n (9.936016, -1.0),\n (9.944016, -1.0),\n (9.952017, -1.0),\n (9.960017, -1.0),\n (9.968018, -1.0),\n (9.976018, -1.0),\n (9.984018, -1.0),\n (9.992019, -1.0),\n (10.000019, -1.0),\n (10.008019, -1.0),\n (10.01602, -1.0),\n (10.02402, -1.0),\n (10.032021, -1.0),\n (10.040021, -1.0),\n (10.048021, -1.0),\n (10.056022, -1.0),\n (10.064022, -1.0),\n (10.072022, -1.0),\n (10.080023, -1.0),\n (10.088023, -1.0),\n (10.096024, -1.0),\n (10.104024, -1.0),\n (10.112024, -1.0),\n (10.120025, -1.0),\n (10.128025, -1.0),\n (10.136025, -1.0),\n (10.144026, -1.0),\n (10.152026, -1.0),\n (10.160027, -1.0),\n (10.168027, -1.0),\n (10.176027, -1.0),\n (10.184028, -1.0),\n (10.192028, -1.0),\n (10.200028, -1.0),\n (10.208029, -1.0),\n (10.216029, -1.0),\n (10.22403, -1.0),\n (10.23203, -1.0),\n (10.24003, -1.0),\n (10.248031, -1.0),\n (10.256031, -1.0),\n (10.264031, -1.0),\n (10.272032, -1.0),\n (10.280032, -1.0),\n (10.288033, -1.0),\n (10.296033, -1.0),\n (10.304033, -1.0),\n (10.312034, -1.0),\n (10.320034, -1.0),\n (10.328034, -1.0),\n (10.336035, -1.0),\n (10.344035, -1.0),\n (10.3520355, -1.0),\n (10.360036, -1.0),\n (10.368036, -1.0),\n (10.376037, -1.0),\n (10.384037, -1.0),\n (10.392037, -1.0),\n (10.400038, -1.0),\n (10.408038, -1.0),\n (10.4160385, -1.0),\n (10.424039, -1.0),\n (10.432039, -1.0),\n (10.44004, -1.0),\n (10.44804, -1.0),\n (10.45604, -1.0),\n (10.464041, -1.0),\n (10.472041, -1.0),\n (10.4800415, -1.0),\n (10.488042, -1.0),\n (10.496042, -1.0),\n (10.504043, -1.0),\n (10.512043, -1.0),\n (10.520043, -1.0),\n (10.528044, -1.0),\n (10.536044, -1.0),\n (10.5440445, -1.0),\n (10.552045, -1.0),\n (10.560045, -1.0),\n (10.568046, -1.0),\n (10.576046, -1.0),\n (10.584046, -1.0),\n (10.592047, -1.0),\n (10.600047, -1.0),\n (10.6080475, -1.0),\n (10.616048, -1.0),\n (10.624048, -1.0),\n (10.632049, -1.0),\n (10.640049, -1.0),\n (10.648049, -1.0),\n (10.65605, -1.0),\n (10.66405, -1.0),\n (10.67205, -1.0),\n (10.680051, -1.0),\n (10.688051, -1.0),\n (10.696052, -1.0),\n (10.704052, -1.0),\n (10.712052, -1.0),\n (10.720053, -1.0),\n (10.728053, -1.0),\n (10.736053, -1.0),\n (10.744054, -1.0),\n (10.752054, -1.0),\n (10.760055, -1.0),\n (10.768055, -1.0),\n (10.776055, -1.0),\n (10.784056, -1.0),\n (10.792056, -1.0),\n (10.800056, -1.0),\n (10.808057, -1.0),\n (10.816057, -1.0),\n (10.824058, -1.0),\n (10.832058, -1.0),\n (10.840058, -1.0),\n (10.848059, -1.0),\n (10.856059, -1.0),\n (10.864059, -1.0),\n (10.87206, -1.0),\n (10.88006, -1.0),\n (10.888061, -1.0),\n (10.896061, -1.0),\n (10.904061, -1.0),\n (10.912062, -1.0),\n (10.920062, -1.0),\n (10.928062, -1.0),\n (10.936063, -1.0),\n (10.944063, -1.0),\n (10.952064, -1.0),\n (10.960064, -1.0),\n (10.968064, -1.0),\n (10.976065, -1.0),\n (10.984065, -1.0),\n (10.992065, -1.0),\n (11.000066, -0.9983549),\n (11.008066, -0.79834557),\n (11.016067, -0.5983362),\n (11.024067, -0.39832687),\n (11.032067, -0.19831753),\n (11.040068, 1.6918182e-3),\n (11.048068, 0.20170116),\n (11.056068, 0.4017105),\n (11.064069, 0.60171986),\n (11.072069, 0.8017292),\n (11.08007, 1.0017385),\n (11.08807, 1.2017479),\n (11.09607, 1.4017572),\n (11.104071, 1.6017666),\n (11.112071, 1.8017759),\n (11.120071, 2.0017853),\n (11.128072, 2.2017946),\n (11.136072, 2.401804),\n (11.144073, 2.6018133),\n (11.152073, 2.8018227),\n (11.160073, 3.001832),\n (11.168074, 3.2018414),\n (11.176074, 3.4018507),\n (11.184074, 3.60186),\n (11.192075, 3.8018694),\n (11.200075, 4.000189),\n (11.208076, 4.020098),\n (11.216076, 4.039489),\n (11.224076, 4.0581737),\n (11.232077, 4.0759754),\n (11.240077, 4.0927286),\n (11.248077, 4.1082807),\n (11.256078, 4.1224947),\n (11.264078, 4.1352477),\n (11.2720785, 4.146435),\n (11.280079, 4.155968),\n (11.288079, 4.163778),\n (11.29608, 4.169812),\n (11.30408, 4.1740384),\n (11.31208, 4.176443),\n (11.320081, 4.177031),\n (11.328081, 4.1758246),\n (11.3360815, 4.1728644),\n (11.344082, 4.1682086),\n (11.352082, 4.161931),\n (11.360083, 4.1541204),\n (11.368083, 4.14488),\n (11.376083, 4.1343255),\n (11.384084, 4.1225843),\n (11.392084, 4.1097937),\n (11.4000845, 4.096099),\n (11.408085, 4.0816526),\n (11.416085, 4.0666127),\n (11.424086, 4.05114),\n (11.432086, 4.035397),\n (11.440086, 4.019547),\n (11.448087, 4.0037518),\n (11.456087, 3.9881692),\n (11.4640875, 3.9729538),\n (11.472088, 3.958252),\n (11.480088, 3.9442048),\n (11.488089, 3.930943),\n (11.496089, 3.9185877),\n (11.504089, 3.9072495),\n (11.51209, 3.8970265),\n (11.52009, 3.8880038),\n (11.5280905, 3.8802538),\n (11.536091, 3.8738337),\n (11.544091, 3.8687878),\n (11.552092, 3.8651443),\n (11.560092, 3.8629189),\n (11.568092, 3.8621106),\n (11.576093, 3.8627052),\n (11.584093, 3.8646746),\n (11.592093, 3.8679771),\n (11.600094, 3.8725586),\n (11.608094, 3.8783517),\n (11.616095, 3.8852797),\n (11.624095, 3.8932538),\n (11.632095, 3.9021783),\n (11.640096, 3.9119468),\n (11.648096, 3.9224482),\n (11.656096, 3.9335647),\n (11.664097, 3.9451742),\n (11.672097, 3.9571528),\n (11.680098, 3.9693727),\n (11.688098, 3.981708),\n (11.696098, 3.9940314),\n (11.704099, 4.0062194),\n (11.712099, 4.0181518),\n (11.720099, 4.0297112),\n (11.7281, 4.0407877),\n (11.7361, 4.051277),\n (11.744101, 4.0610833),\n (11.752101, 4.070118),\n (11.760101, 4.078302),\n (11.768102, 4.085567),\n (11.776102, 4.0918536),\n (11.784102, 4.0971146),\n (11.792103, 4.101313),\n (11.800103, 4.1044235),\n (11.808104, 4.1064315),\n (11.816104, 4.1073346),\n (11.824104, 4.1071415),\n (11.832105, 4.105871),\n (11.840105, 4.1035533),\n (11.848105, 4.100229),\n (11.856106, 4.0959463),\n (11.864106, 4.090764),\n (11.872107, 4.0847497),\n (11.880107, 4.0779757),\n (11.888107, 4.0705237),\n (11.896108, 4.0624785),\n (11.904108, 4.053931),\n (11.912108, 4.044976),\n (11.920109, 4.0357094),\n (11.928109, 4.02623),\n (11.93611, 4.0166364),\n (11.94411, 4.0070276),\n (11.95211, 3.9975004),\n (11.960111, 3.9881496),\n (11.968111, 3.9790664),\n (11.976111, 3.9703388),\n (11.984112, 3.9620485),\n (11.992112, 3.9542727),\n (12.000113, 3.9470816),\n (12.008113, 3.9405375),\n (12.016113, 3.9346972),\n (12.024114, 3.9296079),\n (12.032114, 3.9253092),\n (12.040114, 3.9218316),\n (12.048115, 3.919197),\n (12.056115, 3.9174194),\n (12.064116, 3.9165025),\n (12.072116, 3.916442),\n (12.080116, 3.9172244),\n (12.088117, 3.9188294),\n (12.096117, 3.921227),\n (12.104117, 3.9243808),\n (12.112118, 3.928247),\n (12.120118, 3.932775),\n (12.1281185, 3.9379091),\n (12.136119, 3.9435878),\n (12.144119, 3.9497452),\n (12.15212, 3.9563112),\n (12.16012, 3.9632134),\n (12.16812, 3.9703774),\n (12.176121, 3.977726),\n (12.184121, 3.9851823),\n (12.1921215, 3.99267),\n (12.200122, 4.0001125),\n (12.208122, 4.007436),\n (12.216123, 4.0145683),\n (12.224123, 4.02144),\n (12.232123, 4.027987),\n (12.240124, 4.0341477),\n (12.248124, 4.0398664),\n (12.2561245, 4.045092),\n (12.264125, 4.049781),\n (12.272125, 4.0538926),\n (12.280126, 4.057396),\n (12.288126, 4.0602655),\n (12.296126, 4.0624814),\n (12.304127, 4.064032),\n (12.312127, 4.0649133),\n (12.3201275, 4.0651255),\n (12.328128, 4.0646777),\n (12.336128, 4.0635853),\n (12.344129, 4.0618687),\n (12.352129, 4.059556),\n (12.360129, 4.0566792),\n (12.36813, 4.053277),\n (12.37613, 4.0493917),\n (12.3841305, 4.0450697),\n (12.392131, 4.0403624),\n (12.400131, 4.0353227),\n (12.408132, 4.0300064),\n (12.416132, 4.0244727),\n (12.424132, 4.0187798),\n (12.432133, 4.0129876),\n (12.440133, 4.007157),\n (12.448133, 4.0013466),\n (12.456134, 3.9956145),\n (12.464134, 3.990018),\n (12.472135, 3.984611),\n (12.480135, 3.9794445),\n (12.488135, 3.974568),\n (12.496136, 3.9700246),\n (12.504136, 3.9658556),\n (12.512136, 3.9620976),\n (12.520137, 3.9587808),\n (12.528137, 3.9559326),\n (12.536138, 3.9535737),\n (12.544138, 3.9517202),\n (12.552138, 3.9503832),\n (12.560139, 3.9495673),\n (12.568139, 3.949273),\n (12.576139, 3.9494948),\n (12.58414, 3.9502225),\n (12.59214, 3.9514399),\n (12.600141, 3.9531279),\n (12.608141, 3.9552617),\n (12.616141, 3.9578128),\n (12.624142, 3.9607487),\n (12.632142, 3.9640336),\n (12.640142, 3.967629),\n (12.648143, 3.9714937),\n (12.656143, 3.975584),\n (12.664144, 3.979856),\n (12.672144, 3.9842634),\n (12.680144, 3.9887595),\n (12.688145, 3.993297),\n (12.696145, 3.9978309),\n (12.704145, 4.002314),\n (12.712146, 4.006703),\n (12.720146, 4.0109544),\n (12.728147, 4.015028),\n (12.736147, 4.0188856),\n (12.744147, 4.0224915),\n (12.752148, 4.0258136),\n (12.760148, 4.0288224),\n (12.768148, 4.0314927),\n (12.776149, 4.0338035),\n (12.784149, 4.0357366),\n (12.79215, 4.0372787),\n (12.80015, 4.0384207),\n (12.80815, 4.039157),\n (12.816151, 4.039487),\n (12.824151, 4.0394135),\n (12.832151, 4.038944),\n (12.840152, 4.0380893),\n (12.848152, 4.036864),\n (12.856153, 4.0352864),\n (12.864153, 4.033378),\n (12.872153, 4.0311637),\n (12.880154, 4.0286703),\n (12.888154, 4.0259275),\n (12.896154, 4.022967),\n (12.904155, 4.019821),\n (12.912155, 4.016526),\n (12.920156, 4.0131164),\n (12.928156, 4.009629),\n (12.936156, 4.0060997),\n (12.944157, 4.002565),\n (12.952157, 3.9990602),\n (12.960157, 3.9956207),\n (12.968158, 3.99228),\n (12.976158, 3.98907),\n (12.9841585, 3.986021),\n (12.992159, 3.983162),\n (13.000159, 3.9805174),\n (13.00816, 3.9781117),\n (13.01616, 3.9759645),\n (13.02416, 3.974094),\n (13.032161, 3.9725142),\n (13.040161, 3.9712367),\n (13.0481615, 3.9702697),\n (13.056162, 3.9696174),\n (13.064162, 3.9692817),\n (13.072163, 3.9692612),\n (13.080163, 3.969551),\n (13.088163, 3.9701433),\n (13.096164, 3.971027),\n (13.104164, 3.972189),\n (13.1121645, 3.9736128),\n (13.120165, 3.9752798),\n (13.128165, 3.97717),\n (13.136166, 3.97926),\n (13.144166, 3.981526),\n (13.152166, 3.9839425),\n (13.160167, 3.9864821),\n (13.168167, 3.989118),\n (13.1761675, 3.9918218),\n (13.184168, 3.994565),\n (13.192168, 3.9973197),\n (13.200169, 4.000057),\n (13.208169, 4.002751),\n (13.216169, 4.0053744),\n (13.22417, 4.0079017),\n (13.23217, 4.0103097),\n (13.2401705, 4.012575),\n (13.248171, 4.0146775),\n (13.256171, 4.016599),\n (13.264172, 4.018323),\n (13.272172, 4.019834),\n (13.280172, 4.0211215),\n (13.288173, 4.022176),\n (13.296173, 4.0229897),\n (13.304173, 4.0235586),\n (13.312174, 4.0238814),\n (13.320174, 4.023958),\n (13.328175, 4.023792),\n (13.336175, 4.023389),\n (13.344175, 4.022756),\n (13.352176, 4.021904),\n (13.360176, 4.0208445),\n (13.368176, 4.019592),\n (13.376177, 4.0181613),\n (13.384177, 4.0165706),\n (13.392178, 4.0148377),\n (13.400178, 4.0129833),\n (13.408178, 4.0110273),\n (13.416179, 4.008991),\n (13.424179, 4.0068965),\n (13.432179, 4.0047655),\n (13.44018, 4.00262),\n (13.44818, 4.000483),\n (13.456181, 3.9983745),\n (13.464181, 3.996316),\n (13.472181, 3.994327),\n (13.480182, 3.9924273),\n (13.488182, 3.990634),\n (13.496182, 3.9889631),\n (13.504183, 3.9874306),\n (13.512183, 3.9860487),\n (13.520184, 3.98483),\n (13.528184, 3.9837828),\n (13.536184, 3.9829164),\n (13.544185, 3.9822354),\n (13.552185, 3.9817448),\n (13.560185, 3.9814458),\n (13.568186, 3.9813385),\n (13.576186, 3.981421),\n (13.584187, 3.98169),\n (13.592187, 3.982139),\n (13.600187, 3.982761),\n (13.608188, 3.9835467),\n (13.616188, 3.984486),\n (13.624188, 3.985567),\n (13.632189, 3.9867759),\n (13.640189, 3.9880996),\n (13.64819, 3.9895215),\n (13.65619, 3.9910269),\n (13.66419, 3.992599),\n (13.672191, 3.9942203),\n (13.680191, 3.9958744),\n (13.688191, 3.9975438),\n (13.696192, 3.9992118),\n (13.704192, 4.0008607),\n (13.712193, 4.0024753),\n (13.720193, 4.004039),\n (13.728193, 4.005537),\n (13.736194, 4.0069556),\n (13.744194, 4.0082817),\n (13.752194, 4.009503),\n (13.760195, 4.010609),\n (13.768195, 4.011591),\n (13.776196, 4.01244),\n (13.784196, 4.0131507),\n (13.792196, 4.013717),\n (13.800197, 4.0141363),\n (13.808197, 4.014406),\n (13.816197, 4.014527),\n (13.824198, 4.0144987),\n (13.832198, 4.014325),\n (13.8401985, 4.01401),\n (13.848199, 4.0135584),\n (13.856199, 4.0129776),\n (13.8642, 4.0122747),\n (13.8722, 4.0114594),\n (13.8802, 4.0105414),\n (13.888201, 4.009532),\n (13.896201, 4.0084424),\n (13.9042015, 4.007285),\n (13.912202, 4.0060725),\n (13.920202, 4.004818),\n (13.928203, 4.003535),\n (13.936203, 4.0022364),\n (13.944203, 4.000936),\n (13.952204, 3.9996467),\n (13.960204, 3.9983816),\n (13.9682045, 3.9971528),\n (13.976205, 3.9959722),\n (13.984205, 3.994851),\n (13.992206, 3.9937997),\n (14.000206, 3.9928274),\n (14.008206, 3.991943),\n (14.016207, 3.9911537),\n (14.024207, 3.990466),\n (14.0322075, 3.9898853),\n (14.040208, 3.9894161),\n (14.048208, 3.9890609),\n (14.056209, 3.988822),\n (14.064209, 3.988699),\n (14.072209, 3.9886923),\n (14.08021, 3.9887996),\n (14.08821, 3.989018),\n (14.0962105, 3.9893436),\n (14.104211, 3.9897718),\n (14.112211, 3.990296),\n (14.120212, 3.9909096),\n (14.128212, 3.9916053),\n (14.136212, 3.992375),\n (14.144213, 3.993209),\n (14.152213, 3.9940982),\n (14.160213, 3.9950328),\n (14.168214, 3.9960027),\n (14.176214, 3.9969974),\n (14.184215, 3.9980063),\n (14.192215, 3.9990196),\n (14.200215, 3.996408),\n (14.208216, 3.863068),\n (14.216216, 3.7297287),\n (14.224216, 3.5963893),\n (14.232217, 3.4630494),\n (14.240217, 3.32971),\n (14.248218, 3.1963706),\n (14.256218, 3.0630307),\n (14.264218, 2.9296913),\n (14.272219, 2.796352),\n (14.280219, 2.6630123),\n (14.288219, 2.5296726),\n (14.29622, 2.3963332),\n (14.30422, 2.2629936),\n (14.312221, 2.129654),\n (14.320221, 1.9963145),\n (14.328221, 1.8629749),\n (14.336222, 1.7296352),\n (14.344222, 1.5962958),\n (14.352222, 1.4629562),\n (14.360223, 1.3296165),\n (14.368223, 1.1962771),\n (14.376224, 1.0629375),\n (14.384224, 0.92959785),\n (14.392224, 0.79625845),\n (14.400225, 0.6629188),\n (14.408225, 0.5295794),\n (14.416225, 0.39623976),\n (14.424226, 0.2629001),\n (14.432226, 0.12956071),\n (14.440227, -3.7789345e-3),\n (14.448227, -0.13711834),\n (14.456227, -0.27045822),\n (14.464228, -0.40379763),\n (14.472228, -0.53713703),\n (14.480228, -0.6704769),\n (14.488229, -0.8038163),\n (14.496229, -0.9371557),\n (14.50423, -1.0138799),\n (14.51223, -1.0396309),\n (14.52023, -1.0644922),\n (14.528231, -1.0882031),\n (14.536231, -1.1105201),\n (14.544231, -1.1312197),\n (14.552232, -1.1501),\n (14.560232, -1.1669829),\n (14.568233, -1.1817157),\n (14.576233, -1.1941723),\n (14.584233, -1.2042537),\n (14.592234, -1.2118895),\n (14.600234, -1.2170376),\n (14.608234, -1.219684),\n (14.616235, -1.219843),\n (14.624235, -1.2175564),\n (14.632236, -1.212892),\n (14.640236, -1.2059433),\n (14.648236, -1.1968274),\n (14.656237, -1.1856833),\n (14.664237, -1.1726702),\n (14.672237, -1.1579654),\n (14.680238, -1.1417618),\n (14.688238, -1.1242657),\n (14.6962385, -1.1056938),\n (14.704239, -1.0862715),\n (14.712239, -1.0662293),\n (14.72024, -1.045801),\n (14.72824, -1.02522),\n (14.73624, -1.004718),\n (14.744241, -0.98452103),\n (14.752241, -0.9648486),\n (14.7602415, -0.9459099),\n (14.768242, -0.92790276),\n (14.776242, -0.9110109),\n (14.784243, -0.89540267),\n (14.792243, -0.88122904),\n (14.800243, -0.86862254),\n (14.808244, -0.85769594),\n (14.816244, -0.8485412),\n (14.8242445, -0.8412293),\n (14.832245, -0.83580923),\n (14.840245, -0.8323083),\n (14.848246, -0.83073187),\n (14.856246, -0.8310639),\n (14.864246, -0.83326745),\n (14.872247, -0.83728534),\n (14.880247, -0.84304124),\n (14.8882475, -0.85044086),\n (14.896248, -0.8593734),\n (14.904248, -0.8697127),\n (14.912249, -0.88131946),\n (14.920249, -0.8940425),\n (14.928249, -0.90772104),\n (14.93625, -0.9221863),\n (14.94425, -0.93726397),\n (14.9522505, -0.9527756),\n (14.960251, -0.9685415),\n (14.968251, -0.98438185),\n (14.976252, -1.0001194),\n (14.984252, -1.015581),\n (14.992252, -1.0305998),\n (15.000253, -1.0450164),\n (15.008253, -1.0586814),\n (15.016253, -1.0714558),\n (15.024254, -1.0832133),\n (15.032254, -1.0938411),\n (15.040255, -1.1032405),\n (15.048255, -1.1113287),\n (15.056255, -1.1180388),\n (15.064256, -1.12332),\n (15.072256, -1.1271389),\n (15.080256, -1.1294781),\n (15.088257, -1.1303378),\n (15.096257, -1.1297342),\n (15.104258, -1.1276994),\n (15.112258, -1.1242812),\n (15.120258, -1.1195414),\n (15.128259, -1.113556),\n (15.136259, -1.1064131),\n (15.144259, -1.0982125),\n (15.15226, -1.0890635),\n (15.16026, -1.0790844),\n (15.168261, -1.0684005),\n (15.176261, -1.0571431),\n (15.184261, -1.0454471),\n (15.192262, -1.03345),\n (15.200262, -1.0212905),\n (15.208262, -1.0091068),\n (15.216263, -0.99703425),\n (15.224263, -0.98520535),\n (15.232264, -0.97374713),\n (15.240264, -0.96278065),\n (15.248264, -0.9524191),\n (15.256265, -0.9427671),\n (15.264265, -0.93391937),\n (15.272265, -0.92596036),\n (15.280266, -0.918963),\n (15.288266, -0.9129882),\n (15.296267, -0.9080845),\n (15.304267, -0.9042878),\n (15.312267, -0.9016209),\n (15.320268, -0.9000938),\n (15.328268, -0.8997035),\n (15.336268, -0.9004345),\n (15.344269, -0.9022592),\n (15.352269, -0.90513813),\n (15.36027, -0.909021),\n (15.36827, -0.91384715),\n (15.37627, -0.9195464),\n (15.384271, -0.9260403),\n (15.392271, -0.93324274),\n (15.400271, -0.9410613),\n (15.408272, -0.94939846),\n (15.416272, -0.9581524),\n (15.424273, -0.96721876),\n (15.432273, -0.9764911),\n (15.440273, -0.9858629),\n (15.448274, -0.9952283),\n (15.456274, -1.0044833),\n (15.464274, -1.0135272),\n (15.472275, -1.0222628),\n (15.480275, -1.0305986),\n (15.488276, -1.0384489),\n (15.496276, -1.0457352),\n (15.504276, -1.052386),\n (15.512277, -1.0583386),\n (15.520277, -1.0635391),\n (15.528277, -1.067943),\n (15.536278, -1.0715148),\n (15.544278, -1.0742297),\n (15.5522785, -1.0760725),\n (15.560279, -1.0770376),\n (15.568279, -1.0771298),\n (15.57628, -1.0763634),\n (15.58428, -1.0747617),\n (15.59228, -1.0723573),\n (15.600281, -1.0691907),\n (15.608281, -1.0653105),\n (15.6162815, -1.0607723),\n (15.624282, -1.0556378),\n (15.632282, -1.0499748),\n (15.640283, -1.0438552),\n (15.648283, -1.037355),\n (15.656283, -1.0305531),\n (15.664284, -1.0235304),\n (15.672284, -1.0163687),\n (15.6802845, -1.0091501),\n (15.688285, -1.0019557),\n (15.696285, -0.9948652),\n (15.704286, -0.9879554),\n (15.712286, -0.98130006),\n (15.720286, -0.9749685),\n (15.728287, -0.9690257),\n (15.736287, -0.96353066),\n (15.7442875, -0.95853686),\n (15.752288, -0.9540909),\n (15.760288, -0.9502326),\n (15.768289, -0.94699466),\n (15.776289, -0.9444023),\n (15.784289, -0.94247293),\n (15.79229, -0.94121647),\n (15.80029, -0.9406352),\n (15.8082905, -0.9407237),\n (15.816291, -0.94146943),\n (15.824291, -0.9428525),\n (15.832292, -0.9448465),\n (15.840292, -0.9474186),\n (15.848292, -0.9505301),\n (15.856293, -0.954137),\n (15.864293, -0.9581907),\n (15.872293, -0.9626382),\n (15.880294, -0.9674233),\n (15.888294, -0.972487),\n (15.896295, -0.97776794),\n (15.904295, -0.98320395),\n (15.912295, -0.9887317),\n (15.920296, -0.9942882),\n (15.928296, -0.99981123),\n (15.936296, -1.00524),\n (15.944297, -1.0105158),\n (15.952297, -1.0155828),\n (15.960298, -1.0203881),\n (15.968298, -1.0248832),\n (15.976298, -1.0290232),\n (15.984299, -1.0327685),\n (15.992299, -1.0360843),\n (16.0003, -1.0389413),\n (16.008299, -1.0413154),\n (16.016298, -1.0431892),\n (16.024298, -1.0445504),\n (16.032297, -1.045393),\n (16.040297, -1.0457165),\n (16.048296, -1.0455265),\n (16.056295, -1.0448341),\n (16.064295, -1.0436556),\n (16.072294, -1.0420127),\n (16.080294, -1.0399318),\n (16.088293, -1.0374434),\n (16.096292, -1.0345825),\n (16.104292, -1.0313873),\n (16.112291, -1.0278991),\n (16.12029, -1.0241619),\n (16.12829, -1.0202215),\n (16.13629, -1.016125),\n (16.144289, -1.0119209),\n (16.152288, -1.0076578),\n (16.160288, -1.0033838),\n (16.168287, -0.99914694),\n (16.176287, -0.9949933),\n (16.184286, -0.9909679),\n (16.192286, -0.987113),\n (16.200285, -0.9834686),\n (16.208284, -0.9800713),\n (16.216284, -0.97695476),\n (16.224283, -0.9741486),\n (16.232283, -0.97167856),\n (16.240282, -0.9695663),\n (16.248281, -0.9678289),\n (16.25628, -0.9664793),\n (16.26428, -0.9655256),\n (16.27228, -0.9649716),\n (16.28028, -0.9648164),\n (16.288279, -0.96505475),\n (16.296278, -0.9656772),\n (16.304277, -0.9666701),\n (16.312277, -0.96801597),\n (16.320276, -0.96969366),\n (16.328276, -0.97167885),\n (16.336275, -0.97394395),\n (16.344275, -0.9764591),\n (16.352274, -0.97919184),\n (16.360273, -0.9821081),\n (16.368273, -0.9851723),\n (16.376272, -0.98834777),\n (16.384272, -0.99159724),\n (16.392271, -0.9948834),\n (16.40027, -0.99816906),\n (16.40827, -1.0014178),\n (16.41627, -1.0045941),\n (16.424269, -1.0076638),\n (16.432268, -1.010595),\n (16.440268, -1.0133573),\n (16.448267, -1.015923),\n (16.456266, -1.0182672),\n (16.464266, -1.0203674),\n (16.472265, -1.0222046),\n (16.480265, -1.0237632),\n (16.488264, -1.0250306),\n (16.496264, -1.0259978),\n (16.504263, -1.0266593),\n (16.512262, -1.0270131),\n (16.520262, -1.0270605),\n (16.528261, -1.0268066),\n (16.53626, -1.0262592),\n (16.54426, -1.0254297),\n (16.55226, -1.0243322),\n (16.560259, -1.0229834),\n (16.568258, -1.0214028),\n (16.576258, -1.0196121),\n (16.584257, -1.0176346),\n (16.592257, -1.0154958),\n (16.600256, -1.0132222),\n (16.608255, -1.0108413),\n (16.616255, -1.0083815),\n (16.624254, -1.0058714),\n (16.632254, -1.00334),\n (16.640253, -1.0008156),\n (16.648252, -0.9983261),\n (16.656252, -0.9958988),\n (16.664251, -0.99355924),\n (16.67225, -0.9913321),\n (16.68025, -0.98924017),\n (16.68825, -0.9873042),\n (16.696249, -0.9855431),\n (16.704248, -0.9839733),\n (16.712248, -0.9826089),\n (16.720247, -0.9814616),\n (16.728247, -0.9805402),\n (16.736246, -0.9798511),\n (16.744246, -0.97939783),\n (16.752245, -0.9791814),\n (16.760244, -0.9792),\n (16.768244, -0.9794494),\n (16.776243, -0.9799227),\n (16.784243, -0.98061085),\n (16.792242, -0.98150235),\n (16.800241, -0.9825838),\n (16.80824, -0.9838399),\n (16.81624, -0.9852537),\n (16.82424, -0.9868066),\n (16.83224, -0.9884789),\n (16.840239, -0.9902501),\n (16.848238, -0.99209875),\n (16.856237, -0.9940029),\n (16.864237, -0.99594045),\n (16.872236, -0.9978893),\n (16.880236, -0.99982756),\n (16.888235, -1.001734),\n (16.896235, -1.0035878),\n (16.904234, -1.0053695),\n (16.912233, -1.0070605),\n (16.920233, -1.0086435),\n (16.928232, -1.0101029),\n (16.936232, -1.0114245),\n (16.944231, -1.0125962),\n (16.95223, -1.0136076),\n (16.96023, -1.0144501),\n (16.96823, -1.0151173),\n (16.976229, -1.015605),\n (16.984228, -1.0159107),\n (16.992228, -1.0160345),\n (17.000227, -1.0159779),\n (17.008226, -1.0157448),\n (17.016226, -1.0153408),\n (17.024225, -1.0147735),\n (17.032225, -1.0140519),\n (17.040224, -1.0131868),\n (17.048223, -1.0121902),\n (17.056223, -1.0110757),\n (17.064222, -1.0098575),\n (17.072222, -1.0085511),\n (17.080221, -1.0071725),\n (17.08822, -1.0057381),\n (17.09622, -1.0042652),\n (17.10422, -1.0027704),\n (17.112219, -1.0012711),\n (17.120218, -0.99978375),\n (17.128218, -0.9983247),\n (17.136217, -0.99690974),\n (17.144217, -0.99555385),\n (17.152216, -0.994271),\n (17.160215, -0.99307406),\n (17.168215, -0.99197507),\n (17.176214, -0.9909844),\n (17.184214, -0.9901111),\n (17.192213, -0.98936296),\n (17.200212, -0.988746),\n (17.208212, -0.98826486),\n (17.216211, -0.9879225),\n (17.22421, -0.98772025),\n (17.23221, -0.98765796),\n (17.24021, -0.9877339),\n (17.248209, -0.9879447),\n (17.256208, -0.9882859),\n (17.264208, -0.9887512),\n (17.272207, -0.98933333),\n (17.280207, -0.99002385),\n (17.288206, -0.99081314),\n (17.296206, -0.99169075),\n (17.304205, -0.9926453),\n (17.312204, -0.993665),\n (17.320204, -0.99473727),\n (17.328203, -0.99584925),\n (17.336203, -0.99698794),\n (17.344202, -0.9981403),\n (17.352201, -0.99929315),\n (17.3602, -1.0004338),\n (17.3682, -1.0015496),\n (17.3762, -1.0026289),\n (17.3842, -1.0036601),\n (17.392199, -1.0046326),\n (17.400198, -1.0055367),\n (17.408197, -1.0063635),\n (17.416197, -1.0071052),\n (17.424196, -1.007755),\n (17.432196, -1.0083075),\n (17.440195, -1.0087578),\n (17.448195, -1.0091031),\n (17.456194, -1.0093411),\n (17.464193, -1.0094713),\n (17.472193, -1.009494),\n (17.480192, -1.0094107),\n (17.488192, -1.0092244),\n (17.496191, -1.0089389),\n (17.50419, -1.0),\n (17.51219, -1.0),\n (17.52019, -1.0),\n (17.528189, -1.0),\n (17.536188, -1.0),\n (17.544188, -1.0),\n (17.552187, -1.0),\n (17.560186, -1.0),\n (17.568186, -1.0),\n (17.576185, -1.0),\n (17.584185, -1.0),\n (17.592184, -1.0),\n (17.600183, -1.0),\n (17.608183, -1.0),\n (17.616182, -1.0),\n (17.624182, -1.0),\n (17.632181, -1.0),\n (17.64018, -1.0),\n (17.64818, -1.0),\n (17.65618, -1.0),\n (17.664179, -1.0),\n (17.672178, -1.0),\n (17.680178, -1.0),\n (17.688177, -1.0),\n (17.696177, -1.0),\n (17.704176, -1.0),\n (17.712175, -1.0),\n (17.720175, -1.0),\n (17.728174, -1.0),\n (17.736174, -1.0),\n (17.744173, -1.0),\n (17.752172, -1.0),\n (17.760172, -1.0),\n (17.768171, -1.0),\n (17.77617, -1.0),\n (17.78417, -1.0),\n (17.79217, -1.0),\n (17.800169, -1.0),\n (17.808168, -1.0),\n (17.816168, -1.0),\n (17.824167, -1.0),\n (17.832167, -1.0),\n (17.840166, -1.0),\n (17.848166, -1.0),\n (17.856165, -1.0),\n (17.864164, -1.0),\n (17.872164, -1.0),\n (17.880163, -1.0),\n (17.888163, -1.0),\n (17.896162, -1.0),\n (17.904161, -1.0),\n (17.91216, -1.0),\n (17.92016, -1.0),\n (17.92816, -1.0),\n (17.93616, -1.0),\n (17.944159, -1.0),\n (17.952158, -1.0),\n (17.960157, -1.0),\n (17.968157, -1.0),\n (17.976156, -1.0),\n (17.984156, -1.0),\n (17.992155, -1.0),\n (18.000154, -1.0),\n (18.008154, -1.0),\n (18.016153, -1.0),\n (18.024153, -1.0),\n (18.032152, -1.0),\n (18.040152, -1.0),\n (18.048151, -1.0),\n (18.05615, -1.0),\n (18.06415, -1.0),\n (18.07215, -1.0),\n (18.080149, -1.0),\n (18.088148, -1.0),\n (18.096148, -1.0),\n (18.104147, -1.0),\n (18.112146, -1.0),\n (18.120146, -1.0),\n (18.128145, -1.0),\n (18.136145, -1.0),\n (18.144144, -1.0),\n (18.152143, -1.0),\n (18.160143, -1.0),\n (18.168142, -1.0),\n (18.176142, -1.0),\n (18.184141, -1.0),\n (18.19214, -1.0),\n (18.20014, -1.0),\n (18.20814, -1.0),\n (18.216139, -1.0),\n (18.224138, -1.0),\n (18.232138, -1.0),\n (18.240137, -1.0),\n (18.248137, -1.0),\n (18.256136, -1.0),\n (18.264135, -1.0),\n (18.272135, -1.0),\n (18.280134, -1.0),\n (18.288134, -1.0),\n (18.296133, -1.0),\n (18.304132, -1.0),\n (18.312132, -1.0),\n (18.320131, -1.0),\n (18.32813, -1.0),\n (18.33613, -1.0),\n (18.34413, -1.0),\n (18.352129, -1.0),\n (18.360128, -1.0),\n (18.368128, -1.0),\n (18.376127, -1.0),\n (18.384127, -1.0),\n (18.392126, -1.0),\n (18.400126, -1.0),\n (18.408125, -1.0),\n (18.416124, -1.0),\n (18.424124, -1.0),\n (18.432123, -1.0),\n (18.440123, -1.0),\n (18.448122, -1.0),\n (18.456121, -1.0),\n (18.46412, -1.0),\n (18.47212, -1.0),\n (18.48012, -1.0),\n (18.48812, -1.0),\n (18.496119, -1.0),\n (18.504118, -1.0),\n (18.512117, -1.0),\n (18.520117, -1.0),\n (18.528116, -1.0),\n (18.536116, -1.0),\n (18.544115, -1.0),\n (18.552114, -1.0),\n (18.560114, -1.0),\n (18.568113, -1.0),\n (18.576113, -1.0),\n (18.584112, -1.0),\n (18.592112, -1.0),\n (18.600111, -1.0),\n (18.60811, -1.0),\n (18.61611, -1.0),\n (18.62411, -1.0),\n (18.632109, -1.0),\n (18.640108, -1.0),\n (18.648108, -1.0),\n (18.656107, -1.0),\n (18.664106, -1.0),\n (18.672106, -1.0),\n (18.680105, -1.0),\n (18.688105, -1.0),\n (18.696104, -1.0),\n (18.704103, -1.0),\n (18.712103, -1.0),\n (18.720102, -1.0),\n (18.728102, -1.0),\n (18.736101, -1.0),\n (18.7441, -1.0),\n (18.7521, -1.0),\n (18.7601, -1.0),\n (18.768099, -1.0),\n (18.776098, -1.0),\n (18.784098, -1.0),\n (18.792097, -1.0),\n (18.800097, -1.0),\n (18.808096, -1.0),\n (18.816095, -1.0),\n (18.824095, -1.0),\n (18.832094, -1.0),\n (18.840094, -1.0),\n (18.848093, -1.0),\n (18.856092, -1.0),\n (18.864092, -1.0),\n (18.872091, -1.0),\n (18.88009, -1.0),\n (18.88809, -1.0),\n (18.89609, -1.0),\n (18.904089, -1.0),\n (18.912088, -1.0),\n (18.920088, -1.0),\n (18.928087, -1.0),\n (18.936087, -1.0),\n (18.944086, -1.0),\n (18.952085, -1.0),\n (18.960085, -1.0),\n (18.968084, -1.0),\n (18.976084, -1.0),\n (18.984083, -1.0),\n (18.992083, -1.0),\n (19.000082, -1.0),\n (19.008081, -1.0),\n (19.01608, -1.0),\n (19.02408, -1.0),\n (19.03208, -1.0),\n (19.04008, -1.0),\n (19.048079, -1.0),\n (19.056078, -1.0),\n (19.064077, -1.0),\n (19.072077, -1.0),\n (19.080076, -1.0),\n (19.088076, -1.0),\n (19.096075, -1.0),\n (19.104074, -1.0),\n (19.112074, -1.0),\n (19.120073, -1.0),\n (19.128073, -1.0),\n (19.136072, -1.0),\n (19.144072, -1.0),\n (19.152071, -1.0),\n (19.16007, -1.0),\n (19.16807, -1.0),\n (19.17607, -1.0),\n (19.184069, -1.0),\n (19.192068, -1.0),\n (19.200068, -1.0),\n (19.208067, -1.0),\n (19.216066, -1.0),\n (19.224066, -1.0),\n (19.232065, -1.0),\n (19.240065, -1.0),\n (19.248064, -1.0),\n (19.256063, -1.0),\n (19.264063, -1.0),\n (19.272062, -1.0),\n (19.280062, -1.0),\n (19.288061, -1.0),\n (19.29606, -1.0),\n (19.30406, -1.0),\n (19.31206, -1.0),\n (19.320059, -1.0),\n (19.328058, -1.0),\n (19.336058, -1.0),\n (19.344057, -1.0),\n (19.352057, -1.0),\n (19.360056, -1.0),\n (19.368055, -1.0),\n (19.376055, -1.0),\n (19.384054, -1.0),\n (19.392054, -1.0),\n (19.400053, -1.0),\n (19.408052, -1.0),\n (19.416052, -1.0),\n (19.424051, -1.0),\n (19.43205, -1.0),\n (19.44005, -1.0),\n (19.44805, -1.0),\n (19.456049, -1.0),\n (19.464048, -1.0),\n (19.472048, -1.0),\n (19.480047, -1.0),\n (19.488047, -1.0),\n (19.496046, -1.0),\n (19.504045, -1.0),\n (19.512045, -1.0),\n (19.520044, -1.0),\n (19.528044, -1.0),\n (19.536043, -1.0),\n (19.544043, -1.0),\n (19.552042, -1.0),\n (19.560041, -1.0),\n (19.56804, -1.0),\n (19.57604, -1.0),\n (19.58404, -1.0),\n (19.59204, -1.0),\n (19.600039, -1.0),\n (19.608038, -1.0),\n (19.616037, -1.0),\n (19.624037, -1.0),\n (19.632036, -1.0),\n (19.640036, -1.0),\n (19.648035, -1.0),\n (19.656034, -1.0),\n (19.664034, -1.0),\n (19.672033, -1.0),\n (19.680033, -1.0),\n (19.688032, -1.0),\n (19.696032, -1.0),\n (19.704031, -1.0),\n (19.71203, -1.0),\n (19.72003, -1.0),\n (19.72803, -1.0),\n (19.736029, -1.0),\n (19.744028, -1.0),\n (19.752028, -1.0),\n (19.760027, -1.0),\n (19.768026, -1.0),\n (19.776026, -1.0),\n (19.784025, -1.0),\n (19.792025, -1.0),\n (19.800024, -1.0),\n (19.808023, -1.0),\n (19.816023, -1.0),\n (19.824022, -1.0),\n (19.832022, -1.0),\n (19.840021, -1.0),\n (19.84802, -1.0),\n (19.85602, -1.0),\n (19.86402, -1.0),\n (19.872019, -1.0),\n (19.880018, -1.0),\n (19.888018, -1.0),\n (19.896017, -1.0),\n (19.904016, -1.0),\n (19.912016, -1.0),\n (19.920015, -1.0),\n (19.928015, -1.0),\n (19.936014, -1.0),\n (19.944014, -1.0),\n (19.952013, -1.0),\n (19.960012, -1.0),\n (19.968012, -1.0),\n (19.976011, -1.0),\n (19.98401, -1.0),\n (19.99201, -1.0)]\n\n", "num_lines": 5010}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport Physical\nimport Basic\nimport TypesettingTricks\nimport PlotExample\nimport Expected\nsinExample:: SignalRep Time Voltage\nsinExample = sine (V 2.0) (Hz 10) 0.0\nsinPlot = plotExample \"sine\" sinExpected sinExample 0.0 1.0\npieceExample = toSig Pulse_dc\n  { start_delay=(Sec 1.0),\n    rise_time=(Sec 0.2),\n    pulse_width=(Sec 3.0),\n    fall_time=(Sec 0.3),\n    dc_offset=(V (- 1.0)),\n    period=(Sec 10.0),\n    amplitude=(V 5.0),\n    over=Overshoot{ringing=(V 0.2),\n                   pulse_width=(Sec 3.0),\n                   oscillation=(Hz 2.0),\n                   damp_fac=1.0},\n    under=Overshoot{ringing=(V (- 0.25)),\n                    pulse_width=(Sec 3.0),\n                    oscillation=(Hz 2.10),\n                    damp_fac=1.10} }\npiecePlot = plotExample \"piece\" pieceExpected pieceExample 0.0 20.0\nmain = putStrLn (sinPlot ++ piecePlot)\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Physical where\nimport TypesettingTricks\nclass (Eq a, Show a) => Physical a where\n  fromPhysical:: a -> Float\n  toPhysical:: Float -> a\ninstance Physical Float where\n  fromPhysical x = x\n  toPhysical x = x\ndata PlaneAngle =\n     Rad Float                 |\n     Mrad Float                |\n     Urad Float                |\n     Deg Float                 |\n     Rev Float\n     deriving (Eq, Show)\ninstance Physical PlaneAngle where\n    fromPhysical (Rad x) = x\n    fromPhysical (Mrad x) = realdiv x 1000\n    fromPhysical (Urad x) = realdiv x 1000000\n    fromPhysical (Deg x) = realdiv (realmul x pi) 180\n    fromPhysical (Rev x) = realdiv x (realmul 2.0 pi)\n    toPhysical x = Rad x\ndata SolidAngle =\n     Sr Float            |\n     Msr Float\n     deriving (Eq, Show)\ninstance Physical SolidAngle where\n    fromPhysical (Sr x) = x\n    fromPhysical (Msr x) = realdiv x 1000\n    toPhysical x = Sr x\ndata BurstLength =\n     Cycle Float          |\n     Pulse Float\n     deriving (Eq, Show)\ninstance Physical BurstLength where\n    fromPhysical (Cycle x) = x\n    fromPhysical (Pulse x) = x\n    toPhysical x = Cycle x\ndata Capacitance =\n     Fd Float            |\n     Ufd Float           |\n     Nfd Float           |\n     Pfd Float\n     deriving (Eq, Show)\ninstance Physical Capacitance where\n     fromPhysical (Fd x) = x\n     fromPhysical (Ufd x) = realdiv x 1000000\n     fromPhysical (Nfd x) = realdiv x 1000000000\n     fromPhysical (Pfd x) = realdiv x 1000000000000\n     toPhysical x = Fd x\ndata Charge =\n     C Float              |\n     Kc Float             |\n     Uc Float             |\n     Nc Float\n     deriving (Eq, Show)\ninstance Physical Charge where\n    fromPhysical (C x) = x\n    fromPhysical (Kc x) = realmul 1000 x\n    fromPhysical (Uc x) = realdiv x 1000000\n    fromPhysical (Nc x) = realdiv x 1000000000\n    toPhysical x = C x\ndata Current =\n     A Float             |\n     Ka Float            |\n     Ma Float            |\n     Ua Float            |\n     Na Float\n     deriving (Eq, Show)\ninstance Physical Current where\n    fromPhysical (A x) = x\n    fromPhysical (Ka x) = realmul 1000 x\n    fromPhysical (Ma x) = realdiv x 1000\n    fromPhysical (Ua x) = realdiv x 1000000\n    fromPhysical (Na x) = realdiv x 1000000000\n    toPhysical x = A x\ndata Distance =\n     M Float              |\n     Km Float             |\n     Mm Float             |\n     Um Float             |\n     Nm Float             |\n     In Float             |\n     Ft Float             |\n     SMi Float            |\n     NMi Float\n     deriving (Eq, Show)\ninstance Physical Distance where\n    fromPhysical (M x) = x\n    fromPhysical (Km x) = realmul 1000 x\n    fromPhysical (Mm x) = realdiv x 1000\n    fromPhysical (Um x) = realdiv x 1000000\n    fromPhysical (Nm x) = realdiv x 1000000000\n    fromPhysical (In x) = realmul 25.4 x\n    fromPhysical (Ft x) = realmul 2.12 x\n    fromPhysical (SMi x) = realdiv x 2490.57\n    fromPhysical (NMi x) = realdiv x 1825\n    toPhysical x = M x\ndata Energy =\n     J Float              |\n     Kj Float             |\n     Mj Float             |\n     Ev Float             |\n     Kev Float            |\n     Mev Float\n     deriving (Eq, Show)\ninstance Physical Energy where\n    fromPhysical (J x) = x\n    fromPhysical (Kj x) = realmul 1000 x\n    fromPhysical (Mj x) = realdiv x 1000\n    fromPhysical (Ev x) = realmul 1.6E-19 x\n    fromPhysical (Kev x) = realmul 1.6E-16 x\n    fromPhysical (Mev x) = realmul 1.6E-13 x\n    toPhysical x = J x\ndata MagFlux =\n     Wb Float             |\n     Mwb Float\n     deriving (Eq, Show)\ninstance Physical MagFlux where\n    fromPhysical (Wb x) = x\n    fromPhysical (Mwb x) = realdiv x 1000\n    toPhysical x = Wb x\ndata FluxDensity =\n     T Float              |\n     Mt Float             |\n     Ut Float             |\n     Gam Float\n     deriving (Eq, Show)\ninstance Physical FluxDensity where\n    fromPhysical (T x) = x\n    fromPhysical (Mt x) = realdiv x 1000\n    fromPhysical (Ut x) = realdiv x 1000000\n    fromPhysical (Gam x) = realdiv x 1000000000\n    toPhysical x = T x\ndata Force =\n     N Float              |\n     Kn Float             |\n     Mn Float             |\n     Un Float\n     deriving (Eq, Show)\ninstance Physical Force where\n    fromPhysical (N x) = x\n    fromPhysical (Kn x) = realmul 1000 x\n    fromPhysical (Mn x) = realdiv x 1000\n    fromPhysical (Un x) = realdiv x 1000000\n    toPhysical x = N x\ndata Frequency =\n     Hz Float  |\n     Khz Float |\n     Mhz Float |\n     Ghz Float\n     deriving (Eq, Show)\ninstance Physical Frequency where\n    fromPhysical (Hz x) = x\n    fromPhysical (Khz x) = realmul 1000 x\n    fromPhysical (Mhz x) = realmul 1000000 x\n    fromPhysical (Ghz x) = realmul 1000000000 x\n    toPhysical x = Hz x\ndata Illuminance =\n     Lx Float\n     deriving (Eq, Show)\ninstance Physical Illuminance where\n    fromPhysical (Lx x) = x\n    toPhysical x = Lx x\ndata Inductance =\n    H  Float              |\n    Mh Float              |\n    Uh Float              |\n    Nh Float              |\n    Ph Float\n    deriving (Eq, Show)\ninstance Physical Inductance where\n    fromPhysical (H x) = x\n    fromPhysical (Mh x) = realdiv x 1000\n    fromPhysical (Uh x) = realdiv x 1000000\n    fromPhysical (Nh x) = realdiv x 1000000000\n    fromPhysical (Ph x) = realdiv x 1000000000000\n    toPhysical x = H x\ndata Luminance =\n     Nt Float\n     deriving (Eq, Show)\ninstance Physical Luminance where\n    fromPhysical (Nt x) = x\n    toPhysical x = Nt x\ndata LuminFlux =\n     Lm Float\n     deriving (Eq, Read, Show)\ninstance Physical LuminFlux where\n    fromPhysical (Lm x) = x\n    toPhysical x = Lm x\ndata LuminInten =\n     Cd Float\n     deriving (Eq, Read, Show)\ninstance Physical LuminInten where\n    fromPhysical (Cd x) = x\n    toPhysical x = Cd x\ndata Mass =\n     Kg Float             |\n     G Float              |\n     Mg Float             |\n     Ug Float\n     deriving (Eq, Show)\ninstance Physical Mass where\n    fromPhysical (Kg x) = x\n    fromPhysical (G x) = realdiv x 1000\n    fromPhysical (Mg x) = realdiv x 1000000\n    fromPhysical (Ug x) = realdiv x 1000000000\n    toPhysical x = Kg x\ndata Power =\n     W Float              |\n     Kw Float             |\n     Mw Float             |\n     Uw Float\n     deriving (Eq, Show)\ninstance Physical Power where\n    fromPhysical (W x) = x\n    fromPhysical (Kw x) = realmul 1000 x\n    fromPhysical (Mw x) = realdiv x 1000\n    fromPhysical (Uw x) = realdiv x 1000000\n    toPhysical x = W x\ndata Pressure =\n     Pa Float             |\n     Kpa Float            |\n     Mpa Float            |\n     Upa Float            |\n     Mb Float\n     deriving (Eq, Show)\ninstance Physical Pressure where\n    fromPhysical (Pa x) = x\n    fromPhysical (Kpa x) = realmul 1000 x\n    fromPhysical (Mpa x) = realdiv x 1000\n    fromPhysical (Upa x) = realdiv x 1000000\n    fromPhysical (Mb x) = realmul 100 x\n    toPhysical x = Pa x\ndata Pulse =\n     Pulses Float\n     deriving (Eq, Show)\ninstance Physical Pulse where\n    fromPhysical (Pulses x) = x\n    toPhysical x = Pulses x\ndata RatioInOut =\n     Db Float\n     deriving (Eq, Show)\ninstance Physical RatioInOut where\n    fromPhysical (Db x) = x\n    toPhysical x = Db x\ndata Resistance =\n     Ohm Float            |\n     Kohm Float           |\n     Mohm Float\n     deriving (Eq, Show)\ninstance Physical Resistance where\n    fromPhysical (Ohm x) = x\n    fromPhysical (Kohm x) = realmul 1000 x\n    fromPhysical (Mohm x) = realmul 1000000 x\n    toPhysical x = Ohm x\ndata Temperature =\n     Degk Float           |\n     Degc Float           |\n     Degf Float\n     deriving (Eq, Show)\ninstance Physical Temperature where\n    fromPhysical (Degk x) = x\n    fromPhysical (Degc x) = x + 273\n    fromPhysical (Degf x) = (realdiv (realmul 5 (x-32)) 9) + 273\n    toPhysical x = Degk x\ndata Time =\n     Sec Float            |\n     Msec Float           |\n     Usec Float           |\n     Nsec Float           |\n     Min Float            |\n     Hr Float\n     deriving (Eq, Show)\ninstance Physical Time where\n    fromPhysical (Sec x) = x\n    fromPhysical (Msec x) = realdiv x 1000\n    fromPhysical (Usec x) = realdiv x 1000000\n    fromPhysical (Nsec x) = realdiv x 1000000000\n    fromPhysical (Min x) = realmul 60 x\n    fromPhysical (Hr x) = realmul 3600 x\n    toPhysical x = Sec x\ndata Voltage =\n     V Float |\n     Kv Float |\n     Mv Float |\n     Uv Float\n     deriving (Eq, Show)\ninstance Physical Voltage where\n    fromPhysical (V x) = x\n    fromPhysical (Kv x) = realmul 1000 x\n    fromPhysical (Mv x) = realdiv x 1000\n    fromPhysical (Uv x) = realdiv x 1000000\n    toPhysical x = V x\ndata Volume =\n     L Float            |\n     Ml Float\n     deriving (Eq, Show)\ninstance Physical Volume where\n    fromPhysical (L x) = x\n    fromPhysical (Ml x) = realdiv x 1000\n    toPhysical x = L x\n", "num_lines": 303}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "The functions in this file (well, the single function) will allow the\nuser to plot different functions using the Gnuplot program.  In fact,\nall it really does is output a number of points on the list and allow\nthe user to activate Gnuplot and use the plotting program to get the\nappropriate output.\n\nThe first line just gives the module name.  For the moment, I don't\nanticipate using any modules (although this may change).\n\n> module Plot where\n\nNow we give the type of the function.  This consists of a file name, a\nlist of values, and a function that goes from the appropriate types.\n\n> plot2d:: (Fractional a, Fractional b, Ord a, Ord b, Show a, Show b)\n>       => String -> [(a, b)] -> [a] -> (a -> b) -> String\n> plot2d fl expected inp f = plot2d' expected inp f  \n\n> plot2d':: (Fractional a, Fractional b, Ord a, Ord b, Show a, Show b)\n>        => [(a, b)] -> [a] -> (a -> b) -> String\n> plot2d' [] [] f     = []\n> plot2d' ((e1, e2):es) (x:xs) f\n>  | (e1 `isSame` x) && (e2 `isSame` x')\n>                  = (show e1)       ++\n>                    \"  \"            ++\n>                    (show e2)       ++\n>                    \"\\n\"            ++\n>                    plot2d' es xs f\n>  | otherwise\n>                  = \"Mismatch: \"    ++\n>                    (show e1)       ++\n>                    \"  \"            ++\n>                    (show e2)       ++\n>                    \"  \"            ++\n>                    (show x)        ++\n>                    \"  \"            ++\n>                    (show x')       ++\n>                    \"\\n\"            ++\n>                    plot2d' es xs f\n>   where x' = f x\n> plot2d' es [] _ = \"Extra expected: \" ++ show es\n> plot2d' [] xs _ = \"Extra results: \" ++ show xs\n\n> isSame :: (Fractional a, Ord a) => a -> a -> Bool\n> x `isSame` y = abs (x - y) < 0.00001\n\nAnd now, let's create a function to make a range out of a triple of a\nstart point, an end point, and an increment.\n\n> createRange:: (Num a, Ord a) => a -> a -> a -> [a]\n> createRange s e i = if s > e then []\n>                     else s : createRange (s+i) e i\n\nWe now settle down to a couple of more specific functions that do\nthings that are more unique to gnuplot.  First, we have something that\ncreates the appropriate gnuplot command file.\n\n> createGnuPlot:: Show a => String -> a -> a -> String\n> createGnuPlot fl s e = \n>                         \"set terminal latex\\n\"  ++\n>                         \"set output \\\"\"         ++\n>                         (fl ++ \".tex\\\"\\n\")      ++\n>                         \"set nokey\\n\"           ++\n>                         \"plot [\"                ++\n>                         (show s)                ++\n>                         \":\"                     ++\n>                         (show e)                ++\n>                         \"] \\\"\"                  ++\n>                         (fl ++ \".plt\\\"\")        ++\n>                         \" with lines\\n\"\n\nAnd now we create a fairly specific plotExam function that takes a\nstring, a function, and two floats and produces the correct files\n\n> plotExam:: String -> [(Float, Float)] -> Float -> Float -> (Float -> Float)\n>         -> String\n> plotExam fl expected s e f = plot2d (fl++\".plt\") expected r f ++\n>                              createGnuPlot fl s e\n>               where r = createRange s e ((e - s) / 2500)\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "This file contains code that is explicitly designed to plot examples\nfrom the signal modeling language.\n\n> module PlotExample where\n\n> import Plot\n> import Physical\n> import Basic\n\nOur main task is to take a signal and a begin and start point (both\nreals) and convert it into something that plotExam can take in the\nPlot module.\n\n> plotExample:: (Signal s, Physical a, Physical b) =>\n>               String -> [(Float, Float)] -> s a b -> Float -> Float -> String\n> plotExample fl expected sig s e = plotExam fl expected s e f\n>                    where f  = toFloatFunc f'\n>                          f' = mapSignal sig\n\n> toFloatFunc:: (Physical a, Physical b) => (a -> b) -> Float -> Float\n> toFloatFunc f x = fromPhysical (f (toPhysical x))\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The functions in this file are expressly for the purpose of aiding\n-- the typesetting of some functions with Smugweb.  To this end, in\n-- some cases I will use named, prefix functions rather than operators\n-- (since under Smugweb operators cannot accept arguments).  This file\n-- will define those infix functions.\n\nmodule TypesettingTricks where\n\nrealdiv:: Floating a => a -> a -> a\nrealdiv = (/)\n\nrealmul:: Num a => a -> a -> a\nrealmul = (*)\n\ndotmul:: Num a => a -> a -> a\ndotmul = (*)\n\nrand:: Integer -> [ Float ]\nrand i = r : rand i'\n   where i' = ( (3146757 * i) + 1731) `mod` 4194304\n         r = (fromInteger i') / 4194304.0\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\\begin{code}\nmodule Arr (\n  module Data.Array,\n\n  safezipWith, safezip,\n  row,\n  sum1, map2, map3,\n  mapat, mapat2, mapat3,\n  mapindexed, mapindexed2, mapindexed3,\n--  zipArr, sumArr, scaleArr,\n  arraySize,\n\n  matvec, inner, \n  outerVector,\n  \n  Vector (Vector), toVector, fromVector, listVector, vectorList, vector, \n  zipVector, scaleVector, sumVector, vectorNorm2, vectorSize,\n  \n  Matrix (Matrix), toMatrix, fromMatrix, listMatrix, matrixList, matrix, \n  zipMatrix, scaleMatrix, sumMatrix,\n\n  augment,\n  trMatrix,\n\n--   showsVector,\n--   showsMatrix,\n-- showsVecList, showsMatList\n--  spy,\n) where\nimport Data.Array\nimport Numeric\n--import Trace\n--import IOExtensions(unsafePerformIO)\n\\end{code}\n\n@Vector@ and @Matrix@ are 1-based arrays with read/show in form of Lists.\n\n\\begin{code}\ndata Vector a = Vector (Array Int a) deriving (Eq) --, Show)\n\ntoVector :: Array Int a -> Vector a\ntoVector x = Vector x\n\nfromVector :: Vector a -> Array Int a\nfromVector (Vector x) = x\n\ninstance Functor (Vector) where\n  fmap fn x = toVector (fmap fn (fromVector x))    \n\n{-instance Eq a => Eq (Vector a) where\n--  (Vector x) == (Vector y) = x == y\n-}\n\ninstance Show a => Show (Vector a) where\n  showsPrec p x = showsPrec p (elems (fromVector x))\n\ninstance Read a => Read (Vector a) where\n  readsPrec p = readParen False \n                  (\\r -> [(listVector s, t) | (s, t) <- reads r])\n\ninstance Num b => Num (Vector b) where\n  (+) = zipVector \"+\" (+)\n  (-) = zipVector \"-\" (-)\n  negate = fmap negate\n  abs = fmap abs\n  signum = fmap signum\n--   (*) = matMult -- works only for matrices!\n--  fromInteger = fmap fromInteger\n\\end{code}\n\n\nConvert a list to 1-based vector.\n\n\\begin{code}\nlistVector :: [a] -> Vector a\nlistVector x = toVector (listArray (1,length x) x)\n\nvectorList :: Vector a -> [a]\nvectorList = elems . fromVector\n\nvector (l,u) x | l == 1 = toVector (array (l,u) x)\n               | otherwise = error \"vector: l != 1\"\n               \nzipVector :: String -> (b -> c -> d) -> Vector b -> Vector c -> Vector d\nzipVector s f (Vector a) (Vector b) \n  | bounds a == bounds b = vector (bounds a) [(i, f (a!i) (b!i)) | i <- indices a]\n  | otherwise            = error (\"zipVector: \" ++ s ++ \": unconformable arrays\")\n\nscaleVector :: Num a => a -> Vector a -> Vector a\nscaleVector a = fmap (* a)\n\nsumVector :: Num a => Vector a -> a\nsumVector = sum . elems . fromVector\n\nvectorNorm2 :: Num a => Vector a -> a\nvectorNorm2 x = inner x x\n\nvectorSize :: Vector a -> Int\nvectorSize (Vector x) = rangeSize (bounds x)\n\n\\end{code}\n\n==============\n\n\\begin{code}\ndata Matrix a = Matrix (Array (Int, Int) a) deriving Eq\n\ntoMatrix :: Array (Int, Int) a -> Matrix a\ntoMatrix x = Matrix x\n\nfromMatrix :: Matrix a -> Array (Int, Int) a\nfromMatrix (Matrix x) = x\n\ninstance Functor (Matrix) where\n  fmap fn x = toMatrix (fmap fn (fromMatrix x))    \n\n--instance Eq a => Eq (Matrix a) where\n--  (Matrix x) == (Matrix y) = x == y\n\ninstance Show a => Show (Matrix a) where\n  showsPrec p x = vertl (matrixList x)\n  \nvertl [] = showString \"[]\"\nvertl (x:xs) = showChar '[' . shows x . showl xs \n    where showl [] = showChar ']'\n          showl (x:xs) = showString \",\\n\" . shows x . showl xs\n\ninstance Read a => Read (Matrix a) where\n    readsPrec p = readParen False\n                  (\\r -> [(listMatrix s, t) | (s, t) <- reads r])\n\ninstance Num b => Num (Matrix b) where\n  (+) = zipMatrix \"+\" (+)\n  (-) = zipMatrix \"-\" (-)\n  negate = fmap negate\n  abs = fmap abs\n  signum = fmap signum\n  x * y = toMatrix (matMult (fromMatrix x) (fromMatrix y)) -- works only for matrices!\n--  fromInteger = fmap fromInteger\n\\end{code}\n\nConvert a nested list to a matrix.\n\n\\begin{code}\nlistMatrix :: [[a]] -> Matrix a\nlistMatrix x = Matrix (listArray ((1, 1), (length x, length (x!!0))) (concat x))\n\nmatrixList :: Matrix a -> [[a]]\nmatrixList (Matrix x) = [ [x!(i,j) | j <- range (l',u')] | i <- range (l,u)]\n         where ((l,l'),(u,u')) = bounds x\n\nmatrix ((l,l'),(u,u')) x | l == 1 && l' == 1 = toMatrix (array ((l,l'),(u,u')) x)\n                         | otherwise = error \"matrix: l != 1\"\n\nzipMatrix :: String -> (b -> c -> d) -> Matrix b -> Matrix c -> Matrix d\nzipMatrix s f (Matrix a) (Matrix b) \n  | bounds a == bounds b = matrix (bounds a) [(i, f (a!i) (b!i)) | i <- indices a]\n  | otherwise            = error (\"zipMatrix: \" ++ s ++ \": unconformable arrays\")\n\nscaleMatrix :: Num a => a -> Matrix a -> Matrix a\nscaleMatrix a = fmap (* a)\n\nsumMatrix :: Num a => Matrix a -> a\nsumMatrix = sum . elems . fromMatrix\n\n\\end{code}\n\n\n============\n\n\\begin{code}\nsafezipWith :: String -> (a -> b -> c) -> [a] -> [b] -> [c]\nsafezipWith _ _ [] [] = []\nsafezipWith s f (x:xs) (y:ys) = f x y : safezipWith s f xs ys\nsafezipWith s _ _ _ = error (\"safezipWith: \" ++ s ++ \": unconformable vectors\")\n\nsafezip :: [a] -> [b] -> [(a,b)]\nsafezip = safezipWith \"(,)\" (,)\n\ntrMatrix :: Matrix a -> Matrix a\ntrMatrix (Matrix x) = matrix ((l,l'),(u',u)) [((j,i), x!(i,j)) | j <- range (l',u'), i <- range (l,u)]\n         where ((l,l'),(u,u')) = bounds x\n\nrow :: (Ix a, Ix b) => a -> Array (a,b) c -> Array b c\nrow i x = ixmap (l',u') (\\j->(i,j)) x where ((l,l'),(u,u')) = bounds x\n\nzipArr :: (Ix a) => String -> (b -> c -> d) -> Array a b -> Array a c -> Array a d\nzipArr s f a b | bounds a == bounds b = array (bounds a) [(i, f (a!i) (b!i)) | i <- indices a]\n               | otherwise            = error (\"zipArr: \" ++ s ++ \": unconformable arrays\")\n\\end{code}\n\nValid only for b -> c -> b functions.\n\n\\begin{code}\nzipArr' :: (Ix a) => String -> (b -> c -> b) -> Array a b -> Array a c -> Array a b\nzipArr' s f a b | bounds a == bounds b = accum f a (assocs b)\n                | otherwise            = error (\"zipArr': \" ++ s ++ \": unconformable arrays\")\n\\end{code}\n\nOverload arithmetical operators to work on lists.\n\n\\begin{code}\ninstance Num a => Num [a] where\n  (+) = safezipWith \"+\" (+)\n  (-) = safezipWith \"-\" (-)\n  negate = fmap negate\n  abs = fmap abs\n  signum = fmap signum\n--   (*) = undefined\n--   fromInteger = undefined\n\\end{code}\n\n\\begin{code}\nsum1 :: (Num a) => [a] -> a\nsum1 = foldl1 (+)\n\n--main = print (sum1 [[4,1,1], [5,1,2], [6,1,3,4]])\n\\end{code}\n\n\\begin{code}\nmap2 f = fmap (fmap f) \nmap3 f = fmap (map2 f) \n\\end{code}\n\nMap function f at position n only.  Out of range indices are silently\nignored.\n\n\\begin{code}\nmapat n f x = mapat1 0 f x where\n    mapat1 _ _ [] = []\n    mapat1 i f (x:xs) = (if i == n then f x else x) : mapat1 (i + 1) f xs\n\nmapat2 (i,j) = mapat i . mapat j\nmapat3 (i,j,k) = mapat i . mapat j . mapat k\n\n-- main = print (mapat 2 (10+) [1,2,3,4])\n-- main = print (mapat2 (1,0) (1000+) ginp)\n-- main = print (mapat3 (1,0,1) (1000+) gw)\n\\end{code}\n\n\\begin{code}\nmapindexed f x = mapindexed1 f 0 x where\n    mapindexed1 _ _ [] = []\n    mapindexed1 f n (x:xs) = f n x : mapindexed1 f (n + 1) xs\n\nmapindexed2 f = mapindexed (\\i -> mapindexed (\\j -> f (i, j))) \nmapindexed3 f = mapindexed (\\i -> mapindexed (\\j -> mapindexed (\\k -> f (i, j, k))))\n\n-- main = print (mapindexed (\\x y -> mapat (10+) [1,2,3,4] y) [1,2,3,4])\n-- main = print (mapindexed2 (\\(i,j) x -> 100*i + 10*j + x) ginp)\n-- main = print (mapindexed3 (\\(i,j,k) x -> 1000*i + 100*j + 10*k + x) gw)\n\\end{code}\n\n\n\nOverload arithmetical operators to work on arrays.\n\n\\begin{code}\ninstance (Ix a, Show a, Num b) => Num (Array a b) where\n  (+) = zipArr \"+\" (+)\n  (-) = zipArr \"-\" (-)\n  negate = fmap negate\n  abs = fmap abs\n  signum = fmap signum\n--   (*) = matMult -- works only for matrices!\n--   fromInteger = map fromInteger\n\\end{code}\n\n\\begin{xcode}\nscaleArr :: (Ix i, Num a) => a -> Array i a -> Array i a\nscaleArr a = fmap (*a)\n\nsumArr :: (Ix i, Num a) => Array i a -> a\nsumArr = sum . elems\n\\end{xcode}\n\n\\begin{code}\narraySize :: (Ix i) => Array i a -> Int\narraySize = rangeSize . bounds\n\\end{code}\n\n\\begin{code}\nmatMult         :: (Ix a, Ix b, Ix c, Num d) =>\n                   Array (a,b) d -> Array (b,c) d -> Array (a,c) d\nmatMult x y     =  array resultBounds\n                         [((i,j), sum [x!(i,k) * y!(k,j) | k <- range (lj,uj)])\n                                       | i <- range (li,ui),\n                                         j <- range (lj',uj') ]\n        where ((li,lj),(ui,uj))         =  bounds x\n              ((li',lj'),(ui',uj'))     =  bounds y\n              resultBounds\n                | (lj,uj)==(li',ui')    =  ((li,lj'),(ui,uj'))\n                | otherwise             = error \"matMult: incompatible bounds\"\n\\end{code}\n\n\nInner product of two vectors.\n\n\\begin{code}\ninner :: Num a => Vector a -> Vector a -> a\ninner (Vector v) (Vector w) = if b == bounds w\n               then sum [v!i * w!i | i <- range b]\n               else error \"nn.inner: inconformable vectors\"\n            where b = bounds v\n\\end{code}\n\nOuter product of two vectors $v \\dot w^\\mathrm{T}$.\n\n\\begin{code}\nouterVector :: Num b => Vector b -> Vector b -> Matrix b\nouterVector (Vector v) (Vector w) = if (l,u) == (l',u')\n               then matrix ((l,l'),(u,u')) [((i,j), v!i * w!j) | i <- range (l,u), j <- range (l',u')]\n               else error \"nn.outer: inconformable vectors\"\n            where ((l,u),(l',u')) = (bounds v, bounds w)\n\\end{code}\n\n\\begin{code}\nouterArr :: (Ix a, Num b) => Array a b -> Array a b -> Array (a,a) b\nouterArr v w = if (l,u) == (l',u')\n               then array ((l,l'),(u,u')) [((i,j), v!i * w!j) | i <- range (l,u), j <- range (l',u')]\n               else error \"nn.outer: inconformable vectors\"\n            where ((l,u),(l',u')) = (bounds v, bounds w)\n\\end{code}\n\nInner product of a matrix and a vector.\n\n\\begin{code}\nmatvec :: (Ix a, Num b) => Array (a,a) b -> Array a b -> Array a b\nmatvec w x | bounds x == (l',u') =\n                array (l,u) [(i, sum [w!(i,j) * x!j | j <- range (l',u')]) \n                                | i <- range (l,u)]\n           | otherwise           = error \"nn.matvec: inconformable arrays\"\n         where ((l,l'),(u,u')) = bounds w\n\\end{code}\n\nAppend to a vector.\n\n\\begin{code}\naugment :: (Num a) => Vector a -> a -> Vector a\naugment (Vector x) y = Vector (array (a,b') ((b',y) : assocs x))\n            where (a,b) = bounds x\n                  b' = b + 1\n\\end{code}\n\nOlder approach (x!!i!!j fails in ghc-2.03).\n\n\\begin{code}\ntoMatrix' :: [[a]] -> Matrix a\ntoMatrix' x = Matrix (array ((1,1),(u,u')) [((i,j), (x!!(i-1))!!(j-1)) \n                             | i <- range (1,u), j <- range (1,u')])\n          where (u,u') = (length x,length (x!!0))\n\\end{code}\n\nMatrix 2D printout.\n\n\\begin{code}\npadleft :: Int -> String -> String\npadleft n x | n <= length x = x\n            | otherwise = replicate (n - length x) ' ' ++ x\n\\end{code}\n\n\\begin{code}\npadMatrix :: RealFloat a => Int -> Matrix a -> Matrix String\npadMatrix n x = let ss = fmap (\\a -> showFFloat (Just n) a \"\") x \n                    maxw = maximum (fmap length (elems (fromMatrix ss)))\n              in fmap (padleft maxw) ss\n\\end{code}\n\n\\begin{xcode}\nshowsVector :: (RealFloat a) => Int -> Vector a -> ShowS\nshowsVector n x z1 = let x' = padArr n x\n                         (l,u) = bounds x' in\n                  concat (fmap (\\ (i, s) -> if i == u then s ++ \"\\n\" else s ++ \" \") (assocs x')) ++ z1\n\\end{xcode}\n\n\\begin{xcode}\nshowsMatrix :: RealFloat a => Int -> Matrix a -> ShowS\nshowsMatrix n x z1 = let x' = padMatrix n x\n                         ((l,l'),(u,u')) = bounds x' in\n                   concat (fmap (\\ ((i,j), s) -> if j == u' then s ++ \"\\n\" else s ++ \" \") (assocs x')) ++ z1\n\\end{xcode}\n\n{-\nshowsVecList n x s = foldr (showsVector n) s x\nshowsMatList n x s = foldr (showsMatrix n) s x\n-}\n\n\n\\begin{code}\n--spy :: Show a => String -> a -> a\n--spy msg x = trace ('<' : msg ++ \": \" ++ shows x \">\\n\") x\n--spy x  = seq (unsafePerformIO (putStr ('<' : shows x \">\\n\"))) x\n--spy x  = traceShow \"z\" x\n\\end{code}\n", "num_lines": 396}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\\begin{code}\nmodule Main(main) where\nimport Arr\n\\end{code}\n\n\\begin{code}\ntype F a = Vector a -> a\ntype DF a = Vector a -> Vector a\n\\end{code}\n\n\\begin{code}\ndata {-(Eval a) =>-} ScgData a = ScgData {k :: !Int, err :: !a,\n                          w, p, r :: !(Vector a),\n                          delta, pnorm2, lambda, lambdabar :: !a,\n                          success :: !Bool}\n\\end{code}\n\n\\begin{code}\ncalculate2order :: Floating a => ScgData a -> a -> DF a -> ScgData a\ncalculate2order d sigma1 df = \n  let pnorm2' = vectorNorm2 (p d)\n      sigma = sigma1 / (sqrt pnorm2')\n      s = scaleVector (1/sigma) (df ((w d) + (scaleVector sigma (p d))) - df (w d)) \n  in d {pnorm2 = pnorm2', delta = inner (p d) s}\n\\end{code}\n\n\\begin{code}\nhessPosDef :: (Floating a, Ord a) => ScgData a -> ScgData a\nhessPosDef d =\n  let delta' = delta d + (lambda d - lambdabar d) * pnorm2 d {- step 3 -}\n  in if delta' <= 0                             {- step 4 -}\n     then let lambdabar' = 2.0 * (lambda d - delta' / pnorm2 d)\n          in d {delta = -delta' + lambda d * pnorm2 d, lambda = lambdabar', lambdabar = lambdabar'}\n     else d {delta = delta'}\n\\end{code}\n\n\\begin{code}\nreduceError :: (Floating a, Ord a) => ScgData a -> DF a -> Bool -> a -> a -> ScgData a\nreduceError d df restart bdelta mu = \n  let r' = negate (df (w d))\n      p' = if restart\n           then r'\n           else let beta = (vectorNorm2 r' - inner r' (r d)) / mu\n                in r' + scaleVector beta (p d)\n  in d {p = p', r = r', lambda = if bdelta >= 0.75 then lambda d / 4 else lambda d\n    }\n\\end{code}\n\n\\begin{code}\ndata ScgInput a = ScgInput (F a) (DF a) (Vector a)\n\\end{code}\n\n\\begin{code}\nscgIter :: (Floating a, Ord a) => ScgInput a -> [ScgData a]\nscgIter (ScgInput f df w1) =\n    let p1 = negate (df w1)                     {- step 1 -}\n        r1 = p1\n        pnorm21 = vectorNorm2 p1\n        n = vectorSize w1\n        sigma1 = 1.0e-4\n        lambda1 = 1.0e-6\n        err1 = f w1\n    in iterate (\\d ->\n           let d1 = if success d                {- step 2 -}\n                    then calculate2order d sigma1 df\n                    else d\n               d2 = hessPosDef d1\n               mu = inner (p d2) (r d2)         {- step 5 -}\n               alpha = mu / (delta d2)\n               w' = (w d2) + scaleVector alpha (p d2)\n               err' = f w'\n               bdelta = 2 * (delta d2) * ((err d2) - err') / (mu^2) {- step 6 -}\n               success' = (bdelta >= 0)         {- step 7 -}\n               restart = ((k d) `mod` n == 0)\n               d3 = if success' \n                    then (reduceError (d2 {w = w'}) df restart bdelta mu) \n                            {err = err', lambdabar = 0}\n                    else d2 {lambdabar = lambda d2}\n               d4 = if bdelta < 0.25          {- step 8 -}\n                    then d3 {lambda = (lambda d3) + (delta d3) * (1 - bdelta) / (pnorm2 d3)}\n                    else d3\n           in d4 {k = k d4 + 1, success = success'}\n       )\n       (ScgData 1 err1 w1 p1 r1 0.0 pnorm21 lambda1 0.0 True)\n\\end{code}\n\n\\begin{code}\nrosenbrock = ScgInput\n  (\\ (Vector x) -> 100 * (x!2 - x!1^2)^2 + (1 - x!1)^2)\n  (\\ (Vector x) -> listVector [-2 * (1 - x!1) - 400 * x!1 * (x!2 - x!1^2), \n                              200 * (x!2 -x!1^2)])\n  (listVector [-1,-1.0])\n\\end{code}\n\n\n\\begin{code}\nmain = case vectorList (w ((scgIter rosenbrock)!!1)) of\n       [v1, v2] -> if (e1 `isSame` v1) && (e2 `isSame` v2)\n                   then print (e1, e2)\n                   else putStrLn (\"Mismatch: \" ++ show (e1, e2, v1, v2))\n       vs -> putStrLn (\"Wrong list length: \" ++ show vs)\n\ne1, e2 :: Floating a => a\ne1 = -0.5105811455265337\ne2 = -0.7565080326002654\n\nisSame :: (Fractional a, Ord a) => a -> a -> Bool\nx `isSame` y = abs (x - y) < 0.000000000000001\n\\end{code}\n", "num_lines": 110}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\\section{Versions of {\\tt append}}\n\n\\begin{code}\n{-# LANGUAGE MagicHash #-}\n\nmodule Append where\n\nimport GHC.Exts\nimport Types\n\\end{code}\n\n\\begin{code}\nappend_ :: [a] -> [a] -> [a]\nappend_ (x:xs) ys = x : (append_ xs ys)\nappend_ [] ys = ys\n\nappend_L_S_S :: String -> S Char -> S Char\nappend_L_S_S (a: b: c: d: e: a1: b1: c1: d1: e1: xs) ys  \n = S5 a b c d e (S5 a1 b1 c1 d1 e1 (append_L_S_S xs ys))\nappend_L_S_S (a: b: c: d: e: xs) ys  \n = S5 a b c d e (append_L_S_S xs ys)\nappend_L_S_S (a: b: c: d: _) ys\n = S4 a b c d ys\nappend_L_S_S (a: b: c: _) ys\n = S3 a b c ys\nappend_L_S_S (a: b: _) ys\n = S2 a b ys\nappend_L_S_S [a] ys\n = S1 a ys\nappend_L_S_S [] ys = ys\n\nappend_F_S_S :: F Char -> S Char -> S Char\nappend_F_S_S (F5 a b c d e (F5 a1 b1 c1 d1 e1 xs)) ys  \n = S5 a b c d e (S5 a1 b1 c1 d1 e1 (append_F_S_S xs ys))\nappend_F_S_S (F5 a b c d e xs) ys  \n = S5 a b c d e (append_F_S_S xs ys)\nappend_F_S_S (F4 a b c d) ys\n = S4 a b c d ys\nappend_F_S_S (F3 a b c) ys\n = S3 a b c ys\nappend_F_S_S (F2 a b) ys\n = S2 a b ys\nappend_F_S_S (F1 a) ys\n = S1 a ys\nappend_F_S_S FN ys = ys\n\n\nappend_L_SC_SC :: String -> SC -> SC\nappend_L_SC_SC (C# a: C# b: C# c: C# d: \n                C# e: C# a1: C# b1: C# c1: \n                C# d1: C# e1: xs) ys  \n = SC5 a b c d e (SC5 a1 b1 c1 d1 e1 (append_L_SC_SC xs ys))\nappend_L_SC_SC (C# a: C# b: C# c: C# d: \n                C# e: xs) ys  \n = SC5 a b c d e (append_L_SC_SC xs ys)\nappend_L_SC_SC (C# a: C# b: C# c: C# d: _) ys\n = SC4 a b c d ys\nappend_L_SC_SC (C# a: C# b: C# c: _) ys\n = SC3 a b c ys\nappend_L_SC_SC (C# a: C# b: _) ys\n = SC2 a b ys\nappend_L_SC_SC [C# a] ys\n = SC1 a ys\nappend_L_SC_SC [] ys = ys\n\n\nappend_FC_SC_SC :: FC -> SC -> SC\nappend_FC_SC_SC (FC5 a b c d e (FC5 a1 b1 c1 d1 e1 xs)) ys  \n = SC5 a b c d e (SC5 a1 b1 c1 d1 e1 (append_FC_SC_SC xs ys))\nappend_FC_SC_SC (FC5 a b c d e xs) ys  \n = SC5 a b c d e (append_FC_SC_SC xs ys)\nappend_FC_SC_SC (FC4 a b c d) ys\n = SC4 a b c d ys\nappend_FC_SC_SC (FC3 a b c) ys\n = SC3 a b c ys\nappend_FC_SC_SC (FC2 a b) ys\n = SC2 a b ys\nappend_FC_SC_SC (FC1 a) ys\n = SC1 a ys\nappend_FC_SC_SC FCN ys = ys\n\nappend_F_L_L :: F a -> [a] -> [a]\nappend_F_L_L (F5 a b c d e (F5 a1 b1 c1 d1 e1 xs)) ys  \n = a: b: c: d: e: a1: b1: c1: d1: e1: (append_F_L_L xs ys)\nappend_F_L_L (F5 a b c d e xs) ys  \n = a: b: c: d: e: (append_F_L_L xs ys)\nappend_F_L_L (F4 a b c d) ys  = a: b: c: d: ys\nappend_F_L_L (F3 a b c) ys  = a: b: c: ys\nappend_F_L_L (F2 a b) ys  = a: b: ys\nappend_F_L_L (F1 a) ys  = a: ys\nappend_F_L_L FN ys = ys\n\nappend_S_L_L :: S Char -> String -> String\nappend_S_L_L (S5 a b c d e (S5 a1 b1 c1 d1 e1 xs)) ys  \n =  a:  b:  c:  d:  e:  a1: b1:  c1:  d1:  e1: (append_S_L_L xs ys)\nappend_S_L_L (S5 a b c d e xs) ys  \n =  a:  b:  c:  d: e: (append_S_L_L xs ys)\nappend_S_L_L (S4 a b c d xs) ys  \n =  a:  b:  c:  d: (append_S_L_L xs ys)\nappend_S_L_L (S3 a b c xs) ys  \n =  a:  b:  c: (append_S_L_L xs ys)\nappend_S_L_L (S2 a b xs) ys  \n =  a:  b: (append_S_L_L xs ys)\nappend_S_L_L (S1 a xs) ys  \n =  a: (append_S_L_L xs ys)\nappend_S_L_L SN ys = ys\n\n\nappend_FC_L_L :: FC -> String -> String\nappend_FC_L_L (FC5 a b c d e (FC5 a1 b1 c1 d1 e1 xs)) ys  \n = C# a: C# b: C# c: C# d: C# e: C# a1: \n      C# b1: C# c1: C# d1: C# e1: \n         (append_FC_L_L xs ys)\nappend_FC_L_L (FC5 a b c d e xs) ys  \n = C# a: C# b: C# c: C# d: \n      C# e: (append_FC_L_L xs ys)\nappend_FC_L_L (FC4 a b c d) ys  \n = C# a: C# b: C# c: C# d: ys\nappend_FC_L_L (FC3 a b c) ys  \n = C# a: C# b: C# c: ys\nappend_FC_L_L (FC2 a b) ys  = C# a: C# b: ys\nappend_FC_L_L (FC1 a) ys  = C# a: ys\nappend_FC_L_L FCN ys = ys\n\nappend_SC_L_L :: SC -> String -> String\nappend_SC_L_L (SC5 a b c d e (SC5 a1 b1 c1 d1 e1 xs)) ys  \n = C# a: C# b: C# c: C# d: C# e: C# a1: \n      C# b1: C# c1: C# d1: C# e1: \n          (append_SC_L_L xs ys)\nappend_SC_L_L (SC5 a b c d e xs) ys  \n = C# a: C# b: C# c: C# d: \n      C# e: (append_SC_L_L xs ys)\nappend_SC_L_L (SC4 a b c d xs) ys  \n = C# a: C# b: C# c: C# d: (append_SC_L_L xs ys)\nappend_SC_L_L (SC3 a b c xs) ys  \n = C# a: C# b: C# c: (append_SC_L_L xs ys)\nappend_SC_L_L (SC2 a b xs) ys  \n = C# a: C# b: (append_SC_L_L xs ys)\nappend_SC_L_L (SC1 a xs) ys  \n = C# a: (append_SC_L_L xs ys)\nappend_SC_L_L SCN ys = ys\n\\end{code}\n", "num_lines": 143}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\\begin{code}\n{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\nimport Types\nimport Append\n\nmain = putStr (show (append_FC_L_L (FC2 a_ a_) []))\n   where a_ = case 'a' of { C# x -> x }\n\\end{code}\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\\section{IDS types}\n\n\\begin{code}\n{-# LANGUAGE MagicHash #-}\n\nmodule Types where\n\nimport GHC.Exts\n\ndata F a = FN | F1 a | F2 a a | F3 a a a \n         | F4 a a a a \n         | F5 a a a a a (F a) \n\ndata FI = FIN | FI1 Int# | FI2 Int# Int# | FI3 Int# Int# Int# \n        | FI4 Int# Int# Int# Int# \n        | FI5 Int# Int# Int# Int# Int# FI\n\ndata FC = FCN | FC1 Char# | FC2 Char# Char# \n        | FC3 Char# Char# Char# \n        | FC4 Char# Char# Char# Char# \n        | FC5 Char# Char# Char# Char# Char# FC\n\\end{code}\n\n\\begin{code}\ndata F2 a b = F2N | F21 a b | F22 a b a b | F23 a b a b a b \n            | F24 a b a b a b a b \n            | F25 a b a b a b a b a b (F2 a b) \n\ndata F3 a b c = F3N | F31 a b c | F32 a b c a b c \n              | F33 a b c a b c a b c\n              | F34 a b c a b c a b c a b c\n              | F35 a b c a b c a b c a b c a b c (F3 a b c) \n\ndata F3I = F3IN \n         | F3I1 Int# Int# Int# \n         | F3I2 Int# Int# Int# Int# Int# Int# \n         | F3I3 Int# Int# Int# Int# Int# Int# Int# Int# Int#\n         | F3I4 Int# Int# Int# Int# Int# Int# Int# Int# Int# \n                Int# Int# Int#\n         | F3I5 Int# Int# Int# Int# Int# Int# Int# Int# Int# \n                Int# Int# Int# Int# Int# Int# F3I\n\\end{code}\n\n\\begin{code}\ndata S a = SN | S1 a (S a) | S2 a a (S a) | S3 a a a (S a)\n         | S4 a a a a (S a)\n         | S5 a a a a a (S a) \n\ndata SI = SIN | SI1 Int# SI | SI2 Int# Int# SI \n        | SI3 Int# Int# Int# SI\n        | SI4 Int# Int# Int# Int# SI\n        | SI5 Int# Int# Int# Int# Int# SI\n\n\ndata SC = SCN | SC1 Char# SC | SC2 Char# Char# SC \n        | SC3 Char# Char# Char# SC\n        | SC4 Char# Char# Char# Char# SC\n        | SC5 Char# Char# Char# Char# Char# SC\n\\end{code}\n\n\n\n\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "       module Fast2haskell (\n            Complex_type, Array_type, Assoc_type, Descr_type,\n            abortstr, delay, fix, force, iff, iffrev, seQ,\n            pair, strcmp,\n            entier,\n            land_i, lnot_i, lor_i, lshift_i, rshift_i,\n            descr,\n            destr_update, indassoc, lowbound, tabulate, upbound, update, valassoc) where {\n            import Data.Bits;\n--            import Word2;\n            import Data.Word;\n            import Data.Complex; -- 1.3\n            import Data.Array; -- 1.3\n--          import Data.Int ( Num(fromInt) );\n            type Complex_type   = Complex Double;\n            type Array_type b   = Array Int b;\n            type Assoc_type a   = (Int, a);\n            type Descr_type     = (Int,Int);\n            abortstr      str                 = error (\"abort:\"++str); -- abort (OtherError str);\n            delay         x                   = abortstr \"delay not implemented\";\n            fix           f                   = fix_f where {fix_f = f fix_f};\n            force         x                   = x; -- error  \"force not implemented\";\n            iff           b     x  y          = if b then x else y;\n            iffrev        y  x      b         = if b then x else y;\n            seQ           x    y              = x `seq` y;\n            pair          []                  = False;\n            pair          x                   = True;\n            strcmp        :: [Char] -> [Char] -> Bool;\n            strcmp        x      y            = x == y;\n            entier        x                   = fromIntegral (floor x);\n            land_i        :: Int -> Int -> Int;\n            land_i        x    y              = x .&. y;\n            lnot_i        :: Int -> Int;\n            lnot_i        x                   = complement x;\n            lor_i         :: Int -> Int -> Int;\n            lor_i         x    y              = x .|. y;\n            lshift_i      :: Int -> Int -> Int;\n            lshift_i      x    y              = x `shiftL` y;\n            rshift_i      :: Int -> Int -> Int;\n            rshift_i      x    y              = x `shiftR` y;\n            write         x                   = abortstr \"write not implemented\";\n            descr         l    u              = (l,u);\n            destr_update  ar  i  x            = ar // [(i,x)];\n            indassoc      (i,v)              = i;\n            lowbound      (l,u)               = l;\n            tabulate      f (l,u)             = listArray (l,u) [f i | i <- [l..u]];\n            upbound       (l,u)               = u;\n            update        ar i x              = ar // [(i,x)];\n            valassoc      (i,v)               = v;\n       }\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) -- TEST\nwhere {\nimport Fast2haskell;\nimport Data.Complex;--1.3\nimport Data.Array;--1.3\n\n    c_eps=(5.00000e-06 :: Double);\n    c_t=True;\n    c_f=False;\n    c_input=(0 :: Int);\n    f_main a_n=\n        let { \n            r_x=[(a_tf,(++) (show a_i) ((++) \"\\t\" a_str))|(a_i,(a_tf,a_str))<-f_zip2 (enumFrom (1 :: Int)) c_testlist];\n            r_noks=[(++) a_str \"\\n\"|(a_tf,a_str)<-r_x,not a_tf];\n            r_oks=[(++) a_str \"\\n\"|(a_tf,a_str)<-r_x,a_tf]\n         } in  \n            if (((>) :: (Int -> Int -> Bool)) a_n (0 :: Int))\n            then (f_onetest ((!!) c_testlist (((-) :: (Int -> Int -> Int)) a_n (1 :: Int))))\n            else \n                ((++) (show (length r_oks)) ((++) \" tests passed and \" ((++) (show \n                (length r_noks)) ((++) \" failed\\n\" (c_concat r_noks)))));\n    f_onetest (True,a_str)=(++) \"true:  \" ((++) a_str \"\\n\");\n    f_onetest (False,a_str)=(++) \"false: \" ((++) a_str \"\\n\");\n    f_booltest a_name True a_try=\n        if a_try\n        then (True,\"\")\n        else \n            (False,(++) a_name \"\\tok: true is: false\");\n    f_booltest a_name False a_try=\n        if (not a_try)\n        then (True,\"\")\n        else \n            (False,(++) a_name \"\\tok: false is: true\");\n    f_inttest a_name a_ok a_try=\n        if (((==) :: (Int -> Int -> Bool)) a_ok a_try)\n        then (True,\"\")\n        else \n            (False,(++) a_name ((++) \"\\tok: \" ((++) (show a_ok) ((++) \"\\tis: \" \n            (show a_try)))));\n    f_chartest a_name a_ok a_try=\n        if (((==) :: (Int -> Int -> Bool)) (fromEnum a_ok) (fromEnum a_try))\n        then (True,\"\")\n        else \n            (False,(++) a_name ((++) \"\\tok: \" ((++) ((:) a_ok []) ((++) \"\\tis: \" \n            ((:) a_try [])))));\n    f_strtest a_name a_ok a_try=\n        if (strcmp a_ok a_try)\n        then (True,\"\")\n        else \n            (False,(++) a_name ((++) \"\\tok: \" ((++) a_ok ((++) \"\\tis: \" a_try))));\n    f_linttest a_name a_ok a_try=\n        if (f_lintcmp a_ok a_try)\n        then (True,\"\")\n        else \n            (False,(++) a_name ((++) \"\\tok: \" ((++) (f_showlint a_ok) ((++) \"\\tis: \" \n            (f_showlint a_try)))));\n    f_doubtest a_name a_ok a_try=\n        if (((<=) :: (Double -> Double -> Bool)) (f_abs (((-) :: (Double -> Double -> Double)) a_ok a_try)) c_eps)\n        then (True,\"\")\n        else \n            (False,(++) a_name ((++) \"\\tok: \" ((++) (show a_ok) ((++) \"\\tis: \" \n            ((++) (show a_try) ((++) \"\\tok-is: \" (show (((-) :: (Double -> Double -> Double)) a_ok a_try))))))));\n    f_alternating a_l=(:) (0 :: Int) ((:) (1 :: Int) a_l);\n    f_showlint []=[];\n    f_showlint a_xs=tail (c_concat [(++) \",\" (show a_x)|a_x<-a_xs]);\n    f_lintcmp [] []=True;\n    f_lintcmp [] a_ys=False;\n    f_lintcmp a_xs []=False;\n    f_lintcmp (a_x:a_xs) (a_y:a_ys)=\n        if (((==) :: (Int -> Int -> Bool)) a_x a_y)\n        then (f_lintcmp a_xs a_ys)\n        else \n            False;\n    c_testlist=(:) (f_inttest \"array\" (10 :: Int) ((!) (array (descr (1 :: Int) (3 :: Int)) ((:) \n        ((,) (3 :: Int) (30 :: Int)) ((:) ((,) (1 :: Int) (10 :: Int)) ((:) ((,) (2 :: Int) (20 :: Int)) [])))) (1 :: Int))) ((:) (f_inttest \"array\" (20 :: Int) \n        ((!) (array (descr (1 :: Int) (3 :: Int)) ((:) ((,) (3 :: Int) (30 :: Int)) ((:) ((,) (1 :: Int) (10 :: Int)) \n        ((:) ((,) (2 :: Int) (20 :: Int)) [])))) (2 :: Int))) ((:) (f_inttest \"array\" (30 :: Int) ((!) (array (descr (1 :: Int) (3 :: Int)) \n        ((:) ((,) (3 :: Int) (30 :: Int)) [])) (3 :: Int))) ((:) (f_inttest \"assoc\" (0 :: Int) (indassoc ((,) (0 :: Int) (1 :: Int)))) ((:) \n        (f_inttest \"assoc\" (1 :: Int) (valassoc ((,) (0 :: Int) (1 :: Int)))) ((:) (f_inttest \"bounds\" (1 :: Int) (lowbound (bounds \n        (listArray (descr (1 :: Int) (3 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))))))) ((:) (f_inttest \"bounds\" (3 :: Int) \n        (upbound (bounds (listArray (descr (1 :: Int) (3 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))))))) \n        ((:) (f_inttest \"descr\" (0 :: Int) (lowbound (descr (0 :: Int) (1 :: Int)))) ((:) (f_inttest \"descr\" (1 :: Int) (upbound \n        (descr (0 :: Int) (1 :: Int)))) ((:) (f_linttest \"destr_update\" ((:) (1 :: Int) ((:) (0 :: Int) ((:) (3 :: Int) []))) (elems \n        (destr_update (listArray (descr (0 :: Int) (2 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (1 :: Int) (0 :: Int)))) ((:) \n        (f_linttest \"destr_update\" ((:) (0 :: Int) []) (elems (destr_update (listArray (descr (0 :: Int) (0 :: Int)) ((:) (1 :: Int) \n        ((:) (2 :: Int) ((:) (3 :: Int) [])))) (0 :: Int) (0 :: Int)))) ((:) (f_linttest \"elems\" ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))) \n        (elems (listArray (descr (0 :: Int) (2 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))))) ((:) \n        (f_linttest \"elems\" ((:) (1 :: Int) []) (elems (listArray (descr (0 :: Int) (0 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) \n        ((:) (3 :: Int) [])))))) ((:) (f_inttest \"indassoc\" (0 :: Int) (indassoc ((,) (0 :: Int) (1 :: Int)))) ((:) (f_linttest \"listarray\" \n        ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))) (elems (listArray (descr (0 :: Int) (2 :: Int)) ((:) (1 :: Int) \n        ((:) (2 :: Int) ((:) (3 :: Int) [])))))) ((:) (f_linttest \"listarray\" ((:) (1 :: Int) []) (elems (listArray \n        (descr (0 :: Int) (0 :: Int)) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))))) ((:) (f_inttest \"lowbound\" (0 :: Int) (lowbound \n        (descr (0 :: Int) (1 :: Int)))) ((:) (f_inttest \"subscript\" (1 :: Int) ((!) (tabulate ((!!) ((:) (1 :: Int) \n        ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))) (0 :: Int))) ((:) (f_inttest \"subscript\" (2 :: Int) ((!) (tabulate \n        ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))) (1 :: Int))) ((:) (f_inttest \"subscript\" (3 :: Int) \n        ((!) (tabulate ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))) (2 :: Int))) \n        ((:) (f_linttest \"tabulate\" ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) []))) (elems (tabulate \n        ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) (descr (0 :: Int) (2 :: Int))))) ((:) (f_linttest \"tabulate\" \n        ((:) (1 :: Int) []) (elems (tabulate ((!!) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) [])))) \n        (descr (0 :: Int) (0 :: Int))))) ((:) (f_inttest \"upbound\" (1 :: Int) (upbound (descr (0 :: Int) (1 :: Int)))) ((:) (f_inttest \"valassoc\" (1 :: Int) \n        (valassoc ((,) (0 :: Int) (1 :: Int)))) ((:) (f_doubtest \"add_x\" (0.00000 :: Double) (realPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) \n        ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) (f_doubtest \"add_x\" (0.00000 :: Double) (imagPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) \n        ((:) (f_doubtest \"add_x\" (4.00000 :: Double) (realPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) \n        (f_doubtest \"add_x\" (6.00000 :: Double) (imagPart (((+) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_doubtest \"complex\" (1.00000 :: Double) \n        (realPart ((:+) (1.00000 :: Double) (0.00000 :: Double)))) ((:) (f_doubtest \"complex\" (1.00000 :: Double) (imagPart ((:+) (0.00000 :: Double) (1.00000 :: Double)))) ((:) \n        (f_doubtest \"complex_im\" (0.00000 :: Double) (imagPart ((:+) (1.00000 :: Double) (0.00000 :: Double)))) ((:) (f_doubtest \"complex_im\" (1.00000 :: Double) (imagPart ((:+) (0.00000 :: Double) (1.00000 :: Double)))) \n        ((:) (f_doubtest \"complex_re\" (0.00000 :: Double) (realPart ((:+) (0.00000 :: Double) (1.00000 :: Double)))) ((:) (f_doubtest \"complex_re\" (1.00000 :: Double) (realPart \n        ((:+) (1.00000 :: Double) (0.00000 :: Double)))) ((:) (f_doubtest \"mul_x\" (0.00000 :: Double) (realPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) \n        ((:) (f_doubtest \"mul_x\" (0.00000 :: Double) (imagPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) \n        (f_doubtest \"mul_x\" (((negate) :: (Double -> Double)) (5.00000 :: Double)) (realPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) \n        (f_doubtest \"mul_x\" (10.0000 :: Double) (imagPart (((*) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_doubtest \"sub_x\" (0.00000 :: Double) \n        (realPart (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) (f_doubtest \"sub_x\" (0.00000 :: Double) (imagPart \n        (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (0.00000 :: Double) (0.00000 :: Double)) ((:+) (0.00000 :: Double) (0.00000 :: Double))))) ((:) (f_doubtest \"sub_x\" (((negate) :: (Double -> Double)) (2.00000 :: Double)) (realPart \n        (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_doubtest \"sub_x\" (((negate) :: (Double -> Double)) (2.00000 :: Double)) (imagPart \n        (((-) :: (Complex_type -> Complex_type -> Complex_type)) ((:+) (1.00000 :: Double) (2.00000 :: Double)) ((:+) (3.00000 :: Double) (4.00000 :: Double))))) ((:) (f_inttest \"seq\" (2 :: Int) (seq (enumFrom (1 :: Int)) (2 :: Int))) \n        ((:) (f_strtest \"**\" \"this one\" \"should fail\") [])))))))))))))))))))))))))))))))))))))))))));\n    f_abs a_x=\n        if (((<=) :: (Double -> Double -> Bool)) a_x (0.00000 :: Double))\n        then (((negate) :: (Double -> Double)) a_x)\n        else \n            a_x;\n    c_and=f_foldr (&&) True;\n    f_cjustify a_n a_s=\n        let { \n            r_margin=((-) :: (Int -> Int -> Int)) a_n (length a_s);\n            r_lmargin=((div) :: (Int -> Int -> Int)) r_margin (2 :: Int);\n            r_rmargin=((-) :: (Int -> Int -> Int)) r_margin r_lmargin\n         } in  (++) (f_spaces r_lmargin) ((++) a_s (f_spaces r_rmargin));\n    c_concat=f_foldr (++) [];\n    f_const a_x a_y=a_x;\n    f_digit a_x=\n        if (((<=) :: (Int -> Int -> Bool)) (fromEnum '0') (fromEnum a_x))\n        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_x) (fromEnum '9'))\n        else \n            False;\n    f_drop 0 a_x=a_x;\n    f_drop a_n (a_a:a_x)=f_drop (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x;\n    f_drop a_n a_x=[];\n    f_dropwhile a_f []=[];\n    f_dropwhile a_f (a_a:a_x)=\n        if (a_f a_a)\n        then (f_dropwhile a_f a_x)\n        else \n            ((:) a_a a_x);\n    c_e=((exp) :: (Double -> Double)) (1.00000 :: Double);\n    f_filter a_f a_x=[a_a|a_a<-a_x,a_f a_a];\n    f_foldl a_op a_r []=a_r;\n    f_foldl a_op a_r (a_a:a_x)=\n        let { \n            f_strict a_f a_x=seq a_x (a_f a_x)\n         } in  f_foldl a_op (f_strict a_op a_r a_a) a_x;\n    f_foldl1 a_op (a_a:a_x)=f_foldl a_op a_a a_x;\n    f_foldr a_op a_r []=a_r;\n    f_foldr a_op a_r (a_a:a_x)=a_op a_a (f_foldr a_op a_r a_x);\n    f_foldr1 a_op (a_a:[])=a_a;\n    f_foldr1 a_op (a_a:a_b:a_x)=a_op a_a (f_foldr1 a_op ((:) a_b a_x));\n    f_fst (a_a,a_b)=a_a;\n    f_id a_x=a_x;\n    f_index a_x=\n        let { \n            f_f a_n []=[];\n            f_f a_n (a_a:a_x)=(:) a_n (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x)\n         } in  f_f (0 :: Int) a_x;\n    f_init (a_a:a_x)=\n        if (null a_x)\n        then []\n        else \n            ((:) a_a (f_init a_x));\n    f_iterate a_f a_x=(:) a_x (f_iterate a_f (a_f a_x));\n    f_last a_x=(!!) a_x (((-) :: (Int -> Int -> Int)) (length a_x) (1 :: Int));\n    f_lay []=[];\n    f_lay (a_a:a_x)=(++) a_a ((++) \"\\n\" (f_lay a_x));\n    f_layn a_x=\n        let { \n            f_f a_n []=[];\n            f_f a_n (a_a:a_x)=(++) (f_rjustify (4 :: Int) (show a_n)) ((++) \") \" ((++) a_a ((++) \"\\n\" \n                (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x))))\n         } in  f_f (1 :: Int) a_x;\n    f_letter a_c=\n        if (\n            if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'a') (fromEnum a_c))\n            then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'z'))\n            else \n                False)\n        then True\n        else \n        if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'A') (fromEnum a_c))\n        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'Z'))\n        else \n            False;\n    f_limit (a_a:a_b:a_x)=\n        if (((==) :: (Double -> Double -> Bool)) a_a a_b)\n        then a_a\n        else \n            (f_limit ((:) a_b a_x));\n    f_lines []=[];\n    f_lines (a_a:a_x)=\n        let { \n            r_xs=\n                if (pair a_x)\n                then (f_lines a_x)\n                else \n                    ((:) [] [])\n         } in  \n            if (((==) :: (Int -> Int -> Bool)) (fromEnum a_a) (fromEnum '\\o012'))\n            then ((:) [] (f_lines a_x))\n            else \n                ((:) ((:) a_a (head r_xs)) (tail r_xs));\n    f_ljustify a_n a_s=(++) a_s (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s)));\n    f_map a_f a_x=[a_f a_a|a_a<-a_x];\n    f_map2 a_f a_x a_y=[a_f a_a a_b|(a_a,a_b)<-f_zip2 a_x a_y];\n    f_max a_xs=f_foldl1 f_max2 a_xs;\n    f_max2 a_a a_b=\n        if (((>=) :: (Int -> Int -> Bool)) a_a a_b)\n        then a_a\n        else \n            a_b;\n    f_member a_x a_a=c_or (f_map (flip ((==) :: (Int -> Int -> Bool)) a_a) a_x);\n    f_merge [] a_y=a_y;\n    f_merge (a_a:a_x) []=(:) a_a a_x;\n    f_merge (a_a:a_x) (a_b:a_y)=\n        if (((<=) :: (Int -> Int -> Bool)) a_a a_b)\n        then ((:) a_a (f_merge a_x ((:) a_b a_y)))\n        else \n            ((:) a_b (f_merge ((:) a_a a_x) a_y));\n    f_min a_xs=f_foldl1 f_min2 a_xs;\n    f_min2 a_a a_b=\n        if (((>) :: (Int -> Int -> Bool)) a_a a_b)\n        then a_b\n        else \n            a_a;\n    f_mkset []=[];\n    f_mkset (a_a:a_x)=(:) a_a (f_filter (flip ((/=) :: (Int -> Int -> Bool)) a_a) (f_mkset a_x));\n    c_or=f_foldr (||) False;\n    c_pi=((*) :: (Double -> Double -> Double)) (4.00000 :: Double) (((atan) :: (Double -> Double)) (1.00000 :: Double));\n    f_postfix a_a a_x=(++) a_x ((:) a_a []);\n    c_product=f_foldl ((*) :: (Int -> Int -> Int)) (1 :: Int);\n    f_rep a_n a_x=f_take a_n (f_repeat a_x);\n    f_repeat a_x=(:) a_x (f_repeat a_x);\n    c_reverse=f_foldl (flip (:)) [];\n    f_rjustify a_n a_s=(++) (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s))) a_s;\n    f_scan a_op=\n        let { \n            f_g a_r []=(:) a_r [];\n            f_g a_r (a_a:a_x)=(:) a_r (f_g (a_op a_r a_a) a_x)\n         } in  f_g;\n    f_snd (a_a,a_b)=a_b;\n    f_sort a_x=\n        let { \n            r_n=length a_x;\n            r_n2=((div) :: (Int -> Int -> Int)) r_n (2 :: Int)\n         } in  \n            if (((<=) :: (Int -> Int -> Bool)) r_n (1 :: Int))\n            then a_x\n            else \n                (f_merge (f_sort (f_take r_n2 a_x)) (f_sort (f_drop r_n2 a_x)));\n    f_spaces a_n=f_rep a_n ' ';\n    f_subtract a_x a_y=((-) :: (Int -> Int -> Int)) a_y a_x;\n    c_sum=f_foldl ((+) :: (Int -> Int -> Int)) (0 :: Int);\ndata \n    T_sys_message=F_Stdout [Char] | F_Stderr [Char] | F_Tofile [Char] [Char] | F_Closefile [Char] | F_Appendfile [Char] | F_System [Char] | F_Exit Int;\n    f_take 0 a_x=[];\n    f_take a_n (a_a:a_x)=(:) a_a (f_take (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x);\n    f_take a_n a_x=[];\n    f_takewhile a_f []=[];\n    f_takewhile a_f (a_a:a_x)=\n        if (a_f a_a)\n        then ((:) a_a (f_takewhile a_f a_x))\n        else \n            [];\n    f_transpose a_x=\n        let { \n            r_x'=f_takewhile pair a_x\n         } in  \n            if (null r_x')\n            then []\n            else \n                ((:) (f_map head r_x') (f_transpose (f_map tail r_x')));\n    f_until a_f a_g a_x=\n        if (a_f a_x)\n        then a_x\n        else \n            (f_until a_f a_g (a_g a_x));\n    f_zip2 (a_a:a_x) (a_b:a_y)=(:) (a_a,a_b) (f_zip2 a_x a_y);\n    f_zip2 a_x a_y=[];\n    f_zip3 (a_a:a_x) (a_b:a_y) (a_c:a_z)=(:) (a_a,a_b,a_c) (f_zip3 a_x a_y a_z);\n    f_zip3 a_x a_y a_z=[];\n    f_zip4 (a_a:a_w) (a_b:a_x) (a_c:a_y) (a_d:a_z)=(:) (a_a,a_b,a_c,a_d) (f_zip4 a_w a_x a_y a_z);\n    f_zip4 a_w a_x a_y a_z=[];\n    f_zip5 (a_a:a_v) (a_b:a_w) (a_c:a_x) (a_d:a_y) (a_e:a_z)=(:) (a_a,a_b,a_c,a_d,a_e) (f_zip5 a_v a_w a_x a_y a_z);\n    f_zip5 a_v a_w a_x a_y a_z=[];\n    f_zip6 (a_a:a_u) (a_b:a_v) (a_c:a_w) (a_d:a_x) (a_e:a_y) (a_f:a_z)=(:) (a_a,a_b,a_c,a_d,a_e,a_f) (f_zip6 a_u a_v a_w a_x a_y a_z);\n    f_zip6 a_u a_v a_w a_x a_y a_z=[];\n    f_zip (a_x,a_y)=f_zip2 a_x a_y;\n    main = putStr (f_main c_input)\n}\n", "num_lines": 297}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Defines functions as an instance of Num\n\nmodule Main where\n\ninstance (Eq a, Eq b) => Eq (a->b)\n \n\ninstance Show (a->b) where\n  show f = \"<<function>>\"\n\ninstance (Num a, Num b) => Num (a->b) where\n    f + g    = \\x -> f x + g x\n    negate f = \\x -> - (f x)\n    f * g    = \\x -> f x * g x\n    fromInteger n = \\x -> fromInteger n\n\nss :: Float -> Float\ncc :: Float -> Float\ntt :: Float -> Float\n\nss = sin * sin\ncc = cos * cos\ntt = ss + cc\n-- sin**2 + cos**2 = 1\n\nmain = putStrLn ((show (tt 0.4))++ \"  \"++(show (tt 1.652)))\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Construct\n    ( Surface (..)\n    , Face (..)\n    , CSG (..)\n    , Texture\n    , Transform\n    , union, intersect, difference\n    , plane, sphere, cube, cylinder, cone\n    , transform\n    , translate, translateX, translateY, translateZ\n    , scale, scaleX, scaleY, scaleZ, uscale\n    , rotateX, rotateY, rotateZ\n    , eye, translateEye\n    , rotateEyeX, rotateEyeY, rotateEyeZ\n    ) where\n\nimport Geometry\n\n-- In each case, we model the surface by a point and a pair of tangent vectors.\n-- This gives us enough information to determine the surface\n-- normal at that point, which is all that is required by the current\n-- illumination model.  We can't just save the surface normal because\n-- that isn't preserved by transformations.\n\ndata Surface\n  = Planar Point Vector Vector\n  | Spherical Point Vector Vector\n  | Cylindrical Point Vector Vector\n  | Conic Point Vector Vector\n  deriving Show\n\ndata Face\n  = PlaneFace\n  | SphereFace\n  | CubeFront\n  | CubeBack\n  | CubeLeft\n  | CubeRight\n  | CubeTop\n  | CubeBottom\n  | CylinderSide\n  | CylinderTop\n  | CylinderBottom\n  | ConeSide\n  | ConeBase\n  deriving Show\n\ndata CSG a\n  = Plane a\n  | Sphere a\n  | Cylinder a\n  | Cube a\n  | Cone a\n  | Transform Matrix Matrix (CSG a)\n  | Union (CSG a) (CSG a)\n  | Intersect (CSG a) (CSG a)\n  | Difference (CSG a) (CSG a)\n  | Box Box (CSG a)\n  deriving (Show)\n\n-- the data returned for determining surface texture\n-- the Face tells which face of a primitive this is\n-- the Point is the point of intersection in object coordinates\n-- the a is application-specific texture information\ntype Texture a = (Face, Point, a)\n\nunion, intersect, difference            :: CSG a -> CSG a -> CSG a\n\nunion p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Union p q)\nunion p q = Union p q\n\n-- rather pessimistic\nintersect p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Intersect p q)\nintersect p q = Intersect p q\n\ndifference (Box b1 p) q = Box b1 (Difference p q)\n-- no need to box again inside\n-- difference p@(Box b1 _) q = Box b1 (Difference p q)\ndifference p q = Difference p q\n\nmkBox b p = Box b p\n\nplane, sphere, cube, cylinder, cone     :: a -> CSG a\n\nplane = Plane\nsphere s =\n    mkBox (B (-1 - epsilon) (1 + epsilon)\n             (-1 - epsilon) (1 + epsilon)\n             (-1 - epsilon) (1 + epsilon)) (Sphere s)\ncone s =\n    mkBox (B (-1 - epsilon) (1 + epsilon)\n             (   - epsilon) (1 + epsilon)\n             (-1 - epsilon) (1 + epsilon)) (Cone s)\ncube s =\n    mkBox (B (- epsilon) (1 + epsilon)\n             (- epsilon) (1 + epsilon)\n             (- epsilon) (1 + epsilon)) (Cube s)\ncylinder s =\n    mkBox (B (-1 - epsilon) (1 + epsilon)\n             (   - epsilon) (1 + epsilon)\n             (-1 - epsilon) (1 + epsilon)) (Cylinder s)\n\n----------------------------\n-- Object transformations\n----------------------------\n\ntype Transform = (Matrix, Matrix)\n\ntransform :: Transform -> CSG a -> CSG a\n\ntransform (m, m')   (Transform mp mp' p) = Transform  (multMM m mp)       (multMM mp' m') p\ntransform mm'       (Union p q)          = Union      (transform mm' p)   (transform mm' q)\ntransform mm'       (Intersect p q)      = Intersect  (transform mm' p)   (transform mm' q)\ntransform mm'       (Difference p q)     = Difference (transform mm' p)   (transform mm' q)\ntransform mm'@(m,_) (Box box p)          = Box        (transformBox m box) (transform mm' p)\ntransform (m, m')   prim                 = Transform  m m' prim\n\ntranslate                               :: Coords -> CSG a -> CSG a\ntranslateX, translateY, translateZ      :: Double -> CSG a -> CSG a\n\ntranslate xyz = transform $ transM xyz\ntranslateX x = translate (x, 0, 0)\ntranslateY y = translate (0, y, 0)\ntranslateZ z = translate (0, 0, z)\n\nscale                                   :: Coords -> CSG a -> CSG a\nscaleX, scaleY, scaleZ, uscale          :: Double -> CSG a -> CSG a\n\nscale xyz = transform $ scaleM xyz\nscaleX x = scale (x, 1, 1)\nscaleY y = scale (1, y, 1)\nscaleZ z = scale (1, 1, z)\nuscale u = scale (u,u,u)\n\nrotateX, rotateY, rotateZ               :: Radian -> CSG a -> CSG a\n\nrotateX a = transform $ rotxM a\nrotateY a = transform $ rotyM a\nrotateZ a = transform $ rotzM a\n\nunit = matrix\n      ( ( 1.0, 0.0, 0.0, 0.0 ),\n        ( 0.0, 1.0, 0.0, 0.0 ),\n        ( 0.0, 0.0, 1.0, 0.0 ),\n        ( 0.0, 0.0, 0.0, 1.0 ) )\n\ntransM (x, y, z)\n  = ( matrix\n      ( ( 1, 0, 0, x ),\n        ( 0, 1, 0, y ),\n        ( 0, 0, 1, z ),\n        ( 0, 0, 0, 1 ) ),\n      matrix\n      ( ( 1, 0, 0, -x ),\n        ( 0, 1, 0, -y ),\n        ( 0, 0, 1, -z ),\n        ( 0, 0, 0,  1 ) ) )\n\nscaleM (x, y, z)\n  = ( matrix\n      ( (   x',    0,    0, 0 ),\n        (    0,   y',    0, 0 ),\n        (    0,    0,   z', 0 ),\n        (    0,    0,    0, 1 ) ),\n      matrix\n      ( ( 1/x',    0,    0, 0 ),\n        (    0, 1/y',    0, 0 ),\n        (    0,    0, 1/z', 0 ),\n        (    0,    0,    0, 1 ) ) )\n  where x' = nonZero x\n        y' = nonZero y\n        z' = nonZero z\n\nrotxM t\n  = ( matrix\n      ( (      1,      0,      0, 0 ),\n        (      0,  cos t, -sin t, 0 ),\n        (      0,  sin t,  cos t, 0 ),\n        (      0,      0,      0, 1 ) ),\n      matrix\n      ( (      1,      0,      0, 0 ),\n        (      0,  cos t,  sin t, 0 ),\n        (      0, -sin t,  cos t, 0 ),\n        (      0,      0,      0, 1 ) ) )\n\nrotyM t\n  = ( matrix\n      ( (  cos t,      0,  sin t, 0 ),\n        (      0,      1,      0, 0 ),\n        ( -sin t,      0,  cos t, 0 ),\n        (      0,      0,      0, 1 ) ),\n      matrix\n      ( (  cos t,      0, -sin t, 0 ),\n        (      0,      1,      0, 0 ),\n        (  sin t,      0,  cos t, 0 ),\n        (      0,      0,      0, 1 ) ) )\n\nrotzM t\n  = ( matrix\n      ( (  cos t, -sin t,      0, 0 ),\n        (  sin t,  cos t,      0, 0 ),\n        (      0,      0,      1, 0 ),\n        (      0,      0,      0, 1 ) ),\n      matrix\n      ( (  cos t,  sin t,      0, 0 ),\n        ( -sin t,  cos t,      0, 0 ),\n        (      0,      0,      1, 0 ),\n        (      0,      0,      0, 1 ) ) )\n\n-------------------\n-- Eye transformations\n\n-- These are used to specify placement of the eye.\n-- `eye' starts out at (0, 0, -1).\n-- These are implemented as inverse transforms of the model.\n-------------------\n\neye                                     :: Transform\ntranslateEye                            :: Coords -> Transform -> Transform\nrotateEyeX, rotateEyeY, rotateEyeZ      :: Radian -> Transform -> Transform\n\neye = (unit, unit)\ntranslateEye xyz (eye1, eye2)\n  = (multMM m1 eye1, multMM eye2 m2)\n  where (m1, m2) = transM xyz\nrotateEyeX t (eye1, eye2)\n  = (multMM m1 eye1, multMM eye2 m2)\n  where (m1, m2) = rotxM t\nrotateEyeY t (eye1, eye2)\n  = (multMM m1 eye1, multMM eye2 m2)\n  where (m1, m2) = rotyM t\nrotateEyeZ t (eye1, eye2)\n  = (multMM m1 eye1, multMM eye2 m2)\n  where (m1, m2) = rotzM t\n\n-------------------\n-- Bounding boxes\n-------------------\n\nmergeBox (B x11  x12  y11  y12  z11  z12) (B x21  x22  y21  y22  z21  z22) =\n    B (x11 `min` x21) (x12 `max` x22)\n      (y11 `min` y21) (y12 `max` y22)\n      (z11 `min` z21) (z12 `max` z22)\n\ntransformBox t (B x1  x2  y1  y2  z1  z2)\n  = (B (foldr1 min (map xCoord pts'))\n       (foldr1 max (map xCoord pts'))\n       (foldr1 min (map yCoord pts'))\n       (foldr1 max (map yCoord pts'))\n       (foldr1 min (map zCoord pts'))\n       (foldr1 max (map zCoord pts')))\n  where pts' = map (multMP t) pts\n        pts =  [point x1 y1 z1,\n                point x1 y1 z2,\n                point x1 y2 z1,\n                point x1 y2 z2,\n                point x2 y1 z1,\n                point x2 y1 z2,\n                point x2 y2 z1,\n                point x2 y2 z2]\n", "num_lines": 266}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule CSG(module Construct,\n           module Geometry,\n           module Intersections,\n           module Interval,\n           module Misc) where\n\nimport Construct\nimport Geometry\nimport Intersections\nimport Interval\nimport Misc\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Data where\n\nimport Data.Array\n\nimport CSG\nimport Geometry\nimport Illumination\nimport Primitives\nimport Surface\n\nimport Debug.Trace\n\n-- Now the parsed (expression) language\n\ntype Name = String\n\ntype Code = [GMLToken]\n\ndata GMLToken\n    -- All these can occur in parsed code\n        = TOp     GMLOp\n        | TId     Name\n        | TBind   Name\n        | TBool   Bool\n        | TInt    Int\n        | TReal   Double\n        | TString String\n        | TBody   Code\n        | TArray  Code\n        | TApply\n        | TIf\n         -- These can occur in optimized/transformed code\n         -- NONE (yet!)\n\n\ninstance Show GMLToken where\n   showsPrec p (TOp op)     = shows op\n   showsPrec p (TId id)     = showString id\n   showsPrec p (TBind id)   = showString ('/' : id)\n   showsPrec p (TBool bool) = shows bool\n   showsPrec p (TInt i)     = shows i\n   showsPrec p (TReal d)    = shows d\n   showsPrec p (TString s)  = shows s\n   showsPrec p (TBody code) = shows code\n   showsPrec p (TArray code) = showString \"[ \"\n                            . foldr (\\ a b -> a . showChar ' ' . b) id (map shows code)\n                            . showString \"]\"\n   showsPrec p (TApply)     = showString \"apply\"\n   showsPrec p (TIf)        = showString \"if\"\n\n   showList  code = showString \"{ \"\n                  . foldr (\\ a b -> a . showChar ' ' . b) id (map shows code)\n                  . showString \"}\"\n\n\n-- Now the value language, used inside the interpreter\n\ntype Stack = [GMLValue]\n\ndata GMLValue\n        = VBool    !Bool\n        | VInt     !Int\n        | VReal    !Double\n        | VString  String\n        | VClosure Env Code\n        | VArray   (Array Int GMLValue)         -- FIXME: Haskell array\n        -- uses the interpreter version of point\n        | VPoint   { xPoint :: !Double\n                   , yPoint :: !Double\n                   , zPoint :: !Double\n                   }\n        -- these are abstract to the interpreter\n        | VObject  Object\n        | VLight   Light\n        -- This is an abstract object, used by the abstract interpreter\n        | VAbsObj  AbsObj\n\n\n-- There are only *3* basic abstract values,\n-- and the combinators also.\n\ndata AbsObj\n    = AbsFACE\n    | AbsU\n    | AbsV\n      deriving (Show)\n\ninstance Show GMLValue where\n   showsPrec p value = showString (showStkEle value)\n\nshowStkEle :: GMLValue -> String\nshowStkEle (VBool b)      = show b ++ \" :: Bool\"\nshowStkEle (VInt i)       = show i ++ \" :: Int\"\nshowStkEle (VReal r)      = show r ++ \" :: Real\"\nshowStkEle (VString s)    = show s ++ \" :: String\"\nshowStkEle (VClosure {})  = \"<closure> :: Closure\"\nshowStkEle (VArray arr)\n     = \"<array (\" ++  show (succ (snd (bounds arr))) ++ \" elements)> :: Array\"\nshowStkEle (VPoint x y z) = \"(\" ++ show x\n                         ++ \",\" ++ show y\n                         ++ \",\" ++ show z\n                         ++ \") :: Point\"\nshowStkEle (VObject {})   = \"<Object> :: Object\"\nshowStkEle (VLight {})    = \"<Light> :: Object\"\nshowStkEle (VAbsObj vobs) = \"{{ \" ++ show vobs ++ \"}} :: AbsObj\"\n\n-- An abstract environment\n\nnewtype Env = Env [(Name, GMLValue)] deriving Show\n\nemptyEnv :: Env\nemptyEnv = Env []\n\nextendEnv :: Env -> Name -> GMLValue -> Env\nextendEnv (Env e) n v = Env ((n, v):e)\n\nlookupEnv :: Env -> Name -> Maybe GMLValue\nlookupEnv (Env e) n = lookup n e\n\n-- All primitive operators\n--\n-- There is no Op_apply, Op_false, Op_true and Op_if\n-- (because they appear explicitly in the rules).\n\ndata GMLOp\n   = Op_acos\n   | Op_addi\n   | Op_addf\n   | Op_asin\n   | Op_clampf\n   | Op_cone\n   | Op_cos\n   | Op_cube\n   | Op_cylinder\n   | Op_difference\n   | Op_divi\n   | Op_divf\n   | Op_eqi\n   | Op_eqf\n   | Op_floor\n   | Op_frac\n   | Op_get\n   | Op_getx\n   | Op_gety\n   | Op_getz\n   | Op_intersect\n   | Op_length\n   | Op_lessi\n   | Op_lessf\n   | Op_light\n   | Op_modi\n   | Op_muli\n   | Op_mulf\n   | Op_negi\n   | Op_negf\n   | Op_plane\n   | Op_point\n   | Op_pointlight\n   | Op_real\n   | Op_render\n   | Op_rotatex\n   | Op_rotatey\n   | Op_rotatez\n   | Op_scale\n   | Op_sin\n   | Op_sphere\n   | Op_spotlight\n   | Op_sqrt\n   | Op_subi\n   | Op_subf\n   | Op_trace       -- non standard, for debugging GML programs\n   | Op_translate\n   | Op_union\n   | Op_uscale\n    deriving (Eq,Ord,Ix,Bounded)\n\ninstance Show GMLOp where\n   showsPrec _ op = showString (opNameTable ! op)\n\n\n------------------------------------------------------------------------------\n\n-- And how we use the op codes (there names, there interface)\n\n-- These keywords include, \"apply\", \"if\", \"true\" and \"false\",\n-- they are not parsed as operators, but are\n-- captured by the parser as a special case.\n\nkeyWords :: [String]\nkeyWords = [ kwd | (kwd,_,_) <- opcodes ]\n\n-- Lookup has to look from the start (or else...)\nopTable :: [(Name,GMLToken)]\nopTable = [ (kwd,op) | (kwd,op,_) <- opcodes ]\n\nopNameTable :: Array GMLOp Name\nopNameTable = array (minBound,maxBound)\n                  [ (op,name) | (name,TOp op,_) <- opcodes ]\n\nundef = error \"undefined function\"\nimage = error \"undefined function: talk to image group\"\n\n-- typically, its best to have *one* opcode table,\n-- so that mis-alignments do not happen.\n\nopcodes :: [(String,GMLToken,PrimOp)]\nopcodes =\n [ (\"apply\",      TApply,               error \"incorrect use of apply\")\n , (\"if\",         TIf,                  error \"incorrect use of if\")\n , (\"false\",      TBool False,          error \"incorrect use of false\")\n , (\"true\",       TBool True,           error \"incorrect use of true\")\n ] ++ map (\\ (a,b,c) -> (a,TOp b,c))\n   -- These are just invocation, any coercions need to occur between here\n   -- and before arriving at the application code (like deg -> rad).\n [ (\"acos\",       Op_acos,       Real_Real (rad2deg . acos))\n , (\"addi\",       Op_addi,       Int_Int_Int (+))\n , (\"addf\",       Op_addf,       Real_Real_Real (+))\n , (\"asin\",       Op_asin,       Real_Real (rad2deg . asin))\n , (\"clampf\",     Op_clampf,     Real_Real clampf)\n , (\"cone\",       Op_cone,       Surface_Obj cone)\n , (\"cos\",        Op_cos,        Real_Real (cos . deg2rad))\n , (\"cube\",       Op_cube,       Surface_Obj cube)\n , (\"cylinder\",   Op_cylinder,   Surface_Obj cylinder)\n , (\"difference\", Op_difference, Obj_Obj_Obj difference)\n , (\"divi\",       Op_divi,       Int_Int_Int (ourQuot))\n , (\"divf\",       Op_divf,       Real_Real_Real (/))\n , (\"eqi\",        Op_eqi,        Int_Int_Bool (==))\n , (\"eqf\",        Op_eqf,        Real_Real_Bool (==))\n , (\"floor\",      Op_floor,      Real_Int floor)\n , (\"frac\",       Op_frac,       Real_Real (snd . properFraction))\n , (\"get\",        Op_get,        Arr_Int_Value ixGet)\n , (\"getx\",       Op_getx,       Point_Real (\\ x y z -> x))\n , (\"gety\",       Op_gety,       Point_Real (\\ x y z -> y))\n , (\"getz\",       Op_getz,       Point_Real (\\ x y z -> z))\n , (\"intersect\",  Op_intersect,  Obj_Obj_Obj intersect)\n , (\"length\",     Op_length,     Arr_Int (succ . snd . bounds))\n , (\"lessi\",      Op_lessi,      Int_Int_Bool (<))\n , (\"lessf\",      Op_lessf,      Real_Real_Bool (<))\n , (\"light\",      Op_light,      Point_Color_Light light)\n , (\"modi\",       Op_modi,       Int_Int_Int (ourRem))\n , (\"muli\",       Op_muli,       Int_Int_Int (*))\n , (\"mulf\",       Op_mulf,       Real_Real_Real (*))\n , (\"negi\",       Op_negi,       Int_Int negate)\n , (\"negf\",       Op_negf,       Real_Real negate)\n , (\"plane\",      Op_plane,      Surface_Obj plane)\n , (\"point\",      Op_point,      Real_Real_Real_Point VPoint)\n , (\"pointlight\", Op_pointlight, Point_Color_Light pointlight)\n , (\"real\",       Op_real,       Int_Real fromIntegral)\n , (\"render\",     Op_render,     Render $ render eye)\n , (\"rotatex\",    Op_rotatex,    Obj_Real_Obj (\\ o d -> rotateX (deg2rad d) o))\n , (\"rotatey\",    Op_rotatey,    Obj_Real_Obj (\\ o d -> rotateY (deg2rad d) o))\n , (\"rotatez\",    Op_rotatez,    Obj_Real_Obj (\\ o d -> rotateZ (deg2rad d) o))\n , (\"scale\",      Op_scale,      Obj_Real_Real_Real_Obj (\\ o x y z -> scale (x,y,z) o))\n , (\"sin\",        Op_sin,        Real_Real (sin . deg2rad))\n , (\"sphere\",     Op_sphere,     Surface_Obj sphere') -- see comment at end of file\n , (\"spotlight\",  Op_spotlight,  Point_Point_Color_Real_Real_Light mySpotlight)\n , (\"sqrt\",       Op_sqrt,       Real_Real ourSqrt)\n , (\"subi\",       Op_subi,       Int_Int_Int (-))\n , (\"subf\",       Op_subf,       Real_Real_Real (-))\n , (\"trace\",      Op_trace,      Value_String_Value mytrace)\n , (\"translate\",  Op_translate,  Obj_Real_Real_Real_Obj (\\ o x y z -> translate (x,y,z) o))\n , (\"union\",      Op_union,      Obj_Obj_Obj union)\n , (\"uscale\",     Op_uscale,     Obj_Real_Obj (\\ o r -> uscale r o))\n ]\n\n-- This enumerate all possible ways of calling the fixed primitives\n\n-- The datatype captures the type at the *interp* level,\n-- the type of the functional is mirrored on this (using Haskell types).\n\ndata PrimOp\n\n    -- 1 argument\n    = Int_Int         (Int -> Int)\n    | Real_Real       (Double -> Double)\n    | Point_Real      (Double -> Double -> Double -> Double)\n    | Surface_Obj     (SurfaceFn Color Double -> Object)\n    | Real_Int        (Double -> Int)\n    | Int_Real        (Int -> Double)\n    | Arr_Int         (Array Int GMLValue -> Int)\n\n    -- 2 arguments\n    | Int_Int_Int     (Int -> Int -> Int)\n    | Int_Int_Bool    (Int -> Int -> Bool)\n    | Real_Real_Real  (Double -> Double -> Double)\n    | Real_Real_Bool  (Double -> Double -> Bool)\n    | Arr_Int_Value   (Array Int GMLValue -> Int -> GMLValue)\n\n    -- Many arguments, typically image mangling\n\n    | Obj_Obj_Obj            (Object -> Object -> Object)\n    | Point_Color_Light      (Coords -> Color -> Light)\n    | Real_Real_Real_Point   (Double -> Double -> Double -> GMLValue)\n    | Obj_Real_Obj           (Object -> Double -> Object)\n    | Obj_Real_Real_Real_Obj (Object -> Double -> Double -> Double -> Object)\n    | Value_String_Value     (GMLValue -> String -> GMLValue)\n\n    | Point_Point_Color_Real_Real_Light\n                             (Coords -> Coords -> Color -> Radian -> Radian -> Light)\n    -- And finally render\n    | Render                 (Color -> [Light] -> Object -> Int -> Double -> Int -> Int -> String -> IO ())\n\ndata Type\n    = TyBool\n    | TyInt\n    | TyReal\n    | TyString\n    | TyCode\n    | TyArray\n    | TyPoint\n    | TyObject\n    | TyLight\n    | TyAlpha\n    | TyAbsObj\n      deriving (Eq,Ord,Ix,Bounded)\n\ntypeTable =\n  [ ( TyBool,   \"Bool\")\n  , ( TyInt,    \"Int\")\n  , ( TyReal,   \"Real\")\n  , ( TyString, \"String\")\n  , ( TyCode,   \"Code\")\n  , ( TyArray,  \"Array\")\n  , ( TyPoint,  \"Point\")\n  , ( TyObject, \"Object\")\n  , ( TyLight,  \"Light\")\n  , ( TyAlpha,  \"<anything>\")\n  , ( TyAbsObj, \"<abs>\")\n  ]\n\ntypeNames = array (minBound,maxBound) typeTable\n\ninstance Show Type where\n   showsPrec _ op = showString (typeNames ! op)\n\ngetPrimOpType :: PrimOp -> [Type]\ngetPrimOpType (Int_Int         _) = [TyInt]\ngetPrimOpType (Real_Real       _) = [TyReal]\ngetPrimOpType (Point_Real      _) = [TyPoint]\ngetPrimOpType (Surface_Obj     _) = [TyCode]\ngetPrimOpType (Real_Int        _) = [TyReal]\ngetPrimOpType (Int_Real        _) = [TyInt]\ngetPrimOpType (Arr_Int         _) = [TyArray]\ngetPrimOpType (Int_Int_Int     _) = [TyInt,TyInt]\ngetPrimOpType (Int_Int_Bool    _) = [TyInt,TyInt]\ngetPrimOpType (Real_Real_Real  _) = [TyReal,TyReal]\ngetPrimOpType (Real_Real_Bool  _) = [TyReal,TyReal]\ngetPrimOpType (Arr_Int_Value   _) = [TyArray,TyInt]\ngetPrimOpType (Obj_Obj_Obj            _) = [TyObject,TyObject]\ngetPrimOpType (Point_Color_Light      _) = [TyPoint,TyPoint]\ngetPrimOpType (Real_Real_Real_Point   _) = [TyReal,TyReal,TyReal]\ngetPrimOpType (Obj_Real_Obj           _) = [TyObject,TyReal]\ngetPrimOpType (Obj_Real_Real_Real_Obj _) = [TyObject,TyReal,TyReal,TyReal]\ngetPrimOpType (Value_String_Value     _) = [TyAlpha,TyString]\ngetPrimOpType (Point_Point_Color_Real_Real_Light _)\n                                         = [TyPoint,TyPoint,TyPoint,TyReal,TyReal]\ngetPrimOpType (Render                 _) = [TyPoint,\n                                            TyLight,\n                                            TyObject,\n                                            TyInt,\n                                            TyReal,\n                                            TyReal,\n                                            TyReal,\n                                            TyString]\n\n\n-- Some primitives with better error message\n\nmytrace v s = trace (s ++\" : \"++ show v ++ \"\\n\") v\n\n\nixGet :: Array Int GMLValue -> Int -> GMLValue\nixGet arr i\n   | inRange (bounds arr) i = arr ! i\n   | otherwise = error (\"failed access with index value \"\n                     ++ show i\n                     ++ \" (should be between 0 and \"\n                     ++ show (snd (bounds arr)) ++ \")\")\n\nourQuot :: Int -> Int -> Int\nourQuot _ 0 = error \"attempt to use divi to divide by 0\"\nourQuot a b = a `quot` b\n\nourRem :: Int -> Int -> Int\nourRem _ 0 = error \"attempt to use remi to divide by 0\"\nourRem a b = a `rem` b\n\nourSqrt :: Double -> Double\nourSqrt n | n < 0     = error \"attempt to use sqrt on a negative number\"\n          | otherwise = sqrt n\n\n\nmySpotlight p1 p2 col cutoff exp = spotlight p1 p2 col (deg2rad cutoff) exp\n\n-- The problem specification gets the mapping for spheres backwards\n-- (it maps the image from right to left).\n-- We've fixed that in the raytracing library so that it goes from left\n-- to right, but to keep the GML front compatible with the problem\n-- statement, we reverse it here.\n\nsphere' :: SurfaceFn Color Double -> CSG (SurfaceFn Color Double)\nsphere' (SFun f) = sphere (SFun (\\i u v -> f i (1 - u) v))\nsphere' s = sphere s\n", "num_lines": 409}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Eval where\n\nimport Control.Monad\nimport Data.Array\n\nimport Geometry\nimport CSG\nimport Surface\nimport Data\nimport Parse (rayParse, rayParseF)\n\nclass Monad m => MonadEval m where\n  doOp :: PrimOp -> GMLOp -> Stack -> m Stack\n  tick :: m ()\n  err  :: String -> m a\n\n  tick = return ()\n\nnewtype Pure a = Pure a deriving Show\n\ninstance Functor Pure where\n    fmap = liftM\n\ninstance Applicative Pure where\n    pure = Pure\n    (<*>) = ap\n\ninstance Monad Pure where\n    Pure x >>= k = k x\n    return       = pure\n    fail s       = error s\n\ninstance MonadEval Pure where\n  doOp   = doPureOp\n  err  s = error s\n\ninstance MonadEval IO where\n  doOp prim op stk = do { -- putStrLn (\"Calling \" ++ show op\n                          --           ++ \" << \" ++ show stk ++ \" >>\")\n                          doAllOp  prim op stk\n                        }\n  err  s = error s\n\ndata State\n        = State { env   :: Env\n                , stack :: Stack\n                , code  :: Code\n                } deriving Show\n\ncallback :: Env -> Code -> Stack -> Stack\ncallback env code stk\n      = case eval (State { env = env, stack = stk, code = code}) of\n             Pure stk -> stk\n\n{-# SPECIALIZE eval ::  State -> Pure Stack #-}\n{-# SPECIALIZE eval ::  State -> IO Stack #-}\n\neval :: MonadEval m => State -> m Stack\neval st =\n  do { () <- return () -- $ unsafePerformIO (print st)   -- Functional debugger\n     ; if moreCode st then\n       do { tick             -- tick first, so as to catch loops on new eval.\n            ; st' <- step st\n            ; eval st'\n            }\n        else return (stack st)\n     }\n\nmoreCode :: State -> Bool\nmoreCode (State {code = []}) = False\nmoreCode _                   = True\n\n-- Step has a precondition that there *is* code to run\n{-# SPECIALIZE step ::  State -> Pure State #-}\n{-# SPECIALIZE step ::  State -> IO State #-}\nstep :: MonadEval m => State -> m State\n\n-- Rule 1: Pushing BaseValues\nstep st@(State{ stack = stack, code = (TBool b):cs })\n    = return (st { stack = (VBool b):stack,    code = cs })\nstep st@(State{ stack = stack, code = (TInt i):cs })\n    = return (st { stack = (VInt i):stack,     code = cs })\nstep st@(State{ stack = stack, code = (TReal r):cs })\n    = return (st { stack = (VReal r):stack,    code = cs })\nstep st@(State{ stack = stack, code = (TString s):cs })\n    = return (st { stack = (VString s):stack,  code = cs })\n\n-- Rule 2: Name binding\nstep st@(State{ env = env, stack = (v:stack), code = (TBind id):cs }) =\n  return (State { env = extendEnv env id v, stack = stack,  code = cs })\nstep st@(State{ env = env, stack = [], code = (TBind id):cs }) =\n  err \"Attempt to bind the top of an empty stack\"\n\n-- Rule 3: Name lookup\nstep st@(State{ env = env, stack = stack, code = (TId id):cs }) =\n  case (lookupEnv env id) of\n  Just v -> return (st { stack = v:stack,  code = cs })\n  Nothing -> err (\"Cannot find value for identifier: \" ++ id)\n\n-- Rule 4: Closure creation\nstep st@(State{ env = env, stack = stack, code = (TBody body):cs }) =\n  return (st { stack = (VClosure env body):stack, code = cs })\n\n-- Rule 5: Application\nstep st@(State{ env = env, stack = (VClosure env' code'):stack, code = TApply:cs }) =\n  do { stk <- eval (State {env = env', stack = stack, code = code'})\n     ; return (st { stack = stk, code = cs })\n     }\nstep st@(State{ env = env, stack = [], code = TApply:cs }) =\n  err \"Application with an empty stack\"\nstep st@(State{ env = env, stack = _:_, code = TApply:cs }) =\n  err \"Application of a non-closure\"\n\n-- Rule 6: Arrays\nstep st@(State{ env = env, stack = stack, code = TArray code':cs }) =\n  do { stk <- eval (State {env = env, stack = [], code = code'})\n     ; let last = length stk-1\n     ; let arr = array (0,last) (zip [last,last-1..] stk)\n     ; return (st { stack = (VArray arr):stack, code = cs })\n     }\n\n-- Rule 7 & 8: If statement\nstep st@(State{ env = env, stack = (VClosure e2 c2):(VClosure e1 c1):(VBool True):stack, code = TIf:cs }) =\n  do { stk <- eval (State {env = e1, stack = stack, code = c1})\n     ; return (st { stack = stk, code = cs })\n     }\nstep st@(State{ env = env, stack = (VClosure e2 c2):(VClosure e1 c1):(VBool False):stack, code = TIf:cs }) =\n  do { stk <- eval (State {env = e2, stack = stack, code = c2})\n     ; return (st { stack = stk, code = cs })\n     }\nstep st@(State{ env = env, stack = _, code = TIf:cs }) =\n  err \"Incorrect use of if (bad and/or inappropriate values on the stack)\"\n\n-- Rule 9: Operators\nstep st@(State{ env = env, stack = stack, code = (TOp op):cs }) =\n  do { stk <- doOp (opFnTable ! op) op stack\n     ; return (st { stack = stk, code = cs })\n     }\n\n-- Rule Opps\nstep _ = err \"Tripped on sidewalk while stepping.\"\n\n\n--------------------------------------------------------------------------\n-- Operator code\n\nopFnTable :: Array GMLOp PrimOp\nopFnTable = array (minBound,maxBound)\n                  [ (op,prim) | (_,TOp op,prim) <- opcodes ]\n\n\n\n\ndoPureOp :: (MonadEval m) => PrimOp -> GMLOp -> Stack -> m Stack\ndoPureOp _ Op_render _ =\n    err (\"\\nAttempting to call render from inside a purely functional callback.\")\ndoPureOp primOp op stk = doPrimOp primOp op stk -- call the purely functional operators\n\n{-# SPECIALIZE doPrimOp :: PrimOp -> GMLOp -> Stack -> Pure Stack #-}\n{-# SPECIALIZE doPrimOp :: PrimOp -> GMLOp -> Stack -> IO Stack #-}\n{-# SPECIALIZE doPrimOp :: PrimOp -> GMLOp -> Stack -> Abs Stack #-}\n\ndoPrimOp ::  (MonadEval m) => PrimOp -> GMLOp -> Stack -> m Stack\n\n-- 1 argument.\n\ndoPrimOp (Int_Int fn) _ (VInt i1:stk)\n  = return ((VInt (fn i1)) : stk)\ndoPrimOp (Real_Real fn) _ (VReal r1:stk)\n  = return ((VReal (fn r1)) : stk)\ndoPrimOp (Point_Real fn) _ (VPoint x y z:stk)\n  = return ((VReal (fn x y z)) : stk)\n\n-- This is where the callbacks happen from...\ndoPrimOp (Surface_Obj fn) _ (VClosure env code:stk)\n  = case absapply env code [VAbsObj AbsFACE,VAbsObj AbsU,VAbsObj AbsV] of\n      Just [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] ->\n           let\n               res = prop (color c1 c2 c3) r1 r2 r3\n           in\n               return ((VObject (fn (SConst res))) : stk)\n      _ -> return ((VObject (fn (SFun call))) : stk)\n  where\n        -- The most general case\n        call i r1 r2 =\n          case callback env code [VReal r2,VReal r1,VInt i] of\n             [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3]\n                 -> prop (color c1 c2 c3) r1 r2 r3\n             stk -> error (\"callback failed: incorrectly typed return arguments\"\n                         ++ show stk)\n\ndoPrimOp (Real_Int fn) _ (VReal r1:stk)\n  = return ((VInt (fn r1)) : stk)\ndoPrimOp (Int_Real fn) _ (VInt r1:stk)\n  = return ((VReal (fn r1)) : stk)\ndoPrimOp (Arr_Int fn) _ (VArray arr:stk)\n  = return ((VInt (fn arr)) : stk)\n\n-- 2 arguments.\n\ndoPrimOp (Int_Int_Int fn) _ (VInt i2:VInt i1:stk)\n  = return ((VInt (fn i1 i2)) : stk)\ndoPrimOp (Int_Int_Bool fn) _ (VInt i2:VInt i1:stk)\n  = return ((VBool (fn i1 i2)) : stk)\ndoPrimOp (Real_Real_Real fn) _ (VReal r2:VReal r1:stk)\n  = return ((VReal (fn r1 r2)) : stk)\ndoPrimOp (Real_Real_Bool fn) _ (VReal r2:VReal r1:stk)\n  = return ((VBool (fn r1 r2)) : stk)\ndoPrimOp (Arr_Int_Value fn) _ (VInt i:VArray arr:stk)\n  = return ((fn arr i) : stk)\n\n\n    -- Many arguments, typically image mangling\n\ndoPrimOp (Obj_Obj_Obj fn) _ (VObject o2:VObject o1:stk)\n  = return ((VObject (fn o1 o2)) : stk)\ndoPrimOp (Point_Color_Light fn) _ (VPoint r g b:VPoint x y z : stk)\n  = return (VLight (fn (x,y,z) (color r g b)) : stk)\ndoPrimOp (Point_Point_Color_Real_Real_Light fn) _\n         (VReal r2:VReal r1:VPoint r g b:VPoint x2 y2 z2:VPoint x1 y1 z1 : stk)\n  = return (VLight (fn (x1,y1,z1) (x2,y2,z2) (color r g b) r1 r2) : stk)\ndoPrimOp (Real_Real_Real_Point fn) _ (VReal r3:VReal r2:VReal r1:stk)\n  = return ((fn r1 r2 r3) : stk)\ndoPrimOp (Obj_Real_Obj fn) _ (VReal r:VObject o:stk)\n  = return (VObject (fn o r) : stk)\ndoPrimOp (Obj_Real_Real_Real_Obj fn) _ (VReal r3:VReal r2:VReal r1:VObject o:stk)\n  = return (VObject (fn o r1 r2 r3) : stk)\n\n-- This one is our testing harness\ndoPrimOp (Value_String_Value fn) _ (VString s:o:stk)\n  = res `seq` return (res : stk)\n  where\n     res = fn o s\n\ndoPrimOp primOp op args\n  = err (\"\\n\\ntype error when attempting to execute builtin primitive \\\"\" ++\n          show op ++ \"\\\"\\n\\n| \" ++\n          show op ++ \" takes \" ++ show (length types) ++ \" argument\" ++ s\n                   ++ \" with\" ++ the ++ \" type\" ++ s ++ \"\\n|\\n|\" ++\n          \"      \" ++ unwords [ show ty | ty <- types ]  ++ \"\\n|\\n|\" ++\n          \" currently, the relevant argument\" ++ s ++ \" on the stack \" ++\n                  are ++ \"\\n|\\n| \" ++\n          unwords [ \"(\" ++ show arg ++ \")\"\n                  | arg <-  reverse (take (length types) args) ]  ++ \"\\n|\\n| \"\n          ++ \"    (top of stack is on the right hand side)\\n\\n\")\n  where\n      len   = length types\n      s =  (if len /= 1 then \"s\" else \"\")\n      are =  (if len /= 1 then \"are\" else \"is\")\n      the =  (if len /= 1 then \"\" else \" the\")\n      types = getPrimOpType primOp\n\n\n-- Render is somewhat funny, because it can only get called at top level.\n-- All other operations are purely functional.\n\ndoAllOp :: PrimOp -> GMLOp -> Stack -> IO Stack\ndoAllOp (Render render) Op_render\n                           (VString str:VInt ht:VInt wid:VReal fov\n                           :VInt dep:VObject obj:VArray arr\n                           :VPoint r g b : stk)\n  = do { render (color r g b) lights obj dep (fov * (pi / 180.0)) wid ht str\n       ; return stk\n       }\n  where\n      lights = [ light | (VLight light) <- elems arr ]\n\ndoAllOp primOp op stk = doPrimOp primOp op stk -- call the purely functional operators\n\n------------------------------------------------------------------------------\n{-\n - Abstract evaluation.\n -\n - The idea is you check for constant code that\n - (1) does not look at its arguments\n - (2) gives a fixed result\n -\n - We run for 100 steps.\n -\n -}\n\nabsapply :: Env -> Code -> Stack -> Maybe Stack\nabsapply env code stk =\n     case runAbs (eval (State env stk code)) 100 of\n       AbsState stk _ -> Just stk\n       AbsFail m      -> Nothing\n\nnewtype Abs a   = Abs { runAbs :: Int -> AbsState a }\ndata AbsState a = AbsState a !Int\n                | AbsFail String\n\ninstance Functor Abs where\n    fmap = liftM\n\ninstance Applicative Abs where\n    pure x = Abs (\\ n -> AbsState x n)\n    (<*>) = ap\n\ninstance Monad Abs where\n    (Abs fn) >>= k = Abs (\\ s -> case fn s of\n                                   AbsState r s' -> runAbs (k r) s'\n                                   AbsFail m     -> AbsFail m)\n    return       = pure\n    fail s       = Abs (\\ n -> AbsFail s)\n\ninstance MonadEval Abs where\n  doOp = doAbsOp\n  err  = fail\n  tick = Abs (\\ n -> if n <= 0\n                     then AbsFail \"run out of time\"\n                     else AbsState () (n-1))\n\ndoAbsOp :: PrimOp -> GMLOp -> Stack -> Abs Stack\ndoAbsOp _ Op_point (VReal r3:VReal r2:VReal r1:stk)\n               = return ((VPoint r1 r2 r3) : stk)\n -- here, you could have an (AbsPoint :: AbsObj) which you put on the\n -- stack, with any object in the three fields.\ndoAbsOp _ op _ = err (\"operator not understood (\" ++ show op ++ \")\")\n\n------------------------------------------------------------------------------\n-- Driver\n\nmainEval :: Code -> IO ()\nmainEval prog = do { stk <- eval (State emptyEnv [] prog)\n                   ; return ()\n                   }\n{-\n  * Oops, one of the example actually has something\n  * on the stack at the end.\n  * Oh well...\n                   ; if null stk\n                     then return ()\n                     else do { putStrLn done\n                             ; print stk\n                             }\n-}\n\ndone = \"Items still on stack at (successful) termination of program\"\n\n------------------------------------------------------------------------------\n-- testing\n\ntest :: String -> Pure Stack\ntest is = eval (State emptyEnv [] (rayParse is))\n\ntestF :: String -> IO Stack\ntestF is = do prog <- rayParseF is\n              eval (State emptyEnv [] prog)\n\ntestA :: String -> Either String (Stack,Int)\ntestA is = case runAbs (eval (State emptyEnv\n                                    [VAbsObj AbsFACE,VAbsObj AbsU,VAbsObj AbsV]\n                                    (rayParse is))) 100 of\n             AbsState a n -> Right (a,n)\n             AbsFail m -> Left m\n\nabstest1 = \"1.0 0.0 0.0 point /red { /v /u /face red 1.0 0.0 1.0 } apply\"\n\n-- should be [3:: Int]\net1 = test \"1 /x { x } /f 2 /x f apply x addi\"\n\n\n\n\n\n", "num_lines": 371}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Geometry\n    ( Coords\n    , Ray\n    , Point  -- abstract\n    , Vector -- abstract\n    , Matrix -- abstract\n    , Color  -- abstract\n    , Box(..)\n    , Radian\n    , matrix\n    , coord\n    , color\n    , uncolor\n    , xCoord , yCoord , zCoord\n    , xComponent , yComponent , zComponent\n    , point\n    , vector\n    , nearV\n    , point_to_vector\n    , vector_to_point\n    , dot\n    , cross\n    , tangents\n    , addVV\n    , addPV\n    , subVV\n    , negV\n    , subPP\n    , norm\n    , normalize\n    , dist2\n    , sq\n    , distFrom0Sq\n    , distFrom0\n    , multSV\n    , multMM\n    , transposeM\n    , multMV\n    , multMP\n    , multMQ\n    , multMR\n    , white\n    , black\n    , addCC\n    , subCC\n    , sumCC\n    , multCC\n    , multSC\n    , nearC\n    , offsetToPoint\n    , epsilon\n    , inf\n    , nonZero\n    , eqEps\n    , near\n    , clampf\n    ) where\n\ntype Coords = (Double,Double,Double)\n\ntype Ray = (Point,Vector)    -- origin of ray, and unit vector giving direction\n\ndata Point  = P !Double !Double !Double -- implicit extra arg of 1\n    deriving (Show)\ndata Vector = V !Double !Double !Double -- implicit extra arg of 0\n    deriving (Show, Eq)\ndata Matrix = M !Quad   !Quad   !Quad   !Quad\n    deriving (Show)\n\ndata Color  = C !Double !Double !Double\n    deriving (Show, Eq)\n\ndata Box = B !Double !Double !Double !Double !Double !Double\n    deriving (Show)\n\ndata Quad   = Q !Double !Double !Double !Double\n    deriving (Show)\n\ntype Radian = Double\n\ntype Tup4 a = (a,a,a,a)\n\n--{-# INLINE matrix #-}\nmatrix :: Tup4 (Tup4 Double) -> Matrix\nmatrix ((m11, m12, m13, m14),\n          (m21, m22, m23, m24),\n          (m31, m32, m33, m34),\n          (m41, m42, m43, m44))\n  = M (Q m11 m12 m13 m14)\n      (Q m21 m22 m23 m24)\n      (Q m31 m32 m33 m34)\n      (Q m41 m42 m43 m44)\n\ncoord x y z = (x, y, z)\n\ncolor r g b = C r g b\n\nuncolor (C r g b) = (r,g,b)\n\n{-# INLINE xCoord #-}\nxCoord (P x y z) = x\n{-# INLINE yCoord #-}\nyCoord (P x y z) = y\n{-# INLINE zCoord #-}\nzCoord (P x y z) = z\n\n{-# INLINE xComponent #-}\nxComponent (V x y z) = x\n{-# INLINE yComponent #-}\nyComponent (V x y z) = y\n{-# INLINE zComponent #-}\nzComponent (V x y z) = z\n\npoint :: Double -> Double -> Double -> Point\npoint x y z = P x y z\n\nvector :: Double -> Double -> Double -> Vector\nvector x y z = V x y z\n\nnearV :: Vector -> Vector -> Bool\nnearV (V a b c) (V d e f) = a `near` d && b `near` e && c `near` f\n\npoint_to_vector :: Point -> Vector\npoint_to_vector (P x y z) = V x y z\n\nvector_to_point :: Vector -> Point\nvector_to_point (V x y z)  = P x y z\n\n{-# INLINE vector_to_quad #-}\nvector_to_quad :: Vector -> Quad\nvector_to_quad (V x y z) = Q x y z 0\n\n{-# INLINE point_to_quad #-}\npoint_to_quad :: Point -> Quad\npoint_to_quad (P x y z) = Q x y z 1\n\n{-# INLINE quad_to_point #-}\nquad_to_point :: Quad -> Point\nquad_to_point (Q x y z _) = P x y z\n\n{-# INLINE quad_to_vector #-}\nquad_to_vector :: Quad -> Vector\nquad_to_vector (Q x y z _) = V x y z\n\n--{-# INLINE dot #-}\ndot :: Vector -> Vector -> Double\ndot (V x1 y1 z1) (V x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2\n\ncross :: Vector -> Vector -> Vector\ncross (V x1 y1 z1) (V x2 y2 z2)\n  = V (y1 * z2 - z1 * y2) (z1 * x2 - x1 * z2) (x1 * y2 - y1 * x2)\n\n-- assumption: the input vector is a normal\ntangents :: Vector -> (Vector, Vector)\ntangents v@(V x y z)\n  = (v1, v `cross` v1)\n  where v1 | x == 0    = normalize (vector 0 z (-y))\n           | otherwise = normalize (vector (-y) x 0)\n\n{-# INLINE dot4 #-}\ndot4 :: Quad -> Quad -> Double\ndot4 (Q x1 y1 z1 w1) (Q x2 y2 z2 w2) = x1 * x2 + y1 * y2 + z1 * z2 + w1 * w2\n\naddVV :: Vector -> Vector -> Vector\naddVV (V x1 y1 z1) (V x2 y2 z2)\n    = V (x1 + x2) (y1 + y2) (z1 + z2)\n\naddPV :: Point -> Vector -> Point\naddPV (P x1 y1 z1) (V x2 y2 z2)\n    = P (x1 + x2) (y1 + y2) (z1 + z2)\n\nsubVV :: Vector -> Vector -> Vector\nsubVV (V x1 y1 z1) (V x2 y2 z2)\n    = V (x1 - x2) (y1 - y2) (z1 - z2)\n\nnegV :: Vector -> Vector\nnegV (V x1 y1 z1)\n    = V (-x1) (-y1) (-z1)\n\nsubPP :: Point -> Point -> Vector\nsubPP (P x1 y1 z1) (P x2 y2 z2)\n    = V (x1 - x2) (y1 - y2) (z1 - z2)\n\n--{-# INLINE norm #-}\nnorm :: Vector -> Double\nnorm (V x y z) = sqrt (sq x + sq y + sq z)\n\n--{-# INLINE normalize #-}\n-- normalize a vector to a unit vector\nnormalize :: Vector -> Vector\nnormalize v@(V x y z)\n             | norm /= 0 = multSV (1/norm) v\n             | otherwise = error \"normalize empty!\"\n    where norm = sqrt (sq x + sq y + sq z)\n\n-- This does computes the distance *squared*\ndist2 :: Point -> Point -> Double\ndist2 us vs = sq x + sq y + sq z\n    where\n       (V x y z) = subPP us vs\n\n{-# INLINE sq #-}\nsq :: Double -> Double\nsq d = d * d\n\n{-# INLINE distFrom0Sq #-}\ndistFrom0Sq :: Point -> Double  -- Distance of point from origin.\ndistFrom0Sq (P x y z) = sq x + sq y + sq z\n\n{-# INLINE distFrom0 #-}\ndistFrom0 :: Point -> Double  -- Distance of point from origin.\ndistFrom0 p = sqrt (distFrom0Sq p)\n\n--{-# INLINE multSV #-}\nmultSV :: Double -> Vector -> Vector\nmultSV k (V x y z) = V (k*x) (k*y) (k*z)\n\n--{-# INLINE multMM #-}\nmultMM :: Matrix -> Matrix -> Matrix\nmultMM m1@(M q1 q2 q3 q4) m2\n     = M (multMQ m2' q1)\n         (multMQ m2' q2)\n         (multMQ m2' q3)\n         (multMQ m2' q4)\n  where\n     m2' = transposeM m2\n\n{-# INLINE transposeM #-}\ntransposeM :: Matrix -> Matrix\ntransposeM (M (Q e11  e12  e13  e14)\n              (Q e21  e22  e23  e24)\n              (Q e31  e32  e33  e34)\n              (Q e41  e42  e43  e44)) = (M (Q e11  e21  e31  e41)\n                                           (Q e12  e22  e32  e42)\n                                           (Q e13  e23  e33  e43)\n                                           (Q e14  e24  e34  e44))\n\n\n--multMM m1 m2 = [map (dot4 row) (transpose m2) | row <- m1]\n\n--{-# INLINE multMV #-}\nmultMV :: Matrix -> Vector -> Vector\nmultMV m v = quad_to_vector (multMQ m (vector_to_quad v))\n\n--{-# INLINE multMP #-}\nmultMP :: Matrix -> Point -> Point\nmultMP m p = quad_to_point (multMQ m (point_to_quad p))\n\n-- mat vec = map (dot4 vec) mat\n\n{-# INLINE multMQ #-}\nmultMQ :: Matrix -> Quad -> Quad\nmultMQ (M q1 q2 q3 q4) q\n       = Q (dot4 q q1)\n           (dot4 q q2)\n           (dot4 q q3)\n           (dot4 q q4)\n\n{-# INLINE multMR #-}\nmultMR :: Matrix -> Ray -> Ray\nmultMR m (r, v) = (multMP m r, multMV m v)\n\nwhite :: Color\nwhite = C 1 1 1\nblack :: Color\nblack = C 0 0 0\n\naddCC :: Color -> Color -> Color\naddCC (C a b c) (C d e f) = C (a+d) (b+e) (c+f)\n\nsubCC :: Color -> Color -> Color\nsubCC (C a b c) (C d e f) = C (a-d) (b-e) (c-f)\n\nsumCC :: [Color] -> Color\nsumCC = foldr addCC black\n\nmultCC :: Color -> Color -> Color\nmultCC (C a b c) (C d e f) = C (a*d) (b*e) (c*f)\n\nmultSC :: Double -> Color -> Color\nmultSC k       (C a b c) = C (a*k) (b*k) (c*k)\n\nnearC :: Color -> Color -> Bool\nnearC (C a b c) (C d e f) = a `near` d && b `near` e && c `near` f\n\noffsetToPoint :: Ray -> Double -> Point\noffsetToPoint (r,v) i = r `addPV` (i `multSV` v)\n\n--\n\nepsilon, inf :: Double      -- approximate zero and infinity\nepsilon = 1.0e-10\ninf = 1.0e20\n\nnonZero :: Double -> Double         -- Use before a division. It makes definitions\nnonZero x | x > epsilon  = x        -- more complete and I bet the errors that get\n          | x < -epsilon = x        -- introduced will be undetectable if epsilon\n          | otherwise    = epsilon  -- is small enough\n\n\neqEps x y = abs (x-y) < epsilon\nnear = eqEps\n\nclampf :: Double -> Double\nclampf p | p < 0 = 0\n         | p > 1 = 1\n         | True  = p\n", "num_lines": 313}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\n-- Modified to use stdout (for testing)\n\nmodule Illumination\n    ( Object\n    , Light (..)\n    , light, pointlight, spotlight\n    , render\n    ) where\n\nimport Data.Array\nimport Data.Char(chr)\nimport Data.Maybe\n\nimport Geometry\nimport CSG\nimport Surface\nimport Misc\n\ntype Object = CSG (SurfaceFn Color Double)\n\ndata Cxt = Cxt {ambient::Color, lights::[Light], object::Object, depth::Int}\n        deriving Show\n\nrender :: (Matrix,Matrix) -> Color -> [Light] -> Object -> Int ->\n          Radian -> Int -> Int -> String -> IO ()\nrender (m,m') amb ls obj dep fov wid ht file\n  = do { debugging\n       ; putStrLn (showBitmap' wid ht pixels)\n       }\n  where\n    debugging = return ()\n{-\n                do { putStrLn (show cxt)\n                   ; putStrLn (show (width, delta, aspect, left, top))\n                   }\n-}\n    obj' = transform (m',m) obj\n    ls'  = [ transformLight m' l | l <- ls ]\n    pixelA = listArray ((1,1), (ht,wid))\n                       [ illumination cxt (start,pixel i j)\n                       | j <- take ht  [0.5..]\n                       , i <- take wid [0.5..] ]\n    antiA  = pixelA //\n             [ (ix, superSample ix (pixelA ! ix))\n             | j <- [2 .. ht - 1], i <- [2 .. wid - 1]\n             , let ix = (j, i)\n             , contrast ix pixelA ]\n    pixels = [ [ illumination cxt (start,pixel i j) | i<- take wid [0.5..] ]\n             | j <- take ht [0.5..]\n             ]\n    cxt    = Cxt {ambient=amb, lights=ls',  object=obj', depth=dep}\n    start  = point  0 0 (-1)\n    width  = 2 * tan (fov/2)\n    delta  = width / fromIntegral wid\n    aspect = fromIntegral ht / fromIntegral wid\n    left   = - width / 2\n    top    = - left * aspect\n    pixel i j = vector (left + i*delta) (top - j*delta) 1\n\n    superSample (y, x) col = avg $ col:\n      [ illumination cxt (start, pixel (fromIntegral x - 0.5 + xd) (fromIntegral y - 0.5 + yd))\n      | (xd, yd) <- [(-0.333, 0.0), (0.333, 0.0), (0.0, -0.333), (0.0, 0.333)]\n      ]\n\navg cs = divN (fromIntegral (length cs)) (uncolor (sumCC cs))\n  where divN n (r,g,b) = color (r / n) (g / n) (b / n)\n\ncontrast :: (Int, Int) -> Array (Int, Int) Color -> Bool\ncontrast (x, y) arr = any diffMax [ subCC cur (arr ! (x + xd, y + yd))\n                                  | xd <- [-1, 1], yd <- [-1, 1]\n                                  ]\n  where cur = arr ! (x, y)\n        diffMax col = (abs r) > 0.25 || (abs g) >  0.2 || (abs b) > 0.4\n           where\n                 (r,g,b) = uncolor col\n\n\nillumination :: Cxt -> Ray -> Color\nillumination cxt (r,v)\n  | depth cxt <= 0 = black\n  | otherwise     = case castRay (r,v) (object cxt) of\n                      Nothing -> black\n                      Just info -> illum (cxt{depth=(depth cxt)-1}) info v\n\nillum :: Cxt -> (Point,Vector,Properties Color Double) -> Vector -> Color\nillum cxt (pos,normV,(col,kd,ks,n)) v\n  = ambTerm `addCC` difTerm `addCC` spcTerm `addCC` recTerm\n  where\n    visibleLights = unobscured pos (object cxt) (lights cxt) normV\n    d = depth cxt\n    amb = ambient cxt\n    newV = subVV v (multSV (2 * dot normV v) normV)\n\n    ambTerm = multSC kd (multCC amb col)\n    difTerm = multSC kd (sumCC [multSC (dot normV lj) (multCC intensity col)\n               |(loc,intensity) <- visibleLights,\n               let lj = normalize ({- pos `subVV` -} loc)])\n    -- ZZ might want to avoid the phong, when you can...\n    spcTerm = multSC ks (sumCC [multSC ((dot normV hj) ** n ) (multCC intensity col)\n               |(loc,intensity) <- visibleLights,\n               -- ZZ note this is specific to the light at infinity\n               let lj = {- pos `subVV` -} normalize loc,\n               let hj = normalize (lj `subVV` normalize v)])\n    recTerm  = if recCoeff `nearC` black then black else multCC recCoeff recRay\n    recCoeff = multSC ks col\n    recRay   = illumination cxt (pos,newV)\n\nshowBitmapA :: Int -> Int -> Array (Int, Int) Color -> String\nshowBitmapA wid ht arr\n  = header ++ concatMap scaleColor (elems arr)\n  where\n    scaleColor col = [scalePixel r, scalePixel g, scalePixel b]\n           where (r,g,b) = uncolor col\n    header = \"P6\\n#Galois\\n\" ++ show wid ++ \" \" ++ show ht ++ \"\\n255\\n\"\n\nshowBitmap :: Int -> Int ->[[Color]] -> String\nshowBitmap wid ht pss\n-- type of assert  | length pss == ht && all (\\ ps -> length ps == wid) pss\n  = header ++ concat [[scalePixel r,scalePixel g,scalePixel b]\n                      | ps <- pss, (r,g,b) <- map uncolor ps]\n  where\n    header = \"P6\\n#Galois\\n\" ++ show wid ++ \" \" ++ show ht ++ \"\\n255\\n\"\nshowBitmap _ _ _ = error \"incorrect length of bitmap string\"\n\nscalePixel :: Double -> Char\nscalePixel p = chr (floor (clampf p * 255))\n\nshowBitmap' :: Int -> Int ->[[Color]] -> String\nshowBitmap' wid ht pss\n-- type of assert  | length pss == ht && all (\\ ps -> length ps == wid) pss\n  = header\n ++ unlines [ unwords [unwords [scalePixel' r,scalePixel' g,scalePixel' b]\n                      | (r,g,b) <- map uncolor ps]\n            | ps <- pss ]\n  where\n    header = \"P3\\n#Galois\\n\" ++ show wid ++ \" \" ++ show ht ++ \"\\n255\\n\"\nshowBitmap' _ _ _ = error \"incorrect length of bitmap string\"\n\nscalePixel' :: Double -> String\nscalePixel' p = show (floor (clampf p * 255))\n\n-- Lights\n\ndata Light = Light Vector Color\n           | PointLight Point Color\n           | SpotLight Point Point Color Radian Double\n   deriving Show\n\nlight :: Coords -> Color -> Light\nlight (x,y,z) color =\n  Light (normalize (vector (-x) (-y) (-z))) color\npointlight (x,y,z) color =\n  PointLight (point x y z) color\nspotlight (x,y,z) (p,q,r) col cutoff exp =\n  SpotLight (point x y z) (point p q r) col cutoff exp\n\ntransformLight m (Light v c) = Light (multMV m v) c\ntransformLight m (PointLight p c) = PointLight (multMP m p) c\ntransformLight m (SpotLight p q c r d) = SpotLight (multMP m p) (multMP m q) c r d\n\nunobscured :: Point -> Object -> [Light] ->  Vector -> [(Vector,Color)]\nunobscured pos obj lights normV = catMaybes (map (unobscure pos obj normV) lights)\n\nunobscure :: Point -> Object -> Vector ->  Light -> Maybe (Vector,Color)\nunobscure pos obj normV (Light vec color)\n  -- ZZ probably want to make this faster\n  | vec `dot` normV < 0 = Nothing\n  | intersects (pos `addPV` (0.0001 `multSV` vec),vec) obj = Nothing\n  | otherwise               = Just (vec,color)\nunobscure pos obj normV (PointLight pp color)\n  | vec `dot` normV < 0     = Nothing\n  | intersectWithin (pos `addPV` (0.0001 `multSV` (normalize vec)), vec) obj = Nothing\n  | otherwise               = Just (vec,is)\n      where vec = pp `subPP` pos\n            is  = attenuate vec color\nunobscure org obj normV (SpotLight pos at color cutoff exp)\n  | vec `dot` normV < 0                                                 = Nothing\n  | intersectWithin (org `addPV` (0.0001 `multSV` (normalize vec)), vec) obj = Nothing\n  | angle > cutoff                                                      = Nothing\n  | otherwise                                                           = Just (vec, is)\n      where vec   = pos `subPP` org\n            vec'  = pos `subPP` at\n            angle = acos (normalize vec `dot` (normalize vec'))\n\n            asp   = normalize (at `subPP` pos)\n            qsp   = normalize (org `subPP` pos)\n            is    = attenuate vec (((asp `dot` qsp) ** exp) `multSC` color)\n\nattenuate :: Vector -> Color -> Color\nattenuate vec color = (100 / (99 + sq (norm vec))) `multSC` color\n\n--\n\ncastRay ray p\n  = case intersectRayWithObject ray p of\n    (True, _, _)                     -> Nothing -- eye is inside\n    (False, [], _)                   -> Nothing -- eye is inside\n    (False, (0, b, _) : _, _)        -> Nothing -- eye is inside\n    (False, (i, False, _) : _, _)    -> Nothing -- eye is inside\n    (False, (t, b, (s, p0)) : _, _)     ->\n        let (v, prop) = surface s p0 in\n            Just (offsetToPoint ray t, v, prop)\n\nintersects ray p\n  = case intersectRayWithObject ray p of\n    (True, _, _)                  -> False\n    (False, [], _)                -> False\n    (False, (0, b, _) : _, _)     -> False\n    (False, (i, False, _) : _, _) -> False\n    (False, (i, b, _) : _, _)     -> True\n\nintersectWithin :: Ray -> Object -> Bool\nintersectWithin ray p\n  = case intersectRayWithObject ray p of\n    (True, _, _)                  -> False -- eye is inside\n    (False, [], _)                -> False -- eye is inside\n    (False, (0, b, _) : _, _)     -> False -- eye is inside\n    (False, (i, False, _) : _, _) -> False -- eye is inside\n    (False, (t, b, _) : _, _)     -> t < 1.0\n", "num_lines": 225}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Intersections\n    ( intersectRayWithObject,\n      quadratic\n    ) where\n\nimport Data.Maybe(isJust)\n\nimport Construct\nimport Geometry\nimport Interval\nimport Misc\n\n-- This is factored into two bits.  The main function `intersections'\n-- intersects a line with an object.\n-- The wrapper call `intersectRayWithObject' coerces this to an intersection\n-- with a ray by clamping the result to start at 0.\n\nintersectRayWithObject ray p\n  = clampIntervals is\n  where is = intersections ray p\n\nclampIntervals (True, [], True) = (False, [(0, True, undefined)], True)\nclampIntervals empty@(False, [], False) = empty\nclampIntervals (True, is@((i, False, p) : is'), isOpen)\n  | i `near` 0 || i < 0\n  = clampIntervals (False, is', isOpen)\n  | otherwise\n  = (False, (0, True, undefined) : is, isOpen)\nclampIntervals ivals@(False, is@((i, True, p) : is'), isOpen)\n  | i `near` 0 || i < 0\n  -- can unify this with first case...\n  = clampIntervals (True, is', isOpen)\n  | otherwise\n  = ivals\n\nintersections ray (Union p q)\n  = unionIntervals is js\n  where is = intersections ray p\n        js = intersections ray q\n\nintersections ray (Intersect p q)\n  = intersectIntervals is js\n  where is = intersections ray p\n        js = intersections ray q\n\nintersections ray (Difference p q)\n  = differenceIntervals is (negateSurfaces js)\n  where is = intersections ray p\n        js = intersections ray q\n\nintersections ray (Transform m m' p)\n  = mapI (xform m) is\n  where is = intersections (m' `multMR` ray) p\n        xform m (i, b, (s, p0)) = (i, b, (transformSurface m s, p0))\n\nintersections ray (Box box p)\n  | intersectWithBox ray box = intersections ray p\n  | otherwise = emptyIList\n\nintersections ray p@(Plane s)\n  = intersectPlane ray s\n\nintersections ray p@(Sphere s)\n  = intersectSphere ray s\n\nintersections ray p@(Cube s)\n  = intersectCube ray s\n\nintersections ray p@(Cylinder s)\n  = intersectCylinder ray s\n\nintersections ray p@(Cone s)\n  = intersectCone ray s\n\nnegateSurfaces :: IList (Surface, Texture a) -> IList (Surface, Texture a)\nnegateSurfaces = mapI negSurf\n  where negSurf (i, b, (s,t)) = (i, b, (negateSurface s, t))\n\nnegateSurface (Planar p0 v0 v1)\n  = Planar p0 v1 v0\nnegateSurface (Spherical p0 v0 v1)\n  = Spherical p0 v1 v0\nnegateSurface (Cylindrical p0 v0 v1)\n  = Cylindrical p0 v1 v0\nnegateSurface (Conic p0 v0 v1)\n  = Conic p0 v1 v0\n\ntransformSurface m (Planar p0 v0 v1)\n  = Planar p0' v0' v1'\n  where p0' = multMP m p0\n        v0' = multMV m v0\n        v1' = multMV m v1\n\ntransformSurface m (Spherical p0 v0 v1)\n  = Spherical p0' v0' v1'\n  where p0' = multMP m p0\n        v0' = multMV m v0\n        v1' = multMV m v1\n\n-- ditto as above\ntransformSurface m (Cylindrical p0 v0 v1)\n  = Cylindrical p0' v0' v1'\n  where p0' = multMP m p0\n        v0' = multMV m v0\n        v1' = multMV m v1\n\ntransformSurface m (Conic p0 v0 v1)\n  = Conic p0' v0' v1'\n  where p0' = multMP m p0\n        v0' = multMV m v0\n        v1' = multMV m v1\n\n--------------------------------\n-- Plane\n--------------------------------\n\nintersectPlane :: Ray -> a -> IList (Surface, Texture a)\nintersectPlane ray texture = intersectXZPlane PlaneFace ray 0.0 texture\n\nintersectXZPlane :: Face -> Ray -> Double -> a -> IList (Surface, Texture a)\nintersectXZPlane n (r,v) yoffset texture\n  | b `near` 0\n  = -- the ray is parallel to the plane - it's either all in, or all out\n    if y `near` yoffset || y < yoffset then openIList else emptyIList\n\n    -- The line intersects the plane. Find t such that\n    -- (x + at, y + bt, z + ct) intersects the X-Z plane.\n    -- t may be negative (the ray starts within the halfspace),\n    -- but we'll catch that later when we clamp the intervals\n\n  | b < 0       -- the ray is pointing downwards\n  = (False, [mkEntry (t0, (Planar p0 v0 v1, (n, p0, texture)))], True)\n\n  | otherwise   -- the ray is pointing upwards\n  = (True,  [mkExit (t0, (Planar p0 v0 v1, (n, p0, texture)))],  False)\n\n  where t0 = (yoffset-y) / b\n        x0 = x + a * t0\n        z0 = z + c * t0\n        p0 = point x0 0 z0\n        v0 = vector 0 0 1\n        v1 = vector 1 0 0\n\n        x = xCoord r\n        y = yCoord r\n        z = zCoord r\n        a = xComponent v\n        b = yComponent v\n        c = zComponent v\n\n\n--------------------------------\n-- Sphere\n--------------------------------\n\nintersectSphere :: Ray -> a -> IList (Surface, Texture a)\nintersectSphere ray@(r, v) texture\n  = -- Find t such that (x + ta, y + tb, z + tc) intersects the\n    -- unit sphere, that is, such that:\n    --   (x + ta)^2 + (y + tb)^2 + (z + tc)^2 = 1\n    -- This is a quadratic equation in t:\n    --   t^2(a^2 + b^2 + c^2) + 2t(xa + yb + zc) + (x^2 + y^2 + z^2 - 1) = 0\n    let c1 = sq a + sq b + sq c\n        c2 = 2 * (x * a + y * b + z * c)\n        c3 = sq x + sq y + sq z - 1\n    in\n        case quadratic c1 c2 c3 of\n        Nothing -> emptyIList\n        Just (t1, t2) -> entryexit (g t1) (g t2)\n    where x = xCoord r\n          y = yCoord r\n          z = zCoord r\n          a = xComponent v\n          b = yComponent v\n          c = zComponent v\n          g t = (t, (Spherical origin v1 v2, (SphereFace, p0, texture)))\n              where origin = point 0 0 0\n                    x0 = x + t * a\n                    y0 = y + t * b\n                    z0 = z + t * c\n                    p0 = point  x0 y0 z0\n                    v0 = vector x0 y0 z0\n                    (v1, v2) = tangents v0\n\n\n--------------------------------\n-- Cube\n--------------------------------\n\nintersectCube :: Ray -> a -> IList (Surface, Texture a)\nintersectCube ray@(r, v) texture\n  = -- The set of t such that (x + at, y + bt, z + ct) lies within\n    -- the unit cube satisfies:\n    --    0 <= x + at <= 1,  0 <= y + bt <= 1,  0 <= z + ct <= 1\n    -- The minimum and maximum such values of t give us the two\n    -- intersection points.\n    case intersectSlabIval (intersectCubeSlab face2 face3 x a)\n        (intersectSlabIval (intersectCubeSlab face5 face4 y b)\n                           (intersectCubeSlab face0 face1 z c)) of\n    Nothing -> emptyIList\n    Just (t1, t2) -> entryexit (g t1) (g t2)\n  where g ((n, v0, v1), t)\n          = (t, (Planar p0 v0 v1, (n, p0, texture)))\n          where p0 = offsetToPoint ray t\n        face0 = (CubeFront,  vectorY, vectorX)\n        face1 = (CubeBack,   vectorX, vectorY)\n        face2 = (CubeLeft,   vectorZ, vectorY)\n        face3 = (CubeRight,  vectorY, vectorZ)\n        face4 = (CubeTop,    vectorZ, vectorX)\n        face5 = (CubeBottom, vectorX, vectorZ)\n        vectorX = vector 1 0 0\n        vectorY = vector 0 1 0\n        vectorZ = vector 0 0 1\n        x = xCoord r\n        y = yCoord r\n        z = zCoord r\n        a = xComponent v\n        b = yComponent v\n        c = zComponent v\n\nintersectCubeSlab n m w d\n  | d `near` 0 = if (0 <= w) && (w <= 1)\n                 then Just ((n, -inf), (m, inf)) else Nothing\n  | d > 0      = Just ((n,  (-w)/d), (m, (1-w)/d))\n  | otherwise  = Just ((m, (1-w)/d), (n,  (-w)/d))\n\nintersectSlabIval Nothing Nothing  = Nothing\nintersectSlabIval Nothing (Just i) = Nothing\nintersectSlabIval (Just i) Nothing = Nothing\nintersectSlabIval (Just (nu1@(n1, u1), mv1@(m1, v1)))\n                  (Just (nu2@(n2, u2), mv2@(m2, v2)))\n  = checkInterval (nu, mv)\n  where nu = if u1 < u2 then nu2 else nu1\n        mv = if v1 < v2 then mv1 else mv2\n        checkInterval numv@(nu@(_, u), (m, v))\n          -- rounding error may force us to push v out a bit\n          | u `near` v = Just (nu, (m, u + epsilon))\n          | u    <   v = Just numv\n          | otherwise  = Nothing\n\n\n--------------------------------\n-- Cylinder\n--------------------------------\n\nintersectCylinder :: Ray -> a -> IList (Surface, Texture a)\nintersectCylinder ray texture\n  = isectSide `intersectIntervals` isectTop `intersectIntervals` isectBottom\n  where isectSide   = intersectCylSide ray texture\n        isectTop    = intersectXZPlane CylinderTop ray 1.0 texture\n        isectBottom = complementIntervals $ negateSurfaces $\n                      intersectXZPlane CylinderBottom ray 0.0 texture\n\nintersectCylSide (r, v) texture\n  = -- The ray (x + ta, y + tb, z + tc) intersects the sides of the\n    -- cylinder if:\n    --    (x + ta)^2 + (z + tc)^2 = 1  and 0 <= y + tb <= 1.\n    if (sq a + sq c) `near` 0\n    then -- The ray is parallel to the Y-axis, and does not intersect\n         -- the cylinder sides.  It's either all in, or all out\n        if (sqxy `near` 1.0 || sqxy < 1.0) then openIList else emptyIList\n   else -- Find values of t that solve the quadratic equation\n        --   (a^2 + c^2)t^2 + 2(ax + cz)t + x^2 + z^2 - 1 = 0\n        let c1 = sq a + sq c\n            c2 = 2 * (x * a + z * c)\n            c3 = sq x + sq z - 1\n        in\n        case quadratic c1 c2 c3 of\n        Nothing -> emptyIList\n        Just (t1, t2) -> entryexit (g t1) (g t2)\n\n  where sqxy = sq x + sq y\n        g t = (t, (Cylindrical origin v1 v2, (CylinderSide, p0, texture)))\n            where origin = point 0 0 0\n                  x0 = x + t * a\n                  y0 = y + t * b\n                  z0 = z + t * c\n                  p0 = point  x0 y0 z0\n                  v0 = vector x0 0 z0\n                  (v1, v2) = tangents v0\n\n        x = xCoord r\n        y = yCoord r\n        z = zCoord r\n        a = xComponent v\n        b = yComponent v\n        c = zComponent v\n\n\n-------------------\n-- Cone\n-------------------\n\nintersectCone :: Ray -> a -> IList (Surface, Texture a)\nintersectCone ray texture\n  = isectSide `intersectIntervals` isectTop `intersectIntervals` isectBottom\n  where isectSide   = intersectConeSide ray texture\n        isectTop    = intersectXZPlane ConeBase ray 1.0 texture\n        isectBottom = complementIntervals $ negateSurfaces $\n                      intersectXZPlane ConeBase ray 0.0 texture\n\nintersectConeSide (r, v) texture\n  = -- Find the points where the ray intersects the cond side.  At any points of\n    -- intersection, we must have:\n    --    (x + ta)^2 + (z + tc)^2 = (y + tb)^2\n    -- which is the following quadratic equation:\n    --    t^2(a^2-b^2+c^2) + 2t(xa-yb+cz) + (x^2-y^2+z^2) = 0\n    let c1 = sq a - sq b + sq c\n        c2 = 2 * (x * a - y * b + c * z)\n        c3 = sq x - sq y + sq z\n    in  case quadratic c1 c2 c3 of\n        Nothing -> emptyIList\n        Just (t1, t2) ->\n            -- If either intersection strikes the middle, then the other\n            -- can only be off by rounding error, so we make a tangent\n            -- strike using the \"good\" value.\n            -- If the intersections straddle the origin, then it's\n            -- an exit/entry pair, otherwise it's an entry/exit pair.\n            let y1 = y + t1 * b\n                y2 = y + t2 * b\n            in  if y1 `near` 0                  then entryexit (g t1) (g t1)\n                else if y2 `near` 0             then entryexit (g t2) (g t2)\n                else if (y1 < 0) `xor` (y2 < 0) then exitentry (g t1) (g t2)\n                else                                 entryexit (g t1) (g t2)\n\n  where g t = (t, (Conic origin v1 v2, (ConeSide, p0, texture)))\n            where origin = point 0 0 0\n                  x0 = x + t * a\n                  y0 = y + t * b\n                  z0 = z + t * c\n                  p0 = point  x0 y0 z0\n                  v0 = normalize $ vector x0 (-y0) z0\n                  (v1, v2) = tangents v0\n\n        x = xCoord r\n        y = yCoord r\n        z = zCoord r\n        a = xComponent v\n        b = yComponent v\n        c = zComponent v\n\n        -- beyond me why this isn't defined in the prelude...\n        xor False b = b\n        xor True  b = not b\n\n\n-------------------\n-- Solving quadratics\n-------------------\n\nquadratic :: Double -> Double -> Double -> Maybe (Double, Double)\nquadratic a b c =\n  -- Solve the equation ax^2 + bx + c = 0 by using the quadratic formula.\n  let d = sq b - 4 * a * c\n      d' = if d `near` 0 then 0 else d\n  in if d' < 0\n     then Nothing -- There are no real roots.\n     else\n        if a > 0 then Just (((-b) - sqrt d') / (2 * a),\n                            ((-b) + sqrt d') / (2 * a))\n                 else Just (((-b) + sqrt d') / (2 * a),\n                            ((-b) - sqrt d') / (2 * a))\n\n-------------------\n-- Bounding boxes\n-------------------\n\ndata MaybeInterval = Interval !Double !Double\n                   | NoInterval\n\nisInterval (Interval _ _) = True\nisInterval _              = False\n\nintersectWithBox :: Ray -> Box -> Bool\nintersectWithBox (r, v) (B x1 x2 y1 y2 z1 z2)\n  = isInterval interval\n  where x_interval = intersectRayWithSlab (xCoord r) (xComponent v) (x1, x2)\n        y_interval = intersectRayWithSlab (yCoord r) (yComponent v) (y1, y2)\n        z_interval = intersectRayWithSlab (zCoord r) (zComponent v) (z1, z2)\n        interval = intersectInterval x_interval\n                   (intersectInterval y_interval z_interval)\n\nintersectInterval :: MaybeInterval -> MaybeInterval -> MaybeInterval\nintersectInterval NoInterval _ = NoInterval\nintersectInterval _ NoInterval = NoInterval\nintersectInterval (Interval a b) (Interval c d)\n  | b < c || d < a = NoInterval\n  | otherwise = Interval (a `max` c) (b `min` d)\n\n{-# INLINE intersectRayWithSlab #-}\nintersectRayWithSlab :: Double -> Double -> (Double,Double) -> MaybeInterval\nintersectRayWithSlab xCoord alpha (x1, x2)\n  | alpha == 0 = if xCoord < x1 || xCoord > x2 then NoInterval else infInterval\n  | alpha >  0 = Interval a b\n  | otherwise  = Interval b a\n  where a = (x1 - xCoord) / alpha\n        b = (x2 - xCoord) / alpha\n\ninfInterval = Interval (-inf) inf\n", "num_lines": 405}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Interval\n    ( IList\n    , Intersection\n    , emptyIList, openIList\n    , mkEntry, mkExit\n    , entryexit, exitentry\n    , mapI\n    , unionIntervals, intersectIntervals, differenceIntervals\n    , complementIntervals\n    ) where\n\nimport Geometry\n\n-- The result of a ray trace is represented as a list of surface\n-- intersections.  Each intersection is a point along the ray with\n-- a flag indicating whether this intersection is an entry or an\n-- exit from the solid.  Each intersection also carries unspecified\n-- surface data for use by the illumination model.\n\n-- Just the list of intersections isn't enough, however.  An empty\n-- list can denote either a trace that is always within the solid\n-- or never in the solid.  To dissambiguate, an extra flag is kept\n-- that indicates whether we are starting inside or outside of the\n-- solid.  As a convenience, we also keep an additional flag that\n-- indicates whether the last intersection ends inside or outside.\n\ntype IList a            = (Bool, [Intersection a], Bool)\ntype Intersection a     = (Double, Bool, a)\n\nemptyIList = (False, [], False)\nopenIList = (True, [], True)\n\nmapI f (b1, is, b2) = (b1, map f is, b2)\n\nisEntry (_, entry, _) = entry\nisExit  (_, entry, _) = not entry\n\nmkEntry (t, a) = (t, True,  a)\nmkExit  (t, a) = (t, False, a)\n\nentryexit w1 w2 = (False, [mkEntry w1, mkExit w2], False)\nexitentry w1 w2 = (True, [mkExit w1, mkEntry w2], True)\narrange   w1@(t1, _) w2@(t2, _) | t1 < t2   = entryexit w1 w2\n                                | otherwise = entryexit w2 w1\n\n\ncmpI :: Intersection a -> Intersection a -> Ordering\ncmpI (i, _, _) (j, _, _)\n  | i `near` j = EQ\n  | i   <    j = LT\n  | otherwise  = GT\n\nbad (b1, [], b2) = b1 /= b2\nbad (b1, is, b2) = bad' b1 is || b2 /= b3\n  where (_, b3, _) = last is\n\nbad' b [] = False\nbad' b ((_, c, _) : is) = b == c || bad' c is\n\nunionIntervals :: IList a -> IList a -> IList a\nunionIntervals (isStartOpen, is, isEndOpen) (jsStartOpen, js, jsEndOpen)\n  = (isStartOpen || jsStartOpen, uniIntervals is js, isEndOpen || jsEndOpen)\n  where uniIntervals is [] | jsEndOpen = []\n                           | otherwise = is\n        uniIntervals [] js | isEndOpen = []\n                           | otherwise = js\n        uniIntervals is@(i : is') js@(j : js')\n          = case cmpI i j of\n            EQ -> if isEntry i == isEntry j then i : uniIntervals is' js'\n                                            else uniIntervals is' js'\n            LT -> if isEntry j then i : uniIntervals is' js\n                               else     uniIntervals is' js\n            GT -> if isEntry i then j : uniIntervals is js'\n                               else     uniIntervals is js'\n\nintersectIntervals :: IList a -> IList a -> IList a\nintersectIntervals is js\n  = complementIntervals (unionIntervals is' js')\n  where is' = complementIntervals is\n        js' = complementIntervals js\n\ndifferenceIntervals :: IList a -> IList a -> IList a\ndifferenceIntervals is js\n  = complementIntervals (unionIntervals is' js)\n  where is' = complementIntervals is\n\ncomplementIntervals :: IList a -> IList a\ncomplementIntervals (o1, is, o2)\n  = (not o1, [ (i, not isentry, a) | (i, isentry, a) <- is ], not o2)\n\n-- tests...\n\n{-\nmkIn, mkOut :: Double -> Intersection a\nmkIn x = (x, True, undefined)\nmkOut x = (x, False, undefined)\n\ni1 =  (False, [ mkIn 2, mkOut 7 ], False)\ni1' = (True, [ mkOut 2, mkIn 7 ], True)\ni2 =  (False, [ mkIn 1, mkOut 3, mkIn 4, mkOut 5, mkIn 6, mkOut 8 ], False)\n\nt1 = unionIntervals i1 i2\nt2 = intersectIntervals i1 i2\nt3 = intersectIntervals i2 i1\nt4 = complementIntervals i1\nt5 = intersectIntervals i2 i1'\nt6 = differenceIntervals i2 i1\nt7 = differenceIntervals i2 i2\n\nsh (o1,is,o2) =\n    do  if o1 then putStr \"...\" else return ()\n        putStr $ foldr1 (++) (map si is)\n        if o2 then putStr \"...\" else return ()\nsi (i, True, _, _) = \"<\" ++ show i\nsi (i, False, _, _) = \" \" ++ show i ++ \">\"\n-}\n", "num_lines": 122}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\n-- Modified to read sample input directly from a file.\n\nmodule Main where\n\nimport Parse\nimport Eval\n\nmain = do { str <- readFile \"galois.gml\"\n          ; mainEval (rayParse str)\n          }\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Misc where\n\nimport Debug.Trace\n\ndebug s v = trace (s ++\" : \"++ show v ++ \"\\n\") v\n-- debug s v = v\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Parse where\n\nimport Data.Char\nimport Text.ParserCombinators.Parsec hiding (token)\n\nimport Data\n\n\nprogram :: Parser Code\nprogram =\n  do { whiteSpace\n     ; ts <- tokenList\n     ; eof\n     ; return ts\n     }\n\ntokenList :: Parser Code\ntokenList = many token <?> \"list of tokens\"\n\ntoken :: Parser GMLToken\ntoken =\n       do { ts <- braces   tokenList          ; return (TBody ts) }\n  <|>  do { ts <- brackets tokenList          ; return (TArray ts) }\n  <|> (do { s  <- gmlString                   ; return (TString s) } <?> \"string\")\n  <|> (do { t <- pident False                 ; return t }           <?> \"identifier\")\n  <|> (do { char '/'   -- No whitespace after slash\n          ; t <- pident True                  ; return t } <?> \"binding identifier\")\n  <|> (do { n <- number                       ; return n } <?> \"number\")\n\npident :: Bool -> Parser GMLToken\npident rebind =\n  do { id <- ident\n     ; case (lookup id opTable) of\n       Nothing -> if rebind then return (TBind id) else return (TId id)\n       Just t  -> if rebind then error (\"Attempted rebinding of identifier \" ++ id) else return t\n     }\n\nident :: Parser String\nident = lexeme $\n  do { l <- letter\n     ; ls <- many (satisfy (\\x -> isAlphaNum x || x == '-' || x == '_'))\n     ; return (l:ls)\n     }\n\ngmlString :: Parser String\ngmlString = lexeme $ between (char '\"') (char '\"') (many (satisfy (\\x -> isPrint x && x /= '\"')))\n\n-- Tests for numbers\n-- Hugs breaks on big exponents (> ~40)\ntest_number = \"1234 -1234 1 -0 0\" ++\n              \" 1234.5678 -1234.5678 1234.5678e12 1234.5678e-12 -1234.5678e-12\" ++\n              \" -1234.5678e12 -1234.5678E-12 -1234.5678E12\" ++\n              \" 1234e11 1234E33 -1234e33 1234e-33\" ++\n              \" 123e 123.4e 123ee 123.4ee 123E 123.4E 123EE 123.4EE\"\n\n\n-- Always int or real\nnumber :: Parser GMLToken\nnumber = lexeme $\n  do { s <- optSign\n     ; n <- decimal\n     ;     do { string \".\"\n              ; m <- decimal\n              ; e <- option \"\" exponent'\n              ; return (TReal (read (s ++ n ++ \".\" ++ m ++ e)))  -- FIXME: Handle error conditions\n              }\n       <|> do { e <- exponent'\n              ; return (TReal (read (s ++ n ++ \".0\" ++ e)))\n              }\n       <|> do { return (TInt (read (s ++ n))) }\n     }\n\nexponent' :: Parser String\nexponent' = try $\n  do { e <- oneOf \"eE\"\n     ; s <- optSign\n     ; n <- decimal\n     ; return (e:s ++ n)\n     }\n\ndecimal = many1 digit\n\noptSign :: Parser String\noptSign = option \"\" (string \"-\")\n\n\n------------------------------------------------------\n-- Library for tokenizing.\n\nbraces   p = between (symbol \"{\") (symbol \"}\") p\nbrackets p = between (symbol \"[\") (symbol \"]\") p\n\nsymbol name = lexeme (string name)\n\nlexeme p = do{ x <- p; whiteSpace; return x  }\n\nwhiteSpace  = skipMany (simpleSpace <|> oneLineComment <?> \"\")\n  where simpleSpace = skipMany1 (oneOf \" \\t\\n\\r\\v\")\n        oneLineComment =\n            do{ string \"%\"\n              ; skipMany (noneOf \"\\n\\r\\v\")\n              ; return ()\n              }\n\n\n------------------------------------------------------------------------------\n\nrayParse :: String -> Code\nrayParse is = case (parse program \"<stdin>\" is) of\n              Left err -> error (show err)\n              Right x  -> x\n\nrayParseF :: String -> IO Code\nrayParseF file =\n  do { r <- parseFromFile program file\n     ; case r of\n       Left err -> error (show err)\n       Right x  -> return x\n     }\n\nrun :: String -> IO ()\nrun is = case (parse program \"\" is) of\n         Left err -> print err\n         Right x  -> print x\n\nrunF :: IO ()\nrunF =\n  do { r <- parseFromFile program \"simple.gml\"\n     ; case r of\n       Left err -> print err\n       Right x  -> print x\n     }\n", "num_lines": 138}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Pixmap where\n\nimport Data.Char\nimport System.IO hiding (try)\nimport Text.ParserCombinators.Parsec\n\nreadPPM f\n  = do  h <- openFile f ReadMode\n        s <- hGetContents h\n        case (parse parsePPM f s) of\n          Left err -> error (show err)\n          Right x  -> return x\n\nwritePPM f ppm\n  = do  h <- openFile f WriteMode\n        let s = showPPM (length (head ppm)) (length ppm) ppm\n        hPutStr h s\n\n-- parsing\n\nparsePPM\n  = do  string \"P6\"\n        whiteSpace\n        width <- number\n        whiteSpace\n        height <- number\n        whiteSpace\n        colormax <- number\n        whiteSpace\n        cs <- getInput\n        return (chop width (chopColors cs))\n\nchopColors [] = []\nchopColors (a:b:c:ds) = (ord a, ord b, ord c) : chopColors ds\n\nchop n [] = []\nchop n xs = h : chop n t\n    where (h, t) = splitAt n xs\n\nnumber\n  = do  ds <- many1 digit\n        return (read ds :: Int)\n\nwhiteSpace\n  = skipMany (simpleSpace <|> oneLineComment <?> \"\")\n    where simpleSpace = skipMany1 (oneOf \" \\t\\n\\r\\v\")\n          oneLineComment =\n              do  char '#'\n                  skipMany (noneOf \"\\n\\r\\v\")\n                  return ()\n\n-- printing\n\nshowPPM :: Int -> Int -> [[(Int,Int,Int)]] -> String\nshowPPM wid ht pss\n  = header ++ concat [[chr r, chr g, chr b] | ps <- pss, (r, g, b) <-ps]\n  where\n    header = \"P6\\n#Galois\\n\" ++ show wid ++ \" \" ++ show ht ++ \"\\n255\\n\"\nshowPPM _ _ _ = error \"incorrect length of bitmap string\"\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Primitives where\n\nrad2deg :: Double -> Double\nrad2deg r = r * 180 / pi\n\ndeg2rad :: Double -> Double\ndeg2rad d = d * pi / 180\n\naddi :: Int -> Int -> Int\naddi = (+)\n\naddf :: Double -> Double -> Double\naddf = (+)\n\nacosD :: Double -> Double\nacosD x = acos x * 180 / pi\n\nasinD :: Double -> Double\nasinD x = asin x * 180 / pi\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule RayTrace(module Illumination, module Surface) where\n\nimport Illumination\nimport Surface\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2000 Galois Connections, Inc.\n-- All rights reserved.  This software is distributed as\n-- free software under the license in the file \"LICENSE\",\n-- which is included in the distribution.\n\nmodule Surface\n    ( SurfaceFn (..)\n    , Properties\n    , sfun, sconst\n    , prop\n    , matte, shiny\n    , chgColor\n    , surface\n    ) where\n\nimport Geometry\nimport CSG\nimport Misc\n\n-- the surface gets passed face then u then v.\ndata SurfaceFn c v = SFun (Int -> Double -> Double -> Properties c v)\n                   | SConst (Properties c v)\n\nsfun :: (Int -> Double -> Double -> Properties c v) -> SurfaceFn c v\nsfun = SFun\nsconst :: Properties c v -> SurfaceFn c v\nsconst = SConst\n\ntype Properties c v = (c, v, v, v)\n\nprop c d s p = (c, d, s, p)\n\nmatte = (white, 1.0, 0.0, 1.0)\nshiny = (white, 0.0, 1.0, 1.0)\n\nchgColor :: c -> Properties d v -> Properties c v\nchgColor c (_, d, s, p) = (c, d, s, p)\n\ninstance (Show c, Show v) => Show (SurfaceFn c v) where\n  show (SFun _)   = \"Surface function\"\n  -- show (SConst p) = \"Surface constant: \" ++ show p\n  show (SConst p) = \"Surface constant\"\n\nevalSurface :: SurfaceFn Color Double -> Int -> Double -> Double -> Properties Color Double\nevalSurface (SConst p) = \\_ _ _ -> p\nevalSurface (SFun f)   = f\n\n-- calculate surface properties, given the type of\n-- surface, and intersection point in object coordinates\n\n-- surface :: Surface SurfaceFn -> (Int, Point) -> (Vector, Properties)\n\nsurface (Planar _ v0 v1) (n, p0, fn)\n  = (norm, evalSurface fn n' u v)\n  where norm = normalize $ cross v0 v1\n        (n', u, v) = planarUV n p0\n\nsurface (Spherical _ v0 v1) (_, p0, fn)\n  = (norm, evalSurface fn 0 u v)\n  where x = xCoord p0\n        y = yCoord p0\n        z = zCoord p0\n        k = sqrt (1 - sq y)\n        theta = adjustRadian (atan2 (x / k) (z / k))\n        -- correct so that the image grows left-to-right\n        -- instead of right-to-left\n        u = 1.0 - clampf (theta / (2 * pi))\n        v =       clampf ((y + 1) / 2)\n        norm = normalize $ cross v0 v1\n\n-- ZZ ignore the (incorrect) surface model, and estimate the normal\n-- from the intersection in object space\nsurface (Cylindrical _ v0 v1) (_, p0, fn)\n  = (norm, evalSurface fn 0 u v)\n  where x = xCoord p0\n        y = yCoord p0\n        z = zCoord p0\n        u = clampf $ adjustRadian (atan2 x z) / (2 * pi)\n        v = y\n        norm = normalize $ cross v0 v1\n\n-- ZZ ignore the (incorrect) surface model, and estimate the normal\n-- from the intersection in object space\nsurface (Conic _ v0 v1) (_, p0, fn)\n  = (norm, evalSurface fn 0 u v)\n  where x = xCoord p0\n        y = yCoord p0\n        z = zCoord p0\n        u = clampf $ adjustRadian (atan2 (x / y) (z / y)) / (2 * pi)\n        v = y\n        norm = normalize $ cross v0 v1\n\nplanarUV face p0\n  = case face of\n    PlaneFace      -> (0, x, z)\n\n    CubeFront      -> (0, x, y)\n    CubeBack       -> (1, x, y)\n    CubeLeft       -> (2, z, y)\n    CubeRight      -> (3, z, y)\n    CubeTop        -> (4, x, z)\n    CubeBottom     -> (5, x, z)\n\n    CylinderTop    -> (1, (x + 1) / 2, (z + 1) / 2)\n    CylinderBottom -> (2, (x + 1) / 2, (z + 1) / 2)\n\n    ConeBase       -> (1, (x + 1) / 2, (z + 1) / 2)\n  where x = xCoord p0\n        y = yCoord p0\n        z = zCoord p0\n\n-- misc\n\nadjustRadian :: Radian -> Radian\nadjustRadian r = if r > 0 then r else r + 2 * pi\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule A where\n\nimport C\n-- THIS FIXES IT:\n-- import B\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule B where\n\nimport C\nimport {-# SOURCE #-} A\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule C where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport B\n-- REMOVING THIS OR MOVING THIS OVER \"import B\" FIXES IT:\nimport C\n\nmain = return ()", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "d=25637784375346753+0158409406114519728029864689069987389733-25637784375346753\n\ncox(n)=foldr   (\\x(y)->128*      y+x)0(n)\nde(n)=un(\\x->  (x`mod`128,x    `div`128),(                  ==0))n\ncoll=    un(\\  zs->(          take(   35)zs,          drop(35)zs),(==\"\"))\npe(n,m)x=s(p(  n`div`2,m)x)  `mod`m   --2323         -- john launchbury --\np(n,m)x=if(    n==0)then(1)  else(if(even(n))    then(pe(n,m)x)else(po(n,m)x))\npo(n,  m)x=           (x*p(  n-1,m)   x)`mod`                 m\nun(f,   p)n=   if(p(n))then  []else   (let(a,       b)=f(n)in(a:un(f,p)b))\n(g,s)    =(\\x  ->x,\\x->x*x)  --v(f)   t*g+172\n\ne=4998372704153806867349631861645896723396264061670520817438963311707989737197\nn=6133011105483442903214719346445720362447680717496623906453276570566830154479\n\na=g\n  (concat.map(map(chr.fromIntegral).de.p(d,n).read).lines)\nmain=interact\n  (unlines.map(show.p(e,n).cox.map(fromIntegral.ord)).coll)\nb=g\n--p::(Integer,Integer)->Integer->Integer\ndefault (Integer)\n-- 1.3\nord = (fromEnum :: Char -> Int)\nchr = (toEnum   :: Int  -> Char)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Data_Lazy where\n\nimport LrcPrelude\n\n--\n--      Abstract Syntax\n--\n--\ndata P\n        = C_RootProd_1 !Defs\n        deriving (Show , Eq , Ord)\n\ndata Defs\n        = C_Defs2_1 !Def !Defs\n        | C_NoDefs_1\n        deriving (Show , Eq , Ord)\n\ndata Def\n        = C_Arraydecl_1 !Type !Name !INT\n        | C_Declfunc_1 !Type !Name !FormPars !Stats\n        | C_Declfunc_header_1 !Type !Name !FormPars !Stats\n        | C_Declfunc_header_novar_1 !Type !Name !FormPars !Stats\n        | C_Vardecl_1 !Type !Name\n        deriving (Show , Eq , Ord)\n\ndata Type\n        = C_Booltype_1\n        | C_Chartype_1\n        | C_Errortype_1\n        | C_Inttype_1\n        | C_Realtype_1\n        deriving (Show , Eq , Ord)\n\ndata Name\n        = C_Ident_1 !STR\n        deriving (Show , Eq , Ord)\n\ndata FormPars\n        = C_Emptyformpars_1\n        | C_Lstformpars_1 !FormPar !FormPars\n        deriving (Show , Eq , Ord)\n\ndata FormPar\n        = C_Declformpar_1 !Type !Name\n        deriving (Show , Eq , Ord)\n\ndata Stats\n        = C_Emptystat_1\n        | C_Lststats_1 !Stat !Stats\n        deriving (Show , Eq , Ord)\n\ndata Stat\n        = C_ArrAssign_1 !ArrayUse !Exp\n        | C_Assign_1 !Name !Exp\n        | C_Funccall_1 !Name !ActPars\n        | C_If_t_e_1 !Exp !Stats !Stats\n        | C_Input_1 !Name\n        | C_LocalDecl_1 !Type !Name\n        | C_Print_1 !Exp\n        | C_While_1 !Exp !Stats\n        deriving (Show , Eq , Ord)\n\ndata ArrayUse\n        = C_ArrayInd_1 !Name !Exp\n        deriving (Show , Eq , Ord)\n\ndata Exp\n        = C_AddExp_1 !Exp !Exp\n        | C_AndExp_1 !Exp !Exp\n        | C_DivExp_1 !Exp !Exp\n        | C_EqExp_1 !Exp !Exp\n        | C_Factor_1 !Fac\n        | C_GTExp_1 !Exp !Exp\n        | C_LTExp_1 !Exp !Exp\n        | C_MinExp_1 !Exp\n        | C_MulExp_1 !Exp !Exp\n        | C_NotExp_1 !Exp\n        | C_OrExp_1 !Exp !Exp\n        | C_SubExp_1 !Exp !Exp\n        deriving (Show , Eq , Ord)\n\ndata Fac\n        = C_ArrayConst_1 !ArrayUse\n        | C_BoolConst_1 !BOOL\n        | C_CNIdent_1 !Name\n        | C_Expr_1 !Exp\n        | C_Funcinv_1 !Name !ActPars\n        | C_IntConst_1 !INT\n        | C_RealConst_1 !REAL\n        deriving (Show , Eq , Ord)\n\ndata ActPars\n        = C_Emptyactpars_1\n        | C_Lstactpars_1 !Exp !ActPars\n        deriving (Show , Eq , Ord)\n\ndata PPRoot\n        = C_All_1 !PPS\n        | C_Best_1 !PPS\n        deriving (Show , Eq , Ord)\n\ndata PPS\n        = C_Above_1 !PPS !PPS\n        | C_Apply_1 !PPC !PPSArgs\n        | C_Beside_1 !PPS !PPS\n        | C_Dup_1 !PPS !PPS\n        | C_Empty_1\n        | C_FillBlock_1 !INT !FillList\n        | C_Filla_1 !FillList\n        | C_Indent_1 !INT !PPS\n        | C_Join_1 !PPS\n        | C_Text_1 !STR\n        deriving (Show , Eq , Ord)\n\ndata PPC\n        = C_AboveC_1 !PPC !PPC\n        | C_ApplyC_1 !PPC !PPCArgs\n        | C_BesideC_1 !PPC !PPC\n        | C_DupC_1 !PPC !PPC\n        | C_IndentC_1 !INT !PPC\n        | C_JoinC_1 !PPC\n        | C_ParC_1\n        deriving (Show , Eq , Ord)\n\ndata PPCArgs\n        = C_ConsPPCArgs_1 !PPC !PPCArgs\n        | C_NilPPCArgs_1\n        deriving (Show , Eq , Ord)\n\ndata PPSArgs\n        = C_ConsArgs_1 !PPS !PPSArgs\n        | C_NilArgs_1\n        deriving (Show , Eq , Ord)\n\ndata FillList\n        = C_ConsFillList_1 !PPS !FillList\n        | C_NilFillList_1\n        deriving (Show , Eq , Ord)\n\n\n--\n--      Type of Attributes\n--\n--\ntype Code = [Instr]\n\ntype CodeParams = [Code]\n\ndata Disp\n        = C_Displ_1 !PPS\n        deriving (Show , Eq , Ord)\n\ndata ENTRY\n        = C_Consarray_1 !Type !INT !INT\n        | C_Consfunc_1 !Type !INT !LSTPARAM\n        | C_Consvar_1 !Type !INT\n        | C_EmptyEntry_1\n        deriving (Show , Eq , Ord)\n\ntype ERROR = [OneError]\n\ndata Format\n        = C_Elem_1 !INT !INT !INT !Lst_Str\n        deriving (Show , Eq , Ord)\n\ntype Formats = [Format]\n\ndata Instr\n        = C_ALabel_1 !Name\n        | C_Add_1\n        | C_And_1\n        | C_Call_1 !Name\n        | C_Cod_1\n        | C_Data_1\n        | C_Div_1\n        | C_Eq_1\n        | C_Gt_1\n        | C_Halt_1\n        | C_IIn_1\n        | C_IOut_1\n        | C_Jump_1 !Name\n        | C_Jumpf_1 !Name\n        | C_Load_1\n        | C_Lt_1\n        | C_Minus_1\n        | C_Mul_1\n        | C_Neq_1\n        | C_Not_1\n        | C_Or_1\n        | C_Pusha_1 !Name !INT\n        | C_Pushb_1 !BOOL\n        | C_Pushi_1 !INT\n        | C_Pushr_1 !REAL\n        | C_Ret_1\n        | C_Store_1\n        | C_Sub_1\n        | C_Var_1 !Name !INT !Type\n        deriving (Show , Eq , Ord)\n\ntype LSTPARAM = [OneParam]\n\ntype Lst_Str = [STR]\n\ndata OneError\n        = C_E_FormParam_AD_1 !Name\n        | C_E_Fun_ND_1 !Name\n        | C_E_Loc_Name_AD_1 !Name\n        | C_E_Name_AD_1 !Name\n        | C_E_Name_ND_1 !Name\n        deriving (Show , Eq , Ord)\n\ndata OneParam\n        = C_AParam_1 !Type !Name\n        deriving (Show , Eq , Ord)\n\ndata OneTypeError\n        = C_E_T_ActParam_1\n        | C_E_T_BOP_1\n        | C_E_T_DT_1 !Name\n        | C_E_T_IndArrNotInt_1\n        | C_E_T_NC_1 !Type !Type\n        | C_E_T_NotArithExp_1\n        | C_E_T_NotBooleanExp_1\n        | C_E_T_if_t_e_1\n        | C_E_T_while_1\n        | C_NoTypeError_1\n        deriving (Show , Eq , Ord)\n\ndata Pair_Formats\n        = C_C_Pair_Formats_1 !Formats !BOOL\n        deriving (Show , Eq , Ord)\n\ndata Pair_Lst_T_Errs\n        = C_CPair_Lst_T_Errs_1 !T_Errs !T_Errs\n        deriving (Show , Eq , Ord)\n\ndata Pair_Lst_T_Fmts\n        = C_CPair_Lst_T_Fmts_1 !T_Fmts !T_Fmts\n        deriving (Show , Eq , Ord)\n\ndata Pair_Lst_T_Mins\n        = C_CPair_Lst_T_Mins_1 !T_Mins !T_Mins\n        deriving (Show , Eq , Ord)\n\ndata Pair_T_Formats\n        = C_C_Pair_T_Formats_1 !T_Formats !BOOL\n        deriving (Show , Eq , Ord)\n\ndata Sizes\n        = C_Triple_1 !INT !INT !INT\n        deriving (Show , Eq , Ord)\n\ntype TYPES = [Type]\n\ntype T_Errs = [BOOL]\n\ntype T_Fmts = [T_Formats]\n\ndata T_Formats\n        = C_AFormat_1 !Formats\n        | C_TFormats_1 !Formats !Formats !BOOL !BOOL\n        deriving (Show , Eq , Ord)\n\ndata T_Frame\n        = C_F_1 !INT !INT\n        deriving (Show , Eq , Ord)\n\ntype T_Mins = [Sizes]\n\ntype T_Reqs = [T_Frame]\n\ntype TypeError = [OneTypeError]\n\n", "num_lines": 274}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Lexer for MicroC\n--\n-- Jo\u00e3o Saraiva\n-- 2002\n--\n\n\nmodule Funcs_Lexer where\nimport Data.Char\n\n--\n-- Tokens passed to the parser\n--\n\ndata Token\n       = Tsemicolon\n       | TopenB\n       | TcloseB\n       | TopenSB\n       | TcloseSB\n       | TopenCB\n       | TcloseCB\n       | Ttowdots\n       | Tcomma\n       | Tequal\n       | Tand\n       | Tor\n       | Tassing\n       | Tadd\n       | Tmul\n       | Tsub\n       | Tdiv\n       | Tgt\n       | Tlt \n       | Tnot\n       | Ttrue\n       | Tfalse\n       | Tint\n       | Treal\n       | Tbool\n       | Tchar\n       | Tif\n       | Tthen\n       | Telse\n       | Twhile\n       | Tinput\n       | Tprint\n       | TIdent String\n       | TintVal Int\n       | TrealVal Float\n       deriving Show\n\nlexer []       = []\nlexer (';':cs) =  Tsemicolon : lexer cs\nlexer ('(':cs) =  TopenB : lexer cs\nlexer (')':cs) =  TcloseB : lexer cs\nlexer ('[':cs) =  TopenSB : lexer cs\nlexer (']':cs) =  TcloseSB : lexer cs\nlexer ('{':cs) =  TopenCB : lexer cs\nlexer ('}':cs) =  TcloseCB : lexer cs\nlexer (':':cs) =  Ttowdots : lexer cs\nlexer (',':cs) =  Tcomma : lexer cs\n\nlexer ('=':'=':cs) = Tequal : lexer cs\nlexer ('&':'&':cs) = Tor : lexer cs\nlexer ('|':'|':cs) = Tand : lexer cs\n\nlexer ('=':cs) =  Tassing : lexer cs\nlexer ('+':cs) =  Tadd : lexer cs\nlexer ('*':cs) =  Tmul : lexer cs\nlexer ('-':cs) =  Tsub : lexer cs\nlexer ('/':cs) =  Tdiv : lexer cs\nlexer ('>':cs) =  Tgt : lexer cs\nlexer ('<':cs) =  Tlt : lexer cs\nlexer ('!':cs) =  Tnot : lexer cs\n\nlexer (c:cs) \n      | isSpace c = lexer cs\n      | isAlpha c = lexSTR (c:cs)\n      | isDigit c = lexINT (c:cs)\n\nlexINT cs =\n   case span isDigit cs of\n      (var,rest) -> TintVal ((read var)::Int) : lexer rest\n\n\nlexSTR cs = \n   case span isLegalChar cs of\n      (\"true\",rest)  -> Ttrue : lexer rest\n      (\"false\",rest) -> Tfalse : lexer rest\n      (\"int\",rest)   -> Tint : lexer rest\n      (\"real\",rest)  -> Treal : lexer rest\n      (\"bool\",rest)  -> Tbool : lexer rest\n      (\"char\",rest)  -> Tchar : lexer rest\n      (\"if\",rest)    -> Tif : lexer rest\n      (\"then\",rest)  -> Tthen : lexer rest\n      (\"else\",rest)  -> Telse : lexer rest\n      (\"while\",rest) -> Twhile : lexer rest\n      (\"input\",rest) -> Tinput : lexer rest\n      (\"print\",rest) -> Tprint : lexer rest\n      (var,rest)     -> TIdent var : lexer rest\n\nisLegalChar c = let x = ord c\n                in (isAlpha c) || (isDigit c) || (c == '_') \n\nrunScan = do s <- readFile \"input\"\n             let t = lexer s\n             putStr (show t)\n             return () -- (scanner inp))\n\n", "num_lines": 112}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- parser produced by Happy Version 1.13\n\nmodule Funcs_Parser_Lazy ( runParser ) where\n\nimport Funcs_Lexer\n\nimport Data_Lazy\n\ndata HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18\n\t= HappyTerminal Token\n\t| HappyErrorToken Int\n\t| HappyAbsSyn4 t4\n\t| HappyAbsSyn5 t5\n\t| HappyAbsSyn6 t6\n\t| HappyAbsSyn7 t7\n\t| HappyAbsSyn8 t8\n\t| HappyAbsSyn9 t9\n\t| HappyAbsSyn10 t10\n\t| HappyAbsSyn11 t11\n\t| HappyAbsSyn12 t12\n\t| HappyAbsSyn13 t13\n\t| HappyAbsSyn14 t14\n\t| HappyAbsSyn15 t15\n\t| HappyAbsSyn16 t16\n\t| HappyAbsSyn17 t17\n\t| HappyAbsSyn18 t18\n\naction_0 (41) = happyShift action_6\naction_0 (42) = happyShift action_7\naction_0 (43) = happyShift action_8\naction_0 (44) = happyShift action_9\naction_0 (51) = happyShift action_10\naction_0 (4) = happyGoto action_11\naction_0 (5) = happyGoto action_2\naction_0 (6) = happyGoto action_3\naction_0 (7) = happyGoto action_4\naction_0 (18) = happyGoto action_5\naction_0 _ = happyReduce_3\n\naction_1 (41) = happyShift action_6\naction_1 (42) = happyShift action_7\naction_1 (43) = happyShift action_8\naction_1 (44) = happyShift action_9\naction_1 (51) = happyShift action_10\naction_1 (5) = happyGoto action_2\naction_1 (6) = happyGoto action_3\naction_1 (7) = happyGoto action_4\naction_1 (18) = happyGoto action_5\naction_1 _ = happyFail\n\naction_2 _ = happyReduce_1\n\naction_3 (19) = happyShift action_14\naction_3 _ = happyFail\n\naction_4 (51) = happyShift action_10\naction_4 (18) = happyGoto action_13\naction_4 _ = happyFail\n\naction_5 (20) = happyShift action_12\naction_5 _ = happyFail\n\naction_6 _ = happyReduce_7\n\naction_7 _ = happyReduce_8\n\naction_8 _ = happyReduce_9\n\naction_9 _ = happyReduce_10\n\naction_10 _ = happyReduce_51\n\naction_11 (54) = happyAccept\naction_11 _ = happyFail\n\naction_12 (41) = happyShift action_6\naction_12 (42) = happyShift action_7\naction_12 (43) = happyShift action_8\naction_12 (44) = happyShift action_9\naction_12 (7) = happyGoto action_17\naction_12 (8) = happyGoto action_18\naction_12 (9) = happyGoto action_19\naction_12 (10) = happyGoto action_20\naction_12 _ = happyReduce_11\n\naction_13 (22) = happyShift action_16\naction_13 _ = happyReduce_4\n\naction_14 (41) = happyShift action_6\naction_14 (42) = happyShift action_7\naction_14 (43) = happyShift action_8\naction_14 (44) = happyShift action_9\naction_14 (51) = happyShift action_10\naction_14 (5) = happyGoto action_15\naction_14 (6) = happyGoto action_3\naction_14 (7) = happyGoto action_4\naction_14 (18) = happyGoto action_5\naction_14 _ = happyReduce_3\n\naction_15 _ = happyReduce_2\n\naction_16 (52) = happyShift action_24\naction_16 _ = happyFail\n\naction_17 (51) = happyShift action_10\naction_17 (18) = happyGoto action_23\naction_17 _ = happyFail\n\naction_18 (21) = happyShift action_22\naction_18 _ = happyFail\n\naction_19 _ = happyReduce_12\n\naction_20 (27) = happyShift action_21\naction_20 _ = happyReduce_14\n\naction_21 (41) = happyShift action_6\naction_21 (42) = happyShift action_7\naction_21 (43) = happyShift action_8\naction_21 (44) = happyShift action_9\naction_21 (7) = happyGoto action_17\naction_21 (9) = happyGoto action_27\naction_21 (10) = happyGoto action_20\naction_21 _ = happyFail\n\naction_22 (26) = happyShift action_26\naction_22 _ = happyFail\n\naction_23 _ = happyReduce_15\n\naction_24 (23) = happyShift action_25\naction_24 _ = happyFail\n\naction_25 _ = happyReduce_5\n\naction_26 (41) = happyShift action_6\naction_26 (42) = happyShift action_7\naction_26 (43) = happyShift action_8\naction_26 (44) = happyShift action_9\naction_26 (7) = happyGoto action_28\naction_26 _ = happyFail\n\naction_27 _ = happyReduce_13\n\naction_28 (24) = happyShift action_29\naction_28 _ = happyFail\n\naction_29 (41) = happyShift action_6\naction_29 (42) = happyShift action_7\naction_29 (43) = happyShift action_8\naction_29 (44) = happyShift action_9\naction_29 (45) = happyShift action_35\naction_29 (48) = happyShift action_36\naction_29 (49) = happyShift action_37\naction_29 (50) = happyShift action_38\naction_29 (51) = happyShift action_10\naction_29 (7) = happyGoto action_30\naction_29 (11) = happyGoto action_31\naction_29 (12) = happyGoto action_32\naction_29 (15) = happyGoto action_33\naction_29 (18) = happyGoto action_34\naction_29 _ = happyReduce_17\n\naction_30 (51) = happyShift action_10\naction_30 (18) = happyGoto action_59\naction_30 _ = happyFail\n\naction_31 (25) = happyShift action_58\naction_31 _ = happyFail\n\naction_32 (19) = happyShift action_57\naction_32 _ = happyFail\n\naction_33 (31) = happyShift action_56\naction_33 _ = happyFail\n\naction_34 (20) = happyShift action_53\naction_34 (22) = happyShift action_54\naction_34 (31) = happyShift action_55\naction_34 _ = happyFail\n\naction_35 (20) = happyShift action_43\naction_35 (34) = happyShift action_44\naction_35 (38) = happyShift action_45\naction_35 (39) = happyShift action_46\naction_35 (40) = happyShift action_47\naction_35 (51) = happyShift action_10\naction_35 (52) = happyShift action_48\naction_35 (53) = happyShift action_49\naction_35 (13) = happyGoto action_52\naction_35 (14) = happyGoto action_40\naction_35 (15) = happyGoto action_41\naction_35 (18) = happyGoto action_42\naction_35 _ = happyFail\n\naction_36 (20) = happyShift action_43\naction_36 (34) = happyShift action_44\naction_36 (38) = happyShift action_45\naction_36 (39) = happyShift action_46\naction_36 (40) = happyShift action_47\naction_36 (51) = happyShift action_10\naction_36 (52) = happyShift action_48\naction_36 (53) = happyShift action_49\naction_36 (13) = happyGoto action_51\naction_36 (14) = happyGoto action_40\naction_36 (15) = happyGoto action_41\naction_36 (18) = happyGoto action_42\naction_36 _ = happyFail\n\naction_37 (51) = happyShift action_10\naction_37 (18) = happyGoto action_50\naction_37 _ = happyFail\n\naction_38 (20) = happyShift action_43\naction_38 (34) = happyShift action_44\naction_38 (38) = happyShift action_45\naction_38 (39) = happyShift action_46\naction_38 (40) = happyShift action_47\naction_38 (51) = happyShift action_10\naction_38 (52) = happyShift action_48\naction_38 (53) = happyShift action_49\naction_38 (13) = happyGoto action_39\naction_38 (14) = happyGoto action_40\naction_38 (15) = happyGoto action_41\naction_38 (18) = happyGoto action_42\naction_38 _ = happyFail\n\naction_39 (28) = happyShift action_67\naction_39 (29) = happyShift action_68\naction_39 (30) = happyShift action_69\naction_39 (32) = happyShift action_70\naction_39 (33) = happyShift action_71\naction_39 (34) = happyShift action_72\naction_39 (35) = happyShift action_73\naction_39 (36) = happyShift action_74\naction_39 (37) = happyShift action_75\naction_39 _ = happyReduce_25\n\naction_40 _ = happyReduce_26\n\naction_41 _ = happyReduce_42\n\naction_42 (20) = happyShift action_81\naction_42 (22) = happyShift action_54\naction_42 _ = happyReduce_43\n\naction_43 (20) = happyShift action_43\naction_43 (34) = happyShift action_44\naction_43 (38) = happyShift action_45\naction_43 (39) = happyShift action_46\naction_43 (40) = happyShift action_47\naction_43 (51) = happyShift action_10\naction_43 (52) = happyShift action_48\naction_43 (53) = happyShift action_49\naction_43 (13) = happyGoto action_80\naction_43 (14) = happyGoto action_40\naction_43 (15) = happyGoto action_41\naction_43 (18) = happyGoto action_42\naction_43 _ = happyFail\n\naction_44 (20) = happyShift action_43\naction_44 (34) = happyShift action_44\naction_44 (38) = happyShift action_45\naction_44 (39) = happyShift action_46\naction_44 (40) = happyShift action_47\naction_44 (51) = happyShift action_10\naction_44 (52) = happyShift action_48\naction_44 (53) = happyShift action_49\naction_44 (13) = happyGoto action_79\naction_44 (14) = happyGoto action_40\naction_44 (15) = happyGoto action_41\naction_44 (18) = happyGoto action_42\naction_44 _ = happyFail\n\naction_45 (20) = happyShift action_43\naction_45 (34) = happyShift action_44\naction_45 (38) = happyShift action_45\naction_45 (39) = happyShift action_46\naction_45 (40) = happyShift action_47\naction_45 (51) = happyShift action_10\naction_45 (52) = happyShift action_48\naction_45 (53) = happyShift action_49\naction_45 (13) = happyGoto action_78\naction_45 (14) = happyGoto action_40\naction_45 (15) = happyGoto action_41\naction_45 (18) = happyGoto action_42\naction_45 _ = happyFail\n\naction_46 _ = happyReduce_40\n\naction_47 _ = happyReduce_41\n\naction_48 _ = happyReduce_38\n\naction_49 _ = happyReduce_39\n\naction_50 _ = happyReduce_24\n\naction_51 (24) = happyShift action_77\naction_51 (28) = happyShift action_67\naction_51 (29) = happyShift action_68\naction_51 (30) = happyShift action_69\naction_51 (32) = happyShift action_70\naction_51 (33) = happyShift action_71\naction_51 (34) = happyShift action_72\naction_51 (35) = happyShift action_73\naction_51 (36) = happyShift action_74\naction_51 (37) = happyShift action_75\naction_51 _ = happyFail\n\naction_52 (28) = happyShift action_67\naction_52 (29) = happyShift action_68\naction_52 (30) = happyShift action_69\naction_52 (32) = happyShift action_70\naction_52 (33) = happyShift action_71\naction_52 (34) = happyShift action_72\naction_52 (35) = happyShift action_73\naction_52 (36) = happyShift action_74\naction_52 (37) = happyShift action_75\naction_52 (46) = happyShift action_76\naction_52 _ = happyFail\n\naction_53 (20) = happyShift action_43\naction_53 (34) = happyShift action_44\naction_53 (38) = happyShift action_45\naction_53 (39) = happyShift action_46\naction_53 (40) = happyShift action_47\naction_53 (51) = happyShift action_10\naction_53 (52) = happyShift action_48\naction_53 (53) = happyShift action_49\naction_53 (13) = happyGoto action_64\naction_53 (14) = happyGoto action_40\naction_53 (15) = happyGoto action_41\naction_53 (16) = happyGoto action_65\naction_53 (17) = happyGoto action_66\naction_53 (18) = happyGoto action_42\naction_53 _ = happyReduce_47\n\naction_54 (20) = happyShift action_43\naction_54 (34) = happyShift action_44\naction_54 (38) = happyShift action_45\naction_54 (39) = happyShift action_46\naction_54 (40) = happyShift action_47\naction_54 (51) = happyShift action_10\naction_54 (52) = happyShift action_48\naction_54 (53) = happyShift action_49\naction_54 (13) = happyGoto action_63\naction_54 (14) = happyGoto action_40\naction_54 (15) = happyGoto action_41\naction_54 (18) = happyGoto action_42\naction_54 _ = happyFail\n\naction_55 (20) = happyShift action_43\naction_55 (34) = happyShift action_44\naction_55 (38) = happyShift action_45\naction_55 (39) = happyShift action_46\naction_55 (40) = happyShift action_47\naction_55 (51) = happyShift action_10\naction_55 (52) = happyShift action_48\naction_55 (53) = happyShift action_49\naction_55 (13) = happyGoto action_62\naction_55 (14) = happyGoto action_40\naction_55 (15) = happyGoto action_41\naction_55 (18) = happyGoto action_42\naction_55 _ = happyFail\n\naction_56 (20) = happyShift action_43\naction_56 (34) = happyShift action_44\naction_56 (38) = happyShift action_45\naction_56 (39) = happyShift action_46\naction_56 (40) = happyShift action_47\naction_56 (51) = happyShift action_10\naction_56 (52) = happyShift action_48\naction_56 (53) = happyShift action_49\naction_56 (13) = happyGoto action_61\naction_56 (14) = happyGoto action_40\naction_56 (15) = happyGoto action_41\naction_56 (18) = happyGoto action_42\naction_56 _ = happyFail\n\naction_57 (41) = happyShift action_6\naction_57 (42) = happyShift action_7\naction_57 (43) = happyShift action_8\naction_57 (44) = happyShift action_9\naction_57 (45) = happyShift action_35\naction_57 (48) = happyShift action_36\naction_57 (49) = happyShift action_37\naction_57 (50) = happyShift action_38\naction_57 (51) = happyShift action_10\naction_57 (7) = happyGoto action_30\naction_57 (11) = happyGoto action_60\naction_57 (12) = happyGoto action_32\naction_57 (15) = happyGoto action_33\naction_57 (18) = happyGoto action_34\naction_57 _ = happyReduce_17\n\naction_58 _ = happyReduce_6\n\naction_59 _ = happyReduce_18\n\naction_60 _ = happyReduce_16\n\naction_61 (28) = happyShift action_67\naction_61 (29) = happyShift action_68\naction_61 (30) = happyShift action_69\naction_61 (32) = happyShift action_70\naction_61 (33) = happyShift action_71\naction_61 (34) = happyShift action_72\naction_61 (35) = happyShift action_73\naction_61 (36) = happyShift action_74\naction_61 (37) = happyShift action_75\naction_61 _ = happyReduce_20\n\naction_62 (28) = happyShift action_67\naction_62 (29) = happyShift action_68\naction_62 (30) = happyShift action_69\naction_62 (32) = happyShift action_70\naction_62 (33) = happyShift action_71\naction_62 (34) = happyShift action_72\naction_62 (35) = happyShift action_73\naction_62 (36) = happyShift action_74\naction_62 (37) = happyShift action_75\naction_62 _ = happyReduce_19\n\naction_63 (23) = happyShift action_97\naction_63 (28) = happyShift action_67\naction_63 (29) = happyShift action_68\naction_63 (30) = happyShift action_69\naction_63 (32) = happyShift action_70\naction_63 (33) = happyShift action_71\naction_63 (34) = happyShift action_72\naction_63 (35) = happyShift action_73\naction_63 (36) = happyShift action_74\naction_63 (37) = happyShift action_75\naction_63 _ = happyFail\n\naction_64 (27) = happyShift action_96\naction_64 (28) = happyShift action_67\naction_64 (29) = happyShift action_68\naction_64 (30) = happyShift action_69\naction_64 (32) = happyShift action_70\naction_64 (33) = happyShift action_71\naction_64 (34) = happyShift action_72\naction_64 (35) = happyShift action_73\naction_64 (36) = happyShift action_74\naction_64 (37) = happyShift action_75\naction_64 _ = happyReduce_50\n\naction_65 (21) = happyShift action_95\naction_65 _ = happyFail\n\naction_66 _ = happyReduce_48\n\naction_67 (20) = happyShift action_43\naction_67 (34) = happyShift action_44\naction_67 (38) = happyShift action_45\naction_67 (39) = happyShift action_46\naction_67 (40) = happyShift action_47\naction_67 (51) = happyShift action_10\naction_67 (52) = happyShift action_48\naction_67 (53) = happyShift action_49\naction_67 (13) = happyGoto action_94\naction_67 (14) = happyGoto action_40\naction_67 (15) = happyGoto action_41\naction_67 (18) = happyGoto action_42\naction_67 _ = happyFail\n\naction_68 (20) = happyShift action_43\naction_68 (34) = happyShift action_44\naction_68 (38) = happyShift action_45\naction_68 (39) = happyShift action_46\naction_68 (40) = happyShift action_47\naction_68 (51) = happyShift action_10\naction_68 (52) = happyShift action_48\naction_68 (53) = happyShift action_49\naction_68 (13) = happyGoto action_93\naction_68 (14) = happyGoto action_40\naction_68 (15) = happyGoto action_41\naction_68 (18) = happyGoto action_42\naction_68 _ = happyFail\n\naction_69 (20) = happyShift action_43\naction_69 (34) = happyShift action_44\naction_69 (38) = happyShift action_45\naction_69 (39) = happyShift action_46\naction_69 (40) = happyShift action_47\naction_69 (51) = happyShift action_10\naction_69 (52) = happyShift action_48\naction_69 (53) = happyShift action_49\naction_69 (13) = happyGoto action_92\naction_69 (14) = happyGoto action_40\naction_69 (15) = happyGoto action_41\naction_69 (18) = happyGoto action_42\naction_69 _ = happyFail\n\naction_70 (20) = happyShift action_43\naction_70 (34) = happyShift action_44\naction_70 (38) = happyShift action_45\naction_70 (39) = happyShift action_46\naction_70 (40) = happyShift action_47\naction_70 (51) = happyShift action_10\naction_70 (52) = happyShift action_48\naction_70 (53) = happyShift action_49\naction_70 (13) = happyGoto action_91\naction_70 (14) = happyGoto action_40\naction_70 (15) = happyGoto action_41\naction_70 (18) = happyGoto action_42\naction_70 _ = happyFail\n\naction_71 (20) = happyShift action_43\naction_71 (34) = happyShift action_44\naction_71 (38) = happyShift action_45\naction_71 (39) = happyShift action_46\naction_71 (40) = happyShift action_47\naction_71 (51) = happyShift action_10\naction_71 (52) = happyShift action_48\naction_71 (53) = happyShift action_49\naction_71 (13) = happyGoto action_90\naction_71 (14) = happyGoto action_40\naction_71 (15) = happyGoto action_41\naction_71 (18) = happyGoto action_42\naction_71 _ = happyFail\n\naction_72 (20) = happyShift action_43\naction_72 (34) = happyShift action_44\naction_72 (38) = happyShift action_45\naction_72 (39) = happyShift action_46\naction_72 (40) = happyShift action_47\naction_72 (51) = happyShift action_10\naction_72 (52) = happyShift action_48\naction_72 (53) = happyShift action_49\naction_72 (13) = happyGoto action_89\naction_72 (14) = happyGoto action_40\naction_72 (15) = happyGoto action_41\naction_72 (18) = happyGoto action_42\naction_72 _ = happyFail\n\naction_73 (20) = happyShift action_43\naction_73 (34) = happyShift action_44\naction_73 (38) = happyShift action_45\naction_73 (39) = happyShift action_46\naction_73 (40) = happyShift action_47\naction_73 (51) = happyShift action_10\naction_73 (52) = happyShift action_48\naction_73 (53) = happyShift action_49\naction_73 (13) = happyGoto action_88\naction_73 (14) = happyGoto action_40\naction_73 (15) = happyGoto action_41\naction_73 (18) = happyGoto action_42\naction_73 _ = happyFail\n\naction_74 (20) = happyShift action_43\naction_74 (34) = happyShift action_44\naction_74 (38) = happyShift action_45\naction_74 (39) = happyShift action_46\naction_74 (40) = happyShift action_47\naction_74 (51) = happyShift action_10\naction_74 (52) = happyShift action_48\naction_74 (53) = happyShift action_49\naction_74 (13) = happyGoto action_87\naction_74 (14) = happyGoto action_40\naction_74 (15) = happyGoto action_41\naction_74 (18) = happyGoto action_42\naction_74 _ = happyFail\n\naction_75 (20) = happyShift action_43\naction_75 (34) = happyShift action_44\naction_75 (38) = happyShift action_45\naction_75 (39) = happyShift action_46\naction_75 (40) = happyShift action_47\naction_75 (51) = happyShift action_10\naction_75 (52) = happyShift action_48\naction_75 (53) = happyShift action_49\naction_75 (13) = happyGoto action_86\naction_75 (14) = happyGoto action_40\naction_75 (15) = happyGoto action_41\naction_75 (18) = happyGoto action_42\naction_75 _ = happyFail\n\naction_76 (24) = happyShift action_85\naction_76 _ = happyFail\n\naction_77 (41) = happyShift action_6\naction_77 (42) = happyShift action_7\naction_77 (43) = happyShift action_8\naction_77 (44) = happyShift action_9\naction_77 (45) = happyShift action_35\naction_77 (48) = happyShift action_36\naction_77 (49) = happyShift action_37\naction_77 (50) = happyShift action_38\naction_77 (51) = happyShift action_10\naction_77 (7) = happyGoto action_30\naction_77 (11) = happyGoto action_84\naction_77 (12) = happyGoto action_32\naction_77 (15) = happyGoto action_33\naction_77 (18) = happyGoto action_34\naction_77 _ = happyReduce_17\n\naction_78 (28) = happyShift action_67\naction_78 (29) = happyShift action_68\naction_78 (30) = happyShift action_69\naction_78 (32) = happyShift action_70\naction_78 (33) = happyShift action_71\naction_78 (34) = happyShift action_72\naction_78 (35) = happyShift action_73\naction_78 (36) = happyShift action_74\naction_78 (37) = happyShift action_75\naction_78 _ = happyReduce_36\n\naction_79 (28) = happyShift action_67\naction_79 (29) = happyShift action_68\naction_79 (30) = happyShift action_69\naction_79 (32) = happyShift action_70\naction_79 (33) = happyShift action_71\naction_79 (34) = happyShift action_72\naction_79 (35) = happyShift action_73\naction_79 (36) = happyShift action_74\naction_79 (37) = happyShift action_75\naction_79 _ = happyReduce_37\n\naction_80 (21) = happyShift action_83\naction_80 (28) = happyShift action_67\naction_80 (29) = happyShift action_68\naction_80 (30) = happyShift action_69\naction_80 (32) = happyShift action_70\naction_80 (33) = happyShift action_71\naction_80 (34) = happyShift action_72\naction_80 (35) = happyShift action_73\naction_80 (36) = happyShift action_74\naction_80 (37) = happyShift action_75\naction_80 _ = happyFail\n\naction_81 (20) = happyShift action_43\naction_81 (34) = happyShift action_44\naction_81 (38) = happyShift action_45\naction_81 (39) = happyShift action_46\naction_81 (40) = happyShift action_47\naction_81 (51) = happyShift action_10\naction_81 (52) = happyShift action_48\naction_81 (53) = happyShift action_49\naction_81 (13) = happyGoto action_64\naction_81 (14) = happyGoto action_40\naction_81 (15) = happyGoto action_41\naction_81 (17) = happyGoto action_82\naction_81 (18) = happyGoto action_42\naction_81 _ = happyFail\n\naction_82 (21) = happyShift action_101\naction_82 _ = happyFail\n\naction_83 _ = happyReduce_45\n\naction_84 (25) = happyShift action_100\naction_84 _ = happyFail\n\naction_85 (41) = happyShift action_6\naction_85 (42) = happyShift action_7\naction_85 (43) = happyShift action_8\naction_85 (44) = happyShift action_9\naction_85 (45) = happyShift action_35\naction_85 (48) = happyShift action_36\naction_85 (49) = happyShift action_37\naction_85 (50) = happyShift action_38\naction_85 (51) = happyShift action_10\naction_85 (7) = happyGoto action_30\naction_85 (11) = happyGoto action_99\naction_85 (12) = happyGoto action_32\naction_85 (15) = happyGoto action_33\naction_85 (18) = happyGoto action_34\naction_85 _ = happyReduce_17\n\naction_86 (28) = happyShift action_67\naction_86 (29) = happyShift action_68\naction_86 (30) = happyShift action_69\naction_86 (32) = happyShift action_70\naction_86 (33) = happyShift action_71\naction_86 (34) = happyShift action_72\naction_86 (35) = happyShift action_73\naction_86 (36) = happyShift action_74\naction_86 (37) = happyShift action_75\naction_86 _ = happyReduce_35\n\naction_87 (28) = happyShift action_67\naction_87 (29) = happyShift action_68\naction_87 (30) = happyShift action_69\naction_87 (32) = happyShift action_70\naction_87 (33) = happyShift action_71\naction_87 (34) = happyShift action_72\naction_87 (35) = happyShift action_73\naction_87 (36) = happyShift action_74\naction_87 (37) = happyShift action_75\naction_87 _ = happyReduce_34\n\naction_88 (28) = happyShift action_67\naction_88 (29) = happyShift action_68\naction_88 (30) = happyShift action_69\naction_88 (32) = happyShift action_70\naction_88 (33) = happyShift action_71\naction_88 (34) = happyShift action_72\naction_88 (35) = happyShift action_73\naction_88 (36) = happyShift action_74\naction_88 (37) = happyShift action_75\naction_88 _ = happyReduce_30\n\naction_89 (28) = happyShift action_67\naction_89 (29) = happyShift action_68\naction_89 (30) = happyShift action_69\naction_89 (32) = happyShift action_70\naction_89 (33) = happyShift action_71\naction_89 (34) = happyShift action_72\naction_89 (35) = happyShift action_73\naction_89 (36) = happyShift action_74\naction_89 (37) = happyShift action_75\naction_89 _ = happyReduce_28\n\naction_90 (28) = happyShift action_67\naction_90 (29) = happyShift action_68\naction_90 (30) = happyShift action_69\naction_90 (32) = happyShift action_70\naction_90 (33) = happyShift action_71\naction_90 (34) = happyShift action_72\naction_90 (35) = happyShift action_73\naction_90 (36) = happyShift action_74\naction_90 (37) = happyShift action_75\naction_90 _ = happyReduce_29\n\naction_91 (28) = happyShift action_67\naction_91 (29) = happyShift action_68\naction_91 (30) = happyShift action_69\naction_91 (32) = happyShift action_70\naction_91 (33) = happyShift action_71\naction_91 (34) = happyShift action_72\naction_91 (35) = happyShift action_73\naction_91 (36) = happyShift action_74\naction_91 (37) = happyShift action_75\naction_91 _ = happyReduce_27\n\naction_92 (28) = happyShift action_67\naction_92 (29) = happyShift action_68\naction_92 (30) = happyShift action_69\naction_92 (32) = happyShift action_70\naction_92 (33) = happyShift action_71\naction_92 (34) = happyShift action_72\naction_92 (35) = happyShift action_73\naction_92 (36) = happyShift action_74\naction_92 (37) = happyShift action_75\naction_92 _ = happyReduce_32\n\naction_93 (28) = happyShift action_67\naction_93 (29) = happyShift action_68\naction_93 (30) = happyShift action_69\naction_93 (32) = happyShift action_70\naction_93 (33) = happyShift action_71\naction_93 (34) = happyShift action_72\naction_93 (35) = happyShift action_73\naction_93 (36) = happyShift action_74\naction_93 (37) = happyShift action_75\naction_93 _ = happyReduce_31\n\naction_94 (28) = happyShift action_67\naction_94 (29) = happyShift action_68\naction_94 (30) = happyShift action_69\naction_94 (32) = happyShift action_70\naction_94 (33) = happyShift action_71\naction_94 (34) = happyShift action_72\naction_94 (35) = happyShift action_73\naction_94 (36) = happyShift action_74\naction_94 (37) = happyShift action_75\naction_94 _ = happyReduce_33\n\naction_95 _ = happyReduce_21\n\naction_96 (20) = happyShift action_43\naction_96 (34) = happyShift action_44\naction_96 (38) = happyShift action_45\naction_96 (39) = happyShift action_46\naction_96 (40) = happyShift action_47\naction_96 (51) = happyShift action_10\naction_96 (52) = happyShift action_48\naction_96 (53) = happyShift action_49\naction_96 (13) = happyGoto action_64\naction_96 (14) = happyGoto action_40\naction_96 (15) = happyGoto action_41\naction_96 (17) = happyGoto action_98\naction_96 (18) = happyGoto action_42\naction_96 _ = happyFail\n\naction_97 _ = happyReduce_46\n\naction_98 _ = happyReduce_49\n\naction_99 (25) = happyShift action_102\naction_99 _ = happyFail\n\naction_100 _ = happyReduce_22\n\naction_101 _ = happyReduce_44\n\naction_102 (47) = happyShift action_103\naction_102 _ = happyFail\n\naction_103 (24) = happyShift action_104\naction_103 _ = happyFail\n\naction_104 (41) = happyShift action_6\naction_104 (42) = happyShift action_7\naction_104 (43) = happyShift action_8\naction_104 (44) = happyShift action_9\naction_104 (45) = happyShift action_35\naction_104 (48) = happyShift action_36\naction_104 (49) = happyShift action_37\naction_104 (50) = happyShift action_38\naction_104 (51) = happyShift action_10\naction_104 (7) = happyGoto action_30\naction_104 (11) = happyGoto action_105\naction_104 (12) = happyGoto action_32\naction_104 (15) = happyGoto action_33\naction_104 (18) = happyGoto action_34\naction_104 _ = happyReduce_17\n\naction_105 (25) = happyShift action_106\naction_105 _ = happyFail\n\naction_106 _ = happyReduce_23\n\nhappyReduce_1 = happySpecReduce_1 4 happyReduction_1\nhappyReduction_1 (HappyAbsSyn5  happy_var_1)\n\t =  HappyAbsSyn4\n\t\t (C_RootProd_1 happy_var_1\n\t)\nhappyReduction_1 _  = notHappyAtAll \n\nhappyReduce_2 = happySpecReduce_3 5 happyReduction_2\nhappyReduction_2 (HappyAbsSyn5  happy_var_3)\n\t_\n\t(HappyAbsSyn6  happy_var_1)\n\t =  HappyAbsSyn5\n\t\t (C_Defs2_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_2 _ _ _  = notHappyAtAll \n\nhappyReduce_3 = happySpecReduce_0 5 happyReduction_3\nhappyReduction_3  =  HappyAbsSyn5\n\t\t (C_NoDefs_1\n\t)\n\nhappyReduce_4 = happySpecReduce_2 6 happyReduction_4\nhappyReduction_4 (HappyAbsSyn18  happy_var_2)\n\t(HappyAbsSyn7  happy_var_1)\n\t =  HappyAbsSyn6\n\t\t (C_Vardecl_1 happy_var_1 happy_var_2\n\t)\nhappyReduction_4 _ _  = notHappyAtAll \n\nhappyReduce_5 = happyReduce 5 6 happyReduction_5\nhappyReduction_5 (_ `HappyStk`\n\t(HappyTerminal (TintVal happy_var_4)) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn18  happy_var_2) `HappyStk`\n\t(HappyAbsSyn7  happy_var_1) `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn6\n\t\t (C_Arraydecl_1 happy_var_1 happy_var_2 (toInteger happy_var_4)\n\t) `HappyStk` happyRest\n\nhappyReduce_6 = happyReduce 9 6 happyReduction_6\nhappyReduction_6 (_ `HappyStk`\n\t(HappyAbsSyn11  happy_var_8) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn7  happy_var_6) `HappyStk`\n\t_ `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn8  happy_var_3) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn18  happy_var_1) `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn6\n\t\t (C_Declfunc_1 happy_var_6 happy_var_1 happy_var_3 happy_var_8\n\t) `HappyStk` happyRest\n\nhappyReduce_7 = happySpecReduce_1 7 happyReduction_7\nhappyReduction_7 _\n\t =  HappyAbsSyn7\n\t\t (C_Inttype_1\n\t)\n\nhappyReduce_8 = happySpecReduce_1 7 happyReduction_8\nhappyReduction_8 _\n\t =  HappyAbsSyn7\n\t\t (C_Realtype_1\n\t)\n\nhappyReduce_9 = happySpecReduce_1 7 happyReduction_9\nhappyReduction_9 _\n\t =  HappyAbsSyn7\n\t\t (C_Booltype_1\n\t)\n\nhappyReduce_10 = happySpecReduce_1 7 happyReduction_10\nhappyReduction_10 _\n\t =  HappyAbsSyn7\n\t\t (C_Chartype_1\n\t)\n\nhappyReduce_11 = happySpecReduce_0 8 happyReduction_11\nhappyReduction_11  =  HappyAbsSyn8\n\t\t (C_Emptyformpars_1\n\t)\n\nhappyReduce_12 = happySpecReduce_1 8 happyReduction_12\nhappyReduction_12 (HappyAbsSyn9  happy_var_1)\n\t =  HappyAbsSyn8\n\t\t (happy_var_1\n\t)\nhappyReduction_12 _  = notHappyAtAll \n\nhappyReduce_13 = happySpecReduce_3 9 happyReduction_13\nhappyReduction_13 (HappyAbsSyn9  happy_var_3)\n\t_\n\t(HappyAbsSyn10  happy_var_1)\n\t =  HappyAbsSyn9\n\t\t (C_Lstformpars_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_13 _ _ _  = notHappyAtAll \n\nhappyReduce_14 = happySpecReduce_1 9 happyReduction_14\nhappyReduction_14 (HappyAbsSyn10  happy_var_1)\n\t =  HappyAbsSyn9\n\t\t (C_Lstformpars_1 happy_var_1 C_Emptyformpars_1\n\t)\nhappyReduction_14 _  = notHappyAtAll \n\nhappyReduce_15 = happySpecReduce_2 10 happyReduction_15\nhappyReduction_15 (HappyAbsSyn18  happy_var_2)\n\t(HappyAbsSyn7  happy_var_1)\n\t =  HappyAbsSyn10\n\t\t (C_Declformpar_1 happy_var_1 happy_var_2\n\t)\nhappyReduction_15 _ _  = notHappyAtAll \n\nhappyReduce_16 = happySpecReduce_3 11 happyReduction_16\nhappyReduction_16 (HappyAbsSyn11  happy_var_3)\n\t_\n\t(HappyAbsSyn12  happy_var_1)\n\t =  HappyAbsSyn11\n\t\t (C_Lststats_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_16 _ _ _  = notHappyAtAll \n\nhappyReduce_17 = happySpecReduce_0 11 happyReduction_17\nhappyReduction_17  =  HappyAbsSyn11\n\t\t (C_Emptystat_1\n\t)\n\nhappyReduce_18 = happySpecReduce_2 12 happyReduction_18\nhappyReduction_18 (HappyAbsSyn18  happy_var_2)\n\t(HappyAbsSyn7  happy_var_1)\n\t =  HappyAbsSyn12\n\t\t (C_LocalDecl_1 happy_var_1 happy_var_2\n\t)\nhappyReduction_18 _ _  = notHappyAtAll \n\nhappyReduce_19 = happySpecReduce_3 12 happyReduction_19\nhappyReduction_19 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn18  happy_var_1)\n\t =  HappyAbsSyn12\n\t\t (C_Assign_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_19 _ _ _  = notHappyAtAll \n\nhappyReduce_20 = happySpecReduce_3 12 happyReduction_20\nhappyReduction_20 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn15  happy_var_1)\n\t =  HappyAbsSyn12\n\t\t (C_ArrAssign_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_20 _ _ _  = notHappyAtAll \n\nhappyReduce_21 = happyReduce 4 12 happyReduction_21\nhappyReduction_21 (_ `HappyStk`\n\t(HappyAbsSyn16  happy_var_3) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn18  happy_var_1) `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn12\n\t\t (C_Funccall_1 happy_var_1 happy_var_3\n\t) `HappyStk` happyRest\n\nhappyReduce_22 = happyReduce 5 12 happyReduction_22\nhappyReduction_22 (_ `HappyStk`\n\t(HappyAbsSyn11  happy_var_4) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn13  happy_var_2) `HappyStk`\n\t_ `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn12\n\t\t (C_While_1 happy_var_2 happy_var_4\n\t) `HappyStk` happyRest\n\nhappyReduce_23 = happyReduce 10 12 happyReduction_23\nhappyReduction_23 (_ `HappyStk`\n\t(HappyAbsSyn11  happy_var_9) `HappyStk`\n\t_ `HappyStk`\n\t_ `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn11  happy_var_5) `HappyStk`\n\t_ `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn13  happy_var_2) `HappyStk`\n\t_ `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn12\n\t\t (C_If_t_e_1 happy_var_2 happy_var_5 happy_var_9\n\t) `HappyStk` happyRest\n\nhappyReduce_24 = happySpecReduce_2 12 happyReduction_24\nhappyReduction_24 (HappyAbsSyn18  happy_var_2)\n\t_\n\t =  HappyAbsSyn12\n\t\t (C_Input_1 happy_var_2\n\t)\nhappyReduction_24 _ _  = notHappyAtAll \n\nhappyReduce_25 = happySpecReduce_2 12 happyReduction_25\nhappyReduction_25 (HappyAbsSyn13  happy_var_2)\n\t_\n\t =  HappyAbsSyn12\n\t\t (C_Print_1 happy_var_2\n\t)\nhappyReduction_25 _ _  = notHappyAtAll \n\nhappyReduce_26 = happySpecReduce_1 13 happyReduction_26\nhappyReduction_26 (HappyAbsSyn14  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_Factor_1 happy_var_1\n\t)\nhappyReduction_26 _  = notHappyAtAll \n\nhappyReduce_27 = happySpecReduce_3 13 happyReduction_27\nhappyReduction_27 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_AddExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_27 _ _ _  = notHappyAtAll \n\nhappyReduce_28 = happySpecReduce_3 13 happyReduction_28\nhappyReduction_28 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_SubExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_28 _ _ _  = notHappyAtAll \n\nhappyReduce_29 = happySpecReduce_3 13 happyReduction_29\nhappyReduction_29 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_MulExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_29 _ _ _  = notHappyAtAll \n\nhappyReduce_30 = happySpecReduce_3 13 happyReduction_30\nhappyReduction_30 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_DivExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_30 _ _ _  = notHappyAtAll \n\nhappyReduce_31 = happySpecReduce_3 13 happyReduction_31\nhappyReduction_31 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_AndExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_31 _ _ _  = notHappyAtAll \n\nhappyReduce_32 = happySpecReduce_3 13 happyReduction_32\nhappyReduction_32 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_OrExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_32 _ _ _  = notHappyAtAll \n\nhappyReduce_33 = happySpecReduce_3 13 happyReduction_33\nhappyReduction_33 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_EqExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_33 _ _ _  = notHappyAtAll \n\nhappyReduce_34 = happySpecReduce_3 13 happyReduction_34\nhappyReduction_34 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_GTExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_34 _ _ _  = notHappyAtAll \n\nhappyReduce_35 = happySpecReduce_3 13 happyReduction_35\nhappyReduction_35 (HappyAbsSyn13  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn13\n\t\t (C_LTExp_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_35 _ _ _  = notHappyAtAll \n\nhappyReduce_36 = happySpecReduce_2 13 happyReduction_36\nhappyReduction_36 (HappyAbsSyn13  happy_var_2)\n\t_\n\t =  HappyAbsSyn13\n\t\t (C_NotExp_1 happy_var_2\n\t)\nhappyReduction_36 _ _  = notHappyAtAll \n\nhappyReduce_37 = happySpecReduce_2 13 happyReduction_37\nhappyReduction_37 (HappyAbsSyn13  happy_var_2)\n\t_\n\t =  HappyAbsSyn13\n\t\t (C_MinExp_1 happy_var_2\n\t)\nhappyReduction_37 _ _  = notHappyAtAll \n\nhappyReduce_38 = happySpecReduce_1 14 happyReduction_38\nhappyReduction_38 (HappyTerminal (TintVal happy_var_1))\n\t =  HappyAbsSyn14\n\t\t (C_IntConst_1 (toInteger happy_var_1)\n\t)\nhappyReduction_38 _  = notHappyAtAll \n\nhappyReduce_39 = happySpecReduce_1 14 happyReduction_39\nhappyReduction_39 (HappyTerminal (TrealVal happy_var_1))\n\t =  HappyAbsSyn14\n\t\t (C_RealConst_1 happy_var_1\n\t)\nhappyReduction_39 _  = notHappyAtAll \n\nhappyReduce_40 = happySpecReduce_1 14 happyReduction_40\nhappyReduction_40 _\n\t =  HappyAbsSyn14\n\t\t (C_BoolConst_1 True\n\t)\n\nhappyReduce_41 = happySpecReduce_1 14 happyReduction_41\nhappyReduction_41 _\n\t =  HappyAbsSyn14\n\t\t (C_BoolConst_1 False\n\t)\n\nhappyReduce_42 = happySpecReduce_1 14 happyReduction_42\nhappyReduction_42 (HappyAbsSyn15  happy_var_1)\n\t =  HappyAbsSyn14\n\t\t (C_ArrayConst_1 happy_var_1\n\t)\nhappyReduction_42 _  = notHappyAtAll \n\nhappyReduce_43 = happySpecReduce_1 14 happyReduction_43\nhappyReduction_43 (HappyAbsSyn18  happy_var_1)\n\t =  HappyAbsSyn14\n\t\t (C_CNIdent_1 happy_var_1\n\t)\nhappyReduction_43 _  = notHappyAtAll \n\nhappyReduce_44 = happyReduce 4 14 happyReduction_44\nhappyReduction_44 (_ `HappyStk`\n\t(HappyAbsSyn17  happy_var_3) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn18  happy_var_1) `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn14\n\t\t (C_Funcinv_1 happy_var_1 happy_var_3\n\t) `HappyStk` happyRest\n\nhappyReduce_45 = happySpecReduce_3 14 happyReduction_45\nhappyReduction_45 _\n\t(HappyAbsSyn13  happy_var_2)\n\t_\n\t =  HappyAbsSyn14\n\t\t (C_Expr_1 happy_var_2\n\t)\nhappyReduction_45 _ _ _  = notHappyAtAll \n\nhappyReduce_46 = happyReduce 4 15 happyReduction_46\nhappyReduction_46 (_ `HappyStk`\n\t(HappyAbsSyn13  happy_var_3) `HappyStk`\n\t_ `HappyStk`\n\t(HappyAbsSyn18  happy_var_1) `HappyStk`\n\thappyRest)\n\t = HappyAbsSyn15\n\t\t (C_ArrayInd_1 happy_var_1 happy_var_3\n\t) `HappyStk` happyRest\n\nhappyReduce_47 = happySpecReduce_0 16 happyReduction_47\nhappyReduction_47  =  HappyAbsSyn16\n\t\t (C_Emptyactpars_1\n\t)\n\nhappyReduce_48 = happySpecReduce_1 16 happyReduction_48\nhappyReduction_48 (HappyAbsSyn17  happy_var_1)\n\t =  HappyAbsSyn16\n\t\t (happy_var_1\n\t)\nhappyReduction_48 _  = notHappyAtAll \n\nhappyReduce_49 = happySpecReduce_3 17 happyReduction_49\nhappyReduction_49 (HappyAbsSyn17  happy_var_3)\n\t_\n\t(HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn17\n\t\t (C_Lstactpars_1 happy_var_1 happy_var_3\n\t)\nhappyReduction_49 _ _ _  = notHappyAtAll \n\nhappyReduce_50 = happySpecReduce_1 17 happyReduction_50\nhappyReduction_50 (HappyAbsSyn13  happy_var_1)\n\t =  HappyAbsSyn17\n\t\t (C_Lstactpars_1 happy_var_1 C_Emptyactpars_1\n\t)\nhappyReduction_50 _  = notHappyAtAll \n\nhappyReduce_51 = happySpecReduce_1 18 happyReduction_51\nhappyReduction_51 (HappyTerminal (TIdent happy_var_1))\n\t =  HappyAbsSyn18\n\t\t (C_Ident_1 happy_var_1\n\t)\nhappyReduction_51 _  = notHappyAtAll \n\nhappyNewToken action sts stk [] =\n\taction 54 54 (error \"reading EOF!\") (HappyState action) sts stk []\n\nhappyNewToken action sts stk (tk:tks) =\n\tlet cont i = action i i tk (HappyState action) sts stk tks in\n\tcase tk of {\n\tTsemicolon -> cont 19;\n\tTopenB -> cont 20;\n\tTcloseB -> cont 21;\n\tTopenSB -> cont 22;\n\tTcloseSB -> cont 23;\n\tTopenCB -> cont 24;\n\tTcloseCB -> cont 25;\n\tTtowdots -> cont 26;\n\tTcomma -> cont 27;\n\tTequal -> cont 28;\n\tTand -> cont 29;\n\tTor -> cont 30;\n\tTassing -> cont 31;\n\tTadd -> cont 32;\n\tTmul -> cont 33;\n\tTsub -> cont 34;\n\tTdiv -> cont 35;\n\tTgt -> cont 36;\n\tTlt -> cont 37;\n\tTnot -> cont 38;\n\tTtrue -> cont 39;\n\tTfalse -> cont 40;\n\tTint -> cont 41;\n\tTreal -> cont 42;\n\tTbool -> cont 43;\n\tTchar -> cont 44;\n\tTif -> cont 45;\n\tTthen -> cont 46;\n\tTelse -> cont 47;\n\tTwhile -> cont 48;\n\tTinput -> cont 49;\n\tTprint -> cont 50;\n\tTIdent happy_dollar_dollar -> cont 51;\n\tTintVal happy_dollar_dollar -> cont 52;\n\tTrealVal happy_dollar_dollar -> cont 53;\n\t}\n\nhappyThen = \\m k -> k m\nhappyReturn = \\a -> a\nhappyThen1 = happyThen\nhappyReturn1 = \\a tks -> a\n\nparser tks = happyThen (happyParse action_0 tks) (\\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll })\n\nhappySeq = happyDontSeq\n\n-- happyError :: [Token] -> a\nhappyError _ = error (\"Parse error in line \\n\")\n\n\n\n-- runParser :: String -> Error\nrunParser = parser . lexer\n\n\ntestParser :: String -> IO()\ntestParser filename \n = do s <- readFile filename\n      let tks = lexer s\n      putStr (show tks)\n      let ast = parser tks\n      putStr (show ast)\n      return () -- (scanner inp)\n{-# LINE 1 \"GenericTemplate.hs\" #-}\n-- $Id: Funcs_Parser_Lazy.hs,v 1.1 2002/11/19 17:00:02 simonpj Exp $\n\n{-# LINE 15 \"GenericTemplate.hs\" #-}\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\ninfixr 9 `HappyStk`\ndata HappyStk a = HappyStk a (HappyStk a)\n\n-----------------------------------------------------------------------------\n-- starting the parse\n\nhappyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll\n\n-----------------------------------------------------------------------------\n-- Accepting the parse\n\nhappyAccept j tk st sts (HappyStk ans _) = \n\n\t\t\t\t\t   (happyReturn1 ans)\n\n-----------------------------------------------------------------------------\n-- Arrays only: do the next action\n\n{-# LINE 150 \"GenericTemplate.hs\" #-}\n\n\n-----------------------------------------------------------------------------\n-- HappyState data type (not arrays)\n\n\n\nnewtype HappyState b c = HappyState\n        (Int ->                    -- token number\n         Int ->                    -- token number (yes, again)\n         b ->                           -- token semantic value\n         HappyState b c ->              -- current state\n         [HappyState b c] ->            -- state stack\n         c)\n\n\n\n-----------------------------------------------------------------------------\n-- Shifting a token\n\nhappyShift new_state (1) tk st sts stk@(x `HappyStk` _) =\n     let i = (case x of { HappyErrorToken (i) -> i }) in\n--     trace \"shifting the error token\" $\n     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)\n\nhappyShift new_state i tk st sts stk =\n     happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)\n\n-- happyReduce is specialised for the common cases.\n\nhappySpecReduce_0 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk\n     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)\n\nhappySpecReduce_1 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')\n     = let r = fn v1 in\n       happySeq r (action nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_2 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')\n     = let r = fn v1 v2 in\n       happySeq r (action nt j tk st sts (r `HappyStk` stk'))\n\nhappySpecReduce_3 i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')\n     = let r = fn v1 v2 v3 in\n       happySeq r (action nt j tk st sts (r `HappyStk` stk'))\n\nhappyReduce k i fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappyReduce k nt fn j tk st sts stk\n     = case happyDrop (k - ((1) :: Int)) sts of\n\t sts1@(((st1@(HappyState (action))):(_))) ->\n        \tlet r = fn stk in  -- it doesn't hurt to always seq here...\n       \t\thappyDoSeq r (action nt j tk st1 sts1 r)\n\nhappyMonadReduce k nt fn (1) tk st sts stk\n     = happyFail (1) tk st sts stk\nhappyMonadReduce k nt fn j tk st sts stk =\n        happyThen1 (fn stk) (\\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))\n       where sts1@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts))\n             drop_stk = happyDropStk k stk\n\nhappyDrop (0) l = l\nhappyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t\n\nhappyDropStk (0) l = l\nhappyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs\n\n-----------------------------------------------------------------------------\n-- Moving to a new state after a reduction\n\n\n\n\n\n\n\n\n\nhappyGoto action j tk st = action j j tk (HappyState action)\n\n\n-----------------------------------------------------------------------------\n-- Error recovery ((1) is the error token)\n\n-- parse error if we are in recovery and we fail again\nhappyFail  (1) tk old_st _ stk =\n--\ttrace \"failing\" $ \n    \thappyError\n\n\n{-  We don't need state discarding for our restricted implementation of\n    \"error\".  In fact, it can cause some bogus parses, so I've disabled it\n    for now --SDM\n\n-- discard a state\nhappyFail  (1) tk old_st (((HappyState (action))):(sts)) \n\t\t\t\t\t\t(saved_tok `HappyStk` _ `HappyStk` stk) =\n--\ttrace (\"discarding state, depth \" ++ show (length stk))  $\n\taction (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))\n-}\n\n-- Enter error recovery: generate an error token,\n--                       save the old token and carry on.\nhappyFail  i tk (HappyState (action)) sts stk =\n--      trace \"entering error recovery\" $\n\taction (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk)\n\n-- Internal happy errors:\n\nnotHappyAtAll = error \"Internal Happy error\\n\"\n\n-----------------------------------------------------------------------------\n-- Hack to get the typechecker to accept our action functions\n\n\n\n\n\n\n\n-----------------------------------------------------------------------------\n-- Seq-ing.  If the --strict flag is given, then Happy emits \n--\thappySeq = happyDoSeq\n-- otherwise it emits\n-- \thappySeq = happyDontSeq\n\nhappyDoSeq, happyDontSeq :: a -> b -> b\nhappyDoSeq   a b = a `seq` b\nhappyDontSeq a b = b\n\n-----------------------------------------------------------------------------\n-- Don't inline any functions from the template.  GHC has a nasty habit\n-- of deciding to inline happyGoto everywhere, which increases the size of\n-- the generated parser quite a bit.\n\n\n\n\n\n\n\n\n\n{-# NOINLINE happyShift #-}\n{-# NOINLINE happySpecReduce_0 #-}\n{-# NOINLINE happySpecReduce_1 #-}\n{-# NOINLINE happySpecReduce_2 #-}\n{-# NOINLINE happySpecReduce_3 #-}\n{-# NOINLINE happyReduce #-}\n{-# NOINLINE happyMonadReduce #-}\n{-# NOINLINE happyGoto #-}\n{-# NOINLINE happyFail #-}\n\n-- end of Happy Template.\n", "num_lines": 1549}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- \n--                  Lrc Prelude for Haskell/Gofer \n-- \n--\n-- by Jo\u00e3o Saraiva\n-- Mon Mar  5\n--\n\nmodule LrcPrelude  where\n\n\ntype INT  = Integer\ntype BOOL = Bool\ntype STR  = String\ntype CHAR = Char\ntype REAL = Float\n\n\nlrc_REALtoSTR r = show r\nlrc_INTtoSTR i = show i\nsf_INTtoSTR i = show i\n\ndata BTree a  = Fork !a !(BTree a) !(BTree a)\n              | Nil \n              deriving (Show, Eq , Ord)\n\nlrc_tree_insert a b Nil = (Fork (a,b) Nil Nil)\nlrc_tree_insert a b (Fork (c,d) l r) \n        | a < c  = (Fork (c,d) (lrc_tree_insert a b l) r)\n        | a == c = (Fork (a,b) l r)\n        | a > c  = (Fork (c,d) l (lrc_tree_insert a b r))\n\ntype MAP a b = (BTree (a,b),b)\n\nlrc_empty_map :: a -> (MAP b a)\nlrc_empty_map a = (Nil , a)\n\nlrc_map_single_update :: (Eq a , Ord a) => a -> b -> (MAP a b) -> (MAP a b)\nlrc_map_single_update a b (t,d)     = ((lrc_tree_insert a b t),d) \n\nlrc_map_application :: (Eq a , Ord a) => a -> (MAP a b) -> b\nlrc_map_application a (Nil, b)                    = b\nlrc_map_application a ((Fork (b,c) l r),d)\n      | a == b = c\n      | a < b  = lrc_map_application a (l,d)\n      | a > b  = lrc_map_application a (r,d)\n\n\nlrc_map_in :: (Eq a , Ord a) => a -> (MAP a b) -> Bool\nlrc_map_in _ (Nil, _)                             = False\nlrc_map_in a ((Fork (b,c) l r),d)\n      | a == b = True\n      | a < b  = lrc_map_in a (l,d)\n      | a > b  = lrc_map_in a (r,d)\n\nlrc_map_update :: (Eq a , Ord a) => (MAP a b) -> (MAP a b) -> (MAP a b)\nlrc_map_update e1 e2 = e1   -- XXXXXXXXXXXXXXXX\n\n\nlrc_string_index :: String -> Int -> Char\nlrc_string_index s i = s!!i\n\n\nlrc_string_sub :: String -> Int -> Int -> String\nlrc_string_sub s i1 i2 = s\n\nlrc_string_opensub s i = s\n\nlrc_strindex s c = 0\n\nrepeatCHAR :: a -> Integer -> [a]\nrepeatCHAR c i = replicate  (fromIntegral i) c\n", "num_lines": 73}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport System.Environment\n\nimport LrcPrelude\nimport Funcs_Parser_Lazy\n\nimport Data_Lazy\nimport Visfun_Lazy\n\n\n-- runSemantics :: String -> [BibEntry]\nrunSemantics inp pw = lrcEval (runParser inp) pw\n\n\nrunEval fn pw\n  = do s <- readFile fn\n       let (code,errors,te,pp) = runSemantics s pw\n       \n       putStrLn \"Pretty Printed Input:\"    \n       putStrLn pp\n       putStrLn \"MSP Generated Code:\"\n       putStrLn (showCode code)\n\n       putStrLn \"Detected Semantic Errors:\"\n       putStrLn (show errors)\n       putStrLn (show te)     \n\n--       putStrLn pp_code\n       return ()\n\nmain :: IO ()\nmain = do args <- getArgs \n          putStrLn (show args)\n          let fn = head args\n          let pw = mytoint (head . tail $ args)\n          runEval fn pw\n\nmytoint :: String -> Integer\nmytoint s = read s\n\n\nshowCode []     = \"\\n\"\nshowCode (x:xs) = (showInstr x) ++ \"\\n\" ++ (showCode xs)\n\nshowInstr (C_ALabel_1 n) = (show n) ++ \":\"\nshowInstr C_Add_1        = \"ADD\"\nshowInstr C_And_1        = \"AND\"\nshowInstr (C_Call_1 n)   = \"CALL \" ++ (showName n)\nshowInstr C_Cod_1        = \"CODIGO\"\nshowInstr C_Data_1       = \"MEMORIA DE DADOS\"\nshowInstr C_Div_1        = \"DIV\"\nshowInstr C_Eq_1         = \"EQ\"\nshowInstr C_Gt_1         = \"GT\"\nshowInstr C_Halt_1       = \"HALT\"\nshowInstr C_IIn_1        = \"IN\"\nshowInstr C_IOut_1       = \"OUT\"\nshowInstr (C_Jump_1 n)   = \"JMP \" ++ (showName n)\nshowInstr (C_Jumpf_1 n)  = \"JMPF \" ++  (showName n)\nshowInstr C_Load_1       = \"LOAD\"\nshowInstr C_Lt_1         = \"LT\"\nshowInstr C_Minus_1      = \"MIN\"\nshowInstr C_Mul_1        = \"MUL\"\nshowInstr C_Neq_1        = \"NEQ\"\nshowInstr C_Not_1        = \"NOT\"\nshowInstr C_Or_1         = \"OR\"\nshowInstr (C_Pusha_1 n i) =  \"PUSHa \" ++ (showName n) ++ \" \" ++ (show i)\nshowInstr (C_Pushb_1 b)  = \"PUSHb \" ++ (show b)\nshowInstr (C_Pushi_1 i)  = \"PUSHi \" ++ (show i)\nshowInstr (C_Pushr_1 r)  = \"PUSHr \" ++ (show r)\nshowInstr C_Ret_1        = \"RET\"\nshowInstr C_Store_1      = \"STORE\"\nshowInstr C_Sub_1        = \"SUB\"\nshowInstr (C_Var_1 n i t) = (showName n) ++ \"  TAM \" ++ (show i)\n\n\nshowName (C_Ident_1 n) = show n\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Visfun_Lazy where\nimport Data_Lazy\nimport LrcPrelude\n--\n-- Lazy Circular Evaluator Functions\n--\nlrcEval = visit_P\nvisit_P (C_RootProd_1 t_Defs ) x_pw = (x_code , x_errlst , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = x_fmts_2\n      x_typeerrors = x_typeerrors_1\n      x_errlst = x_errlst_1\n      x_code = ((((:) C_Data_1 (gen_data_mem x_declsout_1))++x_declscode_1)++(((:) C_Cod_1 (genCodeMainFun ))++x_code_1))\n      x_infun_1 = 0\n      x_env_1 = x_declsout_1\n      x_declsin_1 = (lrc_empty_map (C_EmptyEntry_1 ))\n      x_pw_2 = x_pw\n      t_uu_pp = (C_Best_1 x_uu_pp_1)\n      (x_code_1 , x_declscode_1 , x_declsout_1 , x_errlst_1 , x_outfun_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Defs t_Defs x_declsin_1 x_env_1 x_infun_1\n      (x_fmts_2 ) = visit_PPRoot t_uu_pp x_pw_2\nvisit_Defs (C_Defs2_1 t_Def t_Defs_2 ) x_declsin x_env x_infun = (x_code , x_declscode , x_declsout , x_errlst , x_outfun , x_typeerrors , x_uu_pp )\n  where\n      x_infun_2 = x_outfun_1\n      x_env_2 = x_env\n      x_declsin_2 = x_declsout_1\n      x_uu_pp = (C_Above_1 x_uu_pp_1 x_uu_pp_2)\n      x_typeerrors = (x_typeerrors_1++x_typeerrors_2)\n      x_outfun = x_outfun_2\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_declsout = x_declsout_2\n      x_declscode = (x_declscode_1++x_declscode_2)\n      x_code = (x_code_1++x_code_2)\n      x_infun_1 = x_infun\n      x_env_1 = x_env\n      x_declsin_1 = x_declsin\n      (x_code_1 , x_declscode_1 , x_declsout_1 , x_errlst_1 , x_outfun_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Def t_Def x_declsin_1 x_env_1 x_infun_1\n      (x_code_2 , x_declscode_2 , x_declsout_2 , x_errlst_2 , x_outfun_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Defs t_Defs_2 x_declsin_2 x_env_2 x_infun_2\nvisit_Defs (C_NoDefs_1 ) x_declsin x_env x_infun = (x_code , x_declscode , x_declsout , x_errlst , x_outfun , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Empty_1 )\n      x_typeerrors = ([] )\n      x_outfun = x_infun\n      x_errlst = ([] )\n      x_declsout = x_declsin\n      x_declscode = ([] )\n      x_code = ([] )\nvisit_Def (C_Arraydecl_1 t_Type t_Name t_INT ) x_declsin x_env x_infun = (x_code , x_declscode , x_declsout , x_errlst , x_outfun , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 (ppType t_Type) (C_Beside_1 (C_Text_1 \" = \") (C_Beside_1 (ppName t_Name) (C_Text_1 ((\"[\"++(lrc_INTtoSTR t_INT))++\"]\")))))\n      x_typeerrors = ([] )\n      x_outfun = x_infun\n      x_errlst = (if (lrc_map_in t_Name x_declsin) then ((:) (C_E_Name_AD_1 t_Name) ([] )) else ([] ))\n      x_declsout = (if (lrc_map_in t_Name x_declsin) then x_declsin else (lrc_map_single_update t_Name (C_Consarray_1 t_Type t_INT x_infun) x_declsin))\n      x_declscode = ((:) (C_Var_1 (C_Ident_1 ((nametoSTR t_Name)++(lrc_INTtoSTR x_infun))) t_INT t_Type) ([] ))\n      x_code = ([] )\nvisit_Def (C_Declfunc_1 t_Type t_Name t_FormPars t_Stats ) x_declsin x_env x_infun = (x_code , x_declscode , x_declsout , x_errlst , x_outfun , x_typeerrors , x_uu_pp )\n  where\n      x_nlabeli_4 = 1\n      x_infun_4 = (x_infun+1)\n      x_fid_4 = t_Name\n      x_envi_4 = x_env\n      x_uu_pp = (func_def_a_la_c (ppType t_Type) (ppName t_Name) x_uu_pp_3 x_uu_pp_4)\n      x_typeerrors = x_typeerrors_4\n      x_outfun = (x_infun+1)\n      x_errlst = (x_err_aux++x_errlst_4)\n      x_declsout = (if (lrc_map_in t_Name x_declsin) then x_declsin else (lrc_map_single_update t_Name (C_Consfunc_1 t_Type x_infun x_lst_params_3) x_declsin))\n      x_declscode = (((:) (C_Var_1 (C_Ident_1 ((nametoSTR t_Name)++(lrc_INTtoSTR x_infun))) 1 t_Type) (gen_code_func x_infun_4 x_lst_params_3))++x_declscode_4)\n      x_code = (((:) (C_ALabel_1 t_Name) x_code_4)++((:) (C_Ret_1 ) []))\n      x_error = (if (lrc_map_in t_Name x_declsin) then \"\" else \" <- id already defined!\")\n      x_err_aux = (if (lrc_map_in t_Name x_declsin) then ((:) (C_E_Name_AD_1 t_Name) x_errlst_3) else x_errlst_3)\n      (x_errlst_3 , x_lst_params_3 , x_uu_pp_3 ) = visit_FormPars t_FormPars\n      (x_code_4 , x_declscode_4 , x_envo_4 , x_errlst_4 , x_nlabelo_4 , x_typeerrors_4 , x_uu_pp_4 ) = visit_Stats t_Stats x_envi_4 x_fid_4 x_infun_4 x_nlabeli_4\nvisit_Def (C_Declfunc_header_1 t_Type t_Name t_FormPars t_Stats ) x_declsin x_env x_infun = (x_code , x_declscode , x_declsout , x_errlst , x_outfun , x_typeerrors , x_uu_pp )\n  where\n      x_nlabeli_4 = 1\n      x_infun_4 = (x_infun+1)\n      x_fid_4 = t_Name\n      x_envi_4 = x_env\n      x_uu_pp = (C_Empty_1 )\n      x_typeerrors = x_typeerrors_4\n      x_outfun = (x_infun+1)\n      x_errlst = (x_err_aux++x_errlst_4)\n      x_declsout = (if (lrc_map_in t_Name x_declsin) then x_declsin else (lrc_map_single_update t_Name (C_Consfunc_1 t_Type x_infun x_lst_params_3) x_declsin))\n      x_declscode = (((:) (C_Var_1 (C_Ident_1 ((nametoSTR t_Name)++(lrc_INTtoSTR x_infun))) 1 t_Type) (gen_code_func x_infun_4 x_lst_params_3))++x_declscode_4)\n      x_code = (((:) (C_ALabel_1 t_Name) x_code_4)++((:) (C_Ret_1 ) []))\n      x_error = (if (lrc_map_in t_Name x_declsin) then \"\" else \" <- id already defined!\")\n      x_err_aux = (if (lrc_map_in t_Name x_declsin) then ((:) (C_E_Name_AD_1 t_Name) x_errlst_3) else x_errlst_3)\n      (x_errlst_3 , x_lst_params_3 , x_uu_pp_3 ) = visit_FormPars t_FormPars\n      (x_code_4 , x_declscode_4 , x_envo_4 , x_errlst_4 , x_nlabelo_4 , x_typeerrors_4 , x_uu_pp_4 ) = visit_Stats t_Stats x_envi_4 x_fid_4 x_infun_4 x_nlabeli_4\nvisit_Def (C_Declfunc_header_novar_1 t_Type t_Name t_FormPars t_Stats ) x_declsin x_env x_infun = (x_code , x_declscode , x_declsout , x_errlst , x_outfun , x_typeerrors , x_uu_pp )\n  where\n      x_nlabeli_4 = 1\n      x_infun_4 = (x_infun+1)\n      x_fid_4 = t_Name\n      x_envi_4 = x_env\n      x_uu_pp = (C_Empty_1 )\n      x_typeerrors = x_typeerrors_4\n      x_outfun = (x_infun+1)\n      x_errlst = (x_err_aux++x_errlst_4)\n      x_declsout = (if (lrc_map_in t_Name x_declsin) then x_declsin else (lrc_map_single_update t_Name (C_Consfunc_1 t_Type x_infun x_lst_params_3) x_declsin))\n      x_declscode = (((:) (C_Var_1 (C_Ident_1 ((nametoSTR t_Name)++(lrc_INTtoSTR x_infun))) 1 t_Type) (gen_code_func x_infun_4 x_lst_params_3))++x_declscode_4)\n      x_code = (((:) (C_ALabel_1 t_Name) x_code_4)++((:) (C_Ret_1 ) []))\n      x_error = (if (lrc_map_in t_Name x_declsin) then \"\" else \" <- id already defined!\")\n      x_err_aux = (if (lrc_map_in t_Name x_declsin) then ((:) (C_E_Name_AD_1 t_Name) x_errlst_3) else x_errlst_3)\n      (x_errlst_3 , x_lst_params_3 , x_uu_pp_3 ) = visit_FormPars t_FormPars\n      (x_code_4 , x_declscode_4 , x_envo_4 , x_errlst_4 , x_nlabelo_4 , x_typeerrors_4 , x_uu_pp_4 ) = visit_Stats t_Stats x_envi_4 x_fid_4 x_infun_4 x_nlabeli_4\nvisit_Def (C_Vardecl_1 t_Type t_Name ) x_declsin x_env x_infun = (x_code , x_declscode , x_declsout , x_errlst , x_outfun , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 (ppType t_Type) (C_Beside_1 (C_Text_1 \" = \") (ppName t_Name)))\n      x_typeerrors = ([] )\n      x_outfun = x_infun\n      x_errlst = (if (lrc_map_in t_Name x_declsin) then ((:) (C_E_Name_AD_1 t_Name) ([] )) else ([] ))\n      x_declsout = (if (lrc_map_in t_Name x_declsin) then x_declsin else (lrc_map_single_update t_Name (C_Consvar_1 t_Type x_infun) x_declsin))\n      x_declscode = ((:) (C_Var_1 (C_Ident_1 ((nametoSTR t_Name)++(lrc_INTtoSTR x_infun))) 1 t_Type) ([] ))\n      x_code = ([] )\nvisit_Type (C_Booltype_1 ) = ()\nvisit_Type (C_Chartype_1 ) = ()\nvisit_Type (C_Errortype_1 ) = ()\nvisit_Type (C_Inttype_1 ) = ()\nvisit_Type (C_Realtype_1 ) = ()\nvisit_Name (C_Ident_1 t_STR ) = ()\nvisit_FormPars (C_Emptyformpars_1 ) = (x_errlst , x_lst_params , x_uu_pp )\n  where\n      x_uu_pp = (C_Text_1 \"\")\n      x_lst_params = ([] )\n      x_errlst = ([] )\nvisit_FormPars (C_Lstformpars_1 t_FormPar t_FormPars_2 ) = (x_errlst , x_lst_params , x_uu_pp )\n  where\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \",\") x_uu_pp_2))\n      x_lst_params = (x_one_param_1++x_lst_params_2)\n      x_errlst = (if (isinlst x_parname_1 x_lst_params_2) then ((:) (C_E_FormParam_AD_1 x_parname_1) x_errlst_2) else x_errlst_2)\n      (x_one_param_1 , x_parname_1 , x_uu_pp_1 ) = visit_FormPar t_FormPar\n      (x_errlst_2 , x_lst_params_2 , x_uu_pp_2 ) = visit_FormPars t_FormPars_2\nvisit_FormPar (C_Declformpar_1 t_Type t_Name ) = (x_one_param , x_parname , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 (ppType t_Type) (C_Beside_1 (C_Text_1 \" \") (ppName t_Name)))\n      x_parname = t_Name\n      x_one_param = ((:) (C_AParam_1 t_Type t_Name) ([] ))\nvisit_Stats (C_Emptystat_1 ) x_envi x_fid x_infun x_nlabeli = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Empty_1 )\n      x_typeerrors = ([] )\n      x_nlabelo = x_nlabeli\n      x_errlst = ([] )\n      x_envo = x_envi\n      x_declscode = ([] )\n      x_code = []\nvisit_Stats (C_Lststats_1 t_Stat t_Stats_2 ) x_envi x_fid x_infun x_nlabeli = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_nlabeli_2 = x_nlabelo_1\n      x_infun_2 = x_infun\n      x_fid_2 = x_fid\n      x_envi_2 = x_envo_1\n      x_uu_pp = (C_Above_1 (C_Beside_1 x_uu_pp_1 (C_Text_1 \";\")) x_uu_pp_2)\n      x_typeerrors = (x_typeerrors_1++x_typeerrors_2)\n      x_nlabelo = x_nlabelo_2\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_envo = x_envo_2\n      x_declscode = (x_declscode_1++x_declscode_2)\n      x_code = (x_code_1++x_code_2)\n      x_upw_Stats_infun_1 = x_infun\n      x_nlabeli_1 = x_nlabeli\n      x_infun_1 = x_infun\n      x_fid_1 = x_fid\n      x_envi_1 = x_envi\n      (x_code_1 , x_declscode_1 , x_envo_1 , x_errlst_1 , x_nlabelo_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Stat t_Stat x_envi_1 x_fid_1 x_infun_1 x_nlabeli_1 x_upw_Stats_infun_1\n      (x_code_2 , x_declscode_2 , x_envo_2 , x_errlst_2 , x_nlabelo_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Stats t_Stats_2 x_envi_2 x_fid_2 x_infun_2 x_nlabeli_2\nvisit_Stat (C_ArrAssign_1 t_ArrayUse t_Exp ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 x_uu_pp_1 (C_Beside_1 (C_Text_1 \"[\") (C_Beside_1 x_uu_pp_2 (C_Beside_1 (C_Text_1 \"] = \") x_uu_pp_2))))\n      x_typeerrors = (if (typecheck x_an_1 x_type_2 x_fid x_envi) then x_typeerrors_2 else ((:) (C_E_T_DT_1 x_an_1) x_typeerrors_2))\n      x_nlabelo = x_nlabeli\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_envo = x_envi\n      x_declscode = ([] )\n      x_code = (x_code_1++x_code_2)\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_envi\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_envi\n      (x_an_1 , x_code_1 , x_errlst_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_ArrayUse t_ArrayUse x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Stat (C_Assign_1 t_Name t_Exp ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 (ppName t_Name) (C_Beside_1 (C_Text_1 \" = \") x_uu_pp_2))\n      x_typeerrors = (if (x_typerr==(C_NoTypeError_1 )) then x_typeerrors_2 else ((:) x_typerr x_typeerrors_2))\n      x_nlabelo = x_nlabeli\n      x_errlst = (if (isinenv t_Name x_fid x_envi) then x_errlst_2 else ((:) (C_E_Name_ND_1 t_Name) x_errlst_2))\n      x_envo = x_envi\n      x_declscode = ([] )\n      x_code = (((:) (C_Pusha_1 t_Name x_infun) x_code_2)++((:) (C_Store_1 ) ([] )))\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_envi\n      x_typerr = (assign_InfType t_Name x_type_2 x_fid x_envi)\n      x_error = (if (isinenv t_Name x_fid x_envi) then ([] ) else ((:) (C_E_Name_ND_1 t_Name) ([] )))\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Stat (C_Funccall_1 t_Name t_ActPars ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (funccall (ppName t_Name) x_uu_pp_2)\n      x_typeerrors = (checkactparams t_Name x_act_params_2 x_envi)\n      x_nlabelo = x_nlabeli\n      x_errlst = (if (lrc_map_in t_Name x_envi) then x_errlst_2 else ((:) (C_E_Fun_ND_1 t_Name) x_errlst_2))\n      x_envo = x_envi\n      x_declscode = ([] )\n      x_code = (gen_code_func_inv t_Name x_envi x_code_2)\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_envi\n      x_error = (if (lrc_map_in t_Name x_envi) then ([] ) else ((:) (C_E_Fun_ND_1 t_Name) ([] )))\n      (x_act_params_2 , x_code_2 , x_errlst_2 , x_uu_pp_2 ) = visit_ActPars t_ActPars x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Stat (C_If_t_e_1 t_Exp t_Stats t_Stats_2 ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_nlabeli_3 = (x_nlabeli+1)\n      x_infun_3 = x_infun\n      x_fid_3 = x_fid\n      x_envi_3 = x_envi\n      x_nlabeli_2 = x_nlabelo_3\n      x_infun_2 = x_infun\n      x_fid_2 = x_fid\n      x_envi_2 = x_envi\n      x_uu_pp = (if_t_ePP x_uu_pp_1 x_uu_pp_2 x_uu_pp_3)\n      x_typeerrors = (if (x_typerr==(C_NoTypeError_1 )) then ((x_typeerrors_1++x_typeerrors_2)++x_typeerrors_3) else ((:) x_typerr ((x_typeerrors_1++x_typeerrors_2)++x_typeerrors_3)))\n      x_nlabelo = x_nlabelo_2\n      x_errlst = ((x_errlst_1++x_errlst_2)++x_errlst_3)\n      x_envo = x_envi\n      x_declscode = (x_declscode_2++x_declscode_3)\n      x_code = (gen_code_ite x_nlabeli x_code_1 x_code_2 x_code_3)\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_envi\n      x_typerr = (if (isboolexp x_type_1) then (C_NoTypeError_1 ) else (C_E_T_if_t_e_1 ))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_declscode_2 , x_envo_2 , x_errlst_2 , x_nlabelo_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Stats t_Stats x_envi_2 x_fid_2 x_infun_2 x_nlabeli_2\n      (x_code_3 , x_declscode_3 , x_envo_3 , x_errlst_3 , x_nlabelo_3 , x_typeerrors_3 , x_uu_pp_3 ) = visit_Stats t_Stats_2 x_envi_3 x_fid_3 x_infun_3 x_nlabeli_3\nvisit_Stat (C_Input_1 t_Name ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 (C_Text_1 \"input \") (ppName t_Name))\n      x_typeerrors = ([] )\n      x_nlabelo = x_nlabeli\n      x_errlst = (if (isinenv t_Name x_fid x_envi) then ([] ) else ((:) (C_E_Name_ND_1 t_Name) ([] )))\n      x_envo = x_envi\n      x_declscode = ([] )\n      x_code = ((:) (C_Pusha_1 t_Name x_upw_Stats_infun) ((:) (C_IIn_1 ) ((:) (C_Store_1 ) ([] ))))\nvisit_Stat (C_LocalDecl_1 t_Type t_Name ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 (ppType t_Type) (C_Beside_1 (C_Text_1 \" \") (ppName t_Name)))\n      x_typeerrors = ([] )\n      x_nlabelo = x_nlabeli\n      x_errlst = (if (lrc_map_in t_Name x_envi) then ((:) (C_E_Loc_Name_AD_1 t_Name) ([] )) else ([] ))\n      x_envo = (if (lrc_map_in t_Name x_envi) then x_envi else (lrc_map_single_update t_Name (C_Consvar_1 t_Type x_infun) x_envi))\n      x_declscode = ((:) (C_Var_1 t_Name x_infun t_Type) ([] ))\n      x_code = ([] )\nvisit_Stat (C_Print_1 t_Exp ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Beside_1 (C_Text_1 \"print \") x_uu_pp_1)\n      x_typeerrors = x_typeerrors_1\n      x_nlabelo = x_nlabeli\n      x_errlst = x_errlst_1\n      x_envo = x_envi\n      x_declscode = ([] )\n      x_code = (x_code_1++((:) (C_IOut_1 ) ([] )))\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_envi\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp x_env_1 x_fid_1 x_upw_Stats_infun_1\nvisit_Stat (C_While_1 t_Exp t_Stats ) x_envi x_fid x_infun x_nlabeli x_upw_Stats_infun = (x_code , x_declscode , x_envo , x_errlst , x_nlabelo , x_typeerrors , x_uu_pp )\n  where\n      x_nlabeli_2 = (x_nlabeli+1)\n      x_infun_2 = x_infun\n      x_fid_2 = x_fid\n      x_envi_2 = x_envi\n      x_uu_pp = (whilePP (C_Text_1 \"while \") x_uu_pp_1 x_uu_pp_2)\n      x_typeerrors = (if (x_typerr==(C_NoTypeError_1 )) then (x_typeerrors_1++x_typeerrors_2) else ((:) x_typerr (x_typeerrors_1++x_typeerrors_2)))\n      x_nlabelo = x_nlabelo_2\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_envo = x_envi\n      x_declscode = x_declscode_2\n      x_code = (gen_code_while x_nlabeli x_code_1 x_code_2)\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_envi\n      x_typerr = (if (isboolexp x_type_1) then (C_NoTypeError_1 ) else (C_E_T_while_1 ))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_declscode_2 , x_envo_2 , x_errlst_2 , x_nlabelo_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Stats t_Stats x_envi_2 x_fid_2 x_infun_2 x_nlabeli_2\nvisit_ArrayUse (C_ArrayInd_1 t_Name t_Exp ) x_env x_fid x_upw_Stats_infun = (x_an , x_code , x_errlst , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_uu_pp = (C_Beside_1 (ppName t_Name) (C_Beside_1 (C_Text_1 \"[\") (C_Beside_1 x_uu_pp_2 (C_Text_1 \"]\"))))\n      x_typeerrors = (if (isinttype x_type_2) then x_typeerrors_2 else ((:) (C_E_T_IndArrNotInt_1 ) x_typeerrors_2))\n      x_errlst = (if x_noerror then x_errlst_2 else ((:) (C_E_Name_ND_1 t_Name) x_errlst_2))\n      x_code = x_code_2\n      x_an = t_Name\n      x_noerror = (isinenv t_Name x_fid x_env)\n      x_error = (if x_noerror then ([] ) else ((:) (C_E_Name_ND_1 t_Name) ([] )))\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_AddExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" + \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 1 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Add_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_AndExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" && \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 2 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_And_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_DivExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" / \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 1 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Div_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_EqExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" == \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 2 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Eq_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_Factor_1 t_Fac ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = x_uu_pp_1\n      x_typeerrors = x_typeerrors_1\n      x_type = x_type_1\n      x_errlst = x_errlst_1\n      x_code = x_code_1\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Fac t_Fac x_env_1 x_fid_1 x_upw_Stats_infun_1\nvisit_Exp (C_GTExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" > \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 2 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Gt_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_LTExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" < \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 2 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Lt_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_MinExp_1 t_Exp_2 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (C_Beside_1 (C_Text_1 \" - \") x_uu_pp_1)\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_NotArithExp_1 ) x_typeerrors_1) else x_typeerrors_1)\n      x_type = (if (isaritmexp x_type_1) then x_type_1 else (C_Errortype_1 ))\n      x_errlst = x_errlst_1\n      x_code = (x_code_1++((:) (C_Minus_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\nvisit_Exp (C_MulExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" * \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 1 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Mul_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_NotExp_1 t_Exp_2 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (C_Beside_1 (C_Text_1 \" ! \") x_uu_pp_1)\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_NotBooleanExp_1 ) x_typeerrors_1) else x_typeerrors_1)\n      x_type = (if (isboolexp x_type_1) then x_type_1 else (C_Errortype_1 ))\n      x_errlst = x_errlst_1\n      x_code = (x_code_1++((:) (C_Not_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\nvisit_Exp (C_OrExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" || \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 2 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Or_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Exp (C_SubExp_1 t_Exp_2 t_Exp_3 ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_uu_pp = (hv x_uu_pp_1 (C_Beside_1 (C_Text_1 \" - \") x_uu_pp_2))\n      x_typeerrors = (if (x_type==(C_Errortype_1 )) then ((:) (C_E_T_BOP_1 ) (x_typeerrors_1++x_typeerrors_2)) else (x_typeerrors_1++x_typeerrors_2))\n      x_type = (infType 1 x_type_1 x_type_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((x_code_1++x_code_2)++((:) (C_Sub_1 ) ([] )))\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp_2 x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_code_2 , x_errlst_2 , x_type_2 , x_typeerrors_2 , x_uu_pp_2 ) = visit_Exp t_Exp_3 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Fac (C_ArrayConst_1 t_ArrayUse ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = x_uu_pp_1\n      x_typeerrors = x_typeerrors_1\n      x_type = (gettype x_an_1 x_fid x_env)\n      x_errlst = x_errlst_1\n      x_code = x_code_1\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      (x_an_1 , x_code_1 , x_errlst_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_ArrayUse t_ArrayUse x_env_1 x_fid_1 x_upw_Stats_infun_1\nvisit_Fac (C_BoolConst_1 t_BOOL ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Text_1 (if t_BOOL then \"true\" else \"false\") )\n      x_typeerrors = ([] )\n      x_type = (C_Booltype_1 )\n      x_errlst = ([] )\n      x_code = ((:) (C_Pushb_1 t_BOOL) ([] ))\nvisit_Fac (C_CNIdent_1 t_Name ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (ppName t_Name)\n      x_typeerrors = ([] )\n      x_type = (gettype t_Name x_fid x_env)\n      x_errlst = (if (isinenv t_Name x_fid x_env) then ([] ) else ((:) (C_E_Name_ND_1 t_Name) ([] )))\n      x_code = ((:) (C_Pusha_1 t_Name x_upw_Stats_infun) ((:) (C_Load_1 ) ([] )))\nvisit_Fac (C_Expr_1 t_Exp ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = x_uu_pp_1\n      x_typeerrors = x_typeerrors_1\n      x_type = x_type_1\n      x_errlst = x_errlst_1\n      x_code = x_code_1\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp x_env_1 x_fid_1 x_upw_Stats_infun_1\nvisit_Fac (C_Funcinv_1 t_Name t_ActPars ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (funccall (ppName t_Name) x_uu_pp_2)\n      x_typeerrors = (checkactparams t_Name x_act_params_2 x_env)\n      x_type = (gettype t_Name x_fid x_env)\n      x_errlst = (x_error++x_errlst_2)\n      x_code = (gen_code_func_inv t_Name x_env x_code_2)\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_noerror = (lrc_map_in t_Name x_env)\n      x_error = (if x_noerror then ([] ) else ((:) (C_E_Fun_ND_1 t_Name) ([] )))\n      (x_act_params_2 , x_code_2 , x_errlst_2 , x_uu_pp_2 ) = visit_ActPars t_ActPars x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_Fac (C_IntConst_1 t_INT ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Text_1 (lrc_INTtoSTR t_INT))\n      x_typeerrors = ([] )\n      x_type = (C_Inttype_1 )\n      x_errlst = ([] )\n      x_code = ((:) (C_Pushi_1 t_INT) ([] ))\nvisit_Fac (C_RealConst_1 t_REAL ) x_env x_fid x_upw_Stats_infun = (x_code , x_errlst , x_type , x_typeerrors , x_uu_pp )\n  where\n      x_uu_pp = (C_Text_1 (lrc_REALtoSTR t_REAL))\n      x_typeerrors = ([] )\n      x_type = (C_Realtype_1 )\n      x_errlst = ([] )\n      x_code = ((:) (C_Pushr_1 t_REAL) ([] ))\nvisit_ActPars (C_Emptyactpars_1 ) x_env x_fid x_upw_Stats_infun = (x_act_params , x_code , x_errlst , x_uu_pp )\n  where\n      x_uu_pp = (C_Empty_1 )\n      x_errlst = ([] )\n      x_code = ([] )\n      x_act_params = ([] )\nvisit_ActPars (C_Lstactpars_1 t_Exp t_ActPars_2 ) x_env x_fid x_upw_Stats_infun = (x_act_params , x_code , x_errlst , x_uu_pp )\n  where\n      x_upw_Stats_infun_1 = x_upw_Stats_infun\n      x_fid_1 = x_fid\n      x_env_1 = x_env\n      x_upw_Stats_infun_2 = x_upw_Stats_infun\n      x_fid_2 = x_fid\n      x_env_2 = x_env\n      x_uu_pp = (hv x_uu_pp_1 x_uu_pp_2)\n      x_errlst = (x_errlst_1++x_errlst_2)\n      x_code = ((:) x_code_1 x_code_2)\n      x_act_params = ((:) x_type_1 x_act_params_2)\n      (x_code_1 , x_errlst_1 , x_type_1 , x_typeerrors_1 , x_uu_pp_1 ) = visit_Exp t_Exp x_env_1 x_fid_1 x_upw_Stats_infun_1\n      (x_act_params_2 , x_code_2 , x_errlst_2 , x_uu_pp_2 ) = visit_ActPars t_ActPars_2 x_env_2 x_fid_2 x_upw_Stats_infun_2\nvisit_PPRoot (C_All_1 t_PPS ) x_pw = (x_fmts )\n  where\n      x_frame_1 = (C_F_1 x_pw x_pw)\n      x_fmts = (eq_all_fmts x_pw x_fmts_1)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS x_frame_1\nvisit_PPRoot (C_Best_1 t_PPS ) x_pw = (x_fmts )\n  where\n      x_frame_1 = (C_F_1 x_pw x_pw)\n      x_fmts = (eq_best_fmts x_pw x_fmts_1)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS x_frame_1\nvisit_PPS :: PPS -> T_Frame -> (Bool, T_Formats, INT, Integer, Integer)\nvisit_PPS (C_Above_1 t_PPS_2 t_PPS_3 ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_frame_2 = x_frame\n      x_frame_1 = x_frame\n      x_minw = (max x_minw_1 x_minw_2)\n      x_minll = x_minll_2\n      x_maxh = (x_maxh_1+x_maxh_2)\n      x_fmts = (fst_Pair_T_Formats x_fe)\n      x_error = ((x_error_1||x_error_2)||x_aerror)\n      x_fe = (set_fmts_above x_fmts_1 x_fmts_2 x_maxh_1 x_maxh_2)\n      x_aerror = (snd_Pair_T_Formats x_fe)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS_2 x_frame_1\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 ) = visit_PPS t_PPS_3 x_frame_2\nvisit_PPS (C_Apply_1 t_PPC t_PPSArgs ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_reqs_2 = x_reqs_1\n      x_minw = (set_var_apply x_error_cond x_lem x_minw_1)\n      x_minll = (set_var_apply x_error_cond x_lem x_minll_1)\n      x_maxh = (set_var_apply x_error_cond 1 x_maxh_1)\n      x_fmts = (eq_set_fmts_apply x_error_cond x_error_msg x_fmts_1)\n      x_error = x_l_error\n      x_frame_1 = x_frame\n      x_fillmins_1 = x_mins_2\n      x_fillfmts_1 = x_fmts_2\n      x_fillerrs_1 = x_error_2\n      x_lem = (fromIntegral (length x_error_msg))\n      x_l_error = (if x_error_cond then True else x_error_1)\n      x_error_msg = (set_error_msg x_numpars_1 x_len_2)\n      x_error_cond = (x_numpars_1/=x_len_2)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 , x_numpars_1 , x_reqs_1 ) = visit_PPC t_PPC x_fillerrs_1 x_fillfmts_1 x_fillmins_1 x_frame_1\n      (x_error_2 , x_fmts_2 , x_len_2 , x_mins_2 ) = visit_PPSArgs t_PPSArgs x_reqs_2\nvisit_PPS (C_Beside_1 t_PPS_2 t_PPS_3 ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_frame_2 = (narrow_frame x_minll_1 x_frame)\n      x_frame_1 = (narrow_ll x_minw_2 x_frame)\n      x_minw = (max x_minw_1 (x_minll_1+x_minw_2))\n      x_minll = (x_minll_1+x_minll_2)\n      x_maxh = (beside_height x_maxh_1 x_maxh_2)\n      x_fmts = (fst_Pair_T_Formats x_fe)\n      x_error = (x_l_error||x_berror)\n      x_l_error = (x_error_1||x_error_2)\n      x_fe = (set_fmts_beside x_fmts_1 x_fmts_2 x_maxh_1 x_maxh_2 x_frame x_l_error)\n      x_berror = (snd_Pair_T_Formats x_fe)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS_2 x_frame_1\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 ) = visit_PPS t_PPS_3 x_frame_2\nvisit_PPS (C_Dup_1 t_PPS_2 t_PPS_3 ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_frame_2 = x_frame\n      x_frame_1 = x_frame\n      x_minw = x_l_minw\n      x_minll = (min x_minll_1 x_minll_2)\n      x_maxh = (max x_maxh_1 x_maxh_2)\n      x_fmts = (sem_fmts_dup x_fmts_1 x_fmts_2 x_error_1 x_error_2 x_l_minw)\n      x_error = x_l_error\n      x_l_minw = (min x_minw_1 x_minw_2)\n      x_l_error = (x_error_1 && x_error_2)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS_2 x_frame_1\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 ) = visit_PPS t_PPS_3 x_frame_2\nvisit_PPS (C_Empty_1 ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_minw = 0\n      x_minll = 0\n      x_maxh = 0\n      x_fmts = (set_fmts_empty )\n      x_error = False\nvisit_PPS (C_FillBlock_1 t_INT t_FillList ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_minw = x_minw_2\n      x_minll = x_minll_2\n      x_maxh = x_maxh_2\n      x_fmts = (set_fmts_fillblock t_INT x_fmts_2 x_l_pw)\n      x_error = (((t_INT<0)||(t_INT>x_l_pw))||x_error_2)\n      x_pw_2 = t_INT\n      x_minwi_2 = 0\n      x_minlli_2 = 0\n      x_maxhi_2 = 0\n      x_frame_2 = (C_F_1 t_INT t_INT)\n      x_fmtsi_2 = (empty_fmts )\n      x_errori_2 = False\n      x_l_pw = case x_frame of { (C_F_1 w _) -> w }\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 ) = visit_FillList t_FillList x_errori_2 x_fmtsi_2 x_frame_2 x_maxhi_2 x_minlli_2 x_minwi_2 x_pw_2\nvisit_PPS (C_Filla_1 t_FillList ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_minw = x_minw_1\n      x_minll = x_minll_1\n      x_maxh = x_maxh_1\n      x_fmts = (eq_set_fmts_fill x_fmts_1)\n      x_error = x_error_1\n      x_pw_1 = x_l_pw\n      x_minwi_1 = 0\n      x_minlli_1 = 0\n      x_maxhi_1 = 0\n      x_frame_1 = (C_F_1 x_l_pw x_l_pw)\n      x_fmtsi_1 = (empty_fmts )\n      x_errori_1 = False\n      x_l_pw = case x_frame of { (C_F_1 w _) -> w }\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_FillList t_FillList x_errori_1 x_fmtsi_1 x_frame_1 x_maxhi_1 x_minlli_1 x_minwi_1 x_pw_1\nvisit_PPS (C_Indent_1 t_INT t_PPS_2 ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_frame_2 = (narrow_frame t_INT x_frame)\n      x_minw = x_l_minw\n      x_minll = (t_INT+x_minll_2)\n      x_maxh = x_maxh_2\n      x_fmts = (set_fmts_indent t_INT x_fmts_2 x_pw x_l_minw x_frame x_error_2)\n      x_error = (((t_INT<0)||(t_INT>x_pw))||x_error_2)\n      x_pw = case x_frame of { (C_F_1 w _) -> w }\n      x_l_minw = (t_INT+x_minw_2)\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 ) = visit_PPS t_PPS_2 x_frame_2\nvisit_PPS (C_Join_1 t_PPS_2 ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_frame_1 = x_frame\n      x_minw = x_minw_1\n      x_minll = x_minll_1\n      x_maxh = x_maxh_1\n      x_fmts = (fst_Pair_T_Formats x_fe)\n      x_error = (x_error_1||x_jerror)\n      x_jerror = (snd_Pair_T_Formats x_fe)\n      x_fe = (set_fmts_join x_fmts_1 x_error_1)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS_2 x_frame_1\nvisit_PPS (C_Text_1 t_STR ) x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_minw = x_l_minw\n      x_minll = x_l_minw\n      x_maxh = 1\n      x_fmts = (set_fmts_text t_STR x_l_minw x_l_error)\n      x_error = x_l_error\n      x_pw = case x_frame of { (C_F_1 w _) -> w }\n      x_l_minw = (fromIntegral (length t_STR))\n      x_l_error = (x_l_minw>x_pw)\nvisit_PPC (C_AboveC_1 t_PPC_2 t_PPC_3 ) x_fillerrs x_fillfmts x_fillmins x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw , x_numpars , x_reqs )\n  where\n      x_frame_2 = x_frame\n      x_fillmins_2 = (snd_Pair_Lst_T_Mins x_i)\n      x_fillfmts_2 = (snd_Pair_Lst_T_Fmts x_m)\n      x_fillerrs_2 = (snd_Pair_Lst_T_Errs x_e)\n      x_frame_1 = x_frame\n      x_fillmins_1 = (fst_Pair_Lst_T_Mins x_i)\n      x_fillfmts_1 = (fst_Pair_Lst_T_Fmts x_m)\n      x_fillerrs_1 = (fst_Pair_Lst_T_Errs x_e)\n      x_reqs = (x_reqs_1++x_reqs_2)\n      x_numpars = (x_numpars_1+x_numpars_2)\n      x_minw = (max x_minw_1 x_minw_2)\n      x_minll = x_minll_2\n      x_maxh = (x_maxh_1+x_maxh_2)\n      x_fmts = (fst_Pair_T_Formats x_fe)\n      x_error = ((x_error_1||x_error_2)||x_aerror)\n      x_m = (splitAt_T_Fmts (fromIntegral x_numpars_1) x_fillfmts)\n      x_i = (splitAt_T_Mins (fromIntegral x_numpars_1) x_fillmins)\n      x_fe = (set_fmts_above x_fmts_1 x_fmts_2 x_maxh_1 x_maxh_2)\n      x_e = (splitAt_T_Errs (fromIntegral x_numpars_1) x_fillerrs)\n      x_aerror = (snd_Pair_T_Formats x_fe)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 , x_numpars_1 , x_reqs_1 ) = visit_PPC t_PPC_2 x_fillerrs_1 x_fillfmts_1 x_fillmins_1 x_frame_1\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 , x_numpars_2 , x_reqs_2 ) = visit_PPC t_PPC_3 x_fillerrs_2 x_fillfmts_2 x_fillmins_2 x_frame_2\nvisit_PPC (C_ApplyC_1 t_PPC_2 t_PPCArgs ) x_fillerrs x_fillfmts x_fillmins x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw , x_numpars , x_reqs )\n  where\n      x_ireqs_2 = x_reqs_1\n      x_ifillmins_2 = x_fillmins\n      x_ifillfmts_2 = x_fillfmts\n      x_ifillerrs_2 = x_fillerrs\n      x_frame_1 = x_frame\n      x_fillmins_1 = x_fillmins_2\n      x_fillfmts_1 = x_fmts_2\n      x_fillerrs_1 = x_error_2\n      x_reqs = x_reqs_2\n      x_numpars = x_numpars_2\n      x_minw = (set_var_apply x_error_cond x_lem x_minw_1)\n      x_minll = (set_var_apply x_error_cond x_lem x_minll_1)\n      x_maxh = (set_var_apply x_error_cond 1 x_maxh_1)\n      x_fmts = (eq_set_fmts_apply x_error_cond x_error_msg x_fmts_1)\n      x_error = x_l_error\n      x_lem = (fromIntegral (length x_error_msg))\n      x_l_error = (if x_error_cond then True else x_error_1)\n      x_error_msg = (set_error_msg x_numpars_1 x_len_2)\n      x_error_cond = (x_numpars_2/=x_len_2)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 , x_numpars_1 , x_reqs_1 ) = visit_PPC t_PPC_2 x_fillerrs_1 x_fillfmts_1 x_fillmins_1 x_frame_1\n      (x_error_2 , x_fillmins_2 , x_fmts_2 , x_len_2 , x_numpars_2 , x_reqs_2 ) = visit_PPCArgs t_PPCArgs x_ifillerrs_2 x_ifillfmts_2 x_ifillmins_2 x_ireqs_2\nvisit_PPC (C_BesideC_1 t_PPC_2 t_PPC_3 ) x_fillerrs x_fillfmts x_fillmins x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw , x_numpars , x_reqs )\n  where\n      x_frame_2 = (narrow_frame x_minll_1 x_frame)\n      x_fillmins_2 = (snd_Pair_Lst_T_Mins x_i)\n      x_fillfmts_2 = (snd_Pair_Lst_T_Fmts x_m)\n      x_fillerrs_2 = (snd_Pair_Lst_T_Errs x_e)\n      x_frame_1 = (narrow_ll x_minw_2 x_frame)\n      x_fillmins_1 = (fst_Pair_Lst_T_Mins x_i)\n      x_fillfmts_1 = (fst_Pair_Lst_T_Fmts x_m)\n      x_fillerrs_1 = (fst_Pair_Lst_T_Errs x_e)\n      x_reqs = (x_reqs_1++x_reqs_2)\n      x_numpars = (x_numpars_1+x_numpars_2)\n      x_minw = (max x_minw_1 (x_minll_1+x_minw_2))\n      x_minll = (x_minll_1+x_minll_2)\n      x_maxh = (beside_height x_maxh_1 x_maxh_2)\n      x_fmts = (fst_Pair_T_Formats x_fe)\n      x_error = (x_l_error||x_berror)\n      x_m = (splitAt_T_Fmts (fromIntegral x_numpars_1) x_fillfmts)\n      x_l_error = (x_error_1||x_error_2)\n      x_i = (splitAt_T_Mins (fromIntegral x_numpars_1) x_fillmins)\n      x_fe = (set_fmts_beside x_fmts_1 x_fmts_2 x_maxh_1 x_maxh_2 x_frame x_l_error)\n      x_e = (splitAt_T_Errs (fromIntegral x_numpars_1) x_fillerrs)\n      x_berror = (snd_Pair_T_Formats x_fe)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 , x_numpars_1 , x_reqs_1 ) = visit_PPC t_PPC_2 x_fillerrs_1 x_fillfmts_1 x_fillmins_1 x_frame_1\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 , x_numpars_2 , x_reqs_2 ) = visit_PPC t_PPC_3 x_fillerrs_2 x_fillfmts_2 x_fillmins_2 x_frame_2\nvisit_PPC (C_DupC_1 t_PPC_2 t_PPC_3 ) x_fillerrs x_fillfmts x_fillmins x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw , x_numpars , x_reqs )\n  where\n      x_frame_2 = x_frame\n      x_fillmins_2 = x_fillmins\n      x_fillfmts_2 = x_fillfmts\n      x_fillerrs_2 = x_fillerrs\n      x_frame_1 = x_frame\n      x_fillmins_1 = x_fillmins\n      x_fillfmts_1 = x_fillfmts\n      x_fillerrs_1 = x_fillerrs\n      x_reqs = (eq_DupC x_reqs_1 x_reqs_2)\n      x_numpars = x_numpars_1\n      x_minw = x_l_minw\n      x_minll = (min x_minll_1 x_minll_2)\n      x_maxh = (max x_maxh_1 x_maxh_2)\n      x_fmts = (sem_fmts_cdup x_fmts_1 x_fmts_2 x_error_1 x_error_2 x_numpars_1 x_numpars_2 x_l_minw x_error_msg)\n      x_error = x_l_error\n      x_l_minw = (min x_minw_1 x_minw_2)\n      x_l_error = ((x_numpars_1/=x_numpars_2)||(x_error_1 && x_error_2))\n      x_error_msg = (eq_set_error_msg x_numpars_1 x_numpars_2)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 , x_numpars_1 , x_reqs_1 ) = visit_PPC t_PPC_2 x_fillerrs_1 x_fillfmts_1 x_fillmins_1 x_frame_1\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 , x_numpars_2 , x_reqs_2 ) = visit_PPC t_PPC_3 x_fillerrs_2 x_fillfmts_2 x_fillmins_2 x_frame_2\nvisit_PPC (C_IndentC_1 t_INT t_PPC_2 ) x_fillerrs x_fillfmts x_fillmins x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw , x_numpars , x_reqs )\n  where\n      x_frame_2 = (narrow_frame t_INT x_frame)\n      x_fillmins_2 = x_fillmins\n      x_fillfmts_2 = x_fillfmts\n      x_fillerrs_2 = x_fillerrs\n      x_reqs = x_reqs_2\n      x_numpars = x_numpars_2\n      x_minw = x_l_minw\n      x_minll = (t_INT+x_minll_2)\n      x_maxh = x_maxh_2\n      x_fmts = (set_fmts_indent t_INT x_fmts_2 x_pw x_l_minw x_frame x_error_2)\n      x_error = (((t_INT<0)||(t_INT>x_pw))||x_error_2)\n      x_pw = case x_frame of { (C_F_1 w _) -> w }\n      x_l_minw = (t_INT+x_minw_2)\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 , x_numpars_2 , x_reqs_2 ) = visit_PPC t_PPC_2 x_fillerrs_2 x_fillfmts_2 x_fillmins_2 x_frame_2\nvisit_PPC (C_JoinC_1 t_PPC_2 ) x_fillerrs x_fillfmts x_fillmins x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw , x_numpars , x_reqs )\n  where\n      x_frame_1 = x_frame\n      x_fillmins_1 = x_fillmins\n      x_fillfmts_1 = x_fillfmts\n      x_fillerrs_1 = x_fillerrs\n      x_reqs = x_reqs_1\n      x_numpars = x_numpars_1\n      x_minw = x_minw_1\n      x_minll = x_minll_1\n      x_maxh = x_maxh_1\n      x_fmts = (fst_Pair_T_Formats x_fe)\n      x_error = (x_error_1||x_jerror)\n      x_jerror = (snd_Pair_T_Formats x_fe)\n      x_fe = (set_fmts_join x_fmts_1 x_error_1)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 , x_numpars_1 , x_reqs_1 ) = visit_PPC t_PPC_2 x_fillerrs_1 x_fillfmts_1 x_fillmins_1 x_frame_1\nvisit_PPC (C_ParC_1 ) x_fillerrs x_fillfmts x_fillmins x_frame = (x_error , x_fmts , x_maxh , x_minll , x_minw , x_numpars , x_reqs )\n  where\n      x_reqs = ((:) x_frame ([] ))\n      x_numpars = 1\n      x_minw = (fst_t x_l_m)\n      x_minll = (snd_t x_l_m)\n      x_maxh = (third_t x_l_m)\n      x_fmts = (head_T_Fmts x_fillfmts)\n      x_error = x_l_error\n      x_l_m = (head_T_Mins x_fillmins)\n      x_l_error = (head_T_Errs x_fillerrs)\nvisit_PPCArgs (C_ConsPPCArgs_1 t_PPC t_PPCArgs_2 ) x_ifillerrs x_ifillfmts x_ifillmins x_ireqs = (x_error , x_fillmins , x_fmts , x_len , x_numpars , x_reqs )\n  where\n      x_ireqs_2 = (tail_T_Reqs x_ireqs)\n      x_ifillmins_2 = (snd_Pair_Lst_T_Mins x_i)\n      x_ifillfmts_2 = (snd_Pair_Lst_T_Fmts x_m)\n      x_ifillerrs_2 = (snd_Pair_Lst_T_Errs x_e)\n      x_reqs = (x_reqs_1++x_reqs_2)\n      x_numpars = (x_numpars_1+x_numpars_2)\n      x_len = (x_len_2+1)\n      x_fmts = ((:) x_fmts_1 x_fmts_2)\n      x_fillmins = ((:) (C_Triple_1 x_minw_1 x_minll_1 x_maxh_1) x_fillmins_2)\n      x_error = ((:) x_error_1 x_error_2)\n      x_frame_1 = (head_T_Reqs x_ireqs)\n      x_fillmins_1 = (fst_Pair_Lst_T_Mins x_i)\n      x_fillfmts_1 = (fst_Pair_Lst_T_Fmts x_m)\n      x_fillerrs_1 = (fst_Pair_Lst_T_Errs x_e)\n      x_m = (splitAt_T_Fmts (fromIntegral x_numpars_1) x_ifillfmts)\n      x_i = (splitAt_T_Mins (fromIntegral x_numpars_1) x_ifillmins)\n      x_e = (splitAt_T_Errs (fromIntegral x_numpars_1) x_ifillerrs)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 , x_numpars_1 , x_reqs_1 ) = visit_PPC t_PPC x_fillerrs_1 x_fillfmts_1 x_fillmins_1 x_frame_1\n      (x_error_2 , x_fillmins_2 , x_fmts_2 , x_len_2 , x_numpars_2 , x_reqs_2 ) = visit_PPCArgs t_PPCArgs_2 x_ifillerrs_2 x_ifillfmts_2 x_ifillmins_2 x_ireqs_2\nvisit_PPCArgs (C_NilPPCArgs_1 ) x_ifillerrs x_ifillfmts x_ifillmins x_ireqs = (x_error , x_fillmins , x_fmts , x_len , x_numpars , x_reqs )\n  where\n      x_reqs = ([] )\n      x_numpars = 0\n      x_len = 0\n      x_fmts = ([] )\n      x_fillmins = ([] )\n      x_error = ([] )\n\n\nvisit_PPSArgs :: PPSArgs -> [T_Frame] -> (T_Errs, T_Fmts, Integer, T_Mins)\n-- This function's most general type is\n-- visit_PPSArgs :: forall a. (Integral a, Show a)\n--               => PPSArgs -> [T_Frame] -> (T_Errs, T_Fmts, a, T_Mins)\n-- But in the same mutually recusive group is visit_PPS whose type becomes\n-- visit_PPS :: forall a. (Integral a, Show a)\n--           => PPS -> T_Frame -> (Bool, T_Formats, INT, INT, INT)\n-- which GHC now (rightfully) rejects that as ambiguous, even though\n-- acutally default resolution will allow it at call sites,\n-- So I've added a type signature \n-- SLPJ July 2012\n\nvisit_PPSArgs (C_ConsArgs_1 t_PPS t_PPSArgs_2 ) x_reqs = (x_error , x_fmts , x_len , x_mins )\n  where\n      x_reqs_2 = (tail_T_Reqs x_reqs)\n      x_mins = ((:) (C_Triple_1 x_minw_1 x_minll_1 x_maxh_1) x_mins_2)\n      x_len = (x_len_2+1)\n      x_fmts = ((:) x_fmts_1 x_fmts_2)\n      x_error = ((:) x_error_1 x_error_2)\n      x_frame_1 = (head_T_Reqs x_reqs)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS x_frame_1\n      (x_error_2 , x_fmts_2 , x_len_2 , x_mins_2 ) = visit_PPSArgs t_PPSArgs_2 x_reqs_2\nvisit_PPSArgs (C_NilArgs_1 ) x_reqs = (x_error , x_fmts , x_len , x_mins )\n  where\n      x_mins = ([] )\n      x_len = 0\n      x_fmts = ([] )\n      x_error = ([] )\nvisit_FillList (C_ConsFillList_1 t_PPS t_FillList_2 ) x_errori x_fmtsi x_frame x_maxhi x_minlli x_minwi x_pw = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_frame_1 = x_frame\n      x_pw_2 = x_pw\n      x_minwi_2 = x_minwi\n      x_minlli_2 = ((x_minlli+x_minwi)+x_minw_1)\n      x_maxhi_2 = (cons_height x_maxh_1 x_maxhi True)\n      x_frame_2 = x_frame\n      x_fmtsi_2 = (fst_Pair_Formats x_fe)\n      x_errori_2 = (x_errori||x_ferror)\n      x_minw = x_minw_2\n      x_minll = x_minll_2\n      x_maxh = x_maxh_2\n      x_fmts = x_fmts_2\n      x_error = (x_error_2||x_error_1)\n      x_newll = (x_minlli+x_minw_1)\n      x_ferror = (snd_Pair_Formats x_fe)\n      x_fe = (set_fmts_filllist x_fmtsi x_fmts_1 x_maxhi x_maxh_1 x_frame x_avail)\n      x_avail = ((x_pw-x_newll)>=0)\n      (x_error_1 , x_fmts_1 , x_maxh_1 , x_minll_1 , x_minw_1 ) = visit_PPS t_PPS x_frame_1\n      (x_error_2 , x_fmts_2 , x_maxh_2 , x_minll_2 , x_minw_2 ) = visit_FillList t_FillList_2 x_errori_2 x_fmtsi_2 x_frame_2 x_maxhi_2 x_minlli_2 x_minwi_2 x_pw_2\nvisit_FillList (C_NilFillList_1 ) x_errori x_fmtsi x_frame x_maxhi x_minlli x_minwi x_pw = (x_error , x_fmts , x_maxh , x_minll , x_minw )\n  where\n      x_minw = x_minwi\n      x_minll = x_minlli\n      x_maxh = x_maxhi\n      x_fmts = x_fmtsi\n      x_error = x_errori\nabove_fmt u l =\n case u of { (C_Elem_1 uh ul uw ut) -> case l of { (C_Elem_1 lh ll lw lt) -> (C_Elem_1 (uh+lh) ll (max uw lw) (ut++lt)) } }\nabove_fmts u l =\n case u of { ( [] ) -> ([] ) ; ( (:) u2 us ) -> case l of { ( [] ) -> ([] ) ; ( (:) l2 ls ) -> let { (utw) = (total_w u2) ; (ltw) = (total_w l2) ; (fe) = (above_fmt u2 l2) } in (if (utw>=ltw) then ((:) fe (above_fmts us l)) else ((:) fe (above_fmts u ls))) } }\nactformparams actparams lfps =\n case actparams of { ( (:) t1 ts ) -> case lfps of { ( (:) p ls ) -> case p of { (C_AParam_1 t2 n) -> (if (t1==t2) then (actformparams ts ls) else ((:) (C_E_T_ActParam_1 ) (actformparams ts ls))) } ; ( [] ) -> ((:) (C_E_T_ActParam_1 ) ([] )) } ; ( [] ) -> case lfps of { ( (:) p ls ) -> ((:) (C_E_T_ActParam_1 ) ([] )) ; ( [] ) -> ([] ) } }\nadd_glue i ls =\n case ls of { ( [] ) -> ([] ) ; ( (:) s ss ) -> ((:) ((repeatCHAR ' ' i)++s) (add_glue i ss)) }\nafmt_txt string =\n (C_AFormat_1 (text_fmts string))\nallf fs =\n case fs of { ( [] ) -> \"\" ; ( (:) f fs2 ) -> ((txtstr f 0 \"\\n\\n\")++(best fs2)) }\nassign_InfType n exptype fid env =\n let { (desttype) = (gettype n fid env) } in (if ((coercibleTypes desttype exptype)==(C_Errortype_1 )) then (C_E_T_NC_1 desttype exptype) else (C_NoTypeError_1 ))\nasts i =\n (if (i==0) then \"\" else (if (i==1) then \"*\" else ((\":\"++(repeatCHAR '*' (fromIntegral (i-2))))++\"*>\")) )\nbeside_fmt l r =\n case l of { (C_Elem_1 lh ll lw lt) -> case r of { (C_Elem_1 rh rl rw rt) -> (C_Elem_1 ((lh+rh)-1) (ll+rl) (max lw (ll+rw)) (join ll lt rt)) } }\nbeside_fmts f l r =\n case f of { (C_F_1 pw _) -> (foldLeft pw l r) }\nbeside_height lh rh =\n (if ((lh==0)||(rh==0)) then 0 else 1)\nbest fs =\n case fs of { ( [] ) -> \"\" ; ( (:) f fs2 ) -> (txtstr f 0 \"\") }\nblockStats sts =\n (C_Above_1 (C_Beside_1 (C_Text_1 \"{\") (C_Indent_1 2 sts)) (C_Text_1 \"}\"))\ncheckactparams s actpars env =\n case (lrc_map_application s env) of { (C_Consfunc_1 t i lfp) -> (actformparams actpars lfp) ; _ -> ([] ) }\nchoose_ab_beside_fmts avail fa fb f =\n (if avail then (beside_fmts f fa fb) else (above_fmts fa fb))\nchoose_ab_error_beside avail fa fb f =\n (if avail then (error_beside fa fb) else (above_fmts fa fb))\ncoercibleTypes t1 t2 =\n (if (t1==t2) then t1 else case t1 of { (C_Realtype_1 ) -> case t2 of { (C_Inttype_1 ) -> t1 ; _ -> (C_Errortype_1 ) } ; _ -> (C_Errortype_1 ) } )\ncons_height pph acth avail =\n (if (acth==0) then (if (pph>0) then 1 else 0) else (acth+(if avail then 0 else 1) ))\ndispf fs =\n case fs of { ( [] ) -> \"\" ; ( (:) f fs2 ) -> (txtstr f 0 \"\") }\ndropWhileFormatsNotFit i fs =\n case fs of { ( [] ) -> ([] ) ; ( (:) f fs2 ) -> (if (notFits i f) then (dropWhileFormatsNotFit i fs2) else fs) }\ndropWhileFormatsTooWide i l r =\n case r of { ( [] ) -> ([] ) ; ( (:) f fs ) -> (if (tooWide i l f) then (dropWhileFormatsTooWide i l fs) else r) }\nempty_fmts =\n ([] )\nenclosedBy o b c =\n (C_Beside_1 (C_Text_1 o) (C_Beside_1 b (C_Text_1 c)))\neq_DupC r1 r2 =\n (zipwith_max r1 r2)\neq_all_fmts pw fmts =\n (allf (set_fmts_render pw fmts))\neq_best_fmts pw fmts =\n (best (set_fmts_render pw fmts))\neq_disp pw fmts =\n (dispf (set_fmts_render pw fmts))\neq_set_error_msg apars bpars =\n ((((\"<Error: incorrect choice expression. #pars left \"++(lrc_INTtoSTR apars))++\" /= #pars right \")++(lrc_INTtoSTR bpars))++\">\")\neq_set_fmts_apply error msg fmts =\n (set_fmts_apply error (C_AFormat_1 (text_fmts msg)) fmts)\neq_set_fmts_fill fmts =\n (C_AFormat_1 fmts)\nerror_beside fs1 fs2 =\n ([] )\nerror_indent i fs =\n (map_indent_fmt i fs)\nfoldLeft pw l r =\n case l of { ( [] ) -> ([] ) ; ( (:) f fs ) -> (map_With_fmts f (dropWhileFormatsTooWide pw f r)) }\nfst_Pair_Formats f =\n case f of { (C_C_Pair_Formats_1 a b) -> a }\nfst_Pair_Lst_T_Errs t =\n case t of { (C_CPair_Lst_T_Errs_1 a _) -> a }\nfst_Pair_Lst_T_Fmts t =\n case t of { (C_CPair_Lst_T_Fmts_1 a _) -> a }\nfst_Pair_Lst_T_Mins t =\n case t of { (C_CPair_Lst_T_Mins_1 a _) -> a }\nfst_Pair_T_Formats f =\n case f of { (C_C_Pair_T_Formats_1 a b) -> a }\nfst_t t =\n case t of { (C_Triple_1 pw _ _) -> pw }\nfunc_def_a_la_c ty name formpars body =\n (C_Above_1 (C_Beside_1 name (C_Beside_1 (C_Text_1 \"(\") (C_Beside_1 formpars (C_Beside_1 (C_Text_1 \") : \") ty)))) (blockStats body))\nfunccall name pars =\n (C_Beside_1 name (enclosedBy \"(\" pars \")\"))\ngenCodeMainFun =\n ((:) (C_Call_1 (C_Ident_1 \"main\")) ((:) (C_Halt_1 ) ([] )))\ngenCodeParamsFunc i lsttp cap =\n case lsttp of { ( [] ) -> ([] ) ; ( (:) fp fps ) -> case cap of { ( [] ) -> ([] ) ; ( (:) c cs ) -> case fp of { (C_AParam_1 t n) -> (((:) (C_Pusha_1 n i) c)++((:) (C_Store_1 ) (genCodeParamsFunc i fps cs))) } } }\ngen_code_func nf lst =\n case lst of { ( [] ) -> ([] ) ; ( (:) apar ls ) -> case apar of { (C_AParam_1 t n) -> ((:) (C_Var_1 n nf t) (gen_code_func nf ls)) } }\ngen_code_func_inv fn env cap =\n case (lrc_map_application fn env) of { (C_Consfunc_1 t i lstp) -> ((genCodeParamsFunc i lstp cap)++((:) (C_Call_1 fn) ([] ))) ; _ -> ([] ) }\ngen_code_ite i e c1 c2 =\n (((e++((:) (C_Jumpf_1 (C_Ident_1 (\"else_\"++(lrc_INTtoSTR i)))) c1))++((:) (C_Jumpf_1 (C_Ident_1 (\"end_if_\"++(lrc_INTtoSTR i)))) ((:) (C_ALabel_1 (C_Ident_1 (\"else_\"++(lrc_INTtoSTR i)))) c2)))++((:) (C_ALabel_1 (C_Ident_1 (\"end_if_\"++(lrc_INTtoSTR i)))) ([] )))\ngen_code_while i e c1 =\n ((((:) (C_ALabel_1 (C_Ident_1 (\"while_\"++(lrc_INTtoSTR i)))) e)++((:) (C_Jumpf_1 (C_Ident_1 (\"end_while_\"++(lrc_INTtoSTR i)))) c1))++((:) (C_Jump_1 (C_Ident_1 (\"while_\"++(lrc_INTtoSTR i)))) ((:) (C_ALabel_1 (C_Ident_1 (\"end_while_\"++(lrc_INTtoSTR i)))) ([] ))))\ngen_data_mem e =\n ([] )\nget_fmts fs =\n case fs of { (C_AFormat_1 a) -> a ; (C_TFormats_1 _ _ _ _) -> (text_fmts \"<Error: can\\'t dup a dup\") }\ngettype id fid env =\n case (lrc_map_application id env) of { (C_Consvar_1 t i) -> t ; (C_Consarray_1 t i i2) -> t ; (C_Consfunc_1 t i l) -> t ; _ -> case (lrc_map_application fid env) of { (C_Consfunc_1 t i lstp) -> (gettypefp id lstp) ; _ -> (C_Errortype_1 ) } }\ngettypefp id lstfp =\n case lstfp of { ( (:) p ls ) -> case p of { (C_AParam_1 t n) -> (if (id==n) then t else (gettypefp id ls)) } ; ( [] ) -> (C_Errortype_1 ) }\nhead_T_Errs t =\n case t of { ( (:) s _ ) -> s }\nhead_T_Fmts t =\n case t of { ( (:) s _ ) -> s }\nhead_T_Mins t =\n case t of { ( (:) s _ ) -> s }\nhead_T_Reqs t =\n case t of { ( (:) f _ ) -> f }\nhv a b =\n (C_Join_1 (C_Dup_1 (C_Beside_1 a b) (C_Above_1 a b)))\nhvc a b =\n (C_DupC_1 (C_BesideC_1 a b) (C_AboveC_1 a b))\nif_t_ePP exp stats1 stats2 =\n (hv (hv (hv (C_Text_1 \"if\") (C_Beside_1 (C_Text_1 \"(\") (C_Beside_1 exp (C_Text_1 \")\")))) (hv (C_Text_1 \"then\") (blockStats stats1))) (hv (C_Text_1 \"else\") (blockStats stats2)))\nindent_fmt i f =\n case f of { (C_Elem_1 dh dl dw dt) -> (C_Elem_1 dh (i+dl) (i+dw) (add_glue i dt)) }\nindent_fmts f i fs =\n case f of { (C_F_1 pw _) -> (map_indent_fmt i (dropWhileFormatsNotFit (pw-i) fs)) }\ninfType op t1 t2 =\n case op of { 1 -> (coercibleTypes t1 t2) ; 2 -> (if (t1==t2) then (C_Booltype_1 ) else (C_Errortype_1 )) ; _ -> (C_Errortype_1 ) }\ninitLst_Str l =\n case l of { ( [] ) -> ([] ) ; ( (:) x ( [] ) ) -> ([] ) ; ( (:) x ls ) -> ((:) x (initLst_Str ls)) }\nisaritmexp t =\n case t of { (C_Inttype_1 ) -> True ; _ -> False }\nisboolexp t =\n case t of { (C_Booltype_1 ) -> True ; _ -> False }\nisinenv n fid env =\n (if (lrc_map_in n env) then True else case (lrc_map_application fid env) of { (C_Consfunc_1 t i lstp) -> (isinlst n lstp) ; _ -> False } )\nisinlst n l =\n case l of { ( [] ) -> False ; ( (:) apar ls ) -> case apar of { (C_AParam_1 t n2) -> (if (n==n2) then True else (isinlst n ls)) } }\nisinttype t =\n case t of { (C_Inttype_1 ) -> True ; _ -> False }\njoin i lt rt =\n case rt of { ( [] ) -> lt ; ( (:) x rt2 ) -> (((initLst_Str lt)++((:) ((lastLst_Str lt)++x) ([] )))++(add_glue i rt2)) }\nlastLst_Str l =\n case l of { ( (:) x ( [] ) ) -> x ; ( (:) _ ls ) -> (lastLst_Str ls) }\nlast_w f =\n case f of { (C_Elem_1 _ pll _ _) -> pll }\nmap_With_fmts f fs =\n case fs of { ( [] ) -> ([] ) ; ( (:) f2 fs2 ) -> ((:) (beside_fmt f f2) (map_With_fmts f fs2)) }\nmap_indent_fmt i fs =\n case fs of { ( [] ) -> ([] ) ; ( (:) f fs2 ) -> ((:) (indent_fmt i f) (map_indent_fmt i fs2)) }\nmax_T_Frame a b =\n case a of { (C_F_1 w _) -> case b of { (C_F_1 z _) -> (if (w>z) then a else b) } }\nmerge xs ys =\n case xs of { ( [] ) -> ys ; ( (:) x xs2 ) -> case ys of { ( [] ) -> xs ; ( (:) y ys2 ) -> (if (x==y) then ((:) x (merge xs2 ys2)) else (if (x<y) then ((:) x (merge xs2 ys)) else ((:) y (merge xs ys2))) ) } }\nnametoSTR n =\n case n of { (C_Ident_1 s) -> s }\nnarrow_frame i f =\n case f of { (C_F_1 s l) -> (C_F_1 (s-i) (l-i)) }\nnarrow_ll i f =\n case f of { (C_F_1 s l) -> (C_F_1 s (l-i)) }\nnewlines ls =\n case ls of { ( (:) x ( [] ) ) -> x ; ( (:) x xs ) -> ((x++\"\\n\")++(newlines xs)) }\nnotFits delta f =\n case f of { (C_Elem_1 _ _ dw _) -> (dw>delta) }\nnullFormats fs =\n case fs of { ( [] ) -> True ; _ -> False }\nppName n =\n case n of { (C_Ident_1 s) -> (C_Text_1 s) }\nppType t =\n case t of { (C_Inttype_1 ) -> (C_Text_1 \"Int\") ; (C_Realtype_1 ) -> (C_Text_1 \"Real\") ; (C_Booltype_1 ) -> (C_Text_1 \"Bool\") ; (C_Chartype_1 ) -> (C_Text_1 \"Char\") ; (C_Errortype_1 ) -> (C_Text_1 \"Error??\") }\ns2fmt s = let { (l) = (fromIntegral (length s)) } in (C_Elem_1 1 l l ((:) s ([] )))\nsem_fmts_cdup a b ae be anpars bnpars min_w mesg =\n (if (anpars/=bnpars) then (afmt_txt mesg) else (sem_fmts_dup a b ae be min_w))\nsem_fmts_dup afs bfs ae be minw =\n (if (ae && be) then (afmt_txt (asts minw)) else (C_TFormats_1 (get_fmts afs) (get_fmts bfs) ae be))\nset_error_msg numpars len =\n ((((\"<Error: incorrect apply expression. #pars \"++(lrc_INTtoSTR numpars))++\" /= #args \")++(lrc_INTtoSTR len))++\">\")\nset_fmts_ab_above fs gs uh lh etxt =\n case fs of { (C_AFormat_1 ffmts) -> case gs of { (C_AFormat_1 gfmts) -> (C_C_Pair_T_Formats_1 (C_AFormat_1 (set_fmts_abovea ffmts gfmts uh lh)) False) ; (C_TFormats_1 a bs ae be) -> (C_C_Pair_T_Formats_1 (C_TFormats_1 (set_fmts_abovea ffmts a uh lh) (set_fmts_abovea ffmts bs uh lh) ae be) False) } ; (C_TFormats_1 a bs ae be) -> case gs of { (C_AFormat_1 gfmts) -> (C_C_Pair_T_Formats_1 (C_TFormats_1 (set_fmts_abovea a gfmts uh lh) (set_fmts_abovea bs gfmts uh lh) ae be) False) ; _ -> (C_C_Pair_T_Formats_1 (afmt_txt etxt) True) } }\nset_fmts_ab_beside fs gs uh lh frame error etxt =\n case fs of { (C_AFormat_1 ffmts) -> case gs of { (C_AFormat_1 gfmts) -> (C_C_Pair_T_Formats_1 (C_AFormat_1 (set_fmts_besidea ffmts gfmts uh lh frame error)) False) ; (C_TFormats_1 a bs ae be) -> (C_C_Pair_T_Formats_1 (C_TFormats_1 (set_fmts_besidea ffmts a uh lh frame error) (set_fmts_besidea ffmts bs uh lh frame error) ae be) False) } ; (C_TFormats_1 a bs ae be) -> case gs of { (C_AFormat_1 gfmts) -> (C_C_Pair_T_Formats_1 (C_TFormats_1 (set_fmts_besidea a gfmts uh lh frame error) (set_fmts_besidea bs gfmts uh lh frame error) ae be) False) ; _ -> (C_C_Pair_T_Formats_1 (afmt_txt etxt) True) } }\nset_fmts_above us ls uh lh =\n (set_fmts_ab_above us ls uh lh \"<Error: can\\'t above two pairs\")\nset_fmts_abovea a bs uh lh =\n (if (uh==0) then bs else (if (lh==0) then a else (above_fmts a bs)) )\nset_fmts_apply error msg fmts =\n (if error then msg else fmts)\nset_fmts_beside ls rs lh rh frame error =\n (set_fmts_ab_beside ls rs lh rh frame error \"<Error: can\\'t beside two pairs\")\nset_fmts_besidea ls rs lh rh frame error =\n (if (lh==0) then rs else (if (rh==0) then ls else (if error then (error_beside ls rs) else (beside_fmts frame ls rs)) ) )\nset_fmts_empty =\n (C_AFormat_1 (empty_fmts ))\nset_fmts_fillblock i fmts w =\n (if (i<0) then (afmt_txt \"<Error: negative page width in fillblock>\") else (if (i>w) then (afmt_txt (asts i)) else (C_AFormat_1 fmts)) )\nset_fmts_filllist af bf ah bh f avail =\n case bf of { (C_AFormat_1 ns) -> (if (ah==0) then (C_C_Pair_Formats_1 ns False) else (if (bh==0) then (C_C_Pair_Formats_1 af False) else (if (bh<=1) then (C_C_Pair_Formats_1 (choose_ab_beside_fmts avail af ns f) False) else (C_C_Pair_Formats_1 (choose_ab_error_beside avail af (text_fmts \"<Error: element in fill higher than 1>\") f) True)) ) ) ; _ -> (C_C_Pair_Formats_1 (set_fmts_filllista (text_fmts \"<Error: element in fill list is a pair>\") af ah bh avail f) True) }\nset_fmts_filllista fs afmts ah nh avail f =\n (if (ah==0) then afmts else (if (nh==0) then fs else (choose_ab_error_beside avail fs afmts f)) )\nset_fmts_indent i f pw minw frame error =\n (if (i<0) then (afmt_txt \"<Error: negative indentation>\") else (if (i>pw) then (afmt_txt (asts minw)) else (if error then (set_fmts_indent_error_indent i f) else (set_fmts_indent_indent_fmts i f frame)) ) )\nset_fmts_indent_error_indent i fmts =\n case fmts of { (C_AFormat_1 fs) -> (C_AFormat_1 (error_indent i fs)) ; (C_TFormats_1 a bs ae be) -> (C_TFormats_1 (error_indent i a) (error_indent i bs) ae be) }\nset_fmts_indent_indent_fmts i fmts frame =\n case fmts of { (C_AFormat_1 fs) -> (C_AFormat_1 (indent_fmts frame i fs)) ; (C_TFormats_1 a bs ae be) -> (C_TFormats_1 (indent_fmts frame i a) (indent_fmts frame i bs) ae be) }\nset_fmts_join fs err =\n case fs of { (C_AFormat_1 f) -> (if err then (C_C_Pair_T_Formats_1 fs err) else (C_C_Pair_T_Formats_1 (afmt_txt \"<Error: can\\'t join a single result>\") True)) ; (C_TFormats_1 a bs ae be) -> let { (aa) = (if be then (if (nullFormats a) then bs else a) else (if ae then (if (nullFormats bs) then a else bs) else (merge a bs)) ) } in (C_C_Pair_T_Formats_1 (C_AFormat_1 aa) False) }\nset_fmts_render pw fmts =\n (if (pw<0) then (text_fmts \"<Error: negative page width >\") else case fmts of { (C_AFormat_1 fmt) -> fmt ; _ -> (text_fmts \"<Error: can\\'t render a pair>\") } )\nset_fmts_text string minw error =\n (afmt_txt (if error then (asts minw) else string) )\nset_var_apply error lem min =\n (if error then lem else min)\nsnd_Pair_Formats f =\n case f of { (C_C_Pair_Formats_1 a b) -> b }\nsnd_Pair_Lst_T_Errs t =\n case t of { (C_CPair_Lst_T_Errs_1 _ a) -> a }\nsnd_Pair_Lst_T_Fmts t =\n case t of { (C_CPair_Lst_T_Fmts_1 _ a) -> a }\nsnd_Pair_Lst_T_Mins t =\n case t of { (C_CPair_Lst_T_Mins_1 _ a) -> a }\nsnd_Pair_T_Formats f =\n case f of { (C_C_Pair_T_Formats_1 a b) -> b }\nsnd_t t =\n case t of { (C_Triple_1 _ pll _) -> pll }\nsplitAt_T_Errs i tm =\n (if (i<=0) then (C_CPair_Lst_T_Errs_1 ([] ) tm) else case tm of { ( [] ) -> (C_CPair_Lst_T_Errs_1 ([] ) ([] )) ; ( (:) x xs ) -> let { (a) = (splitAt_T_Errs (i-1) xs) ; (xs2) = (fst_Pair_Lst_T_Errs a) ; (xs22) = (snd_Pair_Lst_T_Errs a) } in (C_CPair_Lst_T_Errs_1 ((:) x xs2) xs22) } )\nsplitAt_T_Fmts i tm =\n (if (i<=0) then (C_CPair_Lst_T_Fmts_1 ([] ) tm) else case tm of { ( [] ) -> (C_CPair_Lst_T_Fmts_1 ([] ) ([] )) ; ( (:) x xs ) -> let { (a) = (splitAt_T_Fmts (i-1) xs) ; (xs2) = (fst_Pair_Lst_T_Fmts a) ; (xs22) = (snd_Pair_Lst_T_Fmts a) } in (C_CPair_Lst_T_Fmts_1 ((:) x xs2) xs22) } )\nsplitAt_T_Mins i tm =\n (if (i<=0) then (C_CPair_Lst_T_Mins_1 ([] ) tm) else case tm of { ( [] ) -> (C_CPair_Lst_T_Mins_1 ([] ) ([] )) ; ( (:) x xs ) -> let { (a) = (splitAt_T_Mins (i-1) xs) ; (xs2) = (fst_Pair_Lst_T_Mins a) ; (xs22) = (snd_Pair_Lst_T_Mins a) } in (C_CPair_Lst_T_Mins_1 ((:) x xs2) xs22) } )\ntail_T_Reqs t =\n case t of { ( (:) _ tr ) -> tr }\ntext_fmts s =\n ((:) (s2fmt s) ([] ))\nthird_t t =\n case t of { (C_Triple_1 _ _ ph) -> ph }\ntooWide pw x y =\n ((max (total_w x) ((last_w x)+(total_w y)))>pw)\ntotal_w f =\n case f of { (C_Elem_1 _ _ w _) -> w }\ntxtstr f n s =\n case f of { (C_Elem_1 dh dl dw dt) -> ((newlines (add_glue n dt))++s) }\ntypecheck s exptype fid env =\n (if (exptype==(gettype s fid env)) then True else False)\nwhilePP bg exp stats =\n (C_Apply_1 (C_JoinC_1 (hvc (C_ParC_1 ) (C_JoinC_1 (hvc (C_ParC_1 ) C_ParC_1)))) (C_ConsArgs_1 bg (C_ConsArgs_1 exp (C_ConsArgs_1 stats (C_NilArgs_1 )))))\nwhilePPOLD exp stats =\n (hv (hv (C_Text_1 \"while\") (C_Beside_1 (C_Text_1 \"(\") (C_Beside_1 exp (C_Text_1 \")\")))) (blockStats stats))\nzipwith_max l1 l2 =\n case l1 of { ( [] ) -> l2 ; ( (:) l11 l11s ) -> case l2 of { ( [] ) -> l1 ; ( (:) l22 l22s ) -> ((:) (max_T_Frame l11 l22) (zipwith_max l11s l22s)) } }\n", "num_lines": 1161}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata Vertex = V Int deriving (Read, Show)\n\nmain = do\n    userInput <- getContents\n    (parseVertex.lines) userInput report\n\nreport::Vertex -> IO ()\nreport int = putStr (show int)\n\nparseVertex::[String] -> (Vertex -> IO ()) -> IO ()\nparseVertex inputLines cont\n = case inputLines of\n      (l1:rest) -> case (reads l1) of\n                     [(x,\"\")] -> cont x\n                     other    -> putStr\n                                      ((showString \"Error - retype the edges\\n\".                                      shows other) \"\")\n      _         -> putStr \"No Vertex\"\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bit where\nimport LogFun\nimport Signal\n\ndata Bit = Bot | WeakZero | WeakOne | Zero | One | Top\n  deriving (Eq,Show{-was:Text-})\n\ninstance Static Bit where\n  intToSig = intToSigBit\n  sigToInt = sigToIntBit\n  showStaticSig = showBit\n\ninstance Lattice Bit where\n  bot = Bot\n  top = Top\n  weakZero = WeakZero\n  weakOne = WeakOne\n  lub = lubBit\n  pass = passBit\n\ninstance Signal Bit where\n  showSig = showBit\n  initial = Zero\n  zerO    = Zero\n  one     = One\n  tt1     = tt1Bit\n  tt2     = tt2Bit\n\ninstance Log Bit where\n  dumLog = Zero\n\ntt1Bit :: TT1 -> Bit -> Bit\ntt1Bit (a,b) =\n  let p = intBit a\n      q = intBit b\n      f x = case x of\n              Bot  -> Bot\n              Zero -> p\n              One  -> q\n              Top  -> Top\n  in f\n\ntt2Bit :: TT2 -> Bit -> Bit -> Bit\ntt2Bit (a,b,c,d) = f\n  where p = intBit a\n        q = intBit b\n        r = intBit c\n        s = intBit d\n        f x y = case x of\n                  Bot  ->     case y of\n                                Bot      -> Bot\n                                WeakZero -> Bot\n                                WeakOne  -> Bot\n                                Zero     -> Bot\n                                One      -> Bot\n                                Top      -> Top\n                  WeakZero -> case y of\n                                Bot      -> Bot\n                                WeakZero -> p\n                                WeakOne  -> q\n                                Zero     -> p\n                                One      -> q\n                                Top      -> Top\n                  WeakOne  -> case y of\n                                Bot      -> Bot\n                                WeakZero -> r\n                                WeakOne  -> s\n                                Zero     -> r\n                                One      -> s\n                                Top      -> Top\n                  Zero     -> case y of\n                                Bot      -> Bot\n                                WeakZero -> p\n                                WeakOne  -> q\n                                Zero     -> p\n                                One      -> q\n                                Top      -> Top\n                  One      -> case y of\n                                Bot      -> Bot\n                                WeakZero -> r\n                                WeakOne  -> s\n                                Zero     -> r\n                                One      -> s\n                                Top      -> Top\n                  Top      -> case y of\n                                Bot      -> Top\n                                WeakZero -> Top\n                                WeakOne  -> Top\n                                Zero     -> Top\n                                One      -> Top\n                                Top      -> Top\n\nlubBit :: Bit -> Bit -> Bit\nlubBit a b =\n  case a of\n    Bot      -> case b of\n                  Bot      -> Bot\n                  WeakZero -> WeakZero\n                  WeakOne  -> WeakOne\n                  Zero     -> Zero\n                  One      -> One\n                  Top      -> Top\n    WeakZero -> case b of\n                  Bot      -> Zero\n                  WeakZero -> WeakZero\n                  WeakOne  -> Top\n                  Zero     -> Zero\n                  One      -> One\n                  Top      -> Top\n    WeakOne  -> case b of\n                  Bot      -> WeakOne\n                  WeakZero -> Top\n                  WeakOne  -> WeakOne\n                  Zero     -> Zero\n                  One      -> One\n                  Top      -> Top\n    Zero     -> case b of\n                  Bot      -> Zero\n                  WeakZero -> Zero\n                  WeakOne  -> Zero\n                  Zero     -> Zero\n                  One      -> Top\n                  Top      -> Top\n    One      -> case b of\n                  Bot      -> One\n                  WeakZero -> One\n                  WeakOne  -> One\n                  Zero     -> Top\n                  One      -> One\n                  Top      -> Top\n    Top      -> case b of\n                  Bot      -> Top\n                  WeakZero -> Top\n                  WeakOne  -> Top\n                  Zero     -> Top\n                  One      -> Top\n                  Top      -> Top\n\nshowBit :: Bit -> String\nshowBit Bot      = \"v\"\nshowBit WeakZero = \"z\"\nshowBit WeakOne  = \"o\"\nshowBit Zero     = \"0\"\nshowBit One      = \"1\"\nshowBit Top      = \"^\"\n\n\nintBit :: Int -> Bit\nintBit 0 = Zero\nintBit 1 = One\nintBit x =\n  error (\"\\nintBit received bad Int \" ++ show x ++ \".\\n\")\n\nintToSigBit :: Int -> Bit\nintToSigBit i\n  | i==0  =  Zero\n  | i==1  =  One\n  | i==8  =  Bot\n  | i==9  =  Top\n\nsigToIntBit :: Bit -> Int\nsigToIntBit Zero = 0\nsigToIntBit One  = 1\nsigToIntBit Bot  = 8\nsigToIntBit Top  = 9\n\npassBit :: Bit -> Bit -> Bit\npassBit c a =\n  case c of\n    Bot  -> Bot\n    Zero -> Bot\n    One  -> a\n    Top  -> Top\n\ninstance Num Bit where\n  (+) = or2\n  (*) = and2\n  a - b  = xor a b\n  negate = inv\n  abs    = error \"abs not defined for Signals\"\n  signum = error \"signum not defined for Signals\"\n  fromInteger = error \"fromInteger not defined for Signals\"\n\n", "num_lines": 184}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module LogFun where\n\ntype TT1 = (Int,Int)\ntype TT2 = (Int,Int,Int,Int)\n\ntt_con10, tt_id, tt_inv, tt_con11 :: TT1\n\ntt_con10 = (0,0)\ntt_id    = (0,1)\ntt_inv   = (1,0)\ntt_con11 = (1,1)\n\ntt_con20, tt_and2, tt_nimp,  tt_id21   :: TT2\ntt_nimp', tt_id22, tt_xor,   tt_or2    :: TT2\ntt_nor2,  tt_equ2, tt_inv22, tt_imp'   :: TT2\ntt_inv21, tt_imp,  tt_nand2, tt_con21  :: TT2\n\ntt_con20 = (0,0,0,0)\ntt_and2  = (0,0,0,1)\ntt_nimp  = (0,0,1,0)\ntt_id21  = (0,0,1,1)\ntt_nimp' = (0,1,0,0)\ntt_id22  = (0,1,0,1)\ntt_xor   = (0,1,1,0)\ntt_or2   = (0,1,1,1)\ntt_nor2  = (1,0,0,0)\ntt_equ2  = (1,0,0,1)\ntt_inv22 = (1,0,1,0)\ntt_imp'  = (1,0,1,1)\ntt_inv21 = (1,1,0,0)\ntt_imp   = (1,1,0,1)\ntt_nand2 = (1,1,1,0)\ntt_con21 = (1,1,1,1)\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport Signal\nimport Bit\n\nmain = putStr test\n\ntest = stest\n\ntype B =  Stream Bit\n\nstest = take 80 (shows z \"\\n\")\n  where z = one :: B\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Signal where\n\nimport LogFun\n\nclass (Eq a, Show{-was:Text-} a, Num a) => Signal a where\n  showSig :: a -> String\n\n  zerO, one, initial :: a\n\n  tt1 :: TT1 -> a -> a\n  tt2 :: TT2 -> a -> a -> a\n\n  con10, buf, inv, con11 :: a -> a\n\n  con20, and2, nimp,  id21  :: a -> a -> a\n  nimp', id22, xor,   or2   :: a -> a -> a\n  nor2,  equ2, inv22, imp'  :: a -> a -> a\n  inv21, imp,  nand2, con21 :: a -> a -> a\n  and3,  or3,  nand3, nor3  :: a -> a -> a -> a\n  and4,  or4,  nand4, nor4  :: a -> a -> a -> a -> a\n\n  con10 = tt1 tt_con10\n  buf   = tt1 tt_id\n  inv   = tt1 tt_inv\n  con11 = tt1 tt_con11\n\n  con20 = tt2 tt_con20\n  and2  = tt2 tt_and2\n  nimp  = tt2 tt_nimp\n  id21  = tt2 tt_id21\n  nimp' = tt2 tt_nimp'\n  id22  = tt2 tt_id22\n  xor   = tt2 tt_xor\n  or2   = tt2 tt_or2\n  nor2  = tt2 tt_nor2\n  equ2  = tt2 tt_equ2\n  inv22 = tt2 tt_inv22\n  imp'  = tt2 tt_imp'\n  inv21 = tt2 tt_inv21\n  imp   = tt2 tt_imp\n  nand2 = tt2 tt_nand2\n  con21 = tt2 tt_con21\n\n  and3  a b c = a*b*c\n  or3   a b c = a+b+c\n  nand3 a b c = nand2 a (nand2 b c)\n  nor3  a b c = nor2 a (nor2 b c)\n\n  and4  a b c d = (a*b)*(c*d)\n  or4   a b c d = (a+b)+(c+d)\n  nand4 a b c d = nand2 (nand2 a b) (nand2 c d)\n  nor4  a b c d = nor2 (nor2 a b) (nor2 c d)\n\nclass (Signal a) => Lattice a where\n  bot, top, weakZero, weakOne :: a\n  lub  :: a -> a -> a\n  pass :: a -> a -> a\n\nclass (Signal a) => Static a where\n  intToSig :: Int -> a\n  sigToInt :: a -> Int\n  showStaticSig :: a -> String\n\nclass (Signal a) => Dynamic a where\n  latch, dff :: a -> a\n\nclass (Lattice a, Static a) => Log a where\n  dumLog :: a\n\nclass (Lattice a, Dynamic a) => Sig a where\n  dumSig :: a\n\ndata Stream a = Snil | Scons a (Stream a)  deriving (Eq,Show{-was:Text-})\n\nshead :: Stream a -> a\nshead (Scons x xs) = x\n\nstail :: Stream a -> Stream a\nstail (Scons x xs) = xs\n\nsnull :: Stream a -> Bool\nsnull Snil = True\nsnull (Scons x xs) = False\n\nsmap :: (a->b) -> Stream a -> Stream b\nsmap f Snil = Snil\nsmap f (Scons x xs) = Scons (f x) (smap f xs)\n\nstake, sdrop :: Int -> Stream a -> Stream a\n\nstake 0 xs = xs\n--should be: stake (i+1) (Scons x xs) = Scons x (stake i xs)\nstake i (Scons x xs) | i < 0     = error \"Signal.stake: < 0\"\n                     | otherwise = Scons x (stake (i-1) xs)\n\nsdrop 0 xs = xs\n--should be:sdrop (i+1) (Scons x xs) = sdrop i xs\nsdrop i (Scons x xs) | i < 0     = error \"Signal.sdrop: < 0\"\n                     | otherwise = sdrop i xs\n\nsmap2 :: (a->b->c) -> Stream a -> Stream b -> Stream c\nsmap2 f as bs =\n  case as of\n    Snil -> Snil\n    Scons a as' ->\n      case bs of\n        Snil -> Snil\n        Scons b bs' -> Scons (f a b) (smap2 f as' bs')\n\nsrepeat :: (Static a) => a -> Stream a\nsrepeat x = xs where xs = Scons x xs\n\nstream :: [a] -> Stream a\nstream [] = Snil\nstream (x:xs) = Scons x (stream xs)\n\ninstance (Signal a, Static a) => Dynamic (Stream a) where\n  latch xs = Scons initial xs\n  dff xs = Scons initial xs\n\ninstance (Lattice a, Static a) => Lattice (Stream a) where\n  bot      = srepeat bot\n  top      = srepeat top\n  weakZero = srepeat weakZero\n  weakOne  = srepeat weakOne\n  lub      = smap2 lub\n  pass     = smap2 pass\n\ninstance (Signal a, Static a) => Signal (Stream a) where\n  zerO = srepeat zerO\n  one  = srepeat one\n  tt1  = smap . tt1\n  tt2  = smap2 . tt2\n\ninstance (Lattice a, Static a) => Sig (Stream a) where\n  dumSig = bot  -- ??? shouldn't be necessary, check compiler\n\ninstance (Static a) => Num (Stream a) where\n  (+) = or2\n  (*) = and2\n  a - b  = xor a b\n  negate = inv\n  abs    = error \"abs not defined for Signals\"\n  signum = error \"signum not defined for Signals\"\n  fromInteger = error \"fromInteger not defined for Signals\"\n\n", "num_lines": 147}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! a performance-problem test from Jules.\n--  further comment at the end\n-- \nmodule Main where \n\nimport Data.Char -- 1.3\n\n--1.3:data Maybe a = Nothing | Just a\n\ndata ATree a b = ALeaf\n               | ABranch (ATree a b) a [b] (ATree a b) Int\n                 -- deriving (Eq)\n\ntype SymTable = ATree String Int\n\n\npp_tree :: SymTable -> String\npp_tree ALeaf = \"\"\npp_tree (ABranch l k vs r h)\n  = pp_tree l ++ show (k,reverse vs) ++ \"\\n\" ++ pp_tree r\n\n{-\navAdd :: Ord a  =>  ATree a b -> \n                    a -> \n                    b -> \n                    ATree a b\n-}\navAdd ALeaf xk xv = ABranch ALeaf xk [xv] ALeaf 1\n\navAdd (ABranch l yk yv r hy) xk xv\n   | yk > xk = let (ABranch l1 zk zv l2 _) = avAdd l xk xv\n               in avCombine l1 (f l1) l2 (f l2) r (f r) zk zv yk yv\n   | xk > yk = let (ABranch r1 zk zv r2 _) = avAdd r xk xv\n               in avCombine l (f l) r1 (f r1) r2 (f r2) yk yv zk zv\n   | otherwise  = ABranch l yk (xv:yv) r hy\n   where\n      f :: ATree a b -> Int\n      f ALeaf = 0\n      f (ABranch _ _ _ _ d) = d\n      \n\n\n-- ==========================================================--\n--\n{-\navLookup :: Ord a  =>  ATree a b -> \n                       a -> \n                       Maybe b\n-}\navLookup ALeaf _ = Nothing\n\navLookup (ABranch l k v r _) kk\n   | kk < k     = avLookup l kk\n   | kk > k     = avLookup r kk\n   | otherwise  = Just v\n\n\n\n-- ==========================================================--\n--\navCombine :: ATree a b -> \n             Int -> \n             ATree a b -> \n             Int -> \n             ATree a b -> \n             Int -> \n             a -> \n             [b] -> \n             a -> \n             [b] -> \n             ATree a b\n\navCombine t1 h1 t2 h2 t3 h3 ak av ck cv\n   | h2 > h1 && h2 > h3\n      = ABranch (ABranch t1 ak av t21 (h1+1)) bk bv \n                (ABranch t22 ck cv t3 (h3+1)) (h1+2)\n   | h1 >= h2 && h1 >= h3\n      = ABranch t1 ak av (ABranch t2 ck cv t3 (max1 h2 h3)) \n                (max1 h1 (max1 h2 h3))\n   | h3 >= h2 && h3 >= h1\n      = ABranch (ABranch t1 ak av t2 (max1 h1 h2)) ck cv t3 \n                (max1 (max1 h1 h2) h3)\n   where\n      (ABranch t21 bk bv t22 _) = t2\n      max1 :: Int -> Int -> Int\n      max1 n m = 1 + (if n > m then n else m)\n\n\n-- ==========================================================--\n-- === end                                     AVLTree.hs ===--\n-- ==========================================================--\n\n\n\n\nxref :: SymTable -> Int -> String -> SymTable\n\nxref stab lineno [] = stab\nxref stab lineno ('\\n':cs) = xref stab (lineno+1) cs\nxref stab lineno (c:cs) \n   = if isAlpha c then \n        let (word, rest) = span isAlphaNum cs\n        in  xref (avAdd stab (c:word) lineno) lineno rest\n     else xref stab lineno cs\n\nmain = do\n    s <- getContents\n    putStr (pp_tree (xref ALeaf 1 s))\n\n{-\nDate: Thu, 29 Oct 92 19:38:31 GMT\nFrom: Julian Seward (DRL PhD) <sewardj@uk.ac.man.cs>\nMessage-Id: <9210291938.AA27685@r6b.cs.man.ac.uk>\nTo: partain@uk.ac.glasgow.dcs\nSubject: More ghc vs hbc fiddling (OR: nofib ephemeral contribution (unsolicited :-))\n\nWill,\n\nThere are still some very simple programs for which ghc's performance\nfalls far behind that of hbc's -- even with ghc using a better\nGC.  The stat files below are from a \ncrude cross reference program we hacked together for the purposes\nof an internal \"what-language-to-teach-first-year-undergrads\" debate.\n\nIs this something to do with dictionary zapping?\n\nProgram included below.  Use as a pipe.  Suggest you feed it any\nlarge Haskell source file (I used TypeCheck5.hs from Anna).\n\nJules\n\n---------------------------------------------------------\n\na.out -H9000000 -S \nNw Heap Tt Heap   Stk    GC(real) GC acc (real)     tot (real) newheap    in -dupl  -new  -del  +stk   out  mcode\n  99192   99192    20  0.06   0.1   0.06    0.1    0.16    0.4  396768     0     0     0     0     0     0\n 247752  247752    14  0.13   0.1   0.19    0.2    0.44    0.8  991008     0     0     0     0     0     0\n 623104  623104    34  0.32   0.3   0.51    0.5    1.08    1.5 2492416     0     0     0     0     0     0\n1433968 1433968 15879  0.62   0.8   1.13    1.4    2.66    3.6 5735872     0     0     0     0     0     0\n3009700 3009700  2382  1.56   1.6   2.69    3.0    6.88    8.6 9000000     0     0     0     0     0     0\n         5 GCs,\n      8.69 (13.1) seconds total time,\n      2.69 (3.0) seconds GC time (31.0(23.1)% of total time)\n      0.00 (0.0) seconds major GC time ( 0.0( 0.0)% of total time)\n   9303816 bytes allocated from the heap.\n\n------------------------------------------------\n\nxref +RTS -H9M -S -K200k \n\nCollector: APPEL  HeapSize: 9,437,184 (bytes)\n\n  Alloc   Live   Live   Astk   Bstk OldGen   GC    GC     TOT     TOT  Page Flts  Collec  Resid\n  bytes   bytes    %   bytes  bytes  roots  user  elap    user    elap   GC  TOT   tion   %heap\n4718580  786672  16.7     40    220    424  0.37  0.52    3.67    4.68    0    0   Minor\n4325248  808804  18.7  62724  62820 564968  0.50  0.60    6.63    8.05    0    0   Minor\n3920848  743508  19.0  47512  47600 743220  0.47  0.60    8.60   10.17    0    0   Minor\n3549096  681464  19.2  34644  34892 680820  0.46  0.53   10.43   12.13    0    0   Minor\n3208348  604892  18.9  23564  23676 604512  0.41  0.48   12.07   13.89    0    0   Minor\n2905900  528584  18.2  14164  14396 527952  0.35  0.41   13.53   15.42    0    0   Minor\n2641592  490812  18.6   5228   5388 490476  0.30  0.37   14.85   16.82    0    0   Minor\n2396204  534400  22.3     16     40 534380  0.28  0.32   16.41   18.75    0    0   Minor\n2129016  691708  32.5     36    144 691420  0.33  0.39   18.38   21.68    0    0   Minor\n1090480\n\n30,885,312 bytes allocated in the heap\n         9 garbage collections performed\n\n  Total time  19.29s  (23.06s elapsed)\n  GC time      3.47s  (4.22s elapsed)\n  %GC time    18.0%\n\n--------------------------------------------------\n-}\n", "num_lines": 175}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n-- partain: the failure (crashing) was w/ -prof-auto compilation\n\nmodule Main where\n\nimport Control.Exception (IOException, catch)\n\nxreff :: Int -> [String] -> Table -> Int -> String -> String\nxreff cc exs stab lineno [] = display (foldl delete stab exs)\nxreff cc exs stab lineno ('\\n':cs) = xreff cc exs stab (lineno+1) cs\nxreff cc exs stab lineno (c:cs) \n  = if (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') then\n       case getRestWord cs of\n         (word, rest) -> if (cc :: Int) == 0\n          then   if stab == stab\n                 then\n                    xreff 1000 exs \n                          (enter lineno stab (c:word)) lineno rest\n                 else error \"Force failed?!\"\n          else      xreff (cc-1) exs \n                        (enter lineno stab (c:word)) lineno rest\n      else xreff cc exs stab lineno cs\n\nxref exceptions source = xreff 1000 exceptions ALeaf 1 source\n\ngetRestWord [] = ([], [])\ngetRestWord xs@(x:xs')\n   | (x >= 'a' && x <= 'z') || (x >= 'A' && x <= 'Z') || (x >= '0' && x <= '9')\n   = case getRestWord xs' of \n        (ys,zs) -> if (x >= 'A' && x <= 'Z')\n                   then (toEnum (fromEnum x + (32::Int)):ys, zs)\n                   else (x:ys, zs)\n   | otherwise \n   = ([],xs)\n\ndata Table = ALeaf | ABranch Table String [Int] Table deriving (Eq)\n\nenter n ALeaf w = ABranch ALeaf w [n] ALeaf\nenter n (ABranch l k ns r) w\n = if w < k then ABranch (enter n l w) k ns r else\n   if w > k then ABranch l k ns (enter n r w) else\n                 ABranch l k (n:ns) r\n\ndelete ALeaf w              = ALeaf\ndelete (ABranch l k ns r) w\n = if w < k then ABranch (delete l w) k ns r else\n   if w > k then ABranch l k ns (delete r w) else\n                 ABranch l k [] r\n\ndisplay :: Table -> String\ndisplay t = display_a t \"\"\n\ndisplay_a :: Table -> String -> String\ndisplay_a ALeaf acc = acc\ndisplay_a (ABranch l k ns r) acc\n = display_a l (dispLine k ns ++ display_a r acc)\n\ndispLine k [] = \"\"\ndispLine k ns = k ++ \":\" ++ dispNos ns ++ \"\\n\"\n\ndispNos :: [Int] -> String\ndispNos []     = \"\"\ndispNos (n:ns) = ' ':(show n ++ dispNos ns)\n\nmain = do\n    input <- getContents\n    exceptions <- catch (readFile \"exceptions\") (\\(e :: IOException) -> return \"\")\n    putStr (xref (lines exceptions) input)\n\n{- OLD 1.2:\nmain = readChan stdin abort (\\input ->\n       readFile \"exceptions\"\n                (\\errors     -> output (xref []                 input))\n                (\\exceptions -> output (xref (lines exceptions) input)))\n       where output s = appendChan stdout s abort done\n-}\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "e=181021504832735228091659724090293195791121747536890433\n\nu(f,m)x=i(m(x),       [],let(a,b)=f(x)       in(a:u(f,m)b))\n(v,h)=(foldr(\\x(y    )->00+128*y+x)0,u(     sp(25),((==)\"\")))\np::(Integer,Integer )->Integer      ->     Integer    --NotInt\np(n,m)x     =i(n==0 ,1,i(z n             ,q(n,m)x,    r(n,m)x))\ni(n,e,d     )=if(n) then(e)              else  (d)    --23+3d4f\n(g,main     ,s,un)= (\\x->x,             y(j),\\x->x*x,unlines)--)\nj(o)=i(take(2)o==   \"e=\",\"e=\"++t        (drop(4-2)o),i(d>e,k,l)o)\nl=un.map (show.p      (e,n).v.map(      fromIntegral{-g-}.fromEnum)).h\nk=co.map(map(toEnum       .fromIntegral    ).w.p(d,n).   read).lines\n(t,y)=(\\ (o:q)->              i(o=='-'  ,'1','-' ):   q,interact)\nq(n,m)x=   mod(s(    p(        div(n)2, m{-jl-})x)    )m--hd&&gdb\n(r,z,co)    =(\\(n,   m)x->mod(x*p(n-1,  m)x)m,even    ,concat)--6\n(w,sp)=(    u(\\x->(   mod(x)128,div(x   )128),(==0    )),splitAt)\n\nd=563347325936+1197371806136556985877790097-563347325936\nn=351189532146914946493104395525009571831256157560461451\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nDate: Thu, 22 Sep 1994 01:59:49 +0200\nFrom: Lennart Augustsson <augustss@cs.chalmers.se>\nMessage-Id: <199409212359.BAA01719@statler.cs.chalmers.se>\nTo: glasgow-haskell-bugs@dcs.glasgow.ac.uk\nSubject: ghc bug\n\n\nSome floating constants that are within the floating range\nbecome wrong, e.g.\n\n        1.82173691287639817263897126389712638972163e-300::Double\n\n        -- Lennart\n\nPS.  Maybe you use fromRational as defined in the Prelude?\nThat won't do.  It is badly broken, tell me if you want\none that works.\n-}\n\n-- I have turned this into a general test of extreme constants.\n-- WDP 94/12\n\nmain = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) \"\\n\")\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain = interact ( \\ s -> shows (lex' s) \"\\n\")\n     where lex' \"\" = []\n           lex' s = tok : lex' s' where -- [(tok,s')] = lex s\n                                        (tok,s') = case lex s of\n                                                    [r]   -> r\n                                                    []    -> error (\"Empty: \" ++ s)\n                                                    other -> error (\"Multi: \" ++ s)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--------------------------------\n--      The Game of Life      --\n--------------------------------\n\ngenerations x = 30\n\ndata L a = N | C1 a (L a) | C2 a a (L a)\n\ndata Tuple2 a b = T2 a b\n\ndata Tuple3 a b c = T3 a b c\n\n\nmain = putStr (listChar_string\n                    (append1 (C1 '\\FF' N)\n                             (life1 (generations ()) (start ()))))\n\nlistChar_string :: L Char -> String\nlistChar_string N = []\nlistChar_string (C1 x xs) = x : listChar_string xs\n\nstart :: a -> L (L Int)\nstart x = (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1 N\n          (C1\n           (C1 0\n           (C1 0\n           (C1 0\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 0\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 0\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 0\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 1\n           (C1 0 N))))))))))))))))))))))))))) N)))))))))))))))\n\n-- Calculating the next generation\n\ngen1 :: Int -> L (L Int) -> L (L Int)\ngen1 n board = map1 row1 (shift1 (copy1 n 0) board)\n\nrow1 :: Tuple3 (L Int) (L Int) (L Int) -> L Int\nrow1 (T3 last this next)\n  = zipWith31 elt1 (shift2 0 last)\n                   (shift2 0 this)\n                   (shift2 0 next)\n\n\nelt1 :: Tuple3 Int Int Int\n        -> (Tuple3 Int Int Int)\n        -> (Tuple3 Int Int Int) -> Int\nelt1 (T3 a b c) (T3 d e f) (T3 g h i)\n = if (not (eq tot 2))\n          && (not (eq tot 3))\n      then 0\n      else if (eq tot 3) then 1 else e\n   where tot = a `plus` b `plus` c `plus` d\n               `plus` f `plus` g `plus` h `plus` i\n\neq :: Int -> Int -> Bool\neq x y = x == y\n\nplus :: Int -> Int -> Int\nplus x y = x + y\n\nshiftr1 :: L Int -> L (L Int) -> L (L Int)\nshiftr1 x xs = append2 (C1 x N)  (init1 xs)\n\nshiftl1 :: L Int -> L (L Int) -> L (L Int)\nshiftl1 x xs = append2 (tail1 xs) (C1 x N)\n\nshift1 :: L Int -> L (L Int)\n            -> L (Tuple3 (L Int) (L Int) (L Int))\nshift1 x xs = zip31 (shiftr1 x xs) xs (shiftl1 x xs)\n\nshiftr2 :: Int -> L Int -> L Int\nshiftr2 x xs = append3 (C1 x N) (init2 xs)\n\nshiftl2 :: Int -> L Int -> L Int\nshiftl2 x xs = append3 (tail2 xs) (C1 x N)\n\nshift2 :: Int -> L Int -> L (Tuple3 Int Int Int)\nshift2 x xs = zip32 (shiftr2 x xs) xs (shiftl2 x xs)\n\n-- copy\n\ncopy1 :: Int -> Int -> L Int\ncopy1 0 x = N\ncopy1 n x = C1 x (copy1 (n-1) x)\n\ncopy2 :: Int -> L Int -> L (L Int)\ncopy2 0 x = N\ncopy2 n x = C1 x (copy2 (n-1) x)\n\ncopy3 :: Int -> Char -> L Char\ncopy3 0 x = N\ncopy3 n x = C1 x (copy3 (n-1) x)\n\n-- Displaying one generation\n\ndisp1 :: (Tuple2 (L Char) (L (L Int))) -> L Char\ndisp1 (T2 gen xss)\n = append1 gen\n    (append1 (C1 '\\n' (C1 '\\n' N))\n             (foldr_1 (glue1 (C1 '\\n' N)) N\n                       (map4 (compose2 concat1 (map2 star1)) xss)))\n\nstar1 :: Int -> L Char\nstar1 i = case i of\n           0 -> C1 ' ' (C1 ' ' N)\n           1 -> C1 ' ' (C1 'o' N)\n\nglue1 :: L Char -> L Char -> L Char -> L Char\nglue1 s xs ys = append1 xs (append1 s ys)\n\n-- Generating and displaying a sequence of generations\n\nlife1 :: Int -> L (L Int) -> L Char\nlife1 n xss\n  = foldr_1 (glue1 (copy3 (n+2) '\\VT')) N\n            (map5 disp1\n              (zip1_ (map6 (string_ListChar.show) (ints 0))\n                    gens))\n    where\n    gens = take3 (100 {-740-}::Int) (iterate1 (gen1 n) (initial1 n xss))\n\nints :: Int -> L Int\nints x = C1 x (ints (x+1))\n\nstring_ListChar :: String -> L Char\nstring_ListChar [] = N\nstring_ListChar (x:xs) = C1 x (string_ListChar xs)\n\ninitial1 :: Int -> L (L Int) -> L (L Int)\ninitial1 n xss = take1 n (append2 (map3 (compose1 (take2 n)\n                           (`append3` (copy1 n 0))) xss)\n                                (copy2 n (copy1 n 0)))\n\niterate1 :: (L (L Int) -> L (L Int))\n               -> L (L Int) -> L (L (L Int))\niterate1 f x = C1 x (iterate1 f (f x))\n\n-- versions of built in functions\n\n-- take\ntake1 :: Int -> L (L Int) -> L (L Int)\ntake1 0 _ = N\ntake1 _ N = N\n--should be:take1 (n+1) (C1 x xs) = C1 x (take1 n xs)\ntake1 n (C1 x xs) | n < 0     = error \"Main.take1\"\n                  | otherwise = C1 x (take1 (n-1) xs)\n\ntake2 :: Int -> L Int -> L Int\ntake2 0 _ = N\ntake2 _ N = N\n--should be:take2 (n+1) (C1 x xs) = C1 x (take2 n xs)\ntake2 n (C1 x xs) | n < 0     = error \"Main.take2\"\n                  | otherwise = C1 x (take2 (n-1) xs)\n\ntake3 :: Int -> L (L (L Int))\n             -> L (L (L Int))\ntake3 0 _ = N\ntake3 _ N = N\ntake3 n (C1 x xs) = C1 x (take3 (n-1) xs)\n\n-- init\n\ninit1 :: L (L Int) -> L (L Int)\ninit1 (C1 x N) = N\ninit1 (C1 x xs) = C1 x (init1 xs)\ninit1 N = error \"init1 got a bad list\"\n\ninit2 :: L Int -> L Int\ninit2 (C1 x N) = N\ninit2 (C1 x xs) = C1 x (init2 xs)\ninit2 N = error \"init1 got a bad list\"\n\n-- tail\n\ntail1 :: L (L Int) -> L (L Int)\ntail1 (C1 _ xs) = xs\ntail1 N = error \"tail1 got a bad list\"\n\ntail2 :: L Int -> L Int\ntail2 (C1 _ xs) = xs\ntail2 N = error \"tail2 got a bad list\"\n\n-- maps\n\nmap1 :: (Tuple3 (L Int) (L Int) (L Int) -> L Int) ->\n                L (Tuple3 (L Int) (L Int) (L Int))\n             -> L (L Int)\nmap1 f N = N\nmap1 f (C1 x xs) = C1 (f x) (map1 f xs)\n\nmap2 :: (Int -> L Char) -> L Int -> L (L Char)\nmap2 f N = N\nmap2 f (C1 x xs) = C1 (f x) (map2 f xs)\n\nmap3 :: (L Int -> L Int) -> L (L Int) -> L (L Int)\nmap3 f N = N\nmap3 f (C1 x xs) = C1 (f x) (map3 f xs)\n\nmap4 :: (L Int -> L Char)\n         -> L (L Int) -> L (L Char)\nmap4 f N = N\nmap4 f (C1 x xs) = C1 (f x) (map4 f xs)\n\nmap5 :: (Tuple2 (L Char) (L (L Int)) -> L Char)\n          -> L (Tuple2 (L Char) (L (L Int)))\n          -> L (L Char)\nmap5 f N = N\nmap5 f (C1 x xs) = C1 (f x) (map5 f xs)\n\nmap6 :: (Int -> L Char) -> L Int -> L (L Char)\nmap6 f N = N\nmap6 f (C1 x xs) = C1 (f x) (map6 f xs)\n\n-- compose\n\ncompose2 :: (L (L Char) -> L Char)\n            -> (L Int -> L (L Char))\n            -> L Int -> L Char\ncompose2 f g xs = f (g xs)\n\ncompose1 :: (L Int -> L Int)\n             -> (L Int -> L Int) -> L Int -> L Int\ncompose1 f g xs = f (g xs)\n\n-- concat\n\nconcat1 :: L (L Char) -> L Char\nconcat1 = foldr_1 append1 N\n\n-- foldr\n\nfoldr_1 :: (L Char -> L Char -> L Char)\n            -> L Char -> L (L Char) -> L Char\nfoldr_1 f a N = a\nfoldr_1 f a (C1 x xs) = f x (foldr_1 f a xs)\n\n-- appends\n\nappend1 :: L Char -> L Char -> L Char\nappend1 N ys = ys\nappend1 (C1 x xs) ys = C1 x (append1 xs ys)\n\nappend2 :: L (L Int) -> L (L Int) -> L (L Int)\nappend2 N ys = ys\nappend2 (C1 x xs) ys = C1 x (append2 xs ys)\n\nappend3 :: L Int -> L Int -> L Int\nappend3 N ys = ys\nappend3 (C1 x xs) ys = C1 x (append3 xs ys)\n\n-- zips\n\npzip f (C1 x1 xs) (C1 y1 ys)\n = C1 (f x1 y1) (pzip f xs ys)\npzip f _ _ = N\n\n\nzip1_ :: L (L Char)\n         -> L (L (L Int))\n         -> L (Tuple2 (L Char) (L (L Int)))\nzip1_ = pzip T2\n\nzip2_ :: L (L Int)\n         -> L (L Int)\n         -> L (Tuple2 (L Int) (L Int))\nzip2_ = pzip T2\n\nzip3d :: L Int -> (Tuple2 (L Int) (L Int))\n            -> (Tuple3 (L Int) (L Int) (L Int))\nzip3d x (T2 y z) = T3 x y z\n\nzip3_ :: L (L Int)\n         -> L (Tuple2 (L Int) (L Int))\n         -> L (Tuple3 (L Int) (L Int) (L Int))\nzip3_ = pzip zip3d\n\nzip4_ :: L Int\n         -> L Int\n         -> L (Tuple2 Int Int)\nzip4_ = pzip T2\n\nzip5d :: Int -> (Tuple2 Int Int) -> (Tuple3 Int Int Int)\nzip5d x (T2 y z) = T3 x y z\n\nzip5_ :: L Int\n         -> L (Tuple2 Int Int)\n         -> L (Tuple3 Int Int Int)\nzip5_ = pzip zip5d\n\nzip6_ :: L (Tuple3 Int Int Int)\n         -> L (Tuple3 Int Int Int)\n         -> L (Tuple2 (Tuple3 Int Int Int)\n                      (Tuple3 Int Int Int))\nzip6_ = pzip T2\n\nzip31 :: L (L Int) -> L (L Int)\n         -> L (L Int)\n         -> L (Tuple3 (L Int) (L Int) (L Int))\nzip31 as bs cs\n  = zip3_ as (zip2_ bs cs)\n\nzip32 :: L Int -> L Int -> L Int\n          -> L (Tuple3 Int Int Int)\nzip32 as bs cs\n  = zip5_ as (zip4_ bs cs)\n\n-- zipWith\n\nzipWith21 :: ((Tuple3 Int Int Int)\n              -> (Tuple2 (Tuple3 Int Int Int)\n                         (Tuple3 Int Int Int)) -> Int)\n              -> L (Tuple3 Int Int Int)\n              -> L (Tuple2 (Tuple3 Int Int Int)\n                           (Tuple3 Int Int Int))\n              -> L Int\nzipWith21 = pzip\n\nzipWith31 :: ((Tuple3 Int Int Int)\n              -> (Tuple3 Int Int Int)\n              -> (Tuple3 Int Int Int) -> Int)\n               -> L (Tuple3 Int Int Int)\n               -> L (Tuple3 Int Int Int)\n               -> L (Tuple3 Int Int Int) -> L Int\nzipWith31 z as bs cs\n = zipWith21 z' as (zip6_ bs cs)\n   where z' a (T2 b c) = z a b c\n", "num_lines": 361}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- Test code for Data.HashTable -}\n\nmodule Main(main) where\n\nimport Prelude hiding (lookup)\nimport qualified Prelude (lookup)\nimport Data.Maybe(isJust,isNothing)\nimport Data.Int(Int32)\nimport Test.QuickCheck\nimport System.IO.Unsafe(unsafePerformIO)\nimport Data.HashTab\nimport Control.Monad(liftM2, foldM)\nimport System.Random\nimport System.Environment\n\ninfixr 0 ==.\ninfixr 0 ==~\ninfixr 0 ~~\n\ntype HT = HashTable Int Int\nnewtype HashFun = HF {unHF :: (Int -> Int32)}\ndata Empty = E {e :: (IO HT), hfe :: HashFun}\ndata MkH   = H {h :: (IO HT), hfh :: HashFun}\nnewtype List a = L [a]\n\ndata Action = Lookup Int\n            | Insert Int Int\n            | Delete Int\n            | Update Int Int\n            deriving (Show)\n\ninstance Arbitrary Action where\n  arbitrary = frequency [(10,fmap Lookup arbitrary),\n                         (5, liftM2 Insert arbitrary arbitrary),\n                         (3, liftM2 Update arbitrary arbitrary),\n                         (1, fmap Delete arbitrary)]\n\nsimA :: [Action] -> [Either Bool [Int]]\nsimA = fst . foldl sim ([],[])\n  where sim :: ([Either Bool [Int]], [Action]) -> Action ->\n               ([Either Bool [Int]], [Action])\n        sim (res, past) (Lookup k)   = (Right (lkup k past) : res, past)\n        sim (res, past) (Insert k v) = (res, Insert k v : past)\n        sim (res, past) (Delete k)   = (res, Delete k   : past)\n        sim (res, past) (Update k v) =\n          (Left (not (null l)) : res, Update k v : past)\n          where l = lkup k past\n        lkup _ [] = []\n        lkup k (Delete k' : _)\n          | k==k' = []\n        lkup k (Update k' v : _)\n          | k==k'     = [v]\n        lkup k (Insert k' v : past)\n          | k==k'     = v:lkup k past\n        lkup k (_ : past) = lkup k past\n\nrunA :: HashFun -> [Action] -> IO [Either Bool (Maybe Int)]\nrunA hf acts = do\n  ht <- new (==) (unHF hf)\n  let run res (Lookup a) = fmap (lkup res) $ lookup ht a\n      run res (Insert k v) = insert ht k v >> return res\n      run res (Delete k)   = delete ht k   >> return res\n      run res (Update k v) = fmap (upd res) $ update ht k v\n      lkup res m = Right m : res\n      upd res b = Left b : res\n  foldM run [] acts\n\n(~~) :: IO [Either Bool (Maybe Int)] -> [Either Bool [Int]] -> Bool\nacts ~~ sims = and $ zipWith same (unsafePerformIO acts) sims\n  where same (Left b)         (Left b')  = b==b'\n        same (Right Nothing)  (Right []) = True\n        same (Right (Just a)) (Right xs) = a `elem` xs\n        same _                _          = False\n\nlookups :: HT -> [Int] -> IO [Maybe Int]\nlookups ht ks = mapM (lookup ht) ks\n\ninstance Show HashFun where\n  showsPrec _ (HF hf) r\n      | hf 1 == 0 = \"degenerate\"++r\n      | otherwise = \"usual\"++r\n\ninstance Show Empty where\n  showsPrec _ ee r = shows (hfe ee) r\n\ninstance Show MkH where\n  showsPrec _ hh r = shows (hfh hh) $\n                     (\"; \"++shows (unsafePerformIO (h hh >>= toList)) r)\n\ninstance Show a => Show (List a) where\n  showsPrec _ (L l) r = shows l r\n\ninstance Arbitrary HashFun where\n  arbitrary = frequency [(20,return (HF hashInt)),\n                         (1,return (HF (const 0)))]\n\ninstance Arbitrary Empty where\n  arbitrary = fmap mkE arbitrary\n    where mkE (HF hf) = E {e = new (==) hf, hfe=HF hf}\n\ninstance Arbitrary a => Arbitrary (List a) where\n  arbitrary = do\n    sz <- frequency [(50, sized return),\n                     (1,return (4096*2)),\n                     (0, return (1024*1024))]\n    resize sz $ fmap L $ sized vector\n\ninstance Arbitrary MkH where\n  arbitrary = do\n    hf <- arbitrary\n    L list <- arbitrary\n    let mkH act = H { h = act, hfh = hf }\n    return (mkH . fromList (unHF hf) $ list)\n\n(==~) :: (Eq a) => IO a -> IO a -> Bool\nact1 ==~ act2 = unsafePerformIO act1 == unsafePerformIO act2\n\n(==.) :: (Eq a) => IO a -> a -> Bool\nact ==. v = unsafePerformIO act == v\n\nnotin :: (Testable a) => Int -> MkH -> a -> Property\nk `notin` hh = \\prop ->\n  let f = (not . isJust . unsafePerformIO) (h hh >>= flip lookup k) in\n  f `trivial` prop\n\nprop_emptyLookup :: Empty -> Int -> Bool\nprop_emptyLookup ee k =\n  isNothing . unsafePerformIO $\n  (do mt <- e ee\n      lookup mt k)\n\nprop_emptyToList :: Empty -> Bool\nprop_emptyToList ee =\n  (do mt <- e ee\n      toList mt) ==. []\n\nprop_emptyFromList :: HashFun -> Int -> Bool\nprop_emptyFromList hf k =\n  (do mt <- new (==) (unHF hf) :: IO HT\n      lookup mt k) ==~\n  (do mt <- fromList (unHF hf) []\n      lookup mt k)\n\nprop_insert :: MkH -> Int -> Int -> Bool\nprop_insert hh k v =\n  (do ht <- h hh\n      insert ht k v\n      lookup ht k) ==. Just v\n\nprop_insertu :: MkH -> Int -> Int -> List Int -> Bool\nprop_insertu hh k v (L ks) =\n  let ks' = filter (k /=) ks in\n  (do ht <- h hh\n      insert ht k v\n      lookups ht ks') ==~\n  (do ht <- h hh\n      lookups ht ks')\n\nprop_delete :: MkH -> Int -> Property\nprop_delete hh k =\n  k `notin` hh $\n  isNothing . unsafePerformIO $\n  (do ht <- h hh\n      delete ht k\n      lookup ht k)\n\nprop_deleteu :: MkH -> Int -> List Int -> Bool\nprop_deleteu hh k (L ks) =\n  let ks' = filter (k /=) ks in\n  (do ht <- h hh\n      delete ht k\n      lookups ht ks') ==~\n  (do ht <- h hh\n      lookups ht ks')\n\nnaiveUpdate :: HT -> Int -> Int -> IO ()\nnaiveUpdate ht k v = do\n  delete ht k\n  insert ht k v\n\nprop_update :: MkH -> Int -> Int -> List Int -> Bool\nprop_update hh k v (L ks) =\n  (do ht <- h hh\n      _ <- update ht k v\n      lookups ht ks) ==~\n  (do ht <- h hh\n      naiveUpdate ht k v\n      lookups ht ks)\n\nprop_updatec :: MkH -> Int -> Int -> Bool\nprop_updatec hh k v =\n  (do ht <- h hh\n      _ <- update ht k v\n      lookup ht k) ==. Just v\n\nprop_updateLookup :: MkH -> Int -> Int -> Property\nprop_updateLookup hh k v =\n  k `notin` hh $\n  (do ht <- h hh\n      update ht k v) ==~\n  (do ht <- h hh\n      fmap isJust (lookup ht k))\n\nprop_simulation :: HashFun -> List Action -> Property\nprop_simulation hf (L acts) =\n  (null acts `trivial`) $\n  runA hf acts ~~ simA acts\n\n{-\n\nFor \"fromList\" and \"toList\" properties we're a bit sloppy: we perform\nmultiple insertions for a key (potentially) but give nor promises\nabout which one we will retrieve with lookup, or what order they'll be\nreturned by toList (or if they'll all be returned at all).  Thus we\ninsert all occurrences of a key with the same value, and do all\nchecking via lookups.\n\n-}\n\nprop_fromList :: HashFun -> List Int -> List Int -> Property\nprop_fromList hf (L l) (L ks) =\n  null l `trivial`\n  let assocs = map (\\t -> (t,t)) l in\n  ( do ht <- fromList (unHF hf) assocs\n       lookups ht ks) ==. (map (`Prelude.lookup` assocs) ks)\n\nprop_fromListInsert :: HashFun -> List (Int,Int) -> Int -> Int -> List Int -> Property\nprop_fromListInsert hf (L l) k v (L ks) =\n  null l `trivial`\n  (( do ht <- fromList (unHF hf) l\n        insert ht k v\n        lookups ht ks) ==~\n   ( do ht <- fromList (unHF hf) (l++[(k,v)])\n        lookups ht ks))\n\nprop_toList :: HashFun -> List Int -> List Int -> Property\nprop_toList hf (L l) (L ks) =\n  null l `trivial`\n  let assocs = map (\\t -> (t,t)) l in\n  ( do ht <- fromList (unHF hf) assocs\n       lookups ht ks) ==~\n  ( do ht <- fromList (unHF hf) assocs\n       fmap (\\as -> map (`Prelude.lookup` as) ks) $ toList ht )\n\nte :: (Testable a) => String -> a -> IO ()\n-- te name prop = putStrLn name >> verboseCheck prop\nte name prop = do\n  putStr name\n  quickCheckWith stdArgs { maxSuccess = 500, maxSize = 10000 } prop\n\nmain :: IO ()\nmain = do\n  [r] <- getArgs\n  setStdGen (mkStdGen (read r :: Int))\n  sequence_ $\n    [ te \"emptyLookup:\" prop_emptyLookup,\n      te \"emptyToList:\" prop_emptyToList,\n      te \"emptyFromList:\" prop_emptyFromList,\n      te \"insert:\" prop_insert,\n      te \"insertu:\" prop_insertu,\n      te \"delete:\" prop_delete,\n      te \"deleteu:\" prop_deleteu,\n      te \"update:\" prop_update,\n      te \"updatec:\" prop_updatec,\n      te \"updateLookup:\" prop_updateLookup,\n      te \"fromList:\" prop_fromList,\n      te \"fromListInsert:\" prop_fromListInsert,\n      te \"toList:\" prop_toList,\n      te \"simulation:\" prop_simulation\n    ]\n  putStrLn \"OK\"\n", "num_lines": 272}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Data.HashTable\n-- Copyright   :  (c) The University of Glasgow 2003\n-- License     :  BSD-style (see the file libraries/base/LICENSE)\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- An implementation of extensible hash tables, as described in\n-- Per-Ake Larson, /Dynamic Hash Tables/, CACM 31(4), April 1988,\n-- pp. 446--457.  The implementation is also derived from the one\n-- in GHC's runtime system (@ghc\\/rts\\/Hash.{c,h}@).\n--\n-----------------------------------------------------------------------------\n\nmodule Data.HashTab (\n        -- * Basic hash table operations\n        HashTable, new, insert, delete, lookup, update,\n        -- * Converting to and from lists\n        fromList, toList,\n        -- * Hash functions\n        -- $hash_functions\n        hashInt, hashString,\n        prime,\n        -- * Diagnostics\n        longestChain\n ) where\n\n-- This module is imported by Data.Typeable, which is pretty low down in the\n-- module hierarchy, so don't import \"high-level\" modules\n\n-- Right now we import high-level modules with gay abandon.\nimport Prelude  hiding  ( lookup )\nimport Data.Tuple       ( fst )\nimport Data.Bits\nimport Data.Maybe\nimport Data.List        ( maximumBy, partition, concat, foldl )\nimport Data.Int         ( Int32 )\n\nimport Data.Array.Base\nimport Data.Array       hiding (bounds)\nimport Data.Array.IO\n\nimport Data.Char        ( ord )\nimport Data.IORef       ( IORef, newIORef, readIORef, writeIORef )\nimport Control.Monad    ( mapM, sequence_ )\n\n\n-----------------------------------------------------------------------\n\nreadHTArray  :: HTArray a -> Int32 -> IO a\nreadMutArray  :: MutArray a -> Int32 -> IO a\nwriteMutArray :: MutArray a -> Int32 -> a -> IO ()\nfreezeArray  :: MutArray a -> IO (HTArray a)\nthawArray    :: HTArray a -> IO (MutArray a)\nnewMutArray   :: (Int32, Int32) -> a -> IO (MutArray a)\n#if defined(DEBUG) || defined(__NHC__)\ntype MutArray a = IOArray Int32 a\ntype HTArray a = MutArray a\nnewMutArray = newArray\nreadHTArray  = readArray\nreadMutArray = readArray\nwriteMutArray = writeArray\nfreezeArray = return\nthawArray = return\n#else\ntype MutArray a = IOArray Int32 a\ntype HTArray a = Array Int32 a\nnewMutArray = newArray\nreadHTArray arr i = return $! (unsafeAt arr (fromIntegral i))\nreadMutArray arr i = unsafeRead arr (fromIntegral i)\nwriteMutArray arr i x = unsafeWrite arr (fromIntegral i) x\nfreezeArray = unsafeFreeze\nthawArray = unsafeThaw\n#endif\n\nnewtype HashTable key val = HashTable (IORef (HT key val))\n-- TODO: the IORef should really be an MVar.\n\ndata HT key val\n  = HT {\n        kcount  :: !Int32,              -- Total number of keys.\n        buckets :: !(HTArray [(key,val)]),\n        bmask   :: !Int32,\n        hash_fn :: key -> Int32,\n        cmp     :: key -> key -> Bool\n   }\n\n-- -----------------------------------------------------------------------------\n-- Sample hash functions\n\n-- $hash_functions\n--\n-- This implementation of hash tables uses the low-order /n/ bits of the hash\n-- value for a key, where /n/ varies as the hash table grows.  A good hash\n-- function therefore will give an even distribution regardless of /n/.\n--\n-- If your keyspace is integrals such that the low-order bits between\n-- keys are highly variable, then you could get away with using 'id'\n-- as the hash function.\n--\n-- We provide some sample hash functions for 'Int' and 'String' below.\n\n-- | A sample hash function for 'Int', implemented as simply @(x `mod` P)@\n-- where P is a suitable prime (currently 1500007).  Should give\n-- reasonable results for most distributions of 'Int' values, except\n-- when the keys are all multiples of the prime!\n--\nhashInt :: Int -> Int32\nhashInt = (`rem` prime) . fromIntegral\n\n-- | A sample hash function for 'String's.  The implementation is:\n--\n-- >    hashString = fromIntegral . foldr f 0\n-- >      where f c m = ord c + (m * 128) `rem` 1500007\n--\n-- which seems to give reasonable results.\n--\nhashString :: String -> Int32\nhashString = fromIntegral . foldl f 0\n  where f m c = ord c + (m * 128) `rem` fromIntegral prime\n\n-- | A prime larger than the maximum hash table size\nprime :: Int32\nprime = 1500007\n\n-- -----------------------------------------------------------------------------\n-- Parameters\n\ntABLE_MAX  = 1024 * 1024 :: Int32  -- Maximum size of hash table\n#if tABLE_MIN\n#else\ntABLE_MIN  = 16 :: Int32\n\nhLOAD = 4 :: Int32 -- Maximum average load of a single hash bucket\n\nhYSTERESIS = 0 :: Int32 -- entries to ignore in load computation\n#endif\n\n{- Hysteresis favors long association-list-like behavior for small tables. -}\n\n-- -----------------------------------------------------------------------------\n-- Creating a new hash table\n\n-- | Creates a new hash table.  The following property should hold for the @eq@\n-- and @hash@ functions passed to 'new':\n--\n-- >   eq A B  =>  hash A == hash B\n--\nnew\n  :: (key -> key -> Bool)    -- ^ @eq@: An equality comparison on keys\n  -> (key -> Int32)          -- ^ @hash@: A hash function on keys\n  -> IO (HashTable key val)  -- ^ Returns: an empty hash table\n\nnew cmpr hash = do\n  -- make a new hash table with a single, empty, segment\n  let mask = tABLE_MIN-1\n  bkts'  <- newMutArray (0,mask) []\n  bkts   <- freezeArray bkts'\n\n  let\n    kcnt = 0\n    ht = HT {  buckets=bkts, kcount=kcnt, bmask=mask,\n               hash_fn=hash, cmp=cmpr }\n\n  table <- newIORef ht\n  return (HashTable table)\n\n-- -----------------------------------------------------------------------------\n-- Inserting a key\\/value pair into the hash table\n\n-- | Inserts a key\\/value mapping into the hash table.\n--\n-- Note that 'insert' doesn't remove the old entry from the table -\n-- the behaviour is like an association list, where 'lookup' returns\n-- the most-recently-inserted mapping for a key in the table.  The\n-- reason for this is to keep 'insert' as efficient as possible.  If\n-- you need to update a mapping, then we provide 'update'.\n--\ninsert :: HashTable key val -> key -> val -> IO ()\n\ninsert (HashTable ref) key val = do\n  table@HT{ kcount=k, buckets=bkts, bmask=b } <- readIORef ref\n  let table1 = table{ kcount = k+1 }\n      indx = bucketIndex table key\n  bucket <- readHTArray bkts indx\n  bkts' <- thawArray bkts\n  writeMutArray bkts' indx ((key,val):bucket)\n  freezeArray bkts'\n  table2 <-\n        if tooBig k b\n           then expandHashTable table1\n           else return table1\n  writeIORef ref table2\n\ntooBig :: Int32 -> Int32 -> Bool\ntooBig k b = k-hYSTERESIS > hLOAD * b\n\nbucketIndex :: HT key val -> key -> Int32\nbucketIndex HT{ hash_fn=hash, bmask=mask } key =\n  let h = hash key\n  in  (h .&. mask)\n\nexpandHashTable :: HT key val -> IO (HT key val)\nexpandHashTable\n      table@HT{ buckets=bkts, bmask=mask } = do\n   let\n      oldsize = mask + 1\n      newmask = mask + mask + 1\n      newsize = newmask + 1\n   --\n   if newsize > tABLE_MAX\n      then return table\n      else do\n   --\n   newbkts' <- newMutArray (0,newmask) []\n\n   let\n    table'=table{ bmask=newmask }\n    splitBucket oldindex = do\n      bucket <- readHTArray bkts oldindex\n      let (oldb,newb) = partition ((oldindex==).bucketIndex table' . fst) bucket\n      writeMutArray newbkts' oldindex oldb\n      writeMutArray newbkts' (oldindex + oldsize) newb\n   mapM_ splitBucket [0..mask]\n\n   newbkts <- freezeArray newbkts'\n\n   return ( table'{ buckets=newbkts } )\n\n-- -----------------------------------------------------------------------------\n-- Deleting a mapping from the hash table\n\n-- Remove a key from a bucket\ndeleteBucket :: (key -> Bool) -> [(key,val)] -> (Int32, [(key, val)])\ndeleteBucket _   [] = (0,[])\ndeleteBucket del (pair@(k,_):bucket) =\n  case deleteBucket del bucket of\n    (dels, bucket') | del k     -> dels' `seq` (dels', bucket')\n                    | otherwise -> (dels, pair:bucket')\n      where dels' = dels + 1\n\n-- | Remove an entry from the hash table.\ndelete :: HashTable key val -> key -> IO ()\n\ndelete (HashTable ref) key = do\n  table@HT{ buckets=bkts, kcount=kcnt, cmp=cmpr } <- readIORef ref\n  let indx = bucketIndex table key\n  bkts' <- thawArray bkts\n  bucket <- readMutArray bkts' indx\n  let (removed,bucket') = deleteBucket (cmpr key) bucket\n  writeMutArray bkts' indx bucket'\n  freezeArray bkts'\n  writeIORef ref ( table{kcount = kcnt - removed} )\n\n-- -----------------------------------------------------------------------------\n-- Updating a mapping in the hash table\n\n-- | Updates an entry in the hash table, returning 'True' if there was\n-- already an entry for this key, or 'False' otherwise.  After 'update'\n-- there will always be exactly one entry for the given key in the table.\n--\n-- 'insert' is more efficient than 'update' if you don't care about\n-- multiple entries, or you know for sure that multiple entries can't\n-- occur.  However, 'update' is more efficient than 'delete' followed\n-- by 'insert'.\nupdate :: HashTable key val -> key -> val -> IO Bool\n\nupdate (HashTable ref) key val = do\n  table@HT{ kcount=k, buckets=bkts, cmp=cmpr, bmask=b } <- readIORef ref\n  let indx = bucketIndex table key\n  bkts' <- thawArray bkts\n  bucket <- readMutArray bkts' indx\n  let (deleted,bucket') = deleteBucket (cmpr key) bucket\n      k' = k + 1 - deleted\n      table1 = table{ kcount=k' }\n\n  writeMutArray bkts' indx ((key,val):bucket')\n  freezeArray bkts'\n  table2 <-\n        if tooBig k' b          -- off by one from insert's resize heuristic.\n           then expandHashTable table1\n           else return table1\n  writeIORef ref table2\n  return (deleted>0)\n\n-- -----------------------------------------------------------------------------\n-- Looking up an entry in the hash table\n\n-- | Looks up the value of a key in the hash table.\nlookup :: HashTable key val -> key -> IO (Maybe val)\n\nlookup (HashTable ref) key = do\n  table@HT{ buckets=bkts, cmp=cmpr } <- readIORef ref\n  let indx = bucketIndex table key\n  bucket <- readHTArray bkts indx\n  case [ val | (key',val) <- bucket, cmpr key key' ] of\n        [] -> return Nothing\n        (v:_) -> return (Just v)\n\n-- -----------------------------------------------------------------------------\n-- Converting to/from lists\n\n-- | Convert a list of key\\/value pairs into a hash table.  Equality on keys\n-- is taken from the Eq instance for the key type.\n--\nfromList :: (Eq key) => (key -> Int32) -> [(key,val)] -> IO (HashTable key val)\nfromList hash list = do\n  table <- new (==) hash\n  sequence_ [ insert table k v | (k,v) <- list ]\n  return table\n\n-- | Converts a hash table to a list of key\\/value pairs.\n--\ntoList :: (Ord key, Ord val) => HashTable key val -> IO [(key,val)]\ntoList (HashTable ref) = do\n  HT{ buckets=bkts, bmask=b } <- readIORef ref\n  fmap concat (mapM (readHTArray bkts) [0..b])\n\n-- -----------------------------------------------------------------------------\n-- Diagnostics\n\n-- | This function is useful for determining whether your hash function\n-- is working well for your data set.  It returns the longest chain\n-- of key\\/value pairs in the hash table for which all the keys hash to\n-- the same bucket.  If this chain is particularly long (say, longer\n-- than 10 elements), then it might be a good idea to try a different\n-- hash function.\n--\nlongestChain :: HashTable key val -> IO [(key,val)]\nlongestChain (HashTable ref) = do\n  HT{ buckets=bkts, bmask=b } <- readIORef ref\n  let lengthCmp (_:x)(_:y) = lengthCmp x y\n      lengthCmp []   []    = EQ\n      lengthCmp []   _     = LT\n      lengthCmp _    []    = GT\n  fmap (maximumBy lengthCmp) (mapM (readHTArray bkts) [0..b])\n", "num_lines": 340}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Array -- 1.3\n\nval1, val2 :: Array (Int,Int) Int\nval1 = array ((1,2), (2,1)) []\nval2 = array ((2,1), (1,2)) []\n \nval3 :: Array Integer Double\nval3 = array (4, -3) []\n\nmain = print ((val1 == val1) && (val2 == val2) && (val3 == val3))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main(main) where\n\n--import Int( Num(fromInt) )\n\nnewtype RNG_State = RNG_State (Int, Int, Int)\n\nnew_random i = RNG_State (i `mod` 30269, i `mod` 30307, i `mod` 30323)\n\nnext_unit_random (RNG_State (a,b,c)) =\n  (r, RNG_State (a1,b1,c1))\n  where a1 = (a * 171) `mod` 30269\n        b1 = (b * 172) `mod` 30307\n        c1 = (c * 170) `mod` 30323\n        t  = fromIntegral a1/30269.0 +\n             fromIntegral b1/30307.0 +\n             fromIntegral c1/30323.0\n        r  = t - fromIntegral (truncate t)\n\nnext_random_bool p s =\n  (r < p, s1)\n  where (r,s1) = next_unit_random s\n\nnext_random_list f n s =\n  loop [] n s\n  where loop ps 0 s = (ps, s)\n        loop ps m s = loop (p:ps) (m-1) s1\n                      where (p,s1) = f s\n\nrpart []     _ _ ps qs s = ((ps, qs), s)\nrpart (x:xs) n d ps qs s =\n    if   d*r < n\n    then rpart xs (n-1.0) (d-1.0) (x:ps) qs s1\n    else rpart xs    n    (d-1.0) ps (x:qs) s1\n    where (r, s1) = next_unit_random s\n\nrandom_permutation xs s =\n  rperm xs (length xs) [] s\n  where rperm []      0 ps s = (ps, s)\n        rperm [x1]    1 ps s = ((x1:ps), s)\n        rperm [x1,x2] 2 ps s =\n          if b then (x1:x2:ps, s1) else (x2:x1:ps, s1)\n          where (b, s1) = next_random_bool 0.5 s\n        rperm xs d ps s =\n          let n = d `div` 2\n              ((ys, zs), s1) = rpart xs (fromIntegral n) (fromIntegral d) [] [] s\n              (zps, s2) = rperm zs (d-n) ps s1\n          in rperm ys n zps s2\n          \nminit m n g =\n  outer (m-1) []\n  where outer (-1) xss = xss\n        outer m xss = outer (m-1) (inner (n-1) [] : xss)\n                      where inner (-1) xs = xs\n                            inner n    xs = inner (n-1) (g m n : xs)\n\nvadd [] [] = []\nvadd (x:xs) (y:ys) = x+y : vadd xs ys\n\nmadd [] [] = []\nmadd (xs:xss) (ys:yss) = vadd xs ys : madd xss yss\n\nvaddx [] [] _ = []\nvaddx (x:xs) (y:ys) a = x+y*a : vaddx xs ys a\n\nvsub [] [] = []\nvsub (x:xs) (y:ys) = x-y : vsub xs ys\n\nvmulx [] _ = []\nvmulx (x:xs) a = x*a : vmulx xs a\n\nmmulx [] _ = []\nmmulx (xs:xss) a = vmulx xs a : mmulx xss a\n\nvdist xs ys =\n  loop xs ys 0.0\n  where loop []     []     s = s\n        loop (x:xs) (y:ys) s = loop xs ys (s+d*d)\n                               where d = x-y\n\nvdot xs ys =\n  loop xs ys 0.0\n  where loop []     []     s = s\n        loop (x:xs) (y:ys) s = loop xs ys (s+x*y)\n\nvmmul []     []     = []\nvmmul (x:xs) (r:rs) =\n  loop xs rs (vmulx r x)\n  where loop []     []     ws = ws\n        loop (x:xs) (r:rs) ws = loop xs rs (vaddx ws r x)\n\nvupdate []     _  []     _ = []\nvupdate (r:rs) xs (y:ys) c = vaddx r xs (y*c) : vupdate rs xs ys c\n\nvscale [] [] = []\nvscale (x:xs) (y:ys) = x*y*(1.0-y) : vscale xs ys\n\nsigmoid x = 1.0/(1.0 + exp (0.0-x))\n\nmrand m n l u s =\n  next_random_list (next_random_list f n) m s\n  where f s = (l + (u-l)*r, s1)\n        (r, s1) = next_unit_random s\n\ntrain pats i_h_wt i_h_ch h_o_wt h_o_ch epochs s =\n  loop pats1 i_h_ch h_o_ch 0.0\n  where\n    (pats1, s1) = random_permutation pats s\n    loop [] i_h_ch h_o_ch e0\n      | e <  criterion = ((e,0,i_h_wt,h_o_wt), s1)\n      | epochs <= 0    = ((e,1,i_h_wt,h_o_wt), s1)\n      | True =\n        train pats (madd i_h_wt i_h_ch) (mmulx i_h_ch momentum)\n                   (madd h_o_wt h_o_ch) (mmulx h_o_ch momentum) (epochs-1) s1\n      where e = e0/(fromIntegral (length pats) * fromIntegral (length h_o_wt))\n    loop ((in_pat, out_pat):ps) i_h_ch h_o_ch e =\n        loop ps (vupdate i_h_ch in_act  (tail hid_err) rate)\n                (vupdate h_o_ch hid_act out_err        rate)\n                (e + vdist out_pat out_act)\n        where\n          in_act  = 1.0:in_pat\n          hid_act = 1.0:map (\\w -> sigmoid (vdot in_act  w)) i_h_wt\n          out_act =     map (\\w -> sigmoid (vdot hid_act w)) h_o_wt\n          out_err = vscale (vsub out_pat out_act) out_act\n          hid_err = vscale (vmmul out_err h_o_wt) hid_act\n\nmain = putStrLn (show ans)\n    where (in1,out1)   = head patterns\n          nin          = length in1\n          nhid         = nin\n          nout         = length out1\n          s0           = new_random 353721\n          (i_h_wt, s1) = mrand nhid (nin +1) (0.0-0.3) 0.3 s0\n          i_h_ch       = minit nhid (nin +1) (\\i j -> 0.0)\n          (h_o_wt, s2) = mrand nout (nhid+1) (0.0-0.3) 0.3 s1\n          h_o_ch       = minit nout (nhid+1) (\\i j -> 0.0)\n          (ans, _)     = train patterns i_h_wt i_h_ch h_o_wt h_o_ch epochs s2\n\nrate = 0.05\n\nmomentum = 0.9\n\ncriterion = 0.01\n\n--epochs = 100\n\n--patterns = [([1.0,0.0],[1.0]),\n--            ([0.0,1.0],[1.0]),\n--            ([0.0,0.0],[0.0]),\n--            ([1.0,1.0],[0.0])]\n\nepochs = 90\n\npatterns =\n [([0.955809, 0.095706, 0.269204, 0.824671, 0.448012, 0.722709,\n    0.327677, 0.148595, 0.063143, 0.007019, 0.135166, 0.928800, 0.298593,\n    0.931150, 0.711234, 0.432630, 0.913450, 0.545061, 0.651082, 0.692984,\n    0.371532, 0.940641, 0.202521, 0.064852, 0.965941, 0.523637, 0.914884,\n    0.159062, 0.031648, 0.866848, 0.516526, 0.684317, 0.152135, 0.923734,\n    0.177435, 0.228339, 0.766503, 0.885159, 0.812220, 0.510208, 0.082949,\n    0.459792, 0.580920, 0.134190, 0.705741, 0.859523, 0.243171, 0.377117,\n    0.880551, 0.271218, 0.521989, 0.039888, 0.765862, 0.096347, 0.133702,\n    0.895138, 0.635548, 0.738853, 0.640126, 0.761162, 0.419599, 0.223579,\n    0.779260, 0.734947, 0.488937, 0.426038, 0.430799, 0.613788, 0.090487,\n    0.194372, 0.872494, 0.038179, 0.339183, 0.145482, 0.483932, 0.386425,\n    0.172430, 0.416150, 0.553850, 0.952422, 0.174200, 0.150365, 0.347056,\n    0.438063, 0.674154, 0.004456, 0.087527, 0.291269, 0.028474, 0.450819,\n    0.013642, 0.920896, 0.488815, 0.161840, 0.162084, 0.319803, 0.564989,\n    0.255287, 0.036348, 0.127750, 0.288461, 0.681906, 0.816370, 0.664449,\n    0.282235, 0.537126, 0.265328, 0.964965, 0.043672, 0.577898, 0.990173,\n    0.348186, 0.346446, 0.725700, 0.211463, 0.549821, 0.167943, 0.837062,\n    0.700003, 0.950896, 0.048341, 0.523087, 0.034761, 0.933439, 0.287393,\n    0.299081, 0.840144, 0.894284, 0.885464, 0.845302, 0.157476, 0.948210,\n    0.635060, 0.660421, 0.607990, 0.852107, 0.268868, 0.888760, 0.502518,\n    0.180609, 0.070650, 0.602802, 0.555223, 0.285440, 0.855495, 0.321665,\n    0.356700, 0.068758, 0.725059, 0.047487, 0.263344, 0.102695, 0.504959,\n    0.600452, 0.858974, 0.125217, 0.269662, 0.533982, 0.644642, 0.444838,\n    0.861721, 0.411145, 0.113712, 0.284371, 0.811182, 0.723930, 0.867702,\n    0.595538, 0.561968, 0.235847, 0.929167, 0.375408, 0.410901, 0.030122,\n    0.908536, 0.016297, 0.065859, 0.043977, 0.180425, 0.719810, 0.229469,\n    0.370403, 0.726096, 0.506699, 0.114353, 0.108921, 0.797998, 0.853908,\n    0.296274, 0.046419, 0.063143, 0.489364, 0.811396, 0.949217, 0.380902,\n    0.376751, 0.903958, 0.747703, 0.872127, 0.420392, 0.330729, 0.395032,\n    0.435102, 0.922697, 0.628071, 0.680502, 0.365703, 0.324259, 0.248299,\n    0.779656, 0.236610, 0.258950, 0.971496, 0.821680, 0.692892, 0.454146,\n    0.498856, 0.255776, 0.319895, 0.508377, 0.634022, 0.297617, 0.239479,\n    0.076937, 0.958342, 0.237007, 0.591144, 0.497055, 0.406842, 0.888241,\n    0.554064, 0.383587, 0.650624],\n   [0.234896, 0.423061, 0.263443, 0.123426,\n    0.794525, 0.243195, 0.176474, 0.282455, 0.620580, 0.126517, 0.858114,\n    0.150592, 0.351949, 0.153976, 0.480803, 0.272537, 0.062543, 0.525171,\n    0.896010, 0.872203, 0.431661, 0.702341, 0.385838, 0.951113, 0.058039,\n    0.563982, 0.981357, 0.319594, 0.190779, 0.159156, 0.182152, 0.912154,\n    0.046355, 0.322471, 0.190853, 0.146977, 0.556987, 0.432033, 0.849777,\n    0.397618, 0.800925, 0.817440, 0.103982, 0.417800, 0.982832, 0.123455,\n    0.075878, 0.578246, 0.575774, 0.662847, 0.121769, 0.310270, 0.451505,\n    0.871721, 0.263607, 0.963375, 0.198854, 0.249971, 0.273863, 0.592648,\n    0.133579, 0.119994, 0.679855, 0.626287, 0.174323, 0.164256, 0.841121,\n    0.752313, 0.501021, 0.569367, 0.804985, 0.639864, 0.272153, 0.055158,\n    0.281015, 0.090302, 0.648710, 0.526850, 0.121161, 0.620315, 0.383709,\n    0.487889, 0.739381, 0.609108, 0.181023, 0.419480, 0.453455, 0.658062,\n    0.054643, 0.832708, 0.255309, 0.744293, 0.909823, 0.895573, 0.934952,\n    0.332162, 0.514298, 0.129617, 0.568588, 0.459891, 0.512871, 0.708730,\n    0.244905, 0.504490, 0.408360, 0.724549, 0.263859, 0.126921, 0.917366,\n    0.128843, 0.761606, 0.295994, 0.485532, 0.364426, 0.209157, 0.331918,\n    0.923155, 0.832404, 0.344705, 0.992287, 0.797664, 0.513933, 0.197295,\n    0.898075, 0.321190, 0.766076, 0.896433, 0.510118, 0.555644, 0.731407,\n    0.336166, 0.961858, 0.108792, 0.274650, 0.447974, 0.322401, 0.519439,\n    0.127972, 0.743228, 0.095587, 0.442358, 0.065578, 0.427339, 0.867874,\n    0.115209, 0.391970, 0.222726, 0.427568, 0.562064, 0.073965, 0.500635,\n    0.103580, 0.193423, 0.463678, 0.352990, 0.872354, 0.266832, 0.066053,\n    0.567679, 0.465254, 0.715300, 0.890676, 0.962122, 0.823967, 0.085568,\n    0.195321, 0.730473, 0.142718, 0.589829, 0.954951, 0.190184, 0.350517,\n    0.593301, 0.582699, 0.060864, 0.072237, 0.305630, 0.417032, 0.670941,\n    0.430787, 0.876681, 0.244844, 0.060370, 0.274557, 0.598552, 0.194049,\n    0.661775, 0.251685, 0.143953, 0.228740, 0.268005, 0.353289, 0.234517,\n    0.866899, 0.382406, 0.826395, 0.551468, 0.910383, 0.677785, 0.487901,\n    0.408431, 0.465832, 0.226357, 0.897554, 0.717515, 0.630160, 0.664560,\n    0.807919, 0.184460, 0.314334, 0.122805, 0.073591, 0.617129, 0.220999,\n    0.050125, 0.388057, 0.262980, 0.898668, 0.103295, 0.798561, 0.110919,\n    0.451100, 0.852923, 0.263962, 0.169917, 0.891759, 0.902670, 0.074144,\n    0.746980, 0.667262, 0.158418, 0.192804, 0.468950]),\n\n  ([0.964202, 0.066500, 0.226936, 0.692160, 0.655660, 0.898740, 0.524033,\n    0.579821, 0.196814, 0.235450, 0.473617, 0.647664, 0.698416, 0.424787,\n    0.767571, 0.187048, 0.029542, 0.048921, 0.508835, 0.956023, 0.030000,\n    0.973724, 0.787866, 0.432691, 0.833460, 0.532731, 0.948271, 0.219459,\n    0.583239, 0.502701, 0.073183, 0.503311, 0.322489, 0.025788, 0.723991,\n    0.979400, 0.338694, 0.135716, 0.461501, 0.143620, 0.745018, 0.043428,\n    0.182409, 0.360729, 0.578967, 0.839015, 0.800714, 0.613727, 0.199988,\n    0.765618, 0.306711, 0.341594, 0.267281, 0.722098, 0.733726, 0.270852,\n    0.078555, 0.150273, 0.064547, 0.647755, 0.551744, 0.963408, 0.608631,\n    0.776727, 0.630360, 0.671590, 0.880856, 0.272225, 0.393933, 0.361126,\n    0.513932, 0.929319, 0.654927, 0.683248, 0.235145, 0.619770, 0.322947,\n    0.509049, 0.438612, 0.119938, 0.318155, 0.406720, 0.384625, 0.276345,\n    0.314371, 0.597186, 0.557329, 0.415448, 0.093722, 0.544572, 0.211493,\n    0.403851, 0.794000, 0.837703, 0.640553, 0.265084, 0.829402, 0.518754,\n    0.195807, 0.759392, 0.766900, 0.515610, 0.589740, 0.832545, 0.938505,\n    0.333811, 0.512986, 0.340007, 0.071291, 0.664602, 0.097476, 0.953063,\n    0.716330, 0.065249, 0.256539, 0.652181, 0.757408, 0.367809, 0.432722,\n    0.715354, 0.781518, 0.972747, 0.785791, 0.606159, 0.591449, 0.683523,\n    0.350780, 0.668813, 0.642537, 0.238472, 0.198431, 0.035859, 0.684408,\n    0.196112, 0.128605, 0.655354, 0.388958, 0.330393, 0.928220, 0.843074,\n    0.246040, 0.191717, 0.724906, 0.266549, 0.507981, 0.990509, 0.467574,\n    0.767113, 0.463881, 0.458998, 0.065279, 0.925687, 0.825770, 0.848079,\n    0.215400, 0.779382, 0.506851, 0.714957, 0.452528, 0.594592, 0.573901,\n    0.658132, 0.449507, 0.102847, 0.654500, 0.655812, 0.101474, 0.105991,\n    0.580767, 0.164403, 0.424482, 0.856655, 0.550645, 0.632588, 0.799554,\n    0.120334, 0.587909, 0.587939, 0.594195, 0.325510, 0.582446, 0.952055,\n    0.691580, 0.707785, 0.691580, 0.740196, 0.959563, 0.854366, 0.384228,\n    0.802393, 0.190100, 0.555376, 0.908933, 0.761345, 0.541063, 0.367840,\n    0.466506, 0.804132, 0.010590, 0.799005, 0.869655, 0.483566, 0.976623,\n    0.514817, 0.969665, 0.185705, 0.331492, 0.480422, 0.632160, 0.419385,\n    0.244026, 0.438002, 0.543016, 0.584490, 0.079379, 0.629322, 0.625263,\n    0.374889, 0.508713, 0.168279, 0.348827, 0.472396, 0.339213, 0.970336,\n    0.714225, 0.688009, 0.096377, 0.644551, 0.190954, 0.206671, 0.889401,\n    0.255043, 0.392529],\n   [ 0.347267, 0.395278, 0.312221, 0.271034, 0.606466,\n    0.281430, 0.206116, 0.433894, 0.811608, 0.149699, 0.930589, 0.131576,\n    0.606860, 0.168244, 0.510042, 0.318780, 0.017318, 0.390086, 0.887702,\n    0.856325, 0.410205, 0.731879, 0.429107, 0.951366, 0.090044, 0.460008,\n    0.982247, 0.365122, 0.274204, 0.137115, 0.153039, 0.951211, 0.065363,\n    0.265502, 0.089683, 0.080594, 0.583010, 0.702345, 0.741734, 0.195394,\n    0.694880, 0.634725, 0.110399, 0.510145, 0.984661, 0.095715, 0.060022,\n    0.603920, 0.771879, 0.818352, 0.082082, 0.618599, 0.573476, 0.893264,\n    0.229809, 0.985823, 0.317123, 0.178742, 0.319886, 0.742494, 0.070001,\n    0.097983, 0.799138, 0.627735, 0.234819, 0.174270, 0.832352, 0.747531,\n    0.647704, 0.705891, 0.773991, 0.515965, 0.364954, 0.068576, 0.245708,\n    0.052415, 0.660207, 0.516471, 0.116974, 0.402301, 0.668778, 0.478975,\n    0.759934, 0.675118, 0.254879, 0.420252, 0.301185, 0.501663, 0.106245,\n    0.885773, 0.233874, 0.852706, 0.920644, 0.903723, 0.918905, 0.397496,\n    0.508660, 0.350752, 0.525033, 0.525978, 0.501128, 0.591062, 0.327965,\n    0.501709, 0.383894, 0.685330, 0.354505, 0.031559, 0.873401, 0.127268,\n    0.798431, 0.353377, 0.460709, 0.275419, 0.208795, 0.362425, 0.876697,\n    0.927418, 0.263693, 0.985030, 0.725649, 0.371198, 0.304175, 0.897437,\n    0.436677, 0.633838, 0.883890, 0.471352, 0.563572, 0.763623, 0.364169,\n    0.958443, 0.068425, 0.260482, 0.313543, 0.394317, 0.443647, 0.121875,\n    0.780465, 0.211723, 0.268817, 0.067533, 0.660574, 0.821465, 0.084727,\n    0.520244, 0.288125, 0.675550, 0.580184, 0.116487, 0.701141, 0.082960,\n    0.262049, 0.478233, 0.452062, 0.902427, 0.540173, 0.098391, 0.338498,\n    0.422226, 0.634723, 0.927242, 0.954212, 0.803277, 0.096551, 0.200374,\n    0.689030, 0.291707, 0.580938, 0.939620, 0.151359, 0.232785, 0.503464,\n    0.695066, 0.052623, 0.060584, 0.175948, 0.382867, 0.590377, 0.137340,\n    0.854693, 0.227445, 0.042913, 0.300106, 0.598812, 0.232287, 0.684412,\n    0.365377, 0.094614, 0.097589, 0.241374, 0.555737, 0.246608, 0.794405,\n    0.244149, 0.733437, 0.394148, 0.893992, 0.702754, 0.580066, 0.313107,\n    0.633119, 0.305982, 0.934299, 0.642923, 0.551348, 0.624630, 0.790857,\n    0.331221, 0.474498, 0.189123, 0.110964, 0.484088, 0.151825, 0.119752,\n    0.369902, 0.186865, 0.815287, 0.074211, 0.710128, 0.272505, 0.428258,\n    0.913809, 0.370850, 0.101142, 0.907882, 0.813830, 0.169027, 0.828513,\n    0.535021, 0.157700, 0.154209, 0.657740] ),\n\n  ([0.091800, 0.590747, 0.357860, 0.768944, 0.705832, 0.861995, 0.219123,\n    0.097995, 0.202826, 0.055971, 0.621387, 0.056795, 0.750175, 0.527818,\n    0.164159, 0.654408, 0.634266, 0.384625, 0.464583, 0.807123, 0.907865,\n    0.206702, 0.164922, 0.837733, 0.734306, 0.770074, 0.152898, 0.179693,\n    0.085452, 0.302530, 0.901242, 0.067660, 0.949400, 0.304209, 0.332316,\n    0.495651, 0.703909, 0.463515, 0.115024, 0.223945, 0.812586, 0.700278,\n    0.798822, 0.116245, 0.499100, 0.867183, 0.692465, 0.587878, 0.556658,\n    0.140294, 0.892911, 0.446852, 0.947905, 0.630696, 0.370830, 0.908597,\n    0.352580, 0.247810, 0.519211, 0.065737, 0.318644, 0.345988, 0.070711,\n    0.594501, 0.172735, 0.185614, 0.790979, 0.978179, 0.347209, 0.739830,\n    0.852931, 0.029786, 0.279061, 0.878292, 0.299570, 0.995025, 0.537614,\n    0.459029, 0.500534, 0.015748, 0.336619, 0.359905, 0.009095, 0.237007,\n    0.087802, 0.980621, 0.726005, 0.337168, 0.151524, 0.246712, 0.775872,\n    0.763451, 0.440596, 0.646962, 0.003052, 0.453749, 0.034516, 0.334819,\n    0.492813, 0.326060, 0.459212, 0.825983, 0.023896, 0.316568, 0.789178,\n    0.322672, 0.859310, 0.248024, 0.228217, 0.196203, 0.781091, 0.309366,\n    0.324992, 0.658956, 0.775445, 0.427870, 0.479324, 0.157048, 0.274606,\n    0.315165, 0.895993, 0.515091, 0.361614, 0.468337, 0.642048, 0.363872,\n    0.844020, 0.907407, 0.963775, 0.882931, 0.603198, 0.930235, 0.519639,\n    0.388195, 0.125248, 0.666524, 0.685812, 0.797388, 0.619831, 0.711478,\n    0.589740, 0.502792, 0.632923, 0.621326, 0.028840, 0.684194, 0.560228,\n    0.550920, 0.930204, 0.591937, 0.967132, 0.815455, 0.507126, 0.832453,\n    0.121433, 0.657216, 0.769890, 0.186468, 0.645528, 0.998627, 0.545610,\n    0.992279, 0.693594, 0.462813, 0.664510, 0.624012, 0.560564, 0.443159,\n    0.468307, 0.097537, 0.129246, 0.502792, 0.297189, 0.334117, 0.061190,\n    0.885464, 0.111545, 0.113559, 0.138157, 0.418867, 0.904599, 0.248360,\n    0.660176, 0.592181, 0.062349, 0.009522, 0.306528, 0.088137, 0.327311,\n    0.335643, 0.365917, 0.551897, 0.521531, 0.856471, 0.741783, 0.877163,\n    0.686026, 0.262154, 0.639637, 0.791314, 0.792169, 0.049593, 0.341929,\n    0.020661, 0.681936, 0.176702, 0.977325, 0.816828, 0.392651, 0.656301,\n    0.690176, 0.125736, 0.522843, 0.620746, 0.116733, 0.180731, 0.795282,\n    0.888485, 0.574419, 0.800439, 0.473739, 0.563616, 0.869655, 0.172918,\n    0.789270, 0.700369, 0.131840, 0.407849, 0.032655, 0.562670, 0.578539,\n    0.636982, 0.469131],\n   [0.250121, 0.483413, 0.264094, 0.307941, 0.733994,\n    0.238909, 0.172450, 0.289615, 0.639522, 0.156406, 0.927321, 0.115653,\n    0.439196, 0.138059, 0.430463, 0.210567, 0.043311, 0.427593, 0.713422,\n    0.874737, 0.349128, 0.641711, 0.307643, 0.960792, 0.057629, 0.274816,\n    0.959588, 0.398889, 0.271323, 0.171029, 0.242094, 0.978259, 0.096858,\n    0.335654, 0.139114, 0.149906, 0.430454, 0.483910, 0.630219, 0.285243,\n    0.744639, 0.707501, 0.128506, 0.505621, 0.986704, 0.086747, 0.267839,\n    0.638377, 0.606427, 0.850217, 0.108584, 0.368790, 0.415063, 0.828986,\n    0.366711, 0.960958, 0.215415, 0.253284, 0.268513, 0.436681, 0.111406,\n    0.103739, 0.653758, 0.511406, 0.359645, 0.142705, 0.886096, 0.729033,\n    0.570775, 0.475699, 0.781399, 0.624880, 0.453394, 0.105905, 0.258093,\n    0.043573, 0.695208, 0.381172, 0.131100, 0.470651, 0.494271, 0.329024,\n    0.677485, 0.566830, 0.452777, 0.283240, 0.187764, 0.614069, 0.110264,\n    0.810169, 0.297650, 0.804280, 0.875188, 0.876858, 0.950973, 0.347310,\n    0.568015, 0.203545, 0.636385, 0.402638, 0.561527, 0.704415, 0.335657,\n    0.416779, 0.371755, 0.656713, 0.245263, 0.069130, 0.858867, 0.117609,\n    0.814266, 0.357809, 0.368650, 0.195525, 0.253112, 0.273989, 0.897546,\n    0.737842, 0.188547, 0.991165, 0.751005, 0.552062, 0.267549, 0.903292,\n    0.309227, 0.766666, 0.885213, 0.570977, 0.382676, 0.564119, 0.461571,\n    0.938216, 0.127708, 0.189827, 0.276506, 0.377828, 0.537514, 0.231975,\n    0.575255, 0.211339, 0.194267, 0.110436, 0.330972, 0.823506, 0.087909,\n    0.405803, 0.398364, 0.585681, 0.676848, 0.126466, 0.459028, 0.068184,\n    0.229350, 0.508934, 0.295492, 0.876380, 0.290811, 0.034688, 0.401911,\n    0.337465, 0.767958, 0.852948, 0.981002, 0.763970, 0.070562, 0.312852,\n    0.691511, 0.244069, 0.497265, 0.912701, 0.104435, 0.312821, 0.663720,\n    0.688728, 0.072052, 0.040471, 0.113943, 0.208670, 0.557001, 0.255511,\n    0.744639, 0.166425, 0.049652, 0.223302, 0.492090, 0.229562, 0.573484,\n    0.590362, 0.206928, 0.294928, 0.183751, 0.270976, 0.310734, 0.917243,\n    0.200381, 0.691783, 0.425492, 0.882956, 0.635164, 0.618051, 0.253056,\n    0.505014, 0.434698, 0.910271, 0.737867, 0.553463, 0.588869, 0.748615,\n    0.244402, 0.282370, 0.257965, 0.119861, 0.620997, 0.124454, 0.112210,\n    0.383214, 0.245615, 0.853594, 0.145247, 0.776892, 0.166819, 0.548061,\n    0.802385, 0.142570, 0.098268, 0.887335, 0.906549, 0.087140, 0.690883,\n    0.731714, 0.239845, 0.207338, 0.304361] ),\n\n  ([0.511246, 0.618427, 0.945036, 0.731468, 0.048402, 0.198859, 0.911771,\n    0.848018, 0.052889, 0.803369, 0.046754, 0.561571, 0.734703, 0.006043,\n    0.897824, 0.095798, 0.342509, 0.988769, 0.114628, 0.024812, 0.153844,\n    0.927488, 0.248695, 0.402722, 0.780084, 0.654073, 0.570818, 0.809198,\n    0.316813, 0.499557, 0.687429, 0.467269, 0.371319, 0.725608, 0.237007,\n    0.089572, 0.498337, 0.449721, 0.447890, 0.609638, 0.075076, 0.471175,\n    0.838435, 0.453658, 0.147130, 0.903470, 0.841304, 0.510117, 0.276162,\n    0.019532, 0.632557, 0.452528, 0.921018, 0.216407, 0.947417, 0.572161,\n    0.382977, 0.504929, 0.163121, 0.776605, 0.847072, 0.431288, 0.431196,\n    0.910825, 0.550035, 0.836573, 0.139134, 0.056368, 0.606738, 0.360027,\n    0.484054, 0.965941, 0.525834, 0.093295, 0.438520, 0.288186, 0.946165,\n    0.290719, 0.890316, 0.740532, 0.625294, 0.543016, 0.237251, 0.885006,\n    0.211066, 0.319712, 0.218513, 0.663961, 0.827631, 0.287240, 0.263222,\n    0.352092, 0.007172, 0.308573, 0.138035, 0.080264, 0.998840, 0.530656,\n    0.174993, 0.588122, 0.985260, 0.466170, 0.860317, 0.361461, 0.239326,\n    0.475600, 0.065981, 0.810541, 0.751152, 0.555773, 0.705252, 0.645741,\n    0.356883, 0.841639, 0.093051, 0.106632, 0.901242, 0.726859, 0.792779,\n    0.200873, 0.463912, 0.010041, 0.230628, 0.609210, 0.182226, 0.972442,\n    0.859035, 0.412427, 0.700308, 0.793481, 0.149602, 0.297342, 0.776666,\n    0.210761, 0.198004, 0.397015, 0.081118, 0.830256, 0.221076, 0.422315,\n    0.712790, 0.992767, 0.727836, 0.240638, 0.469253, 0.604083, 0.645497,\n    0.558153, 0.399884, 0.833644, 0.182073, 0.861904, 0.672903, 0.088626,\n    0.706290, 0.277627, 0.288400, 0.170141, 0.426405, 0.500320, 0.668447,\n    0.016816, 0.149052, 0.452895, 0.655019, 0.942717, 0.899747, 0.829737,\n    0.947935, 0.775628, 0.685324, 0.181372, 0.512894, 0.802149, 0.180853,\n    0.696341, 0.991943, 0.925413, 0.621357, 0.336467, 0.646809, 0.942015,\n    0.679678, 0.482131, 0.867000, 0.344493, 0.612293, 0.743370, 0.773278,\n    0.555376, 0.453688, 0.093204, 0.948363, 0.998871, 0.540880, 0.979797,\n    0.825709, 0.917112, 0.149327, 0.572924, 0.767724, 0.336436, 0.521439,\n    0.801843, 0.364666, 0.090609, 0.068575, 0.340251, 0.985717, 0.306742,\n    0.028718, 0.194739, 0.112888, 0.260231, 0.360057, 0.053102, 0.489731,\n    0.005432, 0.151982, 0.048616, 0.615528, 0.687857, 0.335643, 0.096561,\n    0.616504, 0.943907, 0.973693, 0.459304, 0.025239, 0.295297, 0.911924,\n    0.696127, 0.499680],\n   [0.372363, 0.313207, 0.276106, 0.279324, 0.820741,\n    0.205839, 0.328552, 0.399419, 0.774962, 0.215105, 0.853020, 0.226282,\n    0.571785, 0.173005, 0.436688, 0.238419, 0.019348, 0.460500, 0.847289,\n    0.878880, 0.228861, 0.695937, 0.239922, 0.971454, 0.036638, 0.461105,\n    0.972190, 0.455536, 0.254031, 0.210429, 0.335951, 0.912823, 0.057891,\n    0.222266, 0.176725, 0.124067, 0.581808, 0.736316, 0.652302, 0.248547,\n    0.704722, 0.716806, 0.087022, 0.515832, 0.973141, 0.095332, 0.098511,\n    0.549793, 0.810595, 0.823819, 0.070312, 0.561088, 0.364184, 0.852806,\n    0.259421, 0.961891, 0.135451, 0.210059, 0.366696, 0.553164, 0.115941,\n    0.097627, 0.862905, 0.499057, 0.464813, 0.240171, 0.903088, 0.744335,\n    0.613677, 0.796010, 0.774554, 0.611191, 0.427484, 0.043273, 0.272693,\n    0.091735, 0.626866, 0.598557, 0.314647, 0.606310, 0.660126, 0.401762,\n    0.782298, 0.587858, 0.140014, 0.598725, 0.358832, 0.437350, 0.217892,\n    0.874923, 0.189696, 0.806172, 0.853777, 0.849070, 0.872760, 0.442148,\n    0.530084, 0.230444, 0.608441, 0.564128, 0.408068, 0.732274, 0.456723,\n    0.421654, 0.596509, 0.737912, 0.407249, 0.036761, 0.856259, 0.132400,\n    0.832515, 0.371338, 0.573567, 0.425011, 0.247448, 0.522633, 0.942719,\n    0.907415, 0.228517, 0.986824, 0.848198, 0.284663, 0.271171, 0.915369,\n    0.547810, 0.745923, 0.881908, 0.504883, 0.428851, 0.661564, 0.298134,\n    0.974143, 0.105652, 0.342785, 0.412873, 0.440510, 0.350132, 0.211733,\n    0.810887, 0.132996, 0.237006, 0.051134, 0.598440, 0.778627, 0.090580,\n    0.634583, 0.339945, 0.511342, 0.660187, 0.184938, 0.614215, 0.064794,\n    0.270805, 0.456836, 0.536392, 0.940503, 0.295905, 0.129487, 0.447837,\n    0.526879, 0.729304, 0.910458, 0.972890, 0.761394, 0.249717, 0.346499,\n    0.779652, 0.299671, 0.729285, 0.934442, 0.192382, 0.281585, 0.555343,\n    0.601925, 0.071142, 0.063458, 0.207701, 0.356162, 0.631022, 0.165572,\n    0.760330, 0.131365, 0.021257, 0.262862, 0.640069, 0.250123, 0.642715,\n    0.204412, 0.149900, 0.125013, 0.202026, 0.475843, 0.260838, 0.853036,\n    0.272570, 0.625518, 0.496405, 0.928861, 0.852380, 0.627557, 0.282402,\n    0.475618, 0.273318, 0.944023, 0.592831, 0.608529, 0.662162, 0.839359,\n    0.161527, 0.473947, 0.200285, 0.107977, 0.738683, 0.100967, 0.083270,\n    0.366952, 0.199829, 0.879304, 0.068496, 0.810832, 0.152595, 0.411953,\n    0.930309, 0.339304, 0.144649, 0.935868, 0.843733, 0.110269, 0.859667,\n    0.592107, 0.216361, 0.175124, 0.385298] ),\n\n  ([0.943571, 0.073397, 0.654073, 0.012421, 0.871151, 0.176305, 0.656026,\n    0.542619, 0.655629, 0.156926, 0.542405, 0.800378, 0.902829, 0.078860,\n    0.722526, 0.016022, 0.705557, 0.810053, 0.891964, 0.325236, 0.033692,\n    0.248329, 0.572222, 0.780511, 0.462539, 0.377392, 0.129032, 0.521500,\n    0.144963, 0.933775, 0.425214, 0.134312, 0.434156, 0.966491, 0.764672,\n    0.731895, 0.062868, 0.070772, 0.283547, 0.786004, 0.285745, 0.576525,\n    0.445143, 0.242653, 0.890561, 0.473159, 0.794336, 0.951994, 0.485031,\n    0.352306, 0.628040, 0.943632, 0.965209, 0.149022, 0.738151, 0.579333,\n    0.571642, 0.963286, 0.882778, 0.113498, 0.439985, 0.742515, 0.142247,\n    0.693381, 0.051637, 0.107181, 0.816492, 0.329875, 0.491256, 0.099826,\n    0.018921, 0.870327, 0.917081, 0.139225, 0.624866, 0.504471, 0.150365,\n    0.961089, 0.728721, 0.834925, 0.790429, 0.825892, 0.267861, 0.043214,\n    0.760887, 0.776238, 0.968657, 0.183111, 0.694266, 0.223640, 0.270516,\n    0.131596, 0.060457, 0.646962, 0.385601, 0.229835, 0.445692, 0.683218,\n    0.148625, 0.144536, 0.887997, 0.392621, 0.814661, 0.981414, 0.675863,\n    0.978240, 0.459761, 0.181738, 0.515610, 0.742088, 0.142125, 0.233406,\n    0.474563, 0.559130, 0.478713, 0.727805, 0.605640, 0.649739, 0.794183,\n    0.793298, 0.659810, 0.932279, 0.498611, 0.437361, 0.792779, 0.737205,\n    0.849818, 0.827906, 0.672170, 0.163610, 0.756523, 0.045228, 0.891018,\n    0.859615, 0.779260, 0.336314, 0.094516, 0.507736, 0.984222, 0.401685,\n    0.725700, 0.796930, 0.807337, 0.747398, 0.796442, 0.161718, 0.584033,\n    0.632344, 0.590472, 0.070559, 0.901578, 0.642506, 0.703818, 0.144047,\n    0.429609, 0.423597, 0.329569, 0.884640, 0.385693, 0.603046, 0.193243,\n    0.298593, 0.291696, 0.432661, 0.044496, 0.192328, 0.177679, 0.183294,\n    0.111820, 0.423322, 0.888943, 0.822748, 0.426374, 0.887570, 0.653188,\n    0.007904, 0.421369, 0.524461, 0.563555, 0.923124, 0.712760, 0.120975,\n    0.133824, 0.994690, 0.468154, 0.195196, 0.582293, 0.014374, 0.269692,\n    0.741783, 0.000336, 0.702048, 0.877377, 0.119633, 0.062075, 0.238655,\n    0.798944, 0.863826, 0.431074, 0.801965, 0.072726, 0.701865, 0.520829,\n    0.634602, 0.169713, 0.557176, 0.765007, 0.677358, 0.420850, 0.819544,\n    0.053285, 0.297617, 0.876003, 0.664510, 0.490219, 0.144963, 0.000885,\n    0.703085, 0.131718, 0.665090, 0.118290, 0.742485, 0.857143, 0.302835,\n    0.999176, 0.939543, 0.031739, 0.926389, 0.510941, 0.128086, 0.116794,\n    0.503006, 0.728446],\n   [0.351222, 0.278591, 0.283138, 0.122628, 0.763695,\n    0.308245, 0.231191, 0.327072, 0.669178, 0.237753, 0.933039, 0.161955,\n    0.527918, 0.162872, 0.276862, 0.338759, 0.013447, 0.500357, 0.758393,\n    0.890117, 0.286404, 0.614922, 0.471315, 0.955186, 0.089488, 0.366257,\n    0.978455, 0.616409, 0.306164, 0.160409, 0.159356, 0.978049, 0.097219,\n    0.344033, 0.186289, 0.116885, 0.728207, 0.627205, 0.714860, 0.208562,\n    0.727131, 0.828565, 0.158439, 0.466829, 0.971232, 0.121343, 0.161650,\n    0.661611, 0.618124, 0.841358, 0.046860, 0.452121, 0.341010, 0.865947,\n    0.152254, 0.966536, 0.213056, 0.304055, 0.335217, 0.523691, 0.087881,\n    0.064809, 0.795485, 0.452027, 0.317999, 0.116250, 0.898968, 0.803284,\n    0.544429, 0.616822, 0.841354, 0.611205, 0.371687, 0.033215, 0.256717,\n    0.064430, 0.627021, 0.627504, 0.191870, 0.526017, 0.501716, 0.287086,\n    0.784309, 0.622639, 0.183675, 0.468426, 0.212266, 0.355046, 0.108475,\n    0.889961, 0.275599, 0.872669, 0.942839, 0.877238, 0.920511, 0.392231,\n    0.563621, 0.144615, 0.633087, 0.349760, 0.505776, 0.827315, 0.389287,\n    0.540466, 0.506721, 0.612825, 0.373225, 0.041362, 0.902200, 0.092558,\n    0.739404, 0.272585, 0.388132, 0.298448, 0.321686, 0.374587, 0.935410,\n    0.898459, 0.192054, 0.991002, 0.725184, 0.382465, 0.319403, 0.858241,\n    0.597066, 0.710496, 0.882099, 0.531761, 0.456813, 0.845161, 0.499102,\n    0.969086, 0.106525, 0.332143, 0.326130, 0.364720, 0.654414, 0.171305,\n    0.596477, 0.110804, 0.178501, 0.057372, 0.576870, 0.814650, 0.061785,\n    0.478826, 0.367008, 0.320375, 0.650806, 0.181174, 0.468965, 0.037388,\n    0.270917, 0.385496, 0.362564, 0.833518, 0.339478, 0.046834, 0.462328,\n    0.608506, 0.601353, 0.894656, 0.955409, 0.723455, 0.147482, 0.237962,\n    0.735452, 0.206749, 0.757557, 0.933967, 0.214645, 0.375817, 0.574143,\n    0.817046, 0.041647, 0.069035, 0.130061, 0.486610, 0.681156, 0.481305,\n    0.869591, 0.204328, 0.104596, 0.343107, 0.564518, 0.275226, 0.611070,\n    0.249097, 0.084293, 0.199324, 0.278827, 0.330948, 0.206980, 0.806283,\n    0.256766, 0.588891, 0.445696, 0.906602, 0.709172, 0.561304, 0.262893,\n    0.710889, 0.551355, 0.953251, 0.692670, 0.754259, 0.498363, 0.792302,\n    0.159659, 0.299479, 0.167739, 0.071807, 0.487328, 0.132015, 0.081683,\n    0.272535, 0.177688, 0.930233, 0.106226, 0.619949, 0.120131, 0.334437,\n    0.914901, 0.213753, 0.088482, 0.942437, 0.858771, 0.095054, 0.726020,\n    0.678025, 0.174585, 0.250140, 0.419005] ),\n\n  ([0.601306, 0.883114, 0.558214, 0.413923, 0.130222, 0.384136, 0.449324,\n    0.272683, 0.500229, 0.345470, 0.984649, 0.890042, 0.345927, 0.126225,\n    0.419813, 0.756462, 0.566454, 0.909177, 0.362194, 0.286752, 0.101840,\n    0.275582, 0.614643, 0.239540, 0.352245, 0.821070, 0.490219, 0.443525,\n    0.020661, 0.968566, 0.628559, 0.236457, 0.661061, 0.635151, 0.845820,\n    0.523545, 0.712516, 0.908383, 0.048616, 0.860897, 0.301248, 0.388562,\n    0.744163, 0.470901, 0.591296, 0.353648, 0.176855, 0.595355, 0.965209,\n    0.402234, 0.623585, 0.092685, 0.816248, 0.731590, 0.877987, 0.685690,\n    0.233009, 0.706626, 0.455763, 0.765831, 0.358135, 0.876186, 0.551866,\n    0.160466, 0.701590, 0.092624, 0.280770, 0.769280, 0.190893, 0.891629,\n    0.231391, 0.475784, 0.238411, 0.787347, 0.867458, 0.240974, 0.607837,\n    0.640522, 0.805078, 0.784509, 0.360515, 0.754662, 0.498337, 0.759972,\n    0.663198, 0.857143, 0.364544, 0.830958, 0.738365, 0.621326, 0.879940,\n    0.553301, 0.738395, 0.885830, 0.677480, 0.470473, 0.824793, 0.227515,\n    0.177862, 0.328135, 0.233619, 0.044069, 0.784997, 0.813868, 0.608844,\n    0.802728, 0.177038, 0.728782, 0.384106, 0.611042, 0.724540, 0.996948,\n    0.494827, 0.766533, 0.566729, 0.418714, 0.201544, 0.440626, 0.377331,\n    0.575030, 0.305979, 0.154241, 0.350841, 0.787622, 0.540605, 0.199896,\n    0.441176, 0.542680, 0.413648, 0.667959, 0.382977, 0.283364, 0.290170,\n    0.232246, 0.528031, 0.977935, 0.990936, 0.352031, 0.026643, 0.369121,\n    0.689871, 0.045808, 0.386700, 0.311991, 0.391797, 0.894131, 0.940397,\n    0.105319, 0.771477, 0.426649, 0.250557, 0.223823, 0.654927, 0.550768,\n    0.987945, 0.356761, 0.925199, 0.177038, 0.309977, 0.159551, 0.132481,\n    0.698355, 0.273354, 0.624531, 0.591235, 0.478805, 0.310312, 0.477004,\n    0.244270, 0.008667, 0.301309, 0.503098, 0.076144, 0.881558, 0.274270,\n    0.215339, 0.356426, 0.249977, 0.262093, 0.762444, 0.494186, 0.915983,\n    0.349712, 0.489517, 0.785394, 0.712516, 0.441755, 0.054872, 0.833766,\n    0.332133, 0.782250, 0.509812, 0.926908, 0.259377, 0.757439, 0.247291,\n    0.148778, 0.962706, 0.013001, 0.226386, 0.509751, 0.002441, 0.417310,\n    0.378002, 0.875271, 0.211280, 0.901120, 0.598773, 0.974853, 0.602954,\n    0.705924, 0.238899, 0.272378, 0.165716, 0.071505, 0.490493, 0.978912,\n    0.197302, 0.894253, 0.582476, 0.989257, 0.336314, 0.387463, 0.188452,\n    0.023652, 0.948027, 0.274850, 0.953734, 0.756066, 0.019135, 0.548418,\n    0.547594, 0.209479],\n   [0.271663, 0.525723, 0.267998, 0.250128, 0.702226,\n    0.229707, 0.175555, 0.297942, 0.860000, 0.169436, 0.887007, 0.126692,\n    0.384973, 0.182938, 0.553939, 0.253207, 0.029636, 0.425111, 0.846293,\n    0.842762, 0.304010, 0.762392, 0.447713, 0.952176, 0.056503, 0.447279,\n    0.970657, 0.412395, 0.340561, 0.121831, 0.176847, 0.956278, 0.114158,\n    0.355843, 0.137279, 0.076094, 0.595278, 0.711299, 0.589624, 0.171310,\n    0.768125, 0.554197, 0.121300, 0.554864, 0.976230, 0.161199, 0.085808,\n    0.386882, 0.683964, 0.831818, 0.057765, 0.313484, 0.508615, 0.827996,\n    0.333389, 0.971560, 0.189127, 0.211048, 0.345118, 0.566802, 0.105797,\n    0.080436, 0.782501, 0.518403, 0.218373, 0.281876, 0.906947, 0.889611,\n    0.479506, 0.629542, 0.654916, 0.480508, 0.389275, 0.082686, 0.280760,\n    0.109858, 0.733491, 0.446057, 0.249002, 0.541121, 0.502550, 0.371208,\n    0.721902, 0.436620, 0.244237, 0.250580, 0.226793, 0.627351, 0.160097,\n    0.747408, 0.375859, 0.871497, 0.926349, 0.874001, 0.869867, 0.307266,\n    0.483985, 0.124589, 0.578719, 0.366280, 0.412193, 0.594651, 0.369025,\n    0.481161, 0.576671, 0.467754, 0.224526, 0.031813, 0.821986, 0.090304,\n    0.836334, 0.444711, 0.408687, 0.205362, 0.263692, 0.475828, 0.905762,\n    0.909118, 0.301838, 0.988982, 0.774767, 0.589240, 0.246877, 0.876037,\n    0.457144, 0.741628, 0.921321, 0.527897, 0.302698, 0.768976, 0.397204,\n    0.953512, 0.101570, 0.219640, 0.337110, 0.454909, 0.462697, 0.162126,\n    0.761869, 0.168659, 0.298322, 0.061892, 0.703901, 0.867304, 0.080736,\n    0.314129, 0.380475, 0.314903, 0.665137, 0.094841, 0.523808, 0.073543,\n    0.279188, 0.490220, 0.451759, 0.926845, 0.472939, 0.145560, 0.309754,\n    0.286070, 0.687752, 0.920453, 0.965685, 0.776630, 0.163112, 0.167838,\n    0.626627, 0.243982, 0.641384, 0.902528, 0.114211, 0.308358, 0.492737,\n    0.566340, 0.048890, 0.067968, 0.103615, 0.316475, 0.394561, 0.284335,\n    0.879411, 0.207121, 0.036808, 0.216855, 0.550790, 0.368205, 0.531398,\n    0.365759, 0.165072, 0.177080, 0.274344, 0.397236, 0.225324, 0.880869,\n    0.228650, 0.783659, 0.547302, 0.814027, 0.767327, 0.545063, 0.256435,\n    0.519250, 0.316496, 0.922818, 0.742588, 0.447345, 0.628000, 0.811624,\n    0.252169, 0.572887, 0.213673, 0.089029, 0.696801, 0.113802, 0.091420,\n    0.428054, 0.235681, 0.820236, 0.133022, 0.686627, 0.107302, 0.561399,\n    0.916099, 0.288236, 0.200918, 0.935256, 0.871452, 0.071271, 0.844837,\n    0.711053, 0.182887, 0.241940, 0.460490] ),\n\n  ([0.219306, 0.322092, 0.147404, 0.200659, 0.284280, 0.812433, 0.760430,\n    0.114444, 0.378002, 0.977233, 0.289865, 0.789850, 0.589251, 0.843959,\n    0.751396, 0.798212, 0.219275, 0.058535, 0.546159, 0.895779, 0.016999,\n    0.686483, 0.196661, 0.930845, 0.017365, 0.796655, 0.452040, 0.987487,\n    0.139592, 0.860195, 0.168432, 0.046815, 0.201483, 0.494491, 0.871120,\n    0.947172, 0.506088, 0.584613, 0.404584, 0.924009, 0.656545, 0.312540,\n    0.576678, 0.511643, 0.756066, 0.126225, 0.203162, 0.087252, 0.648824,\n    0.179022, 0.458876, 0.838771, 0.357830, 0.271249, 0.941954, 0.437727,\n    0.376904, 0.824976, 0.356761, 0.198767, 0.971770, 0.923154, 0.222907,\n    0.006409, 0.147496, 0.944456, 0.515183, 0.790796, 0.438429, 0.825312,\n    0.641896, 0.833399, 0.176000, 0.479720, 0.666982, 0.684164, 0.392041,\n    0.408856, 0.182928, 0.971374, 0.012452, 0.031281, 0.739891, 0.884854,\n    0.498703, 0.765130, 0.237953, 0.614887, 0.592303, 0.393262, 0.188604,\n    0.526902, 0.319590, 0.743370, 0.251320, 0.354137, 0.912076, 0.213263,\n    0.951964, 0.188818, 0.799341, 0.173467, 0.989166, 0.553789, 0.330271,\n    0.777825, 0.034639, 0.334971, 0.379254, 0.213538, 0.434095, 0.856960,\n    0.493179, 0.922300, 0.714560, 0.881954, 0.735740, 0.822626, 0.304758,\n    0.814142, 0.885464, 0.066225, 0.374645, 0.890103, 0.143284, 0.358257,\n    0.200201, 0.637074, 0.006165, 0.373455, 0.959990, 0.379772, 0.463057,\n    0.299265, 0.369518, 0.077609, 0.169347, 0.037141, 0.059816, 0.272897,\n    0.756066, 0.093295, 0.106357, 0.431806, 0.929991, 0.690115, 0.614643,\n    0.459212, 0.521317, 0.129551, 0.768517, 0.668508, 0.134556, 0.939848,\n    0.248054, 0.987823, 0.559313, 0.836421, 0.422315, 0.683584, 0.597034,\n    0.028748, 0.224067, 0.383435, 0.460158, 0.904111, 0.112278, 0.678640,\n    0.399579, 0.619312, 0.028840, 0.088046, 0.717002, 0.632313, 0.755638,\n    0.664907, 0.818293, 0.704154, 0.578021, 0.027009, 0.464095, 0.402936,\n    0.661733, 0.092349, 0.874020, 0.641255, 0.048372, 0.300729, 0.840358,\n    0.277657, 0.676748, 0.603351, 0.508164, 0.314188, 0.335276, 0.000824,\n    0.977386, 0.720634, 0.953093, 0.911679, 0.383465, 0.417096, 0.134404,\n    0.151738, 0.612903, 0.446089, 0.344005, 0.806513, 0.309671, 0.865047,\n    0.648915, 0.777062, 0.328990, 0.391095, 0.423078, 0.281167, 0.294504,\n    0.328928, 0.921384, 0.090823, 0.415387, 0.813135, 0.128697, 0.787164,\n    0.219306, 0.896023, 0.790979, 0.814234, 0.357738, 0.512772, 0.033723,\n    0.612995, 0.139805],\n   [0.337469, 0.211019, 0.303828, 0.169147, 0.566631,\n    0.265004, 0.229917, 0.266692, 0.707275, 0.181060, 0.891105, 0.151850,\n    0.330346, 0.236540, 0.566669, 0.367808, 0.022893, 0.342128, 0.828586,\n    0.836092, 0.288965, 0.520367, 0.340710, 0.948377, 0.068229, 0.481998,\n    0.961949, 0.321867, 0.409557, 0.096625, 0.235185, 0.963402, 0.086902,\n    0.304833, 0.136653, 0.100314, 0.555993, 0.473476, 0.687371, 0.091541,\n    0.824397, 0.761128, 0.176079, 0.461218, 0.972764, 0.101685, 0.092011,\n    0.704997, 0.786809, 0.845653, 0.048572, 0.532518, 0.294126, 0.790332,\n    0.263704, 0.972708, 0.345158, 0.097973, 0.310588, 0.411926, 0.068545,\n    0.167609, 0.738812, 0.590916, 0.165281, 0.483342, 0.827012, 0.874491,\n    0.706514, 0.764947, 0.810091, 0.569694, 0.516268, 0.052071, 0.182505,\n    0.087599, 0.683585, 0.451136, 0.172146, 0.361382, 0.584432, 0.524382,\n    0.697889, 0.607622, 0.269281, 0.404014, 0.383005, 0.465719, 0.133359,\n    0.848459, 0.329923, 0.676798, 0.918466, 0.925962, 0.912074, 0.448496,\n    0.592100, 0.143557, 0.664445, 0.531189, 0.525847, 0.767499, 0.299313,\n    0.578332, 0.624400, 0.466934, 0.132613, 0.062552, 0.904959, 0.127579,\n    0.818607, 0.446923, 0.465014, 0.273226, 0.337396, 0.414281, 0.956502,\n    0.834423, 0.290169, 0.990990, 0.851944, 0.418151, 0.380813, 0.826651,\n    0.462244, 0.779744, 0.812940, 0.421702, 0.511798, 0.737402, 0.242433,\n    0.976064, 0.082025, 0.373773, 0.357622, 0.499017, 0.402349, 0.271163,\n    0.773220, 0.143733, 0.266738, 0.050067, 0.499764, 0.788335, 0.090030,\n    0.517396, 0.443833, 0.574189, 0.552392, 0.191110, 0.418867, 0.138714,\n    0.305420, 0.657505, 0.572325, 0.943814, 0.480564, 0.142950, 0.344197,\n    0.370294, 0.751791, 0.917778, 0.979460, 0.802610, 0.237874, 0.154067,\n    0.546123, 0.157159, 0.840947, 0.881112, 0.184218, 0.258215, 0.482485,\n    0.519804, 0.043765, 0.055481, 0.093186, 0.499097, 0.448311, 0.311212,\n    0.855592, 0.258039, 0.041089, 0.214369, 0.600970, 0.397062, 0.636188,\n    0.356101, 0.081942, 0.210988, 0.129305, 0.371435, 0.371639, 0.813555,\n    0.371106, 0.809968, 0.372638, 0.920697, 0.714700, 0.493914, 0.314693,\n    0.564047, 0.208476, 0.945736, 0.642147, 0.532650, 0.600253, 0.861064,\n    0.231185, 0.557751, 0.243577, 0.108949, 0.781807, 0.164608, 0.116768,\n    0.415680, 0.234421, 0.906828, 0.111577, 0.653296, 0.165778, 0.443490,\n    0.832201, 0.205338, 0.099455, 0.939522, 0.892921, 0.067812, 0.864319,\n    0.700760, 0.271345, 0.210610, 0.439696] ),\n\n  ([0.854610, 0.475326, 0.616596, 0.950865, 0.181310, 0.239937, 0.388104,\n    0.212043, 0.604663, 0.777734, 0.682180, 0.037111, 0.873531, 0.897580,\n    0.711814, 0.242958, 0.692618, 0.919034, 0.401349, 0.869625, 0.605152,\n    0.349773, 0.907193, 0.866420, 0.971740, 0.994659, 0.187109, 0.100467,\n    0.075686, 0.902371, 0.899991, 0.343669, 0.887173, 0.056734, 0.416395,\n    0.394208, 0.516037, 0.218085, 0.222419, 0.989471, 0.886166, 0.821223,\n    0.496567, 0.665883, 0.661061, 0.336375, 0.142308, 0.222571, 0.953185,\n    0.999573, 0.056734, 0.944517, 0.847346, 0.317728, 0.916807, 0.241737,\n    0.270089, 0.256111, 0.264321, 0.861171, 0.235817, 0.513260, 0.171300,\n    0.326365, 0.001282, 0.790063, 0.266274, 0.762535, 0.159398, 0.459365,\n    0.403455, 0.762322, 0.203894, 0.542253, 0.755608, 0.448927, 0.595691,\n    0.397046, 0.611988, 0.392743, 0.862850, 0.027497, 0.662709, 0.537706,\n    0.764550, 0.416578, 0.050600, 0.793786, 0.051119, 0.791528, 0.971892,\n    0.451552, 0.850826, 0.227088, 0.106937, 0.075411, 0.214850, 0.492874,\n    0.662587, 0.031648, 0.851985, 0.550890, 0.306497, 0.307230, 0.583544,\n    0.610065, 0.775964, 0.776147, 0.550768, 0.143223, 0.441389, 0.569140,\n    0.705100, 0.773644, 0.606220, 0.703238, 0.612903, 0.436659, 0.824488,\n    0.627277, 0.106082, 0.723136, 0.016999, 0.839625, 0.809595, 0.810663,\n    0.668081, 0.234626, 0.076937, 0.889065, 0.882870, 0.333628, 0.365429,\n    0.486129, 0.587970, 0.057009, 0.581957, 0.600085, 0.655538, 0.193640,\n    0.430799, 0.044923, 0.232307, 0.223701, 0.294565, 0.914945, 0.055483,\n    0.651296, 0.679708, 0.574450, 0.035493, 0.503189, 0.757500, 0.079470,\n    0.888302, 0.149663, 0.032319, 0.437056, 0.097079, 0.104068, 0.667837,\n    0.608753, 0.985992, 0.956877, 0.502762, 0.664693, 0.185675, 0.100833,\n    0.287271, 0.994018, 0.273446, 0.403882, 0.171575, 0.978393, 0.867855,\n    0.484603, 0.977294, 0.034639, 0.959990, 0.748314, 0.283578, 0.432752,\n    0.762108, 0.838771, 0.859127, 0.795434, 0.855464, 0.662252, 0.470412,\n    0.685659, 0.917722, 0.640034, 0.599139, 0.188330, 0.812006, 0.345836,\n    0.098178, 0.892514, 0.318552, 0.184057, 0.318918, 0.179724, 0.290109,\n    0.265450, 0.740165, 0.226020, 0.512284, 0.136235, 0.630360, 0.622272,\n    0.050356, 0.516984, 0.774438, 0.020600, 0.363872, 0.707480, 0.795923,\n    0.712027, 0.969573, 0.814051, 0.106540, 0.542009, 0.934843, 0.455031,\n    0.013642, 0.070437, 0.982299, 0.101444, 0.017182, 0.381726, 0.486923,\n    0.708243, 0.827479],\n   [0.358315, 0.270049, 0.342954, 0.214249, 0.838752,\n    0.310564, 0.336771, 0.491659, 0.732358, 0.146048, 0.875334, 0.177203,\n    0.340052, 0.229098, 0.470689, 0.199422, 0.013477, 0.437964, 0.834417,\n    0.801902, 0.374778, 0.710470, 0.380647, 0.932384, 0.136688, 0.415547,\n    0.964993, 0.435191, 0.308797, 0.163246, 0.208703, 0.966874, 0.093376,\n    0.265505, 0.059608, 0.236134, 0.535674, 0.631452, 0.664845, 0.282025,\n    0.768258, 0.736782, 0.122918, 0.461566, 0.987912, 0.084404, 0.129183,\n    0.480177, 0.727945, 0.669787, 0.062807, 0.564469, 0.428409, 0.826974,\n    0.384675, 0.966756, 0.210445, 0.272487, 0.317097, 0.370697, 0.125074,\n    0.121726, 0.635255, 0.498751, 0.333923, 0.279037, 0.831576, 0.742353,\n    0.554140, 0.759262, 0.788903, 0.342407, 0.402883, 0.054452, 0.192420,\n    0.161426, 0.594132, 0.626459, 0.311456, 0.580723, 0.643488, 0.466939,\n    0.751366, 0.460380, 0.344418, 0.299266, 0.238402, 0.530317, 0.201173,\n    0.845135, 0.368270, 0.901918, 0.933553, 0.879270, 0.896686, 0.242673,\n    0.645876, 0.221722, 0.671788, 0.696868, 0.613856, 0.594100, 0.345442,\n    0.478488, 0.365499, 0.560186, 0.419429, 0.068769, 0.764765, 0.122668,\n    0.800360, 0.269527, 0.402713, 0.334230, 0.186238, 0.417001, 0.967712,\n    0.853496, 0.310179, 0.990401, 0.731177, 0.343208, 0.224512, 0.855574,\n    0.460790, 0.815310, 0.857852, 0.702756, 0.390921, 0.820575, 0.520593,\n    0.972868, 0.068325, 0.330995, 0.461637, 0.405847, 0.510358, 0.189043,\n    0.743286, 0.146544, 0.298520, 0.047979, 0.553638, 0.834975, 0.179460,\n    0.576135, 0.432415, 0.424000, 0.680846, 0.195304, 0.569258, 0.102375,\n    0.234922, 0.416825, 0.427743, 0.919058, 0.366473, 0.080673, 0.323088,\n    0.458077, 0.866718, 0.887048, 0.954464, 0.853763, 0.211882, 0.257413,\n    0.401140, 0.143234, 0.711803, 0.858469, 0.176694, 0.376906, 0.538888,\n    0.499580, 0.083381, 0.049338, 0.126933, 0.301235, 0.503423, 0.417381,\n    0.790785, 0.244376, 0.054084, 0.341139, 0.605380, 0.327142, 0.557695,\n    0.273406, 0.123661, 0.177072, 0.239960, 0.264496, 0.289714, 0.758051,\n    0.287238, 0.796446, 0.445350, 0.931600, 0.752621, 0.391089, 0.172409,\n    0.373470, 0.299196, 0.900410, 0.786394, 0.402751, 0.604255, 0.859393,\n    0.225666, 0.533102, 0.141675, 0.139006, 0.737770, 0.172180, 0.215538,\n    0.462962, 0.197081, 0.947766, 0.109388, 0.597156, 0.074044, 0.534133,\n    0.892876, 0.319288, 0.078681, 0.906544, 0.855450, 0.069378, 0.791340,\n    0.571897, 0.240928, 0.309915, 0.333618] ),\n\n  ([0.451521, 0.147221, 0.793268, 0.134800, 0.476577, 0.611164, 0.619312,\n    0.662313, 0.073580, 0.838679, 0.636280, 0.533280, 0.753319, 0.481674,\n    0.839106, 0.484176, 0.576586, 0.062868, 0.198126, 0.954619, 0.398022,\n    0.234657, 0.817927, 0.585437, 0.603961, 0.899411, 0.980773, 0.156499,\n    0.750755, 0.472213, 0.731285, 0.494858, 0.009735, 0.067598, 0.158452,\n    0.385083, 0.825037, 0.891324, 0.030732, 0.012787, 0.690573, 0.618091,\n    0.941404, 0.972564, 0.452345, 0.037629, 0.619587, 0.371441, 0.042665,\n    0.748924, 0.563768, 0.059786, 0.051729, 0.184606, 0.653706, 0.519852,\n    0.043977, 0.747215, 0.897092, 0.444105, 0.024262, 0.337168, 0.967315,\n    0.534165, 0.961150, 0.055483, 0.688437, 0.551775, 0.772637, 0.360759,\n    0.123692, 0.152776, 0.681478, 0.463057, 0.423811, 0.535783, 0.345561,\n    0.235115, 0.091189, 0.436445, 0.670095, 0.422437, 0.816492, 0.498489,\n    0.707541, 0.433393, 0.543687, 0.553453, 0.551897, 0.490768, 0.920011,\n    0.839228, 0.633168, 0.425855, 0.786615, 0.689840, 0.318613, 0.896237,\n    0.866817, 0.726920, 0.226783, 0.308817, 0.307596, 0.084445, 0.160772,\n    0.229316, 0.231239, 0.697897, 0.066927, 0.558763, 0.952391, 0.189154,\n    0.924924, 0.259499, 0.018006, 0.378399, 0.976012, 0.910947, 0.725455,\n    0.954070, 0.195318, 0.876461, 0.275369, 0.332316, 0.414594, 0.363414,\n    0.215857, 0.237434, 0.001343, 0.156438, 0.333476, 0.033784, 0.501236,\n    0.306101, 0.648152, 0.341227, 0.149297, 0.553819, 0.667592, 0.964965,\n    0.656789, 0.774438, 0.557909, 0.670919, 0.179449, 0.217383, 0.386395,\n    0.838435, 0.873989, 0.828394, 0.092746, 0.520737, 0.948180, 0.431837,\n    0.345286, 0.945158, 0.611988, 0.056398, 0.937925, 0.983947, 0.834864,\n    0.184088, 0.884640, 0.627003, 0.315989, 0.204352, 0.867244, 0.987884,\n    0.573992, 0.854793, 0.193091, 0.874325, 0.561632, 0.929228, 0.918790,\n    0.454176, 0.712302, 0.034577, 0.295877, 0.048708, 0.824549, 0.678182,\n    0.195654, 0.583819, 0.690542, 0.465743, 0.668020, 0.730705, 0.874996,\n    0.692587, 0.291879, 0.267403, 0.550737, 0.108310, 0.472610, 0.692251,\n    0.797235, 0.136631, 0.343059, 0.620319, 0.268136, 0.331645, 0.424207,\n    0.994598, 0.634236, 0.351482, 0.702170, 0.642689, 0.708243, 0.230903,\n    0.277017, 0.210700, 0.657064, 0.234046, 0.240455, 0.004852, 0.208808,\n    0.068270, 0.938200, 0.773156, 0.259468, 0.740928, 0.273110, 0.957274,\n    0.786981, 0.839503, 0.206091, 0.446608, 0.477462, 0.517289, 0.109989,\n    0.365703, 0.971221],\n   [0.322975, 0.414170, 0.161146, 0.219434, 0.685011,\n    0.207119, 0.124562, 0.313554, 0.680383, 0.204607, 0.926401, 0.123031,\n    0.342319, 0.160562, 0.383025, 0.263413, 0.031530, 0.278214, 0.854517,\n    0.938668, 0.207718, 0.530081, 0.599408, 0.967141, 0.060306, 0.216206,\n    0.956149, 0.457582, 0.287160, 0.123662, 0.170455, 0.944915, 0.075664,\n    0.367949, 0.137354, 0.245977, 0.789458, 0.601613, 0.753918, 0.205538,\n    0.801701, 0.727608, 0.099538, 0.372815, 0.980670, 0.128872, 0.153952,\n    0.733913, 0.697334, 0.832264, 0.048116, 0.476656, 0.542969, 0.813115,\n    0.428087, 0.974934, 0.283452, 0.267722, 0.308373, 0.467845, 0.073733,\n    0.060755, 0.726314, 0.632607, 0.207968, 0.198739, 0.724649, 0.827431,\n    0.659246, 0.606561, 0.804978, 0.605795, 0.421802, 0.080890, 0.184399,\n    0.042613, 0.669469, 0.636515, 0.163279, 0.506129, 0.443891, 0.538560,\n    0.687417, 0.616605, 0.243001, 0.421577, 0.417744, 0.332821, 0.104680,\n    0.814680, 0.274723, 0.854675, 0.928105, 0.822819, 0.907391, 0.392828,\n    0.560366, 0.167488, 0.771640, 0.421482, 0.502021, 0.705366, 0.356323,\n    0.236132, 0.465837, 0.673047, 0.271604, 0.044967, 0.875918, 0.101957,\n    0.690344, 0.418263, 0.416007, 0.385675, 0.177956, 0.381637, 0.926377,\n    0.834779, 0.212896, 0.991925, 0.837922, 0.493060, 0.257955, 0.881184,\n    0.455624, 0.759888, 0.797075, 0.476411, 0.546274, 0.653626, 0.437864,\n    0.979247, 0.101421, 0.310239, 0.301380, 0.315334, 0.540806, 0.179717,\n    0.803455, 0.157591, 0.320087, 0.061332, 0.563749, 0.755219, 0.043938,\n    0.411661, 0.403751, 0.445964, 0.558204, 0.265296, 0.639173, 0.087912,\n    0.230078, 0.404120, 0.337301, 0.932361, 0.434332, 0.084389, 0.343341,\n    0.257858, 0.761906, 0.918835, 0.952784, 0.774380, 0.105933, 0.159839,\n    0.830403, 0.338071, 0.526166, 0.863985, 0.233685, 0.379596, 0.616285,\n    0.618324, 0.069956, 0.031873, 0.139768, 0.470940, 0.707807, 0.243367,\n    0.727987, 0.305121, 0.104586, 0.262189, 0.546923, 0.339179, 0.566545,\n    0.340525, 0.118514, 0.187525, 0.391617, 0.309406, 0.182629, 0.782616,\n    0.233684, 0.765575, 0.523726, 0.866878, 0.699958, 0.572039, 0.237482,\n    0.526532, 0.374557, 0.928282, 0.707831, 0.618044, 0.446578, 0.624965,\n    0.199537, 0.468197, 0.182506, 0.083061, 0.585536, 0.276978, 0.076367,\n    0.358145, 0.224962, 0.838192, 0.129973, 0.763684, 0.229108, 0.557319,\n    0.866519, 0.293349, 0.163828, 0.895601, 0.903358, 0.058000, 0.789358,\n    0.591071, 0.270399, 0.131062, 0.486600] ),\n\n  ([0.965209, 0.133641, 0.925626, 0.133671, 0.650899, 0.231605, 0.871517,\n    0.258309, 0.107364, 0.016541, 0.557054, 0.607166, 0.550859, 0.089724,\n    0.176702, 0.195593, 0.110752, 0.006592, 0.188025, 0.227668, 0.951659,\n    0.533219, 0.454115, 0.087741, 0.069246, 0.349925, 0.138401, 0.295358,\n    0.041841, 0.858791, 0.882534, 0.328928, 0.517289, 0.250343, 0.298502,\n    0.725211, 0.718314, 0.486862, 0.306864, 0.359874, 0.746239, 0.357524,\n    0.351665, 0.316630, 0.964873, 0.262246, 0.023408, 0.249794, 0.245796,\n    0.880398, 0.122013, 0.647938, 0.356243, 0.380047, 0.689871, 0.903531,\n    0.270577, 0.325297, 0.047121, 0.595904, 0.687124, 0.936308, 0.360454,\n    0.893399, 0.531205, 0.859523, 0.775628, 0.480361, 0.725822, 0.103824,\n    0.646290, 0.916501, 0.010987, 0.299142, 0.889737, 0.833583, 0.093417,\n    0.933103, 0.000305, 0.876553, 0.907254, 0.722800, 0.753166, 0.794946,\n    0.267495, 0.777764, 0.127628, 0.590930, 0.697531, 0.709616, 0.483627,\n    0.130345, 0.711173, 0.345744, 0.520463, 0.122745, 0.331400, 0.202582,\n    0.050539, 0.876949, 0.126804, 0.374828, 0.118503, 0.737968, 0.546495,\n    0.997009, 0.497635, 0.612384, 0.835261, 0.933500, 0.093997, 0.487197,\n    0.310099, 0.853481, 0.290597, 0.349590, 0.279397, 0.346660, 0.761834,\n    0.412946, 0.385571, 0.236427, 0.789911, 0.056154, 0.653279, 0.746544,\n    0.614765, 0.381603, 0.023560, 0.677328, 0.848170, 0.798975, 0.655934,\n    0.248329, 0.483566, 0.540361, 0.778741, 0.762841, 0.533067, 0.513596,\n    0.370281, 0.751061, 0.822260, 0.399396, 0.450819, 0.748253, 0.974914,\n    0.399030, 0.267159, 0.363384, 0.118046, 0.538774, 0.151311, 0.795740,\n    0.339244, 0.937040, 0.334025, 0.454329, 0.426740, 0.940641, 0.494705,\n    0.837642, 0.924558, 0.536699, 0.328990, 0.329020, 0.032716, 0.946013,\n    0.914975, 0.064608, 0.384930, 0.804102, 0.159703, 0.529588, 0.234169,\n    0.837001, 0.106906, 0.039155, 0.077731, 0.436689, 0.387310, 0.760826,\n    0.253212, 0.043825, 0.592669, 0.433638, 0.536180, 0.742943, 0.855220,\n    0.441084, 0.271157, 0.976867, 0.412976, 0.393719, 0.067049, 0.786706,\n    0.443129, 0.877956, 0.588458, 0.483413, 0.943754, 0.526688, 0.473434,\n    0.156957, 0.945952, 0.069094, 0.910062, 0.930143, 0.837275, 0.514573,\n    0.902127, 0.362255, 0.077548, 0.128025, 0.755486, 0.909848, 0.088778,\n    0.352489, 0.816553, 0.850124, 0.599902, 0.334941, 0.993927, 0.573504,\n    0.227882, 0.212073, 0.094333, 0.651753, 0.576739, 0.812311, 0.504532,\n    0.587451, 0.634816],\n   [0.302431, 0.592346, 0.385344, 0.262467, 0.590451,\n    0.183795, 0.213462, 0.439501, 0.685453, 0.160185, 0.933631, 0.128044,\n    0.473315, 0.155567, 0.492202, 0.220253, 0.019522, 0.469708, 0.877853,\n    0.882415, 0.430326, 0.645252, 0.298033, 0.974497, 0.075881, 0.454331,\n    0.980756, 0.353203, 0.227064, 0.112352, 0.204441, 0.986582, 0.111204,\n    0.360922, 0.104295, 0.042607, 0.664624, 0.575153, 0.703935, 0.219955,\n    0.724316, 0.760176, 0.086626, 0.569313, 0.985771, 0.070120, 0.125450,\n    0.608872, 0.735175, 0.869160, 0.116281, 0.382006, 0.535477, 0.916268,\n    0.339548, 0.951149, 0.269138, 0.158267, 0.227921, 0.496810, 0.078373,\n    0.109946, 0.857936, 0.460175, 0.325318, 0.226608, 0.881037, 0.765901,\n    0.643060, 0.624702, 0.860348, 0.550049, 0.440815, 0.045541, 0.260502,\n    0.076994, 0.577882, 0.615792, 0.139510, 0.358114, 0.612593, 0.347721,\n    0.818075, 0.526762, 0.377618, 0.514885, 0.205696, 0.501251, 0.196091,\n    0.886461, 0.334135, 0.829124, 0.919315, 0.913637, 0.931191, 0.463876,\n    0.534980, 0.183099, 0.612192, 0.441730, 0.502768, 0.648400, 0.513146,\n    0.572191, 0.598630, 0.502384, 0.334881, 0.031650, 0.855085, 0.124462,\n    0.852059, 0.450404, 0.460454, 0.470191, 0.387106, 0.341040, 0.953467,\n    0.868460, 0.346095, 0.991675, 0.840988, 0.432867, 0.309167, 0.832854,\n    0.502416, 0.631140, 0.913146, 0.646113, 0.533057, 0.744471, 0.344817,\n    0.940144, 0.095737, 0.351065, 0.352773, 0.470006, 0.334397, 0.168739,\n    0.758467, 0.118992, 0.163775, 0.065261, 0.683652, 0.880562, 0.097123,\n    0.524062, 0.373206, 0.612702, 0.639353, 0.118260, 0.626205, 0.073664,\n    0.238101, 0.415854, 0.550570, 0.891418, 0.355098, 0.070208, 0.362777,\n    0.318568, 0.738166, 0.900724, 0.976352, 0.702925, 0.146500, 0.299967,\n    0.705262, 0.364984, 0.552743, 0.965066, 0.116578, 0.213095, 0.466038,\n    0.747374, 0.067506, 0.087477, 0.178816, 0.416269, 0.468249, 0.214696,\n    0.835123, 0.118108, 0.025186, 0.379601, 0.633495, 0.177899, 0.682522,\n    0.295777, 0.141661, 0.153813, 0.116872, 0.401177, 0.173447, 0.851914,\n    0.213767, 0.629566, 0.332266, 0.909032, 0.721796, 0.678533, 0.154774,\n    0.709337, 0.292937, 0.943155, 0.633317, 0.467546, 0.571542, 0.892620,\n    0.209587, 0.472640, 0.425492, 0.096146, 0.488989, 0.063471, 0.114715,\n    0.354080, 0.168293, 0.811268, 0.093427, 0.730772, 0.163385, 0.495506,\n    0.936379, 0.234286, 0.082734, 0.884049, 0.750206, 0.102785, 0.857904,\n    0.691171, 0.194803, 0.207255, 0.440377] ),\n\n  ([0.929533, 0.249916, 0.651570, 0.752678, 0.825922, 0.961516, 0.715232,\n    0.981933, 0.119022, 0.782250, 0.481582, 0.056917, 0.710440, 0.744163,\n    0.024689, 0.800104, 0.911008, 0.647359, 0.041017, 0.232368, 0.420331,\n    0.972259, 0.720145, 0.170141, 0.315378, 0.856197, 0.640889, 0.589434,\n    0.705618, 0.666005, 0.599170, 0.539232, 0.209906, 0.197089, 0.773492,\n    0.884823, 0.912564, 0.031281, 0.134800, 0.662252, 0.953429, 0.083590,\n    0.506851, 0.325632, 0.409558, 0.869930, 0.182592, 0.668203, 0.624042,\n    0.526902, 0.504379, 0.698263, 0.637928, 0.114566, 0.312449, 0.251686,\n    0.882595, 0.233741, 0.669393, 0.622059, 0.787561, 0.489059, 0.765893,\n    0.989288, 0.460860, 0.828913, 0.414533, 0.928587, 0.097812, 0.293558,\n    0.037843, 0.780816, 0.274758, 0.202918, 0.556444, 0.165197, 0.783349,\n    0.314676, 0.083987, 0.416028, 0.162694, 0.984741, 0.835170, 0.224250,\n    0.584674, 0.860591, 0.152470, 0.265755, 0.248909, 0.139317, 0.058779,\n    0.096744, 0.944182, 0.921293, 0.241127, 0.098422, 0.931639, 0.690481,\n    0.872860, 0.751366, 0.806818, 0.453597, 0.179449, 0.021455, 0.496414,\n    0.568194, 0.155065, 0.138371, 0.045839, 0.791528, 0.335582, 0.547716,\n    0.354442, 0.581622, 0.034608, 0.318491, 0.513718, 0.181249, 0.948485,\n    0.786798, 0.905820, 0.516587, 0.536851, 0.716880, 0.717704, 0.441359,\n    0.084780, 0.761498, 0.027741, 0.358196, 0.852809, 0.501877, 0.120792,\n    0.747978, 0.220954, 0.849330, 0.187933, 0.638630, 0.233589, 0.089114,\n    0.067476, 0.544877, 0.450301, 0.348674, 0.182867, 0.909635, 0.510178,\n    0.770287, 0.334483, 0.578784, 0.314920, 0.170507, 0.500961, 0.340342,\n    0.237617, 0.467055, 0.306589, 0.059359, 0.262856, 0.654500, 0.310953,\n    0.439802, 0.464888, 0.610065, 0.777306, 0.944517, 0.730033, 0.510666,\n    0.075198, 0.904721, 0.129185, 0.142705, 0.374828, 0.350352, 0.847346,\n    0.885556, 0.787927, 0.592059, 0.075533, 0.650136, 0.612690, 0.086581,\n    0.772607, 0.553880, 0.838374, 0.616688, 0.701407, 0.613178, 0.565600,\n    0.316538, 0.647694, 0.234718, 0.499344, 0.574175, 0.226051, 0.787072,\n    0.170141, 0.342265, 0.180517, 0.033082, 0.040284, 0.888180, 0.585284,\n    0.705618, 0.150731, 0.514817, 0.852107, 0.006226, 0.465651, 0.283395,\n    0.950774, 0.309885, 0.570208, 0.269387, 0.748466, 0.855129, 0.878201,\n    0.383007, 0.874722, 0.702322, 0.005676, 0.285348, 0.017823, 0.740684,\n    0.467086, 0.431471, 0.059359, 0.025330, 0.349376, 0.771599, 0.952605,\n    0.225471, 0.121464],\n   [0.471172, 0.394669, 0.206750, 0.210992, 0.672674,\n    0.219721, 0.244692, 0.426030, 0.784261, 0.125930, 0.920721, 0.154459,\n    0.450891, 0.147751, 0.367723, 0.353484, 0.026113, 0.408033, 0.834816,\n    0.836353, 0.222549, 0.727688, 0.436814, 0.937279, 0.062492, 0.322380,\n    0.970168, 0.358693, 0.165828, 0.163289, 0.179660, 0.946080, 0.107585,\n    0.214507, 0.120466, 0.146463, 0.513517, 0.744142, 0.796061, 0.229379,\n    0.872125, 0.699375, 0.097177, 0.456963, 0.983115, 0.103819, 0.067400,\n    0.572813, 0.619288, 0.738678, 0.064006, 0.534990, 0.457646, 0.821854,\n    0.245365, 0.935265, 0.292294, 0.273248, 0.484045, 0.650145, 0.134589,\n    0.129359, 0.760950, 0.500222, 0.244806, 0.295520, 0.888711, 0.794874,\n    0.648125, 0.671853, 0.861657, 0.618463, 0.418073, 0.037680, 0.213474,\n    0.081569, 0.498616, 0.466083, 0.254703, 0.579328, 0.489857, 0.365154,\n    0.823990, 0.691592, 0.177938, 0.402626, 0.413972, 0.432276, 0.128408,\n    0.861022, 0.334743, 0.852509, 0.905923, 0.855449, 0.907655, 0.449490,\n    0.525716, 0.146824, 0.576212, 0.621424, 0.631967, 0.680759, 0.213491,\n    0.453037, 0.455632, 0.589247, 0.386547, 0.051896, 0.834187, 0.065552,\n    0.821578, 0.352428, 0.257310, 0.496232, 0.325953, 0.415318, 0.944347,\n    0.879332, 0.271775, 0.994542, 0.755022, 0.297164, 0.397653, 0.922277,\n    0.248507, 0.646424, 0.828524, 0.605859, 0.566800, 0.766935, 0.501635,\n    0.968145, 0.101199, 0.250424, 0.261777, 0.417199, 0.420268, 0.129902,\n    0.670874, 0.244133, 0.465330, 0.072836, 0.635216, 0.847806, 0.110087,\n    0.366808, 0.501077, 0.518786, 0.719245, 0.116495, 0.614688, 0.075322,\n    0.230603, 0.497451, 0.382493, 0.916194, 0.445191, 0.092338, 0.298070,\n    0.477992, 0.755918, 0.914011, 0.974732, 0.707787, 0.173469, 0.199932,\n    0.765572, 0.213141, 0.596297, 0.892776, 0.147179, 0.364556, 0.506639,\n    0.737935, 0.078835, 0.081713, 0.207005, 0.301130, 0.607415, 0.176493,\n    0.729900, 0.207783, 0.024178, 0.266947, 0.655454, 0.133159, 0.598460,\n    0.426653, 0.098941, 0.108835, 0.144931, 0.394514, 0.293194, 0.870920,\n    0.156846, 0.751377, 0.464677, 0.895932, 0.790477, 0.579755, 0.462048,\n    0.682392, 0.230107, 0.921158, 0.641127, 0.610895, 0.569350, 0.699673,\n    0.178217, 0.276934, 0.170802, 0.081585, 0.765277, 0.194187, 0.089230,\n    0.378231, 0.151939, 0.827206, 0.093455, 0.748796, 0.175005, 0.362430,\n    0.899749, 0.406536, 0.105491, 0.936633, 0.825872, 0.095697, 0.877409,\n    0.610769, 0.203597, 0.204503, 0.606680] ),\n\n  ([0.142003, 0.751518, 0.465590, 0.234352, 0.876461, 0.696310, 0.339915,\n    0.668569, 0.669485, 0.761986, 0.382611, 0.085208, 0.223121, 0.575793,\n    0.773675, 0.736900, 0.707907, 0.110324, 0.562853, 0.794153, 0.569628,\n    0.058077, 0.192145, 0.244758, 0.713095, 0.294137, 0.598560, 0.021302,\n    0.594043, 0.332591, 0.677908, 0.513382, 0.250404, 0.183752, 0.391614,\n    0.120975, 0.804621, 0.517899, 0.296945, 0.005188, 0.467360, 0.541704,\n    0.782586, 0.692190, 0.574999, 0.494095, 0.790277, 0.687185, 0.691214,\n    0.167272, 0.304422, 0.754418, 0.304331, 0.359569, 0.390179, 0.019105,\n    0.151738, 0.666005, 0.061647, 0.548479, 0.702445, 0.513138, 0.761681,\n    0.566820, 0.828913, 0.844234, 0.733970, 0.962340, 0.199927, 0.361064,\n    0.069002, 0.240516, 0.425275, 0.728690, 0.705344, 0.581744, 0.483444,\n    0.649129, 0.166875, 0.158025, 0.464034, 0.210852, 0.317911, 0.366222,\n    0.155736, 0.419538, 0.917020, 0.133152, 0.511338, 0.316782, 0.250801,\n    0.949675, 0.520859, 0.593127, 0.629414, 0.788903, 0.524155, 0.101291,\n    0.024079, 0.566149, 0.494308, 0.176244, 0.628986, 0.295633, 0.322825,\n    0.167791, 0.627735, 0.600818, 0.638203, 0.092868, 0.946715, 0.734642,\n    0.188726, 0.812616, 0.275399, 0.765618, 0.321360, 0.641591, 0.136143,\n    0.086184, 0.587024, 0.794610, 0.283456, 0.899930, 0.004608, 0.577685,\n    0.214942, 0.842891, 0.014191, 0.729667, 0.074770, 0.396619, 0.650868,\n    0.820124, 0.731040, 0.247932, 0.970763, 0.110355, 0.307810, 0.252602,\n    0.260140, 0.783593, 0.954222, 0.158452, 0.058901, 0.950316, 0.130284,\n    0.744774, 0.529954, 0.335520, 0.192419, 0.533708, 0.205237, 0.053743,\n    0.558275, 0.730583, 0.640339, 0.378185, 0.233345, 0.548448, 0.008240,\n    0.910215, 0.980041, 0.574084, 0.163976, 0.055635, 0.910550, 0.331095,\n    0.211127, 0.213782, 0.784875, 0.696524, 0.101505, 0.585772, 0.795099,\n    0.327189, 0.299417, 0.007965, 0.117161, 0.752190, 0.041505, 0.717429,\n    0.011841, 0.287454, 0.223609, 0.454909, 0.755211, 0.429151, 0.445753,\n    0.812281, 0.180944, 0.881344, 0.246742, 0.230079, 0.115024, 0.875149,\n    0.059297, 0.551988, 0.484176, 0.934996, 0.917264, 0.541856, 0.379467,\n    0.748222, 0.445784, 0.270180, 0.856349, 0.294778, 0.166387, 0.775903,\n    0.751946, 0.892605, 0.647328, 0.909574, 0.301675, 0.315500, 0.531083,\n    0.764855, 0.835444, 0.639454, 0.970031, 0.603778, 0.335368, 0.973693,\n    0.501480, 0.682699, 0.136326, 0.732688, 0.893765, 0.884610, 0.549852,\n    0.605731, 0.993652],\n   [0.253504, 0.534326, 0.251760, 0.237928, 0.664410,\n    0.126609, 0.132684, 0.418006, 0.666470, 0.215330, 0.920184, 0.117055,\n    0.355147, 0.170783, 0.327884, 0.256327, 0.027910, 0.470747, 0.880988,\n    0.889491, 0.479139, 0.521001, 0.393600, 0.972722, 0.085265, 0.415580,\n    0.972281, 0.482544, 0.346985, 0.134187, 0.148290, 0.967033, 0.064457,\n    0.308757, 0.091188, 0.106056, 0.666364, 0.644436, 0.738676, 0.157409,\n    0.796504, 0.819582, 0.161226, 0.572395, 0.985212, 0.056289, 0.124700,\n    0.684193, 0.738343, 0.858700, 0.119422, 0.531593, 0.540814, 0.806578,\n    0.255111, 0.953920, 0.375051, 0.132877, 0.304271, 0.424460, 0.108830,\n    0.140324, 0.726330, 0.390954, 0.344656, 0.297103, 0.836113, 0.845710,\n    0.541340, 0.593495, 0.799546, 0.607697, 0.385357, 0.059555, 0.275257,\n    0.043167, 0.741677, 0.452371, 0.186232, 0.458056, 0.634944, 0.440253,\n    0.781245, 0.585590, 0.386615, 0.299644, 0.311233, 0.638113, 0.139079,\n    0.818473, 0.272349, 0.785139, 0.910448, 0.847825, 0.909313, 0.463918,\n    0.570289, 0.136830, 0.605815, 0.361042, 0.480547, 0.633562, 0.233467,\n    0.466913, 0.601511, 0.711690, 0.285150, 0.039565, 0.908040, 0.081223,\n    0.741324, 0.409105, 0.448214, 0.349451, 0.247382, 0.355812, 0.891038,\n    0.892278, 0.230916, 0.983817, 0.739059, 0.550368, 0.366082, 0.896731,\n    0.351754, 0.755379, 0.861318, 0.627702, 0.478943, 0.759569, 0.411450,\n    0.968553, 0.062213, 0.275821, 0.331454, 0.331865, 0.397601, 0.223281,\n    0.710319, 0.145954, 0.317140, 0.057056, 0.578738, 0.816384, 0.047016,\n    0.525610, 0.336833, 0.552102, 0.683525, 0.119884, 0.484933, 0.066421,\n    0.280478, 0.551438, 0.287947, 0.877956, 0.468814, 0.059983, 0.421428,\n    0.275246, 0.737221, 0.887111, 0.973068, 0.761741, 0.125024, 0.179706,\n    0.712262, 0.175115, 0.647305, 0.929135, 0.099306, 0.232157, 0.620496,\n    0.679094, 0.034862, 0.051003, 0.142482, 0.370931, 0.493494, 0.258032,\n    0.837991, 0.177554, 0.086700, 0.207737, 0.563446, 0.417696, 0.483721,\n    0.268154, 0.138681, 0.203293, 0.290859, 0.364657, 0.312939, 0.843912,\n    0.214481, 0.670471, 0.528396, 0.848559, 0.746439, 0.552310, 0.207122,\n    0.532526, 0.364218, 0.940528, 0.635287, 0.556140, 0.505382, 0.879060,\n    0.255610, 0.447759, 0.191044, 0.081017, 0.529700, 0.163505, 0.202604,\n    0.245266, 0.199667, 0.866675, 0.114402, 0.669242, 0.149501, 0.338364,\n    0.852990, 0.361792, 0.111204, 0.925449, 0.829030, 0.085374, 0.849162,\n    0.590237, 0.245031, 0.150276, 0.340917] ),\n\n  ([0.564470, 0.693442, 0.879666, 0.107578, 0.513840, 0.306131, 0.271432,\n    0.947142, 0.450636, 0.831721, 0.927030, 0.669912, 0.940580, 0.550462,\n    0.742088, 0.047792, 0.156682, 0.041353, 0.661550, 0.293374, 0.382855,\n    0.755455, 0.113773, 0.575396, 0.667714, 0.981658, 0.235786, 0.755394,\n    0.535142, 0.986694, 0.045747, 0.376049, 0.157872, 0.609790, 0.218940,\n    0.432936, 0.899991, 0.093966, 0.623646, 0.960265, 0.634938, 0.434828,\n    0.272652, 0.962981, 0.745201, 0.027924, 0.847713, 0.725242, 0.209784,\n    0.896725, 0.451704, 0.027467, 0.685934, 0.281228, 0.746239, 0.302713,\n    0.991058, 0.869991, 0.129826, 0.263619, 0.891629, 0.455061, 0.113681,\n    0.031587, 0.604541, 0.292825, 0.550615, 0.298959, 0.918088, 0.950591,\n    0.874081, 0.555651, 0.337840, 0.920957, 0.003021, 0.911557, 0.164525,\n    0.785180, 0.069155, 0.545976, 0.909726, 0.206366, 0.622486, 0.315073,\n    0.955535, 0.534104, 0.471877, 0.548936, 0.864864, 0.301584, 0.816462,\n    0.569140, 0.248146, 0.396710, 0.824427, 0.958556, 0.593219, 0.188147,\n    0.315226, 0.114170, 0.963958, 0.387860, 0.701682, 0.114353, 0.974639,\n    0.930906, 0.847865, 0.431928, 0.945891, 0.654439, 0.999481, 0.524003,\n    0.648366, 0.056551, 0.442701, 0.830317, 0.540605, 0.916623, 0.047761,\n    0.210761, 0.907559, 0.057924, 0.353465, 0.353740, 0.805231, 0.034425,\n    0.349071, 0.186407, 0.218818, 0.022553, 0.609790, 0.818262, 0.339518,\n    0.699057, 0.941710, 0.048799, 0.366863, 0.386822, 0.193091, 0.971587,\n    0.742851, 0.249214, 0.387860, 0.704428, 0.223762, 0.814692, 0.837397,\n    0.778466, 0.696280, 0.612629, 0.387249, 0.216193, 0.143742, 0.201758,\n    0.455000, 0.830653, 0.669515, 0.372478, 0.015076, 0.776055, 0.982635,\n    0.804102, 0.187414, 0.882138, 0.253090, 0.958678, 0.585559, 0.802576,\n    0.742302, 0.492080, 0.080996, 0.509293, 0.115177, 0.964324, 0.139897,\n    0.163701, 0.840327, 0.129429, 0.387829, 0.896115, 0.583880, 0.587237,\n    0.559923, 0.524461, 0.004425, 0.077090, 0.491440, 0.744163, 0.853969,\n    0.196173, 0.306101, 0.819422, 0.792077, 0.822077, 0.457564, 0.307962,\n    0.819178, 0.022309, 0.780969, 0.850459, 0.734977, 0.731315, 0.210089,\n    0.555071, 0.529038, 0.975768, 0.317301, 0.009491, 0.108585, 0.930784,\n    0.331614, 0.451064, 0.271065, 0.586749, 0.791589, 0.126011, 0.326701,\n    0.309183, 0.489364, 0.369976, 0.277749, 0.072176, 0.861965, 0.439833,\n    0.960906, 0.647023, 0.485916, 0.629292, 0.058443, 0.527085, 0.831874,\n    0.698630, 0.385174],\n   [0.495618, 0.441464, 0.557017, 0.272405, 0.594053,\n    0.213913, 0.095401, 0.330141, 0.756265, 0.213387, 0.945661, 0.215836,\n    0.478364, 0.166789, 0.265475, 0.224600, 0.011292, 0.356525, 0.881330,\n    0.899717, 0.340867, 0.762765, 0.398643, 0.959794, 0.076373, 0.411068,\n    0.956087, 0.425671, 0.267392, 0.086429, 0.230950, 0.969761, 0.077102,\n    0.364494, 0.110616, 0.201659, 0.655970, 0.529764, 0.775525, 0.178886,\n    0.732134, 0.748248, 0.129081, 0.515934, 0.980429, 0.110490, 0.140175,\n    0.754832, 0.623327, 0.732077, 0.072652, 0.447853, 0.313085, 0.880703,\n    0.231171, 0.966561, 0.265433, 0.153128, 0.496576, 0.485365, 0.232871,\n    0.147871, 0.742083, 0.608403, 0.367386, 0.242410, 0.889346, 0.726072,\n    0.567069, 0.541939, 0.876543, 0.588447, 0.463390, 0.048924, 0.332279,\n    0.112237, 0.583767, 0.708608, 0.194895, 0.406334, 0.623418, 0.521972,\n    0.732477, 0.736640, 0.234700, 0.436454, 0.332746, 0.552401, 0.149503,\n    0.896181, 0.132756, 0.723063, 0.864270, 0.737282, 0.896088, 0.500499,\n    0.435932, 0.208168, 0.772405, 0.552217, 0.466660, 0.676089, 0.363508,\n    0.511280, 0.383914, 0.680339, 0.244844, 0.037614, 0.821954, 0.097665,\n    0.866579, 0.369076, 0.428357, 0.289866, 0.218990, 0.386788, 0.958202,\n    0.895966, 0.332165, 0.987714, 0.837437, 0.415629, 0.234766, 0.762833,\n    0.575631, 0.802375, 0.868664, 0.547072, 0.361121, 0.787932, 0.372006,\n    0.962287, 0.132690, 0.364041, 0.272380, 0.455698, 0.386066, 0.211024,\n    0.726992, 0.223019, 0.238927, 0.028980, 0.619901, 0.829672, 0.114443,\n    0.530184, 0.384064, 0.570925, 0.593174, 0.172192, 0.479118, 0.055151,\n    0.175546, 0.543465, 0.386083, 0.921652, 0.407870, 0.111462, 0.413042,\n    0.409689, 0.804235, 0.840629, 0.970208, 0.698751, 0.221048, 0.330415,\n    0.674973, 0.245212, 0.661346, 0.911649, 0.197003, 0.272622, 0.678364,\n    0.645042, 0.082575, 0.073088, 0.102925, 0.483113, 0.540776, 0.190397,\n    0.789439, 0.199725, 0.028167, 0.298789, 0.666024, 0.294616, 0.698567,\n    0.244601, 0.071771, 0.145942, 0.372541, 0.500928, 0.208398, 0.810336,\n    0.256493, 0.752106, 0.419867, 0.844875, 0.739738, 0.589028, 0.172165,\n    0.576336, 0.388612, 0.942727, 0.605002, 0.466328, 0.573021, 0.868937,\n    0.193609, 0.484958, 0.312042, 0.164538, 0.625321, 0.355834, 0.114481,\n    0.326462, 0.120043, 0.885765, 0.155206, 0.625728, 0.175445, 0.336309,\n    0.853385, 0.299478, 0.164527, 0.921071, 0.777973, 0.099571, 0.860153,\n    0.491092, 0.205249, 0.258365, 0.463333] ),\n\n  ([0.870357, 0.935087, 0.150121, 0.356639, 0.240822, 0.138127, 0.380718,\n    0.045442, 0.429823, 0.562517, 0.242409, 0.731742, 0.138768, 0.464309,\n    0.042634, 0.353954, 0.804498, 0.131626, 0.514969, 0.766320, 0.348430,\n    0.478835, 0.791864, 0.209052, 0.130772, 0.994385, 0.910764, 0.898007,\n    0.891110, 0.198492, 0.884426, 0.139439, 0.956359, 0.266915, 0.867061,\n    0.876614, 0.498032, 0.976684, 0.447493, 0.073946, 0.119053, 0.630573,\n    0.600482, 0.846004, 0.552141, 0.116428, 0.327250, 0.735923, 0.750786,\n    0.757378, 0.517228, 0.051332, 0.154057, 0.109104, 0.061281, 0.662770,\n    0.406384, 0.361095, 0.748314, 0.171056, 0.313822, 0.497330, 0.976440,\n    0.850581, 0.317667, 0.872921, 0.809565, 0.273690, 0.267159, 0.363384,\n    0.411298, 0.023469, 0.772149, 0.742088, 0.386822, 0.400220, 0.916929,\n    0.442579, 0.064089, 0.528459, 0.617023, 0.361950, 0.246193, 0.770837,\n    0.399457, 0.861446, 0.465133, 0.854518, 0.888180, 0.620563, 0.269173,\n    0.617115, 0.776025, 0.500992, 0.574511, 0.777551, 0.563921, 0.076479,\n    0.612659, 0.639058, 0.849269, 0.985076, 0.504776, 0.129612, 0.444014,\n    0.759636, 0.994293, 0.087008, 0.104495, 0.293527, 0.368694, 0.193701,\n    0.153478, 0.596973, 0.102481, 0.468856, 0.776269, 0.000702, 0.251717,\n    0.723014, 0.271676, 0.463393, 0.131748, 0.881924, 0.039613, 0.138493,\n    0.309763, 0.585681, 0.585986, 0.857418, 0.442610, 0.969939, 0.326548,\n    0.684713, 0.991852, 0.034211, 0.470840, 0.201971, 0.346904, 0.505295,\n    0.767449, 0.676412, 0.387707, 0.600116, 0.391675, 0.770318, 0.017975,\n    0.595965, 0.757439, 0.948088, 0.700552, 0.613239, 0.533708, 0.236518,\n    0.525773, 0.517441, 0.647847, 0.495041, 0.844569, 0.346507, 0.555956,\n    0.851680, 0.996948, 0.169897, 0.562578, 0.461623, 0.167638, 0.785394,\n    0.470077, 0.244209, 0.900052, 0.160161, 0.339549, 0.754509, 0.299173,\n    0.022309, 0.644307, 0.846034, 0.455824, 0.508805, 0.597034, 0.280923,\n    0.122440, 0.276406, 0.932340, 0.943175, 0.172155, 0.982025, 0.925138,\n    0.812067, 0.872494, 0.537828, 0.927244, 0.351482, 0.504379, 0.048799,\n    0.202124, 0.471297, 0.358623, 0.837458, 0.340373, 0.717582, 0.640278,\n    0.463027, 0.035951, 0.847407, 0.312296, 0.141240, 0.505356, 0.444563,\n    0.410382, 0.470290, 0.330546, 0.732871, 0.859432, 0.869991, 0.006806,\n    0.242683, 0.323160, 0.640065, 0.977264, 0.487289, 0.118381, 0.043641,\n    0.434400, 0.305338, 0.724967, 0.322703, 0.671255, 0.025483, 0.922483,\n    0.050966, 0.261727],\n   [0.260157, 0.307517, 0.358097, 0.252689, 0.772330,\n    0.168730, 0.199755, 0.263603, 0.796697, 0.181093, 0.908662, 0.220840,\n    0.448967, 0.056864, 0.383428, 0.252245, 0.028268, 0.379121, 0.920537,\n    0.931111, 0.376615, 0.702265, 0.339892, 0.951384, 0.054280, 0.473895,\n    0.985559, 0.437227, 0.257565, 0.131997, 0.163347, 0.974754, 0.051855,\n    0.364200, 0.179886, 0.139106, 0.533888, 0.439360, 0.658220, 0.284960,\n    0.802907, 0.717600, 0.108974, 0.423505, 0.979426, 0.072133, 0.140069,\n    0.642677, 0.641243, 0.648287, 0.086454, 0.332935, 0.442687, 0.900471,\n    0.324827, 0.970455, 0.321905, 0.153388, 0.273655, 0.560316, 0.054492,\n    0.164323, 0.775053, 0.618409, 0.320127, 0.217728, 0.806489, 0.830306,\n    0.422330, 0.576379, 0.884398, 0.516388, 0.381542, 0.044992, 0.252025,\n    0.077069, 0.768432, 0.381270, 0.154768, 0.518110, 0.765505, 0.365825,\n    0.591896, 0.683737, 0.155926, 0.240362, 0.234728, 0.662729, 0.099457,\n    0.899237, 0.244236, 0.906834, 0.903701, 0.839181, 0.900426, 0.410311,\n    0.610486, 0.151047, 0.777519, 0.399258, 0.474944, 0.605231, 0.337552,\n    0.385688, 0.341139, 0.679593, 0.385755, 0.035838, 0.872824, 0.144731,\n    0.756607, 0.337629, 0.336516, 0.400295, 0.349064, 0.239996, 0.890461,\n    0.918159, 0.191377, 0.993292, 0.743830, 0.487235, 0.297947, 0.904181,\n    0.347443, 0.796035, 0.902446, 0.487609, 0.457696, 0.661949, 0.538200,\n    0.961316, 0.048804, 0.252998, 0.376427, 0.402341, 0.368201, 0.151905,\n    0.719359, 0.208973, 0.274783, 0.051515, 0.586169, 0.870502, 0.067245,\n    0.473591, 0.397839, 0.618277, 0.627337, 0.094868, 0.342847, 0.082950,\n    0.306641, 0.610109, 0.216219, 0.850829, 0.415679, 0.109415, 0.430899,\n    0.368500, 0.672157, 0.943332, 0.973869, 0.654748, 0.097660, 0.130777,\n    0.714200, 0.168292, 0.513323, 0.919240, 0.323300, 0.443992, 0.613737,\n    0.690707, 0.038421, 0.054618, 0.152763, 0.333967, 0.530286, 0.307992,\n    0.929752, 0.188744, 0.063666, 0.359969, 0.680815, 0.212698, 0.676648,\n    0.319024, 0.140095, 0.220252, 0.142314, 0.333826, 0.266799, 0.812927,\n    0.297978, 0.767975, 0.598235, 0.890015, 0.710723, 0.567831, 0.346083,\n    0.587204, 0.342478, 0.962254, 0.687791, 0.580150, 0.457589, 0.859200,\n    0.168856, 0.500052, 0.205292, 0.075898, 0.546948, 0.241454, 0.054149,\n    0.449954, 0.299996, 0.883236, 0.178772, 0.792651, 0.196661, 0.379851,\n    0.872677, 0.203970, 0.132733, 0.919790, 0.809352, 0.089786, 0.863894,\n    0.624949, 0.109569, 0.242875, 0.490815] ),\n\n  ([0.109653, 0.085360, 0.731498, 0.853023, 0.430921, 0.667531, 0.044008,\n    0.850154, 0.842463, 0.407300, 0.649648, 0.774590, 0.193823, 0.284799,\n    0.957732, 0.577776, 0.450789, 0.762169, 0.762383, 0.691122, 0.074648,\n    0.338389, 0.154241, 0.093356, 0.318003, 0.949950, 0.613880, 0.177160,\n    0.592273, 0.248024, 0.692862, 0.695242, 0.564287, 0.284463, 0.189398,\n    0.568255, 0.137181, 0.636647, 0.224097, 0.835078, 0.972625, 0.503494,\n    0.122288, 0.527024, 0.709952, 0.803125, 0.509537, 0.746971, 0.539415,\n    0.803919, 0.525956, 0.734947, 0.284402, 0.319864, 0.566210, 0.201239,\n    0.650410, 0.001801, 0.450911, 0.708457, 0.795862, 0.755516, 0.436171,\n    0.383374, 0.881466, 0.817835, 0.966979, 0.740532, 0.754509, 0.522599,\n    0.581103, 0.897977, 0.424116, 0.287027, 0.869961, 0.967071, 0.483627,\n    0.850154, 0.901700, 0.897488, 0.136662, 0.294290, 0.014008, 0.558214,\n    0.982940, 0.881375, 0.382244, 0.336375, 0.219855, 0.234382, 0.268654,\n    0.034822, 0.416761, 0.896359, 0.360271, 0.349834, 0.517472, 0.797082,\n    0.100467, 0.709983, 0.227424, 0.659627, 0.420942, 0.757775, 0.442335,\n    0.877346, 0.780511, 0.255074, 0.873501, 0.892941, 0.916623, 0.693625,\n    0.527085, 0.610584, 0.216132, 0.391614, 0.192969, 0.872768, 0.111423,\n    0.358409, 0.599780, 0.532609, 0.408124, 0.707389, 0.391797, 0.153142,\n    0.950774, 0.899533, 0.584887, 0.864986, 0.532609, 0.597858, 0.656850,\n    0.413190, 0.455794, 0.414716, 0.928922, 0.925077, 0.648213, 0.332713,\n    0.394421, 0.429762, 0.743095, 0.080905, 0.651234, 0.661153, 0.027985,\n    0.247139, 0.093509, 0.175176, 0.669027, 0.408185, 0.019929, 0.312784,\n    0.116611, 0.058351, 0.813959, 0.039888, 0.099429, 0.618641, 0.852504,\n    0.195654, 0.112186, 0.306833, 0.299783, 0.180029, 0.804041, 0.150334,\n    0.441664, 0.612049, 0.173437, 0.922910, 0.717612, 0.990204, 0.976043,\n    0.286172, 0.106082, 0.885769, 0.251625, 0.918027, 0.019684, 0.700980,\n    0.376598, 0.907865, 0.366314, 0.522385, 0.547777, 0.201270, 0.932493,\n    0.101688, 0.104434, 0.374615, 0.745384, 0.494430, 0.594440, 0.520707,\n    0.569597, 0.388134, 0.990387, 0.527390, 0.194708, 0.651479, 0.962951,\n    0.529740, 0.670400, 0.134983, 0.616688, 0.817530, 0.144810, 0.255318,\n    0.595294, 0.978668, 0.463027, 0.393689, 0.961913, 0.560747, 0.181127,\n    0.640217, 0.761345, 0.030885, 0.152898, 0.915036, 0.670125, 0.316111,\n    0.344829, 0.997864, 0.640645, 0.704550, 0.035859, 0.496719, 0.945677,\n    0.389813, 0.058412],\n   [0.454856, 0.248515, 0.361389, 0.122148, 0.694139,\n    0.146798, 0.280774, 0.412776, 0.702364, 0.163216, 0.902092, 0.093065,\n    0.474958, 0.264249, 0.434468, 0.227983, 0.011746, 0.387684, 0.926212,\n    0.733468, 0.251994, 0.594014, 0.524123, 0.948130, 0.157794, 0.383516,\n    0.975607, 0.466704, 0.307640, 0.100712, 0.141646, 0.956370, 0.042512,\n    0.297531, 0.085487, 0.093468, 0.596480, 0.690076, 0.797975, 0.267221,\n    0.753295, 0.774192, 0.116699, 0.464241, 0.985235, 0.073823, 0.089206,\n    0.447433, 0.719236, 0.815190, 0.046099, 0.489775, 0.405497, 0.906062,\n    0.254434, 0.967531, 0.295697, 0.102913, 0.406725, 0.519415, 0.081144,\n    0.196076, 0.755829, 0.377023, 0.214420, 0.150418, 0.858558, 0.876656,\n    0.635810, 0.630952, 0.729097, 0.625271, 0.333465, 0.042126, 0.224886,\n    0.142931, 0.763860, 0.603410, 0.175108, 0.380019, 0.666179, 0.447647,\n    0.869742, 0.579908, 0.245852, 0.371972, 0.344010, 0.359698, 0.081658,\n    0.833780, 0.219437, 0.796887, 0.949882, 0.901161, 0.913896, 0.377543,\n    0.619674, 0.128213, 0.516002, 0.422384, 0.409693, 0.684524, 0.425780,\n    0.548613, 0.520597, 0.594379, 0.261667, 0.079061, 0.904477, 0.080815,\n    0.801571, 0.404271, 0.580455, 0.402241, 0.263298, 0.523119, 0.942118,\n    0.916117, 0.335429, 0.988195, 0.777338, 0.500755, 0.323573, 0.857648,\n    0.592954, 0.611505, 0.838570, 0.625515, 0.332418, 0.798301, 0.539981,\n    0.981028, 0.122947, 0.425385, 0.327212, 0.369861, 0.378286, 0.154940,\n    0.779355, 0.110862, 0.317416, 0.040495, 0.507705, 0.858675, 0.089329,\n    0.297920, 0.288036, 0.377962, 0.567168, 0.167161, 0.586962, 0.064270,\n    0.234567, 0.532191, 0.422919, 0.913402, 0.394611, 0.032129, 0.312803,\n    0.443883, 0.683181, 0.931617, 0.976537, 0.787270, 0.157918, 0.235750,\n    0.617241, 0.176583, 0.705436, 0.958141, 0.218316, 0.217251, 0.681318,\n    0.793152, 0.079533, 0.080840, 0.214927, 0.437709, 0.604961, 0.227055,\n    0.805453, 0.181182, 0.030641, 0.358724, 0.664910, 0.292232, 0.570454,\n    0.224660, 0.089332, 0.112569, 0.273717, 0.225018, 0.222019, 0.788015,\n    0.214029, 0.802656, 0.590121, 0.912856, 0.734046, 0.469630, 0.260610,\n    0.592389, 0.334603, 0.936535, 0.760104, 0.684230, 0.639625, 0.771056,\n    0.221245, 0.374172, 0.134190, 0.110979, 0.800637, 0.245717, 0.135946,\n    0.260575, 0.133939, 0.933764, 0.118476, 0.528121, 0.136099, 0.495127,\n    0.832425, 0.290466, 0.117380, 0.906839, 0.875183, 0.109638, 0.801086,\n    0.592449, 0.213508, 0.105856, 0.559403] ),\n\n  ([0.287667, 0.529618, 0.438673, 0.236427, 0.456221, 0.072512, 0.464156,\n    0.676840, 0.272042, 0.673482, 0.784814, 0.071169, 0.228248, 0.558977,\n    0.351512, 0.662923, 0.676229, 0.723411, 0.223273, 0.037019, 0.087497,\n    0.907071, 0.873074, 0.388348, 0.473739, 0.818476, 0.104709, 0.424421,\n    0.996277, 0.007080, 0.862880, 0.559435, 0.296335, 0.292642, 0.716330,\n    0.555620, 0.577166, 0.157262, 0.296731, 0.267830, 0.969390, 0.006928,\n    0.473403, 0.648152, 0.210730, 0.708121, 0.546007, 0.666372, 0.171728,\n    0.306284, 0.235694, 0.302835, 0.258034, 0.332102, 0.756676, 0.269784,\n    0.221168, 0.601794, 0.748833, 0.617328, 0.408521, 0.918088, 0.353099,\n    0.880612, 0.984344, 0.577532, 0.210608, 0.924131, 0.152379, 0.090884,\n    0.667013, 0.139714, 0.912015, 0.022645, 0.962706, 0.154088, 0.378460,\n    0.355846, 0.691366, 0.702475, 0.199225, 0.288553, 0.306650, 0.824641,\n    0.096835, 0.868343, 0.959380, 0.039155, 0.070467, 0.370739, 0.445662,\n    0.652913, 0.286416, 0.828272, 0.548173, 0.860988, 0.189764, 0.615894,\n    0.550707, 0.794305, 0.867641, 0.499588, 0.208014, 0.170660, 0.195868,\n    0.053896, 0.952147, 0.705496, 0.800104, 0.854976, 0.615955, 0.938505,\n    0.362468, 0.355022, 0.455947, 0.632893, 0.305307, 0.845149, 0.754814,\n    0.402814, 0.383221, 0.411695, 0.785363, 0.725791, 0.214209, 0.293527,\n    0.417158, 0.996002, 0.282022, 0.545701, 0.146947, 0.774834, 0.439955,\n    0.415845, 0.834132, 0.895138, 0.448195, 0.340190, 0.922422, 0.575060,\n    0.575457, 0.964476, 0.429365, 0.197882, 0.796442, 0.096713, 0.484603,\n    0.914396, 0.616108, 0.998077, 0.697958, 0.723258, 0.052217, 0.917264,\n    0.139195, 0.186743, 0.807428, 0.276101, 0.210242, 0.437208, 0.161779,\n    0.411145, 0.191046, 0.630543, 0.617695, 0.278390, 0.740867, 0.503739,\n    0.827418, 0.027253, 0.135472, 0.191687, 0.835658, 0.849696, 0.522507,\n    0.960417, 0.167425, 0.011017, 0.974883, 0.012116, 0.793146, 0.468978,\n    0.624958, 0.019257, 0.501572, 0.986328, 0.659841, 0.542924, 0.712699,\n    0.144322, 0.458937, 0.992523, 0.260903, 0.162633, 0.655873, 0.282632,\n    0.180303, 0.932218, 0.405011, 0.843440, 0.023194, 0.167119, 0.634602,\n    0.140690, 0.743034, 0.082095, 0.567461, 0.362041, 0.672964, 0.501450,\n    0.290262, 0.425428, 0.631581, 0.805994, 0.653279, 0.965941, 0.686575,\n    0.624012, 0.281045, 0.457595, 0.608081, 0.672903, 0.976012, 0.126011,\n    0.542528, 0.656941, 0.295572, 0.808527, 0.938688, 0.628498, 0.584643,\n    0.417402, 0.256569],\n   [0.218635, 0.357876, 0.173623, 0.173806, 0.673032,\n    0.189860, 0.351286, 0.442685, 0.692897, 0.138260, 0.929152, 0.187127,\n    0.499222, 0.119533, 0.454319, 0.261703, 0.018971, 0.302934, 0.747664,\n    0.921815, 0.284514, 0.658830, 0.284149, 0.956592, 0.066063, 0.446204,\n    0.972693, 0.393397, 0.309208, 0.095630, 0.181192, 0.938930, 0.067703,\n    0.237331, 0.113878, 0.093320, 0.503422, 0.681623, 0.733120, 0.312091,\n    0.650519, 0.652697, 0.137933, 0.532398, 0.983085, 0.084617, 0.065343,\n    0.549961, 0.745401, 0.892501, 0.074734, 0.519583, 0.376233, 0.753947,\n    0.242325, 0.964071, 0.286072, 0.208462, 0.337912, 0.594345, 0.092390,\n    0.212956, 0.694319, 0.460707, 0.237936, 0.361339, 0.858933, 0.819767,\n    0.467638, 0.727528, 0.746701, 0.532651, 0.330979, 0.050657, 0.332196,\n    0.035503, 0.658197, 0.457472, 0.193841, 0.467948, 0.537894, 0.345733,\n    0.718487, 0.513743, 0.333842, 0.380397, 0.321536, 0.427051, 0.148436,\n    0.799359, 0.348584, 0.849755, 0.868229, 0.841677, 0.909258, 0.539411,\n    0.690853, 0.152109, 0.660805, 0.456971, 0.539072, 0.776359, 0.274709,\n    0.519946, 0.582156, 0.705097, 0.382707, 0.054506, 0.834956, 0.064999,\n    0.809754, 0.418180, 0.407116, 0.378793, 0.226499, 0.431485, 0.869723,\n    0.873152, 0.149430, 0.982588, 0.630468, 0.370831, 0.299135, 0.909328,\n    0.323344, 0.720702, 0.875886, 0.584744, 0.507132, 0.548361, 0.426220,\n    0.959330, 0.112001, 0.223089, 0.350064, 0.521868, 0.493527, 0.204729,\n    0.762551, 0.219292, 0.210416, 0.070511, 0.560222, 0.754688, 0.060908,\n    0.647756, 0.250738, 0.593946, 0.819360, 0.207920, 0.412829, 0.103411,\n    0.364463, 0.585421, 0.424595, 0.913237, 0.494716, 0.067945, 0.427710,\n    0.381549, 0.765270, 0.912343, 0.971849, 0.806889, 0.129748, 0.287356,\n    0.736490, 0.295920, 0.689556, 0.923895, 0.205147, 0.320950, 0.615522,\n    0.694049, 0.058830, 0.072159, 0.210321, 0.362232, 0.547235, 0.186022,\n    0.851536, 0.164144, 0.022905, 0.236097, 0.560682, 0.291979, 0.590515,\n    0.365463, 0.178689, 0.189426, 0.202501, 0.315727, 0.251595, 0.922035,\n    0.244061, 0.671076, 0.500123, 0.894621, 0.834322, 0.546120, 0.309387,\n    0.600686, 0.311961, 0.941726, 0.612745, 0.578015, 0.654615, 0.818524,\n    0.202517, 0.443512, 0.141913, 0.090282, 0.711760, 0.207059, 0.192837,\n    0.374708, 0.308595, 0.899807, 0.086978, 0.753923, 0.143085, 0.494978,\n    0.853515, 0.231696, 0.082054, 0.950877, 0.857621, 0.094328, 0.831074,\n    0.575920, 0.180761, 0.182903, 0.451331] ),\n\n  ([0.718009, 0.244209, 0.163427, 0.491195, 0.639515, 0.517624, 0.195013,\n    0.041749, 0.877834, 0.575610, 0.809778, 0.957854, 0.963408, 0.181585,\n    0.894559, 0.093814, 0.741722, 0.717978, 0.750359, 0.202765, 0.042695,\n    0.855434, 0.958098, 0.501022, 0.656911, 0.645558, 0.441786, 0.734794,\n    0.024689, 0.319102, 0.385052, 0.279641, 0.544420, 0.570025, 0.157659,\n    0.305033, 0.906003, 0.607593, 0.907834, 0.533891, 0.356182, 0.756920,\n    0.976928, 0.629597, 0.301828, 0.889828, 0.792657, 0.741111, 0.157048,\n    0.466933, 0.397015, 0.237220, 0.840907, 0.472427, 0.265328, 0.162053,\n    0.831782, 0.022462, 0.572344, 0.441908, 0.184606, 0.928922, 0.562059,\n    0.375927, 0.417127, 0.999023, 0.177313, 0.440596, 0.671804, 0.353252,\n    0.605213, 0.940550, 0.058901, 0.541429, 0.894925, 0.535783, 0.588183,\n    0.739128, 0.304025, 0.177526, 0.593890, 0.805506, 0.529710, 0.483230,\n    0.060884, 0.483535, 0.480575, 0.082461, 0.756981, 0.524247, 0.746330,\n    0.964660, 0.578143, 0.015839, 0.420362, 0.360057, 0.013123, 0.699393,\n    0.432600, 0.185247, 0.133427, 0.551744, 0.048128, 0.584246, 0.014496,\n    0.417707, 0.688009, 0.596515, 0.995483, 0.971984, 0.728782, 0.483383,\n    0.682394, 0.792535, 0.436720, 0.743736, 0.102390, 0.826472, 0.692984,\n    0.350414, 0.914212, 0.029969, 0.666128, 0.238746, 0.081515, 0.463027,\n    0.088076, 0.578051, 0.915708, 0.620594, 0.289987, 0.857662, 0.893735,\n    0.281381, 0.653859, 0.318766, 0.157811, 0.655507, 0.636708, 0.763237,\n    0.103030, 0.112033, 0.023133, 0.270272, 0.958892, 0.268075, 0.562639,\n    0.852962, 0.771264, 0.720237, 0.647908, 0.585314, 0.691366, 0.200079,\n    0.190405, 0.231269, 0.977233, 0.434706, 0.349742, 0.907041, 0.614277,\n    0.493332, 0.272164, 0.807581, 0.961699, 0.901822, 0.495834, 0.529160,\n    0.329905, 0.305857, 0.177801, 0.018616, 0.896573, 0.964263, 0.799707,\n    0.680990, 0.866024, 0.853542, 0.508316, 0.676382, 0.279611, 0.665059,\n    0.746910, 0.937742, 0.382702, 0.476272, 0.334086, 0.940519, 0.954009,\n    0.376476, 0.645924, 0.755516, 0.504685, 0.829615, 0.058077, 0.416181,\n    0.752617, 0.053926, 0.303842, 0.131596, 0.278085, 0.201056, 0.904294,\n    0.376568, 0.767815, 0.614795, 0.327250, 0.389630, 0.752647, 0.951445,\n    0.030793, 0.110721, 0.245949, 0.442457, 0.047884, 0.089572, 0.188604,\n    0.081332, 0.268227, 0.395978, 0.106754, 0.015137, 0.073580, 0.063143,\n    0.888882, 0.922636, 0.482986, 0.095767, 0.087985, 0.659810, 0.463851,\n    0.573687, 0.655934],\n   [0.426641, 0.368498, 0.324384, 0.244630, 0.810313,\n    0.154400, 0.349735, 0.383929, 0.592216, 0.152524, 0.905401, 0.140957,\n    0.476962, 0.196000, 0.330754, 0.277185, 0.018883, 0.277773, 0.862392,\n    0.903272, 0.303903, 0.594118, 0.361856, 0.941660, 0.079700, 0.480783,\n    0.969456, 0.472912, 0.230198, 0.098414, 0.160896, 0.968786, 0.046620,\n    0.262502, 0.139625, 0.175795, 0.361952, 0.682237, 0.823679, 0.267849,\n    0.790622, 0.778540, 0.116554, 0.395309, 0.970600, 0.098625, 0.083999,\n    0.714550, 0.748284, 0.835519, 0.077502, 0.521743, 0.326032, 0.755997,\n    0.251540, 0.976562, 0.302812, 0.305042, 0.410685, 0.551413, 0.117068,\n    0.132348, 0.621621, 0.626591, 0.383646, 0.184807, 0.834431, 0.780612,\n    0.507623, 0.612959, 0.794717, 0.533914, 0.477495, 0.029843, 0.227917,\n    0.108277, 0.660436, 0.700065, 0.209277, 0.487593, 0.541569, 0.553619,\n    0.731494, 0.580211, 0.275850, 0.372828, 0.243097, 0.420385, 0.098984,\n    0.857177, 0.250690, 0.833313, 0.913703, 0.867545, 0.951534, 0.361687,\n    0.527698, 0.243859, 0.717807, 0.467260, 0.580161, 0.714308, 0.267384,\n    0.456982, 0.374384, 0.692335, 0.299550, 0.083761, 0.919893, 0.096244,\n    0.848201, 0.232173, 0.484829, 0.245712, 0.249837, 0.437164, 0.970420,\n    0.887475, 0.244833, 0.991818, 0.763004, 0.286520, 0.264178, 0.806474,\n    0.660562, 0.674266, 0.860876, 0.734945, 0.467590, 0.805231, 0.447643,\n    0.964540, 0.110531, 0.299224, 0.495899, 0.439600, 0.515685, 0.221798,\n    0.708328, 0.123330, 0.259151, 0.045842, 0.530350, 0.760107, 0.140522,\n    0.285037, 0.378773, 0.458631, 0.583821, 0.141129, 0.426094, 0.055360,\n    0.322095, 0.582423, 0.468241, 0.884921, 0.413174, 0.046554, 0.445516,\n    0.540792, 0.812143, 0.869259, 0.956194, 0.762436, 0.207954, 0.269481,\n    0.813644, 0.223316, 0.794380, 0.903227, 0.153186, 0.216683, 0.710133,\n    0.745967, 0.076032, 0.082960, 0.138856, 0.522247, 0.371434, 0.332129,\n    0.891117, 0.218265, 0.071134, 0.248548, 0.680875, 0.198809, 0.592904,\n    0.277751, 0.089860, 0.167141, 0.243550, 0.326903, 0.306565, 0.898553,\n    0.198083, 0.618236, 0.607264, 0.941108, 0.790631, 0.602020, 0.208493,\n    0.649504, 0.429139, 0.913258, 0.681561, 0.603627, 0.630023, 0.737105,\n    0.243026, 0.483829, 0.173393, 0.060755, 0.683204, 0.284398, 0.103508,\n    0.451004, 0.147505, 0.885852, 0.105137, 0.803031, 0.112451, 0.412019,\n    0.725960, 0.227560, 0.200442, 0.915390, 0.853311, 0.078259, 0.842300,\n    0.799232, 0.236802, 0.236590, 0.327087] ),\n\n  ([0.954619, 0.565477, 0.882290, 0.514939, 0.431104, 0.530839, 0.601520,\n    0.873959, 0.745659, 0.043428, 0.083987, 0.694906, 0.115177, 0.264992,\n    0.254036, 0.215796, 0.019532, 0.320292, 0.658498, 0.936796, 0.358745,\n    0.385907, 0.300882, 0.975127, 0.846828, 0.538285, 0.290017, 0.195654,\n    0.922880, 0.018097, 0.834101, 0.023194, 0.961272, 0.066805, 0.612140,\n    0.342235, 0.061831, 0.991760, 0.053194, 0.391247, 0.201239, 0.615833,\n    0.555406, 0.057314, 0.027192, 0.768517, 0.175451, 0.477218, 0.076205,\n    0.973907, 0.820093, 0.351512, 0.696615, 0.992309, 0.470962, 0.877926,\n    0.457930, 0.371685, 0.473708, 0.709677, 0.327677, 0.665059, 0.422895,\n    0.846034, 0.397076, 0.470138, 0.673788, 0.860347, 0.436934, 0.947569,\n    0.012513, 0.372204, 0.064577, 0.973785, 0.515427, 0.170415, 0.803797,\n    0.585101, 0.129429, 0.892026, 0.818018, 0.868954, 0.004059, 0.664693,\n    0.599261, 0.958464, 0.106784, 0.618000, 0.392895, 0.287179, 0.152989,\n    0.670248, 0.640126, 0.759484, 0.381329, 0.496689, 0.219337, 0.993439,\n    0.206183, 0.086032, 0.767602, 0.292032, 0.278512, 0.790704, 0.863277,\n    0.499344, 0.985839, 0.277596, 0.351390, 0.397595, 0.922941, 0.285684,\n    0.592853, 0.801569, 0.364940, 0.596271, 0.918546, 0.006256, 0.273080,\n    0.122410, 0.069948, 0.744957, 0.865230, 0.523911, 0.907346, 0.312357,\n    0.281869, 0.253761, 0.166540, 0.010956, 0.379498, 0.442518, 0.546251,\n    0.575243, 0.181585, 0.526841, 0.906095, 0.730888, 0.019501, 0.028474,\n    0.857814, 0.545152, 0.894040, 0.389874, 0.529893, 0.724143, 0.088504,\n    0.272439, 0.787500, 0.513932, 0.565783, 0.224372, 0.688589, 0.361431,\n    0.178961, 0.123508, 0.457686, 0.990905, 0.228339, 0.302072, 0.758507,\n    0.053224, 0.395123, 0.759056, 0.546556, 0.003449, 0.583239, 0.367016,\n    0.283151, 0.362987, 0.700766, 0.479049, 0.791986, 0.023072, 0.912137,\n    0.842555, 0.539506, 0.745323, 0.391858, 0.225715, 0.620411, 0.515885,\n    0.112064, 0.663411, 0.229438, 0.909360, 0.694113, 0.728050, 0.900784,\n    0.118595, 0.855739, 0.732658, 0.296213, 0.807093, 0.485733, 0.271249,\n    0.823481, 0.439283, 0.876308, 0.003815, 0.865810, 0.246467, 0.145054,\n    0.091372, 0.904202, 0.483016, 0.377850, 0.187872, 0.313334, 0.130009,\n    0.523209, 0.394818, 0.112827, 0.702780, 0.570452, 0.085238, 0.454512,\n    0.317667, 0.041719, 0.002808, 0.127476, 0.675253, 0.330271, 0.542833,\n    0.861965, 0.115421, 0.915250, 0.620991, 0.713157, 0.401471, 0.984863,\n    0.036164, 0.306619],\n   [0.359776, 0.367097, 0.360432, 0.206506, 0.754471,\n    0.285965, 0.166168, 0.326315, 0.800244, 0.206862, 0.902224, 0.139618,\n    0.610692, 0.143672, 0.351668, 0.325182, 0.025730, 0.455092, 0.929569,\n    0.796769, 0.251855, 0.747627, 0.331670, 0.964723, 0.081021, 0.389377,\n    0.981844, 0.573396, 0.213534, 0.174239, 0.116232, 0.955129, 0.098010,\n    0.382178, 0.106874, 0.088279, 0.545543, 0.621791, 0.575619, 0.146018,\n    0.761163, 0.653365, 0.150332, 0.606838, 0.980184, 0.110615, 0.146229,\n    0.514361, 0.704054, 0.766151, 0.064525, 0.409417, 0.439298, 0.897061,\n    0.299828, 0.971770, 0.367509, 0.291184, 0.281051, 0.502794, 0.096782,\n    0.083478, 0.840663, 0.583090, 0.395116, 0.281379, 0.877926, 0.828898,\n    0.625191, 0.619742, 0.853877, 0.536377, 0.372904, 0.073845, 0.199405,\n    0.100709, 0.606060, 0.473555, 0.180722, 0.531621, 0.601256, 0.244270,\n    0.741130, 0.594147, 0.163998, 0.204984, 0.241442, 0.590100, 0.134714,\n    0.816974, 0.270377, 0.806844, 0.880223, 0.902738, 0.878790, 0.222071,\n    0.650206, 0.154455, 0.539164, 0.455021, 0.436253, 0.719163, 0.462310,\n    0.466113, 0.538283, 0.504002, 0.245044, 0.046836, 0.881469, 0.148622,\n    0.804958, 0.406845, 0.435662, 0.364701, 0.291077, 0.404339, 0.948996,\n    0.888650, 0.217218, 0.988262, 0.810153, 0.354070, 0.251472, 0.892376,\n    0.390826, 0.855087, 0.934166, 0.635453, 0.402146, 0.843193, 0.463845,\n    0.975613, 0.078484, 0.275776, 0.417762, 0.424582, 0.351462, 0.152584,\n    0.709934, 0.176501, 0.342223, 0.045484, 0.523229, 0.867291, 0.180673,\n    0.433035, 0.494813, 0.457182, 0.578500, 0.122501, 0.627640, 0.059493,\n    0.203059, 0.417564, 0.405842, 0.883510, 0.382213, 0.080276, 0.288037,\n    0.366680, 0.771502, 0.868585, 0.984384, 0.748690, 0.225509, 0.208029,\n    0.508301, 0.300714, 0.593630, 0.933136, 0.149565, 0.327301, 0.570310,\n    0.512326, 0.044906, 0.068581, 0.171144, 0.334918, 0.595896, 0.244451,\n    0.868130, 0.306131, 0.023271, 0.230718, 0.581006, 0.262223, 0.475655,\n    0.306093, 0.119837, 0.192525, 0.192306, 0.363700, 0.344519, 0.844001,\n    0.236159, 0.757393, 0.441866, 0.873148, 0.723895, 0.628312, 0.289490,\n    0.471274, 0.276109, 0.933656, 0.774933, 0.515753, 0.508829, 0.878633,\n    0.161455, 0.487705, 0.194438, 0.073326, 0.719559, 0.146848, 0.064468,\n    0.295699, 0.159501, 0.841205, 0.130773, 0.727858, 0.213309, 0.529196,\n    0.900356, 0.375119, 0.133807, 0.913048, 0.900510, 0.175900, 0.858299,\n    0.624336, 0.144456, 0.290592, 0.449766] ),\n\n  ([0.388440, 0.499100, 0.733940, 0.225929, 0.232795, 0.223090, 0.876339,\n    0.324351, 0.299356, 0.762169, 0.124699, 0.241615, 0.421522, 0.130528,\n    0.041871, 0.907041, 0.671590, 0.884213, 0.019318, 0.309915, 0.296731,\n    0.349498, 0.636219, 0.319224, 0.977630, 0.978820, 0.856349, 0.833064,\n    0.065096, 0.364208, 0.969207, 0.039460, 0.952208, 0.940916, 0.681356,\n    0.069918, 0.236579, 0.911008, 0.264534, 0.826624, 0.830744, 0.419446,\n    0.166601, 0.264809, 0.675344, 0.513321, 0.991638, 0.911466, 0.212561,\n    0.915128, 0.255379, 0.901486, 0.275369, 0.142155, 0.822535, 0.312845,\n    0.549120, 0.002838, 0.431623, 0.081851, 0.261422, 0.000977, 0.214240,\n    0.279397, 0.257302, 0.679678, 0.614551, 0.030152, 0.114689, 0.435926,\n    0.615497, 0.855617, 0.457808, 0.837184, 0.677969, 0.721702, 0.123600,\n    0.971038, 0.298898, 0.573473, 0.338267, 0.859340, 0.594989, 0.636738,\n    0.559618, 0.468276, 0.817927, 0.268838, 0.141697, 0.345042, 0.207495,\n    0.639485, 0.478042, 0.412946, 0.088961, 0.022736, 0.779626, 0.955870,\n    0.620685, 0.981933, 0.143742, 0.323527, 0.098392, 0.227912, 0.070437,\n    0.388592, 0.222510, 0.432844, 0.082003, 0.287027, 0.234504, 0.780084,\n    0.602710, 0.472945, 0.328471, 0.531602, 0.754234, 0.619098, 0.244667,\n    0.394452, 0.223426, 0.394330, 0.450758, 0.967101, 0.858760, 0.649190,\n    0.817225, 0.047121, 0.151219, 0.041231, 0.193121, 0.081668, 0.256630,\n    0.630696, 0.788629, 0.541459, 0.714805, 0.478256, 0.770287, 0.500076,\n    0.522507, 0.776086, 0.975463, 0.199438, 0.716086, 0.543352, 0.152318,\n    0.883206, 0.120151, 0.417158, 0.631336, 0.678243, 0.418531, 0.570818,\n    0.834529, 0.807184, 0.203528, 0.290048, 0.529160, 0.911405, 0.160436,\n    0.238777, 0.231574, 0.767174, 0.042421, 0.945555, 0.667928, 0.175390,\n    0.593280, 0.541917, 0.697378, 0.306375, 0.073183, 0.284127, 0.604968,\n    0.281075, 0.544816, 0.889096, 0.169347, 0.269845, 0.574664, 0.216163,\n    0.412732, 0.889950, 0.507523, 0.325938, 0.438124, 0.183325, 0.968780,\n    0.447096, 0.261116, 0.955596, 0.751854, 0.882717, 0.041932, 0.757408,\n    0.746513, 0.387494, 0.624226, 0.290139, 0.064486, 0.046663, 0.786370,\n    0.516160, 0.018586, 0.188360, 0.112522, 0.255684, 0.111606, 0.360057,\n    0.888607, 0.551195, 0.691214, 0.901181, 0.929960, 0.580615, 0.427168,\n    0.142399, 0.747154, 0.400586, 0.266976, 0.763115, 0.955779, 0.301065,\n    0.026276, 0.338481, 0.336375, 0.052614, 0.270486, 0.607135, 0.451674,\n    0.827326, 0.643361],\n   [0.341520, 0.354248, 0.277172, 0.160909, 0.797057,\n    0.240798, 0.202232, 0.531780, 0.648235, 0.247807, 0.899272, 0.204557,\n    0.643516, 0.176589, 0.498432, 0.206448, 0.025146, 0.357909, 0.889836,\n    0.870475, 0.239393, 0.718789, 0.405395, 0.966255, 0.060351, 0.494726,\n    0.973623, 0.450753, 0.274252, 0.156538, 0.144262, 0.967449, 0.117045,\n    0.347548, 0.190970, 0.086992, 0.503627, 0.736885, 0.627200, 0.147963,\n    0.625970, 0.729231, 0.144069, 0.508258, 0.979544, 0.100684, 0.155637,\n    0.614090, 0.726387, 0.819368, 0.064838, 0.369947, 0.284572, 0.910960,\n    0.231451, 0.965955, 0.243170, 0.194659, 0.336649, 0.518927, 0.181495,\n    0.160324, 0.764995, 0.434198, 0.334108, 0.141132, 0.895691, 0.739906,\n    0.519881, 0.575619, 0.774124, 0.553721, 0.448064, 0.045919, 0.193842,\n    0.091922, 0.777352, 0.523866, 0.113049, 0.299497, 0.627231, 0.439321,\n    0.832294, 0.576561, 0.340493, 0.339656, 0.307748, 0.471689, 0.148783,\n    0.872684, 0.317473, 0.791259, 0.918053, 0.786497, 0.862708, 0.431441,\n    0.684761, 0.260587, 0.733843, 0.426337, 0.532126, 0.655947, 0.510283,\n    0.364938, 0.552296, 0.762060, 0.360770, 0.052184, 0.840864, 0.127741,\n    0.689611, 0.300560, 0.320230, 0.241689, 0.372612, 0.472813, 0.967107,\n    0.929884, 0.252993, 0.992958, 0.742849, 0.411894, 0.345896, 0.770270,\n    0.572115, 0.658990, 0.814392, 0.655808, 0.420486, 0.707766, 0.345577,\n    0.975158, 0.085844, 0.406723, 0.249006, 0.238066, 0.539499, 0.145692,\n    0.790438, 0.168272, 0.230688, 0.057680, 0.571479, 0.740323, 0.066511,\n    0.489331, 0.318142, 0.492005, 0.589285, 0.132762, 0.636211, 0.046943,\n    0.332692, 0.462977, 0.288413, 0.866029, 0.322398, 0.070890, 0.418203,\n    0.476348, 0.784088, 0.918616, 0.971825, 0.687118, 0.119708, 0.226636,\n    0.739284, 0.164853, 0.567597, 0.948301, 0.253904, 0.454577, 0.630131,\n    0.797070, 0.069375, 0.062262, 0.181825, 0.514047, 0.579143, 0.347091,\n    0.790777, 0.249278, 0.041634, 0.302402, 0.692700, 0.223413, 0.806465,\n    0.255903, 0.078892, 0.196589, 0.233383, 0.438091, 0.133392, 0.873997,\n    0.187271, 0.777030, 0.369699, 0.892954, 0.791136, 0.568050, 0.271141,\n    0.550761, 0.438786, 0.966893, 0.695801, 0.625005, 0.646452, 0.847563,\n    0.206998, 0.480985, 0.149400, 0.125530, 0.576586, 0.184683, 0.119176,\n    0.215631, 0.154857, 0.888609, 0.251622, 0.675261, 0.155464, 0.353164,\n    0.907869, 0.196696, 0.109431, 0.930597, 0.817032, 0.075295, 0.760376,\n    0.463851, 0.244921, 0.108898, 0.363699] ),\n\n  ([0.490799, 0.225929, 0.074892, 0.299295, 0.397198, 0.393933, 0.135197,\n    0.595447, 0.837336, 0.225318, 0.868160, 0.699576, 0.888455, 0.430280,\n    0.082522, 0.270516, 0.534074, 0.653493, 0.045015, 0.866939, 0.412214,\n    0.461928, 0.850429, 0.240822, 0.002838, 0.233283, 0.934324, 0.172216,\n    0.786401, 0.850764, 0.509842, 0.001007, 0.403821, 0.611042, 0.209449,\n    0.512284, 0.350383, 0.251167, 0.712882, 0.331492, 0.233283, 0.501053,\n    0.642750, 0.485702, 0.125431, 0.067263, 0.509201, 0.286843, 0.046144,\n    0.455184, 0.984191, 0.193701, 0.099704, 0.534806, 0.287484, 0.808802,\n    0.303781, 0.257302, 0.965209, 0.665822, 0.638356, 0.428144, 0.841853,\n    0.964843, 0.346568, 0.942930, 0.427839, 0.910703, 0.018830, 0.392499,\n    0.563128, 0.811274, 0.491501, 0.443617, 0.578448, 0.591876, 0.090976,\n    0.900815, 0.755394, 0.881619, 0.255013, 0.856624, 0.366649, 0.328623,\n    0.062166, 0.835719, 0.077364, 0.299783, 0.700522, 0.339396, 0.989319,\n    0.621662, 0.407453, 0.696799, 0.108737, 0.518509, 0.911039, 0.629048,\n    0.519395, 0.403943, 0.904782, 0.432417, 0.041688, 0.682455, 0.586871,\n    0.186987, 0.659810, 0.216529, 0.795068, 0.896878, 0.497147, 0.616626,\n    0.768395, 0.968383, 0.622394, 0.009156, 0.067385, 0.932310, 0.466384,\n    0.439619, 0.683523, 0.816675, 0.131870, 0.566332, 0.869289, 0.075869,\n    0.377178, 0.801874, 0.720511, 0.483139, 0.554643, 0.557756, 0.041597,\n    0.891690, 0.285531, 0.748955, 0.525468, 0.271493, 0.152684, 0.214423,\n    0.778893, 0.927824, 0.191748, 0.209876, 0.225135, 0.307291, 0.462600,\n    0.629200, 0.414502, 0.298441, 0.482101, 0.110355, 0.774560, 0.432508,\n    0.799402, 0.682699, 0.330760, 0.890835, 0.495071, 0.111087, 0.429548,\n    0.725181, 0.885434, 0.594012, 0.994079, 0.197241, 0.212867, 0.971038,\n    0.344646, 0.643666, 0.604266, 0.096530, 0.115024, 0.772210, 0.077700,\n    0.535691, 0.295450, 0.796472, 0.879727, 0.238716, 0.933805, 0.314280,\n    0.933409, 0.350383, 0.526536, 0.336650, 0.679617, 0.809870, 0.630024,\n    0.373333, 0.091556, 0.898587, 0.723991, 0.981353, 0.144749, 0.390881,\n    0.858089, 0.682424, 0.523148, 0.465102, 0.112980, 0.656240, 0.842891,\n    0.030122, 0.407239, 0.114841, 0.174810, 0.624500, 0.680746, 0.765282,\n    0.147374, 0.544084, 0.986877, 0.266182, 0.410352, 0.354198, 0.523759,\n    0.084964, 0.741539, 0.443220, 0.136418, 0.661367, 0.577044, 0.772942,\n    0.320780, 0.284127, 0.246986, 0.482833, 0.260842, 0.586688, 0.697104,\n    0.503922, 0.930418],\n   [0.424107, 0.396879, 0.414405, 0.114626, 0.785829,\n    0.223161, 0.220193, 0.579817, 0.719536, 0.172066, 0.875931, 0.125967,\n    0.394629, 0.199909, 0.343574, 0.187285, 0.027203, 0.308855, 0.855927,\n    0.876132, 0.397154, 0.704915, 0.341795, 0.949075, 0.098719, 0.354898,\n    0.976726, 0.321007, 0.223962, 0.124901, 0.175442, 0.971870, 0.143232,\n    0.219022, 0.142665, 0.053376, 0.474999, 0.543850, 0.804155, 0.310526,\n    0.791216, 0.762469, 0.169269, 0.528699, 0.985355, 0.087431, 0.175909,\n    0.577205, 0.625587, 0.768158, 0.096223, 0.503537, 0.413709, 0.885578,\n    0.191869, 0.926045, 0.329703, 0.186974, 0.282816, 0.604256, 0.109594,\n    0.178356, 0.753140, 0.517298, 0.515606, 0.216674, 0.820059, 0.804815,\n    0.611976, 0.631029, 0.803835, 0.591237, 0.322586, 0.052500, 0.328980,\n    0.123051, 0.620348, 0.532733, 0.144982, 0.391361, 0.613410, 0.383974,\n    0.734064, 0.532324, 0.344537, 0.422938, 0.254770, 0.530569, 0.153824,\n    0.835986, 0.547887, 0.832646, 0.901160, 0.830598, 0.935647, 0.287002,\n    0.598803, 0.108118, 0.799591, 0.405487, 0.543971, 0.689053, 0.329327,\n    0.383579, 0.390946, 0.614205, 0.349351, 0.048845, 0.904713, 0.143100,\n    0.771536, 0.357421, 0.459892, 0.389907, 0.224094, 0.376756, 0.948369,\n    0.888373, 0.273341, 0.992956, 0.780531, 0.400960, 0.424054, 0.878922,\n    0.436259, 0.647822, 0.800395, 0.634784, 0.492485, 0.799851, 0.479985,\n    0.964370, 0.058900, 0.276129, 0.348107, 0.391172, 0.603799, 0.216043,\n    0.688422, 0.219302, 0.464335, 0.091783, 0.600059, 0.873305, 0.044057,\n    0.450227, 0.399348, 0.499331, 0.611188, 0.133346, 0.474435, 0.073997,\n    0.290723, 0.628574, 0.407430, 0.898788, 0.407404, 0.074780, 0.427978,\n    0.480693, 0.685756, 0.861848, 0.948614, 0.789383, 0.103810, 0.242024,\n    0.591603, 0.202827, 0.707913, 0.928032, 0.219192, 0.375436, 0.620618,\n    0.740555, 0.085314, 0.073262, 0.123595, 0.291393, 0.559089, 0.284462,\n    0.905447, 0.173849, 0.075588, 0.443385, 0.643536, 0.251822, 0.598107,\n    0.282495, 0.110525, 0.149146, 0.151177, 0.353747, 0.285400, 0.869472,\n    0.224384, 0.648134, 0.328993, 0.908896, 0.810594, 0.513033, 0.234783,\n    0.575107, 0.211473, 0.963435, 0.609522, 0.609734, 0.516709, 0.787513,\n    0.218430, 0.318520, 0.172837, 0.092019, 0.536853, 0.163634, 0.178079,\n    0.368606, 0.184779, 0.929009, 0.159243, 0.748073, 0.172109, 0.597596,\n    0.901627, 0.175661, 0.128399, 0.923317, 0.852674, 0.072980, 0.825466,\n    0.662855, 0.122188, 0.163042, 0.256912] )]\n", "num_lines": 1534}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The classic 8-queens problem made famous by Wirth.\n-- This version Colin Runciman, March 2000.\n\nmain =\n    if null solutions then putStrLn \"no solution!\"\n    else putStr (board (head solutions))\n    where\n    solutions = queens 8\n\nqueens :: Int -> [[Int]]\nqueens n = valid n n\n\nvalid :: Int -> Int -> [[Int]]\nvalid 0 n = [[]]\nvalid m n = filter safe (extend n (valid (m-1) n))\n\nextend n b = cp (fromTo 1 n) b\n\ncp :: [a] -> [[a]] -> [[a]]\ncp [] y = []\ncp (a:x) y = map (a:) y ++ cp x y\n\nsafe (a:b) = no_threat a b 1\n\nno_threat a [] m = True\nno_threat a (b:y) m =\n    a /= b && a+m /= b && a-m /= b && no_threat a y (m+1)\n\nboard :: [Int] -> String\nboard b =\n    unlines (concat (zipWith rank (from 1) b))\n  where\n    rank r qcol =\n        map line [\"o o o\", \" \\\\|/ \", \" === \"]\n      where\n        line crown_slice =\n            concat (zipWith square (from 1) b)\n          where\n            square scol _ =\n                if scol == qcol then crown_slice\n                else if (scol `rem` (2::Int)) == (r `rem` (2::Int)) then \".....\"\n                else \"     \"\n\n-- in place of ..\n\nfrom :: Int -> [Int]\nfrom n = n : from (n+1)\n\nfromTo :: Int -> Int -> [Int]\nfromTo m n = if m > n then [] else m : fromTo (m+1) n\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-      The purpose of this is to test that record update is\n        sufficiently polymorphic.  See comments with\n        tcExpr (RecordUpd) in TcExpr.lhs\n-}\n\nmodule Main where\n\ndata T a b c d  = MkT1 { op1 :: a, op2 :: b }\n               | MkT2 { op1 :: a, op3 :: c }\n               | MkT3 { op4 :: a, op5 :: d }\n\nupdate1 :: a2 -> T a b c d -> T a2 b c d2\nupdate1 x t = t { op1 = x }\n        -- NB: the MkT3.op4 case doesn't constrain the result because\n        -- it doesn't have an op1 field\n\nupdate2 :: a2 -> T a b c d -> T a2 b2 c2 d\nupdate2 x t = t { op4 = x }\n\nmain = print (op4 $\n              update2 True $\n              MkT3 { op4 = op2 $\n                           update1 (1::Int) $\n                           MkT1 { op1 = True }\n              })\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "infixr  ->!,=\\\n\n-- auxiliary functions -----------------------------------------------------\n\ng u v w (x:y:z) = i(v x y)(u x y (w z) z)(x:w(y:z))\ng u v w [x]     = [x,512]\nq u v w nil     = u : 95 : z v : w\n\nlong = several.length\n((->!),(=\\))=(map,($))\na           = g q f\ny           = (-)32\nz           = (+)32\nseveral     = (>)2\nfairlySmall = (<)64\nnotTooSmall = (>)91\njustRight   = (==)95\nnotTooBig   = (<)96\nveryBig     = (>)123\ngoodSize x  =foldr(&&)\n  otherwise =\\($x)->![notTooBig,veryBig]\nf y z       =fairlySmall(z)&&goodSize(y)&&notTooSmall(z)\ni cond th el=if(cond)then(th)else(el)\ntoBeIsToDoAndToDoIsToBeSaidConFuTse\n\n-- main functions ----------------------------------------------------------\n\n  g  =  interact$map\n            toEnum.g.map\n            fromEnum\nmain =\n toBeIsToDoAndToDoIsToBeSaidConFuTse(let h=a;t=x where x x=i(long x)x(h t x)\n                                                       q v w x z = - y w:x\n                                                       a = g q f\n                                                       f x y = justRight x\n                                                             && goodSize y\n                                     in t)\n\n-- rittri@cs.chalmers.se ---------------------------------------------------\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom: Paul Sanders <psanders@srd.bt.co.uk>\nTo: partain\nSubject: A puzzle for you\nDate: Mon, 28 Oct 91 17:02:19 GMT\n\nI'm struggling with the following code fragment at the moment:\n-}\n\nimport Data.Array -- 1.3\nimport Data.Ix    -- 1.3\n\nconv_list :: (Ix a, Ix b) => [a] -> [b] -> [[c]] -> Array (a,b) c -> Array (a,b) c\nconv_list [] _ _ ar = ar\nconv_list _ _ [] ar = ar\nconv_list (r:rs) cls (rt:rts) ar\n      = conv_list rs cls rts ar'\n        where ar' = conv_elems r cls rt ar\n\nconv_elems :: (Ix a, Ix b) => a -> [b] -> [c] -> Array (a,b) c -> Array (a,b) c\nconv_elems row [] _ ar = ar\nconv_elems _ _ [] ar = ar\nconv_elems row (col:cls) (rt:rts) ar\n      = conv_elems row cls rts ar'\n        where ar' = ar // [((row,col), rt)]\n\nar :: Array (Int, Int) Int\nar = conv_list [(1::Int)..(3::Int)] [(1::Int)..(3::Int)] ar_list init_ar\n     where init_ar = array (((1::Int),(1::Int)),((3::Int),(3::Int))) []\n\n\nar_list :: [[Int]] -- WDP\nar_list = [[1,2,3],\n           [6,7,8],\n           [10,12,15]]\n\nmain = putStrLn (show ar)\n\n{-\nWhat it tries to do is turn a list of lists into a 2-d array in an incremental\nfashion using 2 nested for-loops. It compiles okay on the prototype compiler\nbut gives a segmentation fault when it executes. I know I can define in the\narray in one go (and I have done) but, for my piece of mind, I want to get this\nway working properly.\n\nIs it a bug in the prototype or is there a glaringly obvious error in my code\nwhich I've been stupid to spot ????\n\nHoping its the latter,\n\nPaul.\n-}\n", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\nThis test runs for a Long Time (10mins for the registerised version)\nand allocates 3.4Gbytes.  It also hammers the GC; with -H16M it spend\n40% of the time in the GC.\n\n\n\nDate: Sun, 25 Oct 92 16:38:12 GMT\nFrom: Julian Seward (DRL PhD) <sewardj@uk.ac.man.cs>\nMessage-Id: <9210251638.AA21153@r6b.cs.man.ac.uk>\nTo: partain@uk.ac.glasgow.dcs\nSubject: Space consumption in 0.09 produced binary\nCc: sewardj@uk.ac.man.cs, simonpj@uk.ac.glasgow.dcs\n\nFolks,\n\nAt the risk of wasting even more of your valuable time, here is\na small problem I ran into:\n\nThe program (XXXX.lhs) listed below runs in constant space (about 4k)\nin both Gofer and hbc 0.998.5.  When compiled with 0.09, it runs out\nof heap in seconds (4 meg heap).\n\nThe program builds a gigantic list of things (CDSs, in fact), I believe\nat least 100,000 long, and searches to find out if a particular CDS is\npresent.  The CDS list is generated lazily, and should be thrown away\nas it goes, until apply_cds is found (see the bottom of the listing).\nGofer and hbc behave as expected, but I suspect ghc is holding onto \nthe complete list unnecessarily.\n\nI include XXXX.stat as supporting evidence.\n\nJules\n\n(compiled hence:\nghc9 -v -O -gc-ap -flet-float -Rgc-stats -Rmax-heapsize 14M -o XXXX XXXX.lhs\n)\n\n-----------------------------------------------------------------------\n\nXXXX +RTS -S \n\nCollector: APPEL  HeapSize: 4,194,304 (bytes)\n\n  Alloc   Live   Live   Astk   Bstk OldGen   GC    GC     TOT     TOT  Page Flts  Collec  Resid\n  bytes   bytes    %   bytes  bytes  roots  user  elap    user    elap   GC  TOT   tion   %heap\n2097108 1119672  53.4     52    132 1119616  0.33  0.35    1.01    1.15    0    0   Minor\n1537300  918200  59.7     48    128 918188  0.26  0.31    1.76    1.95    0    0   Minor\n1078216  654212  60.7     56    160 652612  0.19  0.18    2.29    2.46    0    0   Minor\n 751108  442140  58.9     52    108 442140  0.12  0.12    2.64    2.84    0    0   Minor\n3134224 2935044  93.6     52    108         1.49  1.50    4.13    4.34    0    0  *MAJOR* 70.0%\n 629612  376848  59.9     52    132 376836  0.11  0.11    4.44    4.64    0    0   Minor\n 441184  265100  60.1     96    200 264416  0.08  0.07    4.66    4.86    0    0   Minor\n 308640  204072  66.1     56    160 199476  0.06  0.05    4.81    5.01    0    0   Minor\n3781064 3687092  97.5     56    160         1.81  1.85    6.62    6.86    0    0  *MAJOR* 87.9%\n 253600  160584  63.3     52    108 160584  0.05  0.04    6.75    6.98    0    0   Minor\n 173312  112344  64.8     56    160 110304  0.03  0.03    6.83    7.07    0    0   Minor\n 117128   77260  66.0     36    140  74112  0.01  0.02    6.88    7.13    0    0   Minor\n4037280 3985284  98.7     36    140         1.96  1.98    8.85    9.11    0    0  *MAJOR* 95.0%\n\n-------------------------------------------------------------------------\n-}\n\n> module Main where\n\n> import Prelude hiding (traverse)\n\n%============================================================\n%============================================================\n\n\\section{A CDS interpreter}\n\n\\subsection{Declarations}\n\nSecond attempt at a CDS interpreter.  Should do\nloop detection correctly in the presence of higher order functions.\n\nThe types allowed are very restrictive at the mo.\n\n> data Type = Two\n>           | Fn [Type]\n\nNow, we also have to define CDSs and selectors.\n\\begin{itemize}\n\\item\n@Empty@ is a non-legitimate CDS, denoting no value at all.  We use\nit as an argument in calls to other CDSs denoting that \nthe particular argument is not really supplied.\n\\item\n@Par@ is similarly a non-legit CDS, but useful for constructing\nselectors.  It simply denotes the parameter specified (note\nparameter numbering starts at 1).\n\\item\n@Zero@ and @One@ are constant valued CDSs.\n\\item \n@Call@.\nCalls to other functions are done with @Call@, which expects\nthe callee to return @Zero@ or @One@, and selects the relevant\nbranch.  The @Tag@s identify calls in the dependancy list.\nAlthough a @Call@ is a glorified @Case@ statement, the only allowed\nreturn values are @Zero@ and @One@.  Hence the @CDS CDS@ continuations\nrather than the more comprehensive @(AList Return CDS)@.\nWe require arguments to be fully disassembled.\n\\item @Case@\nCase selectors can only be of the following form:\n\\begin{itemize}\n\\item\n   @[Par n]@  if the n'th parameter is not a function space.\n\\item\n   @[Par n, v1 ... vn]@ if the n'th parameter is a function space of\n                      arity n.  The v's may be only @Empty@, @Zero@,\n                      @One@, or @Par n@.\n\\end{itemize}\n\\end{itemize}\nWe also have a @Magic@ CDS which is a load of mumbo-jumbo for use\nin enumeration of and compilation to CDSs.  Of no significance \nwhatever here.\n\n> data CDS = Empty\n>          | Par Int\n>          | Zero\n>          | One\n>          | Case [CDS] (AList Return CDS)\n>          | Call String Tag [CDS] CDS CDS\n>          | Magic\n>\n> type AList a b = [(a, b)]\n>\n> type Tag = Int\n\n> instance Eq CDS where\n>    (Par n1) == (Par n2) = n1 == n2\n>    Zero == Zero = True\n>    One == One = True\n>    (Case sels1 rets1) == (Case sels2 rets2) = sels1 == sels2 && \n>                                               rets1 == rets2\n>    (Call f1 t1 sels1 a1 b1) == (Call f2 t2 sels2 a2 b2)\n>       = f1 == f2 && t1 == t2 && sels1 == sels2 && a1 == a2 && b1 == b2\n>    Magic == Magic = True\n>    _ == _ = False\n\n\nA @Return@ is a temporary thing used to decide which way to go at\na @Case@ statement.\n\n> data Return = RZero\n>             | ROne\n>             | RP Int\n\n> instance Eq Return where\n>    RZero == RZero  = True\n>    ROne == ROne = True\n>    (RP p1) == (RP p2) = p1 == p2\n>    _ == _ = False\n\nWe need a code store, which gives out a fresh instance of a CDS\nas necessary.  ToDo: Need to rename call sites?  I don't think so.\n\n> type Code = AList String CDS\n\n%============================================================\n%============================================================\n\n\\subsection{The evaluator}\nMain CDS evaluator takes\n\\begin{itemize}\n\\item the code store\n\\item the dependancy list, a list of @Tag@s of calls which are\n      currently in progress\n\\item the current arguments\n\\item the CDS fragment currently being worked on\n\\end{itemize}\n\n> type Depends = [Tag]\n>\n> eval :: Code -> Depends -> [CDS] -> CDS -> CDS\n\nEvaluating a constant valued CDS is trivial.  There may be arguments\npresent -- this is not a mistake.\n\n> eval co de args Zero = Zero\n> eval co de args One  = One\n\nMaking a call is also pretty simple, because we assume\nthat all non-functional arguments are presented as literals,\nand all functional values have already been dismantled (unless\nthey are being passed unchanged in the same position in a recursive call\nto the same function, something for the compiler to detect).\n\nTwo other issues are at work here.  Guided by the selectors,\nwe copy the args to make a set of args for the call.  However, if an\ncopied arg is Empty, the call cannot proceed, so we return the CDS as-is.\nNote that an Empty *selector* is not allowed in a Call (although it is\nin a Case).\n\nThe second issue arises if the call can go ahead.  We need to check the\ntag on the call just about to be made with the tags of calls already in \nprogress (in de) to see if we are looping.  If the tag has already been\nencountered, the result of the call is Zero, so the Zero alternative is\nimmediately selected.\n\n> eval co de args cds@(Call fname tag params alt0 alt1)\n>   = let (copied_an_empty, callee_args) = copy_args args params\n>         augmented_de      = tag : de\n>         callee_code       = lkup co fname\n>         callee_result     = eval co augmented_de callee_args callee_code\n>         been_here_before  = tag `elem` de\n>     in\n>         if    copied_an_empty\n>         then  cds\n>         else\n>         if    been_here_before\n>         then  eval co augmented_de args alt0\n>         else  case callee_result of\n>                  Zero -> eval co de args alt0\n>                  One  -> eval co de args alt1\n>                  _    -> error \"Bad callee result\"\n\nCase really means \"evaluate\".  \n\n   - make sure first selector is non-Empty.  If so, return CDS as-is.\n\n   - Copy other args.  If Empty is *copied*, return CDS as-is.\n     Otherwise, call evaluator and switch on head of result.\n\nNote about switching on the head of the result.  We expect to see\n*only* the following as results:\n\n   Zero\n   One\n   Case [Param m, rest]\n\nin which case switching is performed on\n\n   Zero\n   One\n   Case (Param m)\n\nToDo: what happens if a Call turns up ???\n\n> eval co de args cds@(Case ((Par n):ps) alts)\n>   = let (copied_an_empty, new_args) = copy_args args ps\n>         functional_param = args !! (n-1)\n>     in  if    functional_param == Empty || \n>               copied_an_empty\n>         then  cds\n>         else  eval co de args \n>                    (lkup alts (get_head \n>                                    (eval co de new_args functional_param)))\n\nAuxiliary for evaluating Case expressions.\n\n> get_head Zero                  = RZero\n> get_head One                   = ROne\n> get_head (Case ((Par n):_) _)  = RP n\n\nCopy args based on directions in a list of selectors.\nAlso returns a boolean which is True if an Empty has been\n*copied*.  An Empty *selector* simply produces Empty in the\ncorresponding output position.\n\n> copy_args :: [CDS] -> [CDS] -> (Bool, [CDS])\n>\n> copy_args args params\n>   = case cax False params [] of\n>        (empty_copied, res) -> (empty_copied, reverse res)\n>     where\n>        cax empty [] res = (empty, res)\n>        cax empty (Zero:ps) res = cax empty ps (Zero:res)\n>        cax empty (One:ps) res = cax empty ps (One:res)\n>        cax empty (Empty:ps) res = cax empty ps (Empty:res)\n>        cax empty ((Par n):ps) res\n>           = case args !! (n-1) of\n>                Empty -> cax True ps (Empty:res)\n>                other -> cax empty ps (other:res)\n\n> lkup env k = head ( [v | (kk,v) <- env, kk == k] ++ \n>                       [error ( \"Can't look up \" ) ] )\n\n%============================================================\n%============================================================\n\n%============================================================\n%============================================================\n\nSomething to make running tests easier ...\n\n> eval0 fname args = eval test [] args (lkup test fname)\n>\n> two = [Zero, One]\n\nNow for some test data ...\n\n> test\n>  =\n>  [\n>    (\"add\",     add_cds),\n>    (\"apply\",   apply_cds),\n>    (\"k0\",      k0_cds),\n>    (\"id\",      id_cds),\n>    (\"k1\",      k1_cds),\n>    (\"kkkr\",    kkkr_cds),\n>    (\"kkkl\",    kkkl_cds),\n>    (\"apply2\",  apply2_cds)\n>  ]\n>\n\nConstant Zero function.\n\n> k0_cds\n>   = Case [Par 1]\n>         [(RZero, Zero),\n>          (ROne,  Zero)]\n>\n\nIdentity.\n\n> id_cds\n>   = Case [Par 1]\n>         [(RZero, Zero),\n>          (ROne,  One)]\n\nConstant One function.\n\n> k1_cds\n>   = Case [Par 1]\n>         [(RZero, One),\n>          (ROne,  One)]\n\nStrict in both of two arguments, for example (+).\n\n> add_cds\n>  =    Case [Par 1]\n>          [(RZero, Case [Par 2]\n>                        [(RZero, Zero),\n>                         (ROne,  Zero)\n>                        ]),\n>           (ROne, Case [Par 2]\n>                       [(RZero, Zero),\n>                        (ROne, One)\n>                       ])\n>          ]\n\nThe (in)famous apply function.\n\n> apply_cds\n>  = Case [Par 1, Empty]\n>        [(RZero, Zero),\n>         (ROne, One),\n>         (RP 1, Case [Par 2]\n>                    [(RZero, Case [Par 1, Zero]\n>                                 [(RZero, Zero),\n>                                  (ROne, One)]),\n>                     (ROne,  Case [Par 1, One]\n>                                 [(RZero, Zero),\n>                                  (ROne, One)])\n>                    ])\n>        ]\n\nThe inverse K-combinator: K x y = y\n\n> kkkr_cds\n>  = Case [Par 2]\n>        [(RZero, Zero),\n>         (ROne, One)\n>        ]\n\nThe standard K-combinator, defined thus: K x y = K-inverse y x.\nPurpose of this is to test function calling.\n\n> kkkl_cds\n>  = Case [Par 1]\n>        [(RZero, Case [Par 2]\n>                     [(RZero, Call \"kkkr\" 101 [Zero, Zero] Zero One),\n>                      (ROne,  Call \"kkkr\" 102 [One, Zero]  Zero One)\n>                     ]),\n>         (ROne,  Case [Par 2]\n>                     [(RZero, Call \"kkkr\" 103 [Zero, One]  Zero One),\n>                      (ROne,  Call \"kkkr\" 104 [One, One]   Zero One)\n>                     ])\n>        ]\n\nApply a 2-argument function (apply2 f x y = f x y).\n\n> apply2_cds\n>  = Case [Par 1, Empty, Empty]\n>        [(RZero, Zero),\n>         (ROne, One),\n>         (RP 1, Case [Par 2]\n>               [(RZero, Case [Par 1, Zero, Empty]\n>                            [(RZero, Zero),\n>                             (ROne, One),\n>                             (RP 2, Case [Par 3]\n>                                        [(RZero, Case [Par 1, Zero, Zero]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)]),\n>                                         (ROne, Case [Par 1, Zero, One]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)])\n>                                        ])\n>                            ]),\n>                (ROne,  Case [Par 1, One, Empty]\n>                            [(RZero, Zero),\n>                             (ROne, One),\n>                             (RP 2, Case [Par 3]\n>                                        [(RZero, Case [Par 1, One, Zero]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)]),\n>                                         (ROne, Case [Par 1, One, One]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)])\n>                                        ])\n>                            ])\n>               ]),\n>         (RP 2, Case [Par 3]\n>               [(RZero, Case [Par 1, Empty, Zero]\n>                            [(RZero, Zero),\n>                             (ROne, One),\n>                             (RP 1, Case [Par 2]\n>                                        [(RZero, Case [Par 1, Zero, Zero]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)]),\n>                                         (ROne, Case [Par 1, One, Zero]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)])\n>                                        ])\n>                            ]),\n>                (ROne,  Case [Par 1, Empty, One]\n>                            [(RZero, Zero),\n>                             (ROne, One),\n>                             (RP 1, Case [Par 2]\n>                                        [(RZero, Case [Par 1, Zero, One]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)]),\n>                                         (ROne, Case [Par 1, One, One]\n>                                                [(RZero, Zero),\n>                                                 (ROne, One)])\n>                                        ])\n>                            ])\n>               ])\n>           ]\n\nSimple, isn't it!\n\n%============================================================\n%============================================================\n\n%============================================================\n%============================================================\n\nEnumeration of all CDSs of a given type.\n\nDefine n-ary branched trees.  These are used to hold the \npossible prefixes of function arguments, something essential\nwhen enumerating higher-order CDSs. ToDo: translate to English\n\n> data NTree a = NLeaf\n>              | NBranch a [NTree a]\n\nThe enumeration enterprise involves some mutual recursion\nwhen it comes to higher-order functions.  We define the\ntop-level enumerator function, for trivial cases, hence:\n\n> enumerate :: Type -> [CDS]\n>\n> enumerate Two = [Zero, One]\n> enumerate (Fn ats) = \n>    expand_templates (traverse (length ats) (gen_pfx_trees ats))\n\nEnumerating a function space is tricky.  In summary:\n\n   - Generate the prefix trees for each argument.  \n     For non-function arguments this trivial, but for\n     function-valued arguments this means a call to the\n     enumerator to get all the possible values of the\n     (argument) function space.\n\n   - Traverse the prefix trees, generating a series of\n     \"templates\" for functions.\n\n   - Expand each template thus generated into a genuine CDS.\n     Each template denotes a group of CDSs, all of\n     the same \"shape\" and differing only in the constants\n     they return.  The Magic and RMagic constructors are\n     used for these purposes.\n\nGenerating prefix trees.  For a Two-argument, is easy:\n\n> gen_pfx_trees :: [Type] -> [NTree [CDS]]\n> \n> gen_pfx_trees ts = zipWith gen_pfx_tree ts [1 .. length ts]\n>\n> gen_pfx_tree :: Type -> Int -> NTree [CDS]\n>\n> gen_pfx_tree Two n = NBranch [Par n] []\n\nNote all prefixes are missing the initial (Par n) selector ...\n\nFor a function arg\n\n   - enumerate each of the *function's* args\n\n   - starting with a selector [Empty, ...., Empty],\n     make a tree wherein at each level, branching is \n     achieved by filling in every Empty with every value\n     of that argument type.  ToDo: fix this\n\n> gen_pfx_tree (Fn arg_types) n\n>   = let number_args = length arg_types\n>         enumed_args = map enumerate arg_types\n>         initial_sel = take number_args (repeat Empty)\n>         init_tree   = NBranch ((Par n):initial_sel) []\n>     in\n>         expand_pfx_tree number_args number_args n enumed_args init_tree\n\n@expand_pfx_tree@ expands a tree until there are no Emptys\nat the leaves.  Its first parameter is the number of Emptys\nin the tree it has been given; when zero, expansion is complete.\nThe second parameter is the number of Emptys in the original\ntree (equal to the arity of the function being enumerated).\nThird number is the argument number in the top-level function,\nneeded to make the initial \"Par n\" selector.\nAlso needs to carry around the enumeration of the function's\narguments.\n\n> expand_pfx_tree :: Int -> Int -> Int -> [[CDS]] -> NTree [CDS] -> NTree [CDS]\n>\n> expand_pfx_tree 0 w i enums tree = tree\n>\n> expand_pfx_tree n w i enums (NBranch sels [])\n>   = let indices = [0 .. w - 1]\n>         n_minus_1 = n - 1\n>         new_sels = concat (map expand_sel indices)\n>         expand_sel n\n>           = case sels !! (n+1) of\n>                Empty -> map (upd (n+1) sels) (enums !! n)\n>                other -> []\n>         mk_trivial_tree sel = NBranch sel []\n>     in\n>         NBranch sels (map (expand_pfx_tree n_minus_1 w i enums . mk_trivial_tree) \n>                        new_sels)\n\n> upd :: Int -> [a] -> a -> [a]\n> upd 0 (y:ys) x = x:ys\n> upd n (y:ys) x = y:upd (n-1) ys x\n\nIn the second phase, the prefix trees are traversed to generate\nCDS templates (full of Magic, but no Zero or One).\nThe first arg is the number of arguments, and the\nsecond the prefix trees for each argument.\n\n> traverse :: Int -> [NTree [CDS]] -> [CDS]\n\nEach pfxtree denotes a selector, one for each argument, plus a load\nof more specific selectors.  So for each argument, one manufactures\nall possible sub-cds using the sub-selectors as the set Z.\nYou then take this arg's selector, and manufacture a load of CDSs\nlike this:\n\\begin{verbatim}\n   Case this_selector\n      0 -> z | z <- Z\n      1 -> z | z <- Z\n      Par n -> z | z <- Z for each n in [1 .. length this_selector]\n                          satisfying this_selector !! n == Empty\n\\end{verbatim}\n\n\n> traverse n pfxtrees\n>   = Magic : concat (map doOne [0 .. n - 1])\n>     where\n>        doOne i = traverse_arg n i pfxtrees (pfxtrees !! i) \n\n@traverse_arg@ makes the CDSs corresponding to descending a\nparticular argument, the number of which is given as its second\nparameter.  It also gets the complete set of pfxtrees and the one\nto descend.  Note that having descended in the given argument, we\ncheck its sub-selectors.  If none, (an empty list), this replaced\nby [NLeaf] to make everything work out.  A NLeaf selector\nis a dummy which generates no CDSs.\n\n> traverse_arg n i pfxtrees NLeaf\n>   = []\n\n> traverse_arg n i pfxtrees (NBranch this_selector subsidiary_selectors_init)\n>   = let subsidiary_selectors \n>            = case subsidiary_selectors_init of \n>                 [] -> [NLeaf]; (_:_) -> subsidiary_selectors_init\n>         subsidiary_pfxtrees = map (upd i pfxtrees) subsidiary_selectors\n>         par_requests = preq 1 [] this_selector\n>         preq n acc [] = acc\n>         preq n acc (Empty:rest) = preq (n+1) ((RP n):acc) rest\n>         preq n acc (other:rest) = preq (n+1)         acc  rest\n>         subsidiary_cdss = concat (map (traverse n) subsidiary_pfxtrees)\n>         all_poss_rhss = splat (2 + length par_requests) subsidiary_cdss\n>         all_poss_returns = [RZero,  ROne] ++ par_requests\n>     in\n>         [Case this_selector (zip all_poss_returns rhs)\n>         | rhs <- all_poss_rhss]\n>\n> splat :: Int -> [a] -> [[a]]\n> splat 0 set = [[]]\n> splat n set = [x:xs | x <- set, xs <- splat (n-1) set]\n\nThe final stage in the game is to fill in all the @Magic@s\nwith constants.  A template with $n$ @Magic@s presently generates\n@2^n@ CDSs, obtained by all possible combinations of\nfilling each @Magic@ in with @Zero@ or @One@.  To do this we\nfirst need to count the @Magic@s.\n\n> count_magic :: CDS -> Int\n> \n> count_magic Magic             = 1\n> count_magic (Case sels alts)  = sum (map (count_magic.snd) alts)\n\nWe don't expect to see anything else at this stage.\nNow make $2^n$ lists, each of length $n$, each with a different\nsequence of @Zero@s and @One@s.  Use these to label the \n@Magic@s in the template.\n\n> label_cds :: CDS -> [CDS] -> ([CDS], CDS)\n>\n> label_cds Magic (l:ls) = (ls, l)\n> label_cds (Case sels alts) ls\n>   = case f ls alts of (l9, alts_done) -> (l9, Case sels alts_done)\n>     where\n>        f l0 []     = (l0, [])\n>        f l0 (a:as) = let (l1, a_done)  = lalt l0 a\n>                          (l2, as_done) = f l1 as\n>                      in  (l2, a_done:as_done)\n>        lalt l0 (ret, cds) = case label_cds cds l0 of \n>                               (l1, cds_done) -> (l1, (ret, cds_done))\n\nFinally:\n\n> expand_templates :: [CDS] -> [CDS]\n>\n> expand_templates ts\n>    = concat (map f ts)\n>      where\n>         f tem = map (snd . label_cds tem) \n>                     (splat (count_magic tem) [Zero, One])\n\n--> testq tt = (layn . map show' . nub) (enumerate tt)\n\n> main = putStrLn (show (apply_cds `myElem` (enumerate (Fn [Fn [Two], Two]))))\n>\n> i `myElem` [] = False\n> i `myElem` (x:xs) = if i == x then True else i `myElem` xs \n\n%============================================================\n%============================================================\n", "num_lines": 653}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test checks that constructors with strictness annotations\n-- at least parse correctly.  In GHC 2.02 they didn't!\n\nmodule Main where\n\ndata Foo1 = Crunch1 ! Int ! Int Int deriving( Show )\n\ndata Foo2 = Crunch2 ! Int Int Int   deriving( Show )\n\nmain = do\n        print (Crunch1 (1+1) (2+2) (3+3))\n        print (Crunch2 (1+1) (2+2) (3+3))\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, ExistentialQuantification,\n              ScopedTypeVariables, Rank2Types #-}\n\n--      Modular arithmetic, due to Dale Thurston\n\n-- Here's a way to mimic dependent types using existential types,\n-- illustrated by an implementation of modular arithmetic.  To try it\n-- out, load modulus.hs and try something like\n--      inModulus (mkModulus (1234567890123::Integer)) (^ 98765432198765) 2\n-- to compute 2 to the 98765432198765'th power modulo 1234567890123.\n\n-- The key is the definitions at the top of TypeVal.hs:\n--\n--   class TypeVal a t | t -> a where\n--       -- typeToVal should ignore its argument.\n--       typeToVal :: t -> a\n--\n--   data Wrapper a = forall t . (TypeVal a t) => Wrapper t\n--\n--   class ValToType a where\n--      valToType :: a -> Wrapper a\n--\n-- `valToType' takes a value `x' and returns a (wrapped version of a)\n-- fake value in a new type; from the new type, `x' can be recovered by\n-- applying typeToVal.\n--\n-- This code works under ghc.  It uses existentially quantified data\n-- constructors, scoped type variables, and explicit universal\n-- quantification.\n\n\nmodule Main where\n\nimport TypeVal\n\ndefault (Integer)\n\nmain = print (map (inModulus (mkModulus (1234567890123::Integer)) (^98765432198765)) [2..1000])\n\n\n\ndata Mod s a = Mod {value::a} deriving (Eq, Show)\n\ndata Modulus a = forall s. TypeVal a s => Modulus (a -> Mod s a) (Mod s a -> a)\n\nmkModulus :: (ValToType a, Integral a) => a -> Modulus a\nmkModulus x = case valToType x of {Wrapper (y :: t) ->\n              Modulus normalize (value :: Mod t a -> a)}\n\nnormalize :: forall a s. (TypeVal a s, Integral a) => a -> Mod s a\nnormalize x = (Mod (x `mod` typeToVal (undefined::s)))\n\ninModulus :: Modulus a -> (forall s . TypeVal a s =>  Mod s a -> Mod s a)\n                -> a -> a\ninModulus (Modulus in_ out) f x = out (f (in_ x))\n\ninstance (TypeVal a s, Integral a) => Num (Mod s a) where\n    Mod x + Mod y = normalize (x + y)\n    Mod x - Mod y = normalize (x - y)\n    negate (Mod x) = normalize (negate x)\n    Mod x * Mod y = normalize (x * y)\n    fromInteger a = normalize (fromInteger a)\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             UndecidableInstances, ExistentialQuantification,\n             ScopedTypeVariables #-}\n\n-- TypeVal.hs: dependent types, here we come!\nmodule TypeVal where\n\n-- The functional dependency is necessary to get ghc to accept\n-- some of the instances below.  Is this a bug?\nclass TypeVal a t | t -> a where\n    -- typeToVal should ignore its argument.\n    typeToVal :: t -> a\n\ndata Wrapper a = forall t . (TypeVal a t) => Wrapper t\ninstance Show a => Show (Wrapper a) where\n   show x = \"valToType \" ++ show (getValue x)\n\nclass ValToType a where\n    valToType :: a -> Wrapper a\n\ngetValue :: Wrapper a -> a\ngetValue (Wrapper p) = case p of {(_::t) -> typeToVal (undefined::t)}\n\n-- Instances of ValToType for standard types.  This would also be a\n-- straightforward compiler extension for the general case.\n---- ValToType Bool\ndata TRUE = Dummy1\ninstance TypeVal Bool TRUE where typeToVal = const True\ndata FALSE = Dummy2\ninstance TypeVal Bool FALSE where typeToVal = const False\n\ninstance ValToType Bool where\n    valToType True = Wrapper (undefined :: TRUE)\n    valToType False = Wrapper (undefined :: FALSE)\n\n---- ValToType Int, ValToType Integer\ndata Zero = Dummy3\ninstance TypeVal Integer Zero where typeToVal = const 0\ndata Succ n = Dummy4\ninstance (TypeVal Integer n) => TypeVal Integer (Succ n)\n  where typeToVal = const (typeToVal (undefined :: n) + 1)\ndata Pred n = Dummy5\ninstance (TypeVal Integer n) => TypeVal Integer (Pred n)\n  where typeToVal = const (typeToVal (undefined :: n) - 1)\ndata Dbl n = Dummy6\ninstance (TypeVal Integer n) => TypeVal Integer (Dbl n)\n  where typeToVal = const (typeToVal (undefined :: n) * 2)\n\ninstance ValToType Integer where\n    valToType n | n == 0 = Wrapper (undefined :: Zero)\n                | even n    =\n                   case valToType (div n 2) of {Wrapper x ->\n                   case x of {(_ :: t) ->\n                   Wrapper (undefined :: Dbl t)}}\n                | n > 0  =\n                   case valToType (n-1) of {Wrapper x ->\n                   case x of {(_ :: t) ->\n                   Wrapper (undefined :: Succ t)}}\n                | n < 1  =\n                   case valToType (n+1) of {Wrapper x ->\n                   case x of {(_ :: t) ->\n                   Wrapper (undefined :: Pred t)}}\n\n--- ValToType (a,b)\n--- Doesn't work.  Perhaps a bug in ghc?\n--- Don't need it yet, anyway.\n--instance (TypeVal a1 t1, TypeVal a2 t2) => TypeVal (a1,a2) (t1,t2)\n--    where typeToVal (x,y) = (typeToVal x, typeToVal y)\n\n--instance (ValToType a, ValToType b) => ValToType (a,b) where\n--    valToType (a,b) = case valToType a of {x ->\n--                  case valToType b of {y ->\n--                  Wrapper (x,y)}}\n\ndata NIL a = Dummy20\ninstance TypeVal [a] (NIL a)\n  where typeToVal = const []\ndata CONS t r = Dummy21\ninstance (TypeVal [a] r, TypeVal a t) => TypeVal [a] (CONS t r)\n  where typeToVal = const (typeToVal (undefined::t):typeToVal (undefined::r))\n\ninstance (ValToType a) => ValToType [a] where\n  valToType [] = Wrapper (undefined::NIL a)\n  valToType (x:xs) = case valToType x of {Wrapper x' ->\n                     case x' of {(_::xt) ->\n                     case valToType xs of {Wrapper xs' ->\n                     case xs' of {(_::xst) ->\n                     Wrapper (undefined::CONS xt xst)}}}}\n\n", "num_lines": 90}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T14833 where\n\ndata Dict c where\n  Dict :: c => Dict c\n\nclass    (a => b) => Implies a b\ninstance (a => b) => Implies a b\n\n-- Works ok\niota1 :: (() => a) => Dict a\niota1 = Dict\n\niota2 :: Implies () a => Dict a\niota2 = Dict\n\n{-\n[G] Implies () a\n[G] (() => a)      -- By superclass\n\n[W] a\n-}\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule Bug where\n\ndata Dict c where\n  Dict :: c => Dict c\n\nclass    (a => b) => Implies a b\ninstance (a => b) => Implies a b\n\ncurryC1 :: ((a, b) => c) => Dict (Implies a (Implies b c))\ncurryC1 = Dict\n\ncurryC2 :: Implies (a, b) c => Dict (Implies a (Implies b c))\ncurryC2 = Dict\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T14863 where\n\ndata Dict c where\n  Dict :: c => Dict c\n\nclass    (a => b) => Implies a b\ninstance (a => b) => Implies a b\n\nuncurryCImpredic1 :: forall a b c. Implies a (b => c) => Dict (Implies (a, b) c)\nuncurryCImpredic1 = Dict\n\nuncurryCImpredic2 :: forall a b c. a => Implies b c => Dict (Implies (a, b) c)\nuncurryCImpredic2 = Dict\n\nuncurryC1 :: forall a b c. (a => b => c) => Dict (Implies (a, b) c)\nuncurryC1 = Dict\n\nuncurryC2 :: forall a b c. Implies a (Implies b c) => Dict (Implies (a, b) c)\nuncurryC2 = Dict\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds           #-}\n{-# LANGUAGE InstanceSigs              #-}\n{-# LANGUAGE FlexibleContexts          #-}\n{-# LANGUAGE FlexibleInstances         #-}\n{-# LANGUAGE GADTs                     #-}\n{-# LANGUAGE MultiParamTypeClasses     #-}\n{-# LANGUAGE RankNTypes                #-}\n{-# LANGUAGE TypeFamilies              #-}\n{-# LANGUAGE TypeFamilyDependencies    #-}\n{-# LANGUAGE TypeInType                #-}\n{-# LANGUAGE TypeOperators             #-}\n{-# LANGUAGE UndecidableInstances      #-}\n{-# LANGUAGE QuantifiedConstraints     #-}\n\nmodule T14961 where\n\nimport           Data.Kind\n\nimport           Control.Arrow              (left, right, (&&&), (|||))\nimport           Control.Category\nimport           Prelude                    hiding (id, (.))\n\nimport           Data.Coerce\n\nclass    (forall x. f x => g x) => f ~=> g\ninstance (forall x. f x => g x) => f ~=> g\n\ntype family (#) (p :: Type -> Type -> Type) (ab :: (Type, Type))\n  = (r :: Type) | r -> p ab where\n  p # '(a, b) = p a b\n\nnewtype Glass\n  :: ((Type -> Type -> Type) -> Constraint)\n  -> (Type, Type) -> (Type, Type) -> Type where\n  Glass :: (forall p. z p => p # ab -> p # st) -> Glass z st ab\n\ndata A_Prism\n\ntype family ConstraintOf (tag :: Type)\n  = (r :: (Type -> Type -> Type) -> Constraint) where\n  ConstraintOf A_Prism = Choice\n\n_Left0\n  :: Glass Choice\n       '(Either a x, Either b x)\n       '(a, b)\n_Left0 = Glass left'\n\n_Left1\n  :: c ~=> Choice\n  => Glass c '(Either a x, Either b x) '(a, b)\n_Left1 = Glass left'\n\n-- fails with\n-- \u00e2\u20ac\u00a2 Could not deduce (Choice p)\n-- _Left2\n--   :: (forall p. c p => ConstraintOf A_Prism p)\n--   => Glass c '(Either a x, Either b x) '(a, b)\n-- _Left2 = Glass left'\n\n_Left3\n  :: d ~ ConstraintOf A_Prism\n  => (forall p . c p => d p)\n  => Glass c\n       '(Either a x, Either b x)\n       '(a, b)\n_Left3 = Glass left'\n\n-- fails to typecheck unless at least a partial type signature is provided\n-- l :: c ~=> Choice => Glass c _ _\n-- l = _Left1 . _Left1\n\nnewtype Optic o st ab where\n  Optic\n    :: (forall c d. (d ~ ConstraintOf o, c ~=> d) => Glass c st ab)\n    -> Optic o st ab\n\n_Left\n  :: Optic A_Prism\n       '(Either a x, Either b x)\n       '(a, b)\n_Left = Optic _Left1\n\ninstance Category (Glass z) where\n  id :: Glass z a a\n  id = Glass id\n\n  (.) :: Glass z uv ab -> Glass z st uv -> Glass z st ab\n  Glass abuv . Glass uvst = Glass (uvst . abuv)\n\nclass Profunctor (p :: Type -> Type -> Type) where\n  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d\n  lmap :: (a -> b) -> p b c -> p a c\n  rmap :: (b -> c) -> p a b -> p a c\n\nclass Profunctor p => Choice (p :: Type -> Type -> Type) where\n  left' :: p a b -> p (Either a c) (Either b c)\n  right' :: p a b -> p (Either c a) (Either c b)\n", "num_lines": 99}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE QuantifiedConstraints #-}\nmodule Bug where\n\nimport Data.Kind\n\ndata ECC :: Constraint -> Type -> Type\n\nclass Y a\nclass Z a\n\ninstance  c         => Y (ECC c a)\ninstance (c => Z a) => Z (ECC c a)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuantifiedConstraints, TypeFamilies #-}\n\nmodule T15244 where\nclass (forall t . Eq (c t)) => Blah c\n\n-- Unquantified works\nfoo :: (Eq (a t), Eq (b t), a ~ b) => a t -> b t -> Bool\nfoo a b = a == b\n-- Works\n\n-- Two quantified instances fail with double ambiguity check errors\nbar :: (forall t . Eq (a t), forall t . Eq (b t), a ~ b) => a t -> b t -> Bool\nbar a b = a == b\n-- Minimal.hs:11:8: error:\n--     \u00e2\u20ac\u00a2 Could not deduce (Eq (b t1))\n--       from the context: (forall t1. Eq (a t1), forall t1. Eq (b t1),\n--                          a ~ b)\n--         bound by the type signature for:\n--                    bar :: forall (a :: * -> *) (b :: * -> *) t.\n--                           (forall t1. Eq (a t1), forall t1. Eq (b t1), a ~ b) =>\n--                           a t -> b t -> Bool\n--         at Minimal.hs:11:8-78\n--     \u00e2\u20ac\u00a2 In the ambiguity check for \u00e2\u20ac\u02dcbar\u00e2\u20ac\u2122\n--       To defer the ambiguity check to use sites, enable AllowAmbiguousTypes\n--       In the type signature:\n--         bar :: (forall t. Eq (a t), forall t. Eq (b t), a ~ b) =>\n--                a t -> b t -> Bool\n--    |\n-- 11 | bar :: (forall t . Eq (a t), forall t . Eq (b t), a ~ b) => a t -> b t -> Bool\n--    |\n-- [And then another copy of the same error]\n\n-- Two copies from superclass instances fail\nbaz :: (Blah a, Blah b, a ~ b) => a t -> b t -> Bool\nbaz a b = a == b\n-- Minimal.hs:34:11: error:\n--     \u00e2\u20ac\u00a2 Could not deduce (Eq (b t)) arising from a use of \u00e2\u20ac\u02dc==\u00e2\u20ac\u2122\n--       from the context: (Blah a, Blah b, a ~ b)\n--         bound by the type signature for:\n--                    baz :: forall (a :: * -> *) (b :: * -> *) t.\n--                           (Blah a, Blah b, a ~ b) =>\n--                           a t -> b t -> Bool\n--         at Minimal.hs:33:1-52\n--     \u00e2\u20ac\u00a2 In the expression: a == b\n--       In an equation for \u00e2\u20ac\u02dcbaz\u00e2\u20ac\u2122: baz a b = a == b\n--    |\n-- 34 | baz a b = a == b\n--    |\n\n-- Two copies from superclass from same declaration also fail\nmugga :: (Blah a, Blah a) => a t -> a t -> Bool\nmugga a b = a == b\n--     \u00e2\u20ac\u00a2 Could not deduce (Eq (a t)) arising from a use of \u00e2\u20ac\u02dc==\u00e2\u20ac\u2122\n--       from the context: (Blah a, Blah a)\n--         bound by the type signature for:\n--                    mugga :: forall (a :: * -> *) t.\n--                             (Blah a, Blah a) =>\n--                             a t -> a t -> Bool\n--         at Minimal.hs:50:1-47\n--     \u00e2\u20ac\u00a2 In the expression: a == b\n--       In an equation for \u00e2\u20ac\u02dcmugga\u00e2\u20ac\u2122: mugga a b = a == b\n--    |\n-- 51 | mugga a b = a == b\n--    |\n\n-- One copy works\nquux :: (Blah a, a ~ b) => a t -> b t -> Bool\nquux a b = a == b\n-- Works\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, ImpredicativeTypes, ScopedTypeVariables,\n             QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-}\n\nmodule T15290 where\n\nimport Prelude hiding ( Monad(..) )\nimport Data.Coerce ( Coercible, coerce )\n\nclass Monad m where\n  join  :: m (m a) -> m a\n\nnewtype StateT s m a = StateT { runStateT :: s -> m (s, a) }\n\nnewtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a }\n\ninstance Monad m => Monad (StateT s m) where\n  join = error \"urk\"\n\ninstance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q))\n      => Monad (IntStateT m) where\n\n--   Fails with the impredicative instantiation of coerce, succeeds without\n\n-- Impredicative version (fails)\n--    join = coerce\n--          @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a)\n--          @(forall a. IntStateT m (IntStateT m a)   -> IntStateT m a)\n--          join\n\n\n-- Predicative version (succeeds)\n    join = (coerce\n           @(StateT Int m (StateT Int m a) -> StateT Int m a)\n           @(IntStateT m (IntStateT m a)   -> IntStateT m a)\n           join) :: forall a. IntStateT m (IntStateT m a)   -> IntStateT m a\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, ImpredicativeTypes, ScopedTypeVariables,\n             QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-}\n\nmodule T15290a where\n\nimport Prelude hiding ( Monad(..) )\nimport Data.Coerce ( Coercible, coerce )\n\nclass Monad m where\n  join  :: m (m a) -> m a\n\nnewtype StateT s m a = StateT { runStateT :: s -> m (s, a) }\n\nnewtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a }\n\ninstance Monad m => Monad (StateT s m) where\n  join = error \"urk\"\n\ninstance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q))\n      => Monad (IntStateT m) where\n\n--   Fails with the impredicative instantiation of coerce, succeeds without\n\n-- Impredicative version (fails)\n    join = coerce\n          @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a)\n          @(forall a. IntStateT m (IntStateT m a)   -> IntStateT m a)\n          join\n\n\n-- Predicative version (succeeds)\n--    join = (coerce\n--           @(StateT Int m (StateT Int m a) -> StateT Int m a)\n--           @(IntStateT m (IntStateT m a)   -> IntStateT m a)\n--           join) :: forall a. IntStateT m (IntStateT m a)   -> IntStateT m a\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE InstanceSigs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T15290b where\n\nimport Data.Coerce\nimport Data.Kind\n\ntype Representational1 m = (forall a b. Coercible a b => Coercible (m a) (m b) :: Constraint)\n\nclass Representational1 f => Functor' f where\n  fmap' :: (a -> b) -> f a -> f b\n\nclass Functor' f => Applicative' f where\n  pure'  :: a -> f a\n  (<*>@) :: f (a -> b) -> f a -> f b\n\nclass Functor' t => Traversable' t where\n  traverse' :: Applicative' f => (a -> f b) -> t a -> f (t b)\n\n-- Typechecks\nnewtype T1 m a = MkT1 (m a) deriving (Functor', Traversable')\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, QuantifiedConstraints, ConstraintKinds  #-}\n-- NB: disabling these if enabled:\n{-# LANGUAGE NoUndecidableInstances, NoUndecidableSuperClasses #-}\n\nmodule T15316 where\n\nimport Data.Proxy\n\n{-\nclass Class a where\n         method :: a\n\nsubsume :: (Class a => Class b) => Proxy a -> Proxy b -> ((Class a => Class b) => r) -> r\nsubsume _ _ x = x\n\nvalue :: Proxy a -> a\nvalue p = subsume p p method\n-}\n\nsubsume' :: Proxy c -> ((c => c) => r) -> r\nsubsume' _ x = x\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, PolyKinds, QuantifiedConstraints, RankNTypes #-}\n\nmodule T15334 where\n\nclass C m a\nclass D m a\n\nf :: (forall a. Eq a => (C m a, D m a)) => m a\nf = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, GADTs, RankNTypes,\n             ConstraintKinds, QuantifiedConstraints #-}\n\nmodule T15359 where\n\nclass C a b\n\ndata Dict c where\n  Dict :: c => Dict c\n\nfoo :: (forall a b. C a b => a ~ b) => Dict (C a b) -> a -> b\nfoo Dict x = x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, GADTs, RankNTypes,\n             ConstraintKinds, QuantifiedConstraints,\n             UndecidableInstances #-}\n\nmodule T15359a where\n\nclass C a b\nclass a ~ b => D a b\n\ndata Dict c where\n  Dict :: c => Dict c\n\nfoo :: (forall a b. C a b => D a b) => Dict (C a b) -> a -> b\nfoo Dict x = x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language GADTs, MultiParamTypeClasses, QuantifiedConstraints #-}\n\nmodule T15625 where\n\nimport Data.Coerce\n\nclass a ~ b => Equal a b\n\ntest1 :: (forall b. a ~ b) => a\ntest1 = False\n\ntest2 :: (forall b. Equal a b) => a\ntest2 = False\n\ntest3 :: (forall b. Coercible a b) => a\ntest3 = coerce False\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, ConstraintKinds, QuantifiedConstraints,\n             PolyKinds, GADTs, MultiParamTypeClasses,\n             DataKinds, FlexibleInstances #-}\n\nmodule T15625a where\n\nimport Data.Kind\n\ntype Cat ob = ob -> ob -> Type\n\ndata KLEISLI (m :: Type -> Type) :: Cat (KL_kind m) where\n  MkKLEISLI :: (a -> m b) -> KLEISLI(m) (KL a) (KL b)\n\ndata KL_kind (m :: Type -> Type) = KL Type\n\nclass    (a ~ KL xx) => AsKL a xx\ninstance (a ~ KL xx) => AsKL a xx\n\nekki__ :: Monad m => (forall xx. AsKL a xx) => KLEISLI m a a\nekki__ = MkKLEISLI undefined\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds             #-}\n{-# Language TypeFamilies          #-}\n{-# Language ConstraintKinds       #-}\n{-# Language FlexibleContexts      #-}\n{-# Language QuantifiedConstraints #-}\n{-# Language UndecidableInstances  #-}\nmodule T15918 where\n\nimport Data.Kind\n\nclass Rev f where\n  rev :: f a\n\ninstance (forall xx. cls xx => Rev xx) => Rev (Build cls) where\n  rev = undefined\n\ndata Build :: ((k -> Type) -> Constraint) -> (k -> Type)\n\nuu = rev :: Build [] a\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuantifiedConstraints  #-}\n\n-- Two simple examples that should work\n\nmodule T2893 where\n\nf :: forall b c. (Eq b, forall a. Eq a => Eq (c a)) => c b -> Bool\n{-# NOINLINE f #-}\nf x = x==x\n\ng x = f [x]\n\ndata Rose f x = Rose x (f (Rose f x))\n\ninstance (Eq a, forall b. Eq b => Eq (f b))\n      => Eq (Rose f a)  where\n  (Rose x1 rs1) == (Rose x2 rs2)\n     = x1==x2 && rs1 == rs2\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n    GADTs\n  , FlexibleContexts\n  , RankNTypes\n  , ScopedTypeVariables\n  , QuantifiedConstraints #-}\n\nmodule T2893a where\n\nimport Control.Monad.ST\nimport Data.Array.ST\n\nsortM\n  :: forall a s.\n     (Ord a, MArray (STUArray s) a (ST s))\n  => [a]\n  -> ST s [a]\nsortM xs = do\n  arr <- newListArray (1, length xs) xs\n           :: ST s (STUArray s Int a)\n  -- do some in-place sorting here\n  getElems arr\n\nsortP_3\n  :: (Ord a, forall s. MArray (STUArray s) a (ST s))\n  => [a] -> [a]\nsortP_3 xs = runST (sortM xs)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuantifiedConstraints  #-}\n\nmodule T2893c where\n\ndata Rose f x = Rose x (f (Rose f x))\n\ninstance Eq a => Eq (Rose f a)  where\n  (Rose x1 _) == (Rose x2 _) = x1==x2\n\n-- Needs superclasses\ninstance (Ord a, forall b. Ord b => Ord (f b))\n      => Ord (Rose f a)  where\n  (Rose x1 rs1) >= (Rose x2 rs2)\n     = x1 >= x2 && rs1 == rs2\n  a <= b = False  -- Just to suppress the warning\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE InstanceSigs, RoleAnnotations  #-}\n\nmodule T9123 where\n\nimport Data.Coerce\n\ntype role Wrap representational nominal\nnewtype Wrap m a = Wrap (m a)\n\nclass Monad' m where\n  join' :: forall a. m (m a) -> m a\n\n-- Tests the superclass stuff\ninstance (forall p q. Coercible p q => Coercible (m p) (m q), Monad' m) => Monad' (Wrap m) where\n  join' :: forall a. Wrap m (Wrap m a) -> Wrap m a\n  join' = coerce @(m (m a) -> m a)\n                 @(Wrap m (Wrap m a) -> Wrap m a)\n                 join'\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuantifiedConstraints, PolyKinds, ScopedTypeVariables\n           , StandaloneDeriving, RoleAnnotations, TypeApplications\n           , UndecidableInstances, InstanceSigs\n           , GeneralizedNewtypeDeriving #-}\n\nmodule T9123a where\n\nimport Data.Coerce\n\nclass MyMonad m where\n  join :: m (m a) -> m a\n\nnewtype StateT s m a = StateT (s -> m (a, s))\n\ntype role StateT nominal representational nominal   -- as inferred\n\ninstance MyMonad m => MyMonad (StateT s m) where\n  join = error \"urk\"  -- A good impl exists, but is not\n                      -- of interest for this test case\n\nnewtype IntStateT m a = IntStateT (StateT Int m a)\n\ntype role IntStateT representational nominal   -- as inferred\n\ninstance (MyMonad m, forall p q. Coercible p q => Coercible (m p) (m q))\n               => MyMonad (IntStateT m) where\n  join :: forall a. IntStateT m (IntStateT m a) -> IntStateT m a\n  join = coerce @(StateT Int m (StateT Int m a) -> StateT Int m a)\n                @(IntStateT  m (IntStateT  m a) -> IntStateT  m a)\n                join\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\n\nimport T14028Quote\n\ns :: String\ns = [here|goes nothing|]\n\nmain = putStrLn s\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14028Quote where\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\nhere :: QuasiQuoter\nhere = QuasiQuoter { quoteExp  = litE . stringL,\n                     quotePat = undefined ,\n                     quoteType = undefined,\n                     quoteDec = undefined }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule T3953 where\n\nfoo = [notDefinedHere| |]\n \n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, QuasiQuotes #-}\n\nmodule Main (main) where\n\nimport T4150A\n\nmyHtmlsTemplate = [multiLineStr|\n#include \"T4150template.txt\"\n|]\n\nsomethingElse :: NoSuchType\nsomethingElse = undefined\n\nmain :: IO ()\nmain = print myHtmlsTemplate\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4150A where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\nmultiLineStr :: QuasiQuoter\nmultiLineStr = QuasiQuoter {\n                   quoteExp  = stringE,\n                   quotePat  = error \"XXX\",\n                   quoteType = error \"XXX\",\n                   quoteDec  = error \"XXX\"\n               }\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeSynonymInstances, TemplateHaskell, QuasiQuotes, MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable, NamedFieldPuns, ScopedTypeVariables #-}\nmodule Pnm where\nimport qualified Data.Char as Char\n-- import Language.Pads.Padsc \nimport Control.Monad\n\n_ws = one_or_more Char.isSpace\n  where one_or_more = undefined\n        \nws, wsnl, whitechar :: RE\n\nws   = REd \"[ \\t\\n\\r]+\" \" \"                      -- whitespace\nwsnl = let REd wplus _ = ws in REd wplus \"\\n\"    -- whitespace output as \\n\nwhitechar = REd \"[ \\t\\n\\r]\" \"\\n\"                 -- one white character\n\n\n[pads|\n\n  data PGMx a = PGM \"P5\" ws Header whitechar (Pixmap a)\n               \n  data Header = Header  -- fields should be separated by whitespace\n    {      width  :: Int\n    ws   , height :: Int\n    wsnl , constrain denominator :: Int\n                    where <| 0 <= denominator && denominator < 65536 |>\n    }\n\n  data Pixmap a (h::Header) = Rows   [Row a h | wsnl] length <| height h |>\n  data Row    a (h::Header) = Pixels [a h     | ws]   length <| width h |> \n\n  newtype Greypix (h::Header) =\n     G constrain g::Int16 where <| 0 <= g && g <= denominator h |>\n                              \n  data PGM = PGMx Int16 Greypix\n\n]\n\npgm file = do (rep, md) <- parseFile file\n              return rep\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Check the source spans associated with the expansion of quasi-quotes\nmodule Main (main) where\n\nimport GHC\nimport DynFlags\nimport Outputable\nimport MonadUtils\nimport NameSet\nimport Var\n\nimport Data.Data\n\nimport System.Environment\nimport Control.Monad\nimport Control.Monad.Trans.State\nimport Data.List\nimport Data.Ord\nimport Prelude hiding (traverse)\n\ntype Traverse a = State (SrcSpan, [(Name, SrcSpan)]) a\n\ntraverse :: Data a => a -> Traverse a\ntraverse a =\n    skipNameSet (cast a) a $ do\n      updateLoc  (cast a)\n      showVar    (cast a)\n      showTyVar  (cast a)\n      showPatVar (cast a)\n      gmapM traverse a\n  where\n    showVar :: Maybe (HsExpr GhcTc) -> Traverse ()\n    showVar (Just (HsVar _ (L _ v))) =\n      modify $ \\(loc, ids) -> (loc, (varName v, loc) : ids)\n    showVar _ =\n      return ()\n\n    showTyVar :: Maybe (HsType GhcRn) -> Traverse ()\n    showTyVar (Just (HsTyVar _ _ (L _ v))) =\n      modify $ \\(loc, ids) -> (loc, (v, loc) : ids)\n    showTyVar _ =\n      return ()\n\n    showPatVar :: Maybe (Pat GhcTc) -> Traverse ()\n    showPatVar (Just (VarPat _ (L _ v))) =\n      modify $ \\(loc, ids) -> (loc, (varName v, loc) : ids)\n    showPatVar _\n      = return ()\n\n    -- Updating the location in this way works because we see the SrcSpan\n    -- before the associated term due to the definition of GenLocated\n    updateLoc :: Maybe SrcSpan -> Traverse ()\n    updateLoc (Just loc) = modify $ \\(_, ids) -> (loc, ids)\n    updateLoc _          = return ()\n\n    skipNameSet :: Monad m => Maybe NameSet -> a -> m a -> m a\n    skipNameSet (Just _) a _ = return a\n    skipNameSet Nothing  _ f = f\n\ntest7918 :: Ghc ()\ntest7918 = do\n  dynFlags <- getSessionDynFlags\n  void $ setSessionDynFlags (gopt_set dynFlags Opt_BuildDynamicToo)\n\n  let target = Target {\n                   targetId           = TargetFile \"T7918B.hs\" Nothing\n                 , targetAllowObjCode = True\n                 , targetContents     = Nothing\n                 }\n  setTargets [target]\n  void $ load LoadAllTargets\n\n  typecheckedB <- getModSummary (mkModuleName \"T7918B\") >>= parseModule >>= typecheckModule\n  let (_loc, ids) = execState (traverse (tm_typechecked_source typecheckedB)) (noSrcSpan, [])\n  liftIO . forM_ (sortBy (comparing snd) (reverse ids)) $ putStrLn . showSDoc dynFlags . ppr\n\nmain :: IO ()\nmain = do\n  [libdir] <- getArgs\n  runGhc (Just libdir) test7918\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T7918A where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\nqq = QuasiQuoter {\n         quoteExp  = \\str -> case str of\n                                \"e1\" -> [| True |]\n                                \"e2\" -> [| id True |]\n                                \"e3\" -> [| True || False |]\n                                \"e4\" -> [| False |]\n       , quoteType = \\str -> case str of\n                                \"t1\" -> [t| Bool |]\n                                \"t2\" -> [t| Maybe Bool |]\n                                \"t3\" -> [t| Either Bool Int |]\n                                \"t4\" -> [t| Int |]\n       , quotePat  = let x = VarP (mkName \"x\")\n                         y = VarP (mkName \"y\")\n                     in \\str -> case str of\n                                  \"p1\" -> return $ x\n                                  \"p2\" -> return $ ConP 'Just [x]\n                                  \"p3\" -> return $ TupP [x, y]\n                                  \"p4\" -> return $ y\n       , quoteDec  = undefined\n       }\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule T7918B where\n\nimport T7918A\n\nex1 = [qq|e1|]\nex2 = [qq|e2|]\nex3 = [qq|e3|]\nex4 = [qq|e4|]\n\ntx1 = undefined :: [qq|t1|]\ntx2 = undefined :: [qq|t2|]\ntx3 = undefined :: [qq|t3|]\ntx4 = undefined :: [qq|t4|]\n\npx1 [qq|p1|] = undefined\npx2 [qq|p2|] = undefined\npx3 [qq|p3|] = undefined\npx4 [qq|p4|] = undefined\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Main where\n\nparse = undefined\n\nmain :: IO ()\nmain = print $ [parse||]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Main where\n\nparse = undefined\n\nmain :: IO ()\nmain = case () of\n         [parse||] -> return ()\n         _ -> return ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Main where\n\nmain :: IO ()\nmain = print $ \\parse -> [parse||]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Main where\n\nmain :: IO ()\nmain = p undefined\n  where\n    p = \\parse -> case () of\n                    [parse||] -> return ()\n                    _ -> return ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\nmodule Expr where\n\nimport Data.Data\nimport Data.Typeable\nimport Language.Haskell.TH as TH\nimport Language.Haskell.TH.Quote\n\nimport Text.ParserCombinators.Parsec\nimport Text.ParserCombinators.Parsec.Char\n\ndata Expr  =  IntExpr Integer\n           |  AntiIntExpr String\n           |  BinopExpr BinOp Expr Expr\n           |  AntiExpr String\n    deriving(Typeable, Data)\n\ndata BinOp  =  AddOp\n            |  SubOp\n            |  MulOp\n            |  DivOp\n    deriving(Typeable, Data)\n\neval :: Expr -> Integer\neval (IntExpr n)        = n\neval (BinopExpr op x y) = (opToFun op) (eval x) (eval y)\n  where\n    opToFun AddOp = (+)\n    opToFun SubOp = (-)\n    opToFun MulOp = (*)\n    opToFun DivOp = (div)\n\nsmall :: CharParser st Char\nsmall   = lower <|> char '_'\nlarge   = upper\nidchar  = small <|> large <|> digit <|> char '\\''\n\nlexeme p    = do{ x <- p; spaces; return x  }\nsymbol name = lexeme (string name)\nparens p    = between (symbol \"(\") (symbol \")\") p\n\n_expr :: CharParser st Expr\n_expr   = term   `chainl1` mulop\n\nterm :: CharParser st Expr\nterm    = factor `chainl1` addop\n\nfactor :: CharParser st Expr\nfactor  = parens _expr <|> integer <|> anti\n\nmulop   =   do{ symbol \"*\"; return $ BinopExpr MulOp }\n        <|> do{ symbol \"/\"; return $ BinopExpr DivOp }\n\naddop   =   do{ symbol \"+\"; return $ BinopExpr AddOp }\n        <|> do{ symbol \"-\"; return $ BinopExpr SubOp }\n\ninteger :: CharParser st Expr\ninteger  = lexeme $ do{ ds <- many1 digit ; return $ IntExpr (read ds) }\n\nanti   = lexeme $\n         do  symbol \"$\"\n             c <- small\n             cs <- many idchar\n             return $ AntiIntExpr (c : cs)\n\nparseExpr :: Monad m => TH.Loc -> String -> m Expr\nparseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s =\n    case runParser p () \"\" s of\n      Left err  -> fail $ show err\n      Right e   -> return e\n  where\n    p = do  pos <- getPosition\n            setPosition $ setSourceName (setSourceLine (setSourceColumn pos col) line) file\n            spaces\n            e <- _expr\n            eof\n            return e\n\nexpr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat,\n                     quoteType = undefined, quoteDec = undefined }\n\nparseExprExp :: String -> Q Exp\nparseExprExp s =  do  loc <- location\n                      expr <- parseExpr loc s\n                      dataToExpQ (const Nothing `extQ` antiExprExp) expr\n\nantiExprExp :: Expr -> Maybe (Q Exp)\nantiExprExp  (AntiIntExpr v)  = Just $ appE  (conE (mkName \"IntExpr\"))\n                                                (varE (mkName v))\nantiExprExp  (AntiExpr v)     = Just $ varE  (mkName v)\nantiExprExp  _                = Nothing\n\nparseExprPat :: String -> Q Pat\nparseExprPat s =  do  loc <- location\n                      expr <- parseExpr loc s\n                      dataToPatQ (const Nothing `extQ` antiExprPat) expr\n\nantiExprPat :: Expr -> Maybe (Q Pat)\nantiExprPat  (AntiIntExpr v)  = Just $ conP  (mkName \"IntExpr\")\n                                                [varP (mkName v)]\nantiExprPat  (AntiExpr v)     = Just $ varP  (mkName v)\nantiExprPat  _                = Nothing\n\n-- Copied from syb for the test\n\n-- | Extend a generic query by a type-specific case\nextQ :: ( Typeable a\n        , Typeable b\n        )\n     => (a -> q)\n     -> (b -> q)\n     -> a\n     -> q\nextQ f g a = maybe (f a) g (cast a)\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Main where\n\nimport Expr\n\nmain :: IO ()\nmain = do  print $ eval [expr|1 + 3 + 5|]\n           case [expr|2|] of\n             [expr|$n|] -> print n\n             _          -> return ()\n           case [expr|1 + 2|] of\n             [expr|$x + $y|] -> putStrLn $ show x ++ \" + \" ++ show y\n             _               -> return ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\nmodule Expr where\n\nimport Data.Data\nimport Data.Typeable\nimport Language.Haskell.TH as TH\nimport Language.Haskell.TH.Quote\n\nimport Text.ParserCombinators.Parsec\nimport Text.ParserCombinators.Parsec.Char\n\ndata Expr  =  IntExpr Integer\n           |  AntiIntExpr String\n           |  BinopExpr BinOp Expr Expr\n           |  AntiExpr String\n    deriving(Typeable, Data)\n\ndata BinOp  =  AddOp\n            |  SubOp\n            |  MulOp\n            |  DivOp\n    deriving(Typeable, Data)\n\neval :: Expr -> Integer\neval (IntExpr n)        = n\neval (BinopExpr op x y) = (opToFun op) (eval x) (eval y)\n  where\n    opToFun AddOp = (+)\n    opToFun SubOp = (-)\n    opToFun MulOp = (*)\n    opToFun DivOp = (div)\n\nsmall :: CharParser st Char\nsmall   = lower <|> char '_'\nlarge   = upper\nidchar  = small <|> large <|> digit <|> char '\\''\n\nlexeme p    = do{ x <- p; spaces; return x  }\nsymbol name = lexeme (string name)\nparens p    = between (symbol \"(\") (symbol \")\") p\n\n_expr :: CharParser st Expr\n_expr   = term   `chainl1` mulop\n\nterm :: CharParser st Expr\nterm    = factor `chainl1` addop\n\nfactor :: CharParser st Expr\nfactor  = parens _expr <|> integer <|> anti\n\nmulop   =   do{ symbol \"*\"; return $ BinopExpr MulOp }\n        <|> do{ symbol \"/\"; return $ BinopExpr DivOp }\n\naddop   =   do{ symbol \"+\"; return $ BinopExpr AddOp }\n        <|> do{ symbol \"-\"; return $ BinopExpr SubOp }\n\ninteger :: CharParser st Expr\ninteger  = lexeme $ do{ ds <- many1 digit ; return $ IntExpr (read ds) }\n\nanti   = lexeme $\n         do  symbol \"$\"\n             c <- small\n             cs <- many idchar\n             return $ AntiIntExpr (c : cs)\n\nparseExpr :: Monad m => TH.Loc -> String -> m Expr\nparseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s =\n    case runParser p () \"\" s of\n      Left err  -> fail $ show err\n      Right e   -> return e\n  where\n    p = do  pos <- getPosition\n            setPosition $ setSourceName (setSourceLine (setSourceColumn pos col) line) file\n            spaces\n            e <- _expr\n            eof\n            return e\n\nexpr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat,\n                     quoteType = undefined, quoteDec = undefined }\n\nparseExprExp :: String -> Q Exp\nparseExprExp s =  do  loc <- location\n                      expr <- parseExpr loc s\n                      dataToExpQ (const Nothing `extQ` antiExprExp) expr\n\nantiExprExp :: Expr -> Maybe (Q Exp)\nantiExprExp  (AntiIntExpr v)  = Just $ appE  (conE (mkName \"IntExpr\"))\n                                                (varE (mkName v))\nantiExprExp  (AntiExpr v)     = Just $ varE  (mkName v)\nantiExprExp  _                = Nothing\n\nparseExprPat :: String -> Q Pat\nparseExprPat s =  do  loc <- location\n                      expr <- parseExpr loc s\n                      dataToPatQ (const Nothing `extQ` antiExprPat) expr\n\nantiExprPat :: Expr -> Maybe (Q Pat)\nantiExprPat  (AntiIntExpr v)  = Just $ conP  (mkName \"IntExpr\")\n                                                [varP (mkName v)]\nantiExprPat  (AntiExpr v)     = Just $ varP  (mkName v)\nantiExprPat  _                = Nothing\n\n-- Copied from syb for the test\n\n-- | Extend a generic query by a type-specific case\nextQ :: ( Typeable a\n        , Typeable b\n        )\n     => (a -> q)\n     -> (b -> q)\n     -> a\n     -> q\nextQ f g a = maybe (f a) g (cast a)\n", "num_lines": 116}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Main where\n\nimport Expr\n\nmain :: IO ()\nmain = do  case [expr|1 + 2|] of\n             [expr|$x + $x|] -> print x\n             _               -> return ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule QQ where\n\nimport Language.Haskell.TH.Quote\nimport Language.Haskell.TH\n\npq = QuasiQuoter { quoteDec = \\_ -> [d| f x = x |],\n                   quoteType = \\_ -> [t| Int -> Int |],\n                   quoteExp = \\_ -> [| $(varE (mkName \"x\")) + 1::Int |],\n                   quotePat = \\_ -> [p| Just x |] }\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Test where\n\nimport QQ\n\nf :: [pq| foo |]    -- Expands to Int -> Int\n[pq| blah |]        -- Expands to f x = x\n\nh [pq| foo |] = f [pq| blah |] * 8\n        -- Expands to h (Just x) = f (x+1) * 8\n\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule QQ where\n\nimport Language.Haskell.TH.Quote\nimport Language.Haskell.TH\n\npq = QuasiQuoter { quoteDec = \\_ -> [d| f x = x |],\n                   quoteType = \\_ -> [t| Int -> Int |],\n                   quoteExp = \\_ -> [| $(varE (mkName \"x\")) + 1::Int |],\n                   quotePat = \\_ -> [p| Just x |] }\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Test where\n\nimport QQ\n\nf :: [pq| foo |]    -- Expands to Int -> Int\n[pq| blah |]        -- Expands to f x = x\n\nh [pq| foo |] = f [pq| blah |] * 8\n-- Expands to h (Just x) = f (x+1) * 8\n\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule QQ where\n\nimport Language.Haskell.TH.Quote\nimport Language.Haskell.TH.Syntax\nimport Language.Haskell.TH\n\npq = QuasiQuoter { quoteDec = \\_ -> return [sig],\n                   quoteType = \\_ -> undefined,\n                   quoteExp = \\_ -> undefined,\n                   quotePat = \\_ -> undefined }\n\nsig = SigD (mkName \"f\") (ArrowT `AppT` int `AppT` int)\nint = ConT (mkName \"Int\")\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule Test where\n\nimport QQ\n\nf' = f . (+ 1)\n\n[pq| foo |]         -- Expands to f :: Int -> Int\nf x = x + 1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-missing-fields#-}\nmodule A where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\naquoter :: QuasiQuoter\naquoter = QuasiQuoter {quoteType = conT . mkName }\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\nmodule B where\n\nimport A\n\nfoo:: [aquoter|Int|] -> [aquoter|String|]\nfoo = show\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule A where\n\nimport Data.Data\nimport Data.Typeable\n\ndata Foo = Foo Int\n  deriving (Show, Data, Typeable)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Main where\n\nimport Language.Haskell.TH.Quote\n\nimport qualified A as B\n\ntest1 :: [Int]\ntest1 = $(dataToExpQ (const Nothing) [1 :: Int, 2, 3])\n\ntest2 :: ()\ntest2 = $(dataToExpQ (const Nothing) ())\n\ntest3 :: (Int, Int, Int)\ntest3 = $(dataToExpQ (const Nothing) (1 :: Int, 2 :: Int, 3 :: Int))\n\ntest4 :: Rational\ntest4 = $(dataToExpQ (const Nothing) (5.5 :: Rational))\n\ntest5 :: B.Foo\ntest5 = $(dataToExpQ (const Nothing) (B.Foo 1))\n\nmain :: IO ()\nmain = do\n    print test1\n    print test2\n    print test3\n    print test4\n    print test5\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskellQuotes, RankNTypes, ScopedTypeVariables #-}\nmodule A where\nx = \\(y :: forall a. a -> a) -> [|| y ||]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2931\n\nmodule Foo where\na = 1\n\n-- NB: no newline after the 'a'!\nb = 'a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls #-}\n\n-- Trac #3572\n\nmodule Main where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Ppr\n\nmain = putStrLn . pprint =<< runQ [d| data Void |]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleContexts #-}\n\nmodule T4056 where\nimport Language.Haskell.TH\n\nastTest :: Q [Dec]\nastTest = [d|\n    class C t where\n        op :: [t] -> [t]\n        op = undefined\n  |]\n\nclass D t where\n  bop :: [t] -> [t]\n  bop = undefined\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Crashed GHC 6.12\n\nmodule T4165 where\n\nimport Language.Haskell.TH\nclass Numeric a where\n    fromIntegerNum :: a\n    fromIntegerNum = undefined\n\nast :: Q [Dec]\nast = [d|\n    instance Numeric Int\n    |]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4170 where\n\nimport Language.Haskell.TH\n\nclass LOL a\n\nlol :: Q [Dec]\nlol = [d|\n    instance LOL Int\n    |]\n\ninstance LOL Int\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule T5371 where\nimport Language.Haskell.TH\n\nf :: a -> Name\nf (x :: a) = ''a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6062 where\nx = [| False True |]\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n\nmodule T8455 where\n\nty = [t| 5 |]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport Language.Haskell.TH.Syntax\n\nt1 = case mkName \"^..\" of\n    Name (OccName \".\")  (NameQ (ModName \"^\")) -> error \"bug0\"\n    Name (OccName \"^..\") NameS                -> return ()\n\nt2 = case mkName \"Control.Lens.^..\" of\n    Name (OccName \".\")  (NameQ (ModName \"Control.Lens.^\")) -> error \"bug1\"\n    Name (OccName \"^..\") (NameQ (ModName \"Control.Lens\")) -> return ()\n\nt3 = case mkName \"Data.Bits..&.\" of\n    Name (OccName \".&.\") (NameQ (ModName \"Data.Bits\")) -> return ()\n\nt4 = case mkName \"abcde\" of\n    Name (OccName \"abcde\") NameS -> return ()\n\nmain :: IO ()\nmain = do t1; t2; t3; t4\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T8759a where\n\nfoo = [d| pattern Q = False |]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-matches #-}\n\nmodule T9824 where\n\nfoo = [p| (x, y) |]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_abstractFamily where\n\nimport Language.Haskell.TH\n\n-- Empty closed type families are okay...\nds1 :: Q [Dec]\nds1 = [d| type family F a where |]\n\n-- ...but abstract ones should result in a type error\nds2 :: Q [Dec]\nds2 = [d| type family G a where .. |]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Check that declarations in a bracket shadow the top-level\n-- declarations, rather than clashing with them.\n\nmodule TH_bracket1 where\n\nfoo = 1\nbar = [d| foo = 1 |]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_bracket2 where\n\nd_show = [d| data A = A\n\n             instance Show A  where\n                 show _ = \"A\"\n         |]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule TH_bracket3 where\n\nd_class = [d| class Classy a b where\n                 f :: a -> b\n\n              instance Classy Int Bool where\n                 f x = if x == 0 then True else False\n           |]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_localname where\n\nx = \\y -> [| y |]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule Main (main) where\n\nimport Language.Haskell.TH\n\nu1 :: a\nu1 = undefined\n\nu2 :: a\nu2 = undefined\n\nf :: a\nf = undefined\n\n(.+.) :: a\n(.+.) = undefined\n\nmain :: IO ()\nmain = do runQ [| f u1 u2 |] >>= p\n          runQ [| u1 `f` u2 |] >>= p\n          runQ [| (.+.) u1 u2 |] >>= p\n          runQ [| u1 .+. u2 |] >>= p\n          runQ [| (:) u1 u2 |] >>= p\n          runQ [| u1 : u2 |] >>= p\n          runQ [| \\((:) x xs) -> x |] >>= p\n          runQ [| \\(x : xs) -> x |] >>= p\n          runQ [d| class Foo a b where\n                       foo :: a -> b   |] >>= p\n          runQ [| \\x -> (x, 1 `x` 2) |] >>= p\n          runQ [| \\(+) -> ((+), 1 + 2) |] >>= p\n          runQ [| (f, 1 `f` 2) |] >>= p\n          runQ [| ((.+.), 1 .+. 2) |] >>= p\n\np :: Ppr a => a -> IO ()\np = putStrLn . pprint\n\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test reification of monomorphic types\n\nmodule TH_reifyType1\nwhere\n\nimport Language.Haskell.TH\n\nfoo :: Int -> Int\nfoo x = x + 1\n\ntype_foo :: InfoQ\ntype_foo = reify 'foo\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test reification of polymorphic types\n\nmodule TH_reifyType1\nwhere\n\nimport Language.Haskell.TH\n\ntype_length :: InfoQ\ntype_length = reify 'length\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test the representation of literals and also explicit type annotations\n\nmodule TH_repE1\nwhere\n\nimport Language.Haskell.TH\n\nintegralExpr :: ExpQ\nintegralExpr = [| 42 |]\n\nintExpr :: ExpQ\nintExpr = [| 42 :: Int |]\n\nintegerExpr :: ExpQ\nintegerExpr = [| 42 :: Integer |]\n\ncharExpr :: ExpQ\ncharExpr = [| 'x' |]\n\nstringExpr :: ExpQ\nstringExpr = [| \"A String\" |]\n\nfractionalExpr :: ExpQ\nfractionalExpr = [| 1.2 |]\n\nfloatExpr :: ExpQ\nfloatExpr = [| 1.2 :: Float |]\n\ndoubleExpr :: ExpQ\ndoubleExpr = [| 1.2 :: Double |]\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test the representation of literals and also explicit type annotations\n\nmodule TH_repE1\nwhere\n\nimport Language.Haskell.TH\n\nemptyListExpr :: ExpQ\nemptyListExpr = [| [] |]\n\nsingletonListExpr :: ExpQ\nsingletonListExpr = [| [4] |]\n\nlistExpr :: ExpQ\nlistExpr = [| [4,5,6] |]\n\nconsExpr :: ExpQ\nconsExpr = [| 4:5:6:[] |]\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for Trac #2188\n\nmodule TH_scope where\n\nf g = [d| f :: Int\n          f = g\n          g :: Int\n          g = 4 |]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}  -- 'bar' is ambiguous\n\nmodule TH_tf2 where\n\n{-\n$( [d| class C a where\n         data T a\n         foo :: Bool -> T a |] )\n\n$( [d| instance C Int where\n         data T Int = TInt Bool\n         foo b = TInt (b && b) |] )\n\n$( [d| instance C Float where\n         data T Float = TFloat {flag :: Bool}\n         foo b = TFloat {flag = b && b} |] )\n-}\n\nclass D a where\n         type S a\n         bar :: S a -> Int\n\ninstance D Int where\n         type S Int = Bool\n         bar c = if c then 1 else 2\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns #-}\nmodule A where\n\nimport Language.Haskell.TH.Quote\nimport Language.Haskell.TH\n\nfoo :: QuasiQuoter\nfoo = QuasiQuoter{quotePat = \\s -> viewP [|(*2)|] (varP . mkName $ s)}\n\nbar :: QuasiQuoter\nbar = QuasiQuoter{quotePat = \\_ -> [p|((*3) -> fixed_var)|] }\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes, ViewPatterns #-}\n\nmodule Main where\n\nimport A\n\nmain = do\n  case 1 of\n    [foo|x|] -> print x\n  case 1 of\n    [bar|<!anything~|] -> print fixed_var\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRebindableSyntax #-}\n-- Haskell98!\n\n-- Tests of the do-notation for the parameterized monads\n-- We demonstrate a variable-type state `monadic' transformer\n-- and its phantom-type-state relative to enforce the locking protocol\n-- (a lock can be released only if it is being held, and acquired only\n-- if it is not being held)\n-- The tests are based on the code\n-- http://okmij.org/ftp/Computation/monads.html#param-monad\n\n-- Please search for DO-NOT-YET\n\nmodule DoParamM where\n\nimport Prelude (const, String, ($), (.), Maybe(..),\n                Int, fromInteger, succ, pred, fromEnum, toEnum,\n                (+), Char, (==), Bool(..),\n                IO, getLine, putStrLn, read, show)\nimport qualified Prelude\nimport qualified Control.Monad.State as State\nimport qualified Control.Monad.Identity as IdM\n\n-- A parameterized `monad'\nclass Monadish m where\n    return :: a -> m p p a\n    fail   :: String -> m p p a\n    (>>=)  :: m p q a -> (a -> m q r b) -> m p r b\n\nm1 >> m2 = m1 >>= (const m2)\n\n-- All regular monads are the instances of the parameterized monad\n\nnewtype RegularM m p q a = RegularM{unRM :: m a}\n\ninstance Prelude.Monad m => Monadish (RegularM m) where\n    return = RegularM . Prelude.return\n    fail   = RegularM . Prelude.fail\n    m >>= f = RegularM ((Prelude.>>=) (unRM m) (unRM . f))\n\n-- As a warm-up, we write the regular State computation, with the same\n-- type of state throughout. We thus inject Monad.State into the\n-- parameterized monad\n\ntest1 = State.runState (unRM c) (0::Int) where\n         c = gget >>= (\\v -> gput (succ v) >> return v)\n         gget :: (State.MonadState s m) => RegularM m s s s\n         gget = RegularM State.get\n         gput :: (State.MonadState s m) => s -> RegularM m s s ()\n         gput = RegularM . State.put\n-- (0,1)\n\n-- The same in the do-notation\ntest1_do = State.runState (unRM c) (0::Int) where\n         c = do\n             v <- gget\n             gput (succ v)\n             return v\n         gget :: (State.MonadState s m) => RegularM m s s s\n         gget = RegularM State.get\n         gput :: (State.MonadState s m) => s -> RegularM m s s ()\n         gput = RegularM . State.put\n-- (0,1)\n\n\n-- Introduce the variable-type state (transformer)\n\nnewtype VST m si so v = VST{runVST:: si -> m (so,v)}\n\ninstance Prelude.Monad m => Monadish (VST m) where\n  return x = VST (\\si -> Prelude.return (si,x))\n  fail x   = VST (\\si -> Prelude.fail x)\n  m >>= f  = VST (\\si -> (Prelude.>>=) (runVST m si)\n                                       (\\ (sm,x) -> runVST (f x) sm))\n\nvsget :: Prelude.Monad m => VST m si si si\nvsget = VST (\\si -> Prelude.return (si,si))\nvsput :: Prelude.Monad m => so -> VST m si so ()\nvsput x = VST (\\si -> Prelude.return (x,()))\n\n\n-- Repeat test1 via VST: the type of the state is the same\nvsm1 () = vsget >>= (\\v -> vsput (succ v) >> return v)\n\n-- The same with the do-notation\nvsm1_do () = do\n             v <- vsget\n             vsput (succ v)\n             return v\n\n{-\n *DoParamM> :t vsm1\n vsm1 :: (Monadish (VST m), IdM.Monad m, Prelude.Enum si) =>\n         () -> VST m si si si\n-}\n\ntest2 = IdM.runIdentity (runVST (vsm1 ()) (0::Int))\n-- (1,0)\n\ntest2_do = IdM.runIdentity (runVST (vsm1_do ()) (0::Int))\n-- (1,0)\n\n\n-- Now, we vary the type of the state, from Int to a Char\nvsm2 () = vsget >>= (\\v -> vsput ((toEnum (65+v))::Char) >>\n                           vsget >>= \\v' -> return (v,v'))\n\n{-\n *DoParamM> :t vsm2\n vsm2 :: (Monadish (VST m), IdM.Monad m) => () -> VST m Int Char (Int, Char)\n-}\n\n-- The same with the do-notation\n -- the following does not yet work\nvsm2_do () = do\n             v <- vsget\n             vsput ((toEnum (65+v))::Char)\n             v' <- vsget\n             return (v,v')\n\ntest3 = IdM.runIdentity (runVST (vsm2 ()) (0::Int))\n-- ('A',(0,'A'))\n\ntest3_do = IdM.runIdentity (runVST (vsm2_do ()) (0::Int))\n-- ('A',(0,'A'))\n\n{- The following is a deliberate error:\n\n DoParamM.hs:147:55:\n    Couldn't match expected type `Int' against inferred type `Char'\n    In the second argument of `(==)', namely `v''\n    In the first argument of `return', namely `(v == v')'\n    In the expression: return (v == v')\n\nvsm3 () = vsget >>= (\\v -> vsput ((toEnum (65+v))::Char) >>\n                           vsget >>= \\v' -> return (v==v'))\n -}\n\n\n -- The following too must report a type error -- the expression\n--    return (v == v') must be flagged, rather than something else\nvsm3_do () = do\n             v <- vsget\n             vsput ((toEnum (65+v))::Char)\n             v' <- vsget\n             return (v==v')\n\n\n\n-- Try polymorphic recursion, over the state.\n-- crec1 invokes itself, and changes the type of the state from\n-- some si to Bool.\ncrec1 :: (Prelude.Enum si, Prelude.Monad m) => VST m si si Int\ncrec1 = vsget >>= (\\s1 -> case fromEnum s1 of\n                      0 -> return 0\n                      1 -> vsput (pred s1) >> return 1\n                      _ -> vsput True >>\n                           crec1 >>= (\\v ->\n                             (vsput s1 >> -- restore state type to si\n                              return (v + 10))))\n\n-- The same in the do-notation\ncrec1_do :: (Prelude.Enum si, Prelude.Monad m) => VST m si si Int\ncrec1_do = do\n        s1 <- vsget\n        case fromEnum s1 of\n           0 -> return 0\n           1 -> do {vsput (pred s1); return 1}\n           _ -> do\n                vsput True\n                v <- crec1_do\n                vsput s1 -- restore state type to si\n                return (v + 10)\n\n\ntest4 = IdM.runIdentity (runVST crec1 'a')\n-- ('a',11)\n\ntest4_do = IdM.runIdentity (runVST crec1_do 'a')\n-- ('a',11)\n\n-- Another example, to illustrate locking and static reasoning about\n-- the locking state\n\ndata Locked = Locked; data Unlocked = Unlocked\nnewtype LIO p q a = LIO{unLIO::IO a}\n\ninstance Monadish LIO where\n  return  = LIO . Prelude.return\n  m >>= f = LIO ((Prelude.>>=) (unLIO m) (unLIO . f))\n\nlput :: String -> LIO p p ()\nlput = LIO . putStrLn\nlget :: LIO p p String\nlget = LIO getLine\n\n-- In the real program, the following will execute actions to acquire\n-- or release the lock. Here, we just print out our intentions.\nlock :: LIO Unlocked Locked ()\nlock = LIO (putStrLn \"Lock\")\n\nunlock :: LIO Locked Unlocked ()\nunlock = LIO (putStrLn \"UnLock\")\n\n-- We should start in unlocked state, and finish in the same state\nrunLIO :: LIO Unlocked Unlocked a -> IO a\nrunLIO = unLIO\n\n-- User code\n\ntlock1 = lget >>=  (\\l ->\n         return (read l) >>= (\\x ->\n         lput (show (x+1))))\n\ntlock1r = runLIO tlock1\n\n-- the same in the do-notation\ntlock1_do = do\n            l <- lget\n            let x = read l\n            lput (show (x+1))\n\n{-\n  *VarStateM> :t tlock1\n  tlock1 :: LIO p p ()\n Inferred type has the same input and output states and is polymorphic:\n tlock1 does not affect the state of the lock.\n-}\n\n\ntlock2 = lget >>= (\\l ->\n         lock >> (\n         return (read l) >>= (\\x ->\n         lput (show (x+1)))))\n\ntlock2_do = do\n            l <- lget\n            lock\n            let x = read l\n            lput (show (x+1))\n\n{-\n  *VarStateM> :t tlock2\n  tlock2 :: LIO Unlocked Locked ()\n\nThe inferred type says that the computation does the locking.\n-}\n\ntlock3 = tlock2 >> unlock\ntlock3r = runLIO tlock3\n\n{-\n  *DoParamM> :t tlock3\n  tlock3 :: LIO Unlocked Unlocked ()\n-}\n\n{-\n*DoParamM> tlock3r\n-- user input: 123\nLock\n124\nUnLock\n-}\n\ntlock3_do = do {tlock2_do; unlock}\ntlock3r_do = runLIO tlock3_do\n\n\n-- An attempt to execute the following\n-- tlock4 = tlock2 >> tlock2\n\n{-\n gives a type error:\n    Couldn't match expected type `Locked'\n           against inferred type `Unlocked'\n      Expected type: LIO Locked r b\n      Inferred type: LIO Unlocked Locked ()\n    In the expression: tlock2\n    In a lambda abstraction: \\ _ -> tlock2\n\nThe error message correctly points out an error of acquiring an already\nheld lock.\n-}\n\n-- The following too must be an error: with the SAME error message as above\ntlock4_do = do {tlock2_do; tlock2_do}\n\n-- Similarly, the following gives a type error because of an attempt\n-- to release a lock twice\n-- tlock4' = tlock2 >> unlock >> unlock\n{-\nDoParamM.hs:298:30:\n    Couldn't match expected type `Unlocked'\n           against inferred type `Locked'\n      Expected type: LIO Unlocked r b\n      Inferred type: LIO Locked Unlocked ()\n    In the second argument of `(>>)', namely `unlock'\n    In the expression: (tlock2 >> unlock) >> unlock\n-}\n\n -- The following too must be an error: with the SAME error message as above\ntlock4'_do = do {tlock2_do; unlock; unlock}\n\n", "num_lines": 304}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, MultiParamTypeClasses,\n             FlexibleInstances, FlexibleContexts #-}\n\n-- Tests of the do-notation for the restricted monads\n-- We demonstrate that all ordinary monads are restricted monads,\n-- and show the frequently requested implementation\n-- of MonadPlus in terms of Data.Set.\n-- \n-- The tests are based on the code\n-- http://okmij.org/ftp/Haskell/types.html#restricted-datatypes\n\nmodule DoRestrictedM where\n\nimport Data.List\nimport Prelude (const, String, ($), (.), Maybe(..))\nimport qualified Prelude\nimport qualified Data.Set as Set\n\n-- Defining the restricted monad\nclass MN2 m a where\n    return  :: a -> m a\n    fail    :: String -> m a\n\nclass (MN2 m a, MN2 m b) => MN3 m a b where\n    (>>=) :: m a -> (a -> m b) -> m b\n\nm1 >> m2 = m1 >>= (const m2)\n\n-- All regular monads are the instances of the restricted monad\n\nnewtype RegularM m a = RegularM{unRM :: m a}\n\ninstance Prelude.Monad m => MN2 (RegularM m) a where\n    return = RegularM . Prelude.return\n    fail   = RegularM . Prelude.fail\n\ninstance Prelude.Monad m => MN3 (RegularM m) a b where\n    m >>= f = RegularM ((Prelude.>>=) (unRM m) (unRM . f))\n\n-- We try to inject Maybe (as the regular monad) into Restricted Monad\n\ntest1s () =  return \"a\" >>= (\\x -> return $ \"b\" ++ x)\ntest1f () =  fail \"\"    >>= (\\x -> return $ \"b\" ++ x)\n\n-- the same with the do-notation\n\ntest1s_do () = do\n  x <- return \"a\"\n  return $ \"b\" ++ x\n\n\n{-\nwhose inferred type is\n   *DoRestrictedM> :t test1s\n   test1s :: (MN3 m [Prelude.Char] [Prelude.Char]) => () -> m [Prelude.Char]\n-}\n\ntest1sr :: Maybe String\ntest1sr = unRM $ test1s ()\n-- Just \"ba\"\n\ntest1fr :: Maybe String\ntest1fr = unRM $ test1f ()\n-- Nothing\n\ntest1sr_do :: Maybe String\ntest1sr_do = unRM $ test1s_do ()\n-- Just \"ba\"\n\n-- As often requested, we implement a MonadPlus `monad'\n-- in terms of a Set. Set requires the Ord constraint.\n\nnewtype SMPlus a = SMPlus{unSM:: Set.Set a}\n\ninstance MN2 SMPlus a where\n    return = SMPlus . Set.singleton\n    fail x = SMPlus $ Set.empty\n\ninstance Prelude.Ord b => MN3 SMPlus a b where\n    m >>= f = SMPlus (Set.fold (Set.union . unSM . f) Set.empty (unSM m))\n\n-- We cannot forget the Ord constraint, because the typechecker\n-- will complain (and tell us exactly what we have forgotten).\n\n-- Now we can instantiate the previously written test1s and test1d \n-- functions for this Set monad:\n\ntest2sr :: Set.Set String\ntest2sr = unSM $ test1s ()\n-- fromList [\"ba\"]\n\ntest2fr :: Set.Set String\ntest2fr = unSM $ test1f ()\n-- fromList []\n\ntest2sr_do :: Set.Set String\ntest2sr_do = unSM $ test1s_do ()\n-- fromList [\"ba\"]\n\n", "num_lines": 100}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-missing-monadfail-instances #-}\n{-# LANGUAGE RebindableSyntax, NPlusKPatterns, NoMonadFailDesugaring #-}\n\nmodule RebindableCase1 where\n        {\n--      import Prelude;\n        import Prelude(String,undefined,Maybe(..), (==), (>=) );\n\n        return :: a;\n        return = undefined;\n\n        infixl 1 >>=;\n        (>>=) :: a;\n        (>>=) = undefined;\n\n        infixl 1 >>;\n        (>>) :: a;\n        (>>) = undefined;\n\n        fail :: a;\n        fail = undefined;\n\n        fromInteger :: a;\n        fromInteger = undefined;\n\n        fromRational :: a;\n        fromRational = undefined;\n\n        negate :: a;\n        negate = undefined;\n\n        (-) :: a;\n        (-) = undefined;\n\n\n        test_do f g = do\n                {\n                f;\n                Just a <- g;\n                return a;\n                };\n\n        test_fromInteger = 1;\n\n        test_fromRational = 0.5;\n\n        test_negate a = - a;\n\n        test_fromInteger_pattern 1 = undefined;\n        test_fromInteger_pattern (-1) = undefined;\n        test_fromInteger_pattern (a + 7) = a;\n\n        test_fromRational_pattern 0.5 = undefined;\n        test_fromRational_pattern (-0.5) = undefined;\n        test_fromRational_pattern _ = undefined;\n        }\n", "num_lines": 57}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\nmodule Main where\nimport Prelude\n\nifThenElse :: Int -> String -> String -> String\nifThenElse a b c = case a > 0 of\n    True -> b\n    False -> c\n\nmain :: IO ()\nmain = do\n     print $ if -5 then \"this fails\" else \"this works\"\n     print $ if 5 then \"this works\" else \"this fails\"", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, MonadFailDesugaring #-}\n{-# OPTIONS_GHC -Wno-missing-monadfail-instances #-}\n\n-- Test that rebindable clash warnings are not displayed. This program\n-- should not generate anything on stderr at compile time.\n\nmodule Main where\n\nimport Prelude\n\ncatMaybes xs = do\n    Just x <- xs\n    return x\n\nmain = return ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, MonadFailDesugaring #-}\n{-# OPTIONS_GHC -Wmissing-monadfail-instances #-}\n\n-- Test that rebindable clash warnings are displayed.\n\nmodule Main where\n\nimport Prelude\n\ncatMaybes xs = do\n    Just x <- xs\n    return x\n\nmain = return ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}\n{-# OPTIONS -Wno-error=missing-monadfail-instances #-}\n\nmodule Main where\n        {\n--      import Prelude;\n        import qualified Prelude;\n        import Prelude(String,undefined,Maybe(..),IO,putStrLn,\n                Integer,(++),Rational, (==), (>=) );\n\n        import Prelude(Monad(..),Applicative(..),Functor(..));\n        import Control.Monad(ap, liftM);\n\n        debugFunc :: String -> IO a -> IO a;\n        debugFunc s ioa = (putStrLn (\"++ \" ++ s)) Prelude.>>\n                (ioa Prelude.>>= (\\a ->\n                        (putStrLn (\"-- \" ++ s)) Prelude.>> (Prelude.return a)\n                ));\n\n        newtype TM a = MkTM {unTM :: IO a};\n\n        instance (Functor TM) where\n          {\n            fmap = liftM;\n          };\n        instance (Applicative TM) where\n          {\n            pure  = return;\n            (<*>) = ap;\n          };\n        instance (Monad TM) where\n                {\n                return a = MkTM (debugFunc \"return\" (Prelude.return a));\n\n                (>>=) ma amb = MkTM (debugFunc \">>=\" ((Prelude.>>=) (unTM ma) (\\a -> unTM (amb a))));\n\n                (>>) ma mb = MkTM (debugFunc \">>\" ((Prelude.>>) (unTM ma) (unTM mb)));\n\n                fail s = MkTM (debugFunc \"fail\" (Prelude.return undefined));\n                };\n\n        preturn a = MkTM (Prelude.return a);\n\n        fromInteger :: Integer -> Integer;\n        fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times\n\n        fromRational :: Rational -> Rational;\n        fromRational a = a Prelude.+ a Prelude.+ a; -- three times\n\n        negate :: a -> a;\n        negate a = a; -- don't actually negate\n\n        (-) :: a -> a -> a;\n        (-) x y = y; -- changed function\n\n\n        test_do f g = do\n                {\n                f;                              -- >>\n                Just a <- g;    -- >>= (and fail if g returns Nothing)\n                return a;               -- return\n                };\n\n        test_fromInteger = 27;\n\n        test_fromRational = 31.5;\n\n        test_negate a = - a;\n\n        test_fromInteger_pattern a@1 = \"1=\" ++ (Prelude.show a);\n        test_fromInteger_pattern a@(-2) = \"(-2)=\" ++ (Prelude.show a);\n        test_fromInteger_pattern (a + 7) = \"(a + 7)=\" ++ Prelude.show a;\n\n        test_fromRational_pattern a@0.5 = \"0.5=\" ++ (Prelude.show a);\n        test_fromRational_pattern a@(-0.7) = \"(-0.7)=\" ++ (Prelude.show a);\n        test_fromRational_pattern a = \"_=\" ++ (Prelude.show a);\n\n        tmPutStrLn s = MkTM (putStrLn s);\n\n        doTest :: String -> TM a -> IO ();\n        doTest s ioa =\n                (putStrLn (\"start test \" ++ s))\n                        Prelude.>>\n                (unTM ioa)\n                        Prelude.>>\n                (putStrLn (\"end test \" ++ s));\n\n        main :: IO ();\n        main =\n                (doTest \"test_do failure\"\n                        (test_do (preturn ()) (preturn Nothing))\n                )\n                        Prelude.>>\n                (doTest \"test_do success\"\n                        (test_do (preturn ()) (preturn (Just ())))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger\"\n                        (tmPutStrLn (Prelude.show test_fromInteger)) -- 27 * 5 = 135\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational\"\n                        (tmPutStrLn (Prelude.show test_fromRational)) -- 31.5 * 3 = 189%2\n                )\n                        Prelude.>>\n                (doTest \"test_negate\"\n                        (tmPutStrLn (Prelude.show (test_negate 3))) -- 3 * 5 = 15, non-negate\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 1\"\n                        (tmPutStrLn (test_fromInteger_pattern 1)) -- 1 * 5 = 5, matches \"1\"\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern (-2)\"\n                        (tmPutStrLn (test_fromInteger_pattern (-2))) -- \"-2\" = 2 * 5 = 10\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 9\"\n                        (tmPutStrLn (test_fromInteger_pattern 9)) -- \"9\" = 45, 45 \"-\" \"7\" = \"7\" = 35\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 0.5\"\n                        (tmPutStrLn (test_fromRational_pattern 0.5)) -- \"0.5\" = 3%2\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern (-0.7)\"\n                        (tmPutStrLn (test_fromRational_pattern (-0.7))) -- \"-0.7\" = \"0.7\" = 21%10\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 1.7\"\n                        (tmPutStrLn (test_fromRational_pattern 1.7)) -- \"1.7\" = 51%10\n                );\n        }\n", "num_lines": 134}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}\n{-# OPTIONS -Wno-error=missing-monadfail-instances #-}\n\nmodule Main where\n        {\n--      import Prelude;\n        import qualified Prelude;\n        import Prelude(String,undefined,Maybe(..),IO,putStrLn,\n                Integer,(++),Rational, (==), (>=) );\n\n        debugFunc :: String -> IO a -> IO a;\n        debugFunc s ioa = (putStrLn (\"++ \" ++ s)) Prelude.>>\n                (ioa Prelude.>>= (\\a ->\n                        (putStrLn (\"-- \" ++ s)) Prelude.>> (Prelude.return a)\n                ));\n\n        return :: a -> IO a;\n        return a = debugFunc \"return\" (Prelude.return a);\n\n        infixl 1 >>=;\n        (>>=) :: IO a -> (a -> IO b) -> IO b;\n        (>>=) ma amb = debugFunc \">>=\" ((Prelude.>>=) ma amb);\n\n        infixl 1 >>;\n        (>>) :: IO a -> IO b -> IO b;\n        (>>) ma mb = debugFunc \">>\" ((Prelude.>>) ma mb);\n\n        fail :: String -> IO a;\n        fail s = debugFunc \"fail\" (Prelude.return undefined);\n--      fail s = debugFunc \"fail\" (Prelude.fail s);\n\n        fromInteger :: Integer -> Integer;\n        fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times\n\n        fromRational :: Rational -> Rational;\n        fromRational a = a Prelude.+ a Prelude.+ a; -- three times\n\n        negate :: a -> a;\n        negate a = a; -- don't actually negate\n\n        (-) :: a -> a -> a;\n        (-) x y = y; -- changed function\n\n\n        test_do f g = do\n                {\n                f;                              -- >>\n                Just a <- g;    -- >>= (and fail if g returns Nothing)\n                return a;               -- return\n                };\n\n        test_fromInteger = 27;\n\n        test_fromRational = 31.5;\n\n        test_negate a = - a;\n\n        test_fromInteger_pattern a@1 = \"1=\" ++ (Prelude.show a);\n        test_fromInteger_pattern a@(-2) = \"(-2)=\" ++ (Prelude.show a);\n        test_fromInteger_pattern (a + 7) = \"(a + 7)=\" ++ Prelude.show a;\n\n        test_fromRational_pattern a@0.5 = \"0.5=\" ++ (Prelude.show a);\n        test_fromRational_pattern a@(-0.7) = \"(-0.7)=\" ++ (Prelude.show a);\n        test_fromRational_pattern a = \"_=\" ++ (Prelude.show a);\n\n\n        doTest :: String -> IO a -> IO ();\n        doTest s ioa =\n                (putStrLn (\"start test \" ++ s))\n                        Prelude.>>\n                ioa\n                        Prelude.>>\n                (putStrLn (\"end test \" ++ s));\n\n        main :: IO ();\n        main =\n                (doTest \"test_do failure\"\n                        (test_do (Prelude.return ()) (Prelude.return Nothing))\n                )\n                        Prelude.>>\n                (doTest \"test_do success\"\n                        (test_do (Prelude.return ()) (Prelude.return (Just ())))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger\"\n                        (putStrLn (Prelude.show test_fromInteger))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational\"\n                        (putStrLn (Prelude.show test_fromRational))\n                )\n                        Prelude.>>\n                (doTest \"test_negate\"\n                        (putStrLn (Prelude.show (test_negate 3)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 1\"\n                        (putStrLn (test_fromInteger_pattern 1))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern (-2)\"\n                        (putStrLn (test_fromInteger_pattern (-2)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 9\"\n                        (putStrLn (test_fromInteger_pattern 9))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 0.5\"\n                        (putStrLn (test_fromRational_pattern 0.5))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern (-0.7)\"\n                        (putStrLn (test_fromRational_pattern (-0.7)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 1.7\"\n                        (putStrLn (test_fromRational_pattern 1.7))\n                );\n        }\n", "num_lines": 121}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}\n{-# OPTIONS -Wno-error=missing-monadfail-instances #-}\n\nmodule Main where\n        {\n--      import Prelude;\n        import qualified Prelude;\n        import Prelude(String,undefined,Maybe(..),IO,putStrLn,\n                Integer,(++),Rational, (==), (>=) );\n\n        debugFunc :: String -> IO a -> IO a;\n        debugFunc s ioa = (putStrLn (\"++ \" ++ s)) Prelude.>>\n                (ioa Prelude.>>= (\\a ->\n                        (putStrLn (\"-- \" ++ s)) Prelude.>> (Prelude.return a)\n                ));\n\n        infixl 1 >>=;\n        infixl 1 >>;\n\n        class MyMonad m where\n                {\n                return :: a -> m a;\n                (>>=) :: m a -> (a -> m b) -> m b;\n                (>>) :: m a -> m b -> m b;\n                fail :: String -> m a;\n                };\n\n        instance MyMonad IO where\n                {\n                return a = debugFunc \"return\" (Prelude.return a);\n\n                (>>=) ma amb = debugFunc \">>=\" ((Prelude.>>=) ma amb);\n\n                (>>) ma mb = debugFunc \">>\" ((Prelude.>>) ma mb);\n\n                fail s = debugFunc \"fail\" (Prelude.return undefined);\n        --      fail s = debugFunc \"fail\" (Prelude.fail s);\n                };\n\n        fromInteger :: Integer -> Integer;\n        fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times\n\n        fromRational :: Rational -> Rational;\n        fromRational a = a Prelude.+ a Prelude.+ a; -- three times\n\n        negate :: a -> a;\n        negate a = a; -- don't actually negate\n\n        (-) :: a -> a -> a;\n        (-) x y = y; -- changed function\n\n\n        test_do f g = do\n                {\n                f;                              -- >>\n                Just a <- g;    -- >>= (and fail if g returns Nothing)\n                return a;               -- return\n                };\n\n        test_fromInteger = 27;\n\n        test_fromRational = 31.5;\n\n        test_negate a = - a;\n\n        test_fromInteger_pattern a@1 = \"1=\" ++ (Prelude.show a);\n        test_fromInteger_pattern a@(-2) = \"(-2)=\" ++ (Prelude.show a);\n        test_fromInteger_pattern (a + 7) = \"(a + 7)=\" ++ Prelude.show a;\n\n        test_fromRational_pattern a@0.5 = \"0.5=\" ++ (Prelude.show a);\n        test_fromRational_pattern a@(-0.7) = \"(-0.7)=\" ++ (Prelude.show a);\n        test_fromRational_pattern a = \"_=\" ++ (Prelude.show a);\n\n\n        doTest :: String -> IO a -> IO ();\n        doTest s ioa =\n                (putStrLn (\"start test \" ++ s))\n                        Prelude.>>\n                ioa\n                        Prelude.>>\n                (putStrLn (\"end test \" ++ s));\n\n        main :: IO ();\n        main =\n                (doTest \"test_do failure\"\n                        (test_do (Prelude.return ()) (Prelude.return Nothing))\n                )\n                        Prelude.>>\n                (doTest \"test_do success\"\n                        (test_do (Prelude.return ()) (Prelude.return (Just ())))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger\"\n                        (putStrLn (Prelude.show test_fromInteger))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational\"\n                        (putStrLn (Prelude.show test_fromRational))\n                )\n                        Prelude.>>\n                (doTest \"test_negate\"\n                        (putStrLn (Prelude.show (test_negate 3)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 1\"\n                        (putStrLn (test_fromInteger_pattern 1))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern (-2)\"\n                        (putStrLn (test_fromInteger_pattern (-2)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 9\"\n                        (putStrLn (test_fromInteger_pattern 9))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 0.5\"\n                        (putStrLn (test_fromRational_pattern 0.5))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern (-0.7)\"\n                        (putStrLn (test_fromRational_pattern (-0.7)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 1.7\"\n                        (putStrLn (test_fromRational_pattern 1.7))\n                );\n        }\n", "num_lines": 129}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, NPlusKPatterns, FlexibleInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n{-# OPTIONS -Wno-error=missing-monadfail-instances #-}\n\nmodule Main where\n        {\n--      import Prelude;\n        import qualified Prelude;\n        import Prelude(String,undefined,Maybe(..),IO,putStrLn,\n                Integer,(++),Rational, (==), (>=) );\n\n        debugFunc :: String -> IO a -> IO a;\n        debugFunc s ioa = (putStrLn (\"++ \" ++ s)) Prelude.>>\n                (ioa Prelude.>>= (\\a ->\n                        (putStrLn (\"-- \" ++ s)) Prelude.>> (Prelude.return a)\n                ));\n\n        infixl 1 >>=;\n        infixl 1 >>;\n\n        returnIO :: a -> IO a;\n        returnIO = Prelude.return;\n\n        class HasReturn m where\n                {\n                return :: a -> m a;\n                };\n\n        class HasBind m n mn | m n -> mn, m mn -> n where\n                {\n                (>>=) :: m a -> (a -> n b) -> mn b;\n                };\n\n        class HasSeq m n mn | m n -> mn, m mn -> n where\n                {\n                (>>) :: m a -> n b -> mn b;\n                };\n\n        class HasFail m where\n                {\n                fail :: String -> m a;\n                };\n\n        instance HasReturn IO where\n                {\n                return a = debugFunc \"return\" (returnIO a);\n                };\n\n        instance HasBind IO IO IO where\n                {\n                (>>=) ma amb = debugFunc \">>=\" ((Prelude.>>=) ma amb);\n                };\n\n        instance HasSeq IO IO IO where\n                {\n                (>>) ma mb = debugFunc \">>\" ((Prelude.>>) ma mb);\n                };\n\n        instance HasFail IO where\n                {\n                fail s = debugFunc \"fail\" (returnIO undefined);\n        --      fail s = debugFunc \"fail\" (Prelude.fail s);\n                };\n\n        class HasFromInteger a where\n                {\n                fromInteger :: a -> a;\n                };\n\n        instance HasFromInteger Integer where\n                {\n                fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times\n                };\n\n        class HasFromRational a where\n                {\n                fromRational :: a -> a;\n                };\n\n        instance HasFromRational Rational where\n                {\n                fromRational a = a Prelude.+ a Prelude.+ a; -- three times\n                };\n\n        class HasNegate a where\n                {\n                negate :: a -> a;\n                };\n\n        instance HasNegate Integer where\n                {\n                negate a = a; -- don't actually negate\n                };\n\n        instance HasNegate Rational where\n                {\n                negate a = a; -- don't actually negate\n                };\n\n        class HasMinus a where\n                {\n                (-) :: a -> a -> a;\n                };\n\n        instance HasMinus Rational where\n                {\n                (-) x y = y; -- changed function\n                };\n\n        instance HasMinus Integer where\n                {\n                (-) x y = y; -- changed function\n                };\n\n\n        test_do f g = do\n                {\n                f;                              -- >>\n                Just a <- g;    -- >>= (and fail if g returns Nothing)\n                return a;               -- return\n                };\n\n        test_fromInteger :: Integer;\n        test_fromInteger = 27;\n\n        test_fromRational :: Rational;\n        test_fromRational = 31.5;\n\n        test_negate :: Integer -> Integer;\n        test_negate a = - a;\n\n        test_fromInteger_pattern :: Integer -> String;\n        test_fromInteger_pattern a@1 = \"1=\" ++ (Prelude.show a);\n        test_fromInteger_pattern a@(-2) = \"(-2)=\" ++ (Prelude.show a);\n        test_fromInteger_pattern (a + 7) = \"(a + 7)=\" ++ Prelude.show a;\n\n        test_fromRational_pattern :: Rational -> String;\n        test_fromRational_pattern a@0.5 = \"0.5=\" ++ (Prelude.show a);\n        test_fromRational_pattern a@(-0.7) = \"(-0.7)=\" ++ (Prelude.show a);\n        test_fromRational_pattern a = \"_=\" ++ (Prelude.show a);\n\n\n        doTest :: String -> IO a -> IO ();\n        doTest s ioa =\n                (putStrLn (\"start test \" ++ s))\n                        Prelude.>>\n                ioa\n                        Prelude.>>\n                (putStrLn (\"end test \" ++ s));\n\n        main :: IO ();\n        main =\n                (doTest \"test_do failure\"\n                        (test_do (returnIO ()) (returnIO Nothing))\n                )\n                        Prelude.>>\n                (doTest \"test_do success\"\n                        (test_do (returnIO ()) (returnIO (Just ())))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger\"\n                        (putStrLn (Prelude.show test_fromInteger))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational\"\n                        (putStrLn (Prelude.show test_fromRational))\n                )\n                        Prelude.>>\n                (doTest \"test_negate\"\n                        (putStrLn (Prelude.show (test_negate 3)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 1\"\n                        (putStrLn (test_fromInteger_pattern 1))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern (-2)\"\n                        (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 9\"\n                        (putStrLn (test_fromInteger_pattern 9))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 0.5\"\n                        (putStrLn (test_fromRational_pattern 0.5))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern (-0.7)\"\n                        (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 1.7\"\n                        (putStrLn (test_fromRational_pattern 1.7))\n                )\n           ;\n        }\n", "num_lines": 198}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\n{-# LANGUAGE NPlusKPatterns #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Main where\n        {\n        import qualified Prelude;\n        import Prelude(String,undefined,Maybe(..),IO,putStrLn,\n                Integer,(++),Rational, (==), (>=) );\n\n        debugFunc :: String -> IO a -> IO a;\n        debugFunc s ioa = (putStrLn (\"++ \" ++ s)) Prelude.>>\n                (ioa Prelude.>>= (\\a ->\n                        (putStrLn (\"-- \" ++ s)) Prelude.>> (Prelude.return a)\n                ));\n\n        infixl 1 >>=;\n        infixl 1 >>;\n\n        returnIO :: a -> IO a;\n        returnIO = Prelude.return;\n\n        class HasReturn a where\n                {\n                return :: a;\n                };\n\n        class HasBind a where\n                {\n                (>>=) :: a;\n                };\n\n        class HasSeq a where\n                {\n                (>>) :: a;\n                };\n\n        class HasFail a where\n                {\n                fail :: a;\n                };\n\n        instance HasReturn (a -> IO a) where\n                {\n                return a = debugFunc \"return\" (Prelude.return a);\n                };\n\n        instance HasBind (IO a -> (a -> IO b) -> IO b) where\n                {\n                (>>=) ma amb = debugFunc \">>=\" ((Prelude.>>=) ma amb);\n                };\n\n        instance HasSeq (IO a -> IO b -> IO b) where\n                {\n                (>>) ma mb = debugFunc \">>\" ((Prelude.>>) ma mb);\n                };\n\n        instance HasFail (String -> IO a) where\n                {\n                fail s = debugFunc \"fail\" (Prelude.return undefined);\n        --      fail s = debugFunc \"fail\" (Prelude.fail s);\n                };\n\n        class HasFromInteger a where\n                {\n                fromInteger :: a;\n                };\n\n        instance HasFromInteger (Integer -> Integer) where\n                {\n                fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times\n                };\n\n        class HasFromRational a where\n                {\n                fromRational :: a;\n                };\n\n        instance HasFromRational (Rational -> Rational) where\n                {\n                fromRational a = a Prelude.+ a Prelude.+ a; -- three times\n                };\n\n        class HasNegate a where\n                {\n                negate :: a;\n                };\n\n        instance (b ~ (a -> a)) => HasNegate b where\n                {\n                negate a = a; -- don't actually negate\n                };\n\n        class HasMinus a where\n                {\n                (-) :: a;\n                };\n\n        instance (b ~ (a -> a -> a)) => HasMinus b where\n                {\n                (-) x y = y; -- changed function\n                };\n\n        test_do :: forall a b. IO a -> IO (Maybe b) -> IO b;\n        test_do f g = do\n                {\n                f;                      -- >>\n                Just (b::b) <- g;       -- >>= (and fail if g returns Nothing)\n                return b;               -- return\n                };\n\n        test_fromInteger :: Integer;\n        test_fromInteger = 27;\n\n        test_fromRational :: Rational;\n        test_fromRational = 31.5;\n\n        test_negate :: Integer -> Integer;\n        test_negate a = - a;\n\n        test_fromInteger_pattern :: Integer -> String;\n        test_fromInteger_pattern a@1 = \"1=\" ++ (Prelude.show a);\n        test_fromInteger_pattern a@(-2) = \"(-2)=\" ++ (Prelude.show a);\n        test_fromInteger_pattern (a + 7) = \"(a + 7)=\" ++ Prelude.show a;\n\n        test_fromRational_pattern :: Rational -> String;\n        test_fromRational_pattern a@0.5 = \"0.5=\" ++ (Prelude.show a);\n        test_fromRational_pattern a@(-0.7) = \"(-0.7)=\" ++ (Prelude.show a);\n        test_fromRational_pattern a = \"_=\" ++ (Prelude.show a);\n\n\n        doTest :: String -> IO a -> IO ();\n        doTest s ioa =\n                (putStrLn (\"start test \" ++ s))\n                        Prelude.>>\n                ioa\n                        Prelude.>>\n                (putStrLn (\"end test \" ++ s));\n\n        main :: IO ();\n        main =\n                (doTest \"test_do failure\"\n                        (test_do (Prelude.return ()) (Prelude.return Nothing))\n                )\n                        Prelude.>>\n                (doTest \"test_do success\"\n                        (test_do (Prelude.return ()) (Prelude.return (Just ())))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger\"\n                        (putStrLn (Prelude.show test_fromInteger))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational\"\n                        (putStrLn (Prelude.show test_fromRational))\n                )\n                        Prelude.>>\n                (doTest \"test_negate\"\n                        (putStrLn (Prelude.show (test_negate 3)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 1\"\n                        (putStrLn (test_fromInteger_pattern 1))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern (-2)\"\n                        (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromInteger_pattern 9\"\n                        (putStrLn (test_fromInteger_pattern 9))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 0.5\"\n                        (putStrLn (test_fromRational_pattern 0.5))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern (-0.7)\"\n                        (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational)))\n                )\n                        Prelude.>>\n                (doTest \"test_fromRational_pattern 1.7\"\n                        (putStrLn (test_fromRational_pattern 1.7))\n                );\n        }\n", "num_lines": 189}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XRebindableSyntax #-}\n\n-- This one tests rebindable syntax for do-notation\n\nmodule Main where\n\nimport qualified Prelude\nimport GHC.Num\nimport GHC.Base hiding( Monad(..) )\n\nclass Foo a where\n  op :: a -> a\n\ndata T a = MkT a\n\ninstance Foo Int where\n  op x = x+1\n\n(>>=) :: Foo a => T a -> (a -> T b) -> T b\n(>>=) (MkT x) f = f (op x)\n\n(>>) :: Foo a => T a -> T b -> T b\n(>>) x y = x >>= (\\_ -> y)\n\nreturn :: Num a => a -> T a\nreturn x = MkT (x+1)\n\nfail :: String -> T a\nfail s = error \"urk\"\n\nt1 :: T Int\nt1 = MkT 4\n\nmyt = do { x <- t1\n         ; return x }\n\nmain = case myt of\n         MkT i -> Prelude.print i\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, MultiParamTypeClasses #-}\n\n-- Trac #1537\n\nmodule Foo where\nimport Prelude hiding (Monad(..))\n\nclass Bind m1 m2 m3 where \n  (>>=) :: m1 a -> (a -> m2 b) -> m3 b\n\nclass Return m where\n  return :: a -> m a\n  fail   :: String -> m a \n\ninstance Bind Maybe [] [] where\n  Just x  >>= f = f x\n  Nothing >>= f = []\n\ninstance Return [] where \n  return x = [x]\n  fail _   = [] \n\nshould_compile :: [Int]\nshould_compile = do \n  a <- Just 1\n  [a] \n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, FlexibleInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- Trac #1537\n\nmodule Foo where\nimport qualified Prelude\nimport Prelude hiding (Monad(..))\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\nnewtype Identity a = Identity { runIdentity :: a }\n\ninstance Prelude.Functor Identity where\n    fmap = liftM\n\ninstance Applicative Identity where\n    pure = Prelude.return\n    (<*>) = ap\n\ninstance Prelude.Monad Identity where\n    return a = Identity a\n    m >>= k  = k (runIdentity m)\n\nclass Bind m1 m2 m3 | m1 m2 -> m3 where \n  (>>=) :: m1 a -> (a -> m2 b) -> m3 b\n\nclass Return m where\n  returnM :: a -> m a\n  fail   :: String -> m a \n\ninstance Bind Maybe [] [] where\n  Just x  >>= f = f x\n  Nothing >>= f = []\n\ninstance              Bind Identity a a   where m >>= f = f (runIdentity m)\ninstance Functor a => Bind a Identity a   where m >>= f = fmap (runIdentity . f) m\n\ninstance Prelude.Monad m => Bind m m m where (>>=) = (Prelude.>>=)\n\ninstance Return [] where \n  returnM x = [x]\n  fail _   = [] \n\nreturn :: a -> Identity a\nreturn = Prelude.return\n\nshould_compile :: [Int]\nshould_compile = do \n  a <- Just 1\n  b <- [a*1,a*2]\n  return (b+1)", "num_lines": 53}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, RebindableSyntax #-}\nmodule T10112 where\n\nimport qualified Prelude as P\n\n(>>=) :: a -> ((forall b . b) -> c) -> c\na >>= f = f P.undefined\nreturn a = a\nfail s = P.undefined\n\nt1 = 'd' >>= (\\_ -> 'k')\n\nt2 = do { _ <- 'd'\n        ; 'k' }\n\nfoo = P.putStrLn [t1, t2]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\n\nmodule Bug where\n\nfoo :: (a, b) -> ()\nfoo x | (_,_) <- x = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\n\nmodule Bug where\n\ndata Maybe a = Just a | Nothing\n\nfoo :: [Maybe a] -> [a]\nfoo xs = [ x | Just x <- xs ]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RebindableSyntax #-}\n\nimport Prelude\n\nclass IfThenElse a b where\n  ifThenElse :: a -> b -> b -> b\n\ninstance IfThenElse Bool b where\n  ifThenElse c x y = if c then x else y\n\ndata Foo = Foo | Bar | Baz deriving (Eq, Ord)\n\nmain :: IO ()\nmain = print $ Foo < Bar\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\n\nmodule Lib where\n\nimport Prelude (IO)\n\npure = undefined\n\nfoo :: IO ()\nfoo = do\n  pure ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\n\n-- Trac #303\n\nmodule T where\nimport qualified Prelude as P\n\nclass IxMonad m where\n    return :: a -> m i i a\n    (>>=) :: m i j a -> (a -> m j k b) -> m i k b\n    (>>)  :: m i j a -> m j k b -> m i k b\n    m >> n = m >>= \\_ -> n\n\n    fail :: P.String -> m i j a\n    fail s = P.error s\n\ndata T a b c = T\ninstance IxMonad T where\n    return _ = T\n    m >>= f  = T\n    fail _   = T\n\ntestM :: T (a,b) b a\ntestM = T\n\ntest1 = testM >>= \\x -> return x\n\ntest2  = do\n   x <- testM\n   return x\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Arrows, RebindableSyntax #-}\nmodule T4851 where\n\nimport Prelude hiding ( id, (.) )\n\nimport Control.Category ( Category(..) )\nimport Control.Arrow\n\ngarbage x =\n  proc b ->\n    do rec (c, d) <- undefined -< (b, d)\n       returnA -< c\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\nmodule Main (main) where\n\nimport Prelude \n\nifThenElse True t f = f\nifThenElse False t f = t\n\nmain = print (if True then 1 else 2 :: Int)\n-- Should print 2!\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n{-# LANGUAGE\n    ExplicitForAll\n  , GADTs\n  , RebindableSyntax #-}\nmodule T5908\n       ( Writer\n       , runWriter\n       , execWriter\n       , WriterT\n       , runWriterT\n       , execWriterT\n       , tell\n       ) where\n\nimport Control.Category (Category (id), (>>>))\n\nimport Prelude hiding (Monad (..), id)\nimport qualified Prelude\n\nnewtype Identity a = Identity { runIdentity :: a }\n\nclass Monad m where\n  (>>=) :: forall e ex x a b . m e ex a -> (a -> m ex x b) -> m e x b\n  (>>) :: forall e ex x a b . m e ex a -> m ex x b -> m e x b\n  return :: a -> m ex ex a\n  fail :: String -> m e x a\n\n  {-# INLINE (>>) #-}\n  m >> k = m >>= \\ _ -> k\n  fail = error\n\ntype Writer w = WriterT w Identity\n\nrunWriter :: Writer w e x a -> (a, w e x)\nrunWriter = runIdentity . runWriterT\n\nexecWriter :: Writer w e x a -> w e x\nexecWriter m = snd (runWriter m)\n\nnewtype WriterT w m e x a = WriterT { runWriterT :: m (a, w e x) }\n\nexecWriterT :: Prelude.Monad m => WriterT w m e x a -> m (w e x)\nexecWriterT m = do\n  ~(_, w) <- runWriterT m\n  return w\n  where\n    (>>=) = (Prelude.>>=)\n    return = Prelude.return\n\ninstance (Category w, Prelude.Monad m) => Monad (WriterT w m) where\n  return a = WriterT $ return (a, id)\n    where\n      return = Prelude.return\n  m >>= k = WriterT $ do\n    ~(a, w) <- runWriterT m\n    ~(b, w') <- runWriterT (k a)\n    return (b, w >>> w')\n    where\n      (>>=) = (Prelude.>>=)\n      return = Prelude.return\n  fail msg = WriterT $ fail msg\n    where\n      fail = Prelude.fail\n\ntell :: (Category w, Prelude.Monad m) => w e x -> WriterT w m e x ()\ntell w = WriterT $ return ((), w)\n  where\n    return = Prelude.return\n\n\n", "num_lines": 73}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule Main where\n\n-- Register Allocator Unit Tests\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n--\n-- This file contains fine-grained tests of the register allocator\n-- (\"regalloc\"), which maps variables onto real machine registers.\n-- These tests require inspection and manipulation\n-- of the register allocator's intermediate data structures.\n--\n-- The tests are enumerated in the \"runTests\" function--each returns a Bool\n-- and runTests simply checks that none returned False.\n-- (currently the only test is testGraphNoSpills--see its comments for\n-- details)\n--\n-- If the tests pass it will print \"All tests passed\", otherwise it will\n-- print which ones failed.\n--\n-- Also note: \"on x86\" means \"as if we were compiling for x86\"--this test\n-- doesn't actually have to run on any particular architecture.\n\nimport qualified RegAlloc.Graph.Stats as Color\nimport qualified RegAlloc.Linear.Base as Linear\nimport qualified X86.Instr\nimport HscMain\nimport CgUtils\nimport AsmCodeGen\nimport CmmBuildInfoTables\nimport CmmPipeline\nimport CmmParse\nimport CmmInfo\nimport Cmm\nimport Module\nimport Debug\nimport GHC\nimport GhcMonad\nimport UniqFM\nimport UniqSupply\nimport DynFlags\nimport ErrUtils\nimport Outputable\nimport BasicTypes\n\nimport Stream (collect, yield)\n\nimport Data.Typeable\nimport Data.Maybe\nimport Control.Monad\nimport Control.Applicative\nimport Control.Exception (Exception, throwIO)\nimport System.Environment\nimport System.IO\n\nmain :: IO ()\nmain = do\n    [libdir] <- getArgs\n\n    --get a GHC context and run the tests\n    runGhc (Just libdir) $ do\n        dflags <- fmap setOptions getDynFlags\n        reifyGhc $ \\_ -> do\n            us <- unitTestUniqSupply\n            runTests dflags us\n\n    return ()\n\n    where setOptions = (flip gopt_set) Opt_RegsGraph\n\n\n-- | TODO: Make this an IORef along the lines of Data.Unique.newUnique to add\n-- stronger guarantees a UniqSupply won't be accidentally reused\nunitTestUniqSupply :: IO UniqSupply\nunitTestUniqSupply = mkSplitUniqSupply 't'\n\n\nnewtype RegAllocTestException = RegAllocTestException String\n            deriving (Show, Typeable)\n\ninstance Exception RegAllocTestException\n\n\n-- | a safer assert in the IO monad\n-- perform some action if the passed Bool is false\nassertOr :: (String -> IO ()) -> String -> Bool -> IO Bool\nassertOr alt msg False = alt msg >> return False\nassertOr _   msg True  = return True\n\n-- | Raise an exception if the passed Bool is false\nassertIO :: String -> Bool -> IO Bool\nassertIO = assertOr $ \\msg -> void (throwIO . RegAllocTestException $ msg)\n\n\n-- | compile the passed cmm file and return the register allocator stats\n-- ***NOTE*** This function sets Opt_D_dump_asm_stats in the passed\n-- DynFlags because it won't work without it.  Handle stderr appropriately.\ncompileCmmForRegAllocStats ::\n    DynFlags ->\n    FilePath ->\n    (DynFlags ->\n        NcgImpl (Alignment, CmmStatics) X86.Instr.Instr X86.Instr.JumpDest) ->\n    UniqSupply ->\n    IO [( Maybe [Color.RegAllocStats (Alignment, CmmStatics) X86.Instr.Instr]\n        , Maybe [Linear.RegAllocStats])]\ncompileCmmForRegAllocStats dflags' cmmFile ncgImplF us = do\n    let ncgImpl = ncgImplF dflags\n    hscEnv <- newHscEnv dflags\n\n    -- parse the cmm file and output any warnings or errors\n    ((warningMsgs, errorMsgs), parsedCmm) <- parseCmmFile dflags cmmFile\n\n    -- print parser errors or warnings\n    mapM_ (printBagOfErrors dflags) [warningMsgs, errorMsgs]\n\n    let initTopSRT = emptySRT thisMod\n    cmmGroup <- fmap snd $ cmmPipeline hscEnv initTopSRT $ fromJust parsedCmm\n\n    rawCmms <- cmmToRawCmm dflags (Stream.yield cmmGroup)\n\n    collectedCmms <- mconcat <$> Stream.collect rawCmms\n\n    -- compile and discard the generated code, returning regalloc stats\n    mapM (\\ (count, thisCmm) ->\n        cmmNativeGen dflags thisMod thisModLoc ncgImpl\n            usb dwarfFileIds dbgMap thisCmm count >>=\n                (\\(_, _, _, _, colorStats, linearStats, _) ->\n                -- scrub unneeded output from cmmNativeGen\n                return (colorStats, linearStats)))\n                $ zip [0.. (length collectedCmms)] collectedCmms\n\n    where\n          --the register allocator's intermediate data\n          --structures are usually discarded\n          --(in AsmCodeGen.cmmNativeGen) for performance\n          --reasons.  To prevent this we need to tell\n          --cmmNativeGen we want them printed out even\n          --though we ignore stderr in the test configuration.\n          dflags = dopt_set dflags' Opt_D_dump_asm_stats\n          [usa, usb, usc, usd] = take 4 . listSplitUniqSupply $ us\n          -- don't need debugging information\n          dwarfFileIds = emptyUFM\n          dbgMap = debugToMap []\n          thisMod = mkModule\n                        (stringToUnitId . show . uniqFromSupply $ usc)\n                        (mkModuleName . show . uniqFromSupply $ usd)\n          thisModLoc = ModLocation Nothing (cmmFile ++ \".hi\") (cmmFile ++ \".o\") (cmmFile ++ \".hie\")\n\n\n-- | The register allocator should be able to see that each variable only\n-- has a dependency on the one before it and that therefore only 1 variable\n-- is live after each computation, no spilling needed.\nnoSpillsCmmFile = \"no_spills.cmm\"\n\n-- | Run each unit test in this file and notify the user of success or\n-- failure.\nrunTests :: DynFlags -> UniqSupply -> IO ()\nrunTests dflags us = testGraphNoSpills dflags noSpillsCmmFile us >>= \\res ->\n                        if res then putStrLn \"All tests passed.\"\n                               else hPutStr stderr \"testGraphNoSpills failed!\"\n\n\n-- | To map an unlimited number of abstract variables to a limited number of\n-- real registers the allocator is sometimes forced to \"spill\" data that\n-- isn't needed for the next instruction from a register into memory.\n-- This is expensive so minimizing spills and reloads is a high priority.\n--\n-- testGraphNoSpills compiles the passed cmm file using the graph coloring\n-- register allocator and asserts that it doesn't contain\n-- any spill instructions.  This (very basic) test is for cases where\n-- the register allocator should be able to do everything\n-- (on x86) in the passed file without any spills or reloads.\n--\ntestGraphNoSpills :: DynFlags -> FilePath -> UniqSupply -> IO Bool\ntestGraphNoSpills dflags' path us = do\n        colorStats <- fst . concatTupledMaybes <$>\n                        compileCmmForRegAllocStats dflags path x86NcgImpl us\n\n        assertIO \"testGraphNoSpills: color stats should not be empty\"\n                        $ not (null colorStats)\n\n        -- spill, reload, and reg-reg moves for the cmm file we just\n        -- compiled\n        let srms = foldr (\\(a, b, c) (x, y, z) ->\n                    (a + x, b + y, c + z)) (0, 0, 0)\n                    . mapMaybe extractSRMs $ colorStats\n\n        assertIO\n                (\"testGraphNoSpills called with \" ++ path\n                    ++ \": (spill, reload, reg-reg) = \" ++ show srms)\n                (matchesExpected srms)\n\n    where concatTupledMaybes :: [( Maybe [a], Maybe [b])] -> ([a], [b])\n          concatTupledMaybes =\n            -- either concat the underlying list or return the accumulator list\n            let acc n = maybe n (++ n) in\n              foldr (\\(as, bs) (xs, ys) -> (acc xs as, acc ys bs)) ([], [])\n\n          dflags = dflags' { optLevel = 2 }\n\n          -- discard irrelevant stats\n          extractSRMs x = case x of\n                                Color.RegAllocStatsColored _ _ _ _ _ _ _ _\n                                    rSrms -> Just rSrms\n                                _ -> Nothing\n\n          matchesExpected (a, b, c) = a == 0 && b == 0\n", "num_lines": 207}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that you can hide a constructor\nmodule ShouldCompile where\n\nimport Rn037Help hiding( C )\n        -- C is the constructor, but we should\n        -- still be able to hide it\n\n-- we should still be able to refer to the type constructor, though\ntype Foo = T\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn037Help( T(C) ) where\n\ndata T = C\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn037Help( T(C) ) where\n\ndata T = C\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that you can hide a constructor\nmodule ShouldCompile where\n\nimport Rn037Help hiding( C )\n        -- C is the constructor, but we should\n        -- still be able to hide it\n\nf x = Rn037Help.C\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A(method) where\nclass Class a where method :: a -> a\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Exporting a class method should not export the class too\nmodule B where\nimport A\nf :: Class a => a -> a\nf = method\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A(foo, Bar(..)) where\n\nfoo :: Bar\nfoo = MkBar 42\n\ndata Bar = MkBar Int\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B(module A) where\n\nimport A hiding (Bar)\nimport A(Bar)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\nimport B\n\nbaz :: Bar\nbaz = foo\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module VersionGraphClient(\n   VersionGraphClient,\n\n   ) where\n\nimport ViewType\n\nnewtype VersionGraphClient = VersionGraphClient Int\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nBug report submitted by George Russell, 1/10/2004:\n\nWith both ghc6.2 and 6.2.20040915 on Linux, ghc --make cannot compile\nthe attached files and produces a confusing error message.\n\n  # ghc --make View.hs\nChasing modules from: View.hs\nCompiling ViewType         ( ./ViewType.hs, ./ViewType.o )\nCompiling VersionGraphClient ( ./VersionGraphClient.hs, ./VersionGraphClient.o )Compiling View             ( View.hs, View.o )\n\nView.hs:14:\n     Couldn't match `VersionGraphClient' against `VersionGraphClient'\n        Expected type: VersionGraphClient\n        Inferred type: VersionGraphClient\n     In the `graphClient1' field of a record\n     In the record construction: View {graphClient1 = graphClient}\n\nHowever ghc without make has no problems.\n\n# ghc -c ViewType.hs\n# ghc -c VersionGraphClient.hs\n# ghc -c View.hs\n-}\n\n-- | This module defines the fundamental structure of the (untyped)\n-- objects in a repository.\n--\n-- We depend circularly on CodedValue.hs.  This module is compiled\n-- first and uses CodedValue.hi-boot.\nmodule View(\n   ) where\n\nimport ViewType\nimport VersionGraphClient\n\ncreateView :: VersionGraphClient -> IO View\ncreateView graphClient =\n   do\n      return (View {\n         graphClient1 = graphClient\n         })\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ViewType(\n\n   View(..),\n   ) where\n\n\nimport {-# SOURCE #-} VersionGraphClient\n\ndata View = View {\n   graphClient1 :: VersionGraphClient\n   }\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A (f, y) where\n\nimport B.C (T(..))\n\nf (T x) = x\n\ny = T 42\n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main, z) where\n\nimport A\n\nmain = print (f y)\n\nz = y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport System.Directory\nimport System.Environment\n\nmain :: IO ()\nmain = do d <- getCurrentDirectory\n          putStr $ concatMap f d\n    where f '\\\\' = \"/\"\n          f c    = [c]\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env runhaskell\n> module Main where\n> import Distribution.Simple\n> main :: IO ()\n> main = defaultMain\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B.C where\n\nnewtype T = T Int\n deriving Show\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-dodgy-imports #-}\nmodule Dodgy where\n\nimport DodgyA (X(..))\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule DodgyA(C(..), X(..)) where\n\nclass C a where\n  data X a\n\ninstance C Int where\n  data X Int = X1 Bool\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeApplications #-}\n\nmodule ExplicitForAllRules1 where\n\nimport Data.Proxy\nimport Data.Kind\n\n-- From Proposal 0007 (w/ fix to \"example\")\n\n{-# RULES\n\"example\"  forall a b. forall. map @a @b f = f\n\"example2\" forall a. forall (x :: a). id x = x\n  #-}\n\n{-# NOINLINE f #-}\nf :: a -> b\nf = undefined\n\n-- More tests\n\n{-# RULES\n\"example3\" forall (a :: Type -> Type) (b :: a Int) c. forall x y. g @(Proxy b) @(Proxy c) x y = ()\n\"example4\" forall (a :: Bool) (b :: Proxy a). forall x. g @(Proxy b) @() x = id @()\n\"example5\" forall (a :: Type). forall. h @a = id @a\n\"example5\" forall k (c :: k). forall (x :: Proxy c). id @(Proxy c) x = x\n  #-}\n\n{-# NOINLINE g #-}\ng :: a -> b -> ()\ng _ _ = ()\n\n{-# NOINLINE h #-}\nh :: a -> a\nh x = x\n\n-- Should NOT have a parse error :(\n{-# RULES \"example6\" forall a forall. g a forall = () #-}\n\n-- Should generate a warning\n{-# RULES \"example7\" forall a b. forall (x :: a). id x = x #-}\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Imp100Aux where\nimport Imp100\n\ndata T1 a \ndata T2 a b \ndata T3 a b c \ndata T4 a b c d \ndata T5 a b c d e \ndata T6 a \ndata T7 a b \ndata T8 a b c \ndata T9 a b c d \ndata T10 a b c d e \n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Imp10Aux where\nimport Imp10\ndata T1 a \ndata T2 a b \ndata T3 a b c \ndata T4 a b c d \ndata T5 a b c d e \ndata T6 a \ndata T7 a b \ndata T8 a b c \ndata T9 a b c d \ndata T10 a b c d e \n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Imp500Aux where\nimport Imp500\n\ndata T1 a \ndata T2 a b \ndata T3 a b c \ndata T4 a b c d \ndata T5 a b c d e \ndata T6 a \ndata T7 a b \ndata T8 a b c \ndata T9 a b c d \ndata T10 a b c d e \n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language NoImplicitPrelude #-}\nmodule LookupSub where\nimport qualified LookupSubA\nimport qualified LookupSubB\n\ndata FD = FD\n\ngetEcho = FD\n\ninstance LookupSubA.IODevice FD where\n  getEcho = getEcho\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module LookupSubA where\n\nclass IODevice a where\n  getEcho :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module LookupSubB where\n\ngetEcho = undefined\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonadComprehensions, TransformListComp #-}\n\n-- Test performed for TransformListComp and should work for monad comp aswell:\n-- GHC 7.0.1 failed because the renamer didn't attach\n-- all the used variables to the TransformListComp constructor\n\nmodule List where\n\nintersectFront :: Ord a => [a] -> [a] -> [a]\nintersectFront xs ys = [x | (x,y) <- zip xs ys, then takeWhile by x == y]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-matches #-}\n{-# LANGUAGE MonadComprehensions, ParallelListComp #-}\n-- Test for parallel list comp should work for monad comp aswell:\n--\n-- GHC 6.4 erroneously reported that the \n-- bindings for q and z were unused\n--\n-- Note the parallel list comprehension,\n-- which was the cause of the trouble\n\nmodule ShouldCompile where\n\nt :: [Int]\nt = [ q | y <- [1..10] \n        | z <- [30..40], let q = z*z]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards, MonadComprehensions, TransformListComp, NamedFieldPuns #-}\n\nmodule T3901 where\n\nimport GHC.Exts (groupWith)\n\ndata Rec = Rec {a :: Int} deriving (Show)\n\nrecs1 = [a | Rec {a=a} <- [Rec 1], then group by a using groupWith]\n\nrecs2 = [a | Rec {a} <- [Rec 1], then group by a using groupWith]\n\nrecs3 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]\n\nrecs4 :: [[Int]]\nrecs4 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE MonadComprehensions, ParallelListComp #-}\n-- Test for parallel list comp, which should work for monad comp as well:\n--\n-- On GHC 6.0 and earlier, this parallel list comprehension generated\n-- an incorrect unused-binding warning.\n\nmodule ShouldCompile where\n\nt :: [(Char,Char)]\nt = [ (a,b) | a <- \"foo\" | b <- \"bar\" ]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo (f) where\n-- export food\nf x = x\n\n-- !!! weird patterns with no variables\n1  = f 1\n[] = f []\n1  = f (f 1)\n[] = f (f [])\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! rn005: simplest case: a few non-recursive bindings\n\nmodule Test where\n\nf = []\ng x = x\nh x y = x\ni x y z = x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! rn006: two sets of mutually-recursive blobs:\n-- !!!  f, g, h are mut rec\n-- !!!  i, j, k are mut rec\n\nmodule Test where\n\nf x = g x x\ni x = j x x\n\ng x y = h x x y\nj x y = k x x y\n\nh x y z = f z\nk x y z = i z\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Imp10 where\nimport {-# SOURCE #-} Imp10Aux\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Imp100 where\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\nimport {-# SOURCE #-} Int10\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Imp100 where\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\nimport {-# SOURCE #-} Imp100Aux\n\n", "num_lines": 102}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Imp500 where\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\nimport {-# SOURCE #-} Imp500Aux\n\n\n", "num_lines": 504}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Mod10 where\n\ndata T1 a = C1 a\n\ndata T2 a b = T2C1 a | T2C2 b\n\ndata T3 a b c = T3C1 a | T3C2 b | T3C3 c\n\ndata T4 a b c d = T4C1 a | T4C2 b | T4C3 c | T4C4 d\n\ndata T5 a b c d e = T5C1 a | T5C2 b | T5C3 c | T5C4 d | T5C5 e\n\ndata T6 a = T6C6 a\n\ndata T7 a b = T7C6 a | T7C7 b\n\ndata T8 a b c = T8C1 a | T8C2 b | T8C3 c\n\ndata T9 a b c d = T9C1 a | T9C2 b | T9C3 c | T9C4 d\n\ndata T10 a b c d e = T10C1 a | T10C2 b | T10C3 c | T10C4 d | T10C5 e\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Rexporting\nmodule Test ( module Test , module RnAux017 ) where\n\nimport {-# SOURCE #-} RnAux017\n\nf x = x\n\ndata Foo = MkFoo\n\nclass FOO a where\n    op :: a -> Int\n\ninstance FOO Foo where\n    op x = 42\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Silly (\n        Data.Array.accum\n  ) where\nimport qualified Data.Array\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate fields in record decls\n\nmodule OK where\n\ndata X = A {a :: Int} | B {a :: Int}\n\nf x = x\n\n-- data Y = V {a :: Int}\n\n-- f y = y\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- this is legal, I think (WDP)\n\nmodule Confused where\n\nimport Prelude hiding (otherwise)\n\notherwise = False\n\nf x | otherwise = 1\n\ng otherwise | otherwise = 2\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! This one is fine in Haskell 1.4\n--\nmodule Foo ( Bar(..) ) where { data Bar = Bar X; data X = Y }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! This is fine in Haskell 1.4\n--\nmodule Foo ( Baz(..) ) where \n\nclass Baz a where\n    opx :: Int -> Bar -> a -> a\n\ndata Bar = Bar X\ndata X = Y\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Re-exporting a module whose contents is partially hidden.\nmodule ShouldCompile ( module Data.List ) where\n\nimport Data.List hiding ( sort )\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that more than imported module can share a local\n-- !!! local alias.\nmodule ShouldCompile where\n\nimport qualified Data.List  as X\nimport qualified Data.Maybe as X\n\nx :: Ord a => [a] -> [a]\nx = X.sort\n\ny :: Maybe a -> Bool\ny = X.isJust\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that an imported module may still have\n-- !!! a local alias without having used 'qualified'.\nmodule ShouldCompile where\n\nimport Data.List  as X\nimport Data.Maybe as X\n\nx :: Ord a => [a] -> [a]\nx = X.sort\n\ny :: Maybe a -> Bool\ny = X.isJust\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that a toplevel declaration 'f' in module M is accessible\n-- !!! as both 'f' and 'M.f' within the scope of M. Similarly for imported\n-- !!! entities.\nmodule ShouldCompile where\n\nimport Data.List ( sort )\n\nx :: Int\nx = 2\n\ny :: Int\ny = x\n\nz :: Int\nz = ShouldCompile.x\n\nsortOf :: Ord a=> [a] -> [a]\nsortOf = Data.List.sort\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that lazy name clashing works.\nmodule ShouldCompile where\n\nimport Data.List ( reverse, sort )\n\nsort :: Int     -- Clashes with Data.List.sort,\nsort = 4        -- but never used, so OK\n\n\nreverse :: Int  -- Clashes with Data.List.reverse,\nreverse = 3     -- but the only uses are qualified\n\nx = ShouldCompile.reverse\n\ny = Data.List.reverse\n\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that an imported module may still have\n-- !!! a local alias without having used 'qualified'.\nmodule ShouldCompile where\n\nimport Data.List  as X\nimport Data.Maybe as X\n\nx :: Ord a => [a] -> [a]\nx = X.sort\n\ny :: Maybe a -> Bool\ny = isJust\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that a toplevel declaration 'f' in module M is accessible\n-- !!! as both 'f' and 'M.f' within the scope of M. Similarly for imported\n-- !!! entities.\nmodule ShouldCompile where\n\nimport Data.List ( sort )\n\nx :: Int\nx = 2\n\ny :: Int\ny = x\n\nz :: Int\nz = ShouldCompile.x\n\nsortOf :: Ord a=> [a] -> [a]\nsortOf = Data.List.sort\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that lazy name clashing works\nmodule ShouldCompile where\n\nimport Data.List ( sort )\n\nsort :: Int\nsort = 3\n\nfoo :: Int\nfoo = ShouldCompile.sort\n\nbaz :: (Ord a) => [a] -> [a]\nbaz = Data.List.sort\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that empty declarations are permitted.\nmodule ShouldCompile where\n\n\nclass Foo a where\n\nclass Foz a\n\nx = 2 where \ny = 3\n\ninstance Foo Int where\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking what's legal in the body of a class declaration.\nmodule ShouldCompile where\n\nclass Foo a where {\n  (--<>--) :: a -> a -> Int  ;\n  infixl 5 --<>-- ;\n  (--<>--) _ _ = 2 ; -- empty decl at the end.\n};\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that qualified method names are legal in instance body.\n--     but not (now -- Aug 02) in the binding position\nmodule ShouldCompile where\n\nimport Prelude hiding (Eq, (==))\nimport Prelude as P (Eq,(==))\n\ndata Foo = Foo Int Integer\n\ninstance P.Eq Foo where\n  (Foo a1 b1) == (Foo a2 b2) = a1 P.== a2 && b1 P.== b2\n\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-unused-imports #-}\n-- !!! test unused import warning\nimport Data.List\nmain = return () :: IO ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-name-shadowing #-}\nmodule ShouldCompile where\n\n-- !!! test shadowing of a global name\n\ng = 42 where f -1 = -1  -- shadows (-), probably by accident!\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-unused-binds #-}\nmodule ShouldCompile where\n\n-- !!! should produce warnings about unused identifiers\nx :: [()]\nx = [ () | y <- [] ]\n\nz = do w <- getContents; return ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-unused-binds #-}\n\n-- Test reports of unused bindings\n\nmodule ShouldCompile( t ) where\n\nf x = f x       -- Unused\n\ng x = h x       -- Unused\nh x = g x\n\nt x = t x       -- Used by export list\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Record field selectors imported alone; should be ok\n\nmodule M where \n\nimport Rn042_A( field )\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn042_A( Type(..) ) where \n\ndata Type a = Constr { field :: a }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one should succeed; M.x is unambiguous\n\nmodule ShouldCompile (module M) where\n\n import Rn043_A as M    -- x, M.x\n import Rn043_B         -- x, Rn043_A.x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn043_A where\n\nx = True\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn043_B where\n\nx = 'x'\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one should succeed; x is unambiguous, even\n-- though M.x is not\n\nmodule ShouldCompile (module M) where\n\nimport qualified Rn044_A as M  -- M.x\nimport Rn044_B as M            -- x, M.x\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn044_A where\n\nx = True\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn044_B where\n\nx = 'x'\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE ParallelListComp #-}\n-- On GHC 6.0 and earlier, this parallel list comprehension generated\n-- an incorrect unused-binding warning.\n\nmodule ShouldCompile where\n\nt :: [(Char,Char)]\nt = [ (a,b) | a <- \"foo\" | b <- \"bar\" ]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldCompile where\nimport Data.List (nub) -- all unused\nimport Data.Char (ord, chr)  -- some unused\n\nx = chr 42\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-matches #-}\n{-# LANGUAGE ParallelListComp #-}\n-- GHC 6.4 erroneously reported that the \n-- bindings for q and z were unused\n--\n-- Note the parallel list comprehension,\n-- which was the cause of the trouble\n\nmodule ShouldCompile where\n\nt :: [Int]\nt = [ q | y <- [1..10] \n        | z <- [30..40], let q = z*z]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -W #-}\n-- Produced a bogus unused-import warning in versions of GHC 6.6 \n\nmodule Bug ( Structure (..) ) where\n\nimport Prelude hiding( Rational )\n   -- Rational is exported by Prelude\nimport Data.Ratio ( Rational )\n\ndata Structure a where\n   StructCons  :: Int   -> Structure Int\n   StructRatio ::          Structure Rational\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- GHC 6.4.1 said\n--  test.hs:1:5:\n--     Warning: accepting non-standard pattern guards\n--              (-fglasgow-exts to suppress this message)\n--         [x <- ((1 * 2) + 3) * 4, undefined]\n-- Note the wrongly-parenthesised expression\n\n{-# LANGUAGE Haskell98 #-}\n\nmodule ShouldCompile where\n\nmain | x <- 1*2+3*4 = x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-warnings-deprecations #-}\n\n-- Test deprecation of constructors and class ops\n\nmodule ShouldCompile where\n\nimport Rn050_A\n\ninstance Foo T where\n  op x  = x\n  bop y = y\n\nfoo = op C\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn050_A where\n\n{-# DEPRECATED C \"Use D instead\" #-}\n{-# DEPRECATED op \"Use bop instead\" #-}\n\ndata T = C | D\n\nclass Foo a where\n  op :: a -> a\n  bop :: a -> a\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XNoImplicitPrelude #-}\n\n-- This one crashed GHC 6.6 in lookupDeprec\n-- See Trac #1128\n-- and Note [Used names with interface not loaded]\n-- in RnNames\n\nmodule ShouldCompile where\n\nimport Prelude\n\nfoo :: Int -> Float\nfoo x = 3.0\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn052 where\n\nimport qualified Rn052Aux\n\ndata D = D\n\ninstance Rn052Aux.C D where\n    f _ = True\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn052Aux where\n\nclass C a where\n    f :: a -> Bool\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn053 (D(C1, C2)) where\n\nimport qualified Rn053_A\nimport           Rn053_A hiding (D(..))\nimport           Rn053_B\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn053_A where\n\ndata D = C1 | C2\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn053_B where\n\ndata D = C1 | C2\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn054 where\n\nimport Data.Bits (shiftL)\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-implicit-prelude -fwarn-unused-imports #-}\nmodule ShouldCompile where\n\n-- !!! should produce warnings about implicitly imported Prelude\n--     (but not about the implicit import being unused)\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-implicit-prelude -fwarn-unused-imports #-}\nmodule ShouldCompile where\n\nimport Prelude ()\n\n-- !!! should produce no warnings\n--     (the other use of importing nothing is\n--     to nullify the implicit import of the Prelude)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-implicit-prelude #-}\n{-# LANGUAGE NoImplicitPrelude #-}\nmodule ShouldCompile where\n\n-- !!! should produce no warning\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# OPTIONS_GHC -fwarn-unused-imports #-}\n\n-- Trac #1386\n-- We do not want a warning about unused imports\n\nmodule Foo () where\n\nimport Control.Monad (liftM)\n\nfoo :: IO ()\nfoo = id `liftM` return ()\n\nforeign export ccall \"hs_foo\" foo :: IO ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XDisambiguateRecordFields #-}\n\nmodule Foo () where\n\nimport Rn059_A\nimport Rn059_B\n\na = A { label = 'a' }\n\nb = B { label = 'b' }\n\nf (A { label = a }) (B { label = b }) = (a,b)\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn059_A where\n\ndata A = A { label :: Char }\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn059_B where\n\ndata B = B { label :: Char }\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo (module Data.List) where\n\nimport Data.List\nimport Data.List as Foo\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo (module Prelude) where\n\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2055\n\nmodule Foo where\n\nimport qualified Data.List\n\nfoo genericReplicate = genericReplicate True\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Foo where\n\n-- We should complain that both x and y are unused.\n-- We used to not warn for recursive bindings, like x (trac #2136).\n\nv :: a\nv = let x = x in undefined\n\nw :: a\nw = let y = 'a' in undefined\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Foo where\n\n-- We should complain that the first r shadows the second one, and give\n-- the right locations for the two of them. (trac #2137)\n\nz :: a\nz = r\n    where\n        _a = 'a'\n        _f r = r\n        _b = 'b'\n        r = undefined\n        _c = 'c'\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE RecordWildCards #-}\n\n-- trac #1491\n\nmodule Foo where\n\nimport Rn065A\n\nf T{..} = a + 1\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Rn065A where\n\ndata T = T { a :: Int }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-warnings-deprecations #-}\n\n-- Test warnings on constructors and class ops\n\nmodule ShouldCompile where\n\nimport Rn066_A\n\ninstance Foo T where\n  op x  = x\n  bop y = y\n\nfoo = op C\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn066_A where\n\n{-# WARNING C \"Are you sure you want to do that?\" #-}\n{-# WARNING op \"Is that really a good idea?\" #-}\n\ndata T = C | D\n\nclass Foo a where\n  op :: a -> a\n  bop :: a -> a\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\nimport Rn067_A\n\nx = 'a'\n\n-- The use of x here should not be reported as ambiguous, as it refers\n-- to the local variable.\n--\n-- hugs Sept 2006 says:\n--\n-- ERROR \"rn067.hs\":14 - Ambiguous variable occurrence \"x\"\ntest = let x = \"\" in x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rn067_A where\n\nx = True\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\ndata A = A1 { a, b :: Int }\n       | A2 { a, b :: Int }\n       | A3 { a, b :: Int }\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module RnAux017 where\nimport Test     -- Import main module so there really is a loop\n                -- (avoid warning message)\ndata Wibble = Wibble\ndata Wobble = Wobble\n\na :: Int -> Int\na = undefined\n\nb :: Int -> Int\nb = undefined\n\nc :: Int -> Int\nc = undefined\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n{-# OPTIONS_GHC -Wall -Wno-name-shadowing #-}\n\nmodule T10625 where\n\ndata Ex a = forall a. Ex a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo (Monad(..)) where\n\nimport Prelude (Monad((>>=), return))\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, TypeFamilies #-}\nmodule T10816 where\n\nclass C a where\n  type a # b\n  infix 4 #\n\n  type a *** b\n  type a +++ b\n  infixr 5 ***, +++\n  (***), (+++) :: a -> a -> a\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11164 where\n\nimport T11164b (T)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T11164a where\n\ndata family T a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T11164b where\n\nimport T11164a\n\ndata instance T Int = MkT\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11167 where\n\ndata SomeException\n\nnewtype ContT r m a = ContT {runContT :: (a -> m r) -> m r}\n\nrunContT' :: ContT r m a -> (a -> m r) -> m r\nrunContT' = runContT\n\ncatch_ :: IO a -> (SomeException -> IO a) -> IO a\ncatch_ = undefined\n\nfoo :: IO ()\nfoo = (undefined :: ContT () IO a)\n        `runContT` (undefined :: a -> IO ())\n        `catch_` (undefined :: SomeException -> IO ())\n\nfoo' :: IO ()\nfoo' = (undefined :: ContT () IO a)\n         `runContT'` (undefined :: a -> IO ())\n         `catch_` (undefined :: SomeException -> IO ())\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule T11167_ambig where\n\ndata SomeException\n\nnewtype ContT r m a = ContT {runContT :: (a -> m r) -> m r}\nnewtype ContT' r m a = ContT' {runContT :: (a -> m r) -> m r}\n\nrunContT' :: ContT r m a -> (a -> m r) -> m r\nrunContT' = runContT\n\ncatch_ :: IO a -> (SomeException -> IO a) -> IO a\ncatch_ = undefined\n\nfoo :: IO ()\nfoo = (undefined :: ContT () IO a)\n        `runContT` (undefined :: a -> IO ())\n        `catch_` (undefined :: SomeException -> IO ())\n\nfoo' :: IO ()\nfoo' = (undefined :: ContT () IO a)\n         `runContT'` (undefined :: a -> IO ())\n         `catch_` (undefined :: SomeException -> IO ())\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11624 where\nimport T11624a\nconcat :: Int -> Int\nconcat n = n + 2\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11624a where\nimport {-# SOURCE #-} T11624\nimport Prelude ()\nx = concat 3\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\nmodule T11662 where\n\nimport T11662_A (Rec (Rec))\nimport qualified T11662_A\n\ng :: Rec -> Integer\ng (Rec { T11662_A.f }) = f\n\nh :: Integer -> Rec -> Rec\nh f r = r { T11662_A.f }\n\nk :: Integer -> Rec\nk f = Rec { T11662_A.f }\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11662_A where\n\ndata Rec = Rec { f :: Integer }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12127 where\n\nimport T12127a( T(..), C(..) )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T12127a where\n\nclass C a where\n  data T a\n\ninstance C Int where\n  data T Int = MkT { x, y :: Int }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, DefaultSignatures #-}\n\nmodule T12533 where\n\nclass Foo x where\n  foo :: forall a . x a -> x a\n  default foo :: forall a . x a -> x a\n  foo x = go\n    where go :: x a\n          go = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wunused-binds #-}\n{-# LANGUAGE PatternSynonyms #-}\n\nmodule Foo (pattern P) where\n\n-- x is used!!\nx :: Int\nx = 0\n\npattern P :: Int\npattern P <- _ where\n        P = x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wmissing-signatures #-}\n\nmodule T12597 where\n\nf x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wunused-imports #-}\nmodule T13064 where\n\nimport Control.Applicative\nimport Prelude (IO, pure)   -- Import of 'pure' is redundant\n\nfoo :: IO ()\nfoo = () <$ pure ()\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug where\n\nnewtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }\n\nfoo bar baz = (`runContT` bar.baz)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE BangPatterns #-}\n\nmodule T13646 where\n\nimport Control.Exception\n\nfoo :: IO ()\nfoo = do let !() = assert False ()\n             -- Should not give a warning\n\n         let () = assert False ()\n             -- Should give a warning\n\n         pure ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14487 where\n\nimport T14487A hiding (duplicateName)\n\ntest = X duplicateName\n\nduplicateName = 5\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n\nmodule T14487A where\n\ndata X = X {\n    duplicateName :: Int\n}\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, DisambiguateRecordFields #-}\n\nmodule T14747 where\n\nimport T14747A\n\npattern T{x} = [x]\n\ne = S { x = 42 }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n\nmodule T14747A where\n\npattern S{x} = [x]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14881 where\n\nimport qualified T14881Aux as Aux (L(Cons), x, tail, adjust, length)\n\nx = Aux.Cons\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14881Aux where\n\n-- unambiguous function name.\nadjust :: ()\nadjust = undefined\n\n-- ambiguous function name.\nlength :: ()\nlength = undefined\n\ndata L = Cons { x :: Int      -- unambiguous field selector\n              , tail :: [Int] -- ambiguous field selector\n              }\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DisambiguateRecordFields #-}\nmodule Main where\nimport T15149B\nimport T15149C\nmain = do print (AnDouble{an=1}, AnInt{an=1})\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T15149A where\n\nimport Data.Kind (Type)\n\ndata family An c :: Type\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T15149B where\nimport T15149A\ndata instance An Int = AnInt {an :: Int} deriving Show\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T15149C where\nimport T15149A\ndata instance An Double = AnDouble {an :: Double} deriving Show\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DerivingStrategies #-}\n\n{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}\n\nmodule T15798a () where\n\ndata Foo a = Foo a\n  deriving stock (Eq)\n\ndata Bar a = Bar a\n  deriving (Eq, Show)\n  deriving stock (Ord)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n\n{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}\n\nmodule T15798b () where\n\ndata Foo a = Foo a\n\nderiving instance Eq a => Eq (Foo a)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}\n\nmodule T15798c () where\n\ndata Foo a = Foo a\n  deriving (Eq)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE NamedFieldPuns #-}\nmodule T15957 where\n\ndata P = P { x :: Int, y :: Int }\n\ng1 P{..} = x + 3 -- x from .. is used\ng2 P{x, ..} = x + y -- y from .. is used, even if it's in a weird style\n\nold P{..} | x < 5 = 10\n\n-- Record wildcards in lets have different scoping rules.. they bring\n-- all the identifiers into scope\ndo_example :: IO Int\ndo_example = do\n  let P{..} = P 1 2\n  return $ x + y\n\nlet_in_example =\n  let P{..} = P 1 2\n  in x + 4\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15994 where\n\nimport System.IO\n\nf = [ReadMode, ReadMode]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16616a where\n\nclass C a where\n  type T a b\n\ninstance C (Maybe a) where\n  type forall b. T (Maybe a) b = Either a b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-missing-import-lists #-}\n\n-- Test Trac #1789\nmodule T1789 where\n\nimport Prelude\nimport Data.Map\nimport Data.Map (size)\nimport Data.Maybe (Maybe(..))\nimport Data.Maybe hiding (isJust)\nimport qualified Data.Set as Set", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-missing-import-lists #-}\n\n-- Test Trac #1789\nmodule T1789_2 where\n\nimport Data.Map (size)\nimport Data.Maybe (Maybe(Just, Nothing))\nimport qualified Data.Set as Set (insert)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T1792_imports (B.putStr, z, zipWith) where\n\nimport qualified Data.ByteString as B (putStr, readFile, zip, zipWith)\n\nz = B.readFile\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-top-binds #-}\n\n-- Trac #17\n\nmodule Temp (foo, bar, quux) where\n\ntop :: Int\ntop = 1\n\nfoo :: ()\nfoo = let True = True in ()\n\nbar :: Int -> Int\nbar match = 1\n\nquux :: Int\nquux = let local = True\n       in 2\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-local-binds #-}\n\n-- Trac #17\n\nmodule Temp (foo, bar, quux) where\n\ntop :: Int\ntop = 1\n\nfoo :: ()\nfoo = let True = True in ()\n\nbar :: Int -> Int\nbar match = 1\n\nquux :: Int\nquux = let local = True\n       in 2\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-pattern-binds #-}\n\n-- Trac #17\n\nmodule Temp (foo, bar, quux) where\n\ntop :: Int\ntop = 1\n\nfoo :: ()\nfoo = let True = True in ()\n\nbar :: Int -> Int\nbar match = 1\n\nquux :: Int\nquux = let local = True\n       in 2\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-matches #-}\n\n-- Trac #17\n\nmodule Temp (foo, bar, quux) where\n\ntop :: Int\ntop = 1\n\nfoo :: ()\nfoo = let True = True in ()\n\nbar :: Int -> Int\nbar match = 1\n\nquux :: Int\nquux = let local = True\n       in 2\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-binds #-}\n\n-- Trac #17\n\nmodule Temp (foo, bar, quux) where\n\ntop :: Int\ntop = 1\n\nfoo :: ()\nfoo = let True = True in ()\n\nbar :: Int -> Int\nbar match = 1\n\nquux :: Int\nquux = let local = True\n       in 2\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# OPTIONS_GHC -Wall -Werror #-}\nmodule Bug(P) where\n\nnewtype P a = P (IO a) deriving (Functor, Applicative, Monad)\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-name-shadowing -fwarn-unused-binds #-}\n\n-- Trac #1972\n\nmodule Temp where\n\nimport Data.List\n\ndata Data = Data {name :: String}\n\nh :: a -> a\nh name = name\n\nf mapAccumL x = x\n\nmapAccumL y = y\n\ntest x = a+b \n  where\n    (a,b,c) = x", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XTypeOperators #-}\n\n-- Test fixity of type operators\n-- Trac #2205\n\nmodule ShouldCompile where\n\n infixr 0 :->\n data a :-> b = P a b\n\n fst3:: (a :-> (b :-> c)) -> a\n fst3 (P a (P b c)) = a\n\n\n fst3':: (a :-> b :-> c) -> a\n fst3' (P a (P b c)) = a\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies,EmptyDataDecls,MultiParamTypeClasses #-}\nmodule Test where\n\ntype family Fam1 a\n\nclass C b where\n    f :: ( Fam1 s ~ () ) => b -> s\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Bar where\nimport qualified T2435Foo as Foo\ninstance Foo.C Int where type T Int = Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T2435Foo where\nclass C a where type T a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fwarn-duplicate-exports #-}\n\nmodule T2436( C(..), T(..), module T2436a, S(..) ) where\n\nimport T2436a\n\nclass C a where\n  data T a\n\ninstance C Int where\n  data T Int = TInt Int\n\ndata instance S Int = SInt\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T2436a( S ) where\n\ndata family S a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2506\n\nmodule ShouldCompile where\nimport Control.Exception (assert)\n\nfoo = True `assert` ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeApplications #-}\n\nmodule T2600 where\n\n-- ** See trac #10595 for why we're okay with this generating warnings! **\n\nclass T t where\n    to :: [a] -> t a\n    from :: t a -> [a]\n    tmap :: (a -> a) -> t a -> t a\n\n{-# RULES\n\n\"myrule\" forall t a. forall f x.\n     from (tmap f (to x :: t a)) = map f (from (to x :: t a))\n\n  #-}\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RecordWildCards #-}\nmodule AssocWildCards where\n\nclass FooClass a where\n   data FooType a\n\ninstance FooClass Int where\n   data FooType Int = FooInt { fooIntVal :: Int }\n\nfooInt :: Int -> FooType Int\nfooInt fooIntVal = FooInt{..}\n\nfromFooInt :: FooType Int -> Int\nfromFooInt (FooInt{..}) = fooIntVal\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Werror -fwarn-unused-binds #-}\n\n-- Test Trac #3221: the constructors are used by the deriving\n--                  clause, even though they are not exported\n\nmodule T3221( Foo ) where\n\ndata Foo = Bar | Baz  deriving (Show,Read)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -fwarn-name-shadowing #-}\n\n-- Trac #3262: report shadowing in g but not f\n \nmodule T3262 where\n\nf x = let _ignored = 10 in\n      let _ignored = 20 in\n      x + _ignored\n\ng x = let not_ignored = 10 in\n      let not_ignored = 20 in\n      x + not_ignored\n\nmf x = do let _ignored = 10\n          let _ignored = 20\n          return (x + _ignored)\n\nmg x = do let not_ignored = 10\n          let not_ignored = 20\n          return (x + not_ignored)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# OPTIONS_GHC -fwarn-unused-matches #-}\n\n-- Should warn about the unused 'a', but not about the unused 'c'\n\nmodule T3371(bar) where\n\ndata Foo = Foo { a,b,c :: Int } deriving(Eq)\n\nbar Foo{ a = a, ..} = print b\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3449 (Foo, f1) where\n\nimport T3449A\n\nclass Foo a where\n    f1 :: a\n    f2 :: a\n\ninstance Foo Char where\n    f1 = f2\n    f2 = aChar\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3449A where\n\nimport {-# SOURCE #-} T3449\n\nz :: Foo a => a\nz = f1\n\naChar :: Char\naChar = 'a'\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\n\nmodule T3640 where\n\ndata Record = Record { f1, f2, f3 :: Int }\n\ngoodPun Record{f1,f2,f3} = f1 + f2 + f3\n\nbadPun r = f1 + f2 + f3\n    where Record{f1=f1,f2,f3} = r\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T3823A where\n\nimport T3823B\n\ndata A = X { x :: Bool } | Y\n\ny :: A -> A\ny = \\_ -> Y\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T3823B where\n\nimport {-# SOURCE #-} T3823A\n\ndata B = A A\n\na = x (X True)\nb = y a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards, TransformListComp, NamedFieldPuns #-}\n\nmodule T3901 where\n\nimport GHC.Exts (groupWith)\n\ndata Rec = Rec {a :: Int} deriving (Show)\n\nrecs1 = [a | Rec {a=a} <- [Rec 1], then group by a using groupWith]\n\nrecs2 = [a | Rec {a} <- [Rec 1], then group by a using groupWith]\n\nrecs3 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]\n\nrecs4 :: [[Int]]\nrecs4 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule T3943 where\n\n-- Note that 'r' is used, in the view pattern\n-- The bug was that 'r' was reported unused\n\ntest :: ([a], [a]) -> [a]\ntest x = let (r,(r++) -> rs) = x in rs\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule T4003A where\n\nimport T4003B\n\nimport Data.Data\n\ndata MyId = MyId\n    deriving (Data, Typeable)\n\ndata HsExpr id\n  = HsOverLit (HsOverLit id)\n  | HsBracketOut (HsExpr MyId)\n  deriving (Data, Typeable)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE DeriveDataTypeable #-}\n\nmodule T4003B where\n\nimport {-# SOURCE #-} T4003A (HsExpr)\n\nimport Data.Data\n\ndata HsLit = HsChar\n  deriving (Data, Typeable)\n\ndata HsOverLit id\n  = OverLit (HsExpr id)\n  deriving (Data, Typeable)\n\ndata OverLitVal = HsIntegral\n  deriving (Data, Typeable)\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4239 where\n\nimport T4239A\n\nv1 :: (:+++)\nv1 = (:+++)\n\nv2 :: (:+++)\nv2 = X\n\nv3 :: (:+++)\nv3 = (:---)\n\nv4 = (\u00c2\u00b7)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TypeOperators #-}\n\nmodule T4239A where\n\ndata (:+++) = (:+++)\n            | (:---)\n            | X\n            | Y\n\n(\u00c2\u00b7) = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4240 where\n\nimport T4240B\n\nv :: Int\nv = m\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4240A where\n\nclass C a where\n    m :: a\n\ninstance C Int where\n    m = 5\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4240B (m) where\n\nimport T4240A\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T4426 where\n\n-- GHC 8.0 no longer allows implicit quantification\n-- on the RHS.  This is more consistent:\n--       type F a = a -> m a\n-- has always been rejected and hence so should\n-- these four.  (It was already deprecated in 7.10.)\ntype F a = Monad m => a -> m a\n\ndata X a = X (Eq b => a -> b)\n\ndata Y a = Y { k :: Eq b => a -> b -> c }\n\nf :: forall b. (Monad m => m b) -> b\nf = undefined\n\n-- But these ones are fine:\ntype F' a = forall m. Monad m => a -> m a\n\ndata X' a = X' (forall b. Eq b => a -> b)\n\ndata Y' a = Y' { k' :: forall b c. Eq b => a -> b -> c }\n\nf' :: forall b. (forall m. Monad m => m b) -> b\nf' = undefined\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- We don't want to warn about duplicate exports for things exported\n-- by both \"module\" exports\nmodule T4478 (module Prelude, module Data.List) where\n\nimport Prelude\nimport Data.List\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-missing-import-lists #-}\nmodule T4489 where\n\nimport Data.Maybe\nimport Data.Maybe( Maybe(..) )\nimport Data.Maybe( Maybe(Just) )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TransformListComp #-}\n\n-- GHC 7.0.1 failed because the renamer didn't attach\n-- all the used variables to the TransformListComp constructor\n\nmodule List where\n\nintersectFront :: Ord a => [a] -> [a] -> [a]\nintersectFront xs ys = [x | (x,y) <- zip xs ys, then takeWhile by x == y]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T5306 where\n\nimport T5306b(F(FInt))   -- succeeds\nimport T5306a(F(FBool))  -- failed (before fix)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T5306a( F(..) ) where\nimport T5306b\n\ndata instance F Bool = FBool\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T5306b where\n\ndata family F a\ndata instance F Int = FInt\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Foo where\n\ndata T a \n\ndata S = forall a.S1\n\ndata W where\n  W1 :: forall a. W\n\nf :: forall a. Int\nf = 3\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\nmodule T5334 where\n\ndata T = T { a, b :: Int }\n\nt = T {..}\n  where\n     a = 1\n     -- b = 2\n\ndata S = S { x, y :: Int }\n\ns = S { x = 1 }\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\nmodule Main where\n\nimport qualified T5592a as MR (MyRecord(MyRecord, field))\n\nmain\n  = do { let field = \"Hello, world!\"\n             rec = MR.MyRecord {..}\n       ; print rec }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5592a where\n\ndata MyRecord = MyRecord { field :: String } \n  deriving (Show)  \n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5867( f ) where\nimport T5867a\n\nboo = f\nbar = f\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5867a where\n\n{-# DEPRECATED f \"Don't use f!\" #-}\nf x = x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n\nmodule T6027 where\n\ndata (?) a b = Q a b\n\ninfixr 2 ?\n\ntest :: Int ? String ? Bool\ntest = 0 `Q` (\"foo\" `Q` True)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns, BangPatterns #-}\n\nmodule T6038 where\n\ndata T = MkT { x,y :: Int }\n\nf (MkT { x = !v, y = negate -> w }) = v + w\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6120 where\n\ninfix 3 +++ \n\nclass C a where\n  (+++) :: a -> a -> a\n\n{-# DEPRECATED fail \"fail is deprecated\" #-}\nfail :: String -> String\nfail = id\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7007 where\n\nimport Data.Monoid( Monoid(..) )\n\ninfixr 5 ++   -- This unambiguously refers to the local definition\n\n(++) :: Monoid a => a -> a -> a\n(++) = mappend\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-binds #-}\n\nmodule ShouldFail where\n\nfoo :: Int -> Int\nfoo n = n + 1\n   where\n     Nothing = Just n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7145a ( Applicative(pure) ) where\n\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule T7145b ( A.Applicative(pure) ) where\n\nimport qualified Control.Applicative as A\n\npure :: ()\npure = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-dodgy-imports #-}\n\nmodule T7167 where\n\nimport Data.List hiding (foo)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7336 ( U, T ) where\n\ndata U = MkU deriving Show\n-- Want to report MkU as unused\n\ndata T = MkT deriving Read\n-- But MkT is not unused; we might\n-- parse a string to generate it\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7672 where\nimport qualified T7672a as XX\ndata T = S XX.T\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7672a(Decl.T) where\nimport {-# SOURCE #-} qualified T7672 as Decl\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7963 where\n\nimport Prelude hiding (unlines)\nimport T7963a (unlines)\n\nfoo :: IO ()\nfoo = writeFile \"/tmp/foo\" (unlines [\"hello\", \"world\"])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7963a where\n\nimport Prelude ()\nimport GHC.List\n\nunlines = concat\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\nmodule T7969 where\nimport T7969a \n\nderiving instance Eq T\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7969a where\n\ndata T = MkT\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule T9127 where\n\nf = let !_ = 2 * 2\n    in 2*2\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\nmodule T9778 where\n\ndata T = A | B\n\ndata G a where\n  C :: G A\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! 500 defns chained together at the top-level\nmodule Main(main) where\nmain = undefined\na000 = a001\na001 = a002\na002 = a003\na003 = a004\na004 = a005\na005 = a006\na006 = a007\na007 = a008\na008 = a009\na009 = a010\na010 = a011\na011 = a012\na012 = a013\na013 = a014\na014 = a015\na015 = a016\na016 = a017\na017 = a018\na018 = a019\na019 = a020\na020 = a021\na021 = a022\na022 = a023\na023 = a024\na024 = a025\na025 = a026\na026 = a027\na027 = a028\na028 = a029\na029 = a030\na030 = a031\na031 = a032\na032 = a033\na033 = a034\na034 = a035\na035 = a036\na036 = a037\na037 = a038\na038 = a039\na039 = a040\na040 = a041\na041 = a042\na042 = a043\na043 = a044\na044 = a045\na045 = a046\na046 = a047\na047 = a048\na048 = a049\na049 = a050\na050 = a051\na051 = a052\na052 = a053\na053 = a054\na054 = a055\na055 = a056\na056 = a057\na057 = a058\na058 = a059\na059 = a060\na060 = a061\na061 = a062\na062 = a063\na063 = a064\na064 = a065\na065 = a066\na066 = a067\na067 = a068\na068 = a069\na069 = a070\na070 = a071\na071 = a072\na072 = a073\na073 = a074\na074 = a075\na075 = a076\na076 = a077\na077 = a078\na078 = a079\na079 = a080\na080 = a081\na081 = a082\na082 = a083\na083 = a084\na084 = a085\na085 = a086\na086 = a087\na087 = a088\na088 = a089\na089 = a090\na090 = a091\na091 = a092\na092 = a093\na093 = a094\na094 = a095\na095 = a096\na096 = a097\na097 = a098\na098 = a099\na099 = a100\n\na100 = a101\na101 = a102\na102 = a103\na103 = a104\na104 = a105\na105 = a106\na106 = a107\na107 = a108\na108 = a109\na109 = a110\na110 = a111\na111 = a112\na112 = a113\na113 = a114\na114 = a115\na115 = a116\na116 = a117\na117 = a118\na118 = a119\na119 = a120\na120 = a121\na121 = a122\na122 = a123\na123 = a124\na124 = a125\na125 = a126\na126 = a127\na127 = a128\na128 = a129\na129 = a130\na130 = a131\na131 = a132\na132 = a133\na133 = a134\na134 = a135\na135 = a136\na136 = a137\na137 = a138\na138 = a139\na139 = a140\na140 = a141\na141 = a142\na142 = a143\na143 = a144\na144 = a145\na145 = a146\na146 = a147\na147 = a148\na148 = a149\na149 = a150\na150 = a151\na151 = a152\na152 = a153\na153 = a154\na154 = a155\na155 = a156\na156 = a157\na157 = a158\na158 = a159\na159 = a160\na160 = a161\na161 = a162\na162 = a163\na163 = a164\na164 = a165\na165 = a166\na166 = a167\na167 = a168\na168 = a169\na169 = a170\na170 = a171\na171 = a172\na172 = a173\na173 = a174\na174 = a175\na175 = a176\na176 = a177\na177 = a178\na178 = a179\na179 = a180\na180 = a181\na181 = a182\na182 = a183\na183 = a184\na184 = a185\na185 = a186\na186 = a187\na187 = a188\na188 = a189\na189 = a190\na190 = a191\na191 = a192\na192 = a193\na193 = a194\na194 = a195\na195 = a196\na196 = a197\na197 = a198\na198 = a199\na199 = a200\n\na200 = a201\na201 = a202\na202 = a203\na203 = a204\na204 = a205\na205 = a206\na206 = a207\na207 = a208\na208 = a209\na209 = a210\na210 = a211\na211 = a212\na212 = a213\na213 = a214\na214 = a215\na215 = a216\na216 = a217\na217 = a218\na218 = a219\na219 = a220\na220 = a221\na221 = a222\na222 = a223\na223 = a224\na224 = a225\na225 = a226\na226 = a227\na227 = a228\na228 = a229\na229 = a230\na230 = a231\na231 = a232\na232 = a233\na233 = a234\na234 = a235\na235 = a236\na236 = a237\na237 = a238\na238 = a239\na239 = a240\na240 = a241\na241 = a242\na242 = a243\na243 = a244\na244 = a245\na245 = a246\na246 = a247\na247 = a248\na248 = a249\na249 = a250\na250 = a251\na251 = a252\na252 = a253\na253 = a254\na254 = a255\na255 = a256\na256 = a257\na257 = a258\na258 = a259\na259 = a260\na260 = a261\na261 = a262\na262 = a263\na263 = a264\na264 = a265\na265 = a266\na266 = a267\na267 = a268\na268 = a269\na269 = a270\na270 = a271\na271 = a272\na272 = a273\na273 = a274\na274 = a275\na275 = a276\na276 = a277\na277 = a278\na278 = a279\na279 = a280\na280 = a281\na281 = a282\na282 = a283\na283 = a284\na284 = a285\na285 = a286\na286 = a287\na287 = a288\na288 = a289\na289 = a290\na290 = a291\na291 = a292\na292 = a293\na293 = a294\na294 = a295\na295 = a296\na296 = a297\na297 = a298\na298 = a299\na299 = a300\n\na300 = a301\na301 = a302\na302 = a303\na303 = a304\na304 = a305\na305 = a306\na306 = a307\na307 = a308\na308 = a309\na309 = a310\na310 = a311\na311 = a312\na312 = a313\na313 = a314\na314 = a315\na315 = a316\na316 = a317\na317 = a318\na318 = a319\na319 = a320\na320 = a321\na321 = a322\na322 = a323\na323 = a324\na324 = a325\na325 = a326\na326 = a327\na327 = a328\na328 = a329\na329 = a330\na330 = a331\na331 = a332\na332 = a333\na333 = a334\na334 = a335\na335 = a336\na336 = a337\na337 = a338\na338 = a339\na339 = a340\na340 = a341\na341 = a342\na342 = a343\na343 = a344\na344 = a345\na345 = a346\na346 = a347\na347 = a348\na348 = a349\na349 = a350\na350 = a351\na351 = a352\na352 = a353\na353 = a354\na354 = a355\na355 = a356\na356 = a357\na357 = a358\na358 = a359\na359 = a360\na360 = a361\na361 = a362\na362 = a363\na363 = a364\na364 = a365\na365 = a366\na366 = a367\na367 = a368\na368 = a369\na369 = a370\na370 = a371\na371 = a372\na372 = a373\na373 = a374\na374 = a375\na375 = a376\na376 = a377\na377 = a378\na378 = a379\na379 = a380\na380 = a381\na381 = a382\na382 = a383\na383 = a384\na384 = a385\na385 = a386\na386 = a387\na387 = a388\na388 = a389\na389 = a390\na390 = a391\na391 = a392\na392 = a393\na393 = a394\na394 = a395\na395 = a396\na396 = a397\na397 = a398\na398 = a399\na399 = a400\n\na400 = a401\na401 = a402\na402 = a403\na403 = a404\na404 = a405\na405 = a406\na406 = a407\na407 = a408\na408 = a409\na409 = a410\na410 = a411\na411 = a412\na412 = a413\na413 = a414\na414 = a415\na415 = a416\na416 = a417\na417 = a418\na418 = a419\na419 = a420\na420 = a421\na421 = a422\na422 = a423\na423 = a424\na424 = a425\na425 = a426\na426 = a427\na427 = a428\na428 = a429\na429 = a430\na430 = a431\na431 = a432\na432 = a433\na433 = a434\na434 = a435\na435 = a436\na436 = a437\na437 = a438\na438 = a439\na439 = a440\na440 = a441\na441 = a442\na442 = a443\na443 = a444\na444 = a445\na445 = a446\na446 = a447\na447 = a448\na448 = a449\na449 = a450\na450 = a451\na451 = a452\na452 = a453\na453 = a454\na454 = a455\na455 = a456\na456 = a457\na457 = a458\na458 = a459\na459 = a460\na460 = a461\na461 = a462\na462 = a463\na463 = a464\na464 = a465\na465 = a466\na466 = a467\na467 = a468\na468 = a469\na469 = a470\na470 = a471\na471 = a472\na472 = a473\na473 = a474\na474 = a475\na475 = a476\na476 = a477\na477 = a478\na478 = a479\na479 = a480\na480 = a481\na481 = a482\na482 = a483\na483 = a484\na484 = a485\na485 = a486\na486 = a487\na487 = a488\na488 = a489\na489 = a490\na490 = a491\na491 = a492\na492 = a493\na493 = a494\na494 = a495\na495 = a496\na496 = a497\na497 = a498\na498 = a499\na499 = []       -- !!! ta-dah!!!\n", "num_lines": 508}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-tabs #-}\n-- !!! 500 defns chained together with \"where\"s\nmodule Main(main) where\n\nmain = undefined\na500 =\tlet a000 = []\n\t    a001 = a000\n\t    a002 = a001\n\t    a003 = a002\n\t    a004 = a003\n\t    a005 = a004\n\t    a006 = a005\n\t    a007 = a006\n\t    a008 = a007\n\t    a009 = a008\n\t    a010 = a009\n\t    a011 = a010\n\t    a012 = a011\n\t    a013 = a012\n\t    a014 = a013\n\t    a015 = a014\n\t    a016 = a015\n\t    a017 = a016\n\t    a018 = a017\n\t    a019 = a018\n\t    a020 = a019\n\t    a021 = a020\n\t    a022 = a021\n\t    a023 = a022\n\t    a024 = a023\n\t    a025 = a024\n\t    a026 = a025\n\t    a027 = a026\n\t    a028 = a027\n\t    a029 = a028\n\t    a030 = a029\n\t    a031 = a030\n\t    a032 = a031\n\t    a033 = a032\n\t    a034 = a033\n\t    a035 = a034\n\t    a036 = a035\n\t    a037 = a036\n\t    a038 = a037\n\t    a039 = a038\n\t    a040 = a039\n\t    a041 = a040\n\t    a042 = a041\n\t    a043 = a042\n\t    a044 = a043\n\t    a045 = a044\n\t    a046 = a045\n\t    a047 = a046\n\t    a048 = a047\n\t    a049 = a048\n\t    a050 = a049\n\t    a051 = a050\n\t    a052 = a051\n\t    a053 = a052\n\t    a054 = a053\n\t    a055 = a054\n\t    a056 = a055\n\t    a057 = a056\n\t    a058 = a057\n\t    a059 = a058\n\t    a060 = a059\n\t    a061 = a060\n\t    a062 = a061\n\t    a063 = a062\n\t    a064 = a063\n\t    a065 = a064\n\t    a066 = a065\n\t    a067 = a066\n\t    a068 = a067\n\t    a069 = a068\n\t    a070 = a069\n\t    a071 = a070\n\t    a072 = a071\n\t    a073 = a072\n\t    a074 = a073\n\t    a075 = a074\n\t    a076 = a075\n\t    a077 = a076\n\t    a078 = a077\n\t    a079 = a078\n\t    a080 = a079\n\t    a081 = a080\n\t    a082 = a081\n\t    a083 = a082\n\t    a084 = a083\n\t    a085 = a084\n\t    a086 = a085\n\t    a087 = a086\n\t    a088 = a087\n\t    a089 = a088\n\t    a090 = a089\n\t    a091 = a090\n\t    a092 = a091\n\t    a093 = a092\n\t    a094 = a093\n\t    a095 = a094\n\t    a096 = a095\n\t    a097 = a096\n\t    a098 = a097\n\t    a099 = a098\n\t    a100 = a099\n\t    a101 = a100\n\t    a102 = a101\n\t    a103 = a102\n\t    a104 = a103\n\t    a105 = a104\n\t    a106 = a105\n\t    a107 = a106\n\t    a108 = a107\n\t    a109 = a108\n\t    a110 = a109\n\t    a111 = a110\n\t    a112 = a111\n\t    a113 = a112\n\t    a114 = a113\n\t    a115 = a114\n\t    a116 = a115\n\t    a117 = a116\n\t    a118 = a117\n\t    a119 = a118\n\t    a120 = a119\n\t    a121 = a120\n\t    a122 = a121\n\t    a123 = a122\n\t    a124 = a123\n\t    a125 = a124\n\t    a126 = a125\n\t    a127 = a126\n\t    a128 = a127\n\t    a129 = a128\n\t    a130 = a129\n\t    a131 = a130\n\t    a132 = a131\n\t    a133 = a132\n\t    a134 = a133\n\t    a135 = a134\n\t    a136 = a135\n\t    a137 = a136\n\t    a138 = a137\n\t    a139 = a138\n\t    a140 = a139\n\t    a141 = a140\n\t    a142 = a141\n\t    a143 = a142\n\t    a144 = a143\n\t    a145 = a144\n\t    a146 = a145\n\t    a147 = a146\n\t    a148 = a147\n\t    a149 = a148\n\t    a150 = a149\n\t    a151 = a150\n\t    a152 = a151\n\t    a153 = a152\n\t    a154 = a153\n\t    a155 = a154\n\t    a156 = a155\n\t    a157 = a156\n\t    a158 = a157\n\t    a159 = a158\n\t    a160 = a159\n\t    a161 = a160\n\t    a162 = a161\n\t    a163 = a162\n\t    a164 = a163\n\t    a165 = a164\n\t    a166 = a165\n\t    a167 = a166\n\t    a168 = a167\n\t    a169 = a168\n\t    a170 = a169\n\t    a171 = a170\n\t    a172 = a171\n\t    a173 = a172\n\t    a174 = a173\n\t    a175 = a174\n\t    a176 = a175\n\t    a177 = a176\n\t    a178 = a177\n\t    a179 = a178\n\t    a180 = a179\n\t    a181 = a180\n\t    a182 = a181\n\t    a183 = a182\n\t    a184 = a183\n\t    a185 = a184\n\t    a186 = a185\n\t    a187 = a186\n\t    a188 = a187\n\t    a189 = a188\n\t    a190 = a189\n\t    a191 = a190\n\t    a192 = a191\n\t    a193 = a192\n\t    a194 = a193\n\t    a195 = a194\n\t    a196 = a195\n\t    a197 = a196\n\t    a198 = a197\n\t    a199 = a198\n\t    a200 = a199\n\t    a201 = a200\n\t    a202 = a201\n\t    a203 = a202\n\t    a204 = a203\n\t    a205 = a204\n\t    a206 = a205\n\t    a207 = a206\n\t    a208 = a207\n\t    a209 = a208\n\t    a210 = a209\n\t    a211 = a210\n\t    a212 = a211\n\t    a213 = a212\n\t    a214 = a213\n\t    a215 = a214\n\t    a216 = a215\n\t    a217 = a216\n\t    a218 = a217\n\t    a219 = a218\n\t    a220 = a219\n\t    a221 = a220\n\t    a222 = a221\n\t    a223 = a222\n\t    a224 = a223\n\t    a225 = a224\n\t    a226 = a225\n\t    a227 = a226\n\t    a228 = a227\n\t    a229 = a228\n\t    a230 = a229\n\t    a231 = a230\n\t    a232 = a231\n\t    a233 = a232\n\t    a234 = a233\n\t    a235 = a234\n\t    a236 = a235\n\t    a237 = a236\n\t    a238 = a237\n\t    a239 = a238\n\t    a240 = a239\n\t    a241 = a240\n\t    a242 = a241\n\t    a243 = a242\n\t    a244 = a243\n\t    a245 = a244\n\t    a246 = a245\n\t    a247 = a246\n\t    a248 = a247\n\t    a249 = a248\n\t    a250 = a249\n\t    a251 = a250\n\t    a252 = a251\n\t    a253 = a252\n\t    a254 = a253\n\t    a255 = a254\n\t    a256 = a255\n\t    a257 = a256\n\t    a258 = a257\n\t    a259 = a258\n\t    a260 = a259\n\t    a261 = a260\n\t    a262 = a261\n\t    a263 = a262\n\t    a264 = a263\n\t    a265 = a264\n\t    a266 = a265\n\t    a267 = a266\n\t    a268 = a267\n\t    a269 = a268\n\t    a270 = a269\n\t    a271 = a270\n\t    a272 = a271\n\t    a273 = a272\n\t    a274 = a273\n\t    a275 = a274\n\t    a276 = a275\n\t    a277 = a276\n\t    a278 = a277\n\t    a279 = a278\n\t    a280 = a279\n\t    a281 = a280\n\t    a282 = a281\n\t    a283 = a282\n\t    a284 = a283\n\t    a285 = a284\n\t    a286 = a285\n\t    a287 = a286\n\t    a288 = a287\n\t    a289 = a288\n\t    a290 = a289\n\t    a291 = a290\n\t    a292 = a291\n\t    a293 = a292\n\t    a294 = a293\n\t    a295 = a294\n\t    a296 = a295\n\t    a297 = a296\n\t    a298 = a297\n\t    a299 = a298\n\t    a300 = a299\n\t    a301 = a300\n\t    a302 = a301\n\t    a303 = a302\n\t    a304 = a303\n\t    a305 = a304\n\t    a306 = a305\n\t    a307 = a306\n\t    a308 = a307\n\t    a309 = a308\n\t    a310 = a309\n\t    a311 = a310\n\t    a312 = a311\n\t    a313 = a312\n\t    a314 = a313\n\t    a315 = a314\n\t    a316 = a315\n\t    a317 = a316\n\t    a318 = a317\n\t    a319 = a318\n\t    a320 = a319\n\t    a321 = a320\n\t    a322 = a321\n\t    a323 = a322\n\t    a324 = a323\n\t    a325 = a324\n\t    a326 = a325\n\t    a327 = a326\n\t    a328 = a327\n\t    a329 = a328\n\t    a330 = a329\n\t    a331 = a330\n\t    a332 = a331\n\t    a333 = a332\n\t    a334 = a333\n\t    a335 = a334\n\t    a336 = a335\n\t    a337 = a336\n\t    a338 = a337\n\t    a339 = a338\n\t    a340 = a339\n\t    a341 = a340\n\t    a342 = a341\n\t    a343 = a342\n\t    a344 = a343\n\t    a345 = a344\n\t    a346 = a345\n\t    a347 = a346\n\t    a348 = a347\n\t    a349 = a348\n\t    a350 = a349\n\t    a351 = a350\n\t    a352 = a351\n\t    a353 = a352\n\t    a354 = a353\n\t    a355 = a354\n\t    a356 = a355\n\t    a357 = a356\n\t    a358 = a357\n\t    a359 = a358\n\t    a360 = a359\n\t    a361 = a360\n\t    a362 = a361\n\t    a363 = a362\n\t    a364 = a363\n\t    a365 = a364\n\t    a366 = a365\n\t    a367 = a366\n\t    a368 = a367\n\t    a369 = a368\n\t    a370 = a369\n\t    a371 = a370\n\t    a372 = a371\n\t    a373 = a372\n\t    a374 = a373\n\t    a375 = a374\n\t    a376 = a375\n\t    a377 = a376\n\t    a378 = a377\n\t    a379 = a378\n\t    a380 = a379\n\t    a381 = a380\n\t    a382 = a381\n\t    a383 = a382\n\t    a384 = a383\n\t    a385 = a384\n\t    a386 = a385\n\t    a387 = a386\n\t    a388 = a387\n\t    a389 = a388\n\t    a390 = a389\n\t    a391 = a390\n\t    a392 = a391\n\t    a393 = a392\n\t    a394 = a393\n\t    a395 = a394\n\t    a396 = a395\n\t    a397 = a396\n\t    a398 = a397\n\t    a399 = a398\n\t    a400 = a399\n\t    a401 = a400\n\t    a402 = a401\n\t    a403 = a402\n\t    a404 = a403\n\t    a405 = a404\n\t    a406 = a405\n\t    a407 = a406\n\t    a408 = a407\n\t    a409 = a408\n\t    a410 = a409\n\t    a411 = a410\n\t    a412 = a411\n\t    a413 = a412\n\t    a414 = a413\n\t    a415 = a414\n\t    a416 = a415\n\t    a417 = a416\n\t    a418 = a417\n\t    a419 = a418\n\t    a420 = a419\n\t    a421 = a420\n\t    a422 = a421\n\t    a423 = a422\n\t    a424 = a423\n\t    a425 = a424\n\t    a426 = a425\n\t    a427 = a426\n\t    a428 = a427\n\t    a429 = a428\n\t    a430 = a429\n\t    a431 = a430\n\t    a432 = a431\n\t    a433 = a432\n\t    a434 = a433\n\t    a435 = a434\n\t    a436 = a435\n\t    a437 = a436\n\t    a438 = a437\n\t    a439 = a438\n\t    a440 = a439\n\t    a441 = a440\n\t    a442 = a441\n\t    a443 = a442\n\t    a444 = a443\n\t    a445 = a444\n\t    a446 = a445\n\t    a447 = a446\n\t    a448 = a447\n\t    a449 = a448\n\t    a450 = a449\n\t    a451 = a450\n\t    a452 = a451\n\t    a453 = a452\n\t    a454 = a453\n\t    a455 = a454\n\t    a456 = a455\n\t    a457 = a456\n\t    a458 = a457\n\t    a459 = a458\n\t    a460 = a459\n\t    a461 = a460\n\t    a462 = a461\n\t    a463 = a462\n\t    a464 = a463\n\t    a465 = a464\n\t    a466 = a465\n\t    a467 = a466\n\t    a468 = a467\n\t    a469 = a468\n\t    a470 = a469\n\t    a471 = a470\n\t    a472 = a471\n\t    a473 = a472\n\t    a474 = a473\n\t    a475 = a474\n\t    a476 = a475\n\t    a477 = a476\n\t    a478 = a477\n\t    a479 = a478\n\t    a480 = a479\n\t    a481 = a480\n\t    a482 = a481\n\t    a483 = a482\n\t    a484 = a483\n\t    a485 = a484\n\t    a486 = a485\n\t    a487 = a486\n\t    a488 = a487\n\t    a489 = a488\n\t    a490 = a489\n\t    a491 = a490\n\t    a492 = a491\n\t    a493 = a492\n\t    a494 = a493\n\t    a495 = a494\n\t    a496 = a495\n\t    a497 = a496\n\t    a498 = a497 in\n\ta498\n", "num_lines": 506}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! 500 defns, not chained together\nmodule Main(main) where\n\nmain = undefined\na000 = []\na001 = []\na002 = []\na003 = []\na004 = []\na005 = []\na006 = []\na007 = []\na008 = []\na009 = []\na010 = []\na011 = []\na012 = []\na013 = []\na014 = []\na015 = []\na016 = []\na017 = []\na018 = []\na019 = []\na020 = []\na021 = []\na022 = []\na023 = []\na024 = []\na025 = []\na026 = []\na027 = []\na028 = []\na029 = []\na030 = []\na031 = []\na032 = []\na033 = []\na034 = []\na035 = []\na036 = []\na037 = []\na038 = []\na039 = []\na040 = []\na041 = []\na042 = []\na043 = []\na044 = []\na045 = []\na046 = []\na047 = []\na048 = []\na049 = []\na050 = []\na051 = []\na052 = []\na053 = []\na054 = []\na055 = []\na056 = []\na057 = []\na058 = []\na059 = []\na060 = []\na061 = []\na062 = []\na063 = []\na064 = []\na065 = []\na066 = []\na067 = []\na068 = []\na069 = []\na070 = []\na071 = []\na072 = []\na073 = []\na074 = []\na075 = []\na076 = []\na077 = []\na078 = []\na079 = []\na080 = []\na081 = []\na082 = []\na083 = []\na084 = []\na085 = []\na086 = []\na087 = []\na088 = []\na089 = []\na090 = []\na091 = []\na092 = []\na093 = []\na094 = []\na095 = []\na096 = []\na097 = []\na098 = []\na099 = []\n\na100 = []\na101 = []\na102 = []\na103 = []\na104 = []\na105 = []\na106 = []\na107 = []\na108 = []\na109 = []\na110 = []\na111 = []\na112 = []\na113 = []\na114 = []\na115 = []\na116 = []\na117 = []\na118 = []\na119 = []\na120 = []\na121 = []\na122 = []\na123 = []\na124 = []\na125 = []\na126 = []\na127 = []\na128 = []\na129 = []\na130 = []\na131 = []\na132 = []\na133 = []\na134 = []\na135 = []\na136 = []\na137 = []\na138 = []\na139 = []\na140 = []\na141 = []\na142 = []\na143 = []\na144 = []\na145 = []\na146 = []\na147 = []\na148 = []\na149 = []\na150 = []\na151 = []\na152 = []\na153 = []\na154 = []\na155 = []\na156 = []\na157 = []\na158 = []\na159 = []\na160 = []\na161 = []\na162 = []\na163 = []\na164 = []\na165 = []\na166 = []\na167 = []\na168 = []\na169 = []\na170 = []\na171 = []\na172 = []\na173 = []\na174 = []\na175 = []\na176 = []\na177 = []\na178 = []\na179 = []\na180 = []\na181 = []\na182 = []\na183 = []\na184 = []\na185 = []\na186 = []\na187 = []\na188 = []\na189 = []\na190 = []\na191 = []\na192 = []\na193 = []\na194 = []\na195 = []\na196 = []\na197 = []\na198 = []\na199 = []\n\na200 = []\na201 = []\na202 = []\na203 = []\na204 = []\na205 = []\na206 = []\na207 = []\na208 = []\na209 = []\na210 = []\na211 = []\na212 = []\na213 = []\na214 = []\na215 = []\na216 = []\na217 = []\na218 = []\na219 = []\na220 = []\na221 = []\na222 = []\na223 = []\na224 = []\na225 = []\na226 = []\na227 = []\na228 = []\na229 = []\na230 = []\na231 = []\na232 = []\na233 = []\na234 = []\na235 = []\na236 = []\na237 = []\na238 = []\na239 = []\na240 = []\na241 = []\na242 = []\na243 = []\na244 = []\na245 = []\na246 = []\na247 = []\na248 = []\na249 = []\na250 = []\na251 = []\na252 = []\na253 = []\na254 = []\na255 = []\na256 = []\na257 = []\na258 = []\na259 = []\na260 = []\na261 = []\na262 = []\na263 = []\na264 = []\na265 = []\na266 = []\na267 = []\na268 = []\na269 = []\na270 = []\na271 = []\na272 = []\na273 = []\na274 = []\na275 = []\na276 = []\na277 = []\na278 = []\na279 = []\na280 = []\na281 = []\na282 = []\na283 = []\na284 = []\na285 = []\na286 = []\na287 = []\na288 = []\na289 = []\na290 = []\na291 = []\na292 = []\na293 = []\na294 = []\na295 = []\na296 = []\na297 = []\na298 = []\na299 = []\n\na300 = []\na301 = []\na302 = []\na303 = []\na304 = []\na305 = []\na306 = []\na307 = []\na308 = []\na309 = []\na310 = []\na311 = []\na312 = []\na313 = []\na314 = []\na315 = []\na316 = []\na317 = []\na318 = []\na319 = []\na320 = []\na321 = []\na322 = []\na323 = []\na324 = []\na325 = []\na326 = []\na327 = []\na328 = []\na329 = []\na330 = []\na331 = []\na332 = []\na333 = []\na334 = []\na335 = []\na336 = []\na337 = []\na338 = []\na339 = []\na340 = []\na341 = []\na342 = []\na343 = []\na344 = []\na345 = []\na346 = []\na347 = []\na348 = []\na349 = []\na350 = []\na351 = []\na352 = []\na353 = []\na354 = []\na355 = []\na356 = []\na357 = []\na358 = []\na359 = []\na360 = []\na361 = []\na362 = []\na363 = []\na364 = []\na365 = []\na366 = []\na367 = []\na368 = []\na369 = []\na370 = []\na371 = []\na372 = []\na373 = []\na374 = []\na375 = []\na376 = []\na377 = []\na378 = []\na379 = []\na380 = []\na381 = []\na382 = []\na383 = []\na384 = []\na385 = []\na386 = []\na387 = []\na388 = []\na389 = []\na390 = []\na391 = []\na392 = []\na393 = []\na394 = []\na395 = []\na396 = []\na397 = []\na398 = []\na399 = []\n\na400 = []\na401 = []\na402 = []\na403 = []\na404 = []\na405 = []\na406 = []\na407 = []\na408 = []\na409 = []\na410 = []\na411 = []\na412 = []\na413 = []\na414 = []\na415 = []\na416 = []\na417 = []\na418 = []\na419 = []\na420 = []\na421 = []\na422 = []\na423 = []\na424 = []\na425 = []\na426 = []\na427 = []\na428 = []\na429 = []\na430 = []\na431 = []\na432 = []\na433 = []\na434 = []\na435 = []\na436 = []\na437 = []\na438 = []\na439 = []\na440 = []\na441 = []\na442 = []\na443 = []\na444 = []\na445 = []\na446 = []\na447 = []\na448 = []\na449 = []\na450 = []\na451 = []\na452 = []\na453 = []\na454 = []\na455 = []\na456 = []\na457 = []\na458 = []\na459 = []\na460 = []\na461 = []\na462 = []\na463 = []\na464 = []\na465 = []\na466 = []\na467 = []\na468 = []\na469 = []\na470 = []\na471 = []\na472 = []\na473 = []\na474 = []\na475 = []\na476 = []\na477 = []\na478 = []\na479 = []\na480 = []\na481 = []\na482 = []\na483 = []\na484 = []\na485 = []\na486 = []\na487 = []\na488 = []\na489 = []\na490 = []\na491 = []\na492 = []\na493 = []\na494 = []\na495 = []\na496 = []\na497 = []\na498 = []\na499 = []\n", "num_lines": 509}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving #-}\n\nmodule Foreign.Ptr () where\n\nimport GHC.Show (Show(..))\nimport GHC.Word (Word)\nimport GHC.Base (Num)\n\nnewtype WordPtr = WordPtr Word\n    deriving Num\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\\begin{code}\n{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule GHC.Base\n        (\n        module GHC.Classes,\n        module GHC.Prim,\n        Num(..)\n  ) where\n\nimport GHC.Classes\nimport GHC.Prim\n\nclass Num a  where\n    signum    :: a -> a\n\\end{code}\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule GHC.Num (fromInteger) where\n\nimport GHC.Base\nimport GHC.Integer\n\nfromInteger :: Num a => Integer -> a\nfromInteger = fromInteger\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\\begin{code}\n{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule GHC.Show (Show(..)) where\n\nimport GHC.Types\n\nclass  Show a  where\n    show      :: a   -> [Char]\n\\end{code}\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n\nmodule GHC.Unicode ( ) where\n\nimport GHC.Show ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude, MagicHash #-}\n\nmodule GHC.Word (\n    Word(..),\n    ) where\n\nimport GHC.Base\nimport GHC.Types\nimport GHC.Num ()\n\nimport {-# SOURCE #-} GHC.Unicode ()\n\ninstance Num Word where\n    signum 0               = 0\n    signum _               = 1\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE TypeApplications #-}\n\nmodule ExplicitForAllRules2 where\n\n{-# RULES \"new4\" forall a. forall (x :: b). id @a (wk x) = (wk x) #-}\n{-# RULES \"new5\" forall a. forall (x :: a). id @a y = y #-}\n{-# RULES \"new6\" forall a. forall (x :: a). id @c x = x #-}\n\n{-# NOINLINE wk #-}\nwk :: forall b a. b -> a\nwk _ = error \"\"\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for transform list comp which should work for monad comp as well:\n--\n-- Test trying to use a function bound in the list comprehension as the transform function\n\n{-# OPTIONS_GHC -XRankNTypes -XMonadComprehensions -XTransformListComp #-}\n\nmodule RnFail048 where\n\nfunctions :: [[a] -> [a]]\nfunctions = [take 4, take 5]\n\noutput = [() | f <- functions, then f]\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for transform list comp which should work for monad comp aswell:\n--\n-- Test trying to use a function bound in the list comprehension as the group function\n\n{-# OPTIONS_GHC -XRankNTypes -XMonadComprehensions -XTransformListComp #-}\n\nmodule RnFail049 where\n\nimport Data.List(inits, tails)\n\nfunctions :: [[a] -> [[a]]]\nfunctions = [inits, tails]\n\noutput = [() | f <- functions, then group using f]\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Misplaced where\n\ninstance Eq (T a)\n{-# SPECIALISE instance Eq (T Int) #-}\n -- A mis-placed signature\n\ndata T a = T a\n\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf x x = 2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! rn001: super-simple set of bindings,\n-- !!!  incl wildcard pattern-bindings and *duplicates*\n\nx = []\ny = []\ny = []\n_ = []\n_ = 1\nz = []\n_ = []\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! split definition of f (error)\nf [] = []\ng x = x\nf (x:xs) = []\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! multiple definitions, but hidden in patterns\nmodule Foo where\n\nf x = x\n  where\n    a           = []\n    (b,c,a)     = ([],[],d)\n    [d,b,_]     = ([],a,[])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Main module with no definition of main\n\nmodule Main where\n\nf x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Class and instance decl\n\nmodule Test where\n\nclass K a where\n        op1 :: a -> a -> a\n        op2 :: Int -> a\n\ninstance K Int where\n        op1 a b = a+b\n        op2 x   = x\n\ninstance K Bool where\n        op1 a b = a\n        -- Pick up the default decl for op2\n\ninstance K [a] where\n        op3 a = a       -- Oops!  Isn't a class op of K\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\ndata F = A | B\n\ndata G = A | C\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nf x = 2\n\ng x = 6\n\nf x = 3\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\ntype A = Int\n\ntype B = Bool\n\ntype A = [Bool]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nclass A a where\n op1 :: a\n\nclass B a where\n op2 :: b -> b\n\nclass A a where\n op3 :: a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Conflicting constructors from two data type decls\n\nmodule Foo where\n\ndata T1 = MkT Int\n\ndata T2 = MkT Bool\n\nf (MkT x) = x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! duplicate constructors in datatype\n-- (bug report from Alex Ferguson, c. 2.06)\n\ndata Token\n     =  TokNewline\n     |  TokLiteral\n     |  TokCount\n     |  TokCheck\n     |  TokIs\n     |  TokDeref\n     |  TokFind\n     |  TokLiteral              -- Duplicated!\n     |  TokThe\n\n      deriving Show\n\nmain = print TokCount\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-typed-holes #-}\nmodule ShouldFail where\n\n-- !!! Pattern syntax in expressions\n\nf x = x @ x\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-typed-holes #-}\nmodule ShouldFail where\n\n-- !!! Pattern syntax in expressions\n\nf x = ~ x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! Precedence of unary negation\n\nf1 x y = x + -y         -- Fails\nf2 x y = x * -y         -- Fails\n\n\nf3 x y = -x + y         -- OK: means  (-x) + y\n                        -- since - is left associative\n\nf4 x y = - x*y          -- OK: means -(x*y)\n                        -- since - binds less tightly than *\n\nf5 x y = x >= -y        -- OK means x >= (-y)\n\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, ExplicitForAll #-}\n\nmodule ShouldFail where\n\n-- !!! For-all with parens\n\n-- This one crashed ghc-4.04proto; the parens after the for-all fooled it\n\nclass Monad m => StateMonad s m where\n   getState :: m s\n\nsetState0 :: forall b. (StateMonad (a,b) m => m a)\nsetState0 = getState >>= \\ (l,_r) -> return l\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! Section with with a bad precedence\n\nf x y = (x:y:)\n\n-- GHC 4.04 (as released) let this by, but it's a precedence error.\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n-- !!! Error messages with scoped type variables\n\nmodule Foo where\n\ndata Set a = Set a\n\nunionSetB :: Eq a => Set a -> Set a -> Set a\nunionSetB (s1 :: Set a) s2 = unionSets s1 s2\n where\n   unionSets :: Eq a => Set a -> Set a -> Set a\n   unionSets a b = a\n\n\n{- In GHC 4.04 this gave the terrible message:\n\n    None of the type variable(s) in the constraint `Eq a'\n        appears in the type `Set a -> Set a -> Set a'\n    In the type signature for `unionSets'\n-}\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Qualified names in binding positions are rejected\n\nmodule Foo where\n\n(Baz.f, x) = True\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check that 'qualified' doesn't bring the unqual'ed name into scope.\nmodule ShouldFail where\n\nimport qualified Data.List as L ( intersperse )\n\nx = L.intersperse\n\ny = intersperse\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check that type signatures and pragmas that\n-- !!! don't have a \"parent\" are correctly reported\n\nmodule ShouldFail where\n\n-- Top level test\nf :: Int -> Int\n{-# INLINE f #-}\n\n-- Nested test\nh :: Int -> Int -- This one is ok\nh x = x\n    where\n      g :: Int -> Int   -- Bogus\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nsig_without_a_defn :: a -> b\n\nf :: a -> b\nf = sig_without_a_defn\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nsig_without_a_defn :: a -> b\n\n-- We don't even refer to the variable.  This compiled without error\n-- in ghc-4.08.\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, FlexibleInstances #-}\n\n-- This one made ghc-4.08 crash\n-- rename/RnEnv.lhs:239: Non-exhaustive patterns in function get_tycon_key\n-- The type in the Monad instance is utterly bogus, of course\n\nmodule ShouldCompile ( Set ) where\n\n\ndata Set a = Set [a]\n       deriving (Eq, Ord, Read, Show)\n{-\ninstance Functor Set where\n        f `fmap` (Set xs) = Set $ f `fmap` xs\n-}\ninstance Monad (forall a. Eq a => Set a) where\n        return x = Set [x]\n{-\ninstance Eq (forall a. [a]) where\n-}\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! infix declarations for unknown identifiers aren't allowed\n\nmodule ShouldFail where\n\ninfixl 9 `wibble`\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! illegal to export a module we haven't imported.\nmodule ShouldFail ( module List ) where\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! conflicting exports for a function name\nmodule ShouldFail ( Data.List.map, module ShouldFail ) where\nimport qualified Data.List\nmap = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! check that unqualified imports don't bring qualified names into scope\nmodule ShouldFail ( Data.List.map ) where\nimport Data.List ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! check that qualified imports can be restricted to certain names\nmodule ShouldFail ( Data.List.map ) where\nimport qualified Data.List ( foldr )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! check that hiding works with qualified imports\nmodule ShouldFail ( Data.List.map ) where\nimport qualified Data.List hiding ( map )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! check that hiding on an unqualified import also hides the qualified name\nmodule ShouldFail ( Data.List.map ) where\nimport Data.List hiding ( map )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! qualified names aren't allowed in local binds either\n-- (Haskell 98 (revised) section 5.5.1)\nmodule M where\ng x = let M.y = x + 1 in M.y\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! can't name a constructor in an export list\nmodule ShouldFail ( C ) where\ndata T = C\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that qualified method names are ILLEGAL \n--     in the binding position instance body.\nmodule ShouldFail where\n\nimport Prelude hiding (Eq, (==))\nimport Prelude as P (Eq,(==))\n\ndata Foo = Foo Int Integer\n\ninstance P.Eq Foo where\n  (Foo a1 b1) P.== (Foo a2 b2) = a1 P.== a2 && b1 P.== b2\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one should fail, because it exports\n-- both Data.List:nub and Rnfail040_A:nub\n--\n--  Data.List:nub   is in scope as M.nub and nub\n--  Rnfail040_A:nub is in scope as T.nub, M.nub, and nub\n\nmodule M1 (module M) where\n\n import qualified Rnfail040_A as M  -- M.nub\n import Data.List as M              -- M.nub nub\n import Rnfail040_A as T            -- T.nub nub\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Rnfail040_A( nub ) where\n  nub = True\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f = 3\ng = 3\n\nh :: Int\nj :: Int\n\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Uses of built-in syntax should provoke a decent error message\n\nmodule ShouldFail where\n\ndata T0 = ()\ndata T3= (,,,)\ndata Nil = []\ndata List = Int : Bool \n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Duplicate bindings introduced one at a time with TH\nmodule ShouldFail where\n\nf x = x\n\n$([d| h x = x |])\n\nf x = x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Renamer test\n-- The ambiguity is between the Prelude import and the defn\n-- of splitAt. The import of Data.List has nothing to do with it.\n\nmodule A ( splitAt ) where\n\n  import qualified Data.List\n  splitAt = undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- These crashed GHC 6.4.2\n\nmodule ShouldFail where\n\nx `op1` y = True\nop1 x = False\n\nop2 x = False\nx `op2` y = True\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Qualified name in binding position\nmodule ShouldFail where\n\ndata Test = Map.Map Int Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- trac #924: RnFail047_A.hs-boot exports more than RnFail047_A.hs\n\nmodule RnFail047 where\n\nimport {-# SOURCE #-} RnFail047_A\n\nv = x\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule RnFail047_A (x) where\n\nimport RnFail047\n\nx :: Int\nx = 3\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #1888 \n-- Pretty printing for pragmas\n\nmodule ShouldFail where\n\n{-# NOINLINE[1] foo #-}\n{-# NOINLINE[~2] foo #-}\n{-# NOINLINE foo #-}\n{-# INLINE[1] foo #-}\n{-# INLINE[~2] foo #-}\n{-# INLINE foo #-}\n\nfoo n = foo (n+1)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test trying to use a function bound in the list comprehension as the group function\n\n{-# OPTIONS_GHC -XRankNTypes -XTransformListComp #-}\n\nmodule RnFail049 where\n\nimport Data.List(inits, tails)\n\nfunctions :: [[a] -> [[a]]]\nfunctions = [inits, tails]\n\noutput = [() | f <- functions, then group using f]\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test trying to use a function bound in the list comprehension as the transform function\n\n{-# OPTIONS_GHC -XRankNTypes -XTransformListComp #-}\n\nmodule RnFail048 where\n\nfunctions :: [[a] -> [a]]\nfunctions = [take 4, take 5]\n\noutput = [() | f <- functions, then f]\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- trac #2033: This used to fail when the renamer didn't check for a view\n-- /pattern/ being used in an /expression/ context\n\nmodule RnFail051 where\n\nmain :: IO ()\nmain = wrapper (_ -> putStrLn \"_\")\n\nwrapper :: (String -> IO ()) -> IO ()\nwrapper f = f \"\"\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Error messages when you use 'forall' *without* the RankN flags\n-- Test cases similar to Trac #2114\n\nmodule ShouldFail where\n\nf :: forall a. a->a\nf = error \"ur\"\n\ng :: Int -> (forall a. a-> a) -> Int\ng = error \"ur\"\n\ndata S = MkS (forall a. a->a)\n  -- This one complains about 'a' and 'forall' not in scope\n  -- because they aren't implicitly quantified, \n  -- whereas implicit quantification deals with the first two\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test Trac #2114 (error message)\n\nmodule ShouldFail where\n\ndata T = forall a. MkT a\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for trac #2141\n\nmodule Foo where\n\nfoo :: () -> ()\nfoo x = x { foo = 1 }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses,RankNTypes,ExistentialQuantification,DatatypeContexts #-}\nmodule RnFail055 where\n\nimport RnFail055_aux\n\n-- Id with different type\nf1 :: Int -> Float\nf1 = undefined\n\n-- type synonym with different arity\ntype S1 a b = (a,b)\n\n-- type synonym with different rhs\ntype S2 a b = forall a. (a,b)\n\n-- type synonym with alpha-renaming (should be ok)\ntype S3 a = [a]\n\n-- datatype with different fields\ndata T1 a b = T1 [b] [a]\n\n-- datatype with different stupid theta\ndata (Eq b) => T2 a b = T2 a\n\n-- different constructor name\ndata T3' = T3\ndata T3 = T3'\n\n-- check alpha equivalence\ndata T4 a = T4 (forall b. a -> b)\n\n-- different field labels\ndata T5 a = T5 { field5 :: a }\n\n-- different strict marks\ndata T6 = T6 Int\n\n-- different existential quantification\ndata T7 a = forall a . T7 a\n\n-- extra method in the hs-boot\nclass C1 a b where {}\n\n-- missing method in the hs-boot\nclass C2 a b where { m2 :: a -> b; m2' :: a -> b }\n\n-- different superclasses\nclass (Eq a, Ord a) => C3 a where { }\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module RnFail055_aux where\n\nimport {-# SOURCE #-} RnFail055\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- TupleSections not enabled\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Foo where\n\nfoo = (1,)\n\nbar = (# 1, #)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n\nmodule BindKindName where\n\ntype Foo (a :: DontExistKind) = a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers #-}\n\nmodule RnStaticPointersFail01 where\n\nf x = static x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers #-}\n\nmodule RnStaticPointersFail02 where\n\nf = static T\n\ndata T = TDataCons\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers #-}\n\nmodule RnStaticPointersFail03 where\n\nimport Data.Typeable\nimport GHC.StaticPtr\n\nf x = static (x . id)\n\nf0 x = static (k . id)\n  where\n    k = const (const () x)\n\nf1 x = static (k . id)\n  where\n    k = id\n\nf2 :: Typeable a => a -> StaticPtr TypeRep\nf2 x = const (static (g undefined)) (h x)\n  where\n    g = h\n    h = typeOf\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n-- Test for top-level duplicates\n\nmodule Dup where\n\ndata T = MkT | MkT\n\ndata S = MkT\n\ndata P = MkP { rf :: Int, rf :: Int }\ndata Q = MkQ { rf :: Int }\n\nclass C a where\n  data CT a \n  f :: CT a -> a\n  data CT a\n  f :: CT a -> a\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10618 where\n\nfoo = Just $ Nothing <|> Nothing\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10668 where\n\nimport Data.Type.Equality(Refl)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10781 where\n{- ghc-7.10.2 reported:\n\nT10781.hs:6:5:\n    Found hole \u00e2\u20ac\u02dc_name\u00e2\u20ac\u2122 with type: t\n    Where: \u00e2\u20ac\u02dct\u00e2\u20ac\u2122 is a rigid type variable bound by\n               the inferred type of f :: t at T10781.hs:6:1\n    Relevant bindings include f :: t (bound at T10781.hs:6:1)\n    In the expression: Foo._name\n    In an equation for \u00e2\u20ac\u02dcf\u00e2\u20ac\u2122: f = Foo._name\n-}\nf = Foo._name\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11071 where\n\nimport Data.List (lines)\nimport qualified Data.Map as M ()\nimport qualified Data.IntMap as M ()\nimport qualified Data.IntMap as M () -- just to see if this confused the code\n\nimport qualified Data.Ord as Ord hiding (Down)\n\nimport qualified Data.Map as M' hiding (size, filter)\nimport qualified Data.Map as M' hiding (size)\nimport qualified Data.IntMap as M' hiding (size)\nimport qualified System.IO as M' () -- unrelated\n\nignore :: a -> IO ()\nignore = const (return ())\n\nmain = do\n    ignore NoSuchModule.foo  -- no such module\n    ignore Data.List.foobar  -- does not exist (one import)\n    ignore M.foobar          -- does not exist (two imports)\n    ignore M'.foobar         -- does not exist (three imports)\n    ignore Data.List.sort    -- needs import\n    ignore Data.List.unlines -- needs import, similar to imported\n    ignore M.size            -- multiple modules to import from\n    ignore M.valid           -- only one module to import from\n    ignore Ord.Down          -- explicit hiding\n    ignore M'.size           -- hidden and/or missing in import list\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11071 where\n\nimport Data.List (lines)\nimport Data.IntMap ()\nimport Data.Ord hiding (Down)\nimport Prelude hiding (True)\n\nignore :: a -> IO ()\nignore = const (return ())\n\nmain = do\n    ignore intersperse       -- missing in import list (one import)\n    ignore foldl'            -- missing in import list (two imports)\n    ignore Down              -- explicitly hidden\n    ignore True              -- explicitly hidden from prelude (not really special)\n    ignore foobar            -- genuinely out of scope\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule Bug11592 where\n\ndata A (a :: a) = MkA String\n\ndata B b (a :: a b) = MkB String\ndata C b (a :: b a) = MkC String\n\ndata D b c (a :: c a b) = MkD String\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11663 where\n\n-- All of these should fail as type signatures are not allowed\n-- in patterns without -XScopedTypeVariables.\nhello0 = \\(h :: Int) -> print h\nhello1 (h :: Int) = print h\nhello2 = case 54 of (x :: Int) -> print x\nhello4 = case Just 54 of Just (x :: Int) -> print x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test Trac #12146\n\nmodule T12146 where\n\nipmort Data.Char\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\nmodule T12229 where\n\ndata T = MkT { x, pi :: Float }\n\nf x = MkT { .. }  -- 'pi' is not initialised, because\n                  -- there is no local binding\n\ng x pi = MkT { .. }  -- 'pi' is initialised\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12681 where\nimport qualified T12681a\n\nx = T12681a.A { a = 0 }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12681a where\n  data A = A { a :: Int }\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12686 where\n\nimport Data.Proxy\n\nx = True\n\ndata Bad = Bad 'x\n-- The 'x should be rejeted in a civilised way\n\ndata AlsoBad = AlsoBad {\n  a :: Int,\n  b :: Either Int 'a }\n-- Ditto 'a here\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\nmodule ShouldFail where\n\nf x = x@x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13568 where\n\nimport T13568a\n\ndata S = A\n\nfoo :: A -> ()\nfoo = undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13568a where\n\ndata T = A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13644 where\n\nimport T13644A\n\nbaseENDECfuncs :: FuncId -> ()\nbaseENDECfuncs FuncId{ name = nm } = undefined\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13644A\n(\n  FuncId(FuncId)\n, module X\n)\nwhere\n\nimport T13644C as X\n\nimport T13644B\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13644B where\n\ndata FuncId         = FuncId    { name       :: () }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13644C where\n\ndata T = T { name :: () }\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport qualified T13847A as A\nfoo = \"foo\"\nmain = print $ A.foo $ A.A { foo = () }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13847A where\ndata A = A { foo :: () }\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\nmodule T13947 where\n\nf :: () -> Int :~: Int\nf = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\n{-# LANGUAGE NamedFieldPuns #-}\n\nmodule T14307 where\n\ndata A = A { field :: Int }\ndata B = B { field :: Int }\n\nf :: B -> Int\nf (C { field }) = field\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the ordering constraint on the groupWith function is respected\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule T14591 where\n\nimport GHC.Exts (groupWith)\n\ndata Unorderable = Gnorf | Pinky | Brain\nfoo = [ ()\n      | Gnorf <- [Gnorf, Brain]\n      , then group by x using groupWith\n      ]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14907a where\n\nclass (Bool, a, b)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14907b where\n\n-- This is effectively trying to redefine the constraint tuples already\n-- defined in 'GHC.Classes'.\nclass ()\nclass (a,b)\nclass (a,b,c)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\nmodule T15214 where\n\ntype (~) = Either\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15487 where\n\nimport qualified T15487a\n\nnull = 42\n\nfoo x = null\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15487a (null) where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T15539 where\n\nfoo :: String\nfoo = show a\n  where a = baz\n\n-- We get top level constraints\n--     Show a\n--     forall . <not in scope baz>\n-- We want the insoluble non-in-scope error to suppress\n-- the Show a, just as it does if the whole things is nested\n\nbar :: Int\nbar = 1\n\nbam = putStrLn foo\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\nmodule T15607 where\n\nimport Prelude hiding (pure, return)\n\nt = do { pure 5 }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = Main.foo\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15611b where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15659 where\n\n{-# RULES \"test\" forall x. f x  = x #-}\n\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ExplicitForAll #-}\n\nmodule T15828 where\n\nclass C a where\n  type T a b\n\ninstance C (Maybe a) where\n  type forall a b. T (Maybe a) b = b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE NamedFieldPuns #-}\nmodule T15957_Fail where\n\ndata P = P { x :: Int, y :: Int }\n\nf1 P{..} = 1 + 3 -- nothing bound is used\nf2 P{x, ..} = x + 3 -- y bound but not used\nf3 P{x, y, ..} = x + y -- no bindings left, i.e. no new useful bindings introduced\n\ng2 P{x=a, ..} = a + 3\ng3 P{x=a, y=b, ..} = a + b\ng4 P{x=0, y=0,..} = 0\ng4 _ = 0\n\n-- Record wildcards in lets have different scoping rules.. they bring\n-- all the identifiers into scope\ndo_example :: IO Int\ndo_example = do\n  let P{..} = P 1 2\n  return $ 0\n\nlet_in_example :: Int\nlet_in_example =\n  let P{..} = P 1 2\n  in 0\n\ndata Q = Q { a, b :: P }\n\nnested :: Q -> Int\nnested Q { a = P{..}, .. } = (case b of (P x1 _) -> x1)\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T1595a where\n\na, b :: Integer -> Tpyo\na = undefined\nb = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T16002 where\n\ndata A\ntype family B (x :: *) :: * where\n  A x = x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16114 where\n\ndata T a\ninstance Eq a => Eq a => Eq (T a) where (==) = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T16116b where\n\nclass C a where\n  type F a\ninstance C [a] where\n  type F [a] = b\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule T16385 where\n\ninstance c\ninstance forall c. c\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2490\nmodule ShouldFail where\n\n-- All these sections are illegal\n\nf x = [ (`head` x, ())\n      , (+ x, ())\n      , ((), + x)\n      , ((), + x, ())\n      , ((), x +) ]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-name-shadowing -XNamedFieldPuns -XRecordWildCards #-}\nmodule WildCard where\n\ndata Record = Record {field1 :: Int, field2 :: Double}\n\nfield3 :: Int\nfield3 = 3\n\ntest1 (Record {field1, field2}) = let test = 1 in field1\n\ntest2 :: (Record, Int)\ntest2 = let\n    field1 = 10\n    field2 = 10.0\n    field3 = 8\n    in (Record {..}, field3)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DisambiguateRecordFields #-}\n-- Trac #2901\n\nmodule T2901 where\n\nf = F.Foo { F.field = \"\" }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n\n-- Trac #2993\n\nmodule T2993 where\n\nfoo b a = a <**> b . b\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\n-- Test Trac #3265\n\nmodule T3265 where\n\ndata a :+: b = Left a | Right b\n\nclass a :*: b where {}\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T3792 where\n\nimport Prelude( Prelude.map )   -- Illegal\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test Trac #4042\n\nmodule T4042 where\n\nf :: A -> A\nf\n-- The above line is a naked Template Haskell splice\n-- When compiling without -XTemplateHaskell we don't\n-- want a confusing error message saying \"A is not in scope\"\n\ndata A = A\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\nmodule T5001b where\n\nclass GEnum a where\n     genum :: [a]\n     default genum :: [a]\n     genum = undefined\n\ninstance GEnum Int where\n     {-# INLINE genum #-}\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-imports  #-}\nmodule RedundantImport where\n\n-- this import is redundant, but GHC does not spot it\nimport qualified Foreign.Storable\n\nimport Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )\nimport Foreign.Ptr (castPtr, )\n\nnewtype T a = Cons a\n\ninstance Storable a => Storable (T a) where\n   sizeOf (Cons a) = sizeOf a\n   alignment (Cons a) = alignment a\n   peek = fmap Cons . peek . castPtr\n   poke p (Cons a) = poke (castPtr p) a\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The issue here is getting an error message with a decent source location\nmodule T5281 where\n\nimport T5281A\n\nx = deprec\n\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T5281A where\n\n{-# DEPRECATED deprec \"This is deprecated\" #-}\ndeprec :: Int\ndeprec = 5\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DisambiguateRecordFields #-}\nmodule T5372 where\nimport qualified T5372a\nnotScope (MkS { x = n }) = n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5372a where\ndata S = MkS { x :: Int, y :: Bool }\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5385 where\n\nimport T5385a( (:::) )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5385a where\n\ndata T = Int ::: Int\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\nmodule T5513 where\n\nderiving instance lowercase_name a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5533 where\n\ndata T a = CT {f1 :: Int -> a, f2 :: Double}\nf2 :: Int -> Double\ng x = CT {f1 = \\t -> f2 t + x, f2 = x}\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5589 where\n\nbbb, aaa :: Int\naaa :: Int\naaa = undefined\nbbb = undefined\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5657 where\n\nfoo = [LT..GT]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5745 where\n\nimport T5745a\n\nf :: T\nf = f\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5745a( module T5745b ) where\n\nimport T5745b hiding( T )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5745b where\n\ndata T = MkT\ndata S = MkS\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# OPTIONS_GHC -Werror #-}\n\nmodule T5892a where\n\nimport Data.Tree ( Tree( Node, rootLabel ))\n-- Not importing field 'subForest'\n\nfoo :: Tree [Int] -> Tree [Int]\nfoo (Node {..}) -- Pattern match does not bind 'subForest'\n  = let rootLabel = []\n    in Node {..}   -- Hence warning here\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\nmodule T5892b where\n\nimport Data.Tree ( Tree( Node, rootLabel ))\n-- Not importing field 'subForest'\n\nNode{..} = Node [] []\n-- Binds 'rootLabel' only\n\nfoo = T5892b.rootLabel\nbar = T5892b.subForest\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5951 where\n\nclass A a \nclass B b\nclass C c\n\ninstance\n       A =>\n       B =>\n       C where\n         foo = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\n\nmodule T6018rnfail where\n\n-- IA = injectivity annotation `| foo -> bar`\n\n-- use incorrect tyvar in LHS of IA\ntype family F a = r | a -> a\ntype family Fc a = r | a -> a where\n  Fc a = a\nclass Fcl a where\n  type Ft a = r | a -> a\n\n-- declare result tyvar to be duplicate (without IA)\ntype family G a = a\ntype family Gc a = a where\n  Gc a = a\n\n-- declare result tyvar to be duplicate (with IA)\ntype family Gb a = a | a -> a\ntype family Gcb a = a | a -> a where\n  Gcb a = a\nclass Gclb a where -- here we want two errors\n  type Gtb a = a | a -> a\n\n-- not in-scope tyvar in RHS of IA\ntype family I a b = r | r -> c\ntype family Ic a b = r | r -> c where\n  Ic a b = a\nclass Icl a b where\n  type It a b = r | r -> c\n\n-- not in-scope tyvar in LHS of IA\ntype family L a b = r | c -> a\ntype family Lc a b = r | c -> a where\n  Lc a b = a\nclass Lcl a b where\n  type Lt a b = r | c -> a\n\n-- result variable shadows variable in class head\nclass M a b where\n  type Mt b = a | a -> b\n\n-- here b is out-of-scope\nclass N a b where\n  type Nt a = r | r -> a b\n\n-- result is out of scope. Not possible for associated types\ntype family O1  a | r -> a\ntype family Oc1 a | r -> a where\n    Oc1 a = a\ntype family O2  a :: * | r -> a\ntype family Oc2 a :: * | r -> a where\n    Oc2 a = a\n", "num_lines": 55}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ParallelListComp #-}\n\nmodule T6060 where\n\nfoo = do let bad = [True | x <- [] | y <- []]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6148 where\n\na = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,\n         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)\n\n\nb = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)\n\ndata T = T\n\nc :: (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) \n     T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T\n     T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T\n     T T T\nc = c\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7164 where\n\nclass Foo m where\n    herp :: (a -> a) -> m b -> m b\n    derp :: m a\n\nderp :: Int\nderp = 123\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7338 where\n\na, a :: Int\na :: Int\na = 0\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7338a where\n\na, b :: Int\na = undefined\nb = undefined\n\nc, a :: Int\nc = undefined\n\nc, d :: Int\nd = undefined", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-imports #-}\n\nmodule T7454 where\n\nimport Control.Arrow( Arrow, arr )\n\nfoo () = arr\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7906 where\n\nclass Foo f where\n    foo :: f\n{-# INLINABLE foo #-}\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7937 where\n\n-- Without this operator definition, a precedence parsing error is reported.\n-- Perhaps the default precedence is being assumed for the unknown operator?\n-- That seems wrong, since there's no way to know what the precedence will be when\n-- the operator is defined as the programmer intended.\n\nfoo = 3 > 4 *** 5 == 6\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7943 where\n\ndata Foo = A { bar :: String }\n          | B String { bar :: String }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n\nmodule T8149 where\n\nimport Control.Monad.Trans.Writer (WriterT, runWriterT)\n\nfoo :: Bool\nfoo = runWriterT `seq` True\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\nmodule T8448 where\n\ndata R = R {r :: Int}\nf x = undefined [] {r = x}\n\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9006 where\n\nimport T9006a (T(T))\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9006a( T )where\n\ndata T = T\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\nmodule T9032 where\n\n#ifdef ERR\nimport T9032\n#endif\n\nf x = x\n\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9077 where\n\nmain :: IO {}\nmain = print \"hello\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9156 where\n\ndata D = D1 { f1 :: Int }\n       | D2 { f1, f1 :: Int }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9177 where\n\n-- the main use case\ntype Foo = (int)\n\n-- other interesting cases\ntype Foo2 = (integerr)\n\n-- These two out-of-scope errors aren't caught until\n-- the type checker, so they aren't reported at all\n-- because the renamer aborts compilation\nfoo3 = bar\nfoo4 = Fun\n\n-- this warning is suboptimal (fun would be illegal here)\nfoo5 Fun = ()\n\n-- No errors here:\ndata Bar = Bar\nfun x = x\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9177a where\n\nfoo3 = bar\nfoo4 = Fun\n\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\nmodule T9436 where\n\ndata T = T { x :: Int }\n\nf :: T -> Int\nf (T' { .. }) = x + 1\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\nmodule T9437 where\n\ndata Foo = Foo { x :: Int }\n\ntest :: Foo -> Foo\ntest foo = foo { .. }\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\nmodule T9815 where\n\nnewtype N = N Int deriving (Show)\n\nfoo = print N{..}\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations, PolyKinds #-}\n\nmodule Roles1 where\n\nimport Data.Kind (Type)\n\ndata T1 a = K1 a\ndata T2 a = K2 a\ndata T3 (a :: k) = K3\ndata T4 (a :: Type -> Type) b = K4 (a b)\n\ndata T5 a = K5 a\ndata T6 a = K6\ndata T7 a b = K7 b\n\ntype role T1 nominal\ntype role T2 representational\ntype role T3 phantom\ntype role T4 nominal _\ntype role T5 _\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- tests axiom roles\n\nmodule Roles13 where\n\nnewtype Age = MkAge Int\nnewtype Wrap a = MkWrap a\n\nconvert :: Wrap Age -> Int\nconvert (MkWrap (MkAge i)) = i\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations, IncoherentInstances #-}\n\nmodule Roles12 where\n\ntype role C2 representational\nclass C2 a where\n  meth2 :: a -> a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Roles2 where\n\nimport GHC.Ptr\n\n-- these *must* have certain roles, or things break strangely\n-- see TcForeign\n\ndata T1 a = K1 (IO a)\ndata T2 a = K2 (FunPtr a)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}  -- meth3, meth4 are ambiguous\n\nmodule Roles3 where\n\nclass C1 a where\n  meth1 :: a -> a\n\nclass C2 a b where\n  meth2 :: a ~ b => a -> b\n\nclass C3 a b where\n  type F3 b\n  meth3 :: a -> F3 b -> F3 b\n\ntype family F4 a\n\nclass C4 a b where\n  meth4 :: a -> F4 b -> F4 b\n\ntype Syn1 a = F4 a\ntype Syn2 a = [a]", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n\nmodule Roles4 where\n\ntype role C1 nominal\nclass C1 a where\n  meth1 :: a -> a\n\ntype Syn1 a = [a]\n\nclass C3 a where\n  meth3 :: a -> Syn1 a\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\nmodule T10263 where\n\ndata Maybe a = AF\ntype role Maybe representational\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\nmodule T14101 where\n\ntype role Array representational\ndata Array a\n\ntype Arr = Array\n\ndata Foo a = Foo (Arr a)\ntype role Foo representational\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations, DatatypeContexts, IncoherentInstances,\n             FlexibleInstances #-}\n\nmodule T8958 where\n\nclass Nominal a\ninstance Nominal a\n\nclass Representational a\ninstance Representational a\ntype role Representational representational\n\nnewtype (Nominal k, Representational v) => Map k v = MkMap [(k,v)]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9204b where\n\nimport T9204b2\n\ndata P a = P\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9204b2 where\n\nimport {-# SOURCE #-} T9204b\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}\n\nmodule Roles10 where\n\ntype family F a\ntype instance F Int = Bool\ntype instance F Age = Char\n\nclass C a where\n  meth :: a -> F a\n\ninstance C Int where\n  meth = (> 0)\n\nnewtype Age = MkAge Int\n  deriving C", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RoleAnnotations #-}\n\nmodule Roles11 where\n\ntype role T2 representational\ndata T2 a where\n  K2 :: T2 Int\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Roles12 where\n\nimport Roles12a\n\ndata T a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Roles12a where\nimport {-# SOURCE #-} Roles12\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Roles5 where\n\ndata T a\nclass C a\ntype S a = Int\n\ntype role T nominal\ntype role C representational\ntype role S phantom", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n\nmodule Roles6 where\n\ndata Foo a b = MkFoo (a b)\n\ntype role Foo nominal representational phantom\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n\nmodule Roles7 where\n\nclass Bar a\ntype role Bar repesentational\n -- spelling error intentional!", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations, GADTs #-}\n\nmodule Roles8 where\n\ndata T1 a = K1 a\n\ntype role T1 nominal\ntype role T1 nominal\n\ndata T2 b = MkT2\n\ntype role T2 representational\ntype role T2 phantom", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\nmodule RolesIArray where\n\nimport Data.Word\nimport Data.Array.IArray\nimport Data.Array.Unboxed\n\nnewtype N = MkN Word64\n  deriving (IArray UArray)", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n\nmodule T8773 where\n\ntype role C2 representational\nclass C2 a where\n  meth2 :: a -> a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T9204 where\n\nimport T9204a\n\ndata D a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9204a where\nimport {-# SOURCE #-} T9204\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Exception\nimport Control.Monad\nimport Data.List\nimport System.Mem\n\nmain = do\n  let\n    testAlloc n = do\n      let start = 999999\n      setAllocationCounter start\n      evaluate (last [1..n])\n      c <- getAllocationCounter\n      -- print (start - c)\n      return (start - c)\n  results <- forM [1..1000] testAlloc\n  print (sort results == results)\n    -- results better be in ascending order\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nbreak2 p (x:xs) = if p x then \n                    ([],x:xs)\n                  else\n                    let (b1,b2) = break2 p xs\n                    in  (x : b1, b2)\nbreak2 p []     = ([],[])\n\nsurprise xs = b1 ++ \"\\n surprise \" ++ b2\n               where\n               (b1,b2) = break2 (=='\\n') xs\n\ntest n = length $ surprise $ [head (show i) | i <-[1..n] ] ++ \"\\n the end\"\n\nmain = print $ test 10000\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-\nBy default, on Windows a segfault will pop up an annoying dialog box.\nWe want the RTS to catch it instead.\n-}\n\nmodule Main where\n\nimport Foreign\n\nmain :: IO ()\nmain = do x <- peek nullPtr\n          print (x :: Int)\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-\nBy default, on Windows a division-by-zero will pop up an annoying dialog box.\nWe want the RTS to catch it instead.\n-}\n\nmodule Main where\n\nimport GHC.Base\n\nmain :: IO ()\nmain = print (5 `divInt` 0)\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = return ()\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Process\nimport System.Posix.Signals\nimport Control.Monad(when)\n\ndata SigState = Ignored | Default | Handled\n    deriving (Eq, Read, Show)\n\ndata ChildInfo = ChildInfo {\n        masked :: [(Int,Bool)],\n        handlers :: [(Int, SigState)] }\n    deriving (Read, Show)\n\nmain = do out <- readProcess \"./exec_signals_child\" [] \"\"\n          let ci = read out :: ChildInfo\n              blockedSigs = [x | (x, True) <- masked ci]\n              ignoredSigs = [x | (x, Ignored) <- handlers ci]\n          when (not $ null blockedSigs) $\n            putStrLn (\"signals \" ++ show blockedSigs ++ \" are blocked\")\n          when (not $ null ignoredSigs) $\n            putStrLn (\"signals \" ++ show ignoredSigs ++ \" are ignored\")\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\nimport Foreign.Ptr\n\nmain = do\n  fptr <- wrap $ return . (*4)\n  forkIO $ forever $ do\n    _ <- dyn fptr 4\n    return ()\n  threadDelay $ 100 * 1000\n\nforeign import ccall \"wrapper\" wrap :: (Double -> IO Double) -> IO (FunPtr (Double -> IO Double))\nforeign import ccall \"dynamic\" dyn :: FunPtr (Double -> IO Double) -> Double -> IO Double\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A test to show that -XStaticPointers keeps generated CAFs alive.\n{-# LANGUAGE StaticPointers #-}\nmodule Main where\n\nimport GHC.StaticPtr\n\nimport Control.Concurrent\nimport Data.Maybe (fromJust)\nimport GHC.Fingerprint\nimport System.Mem\nimport System.Mem.Weak\nimport Unsafe.Coerce (unsafeCoerce)\n\nnats :: [Integer]\nnats = [0 .. ]\n\n-- The key of a 'StaticPtr' to some CAF.\nnats_key :: StaticKey\nnats_key = staticKey (static nats :: StaticPtr [Integer])\n\nmain = do\n  let z = nats !! 400\n  print z\n  performGC\n  addFinalizer z (putStrLn \"finalizer z\")\n  print z\n  performGC\n  threadDelay 1000000\n  Just p <- unsafeLookupStaticPtr nats_key\n  print (deRefStaticPtr (unsafeCoerce p) !! 800 :: Integer)\n  -- Uncommenting the next line keeps 'nats' alive and would prevent a segfault\n  -- if 'nats' were garbage collected.\n  -- print (nats !! 900)\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module KeepCafs1 where\n\nimport KeepCafsBase\n\nforeign export ccall \"getX\"\n  getX :: IO Int\n\ngetX :: IO Int\ngetX = return x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module KeepCafs2 where\n\nimport KeepCafsBase\n\nforeign export ccall \"getX\"\n  getX :: IO Int\n\ngetX :: IO Int\ngetX = return (x + 1)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module KeepCafsBase (x) where\n\nx :: Int\nx = last [1..1000]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Foreign\nimport GHCi.ObjLink\nimport System.Mem\nimport System.Exit\n\nforeign import ccall \"dynamic\"\n  callGetX :: FunPtr (IO Int) -> IO Int\n\nmain :: IO ()\nmain = do\n  initObjLinker DontRetainCAFs\n  let\n    loadAndCall obj = do\n      loadObj obj\n      resolveObjs\n      r <- lookupSymbol \"getX\"\n      case r of\n        Nothing -> die \"cannot find getX\"\n        Just ptr -> callGetX (castPtrToFunPtr ptr) >>= print\n      unloadObj obj\n      performGC\n  loadAndCall \"KeepCafs1.o\"\n  loadAndCall \"KeepCafs2.o\"\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module LinkerUnload (init) where\n\nimport GHC\nimport DynFlags\nimport Linker\nimport System.Environment\nimport MonadUtils ( MonadIO(..) )\n\nforeign export ccall loadPackages :: IO ()\n\nloadPackages :: IO ()\nloadPackages = do\n  [libdir] <- getArgs\n  runGhc (Just libdir) $ do\n    dflags <- getSessionDynFlags\n    let dflags' = dflags { hscTarget = HscNothing\n                         , ghcLink  = LinkInMemory }\n    pkgs <- setSessionDynFlags dflags'\n    hsc_env <- getSession\n    liftIO $ Linker.linkPackages hsc_env pkgs\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A test to show that Static Pointers can be listed.\n{-# LANGUAGE StaticPointers #-}\nmodule Main where\n\nimport Control.Monad (when)\nimport Data.List ((\\\\))\nimport GHC.StaticPtr\nimport System.Exit\n\nmain = do\n    found <- staticPtrKeys\n    when (not $ eqBags found expected) $ do\n      print (\"expected\", expected)\n      print (\"found\", found)\n      exitFailure\n  where\n\n    expected =\n      [ staticKey $  static (\\x -> x :: Int)\n      , staticKey   (static return :: StaticPtr (Int -> IO Int))\n      , staticKey $  static g\n      ]\n\n    eqBags :: Eq a => [a] -> [a] -> Bool\n    eqBags xs ys = null (xs \\\\ ys) && null (ys \\\\ xs)\n\ng :: Int -> Int\ng = (+1)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment\nimport Control.Monad\nimport Control.Concurrent\n\nmain = do\n  [n] <- map read <$> getArgs\n  mvars <- replicateM n newEmptyMVar\n  sequence_ [ forkIO $ putMVar m $! nsoln n\n            | (m,n) <- zip mvars (repeat 9) ]\n  mapM_ takeMVar mvars\n\nnsoln nq = length (gen nq)\n where\n    safe :: Int -> Int -> [Int] -> Bool\n    safe x d []    = True\n    safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l\n\n    gen :: Int -> [[Int]]\n    gen 0 = [[]]\n    gen n = [ (q:b) | b <- gen (n-1), q <- [1..nq], safe q 1 b]\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for a bug that provoked the following assertion failure:\n-- nursery-chunks1: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 903\nmodule Main (main) where\n\nimport Control.Monad\nimport System.Environment\nimport GHC.Conc\n\nmain = do\n  [n,m] <- fmap read <$> getArgs\n  forM_ [1..n] $ \\n' ->\n    when (sum [1.. m::Integer] > 0) $ setNumCapabilities (fromIntegral n')\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport Data.Array.IO\nimport Control.Monad\nmain = do\n  arrs <- sequence $ repeat $ (newArray_ (0,2^28) :: IO (IOUArray Int Int))\n        -- larger than 2^28 causes other problems...\n  print (length arrs)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for bug #1791\nimport Control.Monad.ST \nimport Data.Array.ST\nimport Data.Array.MArray\nimport Data.Array.Base(unsafeNewArray_)\nmain = print (runST (do make_empty_table >> return ()))\n\nmake_empty_table::  ST s (STArray s (Int, Int) (Maybe ep))\nmake_empty_table = \n       unsafeNewArray_ ((1, 1), (16384, 16384))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\nimport GHC.Exts\nimport GHC.Base\n\n-- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate()\n-- Here we invoke allocate() via newByteArray#.\n-- Request a number of bytes close to HS_WORD_MAX,\n-- subtracting a few words for overhead in newByteArray#.\nmain :: IO ()\nmain =\n    IO $ \\s1# ->\n           case newByteArray# (maxInt# -# 10#) s1# of\n             (# s2#, _ #) -> (# s2#, () #)\n  where\n    maxInt# :: Int#\n    !(I# maxInt#) = maxBound\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\nimport Foreign\n\n-- Test allocate(), the easy way.\ndata Cap = Cap\nforeign import ccall \"rts_unsafeGetMyCapability\" myCapability :: IO (Ptr Cap)\nforeign import ccall \"allocate\" allocate :: Ptr Cap -> Word -> IO (Ptr ())\n\n-- Number of words n such that n * sizeof(W_) exactly overflows a word\n-- (2^30 on a 32-bit system, 2^61 on a 64-bit system)\noverflowWordCount :: Word\noverflowWordCount = fromInteger $\n                    (fromIntegral (maxBound :: Word) + 1) `div`\n                    fromIntegral (sizeOf (undefined :: Word))\n\nmain = do\n  cap <- myCapability\n  allocate cap (overflowWordCount - 1)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\nimport Foreign\n\n-- Test allocate(), the easy way.\ndata Cap = Cap\nforeign import ccall \"rts_unsafeGetMyCapability\" myCapability :: IO (Ptr Cap)\nforeign import ccall \"allocate\" allocate :: Ptr Cap -> Word -> IO (Ptr ())\n\n-- Number of words n such that n * sizeof(W_) exactly overflows a word\n-- (2^30 on a 32-bit system, 2^61 on a 64-bit system)\noverflowWordCount :: Word\noverflowWordCount = fromInteger $\n                    (fromIntegral (maxBound :: Word) + 1) `div`\n                    fromIntegral (sizeOf (undefined :: Word))\n\nmain = do\n  cap <- myCapability\n  allocate cap (overflowWordCount + 1)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | A test to load symbols exposed with @-rdynamic@.\n--\n-- Exporting 'f' from Main is important, otherwise, the corresponding symbol\n-- wouldn't appear in symbol tables.\n--\n{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE MagicHash                #-}\n{-# LANGUAGE UnboxedTuples            #-}\nmodule Main(main, f) where\n\nimport Foreign.C.String ( withCString, CString )\nimport GHC.Exts         ( addrToAny# )\nimport GHC.Ptr          ( Ptr(..), nullPtr )\nimport System.Info      ( os, arch )\nimport Encoding\n\nmain = (loadFunction Nothing \"Main\" \"f\" :: IO (Maybe String)) >>= print\n\nf :: String\nf = \"works\"\n\n-- loadFunction__ taken from\n-- @plugins-1.5.4.0:System.Plugins.Load.loadFunction__@\nloadFunction :: Maybe String\n             -> String\n             -> String\n           -> IO (Maybe a)\nloadFunction mpkg m valsym = do\n    c_initLinker\n    let symbol = prefixUnderscore\n                   ++ maybe \"\" (\\p -> zEncodeString p ++ \"_\") mpkg\n                   ++ zEncodeString m ++ \"_\" ++ zEncodeString valsym\n                   ++ \"_closure\"\n    ptr@(Ptr addr) <- withCString symbol c_lookupSymbol\n    if (ptr == nullPtr)\n    then return Nothing\n    else case addrToAny# addr of\n           (# hval #) -> return ( Just hval )\n  where\n    prefixUnderscore = case (os, arch) of\n                         (\"mingw32\", \"x86_64\") -> \"\"\n                         (\"cygwin\" , \"x86_64\") -> \"\"\n                         (\"mingw32\", _       ) -> \"_\"\n                         (\"darwin\" , _       ) -> \"_\"\n                         (\"cygwin\" , _       ) -> \"_\"\n                         _                     -> \"\"\n\nforeign import ccall safe \"lookupSymbol\" c_lookupSymbol :: CString -> IO (Ptr a)\nforeign import ccall safe \"initLinker\" c_initLinker :: IO ()\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nimport Control.Concurrent\nimport System.IO\nimport System.Mem\n\nmain :: IO ()\nmain = do hSetBuffering stdout LineBuffering\n          mapM_ doIter [1..3]\n\ndoIter :: Int -> IO ()\ndoIter n = do putStrLn (\"Iteration \" ++ show n)\n              let xs = [n .. 1000000 + n]\n              putStrLn (\"Last: \" ++ show (last xs))\n              putStrLn \"GC 1 start\"\n              performGC\n              putStrLn \"GC 1 done\"\n              putStrLn (\"Head: \" ++ show (head xs))\n              putStrLn \"GC 2 start\"\n              performGC\n              putStrLn \"GC 2 done\"\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = return ()\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = return ()\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Mem.StableName\nimport System.Mem\n\n-- Test that we get the same StableName even after a GC.  This is easy\n-- to get wrong, by not following indirections properly.\n\nmain = do\n  let x = [1..10]\n  seq x (return ())\n  n1 <- makeStableName x\n  performGC\n  n2 <- makeStableName x\n  print (n1 == n2)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\nimport Control.Exception\n\nmain = do\n  -- stack will grow as we evaluate the expression, and then shrink again\n  evaluate $ foldr (+) 0 [1..200000]\n  threadDelay 10 -- allow stack to shrink back to its smallest size\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n#include \"stack001.hs\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Exts\nimport System.Environment\n\nmain = do\n  [n] <- fmap (fmap read) getArgs\n  case g n of\n    (# a, b, c, d, e, f, g, h, i #) -> print a\n\n-- a deep stack in which each frame is an unboxed tuple-return, to exercise\n-- the stack underflow machinery.\ng :: Int -> (# Int,Float,Double,Int#,Float#,Double#,Int,Float,Double #)\ng 0 = (# 1, 2.0, 3.0, 1#, 2.0#, 3.0##, 1, 2.0, 3.0 #)\ng x = case g (x-1) of\n        (# a, b, c, d, e, f, g, h, i #) ->\n          (# a+1, b, c, d, e, f, g, h, i #)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Monad\nimport GHC.RTS.Flags\n\n-- Ensure that +RTS -K0 is parsed\nmain :: IO ()\nmain = do\n    flags <- getGCFlags\n    unless (maxStkSize flags == 0) $ putStrLn \"uh oh\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport System.Posix.Signals\n\nmain :: IO ()\nmain = do\n    _ <- flip (installHandler sig) Nothing $ Catch $\n        putStrLn $ \"Received my signal\"\n    raiseSignal sig\n    threadDelay 100000\n  where\n    sig = sigUSR2\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A reduced version of the original test case\n\n{-# LANGUAGE ForeignFunctionInterface #-}\n\n\nimport Control.Concurrent\nimport Control.Monad\nimport Foreign.C.Types\nimport Foreign.Ptr\n\n\nmain :: IO ()\nmain = do\n    mv <- newEmptyMVar\n    -- Fork a thread to continually dereference a stable pointer...\n    void $ forkIO $ f 1 1000000 >> putMVar mv ()\n    -- ...while we keep enlarging the stable pointer table\n    f 65536 1\n    void $ takeMVar mv\n  where\n    f nWraps nApplies = replicateM_ nWraps $ do\n                            -- Each call to wrap creates a stable pointer\n                            wrappedPlus <- wrap (+)\n                            c_applyFun nApplies wrappedPlus 1 2\n\n\ntype CIntFun = CInt -> CInt -> CInt\n\nforeign import ccall \"wrapper\"\n    wrap :: CIntFun -> IO (FunPtr CIntFun)\n\nforeign import ccall \"apply_fun\"\n    c_applyFun :: CInt -> FunPtr CIntFun -> CInt -> CInt -> IO CInt\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A variant of the T10296a.hs test case in which\n--   - the FFI machinery has been eliminated\n--   - a primop (deRefStablePtr#) is used to dereference the stable pointer\n--   - the stable pointers are explicitly freed at the end\n\n\nimport Control.Concurrent\nimport Control.Monad\nimport Foreign.StablePtr\n\n\nmain :: IO ()\nmain = do\n    sp <- newStablePtr ()\n    _ <- forkIO $ forever $ deRefStablePtr sp >> threadDelay 0\n    sps <- replicateM 1048576 $ newStablePtr ()\n    ----------------------------------------------------------\n    mapM_ freeStablePtr sps\n    freeStablePtr sp\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Foreign.C\nimport Foreign.Marshal.Array\nimport Foreign.Storable\nimport Control.Concurrent\n\n-- The test works only on UNIX like.\n-- unportable bits:\nimport qualified System.Posix.Internals as SPI\nimport qualified System.Posix.Types as SPT\n\npipe :: IO (CInt, CInt)\npipe = allocaArray 2 $ \\fds -> do\n    throwErrnoIfMinus1_ \"pipe\" $ SPI.c_pipe fds\n    rd <- peekElemOff fds 0\n    wr <- peekElemOff fds 1\n    return (rd, wr)\n\nmain :: IO ()\nmain = do\n    (r1, w1)  <- pipe\n    (r2, _w2) <- pipe\n    _ <- forkIO $ do -- thread A\n                     threadWaitRead (SPT.Fd r1)\n    _ <- forkIO $ do -- thread B\n                     threadWaitRead (SPT.Fd r2)\n    yield -- switch to A, then B\n          -- now both are blocked\n    _ <- SPI.c_close w1 -- unblocking thread A fd\n    _ <- SPI.c_close r2 -- breaking   thread B fd\n    yield -- kick RTS IO manager\n\n{-\n Trac #10590 exposed a bug as:\n   T10590: internal error: removeThreadFromDeQueue: not found\n    (GHC version 7.11.20150702 for x86_64_unknown_linux)\n    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n -}\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- T10728 test case for ``-maxN<n>``\n\nmodule Main where\n\nimport GHC.Conc (getNumProcessors, getNumCapabilities)\nimport GHC.Environment\nimport Data.List\n\nmain :: IO ()\nmain = do\n  -- We're parsing args passed in to make sure things are proper between the\n  -- cli and the program.\n  n <- getN <$> getFullArgs\n\n  c <- getNumCapabilities\n  p <- getNumProcessors\n\n  putStr $ check n c p\n\n-----\n\ncheck :: Int -> Int -> Int -> String\ncheck n c p\n  |  n /= 0 && c /= 0 && p /= 0 -- These should never be 0\n  -- Capabilities are equal to n, are they also within processor count?\n  && (n == c && c <= p)\n  -- Capabilities are equal to processor count, are they also within n?\n  || (c == p && c <= n)\n  = \"maxN Successful\"\ncheck _n _c _p = \"maxN Error\"\n\n-- Parsing ``-maxN<n>`` from Args to be sure of it.\ngetN :: [String] -> Int\ngetN args = case filter (isPrefixOf \"-maxN\") (reverse args) of\n    (maxN:_) -> read (drop 5 maxN)\n    _        -> error \"Please pass `-maxN<n>` on command-line\"\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\nimport Foreign\nimport Foreign.C.Types\nimport System.Environment\n\n\nforeign import ccall safe \"finalizerlib.h init_value\"\n    init_value :: Ptr CInt -> IO ()\n\nforeign import ccall safe \"finalizerlib.h &finalize_value\"\n    finalize_value :: FinalizerPtr CInt\n\n\nallocateValue :: IO ()\nallocateValue = do\n    fp <- mallocForeignPtrBytes 10000\n    withForeignPtr fp init_value\n    addForeignPtrFinalizer finalize_value fp\n\n\nmain :: IO ()\nmain = do\n    [n] <- fmap (fmap read) getArgs\n    _ <- forkIO (loop n)\n    loop n\n  where\n    loop n = replicateM_ n allocateValue\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecursiveDo, LambdaCase, BangPatterns #-}\n\nimport Control.Monad.Fix\nimport Data.IORef\nimport System.Mem.Weak\nimport System.Mem\n\nimport Control.Monad\nimport Data.Foldable\n\ndata Pull = Pull\n  { weakSelf  :: Weak Pull\n  , compute :: Weak Pull -> IO Int\n  , invalidators :: IORef [Weak Pull]\n  , cached  :: IORef (Maybe Int)\n  }\n\n\nmakePull :: (Weak Pull -> IO Int) -> IO Pull\nmakePull f = do\n  rec\n    -- This seems to be the culprit, changing the order makes the weakRef get gc'ed\n    -- In this configuration it crashes\n\n    !foo <- Pull weak f <$> newIORef [] <*> newIORef Nothing\n    weak <- mkWeakPtr foo Nothing\n\n  return foo\n\n\ninvalidate :: Pull -> IO ()\ninvalidate p = do\n  writeIORef (cached p) Nothing\n  invs <- readIORef (invalidators p)\n  writeIORef (invalidators p) []\n  traverse_ (deRefWeak >=> traverse_ invalidate) invs\n\n\npull :: Weak Pull -> Pull -> IO Int\npull weak p = do\n  modifyIORef (invalidators p) (weak :)\n  pull' p\n\npull' :: Pull -> IO Int\npull' p = do\n  readIORef (cached p) >>= \\case\n    Nothing -> do\n      r <- compute p (weakSelf p)\n      writeIORef (cached p) (Just r)\n      return r\n\n    Just r -> return r\n\nadd :: Pull -> Int -> IO (Pull)\nadd p n = makePull (\\w -> (+n) <$> pull w p)\n\nmain = do\n  h <- newIORef 0\n\n  source <- makePull (const $ readIORef h)\n  p <- foldM add source (take 1000 (repeat 1))   -- 100 is not enough for crash\n\n  forM_ [1..10] $ \\i -> do\n\n    writeIORef h i\n    invalidate source -- Crashes here on second iteration\n\n    --performGC\n    -- This avoids the crash\n\n    print =<< pull' p\n\n\n\n\n\n\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"c\" c_exp :: Int\n\nmain = print c_exp\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n#if defined(i386_HOST_ARCH)\n# define WINDOWS_CCONV stdcall\n#elif defined(x86_64_HOST_ARCH)\n# define WINDOWS_CCONV ccall\n#else\n# error Unknown mingw32 arch\n#endif\n\nimport Foreign.C.String\n\nforeign import WINDOWS_CCONV \"_strdup\" strdup :: CString -> IO CString\nforeign import WINDOWS_CCONV \"strdup\" strdup2 :: CString -> IO CString\n\ndupString :: String -> IO String\ndupString str = newCString str >>= strdup >>= peekCString\n\ndupString2 :: String -> IO String\ndupString2 str = newCString str >>= strdup2 >>= peekCString\n\nmain =\n do print =<< dupString  \"Hello World!\"\n    print =<< dupString2 \"Hello Again World!\"\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Exception\nimport System.IO\nimport System.Posix\nimport System.Posix.IO\n\nmain = do\n  (pout1, pin1) <- createPipe\n  (pout2, _) <- createPipe\n  pid <- forkProcess $ do\n           hdl <- fdToHandle pin1\n           hSetBuffering hdl LineBuffering\n           handle (\\UserInterrupt{} -> hPutStrLn hdl \"caught\")\n                  $ do hPutStrLn hdl \"registered\"\n                       hdl2 <- fdToHandle pout2\n                       putStrLn =<< hGetLine hdl2\n  hdl <- fdToHandle pout1\n  hSetBuffering hdl LineBuffering\n  \"registered\" <- hGetLine hdl\n  signalProcess sigINT pid\n  putStrLn =<< hGetLine hdl\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Foreign\nimport Foreign.Ptr\nimport Foreign.C\n\nimport Foreign.Marshal.Array\n\nforeign import ccall unsafe \"mult\" mult :: Ptr CInt -> Ptr CInt\n                                        -> CInt -> IO CInt\n\nmain = do res <- withArray [1..10] $ \\a ->\n                 withArray [5..15] $ \\b ->\n                   mult a b 10\n          print res\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.Conc\n\nmain :: IO ()\nmain = setNumCapabilities 0\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test that isByteArray# returns True for large but not explicitly pinned byte\n-- arrays\n\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples  #-}\n\nimport Control.Monad\nimport GHC.Exts\nimport GHC.IO\n\nmain :: IO ()\nmain = do\n    pinned <- IO $ \\s0 ->\n      case newByteArray# 1000000# s0 of\n        (# s1, arr# #) ->\n            case isMutableByteArrayPinned# arr# of\n              n# -> (# s1, isTrue# n# #)\n    unless pinned $ putStrLn \"BAD\"\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport System.Timeout\n\nfuc :: Integer -> Integer\nfuc 0 = 1\nfuc n = n * fuc (n - 1)\n\nmain :: IO ()\nmain = do\n  let x = fuc 30000\n  timeout 1000 (print x)\n  print (x > 0)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Monad\nimport Data.Array.IO.Safe\nimport Data.Word\nimport GHC.Stats\nimport System.Exit\nimport System.Mem\n\nprintAlloc :: String -> IO (Word64, Word64)\nprintAlloc name = do\n    performGC\n    details <- gc <$> getRTSStats\n    let dat = (gcdetails_live_bytes details, gcdetails_mem_in_use_bytes details)\n    putStrLn $ name ++ \": \" ++ show dat\n    pure dat\n\nallocateAndPrint :: IO ()\nallocateAndPrint = do\n    -- allocate and touch a lot of memory (4MB * 260 ~ 1GB)\n    memoryHog <- forM [1 .. 300] $ \\_ ->\n        (newArray (0, 1000000) 0 :: IO (IOUArray Word Word32))\n    _ <- printAlloc \"with large allocation\"\n    -- do something with memory to prevent it from being GC'ed until now\n    forM_ memoryHog $ \\a -> void $ readArray a 0\n\nmain :: IO ()\nmain = do\n    (firstLive, firstTotal) <- printAlloc \"initial\"\n    allocateAndPrint\n    (lastLive, lastTotal) <- printAlloc \"final\"\n\n    -- Now there is no reason to have more memory allocated than at start\n    let ratio = fromIntegral lastTotal / fromIntegral firstTotal\n    putStrLn $ \"alloc ratio \" ++ show ratio\n    when (ratio > 1.5) $ exitFailure\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nimport GHC.Compact\nimport GHC.Int\nimport GHC.Prim\nimport GHC.IO\nimport GHC.Exts\n\ndata BA = ByteArray ByteArray#\n\nnewByteArray :: Int -> IO BA\nnewByteArray (I# sz) = IO $ \\s -> case newByteArray# sz s of {\n  (# s', arr# #) -> case unsafeFreezeByteArray# arr# s of {\n  (# s'', barr# #) -> (# s', ByteArray barr# #) }}\n\nmain :: IO ()\nmain = do\n  ByteArray arr1# <- fmap getCompact $ newByteArray 65000 >>= compact\n  ByteArray arr2# <- newByteArray 65000\n  print (I# (isByteArrayPinned# arr1#))\n  print (I# (isByteArrayPinned# arr2#))\n  putStrLn \"Finished\"\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport qualified Data.Set as Set\nimport Control.Monad\nimport Data.List\n\n---\n---\n---\n\ndata Direction = DirUp | DirLeft | DirRight | DirDown\n    deriving (Eq,Ord,Show,Read)\n\ndirections = [DirUp,DirLeft,DirRight,DirDown]\n\ncoordOffset DirUp = (-1,0)\ncoordOffset DirLeft = (0,-1)\ncoordOffset DirRight = (0,1)\ncoordOffset DirDown = (1,0)\n\nmove (r,c) d = (r+dr,c+dc) where (dr,dc) = coordOffset d\n\nsortPair (x,y) =\n    case compare x y of\n        EQ -> (x,y)\n        LT -> (x,y)\n        GT -> (y,x)\nmapPair12 f (x,y) = (f x,f y)\n\ncachedUsingList f = f'\n    where\n        list = map f [0..]\n        f' i = list !! i\n\nnubSorted [] = []\nnubSorted (x:xs) = nubSorted' x xs\n    where\n        nubSorted' x [] = [x]\n        nubSorted' x (y:ys)\n            | x == y  = nubSorted' x ys\n            | otherwise  = x : nubSorted' y ys\n\n---\n---\n---\n\nsize = 21\nlargestExplicitlyEnumeratedArea = 7\n\ntype Cell = (Int,Int)\ntype Edge = (Cell,Cell)\n\nmkEdge cell1 cell2 = sortPair (cell1,cell2)\n\ncellsAround area = nubSorted $ sort $\n    do\n        cell <- area\n        dir <- directions\n        let cell2 = move cell dir\n        guard $ cell2 `notElem` area\n        return $ cell2\n\nincreaseAreas areas = nubSorted $ sort $\n    do\n        area <- areas\n        cell2 <- cellsAround area\n        return $ sort $ cell2 : area\ngetAreas :: Int -> [[Cell]]\ngetAreasRaw 1 = [[(0,0)]]\ngetAreasRaw n = areas\n    where\n        areas = increaseAreas $ getAreas $ n - 1\ngetAreas = cachedUsingList getAreasRaw\n\ngetEdges area = mapPair12 (map snd) $ partition fst $ nubSorted $ sort $\n    do\n        cell <- area\n        dir <- directions\n        let cell2 = move cell dir\n        let isInternal = cell2 `elem` area\n        return (isInternal,mkEdge cell cell2)\n\ntype SizedArea = (Int,((Set.Set Cell,Set.Set Cell),(Set.Set Edge,Set.Set Edge)))\ngetExtendedAreas n =\n    do\n        area <- getAreas n\n        let areaAround = cellsAround area\n        let edgeInfo = getEdges area\n        return ((Set.fromList area,Set.fromList areaAround),mapPair12 Set.fromList edgeInfo)\n\ngetSizedAreasThrough :: Int -> [SizedArea]\ngetSizedAreasThrough n =\n    do\n        n' <- [1 .. n]\n        extendedArea <- getExtendedAreas n'\n        return $ (n',extendedArea)\n\nsizeForSizedArea (asize,_) = asize\nallSizedAreas = getSizedAreasThrough largestExplicitlyEnumeratedArea\n\nmain = print $ allSizedAreas\n\n", "num_lines": 103}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHCi.ObjLink\n\nlibrary_name = \"libfoo_script_T2615.so\" -- this is really a linker script\n\nmain = do\n  initObjLinker RetainCAFs\n  result <- loadDLL library_name\n  case result of\n    Nothing -> putStrLn (library_name ++ \" loaded successfully\")\n    Just x  -> putStrLn (\"error: \" ++ x)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print $ do x <- [ 0 .. 5 ] ; let { y = 5 - y } ; return y\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Control.Monad (guard)\n\nmain :: IO ()\nmain = print $ head z\n\nz :: [[Int]]\nz    =   do x1  <- [0..3]\n            x2  <- [0..3]\n            x3  <- [0..3]\n            x4  <- [0..3]\n            x5  <- [0..3]\n            x6  <- [0..3]\n            x7  <- [0..3]\n            x8  <- [0..3]\n            x9  <- [0..3]\n            x10 <- [0..3]\n            x11 <- [0..3]\n            x12 <- [0..3]\n            x13 <- [0..3]\n            x14 <- [0..3]\n            x15 <- [0..3]\n            x16 <- [0..3]\n            x17 <- [0..3]\n            x18 <- [0..3]\n            x19 <- [0..3]\n            x20 <- [0..3]\n            x21 <- [0..3]\n            x22 <- [0..3]\n            x23 <- [0..3]\n            x24 <- [0..3]\n            x25 <- [0..3]\n            x26 <- [0..3]\n            x27 <- [0..3]\n            x28 <- [0..3]\n            x29 <- [0..3]\n            x30 <- [0..3]\n            x31 <- [0..3]\n            x32 <- [0..3]\n            x33 <- [0..3]\n            x34 <- [0..3]\n            x35 <- [0..3]\n            x36 <- [0..3]\n            x37 <- [0..3]\n            x38 <- [0..3]\n            x39 <- [0..3]\n            x40 <- [0..3]\n            x41 <- [0..3]\n            x42 <- [0..3]\n            x43 <- [0..3]\n            x44 <- [0..3]\n            x45 <- [0..3]\n            x46 <- [0..3]\n            x47 <- [0..3]\n            x48 <- [0..3]\n            x49 <- [0..3]\n            x50 <- [0..3]\n            x51 <- [0..3]\n            x52 <- [0..3]\n            x53 <- [0..3]\n            x54 <- [0..3]\n            x55 <- [0..3]\n            x56 <- [0..3]\n            x57 <- [0..3]\n            x58 <- [0..3]\n            x59 <- [0..3]\n            x60 <- [0..3]\n            x61 <- [0..3]\n            x62 <- [0..3]\n            x63 <- [0..3]\n            x64 <- [0..3]\n            x65 <- [0..3]\n            x66 <- [0..3]\n            x67 <- [0..3]\n            x68 <- [0..3]\n            x69 <- [0..3]\n            x70 <- [0..3]\n            x71 <- [0..3]\n            x72 <- [0..3]\n            x73 <- [0..3]\n            x74 <- [0..3]\n            x75 <- [0..3]\n            x76 <- [0..3]\n            x77 <- [0..3]\n            x78 <- [0..3]\n            x79 <- [0..3]\n            x80 <- [0..3]\n            x81 <- [0..3]\n            x82 <- [0..3]\n            x83 <- [0..3]\n            x84 <- [0..3]\n            x85 <- [0..3]\n            x86 <- [0..3]\n            x87 <- [0..3]\n            x88 <- [0..3]\n            x89 <- [0..3]\n            x90 <- [0..3]\n            x91 <- [0..3]\n            x92 <- [0..3]\n            x93 <- [0..3]\n            x94 <- [0..3]\n            x95 <- [0..3]\n            x96 <- [0..3]\n            x97 <- [0..3]\n            x98 <- [0..3]\n            x99 <- [0..3]\n            x100 <- [0..3]\n            x101 <- [0..3]\n            x102 <- [0..3]\n            x103 <- [0..3]\n            x104 <- [0..3]\n            x105 <- [0..3]\n            x106 <- [0..3]\n            x107 <- [0..3]\n            x108 <- [0..3]\n            x109 <- [0..3]\n            x110 <- [0..3]\n            x111 <- [0..3]\n            x112 <- [0..3]\n            x113 <- [0..3]\n            x114 <- [0..3]\n            x115 <- [0..3]\n            x116 <- [0..3]\n            x117 <- [0..3]\n            x118 <- [0..3]\n            x119 <- [0..3]\n            x120 <- [0..3]\n            x121 <- [0..3]\n            x122 <- [0..3]\n            x123 <- [0..3]\n            x124 <- [0..3]\n            x125 <- [0..3]\n            x126 <- [0..3]\n            x127 <- [0..3]\n            x128 <- [0..3]\n            x129 <- [0..3]\n            x130 <- [0..3]\n            x131 <- [0..3]\n            x132 <- [0..3]\n            x133 <- [0..3]\n            x134 <- [0..3]\n            x135 <- [0..3]\n            x136 <- [0..3]\n            x137 <- [0..3]\n            x138 <- [0..3]\n            x139 <- [0..3]\n            x140 <- [0..3]\n            x141 <- [0..3]\n            x142 <- [0..3]\n            x143 <- [0..3]\n            x144 <- [0..3]\n            x145 <- [0..3]\n            x146 <- [0..3]\n            x147 <- [0..3]\n            x148 <- [0..3]\n            x149 <- [0..3]\n            x150 <- [0..3]\n            x151 <- [0..3]\n            x152 <- [0..3]\n            x153 <- [0..3]\n            x154 <- [0..3]\n            x155 <- [0..3]\n            x156 <- [0..3]\n            x157 <- [0..3]\n            x158 <- [0..3]\n            x159 <- [0..3]\n            x160 <- [0..3]\n            x161 <- [0..3]\n            x162 <- [0..3]\n            x163 <- [0..3]\n            x164 <- [0..3]\n            x165 <- [0..3]\n            x166 <- [0..3]\n            x167 <- [0..3]\n            x168 <- [0..3]\n            x169 <- [0..3]\n            x170 <- [0..3]\n            x171 <- [0..3]\n            x172 <- [0..3]\n            x173 <- [0..3]\n            x174 <- [0..3]\n            x175 <- [0..3]\n            x176 <- [0..3]\n            x177 <- [0..3]\n            x178 <- [0..3]\n            x179 <- [0..3]\n            x180 <- [0..3]\n            x181 <- [0..3]\n            x182 <- [0..3]\n            x183 <- [0..3]\n            x184 <- [0..3]\n            x185 <- [0..3]\n            x186 <- [0..3]\n            x187 <- [0..3]\n            x188 <- [0..3]\n            x189 <- [0..3]\n            x190 <- [0..3]\n            x191 <- [0..3]\n            x192 <- [0..3]\n            x193 <- [0..3]\n            x194 <- [0..3]\n            x195 <- [0..3]\n            x196 <- [0..3]\n            x197 <- [0..3]\n            x198 <- [0..3]\n            x199 <- [0..3]\n            x200 <- [0..3]\n            x201 <- [0..3]\n            x202 <- [0..3]\n            x203 <- [0..3]\n            x204 <- [0..3]\n            x205 <- [0..3]\n            x206 <- [0..3]\n            x207 <- [0..3]\n            x208 <- [0..3]\n            x209 <- [0..3]\n            x210 <- [0..3]\n            x211 <- [0..3]\n            x212 <- [0..3]\n            x213 <- [0..3]\n            x214 <- [0..3]\n            x215 <- [0..3]\n            x216 <- [0..3]\n            x217 <- [0..3]\n            x218 <- [0..3]\n            x219 <- [0..3]\n            x220 <- [0..3]\n            x221 <- [0..3]\n            x222 <- [0..3]\n            x223 <- [0..3]\n            x224 <- [0..3]\n            x225 <- [0..3]\n            x226 <- [0..3]\n            x227 <- [0..3]\n            x228 <- [0..3]\n            x229 <- [0..3]\n            x230 <- [0..3]\n            x231 <- [0..3]\n            x232 <- [0..3]\n            x233 <- [0..3]\n            x234 <- [0..3]\n            x235 <- [0..3]\n            x236 <- [0..3]\n            x237 <- [0..3]\n            x238 <- [0..3]\n            x239 <- [0..3]\n            x240 <- [0..3]\n            x241 <- [0..3]\n            x242 <- [0..3]\n            x243 <- [0..3]\n            x244 <- [0..3]\n            x245 <- [0..3]\n            x246 <- [0..3]\n            x247 <- [0..3]\n            x248 <- [0..3]\n            x249 <- [0..3]\n            x250 <- [0..3]\n            x251 <- [0..3]\n            x252 <- [0..3]\n            x253 <- [0..3]\n            x254 <- [0..3]\n            x255 <- [0..3]\n            x256 <- [0..3]\n            x257 <- [0..3]\n            x258 <- [0..3]\n            x259 <- [0..3]\n            x260 <- [0..3]\n            x261 <- [0..3]\n            x262 <- [0..3]\n            x263 <- [0..3]\n            x264 <- [0..3]\n            x265 <- [0..3]\n            x266 <- [0..3]\n            x267 <- [0..3]\n            x268 <- [0..3]\n            x269 <- [0..3]\n            x270 <- [0..3]\n            x271 <- [0..3]\n            x272 <- [0..3]\n            x273 <- [0..3]\n            x274 <- [0..3]\n            x275 <- [0..3]\n            x276 <- [0..3]\n            x277 <- [0..3]\n            x278 <- [0..3]\n            x279 <- [0..3]\n            x280 <- [0..3]\n            x281 <- [0..3]\n            x282 <- [0..3]\n            x283 <- [0..3]\n            x284 <- [0..3]\n            x285 <- [0..3]\n            x286 <- [0..3]\n            x287 <- [0..3]\n            x288 <- [0..3]\n            x289 <- [0..3]\n            x290 <- [0..3]\n            x291 <- [0..3]\n            x292 <- [0..3]\n            x293 <- [0..3]\n            x294 <- [0..3]\n            x295 <- [0..3]\n            x296 <- [0..3]\n            x297 <- [0..3]\n            x298 <- [0..3]\n            x299 <- [0..3]\n            x300 <- [0..3]\n            x301 <- [0..3]\n            x302 <- [0..3]\n            x303 <- [0..3]\n            x304 <- [0..3]\n            x305 <- [0..3]\n            x306 <- [0..3]\n            x307 <- [0..3]\n            x308 <- [0..3]\n            x309 <- [0..3]\n            x310 <- [0..3]\n            x311 <- [0..3]\n            x312 <- [0..3]\n            x313 <- [0..3]\n            x314 <- [0..3]\n            x315 <- [0..3]\n            x316 <- [0..3]\n            x317 <- [0..3]\n            x318 <- [0..3]\n            x319 <- [0..3]\n            x320 <- [0..3]\n            x321 <- [0..3]\n            x322 <- [0..3]\n            x323 <- [0..3]\n            x324 <- [0..3]\n            x325 <- [0..3]\n            x326 <- [0..3]\n            x327 <- [0..3]\n            x328 <- [0..3]\n            x329 <- [0..3]\n            x330 <- [0..3]\n            x331 <- [0..3]\n            x332 <- [0..3]\n            x333 <- [0..3]\n            x334 <- [0..3]\n            x335 <- [0..3]\n            x336 <- [0..3]\n            x337 <- [0..3]\n            x338 <- [0..3]\n            x339 <- [0..3]\n            x340 <- [0..3]\n            x341 <- [0..3]\n            x342 <- [0..3]\n            x343 <- [0..3]\n            x344 <- [0..3]\n            x345 <- [0..3]\n            x346 <- [0..3]\n            x347 <- [0..3]\n            x348 <- [0..3]\n            x349 <- [0..3]\n            x350 <- [0..3]\n            x351 <- [0..3]\n            x352 <- [0..3]\n            x353 <- [0..3]\n            x354 <- [0..3]\n            x355 <- [0..3]\n            x356 <- [0..3]\n            x357 <- [0..3]\n            x358 <- [0..3]\n            x359 <- [0..3]\n            x360 <- [0..3]\n            x361 <- [0..3]\n            x362 <- [0..3]\n            x363 <- [0..3]\n            x364 <- [0..3]\n            x365 <- [0..3]\n            x366 <- [0..3]\n            x367 <- [0..3]\n            x368 <- [0..3]\n            x369 <- [0..3]\n            x370 <- [0..3]\n            x371 <- [0..3]\n            x372 <- [0..3]\n            x373 <- [0..3]\n            x374 <- [0..3]\n            x375 <- [0..3]\n            x376 <- [0..3]\n            x377 <- [0..3]\n            x378 <- [0..3]\n            x379 <- [0..3]\n            x380 <- [0..3]\n            x381 <- [0..3]\n            x382 <- [0..3]\n            x383 <- [0..3]\n            x384 <- [0..3]\n            x385 <- [0..3]\n            x386 <- [0..3]\n            x387 <- [0..3]\n            x388 <- [0..3]\n            x389 <- [0..3]\n            x390 <- [0..3]\n            x391 <- [0..3]\n            x392 <- [0..3]\n            x393 <- [0..3]\n            x394 <- [0..3]\n            x395 <- [0..3]\n            x396 <- [0..3]\n            x397 <- [0..3]\n            x398 <- [0..3]\n            x399 <- [0..3]\n            x400 <- [0..3]\n            x401 <- [0..3]\n            x402 <- [0..3]\n            x403 <- [0..3]\n            x404 <- [0..3]\n            x405 <- [0..3]\n            x406 <- [0..3]\n            x407 <- [0..3]\n            x408 <- [0..3]\n            x409 <- [0..3]\n            x410 <- [0..3]\n            x411 <- [0..3]\n            x412 <- [0..3]\n            x413 <- [0..3]\n            x414 <- [0..3]\n            x415 <- [0..3]\n            x416 <- [0..3]\n            x417 <- [0..3]\n            x418 <- [0..3]\n            x419 <- [0..3]\n            x420 <- [0..3]\n            x421 <- [0..3]\n            x422 <- [0..3]\n            x423 <- [0..3]\n            x424 <- [0..3]\n            x425 <- [0..3]\n            x426 <- [0..3]\n            x427 <- [0..3]\n            x428 <- [0..3]\n            x429 <- [0..3]\n            x430 <- [0..3]\n            x431 <- [0..3]\n            x432 <- [0..3]\n            x433 <- [0..3]\n            x434 <- [0..3]\n            x435 <- [0..3]\n            x436 <- [0..3]\n            x437 <- [0..3]\n            x438 <- [0..3]\n            x439 <- [0..3]\n            x440 <- [0..3]\n            x441 <- [0..3]\n            x442 <- [0..3]\n            x443 <- [0..3]\n            x444 <- [0..3]\n            x445 <- [0..3]\n            x446 <- [0..3]\n            x447 <- [0..3]\n            x448 <- [0..3]\n            x449 <- [0..3]\n            x450 <- [0..3]\n            x451 <- [0..3]\n            x452 <- [0..3]\n            x453 <- [0..3]\n            x454 <- [0..3]\n            x455 <- [0..3]\n            x456 <- [0..3]\n            x457 <- [0..3]\n            x458 <- [0..3]\n            x459 <- [0..3]\n            x460 <- [0..3]\n            x461 <- [0..3]\n            x462 <- [0..3]\n            x463 <- [0..3]\n            x464 <- [0..3]\n            x465 <- [0..3]\n            x466 <- [0..3]\n            x467 <- [0..3]\n            x468 <- [0..3]\n            x469 <- [0..3]\n            x470 <- [0..3]\n            x471 <- [0..3]\n            x472 <- [0..3]\n            x473 <- [0..3]\n            x474 <- [0..3]\n            x475 <- [0..3]\n            x476 <- [0..3]\n            x477 <- [0..3]\n            x478 <- [0..3]\n            x479 <- [0..3]\n            x480 <- [0..3]\n            x481 <- [0..3]\n            x482 <- [0..3]\n            x483 <- [0..3]\n            x484 <- [0..3]\n            x485 <- [0..3]\n            x486 <- [0..3]\n            x487 <- [0..3]\n            x488 <- [0..3]\n            x489 <- [0..3]\n            x490 <- [0..3]\n            x491 <- [0..3]\n            x492 <- [0..3]\n            x493 <- [0..3]\n            x494 <- [0..3]\n            x495 <- [0..3]\n            x496 <- [0..3]\n            x497 <- [0..3]\n            x498 <- [0..3]\n            x499 <- [0..3]\n            x500 <- [0..3]\n            x501 <- [0..3]\n            x502 <- [0..3]\n            x503 <- [0..3]\n            x504 <- [0..3]\n            x505 <- [0..3]\n            x506 <- [0..3]\n            x507 <- [0..3]\n            x508 <- [0..3]\n            x509 <- [0..3]\n            x510 <- [0..3]\n            x511 <- [0..3]\n            x512 <- [0..3]\n            x513 <- [0..3]\n            x514 <- [0..3]\n            x515 <- [0..3]\n            x516 <- [0..3]\n            x517 <- [0..3]\n            x518 <- [0..3]\n            x519 <- [0..3]\n            x520 <- [0..3]\n            x521 <- [0..3]\n            x522 <- [0..3]\n            x523 <- [0..3]\n            x524 <- [0..3]\n            x525 <- [0..3]\n            x526 <- [0..3]\n            x527 <- [0..3]\n            x528 <- [0..3]\n            x529 <- [0..3]\n            x530 <- [0..3]\n            x531 <- [0..3]\n            x532 <- [0..3]\n            x533 <- [0..3]\n            x534 <- [0..3]\n            x535 <- [0..3]\n            x536 <- [0..3]\n            x537 <- [0..3]\n            x538 <- [0..3]\n            x539 <- [0..3]\n            x540 <- [0..3]\n            x541 <- [0..3]\n            x542 <- [0..3]\n            x543 <- [0..3]\n            x544 <- [0..3]\n            x545 <- [0..3]\n            x546 <- [0..3]\n            x547 <- [0..3]\n            x548 <- [0..3]\n            x549 <- [0..3]\n            x550 <- [0..3]\n            x551 <- [0..3]\n            x552 <- [0..3]\n            x553 <- [0..3]\n            x554 <- [0..3]\n            x555 <- [0..3]\n            x556 <- [0..3]\n            x557 <- [0..3]\n            x558 <- [0..3]\n            x559 <- [0..3]\n            x560 <- [0..3]\n            x561 <- [0..3]\n            x562 <- [0..3]\n            x563 <- [0..3]\n            x564 <- [0..3]\n            x565 <- [0..3]\n            x566 <- [0..3]\n            x567 <- [0..3]\n            x568 <- [0..3]\n            x569 <- [0..3]\n            x570 <- [0..3]\n            x571 <- [0..3]\n            x572 <- [0..3]\n            x573 <- [0..3]\n            x574 <- [0..3]\n            x575 <- [0..3]\n            x576 <- [0..3]\n            x577 <- [0..3]\n            x578 <- [0..3]\n            x579 <- [0..3]\n            x580 <- [0..3]\n            x581 <- [0..3]\n            x582 <- [0..3]\n            x583 <- [0..3]\n            x584 <- [0..3]\n            x585 <- [0..3]\n            x586 <- [0..3]\n            x587 <- [0..3]\n            x588 <- [0..3]\n            x589 <- [0..3]\n            x590 <- [0..3]\n            x591 <- [0..3]\n            x592 <- [0..3]\n            x593 <- [0..3]\n            x594 <- [0..3]\n            x595 <- [0..3]\n            x596 <- [0..3]\n            x597 <- [0..3]\n            x598 <- [0..3]\n            x599 <- [0..3]\n            x600 <- [0..3]\n            guard (x1+x2+2*x3 >= 0)\n            return [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41,x42,x43,x44,x45,x46,x47,x48,x49,x50,x51,x52,x53,x54,x55,x56,x57,x58,x59,x60,x61,x62,x63,x64,x65,x66,x67,x68,x69,x70,x71,x72,x73,x74,x75,x76,x77,x78,x79,x80,x81,x82,x83,x84,x85,x86,x87,x88,x89,x90,x91,x92,x93,x94,x95,x96,x97,x98,x99,x100,x101,x102,x103,x104,x105,x106,x107,x108,x109,x110,x111,x112,x113,x114,x115,x116,x117,x118,x119,x120,x121,x122,x123,x124,x125,x126,x127,x128,x129,x130,x131,x132,x133,x134,x135,x136,x137,x138,x139,x140,x141,x142,x143,x144,x145,x146,x147,x148,x149,x150,x151,x152,x153,x154,x155,x156,x157,x158,x159,x160,x161,x162,x163,x164,x165,x166,x167,x168,x169,x170,x171,x172,x173,x174,x175,x176,x177,x178,x179,x180,x181,x182,x183,x184,x185,x186,x187,x188,x189,x190,x191,x192,x193,x194,x195,x196,x197,x198,x199,x200,x201,x202,x203,x204,x205,x206,x207,x208,x209,x210,x211,x212,x213,x214,x215,x216,x217,x218,x219,x220,x221,x222,x223,x224,x225,x226,x227,x228,x229,x230,x231,x232,x233,x234,x235,x236,x237,x238,x239,x240,x241,x242,x243,x244,x245,x246,x247,x248,x249,x250,x251,x252,x253,x254,x255,x256,x257,x258,x259,x260,x261,x262,x263,x264,x265,x266,x267,x268,x269,x270,x271,x272,x273,x274,x275,x276,x277,x278,x279,x280,x281,x282,x283,x284,x285,x286,x287,x288,x289,x290,x291,x292,x293,x294,x295,x296,x297,x298,x299,x300,x301,x302,x303,x304,x305,x306,x307,x308,x309,x310,x311,x312,x313,x314,x315,x316,x317,x318,x319,x320,x321,x322,x323,x324,x325,x326,x327,x328,x329,x330,x331,x332,x333,x334,x335,x336,x337,x338,x339,x340,x341,x342,x343,x344,x345,x346,x347,x348,x349,x350,x351,x352,x353,x354,x355,x356,x357,x358,x359,x360,x361,x362,x363,x364,x365,x366,x367,x368,x369,x370,x371,x372,x373,x374,x375,x376,x377,x378,x379,x380,x381,x382,x383,x384,x385,x386,x387,x388,x389,x390,x391,x392,x393,x394,x395,x396,x397,x398,x399,x400,x401,x402,x403,x404,x405,x406,x407,x408,x409,x410,x411,x412,x413,x414,x415,x416,x417,x418,x419,x420,x421,x422,x423,x424,x425,x426,x427,x428,x429,x430,x431,x432,x433,x434,x435,x436,x437,x438,x439,x440,x441,x442,x443,x444,x445,x446,x447,x448,x449,x450,x451,x452,x453,x454,x455,x456,x457,x458,x459,x460,x461,x462,x463,x464,x465,x466,x467,x468,x469,x470,x471,x472,x473,x474,x475,x476,x477,x478,x479,x480,x481,x482,x483,x484,x485,x486,x487,x488,x489,x490,x491,x492,x493,x494,x495,x496,x497,x498,x499,x500,x501,x502,x503,x504,x505,x506,x507,x508,x509,x510,x511,x512,x513,x514,x515,x516,x517,x518,x519,x520,x521,x522,x523,x524,x525,x526,x527,x528,x529,x530,x531,x532,x533,x534,x535,x536,x537,x538,x539,x540,x541,x542,x543,x544,x545,x546,x547,x548,x549,x550,x551,x552,x553,x554,x555,x556,x557,x558,x559,x560,x561,x562,x563,x564,x565,x566,x567,x568,x569,x570,x571,x572,x573,x574,x575,x576,x577,x578,x579,x580,x581,x582,x583,x584,x585,x586,x587,x588,x589,x590,x591,x592,x593,x594,x595,x596,x597,x598,x599,x600]\n", "num_lines": 612}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE ForeignFunctionInterface #-}\n\nimport Foreign hiding ( unsafePerformIO )\nimport Foreign.C\nimport System.IO.Unsafe\n\nd f x = unsafePerformIO $ do\n    g <- mkfun f\n    r <- deriv g x 1\n    return r\n\nmain = do\n    print $ d (\\x -> x * 2) 3\n    print $ d (\\x -> x * d (\\y -> x + y) 5) 7\n\n\nforeign import ccall safe \"deriv\"\n    deriv :: FunPtr (CDouble -> CDouble) -> CDouble -> CDouble -> IO CDouble\n\nforeign import ccall safe \"wrapper\"\n    mkfun :: (CDouble -> CDouble) -> IO (FunPtr (CDouble -> CDouble))\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\nmodule Main where\n\nimport Foreign\nimport Control.Concurrent\n\ntype Fun = Int -> IO Int\n\nforeign import ccall \"wrapper\" mkF :: Fun -> IO (FunPtr Fun)\n\nforeign import ccall \"dynamic\" callF :: FunPtr Fun -> Fun\n\n-- This test should create 5 OS threads only:\n--   one for main\n--   worker 1 for the IO manager\n--   worker 1 for the timeout manager\n--   worker 3 to run the first forkIO\n--   worker 4 created when worker 2 makes its foreign call\n\n-- Due to #4850, an extra worker was being created because worker 2 was\n-- lost after returning from its foreign call.\n\nmain = do\n  m <- newEmptyMVar\n  callback m >> takeMVar m >>= print\n  callback m >> takeMVar m >>= print\n\ncallback m =\n  forkIO $ do\n    f <- mkF $ \\x -> return (x+1)\n    r <- callF f 3\n    putMVar m r\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Foreign\nimport Foreign.C\nimport Text.Printf\nimport System.Exit\nimport Control.Monad\n\nforeign import ccall \"getesp\" getesp :: IO CInt\n\nmain = do\n  checkSpAlignment\n  wrap checkSpAlignment >>= run\n  wrap1 args1 >>= \\f -> run1 f 3\n  wrap2 args2 >>= \\f -> run2 f 3 4\n  wrap3 args3 >>= \\f -> run3 f 3 4 5\n  wrap4 args4 >>= \\f -> run4 f 3 4 5 6\n\nforeign import ccall \"wrapper\" wrap :: IO () -> IO (FunPtr (IO ()))\nforeign import ccall \"dynamic\" run  :: FunPtr (IO ()) -> IO ()\n\ntype Args1 = Int -> IO ()\n\nforeign import ccall \"wrapper\" wrap1 :: Args1 -> IO (FunPtr Args1)\nforeign import ccall \"dynamic\" run1  :: FunPtr Args1 -> Args1\n\nargs1 :: Args1\nargs1 _ = checkSpAlignment\n\ntype Args2 = Int -> Int -> IO ()\n\nforeign import ccall \"wrapper\" wrap2 :: Args2 -> IO (FunPtr Args2)\nforeign import ccall \"dynamic\" run2  :: FunPtr Args2 -> Args2\n\nargs2 :: Args2\nargs2 _ _ = checkSpAlignment\n\ntype Args3 = Int -> Int -> Int -> IO ()\n\nforeign import ccall \"wrapper\" wrap3 :: Args3 -> IO (FunPtr Args3)\nforeign import ccall \"dynamic\" run3  :: FunPtr Args3 -> Args3\n\nargs3 :: Args3\nargs3 _ _ _ = checkSpAlignment\n\ntype Args4 = Int -> Int -> Int -> Int -> IO ()\n\nforeign import ccall \"wrapper\" wrap4 :: Args4 -> IO (FunPtr Args4)\nforeign import ccall \"dynamic\" run4  :: FunPtr Args4 -> Args4\n\nargs4 :: Args4\nargs4 _ _ _ _ = checkSpAlignment\n\ncheckSpAlignment :: IO ()\ncheckSpAlignment = do\n  esp <- getesp\n  when (((esp + fromIntegral (sizeOf (undefined :: Ptr ()))) .&. 15) /= 0) $ do\n     printf \"esp not aligned correctly: %x\\n\" (fromIntegral esp :: Word32)\n     exitWith (ExitFailure 1)\n\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash, GHCForeignImportPrim, UnliftedFFITypes #-}\n\nimport GHC.Exts\n\nforeign import prim \"test\" test :: Int# -> Int# -> Int# -> Int# -> Int#\n                                -> Int# -> Int# -> Int# -> Int# -> Int#\n                                -> Int#\n\nv :: Int\nv = I# (test 111# 112# 113# 114# 115# 116# 117# 118# 119# 120#)\n\nmain :: IO ()\nmain = print v\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, CPP #-}\nimport Foreign.C.String\nimport Control.Monad\nimport System.Environment\nimport System.FilePath\nimport Foreign.Ptr\n\n-- Type of paths is different on Windows\n#if defined(mingw32_HOST_OS)\ntype PathString = CWString\nwithPathString = withCWString\n#else\ntype PathString = CString\nwithPathString = withCString\n#endif\n\nmungeDLL :: FilePath -> FilePath\n#if defined(mingw32_HOST_OS)\n-- Strip extension because addDLL on Windows doesn't want it\nmungeDLL f =\n    let (base, ext) = splitExtension f\n    in if ext == \".dll\" then base else error (\"unexpected DLL file name: \" ++ f)\n#else\nmungeDLL = id\n#endif\n\nmain = do\n    [ty, object] <- getArgs\n    initLinker\n    if ty == \"dyn\"\n      then do\n        r <- withPathString (mungeDLL object) $ \\s -> addDLL s\n        when (r /= nullPtr) $ error =<< peekCString r\n      else do\n        r <- withPathString object $ \\s -> loadObj s\n        when (r /= 1) $ error \"loadObj failed\"\n    r <- resolveObjs\n    when (r /= 1) $ error \"resolveObj failed\"\n    putStrLn \"success\"\n\n{-\n    f <- withCString (mungeSymbol \"do_checks\") lookupSymbol\n    when (f == nullFunPtr) $ error \"lookupSymbol failed\"\n    mkIO f\n\nforeign import ccall \"lookupSymbol\" lookupSymbol :: CString -> IO (FunPtr (IO ()))\nforeign import ccall \"dynamic\" mkIO :: FunPtr (IO ()) -> IO ()\n\nmungeSymbol :: String -> String\n#if LEADING_UNDERSCORE\nmungeSymbol s = \"_\" ++ s -- Mac OS X\n#else\nmungeSymbol = id\n#endif\n-}\n\nforeign import ccall \"initLinker\" initLinker :: IO ()\nforeign import ccall \"addDLL\" addDLL :: PathString -> IO CString\nforeign import ccall \"loadObj\" loadObj :: PathString -> IO Int\nforeign import ccall \"resolveObjs\" resolveObjs :: IO Int\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nmain = do\n  m <- newEmptyMVar\n  forkIO $ putStrLn \"Hello World!\" >> putMVar m ()\n  takeMVar m\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module F where\nimport System.Environment\n\nforeign export ccall f :: IO ()\nf = do\n  getProgName >>= print\n  getArgs >>= print\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print \"ok\"\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Main where\n\nforeign import ccall \"global.h printx\"\n  c_printx :: IO ()\n\nmain = do\n  c_printx\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Main where\n\nforeign import ccall \"global.h printx\"\n  c_printx :: IO ()\n\nmain = do\n  c_printx\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\n\nmain = do\n  t <- myThreadId\n  forkIO (threadDelay 100000 >> killThread t)\n  threadDelay . fromInteger $\n    min 9223372036840001 (fromIntegral (maxBound :: Int))\n    -- caused an overflow in 7.4.2, non-threaded RTS\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, MagicHash #-}\nimport GHC.ForeignPtr\nimport GHC.Ptr\nimport System.Mem\n\n-- Don't use debugBelch() directly, because we cannot call varargs functions\n-- using the FFI (doing so produces a segfault on 64-bit Linux, for example).\n-- See Debug.Trace.traceIO, which also uses debugBelch2.\nforeign import ccall \"&debugBelch2\" fun :: FunPtr (Ptr () -> Ptr () -> IO ())\n\nnew name = do\n    p <- newForeignPtr_ (Ptr name)\n    addForeignPtrFinalizerEnv fun (Ptr \"finalizer 1 (%s)\\n\"#) p\n    addForeignPtrFinalizerEnv fun (Ptr \"finalizer 2 (%s)\\n\"#) p\n    return p\n\nmain = do\n    p <- new \"p\"#\n    q <- new \"q\"#\n    r <- new \"r\"#\n    performGC -- collect p. finalizer order: 2, then 1.\n--    print q\n    touchForeignPtr q\n    performGC -- collect q. finalizer order: 1, then 2.\n              -- expected order: 2, then 1.\n--    print r\n    touchForeignPtr r\n    performGC -- collect r. finalizer order: 2, then 1.\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = return ()\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.Conc.Sync\nimport System.Environment\n\ntest n = atomically $ f [1..n]\n where\n  f [] = retry\n  f (x:xs) = do\n    ys <- f xs\n    return (x:ys)\n\nmain = do\n  [n] <- getArgs\n  test (read n)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.Conc.Sync\nimport Control.Monad\nimport System.Environment\n\ntest n = do\n  dog <- newTVarIO False\n  cat <- newTVarIO False\n  let unset = do\n        d <- readTVar dog\n        c <- readTVar cat\n        if (d || c) then retry else return ()\n      setDog = unset >> writeTVar dog True\n      setCat = unset >> writeTVar cat True\n      reset = do\n        d <- readTVar dog\n        c <- readTVar cat\n        guard (d || c)\n        writeTVar dog False\n        writeTVar cat False\n\n  replicateM_ n (do\n    forkIO (atomically setDog)\n    forkIO (atomically setCat)\n    atomically reset\n    atomically reset)\n\nmain = do\n  [n] <- getArgs\n  test (read n :: Int)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport T7919A\n\nallDecs\n\nmain = print test\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7919A where\n\nimport Control.Applicative\nimport Control.DeepSeq\nimport Control.Monad\nimport Language.Haskell.TH\n\n-- on x86-64 with 7.6.3 it works with size 510 and fails with size 511\nsize = 512\n\ndataName = mkName \"Large\"\nstepName = mkName \"step\"\n\n-- data Large = Large Int ... Int  -- generate 'size' fields, not strict\nlargeData =\n  dataD\n    (cxt [])\n    (dataName)\n    []\n    Nothing\n    [normalC dataName\n             (replicate size (((,) <$> bang noSourceUnpackedness\n                                       noSourceStrictness) `ap` [t| Int |]))]\n    []\n\nconE' :: Name -> [ExpQ] -> ExpQ\nconE' n es = foldl appE (conE n) es\n\nvarName s i = mkName (s ++ show (((i - 1) `mod` size) + 1))\n\n-- step (Large i1 ... in) =\n--   let\n--     j1 = i1 + j4\n--     ...\n--     jn = in + j(3n + 1 `mod` n)\n--   in\n--     Large j1 ... jn\nlargeStep =\n  funD\n    stepName\n    [clause\n      [conP dataName (map (\\ i -> varP (varName \"i\" i)) [1..size])]\n      (normalB\n        (letE\n          (map (\\ i -> valD (varP (varName \"j\" i)) (normalB [| $(varE (varName \"i\" i)) + $(varE $ varName \"i\" (i * 3 + 1)) |]) []) [1..size])\n          (tupE [conE' dataName (map (\\ i -> varE (varName \"j\" i)) [1..size]), varE $ varName \"j\" 1])\n        )\n      )\n      []\n    ]\n\n-- test = let step ... in runSteps step 100000 (Large 1 ... 1)\nlargeLet =\n  valD\n    (varP (mkName \"test\"))\n    (normalB (letE [largeStep] [| runSteps $(varE stepName) 100000 $(conE' dataName (map (const $ litE $ integerL 1) [1..size]))|]))\n    []\n\nallDecs =\n  sequence [largeData, largeLet]\n\nrunSteps :: (state -> (state, Int)) -> Int -> state -> [Int]\nrunSteps f n i | n <= 0    = []\n               | otherwise = case f i of\n                               (i', r) -> {-i' `deepseq`-} (r : runSteps f (n - 1) i')\n-- could use deepseq here to avoid the space leak, but it's not necessary\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nimport Control.Exception\nimport Control.Monad\nimport GHC.Conc\n\nmain = join $ atomically $ do\n  catchSTM\n    (throwSTM ThreadKilled `orElse` return (putStrLn \"wtf\"))\n    (\\(e::SomeException) -> return (putStrLn \"ok\"))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8124 where\n\nf :: Int -> Int\nf x = x + 1\n\nforeign export ccall \"f\" f :: Int -> Int\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\nimport Control.Monad\nimport GHC.Conc\n\nmain = do\n  mainTid <- myThreadId\n  labelThread mainTid \"main\"\n  forM_ [0..0] $ \\i -> forkIO $ do\n    subTid <- myThreadId\n    labelThread subTid $ \"sub \" ++ show i\n    forM_ [0..100000000] $ \\j -> putStrLn $ \"sub \" ++ show i ++ \": \" ++ show j\n  yield\n  setNumCapabilities 2\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\nimport Control.Monad\nimport GHC.Conc\nimport Foreign.Marshal.Alloc\nimport Foreign.Ptr\nimport Foreign.Storable\nimport Foreign.C.Types\nimport GHC.IO\nimport GHC.Exts\n\nforeign import ccall unsafe \"&puts\" puts :: FunPtr (Ptr CChar -> IO ())\n\nmain :: IO ()\nmain = do\n  ptr@(Ptr p) <- malloc\n  poke (ptr :: Ptr CChar) 0\n  setNumCapabilities 2\n  let !(FunPtr puts#) = puts\n  replicateM_ 10000 $ IO $ \\s -> let\n    !(# s1, w #) = mkWeakNoFinalizer# () () s\n    !(# s2, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s1\n    !(# s3, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s2\n    !(# s4, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s3\n    !(# s5, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s4\n    !(# s6, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s5\n    !(# s7, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s6\n    !(# s8, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s7\n    !(# s9, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s8\n    !(# s10, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s9\n    !(# s11, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s10\n    !(# s12, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s11\n    !(# s13, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s12\n    !(# s14, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s13\n    !(# s15, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s14\n    !(# s16, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s15\n    !(# s17, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s16\n    !(# s18, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s17\n    !(# s19, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s18\n    !(# s20, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s19\n    in (# s20, () #)\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes #-}\n-- This is nofib/smp/threads006.  It fails in GHC 7.8.2 with a GC crash.\n\n{-# OPTIONS_GHC -O2 #-}\nimport System.IO\nimport System.Environment\nimport System.CPUTime\nimport Text.Printf\nimport Control.Monad\nimport Control.Concurrent\nimport Control.Concurrent.MVar\nimport Control.Exception\n\nmain :: IO ()\nmain = do\n    hSetBuffering stdout NoBuffering\n    [nthreads] <- fmap (map read) getArgs\n    tids <- replicateM nthreads (mask $ \\_ -> forkIO $ return ())\n    m <- newEmptyMVar\n    -- do it in a subthread to avoid bound-thread overhead\n    forkIO $ do mapM_ killThread tids; putMVar m ()\n    takeMVar m\n    return ()\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Monad\nimport System.Mem.StableName\n\nmain :: IO ()\nmain = replicateM_ 500000 (makeStableName foo)\n\nfoo :: Int\nfoo = 1\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent\n\nmain = threadDelay 2000000\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nf :: Int -> Int\nf x = x + head caf\n\n-- make sure that even when we have a CAF, we can unload the code\ncaf :: [Int]\ncaf = [1..10]\n\nforeign export ccall f :: Int -> Int\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE NumericUnderscores #-}\n{-# LANGUAGE OverloadedStrings #-}\nimport Data.Word\nimport GHC.Base\nimport GHC.Ptr\n\nimport qualified Data.ByteString as B\nimport qualified Data.ByteString.Unsafe as BU\n\nmain :: IO ()\nmain = do\n  traceBinaryEventIO \"0123456789\"\n  traceBinaryEventIO $ B.replicate 10 0\n  traceBinaryEventIO $ B.replicate (maxSize + 1) 0\n\nmaxSize :: Int\nmaxSize = fromIntegral (maxBound :: Word16)\n\ntraceBinaryEventIO :: B.ByteString -> IO ()\ntraceBinaryEventIO bytes =\n  BU.unsafeUseAsCStringLen bytes $ \\(Ptr p, I# n) -> IO $ \\s -> do\n    case traceBinaryEvent# p n s of\n      s' -> (# s', () #)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Word\nimport Debug.Trace\n\nmain = do\n  traceEventIO \"testing\"\n  traceEventIO \"%s\" -- see #3874\n  traceEventIO $ replicate (maxSize + 1) 'A'\n\nmaxSize :: Int\nmaxSize = fromIntegral (maxBound :: Word16)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--We check if RTS arguments are properly filtered/passed along\n--by outputting them to stdout.\n\nimport System.Environment\n\nmain :: IO ()\nmain = getArgs >>= putStr . show\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--We check the generation count as a way to verify an RTS argument\n--was actually parsed and accepted by the RTS.\n\nimport GHC.RTS.Flags (getGCFlags, generations)\n\nmain :: IO ()\nmain = do\n    gcFlags <- getGCFlags\n    putStr . show $ generations gcFlags\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (C) 2015, Luke Iannini\n\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\n\nmodule Main where\nimport Printf ( pr )\n\nforeign import ccall \"talkToCxx\" talkToCxx :: IO ()\n\nmain :: IO ()\nmain = do\n  putStrLn ( $(pr \"Hello From Template Haskell!\") )\n  talkToCxx\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (C) 2015, Luke Iannini\n\n{-# LANGUAGE TemplateHaskell #-}\nmodule Printf where\n\n-- Skeletal printf from the paper:\n-- http://research.microsoft.com/pubs/67015/meta-haskell.pdf\n-- It needs to be in a separate module to the one where\n-- you intend to use it.\n\n-- Import some Template Haskell syntax\nimport Language.Haskell.TH\n\n-- Describe a format string\ndata Format = D | S | L String\n\n-- Parse a format string.  This is left largely to you\n-- as we are here interested in building our first ever\n-- Template Haskell program and not in building printf.\nparse :: String -> [Format]\nparse s   = [ L s ]\n\n-- Generate Haskell source code from a parsed representation\n-- of the format string.  This code will be spliced into\n-- the module which calls \"pr\", at compile time.\ngen :: [Format] -> Q Exp\ngen [D]   = [| \\n -> show n |]\ngen [S]   = [| \\s -> s |]\ngen [L s] = stringE s\n\n-- Here we generate the Haskell code for the splice\n-- from an input format string.\npr :: String -> Q Exp\npr s = gen (parse s)\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"c\" c_exp :: Int\n\nmain = print c_exp\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"a\" a_exp :: Int\n\nmain = print a_exp\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"a\" a_exp :: Int\nforeign import ccall \"c\" c_exp :: Int\n\nmain = print $ c_exp * a_exp\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"power2\" power2 :: Int -> Int\n\nmain = print $ power2 4\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"power3\" power3 :: Int -> Int\n\nmain = print $ power3 4\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2016, Ryan Scott\n-- ExternBug.hs\n{-# LANGUAGE ForeignFunctionInterface #-}\nmodule ExternBug (bar) where\n\n{-# INCLUDE foo.h #-}\n\nforeign import ccall \"bar\"\n  bar :: IO ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"foo\" c_foo :: Int\n\nmain = print c_foo\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"foo\" c_foo :: Int\n\nmain = print c_foo\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Environment (getArgs)\n\nmain :: IO ()\nmain = getArgs >>= print\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"foo\" c_foo :: Int\n\nmain = print c_foo\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"T15261a\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"T15261b\"\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nforeign import ccall \"with_copysign\" c_with_copysign :: Double -> Double\n\nmain = print $ c_with_copysign 8.5\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nforce :: [a] -> [a]\nforce [] = []\nforce x@(a:b) = x `seq` a : force b\n\n{-# NOINLINE infiniteList #-}\ninfiniteList :: [Int]\ninfiniteList = [1..]\n\n\nheapOverflow :: IO ()\nheapOverflow = do\n  evaluate $ length infiniteList -- Force the list\n  evaluate infiniteList -- So that the list cannot be garbage collected.\n  return ()\n\nmain :: IO ()\nmain = heapOverflow `catch` \\x -> case x of\n  HeapOverflow -> putStrLn \"Heap overflow caught!\"\n  _ -> throwIO x\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Conf where\n\niTERATIONS :: Int\niTERATIONS = 1000 * 1000 * 100\n\nbufferSize :: (Num a) => a\nbufferSize = 1024\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Util\nimport ManyQueue\n\nmain = do\n  runTest testManyQueue'1P3C \n  runTest testManyQueue'1P1C \n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule ManyQueue where \n\nimport Control.Concurrent\nimport Control.Monad\n\nimport Conf\n\nnewtype MQueue a = MQueue [MVar a]\n\nnewMQueue size = do\n  lst <- replicateM size newEmptyMVar\n  return (MQueue (cycle lst))\n\nwriteMQueue :: (MQueue a) -> a -> IO (MQueue a)\nwriteMQueue (MQueue (x:xs)) el = do\n  putMVar x el\n  return (MQueue xs)\n\nreadMQueue :: (MQueue a) -> IO (MQueue a, a)\nreadMQueue (MQueue (x:xs)) = do\n  el <- takeMVar x\n  return ((MQueue xs), el)\n\ntestManyQueue'1P1C = do\n  print \"Test.ManyQueue.testManyQueue'1P1C\"\n  finished <- newEmptyMVar\n\n  mq <- newMQueue bufferSize\n  \n  let \n--      elements = [0] ++ [1 .. iTERATIONS] -- workaround\n      elements = [0 .. iTERATIONS] -- heap overflow\n      \n      writer _ 0 = putMVar finished ()\n      writer q x = do\n                  q' <- writeMQueue q x\n                  writer q' (x-1)\n\n      writer' _ [] = putMVar finished ()\n      writer' q (x:xs) = do\n                  q' <- writeMQueue q x\n                  writer' q' xs\n\n      reader _ !acc 0 = print acc >> putMVar finished ()\n      reader q !acc n = do\n                  (q', x) <- readMQueue q\n                  reader q' (acc+x) (n-1)\n  \n  --forkIO $ writer mq iTERATIONS\n  forkIO $ writer' mq elements\n  forkIO $ reader mq 0 iTERATIONS\n\n  takeMVar finished\n  takeMVar finished\n\ntestManyQueue'1P3C = do\n  print \"Test.ManyQueue.testManyQueue'1P3C\"\n  let tCount = 3\n  finished <- newEmptyMVar\n\n  mqs <- replicateM tCount (newMQueue bufferSize)\n  \n  let elements = [0 .. iTERATIONS]\n      \n      writer _ [] = putMVar finished ()\n      writer qs (x:xs) = do\n                  qs' <- mapM (\\q -> writeMQueue q x) qs\n                  writer qs' xs\n\n      reader _ !acc 0 = print acc >> putMVar finished ()\n      reader q !acc n = do\n                  (q', x) <- readMQueue q\n                  reader q' (acc+x) (n-1)\n  \n  forkIO $ writer mqs elements\n  mapM_ (\\ mq -> forkIO $ reader mq 0 iTERATIONS) mqs\n\n  replicateM (tCount+1) (takeMVar finished)\n\n  return ()", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Util where\n\nimport Data.Time\n-- import Data.List.Split (splitEvery)\n\nimport Conf\n\ntimed act = do\n  putStrLn \"\"\n  t0 <- getCurrentTime\n  !v <- act\n  t1 <- getCurrentTime\n  let td = diffUTCTime t1 t0\n  putStrLn $ \"Action time: \" ++ show td\n  return (v,td)\n\nsplitEvery _ [] = []\nsplitEvery n xs = let (lxs,rxs) = splitAt n xs in lxs : splitEvery n rxs\n\nrunTest :: (IO ()) -> IO ()\nrunTest test = do\n  (_, t) <- timed test\n  let format x = unwords . reverse . map reverse . splitEvery 3 . reverse . show $ x\n      val = format (round (fromIntegral iTERATIONS / realToFrac t :: Double) :: Integer)\n\n  putStr \"OpsPerSecond: \" \n  putStrLn val", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent\n\nforeign import ccall \"showControlBits\" checkfpu :: IO ()\n\nmain\n = do checkfpu\n      forkOS checkfpu\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\ndata Test = Test !Int\n\n{-# NOINLINE f #-}\nf a = Test (a + 1)\n\nmain = let (Test x) = f 1 in print x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import qualified Data.Array.Unboxed as UA\nimport Data.Word\n\nmain :: IO ()\nmain = print (UA.listArray (1, 2^(20::Int)) (repeat 0)\n              :: UA.UArray Int Word64)\n       -- this unboxed array should at least take:\n       --   2^20 * 64 bits\n       -- = 8 * (2^20 bytes)\n       -- = 8 MiB (in heap)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = main' ()\n  where\n    main' _ = main >> main' ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Concurrent.MVar  (readMVar)\nimport System.Environment       (getArgs)\nimport System.Exit              (ExitCode (ExitFailure), exitFailure)\nimport System.IO                (hClose, hGetLine, hPutStrLn)\nimport System.Posix.Process     (exitImmediately, getProcessID)\nimport System.Posix.Signals     (Handler (Catch), installHandler, sigHUP,\n                                 signalProcess)\nimport System.Process           (StdStream (CreatePipe), createProcess, proc,\n                                 std_in, std_out, waitForProcess)\nimport System.Process.Internals (ProcessHandle (..),\n                                 ProcessHandle__ (OpenHandle))\nimport System.Timeout           (timeout)\n\nmain :: IO ()\nmain = do\n    args <- getArgs\n    case args of\n        [\"--runghc\", runghc] -> runParent runghc\n        [\"child\"] -> runChild\n        _ -> error $ \"Unknown args: \" ++ show args\n\nrunParent :: FilePath -> IO ()\nrunParent runghc = do\n    (Just inH, Just outH, Nothing, ph@(ProcessHandle mvar _)) <-\n        createProcess (proc runghc [\"T-signals-child.hs\", \"child\"])\n            { std_in = CreatePipe\n            , std_out = CreatePipe\n            }\n\n    -- Get the PID of the actual child process. This will initially be\n    -- runghc. If executeFile is used by runghc, that same process\n    -- will become the ghc process running our code from\n    -- runChild. Otherwise, runChild will run in a child of this\n    -- process.\n    OpenHandle childPid <- readMVar mvar\n\n    -- Get the PID of the process actually running the runChild code,\n    -- by reading it from its stdout (see runChild below).\n    pidS <- hGetLine outH\n    let pid = fromIntegral (read pidS :: Int)\n\n    -- Send the child process the HUP signal. We know this is after\n    -- the signal handler has been installed, since we already got the\n    -- PID from the process.\n    signalProcess sigHUP childPid\n\n    -- Send the child some input so that it will exit if it didn't\n    -- have a sigHUP handler installed.\n    hPutStrLn inH \"\"\n    hClose inH\n\n    -- Read out the rest of stdout from the child, which will be\n    -- either \"NOSIGNAL\\n\" or \"HUP\\n\"\n    rest <- hGetLine outH\n\n    -- Get the exit code of the child\n    ec <- waitForProcess ph\n\n    -- Check that everything matches\n    if childPid /= pid || rest /= hupMessage || ec /= hupExitCode\n        then do\n            -- Debugging display\n            putStrLn $ concat\n                [ \"Child process: \"\n                , show childPid\n                , \", real process: \"\n                , show pid\n                ]\n            putStrLn $ concat\n                [ \"Expected \"\n                , show hupMessage\n                , \", received: \"\n                , show rest\n                ]\n            putStrLn $ concat\n                [ \"Expected \"\n                , show hupExitCode\n                , \", received \"\n                , show ec\n                ]\n            exitFailure\n        else return ()\n\nrunChild :: IO ()\nrunChild = do\n    -- Install our sigHUP handler: print the HUP message and exit with\n    -- the HUP exit code.\n    let handler = Catch $ do\n            putStrLn hupMessage\n            exitImmediately hupExitCode\n    _ <- installHandler sigHUP handler Nothing\n\n    -- Get our actual process ID and print it to stdout.\n    pid <- getProcessID\n    print (fromIntegral pid :: Int)\n\n    -- Block until we receive input, giving a chance for the signal\n    -- handler to be triggered, and if the signal handler isn't\n    -- triggered, gives us an escape route from this function.\n    --\n    -- Include a reasonable timeout to prevent this from running for\n    -- too long\n    _ <- timeout 10000000 getLine\n\n    -- Reaching this point indicates a failure of the test. Print some\n    -- non HUP message and exit with a non HUP exit\n    -- code. Interestingly, in a failure, this exit code will _not_\n    -- be received by the parent process, since the runghc process\n    -- itself will exit with ExitFailure -1, indicating that it was\n    -- killed by signal 1 (SIGHUP).\n    putStrLn \"No signal received\"\n    exitImmediately $ ExitFailure 41\n\nhupExitCode :: ExitCode\nhupExitCode = ExitFailure 42\n\nhupMessage :: String\nhupMessage = \"HUP\"\n", "num_lines": 119}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main = print \"hello from a .hs file\"\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "> main = print \"hello from a .lhs file\"\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env whatever\n\n{-# LANGUAGE CPP #-}\n\nmodule Main where\n\n-- Compiling a program with CPP that also has a hash bang should work (#6132).\n-- Before ghc-7.8, it failed with:\n--\n-- error: invalid preprocessing directive #!\n-- #!/usr/bin/env runghc\n\n#if 1\nmain = return ()\n#endif\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fpackage-trust #-}\n{-# LANGUAGE Unsafe #-}\nmodule Check01 ( main' ) where\n\nimport safe Check01_B\n\nmain' = do\n    let n = mainM 1\n    print $ n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Check01_A (\n        trace\n    ) where\n\nimport qualified Debug.Trace as D\nimport qualified Data.ByteString.Lazy.Char8 as BS\n\n-- | Allowed declasification\ntrace :: String -> a -> a\ntrace s = D.trace $ s ++ show a3\n\na3 :: BS.ByteString\na3 = BS.take 3 $ BS.repeat 'a'\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-- Since Safe we require base package be trusted to compile\nmodule Check01_B where\n\nimport Check01_A\n\nmainM :: Int -> Int\nmainM n = trace \"Allowed Leak\" $ n * 2\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\nmodule Check02 ( main' ) where\n\nimport safe Check02_B\n\nmain' = do\n    let n = mainM 1\n    print $ n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Check02_A (\n        trace\n    ) where\n\nimport qualified Debug.Trace as D\nimport qualified Data.ByteString.Lazy.Char8 as BS\n\n-- | Allowed declasification\ntrace :: String -> a -> a\ntrace s = D.trace $ s ++ show a3\n\na3 :: BS.ByteString\na3 = BS.take 3 $ BS.repeat 'a'\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-- Since Safe we require base package be trusted to compile\nmodule Check02_B where\n\nimport Check02_A\n\nmainM :: Int -> Int\nmainM n = trace \"Allowed Leak\" $ n * 2\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\nmodule Check03 where\n\nimport Check03_B\n\nmainN = do\n    let n = mainM 1\n    print $ n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Check03_A (\n        trace\n    ) where\n\nimport qualified Debug.Trace as D\nimport qualified Data.ByteString.Lazy.Char8 as BS\n\n-- | Allowed declasification\ntrace :: String -> a -> a\ntrace s = D.trace $ s ++ show a3\n\na3 :: BS.ByteString\na3 = BS.take 3 $ BS.repeat 'a'\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-- Since Safe we require base package be trusted to compile\nmodule Check03_B where\n\nimport Check03_A\n\nmainM :: Int -> Int\nmainM n = trace \"Allowed Leak\" $ n * 2\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\nmodule Main ( main ) where\n\nimport Check04_1\n\nmain = main'\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\nmodule Check04_1 ( main' ) where\n\nimport safe Check04_B\n\nmain' = do\n    let n = mainM 1\n    print $ n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Check04_A (\n        trace\n    ) where\n\nimport qualified Debug.Trace as D\nimport qualified Data.ByteString.Lazy.Char8 as BS\n\n-- | Allowed declasification\ntrace :: String -> a -> a\ntrace s = D.trace $ s ++ show a3\n\na3 :: BS.ByteString\na3 = BS.take 3 $ BS.repeat 'a'\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-- Since Safe we require base package be trusted to compile\nmodule Check04_B where\n\nimport Check04_A\n\nmainM :: Int -> Int\nmainM n = trace \"Allowed Leak\" $ n * 2\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fpackage-trust #-}\nmodule Check05 ( main' ) where\n\nmain' = do\n    let n = 1\n    print $ n\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy, NoImplicitPrelude #-}\n{-# OPTIONS_GHC -fpackage-trust #-}\n\n-- make sure importing a safe-infered module brings in the\n-- pkg trust requirements correctly.\nmodule Check06 ( main' ) where\n\nimport safe Check06_A\n\nmain' =\n    let n = mainM 1\n    in n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- safe infered, with requirement base is trusted\nmodule Check06_A where\n\nmainM :: Int -> Int\nmainM n = n + 1\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy, NoImplicitPrelude #-}\n{-# OPTIONS_GHC -fpackage-trust #-}\n\n-- make sure selective safe imports brings in pkg trust requirements correctly.\n-- (e.g only for the imports that are safe ones)\nmodule Check07 ( main' ) where\n\nimport safe Check07_A -- no pkg trust reqs\nimport Check07_B -- base pkg trust req\n\nmain' =\n    let n = a (b 1)\n    in n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n\n-- safe infered, with no pkg trust reqs\nmodule Check07_A where\n\na :: a -> a\na n = n\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- safe infered, with requirement base is trusted\nmodule Check07_B where\n\nimport Prelude\n\nb :: Int -> Int\nb n = n + 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy, NoImplicitPrelude #-}\n{-# OPTIONS_GHC -fpackage-trust #-}\n\n-- make sure selective safe imports brings in pkg trust requirements correctly.\n-- (e.g only for the imports that are safe ones)\nmodule Check08 ( main' ) where\n\nimport safe Check08_A -- no pkg trust reqs\nimport safe Check08_B -- base pkg trust req\n\nmain' =\n    let n = a (b 1)\n    in n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude #-}\n\n-- safe infered, with no pkg trust reqs\nmodule Check08_A where\n\na :: a -> a\na n = n\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- safe infered, with requirement base is trusted\nmodule Check08_B where\n\nimport Prelude\n\nb :: Int -> Int\nb n = n + 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Check09 where\n\nimport Prelude\nimport Data.ByteString.Char8\n\nb :: ByteString\nb = pack \"Hello World\"\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Check10 where\n\nimport Prelude\nimport Data.ByteString.Char8\n\nb :: ByteString\nb = pack \"Hello World\"\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule CheckA (\n        trace\n    ) where\n\nimport qualified Debug.Trace as D\nimport qualified Data.ByteString.Lazy.Char8 as BS\n\n-- | Allowed declasification\ntrace :: String -> a -> a\ntrace s = D.trace $ s ++ show a3\n\na3 :: BS.ByteString\na3 = BS.take 3 $ BS.repeat 'a'\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-- Since Safe we require base package be trusted to compile\nmodule CheckB where\n\nimport CheckB_Aux\n\nmainM :: Int -> Int\nmainM n = trace \"Allowed Leak\" $ n * 2\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule CheckB_Aux (\n        trace\n    ) where\n\nimport qualified Debug.Trace as D\nimport qualified Data.ByteString.Lazy.Char8 as BS\n\n-- | Allowed declasification\ntrace :: String -> a -> a\ntrace s = D.trace $ s ++ show a3\n\na3 :: BS.ByteString\na3 = BS.take 3 $ BS.repeat 'a'\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\nmodule ImpSafe01 ( MyWord ) where\n\n-- While Data.Word is safe it imports trustworthy\n-- modules in base, hence base needs to be trusted.\n-- Note: Worthwhile giving out better error messages for cases\n-- like this if I can.\nimport Data.Word\n\ntype MyWord = Word\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoImplicitPrelude #-}\nmodule ImpSafe02 ( MyWord ) where\n\n-- While Data.Word is safe it imports trustworthy\n-- modules in base, hence base needs to be trusted.\n-- Note: Worthwhile giving out better error messages for cases\n-- like this if I can.\nimport Data.Word\n\ntype MyWord = Word\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Main where\n\nimport safe Prelude\nimport safe ImpSafe03_A\n\nmain = putStrLn \"test\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule ImpSafe03_A where\n\nimport safe Prelude\nimport safe qualified Data.ByteString.Char8 as BS\n\ns = BS.pack \"Hello World\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE NoImplicitPrelude #-}\nmodule ImpSafe04 ( MyWord ) where\n\n-- While Data.Word is safe it imports trustworthy\n-- modules in base, hence base needs to be trusted.\n-- Note: Worthwhile giving out better error messages for cases\n-- like this if I can.\nimport safe Data.Word\nimport System.IO.Unsafe\n\ntype MyWord = Word\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Main where\n\nimport M_SafePkg\n\nmain = do\n    putStrLn $ show bigInt\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Main where\n\nimport M_SafePkg2\n\nmain = do\n    putStrLn $ show bigInt\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Main where\n\nimport M_SafePkg3\n\nmain = do\n    putStrLn $ show bigInt\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Main where\n\nimport M_SafePkg3\n\nmain = do\n    putStrLn $ show bigInt\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Main where\n\nimport M_SafePkg5\n\nmain = do\n    putStrLn $ show bigInt\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Main where\n\nimport M_SafePkg5\n\nmain = do\n    putStrLn $ show bigInt\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Main where\n\nimport Prelude\nimport safe M_SafePkg6\n\nmain = putStrLn \"test\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Main where\n\nimport Prelude\nimport safe M_SafePkg7\n\nmain = putStrLn \"test\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Main where\n\nimport Prelude\nimport safe M_SafePkg8\n\nmain = putStrLn \"test\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Main where\n\nimport Prelude\nimport safe M_SafePkg7\n\nmain = putStrLn \"test\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule M_SafePkg where\n\nbigInt :: Int\nbigInt = 9\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule M_SafePkg2 where\n\nbigInt :: Int\nbigInt = 9\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule M_SafePkg3 where\n\nimport qualified M_SafePkg2 as M2\n\nbigInt :: Int\nbigInt = M2.bigInt\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule M_SafePkg4 where\n\nimport qualified M_SafePkg3 as M3\nimport Data.Word\n\nbigInt :: Int\nbigInt = M3.bigInt\n\ntype MyWord = Word\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- safe inference\n-- same module as M_SafePkg4 which compiles with -XSafe.\n-- Want to make sure compiles fine and is infered safe and\n-- also picks up corrected pkg trust requirements.\nmodule M_SafePkg5 where\n\nimport qualified M_SafePkg3 as M3\nimport Data.Word\n\nbigInt :: Int\nbigInt = M3.bigInt\n\ntype MyWord = Word\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule M_SafePkg6 where\n\nimport safe Prelude\nimport safe qualified Data.ByteString.Char8 as BS\n\ns = BS.pack \"Hello World\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule M_SafePkg7 where\n\nimport Prelude\nimport qualified Data.ByteString.Char8 as BS\n\ns = BS.pack \"Hello World\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule M_SafePkg8 where\n\nimport Prelude\nimport safe qualified Data.ByteString.Char8 as BS\n\ns = BS.pack \"Hello World\"\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\n\nmain = defaultMain\n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- | CPP should still be allowed\nmodule Main where\n\n#include \"Flags01_A.cpp\"\n\n#define mainn main=putStrLn str\n\nmainn\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -pgmdll pgmdll, -I., -L., -Uggg, -Dggg, -with-rtsopts full #-}\n\n-- | These are all flags that should be allowed\nmodule Flags02 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags01 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags02 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE SafeImport #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags03 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE SafeLanguage #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags04 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe, Unsafe #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags05 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy, Unsafe #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags06 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE SafeLanguage, Unsafe #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags07 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE SafeLanguage, Trustworthy #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags08 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE SafeLanguage, Safe #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags09 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe, Trustworthy #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags10 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE Safe #-}\n\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags11 where\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags12 where\n\nf :: Int\nf = 1\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE Unsafe #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags13 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE Unsafe #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags14 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# OPTIONS_GHC -fpackage-trust #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags15 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -fpackage-trust #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags16 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# OPTIONS_GHC -fpackage-trust #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags17 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fpackage-trust #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags18 where\n\nf :: Int\nf = 1\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-package-trust #-}\n-- | Basic test to see if Safe flags compiles\n-- test should fail as there shouldn't be a no-package-trust flag, only a\n-- package-trust flag!\nmodule SafeFlags19 where\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# OPTIONS_GHC -fpackage-trust #-}\n-- | Basic test to see if Safe flags compiles\nmodule SafeFlags20 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n-- | Basic test to see if Safe warning flags compile\n-- Warn if module is infered unsafe\n-- In this test the warning _shouldn't_ fire\nmodule SafeFlags21 where\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n-- | Basic test to see if Safe warning flags compile\n-- Warn if module is infered unsafe\n-- In this test the warning _should_ fire\nmodule SafeFlags22 where\n\nimport System.IO.Unsafe\n\nf :: Int\nf = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\n-- | Basic test to see if Safe warning flags compile\n-- Warn if module is infered unsafe\n-- In this test the warning _should_ fire and cause a compile fail\nmodule SafeFlags22 where\n\nimport System.IO.Unsafe\n\nf :: Int\nf = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-safe #-}\n-- | Basic test to see if Safe warning flags compile\n-- Warn if module is infered safe\n-- In this test the warning _shouldn't_ fire\nmodule SafeFlags23 where\n\nimport System.IO.Unsafe\n\nf :: Int\nf = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-safe #-}\n-- | Basic test to see if Safe warning flags compile\n-- Warn if module is infered safe\n-- In this test the warning _should_ fire\nmodule SafeFlags25 where\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-safe -Werror #-}\n-- | Basic test to see if Safe warning flags compile\n-- Warn if module is infered safe\n-- In this test the warning _should_ fire and cause a compile fail\nmodule SafeFlags26 where\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-safe-infer #-}\n-- | Basic test to see if no safe infer flag compiles\n-- This module would usually infer safely, so it shouldn't be safe now.\n-- We don't actually check that here though, see test '' for that.\nmodule SafeFlags27 where\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -trust base, -trust bytestring #-}\n-- | Basic test to see if no safe infer flag compiles\n-- This module would usually infer safely, so it shouldn't be safe now.\n-- We don't actually check that here though, see test '' for that.\nmodule SafeFlags28 where\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# OPTIONS_GHC -trust base -trust bytestring #-}\n-- | Basic test to see if no safe infer flag compiles\n-- This module would usually infer safely, so it shouldn't be safe now.\n-- We don't actually check that here though, see test '' for that.\nmodule SafeFlags29 where\n\nf :: Int\nf = 1\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe, Unsafe, Trustworthy #-}\n-- | Basic test to see that incompatible flags give a nice error\n-- message and ghc do not panic (see issue #11580).\nmodule SafeFlags30 where\n\nf :: Int\nf = 1\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SafeIgnore where\n\nimport SafeIgnoreA\n\nfoo = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\nmodule SafeIgnoreA where\n\nqux = ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule A (a) where\n\nimport System.IO.Unsafe\n\na :: Int\na = 1\n\nunsafe = unsafePerformIO\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\nmodule B where\n\nimport System.IO.Unsafe\n\na :: Int\na = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule C (a, C(), D(..)) where\n\na :: Int\na = 1\n\nb :: Int\nb = 2\n\ndata C a = C a Int\n\ndata D a = D a Int\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module D (a) where\n\na :: Int\na = 1\n\nb :: Int\nb = 2\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module E where\n\nimport System.IO.Unsafe\n\na :: Int\na = 1\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\nmodule P13_A where\n\nclass Pos a where { res :: a -> Bool }\n\ninstance Pos [a] where { res _ = True }\n\ninstance Pos Char where { res _ = True }\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Compilation should fail as we have overlapping instances that don't obey\n-- our heuristics.\nmodule SH_Overlap1 where\n\nimport safe SH_Overlap1_A\n\ninstance\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as `SH_Overlap6`, but now we are inferring safety. Safe since\n-- overlapped instance declares itself overlappable.\nmodule SH_Overlap10 where\n\nimport SH_Overlap10_A\n\ninstance\n  {-# OVERLAPS #-}\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap10_A (\n    C(..)\n  ) where\n\nimport SH_Overlap10_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\nmodule SH_Overlap10_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as `SH_Overlap6`, but now we are inferring safety. Should be inferred\n-- unsafe due to overlapping instances at call site `f`.\n--\n-- Testing that we are given correct reason.\nmodule SH_Overlap11 where\n\nimport SH_Overlap11_A\n\ninstance\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap11_A (\n    C(..)\n  ) where\n\nimport SH_Overlap11_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\nmodule SH_Overlap11_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap1_A (\n    C(..)\n  ) where\n\nimport SH_Overlap1_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SH_Overlap1_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as SH_Overlap1, but SH_Overlap2_A is not imported as 'safe'.\n--\n-- Question: Should the OI-check be enforced? Y, see reasoning in\n-- `SH_Overlap4.hs` for why the Safe Haskell overlapping instance check should\n-- be tied to Safe Haskell mode only, and not to safe imports.\nmodule SH_Overlap2 where\n\nimport SH_Overlap2_A\n\ninstance\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap2_A (\n    C(..)\n  ) where\n\nimport SH_Overlap2_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SH_Overlap2_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as SH_Overlap1, but module where overlap occurs (SH_Overlap3) is\n-- marked `Unsafe`. Compilation should succeed (symmetry with inferring safety).\nmodule SH_Overlap3 where\n\nimport SH_Overlap3_A\n\ninstance\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap3_A (\n    C(..)\n  ) where\n\nimport SH_Overlap3_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SH_Overlap3_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as SH_Overlap3, however, SH_Overlap4_A is imported as `safe`.\n--\n-- Question: Should compilation now fail? N. At first it seems a nice idea to\n-- tie the overlap check to safe imports. However, instances are a global\n-- entity and can be imported by multiple import paths. How should safe imports\n-- interact with this? Especially when considering transitive situations...\n--\n-- Simplest is to just enforce the overlap check in Safe and Trustworthy\n-- modules, but not in Unsafe ones.\nmodule SH_Overlap4 where\n\nimport safe SH_Overlap4_A\n\ninstance\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap4_A (\n    C(..)\n  ) where\n\nimport SH_Overlap4_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SH_Overlap4_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Compilation should fail as we have overlapping instances that don't obey\n-- our heuristics.\nmodule SH_Overlap5 where\n\nimport safe SH_Overlap5_A\n\ninstance\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap5_A (\n    C(..)\n  ) where\n\nimport SH_Overlap5_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SH_Overlap5_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as `SH_Overlap5` but dependencies are now inferred-safe, not\n-- explicitly marked. Compilation should still fail.\nmodule SH_Overlap6 where\n\nimport safe SH_Overlap6_A\n\ninstance C [a] where\n  f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap6_A (\n    C(..)\n  ) where\n\nimport SH_Overlap6_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\nmodule SH_Overlap6_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as `SH_Overlap6`, but now we are inferring safety. Should be inferred\n-- unsafe due to overlapping instances at call site `f`.\nmodule SH_Overlap7 where\n\nimport SH_Overlap7_A\n\ninstance C [a] where\n  f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE Safe #-}\nmodule SH_Overlap7_A (\n    C(..)\n  ) where\n\nimport SH_Overlap7_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE Safe #-}\nmodule SH_Overlap7_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Overlapping instances, but with a single parameter type-class and no\n-- orphans. So `SH_Overlap8` decided to explicitly depend on `SH_Overlap8_A`\n-- since that's where the type-class `C` with function `f` is defined.\n--\n-- Question: Safe or Unsafe? Safe\nmodule SH_Overlap8 where\n\nimport safe SH_Overlap8_A\n\ninstance C [a] where\n  f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap8_A (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-safe #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Same as `SH_Overlap6`, but now we are inferring safety. Should be inferred\n-- unsafe due to overlapping instances at call site `f`.\nmodule SH_Overlap9 where\n\nimport SH_Overlap9_A\n\ninstance\n  C [a] where\n    f _ = \"[a]\"\n\ntest :: String\ntest = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule SH_Overlap9_A (\n    C(..)\n  ) where\n\nimport SH_Overlap9_B\n\ninstance\n  {-# OVERLAPS #-}\n  C [Int] where\n    f _ = \"[Int]\"\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\nmodule SH_Overlap9_B (\n    C(..)\n  ) where\n\nclass C a where\n  f :: a -> String\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Should fail compilation because safe imports aren't enabled\n-- not because of trying to import an unsafe module\nmodule Mixed01 where\n\nimport safe System.IO.Unsafe\n\nf :: Int\nf = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n-- | Should fail compilation because we import Data.Word as safe and unsafe\nmodule Mixed02 where\n\nimport safe qualified Data.Word as DW\nimport Data.Word\n\nf :: Int\nf = 1\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n-- | Should fail compilation because we import Data.Word as safe and unsafe\nmodule Mixed03 where\n\nimport safe qualified Data.Word as DW\nimport System.IO\nimport Data.Word\n\nf :: Int\nf = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SafeInfered01 where\n\nimport safe SafeInfered01_A\n\ng :: Int\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Trivial Safe Module\nmodule SafeInfered01_A where\n\nf :: Int\nf = 1\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SafeInfered02 where\n\nimport safe SafeInfered02_A\n\ng :: Int\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n-- | Only uses deriving of Typeable so should be considered safe\nmodule SafeInfered02_A where\n\nimport Data.Typeable\n\ndata G = G Int deriving (Typeable)\n\nf :: Int\nf = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SafeInfered03 where\n\nimport safe SafeInfered03_A\n\ng :: Int\ng = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n-- | FFI but in IO monad so safe\nmodule SafeInfered03_A where\n\nimport Foreign.C\n\nforeign import ccall \"math.h\" sin :: CDouble -> IO CDouble\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SafeInfered04 where\n\nimport safe SafeInfered04_A\n\ng :: Int\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n-- | Safe as while it enables rules it doesn't define any. UnsafeInfered05 is a\n-- test case for when rules are defined and it should be unsafe\nmodule SafeInfered04_A where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# LANGUAGE OverlappingInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | We allow this overlap to succeed since the module is regarded as\n-- `-XUnsafe`.\nmodule SafeInfered05 where\n\nimport safe SafeInfered05_A\n\ninstance C [a] where\n  f _ = \"[a]\"\n\ntest2 :: String\ntest2 = f ([1,2,3,4] :: [Int])\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# OPTIONS_GHC -fwarn-safe #-}\nmodule SafeInfered05_A where\n\nclass C a where\n  f :: a -> String\n\ninstance C [Int] where\n  f _ = \"[Int]\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# OPTIONS_GHC -fwarn-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n\n-- | Trivial Safe Module\nmodule SafeWarn01 where\n\ng :: Int\ng = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-- | This module is marked trustworthy but should be inferable as -XSafe.\n-- But no warning enabled.\nmodule TrustworthySafe01 where\n\ng :: Int\ng = 1\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -fwarn-trustworthy-safe #-}\n\n-- | This module is marked trustworthy but should be inferable as -XSafe.\n-- Warning enabled.\nmodule TrustworthySafe02 where\n\ng :: Int\ng = 1\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -Wall #-}\n{-# OPTIONS_GHC -fwarn-trustworthy-safe #-} -- temp broken by 452d6aa95\n\n-- | This module is marked trustworthy but should be inferable as -XSafe.\n-- Warning enabled through `-W`.\nmodule TrustworthySafe03 where\n\ng :: Int\ng = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -W -fno-warn-trustworthy-safe #-}\n\n-- | This module is marked trustworthy but should be inferable as -XSafe.\n-- Warning enabled through `-W` but then disabled with `-fno-warn...`.\nmodule TrustworthySafe04 where\n\ng :: Int\ng = 1\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule UnsafeInfered01 where\n\nimport safe UnsafeInfered01_A\n\ng :: IO a -> a\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Trivial Unsafe Module\nmodule UnsafeInfered01_A where\n\nimport System.IO.Unsafe\n\nf :: IO a -> a\nf = unsafePerformIO\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule UnsafeInfered02 where\n\nimport safe UnsafeInfered02_A\n\ng :: Int\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n-- | Unsafe as uses TH\nmodule UnsafeInfered02_A where\n\nf :: Int\nf = 1\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule UnsafeInfered03 where\n\nimport safe UnsafeInfered03_A\n\ng :: Int\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n-- | Unsafe as uses GND\nmodule UnsafeInfered03_A where\n\nf :: Int\nf = 1\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule UnsafeInfered05 where\n\nimport safe UnsafeInfered05_A\n\ng :: Int\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n-- | Unsafe as uses RULES\n-- Although only turns on the flag doesn't define? So mark safe\n-- maybe?\nmodule UnsafeInfered05_A where\n\n{-# RULES \"f\" f = undefined #-}\n{-# NOINLINE [1] f #-}\nf :: Int\nf = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule UnsafeInfered06 where\n\nimport safe UnsafeInfered06_A\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n-- | Unsafe as uses FFI with a pure function\nmodule UnsafeInfered06_A where\n\nimport Foreign.C\n\nforeign import ccall \"math.h\" sin :: CDouble -> CDouble\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule UnsafeInfered08 where\n\nimport safe UnsafeInfered08_A\n\nf :: Int\nf = g\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverlappingInstances #-}\n{-# OPTIONS_GHC -w #-}  -- Turn off deprecation for OverlappingInstances\n-- | Safe, as we now check at overlap occurrence, not definition.\nmodule UnsafeInfered08_A where\n\ng :: Int\ng = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule UnsafeInfered09 where\n\nimport safe UnsafeInfered09_A\n\nh :: Int\nh = g\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Unsafe as we explicitly marked UnsafeInfered09_B as unsafe\nmodule UnsafeInfered09_A where\n\nimport UnsafeInfered09_B\n\ng :: Int\ng = f\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\nmodule UnsafeInfered09_B where\n\nf :: Int\nf = 1\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Basic test to see if no safe infer flag works\nmodule UnsafeInfered10 where\n\nimport UnsafeInfered10_A\n\ng :: Int\ng = f\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-safe-infer #-}\n-- | Basic test to see if no safe infer flag works\n-- This module would usually infer safely, so it shouldn't be safe now.\nmodule UnsafeInfered10_A where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Basic test to see if no safe infer flag works\nmodule UnsafeInfered11 where\n\nimport UnsafeInfered11_A\n\ng :: Int\ng = f\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n-- | Basic test to see if no safe infer flag works\n-- This module would usually infer safely, so it shouldn't be safe now.\nmodule UnsafeInfered11_A where\n\nf :: Int\nf = 1\n\ndata T = T1 | T2 | T3 deriving ( Eq, Ord, Show )\n\nlookupx :: Ord key => Show val => [(key,val)] -> key -> Maybe val\nlookupx [] _                      = Nothing\nlookupx ((t,a):xs) t' | t == t'   = Just a\n                      | otherwise = lookupx xs t'\n\n{-# RULES \"lookupx/T\" lookupx = tLookup #-}\n{-# NOINLINE [1] lookupx #-}\n\ntLookup :: [(T,a)] -> T -> Maybe a\ntLookup [] _                      = Nothing\ntLookup ((t,a):xs) t' | t /= t'   = Just a\n                      | otherwise = tLookup xs t'\n\nspace = [(T1,\"a\"),(T2,\"b\"),(T3,\"c\")]\nkey = T3\n\nmain = do\n    putStrLn $ \"looking for \" ++ show key\n    putStrLn $ \"in space \" ++ show space\n    putStrLn $ \"Found: \" ++ show (fromMaybe \"Not Found!\" $ lookupx space key)\n    let b | Just \"c\" <- lookupx space key = \"YES\"\n          | otherwise                     = \"NO\"\n    putStrLn $ \"Rules Disabled: \" ++ b\n\nfromMaybe :: a -> Maybe a -> a\nfromMaybe a Nothing  = a\nfromMaybe _ (Just a) = a\n\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\nmodule UnsafeInfered12 where\n\na :: Int\na = 1\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule UnsafeInfered13 where\n\nclass C a where\n  f :: a -> String\n\ninstance {-# OVERLAPS #-} C a where\n  f _ = \"a\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule UnsafeInfered14 where\n\nclass C a where\n  f :: a -> String\n\ninstance {-# OVERLAPPABLE #-} C a where\n  f _ = \"a\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule UnsafeInfered15 where\n\nclass C a where\n  f :: a -> String\n\ninstance {-# OVERLAPPING #-} C a where\n  f _ = \"a\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule UnsafeInfered16 where\n\nclass C a where\n  f :: a -> String\n\ninstance {-# OVERLAPPING #-} C a where\n  f _ = \"a\"\n\ninstance {-# OVERLAPS #-} C Int where\n  f _ = \"Int\"\n\ninstance {-# OVERLAPPABLE #-} C Bool where\n  f _ = \"Bool\"\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule UnsafeInfered17 where\n\nclass C a where\n  f :: a -> String\n\ninstance {-# INCOHERENT #-} C a where\n  f _ = \"a\"\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE OverlappingInstances #-}\nmodule UnsafeInfered18 where\n\nclass C a where\n  f :: a -> String\n\ninstance C a where\n  f _ = \"a\"\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE IncoherentInstances #-}\nmodule UnsafeInfered19 where\n\nclass C a where\n  f :: a -> String\n\ninstance C a where\n  f _ = \"a\"\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n\n-- | Trivial Unsafe Module\nmodule UnsafeWarn01 where\n\nimport System.IO.Unsafe\n\nf :: IO a -> a\nf = unsafePerformIO\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n\n{-# LANGUAGE TemplateHaskell #-}\n-- | Unsafe as uses TH\nmodule UnsafeWarn02 where\n\nf :: Int\nf = 1\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -fwarn-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n\n-- | Trivial Unsafe Module\nmodule UnsafeWarn03 where\n\nimport System.IO.Unsafe\n\nf :: IO a -> a\nf = unsafePerformIO\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -fwarn-trustworthy-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n\n-- | Trivial Unsafe Module\nmodule UnsafeWarn04 where\n\nimport System.IO.Unsafe\n\nf :: IO a -> a\nf = unsafePerformIO\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Unsafe #-}\n{-# OPTIONS_GHC -fwarn-trustworthy-safe #-}\n{-# OPTIONS_GHC -fwarn-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n\n-- | Trivial Unsafe Module\nmodule UnsafeWarn05 where\n\nimport System.IO.Unsafe\n\nf :: IO a -> a\nf = unsafePerformIO\n\n{-# RULES \"g\" g = undefined #-}\n{-# NOINLINE [1] g #-}\ng :: Int\ng = 1\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n{-# OPTIONS_GHC -fwarn-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n\n-- | Unsafe as uses RULES\nmodule UnsafeWarn06 where\n\n{-# RULES \"f\" f = undefined #-}\n{-# NOINLINE [1] f #-}\nf :: Int\nf = 1\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n{-# OPTIONS_GHC -fwarn-safe #-}\n{-# OPTIONS_GHC -fwarn-unsafe #-}\n\n-- | Unsafe as uses RULES\nmodule UnsafeWarn07 where\n\n{-# RULES \"f\" f = undefined #-}\n{-# NOINLINE [1] f #-}\nf :: Int\nf = 1\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe, TemplateHaskell #-}\n\n-- | Test SafeLanguage disables things\nmodule SafeLang01 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe, GeneralizedNewtypeDeriving #-}\n\n-- | Test SafeLanguage disables things\nmodule SafeLang02 where\n\nf :: Int\nf = 1\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n\n-- | Test SafeLanguage disables things\nmodule SafeLang03 where\n\n{-# RULES \"f\" f = undefined #-}\nf :: Int\nf = 1\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n-- | Check rules work as normal without Safe\nmodule Main where\n\ndata T = T1 | T2 | T3 deriving ( Eq, Ord, Show )\n\nlookupx :: Ord key => Show val => [(key,val)] -> key -> Maybe val\nlookupx [] _                      = Nothing\nlookupx ((t,a):xs) t' | t == t'   = Just a\n                      | otherwise = lookupx xs t'\n\n{-# RULES \"lookupx/T\" lookupx = tLookup #-}\ntLookup :: [(T,a)] -> T -> Maybe a\ntLookup [] _                      = Nothing\ntLookup ((t,a):xs) t' | t /= t'   = Just a\n                      | otherwise = tLookup xs t'\n\nspace = [(T1,\"a\"),(T2,\"b\"),(T3,\"c\")]\nkey = T3\n\nmain = do\n    putStrLn $ \"looking for \" ++ show key\n    putStrLn $ \"in space \" ++ show space\n    putStrLn $ \"Found: \" ++ show (fromMaybe \"Not Found!\" $ lookupx space key)\n    let b | Just \"c\" <- lookupx space key = \"YES\"\n          | otherwise                     = \"NO\"\n    putStrLn $ \"Rules Disabled: \" ++ b\n\nfromMaybe :: a -> Maybe a -> a\nfromMaybe a Nothing  = a\nfromMaybe _ (Just a) = a\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# OPTIONS_GHC -fenable-rewrite-rules #-}\n\n-- | Check rules are disabled under Safe\nmodule Main where\n\ndata T = T1 | T2 | T3 deriving ( Eq, Ord, Show )\n\nlookupx :: Ord key => Show val => [(key,val)] -> key -> Maybe val\nlookupx [] _                      = Nothing\nlookupx ((t,a):xs) t' | t == t'   = Just a\n                      | otherwise = lookupx xs t'\n\n{-# RULES \"lookupx/T\" lookupx = tLookup #-}\ntLookup :: [(T,a)] -> T -> Maybe a\ntLookup [] _                      = Nothing\ntLookup ((t,a):xs) t' | t /= t'   = Just a\n                      | otherwise = tLookup xs t'\n\nspace = [(T1,\"a\"),(T2,\"b\"),(T3,\"c\")]\nkey = T3\n\nmain = do\n    putStrLn $ \"looking for \" ++ show key\n    putStrLn $ \"in space \" ++ show space\n    putStrLn $ \"Found: \" ++ show (fromMaybe \"Not Found!\" $ lookupx space key)\n    let b | Just \"c\" <- lookupx space key = \"YES\"\n          | otherwise                     = \"NO\"\n    putStrLn $ \"Rules Disabled: \" ++ b\n\nfromMaybe :: a -> Maybe a -> a\nfromMaybe a Nothing  = a\nfromMaybe _ (Just a) = a\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\n-- Here we stop it succeeding (SAFE)\n\n-- | We use newtype to create an isomorphic type to Int\n-- with a reversed Ord dictionary. We now use the MinList\n-- API of Y1 to create a new MinList. Then we use newtype\n-- deriving to convert the newtype MinList to an Int\n-- MinList. This final result breaks the invariants of\n-- MinList which shouldn't be possible with the exposed\n-- API of Y1.\nmodule Main where\n\nimport SafeLang07_A\n\nclass IntIso t where\n    intIso :: c t -> c Int\n\ninstance IntIso Int where\n    intIso = id\n\nnewtype Down a = Down a deriving (Eq, Show, IntIso)\n\ninstance Ord a => Ord (Down a) where\n    compare (Down a) (Down b) = compare b a\n\nforceInt :: MinList Int -> MinList Int\nforceInt = id\n\na1, a2 :: MinList Int\na1 = foldl insertMinList (newMinList $ head nums) (tail nums)\na2 = forceInt $ intIso $ foldl (\\x y -> insertMinList x $ Down y) (newMinList $ Down $ head nums) (tail nums)\n\nnums :: [Int]\nnums = [1,4,0,1,-5,2,3,5,-1,2,0,0,-4,-3,9]\n\nmain = do\n    printIntMinList a1\n    printIntMinList a2\n\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n\n-- | Here we expose a MinList API that only allows elements\n-- to be inserted into a list if they are at least greater\n-- than an initial element the list is created with.\nmodule SafeLang07_A (\n        MinList,\n        newMinList,\n        insertMinList,\n        printIntMinList\n    ) where\n\ndata MinList a = MinList a [a]\n\nnewMinList :: Ord a => a -> MinList a\nnewMinList n = MinList n []\n\ninsertMinList :: Ord a => MinList a -> a -> MinList a\ninsertMinList s@(MinList m xs) n | n > m     = MinList m (n:xs)\n                                 | otherwise = s\n\nprintIntMinList :: MinList Int -> IO ()\nprintIntMinList (MinList min xs) = putStrLn $ \"MinList Int :: MinList \" ++ show min ++ \" \" ++ show xs\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE ForeignFunctionInterface #-}\n\n-- | Make sure FFI must be IO type\nmodule Main where\n\nimport Foreign.C\n\nforeign import ccall \"SafeLang08_A\" c_sin :: CDouble -> CDouble\n\nsinx :: Double -> Double\nsinx d = realToFrac $ c_sin $ realToFrac d\n\nx :: Double\nx = 0.8932\n\nmain :: IO ()\nmain = do\n    putStrLn \"Hello World\"\n    putStrLn $ \"Sin of \" ++ (show x) ++ \" is \"  ++ (show $ sinx x)\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport SafeLang09_A -- trusted lib\nimport SafeLang09_B -- untrusted plugin\n\nmain = do\n    let r = res [(1::Int)]\n    putStrLn $ \"Result: \" ++ show r \n    putStrLn $ \"Result: \" ++ show function\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n\n-- | Trusted library that unsafe plugins can use\nmodule SafeLang09_A where\n\nclass Pos a where\n    res :: a -> Bool\n\n-- Any call to res with a list in out TCB\n-- should use this method and never a more\n-- specific one provided by an untrusted module\ninstance Pos [a] where\n    res _ = True\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE OverlappingInstances #-}\n\n-- Untrusted plugin! Don't wan't it changing behaviour of our\n-- trusted code\nmodule SafeLang09_B where\n\nimport SafeLang09_A\n\ninstance Pos a where\n    res _ = False\n\ninstance Pos [Int] where\n    res _ = error \"This curry is poisoned!\"\n\nfunction :: Int\nfunction = 3\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Main where\n\nimport safe SafeLang10_A -- trusted lib\nimport safe SafeLang10_B -- untrusted plugin\n\nmain = do\n    let r = res [(1::Int)]\n    putStrLn $ \"Result: \" ++ show r \n    putStrLn $ \"Result: \" ++ show function\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE Trustworthy #-}\n\n-- | Trusted library that unsafe plugins can use\nmodule SafeLang10_A where\n\nclass Pos a where\n    res :: a -> Bool\n\n-- Any call to res with a list in out TCB\n-- should use this method and never a more\n-- specific one provided by an untrusted module\ninstance Pos [a] where\n    res _ = True\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE Safe #-}\n\n-- Untrusted plugin! Don't wan't it changing behaviour of our\n-- trusted code\nmodule SafeLang10_B where\n\nimport SafeLang10_A\n\ninstance {-# OVERLAPPABLE #-} Pos a where\n    res _ = False\n\ninstance {-# OVERLAPPING #-} Pos [Int] where\n    res _ = error \"This curry is poisoned!\"\n\nfunction :: Int\nfunction = 3\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport SafeLang11_A\nimport SafeLang11_B\n\n$(mkSimpleClass ''A)\n\nmain = do\n    let b = c :: A\n    putStrLn $ \"I have a value of A :: \" ++ show b\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SafeLang11_A ( A ) where\n\ndata A = A1 | A2\n\ninstance Show A where\n    show A1 = \"A1 is secret!\"\n    show A2 = \"A2 is secret!\"\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule SafeLang11_B ( Class(..), mkSimpleClass ) where\n\nimport Language.Haskell.TH\n\nclass Class a where\n        c :: a\n\nmkSimpleClass :: Name -> Q [Dec]\nmkSimpleClass name = do\n        TyConI (DataD [] dname [] Nothing cs _) <- reify name\n        ((NormalC conname []):_) <- return cs\n        ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class\n        return [InstanceD Nothing [] (AppT (ConT cname) (ConT dname)) [FunD mname\n            [Clause [] (NormalB (ConE conname)) []]]]\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport SafeLang12_A\nimport SafeLang12_B\n\n$(mkSimpleClass ''A)\n\nmain = do\n    let b = c :: A\n    putStrLn $ \"I have a value of A :: \" ++ show b\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule SafeLang12_A ( A ) where\n\ndata A = A1 | A2\n\ninstance Show A where\n    show A1 = \"A1 is secret!\"\n    show A2 = \"A2 is secret!\"\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule SafeLang12_B ( Class(..), mkSimpleClass ) where\n\nimport Language.Haskell.TH\n\nclass Class a where\n        c :: a\n\nmkSimpleClass :: Name -> Q [Dec]\nmkSimpleClass name = do\n        TyConI (DataD [] dname [] Nothing cs _) <- reify name\n        ((NormalC conname []):_) <- return cs\n        ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class\n        return [InstanceD Nothing [] (AppT (ConT cname) (ConT dname)) [FunD mname\n            [Clause [] (NormalB (ConE conname)) []]]]\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}\n-- | This shows how to use typeable to perform unsafe\n-- casts. Basically its an example of what Safe Haskell\n-- should disallow. SafeLang14 will do that.\nmodule Main where\n\nimport SafeLang15_A\nimport Data.Typeable\n\ndata H = H String deriving (Typeable, Show)\n\ndata G = G Int deriving (Show)\n\nderiving instance Typeable G\n\nderiving instance Typeable P\n\nmain = do\n    let h = H \"Hello World\"\n        g = G 1\n--        Just h' = (cast h) :: Maybe G\n        Just p' = (cast p) :: Maybe G\n        Just px = (cast $ incrG p') :: Maybe P\n    putStrLn $ show h\n    putStrLn $ show g\n--    putStrLn $ show h'\n    putStrLn $ showP p\n    putStrLn $ show p'\n    putStrLn $ showP px\n\nincrG :: G -> G\nincrG (G n) = G $ n + 1\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SafeLang15_A (IsoInt, h, showH, P, p, showP) where\n\nnewtype IsoInt = I Int\n\nh :: IsoInt\nh = I 2\n\nshowH :: String\nshowH = let I n = h\n        in show n\n\ndata P = P Int\n\np :: P\np = P 3\n\nshowP :: P -> String\nshowP (P n) = \"Should be 3 := \" ++ show n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE Safe #-}\n\n-- | Test SafeLanguage disables things\n-- Testing ordering doesn't matter this time\n-- with Safe appearing after TH.\nmodule SafeLang16 where\n\nf :: Int\nf = 1\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\nmodule Main where\n\nimport SafeLang17_A -- trusted lib\nimport SafeLang17_B -- untrusted plugin\n\nmain = do\n    let r = res [(1::Int)]\n    putStrLn $ \"Result: \" ++ show r \n    putStrLn $ \"Result: \" ++ show function\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Trustworthy #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- | Trusted library that unsafe plugins can use\nmodule SafeLang17_A where\n\nclass Pos a where\n    res :: a -> Bool\n\n-- Any call to res with a list in out TCB\n-- should use this method and never a more\n-- specific one provided by an untrusted module\ninstance Pos [a] where\n    res _ = True\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE IncoherentInstances #-}\n\n-- Untrusted plugin! Don't wan't it changing behaviour of our\n-- trusted code\nmodule SafeLang17_B where\n\nimport SafeLang17_A\n\ninstance Pos a where\n    res _ = False\n\ninstance Pos [Int] where\n    res _ = error \"This curry is poisoned!\"\n\nfunction :: Int\nfunction = 3\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n#if __GLASGOW_HASKELL__ >= 703\n{-# LANGUAGE Safe #-}\n#endif\nmodule SafeLang18 where\n\n#define p377 toPair\n\ndata StrictPair a b = !a :*: !b\n\ntoPair :: StrictPair a b -> (a, b)\ntoPair (x :*: y) = (x, y)\n{-# INLINE p377 #-}\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SafeRecomp01 where\n\nf :: Int\nf = 1\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport SafeRecomp02_A\n\nf :: Int\nf = 1\n\nmain :: IO ()\nmain = putStrLn $ show $ f + g\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module SafeRecomp02_A where\n\ng :: Int\ng = 1\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Import unsafe module System.IO.Unsafe to make sure it fails\nmodule Main where\n\nimport System.IO.Unsafe\n\nf :: Int\nf = unsafePerformIO $ putStrLn \"What kind of swallow?\" >> return 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Import unsafe module Debug.Trace to make sure it fails\nmodule Main where\n\nimport Debug.Trace\n\nf :: Int\nf = trace \"What kind of swallow?\" 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Import unsafe module Unsafe.Coerce to make sure it fails\nmodule Main where\n\nimport Unsafe.Coerce\n\nf :: Int\nf = 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Import unsafe module Control.ST to make sure it fails\nmodule Main where\n\nimport Control.Monad.ST.Unsafe\n\nf :: Int\nf = 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Import unsafe module Control.ST to make sure it fails\nmodule Main where\n\nimport Control.Monad.ST.Lazy.Unsafe\n\nf :: Int\nf = 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\n{-# LANGUAGE UnboxedTuples #-}\nmodule Dep05 where\n\nimport GHC.Arr\n\nbad1 = unsafeArray\n\nbad2 = fill\n\nbad3 = done\n\nbad4 = unsafeThawSTArray\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Dep06 where\n\nimport GHC.Conc\n\nbad1 = unsafeIOToSTM\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Dep07 where\n\nimport GHC.ForeignPtr\n\nbad1 = unsafeForeignPtrToPtr\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\nmodule Dep08 where\n\nimport GHC.IOArray\n\nbad1 = unsafeReadIOArray\n\nbad2 = unsafeWriteIOArray\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Dep09 where\n\nimport GHC.Ptr\n\nbad1 = castFunPtrToPtr\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\nmodule Dep10 where\n\nimport GHC.ST\n\nbad1 = liftST \n\nbad2 = unsafeInterleaveST\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Import SYB stuff that should be safe\nmodule Main where\n\nimport Data.Typeable\nimport Data.Dynamic\nimport Data.Data\n\nf :: Int\nf = 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n-- | Import (now safe by default) modules.\nmodule Main where\n\nimport Control.Monad.ST\nimport Control.Monad.ST.Lazy\nimport Foreign.ForeignPtr\nimport Foreign\n\nf :: Int\nf = 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# OPTIONS_GHC -fno-warn-deprecations #-}\n-- | Import all modules from prelude that should be safe\nmodule Main where\n\nimport Numeric\nimport Prelude\n\nimport Control.Applicative\nimport Control.Arrow\nimport Control.Category\n\nimport Control.Concurrent\nimport Control.Concurrent.Chan\nimport Control.Concurrent.MVar\nimport Control.Concurrent.QSem\nimport Control.Concurrent.QSemN\n\nimport Control.Exception\nimport Control.Exception.Base\n\nimport Control.Monad\nimport Control.Monad.Fix\nimport Control.Monad.Instances\nimport Control.Monad.Zip\n\nimport Control.Monad.ST\nimport Control.Monad.ST.Lazy\nimport Control.Monad.ST.Strict\n\nimport Data.Bifunctor\nimport Data.Bits\nimport Data.Bool\nimport Data.Char\n-- import Data.Coerce\nimport Data.Complex\nimport Data.Data\nimport Data.Dynamic\nimport Data.Either\nimport Data.Eq\nimport Data.Fixed\nimport Data.Foldable\nimport Data.Function\nimport Data.Functor.Identity\nimport Data.Functor\nimport Data.IORef\nimport Data.Int\nimport Data.Ix\nimport Data.List\nimport Data.Maybe\nimport Data.Monoid\nimport Data.Ord\nimport Data.Proxy\nimport Data.Ratio\nimport Data.String\nimport Data.Traversable\nimport Data.Tuple\nimport Data.Typeable\nimport Data.Unique\nimport Data.Version\nimport Data.Word\n\nimport Data.STRef\nimport Data.STRef.Lazy\nimport Data.STRef.Strict\n\nimport Data.Type.Bool\n-- import Data.Type.Coercion\n-- import Data.Type.Equality\n\n-- import Debug.Trace\n\nimport Foreign\n\nimport Foreign.Concurrent\nimport Foreign.ForeignPtr\nimport Foreign.Ptr\nimport Foreign.StablePtr\nimport Foreign.Storable\n\nimport Foreign.C\nimport Foreign.C.Error\nimport Foreign.C.String\nimport Foreign.C.Types\n\nimport Foreign.Marshal\nimport Foreign.Marshal.Alloc\nimport Foreign.Marshal.Array\nimport Foreign.Marshal.Error\nimport Foreign.Marshal.Pool\nimport Foreign.Marshal.Utils\n\nimport System.CPUTime\nimport System.Console.GetOpt\nimport System.Environment\nimport System.Exit\nimport System.IO\nimport System.IO.Error\nimport System.Info\nimport System.Mem\nimport System.Mem.StableName\nimport System.Mem.Weak\nimport System.Posix.Internals\nimport System.Posix.Types\nimport System.Timeout\n\nimport Text.ParserCombinators.ReadP\nimport Text.ParserCombinators.ReadPrec\nimport Text.Printf\nimport Text.Read\nimport Text.Read.Lex\nimport Text.Show\nimport Text.Show.Functions\n\nimport Type.Reflection\n\n-- import Unsafe.Coerce\n\nf :: Int\nf = 2\n\nmain :: IO ()\nmain = putStrLn $ \"X is: \" ++ show f\n\n", "num_lines": 125}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-| `elem`, 'print',\n`Unknown',\n'<>', ':=:', 'Bool'\n-}\nmodule DocsInHiFile\n  ( DocsInHiFile.elem\n  , D(..)\n  , add\n  , P(..)\n  , Show(..)\n  ) where\n\n-- | '()', 'elem'.\nelem :: ()\nelem = ()\n\n-- | A datatype.\ndata D\n  = D0 -- ^ A constructor for 'D'. '\n  | D1 -- ^ Another constructor\n  deriving ( Show -- ^ 'Show' instance\n           )\n\nadd :: Int -- ^ First summand for 'add'\n    -> Int -- ^ Second summand\n    -> Int -- ^ Sum\nadd a b = a + b\n\n-- | A class\nclass P f where\n  -- | A class method\n  p :: a -- ^ An argument\n    -> f a\n\n-- | Another datatype...\ndata D'\n-- ^ ...with two docstrings.\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -O -Wno-inline-rule-shadowing #-}\n-- Rules are ignored without -O\n\nmodule Orphans where\n\nimport GHC.Exts (IsList(..))\n\n-- Some orphan things\ninstance IsList Bool where\n  type Item Bool = Double\n  fromList = undefined\n  toList = undefined\n\n{-# RULES \"myrule1\" id id = id #-}\n\n-- And some non-orphan things\ndata X = X [Int]\ninstance IsList X where\n  type Item X = Int\n  fromList = undefined\n  toList = undefined\n\nf :: X -> X\nf x = x\n{-# RULES \"myrule2\" id f = f #-}\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! This one sent 4.06 into an infinite loop\n\n-- But it worked ok if Simpl006Help.forever is \n-- defined in this module.  I have no idea why!\n\n{-# OPTIONS -O #-}\n\nmodule ShouldCompile where\n\nimport Control.Concurrent \nimport Simpl006Help\n\nafter :: Int -> IO a -> IO a\nafter d c = c\n\nevery :: Int -> IO a -> IO ()\nevery d c = forever (after d c)\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Simpl006Help( forever ) where\n\nforever c  = sequence_ (repeat c)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This one killed GHC 5.02 with a funResultTy panic\n-- The reason was that the simplifier was doing a \n-- case-of-case where the result had a polymorphic type.\n-- This in turn showed up because of a newtype (now \n-- transparent) with a forall inside it.\n--\n-- It's quite hard to tickle this one, hence the two-module setup.\n\nmodule FormParse where\n  \nimport Control.Monad\nimport Simpl009Help\n\nidentifier :: Parser Char Char\nidentifier =\n  do c <- lookAhead\n     guard (c == 'a')\n     return c\n\n\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}\n\n-- Helper for simpl009.hs (see comments there)\n\nmodule Simpl009Help where\n  \nimport Control.Applicative (Applicative(..), Alternative(empty, (<|>)))\nimport Control.Monad\n\nnewtype Parser s a\n  = Parser (forall res . (a -> [String] -> P s res) -> [String] -> P s res)\n\ndata P s res\n  = Symbol (s -> P s res)\n  | Fail [String] [String]\n  | Result res (P s res)\n\ninstance Functor (Parser s) where\n    fmap = liftM\n\ninstance Applicative (Parser s) where\n    pure = return\n    (<*>) = ap\n\ninstance Monad (Parser s) where\n  return a = Parser (\\fut -> fut a)\n  \n  Parser f >>= k =\n    Parser (\\fut -> f (\\a -> let Parser g = k a in g fut))\n\n  fail s =\n    Parser (\\fut exp -> Fail exp [s])\n\ninstance Alternative (Parser s) where\n    empty = mzero\n    (<|>) = mplus\n\ninstance MonadPlus (Parser s) where\n  mplus = error \"urk\"\n  mzero = Parser (\\fut exp -> Fail exp [])\n\nlookAhead :: forall s. Parser s s\nlookAhead =\n  Parser (\\fut exp -> Symbol (\\c ->\n    feed c (fut c [])\n  ))\n where\n  feed :: forall res. s -> P s res -> P s res\n  feed c (Symbol sym)     = sym c\n  feed c (Result res fut) = Result res (feed c fut)\n  feed c p@(Fail _ _)     = p\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module OneShot1 where\n\nimport GHC.Base\n\n-- This oneShot is a lie, and together with unsafePerformIO (in the form of\n-- trace) in OneShot2, we can observe the difference.\n\n-- Two modules to ensure that oneShot annotations surive interface files, both\n-- in explicits unfoldings (foo) and in unannotated functions (baz)\n\nfoo :: Int -> Int -> Int\nfoo y = oneShot (\\x -> x+y)\n{-# INLINE foo #-}\n\nbar :: Int -> Int -> Int\nbar y = (\\x -> y+x)\n{-# INLINE bar #-}\n\nbaz :: Int -> Int -> Int\nbaz y = oneShot (\\x -> x+y)\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import OneShot1\nimport System.Environment\nimport Debug.Trace\n\np n = trace \"p evaluated\" (n > 0)\n{-# NOINLINE p #-}\n\nsummap :: (Int -> Int) -> (Int -> Int)\nsummap f n = sum $ map f [1..10]\n{-# NOINLINE summap #-}\n\nfoo' n = if p n then foo n else foo (n+1)\n{-# NOINLINE foo' #-}\n\nbar' n = if p n then bar n else bar (n+1)\n{-# NOINLINE bar' #-}\n\nbaz' n = if p n then baz n else baz (n+1)\n{-# NOINLINE baz' #-}\n\nmain = do\n  n <- length `fmap` getArgs\n  print $ summap (foo' n) n + summap (bar' n) n + summap (baz' n) n\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\n-- This one sent an earlier version of GHC into a\n-- loop in the simplfier, because we allowed a RULE\n-- to fire on a loop-breaker\n--\n-- Discovered by Roman L, Nov 09\n\nmodule Roman where\n\ndata T a = T (T a)\n\ntype family F a\ntype instance F (T a) = Wrap (T a)\n\nclass B (F a) => C a where\n  toF :: a -> F a\n\ngo :: C a => a -> Int\n{-# INLINE go #-}\ngo x = gow (toF x)\n\ninstance C a => C (T a) where\n  {-# INLINE toF #-}\n  toF x = Wrap x\n\nnewtype Wrap a = Wrap a\n\nclass B a where\n  dummy :: a\n\n  gow :: a -> Int\n\ninstance C a => B (Wrap a) where\n  {-# INLINE gow #-}\n  gow (Wrap x) = go x\n  dummy = error \"urk\"\n\nfoo :: C a => T a -> Int\nfoo t = let t' = T t in go t'\n\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- There was a bug in 6.12 that meant that the binding\n-- for 'rght' was initially determined (correctly) to be\n-- strictly demanded, but the FloatOut pass made it lazy\n--\n-- The test compiles the program and greps for the\n-- binding of 'rght' to check that it is marked strict\n-- something like this:\n--         rght [Dmd=Just S] :: EvalTest.AList a\n\nmodule EvalTest where\n\nimport GHC.Conc\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\ndata Eval a = Done a\n\ninstance Functor Eval where\n    fmap = liftM\n\ninstance Applicative Eval where\n    pure = return\n    (<*>) = ap\n\ninstance Monad Eval where\n  return x = Done x\n  Done x >>= k = k x   -- Note: pattern 'Done x' makes '>>=' strict\n\nrpar :: a -> Eval a\nrpar x = x `par` return x\n\nrseq :: a -> Eval a\nrseq x = x `pseq` return x\n\nrunEval :: Eval a -> a\nrunEval (Done x) = x\n\ndata AList a = ANil | ASing a | Append (AList a) (AList a) | AList [a]\n\nappend ANil r = r\nappend l ANil = l -- **\nappend l r    = Append l r\n\nparListTreeLike :: Integer -> Integer -> (Integer -> a) -> AList a\nparListTreeLike min max fn\n | max - min <= threshold = ASing (fn max)\n | otherwise  =\n      runEval $ do\n        rpar rght\n        rseq left\n        return (left `append` rght)\n    where\n      mid  = min + ((max - min) `quot` 2)\n      left = parListTreeLike min mid fn\n      rght = parListTreeLike (mid+1) max fn\n\nthreshold = 1\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Noinline01 where\nimport GHC.Magic\n\n{-# INLINE f #-}\nf x = True\n\ng = noinline f False\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Par01 where\n\nimport GHC.Conc\n\n-- The smoking gun in -ddump-prep is:\n--  case Par01.depth d of sat { __DEFAULT -> sat }\n-- this should never happen!\n\ndepth :: Int -> Int\ndepth d = d `par` depth d\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This one triggers the bug reported in Trac #1092\n-- The problem is that the rule\n--      forall w. f (\\v->w) = w\n-- erroneously matches the call\n--      f id\n--\n-- Lint catches the error\n\nmodule Foo where\n\nf :: (Int -> Int) -> Int\n{-# NOINLINE f #-}\nf g = g 4\n{-# RULES\n  \"f\" forall w. f (\\v->w) = w\n #-}\n\nh = f id\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# OPTIONS_GHC -ddump-simpl-stats #-}\n\n-- The rule foo/bar should fire\n\nmodule Roman where\n\nfoo :: (forall m. m a -> m b) -> m a -> m b\n{-# NOINLINE foo #-}\nfoo f = f\n\nbar :: (forall m. m a -> m a) -> m a -> m a\nbar f = f\n\n{-# RULES \"foo/bar\" foo = bar #-}\n\nblip = foo id\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- See Trac #1370\n-- THis made GHC 6.6 diverge!\n\nmodule ShouldCompile where\n\nnewtype T = V T deriving(Eq,Ord)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Desugaring sections with function-type arguments\n--  Although this is really a desugaring test, the problem is\n-- only tickled by the simplifier\n\n-- type Foo a b = a -> (b -> a) -> b\nmodule ShouldCompile where\n\n(++++) :: (a -> (b -> a) -> b) -> (a -> (b -> a) -> b) -> a -> (b -> a) -> b\nx ++++ y = y\n\ng a xs = map (++++ a) xs\n\nh b xs = map (b ++++) xs\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! class/instance mumble that failed Lint at one time\n--\nmodule ShouldCompile where\nclass Foo a where\n   op :: Int -> a -> Bool\n\ndata Wibble a b c = MkWibble a b c\n\ninstance (Foo a, Foo b, Foo c) => Foo (Wibble a b c) where\n    op x y = error \"xxx\"\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! INLINE on recursive functions.\n{-\nDate: Thu, 8 Dec 94 11:38:24 GMT\nFrom: Julian Seward (DRL PhD) <sewardj@computer-science.manchester.ac.uk>\nMessage-Id: <9412081138.AA16652@rdf009.cs.man.ac.uk>\nTo: partain@dcs.gla.ac.uk\n-}\nmodule ShouldCompile where\n\ntype IMonad a\n   = IMonadState -> IMonadReturn a\n\ndata IMonadReturn a\n   = IMonadOk   IMonadState a\n   | IMonadFail IMonadState String\n\ntype IMonadState\n   = Int\n\n\nreturnI r = \\s0 -> IMonadOk   s0 r\n\nfailI msg = \\s0 -> IMonadFail s0 msg\n\nthenI m k\n   = \\s0 -> case m s0 of\n               IMonadFail s1 msg -> IMonadFail s1 msg\n               IMonadOk s1 r1    -> k r1 s1\n\ntickI n = \\s0 -> IMonadOk (s0+n) ()\n\nmapI f [] = returnI []\nmapI f (x:xs) = f x           `thenI` ( \\ fx ->\n                mapI f xs     `thenI` ( \\ fxs ->\n                returnI (fx:fxs)\n                ))\n\n{-# INLINE returnI #-}\n{-# INLINE failI #-}\n{-# INLINE thenI #-}\n{-# INLINE tickI #-}\n-- {-# INLINE mapI #-}\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples, MagicHash, BangPatterns #-}\n\nmodule ShouldCompile where\n\nimport Data.Ix\nimport GHC.Exts\n\n\nf ixs@(_, ix_end) frozen# =\n let\n  !n# =\n   case (\n         if null (range ixs)\n          then 0\n          else 1\n        ) of { I# x -> x }\n in\n (# frozen#, False #)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! CPR on newtype with polymorphic argument\n\n{-# OPTIONS -O #-}\n\nmodule ShouldCompile where\n\ndata StateM m s a = STM (s -> m (a,s))\n\ninstance Functor m => Functor (StateM m s) where\n  fmap f (STM xs) =  STM (\\s -> fmap (\\ (x,s') -> (f x, s'))\n                                     (xs s)\n                         )\n{-      With GHC 4.04 (first release) this program gave:\n\n  panic! (the `impossible' happened):\n          mk_cpr_let: not a product\n      forall a{-ruq-} b{-rur-}.\n      (a{-ruq-} -> b{-rur-})\n      -> MonadLibrary.StateM{-r2o,x-} m{-a30Y-} s{-a30Z-} a{-ruq-}\n      -> MonadLibrary.StateM{-r2o,x-} m{-a30Y-} s{-a30Z-} b{-rur-}\n\n The reason: 'Functor' is a newtype, whose element is a for-all type.\n\n        newtype Functor f = Functor (forall a,b.  (a->b) -> f a -> f b)\n-}\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE UndecidableInstances,\n             ExistentialQuantification, FlexibleInstances #-}\n\n-- module Formula where\nmodule Main where\n\nimport Prelude hiding (logBase)\n\nimport Data.Maybe\n\n-------------------------------------------------------------------------------\n\n-- Formula\n-- The data type for formulas (algegraic expressions).\n--\n-- It should be an extensible type, so that users of\n-- the library can add new kinds of formulas.\n-- For example, in this prototype I explore:\n--   integer constants (FInt)\n--   unknown variables (FVar)\n--   sums (FSum)\n--   products (FPro)\n--   powers (FPow)\n--   logarithms (FLog)\n-- The user of the library may want to extend it with\n-- trigonometric formulas or derivative formulas, for\n-- example.\n--\n-- The idea is to let each kind of formula be a new data\n-- type. Similar operations with them are implemented\n-- using overloading. So there is a class (FORMULA) to collect\n-- them and each kind of formula should be an instance of it.\n\nclass (Eq f, Show f) => FORMULA f where\n    ty      :: f -> FType\n    intVal  :: f -> Integer\n    varName :: f -> String\n    argList :: f -> [Formula]\n    same    :: (FORMULA f1) => f -> f1 -> Bool\n    intVal   = error \"\"\n    varName  = error \"\"\n    argList  = error \"\"\n    same _ _ = False\n\n-- By now extensibility is accomplished by existentially\n-- quantified type variables.\n\ndata Formula = forall f . ( FORMULA f\n                          , AddT f\n                          ) =>\n               Formula f\n\ninstance Show Formula where\n    show (Formula f) = show f\n\ninstance Eq Formula where\n    (Formula x) == (Formula y) = same x y\n\ninstance FORMULA Formula where\n    ty (Formula f) = ty f\n    intVal (Formula f) = intVal f\n    varName (Formula f) = varName f\n    argList (Formula f) = argList f\n    same (Formula f) = same f\n\n-------------------------------------------------------------------------------\n\n-- How to uniquely identify the type of formula?\n-- Each type of formula is associated to a key (FType)\n-- that identifies it.\n--\n-- Here I use an enumated data type. When extending\n-- the library, the user will have to modify this\n-- data type adding a new constant constructor.\n\ndata FType = INT\n           | VAR\n           | SUM\n           | PRO\n           | POW\n           | LOG\n             deriving (Eq,Ord,Enum,Show)\n\n-------------------------------------------------------------------------------\n\n-- Integer formula\n\ndata FInt = FInt Integer\n            deriving (Eq,Show)\n\nmkInt = Formula . FInt\n\ninstance FORMULA FInt where\n    ty _ = INT\n    intVal (FInt x) = x\n    same (FInt x) y = isInt y && x == intVal y\n\n-- Variable formula\n\ndata FVar = FVar String\n            deriving (Eq,Show)\n\nmkVar = Formula . FVar\n\ninstance FORMULA FVar where\n    ty _ = VAR\n    varName (FVar x) = x\n    same (FVar x) y = isVar y && x == varName y\n\n-- Sum formula\n\ndata FSum = FSum [Formula]\n            deriving (Eq,Show)\n\nmkSum = Formula . FSum\n\ninstance FORMULA FSum where\n    ty _ = SUM\n    argList (FSum xs) = xs\n    same (FSum xs) y = isSum y && xs == argList y\n\n-- Product formula\n\ndata FPro = FPro [Formula]\n            deriving (Eq,Show)\n\nmkPro = Formula . FPro\n\ninstance FORMULA FPro where\n    ty _ = PRO\n    argList (FPro xs) = xs\n    same (FPro xs) y = isPro y && xs == argList y\n\n-- Exponentiation formula\n\ndata FPow = FPow Formula Formula\n            deriving (Eq,Show)\n\nmkPow x y = Formula (FPow x y)\n\ninstance FORMULA FPow where\n    ty _ = POW\n    argList (FPow b e) = [b,e]\n    same (FPow b e) y = isPow y && [b,e] == argList y\n\n-- Logarithm formula\n\ndata FLog = FLog Formula Formula\n            deriving (Eq,Show)\n\nmkLog x b = Formula (FLog x b)\n\ninstance FORMULA FLog where\n    ty _ = LOG\n    argList (FLog x b) = [x,b]\n    same (FLog x b) y = isLog y && [x,b] == argList y\n\n-------------------------------------------------------------------------------\n\n-- Some predicates\n\nisInt x = ty x == INT\nisVar x = ty x == VAR\nisSum x = ty x == SUM\nisPro x = ty x == PRO\nisPow x = ty x == POW\n\nisZero x = isInt x && intVal x == 0\n\n-------------------------------------------------------------------------------\n\n-- Adding two formulas\n-- This is a really very simple algorithm for adding\n-- two formulas.\n\nadd :: Formula -> Formula -> Formula\nadd x y\n    | isJust u  = fromJust u\n    | isJust v  = fromJust v\n    | otherwise = mkSum [x,y]\n    where\n    u = addT x y\n    v = addT y x\n\nclass AddT a where\n    addT :: a -> Formula -> Maybe Formula\n    addT _ _ = Nothing\n\ninstance {-# OVERLAPPABLE #-} (FORMULA a) => AddT a where {}\n\ninstance AddT Formula where\n    addT (Formula f) = addT f\n\ninstance AddT FInt where\n    addT (FInt 0) y  = Just y\n    addT (FInt x) y\n         | isInt y   = Just (mkInt (x + intVal y))\n         | otherwise = Nothing\n\ninstance AddT FSum where\n    addT (FSum xs) y\n         | isSum y   = Just (mkSum (merge xs (argList y)))\n         | otherwise = Just (mkSum (merge xs [y]))\n         where\n         merge = (++)\n\ninstance AddT FLog where\n    addT (FLog x b) y\n         | isLog y && b == logBase y = Just (mkLog (mkPro [x,logExp y]) b)\n         | otherwise                 = Nothing\n         where\n         merge = (++)\n\nisLog x = ty x == LOG\n\nlogBase x\n    | isLog x = head (tail (argList x))\n\nlogExp x\n    | isLog x = head (argList x)\n\n-------------------------------------------------------------------------------\n\n-- Test addition of formulas\n\nmain = print [ add (mkInt 78)  (mkInt 110)\n             , add (mkInt 0)   (mkVar \"x\")\n             , add (mkVar \"x\") (mkInt 0)\n             , add (mkVar \"x\") (mkVar \"y\")\n             , add (mkSum [mkInt 13,mkVar \"x\"]) (mkVar \"y\")\n             , add (mkLog (mkVar \"x\") (mkInt 10))\n                   (mkLog (mkVar \"y\") (mkInt 10))\n             , add (mkLog (mkVar \"x\") (mkInt 10))\n                   (mkLog (mkVar \"y\") (mkVar \"e\"))\n             ]\n", "num_lines": 237}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# OPTIONS_GHC -dcore-lint #-}\n\n-- This one killed GHC 6.0, with a \"panic: applyTys\"\n-- Only with -O, though\n\nmodule ShouldCompile where\n\nnewtype R = R (forall a. a->a)\n\nfoo = case undefined of\n        R f -> f ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE ExistentialQuantification #-}\n\n-- This tests an interaction between GADTs and join points\n-- The case-of-case transformation can pretty easily result\n-- in a type mis-match, because the join point does not see\n-- the refinement from the case branch\n\nmodule ShouldCompile( h ) where\n\ndata T a = forall b. T b [a] | T2\n\nf :: a -> T a -> [a]\nf x (T _ a) = a ++ a ++ a ++ [x]\nf x T2      = [x]\n\nh :: a -> Bool -> T a -> T a -> [a]\nh x b p q = f x (case b of { True -> p; False -> q })\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, KindSignatures,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- This one triggered a bug in the indirection-shorting \n-- machinery, which gave a core-lint error\n\nmodule MHashTable (STHashTable, new, update) where\n\nimport Data.Kind            (Type)\nimport Data.Int             (Int32)\nimport Control.Monad.ST     (ST)\nimport Data.STRef           (STRef)\nimport Data.Array.ST        (STArray)\nimport Data.Array.MArray    (writeArray)\n\nclass Monad m => MutHash arr ref m | arr -> m, ref -> m\n                                   , arr -> ref, ref -> arr where\n    newMHArray  :: (Int32, Int32) -> a -> m (arr Int32 a)\n    readMHArray :: arr Int32 a -> Int32 -> m a\n    writeMHArray:: arr Int32 a -> Int32 -> a -> m ()\n\n    newMHRef    :: a -> m (ref a)\n    readMHRef   :: ref a -> m a\n    writeMHRef  :: ref a -> a -> m ()\n\ninstance MutHash (STArray s) (STRef s) (ST s) where\n    newMHArray  = undefined\n    readMHArray = undefined\n    writeMHArray= writeArray\n\n    newMHRef    = undefined\n    readMHRef   = undefined\n    writeMHRef  = undefined\n\ntype STHashTable s key val = HashTable key val (STArray s) (STRef s) (ST s)\n\nnewtype HashTable key val arr ref m = HashTable (ref (HT key val arr ref m))\n\ndata HT key val arr (ref :: Type -> Type) (m :: Type -> Type) =\n  HT { dir :: (arr Int32 (arr Int32 [(key,val)])) }\n\nnew :: forall arr ref m key val. (MutHash arr ref m) => m (HashTable key val arr ref m)\nnew = do\n  (dir::arr Int32 (arr Int32 [(key,val)]))  <- newMHArray (0,0) undefined\n  (segment::arr Int32 [(key,val)])          <- return undefined\n  return (undefined :: HashTable key val arr ref m)\n\n{-# RULES \"update/ST\" update = updateST #-}\nupdateST:: STHashTable s k v -> k -> v -> ST s Bool\nupdateST= update'\n\nupdate  :: (MutHash arr ref m)\n        => HashTable key val arr ref m -> key -> val -> m Bool\n{-# NOINLINE [1] update #-}\nupdate  = update'\n\nupdate' :: (MutHash arr ref m)\n        => HashTable key val arr ref m -> key -> val -> m Bool\nupdate' _ _ _ = return False\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This is a version of tc095.hs, which makes the compiler \n-- loop (with -O) because of the recursive data-type bug, \n-- unless you have the NOINLINE (which Happy does,\n-- as it happens).\n\n-- Keywords: diverge, contravariant, fixpoint\n\nmodule ShouldSucceed where\n\nhappyParse = happyFail 7 7 (error \"reading EOF!\") (HappyState happyFail) [] [] []\n\ndata HappyState b c = HappyState\n        (Int ->                         -- token number\n         Int ->                         -- token number (yes, again)\n         b ->                           -- token semantic value\n         HappyState b c ->              -- current state\n         [HappyState b c] ->            -- state stack\n         c)\n\n{-# NOINLINE happyFail #-}\nhappyFail _ i tk st@(HappyState action) sts stk = action (-1) (-1) tk st sts ( stk)\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- This one made GHC 6.4.1 panic because of over-zealous \n-- complaining in mkCase1 when there was an empty list of\n-- alternatives\n\nmodule Foo2 where\n\ndata FooBar  = Foo | Bar\n\ndata P a = P0 | P1 FooBar\n\ndata PS p where\n    C :: P Int -> p b -> PS p\n\nf :: PS P -> Char\nf (C (P1 _)   P0)       = 'a'\nf (C (P1 Bar) (P1 Bar)) = 'b'\nf (C (P1 _)   (P1 Bar)) = 'c'\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# OPTIONS_GHC -O2 #-}\n{-# LANGUAGE RankNTypes, GADTs, FlexibleContexts #-}\n\n-- This one make SpecConstr generate bogus code (hence -O2),\n-- with a lint error, in GHC 6.4.1\n-- C.f. http://ghc.haskell.org/trac/ghc/ticket/737\n\nmodule ShouldCompile where\n\n data IHandler st where\n     IHandler :: forall st ev res.\n                 Serialize (TxContext ev) => String -> IO ev\n                 -> (res -> IO ()) -> Ev st ev res -> IHandler st\n     -- Weird test case: (Serialize (TxContext ev)) is simplifiable\n\n data Ev st ev res  = Ev\n data TxContext evt = TxContext\n data TxConfig      = TxConfig\n data M    a        = M a\n\n class Serialize a where\n instance Serialize a => Serialize (TxContext a)\n instance Serialize Int\n instance Serialize ()\n\n data IHR st = forall res ev. Serialize (TxContext ev) => IHR (TxContext ev)\n\n\n runHandler :: M (IHR st) ->  IHandler st -> IO ()\n runHandler queue ih@(IHandler tstring inp out run) = runHandler queue ih\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- Test for trac ticket #1287; ghc 6.6 and 6.6.1 panicked on this\n\nmodule ShouldCompile where\n\n{-# SPECIALIZE delta' :: Num b => Int -> Int -> b -> b -> b #-}\ndelta' :: Eq a => a -> a -> b -> b -> b\ndelta' x y e f = if (x==y) then f else e\n\n{-# SPECIALIZE delta :: Num b => Int -> Int -> b #-}\ndelta :: (Eq a, Num b) => a -> a -> b\ndelta x y = delta' x y 0 1\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XImpredicativeTypes -fno-warn-deprecated-flags -XEmptyDataDecls -XGADTs -XLiberalTypeSynonyms -XFlexibleInstances -XScopedTypeVariables #-}\n\n-- See Trac #1627.  The point is that we should get nice\n--                  compact code for Foo\n\n-- In GHC 7.0 this fails, and rightly so.\n\nmodule M(foo) where\n\nimport Control.Monad\nimport Control.Monad.ST\nimport Data.Array.ST\n\ndata E' v m a where\n    E :: m a -> E' RValue m a\n    V :: m a -> (a -> m ()) -> E' v m a\n\ndata LValue\ndata RValue\n\ntype E m a = E' RValue m a\ntype V m a = E' LValue m a\n\n{-# INLINE runE #-}\nrunE :: E' v m a -> m a\nrunE (E t) = t\nrunE (V t _) = t\n\ninstance Monad m => Functor (E' RValue m) where\n    {-# INLINE fmap #-}\n    fmap f x = liftM f x\n\ninstance Monad m => Applicative (E' RValue m) where\n    {-# INLINE pure #-}\n    pure x = return x\n    {-# INLINE (<*>) #-}\n    (<*>) = ap\n\ninstance (Monad m) => Monad (E' RValue m) where\n    {-# INLINE return #-}\n    return x = E $ return x\n    {-# INLINE (>>=) #-}\n    x >>= f = E $ do\n        x' <- runE x\n        runE (f x')\n\nliftArray :: forall arr m a i . (Ix i, MArray arr a m) =>\n             arr i a -> E m (forall v . [E m i] -> E' v m a)\n{-# INLINE liftArray #-}\nliftArray a = E (do\n    let ix :: [E m i] -> m i\n        ix [i] = runE i\n        {-# INLINE f #-}\n        f is = V (ix is >>= readArray a) (\\ x -> ix is >>= \\ i -> writeArray a i x)\n    return f\n  )\n\n{-# INLINE liftE2 #-}\nliftE2 :: (Monad m) => (a -> b -> c) -> E' va m a -> E' vb m b -> E m c\nliftE2 op x y = E $ do\n    x' <- runE x\n    y' <- runE y\n    return (x' `op` y')\n\n{-# INLINE plus #-}\nplus :: (Monad m) => E m Int -> E m Int -> E m Int\nplus = liftE2 (+)\n\nfoo :: forall s . STArray s Int Int -> ST s Int\nfoo ma = runE $ do\n    a <- liftArray ma\n    let one :: E (ST t) Int\n        one = return 1\n    a[one] `plus` a[one]\n\n", "num_lines": 76}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\n-- See Note [Float coercions (unlifted)] in Simplify\n-- This one gave a CoreLint error when compiled optimised\n--\n-- See also Trac #1718, of which this is a simplified version\n\nmodule ShouldCompile where\n\nbar :: Bool -> Int\nbar x = case (case x of { True -> (# 2,3 #); False -> error \"urk\" }) of\n                (# p,q #) -> p+q\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, FlexibleInstances #-}\n{-# OPTIONS_GHC -O2 #-}\n\n-- See Trac #1746\n\nmodule Foo where\n\ndata T a where T :: T a -> T [a]\n\nclass C a where\n  f :: a -> ()\n\ninstance C (T [a]) where\n  f (T x@(T _)) = f x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- trac #1709\n\nmodule FileDialog where\n\nimport Simpl020_A\n\ncreateFolder :: ()\ncreateFolder = geometry 0\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}\nmodule Simpl020_A where\n\nclass GUIValue a\n\nclass GUIObject w where\n  toGUIObject     :: w -> ()\n  cset            :: GUIValue a => a -> w\n\ninstance GUIValue Int\n\nclass GUIObject w => HasSize w where\n  width :: Int -> w\n\nclass HasSize w => HasGeometry w where\n  geometry :: Int -> w\n\nclass GUIObject w => Window w where\n\ninstance (GUIObject w, Window w) => HasSize w where\n  width w = geometry w\n\ninstance Window w => HasGeometry w where\n  geometry g = cset g\n\ninstance GUIObject ()\n\ninstance Window ()\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Simpl021A where\n\ni :: Integer\ni = 123\n\nj :: Integer\nj = 12345678901234567890123 -- > 2^64\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Simpl021A\n\nmain :: IO ()\nmain = do print i\n          print j\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- This test checks that specialisations can apply inside\n   wrappers.  In particular, the wrapper for 'foo' should\n   look like\n\n         Tmpl= \\ (n_aal [Occ=Once!] :: GHC.Types.Int) ->\n                 case n_aal of _ { GHC.Types.I# ipv_smZ [Occ=Once] ->\n                 case Roman.foo_$s$wgo ipv_smZ 6 of ww_spp { __DEFAULT ->\n                 GHC.Types.I# ww_spp\n                 }\n                 }}]\n   Note the $s$wgo.  That in turn allows $wgo to be dead code.\n-}\n\nmodule Roman where\n\nfoo :: Int -> Int\nfoo n = n `seq` go (Just n) (Just (6::Int))\n  where\n    go u (Just x)\n      = x `seq`\n        case u of\n          Nothing -> go (Just 10) (Just m)\n          Just n\n                 | n <= 0    -> 0\n                 | n < 100   -> go (Just (n-2)) (Just x)\n                 | n < 500   -> go (Just (n-3)) (Just m)\n                 | otherwise -> go (Just (n-1)) (Just (m+m))\n      where\n        m = x+x+x+x+x+x+x\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, UnboxedTuples, MagicHash, StandaloneDeriving, DeriveDataTypeable #-}\n{-# OPTIONS_GHC -O #-}\n\n-- In GHC 6.4, compiling this module gave a Core Lint failure following the\n-- specialiser, because a function was floated out that had a RULE that\n-- mentioned another function (unpack, in fact).  but the latter wasn't\n-- floated because we didn't take the RULES into account properly; result,\n-- variable out of scope.\n\n-- It's hard to cut this test down.\n\n\nmodule Data.PackedString.Latin1 (\n        -- * The @PackedString@ type\n        PackedString,      -- abstract, instances: Eq, Ord, Show, Typeable\n\n         -- * Converting to and from @PackedString@s\n        pack,\n        unpack,\n\n        -- * I\\/O with @PackedString@s\n        hPut, hGet,\n\n        -- * List-like manipulation functions\n        nil,\n        cons,\n        head,\n        tail,\n        null,\n        append,\n        length,\n        index,\n        map,\n        filter,\n        reverse,\n        concat,\n        elem,\n        substr,\n        take,\n        drop,\n        splitAt,\n        foldl,\n        foldr,\n        takeWhile,\n        dropWhile,\n        span,\n        break,\n        lines,\n        unlines,\n        words,\n        unwords,\n        split,\n        splitWith,\n        join,\n--      unpackList, -- eek, otherwise it gets thrown away by the simplifier\n\n    ) where\n\nimport qualified Prelude\nimport Prelude hiding (\n        head,\n        tail,\n        null,\n        length,\n        (!!),\n        map,\n        filter,\n        reverse,\n        concat,\n        elem,\n        take,\n        drop,\n        foldl,\n        foldr,\n        splitAt,\n        takeWhile,\n        dropWhile,\n        span,\n        break,\n        lines,\n        unlines,\n        words,\n        unwords,\n        join\n )\n\nimport GHC.Exts\nimport GHC.IO (IO(..))\nimport Foreign\nimport Data.Typeable\nimport Data.Char\nimport qualified Data.List\nimport System.IO\n\n-- -----------------------------------------------------------------------------\n-- PackedString type declaration\n\n-- | A space-efficient representation of a 'String', which supports\n-- various efficient operations.  A 'PackedString' contains Latin1\n-- (8-bit) characters only.\ndata PackedString = PS {-#UNPACK#-}!Int {-#UNPACK#-}!Int\n                       {-#UNPACK#-}!(ForeignPtr Word8)\n        -- this is a pretty efficient representation, and can be\n        -- converted to/from a StorableArray.\n        -- When the ForeignPtr is unpacked, we get the Addr# stored\n        -- directly in the PS constructor.\n\n-- Perhaps making a slice should be conditional on the ratio of the\n-- slice/string size to limit memory leaks.\n\ninstance Eq PackedString where\n   a == b =  comparePS a b == EQ\n\ninstance Ord PackedString where\n   compare = comparePS\n\ncomparePS (PS off1 len1 fp1) (PS off2 len2 fp2)\n  = inlinePerformIO $\n        withForeignPtr fp1 $ \\p1 ->\n        withForeignPtr fp2 $ \\p2 ->\n        cmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) len1\n  where\n    cmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Ordering\n    cmp p1 p2 n\n      | n == len1 = if n == len2 then return EQ else return LT\n      | n == len2 = return GT\n      | otherwise = do\n          a <- peekElemOff p1 n\n          b <- peekElemOff p2 n\n          case a `compare` b of\n                EQ -> cmp p1 p2 (n+1)\n                LT -> return LT\n                GT -> return GT\n\n--instance Read PackedString: ToDo\n\ninstance Show PackedString where\n    showsPrec p ps r = showsPrec p (unpack ps) r\n\nderiving instance Typeable PackedString\n\n-- -----------------------------------------------------------------------------\n-- Constructor functions\n\n-- | The 'nilPS' value is the empty string.\nnil :: PackedString\nnil = inlinePerformIO $ do\n                fp <- newForeignPtr_ nullPtr\n                return (PS 0 0 fp)\n\n-- | The 'consPS' function prepends the given character to the\n-- given string.\ncons :: Char -> PackedString -> PackedString\ncons c cs = pack (c : (unpack cs)) -- ToDo:better\n\n-- | Convert a 'String' into a 'PackedString'\npackLen :: Int -> String -> PackedString\npackLen len str = inlinePerformIO $ do\n  fp <- mallocForeignPtrBytes len\n  withForeignPtr fp $ \\p -> do\n        fill_it_in p 0 str\n        return (PS 0 len fp)\n\nfill_it_in p i [] = return ()\nfill_it_in p i (c:cs) = do pokeElemOff p i (c2w c); fill_it_in p (i+1) cs\n\npack :: String -> PackedString\npack str = packLen (Prelude.length str) str\n\n{-# INLINE w2c #-}\nw2c :: Word8 -> Char\nw2c = chr . fromIntegral\n{-# INLINE c2w #-}\nc2w :: Char -> Word8\nc2w = fromIntegral . ord\n\n-- -----------------------------------------------------------------------------\n-- List-mimicking functions for PackedStrings\n\n-- | The 'length' function returns the length of the input list.\n-- Analogous to 'length'.\nlength :: PackedString -> Int\nlength (PS _ len _) = len\n\n-- | The 'index' function returns the character in the string at the\n-- given position.\nindex :: PackedString -> Int -> Char\nindex ps i\n  | i >= 0 && i < len = unsafeIndex ps i\n  | otherwise = error \"Data.PackedString.Latin1.index: index out of range\"\n  where len = length ps\n\nunsafeIndex :: PackedString -> Int -> Char\nunsafeIndex (PS off len fp) i =\n  withPackedString fp $ \\p -> do\n    w <- peekElemOff (p `plusPtr` off) i\n    return $! w2c w\n\n-- | The 'head' function returns the first element of a\n-- 'PackedString' or throws an error if the string is empty.\nhead :: PackedString -> Char\nhead ps\n  | len <= 0 = error \"Data.PackedString.Latin1.head: head []\"\n  | otherwise = index ps 0\n  where len = length ps\n\n-- | The 'tail' function returns the tail of a 'PackedString' or throws an error\n-- if the string is empty.\ntail :: PackedString -> PackedString\ntail ps\n  | len <= 0 = error \"Data.PackedString.Latin1.tail: tail []\"\n  | len == 1 = nil\n  | otherwise  = substr ps 1 (len - 1)\n  where len = length ps\n\n-- | The 'null' function returns True iff the argument is null.\nnull :: PackedString -> Bool\nnull (PS _ l _) = l == 0\n\n-- | The 'append' function appends the second string onto the first.\nappend :: PackedString -> PackedString -> PackedString\nappend xs ys\n  | null xs = ys\n  | null ys = xs\n  | otherwise  = concat [xs,ys]\n\n-- | The 'map' function applies a function to each character in the string.\nmap :: (Char -> Char) -> PackedString -> PackedString\nmap f ps = packLen (length ps) (Prelude.map f (unpack ps))\n\n-- | The 'filter' function filters out the appropriate substring.\nfilter :: (Char -> Bool) -> PackedString -> PackedString {-or String?-}\nfilter pred ps = pack $ Prelude.filter pred $ unpack ps\n\n-- | The 'foldl' function behaves like 'foldl' on 'PackedString's.\nfoldl :: (a -> Char -> a) -> a -> PackedString -> a\nfoldl f b ps = Prelude.foldl f b $ unpack ps\n\n-- | The 'foldr' function behaves like 'foldr' on 'PackedString's.\nfoldr :: (Char -> a -> a) -> a -> PackedString -> a\nfoldr f v ps = Prelude.foldr f v $ unpack ps -- no intermediate list, we hope\n\n-- | The 'take' function takes the first @n@ characters of a 'PackedString'.\ntake :: Int -> PackedString -> PackedString\ntake n ps = substr ps 0 (n-1)\n\n-- | The 'drop' function drops the first @n@ characters of a 'PackedString'.\ndrop    :: Int -> PackedString -> PackedString\ndrop n ps = substr ps n (length ps - 1)\n\n-- | The 'splitWith' function splits a 'PackedString' at a given index.\nsplitAt :: Int -> PackedString -> (PackedString, PackedString)\nsplitAt  n ps  = (take n ps, drop n ps)\n\n-- | The 'takeWhile' function is analogous to the 'takeWhile' function.\ntakeWhile :: (Char -> Bool) -> PackedString -> PackedString\ntakeWhile pred ps = pack $ Prelude.takeWhile pred $ unpack ps\n\n-- | The 'dropWhile' function is analogous to the 'dropWhile' function.\ndropWhile :: (Char -> Bool) -> PackedString -> PackedString\ndropWhile pred ps = pack $ Prelude.dropWhile pred $ unpack ps\n\n-- | The 'elem' function returns True iff the given element is in the string.\nelem :: Char -> PackedString -> Bool\nelem c ps = c `Prelude.elem` unpack ps\n\n-- | The 'span' function returns a pair containing the result of\n-- running both 'takeWhile' and 'dropWhile'.\nspan :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)\nspan  p ps = (takeWhile p ps, dropWhile p ps)\n\n-- | The 'break' function breaks a string at the first position which\n-- satisfies the predicate.\nbreak :: (Char -> Bool) -> PackedString -> (PackedString, PackedString)\nbreak p ps = span (not . p) ps\n\n-- | The 'lines' function splits the input on line-breaks.\nlines :: PackedString -> [PackedString]\nlines ps = split '\\n' ps\n\n-- | The 'unlines' function concatenates the input list after\n-- interspersing newlines.\nunlines :: [PackedString] -> PackedString\nunlines pss = join (pack \"\\n\") pss\n\n-- | The 'words' function is analogous to the 'words' function.\nwords :: PackedString -> [PackedString]\nwords ps = Prelude.filter (not.null) (splitWith isSpace ps)\n\n-- | The 'unwords' function is analogous to the 'unwords' function.\nunwords :: [PackedString] -> PackedString\nunwords pss = join (pack \" \") pss\n\n-- | The 'reverse' function reverses the string.\nreverse :: PackedString -> PackedString\nreverse ps = pack $ Prelude.reverse $ unpack ps\n\n-- | The 'concat' function concatenates a list of 'PackedString's.\nconcat :: [PackedString] -> PackedString\nconcat pss = pack $ Prelude.concat $ Prelude.map unpack pss\n\n------------------------------------------------------------\n\n-- | The 'join' function takes a 'PackedString' and a list of 'PackedString's\n-- and concatenates the list after interspersing the first argument between\n-- each element of the list.\njoin :: PackedString -> [PackedString] -> PackedString\njoin filler pss = concat (splice pss)\n where\n  splice []  = []\n  splice [x] = [x]\n  splice (x:y:xs) = x:filler:splice (y:xs)\n\n-- ToDo: the obvious generalisation\n{-\n  Some properties that hold:\n\n  * split x ls = ls'\n      where False = any (map (x `elem`) ls')\n\n  * join (pack [x]) (split x ls) = ls\n-}\n\n-- | The 'split' function splits the input string on each occurrence of the given 'Char'.\nsplit :: Char -> PackedString -> [PackedString]\nsplit c = splitWith (== c)\n\nsplitWith :: (Char -> Bool) -> PackedString -> [PackedString]\nsplitWith pred (PS off 0 fp) = []\nsplitWith pred (PS off len fp) = splitWith' pred off len fp\n\nsplitWith' pred off len fp =\n  withPackedString fp $ \\p -> splitLoop pred p 0 off len fp\n\nsplitLoop pred p idx off len fp\n        | p `seq` idx `seq` off `seq` fp `seq` False = undefined\nsplitLoop pred p idx off len fp\n        | idx >= len  = return [PS off idx fp]\n        | otherwise = do\n                w <- peekElemOff p (off+idx)\n                if pred (w2c w)\n                   then return (PS off idx fp :\n                                  splitWith' pred (off+idx+1) (len-idx-1) fp)\n                   else splitLoop pred p (idx+1) off len fp\n\n-- -----------------------------------------------------------------------------\n-- Local utility functions\n\n-- The definition of @_substr@ is essentially:\n-- @take (end - begin + 1) (drop begin str)@.\n\n-- | The 'substr' function takes a 'PackedString' and two indices\n-- and returns the substring of the input string between (and including)\n-- these indices.\nsubstr :: PackedString -> Int -> Int -> PackedString\nsubstr (PS off len fp) begin end = PS (off+begin) (end-begin+1) fp\n\n-- -----------------------------------------------------------------------------\n-- hPut\n\n-- | Outputs a 'PackedString' to the specified 'Handle'.\n--\n-- NOTE: the string will be output directly in Latin-1.\n--\nhPut :: Handle -> PackedString -> IO ()\nhPut h (PS off l fp) =\n  withForeignPtr fp $ \\p ->\n    hPutBuf h (p `plusPtr` off) l\n\n-- -----------------------------------------------------------------------------\n-- hGet\n\n-- | Read a 'PackedString' directly from the specified 'Handle'.\n-- This is far more efficient than reading the characters into a 'String'\n-- and then using 'pack'.\n--\n-- NOTE: as with 'hPut', the string representation in the file is\n-- assumed to be Latin-1.\nhGet :: Handle -> Int -> IO PackedString\nhGet h i = do\n  fp <- mallocForeignPtrBytes i\n  withForeignPtr fp $ \\p -> do\n    l <- hGetBuf h p i\n    return (PS 0 l fp)\n\n-- -----------------------------------------------------------------------------\n-- unpacking\n\n{-# INLINE unpack #-}\nunpack :: PackedString -> String\nunpack ps = build (unpackFoldr ps)\n\n{-# RULES\n\"unpack-list\"  [1]  forall p  . unpackFoldr p (:) [] = unpackList p\n #-}\n\nunpackList :: PackedString -> [Char]\nunpackList (PS off len fp) =\n   withPackedString fp $ \\p -> do\n      let loop p (-1) acc = return acc\n          loop p n acc = do\n             a <- peekElemOff p n\n             loop p (n-1) (w2c a : acc)\n      loop (p `plusPtr` off) (len-1) []\n\n{-# INLINE [0] unpackFoldr #-}\nunpackFoldr :: PackedString -> (Char -> a -> a) -> a -> a\nunpackFoldr (PS off len fp) f c =\n   withPackedString fp $ \\p -> do\n      let loop p (-1) acc = return acc\n          loop p n acc = do\n             a <- peekElemOff p n\n             loop p (n-1) (w2c a `f` acc)\n      loop (p `plusPtr` off) (len-1) c\n\n-- -----------------------------------------------------------------------------\n-- Utils\n\n-- Just like unsafePerformIO, but we inline it.\n{-# INLINE inlinePerformIO #-}\ninlinePerformIO :: IO a -> a\ninlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r\n\nwithPackedString :: ForeignPtr a -> (Ptr a -> IO b) -> b\nwithPackedString fp io = inlinePerformIO (withForeignPtr fp io)\n", "num_lines": 426}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 #-}\n\n-- Ths one fooled the rule-matching in SpecConstr, and gave a CoreLint error\n\nmodule Foo where\n\ntype Token = (Int, Int, Lex, String)\n\ndata Lex = Llbrace\n\nlaLayout :: Int -> [Int] -> [Token] -> [Token]\n\nlaLayout l (s:ss) (t1@(l1, n1, w1, c1) :\n                   t2@(l2, n2, w2, c2) : ts)\n   | n1 < s    = laLayout l2 (n2:s:ss) ts\n   | n1 == s   = []   -- Otherwise laLayout is bottom!\n   | otherwise = laLayout l ss (t1:t2:ts)\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- Trac #1402\n-- Broke the specialiser\n\nmodule ShouldCompile where\n\nnewtype Gen a = MkGen{ unGen :: Int -> a }\n\nchoose :: Eq a => a -> Gen a\nchoose n = MkGen (\\r -> n)\n\noneof = choose (1::Int)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nimport GHC.CString (unpackFoldrCString#, unpackCString#)\nimport GHC.Base (eqString)\nmain :: IO ()\nmain = do\n  let mix c n = fromEnum c + n\n  n <- readLn\n\n  print $\n    -- We expect the two literals to be concatenated, resulting in \"@@@ ab\"\n    unpackFoldrCString# \"@@@ a\"# mix\n      (unpackFoldrCString# \"b\"# mix n)\n\n  if eqString (unpackCString# \"x\"#) (unpackCString# \"y\"#)\n    then putStrLn $ unpackCString# \"@@@ c\"# -- this should be optimized out\n    else putStrLn $ unpackCString# \"@@@ d\"#\n\n  if eqString (unpackCString# \"foo\"#) (unpackCString# \"foo\"#)\n    then putStrLn $ unpackCString# \"@@@ e\"#\n    else putStrLn $ unpackCString# \"@@@ f\"# -- this should be optimized out\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test from Kirsten Chevalier\n-- Tests the \"strict bindings getting floated to top\" bug in the floater\n\nmodule B (bernoulli) where\n\npowers = [2..] : powers \n\nneg_powers = map (zip (iterate id True)) powers\n\nbernoulli = head powers \n  where powers = head neg_powers \n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10083 where\n  import T10083a\n  data RSR = MkRSR SR\n  eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)\n  foo x y = not (eqRSR x y)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10083a where\n  import {-# SOURCE #-} T10083\n  data SR = MkSR RSR\n  eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T10176(buggy) where\n\n{-# NOINLINE error2Args #-}\nerror2Args :: () -> () -> a\nerror2Args _ _ = error \"here\"\n\nnewtype ReaderT r a = ReaderT { runReaderT :: r -> IO a }\n\ninstance Functor (ReaderT r) where\n    fmap = undefined\n\ninstance Applicative (ReaderT r) where\n    pure    = liftReaderT . pure\n    f <*> v = undefined\n\ninstance Monad (ReaderT r) where\n    return   = liftReaderT . return\n    m >>= k  = undefined\n    m >> k  = ReaderT $ \\r -> do runReaderT m r; runReaderT k r\n\nliftReaderT :: IO a -> ReaderT r a\nliftReaderT m = ReaderT (const m)\n\n{-# NOINLINE buggy #-}\nbuggy fun unit bool =\n    runReaderT (do\n        if bool then liftReaderT $ print () else pure ()\n        case fun unit of\n            True -> do\n                error2Args unit unit\n                pure ()\n            _ -> pure ()\n        ) () :: IO ()\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, TypeFamilies, GADTs, EmptyCase #-}\nmodule T10180 where\n\nnewtype Foo = Foo Int\n\ntype family Bar a\ntype instance Bar Int = Int\n\ntype family Baz a where\n  Baz Int = Int\n  Baz Char = Int\n\ndata a :~: b where\n  Refl :: a :~: a\n\nabsurd0 :: Int :~: Bool -> a\nabsurd0 x = case x of {}\n\nabsurd1 :: Foo :~: Bool -> a\nabsurd1 x = case x of {}\n\nabsurd2 :: Bar Int :~: Bool -> a\nabsurd2 x = case x of {}\n\nabsurd3 :: Baz a :~: Bool -> a\nabsurd3 x = case x of {}\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10181 where\n\n-- GHC 8.0 and previous wrongly eta-reduced this to\n--   t = t\n-- but GHC 8.2 does not; some kind of consequence of\n-- better simplification in the early stages.\n\nt a = t a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 #-}\n{-# OPTIONS_GHC -fno-warn-missing-methods #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n-- {-# OPTIONS_GHC -fno-spec-constr #-} -- Makes the problem go away.\n-- {-# OPTIONS_GHC -fspec-constr-count=1 #-} -- Makes the problem go away.\n\nmodule T10602 where\n\n-- Copy-pasting T10602b.hs into the current module makes the problem go away.\nimport T10602b\n\ndata PairS a = PairS a a\n\n-- Removing the '~' makes the problem go away.\n(PairS _ _) >> ~(PairS b g) = PairS b g\n\nclass Binary t where\n    put :: t -> PairS ()\n\n-- Not using a newtype makes the problem go away.\nnewtype A a = A [a]\n\ninstance Binary a => Binary (A a) where\n    put (A xs) = case splitAt 254 xs of\n        (_, []) -> foldr (>>) (PairS () ()) (map put xs)\n        (_, b)  -> put (A b)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 #-}\n{-# LANGUAGE NoImplicitPrelude #-}\nmodule T10602b (splitAt, map, foldr) where\n\nimport GHC.Classes\nimport GHC.Types\nimport GHC.Num\nimport GHC.Base\n\nsplitAt                :: Int -> [a] -> ([a],[a])\nsplitAt n ls\n  | n <= 0 = ([], ls)\n  | otherwise          = splitAt' n ls\n    where\n        splitAt' :: Int -> [a] -> ([a], [a])\n        splitAt' _  []     = ([], [])\n        splitAt' 1  (x:xs) = ([x], xs)\n        splitAt' m  (x:xs) = (x:xs', xs'')\n          where\n            (xs', xs'') = splitAt' (m - 1) xs\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Made GHC 6.10.2 go into a loop in substRecBndrs\n{-# OPTIONS_GHC -w #-}\n\nmodule T10627 where\n\nimport Data.Word\n\nclass C a where\n    splitFraction    :: a -> (b,a)\n\nroundSimple :: (C a) => a -> b\nroundSimple x = error \"rik\"\n\n{-# RULES\n     \"rs\"  roundSimple = (fromIntegral :: Int -> Word) . roundSimple;\n  #-}\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10694 where\n\nf :: Eq a => a -> Bool\n{-# NOINLINE f #-}\nf x = x==x\n\ntype Foo a b = b\n\n{-# RULES \"foo\" forall (x :: Foo a Char). f x = True #-}\n\nfinkle = f 'c'\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators\n           , DataKinds\n           , PolyKinds\n           , TypeFamilies\n           , GADTs\n           , UndecidableInstances\n           , RankNTypes\n           , ScopedTypeVariables\n  #-}\n\n{-# OPTIONS_GHC -Wall #-}\n{-# OPTIONS_GHC -Werror #-}\n{-# OPTIONS_GHC -O1 -fspec-constr #-}\n\n{-\nghc-stage2: panic! (the 'impossible' happened)\n  (GHC version 7.11.20150723 for x86_64-unknown-linux):\n        Template variable unbound in rewrite rule\n-}\n\nmodule List (sFoldr1) where\n\ndata Proxy t\n\ndata family Sing (a :: k)\n\ndata TyFun (a :: *) (b :: *)\n\ntype family Apply (f :: TyFun k1 k2 -> *) (x :: k1) :: k2\n\ndata instance Sing (f :: TyFun k1 k2 -> *) =\n  SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) }\n\ntype SingFunction1 f = forall t. Sing t -> Sing (Apply f t)\n\ntype SingFunction2 f = forall t. Sing t -> SingFunction1 (Apply f t)\nsingFun2 :: Proxy f -> SingFunction2 f -> Sing f\nsingFun2 _ f = SLambda (\\x -> SLambda (f x))\n\ndata (:$$) (j :: a) (i :: TyFun [a] [a])\ntype instance Apply ((:$$) j) i = (:) j i\n\ndata (:$) (l :: TyFun a (TyFun [a] [a] -> *))\ntype instance Apply (:$) l = (:$$) l\ndata instance Sing (z :: [a])\n  = z ~ '[] =>\n    SNil\n  | forall (m :: a)\n           (n :: [a]). z ~ (:) m n =>\n    SCons (Sing m) (Sing n)\n\ndata ErrorSym0 (t1 :: TyFun k1 k2)\n\ntype Let1627448493XsSym4 t_afee t_afef t_afeg t_afeh = Let1627448493Xs t_afee t_afef t_afeg t_afeh\n\ntype Let1627448493Xs f_afe9\n                     x_afea\n                     wild_1627448474_afeb\n                     wild_1627448476_afec =\n    Apply (Apply (:$) wild_1627448474_afeb) wild_1627448476_afec\ntype Foldr1Sym2 (t_afdY :: TyFun a_afdP (TyFun a_afdP a_afdP -> *)\n                           -> *)\n                (t_afdZ :: [a_afdP]) =\n    Foldr1 t_afdY t_afdZ\ndata Foldr1Sym1 (l_afe3 :: TyFun a_afdP (TyFun a_afdP a_afdP -> *)\n                           -> *)\n                (l_afe2 :: TyFun [a_afdP] a_afdP)\ntype instance Apply (Foldr1Sym1 l_afe3) l_afe2 = Foldr1Sym2 l_afe3 l_afe2\n\ndata Foldr1Sym0 (l_afe0 :: TyFun (TyFun a_afdP (TyFun a_afdP a_afdP\n                                                -> *)\n                                  -> *) (TyFun [a_afdP] a_afdP -> *))\ntype instance Apply Foldr1Sym0 l = Foldr1Sym1 l\n\ntype family Foldr1 (a_afe5 :: TyFun a_afdP (TyFun a_afdP a_afdP\n                                            -> *)\n                              -> *)\n                   (a_afe6 :: [a_afdP]) :: a_afdP where\n  Foldr1 z_afe7 '[x_afe8] = x_afe8\n  Foldr1 f_afe9 ((:) x_afea ((:) wild_1627448474_afeb wild_1627448476_afec)) = Apply (Apply f_afe9 x_afea) (Apply (Apply Foldr1Sym0 f_afe9) (Let1627448493XsSym4 f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec))\n  Foldr1 z_afew '[] = Apply ErrorSym0 \"Data.Singletons.List.foldr1: empty list\"\n\nsFoldr1 ::\n  forall (x :: TyFun a_afdP (TyFun a_afdP a_afdP -> *) -> *)\n         (y :: [a_afdP]).\n  Sing x\n  -> Sing y -> Sing (Apply (Apply Foldr1Sym0 x) y)\nsFoldr1 _ (SCons _sX SNil) = undefined\nsFoldr1 sF (SCons sX (SCons sWild_1627448474 sWild_1627448476))\n  = let\n      lambda_afeC ::\n        forall f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec.\n        Sing f_afe9\n        -> Sing x_afea\n           -> Sing wild_1627448474_afeb\n              -> Sing wild_1627448476_afec\n                 -> Sing (Apply (Apply Foldr1Sym0 f_afe9) (Apply (Apply (:$) x_afea) (Apply (Apply (:$) wild_1627448474_afeb) wild_1627448476_afec)))\n      lambda_afeC f_afeD x_afeE wild_1627448474_afeF wild_1627448476_afeG\n        = let\n            sXs ::\n              Sing (Let1627448493XsSym4 f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec)\n            sXs\n              = applySing\n                  (applySing\n                     (singFun2 (undefined :: Proxy (:$)) SCons) wild_1627448474_afeF)\n                  wild_1627448476_afeG\n          in\n            applySing\n              (applySing f_afeD x_afeE)\n              (applySing\n                 (applySing (singFun2 (undefined :: Proxy Foldr1Sym0) sFoldr1) f_afeD)\n                 sXs)\n    in lambda_afeC sF sX sWild_1627448474 sWild_1627448476\nsFoldr1 _ SNil = undefined\n", "num_lines": 115}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O -fno-full-laziness #-}\nmodule T11155 where\n\nfoo :: Bool\n{-# NOINLINE foo #-}\nfoo = error \"rk\"\n\nbar x = let t :: Char\n            t = case foo of { True -> 'v'; False -> 'y' }\n        in [t]\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11232 where\n\nimport Control.Monad\nimport Data.Data\n\nmkMp :: ( MonadPlus m\n        , Typeable a\n        , Typeable b\n        )\n     => (b -> m b)\n     -> a\n     -> m a\nmkMp ext = unM (maybe (M (const mzero)) id (gcast (M ext)))\n\nnewtype M m x = M { unM :: x -> m x }\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11272 where\n\nimport T11272a as A\nimport Control.Monad.Trans.State\n\nspecialised :: Int -> Int -> ()\nspecialised x y = execState (A.overloaded x y) ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11272a where\n\nimport Control.Monad.Trans.State\nimport Control.Monad\n\noverloaded :: Ord a => a -> a -> State () ()\noverloaded x y = do\n  () <- get\n  when (x <= y) (overloaded y x)\n{-# INLINABLE overloaded #-}\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\n\n-- Produces a Lint error in GHC 8.0\n\nmodule T11444 where\nimport GHC.Exts (reallyUnsafePtrEquality#, Int (..))\n\nptrEq :: a -> a -> Bool\nptrEq !x !y = I# (reallyUnsafePtrEquality# x y) == 1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE Rank2Types #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n\n-- Trac #11562 reported an ASSERT error\n-- It only showed up /without/ -O, and obviously\n-- with a compiler built with -DDEBUG\n\nmodule T11562 where\n\nimport Data.Kind\n\nclass Category (cat :: k -> k -> Type) where\n  id :: cat a a\n  (.) :: cat b c -> cat a b -> cat a c\n\ndata Dict :: Constraint -> Type where\n  Dict :: a => Dict a\n\nnewtype C2D a b = Sub (a => Dict b)\n\ninstance Category C2D where\n  id  = Sub Dict\n  f . g = Sub (sub (sub Dict f) g)\n\nsub :: a => (b => r) -> (C2D a b) -> r\nsub r (Sub Dict) = r\n\n{-\n$ inplace/bin/ghc-stage2 -fforce-recomp -c C.hs -O0\n\nWARNING: file compiler/stgSyn/CoreToStg.hs, line 250\n  $fCategoryConstraint:- True False\n-}\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ScopedTypeVariables#-}\n\nmodule T11644 where\n\nimport Data.Kind (Type)\n\nclass Foo m where\n    type Bar m :: Type\n    action :: m -> Bar m -> m\n\nright x m = action m (Right x)\n\nright' :: (Either a b ~ Bar m, Foo m) => b -> m -> m\nright' x m = action m (Right x)\n\ninstance Foo Int where\n    type Bar Int = Either Int Int\n    action m a = either (*) (+) a m\n\ninstance Foo Float where\n    type Bar Float = Either Float Float\n    action m a = either (*) (+) a m\n\nfoo = print $ right (1::Int) (3 :: Int)\nbar = print $ right (1::Float) (3 :: Float)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Strict #-}\n\nmodule Foo where\n\ndata Foo = Foo\n\ninstance Eq Foo where\n  (==) Foo Foo = True\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import T12076a\nmain = f `seq` return ()\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O0 #-}\nmodule T12076a(f) where\n\nimport GHC.Exts\n\n{-# NOINLINE z #-}\nz = ()\n\nf :: () -> ()\nf _ = let x = lazy z\n      in g x x\n\n{-# NOINLINE g #-}\ng :: () -> () -> ()\ng _ _ = ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, MagicHash #-}\nmodule T12076lit where\n\n-- This test-case demonstrates that cpeApp's collect_args can\n-- be invoked on a literal\n\nimport Foreign.C\nimport Foreign\nimport GHC.Exts\n\nmain = do let y = Ptr \"LOL\"#\n          x <- strlen y\n          x2 <- strlen y -- don't inline y\n          case (x,x2) of\n            (3,3) -> putStrLn \"Yes\"\n            _ -> putStrLn \"No\"\n\nforeign import ccall unsafe \"strlen\"\n  strlen :: Ptr a -> IO Int\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T12076sat where\n\n-- This test demonstrates that we need to saturate\n-- primops even when they don't occur in function position.\n\nimport GHC.Exts\n\nf = I# (dataToTag# timesWord#)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T12212 where\n\ntype family F a\ntype instance F Int = Int\n\nfoo :: a -> F a\n{-# NOINLINE foo #-}\nfoo = undefined\n\n-- Inferred type\n-- forall a b. (Num a, F a ~# F b) => a -> b -> [F a]\nf x y = [ foo x, foo y ] ++ f (x-1) y\n\n-- Specialised call to f @ Int @ Int dNumInt <F Int ~ F Int>\ng = f (3::Int) (4::Int)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12600 where\n\n-- We don't want to see any dictionary-passing in foo. Everything\n-- should be inlined or specialized away.\n\nclass Eq1 f where\n  eq1 :: Eq a => f a -> f a -> Bool\n\ndata F a = F !a !a\ndata G f a = G !(f a) !(f a)\n\ninstance Eq1 F where\n  eq1 = \\(F a b) (F c d) ->\n    -- In order to reproduce the problem, the body of this function needs to be\n    -- large enough to prevent GHC from voluntarily inlining it.\n    larger $ larger $ larger $ larger $ larger $ larger $\n      a == c && b == d\n  {-# INLINE eq1 #-}\n\nlarger :: a -> a\nlarger = id\n{-# NOINLINE larger #-}\n\ninstance (Eq1 f) => Eq1 (G f) where\n  eq1 = \\(G a b) (G c d) -> eq1 a c && eq1 b d\n  {-# INLINE eq1 #-}\n\nfoo :: G F Int -> G F Int -> Bool\nfoo a b = eq1 a b\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- ghc --make Main.hs -O1; ./Main +RTS -s -RTS\n\n-- The point here is that we want to see a top-level\n-- definition like\n--\n-- lvl_r5ao :: Int\n-- lvl_r5ao = case GHC.Real.$wf1 2# 8# of v_B2\n--              { __DEFAULT -> GHC.Types.I# v_B2 }\n--\n-- with the constant (2^8) being floated to top level\n\n{-# LANGUAGE MagicHash #-}\n\nmodule Main( main ) where\n\nimport GHC.Exts\n\ndata Attr = Attr !Int  --- the bang is essential\n\nattrFromInt :: Int -> Attr\n{-# NOINLINE attrFromInt #-}\nattrFromInt w = Attr (w + (2 ^ (8 :: Int)))\n\nfgFromInt :: Int -> Int\n{-# INLINE fgFromInt #-}  -- removing this INLINE makes it many times faster\n                          -- just like the manually inlined version\n                          -- and NOINLINE lands in between\nfgFromInt w = w + (2 ^ (8 :: Int))\n\nattrFromIntINLINE :: Int -> Attr\n{-# NOINLINE attrFromIntINLINE #-}\nattrFromIntINLINE w = Attr (fgFromInt w)\n\nseqFrame2 :: [Int] -> IO ()\n{-# NOINLINE seqFrame2 #-}\nseqFrame2 l = do\n  -- let crux = attrFromInt\n  --   Total   time    2.052s  (  2.072s elapsed)\n  -- but the following version is many times slower:\n  let crux = attrFromIntINLINE\n  --   Total   time    7.896s  (  7.929s elapsed)\n  mapM_ (\\a -> crux a `seq` return ()) l\n\nmain :: IO ()\nmain = seqFrame2 $ replicate 100000000 0\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 #-}\n\n-- This made the simplifier loop doing infinite inlining\n-- in GHC 8.0\n\nmodule T12776(distinct_degree_factorization_i) where\n\nimport Prelude ((==), Eq);\n\ndata Slist a = Nil_s | Cons_s a (Slist a) deriving Eq;\n\nmap_s :: (a -> b) -> Slist a -> Slist b;\nmap_s f (Cons_s x21 x22) = Cons_s (f x21) (map_s f x22);\n\nnormalize_poly_i :: (Eq a) => (a -> a) -> Slist a -> Slist a;\nnormalize_poly_i ops xs = if ops (lead_coeff_i xs) == lead_coeff_i xs then Nil_s else map_s ops xs;\n\nmod_poly_one_main_i :: (Eq a) => (a -> a) -> Slist a -> Slist a;\nmod_poly_one_main_i ops d =\n  if d == d then d else mod_poly_one_main_i ops (normalize_poly_i ops d);\n\nlast_s :: (Eq a) => Slist a -> a;\nlast_s (Cons_s x xs) = (if xs == Nil_s then x else last_s xs);\n\nmod_field_poly_i :: (Eq a) => (a -> a) -> Slist a -> Slist a;\nmod_field_poly_i ops cf =\n  (if cf == cf then cf else\n     mod_poly_one_main_i ops (map_s (\\_ -> ops (last_s cf)) cf));\n\nlead_coeff_i :: Eq a => Slist a -> a;\nlead_coeff_i pp = (case pp of {\n                        Cons_s _ _ -> last_s pp;\n                      });\n\ndist_degree_factorize_main_i :: Eq a => (a -> a) -> Slist a -> [Slist a] -> [Slist a];\ndist_degree_factorize_main_i ff_ops w res =\n  if w == w then res\n           else dist_degree_factorize_main_i ff_ops (mod_field_poly_i ff_ops w)\n                   [normalize_poly_i ff_ops (mod_field_poly_i ff_ops w)];\n\ndistinct_degree_factorization_i :: Eq a => (a -> a) -> [Slist a];\ndistinct_degree_factorization_i ff_ops = dist_degree_factorize_main_i ff_ops Nil_s []\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug where\n-- This ugly cascading case reduces to:\n--    case x of\n--       0 -> \"0\"\n--       1 -> \"1\"\n--       _ -> \"n\"\n--\n-- but only if GHC's case-folding reduction kicks in.\n\n{-# NOINLINE test #-}\ntest :: Word -> String\ntest x = case x of\n   0  -> \"0\"\n   1  -> \"1\"\n   t  -> case t + 1 of\n      1 -> \"0\"\n      2 -> \"1\"\n      t  -> case t + 1 of\n         2 -> \"0\"\n         3 -> \"1\"\n         t  -> case t + 1 of\n            3 -> \"0\"\n            4 -> \"1\"\n            t  -> case t + 1 of\n               4 -> \"0\"\n               5 -> \"1\"\n               t  -> case t + 1 of\n                  5 -> \"0\"\n                  6 -> \"1\"\n                  t  -> case t + 1 of\n                     6 -> \"0\"\n                     7 -> \"1\"\n                     t  -> case t + 1 of\n                        7 -> \"0\"\n                        8 -> \"1\"\n                        t  -> case t + 1 of\n                           8 -> \"0\"\n                           9 -> \"1\"\n                           t  -> case t + 1 of\n                              10 -> \"0\"\n                              11 -> \"1\"\n                              t  -> case t + 1 of\n                                 11 -> \"0\"\n                                 12 -> \"1\"\n                                 t  -> case t + 1 of\n                                    12 -> \"0\"\n                                    13 -> \"1\"\n                                    t  -> case t + 1 of\n                                       13 -> \"0\"\n                                       14 -> \"1\"\n                                       t  -> case t + 1 of\n                                          14 -> \"0\"\n                                          15 -> \"1\"\n                                          t  -> case t + 1 of\n                                             15 -> \"0\"\n                                             16 -> \"1\"\n                                             t  -> case t + 1 of\n                                                16 -> \"0\"\n                                                17 -> \"1\"\n                                                t  -> case t + 1 of\n                                                   17 -> \"0\"\n                                                   18 -> \"1\"\n                                                   t  -> case t + 1 of\n                                                      18 -> \"0\"\n                                                      19 -> \"1\"\n                                                      t  -> case t + 1 of\n                                                         19 -> \"0\"\n                                                         20 -> \"1\"\n                                                         t  -> case t + 1 of\n                                                            20 -> \"0\"\n                                                            21 -> \"1\"\n                                                            t  -> case t + 1 of\n                                                               21 -> \"0\"\n                                                               22 -> \"1\"\n                                                               t  -> case t + 1 of\n                                                                  22 -> \"0\"\n                                                                  23 -> \"1\"\n                                                                  t  -> case t + 1 of\n                                                                     23 -> \"0\"\n                                                                     24 -> \"1\"\n                                                                     t  -> case t + 1 of\n                                                                        24 -> \"0\"\n                                                                        25 -> \"1\"\n                                                                        t  -> case t + 1 of\n                                                                           25 -> \"0\"\n                                                                           26 -> \"1\"\n                                                                           t  -> case t + 1 of\n                                                                              26 -> \"0\"\n                                                                              27 -> \"1\"\n                                                                              t  -> case t + 1 of\n                                                                                 27 -> \"0\"\n                                                                                 28 -> \"1\"\n                                                                                 t  -> case t + 1 of\n                                                                                    28 -> \"0\"\n                                                                                    29 -> \"1\"\n                                                                                    t  -> case t + 1 of\n                                                                                       29 -> \"0\"\n                                                                                       30 -> \"1\"\n                                                                                       t  -> case t + 1 of\n                                                                                          30 -> \"0\"\n                                                                                          31 -> \"1\"\n                                                                                          t  -> case t + 1 of\n                                                                                             31 -> \"0\"\n                                                                                             32 -> \"1\"\n                                                                                             t  -> case t + 1 of\n                                                                                                32 -> \"0\"\n                                                                                                33 -> \"1\"\n                                                                                                t  -> case t + 1 of\n                                                                                                   33 -> \"0\"\n                                                                                                   34 -> \"1\"\n                                                                                                   t  -> case t + 1 of\n                                                                                                      34 -> \"0\"\n                                                                                                      35 -> \"1\"\n                                                                                                      _  -> \"n\"\n", "num_lines": 115}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\nmodule T13025 where\nimport T13025a\n\ntype MyRec = Rec '[ '(\"A\",Int), '(\"B\",Int), '(\"C\",Int) ]\n\ngetC :: MyRec -> Int\ngetC = getField (Proxy::Proxy '(\"C\",Int))\n\ndoubleC :: MyRec -> MyRec\ndoubleC r = setC (2 * (getC r)) r\n  where setC = set . (Field :: Int -> Field '(\"C\",Int))\n\nmain :: IO ()\nmain = print (getC (Field 1 :& Field 2 :& Field 3 :& Nil :: MyRec))\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts,\n             FlexibleInstances, GADTs, MultiParamTypeClasses,\n             PolyKinds, ScopedTypeVariables, TypeFamilies,\n             TypeOperators #-}\nmodule T13025a where\n\nimport Data.Kind (Type)\n\ndata Nat = Z | S Nat\ndata Proxy a = Proxy\n\ndata Field :: (k,Type) -> Type where\n  Field :: a -> Field '(s,a)\n\ntype family Index r rs :: Nat where\n  Index r (r ': rs) = 'Z\n  Index r (s ': rs) = 'S (Index r rs)\n\ndata Rec (rs :: [ (k,Type) ]) where\n  Nil :: Rec '[]\n  (:&) :: Field r -> Rec rs -> Rec (r ': rs)\ninfixr 5 :&\n\nclass Index r rs ~ i => HasField r rs i where\n  get :: proxy r -> Rec rs -> Field r\n  set :: Field r -> Rec rs -> Rec rs\n\ninstance HasField r (r ': rs) 'Z where\n  get _ (x :& _) = x\n  set x (_ :& xs) = x :& xs\n\ninstance (HasField r rs i, Index r (s ': rs) ~ 'S i)\n         => HasField r (s ': rs) ('S i) where\n  get p (_ :& xs) = get p xs\n  set x' (x :& xs) = x :& set x' xs\n\ntype Has r rs = HasField r rs (Index r rs)\n\ngetField :: Has '(s,a) rs => proxy '(s,a) -> Rec rs -> a\ngetField p = aux . get p\n  where aux :: Field '(s,a) -> a\n        aux (Field x) = x\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE MagicHash #-}\nmodule T13027 (insert) where\n\nimport GHC.Exts (isTrue#, reallyUnsafePtrEquality#)\n\ndata Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a)\n           | Tip\n\ntype Size = Int\n\ninsert :: Ord a => a -> Set a -> Set a\ninsert = go\n  where\n    go :: Ord a => a -> Set a -> Set a\n    go !x Tip = Bin 1 x Tip Tip\n    go !x t@(Bin sz y l r) = case compare x y of\n        LT | l' `ptrEq` l -> t\n           | otherwise -> undefined -- balanceL y l' r\n           where !l' = go x l\n        GT | r' `ptrEq` r -> t\n           | otherwise -> undefined -- balanceR y l r'\n           where !r' = go x r\n        EQ | x `ptrEq` y -> t\n           | otherwise -> Bin sz x l r\n{-# INLINABLE insert #-}\n\nptrEq :: a -> a -> Bool\nptrEq x y = isTrue# (reallyUnsafePtrEquality# x y)\n{-# INLINE ptrEq #-}\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13143 where\n\n{-# NOINLINE f #-}\nf :: Int -> a\nf x = f x\n\ng :: Bool -> Bool -> Int -> Int\ng True  True  p = f p\ng False True  p = p + 1\ng b     False p = g b True p\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n{-# OPTIONS_GHC -funfolding-use-threshold=10 #-}\n\nmodule T13155 where\n\nimport GHC.Ptr\nimport GHC.Prim\nimport GHC.Exts\n\nfoo :: Ptr Float -> State# RealWorld -> (# State# RealWorld, Float #)\nfoo p s = case q :: Ptr Float of { Ptr a1 ->\n          case readFloatOffAddr# a1 0# s of { (# s1, f1 #) ->\n          case q :: Ptr Float of { Ptr a2 ->\n          case readFloatOffAddr# a2 1# s of { (# s2, f2 #) ->\n          (# s2, F# (plusFloat# f1 f2) #) }}}}\n  where\n    q :: Ptr a  -- Polymorphic\n    q = p `plusPtr` 4\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13156 where\n\nf g x = let r :: [a] -> [a]\n            r = case g x of True -> reverse . reverse\n                            False -> reverse\n        in\n        r `seq` r `seq` r\n\n\n{- Expected -ddump-prep looks like this.\n   (Case-of-type-lambda an oddity of Core Prep.)\n\n-- RHS size: {terms: 9, types: 9, coercions: 0, joins: 0/0}\nT13156.f1 :: forall a. [a] -> [a]\n[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>, Unf=OtherCon []]\nT13156.f1 =\n  \\ (@ a) (x [Occ=Once] :: [a]) ->\n    case GHC.List.reverse @ a x of sat { __DEFAULT ->\n    GHC.List.reverse1 @ a sat (GHC.Types.[] @ a)\n    }\n\n-- RHS size: {terms: 17, types: 28, coercions: 0, joins: 0/0}\nT13156.f\n  :: forall p.\n     (p -> GHC.Types.Bool) -> p -> [GHC.Types.Int] -> [GHC.Types.Int]\n[GblId,\n Arity=2,\n Caf=NoCafRefs,\n Str=<C(S),1*C1(U)><L,U>,\n Unf=OtherCon []]\nT13156.f =\n  \\ (@ p)\n    (g [Occ=Once!] :: p -> GHC.Types.Bool)\n    (x [Occ=Once] :: p) ->\n    case \\ (@ a) ->\n           case g x of {\n             GHC.Types.False -> GHC.List.reverse @ a;\n             GHC.Types.True -> T13156.f1 @ a\n           }\n    of r [Dmd=<S,U>]\n    { __DEFAULT ->\n    case r @ GHC.Types.Any of { __DEFAULT -> r @ GHC.Types.Int }\n    }\n\n-}\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13170 where\nf :: Int -> Bool\nf x = y == 2 || y == 3\n  where y = -x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T13317 where\n\nimport GHC.Base\n\nf x = let x = \"foo\"#\n          y1 = unpackCString# x\n          y2 = unpackCString# x\n      in\n      (y1, case y2 of\n              'f' : _ -> True\n              _       -> False\n      )\n-- This case-expression should simplify\n-- yielding a KnownBranch simplifier tick\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T13338 where\n\nimport GHC.Exts\n\nmagic# :: Int# -> Bool\nmagic# x# = True\n{-# NOINLINE magic# #-}\n\nf :: Int# -> Int -> Int\nf x# n = length [ i | i@(I# i#) <- [0..n], magic# (remInt# x# 100000# -# i#) ]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Hi where\n\n-- These two should be de-duplicated by CSE\nf, g :: Int -> Int\nf x = 2 + x\ng x = 2 + x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T13367( z ) where\nimport GHC.Exts\ndata T = MkT Addr#\n\nx = MkT \"foo\"#\ny = MkT \"foo\"#\n\nz = (x,y)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Data.Vector.Hybrid.Internal (Vector) where\n\nimport Control.Monad (liftM2)\nimport Data.Functor.Identity (Identity(..))\nimport GHC.ST (ST, runST)\nimport Text.Read (ReadPrec, readPrec)\nimport Data.Kind (Type)\n\n-----\n\nclass Monad m => PrimMonad m where\n  type PrimState m\n\ninstance PrimMonad (ST s) where\n  type PrimState (ST s) = s\n\nclass GMVector v a where\n  gmbasicLength      :: v s a -> Int\n  gmbasicUnsafeSlice :: Int -> Int -> v s a -> v s a\n  gmbasicUnsafeNew   :: PrimMonad m => Int -> m (v (PrimState m) a)\n  gmbasicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()\n\ntype family GMutable (v :: Type -> Type) :: Type -> Type -> Type\n\nclass GMVector (GMutable v) a => GVector v a where\n  gbasicUnsafeFreeze :: PrimMonad m => GMutable v (PrimState m) a -> m (v a)\n\ndata Step s a where\n  Yield :: a -> s -> Step s a\n\ninstance Functor (Step s) where\n  {-# INLINE fmap #-}\n  fmap f (Yield x s) = Yield (f x) s\n\ndata Stream m a = forall s. Stream (s -> m (Step s a)) s\ndata Chunk v a = Chunk Int (forall m. (PrimMonad m, GVector v a) => GMutable v (PrimState m) a -> m ())\ndata New v a = New { newrun :: forall s. ST s (GMutable v s a) }\ntype MBundle m v a = Stream m (Chunk v a)\ntype Bundle v a = MBundle Identity v a\n\nmbfromStream :: Monad m => Stream m a -> MBundle m v a\n{-# INLINE mbfromStream #-}\nmbfromStream (Stream step t) = Stream step' t\n  where\n    step' s = do r <- step s\n                 return $ fmap (\\x -> Chunk 1 (\\v -> gmbasicUnsafeWrite v 0 x)) r\n\nmbunsafeFromList :: Monad m => [a] -> MBundle m v a\n{-# INLINE [1] mbunsafeFromList #-}\nmbunsafeFromList xs = mbfromStream (sfromList xs)\n\nblift :: Monad m => Bundle v a -> MBundle m v a\n{-# INLINE [1] blift #-}\nblift (Stream vstep t) = Stream (return . runIdentity . vstep) t\n\nsfromList :: Monad m => [a] -> Stream m a\n{-# INLINE sfromList #-}\nsfromList zs = Stream step zs\n  where\n    step (x:xs) = return (Yield x xs)\n    step _ = undefined\n\nsfoldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a\n{-# INLINE [1] sfoldlM #-}\nsfoldlM m w (Stream step t) = foldlM_loop w t\n  where\n    foldlM_loop z s\n      = do\n          r <- step s\n          case r of\n            Yield x s' -> do { z' <- m z x; foldlM_loop z' s' }\n\ngmvunstream :: (PrimMonad m, GVector v a)\n            => Bundle v a -> m (GMutable v (PrimState m) a)\n{-# INLINE [1] gmvunstream #-}\ngmvunstream s = gmvmunstreamUnknown (blift s)\n\ngmvmunstreamUnknown :: (PrimMonad m, GVector v a)\n                    => MBundle m v a -> m (GMutable v (PrimState m) a)\n{-# INLINE gmvmunstreamUnknown #-}\ngmvmunstreamUnknown s\n  = do\n      v <- gmbasicUnsafeNew 0\n      (_, _) <- sfoldlM copyChunk (v,0) s\n      return undefined\n  where\n    {-# INLINE [0] copyChunk #-}\n    copyChunk (v,i) (Chunk n f)\n      = do\n          let j = i+n\n          v' <- if gmbasicLength v < j\n                  then gmbasicUnsafeNew undefined\n                  else return v\n          f (gmbasicUnsafeSlice i n v')\n          return (v',j)\n\nnewunstream :: GVector v a => Bundle v a -> New v a\n{-# INLINE [1] newunstream #-}\nnewunstream s = s `seq` New (gmvunstream s)\n\ngnew :: GVector v a => New v a -> v a\n{-# INLINE [1] gnew #-}\ngnew m = m `seq` runST (gbasicUnsafeFreeze =<< newrun m)\n\ngunstream :: GVector v a => Bundle v a -> v a\n{-# INLINE gunstream #-}\ngunstream s = gnew (newunstream s)\n\ngfromList :: GVector v a => [a] -> v a\n{-# INLINE gfromList #-}\ngfromList = gunstream . mbunsafeFromList\n\ngreadPrec :: (GVector v a, Read a) => ReadPrec (v a)\n{-# INLINE greadPrec #-}\ngreadPrec = do\n  xs <- readPrec\n  return (gfromList xs)\n\n-----\n\ndata MVector :: (Type -> Type -> Type) ->\n                (Type -> Type -> Type) ->\n                (Type -> Type -> Type) where\n  MV :: !(u s a) -> !(v s b) -> MVector u v s (a, b)\n\ninstance (GMVector u a, GMVector v b) => GMVector (MVector u v) (a, b) where\n  gmbasicLength (MV ks _) = gmbasicLength ks\n  gmbasicUnsafeSlice s e (MV ks vs) = MV (gmbasicUnsafeSlice s e ks) (gmbasicUnsafeSlice s e vs)\n\n  gmbasicUnsafeNew n = liftM2 MV (gmbasicUnsafeNew n) (gmbasicUnsafeNew n)\n  -- Removing this INLINE pragma makes it compile\n  {-# INLINE gmbasicUnsafeNew #-}\n\n  gmbasicUnsafeWrite (MV ks vs) n (k,v) = do\n    gmbasicUnsafeWrite ks n k\n    gmbasicUnsafeWrite vs n v\n\ndata Vector :: (Type -> Type) -> (Type -> Type) -> Type -> Type\n\ntype instance GMutable (Vector u v) = MVector (GMutable u) (GMutable v)\n\ninstance (GVector u a, GVector v b) => GVector (Vector u v) (a, b) where\n  gbasicUnsafeFreeze = undefined\n\ninstance (GVector u a, GVector v b, Read a, Read b, c ~ (a, b)) => Read (Vector u v c) where\n  readPrec = greadPrec\n", "num_lines": 156}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T13413 where\n\nimport GHC.Exts\n\nfillBlock2 :: (Int# -> Int# -> IO ())\n           -> Int# -> Int# -> IO ()\n\nfillBlock2 write x0 y0\n = fillBlock y0 x0\n where\n   {-# INLINE fillBlock #-}\n   fillBlock y ix\n         | 1# <- y >=# y0\n         = return ()\n         | otherwise\n         = do   write ix x0\n                fillBlock (y +# 1#) ix\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13417 where\n\n-- Amazingly this crashed GHC 8.0.2\n\ndata T a = E7\n\ncons7 :: T a -> T b\ncons7 E7 = E7\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase, EmptyDataDecls, TypeFamilies #-}\n\nmodule T13468 where\n\nimport GHC.Generics\n\ndata Void\n\ninstance Generic Void where\n   type Rep Void = V1\n   from x = case x of\n   to x = case x of\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, GADTs #-}\n\nmodule Foo where\n\ng :: (Int, Int) -> Int\n{-# NOINLINE g #-}\ng (p,q) = p+q\n\nf :: Int -> Int -> Int -> Int\nf x p q\n  = g (let j y = (p,q)\n           {-# NOINLINE j #-}\n          in\n          case x of\n            2 -> j 3\n            _ -> j 4)\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE BangPatterns #-}\n\n{- # OPTIONS_GHC -Werror #-}\n{-# OPTIONS_GHC -g -O2 #-}\n\nmodule Bug (bug) where\n\n-- import GHC.Base (seq)\nimport Unsafe.Coerce (unsafeCoerce)\n\nundefined :: a\nundefined = undefined\n\ndata TypeRep (a :: k) where\n    TrTyCon :: TypeRep (a :: k)\n    TrApp   :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n               TypeRep (a b)\n\ndata SomeTypeRep where\n    SomeTypeRep :: forall k (a :: k).\n                   TypeRep a\n                -> SomeTypeRep\n\nmkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n           TypeRep (a :: k1 -> k2)\n        -> TypeRep (a b)\nmkTrApp TrTyCon = undefined\nmkTrApp TrApp   = undefined\n\nbug :: SomeTypeRep\n-- bug = f x -- this works\nbug = f (f x)\n  where x = SomeTypeRep TrTyCon\n        f :: SomeTypeRep -> SomeTypeRep\n        f (SomeTypeRep acc) = SomeTypeRep (mkTrApp (unsafeCoerce acc))\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O -fmax-simplifier-iterations=0 #-}\n\n-- Not running the simplifier leads to type-lets persisting longer\n\nmodule T13708 where\n\nindexOr :: a -> Int -> [a] -> a\nindexOr fallback idx xs =\n  if (idx < length xs)\n  then xs !! idx\n  else fallback\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase, GADTs #-}\n\nmodule T13990 where\n\ndata T a where\n  TInt :: T Int\n\nabsurd :: T Bool -> a\nabsurd v = case v of {}\n\ndata Foo = Foo !(T Bool)\n\nabsurdFoo :: Foo -> a\nabsurdFoo (Foo x) = absurd x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14137 where\n\n-- The point of this test is that we should inline 'thunk'\n-- into j's RHS, and we can do so quite aggressively, even\n-- when we aren't optimising. See the ticket.\n--\n-- It's not a big deal, because in the end FloatIn\n-- does the same job, only later\n\nf xs = let thunk = length xs\n           j = Just thunk\n           g 0 = j\n           g n = g (n-1)\n       in\n       g 7\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- We don't want to see a case match on the result\n-- of dataToTag#. We check that by looking for case\n-- matches on any literal other than 0# or 1#. We\n-- only really expect to see 1# here (and not the tag\n-- for OtherOS), but just in case GHC decides to get\n-- clever with its knowledge of the possible results\n-- of (==#), we also permit 0#.\n{-# LANGUAGE MagicHash, BangPatterns #-}\nmodule T14140 where\nimport GHC.Exts\n\ndata OS = Linux | Windows | OSX        -- tier 1 desktop OSs\n        | FreeBSD | OpenBSD | NetBSD   -- other free Unix OSs\n        | DragonFly\n        | Solaris | AIX | HPUX | IRIX  -- ageing Unix OSs\n        | HaLVM                        -- bare metal / VMs / hypervisors\n        | Hurd                         -- GNU's microkernel\n        | IOS  | Android               -- mobile OSs\n        | Ghcjs\n        | OtherOS String\n\n-- This is similar to the derived Eq instance. We write it\n-- out manually to prevent future deriving changes from\n-- changing the test.\ninstance Eq OS where\n  OtherOS x == OtherOS y = x == y\n  (!x) == (!y) = case dataToTag# x ==# dataToTag# y of\n               1# -> True\n               _ -> False\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14152 where\n\n{-\nThis test case tests exitification. With exitification, the \"case thunk\" should\nbe lifted out of \"innerGo\", then \"thunk\" gets inlined, we have case-of-case and\ncase-of-known-constructor and the string \"dead code\" should disappear\n\nThe test case T14152b uses the same file, but with -fno-exitification, and checks\nthat the strings \"dead code\" is still present. If not, then some other optimization\ndoes the job now (great!), but then we need to come up with a better test case\nfor exitification (or get rid of it).\n-}\n\ngo 0 y = y\ngo n y = innerGo n y\n  where\n    innerGo 10 y = 0 -- we want to be lazy in thunk\n    innerGo 0 y = case thunk of\n        Nothing -> error \"dead code\"\n        Just y' -> go (n-1) (y + y')\n    innerGo n y = innerGo (n-1) (y*y)\n\n    thunk = if y==0 then Just (y + y) else Just y\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14186 where\n\nfoo f g (x, xs) = (f (g x), map (f . g) xs)\nbar f g (x, xs) = (f (g x), map (f . g) xs)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, ScopedTypeVariables, GADTs, RankNTypes,\n             PolyKinds, KindSignatures #-}\n{-# OPTIONS_GHC -O2 #-} -- We are provoking a bug in SpecConstr\n\nmodule T14270a where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata T a = T1 (T a) | T2\n\ndata K (a :: k) where\n  K1 :: K (a :: Type)\n  K2 :: K a\n\nf :: T (a :: Type) -> Bool\nf (T1 x) = f x\nf T2     = True\n\ng :: forall k (a :: k). K a -> T a -> Bool\ng kv x = case kv of\n            K1 -> f @a T2   -- f @a (T1 x) gives a different crash\n            k2 -> True\n\n-- The point here is that the call to f looks like\n--    f @(a |> co) (T2 @(a |> co))\n-- where 'co' is bound by the pattern match on K1\n-- See Note [SpecConstr and casts] in SpecConstr\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Bits (bit)\n\nmain :: IO ()\nmain = putStrLn (show (f undefined))\n\nf :: [Int] -> Int\nf = sum . zipWith ((+) . bit) [0..] . map undefined . scanl undefined undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MergeSort (\n  msortBy\n ) where\n\ninfixl 7 :%\ninfixr 6 :&\n\ndata LenList a = LL {-# UNPACK #-} !Int Bool [a]\n\ndata LenListAnd a b = {-# UNPACK #-} !(LenList a) :% b\n\ndata Stack a\n  = End\n  | {-# UNPACK #-} !(LenList a) :& (Stack a)\n\nmsortBy :: (a -> a -> Ordering) -> [a] -> [a]\nmsortBy cmp = mergeSplit End where\n  splitAsc n _ _ _ | n `seq` False = undefined\n  splitAsc n as _ [] = LL n True as :% []\n  splitAsc n as a bs@(b:bs') = case cmp a b of\n    GT -> LL n False as :% bs\n    _  -> splitAsc (n + 1) as b bs'\n\n  splitDesc n _ _ _ | n `seq` False = undefined\n  splitDesc n rs a [] = LL n True (a:rs) :% []\n  splitDesc n rs a bs@(b:bs') = case cmp a b of\n    GT -> splitDesc (n + 1) (a:rs) b bs'\n    _  -> LL n True (a:rs) :% bs\n\n  mergeLL (LL na fa as) (LL nb fb bs) = LL (na + nb) True $ mergeLs na as nb bs where\n    mergeLs nx  _ ny  _ | nx `seq` ny `seq` False = undefined\n    mergeLs  0  _ ny ys = if fb then ys else take ny ys\n    mergeLs  _ [] ny ys = if fb then ys else take ny ys\n    mergeLs nx xs  0  _ = if fa then xs else take nx xs\n    mergeLs nx xs  _ [] = if fa then xs else take nx xs\n    mergeLs nx xs@(x:xs') ny ys@(y:ys') = case cmp x y of\n      GT -> y:mergeLs nx xs (ny - 1) ys'\n      _  -> x:mergeLs (nx - 1) xs' ny ys\n\n  push ssx px@(LL nx _ _) = case ssx of\n    End -> px :% ssx\n    py@(LL ny _ _) :& ssy -> case ssy of\n      End\n        | nx >= ny -> mergeLL py px :% ssy\n      pz@(LL nz _ _) :& ssz\n        | nx >= ny || nx + ny >= nz -> case nx > nz of\n            False -> push ssy $ mergeLL py px\n            _     -> case push ssz $ mergeLL pz py of\n              pz' :% ssz' -> push (pz' :& ssz') px\n      _ -> px :% ssx\n\n  mergeAll _ px | px `seq` False = undefined\n  mergeAll ssx px@(LL nx _ xs) = case ssx of\n    End -> xs\n    py@(LL _ _ _) :& ssy -> case ssy of\n      End -> case mergeLL py px of\n        LL _ _ xys -> xys\n      pz@(LL nz _ _) :& ssz -> case nx > nz of\n        False -> mergeAll ssy $ mergeLL py px\n        _     -> case push ssz $ mergeLL pz py of\n          pz' :% ssz' -> mergeAll (pz' :& ssz') px\n\n  mergeSplit ss _ | ss `seq` False = undefined\n  mergeSplit ss [] = case ss of\n    End -> []\n    px :& ss' -> mergeAll ss' px\n  mergeSplit ss as@(a:as') = case as' of\n    [] -> mergeAll ss $ LL 1 True as\n    b:bs -> case cmp a b of\n      GT -> case splitDesc 2 [a] b bs of\n        px :% rs -> case push ss px of\n          px' :% ss' -> mergeSplit (px' :& ss') rs\n      _  -> case splitAsc 2 as b bs of\n        px :% rs -> case push ss px of\n          px' :% ss' -> mergeSplit (px' :& ss') rs\n  {-# INLINABLE mergeSplit #-}\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -g -O #-}\n{-# OPTIONS\n  -fno-strictness\n  -fno-case-merge\n  -fno-call-arity\n  -fno-case-folding\n  -fno-cse\n  -fno-do-eta-reduction\n  -fno-do-lambda-eta-expansion\n  -fno-float-in\n  -ffull-laziness\n  -fno-enable-rewrite-rules\n#-}\n-- This used to fail with:\n--\n-- *** Core Lint errors : in result of Simplifier ***\n-- <no location info>: warning:\n--     [RHS of str_sZr :: Addr#]\n--     Recursive or top-level binder has strict demand info: str_sZr\n--     Binder's demand info: <L,U>\nmodule T14779a where\n\nmkConstr :: String -> String\nmkConstr str = r\n  where\n    r = idx `seq` str\n    idx = eqS r str `seq` [r]\n\nconMkFixed :: String\nconMkFixed = mkConstr \"MkFixed\"\n\neqS :: String -> String -> Bool\neqS [] [] = True\neqS _ _ = False\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -g -O #-}\n-- This used to fail with:\n--\n-- *** Core Lint errors : in result of Simplifier ***\n-- <no location info>: warning:\n--     [RHS of str_s2UI :: Addr#]\n--     The type of this binder is unlifted: str_s2UI\n--     Binder's type: Addr#\n\nmodule T14779b where\n\ndata DataType = DataType\n                        { tycon   :: String\n                        , datarep :: DataRep\n                        }\n\ndata Constr = Constr\n                        { conrep    :: ConstrRep\n                        , constring :: String\n                        , confields :: [String] -- for AlgRep only\n                        , confixity :: Fixity   -- for AlgRep only\n                        , datatype  :: DataType\n                        }\n\ndata DataRep = AlgRep [Constr]\n             | IntRep\n             | FloatRep\n             | CharRep\n             | NoRep\n\ndata ConstrRep = AlgConstr    ConIndex\n               | IntConstr    Integer\n               | FloatConstr  Rational\n               | CharConstr   Char\n\ntype ConIndex = Int\n\n\n-- | Fixity of constructors\ndata Fixity = Prefix\n            | Infix     -- Later: add associativity and precedence\n\n\nmkDataType :: String -> [Constr] -> DataType\nmkDataType str cs = DataType\n                        { tycon   = str\n                        , datarep = AlgRep cs\n                        }\n\nmkConstr :: DataType -> String -> [String] -> Fixity -> Constr\nmkConstr dt str fields fix =\n        Constr\n                { conrep    = AlgConstr idx\n                , constring = str\n                , confields = fields\n                , confixity = fix\n                , datatype  = dt\n                }\n  where\n    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],\n                     showConstr c == str ]\n\ndataTypeConstrs :: DataType -> [Constr]\ndataTypeConstrs dt = case datarep dt of\n                        (AlgRep cons) -> cons\n                        _ -> errorWithoutStackTrace $\n                               \"Data.Data.dataTypeConstrs is not supported for \"\n                                    ++ dataTypeName dt ++\n                                    \", as it is not an algebraic data type.\"\ndataTypeName :: DataType -> String\ndataTypeName = tycon\n\nshowConstr :: Constr -> String\nshowConstr = constring\n\n-- | The type parameter should be an instance of 'HasResolution'.\nnewtype Fixed a = MkFixed Integer -- ^ @since 4.7.0.0\n        deriving (Eq,Ord)\n\ntyFixed :: DataType\ntyFixed = mkDataType \"Data.Fixed.Fixed\" [conMkFixed]\nconMkFixed :: Constr\nconMkFixed = mkConstr tyFixed \"MkFixed\" [] Prefix\n", "num_lines": 84}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14959 where\n\nimport Data.Bits (setBit)\n\nf = foldl setBit 0 [x | (x,_) <- zip [0..] [1]] :: Integer\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs  #-}\nmodule T14978 where\n\ndata Equal a b where\n  Refl :: Equal a a\n\ndata Goof a where\n  Goof :: {-# UNPACK #-} !(Equal a Int) -> Goof a\n\n\nfoo :: Goof Int\nfoo = Goof Refl\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15002 where\n\nimport Control.Concurrent.MVar (MVar, modifyMVar_, putMVar)\nimport Data.Foldable (for_)\n\nbroadcastThen :: Either [MVar a] a -> MVar (Either [MVar a] a) -> a -> IO ()\nbroadcastThen finalState mv x =\n    modifyMVar_ mv $ \\mx -> do\n      case mx of\n        Left ls -> do for_ ls (`putMVar` x)\n                      return finalState\n        Right _ -> return finalState\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15005 (\n    OrderCell,\n    ElementCell,\n    rawAlgorithm,\n    rawAlgorithmWithSize\n    ) where\n\n-- Control\n\nimport Control.Applicative\nimport Control.Monad\nimport Control.Monad.ST\n\n-- Data\n\nimport Data.Word\nimport Data.Bits\nimport Data.STRef\n\ntype RawOrder s o = STRef s (o s)\n\ntype RawElement s e = STRef s (e s)\n\ndata RawAlgorithm s o e = RawAlgorithm {\n    newOrder        :: ST s (RawOrder s o),\n    compareElements :: RawElement s e -> RawElement s e -> RawOrder s o -> ST s Ordering,\n    newMinimum      :: RawOrder s o -> ST s (RawElement s e),\n    newMaximum      :: RawOrder s o -> ST s (RawElement s e),\n    newAfter        :: RawElement s e -> RawOrder s o -> ST s (RawElement s e),\n    newBefore       :: RawElement s e -> RawOrder s o -> ST s (RawElement s e),\n    delete          :: RawElement s e -> RawOrder s o -> ST s ()\n}\n{-FIXME:\n    If we ever allow users to plug in their own algorithms, we have to flag the\n    respective function as unsafe and point out that referential transparency is\n    in danger if the algorithm does not fulfill the specification. This is\n    because element comparison is presented to the user as a pure function. The\n    important condition is that for any two elements, compareElements must\n    always return the same result as long as delete is not called on either\n    element.\n-}\n\ntype OrderCell = Cell\n\ntype ElementCell = Cell\n\ndata Cell s = Cell {\n                  label :: Label,\n                  next  :: CellRef s,\n                  prev  :: CellRef s\n              }\n\ntype CellRef s = STRef s (Cell s)\n\nnewtype Label = Label LabelWord deriving (Eq, Ord)\n\ntype LabelWord = Word64\n\nlabelWordSize :: Int\nlabelWordSize = 64\n\ninitialBaseLabel :: Label\ninitialBaseLabel = Label 0\n\nrawAlgorithm :: RawAlgorithm s OrderCell ElementCell\nrawAlgorithm = rawAlgorithmWithSize defaultSize\n\ndefaultSize :: Int\ndefaultSize = 63\n\nrawAlgorithmWithSize :: Int -> RawAlgorithm s OrderCell ElementCell\nrawAlgorithmWithSize size\n    | size < 0 || size >= labelWordSize\n        = error \"Data.Order.Algorithm.dietzSleatorAmortizedLogWithSize: \\\n                \\Size out of bounds\"\n    | otherwise\n        = RawAlgorithm {\n              newOrder        = fixST $\n                                \\ ref -> newSTRef $ Cell {\n                                   label = initialBaseLabel,\n                                   next  = ref,\n                                   prev  = ref\n                                },\n              compareElements = \\ ref1 ref2 baseRef -> do\n                                    baseCell <- readSTRef baseRef\n                                    cell1 <- readSTRef ref1\n                                    cell2 <- readSTRef ref2\n                                    let offset1 = labelDiff (label cell1)\n                                                            (label baseCell)\n                                    let offset2 = labelDiff (label cell2)\n                                                            (label baseCell)\n                                    return $ compare offset1 offset2,\n              newMinimum      = newAfterCell,\n              newMaximum      = newBeforeCell,\n              newAfter        = const . newAfterCell,\n              newBefore       = const . newBeforeCell,\n              delete          = \\ ref _ -> do\n                                    cell <- readSTRef ref\n                                    modifySTRef\n                                        (prev cell)\n                                        (\\ prevCell -> prevCell {\n                                                           next = next cell\n                                                       })\n                                    modifySTRef\n                                        (next cell)\n                                        (\\ nextCell -> nextCell {\n                                                           prev = prev cell\n                                                       })\n          } where\n\n    noOfLabels :: LabelWord\n    noOfLabels = shiftL 1 size\n\n    labelMask :: LabelWord\n    labelMask = pred noOfLabels\n\n    toLabel :: LabelWord -> Label\n    toLabel = Label . (.&. labelMask)\n\n    labelSum :: Label -> Label -> Label\n    labelSum (Label word1) (Label word2) = toLabel (word1 + word2)\n\n    labelDiff :: Label -> Label -> Label\n    labelDiff (Label word1) (Label word2) = toLabel (word1 - word2)\n\n    labelDistance :: Label -> Label -> LabelWord\n    labelDistance lbl1 lbl2 = case labelDiff lbl1 lbl2 of\n                                  Label word | word == 0 -> noOfLabels\n                                             | otherwise -> word\n\n    newAfterCell :: CellRef s -> ST s (CellRef s)\n    newAfterCell ref = do\n        relabel ref\n        lbl <- label <$> readSTRef ref\n        nextRef <- next <$> readSTRef ref\n        nextLbl <- label <$> readSTRef nextRef\n        newRef <- newSTRef $ Cell {\n            label = labelSum lbl (Label (labelDistance nextLbl lbl `div` 2)),\n            next  = nextRef,\n            prev  = ref\n        }\n        modifySTRef ref     (\\ cell     -> cell     { next = newRef })\n        modifySTRef nextRef (\\ nextCell -> nextCell { prev = newRef })\n        return newRef\n\n    relabel :: CellRef s -> ST s ()\n    relabel startRef = do\n        startCell <- readSTRef startRef\n        let delimSearch ref gapCount = do\n                cell <- readSTRef ref\n                let gapSum = labelDistance (label cell) (label startCell)\n                if gapSum <= gapCount ^ 2\n                    then if ref == startRef\n                             then error \"Data.Order.Algorithm.\\\n                                        \\dietzSleatorAmortizedLogWithSize: \\\n                                        \\Order full\"\n                             else delimSearch (next cell) (succ gapCount)\n                    else return (ref, gapSum, gapCount)\n        (delimRef, gapSum, gapCount) <- delimSearch (next startCell) 1\n        let smallGap = gapSum `div` gapCount\n        let largeGapCount = gapSum `mod` gapCount\n        let changeLabels ref ix = when (ref /= delimRef) $ do\n                cell <- readSTRef ref\n                let lbl = labelSum\n                              (label startCell)\n                              (Label (ix * smallGap + min largeGapCount ix))\n                writeSTRef ref (cell { label = lbl })\n                changeLabels (next cell) (succ ix)\n        changeLabels (next startCell) 1\n    {-FIXME:\n        We allow the number of cells to be larger than the square root of the\n        number of possible labels as long as we find a sparse part in our circle\n        of cells (since our order full condition is only true if the complete\n        circle is congested). This should not influence correctness and probably\n        also not time complexity, but we should check this more thoroughly.\n    -}\n    {-FIXME:\n        We arrange the large and small gaps differently from Dietz and Sleator\n        by putting all the large gaps at the beginning instead of distributing\n        them over the relabeled area. However, this should not influence time\n        complexity, as the complexity proof seems to only rely on the fact that\n        gap sizes differ by at most 1. We should check this more thoroughly\n        though.\n    -}\n\n    newBeforeCell :: CellRef s -> ST s (CellRef s)\n    newBeforeCell ref = do\n        cell <- readSTRef ref\n        newAfterCell (prev cell)\n", "num_lines": 190}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15056 where\n\nimport T15056a\n\nblam x = foo 3 [1..x]\n-- We expect fold/build to fire\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15056a where\n\ntest :: Int -> Bool\ntest 0 = True\ntest n = test (n-1)\n\nfoo :: Foldable t => Int -> t Int -> Int\nfoo n xs | test n\n         = foldr (+) n xs\n         | otherwise\n         = n+7\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PatternSynonyms #-}\nmodule Bar (pattern PointerExpr) where\n\nimport Data.Kind (Type)\nimport T15186A\n\n-------------------------------------------------------------------------------\n\npattern PointerExpr :: Expr tp\npattern PointerExpr <-\n   App (RollRecursive (EmptyAssn :> BVRepr) (App _))\n\n-------------------------------------------------------------------------------\n\ndata CrucibleType where\n  RecursiveType :: Ctx CrucibleType -> CrucibleType\n\ndata TypeRepr (tp :: CrucibleType) where\n  BVRepr :: TypeRepr tp\n  TypeReprDummy :: TypeRepr tp\n\ndata App (f :: CrucibleType -> Type) (tp :: CrucibleType) where\n  RollRecursive :: !(Assignment TypeRepr ctx)\n                -> !(Expr tp)\n                -> App f ('RecursiveType ctx)\n\ndata Expr (tp :: CrucibleType)\n  = App !(App Expr tp)\n  | ExprDummy\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE ViewPatterns #-}\nmodule T15186A (Ctx, Assignment, pattern EmptyAssn, pattern (:>)) where\n\nimport Data.Kind (Type)\n\ndata Ctx k\n  = EmptyCtx\n  | Ctx k ::> k\n\ntype SingleCtx x = 'EmptyCtx '::> x\n\ntype family (<+>) (x :: Ctx k) (y :: Ctx k) :: Ctx k where\n  x <+> 'EmptyCtx = x\n  x <+> (y '::> e) = (x <+> y) '::> e\n\ndata Height = Zero | Succ Height\n\ndata BinomialTree (h::Height) (f :: k -> Type) :: Ctx k -> Type where\n  Empty :: BinomialTree h f 'EmptyCtx\n  PlusOne  :: !Int\n           -> !(BinomialTree ('Succ h) f x)\n           -> !(BalancedTree h f y)\n           -> BinomialTree h f (x <+> y)\n  PlusZero  :: !Int\n            -> !(BinomialTree ('Succ h) f x)\n            -> BinomialTree h f x\n\nnewtype Assignment (f :: k -> Type) (ctx :: Ctx k)\n  = Assignment (BinomialTree 'Zero f ctx)\n\ndata AssignView f ctx where\n  AssignEmpty :: AssignView f 'EmptyCtx\n  AssignExtend :: Assignment f ctx\n               -> f tp\n               -> AssignView f (ctx '::> tp)\n\ndata DropResult f (ctx :: Ctx k) where\n  DropEmpty :: DropResult f 'EmptyCtx\n  DropExt   :: BinomialTree 'Zero f x\n            -> f y\n            -> DropResult f (x '::> y)\n\ndata BalancedTree h (f :: k -> Type) (p :: Ctx k) where\n  BalLeaf :: !(f x) -> BalancedTree 'Zero f (SingleCtx x)\n  BalPair :: !(BalancedTree h f x)\n          -> !(BalancedTree h f y)\n          -> BalancedTree ('Succ h) f (x <+> y)\n\nbal_drop :: forall h f x y\n          . BinomialTree h f x\n         -> BalancedTree h f y\n         -> DropResult f (x <+> y)\nbal_drop t (BalLeaf e) = DropExt t e\nbal_drop _ (BalPair {}) = undefined\n\nbin_drop :: forall h f ctx\n          . BinomialTree h f ctx\n         -> DropResult f ctx\nbin_drop Empty = DropEmpty\nbin_drop (PlusZero _ u) = bin_drop u\nbin_drop (PlusOne s t u) =\n  let m = case t of\n            Empty -> Empty\n            _ -> PlusZero s t\n   in bal_drop m u\n\nviewAssign :: forall f ctx . Assignment f ctx -> AssignView f ctx\nviewAssign (Assignment x) =\n  case bin_drop x of\n    DropEmpty -> AssignEmpty\n    DropExt t v -> AssignExtend (Assignment t) v\n\npattern EmptyAssn :: () => ctx ~ 'EmptyCtx => Assignment f ctx\npattern EmptyAssn <- (viewAssign -> AssignEmpty)\n\npattern (:>) :: () => ctx' ~ (ctx '::> tp) => Assignment f ctx -> f tp -> Assignment f ctx'\npattern (:>) a v <- (viewAssign -> AssignExtend a v)\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15445 where\n\nimport T15445a\n\n\nfoo :: IO ()\nfoo = do { print (plusTwoRec [1..10 :: Int])\n         ; print (plusTwoRec' [1..20 :: Int]) }\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15445a where\n\n{-# SPECIALIZE plusTwoRec :: [Int] -> [Int] #-}\nplusTwoRec :: Num a => [a] -> [a]\nplusTwoRec [] = []\nplusTwoRec (x:xs) = x+2:plusTwoRec xs\n\nplusTwoRec' :: Num a => [a] -> [a]\nplusTwoRec' [] = []\nplusTwoRec' (x:xs) = x+2:plusTwoRec' xs\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T15453 where\n\nimport Data.Kind\nimport Data.Proxy\nimport Data.Type.Equality\n\ntype family S :: Type where\n  S = T\ntype family T :: Type where\n  T = Int\n\nf :: (forall (x :: S). Proxy x) :~: (forall (x :: T). Proxy x)\nf = Refl\n\ng :: (forall (x :: T). Proxy x) :~: (forall (x :: Int). Proxy x)\ng = Refl\n\nh :: (forall (x :: S). Proxy x) :~: (forall (x :: Int). Proxy x)\nh = f `trans` g\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\nmodule T15517 where\n\ndata Nat = Z | S Nat\n\npattern Zpat = Z\n\nsfrom :: Nat -> () -> Bool\nsfrom Zpat  = \\_ -> False\nsfrom (S Z) = \\_ -> False\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds               #-}\n{-# LANGUAGE FlexibleInstances       #-}\n{-# LANGUAGE FunctionalDependencies  #-}\n{-# LANGUAGE GADTs                   #-}\n{-# LANGUAGE LambdaCase              #-}\n{-# LANGUAGE PatternSynonyms         #-}\n{-# LANGUAGE PolyKinds               #-}\n{-# LANGUAGE TypeFamilies            #-}\n{-# LANGUAGE TypeOperators           #-}\nmodule T15517a () where\n\nimport Data.Kind (Type)\nimport Data.Proxy\n\nnewtype Rep (ki :: kon -> Type) (phi :: Nat -> Type) (code :: [[Atom kon]])\n  = Rep (NS (PoA ki phi) code)\n\ndata NA  :: (kon -> Type) -> (Nat -> Type) -> Atom kon -> Type where\n  NA_I :: (IsNat k) => phi k -> NA ki phi (I k)\n  NA_K ::              ki  k -> NA ki phi (K k)\n\ndata NP :: (k -> Type) -> [k] -> Type where\n  NP0  :: NP p '[]\n  (:*) :: p x -> NP p xs -> NP p (x : xs)\n\nclass IsNat (n :: Nat) where\n  getSNat :: Proxy n -> SNat n\ninstance IsNat Z where\n  getSNat _ = SZ\ninstance IsNat n => IsNat (S n) where\n  getSNat p = SS (getSNat $ proxyUnsuc p)\n\nproxyUnsuc :: Proxy (S n) -> Proxy n\nproxyUnsuc _ = Proxy\n\ntype PoA (ki :: kon -> Type) (phi :: Nat -> Type) = NP (NA ki phi)\n\ndata Atom kon\n  = K kon\n  | I Nat\n\ndata Nat = S Nat | Z\ndata SNat :: Nat -> Type where\n  SZ ::           SNat Z\n  SS :: SNat n -> SNat (S n)\n\ndata Kon = KInt\ndata Singl (kon :: Kon) :: Type where\n  SInt :: Int -> Singl KInt\n\ntype family Lkup (n :: Nat) (ks :: [k]) :: k where\n  Lkup Z     (k : ks) = k\n  Lkup (S n) (k : ks) = Lkup n ks\n\ndata El :: [Type] -> Nat -> Type where\n  El :: IsNat ix => Lkup ix fam -> El fam ix\n\ndata NS :: (k -> Type) -> [k] -> Type where\n  There :: NS p xs -> NS p (x : xs)\n  Here  :: p x     -> NS p (x : xs)\n\nclass Family (ki :: kon -> Type) (fam :: [Type]) (codes :: [[[Atom kon]]])\n      | fam -> ki codes , ki codes -> fam where\n    sfrom' :: SNat ix -> El fam ix -> Rep ki (El fam) (Lkup ix codes)\n\ndata Rose a = a :>: [Rose a]\n            | Leaf a\n\ntype FamRoseInt = '[Rose Int, [Rose Int]]\n\ntype CodesRoseInt =\n    '[ '[ '[K KInt, I (S Z)], '[K KInt]], '[ '[], '[I Z, I (S Z)]]]\n\npattern IdxRoseInt = SZ\npattern IdxListRoseInt = SS SZ\n\npat1 :: PoA Singl (El FamRoseInt) '[I Z, I (S Z)]\n     -> NS (PoA Singl (El FamRoseInt)) '[ '[], '[I Z, I (S Z)]]\npat1 d = There (Here d)\n\npat2 :: PoA Singl (El FamRoseInt) '[]\n     -> NS (PoA Singl (El FamRoseInt)) '[ '[], '[I Z, I (S Z)]]\npat2 d = Here d\n\npat3 :: PoA Singl (El FamRoseInt) '[K KInt]\n     -> NS (PoA Singl (El FamRoseInt)) '[ '[K KInt, I (S Z)], '[K KInt]]\npat3 d = There (Here d)\n\npat4 :: PoA Singl (El FamRoseInt) '[K KInt, I (S Z)]\n     -> NS (PoA Singl (El FamRoseInt)) '[ '[K KInt, I (S Z)], '[K KInt]]\npat4 d = Here d\n\ninstance Family Singl FamRoseInt CodesRoseInt where\n  sfrom' = \\case IdxRoseInt     -> \\case El (x :>: xs) -> Rep (pat4 (NA_K (SInt x) :* (NA_I (El xs) :* NP0)))\n                                         El (Leaf x)   -> Rep (pat3 (NA_K (SInt x) :* NP0))\n                 IdxListRoseInt -> \\case El []     -> Rep (pat2 NP0)\n                                         El (x:xs) -> Rep (pat1 (NA_I (El x) :* (NA_I (El xs) :* NP0)))\n", "num_lines": 98}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PartialTypeSignatures, RankNTypes #-}\n\nmodule Foo where\n\nf xs = let ys = reverse xs\n       in ys `seq`\n          let w = length xs\n          in w + length (reverse (case ys of { a:as -> as; [] -> [] }))\n\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14573 where\n\nimport Data.Bits (shift)\n\nbadOne :: [Int] -> Integer     -- replace Integer by Int and all is good!\nbadOne is = sum $ zipWith (\\n _->shift 1 n) [0..] is\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- variant of T5327, where we force the newtype to have a wrapper\n{-# LANGUAGE GADTs, ExplicitForAll #-}\nmodule T16254 where\n\nnewtype Size a b where\n  Size :: forall b a. Int -> Size a b\n\n{-# INLINABLE val2 #-}\nval2 = Size 17\n\n-- In the core, we should see a comparison against 34#, i.e. constant\n-- folding should have happened. We actually see it twice: Once in f's\n-- definition, and once in its unfolding.\nf n = case val2 of Size s -> s + s > n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16288A where\n\nimport T16288C\n\ndata License\n\nclass Pretty a where\n  pretty :: a -> Doc\n\ninstance Pretty License where\n  pretty _  = pretV\n\nbar :: (Pretty a) => a -> Doc\nbar w = foo (pretty (u w w w w))\n\nu :: a -> a -> a -> a -> a\nu = u\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16288B where\n\nimport T16288A\nimport T16288C\n\nbar2 :: License -> Doc\nbar2 = bar\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16288C where\n\ndata Doc = Empty | Beside Doc\n\nhcat :: Doc -> Doc\nhcat Empty = Empty\nhcat xs = hcat xs\n\npretV = hcat Empty\n\nfoo :: Doc -> Doc\nfoo Empty = hcat Empty\nfoo val = Beside val\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16348 where\n\ndata V2 a = V2 !a !a\n\ninv22 _ = case V2 (V2 1 2) (V2 3 4) of\n             V2 _ (V2 _ z) -> z\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T1647 where\n\nfoo :: IO ()\nfoo = putStrLn \"Foo\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Trac #2520: a bug in the specialiser when we tried to\n-- quantify over an Internal Name\n\nmodule Types where\n\ndata Prod a b = Prod a b\n\ndata Nil = Nil\n\nclass ProdSel f where\n   nil :: f Nil\n   prod :: f x -> f y -> f (Prod x y)\n\ninstance ProdSel SqlFields where\n   nil = SFNil\n   prod = SFProd\n\n{-# SPECIALIZE reproject :: SqlFields a -> SqlFields a #-}\n\nreproject :: ProdSel f => SqlFields a -> f a\nreproject SFNil = nil\nreproject (SFProd a b) = prod (reproject a) (reproject b)\n\ndata SqlFields a where\n  SFNil :: SqlFields Nil\n  SFProd :: SqlFields a -> SqlFields b -> SqlFields (Prod a b)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test Trac #3016.\n-- The issue here is whether it compiles in a reasonable time\n-- With GHC 6.10 it took hours!  After fixing the bug (which\n-- was too much inlining) it went down to 30s.\n\n-- This also tests Trac #5652, a complexity issue with the LLVM\n-- backend for this module. Compile time down from 10 min to\n-- 12 seconds.\n\nmodule T3016 where\n\nnewtype F = F Integer\ndata P = NZ !F !F | Z\n\nlargeConsts :: [P]\nlargeConsts = [\n    NZ (F 0x1f8bd0b0c77369f3c5a1943c01215cad8c7018c4af1a588e6eF81c0a39e0a50db8e55bb371d956b15dbcb13ab12af532b1fc6b7ddf0a13d12dfaa76051132b84020bec72d2f265) (F 0x44a9e41f77686550649d5d124021aa477516211625bed15762a0729a0d052c71e99cdcdde7d245c0ab279cd4fd5b554d1f5f5e4ca912c0051df85de732dbc5f672c49f12215103f)\n  , NZ (F 0x1717e2a5c3ee28F6db3f13b087fb3e9efbe38772ffc1f1b03e0f2bbccc016ede33153d46b7ba33618c056cb2f35eda083af75b17115e138483dc59ad83F1077a2829e20bfF5f) (F 0x0c2a90da370b1b8963dF950c975806f6de5a01e5152b4850b2ff99d1f8b0726d5d2f0bb850aba987acafc99b70c581abe9dd39e7bfa4acfb303e76738ed001dec5032359c3ad2c)\n  , NZ (F 0x0d9bae2a98471270cd81eec78d6c906d5db35cdf049f56822b5910fa9b03bfbb07bff09ccec3831c4e4b04485F70a460ef8e0a88f6be4957822bf3c997f34dba2864c6cd47e0b1) (F 0x5c08664f55b7ddce2277f251725bc76ea968ef0c4e4a8522ef920d9dcd36d68704b1c7f03dd54154F741e1970c4cf3bcb055b4938ca787179aeada021e2d7795f52484cf504837)\n  , NZ (F 0x68989557c872f0f3b33eaf57e55f7d5853a2b61c368ae0b602b587b6ed600856dad98d83fc0F370ff6f229b3a0aa3a5fc9ce9d05ebf7f8f531071479c643f0f914226df4a875da) (F 0x0069c79079321474fab6bc7d302eaf60ec2dde78023a2865f2d428be48c8c24fcdef0c049d2c9d6e4f67d37a00b6542813d485d3b3c04a6292513775d4f86d8a288741074d5c88a)\n  , NZ (F 0x0ce80da044b946af21a69e31ac4fc1e5a42bdb8d6cf99fd54ad02087cbf414483145ec8bc2c2b05bd90db5abcb55b0d3fb7c5c9f23acb5605392e16836df34898ac0e8a244b2f42) (F 0x6f19698a2e8a07619db0cde15c261b4bb8f4a2b0332928e2c2529ad04414c7cfb84a38514fc0d6e807dc5e1ba2c35d14cc2d1756df443f407a421a96a96a9f6c945b38b51e6a3ce)\n  , NZ (F 0x2d549e10fd758033c2d9c42b9581291395f196c0c235e8eeeb2c7ae1aae4b81009e50632287b9225b28c4a07be3b32136c2df76bfda3db44ec1ad3c2c75198ba88c48df3acbcf6c) (F 0x0c8433cf98b3a74bf644a38e2b1665d340e68d22b0e12725b6b152c67ea8352247b3be4c454b005362de4f74aba48083374d2d35c94e668f989c2705e86786a9ae6f4551f7098f4)\n  , NZ (F 0x02707bea041e78a21de04f0d99de3767a77af119bF08ee2d2645f76517f7716bbb9c342a4025a5743c82720c932c2d7c140c3347e1585a2bbc54c9185e8005064500bdcb5b602c) (F 0x402be6d62231db6644fF204e039ac366db5c875d624d19b454e267e8661e6c1b7857ce8d9fa88b5dfa232b66b743d193ff8df776dbe191b9b488a30f28b74ce622631e0435082d)\n  , NZ (F 0x0704694ba693174331f08b462effdf5fdf4248a09048a5752732794f317d797982aea4a73de08545332d7fd3e47204cc76d234178c70355fd134dfd3c09db43d984f1c5368000b7) (F 0x68c6e1741a6b6c05e0c9a7972ab61beaaf5ba808198574d76988664f6ac08f67cb8a28f39f7fbd4beee011a784f4e7720091f69ea9670e8307f52b1468ae03a1d55a9F4601b560)\n  , NZ (F 0x1eea11c3d5391cd112c54b56181845a38e0e819460bf38b14224afff8e365364e2b21a6d1b1e859ac53349118cfc49ccc8f43c2e2082f846da7e7289b03e33F6301e23fd3be5b6) (F 0x501188011b45eeb4e0849a15441c48e3244b5453798223d3f8207c836fae1561a88f27b49e5d903044c70bf100be066be47f6ffadc1f93e21dd6d73e76922566128b13fc7278b78)\n  , NZ (F 0x6f4028f5d3c848c11979294848d590bb60c04aaf4a755c955f0674da8d4f16061f2a2ef10af04d4ad4361a577114b3862decc1606efdaae107b97ebfb6658898F3274d5ed773bc) (F 0x24c24b6001f97364416d1ff2924e85d008d142b2de80ea133e12253c460548f2fb16514f31c6199a4471934c75441821d87c88ab4e29212d19d3e9493f8bd478c6728c32F3ce87)\n  , NZ (F 0x2cdb2db5887b8d5e72c360b7aaf778dc90f3982d32cb4800d0a4d89a62716195fb4bf34ae6a9b9f85b845fd1265ea348f979553d16ad17dda326eeed5ffba79d7937926417aa87a) (F 0x6f2dff0a5a06ff421c5713002ae47a29e42e1a9537c049f8d8e2fc82232cc41fa9acb6a93069adc0dc5fdb5041dee65f972255a0174c139885cdbfa1767cef3f21fc8e20691af54)\n  , NZ (F 0x62e3e472a5361e3a807e35e3a0ef747af308399ecebaea7172aaa5ecb464e237021ca06e7592241098c027a1d6170ae09610b3f2a43ef705420e62455f0a4d3c871327cd626cd49) (F 0x0c0ae9be79663ad7af9a309910ef635e6a29f43d6852073e91f33ffb825ed1e458ec59558e50aef20a2a2e764b64b6d638f05d48cc11289ec6bf34ebeb4ef07ca2d1e316e85ce1f)\n  , NZ (F 0x692a88b4f4bb1fb765c852fbc801e30da715debdf38f6b6671a0f8d0f2f19eeafd5074dd3ee3877fc61aec49ac10e94abf9d575fd0c805d56781958bbb2fff32f9bac3cf217a3db) (F 0x6a12b076fd8c5c6bf6a80abb9c86b3c8a046c6f54c1803988c788e678134b1cc9ebe3d4fd1d94dbca40af830e430019022d595843133e95b25191eff98238e2f9a158ea6ff146dc)\n  , NZ (F 0x12f4F60602c7275862f75b0c6a37f620ccb9ac01428f4871046ba7443c27f82ce4a20d92c7f249a9586737cbc4ffac2d26094dff3ba865275b53195d8e93776be097ae89b638e4) (F 0x357d198c192d31d0a51ab8b3171e973deb0a65434d9641640b265ccded2c66a1154d3e0d1fb78de562e98ea17014da4716027279d4043e842195d6490f7de4ef71bcee694bc95df)\n  , NZ (F 0x1fa9d46086685069b0c658aecc29fc5e0720c1db18a453b475932681ab021ad7d0e8c61319c3c5eccd408caede59807f9683a344ef6248b6b7af652d844b94f469a9f097bdf7154) (F 0x69cb3584e77b331a39272407d9332ae3d756baaeae4c96d3206a82a53ec0dfbd933689521a88b7cac055af2692e8346d865b8042175098010c9f329157c314e74e40171f607c6ca)\n  , NZ (F 0x4e11fb21ab6cfa37dcf0e86191b8ac3ee4fcb59d45711145026697d6071f626d42831798b470f579298298e4d0f6888ae11e8f78dc7b67f0d00f51f82dcb93bc5a26c10e0730413) (F 0x19e5a32f6382ad8ed9a8c6d309238ac01632d19b19cc05317073dc7e1297ffa011b42e3ec6ff6e3f46320d5d4593fd947F9722d0a0ba46c713c18817e12b2879546fb300cca135)\n  , NZ (F 0x2af9b31ee022468cd99ade25ad532074c28bF69b9acc043253f938c6265526ee0088bee7b5ebf09cb4978ccaa26da8822de16f966a97e2af85b857aef07f3ed014e3df6692446f) (F 0x61a9192be5e230f9d3fc256320a6145ac8d15a6533d2fa28d7cf23f5e538fc84b463f6182a9b725d41c7e29fa7c4477d4302243a5fa529202a60c8f5e7e43279245F7f364c1706)\n  , NZ (F 0x09893af62c3f9ef91c390ea927747e97a26ee968c48ffd8a33eacee0ffa5bec85dc9017260bf10e0f6c50a6ce5105b8fa98d03a12934cbb1c17b00a882f11b5ce476b1782f5c481) (F 0x0ebaae4919b808ee0a8c84ff691291ce5eb17b47e3fc53f703bd450862e41997964b12ee13F6a32c5d851ad4c7de72ab54b430977fb1044aad5396acfb93e2911de6bf61089909)\n  , NZ (F 0x2ac7ece094487ec15863238cFe36f7d3531f7af3ea6f7bfa901426F4ff9de97edaefabdf3317bc5705f817b9ba5462cd15853b24e243891f6103cba63424154662aa511e4c884) (F 0x6460c199fd17a691d361313748c332357bf2c551eb6a34eda7ca050563dca0decfda32e24e9a521620773f23cd8c1867243971853ab5e8524257d59e7561231b0098b86dee4038b)\n  , NZ (F 0x3d27d74eecc5c08ac70a331978363cda968654682a541c83e4b9eed30049eb5ce19ac1d44773a8f4eb15a9a16f658b1c55a7a8d0387a8da1e527ac43150827be69cb6a385953165) (F 0x632b43b7b47a86614cd9f563022cf5faf83e3a18289783836e7ee17624c88fda2bbd168e97adeedd2cadc36d01a699186c24172d97a5a4cabd6e92e5ee75065fd0a21560021a4c1)\n  , NZ (F 0x10e0b12b928b59df4156f4947a3699ebb15eb77dd7053a4193d8d539a8208b3328741ff1f4214312cf2ac517d578b6258720e326e5e3ce6ebfabd76a33866588333aed8eaf6d2be) (F 0x5b45cac3c6960f930473dc92a59776c705f6788f6d4f9bff84ff23a27b2712d5925a6a412dc42c5771dd740e60efdba850b00409908628b21dce05206d6239b9dc17bb93867a276)\n  , NZ (F 0x10f3e3d9b513c66cc5e385c5a0345724b6b12fdacff837be94e3f6c03717f1514d055df9488be6eaa7e3559f18e1af7b8ea2f9F80b51a82410b04599938403b2c0a0be25281a7a) (F 0x48e6633596ae39992abf47cfc683e1f5adfc35795630dcda7579d2805ccf95aff18caaef786f5f8ec9e4b6cfd74d0088F79cf9b9e3dfbbe22136a5F8fb89114eacde7971ef4dd)\n  , NZ (F 0x449dc8767edd713b02dbb079eefa7fc8ce9fF3f993584be5f75484f4e527f3322ae9f09ad43ef3510Fb031cb4F90f2690ec6311d46d8f9a5a31989279ce0a1b56097c60b594b) (F 0x33b1c40d75365bce66ffdbF6825b2a68fa2d9542ee14604c7710c5204f8491e77d47f40f81ebc8f7ca6d55194e48c3edc742ab20f44099fb87e10774bd10e65f0ca9b102a42f40)\n  , NZ (F 0x2f972908d156af47cd0f810f5f8274b1d374f48e58f103d4f4ac7548b2395639893c0f717e7a796755ec87bd72a8c20466f6a9821cc8ef7adcc8ebd4a996953e328c6Fa81ad718) (F 0x7f8d43bb33c1bd3cb05a3484a087152bee4a93894cc941240fd3611f2d7877397ba3b8e18539547c423dc26924dc1542040b15a4671ec2e72f0352924d7703f101d1cF2e3a59ed)\n  , NZ (F 0x0c6fca7259742ea612b83a60099afd0e44ee6236d56938ad45235f57e7da9d2d36a18c821ebc84af4f946739157c9945fc2225f0fc20b5fa2533d4422f42a8e4fd526a935ee909c) (F 0x265dba8d9490e018f8fb859625c5c664f8e877984d15f74397c8481d04574392c76467d2177eb438b0bfb8d7e898268f425a327b61acaF7263ecebc1b82be2630a8eec65e74961)\n  , NZ (F 0x0804bbf283e6a01d5193Fab80a61f4317217d624a416c11781b8d51563578b9d9834b02a73ff2582796042adbbae9e79852479aba7e9a20e55ec1b0675b6934cdfd39914f3eecb) (F 0x64a61d5f7afa2331b99e53a9e7f459d3829b85c2ca77b82885e8d41f18f8811aee847c6177f88179b3df079034dabe90e36e81a37665585eaf86acb2967649e2062a76e575eb51e)\n  , NZ (F 0x32b3d9e6102f41847cb6c2d9990875fd8f474fc2785a91b8aad7b2b788dba5b4f205fd45faad58f42d2a1336a7a2bc7e4baecfcb7620a429b1df916c513fb748329f9f184a2135d) (F 0x0b1d61a8233d5cab3cc6b73703f617508b93d7ab7928e8772e3b5b491bbd07637ffd13d2fa0bd1F94619430ae87d0750437820516984385383d955aa77e4baf9af86cff2eaabcf)\n  , NZ (F 0x7914c149a93adbef0a2f4652bfb22e56fcaf19d6731b203b4e54f5ea5cc8178612192ff14511bb5645f1f0986ca66cb13a6e175e5ac525d56455b0dd2d65e1f12365f7318f101fa) (F 0x7e2150105e893d245964b8b67877fdfd2fb5bb9b11e18263207ab62d699a8a9ffb564fc90c54f13a01644bdc9905284e72e78ae50bb6ca0555f3332cee0F1ff815c2db743632da)\n  , NZ (F 0x00f98162baa57c158fadd74a11f85c9ada738dc4297e3a8aac33a3bbe11a4033984414bf2430439fc87869d4618961c22d3c3b2d96181cdb5781d588332c36c00e73a3b8ea665f2) (F 0x3f8f2765c88a18f91f58fc4929be654c5f1f2668ce9b138c45c8130e411d4ffb42f03040b3c27d44aa55771cded9f694fc462bFe790b226b8ac322509dfb2df335baca96c194cc)\n  , NZ (F 0x2ed1b863af5cc6ec631d41a0087427989b5f6fa23f059f989605e419083b4258cef955b93ca731072d40593a8021d994e0d6de20069b087587f3fd666a4e688dea1e4e595406a4c) (F 0x42be26b62e46b02c25fb998573769b0758dd00bebd5330650f7f988053450a579bb10c30ec37e01e79356b1ec72658742d9ff0f6ab42a874475e004bd2bbba8361aa52907170dbf)\n  , NZ (F 0x038586a9f436a96f0e54f3fba5228e60017abc4dc4188603a8152167b64948b728238188516ecace3e03fb83d3ec13d3d8987c05bad80bd240c085aff4124ff3bdaa3228beddebf) (F 0x53516d45ff41ffd92de5a8151ec2453971cac4106393f2a3929c7513dc6a586325a324987896f846de1514e95bd9b297953d519570b5851864d2c7edf292db15a49d54843fc4cc3)\n  , NZ (F 0x0a152a03190a01eadb5710587cb605c31dfb0536780638de788bd416b20424a46bec12dec2840abe593524f7118deaa8b1c4e164887914cf11eed5c3344110ad8278a7331084e85) (F 0x212f1987e1867ff743bb3c76db9e5e8ac38daf3ef4e7a28c9652c7996b5bc9fb3cde926ac225eaa015b1cc285bbee989205f40b32af5295ba1e7b676e4cd2bb514f0cccae479ebc)\n  , NZ (F 0x73bf84dfFc477c8ff722e1d4e43530832903bbab606b936d2499bb7737b6bfb28bc67a8cc35977dc1ef80c9675bb5009afc5ae4b894f3b52857ed41c7ef275670a05f073aec47d) (F 0x78a5b7abb4e863130689a7bcd9ac705bacfccd966a7b8ae6d64b9750304192a957faafc82102c78a3abe3da1b788be674405b343f29624e5ead2ba09d5bfa79d42e3f7ae5332d34)\n  , NZ (F 0x1138c92923ccf725ca84881af969Faa09cdd8164d8eca1acaddcbfa0bc849e99ef28e93111717fc4c101b3e2db6534b59f806888b692f014f1580afbe1ca3e448cf09b69543cc4) (F 0x73b180d7fc410beaaa8b1aa68b6c63e949487686f036b1ea152f48f19b77f8b1397814b88b1a7ce4fd3da0d66e270da1d1ac6f5e080a7920f3cd557e6c90074f39be1da3ac7a671)\n  , NZ (F 0x46fd74da3aadd6141e5a94e39615c04fb9b93f306d78c8890eddb9ce9ce4d98bcbb07f8876e1659aefa6ded749004392d9baff1c102ccf2c8Fec4d154f5f758c0511953acc42ba) (F 0x7a37d404c33e6b38caa4c83a81ed44915ae00706e696e6e690753b1facb05ef63a9956aeccc50831830e7e63265fc3dcbe5951a613269cd9029b081a345630726ec6659464ab3ee)\n  , NZ (F 0x110ab86448753b13e1f7bcac2208802ccc8e175dd4446288cf55eefc2d90a84fd8d3841621a49a90f32afaaeaae91da25b9c50dfac657e03eebbf6506f83580ff1b09b9c80a3d89) (F 0x50d4ea69ff2cd6458419aff177d5aa380a95cf9c4b9120c26a77ba7f3ea787e72b8d735f2083e9eef4e3e50ec29af24294d5c7cc175489514614ebf45f36a47241e4f54dcaeff35)\n  , NZ (F 0x11a4f4644af9824a9fFa3882886fc08666bf7eaf9877d52f2bf625b819909f783817502f03f01754959ef989ce4c91df73b8f4bd876a8f2ba57f443b1878e3F2f0e4b239c7f0e) (F 0x1b6fc9c9b84d52b9fc1252a40db309018e42406bfdd0bd7a50f602cda7b3da428607049fafa4201d7940F261b1524798d0b0741605569141783c0b1ab7151f45f2528d539d9fd9)\n  , NZ (F 0x2f60711ace1bdd6526ce0e0636ebe2b349432abad66cdeaac2a0612d003a9a6ecd6117eafa2ed852633890d6f23931c7b568affdade16d8708c4c883e27ac9ec4b33d8df02ab69b) (F 0x4dc2025aa3ec598bc7f28f10d42eb9ed52661265b5d791b5936d9f4e0ec8ab9da5b01efc2a2948128dd3aba9b59eea9805736c3F528de588ce62c4e176e6193cdf8157639d4dc3)\n  , NZ (F 0x606cbaf12f6641692858e44dbe300a70017e1873b48a1cae6093b3da77e0a5e72611e759f868013c60ef358d55932b29a7f472c5a5af431a760f486dcf4af1cd96e2a81d21ace33) (F 0x20c98a6081c7ffba1e26fdcb02a171b449308325d297141395ed457a591c832c890ef464f2c7e226d7d24e582012a023d3e6cc60cd2085d19232e5a241e88747f72a92136f91cbb)\n  , NZ (F 0x1cf0d9a7c117539d05b0d196664bac61d3f69d7f1f9c8d5d99e789d5bcde4cafab89be1a8ca286513f6aa24b5cbd9207730382931f23ebc4e6773e69666a155dad73f31a1b8276a) (F 0x68e994a0a3967893f2f5fd6d34014a6a417485c3777633453cf68f14525b7f912bdee1ad5e355c94500ba02ad7fa69047e48d602273e8948bff7721b52dfc7d43e685cf11364bb1)\n  , NZ (F 0x64dd3887685a42a260299612de16aba7362a3a26990ca064f52940c0068dc94d1730b042de8bae85e8fc78904a05c906a18a7556042c35f9ad50b203528f575ccc7a2ef28f795f6) (F 0x6773b2b064e481bee3ce92a8910c24579223a86f7d2983a763ebaaf2964578cfd1f0c4c4866b8b968e3b736e6d81044b43b69177ce36a27b217f8cf4eeabd87f21e31b6da6f07b8)\n  , NZ (F 0x18892d70cf7c7ed14c6d774d4d8fb06cfc4d88b2cb64bdc2b33bff0228fad5a5aa72fc0c29ab716482c3395e5190F37c3168d43ab6ae7a2a8fb8eb4ac352e4d3b3e452a6958907) (F 0x154387f1e6d3231df9fb4f29f9a7178fd0efc1bd46456f9938df9a9552224fd362d26ab98fbcf5f6bfbfad71cdbf4c84deb34b52f0341e5604a5b54F9cc04db98b1ebcbb4036b3)\n  , NZ (F 0x02dd16a2337c17b756f1207b9e41fd4ff0c90a85eb82d3cff979347006eae0e8346bfbe10f63258166bd01091f907003c9c644fd7ce21a5e0e945e2c293a0b956919c85ad023c1f) (F 0x17b14cd98559da52338cd0b517e85e39ebd6e78c1632acc70ab07e4021bfb1dd929978380140a2cd4beab54c0651a420d82ad3e5e834b0cc54d96669f565e083a8117ae4352490a)\n  , NZ (F 0x38fb0d2cf73364bb64298d3f5df997a307e7b3d577e6839970111db788269b87bdb14eb03a5304aa767c583349ea2d1451da96b38045b7d70db026ac0b4526646a2a8717521ff4f) (F 0x3780c7f465656367caabefcfd330f6ebea232ecd6a309acff73dded18f1e8286d32004658316a3e36cdd7c50a4251bf64eb232ebbcd70da553a21473b5899ff56cf87470af63d90)\n  , NZ (F 0x5681aa548c1597856b5041ae597002ec0e635698e62e68a8F8d13272279d686b51d3057d25f66136e87049facba85444ee85e2804a9fcaab066ef222ecaa88ea6d05e6d72d1593) (F 0x2a8774a7c3d9534a42395cf20975f1b2371252eec136a74f21a5168d66e2eb61d40ddc37e108fd23eb185d76eceaa3210f0eb8f8e41b9870727580e7cee54552369662893e4ef86)\n  , NZ (F 0x15ecd31944ec9215b045e80056682aee721adc0c80cb2e74346bfaada9eda5b1afd412a66b74c890630377f4ed013140404a999dff8f1b2d7bb97fb7c80f76c94cd1d7948cdfb10) (F 0x03c02bac8c24a2d00574534e2095a3c83e245b6cbf337adcf1f0f4c7e2bc0ecbc0f90a052323ee24068a6395342f6fd9ec31fbe0b406e0bfaa1a219e96c9d8311b75b6787617b0c)\n  , NZ (F 0x3d3d6fcb01f68af98246e3f3a45d75f2e83128831e6426c8d64a50d5fb1dc7249e9b93cd292271460b5a0c3b6be84280abf850a80726b67842632f741258e61159acc78cbed27dd) (F 0x0eaf0687eb8163fc4871712bdea607f0fbf5d6db8c367db111ab3d161b952864b88e7f87cbadcb4993a382cd75f71925adc5dae1253d5ee669d53d883da2dcac57634dde5b5d1c4)\n  , NZ (F 0x51ba2361e95a1fd067599de19a8ad87d9256e9497c198d031abf1535e1d22dd01ec62b07454da7509972b0803b0352da4681cfdf2d1ac376a0ab3b7100258d529ed8dc88ea8ee02) (F 0x243d5f372c356fde79e8d0166c98ea0cd5283a9e29af1b8a1203f5be0d47f56a764284599e63424c08dab89774691ddb2970fa5b5423acfc3d1037F1740130c5149620b7b012b3)\n  , NZ (F 0x28b93c69dd210efda8b5afd81a077e58ad21397527a530dc7cee4588be4a1e054b6871b511a5d4e913492f47260acecfae77c2550427c44a87bbb79b9ee79b684a7167200716e41) (F 0x63fc10efbeda768e506a29b4221e3cd8875b26a9f2de6de2Ffa01362b2c6d8f1a9c28dc04bda195f778b4315ceeb6ee6471d7a87ded6f4c603a753f4284a52f94ca14486804dd0)\n  , NZ (F 0x00bed73485f4261b3d520296c518ceedd73c11ac68603ea33cf7ca2375eafdfd1478713007a747827eb6bf4e52fd258e56bd47a359230cc3d540d7b257e0a29b6a14026e9953226) (F 0x492a14a9f8c79ef8e414035e564344fd70226b8858ce3712F6724fd73e1549fd5268e699f45748d1f050fc606136ef50fc59a016073cde7afb757a89230ce6b9bb41a53f3b274e)\n  , NZ (F 0x1836a76659698199c2d194949d99dd213Ff4f40a754a23eb41dd88e5f392de7cc0e2a02ad18ee8f7501d0b7fbaf2a16a7b4621fc82a72b0591b0cf6349de86d167c34ffbb581d4) (F 0x200e3bc5054134518d80b46dc22b3d4101cf661e5c5677b7e5F739eacbaf35c1a9134e7af5cb2F758299a66eF02d1e64e88cc405610fF4e37661960c08178b50d814230f3de)\n  , NZ (F 0x783934681e7c761f9bb135c5e27a3c894e7bbb7914b4a40d57de6b112443e08d165623d60a77464b370c599703ace3b1f403d28650b83736695d6847cdb5669769910859909dba5) (F 0x769741882de1c101ae43f26e8a042523e7040e36af8e774445eabc25f3d4ff5a68df414493e90a11528e58471fca2e192cdb3F4387bb20bdd73d157e20ab60818215706016339f)\n  , NZ (F 0x255b2ca2b903ef6496823f0dcd734fcde4b9cb57f3966a7f79cb5d4f973f90a996548eb5a2af7846c016a31be3c661bc82433d18e22d89a9ea758ec6309c7fc18b9ce5f6c3abbe4) (F 0x04f2b3506de649cb774faac74d99750dfbeba6c988429d001bb7751936bda5de941b70fa1038f3c79b879e9ef3e8bb6301c57393bd664f36880125c9e2d22309566967b60326f62)\n  , NZ (F 0x5ac6f875ebd8b682f1de34316e92fa838039ffb3e73e8470e044580a090f225a48cb7F027dedc4ec7a339defF2c30f1827161adfcca5194826fb831bafbd74bb4fc61ccc0bc0d) (F 0x2a450cf428f48bf7b77dbaed04c1700d5cdcaa53c6e2935e5223107433514a0c957f652fda7ed19c12aa31249cba4a90bf9aa7d5771564325c1eba786c6820b55ac852c2cac54cc)\n  , NZ (F 0x0155a9df1ffb94871f2ef25785c72d0047fbe31f86167fbae322e29dc111cf7249c9c06f8867fbcbea2310450779a0c45f775c28505d35605e17758c9c19c1713c49f2e83270eed) (F 0x7df61e7124b8d4e953bc8768c13033048a18f9a8c0fc683bbe3161a3bbc4f797d1680636b2daa5f2a4c40a93eb0a6e32ccae4730d17c703ce57c089754b12e561cfcf199f216fdc)\n  , NZ (F 0x44dd3e25bF21bf957bbc1b65a55dc5f3ff6322639ec398bc62f54be23f2778e12df961ba17b0d394eb3a1d8ed5eb3bcb9cd6c11d2cba7ea8c751b9bc6c33d4cee1f508e38567c3) (F 0x22f327ec62cc1edb70ddbc993d625d5c197a39677b65fa5be391dd0c5beaa9737aa60edafb79ceb8a122d9bf6886380872e2aaa7ab4b2c65460ff76094bF38a5c96815f001887c)\n  , NZ (F 0x4f2d7eda83f921ec7e46ee568f880daf8580df049e4d3f50a3dcd0841c25F0867cdf149683e92bea1a0bbcf27ae4a98390cd40d1f8e812404fc35aFcdfFe4021ac57f11f48b8) (F 0x1bec80ee0e3216df2e29ecd3b80c5d750233c6b22363a0bd6f54cb18ed0ecd7d068d25424c31dbfaa59a1b4f6984a907435e4cdbe8b3d7ff3e947b2044c31F5d654f6a332a1133)\n  , NZ (F 0x7e79e1fab6d3784ac788b7ab8fba45758255be0901cf1d71f2f5deb6fFd518a54ed822bb5f65bdef300301d34a776c688ca8486fde7ea857ec9b72db52ea8f904e3912fa4a6237) (F 0x721114e65e7d522a55c10eaa64a5297bb8a9bedae918d667d41d21e613b65e1646d5149accf7a9c44f16f797030f158fd331ee04a8517274d162c2d60703ee1cd5585068f18822a)\n  , NZ (F 0x114736bF6eb48158891c61bb296628b28aee02ff7977d9f5908cbf3e557c2781e696ef3dc7f48ae219ee03ea0944fb4ce607fb4ab3bdc569072cc1aed1d4b8682fb6697aa415c5) (F 0x60a6090fdf19df4358d3a1de725c18d2c215f203dcaa03e28c84c52753cb735c28327028e5822ed6119b3d275b3cb96e9e62fbb93a839e40b6a1564836cffb99103e90ae3a8ca3d)\n  , NZ (F 0x5102ea2acf66d3c49c23c6dcda0276179e6b7ac0cf6464b86f5e1fd5c8b6d48164788f9a40bded511b5f6181439e369820e58d74ab96176506939f9dc6fae884b8c2f45a0866409) (F 0x23F159abf795d754106a705502620bf7b666f9217d827e20e1c741b583eb570764bed6a4528951f2d4527f383193ebdf93074b98dd0955d60452cfF0511afa895e4e4ce3bd9ab)\n  , NZ (F 0x698babddab4b4e33219f8a9a4089aa837dec3fc5272948de1ae100a155bc180153ef4ac68b46a674cFd512f20d240c6101dc70b6c4d3a76c581ce9e73c053ca1b8a135684b4a22) (F 0x4db158136a0448e6f82cf54aa12360c5f83a18ee721ae508b691fd39840a6b97b7d9d68d73f8762cbe4914cbec9cbde0a09a5c29ab46de87b166576da6829349bac89872f73f05b)\n  , NZ (F 0x077b1989d49ad88b13dd8f63ece6c7efa57711f7277919c82f50500f4264b50F730f9a11921d45f3bd463f86Fc2bf202d6fb42e1817664bd908ecee7e9ae4604a80e86479bf88) (F 0x1712720c3a7adef8aec8091a540904934ee8b50aee584c663bf60baf7825fdcb71c590a250af7cf100aebb6b176304dd125126dfb9acb7c331d90b805a02331fdc45c3d0ab5812e)\n  , NZ (F 0x158b2a619652e24d91792c128b5266f9f5ee9232c36aeb98F30435f785785c90d0a49d40cc89d4dfb84b4a22b5658696f70e232e0e62fc537438482a42f625366ef7590435406f) (F 0x449a52c0183fdd5b168796cf47be83039fc4bb3a7fbcdf10945bbbd29368b74dfd50a7d20570c43cfb52b9b6b9694cf5faa96b9d6e9939c6491c242ec4023c7f2dfcfcF3eb7f9f)\n  , NZ (F 0x54af9dbf9306465c20c0536d7ec0ef73c1ed2895cad3e8dec8a48f08b63dcc3f800b5ac33e5dc7664c3ab247ce27baf2e441ad96aedd5c940a0d28fbf7e9659c2ba5ee0f769e712) (F 0x66ca236e547e7485d7cb5307140fc05a7eefa0fce6f42f217d933b0360de2b0839c8038832424f8b357e3e949fab6ad2d6a839769672caecca897506fdd775775727ade3e73fb4c)\n  , NZ (F 0x56103e3d570b5b5ed9932ba2f6fd3334bd25c9825e465de792f7d388d978e1564f6b14b34d5abfb6982374eb0dfd337fd3d53c667a20aa81f7c1d30b46de9ecbb475267e70413ed) (F 0x7ea6096fc87fb1c4e6706d7180227f4e3e3abcb52bd637998ce9a55700304b242629cc131f72f41ddaa83acb2d36993dF043be976a97c0f0fc154e5f3abc648bf4010859bfd710)\n  , NZ (F 0x3d5253a995635daadc4df234ab49d7eee160f7e447694252e98520e2800f65557c9c7637ceb07910d0edb53f2f09dbf0cd2616445b0156b28ed8437652b6b9ab8ab359de9935112) (F 0x33e7b552a534877f362ddd6fcec5259a35832aaF1be6b4512ea9c02b9f87b4e9d51f5157e71ef0cc3084962a67b3257eec5af925221F72572393611aa46abe67e38b4ffce146f)\n  , NZ (F 0x27e4b77b434ca0a36ae39d4db1bb7fa9a9a861b35b6bffbb84f32ae2ea70eda59644a26d87b29e24e83c0e97589b933f47215486007b293e22f32ed633a4a643f111b3b3dcd32f1) (F 0x6a96ed54c661b1e6677ad3b8c78ebd0aabd88b64e0582556c00facf5e3cd4b600d6a3bf43a868219a58686a616265bF121e1d0a148Fc2c90d8654d8662a1117d1f9fc081b1a7b)\n  , NZ (F 0x290b953c6146abf9a8c60e09e7b23e36326f99c38b8948e232d0bbab0aa38ed45F74e374ebecdf6ce0c226F64ce5a9fbe9a3a82bba51aa58c5179df3c00009b3303189F9b8c8) (F 0x0512d3ba2ef95f030e25a2f28ac9730065e99099456aae73de520aa3cc7f014a26c51472cbdd06d9cdd7f1e38f8ce67f386aa3ec4651072bb4e7bfbd8835a1f6bbb2280af39cdbe)\n  , NZ (F 0x2875b9e0062f306f0c881d3cc493d22f7eef33e4ab45a3be8b2c85e437f85deb8bf64f9357d95140068b91aa781f41b2bda76517ea7c1300c0e0edf8b877aac7295e06a7f4d8203) (F 0x78324313517b46733cf2113ca3f668932e359ff59017a6a6ce3910065c0f9f4748cf6950334dd1a89db3ef399a700a2bc7b26da1757ab507fd1c18061ee65afb5526e1a5136e404)\n  , NZ (F 0x1d44f44a85d9951122c63cb6efa9dcc290d99c332c151356c930Fa6c60069a14a957004e69579a00ed8cc29d5a21f60c3b03b6e9e198ab5931d0b7cc5c870c2604835616bc5481) (F 0x7150bb89ca1f1d5c73a22fabd16ed75b2e969971dd279f2192719b858f8daaee047164ab6770cd0a5f14dcd1e762c66840b3686833637a6a176d0694a6dba4d9ce53d1ba24b8f7c)\n  , NZ (F 0x56baa15d49b215962f88b2301d23ef6fa68712762cb20aa66afae786ca293179f22b35471dcc49636b89667183da40e3e7157663200913a5f3d66809b2b64d547b652760343934a) (F 0x1c54717b14c0ce225af3b9e6b28c47730846946ddf19580527814247d6e37e97b98a82ec219e30a0b73a43989898a2154b353deb36b654befa70ceb8949bca0d04d612b5f34a53c)\n  , NZ (F 0x67ad76e431a18c5403b58f7dc744dd5beb10e5e667ad02410b6641aa54e4b42ce9fc70ef4da470cb9c0c12d1174bF475e12af56ae503e12e23e98ca7c874eebadced54ddff6e41) (F 0x2879c10ca29760d2e26a04c2e2a5b0dd14F90498902b50db8fa5f9cf4ba6d4810f4e05c57129619159e2754c22e512cdc432ee6a1ab8091b6d8ea36f38e18ea7d178437d172d48)\n  , NZ (F 0x5b7541796494f39659ae28bc46e94f314c5f3a848a2f317990172847c10e0bb73bdf5a0e2a0012d9fb89ebbd7c0cc54400add6d4d7fbe77ec0b3d0a20f45fa1dd8206f68944ae68) (F 0x68a16ff28e03d99a7e591d93068eFe464ebab70e28b0f0a28e3f288e3af5be60d05f91cf350eb9b6ae699a5333111d9db362c712063187cb8d870f8347800126d65d8d086a08f9)\n  , NZ (F 0x01d27a4f1c6418929977db049592f66bf8abf888666d8aec9e743436094aba768c99d6d6a86f8ece035e706324c5eae82387ca29e2fbb4cd8b51b427826ca0c366f9a8196d57493) (F 0x4c8c4d22a88bbe50ddaf786ce643b40d0fc737f81507ef7ba41b9648a5fdc6f41b96e72e2f7817e4aed871448e757ec2b0bc144bdde9bcd4f76ed1d57beed5d61cbe9d9e45fa5e0)\n  , NZ (F 0x1683852e112c4b5cdb14ffa703e50e88ce3f395b7f43139c0709fcd21ed4c791b3fa8a901e585e4d7d05d8c78c88533a44999253515ed80dea9cb0a23f326d40dd630ac79788793) (F 0x5d28d5a2d7c575ba725378fbc9a4fcd139d003626822fF94e9bc44ad94afc1da7faae42f6e984b5c104131581b852379434aecd53c8647a62a1993949f653e623b9ac254da2313)\n  , NZ (F 0x18c9c726e1eed382c6a3745e0415579788e8ca815bf0f25409430573f8b8c54530c25992c88c86c1db00badaab3afa60a012d467bee2a759b1378204fa132b6df2c358f7341e16d) (F 0x73b0fa7564d6db6fd76ee2d2d0d997b2f61d77de1a8295e769de3522b7002cd495aa914a4c5b913bcbc11edc0e62fd5826fb3110af4e802aa6badd4eb72aee1c5d1c6ded7c9ccef)\n  , NZ (F 0x2d4843ae7c1c56d4950741fdea6b6f509596aeeeae4f21f287eb5b62ed92cc9a0e61e3039efd15b7e5bfdace903bfdfd36a437b7824279f5288ceecfF190cee1d94848a5e3c2c0) (F 0x75896b160e9d7ef83536ccba5085d8976a6ce64a620b6177c343266ebc9f7b0d264F9c91f0d43bf16d841a44116f9d69256f3cc48be1a545b10a878202ccf31ee02260b6F09ae)\n  , NZ (F 0x01ae1de6aab007a0f00dc72c95de7914ed07944f5327519e686914e09da9ebb485af7707c211f12ca259fdef73d6204642F9397a75f21c4d879fd930fd9ff091b627434e6F84c) (F 0x32bbd8c72afa3ccf4ac016b1551a3e6918a171a1da595f322ae151f5674756804d6739b2c41c90710aca7d2a6a79881ef339dffa343e4c1ab48f6c41a746b7e1b3ef7c8e5980480)\n  , NZ (F 0x0b24e998ddeaa44b015f4ae2f02ae25922474Fd539fc27cf6bf2b98e27f366528278c697b60000fc7caeF3cf132942825d696827eb58db53804438cbc56cc09a29026eb3db4be) (F 0x05052941b9152a1a05ea86373e37ce666adb7554b0d399e2fd821a20f1d3ba0cbbaa0f0dea5f7f6a1f11ac65c546b70cf223d2f6a34676eca77e1cd6459a7d273d79968ef6956cc)\n  , NZ (F 0x651181ade340c5df0a421d2460d48b9069ffdb0c94ac11596703b1316e9fd7eeb227e46c86c8b5065b6bcc4ec6a9f1201067777a9dea435ad6445ede9ac735e0a6f533358069530) (F 0x078cd1c009e525f95be2d193ae80ea522a8d2fc61d67F64afb0e8955e034fabdfb21608b71f11327d9b653bec2393ad8e38e91e90e663524aec7300c0beba213a81f8248c59b4a)\n  , NZ (F 0x69624c7bf5b3a38681e098b4e3f7e64833aaf0450020faf66e2d6ddb99c6652bef468edec1b512c8b9f3ec74757db5f3961c65cb611be4f225a37bd5f5651971a366ebc47b9fa33) (F 0x4916e7f30ffd33c0a6777832e1e219c6bee11f67a255b6652c8d072d8ec01d8e7d45cef11c1553bd28bf9d8bdca0278fa4df677bf094f6357a1ac89bc82ca910a03d03859242bb2)\n  , NZ (F 0x5da9eee37ba21db8b6be04b0b58abf663e8438ddd737d883df1e9cc93a413041ec827327f4543F8fd705eb9e26F586988919fa62fc52005495af5881698c1b6e20Ff9c3c638a) (F 0x4d7b03093b1fdaa6f5f68ddf09afd2a36070dc57a315e7b0f8fffd5cbc5e49e8c279d8cfff5dcf4c0e3cf23589aFadd58bd72914bcc7e8112785de148cd3d8e9f63956cb9bcF0)\n  , NZ (F 0x28613f73f4cfae4e738a6b8cf69c9a57940d3ed3966de1ed3c7dc6bca3d0a653c42bcd0c51d09ae388001f40b097953218f6afb038238c831eee331ec5be08c34f1f8d55879f23d) (F 0x1788c9d6bb2f01288eccd6ac01cad207c786e901580ff66234f2cb7e11357c027ca3cf69a13Fce4ed29ad71480fd1eb2090df4fd540c27d9ceca9f78fcea01060dd53f6bda0cf7)\n  , NZ (F 0x5f87e378a3bc5f76d0400de551a08b2ca6044cccd0a5231866701c0728fdebac9e7c677c479c9bea733a212cd2b23ce1692af7424cdaa353350803abdc3ea0050751f36b65ca779) (F 0x1385ba33908e1d4443c448534745e84d6816a7fb2658607e3d2ef9a85ead476229caf571db299aab746c7e25784538ee212ae262ca9eeab2ab09e585733af3a85cca3ea3cccd601)\n  , NZ (F 0x3f4ca379a3213fc9532ed51ba007a9817739008276c3e53e61da3d04251bf35da01ed5d1adbd855d3e1dbfb295dba938e69f0b17410ab07951f9a2d1031ccc7cd651c9ed7199a32) (F 0x3cf0c7532005a6ac3453022a43d1e6a52cc11fa0e5a5385be9cc46a7370e337356f7b03c7f21b4f35fa45ba1ad884d51f679f0b7d22743b1024ca1a226e4868c9bbab1af29cff77)\n  , NZ (F 0x01e3b895c86db8ef0621c14ad59a158b01e30a9bf6104db886f38f45eee7784d292c97f32303fa18eabb2454bf052c66cb003f9d513e11536c5902b0a43f534659695209c75f68a) (F 0x33e2262cbd9daaf0dce60fa546275Fd1a2a0f56b89b22924366434fccfd57c8b481020bb80cd561bf8c61a7ace75d8d5c42559cc6bb5bcbfb10dd7eefa507bebf60e56b88e9dcd)\n  , NZ (F 0x721ea141b941ac8399d5e051f53f116566c09045c6cb68642d8c66218239679b4e4dbd7d825474d41f9e5cb7e574b17155a75cec9dd56431e917adbc536c4e828192ca284f14c6c) (F 0x6c484d6eb9e7fd962d39ccc3998c52e9713b5f6efbde7ea4558499142f49b309daa4fb48ddb21362af6c50e5005d548d1d28f864b04857fca0e456289d70135027a5f25682Fc02)\n  , NZ (F 0x31d9e3a62c3b7dec60b17d43fc681c46cfaf083221fffc995fbd017991024ae87d5c2cf77ed19145b9ed8a106ae12a4a1a3ad7cb2ac23fcc48bF641aaf79c8f7c70edb79ce2764) (F 0x292c958f37c36e425a35182204c613153961c602Fd62b60a7d4315d73df9856b48b7f3cfd07dfc14827e02e52c630ef7b3abbf3e4ba4e3745e7213f94785c66e4707c15f6dee6c)\n  , NZ (F 0x6000ea69b5803c7df226e62156789b55360ca862ecd8ecbe983394ff587327bc8b7902d00c9e2864c9f57d7eb6d9f18fd55fFe3f14d4495f814ef54d968660fb6f3809a79e7246) (F 0x05c3327caF35283ce4533c5f43f3a3b2bbf12c39b0e122360c0868c7878b1992e91F348aae0a5ab000805c574b0c0695ca139934999a9a9415468e6251dfc60f9abd75a0e5ab8)\n  , NZ (F 0x3d42a1ff96ec08740abc0ca8bae7088aeae57afd36942b9a4f33cf8dd022db7530642c8e2f8ecc64e5fb6453220252d40e19606d49a78467f3501946f3349b5b3ea820edc271c7c) (F 0x319a99d0edc50fd488bd7c7875e8e36d78c6f54bc9b77d51d3dfcb8b2b35c73833192f04cc1f1594db83a9f4cfbf5af8cddf850cef9cbd8422d022e1532697d11b6a7184f3758bb)\n  , NZ (F 0x6aa3971a90d9e66f952c380e734cda1bab3596aa87f97d15c8c6321369be8339b0c4401f6831e7427f527c742690a8fda58f53ee0896826baba334e54f550b4610a4202a0814e03) (F 0x3f9d0bf15355e3df6a1b37e76a123bcb2a20323b97c2b4362547acb8557780dae6c144f290907a3472dde27611195980b6ee936663689b8eaa776b8af5191d1420f2c2c6ffd8227)\n  , NZ (F 0x0c5f09a23b75df9d6db88799e4fd38d71e8b70361d3b166759f3d54387606dfbFef4ff82cf59cFabd8e225cfa39f44d7afcaa9cb8c68168adbaff101bd305c7097990c622dbb9) (F 0x5b604c72f2098e695cb9f087405932c107350749b09822039adf7d2dd7c4046c7ee3c7949afd4b20205b0d505939a539fd8d3525ff50cf102f7178b03456a9a1778ff15536cbf7f)\n  , NZ (F 0x7e3e9a256c5725fc0b7971772354bdf679f0ddcbdbf021b6205bd72da79eda6781527Fe708984d026143f7c225a65c84948fc2c279350700cb7e9444bcbe5f9d2a18fdb8f3c169) (F 0x43997f1addd5f4e571d3f89b42383f9c6a2692497ee06ea12cad3b5b771cd3ac2117e2794e5c4e4cb3f9d87f5765aa825624aa9cc725bf7e8243e44d8ead952b67ad664675b65f3)\n  , NZ (F 0x10d258f6ecc4dae48f41fab159f1f64341b678e8ae081da3375e5efdaf5487347403a73f65fc34c06c2d8a67e3be7894054fF0F9b2282263c83ea13948ab338c1b2fb678c433b) (F 0x65334672941cee081f6d20b07b9491f156df9ccb4d8f9510d3c5fac868541a84e2b2201264d28c2d64f95ff2c15cac0258e61dc8fa7a91b827c0bab622e1d84b73cbed2295f8e40)\n  , NZ (F 0x77fb8fad7397752454b0cf17f5b0217d7abb02f2f67f6a3ad12dcf6df2afb9c4f888fc54b01458559de4fdd590915f1f749b408c9a1b782450171d4c8ab339468b9b593283fb6e5) (F 0x21449241fb9ef0b730651b7840082ef2bbd612a34a78a40bd09a18523265899deeeac6Face83ff1f72e5d8c1f07fcf98c1832a3e09a5a8813e2494b5ef410bf3f5d49d9acda189)\n  , NZ (F 0x25d046e559a2dd2b92719cf5354e220d010e625955fbd529e5d7e3f01efb07f50a9a6b9c067d4d125846811cdb5bc3f853d7dffbdcef1d19e3eec3e213e444073790b6dbe614816) (F 0x6c340b67028675cc9a446150a013078457ecaf748c0f94b39a49814b43134b4735356280479a15e96e4900987296bc492a27664cd77374554d81402a73c8968ad5fF6dcc27051b)\n  , NZ (F 0x2136f41f7d1e7abdbbf569b495b39186f61ab50df469aa387ef5ce9bad7009a22f78f656725e1f63eeba311b8eb4177ea64d06ac5e28110cdcda2d057f21e98362dd98a91495ce9) (F 0x2d9b8769e80aebe1fcb9edFF1ac458cdf60e4b309ca794c27a456493812dfffc9a9e1dcec66703cec639baae49d3ab5e4f4fb6aa9330957ad611b8e56e6b00682bbc99290a61e)\n  , NZ (F 0x5535ff3a04ca6b78a576c0e8bec9208ae8e8fff4d04a553bb42758597a0c1b836045b603374c12bf6a818ffda84e0de50ada7ad7bd3bda5e47b8b477b5a72cb547b78c9f9154152) (F 0x76896059e576b9766056d029373bf737fb166c5aa7a379c35dea3403c6f0a2e8148b0b6F5df29Fe674ef24ebcf3486f05ce27c1aa351bf75d84d9434d77555dcF612a8b70ef0)\n  , NZ (F 0x642e435cd5bd6b14aea58e6f8403896b8ea65783b50c3da588ed3dc8ed5532e016aa3e0305d588c4b5498b09dff284054e8335ba12dcbc8f67b40958e1346b9da4c5cb904c6f4ff) (F 0x0494fde9ca0f4aaf95d5a1a8ca1b798ec08e4645f1F74dd5c97f039a678fF1e95b9e58e52facb67956d40f99cf916da9761b31dac65c8666873a91f2eb227cc5857202776cf6f)\n  , NZ (F 0x55ac6ce052b50fbd956f3f6ee14eab51a4acf06b2d4722054bf0c76b3b5b4b20bde701c4fa3a6fbd775c62061589b68500e7500502f2ac73bc41fb959587468a3ed71d3cacdfa84) (F 0x6a58e5216cd7380642a64c01aa81763d8fbcf46f5bdecbf4F371fc25b1111898157a6b2eb1578d718af4704926abe58e4f0d3672d61004533ffa1eF87fd552e5ca190862fc4f8)\n  , NZ (F 0x349bc5af6da8142431fb603010560f8fc555a35b8b7752745d1fce8d1dcb602bf8c98c2bb4171b7051a74ce50969aa97b5a4838e249393c0dbc9524e5bda6f89e9428f60ff8efc2) (F 0x6267576dd7c8edd83b117c2160852486c2dc35127518123cf912471fd245747b8e51f6f50235bad0b995c96251fa2f925a2ecb4f81a4068b43b8804164c61a5515caf1c9ee53587)\n  , NZ (F 0x6e9814eb77878330847534c033d22eec83Fdcc9ce2e8556333fcc48388ac4997d3e7e77986902108b5a4ba4189380fd22a2562710c1b2c3d394214e13f8a8f9dea48f9e35e957c) (F 0x29896819b64296a8540dea155ebc0d800688fb305397ebe9716F12b80cbe75f761c25e8b6e42009b397599513503528177abe1e404aa01afb31bc41375b154bb78b77f83dd3fff)\n  , NZ (F 0x535d792442d41050ecbc570c0cb875602324e3018043b8914f03d93ff20c772ed9c632e5206fb2f6703b16f66f93961b072826b8aaa313F95e25a6cd96e7153437cbd85408c3ff) (F 0x7386305d3d7371773699114ecf1ff03babc7db5042c58d317d320e0cecb625d2ade4f2d23acc16a8476a6e61606c97c809d2e49d0e616a399ee754c5a425f378615427fc01d395a)\n  , NZ (F 0x5385d42581c0f353a16926d5c8f097a19ce85ff9d08b6f84c56561b4b767dc9475e559b11bd3cbbf7b9F4b4339ffdfbe3c78a7b8acb59333451bb044a0f201a8981cdf0aa1e6c3) (F 0x791e9421736d07b81ed3e07ae78ffda56386ed2a8746944f8e6173e54f0e9eace3799b20ef2a9191cdb0ff2caa815c8c828657ad4e70e0ea2e64020b60f5a4947dceeb47d29ebee)\n  , NZ (F 0x58eeaeb1514452d0a713ae46a7b62701bc7d2155b432db0fdb1682368ec14c8e77187265e7f523292e0ed3e4bdab1f1158ca7f52230bfcc81d796f0e485d1856ed6b16c51b509d4) (F 0x0c644f089d8e0c5f941b7de53b45a2292590dd5c2726f43baa09c9b2dc7824a18b708d105f8c07a74edba44cacaafc8f76faf3d2d455b8d249d190e487f18627a5d09fc08c89c8b)\n  , NZ (F 0x5dcb84a321ea4b3c7d92778e1e7407e498e855c44a406f9334af7ed65131ca0f0b28bf86ed08d5ea1e491dd558689f9d7c77b53f5bf2de7c57c863176ce495f27418c4da7ce9581) (F 0x7ad5c35ea7d5a4afd5588053b08e1d540a47f139a77b2001861ac819b8680bf8213307530eda9760e1541c2860a627b60d6badef4bae60d445774741c182e8d710f6bcaf220cc96)\n  , NZ (F 0x043007021b94cf80309d066bda1f99a22939decbb3511b296279f11b24fbf6b14cdc48ffa232dcf7cc06d3cb19cf38e59c2a84d406251647d8caa985fa79a987af11b8b8acbc3f0) (F 0x3417952f30c529472fF89d90661593b653522e9bdf72b32c5dbe4aedbdb939bb6a2a315f70b05d32ccf6543378b99b2e2695ac1e85b303e1e6aa935219a1eb91b5c2d365b1b289)\n  , NZ (F 0x36702a08232490315a776f982ccf1f47b54afa33d1466c8661923eab2bc6bf8ae4cbd4cf0c25eaf576b13Fa34fd7c97c738b1d0dd53a6d85682b99adefa67276b483176836161b) (F 0x4bf8be406ef048c03a831a7fa8b037c07951172081009b32c15696430b7d98213bb958eb06ea231aaee69ff40556ed419d903113ddb50e77372e944d9ce123ef7d3c60e5284faa1)\n  , NZ (F 0x52a9fad224606a9f38888a293e007a31e228f9ffcda182bf59e93d6f792ccf0a99917ab38ac7321c25087af41a545c0acf17f393d6106b6d67cd314bd8aae0cacec0a599ee67930) (F 0x2a971a54ef8a526cd49427736fdcfb935e471c387243bf155fd682277de09c28a0d6169b7cca355ad81f978390adf830a81e4022a05e11badee20c737052c68f489ae514fd20433)\n  , NZ (F 0x57ad7e98be74fa6d5a0721258f8d62568b4bd51713055314b44c03ec366d6f13619384cfdb02F2717021a52cc9b3ca2fae2a83af516369919f395caa2c790e21b2c0541c8e02aa) (F 0x4f13f849e4e126d361073520bb00e15380b9dad775383c1242b7d3fc4c7e294e8003f835a850a19524f469a5bebd4320410fbc8d2fba24ab7745a966a2b9192369dacc6877071e7)\n  , NZ (F 0x507d77445894cae623838dd125049f6141a461620d395c345b937d484e8e251c56ced9fb5f4067e28a0869cb1266395d0428a3b07bc4ecc6bb52190f16d1b5f963dadffa9af1a3a) (F 0x7a63a221b2a6e6417eaef232b29f8b29be92e0e3a7f11fda9d28b0fb5357bb6d4658e9bb0b091dad20a86b8d617aadf2f74173e1301c948eb669a09f3d450078f2c50ff9594b5c4)\n  , NZ (F 0x26cb1705160a2F9960e0693832f42ed404dd73fac9ebbdc33bdFf8346fdcb8001de699809cd69d2f319453b53ef7e4be7fc277cd3ba6d44833c719474c4d8e19fcd06d4101618) (F 0x6b2ef104c554a61797f440baa418845d97f3dbd3bd72d9defdae4bbaf32597Ff57c602d8e64de4b319d8a1db126be4575d5003e6666829bdee50321798fbbaf1ade5bd2b8ee38f)\n  , NZ (F 0x58f59376c96f24cec08fb06aa7df9b56e123693f191fd4d8a9b5f57815dcc0d6760a74fdc42f3e17bc5b33466a6b91f7f0f55c46f5b03b01539db0f425b2e505cda86ccd4fd6b5e) (F 0x621c755a6fd77b816ca01650f57ded475ab5ddabca6a83b5178486b1a04cc5e681b31beaa6a1c2d52b173b8d70125511d3bb120e922824767F37c26819c0aa9ee55b3743e8c1f8)\n  , NZ (F 0x44051e54c3df67ba4e3c02b2242e9c61d03d54edee3cd77eaeac6d5bee037f7c378eaf0689882ccefb90a4840a3bf93b523ca75e1b800bd9c678aacace9cb5f9c54ca0030f9f34d) (F 0x0fd57d3053fbdaa80b4802c16e80b7be295ec65a9f36b0aa52f260190aca101cf10f07b650e57a8a5d966eee576be43598c981f7f076e667dd35e8c73755107c0898b5faaaaa9ba)\n  , NZ (F 0x29efa1d31f110f51f9087064078d3029dcf960810629d2123caeffc73638e03d9cbe3b08f80f695a50c7dab8b2ed136b0fbb94fd19f5d0bcf3cc290ff36c0b8bbbe6cf92892b17b) (F 0x52dd38432185c7550d3e9da434b1abbaa97d63a5f9e3fa2ba56a1a349b6904aef847cb4ae6a120b97cf4d1298f5100e2ddeff44a764eff0ec7a2be434f6aad82f36d6b1796d0f3f)\n  , NZ (F 0x6abab7fae71cd020a39c0cf1860197292acbd7267a710091af32800669ca8a309a41cceed02257271fb451beb2ebbcacfcbc02a4079b143b8eb180ef1ae624d568b975f3b0b9571) (F 0x50def8624bbde6ca5c7efFc8cc8ce29fb49df45891419f724c2c83672f065e3d940524b53ce32d1cd6d896567c2057fF960bddf4Ff2884325ead8bc631b2f62bd2c8a49dbcce)\n  , NZ (F 0x03a981886aa3130e272c435f24a5630e187341e483f806334af71c1257346164a0bfff6e9eb2150b34f5a6563db3c19b22d7791d0573720dc3827385b2ecc733224680d4e703782) (F 0x63866d7504b53e7edd40a0cddd293327b6ff8e1ed16ae8fbf36436fb0064eafc46afaaf13a4f78adafa7b7c19f6bd0e52bf3b39ddade41130d4d9a5030fa68cde30465c03443fcd)\n  , NZ (F 0x2037bdd1afb7e6fbe331cd2d899c0e75c4aa8551e7d12ed201cf1bcf66da8cb52f0c03327dda3004d37b465c3d58447016ece90b7c29a3e769b55f093275a00e578bec01cd38c0f) (F 0x595fa33308f1c9b074807a5fc2c8f437a603089473b9a37bebd33ffd21cd7cbab98a8f56647d064972c872c7a7de184c0372a20bf77489eb72927e867dfb1fb674f28ed54685078)\n  , NZ (F 0x2f3224c72b49ed45d74d3e4240a5cb3f290dabd056a2bc72ad2629824c07066eb036fca3ba83db16c05661ad37a243313fb870547c05158ea5ba8e1c8e51f226f194d590559578f) (F 0x4a420678f1b15c777d571447db6c3f5d235ebc77794a9eb58222d114bb5abc059948Ff83c148d339f5cd8b3e178a55e081d06f9705162c1e40e05aba505ec1972a189272484b93)\n  , NZ (F 0x1403a6aa0d2b155879a74436d2e5324a6d6054ca604b01ab1f8db38a5502f596682f457a3aad0bca97eedfb00f254ea6b91726c01cbe244078b6fd6dc6f94920ce0d7bd72ae56a3) (F 0x33b7cbeed2b7756a1fdde915f11962ad8b125996a6a7f0f24a3c058759545d5e522f285e4ad99242F60431297a4f487be427ff449b13c577475b45596ad7d73275408a5dc8131d)\n  , NZ (F 0x01f1928f41c570b03F8aca1d45893051c4a5f6b0293319c865f6f5a36b6772672c6f706c7afa4fb735caca50f297bbd81a38c0d79ebc88cd55e5bc2137Fec7c2e9ada5eae6df4) (F 0x440bc0fbfc6250a1f5064e5dc936d65c0eb26f4a3afff70fddc1d38809dff2a1e29aab357a7b069b84b55babff2f5bf09e596761943ba30acc5e178e22bada2359971d1c5a2922b)\n  , NZ (F 0x6ae9b8059af8d1903b8aea8ed64cdf2c0b242df04c524b6c99c7f72048d3b392a92f711ebf99940e00c77b15ebc6a7f0616e49f4cfa491669973210aae4019d7a0664a67f830307) (F 0x77777f4056142b8dd8e7e83b1d0a0d28737d79de8062ec2c15e4d53d1f34aaf52f7995d5a15c585f7d6e1c38ec5f1ffa05e9c2908d736c62627968eaf32a43bfd5b719c34804c43)\n  , NZ (F 0x0bb62254bad2F02149b66476ec521109dae8995a034cc61c3aa8e6153838ca797836b2537fbca1613b091aa3f34c34c7d4def6b46cc8c58f48f7ab697527db4eec326756f68af8) (F 0x15a37aaa9167c4e615a7207487e59051a5ec7ccaf19243473f309e16923ae3f75198e9f832980d124ca74d43ebda98e796e467b49214e1a80b56ab8b3350f48e68640fd5f565149)\n  , NZ (F 0x410ff375444b20324aa8d8947f9a6955304f209ae0a820c49331a2f2eec0194e512882ec08a31757df41e3390000afaf4e0f00eb58ba19e9b5839871b2a1de924f068a098a5ad77) (F 0x4ceea66d95dFd0cb64a7bbd579eb5a1ad726447cf6854d9121e44686c23e5ce1020f819fcb4a8b9026d17ed6a3087845bc31120fa4cbb772b38976982cc9c0429b36dcdbe92e10)\n  , NZ (F 0x13910ca36c46ae1d59a68d78106e155f0fdd88e4e99ec4230815be48c8ce242f26f5ffcb69461933cd1bff8ab076f3e3aa4ba619238e0deb9630a1e5ac32ec8647f0be8ef36760b) (F 0x3cc0ad99b00ae0d5ddb5c4bfd0d417f04af2c1a9c341856258388645346d304e8a01606af5df86cbdef34d8da71d6c03cc2719ba830582d6ad5878a675bbeba37c748073d5eb102)\n  , NZ (F 0x00c21f68c6d3e45428ebb6232cc1ec2485442279b8ce1734c28313d959b2656f5343594ce3caa01d2d5373d02e0bb3686322b9d5bc8cb3db7be2bedaa77e873F6f928bc66db76d) (F 0x1de6524fd03c659bcbddce6d0ce93a44dea9e568af6e0378326da0cc5ec460d8c108e4ef455b7262dec0d4379373671bb3e9081fb1dff93d25136ae19051ad5c10c1e773b1287f3)\n  , NZ (F 0x24a7a5f06500a8eabd359abdad8849b368ea58c26be0be44b495b04135b2389F1867bf54dc81f43fa8aaa00fff7dd5e65eaadb4211135484a6f8223828820c97d995cc16cd1351) (F 0x162505fb54377c5e61044ce88f38baa2b2085021ac55fbf80bae17f60a8a37d9f3ec97b6fd2cadd5e5b74db9642eb0be4F7d31a14193747d08fd6c5537f7be4ad96718cc3aaaa4)\n  , NZ (F 0x7af5192f414f7a887222f566af539370baba86e05a90f4509ece5c080abb1cf6b5c50903b34b762b2e62edb3ab82874a5038d663fc60242fd84638f54f3526d1e89d299123f947b) (F 0x0fcf5048464031a9a1e0723a5a07db61ecf6605d654d7e351fa6dabb5331fba6ae4b4e4fd8c7a6e15076ca1b340c4a3b0bed162dc226e3e16b1a30a4b299c5cF50e2b8fc539254)\n  , NZ (F 0x20f1af1d3072307baf4c12711f8231d9c8d9f338b5d671097b02dc413d447ff418d92aee763b778f089c585950bf8b26858b4bfc40b71357505c2df8f919c0f6a4945d643253107) (F 0x313e7302cbb79f922973b7e4d17a4bea53b4b7b7b9c47dc4d0d2d577b0aae466b0ce701a9f4ec17d1f162a66da545aef47b05642ebfF91e78c36f4bb7f7e0cca2a33dab224c061)\n  , NZ (F 0x67797c14db33866e1cdf62e8263e8c47b8629caf2a2be0f22f0b62f823e885e036caaabff934470e3d2ac9e5c687c64d7bca32a4da41b2aca64c5ccb78c9d4902aee9c8afb9860b) (F 0x50751285d62000916bd1a49f9c78a207a6a5e56cd0522f6f24d993287e17b9665f9931798b89650bcd449b17034622a83f8eb32f5a858c31cff9b8718fb5e6d962cb7a249becb11)\n  , NZ (F 0x1138fa25a54e2c00d3ee489862eae2c1763293bcd1e498c7bc3c8634ba6959a8b13a876dbFdf60282b39284b084c688986cd152ac651d7d8adb9ecc08cca9ed6272254faa9f1e6) (F 0x1a8725f8cb4a6dfd2c2276d7bb1a8e682c0dde77091b336a5f19ca10fcd5e9da787Fe2317d2eaa5edc8b0bda38a8fc18fd49b8c7595ca04a5d563dF3a517895b0e67a0033caab)\n  , NZ (F 0x13015e1b9da7b781651e06849d2dc65075ced0172bbc4aaf5ed10ed22c5ac8c3344666cc72310d31823622fb6e313f357ae6fcda5ee78fac5ca3a63aef2cb357c64e3e5c91311b3) (F 0x1f08fdd1e38a449ff61ba14bdeb7c1ddac60a58edcd243fcc728b37950d8a1aa6cf5791db051ecaf3c3858919ef897cc6ab9a2eea6ca793c01850209081c940d7ce4657ef593445)\n  , NZ (F 0x1ec187cc156b7b2ed922483282aa19ab74ad23c49e1a1c805d4c822888691a83db14abd0d62ef8e407c89e7d66071ff7dc1d1a017e418392ce17328c72544e8af4c15560690b0f9) (F 0x2fa1c08243a76313287499ee4b5e76aeed4e8b54873387c6175edba1bf56076b7335590dfbd7d415157eff83a0d8afaca0bf7e207ce4956eb126b89616f7b92e157d912961fd60a)\n  , NZ (F 0x26646b2f1cde882a65b4cfa670dfd919c04e748cb46e0b969db920ef4b897943069445eb08636c5a89af76e7763aa6da853886a55e3908cf0562a88c386b72b57509d3f31c32467) (F 0x75a818d9a59fbed41180132b7bcc957eabfd9dba10818c87fb568a1055d666f5aa0073a88109c681dc9eba0a9522a5080ac4dd9a4c194b014af314bc483945e98868d9936eda04a)\n  , NZ (F 0x735406f862050680b13017f0da92d0dc02b41869af754ad27be1fcbbdc93897a0b528a8a9c0ee60aad62b0e2a504ddc0f80e0a84038270c10a0601d7ad40bcc51c6f66fbd8361d6) (F 0x140fb52773660ccdd78c3dadf187745f31e1ac421d71649cf6c96fF995cd166659b14467aca8870185a812d79c7f7945029dcb3c4decc6707821a284060191809566e40b05476e)\n  , NZ (F 0x5Ffb0b37233ed52068204101c41de6cf0587f994ddf54488875f3afb6a7e9d8260b9795c452a051a3d3c41dcb00b7cd153df45ec510ab3bda134deac7711c8515b817875fbf494) (F 0x494d4c56220d7dee238e3185c6b02493faf246559493eda14dd0debba26ccc15b02e3beaf4d098cd32360c349c78ebdc0de0d1042c7975f2932081a747390efd6e3c2695efad852)\n  , NZ (F 0x7eb719a101ddeb132684586575635a93fd43d9ea00f5ac8558f0e93340893874197264f0a95ec898343ec5977cc1f6d2337dc8c729213f7ed4626624fbc779af416b3a1330732b7) (F 0x3301303b0b9012336c1f077bde916650ebe7b31e02f139a781fff69e0e45e789e0ef30a4a778d4897ee578ad30b34e11fc3b61ceea40e4bfcef04252723937a85719d5257118998)\n  , NZ (F 0x716392cbc2a12cf3028d6793dafd1c37881ca62e5fbf5511a2bbc5b533c346cd03f9c0363e334c325af53791c3ac9e41e9519b814aff71be00e2cf8a1147459989b6dff3dda0d3b) (F 0x7d2b235c557e19389d8439a5e8fff4b5b7524de2b2c5bd0e5d40fd894014d4aa3f6fc503ec07ab72d59bd3198454ce9dd6c7218aec801eed30bef1882e0ff42bff7908e663233bf)\n  , NZ (F 0x2da1a9a76d28F1e3b4f30240ef33d7661acdad1525d11ae974d5bd7a2a51b0f46e9d1F8397c48b5b4ce66e6547b1991bda6a0845360a05821e7a073be78eff39be42b9020881f) (F 0x50233e496e0054b8dcddc1ec227fba7172e982753391102f577fa875e3dbaff3918a4fd7c6a3efabc3611fbce63586dd2f38a0c4faa773020356ad3d76fc0c9dcb6baba331F365)\n  , NZ (F 0x5955ccb7ed9542a3a668F8acb11244d5251547ba3ff6084a7cfa201118f8Fa7bacf46378488b9fb50d8aca0ba610ebc51151d322d4359d088cb77c061b9ec8f9c1c439675b373) (F 0x1e0c9e3a93b85ed74f51baca6c33e300bab67ad668672147572c623e9eabe6ff8af3df8909a97a0f56daa6967533dc76fF7377a490533eF47d5dbd02f5fbabe587a4227f3857d)\n  , NZ (F 0x1d0f4dbd8d36823b004f57fdeb467aF2750903766163835c86e59864689732e70f3Fa1e88bd0d12fb18407f208ed5df58909e93ce574cfb9727f075594b6e26d037589b44b2db) (F 0x56b8d41ca20565555b5c6afb4d8a1478760179e31d72c8773d825a1b85799ff7bdcd00688edd54d4a82df342a4fae4973ab2cc5a17ef65fdd3ec700d0362d8e3191266e0ff23f14)\n  , NZ (F 0x0e749b21d2b7b041006a8f1397cd8532bc4ff6d148e2981061d6964fb334d33d06bb0f5d0715bF69e04cf76091f41ab3c88bbc701e2511787fde965c282e7a8a3605dccb325048) (F 0x4197a688028a93a78a150cb8986e7743e9c655ea8e5e7385e890d3b9034279959b17be0f6ee79a6290f305f8a1e08e618ef0ca5595ba02ef56242dfdbe7668621db8728e059545f)\n  , NZ (F 0x408f3abf6e7d8a3f7fc1d35bdd23cb54527023ffc2e85097e4b363dbf114cc0faaa88834f72e93a35b4e4b42be9eb39825a3325e609f94dc2bfa1774eaa80a8ff2a0F9a47491fd) (F 0x6F4d54cec591a6e5bf23ac068b4ef66c792183c16a05ac69a967c7f10b1378c9defd33c040e96b04a00735cbcce21acfFe775af186d4e4bee9ce1a4afd5c04d1f463a66b42e78)\n  , NZ (F 0x11c2238ec9348aa11d6b59763Fafdbea15b2bc84324daf3d4d781bf9f8b9371a67da089b93f81d6c8dfbdf1454b8af708815964277dc407F42e30c3834fd735d0e85d2387bb0d) (F 0x07872ba50d77a7f037d308bdc18a5b9f38e7f1cc937d105cfc8eff5219c3d6d638c773d44503ef2a18e667c4f433b5469024880630df34e431510b1b958203e21b3cda753d6ccb7)\n  , NZ (F 0x4bf3b063c8d54be9453710b5036c8fa60de0cfcdc7adbda15ce5a276e4f671479faa1e41c5815caa06ee5d48bcbb4c96d2e9334f6f085a11d511a45cf3007b15d7b3b71ffda1ae6) (F 0x012205d31cb6b361060bf361c4fb036291314d02adf00a73ede41159910c1c8c654b0984c800e5eda2d1a99733583df87f501d8e0F51647e00dc62aFe533dedc2afc42f10d40c)\n  , NZ (F 0x44e97b0b5023eeb3b3048f6353ddd953f9c12d32a5712d901d21104285f3707a60c35aacf0d863efd3bc5d0f59863e461fb7c6ea1c6b6c9bdb5e4dbdc6b9f43627fdd4f78d95ab0) (F 0x5720f90b42530f1be05077d825c9441c982e2ab0468408bfc9bc7e5f4d84f7ed7507310dcadf76e7b3bb24833cb4ef3c5652dd2bcd88e5040e8c1a97951accd49bd6502bf0901f0)\n  , NZ (F 0x7856987ccfbed5e00cc490eeb15159d0fbc3aee0ef25c1a43d69b1c62413275c79a20a26cce9eb08167bd207912aa8417230692976b2fc3ff9f287d69183085cfb27c9a988a31f4) (F 0x737b6a64a08Fff264dfde7c3edf122548cfb62942c38402c4504a95779cc4c747545d9ecc552b011e79daa1d09370b9a420523b63bca0a62dae7caa386cea13b8fab4f44b49f1d)\n  , NZ (F 0x6783a6b938ee0550944c1eF8cb83ae8155f9cea72df482cf5205eab1a1a8d5bff78b4f9e16cad8eacFf95e3f7df96f993991a19974e9ce916ef21b74e292f8c751f6d320c28f6) (F 0x606a546376d1dac27e56cb1a35e893be569d2df7e50289eedb36888146a6cfaa341c712042bb064ca66252287248ccb186bcfb4c8717ff22781efa5192dbc8cbe6faccac780fb3d)\n  , NZ (F 0x792b51a70f4e455d16df41933793649ab1fb9115a620d9194e0bde1c49f4e73b2be34069b6381cf0a32d9e7a49e8a9b54688063caF7f49a6123609bcf8571394cb95c5345bdf85) (F 0x4af476d42021943813f469a3ebaeaa55649b6af32282b7b7cbf88f0ee3cd68be3c69eb5718e54e65f799f99e7aa99eb9d5c9e4b2021dbbf161ecd92e2c321921a476aac0cf6f5d8)\n  , NZ (F 0x350372a65c3df3056b12a719d18f97cc73af72f1226f51134578834455354cfc65c29aa04aeb8e77c30e74f21f75301126229c06a9f872939a54b693fb626dbdf0fcdFdb394da4) (F 0x0006042d5d714f59ac7489f17a455d250bc7bccc6c6b913f6004128964228eccdac87558d3d7879882fd6d85348cd8374a06790535f2344e3d22c7af54098244f5ca6065312e52e)\n  , NZ (F 0x7e5901b97f1d18a2af0b748aacc381afb181e7c900922194a7435baf32475e1bd4d7b238Fb7eaf2e06ac8bc296df62fb0d081b93662b648081e0089e36668b3ac9da8c9a809118) (F 0x5185f348708462cc67b76e35cee61c611d00bb9898ebd3f84f81dbbb8d57ab9053c9f1be7596b676695007bf4f3c50cbaf6728d6ee450a7b21710a3abae38d52584225bd0b2f979)\n  , NZ (F 0x781b476fa3880368b883b37f045654b880ef70cf3316da40d9d7a2089ee37b03bfd14cbbcceb0c3f83797d7468e47d5737ffffa847af09165276513568eedcec3d4c7752a428344) (F 0x4c37e5835b8a1580f82ba115bf5436d28e324cc2dc5b01ca67d51497217a4ae6c1a1e0ca38953da3965fb905aa9c9aed9da9cb1e38bace7c6c34dafd0F7de8216ad36c8b56c291)\n  , NZ (F 0x030a9fd1e4b6a6825dd5a54b9c57dbf6eab13b644bce095d1bd823a964130c826aa3b8f99bbdad3d4c90a0da9b9a46abcbee912680c0ad82ec940616Fe30080d5682ac44b0b155) (F 0x4426c675f4eda4f2df0990f0d847cbd5933e6ff0cce272d36b9fbf142f98903cb450d8595c1af214bb27f8a27d8340efab15ddc8863aFcc986942dc05c3ab891fb45b645547cda)\n  , NZ (F 0x35ae3d8227d2f74114c219e233e0f6511b8574f2266f6153a4744f7b85a99659013cf100623f9c2e68a53f0289995b9c8e77c0412c3791d95750b32d8F1401806c928a3faea4d9) (F 0x51dd701e3fdbbfff370e48c5aac26f3315fab97fa516f502c2231f16a28a77a2328e603498a071fc30158cef0b220e0fa40f5b16d6b75e11ca6443824b2a0d3403d20144641d862)\n  , NZ (F 0x1056ec4552fdbbb27707c742cdde4007f3983a860ce1591236569acd42d1d71d1a7aa2cabc0491ff86728ca61f77bd0171e61366ce70bd51c4d299ac0956fddF6144d10f5d67cd) (F 0x496b28bf3564c0d4fa1ce1750a91ea37bebc228f1cf13c30bad2ba7de0fb18f50aef7126c097f1467dc904c7cd5b189ec5a9c73b69c7579d05f0658cd68dc7d9f9c4e133f55696c)\n  , NZ (F 0x798f9b23b5c455a492f7dd76e182ca2d35bf67192c2b84a0f4aef2d507bF4d41491245771e8cacc08950ff6d391a9bd92c3a2e517fc3ae0097584f2f8aF6d843e804cd313cad4) (F 0x3a387f0f903024f7c4dec77cba75306d3ddade2327be81795f6f89399fbcc1f7e05903f0f3e50af9c86a8de9631ca0765b684cd6bb0a6575c5ae9af2ec156e5cf258e0f7050744d)\n  , NZ (F 0x71df6048d286c20dee73d0152ecc63170391b6303bd962d1254fce7468269d27b4469521f4275f5568a88978489d1784caf88fb6a87b64dd25a034176a17d84992c49248266de1c) (F 0x14b4f041197e9462f1b2b16F91b3df561db55fa350d3841c8ff9a7cf936e87e00a1b30651758a689336e830a7e493eFc666Faec9ce45219668d3dcbc20d8192815289d923605)\n  , NZ (F 0x4e1224e58a1282a0d542b9bd5208066a06f36a69e74a7a0323d284a73ed5a5c61c690197ffb5703f71167381f7F368ff692404abadeed4547080130d0287d8fb8126c57ca8c98b) (F 0x79efa4e5bc0fbbc518b01d3e42afd05507512b83df6e3d5e68e75df848b40472a930b0317b8e7e501f1021F2e166c7d5a928be68e52e8de779969d6004abf423e00e386f7e97c5)\n  , NZ (F 0x7821f6bea5f7a4f6978c831141070b6ef7a83aa0b85884ed4cc5ace2a81d7713fb590d962e03b89b07bb938f10c4e79140545fbbd72e7c81c16f02fa3ab09e2a025ffb57cd4a7f7) (F 0x31ff04906fab37aeb503ddfa0c79dd2845137d22bd245449b68460cae6259803904f934eaa2833ad906ec3a7f65a10137f994c6ebbb9b26a9d620016d8676f83679e3fc3a1569a3)\n  , NZ (F 0x7276937fba7d0a3e382519ffb5b6d3c5d83c290c0cb15ef83ed6387dFb979e9ed7a3ea4cdccb3e53087ea8d8bf9f230084f3a785de22221d6d98c46878594639501f3a44ae6617) (F 0x48a09974297cae8554ada22f384b51da75b81add433d2caf0c106f84199087a6d2c16f546998588ebf4896d01350f67cceb24f2d5cf571bde5ab015c18e60ca4db643fbb552a717)\n  , NZ (F 0x637754993878806724e59392ce7F1e2dc50af344635b51423bbc09ca123089cbbc167b2dc1d1440d15dea4605062484c19114c9e146256e5b679ee5da9502f1dda662ab0bd46d1) (F 0x2149e5bc5435758f39f35d809fa03a4743ec62061f91e6412e392a56ca35298e32571953f12d2859629e59beFacc025a440d2a74832b0f605cb466d5d6ce27d2c7cf242Fdd8d0)\n  , NZ (F 0x37fdb8d62aaa6319eafd07d235d49f6b37768dd9f5c908ec3290a2352c22e11b6e90ba94bcd78Fadc6580c2026e5163ca197026a55523530d720cb6482c12025c21d6a420250a7) (F 0x25f9bfd4d3645de7cd9aeeefa8a5842ebbc36c938d908ed54794ffd80b0e0f2db081074541b9499eab478ff01c14ec78cc166e9df31207f7c65e6aac3dcc7c11b6a8357facfc462)\n  , NZ (F 0x57b62efa507593a0e97d0943c0a2d823d1cedcefdb10d4e1f8247Fccc5ed9625d6ee543c28ae941f19df7fd225eb0413386431953c3bf5c0d66c057cb7371F36da539a3d453d0) (F 0x2F82735c76399a6a9fb477c1c580cf0dc25233e3ec11072d1d18a6da9699528b59333271dc3f45893678b16020f209907ff2f3ab497dc1523687c1d2e7a30c9b515a62b4d6c5cf)\n  , NZ (F 0x125b0a5a4b7e8f2608efaafc560a1ae5e030040db670ac81becb2bda4dc57781ad9fa65a566de587c8f293c65bf6f98c9cead2073f84079384305aed0de8fd3d90b886d1ea4be7b) (F 0x073d2361cb6a0051fcab6dbdf0a5b92540071a57c643a10277f95f4374c797f0d79b12b0e9175621a123086a0a8d03e173661c1c0d2d5f1cc081654a99ae10965dd7dd07b1f3ea4)\n  , NZ (F 0x5Fcb4de303a636fa7f96b32799cacd3943da5581262469a817b8ce3e6072e64e500360d9f45a7d7cb176b96f3214b65e81ff25abe9c29f897f40918b164646b2767ddf7da3c758) (F 0x44bf90bd280f29ec281b60d09d13c22f1987e777558aa474e1ea85da214464a4F6b8ac809509c86d2e3d2d33e6d7e9ac442c3e6fc9b745f79a35c01ec8e0b9355d48e6a6b9827f)\n  , NZ (F 0x61b42c569bdd2f5a41256a64ab6a3bc36a58dd13292e5514fcb7a8b2e390214df876212724ef735ac35089b458d1fcac984cf38ed2eb5f46f65ca7c035859a76829eda2df0879a3) (F 0x64f3c0e7c42eb219b8cad63389c45992bde7215ad8411163a5e936c109ee2b130f2f6fc616e81d6d89e8c1d9e69d7b76d1f7acac1bb5819fa5583e72109c65c500576632bbbed1f)\n  , NZ (F 0x09bF975bf3a64bff4cfaf9bf978d0e53f6506602127931b239a3c6b8a88872ef8ef2af068aa9ba7544c1534a571fdd504d6f59cdc88dfb71c344a8ff81d56Fbf74ec4e38cc082) (F 0x66140b9fbedf560bd098a4329a114f0c45fd076a2f2cdaa5a020099bF2b0106b202f01a8773cd3da682d0232c2bd6f13cd1e8a559490a6d6758e0a10649c53ac5e507b993ebf60)\n  , NZ (F 0x237b21e5c8943400f158c7407bfa03342ca3644ee02ebd8818dadf96ca961dcbd7d32b377a816bf7f6b24f16b76a80345ce9a296bF67ba961335b67caa2eF9f14a0ce2730653f) (F 0x03876c591b05a44c39994010567b924d29afbb9c31adc060fa1642a5fd294ed323d574b746011eb0f490e6a8175d0c8c329a8e652d2af7140e78c2b1cf699c054e710c1664f94b3)\n  , NZ (F 0x2bcdd69de218d8d4e9ebbbaf1080149b02d0F64f7f16217c08d6235f5194c4dfca2ddb497f983f85b50ddbb23a71b4282062e7bcd165b3dda2345103efd07dcca649841a647F0) (F 0x1f57d7f2a8b3ad7e3f4f7a06aa11315cc5775e0f971c1b2f8ff9184fc24860253065f82377ca4f5ee02beb3991cefdaa7132ce63f5d221f88490198b0F8082375a04269a4a4a5c)\n  , NZ (F 0x16027c7493b1330ff9e4a198b6842154a594063fa56d008f1b1509471784aa5ac1d3d9cdcc0e25decc5a0eaa203e917ab87a440c4015fa999c19c3f1ea63e0b5cc59e9bbb75823d) (F 0x252f5d7381845b0113134e92edaf036f6a52c83465819cb34a26389437d60f8b43d09a6f3fcae6573e1345c226f9031c864b64931dd759b41dda10e3c0d2971c0bfb2adf898ff56)\n  , NZ (F 0x3d51b0182eeeb61ab94c0d99b3e5b9cf77db47ed83741490c64053ae9360f9173191cc7bac55cfb08e4034d0cd5e68b4be51a3a0be03625aba862400968eb8f6ff7f276087a6c80) (F 0x39f2588e130b113a4f6793109badb16709d2c540fbaf56e0d7be27befd9c42b74f8fdf8bae011d2a36bc93c3c8c295b07cdedcfa37887298de9d7217179989e59a737e3e2bc23f0)\n  , NZ (F 0x45bdec38f3ee2850f591628e79422abad2326a5c3fa8da5c635e68c1c218299d129253e8759523adae06c2442bd4b4ff1a8816f4babd73f172c767c47bf66d0edc037466fcaa93e) (F 0x782341a1acf611583e27c83a9418ca9dc03bb5d8e7c0facf13f8a9227504eb23b617502f8cbb9042a7bac46701ddecc2e7530d086df75d82596c3b42e4190414ea7b71d125b7247)\n  , NZ (F 0x143ba435cfb725a0198542e7c106e1ece6ba678fae0e31822b26a4e4bcfaec21a4e5a476e9f7a1ac1bfdae393147674ebe069983f5bbfd7f829f9110754e5693b330a5166960274) (F 0x152552bd336075949de4abbb5b517190bb7af62ff24568c02257567536618f5458f0798f74a3d3998e81642d6efa7d3a0001b5abf633a64b03715ee749551924e0b74f26c93d334)\n  , NZ (F 0x3f8cc155a8251d78b2d12ac5e0a4df878fb7cb59c2c6cccb17599ab7e857fc48c12a3680344c7f269ec0a45e504e12d7236bafa473415c4c4b8c333Fc53d892fc54689e27835e4) (F 0x6633e74e9d8a700ab0b5b4700c2006561d98e245a25301b13d47ba453eb733409da02b022d5c0360a77507b3e2a77ba37dfc78e895be6b551697cda363aF56ace1c771ca2e1c19)\n  , NZ (F 0x4e9d070639600319c5ec10b86daeb205677ec2877836ef62d7fb82b5316d816f2897e142165606bf6fd5122c40c701ff3d001ff1af6888d60525298a9d460d23e55c547abc75161) (F 0x5c1334c7849e604c423e0d50caedd53697aef0d90f6c272a6cbde7f1ca155222ec466e4c5df7015514d473419c40684735702578218ee5a1f622cbb46727fdc94c08903dc448399)\n  , NZ (F 0x43e32ca45c5904ccb9dbe93cd19a9a02a869701f61F3ea6aa1d56cdb36eac1601f9c630b1e8e2f457b3fb1bdd210db05f577c73dd8fc9831353f3697de7534de05acb1962b8eca) (F 0x52bba7591156fcae4df8175966b317c49711d3b9d4064104038779814668bff9e6c5dfb2d4a2200b2f4dfcd7816dc9b40057f520a1b7058f55c296663fa332b36b8245a7c514bd8)\n  , NZ (F 0x3dee000784d12f0d8fc23553acfba510d1a6b88e02fae1c2fbdf63e38911a8acef8b360b013b628549365c5307962f854a048567f6cd3f284ebfcb68dabc95d8a268b24d543cb79) (F 0x11e3e4d0a1f9149d04f82c5b469d7d1f9d4bd0776537857875ca3a5d534d2c3dc4e1e804948a80bf08019152d7e0534847d75ac366fdcbe89df75108c41dfdb29d9f2f3ea6aba86)\n  , NZ (F 0x7c9fff7c2f6cbb152e7092e63a28d32892868952b70d36f0fd07372ce64286b2b997f5b8616bd9b9b609502c8c29a77701d945e2ce2c9f5cceb3b15d97749f8f0668c82c0fa79fc) (F 0x2b17078abc1c7892114a46f9fc8cd0168f5623e07e2cda7af1bc6175903dec78d7d685eb847ae8798cb04f132b5397957b0d5142ed58357bc90c36987946d07b800035bd860accb)\n  , NZ (F 0x653451de7ede21ef490670a0861b79b4c49a40cbb4d976c73bf474e53e2974eb4f13a56ae5eef077b24ea08ed1f77ba53151ce770c05689c0f5a11eb74bf132cf4424ce56018379) (F 0x778ec39a4d2f16092b6a28bfd660ced9f31b1c28a9f00b99cd6c8b4ae75a958fca2d84b3f2861ccc00ee4ddead4051230d4154f35ffcf84cbcb86150f6fa7b3acf2e366ff2c1878)\n  , NZ (F 0x28cb1e3ecc00f03c2938833f19b187682091d8a3b02092bb480d9b406b88582e754c7773e228b50a5460e522235eac98f8a64a7b0cafb2307a06c2d9722360f8684171d006d2a50) (F 0x68d4fc138223f4Fa28b85beba48909c6a7a4ec3243268d76497ed6efa19b316d52c5a39ca0faf72bbb633382281daa9f5af443084e15d824d40fc39781492390b19525840edca8)\n  , NZ (F 0x161e3050562b777ebb7fb688f53459753c094cc71c181d8ab5254a973f0007be9bcc7a2b002de54b60ddc682cead6e973aa48f0a0c4f08bdc7d5ecdee63b767bd635ef82b0d78c5) (F 0x5501e156c9bd68a3d7737d9af2cd7055a77f2705eb172b29dd45a9b3d51b1d12742656ee45f895f113c0c5e08e9926cce92ebcb6091a2c54cde5ebd32958a50c14c1a08157b69a6)\n  , NZ (F 0x2524296429dd09a84cf29e00668bbe0a1ba4a0c8F39e4291b33dd77c84682e1b55d8728169458a226a8430ab995dd74ce940e55db50cf4eccf217d784dc2404a8b262489935b63) (F 0x1566b9d5d6b54d53120b07c23756083f814c60166232552bebc64e9723eec5e46a3acf9051231159cb1098028f483277b3c6447e93cdceb19656113308ad7801a7a3468ca7e7351)\n  , NZ (F 0x5f676ed937b1d677997e431622988f4dbb2b2ae70a99837dcb7470043ae639c7858cfcf4dbbdd8e3b4a15eebcd5d14886579ec009a1665c33a22a3ff23d450e80dc0b1e7b6fc416) (F 0x3db38c083afd8676e52586c7ad3a600b80ccb8f2d6a4724991278df3b92979558bece50321cb8500a9b4e1c02b231ddb35d711937ef1e0d53b2bf8d0e1d536bac4334555a1e5f33)\n  , NZ (F 0x2c47e9b5ac9e35d2da0301b29c516701d12ab3b52aae62c4adb23ba13981e09c01428463f68c3affb8258067ab28fb0517acbe72da093d843e186810261697907ad2a464cc2d564) (F 0x1e2a794420206609ea5fdde9e0b4be52413d861da588f1eefb18229399a79fae6ab4f49eb2e2e25c6d02cfdc2fdc3aa770925f4b03a66a541764016f0507821dc995b4ac6613658)\n  , NZ (F 0x09f6485Fcefa6b7bb4ba5d3663135efc619ad3d810777e5d0c54f31f2858edbcb54a2d6783f640ddb9b89af343c2bc093a0e3c6576658963a91826b53a94ef0a10702c4b148318) (F 0x72aa0ed66efdbfa2811a88b25d2ea81a78ebd996759e471126487753b4e060abc2dbeb24ea2dcdbec3a148c651004a88f029bf7a11fcefcc3361d5693edfc95bdf43Fb5d67b4f4)\n  , NZ (F 0x1daced59e95b88b862da99941095060f7ea7d77f5582aa52c4caf259d948bead113d217739341f42478e20d306ee798bd401b25b6a5f516ffbbd77d69ca42ccab873ffdd4c2756c) (F 0x0fd199301ba85dcc2dc04667cf977ebae4632c880fba072d7d62383750a36e9cd54be712a3763d670eb2175a002F51e2aea3973a72d5f7e2e10104dffa29969b6eb6eb3d73760f)\n  , NZ (F 0x3f048a7862bc0a8a6f3ef30e625eb08babc1056940261cd07111fbeFa8f7e0a183de2420d12ccd5b829e766b4d3ad40eeaf63cd2a5b0841ab10a3e376f83221dca054430383a66) (F 0x3201d3be301655504c5db0b778ab53ae7a318f49c09281e011a390e01cc64c5F44fdcbbf224807954424445f63806c5649fc3572a737bee8ec1a404e7dc4f1d2f8e3cf152da45d)\n  , NZ (F 0x7f83e103bfc4a65c93866333d11b9b5c0a741d92d145323aebc01c21d09f39993aa4959a4fc16901ebec218ba13a5f036ac0a7d982d1f93F2e22b749a2f9321f4706c399d537ce) (F 0x112bd10caf88f3c9704e471ae79f9842832ccf0541d403196c6234abb78d04123b367a30822e75f3b866c59fc291fff123b5964352199e9b71b9c6f61ded85a1130359bed8467c5)\n  , NZ (F 0x50baa197ef799a1a7c5a6f1a0f986ef980dafdc4371dea72dbb445cb0e423e109228aeab285cad460e44be193fb80cc0e2379d79754906559f62df279f7f01a996a770a494e03b8) (F 0x088245a3854eb650217b214e9ecef59181a1214f3b0d13361370adbc376a48d30c3ff51244f488694746729cd88fd325f7d24c69fc3194dd6ce5e4038842854ff7580fdea3d177a)\n  , NZ (F 0x0b8176664a1bba03a9a2f6c5d5978dd349169715f8074387ab813cbb8e8b3fa583c542f0c41b84c4f282a91182abef7cdd7b755ce107a76ab644f9a6a24eb5f36b1093d28de0979) (F 0x72f972f4ce417e9dcdabe29850ab622359a34e5a5e72af336924e695d2e9429a0889160bde705c1f29d80cf979658696e59796becd1513c29651e67d4523a5ad60605d7ab42324a)\n  , NZ (F 0x67ac57b949dc455d8a60c2b02cd56c7f05429d1ab010edbc80ed467492c606c15fd76b9a18e823719227dd81eb2d8af387198eb4652dbdc758f342f156ae35ec247c59de3894671) (F 0x19755e7be281c056e52f435eee30b86cf750311c63dd4dd7c9f00806ac769d0f223c7bc7e7e3fdf1edb7eb8715e95e65ced7915d523d6010c57fa3ee85a4746d7a36016564a6108)\n  , NZ (F 0x34452253804d272516b68e0801dc1b689b03d32ef9e8459f2c06b2319007135c644c8d57c937e46c0a45701ed169750a1d39d36566fbf6ef880746040f8a04be2015581cb6dac7c) (F 0x254358cabbe27da1d90367b0e03b21935ebc4de5e84963ab392f3b6ad5b1d7820b0484bb35756b349f4067361c554086b84225ce5cb3ab86ea5878d77ab3264b460eac290d77ec6)\n  , NZ (F 0x45410ac01618704b9058ce4b78f2023d63c4a2372aa69313b77c5533ae5ee8de5207c5880bf061109275c4d5f8177ebb52bca7c53d8f6a33e19ec1405275cf35686a29af70aaead) (F 0x4c6387829290bc7aaafc74bf50432c9cd5fd6d9b197d7c63d75e2e54f7cd67fb6084e0e0147cc95e12ed2e3e14ec27adfccf79c65faf5a03b18219d5fdc49b998780c9b51b78f82)\n  , NZ (F 0x7dc826724ffdca793d1bec7c462e9a9c9b92901d458abf216333077f6d10a0e3915b7f08a05de8696a65283353a4a7ce9b424119778692c24094ca3efd6a5f10ec1a34efb6d425a) (F 0x0ce3d664fb66b023939b993b14bbf240eb8b2d5d8e8a8dc03ac628a190c49a50c6a20327efb0676afc77b17c610e4b7a11648037468babb9f403ff51f13d090abce02a16fdc567a)\n  , NZ (F 0x479768755fdde08c1175799ca401d5cdfb8b60572256e03e99d2b02b31398f5e8ab4452e7fd851b86706a12325c7b319b680743941b412d63e698635d6a01032957d05eedbcc7bf) (F 0x734fda15c4e898b3c3160367486803dF93e233d850731193351d91ce5c4397b9F62a4a6e3b19107587ca2a4d79f49a344f660a8bbbb3932d30f51d82443c29d2635af7eb2577b)\n  , NZ (F 0x6c9ab2d1fd9679742cef39e868c450a579d62d02b65449f5d0f0b71d2f54e8a25431e961222b51763bbdcab3aa04f2a862a7c99d28e9c14eb7f30dbb4f4b7249544900cc4967302) (F 0x1887b5515960a90ab8d0fbd7e38f10fd03b69f1aef580371c0b4e653e067662bd7f7d60be1cf8ab2c1e9c49ebd55e12f33f2c49f00416309572d49c2b83e92c292653ad02a635fb)\n  , NZ (F 0x6f1b87e64c4417263a4a041b2772108c93787563948972e3dd60c68378ef9a278a5e44059c7152727608455085b17245b6272ee6e9efbaF6e240e18445853141707bbdd7a14cc6) (F 0x48a562cc2621409f599aa8c0659ea1ed5deed33e96424256d298f8bf1f5d9be6096e9ea16f8Fc8228835f69064290ac1403490638582e3016eef9a77037dfcf953b0e02fca91cb)\n  , NZ (F 0x556f192acbf99c485c5d02146a7996c11d5a8f2c4b278a5ba98bd7b7e94303a275bf6cf516239c2b45a03b14495790aaf3c76616dab067fd17a1c5fcc66bcf91783e02b5caf45de) (F 0x0408645aa01fc6c0b7b8d08c194ac51d0ef2b9e4fc14163d2863440579428cdf5a794da9715184830fcbb62bad5ad6a5bcFbd7281b7cbfcbc9f6682e390975331f12ba482249af)\n  , NZ (F 0x48d27aF37db0447b7a0acefd9c15caef8cec9753bf63ea4603fa1217f7e11fac7ec211651079f57854b40d73186111a7e17806abb9bf7e11d0a24cd2a618a35a866145511e4e0f) (F 0x6a2aeec0dfd14200742ff36a7210eed6472ddb092698bc527c365d1fc39955d39db028aef62abbb799e9ae89a1d6faf9b8a1b22ffb223Fe4b775f430eb8ccd3a98c78290e74f21)\n  , NZ (F 0x75a9c657a91b1304bacef1c038f69882c6361a28F4125e11bf5ea5b342b014fbf6cbfc8e5365b8f7483a46c4849eaa58df1579e2602f8242469687c4186e6308aeec2511b7527f) (F 0x467adaab9ee578686cc89188255ced71c1c9bc6073ddf4777657f7348475e6ec6652c226d63a5d6588002c3e1e2576713c0b87ea14e1a6905aa00fbae368cc8b6f4a81381644505)\n  , NZ (F 0x3dad0dc2c31a69d9affa16a24244610b27575bcdfae7ec692f9dbfd887543685ee2250cd6cf6ae129e62afa9a927c985cf338b91cc49f1d26653d2d35d4f340df580f0125ffc1d5) (F 0x0dcec85f02ab563dcd93f34c41b17317da35752b434e70b22675f8d85d519ab22a3f9a145294264f453dd157b557d90e61efd6285995f1ac99c0610b9d4716a58dd5fac50799738)\n  , NZ (F 0x1d4c54a09ee13769ea4d28bd20ce01411377b4d505f9b4900d85f25070ad1bf29e517415e13155a6c50f26c6c215adc3b463639f9009713be137525c565547dcd0959519da6eaf1) (F 0x473c65e51c7db26fd2c3dfca21d9bacd55e0a2498a0d7cade67816e4913f2250c507301f611cfb091c41964630f86af7b0bd2fc53d577ec6381e9453aabaf5bcb1d8697c258e010)\n  , NZ (F 0x43fad1be9ba195a35a123dc773f5267c6798ba5ac761e55677d690cbee095a71a78f10d2a9852c8c83cc3b369d09fa23109a727257bb595500dc8Fcbd154b8af647d9f630486c2) (F 0x38895c5e99ae2c151b039124239616500d21c1f3fba2349504e5020a8b1f3ee266c0b810f4f12005ddec147d1b72Fd2bdec755020563bb4bec9F6f6c7c485f6de1cc5446da2c8)\n  , NZ (F 0x604c63c844dd1c9bf6fcefae418fb8f35077d304710a38c519b55d0564280df7e67da983f889713e8d4ca0748aff9F7212c4227aec1724cfa8a1bf47ec0ce79cb9f6552F037a2) (F 0x61a8124849189a09dd94ef821b7bcbc519ffc42b9114399886f8670946137495779F15a26fc9b15d71941980e064e2ebdf8c65e25fb98934f8e6575a37b5927a96f029f96fd544)\n  , NZ (F 0x19d3bf0dee17b4142b3f734e4e579a355282576e1e77d68291a3f4c09bd2a5ff81976a427717dbd5ea550af9aaa362da2923763eb7b1990921bd3d2f8f46902807a6ba1713f9b97) (F 0x7c216ad491c85785065fb731218146c06aa862c81b15909ad29f5aFfd207816224fb94831b8a0d6217dba6a9bcad2a77dbcacb81ccdf4523739aec2cc31f3591ad876c85804826)\n  , NZ (F 0x4e5860231a3f4b0bdc153e4f2ad8b1fFb86d6f484af7c83add6f6a1ef9e7175a8f744da2daf49F1388408a4660a4ab5137cab05c925dd40a51dabe9b23307880a7dae9a2f4e4d) (F 0x505f420569ba05a1486236f67417a0b100f69aee1335515ed971c321093ecb7a469b080c0e4ff311b4d4c6481b7f15a760e744adea7368f750b6817f2f314327a408055007de30f)\n  , NZ (F 0x76e56aff6b42e74a40766b3bc132b45b39c22ad3323f5d69b4d647002c68d8a9265a4528b0b8529db285963341e8f3e337b61a46e2ed19c530a88def96970eb3f0e7174e292c5a5) (F 0x244f8c168c7c1d7c07a038e32b9cb9a7e06ef0cf4fc42c9ee6e8438255657c79200703283ed338961c1aea61b3f70d94a9b33811a066b139066e92f02445aFb13c73b9bc2da29a)\n  , NZ (F 0x27772d2123c116c939f40ea5c6961c7b67dee138f3d027e0717ffb472292ae67fdabc1879e8186e95de1d413f31a27730509cd439851a38411773774b0b337474b32a7400c37c19) (F 0x4e1a7eb3e5b2e6375079d4953877a55e73a72c41f0d497e07b947e896177974c0b23998ee2b11fac81bc501b16df3274e8745a3acaa86a7cf645d947254aea7e5d5cb8325818f58)\n  , NZ (F 0x1902180be990c70aec771caeb7eae2b8aca01eb3704433b77F5ee47ba70c53c4a153b6becf5802c0acaeeea55a1e19deacceb7c3eb96b5cd34F24e18e173dfc84b481b6aa7acd) (F 0x03ec933a09816f2ddfa744e2d2d483b2df3b68a503c19b3442b7f113dd7d32e04c9bdff7348b459f5817411ad70f6a64dd1d844c8393da2988f927339a482e0f429010a575d6af7)\n  , NZ (F 0x455ddb601fabf4c6fc4ba1c9fb870abcd917d78c2e90Fa3f89d487e0ebe0156cdb9442b46dc9b1fdfd536aa41cead887f921403a224a1e35f83596120828a7f21a36a3fcb7fa27) (F 0x75040047ccf8a05169a6c32e812e78ff4841e4F15ce816d151328acfd69a89644c3f6e3ee258779dd869e9e8c6bb1f137606f9df9c45a3cf8040f94450d62890bf6683d091e602)\n  , NZ (F 0x40c65063736cf70c4cfabc33b653ae466d6023317573a59f31dad1d3d8cf3da3939fdc203a3cb267ea1490ca65b7d8bf1adf4e55d6968a124884b31cb06b7526b970639f3cbffb1) (F 0x0a82bf7195ca56ed0931405e8c747a89fb562f5bf514f72af06931b7ee2517d96a97d0a5b5eef274956f29918bb76a4ac76415cF9fbaa2b0c5ad1bd49d1053da33c8d15c096be1)\n  , NZ (F 0x4f6226c9303923f5614ae9517aa3c4cdd6bf52400ebe1da370ca36eb26948637765e17e6e307e1b3d6c351cab37ed25eb35507f945820248041349c6270c1273ae9d9698880bde6) (F 0x6b0612d55f498401ed6efa829b4d9b816aF76cc665c3ee2184dca487f0226aa4d1809cbddf6a10f344b948d334a4e3b35566ffd64b33be6ffc6081158ad0c08f03484ff6bc3059)\n  , NZ (F 0x0c694bd7c253e75f37e613e8e1a3a2ad9f7587d7bf12626e6cd600c388198003e8a5ff8a441aa95b88c6ceedb9f3dafdf2a3cec2dfbc675b6fad96986b2ceaac43bc3b0d934c042) (F 0x008d2cf2d3acdb227fd08a8636a0bbefae2ceF064d836fbfd258e1cbcd74ef0e89F4d9263F78dec8904b7381a2ac00de0a81f21c4a048a1233f323a928256d768f99239582d8)\n  , NZ (F 0x269fd561a967a2b955ba206338d4d85173bd518a14d8870ea1bf886592b3a9336e50a3e1c08ca019a4e1887aca76ef2d28cf89ebf3c464732f6534290eac58e01f75e262a784d6e) (F 0x6441f717e3d606a5498962a015bef453e11f1457c1e610172dd0aece71b2ff134719ec41457b3715654e7b617c9601829526b02811ec0d05ca0d242bde2d5943173ba4aa73426c2)\n  , NZ (F 0x5a6b0a9c20406ac4b605ec983446e7fa49d464a36f5df210f71f1ad86232aa54589ead2F529f5a44ec7ed68bd30d87f8875d6b8c78F93174245d9f6d816ac106fa30661cfc48a) (F 0x629f60ad346786c5dae6aff84e5ded7cfa142250b6462b0559c4beaa243402b39ca439dded754c277b6f21884ada82f4ebaedbf8164f8a106345a84a1e5867669b2aa856a8a8f93)\n  , NZ (F 0x5c780314dce5e59416049521f83774d91de73cc1de007834e712698d019b4b703c135cec5053af8f8796eecb2f36a46d16133496867443b6581d62aca7ecd44f6e0464d5e51abf2) (F 0x4d36cb65e9489091d4ccc38437c8da30234485918fb98cfdcbfcfccf59fd6817adb93c5e4e2842dbfbcf83233375c0f9f2d3173675002cbe9b343b5c52c9e042F532b0cef80497)\n  , NZ (F 0x6bf4ba11eb988a2ce20326cb3b4fbfa817b901104c884ff07d32741c8462bd45dfb2dfc8d725b997dfde90e8fa8f47cf175330792400b9b5761b5a4556749e06af59160241b259d) (F 0x74ecf0bf19925a1b6ec206f534195259da7c7ee1e38f7584bf11ce0fd23e6e2c6cf0eb7415f7d1160998b312a508b99de99d926fbe1b16e04972b9429ca1b448458ed5c5ae9c5a7)\n  , NZ (F 0x5afcda26408f24a56c73b782c3f6cd10a05e47e6a7ed211614a3979b8ece27268f7091c0f10c3e95cbaff99e0f08caf653ee64d86f553b4efce17e1db8110cce6dcdcab4f6f7600) (F 0x0c72def26bbbe7b31fbc06b877bc5551d893d53bcacce8457918c94c81352Fc9cc0cce3963c3bbe59cabefa65b21daf53966af16a94c7d213367a3e0c931ef37869cf6dd21ada7)\n  , NZ (F 0x054990acddee5b33b22bcaaa10149b6d72f32103591c9b33e2cd0cd0c364928b4b5efb2e096b8f35ff6019627716e9a6e553b05cb8e1563d8ebc4823ad1d0cdcc07cd9b22f8d753) (F 0x72ad4c8b467c1df0c4494831eb66d70845ce37fFf20d71011018dbb164a6f3da71b11080099fb0589d77036bb9e103f142b5e7ef155b71350bfa0ef5a2a84880d1afbf7ea658bd)\n  , NZ (F 0x0f0457ef39ba92e38a00acd2ff925f2b05ede4ef0596cb9ab8197fa3b3d405fa382197723f4d871cbb654c820d4db668e820a00e7b9a5976b2bc505fc76170f0415c7aa8c920561) (F 0x5c73027aad719a0af1f54b46605bfc4b1e3330c49d1f78fb77f9cbdca4d67be8d41091cd1ef46e15cbd7f963f5b606f7612953a7be6c5fcaa91bfccf3a1b8bdee282b5894285de2)\n  , NZ (F 0x38504fa99c7ed74521a09257145db1846487e4ad2f8aec99dc490d8393a5d278ae2a4363def022b646da0f832d1dadecaa114b06c3f654c9b37979fa63b2d8864195fa6bd8419e8) (F 0x7f7c3d45F423fcecf59ee2e77abab4291cc1e1e9414c9617881862c01c3e85a363e8d1cf966fc5de1cb1912d296d2057b236220879dbc35e601a0795ceab56cb91e339c60cae9f)\n  , NZ (F 0x5f2761d352ae497Fbf49334944af8fF99a5c6eaca618e400c79827aae98d5512f9a3438121d475acbbe5408423f2a10ce37d53e849069027c230c7c5cba19b30af7e11df11f12) (F 0x566c840460bd1568871d7364ab9b96dfa7a9193d9da692bb3a7987267b36d9ff4de717f365b22c1116bd35d166f159f613371645c9de16d4d86d491a4915d9c2605d2226923622f)\n  , NZ (F 0x71038f9cdb113b84ae4282fff461a9fa2b21f4c0a23a6503dceef187ddfc8fc50c171ed8313b74de81b988f0c75eafa987aa5640932a56ba207663789780f5a4d8d2f14eae8efac) (F 0x0473bcc49c6Fe6f9f9fbfc883483153552Fd9fc962a1f324817b18961f7fde81c622abb358c21b782740292a2b90c05dd4ea0029a90626462c84311c9562ec82da09be2f9abbe)\n  , NZ (F 0x58f8cf29fda61b8da53f64e6cfdd5923F477e5b9baddded4682f176146f7d9bfacfba99886fb9ab84d9ea7226e441d2a1a6292bc7b66a33af212e6bc9b1ddddd51afaf6b0dded2) (F 0x1cc5375fd8b6d8b0a4939d1dbe036d0e8da5Fc54a0b8527c6836172039ddc0062bce2d701f89a304fcdb9b3a87948f29ae2ffF972eb28db2ba49ce4f8e9efbe4a801a22ee64f1)\n  , NZ (F 0x3e04de865c35264b1ca5bdc5a5492e9e3f43fbedb6ffda353d3a4f5a59433e0665b5d330aabe5d419b936b3c58db50b2f5c28ed8e21fb7cf4cceeb57d974a28de60b5bdcac81824) (F 0x7068c65b5c8dee3983f06f61cc81709bfa1e40Fd0696a3bd37376eb2ae900be41f308b7103e6e625437db89a9820bedd1a9cf5857c7274a38994e85139c70fcc7b7c206df50bb3)\n  , NZ (F 0x0b7e74df6144045b9fdb1cb993094d7c05b85db04d3a69d4d280bc9923e7f435566ac3a6308c18c1340e254f8F3eebafc85d14c870b0ca20294eae1c7329c8a76427b847cc7536) (F 0x3da4446b7482437f59e1f476488487da43f9ad479c9ff6ccef6242724b2311c642583169a09fc5b9caf17ed1473ee9b098262e3ae11f09444fc80b67f89717799733cbcd1b4a343)\n  , NZ (F 0x3eaac2995465bd7e4e22b77f806a2228fc277c03bff28e8a0c59ea1085ddcc1a44260a2e502855d242413e6bb2c098bda868149422aaf5916f74020bad2b8413413861658bd53e1) (F 0x0cd912f35d6d906fd91482d51ade5d6844b805fae77f647c97d09352e22fb0be9f1ce0e563e32a3475ffd7ae7172c4933ebade804c2c761de63290edbccaed466583cFb635db69)\n  , NZ (F 0x24a151d37bc46f1a2ae932adb923992d00f1bdebb1b99cf6913cbb7f78cf3565475493067a299fb1387ed3c3003b313cedb9fbc328edb990951df8110aa355bd30858700751d673) (F 0x0a34b330f667ea7ab9c7bde886507c4d9d77aeb647d72ee769cc8c4d8ad78dd3da2e37177a347ab73d4528aade38580e260b6e1F54fa95c32784dc108fb0aa3ccb136fb1bf02eb)\n  , NZ (F 0x548a174af0717c7c9f50be69f0a91477e523cb59172a5a43267203da8b3e299523afa148e00a379b87d69b6a5c2f32d75e3b1007adeecf37c93161b8f868Fb2654b6b07ef83F7) (F 0x51e02aed5939c0bbb8ece3b3a8e6c4f4b862df72a3da859a9F14843a865b1838b2d2d2c550fba46ef303a2d829e5a0d14c3657f3802d63abf364452aa8c8ea1018d29dc8f04227)\n  , NZ (F 0x3836933e0024faee431f7b7c077bdc47c3a2a554ea43fab917a12f9e8489365aa1211c44f721ca63628d41022f929f577341729567f414fd0f0b21446e572b2bb47faef190580dd) (F 0x0cb8bde755f378e400a0879c331b1eba207503Fb506ac67f487e8e795d916835a8e34d427a97635da77378b74e90d1e59ca365a44137b70eb7e74c0395bd3f74f26855a45d250e)\n  , NZ (F 0x30cf5d3dcbd150c44bd18857abe9b67c51490b3745402beb4deb272cbd9835aa1a2e2c7085cc89ff344d621e9b1b56c66cdac2159a7a3075b87e5f388ed7401a6c405e96c207762) (F 0x2b8aFd5cccd96117f3d15a72efa8c26934890069414cc3dedeb19a76468762195b257d67c6bea4600fcdbb23a32cd8085f032aa60989ce398240b8eeafa23fb4135a03c26826a4)\n  , NZ (F 0x3bf1bc37362579c1eb1eb01f683b629c611591fc2e110ccf0de90382079a385b890f1ce95eba4f653a243972ded83d5d06662adcac7eddbc021607bc1d374a775719d9a2e3ae029) (F 0x06f09f3e7508fc7c0b604cf53a917ecfc57d9c7cfafd0166ce6f878a7ad4c26c622edf24a99c1b3021563828ad3291b038affddc10adc0e1ca246ea64af7525d8b234d6385ce77c)\n  , NZ (F 0x29f520ab7090aF4c6f3497eca8079d39d0b2b0062bac8640045f28174460cd68d9ede67eFc412e20d172955201d6423f48a4645493a1edfa1b59db06c231031c21692747ba9f5) (F 0x23ce14d0af1b9e595a2727eccbce7eff6abf4cbe4eb7eca5cee43240abdea5595db6ea734d710880a726ca16d7e25c02ee6501eeed3d7274aaee4ca1acbb6df6990589df9c4e7b5)\n  , NZ (F 0x72d444c865d0ef8d9d0d509186f69610e9ad6080b7c767c097d661111a9054cbfb1ddab755830502799199a9a5d285bc90c8865b531c2c8b2194585f5ab0d80ef12c74d4dd8efbe) (F 0x3d402f832da6a6170F6350199d0f29906de6d64b9c78fcc588d91a7ec8658dbdff6310038f7c876c806517877da95484b264f271061377Fb1e152690d0625a0e3d53d9c2e72a2)\n  , NZ (F 0x712a46dbac00d73a7b5e3d42fca8ad300365792d54c36f5d741ab13ae0fd077e98b47a54901d5b99a754787d4122abffa6941fb9afd9175bab2fbf9fdae3f69ea33a01c6eb98b5f) (F 0x74388aa3677e52a3a1ddd52aa6fa1e2dffb0404e16e06cb92e00113b265ec5ed223de5ae920988b9c579bbf6587dd819097f45c9d8954158125241a3e668d4be62b8775067e239b)\n  , NZ (F 0x0b870cba76b024484744a3ec3c9ed63b60bae4a4c5715a92d19dcc4b90b881989971184aea78a7e3243d8bf576061b21aa6f8300f6d18373c4c98eddc0e2b7379a5577ce3a5f1ff) (F 0x7af7b1382dd4361ab121daF2a80bfafc9800827039bea18013be0b332358094b17cee9b1c87a18330ac164205da81b218ee730b96a762b84cbc9fcf6c620F76d08145d0c8c619)\n  , NZ (F 0x415179113efafc7cb404eda551d53f9a97c3778936613e5411d2afd85d3f9be196e71a95666854ea544a219d0418ecFe4d29e1e9805e7fc8e7f9ade14abd4b632a798808bd8063) (F 0x2f8b08afa52b6874e943d83e614f46a9d980acb1f10bdd03e227a5ac8a90c8857ac8f888999681dd8b756728dcdffabb8147b4eaa2822126ecc22451ee02989de9289b2a6c5Fea)\n  , NZ (F 0x62ce457ca5d6b78b32f315c700b3af895bea3093487c21880d532314748362495af2274dcf13d461225e86ad4f9afc36cc08256bf5aae01ad70db836f603a2c3e13cdea87d0bb7a) (F 0x350f118f83f53ef392d4269e64423e32c8135d11922454a49ecf19af0a904ac04c558c38f459c9c03eeeb931b0a34b6386ebdb2472c77b0b271d7ce10e5b98c5b30b553aea36f7c)\n  , NZ (F 0x34ea41d780118edcceda032fba9ba82ea0b090b69bc95a2de82d58b11d21db1cabd8625b1535e95fc3585b5a1aaf41d713daa51576f7dbe8ceff34cb047c15e2b50bac0d7844149) (F 0x4e5b9c3223fd95472f633452e5dc8d7ff0988596be2415439913e05b620ed3e296441ba457b094a27a3fa0d650ef46c8d6fcf7d18e83ba5d198bd65aaacd62c4a939a2096922b38)\n  , NZ (F 0x09faf972ced0c1ad8a296f940d037ca789ed9ecb9aeed29f9c8573ccf2eae2f423688f6f266693196c731bca9618f0b2d7b7c30eb226059cf5331495d5962fb61469fd46e619aba) (F 0x500e62021080806f82216c6d117f16210d02d69a5f8bbe88ce5db0aef462f36919549bae142a907aa1b3ab7a7ceddb7b44305aabe9d309b6d7854Fa3d1efc959e29134b1cead2d)\n  , NZ (F 0x0283e4fbcbc90a0e9bc8c7811da21645ac34bdb615ae68dfb5a6554e092859791611c636f32bc01b3215edd11b454eb658932e14fc7f7c7d4206b2add141b7566FcbbF62a33ad) (F 0x253147c4fdc8329ec280fc2050a9a7ad71c2c5eabefa2559c59e5604d67da9732ba2543f443f9059bf84dca982a5d7dbae9ec45e47ae132aaaa3f2acf22a39e583F90e28c00756)\n  , NZ (F 0x41df10b7b2fb3fa9d492c7b05a7c00ca1a2305b544c849933b6bc548bdc6c218fd69dc026829db2a769b13336192d88e5b59bc29b4f1abe6cd379f3df7376d2ff26ac71b498fac7) (F 0x1c145c827e1df3ad93220a2600c5de914613ebc330fde8ebaee364c5027b0bc33f2366467f35f203047a48ea662cb7e8caf5c1dac4a3b63e559830e82a9ae42bd5c20217a92efd9)\n  , NZ (F 0x3c2fc07df3090bf85ffde0d3f3595528ed76803e5a3c86e5f745ff2171de8ea5ab0976f09a6bdb0a9e60684f16ba2b2d2df0a4b18400df4f6041700815032c9c96912c428520ce1) (F 0x38313d848494b1c30ad317b93734b11ecb3b3674ffa83afa11ef2433c903ddcdb86984c3882d70385c27f49374151c6eFed99677b630c94f1ff8f46a55b9eb888d914642a0cfd1)\n  , NZ (F 0x52ffba37fac41d20f8eae991752584a6b62f996147ff689ee98ea3b6a2b83d131c2030b0dc303f14cc9e67599acd0fb267a70a350b57c1941ace5cce7337f4d5647a0e5b649cd18) (F 0x5f1a5aee6d188fb28cacceb32d93Fcf9fb741cad7298deca4b23c29098f7c340add95adcfc53e4736193792e37341a57b823621f8746938b501914f81332a2c57e40f690f57b0c)\n  , NZ (F 0x714c7124744d9d7a782ad0547a14b6c528d516aee95aa8b13faef9a06f06754da33ecf1f2dc4b92c4aa301d24eF25b69fbdb197db2db4e08bFcead870e275b77281e99e8c944a) (F 0x4e8cd403f15c9927Fc33e18834bb15f0674f4F98ef7eed63dbf27e2657b7c7709ca44e0034bed705b98c5d628c483c67f57e0031ed557eef1884365eabd983d153a5613404d43)\n  , NZ (F 0x414bebfb6bde8456a5422315e6de014861cb401548e6deb85210baa2c257b503304e0b635043316fb7b3a2946a79910f765e3f6f267955f8036a07fa972d5bab25c0f4165bd1069) (F 0x50d6e5bd23e5a19f59be0fc35839839d41924c09ce6ac83749eb0c222f05ef6ed14f1cbe02c8f00aa87e1ccd7b568db129d9571f07a2c5c47c79a34a291bb66b04bc05a3e6d8580)\n  , NZ (F 0x045e02e941756d00c488785b3e80cb09dfbF1dd6715c7913770aa119367f1b437e3ee25dd522be28e89682698d6e4684bb3c67a1825734b36a6f9e65fb26a404c62549d1c3ad35) (F 0x065f87316e550069384a03329b43b77e5d3ee36245ed3a7ec939430c108c0e378aafcc3caca1927d118e239117c502adf2890baea7d6dbd58d8f6b062783c2e8f127c3e9cec44f9)\n  , NZ (F 0x18edca28c3d9f0803a491831957f53a8d642602395b293b8486cd83a79f860bc2a3b4ddfdd2b733d7ccab0500e6eac43a47fc98d02deea874d67a7dd6a16cc730bbef7a2aab6cb2) (F 0x2adf3cd9f660f7fbbe620e0a44aa64425bFcd4eaa79764072f13e594652c480e1e5e4e8ded6930b9757a4f4Fb08bf506c5ec7ec797cb4673f01ea5391a044424081c03c730748)\n  , NZ (F 0x3e05a6942de547cff75590e5d5880fdcc5bc49ae93bcb41df51efd50b9ee10031022461c1e153e451cd9a60460928437932b85d5c36e101919cb7bfbe267252785e1b151279f29c) (F 0x23a1463b962596b1955bac80c487294a42e4c340462be880538426dab1ba0aad117d84bebbd487c2cf4b5f02ce10db832dd23a40e8a864e092dbf08e3d68383fc115a72edda6297)\n  , NZ (F 0x67253d0c5de87e4b5cbce31ae44bd9d9183c123ba013d51c3c4179408fc57f14aac478f1bb81fa6adbb0b4d99ddd58da3eba36b66eaf5cb9f09d685d0a20dd3565b121cb96f39ad) (F 0x136c059b5f57b8d7330d5c3def0e3f7c960caf98ec1d8F5eb0be401939144588c28e2c8a077efb16833271c13b1ac95cc7afbd5e93b816e21627e911703b6cd97f444e87adaa64)\n  , NZ (F 0x157d2c314add68b3498a4921a077d1045be3110b928260426907f15ba0efc5f2ca33fde6a580a84f7e2be221b809734bcea726e41f18df1fb63491efbe8d657d2e3ba61b410340a) (F 0x25a9623bdf9c4794d86bd6d187fd948e221f13b89fd3d55f2dbcccf2cd901e024049fb28ae66c832a3dF1e178b729788b30948b13dd2b7daf073a8c7ea965575b45591219cd8f8)\n  , NZ (F 0x576e54c9728db80444bbf803c8100d0857aF6e6bd8741cf0795b6cb1062b287213e6c3338d9b23cd7a744d45a1dee7a6c1ed3a1073a47eecd7bda4db93f75f7dce5d8396ce2b22) (F 0x1733c001154e9620c8c1add220021118b10ca9434053ab8c00a368f4ecef31da4767e6d0be2dc9af41c595b96d42b298c6c4b6e52c47db7a23c458fb21ee3c88794a61ad22fdcf4)\n  , NZ (F 0x5d0a1b222ef2e79b58a0f29c6ce9991c0b9e933dc0ff75ff15359688e293f4cf6b2e5b631cf148Ff27c472a35524eeba91a2a2c3a3a2326f407a8c3555020b89a22e57ed400a59) (F 0x7ce452dd61c23b6e8ab3c2eec4d760095859cceac6e4a3a112fc577c4e2763a82961276ce9203bf3Ff263e514b58f511c18b1a9d6c135e44aa8513d9cb8648cde8c5718faa59e9)\n  , NZ (F 0x2ee0120de58da43fadb3c1839be94b47f52bb6957F7ea921066a5cc139b596c3b32ab79a36da69349c11e2ca16267a5e2f72739d5f2c8c6c351c5f8a37b452bd385b43d879cc3d) (F 0x69f102F1560e1620a94ea7eb389495a0314c3bd5fabc17249e5ab39e7f1434ffb1f0629505e7ae7ad90c32d7c53c7c62fbddeb1e3c7f9ae9fd5bd1f1c68b37498faf9F8921c0a)\n  , NZ (F 0x077582acd1a626a553c253e10279fb3b7961f81e76b39535de22f398a466bdbadf7838ba0640bcc29e64d32b862ce636af5F85ca12b5d7ab74ab4e515e52608edab5a83e9e780a) (F 0x210088d3eeb100536282da0024d9dd22ef7194c7a362de80375fb6b6346e74353a80766090921d529d97d947b9745a329d576a2a3b4d2fb77ee8afa936319f813c4b204247ab073)\n  , NZ (F 0x6630aa5cb6a05207e5e15c861cd805a7727cb22afb78a98102bda5110deeac6b5abd7b46ff31b89a2c5b471aebbfdd2bb63d271910a9e1db5c61462b915b29139Fa97aaf358e7b) (F 0x7cf7aa4ce1bb713e52ba668f237b5ed1e9b4b2dad2502c10ca94e74ba4d80e9e2a9f78e33ec51b3dbef410522c3e9bee4621a558a218da543fd9704c01288d7b31af69604915899)\n  , NZ (F 0x16c8f2f65b2f078a273690f008F5b3310b70d5dd4a86d723d0a6cb01d45e3d7293921f24738e7e2742f30838edea77701c65908289c9a01904b1770a92e5d64a2fb2aa95eabb01) (F 0x7afb0f5d9d099aFb231775fbe76137e11db507ecaa8b21d9da4e5ed69491ba5205F55c18f0c2c943a15448302cdb122d283b4906a3b809f623bdf78a0fd1b356f74ff32ad9248)\n  , NZ (F 0x46529c5951c4372e37a3d1ece7280a29df20cde80a08339251ae625eae1912d8750402f8456b52aa777fb50c7ea13a5d808b2bfcadc71e6a20daab454f00f99dbd92dcf6ede98b3) (F 0x0e7e80d0100c8debe14ce1286048fab7d4535d84fdd39c892ff56a7cb533a45dc911329c3dd3c16950396e780a7c606cae635e3f483e36857f9f5de9b691c679ca755410b7a3970)\n  , NZ (F 0x25586ca3bd7788cb2928226c224243f37608c7c7ad2aa1fc6b7e7ece4eca11eddcee730ab074edb6f108dac19bc448c7336b22a6a474cf0631c00d64F722343a3e0ea9abf9b74a) (F 0x6149b02f4484ef31949a43b4aad97621d68d26b212039ef2f5c1d2316f51a6266bd160b758190bd39176b702d291dfb73F12f434e203c662e5f05f7f7ca3b543ef628465508b5a)\n  , NZ (F 0x41c448100ec5a217b405c4b33ce6793093f8ee8e8aa2cea6c0a88be3a3e3303b790d45ab6ce3c23b67a11035af4172a0acf4add228f89bea8569ce20b168a2c25b5959ac8fd7d31) (F 0x0686d719f3b2a8769310e9d6421344a0d125a68dbc00bccba0deeb0844ad2d42725eb974149de245a3f74ea16e4a6c7be2eaf4d36e0f47e027c5f9d7eF4140d8b3f1e498548d90)\n  , NZ (F 0x4fc1b5b494d45e55e178703442b7569dd7dbaf27c3c95b29032e8d0edf7bbf903e6460c0353eb3e7bc515cdF26a718307f2854fa523c22a9986e87c3ab1e2396966b53059620d7) (F 0x15975aa8238c4d75be2a7051944a46b54888476ddfb1203eec467f93d2bcc28cfcdec6ad1bde4c9b381917ef8edab3704a9687ec0dc67ee094fd0d8ffcd1447e37f9a054ef76f03)\n  , NZ (F 0x21f61994a5d5e71f8958eb556dbc7d1ab8d38054aa0ab96217251be5ee600d393f69d8e0617f5b957F4801403b57cec7ecd621fbb237c2fa230d1ab2ac6bbc0847570f08d16fb7) (F 0x186113baad161b25d320604f1d7daeb4dbb4e8756b89db307ba48dc50728fc69b08583046ff7418cf9816020eeca4f7f375876c7668c2ff6ce6745bbac6d73ba426087eFe530f7)\n  , NZ (F 0x25dedc0d8a44F85a2616fc9e4e649f5642ff8cba4b5aac7422c6ecea78382ad8fb301e14bc43c228e47505ed95f442b2e5722b24b542235e3a50e5244d5d6a9972bdc2d54a394a) (F 0x217454e6d3dd2c42e886689e152f49e8c2dad8b46ea66669c8f4066ed8aa1e59ce3cc98c69f5e8b64f98a4bb81d2c76cd75b242f6e9a37c3c78ff4953F17d641ce73def9d4012b)\n  , NZ (F 0x22cb7ff0125ae2bb73034fd2bcf47ca5f5840bb16e263b0398d4e9a1ace3eb2643b31121cac3f38ba1d5d2777f0b810f3580057717eef55c062f2c01e8dc18794Fb86c59d31df0) (F 0x1dd3c39a433b8310e762097b8f42044e095d3a65ccb04239eb3ced1f955e62ffd8c331cc3113520d555cd6fae0bddc5a4fab2cc9ea6c7b6eaf8e92197735f7677d427cde81c59d0)\n  , NZ (F 0x1a01c0c2412172ca6164166ad8cd8f89e190643f676028a9218d353d335f4bd02d914683cb205a60a20f2f72771558b7c0925c3748bea3f9adb7ee1adee58aee395b8a23984436b) (F 0x16ef53c51d1f94f977113f45ad24fa21b1966045f0e106696749bc6773a9cdf050ae7332c60c148466fd35e402fdfab0c3a241d3764166cb73a685a5a7ee6bd9c04549262ae4e28)\n  , NZ (F 0x27f137798ed11e5a7a779c60b96a5ff4f4c221626dd5a8efa26a4d88a1571144f078caf99fddbcc401c12bf60936a4f5af7de5c2d53b5090e8a15945e3a132d47987bd702157caf) (F 0x43ed3bf21f3319de51470F09ee9cce825517ec90884fd232d49124f8649f3fc9c0bb60896611f420b8959eb19892e60d8efb2325be14d81ca1887eb6e774de0c46619781c5a56f)\n  , NZ (F 0x068b335f156a7be9f6608ad33806da5d5e737eefab99ec73f3a1d70eeec16bb2e056f577c5a4a073aa55438958ca39b43f567364ba7cb93b42e162f9efcba9a2100f1f7c9a76a31) (F 0x3b90331f1ab28e9a7db099828ec6c4691d3943fa9542cd6374bf928ec20b9d11475b2424a0e2847b3cf6e22f7a3961c88674d0c159cda08185836c8c80f6e0bd9f705e075d18bf7)\n  , NZ (F 0x2b7e886af6121b60151561b43bfa26f55bc9dcc9d12293b4a1e6b7853ea02bc666321a5f833255a968053f96bbca954b02a8ca68235adfd48d425c441f30e1d56c0c09ca1308265) (F 0x68c5a80f29c974389789F97c5941de364179c2ff851574ae6a1f0db89f7292c00a9d16b763df833995d6f3833fa8abbbb0624a5135866ff3770d93914dc51832c18f2a1bce7f5e)\n  , NZ (F 0x5f2daab021951a858162779cc67f5233362666f40f493fdb4779eda646bd7ed1c3df6664b2fa3b9f309c265cbc48f00f527be395940ea06499310be64dda535cd6418adc2366388) (F 0x2f8a3e95478390096a21ddff2ae025f15b9f33901275fb0290d233386711c322364c36c7b93a34defd8bF75a3d53382a8bd79d60463ef7cf1472cead60f625aeb9b040d388f93a)\n  , NZ (F 0x19edf44d2Fa8c6d7edcefb6a2678a9015faa30e1ff19fd4f8d1691a7c4c8b61b1216f1c6ecce22a09f958c8cd46e183ff49c75ef3831c1d9040830f425f25d3c02ce77d160792a) (F 0x791953acc6cb7b6abaF82f88c374c2f2948136f0c4531442484ec5a8af413306df3d2d4a3a62e412676363c0a8d9ef784e63ae6F8733ce8d0e593a75b34ad7929e8cf525a6246)\n  , NZ (F 0x00f429a3cdb3485db756523cbF3bf25222b4ba3906dca927841928355df75267f2f7bef9e485f98152140acbe3b740036eaba3990ba06389f8fbc81e73eecbd07ba22c15f9b52e) (F 0x691e4f064b51cd7b9f20a0e1b9b19773ea33918e372b4ac7526dae496206a498f399bd9faa3fd38a980be67e33fd938ca954eb860ea44a57773703e297e774beafb549e3890fd74)\n  , NZ (F 0x079426a275a79aac01dfa1104ff27d67ed70e280945a0df02f8d8ccef3f419884a71802a0eed4a88cd5c16e5e693014f2f42a8126c237664030607d260cfa7ca3216aa4a8cbb023) (F 0x2d0a5e2a362f18c20be0235590b52bb3166f483716727b6036ae08a762011a767e20559617e1869cb2Fc2d4d379e7d5ba06f0d1ffa99c69896f63af173734a7268caa05631554b)\n  , NZ (F 0x160dfa75e225cd140ef77a85ee4f03fbca129832540dcbfd73b783707dd85c35133dd35df8b511a1a77cc7824a686c17c4d745443aeeb2358d5dfc1107087c7edc81ecc595372f7) (F 0x02916a1b08ba34e168a08381f7162710e3c47e1eb63062cd9effa5bcaacc5c05a42722838d34ffd0323cc39088fa44d2d74b295c32e7ea51c490cf9a3d1b239d6f1068d37d0adbe)\n  , NZ (F 0x2a302d3ea74d33f2e15da3e7703b92c1abf9614a225bc572220961fb0c443533c4ea58b701a577dd2f8ac97aaa0b072dbf1dd90a069ed0b2b75809c55204c799b23406da4c6406d) (F 0x5d65b544c825d0e58f3988F59d528bc753091a190dd426e8c33b34440bb3c22c91ef72bf06d99634bcf598d1977d13ac728806fa0b9ae3c3f6acf46d03d22f71b47a97ea019e03)\n  , NZ (F 0x2f81e1edaac506077ce38e37b9fa4b78d9efc62bdaf0acb502ae391004bebb63e56cfd101dd6cf43958870b648962da26c60fc7c4b73ce3cf3856b772cf330beaee49b90c9f7a88) (F 0x459c7f7e5b1e81822005293904015345dd058a3a57d86b79952d867367d46a408853e688b12b2936860f90d30fa1dbd69b5fd775575c5f3bf62c495c6a84a00bd06c92e5d813a7e)\n  , NZ (F 0x7d4875b384a303d6d28acb72fc6c2f176afaa28abd10bc697ee1077ae5ad27fccf471f0c2a9a9b029a683db24b26842d2befa333f4cc50833581b30adbeb5aa7668d4a3e904f7a4) (F 0x634934838d27cc224771c35c7b8bad8c7c0F099c8c8287dada53F6c5F2dc84af4fa6d3c596e9f75c715c02f7e212b7e7e16710a480dd1a9187312715Fcafb00f74916488961)\n  , NZ (F 0x168c52c19d09123b56aff579fd1f5b4230a6892435605a3d74ff56a4ed81238889efaa75dc07befc69b95e154fF148e0c3fd6355b38110e13bc6edc6ab4ab43ac59210e2b2ad9d) (F 0x4b6adedeb50e2bc0e4c83d2a4e0a9edce71d0d0f74e85fa8120f91a165871955e36c960d4754394af959339e574bd033fFb13c92a33a3665a95169b0efac29f5968871407f0366)\n  , NZ (F 0x0181be7390Fa6614a3b510707d57db684abb9f22b277f58591d88f064d82cbeef80f222ac977f1d60e4fa38c7ad3762366622f82119f25566814003c212ee1c970e9aec04df947) (F 0x11ead477262c8ac9be7217e8a507838dcf1194e942b28ae444e729fb92d7cf27a6bf49cddf0d5aeed3ac5f215bc3415d828e832d4c078c31ecb5162dc4bd00611e261c00330ded0)\n  , NZ (F 0x17d4ac8243b7e83b4721ef81f8e00f5ff50ed4f67d8636936c3d30e6452eb98cb76ee8211633ac748a3e0c870f3545f2e66006070d07492cec1c70f6d5d4012bb82702cb4f9d259) (F 0x2f76c21b7fcd94d4f1cf2bb991a7103d808d8d23bea33699cFcddc0b649fab5fa78822f4213e22f3e857fa7b14e714351a63c1de58c3637f7b4c8b85cfb2d39be9ccfce775f90e)\n  , NZ (F 0x6f3d7cf0a49f00670ffFcd38a0dc2109c4fcb69eff8ef9d389a24405117c0b1a9bb34b89e183da796c868dcd5c25e6ff9b955643a3ad123976cdd888a2fce3a8ad338b8538119d) (F 0x74513cFaf8916db7ed776f0580c1c6ff883356dc766ae35e8b01ede9e8f85943e4F34fabc1f511ab736495827526ca129b86b46762dfd2f8cce06fd9f63cf9aea4eecec1b710a)\n  , NZ (F 0x2e39f95e09F6b2c53928e35a073a1cffd2398595f9b30fabc2d3d50094695929cfa1ef32f0ac2b17404240d6f91bec9760311553067e5b11bb36bf6574b6f14bc7240e4dabf5c9) (F 0x0c575f3a2357634aca8d2f35a0105fa6a421b3b0f4abb1793c3134c410b43c6c6265026ea9200e12a8ec62521f2c0085c2c2041502c1a12a1a00b6fc2563354b10e9f4dc97e3c7f)\n  , NZ (F 0x7ff72ca473925ee946166c493ff733945711d87a8742a4783283d852f2cd511c6cfde8ac4b0720f7e9F3ec7cdcab2fb7ef32c968c7ac56d7634ec7b9ade6686984d98c169d3eab) (F 0x42df33ed5625a89e09f8a71ed06140af858f90b6d77afc4420d97a3e52c9cf429923e609e77373e98572cd1ab5e2a37d79487b82dbea6cbb067f5bdf569ccfc8c4b6d9506ba1cdd)\n  , NZ (F 0x3fc70b90ddae1aebff85cfc5fdc1b5123b687c4894205c3faa88f00d121a245f1208afde280eee59153065fde5783d65401ef792af313e434122ef528bb0b29448dd4b8d2ffdc36) (F 0x25392bdd706625df1f50ae674808aa034f5b68688936187e2c2b0b46525df8c154cdaea589a6875b2dcc151e7d91d0f6bf34a5ecfd8246a74620F4c0b5793bc312948352d8d002)\n  , NZ (F 0x34bffba954ec724b8e11aa9c7fc273e6582cdb532e4bfa7de98736dbedfcbaa958df29acd10df20a8a0f46746242a0bd0a316384eea5b9450efa104a5f2ef070f8bdfab4c55fa2f) (F 0x4a8d667bbc62397a8cba0c595123eb211c2f9830693ec16f86a10436ab4717e3a6837f28e3a13b4b0f88c89529998a563a66ab507894b7cc9649014f31576d31b4a798f698ddFc)\n  , NZ (F 0x76ed06107c5731d0169900ae0261adee659cfcf0aa0c606b5825666271526285784241a11986e63df5b96134225b08ecf9c8c92c81d2b7b4e149aae8fc2bb94e7ded71aea9c3abb) (F 0x1a06e445f53e801e198df38863f061db929c2624e216c64afc4317fb33b41736553a82814ae177458eb35d22f8652ea04fb777cae7b7ff08118747af2466d7706cddbf33a803047)\n  , NZ (F 0x14288a8945e60ee5dfcfaad48ee25a980b854636923ba501dfac6b6320e7a3156a1da66ff9f0d73cf6d4739d4b0f9738901dc7f98fb351e5146c0b29b26e62be22a95615727f042) (F 0x22a3992f79f325f56d3dfda922ffc1ee32183f3cad23935bc9205a25178522f819146ae1ab7b196fbdc03b86a131217c0a9f9950a3f4a69d4bca3ef1571676087985f94d115531d)\n  , NZ (F 0x21612a698b6e22b482b6295ed092730224f1bda99abff69185e23e60e6c47ac5315bd50926163575308c0e613c6af01f3b0b2a68eFfae2b9a0752fc3ea05a9efb197b5a8fddaf5) (F 0x5025f9b2f5462971aaca2d1d4e8fc34c48f32f4cebb1a1cc954046ed5501594b38380131b1244891fb3ce1df7c4190b70d1b330e9a96de3975111457aa94e4755f463c0963502cd)\n  , NZ (F 0x2de65eddcdc92e1eef5a98428b6Fad1129837d8f1004cd36e7141b8fbb8d8cccb6a747f954ec08943fb6d193421c4ff59ba55ded8713109b481eac96ff6b76f1512c1eaf888ddb) (F 0x5332b975baeb568e577e2d330565b4da79cbc021ad6798b4a51571bc4b4259072b208a0d82074bf4deed0624ec0124340472b6efd1341e0d9d909f32937d0c6f20fa154a2b2607f)\n  , NZ (F 0x423a95a8853c492a486a50433b45fb38b15d7ad979ca0dc22ce70b6ba8ddefb849160629360f3eca5564c5720a07928b997ff886a88c530b740bb14fb35842f4995024dad98fabc) (F 0x1382c0a9d0d7ec7e20812a07d013c5213ef0fdc9F04064c41669fa70d322f31e0213faabce49b0143da9c4ebddc5143fafaf9b68af8f1bf3e4a6f3ae6cd8f618a88e5476a01696)\n  , NZ (F 0x096b771794fd12eebd59769361a2645ac12ed63340f2b2c637b0181399dFacde2008961a41932e17f2a6cc2db260a2fbd71ecabd4defc8b1e725969406ce7b5a3cdd407662b272) (F 0x531e528b428e4ba8246b270510fb3eb0d3c843d3d3d1015a843ba9174c70f0bf1a6d4bece843d06ee6a24222c733c96240b01455f8878bc0fdb5e52777c599e50566f101c348496)\n  , NZ (F 0x2bdcb26dcf6307f2bf265db10a34bd4c02392dc7eed1f2793b0081ca3e17d4602e3f6af9a7ab24a42a6d483e67cc2f8bc13726051760751719eb795586356104fc2067bc882b818) (F 0x0816de43570e277e8e3c3dff2d91d8fd727059023c920e0e67d393102d42aa0946b45abd236914a0e7acf8497f5d41f927429c41f1368dfd3d20882d70dc9303446ecf08b8799dd)\n  , NZ (F 0x0b51bb043b5b03a011a49ca7a4c31324b9a4c4eca9da29edeea192780b120b6ad2b8f92f64f0a6092eba2336ba13574328597ffbb956eb4a4ae4d48805d2b311d73dfce31fc0F7) (F 0x177d4cf5650a0a5252990177d55147b70d6ad06f409e7450c62dc640b5e9986e97cb7d5faeec6693ff6fcdc859a94562e39b5a971dd5af05de05fc0b69b8fa8f200698588492e78)\n  , NZ (F 0x3307ac0b96ce2b59da5770706f8dd26df62574b08728f2a819dffd67603fdf0a3f4263609c54a8e86e9964437e8ae2c6195448507d362c0d91805f2d463c6661272428d47803368) (F 0x2d794fd54f5022531a5f7ef40e62de326033fc05de9cfd2b5d0e2edb9a4c26b111c5f330e7e8864c37246eced96160b5965ddabdeca645ec891eeaad865d10f7ab5e1b3cc61a127)\n  , NZ (F 0x66a8950f33e519961599740654736770a2ab14dade2dd1d5c99bd0c82279ef2f111d179d74921f95f20729bf95c84d0aa9d6dd7f106b5add2b2af2f5d96c31fc2ba81a786ced73b) (F 0x4311afda6a5ed05d543cc3c1757010bea900c5e0534373c52f3451a55624bbb66aaffa4fc8852f5992c8fb80bF808a79cf7fcea70f58db7fb8f1d42c130ec091016427adae988d)\n  , NZ (F 0x56368419397aa0f0b380ea041d657aaca6da8115bba015e8586212337ad5b6bfbef3648070f668450d8ed294e4e0c59d9b9f3c9d11f3dee11b05ae3d301422966ce649e85f1d974) (F 0x4203cc2c0ac78c6e35a4311cf55caaa01491909aa8408c73df68172392f99678dc4c110e46e9e04f2804d81ee9f092716e39e52a91e39ff716698ba43b768482a4125ea131b93a7)\n  , NZ (F 0x307b41830aeb742cad760b5a1410f32cccccd90c2fbbba150b8ebce1f2e17844c98b2f8e00dd5fcb342c31f303b41c639e8a7cc7a0805960a4632d6f73f26b053e70672b5e448a9) (F 0x32a40f4f7af8c378bf521959e9f226604d6649f1103dd1eb53235714b7b4b0d6f5573584107367b8593233da3330537d5bc051413c0be25edcfd6da192f0f20b2456709a74a2bb2)\n  , NZ (F 0x004fbae84415e240af6831d353Ff738d5757c03f1125d96bfF3af48b135d052d2c9d3c83307a49677bd311f11dabb9b20c3dba153d7bdd5e7464159f5814528be586a22d1dc9b) (F 0x3edf41bd701e3608a7c2ee0b197d3916ea59f6aa132cb838e5829bf962621fda2d450b3e5d882d3c643b32a869f233869030a5c7300194215a5702c07c979e29d3a370f8338314a)\n  , NZ (F 0x7a8097c0b70bca06b148a0618a330b0bdd1fab96ac74fdfbcabbd614f821485ee2d35642bdcff82d5e2ebf1636cf5865dd44e2c1c6433cee0e5e1260e9d4de088924749cf0629ba) (F 0x36e063798b6f3fa0b5533b77decfbea3da055f8ec487bdae7404b2e416ff7eae6de0f009ea9dd91105104e962a228672d8466F242328f6b01c2ca8b2dbdacea0f55990d045c5a2)\n  , NZ (F 0x71422ad9e928fd6fc8dc63008596b31cecff8c31704b94389bf619a47bc7e43587a9c5b0217356b5d42727e2fc2ccf796551e3c58ced662c53cf3166ea992a3a99543cf48b355cc) (F 0x054bF735a821dc3444745a45c32ab8a7ec6498937c144417808919cc0a37fa104f246d0f472ac9e8ac13d3a7ea00b6c45cb129ff872405e6c03dc7632ab9235290163eF23ee40)\n  , NZ (F 0x166c562644ec16dfa23b69d2e17c2ed11724ac4443e285609cd41e70bdac81fa0c2b2755fcbb6ed1d8a67d05bc102F88dcbec844d2f73f1e8714ebd591e7b625aa6923f75f5b7c) (F 0x13795d52db23668d4928ec3637a9db80197da8204c852d6cdea230315ea643e2eF7dda28a6052cfbce122b827ad06d8f3c09882320f7f488c5f9634c3a232f149101fabc588d16)\n  , NZ (F 0x02c84ce75541db248c1ee7cd536c41093225ed6c5ee686399b8d8867df3e9e00bbfb9d102465b319ba1e1debd56b0901757fb91f8543a2c84b964c58194dc7f71160ecdd7800587) (F 0x70f4a2683e7bf861a685abd75768Fd0a90cab72016bdda7934d0e141623be801ee9c841eaac9479becbfaed609e4d5ea9350744cc0f75f89346d70ff5b0e7b318f897c4c5d9a40)\n  , NZ (F 0x1f39bc9579fFcc238b8a3127d8c58d12dc91c300667ef938c8480ae0618fdaa94700e20c3c6f1b926cf76d8d2bd13a8100e181149a5455aae17001b87c4886c492ee720e6b1f7c) (F 0x495d96dd2f60035b10a3a797cd6dcc4c0c26181fc6f142100f61fab4e6555db93a43c7d935e373a1a2f79c09b7a25049e7a9def9ca2e09e6c2a3637a63d732807428d1abffaf027)\n  , NZ (F 0x07472b11e2db3d7e7a0c908f3892b677a1ff4e9f811e84ef989947d6405b26510aaa6d3fc13f69da8f515beef204f70d66636ec245134a835f3c514d3a7997d909cbe113b1de1f5) (F 0x535974847c45ec235da59b2e30325e8fd4dc376f6a6172c6ed3e83cbbb9f01a5df9048f5c302057dec7f8a3b41a6e564e3628bad4a9b93f4a90a5ab49f5db186c110585899f0216)\n  , NZ (F 0x72dc171533b94844a6598d24c9ff1a93f19c026ee66f5018f52fF5d646b8a3a66767684ce67e2eeac816032e96c5dd1ac563Fa4046e71b00dc054049acc05d903c64e800e9bea) (F 0x530705a75986d869d3184178a1fc3f154261f02e44527f1b5f65836e768e150a0d0ec5c0c97186a62d0ecbb32880524c44f638e9c42fb6297ec2b0f8f80d72b1940a5Fa3f98dda)\n  , NZ (F 0x4e8c1f006d26773193a6b0f4b590f8ac11ad6e0ce38c1676e1da67fb1e012dcc859a42570ce8df738c9cce3691e64f0e93e661abc5b2752df6c29b4af66c4e55006141ecFf3bd7) (F 0x321545cded7f3ed31aaF0e5e47a1c62635ae4b91882d17c24977ff52d189ea5e5da045e429b945d2ed9619a1b5ec716d8dcf0e7f603940fb99c07956a95a783db6b2b85742941f)\n  , NZ (F 0x2b2ab0cb39273a796eb044eef41fF1f8fbf986f31273a1f777cd66e90e2c8c984a79b3a8246f030f03d713d06844da593a83d5d44b6a950e809f498c60e42e34575938b2909c51) (F 0x7babe04F7ac6c52f6b4443a841089de59acc3d7ca835fb333536312f527f516d8faf98ed11a58fa6154f306d711502364dffFf307c55eab1f14bec47ae949481a9cc3d0871d17)\n  , NZ (F 0x22c60409b7f70560f42f993e92f9d6bfde05d6a421715e7941c46f47f0293787bf6b7e38847e85b840e7fbe976e6d46df7dc147751b1a24046c64239fcf136ea9924fc8d019e0ea) (F 0x2e1290016802f2310928fc6f9c288c10ade6008c1b2cf2552bb381a41401c1b29af5071d990475a285649bd6549b366755a098d8cf3125c14cfdcc72515d9da5b868528e26173db)\n  , NZ (F 0x695655b6c673cc9077a2a41cf6c5e2c29d2979d8f983f0e867d209aeed4369d0a457300414e4f150520541c59b85d6dcad0cc554617a5e9f91b3e8a755bd466c15d7e5016dc5196) (F 0x70e0bf9e36b565274ecbd57d28c67d375ebd6408c99be237345e7820e62e1ea41c24aacc50106eed89b86f47130fd69a8f07caddac547a718adceae6a6b9a3cc923a868ff7471d1)\n  , NZ (F 0x5b8ddba46b9f82728633e6d97be442a39100257a7325d4009bF83e0ea215537bfbedf5cfab0a607c5b556e217cd199a5cb3f189af67f1284f8555f70c14ce1f937300f88136625) (F 0x20d84fc6cc1e97b3e29a109a955F879d54a2b8b8f2c3f7f96aa0e53f36085bb90d0817db03fb22c9029490dda850b0F739a16b0d7545a68a9acf1bb80ecdde410c50a87e54f33)\n  , NZ (F 0x6f250f2933db34d7a9db7ec3b803a679cdeecd9d36fb94d05ea8be33543830aabe9e0d2aed8244e32fcf7dbdfd8283562dc6cd5fb183905f5ffb306548f3ca9a90c486a2f5f3f79) (F 0x14403c1e7035af9ddf373bc57c1f4399e1d7e85b7b535d9f5d98d8d50f0bc8a7d018c29a50c6c96a1bc4dee66b36031e29090da9394b683d7e079349d2d9a3ac9e9a3d4bbdd0648)\n  , NZ (F 0x3cd4143b60d10e668c646cf61c44209d435d78054397cd03ab34a258d9e6b8c82b02a2ff8d837a2c33ec8604a9b5c9F36a4d463de1b4143cb580c8431e5fc9f9b50f5e60F8dea) (F 0x57eb586f79e4b7c07207897ca887cc40f599ba9005f0a27fb20e6dc51abda46719b602a92ba7baf168d02552291232ad0cbf4abe67d54f84c90b47fad1dbdf5c180524f9d2e5314)\n  , NZ (F 0x1b0e5433b791ea88bb643ada4b305b6697bc054c53c7f693870db9cd61f4634ab02878c0755a2482b2ca338dd6809a78f29d1c3b6a58217cbf93951065bcb64b2f5cbaa0c94a7c9) (F 0x0db2b12e0f13009805e8f4def5df491fa5fb08347c019f01649369993d6e1e6b881b9af9faf14f5c01d49cc5de9732e166e59c060b4cc2731ddb8e0367f985d8dae12F8f376005)\n  , NZ (F 0x3645b20464802111e8cb37adacb1c3b0c90502f58f1e602ced3afb08b984aed7c6adaa0a952448838d1e1ed3ef48285c59422353e77320c547aacfb202f24240a196d63eb006ef6) (F 0x455dcaac44388e02efa4a72d052412dbcf677a159b7c96a9750def2d4114745fbbf7f6354c9359dde6aecd108c0e41b9e907d9b04a8c321f228b2caaa3c7bc2a8a922cF177cbee)\n  , NZ (F 0x433a96105c2881bc8908a7d6c3755b47bbc34eec65dc400a8a6dc8e97d1dc23733c0d08718d2632761da92b15b24a94ede97117e763ea565237689dee6afa61b575e875aa953b8e) (F 0x72b6097b4ac162ff1316dda2bf576211bcc78b56364560b4d50ead7468697c8a1d8b398044185e07de29aa74076c24b93f04786dd94bbF92f616f4369d17d6a0f8cdd52ff69b0e)\n  , NZ (F 0x47173ccc97b8625c1339d5b3e78ac2b966b353e08f1626ef470f729943fa156a2d750e077b531c70fce30450b5aba6bb9bbd4530cc852cbdd316e3f1498eeedc47dadaf4c83dc75) (F 0x669d383bcddfc0b1af6503d01Fad1ca05c30cfd749873b66ce0c19c10e7017eb24ed441c9dcada36080e02edd2174f0c75b7d8559acd289a2bbaf01583817b83e77297ad908de4)\n  , NZ (F 0x7fc2032e880fdb1adcf7ae0f07cfdb667aa6fce61254e236f8761d1f8e3581b028b2218f37df3a516cfdac6e1db748f167fb4f791a13d45c7b3caa32b236734032c032ecbb17b62) (F 0x39ce2ca045d4db6086fb45d570eb2dfcd39ef2b06f2fdcec796a01c70af7c5897c0a12b76be6de06e2a19caf0de002a42aeb036d632edc8600d8680F3d28aea3d91a3d11d5b5bf)\n  , NZ (F 0x6e467b84d3ad0e0ca811a0a84cbfa82840b9f5bf3b99b1aa53ad99503661eecd02996d50be5fd813ffc620F44acbaa3f8c11Fa807dea8c53ee8fb1d267856224abb409fced51c) (F 0x004b780680475771a7dad0c56d8550230491538da83e471db9dc22b844fbb38c64967bc72ade3f01e2e522bd20b7b96b35f380f0f00da5869774df9a3b735e4f481e9970121dc21)\n  , NZ (F 0x2c00fc16ce3cd1d0ab4a4580d282bdb5bb70c7b4ab42562484a0541ad40a219ed6cf19c0426ff1fbe81ec1b42926d718062351aa10f20ef499fbf37f836469faaad173bb93eabb6) (F 0x6fc855eb5befa5932993671361e9ef8de0fae68c821a6e08b688d81a29fd0eb1ca83b602cc79de0abd2fddc998794249f48d26a67dbe970ab3ad7d5a373Fe5a14ea6539a3ba331)\n  , NZ (F 0x13094beb67bfa3186a501046196d6704607e475412e914eeee2863b8057590481b08d7a1265f30f66b3c6e8c309d428eb2d645b6432e415db7ed0eda947Fa8f82e05d05a656861) (F 0x33faab6ed66c267f497703d220af9b1038548a9cdfb46ecabef62e2df279bf456f934987c68b3b51e5c679d4a0506e9dd9a5e6a3a551420b1c26229ec93c4c0676d7219b6262666)\n  , NZ (F 0x5387f3c05734dc50a4fbbac8d0d9ee86abdc044dae90d7ae40c4348279a36ccb31ba2cd72448d66b3c2fa06a468e990660e1802d79665a248caa2fa4bbb066574b021ab76fbd8ff) (F 0x282d5de7b07d73bce212de0b9d01d9a72804363d426c6adc4033eb2b9b8d0a1169268e59f2949838f8298a09d8dc1721235d18d5168c1f36eb8b2c9aa9bef156b3e63b3bbd52a5e)\n  , NZ (F 0x30d88ae0871b383808ed8c955959f669674a9bc226b701d25de356a089ad6b5011a87091de2ce56d41fc87cbb782b8ef8b23d2087da1ac80e5e7730949045c4a19832f916e17228) (F 0x4e73961de2b2679b8c5dcd9642fd79af9ae2bc51333864d1c8f9465aa96f89796b62bc570188e004e3446e8c5a477b5ef44917c9cdebacbdcb6b9a6caa6a1e67a475b84e087e8f9)\n  , NZ (F 0x7a76eff48398f10670e084e039d2c0d6785ecfb0e5095d786936f4f720d0de06e0d3b8445b2a1e68206b6c4becdd8af295d79360b59acf8d83aa2e653117085c498534bfd2b55a7) (F 0x527F74d6be6d27574ea392518657aad2cb431cab555e20b0c7391c6261f68a3e697946fb0a30d29c663cc5606398b391e96f2e000f1c893565Fa3f3a56fb1228191e0e44814e6)\n  , NZ (F 0x11af2233e9141df73290ad7c87b8883e588ea9233b9bd78c985b2480344e2b425497e0d0c1c070e852a6e7ad726291f76d43035a804e19437d628113b04220764b5d3657edb6528) (F 0x264f08ee0b43bf5de7ca26a606069fc45ebcd79fc4dbc3ddcf46b7e8e675b534a44277b654a5f04b00beab2eb13d1e3cbd72ca81bf2d307526adc52f581490fb1fd030c202b10ba)\n  , NZ (F 0x1331a347d20fd3146c97610f1535f38b8dc6d7bb35e7c19Fc4800c0cd34c6d3cc065649a26a0e31017ff74e3c806363da1654f8c8d52f286687e592a9055aa5b91cd4159592120) (F 0x58325ca11e994F48172f7eaf88498c37c006b9f80e7159bd82b30e17805597c135ea13093e90c938830ef90de1a662e7d87d97c63569704e5a45b56b23b758bff0e7553f78d64c)\n  , NZ (F 0x7685940c33e76abc13def09b47a16d7da7cd281621567bad8d78987140024644ef6e1fb8c66f4749033887b7844560da0aad83c34d924e8Fb3a7f505ea994ed1d36df6e7138d4c) (F 0x2860c2f02a0f259696c0dffa69fcb215d1c0107285c72c8dbca67ab4bc4152c0b846cdceed81b5e0cebe82ac5659c2c8e90c96c4456F128a7d823291da7e4ec258bc09c95e849a)\n  , NZ (F 0x21f35fb874abe85b36ced75614dd3d96c36bfffce048af46c3c5099e73c13350dccff78d9ff013ccb71471267e609ffab655f4b7945275c479f22234d86cf7659073865c20bdf41) (F 0x116353735ea9a24a54dfff3007fd6bac0717fc74d1c030c5d6d1fcda9f3970355a793084034f94a16d9f31c310820a1c4417f8ae078bb9be017b7e90bd13abd0c0c7338933202a5)\n  , NZ (F 0x21a12705c24f16637f698b37c5aae0a1de9e88624a3785e987cad86cbcf7a21f2e50ec1b64059cbc343f73773d7e3b56e907f5fad26a409d5d4d059bfc4b242ff256dfa385f80ed) (F 0x340bbab94c6a8f3cbdd2c2ee98ed15b79c28e039eaaa677fd15a4ceb44ef200b281fc4ff2e39e35e5f7a7d02d616bb5973c8e32d8fa553ed1886f6409e588ea6b500f526b6da30a)\n  , NZ (F 0x141771444ed47f818a2926821f79F8ccc11a35e4e9191a8e2f45be2ad867d3b405d1533639297ab3bef2584e2eF577bde1f69d0d066d82365128f3a650609322908254f578dbf) (F 0x4b4009f7c7da66c2caf4459d1ad667051db158c17b7a932326681ac878e4Fcd3e968e545606dbe1c59ec8e655b060850e17b180248bc63c640ad7e3ef1805a18662ccc3716ad7b)\n  , NZ (F 0x59d917113b0ef334b1130c40221b5b0243d81e296927d7Fd261b13b472a697087caee2554a68599f437e126f71bfb1120140cc4c98070ce04c0e7a4dea17dcd33d251578d1edef) (F 0x1222665e1e3b84ce6dc4af88e1e5670dde191a9790b669b574a358d3c122182989a051bee0b7d27d2aaacabeb94dd1c16310450c7d2f46c67d0739042f70a28e85f1cd63d989d54)\n  , NZ (F 0x5f4b8bff19e055a2d6e31cf6d02c7f51227a49df4c1d7ec0a47ce909c7ea7dd2bf0d8eef88da5ef5c0bebed328ac7cb497796520a5496c445bb24246f6b9c000cf4fdc507945621) (F 0x332a37b0f24dc00bfde9beb5498abf895051b12dda1b490028a1659f791d8e3a7babd3a36fcdded0cfff6a241c9018dbd843452b4d11fd8a8efF17853bb4bcd00139c2c6ab674f)\n  , NZ (F 0x3276c232473944daae96263b71b98fd9c78c5f5fd570e2982e4Fa064f320c17881F8ce943f5d158e1bd28a76Fcf345cdca9374d9436b8e6bb9e47e72d048005c361f45435b53) (F 0x6ddc54de7a36ec861679d60cb33cb34c71d53f975214f3c81be881e426c4d367abf21f37bd182b99a5d49e383b490bf34863c3f2de6493c8403dce446e2750251ca5c2d227220e4)\n  , NZ (F 0x22882ee6f24b01e11a1039a3b4e35f406580f1d79e5f3d777f5aec8974c11cb89f8fb6bd9eaca05e4d847fa59497b1dd60398c891e2e550c5137b6282ed7566bf77a879bd293c5c) (F 0x3bb7d76aae5206e279a7d00331e69121f856f2d59821bac10b04f50248231ce2a24047cc6c5c6253defc55052174164a2cf5a882581f0a5a5f3ce228171fa9b81df93a856cf1474)\n  , NZ (F 0x4e3b01b254428121de747f326f704e4dc93f4dd35b0eb553f114f69df5387a5b656a8272c01cd247a80f8b6eb22377f6c3a6eec402d9e0902f0bdb9fbfdc972ad542ec3759e42e4) (F 0x30360a49c21bc3e0eef159556e5ed558e75ac3e3066ca48236af186577008dc951ca70d66F4116e4996f69a8a4178c1757fb61d82aeef89e5fc180c2a1e4ceFd2794e129916ed)\n  , NZ (F 0x42bcc5213dff1a14c2f13e7e7e5ceda55f8cbacc1c261040031f305bca5039d7b5c9a4816be9fd1a861290491f3b99da1adc9c8d8636ea7a9ea679Fd4275a0d637298e8748ea7c) (F 0x055954c005a2b9dbefd9be23bcf25a1764109e3f35eb3620f04e63f5af2fd725e1bcd0b1000015f6729c486f5aae4e9c45442db990d7f81e401e83f3d674f0421312bF04784c92)\n  , NZ (F 0x5981b63db07402d5ff98b6dcd9f5d83b35a7b5d98425083a3bd322043e8b06d3836dada5c056ca7f7dc724ac9b71d51df4e38b3a61eaf661aaa1008b24940688b493ff912699ecb) (F 0x3a5d3dfd4a16b30bcec236324c5a4563835b38b9f10575c1e61ae59295381b80e880938bf255d2a7b91897699ed0158243709375c7e36440bf88f1181b63f5c459F1e7d12ad4d9)\n  , NZ (F 0x41864ca2748aa8bf01b1fa490125b6bcabb29a8a8a421954c3a16c39a8288222674aba07c1d1e930d59bc635d9fcf687a3a4d09752b98e1caf6c4632e23114ec51e919b869a422d) (F 0x4d79a3cf06b357062f07be0daafdfbf275fd232509497988fbcda5c1232a9dbb45dbac2e4ec6f6193c15388906d50fa4b55f2f999e54c016a5c16871b9e237a6b818dd4e67e56b2)\n  , NZ (F 0x7859676d21778f0433ad95bfcab37a6e74cb49bf4c99d64c0fcb7d2f2cb90f4f85f4d26b5c4865d384c480f0fc816a9cea4bb6ee6050c6159f1440645875f111671b0a629caf2de) (F 0x5997e51c47591518dcc4587bedc8909e415813a430e8a8068fd38133dc574a07e2ed691d1334815d3f84e6885bd54b72fca97318282196f8339ebbaf4e37040362ff1db440c8932)\n  , NZ (F 0x0cc135560a3afbd50f6c1402f6b17c8c3ab47c17ab167aa353d0b36d3e114da6963c0369fd0b22b389d8bf3e5e629b7596fa7fb502ef753bcbee3451eb7709edd438adece2b1163) (F 0x706e331ea37f0e68240b814b5f523bd58d34965a2499db8700b9e5e8ad07d09d6812ae438478c972fcf1554f59538ed5bf20d12003da47f966c0fd1f02eef8ffd5503194a687ff8)\n  , NZ (F 0x4bebb8afd1e892eb5d6cd21b2627a11e4d071ba21ae12f64c95672492b533f2a9898a8a6a7b06ecdf02d97a4cF9f8977b171c565a720d9dc67e7bb0f7c1bd1f1b1bf35d9bbfcbe) (F 0x66fa35f402572352592461c7de3c8daadbabaea5bda8ab1241e9c98c2028a07ee7f67010338ff3e6f80631de6f8a690606beb6619f7cb57e0758bcbd47ae26203501f75a422f877)\n  , NZ (F 0x3318f0104462d74daacfb3ef465aa29db08af15e571e2b0d635b4e4e2947304ead67acb8fc5fdccFe7aa817fb6f60463c5612bbfa872a3e93369db9cb9354d82eeec68359e8240) (F 0x6763a6269eb0def9dffc3ecca9c037331f67c32396406fbbbea3ad80b21a2c77f42e6e7f362c08354bc71a4dc6d64f9081bbb27a45c49c6940005496b8909b041e4d9f20513056b)\n  , NZ (F 0x7b0a9fc068b987b555b57213eb1f025b301c5511b546f89a367c79153cea68899c3faf0bf2816c917eb66640df588934c7740a7b2e6dd833d8e7f15fabeffc7de6d7010599f7086) (F 0x5706ff1ad37a1a2b512b77c0bde933d1fd2c628c9016b6949255584aF7e80a520c389348ba21ac67d709f899741764d3b3b32a7aed9755c3a7cfd5bcf864d8cc60e19e3a64467c)\n  , NZ (F 0x38Fbe6b1f7360cfd5ba2ae30386e50dc809260e9f6a0e985a536b4ab66a0f29efc27947960F7d491c84e6068cd948d5d46ffb93396099a9c555607a41e5798f635f5b8b269ceb) (F 0x5988659bea6260bd71d5f0ba745390faf8060d36753c6b206b4fdF9c87f7139b1971bee47bbdae3be11aa8e13e7ba7132dbeda26be27947ba78baefc2e442b238c8f87aee7121b)\n  , NZ (F 0x126976ea031dcd773963c9dd8d9eb4b65b675806ad55577ebbacddb35682ab6e5aa5c063306b109a924d8ad5b1eec59d5f166958f0c6bd5c4e77baf2fbc382c171a77c759b9a020) (F 0x6391c3a5d6e8bea02e0057b495e58510a37baf944887d4ae392e49ce7Fe1b0e2a6a23191be32b314f6f96f8181ab29e87db7052e1c8b1681bb444c9743b14201c93975f76dd29f)\n  , NZ (F 0x435ed91459b56745ae6b0e573b1f95ec086eb438a0fd6a4ed047cf8f23f5c122d42771c52600b8879ae2ea2f5ca51585933b2cd8be388d806ae8997765c39a4adb48da5cf18b5f1) (F 0x00527ca4895bd9ee3534bdb83403d8ef2038bd4b591bda3490e517f5ccc268eb20c20108d4bc050c9410480ec1c36e8ae9d144b48b35c356eee0f044b9853db7338a3c7fa355842)\n  , NZ (F 0x52106e19f5dfd0109a4da13Fcee98ae02523f5Fef65bbb4386ffaa402e0ae18234c02f76c499b5fc6ace3df8fa985b7b87b76f8eb3e9426e121948eedae276412e8b5a8c1ee89) (F 0x768a34673ef75eede1cdb5277100c012f03281db7c927d7acace5049755b1ccdcdb249667291731c4725a43c390a9e891b690db63328e0ed6815ecc6485ef5b1bb610b2dcd7bd77)\n  , NZ (F 0x2bd7cc3894ab29ebf349e5b3313a6bbc000cf279b3045d25b7f047df2be3a33d0d537a86baa59bc774fa8aaa90dfb07897cdeb24cd1e781810e09dd3ff1b14e940525d2b36e4088) (F 0x6a7cda0042e97af02b56302cff22a5e42645fa9c4b51ef1cd57adcF5b248450c562e17cefd4ab93da38bc1cdf5baf9166e002d8bdaac1037ff0049c62adba3c7c0a3d20e78933b)\n  , NZ (F 0x216ad381dfba4e599030f6cf2d2a5525d18b99b8f39f950f11905697f76edd43de389ec20418559f9d24927f3fdb04011658ac3098fa2dfa843c01ccf3ecc0378b580d9f8a42be5) (F 0x04616957a14bc983c5ce7068cb2b19d5a136eaf1f24536ce9306ac64760f5fF448772c1Fedc0613ae7fb881eb6b4b6a9a02df34614b504d8af55901dd3945074944765539fb45)\n  , NZ (F 0x5921026f870e2bb470541ec0f0e2F3426f3d5d2133609c8d29bb59934d45fF04f3cb026b5ab359f3a61bdb19c5e87ba49ad4847a6d30b2c7ef091628050137fdebdd251691c08) (F 0x11ba3a1c95d7028d343aaaa3651ad3186b33b89ee972006Fc78dcFa2f125c0454b1ec71a210a921d0f03a739F29d7e0311d5452e1d5f380cc7b4e2926b129269bb1ff70ca3c4)\n  , NZ (F 0x20f5265959b03c5da3a2d80726c0367db06208ce5ed5ea444762dcb26bab90a938420a979985a9413cacc3f19e6de46d9c6e909a9a37c90e40ea419c6b90ea7dceb67461e64cb87) (F 0x36aeac023eb19382b8e837d96f1474dfa7f0b52ae777f648be1F4f2b7792d04167808c156f45ca132f4eda0d63a3c9c65b06c341cc34c5281431b67c8f540174f238eaee937956)\n  , NZ (F 0x7848c70180a8017f62F4d9a2c34ecd7843f0bbef283aed65a029bc2c3e14ab82178e749f108e48598a88821924c342b554a0b8813dc25aa8d17edd3cb9af8d4d3f92d61f3dc434) (F 0x5718cd37f25f3fa1ed482912ece1ca153866c97b8882a972f59fd00ebbca870c8db275c1fdd5fdbec7121db03538d32984c10fa048a9ff3611cfb73d59dd53db58e096e3d407041)\n  , NZ (F 0x18186a692c6b18205101babc48ea94d60b9b44a3ac3dce11ab0f1801fbcf2300dfc17db507bb83d17d99d1b936f5e54ed3edd9b253681d6d7969d6bbb12e72406516f8840d3be35) (F 0x490569f61d6775830e23a60eedce9f7ee29729cdf2785102c01ee479f150d9f6c20a1345733265c795eb7b1a162fdc67187bc22a67d0a34e5b611903863196be9936d781ddf1ffb)\n  , NZ (F 0x479c7a1e9cdf562ec140c838238126acfcfcbdd42c20eb1992697cf1f447d8eb65222e2c966e5a31b823b07cda0f0bc87336e55697ffa5927f941d9956bd14343660b5dbcc55b29) (F 0x2fa891b03b5507b56c8887703a89a9fdb1a402b0de00aa64a485d5712fb11f3d89e0d5be0815fdd4745bf131ec774484a139b2c6ed559d6f96a16b65b648f506bfa5c3ef637f81d)\n  , NZ (F 0x05d9d50306a23802da3445b35d989c12ffFb07e2152551e0F9e42f16d262b476a2264fcc4221cddec3154e3c21661a6e1d4b4fc3698e8f7b41a4b467ac0999d8c985b1a88a8b7) (F 0x7b8012521fcd276e08580a42d9d72bd68f571c3d646fa1a9a84a85ac400b49becaa9daecf8f83da8da3a615b00247ef7e0611e687aa7ff9bb28c30d6946709633ee87995e957038)\n  , NZ (F 0x3da780363e1ea076167770a07ae290cb6a75b8f0144f8a0bdc7d9de829a62fa37c72e14c232ab0d21b3ce15f72a2dfba70bf79e32029bc879a0e0fb0824b8f5cec109a94c309e91) (F 0x01e23dc5d74cde68fde271659e75405d4bc2d23656edfc113d03091889847e8cfb687b83f83f42c7bf36758763497c686a32946512f7f4caf3803b091b1b086aef068422af06adc)\n  , NZ (F 0x34b3c4dff18a007cb322a08cc7546d9c2154427ad3b22c7803b28fc645277e1651b2065648430Fb49c7f6406145cFdc8bc15fc9706cc3172037351201d8cbd2b47dee88c24c5f) (F 0x6ced668a920e824b76046255f2124ac16501bbf8dbb94319bd905561a6b4993afc0f2660865c819faf6e2F2f9b1ed2521c6b532ace05da1450e9dc4875ac3746ac39b3703449d7)\n  , NZ (F 0x76bb98f5fF0e31520f5c0332ba64d5d05062b535d6f1a8bb9957d81344e304515b05f706e558053ea47035b8dc74ed9edeb7c78907add1ff553c043b6bb37f70ee6dc8f2c9c9b3) (F 0x3536c1581c67473d59478188091eb25527a8e45ec52a4fffbb781b2dc8b8db4df17712732ee8f65daa1a1bc6c61a9433f00d5bd6e113e1f4ffbdf2beaadbb29eb80a57f4820f33c)\n  , NZ (F 0x283b6a2f66e232eb4101d89acf4a8484d6aeebb69b1389ed34269241c8064b9a35d403da1661ca59bf9f3383c9f51ca501dc9d8dd713dca9db841ea8fd17079c188d4cba895a495) (F 0x3b94a045ba77ba0ca9ee89301111c324f9ca84716ce4bec57f2cbb52ffc91a7e236b64e5612c50413365f80f508c96c012a823e8a8b8586b5cc60b8a5f8fbc00df8c1857422e7d0)\n  , NZ (F 0x1100a16d490883b59ac9571b37e10e6ffbc7347526f72d34f801d4c4ed89cc18c97de7448d28c61e26486590474ecd7d9ab2c43e9555ca1ccddf99c14dd7931843d3aa930d2126d) (F 0x015f9869bf42b7cd929935e0a33ad63245c65e525b4b3204ddd453a385fc663addc8a87570a1142ca7080604c9177e239802b5107005ba9a200e0ab50d7329aFb7f1f709035c38)\n  , NZ (F 0x33940d337b46f2af118e37cda55251b5f3710f7f97d66ea006e94d17db52c23d6a7d53c574f062ce3b96305110e7a2d5f60949323f77c1837ff7266557b49bbd8ecbb3128aa668e) (F 0x140d30d3eb77b2fc15ee889f914d8ef198d66aff6603c748f846421c72e0f5727993274d7f79913dd1968f80cb3e364c0fb3bc7b09368e9Fec7f4f4d749116632e2644b22af803)\n  , NZ (F 0x40b7ebFcfbe201208c25aba2afda14e0ad5b93b92b34852eaaa680631c9f8b785250ac55fc80ffd83b44723bc8818c52f2426179257c800ce6537cdd68727aadfd20f56e10b5d8) (F 0x4b5dc285066613382e48e61fd4cd1087a16763c4bb3aa70a522c298c2c03390cbd73895678c272c928a34e46ba3b054e624fd808302688728b9e493b4fc6a96f678cb84d5293758)\n  , NZ (F 0x422176ddeba263b92904f36770b4dd0036ef3d54b49ba70c246cd6e9f4ff0cb5d5c97e68d8effd9fa40ebce9253d29cd66722e4c7a4f1bb39a5f423889f4ac3bf2ce91e28827d30) (F 0x630ec81648932cddc8760245962f6a529b9f9601bd55286f01cf570c34a04b8de8615140f93b2bf557f533cbc206a0016e79ab84c09bda15b2cd863c06628a313be9b98e5c21685)\n  , NZ (F 0x2659f6319c6c18df52fff0fb2221d71a315f860b4404e3d087e20a12205e23f4a37d24043366f6f40c4b86ec4bffb96a3338c9a4d74ff9e0044f3a8dcd3e0a14e3f2b5c015d08d0) (F 0x751fdb4b4f4a71fbff7539cc50fbe2f1885c1d8621236e150a5d0059bc06673cf22ee68b9ea559b35a97e2100d7a9c75d7998cacbedabb1eed5e583e5faa107656da4617fcc0308)\n  , NZ (F 0x223c4ba033a515bc0bc11529983cb5e33ed5fc2099778d4ac9f27e8ef9da2aec43440ab4d6e309f9b7cf11858f699af3345F3Fb53cecc434f74747389297b61eb361f5a3ed379) (F 0x766e4c903f8f0c8d65ce27327d8da9a199d60d845082a2581714de3a390c711f200f1f3afc08e7de4f7100b353e5436af5173c730f2425db74773de44dedb46a243ed832576bbc2)\n  , NZ (F 0x7e2cfaa4bd15597c8eaeb116d19666f39d20cc3233b315629c0a40c0cd47ce79e466e891b092ac2dab692413530c2c1503d0f3ed4355721e4e48009116365f6293c90f781585355) (F 0x475f45d6eb8dc9060cbc3408bb96c2bcbade90e96b7a3e197f61dc529ac1dd2f186119d01e60c237a2bf971ef208ef9742c44fd8a89ab42f61870ec111b6c0af61385f335adcc1a)\n  , NZ (F 0x28335c295cd563422428870f512d48508d14df1ffa1662201eb4cde90d2de82b00c3aa77f9d2f9e4799268b8bcfcf0c98a6f7370592c7fdbba414174eea870f28a5f58ac46a66a3) (F 0x67024edf507a3224355f427b3108dbc928aacfF5d7809082923c74ce33b49faccdb933bb38e7e9e9fb6dcb22dfc289cf955c8ca15b8b7ad78e0d147eFae6407ce593cc78af1fd)\n  , NZ (F 0x6236c53c59b072242f6105d68d24a3a4dcbf649e9abf8322142eb0315866849966ea9485bd09411ef9ebbb2a8ee9711b104cce503265df6d5792568bdfc4544ff24109c2d55186f) (F 0x07433635710b8bd67165a4a6d631ad09bfd730d6f50eaa5db42eb1229a5fc17bff13eb91ece09ce146458dd217d2617b86f85005fb12376a9dddb6d79b21c3ccf6f492c1f9e2e7c)\n  , NZ (F 0x0e0F1f53ecbbb7a1ca69c20b83cd6adcb53a1215f1ff47869d3ec8F586cF3db8ac92e0a578b97f716251a322b35f825d55af1302879245ee9fb02a0db1f6341333061ba40483) (F 0x442ae2f589efc9b0b642b55ab4c5dede878bbdf73a361bb442bFe62434eb0778a27948796fadb01d3eb1cda233fb892315fdb22d1b0614162cc7c6c29f532d0c1845ae091e3639)\n  , NZ (F 0x53e4c834af505ecc20af598c5371a2172911004d9d8a3f46e63a459deefd36ac21da8939f3ce1e8d84fa23f30f7017aefF7052be3e71658d83bb32ec9f521730ddfd92c4554980) (F 0x11a4bef911f496c06a63296574a34d1b070bcd83327f0c456ca343263e6ef6308223000e7b431f4a61044ee62daa5a428a946fc2f0c345cf40e00b38eda364f528cc7253a2de6ab)\n  , NZ (F 0x755c3F3e0ce21c1f9667d07d274af32003bd138188103c4c4fcce690F41791eb3d6b33cf3ae5482e713198ceaf4299380647ab68369f37e8e582e9c491934275076ee9b10fc12) (F 0x348f6ea593e0a92bf3eb07fd4ff40363f19d115280dc7b4cd7f0f1c0d3a556482c142d49387bd38f81f1de7be41cb4fac594e889e70cefa0016a251f705887099b56bd26bc92e28)\n  , NZ (F 0x5b78b4f170f6a1d4afc3ea1d23f815b2a32942de32c245751b7d466d69518debd1e4540630dcba830d4e035be99f2e1c6b84e58caeb716e2c370b937ee884fac7a58ccae4071d58) (F 0x3fb43106773d23f1a5173e9c42c9c34d69b19703bdadfca42d984142b7d174f28a11befc854f9ee3afaa80cc06342808b57f01c2da77d5cb3e7ecc339406077f4bbf40d51879398)\n  , NZ (F 0x6b56ca08bee40be92f55d5708a237f6664f354e053c6b745c676d1671b6a9f51237b1a60ba7cca1ef2c8f5eaf0124e8f6b2a9afd1f4f22e17ad59315a046501cbe7cce5e89533aa) (F 0x6124d0ec34587796edabd9bf7c3778894ef9d4993fff159e4fbaf541c58d3346b1d5d1b98df8714a22a891154546c52bea908d8cbf666f8f708349b2419fa31847c6227c60af2ae)\n  , NZ (F 0x3b6bb55f5cFb01ea1c51c8a3613f369e92e662a04bba8f3e83814e0d73310a445b52163c6c82f8bf628ee8391F8e03c667736964fc6629153bbf3a24c10b66fb8bf9720ff2155) (F 0x35d61495fd54ebac76f7d27093a805e0a67a1899fd259e838ef47e2b791f2ffc1e798559d9d763b25633de8a6aeb7aadca80184b16895bef07d7aa524136481ccfb821efcdccc7e)\n  , NZ (F 0x575a7310c8bd95026b3c27e3777c47e6e3979680942207af444aeab06d7ab885db9787f58d72ffbfaa57f5ebb11ca7c259e442ba1c36a5f79ef4028ce3eb851014451bc5e403511) (F 0x41614abd43cd2e9e60ee89b2e1f3e29429327ea2d3191b70357d20779e3241e600efdda6ab06f8a3c91a1b9781caa319742a38898176149ebf90c90648526480a6612f268251a8d)\n  , NZ (F 0x23aa49066958b24d0fc54929018a35426681b308f9f47822ecf85456caf701814906c3f917f1241e0649cb814d18a911746fc729a3f29472214Fe304f02cfcf96dc7292f76a6f9) (F 0x219cc84a3432a5df0da6d8d71d65b5258e076ff6bb455e29754a5827d7615b4b03a253581130610432e47483232b6532935a14b08566ed70ea34d03998e80b2759e9f7e37031074)\n  , NZ (F 0x1cb7421b8ad4dd72e9875f651940d4a3ed75bbcf95710b8352a85b72a891328835e785452a51f37f978ab07d442f800972b00d2eee39a49e797f5b8812ad334a92351840176fa14) (F 0x4d050d26f9521ff914074eb9d9b661d8603e5d4d2a8dc35b420c2ca1e7c82dfb43f6f947733c5182b03fd4b3700ad84224Fe89aad837e1f658e94fbbeea6d621b8c1d42182f9eb)\n  , NZ (F 0x07b94a85f6309882612d9e784fcac00284318111a76caeF8e77e6dd7396de14b5dcf7b71ab9db59e53139ce232dac360384c430abbdfa191b0b4e42b92f93a2cb73933c403edca) (F 0x5a34c223208c5f174c9b983e5fdab45ad0c9f0a34b3f84d28cc81cdaaded4871993106c268ea01a7e690cf2f940e1370aa7ac8c73e86e52e3d90f711bcefcc47b56d555b8a80632)\n  , NZ (F 0x7ad98ff1eb67a3d4b9f2ff19eafbe1d7cb53da7b1d52d8480da718ba3a22aea68ffc6695b50793846f7dFbcd0c1ffbc6195a1df6c450e27077c2eb6d6130eb3e19bb6f90f30748) (F 0x07519966b1e5cf37e4dd3e045c112eadee9d3a8949e3749a7036738d410476ce32981b36d0ab64bcced97dac5396a1888c869ac9cc7eee344eee1e56af6817ee9ce8222b164f45b)\n  , NZ (F 0x305bbaea3a23047547f75c3cd73ecb130b1d395060f6a8e392de1242cd8880765db46e58d6b79ee17aedbb6dcd5f6f6ba5da45233e7a4bde33bb757bac042f87dccdbaa638fc926) (F 0x02e682ce3bf9139c60dd39e83b81b9dea52ad3319a6d262f34c4255bea295483bfc0fc0af5e531cb9cfcf6bb878fad342947c7968b0181ab053f4d957de18d7a5b024625ccb678e)\n  , NZ (F 0x627fd5c1c7b11187b47c9bf3b1c9d53e4c4bbf93d411F522b98e05cb982972cbae2ed94c373fb49c34ce887e3ecc213ea5a0e909cd1fa5596de6ca99c788f2d1872973d9911cf7) (F 0x066e9c8a18dc90db2b0becfa8cec01160a81837c12a7028dc069db628947542c53bcbfd342fb7023ab1f325e4b4b39dc8424fd5f6ed82d2f9909a97890bd65180df55a7ebc29772)\n  , NZ (F 0x67965be5a9eac8e589f6cd714a7903fd8a6d7e8fb49a2405362b47c50e09fc703f3b78ed2500bc7572c039bff47f060cf4f103613095431cd8f1653b459dcfF12bd44e57bfd558) (F 0x1a9baed239596489a20ef956bcefdbaee03237b5a0835a6edf0e2db8aaebc9e3e356e3Fcb36f447aa513add76288c7d5e8ee8f7ea595385d4da107fc3c39294e979c9c84424045)\n  , NZ (F 0x54021a0073232390e4f66bac27730693567a51f47d784bb80b78f553139f5e015207eb6edfaa5fb6Fd4fdb118749443ab99e2935cdde101a96Fecdf84df190d15d8ede6f32149) (F 0x615c86cd0c1aa157917ea45d43dac5761c01b497c54aa3e45a52c8aeb21b088149499434a182b87a18Ffc82bf9294538360a0f5a179329a90a29fd7b8fc5ea13c833c3bbdf6ae9)\n  , NZ (F 0x35Fd94e66503330753d999554b6db32dedb5ad46b982a103217e1e15073c2347142165b55e849792ee41622d06875e2d6840cd96c493af335440efbcf5fa6bd773dbbe553d1b1b) (F 0x026dab3ad6669b9b9f228460d5cfa8bb5dcd2a1ec522ff6bf0ed1a02c3c6eF357efae9574abcd6ab0947223e79c25d8f8b75108f420d6c2503Fe8c70d05713001c7c85ae4cb13)\n  , NZ (F 0x1401c8d699c7ef490250efaaf4da80014c65f00e832cb4e26917d72ddca42efbf028baeb65c18494d81bb6c5e9f7079234fcbf5fd567e0b30a5b95d6fb15d088d5a92184594ca13) (F 0x312b563f34b404bd9aF4205de4cd839d6558dfbc083bf27fa205463daaFd099c4877af8060bbf947ae252719bb17d9da62f583455475dd29f71818066383d225c71e42a78c279)\n  , NZ (F 0x43bc8838a940286af8397aed5cfb0e13da386963a0220e4365fd4499109458bdeeb6a1693d9202cebb11bf3eb2818b1f683cfa8e85d1c26c1de9ee979fcc952eb1a307b6d37e46c) (F 0x5cb2f1c1df4899ddb6432eb046965e3dfba96cdfddc3445c4fd08183316161e4956f0fc868cf2b816Fbcf0520eb9ace0998ab17ebd94662402b482ed3cd1fb1105c6a9fa737487)\n  , NZ (F 0x7bf83350a4aaa3839f7bec16936494d8d90dad7604d76588f40458dac0b427b5fb56d8faf1042b01672605128d927f38862ad0a5966989dbbac019415220e7d0a78dc9056da7541) (F 0x2e07be5e1ec9cc9b38708937c845df474139d452ab447ee8b8F683cc17d3a4375bd5a69f218b260d9d2a1a9b88674870a779fca3d16267a327f1fd54760d2f6d029d8cb94297d2)\n  , NZ (F 0x27f8778e9785ea6d3ee56a35af6e1c926b9cf58b0d5d43c3e2132e13061259eca1e8a1887ce9de25d0e0da9bf6c5ccf72b450df793d0b08daf27656c022f5d527cd36a3304c500b) (F 0x6ed2dc412ecafc05d822b1a21527f24ed5beed4445b46e6f2108b5771a492b8be46cc63ba1714269fa869afa46bdc84cb815121c56fd089e7a97fb3943e848172f5583ad3f90cf1)\n  , NZ (F 0x7119aa9ee307d302f829d2e013d8ea10aFc8e780eee0d56aac14dc2fbc06fb640d01668ef5f57afa9b94dac762594ee385f85baf8d24aea9f880859d4f83d47089356ba005729e) (F 0x39ab8727da4b03122c829a42F25113ee054b521dc32263ce46b0e77e9512652874a92a94f1299e022c02ad4d44df654F5b6dd791d4a1a0d5e0b74d9a0d521b39c7494eedb8b47)\n  , NZ (F 0x528210a266efdd74cbc1f3c625b2a76e4000e15742c584b04273cb2e6101f30291fbbcf0c7118f8926ab264242f8a9d8c5b8afa2b4548e55074f7d9893f8b416747d0fb0a065d31) (F 0x1c3d14fa974494c65cec2b6990ae0176e1a9cf28a5ad45e94126e78608f349322ac52458b2f554cdcf6f4a8b9f7b93e61787b7d36eddacf125cb6a3e8812b3ba5b2f144bf108cee)\n  , NZ (F 0x35eebec9ab1ab330a030a14569ecff850178df57f90fd15a9f654476cf67f4798af3630f3a568ea9f766ce093812c5502c162e27a8ed69830a87062c355903f20a03b01fd87ed1d) (F 0x66fccfb927b222572fc066e9988ecb1d2bbe802b069a6f942de6ae1eeed17fb23e56b8d47ea059d9b4e39fba5a417042b9c016fa4db74e3737a39f78f023e9cb6d21b536437907e)\n  , NZ (F 0x174a9f6dac3a5f59d330fcff2dfdb0fba7cde52dc4594db423ff2765b62b478af3e5c37646f8c0d7fa2a39025ae6065551a9a3867b0dd551c683eded59252144b9822a8f6861929) (F 0x1a624adad4015e3740285896d158f8d9a2becce2046523f12a256bbf2396bcda7cdc1ea6610e904cae462F2e97e269fdcf8d735792870b66c4146d683beaf9b9937ecf5728bdd7)\n  , NZ (F 0x60ab210a15eff90ce9eba8c9138cf5eb264e89356687cd67ef9269ba2d1636679f38df3a7e029c6b636408fdde7ea615d9d059066a5dfd875b133d838ba3a123c69265c702f99a1) (F 0x29eaaf5c2ce8b6827d6e080a993dec120241cb3bb69e3bb52bdb58153da49143d9b80a3a98e53d0175fb9a22b5c94f656cd139daeabb2527dc5ab4ed0107a63e84be3979d7a5172)\n  , NZ (F 0x531a0464a9fb9f2c67c03f97e1d5b22425b9c8e0462f5ead16a126a53a89087197fb0d7781385713c1b933f902d8dcc7b2c2e70d2317626be88c83f8ab171ad0456d7dc6050856f) (F 0x1b8fb03a70863efa7503aa4a36505cf241be8b79d065b6d3e89498751b79524044cb18f89e1d12b180ce953457d43c9736edce2ed178d799f28d8497cc74c1d44e30e5ea8e2d5ae)\n  , NZ (F 0x32f4d59e7d6448f7dcd9192ee13a2c54572de6687bd7ef9a303c5d2d1667be44b2270d02a47942cd428db3b5e7297425ac429F41a9ce89ba82aeba50d658e0b87abd60697e8491) (F 0x215e1b051b88f08ec2f6e4e0726702f4355e13919b8967887d6b089636bb3f9bf634cb79a6adbc5c130dbe4029646213cc704b7f70b6e114230434aeeaf6e3e48d07ee2ed0b11b9)\n  , NZ (F 0x798f69f1f811186e4edc165adc7defa44a5715d2c39d94c4726a97f2452ddaa401dd06e97c071222528edb87fce732cf109892bfdd3b88bac1dec143655f81dabf4a8c0272230d4) (F 0x61892c6fac23e270a81a8ef9cfa1437736b4230b69e8dc90e2edf85ded7563259192ff574ccc7486bd95404c7e216aef838347925866fdde22970642cb6ae5e9558fF4cdb9ae2a)\n  , NZ (F 0x6b4a043a32fd32c694a7767415f65ca0eb0cc91f5dac231e510888b1b7364d2311dcca28a0a29ac5c1ca8776565a718e9258a1ccb84b48d126f2170f23d1effd4eff7fa665cc23c) (F 0x1e060a4056c263afae920bc3058ddb0202d501382f329ef8d4aa29624b5a3fbf2e315a4d2Fc68740520b57b19cdacc21bf32e54f4091232f6089b3a381ce8912a145c32c0da1a4)\n  , NZ (F 0x45020a8ab2e7960653ba1b7da62b20861aca832dd6a88c52b16f2591b84f7ddf9bf494e3105ee444731cc59eb8f70c4c2F01d51ac2fac1cce6a3649351d3b03ea443df722432cb) (F 0x035a023e449c1417638ede14e257a25d90f047f50492fFffc4bb44dac1a70c2ccb7204d181a9be8e3cedc89a0b488103d86d894fc24d00ac18849e1a82ae0dd05677bd9ff89967)\n  , NZ (F 0x2b40f03fca12058aebe96a0a05d0db60818a7a102061087258719bb950812aFe56fb90696cd6022b4729a72ae050ca97dd581774424acffd245192f5424f1ddf06c78691790c8a) (F 0x64432ddfbb2087afdd53e52d462fa11c5a4e6c73976854c38d9594548615cbcd851e8e0b3dcc2cc2ec9576e4a3598fbc17aecabfd63b396382d1c2ac32f3e3fccc7e0962bd5caff)\n  , NZ (F 0x4b687be60be95aa0a889901c416bd1a1d4ed1672c976aceb22be37c7f6a3d33c60031bddb6904dc6a603dc696f583199aa5f7c6e7589bFab8da16256d24f58fb55c6609ca2cf52) (F 0x2a72538eab5404aba298e9fd00d8bcf003ab7ab1ef859dd66f501d029a115b18cd36732d53fdbc9e8d1f282303facd60d588fae09ea126ae545a2191472986448dc807c6310b222)\n  , NZ (F 0x24b6a954624f57f3dae8ded05b3e9b9073e00ac3197aeb220b77c8997f5d7995cac32c8d28F4cfddf8efc4690ffa21e54fa553752a37ecb87106623412691F17d44cb403a499d) (F 0x46086d0b649ea0f69c3f644503cba8541778dc28dede5bca58d82c4240d79a5cb802a6e1ba0ea330463c82f1d978a8d72b751e0c58391341d5d6a99058910b824F816e94848ae7)\n  , NZ (F 0x41d98200a7f608f82772bcb00742fbe049dc2ebfcc6fdf24b05de18e2a4f27e573ce431e9ea51b6303a9694933d21d38c56a5a5bcc7d3081490c150762c031ae3cd47012ad26303) (F 0x7f4c2f1150234cec53c90442c392846e5b93a121a06f0c5f732c9255dc1e9da3a5aa3bbcc82215836cc2066952cbdd47fcd6c9398d0f310e5460784e9203d0a9b14e0aa9c3cc94b)\n  , NZ (F 0x67723885aefd349610221f04e57620ab35bda2350c46f3bd077b68ab9fa9cd36cbf72950bd944c1ca47051ff24124067ebbf3591b7a48314f1b2ea6bb02097432c0d68e7da5c0f1) (F 0x6eb014b641d5a0bed8bb82dcf36177ed698a19900bf4c5a55f389767846aa76ce411f9d19b537e0cb5ea4a09abf963a43d5e9d48F0f45f7d3c63020aeb12077a07e4a34eaa9547)\n  , NZ (F 0x7e00b9eb12918f71c45fbcaa3d9f0ea9ee4c3e73af523ab8a9c0b63cf6b317e560929dd72247dc68827819ee8719c0fa684f3c768f8cc4a29f8df5b6630d0ddabfd37b669679cf0) (F 0x48f8f577ae1e57437961c5d9f293ef44b3ceb230f356d9873915cf550654c42edc2db856e67b4f0b5e0fd99a271df8Fcf0991b4d1930d58951a8372c05348749c77f6039df6c3c)\n  , NZ (F 0x5260d1736ac29a3f8d1fb5df7b2796f2975cfba0b1082b825df00dcae411b0db901720b680a4943525de5d92d720d291c96fcbcc84b0bff24ffca50b3377789deeaf679a7f8a04e) (F 0x3dbd74181b7b4c5913ac08ce6f6db84015678db413946c5022df24e4b359406070bd3f3d15b7116e454e25c2f7523a41d2c554e1b8921ab468004c44dcd655e919f40366607e9b6)\n  , NZ (F 0x72ca28ea57c9f90628349d2a4f7ab70ff0cd6df7e744216ed774bc275cda176cebcd72e6f599579a9e009171d578da8ae03b2e0b9fb7438abaa64765025b548a18029886ae350a4) (F 0x55343e218a707698e9067b01fd3599db43121e4b6dbbc80eb46a001c88eb777f2105c96970df0cf1c5f64a5bc44ef09ed5185f6062e981e2d97b48bddcffd4e3bac3f05a7781302)\n  , NZ (F 0x5c39b755a80009b5112273aad86ae4804cde8b3f39d2328025761df567c7ebaa791d897ba3ce6e64d4b2ca94beeae077dbf63202b1b9692d3b688108442475a3eaa0a7a35534da4) (F 0x29a789b84ccd65d20399cf5955ab267481bfbf73376bd037d702ba265c0c0e9732f6e84cf3f571135ba8b49f298463d1868e3990c44620576881ae79e308c2e40381a8def2f293f)\n  , NZ (F 0x77aa364eeb14a6a95c9bdf044963e7e309a9d200a03ab92131d731f4842b8338fc62fcd842ac9f6a0b53a43a89df45ef61f9865f7e8f23b32a5c2fb2bc3d536dbf9be0a84ca1a35) (F 0x2b867eda0f44fa3a626c0866ecd1d95ecd76cda3da773ae1f58ef2Fcca0139f05c4bdfcdf0ce5752511dc6f2ba4a74fbc3ba517388fc70249a9391195cfb5270f9cb99f3b7abd8)\n  , NZ (F 0x29dbb1450eaf97140924cbc124a327893909b94c4ed2300aca9778a7623e71504350c1f4731d87b6e4dd57250224be538c2909c10d68b272356b3068f43fcf328f937e365556bac) (F 0x383775ca885a5F0ce98da21552d1c7587e253f22026aead75e3f5906a396f4208ca8c82d5a5d514bec51f6857a91db6eaca2c0066f090af4f115f08cb7c5c4d5447b9b120685fc)\n  , NZ (F 0x365c1397c9800d1735ad4480c67f7ecc4f93d41cd34459bb0d3d090c9d9cd8871cbb0cb664db2bd7d5d8bd238f091025d516b7d684470fd659cda0008181839173d549f2c587d64) (F 0x7cdcc4516bd725a44c0b3a1263ba7c4cab805bc7af704b7986acff38f006a9f6d2b10661faa4f207b36e9bbb9b95070a09ea007776791280bae5a15eab934c3abf6a47c11497431)\n  , NZ (F 0x50b19f451b3acf6b6fb4325daad9e931a69461f103e9b3a0ca9c31e76980c5aff1e4fd65bb588b3b39b3df0bcde9be77563ef200e47f19fd51342d83d352b195d8cb024fa6abf06) (F 0x67b5174efa28a978dcac1bbe352f78bae99c6ccf2255f8cf2145b93a4f34e7ce7297Fe1e5c9e9ea28d11efc782fd92ecd86628ed05e8195afc500159f28a5a9ce63bc02694aea5)\n  , NZ (F 0x747050c59587bef98e906842d0b15a54d2cd6f366420bd0a89b4bcc6bb992d238d19ebecc588cfd1965b093a36ae1d23fc0e435bc9167304627417959dd9bd9c2e18f4447244a73) (F 0x1709696ab745c52242876f6aef5679c02bdd0a4188f93db67a49e65b1ce6a7fbfb4adc30792f3c266318f722362d58ac2da66b2dc6de7d7f4acd384ec9b83ccec3487e1f82d49d4)\n  , NZ (F 0x79ce46262c732b7ba821c97158e2718a46851034f8717ce8a7f37fff92e3c7be01e8969b356f7eb7879c9d9d7c99e6369751a86bcffd3ac62ead93e2d3909a47b4c213b98e0cbda) (F 0x0394746bd24cfa6d9b6bff64c6295c0F1ab7cb35efbb395cd920ac5de89a5db22471519c31db82ef544d105457bd159186a9e2ce46b61023dca5af2e9d50ad7b2924514bfd552a)\n  , NZ (F 0x33dcbf154a2068d1f614da13ee5e7eb8d23691a2bc8c7ecfbcc6e05b0d339d9a168e7313b5a80ac5c355cdd1dcc505879d099d999321658a308a698eccf3a015e7540490cbb6b7a) (F 0x535ccfb1ff8009ae47ca0a2e8ac9f3b67d43e3a82f9532988a45f6f880035598e4b4bc9da5d5e357f89634098812d3994405a8578f15b9957760fc49ec28e96c0ec2d16a97ed7bb)\n  , NZ (F 0x28c497b12c0aFa0e36f0e80223174f2e5f03837ff6c2e680f49fc662bdc0d88129b45af8a4611fc84006de92ce1dbeab075bd89f96e6d3fb0514d52630207401216a03ba8d292a) (F 0x5aff4f53228da53e47465aa923f715F809a70f16fc79d49c27b9880013ffac98cc862c6e4F6a1a9966c0a927662d5084affab8c67ba94f8a55dd0616a77b72d879cd80bfbcd06)\n  , NZ (F 0x750a4923f6a4b633105ad651c4a29453dac455c4df65492530b4cfd718075e0e70f2aaec7a9f3089f6e574b2eddbf3895279f46ef4bb8b9fc9c4798f610643f6cd3a2b982bd13c6) (F 0x49dd266531ab0299ba7ac056498f9b79e5c8adc256daf1f13d31bb552ba208126a5784eb8e26436d941bf71e369bbb55444a1b4cf519c88c3b4a7700ca9f16fd1fbe5c352ea37be)\n  , NZ (F 0x22c098429c6ba2f0508c5f9d64ad23ee8bFec827875f589b2c5b6420cc408a0ac5dff1dc91c989df650fb4aF66050ef86e4e4fd44a9c01e87e0a91269ce40c98Fb2ae44dab0c) (F 0x21a8c90fa744b668aa03144dcc6694db433ba5647483bbf525b06cf4a800c7eed07ec23b67c728512e369c1d923205b20cdba4fdf680aff02d90d20a928d146785347e87dbfca78)\n  , NZ (F 0x126c35651bbe3999a1b9079e8d7a564d9a96dd6817cf189c83164dc32f22fb725d95e9866fdece0174c790a242c5124471c651afcf1cb7f012038bcc0ce7bdd4a3d43bf27384402) (F 0x3b70814dd3a4f39e7f37e7cd03387e9f137ed634858f43d8f61d9c4199F9c013f38291cc292f8ee8fc2d13f4972b2031726cf5eee8301580a2122becde190afa348e7092e2828e)\n  , NZ (F 0x5a4672875411c110bec2e5426284a5d7478d9faaf7b0315F06b1dbf019939088eb3bc96c2be73e169c37d51516d2a46c368fa1cb69680ea28842195e5dcb1e4ed620ad95a0a0d1) (F 0x0b623cc8243747e8cb4c454c705520730ce270ab39988b563fa2a8ba2188fd434f0950779eecd17a3ce5b5dafc8ac7c8561cea85be2bfcd4ab8f351c4b76480814c44bc4e4f3b5b)\n  , NZ (F 0x5c4122451a980ba946c38fde723472c1a94f6e8704b270510ee372c6b4b4c25fa3086a777b6bf7f4664e1bf5439ae807a278a0664eb890bd5e3f2ed74628607a02bb2dd8fb1cbd5) (F 0x34a4b8a0df3aeab5b08cfb8ac699cf6344dbc3dbfc8c4cba7e788f753ca6666a47b4ab27fd4a2950362ed6626eb92d9f59ff3f1ce81ef80c5c9095317185f5a567ad334d333c581)\n  , NZ (F 0x796a712a63677c1e8e055de8b86c450ed73503b1b47182ed27b8bf6295f07161eb7c2083bb3a393b9e4f45043dd0aab9d488716297b313680e410fdd9b5a5219a1499458f9eae4f) (F 0x31d792d9f8fa7f2d1f7b2d4392c2acb88c43a8285acde12f8a3e0009b4f40f1640c0819839a1a64e6361b22def21992dc030abbee27aa25ef0ff15eF932950d952efbe4d7aae98)\n  , NZ (F 0x25fdFc99d36097ede65569064f4a0e998de0f116d6843e215831e6a516a915343ef4b2ed151396c1725cea4876d8037efa00c394e26fa68160137540c7b3cc539d9e5791f7cec5) (F 0x11b9620e401f6c611b01827e6eca5e29b1af4759f63974ab8004b17f1782e63d3590bd5bb03c4a258f72c17F7adda55d309c24cd5f5dc8ef4528c73949bb0d3102d40e18bbf448)\n  , NZ (F 0x5b2dbbf3920e84952a4b952cd7c470fbcfc37ec208c06fcd154692a603c35508883e9562a68ff09be6ed9a61239b3a1d883283b8f98830b0b60770379fc6b2538a21969c7de0e64) (F 0x2e019cc4cd532dd9cadb73a32c303a7971a94913160Fb3ba1943af1f0e059d03b2b1e5d0813951f957b6854f8475158c21e31ad314a25df9e80d73b8ae73acc88b477c36debdc4)\n  , NZ (F 0x680b84661c08da860de17510df1b9ff4f557bf4050dc5bb19d0938ab594e23a4b1f9faf100d34ec9d63d75167022f46351de23eb48d7917984bc4e70983ae569bdd7f3ba2b14a46) (F 0x51aad1c1b5c454a8678fb46f088a8745c3eac254f199a5e327d5a4942e7d9570b38a3fa3bd7e7d665cd0f1d7d7f87887bfbe9f98e2bdefc81ceb7f7c8578b01ddfa598675651f10)\n  , NZ (F 0x7937b9d5e6f334668d184f6270988ba4b0175f4bd1c911bcf26b9eac932aec286d2494b68425ec7e7298e21e1aa6fbf4cec1c47f10a9ebdb87f85e28a7ddbe346546ce6379fcf61) (F 0x3c842f9be1df9224f276c02917172562e0b8629ab77cca477e9e112fa97ee01c63ef316b10da5a905c840a41657ce1276e2680d6f131cc8b02ed023dacd259aec923035093f506e)\n  , NZ (F 0x7d673b1e1571ae18b062af9209c377ca17942d91b5061bdbebe8bf05e3830506b9d441470640412c3cfdc20ce33c48813f2013da7293d687e2b725862c858ba15dc7b94f922f2e5) (F 0x65bd7c64773e4036ba2806f4861e7b79056ff08943d5dc85a3bdebe4c3c0b71a9fbad531ac3c0a04dc701304642e52a4f97001c4127aafded5acdcbea1c24eb76727f6e29bb1360)\n  , NZ (F 0x36a7249bFb958de4f00712499123245fa91dcc0b612ada84c6e2d8ed309970454d6951383a0074478a4c27bc28fc2de4716064f114d9a2ce72bab7836a237760dc5e056704f817) (F 0x6b45842c54f371b86bb9bf91af9121402ea5eddeb175afcb59718d386e977d450735820b735bb6dd5fa002a8cb01545a3f7cb2767e3f9596905f63c4b4e8ae0c98363806aff98e5)\n  , NZ (F 0x5eba5b2125c3a20c4774c38f2e0b3841a6b59442591044ccb9375f6fbcfcf96cde208412eeea4448669b67f0ec344a78b0497653fa79d1779fbdfbcf44a441971ec210cb138f7b4) (F 0x51755b6b79f8a2bb491d65d793a36ef3a203cfd9e4d547bcde659f6cbc1c9fff3c24b6150f29d2359dc9c036f8014387fb9b4018fd3b0c59923afd56029f4b7a405b7e37a283085)\n  , NZ (F 0x45b33ff6cc6ec770853c5b7a22a281e0c93d749f26f65bb8861b310e3110f39848F98343727984b15b99dac424b23294c505895d83a3dfae92cf8ac5cade414757fa76609fab32) (F 0x7ddcd16f5702de9b76672847259933943b2b11a8887f4f1739c2a37e60628c7427bc220f4c7abf755e2b9a841dF8b42665e91727972bf7b90b60a3f9de87697fa9583c59e9d728)\n  , NZ (F 0x671e996b99ed09e58f19673d53a6f5e7be412b550325ec31c04a1b77ae44f6e7eb65a2659f7251Fced42a8e936c5ef57d5f95734e4d3bcb3e9d00303a7f2cbb11377073a49303e) (F 0x7ca677f2e4c2564f6c0786fd29434c2aefba0bb6074c4f893bf3e56545dcf8dfc95d10c8bb4a7218e074247bd4c941d5f2f355b0c99697d1222361006edacd89f143287cf36797f)\n  , NZ (F 0x5745a33ecac6de34a50f955b1ffc56ae7a4eb2fce18616f86beb1a3f2b91363a984422d915caee3da54c1e4c6a545054e80dfc3f3817d7fa472b00F9c5e0f0ddf50a333eb56dd9) (F 0x3d9d3f856d9a9Fa5a6b023b05c546dccad1a1f9110c1e6b6e243709ea012d548f64519dd7f315cd7d07868205eec038c0e735dbc4e430eeb53eaf12a0e4a8174e906c4e4a55b4b)\n  , NZ (F 0x2cfae4592af570f38e541dec8dcca7cbeade7d892e3c18dee90d3e9b168351bdca76dbbf314a00a55dc85e6d382e42018b86cdd015959fdd570df48f06b23b23358db01212db87f) (F 0x648ea715e8b48bada7e967a4e03048c56174b19fb2e2988c01d2e94414de2c1afacf8ee93f06373072b600c9afbf73f7936c6809dbabb3d7695e80259dd97f2bb5f9ba1c5b7cfb1)\n  , NZ (F 0x613f3ab3165fc71b004088117bceb41b3ac50dd7b446700011887a95b7c824faf76ac3404820762887ca179bf2d10a363fa3a20fa46ba2c76147be6b85f0f8c5f83Fb0e3a6488f) (F 0x2e52a4a35868f6702f312b627c7e8185352904698f54162718fc3c7d026e25cafd39e12ab306c16b341a35f7b37535f3cb1eb875d91c71be6d4dab6a248949f4db79fd02580bac8)\n  , NZ (F 0x123c26e5e9680718c26e2eab0facd11727119816af987706036fb6b7aa175b1267f73ebb575d3c24a9041c67368e0771b324c30d12392f4f034225f3850bd74d13824b8e9e233b6) (F 0x62bfbb315897247b0547e62dcadee059c8074f6801dd5c0a3b43809c20de83797d61f3085c4097898ad8bfb1a73287ad4bb1ba75e701768a879304bde1c871d96b69ed26558a396)\n  , NZ (F 0x14f26c7ffb565ffff35d1dfcdac4b26d3a17cc7a6b891ee80144b8635891517ba14e1a92a1363a4fb0a3a7bd42b7c7826191e8a9624122058ef67c035d433df86f69c7c0f20a932) (F 0x7b79b848a40ba4333473766579e698457a1c5b0288a7c66cc0ef9bc198199efa847c19297a04e7032665ab2cbc8c89eb28535a62410c9e63db3df03010c4714d7f7912b3e8ec1d0)\n  , NZ (F 0x3b53b5b443F18f770bb7c999135f28271ab283a3674ef2fbe284399828b9b5f7788242cac75623b7d2b76bb7a4bda51abcd8149018269d7173cd3f08112b50f854ca5c30cb424c) (F 0x079af554472db5fb9c807281d3563aFfa13de9c895f03054ba9472aa951a5540ad0697576309b74f6ffdaf7fd3006f1c8d8e8d84399F9e885964d823cfbb5cdd8dadeeb02eea0)\n  , NZ (F 0x105fdb39f97dc10cb83c3ed23f17e4d50189b87252c012d67dc1edb8af20aa91011943650d67c0709899a6c06f065f94fa3de9cdb2570779a51b7a4c50085d6446b7fc0f0fbc471) (F 0x2cfafce1d14283f59cd3c27493ec2b3c5aec5e173ac5a18a5f2946139c4fc373f8fcc95380c18abe21c037ce7f98c5106a88a54b3ab5d7a31d90abbb837931de66f625534803b63)\n  , NZ (F 0x0962a184aab92f543807a625f590c180534d2706aaa1f75a42364e707285b3e5426ced41e7dc6d8a39db02b6d433714e931dc50fb928f3e9ddc4cdb67359db08dda399b6c1924f8) (F 0x71bba6c64295b24fc29ac4c2ebbbf6ad2c4c9e66a90c78462a90c731ddf5b0e46cef90c0a7cc0c3923ebc1f2984eb2d0a9cdea22e48a0369fcaf4e4e7e5252f38c2dd411866c57c)\n  , NZ (F 0x1adc2f8701850d337327187a79350544d801a8dd8ad07a722a661c48b8633951b1c4061e8b58e33df7d1442cbfc6baa8310beabb5ec43cc2245345c6facd51939ed5e0cf6cf0183) (F 0x6ce927e2deee5079d4978707a27803888011d8453bd6adfbde5a1700d3545eae7b7fbd88939ee818ce0de0a3eaed668098c3ba4662ddc037796f510796b53c7df96c37f1eab82bc)\n  , NZ (F 0x2ae01f9453f66cad96ce925d99241008de65b45bab8787cebeb3197eb14a9a4cc751a7d06f631a1bf5f2083bcc011684c5732d9a38675bf08da0675f62ac8a64ea26cf01557f893) (F 0x23652bc1ff40549F9275015064e55e7b4b7a18f5dc801e23dedc2e3d7bb98d56a30cad08a99057f49ca1bd4292af85230a7698d5d1cbab9977686416677d73f56c7ae26428f75c)\n  , NZ (F 0x4985ed40c9e2d479ef810cd18159774c4645d248051b52a053cd4a3d3fbb51bd91a1ec7e5b542c052dbbcd63876968c474a0e31849867a27eb8b827c1fff4fc8a97e3b4ee515b65) (F 0x6bb1dd67e5d3d9371e3d981262e85543fa88701af825328bb36e29c601eb7de4a31b80eb79e5dbdf1f88ca73941cac2a8132890dfb0eb176e2da821f4f578323d79dbfb56d4f294)\n  , NZ (F 0x2003b099d21cbb834990f878f0438798b8c6eb2edba0ff1bb2f78a6bb7e4863742daa9eF4f86de202064de38dc233f289a9d246515d33899b2a57abbfba48dbb15e2f71851786c) (F 0x45394371cb9534edb0605699841c12095344d233eb11868a16de07042e929beba5c832ea7228490c6f82d564c1d7697a70b6ae3ec9c8cdaacb4a24d5e88069b58daadb40c2def8e)\n  , NZ (F 0x51dbF35c4e4f0db98cfa741ad10ec1ee95F257aa734d44d73c132da27dd7d1f2a5a44849a54c52836139660ac4ab3f38869724a64eed1cdc3a5f465fF73c644afbbf35047b31) (F 0x7bf1aabcaa2544e5b0c41c88b3f8e6c1eada67833436e4460b32863396b927ddaf56f6003758ea446190236775fc9ea2e6bb2354906c8258e2f847b0e7eb1f78358852453e154e6)\n  , NZ (F 0x1c545ecfc87F687308879a5a2f704e89f71f522ee15413ebd4dfa0ca7cd38fff728df76aeeb92bd10169cda4709d47301b787f17e8f7f31d9acc35e21c73bee2c1e40e34f80f7d) (F 0x0417114ef4c3353c80c85a41e5199584dbf819fb4efc8071a78b2a8cf0898b589fce5abb37f274a4cfd521440981fba8219b0c77bc90651f6ea4bde41205e32a14552e749b1a6ef)\n  , NZ (F 0x45282951813a86360a737f9477965cc4bd305862adc3601a0acad11322b7e1a5beaf0e4c79e4848b65c0aef27af528832ded33b268cc9d5443a9b8418d9e11e7d2eb27c2f00b6d0) (F 0x25ae41d2a6f4da08a9683c7f1fc862afa31a9ad782f34dbb28de2774799957afa1ea912e96db22b1e7966ca32f621da368e76d65c7111b81c22ed6f355a6a50586930cdf7d6db01)\n  , NZ (F 0x08f3fb0878e600322ebadd5252d49c54518d5ec56225a6e6b30a2ce37d42eae0e4164a441a3a2b35d9442205125534ab55a731e27860a04df95a059347a86458300aea7e4ad2acc) (F 0x343a00618a92288c400f7e1537db087854d9FdeF7e5daa780048924497403aa847aed8df10d33bce8300fd94b6b4d400ecb7b80f7ccF1830c25edb545b7ddc4f6ea71f18cade)\n  , NZ (F 0x5fc11a7570a7cabaa51d06a3459ed775ff37401286a800523630f27e6c40c72192790cae0fdbdf7b76cc602c063f2f71fccd7b5c49f9f698503b05a439466c0427ef243c098215b) (F 0x3cfF509824892aa939a8835368a1131c8e944fd4d7543999b6f67ffae815fc6786fff6e5d61b6e9e2688ffa96b46f869ea3be633b2ef90ce1e7e0e90f90b00ab59582c6958c2e5)\n  , NZ (F 0x6c7a31663ee204389b3bb735bd596fbe0c1b2ca208aa29039bf5173Fadc932aff6996F1a8a778d11f2cfd500522ce5285f858c12eabb3ab1ad28ec409129335a7e5512d04df0b) (F 0x624ae2a1bcdf0ac2667b8f0d7baa59230eaf66d047363bd627c0170abd50e026a821156dde688000bc6416f4cc4eaade2f2167d53e8f7a65d4b5f4d2856eb73234bbcfbf1265ac7)\n  , NZ (F 0x44d5144f422aa01f978690942398c036a4b52e1549d6114ea3fbd95436b32176f6c62ae132f8b7a86fa3361d7d78cc1ff9266d1b120752ca8009988563a1f132883c7b20ce70c39) (F 0x030270f5fc129e66490e3bb36730cbe2c4d3bd9a49c100017ed1c061ec6199df9b388b31773711cc8c31108dba3941832e5a92df80981854f9b1ee090eaa35e150486034e2cf76b)\n  , NZ (F 0x71f120017609bac1bd5698c46f7a76b48e35ad80c444f45da764bb59db5fc4cdb522d10f5b1a69859dc990da9f52cf41eeb59354a50e39be818e053d9b91e8aa88665034ff25745) (F 0x5f9983b67aeaff7388bdd689b6188d007341fbf645e59d1d008c2e116ef712132d6b749a0b0622e76b8a028bd716d372d0434f780980993b883be2a64d4f37e27e021e1599115e2)\n  , NZ (F 0x397aaaaddea38f915ae2957a63919e9b5bb621e464650a3d923722ce392fc9675c9069f8324e234c78434cdd3bc74b53e6aa31c55138418327a28549322d1935357ef3cd150bf9f) (F 0x6971e39e3305eda5f3a76c8c4a143a700a793f4130628e2b92987c2a18ea40e30538a656d231f7c0d52ff2fdf9264b0e36c51fc48d3308ef89bd96e18ff29cb2c86b5a2073ade60)\n  , NZ (F 0x5d4303ece7d319b3d0087b23286c99546b0820c2e086ff2fc0897dea80af3e12097838e671cfa5ec60ac8f8ad6756bc22144d60685257b0666be692cdaf54404054f603e190ec39) (F 0x3c507596ef6dc86ef4f27a9d0497939d05f8d6a6bd0026bd79d8d941c694a887041c246128fc29211e70423a8ad5d738641ef2f05746c4c8ae0f80991a2181c59a7bb24facb94f2)\n  , NZ (F 0x237dc5fb2c18aa357e982434c11a38390b932df0d91fce549d340c0b594ad53d2015b70f258e5940632bb3b1a4fdef6430ac377bb05a77eea6eb94e87f21b48b572178427800d01) (F 0x35d176ddff2190172dd5a0fb54f6e44e94cd8f76dd1b2ed60bcb114ae27c8e63bd40921bf6abcda5d76b1d891e0b6e00c69e48ea65d441346f93d802b5bc1523110eeafac36a342)\n  , NZ (F 0x1b1a7629da0765d97f5f23f037ad384720d250150bf1cc1f206a20574553b32dd760a726955a5bfc4a32fc0a423516acd675a63d0dfab650fcbfc68232bd4e367d08a9c6a45f31f) (F 0x690c08f214407c90a073d39772f1f3a409c6c2a44640b002b48bbe76db3c5135c5fa4bf5697bd2bfa3f7ce78c1df292e8e341c072c8a17e99017f05a9c41613c1b569d8003be0db)\n  , NZ (F 0x10ec53f59e1b9b72d0e8447d21b0b3427f64058a292ccfb65684403a153906adcd9e8ea9ade3521ca9be7e5d20796fff7a6d53f3e21bcd12f15a37bd14b3ff352f97c4e4f2f615a) (F 0x34fdb134c927026e4680909dc7f5a3bbf0207ed17f83d03904557a142aa7f5a987a9fd6e5152d99c56d0aeda6f3cce6cb0cd79452a8f88f055d030f95e0b9b31fb56d9cd2e9bb4e)\n  , NZ (F 0x757e3a80f323c4bf54f5bd4798cdf34f94ec64bd2f1bce17fa4e6afc37e422fbd0792dd9287aacc4ad6892a2373b59112d4086cb64dc2083c389e7f93e359dd6389821ec53dfced) (F 0x1a7c7b0a4c752251455ad3cddf852e862fa3500a5046e8d7a52d723b207f0cf1681d321cb99b3e45fc935215460cde3251f0e91ebe1bb4de20071cd075b8225065eae2e10744177)\n  , NZ (F 0x0de1cb1e08a3a48d04767c86861ef5bcf980900a884cd76283dc904d4de68758866e81fa05325cd67915a14453e16da06186abe91c3ee4fb496dbc57fc7b2c47ab1cd81556b22e4) (F 0x27732be84f1c278d73b97423ca06eadcca31bfFe9c1a7882431724fb6b54e11b72a7bc42f1f76fc6b7bc1c9599c28c7537ad25e642b4f40a2cae02c96779f0eaa9f76bbeb46227)\n  , NZ (F 0x42fc65989d4e63c0cddde318fddf19c2384329e257c04f31cbec7e20d42f9c8b0f0805cf0647f677de6f96d49a78f9d0a29968f86a85d2a368638df1ea4086d12785301539b221e) (F 0x6a790daf1173ce89ce8167446e9246de56bc14b74d476b06be08e8b709691a44c74fb5dd0a93aa6274619f705a1ea90bcc29f59c1703f51a6877356deaec70a6b9fb86224880e9b)\n  , NZ (F 0x71e30881ee50c7142e2c6f8b215933944d9081c6f894959a4247628c0adfcdf1d0ef6e61d9823346a8ab09c2dced825ecb04c931e927b992eb62a5506e5d2dF8b0eb103bc053b3) (F 0x429d926e8dc08d5b4a4b5c598c648b862de55dc5d5850a7b0e836cd5611dfd23587f8b7c34d8087aa17d469aa2a064ce2f8676f621b600d33851f71d084f6ed8e61daadd172433e)\n  , NZ (F 0x0c726be16f5838d966631af9d0d77db0a411110f81bfb48f290b1acc6b01e41ee57d2dc674bffd3f4b7d2d9fb010b1eb1634453a31dbaca5dd011006760d61882622dcffd7c7b42) (F 0x7a727e7d4ee8b760825a2c689c0892938640ff6418ae69a863d3f5cb3eda2d5829830714d4f20f79155a377108a627b33397ff9e97db11f9893afbcb2a92fa92573935b95601715)\n  , NZ (F 0x7f0cb44b7a6a440b487d81ac425e4004a1d0366bacf200fb0b81b682ac6b3484d5af2064d7264666a20ecF08a9F47acbc930c6fd8e15b5c9b535329da879eb19c1b120a7b1f6c) (F 0x54d4b68357bf2d86398c2fc43777c3e72a8d5a3fb0d979098cb62716227f5bd33df0ec6c328a13d21f63d1b2765f3094994e1ea6e31759b7c1c65806a59e35249696702321b67ea)\n  , NZ (F 0x2d8685ae010ecbcb7d56a8ee200eba739cb352e598a7bf7539dd83a70f5813274d49850d726cc1eb2307bf837b7384485ac7f0a716743734dcbc2b68e2f3a16c229b319f37f2b7e) (F 0x5801b5f8e504754192869194F7ce06bd8de05d8474993401a762c011d0ddca38c92dc8a6f1fd510319bdd7e8a39f624884a8773aa1208f60e39f12d35bece1b6cf332c665e7232)\n  , NZ (F 0x300da4a53800d1d14b90587a5a8560b1e41ae5d44ecb67d602780b42d9da5b4b5c4aa407b8e93f51e715cad060f2a7b2818a1b21001c3dc381f31605812d3740ec2f856af9f7e16) (F 0x560a13eaa55f9d1a60180bec949f9666ad38b77d89c188da060a688c91165c8d41c14728047f1e6f7622dfb866fabfc9055df147ebbdf3e96a70b49712f0219b7ce170564708290)\n  , NZ (F 0x16ea93685a3bf520a830bcce7b19f8db6d292f187d85d79922e0e173f1fb3b52d714d72129da349420da1157898b6042b2587b248b053113c539cd01a60bf92b09ab057d3b348c0) (F 0x41e4f0af8cf2664b94951b23ceade60bb2b000d763539cfbe4Ffbf1f5bc904e5ae0f97fa6dfd8c29408546d74853460871979c10efc8dc5b6b5891a5c5c340a4f74329bed3a4ce)\n  , NZ (F 0x7367f0F84730015544e16584da14a2de8a12632b3ebc2e2534e47e81346183e1fbe1f63aa5b91b2c583acaa4af2664941a0ad1210b2866a15698806bb5e70c9a807b92a3ced503) (F 0x3682714a6613e3733a5456d0f13368d8cf57cc0b19b6726d77dc216656b56ff2e69409f376698f4bead790eaead28b4975cad839803e9500fa0b495f31ca57ada1284ae2d70a217)\n  , NZ (F 0x4b86d5b43bff8b053b7b62d3bbf2f302fb85ac0e4688a0d9c39524a76dba069b4093a93eed947e008f271f33c246105acf2aa5820b19bf8584e078d5aaddb11773196c6be802529) (F 0x6bd6dddb439b228dbF96fce77b8afb0236d0ec27da5552e9b80c0d60cce3ecf85cc7c0ad030caaf83500bdb286b7867ff289a0f138cddc8dac2d72d12ca3f90ae4088f65dd9a5f)\n  , NZ (F 0x4f40e4b730a01211818049aa13812651accb63c4675b91b04dfc7776266e0ab03202181e788aad03b428e22e03edd9125c376b3276bd00c99b7afa315f31a1ba19a50c206a99a67) (F 0x5e44c275b165b33e9bdbeff684c639656c972299591703bb071ef7147e1073b43d941ab5ff57f122ae7ef70aa275312fdfb02704631e20d713c0a8228d89c364c81100d8cd366fc)\n  , NZ (F 0x5b5a4ec714481f88796e9c753b73e026c52c90591165f83940b8c9b7c462fcf01304bbaf80b1816b01e9be137b707cba51da5957a493313dfdb2f40c33208d05bebdde3cb37b22f) (F 0x584edd65fcfddb222ba1b7fb670c6549c48de7fb8516ac02e19736fd9a3fb051994e337c1a1be261Fc80977652b4c7f9f7fd137511613204c002d3f164515e20298937e67d76c2)\n  , NZ (F 0x12b7a4828e74be0837833a8b836f5c4e656c150e44de02aa689bc4442f772a0128dda9b7f8e08d1128305130821d9ac05a35477285ec8479ce9a1cb433eccbeb263c8475025bad6) (F 0x21b8713bd51c8206a6bb3c2e512be289ec5c88f51e923adca6ae92df07d3ce557dbbd3d04664c57fd15df9a0e0bfc470f36c82d8f4a7689d73878121a1c0017112218ada8f63fde)\n  , NZ (F 0x7f84ced72a5ae052cecc85e316f7e0ff6d04735c4fb21500ae0f9384e9b33ffcdcd6Fca5321303b4324824d8983cbbf722ea48c914319dcc45781c3b0caceab513f45728c7219c) (F 0x4a601a6ec6be67ce19c126f4db9d27c02b08809bd70d589050177fddf85f6bd4776729bc7eeeceab8262928550df6e7d5084e17e2189362c10920b6a8d03b4c55642c2ef12e0dca)\n  , NZ (F 0x5f167a4394a5a9e45c487d0c64ce498d73e39b12e723f41fceb7b32217d85ee605379864c326e5e1581c3f87530ca605caee02e522f3d3ec882588ca25cd97d54d3f692b76f7ed3) (F 0x62538ba829937d3eabf95cc9b34bF4536676a9f4a686f50a3fc7555236f39085ddf98de2ab5b61d22fc01053120799f40d7338d7e013cc430f68b51252e24cbeb0cb03d4a2525e)\n  , NZ (F 0x257397db73f74d14577e1d076b0e155405b0f1e835ddcdcfb3294dee36bc6e927da03c7038754dca27e9f8a8c6476b4eba8fd036b45f58006ee04a2fd1a6c15ee87b8139398dd1d) (F 0x22e5cbe41b8171a82b43d309cc1ae3f16f136aa587d053f5887a5c113f18de3340bd9ea6ca82778728aff679d700814382e0bda7507428420251a739b097e449d79075d263b0f21)\n  , NZ (F 0x73b0f85021385427ffad987247d1F21cF34e0c5f4ce1e137e935299add9d81d6a7a23fa4966ece686f0203cbbf23de64278407d4ceeee0b4d9b08e81609a789f494ddcdfa1a35) (F 0x7987392224e6e0f61439d3d18af6b09ad1a40d3b214393e54357f5bcf31a059dffc1f4fae3b91cb48ea52eb6b7d14f092475c0fc0ce4211Fe4aafa26d417d2e0387415d16dcb4f)\n  , NZ (F 0x5359e30bbf71d2f4345f6a2758b7854506d3249427a640e31dc410c9d174b6f9bd49e52f8945b3225341bada70477ada3977434d0cdbe827b2992cf58a2f7b8beec1d8207fd0dcf) (F 0x2d576879c096a0b1191d438a3b96cd06bdd65b2496688e047b112c05ac885953bbcb1f46fa669191595731e856344493f9ab6887eae66a90fd6e41f6a8898Fa1ce48cbaf0a1caa)\n  , NZ (F 0x315fba1881ccf4e9541eb3f3f54465a08995cf2a45df59b7f548a65bF78e8991c291d148f17e07d4cca24f49851307d81642e19025e9424fc0c6dd7ed8351416872dddf9cb7a68) (F 0x7236259b79e33f69fc330bf7353855e7624a0cd47d67e9538aedd99530da5b63b5353595a2759013c83d231e0d774fd129adc1Fe3e19c8f377d84bfaaacd5a28cab1e06e83cb3d)\n  , NZ (F 0x5125d0728c41d4b530c099825be9c6441d16404e7cb5d5a53807bf1d9447e8a40d5f936a2457e602834570b35946c4cFd00061d1bdf357f2b5dbb17d362b4b452139df788455dc) (F 0x4f8cb683e98c3dcaf3a50d91f6bce371ab82c69a6125fb2497e935c74514dcf6623ea28407deee4e92698270f4527ee479b0b7ac2b1ab8b140a4ffd3c5257F8119811861269e4f)\n  , NZ (F 0x18bdec8657f05873730bd489c03786dd9F5a5470e9a4437f9F087777ccda60db9ac57c4facb475ff5599236a38a1c7ad3ea494dcfdd0e0f04333347066e297d0a29bd535bf81c) (F 0x1e9a0c8e0777a5be3a323a218aa39ffacb28820942f0fd84a903e88482bf52ad22673396495fc7fca0bf70db65a347cd52f38a39a90a11cdb98691345b5ef367eaba30d5032cf26)\n  , NZ (F 0x0f9ef22ef92ccebf033d68eee7b598eacf4c3d6e3204f206e0b0ff08bc7bebe9ee1f391b9c6ab94ac08a4963127a17a5aefc6ae440fb4f19a116e9b9b73d20b94acf187f6ebe441) (F 0x245ab22813d398528760bf627f48c744e861938d3cbc494c62932df73a98aa3a8de41393deaf8076ab64ca21e888f7ffaafa603b0ce6b4670a3e23b98b892522ec5a069cbe817fd)\n  , NZ (F 0x25948137e36436b138efb771e5d19bb28dbfc1d07e8c48d38e7ea368765fd1ede5a56a1bc766167ea98dc58376dab41d3bc4f7bd20011b0389bd5f01111f0686c0bf1eab65fb25c) (F 0x5b3aab88c9163f1bb4666d5d001ca65a1ef619c9a5673336f9ceb800a1b7ee35ae03a6dde930c4098d566ae21706d74b55e51a6c1f22daf5e581b3b98d9b28530d360fc74f10232)\n  , NZ (F 0x59de934bf3672a08b9bb2186a2e97603c7d0b0bee8eccdf032571db83c3bbd0329cd8bb03d5e01e1728bd8eebaddc3a300b0f72f7c684b6053e0975be44582ab969de73a0401017) (F 0x6d06948a0482d47a2c7c4128d5ee831a30b47314edc30180ce9aa7b9069671be93b1ee31f26411cccc7a57c39ea6271b03d9531c43769dd7b5cbaaed863fb41743804fd2a1c3166)\n  , NZ (F 0x7a96ed1ac1d354bf97aefbce94310e45b8707c6150f77e3445e64a4f5cb98f10eb5a0125691d38d05ffc886f7aaa292ce52f915152e017da17266eadcb870f8e608e7626d24f4ae) (F 0x1c5a4e1e746f9bf97f64fac8f7a10813123f6ac47ac4b9df6825b1137d2dd6f251992e5d72974e871168e9536a5eb905faeeb014c056abf65bc762c8775e1f5776d707032aea19d)\n  , NZ (F 0x790fcf9257801b28eaaa83c678fd5b941e2e96b06f19367de7df86f8d2f1b1f3400F8cac128e184b10c299a991ae350074b7636fbc380724190f8ec6e9d2d13aeb55e44804edb6) (F 0x797ba3b03729b69ece26f2c04173e615524554aa5c78690ae03c35761ca1b064204cc18f6038c664b75e4764e38f9ab31cf1585d4092d54681a0555a82f07c744bfafcdaecdafd7)\n  , NZ (F 0x29e339be8251ad2dad6969d1a2fa1fb9a022a5bb36719d0b54c9c075ea93e128d054aabbeaf6b9f54ae98d97896d547b97821ddf399c00abf455e14e18bb79952587477ac0730c9) (F 0x23bc1c1b9eF60df0b63ed86cfa97d801d037c10c80f1f4e8c5ebd36abed3268dcacc05be80b057777119995830a36d548b79d3e50fa8d3d397f20effa4b3da9f174a5999Fcf71)\n  , NZ (F 0x037e7587b5723638b315f0eb2a53e99558a387d0ae8be384792d523cf14e5c8cf4e9a2f032b4b055c589d590e681cc0563f1acf5aa63f41bf6bfd5e9c51781afdd0c509040d3442) (F 0x310b387eeb512951177de1a744c39b2ff195d08a536dbf11ddc691a51d3950cb869e4959cf2bb9a3a243c606279eac12870a3ff4c1f2e115918bf47dda6ea16b1b4cddbdeefb59b)\n  , NZ (F 0x2b8910934e8639d37813f0291083bdf513be9b15941fbc33b2a3d76e673fa95e8d5f3a267f60333dde0504c8c70c2a7e98e53d4935c2ae0e78543c99f90432ad56cb9bad3278ed8) (F 0x01321f2fF1a5e6d955820776f356a2ac960606dc190d08f4991850c4a140106d9df3acf297f0f2d3c5a7c7e87e4b63f501142a07f18a4cebaadd3446dff48ea9a042e34336345b)\n  , NZ (F 0x353b9c4e8296922b8eb3a3b00aaa3710cbf1ffb2ab92440e1d0553ec687a69c083aa53c7c31d410203aa17ccFbf9c4b13e5bfc6f8aec5bca70b387ce6d0e2f8d942dc3c94d1397) (F 0x4fb52c617e464b7f347f409a17665f664be51d500412a36561a29724f311cc576814e25fc62164913b5a33a45262fc5b243e146e4862f72870590175e2ebc515e57bd45760bc4aa)\n  , NZ (F 0x24a41106c260b91e7c0946a118524c6974513a7a35b791551fa9ed9b6173fb8c7c263c9b1890a3d23890320c255cd3ebfcf53b100967F859d9271e37faaf1d389480f696bd4009) (F 0x172a786f79b09662dab998dcac611af3350fdc3a48a9972db13478f9193a2f2323a058239a940b57408ce8e693c533eeeb195880a38f28b886b416eaec10f503d757f7a3225d276)\n  , NZ (F 0x0a153eaf7bb8ce1f7638a5506a68c19e021a853fadef1ed2a37f768a6ca9dd9757F2a2f36be51d4dacdcf4548f62b8778cdad6a4d05ef6b7278e3c907d254a9a022d411b1d67f3) (F 0x07a0073938686ff26a9c76647cedfa2411ed69e3e415ae037c336e0f8749dff038ef7e0aff59135f855b6c511b061ae9dF1b27fca5732340ec6e4db241af56e286a77bb661334b)\n  , NZ (F 0x0250641ecbfd9920d0488621602244d1107b3caca40f4a32a48649841a851739087a4b6935dfcb658a4ef07b2df124697853361031b86f1b3c37b9116595fd2f81788e99ac4a845) (F 0x0996ae085ce20c495f5d0dcb82e370cecb223e2cde3d6634f6711563d5f750ce12aded72d02f9c94a61795d1930209d765ba554a45ffb59db30a3208408abe664b40b629afc9c54)\n  , NZ (F 0x4e3cde035286577ba899f2fb9a95253afdeac1d7d4ea0e89c1a009d60bf79e4857e0ac0bfa89Ff521f3d329b257a712884cd27f7e2c039de9d37e2F92527ed8f7f9c777c5aadc) (F 0x6614467e06b22147927e68e5dbe3aaa0a710519cfccbcbaabe6d110d54b5ac6bb12f3b2c8c97d1a4cd5bdf4138eF3e8593f1ce63b01af6ab8704b479e5ce908e5ad0939c510d62)\n  , NZ (F 0x1901ded9c7b65dc1068c84b6d5ac3cfa15e6e61b2788a2592094e2b4455cb2f6a99820aade15ea1e420a2e451ef3e385d7817149f02d42d27056ecbbfc5560e4421549cac29001b) (F 0x6cd583ad69c2f271bed8aea8efb077478d61ac4ec3a9f0b53fF406aec468dcce079a1dda0f12ef675dbc243d263ba642029214be28af9e4679989255831649a3ee8d4bc2cc2c16)\n  , NZ (F 0x536ed0052e2cd4ced48fd29bF13826737bdfa1d5be65d3db9f93f8cf9c033b2add2aaa6d821296b6ed5f047a8b470f924e1d6e9255c5ac0f8760b79d43f2737e8f654e13f49c76) (F 0x226d8fbb38b22c259a86393002b3f690d3e13a480a093fad41058776cc69f72092dc5d078ee9b99294d9625a8755bF06695fd96e36e6a12da3c6769d676ca8db54cF0ee09eec2)\n  , NZ (F 0x3028c14640c96c0a52f9bcb44e0c1230364fbfc1bb1aba5cdbe1905758f855843fa6e77a252037fb4c3e8954209c702b8d24F98b18b151492c3294be1f39253c14f316da0de161) (F 0x22acabd0e5ad23d55717ef7bed416d05722d15F04791c2f594d1fdff380c06a4ab230df22377e09d25037b62940424a38b949e8280ed3d7bb79c6d58ca45b385fc0c101721bdc5)\n  , NZ (F 0x77cebf07cf8a559ebb581284fbd09ab13457b4e6e88ad4634961bdfde1d758f2c96089177b6f203e252bd42ee031f115c2a1663f3dc57d98106ef0d592ba7df2d5d0708d6b68380) (F 0x37be418360f056b1716d6c3bc6fF31bae88ae85cdead7b4e7250d36387d07e6c21d15e5a246721f9dd3a4322357ef9eae51394cbeea41708ab8f82de2b94fb35b2734be18e6147)\n  , NZ (F 0x79fb365ef19a0a1c30199d42c838617250788efd04e6cd3c7cfcbab459e4e4fae99a11bd81f459127f2097a2a5485972c395d869eaceaff8c202390d79ed52dbc0ec4338f122083) (F 0x0e1a39a6650372eb224d912366fd08e5b3646081dd3b649f2fa0092696b2f17dece1cfd53e3576f2947901038460bd86f1aa05170938a2584b719f2a3ec16113445b33e6203c9d8)\n  , NZ (F 0x55dd7b0ad66fa84c1b105253dd9b5026832add8a1da91bd93fc41260540f1d507df8aabbe560be5980ab93caaedb5a93705d43d6259576170077c6fd869e740c18c72865610b9eb) (F 0x2d72f9996c2d7b314176783755e5a40882d1bc6e8aa01de6886694a1c7e5522fb8a134abec7120c3227a840d5bc0fa913735c8a26edbba393897b81603F2F3982d4879dbba92a)\n  , NZ (F 0x1cb04b224b85d42d1c72968168d76c8c9a14aa1f949c778ff9e372eac69a1144bc59139050c6d1ff62b3b32a4e0991cdc485793aba33be7cad4e217ed0b6a39507d216086c9b418) (F 0x6a6448a91d36c7275fcebfba56fa91d3370f1608f392d60683fa2b312be092dc1cb5c2df37ab2dee5c1e6609b38496b66c16e55e3301a5ef280876579fd9943d8d6eba21dd4f1e2)\n  , NZ (F 0x672a396da1335476d238c634f24535737d09e4dcfc422844bea556d14ccbdec5cff6667d3ac10583f376d3432127c5ab0af2dbdb5e1ba68fcfa854c9df9969b16ed148388c115fd) (F 0x60aa824f7943223dbe55e6b2a0f5ab39eda93acd3bdd1ac91f8e4b1a825a00a8bd99335c25181a9eb2a2f00790728743a8d646baa3b5d0c6199fae797f41ae0662ec3295882ede2)\n  , NZ (F 0x39e74efbd9db238531e833f6056ecf0c9b5320cd3a80caa236954ce84a742eca53f73d13cbe60477acc1b81e1bdaa2224ebc8424d839a21c395d2dad6c491d65bbcb1b7db12f1d3) (F 0x0abbb65ee27989d420f3392058a094f21bfb922c7b5ea5382bdb342d12675abf61a1f7fd11d8124d41a5c0609759e6e1262eabbb7b85e775e2bd97afa3e008200075213b3106b60)\n  , NZ (F 0x0d2055d690b9397726ad8ec9de385a0fdf2141480cc29777b1e9ecb96eb44e03d0f310cdc9b7a8dF5784baaa3c63ac5ec056186b8ff669d8b7f542f0d280ff4500522a602365b4) (F 0x53526c91a2ab71fb76582151504c1a1c94cc6ebc197d018b1726641abce3218a2dc07f93d68c89914791c5f63284e735d9362fdf556327cb7231d7d8babedbc9b589b9450c8d4f4)\n  , NZ (F 0x711ee90e2135581e784e24c2cf7896fc11aae34d02444f6e712a74235097bfc32105f0323bf3d688ecf6518631c4677ad518d68e61fb63e310e79c1f06312adcca30019f187d436) (F 0x5cd27ed00ea43d081b2e1e86c7af38e1879690e305f7a247ec64f53b566ea5a9d461587aa378644f410e50c1edbb4ecf6a284d787ef4734823865403872d78aaafd14f06c3e64a7)\n  , NZ (F 0x4abdd808cf20bcad18cd4d2d792f1885154f264676e1651e0a22faccce55960411f601c7287a6ee9b149a533c07F517a38e2ac39c696f0b9707334a73a097bbd88b85396bc2710) (F 0x22f0a1a9fa3686b5cae144fb28e9f0711435ff294158581F430f7dc8f7c4b2a3956e4ee57286055dd40b91f7c4abc8ec23964f7dc329f85352Fd486204d708cfab08b1579a182)\n  , NZ (F 0x5f258cf2aec6add6c043f7861f5ba200c40a7f15b5c0a7f7F356919e1dda3aa99d989c7336aaa51f5c2f708c05f9f676e74945262d4a70Fcef26Fc1eaf6de9cce952d9dd9956) (F 0x02522900bf9fff8e11ee9e6b5302134bad383999f2a6271f856ade8e935ae87f564d691a7759f48444d256a5c363ce235a39622f1f49389fc4f29f83d686405e35e41d71854e0cb)\n  , NZ (F 0x504029f9701e433c11d4433b0dc1ea7ba5c88291c06d1fd4820dde01c24a4ce25b74304cb7e7d0381d5048cb6daf224c24034be60944276a53c3bb9a38664e6323504b438ba4c3b) (F 0x3bf0236364a982a9afad7648491cde3fbbd130e32a02becd75c043d3a8b4869028542065d6e2dd9eb16c28267d08bc5bba0428d5a307221e6595e6dc07df1dcc0e3774c706a9e76)\n  , NZ (F 0x775589b5557ed1a20961d691a4ca07f0510512e87c16228b42212f9b4af3c49a380393db2e3106df06ea4c258a271d593356e5634956c061c17a5c52f7c44a296c21580f8e661d4) (F 0x38afca621805858f4bf9b47162ff98bF1960bedab935788f51251e4F8650b0b3ee5099c1b38e185ad673f1af27b002411c20fb6536Fd0ba702ee07e1b48da9307c484bae834e)\n  , NZ (F 0x3f43a457db269562aa142da2b2466eb43efb7aF51cae1ff0c2f19157f5a5384081a404221e4005a69e839d16f77756475514c375fa715a9a3bf807bff3e2901052ba4fa989d72a) (F 0x6b5ac416681ac89312368f54209be6dfb64922ce7d1dc83d93f99096e974af1c9b7d72a87d60e6bf8ce6df0f10adbade4154c9c5b689481cb9ab1b5a6456681ecf9b5ba278cbaf6)\n  , NZ (F 0x79d8e290b75a9ddc7a2c03eadedFe7f17164fac958cb0fdb7dcf1c0af6ac04a069d235a230cb789effa50d1b129fb8885e33814a793184108ea0d10600a9f4b79c553aa07aF74) (F 0x05a7a22330536e540e4a3a4e2c0305acc52420e0d9b6bebf123747426c11f46b7dbfc88ede95355d735261ca8ac350eba3e5a5e52879f0a16f843076fc2999a706b824f036bb9a6)\n  , NZ (F 0x0b05665f487cb54d4f92a574c992c72d2d1e702ba7ebe79d9f01f8c4851a4a734ed32df1178338c9f3660965d90b09e403aafc30532dc10990e510f3646bcbbf77f148635f7a9d9) (F 0x323a6c0fb5e7214f60261be63a6655eda8254de575944c7d26Faab76ff6ee0221d24b3f33f9eaa27b7423013768cd65e668b32998fabd694ca482874fa6c1299d7873da57f02aa)\n  , NZ (F 0x296e64b7c0c9311bedf3358ebbd28b212cc0c4945993477f549f3421a9533812c0d0aa7a45c5b415e29dea0877e5b1b0601bd111a18c16a5990e72a1dc4ce76f9d056652985ddf1) (F 0x0b81b340c3415a1cb9187004692a302bd6c53f089f4cfb8e76c865a17f56acb3bfddbcaf557156e769cbb98d5917ec0f606877c49561d310803bbc5d0ecff1946f3652a3407b495)\n  , NZ (F 0x604231bd97187888281e3e49f38a7f103882c7ff2f466171f33da1da82d0013fdc9781575a4e4cdae3d7579e3cb46366bd1678e5e3782ba6151f36a8f1467d4c967192f13469a80) (F 0x240598810071c6115c842d21ec8ea1ef586a01c1752c3686700ca73f457202a731786b64b599ba7962ff8c3a4cd66cabd03ce4179fab19572b398d0716a00219ca90669b6904afb)\n  , NZ (F 0x356c1067a64316558ec0f45a6ec0aea1d8e40442ddd47f2d1548f8be380e957d16865db62e5ebb20f0d4b27ee474414b15f67961a121496ef97503b13c62a3d09cf2c12bebe3f85) (F 0x64afcc31c2df0818567468384d637660d3da95bb35a9302dcec3abebf0594c59b2c969fcc0692eb0e9179368b971d98bc0399b420a225dcf7b9377cbb9008ee802f0738e88b9e19)\n  , NZ (F 0x20b65e3F08c0538d3e77F92165c68daa29e995bb8da7bedac5681bf3e0f119bcaa6fdf64258765f12308b385bdeb9fa38da681F524a51f7a467e6b6c85360f88ddd95228b119) (F 0x11b8817e80ebc647d17fc073a1b1e58a5F0abcee81eb741aa4097afd85b44e70c54e88916bce95b5f0bd6fd0f4c03f781bd4c2b8d5c1648fb0754a2d3915999d728159eede24a3)\n  , NZ (F 0x5ecc7cab08731d0c422095c03bb31b965591cd3f3166e211a7631089341a908d796376ec8e3db3810397624854b3b1e283d5e2f3e34370234ff3caa6a0ef6efd7690293ea9078a1) (F 0x15877b2c9687f5fd4496c7fdaea28c5d52fdd5aa3a95e30e92f9779ca40509a34615310ca76b313970f5a815d7c6babb7f2da11fb00dbd706de6000eaab639e760a7ab76bcac91e)\n  , NZ (F 0x4bb68d4eb60a34edb8c8e6e8ad47c80c3deaa318f95e1a897caee0d3acb35ce3a4904eb71b290caa060e1d5db534272bf8f88d11d0b292592534cd778c7188e6946d98cacd5d8cc) (F 0x6548de54cb8eb2e8808946f093100575dbea3e7bbbcd9f93f380855fae6f4c116ca65fcb6e20d74ec50d8eF7c345d4b98fb411d09d061fde75Fcb92ea72d9aa815b02e9cd1c3a)\n  , NZ (F 0x1116295e5d00f99a03bc646acc90e39a07178349228b322ef62ff5d98025ce1e59377fafa47a58271e377a545917c2e0392c690eed81eace986fa0c5d93ff1b559abbd902599ca5) (F 0x016112c3e8ec657a84b7cd6aa5f9e1539d329fbacf8317119745a902c0145ccb9252181c596ad8959a7fdb9cf6cd044dcba40e953e503f7957a106936922b4aa7e88f76d1cb1d85)\n  , NZ (F 0x26b6a409c98e914e891c05e3f0f9c852f3af7a721f0a55c5df637d0434629eddff41702fd64f8f929ef99adcf562fd02348c930dd90c2b4a2a4f52b5d57dddcFd7c18d602300df) (F 0x49c4c9ac1a84eed4e45983de0cdb967920d5c63509ff8788782515c7842b4ab554238b0dead3a1a90f965aac8d22fc08179321eef7fd5f5a9e375389e568c0c91F34912029ce04)\n  , NZ (F 0x75ee179a569388821bd0207d0662d289a8632db7a46af068cbeac0970F1620236fa6e5f9f7940e6e52651f027747f89e68f63160160cfc0dadbae05f69d8fa650a102f4ac6745f) (F 0x47e19717934e14aa64db8633b6e1cf660e3332bde7bb04e3404e8500410a36455041684ed13ac28c47a6c20e342b247a277963d74984a0b568eb3a4cdf1e807be3c49721d275a83)\n  , NZ (F 0x07c7dfc167894ab06f21ebc8e74a6796fbadc457e1731e379e2cdff0c027113bf30c0e5bd53bb7f35e6ba448ae7b19a057e1aaa8ccbaaa917da6317cebd6b5a672346ad6a847fd5) (F 0x141d85c1a589ce727f7f44134aa32c07eaaa499dfac6efd83c229Ff8401aada72229372dd78d8d56b460473220573288f25c3b7facc5d6ab7b01368c68370e402a6c2a6d05c9d2)\n  , NZ (F 0x63d5ac83e688fdb970c2aa61d4702ad326c63d6f888ada88e720142ba7c46206fc30e8954b43cff74271863bf166892d81270b18d8646a29e4920a086530b7321da7153584ff6ba) (F 0x5e6e68a734053e087d120323f009b2a8739e7f1ab01ed39457818564a2331b8f48a76b37Fbaa680ad3c361848cb0b46c8e7e62762b0e8f61a576d002ae5a0b493956b6f165e5df)\n  , NZ (F 0x5d784a1aba718286cf487ea2b522c4e4d65ec0081d52e831850043d70ae884f693899f06de5b51b9ae06447c5fa9b9f700f245fd7e079c9fc9af08c785d0c807deb8f570482a2c8) (F 0x683b279d38d180Fc6480b54679ae33ebf1eaea474b6e1d15195fF4aacdd216716d508b584b9dcd96c0e258ff4c9a90a8d442ef8b0712dbb7d877b911fcba2bfd388b1fF5f287)\n  , NZ (F 0x446c3b56323053c1faf9fb4f4cbccba4ebdd66d41b8095e715f35b9782c5d9513513a12185d3d8e11a654610ccd2eef1bc0b53886343d90eda3b8ff60511d3162e8eead6ba3ef40) (F 0x7221FFc0d05667b6db875c5043be112897e36c8014aedcd0ffa8b462be6e81b89f114ec682d32445923ed9187d25ffd63e6f2a6277930138a06770e1c4b7ca4b3c231a863ad4d)\n  , NZ (F 0x2ed3ba283e9fd13ce5344c724b5bad55b0908741e3c2215a128ae52769150756b120f5dcf52f1a1097c5763ed62c9ae076851366e78acc96478d25a62aa38d5e2ea88742683e838) (F 0x267cb2663a53c07de79d38b0bca7e132b66eb73d0c200396b4f827ac6d2c492de485969bf432ccc484c6338a56d532930f65dc10b9e9f5e14bd01dbc736c9fc5b8eb6650f90dd27)\n  , NZ (F 0x250dd047910bbe931d7f83e682bdfa87d3c7b2ac0dd4076ab77Fa05564f5f3be15fa940ae4ede244ca1d9946d1115e81a704a742748b676d35db4e17e442d718d6193c32fb3a24) (F 0x01e2840a9e7f386a33ff084f161054b96919482bd82dd34dd3e47760bf102be5014d875f40fFfb37caf48a4769f53a6e252d4f4b776a7317f37ec4F4396b7ce98644cdf5c9ba9)\n  , NZ (F 0x69167eda02e1091edd7e9cf043d62Fe36372b396da48e761b8401fc9fd1b3a7cc1a69f0ee7fffc2debec125cb0363c889a239408e140eecce06b1674fa682ba18dd58dd33173d6) (F 0x152130d2445cdd78405dc049b093bf150303942990362e0b8f70551c2f85c22fbea744aca18a3a5d7ab16fF95381d455c5417ce1e3129ccba9551d7ed2b2603ffff21bc8dd5d8f)\n  , NZ (F 0x28e3c50988240558c72b2977db81f2c5ebe52f4a75501e27ab5564222a70b7b61b6ca4866bfc21ac1ef994e4bc8ff326a941b06a8359c9ca988b7c652662a2207f379b77cd6a153) (F 0x6e478dab85ee60273b263365db59055f6eef13046df0e13443b7a3ee2835d7ac082d08bade5193080f686e15e2b92b7042cc2e02974f6adcfff21c34fcd081c9d7a3a16c412de2f)\n  , NZ (F 0x72b043c6f3fd639c263edc39c3eab0e51b39556cf26f76801258fddc15fb739123c4efcc407b94a6f0c3a2424d25433a6037647160324da61bae400bc350d4089b362beb75f8b41) (F 0x5b7c97380810ed0652b9bfc1ed3d12d3941d75196af8b44129af6a1c3a4606b359126a995f51189efc5734b3cd3b9b670d3f1de7385b3f958b2e504Ffb00ffda2906baa659aeca)\n  , NZ (F 0x546e349c35d9d3430b6178c50ff3f4fdd81924ae706d2e4339e37f88348531f4f9F03ecad409966ad01b660195fb5e38bd3ed6c5d0988cd8832749b5d07e4986b216734aa98692) (F 0x0649451ed92184ab690656112a815459030a9df5cf4595ab8da5f8c6c01c7ee5a6c7cb72f5ea21cf9753cf073f9bd33453825f4e5b93a2d1ceb134699b8e8a61a6aac81aecaa8c8)\n  , NZ (F 0x45fc0750Fce3c935c933a57f6bf46bbdc8ab0a1cf7500a7e7aa900038ebf69fc4429b16a8f651c3ea86903185acd4b917c01e06db80b70f15fa505cd36473dc11c2766179949ac) (F 0x0f1db535af9fc8173a8335671209b9037508fab56d9125b4294cb08d7e1878f5a851ad15fc29c9c4c842481a1d578bd88c43cd7cac0109ab4ed56376f570a02cb765c52a10987e9)\n  , NZ (F 0x365d16d6d1a64183bdefc7b7cac4996e68956fb8791061272b41258ad71d276491bf69b4d6534dfc00ad45917e0ab8b71c2a7581adb443917bf14e45aee0547aada7d697748b548) (F 0x2f83d51154f25f2c1a4676b86b9393b1262dbc8aabb5c63333a6141f1fF6ff47240a3642bc5218405f1ae03b60066bf334d8ab28606490e04b78317c470bb609ead54957627aef)\n  , NZ (F 0x4e7fcebf36244eb3abc32283b9e4af9e193afd3f696678d18eb59f35592c1f44de4c1e8e6c5942f17fddeccefca1a3ce9e0f5e274dee18c152d679a9d70c4cfc0dFd4885d88580) (F 0x34cFc87868b6172f25038d9342ec5f75a6d5370f5530579512ec206e25c9130629036e2e3e6cefd9eaa7c2aff5517289caf298c4f142e07e8324025fdd80f3fb0d377db72a8045)\n  , NZ (F 0x4f53671973d2c3d9edf26bd14e87117adf6287b8475b73f612282897fde65eddd0ae7c6fafd49661fd95e4220330bbaf597085ec4c5639dc3a9439a88c6c98e85fc7ee0e605f1b1) (F 0x5caac7d22d272aa197ef3368b65c942b505052466a0bcc53df2515af3fdfc3667020015b3e718ad982e1f8731F2aec54945a02433c7163a31100f38ba3b624575ef374a84f7854)\n  , NZ (F 0x6d3b7b8b2d7d8227ea673366028e21a9008b04dbb40f5080483d7312b8fb31d8e4cbb020854d26f1cdf772de81a0f55Fd34a4a0193fc51db1ca429dda0618de157cbc5fbc0c7b5) (F 0x0cbe9c3e555cfbbc0533b8847481014c42cca111bce71aaa69744351e6e69860070028c5c65b023aef9cb2204814c23ba2868ce5e3b6f89110789c4708fc229f4b10e30e939fcc6)\n  , NZ (F 0x0227b8ce16fdbcc9d128d566ae50bcaf838c06ccad3d9a14d6cc57e66d9e60afa72ca1840e4aa7a691d06398b33d8ddf9523bd25df334f01af000a0148f1b599ac4522a13e1daca) (F 0x2c5f05331b8db5b2128cd39859739b7f2e6e8435c98a4c826e7e8b5dd8ba05c447779d02cff1b1d034d3ee0088290645eea0c5613765f280b9bf231e5c0fc6ff8ae7ad1735ff517)\n  , NZ (F 0x4359f7b432f9cc7a7174978c0dbe393d3422732f1b2c76a0e161b381fce0ca235e8c7ffc82c93c39a7cab198965ac015672111627eeb14d31b34b60de2ea358482db2c2a0656db5) (F 0x612bde975a69d09310c69d3165c910273b1d99666ceb475e5de328268445d1396246c5805c5ca501855ec2d02e91377e7ea4555ec0cb036312b2c081871ffa242dcd0bf57593627)\n  , NZ (F 0x7ca892f5fa9d62d61b4366ddfdbce8c7743d7fd45b2290853ace2ee7bbfa3daaddce31197002d0ee882c3ffcccbaacdb1F617be29c588af2b0df1490379283af8fd291091f1547) (F 0x10d1d0bf3d4c3d5623c84ded0409078ad4134976fcc54deef03d4819e58367fcc544f61ec63078e92dd8ac729078d0212a3a3bc8a810e597285350d5b00fd9998ef1d46f82f0a78)\n  , NZ (F 0x2eba3612b2805ddac9401bf62f968e7fafd73e72fc3F6124b823820e2c0cbbf0bbc576cb877536952ad16a0be29cfc75b2b5f4cbe3a9e929afa9b31e445861a7f70307bf547e7b) (F 0x15947eeaa139e6d327f5fc28474b4c43392c840a24d37516f551af0f088ca5d1ca24e489a4c386aa4df4efcc1a5d112Fe7eec379c76bFf77934a2365ab54903a6b860d60Ff41)\n  , NZ (F 0x0af93eda366d4525f85ed1b988ff3c1d5db710e2ff3ca902a0f122d80f21e0e4eFb244de845908b1b0894f9daa83e12163f044242ca6b10173036b8bd5dcb1647f3731502be500) (F 0x331ae20aaee9bc061d40830a6a257e0bb523abb561b51bd8da2f3caf6ae7f3b71c9c6db5f1c9b081fc70c1b1e8068d31aafadeb5de98b056fc294afbd72300ebd72b6ce4bc18511)\n  , NZ (F 0x78df234cc31ed548216c38f32ac3a5168097f63e22c2ff5c9db89d4b62dd84fddd459884da6b48f06afa8f077b698ec10e2d45a6f81df304063a094e67460e8962bbd184bc48cac) (F 0x5152497bf7950cd6e698c897f72ca62c4cc0ba0c62c9cbb49cadfa335d917168db5952bcca47d5c2681fb33b958c29a5e18c968206173caf01159f4764ae5cd8019df1cadaf7584)\n  , NZ (F 0x1980ff1364cbaff6d59dbb67e5b9c441af672b13d938065e766ece91bdca8cab71aa4ffb9a61a92024e094685858d7922a261bceeb9b80e61f22b3f2a3a30a544da18d4Fef30ad) (F 0x116fa0cf7ae9b5615e5cbc5c82e2Fb024966c8ab10d459e758c62b43570fa1553bb4eb86207f216840882d3de4ea3a3c11998020c192d2b456abb5b75f1db482d79bb1dafbcaeb)\n  , NZ (F 0x4bc9e353acddeb147142bb4b0338415aabd88ede94740f0bccbd2324e70882856c76299d6ddaa9edd72c4f4c5a4089e95bd087ef96ec109bdb3d9322a908edcff47bc3747d4eaad) (F 0x52a18c5949ef65bbd9ae6c7c7d2fd5c0772d64616bbf3b858c903a4b0427fcc9f1844da363949b421cddb4d8f27a700336cd304338fded128836162a1a0ee3ff16034589b9d0bfc)\n  , NZ (F 0x45b3f71cd9613288a3d32F878cd8cd636327ed57268138d4cc9d11a560442ba9a7a20702a84358099f260b6e94f1837ad1100cbb4f72e8ab7e1bce6b3c4c867dddb19e22e57016) (F 0x4524cda3cdc9c022b1841d370083bd68bbdd11d5dcb9677fd47e24b4f73dd0bdf1d2dba255153a0d421f2f3e5246279b9ed70694e49a883e7700c664a10a268280de0b9afb91c09)\n  , NZ (F 0x02840c70f63de4c8f1ef8519e071756bc5051ea20659F117979c95df7dace65370aaf894a1d3345cca79c09286bec986924a6F5523984ce5d6Fa9a2dddf033de9832821F80b) (F 0x295c63418faadfcbeaf1dcebd0bbf04c32da3dc8ee4d4e9d89c24486ac03e0a3805762ee8473ebcd7f362a027d1247e53e9aa7a5F017192c40b712dbea96af2e00bbe8a65408e0)\n  , NZ (F 0x2355d72b024bc848c42c7cff7971a616cad27bd1172961a13d687affa6a69ebad48caee32b1dc3d93b6b74aad589b925ea6122a80462cb1b2c8c08eb267dc1c3ed240cb09a1e122) (F 0x548e1c088cc867a6683141a46a333b0c69678ea4efcd0208c15a6c0c4cbed75d2f5cfd14de7f4b4491b0b9cd02ee940e45a30634b52e3a14e7481ce887003a2bc8b70d6294a789e)\n  , NZ (F 0x30420796fddd68c49c948b7d1f4fda59231d20c0546f3000d2ee663f765f0614485101d82a76b6c4fa1fc2fb5b4a897b2f430a435dbbb568843e11d159081d04c5e4dbd044940ac) (F 0x356c5c5e903021c1ffa6b7bb34f24ba07c072c6351a8eed1ce58d8fb422e63b24f1a14f1a01e9f10bab6c78805188d7b1bc6a0473F107dfa1790fcca63341144a12ddf4d8ae560)\n  , NZ (F 0x6cb6029d26513e2ba68f750dfd7dff645d9390673eb9052b9878bba1ff3fccc87ed8f9d6632ddc8f5bd03a102edeacbe37c8a6936158f111e0d12a9cf7d425e991919413ea8dad7) (F 0x7c4ee05e79883e45c95beFc88fffa8c1cb615b3089c5b727c49c4c2675e4617ec7c9a4cee296ce13907321cc56a3cef574881314181565c7d686de34a2e9719c9446945F51983)\n  , NZ (F 0x6c7aedf18b89bcc56e23ddc249dde79f58697c1c6252f939a270fb38b65aba99d3851a3359792cb6eebfca4561a80f541fc31a3d7f4cf5937e713e38af59f56cbbf2690014a3041) (F 0x244cea94c29Fe1a27f27beb4dc62e09bb629bd27f5706086fcd2678c0e105757048957ac24a561525346d2f36516a0bbcdd5c50281e68e77e2c77a9378bdb5fd3d808fde941298)\n  , NZ (F 0x3603d5125fca1e87e6b1dcd3dd17d3cd86bb12f902eeac8fd02c3bcbbcf7f8bf6cbbe1366f9c8e25d949ddbaac7c27bf518121079bb8955e9a64659895df5684578b800a2c08c84) (F 0x4422a84d9f9de240ce0a8c6a55a3ffae5515c11492416cbb7017e9d5441be5a2b825339b42095e5ae98d135698e4c08f910f132a079d0b92211a08a91b1452b33d746e102ae764a)\n  , NZ (F 0x414caa4f733e932553009d93d3251a42F2c580ab7d283e2d1e170726f5f9be5b7653408fa7572d3f009cf4ee802613aa3a31c2991dbdfaabccecd832c4e86c6a68f2e612739b7b) (F 0x23ada1bcbd3a506cfb3de390c21ec572a1c47173c0c81720c8464525c52a45cfd671762041dee2f16533dcda869caeeafc34891021cc2b2157d4f915e1d5bd8a2b57df9c24734f0)\n  , NZ (F 0x57afce5cb571cc5760d1f0a4d90e91f5ac8391977d11bc37dcd85f5e01839d984e24a429e7df120a724a21949f1cac61495d3f1639e886024c21e04c46c69103522355b046d2cf6) (F 0x48e6ec239e955630bc6b80eb7d476fdcb853cefdd1a54e1dbc181de37ffcec38F02f8b5db392ee55d55b6bcf18836db8602fc27ca0e006aeca2c79e6635661b9ef392714bd3b16)\n  , NZ (F 0x1546b20d6b24f309b7ae5c49949425b10350c72ef077f8988448bb7665c0fd3630c8d3f5c9e3e16106acf422f0149817f27dd80b2c66bbd4d92ddb663736649130b459ef2cb4d91) (F 0x0e0a7ccdd9f2e40c2509cb8759c31882c6f0af9082f9ae4c0eced3870Fd4f8d009c4de7e640F3ed4c8639deda22a6c3df4e57a6e3a7953cbe00867e5b40df37efadc6a45ec0dd)\n  , NZ (F 0x08498134b0bc9e1b75cd4590d23e5b78faed9a4373c9a054ba5896243b0d589252ae5854d56199d8e3191b670e6dee2fd2669eab6e90cf1738e6042b7c85ecea74ad1bbf4daefc5) (F 0x090f572ab081f45c3ade75e3e2f359707b4c9dff7861adb0276b4590efad86056a666b5f8889447af7560f5e9b778eb8e8f55bbbb61d0502bdf7baab4352099f2310a43c163f168)\n  , NZ (F 0x1db52c53c2b2f23fa8366c0b101aab1e67a7edf6b833d3a06b867fc4ad23ec3398ca5dc92a18821f6c3595c3f0c823929275c32e918c2cdf8be51019bb5a70f980cde3ce21a9ba2) (F 0x048764a0bdba152ba8574fa87c9364790068c39edb48a7a67da6357b6f057b4deaa6f086cea3bcc5861351bc77f076f2d56b7b464bb8a1e9fa8d0c3d2e514a702f6a14522afc6b4)\n  , NZ (F 0x3ac0271c0670a3580320de9c16b540dc328f4e92ba7fda73ea7e324d30a41fa283734d0b9569c9b45466857ef84634fa46e178eb71d2579a05ad7bf92c5a9cff4b3117000095df4) (F 0x0ecd0510b9de90dd810dc2120cec126f92fcfa69b97e259bd59cb7bba690e221d0f07a4e43acae95fa333d7ab6fa7200b9b6eacf843cf3e523d9d3482d57df3f23efdbd55cae8d6)\n  , NZ (F 0x73e43c002b75c7a4a4d93e49a754c1e221e79bd2cb4204a318492637f36112a9502b2e98118456337c751d9a4095adF9cd80e9f8504524055b60545b7f2a4e41203dbeff36e0fb) (F 0x328495a6175c9700da2e76d59c80b65d06202a3ae0fff5ab0eb06ba6031a30a29d7a846a8e19b615b15a996aa883e6b8e9107dec94f59daaa541ebd06a89577Fb57edabc453ddd)\n  , NZ (F 0x1156a682ef64a1522a066b63389f0fadae4044b9f3F5b4307439c2867cfdcbc1ccd6ffd9ac2eba59cbb103571cbcf4fa1ac80ea3da683d146543225ff9685df780b0c7a7816a97) (F 0x434fc638e047abcdb92582ab47b8b4e41ce110f08248e460eaa8e72ca80cf48a312db80e5143d4513e5bce24d798e13b89ebf1cf14fdc431791880ddf13d8d06d5f522c6a8263ed)\n  , NZ (F 0x0a1cc99a2250bc566dfd190c12a101d97832e3ba8f2692b6ce51fb5c68d8604bf92c146a02e9461054ce0378d2cdf8afd3f201d23575c867b04465a6ec6285807a1d672b9631511) (F 0x4707c15da62c0aecfa76e70d92c8a473b6f4bb0a671323b34bdd0fc80190547b8a5f7b5ac1d6f6169271b87770aa100e2c271db5f6696bc400166fc3bb5a81df3b6d8c4749427c0)\n  , NZ (F 0x6288a3951452e5528074104b97fcb0adaab85ab3e74e2a14f5405b29c3d30084Fda236bafd981a19794dd83a3da847f456629dF8ec166ada2bfc183e1f18a24cea91f6b135faa) (F 0x1f179a306ee07b99d97fa2cd7751f8d29a994cc976a4f63422bf0b7f624360037585217a07a75ea7606b1cd64b46e3de3cee7af5cc133427c17a2faa4c36d03cce1465e5385b37c)\n  , NZ (F 0x75e86c8d781dd1cd96c992575c1132550eed0b2ec272682c1e38a66cd24c1553e927318052439fd2eb613e2548ba64cdce738aaca67ec9eba2a6882ceeef458aac36eadfc55e115) (F 0x51d3c8569b6a3ef24982caddf1f34f35db9481574ad0eb493c52c312addaedce6959632ccf46831f3685dfc63eb050637797a048da937eec8c90c1bb5d39630e28d7db3e1a3a616)\n  , NZ (F 0x33898307fb6fbd2f02e0fcf54a42cf7698f169a845521345fa97b2717287ee83c2d668f742577089b533a66c431ed1ec4ea7600b2b8c1bef0e725b23e584a600d1cf6bd58428158) (F 0x61220bc84633b9416f2de792f72a4b8b02b953001258bc09016aaaf9e25bd0b11a9c7723a602fb308f8d27c0F2c2a754ab1e0b413a2e2d361b901253bf90750fae2fadc718727b)\n  , NZ (F 0x65135b6a2732e5483bea9f2dd9419393197da38965dc2c78bf0e1189670e58216b987dc0462a599F7956ec000f79636ef5abbf6f47b0c55fab0a357f74781291da65c1462883a8) (F 0x65675cb8229cb6a04dbbd21dbc99952df4dc91ceb0ee5b747347df2fa9a9d5f4e79c7c9bd0d2c45f8658b7d66a391482badc5a6251e1a5c9d3daf659f367334a7a7d3988cbf477f)\n  , NZ (F 0x3467444a5d1c45959b22ce189325acbbF3ca3edab5175d0bf2a2f06d30bd5f6ac6229945cd4bbdaa2320257d172d66b0cbe1be188b9a59f15b9ca7449227dce5a9840e48c84e01) (F 0x2d484925b7550c182f02dc5274e30F4b56c6592afce7523f0895acab5dfdf76350a72390ff6fa4e368d9d6b4763acfFa3171e2a26c4c6bb75401732f8a1e17efa3c6de4dd80F)\n  , NZ (F 0x0d6781da1f70c0ca0fa410e6f0899b4ea0c47d59285b1df883d2f6ecf7139cac789b70a606c56c06b88b7acf2f9c9c34bfadf14df00a086ef0a53dda4c30047da0b26ed67a0a6F) (F 0x0646552538e32e98b7103118d1763e95b8f34e6F298a185c6eb9ca13a958cbd3c2ec37ef5ac043678e83cf33229eF6a219f51696d0aac00e136b83d90625d901b92c2649cb7cb)\n  , NZ (F 0x31e6f81edd6ad2dc707562a4ade661dace6e32675a01bee14cbed4f3eb285856340d046ce0672863850384839b0cfdf64635e5534d7a9db5a068938d67521cb5115cbfa9a4cd045) (F 0x2e208f01333b0dd205c7925f83bf1d7e56d1735a2da5d3900883dbe0b22cdde1f21d06179b0aad7c2ce3401a00c0ea7f55a999c456bf77b7679584db5e0b3e1d7a6253d13758d9c)\n  , NZ (F 0x121c2ce5665c81d109b91f631012472c1c22dea3b5d99c7dd1ad0683370c74967e647cbba4613ca97a354353a6bf194672effbd69df8d4f7c4831d1f52bf8e0464a822a56b2970f) (F 0x1fc2b608661087e7eecc452815db4e675396ce72d8160f0c8ce25112178e649399cc410110a97bb42ebb3f41185797db97afbF5097d99f6e30c3e113d34d4b74946e705f4aa128)\n  , NZ (F 0x2c897cf2767a245e48807d8af27bde6d6280df43c7e6800fdee0f4c03f3ca98e5c71159dc82018671dcb71cf039c2d7d259583022b8885ec82a66255704fa67c6c8d40617acc5ce) (F 0x173b84a48370a612bba01af96cfceff19c8f2368b3f24f8cac65a1e9d2de5b3427a28bb163a709ca120a62b0932cecae73e4a0c8e39678cF4790716254070c207cbb38379a2d56)\n  , NZ (F 0x5f82dFe9093c66405f8ab0b558f03cec040710496047ec20190cef43b52e89149bec4c8c800e0edd5793191f2178bbc6d54847c0c6466b388d43c88707f3058fbdbb422187dd97) (F 0x0b60e0ef6d27780cc47a415d15d51643e545816bdb0fa9102bc6edfadd92443f3429ffbb2d1331b71a888f11bacf5680b99419216096a0f2bedFc396a26a708a9c1e457c631067)\n  , NZ (F 0x3cd3476c6692ffdf6c2e5be56bb78f973d06405d5f7a5dae04b8220fa942fd8cae084b481a2c304fF897a915Fedb36af2ecf5246b847c0c535f3c2c8a6dc53e59825c1857a806) (F 0x7903aa449c8ad8b5b7497754ee146c81c73c550273283627b840bcff66f78bee549ef86a101ce1331ec2d658e0735f07f14e9ee887a181555b3fa93ae296383c60038dd6e21c2c1)\n  , NZ (F 0x4477939d8d18b7f04aee584e7d578976906216ec92fd8df89479a58eF19c91a2a4d085319ca9a83293ee5c88ead2a4722e813f9c5a8781fc1137b4210b857b2eF96c3fb9c6b3a) (F 0x073d04a9373b661bcb729b10536beb3c4af77e10ecf8142cd0d61c015acdd035ca95aaf2db6cd00e60f4d41e78229f9c61e87e1ace08f4c02e5cb02b1f46be5929f6dd5ab3ec0a0)\n  , NZ (F 0x06a0623a242da11c1Fce29c2f3924db45227585d9a91e415e87b145f2a5069379bc5466b5789eb8b54652188cd3536c91ac2e151b201cb0f7d1afF674253d3848734dc0626ce6) (F 0x1e075bf9c5b9ee8e61a97a2c494efdc37ee6581c9a58799a98de5e4f5817353c56b5397231a93b52b56626d21be6efda54347973dad055c76b6964d791bF92a72f96Fbf3e68a4)\n  , NZ (F 0x28eb5f962270e554ca71d5b26db5554650fbe6d4c129a47b9379ae52d4a1c45df8c746ef7e7ef7cdf512cb647c9b9645e5584f31794c9d44b2299dd56e5f795154ae7d620be84e5) (F 0x69ec24eb14c2a7063250c7b5263e4ed1e6ab315dc144d25559f5dc15690af24db7647cb1df8bb67b07cf08f442b5d1ccb00a150910cf8fcef8cb561ffd7e0e53b2a8f130b833658)\n  , NZ (F 0x586e5245095db75d43ac104e2b48b4d0Fb005ff002f25ea4ee3f006c3abf3764cd90a829a4cdd6076Ff57127e98a2b62f7305af2cdc776cd5d2fc6F6d5a2d609a38e18ffc7e8) (F 0x155528ce5ffb8f81a8291b9656b0ff93d5b0ae57e6da32231c92a81ee477e25399f06852241f497d04b4af730bd403a4a3ef46b6480d0010baf1ce3b4bad66f980a492f1511eae1)\n  , NZ (F 0x6d1f4c4b82ce435345223934e912b35fd9f33266a7be7b95970aabe6ca57e87082b77b762a1732d68ca09cac496395d95a4d0c426b08b3901ef1e878ea6e6d009e12a14c1bc7f9c) (F 0x5d6b51b3dc41dbdefb9c37fadf5760bb67ed052cd9560892bf1a3efc4b9f2cc0027f7699694c363789d2cd16b7a6fa875aa42b9b23980aaa28ccf312025ace274188eab3fdfbe88)\n  , NZ (F 0x0d112312ee88b90bfbef8fc5dc2867259f105aa43d57833337ffa2b98a0f28ba3a9200b36d29b85970a077a8dc4cc5d4f010ab8faa256649dbb7e82F35841e4096c47676dd5989) (F 0x66b5cbb08ca8667f942f4193ed11a2544069898e9d15c4cc165735f20ab5649bcb3560a29322216a72c875be7f91f5199b895adaa00adc3F0f596e97b222a4d9df72411b3e1e86)\n  ]\n", "num_lines": 589}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Foo where\n\nimport Data.Bits\n\n-- This should be simplified away to -28\nint :: Int\nint = negate ((((((15 + 18 - 11) * 3) `quot` 2) `rem` 19) `shiftL` 3) `shiftR` 2)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test Trac #3118\n\n-- The test is quite delicate.  It aims to get 'f' to look like\n--   f y = case x of\n--             Red -> (y, y)\n--             _ -> let v = case x of\n--                             Green -> 2\n--                             Blue  -> 3\n--                  in (v, 5)\n--\n-- And now float the inner case to top level\n-- so that it's not so obvious that the Red case\n-- cannot occur.  This crashed GHC 6.10.\n--\n-- It's delicate to make the bug show up\n--  (a) because it relies on not \"seeing\" that\n--      x = Red until later.\n--  (b) because dropping the Red case must happen\n--      before float-out, which itself happens v early\n\n-- In the original report, the x=Red was concealed by profiling\n\nmodule T3118 where\n\ndata Colour = Red | Green | Blue\n\n\n{-# NOINLINE [0] f #-}\ng x = Red\n\nx = g True\n\nf :: Int -> (Int,Int)\nf y = case x of\n         Red -> (y, y)\n         xx -> let v = case xx of\n                          Red -> 1\n                          Green -> 2\n                          Blue  -> 3\n                 in (v, 5)\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #3234\n-- Should give a use of foldr/single\n\nmodule Foo where \n\nx = ['x'] ++ \"haskell\"\n\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This tests whether a supurious `seq` is eliminated\n\n-- The test output is -ddump-simpl with uniques suppressed,\n-- so it may wobble a bit and require updating\n\nmodule T3717 where\n\nfoo :: Int -> Int\nfoo 0 = 0\nfoo n = (if n < 5 then 1 else 2) `seq` foo (n-1)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -ddump-simpl #-}\nmodule T3772 where\n\nimport T3772_A\n\nfoo :: Int -> ()\n{-# NOINLINE foo #-}\nfoo n = apply n (id :: [Double] -> [Double])\n\n-- = apply [Double] [Double] d1 d2 (id :: [Double] -> [Double]) =\n-- deepSeq d2 (id (gen d1 n)) () = deepSeq d2 (gen d1 n) () = d2 |> co\n-- (gen d1 n) () =\n\n\n-- where d2 :: DeepSeq [Double]\n--       d2 = df d3\n-- \n--       d3 :: DeepSeq Double\n\n--       d1 :: C [Double]\n--       d1 = df' d3\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\nmodule T3772_A where\n\nclass DeepSeq a => C a where\n-- class C a where\n  gen :: Int -> a\n\ninstance C Double where\n  gen = fromIntegral\n\ninstance C a => C [a] where\n  {-# INLINE gen #-}\n  gen n = replicate n (gen n)\n\nclass DeepSeq a where\n  deepSeq :: a -> b -> b\n\ninstance DeepSeq Double where\n  deepSeq = seq\n\ninstance DeepSeq a => DeepSeq [a] where\n  {-# INLINE deepSeq #-}\n  deepSeq xs b = foldr deepSeq b xs\n\napply :: (C a, DeepSeq b) => Int -> (a -> b) -> ()\n{-# INLINE apply #-}\napply n f = f (gen n) `deepSeq` ()\n\n\n{-\n$cdeepSeq :: DeepSeq a -> [a] -> b -> b\n-- User INLINE( 3 args )!\n$cdeepSeq a (d:DS a) b (x:[a]) (y:b) = ...\n\n$fDeepSeq[] :: DeepSeq a -> DeepSeq [a]\n-- DFun (with auto INLINE pragma)\n$fDeepSeq[] a d = $cdeepSeq a d |> blah\n\n$cp1 a d :: C a => DeepSep [a]\n-- We don't want to eta-expand this, lest\n-- $cdeepSeq gets inlined in it!\n$cp1 a d = $fDeepSep[] a (scsel a d)\n\n$fC[] :: C a => C [a]\n-- DFun\n$fC[] a d = MkC ($cp1 a d) ($cgen a d)\n-}", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ScopedTypeVariables, FlexibleInstances  #-}\n\n-- This test has a deep nest of join points, which led to \n-- an exponential blow-up in SpecConstr\n\nmodule T3831(setAttributes)  where\n\nimport Data.Monoid\nimport Control.Applicative (Applicative(..), Alternative(empty, (<|>)))\nimport Control.Monad\n\nclass (Monoid s, OutputCap s) => TermStr s\n\nclass OutputCap f where\n    outputCap :: ([Int] -> String) -> [Int] -> f\n    outputCap = error \"urk\"\n\ninstance OutputCap [Char] where\ninstance (Enum p, OutputCap f) => OutputCap (p -> f) where\n\n\ninstance Functor Capability where\n    fmap = liftM\n\ninstance Applicative Capability where\n    pure = return\n    (<*>) = ap\n\ninstance Monad Capability where\n    return = Capability . const . return . Just\n    Capability f >>= g = Capability $ \\t -> do\n        mx <- f t\n        case mx of\n            Nothing -> return Nothing\n            Just x -> let Capability g' = g x in g' t\n\ninstance Alternative Capability where\n    empty = mzero\n    (<|>) = mplus\n\ninstance MonadPlus Capability where\n    mzero = Capability (const $ return Nothing)\n    Capability f `mplus` Capability g = Capability $ \\t -> do\n        mx <- f t\n        case mx of\n            Nothing -> g t\n            _ -> return mx\n\nnewtype Capability a = Capability (() -> IO (Maybe a))\n\ntiGetOutput1 :: forall f . OutputCap f => String -> Capability f\n{-# NOINLINE tiGetOutput1 #-}\ntiGetOutput1 _ = return (outputCap (const \"\") [])\n\nenterStandoutMode :: TermStr s => Capability s\nenterStandoutMode = tiGetOutput1 \"smso\"\n\nenterUnderlineMode :: TermStr s => Capability s\nenterUnderlineMode = tiGetOutput1 \"smul\"\n\nreverseOn :: TermStr s => Capability s\nreverseOn = tiGetOutput1 \"rev\"\n\nblinkOn:: TermStr s => Capability s\nblinkOn = tiGetOutput1 \"blink\"\n\nboldOn :: TermStr s => Capability s\nboldOn = tiGetOutput1 \"bold\"\n\ndimOn :: TermStr s => Capability s\ndimOn = tiGetOutput1 \"dim\"\n\ninvisibleOn :: TermStr s => Capability s\ninvisibleOn = tiGetOutput1 \"invis\"\n\nprotectedOn :: TermStr s => Capability s\nprotectedOn = tiGetOutput1 \"prot\"\n\ndata Attributes = Attributes {\n                    standoutAttr,\n                    underlineAttr,\n                    reverseAttr,\n                    blinkAttr,\n                    dimAttr,\n                    boldAttr,\n                    invisibleAttr,\n                    protectedAttr :: Bool\n                }\n\nsetAttributes :: TermStr s => Capability (Attributes -> s)\nsetAttributes = usingSGR0 `mplus` manualSets\n    where\n        usingSGR0 = do\n            sgr <- tiGetOutput1 \"sgr\"\n            return $ \\a -> let mkAttr f = if f a then 1 else 0 :: Int\n                           in sgr (mkAttr standoutAttr)\n                                  (mkAttr underlineAttr)\n                                  (mkAttr reverseAttr)\n                                  (mkAttr blinkAttr)\n                                  (mkAttr dimAttr)\n                                  (mkAttr boldAttr)\n                                  (mkAttr invisibleAttr)\n                                  (mkAttr protectedAttr)\n                                  (0::Int)\n        attrCap :: TermStr s => (Attributes -> Bool) -> Capability s\n                    -> Capability (Attributes -> s)\n        attrCap f cap = do {to <- cap; return $ \\a -> if f a then to else mempty}\n                        `mplus` return (const mempty)\n        manualSets = do\n            cs <- sequence [attrCap standoutAttr enterStandoutMode\n                            , attrCap underlineAttr enterUnderlineMode\n                            , attrCap reverseAttr reverseOn\n                            , attrCap blinkAttr blinkOn\n                            , attrCap boldAttr boldOn\n                            , attrCap dimAttr dimOn\n                            , attrCap invisibleAttr invisibleOn\n                            , attrCap protectedAttr protectedOn\n                            ]\n            return $ \\a -> mconcat $ map ($ a) cs\n\n", "num_lines": 122}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T3990 where\n\ndata family Complex a\ndata instance Complex Double = CD {-# UNPACK #-} !Double\n                                  {-# UNPACK #-} !Double\n\ndata T = T {-# UNPACK #-} !(Complex Double)\n-- This shouuld actually get unpacked!\n\ntest_case :: T\ntest_case = T (CD 1 1)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4138 where\n\nimport T4138_A\n\n-- We NOINLINE f because we want to count the number of F#s in the\n-- -ddump-simpl output, so we don't want to be confused by F#s\n-- appearing in the inlining\n{-# NOINLINE f #-}\nf :: (Float, Float) -> ()\nf = rnf\n\n{-\nWe're hoping that the output will include something like:\n\n  \\ (ds_afa :: (GHC.Types.Float, GHC.Types.Float)) ->\n    case ds_afa of _ { (x_afd, y_afe) ->\n    case x_afd of _ { GHC.Types.F# ipv_afm ->\n    T4138_A.$fNFDataFloat_$crnf y_afe } }\n-}\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T4138_A where\n\nclass NFData a where\n    rnf :: a -> ()\n    rnf a = a `seq` ()\n\ninstance NFData Float\n\ninstance (NFData a, NFData b) => NFData (a,b) where\n    rnf (x,y) = rnf x `seq` rnf y\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Eta where\n\ndata T = MkT\nnewtype Foo = Foo T\n\nlift :: Foo -> T\nlift (Foo x) = bof x\n  -- The point is that we expect\n  --   lift = bof |> co\n  -- not\n  --   lift = \\fx -> bof (fx |> co)\n\nbof :: T -> T\n{-# NOINLINE bof #-}\nbof MkT = MkT\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\n-- Triggered a lint error due to the specialiser\n\nmodule T4203 where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\nnewtype NonNegative a = NonNegative a\n deriving (Eq, Num, Show)\n\ninstance (Eq a, Num a) => Arbitrary (NonNegative a) where\n  arbitrary = return (rubble (rubble 0))\n  coarbitrary = error \"urk\"\n\nrubble :: (Eq a, Num a) => a -> a\nrubble 0 = 1\nrubble n = n * rubble (n-1)\n\nnewtype EmptyStackSet = EmptyStackSet (NonNegative Int)\n\ninstance Arbitrary EmptyStackSet where\n  arbitrary = do\n        x <- arbitrary :: Gen (NonNegative Int)\n        return $ EmptyStackSet x\n  coarbitrary = error \"urk\"\n\nnewtype Gen a = Gen a\n\ninstance Functor Gen where\n    fmap = liftM\n\ninstance Applicative Gen where\n    pure = return\n    (<*>) = ap\n\ninstance Monad Gen where\n  return a    = Gen a\n  Gen m >>= k = Gen (let Gen m' = k m in m')\n\nclass Arbitrary a where\n  arbitrary   :: Gen a\n  coarbitrary :: a\n\ndata StackSet = StackSet\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #4306\n-- Check that the worker for 'upd' has only one argument\n\nmodule T4306 where\n\ndata D = D {-# UNPACK #-} !Double {-# UNPACK #-} !Double  \ndata UPD = UPD {-# UNPACK #-} !Double D\n\nupd (UPD _ (D x _)) = sqrt $! (x*x + x*x + sin x + x*x + x*x + cos x + x*x + x*x + tan x +\n                               x*x + x*x + sin x + x*x + x*x + cos x + x*x + x*x + tan x +\n                               x*x + x*x + sin x + x*x + x*x + cos x + x*x + x*x + tan x)\n                               -- make the rhs large enough to be worker/wrapperred\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one elicited a bug in the simplifier\n-- that produces a Lint out-of-scope error\n\nmodule T4345 where\n\nisNull :: IO Bool\nisNull = error \"urk\"\n\nwrapMatchAll :: IO (Maybe ())\nwrapMatchAll = do\n   nsub <- undefined\n   let loop True = do atEnd <- isNull\n                      return Nothing\n       loop False = loop False\n   result <- undefined\n   loop undefined\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule T4398 where\n\n{-# RULES \"suspicious\" forall (x :: a) y. f (x :: Ord a => a) y = g x y  #-}\n\n{-# NOINLINE f #-}\nf :: a -> a -> Bool\nf x y = True\n\ng :: Ord a => a -> a -> Bool\ng = (<)\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4903 where\n\nimport T4903a\n\n{-# SPECIALIZE eq :: TreeF Tree -> Tree -> Bool #-}\n-- The pragma is only problematic if it is in a separate module\n\nf :: Bool\n-- If we don't use eq, there is no problem  \nf = eq Tree tree  \n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts      #-}\n{-# LANGUAGE RankNTypes            #-}\n{-# LANGUAGE TypeOperators         #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances     #-}\n{-# LANGUAGE GADTs                 #-}\n{-# LANGUAGE TypeFamilies          #-}\n\nmodule T4903a where\n\nimport Data.Kind\n\nclass El phi ix where\n  proof :: phi ix\n\nclass Fam phi where\n  from :: phi ix -> ix -> PF phi I0 ix\n\ntype family PF (phi :: Type -> Type) :: (Type -> Type) -> Type -> Type\n\ndata I0 a = I0 a\n\ndata I xi      (r :: Type -> Type) ix = I (r xi)\ndata (f :*: g) (r :: Type -> Type) ix = f r ix :*: g r ix\n\nclass HEq phi f where\n  heq :: (forall ix. phi ix -> r ix -> Bool)\n      -> phi ix -> f r ix -> Bool\n\ninstance El phi xi => HEq phi (I xi) where\n  -- Replacing proof by undefined solves the problem\n  heq eq _ (I x)     = eq proof x\n\ninstance (HEq phi f, HEq phi g) => HEq phi (f :*: g) where\n  -- The problem only arises when there are two calls to heq here\n  heq eq p (x :*: y) = heq eq p x && heq eq p y\n\n\n{-# INLINABLE eq #-}\neq :: (Fam phi, HEq phi (PF phi)) => phi ix -> ix -> Bool  \neq p x = heq (\\p (I0 x) -> eq p x) p (from p x)\n\n\ndata Tree = Bin Tree Tree\n\ntree :: Tree\n-- The problem only occurs on an inifite (or very large) structure  \ntree = Bin tree tree\n\ndata TreeF :: Type -> Type where Tree :: TreeF Tree\n\ntype instance PF TreeF = I Tree :*: I Tree\n-- If the representation is only |I Tree| then there is no problem\n\ninstance Fam TreeF where\n  from Tree (Bin l r) = I (I0 l) :*: I (I0 r)\n\ninstance El TreeF Tree where proof = Tree  \n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T4908 where\nimport GHC.Base\n\nf :: Int -> (Int,Int) -> Bool\nf 0 x = True \nf n x = case x of (a,b) -> case b of \n                             I# 0# -> True\n                             I# _  -> f (n-1) x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4918 where\n\nimport T4918a\n\nf1 = map (\\() -> 'p') [()]\nf2 = map (\\() -> 'q') myEnum\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4918a where\n\nclass MyEnum a where \n myEnum :: [a]\n\ninstance MyEnum () where \n myEnum = [()]\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4930 where\n\nfoo :: Int -> Int\nfoo n = (if n < 5 then foo n else n+2)\n        `seq` n+5\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Data.Int\nimport Data.Array.Base\nimport Data.Array.ST\nimport Control.Monad.ST\nimport System.Environment\n\nmain :: IO ()\nmain = do\n  [_nr, _len] <- getArgs\n  let nRounds = read _nr :: Int\n      len = read _len :: Int\n  stToIO $ do\n    arr <- newArray (1, len) 0\n   \n    let spin :: STUArray s Int Int -> Int -> Int -> Int -> ST s ()\n        spin _   r i n | i > n = return ()\n        spin arr r i n = do x <- unsafeRead arr i\n                            unsafeWrite arr i $ x + r\n                            spin arr r (i + 1) n\n       \n        loop :: STUArray s Int Int -> Int -> ST s ()\n        loop _   r | r > nRounds = return ()\n        loop arr r = do\n            k <- getNumElements arr\n            spin arr r 0 (k - 1)\n            loop arr (r + 1)\n   \n    loop arr 1\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T4957 where\n\nimport GHC.Base\n\nf :: Bool -> Int -> Int\nf b 0 = 0\nf b x = let y = case b of\n                 True -> case f b (x-1) of\n                            I# v -> I# (v -# 1#)\n                 False -> case f b (x-1) of\n                            I# v -> I# (v +# 1#)\n      in\n      case b of\n         True -> case y of\n                   I# w -> I# (w -# 1#)\n\n         False -> case y of\n                   I# w -> I# (w +# 1#)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- In this test we do -ddump-simpl, and grep for 'patError.\n-- We expect *not* to see patError in the output\n-- because the branch is inaccessible.  \n-- In GHC 7.0 and earlier, we did get a patError in the output program.\n\n{-# LANGUAGE TypeFamilies, GADTs #-}\nmodule NoMatch where\n\ndata Tag\ndata TagExtra\n\n--------\n\ndata Foo a where\n  Foo :: String -> Foo a\n  FooExtra :: Int -> Foo TagExtra\n\n-- The cmm code for fooName does not match against 'FooExtra'\nfooName :: Foo Tag -> String\nfooName (Foo s) = s\n\n--------\n\ndata Bar a where\n  Bar :: String -> Bar a\n  BarExtra :: a ~ TagExtra => Int -> Bar a\n\n-- The cmm code for barName will try to pattern-match against 'BarExtra'\nbarName :: Bar Tag -> String\nbarName (Bar s) = s\n\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, GADTs, TypeFamilies, MultiParamTypeClasses,  FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances,  FlexibleInstances #-}  \nmodule T5303( showContextSeries ) where\n\nimport Control.Monad.State.Strict( StateT )  \nimport Control.Monad.Trans ( lift )\nimport Data.Kind (Type)\n\ndata Tree (m :: Type -> Type) = Tree {}\n\ndata FL (a :: Type -> Type -> Type) x z where\n    (:>:) :: a x y -> FL a y z -> FL a x z\n    NilFL :: FL a x x\n\nclass (Functor m, Monad m) => ApplyMonad m (state :: (Type -> Type) -> Type)\n\nclass Apply (p :: Type -> Type -> Type) where\n    type ApplyState p :: (Type -> Type) -> Type\n    apply :: ApplyMonad m (ApplyState p) => p x y -> m ()\n\nclass (Functor m, Monad m, ApplyMonad (ApplyMonadOver m state) state)\n      => ApplyMonadTrans m (state :: (Type -> Type) -> Type) where\n  type ApplyMonadOver m state :: Type -> Type\n  runApplyMonad :: (ApplyMonadOver m state) x -> state m -> m (x, state m)\n\ninstance (Functor m, Monad m) => ApplyMonadTrans m Tree where\n  type ApplyMonadOver m Tree = TreeMonad m\n  runApplyMonad = virtualTreeMonad\n\ninstance (Functor m, Monad m) => ApplyMonad (TreeMonad m) Tree\n\n-- | Internal state of the 'TreeIO' monad. Keeps track of the current Tree\n-- content, unsync'd changes and a current working directory (of the  monad).\ndata TreeState m = TreeState { tree :: !(Tree m) }  \ntype TreeMonad m = StateT (TreeState m) m  \ntype TreeIO = TreeMonad IO\n\nvirtualTreeMonad :: (Functor m, Monad m) => TreeMonad m a -> Tree m -> m  (a, Tree m)  \nvirtualTreeMonad action t = undefined\n\napplyToState :: forall p m x y. (Apply p, ApplyMonadTrans m (ApplyState p))\n             => p x y -> (ApplyState p) m -> m ((ApplyState p) m)  \napplyToState _ _ = snd `fmap` runApplyMonad undefined undefined\n\nshowContextSeries :: (Apply p, ApplyState p ~ Tree) => FL p x y -> TreeIO ()\nshowContextSeries (p:>:_) = (undefined >>= lift . applyToState p) >>  return ()\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5327 where\n\nnewtype Size = Size Int\n\n{-# INLINABLE val2 #-}\nval2 = Size 17\n\n-- In the core, we should see a comparison against 34#, i.e. constant\n-- folding should have happened. We actually see it twice: Once in f's\n-- definition, and once in its unfolding.\nf n = case val2 of Size s -> s + s > n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE UnicodeSyntax #-}\n{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T5329 where\n\ndata PZero\ndata PSucc p\n\ndata Peano n where\n  PZero \u00e2\u02c6\u00b7 Peano PZero\n  PSucc \u00e2\u02c6\u00b7 IsPeano p \u00e2\u2021\u2019 Peano p \u00e2\u2020\u2019 Peano (PSucc p)\n\nclass IsPeano n where\n  peano \u00e2\u02c6\u00b7 Peano n\n\ninstance IsPeano PZero where\n  peano = PZero\n\ninstance IsPeano p \u00e2\u2021\u2019 IsPeano (PSucc p) where\n  peano = PSucc peano \n\nclass (n ~ PSucc (PPred n)) \u00e2\u2021\u2019 PHasPred n where\n  type PPred n\n\ninstance PHasPred (PSucc p) where\n  type PPred (PSucc p) = p\n\npPred \u00e2\u02c6\u00b7 Peano (PSucc p) \u00e2\u2020\u2019 Peano p\npPred (PSucc p) = p\n\ninfixl 6 :+:\n\nclass (IsPeano n, IsPeano m, IsPeano (n :+: m), (n :+: m) ~ (m :+: n))\n      \u00e2\u2021\u2019 PAdd n m where\n  type n :+: m\n\ninstance PAdd PZero PZero where\n  type PZero :+: PZero = PZero\n\ninstance IsPeano p \u00e2\u2021\u2019 PAdd PZero (PSucc p) where\n  type PZero :+: (PSucc p) = PSucc p\n\ninstance IsPeano p \u00e2\u2021\u2019 PAdd (PSucc p) PZero where\n  type (PSucc p) :+: PZero = PSucc p\n\ninstance (IsPeano n, IsPeano m, PAdd n m) \u00e2\u2021\u2019 PAdd (PSucc n) (PSucc m) where\n  type (PSucc n) :+: (PSucc m) = PSucc (PSucc (n :+: m))\n\ndata PAddResult n m r where\n  PAddResult \u00e2\u02c6\u00b7 (PAdd n m, PAdd m n, (n :+: m) ~ r)\n             \u00e2\u2021\u2019 PAddResult n m r\n\npAddLeftZero \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac n . IsPeano n \u00e2\u2021\u2019 PAddResult PZero n n\npAddLeftZero = case peano \u00e2\u02c6\u00b7 Peano n of\n  PZero   \u00e2\u2020\u2019 PAddResult\n  PSucc _ \u00e2\u2020\u2019 PAddResult\n\npAddRightZero \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac n . IsPeano n \u00e2\u2021\u2019 PAddResult n PZero n\npAddRightZero = case peano \u00e2\u02c6\u00b7 Peano n of\n  PZero   \u00e2\u2020\u2019 PAddResult\n  PSucc _ \u00e2\u2020\u2019 PAddResult\n\ndata PAddSucc n m where\n  PAddSucc \u00e2\u02c6\u00b7 (PAdd n m, PAdd m n,\n              PAdd (PSucc n) m, PAdd m (PSucc n),\n              PAdd n (PSucc m), PAdd (PSucc m) n,\n              (PSucc n :+: m) ~ PSucc (n :+: m),\n              (n :+: PSucc m) ~ PSucc (n :+: m))\n           \u00e2\u2021\u2019 PAddSucc n m\n\npAddSucc \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac n m . (IsPeano n, IsPeano m) \u00e2\u2021\u2019 PAddSucc n m\npAddSucc = case (peano \u00e2\u02c6\u00b7 Peano n, peano \u00e2\u02c6\u00b7 Peano m) of\n  (PZero,   PZero)   \u00e2\u2020\u2019 PAddSucc\n  (PZero,   PSucc _) \u00e2\u2020\u2019 case pAddLeftZero \u00e2\u02c6\u00b7 PAddResult n (PPred m) (PPred m) of\n    PAddResult \u00e2\u2020\u2019 PAddSucc\n  (PSucc _, PZero)   \u00e2\u2020\u2019 case pAddRightZero \u00e2\u02c6\u00b7 PAddResult (PPred n) m (PPred n) of\n    PAddResult \u00e2\u2020\u2019 PAddSucc\n  (PSucc _, PSucc _) \u00e2\u2020\u2019 case pAddSucc \u00e2\u02c6\u00b7 PAddSucc (PPred n) (PPred m) of\n    PAddSucc \u00e2\u2020\u2019 PAddSucc\n\ndata PAdd2 n m where\n  PAdd2 \u00e2\u02c6\u00b7 (PAdd n m, PAdd m n) \u00e2\u2021\u2019 PAdd2 n m\n\npAdd2 \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac n m . (IsPeano n, IsPeano m) \u00e2\u2021\u2019 PAdd2 n m\npAdd2 = case (peano \u00e2\u02c6\u00b7 Peano n, peano \u00e2\u02c6\u00b7 Peano m) of\n  (PZero,   PZero)   \u00e2\u2020\u2019 PAdd2\n  (PZero,   PSucc _) \u00e2\u2020\u2019 PAdd2\n  (PSucc _, PZero)   \u00e2\u2020\u2019 PAdd2\n  (PSucc _, PSucc _) \u00e2\u2020\u2019 case pAdd2 \u00e2\u02c6\u00b7 PAdd2 (PPred n) (PPred m) of\n    PAdd2 \u00e2\u2020\u2019 PAdd2\n\ndata PAdd3 n m k where\n  PAdd3 \u00e2\u02c6\u00b7 (PAdd n m, PAdd m k, PAdd m n, PAdd k m, PAdd n k, PAdd k n,\n           PAdd (n :+: m) k, PAdd k (m :+: n),\n           PAdd n (m :+: k), PAdd (m :+: k) n,\n           PAdd (n :+: k) m, PAdd m (n :+: k),\n           ((n :+: m) :+: k) ~ (n :+: (m :+: k)),\n           (m :+: (n :+: k)) ~ ((m :+: n) :+: k))\n        \u00e2\u2021\u2019 PAdd3 n m k\n\npAdd3 \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac n m k . (IsPeano n, IsPeano m, IsPeano k) \u00e2\u2021\u2019 PAdd3 n m k\npAdd3 = case (peano \u00e2\u02c6\u00b7 Peano n, peano \u00e2\u02c6\u00b7 Peano m, peano \u00e2\u02c6\u00b7 Peano k) of\n  (PZero,   PZero,   PZero)   \u00e2\u2020\u2019 PAdd3\n  (PZero,   PZero,   PSucc _) \u00e2\u2020\u2019 PAdd3\n  (PZero,   PSucc _, PZero)   \u00e2\u2020\u2019 PAdd3\n  (PSucc _, PZero,   PZero)   \u00e2\u2020\u2019 PAdd3\n  (PZero,   PSucc _, PSucc _) \u00e2\u2020\u2019\n    case pAdd2 \u00e2\u02c6\u00b7 PAdd2 (PPred m) (PPred k) of\n      PAdd2 \u00e2\u2020\u2019 PAdd3\n  (PSucc _, PZero,   PSucc _) \u00e2\u2020\u2019\n    case pAdd2 \u00e2\u02c6\u00b7 PAdd2 (PPred n) (PPred k) of\n      PAdd2 \u00e2\u2020\u2019 PAdd3\n  (PSucc _, PSucc _, PZero)   \u00e2\u2020\u2019\n    case pAdd2 \u00e2\u02c6\u00b7 PAdd2 (PPred n) (PPred m) of\n      PAdd2 \u00e2\u2020\u2019 PAdd3\n  (PSucc _, PSucc _, PSucc _) \u00e2\u2020\u2019 \n    case pAdd3 \u00e2\u02c6\u00b7 PAdd3 (PPred n) (PPred m) (PPred k) of\n      PAdd3 \u00e2\u2020\u2019 case pAddSucc \u00e2\u02c6\u00b7 PAddSucc (PPred n :+: PPred m) (PPred k) of\n        PAddSucc \u00e2\u2020\u2019 case pAddSucc \u00e2\u02c6\u00b7 PAddSucc (PPred n :+: PPred k) (PPred m) of\n          PAddSucc \u00e2\u2020\u2019 case pAddSucc \u00e2\u02c6\u00b7 PAddSucc (PPred m :+: PPred k) (PPred n) of \n            PAddSucc \u00e2\u2020\u2019 PAdd3\n\n", "num_lines": 131}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule T5342 (increaseAreas) where\n\nimport Control.Monad\nimport Data.List\n\nnubSorted :: Eq a => [a] -> [a]\nnubSorted = undefined\n\ncellsAround :: (Num a, Num b, Ord a, Ord b) => [(a, b)] -> [(a, b)]  \ncellsAround = undefined\n\nincreaseAreas :: (Num a, Num b, Ord a, Ord b) => [[(a, b)]] -> [[(a, b)]]  \nincreaseAreas areas \n = nubSorted $ sort $\n     do\n         area <- areas\n         cell2 <- cellsAround area\n         return $ sort $ cell2 : area\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, RankNTypes, MagicHash, UnboxedTuples #-}\n\nmodule T5359a (linesT) where\n\nimport GHC.Base hiding (empty)\nimport GHC.Word\nimport GHC.ST (ST(..), runST)\n\nnullT :: Text -> Bool\nnullT (Text _ _ len) = len <= 0\n{-# INLINE [1] nullT #-}\n\nspanT :: (Char -> Bool) -> Text -> (Text, Text)\nspanT p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))\n  where k = loop 0\n        loop !i | i >= len || not (p c) = i\n                | otherwise             = loop (i+d)\n            where Iter c d              = iter t i\n{-# INLINE spanT #-}\n\nlinesT :: Text -> [Text]\nlinesT ps | nullT ps  = []\n          | otherwise = h : if nullT t\n                            then []\n                            else linesT (unsafeTail t)\n    where (h,t) = spanT (/= '\\n') ps\n{-# INLINE linesT #-}\n\nunsafeTail :: Text -> Text\nunsafeTail t@(Text arr off len) = Text arr (off+d) (len-d)\n  where d = iter_ t 0\n{-# INLINE unsafeTail #-}\n\ndata Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int\n\niter :: Text -> Int -> Iter\niter (Text arr _ _) i = Iter (unsafeChrT m) 1\n  where m = unsafeIndex arr i\n{-# INLINE iter #-}\n\niter_ :: Text -> Int -> Int\niter_ (Text arr off _) i | m < 0xD800 || m > 0xDBFF = 1\n                         | otherwise                = 2\n  where m = unsafeIndex arr (off+i)\n{-# INLINE iter_ #-}\n\ndata Text = Text {-# UNPACK #-}!Array {-# UNPACK #-}!Int {-# UNPACK #-}!Int\n\ntext :: Array -> Int -> Int -> Text\ntext arr off len = Text arr off len\n{-# INLINE text #-}\n\nemptyT :: Text\nemptyT = Text empty 0 0\n{-# INLINE [1] emptyT #-}\n\ntextP :: Array -> Int -> Int -> Text\ntextP arr off len | len == 0  = emptyT\n                  | otherwise = text arr off len\n{-# INLINE textP #-}\n\nunsafeChrT :: Word16 -> Char\nunsafeChrT (W16# w#) = C# (chr# (word2Int# w#))\n{-# INLINE unsafeChrT #-}\n\ndata Array = Array ByteArray#\n\ndata MArray s = MArray (MutableByteArray# s)\n\nnew :: forall s. Int -> ST s (MArray s)\nnew n@(I# len#)\n  | n < 0 || n /= 0 = error $ \"Data.Text.Array.new: size overflow\"\n  | otherwise = ST $ \\s1# ->\n       case newByteArray# len# s1# of\n         (# s2#, marr# #) -> (# s2#, MArray marr# #)\n{-# INLINE new #-}\n\nunsafeFreeze :: MArray s -> ST s Array\nunsafeFreeze (MArray maBA) = ST $ \\s# -> (# s#, Array (unsafeCoerce# maBA) #)\n{-# INLINE unsafeFreeze #-}\n\nunsafeIndex :: Array -> Int -> Word16\nunsafeIndex (Array aBA) (I# i#) =\n    case indexWord16Array# aBA i# of r# -> (W16# r#)\n{-# INLINE unsafeIndex #-}\n\nempty :: Array\nempty = runST (new 0 >>= unsafeFreeze)\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T5359b where\n\n-----------------------------------------------------------------------------\n-- Base\n-----------------------------------------------------------------------------\ninfixr 5 :+:\ninfixr 6 :*:\n\ndata U       = U              \ndata a :+: b = L a | R b      \ndata a :*: b = a :*: b        \nnewtype Rec a   = Rec a       \n\nclass Representable a where\n  type Rep a\n  to   :: Rep a -> a\n  from :: a -> Rep a\n\n\ndata Tree = Leaf | Bin Int Tree Tree\n\ninstance Representable Tree where\n  type Rep Tree =     U\n                      :+: (Rec Int :*: Rec Tree :*: Rec Tree)\n\n  from (Bin x l r) = R ((Rec x :*: Rec l :*: Rec r))\n  from Leaf        = L (U)\n\n  to (R ((Rec x :*: (Rec l) :*: (Rec r)))) = Bin x l r\n  to (L (U))                               = Leaf\n\n--------------------------------------------------------------------------------\n-- Generic enum\n--------------------------------------------------------------------------------\n\nclass Enum' a where\n  enum' :: [a]\n\ninstance Enum' U where enum' = undefined\ninstance (Enum' a) => Enum' (Rec a) where enum' = undefined\ninstance (Enum' f, Enum' g) => Enum' (f :+: g) where enum' = undefined\ninstance (Enum' f, Enum' g) => Enum' (f :*: g) where enum' = undefined\n\n\n-- This INLINE pragma is essential for the bug\n{-# INLINE genum #-}\ngenum :: (Representable a, Enum' (Rep a)) => [a]\n-- The definition of genum is essential for the bug\ngenum = map to enum'\n\n\ninstance Enum' Tree where enum' = genum\ninstance Enum' Int  where enum' = []\n\n-- This SPECIALISE pragma is essential for the bug\n{-# SPECIALISE genum :: [Tree] #-}\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5366 where\n\nnewtype Id a = Id Int\ndata Foo = Foo {-# UNPACK #-} !(Id Foo) String\ndata Bar = Bar {-# UNPACK #-} !Foo\n\nf :: Bar -> Int\nf (Bar (Foo (Id x) _)) = x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\ntype T a = Int\n\nf :: T a -> Bool -> [Int]\nf x b = case b of\n               True  -> f x b\n               False -> x : f x (x > 19)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5550 where\n\nimport GHC.Exts ( SpecConstrAnnotation(..) )\n\ndata SPEC = SPEC | SPEC2\n{-# ANN type SPEC ForceSpecConstr #-}\n\nloop :: SPEC -> [Int] -> [Int] -> [Int]\nloop SPEC z [] = z\nloop SPEC z (x:xs) = loop SPEC (x:z) xs\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = do\n  printInt $ 9999 `div` 5\n  printInt $ 9999 `mod` 5\n  n <- readLn\n  printInt $ n `div` 4\n  printInt $ n `mod` 4\n\nprintInt :: Int -> IO ()\nprintInt = print\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5623 where\n\nimport Foreign.Storable\nimport Control.Monad\nimport GHC.Ptr\n\nfoo :: Ptr Float -> IO Float\nfoo p = liftM2 (+) (peekElemOff q 0) (peekElemOff q 1)\n  where\n    q = p `plusPtr` 4\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\nmodule T5658b where\nimport GHC.Prim\nimport GHC.Exts ( isTrue# )\n\nfoo :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool\nfoo xs ys m n = go 0# 0#\n  where\n    go i j = case isTrue# (i >=# m) of\n      False -> let !x = indexIntArray# xs i in\n        case isTrue# (j >=# n) of\n          False -> case isTrue# (x ==# indexIntArray# ys j) of\n            False -> False\n            True  -> go (i +# 1#) (j +# 1#)\n          True -> False\n      True -> case isTrue# (j >=# n) of\n        False -> let !y = indexIntArray# ys i in False\n        True -> True\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5776 where\n\n-- The point about this test is that we should get a rule like this:\n-- \"foo\" [ALWAYS]\n--    forall (@ a)\n--           ($dEq  :: Eq a)\n--           ($dEq1 :: Eq a)\n--           (x :: a)\n--           (y :: a)\n--           (z :: a).\n--      T5776.f (g @ a $dEq1 x y)\n--              (g @ a $dEq  y z)\n--      = GHC.Types.True\n--\n-- Note the *two* forall'd dEq parameters. This is important.\n-- See Note [Simplifying RULE lhs constraints] in TcSimplify\n\n{-# RULES \"foo\" forall x y z.\n      f (g x y) (g y z) = True\n #-}\n\ng :: Eq a => a -> a -> Bool\n{-# NOINLINE g #-}\ng = (==)\n\nf :: Bool -> Bool -> Bool\n{-# NOINLINE f #-}\nf a b = False\n\nblah :: Int -> Int -> Bool\nblah x y = f (g x y) (g x y)\n \n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule T5821 where\n\ntype family T a\ntype instance T Int = Bool\n\nfoo :: Num a => a -> T a\nfoo = undefined\n\n{-# SPECIALISE foo :: Int -> Bool #-}\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5996 where\n\ndata C a b = C a b\na = undefined\n{-# NOINLINE a #-}\nb = undefined\n{-# NOINLINE b #-}\n\nx1 = C a b\nx2 = C x1 b\ny1 = C a b\ny2 = C y1 b\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6056 where\nimport T6056a\n\nfoo :: Int -> (Maybe Int, [Int])\nfoo x = smallerAndRest x [x]\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6056a where\n\nsmallerAndRest :: Ord a => a -> [a] -> (Maybe a, [a])\nsmallerAndRest x [] = (Nothing, [])\nsmallerAndRest x (y:ys) | y < x = (Just y, ys)\n                        | otherwise = smallerAndRest x ys\n\n{-# INLINABLE smallerAndRest #-}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6082_RULE where\n\n-- Should warn\nfoo1 x = x\n{-# RULES \"foo1\" forall x. foo1 x = x #-}\n\n-- Should warn\nfoo2 x = x\n{-# INLINE foo2 #-}\n{-# RULES \"foo2\" forall x. foo2 x = x #-}\n\n-- Should not warn\nfoo3 x = x\n{-# NOINLINE foo3 #-}\n{-# RULES \"foo3\" forall x. foo3 x = x #-}\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule Float where\n\nimport GHC.Prim\n\nfoo vs  \n  = let w = if length (reverse vs) > 10 then Just (length vs) else Nothing\n        \n        f :: State# RealWorld -> Int -> (# Int, State# RealWorld #)\n        f s x | Just 0 <- w = case f s (x+1) of\n                        (# r, s' #) -> (# r, s' #) \n              | otherwise = (# x, s #)\n\n    in f realWorld# 1\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Char\n\n{-# RULES \"map-loop\" [~] forall f . map' f = map' (id . f) #-}\n\n{-# NOINLINE map' #-}\nmap' f [] = []\nmap' f (x:xs) = f x : map' f xs\n\nmain = print (map' toUpper \"Hello, World\")\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7165 where\n\nimport T7165a\n\nmeh = blah (0,0)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T7165a where\n\nblah :: (dd ~ (Double, Double)) => dd -> dd\nblah (ax, bx)\n    | ax < bx = blah (bx, ax)\n    | otherwise = (0,0)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T7287 where\n\nimport GHC.Prim\n\n{-# RULES\n  \"int2Word#/word2Int#\" forall x. int2Word# (word2Int# x) = x\n  #-}\n\n{- We get a legitimate\n\n   T7287.hs:7:3: warning:\n       Rule int2Word#/word2Int# may never fire because\n         rule \"word2Int#\" for \u00e2\u20ac\u02dcword2Int#\u00e2\u20ac\u2122 might fire first\n       Probable fix: add phase [n] or [~n] to the competing rule\n\nbecause rule \"word2Int#\" is the constant folding rule that converts\na sufficiently-narrow Word# literal to an Int#.  There is a similar\none for int2Word#, so the whole lot is confluent. -}\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Both these functions should successfully simplify\n-- using the combine-identical-alternatives optimisation\n\nmodule T7360 where\n\nimport GHC.List as L\n\ndata Foo = Foo1 | Foo2 | Foo3 !Int\n    \nfun1 :: Foo -> ()\n{-# NOINLINE fun1 #-}\nfun1 x = case x of\n               Foo1 -> ()\n               Foo2 -> ()\n               Foo3 {} -> ()\n\nfun2 x = (fun1 Foo1,  -- Keep -ddump-simpl output \n                      -- in a predicatable order\n         case x of\n          [] -> L.length x\n          (_:_) -> L.length x)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The contents of this file are irrelevant. It is merely\n-- the target for compilation by the T7702Plugin, which\n-- exhibits the space leak in Trac #7702\nmodule Main where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds #-}\n\nmodule Foo( shared, foo, bar) where\n-- module Foo where\n\nimport Data.Kind\n\n{-\nfoo :: [Int] -> [Int]\nfoo = let f = map negate\n      in   f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n           f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n           f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n           f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n           f . f . f . f . f . f . f . f . f . f . f . f . f\n\n-}\n\ntype family Domain (f :: Type -> Type) a :: Constraint\n\ntype instance Domain [] a = ()\n\ninstance MyFunctor [] where\n  myfmap = map\n\nclass MyFunctor f where\n  myfmap :: (Domain f a, Domain f b) => (a -> b) -> f a -> f b\n\nshared :: (MyFunctor f, Domain f Int) => f Int -> f Int\nshared = let\n  f = myfmap negate\n  in\n  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.  f.\n  f . f . f . f . f . f . f . f . f . f . f . f . f\n\nfoo xs = shared $ 0:xs\nbar xs = 0:shared xs\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T7796 where\n\nimport GHC.Prim\n\n--\n-- test for #7796\n--\n-- created by nicolas.frisby@gmail.com, feel free to email me!\n--\n-- a delicate interaction between specialisation and w/w creates a\n-- binding that is dead but is allocated at run-time\n--\n\n--\n-- we grep the -ddump-prep for $s$go, and the actual test expects a\n-- particular number of hits\n--\n-- thus the test will fail in two scenarios:\n--\n--   * the actually interesting case where the zombie $s$go binding\n--     survives, or\n--\n--   * the naming convention for specialised things changes, in which\n--     case the Makefile rule for this test needs to be updated to\n--     scrape the -ddump-prep output differently\n--\n\n--\n-- the zombie binding is $sgo; here's how we reproduce it:\n--\n--   1. specialise go such that the RHS of $sgo uses both $sgo and go\n--\n--   2. worker-wrapper $sgo but *not* go\n--\n-- thus: $sgo uses $w$sgo uses go uses $sgo\n--\n-- the key point: the last \"use\" is only via a RULE; see the ticket\n-- #7796 for more discussion and related tickets\n--\n\ndata L = C Int# L | N Int# -- I'm using unboxed elements to avoid ww'd\n                           -- unrelated to the bug\n\nhost :: Eq b => b -> L -> Bool\nhost b x =\n  let go :: Eq a =>  -- must be used (to trigger specialise), but not\n                     -- strict (else we ww the unspecialised version)\n\n            a ->     -- must be strict, so that we ww the\n                     -- specialisation\n\n            L ->     -- not sure what this needs... but strict is\n                     -- doing the trick\n\n            Bool\n\n      go d (N i) = d `seq` case i of\n        0# -> True\n        o  -> go b (N (i -# 1#)) -- NB must at (a ~ b)\n\n      go d (C x xs) = (d == d) `seq` go d (C (x -# 1#) xs)\n  in go (3 :: Int) x\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7865 where\n\n-- Our very expensive operation that we don't want to perform more than once\n-- Don't inline it so we can see exactly where it's called in the core\n{-# NOINLINE expensive #-}\nexpensive :: Int -> Int\nexpensive x = x * 100000\n\n-- SpecConstr this function:\nrecursive :: [Int] -> (Int,Int) -> (Int,Int)\nrecursive list acc\n = case list of\n   []     -> acc\n   (x:xs) ->\n     -- Our expensive tuple:\n     -- The case is here mainly so that the expensive let isn't floated out before SpecConstr.\n     let a'    = case xs of\n                 [] -> acc\n                 (_:_) -> (let b = expensive x in (b * 2), x)\n         -- Use the expensive value once and recurse.\n         -- We recurse with (_:_:_) so that a specialisation is made for that pattern,\n         -- which simplifies the case xs above. This exposes the expensive let.\n         (p,q) = case a' of (p',q') -> recursive (x:x:xs) (q',p')\n\n         -- Use the expensive value again.\n         -- Our problem is that this shows up as a separate let-binding for expensive, instead of reusing\n         -- the already computed value from above.\n     in  (p + fst a', q + snd a')\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7944 where\n\nimport GHC.Exts\n\n-- Force specialisation of \"go\"\ndata SPEC = SPEC | SPEC2\n{-# ANN type SPEC ForceSpecConstr #-}\n\n-- This is more or less just an ordinary fold\ngo :: SPEC -> [a] -> IntMap a -> IntMap a\ngo SPEC [] m = m\ngo SPEC (_:xs) m\n = go SPEC xs\n -- This would be the \"worker function\" of the fold\n $ Unary m\n\n\n-- Both constructors are necessary, despite only one being used\ndata IntMap a = Nil | Unary (IntMap a)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- We import Pretty from package ghc\nmodule T7995 where\nimport Pretty\n\n\nfoo = text \"test\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# OPTIONS_GHC -dcore-lint -O #-}\nmodule T8196 where\n\ndata T a b = MkT (a b)\n   deriving Show\n\nfoo = print (MkT (Just True))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8221 where\n\nimport T8221a\n\ndata Located e = L () e deriving Eq\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8221a where\n\nimport Data.IORef\n\ndata Link a = Link !(IORef (Link a)) | X \n\ninstance Eq (Link a) where\n (==) (Link x) (Link y) = x==y\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8221b where\n\ndata Link a = Link a !(Link a)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T8274 where\n\nimport GHC.Prim\n\ndata P = Positives Int# Float# Double# Char# Word#\ndata N = Negatives Int# Float# Double#\n\np = Positives 42# 4.23# 4.23## '4'# 4##\nn = Negatives -4# -4.0# -4.0##\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8329 where\n\nimport T8329_Parse\nimport T8329_Com\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8329_Com where\n\nimport Data.String (fromString)\n\nencodingName :: String\nencodingName = fromString \"\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O0 #-}\n\nmodule T8329_Meta where\n\nimport Data.String\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8329_Parse where\n\nimport T8329_Meta\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, RankNTypes #-}\n\nmodule Main ( main, useAbstractMonad ) where\n\nimport Control.Monad\nimport Control.Monad.ST\nimport Control.Applicative\n\nnewtype ReaderT r m a = ReaderT {\n        -- | The underlying computation, as a function of the environment.\n        runReaderT :: r -> m a\n    }\n\ninstance (Applicative m) => Applicative (ReaderT r m) where\n    pure    = liftReaderT . pure\n    f <*> v = ReaderT $ \\ r -> runReaderT f r <*> runReaderT v r\n\ninstance (Functor m) => Functor (ReaderT r m) where\n    fmap f  = mapReaderT (fmap f)\n\ninstance (Monad m) => Monad (ReaderT r m) where\n    return x  = ReaderT (\\_ -> return x)\n    m >>= k  = ReaderT $ \\ r -> do\n        a <- runReaderT m r\n        runReaderT (k a) r\n    fail msg = ReaderT (\\_ -> fail msg)\n\nmapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b\nmapReaderT f m = ReaderT $ f . runReaderT m\n\nliftReaderT :: m a -> ReaderT r m a\nliftReaderT m = ReaderT (const m)\n\nask :: (Monad m) => ReaderT r m r\nask = ReaderT return\n\nclass (Applicative m, Functor m , Monad m) => MonadAbstractIOST m where\n    addstuff :: Int -> m Int\n\ntype ReaderST s = ReaderT (Int) (ST s)\n\ninstance MonadAbstractIOST (ReaderST s) where\n    addstuff a = return . (a +) =<< ask\n\nrunAbstractST :: (forall s. ReaderST s a) -> a\nrunAbstractST f = runST $ runReaderT f 99\n\n{-# SPECIALIZE useAbstractMonad :: Int -> ReaderST s Int #-}\n-- Note the polymorphism\nuseAbstractMonad :: MonadAbstractIOST m => Int -> m Int\nuseAbstractMonad n = foldM (\\a b -> a `seq` return . (a +) =<< (addstuff b)) 0 [1..n]\n\n-- useConcreteMonad :: Int -> ReaderST s Int\n-- useConcreteMonad = foldM (\\a b -> a `seq` return . (a +) =<< (addstuff b)) 0 [1..n]\n\nmain :: IO ()\nmain = do\n    let st = runAbstractST (useAbstractMonad 5000000)\n    putStrLn . show $ st\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DataKinds, KindSignatures, FlexibleInstances #-}\n\nmodule T8537 where\n\nimport Data.Functor\n\ndata Nat = S !Nat  | Z\n\ninfixr 3 :*\n\ndata Shape (rank :: Nat) a where\n    Nil  :: Shape Z a\n    (:*) ::  !(a) -> !(Shape r a ) -> Shape  (S r) a\n\ninstance Functor (Shape Z) where\n\n    fmap  = \\ f Nil -> Nil\n    {-# INLINABLE fmap #-}\n\n    {-# SPECIALIZE fmap :: (Int ->Int )-> (Shape Z Int)-> (Shape Z Int) #-}\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\nmodule T8714 where\n\ndata HLState = forall a. HLState (a -> a) !a\n\ndata BufferImpl = FBufferData !HLState\n\nfocusAst :: BufferImpl -> HLState\nfocusAst (FBufferData (HLState f x)) = HLState f (f x)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n-- I'm concerned that the -ddump-simpl output may differ on 32 and 64-bit\n-- platforms.  So far I've only put in output for 64-bit platforms.\n\nmodule T8832 where\n\nimport Data.Bits\nimport Data.Int\nimport Data.Word\n\n#define T(s,T) \\\ns :: T ; \\\ns = clearBit (bit 0) 0 ; \\\n\nT(i,Int)\nT(i8,Int8)\nT(i16,Int16)\nT(i32,Int32)\n#ifdef T8832_WORDSIZE_64\nT(i64,Int64)\n#endif\n\nT(w,Word)\nT(w8,Word8)\nT(w16,Word16)\nT(w32,Word32)\n#ifdef T8832_WORDSIZE_64\nT(w64,Word64)\n#endif\n\nT(z,Integer)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-missing-methods #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE KindSignatures, GADTs, DataKinds, FlexibleInstances, FlexibleContexts #-}\n\nmodule T8848 where\n\nimport qualified Control.Applicative as A\nimport qualified Data.Functor as Fun\n\ndata Nat = S Nat  | Z\n\ndata Shape (rank :: Nat) a where\n    Nil  :: Shape Z a\n    (:*) ::  a -> Shape r a -> Shape  (S r) a\n\ninstance A.Applicative (Shape Z) where\ninstance A.Applicative (Shape r)=> A.Applicative (Shape (S r)) where\ninstance Fun.Functor (Shape Z) where\ninstance (Fun.Functor (Shape r)) => Fun.Functor (Shape (S r)) where\n\nmap2 :: (A.Applicative (Shape r))=> (a->b ->c) -> (Shape r a) -> (Shape r b) -> [Shape r c]\n-- Artificially made recursive so that it won't inline,\n-- so we can see if the specialisation happens\nmap2 = \\f l r -> (A.pure f A.<*>  l  A.<*> r) : map2 f l r\n\n{-# SPECIALIZE map2 :: (a->b->c)\n                    -> (Shape (S (S Z)) a )\n                    -> Shape (S (S Z)) b\n                    -> [Shape (S (S Z)) c] #-}\n\nmap3 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> [Shape (S (S Z)) c]\nmap3 x y z = map2 x y z\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule T8848a where\n\nf :: Ord a => b -> a -> a\nf y x = x\n\n{-# SPECIALISE f :: b -> [Int] -> [Int] #-}\n\n{- Specialised badly:\n\n\"SPEC Spec.f\" [ALWAYS]\n    forall (@ b_aX7).\n      Spec.f @ b_aX7\n             @ [GHC.Types.Int]\n             (GHC.Classes.$fOrd[]\n                @ GHC.Types.Int\n                (GHC.Classes.$fEq[] @ GHC.Types.Int GHC.Classes.$fEqInt)\n                GHC.Classes.$fOrdInt)\n      = Spec.f_$sf @ b_aX7\n-}", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9400 (main) where\nimport GHC.Base\n\nstr = \"defg\"\n\nmain :: IO ()\nmain = do\n    case \"abc\" of\n        (x:y:xs) -> putStrLn xs\n    case \"\" of\n        [] -> putStrLn \"x\"\n    case \"ab\" of\n        [] -> putStrLn \"y\"\n        (x:y:[]) -> putStrLn \"z\"\n    case str of\n        (x:xs) -> putStrLn xs\n    case \"ab\" of\n        \"\" -> putStrLn \"fail\"\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9441a where\n\nf1 :: Integer -> Integer\nf1 1 = 1\nf1 n = n * f1 (n - 1)\n\nf2 :: Integer -> Integer\nf2 1 = 1\nf2 m = m * f2 (m - 1)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9441b where\n\nf1 :: Integer -> Integer\nf1 n\n    | n <= 1 = 1\n    | otherwise = go n 1\n  where\n    go 0 r = r\n    go m r = go (m - 1) (r * m)\n\nf2 :: Integer -> Integer\nf2 n = go n 1\n  where\n    go 0 s = s\n    go p s = go (p - 1) (s * p)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9441 where\n-- Core output should show only one recursive Bind Rec { .. }\nimport GHC.Exts (build)\n\n{-# INLINE reverse' #-}\nreverse' :: [a] -> [a]\nreverse' xs = build $ \\c n -> foldl (\\a x -> x `c` a) n xs\n\nappRev :: [a] -> [a] -> [a]\nappRev xs ys = xs ++ reverse' ys\n\nrevAppRev :: [a] -> [a] -> [a]\nrevAppRev xs ys = reverse' xs ++ reverse' ys\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9509 (main) where\n\nimport T9509a\n\nmain = foo (5 :: Int) >>= print\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9509a (foo) where\n\nimport Data.IORef\n\nfoo :: Ord a => a -> IO a\n{-# INLINABLE foo #-}\nfoo x = newIORef x >>= readIORef >>= \\y ->\n        case compare x y of\n           LT ->  return x\n           _  ->  foo x   -- Recursive so it won't inline\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances #-}\n\n-- This is a copy of typecheck/should_run/T3500b, but it's here for\n-- a different reason: at one time, it sent the compiler into a loop.\n-- ANd T3500b isn't tested 'fast' mode\n\nmodule T9565 where\n\nnewtype Mu f = Mu (f (Mu f))\n\ntype family Id m\ntype instance Id m = m\n\ninstance Show (Id (f (Mu f))) => Show (Mu f) where\n    show (Mu f) = show f\n\nshowMu :: Mu (Either ()) -> String\nshowMu = show\n\nitem :: Mu (Either ())\nitem = Mu (Right (Mu (Left ())))\n\nmain = print (showMu item)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# OPTIONS_GHC -O #-}\n\nmodule T9583 where\n\nimport Data.Binary      ( Binary(..) )\nimport Data.Data        ( Data )\nimport Data.Typeable    ( Typeable )  \nimport GHC.Generics     ( Generic )\n\ndata T = A\n       | B\n       | C T\n       | D T T\n       | E T T\n  deriving (Data, Generic, Typeable)\n\ninstance Binary T\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport B\n\ndata HsExpr id\n  = HsOverLit (HsOverLit id)\n  | HsBracketOut (HsExpr id)\n  deriving Eq\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nimport {-# SOURCE #-} A (HsExpr)\n\ndata HsOverLit id\n  = OverLit (HsExpr id)\n  deriving Eq\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\n\nmain = defaultMain\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7702Plugin ( plugin )  where\n\nimport GhcPlugins\n\n-- A plugin that does nothing but tickle CoreM's writer.\nplugin :: Plugin\nplugin = defaultPlugin { installCoreToDos = install }\n    where\n        install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]\n        install _ todos = do\n\n            putMsgS \"T7702Plugin\"\n\n            -- 1 million times, so the allocation in this plugin dominates allocation due\n            -- to other compiler flags and the test framework can easily catch the difference\n            -- can't use replicateM_ because it causes its own problems\n            nothingX100000 ; nothingX100000 ; nothingX100000 ; nothingX100000 ; nothingX100000\n            nothingX100000 ; nothingX100000 ; nothingX100000 ; nothingX100000 ; nothingX100000\n\n            return todos\n\n-- this will result in a call to plusWriter in CoreM's\n-- >>= implementation, which was causing the space leak\nnothing :: CoreM ()\nnothing = liftIO (return ())\n\nnothingX10 :: CoreM ()\nnothingX10 = do\n    nothing ; nothing ; nothing ; nothing ; nothing\n    nothing ; nothing ; nothing ; nothing ; nothing\n\nnothingX100 :: CoreM ()\nnothingX100 = do\n    nothingX10 ; nothingX10 ; nothingX10 ; nothingX10 ; nothingX10\n    nothingX10 ; nothingX10 ; nothingX10 ; nothingX10 ; nothingX10\n\nnothingX1000 :: CoreM ()\nnothingX1000 = do\n    nothingX100 ; nothingX100 ; nothingX100 ; nothingX100 ; nothingX100\n    nothingX100 ; nothingX100 ; nothingX100 ; nothingX100 ; nothingX100\n\nnothingX10000 :: CoreM ()\nnothingX10000 = do\n    nothingX1000 ; nothingX1000 ; nothingX1000 ; nothingX1000 ; nothingX1000\n    nothingX1000 ; nothingX1000 ; nothingX1000 ; nothingX1000 ; nothingX1000\n\nnothingX100000 :: CoreM ()\nnothingX100000 = do\n    nothingX10000 ; nothingX10000 ; nothingX10000 ; nothingX10000 ; nothingX10000\n    nothingX10000 ; nothingX10000 ; nothingX10000 ; nothingX10000 ; nothingX10000\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\nimport Control.DeepSeq\nmain = evaluate (('a' : undefined) `deepseq` return () :: IO ())\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\nimport Unsafe.Coerce\nimport Data.Array\n\nnewtype Age = Age Int\n\nfooAge :: Array Int Int -> Array Int Age\nfooAge = fmap Age\nfooCoerce :: Array Int Int -> Array Int Age\nfooCoerce = fmap coerce\nfooUnsafeCoerce :: Array Int Int -> Array Int Age\nfooUnsafeCoerce = fmap unsafeCoerce\n\nsame :: a -> b -> IO ()\nsame x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of\n    1# -> putStrLn \"yes\"\n    _  -> putStrLn \"no\"\n\nmain = do\n    let l = listArray (1,3) [1,2,3]\n    same (fooAge l) l\n    same (fooCoerce l) l\n    same (fooUnsafeCoerce l) l\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Monad.ST\nimport Data.STRef\n\n-- Make sure that the realWord# token used by runST (actually by runSTRep) is\n-- not inlined, which would share the call to `newMutVar#`, and suddenly there\n-- would be only one MutVar\n\nmain =\n    let f () = runST $ do\n        ref <- newSTRef 0\n        modifySTRef ref (+1)\n        readSTRef ref\n    in print (f () + f ())\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This test checks that the magic treatment of RULES \n-- for 'seq' works right. \n--\n-- See Note [RULES for seq] in MkId for more details\n\nmodule Main where\n\n{-# NOINLINE f #-}\nf x = not x\n\n{-# RULES \n     \"f/seq\" forall n.  seq (f n) = const True\n #-}\n\nmain = print (seq (f True) False)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test filter fusion\n\n-- In GHC 4.06, the filterFB rule was back to front, which\n-- made this program hit the \"error foo\" case instead of\n-- working fine.\n\n\nmodule Main where\n\nmain :: IO ()\nmain = print (length (filter (not . foo)\n                             (filter (const False) [Nothing])))\n  where foo (Just x) = x\n        foo _        = error \"foo\"\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- !!! A rules test\n-- At one time the rule got too specialised a type:\n--\n--  _R \"ffoo\" forall {@ a1 v :: (a1, ((), ()))}\n--            fst @ a1 @ () (sndSnd @ a1 @ () @ () v) = fst @ a1 @ ((), ()) v\n\n\nmodule Main where\n\nimport System.IO\nimport System.IO.Unsafe ( unsafePerformIO )\n\n{-# NOINLINE [0] sndSnd #-}\n-- Don't inline till last, to give the rule a chance\nsndSnd (a,(b,c)) = (a,c)\n\n{-# NOINLINE [2] myFst #-}\n-- Don't inline till last, to give the rule a chance\nmyFst (a,b) = a\n\ntrace x y = unsafePerformIO (hPutStr stderr x >> hPutStr stderr \"\\n\" >> return y)\n\n{-# RULES \"foo\" forall v .  myFst (sndSnd v) = trace \"Yes\" (fst v) #-}\n\nmain :: IO ()\nmain = print (myFst (sndSnd (True, (False,True))))\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\n-- O2 to get CSE\n\nmodule Main where\n\nf :: Int -> (# Int, Int #)\nf 0 = (# 1,2 #)\nf n = f (n-1)\n\n{-# NOINLINE g #-}\ng x = case f x of\n        (# a,b #) -> if a>0\n                     then f x   -- CSE opportunity\n                     else (# b,a #)\n\n-- GHC 6.2 wrongly optimised g to:\n--      case f x of t\n--        (# a,b #) -> if a>0 then\n--                        t     -- WRONG\n--                      else (# b,a #)\n\nmain = case g 2 of (# a,b #) -> print a\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- A test for loss of sharing.  GHC 6.4.1 did a bogus preInlineUnconditionally\n\nimport Control.Monad ( guard )\n\nexpensive 0 = True\nexpensive 1 = False\nexpensive n = expensive (n-2)\n\nf g = if expensive (1000000*(fst g)) then odd else even\n\n---------------------------------------------------------\n-- The key point is that the (c g) call should not get pushed inside the \\x,\n-- as happened in 6.4.1.  Doing so loses laziness, and this test shows up \n-- the difference in performance\ngen_sucW grow c g \n  = \\ x -> grow g x >>= \\ y -> do guard $ check y; return y\n  where \n    check = c g\n\nsucW = gen_sucW (\\ g x -> map (+x) [fst g..snd g]) f (11,500000)\n\nmain = print (sum $ sucW 11,sum $ sucW 12)\n\n-- Because this version uses a case expression, the bug \n-- doesn't happen and execution is much faster\ngen_sucC grow c g = case c g of \n           check -> \\ x -> grow g x >>= \\ y -> do guard $ check y; return y\n\nsucC = gen_sucC (\\ g x -> map (+x) [fst g..snd g]) f (11,500000)\n\nmainC = print (sum $ sucC 11,sum $ sucC 12)\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain = print (fib' 100)\n        -- This will time out unless memoing works properly\n\ndata Nat = Z | S Nat\n           deriving (Show, Eq)\n\nmemo f = g\n  where\n    fz = f Z\n    fs = memo (f . S)\n    g  Z    = fz\n    g (S n) = fs n\n        -- It is a BAD BUG to inline 'fs' inside g\n        -- and that happened in 6.4.1, resulting in exponential behaviour\n\n-- memo f = g (f Z) (memo (f . S))\n--        = g (f Z) (g (f (S Z)) (memo (f . S . S)))\n--        = g (f Z) (g (f (S Z)) (g (f (S (S Z))) (memo (f . S . S . S))))\n\nfib' :: Nat -> Integer\nfib'             =  memo fib\n  where\n  fib Z          =  0\n  fib (S Z)      =  1\n  fib (S (S n))  =  fib' (S n) + fib' n\n\ninstance Num Nat where\n  fromInteger 0        =  Z\n  fromInteger n        =  S (fromInteger (n - 1))\n  Z + n                =  n\n  S m + n              =  S (m + n)\n  Z * n                =  Z\n  S m * n              =  (m * n) + n\n  Z - n                =  Z\n  S m - Z              =  S m\n  S m - S n            =  m - n\n\ninstance Enum Nat where\n  succ                 =  S\n  pred Z               =  Z\n  pred (S n)           =  n\n  toEnum               =  fromInteger . toInteger\n  fromEnum Z           =  0\n  fromEnum (S n)       =  fromEnum n + 1\n\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- Actually, this exercises prelude/PrelRules, but this is the closest\n-- place I could find to put it...\n\nimport GHC.Exts\nimport Numeric\nimport Data.Bits\n\nmain = do phex (I# (uncheckedIShiftL#  (negateInt# 5#) 2#))\n          phex (I# (uncheckedIShiftRA# (negateInt# 5#) 1#))\n          phex (I# (uncheckedIShiftRL# (negateInt# 5#) 1#))\n          phex (W# (uncheckedShiftL#   (int2Word# (negateInt# 5#)) 2#))\n          phex (W# (uncheckedShiftRL#  (int2Word# (negateInt# 5#)) 1#))\n\nphex x = putStrLn (showSigned (\\x -> (\"0x\"++) . showHex x) 0 x \"\")\n\n{- Too wordsize-dependent\nphex x = putStrLn (hex x)\nhex x = \"0x\" ++ [onedigit (fromIntegral ((x `shiftR` (i*4)) .&. 0xF))\n                 | i <- [digits-1,digits-2..0]]\n    where\n    digits = bitSize x `div` 4\n    onedigit n = \"0123456789abcdef\" !! n\n-}\n\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\nimport Data.Char\n\n{-# NOINLINE f #-}\nf :: Int -> String\nf x = \"NOT FIRED\"\n\n{-# NOINLINE neg #-}\nneg :: Int -> Int\nneg = negate\n\n{-# NOINLINE myord #-}\nmyord :: Char -> Int\nmyord = ord\n\n{-# RULES\n     \"f\" forall (c::Char->Int) (x::Char). f (c x) = \"RULE FIRED\"\n #-}\n\nmain = do { print (f (myord 'a'))       -- Rule should fire\n          ; print (f (neg 1)) }         -- Rule should not fire\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- This test is really meant for human looking; do a -ddump-simpl.\n\n-- The definition that you want to look at is for foo.\n-- It produces a nested unfold that should look something\n-- like the code below.  Note the 'lvl1_shW'.  It is BAD\n-- if this is a lambda instead; you get a lot more allocation\n-- See Note [Escaping a value lambda] in SetLevels\n\n\n{-\n      $wunfold_shU =\n        \\ (ww_she :: [[a_abm]]) (ww1_shf :: Data.Maybe.Maybe (Stream.Stream a_abm)) ->\n          case ww1_shf of wild2_afo {\n            Data.Maybe.Nothing ->\n              case ww_she of wild_ad6 {\n                [] -> GHC.Base.[] @ a_abm;\n                : x_ado xs1_adp ->\n                  $wunfold_shU\n                    xs1_adp\n                    (Data.Maybe.Just\n                       @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ [a_abm]\n                                                                *** lvl1_shW ***\n                                                                x_ado))\n              };\n            Data.Maybe.Just ds3_afJ ->\n              case ds3_afJ of wild3_afL { Stream.Stream @ s1_afN stepb_afO sb_afP ->\n              case stepb_afO sb_afP of wild4_afR {\n                Stream.Done -> $wunfold_shU ww_she (Data.Maybe.Nothing @ (Stream.Stream a_abm));\n                Stream.Yield x_afV sb'_afW ->\n                  GHC.Base.:\n                    @ a_abm\n                    x_afV\n                    ($wunfold_shU\n                       ww_she\n                       (Data.Maybe.Just\n                          @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ s1_afN stepb_afO sb'_afW)));\n                Stream.Skip sb'_afZ ->\n                  $wunfold_shU\n                    ww_she\n                    (Data.Maybe.Just\n                       @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ s1_afN stepb_afO sb'_afZ))\n              }\n              }\n-}\n\n\n\nmodule Main( main, foo ) where\n-- Must export foo to make the issue show up\n\nimport Prelude hiding ( concatMap, map)\n\nmain = print (sum (foo [[1,2], [3,4,5]]))\n\nfoo :: Num a => [[a]] -> [a]\nfoo xss = Main.concatMap (\\xs -> Main.map (+1) xs) xss\n\n\ninstance StreamableSequence [] where\n  stream = listToStream\n  unstream = streamToList\n  -- These inline pragmas are useless (see #5084)\n{-\n  {-# INLINE stream #-}\n  {-# INLINE unstream #-}\n-}\n\nlistToStream :: [a] -> Stream a\nlistToStream xs = Stream next xs\n  where next []     = Done\n        next (x:xs) = Yield x xs\n{-# INLINE [0] listToStream #-}\n\nstreamToList :: Stream a -> [a]\nstreamToList (Stream next s) = unfold s\n  where unfold s =\n          case next s of\n            Done       -> []\n            Skip    s' ->     unfold s'\n            Yield x s' -> x : unfold s'\n{-# INLINE [0] streamToList #-}\n\n{-# RULES\n\"stream/unstream\"\n  forall s. listToStream (streamToList s) = s\n  #-}\n\nmap :: (a -> b) -> [a] -> [b]\nmap f = unstream . mapS f . stream\n{-# INLINE map #-}\n\nconcatMap :: (a -> [b]) -> [a] -> [b]\nconcatMap f = unstream . concatMapS (stream . f) . stream\n{-# INLINE concatMap #-}\n\n\ndata Stream a = forall s. Stream (s -> Step a s) s\n\ndata Step a s = Done\n              | Yield a s\n              | Skip    s\n\nclass StreamableSequence seq where\n  stream   :: seq a -> Stream a\n  unstream :: Stream a -> seq a\n\n  -- axiom: stream . unstream = id\n  -- These inline pragmas are useless (see #5084)\n{-\n  {-# INLINE stream #-}\n  {-# INLINE unstream #-}\n-}\n\n{-\n--version that does not require the sequence type\n--to be polymorphic in its elements:\n\nclass StreamableSequence seq a | seq -> a where\n  stream   :: seq -> Stream a\n  unstream :: Stream a -> seq\n-}\n\n\nmapS :: (a -> b) -> Stream a -> Stream b\nmapS f (Stream next s0) = Stream next' s0\n  where next' s = case next s of\n          Done       -> Done\n          Skip    s' -> Skip        s'\n          Yield x s' -> Yield (f x) s'\n{-# INLINE [0] mapS #-}\n\n\nconcatMapS :: (a -> Stream b) -> Stream a -> Stream b\nconcatMapS f (Stream step s) = Stream step' (s, Nothing)\n  where step' (s, Nothing) =\n          case step s of\n            Yield x s' -> Skip (s', Just (f x))\n            Skip    s' -> Skip (s', Nothing)\n            Done       -> Done\n\n        step' (s, Just (Stream stepb sb)) =\n          case stepb sb of\n            Yield x sb' -> Yield x (s, Just (Stream stepb sb'))\n            Skip    sb' -> Skip (s, Just (Stream stepb sb'))\n            Done        -> Skip (s, Nothing)\n{-# INLINE [0] concatMapS #-}\n\n", "num_lines": 150}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, MagicHash, UnboxedTuples #-}\n\n-- From trac #1947\n-- Should fail with heap exhaustion\n-- See notes below with \"Infinite loop here\".\n\nmodule Main(main) where\n\nimport System.IO.Unsafe\nimport System.IO\nimport System.Environment\nimport System.Exit\nimport Foreign.C.Types\nimport Data.Char(ord,chr)\n\n\n-- low level imports\nimport GHC.Base                 (realWorld#)\nimport GHC.IO                   (IO(IO), unIO, unsafePerformIO)\nimport GHC.Prim                 (State#,RealWorld)\n\n\n-- FFI replacements for Haskell stuff\nforeign import ccall unsafe \"stdio.h getchar\" getchar :: IO CInt\nforeign import ccall unsafe \"ctype.h iswspace\" isspace :: CInt -> CInt\n\n\nskipCAF :: State# RealWorld -> a -> a\nskipCAF _ x = x\n\n\n-- IO Subsystem\n-- Unboxed IO is more efficient, but requires a certain level of\n-- optimisation, so provide a BOXED_IO fallback\n\ndata RW_Box = RW_Box (State# RealWorld)\ntype RW_Pair a = (RW_Box, a)\n\nfromIO :: IO a -> (RW_Box -> RW_Pair a)\nfromIO a (RW_Box r) = case unIO a r of (# r, x #) -> (RW_Box r, x)\n\ntoIO :: (RW_Box -> RW_Pair a) -> IO a\ntoIO f = IO $ \\r -> case f (RW_Box r) of (RW_Box r, x) -> (# r, x #)\n\n-- IO functions not dependent on the IO primitives\nmain :: IO ()\nmain = toIO main_generated\n\ntypeRealWorld :: RW_Box -> RW_Box\ntypeRealWorld x = x\n\noverlay_get_char :: RW_Box -> RW_Pair Int\noverlay_get_char = fromIO $ do\n    c <- getchar\n    return $ fromIntegral c\n\nsystem_IO_hPutChar :: Handle -> Int -> RW_Box -> RW_Pair ()\nsystem_IO_hPutChar h c = fromIO $ hPutChar h (chr c)\n\noverlay_errorIO :: [Int] -> RW_Box -> RW_Pair a\noverlay_errorIO x r = case fromIO (putStrLn (\"ERROR: \" ++ map chr x)) r of\n                           (r, _) -> fromIO exitFailure r\n\nsystem_Environment_getArgs :: RW_Box -> RW_Pair [[Int]]\nsystem_Environment_getArgs r = case (fromIO getArgs) r of\n                                    (r, s) -> (r, map str_ s)\n\noverlay_supero_wrap x = x\n\n\n-- Primitives\nprelude_seq = seq\n\nprelude_error x = error (map chr x)\n\naDD_W = (+) :: Int -> Int -> Int\nmUL_W = (*) :: Int -> Int -> Int\nsUB_W = (-) :: Int -> Int -> Int\neQ_W = (==) :: Int -> Int -> Bool\nnE_W = (/=) :: Int -> Int -> Bool\ngT_W = (>) :: Int -> Int -> Bool\ngE_W = (>=) :: Int -> Int -> Bool\nlT_W = (<) :: Int -> Int -> Bool\nlE_W = (<=) :: Int -> Int -> Bool\nqUOT = quot :: Int -> Int -> Int\nrEM = rem :: Int -> Int -> Int\nnEG_W = negate :: Int -> Int\nyHC_Primitive_primIntAbs = abs :: Int -> Int\nyHC_Primitive_primIntSignum = signum :: Int -> Int\nyHC_Primitive_primIntegerAdd = (+) :: Integer -> Integer -> Integer\nyHC_Primitive_primIntegerEq = (==) :: Integer -> Integer -> Bool\nyHC_Primitive_primIntegerFromInt = toInteger :: Int -> Integer\nyHC_Primitive_primIntegerGe = (>=) :: Integer -> Integer -> Bool\nyHC_Primitive_primIntegerGt = (>) :: Integer -> Integer -> Bool\nyHC_Primitive_primIntegerLe = (<=) :: Integer -> Integer -> Bool\nyHC_Primitive_primIntegerMul = (*) :: Integer -> Integer -> Integer\nyHC_Primitive_primIntegerNe = (/=) :: Integer -> Integer -> Bool\nyHC_Primitive_primIntegerNeg = negate :: Integer -> Integer\nyHC_Primitive_primIntegerQuot = quot :: Integer -> Integer -> Integer\nyHC_Primitive_primIntegerQuotRem = quotRem :: Integer -> Integer -> (Integer, Integer)\nyHC_Primitive_primIntegerRem = rem :: Integer -> Integer -> Integer\nyHC_Primitive_primIntFromInteger = fromInteger :: Integer -> Int\nyHC_Primitive_primIntegerLt = (<) :: Integer -> Integer -> Bool\nyHC_Primitive_primIntegerSub = (-) :: Integer -> Integer -> Integer\n\naDD_D = (+) :: Double -> Double -> Double\nsUB_D = (-) :: Double -> Double -> Double\nlT_D = (<) :: Double -> Double -> Bool\nlE_D = (<=) :: Double -> Double -> Bool\ngT_D = (>) :: Double -> Double -> Bool\ngE_D = (>=) :: Double -> Double -> Bool\neQ_D = (==) :: Double -> Double -> Bool\nmUL_D = (*) :: Double -> Double -> Double\nnEG_D = (negate) :: Double -> Double\nnE_D = (/=) :: Double -> Double -> Bool\nsLASH_D = (/) :: Double -> Double -> Double\nyHC_Primitive_primDecodeDouble = decodeFloat :: Double -> (Integer,Int)\nyHC_Primitive_primDoubleACos = acos :: Double -> Double\nyHC_Primitive_primDoubleASin = asin :: Double -> Double\nyHC_Primitive_primDoubleATan = atan :: Double -> Double\nyHC_Primitive_primDoubleAbs = abs :: Double -> Double\nyHC_Primitive_primDoubleCos = cos :: Double -> Double\nyHC_Primitive_primDoubleExp = exp :: Double -> Double\nyHC_Primitive_primDoubleFromInteger = fromInteger :: Integer -> Double\nyHC_Primitive_primDoubleLog = log :: Double -> Double\nyHC_Primitive_primDoublePow = (**) :: Double -> Double -> Double\nyHC_Primitive_primDoubleSignum = signum :: Double -> Double\nyHC_Primitive_primDoubleSin = sin :: Double -> Double\nyHC_Primitive_primDoubleSqrt = sqrt :: Double -> Double\nyHC_Primitive_primDoubleTan = tan :: Double -> Double\nyHC_Primitive_primEncodeDouble = encodeFloat :: Integer -> Int -> Double\n\n\n\n\n-- things which Yhc decides should be hopelessly slow\nprelude_Int_Integral_mod = mod :: Int -> Int -> Int\nprelude_Integer_Integral_div = div :: Integer -> Integer -> Integer\nprelude_Integer_Integral_mod = mod :: Integer -> Integer -> Integer\nprelude_Integer_Num_signum = signum :: Integer -> Integer\nprelude_Integer_Num_abs = abs :: Integer -> Integer\n\n\nint_ x = x :: Int\nchr_ x = ord x\nstr_ x = map chr_ x\n\n\nsystem_IO_stdin = stdin\nsystem_IO_stdout = stdout\n\ndata_Char_isSpace :: Int -> Bool\ndata_Char_isSpace c = isspace (toEnum c) /= 0\n\n\n\ntype ReadsPrec a = Int -> [Int] -> [(a,[Int])]\n\n\nprelude_Int_Read_readsPrec :: ReadsPrec Int\nprelude_Int_Read_readsPrec p s = [(a, str_ b) | (a,b) <- readsPrec p (map chr s)]\nprelude_Int_Read_readList = undefined\n\nprelude_Integer_Read_readsPrec :: ReadsPrec Integer\nprelude_Integer_Read_readsPrec p s = [(a, str_ b) | (a,b) <- readsPrec p (map chr s)]\nprelude_Integer_Read_readList = undefined\n\nprelude_Double_Read_readsPrec :: ReadsPrec Double\nprelude_Double_Read_readsPrec p s = [(a, str_ b) | (a,b) <- readsPrec p (map chr s)]\nprelude_Double_Read_readList = undefined\n\nprelude_Char_Read_readsPrec :: ReadsPrec Int\nprelude_Char_Read_readsPrec p s = [(chr_ (a :: Char), str_ b) | (a,b) <- readsPrec p (map chr s)]\n\nprelude_Char_Show_showList :: [Int] -> [Int] -> [Int]\nprelude_Char_Show_showList value rest = str_ (show (map chr value)) ++ rest\n\nprelude_Char_Show_showsPrec :: Int -> Int -> [Int] -> [Int]\nprelude_Char_Show_showsPrec prec i rest = str_ (showsPrec prec (chr i) []) ++ rest\n\nprelude_Int_Show_showsPrec :: Int -> Int -> [Int] -> [Int]\nprelude_Int_Show_showsPrec prec i rest = str_ (showsPrec prec i []) ++ rest\n\nprelude_Integer_Show_showsPrec :: Int -> Integer -> [Int] -> [Int]\nprelude_Integer_Show_showsPrec prec i rest = str_ (showsPrec prec i []) ++ rest\n\nprelude_Double_Show_showsPrec :: Int -> Double -> [Int] -> [Int]\nprelude_Double_Show_showsPrec prec i rest = str_ (showsPrec prec i []) ++ rest\n\n\nprelude_'amp'amp27 v1 v2 =\n    case (data_Char_isSpace v1) of\n        True ->\n            case v2 of\n                [] -> True\n                (:) v4 v5 -> prelude_'amp'amp27 v4 v5\n        False -> False\n\nprelude_LAMBDA22 v1 v2 =\n    case v1 of\n        (,) v267 v268 ->\n            case v268 of\n                [] -> prelude_LAMBDA24 v267 v2\n                (:) v7 v8 ->\n                    let v11 = prelude_'amp'amp27 v7 v8\n                    in case v11 of\n                           True -> prelude_LAMBDA24 v267 v2\n                           False -> prelude__foldr25 v2\n\nprelude_LAMBDA24 v1 v2 = (:) v1 (prelude__foldr25 v2)\n\nprelude_IO_Monad_fail41 v1 =\n    overlay_errorIO\n      (skipCAF realWorld# (str_ \"pattern-match failure in do expression\"))\n      v1\n\nprelude__foldr25 v1 =\n    case v1 of\n        [] -> []\n        (:) v296 v297 -> prelude_LAMBDA22 v296 v297\n\nf17 uncaf = skipCAF uncaf (str_ \"Prelude.read: no parse\")\n\nf18 v1 v2 =\n    case v1 of\n        (,) v176 v177 ->\n            case v177 of\n                [] -> f20 v176 v2\n                (:) v7 v8 ->\n                    let v11 = prelude_'amp'amp27 v7 v8\n                    in case v11 of\n                           True -> f20 v176 v2\n                           False ->\n                               case v2 of\n                                   [] -> prelude_error (f17 realWorld#)\n                                   (:) v4 v5 -> f18 v4 v5\n\nf20 v1 v2 =\n    case v2 of\n        [] -> v1\n        (:) v257 v258 ->\n            let v9 = prelude_LAMBDA22 v257 v258\n            in case v9 of\n                   [] -> v1\n                   (:) v10 v11 ->\n                       prelude_error\n                         (skipCAF realWorld# (str_ \"Prelude.read: ambiguous parse\"))\n\n-- Infinite loop here.  It was originally:\n-- f34 v1 v2 v3 =\n--    let v336 = f34 v1 v2 v3\n--    in v336\n--\n-- But that now (correctly) just makes a non-allocating infinite loop\n-- instead of (incorrectly) eta-reducing to f34 = f34.\n-- So I've changed to an infinite, allocating loop, which makes\n-- the heap get exhausted.\nf34 v1 v2 v3 =\n  if abs v2 < 1000 then \n    let v336 = f34 (v1+1) (-v2) v3\n    in v336\n  else if v2 == 2000 then 0 else v1\n\nf38 v1 v2 =\n    case v1 of\n        [] -> system_IO_hPutChar system_IO_stdout (chr_ '\\n') v2\n        (:) v350 v351 ->\n            case (system_IO_hPutChar\n                    system_IO_stdout\n                    v350\n                    (typeRealWorld v2)) of\n                ( v7  , v8  ) -> f38 v351 v7\n\nmain_generated v1 =\n    case (system_Environment_getArgs (typeRealWorld v1)) of\n        ( v3  , v4  ) ->\n            case v4 of\n                (:) v7 v8 ->\n                    case v8 of\n                        (:) v9 v12 ->\n                            case v12 of\n                                (:) v13 v14 ->\n                                    case v14 of\n                                        [] ->\n                                            case (prelude_Int_Show_showsPrec\n                                                    (int_ 0)\n                                                    (let v8 =\n                                                             case (prelude_Int_Read_readsPrec\n                                                                     (int_ 0)\n                                                                     v7) of\n                                                                 [] -> prelude_error (f17 realWorld#)\n                                                                 (:) v12 v14 -> f18 v12 v14\n                                                         v10 =\n                                                             case (prelude_Int_Read_readsPrec\n                                                                     (int_ 0)\n                                                                     v9) of\n                                                                 [] -> prelude_error (f17 realWorld#)\n                                                                 (:) v15 v16 -> f18 v15 v16\n                                                         v11 =\n                                                             case (prelude_Int_Read_readsPrec\n                                                                     (int_ 0)\n                                                                     v13) of\n                                                                 [] -> prelude_error (f17 realWorld#)\n                                                                 (:) v17 v18 -> f18 v17 v18\n                                                     in case (lT_W v10 v8) of\n                                                            True ->\n                                                                let v7 = f34 v8 v10 v11\n                                                                in v7\n                                                            False -> v11)\n                                                    (skipCAF realWorld# (str_ \"\"))) of\n                                                [] ->\n                                                    system_IO_hPutChar\n                                                      system_IO_stdout\n                                                      (chr_ '\\n')\n                                                      (typeRealWorld v3)\n                                                (:) v11 v12 ->\n                                                    case (system_IO_hPutChar\n                                                            system_IO_stdout\n                                                            v11\n                                                            (typeRealWorld (typeRealWorld v3))) of\n                                                        ( v7  , v8  ) -> f38 v12 v7\n                                        (:) v15 v16 -> prelude_IO_Monad_fail41 v3\n                                [] -> prelude_IO_Monad_fail41 v3\n                        [] -> prelude_IO_Monad_fail41 v3\n                [] -> prelude_IO_Monad_fail41 v3\n\n", "num_lines": 327}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Exts\n\n-- This checks that rules look through unfoldings when matching\n-- lambdas, but only in the right phase\n\nfoo :: (Int -> IO ()) -> IO ()\nfoo f = putStr \"not fired: \" >> f 0\n{-# NOINLINE foo #-}\n\nf1 :: Int -> IO ()\nf1 _ = putStrLn \"f1\"\n{-# NOINLINE[0] f1 #-}\n\nf2 :: Int -> IO ()\nf2 _ = putStrLn \"f2\"\n{-# NOINLINE f2 #-}\n\nnewtype Age = MkAge Int\n\n-- It also checks that this can look through casted lambdas\n\nf3 :: Age -> IO ()\nf3 _ = putStrLn \"f3\"\n{-# NOINLINE[0] f3 #-}\n\n\n{-# RULES \"foo\" [0] forall g . foo (\\x -> g) = putStr \"fired: \" >> g #-}\n\nmain = do\n    foo f1\n    foo f1\n    foo f2\n    foo f2\n    foo (coerce f3)\n    foo (coerce f3)\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import GHC.OldList\nmain :: IO ()\nmain = maximumBy compare [1..10000] `seq` return ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}\nmodule Main where\n\ndata JSONState = JSONState [()] () () deriving Show\n\nweta_s6yD :: Either a (b, c) -> (# (Either a b, JSONState) #)\nweta_s6yD ww_s6ys = case ww_s6ys of\n    Left l -> (# (Left l, JSONState [] () ()) #)\n    Right (x, _) -> (# (Right x, JSONState [] () ()) #)\n\neta_B1 :: (Either a (b, c), t) -> Either a1 (Either a b, JSONState)\neta_B1 (ww_s6ys, _) = case weta_s6yD ww_s6ys of\n    (# ww_s6zb #) -> Right ww_s6zb\n\nwks_s6yS :: Either a b -> (# (Either a b, JSONState) #)\nwks_s6yS ww_s6yH =\n    case case ww_s6yH of\n        Left l_a4ay -> eta_B1 (Left l_a4ay, ())\n        Right r_a4aB -> eta_B1 (Right (r_a4aB, ()), ())\n    of\n        Right ww_s6ze -> (# ww_s6ze #)\n\nks_a49u :: (Either a b, t) -> Either a1 (Either a b, JSONState)\nks_a49u (ww_s6yH, _) = case wks_s6yS ww_s6yH of\n    (# ww_s6ze #) -> Right ww_s6ze\n\nwks_s6z7 :: Either a b -> (# (Either a b, JSONState) #)\nwks_s6z7 ww_s6yW = case (\n    case ww_s6yW of\n        Left _ -> ks_a49u (ww_s6yW, JSONState [()] () ())\n        Right _ -> ks_a49u (ww_s6yW, JSONState [] () ())\n    ) of\n        Right ww_s6zh -> (# ww_s6zh #)\n\nks_X3Sb :: Either () Int -> Either String (Either () Int, JSONState)\nks_X3Sb ww_s6yW = case wks_s6z7 ww_s6yW of\n    (# ww_s6zh #) -> Right ww_s6zh\n\nmain :: IO ()\nmain = print $ ks_X3Sb (Left ())\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main ) where\n\nimport Debug.Trace\n\nfoo :: (a,b) -> a\nfoo (x,y) = x\n{-# NOINLINE foo #-}\n\nwwMe :: Int -> (Int,Int) -> (Int, Int)\nwwMe 0 p =\n    let a = fst p\n        b = snd p\n        -- This ensures sharing of b, as seen by the demand analyzer\n\n    in foo p `seq`\n       -- This ensures that wwMe is strict in the tuple, but that the tuple\n       -- is preserved.\n       (b + a, a + b)\n\nwwMe n p = wwMe (n-1) (0,0)\n    -- ^ Make it recursive, so that it is attractive to worker-wrapper\n\ngo :: Int -> IO ()\ngo seed = do\n    let shareMeThunk = trace \"Evaluated (should only happen once)\" (seed + 1)\n        {-# NOINLINE shareMeThunk #-}\n        -- ^ This is the thunk that is wrongly evaluated twice.\n\n    let (x,y) = wwMe 0 (seed,shareMeThunk)\n\n    (x + y) `seq` return ()\n    -- ^ Use both components\n{-# NOINLINE go #-}\n\nmain :: IO ()\nmain = go 42\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data T1 = MkT1Bad                     | MkT1Good                     deriving Show\ndata T2 = MkT2Bad Int                 | MkT2Good Int                 deriving Show\ndata T3 = MkT3Bad {-# UNPACK #-} !Int | MkT3Good {-# UNPACK #-} !Int deriving Show\ndata T4 = MkT4Bad Int                 | MkT4Good Int                 deriving Show\ndata T5 = MkT5Bad {-# UNPACK #-} !Int | MkT5Good {-# UNPACK #-} !Int deriving Show\n\n{-# RULES\n\n\"T1\"           app MkT1Bad     = MkT1Good\n\"T2\" forall x. app (MkT2Bad x) = MkT2Good x\n\"T3\" forall x. app (MkT3Bad x) = MkT3Good x\n\"T4\"           app MkT4Bad     = MkT4Good\n\"T5\"           app MkT5Bad     = MkT5Good\n  #-}\n\napp = id\n{-# NOINLINE app #-}\n\nmain = do\n  print (app MkT1Bad)\n  print (app (MkT2Bad 42))\n  print (app (MkT3Bad 42))\n  print (app MkT4Bad 42)\n  print (app MkT5Bad 42)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "data T6 = MkT6Bad {-# UNPACK #-} !Int | MkT6Good {-# UNPACK #-} !Int deriving Show\n\n{-# RULES\n\n\"T6\" [1] forall x. MkT6Bad x = MkT6Good x\n  #-}\n\nmain = do\n  print (MkT6Bad 42) -- late rule\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nf :: Word -> Bool\nf n = case n+1 of\n       0 -> True\n       _ -> False\n{-# NOINLINE f #-}\n\nmain = do\n   putStrLn \"Word: wrap (0-1)\"\n   print (f (-1))\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Debug.Trace\n\ng x expensive ys = let h = \\y -> y + expensive x\n                   in map h ys\n{-# NOINLINE g #-}\n\nfoo x = trace \"Evaluate me only once!\" x\n\nmain = sum (g 1 foo [1,2,3]) `seq` return ()\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule Main (main) where\n\nimport T13429a\n\nimport Data.Foldable (Foldable(..))\nimport Data.Monoid (Monoid(..))\n\nmain :: IO ()\nmain = print $ prop_mappend z z\n  where\n    z :: Seq Integer\n    z = deep (Four 1 2 3 4) Empty (Four 1 2 3 4)\n\ninfix 4 ~=\n\n(~=) :: Eq a => Maybe a -> a -> Bool\n(~=) = maybe (const False) (==)\n\n-- Partial conversion of an output sequence to a list.\ntoList' :: (Eq a, Measured [a] a, Valid a) => Seq a -> Maybe [a]\ntoList' xs\n  | valid xs = Just (toList xs)\n  | otherwise = Nothing\n\nprop_mappend :: Seq Integer -> Seq Integer -> Bool\nprop_mappend xs ys =\n    toList' (mappend xs ys) ~= toList xs ++ toList ys\n\n------------------------------------------------------------------------\n-- Valid trees\n------------------------------------------------------------------------\n\nclass Valid a where\n    valid :: a -> Bool\n\ninstance (Measured v a, Eq v, Valid a) => Valid (FingerTree v a) where\n    valid Empty = True\n    valid (Single x) = valid x\n    valid (Deep s pr m sf) =\n        s == measure pr `mappend` measure m `mappend` measure sf &&\n        valid pr && valid m && valid sf\n\ninstance (Measured v a, Eq v, Valid a) => Valid (Node v a) where\n    valid node = measure node == foldMap measure node && all valid node\n\ninstance Valid a => Valid (Digit a) where\n    valid = all valid\n\ninstance Valid Integer where\n    valid = const True\n\n------------------------------------------------------------------------\n-- Use list of elements as the measure\n------------------------------------------------------------------------\n\ntype Seq a = FingerTree [a] a\n\ninstance Measured [Integer] Integer where\n    measure x = [x]\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T13429a where -- Originally FingerTree.hs from the ticket\n\nimport Data.Semigroup (Semigroup(..))\n\nclass (Monoid v) => Measured v a | a -> v where\n    measure :: a -> v\n\ninstance (Measured v a) => Measured v (Digit a) where\n    measure = foldMap measure\n\ninstance (Monoid v) => Measured v (Node v a) where\n    measure (Node2 v _ _)    =  v\n    measure (Node3 v _ _ _)  =  v\n\ninstance (Measured v a) => Measured v (FingerTree v a) where\n    measure Empty           =  mempty\n    measure (Single x)      =  measure x\n    measure (Deep v _ _ _)  =  v\n\ndata FingerTree v a\n    = Empty\n    | Single a\n    | Deep !v !(Digit a) (FingerTree v (Node v a)) !(Digit a)\n  deriving Show\n\ninstance Foldable (FingerTree v) where\n    foldMap _ Empty = mempty\n    foldMap f (Single x) = f x\n    foldMap f (Deep _ pr m sf) =\n        foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf\n\ninstance Measured v a => Semigroup (FingerTree v a) where\n    (<>) = (><)\n\ninstance Measured v a => Monoid (FingerTree v a) where\n    mempty = empty\n\nempty :: Measured v a => FingerTree v a\nempty = Empty\n\ninfixr 5 ><\ninfixr 5 <|\ninfixl 5 |>\n\n(<|) :: (Measured v a) => a -> FingerTree v a -> FingerTree v a\na <| Empty              =  Single a\na <| Single b           =  deep (One a) Empty (One b)\na <| Deep v (Four b c d e) m sf = m `seq`\n    Deep (measure a `mappend` v) (Two a b) (node3 c d e <| m) sf\na <| Deep v pr m sf     =\n    Deep (measure a `mappend` v) (consDigit a pr) m sf\n\nconsDigit :: a -> Digit a -> Digit a\nconsDigit a (One b) = Two a b\nconsDigit a (Two b c) = Three a b c\nconsDigit a (Three b c d) = Four a b c d\nconsDigit _ (Four _ _ _ _) = illegal_argument \"consDigit\"\n\n(|>) :: (Measured v a) => FingerTree v a -> a -> FingerTree v a\nEmpty |> a              =  Single a\nSingle a |> b           =  deep (One a) Empty (One b)\nDeep v pr m (Four a b c d) |> e = m `seq`\n    Deep (v `mappend` measure e) pr (m |> node3 a b c) (Two d e)\nDeep v pr m sf |> x     =\n    Deep (v `mappend` measure x) pr m (snocDigit sf x)\n\nsnocDigit :: Digit a -> a -> Digit a\nsnocDigit (One a) b = Two a b\nsnocDigit (Two a b) c = Three a b c\nsnocDigit (Three a b c) d = Four a b c d\nsnocDigit (Four _ _ _ _) _ = illegal_argument \"snocDigit\"\n\n(><) :: (Measured v a) => FingerTree v a -> FingerTree v a -> FingerTree v a\n(><) =  appendTree0\n\nappendTree0 :: (Measured v a) => FingerTree v a -> FingerTree v a -> FingerTree v a\nappendTree0 Empty xs =\n    xs\nappendTree0 xs Empty =\n    xs\nappendTree0 (Single x) xs =\n    x <| xs\nappendTree0 xs (Single x) =\n    xs |> x\nappendTree0 (Deep _ pr1 m1 sf1) (Deep _ pr2 m2 sf2) =\n    deep pr1 (addDigits0 m1 sf1 pr2 m2) sf2\n\naddDigits0 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)\naddDigits0 m1 (One a) (One b) m2 =\n    appendTree1 m1 (node2 a b) m2\naddDigits0 m1 (One a) (Two b c) m2 =\n    appendTree1 m1 (node3 a b c) m2\naddDigits0 m1 (One a) (Three b c d) m2 =\n    appendTree2 m1 (node2 a b) (node2 c d) m2\naddDigits0 m1 (One a) (Four b c d e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits0 m1 (Two a b) (One c) m2 =\n    appendTree1 m1 (node3 a b c) m2\naddDigits0 m1 (Two a b) (Two c d) m2 =\n    appendTree2 m1 (node2 a b) (node2 c d) m2\naddDigits0 m1 (Two a b) (Three c d e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits0 m1 (Two a b) (Four c d e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits0 m1 (Three a b c) (One d) m2 =\n    appendTree2 m1 (node2 a b) (node2 c d) m2\naddDigits0 m1 (Three a b c) (Two d e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits0 m1 (Three a b c) (Three d e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits0 m1 (Three a b c) (Four d e f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits0 m1 (Four a b c d) (One e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits0 m1 (Four a b c d) (Two e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits0 m1 (Four a b c d) (Three e f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits0 m1 (Four a b c d) (Four e f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\n\nappendTree1 :: (Measured v a) => FingerTree v a -> a -> FingerTree v a -> FingerTree v a\nappendTree1 Empty a xs =\n    a <| xs\nappendTree1 xs a Empty =\n    xs |> a\nappendTree1 (Single x) a xs =\n    x <| a <| xs\nappendTree1 xs a (Single x) =\n    xs |> a |> x\nappendTree1 (Deep _ pr1 m1 sf1) a (Deep _ pr2 m2 sf2) =\n    deep pr1 (addDigits1 m1 sf1 a pr2 m2) sf2\n\naddDigits1 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)\naddDigits1 m1 (One a) b (One c) m2 =\n    appendTree1 m1 (node3 a b c) m2\naddDigits1 m1 (One a) b (Two c d) m2 =\n    appendTree2 m1 (node2 a b) (node2 c d) m2\naddDigits1 m1 (One a) b (Three c d e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits1 m1 (One a) b (Four c d e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits1 m1 (Two a b) c (One d) m2 =\n    appendTree2 m1 (node2 a b) (node2 c d) m2\naddDigits1 m1 (Two a b) c (Two d e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits1 m1 (Two a b) c (Three d e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits1 m1 (Two a b) c (Four d e f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits1 m1 (Three a b c) d (One e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits1 m1 (Three a b c) d (Two e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits1 m1 (Three a b c) d (Three e f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits1 m1 (Three a b c) d (Four e f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits1 m1 (Four a b c d) e (One f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits1 m1 (Four a b c d) e (Two f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits1 m1 (Four a b c d) e (Three f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits1 m1 (Four a b c d) e (Four f g h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\n\nappendTree2 :: (Measured v a) => FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a\nappendTree2 Empty a b xs =\n    a <| b <| xs\nappendTree2 xs a b Empty =\n    xs |> a |> b\nappendTree2 (Single x) a b xs =\n    x <| a <| b <| xs\nappendTree2 xs a b (Single x) =\n    xs |> a |> b |> x\nappendTree2 (Deep _ pr1 m1 sf1) a b (Deep _ pr2 m2 sf2) =\n    deep pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2\n\naddDigits2 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)\naddDigits2 m1 (One a) b c (One d) m2 =\n    appendTree2 m1 (node2 a b) (node2 c d) m2\naddDigits2 m1 (One a) b c (Two d e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits2 m1 (One a) b c (Three d e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits2 m1 (One a) b c (Four d e f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits2 m1 (Two a b) c d (One e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits2 m1 (Two a b) c d (Two e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits2 m1 (Two a b) c d (Three e f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits2 m1 (Two a b) c d (Four e f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits2 m1 (Three a b c) d e (One f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits2 m1 (Three a b c) d e (Two f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits2 m1 (Three a b c) d e (Three f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits2 m1 (Three a b c) d e (Four f g h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits2 m1 (Four a b c d) e f (One g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits2 m1 (Four a b c d) e f (Two g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits2 m1 (Four a b c d) e f (Three g h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2\n\nappendTree3 :: (Measured v a) => FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a\nappendTree3 Empty a b c xs =\n    a <| b <| c <| xs\nappendTree3 xs a b c Empty =\n    xs |> a |> b |> c\nappendTree3 (Single x) a b c xs =\n    x <| a <| b <| c <| xs\nappendTree3 xs a b c (Single x) =\n    xs |> a |> b |> c |> x\nappendTree3 (Deep _ pr1 m1 sf1) a b c (Deep _ pr2 m2 sf2) =\n    deep pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2\n\naddDigits3 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)\naddDigits3 m1 (One a) b c d (One e) m2 =\n    appendTree2 m1 (node3 a b c) (node2 d e) m2\naddDigits3 m1 (One a) b c d (Two e f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits3 m1 (One a) b c d (Three e f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits3 m1 (One a) b c d (Four e f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits3 m1 (Two a b) c d e (One f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits3 m1 (Two a b) c d e (Two f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits3 m1 (Two a b) c d e (Three f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits3 m1 (Two a b) c d e (Four f g h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits3 m1 (Three a b c) d e f (One g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits3 m1 (Three a b c) d e f (Two g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits3 m1 (Three a b c) d e f (Three g h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2\naddDigits3 m1 (Four a b c d) e f g (One h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits3 m1 (Four a b c d) e f g (Two h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2\naddDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2\n\nappendTree4 :: (Measured v a) => FingerTree v a -> a -> a -> a -> a -> FingerTree v a -> FingerTree v a\nappendTree4 Empty a b c d xs =\n    a <| b <| c <| d <| xs\nappendTree4 xs a b c d Empty =\n    xs |> a |> b |> c |> d\nappendTree4 (Single x) a b c d xs =\n    x <| a <| b <| c <| d <| xs\nappendTree4 xs a b c d (Single x) =\n    xs |> a |> b |> c |> d |> x\nappendTree4 (Deep _ pr1 m1 sf1) a b c d (Deep _ pr2 m2 sf2) =\n    deep pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2\n\naddDigits4 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a)\naddDigits4 m1 (One a) b c d e (One f) m2 =\n    appendTree2 m1 (node3 a b c) (node3 d e f) m2\naddDigits4 m1 (One a) b c d e (Two f g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits4 m1 (One a) b c d e (Three f g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits4 m1 (One a) b c d e (Four f g h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits4 m1 (Two a b) c d e f (One g) m2 =\n    appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2\naddDigits4 m1 (Two a b) c d e f (Two g h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits4 m1 (Two a b) c d e f (Three g h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2\naddDigits4 m1 (Three a b c) d e f g (One h) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2\naddDigits4 m1 (Three a b c) d e f g (Two h i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2\naddDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2\naddDigits4 m1 (Four a b c d) e f g h (One i) m2 =\n    appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2\naddDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2\naddDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2\naddDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =\n    appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2\n\ndeep ::  (Measured v a) =>\n     Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a\ndeep pr m sf = Deep ((measure pr `mappendVal` m) `mappend` measure sf) pr m sf\n\ndata Digit a\n    = One a\n    | Two a a\n    | Three a a a\n    | Four a a a a\n    deriving Show\n\ninstance Foldable Digit where\n    foldMap f (One a) = f a\n    foldMap f (Two a b) = f a `mappend` f b\n    foldMap f (Three a b c) = f a `mappend` f b `mappend` f c\n    foldMap f (Four a b c d) = f a `mappend` f b `mappend` f c `mappend` f d\n\ndata Node v a = Node2 !v a a | Node3 !v a a a\n    deriving Show\n\ninstance Foldable (Node v) where\n    foldMap f (Node2 _ a b) = f a `mappend` f b\n    foldMap f (Node3 _ a b c) = f a `mappend` f b `mappend` f c\n\nnode2        ::  (Measured v a) => a -> a -> Node v a\nnode2 a b    =   Node2 (measure a `mappend` measure b) a b\n\nnode3        ::  (Measured v a) => a -> a -> a -> Node v a\nnode3 a b c  =   Node3 (measure a `mappend` measure b `mappend` measure c) a b c\n\nmappendVal :: (Measured v a) => v -> FingerTree v a -> v\nmappendVal v Empty = v\nmappendVal v t = v `mappend` measure t\n\nillegal_argument :: String -> a\nillegal_argument name =\n    error $ \"Logic error: \" ++ name ++ \" called with illegal argument\"\n", "num_lines": 348}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one come from lehins, between comment:22 and 23 of Trac #13429\nmodule Main where\n\nimport T13429_2a as Array\n\narr2 :: Array D Int Int -> Array D Int Int\narr2 arr = Array.map (*2) arr\n\nmain :: IO ()\nmain = print $ arr2 $ makeArray 1600 id\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances     #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\nmodule T13429_2a where\n\ndata D\n\ndata Array r ix e = Array { _size :: ix\n                          , _index :: ix -> e }\n\nclass Show ix => Index ix\n\ninstance Index Int\n\nclass Index ix => Massiv r ix e where\n  size :: Array r ix e -> ix\n  makeArray :: ix -> (ix -> e) -> Array r ix e\n  index :: Array r ix e -> ix -> e\n\n\ninstance Massiv r ix e => Show (Array r ix e) where\n  show arr = \"<Array \" ++ show (size arr) ++ \">\"\n\n\ninstance Index ix => Massiv D ix e where\n  size = _size\n  makeArray = Array\n  index = _index\n\n\n-- | Map a function over an array (restricted return type)\nmap :: Massiv r' ix e' => (e' -> e) -> Array r' ix e' -> Array D ix e\nmap = mapG\n{-# INLINE map #-}\n\n-- | Map a function over an array (general)\nmapG :: (Massiv r' ix e', Massiv r ix e) => (e' -> e) -> Array r' ix e' -> Array r ix e\nmapG f arr = makeArray (size arr) (f . index arr)\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndelayedId :: a -> a\ndelayedId x = x\n{-# INLINE [0] delayedId #-}\n\nalwaysTrue :: [Integer]-> Bool\nalwaysTrue xs = xs == delayedId xs\n{-# NOINLINE alwaysTrue #-}\n\n{-# RULES\n    \"[Integer] Eq Refl\" forall (xs :: [Integer]). xs == xs = True\n#-}\n\nmain = putStrLn $ if alwaysTrue undefined then \"ok\" else \"not ok\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE UndecidableSuperClasses #-}\n{-# LANGUAGE PolyKinds #-}\nmodule Main where\n\nimport T13750a\n\nimport GHC.Exts (Constraint)\nimport Unsafe.Coerce\nimport Data.Proxy\n\nclass MyShow a where\n  myShow :: a -> String\n\ninstance MyShow Char where\n  myShow a = [a]\n\ngshowS :: (All2 MyShow xss) => NS xss -> String\ngshowS (Z xs)  = gshowP xs\ngshowS (S xss) = gshowS xss\n\ngshowP :: (All MyShow xs) => NP xs -> String\ngshowP (x :* Nil) = myShow x\n\nclass (AllF c xs) => All (c :: k -> Constraint) (xs :: [k])\n  -- where foo :: Proxy c     -- This makes it not seg-fault\n\ninstance All c '[]\ninstance (c x, All c xs) => All c (x ': xs)\n\ntype family AllF (c :: k -> Constraint) (xs :: [k]) :: Constraint\ntype instance AllF _c '[]       = ()\ntype instance AllF  c (x ': xs) = (c x, All c xs)\n\ntype All2 f = All (All f)\n\nmain :: IO ()\nmain = do\n  let t = 'x' :* Nil\n  print (gshowS (Z ('x' :* Nil) :: NS '[ '[ Char ] ]))\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ViewPatterns #-}\nmodule T13750a where\n\nimport Data.Kind (Type)\nimport Unsafe.Coerce\n\ntype family AnyT :: Type where {}\ntype family AnyList :: [Type] where {}\n\nnewtype NP (xs :: [Type]) = NP [AnyT]\n\ndata IsNP (xs :: [Type]) where\n  IsNil  :: IsNP '[]\n  IsCons :: x -> NP xs -> IsNP (x ': xs)\n\nisNP :: NP xs -> IsNP xs\nisNP (NP xs) =\n  if null xs\n    then unsafeCoerce IsNil\n    else unsafeCoerce (IsCons (head xs) (NP (tail xs)))\n\npattern Nil :: () => (xs ~ '[]) => NP xs\npattern Nil <- (isNP -> IsNil)\n  where\n    Nil = NP []\n\npattern (:*) :: () => (xs' ~ (x ': xs)) => x -> NP xs -> NP xs'\npattern x :* xs <- (isNP -> IsCons x xs)\n  where\n    x :* NP xs = NP (unsafeCoerce x : xs)\ninfixr 5 :*\n\ndata NS (xs :: [[Type]]) = NS !Int (NP AnyList)\n\ndata IsNS (xs :: [[Type]]) where\n  IsZ :: NP x -> IsNS (x ': xs)\n  IsS :: NS xs -> IsNS (x ': xs)\n\nisNS :: NS xs -> IsNS xs\nisNS (NS i x)\n  | i == 0    = unsafeCoerce (IsZ (unsafeCoerce x))\n  | otherwise = unsafeCoerce (IsS (NS (i - 1) x))\n\npattern Z :: () => (xs' ~ (x ': xs)) => NP x -> NS xs'\npattern Z x <- (isNS -> IsZ x)\n  where\n    Z x = NS 0 (unsafeCoerce x)\n\npattern S :: () => (xs' ~ (x ': xs)) => NS xs -> NS xs'\npattern S p <- (isNS -> IsS p)\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.Exit\nimport Control.Monad.Trans.State.Strict\n\neval :: Int -> State Int a -> a\neval p = fst . flip runState p\n\nadvance :: Int -> State Int ()\nadvance = modify' . (+)\n\nloc :: State Int Int\nloc = get\n\nemit1 :: State Int ()\nemit1 = advance 1\n\nemitN :: Int -> State Int ()\n-- adding in the 0 case, breaks with HEAD. 8.2.1 is fine with it.\n-- emitN 0 = advance 0\nemitN 0 = pure ()\nemitN n = advance n\n\nalign8 :: State Int ()\nalign8 = do\n  bits <- (`mod` 8) <$> loc\n  emitN (8 - bits)\n\nmain :: IO ()\nmain = do\n  let p = eval 0 (emit1 >> align8 >> loc)\n  putStrLn $ show p\n  if p == 8\n    then putStrLn \"OK\" >> exitSuccess\n    else putStrLn \"FAIL\" >> exitFailure\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash             #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies          #-}\n\nmodule Main where\n\nimport Control.Monad (forM_, liftM)\nimport qualified Data.Vector.Generic         as G\nimport qualified Data.Vector.Generic.Mutable as M\nimport qualified Data.Vector.Primitive as P\nimport qualified Data.Vector.Unboxed         as U\nimport qualified Data.Vector.Unboxed.Mutable as MU\nimport GHC.Exts\n\nvec :: U.Vector Moebius\nvec = U.singleton Moebius0\n\nmain :: IO ()\nmain = print $ U.head vec == U.head vec\n\ndata Moebius = Moebius0 | Moebius1 | Moebius2\n  deriving (Eq)\n\nfromMoebius :: Moebius -> Int\nfromMoebius Moebius0 = 0\nfromMoebius Moebius1 = 1\nfromMoebius Moebius2 = 2\n\ntoMoebius :: Int -> Moebius\ntoMoebius (I# i#) = tagToEnum# i#\n\nnewtype instance U.MVector s Moebius = MV_Moebius (P.MVector s Int)\nnewtype instance U.Vector    Moebius = V_Moebius  (P.Vector    Int)\n\ninstance U.Unbox Moebius\n\ninstance M.MVector U.MVector Moebius where\n  basicLength (MV_Moebius v) = M.basicLength v\n  basicUnsafeSlice i n (MV_Moebius v) = MV_Moebius $ M.basicUnsafeSlice i n v\n  basicOverlaps (MV_Moebius v1) (MV_Moebius v2) = M.basicOverlaps v1 v2\n  basicUnsafeNew n = MV_Moebius `liftM` M.basicUnsafeNew n\n  basicInitialize (MV_Moebius v) = M.basicInitialize v\n  basicUnsafeReplicate n x = MV_Moebius `liftM` M.basicUnsafeReplicate n (fromMoebius x)\n  basicUnsafeRead (MV_Moebius v) i = toMoebius `liftM` M.basicUnsafeRead v i\n  basicUnsafeWrite (MV_Moebius v) i x = M.basicUnsafeWrite v i (fromMoebius x)\n  basicClear (MV_Moebius v) = M.basicClear v\n  basicSet (MV_Moebius v) x = M.basicSet v (fromMoebius x)\n  basicUnsafeCopy (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeCopy v1 v2\n  basicUnsafeMove (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeMove v1 v2\n  basicUnsafeGrow (MV_Moebius v) n = MV_Moebius `liftM` M.basicUnsafeGrow v n\n\ninstance G.Vector U.Vector Moebius where\n  basicUnsafeFreeze (MV_Moebius v) = V_Moebius `liftM` G.basicUnsafeFreeze v\n  basicUnsafeThaw (V_Moebius v) = MV_Moebius `liftM` G.basicUnsafeThaw v\n  basicLength (V_Moebius v) = G.basicLength v\n  basicUnsafeSlice i n (V_Moebius v) = V_Moebius $ G.basicUnsafeSlice i n v\n  basicUnsafeIndexM (V_Moebius v) i = toMoebius `liftM` G.basicUnsafeIndexM v i\n  basicUnsafeCopy (MV_Moebius mv) (V_Moebius v) = G.basicUnsafeCopy mv v\n  elemseq _ = seq\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -O -g #-}\nmain = print (4, \"foo\")\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -g1 -O #-}\nimport System.Environment\nsummap :: (Int -> Int) -> (Int -> Int)\nsummap f n = f 10\n{-# NOINLINE summap #-}\n\nmain = do\n  n <- length `fmap` getArgs\n  print $ summap (+ n) n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport T14965_Sep\n\nmain :: IO ()\nmain = print $ cc bb\n\nbb :: Sep\nbb = catSep b1 b2\n\nb1 :: Sep\nb1 = Sep [] [\"foo\"] []\n\nb2 :: Sep\nb2 = Sep [] [\"bar\"] []\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14965_Sep where\n\ndata Sep = Sep\n  { bugVanishesWithoutThis :: [()]\n  , middle :: [String]\n  , orThis :: [()]\n  }\n\ncatSep :: Sep -> Sep -> Sep\ncatSep (Sep a b c) (Sep x y z) = Sep (a ++ x) (b ++ y) (c ++ z)\n\ncc :: Sep -> Bool\ncc boost = elem \"foo\" $ middle boost\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O #-}\n-- Bug only showed up with optimisation on\n\nmodule Main where\n\nimport qualified Control.Exception as Exception\n\nmain :: IO ()\nmain = do\n    unserialize\n    putStrLn \"all is well\"\n\nunserialize :: IO Char\nunserialize =\n    if definitelyTrue\n        then do\n            return 'a'\n        else do\n            Exception.evaluate (error \"wrong place\")\n\n{-# NOINLINE definitelyTrue #-}\ndefinitelyTrue :: Bool\ndefinitelyTrue = True\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport GHC.Enum\n\ndata XXX = AL | AK | AZ | AR | CA | CO | CT | DE | FL\n    deriving (Enum, Bounded, Show)\n\ndata Z = Y | X XXX deriving( Show )\n\ninstance Enum Z where\n  fromEnum Y     = 0\n  fromEnum (X s) = 1 + fromEnum s\n  toEnum 0   = Y\n  toEnum i   = X (toEnum (i - 1))\n\ninstance Bounded Z where\n  minBound = Y\n  maxBound = X maxBound\n\n\nmain = print [ succ (x :: Z) | x <- [minBound .. pred maxBound] ]\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\ndata T = MkT !Bool\n\nf :: T -> Bool\nf _ = False\n{-# NOINLINE f #-}\n\n{-# RULES \"non-det\" [1] forall x. f (MkT x) = x #-}\n\nmain :: IO ()\nmain = print (f (MkT True))\n-- Prints `True` if the rule fires, or `False` is the wrapper for `MkT` inlines\n-- in phase 2, preventing the rule from being triggered in phase 1.\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\ndata T = MkT !Bool\n\nf :: Bool -> IO ()\nf _ = putStrLn \"The rule triggered before case-of-known-constructor could take effect (bad!)\"\n{-# NOINLINE f #-}\n\ng :: IO ()\ng = putStrLn \"Case-of-known-constructor triggered (good!)\"\n\n{-# RULES \"non-det\" [~0] f True = g #-}\n\nmain :: IO ()\nmain =\n  case MkT True of\n    MkT x -> f x\n-- What we want to see is case-of-known-constructor triggering before phase 0\n-- (when the wrapper for MkT is allowed to be inlined). If it is, then the rule\n-- will see `f True` and trigger, and `g` will be run. If it isn't then `f True`\n-- will only appear at phase 0, when the rule cannot trigger, hence `f` will be\n-- run.\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExplicitForAll #-}\nmodule Main (main) where\n\nimport GHC.Exts\n\nnewtype Age a b where\n  Age :: forall b a. Int -> Age a b\n\ndata T a = MkT a\n\n{-# NOINLINE foo #-}\nfoo :: (Int -> Age Bool Char) -> String\nfoo _ = \"bad (RULE should have fired)\"\n\n{-# RULES \"foo/coerce\" [1] foo coerce = \"good\" #-}\n\nmain = putStrLn (foo Age)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\nimport Unsafe.Coerce\n\nnewtype Age = Age Int\n\nfoo :: [Int] -> [Int]\nfoo = map id\nfooAge :: [Int] -> [Age]\nfooAge = map Age\nfooCoerce :: [Int] -> [Age]\nfooCoerce = map coerce\nfooUnsafeCoerce :: [Int] -> [Age]\nfooUnsafeCoerce = map unsafeCoerce\n\nsame :: a -> b -> IO ()\nsame x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of\n    1# -> putStrLn \"yes\"\n    _  -> putStrLn \"no\"\n\nmain = do\n    let l = [1,2,3]\n    same (foo l) l\n    same (fooAge l) l\n    same (fooCoerce l) l\n    same (fooUnsafeCoerce l) l\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O -ddump-rules #-}\n\n-- Trac #2486\n--\n-- The thing to look for here is that specialisations for fib and tak \n-- at both Int and Double are indeed generated; hence -ddump-rules\n\nmodule Main where\n\nimport System.Environment\nimport Numeric\n\nmain = do\n    n <- getArgs >>= readIO . head\n    let m  = n-1\n        a  = 27 + fromIntegral n\n    putStr $\n       line \"Ack\" [3,n]       (ack 3 n)                     show ++\n       line \"Fib\" [a]         (fib a             :: Double) (\\n -> showFFloat (Just 1) n []) ++\n       line \"Tak\" [3*m,2*m,m] (tak (3*m) (2*m) m :: Int)    show ++\n       line \"Fib\" [3]         (fib 3             :: Int)    show ++\n       line \"Tak\" [3,2,1]     (tak 3 2 1         :: Double) show\n    where\n       line pre a r f = pre ++ \"(\" ++ csv f a \"\" ++ \"): \" ++ f r ++ \"\\n\"\n       csv f [a]   s  = s ++ f a\n       csv f (a:b) s  = s ++ f a ++ \",\" ++ csv f b s\n\nack :: Int -> Int -> Int\nack 0 n = n+1\nack m 0 = ack (m-1) 1\nack m n = ack (m-1) (ack m (n-1))\n\nfib :: (Num a, Ord a) => a -> a\nfib     n = if n >= 2 then fib  (n-1) + fib  (n-2) else 1\n\ntak :: (Num a, Ord a) => a -> a -> a -> a\ntak x y z = if y < x then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y) else z\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata X = X ()\n\n{-# NOINLINE newX #-}\nnewX :: () -> IO X\nnewX n = do\n    let {-# NOINLINE value #-}\n        value = n\n    return (X value)\n\nmain = do\n    x <- newX (error \"Why?\")\n    case x of\n        X _ -> return ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\n\n-- See Trac #3403: interaction of pattern match failure and CPR\n-- The point is that this should run in constant space, with no\n-- stack growth.  In GHC 6.10 the tail call optimisation didn't work.\n\nmodule Main (main) where\n\nimport qualified Data.Set as Set\nimport Data.Set (Set)\n\ndata Result = Result !S1 !S2\n\ntype S1 = Set ()\ntype S2 = Set ()\n\ninput :: [[(Int, ())]]\ninput = replicate 1000 (replicate 400 (100, ()))\n\nmain :: IO ()\nmain = do let Result s1 s2 = doAll Set.empty Set.empty () input\n          print $ Set.size s1\n          print $ Set.size s2\n\ndoAll :: S1 -> S2 -> () -> [[(Int, ())]] -> Result\ndoAll !s1 !s2 !_    [] = Result s1 s2\ndoAll !s1 !s2 !unit ([] : xs) = doAll s1 s2 unit xs\ndoAll !s1 !s2 !unit (((t, _) : x1) : x2 : xs)\n | t >= 99999 = doAll s1 s2 unit (x1 : x2 : xs)\ndoAll !s1 !s2 !unit (((_, ()) : x) : xs)\n    = doAll s1 s2 unit (x : xs)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# OPTIONS_GHC -O2 #-}\n\n-- Trac #3437\n-- When we do SpecConstr on 'go', we want the specialised\n-- function to *still* be strict in k.  Otherwise we get\n-- a bad space leak!\n\n-- The test is run with +RTS -M10m to limit the amount of heap\n-- It should run in constant space, but if the function isn't \n-- strict enough it'll run out of heap\n\nmodule Main where\n\ngo :: [Int] -> [Int] -> [Int]\ngo (0:xs) !k = k\ngo (n:xs) !k = go (n-1 : xs) (k ++ k)\n\nmain = print (go [100000000] [])\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- \n    Copyright 2009 Mario Blazevic\n\n    This file is part of the Streaming Component Combinators (SCC) project.\n\n    The SCC project is free software: you can redistribute it and/or\n    modify it under the terms of the GNU General Public License as\n    published by the Free Software Foundation, either version 3 of the\n    License, or (at your option) any later version.\n\n    SCC is distributed in the hope that it will be useful, but WITHOUT\n    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY\n    or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public\n    License for more details.\n\n    You should have received a copy of the GNU General Public License\n    along with SCC.  If not, see <http://www.gnu.org/licenses/>.\n-}\n\n-- | Module \"Trampoline\" defines the pipe computations and their basic building blocks.\n\n{-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses,\n             TypeFamilies, KindSignatures, FlexibleContexts, NoMonadFailDesugaring,\n             FlexibleInstances, OverlappingInstances, UndecidableInstances\n #-}\n\n{-   Somewhere we get:\n\n  Wanted: AncestorFunctor (EitherFunctor a (TryYield a)) d\n  This should not reduce because of overlapping instances\n\n  If it (erroneously) does reduce, via dfun2 we get\n  Wanted: Functor (EitherFunctor a (TryYield a)\n          Functor d'\n          Functor d\n          d ~ EitherFunctor d' s\n          AncestorFunctor (EitherFunctor a (TryYield a) d'\n\n\n  And that gives an infinite loop in the type checker!\n-}\n\n\nmodule Main where\n\nimport Data.Kind (Type)\nimport Control.Monad (liftM, liftM2, when, ap)\nimport Control.Monad.Fail (MonadFail(fail))\n-- import Control.Monad.Identity\n\nimport Debug.Trace (trace)\n\n\n-------------\nclass (Functor a, Functor d) => AncestorFunctor a d where\n   liftFunctor :: a x -> d x\n\n-- dfun 1\ninstance Functor a => AncestorFunctor a a where\n   liftFunctor = trace \"liftFunctor id\" . id\n\n-- dfun 2\ninstance ( Functor a\n         , Functor d'\n         , Functor d\n         , d ~ EitherFunctor d' s\n         , AncestorFunctor a d')\n      => AncestorFunctor a d where\n   liftFunctor = LeftF . (trace \"liftFunctor other\" . liftFunctor :: a x -> d' x)\n\n-------------\nnewtype Identity a = Identity { runIdentity :: a }\n\ninstance Functor Identity where\n    fmap = liftM\n\ninstance Applicative Identity where\n    pure  = return\n    (<*>) = ap\n\ninstance Monad Identity where\n    return a = Identity a\n    m >>= k  = k (runIdentity m)\n\nnewtype Trampoline m s r = Trampoline {bounce :: m (TrampolineState m s r)}\ndata TrampolineState m s r = Done r | Suspend! (s (Trampoline m s r))\n\ninstance (Monad m, Functor s) => Functor (Trampoline m s) where\n  fmap = liftM\n\ninstance (Monad m, Functor s) => Applicative (Trampoline m s) where\n  pure  = return\n  (<*>) = ap\n\ninstance (Monad m, Functor s) => Monad (Trampoline m s) where\n   return x = Trampoline (return (Done x))\n   t >>= f = Trampoline (bounce t >>= apply f)\n      where apply f (Done x) = bounce (f x)\n            apply f (Suspend s) = return (Suspend (fmap (>>= f) s))\n\ninstance (Monad m, Functor s) => MonadFail (Trampoline m s) where\n  fail = error\n\ndata Yield x y = Yield! x y\ninstance Functor (Yield x) where\n   fmap f (Yield x y) = trace \"fmap yield\" $ Yield x (f y)\n\ndata Await x y = Await! (x -> y)\ninstance Functor (Await x) where\n   fmap f (Await g) = trace \"fmap await\" $ Await (f . g)\n\ndata EitherFunctor l r x = LeftF (l x) | RightF (r x)\ninstance (Functor l, Functor r) => Functor (EitherFunctor l r) where\n   fmap f v = trace \"fmap Either\" $ \n              case v of\n                LeftF l  -> trace \"fmap LeftF\" $ LeftF (fmap f l)\n                RightF r -> trace \"fmap RightF\" $ RightF (fmap f r)\n\ntype TryYield x = EitherFunctor (Yield x) (Await Bool)\n\nsuspend :: (Monad m, Functor s) => s (Trampoline m s x) -> Trampoline m s x\nsuspend s = Trampoline (return (Suspend s))\n\nyield :: forall m x. Monad m => x -> Trampoline m (Yield x) ()\nyield x = suspend (Yield x (return ()))\n\nawait :: forall m x. Monad m => Trampoline m (Await x) x\nawait = suspend (Await return)\n\ntryYield :: forall m x. Monad m => x -> Trampoline m (TryYield x) Bool\ntryYield x = suspend (LeftF (Yield x (suspend (RightF (Await return)))))\n\ncanYield :: forall m x. Monad m => Trampoline m (TryYield x) Bool\ncanYield = suspend (RightF (Await return))\n\nliftBounce :: Monad m => m x -> Trampoline m s x\nliftBounce = Trampoline . liftM Done\n\nfromTrampoline :: Monad m => Trampoline m s x -> m x\nfromTrampoline t = bounce t >>= \\(Done x)-> return x\n\nrunTrampoline :: Monad m => Trampoline m Maybe x -> m x\nrunTrampoline = fromTrampoline\n\ncoupleNestedFinite :: (Functor s, Monad m) =>\n                      Trampoline m (EitherFunctor s (TryYield a)) x\n                   -> Trampoline m (EitherFunctor s (Await (Maybe a))) y -> Trampoline m s (x, y)\ncoupleNestedFinite t1 t2 =\n   trace \"bounce start\" $\n   liftBounce (liftM2 (,) (bounce t1) (bounce t2))\n   >>= \\(s1, s2)-> trace \"bounce end\" $\n                   case (s1, s2)\n                   of (Done x, Done y) -> return (x, y)\n                      (Done x, Suspend (RightF (Await c2))) -> coupleNestedFinite (return x) (c2 Nothing)\n                      (Suspend (RightF (LeftF (Yield _ c1))), Done y) -> coupleNestedFinite c1 (return y)\n                      (Suspend (RightF (LeftF (Yield x c1))), Suspend (RightF (Await c2))) -> coupleNestedFinite c1 (c2 $ Just x)\n                      (Suspend (RightF (RightF (Await c1))), Suspend s2@(RightF Await{})) -> coupleNestedFinite (c1 True) (suspend s2)\n                      (Suspend (RightF (RightF (Await c1))), Done y) -> coupleNestedFinite (c1 False) (return y)\n                      (Suspend (LeftF s), Done y) -> suspend (fmap (flip coupleNestedFinite (return y)) s)\n                      (Done x, Suspend (LeftF s)) -> suspend (fmap (coupleNestedFinite (return x)) s)\n                      (Suspend (LeftF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNestedFinite $ suspend $ LeftF s1) s2)\n                      (Suspend (LeftF s1), Suspend (RightF s2)) -> suspend (fmap (flip coupleNestedFinite (suspend $ RightF s2)) s1)\n                      (Suspend (RightF s1), Suspend (LeftF s2)) -> suspend (fmap (coupleNestedFinite (suspend $ RightF s1)) s2)\n\nlocal :: forall m l r x. (Monad m, Functor r) => Trampoline m r x -> Trampoline m (EitherFunctor l r) x\nlocal (Trampoline mr) = Trampoline (liftM inject mr)\n   where inject :: TrampolineState m r x -> TrampolineState m (EitherFunctor l r) x\n         inject (Done x) = Done x\n         inject (Suspend r) = Suspend (RightF $ fmap local r)\n\nout :: forall m l r x. (Monad m, Functor l) => Trampoline m l x -> Trampoline m (EitherFunctor l r) x\nout (Trampoline ml) = Trampoline (liftM inject ml)\n   where inject :: TrampolineState m l x -> TrampolineState m (EitherFunctor l r) x\n         inject (Done x) = Done x\n         inject (Suspend l) = Suspend (LeftF $ fmap out l)\n\nliftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Trampoline m a x -> Trampoline m d x\nliftOut (Trampoline ma) = trace \"liftOut\" $ Trampoline (liftM inject ma)\n   where inject :: TrampolineState m a x -> TrampolineState m d x\n         inject (Done x) = Done x\n         inject (Suspend a) = trace \"inject suspend\" $ Suspend (liftFunctor $ trace \"calling fmap\" $ \n                              fmap liftOut (trace \"poking a\" a))\n\ndata Sink (m :: Type -> Type) a x =\n   Sink   {put :: forall d. (AncestorFunctor (EitherFunctor a (TryYield x)) d) => x -> Trampoline m d Bool,\n           canPut :: forall d. (AncestorFunctor (EitherFunctor a (TryYield x)) d) => Trampoline m d Bool}\nnewtype Source (m :: Type -> Type) a x =\n   Source {get :: forall d. (AncestorFunctor (EitherFunctor a (Await (Maybe x))) d) => Trampoline m d (Maybe x)}\n\npipe :: forall m a x r1 r2. (Monad m, Functor a) =>\n        (Sink m a x -> Trampoline m (EitherFunctor a (TryYield x)) r1)\n     -> (Source m a x -> Trampoline m (EitherFunctor a (Await (Maybe x))) r2) -> Trampoline m a (r1, r2)\npipe producer consumer = coupleNestedFinite (producer sink) (consumer source) where\n   sink = Sink {put= liftOut . (local . tryYield :: x -> Trampoline m (EitherFunctor a (TryYield x)) Bool),\n                canPut= liftOut (local canYield :: Trampoline m (EitherFunctor a (TryYield x)) Bool)} :: Sink m a x\n   source = Source (liftOut (local await :: Trampoline m (EitherFunctor a (Await (Maybe x))) (Maybe x))) :: Source m a x\n\npipeProducer sink = do put sink 1\n                       (c, d) <- pipe\n                                    (\\sink'-> do put sink' 2\n                                                 put sink 3\n                                                 put sink' 4\n                                                 return 5)\n                                    (\\source'-> do Just n <- get source'\n                                                   put sink n\n                                                   put sink 6\n                                                   return n)\n                       put sink c\n                       put sink d\n                       return (c, d)\n\ntestPipe = print $\n           runIdentity $\n           runTrampoline $\n           do (a, b) <- pipe\n                           pipeProducer\n                           (\\source-> do Just n1 <- get source\n                                         Just n2 <- get source\n                                         Just n3 <- get source\n                                         return (n1, n2, n3))\n              return (a, b)\n\nmain = testPipe\n", "num_lines": 224}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}\nmodule Main(main,f) where\n\nimport Data.List (isPrefixOf)\nimport Data.Dynamic\nimport Control.Exception as E\n\ndata Failure = Failure\n    deriving (Show, Typeable)\n\ninstance Exception Failure\n\ntest = (E.throw Failure >> return ())\n          `E.catch`\n       (\\(x::Failure) -> return ())\n\nmain :: IO ()\nmain = print =<< test\n\nf :: Bool -> Bool -> Bool\nf True = error \"urk\"\n-- f False = \\y -> y\n\n{-\nUderlying cause: we call\n          catch# thing handler\nand expect that (thing state-token) will\n    - either diverge/throw an exception\n    - or return (# x,y #)\nBut it does neither: it returns a PAP, because\n    thing = \\p q. blah\n\nIn particular, 'thing = lvl_sxo' is\n  lvl_sxc :: IO Any\n  lvl_sxc = error \"urk\"\n\n  lvl_sxo :: IO ()\n    = lvl_sxc >> return ()\n\n          -- inline (>>) --\n\n    = (\\(eta::S#). case lvl_sxc |> g1 eta of ...) |> g2\n    where\n      g1 :: IO Any ~ S# -> (# S#, Any #)\n      g2 :: S# -> (# S#, () #) -> IO ()\n\n          -- case-of-bottomming function --\n\n    = (\\ (eta::S#). lvl_sxc |> g1 |> ug3) |> g2\n    where\n      ug3(unsafe) :: S# -> (S#, Any) ~ (# S#, () #)\n\nThis is all fine.  But it's crucial that lvl_sxc actually diverges.\nDo not eta-expand it to\n\n   lvl_sxc :: IO Any\n   lvl_sxc = \\eta. error \"urk\" |> ug4\n       where\n         ug4(unsafe) :: S# -> (# S#, Any #) ~ IO Any\n\nIn contrast, if we had\n   case x of\n     True  -> \\a -> 3\n     False -> error \"urk\"\nwe can, and must, eta-expand the error\n\n-}\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport T3972A (Expr(E10), Token, spanning, getSpan)\n\nimport Control.Monad\nimport System.Exit\nimport System.IO\n\nmain :: IO ()\nmain = do h <- openFile \"T3972.o\" ReadMode\n          s <- hFileSize h\n          hClose h\n          -- size is just under 8k on amd64/Linux in 6.13, but was\n          -- around 3.5M in 6.12. Let's try >20k as the test for\n          -- having regressed.\n          when (s > 20000) $ do\n              hPutStrLn stderr (\"T3972.o is too big! \" ++ show s)\n              exitFailure\n\nmakeTupleOrExpr :: [Expr] -> Maybe Token -> Expr\nmakeTupleOrExpr [e] Nothing = e\nmakeTupleOrExpr es@(_:_) (Just t) = E10 (spanning es t)\nmakeTupleOrExpr es@(_:_) Nothing  = E10 (getSpan es)\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T3972A (Expr(..), Token(..), spanning, getSpan) where\n\nclass Span a where\n   getSpan :: a -> SrcSpan\n\nspanning :: (Span a, Span b) => a -> b -> SrcSpan\nspanning x y = combineSrcSpans (getSpan x) (getSpan y)\n\ninstance Span a => Span [a] where\n   getSpan [] = error \"[]\"\n   getSpan [x] = getSpan x\n   getSpan list@(x:_) = combineSrcSpans (getSpan x) (getSpan (last list))\n\ndata SrcSpan\n\n  = SpanMultiLine\n    { span_start_row    :: !Int\n    , span_start_column :: !Int\n    , span_end_row      :: !Int\n    , span_end_column   :: !Int\n    }\n\ncombineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan\ncombineSrcSpans start end\n = case row1 `compare` row2 of\n     LT -> SpanMultiLine row1 col1 row2 col2\n     _  -> SpanMultiLine row2 col2 row1 col1\n  where\n  row1 = startRow start\n  col1 = startCol start\n  row2 = endRow end\n  col2 = endCol end\n\n\nstartRow :: SrcSpan -> Int\nstartRow (SpanMultiLine { span_start_row = row }) = row\n\nendRow :: SrcSpan -> Int\nendRow (SpanMultiLine { span_end_row = row }) = row\n\nstartCol :: SrcSpan -> Int\nstartCol (SpanMultiLine { span_start_column = col }) = col\n\nendCol :: SrcSpan -> Int\nendCol (SpanMultiLine { span_end_column = col }) = col\n\ndata Token\n   = T10 { token_SrcSpan :: SrcSpan }\n   | T11 { token_SrcSpan :: SrcSpan }\n   | T12 { token_SrcSpan :: SrcSpan }\n   | T13 { token_SrcSpan :: SrcSpan }\n   | T14 { token_SrcSpan :: SrcSpan }\n   | T15 { token_SrcSpan :: SrcSpan }\n   | T16 { token_SrcSpan :: SrcSpan }\n   | T17 { token_SrcSpan :: SrcSpan }\n   | T18 { token_SrcSpan :: SrcSpan }\n   | T19 { token_SrcSpan :: SrcSpan }\n   | T20 { token_SrcSpan :: SrcSpan }\n   | T21 { token_SrcSpan :: SrcSpan }\n   | T22 { token_SrcSpan :: SrcSpan }\n   | T23 { token_SrcSpan :: SrcSpan }\n   | T24 { token_SrcSpan :: SrcSpan }\n\ninstance Span Token where\n  getSpan = token_SrcSpan\n\ndata Expr\n   = E10 { expr_SrcSpan :: SrcSpan }\n   | E11 { expr_SrcSpan :: SrcSpan }\n   | E12 { expr_SrcSpan :: SrcSpan }\n   | E13 { expr_SrcSpan :: SrcSpan }\n   | E14 { expr_SrcSpan :: SrcSpan }\n   | E15 { expr_SrcSpan :: SrcSpan }\n   | E16 { expr_SrcSpan :: SrcSpan }\n   | E17 { expr_SrcSpan :: SrcSpan }\n   | E18 { expr_SrcSpan :: SrcSpan }\n   | E19 { expr_SrcSpan :: SrcSpan }\n   | E20 { expr_SrcSpan :: SrcSpan }\n   | E21 { expr_SrcSpan :: SrcSpan }\n   | E22 { expr_SrcSpan :: SrcSpan }\n   | E23 { expr_SrcSpan :: SrcSpan }\n   | E24 { expr_SrcSpan :: SrcSpan }\n\ninstance Span Expr where\n   getSpan = expr_SrcSpan\n", "num_lines": 87}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\nimport T3983_Foo\nimport T3983_Bar\n\nmain = catchX (foo False True) >>= print", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nmodule T3983_Bar where\nimport Data.Dynamic\nimport Control.Exception\nimport Control.Monad (unless)\n\ntype Assertion = IO ()\n\ndata X = X String deriving (Show, Typeable)\n\ninstance Exception X\n\nthrowX = throw.X\n\ncatchX action = do { action; return True; } `catches` [Handler (\\(X _) -> return False)]", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T3983_Foo where\n\nimport Control.Monad (unless)\nimport Control.Exception\nimport T3983_Bar\n\nfoo :: Bool -> Bool -> IO ()\nfoo a b = unless a $ throwX (if b then \"\" else \"\")\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f x = case x of\n  x@True  -> \\y -> x && y\n  x@False -> \\y -> x && y\n\nmain = putStrLn $ f (error \"Correct\") `seq` \"Error\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test exposes the bug in GHC 7.0.1 (and earlier)\n-- which did the following rule rewrite:\n--\n--    f (let v = 2 in g v) (let v = 3 in g v)\n--    --->  let v = 2 in let v = 3 in g v + g v\n--\n-- which is wrong because of the shadowing of v\n\nmodule Main where\nfoo :: Int -> Int\n{-# INLINE foo #-}\nfoo x = g (bar (x,x))\n\nbar :: (Int,Int) -> Int\n{-# NOINLINE bar #-}\nbar (x,y) = x\n\nbaz :: Int -> Int\n{-# NOINLINE baz #-}\nbaz x = x\n\nf :: Int -> Int -> Int\n{-# NOINLINE f #-}\nf x y = x+y\n\ng :: Int -> Int\n{-# NOINLINE g #-}\ng x = x\n\n{-# RULES\n\n \"f/g\" [1] forall x y. f (g x) (g y) = x + y\n\n #-}\n\nmain = print $ f (foo (baz 1)) (foo (baz 2))\n-- Should print 3\n-- Bug means that it prints 4\n\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax #-}\n{-# LANGUAGE EmptyDataDecls #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n\ninfixr 7 :*, .*\ninfix  8 :*:, .*.\n\ndata HNil\ndata \u00ce\u00b1 :* \u00ce\u00b2\ntype HSingle \u00ce\u00b1 = \u00ce\u00b1 :* HNil\ntype \u00ce\u00b1 :*: \u00ce\u00b2 = \u00ce\u00b1 :* \u00ce\u00b2 :* HNil\n\ndata HList l where\n  HNil  \u00e2\u02c6\u00b7 HList HNil\n  (:*) \u00e2\u02c6\u00b7 \u00ce\u00b1 \u00e2\u2020\u2019 HList t \u00e2\u2020\u2019 HList (\u00ce\u00b1 :* t)\n\n(.*) \u00e2\u02c6\u00b7 \u00ce\u00b1 \u00e2\u2020\u2019 HList t \u00e2\u2020\u2019 HList (\u00ce\u00b1 :* t)\n(.*) = (:*)\n\n(.*.) \u00e2\u02c6\u00b7 \u00ce\u00b1 \u00e2\u2020\u2019 \u00ce\u00b2 \u00e2\u2020\u2019 HList (\u00ce\u00b1 :*: \u00ce\u00b2)\na .*. b = a .* b .* HNil\n\ndata First\ndata Next p\n\ndata HIndex i where\n  First \u00e2\u02c6\u00b7 HIndex First\n  Next  \u00e2\u02c6\u00b7 HIndex p \u00e2\u2020\u2019 HIndex (Next p)\n\nclass (l ~ (HHead l :* HTail l)) \u00e2\u2021\u2019 HNonEmpty l where\n  type HHead l\n  type HTail l\n\ninstance HNonEmpty (h :* t) where\n  type HHead (h :* t) = h\n  type HTail (h :* t) = t\n\nhHead \u00e2\u02c6\u00b7 HNonEmpty l \u00e2\u2021\u2019 HList l \u00e2\u2020\u2019 HHead l\nhHead (h :* _) = h\nhHead _        = undefined\n\nhTail \u00e2\u02c6\u00b7 HNonEmpty l \u00e2\u2021\u2019 HList l \u00e2\u2020\u2019 HList (HTail l)\nhTail (_ :* t) = t\nhTail _        = undefined\n\ndata HFromWitness n l where\n  HFromFirst \u00e2\u02c6\u00b7 HFromWitness First l\n  HFromNext  \u00e2\u02c6\u00b7 (HNonEmpty l, HFromClass p (HTail l),\n                HTail (HFrom (Next p) l) ~ HFrom (Next p) (HTail l))\n             \u00e2\u2021\u2019 HFromWitness (Next p) l\n\nclass HFromClass n l where\n  type HFrom n l\n  hFromWitness \u00e2\u02c6\u00b7 HFromWitness n l\n\ninstance HFromClass First l where\n  type HFrom First l = l\n  hFromWitness = HFromFirst\n\ninstance (HNonEmpty l, HFromClass p (HTail l)) \u00e2\u2021\u2019 HFromClass (Next p) l where\n  type HFrom (Next p) l = HFrom p (HTail l)\n  hFromWitness = case hFromWitness \u00e2\u02c6\u00b7 HFromWitness p (HTail l) of\n    HFromFirst \u00e2\u2020\u2019 HFromNext\n    HFromNext  \u00e2\u2020\u2019 HFromNext\n\nhFrom \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac n l . HFromClass n l \u00e2\u2021\u2019 HIndex n \u00e2\u2020\u2019 HList l \u00e2\u2020\u2019 HList (HFrom n l)\nhFrom First    l = l\nhFrom (Next p) l = case hFromWitness \u00e2\u02c6\u00b7 HFromWitness n l of\n  HFromNext  \u00e2\u2020\u2019 hFrom p (hTail l)\n  _          \u00e2\u2020\u2019 undefined\n\ntype HNth n l = HHead (HFrom n l)\n\nhNth \u00e2\u02c6\u00b7 \u00e2\u02c6\u20ac n l . (HFromClass n l, HNonEmpty (HFrom n l))\n     \u00e2\u2021\u2019 HIndex n \u00e2\u2020\u2019 HList l \u00e2\u2020\u2019 HNth n l\nhNth First l    = hHead l\nhNth (Next p) l = case hFromWitness \u00e2\u02c6\u00b7 HFromWitness n l of\n  HFromNext \u00e2\u2020\u2019 hNth p (hTail l)\n  _         \u00e2\u2020\u2019 undefined\n\nmain = putStrLn $ hNth (Next First) (0 .*. \"Test\")\n\n", "num_lines": 90}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport T5441a\n\nmain = putStrLn (showNat Z)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5441a where\n\nimport Unsafe.Coerce (unsafeCoerce)\nimport GHC.Base (Any)\n\nlistmap :: (a -> b) -> [a] -> [b]\nlistmap f []       = []\nlistmap f (x : xs) = f x : listmap f xs\n\ndata Nat = Z | S Nat\n\n{-# NOINLINE inject #-}\ninject :: Nat -> Nat -> Nat\ninject m i = i\n\n{-# NOINLINE look #-}\nlook :: Nat -> String -> Char\nlook Z _ = '0'\n\nshowDigit :: Nat -> () -> Nat -> Char\nshowDigit base prf d = look (inject base d) \"\"\n\ntoDigits :: Nat -> Nat -> [Nat]\ntoDigits Z Z = [Z]\n\ncoe1 :: (Nat -> String) -> Any\ncoe1 = unsafeCoerce\n\ncoe2 :: Any -> (Nat -> String)\ncoe2 = unsafeCoerce\n\nshowInBase :: Nat -> Any\nshowInBase base\n  = coe1 (\\n -> listmap\n                (showDigit base ())\n                (toDigits base n))\n\nshowNat :: Nat -> String\nshowNat = coe2 (showInBase Z)\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport GHC.Exts\n\ndata Var = TyVar !Int Bool Bool\n         | TcTyVar Bool !Int Bool\n         | Var Bool Bool !Int\n         deriving (Show)\n\nscrut :: Var -> (Bool, String)\nscrut v = (True, case v of\n    TcTyVar {} -> \"OK\"\n    _ -> show v ++ show (case (case v of\n                                 TyVar b _ _ -> b\n                                 Var _ _ b -> b) of\n                           I# x# -> if isTrue# (x# ==# 7#)\n                                    then show (I# (x# +# 1#))\n                                    else show (I# (x# +# 2#))))\n\nmain = putStrLn $ snd (scrut (TcTyVar True 1 False))\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fpedantic-bottoms #-}\n-- The pedantic-bottom flag makes GHC pickier about bottoms\n-- See the ticket #5587\n\nmodule Main(main) where\n\nhiddenError = error \"hidden error\"\n\nmain = print $ seq (head (map (\\a -> \\b -> hiddenError) (hiddenError::[] Bool))) id [1]\n\n{-  See notes in Trac #5587\nf a b =  a\nhe = hiddenError::[Bool]\nmain = print $ seq (head (map f he)) id [1]\n\n\nhead (map f he)\n= head (build (\\cn. foldr (mapFB c f) n he))\n= (\\cn. foldr (mapFB c f) n he) (\\x _ -> x) badHead\n= foldr (mapFB (\\x _ -> x) f) badHead he\n= let go [] = badHead\n       go (y:ys) = mapFB (\\x _ -> x) f y (go ys)\n   in go he\n= let go []     = badHead\n       go (y:ys) = mapFB (\\x _ -> x) f y (go ys)\n                 = (\\x _. x) (f y) (go ys)\n                 = f y\n                 = \\b. y\n   in go he\n-}\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash #-}\n\nmodule Main (main) where\n\nimport GHC.Base\nimport GHC.Integer.GMP.Internals\n\nmain :: IO ()\nmain = (encodeDouble 0 :: Double) `seq` return ()\n\n{-# INLINE encodeDouble #-}\nencodeDouble :: Integer -> Double\nencodeDouble (S# _)   = D# 3.0##\nencodeDouble (Jp# _)  = D# 4.0##\nencodeDouble (Jn# _)  = D# 5.0##\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmain = do { let a = \\x -> seq undefined (+1)\n          ; print $ (a `seq` a [] `seq` id) [0] }\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ntest = seq (seq id (\\a -> undefined a)) \n\nmain = print (test [0])\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- Stack overflow if the tail recursion does not work\n\ngoInt :: Integer -> Integer -> Int\ngoInt 500 100000 = 0\ngoInt   x 100000 = goInt (x+1) 1\ngoInt   x      y = goInt x     (y+1)\n\nmain = print $ goInt 1 1\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\n-- Stack overflow if the tail recursion does not work out properly\n\nincompleteBetaWorker :: Double -> Double\nincompleteBetaWorker _ = loop 1 1 1 1\n  where\n    -- Constants\n    eps = 1e-15\n    -- Loop\n    loop :: Double -> Int -> Double -> Double -> Double\n    loop !psq !ns !term !betain\n      | done           = betain'\n      | ns > 10000000  = betain'\n      | otherwise      = loop psq' (ns + 1) term' betain'\n      where\n        -- New values\n        term'   = term\n        betain' = betain\n        psq'    = if ns < 0 then psq + 1 else psq\n        -- This condition cause stack overflow\n        done = db <= eps && db <= eps*betain' where db = abs term'\n        -- With this it loops endlessly\n        -- done = db <= eps * betain' where db = abs term'\n\nmain :: IO ()\nmain = print $ incompleteBetaWorker 0\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\n\nmodule Main where\n\nf :: (?x :: Int) => ((?x :: Int) => Int) -> Bool -> Int  \nf g False = g  \nf g True = let ?x = ?x + 1\n           in f g False\n\nh :: (?x :: Int) => Int\nh = ?x\n\nmain :: IO ()\nmain = print (let ?x = 0 in f h True)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nimport GHC.Exts\n\nnewtype Age = Age Int\n\n{-# NOINLINE myMap #-}\nmyMap f [] = []\nmyMap f (x:xs) = f x : myMap f xs\n\n{-# RULES \"map id2\" myMap (\\x -> x) = id #-}\n\nmapId = myMap id\nmapIdApp x = myMap id x\n\nmapLamId = myMap (\\x -> x)\nmapLamIdApp x = myMap (\\x -> x) x\n\n\nsame :: a -> a -> IO ()\nsame x y = case reallyUnsafePtrEquality# x y of\n    1# -> putStrLn \"yes\"\n    _  -> putStrLn \"no\"\n\nmain = do\n    let l = [1,2,3]\n    same (mapId l) l\n    same (mapIdApp l) l\n    same (mapLamId l) l\n    same (mapLamIdApp l) l\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nmodule Main where\nimport Control.Exception (throwIO, Exception)\nimport Control.Monad (when)\nimport Data.Typeable (Typeable)\n\ndata Boom = Boom deriving (Show, Typeable)\ninstance Exception Boom\n\nmain = do\n    args <- return []\n\n    -- Should throw this exception.\n    when (length args /= 1) (throwIO Boom)\n\n    -- With -O, instead throws this one from head [].\n    let n = read (head args)\n    print (n :: Int)\n\n    return ()", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nnewtype T a = MkT a\n\n-- Trac #9128: we treated x as absent!!!!\n\nf x = let {-# NOINLINE h #-}\n          h = case x of MkT g -> g\n      in \n      h (h (h (h (h (h True)))))\n\nmain = print (f (MkT id))\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nmodule Main(main ) where\n\nimport GHC.IO (IO (..))\nimport GHC.Prim\n\nwriteB :: MutableArray# RealWorld Char -> IO ()\nwriteB arr# = IO $ \\s0# -> (# writeArray# arr# 0# 'B' s0#, () #)\n\ninlineWriteB :: MutableArray# RealWorld Char -> ()\ninlineWriteB arr# =\n    case f realWorld# of\n        (# _, x #) -> x\n  where\n    IO f = writeB arr#\n\ntest :: IO Char\ntest = IO $ \\s0# ->\n  case newArray# 1# 'A' s0# of\n    (# s1#, arr# #) ->\n      case seq# (inlineWriteB arr#) s1# of\n        (# s2#, () #) ->\n          readArray# arr# 0# s2#\n\nmain :: IO ()\nmain = test >>= print\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n#include \"MachDeps.h\"\n\n#if __GLASGOW_HASKELL__ < 709\nimport GHC.Types\n#endif\n\nimport StrictPrim\nimport Type\nimport Natural\n\n\nmain :: IO ()\nmain = do\n    let (a, b) = (1234, 2345)\n        (na, nb) = (mkSingletonNat a, mkSingletonNat b)\n        nc = timesNatural na nb\n\n    print $ fromNatural na\n    print $ fromNatural nb\n    print $ fromNatural nc\n    checkEtaCount\n\n\ncheckEtaCount :: IO ()\ncheckEtaCount = do\n    text <- readFile \"Natural.dump-simpl\"\n    let etaCount = length . filter (== \"eta\") $ words text\n    if etaCount > 0\n        then error $ \"Error : Eta count (\" ++ show etaCount ++ \") should 0.\"\n        else putStrLn \"Test passed!\"\n\n\nmkSingletonNat :: Word -> Natural\nmkSingletonNat x = runStrictPrim mkNat\n  where\n    mkNat :: StrictPrim s Natural\n    mkNat = do\n        marr <- newWordArray 1\n        writeWordArray marr 0 x\n        narr <- unsafeFreezeWordArray marr\n        return $ Natural 1 narr\n\n\nfromNatural :: Natural -> Word\nfromNatural (Natural _ arr) = indexWordArray arr 0\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}\n\nmodule Natural where\n\nimport Prelude hiding (Integer, abs, sum)\n\nimport StrictPrim\nimport Type\n\n\n{-# NOINLINE timesNatural #-}\ntimesNatural :: Natural -> Natural -> Natural\ntimesNatural (Natural !n1 !arr1) (Natural !n2 !arr2) =\n    runStrictPrim $ do\n        maxOutLen <- return (1 + n1 + n2)\n        marr <- newWordArray maxOutLen\n        len <- preLoop marr\n        narr <- unsafeFreezeWordArray marr\n        return $! Natural len narr\n  where\n    preLoop marr = do\n        x <- indexWordArrayM arr1 0\n        y <- indexWordArrayM arr2 0\n        let (# cry, prod #) = timesWord2 x y\n        writeWordArray marr 0 prod\n        outerLoop1 1 marr 0 cry\n\n    outerLoop1 !nx !marr !carryhi !carrylo\n        | nx < n2 = do\n            (cryhi, crylo, sum) <- innerLoop1xi nx 0 0 carryhi carrylo\n            writeWordArray marr nx sum\n            outerLoop1 (nx + 1) marr cryhi crylo\n        | otherwise = outerLoop1a nx marr carryhi carrylo\n\n    outerLoop1a !nx !marr !carryhi !carrylo\n        | nx < n1 - 1 = do\n            (cryhi, crylo, sum) <- innerLoop1yi nx 0 0 carryhi carrylo\n            writeWordArray marr nx sum\n            outerLoop1a (nx + 1) marr cryhi crylo\n        | otherwise = outerLoop2 nx marr carryhi carrylo\n\n    innerLoop1xi !xi !yi !carryhi !carrylo !sum\n        | xi >= 0 = do\n            x <- indexWordArrayM arr1 xi\n            y <- indexWordArrayM arr2 yi\n            let (# !cry0, !prod #) = timesWord2 x y\n                (# !cry1, !sum1 #) = plusWord2 prod sum\n                (# !tcryhi, !crylo #) = plusWord2C carrylo cry0 cry1\n                !cryhi = plusWord carryhi tcryhi\n            innerLoop1xi (xi - 1) (yi + 1) cryhi crylo sum1\n        | otherwise = return $! (carryhi, carrylo, sum)\n\n    innerLoop1yi !xi !yi !carryhi !carrylo !sum\n        | yi < n2 = do\n            x <- indexWordArrayM arr1 xi\n            y <- indexWordArrayM arr2 yi\n            let (# !cry0, !prod #) = timesWord2 x y\n                (# !cry1, !sum1 #) = plusWord2 prod sum\n                (# !tcryhi, !crylo #) = plusWord2C carrylo cry0 cry1\n                !cryhi = plusWord carryhi tcryhi\n            innerLoop1yi (xi - 1) (yi + 1) cryhi crylo sum1\n        | otherwise = return $! (carryhi, carrylo, sum)\n\n    outerLoop2 !nx !marr !carryhi !carrylo\n        | nx < n1 + n2 - 1 = do\n            (cryhi, crylo, sum)\n                    <- innerLoop2 (n1 - 1) (nx - n1 + 1) 0 carryhi carrylo\n            writeWordArray marr nx sum\n            outerLoop2 (nx + 1) marr cryhi crylo\n        | carrylo /= 0 = do\n            writeWordArray marr nx carrylo\n            return $! nx + 1\n        | otherwise = return $! nx\n\n    innerLoop2 !xi !yi !carryhi !carrylo !sum\n        | yi < n2 = do\n            x <- indexWordArrayM arr1 xi\n            y <- indexWordArrayM arr2 yi\n            let (# !cry0, !prod #) = timesWord2 x y\n                (# !cry1, !sum1 #) = plusWord2 prod sum\n                (# !tcryhi, !crylo #) = plusWord2C carrylo cry0 cry1\n                !cryhi = plusWord carryhi tcryhi\n            innerLoop2 (xi - 1) (yi + 1) cryhi crylo sum1\n        | otherwise = return $! (carryhi, carrylo, sum)\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash, NoImplicitPrelude, RankNTypes,\n    TypeFamilies, UnboxedTuples, UnliftedFFITypes #-}\n\nmodule StrictPrim\n    ( StrictPrim\n    , PrimMonad (..)\n    , runStrictPrim\n    ) where\n\n#if __GLASGOW_HASKELL__ < 709\nimport Control.Applicative\n#endif\n\nimport GHC.Base\n\nnewtype StrictPrim s a\n    = StrictPrim (State# s -> (# State# s, a #))\n\ninstance Applicative (StrictPrim s) where\n    {-# INLINE pure #-}\n    pure = return\n\n    {-# INLINE (<*>) #-}\n    (<*>) a b = do f <- a ; v <- b ; return $! (f $! v)\n\ninstance Functor (StrictPrim s) where\n    {-# INLINE fmap #-}\n    fmap !f (StrictPrim !m) = StrictPrim $ \\ !s ->\n        case m s of\n            (# !new_s,!r #) -> (# new_s, f $! r #)\n\n\ninstance Monad (StrictPrim s) where\n    {-# INLINE return #-}\n    return !x = StrictPrim ( \\ !s -> (# s, x #))\n\n    {-# INLINE (>>) #-}\n    (!m) >> (!k) = do { _ <- m ;  k }\n\n    {-# INLINE (>>=) #-}\n    (StrictPrim !m) >>= (!k) =\n        StrictPrim ( \\ !s ->\n            case m s of\n                (# new_s, r #) -> case k r of\n                    StrictPrim k2 -> k2 new_s\n            )\n\ninstance PrimMonad (StrictPrim s) where\n    type PrimState (StrictPrim s) = s\n    {-# INLINE primitive #-}\n    primitive = StrictPrim\n\n\n{-# INLINE runStrictPrim #-}\nrunStrictPrim :: (forall s. StrictPrim s a) -> a\nrunStrictPrim !st =\n    case st of\n        StrictPrim st_rep ->\n            case st_rep realWorld# of\n                (# _, !r #) -> r\n\nclass Monad m => PrimMonad m where\n    type PrimState m\n    primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a\n\n#if __GLASGOW_HASKELL__ < 709\n-- Grab this from Prelude (part of Base) because Base depends on this code.\n($!) :: (a -> b) -> a -> b\nf $! x  = let !vx = x in f vx\n#endif\n", "num_lines": 71}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}\n\n#include \"MachDeps.h\"\n\nmodule Type where\n\nimport GHC.Prim\nimport GHC.Types\n\nimport StrictPrim\n\ndata Natural = Natural {-# UNPACK #-} !Int {-# UNPACK #-} !WordArray\n\ndata WordArray = WA ByteArray#\ndata MutableWordArray m = MWA (MutableByteArray# (PrimState m))\n\n{-# INLINE newWordArray #-}\nnewWordArray :: (Monad m, PrimMonad m) => Int -> m (MutableWordArray m)\nnewWordArray !len = do\n    let !(I# n#) = len * sizeOfWord\n    primitive (\\s# -> case newByteArray# n# s# of\n                        (# s'#, arr# #) -> (# s'#, MWA arr# #))\n\n{-# INLINE unsafeFreezeWordArray #-}\nunsafeFreezeWordArray :: (Monad m, PrimMonad m)\n                        => MutableWordArray m -> m WordArray\nunsafeFreezeWordArray !(MWA arr#) =\n    primitive (\\s# -> case unsafeFreezeByteArray# arr# s# of\n                        (# s'#, arr'# #) -> (# s'#, WA arr'# #))\n\n{-# INLINE indexWordArray #-}\nindexWordArray :: WordArray -> Int -> Word\nindexWordArray !(WA arr#) (I# i#) =\n    let w# = indexWordArray# arr# i# in W# w#\n\n{-# INLINE indexWordArrayM #-}\nindexWordArrayM :: Monad m => WordArray -> Int -> m Word\nindexWordArrayM !(WA arr#) (I# i#) =\n    let w# = indexWordArray# arr# i# in\n    case W# w# of x -> return x\n\n\n{-# INLINE writeWordArray #-}\nwriteWordArray :: (Monad m, PrimMonad m)\n                        => MutableWordArray m -> Int -> Word -> m ()\nwriteWordArray !(MWA arr#) (I# i#) (W# x#) =\n    primitive (\\s# ->\n        case writeWordArray# arr# i# x# s# of\n            s'# -> (# s'#, () #))\n\n\n{-# INLINE plusWord #-}\nplusWord :: Word -> Word -> Word\nplusWord (W# a) (W# b) =\n    let !s = plusWord# a b\n    in W# s\n\n{-# INLINE plusWord2 #-}\nplusWord2 :: Word -> Word -> (# Word, Word #)\nplusWord2 (W# a) (W# b) =\n    let (# !c, !s #) = plusWord2# a b\n    in (# W# c, W# s #)\n\n{-# INLINE plusWord2C #-}\nplusWord2C :: Word -> Word -> Word -> (# Word, Word #)\nplusWord2C (W# a) (W# b) (W# c) =\n    let (# !c1, !s1 #) = plusWord2# a b\n        (# !c2, !s2 #) = plusWord2# s1 c\n        !carry = plusWord# c1 c2\n    in (# W# carry, W# s2 #)\n\n{-# INLINE timesWord2 #-}\ntimesWord2 :: Word -> Word -> (# Word, Word #)\ntimesWord2 (W# a) (W# b) =\n    let (# !ovf, !prod #) = timesWord2# a b\n    in (# W# ovf, W# prod #)\n\nsizeOfWord :: Int\nsizeOfWord = WORD_SIZE_IN_BITS `div` 8\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13588 where\n\nnewtype T a = MkT a\nf (x, y) = (MkT x, y)\n{-# NOINLINE f #-}\n\n\nbar x =\n    let y = f (x,x) in\n    let z = case y of (MkT x,y) -> (x,y) in\n    (z,z)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Debug.Trace\n\nnewtype Id a = Id a\n\n\nunId True _ = Nothing -- make lazy\nunId False (Just (Id x)) = (Just x)\nunId False Nothing = Nothing\n{-# NOINLINE unId #-}\n\nval n = trace \"evaluated once, as it should\" (Just (Id n))\n{-# NOINLINE val #-}\n\nfoo b n = unId b (val n)\n{-# NOINLINE foo #-}\n\nmain = print (foo False 1)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Main where\n\nmain :: IO ()\nmain = do\n  let f :: (Bool, Bool) -> (Bool, Bool) -> (Bool, Bool)\n      f (True, False) (False, False) = (False, True)\n      f _ _ = (True, False)\n      ((i, b), v) = ((False,True),[(False,True),(False,False),(True,True),(True,False),(False,False),(False,True),(True,True),(True,True),(False,True),(True,False),(False,False),(True,True),(True,True),(False,False),(False,False),(False,True),(True,False),(True,False),(True,True),(True,True),(False,True),(True,False),(True,False),(True,True),(False,False),(True,True),(False,False),(True,False),(False,True),(True,True)])\n  print $ foldlTest f (i, b) v\n\ntype FoldlTest a = (a -> a -> a) -> a -> [a] -> Bool\n\nfoldlTest :: FoldlTest (Bool, Bool)\nfoldlTest f (i, b) v =\n  foldl f (i, b) v == foldl (\\x -> f (unmodel x)) (i, b) v\n\nclass TestData a where\n  type Model a\n  unmodel :: Model a -> a\n\ninstance TestData Bool where\n  type Model Bool = Bool\n  unmodel = id\n\ninstance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where\n  type Model (a,b) = (Model a, Model b)\n  unmodel (a,b) = (unmodel a, unmodel b)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nimport GHC.Exts\nimport Unsafe.Coerce\n\nfoo :: Either Int a -> Either Bool a\nfoo (Right x) = Right x\nfoo _ = Left True\n{-# NOINLINE foo #-}\n\nbar :: a -> (Either Int a, Either Bool a)\nbar x = (Right x, Right x)\n{-# NOINLINE bar #-}\n\nnested :: Either Int (Either Int a) -> Either Bool (Either Bool a)\nnested (Right (Right x)) = Right (Right x)\nnested _ = Left True\n{-# NOINLINE nested #-}\n\n\n-- CSE in a recursive group\ndata Tree x = T x (Either Int (Tree x)) (Either Bool (Tree x))\nrec1 :: x -> Tree x\nrec1 x =\n    let t = T x r1 r2\n        r1 = Right t\n        r2 = Right t\n    in t\n{-# NOINLINE rec1 #-}\n\n-- Not yet supported! (and tricky)\ndata Stream a b x = S x (Stream b a x)\nrec2 :: x -> Stream a b x\nrec2 x =\n    let s1 = S x s2\n        s2 = S x s1\n    in s1\n{-# NOINLINE rec2 #-}\n\ntest x = do\n    let (r1,r2) = bar x\n    (same $! r1) $! r2\n    let r3 = foo r1\n    (same $! r1) $! r3\n    let (r4,_) = bar r1\n    let r5 = nested r4\n    (same $! r4) $! r5\n    let (T _ r6 r7) = rec1 x\n    (same $! r6) $! r7\n    let s1@(S _ s2) = rec2 x\n    (same $! s1) $! s2\n{-# NOINLINE test #-}\n\nmain = test \"foo\"\n\nsame :: a -> b -> IO ()\nsame x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of\n    1# -> putStrLn \"yes\"\n    _  -> putStrLn \"no\"\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M where\n\n{-# ANN myId \"HLint: ignore\" #-}\nmyId :: a -> a\nmyId x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2632\n\nmodule MkData where\n\nimport Language.Haskell.TH\n\nop :: Num v => v -> v -> v\nop a b = a + b\n\ndecl1 = [d| func = 0 `op` 3 |]\n\ndecl2 = [d| op x y = x\n            func = 0 `op` 3 |]\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-}\n                -- Makes f2 a bit more challenging\n\nmodule Foo where\n\n\nh :: Int -> Int -> Bool\nh 0 y = y>0\nh n y = h (n-1) y\n\n-- The main point: all of these functions can have the CPR property\n\n------- f1 -----------\n-- x is used strictly by h, so it'll be available\n-- unboxed before it is returned in the True branch\n\nf1 :: Int -> Int\nf1 x = case h x x of\n        True  -> x\n        False -> f1 (x-1)\n\n\n------- f2 -----------\n-- x is a strict field of MkT2, so we'll pass it unboxed\n-- to $wf2, so it's available unboxed.  This depends on\n-- the case expression analysing (a subcomponent of) one\n-- of the original arguments to the function, so it's\n-- a bit more delicate.\n\ndata T2 = MkT2 !Int Int\n\nf2 :: T2 -> Int\nf2 (MkT2 x y) | y>0       = f2 (MkT2 x (y-1))\n              | y>1       = 1\n              | otherwise = x\n\n\n------- f3 -----------\n-- h is strict in x, so x will be unboxed before it\n-- is rerturned in the otherwise case.\n\ndata T3 = MkT3 Int Int\n\nf1 :: T3 -> Int\nf1 (MkT3 x y) | h x y     = f3 (MkT3 x (y-1))\n              | otherwise = x\n\n\n------- f4 -----------\n-- Just like f2, but MkT4 can't unbox its strict\n-- argument automatically, as f2 can\n\ndata family Foo a\nnewtype instance Foo Int = Foo Int\n\ndata T4 a = MkT4 !(Foo a) Int\n\nf4 :: T4 Int -> Int\nf4 (MkT4 x@(Foo v) y) | y>0       = f4 (MkT4 x (y-1))\n                      | otherwise = v\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata Boolean = FF | TT\ndata Pair a b = MkPair a b\ndata LList alpha = Nill | Conss alpha (LList alpha) \ndata Nat = Zero | Succ Nat\ndata Tree x = Leaf x | Node (Tree x) (Tree x) \ndata A a = MkA a (A a) \n\nappend :: LList a -> LList a -> LList a\nappend  xs ys  = case xs of\n                  Conss z zs  -> Conss z (append zs ys) \n                  v -> ys\n\n\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\nfact :: Int -> Int\nfact n = if n==0 then 2 else (fact n) * n\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata Fun = MkFun (Fun -> Fun)\ndata LList a = Nill | Conss a (LList a)\n\ng :: Fun -> Fun\ng f = f\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata Goo a = Gsimpl | Gcompl ([Goo a]) \ndata Moo a b = Msimple | Mcompl (Moo b a)\n\n\nidGoo :: Goo a -> Goo a\nidGoo x = x\n\nidMoo :: Moo a b -> Moo a b\nidMoo x = x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! TEST OF DEFACTORISATION FOR FUNCTIONS THAT DROP \n-- !!             POLYMORPHIC VARIABLES\n\nmodule Test where\ndata Boolean = FF | TT\ndata Pair a b = MkPair a b\ndata LList alpha = Nill | Conss alpha (LList alpha) \ndata Nat = Zero | Succ Nat\ndata Tree x = Leaf x | Node (Tree x) (Tree x) \ndata A a = MkA a (A a) \n\nappend :: LList a -> LList a -> LList a\nappend  xs ys  = case xs of\n                  Nill -> ys \n                  Conss z zs  -> Conss z (append zs ys) \n\n-- The following function drops @b@.\n\nflat :: Tree (Pair a b) -> LList a\nflat t =  case t of\n              Leaf (MkPair a b) -> Conss a Nill \n              Node l r -> append (flat l) (flat r)\n\nfl :: Boolean -> LList Boolean\nfl x = flat (Leaf (MkPair TT Zero)) \n\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata Boolean = FF | TT\ndata Pair a b = MkPair a b\ndata LList alpha = Nill | Conss alpha (LList alpha) \ndata Nat = Zero | Succ Nat\ndata Tree x = Leaf x | Node (Tree x) (Tree x) \ndata A a = MkA a (A a) \n\n{-\nmap :: (a -> b) -> [a] -> [b]\nmap f xs = case xs of\n             []     -> []\n             (y:ys) -> (f y):(map f ys)\n\nmap_ide :: [[a]] -> [[a]]\nmap_ide = map (\\x->x)\n-}\n\nmy_id :: a -> a\nmy_id x = x\n\nidNat :: Nat -> Nat\nidNat x = x\n\nidBool :: Boolean -> Boolean\nidBool x = x\n\nfun :: (a->b) -> a -> b\nfun f x = g f\n where \n  g f   = f x\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one killed GHC 6.4 because it bogusly attributed\n-- the CPR property to the constructor T\n-- Result: a mkWWcpr crash\n-- Needs -prof -fprof-auto to show it up\n\nmodule ShouldCompile where\n\nnewtype T a = T { unT :: a }\n\nf = unT\n\ntest cs = f $ case cs of\n                   [] -> T []\n                   (x:xs) -> T $ test cs\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata Boolean = FF | TT\ndata Pair a b = MkPair a b\ndata LList alpha = Nill | Conss alpha (LList alpha) \ndata Nat = Zero | Succ Nat\ndata Tree x = Leaf x | Node (Tree x) (Tree x) \ndata A a = MkA a (A a) \n{-\nid :: a -> a\nid x = x      \n\nidb :: Boolean -> Boolean\nidb b = b\n\nswap :: Pair a b -> Pair b a\nswap t = case t of \n           MkPair x y -> MkPair y x\n\nbang :: A (A a) -> Boolean\nbang x = case x of\n           MkA y ys -> TT\n\nneg :: Boolean -> Boolean\nneg b = case b of \n         FF -> TT \n         TT -> FF \n\nnull :: LList x -> Boolean\nnull l = case l of \n           Nill -> TT\n           _ -> FF\n\nloop :: Boolean -> a\nloop b = loop b\n-}\nidl ::  LList a -> LList a\nidl xs  = case xs of\n           Conss y ys -> Conss y (idl ys)\n           _ -> Nill \n{-\nidn :: Nat -> Nat\nidn n = case n of\n          Zero -> Zero \n          Succ m -> Succ (idn m)\n\nadd :: Nat -> Nat -> Nat\nadd a b = case a of \n            Zero -> b\n            Succ c -> Succ (add c b) \n\nlength :: LList a -> Nat\nlength xs = case xs of \n              Nill -> Zero\n              Conss y ys  -> Succ(length ys) \n\nbefore :: LList Nat -> LList Nat\nbefore xs = case xs of\n              Nill -> Nill\n              Conss y ys -> case y of \n                             Zero -> Nill\n                             Succ n -> Conss y (before ys)     \n\nreverse :: LList a -> LList a\nreverse rs = case rs of\n               Nill -> Nill\n               Conss y ys -> append (reverse ys) (Conss y Nill) \n\nf :: Nat -> Nat\nf n = case n of\n        Zero -> Zero\n        Succ m -> Succ (g m)\n\ng :: Nat -> Nat\ng n = case n of\n       Zero -> Zero\n       Succ m -> Succ (f m)\n\nappend :: LList a -> LList a -> LList a\nappend  xs ys  = case xs of\n                  Nill -> ys \n                  Conss z zs  -> Conss z (append zs ys) \n\nflatten :: Tree alpha -> LList alpha\nflatten t = case t of\n              Leaf x   -> Conss x Nill \n              Node l r -> append (flatten l) (flatten r)\n\nsum :: Tree Nat -> Nat\nsum t = case t of\n          Leaf t   -> t\n          Node l r -> add (sum l) (sum r) \n\nsuml :: LList Nat -> Nat\nsuml Nill = Zero\nsuml (Conss n ns) = add n (suml ns)\n\nmap :: (a -> b) -> LList a -> LList b\nmap f xs = case xs of\n             Nill -> Nill\n             Conss y ys -> Conss (f y) (map f ys)\n-}\n\n\n", "num_lines": 104}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\nmodule ShouldSucceed where\n\n{-# OPTIONS -O #-}\n\nnewtype Num a => Point2 a     = Point2 (a,a)\n\narea2 :: Num a => Point2 a -> Point2 a -> Point2 a -> a\narea2 (Point2 (px,py)) (Point2 (qx,qy)) (Point2 (rx,ry))\n     = (px-qx) * (py-ry) - (py-qy) * (px-rx)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Recursive newtypes\n--      Needs -O\n-- This one made GHC < 5.00.2 go into an\n-- infinite loop in the strictness analysier\n\nmodule Foo where\n\nnewtype V = MkV V\n\nf :: V -> V\nf (MkV v) = v\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! THIS TEST IS FOR TYPE SYNONYMS AND FACTORISATION IN THEIR PRESENCE.\n\nmodule Test where\ndata M a = A | B a (M a)\ndata L a = N | C a (Syn a)\ntype Syn b = L b\n\nidL :: L (Syn c) -> L (Syn c)\nidL N       = N\nidL (C x l) = C x (idL l) \n\nidM:: M (L (Syn x)) -> M (L (Syn x))\nidM A       = A\nidM (B x l) = B (idL x) (idM l) \n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T10482 where\n\ndata family Foo a\ndata instance Foo (a, b) = FooPair !(Foo a) !(Foo b)\nnewtype instance Foo Int = Foo Int\n\nfoo :: Foo ((Int, Int), Int) -> Int -> Int\nfoo !f k =\n  if k == 0 then 0\n  else if even k then foo f (k-1)\n  else case f of\n    FooPair (FooPair (Foo n) _) _ -> n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-}\n                -- Makes f2 a bit more challenging\n\n-- Tests inspired by Note [CPR examples] in DmdAnal, and Trac #10482\n\nmodule Foo where\n\n\nh :: Int -> Int -> Bool\nh 0 y = y>0\nh n y = h (n-1) y\n\n-- The main point: all of these functions can have the CPR property\n\n------- f1 -----------\n-- x is used strictly by h, so it'll be available\n-- unboxed before it is returned in the True branch\n\nf1 :: Int -> Int\nf1 x = case h x x of\n        True  -> x\n        False -> f1 (x-1)\n\n\n------- f2 -----------\n-- x is a strict field of MkT2, so we'll pass it unboxed\n-- to $wf2, so it's available unboxed.  This depends on\n-- the case expression analysing (a subcomponent of) one\n-- of the original arguments to the function, so it's\n-- a bit more delicate.\n\ndata T2 = MkT2 !Int Int\n\nf2 :: T2 -> Int\nf2 (MkT2 x y) | y>0       = f2 (MkT2 x (y-1))\n              | y>1       = 1\n              | otherwise = x\n\n\n------- f3 -----------\n-- h is strict in x, so x will be unboxed before it\n-- is rerturned in the otherwise case.\n\ndata T3 = MkT3 Int Int\n\nf3 :: T3 -> Int\nf3 (MkT3 x y) | h x y     = f3 (MkT3 x (y-1))\n              | otherwise = x\n\n\n------- f4 -----------\n-- Just like f2, but MkT4 can't unbox its strict\n-- argument automatically, as f2 can\n\ndata family Foo a\nnewtype instance Foo Int = Foo Int\n\ndata T4 a = MkT4 !(Foo a) Int\n\nf4 :: T4 Int -> Int\nf4 (MkT4 x@(Foo v) y) | y>0       = f4 (MkT4 x (y-1))\n                      | otherwise = v\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10694 where\n\n-- The point here is that 'm' should NOT have the CPR property\n-- Checked by grepping in the -ddump-simpl\n\n\n-- Some nonsense so that the simplifier can't see through\n-- to the I# constructor\npm :: Int -> Int -> (Int, Int)\npm x y = (l !! 0, l !! 1)\n  where l = [x+y, x-y]\n{-# NOINLINE pm #-}\n\nm :: Int -> Int -> Int\nm x y = case pm x y of\n  (pr, mr) -> mr\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11770 where\n\n\nfoo :: Int -> Int ->  Int\nfoo 10 c = 0\nfoo n c =\n        -- Bar should not be marked as one-shot\n    let bar :: Int -> Int\n        bar n = n + c\n        {-# NOINLINE bar #-}\n    in bar n + foo (bar (n+1)) c\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule Foo( f ) where\nimport GHC.Prim\n\nf True  = raise# True\nf False = \\p q -> raise# False\n\n\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T13077 where\nimport GHC.Exts\n\ndata X = A | B | C\n\ndata T = MkT !X Int# Int#\n\nf (MkT x 0# _) = True\nf (MkT x n  _)  = let v = case x of\n                         A -> 1#\n                         B -> 2#\n                         C -> n\n                  in f (MkT x v v)\n -- Tests evaluatedness for worker args\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash  #-}\nmodule T13077a where\n\nimport GHC.Exts\n\ndata X = A | B | C\n\ndata T = MkT !X Int# Int#\n\ng :: Int -> T\ng 0 = MkT A 1# 2#\ng n = g (n-1)\n\nboo :: Int -> T\nboo k = case g k of\n          MkT x n _ -> let v = case x of\n                                  A -> 1#\n                                  B -> 2#\n                                  C -> n\n                       in MkT x v v\n  -- Tests evaluated-ness for CPR\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- | Asserts that absent bindings of UnliftedRep are properly WWed\nmodule Unlifted where\n\nimport GHC.Exts\n\nfac :: Int -> Int\nfac n = product [1..n]\n\ndata MMutVar s a = MMutVar (MutVar# s a) Int\nmutVar :: MMutVar s a -> Int\nmutVar (MMutVar _ n) = fac n\n{-# NOINLINE mutVar #-}\n\ndata AArray a = AArray (Array# a) Int\narray :: AArray a -> Int\narray (AArray _ n) = fac n\n{-# NOINLINE array #-}\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16029 where\n\ndata S = MkS Int Int\n\ng1 :: S -> Int -> Int\ng1 (MkS x y) 0 = 0\ng1 (MkS x y) n = g1 (MkS y x) (n-1)\n\ndata T = MkT !Int !Int\ng2 :: T -> Int -> Int\ng2 (MkT x y) 0 = 0\ng2 (MkT x y) n = g2 (MkT y x) (n-1)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O2 #-}\n\n-- Trac #1988: this one killed GHC 6.8.2\n--              at least with -O2\n\nmodule ShouldCompile where\n\nnewtype CFTree = CFTree (String, [CFTree])\n\nprCFTree :: CFTree -> String\nprCFTree (CFTree (_,trees)) = concatMap ps trees\n    where ps t@(CFTree (_,[])) = prCFTree t\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8037 where\n\nimport Unsafe.Coerce\nimport Foreign.C.Types\nimport System.IO.Unsafe\n\ndata D4 = D4 CInt CInt CInt\ndata Color3 = Color3 CInt CInt\n\ncrash :: D4 -> IO ()\ncrash x = color (unsafeCoerce x)\n\ncolor :: Color3 -> IO ()\ncolor (Color3 r g) = f (unsafePerformIO undefined) r g\n\nforeign import ccall f :: CInt -> CInt -> CInt -> IO ()\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8467 where\n\nnewtype Void = Void Void\n\ndata Decision a = Disproved (a -> Void)\n\nbar :: Int -> Void\nbar = \\_ -> undefined\n\nfoo :: () -> Decision Int\nfoo _ = Disproved (\\_ -> undefined)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8743 where\n\n-- Without the following import, it does not fail\nimport T8743a ()\n\n-- [()] required, () does not work.\nclass ToRow a where toRow :: a -> [()]\n\ninstance ToRow (Maybe a) where\n    toRow Nothing  = [()]\n    toRow (Just _) = [()]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8743a where\n\nimport {-# SOURCE #-} T8743 ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, LambdaCase, BangPatterns, MagicHash, TupleSections, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -w #-}  -- Suppress warnings for unimplemented methods\n\n------------- WARNING ---------------------\n--\n-- This program is utterly bogus. It takes a value of type ()\n-- and unsafe-coerces it to a function, and applies it.\n-- This is caught by an ASSERT with a debug compiler.\n--\n-- See Trac #9208 for discussion\n--\n--------------------------------------------\n\n{- | Evaluate Template Haskell splices on node.js,\n     using pipes to communicate with GHCJS\n -}\n\n-- module GHCJS.Prim.TH.Eval\nmodule Eval (\n         runTHServer\n       ) where\n\nimport           Control.Applicative\nimport           Control.Monad\n#if __GLASGOW_HASKELL__ >= 800\nimport           Control.Monad.Fail (MonadFail(fail))\n#endif\nimport           Control.Monad.IO.Class (MonadIO (..))\n\nimport           Data.Binary\nimport           Data.Binary.Get\nimport           Data.ByteString          (ByteString)\nimport qualified Data.ByteString          as B\nimport qualified Data.ByteString.Lazy     as BL\n\nimport           GHC.Base                 (Any)\n\nimport qualified Language.Haskell.TH        as TH\nimport qualified Language.Haskell.TH.Syntax as TH\n\nimport           Unsafe.Coerce\n\ndata THResultType = THExp | THPat | THType | THDec\n\ndata Message\n  -- | GHCJS compiler to node.js requests\n  = RunTH THResultType ByteString TH.Loc \n  -- | node.js to GHCJS compiler responses\n  | RunTH' THResultType ByteString [TH.Dec] -- ^ serialized AST and additional toplevel declarations\n\ninstance Binary THResultType where\n  put _ = return ()\n  get   = return undefined\n\ninstance Binary Message where\n  put _ = return ()\n  get   = return undefined\n\ndata QState = QState\n\ndata GHCJSQ a = GHCJSQ { runGHCJSQ :: QState -> IO (a, QState) }\n\ninstance Functor GHCJSQ where\n  fmap f (GHCJSQ s) = GHCJSQ $ fmap (\\(x,s') -> (f x,s')) . s\n\ninstance Applicative GHCJSQ where\n  f <*> a = GHCJSQ $ \\s ->\n    do (f',s')   <- runGHCJSQ f s\n       (a', s'') <- runGHCJSQ a s'\n       return (f' a', s'')\n  pure x = GHCJSQ (\\s -> return (x,s))\n\ninstance Monad GHCJSQ where\n  (>>=) m f = GHCJSQ $ \\s ->\n    do (m', s')  <- runGHCJSQ m s\n       (a,  s'') <- runGHCJSQ (f m') s'\n       return (a, s'')\n  return    = pure\n\n#if __GLASGOW_HASKELL__ >= 800\ninstance MonadFail GHCJSQ where\n  fail = undefined\n#endif\n\ninstance MonadIO GHCJSQ where liftIO m = GHCJSQ $ \\s -> fmap (,s) m\ninstance TH.Quasi GHCJSQ\n\n-- | the Template Haskell server\nrunTHServer :: IO ()\nrunTHServer = void $ runGHCJSQ server QState\n  where\n    server = TH.qRunIO awaitMessage >>= \\case\n      RunTH t code loc -> do\n        a <- TH.qRunIO $ loadTHData code\n        runTH t a loc\n      _ -> TH.qRunIO (putStrLn \"warning: ignoring unexpected message type\")\n\nrunTH :: THResultType -> Any -> TH.Loc -> GHCJSQ ()\nrunTH rt obj loc = do\n  res <- case rt of\n           THExp  -> runTHCode (unsafeCoerce obj :: TH.Q TH.Exp)\n           THPat  -> runTHCode (unsafeCoerce obj :: TH.Q TH.Pat) \n           THType -> runTHCode (unsafeCoerce obj :: TH.Q TH.Type)\n           THDec  -> runTHCode (unsafeCoerce obj :: TH.Q [TH.Dec])\n  TH.qRunIO (sendResult $ RunTH' rt res [])\n\nrunTHCode :: {- Binary a => -} TH.Q a -> GHCJSQ ByteString\nrunTHCode c = TH.runQ c >> return B.empty\n\nloadTHData :: ByteString -> IO Any\nloadTHData bs = return (unsafeCoerce ()) \n\nawaitMessage :: IO Message\nawaitMessage = fmap (runGet get) (return BL.empty)\n\n-- | send result back\nsendResult :: Message -> IO ()\nsendResult msg = return ()\n", "num_lines": 119}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata LList t = Nill | Conss t (LList t)\ndata BBool = TTrue | FFalse\n\nf Nill = TTrue\nf (Conss a as) = FFalse\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\na :: [a] -> [[a]]\na x = [x]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\ndata Boolean = FF | TT\ndata Pair a b = Mkpair a b\ndata LList alpha = Nill | Conss alpha (LList alpha) \ndata Nat = Zero | Succ Nat\ndata Tree t = Leaf t | Node (Tree t) (Tree t) \ndata A a = MkA a (A a) \ndata Foo baz = MkFoo (Foo (Foo baz))\n{-\n append1 :: LList a -> LList a -> LList a\n append1 xs ys = append2 xs\n   where\n     append2 xs = case xs of\n                    Nill -> ys\n                    Conss x xs -> Conss x (append3 xs)\n     append3 xs = case xs of\n                    Nill -> ys\n                    Conss x xs -> Conss x (append2 xs)\n\n loop :: a -> a\n loop x =  loop x\n\n hd :: LList b -> b\n hd Nill         = loop\n hd (Conss y ys) = y\n\n hdb :: LList (LList b) -> LList b\n hdb = hd\n\n append :: [a] -> [a] -> [a]\n append [] ys     = ys\n append (x:xs) ys = x:(append xs ys)\n \n f :: [a] -> [a]\n f y = append x (f y)\n   where  x = append x (f y)\n-}\napp :: LList a -> LList a -> LList a\napp Nill Nill = Nill\napp  xs ys  = case xs of\n                Nill -> ys \n                Conss z zs  -> Conss z (app zs ys) \n{-\n app :: LList a -> LList a -> LList a\n app  xs ys = case xs of\n               Nill -> case ys of\n                        Nill -> Nill\n                        Conss u us -> ap \n               Conss a as -> ap \n  where ap = case xs of\n              Nill -> ys \n              Conss z zs  -> Conss z (app zs ys) \n\n app :: LList a -> LList a -> LList a\n app  xs ys = case xs of\n               Nill -> case ys of\n                        Nill -> Nill\n                        Conss u us -> ap xs ys\n               Conss a as -> ap xs ys\n\n ap xs ys = case xs of\n              Nill -> ys \n              Conss z zs  -> Conss z (app zs ys) \n\n ap :: LList a -> LList a -> LList a\n ap  xs ys  = case xs of\n                 Nill -> ys \n                 Conss z zs  -> Conss z (ap zs ys) \n\n app :: LList a -> LList a -> LList a\n app  xs ys = case xs of\n               Nill -> case ys of\n                        Nill -> Nill\n                        Conss u us -> ap xs ys\n               Conss a as -> ap xs ys\n-}\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Made the new demand analyser enter an absent arg \n-- Reason: it thought 'a' was unused in g.\n\nmodule Main where\n\n-- Strictness: SS(AL) -> T\nf True p@(x,y) = (p,y)\nf False p@(x,y) = f y p\n\n-- Easy to get the wrong strictness,\n-- by thinking 'a' is absent\ng True  a b = f False (a,b)\ng False a b = g b a b\n\nmain = print (g True 'a' True)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This showed up an \"entered-absent-arg\" error in 5.02.1\n\nmodule Main where\n\nis_volatile :: [Int] -> (String,Int) -> Int\nis_volatile [] (destVarName, destPtr)\n        = error (\"Variable not found: \" ++ \"(\" ++ (show destPtr) ++ \") \" ++ destVarName)\nis_volatile (a:allWrites) (destVarName, destPtr)\n  | a == destPtr    = a\n  | otherwise = is_volatile allWrites (destVarName, destPtr)\n\nmain = print (is_volatile [] (\"hello\",2))\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This module should run fine with an empty argument list\n-- But it won't if the strictness analyser thinks that 'len' is use\n-- strictly, which was the case in GHC 6.0\n\n-- See the io_hack_reqd in DmdAnal.lhs\n\nmodule Main where\n\nimport System.Environment\nimport System.Exit\n\nmain    = do\n            args <- getArgs\n            let len = read (head args) :: Int\n\n            (if null args && useLazily len\n                then putStrLn \"ok\" >> exitWith ExitSuccess\n                else return () )\n\n            print len\n\nuseLazily :: Int -> Bool\nuseLazily len = ([len,3,4] !! 1) == 3\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nf 0 = 0\nf x = x + g (x-1)\n\ng 0 = 0\ng x = x - f (x-1)\n\nmain = print (f 300)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule Main where\n\nimport Debug.Trace\n\ndata Machine = Machine (Int -> Machine) Int\n\nmain :: IO ()\nmain = (go 7 $ Machine (gstep (Array 99)) 8) `seq` return ()\n  where\n    go :: Int -> Machine -> Int\n    go 0 (Machine _ done) = done\n    go nq (Machine step _) = go (nq-1) $ step 0\n\ngstep :: Array Int -> Int -> Machine\ngstep m x = Machine (gstep m') (mindexA m)\n  where\n    !m' = adjustA x m\n\ndata Array a = Array a\n\nadjustA :: (Show a) => Int ->  Array a -> Array a\nadjustA i (Array t)\n  | i < 0 = undefined i -- not just undefined!\n  | otherwise = Array $ trace (\"adj \" ++ show t) $ t\n\nmindexA :: Array a -> a\nmindexA (Array v) = v\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -feager-blackholing #-}\n\nmodule Main where\n\n{-# NOINLINE foo #-}\nfoo :: Bool -> Int -> Int -> Int\nfoo True  _ x = 1\nfoo False _ x = x+1\n\n{-# NOINLINE bar #-}\nbar :: Int -> (Int,Int)\nbar x = let y1 = x * 2\n            y2 = x * 2\n        in (foo False y1 y2,foo False y2 y1)\n\nmain = print (fst p + snd p)\n  where\n    p = bar 3\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n   Test case for a problem where GHC had incorrect strictness\n   information for foreign calls with lifted arguments\n -}\n{-# OPTIONS_GHC -O0 #-}\nmodule Main where\n\nimport T11076A\nimport Control.Exception\nx :: Bool\nx = error \"OK: x has been forced\"\n\nmain :: IO ()\nmain = print (testBool x) `catch`\n          \\(ErrorCall e) -> putStrLn e -- x should be forced\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O #-}\n{-# LANGUAGE MagicHash,\n             ForeignFunctionInterface,\n             UnliftedFFITypes,\n             GHCForeignImportPrim,\n             BangPatterns\n  #-}\nmodule T11076A where\n\nimport GHC.Exts\nimport Unsafe.Coerce\n\n{-\n   If the demand type for the foreign call argument is incorrectly strict,\n   the bang pattern can be optimized out\n -}\ntestBool :: Bool -> Int\ntestBool !x = I# (cmm_testPrim (unsafeCoerce x))\n{-# INLINE testBool #-}\n\nforeign import prim \"testPrim\" cmm_testPrim :: Any -> Int#\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\nimport Control.Monad\nimport Control.Exception\nimport Control.Monad.Trans.Cont\nimport GHC.Exts\n\n\ntype RAW a = ContT () IO a\n\n-- See https://ghc.haskell.org/trac/ghc/ticket/11555\ncatchSafe1, catchSafe2 :: IO a -> (SomeException -> IO a) -> IO a\ncatchSafe1 a b = lazy a `catch` b\ncatchSafe2 a b = join (evaluate a) `catch` b\n\n-- | Run and then call a continuation.\nrunRAW1, runRAW2 :: RAW a -> (Either SomeException a -> IO ()) -> IO ()\nrunRAW1 m k = m `runContT` (k . Right) `catchSafe1` \\e -> k $ Left e\nrunRAW2 m k = m `runContT` (k . Right) `catchSafe2` \\e -> k $ Left e\n\n{-# NOINLINE run1 #-}\nrun1 :: RAW ()-> IO ()\nrun1 rs = do\n    runRAW1 rs $ \\x -> case x of\n        Left e -> putStrLn \"CAUGHT\"\n        Right x -> return x\n\n{-# NOINLINE run2 #-}\nrun2 :: RAW ()-> IO ()\nrun2 rs = do\n    runRAW2 rs $ \\x -> case x of\n        Left e -> putStrLn \"CAUGHT\"\n        Right x -> return x\n\nmain :: IO ()\nmain = do\n    run1 $ error \"MISSED\"\n    run2 $ error \"MISSED\"\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- If care is not taken when aborting a fixed-point iteration, wrong absentness\n-- information escapes\n\n-- Needs to be a product type\ndata Stream = S Int Stream\n\nbar :: Int -> Stream -> Int\nbar n s = foo n s\n  where\n    foo :: Int -> Stream -> Int\n    foo 0 (S n s) = 0\n    foo i (S n s) = n + foo (i-1) s\n{-# NOINLINE bar #-}\n\n\nbaz :: Int -> Stream -> Int\nbaz 0 not_absent = 0\nbaz 1 not_absent = baz 2 not_absent\nbaz x not_absent = bar 1000 arg\n  where\n    arg = S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ not_absent\n\nbamf x = baz x (S x (error \"This is good!\"))\n{-# NOINLINE bamf #-}\n\nmain :: IO ()\nmain = bamf 10 `seq` return ()\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Needs to be a product type\ndata Stream = S Int Stream\n\n-- a is wrongly recorded abstent if the non-lazy-fv from foo are thrown away.\nbar :: Int -> Int -> Stream -> Int\nbar a n s = foo n s\n  where\n    -- Non terminating local rec, strict in a\n    foo :: Int -> Stream -> Int\n    foo 0 (S n s) = a\n    foo i (S n s) = a `seq` n + foo (i-1) s\n{-# NOINLINE bar #-}\n\n\nbaz :: Int -> Int -> Int\nbaz 0 not_absent = 0\nbaz 1 not_absent = baz 2 not_absent\nbaz x not_absent = bar not_absent 1000 arg\n  where\n    arg = S 1 arg\n\nbamf x = baz x (error \"This is good!\")\n{-# NOINLINE bamf #-}\n\n\nmain :: IO ()\nmain = bamf 10 `seq` return ()\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Control.Exception\n\n-- This should result in the \"What\" exception, not the undefined.\n{-# NOINLINE f #-}\nf :: Int -> Int -> IO Int\nf x y | x>0       = throwIO (userError \"What\")\n      | y>0       = return 1\n      | otherwise = return 2\n\nmain = f 2 undefined >>= print\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Control.Concurrent.STM\nimport Control.Concurrent.STM.TVar\n\nchkLoop :: TVar String -> STM ()\nchkLoop v = do\n  val <- readTVar v\n  if (length val == 2) then retry else return ()\n\nmain :: IO ()\nmain = do\n  v <- newTVarIO \"hi\"\n  atomically $ do\n    chkLoop v `orElse` return ()\n    error \"you're expected to see this\"\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport T14285a\nimport Prelude hiding (null)\n\nmain :: IO ()\nmain = do\n  let args = \"hw\"\n  print $ null $ pre_images 'a' (Rel (fromList [('a',sfromList args)]) (fromList [('b',sfromList args)]))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14285a where\n\nimport qualified Data.Foldable as F\nimport qualified Data.IntMap as IM\nimport qualified Data.IntSet as IS\nimport Prelude hiding (null)\n\ndata Set k = Set IS.IntSet\n\nempty = Set IS.empty\n\n\nnull (Set a) = IS.null a\n\nsfromList :: (Enum a, Foldable c) => c a -> Set a\nsfromList xs = Set $ IS.fromList $ Prelude.map fromEnum $ F.toList xs\n\n{-# inlineable fromList #-}\nfromList :: Enum k => [(k,v)] -> Map k v\nfromList kvs =\n  Map $ IM.fromList $ Prelude.map (\\(k,v) -> (fromEnum k, v)) kvs\n\n\nnewtype Map k v = Map { unMap :: (IM.IntMap v) } deriving (Eq, Ord)\n\n{-# inlineable findWithDefault #-}\nfindWithDefault d k (Map m) = IM.findWithDefault d (fromEnum k) m\n\ndata Rel a b = Rel !(Map a (Set b)) !(Map b (Set a))\n\n{-# INLINEABLE images #-}\nimages x (Rel f b) = findWithDefault empty x f\n{-# INLINEABLE pre_images #-}\npre_images x rel = images x $ mirrorRel rel\n{-# INLINEABLE mirrorRel #-}\nmirrorRel :: Rel a b -> Rel b a\nmirrorRel (Rel f g) = Rel g f\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\nmodule Main (main) where\n\nmain :: IO ()\nmain = r `seq` return ()\n\nr :: Rec\nr = Rec{ a = error \"xxx\", b = 3, c = True }\n\nclass C t\ninstance C Bool\n\ndata Rec = forall t. C t => Rec\n  { a :: ()\n  , b :: !Int\n  , c :: t\n  }\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import System.IO.Unsafe (unsafePerformIO)\n\ndata T = T !Bool\ndata Box a = Box a\n\nf :: Int -> T -> Box Bool\nf n t\n  | n <= 0 = case t of\n      T b -> Box b\n  | otherwise = f (n-2) t\n\nf1 :: Int -> Bool -> Box Bool\nf1 n t\n  | n <= 0 = f (-n) $! T t\n  | otherwise = f1 (n-2) t\n\ng :: Int -> Bool\ng k = if k <= 0\n        then unsafePerformIO (putStrLn \"Evaluated True\" >> return True)\n        else unsafePerformIO (putStrLn \"Evaluated False\" >> return False)\n{-# NOINLINE g #-}\n\nmain :: IO ()\nmain = case f1 4 (g 0) of\n    Box _ -> return ()\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\ndata X = X ()\n\n{-# NOINLINE newX #-}\nnewX :: () -> IO X\nnewX n = do\n    let {-# NOINLINE value #-}\n        value = n\n    return (X value)\n\nmain = do\n    x <- newX (error \"Why?\")\n    case x of\n        X _ -> return ()\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns, BangPatterns #-}\nmodule Main where\n\nimport Control.Exception\nmain :: IO ()\nmain = do print (f False)\n          print (f True)\n          print (g undefined) `catchE` \\_ -> putStrLn \"g exception\"\n          print (h undefined) `catchE` \\_ -> putStrLn \"h exception\"\n          print (i undefined) `catchE` \\_ -> putStrLn \"i exception\"\n          putStrLn \"Done\"\n\ncatchE :: IO a -> (ErrorCall -> IO a) -> IO a\ncatchE = catch\n\nf :: Bool -> String\nf (view -> Nothing) = \"Got Nothing\"\nf (view -> Just x)  = \"Got Just \" ++ show x\n\ng :: Bool -> String\ng (view -> x) = \"g Got something\"\n\nh :: Bool -> String\nh (view -> !x) = \"h Got something\"\n\ni :: Bool -> String\ni !(view -> x) = \"i Got something\"\n\nview :: Bool -> Maybe Int\nview False = Nothing\nview True = Just 5\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nmodule Main where\nimport GHC.Exts\n\nf :: (() -> (# Int#, () #)) -> ()\n{-# NOINLINE f #-}\n-- Strictness signature was (7.8.2)\n--    <C(S(LS)), 1*C1(U(A,1*U()))>\n-- I.e. calls k, but discards first component of result\nf k = case k () of (# _, r #) -> r\n\ng :: Int -> ()\ng y = f (\\n -> (# case y of I# y2 -> h (h (h (h (h (h (h y2)))))), n #))\n   -- RHS is big enough to force worker/wrapper\n\n{-# NOINLINE h #-}\nh :: Int# -> Int#\nh n = n +# 1#\n\nmain = print (g 1)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, FlexibleInstances #-}\n{-# OPTIONS_GHC -funbox-strict-fields #-}\n\nmodule Arr (\n        Array(..), (!!!), array\n    ) where\n\nimport GHC.Num\nimport GHC.ST\nimport GHC.Base\nimport Good\n\ndata Array e = Array !Int !Int Int (Array# e)\n\narray :: (Int,Int) -> [(Int, e)] -> Array e\narray (l,u) ies\n    = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]\n\nunsafeArray :: (Int,Int) -> [(Int, e)] -> Array e\nunsafeArray b ies = unsafeArray' b (rangeSize b) ies\n\nunsafeArray' :: (Int,Int) -> Int -> [(Int, e)] -> Array e\nunsafeArray' (l,u) n@(I# n#) ies =\n  if n == 0 then error \"aa\" else runST (ST $ \\s1# ->\n    case newArray# n# arrEleBottom s1# of\n        (# s2#, marr# #) ->\n            foldr (fill marr#) (done l u n marr#) ies s2#)\n\n{-# NOINLINE arrEleBottom #-}\narrEleBottom :: a\narrEleBottom = error \"(Array.!): undefined array element\"\n\nunsafeAt :: Array e -> Int -> e\nunsafeAt (Array _ _ _ arr#) (I# i#) =\n    case indexArray# arr# i# of (# e #) -> e\n\nfill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a\nfill marr# (I# i#, e) next \n = \\s1# -> case writeArray# marr# i# e s1# of \n             s2# -> next s2# \n\ndone :: Int -> Int -> Int -> MutableArray# s e -> STRep s (Array e)\ndone l u n marr# \n  = \\s1# -> case unsafeFreezeArray# marr# s1# of\n              (# s2#, arr# #) -> (# s2#, Array l u n arr# #)\n\ninstance Eq (Array e) where\n    (Array l1 _ _ _) == (Array l2 _ _ _) = l1 == l2\n\ninstance Ord (Array e) where\n    compare (Array l1 _ _ _) (Array l2 _ _ _) = compare l1 l2\n\n{-# INLINE index #-}\nindex               :: (Int,Int) -> Int -> Int\nindex (m,n) i | m <= i && i <= n =  i - m\n              | otherwise   =  error \"index out of range\"\n\nrangeSize           :: (Int,Int) -> Int\nrangeSize (l,h) = h - l + 1\n\n\n{-# INLINE (!!!) #-}\n(!!!) :: Array e -> Int -> e\narr@(Array l u _ _) !!! i = unsafeAt arr $ index (l,u) i\n\ninstance Good (Array Int) where\n    isGood (Array _ _ n _) = 0 < n\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Base (\n              Map(..)\n            , lookup\n            , empty\n            , insert\n            ) where\n\nimport Prelude hiding (lookup)\nimport Good\n\nempty :: Map k a\nempty = Tip\n\ndata Map k a  = Bin !k a !(Map k a) | Tip\n\ninsert :: Ord k => k -> a -> Map k a -> Map k a\ninsert = go\n  where\n    go :: Ord k => k -> a -> Map k a -> Map k a\n    go kx x Tip = singleton kx x\n    go kx x (Bin ky y r) =\n        case compare kx ky of\n            EQ -> Bin kx x r\n            LT -> Bin ky y (go kx x r)\n            GT -> Bin ky y (go kx x r)\n{-# INLINABLE insert #-}\n\nsingleton :: k -> a -> Map k a\nsingleton k x = Bin k x Tip\n\nlookup :: Eq k => k -> Map k a -> Maybe a\nlookup = go\n  where\n    go x _ | x `seq` False = undefined\n    go _ Tip = Nothing\n    go k (Bin kx x r) = case k == kx of\n      False -> go k r\n      True -> Just x\n{-# INLINABLE lookup #-}\n\ninstance Good k => Good (Map k a) where\n  isGood Tip = True\n  isGood (Bin k _ r) = isGood k && isGood r\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module BuggyOpt\n    (\n      addSequence, -- induces inliner bug, but not used anywhere\n    ) where\n\nimport M\nimport Prelude hiding (lookup)\n\naddSequence :: Map (Array Int) Int -> Map (Array Int) Int\naddSequence seqs =\n  seq (isJust (lookup seq_ seqs)) (insert seq_ 5 seqs)\n\nseq_ = array (2,2) [ (2,3)]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Good (Good(..)) where\n\nclass Good a where\n  isGood :: a -> Bool\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M (Array, (!!!), array, isJust, Map, lookup, insert, empty) where\n\nimport Arr (Array, (!!!), array)\nimport Base (Map, lookup, insert, empty)\nimport Prelude hiding (lookup)\n\nisJust :: Maybe a -> Bool\nisJust Nothing = False\nisJust (Just _) = True\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport BuggyOpt() -- bug inducer!\n\nimport Prelude hiding (lookup)\nimport Good\nimport M\n\nmkLin :: Array Int -> Map (Array Int) Int\nmkLin mseqs =\n   (isJust (lookup mseqs empty)) `seq` (insert mseqs 1 empty)\n\nmain :: IO ()\nmain = print $ isGood $ mkLin (array (1,1) [ (1,array (3,3) [(3, 42)]) ]!!!1)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module BottomFromInnerLambda where\n\nexpensive :: Int -> Int\nexpensive 0 = 0\nexpensive n = expensive n\n{-# NOINLINE expensive #-}\n\n-- We could be saying \"<S(S),1*(U(U))><L,A>b\"\n-- but we are saying \"<S(S),1*(U(U))>\"\n-- We should not be saying \"<S(S),1*(U(U))>b\"\nf :: Int -> Int -> Int\nf x = expensive x `seq` (\\y -> error (show y))\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CaseBinderCPR where\n\n-- This example, taken from nofib's transform (and heavily reduced) ensures that\n-- CPR information is added to a case binder\n\nf_list_cmp::(t1 -> t1 -> Int) -> [t1] -> [t1] -> Int;\nf_list_cmp a_cmp [] []= 0\nf_list_cmp a_cmp [] a_ys= -1\nf_list_cmp a_cmp a_xs []= 1\nf_list_cmp a_cmp (a_x:a_xs) (a_y:a_ys)=\n    if r_order == 0\n    then f_list_cmp a_cmp a_xs a_ys\n    else r_order\n  where\n    r_order = a_cmp a_x a_y\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule DmdAnalGADTs where\n\n-- This tests the effect of different types in branches of a case\n\ndata D a where\n    A :: D Int\n    B :: D (Int -> Int)\n\nhasCPR :: Int\nhasCPR = 1\n\nhasStrSig :: Int -> Int\nhasStrSig x = x\n\ndiverges :: Int\ndiverges = diverges\n\n-- The result should not have a CPR property\n-- Because we are lub\u00e2\u20ac\u2122ing \"m\" and \"<S,U>m\" in the case expression.\nf :: D x -> x\nf x = case x of\n    A -> hasCPR\n    B -> hasStrSig\n\n-- This should have the CPR property\nf' :: D Int -> Int\nf' x = case x of\n    A -> hasCPR\n\n-- The result should not be diverging, because one branch is terminating.\n-- It should also put a strict, but not hyperstrict demand on x\ng :: D x -> x\ng x = case x of\n    A -> diverges\n    B -> \\_ -> diverges\n\n\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module FacState where\n\n\nfac :: Int -> a ->  (a, Int)\nfac n s | n < 2     = (s,1)\n        | otherwise = case  fac (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'')\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HyperStrUse where\n\nf :: (Int, Int) -> Bool -> Int\nf (x,y) True = error (show x)\nf (x,y) False = x +1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Just an example on how to create tests that test the strictness analyzer\n\nmodule StrAnalExample where\n\nfoo x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12370 where\n\nfoo :: (Int, Int) -> Int\nfoo (x,y) = x + y\n{-# NOINLINE foo #-}\n\n-- If the p is processed by LetUp, then we get nice use-once demands on n and m\nbar n m =\n    let p = (n,m)\n        {-# NOINLINE p #-}\n    in foo p\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T8569 where\n\ndata Rep t where\n  Rint :: Rep Int\n  Rdata :: Rep i -> (t -> i) -> Rep t\n\naddUp :: Rep a -> a -> Int\naddUp Rint n  = n\naddUp (Rdata i f) x = addUp i (f x)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  MagicHash , UnboxedTuples #-}\n\nmodule T8598(fun) where\n\nimport GHC.Float (Double(..))\nimport GHC.Integer (decodeDoubleInteger, encodeDoubleInteger)\n\n-- Float.scaleFloat for Doubles, slightly simplified\nfun :: Double -> Double\nfun x | isFix           = x\n      | otherwise       = case x of\n          (D# x#) -> case decodeDoubleInteger x# of\n            (# i, j #) -> D# (encodeDoubleInteger i j)\n  where\n  isFix = isDoubleFinite x == 0\n\nforeign import ccall unsafe \"isDoubleFinite\" isDoubleFinite :: Double -> Int\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module UnsatFun where\n\n-- Here we test how a partially applied function (f x)\n-- with a bottom result affects the strictness signature\n-- when used strictly (g) and lazily (g')\n--\n-- In both cases, the parameter x should not be absent\n\nf :: Int -> Int -> Int\nf x y = error (show x)\n{-# NOINLINE f #-}\n\nh :: (Int -> Int) -> Int\nh f = f 2\n{-# NOINLINE h #-}\n\nh2 :: Bool -> (Int -> Int) -> Int\nh2 True  _ = 0\nh2 False f = f 2\n{-# NOINLINE h2 #-}\n\n-- Should get a bottom result\ng :: Int -> Int\ng x = let f' = f x\n      in h f'\n\n-- Should not get a bottom result\ng' :: Int -> Int\ng' x = let f' = f x\n       in h2 True f'\n\nh3 :: (Int -> Int -> Int) -> Int\nh3 f = f 2 `seq` 3\n{-# NOINLINE h3 #-}\n\n\n-- And here we check that the depth of the strictness\n-- of h is applied correctly.\ng3 :: Int -> Int\ng3 x = h3 (\\_ _ -> error (show x))\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds, DataKinds #-}\n\nmodule ClosedFam1 where\n\nimport Language.Haskell.TH\n\n$(do { decl <- [d| type family Foo a (b :: k) where\n                     Foo Int Bool = Int\n                     Foo a Maybe = Bool\n                     Foo b (x :: Bool) = Char |]\n     ; reportWarning (pprint decl)\n     ; return [] })\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds, TypeApplications #-}\n\nmodule ClosedFam2 where\n\nimport Language.Haskell.TH\n\n$( return [ ClosedTypeFamilyD\n              (TypeFamilyHead\n                (mkName \"Equals\")\n                [ KindedTV (mkName \"a\") (VarT (mkName \"k\"))\n                , KindedTV (mkName \"b\") (VarT (mkName \"k\")) ]\n                ( TyVarSig (KindedTV (mkName \"r\") (VarT (mkName \"k\"))))\n                Nothing)\n              [ TySynEqn Nothing\n                         (AppT (AppT (ConT (mkName \"Equals\")) (VarT (mkName \"a\")))\n                               (VarT (mkName \"a\")))\n                         (ConT (mkName \"Int\"))\n              , TySynEqn Nothing\n                         (AppT (AppT (ConT (mkName \"Equals\")) (VarT (mkName \"a\")))\n                               (VarT (mkName \"b\")))\n                         (ConT (mkName \"Bool\")) ] ])\n\na :: Equals b b\na = (5 :: Int)\n\nb :: Equals Int Bool\nb = False\n\n$( return [ ClosedTypeFamilyD\n               (TypeFamilyHead\n                (mkName \"Foo\")\n                [ KindedTV (mkName \"a\") (VarT (mkName \"k\"))]\n                (KindSig StarT ) Nothing )\n                [ TySynEqn Nothing\n                           (AppT (AppKindT (ConT (mkName \"Foo\")) StarT)\n                                 (VarT (mkName \"a\")))\n                           (ConT (mkName \"Int\"))\n                , TySynEqn Nothing\n                           (AppT (AppKindT (ConT (mkName \"Foo\")) (AppT (AppT ArrowT StarT) (StarT)))\n                                 (VarT (mkName \"a\")))\n                           (ConT (mkName \"Bool\")) ] ])\nc :: Foo Int\nc = 5\n\nd :: Foo Bool\nd = 6\n\ne :: Foo Maybe\ne = False\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-missing-fields #-}\nmodule T10047 where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\nn = QuasiQuoter { quoteExp = dyn }\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T10267 where\n\nimport Language.Haskell.TH\nimport T10267a\n\n[d| i :: a -> a\n    i = _foo\n\n    j :: a -> a\n    j x = _ |]\n\n$(return [\n   SigD (mkName \"k\")\n        (ForallT [PlainTV (mkName \"a\")]\n                 []\n                 (AppT (AppT ArrowT (VarT (mkName \"a\"))) (VarT (mkName \"a\"))))\n , FunD (mkName \"k\")\n        [Clause [] (NormalB (UnboundVarE (mkName \"_foo\"))) []]\n ])\n\n$(return [\n   SigD (mkName \"l\")\n        (ForallT [PlainTV (mkName \"a\")]\n                 []\n                 (AppT (AppT ArrowT (VarT (mkName \"a\"))) (VarT (mkName \"a\"))))\n , FunD (mkName \"l\")\n        [Clause [VarP (mkName \"x\")] (NormalB (UnboundVarE (mkName \"_\"))) []]\n ])\n\nfoo :: a -> a\nfoo x = $varX\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T10267a where\n\nimport Language.Haskell.TH\n\nvarX :: Q Exp\nvarX = [| x |]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10279 where\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\n-- NB: rts-1.0 is used here because it doesn't change.\n-- You do need to pick the right version number, otherwise the\n-- error message doesn't recognize it as a source package ID,\n-- (This is OK,  since it will look obviously wrong when they\n-- try to find the package in their package database.)\nblah = $(conE (Name (mkOccName \"Foo\") (NameG VarName (mkPkgName \"rts-1.0\") (mkModName \"A\"))))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilies #-}\n\nmodule T10306 where\n\nimport Language.Haskell.TH\nimport GHC.TypeLits\n\n-- Attempting to reify a built-in type family like (+) previously\n-- caused a crash, because it has no equations\n$(do x <- reify ''(+)\n     case x of\n       FamilyI (ClosedTypeFamilyD _ []) _ -> return []\n       _ -> error $ show x\n )\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T10596 where\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\nimport System.IO\n\ndo\n  putQ (100 :: Int)\n  x <- (getQ :: Q (Maybe Int))\n\n  -- It should print \"Just 100\"\n  runIO $ print x\n  runIO $ hFlush stdout\n  return []\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE DerivingStrategies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T10598_TH where\n\nimport Language.Haskell.TH\n\nclass C a\ninstance C Int\n\nclass C a => D a\ninstance D Int\n\n{-\nnewtype Foo = MkFoo Int\n  deriving stock    Eq\n  deriving anyclass C\n  deriving newtype  Read\n\nderiving stock    instance Ord  Foo\nderiving anyclass instance D    Foo\nderiving newtype  instance Show Foo\n-}\n\n$(do fooDataName  <- newName \"Foo\"\n     mkFooConName <- newName \"MkFoo\"\n     let fooType = conT fooDataName\n     sequence [ newtypeD (cxt []) fooDataName [] Nothing\n                (normalC mkFooConName\n                  [ bangType (bang noSourceUnpackedness noSourceStrictness)\n                             [t| Int |] ])\n                [ derivClause (Just StockStrategy)    [ [t| Eq   |] ]\n                , derivClause (Just AnyclassStrategy) [ [t| C    |] ]\n                , derivClause (Just NewtypeStrategy)  [ [t| Read |] ] ]\n             , standaloneDerivWithStrategyD (Just StockStrategy)\n                 (cxt []) [t| Ord $(fooType) |]\n             , standaloneDerivWithStrategyD (Just AnyclassStrategy)\n                 (cxt []) [t| D $(fooType) |]\n             , standaloneDerivWithStrategyD (Just NewtypeStrategy)\n                 (cxt []) [t| Show $(fooType) |] ])\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T10603 where\n\nmain = print $ $([| case Just 'a' of Just a -> Just ((\\x -> x) a) |])\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = do\n    putStrLn $([| 'a'#   |] >>= stringE . show)\n    putStrLn $([| \"abc\"# |] >>= stringE . show)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GHCForeignImportPrim, UnliftedFFITypes, QuasiQuotes, MagicHash #-}\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\nimport GHC.Exts\n\n{-\n   the prim and javascript calling conventions do not support\n   headers and the static keyword.\n-}\n\n-- check that quasiquoting roundtrips successfully and that the declaration\n-- does not include the static keyword\ntest1 :: String\ntest1 = $(do (ds@[ForeignD (ImportF _ _ p _ _)]) <-\n               [d| foreign import prim \"test1\" cmm_test1 :: Int# -> Int# |]\n             addTopDecls ds\n             case p of\n              \"test1\" -> return (LitE . stringL $ p)\n              _       -> error $ \"unexpected value: \" ++ show p\n         )\n\n-- check that constructed prim imports with the static keyword are rejected\ntest2 :: String\ntest2 = $(do t <- [t| Int# -> Int# |]\n             cmm_test2 <- newName \"cmm_test2\"\n             addTopDecls\n               [ForeignD (ImportF Prim Safe \"static test2\" cmm_test2 t)]\n             [| test1 |]\n         )\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\ndata T = T {-# UNPACK #-} !Int !Int Int\n\n$(return [])\n\nmain :: IO ()\nmain = putStrLn $(reifyConStrictness 'T >>= stringE . show)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\ndata T = T {-# UNPACK #-} !Int !Int Int\n\n$(return [])\n\nmain :: IO ()\nmain = putStrLn $(reifyConStrictness 'T >>= stringE . show)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\ndata T = T {-# UNPACK #-} !Int !Int Int\n\n$(return [])\n\nmain :: IO ()\nmain = putStrLn $(reifyConStrictness 'T >>= stringE . show)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StrictData, TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\nimport T10697_sourceUtil\n\n$([d|data A1 = A1                   Int {- No unpackedness, no strictness -}|])\n$([d|data A2 = A2                  !Int {- No unpackedness, strict        -}|])\n$([d|data A3 = A3                  ~Int {- No unpackedness, lazy          -}|])\n$([d|data A4 = A4 {-# NOUNPACK #-}  Int {- NOUNPACK, no strictness        -}|])\n$([d|data A5 = A5 {-# NOUNPACK #-} !Int {- NOUNPACK, strict               -}|])\n$([d|data A6 = A6 {-# NOUNPACK #-} ~Int {- NOUNPACK, lazy                 -}|])\n$([d|data A7 = A7 {-#   UNPACK #-}  Int {- UNPACK, no strictness          -}|])\n$([d|data A8 = A8 {-#   UNPACK #-} !Int {- UNPACK, strict                 -}|])\n$([d|data A9 = A9 {-#   UNPACK #-} ~Int {- UNPACK, lazy                   -}|])\n\n$(do b1 <- newName \"B1\"\n     b2 <- newName \"B2\"\n     b3 <- newName \"B3\"\n     b4 <- newName \"B4\"\n     b5 <- newName \"B5\"\n     b6 <- newName \"B6\"\n     b7 <- newName \"B7\"\n     b8 <- newName \"B8\"\n     b9 <- newName \"B9\"\n     c1 <- newName \"C1\"\n     c2 <- newName \"C2\"\n     c3 <- newName \"C3\"\n     c4 <- newName \"C4\"\n     c5 <- newName \"C5\"\n     c6 <- newName \"C6\"\n     c7 <- newName \"C7\"\n     c8 <- newName \"C8\"\n     c9 <- newName \"C9\"\n\n     d1 <- makeSimpleDatatype b1 c1 noSourceUnpackedness noSourceStrictness\n     d2 <- makeSimpleDatatype b2 c2 noSourceUnpackedness sourceStrict\n     d3 <- makeSimpleDatatype b3 c3 noSourceUnpackedness sourceLazy\n     d4 <- makeSimpleDatatype b4 c4 sourceNoUnpack       noSourceStrictness\n     d5 <- makeSimpleDatatype b5 c5 sourceNoUnpack       sourceStrict\n     d6 <- makeSimpleDatatype b6 c6 sourceNoUnpack       sourceLazy\n     d7 <- makeSimpleDatatype b7 c7 sourceUnpack         noSourceStrictness\n     d8 <- makeSimpleDatatype b8 c8 sourceUnpack         sourceStrict\n     d9 <- makeSimpleDatatype b9 c9 sourceUnpack         sourceLazy\n     return [d1, d2, d3, d4, d5, d6, d7, d8, d9])\n\nmain :: IO ()\nmain = mapM_ print [ $(checkBang ''E1 noSourceUnpackedness noSourceStrictness)\n                   , $(checkBang ''E2 noSourceUnpackedness sourceStrict)\n                   , $(checkBang ''E3 noSourceUnpackedness sourceLazy)\n                   , $(checkBang ''E4 sourceNoUnpack       noSourceStrictness)\n                   , $(checkBang ''E5 sourceNoUnpack       sourceStrict)\n                   , $(checkBang ''E6 sourceNoUnpack       sourceLazy)\n                   , $(checkBang ''E7 sourceUnpack         noSourceStrictness)\n                   , $(checkBang ''E8 sourceUnpack         sourceStrict)\n                   , $(checkBang ''E9 sourceUnpack         sourceLazy)\n                   ]\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StrictData, TemplateHaskell #-}\nmodule T10697_sourceUtil where\n\nimport Language.Haskell.TH\n\nmakeSimpleDatatype :: Name\n                   -> Name\n                   -> SourceUnpackednessQ\n                   -> SourceStrictnessQ\n                   -> Q Dec\nmakeSimpleDatatype tyName conName srcUpk srcStr =\n  dataD (cxt []) tyName [] Nothing [normalC conName\n    [bangType (bang srcUpk srcStr) (conT ''Int)]] []\n\ncheckBang :: Name\n          -> SourceUnpackednessQ\n          -> SourceStrictnessQ\n          -> ExpQ\ncheckBang n srcUpk1 srcStr1 = do\n  TyConI (DataD _ _ _ _ [NormalC _ [(Bang srcUpk2 srcStr2, _)]] _) <- reify n\n  srcUpk1' <- srcUpk1\n  srcStr1' <- srcStr1\n  if srcUpk1' == srcUpk2 && srcStr1' == srcStr2\n    then [| True |]\n    else [| False |]\n\ndata E1 = E1                   Int -- No unpackedness, no strictness\ndata E2 = E2                  !Int -- No unpackedness, strict\ndata E3 = E3                  ~Int -- No unpackedness, lazy\ndata E4 = E4 {-# NOUNPACK #-}  Int -- NOUNPACK, no strictness\ndata E5 = E5 {-# NOUNPACK #-} !Int -- NOUNPACK, strict\ndata E6 = E6 {-# NOUNPACK #-} ~Int -- NOUNPACK, lazy\ndata E7 = E7 {-#   UNPACK #-}  Int -- UNPACK, no strictness\ndata E8 = E8 {-#   UNPACK #-} !Int -- UNPACK, strict\ndata E9 = E9 {-#   UNPACK #-} ~Int -- UNPACK, lazy\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, TemplateHaskell #-}\nmodule Main where\n\nimport GHC.Exts\nimport T10704a\n\nmain :: IO ()\nmain = do\n  putStrLn $(fixityExp ''(->))\n  putStrLn $(fixityExp ''Show)\n  putStrLn $(fixityExp 'show)\n  putStrLn $(fixityExp '(+))\n  putStrLn $(fixityExp ''Int)\n  putStrLn $(fixityExp ''Item)\n  putStrLn $(fixityExp ''Char#)\n  putStrLn $(fixityExp 'Just)\n  putStrLn $(fixityExp 'seq)\n  putStrLn $(fixityExp '($))\n  putStrLn $(fixityExp ''(:=>))\n  putStrLn $(fixityExp ''(:+:))\n  putStrLn $(fixityExp ''(:*:))\n  putStrLn $(fixityExp ''(:%:))\n  putStrLn $(fixityExp ''(:?:))\n  putStrLn $(fixityExp ''(:@:))\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, TypeOperators #-}\nmodule T10704a where\n\nimport Language.Haskell.TH\n\ninfixl 1 :=>\ninfixl 2 :+:\ninfix  3 :*:\ninfix  4 :%:\ninfixr 5 :?:\ninfixr 6 :@:\n\nclass a :=> b\ntype a :+: b = Either a b\ndata a :*: b = a :*: b\nnewtype a :%: b = Percent (a, b)\ndata family a :?: b\ntype family a :@: b where a :@: b = Int\n\nfixityExp :: Name -> Q Exp\nfixityExp n = reifyFixity n >>= stringE . show\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = do\n  pprint <$> runQ [| do { let { }; return (); } |]             >>= putStrLn\n  pprint <$> runQ [| do { let { x = 5 }; return x; } |]        >>= putStrLn\n  pprint <$> runQ [| do { let { x = 5; y = 3 }; return x; } |] >>= putStrLn\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T10796a where\n\nimport Data.Ratio\nimport Data.Set (Set, fromList)\nimport Language.Haskell.TH.Syntax (liftData)\n\n-- Data instance with toConstr implemented using a variable,\n-- not a data constructor\nsplicedSet :: Set Char\nsplicedSet = $(liftData (fromList \"test\"))\n\n-- Infix data constructor\nsplicedRatio :: Ratio Int\nsplicedRatio = $(liftData (1 % 2 :: Ratio Int))\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T10796b where\n\nimport Data.Set (Set, fromList)\nimport Language.Haskell.TH.Quote (dataToPatQ)\n\nbadPattern :: Set Char -> Set Char\nbadPattern s@($(dataToPatQ (const Nothing) (fromList \"test\"))) = s\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}\n\nmodule T10810 where\n\n$([d| data Foo = (:!) |])\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilies #-}\n\nmodule Bug where\n\n$([d| class C a where\n        type F a\n        type F a = a |])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule T10819 where\n\nimport T10819_Lib\n\nimport Language.Haskell.TH.Syntax\n\nclass C a b | b -> a where\n  f :: b -> a\n\ndata D = X\n\ninstance C Int D where\n  f X = 2\n\n$(doSomeTH \"N\" (mkName \"D\")\n    [DerivClause Nothing [ConT (mkName \"C\") `AppT` ConT (mkName \"Int\")]])\n\nthing :: N\nthing = N X\n\nthing1 :: Int\nthing1 = f thing\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10819_Lib where\n\nimport Language.Haskell.TH.Syntax\n\ndoSomeTH s tp drv = return [NewtypeD [] n [] Nothing (NormalC n\n    [(Bang NoSourceUnpackedness NoSourceStrictness, ConT tp)]) drv]\n  where n = mkName s\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LiberalTypeSynonyms #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE MagicHash #-}\n\nmodule Main where\n\nimport Language.Haskell.TH.Syntax\nimport GHC.LanguageExtensions\n\nmain = do\n  print $(isExtEnabled Cpp                  >>= lift)\n  print $(isExtEnabled LiberalTypeSynonyms  >>= lift)\n  print $(isExtEnabled RankNTypes           >>= lift)\n  print $(isExtEnabled TypeSynonymInstances >>= lift)\n  print $(isExtEnabled MagicHash            >>= lift)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, GADTs, ExplicitForAll, KindSignatures,\n             TypeFamilies, DataKinds #-}\n\nmodule T10828 where\n\nimport Language.Haskell.TH hiding (Type)\nimport System.IO\nimport Data.Kind (Type)\n\n$( do { decl <- [d| data family D a :: Type -> Type\n                    data instance D Int Bool :: Type where\n                         DInt :: D Int Bool\n\n                    data E where\n                      MkE :: a -> E\n\n                    data Foo a b where\n                      MkFoo, MkFoo' :: a -> Foo a b\n\n                    newtype Bar :: Type -> Bool -> Type where\n                      MkBar :: a -> Bar a b\n                 |]\n\n      ; runIO $ putStrLn (pprint decl) >> hFlush stdout\n      ; return decl }\n )\n\n-- data T a :: Type where\n--    MkT :: a -> a -> T a\n--    MkC :: forall a b. (a ~ Int) => { foo :: a, bar :: b } -> T Int\n\n$( return\n   [ DataD [] (mkName \"T\")\n           [ PlainTV (mkName \"a\") ]\n           (Just StarT)\n           [ GadtC [(mkName \"MkT\")]\n                   [ ( Bang NoSourceUnpackedness NoSourceStrictness\n                     , VarT (mkName \"a\")\n                     )\n                   , ( Bang NoSourceUnpackedness NoSourceStrictness\n                     , VarT (mkName \"a\")\n                     )\n                   ]\n                   (AppT (ConT (mkName \"T\"))\n                         (VarT (mkName \"a\")))\n           , ForallC [PlainTV (mkName \"a\"), PlainTV (mkName \"b\")]\n                     [AppT (AppT EqualityT (VarT $ mkName \"a\"  ) )\n                                           (ConT $ mkName \"Int\") ] $\n             RecGadtC [(mkName \"MkC\")]\n                  [ ( mkName \"foo\"\n                    , Bang NoSourceUnpackedness NoSourceStrictness\n                    , VarT (mkName \"a\")\n                    )\n                  , ( mkName \"bar\"\n                    , Bang NoSourceUnpackedness NoSourceStrictness\n                    , VarT (mkName \"b\")\n                    )\n                  ]\n                  (AppT (ConT (mkName \"T\"))\n                        (ConT (mkName \"Int\"))) ]\n           [] ])\n\n$( do { -- test reification\n        TyConI dec <- runQ $ reify (mkName \"T\")\n      ; runIO $ putStrLn (pprint dec) >> hFlush stdout\n\n        -- test quoting\n      ; d <- runQ $ [d|\n             data T' a :: Type where\n                MkT' :: a -> a -> T' a\n                MkC' :: forall a b. (a ~ Int) => { foo :: a, bar :: b }\n                                              -> T' Int |]\n      ; runIO $ putStrLn (pprint d) >> hFlush stdout\n      ; return [] } )\n", "num_lines": 75}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, GADTs, ExplicitForAll, KindSignatures #-}\n\nmodule T10828a where\n\nimport Language.Haskell.TH\nimport System.IO\n\n-- attempting to place a kind signature on a H98 data type\n$( return\n   [ DataD [] (mkName \"T\")\n           [ PlainTV (mkName \"a\") ]\n           (Just StarT)\n           [ NormalC (mkName \"MkT\")\n                   [ ( Bang NoSourceUnpackedness NoSourceStrictness\n                     , VarT (mkName \"a\")\n                     )\n                   , ( Bang NoSourceUnpackedness NoSourceStrictness\n                     , VarT (mkName \"a\")\n                     )\n                   ]\n           ]\n           [] ])\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, GADTs, ExplicitForAll, KindSignatures #-}\n\nmodule T10828b where\n\nimport Language.Haskell.TH\nimport System.IO\n\n-- attempting to mix GADT and normal constructors\n$( return\n   [ DataD [] (mkName \"T\")\n           [ PlainTV (mkName \"a\") ]\n           (Just StarT)\n           [ NormalC\n               (mkName \"MkT\")\n               [ ( Bang NoSourceUnpackedness NoSourceStrictness\n                 , VarT (mkName \"a\")\n                 )\n               , ( Bang NoSourceUnpackedness NoSourceStrictness\n                 , VarT (mkName \"a\")\n                 )\n               ]\n           , ForallC [PlainTV (mkName \"a\")]\n                     [AppT (AppT EqualityT (VarT $ mkName \"a\"  ) )\n                                           (ConT $ mkName \"Int\") ] $\n             RecGadtC\n                 [ (mkName \"MkC\")]\n                 [ ( mkName \"foo\"\n                   , Bang NoSourceUnpackedness NoSourceStrictness\n                   , VarT (mkName \"a\")\n                   )\n                 , ( mkName \"bar\"\n                   , Bang NoSourceUnpackedness NoSourceStrictness\n                   , VarT (mkName \"b\")\n                   )\n                 ]\n                 (AppT (ConT (mkName \"T\"))\n                       (ConT (mkName \"Int\")))\n           ]\n           [] ])\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T10891 where\n\nimport Language.Haskell.TH hiding (Type)\nimport System.IO\nimport Data.Kind (Type)\n\nclass C a where\n  f :: a -> Int\n\nclass C' a where\n  type F a :: Type\n  type F a = a\n  f' :: a -> Int\n\nclass C'' a where\n  data Fd a :: Type\n\ninstance C' Int where\n  type F Int = Bool\n  f' = id\n\ninstance C'' Int where\n  data Fd Int = B Bool | C Char\n\n$(return [])\n\ntest :: ()\ntest =\n  $(let\n      display :: Name -> Q ()\n      display q = do\n        i <- reify q\n        runIO (hPutStrLn stderr (pprint i) >> hFlush stderr)\n    in do\n      display ''C\n      display ''C'\n      display ''C''\n      [| () |])\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T10945 where\n\nimport Language.Haskell.TH\n\n$$(return [\n   SigD (mkName \"m\")\n        (ForallT [PlainTV (mkName \"a\")]\n                 []\n                 (AppT (AppT ArrowT (VarT (mkName \"a\"))) (VarT (mkName \"a\"))))\n , FunD (mkName \"m\")\n        [Clause [VarP (mkName \"x\")] (NormalB (VarE (mkName \"x\"))) []]\n ])\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T10946 where\n\nimport Language.Haskell.TH\n\nm :: a -> a\nm x = $$([||_||])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T11046 where\n\nimport T11046_helper\nimport GHC.TypeLits\nimport Control.Monad(unless)\n\n$(check \"GHC.TypeLits.*\")\n$(check \"GHC.TypeLits.+\")\n$(check \"GHC.TypeLits.Nat\")\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TemplateHaskell #-}\nmodule T11046_helper where\nimport Language.Haskell.TH\n\ncheck :: String -> Q [Dec]\ncheck x = do mb <- lookupTypeName x\n             case mb of\n               Nothing -> fail \"Bug #11046 is still present.\"\n               Just _  -> return []\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T11145 where\n\ndata family Fuggle x y\n\n[d| data instance Fuggle Int (Maybe (a,b)) where\n      MkFuggle :: Fuggle Int (Maybe Bool) |]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TemplateHaskell #-}\nmodule T11341 where\n\nimport Language.Haskell.TH\nimport System.IO\n\ntype S1 = T1\ndata T1 a where\n  MkT1 :: S1 Int\n\ntype S2 a = T2\ndata T2 a where\n  MkT2 :: S2 Char Int\n\ntype Id a = a\ntype S3 a = T3\ndata T3 a where\n      MkT3 :: Id (S3 Char Int)\n\n$( do  -- test reification\n  { TyConI dec <- runQ $ reify (mkName \"T1\")\n  ; runIO $ putStrLn (pprint dec) >> hFlush stdout\n\n  ; TyConI dec <- runQ $ reify (mkName \"T2\")\n  ; runIO $ putStrLn (pprint dec) >> hFlush stdout\n\n  ; TyConI dec <- runQ $ reify (mkName \"T3\")\n  ; runIO $ putStrLn (pprint dec) >> hFlush stdout\n\n  ; return [] } )\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule Main (main) where\n\nimport Language.Haskell.TH\n\ninfixr 7 :***:\ndata GADT a where\n  Prefix  :: Int -> Int -> GADT Int\n  (:***:) :: Int -> Int -> GADT Int\n\n$(do gadtName   <- newName \"GADT2\"\n     prefixName <- newName \"Prefix2\"\n     infixName  <- newName \":****:\"\n     a          <- newName \"a\"\n     return [ DataD [] gadtName [KindedTV a StarT] Nothing\n              [ GadtC [prefixName]\n                [ (Bang NoSourceUnpackedness NoSourceStrictness,ConT ''Int)\n                , (Bang NoSourceUnpackedness NoSourceStrictness,ConT ''Int)\n                ] (AppT (ConT gadtName) (ConT ''Int))\n              , GadtC [infixName]\n                [ (Bang NoSourceUnpackedness NoSourceStrictness,ConT ''Int)\n                , (Bang NoSourceUnpackedness NoSourceStrictness,ConT ''Int)\n                ] (AppT (ConT gadtName) (ConT ''Int))\n              ] []\n            , InfixD (Fixity 7 InfixR) infixName\n            ])\n\n$(return [])\n\nderiving instance Show (GADT2 a)\n\nmain :: IO ()\nmain = do\n  -- Verify that infix GADT constructors reify correctly\n  putStrLn $(reify ''GADT   >>= stringE . pprint)\n  putStrLn $(reify '(:***:) >>= stringE . pprint)\n  -- Verify that reifyFixity returns something with (:***:)\n  -- (but not with Prefix, since it has no fixity declaration)\n  putStrLn $(reifyFixity 'Prefix  >>= stringE . show)\n  putStrLn $(reifyFixity '(:***:) >>= stringE . show)\n  -- Verify that spliced-in GADT infix constructors are actually infix\n  print (1 :****: 4)\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TemplateHaskell #-}\n\nmodule T11452 where\n\nimpred :: (forall a. a -> a) -> ()\nimpred = $$( [|| \\_ -> () ||] )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule Main where\n\nimport Data.Kind (Type)\nimport Language.Haskell.TH hiding (Type)\n\ntype Id1    a       = a\ntype Id2 k (a :: k) = a\ndata Proxy1 (a :: Id1      k) = Proxy1\ndata Proxy2 (a :: Id2 Type k) = Proxy2\n\n$(return [])\n\nmain :: IO ()\nmain = do\n  putStrLn $(reify ''Proxy1 >>= stringE . pprint)\n  putStrLn $(reify ''Proxy2 >>= stringE . pprint)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T11484 where\n\nimport Data.Kind\n\ntype TySyn (k :: Type) (a :: k) = ()\n\n$([d| type TySyn2 (k :: Type) (a :: k) = () |])\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule T11629 where\n\nimport Control.Monad\nimport Language.Haskell.TH\n\nclass C (a :: Bool)\nclass D (a :: (Bool, Bool))\nclass E (a :: [Bool])\n\ninstance C True\ninstance C 'False\n\ninstance D '(True, False)\ninstance D '(False, True)\n\ninstance E '[True, False]\ninstance E '[False, True]\n\ndo\n  let getType (InstanceD _ _ ty _) = ty\n      getType _                    = error \"getType: only defined for InstanceD\"\n\n      failMsg a ty1 ty2 = fail $ \"example \" ++ a\n        ++ \": ty1 /= ty2, where\\n ty1 = \"\n        ++ show ty1 ++ \"\\n ty2 = \" ++ show ty2\n\n      withoutSig (ForallT tvs cxt ty) = ForallT tvs cxt (withoutSig ty)\n      withoutSig (AppT ty1 ty2)       = AppT (withoutSig ty1) (withoutSig ty2)\n      withoutSig (SigT ty ki)         = withoutSig ty\n      withoutSig ty                   = ty\n\n  -- test #1: type quotations and reified types should agree.\n  ty1 <- [t| C True |]\n  ty2 <- [t| C 'False |]\n  ClassI _ insts <- reify ''C\n  let [ty1', ty2'] = map getType insts\n\n  when (ty1 /= ty1') $ failMsg \"A\" ty1 ty1'\n  when (ty2 /= ty2') $ failMsg \"B\" ty2 ty2'\n\n  -- test #2: type quotations and reified types should agree wrt\n  -- promoted tuples.\n  ty3 <- [t| D '(True, False) |]\n  ty4 <- [t| D (False, True)  |]\n  ClassI _ insts <- reify ''D\n  let [ty3', ty4'] = map (withoutSig . getType) insts\n\n  when (ty3 /= ty3') $ failMsg \"C\" ty3 ty3'\n  -- The following won't work. See https://ghc.haskell.org/trac/ghc/ticket/12853\n  -- when (ty4 /= ty4') $ failMsg \"D\" ty4 ty4'\n\n  -- test #3: type quotations and reified types should agree wrt to\n  -- promoted lists.\n  ty5 <- [t| E '[True, False] |]\n  ty6 <- [t| E [False, True]  |]\n\n  ClassI _ insts <- reify ''E\n  let [ty5', ty6'] = map (withoutSig . getType) insts\n\n  when (ty5 /= ty5') $ failMsg \"C\" ty5 ty5'\n  when (ty6 /= ty6') $ failMsg \"D\" ty6 ty6'\n\n  return []\n", "num_lines": 68}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE DuplicateRecordFields #-}\n\n\nmodule T11680 where\n\n\nimport qualified Data.List                  as List\nimport           Language.Haskell.TH.Syntax         (addTopDecls)\n\n\n------------------------------------------------------------------------------\n-- # No suggestions or exact match\nex1 :: Bool\nex1 = noMatches\n\n------------------------------------------------------------------------------\n-- # One suggestion (abcd), but no exact match\nex2 :: [a]\nex2 = abce\n\nabcd :: String\nabcd = \"abcd\"\n\n------------------------------------------------------------------------------\n-- # No suggestions, but an exact match after a splice\n-- # Exact match following a single-line splice\n-- # One splice separating use and binding\n-- # Annotation does not affect identification of top-level splice\nex3 :: Int\nex3 = foo\n\n------------------------------------------------------------------------------\n-- # Suggestions (bat, baz) and an exact match after a splice\n-- # Out-of-scope suggestion (bad) NOT reported\n-- # Exact match following a multi-line splice\n-- # Multiple splices separating use and binding\nex4 :: ()\nex4 = bar\n\nbat :: [Double]\nbat = [1.2, 3.4]\n\nbaz :: Bool\nbaz = True\n\n------------------------------------------------------------------------------\n-- # No suggestions, but an exact match IN a splice\nex5 :: [Double]\nex5 = ns\n\n------------------------------------------------------------------------------\n-- # Qualified suggestion and an exact local match after a splice\n-- # Inline bracket does not affect identification of top-level splice\nex6 = intercalate\n\n------------------------------------------------------------------------------\n-- # Qualified suggestion, but no exact local match\nex7 = nub\n\n------------------------------------------------------------------------------\n-- # No suggestions or matches for an out-of-scope duplicate field selector\nex8 :: Int\nex8 = x undefined\n\n------------------------------------------------------------------------------\n-- # Exact match to binding added by addTopDecls in next inter-splice group\nex9 :: ()\nex9 = cat\n\n----------------------------------------------------------------------------\n-- END OF INTER-SPLICE GROUP\n----------------------------------------------------------------------------\n\n------------------------------------------------------------------------------\n-- # In a splice, suggestions for out-of-scope variable (cab) dependent upon\n-- #   whether that variable is used in a binding added by addTopDecls:\n-- #   cat and cap both suggested for f's cab, only cap suggested for g's cab\n$(do\n    ds <- [d| f = cab\n              cat = ()\n            |]\n    addTopDecls ds\n    [d| g = cab\n        cap = True\n      |])\n\n------------------------------------------------------------------------------\n-- # Exact match to binding added by addTopDecls in current inter-splice group\nex10 :: ()\nex10 = cat\n\n----------------------------------------------------------------------------\n-- END OF INTER-SPLICE GROUP\n----------------------------------------------------------------------------\n$(return [])\n\n{-# ANN foo (Just \"hello\") #-}\nfoo :: Int\nfoo = 23\n\n\n----------------------------------------------------------------------------\n-- END OF INTER-SPLICE GROUP\n----------------------------------------------------------------------------\n[d| ms = 3 : ns :: [Int]\n    ns = 4 : ms\n  |]\n\nbar = [| 23.6 : bat |]\n\nbad = False\n\nintercalate = undefined\n\ndata D = D { x :: Int\n           , y :: Double\n           }\n\ndata E = E { x :: Bool\n           , y :: String\n           }\n", "num_lines": 123}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T11721_TH where\n\nimport Language.Haskell.TH\n\ndata T a where\n  MkT :: forall b a. b -> T a\n\n$(return [])\n\nmain :: IO ()\nmain = print\n  $(do let rightOrder :: [TyVarBndr] -> Bool\n           rightOrder [KindedTV b _, KindedTV a _]\n             = nameBase b == \"b\" && nameBase a == \"a\"\n           rightOrder _ = False\n\n       TyConI (DataD _ _ _ _\n                     [ForallC con_tvbs1 _ _] _) <- reify ''T\n       DataConI _ (ForallT con_tvbs2 _ _) _ <- reify 'MkT\n\n       if rightOrder con_tvbs1 && rightOrder con_tvbs2\n          then [| () |]\n          else fail \"T11721_TH failed\")\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T11797 where\n\nimport Language.Haskell.TH\nimport System.IO\n\n$(do dec <- [d| class Foo a where\n                  meth :: a -> b -> a |]\n     runIO $ do putStrLn $ pprint dec\n                hFlush stdout\n     return [] )\n\n-- the key bit is the forall b. in the type of the method\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T11809 where\n\n{- Test splicing in a data type with records -}\n\n[d|\n data D a = MkD { unD :: a }\n\n someD = MkD \"Hello\"\n getD  = unD someD   -- unD should resolve to the record selector above!\n |]\n\ngetD' = unD someD    -- dito here outside of the splice!\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T11941 where\n\nimport Data.Monoid\n\nconst (return []) $ mempty { getFrst = Just () }\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds\n             , TypeInType, TypeApplications, TypeFamilies  #-}\n\nmodule T12045TH1 where\nimport Data.Kind\nimport Language.Haskell.TH hiding (Type)\n\n$([d| type family F (a :: k) :: Type where\n                     F @Type Int = Bool\n                     F @(Type->Type) Maybe = Char |])\n\n\n$([d| data family D (a :: k) |])\n\n$([d| data instance D @Type a = DBool |])\n\n$([d| data instance D @(Type -> Type) b = DChar |])\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeApplications, PolyKinds\n             , TypeFamilies, DataKinds #-}\n\nmodule T12045TH2 where\n\nimport Data.Kind\nimport Language.Haskell.TH hiding (Type)\nimport System.IO\n\ntype family Foo (a :: k) :: Type where\n  Foo @Type a = Bool\n\ntype family Baz (a :: k)\ntype instance Baz @(Type->Type->Type) a = Char\n\n$( do FamilyI foo@(ClosedTypeFamilyD (TypeFamilyHead _ tvbs1 res1 m_kind1)\n                   [TySynEqn (Just bndrs1) (AppT _ lhs1) rhs1])\n              [] <- reify ''Foo\n      FamilyI baz@(OpenTypeFamilyD (TypeFamilyHead _ tvbs2 res2 m_kind2))\n              [inst@(TySynInstD (TySynEqn (Just bndrs2) (AppT _ lhs2) rhs2))] <- reify ''Baz\n      runIO $ putStrLn $ pprint foo\n      runIO $ putStrLn $ pprint baz\n      runIO $ putStrLn $ pprint inst\n      runIO $ hFlush stdout\n      return [ ClosedTypeFamilyD\n                 (TypeFamilyHead (mkName \"Foo'\") tvbs1 res1 m_kind1)\n                 [TySynEqn (Just bndrs1) (AppT (ConT (mkName \"Foo'\")) lhs1) rhs1]\n             , OpenTypeFamilyD\n                 (TypeFamilyHead (mkName \"Baz'\") tvbs2 res2 m_kind2)\n             , TySynInstD (TySynEqn (Just bndrs2) (AppT (ConT (mkName \"Baz'\")) lhs2) rhs2)] )\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TemplateHaskell #-}\n{-# Language DisambiguateRecordFields #-}\n\nmodule T12130 where\n\nimport T12130a hiding (Block)\n\nb = $(block)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T12130a where\n\nimport Language.Haskell.TH\n\ndata Block = Block\n    { blockSelector :: ()\n    }\n\nblock :: Q Exp\nblock =\n    [| Block {\n         -- Using record syntax is necessary to trigger the bug.\n         blockSelector = ()\n       }\n    |]\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T12387 where\n\nimport Language.Haskell.TH.Lib\n\ndata Foo = Foo\n\n$(do d <- instanceD (cxt []) (conT ''Eq `appT` conT ''Foo)\n            [funD 'compare [clause [] (normalB $ varE 'undefined) []]]\n     return [d])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedTuples #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\ndata T = T (# Int, Int #)\n\n$(return [])\n\nmain :: IO ()\nmain = putStrLn $(reify ''T >>= stringE . pprint)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedTuples #-}\nmodule T12407 where\n\nimport Language.Haskell.TH.Lib\nimport Language.Haskell.TH.Syntax\n\n$(do let ubxTup = conT (unboxedTupleTypeName 2) `appT` conT ''Int\n                                                `appT` conT ''Int\n     x <- newName \"x\"\n     y <- newName \"y\"\n\n     [d| f :: $(ubxTup) -> $(ubxTup)\n         f $(conP (unboxedTupleDataName 2) [varP x, varP y])\n             = $(conE (unboxedTupleDataName 2) `appE` varE x\n                                               `appE` varE y)\n      |])\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T12411 where\n\npure @Q []\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedSums #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\ndata T = T (# Int | Char #)\n\n$(return [])\n\nmain :: IO ()\nmain = putStrLn $(reify ''T >>= stringE . show)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedSums #-}\n-- Essentially the same as TH_repUnboxedTuples, but for unboxed sums\nmodule Main where\n\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = case bar () of\n       (# a |   #) -> print a\n       (#   | b #) -> print b\n\nbar :: () -> (# String | Int #)\nbar () = $( do e <- [| case (# 'b' | #) of\n                        (# 'a' |   #) -> (# \"One\"   |   #)\n                        (# 'b' |   #) -> (#         | 2 #)\n                        (# _   |   #) -> (# \"Three\" |   #)\n                        (#     | _ #) -> (#         | 4 #)\n                     |]\n               return e )\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedSums #-}\nmodule T12478_3 where\n\nimport Language.Haskell.TH\n\n$(do let ubxSum = unboxedSumT 2 `appT` conT ''Int `appT` conT ''Int\n     x <- newName \"x\"\n     y <- newName \"y\"\n\n     [d| swap :: $(ubxSum) -> $(ubxSum)\n         swap $(unboxedSumP (varP x) 1 2) = $(unboxedSumE (varE x) 2 2)\n         swap $(unboxedSumP (varP y) 2 2) = $(unboxedSumE (varE y) 1 2)\n      |])\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedSums #-}\nmodule T12478_4 where\n\nimport Language.Haskell.TH\n\nf :: $(unboxedSumT 1 `appT` conT ''()) -> Int\nf _ = 42\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedSums #-}\nmodule T12478_5 where\n\nimport Language.Haskell.TH\n\nfoo :: $(conT (unboxedSumTypeName 2) `appT` conT ''() `appT` conT ''())\n    -> $(conT (unboxedSumTypeName 2) `appT` conT ''() `appT` conT ''())\nfoo $(conP (unboxedSumDataName 1 2) [conP '() []])\n  = $(conE (unboxedSumDataName 2 2) `appE` conE '())\nfoo $(conP (unboxedSumDataName 2 2) [conP '() []])\n  = $(conE (unboxedSumDataName 2 2) `appE` conE '())\n\nfoo2 :: (# () | () #)\n     -> $(conT (unboxedSumTypeName 2) `appT` conT ''() `appT` conT ''())\nfoo2 (# () | #) = $(conE (unboxedSumDataName 2 2) `appE` conE '())\nfoo2 $(conP (unboxedSumDataName 2 2) [conP '() []]) = (# | () #)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T12503 where\n\nimport Language.Haskell.TH\n\ndata T1 k\nclass C1 a\n\n$(do TyConI (DataD [] tName [ KindedTV kName kKind] _ _ _)\n       <- reify ''T1\n     d <- instanceD (cxt [])\n                    (conT ''C1 `appT`\n                      (conT tName `appT` sigT (varT kName) kKind))\n                    []\n     return [d])\n\ndata family T2 (a :: b)\ndata instance T2 b\nclass C2 a\n\n$(do FamilyI (DataFamilyD tName _ _) [DataInstD [] _ tyVar _ _ _]\n       <- reify ''T2\n     d <- instanceD (cxt [])\n                    (conT ''C2 `appT` return tyVar)\n                    []\n     return [d])\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedTuples #-}\nmodule T12513 where\n\nimport Language.Haskell.TH.Lib\nimport Language.Haskell.TH.Syntax\n\nf :: $([t| (# Int #) |]) -> Int\nf x = x\n\ng :: $(unboxedTupleT 1 `appT` conT ''Int) -> Int\ng x = x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T12530 where\n\nimport Language.Haskell.TH\n\n$([d|   -- Test the Template Haskell pretty-printing for TypeApplications\n        f :: Maybe Int -> Maybe Int\n        f = id @(Maybe Int)\n\n        -- Wildcards and scoped type variables too\n        g :: forall a. a\n        g = undefined @(_) @(a)\n    |])\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T12646 where\n\nimport Language.Haskell.TH hiding (Type)\nimport System.IO\nimport Data.Kind (Type)\n\ntype family F (a :: k) :: Type where\n    F (a :: Type -> Type) = Int\n    F (a :: k) = Char\n\n$(do info <- reify ''F\n     runIO $ putStrLn $ pprint info\n     runIO $ hFlush stdout\n     return [])\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T12788 where\n\nimport Language.Haskell.TH\nimport T12788_Lib\n\ndata Bad = Bad { _bad :: String } deriving (Eq, Ord, Show)\n\n$(deriveJSON defaultOptions{} ''Bad)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12788_Lib where\n\nimport Language.Haskell.TH\n\ndata Options = Options\n    { fieldLabelModifier :: String -> String\n    , constructorTagModifier :: String -> String\n    , allNullaryToStringTag :: Bool\n    , omitNothingFields :: Bool\n    , sumEncoding :: SumEncoding\n    , unwrapUnaryRecords :: Bool\n    }\n\ndata SumEncoding =\n    TaggedObject { tagFieldName      :: String\n                 , contentsFieldName :: String\n                 }\n  | ObjectWithSingleField\n  | TwoElemArray\n\nderiveJSON :: Options -> Name -> Q [Dec]\nderiveJSON _ _ = return []\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UnboxedTuples #-}\nmodule T12977 where\n\nimport Language.Haskell.TH.Lib\nimport Language.Haskell.TH.Syntax\n\nzero :: () -> $(conT (unboxedTupleTypeName 0))\nzero () =  $(conE (unboxedTupleDataName 0))\n\none :: () -> $(conT (unboxedTupleTypeName 1) `appT` conT ''Int)\none () =  $(conE (unboxedTupleDataName 1)) 42\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T12993 where\nimport T12993_Lib\nf = $(q)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T12993_Lib (q) where\ndata X = X { x :: Int }\nq = [|x|]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T13018 where\n\ndata T a where\n  MkT :: Eq b => b -> T a\n\n$([d| pattern P :: b -> T a\n      pattern P x <- MkT x\n    |])\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE ViewPatterns #-}\n\nmodule T13098 where\n\nimport Language.Haskell.TH\n\n$( sequence [ dataD (cxt []) (mkName \"T\") [PlainTV (mkName \"a\")]\n                     Nothing [normalC (mkName \"T\") []] []\n          , pragCompleteD [mkName \"T\"] Nothing ] )\n\n$([d| class LL f where\n        go :: f a -> ()\n\n      instance LL [] where\n        go _ = ()\n\n      pattern T2 :: LL f => f a\n      pattern T2 <- (go -> ())\n\n      {-# COMPLETE T2 :: [] #-}\n\n      -- No warning\n      foo :: [a] -> Int\n      foo T2 = 5\n    |])\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T13123 where\n\nimport Data.Kind (Type, Constraint)\n\n$([d| idProxy :: forall k proxy (a :: k). proxy a -> proxy a\n      idProxy x = x\n    |])\n\n$([d| id2 :: Show a => a -> a\n      id2 x = x\n      {-# SPECIALIZE id2 :: forall k proxy (a :: k). Show (proxy a)\n                         => proxy a -> proxy a #-}\n    |])\n\n$([d| wibble :: Maybe Int\n      wibble = (undefined :: forall k proxy (a :: k). proxy a)\n    |])\n\n$([d| class Foo b where\n        bar         :: forall k proxy (a :: k). proxy a -> b\n        default bar :: forall k proxy (a :: k). proxy a -> b\n        bar = undefined\n    |])\n\n$([d| data GADT where\n        MkGADT :: forall k proxy (a :: k). proxy a -> GADT\n    |])\n\n$([d| data Dec13 :: (Type -> Constraint) -> Type where\n        MkDec13 :: c a => a -> Dec13 c\n    |])\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -optc-DA_MACRO=1 #-}\n\nimport Language.Haskell.TH.Syntax\nimport System.IO (hFlush, stdout)\n\nforeign import ccall fc :: Int -> IO Int\n\ndo addForeignSource LangC $ unlines\n     [ \"#include <stdio.h>\"\n     , \"int fc(int x) {\"\n     , \"  printf(\\\"calling f(%d)\\\\n\\\",x);\"\n     , \"  fflush(stdout);\"\n     , \"  return A_MACRO + x;\"\n     , \"}\"\n     ]\n   return []\n\nforeign import ccall fcxx :: Int -> IO Int\n\ndo addForeignSource LangCxx $ unlines\n     [ \"#include <iostream>\"\n     , \"extern \\\"C\\\" {\"\n     , \"  int fcxx(int x) {\"\n     , \"    std::cout << \\\"calling fcxx(\\\" << x << \\\")\\\" << std::endl;\"\n     , \"    std::cout.flush();\"\n     , \"    return A_MACRO + x;\"\n     , \"  }\"\n     , \"}\"\n     ]\n   return []\n\nmain :: IO ()\nmain = do\n  fc 2 >>= print\n  hFlush stdout\n  fcxx 5 >>= print\n  hFlush stdout\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\nimport T13473a\n\n[quoter|y|] = 1\n\nmain :: IO ()\nmain = do\n  let $(varP $ mkName \"x\") = 1 in print x\n  print y\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13473a where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\nquoter :: QuasiQuoter\nquoter = QuasiQuoter { quotePat  = varP . mkName\n                     , quoteExp  = undefined\n                     , quoteDec  = undefined\n                     , quoteType = undefined }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nimport T13587A\n\nmain :: IO ()\nmain = do\n    let sin' = $$(importDoubleToDouble \"sin\")\n        cos' = $$(importDoubleToDouble \"cos\")\n    --\n    print (sin' 0)\n    print (cos' pi)\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE QuasiQuotes     #-}\n\nmodule T13587A where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\nimportDoubleToDouble :: String -> Q (TExp (Double -> Double))\nimportDoubleToDouble fname = do\n    n <- newName fname\n    d <- forImpD CCall unsafe fname n [t|Double -> Double|]\n    addTopDecls [d]\n    unsafeTExpCoerce (varE n)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Main where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax (lift)\n\ndata family DF a\ndata    instance DF [a]       = DFList a\nnewtype instance DF (Maybe a) = DFMaybe a\n\n$(return [])\n\nmain :: IO ()\nmain = print\n  $(do FamilyI (DataFamilyD _ _ _) insts <- reify ''DF\n       lift $ all (\\case DataInstD _ _ (AppT (ConT _) (AppT _ (VarT v1))) _\n                                       [NormalC _ [(_, VarT v2)]] _\n                           -> v1 == v2\n                         NewtypeInstD _ _ (AppT (ConT _) (AppT _ (VarT v1))) _\n                                          (NormalC _ [(_, VarT v2)]) _\n                           -> v1 == v2\n                         _ -> error \"Not a data or newtype instance\")\n              insts)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, PolyKinds, TemplateHaskell, RankNTypes #-}\nmodule T13642 where\n\nimport Data.Kind (Type)\nimport Language.Haskell.TH (stringE, pprint)\n\nfoo :: IO ()\nfoo = putStrLn $([d| data Foo :: forall a. a -> Type where MkFoo :: Foo Int |]\n                 >>= \\d -> stringE (pprint d))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T13776 where\n\nimport Language.Haskell.TH\n\nspliceTy1 :: $(conT ''(,) `appT` conT ''Int `appT` conT ''Int)\nspliceTy1 = (1,2)\n\nspliceTy2 :: $(conT ''[] `appT` conT ''Int)\nspliceTy2 = []\n\nspliceExp1 :: (Int, Int)\nspliceExp1 = $(conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1))\n\nspliceExp2 :: [Int]\nspliceExp2 = $(conE '[])\n\nsplicePat1 :: (Int, Int) -> ()\nsplicePat1 $(conP '(,) [litP (integerL 1), litP (integerL 1)]) = ()\n\nsplicePat2 :: [Int] -> ()\nsplicePat2 $(conP '[] []) = ()\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T13781 where\n\nimport Data.Kind\nimport Data.Proxy\n\n$([d| f :: Proxy (a :: (k :: Type))\n      f = Proxy\n    |])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T13782 where\n\nimport Language.Haskell.TH\n\n$(do TyConI (DataD _ _ [KindedTV a1 _] _ _ _) <- reify ''Maybe\n     [f,a2] <- mapM newName [\"f\",\"a\"]\n     return [ SigD f (ForallT [PlainTV a1,\n                               KindedTV a2 (AppT (ConT ''Maybe) (VarT a1))]\n                   [] (ConT ''Int))\n            , ValD (VarP f) (NormalB (LitE (IntegerL 42))) []\n            ])\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T13837 where\n\nimport Language.Haskell.TH.Lib\nimport Language.Haskell.TH.Syntax\n\ntest_local_tyfam_expansion :: String\ntest_local_tyfam_expansion =\n  $(do fam_name <- newName \"Fam\"\n       stringE . show =<< qReifyInstances fam_name [])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices #-}\nmodule T13856 where\n\nimport Language.Haskell.TH\n\nf :: Int\nf = $(lamE [] [| 42 |])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Main where\n\nimport Data.Function (on)\nimport Language.Haskell.TH.Syntax\n\ndata a :~: b where\n  Refl :: a ~ b => a :~: b\n\n$(return [])\n\nmain :: IO ()\nmain = print\n  $(do TyConI (DataD _ _ tycon_tyvars _\n                     [ForallC con_tyvars _ _] _) <- reify ''(:~:)\n\n       let tvbName :: TyVarBndr -> Name\n           tvbName (PlainTV  n)   = n\n           tvbName (KindedTV n _) = n\n\n       lift $ and $ zipWith ((/=) `on` tvbName) tycon_tyvars con_tyvars)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Data.Proxy\nimport GHC.Generics\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = do\n  putStrLn $([t| Proxy  (:*:) |] >>= stringE . pprint)\n  putStrLn $([t| Proxy '(:*:) |] >>= stringE . pprint)\n  putStrLn $([t| Proxy '(:)   |] >>= stringE . pprint)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T13968 where\n\nimport Language.Haskell.TH\n\n$(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilyDependencies #-}\n{-# LANGUAGE PolyKinds #-}\nmodule Main where\n\nimport Data.Kind\nimport Data.Proxy\nimport Language.Haskell.TH hiding (Type)\n\n-- Anonymous tyvar binder example\nnewtype Foo1 = Foo1 (Proxy '[False, True, False])\n\n-- Required (dependent) tyvar binder example\ntype family Wurble k (a :: k) :: k\nnewtype Foo2 a = Foo2 (Proxy (Wurble (Maybe a) Nothing))\n\n-- Non-injective type family example\ntype family Foo3Fam1 (a :: Type) :: Type where\n  Foo3Fam1 a = a\ntype family Foo3Fam2 (a :: Foo3Fam1 b) :: b\nnewtype Foo3 = Foo3 (Proxy (Foo3Fam2 Int))\n\n-- Injective type family example\ntype family Foo4Fam1 (a :: Type) = (r :: Type) | r -> a where\n  Foo4Fam1 a = a\ntype family Foo4Fam2 (a :: Foo4Fam1 b) :: b\nnewtype Foo4 = Foo4 (Proxy (Foo4Fam2 Int))\n\n$(return [])\n\nmain :: IO ()\nmain = do\n  putStrLn $(reify ''Foo1 >>= stringE . pprint)\n  putStrLn $(reify ''Foo2 >>= stringE . pprint)\n  putStrLn $(reify ''Foo3 >>= stringE . pprint)\n  putStrLn $(reify ''Foo4 >>= stringE . pprint)\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T14204 where\n\nimport GHC.StaticPtr\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = putStrLn (deRefStaticPtr $(pure (StaticE (LitE (StringL \"wat\")))))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nimport Language.Haskell.TH.Syntax\nimport System.IO (hFlush, stdout)\n\nforeign import ccall foo :: Int -> IO Int\n\ndo fpIn <- addTempFile \"c\"\n   let cSrc = (unlines [ \"#include <stdio.h>\"\n                       , \"int foo(int x) {\"\n                       , \"  printf(\\\"calling f(%d)\\\\n\\\",x);\"\n                       , \"  fflush(stdout);\"\n                       , \"  return 1 + x;\"\n                       , \"}\"\n                       ])\n   runIO $ writeFile fpIn cSrc\n   addForeignFilePath LangC fpIn\n   return []\n\nmain :: IO ()\nmain = do\n  foo 2 >>= print\n  hFlush stdout\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ApplicativeDo #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nimport Language.Haskell.TH\nimport Prelude\n\nmain = putStrLn $(do\n  expr <- [|\n    do x <- getLine\n       y <- getLine\n       pure (x, y)\n    |]\n  stringE (pprint expr))\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nimport Language.Haskell.TH.Syntax\n\n[d| f = Bool |] >>= addTopDecls >> return []\n\nmain = return ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T14646 where\n\n$([d| f :: (forall a. a) -> Int\n      f _ = undefined |])\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T14681 where\n\nimport Data.Functor.Identity\nimport Language.Haskell.TH\n\n$([d| f = \\(Identity x) -> x |])\n$([d| g = $(pure $ VarE '(+) `AppE` LitE (IntegerL (-1))\n                             `AppE` (LitE (IntegerL (-1)))) |])\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T1476 where\n\nimport Language.Haskell.TH\n\nfoo $( return $ VarP $ mkName \"x\" ) = x\nbar $( [p| x |] ) = x\n\nbaz = [| \\ $( return $ VarP $ mkName \"x\" ) -> $(dyn \"x\") |]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T1476b where\n\nimport Language.Haskell.TH\n\nbaz = [| \\ $( return $ VarP $ mkName \"x\" ) -> x |]\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14817 where\n\nimport Data.Kind (Type)\n\n$([d| data family Foo :: Type\n      data instance Foo :: Type |])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T14843 where\n\nimport Language.Haskell.TH.Syntax\n\ntype T1 = $(return (PromotedTupleT 2))\ntype T2 = $([t| '(,) |])\ntype T3 = $(return (PromotedT (tupleDataName 2)))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\nmodule T14869 where\n\nimport Data.Kind\nimport GHC.Exts\nimport Language.Haskell.TH (pprint, reify, stringE)\n\ntype MyConstraint = Constraint\ntype MyLiftedRep  = LiftedRep\n\ntype family Foo1 :: Type\ntype family Foo2 :: Constraint\ntype family Foo3 :: MyConstraint\ntype family Foo4 :: TYPE MyLiftedRep\n\n$(pure [])\n\nfoo1, foo2, foo3 :: String\nfoo1 = $(reify ''Foo1 >>= stringE . pprint)\nfoo2 = $(reify ''Foo2 >>= stringE . pprint)\nfoo3 = $(reify ''Foo3 >>= stringE . pprint)\nfoo4 = $(reify ''Foo4 >>= stringE . pprint)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T14875 where\n\n$([d| f :: Bool -> Bool\n      f x = case x of\n              (True :: Bool) -> True\n              (False :: Bool) -> False\n\n      g :: Bool -> Bool\n      g x = (case x of\n               True -> True\n               False -> False) :: Bool\n    |])\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE InstanceSigs #-}\n\nmodule T14885a where\n\nclass Foo1 a where\n  bar1 :: forall b. a -> b -> b\n  bar1 _ x = (x :: b)\n\n$([d| class Foo2 a where\n        bar2 :: forall b. a -> b -> b\n        bar2 _ x = (x :: b)\n\n      instance Foo2 Int where\n        bar2 :: forall b. Int -> b -> b\n        bar2 _ x = (x :: b)\n    |])\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule T14885b where\n\nclass Foo1 a where\n  foo1         :: forall b. a -> b -> b\n  default foo1 :: forall b. a -> b -> b\n  foo1 _ x = (x :: b)\n\n$([d| class Foo2 a where\n        foo2         :: forall b. a -> b -> b\n        default foo2 :: forall b. a -> b -> b\n        foo2 _ x = (x :: b)\n    |])\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule T14885c where\n\npattern P1 :: forall a. a -> Maybe a\npattern P1 x <- Just x where\n  P1 x = Just (x :: a)\n\n$([d| pattern P2 :: forall a. a -> Maybe a\n      pattern P2 x <- Just x where\n        P2 x = Just (x :: a)\n    |])\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T14888 where\n\nimport Language.Haskell.TH\n\nfoo :: $([t| (->) Bool Bool |])\nfoo x = x\n\nclass Functor' f where\n  fmap' :: (a -> b) -> f a -> f b\n\ninstance Functor' ((->) r) where\n  fmap' = (.)\n\n$(return [])\n\nfunctor'Instances :: String\nfunctor'Instances = $(reify ''Functor' >>= stringE . pprint)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -ddump-splices #-}\nmodule T15243 where\n\ndata Unit = Unit\n\n$([d| type family F (a :: k) :: k where\n        F 'Unit = 'Unit\n        F '(,)  = '(,)\n        F '[]   = '[]\n        F '(:)  = '(:)\n    |])\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T10047A where\n\nimport Language.Haskell.TH\n\n-- Passing var name to conE should fail.\nx = $(conE 'id)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T10047B where\n\nimport Language.Haskell.TH\n\n-- Passing datacon name to varE should fail.\nx = $(varE 'Just)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T15321 where\n\nfoo :: String\nfoo = test\n\nbar :: String\nbar = $(_ \"baz\")\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T15324 where\n\n$([d| f :: forall a. (Show a => a) -> a\n      f _ = undefined\n    |])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T15331 where\n\nimport Data.Proxy\n\n$([d| f :: Proxy (Int -> Int)\n      f = Proxy @(Int -> Int)\n    |])\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15360a where\n\nimport Language.Haskell.TH\n\ndata T a b c = Mk a b c\n\nbar :: $( return $ AppT (InfixT (ConT ''Int) ''T (ConT ''Bool)) (ConT ''Double) )\nbar = Mk 5 True 3.14\n\nbaz :: $( return $ AppT (ParensT (ConT ''Maybe)) (ConT ''Int) )\nbaz = Just 5\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE StarIsType #-}\nmodule T15360b where\n\nimport Data.Kind\nimport Data.Proxy\n\nx :: Proxy $([t| * Double |])\nx = Proxy\n\ny :: Proxy $([t| 1 Int |])\ny = Proxy\n\nz :: Proxy $([t| Constraint Bool |])\nz = Proxy\n\nw :: Proxy $([t| '[] Int |])\nw = Proxy\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds #-}\n\nmodule T15362 where\n\ndata Nat = Zero | Succ Nat\n\n$( [d| type family a + b where\n         Maybe Zero b = b\n         Succ a + b = Succ (a + b) |] )\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE RoleAnnotations #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T15365 where\n\n$([d| type (|||) = Either\n\n      (&&&) :: Bool -> Bool -> Bool\n      (&&&) = (&&)\n\n      type role (***)\n      data (***)\n\n      class (???)\n      instance (???)\n\n      data family ($$$)\n      data instance ($$$)\n\n      type family (^^^)\n      type instance (^^^) = Int\n\n      type family (###) where\n        (###) = Int\n\n      pattern (:!!!) :: Bool\n      pattern (:!!!) = True\n    |])\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T1541 where\n\n$( [d|  infixr 3 +++\n        (+++) :: Int -> Bool -> Bool\n        (+++) x y = error \"ruk\"\n   |])\n\n-- This definition will only typecheck if the\n-- the fixity of (+++) is infixr\nfoo p q r = p +++ q +++ r\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15437 where\n\nimport T15437A\n\nf :: Int\nf = $$(foo)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T15437A where\n\nimport Language.Haskell.TH.Syntax (Q, TExp)\n\nget :: forall a. Int\nget = 1\n\nfoo :: forall a. Q (TExp Int)\nfoo = [|| get @a ||]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15471 where\n\nimport T15471A\n\n\nqux = $$(test_foo)\n\nbar y = $$(list_foo [|| y ||] )\n\nmain = print (qux 5) >> print (bar True)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15471A where\n\nimport Language.Haskell.TH\n\nfoo1 x = x\n\n\ntest_foo :: Q (TExp (a -> a))\ntest_foo = [|| foo1 ||]\n\n\nlist_foo :: Q (TExp a) -> Q (TExp [a])\nlist_foo x = [|| [ $$x, $$x ] ||]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Bug where\n\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = putStrLn $(recover (stringE \"reifyFixity failed\")\n                          (do foo <- newName \"foo\"\n                              _ <- reifyFixity foo\n                              stringE \"reifyFixity successful\"))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T15502 where\n\nimport Language.Haskell.TH.Syntax  (Lift(lift))\n\nmain = print ( $( lift (toInteger (maxBound :: Int) + 1) )\n             , $( lift (minBound :: Int) )\n             )\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T15518 where\n\n$([d| f :: Bool -> ()\n      f = \\case True  -> ()\n                False -> ()\n    |])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15550 where\n\n$([d| myId :: a -> a\n      myId x = x\n      {-# NOINLINE [1] myId #-}\n      {-# RULES \"myId\" forall x. myId x = x #-}\n    |])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T15572 where\n\nimport Language.Haskell.TH\n\n$([d| type AbsoluteUnit1 = '() |])\n$(pure [TySynD (mkName \"AbsoluteUnit2\") [] (ConT '())])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE QuantifiedConstraints #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T15738 where\n\nimport Language.Haskell.TH\nimport System.IO\n\ndata Foo x = MkFoo x\n\n$(do d <- [d| f :: (forall a. Eq (Foo a)) => Foo x -> Foo x -> Bool\n              f = (==) |]\n     runIO $ hPutStrLn stderr $ pprint d\n     pure d)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15783A where\n\nimport T15783B\n\nmain = $$f\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15783B(f) where\n\nd = 0\n\nf = [|| d ||]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T15792 where\n\nimport Data.Kind\nimport Language.Haskell.TH hiding (Type)\nimport System.IO\n\nnewtype T (f :: forall a. a -> Type) = MkT (f Bool)\n\n$(pure [])\n\n$(do info <- reify ''T\n     runIO $ hPutStrLn stderr $ pprint info\n     pure [])\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15815A where\n\nmkFoo tyQ = [d|\n    foo :: a ~ $(tyQ) => a\n    foo = undefined\n  |]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, GADTs #-}\nmodule T15815B where\n\nimport T15815A\n\nmkFoo [t| Int -> Int |]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T15845 where\n\nimport Language.Haskell.TH\nimport System.IO\n\ndata family F1 a b\ndata instance F1 [a] b = MkF1\n\ndata family F2 a\ndata instance F2 a = MkF2\n\n$(do i1 <- reify ''F1\n     i2 <- reify ''F2\n     runIO $ mapM_ (hPutStrLn stderr . pprint) [i1, i2]\n     pure [])\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T15985 where\n\nimport Language.Haskell.TH\n\nfoo :: String\nfoo = $(stringE (pprint EqualityT))\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T16133 where\n\nimport Data.Kind\nimport Language.Haskell.TH hiding (Type)\n\ndata P (a :: k) = MkP\n\n$([d| f :: Int\n      f = $(varE 'id `appTypeE` conT ''Int `appE` litE (integerL 42))\n\n      type P' = $(conT ''P `appKindT` conT ''Type) |])\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Main where\n\nimport Language.Haskell.TH.Syntax\nimport Foreign.C.String\nimport Config -- from \"ghc\" package\n\n$(do\n   -- some targets (e.g. Darwin) require a \"_\" symbol prefix...\n   addForeignSource LangAsm (if cLeadingUnderscore == \"YES\"\n      then \".global \\\"_mydata\\\"\\n\\\n           \\_mydata:\\n\\\n           \\.ascii \\\"Hello world\\\\0\\\"\\n\"\n      else \".global \\\"mydata\\\"\\n\\\n           \\mydata:\\n\\\n           \\.ascii \\\"Hello world\\\\0\\\"\\n\"\n      )\n   return [])\n\nforeign import ccall \"&mydata\" mystring :: CString\n\nmain :: IO ()\nmain = putStrLn =<< peekCString mystring\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16183 where\n\nimport Data.Kind\n\n$([d| type F1 = (Maybe :: Type -> Type) Int\n      type F2 = (Int :: Type) -> (Int :: Type)\n      type family F3 a where\n        F3 (a :: Type) = Int\n      newtype F4 = MkF4 (Int :: Type) |])\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T16195 where\n\nimport T16195A\n\nmain2 :: IO ()\nmain2 = return ()\n\nmain :: IO ()\nmain = $$foo\n\nmain3 :: IO ()\nmain3 = putStrLn ($$showC $$unitC)\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T16195A where\n\nimport Language.Haskell.TH\n\nfoo :: Q (TExp (IO ()))\nfoo = [|| return () ||]\n\nshowC :: Q (TExp (() -> String))\nshowC = [|| show ||]\n\nunitC :: Q (TExp ())\nunitC = [|| () ||]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule T16293b where\n\nimport Control.Monad\nimport GHC.Exts\nimport Language.Haskell.TH\n\nf :: ()\nf = $(do PrimTyConI _ arity _ <- reify ''Proxy#\n         unless (arity == 1) $\n           fail $ \"Unexpected arity for Proxy#: \" ++ show arity\n         [| () |])\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16326_TH where\n\nimport Control.Monad.IO.Class\nimport Data.Kind\nimport Data.Proxy\nimport Language.Haskell.TH hiding (Type)\nimport System.IO\n\ndata Foo :: forall a -> a -> Type\ntype family Foo2 :: forall a -> a -> Type where\n  Foo2 = Foo\n\n$(do info <- reify ''Foo2\n     liftIO $ hPutStrLn stderr $ pprint info\n\n     dec <- [d| data Nested :: forall a. forall b -> forall c.\n                               forall d -> forall e.\n                               Proxy '[a,b,c,d,e] -> Type |]\n     liftIO $ hPutStrLn stderr $ pprint dec\n     pure dec)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH.Syntax (lift)\nimport T1830_3a\n\nmain :: IO ()\nmain = do\n  print ($(lift algDT1) == algDT1)\n  print ($(lift algDT2) == algDT2)\n  print ($(lift algDT3) == algDT3)\n  print ($(lift prim)   == prim)\n  print ($(lift df1)    == df1)\n  print ($(lift df2)    == df2)\n  print ($(lift df3)    == df3)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveLift #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T1830_3a where\n\nimport GHC.Exts\nimport Language.Haskell.TH.Syntax (Lift(..))\n\ndata AlgDT a b c = NormalCon a b\n                 | RecCon { recCon1 :: a, recCon2 :: b}\n                 | a :^: b\n  deriving (Eq, Lift)\n\ndata Prim = Prim Char# Double# Int# Float# Word#\n  deriving (Eq, Lift)\n\n-- We can't test this for equality easily due to the unstable nature of\n-- primitive string literal equality. We include this anyway to ensure that\n-- deriving Lift for datatypes with Addr# in them does in fact work.\ndata AddrHash = AddrHash Addr#\n  deriving Lift\n\ndata Empty deriving Lift\n\ndata family DataFam a b c\n\ndata instance DataFam Int b c = DF1 Int | DF2 b\n  deriving (Eq, Lift)\n\nnewtype instance DataFam Char b c = DF3 Char\n  deriving (Eq, Lift)\n\nalgDT1, algDT2, algDT3 :: AlgDT Int String ()\nalgDT1 = NormalCon 1 \"foo\"\nalgDT2 = RecCon 2 \"bar\"\nalgDT3 = 3 :^: \"baz\"\n\nprim :: Prim\nprim = Prim 'a'# 1.0## 1# 1.0# 1##\n\ndf1, df2 :: DataFam Int Char ()\ndf1 = DF1 1\ndf2 = DF2 'a'\n\ndf3 :: DataFam Char () ()\ndf3 = DF3 'b'\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, FlexibleInstances,\n          MultiParamTypeClasses, TypeSynonymInstances #-}\nmodule Main where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\nclass Eq a => MyClass a \ndata Foo = Foo deriving Eq\n\ninstance MyClass Foo \n\ndata Bar = Bar\n  deriving Eq\n\ntype Baz = Bar\ninstance MyClass Baz\n\ndata Quux a  = Quux a   deriving Eq\ndata Quux2 a = Quux2 a  deriving Eq\ninstance Eq a  => MyClass (Quux a)\ninstance Ord a => MyClass (Quux2 a)\n\nclass MyClass2 a b\ninstance MyClass2 Int Bool\n\n$(return [])\n\nmain = do\n    putStrLn $(do { info <- reify ''MyClass; lift (pprint info) })\n    print $(isInstance ''Eq [ConT ''Foo] >>= lift)\n    print $(isInstance ''MyClass [ConT ''Foo] >>= lift)\n    print $ not $(isInstance ''Show [ConT ''Foo] >>= lift)\n    print $(isInstance ''MyClass [ConT ''Bar] >>= lift) -- this one\n    print $(isInstance ''MyClass [ConT ''Baz] >>= lift)\n    print $(isInstance ''MyClass [AppT (ConT ''Quux) (ConT ''Int)] >>= lift) --this one\n    print $(isInstance ''MyClass [AppT (ConT ''Quux2) (ConT ''Int)] >>= lift) -- this one\n    print $(isInstance ''MyClass2 [ConT ''Int, ConT ''Bool] >>= lift)\n    print $(isInstance ''MyClass2 [ConT ''Bool, ConT ''Bool] >>= lift)\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TemplateHaskell #-}\nmodule ReifyPlusTypeInferenceBugs where\n\nimport Language.Haskell.TH\nimport System.IO\n\na = 1\n\n$(return [])\n\nb = $(do VarI _ t _ <- reify 'a\n         runIO $ putStrLn (\"inside b: \" ++ pprint t)\n         [| undefined |]) \n\nc = $([| True |])\n\n$(return [])\n\nd = $(do VarI _ t _ <- reify 'c\n         runIO $ putStrLn (\"inside d: \" ++ pprint t)\n         [| undefined |] )\n\n$(do VarI _ t _ <- reify 'c\n     runIO $ putStrLn (\"type of c: \" ++ pprint t)\n     return [] )\n\ne = $([| True |])\n\n$(return [])\n\nf = $(do VarI _ t _ <- reify 'e\n         runIO $ putStrLn (\"inside f: \" ++ pprint t)\n         [| undefined |] )\n\n$(do VarI _ t _ <- reify 'e\n     runIO $ putStrLn (\"type of e: \" ++ pprint t)\n     return [] )\n\n$( runIO $ do hFlush stdout\n              hFlush stderr\n              return [] )\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test Trac #2386\n\nmodule T2386 where\n\nimport T2386_Lib\n\nfoo = $(makeOne)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T2386_Lib(ExportedAbstract, makeOne) where\n\ndata ExportedAbstract = Yay String | NonYay Bool\n\nmakeOne = [| Yay \"Yep\" |]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test Trac #2597 (first bug)\n\nmodule ShouldCompile where\nimport T2597a_Lib\n\nbug = $mkBug\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n-- Library module for T2597a\n\nmodule T2597a_Lib where\nimport Language.Haskell.TH\n\n\nmkBug :: ExpQ\nmkBug = return $ CompE [BindS (VarP $ mkName \"p\") (ListE []), NoBindS\n                         (VarE $ mkName \"p\")]\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test Trac #2597 (second bug)\n\nmodule ShouldCompile where\nimport T2597b_Lib\n\nbug2 = $mkBug2\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n-- Library module for T2597b\n\nmodule T2597b_Lib where\nimport Language.Haskell.TH\n\n\nmkBug2 :: ExpQ\nmkBug2 = return $ DoE []\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Trac #2674\n\nmodule ShouldFail where\n\nimport Language.Haskell.TH\n\n$(return [FunD (mkName \"foo\") []])\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T2685 where\n\nimport T2685a\n\n$( th )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T2685a (th) where\n\nimport Language.Haskell.TH\n\nnewtype NT = C (() -> ())\n\nth :: Q [Dec]\nth = [d| foo = C undefined |]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T2700 where\nimport Language.Haskell.TH\nimport System.IO\n\n$( do { d <- sigD (mkName \"foo\") [t| (Int -> Bool) -> Bool |]\n      ; runIO (hPutStrLn stderr (pprint d))\n      ; return [] }\n  )\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Fixity where\n\nclass MyClass a where\n    (.*.) :: a -> a -> a\n\nf x = x\n\n$( [d| x = undefined |] )\n\ninfixr 3 .*.\nf :: Int -> Int\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XTemplateHaskell #-} \nmodule TH( x ) where \nimport Language.Haskell.TH\n\ndata T f = MkT (f Int)\n\nx = $(return (SigE (VarE 'x) (AppT (ConT ''T) (AppT ArrowT (ConT ''Int)))))\n \n\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE RankNTypes, FlexibleContexts, ImplicitParams, TemplateHaskell #-}\n\n-- This test makes sure TH understands types where\n-- there is a predicate but no 'forall'\n--\n-- There are two tests in here; both should be fine\n-- Trac ticket: #3100\n\nmodule T3100 where\n\nimport Language.Haskell.TH\n\nflop :: Ord Int => Int -> Int\n-- Weird test case: (Ord Int) is simplifiable and redundant\nflop x = x\n\n$(do { t <- reify 'flop; return [] })\n\ntype T a = Eq a => a\n\n$(do { reify ''T; return []})\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- LANGUAGE TemplateHaskell #-}\n\n-- Template Haskell type splices\nmodule T3177 where\n\nf :: $(id [t| Int |])\nf = 3\n\nclass C a where\n  op :: a -> a\n\ninstance C a => C ($([t| Maybe |]) a) where\n  op x = fmap op x\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- LANGUAGE TemplateHaskell #-}\n\n-- Template Haskell type splices\n-- Should fail, with a decent error message\n\nmodule T3177a where\n\nf :: $(id [t| Int Int |])\nf = 3\n\ng :: Int Int\ng = 3\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell,ForeignFunctionInterface #-}\n\nmodule T3319 where\n\nimport Foreign.Ptr\nimport Language.Haskell.TH\n\n$(return [ForeignD (ImportF CCall Unsafe \"&\" (mkName \"foo\") (AppT (ConT ''Ptr) (ConT ''())))])\n\n-- Should generate the same as this:\nforeign import ccall unsafe \"&\" foo1 :: Ptr ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T3395 where\n\nimport Language.Haskell.TH\n\nfoo = $(return $\n     CompE\n         [NoBindS (VarE $ mkName \"undefined\")\n         ,BindS (VarP $ mkName \"r1\") (VarE $ mkName \"undefined\") ])\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test Trac #3467\n\nmodule T3467 where\n\nimport Language.Haskell.TH\nimport Foreign\n\nsizeq :: Name -> Q Exp\nsizeq n = [| sizeOf (undefined :: $(conT n)) |]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -ddump-splices #-}\nmodule T3600 where\nimport T3600a\n$(test)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T3600a where\n\nimport Language.Haskell.TH\n\ntest :: Q [Dec]\ntest = do\n     let args1 = [] :: [String]\n         args2 = [] :: String\n         args3 = \"x\" :: String\n         body = [| (testFun1 args1, testFun2 args2, testFun2 args3)  |]\n         decNm = mkName \"myFunction\"\n     (:[]) `fmap` funD decNm [clause [] (normalB body) []]\n\ntestFun1 :: [String] -> String\ntestFun1 _ = \"hello\"\n\ntestFun2 :: String -> String\ntestFun2 _ = \"goodbye\"\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule THBug1 where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\ndata HCons a b = HCons a b\ndata HNil = HNil\n\nmhlt :: [Q Type] -> Q Type\nmhlt xss = [t| $(foldThing xss)|]\n  where\n    foldThing (x:xs) = [t| HCons $x $(foldThing xs)|]\n    foldThing []     = [t| HNil |]\n\nmhlt1 :: [Int] -> Q Exp\nmhlt1 xss = [| $(foldThing1 xss) |]\n  where\n    foldThing1 (x:xs) = [| x : $(foldThing1 xs)|]\n    foldThing1 [] = [| [] |]\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T3899 where\n\nimport T3899a\n\nf = $(nestedTuple 3)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T3899a where\n\n\nimport Language.Haskell.TH\nimport Control.Monad\n\ndata Cons a b = Cons a b\ndata Nil = Nil\n\nnestedTuple n = do\n     xs <- replicateM n (newName \"x\")\n     return $ LamE [foldr (\\v prev -> ParensP (ConP 'Cons [VarP v,prev]))\n                       (ConP 'Nil []) xs]\n                   (TupE $ map VarE xs)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, TypeFamilies, TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH hiding (Type)\nimport Data.Kind (Type)\n\ntype family S :: (Type -> (Type -> Type -> Type))\n              -> (Type -> Type) -> Type\n\n$(return [])\n\ntest :: String\ntest = $(do\n        test <- [d|\n                type family T :: (Type -> (Type -> Type -> Type))\n                              -> (Type -> Type) -> Type |]\n        blah <- reify ''S\n        return (LitE (StringL (pprint test ++ \"\\n\" ++ pprint blah))))\n\nmain = putStrLn test\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T4124 where\n\nclass Storable a where\ndata X = X\n[d| instance Storable $( [t| X |] ) where |]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T4128 where\n\nimport Language.Haskell.TH\nclass C a where\ndata X = X\nfmap return $ instanceD (cxt []) [t| C $(conT ''X) |] []\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies,TemplateHaskell #-}\nmodule Bug where\n\nimport Language.Haskell.TH\nimport System.IO\n\nclass C a where\n    type T a\n\n$(do { ds <- [d|\n                 instance C (Maybe a) where\n                    type T (Maybe a) = Char\n             |]\n     ; runIO $ do { putStrLn (pprint ds); hFlush stdout }\n     ; return ds })\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies,\n             FlexibleInstances #-}\n\nmodule T4135a where\n\nimport Control.Monad\nimport Language.Haskell.TH\n\nclass Foo a where\n    type FooType a\n\ncreateInstance' :: Q Type -> Q Dec\ncreateInstance' t = liftM head [d|\n    instance Foo $t where\n      type FooType $t = String |]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, GADTs #-}\n\nmodule T4188 where\n\nimport Language.Haskell.TH\nimport System.IO\n\nclass C a where {}\n\ndata T1 a where\n  MkT1 :: a -> b -> T1 a\n\ndata T2 a where\n  MkT2 :: (C a, C b) => a -> b -> T2 a\n\ndata T3 x where\n  MkT3 :: (C x, C y) => x -> y -> T3 (x,y)\n\n$(do { dec1 <- reify ''T1\n     ; runIO (putStrLn (pprint dec1))\n     ; dec2 <- reify ''T2\n     ; runIO (putStrLn (pprint dec2))\n     ; dec3 <- reify ''T3\n     ; runIO (putStrLn (pprint dec3))\n     ; runIO (hFlush stdout)\n     ; return [] })\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T4233 where\nimport Language.Haskell.TH\n\nw :: Q Type\nw = varT (mkName \"w\")\n\nf :: Q Type\nf = [t| $w -> $w |]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T4364 where\n\ndata Z\n\ntype N0 = $( [t| Z |] )\ntype N1 = $( [t| Z |] )\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XTemplateHaskell #-} \nmodule TH( x ) where \nimport Language.Haskell.TH\n\nx = $(return (LitE (StringL \"hello\\ngoodbye\\nand then\")))\n \n\n\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Foo where\n\nimport Language.Haskell.TH\n\nx :: Int\nx = let args = [| show $(varE (mkName \"x\")) |]\n    in undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5037 where\nimport Language.Haskell.TH\nimport System.IO\n\n$( do ds <- [d|  f :: Maybe Int -> Int\n                 f Nothing = 3\n                 f (Just x) = $(varE (mkName \"x\"))\n            |]\n      runIO $ (putStrLn (pprint ds) >> hFlush stdout)\n      return ds )\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5126 where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\nf :: Q [Dec]\nf =\n    [d|\n        x2 :: $(conT ''Int)\n        x2 = undefined\n    |]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T5217 where\nimport Language.Haskell.TH\n\n$([d| data T a b where { T1 :: Int -> T Int Char\n                       ; T2 :: a -> T a a\n                       ; T3 :: a -> T [a] a\n                       ; T4 :: a -> b -> T b [a] } |])\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5290 where\n\nimport Language.Haskell.TH\n\n$( let n = mkName \"T\"\n   in return [DataD [] n [] Nothing\n                [NormalC n [(Bang SourceUnpack SourceStrict,ConT ''Int)]] []] )\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5358 where\n\nimport Language.Haskell.TH\n\nt1, t2 :: Int\nt1 x = x\nt2 x = x\n\nprop_x1 x = t1 x == t2 x\n\n$(return [])\n\nrunTests = $( do VarI _ t _ <- reify (mkName \"prop_x1\")\n                 error $ (\"runTest called error: \" ++ pprint t)\n            )\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5362() where\n\nimport System.IO\nimport Language.Haskell.TH\n\n$(\n     do fName <- newName \"f\"\n        gName <- newName \"g\"\n        let gExp = varE gName\n\n        sdf <- sigD fName [t| () |]\n        sdg <- sigD gName [t| () |]\n        fdf <- funD fName [clause [] (normalB [| undefined $gExp |]) []]\n        fdg <- funD gName [clause [] (normalB [| undefined       |]) []]\n        let ds = [sdf, fdf, sdg, fdg]\n        runIO $ do { putStrLn (pprint ds); hFlush stdout }\n        return ds\n     )\n\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\n$( [d| g = 0\n       h = $( return $ LamE [VarP (mkName \"g\")] (VarE 'g) ) |] )\n         -- The 'g should bind to the g=0 definition\n\n-- Should print 0, not 1!\nmain = print (h 1)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5404 where\n\nfoobar :: Int\nfoobar = $([|\n      let\n        bar :: Int\n        bar = 5\n      in bar\n   |])\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\n$([d| instance Show (a -> b) where\n         showsPrec _ _ = showString \"<function>\"\n  |])\n\nmain = print id\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5434 where\n\nimport T5434a\n\n$(genShadow1)\n\nv :: Bool\nv = True\n\n$(genShadow2)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5434a where\n\nimport Language.Haskell.TH\n\ngenShadow1 :: Q [Dec]\ngenShadow1 = \n  [d| x :: Char\n      x = 'x'\n    |]\n\ngenShadow2 :: Q [Dec]\ngenShadow2 =\n  [d| z :: Char\n      z = succ x\n        where x = 'y'\n    |]     \n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, KindSignatures, FlexibleInstances #-}\n\nmodule T5452 where\n\nimport Language.Haskell.TH hiding (Type)\nimport Data.Kind (Type)\n\nclass C (f :: Type -> Type)\nclass D (f :: Type -> Type)\n\ninstance C ((,) Int)\n\n$(do { ClassI _ [inst_dec] <- reify ''C\n     ; let InstanceD o cxt (AppT _ ty) _ = inst_dec\n     ; return [InstanceD o cxt\n                         (foldl AppT (ConT ''D) [ty]) \n                         []\n              ] })\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5508 where\n\nimport Language.Haskell.TH\n\nthb = $(do { let x = mkName \"x\"\n                 v = return (LamE [VarP x] $ VarE x)\n           ; [| $v . id |] })\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}\nimport qualified T5555_Lib as L\n\ntest :: String\ntest = [L.s|hello world|]\n\nmain :: IO ()\nmain = putStrLn test\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5555_Lib(s) where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\ns :: QuasiQuoter\ns = QuasiQuoter expr undefined undefined undefined\n\nexpr :: String -> Q Exp\nexpr = stringE\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5597 where\nimport T5597a( f )\n\ng = $(f [t| (Int, Int) |])\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5597a where\nimport Language.Haskell.TH\n\nf :: Q Type -> Q Exp\nf t = [| (3,4) :: $t |]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5665 where\n\nimport T5665a\n\ndata Record = Record { recordField :: Int }\n\n$(doSomeTH \"SomeType\" ''Int)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5665a where\n\nimport Language.Haskell.TH\n\ndoSomeTH s tp = return [NewtypeD [] n [] Nothing (NormalC n\n        [(Bang NoSourceUnpackedness NoSourceStrictness, ConT tp)]) []]\n   where n = mkName s\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5700 where\n\nimport T5700a\n\ndata D = D\n\n$(mkC ''D)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5700a where\n\nimport Language.Haskell.TH\n\nclass C a where\n  inlinable :: a -> ()\n\nmkC :: Name -> Q [Dec]\nmkC n = return\n  [InstanceD Nothing [] (AppT (ConT ''C) (ConT n))\n    [ FunD 'inlinable [Clause [WildP] (NormalB (ConE '())) []],\n      PragmaD (InlineP 'inlinable Inline FunLike AllPhases)    \n    ] \n  ]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5737 where\n\nimport Language.Haskell.TH\nmakeAlpha n = [d| data Alpha = Alpha $(conT n) deriving (Show, Read) |]\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5795 where\n\nimport Language.Haskell.TH\n\nty :: Q Type\nty = [t| Int |]\n\nf :: $ty\nf = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTSyntax, TemplateHaskell, KindSignatures #-}\n\nmodule T5882 where\n\nimport Data.Kind (Type)\n\ndata Foo :: Type -> Type where\n   Foo :: a -> Foo a\n\n$( [d|  data Bar :: Type -> Type where\n           Bar :: a -> Bar a\n  |] )\n\nf (Bar x) = Foo x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies    #-}\nmodule T5883 where\n\nimport Language.Haskell.TH\n\n$( [d|\n        data Unit = Unit\n        instance Show Unit where\n          show _ = \"\"\n          {-# INLINE show #-}\n  |])\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T5886 where\n\nimport T5886a\n\n$(bang)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T5886a where\n\nimport Language.Haskell.TH hiding (Type)\nimport Data.Kind (Type)\n\nclass C \u00ce\u00b1 where\n  type AT \u00ce\u00b1 \u00e2\u02c6\u00b7 Type\n\nbang \u00e2\u02c6\u00b7 DecsQ\nbang = return [InstanceD Nothing [] (AppT (ConT ''C) (ConT ''Int))\n                [TySynInstD (TySynEqn Nothing (AppT (ConT ''AT) (ConT ''Int)) (ConT ''Int))]]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5968 where\n\ndata Bar a = Bar $( [t| a |] )\n\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T5971 where\n\nimport Language.Haskell.TH\n\n_ = $(newName \"x\" >>= varE)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n$( error (\"foo \" ++ error \"bar\") )\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5984 where\n\nimport T5984_Lib\n\n$nt\n$dt\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T5984_Lib where\n\nimport Language.Haskell.TH\n\nnt :: Q [Dec]\nnt = return [NewtypeD [] foo [] Nothing (NormalC foo\n      [(Bang NoSourceUnpackedness NoSourceStrictness, ConT ''Int)]) []]\n  where foo = mkName \"Foo\"\n\ndt :: Q [Dec]\ndt = return [DataD [] bar [] Nothing [NormalC bar\n      [(Bang NoSourceUnpackedness NoSourceStrictness, ConT ''Int)]] []]\n  where bar = mkName \"Bar\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds #-}\n\nmodule T6005 where\n\n$( [d|\n   data Nat = Zero | Succ Nat\n   data Proxy a = Proxy\n   foo :: Proxy 'Zero\n   foo = foo\n   |])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T6005a where\n\n-- The point here is that we don't need to generate the\n-- derived code inside the bracket; doing so is troublesome\n-- and it should never be type incorrect, so it's also a\n-- waste of effort.\n\n$( [d|\n   data Nat = Zero | Succ Nat deriving( Show )\n   |] )\n\nfoo :: String\nfoo = show (Succ Zero)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies, DataKinds, UndecidableInstances,\n             PolyKinds #-}\nmodule T6018th where\n\nimport Language.Haskell.TH\n\n-- Test that injectivity works correct with TH. This test is not as exhaustive\n-- as the original T6018 test.\n\n-- type family F a b c = (result :: k) | result -> a b c\n-- type instance F Int  Char Bool = Bool\n-- type instance F Char Bool Int  = Int\n-- type instance F Bool Int  Char = Char\n$( return\n   [ OpenTypeFamilyD (TypeFamilyHead\n       (mkName \"F\")\n       [ PlainTV (mkName \"a\"), PlainTV (mkName \"b\"), PlainTV (mkName \"c\") ]\n       (TyVarSig (KindedTV (mkName \"result\") (VarT (mkName \"k\"))))\n       (Just $ InjectivityAnn (mkName \"result\")\n                             [(mkName \"a\"), (mkName \"b\"), (mkName \"c\") ]))\n   , TySynInstD\n       (TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"F\")) (ConT (mkName \"Int\")))\n                       (ConT (mkName \"Char\"))) (ConT (mkName \"Bool\")))\n                 (ConT (mkName \"Bool\")))\n\n   , TySynInstD\n       (TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"F\")) (ConT (mkName \"Char\")))\n                       (ConT (mkName \"Bool\"))) (ConT (mkName \"Int\")))\n                 (ConT (mkName \"Int\")))\n   , TySynInstD\n       (TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"F\")) (ConT (mkName \"Bool\")))\n                       (ConT (mkName \"Int\"))) (ConT (mkName \"Char\")))\n                 (ConT (mkName \"Char\")))\n   ] )\n\n-- this is injective - a type variables mentioned on LHS is not mentioned on RHS\n-- but we don't claim injectivity in that argument.\n--\n-- type family J a (b :: k) = r | r -> a\n---type instance J Int b = Char\n$( return\n   [ OpenTypeFamilyD (TypeFamilyHead\n       (mkName \"J\")\n       [ PlainTV (mkName \"a\"), KindedTV (mkName \"b\") (VarT (mkName \"k\")) ]\n       (TyVarSig (PlainTV (mkName \"r\")))\n       (Just $ InjectivityAnn (mkName \"r\") [mkName \"a\"]))\n   , TySynInstD\n       (TySynEqn Nothing (AppT (AppT (ConT (mkName \"J\")) (ConT (mkName \"Int\")))\n                       (VarT (mkName \"b\")))\n                 (ConT (mkName \"Char\")))\n   ] )\n\n-- Closed type families\n\n-- type family IClosed (a :: *) (b :: *) (c :: *) = r | r -> a b where\n--     IClosed Int  Char Bool = Bool\n--     IClosed Int  Char Int  = Bool\n--     IClosed Bool Int  Int  = Int\n\n$( return\n   [ ClosedTypeFamilyD (TypeFamilyHead\n       (mkName \"I\")\n       [ KindedTV (mkName \"a\") StarT, KindedTV (mkName \"b\") StarT\n       , KindedTV (mkName \"c\") StarT ]\n       (TyVarSig (PlainTV (mkName \"r\")))\n       (Just $ InjectivityAnn (mkName \"r\") [(mkName \"a\"), (mkName \"b\")]))\n\n       [ TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"I\")) (ConT (mkName \"Int\")))\n                                      (ConT (mkName \"Char\"))) (ConT (mkName \"Bool\")))\n                          (ConT (mkName \"Bool\"))\n\n       , TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"I\")) (ConT (mkName \"Int\")))\n                                      (ConT (mkName \"Char\"))) (ConT (mkName \"Int\")))\n                          (ConT (mkName \"Bool\"))\n\n       , TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"I\")) (ConT (mkName \"Bool\")))\n                                      (ConT (mkName \"Int\"))) (ConT (mkName \"Int\")))\n                          (ConT (mkName \"Int\"))\n       ]\n   ] )\n\n-- reification test\n$( do { decl@([ClosedTypeFamilyD (TypeFamilyHead _ _ _ (Just inj)) _]) <-\n               [d| type family Bak a = r | r -> a where\n                        Bak Int  = Char\n                        Bak Char = Int\n                        Bak a    = a |]\n      ; return decl\n      }\n )\n\n-- Check whether incorrect injectivity declarations are caught\n\n-- type family I a b c = r | r -> a b\n-- type instance I Int  Char Bool = Bool\n-- type instance I Int  Int  Int  = Bool\n-- type instance I Bool Int  Int  = Int\n$( return\n   [ OpenTypeFamilyD (TypeFamilyHead\n       (mkName \"H\")\n       [ PlainTV (mkName \"a\"), PlainTV (mkName \"b\"), PlainTV (mkName \"c\") ]\n       (TyVarSig (PlainTV (mkName \"r\")))\n       (Just $ InjectivityAnn (mkName \"r\")\n                             [(mkName \"a\"), (mkName \"b\") ]))\n\n   , TySynInstD\n         (TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"H\")) (ConT (mkName \"Int\")))\n                                       (ConT (mkName \"Char\"))) (ConT (mkName \"Bool\")))\n                           (ConT (mkName \"Bool\")))\n\n   , TySynInstD\n         (TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"H\")) (ConT (mkName \"Int\")))\n                                       (ConT (mkName \"Int\"))) (ConT (mkName \"Int\")))\n                           (ConT (mkName \"Bool\")))\n\n   , TySynInstD\n         (TySynEqn Nothing (AppT (AppT (AppT (ConT (mkName \"H\")) (ConT (mkName \"Bool\")))\n                                       (ConT (mkName \"Int\"))) (ConT (mkName \"Int\")))\n                           (ConT (mkName \"Int\")))\n   ] )\n", "num_lines": 121}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T6114 where\nimport Language.Haskell.TH\n\n$(do\n   xName <- newName \"x\"\n   instanceType <- [t| $(varT xName) |]\n   _ <- reifyInstances ''Eq [instanceType]\n   return []\n  )\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T7021 where\n\nimport T7021a\n\nfunc :: a -> Int\nfunc = $(test)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ConstraintKinds, TemplateHaskell, PolyKinds, TypeFamilies, RankNTypes #-}\n\nmodule T7021a where\n\nimport GHC.Exts\nimport Language.Haskell.TH\n\ntype IOable a = (Show a, Read a)\ntype family ALittleSilly :: Constraint\n\ndata Proxy a = Proxy\n\nfoo :: IOable a => a\nfoo = undefined\n\nbaz :: a b => Proxy a -> b\nbaz = undefined\n\nbar :: ALittleSilly  => a\nbar = undefined\n\ntest :: Q Exp\ntest = do\n    Just fooName <- lookupValueName \"foo\"\n    Just bazName <- lookupValueName \"baz\"\n    Just barName <- lookupValueName \"bar\"\n    reify fooName\n    reify bazName\n    reify barName\n    [t| forall a. (Show a, (Read a, Num a)) => a -> a |]\n    [| \\_ -> 0 |]\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Main where\n\nimport T7064a\n\n$(decls)\n\nmain = hsToTh\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7064a (decls, hsToTh) where\n\nimport Language.Haskell.TH\n\ndecls = [d|\n    f1 x = 1; f2 x = 2; f3 x = 3\n    {-# INLINE f1 #-} \n    {-# INLINE [2] f2 #-} \n    {-# INLINE CONLIKE [~2] f3 #-} \n    g1 x = 1; g2 x = 2; g3 x = 3\n    {-# SPECIALISE g1 :: Int -> Int #-}\n    {-# SPECIALISE [2] g2 :: Int -> Int #-}\n    {-# SPECIALISE INLINE [~2] g3 :: Int -> Int #-}\n    data T a = T a\n    instance Eq a => Eq (T a) where\n      {-# SPECIALISE instance Eq (T Int) #-}\n      (T x) == (T y) = x == y\n    {-# RULES\n          \"rule1\" fromIntegral = id :: a -> a ;\n          \"rule2\" [1] forall (x :: a) . fromIntegral x = x ;\n          \"rule3\" [~1] forall (x :: a) . fromIntegral x = x\n      #-}\n  |]\n\nhsToTh = do\n  decls' <- runQ decls\n  mapM (print . ppr) decls'\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -fwarn-name-shadowing #-}\n\n-- Should not produce a name-shadowing warning (GHC 7.4 did)\n\nmodule T7092 where\n\nimport T7092a\n\nblah = $(code)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T7092a where\n\nimport Language.Haskell.TH\n\ncode :: Q Exp\ncode = do\n  n1 <- newName \"foo\"\n  n2 <- newName \"foo\"\n  letE [valD (varP n1) (normalB [| (1 :: Int) |]) []] \n       $ letE [valD (varP n2) (normalB [| (2 :: Int) |]) []] \n       $ appE (appE [| ((+) :: Int -> Int -> Int)|] (varE n1)) (varE n2)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7241 where\n\nimport Language.Haskell.TH\n\n$(newName \"Foo\" >>= \\o -> return [DataD [] o [] Nothing [RecC o []] []])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7276 where\n\nx = $( [d| y = 3 |] )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7445 where\nimport T7445a\n\nmoo = $(foo)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}\nmodule T7445a ( foo ) where\n\nimport Data.Data\nimport Language.Haskell.TH.Quote\nimport Language.Haskell.TH\n\ndata Expr\n    =  IntExpr Integer\n    deriving (Show, Typeable, Data)\n\nfoo :: ExpQ\nfoo = dataToExpQ (const Nothing) (IntExpr 1)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, KindSignatures, PolyKinds, TypeFamilies, TemplateHaskell #-}\n\nmodule T7477 where\n\nimport Language.Haskell.TH\n\ntype family F (a :: k)\ntype instance F Int = Bool\n\n$( do { info <- reifyInstances ''F [ConT ''Int]\n      ; reportWarning (pprint info)\n      ; return [] })\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7484 where\n\nimport Language.Haskell.TH\n\n$( return [ ValD (VarP (mkName \"a \")) (NormalB (LitE (IntegerL 5))) [] ] )\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -ddump-rn -ddump-splices #-}\n{-# LANGUAGE TemplateHaskell, TypeFamilies #-}\nmodule T7532 where\n\nimport Language.Haskell.TH\nimport T7532a\n\ninstance C Bool where\n  data D Bool = MkD\n\n$(bang')\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T7532a where\n\nimport Language.Haskell.TH\n\nclass C a where\n     data D a\n\nbang' :: DecsQ\nbang' = return [\n     InstanceD Nothing [] (AppT (ConT ''C) (ConT ''Int)) [\n         DataInstD [] Nothing (AppT (ConT ''D) (ConT ''Int)) Nothing [\n             NormalC (mkName \"T\") []] []]]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeOperators #-}\n\nmodule T7667 where\n\nimport Language.Haskell.TH\n\n$( return [ TySynD (mkName \"+\") [PlainTV (mkName \"a\"), PlainTV (mkName \"b\")]\n                   (AppT (AppT (ConT ''Either) (VarT $ mkName \"a\")) (VarT $ mkName \"b\")) ] )", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T7667a where\n\nimport Language.Haskell.TH\n\n   -- to be correct, this should be ConE, not VarE!\nfalse = $( return $ VarE (mkName \"False\") )", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase, TemplateHaskell, LambdaCase #-}\n\nmodule T7681 where\n\ndata Void\n\nfoo :: Void -> a\nfoo x = $( [| case x of {} |] )\n\nbar :: Void -> a\nbar = $( [| \\case {} |] )\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\nclass C a\ninstance C Int\n\ntype D a = C a\n\n$(return [])\n\nmain = print $(\n  do isCInst <- isInstance ''C [ConT ''Int]\n     isDInst <- isInstance ''D [ConT ''Int]\n     lift (isCInst,isDInst))\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilies #-}\n\nmodule T8028 where\n\nimport T8028a\n\nimport Language.Haskell.TH\n\n$(x)\n\n-- Check that the empty closed type family F produced by $(x) can\n-- subsequently be reified\n$(do f <- reify ''F\n     case f of\n       FamilyI (ClosedTypeFamilyD _ []) _ -> return []\n       _ -> error $ show f\n )\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8028a where\n\nimport Language.Haskell.TH\n\nx = do n <- newName \"F\"\n       return [ClosedTypeFamilyD (TypeFamilyHead n [] NoSig Nothing) []]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds, PolyKinds,\n             GADTs #-}\n\nmodule T8031 where\n\nimport Data.Proxy\nimport Data.Kind\n\ndata SList :: [k] -> Type where\n  SCons :: Proxy h -> Proxy t -> SList (h ': t)\n\n$( [d| foo :: forall k (a :: k). Proxy a\n           -> forall (b :: [k]). Proxy b\n           -> SList (a ': b)\n       foo a b = SCons a b |] )\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, StandaloneDeriving #-}\n\nmodule T8100 where\n\nimport Language.Haskell.TH\n\ndata Foo a = Foo a\ndata Bar = Bar Int\n\n$( do decs <- [d| deriving instance Eq a => Eq (Foo a)\n                  deriving instance Ord a => Ord (Foo a) |]\n      return ( StandaloneDerivD Nothing [] (ConT ''Eq `AppT` ConT ''Bar)\n             : StandaloneDerivD Nothing [] (ConT ''Ord `AppT` ConT ''Bar)\n             : decs ) )\n\nblah :: Ord a => Foo a -> Foo a -> Ordering\nblah = compare\n\nbuzz :: Bar -> Bar -> Ordering\nbuzz = compare\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, ParallelListComp #-}\n\nmodule Main where\n\nlist = [ (x,y) | x <- [1..10], x `mod` 2 == 0 | y <- [2,6..50] ]\n\nlist' = $( [| [ (x,y) | x <- [1..10], x `mod` 2 == 0 | y <- [2,6..50] ] |] )\n\nmain = do putStrLn (show list)\n          putStrLn (show list')\n          putStrLn $ show (list == list')", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, DataKinds #-}\n\nimport Language.Haskell.TH\n\ntype T = $(return $ LitT $ NumTyLit (-1))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds #-}\n{-# OPTIONS_GHC -Wall #-}\n\nmodule T8499 where\n\nimport Language.Haskell.TH\n\n$( do TyConI (DataD _ _ [KindedTV tvb_a _] _ _ _) <- reify ''Maybe\n      my_a <- newName \"a\"\n      return [TySynD (mkName \"SMaybe\")\n                     [KindedTV my_a (AppT (ConT ''Maybe) (VarT tvb_a))]\n                     (TupleT 0)] )\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE ConstraintKinds #-}\n\nmodule T8507 where\n\ntype Stringy1 a = (Read a, Show a)\n\n$([d|type Stringy2 a = (Read a, Show a) |])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T8540 where\n\nimport T8540a\n\nbaz :: Int\nbaz = $foo\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T8540a (foo) where\n\nimport Language.Haskell.TH\n\nfoo :: Q Exp\nfoo = [| bar |]\n\nbar :: Int\nbar = 5\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T8577 where\n\nimport Language.Haskell.TH\n\nimport T8577a\n\nfoo2 :: A Bool\nfoo2 = $$(y)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule T8577a where\nimport Language.Haskell.TH\n\ndata A a = A\n\nx :: Q (TExp (A a))\nx = [|| A ||]\n\ny :: Q (TExp (A Int))\ny = x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -dth-dec-file #-}\nmodule T8624 (THDec(..)) where\n\nimport Language.Haskell.TH\n\n$(return [DataD [] (mkName \"THDec\") [] Nothing\n          [NormalC (mkName \"THDec\") []] []])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, PatternSynonyms #-}\n\nmodule T8759 where\n\nimport Language.Haskell.TH\n\npattern P = ()\n\n$( do info <- reify 'P\n      reportWarning (show info)\n      return [] )\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, RankNTypes, GADTs, PatternSynonyms #-}\n\nmodule T8761 where\n\n{- Testsuite for pattern synonyms as implemented by ticket #8761 -}\n\nimport Control.Monad\nimport Language.Haskell.TH\nimport System.IO\n\ndata Ex         where MkEx       :: forall a. a -> Ex\ndata ExProv     where MkExProv   :: forall a. (Show a) => a -> ExProv\ndata UnivProv a where MkUnivProv :: forall a. (Show a) => a -> UnivProv a\n\n{- Test manual construction and pretty printing of pattern synonyms -}\ndo\n  [qx1,qy1,qz1] <- mapM (\\i -> newName $ \"x\" ++ show i) [1,2,3]\n  let nm1       = mkName \"Q1\"\n      prefixPat = patSynD nm1 (prefixPatSyn [qx1,qy1,qz1]) unidir\n        (tupP [tupP [varP qx1, varP qy1], listP [varP qz1], wildP, wildP])\n\n  [qx2,qy2] <- mapM (\\i -> newName $ \"x\" ++ show i) [1,2]\n  let nm2      = mkName \"Q2\"\n      infixPat = patSynD nm2 (infixPatSyn qx2 qy2) implBidir\n        (tupP [tupP [varP qx2, varP qy2]])\n\n  let nm3           = mkName \"Q3\"\n      [qx3,qy3,qz3] = map mkName [\"qx3\", \"qy3\", \"qz3\"]\n      patP          = tupP [tupP [varP qx3, varP qy3], listP [varP qz3]]\n      patE          = tupE [tupE [varE qx3, varE qy3], listE [varE qz3]]\n      cls           = clause [varP qx3, varP qy3, varP qz3] (normalB patE) []\n      recordPat     = patSynD nm3 (recordPatSyn [qx3,qy3,qz3])\n                        (explBidir [cls]) patP\n\n  pats <- sequence [prefixPat, infixPat, recordPat]\n  -- pretty print the pattern synonyms:\n  mapM_ (runIO . hPutStrLn stderr . pprint) pats\n  -- splice in the pattern synonyms\n  return pats\n\n{- Test prefix pattern synonyms -}\n[d|\n pattern P1 x y z <- ((x,y), [z], _, _)   -- unidirectional pattern\n pattern P2 x y z =  ((x,y), [z])         -- implicit bidirectional pattern\n pattern P3 x y z <- ((x,y), [z]) where   -- explicit bidirectional pattern\n   P3 x y z = ((x,y), [z]) |]\n\n{- Test infix pattern synonyms -}\n[d|\n pattern x :*: y <- ((x,_), [y])\n pattern x :+: y =  (x,y)\n pattern x :~: y <- (x,y) where\n   x :~: y = (x,y) |]\n\n{- Test record pattern synonyms -}\n[d|\n pattern R1 {x1, y1} <- ((x1,_), [y1])\n getX1 = x1 ((1, 2), [3]) -- should yield 1\n getY1 = y1 ((1, 2), [3]) -- should yield 3\n pattern R2 {x2, y2} =  (x2, [y2])\n pattern R3 {x3, y3} <- (x3, [y3]) where\n   R3 x y = (x, [y]) |]\n\n--x1 = \"no, no, no\"\n--y1 = \"no, no, no\"\n\ngetX1' = x1 ((1, 2), [3]) -- should yield 1\ngetY1' = y1 ((1, 2), [3]) -- should yield 3\n\n{- Test splicing unidirectional pattern synonyms with different types -}\n[d|\n pattern P :: Bool\n pattern P <- True\n\n pattern Pe :: () => forall a. a -> Ex\n pattern Pe x <- MkEx x\n\n pattern Pu :: forall a. a -> a\n pattern Pu x <-  x\n\n pattern Pue :: forall a. () => forall b. a -> b -> (a, Ex)\n pattern Pue x y <- (x, MkEx y)\n\n pattern Pur :: forall a. (Num a, Eq a) => a -> [a]\n pattern Pur x <- [x, 1]\n\n pattern Purp :: forall a b. (Num a, Eq a) =>\n                 Show b => a -> b -> ([a], UnivProv b)\n pattern Purp x y <- ([x, 1], MkUnivProv y)\n\n pattern Pure :: forall a. (Num a, Eq a) => forall b. a -> b -> ([a], Ex)\n pattern Pure x y <- ([x, 1], MkEx y)\n\n pattern Purep :: forall a. (Num a, Eq a) =>\n                 forall b. Show b => a -> b -> ([a], ExProv)\n pattern Purep x y <- ([x, 1], MkExProv y)\n\n pattern Pep :: () => forall a. Show a => a -> ExProv\n pattern Pep x <- MkExProv x\n\n pattern Pup :: forall a. () => Show a => a -> UnivProv a\n pattern Pup x <- MkUnivProv x\n\n pattern Puep :: forall a. () => forall b. (Show b) => a -> b -> (ExProv, a)\n pattern Puep x y <- (MkExProv y, x) |]\n\n{- Test reification of different pattern synonyms and their types -}\ndo\n  infos <- mapM reify [ 'P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp\n                      , 'Pure, 'Purep, 'Pep, 'Pup, 'Puep ]\n  mapM_ (runIO . hPutStrLn stderr . pprint) infos\n    -- NB. use stderr rather than stdout, because GHC does not\n    -- guarantee to flush stdout after TH code.  In particular when\n    -- the output is going to a file, and we're using GHC with the\n    -- runtime linker or with -fexternal-interpreter, stdout will not\n    -- get flushed.\n  [d| theAnswerIs = 42 |]\n", "num_lines": 118}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ConstraintKinds, RankNTypes #-}\n\nmodule T8807 where\n\nimport Data.Proxy\n\nfoo :: $( [t| forall a b. a b => Proxy a -> b -> b |] )\nfoo = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilyDependencies, PolyKinds #-}\n\nmodule T8884 where\n\nimport Language.Haskell.TH\nimport System.IO\n\ntype family Foo a = r | r -> a where\n  Foo x = x\n\ntype family Baz (a :: k) = (r :: k) | r -> a\ntype instance Baz x = x\n\n$( do FamilyI foo@(ClosedTypeFamilyD (TypeFamilyHead _ tvbs1 res1 m_kind1)\n                   [TySynEqn (Just bndrs1) (AppT _ lhs1) rhs1])\n              [] <- reify ''Foo\n      FamilyI baz@(OpenTypeFamilyD (TypeFamilyHead _ tvbs2 res2 m_kind2))\n              [inst@(TySynInstD (TySynEqn (Just bndrs2) (AppT _ lhs2) rhs2))] <- reify ''Baz\n      runIO $ putStrLn $ pprint foo\n      runIO $ putStrLn $ pprint baz\n      runIO $ putStrLn $ pprint inst\n      runIO $ hFlush stdout\n      return [ ClosedTypeFamilyD\n                 (TypeFamilyHead (mkName \"Foo'\") tvbs1 res1 m_kind1)\n                 [TySynEqn (Just bndrs1) (AppT (ConT (mkName \"Foo'\")) lhs1) rhs1]\n             , OpenTypeFamilyD\n                 (TypeFamilyHead (mkName \"Baz'\") tvbs2 res2 m_kind2)\n             , TySynInstD (TySynEqn (Just bndrs2) (AppT (ConT (mkName \"Baz'\")) lhs2) rhs2)] )\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T8932 where\n\n$([d|\n   foo :: a -> a\n   foo x = x\n  |])\n\nfoo :: a\nfoo = undefined\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TemplateHaskell,\n             FlexibleInstances, UndecidableInstances #-}\n\nmodule T8953 where\n\nimport Data.Proxy\nimport Language.Haskell.TH hiding (Type)\nimport Data.Kind (Type)\nimport System.IO\n\ntype family Poly (a :: k) :: Type\ntype instance Poly (x :: Bool) = Int\ntype instance Poly (x :: Maybe k) = Double\n\ntype family Silly :: k -> Type\ntype instance Silly = (Proxy :: Type -> Type)\ntype instance Silly = (Proxy :: (Type -> Type) -> Type)\n\na :: Proxy (Proxy :: Type -> Type)\nb :: Proxy (Proxy :: (Type -> Type) -> Type)\na = undefined\nb = undefined\n\ntype StarProxy (a :: Type) = Proxy a\n\nclass PC (a :: k)\ninstance PC (a :: Type)\ninstance PC (Proxy :: (k -> Type) -> Type)\n\ndata T1 :: k1 -> k2 -> Type\ndata T2 :: k1 -> k2 -> Type\ntype family F a :: k\ntype family G (a :: k) :: k\ntype instance G T1 = T2\ntype instance F Char = (G T1 Bool :: (Type -> Type) -> Type)\n\n$( do infos <- mapM reify [''Poly, ''Silly, 'a, 'b, ''StarProxy, ''PC, ''F, ''G]\n      runIO $ mapM (putStrLn . pprint) infos\n      runIO $ hFlush stdout\n      return [] )\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, MagicHash, UnboxedTuples #-}\n\nmodule T8954 where\n\nimport Language.Haskell.TH\n\n$( do _ <- reify '(##)\n      _ <- reify '(#,#)\n      _ <- reify ''(##)\n      _ <- reify ''(#,#)\n      _ <- reify '()\n      _ <- reify ''()\n      _ <- reify '[]\n      _ <- reify ''[]\n      return [] )\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T8987 where\nimport Language.Haskell.TH\n\n$(reportWarning ['1', undefined] >> return [])", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Language.Haskell.TH\n\nmain = putStrLn $ pprint foo\n\nfoo :: Dec\nfoo = barD\n  where\n       barD = FunD ( mkName \"bar\" )\n                   [ Clause manyArgs (NormalB barBody) [] ]\n\n       barBody = DoE [letxStmt, retxStmt]\n       letxStmt = LetS [ ValD (VarP xName) (NormalB $ LitE $ IntegerL 5) [] ]\n       retxStmt = NoBindS $ AppE returnVarE xVarE\n       xName = mkName \"x\"\n       returnVarE = VarE $ mkName \"return\"\n       xVarE = VarE xName\n       manyArgs = map argP [0..9]\n       argP n = VarP $ mkName $ \"arg\" ++ show n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, DefaultSignatures #-}\n\nmodule T9064 where\n\nimport Language.Haskell.TH\nimport System.IO\n\n$( [d| class C a where\n         foo :: a -> String\n         default foo :: Show a => a -> String\n         foo = show |] )\n\ndata Bar = Bar deriving Show\ninstance C Bar\n\nx :: Bar -> String\nx = foo\n\n$( do info <- reify ''C\n      runIO $ do\n        putStrLn $ pprint info\n        hFlush stdout\n      return [] )\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T9066 where\n\n$([d| data Blargh = (:<=>) Int Int\n      infix 4 :<=>\n\n      type Foo a b = Either a b\n      infix 5 `Foo`\n        |])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, TypeFamilies #-}\n\nmodule T9081 where\n\nimport Data.Proxy\n\n$( [d|\n  class kproxy ~ 'KProxy => C (kproxy :: KProxy a) where\n    type TF (x :: a) :: Bool\n  |])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T9084 where\n\n$([d|\n   class C a where\n     meth :: a -> a\n     meth = undefined -- give a (silly) default\n     {-# MINIMAL meth #-}\n   |])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, PolyKinds, TypeFamilies #-}\n\nmodule T9160 where\n\nimport Data.Kind (Type)\n\n$( [d| class C (a :: k) where\n          type F (a :: k) :: Type\n    |]\n )\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T9209 where\n\nfoo = let $( [d| x = 5 |] ) in x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T9262 where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Ppr\nimport System.IO\n\n$(do insts <- reifyInstances ''Eq [ListT `AppT` VarT (mkName \"a\")]\n     runIO $ putStrLn $ pprint insts\n     runIO $ hFlush stdout\n     return [] )\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds #-}\n\nmodule T9692 where\n\nimport Data.Kind (Type)\nimport Language.Haskell.TH hiding (Type)\nimport Language.Haskell.TH.Syntax hiding (Type)\nimport Language.Haskell.TH.Ppr\nimport System.IO\n\nclass C a where\n        data F a (b :: k) :: Type\n\ninstance C Int where\n        data F Int x = FInt x\n\n$( do info <- qReify (mkName \"F\")\n      runIO $ putStrLn $ pprint info\n      runIO $ hFlush stdout\n      return [])\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9693 where\nimport Language.Haskell.TH\n\nstuff = do\n  -- let x = mkName \"X\"\n  x <- newName \"X\"\n  sequence $ [dataD (return []) x [] Nothing [\n      normalC x []\n    ] []]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nimport T9693\n\nstuff\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9693 where\nimport Language.Haskell.TH\n\nstuff = do\n  let x = mkName \"X\"\n  -- x <- newName \"X\"\n  sequence $ [dataD (return []) x [] Nothing [\n      normalC x []\n    ] []]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule T9738 where\n\nimport System.IO\nimport Language.Haskell.TH\n\ndata Foo = MkFoo\n\n$( do decs <- [d| {-# ANN type Foo \"hi\" #-}\n                  {-# ANN MkFoo \"there\" #-}\n                  {-# ANN module \"Charley\" #-}\n                   |]\n      runIO $ print decs\n      runIO $ hFlush stdout\n      return [] )\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Trac #2358\n\nmodule ShouldFail where\nimport Language.Haskell.TH\n\nx = $(sigE [|1|] (tupleT 1 `appT` conT ''Int))\n        -- 1 :: (Int)   ( a 1-tuple type)\n\ny = $(sigE [|1|] (tupleT 1))\n        -- 1 :: (1)     (a 1-tuple tycon not applied)\n\nz = $(tupE [ [| \"yes\" |] ])\n        -- (\"yes\")      (a 1-tuple expression)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\nmodule TH_class1 where\n\n$( [d| class Classy a b c d | a -> b c, c -> d where\n            f :: a -> b -> c -> d\n     |] )\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TH_dataD1 where\n\nimport Language.Haskell.TH\n\nds :: Q [Dec]\nds = [d|\n          $(do { d <- dataD (cxt []) (mkName \"D\") [] Nothing\n                             [normalC (mkName \"K\") []] []\n               ; return [d]})\n       |]\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule Main where\n\nimport TH_Depends_External (loadStringFromFile)\n\nmain :: IO ()\nmain = putStrLn $loadStringFromFile\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TH_Depends_External where\n\nimport Language.Haskell.TH.Syntax\nimport Language.Haskell.TH.Lib\n\nloadStringFromFile :: Q Exp\nloadStringFromFile = do\n  let externalDependency = \"TH_Depends_external.txt\"\n  qAddDependentFile externalDependency\n  s <- qRunIO $ readFile externalDependency\n  stringE s\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Two sliced declarations bind the same variable.\n-- This test checks that there's a reasonable error message\n\nmodule ShouldCompile where\n\n$( [d| x = 1 |] )\n\n$( [d| x = 2 |] )\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, EmptyCase #-}\n-- Trac #2431: empty case expression\n--             now accepted\n\nmodule Main where\n\nimport Language.Haskell.TH\n\nf :: Int\nf = $(caseE (litE $ CharL 'a') [])\n\nmain = print f\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test error message when the code in a splice\n-- fails in an immediate fashion (e.g. with a\n-- pattern match failure)\n\nmodule ShouldCompile where\n\n$( case reverse \"no\" of\n        [] -> return []\n )\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test error message when the code in a splice\n-- fails in a lazy fashion (e.g. a (head [])\n-- thunk is embedded in the returned structure).\n\nmodule TH where\n\n$( do { ds <- [d| |] \n      ; return (tail ds) }\n )\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, ExplicitForAll #-}\n\nmodule Main where\n\nimport TH_ExplicitForAllRules_a\n\n$(decls)\n\nmain = hsToTh\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\nmodule TH_ExplicitForAllRules_a (decls, hsToTh) where\n\nimport Language.Haskell.TH\n\ndecls = [d| {-# RULES \"example\" forall a. forall (x :: a). id x = x #-} |]\n\nhsToTh = do\n  decls' <- runQ decls\n  mapM (print . ppr) decls'\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test for sane reporting on TH code giving up.\n\nmodule ShouldCompile where\n\n$( fail \"Code not written yet...\" )\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule ShouldCompile where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\n$( do\n     addModFinalizer (do b <- getQ; reportWarning (show (b::Maybe Bool)))\n     return [] )\n$( putQ True >> return [] )\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import TH_finalizer2M\n\nmain = print (f 0)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule TH_finalizer2M where\n\nimport Language.Haskell.TH.Syntax\n\ng :: IO ()\ng = $(do addModFinalizer (do d <- [d| f x = (2 :: Int) |]; addTopDecls d)\n         [| return ()|]\n     )\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ForeignFunctionInterface, CApiFFI, GHCForeignImportPrim,\n             QuasiQuotes, TemplateHaskell, JavaScriptFFI, MagicHash,\n             UnliftedFFITypes #-}\n\nmodule TH_foreignCallingConventions where\n\nimport GHC.Prim\nimport Control.Applicative\nimport Language.Haskell.TH\nimport System.IO\nimport Foreign.Ptr\n\n$( do let fi cconv safety lbl name ty =\n            ForeignD (ImportF cconv safety lbl name ty)\n      dec1 <- fi CCall      Interruptible \"&\"   (mkName \"foo\") <$> [t| Ptr () |]\n      dec2 <- fi Prim       Safe          \"bar\" (mkName \"bar\") <$> [t| Int# -> Int# |]\n      -- the declarations below would result in warnings or errors when returned\n      dec3 <- fi CApi       Unsafe        \"baz\" (mkName \"baz\") <$> [t| Double -> IO () |]\n      dec4 <- fi StdCall    Safe          \"bay\" (mkName \"bay\") <$> [t| (Int -> Bool) -> IO Int |]\n      dec5 <- fi JavaScript Unsafe        \"bax\" (mkName \"bax\") <$> [t| Ptr Int -> IO String |]\n      runIO $\n        mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5] >> hFlush stdout\n      return [dec1, dec2]\n )\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, ForeignFunctionInterface, InterruptibleFFI #-}\n\nmodule TH_foreign where\n\nimport Foreign.Ptr\nimport Language.Haskell.TH\n\n$(return [ForeignD (ImportF CCall Interruptible \"&\" (mkName \"foo\") (AppT (ConT ''Ptr) (ConT ''())))])\n\n-- Should generate the same as this:\nforeign import ccall interruptible \"&\" foo1 :: Ptr ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -ddump-splices -XExistentialQuantification #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH_genEx where\n\nimport TH_genExLib\nimport Language.Haskell.TH\n\nclass MyInterface a where\n  foo :: a -> Int\n  foo1 :: Int -> a -> Int\n\n$(genAny (reify ''MyInterface))\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TH_genExLib where\n\nimport Language.Haskell.TH\n\ngenAny :: Q Info -> Q [Dec]\ngenAny decl = do { d <- decl\n                 ; case d of\n                    ClassI (ClassD _ name _ _ decls) _ -> return [genAnyClass name decls]\n                    _ -> error \"genAny can be applied to classes only\"\n        }\n\ngenAnyClass :: Name -> [Dec] -> Dec\ngenAnyClass name decls\n  = DataD [] anyName [] Nothing [constructor] []\n  where\n    anyName = mkName (\"Any\" ++ nameBase name ++ \"1111\")\n    constructor = ForallC [PlainTV var_a] [AppT (ConT name) (VarT var_a)] $\n                  NormalC anyName\n                                [(Bang NoSourceUnpackedness NoSourceStrictness, VarT var_a)]\n    var_a = mkName \"a\"\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\nfuncToReify :: (?z :: Int) => Int\nfuncToReify = ?z\n\n$( [d|\n        f :: (?x :: Int) => Int\n        f = let ?y = 2 in ?x + ?y |] )\n\nmain = do\n    putStrLn $(lift . pprint =<< reify 'funcToReify)\n    print (let ?x = 3 in f)\n    print $( [| let ?x = 1 in ?x |] )\n    print $(letE [implicitParamBindD \"y\" (lift (2 :: Int))]\n                 (implicitParamVarE \"y\") )\n    putStrLn $( lift . pprint =<< [d|\n        f :: (?x :: Int) => Int\n        f = let ?y = 2 in ?x + ?y |] )\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n{-# LANGUAGE TemplateHaskell #-}\nimport Language.Haskell.TH\n\n$(fmap (:[]) (implicitParamBindD \"x\" [e| 1 |]))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n{-# LANGUAGE TemplateHaskell #-}\nimport Language.Haskell.TH\n\nmain = $(letE [ implicitParamBindD \"x\" [e| 1 |]\n              , funD (mkName \"y\") [clause [] (normalB [e| 2 |]) []]\n              ]\n              (varE (mkName \"y\")))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n{-# LANGUAGE TemplateHaskell #-}\nimport Language.Haskell.TH\n\nmain = print $(letE [implicitParamBindD \"invalid name\" [e| \"hi\" |]]\n                    (implicitParamVarE \"invalid name\"))\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\n\n$(do\n  invalidDecl <- valD (varP (mkName \"emptyDo\")) (normalB (doE [])) []\n  addTopDecls [invalidDecl]\n  return [])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test Lifting instances\n\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH_Lift where\n\nimport Language.Haskell.TH.Syntax\nimport Data.Ratio\nimport Data.Word\nimport Data.Int\nimport Numeric.Natural\nimport Data.List.NonEmpty\n\na :: Integer\na = $( (\\x -> [| x |]) (5 :: Integer) )\n\nb :: Int\nb = $( (\\x -> [| x |]) (5 :: Int) )\n\nb1 :: Int8\nb1 = $( (\\x -> [| x |]) (5 :: Int8) )\n\nb2 :: Int16\nb2 = $( (\\x -> [| x |]) (5 :: Int16) )\n\nb3 :: Int32\nb3 = $( (\\x -> [| x |]) (5 :: Int32) )\n\nb4 :: Int64\nb4 = $( (\\x -> [| x |]) (5 :: Int64) )\n\nc :: Word\nc = $( (\\x -> [| x |]) (5 :: Word) )\n\nd :: Word8\nd = $( (\\x -> [| x |]) (5 :: Word8) )\n\ne :: Word16\ne = $( (\\x -> [| x |]) (5 :: Word16) )\n\nf :: Word32\nf = $( (\\x -> [| x |]) (5 :: Word32) )\n\ng :: Word64\ng = $( (\\x -> [| x |]) (5 :: Word64) )\n\ng1 :: Natural\ng1 = $( (\\x -> [| x |]) (5 :: Natural) )\n\nh :: Rational\nh = $( (\\x -> [| x |]) (5 % 3 :: Rational) )\n\nh1 :: Float\nh1 = $( (\\x -> [| x |]) (pi :: Float) )\n\nh2 :: Double\nh2 = $( (\\x -> [| x |]) (pi :: Double) )\n\ni :: Char\ni = $( (\\x -> [| x |]) 'x' )\n\nj :: Bool\nj = $( (\\x -> [| x |]) True )\n\nk :: Maybe Char\nk = $( (\\x -> [| x |]) (Just 'x') )\n\nl :: Either Char Bool\nl = $( (\\x -> [| x |]) (Right False :: Either Char Bool) )\n\nm :: [Char]\nm = $( (\\x -> [| x |]) \"hi!\")\n\nn :: ()\nn = $( (\\x -> [| x |]) () )\n\no :: (Bool, Char, Int)\no = $( (\\x -> [| x |]) (True, 'x', 4 :: Int) )\n\np :: NonEmpty Char\np = $( (\\x -> [| x |])  ('a' :| \"bcde\") )\n\n", "num_lines": 83}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test that LINE pragmas influence type error messages correctly\n\nmodule ShouldFail where\n\nimport Language.Haskell.TH\n\n$( do p  <- pragLineD 42 \"virtual file\"\n      ds <- [d| x = $(varE (mkName \"doesntExist\")) |]\n      return (p:ds) )\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test 'lookupTypeName' and 'lookupValueName'\n\nimport Language.Haskell.TH\n\nimport qualified TH_lookupName_Lib\nimport qualified TH_lookupName_Lib as TheLib\n\nf :: String\nf = \"TH_lookupName.f\"\n\ndata D = D\n\n$(return [])\n\nmain = mapM_ print [\n  -- looking up values\n  $(do { Just n <- lookupValueName \"f\" ; varE n }),\n  $(do { Nothing <- lookupTypeName \"f\";  [| \"\" |] }),\n  -- looking up types\n  $(do { Just n <- lookupTypeName \"String\"; sigE [| \"\" |] (conT n) }),\n  $(do { Nothing <- lookupValueName \"String\"; [| \"\" |] }),\n  -- namespacing\n  $(do { Just n <- lookupValueName \"D\"; DataConI{} <- reify n; [| \"\" |] }),\n  $(do { Just n <- lookupTypeName \"D\"; TyConI{} <- reify n; [| \"\" |] }),\n  -- qualified lookup\n  $(do { Just n <- lookupValueName \"TH_lookupName_Lib.f\"; varE n }),\n  $(do { Just n <- lookupValueName \"TheLib.f\"; varE n }),\n  -- shadowing\n  $(TheLib.lookup_f),\n  $( [| let f = \"local f\" in $(TheLib.lookup_f) |] ),\n  $( [| let f = \"local f\" in $(do { Just n <- lookupValueName \"f\"; varE n }) |] ),\n  $( [| let f = \"local f\" in $(varE 'f) |] ),\n  let f = \"local f\" in $(TheLib.lookup_f),\n  let f = \"local f\" in $(varE 'f)\n ]\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_lookupName_Lib where\n\nimport Language.Haskell.TH\n\nf :: String\nf = \"TH_lookupName_Lib.f\"\n\nlookup_f :: Q Exp\nlookup_f = do { Just n <- lookupValueName \"f\"; varE n }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test name quoting and splicing, for built-in syntax\n\nmodule TH_mkName where\n\nimport Language.Haskell.TH\n\nx1 = $( return (ConE '()))\nx2 = $( return (ConE '(,)))\nx3 = $( return (ConE '[]))\nx4 = $( return (ConE '(:)))\nx5 = $( return (ConE 'Just))\n\ny1 = $( return (ConE (mkName \"()\")))\ny2 = $( return (ConE (mkName \"(,)\")))\ny3 = $( return (ConE (mkName \"[]\")))\ny4 = $( return (ConE (mkName \":\")))\ny5 = $( return (ConE (mkName \"Just\")))\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\neitherName, fooName, moduleFooName :: Name\neitherName = ''Either\nfooName = mkName \"foo\"\nmoduleFooName = mkName \"Module.foo\"\n\nmain :: IO ()\nmain = do\n  print $ nameBase eitherName\n  print $ nameBase fooName\n  print $ nameBase moduleFooName\n\n  print $ nameModule eitherName\n  print $ nameModule fooName\n  print $ nameModule moduleFooName\n\n  print $ namePackage eitherName\n  print $ namePackage fooName\n  print $ namePackage moduleFooName\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Data.Maybe (Maybe(..))\nimport Data.Ord (Ord)\nimport Language.Haskell.TH (mkName, nameSpace)\n\nmain :: IO ()\nmain = mapM_ (print . nameSpace)\n             [ 'Prelude.id\n             , mkName \"id\"\n             , 'Data.Maybe.Just\n             , ''Data.Maybe.Maybe\n             , ''Data.Ord.Ord\n             ]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule TH_NestedSplices where\n\nimport Language.Haskell.TH\n\nimport TH_NestedSplices_Lib\n-- This import brings in\n--   spliceExpr :: String -> Q Exp -> Q Exp\n--   declareFun :: String -> Q [Dec]\n\n-- Top level splice without $\ndeclareFun \"a\"\n\n-- Splice inside splice\n$(declareFun $(stringE \"b\"))\n\n-- Splice inside splice without outer $\ndeclareFun $(stringE \"c\")\n\n-- Ordinary splicing\nf x = $(spliceExpr \"boo\" [| x |])\n\n-- Splice inside splice\ng x = $(spliceExpr $(litE (stringL \"boo\")) [| x |])\n\n-- Ordinary splice inside bracket\nh1 = [| $(litE (integerL 3)) |]\n\n-- Splice inside splice inside bracket\nh2 = [| $(litE ($(varE 'integerL) 3)) |]\n\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule TH_NestedSplices_Lib where\n\nimport Language.Haskell.TH\n\nspliceExpr :: String -> Q Exp -> Q Exp\nspliceExpr s e = [| (s, $e) |]\n\ndeclareFun :: String -> Q [Dec]\ndeclareFun s\n  = do { n <- newName s\n       ; d <- funD n [clause [] (normalB [| 22 |]) []]\n       ; return [d] }\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}\nmodule TH_overlaps where\n\nimport Language.Haskell.TH\n\nclass C1 a where c1 :: a\nclass C2 a where c2 :: a\nclass C3 a where c3 :: a\n\n[d|\n  instance {-# OVERLAPPABLE #-} C1 [a]      where c1 = []\n  instance                      C1 [Int]    where c1 = [1]\n\n  instance                      C2 [a]      where c2 = []\n  instance {-# OVERLAPPING #-}  C2 [Int]    where c2 = [1]\n\n  instance                      C3 [a]      where c3 = []\n  instance {-# OVERLAPS #-}     C3 [[a]]    where c3 = [[]]\n  instance                      C3 [[Int]]  where c3 = [[1]]\n  |]\n\ntest1 :: ([Char],[Int])\ntest1 = (c1,c1)\n\ntest2 :: ([Char],[Int])\ntest2 = (c2,c2)\n\ntest3 :: ([Char],[[Char]],[[Int]])\ntest3 = (c3,c3,c3)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE OverloadedLabels #-}\n{-# LANGUAGE DuplicateRecordFields #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\nmodule TH_overloadedlabels where\n\nimport Language.Haskell.TH\nimport GHC.OverloadedLabels\n\ndata T = T { sel :: Int}\n\ninstance IsLabel \"sel\" (T -> Int) where\n  fromLabel (T n) = n\n\nx :: Int\nx = $(labelE \"sel\") (T 5)\n\ny :: Int\ny = $( [| #sel |] ) (T 6)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -ddump-splices #-}\n{-# LANGUAGE TemplateHaskell #-}\nmodule TH_pragma where\n\n\n$( [d| foo :: Int -> Int\n       {-# NOINLINE foo #-}\n       foo x = x + 1    |] )\n\n$( [d| bar :: Num a => a -> a\n       {-# SPECIALISE INLINE [~1] bar :: Float -> Float #-}\n       bar x = x * 10        |] )\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH_Promoted1Tuple where\n\nimport Language.Haskell.TH\n\n$(sequence [tySynD (mkName \"F\") [] (appT (promotedTupleT 1) (conT ''Int))])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule TH_PromotedList where\n\nimport Language.Haskell.TH\n\n$(let ty = AppT (AppT PromotedConsT (ConT ''Int))\n            (AppT (AppT PromotedConsT (ConT ''Bool)) PromotedNilT)\n\n  in  reportWarning (pprint ty) >>\n        return [])\n\ndata Proxy a = Proxy\n\nf :: Proxy (True ': $(appT (appT promotedConsT (conT 'False)) promotedNilT))\nf = Proxy :: Proxy ('[True, False] :: [Bool])\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH_PromotedTuple where\n\nimport Language.Haskell.TH\n\ndata Equal a b where\n  Refl :: Equal a a\n\nequal :: Equal '(Int, False) $(do ty <- [t| '(Int, False) |]\n                                  reportWarning (show ty)\n                                  return ty)\n\nequal = Refl\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_raiseErr1 where\nimport Language.Haskell.TH\n\nfoo = $(do { report True \"Error test succeeded\"; fail \"\" })\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Same as T14471 but also enables RebindableSyntax, since that's a\n-- tricky case.\n\n{-# LANGUAGE ApplicativeDo #-}\n{-# LANGUAGE RebindableSyntax #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nimport Language.Haskell.TH\nimport Prelude\n\nmain = putStrLn $(do\n  expr <- [|\n    do x <- getLine\n       y <- getLine\n       pure (x, y)\n    |]\n  stringE (pprint expr))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Language.Haskell.TH\n\n-- The recover successfully find that 'ola' is not in scope\n-- and use '1' instead\n\ny = $(recover (return (LitE (IntegerL 1)))\n              (reify (mkName (\"ola\")) >> return (LitE (IntegerL 2))))\n\nmain = print y\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -Wall #-}\nmodule Bug where\n\nimport Language.Haskell.TH\n\n-- Warnings should be preserved through recover\nmain :: IO ()\nmain = putStrLn $(recover (stringE \"splice failed\")\n                          [| let x = \"a\" in let x = \"b\" in x |])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecursiveDo #-}\nimport Data.IORef\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\nimport TH_recursiveDoImport\n\nmain = testRec >> testMdo\n\ntestRec = do\n    putStrLn $(lift . pprint =<< recIO)\n    -- Test that we got the expected structure.\n    SelfRef r1 <- $(recIO)\n    r2 <- readIORef r1\n    SelfRef r1' <- readIORef r2\n    print (r1 == r1')\n\ntestMdo =\n    putStrLn $(lift . pprint =<< mdoIO)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecursiveDo #-}\nmodule TH_recursiveDoImport where\nimport Data.IORef\nimport Language.Haskell.TH\n\ndata SelfRef = SelfRef (IORef (IORef SelfRef))\n\nrecIO :: ExpQ\nrecIO = [e|\n    do rec r1 <- newIORef r2\n           r2 <- newIORef (SelfRef r1)\n       readIORef r2 |]\n\nmdoIO :: ExpQ\nmdoIO = [e|\n    mdo r1 <- return r2\n        r2 <- return (const 1 r1)\n        return r1 |]\n\nemptyRecIO :: ExpQ\nemptyRecIO = [e|\n   do rec {}\n      return () |]\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test reification of data declarations\n\n{-# LANGUAGE TypeFamilies, TypeApplications, PolyKinds #-}\nmodule TH_reifyDecl1 where\n\nimport Data.Kind as K\nimport System.IO\nimport Language.Haskell.TH\nimport Text.PrettyPrint.HughesPJ\n\ninfixl 3 `m1`\n\n-- simple\ndata T = A | B\n\n-- parametric\ndata R a = C a | D\n\n-- recursive\ndata List a = Nil | Cons a (List a)\n\n-- infix operator\ndata Tree a = Leaf | Tree a :+: Tree a\n\n-- type declaration\ntype IntList = [Int]\n\n-- newtype declaration\nnewtype Length = Length Int\n\n-- simple class\nclass C1 a where\n  m1 :: a -> Int\n\n-- class with instances\nclass C2 a where\n  m2 :: a -> Int\ninstance C2 Int where\n  m2 x = x\n\n-- associated types\nclass C3 a where\n  type AT1 a\n  data AT2 a\n\ninstance C3 Int where\n  type AT1 Int = Bool\n  data AT2 Int = AT2Int\n\n-- type family\ntype family TF1 a\n\n-- type family, with instances\ntype family TF2 a\ntype instance TF2 Bool = Bool\n\n-- data family\ndata family DF1 a\n\n-- data family, with instances\ndata family DF2 a\ndata instance DF2 Bool = DBool\n\ndata family DF3 (a :: k)\ndata instance DF3 @K.Type a = DF3Bool\ndata instance DF3 @(K.Type -> K.Type) b = DF3Char\n\n$(return [])\n\ntest :: ()\ntest = $(let\n      display :: Name -> Q ()\n      display q = do { i <- reify q; runIO $ hPutStrLn stderr (pprint i) }\n    in do { display ''T\n          ; display ''R\n          ; display ''List\n          ; display ''Tree\n          ; display ''IntList\n          ; display ''Length\n          ; display 'Leaf\n          ; display 'm1\n          ; display ''C1\n          ; display ''C2\n          ; display ''C3\n          ; display ''AT1\n          ; display ''AT2\n          ; display ''TF1\n          ; display ''TF2\n          ; display ''DF1\n          ; display ''DF2\n          ; display ''DF3\n          ; [| () |] })\n", "num_lines": 93}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TH_reifyDecl2 where\n\nimport Language.Haskell.TH\nimport System.IO\n\n$(\n    do x <- reify ''Maybe\n       runIO $ hPutStrLn stderr $ pprint x\n       return []\n )\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test reification of explicit foralls in type families\n\n{-# LANGUAGE TypeFamilies, ExplicitForAll #-}\nmodule TH_reifyExplicitForAllFams where\n\nimport System.IO\nimport Language.Haskell.TH\nimport Text.PrettyPrint.HughesPJ\n\nimport Data.Proxy\nimport Data.Kind\n\n$([d| data family F a\n      data instance forall a. F (Maybe a) = MkF a |])\n\n$([d| class C a where\n        type G a b\n      instance forall a. C [a] where\n        type forall b. G [a] b = Proxy b |])\n\n$([d| type family H a b where\n        forall x y. H [x] (Proxy y) = Either x y\n        forall z.   H z   z         = Maybe z |])\n\n$(return [])\n\ntest :: ()\ntest = $(let\n      display :: Name -> Q ()\n      display q = do { i <- reify q; runIO $ hPutStrLn stderr (pprint i) }\n    in do { display ''F\n          ; display ''C\n          ; display ''G\n          ; display ''H\n          ; [| () |] })\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test reifyInstances\n\n{-# LANGUAGE TypeFamilies #-}\nmodule TH_reifyInstances where\n\nimport System.IO\nimport Language.Haskell.TH\nimport Text.PrettyPrint.HughesPJ\n\n-- classes\nclass C1 a where f1 :: a\n\nclass C2 a where f2 :: a\ninstance C2 Int where f2 = 0\ninstance C2 Bool where f2 = True\n\n-- type families\ntype family T1 a\n\ntype family T2 a\ntype instance T2 Int = Char\ntype instance T2 Bool = Int\n\n-- data families\ndata family D1 a\n\ndata family D2 a\ndata instance D2 Int = DInt | DInt2\ndata instance D2 Bool = DBool\n\n$(return [])\n\ntest :: ()\ntest = $(let\n          display :: Name -> Q ()\n          display n = do \n               { intTy <- [t| Int |]\n               ; is1 <- reifyInstances n [intTy]\n               ; runIO $ hPutStrLn stderr (nameBase n)\n               ; runIO $ hPutStrLn stderr (pprint is1)\n               }\n        in do { display ''C1\n              ; display ''C2\n              ; display ''T1\n              ; display ''T2\n              ; display ''D1\n              ; display ''D2\n              ; [| () |]\n              })\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test reification of local definitions\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE TemplateHaskell #-}\nimport Language.Haskell.TH.Syntax\nimport System.IO\n\n-- Sidestep the staging restriction\n-- printTypeOf :: String -> Q ()\n#define printTypeOf(n) (addModFinalizer $ do \\\n                       { VarI _ t _ <- reify (mkName (n)) \\\n                       ; runIO $ hPutStrLn stderr (n ++ \" :: \" ++ show t) \\\n                       })\n\nmain :: IO ()\nmain = print (f 1 \"\", g 'a' 2, h True 3)\n  where\n    f xf yf = ( xf :: Int\n              , let ff $(do printTypeOf(\"yf\")\n                            [p| z |]\n                        ) = z :: $(do printTypeOf(\"z\")\n                                      [t| () |]\n                                  )\n                 in $(do printTypeOf(\"xf\")\n                         [| yf :: String |]\n                     )\n            )\n    g xg y = ( $(do printTypeOf(\"xg\")\n                    [| y :: Int |]\n                )\n             , xg :: Char\n             )\n    h xh y = ( $$(do printTypeOf(\"xh\")\n                     [|| y :: Int ||]\n                 )\n             , xh :: Bool\n             )\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests that a complete type is yielded by reify for local definitions,\n-- even when using functional dependencies which are resolved at the very end of\n-- type checking.\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE FunctionalDependencies #-}\nmodule TH_reifyLocalDefs2 where\nimport Language.Haskell.TH as TH\nimport Language.Haskell.TH.Syntax as TH\nimport System.IO\n\nclass C a b | a -> b where\n  yo :: a -> IO b\n\ninstance C Bool Int where\n  yo _ = return 0\n\nt3 :: IO ()\nt3 = do\n  x <- yo True\n  $(do addModFinalizer $ do\n         VarI _ t _ <- TH.reify 'x\n         runIO $ hPutStrLn stderr $ show t\n       [| return () |]\n   )\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2339\n\nmodule Foo where\n\nimport System.IO\nimport Language.Haskell.TH\n\ntype C = Int\n\n$(do\n  a <- reify $ mkName \"C\"\n  runIO $ hPutStrLn stderr (show a)\n  return []\n  )\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test the representation of literals and also explicit type annotations\n\nmodule Main\nwhere\n\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = mapM_ putStrLn [show an_integral, show an_int, show an_integer,\n                       show an_char, show an_string, show an_fractional,\n                       show an_float, show an_double]\n\nan_integral :: Integer\nan_integral = $( [| 42 |] )\n\nan_int :: Int\nan_int = $( [| 42 :: Int |] )\n\nan_integer :: Integer\nan_integer = $( [| 98765432123456789876 :: Integer |] )\n\nan_char :: Char\nan_char = $( [| 'x' |] )\n\nan_string :: String\nan_string = $( [| \"A String\" |] )\n\nan_fractional :: Double\nan_fractional = $( [| 1.2 |] )\n\nan_float :: Float\nan_float = $( [| 1.2 :: Float |] )\n\nan_double :: Double\nan_double = $( [| 1.2 :: Double |] )\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main\nwhere\n\nimport Language.Haskell.TH\nimport System.IO\n\n$(\n  do ds <- [d|\n        foo :: Int -> Int\n        foo x\n         | x == 5 = 6\n        foo x = 7\n      |]\n     runIO $ do { putStrLn (pprint ds); hFlush stdout }\n     return ds\n )\n\n$(\n  do ds <- [d|\n        bar :: Maybe Int -> Int\n        bar x\n         | Just y <- x = y\n        bar _ = 9\n      |]\n     runIO $ do { putStrLn (pprint ds) ; hFlush stdout }\n     return ds\n )\n\nmain :: IO ()\nmain = do putStrLn $ show $ foo 5\n          putStrLn $ show $ foo 8\n          putStrLn $ show $ bar (Just 2)\n          putStrLn $ show $ bar Nothing\n\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test the representation of unboxed literals\n\nmodule Main\nwhere\n\n$(\n    [d|\n        foo :: Int -> Int\n        foo x\n         | x == 5 = 6\n        foo x = 7\n      |]\n )\n\n$(\n    [d|\n        bar :: Maybe Int -> Int\n        bar x\n         | Just y <- x = y\n        bar _ = 9\n      |]\n )\n\nmain :: IO ()\nmain = do putStrLn $ show $ foo 5\n          putStrLn $ show $ foo 8\n          putStrLn $ show $ bar (Just 2)\n          putStrLn $ show $ bar Nothing\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Main\nwhere\n\nimport TH_repPatSig_asserts\n\nassertFoo [d| foo :: Int -> Int\n              foo (x :: Int) = x\n            |]\n\nassertCon [| \\(x :: Either Char Int -> (Char, Int)) -> x |]\n\nassertVar [| \\(x :: Maybe a) -> case x of Just y -> (y :: a) |]\n\nmain :: IO ()\nmain = return ()\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Main\nwhere\n\nimport Language.Haskell.TH\n\n$([d| f = \\(_ :: Either a b) -> $(sigE (varE 'undefined) (varT ''c)) |])\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_repPatSig_asserts where\n\nimport Language.Haskell.TH\n\nassertFoo :: Q [Dec] -> Q [Dec]\nassertFoo decsQ = do\n  decs <- decsQ\n  case decs of\n    [ SigD _ (AppT (AppT ArrowT (ConT t1)) (ConT t2)),\n      FunD _ [Clause [SigP (VarP _) (ConT t3)] (NormalB (VarE _)) []] ]\n      | t1 == ''Int && t2 == ''Int && t3 == ''Int -> return []\n    _  -> do reportError $ \"Unexpected quote contents: \" ++ show decs\n             return []\n\nassertCon :: Q Exp -> Q [Dec]\nassertCon expQ = do\n  exp <- expQ\n  case exp of\n    LamE [SigP (VarP _) (AppT (AppT ArrowT (AppT (AppT (ConT eitherT)\n                                                       (ConT charT1))\n                                                 (ConT intT1)))\n                              (AppT (AppT (TupleT 2) (ConT charT2))\n                                    (ConT intT2)))]\n         (VarE _)\n      | eitherT == ''Either &&\n        charT1 == ''Char &&\n        charT2 == ''Char &&\n        intT1 == ''Int &&\n        intT2 == ''Int -> return []\n    _ -> do reportError $ \"Unexpected quote contents: \" ++ show exp\n            return []\n\nassertVar :: Q Exp -> Q [Dec]\nassertVar expQ = do\n  exp <- expQ\n  case exp of\n    LamE [SigP (VarP x) (AppT (ConT _) (VarT a))]\n         (CaseE (VarE x1) [Match (ConP _ [VarP y])\n                                 (NormalB (SigE (VarE y1) (VarT a1))) []])\n      | x1 == x &&\n        y1 == y &&\n        a1 == a -> return []\n    _ -> do reportError $ \"Unexpected quote contents: \" ++ show exp\n            return []\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- test the representation of unboxed literals\n\nmodule Main where\n\nimport GHC.Exts\nimport GHC.Float\nimport Language.Haskell.TH\nimport Text.PrettyPrint\nimport System.IO\n\nmain :: IO ()\nmain = do putStrLn $ show $ $( do e <- [| I# 20# |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  return e )\n          putStrLn $ show $ $( do e <- [| W# 32## |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  return e )\n          putStrLn $ show $ $( do e <- [| F# 12.3# |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  return e )\n          putStrLn $ show $ $( do e <- [| D# 24.6## |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  return e )\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n-- test the representation of unboxed literals\n\nmodule Main where\n\nimport GHC.Exts\nimport GHC.Float\nimport Language.Haskell.TH\nimport Text.PrettyPrint\nimport System.IO\n\nmain :: IO ()\nmain = do putStrLn $ show $ $( do e <- [| 20# |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  [| I# $( return e) |] )\n          putStrLn $ show $ $( do e <- [| 32## |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  [| W# $(return e) |] )\n          putStrLn $ show $ $( do e <- [| 12.3# |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  [| F# $(return e) |] )\n          putStrLn $ show $ $( do e <- [| 24.6## |]\n                                  runIO $ putStrLn $ show e\n                                  runIO $ putStrLn $ pprint e\n                                  runIO $ hFlush stdout\n                                  [| D# $(return e) |] )\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n-- test the representation of unboxed literals\n\nmodule Main\nwhere\n\nimport GHC.Exts\nimport GHC.Float\nimport Language.Haskell.TH\nimport Text.PrettyPrint\nimport System.IO\n\nmain :: IO ()\nmain = do putStrLn $ show $ $( do e <- [| I# 20# |]\n                                  return e )\n          putStrLn $ show $ $( do e <- [| W# 32## |]\n                                  return e )\n          putStrLn $ show $ $( do e <- [| F# 12.3# |]\n                                  return e )\n          putStrLn $ show $ $( do e <- [| D# 24.6## |]\n                                  return e )\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n-- test the representation of unboxed literals\n\nmodule Main\nwhere\n\nimport GHC.Exts\nimport GHC.Float\nimport Language.Haskell.TH\nimport Text.PrettyPrint\nimport System.IO\n\nmain :: IO ()\nmain = do putStrLn $ show $ $( do e <- [| 20# |]\n                                  [| I# $(return e) |] )\n          putStrLn $ show $ $( do e <- [| 32## |]\n                                  [| W# $(return e) |] )\n          putStrLn $ show $ $( do e <- [| 12.3# |]\n                                  [| F# $(return e) |] )\n          putStrLn $ show $ $( do e <- [| 24.6## |]\n                                  [| D# $(return e) |] )\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, UnboxedTuples #-}\n-- test the representation of unboxed tuples\n\nmodule Main where\n\nimport GHC.Exts\nimport GHC.Float\nimport Language.Haskell.TH\nimport Text.PrettyPrint\nimport System.IO\n\nmain :: IO ()\nmain = case bar () of\n       (# str, int #) ->\n           print (str, int)\n\nbar :: () -> (# String, Int #)\nbar () = $( do e <- [| case (# 'b', False #) of\n                       (# 'a', True  #) -> (# \"One\", 1 #)\n                       (# 'b', False #) -> (# \"Two\", 2 #)\n                       (# _,   _     #) -> (# \"Three\", 3 #)\n                     |]\n               runIO $ putStrLn $ show e\n               runIO $ putStrLn $ pprint e\n               runIO $ hFlush stdout\n               return e )\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH_RichKinds where\n\nimport Data.Kind (Type, Constraint)\nimport Language.Haskell.TH hiding (Type)\n\n$(do  tys <- sequence [ [t| forall a. (a :: Bool) |]\n                      , [t| forall a. (a :: Constraint) |]\n                      , [t| forall a. (a :: [Type]) |]\n                      , [t| forall a. (a :: (Type, Bool)) |]\n                      , [t| forall a. (a :: ()) |]\n                      , [t| forall a. (a :: (Type -> Bool)\n                                         -> ((Type, Type -> Type) -> Bool)) |]\n                      ]\n\n      reportWarning (pprint tys)\n      return [])\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule TH_RichKinds2 where\n\nimport qualified Data.Kind as K\nimport Data.Char\nimport Data.List\nimport Language.Haskell.TH\n\n$(return [OpenTypeFamilyD (TypeFamilyHead\n          (mkName \"Map\") [KindedTV (mkName \"f\")\n                          (AppT (AppT ArrowT (VarT (mkName \"k1\")))\n                           (VarT (mkName \"k2\"))),\n                          KindedTV (mkName \"l\")\n                          (AppT ListT\n                           (VarT (mkName \"k1\")))]\n          (KindSig (AppT ListT (VarT (mkName \"k2\")))) Nothing)])\n\n$( let fixKs :: String -> String -- need to remove TH renaming index from k variables\n       fixKs s =\n         case (elemIndex 'k' s) of\n           Nothing -> s\n           Just i ->\n             if i == (length s) || (s !! (i+1) /= '_') then s else\n             let (prefix, suffix) = splitAt (i+2) s -- the +2 for the \"k_\"\n                 (index, rest) = span isDigit suffix in\n             if length index == 0 then s else\n             prefix ++ \"0\" ++ (fixKs rest)\n   in\n   do decls <- [d| data SMaybe :: (k -> K.Type) -> (Maybe k) -> K.Type where\n                     SNothing :: SMaybe s 'Nothing\n                     SJust :: s a -> SMaybe s ('Just a)\n\n                   type instance Map f '[] = '[]\n                   type instance Map f (h ': t) = ((f h) ': (Map f t))\n                   |]\n      reportWarning (fixKs (pprint decls))\n      return decls )\n\ndata SBool :: Bool -> K.Type where\n  SFalse :: SBool 'False\n  STrue :: SBool 'True\n\nmbool :: SMaybe SBool ('Just 'False)\nmbool = SJust SFalse\n", "num_lines": 52}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH_Roles1 where\n\nimport Language.Haskell.TH\n\n$( return [ DataD [] (mkName \"T\") [PlainTV (mkName \"a\")] Nothing [] []\n          , RoleAnnotD (mkName \"T\") [RepresentationalR] ] )\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, RoleAnnotations, PolyKinds #-}\n\nmodule TH_Roles2 where\n\nimport Language.Haskell.TH\n\n$( return [ DataD [] (mkName \"T\") [KindedTV (mkName \"a\") (VarT (mkName \"k\"))]\n            Nothing [] []\n          , RoleAnnotD (mkName \"T\") [RepresentationalR] ] )\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, PolyKinds, RoleAnnotations #-}\n\nmodule Roles3 where\n\nimport Language.Haskell.TH\nimport System.IO\n\n$( do { decls <- [d| data Foo a (b :: k) c (d :: k)\n                     type role Foo _ _ representational nominal |]\n      ; runIO $ putStrLn (pprint decls) >> hFlush stdout\n      ; return decls })\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Roles4 where\n\nimport Language.Haskell.TH\nimport System.IO\n\ndata Sticky a b = MkSticky (a b)\n\n$( do roles <- reifyRoles (mkName \"Sticky\")\n      runIO $ putStrLn (show roles) >> hFlush stdout\n      return [] )\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- See Trac #1678\n\nmodule TH where \n\nimport Language.Haskell.TH \n \n \n-- foo = $(fail \"hi\")\n\nfoo = $(runIO (fail \"hi\"))\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}\nmodule Foo where\n\n\n$([d| f :: forall a. a->a\n      f x = x::a \n    |])\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test for trac #2956\n\nmodule TH_sections where\n\ntwo :: Int\ntwo = $( [| (1 +) 1 |] )\n\nthree :: Int\nthree = $( [| (+ 2) 1 |] )\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- We should get a civilised report of conflicting variable\n-- bindings in the definition spliced in by foo\n\nmodule TH_spliceD1 where\n\nimport TH_spliceD1_Lib\n\n$(foo)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH_spliceD1_Lib where\nimport Language.Haskell.TH\n\nfoo :: Q [Dec]\nfoo = sequence [funD (mkName \"f\")\n       [\n         clause\n           [varP $ mkName \"c\",varP $ mkName \"c\"]\n           (normalB $ [| undefined |])\n           []\n       ]]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_spliceD2 where\n\nimport qualified TH_spliceD2_Lib\n\n$( [d| data T = T TH_spliceD2_Lib.T |] )\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_spliceD2_Lib where\n\ndata T = T Int\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test splicing of a generated data declarations\n\nmodule TH_spliceDecl1\nwhere\n\nimport Language.Haskell.TH\n\n\n-- splice a simple data declaration\n$(return [DataD [] (mkName \"T\") [] Nothing [NormalC (mkName \"C\") []] []])\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test splicing of quoted data and newtype declarations\n\nmodule TH_spliceDecl2\nwhere\n\nimport Language.Haskell.TH\n\n-- splice a simple quoted declaration (x 2)\n$([d| data T1 = C1 |])\n\n$([d| newtype T2 = C2 String |])\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test splicing of reified and renamed data declarations\n\nmodule TH_spliceDecl3\nwhere\n\nimport Language.Haskell.TH\nimport TH_spliceDecl3_Lib\n\ndata T = C\n\n$(do { TyConI d <- reify ''T; rename' d})\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_spliceDecl3_Lib\nwhere\n\nimport Language.Haskell.TH\n\nrename' :: Dec -> Q [Dec]\nrename' (DataD ctxt tyName tyvars ksig cons derivs) =\n  return [DataD ctxt (stripMod tyName) tyvars ksig\n          (map renameCons cons) derivs]\n  where\n    renameCons (NormalC conName tys) = NormalC (stripMod conName) tys\n    --\n    stripMod v = mkName (nameBase v ++ \"'\")\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, UndecidableInstances, FlexibleInstances, TypeSynonymInstances #-}\n\nmodule TH_spliceDecl4 where\n\nimport TH_spliceDecl4_Lib\n\ninstance IncrSelf String where\n    incrSelf x = x ++ \"x\"\n\n$(instanceIncrSelfTuple 2)\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TemplateHaskell, UndecidableInstances #-}\n\nmodule TH_spliceDecl4_Lib(\n  instanceIncrSelfTuple,\n  IncrSelf(..)\n)\nwhere\nimport Control.Monad\nimport Data.Maybe\nimport Language.Haskell.TH\n\nclass IncrSelf a where\n    incrSelf :: a -> a\n\n\n\ninstanceIncrSelfTuple :: Int -> Q [Dec]\ninstanceIncrSelfTuple n = [d| incrSelf value = True |]\n\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nmy_id :: a -> a\nmy_id x = $( [| x |] )\n\nmain = print (my_id \"hello\")\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test the representation of literals and also explicit type annotations\n\nmodule TH_repE1\nwhere\n\nimport Language.Haskell.TH\n\n$( do let emptyListExpr :: ExpQ\n          emptyListExpr = [| [] |]\n\n          singletonListExpr :: ExpQ\n          singletonListExpr = [| [4] |]\n\n          listExpr :: ExpQ\n          listExpr = [| [4,5,6] |]\n\n          consExpr :: ExpQ\n          consExpr = [| 4:5:6:[] |]\n\n      [d| foo = ($emptyListExpr, $singletonListExpr, $listExpr, $consExpr) |]\n )\n\nbar = $( [| case undefined of\n                [1] -> 1 |] )\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport Language.Haskell.TH\n\n$( do let h x = x\n          foo = [| \\x -> $(h [| x |]) |]\n\n      [d| baz = $foo |]\n )\n\nmain = print (baz \"Hello\")\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport TH_spliceE5_Lib\n\nv1 = \"foo\"\n\nmain = putStrLn $(expandVars [\"v1\",\"v2\"])\n-- The splice expands to refer to both v1 and v2,\n-- and the test checks that we don't dependency-analyse\n-- the program so that one or the other isn't in scope\n-- to the type checker\n\n    \nv2 = \"bar\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TH_spliceE5_Lib where\n\nimport Language.Haskell.TH\n\nexpandVars :: [String] -> Q Exp\nexpandVars s = [| concat $(return (ListE (map f s))) |]\n  where\n    f x = VarE (mkName x)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport TH_spliceE5_prof_Lib\n\nv1 = \"foo\"\n\nmain = putStrLn $(expandVars [\"v1\",\"v2\"])\n-- The splice expands to refer to both v1 and v2,\n-- and the test checks that we don't dependency-analyse\n-- the program so that one or the other isn't in scope\n-- to the type checker\n\n    \nv2 = \"bar\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport TH_spliceE5_prof_ext_Lib\n\nv1 = \"foo\"\n\nmain = putStrLn $(expandVars [\"v1\",\"v2\"])\n-- The splice expands to refer to both v1 and v2,\n-- and the test checks that we don't dependency-analyse\n-- the program so that one or the other isn't in scope\n-- to the type checker\n\n\nv2 = \"bar\"\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_spliceE5_prof_ext_Lib where\n\nimport Language.Haskell.TH\n\nexpandVars :: [String] -> Q Exp\nexpandVars s = [| concat $(return (ListE (map f s))) |]\n  where\n    f x = VarE (mkName x)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule TH_spliceE5_prof_Lib where\n\nimport Language.Haskell.TH\n\nexpandVars :: [String] -> Q Exp\nexpandVars s = [| concat $(return (ListE (map f s))) |]\n  where\n    f x = VarE (mkName x)\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- This failed in 6.10.1, as the Name's for True and False in\n-- Language.Haskell.TH.Syntax.{trueName,falseName} were wrong.\n\nmodule TH_spliceE6 where\n\na = $( (\\b -> [| b |]) True )\nb = $( (\\m -> [| m |]) (Just 'm') )\nc = $( (\\e -> [| e |]) (Left 'e' :: Either Char Bool) )\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test representation and splicing of left-parenthesised right infix operators\n\nmodule TH_spliceExpr1\nwhere\n\nimport Language.Haskell.TH\n\nfoo :: Int\nfoo = $( [| ((+) $ 2) $ 2 |] )\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XTemplateHaskell #-}\n\n-- Trac #2017\n\nmodule ShouldCompile where\n\n import Language.Haskell.TH\n\n $(do e <- [d| f a b\n                 | a == b = a\n                 | otherwise = b |]\n      return e)\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Tickles a GHC 6.4 buglet\n\nmodule ShouldCompile where\n\nclass Foo a where\n    foo :: a -> a\n    foo = id\n\n-- Splice an instance decl that uses the default method\n$( [d| instance Foo () where |] )\n\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE StaticPointers #-}\n\n-- | A test of static forms in TH quotations.\nmodule Main(main) where\n\nimport GHC.StaticPtr\n\nmain = print $ deRefStaticPtr $([| static g :: StaticPtr String |])\n\ng = \"found\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE StaticPointers #-}\n\n-- | A test to try the static form in splices, which should fail.\n--\nmodule Main(main) where\n\nimport GHC.Fingerprint\nimport GHC.StaticPtr\n\nmain = print $ $(case staticKey (static 'a') of\n  Fingerprint w0 w1 ->\n    let w0i = fromIntegral w0 :: Integer\n        w1i = fromIntegral w1 :: Integer\n    in\n     [| fmap (\\p -> deRefStaticPtr p :: Char) $ unsafeLookupStaticPtr $\n          Fingerprint (fromIntegral w0i) (fromIntegral w1i)\n      |]\n     )\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport Language.Haskell.TH\nimport GHC.Prim(Addr#)\nimport GHC.Ptr\nimport Foreign.Marshal.Array (peekArray)\nimport Data.Word (Word8)\n\ncheck_equal :: [Word8] -> Addr# -> IO ()\ncheck_equal bytes addr = do\n  bytes' <- peekArray (length bytes) (Ptr addr)\n  print (bytes == bytes')\n\nmain = do\n  -- check round-trip\n  check_equal [0..255] $(litE $ stringPrimL [0..255])\n\n  -- check printing\n  let e = LitE (StringPrimL [0..255])\n  print e\n  putStrLn (pprint e)\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule TH_tf1 where\n\nimport Data.Kind (Type)\n\n$( [d| data family T a |] )\n$( [d| data instance T Int = TInt Bool |] )\n\nfoo :: Bool -> T Int\nfoo b = TInt (b && b)\n\n$( [d| type family S a |] )\n$( [d| type instance S Int = Bool |] )\n\nbar :: S Int -> Int\nbar c = if c then 1 else 2\n\n$( [d| type family R (a :: Type -> Type) :: Type -> Type |] )\n$( [d| type instance R Maybe = [] |] )\n\nbaz :: R Maybe Int -> Int\nbaz = head\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances #-}\n\nmodule TH_tf3 where\n\ntype family T a\n\n$( [d| foo :: T [a] ~ Bool => a -> a\n       foo x = x |] )\n\n$( [d| class C a \n       instance a ~ Int => C a |] )", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Test the use of tupleDataName, tupleTypeName\n\nmodule ShouldCompile where\n\nimport Language.Haskell.TH\n\nfoo = $( sigE (appsE [conE (tupleDataName 2),\n                     litE (integerL 1),\n                     litE (integerL 2)])\n              (appT (appT (conT (tupleTypeName 2))\n                          (conT ''Integer))\n                    (conT ''Integer))\n        )\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies #-}\n\nmodule TH_TyInstWhere1 where\n\n$([d| type family F (a :: k) (b :: k) :: Bool where\n        F a a = True\n        F a b = False |])\n\ndata Proxy a = P\n\nf :: Proxy True -> Proxy (F Int Int)\nf x = x\n\ng :: Proxy False -> Proxy (F Int Bool)\ng x = x ", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies, TypeApplications #-}\n\nmodule TH_TyInstWhere2 where\n\nimport Language.Haskell.TH hiding (Type)\nimport Data.Kind\n\n$( do { decs <- [d| type family F (a :: k) (b :: k) :: Bool where\n                      F a a = True\n                      F a b = False |]\n      ; reportWarning (pprint decs)\n      ; return [] })\n\n$( do { dec1 <- [d| type family F1 (a :: k) :: Type where\n                      F1 @Type Int = Bool\n                      F1 @Bool 'False = Char |]\n      ; reportWarning (pprint dec1)\n      ; return [] })\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, UnboxedTuples #-}\n\nmodule TH_unboxedSingleton where\n\nf :: () -> (# Int #)\nf () = $( [| (# 3 #) |] )\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE NoStarIsType #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule Main where\n\nimport TH_unresolvedInfix_Lib\nimport Language.Haskell.TH\n\n--------------------------------------------------------------------------------\n--                                Expressions                                 --\n--------------------------------------------------------------------------------\nexprs = [\n-------------- Completely-unresolved bindings\n  $( n +? (n *? n) ),\n  $( (n +? n) *? n ),\n  $( n +? (n +? n) ),\n  $( (n +? n) +? n ),\n  -- VarE version\n  $( uInfixE n plus2 (uInfixE n plus2 n) ),\n  $( uInfixE (uInfixE n plus2 n) plus2 n ),\n  $( uInfixE n plus3 (uInfixE n plus3 n) ),\n  $( uInfixE (uInfixE n plus3 n) plus3 n ),\n\n--------------- Completely-resolved bindings\n  $( n +! (n *! n) ),\n  $( (n +! n) *! n ),\n  $( n +! (n +! n) ),\n  $( (n +! n) +! n ),\n\n-------------- Mixed resolved/unresolved\n  $( (n +! n) *? (n +? n) ),\n  $( (n +? n) *? (n +! n) ),\n  $( (n +? n) *! (n +! n) ),\n  $( (n +? n) *! (n +? n) ),\n\n-------------- Parens\n  $( ((parensE ((n +? n) *? n)) +? n) *? n ),\n  $( (parensE (n +? n)) *? (parensE (n +? n)) ),\n  $( parensE ((n +? n) *? (n +? n)) ),\n\n-------------- Sections\n  $( infixE (Just $ n +? n) plus Nothing ) N,\n  -- see B.hs for the (non-compiling) other version of the above\n  $( infixE Nothing plus (Just $ parensE $ uInfixE n plus n) ) N,\n\n-------------- Dropping constructors\n  $( n *? tupE [n +? n] )\n  ]\n\n--------------------------------------------------------------------------------\n--                                  Patterns                                  --\n--------------------------------------------------------------------------------\npatterns = [\n-------------- Completely-unresolved patterns\n  case N :+ (N :* N) of\n    [p1|unused|] -> True,\n  case N :+ (N :* N) of\n    [p2|unused|] -> True,\n  case (N :+ N) :+ N of\n    [p3|unused|] -> True,\n  case (N :+ N) :+ N of\n    [p4|unused|] -> True,\n-------------- Completely-resolved patterns\n  case N :+ (N :* N) of\n    [p5|unused|] -> True,\n  case (N :+ N) :* N of\n    [p6|unused|] -> True,\n  case N :+ (N :+ N) of\n    [p7|unused|] -> True,\n  case (N :+ N) :+ N of\n    [p8|unused|] -> True,\n-------------- Mixed resolved/unresolved\n  case ((N :+ N) :* N) :+ N of\n    [p9|unused|] -> True,\n  case N :+ (N :* (N :+ N)) of\n    [p10|unused|] -> True,\n  case (N :+ N) :* (N :+ N) of\n    [p11|unused|] -> True,\n  case (N :+ N) :* (N :+ N) of\n    [p12|unused|] -> True,\n-------------- Parens\n  case (N :+ (N :* N)) :+ (N :* N) of\n    [p13|unused|] -> True,\n  case (N :+ N) :* (N :+ N) of\n    [p14|unused|] -> True,\n  case (N :+ (N :* N)) :+ N of\n    [p15|unused|] -> True,\n-------------- Dropping constructors\n  case (N :* (N :+ N)) of\n    [p16|unused|] -> True\n ]\n\n--------------------------------------------------------------------------------\n--                                  Types                                     --\n--------------------------------------------------------------------------------\n\n-------------- Completely-unresolved types\n_t1  = 1 `Plus` (1 `Times` 1) :: $( int $+? (int $*? int) )\n_t2  = 1 `Plus` (1 `Times` 1) :: $( (int $+? int) $*? int )\n_t3  = (1 `Plus` 1) `Plus` 1  :: $( int $+? (int $+? int) )\n_t4  = (1 `Plus` 1) `Plus` 1  :: $( (int $+? int) $+? int )\n-------------- Completely-resolved types\n_t5  = 1 `Plus` (1 `Times` 1) :: $( int $+! (int $*! int) )\n_t6  = (1 `Plus` 1) `Times` 1 :: $( (int $+! int) $*! int )\n_t7  = 1 `Plus` (1 `Plus` 1)  :: $( int $+! (int $+! int) )\n_t8  = (1 `Plus` 1) `Plus` 1  :: $( (int $+! int) $+! int )\n-------------- Mixed resolved/unresolved\n_t9  = ((1 `Plus` 1) `Times` 1) `Plus` 1 :: $( (int $+! int) $*? (int $+? int) )\n_t10 = 1 `Plus` (1 `Times` (1 `Plus` 1)) :: $( (int $+? int) $*? (int $+! int) )\n_t11 = (1 `Plus` 1) `Times` (1 `Plus` 1) :: $( (int $+? int) $*! (int $+! int) )\n_t12 = (1 `Plus` 1) `Times` (1 `Plus` 1) :: $( (int $+? int) $*! (int $+? int) )\n-------------- Parens\n_t13 = (1 `Plus` (1 `Times` 1)) `Plus` (1 `Times` 1) :: $( ((parensT ((int $+? int) $*? int)) $+? int) $*? int )\n_t14 = (1 `Plus` 1) `Times` (1 `Plus` 1)             :: $( (parensT (int $+? int)) $*? (parensT (int $+? int)) )\n_t15 = (1 `Plus` (1 `Times` 1)) `Plus` 1             :: $( parensT ((int $+? int) $*? (int $+? int)) )\n\nmain = do\n  mapM_ print exprs\n  mapM_ print patterns\n  -- check that there are no Parens or UInfixes in the output\n  runQ [|N :* N :+ N|] >>= print\n  runQ [|(N :* N) :+ N|] >>= print\n  runQ [p|N :* N :+ N|] >>= print\n  runQ [p|(N :* N) :+ N|] >>= print\n  runQ [t|Int * Int + Int|] >>= print\n  runQ [t|(Int * Int) + Int|] >>= print\n\n  -- pretty-printing of unresolved infix expressions\n  let ne = ConE $ mkName \"N\"\n      np = ConP (mkName \"N\") []\n      nt = ConT (mkName \"Int\")\n      plusE = ConE (mkName \":+\")\n      plusP = (mkName \":+\")\n      plusT = (mkName \"+\")\n  putStrLn $ pprint (InfixE (Just ne) plusE (Just $ UInfixE ne plusE (UInfixE ne plusE ne)))\n  putStrLn $ pprint (ParensE ne)\n  putStrLn $ pprint (InfixP np plusP (UInfixP np plusP (UInfixP np plusP np)))\n  putStrLn $ pprint (ParensP np)\n  putStrLn $ pprint (InfixT nt plusT (UInfixT nt plusT (UInfixT nt plusT nt)))\n  putStrLn $ pprint (ParensT nt)\n", "num_lines": 142}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TH_unresolvedInfix2 where\n\nimport Language.Haskell.TH\n\ninfixl 6 :+\n\ndata Tree = N\n  | Tree :+ Tree \n  | Tree :* Tree \n\n$(return [])\n\n-- Should fail\nexpr = $( let plus = conE '(:+)\n              n = conE 'N\n          in infixE Nothing plus (Just $ uInfixE n plus n) )\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE NoStarIsType #-}\n\nmodule TH_unresolvedInfix_Lib where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Lib\nimport Language.Haskell.TH.Quote\n\ninfixl 6 :+\ninfixl 7 :*\n\ndata Tree = N\n  | Tree :+ Tree \n  | Tree :* Tree \n\n-- custom instance, including redundant parentheses\ninstance Show Tree where\n  show N = \"N\"\n  show (a :+ b) = \"(\" ++ show a ++ \" :+ \" ++ show b ++ \")\"\n  show (a :* b) = \"(\" ++ show a ++ \" :* \" ++ show b ++ \")\"\n\n-- VarE versions\ninfixl 6 +:\ninfixl 7 *:\n(+:) = (:+)\n(*:) = (:*)\n\nn = conE (mkName \"N\")\nplus = conE (mkName \":+\")\ntimes = conE (mkName \":*\")\n\na +? b = uInfixE a plus b\na *? b = uInfixE a times b\na +! b = infixApp a plus b\na *! b = infixApp a times b\n\nplus2 = varE (mkName \"+:\")\ntimes2 = varE (mkName \"*:\")\nplus3 = conE ('(:+))\n\n\n--------------------------------------------------------------------------------\n--                                  Patterns                                  --\n--------------------------------------------------------------------------------\n-- The only way to test pattern splices is using QuasiQuotation\nmkQQ pat = QuasiQuoter undefined (const pat) undefined undefined\np = conP (mkName \"N\") []\nplus' = mkName \":+\"\ntimes' = mkName \":*\"\n\na ^+? b = uInfixP a plus' b\na ^*? b = uInfixP a times' b\na ^+! b = infixP a plus' b\na ^*! b = infixP a times' b\n\n-------------- Completely-unresolved patterns\np1 = mkQQ ( p ^+? (p ^*? p) )\np2 = mkQQ ( (p ^+? p) ^*? p )\np3 = mkQQ ( p ^+? (p ^+? p) )\np4 = mkQQ ( (p ^+? p) ^+? p )\n-------------- Completely-resolved patterns\np5 = mkQQ ( p ^+! (p ^*! p) )\np6 = mkQQ ( (p ^+! p) ^*! p )\np7 = mkQQ ( p ^+! (p ^+! p) )\np8 = mkQQ ( (p ^+! p) ^+! p )\n-------------- Mixed resolved/unresolved\np9 = mkQQ ( (p ^+! p) ^*? (p ^+? p) )\np10 = mkQQ ( (p ^+? p) ^*? (p ^+! p) )\np11 = mkQQ ( (p ^+? p) ^*! (p ^+! p) )\np12 = mkQQ ( (p ^+? p) ^*! (p ^+? p) )\n-------------- Parens\np13 = mkQQ ( ((parensP ((p ^+? p) ^*? p)) ^+? p) ^*? p )\np14 = mkQQ ( (parensP (p ^+? p)) ^*? (parensP (p ^+? p)) )\np15 = mkQQ ( parensP ((p ^+? p) ^*? (p ^+? p)) )\n-------------- Dropping constructors\np16 = mkQQ ( p ^*? (tupP [p ^+? p]) )\n\n--------------------------------------------------------------------------------\n--                                  Types                                     --\n--------------------------------------------------------------------------------\n\ninfixl 6 +\ninfixl 7 *\ndata (+) a b = Plus a b\ndata (*) a b = Times a b\n\nint = conT (mkName \"Int\")\ntyPlus = mkName \"+\"\ntyTimes = mkName \"*\"\n\na $+? b = uInfixT a tyPlus b\na $*? b = uInfixT a tyTimes b\na $+! b = infixT a tyPlus b\na $*! b = infixT a tyTimes b\n", "num_lines": 96}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns, QuasiQuotes #-}\n\nmodule Main where\n\nimport Language.Haskell.TH\n\nmain = do\n  p <- runQ [p|(id -> x)|]\n  print p\n  putStrLn (pprint p)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Main where\n\nimport Language.Haskell.TH\n\n\nmain = do {d <- runQ $ [| let { foo = bar where bar = 3 } in foo |];  print d}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell       #-}\n\nmodule ASCII () where\n\nimport Tree\nimport PatternGenerator\n\ntype EP g = Bool\n\ntemplateFoo ''EP ['A'..'Z']\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module PatternGenerator where\n\nimport Tree\n\nimport Language.Haskell.TH\n\ntemplateFoo :: Name -> [Char] -> DecsQ\ntemplateFoo _ _ = return []\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module These where\n\ntuc :: t (k, a)\ntuc = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tree where\n\nimport These\n\nmp :: Maybe (Int, ())\nmp = tuc\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule A where\na = [|3|]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- B.hs\n{-# LANGUAGE TemplateHaskell #-}\nmodule B where\nimport A\nx = $(a)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule B where\n\nimport {-# SOURCE #-} A ()\n--import A ()\nimport Language.Haskell.TH\n\nexpQ :: ExpQ\nexpQ = [| () |]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule C where\n\nimport B\n\nfoo :: a\nfoo = undefined\n  where second = $( expQ )\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main where\n\nimport ModuleA\n\nmain = return ()\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ModuleA where\n\nimport ModuleB\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule ModuleB where\n\nimport ModuleC\n\n$(nothing)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ModuleC where\n\nimport Language.Haskell.TH\n\nimport {-# SOURCE #-} ModuleA\n\nnothing = return [] :: Q [Dec]\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Dummy where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\n\nimport Language.Haskell.TH\n\nmain :: IO ()\nmain = putStrLn $(return $ LitE $ StringL \"hello\")\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B1 where\n\nimport A\n\nf :: T\nf = T\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B2 where\n\nimport A\n\nf :: T\nf = T\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\nimport qualified B1\nimport qualified B2\n\nx = [B1.f,B2.f]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\ndata T = T\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\ndata T = T\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\nmodule A where\n\nclass Matrix a fa | a -> fa where\n    row :: [a] -> fa\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\nmodule B where\nimport A\n\nnewtype Val = Val [Int]\n\ninstance Matrix Bool Val\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module C where\n\n-- !!! a test for missing instances w/ functional dependencies \n-- (failed in GHC 5.00.2)\n\nimport A\nimport B\n\nct0a = row [True,False,True,False]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n\nmodule A where\n\ntype a :+ b = (a,b)\ninfixr 1 :+\n\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n\nmodule B where\nimport A\n\na :: Int :+ Float :+ Double\na = undefined\n\nb :: Int\nb = case a of (p,q) -> p\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module AbstractRefinementSubstitutions where\n\nf :: [Integer] -> Integer\nf = _\n\ng :: [Integer] -> Integer\ng = _ 0\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ConstraintSubstitutions where\n\ng :: Ord a => [a] -> a\ng = _\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule DfltProb1 where\n\nimport Control.Monad.ST\nimport Prelude hiding (traverse)\n\ntraverse :: a -> ST s [a]\ntraverse = undefined\n\n-- WORKS with signature test :: Num a => [a]\ntest = runST (traverse 1)\n\nmain = print test\n\n\n\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule DfltProb2 where\n\n{- NB: This program fails in GHC 7.4.1 but should be accepted with our new defaulting plan -} \n\nf :: Int -> Bool\nf x = const True (\\y -> let w :: a -> a\n                            w a = const a (y+1)\n                        in w y)\n\n{- The implication constraint we get here is that (y::beta):\n            [untch=beta] forall a. 0 => Num beta\n   and we can't really do any defaulting in this scope. \n\n   Instead with our new defaulting plan we \n\n     (i) try to approximate the whole constraint\n     (ii) /then/ we try to default (and succeed)\n     (iii) then try to resolve again\n \n   See Note [Top-level Defaulting Plan] in TcSimplify -}\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns, GADTs #-}\n\nmodule ExPat where\n\ndata T where\n  MkT :: Integral a => a -> Int -> T\n\n-- c.f. T11700\n\n-- Succeeds because y::Int\nf x = let MkT _ y  = x\n      in y\n\n-- Remarkablly, this succeeds because\n--   (toInteger (v::a)) is an Integer\ng x = let MkT (toInteger -> y) _ = x\n      in y\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule ExPatFail where\n\ndata T where\n  MkT :: Integral a => a -> Int -> T\n\n-- Fails because y is bound to an existential type\n-- Mind you, the error message is pretty terrible\n-- c.f. T11700\n\nf x = let MkT y _ = x\n      in y\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- A classic test for type inference\n-- Taken from \"Haskell and principal types\", Section 3\n-- by Faxen, in the Haskell Workshop 2003, pp88-97\n\nmodule ShouldCompile where\n\nimport GHC.List (null)\nimport Prelude hiding (null)\n\nclass HasEmpty a where\n  isEmpty :: a -> Bool\n\ninstance HasEmpty [a] where\n  isEmpty x = null x\n\ninstance HasEmpty (Maybe a) where\n  isEmpty Nothing  = True\n  isEmpty (Just x) = False\n\ntest1 y\n  =  (null y)\n  || (let f :: forall d. d -> Bool\n          f x = isEmpty (y >> return x)\n      in f y)\n\ntest2 y\n  =  (let f :: forall d. d -> Bool\n          f x = isEmpty (y >> return x)\n      in f y)\n  || (null y)\n\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}\n\n-- Trac #1781\n-- This one should really succeed, because 'plus' can only\n-- be called with a = Int->Int, but the old fundep story\n-- certainly made it fail, and so that's what we expect for now\n-- We may become more liberal later\n\nmodule ShouldCompile where\n\nclass E a b | a -> b, b -> a\ninstance E a a\n\nplus :: (E a (Int -> Int)) => Int -> a\nplus x y = x + y\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}\n\n-- Trac #1783\n-- Like Trac #1781 you could argue that this one should succeed\n-- but we stick with the old behaviour for now.  When we do\n-- fundeps properly it'll probably start to work\n\nmodule ShouldCompile where\n\nimport Prelude hiding (foldr, foldr1)\n\nimport Data.Maybe\n\nclass Elem a e | a -> e\n\nclass Foldable a where\n  foldr :: Elem a e => (e -> b -> b) -> b -> a -> b\n\n--  foldr1 :: forall e. Elem a e => (e -> e -> e) -> a -> e  -- WORKS!\n  foldr1 :: Elem a e => (e -> e -> e) -> a -> e\n  foldr1 f xs = fromMaybe (error \"foldr1: empty structure\")\n                  (foldr mf Nothing xs)\n     where mf :: Elem a e => (e -> Maybe e -> Maybe e)\n           mf x Nothing  = Just x\n           mf x (Just y) = Just (f x y)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}\n\n-- Trac #1795\n\nmodule ShouldCompile where\n\ndata A a = A\n\nclass MkA a b | a -> b where\n   mkA :: a -> A b\n\ninstance MkA a a where\n\ntranslate :: (String, a) -> A a\ntranslate a = mkA a\n\n{- From the call to mkA\n\n[W] MkA alpha beta\n[W] alpha ~ (String,a)\n[W] A beta ~ A a\n\n==>  beta:=a, alpha:=(String,a)\n-}\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n    MultiParamTypeClasses,\n    FunctionalDependencies,\n    UndecidableInstances,\n    FlexibleInstances,\n    EmptyDataDecls #-}\n\n-- Trac #1797\n\nmodule ShouldCompile where\n\ndata True\n\ndata False\n\nclass TypeEq type1 type2 result | type1 type2 -> result where\n    typeEq :: type1 -> type2 -> result\n\ninstance TypeEq soleType soleType True where\n    typeEq _ _ = undefined\n\ninstance (TypeCast False result) => TypeEq type1 type2 result where\n    typeEq _ _ = undefined\n\nclass TypeCast type1 type2 | type1 -> type2, type2 -> type1\n\ninstance TypeCast soleType soleType\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -frefinement-level-hole-fits=2 #-}\n{-# LANGUAGE MonoLocalBinds #-}\nmodule TG where\nimport Prelude ( Monad, Applicative, Functor\n               , fmap, (<*>), pure, (>>=)\n               , (=<<), ($), (<$>) )\n\ndata Free f a = Pure a | Free (f (Free f a))\n\ninstance Functor f => Functor (Free f) where\n    fmap f = go where\n      go (Pure a) =  Pure (f a)\n      -- Should suggest (fmap)\n      go (Free fa) = Free (_a go fa)\n\ninstance Functor f => Applicative (Free f) where\n  pure = Pure\n  Pure a <*> Pure b = Pure (a b)\n  Pure a <*> Free mb = Free (fmap a <$> mb)\n  Free ma <*> b = Free ((<*> b) <$> ma)\n\ninstance Applicative f => Monad (Free f) where\n    Pure a >>= f = f a\n      -- Should suggest ((=<< (_ :: a -> Free f b))\n    Free f >>= g = Free (fmap _a f)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE FunctionalDependencies, FlexibleContexts #-}\n\nclass C a where\n\nclass D a where\n dop :: a -> a\n\ninstance C a => D [a] where\n dop = undefined\n\nclass J a b | a -> b\n where j :: a -> b -> ()\n\ninstance J Bool Int where\n j = undefined\n\nfoo :: D [Int] => ()\n-- Weird test case: (D [Int]) is simplifiable\nfoo = j True (head (dop [undefined]))\n\nmain = return ()\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Main where\n\ndata A a\n\ntype T a = A a\n\n\nf :: (A a ~ T Int) => a -> Int\nf x = x\n\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\n-- Provided by Christian Maeder; broke\n-- a pre-release GHC 7.0\n\nmodule HasKey where\n\nclass Ord key => HasKey x key | x -> key where\n   toKey :: x -> key\n\nnewtype Keyed x = Keyed { unKey :: x }\n\nlift :: (HasKey x1 key1,HasKey x2 key2)\n   => (key1 -> key2 -> a) -> (Keyed x1 -> Keyed x2 -> a)\nlift f x1 x2 = f (toKey . unKey $ x1) (toKey . unKey $ x2)\n\ninstance HasKey x key => Eq (Keyed x) where\n   (==) = lift (==)\n\ninstance HasKey x key => Ord (Keyed x)\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Holes where\n\nf = _\n\ng :: Int -> Char\ng x = _\n\nh = _ ++ \"a\"\n\nz :: [a] -> [a]\nz y = const y _\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Holes2 where\n\nf = show _\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Holes3 where\n\nf = _\n\ng :: Int -> Char\ng x = _gr\n\nh = _aa ++ \"a\"\n\nz :: [a] -> [a]\nz y = const y _x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fshow-hole-constraints #-}\n{-# LANGUAGE GADTs, TypeOperators #-}\nmodule HoleConstraints where\nimport Data.Type.Equality hiding (castWith)\n\n-- \"from the signature of f1\"\nf1 :: Eq a => a\nf1 = _\n\n-- \"from the signature of f2\", only once\nf2 :: (Show a, Eq a) => a\nf2 = _\n\n-- \"from the instance declaration\"\nclass C a where f3 :: a\ninstance Eq a => C [a] where f3 = _\n\n-- \"from a pattern with constructor ... in an equation for 'castWith'\"\ncastWith :: a :~: b -> a -> b\ncastWith Refl x = _\n\ndata AnyShow where\n  AnyShow :: Show a => a -> AnyShow\n\n-- \"from a pattern with constructor ... in a case alternative\"\nfoo :: AnyShow -> String\nfoo a = case a of AnyShow x -> _\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fshow-hole-constraints #-}\n{-# LANGUAGE GADTs, TypeOperators #-}\nmodule HoleConstraintsNested where\nimport Data.Type.Equality\n\ndata EqOrd a where EqOrd :: (Eq a, Ord a) => EqOrd a\n\nf :: a :~: b -> EqOrd a -> Int\nf d1 d2 =\n  case d1 of\n    Refl -> case d2 of\n      EqOrd -> _\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- This one relies on doing instance reduction\n-- on a /derived/ class\n--    [W] C (F a0) a0, F a0 ~ Bool\n-- Currently (Oct 16) I've disabled this because it seems like\n-- overkill.\n--\n-- See Note Note [No reduction for Derived class constraints]\n-- in TcInteract\n\nmodule Foo where\n\ntype family F a\ntype instance F Int = Bool\n\nclass C a b where\n\ninstance (b~Int) => C Bool b\n\nblug :: C (F a) a => a -> F a\nblug = error \"Urk\"\n\nfoo :: Bool\nfoo = blug undefined\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Prelude (Show, String, error, IO(), show, Ordering(EQ))\n\nhead :: [a] -> a\nhead (x:xs) = _\nhead _ = error \"Empty list!\"\n\nmshow :: Show a => a -> a\nmshow a = _\n\nmain :: IO ()\nmain = error \"no main\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}\n\n-- Compiles fine.\n-- Instance selection works fine.\n-- try: :t foo (T1b T1a)\n\nmodule ShouldCompile where\n\n-- Notice: T1 is a recursive type.\n-- Notice: the classes are recursive, too.\n-- Why does this work when almost the same thing doesn't?\n-- Say: adding an Int component to T1a makes things loop.\n-- See LoopOfTheDay2.hs and LoopOfTheDay3.hs.\n\ndata T1 = T1a | T1b T1\n\nclass C0 x where foo :: x -> (); foo = undefined\nclass C1 x y\nclass C1 x y => C2 x y\n\ninstance C0 T1              => C1 () T1         -- (I1)\ninstance (C1 x T1)          => C2 x T1          -- (I2)\ninstance C2 () T1           => C0 T1            -- (I3)\n\nbaz = foo (T1b T1a)\n\n{- Need         C0 T1\n-->(I3)         C2 () T1\n-->(I2)         C1 () T1\n-->(I1)         C0 T1           -- STOP because we've seen this before\n-}\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}\n\n-- Compilation loops in GHC 6.2!\n-- While LoopOfTheDay1.hs did compile and work,\n-- this one loops during compilation, even though\n-- there is only an innocent difference regarding T1,\n-- i.e., an additional, non-recursive constructor component.\n\nmodule ShouldCompile where\n\ndata T1 = T1a Int | T1b T1\n\nclass C0 x where foo :: x -> (); foo = undefined\n-- foo :: C0 x => x -> ()\n\nclass C1 x y\nclass C1 x y => C2 x y\n\ninstance C0 Int              => C1 () Int       -- I1\ninstance C0 T1               => C1 () T1        -- I2\ninstance (C1 x T1, C1 x Int) => C2 x T1         -- I3\ninstance C1 x Int            => C2 x Int        -- I4\ninstance C2 () T1            => C0 T1           -- I5\ninstance C2 () Int           => C0 Int          -- I6\n\n\nbaz = foo (T1b (T1a 3))\n\n{- Need\n                C0 T1\n-->(I5)         C2 () T1\n-->(I3)         C1 () T1, C1 () Int\n-->(I1,I2)      C0 T1, C0 Int\n-->(recusive)   C0 Int\n-->(I6)         C2 () Int\n-->(I4)         C1 () Int\n-->(recursive)  {}\n-}\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,\n             UndecidableInstances #-}\n\n-- Instances compile fine but instance selection loops in GHC 6.2.\n-- try: :t foo (T1a 1)\n-- This is essentially the same as LoopOfTheDay2.hs\n-- but with the innocent (?) use of overlapping instances.\n\nmodule ShouldCompile where \n\ndata T1 = T1a Int | T1b T1\n\nclass C0 x where foo :: x -> (); foo = undefined\nclass C1 x y\nclass C1 x y => C2 x y\n\ninstance C0 a                => C1 () a\ninstance (C1 x T1, C1 x Int) => C2 x T1\ninstance C1 x Int            => C2 x Int\ninstance C2 () a             => C0 a\n\nbaz = foo (T1b (T1a 3))\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the types of the old binder and the binder implicitly introduced by grouping are linked\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule ShouldCompile where\n\nimport Data.List(inits)\n\nfoo :: [[[Int]]]\nfoo = [ x\n      | x <- [1..10]\n      , then group using inits\n      , then group using inits\n      ]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Werror -fwarn-missing-export-lists #-}\nmodule ShouldCompile (foo) where\n\nfoo :: String\nfoo = \"foo\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Werror -fwarn-missing-export-lists #-}\nmodule ShouldCompile () where\n\nfoo :: String\nfoo = \"foo\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MutRec where\n\n-- Mutual recursion with different\n-- names for the same type variable\nf t = x\n  where\n    x :: [a]\n    y :: b\n    (x,y,z,r) = ([y,z], z, head x, t)\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- An example of RelaxedPolyRec in action which came up\n-- on Haskell Cafe June 2010 (Job Vranish)\n\nmodule Foo where\n\nimport Data.Maybe\n\n-- The fixed point datatype\ndata Y f = Y (f (Y f))\n\n-- Silly dummy function\nmaybeToInt :: Maybe a -> Int\nmaybeToInt = length . maybeToList\n\n---------------------------\n-- f and g are mutually recursive\n-- Even though f has a totally monomorphic\n-- signature, g has a very polymorphic one\n\nf :: Y Maybe -> Int\nf (Y x) = g maybeToInt x\n\n-- With RelaxedPolyRec we can infer this type\n-- g :: Functor f => (f Int -> b) -> f (Y Maybe) -> b\ng h x = h $ fmap f x\n\n-- 'test' checks that g's type is polymorphic enough\ntest :: Functor f => (f Int -> b) -> f (Y Maybe) -> b\ntest = g\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, LiberalTypeSynonyms, ImpredicativeTypes #-}\nmodule PolyTypeDecomp where \n\n\n{- The purpose of this test is to check if decomposition of wanted \n   equalities in the /constraint solver/ (vs. the unifier) works properly.\n   Unfortunately most equalities between polymorphic types are converted to \n   implication constraints early on in the unifier, so we have to make things\n   a bit more convoluted by introducing the myLength function. The wanted \n   constraints we get for this program are:\n      [forall a. Maybe a] ~ Id alpha\n      [forall a. F [a]]   ~ Id alpha \n   Which, /after reactions/ should create a fresh implication: \n      forall a. Maybe a ~ F [a]\n   that is perfectly soluble.\n-}\n \ntype family F a\ntype instance F [a] = Maybe a \n\ntype family Id a \ntype instance Id a = a\n\nf :: [forall a. F [a]]\nf = undefined\n\n\ng :: [forall a. Maybe a] -> Int\ng x = myLength [x,f]\n\nmyLength :: [Id a] -> Int \nmyLength = undefined\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule PushHRIf where\n\nfoo = (if True then id else id) :: forall a. a -> a\n\nbar = (foo 'x', foo True)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, GADTs, RankNTypes, TypeOperators, ScopedTypeVariables #-}\n\nmodule RebindHR where\n\nimport Prelude hiding ( (>>=) )\nimport Data.Typeable\n\ndata Exp = Int Int | Plus Exp Exp | Bool Bool\ndata TExp a where\n  TInt :: Int -> TExp Int\n  TPlus :: TExp Int -> TExp Int -> TExp Int\n  TBool :: Bool -> TExp Bool\n\n(>>=) :: ((forall t. Typeable t => TExp t -> Maybe r) -> Maybe r)\n      -> (forall t. Typeable t => TExp t -> Maybe r)\n      -> Maybe r\nx >>= y = x y\n\ncheck :: Exp -> (forall t. Typeable t => TExp t -> Maybe r) -> Maybe r\ncheck (Int n) k = k (TInt n)\ncheck (Bool b) k = k (TBool b)\ncheck (Plus e1 e2) k = do te1 :: TExp ty1 <- check e1\n                          te2 :: TExp ty2 <- check e2\n                          case (eqT :: Maybe (ty1 :~: Int), eqT :: Maybe (ty2 :~: Int)) of\n                            (Just Refl, Just Refl) -> k (TPlus te1 te2)\n                            _ -> Nothing\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax #-}\n\nmodule RebindNegate where\n\nimport Prelude ( length )\n\nnegate = length\n\ny = - \"foo\"\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module RefinementSubstitutions where\n\nf :: [Integer] -> Integer\nf = _\n\ng :: [Integer] -> Integer\ng = _ 0\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n\nmodule RepArrow where\n\nimport Data.Ord ( Down )  -- convenient \"Id\" newtype, without its constructor\nimport Data.Coerce\n\nfoo :: Coercible (Down (Int -> Int)) (Int -> Int) => Down (Int -> Int) -> Int -> Int\nfoo = coerce\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule SigTyVars where\n\n-- Here the lexically scoped type variables 'a' and 'b'\n-- both map to the same skolem 'x'.  It's perhaps a bit\n-- surprising, but it's awkward to prevent, and it seems\n-- easier to leave it.\n\nf :: x -> x -> [x]\nf (x::a) (y::b) = [x::b, y::a]\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, TypeOperators, DataKinds, PolyKinds,\n             TypeFamilies, GADTs, StandaloneDeriving #-}\n\nmodule SplitWD where\n\nimport Data.Kind ( Type )\n\ndata Nat = Zero | Succ Nat\n\ntype family a + b where\n  Zero + b = b\n  Succ a + b = Succ (a + b)\ninfixl 6 +\n\ndata Vec :: Type -> Nat -> Type where\n  VNil :: Vec a Zero\n  (:>) :: a -> Vec a n -> Vec a (Succ n)\ninfixr 5 :>\n\ntype family (xs :: Vec a n) +++ (ys :: Vec a m) :: Vec a (n + m) where\n  VNil +++ ys = ys\n  (x :> xs) +++ ys = x :> (xs +++ ys)\ninfixr 5 +++\n\ndata Exp :: Vec Type n -> Type -> Type where\n  Var :: Elem xs x -> Exp xs x\n\ndata Elem :: forall a n. Vec a n -> a -> Type where\n  Here :: Elem (x :> xs) x\n  There :: Elem xs x -> Elem (y :> xs) x\n\n-- | @Length xs@ is a runtime witness for how long a vector @xs@ is.\n-- @LZ :: Length xs@ says that @xs@ is empty.\n-- @LS len :: Length xs@ tells you that @xs@ has one more element\n-- than @len@ says.\n-- A term of type @Length xs@ also serves as a proxy for @xs@.\ndata Length :: forall a n. Vec a n -> Type where\n  LZ :: Length VNil\n  LS :: Length xs -> Length (x :> xs)\n\nderiving instance Show (Length xs)\n\n-- | Convert an expression typed in one context to one typed in a larger\n-- context. Operationally, this amounts to de Bruijn index shifting.\n-- As a proposition, this is the weakening lemma.\nshift :: forall ts2 t ty. Exp ts2 ty -> Exp (t :> ts2) ty\nshift = go LZ\n  where\n    go :: forall ts1 ty. Length ts1 -> Exp (ts1 +++ ts2) ty -> Exp (ts1 +++ t :> ts2) ty\n    go l_ts1 (Var v)          = Var (shift_elem l_ts1 v)\n\n    shift_elem :: Length ts1 -> Elem (ts1 +++ ts2) x\n               -> Elem (ts1 +++ t :> ts2) x\n    shift_elem = undefined\n\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "f :: [String]\nf = _ \"hello, world\"\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, DeriveDataTypeable #-}\n\n-- This is a performance test.  In GHC 6.4, it simply wouldn't compile\n-- because the types got exponentially large, due to poor handling of\n-- type synonyms\n\nmodule ShouldCompile where\n\nimport Data.Word\nimport Data.Int\nimport Data.Typeable\n\ndata HNil      = HNil      deriving (Eq,Show,Read)\ndata HCons e l = HCons e l deriving (Eq,Show,Read)\n\ntype e :*: l = HCons e l\n        -- In GHC 6.4 the deeply-nested use of this\n        -- synonym gave rise to exponential behaviour\n\n--- list endian16\nnewtype Tables = Tables [TableInfo] deriving (Show, Typeable)\n\ntype TableInfo =\n    AvgPot :*:\n    NumPlayers :*:\n    Waiting :*:\n    PlayersFlop :*:\n    TableName :*:\n    TableID :*:\n    GameType :*:\n    InfoMaxPlayers :*:\n    RealMoneyTable :*:\n    LowBet :*:\n    HighBet :*:\n    MinStartMoney :*:\n    MaxStartMoney :*:\n    GamesPerHour :*:\n    TourType :*:\n    TourID :*:\n    BetType :*:\n    CantReturnLess :*:\n    AffiliateID :*:\n    NIsResurrecting :*:\n    MinutesForTimeout :*:\n    SeatsToResurrect :*:\n    LangID :*:\n    HNil\n\nnewtype TourType = TourType TourType_ deriving (Show, Typeable)\nnewtype AvgPot = AvgPot Word64 deriving (Show, Typeable)\nnewtype NumPlayers = NumPlayers Word16 deriving (Show, Typeable)\nnewtype Waiting = Waiting Word16 deriving (Show, Typeable)\nnewtype PlayersFlop = PlayersFlop Word8 deriving (Show, Typeable)\nnewtype TableName = TableName String deriving (Show, Typeable)\nnewtype TableID = TableID Word32 deriving (Show, Typeable)\nnewtype OldTableID = OldTableID Word32 deriving (Show, Typeable)\nnewtype GameType = GameType GameType_ deriving (Show, Typeable)\nnewtype InfoMaxPlayers = InfoMaxPlayers Word16 deriving (Show, Typeable)\nnewtype RealMoneyTable = RealMoneyTable Bool deriving (Show, Typeable)\nnewtype LowBet = LowBet RealMoney_ deriving (Show, Typeable)\nnewtype HighBet = HighBet RealMoney_ deriving (Show, Typeable)\nnewtype MinStartMoney = MinStartMoney RealMoney_ deriving (Show, Typeable)\nnewtype MaxStartMoney = MaxStartMoney RealMoney_ deriving (Show, Typeable)\nnewtype GamesPerHour = GamesPerHour Word16 deriving (Show, Typeable)\nnewtype TourID = TourID Word32 deriving (Show, Typeable)\nnewtype BetType = BetType BetType_ deriving (Show, Typeable)\nnewtype CantReturnLess = CantReturnLess Word32 deriving (Show, Typeable)\nnewtype AffiliateID = AffiliateID [Word8] deriving (Show, Typeable)\nnewtype NIsResurrecting = NIsResurrecting Word32 deriving (Show, Typeable)\nnewtype MinutesForTimeout = MinutesForTimeout Word32 deriving (Show, Typeable)\nnewtype SeatsToResurrect = SeatsToResurrect Word32 deriving (Show, Typeable)\nnewtype LangID = LangID Word32 deriving (Show, Typeable)\n\ndata GameType_\n    = EmptyGame\n    | Holdem\n    | OmahaHoldem\n    | OmahaHiLo\n    | SevenCardStud\n    | SevenCardStudLoHi\n    | OneToOne\n    | OneToOneOmaha\n    | OneToOne7CS\n    | OneToOneOmahaHL\n    | OneToOne7CSHL\n    | TeenPatti\n    | OneToOneTeenPatti\n      deriving (Eq, Show, Typeable)\n\ntype RealMoney_ = Word64\n\ndata TourType_\n    = TourNone\n    | TourSingle\n    | TourMulti\n    | TourHeadsUpMulti\n    deriving (Enum, Eq, Show, Typeable)\n\ndata BetType_\n    = BetNone\n    | BetFixed\n    | BetPotLimit\n    | BetNoLimit\n    | BetBigRiver\n    | BetTeenPatti\n    | BetTeenPattiFixed\n    deriving (Enum, Eq, Show, Typeable)\n\n", "num_lines": 109}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Another type-synonym performance test\n--      (Trac 323)\n-- Fails in GHC up to 6.6\n\nmodule ShouldCompile where\n\ntype S = Maybe\ntype S2 n = S (S n)\ntype S4 n = S2 (S2 n)\ntype S8 n = S4 (S4 n)\ntype S16 n = S8 (S8 n)\ntype S32 n = S16 (S16 n)\n\ntype N64 n = S32 (S32 n)\n\ntype N64' =\n   S ( S ( S ( S ( S ( S ( S ( S (\n   S ( S ( S ( S ( S ( S ( S ( S (\n   S ( S ( S ( S ( S ( S ( S ( S (\n   S ( S ( S ( S ( S ( S ( S ( S (\n   S ( S ( S ( S ( S ( S ( S ( S (\n   S ( S ( S ( S ( S ( S ( S ( S (\n   S ( S ( S ( S ( S ( S ( S ( S (\n   S ( S ( S ( S ( S ( S ( S ( S (\n   Int\n   ))))))))\n   ))))))))\n   ))))))))\n   ))))))))\n   ))))))))\n   ))))))))\n   ))))))))\n   ))))))))\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule T10009 where\n\n\ntype family F a\ntype family UnF a\n\nf :: (UnF (F b) ~ b) => F b -> ()\nf = error \"urk\"\n\ng :: forall a. (UnF (F a) ~ a) => a -> ()\ng _ = f (undefined :: F a)\n\n\n{- ---------------\n[G] UnF (F b) ~ b\n\n[W] UnF (F beta) ~ beta\n[W] F a ~ F beta\n\n-------------------\n[G] g1: F a ~ fsk1         fsk1 := F a\n[G] g2: UnF fsk1 ~ fsk2    fsk2 := UnF fsk1\n[G] g3: fsk2 ~ a\n\n[W] w1: F beta ~ fmv1\n[W] w2: UnF fmv1 ~ fmv2\n[W] w3: fmv2 ~ beta\n[W] w5: fsk1 ~ fmv1   -- From F a ~ F beta\n                      -- using flat-cache\n\n---- No progress in solving -----\n-- Unflatten:\n\n[W] w3: UnF (F beta) ~ beta\n[W] w5: fsk1 ~ F beta\n\n--- Improvement\n\n[D] F beta ~ fmv1\n[D] UnF fmv1 ~ fmv2    -- (A)\n[D] fmv2 ~ beta\n[D] fmv1 ~ fsk1        -- (B) From F a ~ F beta\n                       -- NB: put fmv on left\n\n--> rewrite (A) with (B), and match with g2\n\n[D] F beta ~ fmv1\n[D] fmv2 ~ fsk2        -- (C)\n[D] fmv2 ~ beta        -- (D)\n[D] fmv1 ~ fsk1\n\n--> rewrite (D) with (C) and re-orient\n\n[D] F beta ~ fmv1\n[D] fmv2 ~ fsk2\n[D] beta ~ fsk2       -- (E)\n[D] fmv1 ~ fsk1\n\n-- Now we can unify beta!\n-}\n\n\n\n{-\n\n-----\nInert: [G] fsk_amA ~ b_amr\n       [G] UnF fsk_amy ~ fsk_amA\n       [G} F b_amr ~ fsk_amy\n\nwl: [W] F b_amr ~ F b_amt\n\nwork item: [W] UnF (F b_amt) ~ b_amt\n  b_amt is the unification variable\n\n===>      b_amt := s_amF\n\nInert: [G] fsk_amA ~ b_amr\n       [G] UnF fsk_amy ~ fsk_amA\n       [G} F b_amr ~ fsk_amy\n\nwl: [W] F b_amr ~ F b_amt\n    [W] UnF s_amD ~ s_amF\n\nwork item: [W] F b_amt ~ s_amD\n\n\n===>\nwl: [W] F b_amr ~ F b_amt\n    [W] UnF s_amD ~ s_amF\n\nInert: [G] fsk_amA ~ b_amr\n       [G] UnF fsk_amy ~ fsk_amA\n       [G} F b_amr ~ fsk_amy\n       [W] F s_amF ~ s_amD\n\n===>\nwl: [W] F b_amr ~ F b_amt\n\nInert: [G] fsk_amA ~ b_amr\n       [G] UnF fsk_amy ~ fsk_amA\n       [G} F b_amr ~ fsk_amy\n       [W] F s_amF ~ s_amD\n       [W] UnF s_amD ~ s_amF\n\n===>\nInert: [G] fsk_amA ~ b_amr\n       [G] UnF fsk_amy ~ fsk_amA\n       [G} F b_amr ~ fsk_amy\n       [W] UnF s_amD ~ s_amF\n       [W] F s_amF ~ s_amD\n\nwl:\n\nwork-item: [W] F b_amr ~ F b_amt\n--> fsk_amy ~ s_amD\n--> s_amD ~ fsk_amy\n\n===>\nInert: [G] fsk_amA ~ b_amr\n       [G] UnF fsk_amy ~ fsk_amA\n       [G} F b_amr ~ fsk_amy\n       [W] UnF s_amD ~ s_amF\n       [W] F s_amF ~ s_amD\n       [W] s_amD ~ fsk_amy\n\nwl:\n\nwork item: [D] UnF s_amD ~ s_amF\n\n--> [D] UnF fsk_amy ~ s_amF\n--> [D] s_amF ~ fsk_amA\n\n===>\nInert: [G] fsk_amA ~ b_amr\n       [G] UnF fsk_amy ~ fsk_amA\n       [G} F b_amr ~ fsk_amy\n       [W] UnF s_amD ~ s_amF\n       [W] F s_amF ~ s_amD\n       [W] s_amD ~ fsk_amy\n       [D] s_amF ~ fsk_amA\n\nwl:\n\nwork item: [D] F s_amF ~ s_amD\n--> F fsk_amA ~ s_amD\n--> s_amd ~ b_amr\n-}\n", "num_lines": 151}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule T10031 where\nimport Data.Coerce\ncoerce' :: Coercible b a => a -> b\ncoerce' = coerce (\\x -> x :: b) :: forall a b. Coercible b a => a -> b\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T0072 where\n{-# RULES\n\"map/empty\" forall (f :: a -> _). map f [] = []\n  #-}\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses  #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE FlexibleInstances      #-}\n{-# LANGUAGE UndecidableInstances   #-}\n\nmodule T10100 where\n\ndata Zero\ndata Succ a\n\nclass Add a b ab | a b -> ab, a ab -> b\ninstance Add Zero b b\ninstance (Add a b ab) => Add (Succ a) b (Succ ab)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FunctionalDependencies,\n             UndecidableInstances, FlexibleInstances #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule T10109 where\n\ndata Succ a\n\nclass Add (a :: k1) (b :: k2) (ab :: k3) | a b -> ab\ninstance (Add a b ab) => Add (Succ a) b (Succ ab)\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, TypeFamilies #-}\n\nmodule T10156 where\n\nimport Data.Coerce\n\ndata Iso a b = Iso (a -> b) (b -> a)\n\ncoerceIso :: Coercible a b => Iso a b\ncoerceIso = Iso coerce coerce\n\ntype family F x\n\nf :: (Coercible a (F b), Coercible c (F b)) => a -> b -> c\nf x _ = coerce x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}\n    -- This test deliberately uses a simplifiable class constraint\n\nmodule T10177 where\n\nimport Data.Typeable\n\nnewtype V n a = V [a]\n\nclass    Typeable a                   => C a\ninstance (Typeable (V n), Typeable a) => C (V n a)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10184 where\n\nimport Data.Coerce\n\nnewtype Bar a = Bar (Either a (Bar a))\nnewtype Age = MkAge Int\n\nx :: Bar Age\nx = coerce (Bar (Left (5 :: Int)))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10185 where\n\nimport Data.Coerce\nimport Data.Proxy\n\nfoo :: (Coercible (a b) (c d), Coercible (c d) (e f)) => Proxy (c d) -> a b -> e f\nfoo _ = coerce\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, GADTs,\n             ConstraintKinds, DataKinds, KindSignatures,\n             FlexibleInstances #-}\n\nmodule T10195 where\n\nimport Data.Kind\n\ndata Foo m zp r'q = Foo zp\ndata Dict :: Constraint -> Type where\n  Dict :: a => Dict a\n\ntype family BarFamily a b :: Bool\nclass Bar m m'\ninstance (BarFamily m m' ~ 'True) => Bar m m'\n\nmagic :: (Bar m m') => c m zp -> Foo m zp (c m' zq)\n-- Weird test case: (Bar m m') is simplifiable\nmagic = undefined\n\ngetDict :: a -> Dict (Num a)\ngetDict _ = undefined\nfromScalar :: r -> c m r\nfromScalar = undefined\n\nfoo :: (Bar m m')\n  => c m zp -> Foo m zp (c m' zq) -> Foo m zp (c m' zq)\n-- Weird test case: (Bar m m') is simplifiable\nfoo b (Foo sc) =\n  let scinv = fromScalar sc\n  in case getDict scinv of\n    Dict -> magic $ scinv * b\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors -fno-warn-deferred-type-errors #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n\nmodule T9834 where\nimport Control.Applicative\nimport Data.Functor.Identity\n\ntype Nat f g = forall a. f a -> g a\n\nnewtype Comp p q a = Comp (p (q a))\n\nliftOuter :: (Functor p, Applicative q) => p a -> (Comp p q) a\nliftOuter pa = Comp (pure <$> pa)\n\nrunIdComp :: Functor p => Comp p Identity a -> p a\nrunIdComp (Comp p) = runIdentity <$> p\n\nwrapIdComp :: Applicative p => (forall q. Applicative q => Nat (Comp p q) (Comp p q)) -> p a -> p a\nwrapIdComp f = runIdComp . f . liftOuter\n\nclass Applicative p => ApplicativeFix p where\n  afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a\n  afix = wrapIdComp\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ConstraintKinds #-}\n\nmodule Foo where\n\ntype X a = (Eq a, Show a)\n\nclass Eq a => C a b\n\n-- HEAD was unable to find the (Eq a) superclass\n-- for a while in March/April 2015\ninstance X a => C a [b]\n\n\n\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-binds #-}\n\nmodule T10347 (N, mkN) where\n\nimport Data.Coerce\n\nnewtype N a = MkN Int\n\nmkN :: Int -> N a\nmkN = coerce\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, DataKinds, KindSignatures, StandaloneDeriving, TypeOperators #-}\n\nmodule T10348 where\n\nimport GHC.TypeLits\nimport Data.Typeable\nimport Data.Proxy\n\ndata Foo (n :: Nat) where\n  Hey :: KnownNat n => Foo n\n\nderiving instance Show (Foo n)\n\ndata T t where\n  T :: (Show t, Typeable t) => t -> T t\n\nderiving instance Show (T n)\n\nhey :: KnownNat n => T (Foo n)\nhey = T Hey\n\nho :: T (Foo 42)\nho = T Hey\n\nf1 :: KnownNat a => Proxy a -> TypeRep\nf1 = typeRep\n\ng2 :: KnownSymbol a => Proxy a -> TypeRep\ng2 = typeRep\n\npEqT :: (KnownSymbol a, KnownSymbol b) => Proxy a -> Proxy b -> Maybe (a :~: b)\npEqT Proxy Proxy = eqT\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T10390 where\n\nclass ApPair r where\n  apPair :: (forall a . (ApPair a, Num a) => Maybe a) -> Maybe r\n\ninstance (ApPair a, ApPair b) => ApPair (a,b) where\n  apPair = apPair'\n\napPair' :: (ApPair b, ApPair c)\n        => (forall a . (Num a, ApPair a) => Maybe a) -> Maybe (b,c)\n            -- NB constraints in a different order to apPair\napPair' f =  let (Just a) = apPair f\n                 (Just b) = apPair f\n          in Just $ (a, b)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, TypeFamilies, MultiParamTypeClasses #-}\n\nmodule T10423 where\n\nclass Monad m => Testable m a\n\nnewtype Prop m = MkProp (m Int)\n\ninstance (Monad m, m ~ n) => Testable n (Prop m)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10428 where\n\nimport Data.Coerce\ncoerceNewtype :: (Coercible (o r) (n m' r)) => [o r] -> [n m' r]\ncoerceNewtype = coerce\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, PolyKinds,\n             DataKinds, RankNTypes, GADTs, TypeOperators #-}\nmodule T10432 where\n\nimport Data.Kind (Type)\nimport Data.Type.Equality\n\ndata WrappedType = forall a. WrapType a;\n\nmatchReflK :: forall ka kb (a :: ka) (b :: kb) (r :: Type).\n  ('WrapType a :~: 'WrapType b) -> (('WrapType a ~ 'WrapType b) => r) -> r;\n  matchReflK Refl r = r;\n\nmatchReflK2 :: forall ka kb (a :: ka) (b :: kb) (r :: Type).\n               ('WrapType a :~: 'WrapType b) ->  r\nmatchReflK2 x = let foo :: ('WrapType a ~ 'WrapType b) => r\n                    foo = undefined\n                in undefined\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10489 where\n\n-- Triggered an ASSERT in a debug build at some point.\nconvert d = let d' = case d of '0' -> '!' in d'\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n\nmodule T10493 where\n\nimport Data.Coerce\nimport Data.Ord (Down)  -- no constructor\n\nfoo :: Coercible (Down Int) Int => Down Int -> Int\nfoo = coerce\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module App where\n\nimport Data.Coerce\n\nfoo :: Coercible (a b) (c d) => a b -> c d\nfoo = coerce\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies #-}\nmodule T10562 where\n\ntype family Flip a\n\ndata QueryRep qtyp a where\n    QAtom :: a -> QueryRep () a\n    QOp   :: QueryRep (Flip qtyp) a -> QueryRep qtyp a\n\ninstance Eq (QueryRep qtyp a) where\n  (==) = error \"urk\"\n\ninstance (Ord a) => Ord (QueryRep qtyp a) where\n  compare (QOp a) (QOp b) = a `compare` b\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances,\n             DataKinds, TypeFamilies, KindSignatures, PolyKinds, FunctionalDependencies #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule T10564 where\n\nimport Data.Kind (Type)\n\nclass HasFieldM (l :: k) r (v :: Maybe Type)\n        | l r -> v\n\nclass HasFieldM1 (b :: Maybe [Type]) (l :: k) r v\n        | b l r -> v\n\nclass HMemberM (e1 :: k) (l :: [k]) (r :: Maybe [k])\n        | e1 l -> r\n\ndata Label a\ntype family LabelsOf (a :: [Type]) ::  [Type]\n\ninstance (HMemberM (Label (l::k)) (LabelsOf xs) b,\n            HasFieldM1 b l (r xs) v)\n         => HasFieldM l (r xs) v where\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase, TypeFamilies #-}\n\nmodule T10589 where\n\ntype family F a where\n  F a = Bool -> a\n\nfoo = (\\case True -> 5\n             False -> 6) :: F Int\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableSuperClasses #-}\n\nmodule T10592 where\n\nimport Data.Kind (Type)\nimport Prelude (Bool(True,False),Integer,Ordering)\nimport qualified Prelude\n\n--------------------\n-- class hierarchy\n\nclass Boolean (Logic a) => Eq a where\n    type Logic a :: Type\n    (==) :: a -> a -> Logic a\n\n    (/=) :: a -> a -> Logic a\n    a/=b = not (a==b)\n\nclass Eq a => POrd a where\n    inf :: a -> a -> a\n\nclass POrd a => MinBound a where\n    minBound :: a\n\nclass POrd a => Lattice a where\n    sup :: a -> a -> a\n\nclass (Lattice a, MinBound a) => Bounded a where\n    maxBound :: a\n\nclass Bounded a => Complemented a where\n    not :: a -> a\n\nclass Bounded a => Heyting a where\n    infixr 3 ==>\n    (==>) :: a -> a -> a\n\nclass (Complemented a, Heyting a) => Boolean a\n\n(||) :: Boolean a => a -> a -> a\n(||) = sup\n\n(&&) :: Boolean a => a -> a -> a\n(&&) = inf\n\n--------------------\n-- Bool instances\n-- (these work fine)\n\ninstance Eq Bool where\n    type Logic Bool = Bool\n    (==) = (Prelude.==)\n\ninstance POrd Bool where\n    inf True  True  = True\n    inf _     _     = False\n\ninstance MinBound Bool where\n    minBound = False\n\ninstance Lattice Bool where\n    sup False False = False\n    sup _     _     = True\n\ninstance Bounded Bool where\n    maxBound = True\n\ninstance Complemented Bool where\n    not True  = False\n    not False = True\n\ninstance Heyting Bool where\n    False ==> _ = True\n    True  ==> a = a\n\ninstance Boolean Bool\n\n--------------------\n-- Integer instances\n-- (these work fine)\n\ninstance Eq Integer where\n    type Logic Integer = Bool\n    (==) = (Prelude.==)\n\ninstance POrd Integer where\n    inf = Prelude.min\n\ninstance Lattice Integer where\n    sup = Prelude.max\n\n--------------------\n-- function instances\n-- (these cause GHC to loop)\n\ninstance Eq b => Eq (a -> b) where\n    type Logic (a -> b) = a -> Logic b\n    f==g = \\a -> f a == g a\n\ninstance POrd b => POrd (a -> b) where\n    inf f g = \\a -> inf (f a) (g a)\n\ninstance MinBound b => MinBound (a -> b) where\n    minBound = \\_ -> minBound\n\ninstance Lattice b => Lattice (a -> b) where\n    sup f g = \\a -> sup (f a) (g a)\n\ninstance Bounded b => Bounded (a -> b) where\n    maxBound = \\_ -> maxBound\n\ninstance Complemented b => Complemented (a -> b) where\n    not f = \\a -> not (f a)\n\ninstance Heyting b => Heyting (a -> b) where\n    f ==> g = \\a -> f a ==> g a\n\ninstance Boolean b => Boolean (a -> b)\n", "num_lines": 121}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n{-# OPTIONS_GHC -Wredundant-constraints #-}\n\nf :: (?file1 :: String) => IO ()\nf = putStrLn $ \"f2: \"\n\nmain :: IO ()\nmain = let ?file1 = \"A\" in f\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T9939 where\n\nf1 :: (Eq a, Ord a) => a -> a -> Bool\n-- Eq a redundant\nf1 x y = (x == y) && (x > y)\n\nf2 :: (Eq a, Ord a) => a -> a -> Bool\n-- Ord a redundant, but Eq a is reported\nf2 x y = (x == y)\n\nf3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool\n-- Eq b redundant\nf3 x y = x==y\n\ndata Equal a b where\n  EQUAL :: Equal a a\n\nf4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool\n-- Eq b redundant\nf4 x y EQUAL = y==y\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T10642 where\n\nimport Data.Coerce\n\ntype family F a\n\nnewtype D a = D (F a)\n\n-- | This works on 7.10.1, but fails on HEAD (20150711)\ncoerceD :: F a -> D a\ncoerceD = coerce\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T10744 where\n\nimport GHC.Exts\nimport GHC.Magic\n\n-- Checks if oneShot is open-kinded\n\nf0 :: Int -> Int\nf0 = oneShot $ \\n -> n\n\nf1 :: Int# -> Int\nf1 = oneShot $ \\n# -> I# n#\n\nf2 :: Int -> Int#\nf2 = oneShot $ \\(I# n#) -> n#\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10770a where\n\nimport Data.Typeable\n\nmain = print $ foo $ Just ()\n\nfoo :: Typeable (t a) => t a -> String\nfoo x = let k = show $ typeOf x in k\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# OPTIONS_GHC -fwarn-redundant-constraints #-}\nmodule T10770b where\n\nf :: (Show a, Show (Maybe a)) => Maybe a -> String\nf x = let k = show x in k\n\ng :: (Show a, Show (Maybe a)) => Maybe a -> String\ng x = show x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-monomorphism-restriction #-}\n\nmodule T10935 where\n\nf x = let y = 1+1 in (y,y)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE MonomorphismRestriction, ExtendedDefaultRules #-}\nmodule T10971a where\n\nimport Data.Traversable (fmapDefault)\n\nf = \\x -> length x\ng = \\f x -> fmapDefault f x\nh = \\f x -> (fmapDefault f x, length x)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds #-}\nmodule T11056 where\nimport Data.Typeable\n\ndata T = A | B Int\n\nbar :: TypeRep\nbar = typeRep (Proxy :: Proxy '[True])\n\nbaz :: TypeRep\nbaz = typeRep (Proxy :: Proxy 'A)\n\nquux :: TypeRep\nquux = typeRep (Proxy :: Proxy 'B)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T11062 where\nimport T11062a\ntype family F a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T11062a where\nimport {-# SOURCE #-} T11062\ntype instance F Int = Bool\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule Bug where\n\ndata T a = MkT\n\nout :: forall a. T a -> ()\nout MkT = ()\n\ninHoisted :: forall r. () -> (forall a. T a -> r) -> r\ninHoisted _ foo = foo MkT\n\ninUnhoisted :: () -> forall r. (forall a. T a -> r) -> r\ninUnhoisted _ foo = foo MkT\n\ntestHoisted :: ()\ntestHoisted = inHoisted () out\n\ntestUnhoisted :: ()\ntestUnhoisted = inUnhoisted () out\n\n\n----------------\n\ndata A s = A { unA :: () }\n\nrunA1 :: (forall s. A s) -> ()\nrunA1 a = unA a\n\n-- doesn't work :(\nrunA2 :: (forall s. A s) -> ()\nrunA2 (A a) = a\n\nrunA3 :: (forall s. A s) -> ()\nrunA3 a = case a of A x -> x\n\nrunA4 :: (forall s. A s) -> ()\nrunA4 a = let A x = a in x\n\nrunA5 :: (forall s. A s) -> ()\nrunA5 a = go a\n  where go (A a) = a\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, KindSignatures #-}\n{-# LANGUAGE GADTs #-}\nmodule T11237 where\n\nimport qualified Data.Kind\n\ndata Works :: Data.Kind.Type where\n  WorksConstr :: Works\n\ntype Set = Data.Kind.Type\n\ndata ShouldWork :: Set where\n  ShouldWorkConstr :: ShouldWork\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11246 where\n\nimport GHC.Exts\n\ntype Key a = Any\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- /tmp/panic.hs\n{-# LANGUAGE FlexibleContexts        #-}\n{-# LANGUAGE FlexibleInstances       #-}\n{-# LANGUAGE InstanceSigs            #-}\n{-# LANGUAGE TypeFamilies            #-}\n{-# LANGUAGE TypeSynonymInstances    #-}\n{-# LANGUAGE UndecidableSuperClasses #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\n\nmodule T11254 where\n\nclass (Frac (Frac a) ~ Frac a, Fractional (Frac a), ID (Frac a)) => ID a where\n  type Frac a\n  embed :: a -> Frac a\n\ninstance ID Rational where\n  type Frac Rational = Int\n  embed :: Rational -> Rational\n  embed = undefined\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule Data.Profunctor.Strong where\n\nimport Control.Arrow\nimport Control.Category\nimport Data.Tuple\nimport Prelude hiding (id,(.))\n\ninfixr 0 :->\ntype p :-> q = forall a b. p a b -> q a b\n\nclass Profunctor p where\n  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d\n\nclass ProfunctorFunctor t where\n  promap    :: Profunctor p => (p :-> q) -> t p :-> t q\n\nclass ProfunctorFunctor t => ProfunctorMonad t where\n  proreturn :: Profunctor p => p       :-> t p\n  projoin   :: Profunctor p => t (t p) :-> t p\n\nclass ProfunctorFunctor t => ProfunctorComonad t where\n  proextract   :: Profunctor p => t p :-> p\n  produplicate :: Profunctor p => t p :-> t (t p)\n\nclass Profunctor p => Strong p where\n  first' :: p a b  -> p (a, c) (b, c)\n  first' = dimap swap swap . second'\n\n  second' :: p a b -> p (c, a) (c, b)\n  second' = dimap swap swap . first'\n\n----------------------------------------------------------------------------\n\nnewtype Tambara p a b = Tambara { runTambara :: forall c. p (a, c) (b, c) }\n\ninstance Profunctor p => Profunctor (Tambara p) where\n  dimap f g (Tambara p) = Tambara $ dimap (first f) (first g) p\n\ninstance ProfunctorFunctor Tambara where\n  promap f (Tambara p) = Tambara (f p)\n\ninstance ProfunctorComonad Tambara where\n  proextract (Tambara p) = dimap (\\a -> (a,())) fst p\n\n  produplicate (Tambara p) = Tambara (Tambara $ dimap hither yon p)\n    where\n      hither :: ((a, b), c) -> (a, (b, c))\n      hither ~(~(x,y),z) = (x,(y,z))\n\n      yon    :: (a, (b, c)) -> ((a, b), c)\n      yon    ~(x,~(y,z)) = ((x,y),z)\n\ninstance Profunctor p => Strong (Tambara p) where\n  first' = runTambara . produplicate\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes #-}\n\n-- Sept 16: this compiles again now, because I've weakened\n--          ImpredicativeTypes a lot\n\nmodule T11319 where\n\nf :: Monad m => m (Maybe a)\nf = return Nothing\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\nmodule T11339 where\n\nimport Control.Applicative ( Const(Const, getConst) )\nimport Data.Functor.Identity ( Identity(Identity) )\n\ntype Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t\n\nfailing :: forall s t a b . Traversal s t a b -> Traversal s t a b -> Traversal s t a b\nfailing left right afb s = case pins t of\n  [] -> right afb s\n  _  -> t afb\n  where\n    t :: Applicative f => (a -> f b) -> f t\n    -- Does not work because the MR applies to this binding group\n    Bazaar { getBazaar = t } = left sell s\n\n    sell :: a -> Bazaar a b b\n    sell w   = Bazaar ($ w)\n\n    pins :: ((a -> Const [Identity a] b) -> Const [Identity a] t) -> [Identity a]\n    pins f   = getConst (f (\\ra -> Const [Identity ra]))\n\nnewtype Bazaar a b t = Bazaar { getBazaar :: (forall f. Applicative f => (a -> f b) -> f t) }\n\ninstance Functor (Bazaar a b) where\n  fmap f (Bazaar k) = Bazaar (fmap f . k)\n\ninstance Applicative (Bazaar a b) where\n  pure a = Bazaar $ \\_ -> pure a\n  Bazaar mf <*> Bazaar ma = Bazaar $ \\afb -> mf afb <*> ma afb\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonomorphismRestriction, RankNTypes, ScopedTypeVariables #-}\n\nmodule T11339b where\n\nimport Control.Applicative ( Const(Const, getConst) )\nimport Data.Functor.Identity ( Identity(Identity) )\n\ntype Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t\n\nfailing :: forall s t a b . Traversal s t a b -> Traversal s t a b -> Traversal s t a b\nfailing left right afb s = case pins t of\n  [] -> right afb s\n  _  -> t afb\n  where\n    t :: Applicative f => (a -> f b) -> f t\n    -- Works because of NoMonomorphismRestriction\n    Bazaar { getBazaar = t } = left sell s\n\n    sell :: a -> Bazaar a b b\n    sell w   = Bazaar ($ w)\n\n    pins :: ((a -> Const [Identity a] b) -> Const [Identity a] t) -> [Identity a]\n    pins f   = getConst (f (\\ra -> Const [Identity ra]))\n\nnewtype Bazaar a b t = Bazaar { getBazaar :: (forall f. Applicative f => (a -> f b) -> f t) }\n\ninstance Functor (Bazaar a b) where\n  fmap f (Bazaar k) = Bazaar (fmap f . k)\n\ninstance Applicative (Bazaar a b) where\n  pure a = Bazaar $ \\_ -> pure a\n  Bazaar mf <*> Bazaar ma = Bazaar $ \\afb -> mf afb <*> ma afb\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonoLocalBinds, RankNTypes, ScopedTypeVariables #-}\n\nmodule T11339c where\n\nimport Control.Applicative ( Const(Const, getConst) )\nimport Data.Functor.Identity ( Identity(Identity) )\n\ntype Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t\n\nfailing :: forall s t a b . Traversal s t a b -> Traversal s t a b -> Traversal s t a b\nfailing left right afb s = case pins t of\n  [] -> right afb s\n  _  -> t afb\n  where\n    t :: Applicative f => (a -> f b) -> f t\n    -- Works because of MonoLocalBinds\n    Bazaar { getBazaar = t } = left sell s\n\n    sell :: a -> Bazaar a b b\n    sell w   = Bazaar ($ w)\n\n    pins :: ((a -> Const [Identity a] b) -> Const [Identity a] t) -> [Identity a]\n    pins f   = getConst (f (\\ra -> Const [Identity ra]))\n\nnewtype Bazaar a b t = Bazaar { getBazaar :: (forall f. Applicative f => (a -> f b) -> f t) }\n\ninstance Functor (Bazaar a b) where\n  fmap f (Bazaar k) = Bazaar (fmap f . k)\n\ninstance Applicative (Bazaar a b) where\n  pure a = Bazaar $ \\_ -> pure a\n  Bazaar mf <*> Bazaar ma = Bazaar $ \\afb -> mf afb <*> ma afb\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonoLocalBinds, RankNTypes #-}\n\n-- Ross Paterson's example from\n-- https://prime.haskell.org/wiki/MonomorphicPatternBindings\n\nmodule T11339d where\n\nimport Control.Monad.ST\n\nnewtype ListMap m a b = ListMap ([a] -> m [b])\n\nrunMap :: (forall s. ListMap (ST s) a b) -> [a] -> [b]\nrunMap lf as = runST (f as)\n             where\n               ListMap f = lf\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE DataKinds #-}\n\nmodule T11348 where\n\nimport Data.Kind\nimport Data.Proxy\n\ntype family TrivialFamily t :: Type\ntype instance TrivialFamily (t :: Type) = Bool\n\ndata R where\n    R :: Proxy Bool -> R\n\ntype ProblemType t = 'R ('Proxy :: Proxy (TrivialFamily t))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, RankNTypes, MultiParamTypeClasses,\n              FunctionalDependencies, FlexibleInstances, FlexibleContexts\n #-}\n\nmodule XMonad.Layout.MultiToggle where\n\nimport Data.Typeable\n\n-- This appears to be the culprit\nexpand :: (HList ts a) => MultiToggleS ts l a -> MultiToggle ts l a\nexpand (MultiToggleS b ts) =\n    resolve ts id\n        (\\x mt -> let g = transform' x in mt{ currLayout = g $ currLayout mt })\n        (MultiToggle (EL b id) ts)\n\nclass (Typeable t) => Transformer t a | t -> a where\n    transform :: t\n              -> l a\n              -> (forall l'. l' a -> (l' a -> l a) -> b)\n              -> b\n\ndata  EL l a = forall l'. EL (l' a) (l' a -> l a)\n\ntransform' :: (Transformer t a) => t -> EL l a -> EL l a\ntransform' t (EL l det) = undefined\n\ndata MultiToggleS ts l a = MultiToggleS (l a) ts\n                         deriving (Read, Show)\n\ndata MultiToggle ts l a = MultiToggle{\n    currLayout :: EL l a,\n    transformers :: ts\n    }\n\nclass HList c a where\n    resolve :: c -> b -> (forall t. (Transformer t a) => t -> b) -> b\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11397 where\n\n\nf :: a -> [Maybe a]\nf x =\n   let switch l = [l Nothing, l (Just x)]\n   in  switch id\n\nu :: a\nu = u\n\nf2 :: a\nf2 = let switch l = l u in switch u\n\n\nf3 :: a\nf3 = let switch l = l undefined in switch undefined\n\n\nnewtype VectorLazy a = VectorLazy a\nnewtype Vector a = Vector a\nnewtype Pointer a = Pointer a\n\nempty :: VectorLazy a\nempty = undefined\n\ncons :: Vector a -> Pointer a\ncons = undefined\n\nunfoldrResult :: (a -> Either c (b, a)) -> a -> (VectorLazy b, c)\nunfoldrResult = undefined\n\nswitchL :: b -> (a -> Pointer a -> b) -> Pointer a -> b\nswitchL = undefined\n\ninverseFrequencyModulationChunk ::\n   (Num t, Ord t) =>\n   (s -> Maybe (t,s)) -> (t,s) -> Vector v -> (VectorLazy v, Maybe (t,s))\ninverseFrequencyModulationChunk nextC (phase,cst0) chunk =\n   let {-\n       switch ::\n          (Maybe (t, s) -> r) ->\n          ((t, v) -> (s, Pointer v) -> r) ->\n          t ->\n          (s, Pointer v) -> r\n       -}\n       switch l r t (cp0,xp0) =\n          maybe\n             (l Nothing)\n             (\\(c1,cp1) ->\n                switchL\n                   (l (Just (t,cp0)))\n                   (\\x1 xp1 -> r (t+c1,x1) (cp1,xp1))\n                   xp0)\n             (nextC cp0)\n\n       {-\n       go ::\n          (t,v) -> (s, Pointer v) ->\n          Either (Maybe (t,s)) (v, ((t,v), (s, Pointer v)))\n       -}\n       go (c,x) cxp =\n          if c<1\n            then switch Left go c cxp\n            else Right (x, ((c-1,x),cxp))\n\n   in  switch ((,) empty)\n          (curry $ unfoldrResult (uncurry go))\n          phase (cst0, cons chunk)\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule T11401 where\n\nimport Data.Kind (Type)\n\nnewtype Value a = Value a\nnewtype CodeGen r a = CodeGen a\n\nbind :: CodeGen r a -> (a -> CodeGen r b) -> CodeGen r b\nbind (CodeGen a) k = k a\n\nclass\n   (f ~ CalledFunction g, r ~ CallerResult g, g ~ CallerFunction f r) =>\n       CallArgs f g r where\n   type CalledFunction g :: Type\n   type CallerResult g :: Type\n   type CallerFunction f r :: Type\n   call :: f -> g\n\ninstance CallArgs (IO a) (CodeGen r (Value a)) r where\n   type CalledFunction (CodeGen r (Value a)) = IO a\n   type CallerResult (CodeGen r (Value a)) = r\n   type CallerFunction (IO a) r = CodeGen r (Value a)\n   call = undefined\n\ninstance CallArgs b b' r => CallArgs (a -> b) (Value a -> b') r where\n   type CalledFunction (Value a -> b') = a -> CalledFunction b'\n   type CallerResult (Value a -> b') = CallerResult b'\n   type CallerFunction (a -> b) r = Value a -> CallerFunction b r\n   call = undefined\n\ntest :: IO a -> (a -> IO ()) -> CodeGen () (Value ())\ntest start stop  =  bind (call start) (call stop)\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11458 where\n\noptIntArg f = (f Nothing, f (Just True))\n\noptIntArg2 f = (f (Just True), f Nothing)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fplugin=T11462_Plugin #-}\n\nmodule T11462 where\n\nimpossible :: a\nimpossible = undefined\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11462_Plugin(plugin) where\n\nimport TcRnMonad ( TcPlugin(..), TcPluginResult(..) )\nimport Plugins ( defaultPlugin, Plugin(..), CommandLineOption )\n\nplugin :: Plugin\nplugin = defaultPlugin { tcPlugin = Just . thePlugin }\n\nthePlugin :: [CommandLineOption] -> TcPlugin\nthePlugin opts = TcPlugin\n  { tcPluginInit  = return ()\n  , tcPluginSolve = \\_ _ _ _ -> return $ TcPluginOk [] []\n  , tcPluginStop  = \\_ -> return ()\n  }\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, UndecidableSuperClasses #-}\n\nmodule T11480 where\n\nclass C [a] => D a\nclass D a => C a\n\nfoo :: C a => a -> a\nfoo = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeApplications, ScopedTypeVariables #-}\n\nmodule Bug where\n\nimport Data.Proxy\n\nclass C a where\n  foo :: Proxy a\n\nbar :: forall a. C a => Proxy a\nbar = foo @a\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ExplicitForAll #-}\n{-# LANGUAGE PatternSynonyms #-}\n\nmodule T11524 where\n\ndata AType (a :: k) where\n    AMaybe :: AType Maybe\n    AInt :: AType Int\n    AApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).\n            AType a -> AType b -> AType (a b)\n\npattern PApp :: () => (fun ~ a b) => AType a -> AType b -> AType fun\n--pattern PApp :: forall k (fun :: k) k1 (a :: k1 -> k) (b :: k1).\n--            () => (fun ~ a b) => AType a -> AType b -> AType fun\npattern PApp fun arg <- AApp fun arg\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, KindSignatures, TypeFamilies,\n             ConstraintKinds, FlexibleContexts #-}\n{-# OPTIONS_GHC -fplugin T11525_Plugin #-}\nmodule T11525 where\n\nimport GHC.TypeLits\nimport Data.Proxy\n\ntruncateB :: KnownNat a => Proxy (a + b) -> Proxy a\ntruncateB Proxy = Proxy\n\nclass Bus t where\n  type AddrBits t :: Nat\n\ndata MasterOut b = MasterOut\n    { adr :: Proxy (AddrBits b)\n    }\n\ntype WiderAddress b b' k = ( KnownNat (AddrBits b)\n                           , AddrBits b' ~ (AddrBits b + k)\n                           )\n\nnarrowAddress' :: (WiderAddress b b' k)\n               => MasterOut b'\n               -> MasterOut b\nnarrowAddress' m = MasterOut { adr = truncateB (adr m) }\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11525_Plugin(plugin) where\n\nimport TcRnMonad ( TcPlugin(..), TcPluginResult(..) )\nimport Plugins ( defaultPlugin, Plugin(..), CommandLineOption )\n\nplugin :: Plugin\nplugin = defaultPlugin { tcPlugin = Just . thePlugin }\n\nthePlugin :: [CommandLineOption] -> TcPlugin\nthePlugin opts = TcPlugin\n  { tcPluginInit  = return ()\n  , tcPluginSolve = \\_ _ _ _ -> return $ TcPluginOk [] []\n  , tcPluginStop  = \\_ -> return ()\n  }\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs        #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule T11552 where\n\nnewtype MaybeT m a =\n  MaybeT { runMaybeT :: m (Maybe a) }\n\ninstance (Functor m) => Functor (MaybeT m) where\n  fmap f (MaybeT ma) =\n    MaybeT $ (fmap . fmap) f ma\n\ninstance forall f . (Applicative f) => Applicative (MaybeT f) where\n  pure :: a -> MaybeT f a\n  pure x = MaybeT (pure (pure x))\n\n  (<*>) :: forall a b . Applicative f => MaybeT f (a -> b) -> MaybeT f a -> MaybeT f b\n  (MaybeT fab) <*> (MaybeT mma) =\n   let fab' :: f (Maybe (a -> b))\n       fab' = fab\n   in MaybeT $ undefined\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T11608 where\n\ntype Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t\n\nclass Each s t a b | s -> a, t -> b, s b -> t, t a -> s where\n  each :: Traversal s t a b\n  default each :: (Traversable g, s ~ g a, t ~ g b) => Traversal s t a b\n  each = traverse\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, PolyKinds #-}\n\nmodule T11699 where\n\ntype family F a where F (f a) = f a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies #-} -- Remove this line and the code compiles.\n\nmodule T11700 where\n\ndata Muse\ndata Message\ndata Folder\n\nclass PersistEntity record\n\ndata Entity record where\n  Entity :: PersistEntity record => record -> Entity record\n\nfn1 :: (Entity Muse, Entity Message) -> Message\nfn1 cluster = let (Entity foo, Entity msg) = cluster\n              in msg\n-- fn1 (Entity foo, Entity msg) = msg\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule Example where\n\nimport Data.Typeable\nimport GHC.Exts\n\ndata Wat (a :: TYPE ('TupleRep '[])) = Wat a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule T11736 where\n\nimport Data.Proxy\n\nfoo :: Proxy (#,#)\nfoo = Proxy\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T11766 where\n\nimport Data.Maybe (isJust)\n\ndata Wrapper a = Wrapper a deriving (Show)\n\nclass Resolution a\ninstance Resolution (Wrapper a)\n\nclass (Resolution b, Resolution d) => C a b c d | a -> b, c -> d, a d -> c, b c -> a where\n  cfun :: (b -> d) -> a -> c\n\ninstance {-# OVERLAPPABLE #-} (Resolution b, Resolution d, a ~ b, c ~ d) => C a b c d where\n  cfun = ($)\n\ninstance {-# OVERLAPPING #-} (C b c d e) => C (Maybe a -> b) c (Maybe a -> d) e where\n  cfun f b = \\x -> cfun f (b x)\n\nfoo :: Maybe a -> Wrapper Bool\nfoo = Wrapper . isJust\n\nt1 = cfun id foo $! Nothing\nt2 = let f = cfun id foo in f Nothing\nt3 = cfun id foo Nothing\nt4 = cfun id foo $ Nothing\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\nmodule T11793 where\n\nclass C a where\n  op :: (?x::Int) => a -> a\n\n-- Should be OK even without ConstrainedClassMethods\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs #-}\n\nmodule T11811 where\n\nimport Data.Kind\n\ndata Test (a :: x) (b :: x) :: x -> Type\n  where K :: Test Int Bool Double\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, ScopedTypeVariables, AllowAmbiguousTypes #-}\nmodule T11947 where\n\ntheFloatDigits :: forall a. RealFloat a => Int\n-- The type is ambiguous\ntheFloatDigits = floatDigits (undefined @_ @a)\n\nfoo :: IO ()\nfoo = print (theFloatDigits @Double, theFloatDigits @Float)\n-- But the applications are not\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExtendedDefaultRules #-}\n\nmodule T11974 where\n\ndefault (Maybe, [])\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonadComprehensions, ParallelListComp #-}\n\nmodule Foo where\n\nfoo xs ys = [ (f y True, f x 'c')\n            | let f _ z = z, x <- xs\n            | y <- ys ]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ApplicativeDo #-}\nmodule Main where\nimport Control.Concurrent.MVar\n\ntype Locker = forall a. IO a -> IO a\n\nmain :: IO ()\nmain = do\n    line <- getLine\n    lock <- newMVar ()\n    let locker :: Locker\n        locker = withMVar lock . const\n    f line locker\n\nf :: String -> Locker -> IO ()\nf line locker = locker $ putStrLn line\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This is similar to T11982b but 'locker' inlined which allows the module to\n-- compile.\n\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ApplicativeDo #-}\nmodule Main where\nimport Control.Concurrent.MVar\n\ntype Locker = forall a. IO a -> IO a\n\nmain :: IO ()\nmain = do\n    line <- getLine\n    lock <- newMVar ()\n    f line $ withMVar lock . const\n\nf :: String -> Locker -> IO ()\nf line locker = locker $ putStrLn line\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, GADTs, TypeApplications, TypeInType, DataKinds,\n    RankNTypes, ConstraintKinds, TypeFamilies #-}\n\nmodule T12045a where\n\nimport Data.Kind\nimport Data.Typeable\n\ndata T (f :: k -> Type) a = MkT (f a)\n\nnewtype TType f a= MkTType (T @Type f a)\n\nt1 :: TType Maybe Bool\nt1 = MkTType (MkT (Just True))\n\nt2 :: TType Maybe a\nt2 = MkTType (MkT Nothing)\n\ndata Nat = O | S Nat\n\ndata T1 :: forall k1 k2. k1 -> k2 -> Type where\n  MkT1 :: T1 a b\n\nx :: T1 @_ @Nat False n\nx = MkT1\n\n-- test from trac 12045\ntype Cat k = k -> k -> Type\n\ndata FreeCat :: Cat k -> Cat k where\n  Nil  :: FreeCat f a a\n  Cons :: f a b -> FreeCat f b c -> FreeCat f a c\n\nliftCat :: f a b -> FreeCat f a b\nliftCat x = Cons x Nil\n\ndata Node = Unit | N\n\ndata NatGraph :: Cat Node where\n  One  :: NatGraph Unit N\n  Succ :: NatGraph N    N\n\none :: (FreeCat @Node NatGraph) Unit N\none = liftCat One\n\ntype Typeable1 = Typeable @(Type -> Type)\ntype Typeable2 = Typeable @(Type -> Type -> Type)\ntype Typeable3 = Typeable @(Cat Bool)\n\ntype family F a where\n  F Type = Type -> Type\n  F (Type -> Type) = Type\n  F other = other\n\ndata T2 :: F k -> Type\n\nfoo :: T2 @Type Maybe -> T2 @(Type -> Type) Int -> Type\nfoo a b = undefined\n\ndata family D (a :: k)\ndata instance D @Type a = DBool\ndata instance D @(Type -> Type) b = DChar\n\nclass C a where\n  tc :: (D a) -> Int\n\ninstance C Int where\n  tc DBool = 5\n\ninstance C Bool where\n  tc DBool = 6\n\ninstance C Maybe where\n  tc DChar = 7\n\n-- Tests from D5229\ndata P a = MkP\ntype MkPTrue = MkP @Bool\n\ntype BoolEmpty = '[] @Bool\n\ntype family F1 (a :: k) :: Type\ntype G2 (a :: Bool) = F1 @Bool a\n", "num_lines": 84}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\nmodule T12064 where\nimport T12064a\ndata D = forall n. K n => DCon n\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12064a where\nimport {-# SOURCE #-} T12064\nclass K a where\n  kfun :: D -> a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wunused-imports #-}\nmodule T12067 where\n\nimport Data.Functor.Identity\nimport Data.Coerce\nimport T12067a\n\nfoo :: M [a] -> MT [] a\nfoo = coerce\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12067a (MT(..), M) where\n\nimport Data.Functor.Identity\n\nnewtype MT m b = MT (m b)\ntype M b = MT Identity b\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule T12069 where\n\nfoo (_ :: p a) = [] :: [a]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T12082 where\n\nimport Data.Typeable (Typeable)\nimport Control.Monad.ST (RealWorld)\n\nf :: forall a. (forall b. Typeable b => b -> a) -> a\nf = undefined :: (RealWorld -> a) -> a\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, DataKinds, UndecidableInstances #-}\n\nmodule T12104 where\n\nimport GHC.TypeLits\n\ntype family F a where\n  F a = TypeError (Text \"error\")\n\nerr :: F ()\nerr = ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ImplicitParams #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T12133 where\n\nimport           GHC.Classes (IP(..))\nimport           Data.Kind (Constraint, Type)\n\n-- | From \"Data.Constraint\":\ndata Dict :: Constraint -> Type where Dict :: a => Dict a\n\nnewtype a :- b = Sub (a => Dict b)\n\ninfixl 1 \\\\ -- required comment\n\n(\\\\) :: a => (b => r) -> (a :- b) -> r\nr \\\\ Sub Dict = r\n\n-- | GHC 7.10.2 type checks this function but GHC 8.0.1 does not unless\n-- you modify this example in one of the following ways:\n--\n--   * uncomments the type signature for 'Sub'\n--\n--   * flatten the nested pairs of constraints into a triple of constraints\n--\n--   * replace 'IP sym ty' with 'c9', where 'c9' is a new constraint variable.\n--\n-- The error message is listed below.\nfoo :: forall c1 c2 c3 sym ty\n    .  (c1, c2) :- c3\n    -> (c1, (IP sym ty, c2)) :- (IP sym ty, c3)\nfoo sp = ( Sub\n--           :: ((c1, (IP sym ty, c2)) => Dict (IP sym ty, c3))\n--              -> (c1, ((IP sym ty), c2)) :- (IP sym ty, c3)\n         )\n         ( (Dict \\\\ sp) :: Dict (IP sym ty, c3) )\n\n{- Compiler error message:\n\nGHCi, version 8.0.1: http://www.haskell.org/ghc/  :? for help\n[1 of 1] Compiling T                ( t.hs, interpreted )\n\nt.hs:44:13: error:\n    \u00e2\u20ac\u00a2 Could not deduce: IP sym ty arising from a use of \u00e2\u20ac\u02dcDict\u00e2\u20ac\u2122\n      from the context: (c1, (IP sym ty, c2))\n        bound by a type expected by the context:\n                   (c1, (IP sym ty, c2)) => Dict (IP sym ty, c3)\n        at t.hs:(40,10)-(44,49)\n      or from: c3\n        bound by a type expected by the context:\n                   c3 => Dict (IP sym ty, c3)\n        at t.hs:44:13-22\n    \u00e2\u20ac\u00a2 In the first argument of \u00e2\u20ac\u02dc(\\\\)\u00e2\u20ac\u2122, namely \u00e2\u20ac\u02dcDict\u00e2\u20ac\u2122\n      In the first argument of \u00e2\u20ac\u02dcSub\u00e2\u20ac\u2122, namely\n        \u00e2\u20ac\u02dc((Dict \\\\ sp) :: Dict (IP sym ty, c3))\u00e2\u20ac\u2122\n      In the expression: (Sub) ((Dict \\\\ sp) :: Dict (IP sym ty, c3))\n    \u00e2\u20ac\u00a2 Relevant bindings include\n        foo :: (c1, c2) :- c3 -> (c1, (IP sym ty, c2)) :- (IP sym ty, c3)\n          (bound at t.hs:40:1)\nFailed, modules loaded: none.\n-}\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-}\n\nmain :: IO ()\nmain = smth\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}\n\nmodule T12185 where\n\nclass Foo a\n\nnewtype Bar r = Pow r deriving (Eq)\n\ninstance (Foo r) => Foo (Bar r)\n\ntype family Ctx a where Ctx t = (Foo (Bar t), Eq (Bar t))\n\nrun :: (forall t . (Ctx t) => t -> Int) -> Int\nrun g = undefined\n\nfoo :: (Foo (Bar t)) => t -> Int\nfoo = undefined\n\nmain :: IO ()\nmain = print $ run foo\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-}\nmodule Kinds where\n\nimport GHC.Types\n\ntype family G (a :: Type) :: Type\ntype instance G Int = Bool\n\ntype family F (a :: Type) :: G a\ntype instance F Int = True\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes #-}\n\n-- Test pattern bindings, existentials, and higher rank\n\nmodule T12427a where\n\ndata T where\n  T1 :: a -> ((forall b. [b]->[b]) -> Int) -> T\n  T2 :: ((forall b. [b]->[b]) -> Int) -> T\n\n-- Inference\n-- Worked in 7.10 (probably wrongly)\n-- Failed in 8.0.1\n-- Fails in 8.2 because v is polymorphic\n--     and the T1 pattern match binds existentials,\n--     and hence bumps levels\nh11 y = case y of T1 _ v -> v\n\n-- Worked in 7.10 (probably wrongly)\n-- Failed in 8.0.1\n-- Succeeds in 8.2 because the pattern match has\n--   no existentials, so it doesn't matter than\n--   v is polymorphic\nh12 y = case y of T2 v -> v\n\n-- Inference\n-- Same results as for h11 and h12 resp\nT1 _ x1 = undefined\nT2 x2 = undefined\n\n-- Works in all versions\nh2 :: T -> (forall b. [b] -> [b]) -> Int\nh2 y = case y of T1 _ v -> v\n\n-- Checking\n-- Fails in 7.10  (head exploded)\n-- Fails in 8.0.1 (ditto)\n-- Succeeds in 8.2\nx3 :: (forall a. a->a) -> Int\nT1 _ x3 = undefined\n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, RankNTypes #-}\n\nmodule T12427b where\n\nnewtype Acquire a = Acquire {unAcquire :: (forall b. b -> b) -> IO a}\n\ninstance Functor Acquire where\n    fmap = undefined\n\ninstance Applicative Acquire where\n    pure = undefined\n    (<*>) = undefined\n\ninstance Monad Acquire where\n    Acquire f >>= g' = Acquire $ \\restore -> do\n        x <- f restore\n        let Acquire g = g' x\n        -- let g = unAcquire (g' x)\n        g restore\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T12466 where\n\nclass Foo a where\n  foo :: (a ~ Int => Int) -> a -> a\n  foo _ a2 = a2\n\ninstance Foo Char\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T12466a where\n\nimport GHC.TypeLits (Nat)\nimport Unsafe.Coerce (unsafeCoerce)\n\ndata Dict a where\n  Dict :: a => Dict a\n\nnewtype a :- b = Sub (a => Dict b)\n\naxiom :: forall a b. Dict (a ~ b)\naxiom = unsafeCoerce (Dict :: Dict (a ~ a))\n\ntype Divides n m = n ~ Gcd n m\ntype family Gcd :: Nat -> Nat -> Nat where\n\ndividesGcd :: forall a b c. (Divides a b, Divides a c) :- Divides a (Gcd b c)\ndividesGcd = Sub axiom\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ConstraintKinds, Rank2Types, ImplicitParams #-}\n\nmodule T12507 where\n\ndata Rec fields where\n  Rec :: fields => Rec fields\n\nqn :: Rec fields -> (fields => r) -> r\nqn Rec e = e\n\nrecord :: Rec (?a :: Int, ?b :: String)\nrecord = Rec where ?a=42\n                   ?b=\"hey\"\n\naccess :: Int\naccess = qn record ?a\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes #-}\n\nmodule T12644 where\n\ndata T a = T1 Int\n\ninstance Show (T a) where\n  show (T1 x) = show x\n\nt1 :: T a\nt1 = T1 1\n\nf :: String\nf = show t1\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\n{-# LANGUAGE UndecidableInstances      #-}\n{-# LANGUAGE GADTs                     #-}\n{-# LANGUAGE PolyKinds                 #-}\n{-# LANGUAGE TypeApplications          #-}\n\n---------------  The original bug report --------------\n--\n-- See T12734a for a smaller version\n\nmodule T12734 where\n\nimport Prelude\nimport Data.Kind\nimport Control.Applicative\nimport Control.Monad.Fix\nimport Control.Monad.Trans.Identity\nimport Control.Monad.Trans.Class\nimport Control.Monad.IO.Class\n\n\ndata A\ndata B\ndata Net\ndata Ty\n\ndata Layer4 t l\ndata TermStore\n\n-- Helpers: Stack\n\ndata Stack layers (t :: Type -> Type) where\n    SLayer :: t l -> Stack ls t -> Stack (l ': ls) t\n    SNull  :: Stack '[] t\n\ninstance ( Constructor m (t l)\n         , Constructor m (Stack ls t)) => Constructor m (Stack (l ': ls) t)\ninstance Monad m                       => Constructor m (Stack '[]       t)\n\n\n-- Helpers: Expr\n\nnewtype Expr  t layers    = Expr (TermStack t layers)\ntype TermStack t layers = Stack layers (Layer4 (Expr t layers))\n\n\n-- Helpers: Funny typeclass\n\nclass Monad m => Constructor m t\n\ninstance ( Monad m, expr ~ Expr t layers, Constructor m (TermStack t layers)\n         ) => Constructor m (Layer4 expr Ty)\n\n\n-- HERE IS A FUNNY BEHAVIOR: the commented line raises context reduction stack\n-- overflow\ntest_gr ::\n    ( Constructor m (TermStack t layers), Inferable A layers m, Inferable B t m\n      , bind ~ Expr t layers\n--  ) => m (Expr t layers)\n    ) => m bind\ntest_gr = undefined\n\n\n-- Explicit information about a type which could be inferred\n\nclass Monad m => Inferable (cls :: Type) (t :: k) m | cls m -> t\n\nnewtype KnownTyx (cls :: Type) (t :: k) (m :: Type -> Type) (a :: Type) =\n    KnownTyx (IdentityT m a)\n  deriving (Show, Functor, Monad, MonadIO, MonadFix, MonadTrans,\n            Applicative, Alternative)\n\ninstance {-# OVERLAPPABLE #-} (t ~ t', Monad m) =>\n  Inferable cls t (KnownTyx cls t' m)\ninstance {-# OVERLAPPABLE #-} (Inferable cls t n, MonadTrans m, Monad (m n)) =>\n  Inferable cls t (m n)\n\n\nrunInferenceTx :: forall cls t m a. KnownTyx cls t m a -> m a\nrunInferenceTx = undefined\n\n\n\n-- running it\n\ntest_ghc_err :: (MonadIO m, MonadFix m)\n        => m (Expr Net '[Ty])\ntest_ghc_err = runInferenceTx @B  @Net\n             $ runInferenceTx @A @'[Ty]\n             $ (test_gr)\n", "num_lines": 101}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE DeriveFunctor #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\n{-# LANGUAGE UndecidableInstances      #-}\n{-# LANGUAGE GADTs                     #-}\n{-# LANGUAGE PolyKinds                 #-}\n{-# LANGUAGE TypeApplications          #-}\n\n\n-- This version is shorter than T12734, and should yield a\n-- type error message.  If things go wrong, you get\n-- an infinite loop\n\nmodule T12734a where\n\nimport Prelude\nimport Data.Kind\nimport Control.Applicative\nimport Control.Monad.Fix\nimport Control.Monad.Trans.Identity\nimport Control.Monad.Trans.Class\nimport Control.Monad.IO.Class\n\n\ndata A\ndata B\ndata Net\ndata Ty\n\ndata Layer4 t l\ndata TermStore\n\ndata Stack lrs (t :: Type -> Type) where\n    SLayer :: t l -> Stack ls t -> Stack (l ': ls) t\n    SNull  :: Stack '[] t\n\ninstance ( Con m (t l)\n         , Con m (Stack ls t)) => Con m (Stack (l ': ls) t)\ninstance Monad m               => Con m (Stack '[]       t)\ninstance ( expr ~ Expr t lrs\n         , Con m (TStk t lrs)) => Con m (Layer4 expr Ty)\n\n\nnewtype Expr  t lrs    = Expr (TStk t lrs)\ntype TStk t lrs = Stack lrs (Layer4 (Expr t lrs))\n\n\nclass Con m t\n\n\n-- HERE IS A FUNNY BEHAVIOR: the commented line raises context reduction stack overflow\ntest_gr :: forall m t lrs bind.\n           ( Con m (TStk t lrs)\n            , bind ~ Expr t lrs\n--        ) => m (Expr t lrs)       -- GHC 8 worked if you said this...\n          ) => m bind               -- but not this!\ntest_gr = undefined\n\n\nnewtype KT (cls :: Type) (t :: k) (m :: Type -> Type) (a :: Type)\n   = KT (IdentityT m a)\n\ntest_ghc_err :: KT A '[Ty] IO (Expr Net '[Ty])\n\ntest_ghc_err = test_gr @(KT A '[Ty] IO) @_ @'[Ty] @(Expr Net '[Ty])\n\n{-  Works!\ntest_ghc_err = test_gr @(KT A '[Ty] IO)\n                       @Net\n                       @'[Ty]\n                       @(Expr Net '[Ty])\n-}\n\n{-  Some notes.  See comment:10 on Trac #12734\n\n[W] Con m (TStk t lrs)\n[W] Inferable A lrs m\n[W] bind ~ Expr t lrs\n[W] m bind ~ KT A '[Ty] IO (Expr Net '[Ty])\n\n==> m := KT A '[Ty] IO\n    bind := Expr Net '[Ty]\n    t := Net\n    lrs := '[Ty]\n\n[W] Con m (TStk t lrs)\n  = Con m (Stack lrs (Layer4 bind))\n--> inline lrs\n[W] Con m (Stack '[Ty] (Layer4 bind))\n--> instance\n[W] Con m (Stack '[] bind)\n    --> Monad m\n+\n[W] Con m (Layer4 bind Ty)\n-->\n[W] bind ~ Expr t0 lrs0\n[W] Con m (TStk t0 lrs0)\n-}\n", "num_lines": 106}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies #-}\n{-# OPTIONS_GHC -ddump-types #-}\n\nmodule T12763 where\n\nclass C a | -> a where\n   m :: a -> ()\n\ninstance C Int where\n  m = undefined\n\n-- Expecting inferred type f :: Int -> ()\nf x = m x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T12785a where\n\nimport Data.Kind (Type)\n\nfoo :: forall (dk :: Type) (c :: Type -> Type) (t :: dk -> Type) (a :: Type).\n       (dk ~ Type)\n    => (forall (d :: dk). c (t d)) -> Maybe (c a)\nfoo _ = Nothing\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonomorphismRestriction #-}\n{-# LANGUAGE TypeFamilies              #-}\n{-# LANGUAGE DataKinds              #-}\n{-# LANGUAGE ExtendedDefaultRules      #-}\n\nmodule T12797 where\n\nimport Prelude\nimport Control.Monad.IO.Class\nimport Data.Kind (Type)\n\ntype family FuncArg (m :: (Type -> Type)) :: Maybe Type\n\ntest2 :: (MonadIO m, FuncArg m ~ 'Nothing) => m ()\ntest2 = liftIO $ print 6\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll, MagicHash, KindSignatures #-}\nmodule T12850 where\n\nimport GHC.Types (RuntimeRep(..), TYPE)\n\nf :: forall (x :: TYPE 'IntRep). x -> x\nf x = x\n\ng = ()\n    where h = f 0#\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll, PolyKinds, GADTSyntax,\n             ExistentialQuantification #-}\n\nmodule T12911 where\n\nimport GHC.Exts\n\ndata X where\n  MkX :: forall r (a :: TYPE r). (a -> a) -> X\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, ConstraintKinds #-}\n\nmodule T12919 where\n\nimport Data.Kind\n\ndata N = Z\n\ndata V :: N -> Type where\n  VZ :: V Z\n\ntype family VC (n :: N) :: Type where\n  VC Z = Type\n\ntype family VF (xs :: V n) (f :: VC n) :: Type where\n  VF VZ f = f\n\ndata Dict c where\n  Dict :: c => Dict c\n\nprop :: xs ~ VZ => Dict (VF xs f ~ f)\nprop = Dict\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExtendedDefaultRules #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE DataKinds #-}\n\nmodule T12923 where\n\n-- Test that ExtendedDefaultRules defaults multiparameter typeclasses with only\n-- one parameter of kind Type.\nclass Works a (b :: Bool) where\n   works :: a -> A b\n\ndata A (b :: Bool) = A deriving Show\n\ninstance Works Integer 'True where works _ = A\n\nmain :: IO ()\nmain = print (works 5 :: A 'True)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExtendedDefaultRules #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n\nmodule T12924 where\n\nimport GHC.TypeLits\n\ndata A (b :: [Symbol]) = A deriving Show\n\n-- Test that ExtendedDefaultRules defaults multiparameter typeclasses with only\n-- one parameter of kind Type.\nclass Works a (b :: [Symbol]) where\n   works :: a -> A b\n\ninstance Works Integer a where\n   works _ = A\n\nmain :: IO ()\nmain = print (addA (works 5) (works 10)) -- :: A '[])\n\n-- | Note argument types aren't concrete\naddA :: A a -> A a -> A '[]\naddA A A = A\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug where\n\ndata Foo a x = Foo x\n\nrefoo :: Foo a x -> Foo b x\n{-# NOINLINE refoo #-}\nrefoo (Foo x) = Foo x\n\n{-# RULES\n\n\"refoo/refoo\" forall s.\n  refoo (refoo s) = s  #-}\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExtendedDefaultRules #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n\nmodule T12926 where\n\nimport GHC.TypeLits\n\ndata A (b :: [Symbol]) = A deriving Show\n\nclass Works a (b :: [Symbol]) where\n   works :: a -> A b\n\ninstance Works Integer a where\n   works _ = A\n\naddA :: A a -> A a -> A a\naddA A A = A\n\ntest2 :: A x -- Note this is able to have a polymorphic type\ntest2 = addA (works 5) (works 5)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MonomorphismRestriction #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule Token where\n\nclass S s t | s -> t\n\nm :: forall s t . S s t => s\nm = undefined\n\no :: forall s t . S s t => s -> s\no = undefined\n\nc :: forall s . s -> s -> s\nc = undefined\n\np :: forall s . S s () => s -> s\np d = f\n  where\n\n    -- declaring either of these type signatures will cause the bug to go away\n\n    -- f :: s\n    f = c d (o e)\n\n    -- e :: s\n    e = c m m\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T12987 where\n\nimport GHC.Exts\n\nclass NUM (a :: TYPE rep) where add :: a -> a -> a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -ddump-ds -dsuppress-uniques #-}\n{-# LANGUAGE GADTs #-}\n\nmodule T13032 where\n\nf :: (a ~ b) => a -> b -> Bool\nf x y = True\n\n-- The point of the test is to check that we don't\n-- get a redundant superclass selection to fetch an\n-- equality constraint out of the (a~b) dictionary\n-- Hence -ddump-ds\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HolesInfix where\n\nf, g, q :: Int -> Int -> Int\nf x y = _ x y\ng x y = x `_` y\nq x y = x `_a` y\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n\n{-# OPTIONS_GHC -Wall #-}\n\n-- | Bug(?) in Coercible constraint solving\n\nmodule T13083 where\n\nimport Data.Kind\nimport GHC.Generics (Par1(..),(:*:)(..))\nimport GHC.Exts (coerce)\n\n-- Representation as free vector space\ntype family V (a :: Type) :: Type -> Type\n\ntype instance V R = Par1\ntype instance V (a,b) = V a :*: V b\n\ntype instance V (Par1 a) = V a\n\ndata R = R\n\n-- Linear map in row-major order\nnewtype L a b = L (V b (V a R))\n\n-- Use coerce to drop newtype wrapper\nbar :: L a b -> V b (V a R)\nbar = coerce\n\n{-\n[W] L a b ~R V b (V a R)\n-->\n    V b (V a R)  ~R  V b (V a R)\n-}\n\n{--------------------------------------------------------------------\n    Bug demo\n--------------------------------------------------------------------}\n\n-- A rejected type specialization of bar with a ~ (R,R), b ~ (Par1 R,R)\nfoo :: L (R,R) (Par1 R,R) -> V (Par1 R,R) (V (R,R) R)\n-- foo :: L (a1,R) (Par1 b1,b2) -> V (Par1 b1,b2) (V (a1,R) R)\nfoo = coerce\n\n{-\n[W] L (a1,R) (Par1 b1, b2)   ~R   V (Par1 b1,b2) (V (a1,R) R)\n-->\n    V (Par1 b1, b2) (V (a1,R) R)  ~R    same\n\n    -> (V (Par1 b1) :*: V b2) ((V a1 :*: V R) R)\n    -> (:*:) (V b1) (V b2) (:*: (V a1) Par1 R)\n\n-->\n    L (a1,R) (Par1 b1, b2)   ~R   (:*:) (V b1) (V b2) (:*: (V a1) Par1 R)\n-}\n\n--     \u00e2\u20ac\u00a2 Couldn't match representation of type \u00e2\u20ac\u02dcV Par1\u00e2\u20ac\u2122\n--                                with that of \u00e2\u20ac\u02dcPar1\u00e2\u20ac\u2122\n--         arising from a use of \u00e2\u20ac\u02dccoerce\u00e2\u20ac\u2122\n\n-- Note that Par1 has the wrong kind (Type -> Type) for V Par1\n\n-- Same error:\n--\n-- foo :: (a ~ (R,R), b ~ (Par1 R,R)) => L a b -> V b (V a R)\n\n-- The following similar signatures work:\n\n-- foo :: L (R,R) (R,Par1 R) -> V (R,Par1 R) (V (R,R) R)\n-- foo :: L (Par1 R,R) (R,R) -> V (R,R) (V (Par1 R,R) R)\n\n-- Same error:\n\n-- -- Linear map in column-major order\n-- newtype L a b = L (V a (V b s))\n\n-- foo :: L (R,R) (Par1 R,R) -> V (R,R) (V (Par1 R,R) R)\n-- foo = coerce\n\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeFamilyDependencies, UndecidableInstances #-}\n\ntype family Foo a = r | r -> a where\n        Foo Int = Char\n        Foo Integer = String\n\ntype family Bar a = r | r -> a where\n        Bar Char = Double\n        Bar String = Float\n\ntype family Baz a = r | r -> a where\n        Baz x = Bar (Foo x)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T13333 where\n\nimport Data.Data\nimport GHC.Exts (Constraint)\n\ndata T (phantom :: k) = T\n\ndata D (p :: k -> Constraint) (x :: j) where\n  D :: forall k (p :: k -> Constraint) (x :: k). p x => D p x\n\nclass Possibly p x where\n  possibly :: proxy1 p -> proxy2 x -> Maybe (D p x)\n\ndataCast1T :: forall k c t (phantom :: k).\n              (Typeable k, Typeable t, Typeable phantom, Possibly Data phantom)\n           => (forall d. Data d => c (t d))\n           -> Maybe (c (T phantom))\ndataCast1T f = case possibly (Proxy :: Proxy Data) (Proxy :: Proxy phantom) of\n                 Nothing -> Nothing\n                 Just D  -> gcast1 f\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, ScopedTypeVariables, TypeOperators, GADTs #-}\n{-# OPTIONS_GHC -Wno-overlapping-patterns #-}  -- don't want erroneous warning in test output\n                                               -- if removing this doesn't change output, then\n                                               -- remove it!\n\nmodule T13337 where\n\nimport Data.Typeable\nimport Data.Kind\n\nf :: forall k (a :: k). (Typeable k, Typeable a) => Proxy a -> Proxy Int\nf p = case eqT :: Maybe (k :~: Type) of\n  Nothing -> Proxy\n  Just Refl -> case eqT :: Maybe (a :~: Int) of\n    Nothing -> Proxy\n    Just Refl -> p\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE PolyKinds #-}\nmodule Bug where\n\nimport GHC.Exts\n\ntype Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v\n\n-- should be accepted because GHC will generalize over v. Note v /= v1.\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O #-}   -- To switch on the RULE\n{-# LANGUAGE RankNTypes #-}\n\nmodule T13381 where\n\ndata Exp a = Exp\n\nfromExp :: Exp a -> a\nfromExp _ = error \"Impossible\"\n\nnewtype Iter a b = Iter { getIter :: forall r. (a -> r) -> (b -> r) -> r }\n\niterLoop :: (a -> Iter a b) -> a -> b\niterLoop f x = error \"urk\"\n\n\n  -- This rewrite rule results in a GHC panic: \"opt_univ fell into a hole\" on GHC 8.0.1, 8.0.2, and 8.1.\n{-# RULES \"fromExp-into-iterLoop\" [~]\n    forall (f :: Int -> Iter (Exp Int) (Exp Char))\n           (init :: Int).\n    fromExp (iterLoop f init) = error \"urk\"\n  #-}\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, PolyKinds, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -O #-}\nmodule T13458 where\nimport GHC.Exts\nimport Data.Kind\nimport Unsafe.Coerce\n\nunsafeCoerce' :: forall (r :: RuntimeRep)\n                       (a :: TYPE r) (b :: TYPE r).\n                a -> b\nunsafeCoerce' = unsafeCoerce id\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13474 where\n\nimport qualified Data.Map as M\n\nclass Default a where\n  def :: a\n\nfoo :: Default a => b -> a\nfoo x = def\n\nmapdef :: Default v => M.Map k v -> M.Map k v\nmapdef = M.map foo\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, TypeFamilies #-}\n\nmodule T13490 where\n\nimport Data.Typeable\n\ntype family Foo a\n\ndata C a\n\nfoo :: (Typeable (C z), z ~ Foo zp) => C zp\nfoo = undefined\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples, MagicHash #-}\nmodule T13509 where\n\nimport GHC.Exts\nimport Data.Word\n\nselectPower :: Word# -> (# Word#, Word# #)\nselectPower base = go base\n  where\n--    go :: Word# -> (# Word#, Word# #)\n    go pw = case timesWord2# pw pw of\n        (# 0##, pw2 #)\n          -> let (# n, pw2n #) = go pw2 in\n            case timesWord2# pw pw2n of\n              (# 0##, pw2n1 #) -> (#n `timesWord#` 2## `plusWord#` 1##, pw2n1 #)\n              _ -> (# n `timesWord#` 2##, pw2n #)\n        _           -> (# 1##, pw #)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PartialTypeSignatures #-}\n{-# LANGUAGE ScopedTypeVariables   #-}\n{-# LANGUAGE TypeApplications      #-}\n\n{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}\n\ntype Empty a = ()\n\nfoo :: expr a -> expr a -> expr (Empty a)\nfoo = undefined\n\nnewtype Expr a = SPT {run :: String}\n\npt1 :: forall a ptexpr . ptexpr a -> ptexpr (Empty a)\npt1 a = foo a a\n\npt2 :: forall a ptexpr . ptexpr a -> ptexpr _\npt2 a = foo a a\n\nmain :: IO ()\nmain = do\n    -- This typechecks without any trouble.\n    putStrLn $ run $ pt1 @Int @Expr undefined\n\n    -- This should also typecheck, but doesn't since GHC seems to mix up the\n    -- order of the type variables.\n    putStrLn $ run $ pt2 @Int @Expr undefined\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule T13526 where\n\nclass C a where\n  op :: a -> a\n\ninstance {-# OVERLAPPING #-} C [Char] where\n  op x = x\n\ninstance C a => C [a] where\n  op (x:xs) = [op x]\n\ninstance C a => C (Maybe a) where\n  op x = error \"urk\"\n\n-- We should get no complaint\nfoo :: C [a] => a -> [a]\nfoo x = op [x]\n\nbar :: C (Maybe a) => a -> Maybe a\nbar x = op (Just x)\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13585 where\nimport T13585b (extractZonedTime)\n\nmain :: IO ()\nmain = print extractZonedTime\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, RankNTypes, TypeFamilies, MultiParamTypeClasses, FlexibleInstances,UndecidableInstances #-}\n\nmodule T13585a where\n\nimport Data.Monoid (First(..))\nimport Data.Functor.Identity\nimport Data.Kind (Type)\n\nclass Profunctor p where\n  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d\n  dimap f g = lmap f . rmap g\n  {-# INLINE dimap #-}\n\n  lmap :: (a -> b) -> p b c -> p a c\n  lmap f = dimap f id\n  {-# INLINE lmap #-}\n\n  rmap :: (b -> c) -> p a b -> p a c\n  rmap = dimap id\n  {-# INLINE rmap #-}\n\n\ndata Exchange a b s t = Exchange (s -> a) (b -> t)\n\ninstance Functor (Exchange a b s) where\n  fmap f (Exchange sa bt) = Exchange sa (f . bt)\n  {-# INLINE fmap #-}\n\ninstance Profunctor (Exchange a b) where\n  dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt)\n  {-# INLINE dimap #-}\n  lmap f (Exchange sa bt) = Exchange (sa . f) bt\n  {-# INLINE lmap #-}\n  rmap f (Exchange sa bt) = Exchange sa (f . bt)\n  {-# INLINE rmap #-}\n\n\n\nwithIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r\nwithIso ai k = case ai (Exchange id Identity) of\n  Exchange sa bt -> k sa (runIdentity undefined bt)\n{-# INLINE withIso #-}\n\ntype Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)\ntype Iso' s a = Iso s s a a\ntype AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t)\n\nclass    (Rewrapped s t, Rewrapped t s) => Rewrapping s t\ninstance (Rewrapped s t, Rewrapped t s) => Rewrapping s t\n\n\ninstance (t ~ First b) => Rewrapped (First a) t\ninstance Wrapped (First a) where\n    type Unwrapped (First a) = Maybe a\n    _Wrapped' = iso getFirst First\n    {-# INLINE _Wrapped' #-}\n\nclass Wrapped s => Rewrapped (s :: Type) (t :: Type)\n\nclass Wrapped s where\n    type Unwrapped s :: Type\n    _Wrapped' :: Iso' s (Unwrapped s)\n\n_Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t)\n_Wrapping _ = _Wrapped\n{-# INLINE _Wrapping #-}\n\niso :: (s -> a) -> (b -> t) -> Iso s t a b\niso sa bt = dimap sa (fmap bt)\n{-# INLINE iso #-}\n\n_Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)\n_Wrapped = withIso _Wrapped' $ \\ sa _ -> withIso _Wrapped' $ \\ _ bt -> iso sa bt\n{-# INLINE _Wrapped #-}\n\nau :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a\nau k = withIso k $ \\ sa bt f -> fmap sa (f bt)\n{-# INLINE au #-}\n\nala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)\nala = au . _Wrapping\n{-# INLINE ala #-}\n", "num_lines": 83}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13585b where\n\nimport T13585a\nimport Data.Monoid\n\nextractZonedTime :: Maybe ()\nextractZonedTime = ala First foldMap [Nothing]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n\nmodule Bug where\n\nx :: forall a b. (a ~ Integer, b ~ Integer) => (a, b)\n!x = (1, 2)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds, UndecidableInstances #-}\nmodule T13603 where\n\nimport GHC.Exts (TYPE, RuntimeRep)\n\nclass        A (a :: TYPE rep)\nclass A a => B (a :: TYPE rep)\n\ninstance A b => A (a -> (b :: TYPE rep))\ninstance B b => B (a -> (b :: TYPE rep))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TypeFamilyDependencies #-}\n{-# Language RankNTypes             #-}\n{-# Language KindSignatures         #-}\n{-# Language DataKinds              #-}\n{-# Language PolyKinds              #-}\n{-# Language GADTs                  #-}\n\nimport Data.Kind (Type)\n\ndata Code = I\n\ntype family\n  Interp (a :: Code) = (res :: Type) | res -> a where\n  Interp I = Bool\n\ndata T :: forall a. Interp a -> Type where\n  MkNat :: T False\n\ninstance Show (T a) where show _ = \"MkNat\"\n\nmain = do\n  print MkNat\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}\nmodule T13651 where\n\ntype family F r s = f | f -> r s\n\ntype instance F (Bar h (Foo r)) (Bar h (Foo s)) = Bar h (Bar r s)\n\ndata Bar s b\ndata Foo a\n\nfoo :: (F cr cu ~ Bar h (Bar r u),\n        F cu cs ~ Bar (Foo h) (Bar u s))\n    => Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs)\nfoo = undefined\n\n{-  Typechecking this program used to /just/ succeed in GHC 8.2,\n    (see Trac #14745 for why), but doesn't in 8.4.\n\n[G]  F cr cu ~ Bar h (Bar r u),\n     F cu cs ~ Bar (Foo h) (Bar u s))\n\n\n[W] F cr cu0 ~ Bar h (Bar r u)\n    --> (top-level fundeps)  cr ~ Bar h (Foo r)\n                             cu0 ~ Bar h (Foo u)\n        (local fundeps)      cu ~ cu0\n\n[W] F cu0 cs ~ Bar (Foo h) (Bar u s)\n    -->  (top-level fundeps)  cu0 ~ Bar (Foo h) (Foo u)\n                              cs  ~ Bar (Foo h) (Foo s)\n         (local fundeps)      cu0 ~ cu\n\n[W] F cr (Bar (Foo h) (Fo u)) ~ Bar h (Bar r u)\n\n-}\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}\nmodule T13651 where\n\ntype family F r s = f | f -> r s\n\ntype instance F (Bar h (Foo r)) (Bar h (Foo s)) = Bar h (Bar r s)\n\ndata Bar s b\ndata Foo a\n\nfoo :: (F cr cu ~ Bar h (Bar r u),\n        F cu cs ~ Bar (Foo h) (Bar u s))\n    => Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> cu -> Foo (cr -> cs)\n    -- A variant of T13651 which fixes 'cu'\n    -- as well as the other type args\nfoo = undefined\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\nmodule T13680 where\n\nfoo :: [Int]\nfoo = [] @Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# OPTIONS_GHC -Wmonomorphism-restriction #-}\nmodule Bug where\n\nclass Monad m => C m where\n  c :: (m Char, m Char)\n\nfoo :: forall m. C m => m Char\nfoo = bar >> baz >> bar2\n  where\n    -- Should not get MR warning\n    bar, baz :: m Char\n    (bar, baz) = c\n\n    -- Should get MR warning\n    (bar2, baz2) = c\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, MonoLocalBinds #-}\n\nmodule T13804 where\n\nf periph = let sr :: forall a. [a] -> [a]\n               sr = if periph then reverse else id\n\n               sr2 = sr\n               -- The question: is sr2 generalised?\n               -- It should be, because sr has a type sig\n               -- even though it has periph free\n           in\n           (sr2 [True], sr2 \"c\")\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeOperators, PolyKinds, DataKinds,\n             TypeFamilyDependencies, RankNTypes, LambdaCase, EmptyCase #-}\n\nmodule T13822 where\n\nimport Data.Kind\n\ndata KIND = STAR | KIND :> KIND\n\ndata Ty :: KIND -> Type where\n  TInt   :: Ty STAR\n  TBool  :: Ty STAR\n  TMaybe :: Ty (STAR :> STAR)\n  TApp   :: Ty (a :> b) -> (Ty a -> Ty b)\n\ntype family\n  IK (k :: KIND) = (res :: Type) | res -> k where\n  IK STAR   = Type\n  IK (a:>b) = IK a -> IK b\n\ntype family\n  I (t :: Ty k) = (res :: IK k) | res -> t where\n  I TInt       = Int\n  I TBool      = Bool\n  I TMaybe     = Maybe\n  I (TApp f a) = (I f) (I a)\n\ndata TyRep (k :: KIND) (t :: Ty k) where\n  TyInt   :: TyRep STAR         TInt\n  TyBool  :: TyRep STAR         TBool\n  TyMaybe :: TyRep (STAR:>STAR) TMaybe\n  TyApp   :: TyRep (a:>b) f -> TyRep a x -> TyRep b (TApp f x)\n\nzero :: TyRep STAR a -> I a\nzero = \\case\n  TyInt           -> 0\n  TyBool          -> False\n  TyApp TyMaybe _ -> Nothing\n\n\n-- Inferred type:\n--\n-- int :: TyRep STAR TInt -> Int\nint rep = zero rep :: Int\n\n-- bool:: TyRep STAR TBool -> Bool\nbool rep = zero rep :: Bool\n\n-- Previously failed with:\n--\n-- v.hs:43:16: error:\n--     \u00e2\u20ac\u00a2 Couldn't match kind \u00e2\u20ac\u02dck\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dc'STAR\u00e2\u20ac\u2122\n--       \u00e2\u20ac\u02dck\u00e2\u20ac\u2122 is a rigid type variable bound by\n--         the inferred type of\n--         maybeInt :: (I 'TInt ~ Int, I 'TMaybe ~ Maybe) =>\n--                     TyRep 'STAR ('TApp 'TMaybe 'TInt) -> Maybe Int\n--         at v.hs:25:3\n--       When matching the kind of \u00e2\u20ac\u02dc'TMaybe\u00e2\u20ac\u2122\n--       Expected type: Maybe Int\n--         Actual type: I ('TApp 'TMaybe 'TInt)\n--     \u00e2\u20ac\u00a2 In the expression: zero rep :: Maybe Int\n--       In an equation for \u00e2\u20ac\u02dcmaybeInt\u00e2\u20ac\u2122: maybeInt rep = zero rep :: Maybe Int\n--     \u00e2\u20ac\u00a2 Relevant bindings include\n--         rep :: TyRep 'STAR ('TApp 'TMaybe 'TInt) (bound at v.hs:43:10)\n--         maybeInt :: TyRep 'STAR ('TApp 'TMaybe 'TInt) -> Maybe Int\n--           (bound at v.hs:43:1)\n-- Failed, modules loaded: none.\nmaybeInt rep = zero rep :: Maybe Int\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, KindSignatures #-}\n\nimport GHC.TypeLits (Nat, Symbol)\n\nclass A (n::Nat)\ninstance A 0\n\nclass B (s::Symbol)\ninstance B \"B\"\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\nmodule T13848 where\n\ndata N = Z | S N\n\ndata Vec1 (n :: N) a where\n  VNil1  :: forall a. Vec1 Z a\n  VCons1 :: forall n a. a -> Vec1 n a -> Vec1 (S n) a\n\ndata Vec2 (n :: N) a where\n  VNil2  :: Vec2 Z a\n  VCons2 :: a -> Vec2 n a -> Vec2 (S n) a\n\ndata Vec3 (n :: N) a\n  = (n ~ Z) => VNil3\n  | forall (n' :: N). (n ~ S n') => VCons3 a (Vec3 n' a)\n\nvcons1 :: Vec1 (S Z) Int\nvcons1 = VCons1 @Z @Int 1 (VNil1 @Int)\n\nvcons2 :: Vec2 (S Z) Int\nvcons2 = VCons2 @Int @Z 1 (VNil2 @Int)\n\nvcons3 :: Vec3 (S Z) Int\nvcons3 = VCons3 @(S Z) @Int @Z 1 (VNil3 @Z @Int)\n\nnewtype Result1 a s = Ok1 s\n\nnewtype Result2 a s where\n  Ok2 :: s -> Result2 a s\n\nresult1 :: Result1 Int Char\nresult1 = Ok1 @Int @Char 'a'\n\nresult2 :: Result2 Int Char\nresult2 = Ok2 @Char @Int 'a'\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Foo where\n\nimport Data.Kind\n\ndata Foo (a :: Type) (b :: Type) where\n  MkFoo :: (a ~ Int, b ~ Char) => Foo a b\n\ndata family Sing (a :: k)\ndata SFoo (z :: Foo a b) where\n  SMkFoo :: SFoo MkFoo\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Bug where\n\nimport Data.Kind\n\ndata family Sing (a :: k)\n\ndata HR (a :: j) (b :: k) where\n  HRefl :: HR a a\n\ndata instance Sing (z :: HR a b) where\n  SHRefl :: Sing HRefl\n\nfoo :: forall (j :: Type) (k :: Type) (a :: j)\n              (b :: k) (r :: HR a b)\n              (p :: forall (z :: Type) (y :: z). HR a y -> Type).\n          Sing r\n       -> App p HRefl\n       -> HRApp p r\nfoo SHRefl pHRefl = pHRefl\n\ntype App f x = f x\ntype HRApp (f :: forall (z :: Type) (y :: z). HR a y -> Type)\n           (x :: HR a b) = f x\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T13881 where\n\ndata family Sing (a :: k)\n\ndata instance Sing (z :: [a]) where\n  SNil  :: Sing '[]\n  SCons :: Sing x -> Sing xs -> Sing (x ': xs)\n\nfl :: forall a (l :: [a]). Sing l -> Sing l\nfl (SNil :: Sing (l :: [y])) = SNil\nfl (SCons x xs)              = SCons x xs\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\nmodule Bug where\n\nimport T13915a_Foo\n\ndata Proxy (a :: k)\ndata S = MkS (Proxy 'MkT)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T13915a_Foo where\n\ndata family T a\ndata instance T Int = MkT\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\nmodule Foo where\n\nimport Data.Typeable (Proxy(..), typeRep)\n\ndata family T a\ndata instance T Int = MkT\n\nmain :: IO ()\nmain = print $ typeRep (Proxy :: Proxy MkT)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses   #-}\n{-# LANGUAGE TypeOperators           #-}\n{-# LANGUAGE FlexibleInstances       #-}\n{-# LANGUAGE FlexibleContexts        #-}\n{-# LANGUAGE ScopedTypeVariables     #-}\n{-# LANGUAGE UndecidableInstances    #-}\n{-# LANGUAGE TypeApplications        #-}\n{-# LANGUAGE PolyKinds, DataKinds    #-}\n{-# LANGUAGE AllowAmbiguousTypes     #-}\n{-# LANGUAGE NoImplicitPrelude       #-}\n{-# LANGUAGE GADTs                   #-}\n\nmodule Data.List.Unrolled where\n\nimport GHC.TypeLits\n\n-- | Drop @n@ elements from a list\nclass Drop (n :: Nat) where\n    drop :: [a] -> [a]\n\ninstance {-# OVERLAPPING #-} Drop 0 where\n    drop xs = xs\n    {-# INLINE drop #-}\n\ninstance {-# OVERLAPPABLE #-} (Drop (n - 1)) => Drop n where\n    drop [] = []\n    drop (_ : xs) = drop @(n - 1) xs\n    {-# INLINE drop #-}\n\n-- | Take @n@ elements from a list\nclass Take (n :: Nat) where\n    take :: [a] -> [a]\n\ninstance {-# OVERLAPPING #-} Take 0 where\n    take _ = []\n    {-# INLINE take #-}\n\ninstance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where\n    take [] = []\n    take (x : xs) = x : take @(n - 1) xs\n    {-# INLINE take #-}\n\n-- | Split list at @n@-th element.\nsplitAt :: forall (n :: Nat) a. (Take n, Drop n) => [a] -> ([a], [a])\nsplitAt xs = (take @n xs, drop @n xs)\n\n-- | Split list into chunks of the given length @c@. @n@ is length of the list.\nclass ChunksOf (n :: Nat) (c :: Nat) where\n    chunksOf :: [a] -> [[a]]\n\ninstance {-# OVERLAPPING #-} ChunksOf 0 0 where\n    chunksOf _ = []\n    {-# INLINE chunksOf #-}\n\ninstance {-# OVERLAPPABLE #-} ChunksOf 0 c where\n    chunksOf _ = []\n    {-# INLINE chunksOf #-}\n\ninstance {-# OVERLAPPABLE #-} ChunksOf n 0 where\n    chunksOf _ = []\n    {-# INLINE chunksOf #-}\n\n\ninstance {-# OVERLAPPABLE #-} (Take c, Drop c, ChunksOf (n - 1) c) => ChunksOf n c where\n    chunksOf xs =\n        let (l, r) = splitAt @c xs\n        in l : chunksOf @(n - 1) @c r\n    {-# INLINE chunksOf #-}\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\nmodule Panic where\n\nimport Language.Haskell.TH\n\nexpr :: IO Exp\nexpr = runQ $ do\n  name <- newName \"foo\"\n  [| do $(varP name) <- pure (); pure () |]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14128 where\n\nimport T14128Type\nimport {-# SOURCE #-} T14128a\n\ninstance Show AType where\n    show AType = \"hello\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14128a where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14128Main where\n\nimport T14128\n\n-- Overview:\n--   * T14128Main is imports T14128\n--   * T14128Type defines datatype MyType\n--   * T14128 has a boot file and defines a orphan Show instance; it SOURCE\n--     imports T14128\n--   * T14128a has a boot file which SOURCE imports T14128\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14128Type where\n\ndata AType = AType\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-}\n\nmodule Foo where\n\nimport Data.Coerce\n\nf :: Bool\nf = coerce (k :: Int)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes, DerivingStrategies, TypeApplications,\n    ScopedTypeVariables, GADTs, PolyKinds #-}\n\nmodule T14154 where\n\nnewtype Ran g h a\n  = MkRan (forall b. (a -> g b) -> h b)\n\nnewtype Swap p f g a where\n  MkSwap :: p g f a -> Swap p f g a\n\nireturn :: forall m i a. a -> m i i a\nireturn = undefined\n\nxs = case ireturn @(Swap Ran) 'a' of\n       MkSwap (MkRan f) -> f print\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n\nmodule T14158 where\n\nimport qualified Control.Category as Cat\n\nfoo = (Cat.id @(->) >>=)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, TypeFamilies,\n  FunctionalDependencies, KindSignatures, PolyKinds, DataKinds,\n  UndecidableInstances #-}\nmodule T14185 where\n\nimport GHC.Types\nimport GHC.Prim\n\n\nclass Unbox (t :: *) (r :: TYPE k) | t -> r, r -> t where\n  unbox :: t -> r\n  box :: r -> t\n\ninstance Unbox Int Int# where\n  unbox (I# i) = i\n  box i = I# i\n\ninstance Unbox Char Char# where\n  unbox (C# c) = c\n  box c = C# c\n\ninstance (Unbox a a', Unbox b b') => Unbox (a,b) (# a', b' #) where\n  unbox (a,b) = (# unbox a, unbox b #)\n  box (# a, b #) = (box a, box b)\n\ntestInt :: Int\ntestInt = box (unbox 1)\n\ntestTup :: (Int, Char)\ntestTup = box (unbox (1, 'a'))\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TypeClassConstraintsInformedHoles where\n\n-- Make sure that constraints imposed by the call site\n-- are handled. See trac #14273\npleaseShow :: Show a => Bool -> a -> Maybe String\npleaseShow False _ = Nothing\npleaseShow True a = Just (show _a)\n\nk :: String\nk = \"I fit into the hole in foo!\"\n\nfoo :: [a] -> String\nfoo xs = show (_h ++ [])\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14333 where\n\nimport Data.Coerce\n\nbad :: Coercible (a b) (c d) => c d -> a b\nbad = coerce\n\nbad2 :: Coercible (c d) (a b) => c d -> a b\nbad2 = coerce\n\nbad3 :: Coercible (a b) b => b -> a b\nbad3 = coerce\n\nbad4 :: Coercible b (a b) => b -> a b\nbad4 = coerce\n\nnewtype Id a = MkId a\n\nfoo :: Id Int\nfoo = bad3 (3 :: Int)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14363 where\n\nimport Data.Coerce\n\nfoo x = [fmap, coerce]\n-- Should work\n-- foo :: forall b (f :: * -> *) a p.\n--        (Functor f, Coercible a (f a), Coercible b (f b)) =>\n--        p -> [(a -> b) -> f a -> f b]\n--\n-- Failed in 8.2\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14363a where\n\nimport Data.Coerce\n\ncontra :: (a -> b) -> (f b -> f a)\ncontra = undefined\n\nfoo x = [coerce, contra]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\n\nmodule T14366 where\nimport Data.Kind\nimport Data.Type.Equality\n\ntype family Cast (a :: Type) (b :: Type) (e :: a :~: b) (x :: a) :: b where\n  Cast _ _ Refl x = x\n\ntype family F (a :: Type) :: Type where\n  F (a :: _) = a\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14396 where\nimport T14396a\nimport T14396b\ndata S = S\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T14396a where\nimport T14396f\nimport {-# SOURCE #-} T14396(S)\ntype instance F Int = S\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T14396b where\nimport T14396f\ntype instance F Bool = Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T14396f where\ntype family F a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonoLocalBinds, FlexibleInstances, OverloadedStrings #-}\n{-# OPTIONS -fsolve-constant-dicts #-}\n\nmodule T14434 where\n\nclass ToString a where\n  toString :: a -> String\n\n-- | This instance is used in original code as hack\n-- to simplify code generation\ninstance {-# OVERLAPPABLE #-} ToString a where\n  toString _ = \"Catchall attribute value\"\n\ntoStringX :: (ToString a) => a -> String\ntoStringX = toString\n  -- Here we do /not/ want to solve the ToString\n  -- constraint with the local instance\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T14441 where\n\nimport Data.Kind\n\ntype family Demote (k :: Type) :: Type\ntype family DemoteX (a :: k) :: Demote k\n\ndata Prox (a :: k) = P\n\ntype instance Demote (Prox (a :: k)) = Prox (DemoteX a)\n$(return [])\ntype instance DemoteX P = P\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language KindSignatures, TypeOperators, PolyKinds, TypeOperators, ConstraintKinds, TypeFamilies, DataKinds, TypeInType, GADTs, AllowAmbiguousTypes, InstanceSigs, RankNTypes, UndecidableInstances #-}\nmodule T14451 where\n\nimport Data.Kind\n\ndata TyFun :: Type -> Type -> Type\n\ntype a ~> b = TyFun a b -> Type\n\ntype Cat ob = ob -> ob -> Type\n\ntype family\n  Apply (f :: a ~> b) (x :: a) :: b where\n  Apply (CompSym2 f g) a = Comp f g a\n\ndata CompSym2 :: (b ~> c) -> (a ~> b) -> (a ~> c)\n\ntype a\u00c2\u00b7b = Apply a b\n\nclass Varpi (f :: i ~> j) where\n  type Dom (f :: i ~> j) :: Cat i\n  type Cod (f :: i ~> j) :: Cat j\n\n  varpa :: Dom f a a' -> Cod f (f\u00c2\u00b7a) (f\u00c2\u00b7a')\n\ntype family\n  Comp (f::k1 ~> k) (g::k2 ~> k1) (a::k2) :: k where\n  Comp f g a = f \u00c2\u00b7 (g \u00c2\u00b7 a)\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T14488 where\n\ntype Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s\n\ndata T a = MkT { _tfield :: Eq a => a }\n\ntfield :: Eq a => Lens' (T a) a\ntfield f t = MkT <$> f (_tfield t)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14590 where\n\nf1, f2, f3, f4 :: Int -> Int -> Int\nf1 x y = (x `_`)  y\nf2 x y = (x `_a`) y\nf3 x y = (`_`  x) y\nf4 x y = (`_a` x) y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, KindSignatures #-}\n\n-- Trac #1470\n\nmodule Foo where\n\nimport Data.Kind (Type)\n\nclass Sat a\nclass Data (ctx :: Type -> Type) a\ninstance  Sat (ctx Char)             => Data ctx Char\ninstance (Sat (ctx [a]), Data ctx a) => Data ctx [a]\n\nclass Data FooD a => Foo a\n\ndata FooD a = FooD\n\ninstance Foo t => Sat (FooD t)\n\ninstance {-# OVERLAPPABLE #-} Data FooD a => Foo a\ninstance {-# OVERLAPS #-}     Foo a       => Foo [a]\ninstance {-# OVERLAPPING #-}                 Foo [Char]\n{-\n Given:                Foo a,\n and its superclasses: Data FooD a\n\n Want superclass: Data FooD [a]\n\n by instance Data FooD [a]\n want:   Sat (FooD [a])\n         Data FooD a      -- We have this\n\n by instance Sat (FooD t)\n want:   Foo [a]\n\nBUT THIS INSTANCE OVERLAPS\n-}\n\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# OPTIONS_GHC -fdefer-type-errors -O #-}\n-- Oddly this bug was only triggered with -fdefer-type-errors\n-- The -O ensures that the RULE is processed\n\nmodule T14732 where\n\nimport Prelude hiding (zip, zipWith)\nimport Data.Kind (Type)\n\nzipWith :: (a -> b -> c)\n        -> Bundle v a\n        -> Bundle v b\n        -> Bundle v c\nzipWith = undefined\n\nclass GVector (v :: Type -> Type) a\ninstance GVector Vector a\n\ndata Bundle (v :: Type -> Type) a\ndata Vector a\nclass Unbox a\n\nstream :: GVector v a => v a -> Bundle v a\n{-# INLINE [1] stream #-}\nstream = undefined\n\nzip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b)\n{-# INLINE [1] zip #-}\nzip = undefined\n{-# RULES \"stream/zip [Vector.Unboxed]\" forall as bs .\n  stream (zip as bs) = zipWith (,) (stream as)\n                                   (stream bs)   #-}\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language QuantifiedConstraints #-}\n{-# Language StandaloneDeriving #-}\n{-# Language DataKinds #-}\n{-# Language TypeOperators #-}\n{-# Language GADTs #-}\n{-# Language KindSignatures #-}\n{-# Language FlexibleInstances #-}\n{-# Language UndecidableInstances #-}\n{-# Language MultiParamTypeClasses #-}\n{-# Language RankNTypes #-}\n{-# Language ConstraintKinds #-}\n\nmodule T14735 where\n\nimport Data.Kind\n\ndata D c where\n  D :: c => D c\n\nnewtype a :- b = S (a => D b)\n\nclass C1 a b\nclass C2 a b\ninstance C1 a b => C2 a b\n\nclass    (forall xx. f xx) => Limit f\ninstance (forall xx. f xx) => Limit f\n\nimpl :: Limit (C1 a) :- Limit (C2 a)\nimpl = S D\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StrictData, TypeOperators, GADTs #-}\n{-# LANGUAGE StrictData #-}\n\n-- Enable -Werror to fail in case we get this warning:\n--\n--   UNPACK pragma lacks '!' on the first argument of \u00e2\u20ac\u02dcA\u00e2\u20ac\u2122\n--\n-- In this test case we expect not to get this warning and succeed\n-- because of -XStrictData, see T14761a for the opposite.\n{-# OPTIONS -Werror #-}\n\nmodule T14761c where\n\ndata A = A { a :: {-# UNPACK #-} Maybe Int }\n\ndata x && y = Pair x y\n\ndata B = B { b :: {-# UNPACK #-} Maybe Int && [] Char && Int }\n\ndata G where\n  MkG2 :: {-# UNPACK #-} Maybe Int && [] Char && Int -> G\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\nmodule T14763 where\n\nimport Data.Kind (Type)\n\ndata Value a = Value a\n\ndata SomeValue expr where\n  SomeValue :: Esqueleto query expr backend => expr (Value a) -> SomeValue expr\n\nclass Esqueleto (query :: Type -> Type) (expr :: Type -> Type) backend\n        | query -> expr backend, expr -> query backend\n\ndata SqlQuery a\n\ndata SqlBackend\n\ndata SqlExpr a where\n  ECompositeKey :: SqlExpr (Value a)\n\ninstance Esqueleto SqlQuery SqlExpr SqlBackend\n\nmatch' :: SomeValue SqlExpr -> a\nmatch' (SomeValue ECompositeKey) = undefined\n\n-- This is tricky becauuse we get a Given constraint\n--    [G] Esqueleto query SqlExpr backend\n-- where query and backend are existential.\n-- Then fundeps with the top-level instance specify\n--    [D] query   ~ SqlQuery\n--    [D] backend ~ SqlBackend\n-- And that is not an error!\n-- (Nor can we exploit it, though.)\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableSuperClasses #-}\n\nmodule T14774 where\n\nclass C a => D a where\n  cop :: a -> Bool\n\nclass D a => C a where\n  dop :: a -> a\n\nf :: C a => Int -> a -> Bool\nf 0 x = cop x\nf n x = f (n-1) x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language UnboxedTuples #-}\nmodule T14811 where\n\ndata Foo a = Foo (# a #)\ndata Bar = Bar (# #)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14934 where\n\nimport T14934a\nimport GHC.TypeLits\n\ng :: Foo (1 - 0)\ng = f MkFoo1\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14934a where\n\nimport Data.Kind (Type)\nimport GHC.TypeLits\n\ndata Foo :: Nat -> Type where\n  MkFoo0 :: Foo 0\n  MkFoo1 :: Foo 1\n\nf :: Foo (1 - 0) -> Foo 1\nf x = x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test Trac #1495\n\nmodule CompilerBug where\n\nnewtype Fix a = Fix (a (Fix a))\ndata ID a = ID a\nnewtype I a = I a\n\ntestOk :: Fix ID\ntestOk = undefined\n\n-- this definition causes the compiler to fail to terminate\ntestInfiniteLoop :: Fix I\ntestInfiniteLoop = undefined\n\n\nnewtype T = MkT T\ntest :: T\ntest = undefined\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\nmodule T15050 where\ndata P a = P\ndata T1 a where\n  MkT1a :: forall a.              P a               -> T1 a\n  MkT1b :: forall a.              P a               -> T1 a\n  MkT1c :: forall a.              P a               -> T1 a\n  MkT2  :: forall a.              P a               -> T1 (a,a)\n  MkT3  :: forall a b. b ~ Int => P a -> P b        -> T1 a\n  MkT4  :: forall a b.            P a -> P b        -> T1 a\n  MkT5  :: forall a b c. b ~ c => P a -> P b -> P c -> T1 a\n\nfoo :: T1 (Int, Int) -> ()\nfoo (MkT1a (P::P (Int,Int)))    = ()\nfoo (MkT1b (P::P (Int,x)))      = (() :: x ~ Int => ())\nfoo (MkT1c (P::P x))            = (() :: x ~ (Int,Int) => ())\nfoo (MkT2  (P::P x))            = (() :: x ~ Int => ())\nfoo (MkT3  P (P::P Int))        = ()\nfoo (MkT4  P (P::P b))          = ()\nfoo (MkT5  P (P::P b) (P::P b)) = ()\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, TypeFamilyDependencies,\n             ScopedTypeVariables, TypeOperators, GADTs,\n             DataKinds #-}\n\nmodule T15141 where\n\nimport Data.Type.Equality\nimport Data.Proxy\n\ntype family F a = r | r -> a where\n  F () = Bool\n\ndata Wumpus where\n  Unify :: k1 ~ F k2 => k1 -> k2 -> Wumpus\n\nf :: forall k (a :: k). k :~: Bool -> ()\nf Refl = let x :: Proxy ('Unify a b)\n             x = undefined\n         in ()\n\n{-\nWe want this situation:\n\nforall[1] k[1].\n  [G] k ~ Bool\n  forall [2] ... . [W] k ~ F kappa[2]\n\nwhere the inner wanted can be solved only by taking the outer\ngiven into account. This means that the wanted needs to be floated out.\nMore germane to this bug, we need *not* to generalize over kappa.\n\nThe code above builds this scenario fairly exactly, and indeed fails\nwithout the logic in kindGeneralize that excludes constrained variables\nfrom generalization.\n-}\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\n\nimport Control.Exception\nimport System.Exit\nimport GHC.Exts\n\nmain :: IO ()\nmain = do\n  let a = throw $ toException ExitSuccess :: Int#\n  return ()\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# OPTIONS_GHC -Wredundant-constraints -Wall -Werror #-}\nimport GHC.TypeLits (TypeError, ErrorMessage(..))\n\nclass C a where f :: a -> a\ninstance {-# OVERLAPPING #-} C Int where f _ = 42\ninstance {-# OVERLAPPABLE #-} TypeError ( 'Text \"Only Int is supported\" ) => C a where f = undefined\n\nmain :: IO ()\nmain = print $ f (42::Int)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -ddump-tc-ast #-}\n\nmodule T15242 where\n\nf = (((const) 3)) ((((seq) 'a')) 'b')\ng = ((((((((((id id)) id) id) id))) id))) id\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T15368 where\n\nimport Data.Kind (Type)\n\ntransitive :: (a, b) -> (b, c) -> (a, c)\ntransitive = undefined\n\ntrigger :: a -> b -> (F a b, F b a)\ntrigger _ _ = _ `transitive` trigger _ _\n\ntype family F (n :: Type) (m :: Type) :: Type\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Bug where\n\nimport Data.Type.Equality\n\ndata S (a :: Either x y)\n\nmkRefl :: n :~: j\nmkRefl = Refl\n\nright :: forall x y (r :: Either x y).\n         S r -> ()\nright no =\n  case mkRefl @x @y of\n    Refl -> no + _\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language DataKinds, TypeInType, TypeFamilies, UndecidableInstances #-}\n\nmodule T15412 where\n\nimport Data.Kind\n\nnewtype I a = I a\n\ntype C = Constraint\n\ntype family\n  UnitC :: C where\n  UnitC = ()\n\ninstance UnitC => Functor I where\n  -- The UnitC type family in the context needs UndecidableIntances\n  fmap = undefined\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\nmodule T15428 where\n\ndata Flurmp\ntype family Pure (x :: a) :: f a\n\ntype T = Pure Flurmp Flurmp\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, FlexibleContexts #-}\n\nmodule T15431 where\n\nimport Data.Coerce\n\ndata T t where\n  A :: Show (t a) => t a -> T t\n  B :: Coercible Int (t a) => t a -> T t\n\nf :: T t -> String\nf (A t) = show t\n\ng :: T t -> Int\ng (B t) = coerce t\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\nmodule T15431a where\n\nimport Data.Coerce\nimport Data.Functor.Identity\n\ng1 :: Coercible (t a) Int => t a -> Int\ng1 = coerce\n\ng2 :: Coercible Int (t a) => t a -> Int\ng2 = coerce\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n-- {-# LANGUAGE UndecidableInstances #-}\nmodule Bug where\n\ntype family Undefined :: k where {}\n\ntype family LetInterleave xs t ts is (a_ahkO :: [a]) (a_ahkP :: [[a]]) :: [[a]] where\n  LetInterleave xs t ts is y z = Undefined y z\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}\nmodule T15499 ()\nwhere\n\ndata ADT (p :: Integer) where\n  ADT ::\n    { a :: a\n    , b :: Integer\n    } -> ADT p\n\nfoo = undefined {b=undefined}\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyCase #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE DataKinds #-}\nmodule T15549a where\n\nimport Data.Proxy\nimport Data.Void\n\ndata family Sing (a :: k)\ndata instance Sing (z :: Void)\n\ntype family Rep a\nclass SGeneric a where\n  sTo :: forall (r :: Rep a). Sing r -> Proxy a\n\ntype instance Rep Void = Void\ninstance SGeneric Void where\n  sTo x = case x of\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE DataKinds #-}\n\nmodule T15549b where\n\nimport Data.Kind (Type)\n\nnewtype Identity a = Identity a\nnewtype Par1 a = Par1 a\n\ndata family Sing :: forall k. k -> Type\ndata instance Sing :: forall k. k -> Type\n\ntype family Rep1 (f :: Type -> Type) :: Type -> Type\ntype instance Rep1 Identity = Par1\n\ntype family From1 (z :: f a) :: Rep1 f a\ntype instance From1 ('Identity x) = 'Par1 x\n\nund :: a\nund = und\n\nf :: forall (a :: Type) (x :: Identity a).  Sing x\nf = g\n    where g :: forall (a :: Type) (f :: Type -> Type) (x :: f a). Sing x\n          g = seq (und :: Sing (From1 x)) und\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule STree where\n\ndata STree a where\n    STreeIM :: {\n        l :: v a ,\n        stree :: a\n    } -> STree a\n\ninsert :: STree a -> STree a\ninsert s = s { stree = undefined }\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, OverloadedStrings #-}\n\nmodule T15645 where\n\nimport Prelude hiding (fail)\n\nfoo x = do\n    Just y <- x\n    return y\n\nnewtype Text = Text String\n\nfail :: Text -> a\nfail (Text x) = error x\n\nfromString :: String -> Text\nfromString = Text\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeInType #-}\n\nmodule T15778 where\n\nf (x :: (Int :: a)) = True :: (Bool :: a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes       #-}\n{-# Language GADTs            #-}\n{-# Language TypeApplications #-}\n{-# Language PolyKinds        #-}\n\n{-# Options_GHC -dcore-lint #-}\nmodule T15788 where\nimport Data.Kind\n\ndata A :: forall k. Type where\n MkA :: A @k\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes       #-}\n{-# Language TypeApplications #-}\n{-# Language PolyKinds        #-}\n{-# Language GADTs            #-}\n\nmodule T15807a where\nimport Data.Kind\n\ndata\n  App :: forall (f :: Type -> Type). Type -> Type\n  where\n  MkApp :: f a -> App @f a\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16008 where\n\nimport Data.Kind\n\nclass C k where\n  type S :: k -> Type\n\ndata D :: Type -> Type\ndata SD :: forall a. D a -> Type\n\ninstance C (D a) where\n  type S = SD\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\nmodule T16033 where\n\nf    :: (forall x. x -> forall y. y -> c) -> ()\nf (_ ::  forall a. a -> forall b. b -> c)  = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StrictData #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16141 where\n\ndata family T1\nnewtype instance T1 = MkT1 Int\n  deriving Eq\n\nnewtype T2 a b where\n  MkT2 :: forall b a. Int -> T2 a b\n  deriving Eq\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule T16188 where\n\nimport Data.Kind (Type)\nimport Data.Type.Bool (type (&&))\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\ntype family Apply (f :: a ~> b) (x :: a) :: b\ndata family Sing :: forall k. k -> Type\n\ndata instance Sing :: Bool -> Type where\n  SFalse :: Sing False\n  STrue  :: Sing True\n\n(%&&) :: forall (x :: Bool) (y :: Bool).\n         Sing x -> Sing y -> Sing (x && y)\nSFalse %&& _ = SFalse\nSTrue  %&& a = a\n\ndata RegExp :: Type -> Type where\n  App :: RegExp t -> RegExp t -> RegExp t\n\ndata instance Sing :: forall t. RegExp t -> Type where\n  SApp :: Sing re1 -> Sing re2 -> Sing (App re1 re2)\n\ndata ReNotEmptySym0 :: forall t. RegExp t ~> Bool\ntype instance Apply ReNotEmptySym0 r = ReNotEmpty r\n\ntype family ReNotEmpty (r :: RegExp t) :: Bool where\n  ReNotEmpty (App re1 re2) = ReNotEmpty re1 && ReNotEmpty re2\n\nsReNotEmpty :: forall t (r :: RegExp t).\n               Sing r -> Sing (Apply ReNotEmptySym0 r :: Bool)\nsReNotEmpty (SApp sre1 sre2) = sReNotEmpty sre1 %&& sReNotEmpty sre2\n\nblah :: forall (t :: Type) (re :: RegExp t).\n        Sing re -> ()\nblah (SApp sre1 sre2)\n  = case (sReNotEmpty sre1, sReNotEmpty sre2) of\n      (STrue, STrue) -> ()\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16204 where\n\nimport Data.Kind\n\n-----\n-- singletons machinery\n-----\n\ndata family Sing :: forall k. k -> Type\ndata SomeSing :: Type -> Type where\n  SomeSing :: Sing (a :: k) -> SomeSing k\n\n-----\n-- (Simplified) GHC.Generics\n-----\n\nclass Generic (a :: Type) where\n    type Rep a :: Type\n    from :: a -> Rep a\n    to   :: Rep a -> a\n\nclass PGeneric (a :: Type) where\n  -- type PFrom ...\n  type PTo (x :: Rep a) :: a\n\nclass SGeneric k where\n  -- sFrom :: ...\n  sTo :: forall (a :: Rep k). Sing a -> Sing (PTo a :: k)\n\n-----\n\nclass SingKind k where\n  type Demote k :: Type\n  -- fromSing :: ...\n  toSing :: Demote k -> SomeSing k\n\ngenericToSing :: forall k.\n                 ( SingKind k, SGeneric k, SingKind (Rep k)\n                 , Generic (Demote k), Rep (Demote k) ~ Demote (Rep k) )\n              => Demote k -> SomeSing k\ngenericToSing d = withSomeSing @(Rep k) (from d) $ SomeSing . sTo\n\nwithSomeSing :: forall k r\n              . SingKind k\n             => Demote k\n             -> (forall (a :: k). Sing a -> r)\n             -> r\nwithSomeSing x f =\n  case toSing x of\n    SomeSing x' -> f x'\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16204b where\n\nimport Data.Kind\n\n-----\n-- singletons machinery\n-----\n\ndata family Sing :: forall k. k -> Type\ndata SomeSing :: Type -> Type where\n  SomeSing :: Sing (a :: k) -> SomeSing k\n\n-----\n-- (Simplified) GHC.Generics\n-----\n\nclass Generic (a :: Type) where\n    type Rep a :: Type\n    from :: a -> Rep a\n    to   :: Rep a -> a\n\nclass PGeneric (a :: Type) where\n  -- type PFrom ...\n  type PTo (x :: Rep a) :: a\n\nclass SGeneric k where\n  -- sFrom :: ...\n  sTo :: forall (a :: Rep k). Sing a -> Sing (PTo a :: k)\n\n-----\n\nclass SingKind k where\n  type Demote k :: Type\n  -- fromSing :: ...\n  toSing :: Demote k -> SomeSing k\n\ngenericToSing :: forall k.\n                 ( SingKind k, SGeneric k, SingKind (Rep k)\n                 , Generic (Demote k), Rep (Demote k) ~ Demote (Rep k) )\n              => Demote k -> SomeSing k\ngenericToSing d = withSomeSing (from d) $ SomeSing . sTo\n\nwithSomeSing :: forall k r\n              . SingKind k\n             => Demote k\n             -> (forall (a :: k). Sing a -> r)\n             -> r\nwithSomeSing x f =\n  case toSing x of\n    SomeSing x' -> f x'\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T16225 where\n\nimport Data.Kind\n\ndata family Sing :: k -> Type\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\ntype family Apply (f :: a ~> b) (x :: a) :: b\n\ndata TyCon1 :: (k1 -> k2) -> (k1 ~> k2)\ntype instance Apply (TyCon1 f) x = f x\n\ndata SomeApply :: (k ~> Type) -> Type where\n  SomeApply :: Apply f a -> SomeApply f\n\nf :: SomeApply (TyCon1 Sing :: k ~> Type)\n  -> SomeApply (TyCon1 Sing :: k ~> Type)\nf (SomeApply s)\n = SomeApply s\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T1634 where\n\nt1 :: a -> (forall b. b -> (a,b))\nt1 = (,)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls #-}\n{-# OPTIONS_GHC -fno-warn-type-defaults #-}\n\n-- Trac #2045\n-- ghc -fhpc --make Vhdl.hs -o gencirc -Wall\n\nmodule ShouleCompile where\n\nwriteDefinitions :: Generic b\n                 => b -> IO ()\nwriteDefinitions out =\n  do let define v s =\n           case s of\n             Bool True     -> port \"vcc\"  []\n             Bool False    -> port \"gnd\"  []\n             Inv x         -> port \"inv\"  [x]\n\n             And []        -> define v (Bool True)\n             And [x]       -> port \"id\"   [x]\n             And [x,y]     -> port \"and2\" [x,y]\n             And (x:xs)    -> define (w 0) (And xs)\n                           >> define v (And [x,w 0])\n\n             Or  []        -> define v (Bool False)\n             Or  [x]       -> port \"id\"   [x]\n             Or  [x,y]     -> port \"or2\"  [x,y]\n             Or  (x:xs)    -> define (w 0) (Or xs)\n                           >> define v (Or [x,w 0])\n\n             Xor  []       -> define v (Bool False)\n             Xor  [x]      -> port \"id\"   [x]\n             Xor  [x,y]    -> port \"xor2\" [x,y]\n             Xor  (x:xs)   -> define (w 0) (Or xs)\n                           >> define (w 1) (Inv (w 0))\n                           >> define (w 2) (And [x, w 1])\n\n                           >> define (w 3) (Inv x)\n                           >> define (w 4) (Xor xs)\n                           >> define (w 5) (And [w 3, w 4])\n                           >> define v     (Or [w 2, w 5])\n\n             Multi a1 a2 a3 a4 -> multi a1 a2 a3 a4\n           where\n            w i = v ++ \"_\" ++ show i\n\n            multi n \"RAMB16_S18\" opts args =\n              do putStr $\n                      \"  \"\n                   ++ \" : \"\n                   ++ \"RAMB16_S18\"\n                   ++ \"\\ngeneric map (\"\n                   ++ opts\n                   ++ mapTo \"DOP\" [0,1] (get 16 2 outs)\n                   ++ mapTo \"ADDR\" [0..9] (get 0 10 args)\n              where\n                outs = map (\\i -> \"o\" ++ show i ++ \"_\" ++ v) [1..n]\n\n                get :: Int -> Int -> [a] -> [a]\n                get n' m xs = take m (drop n' xs)\n\n                mapTo s' (n':ns) (x:xs) = s' ++ \"(\" ++ show n' ++ \")\"\n                                          ++ \" => \" ++ x ++ \",\\n\"\n                                          ++ mapTo s' ns xs\n                mapTo _ _ _ = \"\"\n\n\n\n            multi n \"RAMB16_S18_S18\" opts args =\n              do putStr $\n                      opts\n                   ++ mapTo \"DOA\" [0..15] (get 0 16 outs)\n                   ++ mapTo \"DOB\" [0..15] (get 18 16 outs)\n                   ++ mapTo \"DOPA\" [0,1] (get 16 2 outs)\n                   ++ mapTo \"DOPB\" [0,1] (get 34 2 outs)\n                   ++ mapTo \"ADDRA\" [0..9] (get 0 10 args)\n                   ++ mapTo \"ADDRB\" [0..9] (get 10 10 args)\n                   ++ mapTo \"DIA\" [0..15] (get 20 16 args)\n                   ++ mapTo \"DIB\" [0..15] (get 38 16 args)\n                   ++ mapTo \"DIPA\" [0,1] (get 36 2 args)\n                   ++ mapTo \"DIPB\" [0,1] (get 54 2 args)\n                   ++ head (get 56 1 args)\n                   ++ head (get 57 1 args)\n              where\n                outs = map (\\i -> \"o\" ++ show i ++ \"_\" ++ v) [1..n]\n\n                get :: Int -> Int -> [a] -> [a]\n                get _ _ = id\n\n                mapTo s' (n':ns) (x:xs) = s' ++ \"(\" ++ show n' ++ \")\"\n                                          ++ \" => \" ++ x ++ \",\\n\"\n                                          ++ mapTo s' ns xs\n                mapTo _ _ _ = \"\"\n            multi _ _ _ _ = undefined\n\n            port n args | n == \"id\" =\n              do putStr $\n                      \"  \"\n                   ++ v ++ \" <= \" ++ (head args) ++ \";\\n\"\n\n            port _ _ = undefined\n     netlistIO define (struct out)\n     return ()\n\nnetlistIO :: (v -> S v -> IO ()) -> f Symbol -> IO (f v)\nnetlistIO = undefined\n\ndata Struct a\n\nclass Generic a where\n  struct    :: a -> Struct Symbol\n  struct = undefined\n\ninstance Generic (Signal a)\n\ndata Signal a\n\ndata Symbol\n\ndata S s\n  = Bool      Bool\n  | Inv       s\n  | And       [s]\n  | Or        [s]\n  | Xor       [s]\n  | Multi    Int String String [s]\n\n", "num_lines": 127}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonomorphismRestriction #-}\n\nmodule Foo where\n\nf :: Read a => a\n-- This one needs NoMonomorphismRestriction else f could\n-- not get a polymorphic type\n(f, _) = (read \"3\", True)\n\ng :: Read a => a\ng = f\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T2412 ( Baz ) where\n\nimport T2412A ( Bar )\n\ntype Spqr = Bar\ndata Baz = Baz Spqr\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T2412A where\n\nimport {-# SOURCE #-} T2412 ( Baz )\n\ntype Bar = Baz\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n\n-- Test Trac #2433\n\nmodule T2433 where\n\n import Data.Typeable(Typeable)\n import T2433_Help( T )\n\n deriving instance Typeable T\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2433_Help where\n\ndata T a = MkT a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, DatatypeContexts #-}\n\nmodule ShouldCompile where\n\n  data Eq t => TrafoE t = forall env2 . TrafoE Int t\n\n  newSRef () = TrafoE \n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- Trac #2494, should compile ok\n\nmodule Foo where\n\nfoo :: (forall m. Monad m => Maybe (m a) -> Maybe (m a)) -> Maybe a -> Maybe a\n{-# NOINLINE [1] foo #-}\nfoo _ x = x\n\n{-# RULES\n\n\"foo/foo\"\n  forall (f :: forall m. Monad m => Maybe (m a) -> Maybe (m a))\n         (g :: forall m. Monad m => Maybe (m a) -> Maybe (m a)) x.\n  foo f (foo g x) = foo (f . g) x\n #-}\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- Trac #2494, should generate an error message\n\nmodule Foo where\n\nfoo :: (forall m. Monad m => Maybe (m a) -> Maybe (m a)) -> Maybe a -> Maybe a\nfoo _ x = x\n\n{-# RULES\n\n\"foo/foo\"\n  forall (f :: forall m. Monad m => Maybe (m a) -> Maybe (m a))\n         (g :: forall m. Monad m => Maybe (m b) -> Maybe (m b)) x.\n  foo f (foo g x) = foo (f . g) x\n #-}\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-unused-binds #-}\n\nmodule ShouldCompile() where\n\nfoo x = x\n{-# NOINLINE [1] foo #-}\n\n-- Trac #2497; test should compile without language\n--             pragmas to switch on the forall\n{-# RULES \"id\" forall (x :: a). foo x = x #-}\n\n\n\n-- Trac #2213; eq should not be reported as unused\n\neq,beq :: Eq a => a -> a -> Bool\n{-# NOINLINE [0] eq #-}\n-- The pragma and [~1] in the RULE are to prevent an infinite loop\n-- in the simplifier, where the RULE fires infinitely in its\n-- own RHS\neq = (==)    -- Used\nbeq = (==)   -- Unused\n\n{-# RULES\n    \"rule 1\" [~1] forall x y. x == y = y `eq` x\n  #-}\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- Trac #2572\n\nmodule Foo where\n\ntype GTypeFun = forall a . a -> ()\n\ngmapType :: Int -> GTypeFun\ngmapType _ (_ :: a) = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses,\n             FunctionalDependencies, RankNTypes #-}\n\nmodule Q where\n\nclass Transformer t a | t -> a where\n    transform :: t -> l a -> (forall l'. l' a -> b) -> b\n\ndata EL a = forall l. EL (l a)\n\nunEL :: EL a -> (forall l. l a -> b) -> b\nunEL _ _ = error \"unEL\"\n\ntransform' :: (Transformer t a) => t -> EL a -> EL a\ntransform' = error \"transform'\"\n\ndata MultiToggleS ts a = MultiToggleS ts\n\ndata MultiToggle = MultiToggle\n\nexpand :: HList ts a => MultiToggleS ts a -> MultiToggle\nexpand (MultiToggleS ts) =\n    resolve ts\n        (\\x mt ->\n            let g = transform' x in\n            mt\n        )\n        MultiToggle\n\nclass HList c a | c -> a where\n    resolve :: c -> (forall t. (Transformer t a) => t -> b) -> b\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2735\n\nmodule Bug where\n\ndata S = S { s1 :: (), s2 :: () }\n\nf s = s { s1 = (), s2 = s1 s }\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XGADTs #-}\n\nmodule RepAux (\n  toSpineRl\n) where\n\ndata MTup l where\n    P :: MTup l -> MTup (a,l)\n\ndata Spine a where\n    S :: Spine (a -> b) -> Spine b\n\ntoSpineRl :: MTup l -> l -> (l -> a) -> Spine a \ntoSpineRl (P rs) (a, l) into = S (toSpineRl rs l into')\n  where \n    into' tl1 x1 = into (x1,tl1)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes, FlexibleContexts #-}\nmodule T2846 where\n\nx = [1,2,3] :: [Num a => a]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -w #-}\n{-# LANGUAGE UndecidableInstances, EmptyDataDecls #-}\n{-# LANGUAGE RankNTypes, KindSignatures, MultiParamTypeClasses, FlexibleInstances #-}\n\n-- Works with new constraint solver\n\nmodule T3018 where\n\nimport Control.Monad\n\n-- minimal Data/Rep classes\ndata Rep (ctx :: * -> *) a\n\nclass Data (ctx :: * -> *) a where rep :: Rep ctx a\n\nclass Sat a where dict :: a\n\n---------  Version A: failed in 6.12.3 -----------\n-- Substitution class\n-- substitute [a -> t] t'.\nclass Subst_A a t t' where\n    subst_A :: (Monad m) => a -> t -> t' -> m t'\n\ndata SubstD_A a t t' = SubstD_A {substD_A:: forall m. (Monad m) => a -> t -> t' -> m t'}\n\n-- Allow override dictionary version with implementation of type class Subst\ninstance Subst_A a t t' => Sat (SubstD_A a t t') where\n    dict = SubstD_A {substD_A = subst_A}\n\n-- Generic instance\ninstance Data (SubstD_A a t) t' => Subst_A a t t' where\n    subst_A = undefined\n\n---------  Version B: passed in 6.12.3 -----------\n-- Substitution class\n-- substitute [a -> t] t'.\nclass Subst_B a t t' where\n    subst_B :: a -> t -> t' -> t'\n\ndata SubstD_B a t t' = SubstD_B {substD_B :: a -> t -> t' -> t'}\n\n-- allow override dictionary version with implementation of type class Subst\ninstance Subst_B a t t' => Sat (SubstD_B a t t') where\n    dict = SubstD_B {substD_B = subst_B}\n\n-- generic instance\ninstance Data (SubstD_B a t) t' => Subst_B a t t' where\n    subst_B = undefined\n\n\n{- Commentary from Trac #3018\n\nHere are the key lines of code:\n\n    class Subst a t t' where\n        subst :: (Monad m) => a -> t -> t' -> m t'\n\n    data SubstD a t t'\n      = SubstD (forall m. Monad m => a -> t -> t' -> m t')\n\n    instance Data (SubstD a t) t' => Subst a t t'          -- (1)\n\n    instance Subst a t t' => Sat (SubstD a t t') where     -- (2)\n        dict = SubstD subst\n\nThe call to 'subst' on the last line gives rise to a constraint (Subst\na t t'). But that constraint can be satisfied in two different ways:\n\n    Using the instance declaration for Subst (which matches anything!)\n    Using the context of the Sat (SubstD ..) instance declaration itself\n\nIf GHC uses (1) it gets into a corner it can't get out of, because now\nit needs (Data (SubstD a t) t'), and that it can't get. The error\nmessage is a bit misleading:\n\nT3018.hs:29:28:\n    Could not deduce (Data (SubstD a t) t') from the context (Monad m)\n      arising from a use of `subst' at T3018.hs:29:28-32\n\nit should really say\n\n ...from the context (Subst a t t', Monad m)\n\nbut that's a bit of a separate matter.\n\nNow, you are hoping that (2) will happen, but I hope you can see that\nit's delicate. Adding the (Monad m) context just tips things over the\nedge so that GHC doesn't \"see\" the (Subst a t t') in the context until\ntoo late. But the real problem is that you are asking too much. Here\nis a simpler example:\n\n    f :: Eq [a] => a -> blah\n    f x = let g :: Int -> Int\n              g = ....([x]==[x])...\n          in ...\n\nThe use of == requires Eq [a], but GHC will probably use the list\nequality instance to simplify this to Eq a; and then it can't deduce\nEq a from Eq [a]. Local constraints that shadow or override global\ninstance declarations are extremely delicate.\n\nAll this is perhaps soluble if GHC were to be lazier about solving\nconstraints, and only makes the attempt when it has all the evidence\nin hand. I'm thinking quite a bit about constraint solving at the\nmoment and will bear that in mind. But I can't offer you an immediate\nsolution. At least I hope I've explained the problem.\n-}\n", "num_lines": 108}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses,\n             FunctionalDependencies, FlexibleInstances #-}\n\nmodule T3108 where\n\n-- Direct recursion terminates (typechecking-wise)\n\nclass C0 x\n where\n m0 :: x -> ()\n m0 = const undefined\n\ninstance {-# OVERLAPPING #-} (C0 x, C0 y) => C0 (x,y)\ninstance {-# OVERLAPPING #-} C0 Bool\ninstance {-# OVERLAPPABLE #-} C0 (x,Bool) => C0 x\n\nfoo :: ()\nfoo = m0 (1::Int)\n\n\n-- Indirect recursion does not terminate (typechecking-wise)\n\nclass C1 x\n where\n m1 :: x -> ()\n m1 = const undefined\n\ninstance {-# OVERLAPPING #-} (C1 x, C1 y) => C1 (x,y)\ninstance {-# OVERLAPPING #-} C1 Bool\ninstance {-# OVERLAPPABLE #-} (C2 x y, C1 (y,Bool)) => C1 x\n-- Weird test case: (C1 (y,Bool)) is simplifiable\n\nclass C2 x y | x -> y\ninstance C2 Int Int\n\n-- It is this declaration that causes nontermination of typechecking.\nbar :: ()\nbar = m1 (1::Int)\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #3219.  Lint error in GHC 6.10\n\nmodule T3219 where\n\ndata T a = A{ m1 :: a } | B{ m1, m2 :: a } | C{ m2 :: a }\n\n-- bar :: (a -> a) -> T a -> T a\nbar f x@(A m) = x{m1 = f m}\n\n-- foo :: (a -> a) -> T a -> T a\nfoo f x@(C m) = x{m2 = f m}\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ViewPatterns #-}\n{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}\n\nmodule T3342 where\n\ndata F = FT String [F]\ndata G = GX F F | GY\n\nspec :: F -> G\nspec (FT \"X\"  [t1, t2]) = GX t1 t2\nspec _                  = GY\n\n-- walk :: F -> F\nwalk (spec -> GX _ t2) = walk t2\nwalk t@(FT _ _)        = t\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies  #-}\n\n-- Trac #3346\n\nmodule Foo where\n\nclass EP a where\n  type Result a\n  from :: a -> Result a\n  to   :: Result a -> a\n\n-- {-# RULES \"rule1\"   forall x. to (from x) = x #-}\n-- {-# RULES \"rule2\"   forall x. from (to x) = x #-}\n\nfoo :: EP a => a -> a\n-- This is typed in a way rather similarly to RULE rule1\nfoo x = to (from x)\n\n-- 'bar' has an ambiguous type and is rightly rejected\n-- bar :: forall a. Result a -> Result a\n-- bar x = from (to x :: a)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, Generics #-}\n{-# OPTIONS_GHC -v0 #-}\n\n-- We should only generate one set of generic to/from functions\n-- for T, despite the multiple chunks caused by the TH splices\n-- See Trac #3391\n\nmodule T3391 where\n\ndata T = MkT\n\n$(return [])\n\n$(return [])\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  ExistentialQuantification, TypeFamilies #-}\n\n-- Tests a nasty case where 'exprType' or 'coreAltsType' can\n-- return a type that mentions an out-of-scope type variable\n-- because of a type synonym that discards one of its arguments\n--\n-- See Note [Existential variables and silly type synonyms] \n-- in CoreUtils\n\n-- In GHC 6.10, both tests below (independently) give Lint errors\n\nmodule T3409 where\n\n\n--------------------------\n-- Simpler version not involving type families\n\ndata T = forall a. T a (Funny a)\ntype Funny a = Bool\n\nf :: T -> Bool\nf (T x n) = n\n\n\n--------------------------\n-- Cut down version of the original report\n\nnewtype Size s = Size Int\n\ndata ArrayS d e = ArrayS d e\n\ndata Array1 e = forall s . Array1 (Size s) (ArrayS (Size s) e)\n-- Array1 :: forall e s. Size s -> ArrayS (Size s) e -> Array1 e\n\ncopy ::  Int -> Array1 a -> Array1 a\ncopy _ (Array1 s a) = Array1 s $ (ArrayS s (bang a))\n  -- Array1 s :: ArrayS (Size s) a -> Array1 a\n\n  -- s :: Size s\n  -- a :: ArrayS (Size s) a\n  -- ArrayS :: Size s -> a -> ArrayS (Size s) a\n  -- i :: AccessIx (ArrayS (Size s) a) = Ix s\n  -- bang a :: AccessResult (ArrayS (Size s) a) = a\n\n  -- ArrayS s (bang a) :: ArrayS (Size s) (AccessResult (ArrayS (Size s) a))\n\nclass Access a where\n    type AccessResult a\n    bang :: a -> AccessResult a\n\ninstance Access (ArrayS d a) where\n    type AccessResult (ArrayS d a) = a\n    bang = error \"urk\"\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes #-}\n\nmodule T3692 where\n\ntype Foo a b = () -> (Bar a => a)\n\nclass Bar a where {}\n\nfoo :: Foo a b\nfoo = id (undefined :: Foo p q)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -Wall #-}\n\nmodule T3696 where\n\nclass C a where c :: a\n\ninstance C Int where c = 37\n\ndef = c\n\nuse :: Int\nuse = def\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ImplicitParams, GADTs #-}\n\nmodule T3743 where\n\nclass Foo a\n\ndata M where M :: Foo a => a -> M\n\nx :: (?x :: ()) => ()\nx = undefined\n\n-- foo :: (?x :: ()) => M -> ()\nfoo y = case y of\n    M _ -> x\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n\n-- Test for Trac #3955\n\nmodule T3955 where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\nclass (Monad m) => MonadReader r m \nnewtype Reader r a = Reader { runReader :: r -> a }\n\ninstance Functor (Reader r) where\n    fmap = liftM\n\ninstance Applicative (Reader r) where\n    pure = return\n    (<*>) = ap\n\ninstance Monad (Reader r) where\n  (>>=)  = error \"urk\"\n  return = error \"urk\"\n\ninstance MonadReader r (Reader r)\n\nnewtype T a x = T (Reader a x)\n    deriving (Functor, Applicative, Monad, MonadReader a)\n\n{-\n[1 of 1] Compiling Main             ( bug.hs, interpreted )\nmkUsageInfo: internal name? a{tv amy}\nOk, modules loaded: Main.\n-}\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule Test where\n\nfoo :: () -> forall b. b\nfoo = undefined\n\nworks = id foo\n\nfails = (id) foo\n\n-- works type checks, but fails fails with the following error\n-- message:\n--\n--   Cannot match a monotype with `() -> forall b. b'\n--   Probable cause: `foo' is applied to too few arguments\n--   In the first argument of `(id)', namely `foo'\n--   In the expression: (id) foo\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, RankNTypes, ScopedTypeVariables, KindSignatures #-}\n\nmodule T4310 where\n\nimport GHC.ST\nimport Data.Kind (Type)\n\ntype family Mutable a :: Type -> Type -> Type\n\ndata New v a = New (forall s. ST s (Mutable v s a))\n\ncreate :: (forall s. ST s (Mutable v s a)) -> New v a\ncreate = New\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-missing-methods #-}\n{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, RankNTypes, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards, DatatypeContexts #-}\n\nmodule T4355 where\n\nimport Control.Arrow\nimport Control.Monad.Trans      -- From mtl\nimport Control.Monad.Reader     -- Ditto\nimport Data.Typeable\nimport Data.Maybe\n\nclass (Eq t, Typeable t) => Transformer t a | t -> a where\n    transform :: (LayoutClass l a) => t -> l a ->\n        (forall l'. (LayoutClass l' a) => l' a -> (l' a -> l a) -> b) -> b\n\nclass HList c a where\n    find :: (Transformer t a) => c -> t -> Maybe Int\n\nclass Typeable a => Message a\n\ndata (LayoutClass l a) => EL l a = forall l'. (LayoutClass l' a) => EL (l' a) (l' a -> l a)\n\nunEL :: (LayoutClass l a) => EL l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b\nunEL (EL x _) k = k x\n\ntransform' :: (Transformer t a, LayoutClass l a) => t -> EL l a -> EL l a\ntransform' t (EL l det) = transform t l (\\l' det' -> EL l' (det . det'))\n\ndata Toggle a = forall t. (Transformer t a) => Toggle t\n    deriving (Typeable)\n\ninstance (Typeable a) => Message (Toggle a)\n\ndata MultiToggle ts l a = MultiToggle{\n    currLayout :: EL l a,\n    currIndex :: Maybe Int,\n    transformers :: ts\n}\n\ninstance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where\n\nclass Show (layout a) => LayoutClass layout a where\n    handleMessage :: layout a -> SomeMessage -> IO (Maybe (layout a))\n\ninstance (Typeable a, Show ts, HList ts a, LayoutClass l a)\n      => LayoutClass (MultiToggle ts l) a where\n    handleMessage mt m\n        | Just (Toggle t) <- fromMessage m\n        , i@(Just _) <- find (transformers mt) t\n            = case currLayout mt of\n                EL l det -> do\n                    return . Just $\n                        mt {\n                            currLayout = (if cur then id else transform' t) (EL (det l) id)\n                        }\n                    where cur = (i == currIndex mt)\n\ndata SomeMessage = forall a. Message a => SomeMessage a\n\nfromMessage :: Message m => SomeMessage -> Maybe m\nfromMessage (SomeMessage m) = cast m\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE FlexibleContexts #-}\n\n-- This test comes from Sergei Mechveliani's DoCon system\n\nmodule Pol3_ (moduloBasisx) where\n\nclass CommutativeRing a\nclass CommutativeRing a => LinSolvRing a\nclass LinSolvRing a => EuclideanRing a\n\ninstance EuclideanRing a => LinSolvRing (Pol a)        -- XXXX\ninstance CommutativeRing a => CommutativeRing (Pol a)\n\ndata Pol a = MkPol\n\nupLinSolvRing :: LinSolvRing a => a -> ()\nupLinSolvRing = undefined\n\nmoduloBasisx :: (LinSolvRing (Pol a), CommutativeRing a) => Pol a -> ()\nmoduloBasisx p = let x :: ()\n                     x = upLinSolvRing p\n                 in ()\n\n  -- This is very delicate!  The constraint (LinSolvRing (Pol a))\n  -- arises in the RHS of x, and we must be careful *not* to simplify\n  -- it with the instance declaration \"XXXX\", else we get the\n  -- unsatisfiable constraint (EuclideanRing a). In effect, the\n  -- given constraint in the type sig for moduleBasisx overlaps\n  -- with the top level declaration.\n\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleInstances, UndecidableInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\nmodule T4401 where\n\nclass Mul x y z | x y -> z\nclass IsType a\nclass IsType a => IsSized a s | a -> s\n\ndata Array n a = Array\ninstance IsSized a s => IsType (Array n a)\ninstance (IsSized a s, Mul n s ns) => IsSized (Array n a) ns\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards, RecursiveDo #-}\n{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}\n\nmodule TT where\n\ndata T = T {t1, t2 :: Int}\n\nf :: T -> Int\nf d = x\n    where T {t1 = x, ..} = d\n\ng :: T -> Int\ng (T {t1 = x, ..}) = x\n\n-- The fix to this test also affected the dorec checking code, hence this:\nh :: Maybe Int\nh = do\n    rec\n      T {t1 = x, ..} <- Just $ T 1 1\n    return x\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\nmodule Ambiguity where\n\nclass C1 a b | b -> a\nclass (C1 a b) => C2 a b where\n  foo :: b -> b\n\ndata A = A\ndata B = B\ninstance C1 A B \ninstance C2 A B where foo = error \"urk\"\n\n-- this is accepted by both 6.12.3 and 7  \nrunFoo1 :: C2 a b => b -> b  \nrunFoo1 = foo\n\n-- this is accepted by 6.12.3, but not by 7\nrunFoo2 :: B -> B\nrunFoo2 = foo\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- #4444: We shouldn't warn about SPECIALISE INLINE pragmas on\n--        non-overloaded functions\n\n{-# LANGUAGE GADTs, MagicHash #-}\nmodule Q where\n\nimport GHC.Exts\n\ndata Arr e where\n  ArrInt :: !Int -> ByteArray# -> Arr Int\n  ArrPair :: !Int -> Arr e1 -> Arr e2 -> Arr (e1, e2)\n\n(!:) :: Arr e -> Int -> e\n{-# SPECIALISE INLINE (!:) :: Arr Int -> Int -> Int #-}\n{-# SPECIALISE INLINE (!:) :: Arr (a, b) -> Int -> (a, b) #-}\n(ArrInt _ ba)     !: (I# i) = I# (indexIntArray# ba i)\n(ArrPair _ a1 a2) !: i      = (a1 !: i, a2 !: i)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, NoMonoLocalBinds, NoMonoPatBinds #-}\n\nmodule T4498 where\n\nf x = let !y = (\\v -> v) :: a -> a\n      in (y x, y 'T')\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE \n        GADTs,\n        TypeOperators,\n        ScopedTypeVariables,\n        RankNTypes,\n        NoMonoLocalBinds\n #-}\n{-# OPTIONS_GHC -O2 -w #-}\n{-\n  Copyright (C) 2002-2003 David Roundy\n\n  This program is free software; you can redistribute it and/or modify\n  it under the terms of the GNU General Public License as published by\n  the Free Software Foundation; either version 2, or (at your option)\n  any later version.\n\n  This program is distributed in the hope that it will be useful,\n  but WITHOUT ANY WARRANTY; without even the implied warranty of\n  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n  GNU General Public License for more details.\n\n  You should have received a copy of the GNU General Public License\n  along with this program; see the file COPYING.  If not, write to\n  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,\n  Boston, MA 02110-1301, USA.\n-}\n\nmodule T4524 where\n\nimport Data.Maybe ( mapMaybe )\nimport Control.Applicative ( Alternative(..) )\nimport Control.Monad ( MonadPlus(..), msum, ap, liftM )\nimport Unsafe.Coerce (unsafeCoerce)\n\nnewtype FileName = FN FilePath deriving ( Eq, Ord )\n\ndata FL a x z where\n    (:>:) :: a x y -> FL a y z -> FL a x z\n    NilFL :: FL a x x\ndata RL a x z where\n    (:<:) :: a y z -> RL a x y -> RL a x z\n    NilRL :: RL a x x\ndata (a1 :> a2) x y = forall z. (a1 x z) :> (a2 z y)\ninfixr 1 :>\ndata (a1 :< a2) x y = forall z. (a1 z y) :< (a2 x z)\ninfix 1 :<\ninfixr 5 :>:, :<:\n\ndata EqCheck a b where\n    IsEq :: EqCheck a a\n    NotEq :: EqCheck a b\n\nclass MyEq p => Invert p where\n    invert :: p x y -> p y x\n    identity :: p x x\n\nclass MyEq p where\n    unsafeCompare :: p a b -> p c d -> Bool\n    unsafeCompare a b = IsEq == (a =/\\= unsafeCoerceP b)\n\n    (=\\/=) :: p a b -> p a c -> EqCheck b c\n    a =\\/= b | unsafeCompare a b = unsafeCoerceP IsEq\n             | otherwise = NotEq\n\n    (=/\\=) :: p a c -> p b c -> EqCheck a b\n    a =/\\= b | IsEq == (a =\\/= unsafeCoerceP b) = unsafeCoerceP IsEq\n             | otherwise = NotEq\n\ninfix 4 =\\/=, =/\\=\n\nclass Commute p where\n    commute :: (p :> p) x y -> Maybe ((p :> p) x y)\n\ninstance (MyEq p, Commute p) => MyEq (FL p) where\ninstance (MyEq p, Commute p) => MyEq (RL p) where\ninstance Commute p => Commute (RL p) where\ninstance (Commute p, Invert p) => Invert (RL p) where\ninstance (Invert p, Commute p) => Invert (FL p) where\ninstance Eq (EqCheck a b) where\ninstance MyEq FilePatchType where\ninstance Invert Patch where\n\ninstance MyEq Patch where\n    unsafeCompare = eqPatches\n\neqPatches :: Patch x y -> Patch w z -> Bool\neqPatches (PP p1) (PP p2) = undefined\neqPatches (Merger _ _ p1a p1b) (Merger _ _ p2a p2b)\n = eqPatches p1a p2a &&\n   eqPatches p1b p2b\neqPatches (Regrem _ _ p1a p1b) (Regrem _ _ p2a p2b)\n = eqPatches p1a p2a &&\n   eqPatches p1b p2b\neqPatches _ _ = False\n\ndata Prim x y where\n    FP :: !FileName -> !(FilePatchType x y) -> Prim x y\n\ndata FilePatchType x y = FilePatchType\n                            deriving (Eq,Ord)\n\ndata Patch x y where\n    PP :: Prim x y -> Patch x y\n    Merger :: FL Patch x y\n           -> RL Patch x b\n           -> Patch c b\n           -> Patch c d\n           -> Patch x y\n    Regrem :: FL Patch x y\n           -> RL Patch x b\n           -> Patch c b\n           -> Patch c a\n           -> Patch y x\n\ndata Sealed a where\n    Sealed :: a x -> Sealed a\ndata FlippedSeal a y where\n    FlippedSeal :: !(a x y) -> FlippedSeal a y\n\nmapFlipped :: (forall x. a x y -> b x z) -> FlippedSeal a y -> FlippedSeal b z\nmapFlipped f (FlippedSeal x) = FlippedSeal (f x)\n\nheadPermutationsRL :: Commute p => RL p x y -> [RL p x y]\nheadPermutationsRL NilRL = []\nheadPermutationsRL (p:<:ps) =\n    (p:<:ps) : mapMaybe (swapfirstRL.(p:<:)) (headPermutationsRL ps)\n        where swapfirstRL (p1:<:p2:<:xs) = do p1':>p2' <- commute (p2:>p1)\n                                              Just $ p2':<:p1':<:xs\n              swapfirstRL _ = Nothing\n\nis_filepatch :: Prim x y -> Maybe FileName\nis_filepatch (FP f _) = Just f\nis_filepatch _ = Nothing\n\ntoFwdCommute :: (Commute p, Commute q, Monad m)\n             => ((p :< q) x y -> m ((q :< p) x y))\n             -> (q :> p) x y -> m ((p :> q) x y)\ntoFwdCommute c (x :> y) = do x' :< y' <- c (y :< x)\n                             return (y' :> x')\n\nunsafeUnseal :: Sealed a -> a x\nunsafeUnseal (Sealed a) = unsafeCoerceP1 a\n\nunsafeUnsealFlipped :: FlippedSeal a y -> a x y\nunsafeUnsealFlipped (FlippedSeal a) = unsafeCoerceP a\n\nunsafeCoerceP :: a x y -> a b c\nunsafeCoerceP = unsafeCoerce\n\nunsafeCoercePStart :: a x1 y -> a x2 y\nunsafeCoercePStart = unsafeCoerce\n\nunsafeCoercePEnd :: a x y1 -> a x y2\nunsafeCoercePEnd = unsafeCoerce\n\nunsafeCoerceP1 :: a x -> a y\nunsafeCoerceP1 = unsafeCoerce\n\ndata Perhaps a = Unknown | Failed | Succeeded a\n\ninstance Functor Perhaps where\n  fmap = liftM\n\ninstance Applicative Perhaps where\n  pure  = return\n  (<*>) = ap\n\ninstance  Monad Perhaps where\n    (Succeeded x) >>= k =  k x\n    Failed   >>= _      =  Failed\n    Unknown  >>= _      =  Unknown\n    Failed   >> _       =  Failed\n    (Succeeded _) >> k  =  k\n    Unknown  >> k       =  k\n    return              =  Succeeded\n    fail _              =  Unknown\n\ninstance Alternative Perhaps where\n  (<|>) = mplus\n  empty = mzero\n\ninstance  MonadPlus Perhaps where\n    mzero                 = Unknown\n    Unknown `mplus` ys    = ys\n    Failed  `mplus` _     = Failed\n    (Succeeded x) `mplus` _ = Succeeded x\n\ntoMaybe :: Perhaps a -> Maybe a\ntoMaybe (Succeeded x) = Just x\ntoMaybe _ = Nothing\n\ncleverCommute :: CommuteFunction -> CommuteFunction\ncleverCommute c (p1:<p2) =\n    case c (p1 :< p2) of\n    Succeeded x -> Succeeded x\n    Failed -> Failed\n\nspeedyCommute :: CommuteFunction\nspeedyCommute (p1 :< p2) -- Deal with common case quickly!\n    | p1_modifies /= Nothing && p2_modifies /= Nothing &&\n      p1_modifies /= p2_modifies = undefined\n    | otherwise = Unknown\n    where p1_modifies = isFilepatchMerger p1\n          p2_modifies = isFilepatchMerger p2\n\neverythingElseCommute :: MaybeCommute -> CommuteFunction\neverythingElseCommute _ x = undefined\n\nunsafeMerger :: String -> Patch x y -> Patch x z -> Patch a b\nunsafeMerger x p1 p2 = unsafeCoercePStart $ unsafeUnseal $ merger x p1 p2\n\nmergerCommute :: (Patch :< Patch) x y -> Perhaps ((Patch :< Patch) x y)\nmergerCommute (Merger _ _ p1 p2 :< pA)\n    | unsafeCompare pA p1 = Succeeded (unsafeMerger \"0.0\" p2 p1 :< unsafeCoercePStart p2)\n    | unsafeCompare pA (invert (unsafeMerger \"0.0\" p2 p1)) = Failed\nmergerCommute (Merger _ _\n                (Merger _ _ c b)\n                (Merger _ _ c' a) :<\n                Merger _ _ b' c'')\n    | unsafeCompare b' b && unsafeCompare c c' && unsafeCompare c c'' = undefined\nmergerCommute _ = Unknown\n\ninstance Commute Patch where\n    commute x = toMaybe $ msum\n                  [toFwdCommute speedyCommute x,\n                   toFwdCommute (cleverCommute mergerCommute) x,\n                   toFwdCommute (everythingElseCommute undefined) x\n                  ]\n\nisFilepatchMerger :: Patch x y -> Maybe FileName\nisFilepatchMerger (PP p) = is_filepatch p\nisFilepatchMerger (Regrem und unw p1 p2)\n    = isFilepatchMerger (Merger und unw p1 p2)\n\ntype CommuteFunction = forall x y. (Patch :< Patch) x y -> Perhaps ((Patch :< Patch) x y)\ntype MaybeCommute = forall x y. (Patch :< Patch) x y -> Maybe ((Patch :< Patch) x y)\n\n{- unwind, trueUnwind, reconcleUnwindings, and merger are most likely\n where the problem lies.  Everything above is just brought in to bring\n in enough context so that those four will compile. -}\nunwind :: Patch x y -> Sealed (RL Patch x) -- Recreates a patch history in reverse.\nunwind (Merger _ unwindings _ _) = Sealed unwindings\nunwind p = Sealed (p :<: NilRL)\n\ntrueUnwind :: Patch x y -> Sealed (RL Patch x) -- Recreates a patch history in reverse.\ntrueUnwind p@(Merger _ _ p1 p2) =\n    case (unwind p1, unwind p2) of\n    (Sealed (_:<:p1s),Sealed (_:<:p2s)) ->\n         Sealed (p :<: unsafeCoerceP p1 :<: unsafeUnsealFlipped (reconcileUnwindings p1s (unsafeCoercePEnd p2s)))\n\nreconcileUnwindings :: RL Patch x z -> RL Patch y z -> FlippedSeal (RL Patch) z\nreconcileUnwindings p1s NilRL = FlippedSeal p1s\nreconcileUnwindings (p1:<:_) (p2:<:_) =\n    case [undefined | p1s'@(_:<:_) <- headPermutationsRL (p1:<:undefined)] of\n    ((_:<:p1s', _:<:p2s'):_) ->\n        mapFlipped (undefined :<:) $ reconcileUnwindings p1s' (unsafeCoercePEnd p2s')\n\nmerger :: String -> Patch x y -> Patch x z -> Sealed (Patch y)\nmerger \"0.0\" p1 p2 = Sealed $ Merger undoit unwindings p1 p2\n    where fake_p = Merger identity NilRL p1 p2\n          unwindings = unsafeUnseal (trueUnwind fake_p)\n          p = undefined\n          undoit = undefined\n", "num_lines": 265}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeSynonymInstances #-}\n{-# OPTIONS_GHC -fwarn-orphans #-}\nmodule T4912 where\n\nimport T4912a\n\n\ntype OurData = TheirData\n\ninstance Foo TheirData where\n     foo = id\n\ninstance Bar OurData where\n     bar _ = \"Ours\"\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T4912a where\n\ndata TheirData = TheirData\n\nclass Foo a where\n     foo :: a -> a\n\nclass Bar a where\n    bar :: a -> String\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ScopedTypeVariables, EmptyDataDecls, RankNTypes #-}\n\nmodule T4917 where\n\n-- only works on ghc6 but not on ghc7\ntype Const a b = a\n\nnewtype Fix f n = In { out :: f (Fix f) n }\n\nmcata :: forall f a b .\n         (forall x c . (forall d . x d -> Const b d) -> f x c -> Const b c)\n      -> Fix f a -> Const b a\nmcata f x = f {- x=(Fix f), c=a -} mcataf outx\n  where\n    outx :: f (Fix f) a\n    outx = out x\n\n    mcataf :: forall d. Fix f d -> Const b d\n    mcataf y = mcata {- f=f, a=d, b=b0 -} f (y :: Fix f d)\n    -- Const b d ~ Const b0 d\n    -- Expected type of f :: forall x c. (forall d. x d -> Const b0 d) -> f x c -> Const b0 c\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE UndecidableInstances,\n             MultiParamTypeClasses,\n             KindSignatures,\n             FlexibleInstances,\n             FunctionalDependencies #-}\n\nmodule Storage.Hashed.Monad () where\n\nimport Control.Applicative (Applicative(..))\nimport Data.Kind (Type)\n\nclass Monad m => TreeRO m where\n    withDirectory :: (MonadError e m) => Int -> m a -> m a\n    expandTo :: (MonadError e m) => Int -> m Int\n\ninstance (Monad m, MonadError e m) => TreeRO (M m) where\n    expandTo = undefined\n    withDirectory dir _ = do\n      _ <- expandTo dir\n      undefined\n\ndata M (m :: Type -> Type) a\n\ninstance Functor (M m) where\n    fmap = undefined\n\ninstance Applicative (M m) where\n    pure = undefined\n    (<*>) = undefined\n\ninstance Monad m => Monad (M m) where\n    (>>=) = undefined\n    return = undefined\n\ninstance MonadError e m => MonadError e (M m)\n\nclass Monad m => MonadError e m | m -> e\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -w -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleContexts, FlexibleInstances,\n             OverlappingInstances, UndecidableInstances,\n             KindSignatures #-}\n\n-- Cut down from a larger core-lint error\n\nmodule Q where\n\nimport Control.Monad (foldM, liftM, ap)\n\ndata NameId = NameId\ndata Named name a = Named\ndata Arg e  = Arg\n\ndata Range = Range\ndata Name = Name\ndata ALetBinding = ALetBinding\ndata APattern a = APattern\ndata CExpr = CExpr\ndata CPattern = CPattern\ndata NiceDeclaration = QQ\ndata TypeError = NotAValidLetBinding NiceDeclaration  \ndata TCState = TCSt { stFreshThings :: FreshThings }  \ndata FreshThings = Fresh\n\nnewtype NewName a = NewName a\nnewtype LetDef = LetDef NiceDeclaration  \nnewtype TCMT (m :: * -> *) a = TCM ()\n\nlocalToAbstract :: ToAbstract c a => c -> (a -> TCMT IO b) -> TCMT IO b  \nlocalToAbstract = undefined\n\ntypeError :: MonadTCM tcm => TypeError -> tcm a  \ntypeError = undefined\n\nlhsArgs :: [Arg (Named String CPattern)]  \nlhsArgs = undefined\n\nfreshNoName :: (MonadState s m, HasFresh NameId s) => Range -> m Name  \nfreshNoName = undefined\n\nclass (Monad m) => MonadState s m | m -> s  \nclass (Monad m) => MonadIO m\n\nclass ToAbstract concrete abstract | concrete -> abstract where\n    toAbstract :: concrete -> TCMT IO abstract\n\nclass (MonadState TCState tcm) => MonadTCM tcm where\n    liftTCM :: TCMT IO a -> tcm a\n\nclass HasFresh i a where\n    nextFresh :: a -> (i,a)\n\ninstance ToAbstract c a => ToAbstract [c] [a] where  \ninstance ToAbstract c a => ToAbstract (Arg c) (Arg a) where  \ninstance ToAbstract c a => ToAbstract (Named name c) (Named name a) where  \ninstance ToAbstract CPattern (APattern CExpr) where\n\ninstance ToAbstract LetDef [ALetBinding] where\n    toAbstract (LetDef d) = do _ <- letToAbstract\n                               undefined\n        where letToAbstract = do\n                  localToAbstract lhsArgs $ \\args ->\n                          foldM lambda undefined (undefined :: [a])\n              lambda _ _ = do x <- freshNoName undefined\n                              return undefined\n              lambda _ _ = typeError $ NotAValidLetBinding d\n\ninstance HasFresh NameId FreshThings where\n    nextFresh = undefined\n\ninstance HasFresh i FreshThings => HasFresh i TCState where\n    nextFresh = undefined\n\ninstance Monad m => MonadState TCState (TCMT m) where\n\ninstance Monad m => MonadTCM (TCMT m) where\n    liftTCM = undefined\n\ninstance Functor (TCMT m) where\n  fmap = liftM\n\ninstance Applicative (TCMT m) where\n  pure  = return\n  (<*>) = ap\n\ninstance Monad (TCMT m) where\n    return = undefined\n    (>>=) = undefined\n    fail = undefined\n\ninstance Monad m => MonadIO (TCMT m) where\n\n", "num_lines": 96}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests pattern bindings that are generalised\n\nmodule T5032 where\n\nid1 :: a -> a\n(id1) = id\n\nfoo = (id1 True, id1 'x')\n\ng :: a -> a\nh :: a -> a\n(g, h) = (\\x -> x, \\y -> y)\n\ntoo = (g (h True), g (h 'x'))\n\n-- No type signature necessary; \n-- the MR only strikes when overloading is involved\n[id3] = [id]\n\nnoo = (id3 True, id3 'x')\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\n\nmodule Test where\n\nclass C t where\n    type TF t\n    ttt :: TF t -> t\n\nb :: (C t, ?x :: TF t) => t\nb = ttt ?x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}\nmodule T5481 where\n\nclass Foo a b where\n    type X a\n    type X a = b\n    type Y b\n    type Y b = a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule T5514 where\n\nclass Foo a where\n        foo :: a -> a\n\ninstance (Foo a, Foo b) => Foo (a, b) where\n        foo = foo' ()\n\n-- foo' :: () -> b -> b\nfoo' es = const id (unitId es)\n\nunitId :: () -> ()\nunitId = id\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, KindSignatures #-}\n\nmodule TcShouldTerminate where\n\nimport Data.Kind (Constraint)\n\nclass C (p :: Constraint)\nclass D (p :: Constraint)\n\ninstance C (D p) => C (D (D p))\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax, RankNTypes, TypeFamilies #-}\nmodule T5595 where\n\nimport Data.Kind (Type)\n\nclass MonadTransControl t where\n  type St t :: Type \u00e2\u2020\u2019 Type\n\n  liftControl :: Monad m =>(Run t \u00e2\u2020\u2019 m a) \u00e2\u2020\u2019 t m a\n\n  restore :: Monad o => St t y \u00e2\u2020\u2019 t o y\n\ntype Run t = forall n b. Monad n => t n b \u00e2\u2020\u2019 n (St t b)\n\nfoo :: (Monad m, MonadTransControl t) => (Run t -> m a) -> t m a\nfoo f = liftControl f\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses\n            ,FunctionalDependencies\n            ,FlexibleContexts #-}\n\nmodule T5643 where\n\nimport Prelude ()\n\nclass FoldableLL a b | a -> b\n\nclass FoldableLL full item => ListLike full item | full -> item where\n    \n    cons :: item -> full -> full\n    head :: full -> item\n    tail :: full -> full \n\n    init :: full -> full\n    init l = cons (head l) (init xs)\n        where xs = tail l\n              \n-- Deriveds from the functional dependencies were escaping in the Wanted\n-- constraints and emitWantedCts was giving a panic error.\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs, ConstraintKinds, RankNTypes #-}\nmodule T5655 where\n\nimport Data.Kind (Type, Constraint)\n\nclass Show a => Twice a where twice :: a -> a\n\ninstance Twice Int where twice = (*2)\n\ndata ETwice where ETwice :: Twice a => a -> ETwice\n\nclass E e where\n    type C e :: Type -> Constraint\n    ap :: (forall a. C e a => a -> r) -> e -> r\n\ninstance E ETwice where\n    type C ETwice = Twice\n    ap f (ETwice a) = f a\n\nf :: (E e, C e ~ Twice) => e -> ETwice\nf = ap (ETwice . twice)\n\nfoo :: ETwice\nfoo = ETwice (5 :: Int)\n\nbar :: IO ()\nbar = ap print (f foo)\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ScopedTypeVariables, InstanceSigs #-}\nmodule Foo where\n\ndata T a = T a\n\nclass C a where\n  foo :: b -> a -> (a, [b])\n\ninstance C a => C (T a) where\n  foo :: forall b. b -> T a -> (T a, [b])\n  foo x (T y) = (T y, xs)\n     where\n       xs :: [b]\n       xs = [x,x,x]\n\ninstance Functor T where\n  fmap :: (a -> b) -> T a -> T b\n  fmap f (T x) = T (f x)\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}\n\nmodule T5792 where\n\n\ndata T = TT\ntype family Compare (m :: T) :: Ordering  \ntype instance Compare TT = Compare TT\n\ntype Compare' a = Compare a\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, FlexibleInstances, ScopedTypeVariables, TypeFamilies #-}\n\nmodule T6011 where\n\nimport Data.Kind (Type)\n\ndata family GenMod :: Modulus Type -> Type -> Type\n\ntype Mod n = GenMod (FiniteRing n) Integer\n\ndata Modulus n = FiniteRing n\n\ndata instance GenMod (FiniteRing n) Integer = Mod Integer Integer\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds                 #-}\n{-# LANGUAGE MultiParamTypeClasses     #-}\n{-# LANGUAGE PolyKinds                 #-}\n{-# LANGUAGE TypeFamilyDependencies     #-}\n{-# LANGUAGE UndecidableInstances      #-}\n{-# LANGUAGE ScopedTypeVariables       #-}\n{-# LANGUAGE NoMonomorphismRestriction #-}\n\nmodule T6018 where\n\n{-\nbarapp2 :: Int\nbarapp2 = bar 1\n\nbar :: Bar a -> Bar a\nbar x = x\n\ntype family Bar a = r | r -> a where\n    Bar Int  = Bool\n    Bar Bool = Int\n    Bar Bool = Char\n\ntype family F a b c = (result :: k) | result -> a b c\n\ntype family FClosed a b c = result | result -> a b c where\n    FClosed Int  Char Bool = Bool\n    FClosed Char Bool Int  = Int\n    FClosed Bool Int  Char = Char\n-}\n{-\ng6_use :: [Char]\ng6_use = g6_id \"foo\"\n\ng6_id :: G6 a -> G6 a\ng6_id x = x\n\ntype family G6 a = r | r -> a\ntype instance G6 [a]  = [Gi a]\ntype family Gi a = r | r -> a\ntype instance Gi Int = Char\n-}\n\nimport Data.Kind (Type)\nimport T6018a -- defines G, identical to F\n\ntype family F a b c = (result :: k) | result -> a b c\ntype instance F Int  Char Bool = Bool\ntype instance F Char Bool Int  = Int\ntype instance F Bool Int  Char = Char\n\n\ntype instance G Bool Int  Char = Char\n\ntype family I (a :: k) b (c :: k) = r | r -> a b\ntype instance I Int  Char Bool = Bool\ntype instance I Int  Char Int  = Bool\ntype instance I Bool Int  Int  = Int\n\n-- this is injective - a type variable introduced in the LHS is not mentioned on\n-- RHS but we don't claim injectivity in that argument.\ntype family J a (b :: k) = r | r -> a\ntype instance J Int b = Char\n\ntype MaybeSyn a = Maybe a\nnewtype MaybeNew a = MaybeNew (Maybe a)\n\n-- make sure we look through type synonyms...\ntype family K a = r | r -> a\ntype instance K a = MaybeSyn a\n\n-- .. but not newtypes\ntype family M a = r | r -> a\ntype instance M (Maybe a)    = MaybeSyn a\ntype instance M (MaybeNew a) = MaybeNew a\n\n-- Closed type families\n\n-- these are simple conversions from open type families. They should behave the\n-- same\ntype family FClosed a b c = result | result -> a b c where\n    FClosed Int  Char Bool = Bool\n    FClosed Char Bool Int  = Int\n    FClosed Bool Int  Char = Char\n\ntype family IClosed (a :: Type) (b :: Type) (c :: Type) = r | r -> a b where\n    IClosed Int  Char Bool = Bool\n    IClosed Int  Char Int  = Bool\n    IClosed Bool Int  Int  = Int\n\ntype family JClosed a (b :: k) = r | r -> a where\n    JClosed Int b = Char\n\ntype family KClosed a = r | r -> a where\n    KClosed a = MaybeSyn a\n\n-- Here the last equation might return both Int and Char but we have to\n-- recognize that it is not possible due to equation overlap\ntype family Bak a = r | r -> a where\n     Bak Int  = Char\n     Bak Char = Int\n     Bak a    = a\n\n-- This is similar, except that the last equation contains concrete type.  Since\n-- it is overlapped it should be dropped with a warning\ntype family Foo a = r | r -> a where\n    Foo Int  = Bool\n    Foo Bool = Int\n    Foo Bool = Bool\n\n-- this one was tricky in the early implementation of injectivity.  Now it is\n-- identical to the above but we still keep it as a regression test.\ntype family Bar a = r | r -> a where\n    Bar Int  = Bool\n    Bar Bool = Int\n    Bar Bool = Char\n\n-- Now let's use declared type families. All the below definitions should work\n\n-- No ambiguity for any of the arguments - all are injective\nf :: F a b c -> F a b c\nf x = x\n\n-- From 1st instance of F: a ~ Int, b ~ Char, c ~ Bool\nfapp :: Bool\nfapp = f True\n\n-- now the closed variant of F\nfc :: FClosed a b c -> FClosed a b c\nfc x = x\n\nfcapp :: Bool\nfcapp = fc True\n\n-- The last argument is not injective so it must be instantiated\ni :: I a b Int -> I a b Int\ni x = x\n\n-- From 1st instance of I: a ~ Int, b ~ Char\niapp :: Bool\niapp = i True\n\n-- again, closed variant of I\nic :: IClosed a b Int -> IClosed a b Int\nic x = x\n\nicapp :: Bool\nicapp = ic True\n\n-- Now we have to test weird closed type families:\nbak :: Bak a -> Bak a\nbak x = x\n\nbakapp1 :: Char\nbakapp1 = bak 'c'\n\nbakapp2 :: Double\nbakapp2 = bak 1.0\n\nbakapp3 :: ()\nbakapp3 = bak ()\n\nfoo :: Foo a -> Foo a\nfoo x = x\n\nfooapp1 :: Bool\nfooapp1 = foo True\n\nbar :: Bar a -> Bar a\nbar x = x\n\nbarapp1 :: Bool\nbarapp1 = bar True\n\nbarapp2 :: Int\nbarapp2 = bar 1\n\n-- Declarations below test more liberal RHSs of injectivity annotations:\n-- permiting variables to appear in different order than the one in which they\n-- were declared.\ntype family H a b = r | r -> b a\ntype family Hc a b = r | r -> b a where\n  Hc a b = a b\nclass Hcl a b where\n  type Ht a b = r | r -> b a\n\n-- repeated tyvars in the RHS of injectivity annotation: no warnings or errors\n-- (consistent with behaviour for functional dependencies)\ntype family Jx a b = r | r -> a a\ntype family Jcx a b = r | r -> a a where\n  Jcx a b = a b\nclass Jcl a b where\n  type Jt a b = r | r -> a a\n\ntype family Kx a b = r | r -> a b b\ntype family Kcx a b = r | r -> a b b where\n  Kcx a b = a b\nclass Kcl a b where\n  type Kt a b = r | r -> a b b\n\n-- Declaring kind injectivity. Here we only claim that knowing the RHS\n-- determines the LHS kind but not the type.\ntype family L (a :: k1) = (r :: k2) | r -> k1 where\n    L 'True  = Int\n    L 'False = Int\n    L Maybe  = 3\n    L IO     = 3\n\ndata KProxy (a :: Type) = KProxy\ntype family KP (kproxy :: KProxy k) = r | r -> k\ntype instance KP ('KProxy :: KProxy Bool) = Int\ntype instance KP ('KProxy :: KProxy Type) = Char\n\nkproxy_id :: KP ('KProxy :: KProxy k) -> KP ('KProxy :: KProxy k)\nkproxy_id x = x\n\nkproxy_id_use = kproxy_id 'a'\n\n-- Now test some awkward cases from The Injectivity Paper.  All should be\n-- accepted.\ntype family Gx a\ntype family Hx a\ntype family Gi a = r | r -> a\ntype instance Gi Int = Char\ntype family Hi a = r | r -> a\n\ntype family F2 a = r | r -> a\ntype instance F2 [a]       = [Gi a]\ntype instance F2 (Maybe a) = Hi a -> Int\n\ntype family F4 a = r | r -> a\ntype instance F4 [a]       = (Gx a, a,   a,    a)\ntype instance F4 (Maybe a) = (Hx a, a, Int, Bool)\n\ntype family G2 a b = r | r -> a b\ntype instance G2 a    Bool = (a, a)\ntype instance G2 Bool b    = (b, Bool)\n\ntype family G6 a = r | r -> a\ntype instance G6 [a]  = [Gi a]\ntype instance G6 Bool = Int\n\ng6_id :: G6 a -> G6 a\ng6_id x = x\n\ng6_use :: [Char]\ng6_use = g6_id \"foo\"\n\n-- A sole exception to \"bare variables in the RHS\" rule\ntype family Id (a :: k) = (result :: k) | result -> a\ntype instance Id a = a\n\n-- This makes sure that over-saturated type family applications at the top-level\n-- are accepted.\ntype family IdProxy (a :: k) b = r | r -> a\ntype instance IdProxy a b = (Id a) b\n\n-- make sure we look through type synonyms properly\ntype IdSyn a = Id a\ntype family IdProxySyn (a :: k) b = r | r -> a\ntype instance IdProxySyn a b = (IdSyn a) b\n\n-- this has bare variable in the RHS but all LHS variables are also bare so it\n-- should be accepted\ntype family Fa (a :: k) (b :: k) = (r :: k2) | r -> k\ntype instance Fa a b = a\n\n-- Taken from #9587. This exposed a bug in the solver.\ntype family Arr (repr :: Type -> Type) (a :: Type) (b :: Type)\n  = (r :: Type) | r -> repr a b\n\nclass ESymantics repr where\n    int :: Int  -> repr Int\n    add :: repr Int  -> repr Int -> repr Int\n\n    lam :: (repr a -> repr b) -> repr (Arr repr a b)\n    app :: repr (Arr repr a b) -> repr a -> repr b\n\nte4 = let c3 = lam (\\f -> lam (\\x -> f `app` (f `app` (f `app` x))))\n      in (c3 `app` (lam (\\x -> x `add` int 14))) `app` (int 0)\n\n-- This used to fail during development\nclass Manifold' a where\n    type Base  a = r | r -> a\n    project :: a -> Base a\n    unproject :: Base a -> a\n\nid' :: forall a. ( Manifold' a ) => Base a -> Base a\nid' = project . unproject\n", "num_lines": 289}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\n\nmodule T6018a where\n\nimport Data.Kind (Type)\nimport {-# SOURCE #-} T6018 -- test support for hs-boot files\n\ntype family G a b c = (result :: Type) | result -> a b c\ntype instance G Int  Char Bool = Bool\ntype instance G Char Bool Int  = Int\n\ntype instance F Bool Int  Char = Char\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE EmptyDataDecls #-}\nmodule T6055 where\n\ndata Int1  = Int1\ndata Word1 = Word1\n\ndata D1\ndata D2\n\n\nclass Succ x y | x -> y\ninstance Succ D1 D2\n\n\nclass Add' x y z | x y -> z\n\ninstance Succ y z => Add' D1 y z\n\n\nclass (Add' x y z) => Add x y z | x y -> z\ninstance (Add' D1 y z) => Add D1 y z\n-- Weird test case: (Add' D1 y z) is simplifiable\n\nclass IsSized a s | a -> s where\n\ninstance IsSized Int1  D1\ninstance IsSized Word1 D1\n\ninstance (IsSized a s, Add s s ns) =>\n   IsSized (Pair a) ns where\n\ndata Pair a = Pair a a\n\n\nswitchFPPred ::\n   (IsSized v0 s, IsSized v1 s) =>\n   v0 -> v1\nswitchFPPred = undefined\n\ncmpss :: Pair Word1 -> Pair Int1\ncmpss = switchFPPred\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FunctionalDependencies #-}\n\nmodule T6134 where\n\nclass C a b | a -> b \n\nf :: C Int b => Int -> Int\nf = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T700 where\n\n-- These two should behave the same way\n\nf,g :: (forall a. Maybe a) -> (forall a. a)\n\nf x = case x of Just y -> y\ng (Just y) = y\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7050 where\n\ndata Foo a = Foo {-# UNPACK #-} !(Foo a) \n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\nmodule Prog where\n\nclass AddName i d | d->i where \n  addName :: d -> d\n\nclass Rec rec struct | rec->struct where\n  mapRec :: (struct->struct) -> rec -> rec\n\n-- We got a very bogus siguature for addNameRec in thc 7.6rc1\n-- addNameRec :: forall rec struct.\n--                Recursive.Rec rec struct\n--                -> DefinedNames.AddName (GHC.Prim.Any *) struct\n--                -> rec\n--                -> rec\n\naddNameRec x = mapRec addName x\n\ninstance AddName Int Bool where\n  addName = error \"urk\"\ninstance AddName Float Char where\n  addName = error \"urk\"\n\ninstance Rec Char Bool where\n  mapRec = error \"urk\"\ninstance Rec Bool Char where\n  mapRec = error \"urk\"\n\n\nfoo1 :: Char -> Char\nfoo1 = addNameRec \n\nfoo2 :: Bool -> Bool\nfoo2 = addNameRec \n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-#OPTIONS_GHC -Wpartial-fields #-}\n{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GADTs #-}\n\n\nmodule T7196 where\n\ndata T a = A\n  { m1  :: a\n  , m2  :: a\n  , _m3 :: a\n  } | B\n  {\n    m1 :: a\n  }\n\npattern P{x} = x\n\ndata family F a\ndata instance F a where\n  F1 :: { f1 :: Int } -> F Int\n  F2 :: { f2 :: Int } -> F Char\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies #-}  {-# LANGUAGE FlexibleInstances #-}\n\nmodule T7171 where\n\nimport T7171a\nimport Data.ByteString\n\n-- this works\n-- test1 :: [Int] -> [Int]\n-- test1 = test\n\n-- this fails\ntest2 :: ByteString -> ByteString\ntest2 = test\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FunctionalDependencies #-}  {-# LANGUAGE FlexibleInstances #-}\n\nmodule T7171a where\n\nimport Data.ByteString as B\nimport Data.Word\n\nclass Foo a b | a -> b\n\nclass (Foo a b) => Bar a b | a -> b\n\ninstance Foo [a] a\ninstance Bar [a] a\ninstance Foo ByteString Word8\ninstance Bar ByteString Word8\n\ntest :: Bar full item => full -> full\ntest inp = inp\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7173 where\n\n\n-- se and sb are mutually recursive\n--   se takes a numeric parameter (which it ignores)\n--   sb passes it a constant 10\n--\n-- so sb :: Num a => ...type not involving a...\n--\n-- So the ambiguity check must default ambiguous p, \n-- rather than complaining that sb is ambiguous.\n\nshowEnv' env t = se 10 env t \n where\n   se p env (Bind n b sc) = sb env n b\n   sb env n t             = se 10 env t\n\ndata TT n = Bind n (TT n) (TT n)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Patch (qc_prim) where\n\nimport Data.Kind (Type)\n\nclass PrimPatch (prim :: Type -> Type -> Type)\n\nclass PrimPatch (PrimOf p) => PrimPatchBase p where\n    type PrimOf (p :: Type -> Type -> Type) :: Type -> Type -> Type\n\ntype TestGenerator thing gen = (forall t ctx . (forall xx yy . thing xx yy -> t) -> (gen ctx -> t))\n\ntype family ModelOf (patch :: Type -> Type -> Type) :: Type -> Type\n\ndata WithState s p x y = WithState {\n                              _wsStartState :: s x\n                            , _wsPatch      :: p x y\n                            , _wsEndState   :: s y\n                            }\n\narbitraryThing :: x -> TestGenerator thing (thing x)\narbitraryThing _ f p = f p\n\nqc_prim :: forall prim x y .\n           (PrimPatch prim\n           , PrimOf prim ~ prim\n           ) => prim x y -> [()]\nqc_prim _ =\n  concat\n  [\n   patch_repo_properties      (undefined :: prim x a)    \"arbitrary\"    arbitraryThing'\n  ]\n      where arbitraryThing' = arbitraryThing (undefined :: a)\n\npatch_repo_properties :: p x y -> String -> TestGenerator (WithState (ModelOf (PrimOf p)) p) gen -> [()]\npatch_repo_properties _ _genname _gen = undefined\n\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Test2 where\n\nclass C a b | b -> a\n\ndata A = A\ndata X a = X\ndata Y = Y\n\ntype family TF b\n\nf :: (forall b. (C a b, TF b ~ Y) => b) -> X a\nf _ = undefined\n\nu :: (C A b, TF b ~ Y) => b\nu = undefined\n\nv :: X A\nv = (f :: (forall b. (C A b, TF b ~ Y) => b) -> X A) u -- This line causes an error (see below)\n\n{-\nGHC 7.6.1-rc1 (7.6.0.20120810) rejects this code with the following error message.\n\nTest2.hs:24:52:\n    Couldn't match expected type `Y'\n                with actual type `TF (forall b. (C A b, TF b ~ Y) => b)'\n    In the first argument of `f ::\n                                (forall b. (C A b, TF b ~ Y) => b) -> X', namely\n      `u'\n    In the expression: (f :: (forall b. (C A b, TF b ~ Y) => b) -> X) u\n    In an equation for `v':\n        v = (f :: (forall b. (C A b, TF b ~ Y) => b) -> X) u\n\nGHC 7.4.1 rejected this code with a different error message:\n\nTest2.hs:24:6:\n    Cannot deal with a type function under a forall type:\n    forall b. (C A b, TF b ~ Y) => b\n    In the expression: f :: (forall b. (C A b, TF b ~ Y) => b) -> X\n    In the expression: (f :: (forall b. (C A b, TF b ~ Y) => b) -> X) u\n    In an equation for `v':\n        v = (f :: (forall b. (C A b, TF b ~ Y) => b) -> X) u\n-}", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule T7220a where\n\nclass C a b | b -> a\n\ndata X = X\ndata Y = Y\n\ntype family TF b\n\nf :: (forall b. (C a b, TF b ~ Y) => b) -> X\n-- This type is really ambiguous\n-- GHC 7.8 didn't detect that, and accepted the type, but would fail\n-- when given    g :: <the same type>\n--               g x = f x\n-- But it would succeed if you said just\n--               g = f\n-- Now we fail in all ways!\n\nf _ = undefined\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonoLocalBinds, NoMonomorphismRestriction, RankNTypes #-}\nmodule T7268 where\n\ndata X = X { a :: forall a . a -> Bool }\n\nida :: forall b. b -> Bool\nX { a = ida } = error \"urk\"\n\nbar :: c -> Bool\nbar = ida\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7312 where\n\n-- this works\nmac :: Double -> (Double->Double) -> (Double-> Double)\nmac ac m = \\ x -> ac + x * m x\n\n-- this doesn't\nmac2 :: Double -> (->) Double Double -> (->) Double Double\nmac2 ac m = \\ x -> ac + x * m x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies, PolyKinds #-}\n\nmodule T7384 where\n\nclass Baz a b | a -> b where\n   bar :: a -> ()\n\ninstance Baz Bool Bool where\n   bar _ = ()\n\nfoo = bar False\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall -Werror#-}\nmodule T7408 (Context, mkContext) where\nimport Foreign\n\nnewtype Context = Context (Ptr ())\nforeign import ccall mkContext :: IO Context\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6117a where\n\n-- Tests that Lint does not complain about\n-- a mis-match between * and Constraint\n\nclass B a where\n     b :: a\n\nnewtype Additive a = Additive a\n\ninstance B a => B (Additive a) where\n    b = Additive b\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, DataKinds, PolyKinds, KindSignatures, GADTs #-}\nmodule T7503a where\n    import Data.Kind\n    import GHC.Exts hiding (Any)\n\n    data WrappedType = forall a. WrapType a\n\n    data A :: WrappedType -> Type where\n        MkA :: forall (a :: Type). AW a -> A (WrapType a)\n\n    type AW  (a :: k) = A (WrapType a)\n    type AW' (a :: k) = A (WrapType a)\n\n    class C (a :: k) where\n        aw :: AW a -- workaround: AW'\n\n    instance C [] where\n        aw = aw\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE FlexibleContexts, Rank2Types #-}\n\nmodule Test where\n\ntype Constrained x y r = (Eq x, Eq y) => x -> y -> r\n\nf :: Constrained String String ()\n-- Weird test case: (Eq String, Eq String) is simplifiable\nf = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7562 where\n\ndata Pair2 = Pair2 {-# UNPACK #-} Int\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule T7641 where\n\ndata Foo b = Foo deriving Show\n\nclass ToFoo a b where\n    toFoo :: a -> Foo b\n\ninstance ToFoo (c -> ()) b where\n    toFoo _ = Foo\n\nbaz () = toFoo $ \\_ -> ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, TypeFamilies #-}\n\nmodule T7643 where\n\nimport GHC.Exts\n\ntype family T\ntype instance T = RealWorld\n\nfoo :: () -> State# T\nfoo _ = unsafeCoerce# realWorld#\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule T7827 where\n\nbug :: a -> ()\nbug ((_ :: a) :: a) = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n{-# LANGUAGE\n     FlexibleContexts\n   , FlexibleInstances\n   , FunctionalDependencies\n   , MultiParamTypeClasses\n   , KindSignatures\n   , UndecidableInstances #-}\n\nmodule T7875 where\n\nimport Data.Kind (Type)\n\nclass Het a b | a -> b where\n  het :: m (f c) -> a -> m b\n\nclass GHet (a :: Type -> Type) (b :: Type -> Type) | a -> b\ninstance            GHet (K a) (K [a])\ninstance Het a b => GHet (K a) (K b)\n\n\ndata A a   = A (A a)\ndata K x a = K x\n\ninstance Het (A a) (A [a]) where het = het1\n\nhet1 :: (GHet (K a) (K b)) => m (f c) -> a -> m b\n-- Weird test case: (GHet (K a) (K b)) is simplifiable\nhet1 = undefined\n\n\n{- Wanted\n     (GHet (K (A a)) (K (A [a])))\n\n-- Fundeps give ([A a] ~ A [a])\n-}\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, MagicHash #-}\n\nmodule T7888 where\nimport GHC.Err( undefined )\nimport GHC.Prim\n\n{- The fix for #11431 makes this no longer work. But it shouldn't really,\nwithout impredicativity.\nf :: (forall a. a) -> b\nf = undefined\n-}\n\n-- this still had better work, though!\ng :: Int -> Int#\ng _ = undefined\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -O #-}    -- -O casused a Lint error in the simplifier, so I'm putting that in\n                          -- all the time, so we don't miss it in a fast validate\n\nmodule T7891 where\n\nimport Data.Kind (Type)\n\nnewtype T = T (forall t. t -> t)\n\ntf :: T\ntf = T id\n\n-- Can't write this type signature:\nf :: t -> t\nT f = tf\n\n-- But with an indirection we can:\ng :: t -> t\ng = f\n\n-- We can still use f as it were fully polymorphic (which is good):\na :: ()\na = f ()\nb :: Char\nb = f 'b'\n\n-------------\n\nclass C t where\n  data F t :: Type\n  mkF :: t -> F t\n\ninstance C () where\n  data F () = FUnit (forall t. t -> t)\n  mkF () = FUnit id\n\n-- Can't write a type for f here either:\nk :: t -> t\nFUnit k = mkF ()\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE KindSignatures #-}\n\nmodule T7903 where\n\nimport Data.Kind (Type)\n\ninstance Eq (((->) a :: Type -> Type) b)\ninstance (Ord b) => Ord (((->) a) b)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances, AllowAmbiguousTypes #-}\n\nmodule T8392 where\n\nclass Fun f a b where\n    fun :: f -> a -> b\n\ninstance (b ~ Int, a ~ Int) => Fun F a b\n    where fun _ = (+1)\n\ndata F = F\n\ndata Compose a b = Compose a b\n\n-- ghc-7.6 version\ninstance (Fun f b c, Fun g a b) => Fun (Compose f g) a c where\n    fun (Compose f g) a = fun f (fun g a :: b)", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\nmodule T8474 where\n\ndata D = D Int deriving Show\n\n-- In 7.7 this took exponential time!\nslow_to_compile :: IO ()\nslow_to_compile = do\n  tst1 <- return 1\n\n  let ?tst1 = tst1\n{-\n  let ?tst2 = tst1\n  let ?tst3 = tst1\n  let ?tst4 = tst1\n  let ?tst5 = tst1\n  let ?tst6 = tst1\n  let ?tst7 = tst1\n-}\n\n  print $ D ?tst1", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n\nmodule T8555 where\nimport Data.Coerce\n\nfoo :: Coercible [a] [b] => a -> b\nfoo = coerce\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\nmodule Tagged where\n\nnewtype Tagged s b = Tagged b deriving Eq\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, GeneralizedNewtypeDeriving, ImpredicativeTypes #-}\nmodule Foo where\n\nclass C a where op :: (forall b. b -> a) -> a\n\nnewtype T x = MkT x deriving( C )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, RankNTypes, GADTs #-}\nmodule T8644 where\n\ndata Dict c where Dict :: c => Dict c\n\nfoo :: Dict c -> (c => r) -> r\nfoo Dict x = x\n\nbar :: Dict ()\nbar = Dict\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\nimport GHC.Exts\n\ngo :: () -> Int#\ngo () = 0#\n\nmain = print (I# (go $ ()))\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\nmodule T8762 where\n\ntype Ty a = Int\n\nbug :: Ty a -> (# Ty a, () #)\nbug ty = (# ty, () #)\n\nfoo = let (# a, b #) = bug undefined\n      in ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n\nmodule T8555 where\nimport Data.Coerce\n\nfoo :: Coercible a b => b -> a\nfoo = coerce\n\nbar :: (Coercible a b, Coercible b c) => b -> c -> a\nbar b c = coerce c\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, RankNTypes, PolyKinds #-}\nmodule T8856 where\n\nimport Data.Proxy\n\nfoo = (undefined :: Proxy a) :: forall a. Proxy a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n\n-- Also see Note [Order of Coercible Instances]\n\nmodule T9117 where\n\nimport Data.Coerce\n\nnewtype Phant a = MkPhant Char\ntype role Phant representational\n\nex1 :: Phant Bool\nex1 = coerce (MkPhant 'x' :: Phant Int)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9117_2 where\n\n\nimport Data.Coerce\n\nnewtype Foo a = Foo (Foo a)\nnewtype Age = MkAge Int\n\nex1 :: (Foo Age) -> (Foo Int)\nex1 = coerce\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9117_3 where\n\nimport Data.Type.Coercion\nimport Data.Coerce\n\neta :: Coercible f g => Coercion (f a) (g a)\neta = Coercion\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, UndecidableInstances #-}\n\nmodule T9151 where\n\nimport Data.Proxy\n\nclass PEnum (kproxy :: KProxy a) where\n  type ToEnum (x :: a) :: Bool\n  type ToEnum x = TEHelper\n\ntype TEHelper = ToEnum Int\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule T9404 where\n\nfoo _ = case seq () (# #) of (# #) -> ()\nfoo2 _ = case () `seq` (# #) of (# #) -> ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TypeFamilies #-}\n\nmodule T9404b where\n\ntype family ListTF x where\n  ListTF x = [x]\n\nbar :: (forall x. ListTF x -> Int) -> ()\nbar _ = ()\n\nmyconst :: ((forall r. ListTF r -> Int) -> ()) -> x -> (forall r. ListTF r -> Int) -> ()\nmyconst x _ = x\n\nfoo = (bar `myconst` ()) $ length\nfoo2 = (myconst bar ()) $ length\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = _main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = _main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = _main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T9569a where\n\ng :: (Int -> Int) -> Int\ng f = f 4\n\nf1 :: (forall a. a -> a) -> Int\nf1 = g\n\nf2 :: (forall a. a -> a) -> Int\nf2 x = g x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}\n{-# OPTIONS_GHC -fwarn-redundant-constraints #-}\nmodule TcTypeNatSimple where\n\nimport GHC.TypeLits\nimport Data.Proxy\n\ntype family SomeFun (n :: Nat)\n\n-- See the Trac ticket; whether this succeeds or fails is distinctly random\n\n-- upon creation, commit f861fc6ad8e5504a4fecfc9bb0945fe2d313687c, this failed\n\n-- with Simon's optimization to the flattening algorithm, commit\n-- 37b3646c9da4da62ae95aa3a9152335e485b261e, this succeeded\n\n-- with the change to stop Deriveds from rewriting Deriveds (around Dec. 12, 2014),\n-- this failed again\n\n-- 2016-01-23: it just started passing again, when\n-- -fwarn-redundant-constraints was removed from the default warning set.\n-- Turning the warning back on for this module, ghc reports (and probably has\n-- for some time):\n--      Redundant constraints: (x <= y, y <= x)\n--      In the type signature for:\n--            ti7 :: (x <= y, y <= x) => Proxy (SomeFun x) -> Proxy y -> ()\n\nti7 :: (x <= y, y <= x) => Proxy (SomeFun x) -> Proxy y -> ()\nti7 _ _ = ()\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n\nmodule T9834 where\nimport Control.Applicative\nimport Data.Functor.Identity\n\ntype Nat f g = forall a. f a -> g a\n\nnewtype Comp p q a = Comp (p (q a))\n\nliftOuter :: (Functor p, Applicative q) => p a -> (Comp p q) a\nliftOuter pa = Comp (pure <$> pa)\n\nrunIdComp :: Functor p => Comp p Identity a -> p a\nrunIdComp (Comp p) = runIdentity <$> p\n\nwrapIdComp :: Applicative p => (forall q. Applicative q => Nat (Comp p q) (Comp p q)) -> p a -> p a\nwrapIdComp f = runIdComp . f . liftOuter\n\nclass Applicative p => ApplicativeFix p where\n  afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a\n  afix = wrapIdComp", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule T9892 where\n\nimport Control.Applicative\nimport Control.Category\nimport Prelude hiding ((.),id)\n\nnewtype FocusingPlus w k s a = FocusingPlus { unfocusingPlus :: k (s, w) a }\n\ninstance Functor (k (s, w)) => Functor (FocusingPlus w k s) where\n  fmap f (FocusingPlus as) = FocusingPlus (fmap f as)\n\ninstance Applicative (k (s, w)) => Applicative (FocusingPlus w k s) where\n  pure = FocusingPlus . pure\n  FocusingPlus kf <*> FocusingPlus ka = FocusingPlus (kf <*> ka)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -Wredundant-constraints #-}\n\nmodule T9939 where\n\nf1 :: (Eq a, Ord a) => a -> a -> Bool\n-- Eq a redundant\nf1 x y = (x == y) && (x > y)\n\nf2 :: (Eq a, Ord a) => a -> a -> Bool\n-- Ord a redundant, but Eq a is reported\nf2 x y = (x == y)\n\nf3 :: (Eq a, a ~ b, Eq b) => a -> b -> Bool\n-- Eq b redundant\nf3 x y = x==y\n\ndata Equal a b where\n  EQUAL :: Equal a a\n\nf4 :: (Eq a, Eq b) => a -> b -> Equal a b -> Bool\n-- Eq b redundant\nf4 x y EQUAL = y==y\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies #-}\nmodule T9971 where\n\ntype Vertex v = v Double\n\nclass C a b | b->a  where\n  op :: a -> b\n\nfoo :: Vertex x\nfoo = error \"urk\"\n\nbar x = [op foo, op foo]\n -- This gives rise to a [D] Vertex a1 ~ Vertex a2\n -- And that made the canonicaliser go into a loop (Trac #9971)\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-redundant-constraints #-}\n\nmodule T9973 where\n\nduplicateDecl :: (Eq t) => t -> IO ()\n-- Trac #9973 was a bogus \"redundant constraint\" here\nduplicateDecl sigs\n = do { newSpan <- return typeSig\n\n         -- **** commenting out the next three lines causes the original warning to disappear\n       ; let rowOffset = case typeSig of {  _  -> 1 }\n\n       ; undefined }\n   where\n     typeSig = definingSigsNames sigs\n\n\ndefiningSigsNames :: (Eq t) => t -> ()\ndefiningSigsNames x = undefined\n  where\n    _ = x == x   -- Suppress the complaint on this\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\na x = y+2 where y = x+3\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nb = if True then 1 else 2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n-- This is a somewhat surprising program.\n-- It shows up the monomorphism restriction, *and* ambiguity resolution!\n-- The binding is a pattern binding without a signature, so it is monomorphic.\n-- Hence the types of c,d,e are not universally quantified.  But then\n-- their type variables are ambiguous, so the ambiguity resolution leaps\n-- into action, and resolves them to Integer.\n\n-- That's why we check the interface file in the test suite.\n\n(c@(d,e)) = if True then (1,2) else (1,3)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nf x = case x of\n       True -> True\n       False -> x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ng ((x:z),y) = x\ng (x,y) = 2\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nh = 1:h\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nj = 2\n\nk = 1:j:l\n\nl = 0:k\n\nm = j+j\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nn True = 1\nn False = 0\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\no (True,x) = x\no (False,y) = y+1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\np = [(y+2,True) | y <- [1,2]]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nx@_ = x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nq = \\ y -> y\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n(r,s) = (1,'a')\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nt = 1+t\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nu x = \\ (y,z) -> x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nf x@_ y@_ = x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nv | True = v+1\n  | False = v\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nw = a where a = y\n            y = 2\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n(al:am) = [y+1 | (y,z) <- [(1,2)]]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nf x = a where a = x:a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nf x = a\n\na = (x,x)\n\nx = x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nmain = iD iD\n\niD x = x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nmain  = s k k \n\ns f g x = f x (g x)\n\nk x y = x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nmain x = s k k x\n\ns f g x = f x (g x)\n\nk x y = x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ng x = f (f True x) x where f x y = if x then y else (f x y)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ng x = f (f True x) x \nf x y = if x then y else (f x y)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nh x = f (f True x) x \nf x y = if x then y else (g y x)\ng y x = if x then y else (f x y)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ntype H = (Int,Bool)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ntype G = [Int]\n\ndata K = H Bool | M G\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ntype H = [Bool]\n\ntype G = (H,Char)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata Rec = Node Int Rec\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata AList b = Node b [b] | Other (b,Char)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata Twine = Twine2 Twist\n\ndata Twist = Twist2 Twine\n\ntype F = Twine \n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata AList a = ANull | ANode a (AList a)\n\ntype IntList = AList Int\n\ng (ANull) = 2\ng (ANode b (ANode c d)) | b = 3\n                        | True = 4\n\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ntype AnnExpr a = (a,Expr a)\n\ndata Expr a = Var [Char]\n              | App (AnnExpr a) (AnnExpr a)\n\ng (a,(Var name)) = [name]\ng (a,(App e1 e2)) = (g e1) ++ (g e2)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass (Eq a) => A a where\n op1 :: a -> a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Eq' a where\n  deq :: a -> a -> Bool\n\ninstance (Eq' a) => Eq' [a] where\n deq []     [] = True\n deq (x:xs) (y:ys) = if (x `deq` y) then (deq xs ys) else False\n deq other1 other2 = False\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nf (x:xs) = if (x == (fromInteger 2)) then xs else []\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass (Eq a) => A a where\n op1 :: a -> a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n-- !!! tests the deduction of contexts.\n\nf :: (Eq a) => a -> [a]\n\nf x = g x\n      where\n      g y = if (y == x) then [] else [y]\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! a very simple test of class and instance declarations\n\nmodule ShouldSucceed where\n\nclass H a where\n op1 :: a -> a -> a\n\ninstance H Bool where\n op1 x y = y\n\nf :: Bool -> Int -> Bool\nf x y = op1 x x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! a file mailed us by Ryzard Kubiak. This provides a good test of the code\n-- !!! handling type signatures and recursive data types.\n\nmodule ShouldSucceed where\n\ndata Boolean = FF | TT\ndata Pair a b = Mkpair a b\ndata List alpha = Nil | Cons alpha (List alpha)\ndata Nat = Zero | Succ Nat\ndata Tree t = Leaf t | Node (Tree t) (Tree t) \n\nidb :: Boolean -> Boolean\nidb x = x      \n\n\nswap :: Pair a b -> Pair b a\nswap t = case t of \n           Mkpair x y -> Mkpair y x \n\nneg :: Boolean -> Boolean\nneg b = case b of \n          FF -> TT \n          TT -> FF \n\nnUll :: List alpha -> Boolean\nnUll l = case l of \n           Nil -> TT\n           Cons y ys  -> FF \n\nidl ::  List a -> List a\nidl xs  = case xs of\n           Nil -> Nil \n           Cons y ys -> Cons y (idl ys)\n     \nadd :: Nat -> Nat -> Nat\nadd a b = case a of \n            Zero -> b \n            Succ c -> Succ (add c b) \n\napp :: List alpha -> List alpha -> List alpha\napp  xs zs  = case xs of\n                  Nil -> zs \n                  Cons y ys  -> Cons y (app ys zs) \n                 \nlEngth :: List a -> Nat\nlEngth xs = case xs of \n              Nil -> Zero  \n              Cons y ys  -> Succ(lEngth ys) \n\nbefore :: List Nat -> List Nat\nbefore xs = case xs of\n              Nil -> Nil\n              Cons y ys -> case y of \n                              Zero -> Nil\n                              Succ n -> Cons y (before ys)       \n\nrEverse :: List alpha -> List alpha\nrEverse rs = case rs of\n               Nil -> Nil\n               Cons y ys -> app (rEverse ys) (Cons y Nil) \n             \n\nflatten :: Tree alpha -> List alpha\nflatten t = case t of\n              Leaf x   -> Cons x Nil \n              Node l r -> app (flatten l) (flatten r)\n         \nsUm :: Tree Nat -> Nat\nsUm t = case t of\n          Leaf t   -> t\n          Node l r -> add (sUm l) (sUm r) \n\n\n", "num_lines": 74}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n-- !!! another simple test of class and instance code.\n\nclass A a where\n op1 :: a\n\ninstance A Int where\n op1 = 2\n\nf x = op1\n\nclass B b where\n op2 :: b -> Int\n\ninstance (B a) => B [a] where\n op2 [] = 0\n op2 (x:xs) = 1 + op2 xs\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- once produced a bug, here as regression test\n\nmodule ShouldSucceed where\n\nf _ | otherwise = ()\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\nmodule ShouldSucceed where\n\nclass C a where\n op1 :: a -> a\n\nclass (C a) => B a where\n op2 :: a -> a -> a\n\ninstance (B a) => B [a] where\n op2 xs ys = xs\n\ninstance C [a] where\n op1 xs = xs\n\n{- This was passed by the prototype, but failed hard in the new\ntypechecker with the message\n\nFail:No match in theta_class\n-}\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass C a where\n op1 :: a -> a\n\nclass (C a) => B a where\n op2 :: a -> a -> a\n\n{- Failed hard in new tc with \"No match in theta_class\" -}\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ntype OL a =  [a]\n\n-- produces the interface:\n-- data OL a = MkOL [a] deriving ()\n-- ranOAL :: (OL (a, a)) -> [a]\n-- this interface was produced by BOTH hbc and nhc\n\n-- the following bogus type sig. was accepted by BOTH hbc and nhc\nf x = ranOAL where -- ranOAL :: OL (a,v) -> [a]\n--ranOAL :: OL (a,v) -> [v], the right sig.\n                   ranOAL ( xs) = mp sd xs\n\n\nmp f [] = []\nmp f (x:xs) = (f x) : mp f xs\n\nsd (f,s) = s\n\n\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata OL a = MkOL [a]\ndata FG a b = MkFG (OL (a,b))\ndata AFE n a b = MkAFE (OL (n,(FG a b)))\n\n--ranOAL :: OL (a,v) -> [a]\nranOAL :: OL (a,v) -> [v]\nranOAL (MkOL xs) = mAp sNd xs\n\nmAp f [] = []\nmAp f (x:xs) = (f x) : mAp f xs\n\nsNd (f,s) = s\n\nranAFE :: AFE n a b -> [FG a b]  -- ?\nranAFE (MkAFE nfs) = ranOAL nfs\n\n\n\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nfib n = if n <= 2 then n else fib (n-1) + fib (n-2)\n\n----------------------------------------\n\nmem x [] = False\nmem x (y:ys) = (x == y) `oR` mem x ys\n\na `oR` b = if a then True else b\n\n----------------------------------------\n\nmem1 x [] = False\nmem1 x (y:ys) = (x == y) `oR1` mem2 x ys\n\na `oR1` b = if a then True else b\n\nmem2 x [] = False\nmem2 x (y:ys) = (x == y) `oR` mem1 x ys\n\n---------------------------------------\n\nmem3 x [] = False\nmem3 x (y:ys) = if [x] == [y] then mem4 x ys else False\n\nmem4 y (x:xs) = mem3 y xs\n\n---------------------------------------\n\nmain1 = [[(1,True)]] == [[(2,False)]]\n\n---------------------------------------\n\nmain2 = \"Hello\" == \"Goodbye\"\n\n---------------------------------------\n\nmain3 = [[1],[2]] == [[3]]\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Foo a where\n o_and :: a -> a -> a\n\n\ninstance Foo Bool where\n o_and False x = False\n o_and x False = False\n o_and True True = True\n\n\ninstance Foo Int where\n o_and x 0 = 0\n o_and 0 x = 0\n o_and 1 1 = 1\n\n\nf x y = o_and x False\n\ng x y = o_and x 1\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule ShouldSucceed where\n\nclass Eq' a where\n doubleeq :: a -> a -> Bool\n\nclass (Eq' a) => Ord' a where\n lt :: a -> a -> Bool\n\ninstance Eq' Int where\n doubleeq x y = True\n\ninstance (Eq' a) => Eq' [a] where\n doubleeq x y = True\n\ninstance Ord' Int where\n lt x y = True\n\n{-\nclass (Ord a) => Ix a where\n range :: (a,a) -> [a]\n\ninstance Ix Int where\n range (x,y) = [x,y]\n-}\n\n\n\n\n\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ntype A a = B a\n\ntype B c = C\n\ntype C = Int\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Eq' a where\n deq :: a -> a -> Bool\n\ninstance Eq' Int where\n deq x y = True\n\ninstance (Eq' a) => Eq' [a] where\n deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False\n\nf x = deq x [1]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Eq' a where\n doubleeq :: a -> a -> Bool\n\nclass (Eq' a) => Ord' a where\n lt :: a -> a -> Bool\n\ninstance Eq' Int where\n doubleeq x y = True\n\ninstance Ord' Int where\n lt x y = True\n\nf x y | lt x 1 = True\n      | otherwise = False\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n(x,y) = (\\p -> p,\\q -> q)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Duplicate class assertion warning\n\n-- ghc 6.6 now warns about duplicate class assertions,\n\nmodule ShouldSucceed where\n\nclass Eq' a where\n doubleeq :: a -> a -> Bool\n\nclass (Eq' a) => Ord' a where\n lt :: a -> a -> Bool\n\ninstance Eq' Int where\n doubleeq x y = True\n\ninstance (Eq' a, Eq' a) => Eq' [a] where\n doubleeq x y = True\n\nf x y = doubleeq x [1]\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n-- See also tcfail060.hs\n\nclass Eq' a where\n deq :: a -> a -> Bool\n\ninstance Eq' Int where\n  deq x y = True\n\ninstance (Eq' a) => Eq' [a] where\n   deq (a:as) (b:bs) = dand (f a b) (f as bs)\n\ndand True True = True\ndand x y = False\n\nf :: Eq' a => a -> a -> Bool\nf p q = dand (deq p q) (deq [1::Int] [2::Int])\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule ShouldSucceed where\n\nclass Eq2 a where\n doubleeq :: a -> a -> Bool\n\nclass (Eq2 a) => Ord2 a where\n lt :: a -> a -> Bool\n\ninstance Eq2 Int where\n doubleeq x y = True\n\ninstance Ord2 Int where\n lt x y = True\n\ninstance (Eq2 a,Ord2 a) => Eq2 [a] where\n doubleeq xs ys = True\n\nf x y = doubleeq x [1] \n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Eq2 a where\n deq :: a -> a -> Bool\n foo :: a -> a\n\ninstance Eq2 Int where\n deq x y = True\n foo x = x\n\ninstance (Eq2 a) => Eq2 [a] where\n deq (a:as) (b:bs) = if (deq a (foo b)) then (deq as (foo bs)) else False\n foo x = x\n\nf x = deq x [1]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Eq2 a where\n deq :: a -> a -> Bool\n\ninstance (Eq2 a) => Eq2 [a] where\n deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False\n\n\ninstance Eq2 Int where\n deq x y = True\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Eq1 a where\n deq :: a -> a -> Bool\n\ninstance (Eq1 a) => Eq1 [a] where\n deq (a:as) (b:bs) = deq a b\n\ninstance Eq1 Int where\n deq x y = True\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nclass Eq1 a where\n deq :: a -> a -> Bool\n\ninstance Eq1 Int where\n deq x y = True\n\ninstance (Eq1 a) => Eq1 [a] where\n deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False\n\nf x (y:ys) = deq x ys\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata X a = Tag a \n\nclass Reps r where\n f :: r -> r -> r\n\ninstance Reps (X q) where\n-- f (Tag x) (Tag y) = Tag y\n f x y = y\n\ninstance Reps Bool where\n f True True = True\n f x y = False\n\ng x = f x x\n\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata Boolean = FF | TT\n\nidb :: Boolean -> Boolean\nidb x = x      \n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n-- import TheUtils\nimport qualified Data.Set as Set\nimport Data.Set (Set)\nimport Data.List (partition )\n\ndata Digraph vertex = MkDigraph [vertex]\n\ntype Edge  vertex = (vertex, vertex)\ntype Cycle vertex = [vertex]\n\nmkDigraph = MkDigraph\n\nstronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]\nstronglyConnComp es vs\n  = snd (span_tree (new_range reversed_edges)\n                    ([],[])\n                   ( snd (dfs (new_range es) ([],[]) vs) )\n         )\n where\n   reversed_edges = map swap es\n\n   swap :: Edge v -> Edge v\n   swap (x,y) = (y, x)\n\n   new_range    []       w = []\n   new_range ((x,y):xys) w\n        = if x==w\n          then (y : (new_range xys w))\n          else (new_range xys w)\n\n   span_tree r (vs,ns) []   = (vs,ns)\n   span_tree r (vs,ns) (x:xs)\n        | x `elem` vs = span_tree r (vs,ns) xs\n        | otherwise = span_tree r (vs',(x:ns'):ns) xs\n          where\n            (vs',ns') = dfs r (x:vs,[]) (r x)\n\ndfs r (vs,ns)   []   = (vs,ns)\ndfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs\n                     | otherwise = dfs r (vs',(x:ns')++ns) xs\n                                   where\n                                     (vs',ns') = dfs r (x:vs,[]) (r x)\n\n\nisCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool\nisCyclic edges [v] = (v,v) `elem` edges\nisCyclic edges vs = True\n\n\ntopSort :: (Eq vertex) => [Edge vertex] -> [vertex]\n              -> MaybeErr [vertex] [[vertex]]\n\n\ntopSort edges vertices\n = case cycles of\n        [] -> Succeeded [v | [v] <- singletons]\n        _  -> Failed cycles\n   where\n   sccs = stronglyConnComp edges vertices\n   (cycles, singletons) = partition (isCyclic edges) sccs\n\n\ntype FlattenedDependencyInfo vertex name code\n   = [(vertex, Set name, Set name, code)]\n\nmkVertices :: FlattenedDependencyInfo vertex name code -> [vertex]\nmkVertices info = [ vertex | (vertex,_,_,_) <- info]\n\nmkEdges :: (Ord name) =>\n            [vertex]\n         -> FlattenedDependencyInfo vertex name code\n         -> [Edge vertex]\n\nmkEdges vertices flat_info\n = [ (source_vertex, target_vertex)\n   | (source_vertex, _, used_names, _) <- flat_info,\n     target_name   <- Set.toList used_names,\n     target_vertex <- vertices_defining target_name flat_info\n   ]\n where\n   vertices_defining name flat_info\n    = [ vertex |  (vertex, names_defined, _, _) <- flat_info,\n                name `Set.member` names_defined\n      ]\n\nlookupVertex :: (Eq vertex) =>\n                 FlattenedDependencyInfo vertex name code\n              -> vertex\n              -> code\n\nlookupVertex flat_info vertex\n = head code_list\n where\n   code_list = [ code | (vertex',_,_,code) <- flat_info, vertex == vertex']\n\n\nisRecursiveCycle :: (Eq vertex) => Cycle vertex -> [Edge vertex] -> Bool\nisRecursiveCycle [vertex] edges = (vertex, vertex) `elem` edges\nisRecursiveCycle cycle    edges = True\n\n\n\n-- may go to TheUtils\n\ndata MaybeErr a b = Succeeded a | Failed b\n\n", "num_lines": 109}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata Pair a b = MkPair a b\nf x = [ a | (MkPair c a) <- x ]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nf [] = []\nf (x:xs) = x : (f xs)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata T a = D (B a) | C\ndata B b = X | Y b\n\ninstance (Eq a) => Eq (T a) where\n (D x) == (D y) = x == y\n C == C = True\n a == b = False\n\n a /= b = not (a == b)\n\ninstance (Eq b) => Eq (B b) where\n X == X = True\n (Y a) == (Y b) = a == b\n a == b = False\n\n a /= b = not (a == b)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nx = 'a'\n(y:ys) = ['a','b','c'] where p = x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n\ndata Boolean = FF | TT\n\n\nidb :: Boolean -> Boolean\nidb x = x      \n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldSucceed where\n\nf [] = []\nf (x:xs) = x : (f xs)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\ndata T a = D (B a) | C\ndata B b = X | Y b\n\ninstance (Eq a) => Eq (T a) where\n (D x) == (D y) = x == y\n C == C = True\n a == b = False\n\n a /= b = not (a == b)\n\ninstance (Eq b) => Eq (B b) where\n X == X = True\n (Y a) == (Y b) = a == b\n a == b = False\n\n a /= b = not (a == b)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! scoping in list comprehensions right way 'round?\n-- a bug reported by Jon Hill\n--\nmodule ShouldSucceed where\n\nx = [[True]]\nxs :: [Bool]\nxs = [x | x <- x, x <- x]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! make sure context of EQ is minimised in interface file.\n--\nmodule ShouldSucceed where\n\ndata NUM = ONE | TWO\nclass (Num a) => ORD a\n\nclass (ORD a, Show a) => EQ a where\n        (===) :: a -> a -> Bool\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! instance decls with no binds\n--\nmodule ShouldFail where\n\ndata Bar a = MkBar Int a\n\ninstance Eq a => Eq (Bar a)\ninstance Ord a => Ord (Bar a)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! small class decl with local polymorphism;\n-- !!! \"easy\" to check default methods and such...\n-- !!! (this is the example given in TcClassDcl)\n--\nmodule ShouldSucceed where\n\nclass Foo a where\n    op1 :: a -> Bool\n    op2 :: Ord b => a -> b -> b -> b\n\n    op1 x = True\n    op2 x y z = if (op1 x) && (y < z) then y else z\n\ninstance Foo Int where {}\n\ninstance Foo a => Foo [a] where {}\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--module Parse(Parse(..),whiteSpace,separatedBy) where\n--import StdLib\nmodule ShouldSucceed where\n\nimport Data.Char\n\nclass Parse a where\n       parseFile :: String -> [a]\n       parseLine :: String -> a\n       parseType :: String -> (a,String)\n       parse :: String -> (a,String)\n       forced :: a -> Bool\n\n       parseFile string | all forced x = x\n                       where x = map parseLine (lines' string)\n       parseLine = pl.parse where pl (a,_) = a\n       parse = parseType.whiteSpace\n       forced x = True\n\ninstance Parse Int where\n       parseType str = pl (span' isDigit str)\n               where    pl (l,r) = (strToInt l,r)\n       forced n | n>=0 = True\n\ninstance Parse Char where\n       parseType (ch:str) = (ch,str)\n       forced n = True\n\ninstance (Parse a) => Parse [a] where\n        parseType more = (map parseLine (separatedBy ',' (l++\",\")),out)\n                       where    (l,']':out) = span' (\\x->x/=']') (tail more)\n        forced = all forced\n\nseparatedBy :: Char -> String -> [String]\nseparatedBy ch [] = []\nseparatedBy ch xs = twaddle ch (span' (\\x->x/=ch) xs)\n               where    twaddle ch (l,_:r) = l:separatedBy ch r\n\nwhiteSpace :: String -> String\nwhiteSpace = dropWhile isSpace\n\nspan' :: (a->Bool) -> [a] -> ([a],[a])\nspan' p [] = ([],[])\nspan' p (x:xs') | p x = fixLeak x (span' p xs') where fixLeak x (xs,ys) = (x:xs,ys)\nspan' _ xs = ([],xs)\n\nlines' :: [Char] -> [[Char]]\nlines' \"\" = []\nlines' s = plumb (span' ((/=) '\\n') s)\n       where   plumb (l,s') = l:if null s' then [] else lines' (tail s')\n\nstrToInt :: String -> Int\nstrToInt x = strToInt' (length x-1) x\n      where   strToInt' _ [] = 0\n              strToInt' x (a:l) = (charToInt a)*(10^x) + (strToInt' (x-1) l)\n\ncharToInt :: Char -> Int\ncharToInt x = (ord x - ord '0')\n", "num_lines": 59}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! an example Simon made up\n--\nmodule ShouldSucceed where\n\nf x = (x+1, x<3, g True, g 'c')\n        where\n        g y = if x>2 then [] else [y]\n{-\nHere the type-check of g will yield an LIE with an Ord dict\nfor x.  g still has type forall a. a -> [a].  The dictionary is\nfree, bound by the x.\n\nIt should be ok to add the signature:\n-}\n\nf2 x = (x+1, x<3, g2 True, g2 'c')\n        where\n        -- NB: this sig:\n        g2 :: a -> [a]\n        g2 y = if x>2 then [] else [y]\n{-\nor to write:\n-}\n\nf3 x = (x+1, x<3, g3 True, g3 'c')\n        where\n        -- NB: this line:\n        g3 :: a -> [a]\n        g3 = (\\ y -> if x>2 then [] else [y])::(a -> [a])\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tc082: an instance for functions\n--\nmodule ShouldSucceed where\n\nclass Normal a\n        where\n        normal :: a -> Bool\n\ninstance Normal ( a -> b ) where\n        normal _ = True\n\nf x = normal id\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- This program shows up a bug in the handling of\n   the monomorphism restriction in an earlier version of\n   ghc.  With ghc 0.18 and before, f gets a type with\n   an unbound type variable, which shows up in the\n   interface file.  Reason: it was being monomorphised.\n\n   Simon PJ\n-}\n\nmodule ShouldSucceed where\n\n\ng :: Num a => Bool -> a -> b -> a\ng b x y = if b then x+x else x-x\n\n-- Everything is ok if this signature is put in\n-- but the program should be perfectly legal without it.\n-- f :: Num a => a -> b -> a\nf = g True\n\nh y x = f (x::Int) y\n        -- This use of f binds the overloaded monomorphic\n        -- type to Int\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- !!! From a bug report from Satnam.\n-- !!! To do with re-exporting importees from PreludeGla* modules.\nmodule ShouldSucceed ( module GHC.Prim ) where\n\nimport GHC.Prim\n\ntype FooType = Int\ndata FooData = FooData\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n  From: Marc van Dongen <dongen@cs.ucc.ie>\n  Date: Sat, 31 May 1997 19:57:46 +0100 (BST)\n\n   panic! (the `impossible' happened):\n           tcLookupTyVar:a_r6F\n\n   Please report it as a compiler bug to glasgow-haskell-bugs@dcs.gla.ac.uk.\n\n\nIf the instance definition for (*) at the end of this toy module\nis replaced by the definition that is commented, this all compiles\nfine. Strange, because the two implementations are equivalent modulo\nthe theory {(*) = multiply}.\n\nRemove the `multiply :: a -> a -> a' part, and it compiles without\nproblems.\n\n\nSPJ note: the type signature on \"multiply\" should be\n        multiply :: Group a => a -> a -> a\n\n-}\n\nmodule ShouldSucceed( Group, Ring ) where\n\nimport qualified Prelude( Ord(..), Eq(..), Num(..) )\nimport Prelude hiding( Ord(..), Eq(..), Num(..) )\n\nclass Group a where\n  compare     :: a -> a -> Prelude.Ordering\n  fromInteger :: Integer -> a\n  (+) :: a -> a -> a\n  (-) :: a -> a -> a\n  zero :: a\n  one  :: a\n  zero = fromInteger 0\n  one  = fromInteger 1\n\n-- class (Group a) => Ring a where\n-- (*) :: a -> a -> a\n-- (*) a b =\n--                  case (compare a zero) of\n--                    EQ -> zero\n--                    LT -> zero - ((*) (zero - a) b)\n--                    GT -> case compare a one of\n--                            EQ -> b\n--                            _  -> b + ((*) (a - one) b)\n\nclass (Group a) => Ring a where\n  (*) :: a -> a -> a\n  (*) a b = multiply a b\n          where multiply :: Group b => b -> b -> b\n                multiply a b\n                  = case (compare a zero) of\n                      EQ -> zero\n                      LT -> zero - (multiply (zero - a) b)\n                      GT -> case compare a one of\n                              EQ -> b\n                              _  -> b + (multiply (a - one) b)\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldSucceed where\n\ndata SeqView t a              =  Null\n                              |  Cons a (t a)\n\nclass PriorityQueue q where\n    empty                       :: (Ord a) => q a\n    single                      :: (Ord a) => a -> q a\n    insert                      :: (Ord a) => a -> q a -> q a\n    meld                        :: (Ord a) => q a -> q a -> q a\n    splitMin                    :: (Ord a) => q a -> SeqView q a\n    insert a q          =  single a `meld` q\n\ntoOrderedList q         =  case splitMin q of\n   Null                 -> []\n   Cons a q             -> a : toOrderedList q\n\ninsertMany x q          =  foldr insert q x\npqSort q x              =  toOrderedList (insertMany x q)\n\ncheck                   :: forall q. (PriorityQueue q) => (forall a. Ord a => q a) -> IO ()\ncheck empty             =  do\n    putStr \"*** sorting\\n\"\n    out (pqSort empty [1 .. 99])\n    out (pqSort empty [1.0, 1.1 ..99.9])\n\nout                             :: (Eq a, Num a) => [a] -> IO ()\nout x | sum x == 0              =  putStr \"ok\\n\"\n      | otherwise               =  putStr \"ok\\n\"\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- Check that \"->\" is an instance of Eval\n\nmodule ShouldSucceed where\n\ninstance Show (a->b) where\n        show _ = error \"attempt to show function\"\n\ninstance (Eq b) => Eq (a -> b) where\n        (==) f g = error \"attempt to compare functions\"\n\n        -- Since Eval is a superclass of Num this fails\n        -- unless -> is an instance of Eval\ninstance (Num b) => Num (a -> b) where\n    f + g                     =  \\a -> f a + g a\n    f - g                     =  \\a -> f a - g a\n    f * g                     =  \\a -> f a * g a\n    negate f                  =  \\a -> negate (f a)\n    abs f                     =  \\a -> abs (f a)\n    signum f                  =  \\a -> signum (f a)\n    fromInteger n             =  \\a -> fromInteger n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Stress test for type checker\n\nmodule ShouldSucceed where\n\nimport Prelude hiding (head)\n\none :: a\none = one\n\nhead (x:xs) = x\n\nbottom xs = head xs\n\nabsIf a b c = a\n\nabsAnd a b = head [a,b]\n\nfac_rec fac0 n a \n  = (absIf (absAnd (s_3_0 n) one) \n           (s_2_0 a) \n           (fac0 (absAnd (s_3_2 n) one) (absAnd (s_3_1 n) (s_2_1 a))))\n\nf_rec f0 a \n  = (f0 (s_1_0 a))\n\ng_rec g0 g1 x y z p \n  = (absIf (absAnd (s_3_0 p) one) \n           (absAnd (s_1_0 x) (s_3_0 z)) \n           (absAnd \n              (g0 (s_1_0 y) one one (absAnd (s_3_1 p) one)) \n              (g1 (s_3_2 z) (s_3_1 z) one (absAnd (s_3_2 p) one))))\n\ns_2_0 (v0,v1)   = v0\ns_2_1 (v0,v1)   = v1\ns_1_0 v0  = v0\ns_3_0 (v0,v1,v2)   = v0\ns_3_1 (v0,v1,v2)   = v1\ns_3_2 (v0,v1,v2)   = v2\n\nfac n a = fac_rec fac_rec4 n a\n\nfac_rec4 n a  = (fac_rec fac_rec3 n a)\nfac_rec3 n a  = (fac_rec fac_rec2 n a)\nfac_rec2 n a  = (fac_rec fac_rec1 n a)\nfac_rec1 n a  = (fac_rec fac_rec0 n a)\nfac_rec0 n a  = (bottom [n,a])\n\nf a = (f_rec f_rec2 a)\n\nf_rec2 a  = (f_rec f_rec1 a)\nf_rec1 a  = (f_rec f_rec0 a)\nf_rec0 a  = (bottom [a])\n\ng x y z p = (g_rec g_rec8 g_rec8 x y z p)\n\n{- \ng x y z p = (g_rec g_rec16 g_rec16 x y z p)\n\ng_rec16 x y z p  = (g_rec g_rec15 g_rec15 x y z p)\ng_rec15 x y z p  = (g_rec g_rec14 g_rec14 x y z p)\ng_rec14 x y z p  = (g_rec g_rec13 g_rec13 x y z p)\ng_rec13 x y z p  = (g_rec g_rec12 g_rec12 x y z p)\ng_rec12 x y z p  = (g_rec g_rec11 g_rec11 x y z p)\ng_rec11 x y z p  = (g_rec g_rec10 g_rec10 x y z p)\ng_rec10 x y z p  = (g_rec g_rec9 g_rec9 x y z p)\ng_rec9 x y z p  = (g_rec g_rec8 g_rec8 x y z p)\n-}\n\ng_rec8 x y z p  = (g_rec g_rec7 g_rec7 x y z p)\ng_rec7 x y z p  = (g_rec g_rec6 g_rec6 x y z p)\ng_rec6 x y z p  = (g_rec g_rec5 g_rec5 x y z p)\ng_rec5 x y z p  = (g_rec g_rec4 g_rec4 x y z p)\ng_rec4 x y z p  = (g_rec g_rec3 g_rec3 x y z p)\ng_rec3 x y z p  = (g_rec g_rec2 g_rec2 x y z p)\ng_rec2 x y z p  = (g_rec g_rec1 g_rec1 x y z p)\ng_rec1 x y z p  = (g_rec g_rec0 g_rec0 x y z p)\ng_rec0 x y z p  = (bottom [x,y,z,p])\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-      This module tests that we can ge polymorphic recursion\n        of overloaded functions.  GHC 2.02 produced the following\n        bogus error:\n\n        tmp.lhs:1: A group of type signatures have mismatched contexts\n                       Abf.a ::  (PrelBase.Ord f{-aX6-}) => ...\n                       Abf.b ::  (PrelBase.Ord f{-aX2-}) => ...\n\n        This was due to having more than one type signature for one\n        group of recursive functions.\n-}\n\n\nmodule ShouldSucceed where\n\na :: (Ord f) => f\na = b\n\nb :: (Ord f) => f\nb = a\n\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! Test polymorphic recursion\n\n\n-- With polymorphic recursion this one becomes legal\n--      SLPJ June 97.\n\n{-\nTo: Lennart Augustsson <augustss@cs.chalmers.se>\nCc: partain@dcs.gla.ac.uk, John Peterson (Yale) <peterson-john@cs.yale.edu>,\n    simonpj@dcs.gla.ac.uk\nSubject: Type checking matter\nDate: Fri, 23 Oct 92 15:28:38 +0100\nFrom: Simon L Peyton Jones <simonpj@dcs.gla.ac.uk>\n\n\nI've looked at the enclosed again.  It seems to me that\nsince \"s\" includes a recursive call to \"sort\", inside the body\nof \"sort\", then \"sort\" is monomorphic, and hence so is \"s\";\nhence the type signature (which claims full polymorphism) is\nwrong.\n\n[Lennart says he can't see any free variables inside \"s\", but there\nis one, namely \"sort\"!]\n\nWill: one for the should-fail suite?\n\nSimon\n\n\n------- Forwarded Message\n\n\nFrom: Lennart Augustsson <augustss@cs.chalmers.se>\nTo: partain\nSubject: Re: just to show you I'm a nice guy...\nDate: Tue, 26 May 92 17:30:12 +0200\n\n> Here's a fairly simple module from our compiler, which includes what\n> we claim is an illegal type signature (grep ILLEGAL ...).\n> Last time I checked, hbc accepted this module.\n\nNot that I don't believe you, but why is this illegal?\nAs far as I can see there are no free variables in the function s,\nwhich makes me believe that it can typechecked like a top level\ndefinition.  And for a top level defn the signature should be\nall right.\n\n        -- Lennart\n- ------- End of forwarded message -------\n-}\nmodule ShouldSucceed where\n\nsort :: Ord a => [a] -> [a]\nsort xs = s xs (length xs)\n   where\n      s :: Ord b => [b] -> Int -> [b]   -- This signature is WRONG\n      s xs k = if k <= 1 then xs\n               else merge (sort ys) (sort zs)\n               where (ys,zs) = init_last xs (k `div` (2::Int))\n\n-- Defns of merge and init_last are just dummies with the correct types\nmerge :: Ord a => [a] -> [a] -> [a]\nmerge xs ys = xs\n\ninit_last :: [a] -> Int -> ([a],[a])\ninit_last a b = (a,a)\n\n", "num_lines": 70}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldSucceed where\n\ndata Empty q                    =  Empty (forall a. Ord a => q a)\nq                               :: (Ord a) => [a]\nq                               =  []\ne0, e1, e2                      :: Empty []\ne0                              =  Empty []\ne1                              =  Empty ([] :: (Ord a) => [a])\ne2                              =  Empty q\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\ndata State c a = State (c -> (a,c))\n\nunState :: State c a -> (c -> (a,c))\nunState (State x) = x\n\nunitState :: a -> State c a\nunitState a = State (\\s0 -> (a,s0))\n\nbindState :: State c a -> (a -> State c b) -> State c b\nbindState m k = State (\\s0 -> let (a,s1) = (unState m) s0\n                                  (b,s2) = (unState (k a)) s1 \n                              in (b,s2))\n\ninstance Eq c => Functor (State c) where\n    fmap = liftM\n\ninstance Eq c => Applicative (State c) where\n    pure = return\n    (<*>) = ap\n\ninstance Eq c => Monad (State c) where\n    return = unitState \n    (>>=)  = bindState \n\ndata TS = TS { vs::Int } deriving (Show,Eq)\n\ntype St a = State TS a\n\nfoo :: Int -> St Int  -- it works if this line is not given\nfoo x = return x\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n-- From a bug report by Sven Panne.\n\nfoo = bar\n   where bar = \\_ -> (truncate boing, truncate boing)\n         boing = 0\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nBug report from Jon Mountjoy:\n\nWhile playing with Happy I managed to generate a Haskell program\nwhich compiles fine under ghc but not under Hugs.  I don't know which\none is the culprit....\n\nIn Hugs(January 1998), one gets\n\n     ERROR \"hugs.hs\" (line 32): Unresolved top-level overloading\n     *** Binding             : happyReduce_1\n     *** Outstanding context : Functor b\n\nwhere line 32 is the one marked -- ##\n\nIt compiles in ghc-3.00.  Changing very small things, like the\nline marked ---**** to\n      action_0 (6) = happyShift action_0        ---****\n\nthen makes ghc produce a similar message:\n\n   hugs.hs:37:\n   Cannot resolve the ambiguous context (Functor a1Ab)\n   `Functor a1Ab' arising from use of `reduction', at hugs.hs:37\n-}\n\nmodule ShouldSucceed where\n\ndata HappyAbsSyn t1 t2 t3\n        = HappyTerminal Token\n        | HappyErrorToken Int\n        | HappyAbsSyn1 t1\n        | HappyAbsSyn2 t2\n        | HappyAbsSyn3 t3\n\naction_0 (6) = happyShift action_3        --- *****\naction_0 (1) = happyGoto action_1\naction_0 (2) = happyGoto action_2\naction_0 _ = happyFail\n\naction_1 (7) = happyAccept\naction_1 _ = happyFail\n\naction_2 _ = happyReduce_1\n\naction_3 (5) = happyShift action_4\naction_3 _ = happyFail\n\naction_4 (4) = happyShift action_6\naction_4 (3) = happyGoto action_5\naction_4 _ = happyFail\n\naction_5 _ = happyReduce_2\n\naction_6 _ = happyReduce_3\n\nhappyReduce_1 = happySpecReduce_1 1 reduction where {    -- ##\n  reduction\n        (HappyAbsSyn2  happy_var_1)\n         =  HappyAbsSyn1\n                 (\\p -> let q = map (\\(x,y) -> (x,y p)) happy_var_1 in  (10.1))\n;\n  reduction _  = notHappyAtAll }\n\nhappyReduce_2 = happySpecReduce_3 2 reduction where {\n  reduction\n        (HappyAbsSyn3  happy_var_3)\n        _\n        (HappyTerminal (TokenVar happy_var_1))\n         =  HappyAbsSyn2\n                 ([(happy_var_1,happy_var_3)]);\n  reduction _ _ _  = notHappyAtAll }\n\nhappyReduce_3 = happySpecReduce_1 3 reduction where {\n  reduction\n        (HappyTerminal (TokenInt happy_var_1))\n         =  HappyAbsSyn3\n                 (\\p -> happy_var_1);\n  reduction _  = notHappyAtAll }\n\nhappyNewToken action sts stk [] =\n        action 7 7 (error \"reading EOF!\") (HappyState action) sts stk []\n\nhappyNewToken action sts stk (tk:tks) =\n        let cont i = action i i tk (HappyState action) sts stk tks in\n        case tk of {\n        TokenInt happy_dollar_dollar -> cont 4;\n        TokenEq -> cont 5;\n        TokenVar happy_dollar_dollar -> cont 6;\n        }\n\nhappyThen = \\m k -> k m\nhappyReturn = \\a tks -> a\nmyparser = happyParse\n\n\n\nhappyError ::[Token] -> a\nhappyError _ = error \"Parse error\\n\"\n\n--Here are our tokens\ndata Token  =\n              TokenInt Int\n            | TokenVar String\n            | TokenEq\n            deriving Show\n\nmain = print (myparser [] [])\n-- $Id: tc095.hs,v 1.4 2005/05/24 11:33:11 simonpj Exp $\n\n{-\n        The stack is in the following order throughout the parse:\n\n        i       current token number\n        j       another copy of this to avoid messing with the stack\n        tk      current token semantic value\n        st      current state\n        sts     state stack\n        stk     semantic stack\n-}\n\n-----------------------------------------------------------------------------\n\nhappyParse = happyNewToken action_0 [] []\n\n-- All this HappyState stuff is simply because we can't have recursive\n-- types in Haskell without an intervening data structure.\n\nnewtype HappyState b c = HappyState\n        (Int ->                         -- token number\n         Int ->                         -- token number (yes, again)\n         b ->                           -- token semantic value\n         HappyState b c ->              -- current state\n         [HappyState b c] ->            -- state stack\n         c)\n\n-----------------------------------------------------------------------------\n-- Accepting the parse\n\nhappyAccept j tk st sts [ HappyAbsSyn1 ans ] = happyReturn ans\nhappyAccept j tk st sts _                    = notHappyAtAll\n\n-----------------------------------------------------------------------------\n-- Shifting a token\n\nhappyShift new_state (-1) tk st sts stk@(HappyErrorToken i : _) =\n--     _trace \"shifting the error token\" $\n     new_state i i tk (HappyState new_state) (st:sts) stk\n\nhappyShift new_state i tk st sts stk =\n     happyNewToken new_state (st:sts) (HappyTerminal tk:stk)\n\n-----------------------------------------------------------------------------\n-- Reducing\n\n-- happyReduce is specialised for the common cases.\n\n-- don't allow reductions when we're in error recovery, because this can\n-- lead to an infinite loop.\n\nhappySpecReduce_0 i fn (-1) tk _ sts stk\n     = case sts of\n        st@(HappyState action):sts -> action (-1) (-1) tk st sts stk\n        _ -> happyError\nhappySpecReduce_0 i fn j tk st@(HappyState action) sts stk\n     = action i j tk st (st:sts) (fn : stk)\n\nhappySpecReduce_1 i fn (-1) tk _ (st@(HappyState action):sts) stk\n     = action (-1) (-1) tk st sts stk\nhappySpecReduce_1 i fn j tk _ sts@(st@(HappyState action):_) (v1:stk')\n     = action i j tk st sts (fn v1 : stk')\nhappySpecReduce_1 _ _ _ _ _ _ _\n     = notHappyAtAll\n\nhappySpecReduce_2 i fn (-1) tk _ (st@(HappyState action):sts) stk\n     = action (-1) (-1) tk st sts stk\nhappySpecReduce_2 i fn j tk _ (_:sts@(st@(HappyState action):_)) (v1:v2:stk')\n     = action i j tk st sts (fn v1 v2 : stk')\nhappySpecReduce_2 _ _ _ _ _ _ _\n     = notHappyAtAll\n\nhappySpecReduce_3 i fn (-1) tk _ (st@(HappyState action):sts) stk\n     = action (-1) (-1) tk st sts stk\nhappySpecReduce_3 i fn j tk _ (_:_:sts@(st@(HappyState action):_))\n        (v1:v2:v3:stk')\n     = action i j tk st sts (fn v1 v2 v3 : stk')\nhappySpecReduce_3 _ _ _ _ _ _ _\n     = notHappyAtAll\n\nhappyReduce k i fn (-1) tk _ (st@(HappyState action):sts) stk\n     = action (-1) (-1) tk st sts stk\nhappyReduce k i fn j tk st sts stk = action i j tk st' sts' (fn stk)\n       where sts'@(st'@(HappyState action):_) = drop (k::Int) (st:sts)\n\nhappyMonadReduce k i c fn (-1) tk _ sts stk\n      = case sts of\n             (st@(HappyState action):sts) -> action (-1) (-1) tk st sts stk\n             [] -> happyError\nhappyMonadReduce k i c fn j tk st sts stk =\n        happyThen (fn stk) (\\r -> action i j tk st' sts' (c r : stk'))\n       where sts'@(st'@(HappyState action):_) = drop (k::Int) (st:sts)\n             stk' = drop (k::Int) stk\n\n-----------------------------------------------------------------------------\n-- Moving to a new state after a reduction\n\nhappyGoto action j tk st = action j j tk (HappyState action)\n\n-----------------------------------------------------------------------------\n-- Error recovery (-1 is the error token)\n\n-- fail if we are in recovery and no more states to discard\n{-# NOINLINE happyFail #-}\n-- NOINLINE else GHC diverges with the contravariant data type bug\n-- See test simplCore/should_compile/simpl012\nhappyFail  (-1) tk st' [] stk = happyError\n\n-- discard a state\nhappyFail  (-1) tk st' (st@(HappyState action):sts) stk =\n--      _trace \"discarding state\" $\n        action (-1) (-1) tk st sts stk\n\n-- Enter error recovery: generate an error token,\n--                       save the old token and carry on.\n\n-- we push the error token on the stack in anticipation of a shift,\n-- and also because this is a convenient place to store the saved token.\n\nhappyFail  i tk st@(HappyState action) sts stk =\n--      _trace \"entering error recovery\" $\n        action (-1) (-1) tk st sts (HappyErrorToken i : stk)\n\n-- Internal happy errors:\n\nnotHappyAtAll = error \"Internal Happy error\\n\"\n\n-- end of Happy Template.\n", "num_lines": 238}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldSucceed where\n\n-- !!! monomorphism restriction and defaulting\n\nx = 3\n\nmain = print $ 6 / x\n\n{-\nHugs 1.4 complains: ERROR \"Strange.hs\" (line 3): Int is not an\ninstance of class \"Fractional\".  GHC however compiles the program.\nSubstitute for x and Hugs is happy.  What's going on?\n\nI haven't studied the numeric classes much so perhaps I'm missing\nsomething obvious here.  (I see that the bugs page alludes to some 1.4\nfeatures not in Hugs leading to type errors.  If this is it, maybe you\nshould give it as an example?)\n\n  Bjarte\n\n------- Message 2\n\nDate:    Wed, 25 Feb 98 14:01:35 -0500\nFrom:    \"John C. Peterson\" <peterson-john@CS.YALE.EDU>\nTo:      bjartem@idi.ntnu.no\ncc:      hugs-bugs@CS.YALE.EDU\nSubject: Re: Fractional and Int?\n\nThis is a known hugs bug.  x should be monomorphic, allowing the usage\nin main to constrain it to Fractional.  Instead, it is generalized and\nthen defaulted to Int without being influenced by main.  So ghc is\nright and hugs is wrong on this one.  I expect this will be fixed\neventually. \n\n   John\n-}\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n-- !!! Local universal quantification.\nmodule ShouldSucceed where\n\ndata Monad2 m = MkMonad2 (forall a. a -> m a)\n                         (forall a b.  m a -> (a -> m b) -> m b)\n\nhalfListMonad  :: (forall a b. [a] -> (a -> [b]) -> [b]) -> Monad2 []\nhalfListMonad b = MkMonad2 (\\x -> [x]) b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Ambiguity in local declarations\n\nmodule ShouldSucceed where\n\ntype Cp a =  a -> a -> Ordering\n\nm :: Eq a => Cp a -> [a] -> a\nm            _       [x,y,z] =  if x==y then x else z\n\ncpPairs :: Cp [j] -> (a,[j]) -> (a,[j]) -> Ordering\ncpPairs    cp        (_,p)      (_,q)   =  cp p q\n\nmp :: (Eq i,Eq j) => Cp [j] -> [(i,[j])] -> (i,[j])\nmp                   cp        dD          =\n                                    let  minInRow = m (cpPairs cp)\n                                    in   minInRow dD\n\n{- GHC 3.02 reported\n\n    T.hs:24:\n        Ambiguous type variable(s)\n        `j' in the constraint `Eq (aYD, [j])'\n            arising from use of `m' at T.hs:24\n        In an equation for function `mp':\n            mp cp dD = let minInRow = m (cpPairs cp) in minInRow dD\n\nThis was because the ambiguity test in tcSimplify didn't\ntake account of the type variables free in the environment.\n\nIt should compile fine.\n-}\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! check if tc type substitutions really do\n-- !! clone (or if not, work around it by cloning\n-- !! all binders in first pass of the simplifier).\nmodule ShouldCompile where\n\nf,g :: Eq a => (a,b)\nf = g\ng = f\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Caused ghc-3.03 and 4.01 tc to enter a \n-- !!! a blackhole (as reported by P. Callaghan.)\nmodule ShouldCompile where\n\ntype C a = D a -> a\nnewtype D a = DD (D_ a)\ntype D_ a = C (Maybe a)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Caused ghc-4.04proto to loop!\n-- !!! (as reported by Sigbjorn)\n\nmodule ShouldCompile where\n\n-- This made the compiler (4.04 proto) loop (stack overflow)\n-- The bug was in TcUnify.uUnboundVar and is documented there.\n\ntype A a = ()\n\nf :: (A a -> a -> ()) -> ()\nf = \\ _ -> ()\n\nx :: ()\nx = f (\\ x p -> p x)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- !!! Caused ghc-4.04proto to report a bogus type error\n-- !!! (as reported by Keith)\n\n-- The type error arose from a mistake in tcMatches.tc_match\n\n-- Involves pattern type signatures\n\nmodule ShouldCompile where\n\np :: forall a. a -> a\np = let y = p in \\ (x::a) -> x\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Checking that Main.main's type can now be of the form (IO a)\nmodule Main(main) where\n\nmain = putStrLn \"Hello\" >> return (id)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\nmodule ShouldCompile where\n\nimport Control.Monad.ST\nimport Data.STRef\n\n-- (Modified now that we don't have result type signatures)\n\nf:: forall s. ST s Int\nf = do v <- newSTRef 5\n       let g :: ST s Int\n             -- ^ should be in scope\n           g = readSTRef v\n       g\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}\n\n-- !!! Mutually recursive kind inference\n-- Exposes a bug in 4.08 (fixed in 4.08 pl1)\n\nmodule ShouldCompile where\n\n-- This pair will tickle the bug\nclass Lookup c k a where\n    lookupAll :: Sequence seq a => c -> k -> seq a\n\nclass Lookup (s a) Int a => Sequence s a where\n    foo :: s a\n\n\n-- This decl will tickle it all by itself\nclass Matrix a e where\n   amap2  :: (Matrix a d) =>\n             (e -> d -> e) -> a ix e -> a ix d -> a ix e\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Kind checking in a recursive situation\n-- Exposes a bug in proto-4.09 (black hole)\n\nmodule ShouldCompile where\n\ndata ChItem = ChItemX Stream\ntype Stream = ChItem \n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}\n-- !!! Scopes in kind checking\n\n-- Exposes a bizarre bug in 4.08.1\n--    TestSh.hs:6:\n--      `Shape' is not in scope\n--      When checking kinds in `HasConfigValue Shape nodeTypeParms'\n--      In the class declaration for `HasShape'\n\nmodule ShouldCompile where\n\ndata Shape value = Box | Circle\n\nclass HasConfigValue Shape nodeTypeParms => HasShape nodeTypeParms where {}\n\nclass HasConfigValue option configuration where\n   ($$$) :: option value -> configuration value -> configuration value\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             UndecidableInstances #-}\n-- UndecidableInstances because 'b' appears in the context but not the head\n\nmodule ShouldCompile where\n\n-- This accepted by Hugs, but not by GHC 4.08.1\n-- Reported by Thomas Hallgren Nov 00\n\nclass P a\nclass R a b | b->a\n\ninstance (P a,R a b) => P [b]\n\n{- GHC 4.08.1 doesn't seem to allow variables in the context that\ndon't appear after the =>, but which are still ok since they are\ndetermined by the functional dependenices.  -}\n\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- !!! Test monomorphism + RULES\n\nmodule ShouldCompile where\n\n-- This example crashed GHC 4.08.1.\n-- The reason was that foobar is monomorphic, so the RULE \n-- should not generalise over it.\n\n{-# NOINLINE [1] foo #-}\nfoo 1 = 2\n{-# NOINLINE [1] bar #-}\nbar 0 = 1\n\nfoobar = 2\n\n{-# RULES\n  \"foo/bar\" foo bar = foobar\n #-}\n\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- !!! Functional dependencies\n-- This broke an early impl of functional dependencies\n-- (complaint about ambiguity)\n\nmodule ShouldCompile where\n\nclass C a b | a -> b where f :: a -> b\n\ng :: (C a b, Eq b) => a -> Bool\ng x = f x == f x\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! Monomorphism restriction\n\nmodule ShouldCompile where\n\nfoo :: Eq a => a -> b -> b\nfoo x y = y\n\n-- Expect test2 :: forall b. b->b\n-- despite the monomorphism restriction\npoly = foo (3::Int)\n\n-- Check that test2 is polymorphic\ntest = (poly True, poly 'c')\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances #-}\n\n-- !!! Functional dependencies\n-- This broke an early impl of functional dependencies\n\nmodule ShouldCompile where\n\nclass Foo r a | r -> a where\n    foo :: a -> r\n\ninstance Foo (Maybe e) e where\n    foo = Just\n\nbad:: Num e => Maybe e\nbad = foo 0\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances #-}\n-- !!! Functional dependencies\n-- This broke an early impl of functional dependencies\n-- (complaining about ambiguity)\n\nmodule ShouldCompile where\n\nclass Foo r a | r -> a where\n    foo :: r -> a\n\ninstance Foo [m a] (m a)\n\nbad:: Monad m => m a\nbad = foo bar\n\nbar:: Monad m => [m a]\nbar = []\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances #-}\n-- !!! Functional dependencies\n-- This broke an early impl of functional dependencies\n-- (caused a panic)\n\nmodule ShouldCompile where\n\nclass Foo r a | r -> a where\n    foo :: r -> a\n\ninstance Foo [m a] (m a)\n\nbad:: Monad m => m a\nbad = foo bar\n\nbar:: [m a]\nbar = []\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, UndecidableInstances #-}\n-- UndecidableInstances now needed because the Coverage Condition fails\n\n-- !!! Functional dependencies\n-- This one gave another fail in tcReadMutVar\n\nmodule M1 where\n\nclass HasFoo a foo | a -> foo where\n    foo :: a -> foo\ninstance HasFoo Int Int where\n    foo = id\n\ninstance HasFoo a b => HasFoo [a] b where\n    foo = foo . head\n\ntest:: [[Int]] -> Int\ntest = foo\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             UndecidableInstances #-}\n\n-- !!! An instance decl with a context containing a free type variable\n-- The interest here is that there's a \"b\" in the instance decl\n-- context that isn't mentioned in the instance head.  \n-- Hence UndecidableInstances\n\nmodule ShouldCompile where\n\nclass HasConverter a b | a -> b where\n   convert :: a -> b\n \ndata Foo a = MkFoo a\n\ninstance (HasConverter a b,Show b) => Show (Foo a) where\n   show (MkFoo value) = show (convert value)\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             ExistentialQuantification #-}\n\n-- !!! Functional dependencies and existentials\n\n-- Hugs (February 2000) doesn't like it. It says\n--  Variable \"e\" in constraint is not locally bound\n\nmodule ShouldCompile where\n\nclass Collection c e | c -> e where\n   empty :: c\n   put   :: c -> e -> c\n\ndata SomeCollection e = forall c . Collection c e => MakeSomeCollection c\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check that we can have a type for main that is more general than IO a\n\n-- main :: forall a.a   certainly also has type IO a, so it should be fine.\n\nmodule Main(main) where\n\nmain :: a\nmain = error \"not much luck\"\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- !!! Implicit Parameters\n\n-- If the implicit param isn't recognized as a PredType, x and y\n-- will be inferred to have two params instead of one.\n\nmodule ShouldCompile where\n\nx () = ?wibble\n\ny () = x ()\n\nsame :: a -> a -> b\nsame x y = undefined\n\na () = same x id\nb () = same y id\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- !!! Implicit Parameters\n\n-- GHC 5.00 doesn't handle this:\n\n--  Could not deduce `?wibble :: t' from the context ()\n--  Probable fix:\n--      Add `?wibble :: t' to the banding(s) for {y}\n--  Or add an instance declaration for `?wibble :: t'\n--  arising from use of implicit parameter `?wibble' at tc122.hs:18\n--  in the definition of function `y': wibble\n\n\nmodule ShouldCompile where\n\nx () = y\n    where y = ?wibble\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- !!! Monotypes w/ Implicit Parameters\n\n-- GHC 5.00 doesn't handle this:\n\n--  Couldn't match `{?wibble :: Int}' against `()'\n--      Expected type: {?wibble :: Int}\n--      Inferred type: ()\n--  In the first argument of `x', namely `()'\n--  in the definition of function `y': x ()\n\nmodule ShouldCompile where\n\nx () = (?wibble :: Int)\n\ny () = x ()\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# OPTIONS_GHC -O #-}    -- -O casused a Lint error in the simplifier, so I'm putting that in\n                          -- all the time, so we don't miss it in a fast validate\n\n-- !!! Rank 2 polymorphism\n-- Both f and g are rejected by Hugs [April 2001]\n\nmodule Foo  where\n\ndata T = T { t1 :: forall a. a -> a\n           , t2 :: forall b c. b->c->c }\n\n-- Test pattern bindings for polymorphic fields\nf :: T -> (Int,Char, Char)\nf t = let T { t1 = my_t1, t2 = my_t2 } = t\n      in\n      (my_t1 3, my_t1 'c', my_t2 2 'c')\n\nf2 :: T -> (Int,Char, Char)\nf2 t = let T { t1 = my_t1, t2 = my_t2 } = t\n       in\n       (my_t1 3, my_t1 'c', my_t2 2 'c')\n\n-- Test record update with polymorphic fields\ng :: T -> T\ng t = t { t2 = \\x y -> y }\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, UndecidableInstances #-}\n-- UndecidableInstances now needed because the Coverage Condition fails\n\n-- !!! Functional dependency test. Hugs [Apr 2001] fails to typecheck this\n-- We should infer this type for foo\n--      foo :: Q (S (S Z)) (S Z)\n\nmodule ShouldCompile where\n\ndata Z = Z\ndata S a = S a\n\nclass Add a b c | a b -> c where add :: a -> b -> c\n\ninstance Add Z a a\ninstance Add a b c => Add (S a) b (S c)\n\nclass Mul a b c | a b -> c where mul :: a -> b -> c\n\ninstance Mul Z a Z\ninstance (Mul a b c, Add b c d) => Mul (S a) b d\n\ndata Q a b = Q a b\n\n-- Problem here.  This is the addition of rational\n-- numbers: (a/b) + (c/d) = (ad+bc)/bd\n\ninstance (Mul a d ad,\n          Mul b c bc,\n          Mul b d bd,\n          Add ad bc ad_bc) => Add (Q a b) (Q c d) (Q ad_bc bd)\n\nz = Z\nsz = S Z\nssz = S (S Z)\n\nfoo = add (Q sz sz) (Q sz sz)\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, FlexibleContexts, UndecidableInstances #-}\n-- UndecidableInstances now needed because the Coverage Condition fails\n\n-- !!! Functional dependency test. Hugs [Apr 2001] fails to typecheck this\n-- Rather bizarre example submitted by Jonathon Bell\n\nmodule ShouldCompile where\n\n-- module Foo where\n\nclass Bug f a r | f a -> r where\n   bug::f->a->r\n\ninstance                Bug (Int->r) Int      r\ninstance (Bug f a r) => Bug f        (c a)    (c r)\n\nf:: Bug(Int->Int) a r => a->r\nf = bug (id::Int->Int)\n\ng1 = f (f [0::Int])\n-- Inner f gives result type\n--      f [0::Int] :: Bug (Int->Int) [Int] r => r\n-- Which matches the second instance declaration, giving r = [r']\n--      f [0::Int] :: Bug (Int->Int) Int r' => r'\n-- Wwich matches the first instance decl giving r' = Int\n--      f [0::Int] :: Int\n-- The outer f now has constraint\n--      Bug (Int->Int) Int r\n-- which makes r=Int\n-- So g1::Int\n\ng2 = f (f (f [0::Int]))\n-- The outer f repeats the exercise, so g2::Int\n-- This is the definition that Hugs rejects\n\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- !!! Another implicit parameter test, from Alastair Reid\n\nmodule ShouldCompile where\n\nimport Data.Maybe\n\ntype Env = ([(String,Int)],Int)\n\nident1 :: (?env :: Env) => String -> Int\nident1 x = y\n where\n  env = ?env\n  y   = fromJust (lookup x (fst env))\n\nident2 :: (?env :: Env) => String -> Int\nident2 x = y\n where\n  y   = fromJust (lookup x (fst ?env))\n\n\n-- Two more tests from Jeff Lewis\nx () = y where y = ?wibble\n\nf () = ?wibble :: Int\ng () = f ()\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Test type checking of mutually recursive groups\n-- GHC 5.00 was falling into a black hole when type checking a recursive\n-- group of type declarations including a *chain* of type synonyms.\n\nmodule ShouldCompile where\n\n  type PhraseFun = PMap -> Float\n  type PMap      = () -> Player\n  data Player    = MkT PhraseFun\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- !!! Test inheritance of implicit parameters.\n-- GHC 5.00.2 fails this test\n\n-- The thing is to do with whether an implicit parameter\n-- constraint can be \"inherited\".  See notes in TcSimplify.lhs\n\nmodule ShouldCompile where\n\ndata R = R {f :: Int}\n\nfoo :: (?x :: Int) => R -> R\nfoo r = r {f = ?x}\n\nbaz :: (?x :: Int) => Int\nbaz = (?x +1) :: Int\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- !!! Desugaring of record updates\n-- Showed up a bug in the newtype-squashing machinery\n\n\nmodule ShouldCompile where\n\ndata R = R {field :: Int}\n\ntest:: (?param :: R) => a -> Int\ntest x = field (?param {field = 42})\n        -- The type of the record to be updated is\n        -- {?param :: R} as well as plain R\n        -- which confused the compiler\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- !!! Typechecking of functional dependencies\n-- Showed up (another) bug in the newtype-squashing machinery\n\n\nmodule ShouldCompile where\n\nclass Split2 a b | a -> b, b -> a where\n    combine2 :: (b,b) -> a\n\nclass Split4 a b | a -> b, b -> a where\n    combine4 :: (b,b) -> a\n\nnewtype Word16 = Word16 Int\nnewtype Word32 = Word32 Int\nnewtype Word64 = Word64 Int\n\ninstance Split2 Word32 Word16 where\n    combine2 = undefined\n\ninstance Split2 Word64 Word32 where\n    combine2 a = undefined\n\ninstance Split4 Word64 Word16 where\n    combine4 (a, b) = \n        combine2 ( (combine2 (a, b)), combine2 (a, b))\n\n\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Monomorphism restriction\n-- This one should work fine, despite the monomorphism restriction\n-- Fails with GHC 5.00.1\n\nmodule Test where\nimport Control.Monad.ST\nimport Data.STRef\n\n-- Should get\n-- apa :: forall s. ST s ()\napa = newSTRef () >> return  ()\n\nfoo1 = runST apa\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}\n\n-- !!! Existentials\n\n-- This one killed GHC 5.00.1:\n--    Inferred type is less polymorphic than expected\n--    Quantified type variable `a' is unified with another quantified type variable `a'\n--    When checking a pattern that binds f :: a -> Int\n--    In the definition of `f': f (T (x :: a) f) = T (undefined :: a) f\n\nmodule Test where\n\ndata T = forall a. T a (a->Int)\n\nf :: T -> T\nf (T (x::a) f) = T (undefined::a) f\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\n-- !!! Scoped type variables: result sig\n\nmodule Test where\n\nf :: Int -> Int\nf x :: Int = x\n\ng :: Int -> Int\ng x :: a = x :: a       -- Here, a is a name for Int\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification #-}\n\n-- !!! scoped type variables w/ existential types\n-- this test failed in GHC 5.00\n\nmodule ShouldCompile where\n\ndata T = forall a. MkT [a]\n\nf :: T -> T\nf (MkT [t::a]) = MkT t3\n    where t3::[a] = [t,t,t]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\n-- !!! scoped type variables\n-- this test failed in pre-release GHC 5.02\n\nmodule ShouldCompile where\n\nf :: forall x. x -> x -> x\nf (x::x) (y::x) = x\n-- Two points: (a) we are using x as a term variable and as a type variable\n--             (b) the type variable appears twice, but that is OK\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances #-}\n{-# OPTIONS -dcore-lint #-}\n\n{-       This one killed GHC 5.02\n\nThe problem is that in rather obscure cases (involving functional\ndependencies) it is possible to get an AbsBinds [] [] (no tyvars, no\ndicts) which nevertheless has some \"dictionary bindings\".  These come\nout of the typechecker in non-dependency order, so we need to Rec them\njust in case.   Otherwise we get a CoreLint out-of-scope error.\n\nReported by Armin Groesslinger\n\n-}\n\nmodule ShouldCompile\nwhere\n\ndata X a = X a\n\nclass Y a b | a -> b where\n    y :: a -> X b\n\ninstance Y [[a]] a where\n    y ((x:_):_) = X x\n\ng :: Num a => [X a] -> [X a]\ng xs = h xs\n    where\n    h ys = ys ++ map (k (y [[0]])) xs\n\nk :: X a -> X a -> X a\nk _ _ = y ([] ++ [[]] ++ [])\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- Make sure for-alls can occur in data types\n\nmodule Foo where\n\nnewtype CPS1 a = CPS1 { unCPS1 :: forall ans . (a -> ans) -> ans }\n\nnewtype CPS2 a = CPS2 (forall ans . (a -> ans) -> ans)\n        -- This one also has an interesting record selector;\n        -- caused an applyTypeArgs crash in 5.02.1\n\ndata    CPS3 a = CPS3 { unCPS3 :: forall ans . (a -> ans) -> ans }\ndata    CPS4 a = CPS4 (forall ans . (a -> ans) -> ans)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\n-- Scoped type variables on pattern bindings\n-- This should *fail* on GHC 5.02 and lower,\n-- It's a post-5.02 enhancements to allow them.\n\n-- It's an error again in GHC 6.6!\n\nmodule ShouldCompile where\n\nf x = let (p::a,q::a) = x in (q::a,p)\n\ng a b = let y::a = a in\n        let  v :: a\n             v = b\n         in v\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Legitimate re-use of prelude class-method name (==)\n-- Used not to be legal, but a late H98 change made it legal\n--\nmodule ShouldFail where\n\ndata NUM = ONE | TWO\nclass EQ a where\n        (==) :: a -> a -> Bool\n\ninstance EQ NUM where\n        a == b = True\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- These two declarations get their derived instances\n-- in two different ways\n\nmodule ShouldCompile where\n\nnewtype Bar = Bar Int deriving Eq\ndata    Baz = Baz Bar deriving Eq\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\n\n-- Rank-2 types with implicit parameters.\n-- GHC 5.02 erroneously rejected this\n\nmodule ShouldCompile where\n\n    f :: ((?param :: a) => b) -> a -> b\n    f foo a = let ?param = a in foo \n\n    g :: (?param :: a) => a\n    g = ?param\n\n    h :: a -> a\n    h = f g\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes, ImplicitParams, UnboxedTuples #-}\n\n-- Test two slightly exotic things about type signatures\n\nmodule ShouldCompile where\n\n        -- The for-all hoisting should hoist the\n        -- implicit parameter to give\n        --      r :: (?param::a) => a\n    r :: Int -> ((?param :: a) => a)\n    r = error \"urk\"\n\n        -- The unboxed tuple is OK because it is\n        -- used on the right hand end of an arrow\n    type T = (# Int, Int #)\n\n    f :: Int -> T\n    f = error \"urk\"\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- The interesting thing about this one is that\n-- there's an unbound type variable of kind *->*\n-- that the typechecker should default to some \n-- arbitrary type.\n--\n-- GHC 5.02 could only really deal with such things\n-- of kind *, but 5.03 extended that to *->..->*\n-- Still not complete, but a lot better.\n\nmodule ShouldCompile where\n\nf :: (forall a b . a b -> int) -> (forall c . c int) -> int \nf x y = x y\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one sent 5.03 into an infinite loop, because it\n-- gazed too deeply into the functional type of PP\n\nmodule ShouldCompile where\n\nnewtype PP = PP (Int -> PP)\n\nfoo = PP undefined\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This program tickled a bug in 5.02.2's forall-lifting\n\nmodule ShouldCompile where\n\nclass Class x where\n combinator' :: (forall y. Class y => y -> y) -> x -> x\n\ncombinator :: (forall y. Class y => y -> y)\n           -> (forall x. Class x => x -> x)\ncombinator f = combinator' f\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LiberalTypeSynonyms #-}\n{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldCompile where\n\ntype Generic i o = forall x. i x -> o x\ntype Id x = x\n\nfoo :: Generic Id Id\nfoo = error \"urk\"\n\n-- The point here is that we instantiate \"i\" and \"o\"\n-- with a partially applied type synonym.  This is\n-- OK in GHC because we check type validity only *after*\n-- expanding type synonyms (with LiberalTypeSynonyms enabled).\n--\n-- However, a bug in GHC 5.03-Feb02 made this break a\n-- type invariant (see Type.mkAppTy)\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\nmodule ShouldCompile where\n\nf v = (\\ (x :: forall a. a->a) -> True) id -- 'c'\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- A test for rank-3 types\n\nmodule ShouldCompile where\n\ndata Fork a                   =  ForkC a a\n\nmapFork                       :: forall a1 a2 . (a1 -> a2) -> (Fork a1 -> Fork a2)\nmapFork mapA (ForkC a1 a2)    =  ForkC (mapA a1) (mapA a2)\n\ndata SequF s a    =  EmptyF | ZeroF (s (Fork a)) | OneF a (s (Fork a))\nnewtype HFix h a  =  HIn (h (HFix h) a)\n\ntype Sequ =  HFix SequF\n\nmapSequF  :: forall s1 s2 . (forall b1 b2 . (b1 -> b2) -> (s1 b1 -> s2 b2))\n                         -> (forall a1 a2 . (a1 -> a2) -> (SequF s1 a1 -> SequF s2 a2))\nmapSequF mapS mapA EmptyF     =  EmptyF\nmapSequF mapS mapA (ZeroF as) =  ZeroF (mapS (mapFork mapA) as)\nmapSequF mapS mapA (OneF a as)=  OneF (mapA a) (mapS (mapFork mapA) as)\n\nmapHFix :: forall h1 h2 . (forall f1 f2 . (forall c1 c2 . (c1 -> c2) -> (f1 c1 -> f2 c2))\n                                          -> (forall b1 b2 . (b1 -> b2) -> (h1 f1 b1 -> h2 f2 b2)))\n                          -> (forall a1 a2 . (a1 -> a2) -> (HFix h1 a1 -> HFix h2 a2))\nmapHFix mapH mapA (HIn v)     =  HIn (mapH (mapHFix mapH) mapA v)\n\nmapSequ  :: forall a1 a2 . (a1 -> a2) -> (Sequ a1 -> Sequ a2)\nmapSequ  =  mapHFix mapSequF\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             UndecidableInstances #-}\n-- -XUndecidableInstances now needed because the Coverage Condition fails\n\n-- This one blew up Hugs (Apr 02)\n\nmodule ShouldCompile where\n\n--  Context reduction can introduce opportunities for context improvement,\n--  so add an additional `improve' step afterwards.  The bug is demonstrated by\n--  the following code:\n  \n  class C a b c | a b -> c where\n    m :: a -> b -> c\n  \n  instance C Integer Integer Integer where\n    m = error \"urk\" \n \n  newtype T a = T a\n  \n  instance C a b c => C (T a) (T b) (T c) where\n    m = error \"urk\" \n  \n  i :: T Integer\n  i = undefined\n  \n  x = m (m i i) i -- This line blows up w/ unresolved top-level overloading\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- No ScopedTypeVariables, so (v::a) means (v:: forall a.a)\n\nmodule ShouldCompile where\n\ndata T a = T a\n\ninstance Eq (T a) where\n  (==) x y = let v :: a\n                 v = undefined\n             in\n                v\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The type sig mentions a type variable that doesn't appear in \n-- the type.  This one killed GHC 5.03, in a trivial way.\n\nmodule ShouldCompile where\n\ntype T a = () -> ()\n\nf :: T a\nf () = ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LiberalTypeSynonyms #-}\n\n-- The type sig for 'test' is illegal in H98 because of the\n-- partial application of the type sig.\n-- But with LiberalTypeSynonyms it should be OK because when\n-- you expand the type synonyms it's just Int->Int\n--      c.f should_fail/tcfail107.hs\n\nmodule ShouldCompile where\n\ntype Thing m = m ()\n\ntype Const a b = a\n\ntest :: Thing (Const Int) -> Thing (Const Int)\ntest = test\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n\n-- Test infix type constructors\n\nmodule ShouldCompile where\n\ninfixl 4 :*:\ninfixl 3 :+:\n\ndata a :*: b = a :*: b\ndata a :+: b = a :+: b\n\ndata T a b = T (a `b` Int)\n\ntype Foo a b = a `T` b\n\nf :: Int :*: Bool :+: Char\nf = (3 :*: True) :+: 'c'\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- Test silly type synonyms\n\nmodule ShouldCompile where\n\ntype C u a = u  -- Note 'a' unused\n\nfoo :: (forall a. C u a -> C u a) -> u\nfoo x = undefined x\n\nbar :: Num u => u\nbar = foo (\\t -> t + t)\n-- The (Num u) should not get trapped inside the\n-- /\\a-abstraction which the compiler constructs for\n-- the arg to foo.  But it might because it's Num (C u a)!\n\n-- This test tickles a bizarre corner case documented\n-- as [Silly Type Synonym] in TcMType.lhs\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- Types should be checked for well-formedness only after\n-- expanding type synonyms.  GHC 5.03 fails this\n\nmodule ShouldCompile where\n\ntype All u = forall x. x->u\ntype All' u = u -> All u\n\nall1 :: All u -> (u -> All u) -> All u\nall1 _ _ = undefined\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n\n-- Don't do the cunning new newtype-deriving thing\n-- when the type constructor is recursive\n\nmodule Main where\n\n\nnewtype A = A [A] deriving (Eq)\n\n-- The derived instance would be:\n-- instance Eq A where\n--      (A xs) == (A ys) = xs==ys\n--   $df :: Eq [A] => Eq A\n--   $df d = d |> Eq (sym co)\n\nx :: A\nx = A [A [], A [A []]]\n\nmain = print (x == x)\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n--Tests alpha-renaming in with extended type-synonyms\n\nmodule ShouldCompile where\n\ntype Foo x = forall a. a -> x\n\nfoo :: Foo (Foo ())\n-- foo :: forall a b. a -> b -> ()\n--  NOT   forall a. a -> a -> ()\nfoo =  undefined\n\nbaz = foo 'c' True\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n-- Blew up GHC 5.04, with:\n--    Ambiguous type variable(s) `q' in the constraint `Foo q'\n--    arising from a function with an overloaded argument type at Foo.hs:7\n--      Expected type: Int -> (forall q1. (Foo q1) => q1 -> a) -> a\n--      Inferred type: Int -> (q -> a) -> a\n--    In the application `GHC.Err.noMethodBindingError \"Foo.hs:7|Foo.foo\"#'\n--\n-- Fix is to give wild-card args to the default methods\n-- See TcClassDcl.mkDefMethRhs\n\nmodule ShouldCompile where\n\nclass Foo a where\n  op :: Eq c => c -> (forall b. Eq b => b->b) -> a -> a\n\ninstance Foo Int\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- These ones failed with 5.04.  They need a coercion\n-- in the pattern matching compiler, so they are a bit\n-- tricky.\n\n-- GHC 6.3: these are back to failures, because we no longer do\n--          type subsumption in pattern-matching\n\n-- GHC 7.0: back to success\n\nmodule ShouldCompile where\n\nnewtype Bug s a = Bug a\n\nrunBug :: (forall s. Bug s a) -> a\nrunBug (Bug _) = undefined\n\nnewtype BugN s a = BugN a\n\nrunBugN :: (forall s. BugN s a) -> a\nrunBugN (BugN _) = undefined\n\ndata Foo a b = Foo { foo :: a -> b }\n\nbaz :: String -> (forall a b . Foo a b) -> IO ()\nbaz s (Foo { foo = foo }) = putStrLn s\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This one killed GHC 5.05 and earlier\n-- The problem was in a newtype with a record selector, with\n-- a polymorphic argument type.  MkId generated a bogus selector\n-- function\n\nmodule ShouldCompile where\n\ntype M3 a = forall r. (forall b. M3' b -> (b -> M3' a) -> r) -> r\n\nnewtype M3' a = M3' { mkM3' :: M3 a }\n\nflop :: forall a b. M3' b -> (b -> M3' a) -> Int\nflop = \\m' k -> mkM3' m' (\\bm k1 -> error \"urk\")\n\n-- Suppose mkM3' has the straightforward type: \n--     mkM3' :: forall a. M3' a -> M3 a\n-- Then (mkM3' m') :: forall r. (forall b. ...) -> r\n-- If we simply do a subsumption check of this against\n--    alpha -> Int\n-- where alpha is the type inferred for (\\bm k1 ...) \n-- this won't work.\n\n-- But if we give mkM3' the type \n--     forall a r. M3' a -> (forall b. ...) -> r\n-- everthing works fine.  Very very delicate.\n\n---------------- A more complex case -------------\nbind :: M3 a -> (a -> M3 b) -> M3 b\nbind m k b = b (M3' m) (\\a -> M3' (k a))\n\nobserve :: M3 a -> a\nobserve m\n      = m (\\m' k -> mkM3' m'\n                (\\bm k1 -> observe (bind (mkM3' bm)\n                        (\\a -> bind (mkM3' (k1 a)) (\\a -> mkM3' (k a)))))\n                )\n\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\nmodule ShouldCompile where\n\ndata UniqueSupply = US Integer\n\nnewUnique :: (?uniqueSupply :: UniqueSupply) => Integer\nnewUnique = r\n    where US r = ?uniqueSupply\n        -- The lazy pattern match in the where clause killed GHC 5.04\n        -- because the type {?uniqueSupply::UniqueSupply} of the RHS\n        -- of the 'where' didn't look like a UniqueSupply\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstrainedClassMethods #-}\n{-# OPTIONS_GHC -dcore-lint #-}\n\n-- Fails GHC 5.04.2 with -dcore-lint\n-- The issue ariseswhen you have a method that\n-- constrains a class variable\n\nmodule Test where\n\nclass C a where\n    f :: (Eq a) => a\n\ninstance C () where\n    f = f\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             ExistentialQuantification, RankNTypes,\n             FlexibleInstances #-}\n\n-- Arguably, the type signature for f1 should be enough to make\n-- this program compile, but in 5.04 it wasn't; the\n-- extra sig in f2 was needed.\n--\n-- This is a pretty borderline case.\n\nmodule ShouldCompile where\n\n    class C t a b | t a -> b\n    instance C Char a Bool\n\n    data P t a = forall b. (C t a b) => MkP b\n\n    data Q t = MkQ (forall a. P t a)\n\n    f1 :: Q Char\n    f1 = MkQ (MkP True)\n\n    f2 :: Q Char\n    f2 = MkQ (MkP True :: forall a. P Char a)\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- It used to be that (->) would have a very restrictive kind when used in\n-- prefix position. This restriction was lifted after the levity polymorphism\n-- work in 2016.\n\nmodule ShouldSucceed where\nimport GHC.Base\n\ntype T = (->) Int#\n\n-- Here's the old comment from TypeRep:\n--\n-- funTyCon = mkFunTyCon funTyConName\n--              (mkArrowKinds [liftedTypeKind, liftedTypeKind]\n--                              liftedTypeKind)\n-- You might think that (->) should have type (? -> ? -> *), and you'd be right\n-- But if we do that we get kind errors when saying\n--      instance Control.Arrow (->)\n-- because the expected kind is (*->*->*).  The trouble is that the\n-- expected/actual stuff in the unifier does not go contra-variant, whereas\n-- the kind sub-typing does.  Sigh.  It really only matters if you use (->) in\n-- a prefix way, thus:  (->) Int# Int#.  And this is unusual.\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}\n\n-- We want to get the type\n--      g :: forall a b c.  C a (b,c) => a -> b\n--but GHC 6.0 bogusly gets\n--      g :: forall a b.  C a (b,()) => a -> b\n\n-- Having done this, we reject f on the grounds\n-- that its type is ambiguous: adding the type\n-- signature   g :: C a (b,c) => a -> b\n-- would fail\n\nmodule ShouldCompile where\n\nclass C a b where { op :: a -> b }\n\ng x = fst (op x)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one briefly killed the new GHC 6.4\n\nmodule Foo where\n\nnewtype Foo x = Foo x\n-- data Foo x = Foo x -- this works\n\nclass X a where\n        x :: a -> IO ()\n\nclass X a => Y a where\n        y :: [a] -> IO ()\n\nclass Z z where\n        z :: Y c => z c -> IO ()\n\ninstance X Char where\n        x = putChar\ninstance X a => X (Foo a) where\n        x (Foo foo) = x foo\n\ninstance Y Char where\n    y cs = mapM_ x cs\n\ninstance Z Foo where\n        z = x\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test killed GHC 6.0.2 when it read the interface file for\n-- Tc170_Aux, because there was a\n--      forall a. (# ... #)\n-- in the default method for 'position'\n--\n-- NB: only fails when compiled in batch mode. In --make mode, GHC\n--     doesn't read the interface file, so all is well.\n\nmodule ShouldCompile where\n\nimport Tc170_Aux\n\ndata Bitmap = Bitmap\n\ninstance Dimensions Bitmap where\n  frame = error \"urk\"\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\nmodule Tc170_Aux where\n\nclass ReadMode mode\n\ndata Attr m w a = Attr (w -> IO a) (w -> a -> IO ())  \n\nmapAttr :: ReadMode m => (a -> b) -> (a -> b -> a) -> Attr m w a -> Attr m w b\nmapAttr get set (Attr getter setter)\n    = Attr (\\w   -> do a <- getter w; return (get a))\n           (\\w b -> do a <- getter w; setter w (set a b))\n\n\ndata Rect  = Rect\ndata Point = Point\ntopLeft    = undefined\nrectMoveTo = undefined\n\nclass Dimensions w where\n  frame    :: ReadMode m => Attr m w Rect\n\n  position :: ReadMode m => Attr m w Point\n  position  = mapAttr (\\f -> topLeft f) (\\f p -> rectMoveTo p f) frame\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Data types with no constructors\n\nmodule ShouldCompile where\n\ndata S\ndata T a\n\nf :: [T a] -> Int\nf xs = length xs\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test where\n\nclass C s where\n   foo :: (Int -> Int) -> s -> s\n\ninstance C Int where\n   foo = undefined --prevent warning\n\nbar _ = baz where\n   baz :: C s => s -> s\n   baz = foo baz\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, UndecidableInstances #-}\n\nmodule Tc173a where\n\nclass FormValue value where\n   isFormValue :: value -> ()\n   isFormValue _ = () \n\nclass FormTextField value\n\ninstance FormTextField String\n\ninstance {-# OVERLAPPABLE #-} FormTextField value => FormTextFieldIO value\n\nclass FormTextFieldIO value\n\ninstance FormTextFieldIO value => FormValue value\n\ninstance {-# OVERLAPPING #-} FormTextFieldIO value => FormTextFieldIO (Maybe value)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\nmodule Tc173b where\n\nimport Tc173a\n\nis :: ()\nis = isFormValue (Just \"\")", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule ShouldCompile where\n\nf x = (# x, x #) :: (# Int, Int #)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- See trac bug 179\n\n-- Gives a bogus type error\n--    No instance for (Show (t -> Bool))\n--      arising from use of `show' at tc175.hs:11:8-11\n--    In the definition of `foo': foo x = show (\\ _ -> True)\n-- because the instance decl has type variables with\n-- kind *, whereas the constraint (Show (x -> Bool)) has x::??\n-- Kind of stupid, really, but awkward to fix.\n\nmodule ShouldCompile where\n\ninstance Show (a->b)\n\nfoo x = show (\\ _ -> True)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n{-  With \"hugs -98 +o test.hs\" gives me:\n    ERROR \"test.hs\":8 - Cannot justify constraints in instance member binding\n    *** Expression    : fromStr\n    *** Type          : FromStr [a] => String -> [a]\n    *** Given context : FromStr [a]\n    *** Constraints   : FromStr [a]\n\n    Adding the constraint \"FromStr a\" to the declaration of fromStr fixes \n    the problem, but that seems like it should be redundant. Removing the \n    second instance (lines 10-11) also fixes the problem, interestingly enough.\n\n    /Bjorn Bringert -}\n\n-- August 08: on reflection I think a complaint about overlapping\n-- instances for line 8 is absolutely right, so I've changed this to\n-- expected-failure\n\n-- Sept 08: on further reflection (!) I'm changing it back\n-- See Note [Subtle interaction of recursion and overlap]\n-- in TcInstDcls\n\nmodule ShouldCompile  where\n\nclass FromStr a where\n     fromStr :: String -> a\n\ntypeError :: FromStr a => a -> a\ntypeError t = error \"type error\"\n\ninstance {-# OVERLAPPABLE #-} FromStr [a] where\n     fromStr _ = typeError undefined  -- line 8\n\ninstance {-# OVERLAPPING #-} FromStr [(String,a)] where  -- line 10\n     fromStr _ = typeError undefined  -- line 11\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, UndecidableInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- This is a rather complicated program that uses functional\n-- dependencies to do Peano arithmetic.\n--\n-- GHC 6.2 dies because tcSimplifyRestricted was trying to\n-- be too clever.  See 'Plan B' in tcSimplifyRestricted\n\nmodule ShouldCompile where\n\n\n\n-- This is the offending definition.  It falls under\n-- the monomorphism restriction, so tcSimplifyRestricted applies\nbug = ins b (ins b Nil)\n\n\n------------------------------------\ndata LAB l r = LAB l r deriving Show\n\ndata OR a b = OR a b deriving Show\n\n\ndata Cons x y = Cons x y deriving Show\n\ndata Nil = Nil deriving Show\n\ndata T = T\n\ndata F = F\n\ndata A = A deriving Show\n\ndata B = B deriving Show\n\ndata Zero = Zero\n\ndata Succ n = Succ n\n\nb = ((LAB B []),[])\n\n-- insertion function\n-- insert label pairs in the a list of list, each list contains a collection of\n-- label pair that sharing the common label.\n\n\nclass Ins r l l' | r l -> l' where\n    ins :: r -> l -> l'\n\n\ninstance Ins ((LAB l1 r1),r1') Nil (Cons (Cons ((LAB l1 r1),r1') Nil) Nil) where\n    ins l Nil = (Cons (Cons l Nil) Nil)\n\n\ninstance ( L2N l1 n1\n     , L2N l2 n2\n     , EqR n1 n2 b\n     , Ins1 ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') b l\n     ) => Ins ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') l\n    where\n      ins ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs')\n        = ins1  ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs')\n                (eqR (l2n l1)  (l2n l2))\n-- Note that n1 and n2 are functionally defined by l1 and l2, respectively,\n-- and b is functionally defined by n1 and n2.\n\n\nclass Ins1 r l b l' | r l b -> l' where\n    ins1 :: r -> l -> b -> l'\n\ninstance Ins1 ((LAB l1 r1),r1') (Cons r rs) T\n              (Cons (Cons ((LAB l1 r1),r1') r) rs) where\n   ins1 l (Cons r rs) _ = (Cons (Cons l r) rs)\n\ninstance ( Ins ((LAB l1 r1),r1') rs rs')\n      => Ins1 ((LAB l1 r1),r1') (Cons r rs) F (Cons r rs') where\n    ins1 l (Cons r rs) _ = (Cons r (ins l rs))\n\n-- class for mapping label to number\n\nclass L2N l n | l -> n where\n    l2n :: l -> n\n\ninstance L2N A Zero where\n    l2n A = Zero\n\ninstance L2N B (Succ Zero) where\n    l2n B = Succ Zero\n\n\n-- class for comparing number type\n\nclass EqR n1 n2 b | n1 n2 -> b where\n    eqR :: n1 -> n2 -> b\n\ninstance EqR Zero Zero T where\n    eqR _ _ = T\n\ninstance EqR Zero (Succ n) F where\n    eqR _ _ = F\n\ninstance EqR (Succ n) Zero F where\n    eqR _ _ = F\n\ninstance (EqR n1 n2 b) => EqR (Succ n1) (Succ n2) b where\n    eqR (Succ n1) (Succ n2) = eqR n1 n2\n\n", "num_lines": 109}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleInstances #-}\n\n-- This one tickled the kind-check in TcType.matchTys,\n-- which should use sub-kinding\n\nmodule ShouldCompile where\n\ntype TypeRep = ()\n\nclass Typeable2 t where\n  typeOf2 :: t a b -> TypeRep\n \nclass Typeable1 t where\n  typeOf1 :: t a -> TypeRep\n\nclass Typeable0 a where\n  typeOf0 :: a -> TypeRep\n\ninstance Typeable2 (->) where\n  typeOf2 = undefined\n\ninstance (Typeable2 t, Typeable0 a) => Typeable1 (t a) where\n  typeOf1 = undefined\n\ninstance (Typeable1 t, Typeable0 a) => Typeable0 (t a) where\n  typeOf0 = undefined\n\nclass Typeable0 a => Data0 a where\n  dataTypeOf0 :: a -> Bool\n\ninstance (Data0 a, Data0 b) => Data0 (a -> b) where\n  dataTypeOf0 = undefined\n\nfoo :: (Typeable0 a, Typeable0 b) => (a -> b) -> TypeRep\nfoo f = typeOf0 f\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, FlexibleInstances, UndecidableInstances #-}\n\n-- Tests context reduction for existentials\n\nmodule TestWrappedNode where\n\nclass Foo a where { op :: a -> Int }\n\ninstance {-# OVERLAPPABLE #-} Foo a => Foo [a] where    -- NB overlap\n  op (x:xs) = op x\ninstance {-# OVERLAPPING #-} Foo [Int] where            -- NB overlap\n  op x = 1\n\ndata T = forall a. Foo a => MkT a\n\nf :: T -> Int\nf (MkT x) = op [x,x]\n        -- The op [x,x] means we need (Foo [a]).  We used to\n        -- complain, saying that the choice of instance depended on\n        -- the instantiation of 'a'; but of course it isn't *going*\n        -- to be instantiated.\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, UndecidableInstances #-}\n\n-- This tests an aspect of functional dependencies, revealing a bug in GHC 6.0.1\n-- discovered by Martin Sulzmann\n\n\nmodule ShouldCompile where\n\ndata PHI = PHI\ndata EMPT = EMPT\ndata LAB l a = LAB l a\ndata Phi = Phi\n\ndata A = A\ndata A_H = A_H [Char]\n\n\nclass LNFyV r1 r2 h1 h2 | r1 -> r2, r1 r2 -> h1 h2 where\n    lnfyv :: r1->r2->h1->h2\n\ninstance ( REtoHT (LAB l c) h)\n        => LNFyV (LAB l c) ((LAB l c),EMPT) h (h,[Phi]) where -- (L2)\n    lnfyv = error \"urk\"\n\nclass REtoHT s t | s->t\ninstance REtoHT (LAB A [Char]) A_H    -- (R4)\n\nfoo = lnfyv (LAB A \"\") ((LAB A \"\"),EMPT) (A_H \"1\")\n\n\n{-\nghci 6.0.1\n\n*Test> :t (lnfyv (LAB A \"\") ((LAB A \"\"),EMPT) (A_H \"1\") )\n\nNo instance for (LNFyV (LAB A [Char])\n                       (LAB A [Char], EMPT)\n                       A_H\n                       (h, [Phi]))\n  arising from use of `lnfyv' at <No locn>\n\n\nhugs November 2002\n\nTest> :t (lnfyv (LAB A \"\") ((LAB A \"\"),EMPT) (A_H \"1\"))\nlnfyv (LAB A \"\") (LAB A \"\",EMPT) (A_H \"1\") :: (A_H,[Phi])\n\n\nhugs is right, here's why\n\n\n(lnfyv (LAB A \"\") ((LAB A \"\"),EMPT) (A_H \"1\")) yields\n\n\n                  LNFyV (LAB A Char) ((LAB A Char),EMPT) (A_H) c\n\nimprove by (L2)   LNFyV (LAB A Char) ((LAB A Char),EMPT) (A_H) (A_H,[Phi]), c=(A_H,[Phi])\nreduce by (L2)    REtoHT (LAB A Char) A_H, c=(A_H,[Phi])\nreduce by (R4)    c=(A_H,[Phi])\n\n\n-}\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, FlexibleContexts, UndecidableInstances #-}\n\n-- Example of improvement, due to George Russel\n\nmodule Folders where\n\ndata Folder = Folder\n\nnewtype SB x = SB x\nnewtype SS x = SS x\n\ndata NodeArcsHidden = NodeArcsHidden\n\nclass HasSS hasS x | hasS -> x where\n   toSS :: hasS -> SS x\n\ninstance HasSS (SB x) x where\n   toSS (SB x) = (SS x)\n\nclass HMV option graph node where\n   modd :: option -> graph -> node value -> IO ()\n\ninstance HMV NodeArcsHidden graph node\n      => HMV (Maybe NodeArcsHidden) graph node\n  where\n   modd = error \"burk\"\n\ngn :: HMV NodeArcsHidden graph node\n   => graph\n   -> SS (graph -> node Int -> IO ())\ngn graph = fmapSS (\\ arcsHidden -> (\\ graph node -> modd arcsHidden graph node))\n                  (toSS (error \"C\" :: SB (Maybe NodeArcsHidden)))\n\n-- The call to modd gives rise to\n--      HMV option graph node\n-- The call to toSS gives rise to\n--      HasSS (SB (Maybe NodeArcsHidden)) x\n-- where (toSS (error ...)) :: SS x\n-- and hence arcsHidden :: x\n--\n-- Then improvement should give x = Maybe NodeArcsHidden\n-- and hence option=Maybe NodeArcsHidden\n\nfmapSS :: (a->b) -> SS a -> SS b\nfmapSS = error \"urk\"\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts, ExistentialQuantification #-}\n\n-- Tests the \"stupid theta\" in pattern-matching\n-- when there's an existential as well\n\nmodule ShouldCompile  where\n\ndata (Show a) => Obs a = forall b. LiftObs a b\n\nf :: Show a => Obs a -> String\nf (LiftObs _ _) = \"yes\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ExistentialQuantification, RankNTypes #-}\n\n-- An interesting interaction of universals and existentials, prompted by\n-- http://www.haskell.org/pipermail/haskell-cafe/2004-October/007160.html\n--\n-- Note the non-nested pattern-match in runProg; tcfail126 checks the\n-- nested pattern match\n\nmodule Foo  where\n\nimport Control.Monad.Trans\n\ndata Bar m\n  = forall t. (MonadTrans t, Monad (t m))\n           => Bar (t m () -> m ()) (t m Int)\n\ndata Foo = Foo (forall m. Monad m => Bar m)\n\nrunProg :: Foo -> IO ()\nrunProg (Foo b) = case b of\n                    Bar run op -> run (prog op)\n        -- You can't say runProg (Foo (Bar run op));\n        -- see tcfail126\n\nprog :: (MonadTrans t, Monad (t IO)) => a -> t IO ()\nprog x = error \"urk\"\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, ExistentialQuantification #-}\n\n-- Both these two fail in 6.2.2 \n\nmodule ShouldCompile where\n\n\n-- A record with an 'existential' context that binds no\n-- type vars, so record selectors should be OK\ndata Test1 = (?val::Bool) => Test1 { name :: String }\n \ninstance Show Test1 where\n    show p = name p\n\n\n-- Same, but no record selector; GHC 6.2.2 failed because it tried\n-- to derive generic to/from \ndata Test2 = (?val::Bool) => Test2 String\nf (Test2 s) | ?val = s\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, BangPatterns #-}\n\n-- Killed GHC 6.3 HEAD\n\nmodule Bug where\nimport GHC.Base\n\nfoo v = let !(I# x#) = 7 * 7 in \"Forty-Two\"", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Killed 6.2.2\n-- The trouble was that 1 was instantiated to a type (t::?)\n-- and the constraint (Foo (t::? -> s::*)) didn't match Foo (a::* -> b::*).\n-- Solution is to zap the expected type in TcEpxr.tc_expr(HsOverLit). \n\nmodule ShouldCompile where\n\nclass Foo a where\n     foo :: a\n\ninstance Foo (a -> b) where\n     foo = error \"urk\"\n\ntest :: ()\ntest = foo 1\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE UndecidableInstances, FlexibleInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n-- UndecidableInstances now needed because the Coverage Condition fails\n\n-- Hugs failed this functional-dependency test\n-- Reported by Iavor Diatchki Feb 05\n\nmodule ShouldCompile where\n\ndata N0\nnewtype Succ n    = Succ n\n\nclass Plus a b c | a b -> c\ninstance Plus N0 n n\ninstance Plus a b c => Plus (Succ a) b (Succ c)\n\n( # )              :: Plus x y z => x -> y -> z\n( # )               = undefined\n\nclass BitRep t n | t -> n where\n  toBits         :: t -> n\n\ninstance BitRep Bool (Succ N0) where\n  toBits = error \"urk\"\n\ninstance BitRep (Bool,Bool,Bool) (Succ (Succ (Succ N0))) where\n  toBits (x,y,z) = toBits x # toBits y # toBits z\n\n-- Hugs complains that it cannot solve the constraint:\n-- Plus (Succ N0) (Succ N0) (Succ (Succ N0))\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, MultiParamTypeClasses, LiberalTypeSynonyms #-}\n\n-- Test infix type constructors for type synonyms\n\nmodule ShouldCompile where\n\ninfix 9 :-+-:\ntype (f :-+-: g) t o1 o2 = Either (f t o1 o2) (g t o1 o2)\n\ndata Foo a b c = Foo (a,b,c)\n\ntype App f = f Int Bool Int\n\nf :: (Foo :-+-: Foo) Bool Int Bool\nf = error \"urk\"\n\ng :: App (Foo :-+-: Foo) \ng = error \"urk\"\n\n-------- classes --------\n\nclass (Eq a, Eq b) => a :&: b where\n   op :: a -> b\n\nh :: (a :&: b) => a -> b\nh x = op x\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonoPatBinds #-}\n        -- Disable experimental monomorphic pattern bindings\n\n-- Nasty test for type signatures\n-- In both groups of declarations below, the type variables 'a' and 'b'\n-- end up being unified together.\n\nmodule ShouldCompile where\n\n-------------\n  x :: a\n  x = z `asTypeOf` y\n\n  y :: b\n  y = z\n\n  z = x\n-------------\n  p :: [a]\n  q :: b\n  (p,q,r) = ([q,r], r, head p)\n\n-------------\n  t :: a\n  u :: b\n  (t,u,v) = (v,v,t)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, KindSignatures #-}\n\n-- The record update triggered a kind error in GHC 6.2\n\nmodule Foo where\n\nimport Data.Kind (Type)\n\ndata HT (ref :: Type -> Type)\n  = HT { kcount :: Int }\n\nset_kcount :: Int -> HT s -> HT s\nset_kcount kc ht = ht{kcount=kc}\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n-- This only typechecks if forall-hoisting works ok when\n-- importing from an interface file.  The type of Twins.gzipWithQ\n-- is this:\n--   type GenericQ r = forall a. Data a => a -> r\n--   gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])\n-- It's kept this way in the interface file for brevity and documentation,\n-- but when the type synonym is expanded, the foralls need expanding\n\nmodule Foo where\n\nimport Data.Generics.Basics\nimport Data.Generics.Aliases\nimport Data.Generics.Twins(gzipWithQ)\n\n-- | Generic equality: an alternative to \\deriving Eq\\\ngeq :: Data a => a -> a -> Bool\ngeq x y = geq' x y\n  where\n--    This type signature no longer works, because it is\n--    insufficiently polymorphic.\n--    geq' :: forall a b. (Data a, Data b) => a -> b -> Bool\n    geq' :: GenericQ (GenericQ Bool)\n    geq' x y =     (toConstr x == toConstr y)\n                && and (gzipWithQ geq' x y)\n\n\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE Arrows, CPP, TypeOperators #-}\n\n-- Test infix type notation and arrow notation\n\nmodule Test where\n\nimport Prelude hiding (id,(.))\nimport Control.Category\nimport Control.Arrow\n\n-- For readability, I use infix notation for arrow types.  I'd prefer the\n-- following, but GHC doesn't allow operators like \"-=>\" as type\n-- variables.\n-- \n-- comp1 :: Arrow (-=>) => b-=>c -> c-=>d -> b-=>d\n\n\ncomp1 :: Arrow to => b `to` c -> c `to` d -> b `to` d\ncomp1 f g = proc x -> do\n            b <- f -< x\n            g -< b\n\n-- arrowp produces\n-- comp1 f g = (f >>> g)\n\ncomp :: Arrow to => (b `to` c, c `to` d) `to` (b `to` d)\ncomp = arr (uncurry (>>>))\n\n-- app :: Arrow to => (b c, b) `to` c\n\ntype R = Float\ntype I = Int\n\nz1,z2 :: Arrow to => I `to` (R `to` R)\nz1 = undefined \nz2 = z1\n\nz3 :: Arrow to => (I,I) `to` (R `to` R,R `to` R)\nz3 = z1 *** z2\n\nz4 :: Arrow to => (I,I) `to` (R `to` R)\nz4 = z3 >>> comp\n\ncomp4,comp5 :: Arrow to =>\n  b `to` (c `to` d) -> e `to` (d `to` f) -> (b,e) `to` (c `to` f)\n\ncomp4 g f = proc (b,e) -> do\n            g' <- g -< b\n            f' <- f -< e\n            returnA -< (g' >>> f')\n\ncomp5 g f = (g *** f) >>> comp\n\nlam,lam2 :: Arrow to => (e,b) `to` c -> e `to` (b `to` c)\n\nlam f = arr $ \\ e -> arr (pair e) >>> f\n\npair a b = (a,b)\n\n-- I got the definition lam above by starting with\n\nlam2 f = proc e ->\n         returnA -< (proc b -> do\n                     c <- f -< (e,b)\n                     returnA -< c)\n\n-- I desugared with  the arrows preprocessor, removed extra parens and\n-- renamed \"arr\" to \"pure\", to get\n-- \n--  lam f = pure (\\ e -> pure (\\ b -> (e, b)) >>> f)\n\n-- Note that lam is arrow curry\n\n-- curry :: ((e,b) -> c) -> (e -> b -> c)\n\n-- All equivalent:\n\ncurry1 f e b = f (e,b)\n\ncurry2 f = \\ e -> \\ b -> f (e,b)\n\ncurry3 f = \\ e -> f . (\\ b -> (e,b))\n\ncurry4 f = \\ e -> f . (pair e)\n\n\n\ncomp6 :: Arrow to => b `to` (c `to` d) -> e `to` (d `to` f)\n                  -> b `to` (e `to` (c `to` f))\ncomp6 g f = lam $ comp5 g f \n\n-- What about uncurrying?\n\n-- uncurryA :: Arrow to => b `to` (c `to` d)\n--                     -> (b,c) `to` d\n-- uncurryA f = proc (b,c) -> do\n--              f' <- f -< b\n--              returnA -< f' c\n\n-- Why \"lam\" instead of \"curryA\" (good name also): so I can use Arrows\n-- lambda notation, similar to\n\ncompF g f = \\ b e -> g b . f e\n\n-- But I haven't figured out how to.\n\n-- comp7 :: Arrow to => b `to` (c `to` d) -> e `to` (d `to` f)\n--                   -> b `to` (e `to` (c `to` f))\n-- comp7 g f = proc b -> proc e -> do\n--             g' <- g -< b\n--             f' <- f -< e\n--             returnA -< (g' >>> f')\n\n-- Try \"(| lam \\ b -> ... |)\" in the FOP arrows chapter\n-- cmd ::= form exp cmd1 ... cmdn.  Parens if nec\n\n-- (| lam (\\ b -> undefined) |)\n\n-- Oh!  The arrow syntax allows bindings with *infix* operators.  And I\n-- don't know how to finish comp7.\n\n-- Uncurried forms:\n\ncomp8 :: Arrow to => (b,c) `to` d -> (e,d) `to` k -> (b,c,e) `to` k\ncomp8 g f = proc (b,c,e) -> do\n            d <- g -< (b,c)\n            f -< (e,d)\n\n-- This looks like straightforward `to` translation.  With insertions of\n-- curry & uncurry operators, it'd probably be easy to handle curried\n-- definitions as well.\n\n-- Simpler example, for experimentation\n\ncomp9 :: Arrow to => (c,d) `to` e -> b `to` d -> (b,c) `to` e\ncomp9 g f = proc (b,c) -> do\n            d <- f -< b\n            g -< (c,d)\n \n-- Desugared:\n\ncomp9' :: Arrow to => (c,d) `to` e -> b `to` d -> (b,c) `to` e\ncomp9' g f = first f >>> arr (\\ (d,c) -> (c,d)) >>> g\n\n\n", "num_lines": 147}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- A newtype representation problem crashed GHC 6.4\n\nmodule ShouldCompile where\n\n\nnewtype Signal a = Signal Symbol\n\nnewtype Symbol = Symbol (S Symbol)\n\ndata S s = Bool Bool\n\nliftl :: Signal a -> Symbol\nliftl (Signal a) = a \n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- Tests the special case of\n--      non-recursive, function binding,\n--      with no type signature\n\nmodule ShouldCompile where\n\nf = \\ (x :: forall a. a->a) -> (x True, x 'c')\n\ng (x :: forall a. a->a) = x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, TypeSynonymInstances #-}\n\n-- This one made GHC 6.4 loop because Unify.unify\n-- didn't deal correctly with unifying\n--      a :=: Foo a\n-- where\n--      type Foo a = a\n\nmodule ShouldSucceed where\n\nnewtype PRef a = PRef a\ntype Drop1 a = a\nclass Ref a r | a -> r  where readRef :: a -> r\ninstance Ref (PRef a) (Drop1 a) where readRef (PRef v) = v\n\n\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test the refined dependency analysis of bindings\n-- with -fglagow-exts\n\nmodule ShouldCompile where\n\n  f1 :: Eq a => a -> Bool\n  f1 x = (x == x) || g1 True\n  \n  g1 :: Ord a => a -> Bool\n  g1 y = (y <= y) || f1 True\n\n---------\n\n  f2 :: Eq a => a -> Bool\n  f2 x = (x == x) || g2 True || g2 \"Yes\"\n  \n  g2 y = (y <= y) || f2 True\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, FlexibleContexts #-}\n\n-- Another dependency analysis test\n-- Notice that 'a' and 'b' are mutually recursive, \n-- but have different contexts. \n--\n-- This is the program submitted by Robert van Herk [rherk@cs.uu.nl]\n-- to motivate the refined dependency analysis.\n\nmodule ShouldCompile where\nimport Data.IORef\n\nclass MyReader r v | r -> v where\n  myRead :: r -> IO v\n\ndata R v = R (IORef v)\ninstance MyReader (R v) v where\n  myRead (R v) =\n    do v <- readIORef v\n       return v\n\n\na :: IO ()\na =\n  do r <- createReader\n     b r\n\nb :: MyReader r Int => r -> IO ()\nb r =\n  do i <- myRead r\n     if i > 10\n       then a\n       else putStrLn (show i)\n\ncreateReader :: IO (R Int)\ncreateReader =\n  do ref <- newIORef 0\n     return (R ref)\n \n", "num_lines": 41}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- This should work, because the type sig and the type\n-- in the pattern match exactly\n\nmodule Foo where\n\nfoo :: (forall a. a -> b) -> b\nfoo (f :: forall a. a -> b) = f undefined :: b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-}\n\n-- This code defines a default method with a highly dubious type,\n-- because 'v' is not mentioned, and there are no fundeps\n-- Hence needing AllowAmbiguousTypes\n--\n-- However, arguably the instance declaration should be accepted,\n-- beause it's equivalent to\n--      instance Baz Int Int where { foo x = x }\n-- which *does* typecheck\n\n-- GHC does not actually macro-expand the instance decl.  Instead, it\n-- defines a default method function, thus\n--\n--      $dmfoo :: Baz v x => x -> x\n--      $dmfoo y = y\n--\n-- Notice that this is an ambiguous type: you can't call $dmfoo\n-- without triggering an error.  And when you write an instance decl,\n-- it calls the default method:\n--\n--      instance Baz Int Int where foo = $dmfoo\n--\n-- I'd never thought of that.  You might think that we should just\n-- *infer* the type of the default method (here forall a. a->a), but\n-- in the presence of higher rank types etc we can't necessarily do\n-- that.\n\nmodule Foo1 where\n\nclass Baz v x where\n   foo :: x -> x\n   foo y = y\n\ninstance Baz Int Int\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -w #-}\n{-# LANGUAGE ConstrainedClassMethods #-}  -- Needed for 'baz'\n\n-- A nasty case that crashed GHC 6.4 with a Lint error; \n-- see Note [Multiple instantiation] in TcExpr\n\nmodule ShouldCompile where\n\nclass C a where\n  foo :: Eq b => b -> a -> Int\n  baz :: Eq a => Int -> a -> Int\n\ninstance C Int where\n  baz = foo\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             ExistentialQuantification, FlexibleContexts #-}\n\n{-      Email 30 Jan 2006\n\n> the attached program compiles under GHC, but not with Hugs. as far as\n> i see, Hugs don't use dependencies in class headers to figure out that\n> there is only one \"vMkIOError\" that can be called in the last\n> definition\n\nOK, I think it's a bug (though the example is bizarre).  Sadly Hugs's\nsupport for FDs is rough around the edges (and unlikely to improve\nsoon).\n\n-}\n\nmodule ShouldCompile where\n\n        class (Monad m) => Stream m h | h->m where\n                vMkIOError :: h -> Int\n\n        data BinHandle = forall h . Stream IO h => BinH h\n\n        instance Stream IO BinHandle where\n                vMkIOError (BinH h) = vMkIOError h\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Tests that subFunTys works when the argument is a type of form (a ty1 ty2)\n\nmodule ShouldCompile where\n\nnewtype StreamArrow a b c = Str (a [b] [c])\n\nfoo = Str $ (\\x -> x)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes #-}\n\n-- Check that we can have a forall after a forall\n\nmodule Foo4 where\n\ntype AnyE a = forall err. Either err a\n\nfoo :: Monad m => AnyE (m t)\nfoo = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# OPTIONS_GHC -dcore-lint #-}\n{-# LANGUAGE ImplicitParams #-}\n\n-- The dict-bindings attached to an IPBinds \n-- need not be in recursive order.  This is\n-- a long-standing bug, which lasted up to \n-- and including GHC 6.4.2\n\nmodule Bug795(foo) where\n\ndata Arg = E Integer | T Bool deriving (Eq, Show)\n\nfoo :: Integer -> [Arg] -> IO String\nfoo 1 as = do { let ?err = \"my custom error\"\n               ; let ws = (show (firstE as))\n               ; return (show (firstE as)) }\n\nfirstE :: (?err :: String) => [Arg] -> Integer\nfirstE = error \"urk\"\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, GADTs, KindSignatures #-}\n\n-- Tests infix type constructors in GADT declarations\n\nmodule ShouldCompile where\n\nimport Data.Kind\n\ninfix 1 `DArrowX`       -- (->) has precedence 0\n\ndata DArrowX :: Type -> Type -> Type where\n  First   :: a `DArrowX`  a' -> (a,b) `DArrowX` (a',b)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes #-}\n\n-- This one showed up a bug in pre-subsumption\n\nmodule ShouldCompile where\n\nclass Data a where {}\n\ntype GenericQ r = forall a. Data a => a -> r\n\neverything :: (r -> r -> r) -> GenericQ r \neverything k f  = error \"urk\"\n\n\n-- | Get a list of all entities that meet a predicate\nlistify :: (r -> Bool) -> GenericQ [r]\nlistify p = everything (++) \n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Tests enhanced polymorphism\n\nmodule ShouldCompile where\n\nfoo xs = let\n           f :: Eq a => [a] -> [a]\n           f [] = []\n           f xs | null (g [True]) = []\n                | otherwise       = tail (g xs)\n\n           g :: Eq b => [b] -> [b]\n           g [] = []\n           g xs | null (f \"hello\") = []\n                | otherwise       = tail (f xs)\n        in f xs\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ImplicitParams, RankNTypes #-}\n\n-- This program failed to typecheck in an early version of\n-- GHC with impredicative polymorphism, but it was fixed by\n-- doing pre-subsumption in the subsumption check.\n-- Trac bug #821\n\nmodule ShouldCompile where\n\ntype PPDoc = (?env :: Int) => Char\n\nf :: Char -> PPDoc\nf  = succ \n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\n-- Unboxed tuples; cf tcfail115, tcfail120\n\nmodule ShouldFail where\n\ntype T a = Int -> (# Int, Int #)\n\n-- Should be ok\nh t = \\x -> case t x of (# r, s #) -> r\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldCompile where\n\nf :: forall a. a -> forall b. b -> Int\nf = error \"urk\"\n\n-- Both these should be ok, but an early GHC 6.6 failed\n\ng1 = [ (+) :: Int -> Int -> Int, f ]\ng2 = [ f, (+) :: Int -> Int -> Int ]\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags -XScopedTypeVariables -XGADTs #-}\n\n-- Nov 2014: impredicative types are very dodgy so I am\n--           FAR from confident that these tests give the right errors\n\n-- Here are a bunch of tests for impredicative polymorphism\n-- mainly written by Dimitrios\n\n-- Sept 16: I'm just accepting the bizarre output.\n-- None of this is right\n\nmodule ShouldCompile where\n\nxs :: [forall a. a->a]\nxs = [\\x -> x]\n\nfoo = id xs\n\n-- Annotation resolves impredicative instantiation\nbar = ((:)::(forall a.a ->a) -> [forall a. a->a] -> [forall a. a ->a])\n               (head foo) foo\n\n-- result type resolves everything! really neat\nbarr :: [forall a. a -> a]\nbarr = (head foo):(tail foo)\n\nzoo = tail xs\nzooo = head xs\n\n-- This is the only unsatisfactory case...annotating\n-- one of the arguments does not do the job...but maybe\n-- this is reasonable to expect ...\n-- bar3 = ((head foo) :: forall a. a ->a) : foo\n\ndata Pair a b where\n   P :: a -> b -> Pair a b\n\ndata List a where\n   Nil  :: List a\n   Cons :: a -> List a -> List a\n--   FromMono :: (a->a) -> List (forall a. a->a)\n--   This constructor looks utterly bogus, so\n--   I'm commenting it out; SLPJ 7 Jan 08\n\nf :: Int -> Pair Int Int\nf x = P x x\n\nh0 :: (forall a. a -> a) -> Int\nh0 g = let y = P (g 3) (g (P 3 4))\n      in 3\n\n\nh1 (g::(forall a. a ->a))\n   = let y = P (g 3) (g (P 3 4))\n     in 3\n\nh2 :: (forall a. a -> a) -> Int\nh2 (g::(forall a. a ->a)) = let y = P (g 3) (g (P 3 4))\n                            in 3\n\nxs1 :: List (forall a. a ->a)\nxs1 = let cons = Cons :: (forall a. a ->a)\n                      -> List (forall a. a->a)\n                      -> List (forall a. a ->a)\n      in cons (\\x -> x) Nil\n\nxs2 :: List (forall a. a -> a)\nxs2 = (Cons :: ((forall a. a->a)\n            -> List (forall a. a->a)\n            -> List (forall a. a->a)))\n        (\\x ->x) Nil\n\nfoo2 :: forall a. List a -> a -> a\nfoo2 x y = y\n\nbar4 = (foo2 :: List (forall a. a->a) -> (forall a. a->a) -> (forall a.a->a))\n           xs1 (\\x -> x)\n\n\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- This one crashed the 6.6 release candidate\n\nmodule ShouldCompile where\n\n-- A specialise pragma with no type signature\nfac n = fac (n + 1)\n{-# SPECIALISE fac :: Int -> Int #-}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables, FlexibleInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- This tests scoped type variables, used in an expression\n-- type signature in t1 and t2\n\nmodule Foo7 where\nimport Control.Monad\nimport Control.Monad.ST\nimport Data.Array.MArray\nimport Data.Array.ST\nimport Data.STRef\nimport Data.Set hiding (map,filter)\n\n-- a store that allows to mark keys\nclass Mark m store key | store -> key m where\n     new   :: (key,key) -> m store\n     mark  :: store -> key -> m ()\n     markQ :: store -> key -> m Bool\n     seen  :: store -> m [ key ]\n\n-- implementation 1\ninstance Ord key => Mark (ST s) (STRef s (Set key)) key where\n     new   _   = newSTRef empty\n     mark  s k = modifySTRef s (insert k)\n     markQ s k = liftM (member k) (readSTRef s)\n     seen  s   = liftM elems (readSTRef s)\n\n-- implementation 2\ninstance Ix key => Mark (ST s) (STUArray s key Bool) key where\n     new   bnd = newArray bnd False\n     mark  s k = writeArray s k True\n     markQ     = readArray\n     seen  s   = liftM (map fst . filter snd) (getAssocs s)\n\n-- traversing the hull suc^*(start) with loop detection\ntrav suc start i = new i >>= \\ c -> mapM_ (compo c) start >> return c\n     where compo c x = markQ c x >>= flip unless (visit c x)\n           visit c x = mark c x >> mapM_ (compo c) (suc x)\n\n-- sample graph\nf 1 = 1 : []\nf n = n : f (if even n then div n 2 else 3*n+1)\n\nt1 = runST ( (trav f [1..10] (1,52) >>= \\ (s::STRef s (Set Int)) -> seen s)\n            :: forall s. ST s [Int] )\n\nt2 = runST ( (trav f [1..10] (1,52) >>= \\ (s::STUArray s Int Bool) -> seen s)\n            :: forall s. ST s [Int] )\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XImpredicativeTypes -fno-warn-deprecated-flags -XGADTs #-}\n\n-- This program sent GHC 6.6 into a loop, because the fixpointing\n-- of the substitution in type refinement got its in-scope-set\n-- from the answer!\n\nmodule ShouldCompile where\n\n------------------\ndata Foo a b where F :: a -> Foo () a\n\nbar :: Foo () (forall a.a) -> ()\nbar (F _) = ()\n\n------------------\ndata Foo2 a where F2 :: a -> Foo2 [a]\n\nbar2 :: Foo2 [forall a.a] -> ()\nbar2 (F2 _) = ()\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n\n-- Test for trac #366\n-- The C2 case is impossible due to the types\n\nmodule ShouldCompile where\n\ndata T a where\n    C1 :: T Char\n    C2 :: T Float\n\nexhaustive :: T Char -> Char\nexhaustive C1 = ' '\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, FlexibleInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- Test for trac #816\n-- GHC's typechecker loops when trying to type this, resulting in a\n-- context stack overflow.\n\n{- Maybe this should typecheck:\n\n   Given: Foo x y, Bar y z\n   Wanted: Foo x beta, Bar beta z\n\nIf we happened to process (Foo x beta) first we \nmight generate the extra equality beta~y, and we are good\n\nIf we process (Bar beta z) first, we end up in an infinite\nloop, using the (Bar x z) instance repeatedly.\n\nIf instead we'd had\n   class (F x ~ y) => Foo x y where\n     type F x\n     foo :: x -> y\n\nThen after canonicalising we get\n     Given: Foo x y, Bar y z, F x ~ y\n     Wanted: Foo x beta, Bar beta z\n-}\n\nmodule ShouldCompile where\n\nclass Foo x y | x -> y where\n foo :: x -> y\n\nclass Bar x z where\n bar :: x -> z -> Int\n\ninstance (Foo x y, Bar y z) => Bar x z where\n bar x z = bar (foo x) z\n\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -w #-}\n{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}\n\nmodule ShouldCompile where\n\n\nimport Control.Monad.Reader\n\ninstance Eq (a -> b) where\n     _ == _ = error \"whoops\"\n\ninstance Show (a -> b) where\n     show = const \"<fun>\"\n\n-- This is the example from Trac #179\nfoo x = show (\\_ -> True)\n\n-- This is the example from Trac #963\ninstance (Num a, Monad m, Eq (m a), Show (m a)) => Num (m a) where\ntest = 1 True\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\nmodule ShouldCompile where\n\nbar :: (Show a, ?c::a) => String\n-- This type should not be reported as ambiguous\n-- See the call in \nbar = show ?c\n\nfoo = let { ?c = 'x' } in bar\n\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, NoMonomorphismRestriction #-}\n\nmodule ShouldCompile where\n\n-- c.f. tc218.hs, only no type signature here\n-- Instead, the NoMonomorphismRestriction language\nbar = show ?c\n\nfoo1 = let { ?c = 'x' } in bar\nfoo2 = let { ?c = True } in bar\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n\n-- See Trac #1033\n\nmodule Pointful' where\n\nimport Data.Generics\nimport Control.Monad.State\n\ndata HsExp = HsWildCard deriving( Typeable, Data )\ndata HsName = HsName deriving( Typeable, Data )\n\n-- rename :: () -> HsExp -> State (HsName, [HsName]) HsExp  \n-- Type sig commented out\nrename1 = \\_ -> everywhereM (mkM (\\e -> case e of HsWildCard -> return e))\n\nrename2 _ = everywhereM (mkM (\\e -> case e of  HsWildCard -> return e))\n\nuncomb1 :: State (HsName, [HsName]) HsExp  \nuncomb1 = rename1 () undefined  \n\nuncomb2 :: State (HsName, [HsName]) HsExp  \nuncomb2 = rename2 () undefined  \n\n\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- A program very like this triggered a kind error with GHC 6.6\n\nmodule Foo where\n\ndata PatchSeq p a b where\n    Nil   :: PatchSeq p a b\n    U  :: p a b -> PatchSeq p a b\n    (:-)  :: PatchSeq p a b -> PatchSeq p b c -> PatchSeq p a c\n\n-- is_normal :: PatchSeq p a b -> Bool \nis_normal Nil = True \nis_normal (U _) = True \nis_normal (U _ :- _) = True \nis_normal _ = False \n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\n\n-- Tests impredivative polymorphism with left-to-right\n-- flow information; see the uses of \"$\"\n\nmodule TestIP where\n\nimport Control.Monad.ST\nimport Data.STRef\n\n-- Here's a use of runST with ($)\nfoo = runST $ (do { v <- newSTRef 0; readSTRef v })\n\n-- Here's a use of implicit parameters with ($)\n\ntype PPDoc = (?env :: Int) => Char -> Char\n\nf :: PPDoc -> PPDoc\nf c = g $ c\n\n-- Fully annotated version of f, as compiled by GHC 6.4.2\n--\n-- f ?env c = $ (C->C) (C->C)\n--              (\\(x:C->C). g ?env (\\?env. x))\n--              (c ?env)\n--\n-- The subsumption test needed from the call to $ is this:\n--      ?env => (?env => C -> C) -> C -> C   <=  a->b\n--      (?env => C -> C) -> C -> C   <=  a->b\n--      (a) C->C <= b\n--      (b) a <= (?env => C -> C)\n-- And perhaps surprisingly (b) succeeds!\n\ng :: PPDoc -> PPDoc\ng d = d\n\n\n\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-deprecations #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\nmodule Foo where\n\n-- This example suggested by Yitzchak Gale\n\nimport Control.Monad.State\nimport Control.Monad.Error\n\nclass Error e => Game b mv e | b -> mv e where\n    newBoard :: MonadState b m => m ()\n        -- This method is unambiguous, because\n        -- m determines b (via a fundep in MonadState)\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XOverloadedStrings #-}\nmodule T where\n\nimport Data.String\n\nnewtype MyString = MyString String deriving (Eq, Show)\ninstance IsString MyString where\n    fromString = MyString\n\ngreet1 :: MyString -> MyString\ngreet1 \"hello\" = \"world\"\ngreet1 other = other\n\ngreet2 :: String -> String\ngreet2 \"hello\" = \"world\"\ngreet2 other = other\n\ngreet3 :: (Eq s, IsString s) => s -> s\ngreet3 \"hello\" = \"world\"\ngreet3 other = other\n\ntest = do\n    print $ greet1 \"hello\"\n    print $ greet2 \"fool\"\n    print $ greet3 (\"foo\" :: String)\n    print $ greet3 (\"bar\" :: MyString)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Newtype in GADT syntax\n\nmodule ShouldCompile where\n\nnewtype Bug a where Bug :: a -> Bug a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -O -funbox-strict-fields #-}\n\n-- The combination of unboxing and a recursive newtype crashed GHC 6.6.1\n-- Trac #1255\n-- Use -O to force the unboxing to happen\n\nmodule Foo where\n\nnewtype Bar = Bar Bar -- Recursive\n\ndata Gah = Gah { baaz  :: !Bar }\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Ensure that tuple instances are brought into scope\n-- See Trac #1385\n\nmodule ShouldCompile where\n\nfoo = (1,True) == (2,False)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- Without a type sig this is slightly tricky.\n-- See Trac #1430\n\n-- Reason: we get an implication constraint (forall a. Typeable a => Typeable b),\n-- when generalising unExTypeable.  We want to infer a context for the \n-- whole thing of (Typeable b).\n-- See Note [Inference and implication constraints] in TcSimplify\n\n\nmodule Foo where\n\nimport Data.Typeable\n\ndata ExTypeable = forall a. Typeable a => ExTypeable a\n\n-- unExTypeable :: Typeable h => ExTypeable -> Maybe h\nunExTypeable (ExTypeable a) = cast a\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-simplifiable-class-constraints #-}\n\n-- trac #1406: Constraint doesn't reduce in the presence of quantified\n--             type variables\n\n{-# LANGUAGE FlexibleInstances, UndecidableInstances, RankNTypes,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\nmodule Problem where\n\ndata Z\ndata S a\n\nclass HPrefix l\ninstance (NSub (S Z) ndiff, HDrop ndiff l l) => HPrefix l\n-- Weird test case: (NSub (S Z) ndiff) is simplifiable\n\nclass NSub n1 n3 | n1 -> n3\ninstance NSub Z Z\ninstance NSub n1 n3 => NSub (S n1) n3\n\nclass HDrop n l1 l2 | n l1 -> l2\ninstance HDrop Z l l\n\nt_hPrefix :: HPrefix l => l -> ()\n-- Weird test case: (HPrefix l) is simplifiable\nt_hPrefix = undefined\n\n-- In ghc 6.6.1 this works...\nthr' :: (forall r. l -> a) -> a\nthr' f = f undefined\nthP4' = thr' t_hPrefix\n\n-- ... but this doesn't work...?\nthr :: (forall r. r -> a) -> a\nthr f = f undefined\nthP4 = thr t_hPrefix\n\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE ImplicitParams, RankNTypes #-}\n\n-- Trac #1445\n\nmodule Bug where\n\nf :: () -> (?p :: ()) => () -> ()\nf _ _ = ()\n\ng :: (?p :: ()) => ()\ng = f () ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -ddump-types -dsuppress-module-prefixes #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}\n\n-- See Trac #1456\n\n-- The key thing here is that foo should get the type\n--     foo :: forall b s t1. (Zork s (Z [Char]) b)\n--         => Q s (Z [Char]) t1 -> ST s ()\n\n-- Note the quantification over 'b', which was previously\n-- omitted; see Note [Important subtlety in oclose] in FunDeps\n\n\nmodule ShouldCompile where\n\nimport GHC.ST\n\ndata Q s a chain = Node s a chain\n\ndata Z a  = Z  a\n\ns :: Q t (Z [Char]) t1 -> Q t (Z [Char]) t1\ns = undefined\n\nclass  Zork s a b | a -> b where\n  huh :: Q s a chain ->  ST s ()\n\nfoo b = huh (s b)\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- This one fixed the constraint solver (Lint error)\n-- See Trac #1494\n\nmodule ShouldCompile where\n\nimport Control.Monad.State\n\nnewtype L m r = L (StateT Int m r)\n\ninstance Functor (L m) where\n  fmap = undefined\n\ninstance Applicative (L m) where\n  pure  = undefined\n  (<*>) = undefined\n\ninstance Monad m => Monad (L m) where\n  (>>=)  = undefined\n  return = undefined\n\nzork :: (Monad m) => a -> L m ()\nzork = undefined\n\nmumble e = do { modify id; zork e }\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldCompile where\n\nnewtype Swizzle = MkSwizzle (forall a. Ord a => [a] -> [a])\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XLiberalTypeSynonyms #-}\n\nmodule ShouldCompile where\n\ntype T a b = a\ntype S m   = m ()\n\nf :: S (T Int)\nf = undefined\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE FlexibleInstances, UndecidableInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n    -- 'x' and 'v' are ambiguous\n\n-- Trac #1564\n\nmodule Foo where\n\nimport Text.PrettyPrint\nimport Prelude hiding(head,tail)\n\nclass FooBar m k l | m -> k l where\n a :: m graphtype\n\ninstance FooBar [] Bool Bool where\n  a = error \"urk\"\n\ninstance FooBar Maybe Int Int where\n  a = error \"urk\"\n\nclass (Monad m)=>Gr g ep m where\n x:: m Int\n v:: m Int\n\ninstance (Monad m,  FooBar m x z) =>  Gr g ep m  where\n  x = error \"urk\"\n  v = error \"urk\"\n\n-- Old GHC claims for y:  y :: (Monad m, FooBar m GHC.Prim.Any GHC.Prim.Any)\n--                          => m Int (which is wrong)\n-- The uses in foo and bar show if that happens\ny () = x\n\nfoo :: [Int]\nfoo = y ()\n\nbar :: Maybe Int\nbar = y ()\n\n\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldCompile where\n\n-- Check that we can have a forall to the right of a double-arrow\n\nf :: forall a. (Num a) => forall b. (Ord b) => a -> b -> b -> a\nf x y z = if y>z then x+1 else x\n\ng :: (Num a) => (Ord b) => a -> b -> b -> a\ng x y z = if y>z then x+1 else x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes, MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- This one caught a bug in the implementation of functional\n-- dependencies, where improvement must happen when\n-- checking the call in 'test4'\n\nmodule ShouldCompile where\n\nnewtype M s a = M a\n\nclass Modular s a | s -> a\n\nwim ::  forall a w. Integral a\n                      => a -> (forall s. Modular s a => M s w) -> w\nwim i k = error \"urk\"\n\ntest4'  ::  (Modular s a, Integral a) => M s a\ntest4'  =   error \"urk\"\n\ntest4   =   wim 4 test4'\n--   Integral a0, (Modular s a0 => Modular s1 a1, Integral a1, M s1 a1 ~ M s w0)\n--   Under the implication, [D] a1 ~ a0, [W] a1 ~ w0\n--   Hence a1 := w0, [D] w0 ~ a0\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This innocuous module made GHC 6.6 have exponential behaviour\n-- when doing validity checking on the synonym declarations\n--\n-- This lot is enough to make the test time out, I hope\n\nmodule ShouldCompile where\n\ndata TIACons1 i r c = K (c i) (r c)\n\ntype TIACons2  t x = TIACons1 t (TIACons1 t x)\ntype TIACons3  t x = TIACons2 t (TIACons1 t x)\ntype TIACons4  t x = TIACons2 t (TIACons2 t x)\ntype TIACons7  t x = TIACons4 t (TIACons3 t x)\ntype TIACons8  t x = TIACons4 t (TIACons4 t x)\ntype TIACons15 t x = TIACons8 t (TIACons7 t x)\ntype TIACons16 t x = TIACons8 t (TIACons8 t x)\ntype TIACons31 t x = TIACons16 t (TIACons15 t x)\ntype TIACons32 t x = TIACons16 t (TIACons16 t x)\ntype TIACons47 t x = TIACons32 t (TIACons15 t x)\ntype TIACons48 t x = TIACons32 t (TIACons16 t x)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n-- Trac #1072\n\nmodule ShouldCompile where\n\nimport Tc239_Help\n\nf1 :: Show a => WrapIO e a\nf1 = return undefined\n\nf2 :: Show a => WrapIO2 a\nf2 = f1\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tc239_Help ( WrapIO, WrapIO2 ) where\n\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (liftM, ap)\n\nnewtype WrapIO e a = MkWrapIO { unwrap :: IO a }\n\ntype WrapIO2 a = WrapIO String a\n\ninstance Functor (WrapIO e) where\n    fmap = liftM\n\ninstance Applicative (WrapIO e) where\n    pure = return\n    (<*>) = ap\n\ninstance Monad (WrapIO e) where\n  return x = MkWrapIO (return x)\n\n  m >>= f  = MkWrapIO (do x <- unwrap m\n                          unwrap (f x) )\n\n  fail str = error str", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the types of the old binder and the binder implicitly introduced by grouping are linked\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule ShouldCompile where\n\nimport Data.List(inits)\n\nfoo :: [[[Int]]]\nfoo = [ x\n      | x <- [1..10]\n      , then group using inits\n      , then group using inits\n      ]\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XGADTs -XRankNTypes -O1 #-}\n-- Trac #2018\n\nmodule Bug1 where\n\n data A a where\n   MkA :: A ()\n\n class C w where\n   f :: forall a . w a -> Maybe a\n\n instance C A where\n   f MkA  = Just ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule Bug where\n\nf1 :: forall a. [a] -> [a]\nf1 (x:xs) = xs ++ [ x :: a ]   -- OK\n\nf2 :: forall a. [a] -> [a]\nf2 = \\(x:xs) -> xs ++ [ x :: a ]   -- OK\n\n-- This pair is a cut-down version of Trac #2030\nisSafe alts = isSafeAlts alts\n\nisSafeAlts :: forall m . Int -> m Int\nisSafeAlts x = error \"urk\"\n  where\n    isSafeAlt :: Int -> m Int\n    isSafeAlt alt = isSafe `seq` error \"urk\"\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Bug where\n\n-- When we warn about this, we give a warning saying\n--    Inferred type: (.+.) :: forall a. a\n-- but we used to not print the parentheses.\n\n(.+.) = undefined\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\n-- Tests record update in the presence of\n-- existentials, GADTs, type families\n\nmodule Rec where\n\n----------------- Existential\ndata S a where\n   S1 :: { fs1 :: a, fs2 :: b } -> S a\n   S2 :: { fs1 :: a } -> S a\n\nupdS s x = s { fs1=x }\n\n{-\n------------------ GADT\ndata T a b where\n   T1 :: { ft1 :: a, ft2 :: c, ft3 :: d } -> T a Int\n   T2 :: { ft1 :: a, ft3 :: c } -> T a Int\n   T3 :: T Int b\n\nf :: T a1 b -> a2 -> T a2 b\nf x v = x { ft1 = v }\n\n------------------ Type family\ndata family R a\ndata instance R (a,b) where\n   R1 :: { fr1 :: a, fr2 :: b, fr3 :: c } -> R (a,b)\n   R2 :: { fr1 :: a, fr3 :: c } -> R (a,b)\n\nupdR r x = r { fr1=x }\n-}\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for trac #2937\n\n{-# LANGUAGE GADTs, TypeFamilies #-}\n\nmodule Tc245 where\n\nimport Tc245_A\n\ninstance Foo Int where\n    data Bar Int x where\n        Baz :: Bar Int String\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Tc245_A where\n\nimport Data.Kind (Type)\n\nclass Foo a where\n    data Bar a :: Type -> Type\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for trac #3066\n-- GHC with optimisation off would go into an infinite loop\n\nmodule Tc246 () where\n\nnewtype Foo = Foo Foo\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, EmptyDataDecls, KindSignatures #-}\n\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\n-- Various forms of empty data type declarations\n\ndata T1\n\ndata T2 where\n\ndata T3 :: Type -> Type\n\ndata T4 a :: Type -> Type\n\ndata T5 a :: Type -> Type where\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n\nmodule ShouldCompile where\n\nidentity :: forall a. a -> a\nidentity x = x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ctx where\n\nf :: (Monad m, Eq (m a)) => a -> m a -> Bool\nf x y = (return x == y)\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\nclass Cls a where\n    type Fam a :: Type\n    type Fam a = Maybe a\n\ninstance Cls Int where\n    -- Gets type family from default\n\ninc :: (Fam a ~ Maybe Int) => a -> Fam a -> Fam a\ninc _proxy (Just x) = Just (x + 1)\ninc _proxy Nothing  = Just 0\n\nfoo :: Maybe Int -> Maybe Int\nfoo = inc (undefined :: Int)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule ShouldCompile where\n\nimport Tc251_Help\n\ninstance Cls Int where\n\ninc :: (Fam a ~ Maybe Int) => a -> Fam a -> Fam a\ninc _proxy (Just x) = Just (x + 1)\ninc _proxy Nothing  = Just 0\n\nfoo :: Maybe Int -> Maybe Int\nfoo = inc (undefined :: Int)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule Tc251_Help where\n\nimport Data.Kind (Type)\n\nclass Cls a where\n    type Fam a :: Type\n    type Fam a = Maybe a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\nclass Cls a where\n    type Fam a :: Type\n    type Fam a = Maybe a\n\ninstance Cls Int where\n    -- Overriding default\n    type Fam Int = Bool\n\nnott :: (Fam a ~ Bool) => a -> Fam a -> Fam a\nnott _proxy False = True\nnott _proxy True  = False\n\nfoo :: Bool -> Bool\nfoo = nott (undefined :: Int)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n  -- this is needed because |FamHelper a x| /< |Fam a x|\nmodule ShouldCompile where\n\nimport Data.Kind (Type)\n\nclass Cls a where\n    type Fam a b :: Type\n    -- Multiple defaults!\n    type Fam a x = FamHelper a x\n\ntype family FamHelper a x\ntype instance FamHelper a Bool = Maybe a\ntype instance FamHelper a Int  = (String, a)\n\ninstance Cls Int where\n    -- Gets type family from default\n\ninc :: (Fam a Bool ~ Maybe Int, Fam a Int ~ (String, Int)) => a -> Fam a Bool -> Fam a Int -> Fam a Bool\ninc _proxy (Just x) (_, y) = Just (x + y + 1)\ninc _proxy Nothing  (_, y) = Just y\n\nfoo :: Maybe Int -> (String, Int) -> Maybe Int\nfoo = inc (undefined :: Int)\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fwarn-missing-methods #-}\nmodule AssocTyDef01 where\n\nclass Cls a where\n    type Typ a\n\ninstance Cls Int where\n    -- No default: should get warning", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds, UndecidableInstances #-}\nmodule Ctx where\n\nimport Data.Kind ( Type, Constraint )\n\ntype family Indirect :: Type -> Constraint\ntype instance Indirect = Show\n\nclass Cls a where\n    f :: a -> String\n\ninstance Indirect a => Cls [a] where\n    f = show\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds, UndecidableInstances, UndecidableSuperClasses #-}\nmodule Ctx where\n\nimport Data.Kind ( Type, Constraint )\n\ntype family Indirect :: Type -> Constraint\ntype instance Indirect = Show\n\nclass Indirect a => Cls a where\n\nfoo :: Cls a => a -> String\nfoo = show\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures, ConstraintKinds, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}\nmodule Ctx where\n\nimport Data.Kind ( Type, Constraint )\n\ndata Proxy (ctxt :: Type -> Constraint) = Proxy\n\n-- At one time, this one worked:\nnonmeth :: ctxt Int => Proxy ctxt -> a\nnonmeth prox = nonmeth prox\n\n\nclass Foo (ctxt :: Type -> Constraint) a where\n    meth :: ctxt a => Proxy ctxt -> a\n\ninstance ctxt Int => Foo ctxt Int where\n    -- But this one didn't:\n    meth prox = meth prox\n\n-- The error was:\n-- Could not deduce (ctxt Int) arising from a use of `meth'\n-- from the context (ctxt Int)\n\n-- The problem was that irreducible evidence did not interact with\n-- evidence of equal type.\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, TypeFamilies, UndecidableInstances #-}\n\nmodule AltPrelude where\n\nimport Data.Kind (Constraint)\n\nclass MyFunctor f where\n       type FunctorCtxt f a :: Constraint\n       type FunctorCtxt f a = ()\n       (<$>) :: (FunctorCtxt f a, FunctorCtxt f b) => (a -> b) -> f a -> f b\n\nclass MyFunctor ap => MyApplicative ap where\n       type ApplicativeCtxt ap a :: Constraint\n       type ApplicativeCtxt ap a = FunctorCtxt ap a\n       (<***>) :: (ApplicativeCtxt ap a, ApplicativeCtxt ap b) => ap (a -> b) -> ap a -> ap b\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test we don't get a cycle for \"phantom\" superclasses\n{-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, FlexibleContexts #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n    -- 'meth' is ambiguous\n\nmodule TcOK where\n\nclass A cls c where\n    meth :: cls c => c -> c\n\nclass A B c => B c where\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test we don't get a cycle for \"phantom\" superclasses,\n-- even if the phantomness is behind a type synonym\n{-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, FlexibleContexts #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n    -- 'meth' is ambiguous\n\nmodule TcOK where\n\nclass A ctxt c where\n    meth :: ctxt => c -> c\n\ntype Bish = B Int\n\nclass A Bish c => B c where\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\nmodule TcOK where\n\nnewtype (f <.> g) a = Compose (f (g a))\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE IncoherentInstances, MultiParamTypeClasses, FlexibleInstances #-}\n\n-- Liberated IncoherentInstances behavior (#8141)\n\nclass C a b where foo :: (a,b)\n\ninstance C Int b where foo = undefined\ninstance C a Int where foo = undefined\n\nx :: (Int, Int)\nx = foo\n\nmain = return ()\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE IncoherentInstances, MultiParamTypeClasses, FlexibleInstances #-}\n\n-- Get a non-incoherent instance from that file\nimport Tc263_Help\n\ninstance C [a] b where foo = undefined\ninstance C a Int where foo = undefined\n\ny :: ([Int],Int)\ny = foo\n\nmain = return ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule Tc263_Help where\n\nclass C a b where foo :: (a,b)\n\ninstance C [Int] b where foo = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule Tc265 where\n\ndata T a = MkT (F a)\ntype family F a where\n  F (T a) = a\n  F (T Int) = Bool\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tc266 where\nimport Tc266a\ndata T = T\nf = T\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tc266a where\nimport {-# SOURCE #-} Tc266\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nmodule Tc267a where\nimport {-# SOURCE #-} Tc267b\ndata T = T deriving (Show)\ndata S = S\nx = y\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\nmodule Tc267b where\nimport Tc267a\ny = S\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE ConstraintKinds #-}\nmodule Tc268 where\nimport GHC.Exts\ntype A = (() :: Constraint)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE PolyKinds #-}\nmodule Tc269 where\n\nimport GHC.Types\n\n{-\n-- We'd like this to kind check, but it doesn't today,\n-- see Note [Missed opportunity to retain higher-rank kinds]\n\n-- TSyn is in an SCC of its own, so we can read off the\n-- kind directly.\ndata T (p :: forall k. k -> Type) = T\ntype TSyn = T\n-}\n\n-- S and SSyn are in an SCC, so we do kind inference for\n-- everything.  Need an explicit type signature.\ndata K (a :: k) = K\ndata S (p :: forall k. k -> Type) = S (SSyn K)\ntype SSyn = (S :: (forall k. k -> Type) -> Type)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tc270 where\n\n-- Type synonym stress test... though, it does seem that we\n-- are quadratic in the number of nested type synonyms.\n\ntype T0 = ()\ntype T1 = T0\ntype T2 = T1\ntype T3 = T2\ntype T4 = T3\ntype T5 = T4\ntype T6 = T5\ntype T7 = T6\ntype T8 = T7\ntype T9 = T8\ntype T10 = T9\ntype T11 = T10\ntype T12 = T11\ntype T13 = T12\ntype T14 = T13\ntype T15 = T14\ntype T16 = T15\ntype T17 = T16\ntype T18 = T17\ntype T19 = T18\ntype T20 = T19\ntype T21 = T20\ntype T22 = T21\ntype T23 = T22\ntype T24 = T23\ntype T25 = T24\ntype T26 = T25\ntype T27 = T26\ntype T28 = T27\ntype T29 = T28\ntype T30 = T29\ntype T31 = T30\ntype T32 = T31\ntype T33 = T32\ntype T34 = T33\ntype T35 = T34\ntype T36 = T35\ntype T37 = T36\ntype T38 = T37\ntype T39 = T38\ntype T40 = T39\ntype T41 = T40\ntype T42 = T41\ntype T43 = T42\ntype T44 = T43\ntype T45 = T44\ntype T46 = T45\ntype T47 = T46\ntype T48 = T47\ntype T49 = T48\ntype T50 = T49\ntype T51 = T50\ntype T52 = T51\ntype T53 = T52\ntype T54 = T53\ntype T55 = T54\ntype T56 = T55\ntype T57 = T56\ntype T58 = T57\ntype T59 = T58\ntype T60 = T59\ntype T61 = T60\ntype T62 = T61\ntype T63 = T62\ntype T64 = T63\ntype T65 = T64\ntype T66 = T65\ntype T67 = T66\ntype T68 = T67\ntype T69 = T68\ntype T70 = T69\ntype T71 = T70\ntype T72 = T71\ntype T73 = T72\ntype T74 = T73\ntype T75 = T74\ntype T76 = T75\ntype T77 = T76\ntype T78 = T77\ntype T79 = T78\ntype T80 = T79\ntype T81 = T80\ntype T82 = T81\ntype T83 = T82\ntype T84 = T83\ntype T85 = T84\ntype T86 = T85\ntype T87 = T86\ntype T88 = T87\ntype T89 = T88\ntype T90 = T89\ntype T91 = T90\ntype T92 = T91\ntype T93 = T92\ntype T94 = T93\ntype T95 = T94\ntype T96 = T95\ntype T97 = T96\ntype T98 = T97\ntype T99 = T98\ntype T100 = T99\ntype T101 = T100\ntype T102 = T101\ntype T103 = T102\ntype T104 = T103\ntype T105 = T104\ntype T106 = T105\ntype T107 = T106\ntype T108 = T107\ntype T109 = T108\ntype T110 = T109\ntype T111 = T110\ntype T112 = T111\ntype T113 = T112\ntype T114 = T113\ntype T115 = T114\ntype T116 = T115\ntype T117 = T116\ntype T118 = T117\ntype T119 = T118\ntype T120 = T119\ntype T121 = T120\ntype T122 = T121\ntype T123 = T122\ntype T124 = T123\ntype T125 = T124\ntype T126 = T125\ntype T127 = T126\ntype T128 = T127\ntype T129 = T128\ntype T130 = T129\ntype T131 = T130\ntype T132 = T131\ntype T133 = T132\ntype T134 = T133\ntype T135 = T134\ntype T136 = T135\ntype T137 = T136\ntype T138 = T137\ntype T139 = T138\ntype T140 = T139\ntype T141 = T140\ntype T142 = T141\ntype T143 = T142\ntype T144 = T143\ntype T145 = T144\ntype T146 = T145\ntype T147 = T146\ntype T148 = T147\ntype T149 = T148\ntype T150 = T149\ntype T151 = T150\ntype T152 = T151\ntype T153 = T152\ntype T154 = T153\ntype T155 = T154\ntype T156 = T155\ntype T157 = T156\ntype T158 = T157\ntype T159 = T158\ntype T160 = T159\ntype T161 = T160\ntype T162 = T161\ntype T163 = T162\ntype T164 = T163\ntype T165 = T164\ntype T166 = T165\ntype T167 = T166\ntype T168 = T167\ntype T169 = T168\ntype T170 = T169\ntype T171 = T170\ntype T172 = T171\ntype T173 = T172\ntype T174 = T173\ntype T175 = T174\ntype T176 = T175\ntype T177 = T176\ntype T178 = T177\ntype T179 = T178\ntype T180 = T179\ntype T181 = T180\ntype T182 = T181\ntype T183 = T182\ntype T184 = T183\ntype T185 = T184\ntype T186 = T185\ntype T187 = T186\ntype T188 = T187\ntype T189 = T188\ntype T190 = T189\ntype T191 = T190\ntype T192 = T191\ntype T193 = T192\ntype T194 = T193\ntype T195 = T194\ntype T196 = T195\ntype T197 = T196\ntype T198 = T197\ntype T199 = T198\ntype T200 = T199\ntype T201 = T200\ntype T202 = T201\ntype T203 = T202\ntype T204 = T203\ntype T205 = T204\ntype T206 = T205\ntype T207 = T206\ntype T208 = T207\ntype T209 = T208\ntype T210 = T209\ntype T211 = T210\ntype T212 = T211\ntype T213 = T212\ntype T214 = T213\ntype T215 = T214\ntype T216 = T215\ntype T217 = T216\ntype T218 = T217\ntype T219 = T218\ntype T220 = T219\ntype T221 = T220\ntype T222 = T221\ntype T223 = T222\ntype T224 = T223\ntype T225 = T224\ntype T226 = T225\ntype T227 = T226\ntype T228 = T227\ntype T229 = T228\ntype T230 = T229\ntype T231 = T230\ntype T232 = T231\ntype T233 = T232\ntype T234 = T233\ntype T235 = T234\ntype T236 = T235\ntype T237 = T236\ntype T238 = T237\ntype T239 = T238\ntype T240 = T239\ntype T241 = T240\ntype T242 = T241\ntype T243 = T242\ntype T244 = T243\ntype T245 = T244\ntype T246 = T245\ntype T247 = T246\ntype T248 = T247\ntype T249 = T248\ntype T250 = T249\ntype T251 = T250\ntype T252 = T251\ntype T253 = T252\ntype T254 = T253\ntype T255 = T254\ntype T256 = T255\ntype T257 = T256\ntype T258 = T257\ntype T259 = T258\ntype T260 = T259\ntype T261 = T260\ntype T262 = T261\ntype T263 = T262\ntype T264 = T263\ntype T265 = T264\ntype T266 = T265\ntype T267 = T266\ntype T268 = T267\ntype T269 = T268\ntype T270 = T269\ntype T271 = T270\ntype T272 = T271\ntype T273 = T272\ntype T274 = T273\ntype T275 = T274\ntype T276 = T275\ntype T277 = T276\ntype T278 = T277\ntype T279 = T278\ntype T280 = T279\ntype T281 = T280\ntype T282 = T281\ntype T283 = T282\ntype T284 = T283\ntype T285 = T284\ntype T286 = T285\ntype T287 = T286\ntype T288 = T287\ntype T289 = T288\ntype T290 = T289\ntype T291 = T290\ntype T292 = T291\ntype T293 = T292\ntype T294 = T293\ntype T295 = T294\ntype T296 = T295\ntype T297 = T296\ntype T298 = T297\ntype T299 = T298\ntype T300 = T299\ntype T301 = T300\ntype T302 = T301\ntype T303 = T302\ntype T304 = T303\ntype T305 = T304\ntype T306 = T305\ntype T307 = T306\ntype T308 = T307\ntype T309 = T308\ntype T310 = T309\ntype T311 = T310\ntype T312 = T311\ntype T313 = T312\ntype T314 = T313\ntype T315 = T314\ntype T316 = T315\ntype T317 = T316\ntype T318 = T317\ntype T319 = T318\ntype T320 = T319\ntype T321 = T320\ntype T322 = T321\ntype T323 = T322\ntype T324 = T323\ntype T325 = T324\ntype T326 = T325\ntype T327 = T326\ntype T328 = T327\ntype T329 = T328\ntype T330 = T329\ntype T331 = T330\ntype T332 = T331\ntype T333 = T332\ntype T334 = T333\ntype T335 = T334\ntype T336 = T335\ntype T337 = T336\ntype T338 = T337\ntype T339 = T338\ntype T340 = T339\ntype T341 = T340\ntype T342 = T341\ntype T343 = T342\ntype T344 = T343\ntype T345 = T344\ntype T346 = T345\ntype T347 = T346\ntype T348 = T347\ntype T349 = T348\ntype T350 = T349\ntype T351 = T350\ntype T352 = T351\ntype T353 = T352\ntype T354 = T353\ntype T355 = T354\ntype T356 = T355\ntype T357 = T356\ntype T358 = T357\ntype T359 = T358\ntype T360 = T359\ntype T361 = T360\ntype T362 = T361\ntype T363 = T362\ntype T364 = T363\ntype T365 = T364\ntype T366 = T365\ntype T367 = T366\ntype T368 = T367\ntype T369 = T368\ntype T370 = T369\ntype T371 = T370\ntype T372 = T371\ntype T373 = T372\ntype T374 = T373\ntype T375 = T374\ntype T376 = T375\ntype T377 = T376\ntype T378 = T377\ntype T379 = T378\ntype T380 = T379\ntype T381 = T380\ntype T382 = T381\ntype T383 = T382\ntype T384 = T383\ntype T385 = T384\ntype T386 = T385\ntype T387 = T386\ntype T388 = T387\ntype T389 = T388\ntype T390 = T389\ntype T391 = T390\ntype T392 = T391\ntype T393 = T392\ntype T394 = T393\ntype T395 = T394\ntype T396 = T395\ntype T397 = T396\ntype T398 = T397\ntype T399 = T398\ntype T400 = T399\ntype T401 = T400\ntype T402 = T401\ntype T403 = T402\ntype T404 = T403\ntype T405 = T404\ntype T406 = T405\ntype T407 = T406\ntype T408 = T407\ntype T409 = T408\ntype T410 = T409\ntype T411 = T410\ntype T412 = T411\ntype T413 = T412\ntype T414 = T413\ntype T415 = T414\ntype T416 = T415\ntype T417 = T416\ntype T418 = T417\ntype T419 = T418\ntype T420 = T419\ntype T421 = T420\ntype T422 = T421\ntype T423 = T422\ntype T424 = T423\ntype T425 = T424\ntype T426 = T425\ntype T427 = T426\ntype T428 = T427\ntype T429 = T428\ntype T430 = T429\ntype T431 = T430\ntype T432 = T431\ntype T433 = T432\ntype T434 = T433\ntype T435 = T434\ntype T436 = T435\ntype T437 = T436\ntype T438 = T437\ntype T439 = T438\ntype T440 = T439\ntype T441 = T440\ntype T442 = T441\ntype T443 = T442\ntype T444 = T443\ntype T445 = T444\ntype T446 = T445\ntype T447 = T446\ntype T448 = T447\ntype T449 = T448\ntype T450 = T449\ntype T451 = T450\ntype T452 = T451\ntype T453 = T452\ntype T454 = T453\ntype T455 = T454\ntype T456 = T455\ntype T457 = T456\ntype T458 = T457\ntype T459 = T458\ntype T460 = T459\ntype T461 = T460\ntype T462 = T461\ntype T463 = T462\ntype T464 = T463\ntype T465 = T464\ntype T466 = T465\ntype T467 = T466\ntype T468 = T467\ntype T469 = T468\ntype T470 = T469\ntype T471 = T470\ntype T472 = T471\ntype T473 = T472\ntype T474 = T473\ntype T475 = T474\ntype T476 = T475\ntype T477 = T476\ntype T478 = T477\ntype T479 = T478\ntype T480 = T479\ntype T481 = T480\ntype T482 = T481\ntype T483 = T482\ntype T484 = T483\ntype T485 = T484\ntype T486 = T485\ntype T487 = T486\ntype T488 = T487\ntype T489 = T488\ntype T490 = T489\ntype T491 = T490\ntype T492 = T491\ntype T493 = T492\ntype T494 = T493\ntype T495 = T494\ntype T496 = T495\ntype T497 = T496\ntype T498 = T497\ntype T499 = T498\ntype T500 = T499\ntype T501 = T500\ntype T502 = T501\ntype T503 = T502\ntype T504 = T503\ntype T505 = T504\ntype T506 = T505\ntype T507 = T506\ntype T508 = T507\ntype T509 = T508\ntype T510 = T509\ntype T511 = T510\ntype T512 = T511\ntype T513 = T512\ntype T514 = T513\ntype T515 = T514\ntype T516 = T515\ntype T517 = T516\ntype T518 = T517\ntype T519 = T518\ntype T520 = T519\ntype T521 = T520\ntype T522 = T521\ntype T523 = T522\ntype T524 = T523\ntype T525 = T524\ntype T526 = T525\ntype T527 = T526\ntype T528 = T527\ntype T529 = T528\ntype T530 = T529\ntype T531 = T530\ntype T532 = T531\ntype T533 = T532\ntype T534 = T533\ntype T535 = T534\ntype T536 = T535\ntype T537 = T536\ntype T538 = T537\ntype T539 = T538\ntype T540 = T539\ntype T541 = T540\ntype T542 = T541\ntype T543 = T542\ntype T544 = T543\ntype T545 = T544\ntype T546 = T545\ntype T547 = T546\ntype T548 = T547\ntype T549 = T548\ntype T550 = T549\ntype T551 = T550\ntype T552 = T551\ntype T553 = T552\ntype T554 = T553\ntype T555 = T554\ntype T556 = T555\ntype T557 = T556\ntype T558 = T557\ntype T559 = T558\ntype T560 = T559\ntype T561 = T560\ntype T562 = T561\ntype T563 = T562\ntype T564 = T563\ntype T565 = T564\ntype T566 = T565\ntype T567 = T566\ntype T568 = T567\ntype T569 = T568\ntype T570 = T569\ntype T571 = T570\ntype T572 = T571\ntype T573 = T572\ntype T574 = T573\ntype T575 = T574\ntype T576 = T575\ntype T577 = T576\ntype T578 = T577\ntype T579 = T578\ntype T580 = T579\ntype T581 = T580\ntype T582 = T581\ntype T583 = T582\ntype T584 = T583\ntype T585 = T584\ntype T586 = T585\ntype T587 = T586\ntype T588 = T587\ntype T589 = T588\ntype T590 = T589\ntype T591 = T590\ntype T592 = T591\ntype T593 = T592\ntype T594 = T593\ntype T595 = T594\ntype T596 = T595\ntype T597 = T596\ntype T598 = T597\ntype T599 = T598\ntype T600 = T599\ntype T601 = T600\ntype T602 = T601\ntype T603 = T602\ntype T604 = T603\ntype T605 = T604\ntype T606 = T605\ntype T607 = T606\ntype T608 = T607\ntype T609 = T608\ntype T610 = T609\ntype T611 = T610\ntype T612 = T611\ntype T613 = T612\ntype T614 = T613\ntype T615 = T614\ntype T616 = T615\ntype T617 = T616\ntype T618 = T617\ntype T619 = T618\ntype T620 = T619\ntype T621 = T620\ntype T622 = T621\ntype T623 = T622\ntype T624 = T623\ntype T625 = T624\ntype T626 = T625\ntype T627 = T626\ntype T628 = T627\ntype T629 = T628\ntype T630 = T629\ntype T631 = T630\ntype T632 = T631\ntype T633 = T632\ntype T634 = T633\ntype T635 = T634\ntype T636 = T635\ntype T637 = T636\ntype T638 = T637\ntype T639 = T638\ntype T640 = T639\ntype T641 = T640\ntype T642 = T641\ntype T643 = T642\ntype T644 = T643\ntype T645 = T644\ntype T646 = T645\ntype T647 = T646\ntype T648 = T647\ntype T649 = T648\ntype T650 = T649\ntype T651 = T650\ntype T652 = T651\ntype T653 = T652\ntype T654 = T653\ntype T655 = T654\ntype T656 = T655\ntype T657 = T656\ntype T658 = T657\ntype T659 = T658\ntype T660 = T659\ntype T661 = T660\ntype T662 = T661\ntype T663 = T662\ntype T664 = T663\ntype T665 = T664\ntype T666 = T665\ntype T667 = T666\ntype T668 = T667\ntype T669 = T668\ntype T670 = T669\ntype T671 = T670\ntype T672 = T671\ntype T673 = T672\ntype T674 = T673\ntype T675 = T674\ntype T676 = T675\ntype T677 = T676\ntype T678 = T677\ntype T679 = T678\ntype T680 = T679\ntype T681 = T680\ntype T682 = T681\ntype T683 = T682\ntype T684 = T683\ntype T685 = T684\ntype T686 = T685\ntype T687 = T686\ntype T688 = T687\ntype T689 = T688\ntype T690 = T689\ntype T691 = T690\ntype T692 = T691\ntype T693 = T692\ntype T694 = T693\ntype T695 = T694\ntype T696 = T695\ntype T697 = T696\ntype T698 = T697\ntype T699 = T698\ntype T700 = T699\ntype T701 = T700\ntype T702 = T701\ntype T703 = T702\ntype T704 = T703\ntype T705 = T704\ntype T706 = T705\ntype T707 = T706\ntype T708 = T707\ntype T709 = T708\ntype T710 = T709\ntype T711 = T710\ntype T712 = T711\ntype T713 = T712\ntype T714 = T713\ntype T715 = T714\ntype T716 = T715\ntype T717 = T716\ntype T718 = T717\ntype T719 = T718\ntype T720 = T719\ntype T721 = T720\ntype T722 = T721\ntype T723 = T722\ntype T724 = T723\ntype T725 = T724\ntype T726 = T725\ntype T727 = T726\ntype T728 = T727\ntype T729 = T728\ntype T730 = T729\ntype T731 = T730\ntype T732 = T731\ntype T733 = T732\ntype T734 = T733\ntype T735 = T734\ntype T736 = T735\ntype T737 = T736\ntype T738 = T737\ntype T739 = T738\ntype T740 = T739\ntype T741 = T740\ntype T742 = T741\ntype T743 = T742\ntype T744 = T743\ntype T745 = T744\ntype T746 = T745\ntype T747 = T746\ntype T748 = T747\ntype T749 = T748\ntype T750 = T749\ntype T751 = T750\ntype T752 = T751\ntype T753 = T752\ntype T754 = T753\ntype T755 = T754\ntype T756 = T755\ntype T757 = T756\ntype T758 = T757\ntype T759 = T758\ntype T760 = T759\ntype T761 = T760\ntype T762 = T761\ntype T763 = T762\ntype T764 = T763\ntype T765 = T764\ntype T766 = T765\ntype T767 = T766\ntype T768 = T767\ntype T769 = T768\ntype T770 = T769\ntype T771 = T770\ntype T772 = T771\ntype T773 = T772\ntype T774 = T773\ntype T775 = T774\ntype T776 = T775\ntype T777 = T776\ntype T778 = T777\ntype T779 = T778\ntype T780 = T779\ntype T781 = T780\ntype T782 = T781\ntype T783 = T782\ntype T784 = T783\ntype T785 = T784\ntype T786 = T785\ntype T787 = T786\ntype T788 = T787\ntype T789 = T788\ntype T790 = T789\ntype T791 = T790\ntype T792 = T791\ntype T793 = T792\ntype T794 = T793\ntype T795 = T794\ntype T796 = T795\ntype T797 = T796\ntype T798 = T797\ntype T799 = T798\ntype T800 = T799\ntype T801 = T800\ntype T802 = T801\ntype T803 = T802\ntype T804 = T803\ntype T805 = T804\ntype T806 = T805\ntype T807 = T806\ntype T808 = T807\ntype T809 = T808\ntype T810 = T809\ntype T811 = T810\ntype T812 = T811\ntype T813 = T812\ntype T814 = T813\ntype T815 = T814\ntype T816 = T815\ntype T817 = T816\ntype T818 = T817\ntype T819 = T818\ntype T820 = T819\ntype T821 = T820\ntype T822 = T821\ntype T823 = T822\ntype T824 = T823\ntype T825 = T824\ntype T826 = T825\ntype T827 = T826\ntype T828 = T827\ntype T829 = T828\ntype T830 = T829\ntype T831 = T830\ntype T832 = T831\ntype T833 = T832\ntype T834 = T833\ntype T835 = T834\ntype T836 = T835\ntype T837 = T836\ntype T838 = T837\ntype T839 = T838\ntype T840 = T839\ntype T841 = T840\ntype T842 = T841\ntype T843 = T842\ntype T844 = T843\ntype T845 = T844\ntype T846 = T845\ntype T847 = T846\ntype T848 = T847\ntype T849 = T848\ntype T850 = T849\ntype T851 = T850\ntype T852 = T851\ntype T853 = T852\ntype T854 = T853\ntype T855 = T854\ntype T856 = T855\ntype T857 = T856\ntype T858 = T857\ntype T859 = T858\ntype T860 = T859\ntype T861 = T860\ntype T862 = T861\ntype T863 = T862\ntype T864 = T863\ntype T865 = T864\ntype T866 = T865\ntype T867 = T866\ntype T868 = T867\ntype T869 = T868\ntype T870 = T869\ntype T871 = T870\ntype T872 = T871\ntype T873 = T872\ntype T874 = T873\ntype T875 = T874\ntype T876 = T875\ntype T877 = T876\ntype T878 = T877\ntype T879 = T878\ntype T880 = T879\ntype T881 = T880\ntype T882 = T881\ntype T883 = T882\ntype T884 = T883\ntype T885 = T884\ntype T886 = T885\ntype T887 = T886\ntype T888 = T887\ntype T889 = T888\ntype T890 = T889\ntype T891 = T890\ntype T892 = T891\ntype T893 = T892\ntype T894 = T893\ntype T895 = T894\ntype T896 = T895\ntype T897 = T896\ntype T898 = T897\ntype T899 = T898\ntype T900 = T899\ntype T901 = T900\ntype T902 = T901\ntype T903 = T902\ntype T904 = T903\ntype T905 = T904\ntype T906 = T905\ntype T907 = T906\ntype T908 = T907\ntype T909 = T908\ntype T910 = T909\ntype T911 = T910\ntype T912 = T911\ntype T913 = T912\ntype T914 = T913\ntype T915 = T914\ntype T916 = T915\ntype T917 = T916\ntype T918 = T917\ntype T919 = T918\ntype T920 = T919\ntype T921 = T920\ntype T922 = T921\ntype T923 = T922\ntype T924 = T923\ntype T925 = T924\ntype T926 = T925\ntype T927 = T926\ntype T928 = T927\ntype T929 = T928\ntype T930 = T929\ntype T931 = T930\ntype T932 = T931\ntype T933 = T932\ntype T934 = T933\ntype T935 = T934\ntype T936 = T935\ntype T937 = T936\ntype T938 = T937\ntype T939 = T938\ntype T940 = T939\ntype T941 = T940\ntype T942 = T941\ntype T943 = T942\ntype T944 = T943\ntype T945 = T944\ntype T946 = T945\ntype T947 = T946\ntype T948 = T947\ntype T949 = T948\ntype T950 = T949\ntype T951 = T950\ntype T952 = T951\ntype T953 = T952\ntype T954 = T953\ntype T955 = T954\ntype T956 = T955\ntype T957 = T956\ntype T958 = T957\ntype T959 = T958\ntype T960 = T959\ntype T961 = T960\ntype T962 = T961\ntype T963 = T962\ntype T964 = T963\ntype T965 = T964\ntype T966 = T965\ntype T967 = T966\ntype T968 = T967\ntype T969 = T968\ntype T970 = T969\ntype T971 = T970\ntype T972 = T971\ntype T973 = T972\ntype T974 = T973\ntype T975 = T974\ntype T976 = T975\ntype T977 = T976\ntype T978 = T977\ntype T979 = T978\ntype T980 = T979\ntype T981 = T980\ntype T982 = T981\ntype T983 = T982\ntype T984 = T983\ntype T985 = T984\ntype T986 = T985\ntype T987 = T986\ntype T988 = T987\ntype T989 = T988\ntype T990 = T989\ntype T991 = T990\ntype T992 = T991\ntype T993 = T992\ntype T994 = T993\ntype T995 = T994\ntype T996 = T995\ntype T997 = T996\ntype T998 = T997\ntype T999 = T998\ntype T1000 = T999\n", "num_lines": 1007}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tc271 where\n\nimport Tc271a\n\nclass K a where\n    f :: a -> a\n    g :: a -> a\n\nh :: K a => a -> a\nh = f . g . h2\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tc271a where\nimport {-# SOURCE #-} Tc271\n\nh2 :: K a => a -> a\nh2 = h\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n{-# OPTIONS_GHC -fwarn-unused-imports  #-}\n\nimport Data.Coerce\nimport Data.Proxy\nimport Data.Monoid (First(First)) -- check whether the implicit use of First is noted\n\n-- see https://ghc.haskell.org/trac/ghc/wiki/Design/NewCoercibleSolver/V2\n\nfoo1 :: f a -> f a\nfoo1 = coerce\n\nnewtype X = MkX (Int -> X)\nfoo2 :: X -> X\nfoo2 = coerce\n\nnewtype X2 a = MkX2 Char\ntype role X2 nominal\n\nfoo3 :: X2 Int -> X2 Bool\nfoo3 = coerce\n\nnewtype Age = MkAge Int\nnewtype Y a = MkY a\ntype role Y nominal\n\nfoo4 :: Y Age -> Y Int\nfoo4 = coerce\n\nnewtype Z a = MkZ ()\ntype role Z representational\n\nfoo5 :: Z Int -> Z Bool\nfoo5 = coerce\n\nnewtype App f a = MkApp (f a)\n\nfoo6 :: f a -> App f a\nfoo6 = coerce\n\nfoo7 :: Coercible a b => b -> a\nfoo7 = coerce\n\nfoo8 :: (Coercible a b, Coercible b c) => Proxy b -> a -> c\nfoo8 _ = coerce\n\nmain = print (coerce $ Just (1::Int)  :: First Int)\n\n\n\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleInstances #-}\nmodule TcCustomSolverSuper where\n\nimport GHC.TypeLits\nimport Data.Typeable\n\n{-\n\nWhen solving super-class instances, GHC solves the evidence without\nusing the solver (see `tcSuperClasses` in `TcInstDecls`).\n\nHowever, some classes need to be excepted from this behavior,\nas they have custom solving rules, and this test checks that\nwe got this right.\n\nPS: this test used to have Typeable in the context too, but\n    that's a redundant constraint, so I removed it\n\nPPS: the whole structre of tcSuperClasses has changed,\n     so I'm no longer sure what is being tested here\n-}\n\n\nclass (KnownNat x)    => C x\nclass (KnownSymbol x) => D x\n\ninstance C 2\ninstance D \"2\"\n\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE LambdaCase #-}\n\nmodule TcLambdaCase where\n\nimport Data.Bits ((.|.))\n\nf1 :: (a -> a) -> (a -> a)\nf1 = \\case x -> x\n\nf2 :: Num a => a -> a\nf2 = \\case x -> x + x\n\nf3 :: Int -> (Int, Int)\nf3 = (\\case y -> (y + y, y * y)) . (.|. 12)\n\nf4 = \\case _ -> undefined\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers #-}\n\nmodule StaticPointers01 where\n\nimport GHC.StaticPtr\n\nf0 :: StaticPtr (Int -> Int)\nf0 = static g\n\nf1 :: StaticPtr (Bool -> Bool -> Bool)\nf1 = static (&&)\n\nf2 :: StaticPtr (Bool -> Bool -> Bool)\nf2 = static ((&&) . id)\n\ng :: Int -> Int\ng = id\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE StaticPointers     #-}\n\nmodule StaticPointers02 where\n\nimport GHC.StaticPtr\nimport Data.Typeable\n\nf2 :: Typeable a => StaticPtr (a -> a)\nf2 = static id\n\nf3 :: StaticPtr (Char -> Int)\nf3 = static method\n\nf4 :: Typeable a => StaticPtr (T a -> a)\nf4 = static t_field\n\ng :: Int -> Int\ng = id\n\nf5 :: Typeable a => StaticPtr (a -> a)\nf5 = static (id . id)\n\nf6 :: Typeable a => StaticPtr (a -> IO a)\nf6 = static return\n\nf7 :: Typeable a => StaticPtr (a -> IO a)\nf7 = static (\\x -> getLine >> return x)\n\ndata T a = T { t_field :: a }\n  deriving Typeable\n\nclass C a where\n  method :: a -> Int\n\ninstance C Char where\n  method = const 0\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}\nmodule TcTypeNatSimple where\nimport GHC.TypeLits as L\nimport Data.Proxy\n\n--------------------------------------------------------------------------------\n-- Test evaluation\ne1 :: Proxy (2 + 3) -> Proxy 5\ne1 = id\n\ne2 :: Proxy (2 L.* 3) -> Proxy 6\ne2 = id\n\ne3 :: Proxy (2 ^ 3) -> Proxy 8\ne3 = id\n\ne4 :: Proxy (0 + x) -> Proxy x\ne4 = id\n\ne5 :: Proxy (x + 0) -> Proxy x\ne5 = id\n\ne6 :: Proxy (x L.* 0) -> Proxy 0\ne6 = id\n\ne7 :: Proxy (0 L.* x) -> Proxy 0\ne7 = id\n\ne8 :: Proxy (x L.* 1) -> Proxy x\ne8 = id\n\ne9 :: Proxy (1 L.* x) -> Proxy x\ne9 = id\n\ne10 :: Proxy (x ^ 1) -> Proxy x\ne10 = id\n\ne11 :: Proxy (1 ^ x) -> Proxy 1\ne11 = id\n\ne12 :: Proxy (x ^ 0) -> Proxy 1\ne12 = id\n\ne13 :: Proxy (1 <=? 2) -> Proxy True\ne13 = id\n\ne14 :: Proxy (2 <=? 1) -> Proxy False\ne14 = id\n\ne15 :: Proxy (x <=? x) -> Proxy True\ne15 = id\n\ne16 :: Proxy (0 <=? x) -> Proxy True\ne16 = id\n\ne17 :: Proxy (3 - 2) -> Proxy 1\ne17 = id\n\ne18 :: Proxy (a - 0) -> Proxy a\ne18 = id\n\ne19 :: Proxy (Div 10 3) -> Proxy 3\ne19 = id\n\ne20 :: Proxy (Div x 1) -> Proxy x\ne20 = id\n\ne21 :: Proxy (Mod 10 3) -> Proxy 1\ne21 = id\n\ne22 :: Proxy (Mod x 1) -> Proxy 0\ne22 = id\n\ne23 :: Proxy (Log2 10) -> Proxy 3\ne23 = id\n\n--------------------------------------------------------------------------------\n-- Test interactions with inerts\n\n-- ti1 :: Proxy (x + y) -> Proxy x -> ()\n-- ti1 _ _ = ()\n\nti2 :: Proxy (y + x) -> Proxy x -> ()\nti2 _ _ = ()\n\nti3 :: Proxy (2 L.* y) -> ()\nti3 _ = ()\n\nti4 :: Proxy (y L.* 2) -> ()\nti4 _ = ()\n\nti5 :: Proxy (2 ^ y) -> ()\nti5 _ = ()\n\nti6 :: Proxy (y ^ 2) -> ()\nti6 _ = ()\n\nti8 :: Proxy (x - y) -> Proxy x -> ()\nti8 _ _ = ()\n\nti9 :: Proxy (y - x) -> Proxy x -> ()\nti9 _ _ = ()\n", "num_lines": 103}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}\nmodule TcTypeNatSimple where\nimport GHC.TypeLits\nimport Data.Proxy\n\n--------------------------------------------------------------------------------\n-- Test evaluation\n\nte1 :: Proxy (AppendSymbol \"\" x) -> Proxy x\nte1 = id\n\nte2 :: Proxy (AppendSymbol x \"\") -> Proxy x\nte2 = id\n\nte3 :: Proxy (AppendSymbol \"type\" \"level\") -> Proxy \"typelevel\"\nte3 = id\n\n--------------------------------------------------------------------------------\n-- Test interactions with inerts\n\ntei1 :: Proxy (AppendSymbol y x) -> Proxy x -> ()\ntei1 _ _ = ()\n\ntei2 :: Proxy (AppendSymbol \"foo\" x) -> ()\ntei2 _ = ()\n\ntei3 :: Proxy (AppendSymbol x \"foo\") -> ()\ntei3 _ = ()\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes, LiberalTypeSynonyms #-}\n\n-- This test checks that deep skolemisation and deep\n-- instantiation work right.  A buggy prototype\n-- of GHC 7.0, where the type checker generated wrong\n-- code, sent applyTypeToArgs into a loop.\n\nmodule Twins where\n\nimport Data.Data\n\ntype GenericQ r = forall a. Data a => a -> r\ntype GenericM m = forall a. Data a => a -> m a\n\ngzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)\ngzip f x y\n  = f x y\n     `orElse`\n    if toConstr x == toConstr y\n    then gzipWithM (gzip f) x y\n    else Nothing\n\ngzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)\ngzipWithM _ = error \"urk\"\n\norElse :: Maybe a -> Maybe a -> Maybe a\norElse = error \"urk\"\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeInType, TypeOperators, TypeFamilies,\n             UndecidableInstances, ConstraintKinds #-}\nmodule TypeInTypeSubstitutions where\n\nimport GHC.TypeLits as L\nimport Data.Type.Bool\nimport Data.Type.Equality\nimport Data.List (sort)\n\n\n-- We define a very simplistic O notation, with sufficient expressiveness\n-- to capture the complexity of a few simple sorting algorithms\ndata AsympPoly = NLogN Nat Nat\n\n-- Synonyms for common terms\ntype N     = NLogN 1 0\ntype LogN  = NLogN 0 1\ntype One   = NLogN 0 0\n\n-- Just to be able to write it nicely\ntype O (a :: AsympPoly) = a\n\ntype family (^.) (n :: AsympPoly) (m :: Nat) :: AsympPoly where\n  (NLogN a b) ^. n = (NLogN (a L.* n) (b L.* n))\n\ntype family (*.) (n :: AsympPoly) (m :: AsympPoly) :: AsympPoly where\n  (NLogN a b) *. (NLogN c d) = NLogN (a+c) (b+d)\n\ntype family OCmp (n :: AsympPoly) (m :: AsympPoly) :: Ordering where\n  OCmp (NLogN a b) (NLogN c d) = If (CmpNat a c == EQ)\n                                    (CmpNat b d)\n                                    (CmpNat a c)\n\ntype family OGEq (n :: AsympPoly) (m :: AsympPoly) :: Bool where\n  OGEq n m = Not (OCmp n m == 'LT)\n\ntype (>=.) n m = OGEq n m ~ True\n\ninfix 4 >=.\ninfixl 7 *., ^.\n\n\n\n-- Stable sorts must be stable, but unstable can be, but don't need to.\ntype IsStable s = (s || True) ~ True\n-- We encode in the return type of the sorting function its average complexity,\n-- memory use and stability.\nnewtype Sorted (cpu :: AsympPoly) -- The minimum operational complexity\n                                       -- this algorithm satisfies.\n               (mem :: AsympPoly) -- The minimum space complexity this\n                                       -- algorithm satisfies.\n               (stable :: Bool)        -- Whether the sort is stable or not.\n               a                       -- What was being sorted.\n               = Sorted {sortedBy :: [a]}\n\n-- Merge sort is O(N*Log(N)) on average in complexity, so that's the\n-- minimum complexity we promise to satisfy. Same goes with memory, which is\n-- O(N), and as we all know, mergesort is a stable sorting algoritm.\nmergeSort :: (Ord a, n >=. O(N*.LogN), m >=. O(N), IsStable s) =>\n             [a] -> Sorted n m s a\nmergeSort = Sorted . sort\n\ninsertionSort :: (Ord a, n >=. O(N^.2), m >=. O(One), IsStable s) =>\n                 [a] -> Sorted n m s a\ninsertionSort = Sorted . sort\n\n-- Note that we don't actually check the complexity (as evidenced by them all\n-- being implemented with sort, a smooth applicative merge sort). With more\n-- dependent types however, some of these properties might be verifiable.\nquickSort :: (Ord a, n >=. O(N*.LogN), m >=. O(N)) => [a] -> Sorted n m False a\nquickSort = Sorted . sort\n\nheapSort :: (Ord a, n >=. O(N*.LogN), m >=. O(One)) => [a] -> Sorted n m False a\nheapSort = Sorted . sort\n\n-- Here we say that sorted can use at most operational complexity O(N^2), space\n-- complexity of at most (O(N)) and that it should be stable.\nmySortA :: Sorted (O(N^.2)) (O(N)) True Integer\nmySortA = _a [3,1,2]\n\nmySortB :: Sorted (O(N*.LogN)) (O(N)) False Integer\nmySortB = _b [3,1,2]\n\nmySortC :: Sorted (O(N*.LogN)) (O(One)) False Integer\nmySortC = _c [3,1,2]\n\nmain :: IO ()\nmain = print (sortedBy mySortA)\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# OPTIONS_GHC -funbox-small-strict-fields #-}\nmodule Test where\n\nimport GHC.Exts\n\n-- The following should be unboxed automatically:\ndata A = A Int#\ndata B = B !A\ndata C = C !()\ndata D = D !B\ndata E = E !D !D\n\nd = D (B (A 0#))\ne = E d d\n\ndata F = F Int#\nnewtype G = G F\ndata H = H !G !G\n\nh = H (G (F 1#)) (G (F 1#))\n\n-- This should not be unboxed:\n\ndata I = I !H !H\n\ni = I h h\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE\n            NoImplicitPrelude\n           , ExistentialQuantification\n  #-}\n\nmodule Test where\n\nhGetContents handle_ = handle_{ haType=SemiClosedHandle}\n\ndata HandleType = SemiClosedHandle\n\nclass Show a where\n  show :: a -> a\n\n-- they have to check whether the handle has indeed been closed.\ndata Handle__\n  = forall dev . (Show dev) =>\n    Handle__ {\n      haDevice      :: !dev,\n      haType        :: HandleType           -- type (read/write/append etc.)\n}\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ValidHoleFits where\n\n\ndata Moo = Moo Integer\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nimport Prelude hiding (putStr, putStrLn)\nimport qualified System.IO (putStr, putStrLn)\nimport Data.Maybe\nimport qualified ValidHoleFits\n\nps :: String -> IO ()\nps = putStrLn\n\na :: Int -> IO Int\na _ = return 1\nb :: Int -> IO Int\nb _ = return 2\nc :: Int -> IO Int\nc _ = do { x <- a 0\n         ; y <- _ x\n         ; return y }\n\ntest :: [Maybe a] -> [a]\ntest = _\n\ntest2 :: Integer -> ValidHoleFits.Moo\ntest2 = _\n\nk :: Maybe Integer\nk = _ 2\n\nf :: String\nf = show _\n\n\nh :: String\nh = show (_ (_ :: Bool))\n\n-- Built-in Syntax\nmyCons :: a -> [a] -> [a]\nmyCons = _\n\nmain :: IO ()\nmain = _ \"hello, world\"\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule ValidSubsInteractions where\n\nimport Data.Kind\n\n\ndata SBool :: Bool -> Type where\n  SFalse :: SBool 'False\n  STrue  :: SBool 'True\n\nf :: SBool 'True\nf = _\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, ScopedTypeVariables, PolyKinds,\n             TypeFamilies, RankNTypes,\n             FlexibleContexts #-}\n-- tests about visible type application\n\nmodule Vta1 where\n\nimport Data.Kind (Type)\n\nquad :: a -> b -> c -> d -> (a, b, c, d)\nquad = (,,,)\n\nsilly = quad @_ @Bool @Char @_ 5 True 'a' \"Hello\"\n\npairup_nosig x y = (x, y)\n\npairup_sig :: a -> b -> (a,b)\npairup_sig u w = (u, w)\n\nanswer_sig = pairup_sig @Bool @Int False 7 --\n-- (False, 7) :: (Bool, Int)\n\nanswer_read = show (read @Int \"3\") -- \"3\" :: String\nanswer_show = show @Integer (read \"5\") -- \"5\" :: String\nanswer_showread = show @Int (read @Int \"7\") -- \"7\" :: String\n\nintcons a = (:) @Int a\n\nintpair x y = pairup_sig @Int x y\n\nanswer_pairup = pairup_sig @Int 5 True -- (5, True) :: (Int, Bool)\nanswer_intpair = intpair 1 \"hello\" -- (1, \"hello\") :: (Int, String)\nanswer_intcons = intcons 7 []      -- [7] :: [Int]\n\ntype family F a\ntype instance F Char = Bool\n\ng :: F a -> a\ng _ = undefined\n\nf :: Char\nf = g True\n\nanswer = g @Char False\n\nmapSame :: forall b. (forall a. a -> a) -> [b] -> [b]\nmapSame _ [] = []\nmapSame fun (x:xs) = fun @b x : (mapSame @b fun xs)\n\npair :: forall a. a-> (forall b. b -> (a, b))\npair x y = (x, y)\n\nb = pair @Int 3 @Bool True\nc = mapSame id [1,2,3]\nd = pair 3 @Bool True\n\npairnum :: forall a. Num a => forall b. b -> (a, b)\npairnum = pair 3\n\ne = (pair 3 :: forall a. Num a => forall b. b -> (a, b)) @Int @Bool True\nh = pairnum @Int @Bool True\n\ndata First (a :: Type -> Type) = F\ndata Proxy (a :: k) = P -- This expands to P (kind variable) (type variable)\ndata Three (a :: Type -> k -> Type) = T\n\nfoo :: Proxy a -> Int\nfoo _ = 0\n\nfirst :: First a -> Int\nfirst _ = 0\n\nfTest = first F\nfMaybe = first @Maybe F\n\ntest = foo P\nbar = foo @Bool P -- should work\n\ntoo :: Three a -> Int\ntoo _ = 3\n\nthreeBase = too T\nthreeOk = too @Either T\n\nblah = Nothing @Int\n\nnewtype N = MkN { unMkN :: forall a. Show a => a -> String }\n\nn = MkN show\n\nboo = unMkN n @Bool\n\nboo2 :: forall (a :: Type -> Type) . Proxy a -> Bool\nboo2 _ = False\n\nbase = boo2 P\nbar'= boo2 @Maybe P -- should work\n", "num_lines": 98}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TypeApplications #-}\n\n\nmodule Vta2 where\n\ncheckIf :: Bool -> (forall a. a -> a) -> (Bool, Int)\ncheckIf _ = if True\n            then \\f -> (f True, f 5)\n            else \\f -> (f False, f @Int 3)\n\ncheckCase :: Bool -> (forall a. a -> a) -> (Bool, Int)\ncheckCase _ = case True of\n                True -> \\f -> (f True, f 5)\n                False -> \\f -> (f False, f @Int 3)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef01 where\n\nclass OtherCls a where\n    type OtherTyp a\n\nclass Cls a where\n    type Typ a\n    type OtherType a = Int\n      -- Default for another class AT: want error\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef02 where\n\nclass Cls a where\n    type Typ a\n    type Typ [b] = Int\n      -- Default is not parametric in type class params\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef03 where\n\nclass Cls a where\n    data Typ a\n    type Typ a = Int\n      -- Default for data family :-(", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef04 where\n\nclass Cls a where\n    type Typ a\n    type Typ a = Maybe\n      -- Wrong kind for default", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef05 where\n\nclass Cls a where\n    type Typ a\n    type Typ = Maybe\n      -- Too few params for default", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef06 where\n\nclass Cls a where\n    type Typ a\n    type Typ a b = Int\n      -- Too many params for default\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef07 where\n\nclass Cls a where\n    type Typ a = Int\n     -- Default without family\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module AssocTyDef07 where\n\nclass Cls a where\n    type Typ a = Int\n     -- Default without family OR extension flag\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule AssocTyDef01 where\n\ntype family OtherTyp a\n\nclass Cls a where\n    type Typ a\n    type OtherType a = Int\n      -- Default for top level AT: want error\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, TypeOperators, TypeFamilies, MultiParamTypeClasses, GADTs #-}\n\nmodule ClassOperator where\n\nimport Data.Kind\n\n-- | Class with fixity, including associated types\nclass a ><> b where\n  type a <>< b :: Type\n  data a ><< b\n  (>><), (<<>) :: a -> b -> ()\n\n  -- | Multiple fixities\n  (**>), (**<), (>**), (<**) :: a -> a -> ()\n\ninfixr 1 ><>\ninfixl 2 <><\ninfixl 3 ><<\ninfixr 4 >><\ninfixl 5 <<>\n\ninfixr 8 **>, >**\ninfixl 8 **<, <**\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, FlexibleInstances #-}\n\nmodule ContextStack1 where\n\nclass Cls a where meth :: a\n\ninstance Cls [a] => Cls a\n\nt :: ()\nt = meth\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes, TypeFamilies #-}\n\nmodule ContextStack2 where\n\nimport Data.Kind (Type)\n\ntype family TF a :: Type\ntype instance TF (a,b) = (TF a, TF b)\n\n-- Succeeds with new approach to fuvs\n-- Aug 2016\nt :: (a ~ TF (a,Int)) => Int\nt = undefined\n\n{- a ~ TF (a,Int)  \n     ~ (TF a, TF Int)\n     ~ (TF (TF (a,Int)), TF Int)\n     ~ (TF (TF a, TF Int), TF Int)\n     ~ ((TF (TF a), TF (TF Int)), TF Int) \n\n\n      fsk ~ a\n      TF (a, Int) ~ fsk\n-->\n      fsk ~ a\n*     fsk ~ (TF a, TF Int)\n        (flatten lhs)\n         a ~ (TF a, TF Int)\n        (flatten rhs)\n        a ~ (fsk1, TF Int)\n(wk)  TF a ~ fsk1   \n\n--> (rewrite inert)\n\n   fsk ~ (fsk1, TF Int)\n   a ~ (fsk1, TF Int)\n(wk) TF a ~ fsk1\n\n-->\n      fsk ~ (fsk1, TF Int)\n      a   ~ (fsk1, TF Int)\n\n*     TF (fsk1, fsk2) ~ fsk1\n(wk)  TF Tnt ~ fsk2\n\n-->   \n      fsk ~ (fsk1, TF Int)\n      a   ~ (fsk1, TF Int)\n\n*     fsk1 ~ (TF fsk1, TF fsk2)\n        (flatten rhs)\n        fsk1 ~ (fsk3, TF fsk2)\n\n   \n(wk)  TF Int ~ fsk2\n      TF fsk1 ~ fsk3\n-}\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, UndecidableInstances #-}\nmodule T1 where\nimport GHC.TypeLits\n\n\ndata MyType = MyType\n\ninstance\n  TypeError (Text \"Values of type 'MyType' cannot be compared for equality.\")\n    => Eq MyType where (==) = undefined\n\nerr x = x == MyType\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, UndecidableInstances #-}\n{-# LANGUAGE TypeFamilies, TypeOperators, FlexibleContexts #-}\nmodule T2 where\n\nimport GHC.TypeLits\n\ntype family IntRep a where\n  IntRep Int      = Integer\n  IntRep Integer  = Integer\n  IntRep Bool     = Integer\n  IntRep a        = TypeError (Text \"The type '\" :<>: ShowType a :<>:\n                               Text \"' cannot be represented as an integer.\")\n\nconvert :: Num (IntRep a) => a -> IntRep a\nconvert _ = 5\n\nerr = convert id\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\nmodule T3 where\n\nimport GHC.TypeLits\n\nf :: TypeError (Text \"This is a type error\")\nf = undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n\n-- The \"bad case\" in #11391\nmodule CustomTypeErrors04 where\n\nimport Data.Kind\nimport GHC.TypeLits (TypeError, ErrorMessage(..))\n\ntype family Resolve (t :: Type -> Type) :: Type -> Type where\n  Resolve _ = TypeError (Text \"ERROR\")\n\ntestNOTOK1 :: Resolve [] Int\ntestNOTOK1 = ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}\n{-# LANGUAGE UndecidableInstances #-}\n\n-- The \"tricky case\" in #11391\nmodule CustomTypeErrors05 where\n\nimport Data.Kind\nimport GHC.TypeLits (TypeError, ErrorMessage(..))\n\ntype family Resolve (t :: Type -> Type) :: Type -> Type where\n  Resolve _ = TypeError (Text \"ERROR\")\n\ntestNOTOK2 :: Resolve [] Int\ntestNOTOK2 = 1\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "type Foo = Int\ntype Bar = Bool\n\nmain = print $ (1 :: Foo) == (False :: Bar)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- In case of types with nested type synonyms, all synonyms should be expanded\n\n{-# LANGUAGE RankNTypes #-}\n\nimport Control.Monad.ST\n\ntype Foo = Int\ntype Bar = Bool\n\ntype MyFooST s = ST s Foo\ntype MyBarST s = ST s Bar\n\nfooGen :: forall s . MyFooST s\nfooGen = undefined\n\nbarGen :: forall s . MyBarST s\nbarGen = undefined\n\nmain = print (runST fooGen == runST barGen)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- We test two things here:\n--\n-- 1. We expand only as much as necessary. In this case, we shouldn't expand T.\n-- 2. When we find a difference(T3 and T5 in this case), we do minimal expansion\n--    e.g. we don't expand both of them to T1, instead we expand T5 to T3.\n\nmodule Main where\n\ntype T5 = T4\ntype T4 = T3\ntype T3 = T2\ntype T2 = T1\ntype T1 = Int\n\ntype T a = Int -> Bool -> a -> String\n\nf :: T (T3, T5, Int) -> Int\nf = undefined\n\na :: Int\na = f (undefined :: T (T5, T3, Bool))\n\nmain = print a\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Synonyms shouldn't be expanded since type error is visible without\n-- expansions. Error message should not have `Type synonyms expanded: ...` part.\n\nmodule Main where\n\ntype T a = [a]\n\nf :: T Int -> String\nf = undefined\n\nmain = putStrLn $ f (undefined :: T Bool)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n\nmodule FailDueToGivenOverlapping where\n\nclass C a where\n\nclass D a where\n dop :: a -> ()\n\n\ninstance C a => D [a]\n\n-- should succeed since we can't learn anything more for 'a'\nfoo :: (C a, D [Int]) => a -> ()\nfoo x = dop [x]\n\n\nclass E a where\n eop :: a -> ()\n\ninstance E [a] where\n eop = undefined\n\n-- should fail since we can never be sure that we learnt\n-- everything about the free unification variable.\nbar :: E [Int] => () -> ()\nbar _ = eop [undefined]\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- Here's a nice example of a fundep loop, correctly\n-- rejected by the undecidable-instance check.\n-- See comments below.\n\nmodule FDLoop where\n\nclass C a b | a -> b where f :: a -> b\nnewtype T a = T a\n\ninstance (C a b, Eq b) => Eq (T a) where (==) = undefined\n\ng x = (undefined :: d -> d -> d -> ()) (T x) (f x) (undefined :: Eq e => e)\n\n{-    Analysis\n\n   f :: C a b => a -> b\n   x :: a\n   b ~ T a\n   need: C a b\n   b ~ e\n   need: Eq e\n\nHence need (C a (T a), Eq (T a))\nApply instance for Eq\n     = (C a (T a), C a g, Eq g)\nApply functional dependency: g ~ T a\n     = (C a (T a), C a (T a), Eq (T a))\nAnd now we are back where we started\n-}\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, GADTs #-}\n\nmodule FDsFromGivens where\n\nclass C a b | a -> b where\n   cop :: a -> b -> ()\n\n{- Failing, as it righteously should! It's inaccessible code -}\n-- But (c.f. test T5236) we no longer reject this in the\n-- typechecker (see Trac #12466)\n-- Instead we get a redundant pattern-match warning,\n-- in the post-typechecking pattern-match checks\ng1 :: (C Char [a], C Char Bool) => a -> ()\ng1 x = ()\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, GADTs #-}\n\nmodule FDsFromGivens2 where\n\nclass C a b | a -> b where\n   cop :: a -> b -> ()\n\ndata KCC where\n  KCC :: C Char Char => () -> KCC\n\nf :: C Char [a] => a -> a\nf = undefined\n\nbar :: KCC -> a -> a\nbar (KCC _) = f\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, GADTs, TypeFamilies #-}\nmodule Test where\n\n\ndata T a where\n  MkT :: a -> T a\n  MkT3 :: forall a. (a ~ Bool) => T a\n\n-- Mismatches in givens\nbloh :: T Int -> ()\nbloh x = case x of\n           MkT3 -> ()\n\ntype family F a b\ntype family G a b\ntype instance F a Bool = a\ntype instance G a Char = a\n\ngoo1 :: forall a b. (F a b ~ [a]) => b -> a  -> a\ngoo1 = undefined\n\ngoo2 :: forall a. G a Char ~ [Int] => a -> a\ngoo2 = undefined\n\n-- Just an occurs check\ntest1 = goo1 False undefined\n\n-- A frozen occurs check, now transformed to decomposition error\ntest2 = goo2 (goo1 False undefined)\ntest3 = goo1 False (goo2 undefined)\n\n\n-- A frozen occurs check, now transformed to both a decomposition and occurs check\ndata M a where\n  M :: M a\ndata T2 a b where\n  T2 :: T2 a b\n\ngoo3 :: forall a b. F a b ~ T2 (M a) a => b -> a -> a\ngoo3 = undefined\n\ngoo4 :: forall a c. G a Char ~ T2 (T2 c c) c => a -> a\ngoo4 = undefined\n\ntest4 = goo4 (goo3 False undefined)\ntest5 = goo3 False (goo4 undefined)\n\n\n\n", "num_lines": 50}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\nmodule IPFail where\n\nf0 :: (?x :: Int) => () -> Bool\nf0 () = let ?x = 5 in ?x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- inspired by comment:25 on #12708\n\n{-# LANGUAGE PolyKinds #-}\n\nmodule LevPolyBounded where\n\nimport GHC.Exts\n\nclass XBounded (a :: TYPE r) where\n  minBound :: a\n  maxBound :: a\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, MultiParamTypeClasses\n  , FlexibleContexts, FlexibleInstances, UndecidableInstances\n  , TypeSynonymInstances, GeneralizedNewtypeDeriving\n  #-}\n\nmodule LongWayOverlapping where\n\n\nclass M a where\n\nclass M a => XMLG a\n\ninstance M [a]\n\ninstance XMLG [m] where     -- Generates an implication wanted:  forall m. M [m]\n\nclass M a => EmbAsChild a b where\n  emb :: b -> [a]\n\n\ninstance EmbAsChild [Char] Bool where\n  emb _ = emb 'c'\n\n\n  -- This one generates an unsolvable EmbAsChild [Char] Char\n\n-- Original problem is:\n-- [w] EmbAsChild [Char] Char\n-- [w] forall m. M [m]\n-- Now, by converting the wanted to given and pushing it inside the implication\n-- we have the following:\n-- [g] EmbAsChild [Char] Char\n-- [g] M [Char]   <~~ The superclass of the first given!\n-- [w] M [m]\n-- And now OOPS we can't solve M [m] because we are supposed to delay our choice\n-- as much as possible!\n\n-- DV:\n-- One possible solution is to STOP PUSHING wanteds as givens inside an implication\n-- in a checking context. I think it's the best thing to do and I've implemented it.\n\n-- In inference mode that's ok and the error message is very comprehensible, see\n-- test case PushedInFlatsOverlap.hs\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the correct type is used checking the using clause of the transform\n\n{-# LANGUAGE MonadComprehensions, TransformListComp #-}\n\nmodule ShouldFail where\n\nimport Data.List(inits)\n\nz :: [Int]\nz = [x | x <- [3, 2, 1], then inits]\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Checks that the ordering constraint on the groupWith function is respected\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule ShouldFail where\n\nimport GHC.Exts (groupWith)\n\ndata Unorderable = Gnorf | Pinky | Brain\n\nfoo = [ ()\n      | x <- [Gnorf, Brain]\n      , then group by x using groupWith\n      ]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the correct type is used checking the using clause of the group\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\nmodule ShouldFail where\nimport GHC.Exts( the )\nimport GHC.List\n\ndata Unorderable = Gnorf | Pinky | Brain\n\nfoo = [ GHC.List.length x\n      | x <- [Gnorf, Brain]\n      , then group using take 5\n      ]\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the types of the old binder and the binder \n-- implicitly introduced by grouping are linked\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule ShouldFail where\n\nfoo = [ x + 1\n      | x <- [\"Hello\", \"World\"]\n      , then group using take 5\n      ]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that using the \"by\" clause in a transform requires a function parameter\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule ShouldFail where\n\nimport Data.List(take)\n\nz = [x | x <- [1..10], then take 5 by x ]\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the correct type is used checking the using clause of \n-- the group when a by clause is present\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\nmodule ShouldFail where\nimport GHC.List\n\nfoo = [ GHC.List.length x\n      | x <- [1..10]\n      , then group by x using take 2\n      ]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that using the \"by\" clause in a transform requires a function parameter\n\n{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}\n\nmodule ShouldFail where\n\nimport Data.List(take)\n\nz = [x | x <- [1..10], then group by x using take ]\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Werror -fwarn-missing-export-lists #-}\nmodule ShouldFail where\n\nfoo :: String\nfoo = \"foo\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n\n-- This is a superclass loop test\n-- It should fail with a type error, but\n-- it's all too easy to succeed with a bogus recursive dictionary\n\nmodule SCLoop where\n\nclass SC a where\n  f :: a -> ()\n\nclass SC a => A a b where\n  op :: a -> b -> ()\n  op x _ = f x\n\ninstance A a b => A a [b]\n-- dfun1 :: \\d::(A a b) -> DA (sc d)\n\ninstance SC a  => A a (Maybe b)\n-- dfun2 :: \\d::SC a -> DA d\n\nfoo = op () ([Just True])\n\n{- Here is the explanation:\n~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n[Wanted]  d1 : (A () [Maybe Bool])\n~~~>                              d1 := dfun1 d2\n[Wanted]  d2 : (A () (Maybe Bool))\n~~~>                              d2 := dfun2 d3\n[Wanted]  d3 : SC ()\n[Derived] d4 : SC ()               d4 := sc d1\n~~~>\n      d3 := sc d1\n      isGoodRecEv will check:\n                  d3 == sc d1\n                     == sc (dfun1 d2)\n                     == sc (dfun1 (dfun2 d3) ==> PASSES!   (gravity = 1)\n        This is BAD BAD BAD, because we get a loop\n\n      If we had inlined the definitions:\n                  d3 == sc d1\n                     == sc (DA (sc d2))\n                     == sc (DA (sc (DA d3))) ==> DOES NOT! (gravity = 0)\n\nWe should get \"No instance for SC ()\"\n-}\n\n\n\n\n\n\n\n\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}\n\nmodule SilentParametersOverlapping where \n\nclass C a where \n  c :: a -> () \n\nclass C a => B a where \n  b :: a -> () \n\ninstance C [a] where \n  c x = () \n\ninstance {- silent: C [(a,b)] => -} B [(a,b)] where \n  b x = c [(undefined,undefined)]\n  -- We get wanted: C [(gamma, delta)], \n  -- and gamma,delta are unconstrained\n  -- We can apply the C [a] instance without difficulty, but\n  --  that fails due to silent dfun parameters\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule StrictBinds where\n\nimport GHC.Exts\n\nfoo = let x = 3# +# y\n          y = x in\n      True\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T10194 where\n\ntype X = forall a . a\n\ncomp :: (X -> c) -> (a -> X) -> (a -> c)\ncomp = (.)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10285 where\n\nimport T10285a\nimport Data.Type.Coercion\nimport Data.Coerce\n\noops :: Coercion (N a) (N b) -> a -> b\noops Coercion = coerce\n\nunsafeCoerce :: a -> b\nunsafeCoerce = oops coercion\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n\nmodule T10285a (N, coercion) where\n\nimport Data.Type.Coercion\n\nnewtype N a = MkN Int\ntype role N representational\n\ncoercion :: Coercion (N a) (N b)\ncoercion = Coercion\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10351 where\n\nclass C a where\n  op :: a -> ()\n\nf x = op [x]\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10495 where\n\nimport Data.Coerce\n\nfoo = coerce\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T10534 where\n\nimport T10534a\n\nnewtype instance DF a = MkDF ()\n\nunsafeCoerce :: a -> b\nunsafeCoerce = silly\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts #-}\n\nmodule T10534a where\n\nimport Data.Coerce\n\ndata family DF a\n\nsilly :: Coercible (DF a) (DF b) => a -> b\nsilly = coerce\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T10619 where\n\n-- tests that type checking doesn't care about order. all of these\n-- should fail and be reported.\n\nfoo _ = if True\n        then ((\\x -> x) :: (forall a. a -> a) -> forall b. b -> b)\n        else \\y -> y\n\nbar _ = if True\n        then \\y -> y\n        else ((\\x -> x) :: (forall a. a -> a) -> forall b. b -> b)\n\nbaz True  = (\\x -> x) :: (forall a. a -> a) -> forall b. b -> b\nbaz False = \\y -> y\n\nquux False = \\y -> y\nquux True  = (\\x -> x) :: (forall a. a -> a) -> forall b. b -> b\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n\nmodule T10698 where\nimport Data.Coerce\n\ndata Map k a  = Map k a\ntype role Map nominal representational\n\nmap1 :: (k1->k2) -> Map k1 a -> Map k2 a\nmap1 f (Map a b) = Map (f a) b\n{-# NOINLINE  [1] map1 #-}\n{-# RULES\n\"map1/coerce\" map1 coerce = coerce\n #-}\n\n\nmap2 :: (a -> b) -> Map k a -> Map k b\nmap2 f (Map a b) = Map a (f b)\n{-# NOINLINE [1] map2 #-}\n\n{-# RULES\n\"map2/coerce\" map2 coerce = coerce\n #-}\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\nmodule T10715 where\n\nimport Data.Coerce (coerce, Coercible)\nimport Data.Ord ( Down )  -- convenient newtype\n\ndata X a\n\n-- See Trac #10715 for a long discussion about whether\n-- this should be accepted or not.\n--\n-- But in Trac #12466 we decided to accept contradictory\n-- type signatures, so definition is now accepeted even\n-- though you can never call it.  Instead we get a\n-- redundant pattern-match warning, in the\n-- post-typechecking pattern-match checks\ndoCoerce :: Coercible a (X a) => a -> X a\ndoCoerce = coerce\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10715b where\n\n-- test error message: should complain about an occurs check\n\nimport Data.Coerce\n\nfoo = coerce `asTypeOf` head\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\nmodule T10836 where\n\ntype family Foo a = r | r -> a where\n    Foo Int  = Int\n    Foo Bool = Int\n\ntype family Bar a = r | r -> a where\n    Bar Int  = Int\n    Bar Bool = Int\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonomorphismRestriction, NoExtendedDefaultRules #-}\nmodule T10971b where\nimport Data.Traversable (fmapDefault)\nf = \\x -> length x\ng = \\f x -> fmapDefault f x\nh = \\f x -> (fmapDefault f x, length x)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonomorphismRestriction, ExtendedDefaultRules #-}\nmodule T10971c where\n\nimport Data.Traversable (fmapDefault)\n\nf = \\x -> length x\ng = \\f x -> fmapDefault f x\nh = \\f x -> (fmapDefault f x, length x)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import T10971c\n\nmain = do\n  print $ f (Just 1)\n  print $ g (+1) (Just 5)\n  print $ h (const 5) Nothing\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11112 where\n\nsort :: Ord s -> [s] -> [s]\nsort xs = xs\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-typed-holes #-}\n\nmodule T11274 where\n\ndata Asd = Asd\n\nsomeHole = _asd\n\nmissingInstance :: Asd -> Asd -> Bool\nmissingInstance x y = x == y\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n\nmodule T11313 where\n\nx = fmap @ (*)\n\n-- test error message output, which was quite silly before\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Should AllowAmbiguousTypes really be needed here?\n{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, AllowAmbiguousTypes #-}\nmodule T11347 where\n\nnewtype Id1 a = MkId1 a\nnewtype Id2 a = MkId2 (Id1 a) deriving (UnsafeCast b)\n\ntype family Discern a b\ntype instance Discern (Id1 a) b = a\ntype instance Discern (Id2 a) b = b\n\nclass UnsafeCast to from where\n  unsafe :: from -> Discern from to\n\ninstance UnsafeCast b (Id1 a) where\n  unsafe (MkId1 x) = x\n\nunsafeCoerce :: a -> b\nunsafeCoerce x = unsafe (MkId2 (MkId1 x))\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, RankNTypes #-}\n\nmodule T11355 where\n\nfoo = const @_ @((forall a. a) -> forall a. a) () (id @(forall a. a))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11356 where\n\nclass T p p => C p\n\ntype T x = C x\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, PolyKinds #-}\n\nmodule Foo where\n\ninstance Eq (Either a)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11541 where\n\ng :: Ord k => k -> v -> ()\ng k v = ()\n\nf x y =\n   let m = min x y\n   in  g m foo\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11563 where\n\ndata T a = MkT\nclass C t\ninstance C s => C T\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T11623 where\n\ntype family T where { Maybe T = Int }\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\nmodule BadError where\n\nimport GHC.TypeLits\nimport Data.Proxy\n\nf :: Proxy (a :: Symbol) -> Int\nf _ = f (Proxy :: Proxy (Int -> Bool))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonoLocalBinds #-}\nmodule T11698 where\n\nf x = (k 'v', k True)\n  where\n    h = const True x\n    k z = const h (k z) -- k type should not be generalized because h is closed.\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nmodule T11724 where\n\nimport GHC.Exts\n\ndata Foo (r :: RuntimeRep) (a :: TYPE r) = Foo a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, ScopedTypeVariables #-}\nmodule T11947 where\n\ntheFloatDigits :: forall a. RealFloat a => Int\n-- The type is ambiguous, despite potential defaulting\ntheFloatDigits = floatDigits (undefined @_ @a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, NoMonoLocalBinds #-}\n-- The NoMonoLocalBinds is crucial to making inference fail\n-- See Trac #11948 comment:2\n{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}\n\nmodule T11948 where\n\ntype family F b\n\nnewtype Foo r = Foo r\n\ntype instance F (Foo r) = Foo (F r)\n\nclass Bar a b where\n  bar :: a -> b\n\ninstance (Bar a b) => Bar (Foo a) (Foo b)\n\nbug :: forall zq. (Bar (Foo (F zq)) (Foo zq))\n               => Foo (F zq) -> Foo zq\nbug sk = let x = bar sk :: Foo zq\n         in x\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExtendedDefaultRules #-}\n\nmodule T11974b where\n\ndefault (Either, Monad, [], Maybe, Either Bool, Integer, Double, Blah)\n\ndata Blah\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances, ScopedTypeVariables, FlexibleContexts #-}\n\nmodule T11990a where\n\nimport GHC.TypeLits\nimport Data.Proxy\n\ntype family PartialTF t :: Symbol where\n  PartialTF Int  = \"Int\"\n  PartialTF Bool = \"Bool\"\n  PartialTF a    = TypeError (Text \"Unexpected type @ PartialTF: \"\n                                                         :<>: ShowType a)\n\ntestPartialTF :: forall a.(KnownSymbol (PartialTF a)) => a -> String\ntestPartialTF t = symbolVal (Proxy :: Proxy (PartialTF a))\n\nt1 = testPartialTF 'a'\n\n{- Above code rightly fails with the following error:\n    \u00e2\u20ac\u00a2 Unexpected type: Char\n    \u00e2\u20ac\u00a2 In the expression: testPartialTF 'a'\n      In an equation for \u00e2\u20ac\u02dct1\u00e2\u20ac\u2122: t1 = testPartialTF 'a'\n-}\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances, ScopedTypeVariables, FlexibleContexts #-}\n\nmodule T11990b where\n\nimport GHC.TypeLits\nimport Data.Proxy\n\ntype family PartialTF t :: Symbol where\n  PartialTF Int  = \"Int\"\n  PartialTF Bool = \"Bool\"\n  PartialTF a    = TypeError (Text \"Unexpected type @ PartialTF: \"\n                                                         :<>: ShowType a)\n\ntype family NestedPartialTF (tsym :: Symbol) :: Symbol where\n  NestedPartialTF \"Int\" = \"int\"\n  NestedPartialTF \"Bool\" = \"bool\"\n  NestedPartialTF a =\n    TypeError (Text \"Unexpected type @ NestedPartialTF: \" :<>: ShowType a)\n\ntestPartialTF :: forall a.(KnownSymbol (PartialTF a)) => a -> String\ntestPartialTF t = symbolVal (Proxy :: Proxy (PartialTF a))\n\ntestNesPartialTF ::\n  forall a.(KnownSymbol (NestedPartialTF (PartialTF a))) => a -> String\ntestNesPartialTF t = symbolVal (Proxy :: Proxy (NestedPartialTF (PartialTF a)))\n\nt2 = testNesPartialTF 'a'\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12035 where\nimport T12035a\ntype T = Bool\ny = f True\n\n-- This should error that 'type T = Int' doesn't match 'data T',\n-- NOT that f expects argument of type T but got Bool.\n--\n-- NB: This test will start passing if we allow abstract data\n-- types to be implemented using type synonyms.\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12035a where\nimport {-# SOURCE #-} T12035\nf :: T -> T\nf x = x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12042 where\nimport qualified T12042a as B\ntype S = B.R\ntype R = B.U\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12042a (module T12042a, module T12042) where\nimport {-# SOURCE #-} T12042\ntype U = S\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n\nmodule T12045b where\n\nimport Data.Kind\n\nx :: Int @Type\nx = 5\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeApplications, KindSignatures, DataKinds, GADTs\n             , TypeFamilies, RankNTypes #-}\n\nmodule T12045c where\nimport Data.Kind\n\ntype family F a where\n  F @Type a = Bool\n  F @(Type -> Type) b = Char\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12063 where\nimport T12063a\nx :: S\nx = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12063a where\nimport {-# SOURCE #-} T12063\ntype S = T\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UnicodeSyntax #-}\nmodule T12803a where\n\ntype Constrd a = Num a \u00e2\u2021\u2019 a\n\ndata ADT a = ADT (Constrd a) ExistentiallyLost\n\ndata ExistentiallyLost = \u00e2\u02c6\u20ac u. TC u \u00e2\u2021\u2019 ExistentiallyLost u\n\nclass u ~ (ATF1 u, ATF2 u) \u00e2\u2021\u2019 TC u where\n    type ATF1    u \u00e2\u02c6\u00b7 *\n    type ATF2    u \u00e2\u02c6\u00b7 *\n    uie_handlers   \u00e2\u02c6\u00b7 ADT Int\n\n-- Loop:\n--  - ADT depends on ExistentiallyLost (also the Constrd appendage)\n--  - ExistentiallyLost depends on TC\n--  - TC depends on ADT\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T12083b where\n\nclass Class a where\n    test :: a -> (Eq a => r) -> r\n\ndata P a b where\n    Con :: (Class a, a ~ b) => P a b\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule T12102 where\n\nimport Data.Kind\nimport GHC.TypeLits\n\ntype family IsTypeLit a where\n  IsTypeLit Nat    = 'True\n  IsTypeLit Symbol = 'True\n  IsTypeLit a      = 'False\n\ndata T :: forall a. (IsTypeLit a ~ 'True) => a -> Type where\n  MkNat    :: T 42\n  MkSymbol :: T \"Don't panic!\"\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12124 where\n\ndata Whoops = Whoops Int Int\n\nfoo :: Maybe Int\nfoo = return (case Whoops 1 2 of\n                 Whoops a -> a\n                 _ -> 0)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n-- {-# LANGUAGE AllowAmbiguousTypes #-} -- Not required with GHC 8.0.1.\n\nmodule T12151 where\n\nclass Put a where\n    put :: a\n\n    default put :: t  -- This should be `a` instead of `t`\n    put = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-}\n\nmodule T12170a where\n\n-- import Control.Monad  -- comment this out to cause error\nimport Data.IORef\n\nclass MonadRef m where\n    type Ref m :: * -> *\n    newRef :: a -> m (Ref m a)\n    readRef :: Ref m a -> m a\n\ninstance MonadRef IO where\n    type Ref IO = IORef\n    newRef = newIORef\n    readRef = readIORef\n\nfoo :: IO ()\nfoo = newRef (pure ()) >>= join . readRef\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nbar = \\x -> \\x -> _\n\nbaz = \\x -> \\y -> \\z -> \\x -> \\z -> _\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, ScopedTypeVariables, UnboxedTuples #-}\n\nmodule T12373 where\n\nimport GHC.MVar\nimport GHC.Prim\nimport GHC.Types\n\nmain :: IO ()\nmain = IO (\\rw -> newMVar# rw) >> return ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fdefer-typed-holes #-}\n\nmodule T12406 where\n\n-- import Control.Monad  -- comment this out to cause error\nimport Data.IORef\n\nclass MonadRef m where\n    type Ref m :: * -> *\n    newRef :: a -> m (Ref m a)\n    readRef :: Ref m a -> m a\n\ninstance MonadRef IO where\n    type Ref IO = IORef\n    newRef = newIORef\n    readRef = readIORef\n\nfoo :: IO ()\nfoo = newRef (pure ()) >>= join . readRef\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\nmodule T12430 where\n\ntype C a = Int\ntype family F x = y | y -> x where\n  F x = C x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n\nmodule T12529 where\n\nf = p @ Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T12563 where\n\nfoo :: ((forall a. f a) -> f r) -> f r\nfoo g = undefined\n\nx = \\g -> foo g\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeApplications #-}\n{-# OPTIONS_GHC -fdefer-typed-holes #-}\nmodule T12589 where\n\nimport Data.Proxy\n\nhcpure :: proxy c -> (forall a. c a => f a) -> h f xs\nhcpure _ _ = undefined\n\na = minBound\n  & hcpure (Proxy @Bounded)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FunctionalDependencies #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE UndecidableSuperClasses #-}\nmodule T12648 where\n\nimport Data.Kind (Type, Constraint)\nimport Unsafe.Coerce (unsafeCoerce)\n\ntype family Skolem (p :: k -> Constraint) :: k\ntype family Forall (p :: k -> Constraint) :: Constraint\ntype instance Forall p = Forall_ p\nclass p (Skolem p) => Forall_ (p :: k -> Constraint)\ninstance p (Skolem p) => Forall_ (p :: k -> Constraint)\n\ninst :: forall p a. Forall p :- p a\ninst = unsafeCoerce (Sub Dict :: Forall p :- p (Skolem p))\n\ndata Dict :: Constraint -> Type where\n  Dict :: a => Dict a\n\nnewtype a :- b = Sub (a => Dict b)\n\ninfixl 1 \\\\ -- required comment\n\n(\\\\) :: a => (b => r) -> (a :- b) -> r\nr \\\\ Sub Dict = r\n\nclass (Applicative b, Applicative m, Monad b, Monad m) => MonadBase b m | m -> b\n\ninstance MonadBase IO IO -- where liftBase = id\n\nclass MonadBase b m => MonadBaseControl b m | m -> b where\n  type StM m a :: Type\n  liftBaseWith :: (RunInBase m b -> b a) -> m a\n\ntype RunInBase m b = forall a. m a -> b (StM m a)\n\ninstance MonadBaseControl IO IO where\n    type StM IO a = a\n    liftBaseWith f = f id\n    {-# INLINABLE liftBaseWith #-}\n\nclass    (StM m a ~ a) => IdenticalBase m a\ninstance (StM m a ~ a) => IdenticalBase m a\n\nnewtype UnliftBase b m = UnliftBase { unliftBase :: forall a. m a -> b a }\n\nmkUnliftBase :: forall m a b. (Forall (IdenticalBase m), Monad b)\n             => (forall c. m c -> b (StM m c)) -> m a -> b a\nmkUnliftBase r act = r act \\\\ (inst :: Forall (IdenticalBase m) :- IdenticalBase m a)\n\nclass    (MonadBaseControl b m, Forall (IdenticalBase m)) => MonadBaseUnlift b m | m -> b\ninstance (MonadBaseControl b m, Forall (IdenticalBase m)) => MonadBaseUnlift b m\n\naskUnliftBase :: forall b m. (MonadBaseUnlift b m) => m (UnliftBase b m)\naskUnliftBase = liftBaseWith unlifter\n  where\n    unlifter :: (forall c. m c -> b (StM m c)) -> b (UnliftBase b m)\n    unlifter r = return $ UnliftBase (mkUnliftBase r)\n\nf :: (MonadBaseUnlift m IO) => m a\nf = do\n\n _ <- askUnliftBase\n\n return ()\n", "num_lines": 77}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language PolyKinds, ViewPatterns, RebindableSyntax,\n             MagicHash, NoImplicitPrelude #-}\n\nmodule T12709 where\n\nimport GHC.Types\nimport Prelude hiding (Num (..))\nimport qualified Prelude as P\nimport GHC.Prim\n\ndata BoxUnbox = BUB Int Int#\n\nclass Num (a :: TYPE rep) where\n  (+) :: a -> a -> a\n\n  fromInteger :: Integer -> a\n\ninstance Num Int where\n  (+) = (P.+)\n  fromInteger = P.fromInteger\n\ninstance Num Int# where\n  (+) = (+#)\n  fromInteger (fromInteger -> I# n) = n\n\na :: BoxUnbox\na = let u :: Num (a :: TYPE rep) => a\n        u = 1 + 2 + 3 + 4\n     in\n        BUB u u\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, MagicHash #-}\n\nmodule T12729 where\n\nimport GHC.Exts\n\nnewtype A where\n   MkA :: Int# -> A\n\nnewtype B = MkB Int#\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TypeOperators, ViewPatterns #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE DataKinds, PolyKinds, GADTs #-}\n\nmodule T12785b where\n\nimport Data.Kind\n\ndata Peano = Z | S Peano\n\ndata HTree n a where\n  Point :: a -> HTree Z a\n  Leaf :: HTree (S n) a\n  Branch :: a -> HTree n (HTree (S n) a) -> HTree (S n) a\n\ndata STree n :: forall a . (a -> Type) -> HTree n a -> Type where\n  SPoint :: f a -> STree Z f (Point a)\n  SLeaf :: STree (S n) f Leaf\n  SBranch :: f a -> STree n (STree (S n) f) stru -> STree (S n) f (a `Branch` stru)\n  SBranchX :: (Payload (S n) (Payload n stru) ~ a)\n          => f a -> STree n (STree (S n) f) stru -> STree (S n) f (a `Branch` stru)\n\ndata Hidden :: Peano -> (a -> Type) -> Type where\n  Hide :: STree n f s -> Hidden n f\n\nnest :: HTree m (Hidden (S m) f) -> Hidden m (STree ('S m) f)\nnest (Point (Hide st)) = Hide (SPoint st)\nnest Leaf = Hide SLeaf\nnest (Hide a `Branch` (nest . hmap nest -> Hide tr)) = Hide $ a `SBranchX` tr\n\nhmap :: (x -> y) -> HTree n x -> HTree n y\nhmap f (Point a) = Point (f a)\nhmap f Leaf = Leaf\nhmap f (a `Branch` tr) = f a `Branch` hmap (hmap f) tr\n\ntype family Payload (n :: Peano) (s :: HTree n x) where\n  Payload Z (Point a) = a\n  Payload (S n) (a `Branch` stru) = a\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances,\n             TypeFamilies, FunctionalDependencies #-}\n\nmodule T10778 where\n\ntype family F a :: *\nclass C a b | a -> b\n\ninstance C p (F q) => C p [q]\n-- This instance should fail the (liberal) coverage condition\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n\nmodule T12837 where\n\nimport GHC.TypeLits\nimport Data.Typeable\n\ndata K = K\n\ninstance Typeable K\ninstance KnownNat n\ninstance KnownSymbol n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "x :: String -> String\nx s = print (reverse s + 1)\n\nmyshow :: (String -> String) -> String\nmyshow x = show x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\nmodule T12918a where\n\nimport Control.Monad.Trans.Class\n\nclass Monad m => MonadSupply m where\n  fresh :: m Integer\n  default fresh :: MonadTrans t => t m Integer\n  fresh = lift fresh\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T12918b where\n\nclass Foo1 a where\n  -- These ones should be rejected\n  bar1         :: a -> b\n  default bar1 :: b -> a\n  bar1 = undefined\n\n  bar2         :: a -> b\n  default bar2 :: x\n  bar2 = undefined\n\n  bar3         :: a -> b\n  default bar3 :: a -> Int\n  bar3 = undefined\n\n  bar4         :: a -> Int\n  default bar4 :: a -> b\n  bar4 = undefined\n\n  -- These ones are OK\n  baz1         :: forall b c. a -> b -> c\n  default baz1 :: forall b c. a -> b -> c\n  baz1 = undefined\n\n  baz2         :: forall b c. a -> b -> c\n  default baz2 :: forall c b. a -> b -> c\n  baz2 = undefined\n\n  baz3         :: a -> b -> c\n  default baz3 :: a -> x -> y\n  baz3 = undefined\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\nmodule T12921 (stat) where\n\n{-# ANN module \"HLint: ignore Reduce duplication\" #-}\n\nstat :: Int -> Int\nstat = choice []\n\n-- 'choice' is deliberately out of scope in this test\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -dcore-lint -fdefer-typed-holes #-}\nmodule T12947 where\n\nimport qualified Control.Monad.Fail as Fail\n\nnewtype P m a = P { unP :: (a -> IO (m ())) -> IO (m ()) }\n\ninstance Functor (P m) where\n\ninstance Applicative (P m) where\n\ninstance Monad (P m) where\n\ninstance (Fail.MonadFail m) => Fail.MonadFail (P m) where\n  fail msg = ContT $ \\ _ -> Fail.fail msg\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T12966 where\n-- This should fail with a proper error message, not a compiler panic.\ntype Maybeify c = forall d. (c d) => ((~) (Maybe d))\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, PolyKinds, ExplicitForAll #-}\n\nmodule T12973 where\n\nimport qualified Prelude as P\nimport GHC.Exts\n\nclass Num (a :: TYPE r) where\n  (+) :: a -> a -> a\n  fromInteger :: P.Integer -> a\n\nfoo :: forall r (a :: TYPE r). Num a => a\nfoo = 3 + 4\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13068 where\nimport T13068a\nclass C a where\n    f :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13068a where\nimport {-# SOURCE #-} T13068\ninstance C Int where\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import T13068\nmain = print (f :: Int)\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule Main where\n\n!(Just x) = Nothing\n\nmain = putStrLn \"hi there!\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnicodeSyntax, MagicHash, DataKinds, PolyKinds, TypeFamilies #-}\n\n-- from Conal Elliott\n-- Actually, this *should* work. But I want to put it in the testsuite\n-- as a succeeding \"compile_fail\" test to make sure that we don't panic.\n\nmodule RepRep where\n\nimport GHC.Exts\n\ntype family RepRep a \u00e2\u02c6\u00b7 RuntimeRep\n\nclass HasRep a where\n  type Rep a \u00e2\u02c6\u00b7 TYPE (RepRep a)\n  repr \u00e2\u02c6\u00b7 a \u00e2\u2020\u2019 Rep a\n  abst \u00e2\u02c6\u00b7 Rep a \u00e2\u2020\u2019 a\n\ntype instance RepRep Int = IntRep\n\ninstance HasRep Int where\n  type Rep Int = Int#\n  abst n = I# n\n  repr (I# n) = n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport T13292a\n\n-- main :: IO ()\nmain = someFunc\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13292a( someFunc ) where\n\n--someFunc :: IO ()\nsomeFunc = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule T13300 where\n\ndata W where\n  WI :: Int\n  WD :: Double\n\ndata Superblock\n  = A { f :: W }\n  | B { f :: W }\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T13311 where\n\nf :: forall a. (Monoid a) => forall b. (Monoid b) => Maybe a -> Maybe b\nf _ = mempty\n\ng :: IO ()\ng = do\n  f\n  putChar 'a'\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# language ConstraintKinds, FlexibleContexts, TypeFamilies,\n    UndecidableInstances, DeriveFunctor #-}\n\nmodule T13320 where\n\nimport GHC.Exts        (Constraint)\n\ndata QCGen\n\nnewtype Gen a = MkGen { unGen :: QCGen -> Int -> a }\n  deriving Functor\n\nsized :: (Int -> Gen a) -> Gen a\nsized f = MkGen (\\r n -> let MkGen m = f n in m r n)\n\nclass Arbitrary a where\n  arbitrary :: Gen a\n\ntype family X_Var \u00ce\u00be\n\ndata TermX \u00ce\u00be = Var (X_Var \u00ce\u00be)\n\ntype ForallX (\u00cf\u2020 :: * -> Constraint) \u00ce\u00be = ( \u00cf\u2020 (X_Var \u00ce\u00be) )\n\n-- This type signature used to be necessary to prevent the\n-- type checker from looping.\n-- genTerm :: ForallX Arbitrary \u00ce\u00be => Int -> Gen (TermX \u00ce\u00be)\ngenTerm 0 = Var <$> arbitrary\ngenTerm n = Var <$> genTerm (n - 1)\n\ninstance ForallX Arbitrary \u00ce\u00be => Arbitrary (TermX \u00ce\u00be) where\n  arbitrary = sized genTerm\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{- # OPTIONS_GHC -fno-defer-type-errors #-}\nmodule T13446 where\n\nimport Data.Coerce (Coercible)\nimport Data.Kind (Type, Constraint)\nimport GHC.TypeLits (Symbol)\n\ndata Dict :: Constraint -> Type where\n  Dict :: a => Dict a\n\ninfixr 9 :-\nnewtype a :- b = Sub (a => Dict b)\ninstance a => Show (a :- b) where\n  showsPrec d (Sub Dict) = showParen (d > 10) $ showString \"Sub Dict\"\n\nclass Lifting p f where\n  lifting :: p a :- p (f a)\n\ndata Blah a = Blah\n\nnewtype J (a :: JType) = J (Blah (J a))\nnewtype JComparable a = JComparable (J (T (JTy a)))\n\ninstance Lifting JReference JComparable where\n  lifting = Sub 'a'\n\nclass (Coercible a (J (JTy a))) => JReference a where\n  type JTy a :: JType\n\ntype T a\n  = 'Generic ('Iface \"java.lang.Comparable\") '[a]\ndata JType = Class Symbol\n           | Generic JType [JType]\n           | Iface Symbol\ntype JObject = J (Class \"java.lang.Object\")\ninstance JReference JObject where\n  type JTy JObject = 'Class \"java.lang.Object\"\n", "num_lines": 47}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\n\nmodule T13487 where\n\nimport Data.Kind (Constraint)\nimport GHC.TypeLits\n\ndata Foo a b where\n  K :: Error a b => a -> b -> Foo a b\n\ntype family Error a b :: Constraint where\n  Error Int Int = ()\n  Error _   _   = TypeError ('Text \"GHC panic in 3... 2... 1...\")\n\nfoo = K 'a' 'b'\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses #-}\nmodule Bug where\n\nclass FunDep lista a | lista -> a\ninstance FunDep [a] a\n\nsingleton :: FunDep lista a => a -> lista\nsingleton _ = undefined\n\n-- this error is expected:\n--   Couldn't match type 'Char' with '()'\n--   arising from a functional dependency between\n--     constraint 'FunDep [Char] ()' arising from a use of 'singleton'\n--     instance 'FunDep [a] a'\nillTyped :: [Char]\nillTyped = singleton ()\n  {-  [W] FunDep [Char] () -}\n\n-- but this one is not:\n--   Couldn't match type '()' with 'Char'\n--     arising from a functional dependency between constraints:\n--       'FunDep [Char] Char' arising from a use of 'singleton' (in 'wellTyped')\n--       'FunDep [Char] ()' arising from a use of 'singleton' (in 'illTyped')\nwellTyped :: [Char]\nwellTyped = singleton 'a'\n  {-   [W] FunDep [Char] Char -}\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule T13530 where\n\nimport GHC.Exts\n\ng :: Int -> (# Int#, a #)\ng (I# y) = (# y, undefined #)\n\nf :: Int -> (# Int#, Int# #)\nf x = g x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T13610 where\n\nimport GHC.Prim\nimport GHC.Types\n\nmain = do\n    let primDouble = 0.42## :: Double#\n    let double = 0.42 :: Double\n    IO (\\s -> mkWeakNoFinalizer# double () s)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\nimport GHC.Prim\nimport GHC.Types\n\nmain = do\n    let local = ()\n    let null = 0## :: Word#\n    let triple = (# local, null, null #)\n    IO (\\s -> case mkWeakNoFinalizer# triple () s of (# s, r #) -> (# s, () #))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -dcore-lint -fdefer-typed-holes #-}\nmodule T13640 where\n\nimport Prelude hiding ((.))\n\nclass Functor' f where\n  map' :: (a -> b) -> f a -> f b\n\nclass Bifunctor' f where\n  map2' :: (a -> b) -> f a c -> f b c\n\nbimap' :: Bifunctor' f => (a -> b) -> (c -> d) -> (f a c -> f b d)\nbimap' f g = map2' f . map'\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\nmodule T13677 where\n\nimport GHC.Exts (Constraint)\n\ndata Dict a where\n  Dict :: a => Dict a\n\nfoo :: Dict (Int ~ Int) => Int\nfoo = undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor, TypeApplications #-}\n\nmodule T13819 where\n\nimport Data.Coerce\nimport Control.Applicative\n\nnewtype A a = A (IO a)\n  deriving Functor\n\ninstance Applicative A where\n  pure = pure @(_ -> WrappedMonad A _) @(_ -> A _) pure\n\ninstance Monad A where\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\nmodule T13902 where\n\nf :: a -> a\nf x = x\n\ng :: Int\ng = f @Int 42 5\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\nmodule T13909 where\n\nimport Data.Kind\n\ndata Hm (k :: Type) (a :: k) :: Type\n\nclass HasName (a :: k) where\n  getName :: proxy a -> String\n\ninstance HasName Hm where\n  getName _ = \"Hm\"\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule Main where\n\nimport GHC.Exts\nimport Data.Kind\nimport GHC.Generics\n\nclass GUnbox (f :: Type -> Type) (r :: RuntimeRep) where\n    type GUnboxed f r :: TYPE r\n    gunbox :: f p -> GUnboxed f r\n\ninstance (GUnbox f rf, GUnbox g rg) => GUnbox (f :*: g) ('TupleRep '[rf, rg]) where\n    type GUnboxed (f :*: g) ('TupleRep '[rf, rg]) = (# GUnboxed f rf, GUnboxed g rg #)\n    -- if I remove implementation of `gunbox` it compiles successfully\n    gunbox (x :*: y) = (# gunbox x, gunbox y #)\n\ninstance (GUnbox f rf, GUnbox g rg) => GUnbox (f :+: g) ('SumRep '[rf, rg]) where\n    type GUnboxed (f :+: g) ('SumRep '[rf, rg]) = (# GUnboxed f rf | GUnboxed g rg #)\n    gunbox (L1 l) = (# gunbox l | #)\n    gunbox (R1 r) = (# | gunbox r #)\n\nmain :: IO ()\nmain = pure ()\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T13983 where\n\nimport Data.Proxy\n\ntype Wat = forall (a :: k). Proxy a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T14000 where\n\nclass C a where\n    type T a\n    c :: a -> T a\n\nfoo = c noSuchThing   -- noSuchThing is not in scope\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\nmodule T14048a where\n\nimport Data.Kind\n\ndata Foo :: Constraint\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14048b where\n\nimport Data.Kind\n\ndata family Foo :: Constraint\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T14048c where\n\nimport Data.Kind\n\ndata family   Foo :: k\ndata instance Foo :: Constraint\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeFamilies #-}\n\nnewtype X = RollX (() -> X)\n\ntype family F t :: X where\n    F t = RollX (t -> ())\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14232 where\n\nf :: (String -> a) String -> a\nf g s = g s\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, MultiParamTypeClasses #-}\n\nmodule T14325 where\n\nclass (a~b) => C a b\n\nfoo :: C a b => a -> b\nfoo x = x\n\nhm3 :: C (f b) b => b -> f b\nhm3 x = foo x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds, DataKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T14350 where\n\nimport Data.Kind\n\ndata Proxy a = Proxy\ndata family Sing (a :: k)\n\ndata SomeSing k where\n  SomeSing :: Sing (a :: k) -> SomeSing k\n\nclass SingKind k where\n  type Demote k :: Type\n  fromSing :: Sing (a :: k) -> Demote k\n  toSing   :: Demote k -> SomeSing k\n\ndata instance Sing (x :: Proxy k) where\n  SProxy :: Sing 'Proxy\n\ninstance SingKind (Proxy k) where\n  type Demote (Proxy k) = Proxy k\n  fromSing SProxy = Proxy\n  toSing Proxy = SomeSing SProxy\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family Apply (f :: k1 ~> k2) (x :: k1) :: k2\ntype a @@ b = Apply a b\ninfixl 9 @@\n\nnewtype instance Sing (f :: k1 ~> k2) =\n  SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) }\n\ninstance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where\n  type Demote (k1 ~> k2) = Demote k1 -> Demote k2\n  fromSing sFun x = case toSing x of SomeSing y -> fromSing (applySing sFun y)\n  toSing = undefined\n\ndcomp :: forall (a :: Type)\n                (b :: a ~> Type)\n                (c :: forall (x :: a). Proxy x ~> b @@ x ~> Type)\n                (f :: forall (x :: a) (y :: b @@ x). Proxy x ~> Proxy y ~> c @@ ('Proxy :: Proxy x) @@ y)\n                (g :: forall (x :: a). Proxy x ~> b @@ x)\n                (x :: a).\n         Sing f\n      -> Sing g\n      -> Sing x\n      -> c @@ ('Proxy :: Proxy x) @@ (g @@ ('Proxy :: Proxy x))\ndcomp f g x = applySing f Proxy Proxy\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14390 where\n\nimport Data.Type.Equality\ninstance (~~) Int Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TypeApplications #-}\n{-# Language ImpredicativeTypes #-}\n-- This isn't a test for impredicative types; it's\n-- just that visible type application on a for-all type\n-- is an easy way to provoke the error.\n--\n-- The ticket #14605 has a much longer example that\n-- also fails; it does not use ImpredicativeTypes\n\nmodule T14605 where\n\nimport GHC.Prim (coerce)\n\nduplicate = coerce @(forall x. ()) @(forall x. x)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n    -- This line is crucial to the bug\n\n{-# Language GADTs #-}\n{-# Language InstanceSigs #-}\n{-# Language KindSignatures #-}\n{-# Language TypeFamilies #-}\n{-# Language DataKinds #-}\n{-# Language FlexibleInstances #-}\n\nmodule T14607 where\n\nimport Data.Kind\n\ndata LamCons :: Type -> Type -> () -> Type where\n  C :: LamCons a a '()\n\nclass Mk a where\n  mk :: LamCons a a '()\n\ninstance Mk a where\n  mk :: LamCons a '()\n  mk = mk\n\n-- At some point, this program was accepted. That's fine. But right now,\n-- it's rejected with a kind error, and we can't generally defer kind\n-- errors, so I'm saying that behavior is OK.\n\n-- Later (May 18) the kind error ended up being in an term-level\n-- implication constraint, which /does/ have an evidence binding\n-- So now the kind error can be deferred.\n-- Consequence of a fast-path for tcImplicitTKBndrsX I think.\n\n-- Later (Nov 18) we are back to a kind error, which is fine\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T14618 where\n\nsafeCoerce :: a -> b\nsafeCoerce = f'\n    where\n        f :: d -> forall c. d\n        f x = x\n\n        f' = f\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, GADTs #-}\n\n-- Enable -Werror to fail in case we get this warning:\n--\n--   UNPACK pragma lacks '!' on the first argument of \u00e2\u20ac\u02dcA\u00e2\u20ac\u2122\n--\n-- In this test case we expect to get this warning and fail,\n-- see T14761c for the opposite.\n{-# OPTIONS -Werror #-}\n\nmodule T14761a where\n\ndata A = A { a :: {-# UNPACK #-} Maybe Int }\n\ndata x && y = Pair x y\n\ndata B = B { b :: {-# UNPACK #-} Maybe Int && [] Char && Int }\n\ndata G where\n  MkG2 :: {-# UNPACK #-} Maybe Int && [] Char && Int -> G\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n\nmodule T14761b where\n\ndata A = A { a :: ! Maybe Int}\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T14884 where\n\nx :: IO ()\nx = _ print \"abc\"\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T14904a where\n\nimport Data.Kind\n\ntype family F (f :: forall a. g a) :: Type where\n  F (f :: forall a. g a) = Int\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE PolyKinds #-}\nmodule T14904b where\n\nimport Data.Kind\n\ntype family F f :: Type where\n  F ((f :: forall a. g a) :: forall a. g a) = Int\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums #-}\n{-# LANGUAGE DataKinds #-}\n\nmodule T15067 where\n\nimport Type.Reflection\n\nfloopadoop :: TypeRep (# Bool | Int #)\nfloopadoop = typeRep\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeInType #-}\nmodule T15330 where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata T :: forall a. a -> Type\n\nf1 :: Proxy (T True)\nf1 = \"foo\"\n\nf2 :: forall (t :: forall a. a -> Type).\n      Proxy (t True)\nf2 = \"foo\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T15361 where\n\nimport Data.Kind\nimport Data.Type.Equality\n\n-- Don't report (* ~ *) here\nfoo :: forall (a :: Type) (b :: Type) (c :: Type).\n       a :~~: b -> a :~~: c\nfoo HRefl = HRefl\n\ndata Chumbawamba :: Type -> Type where\n  IGetKnockedDown :: (Eq a, Ord a) => a -> Chumbawamba a\n\n-- Don't report (Eq a) here\ngoo :: Chumbawamba a -> String\ngoo (IGetKnockedDown x) = show x\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  MultiParamTypeClasses, RankNTypes #-}\n\nmodule T15438 where\n\nclass C a b\n\nfoo :: (forall a b. C a b => b -> b) -> Int\nfoo = error \"urk\"\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\nmodule T15515 where\n\nimport Data.Kind\nimport Data.Proxy\n\nclass C a where\n  c :: Proxy a\n\ntype family F\n\ndata D :: F -> Type\n\ninstance C (D :: F -> Type) where\n  c = Proxy\n\nc' :: Proxy (D :: F -> Type)\nc' = c @(D :: F -> Type)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StrictData #-}\n\nmodule T15523 where\n\nnewtype Duration = Foo\ndata Literal = LitDuration Duration\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15527 where\n\nf :: (Int -> Int) -> (Int -> Int) -> (Int -> Int)\nf =  (.) @Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, PolyKinds, TypeOperators #-}\n{-# LANGUAGE TypeInType, TypeFamilies #-}\nmodule T15552 where\n\nimport Data.Kind\n\ndata Elem :: k -> [k] -> Type\n\ndata EntryOfVal (v :: Type) (kvs :: [Type]) where\n  EntryOfVal :: forall (v :: Type) (kvs :: [Type]) (k :: Type).\n                Elem (k, v) kvs -> EntryOfVal v kvs\n\ntype family EntryOfValKey (eov :: EntryOfVal v kvs) :: Type\n\ntype family GetEntryOfVal (eov :: EntryOfVal v kvs) :: Elem (EntryOfValKey eov, v) kvs\n\ntype family FirstEntryOfVal (v :: Type) (kvs :: [Type]) :: EntryOfVal v kvs where\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, PolyKinds, TypeOperators #-}\n{-# LANGUAGE TypeInType, TypeFamilies #-}\n{-  # LANGUAGE UndecidableInstances #-}\nmodule T15552 where\n\nimport Data.Kind\n\ndata Elem :: k -> [k] -> Type where\n  Here :: Elem x (x : xs)\n  There :: Elem x xs -> Elem x (y : xs)\n\ndata EntryOfVal (v :: Type) (kvs :: [Type]) where\n  EntryOfVal :: forall (v :: Type) (kvs :: [Type]) (k :: Type).\n                Elem (k, v) kvs -> EntryOfVal v kvs\n\ntype family EntryOfValKey (eov :: EntryOfVal v kvs) :: Type where\n  EntryOfValKey ('EntryOfVal (_ :: Elem (k, v) kvs)) = k\n\ntype family GetEntryOfVal (eov :: EntryOfVal v kvs)\n            :: Elem (EntryOfValKey eov, v) kvs\n  where\n    GetEntryOfVal ('EntryOfVal e) = e\n\ntype family FirstEntryOfVal (v :: Type) (kvs :: [Type]) :: EntryOfVal v kvs\n  where FirstEntryOfVal v (_ : kvs)\n           = 'EntryOfVal (There (GetEntryOfVal (FirstEntryOfVal v kvs)))\n--type instance FirstEntryOfVal v (_ : kvs)\n--         = 'EntryOfVal ('There (GetEntryOfVal (FirstEntryOfVal v kvs)))\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeApplications, DataKinds, RankNTypes #-}\n\nmodule T15592 where\nimport Data.Proxy\n\ndata VisProxy k (a :: k) = MkVP\nclass D (a :: Proxy j) (b :: Proxy k) c where\n  meth1 :: forall z. D @j @k a b z => z -> Proxy '(a, b)\n  meth2 :: Proxy k j -> Proxy '(a, b, c)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Bug (f) where\n\nimport Data.Kind\nimport Data.Proxy\n\ndata TyFun :: Type -> Type -> Type\ntype a ~> b = TyFun a b -> Type\ninfixr 0 ~>\n\ntype family F x :: Type -> Type\ndata F1Sym :: forall x a. x ~> F x a\ndata F2Sym :: forall x a. F x a ~> x\ndata Comp :: forall b c a. (b ~> c) -> (a ~> b) -> (a ~> c)\n\nsg :: forall a b c (f :: b ~> c) (g :: a ~> b) (x :: a).\n      Proxy f -> Proxy g -> Proxy (Comp f g)\nsg _ _ = Proxy\n\nf :: forall (x :: Type). Proxy x -> ()\nf _ = ()\n  where\n    g :: forall z ab. Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)\n    g = sg Proxy Proxy\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeOperators #-}\nmodule T15648 where\n\nimport Data.Kind (Type)\nimport Data.Type.Equality (type (~~))\nimport T15648a (ueqT)\n\ndata LegitEquality :: Type -> Type -> Type where\n  Legit :: LegitEquality a a\n\ndata JankyEquality :: Type -> Type -> Type where\n  Jank :: $ueqT a b -> JankyEquality a b\n\nunJank :: JankyEquality a b -> $ueqT a b\nunJank (Jank x) = x\n\nlegitToJank :: LegitEquality a b -> JankyEquality a b\nlegitToJank Legit = Jank\n\nmkLegit :: a ~~ b => LegitEquality a b\nmkLegit = Legit\n\nueqSym :: forall (a :: Type) (b :: Type).\n          $ueqT a b -> $ueqT b a\nueqSym = unJank $ legitToJank $ mkLegit @b @a\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T15648a where\n\nimport Language.Haskell.TH.Lib\nimport Language.Haskell.TH.Syntax\n\nueqT :: Q Type\nueqT = conT $ mkNameG_tc \"ghc-prim\" \"GHC.Prim\" \"~#\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies, FlexibleContexts #-}\n\nmodule T15767 where\n\nclass C a b | b -> a where f :: a -> b\n\ny = x where\n  x :: (C () b, C Bool b) => b\n  x  = f ()\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes       #-}\n{-# Language TypeFamilies     #-}\n{-# Language TypeApplications #-}\n{-# Language PolyKinds        #-}\n\nmodule T15793 where\nimport Data.Kind\n\ntype family\n  F1 (a :: Type) :: Type where\n  F1 a = Maybe a\n\nf1 :: F1 a\nf1 = Nothing\n\ntype family\n  F2 :: forall (a :: Type). Type where\n  F2 @a = Maybe a\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Bug where\n\nnewtype N a where\n  MkN :: Show a => a -> N a\ntype family T a\ntype instance T (N a) = N a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language    RankNTypes          #-}\n{-# Language    TypeFamilies        #-}\n{-# Language    ScopedTypeVariables #-}\n{-# Language    TypeApplications    #-}\n{-# Language    DataKinds           #-}\n{-# Language    PolyKinds           #-}\n{-# Language    TypeOperators       #-}\n{-# Language    GADTs               #-}\n{-# Language    FlexibleInstances   #-}\n\nmodule T15797 where\nimport Data.Kind\n\nclass R\u00c3\u00adki (obj :: Type) where\n  type Obj :: obj -> Constraint\n  type Obj = B\u00c3\u00a6 @k :: k -> Constraint\n\nclass    B\u00c3\u00a6    (a :: k)\ninstance B\u00c3\u00a6 @k (a :: k)\n\ndata\n  EQ :: forall ob. ob -> ob -> Type where\n  EQ :: EQ a a\n\ninstance\n  R\u00c3\u00adki (EQ @ob)\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language CPP               #-}\n{-# Language DataKinds         #-}\n{-# Language RankNTypes        #-}\n{-# Language PatternSynonyms   #-}\n{-# Language TypeOperators     #-}\n{-# Language PolyKinds         #-}\n{-# Language GADTs             #-}\n{-# Language TypeFamilies      #-}\n{-# Language TypeApplications  #-}\n{-# Language FlexibleContexts  #-}\n{-# Language FlexibleInstances #-}\n{-# Language InstanceSigs      #-}\n\nmodule T15799 where\nimport qualified GHC.TypeLits as TypeLits\nimport GHC.TypeLits (Nat, KnownNat)\nimport Data.Kind\n\ndata Op obj = Op obj\n\ntype family\n UnOp (op_a :: Op obj) :: obj where\n UnOp ('Op obj) = obj\n\nclass\n R\u00c3\u00adki (obj :: Type) where\n type (-->) :: Op obj -> obj -> Type\n type (<--) :: obj -> Op obj -> Type\n\n unop :: forall (a :: obj) (b :: obj). (a <-- 'Op b) -> ('Op b --> a)\n\ndata (<=) :: Op Nat -> Nat -> Type where\n  LessThan :: (KnownNat (UnOp op_a), KnownNat b, UnOp op_a TypeLits.<= b)\n           => (op_a <= b)\n\nnewtype (>=) :: Nat -> Op Nat -> Type where\n  Y :: (a <= b) -> (b >= a)\n\ninstance R\u00c3\u00adki Nat where\n type (-->) = (<=)\n type (<--) = (>=)\n\n unop :: (a >= b) -> (b <= a)\n unop GreaterThan = LessThan\n\npattern GreaterThan :: () => (KnownNat (UnOp b), KnownNat a, UnOp b <= a) => a >= b\npattern GreaterThan = Y LessThan\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language CPP                   #-}\n{-# Language QuantifiedConstraints #-}\n{-# Language TypeApplications      #-}\n{-# Language PolyKinds             #-}\n{-# Language TypeOperators         #-}\n{-# Language DataKinds             #-}\n{-# Language TypeFamilies          #-}\n{-# Language TypeSynonymInstances  #-}\n{-# Language FlexibleInstances     #-}\n{-# Language GADTs                 #-}\n{-# Language UndecidableInstances  #-}\n{-# Language MultiParamTypeClasses #-}\n{-# Language FlexibleContexts      #-}\n\nmodule Bug where\nimport Data.Coerce\nimport Data.Kind\n\ntype Cat ob = ob -> ob -> Type\n\ntype Obj = Type\n\nclass    Coercible (op_a --> b) (b <-- op_a) => (op_a -#- b)\ninstance Coercible (op_a --> b) (b <-- op_a) => (op_a -#- b)\n\nclass    (forall (op_a :: obj) (b :: obj). op_a -#- b) => OpOpNoOp obj\ninstance (forall (op_a :: obj) (b :: obj). op_a -#- b) => OpOpNoOp obj\n\nclass\n  R\u00c3\u00adki (obj :: Obj) where\n  type (-->) :: obj -> obj -> Type\n\n  i\u00c3\u00b0 :: a --> (a::obj)\n\nclass\n  OpOpNoOp obj\n  =>\n  OpR\u00c3\u00adki (obj :: Obj) where\n  type (<--) :: obj -> obj -> Type\n\ndata Op a = Op a\n\ntype family UnOp op where UnOp ('Op obj) = obj\n\nnewtype Y :: Cat (Op a) where\n  Y :: (UnOp b --> UnOp a) -> Y a b\n\ninstance R\u00c3\u00adki Type where\n type (-->) = (->)\n i\u00c3\u00b0 x = x\n\ninstance OpR\u00c3\u00adki (Op Type) where\n type (<--) @(Op Type) = Y @Type\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language RankNTypes       #-}\n{-# Language TypeApplications #-}\n{-# Language PolyKinds        #-}\n{-# Language GADTs            #-}\n\nmodule T15807 where\nimport Data.Kind\n\ndata\n  App :: forall (f :: k -> Type). k -> Type\n  where\n  MkApp :: f a -> App @f a\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language TypeApplications #-}\n{-# Language TypeFamilies        #-}\n\nmodule T15816 where\nimport Data.Kind\n\ndata family U\ndata instance U @Int\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "--\n-- Check that we produce only one error message for each type\n-- signature. See ticket #1595.\n--\n\nmodule T1595 where\n\nfoo1, bar1 :: DoesNotExist\nfoo1 = undefined\nbar1 = undefined\n\nclass Test a where\n  foo2, bar2 :: a -> DoesNotExist\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T15954 where\n\nimport Data.Kind\n\ntype A a = Int\ntype B1 (a :: Type -> Type) = forall x. x -> x\ntype C1 = B1 A\n\ndata NonShow\ntype B2 (a :: Type -> Type) = Show NonShow => Int\ntype C2 = B2 A\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeInType #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T15962 where\n\nimport Data.Kind (Type)\n\ntype Exp a = a -> Type\ntype family Eval (e :: Exp a) :: a\n\ndata OpKind = Conjunction\n\ndata Dual (k :: OpKind) :: Exp OpKind\n\ndata Map :: (a -> Exp b) -> [ a ] -> Exp [ b ]\n\ntype instance Eval (Map f (a ': as)) = Eval (f a) ': Eval (Map f as)\n\ndata Big :: [ OpKind ] -> Type where\n  Big  :: [ Big ks ] -> Big ('Conjunction ': ks)\n\ndualBig :: Big ks -> Big (Eval (Map Dual ks))\ndualBig = _\n\ninstance Semigroup (Big a) where\n  Big xs <> Big ys = Big (xs <> ys)\n\ninstance Monoid (Big ('Conjunction ': ks)) where\n  mempty = iDontExist\n\nflatten :: Monoid (Big ks) => Big (k ': k ': ks) -> Big ks\nflatten = undefined\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\nmodule T16059a where\n\ntype Foo b = Eq b => b\n\nf :: forall b (a :: Eq b => b). Int\nf = 27\n\ng :: forall b (a :: Foo b). Int\ng = 42\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE UnboxedTuples #-}\nmodule T16059b where\n\ntype Foo = forall a. a\ntype Bar = (# #)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16059c where\n\nimport T16059b\n\nf :: Foo -> a -> f\nf g x = g x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16059d where\n\nimport T16059b\n\ntype Bar' = Bar\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T16059e where\n\nimport T16059b\n\ntype Const a b = a\n\n-- This is accepted, since the rank-n type `Foo` never makes it into the type\n-- of `f` post-expansion...\nf :: Const Int Foo -> Int\nf _ = 42\n\n-- ...but this *is* rejected, since `Foo` does make it into the type of `g`\n-- post-expansion.\ng :: Const Foo Foo -> Int\ng _ = f 27\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeOperators, PolyKinds #-}\n\nmodule T16074 where\n\nimport GHC.Types\n\ndata a :~: b where Refl :: a :~: a\n\nfoo :: TYPE a :~: TYPE b\nfoo = Refl\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16204c where\n\nimport Data.Kind\n\ndata family Sing :: forall k. k -> Type\ntype family Rep  :: Type\n\nsTo :: forall (a :: Rep). Sing a\nsTo = sTo\n\nx :: forall (a :: Type). Sing a\nx = id sTo\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule T16255 where\n\nimport Data.Kind\nimport GHC.TypeLits\n\ndata SBool :: Bool -> Type\ntype family F1 :: forall k. k -> Type where\n  F1 @Bool = SBool\n\ndata family D1 :: forall k. k -> Type\n-- Note that this similar-looking data family instance is OK, since data family\n-- instances permit oversaturation in their equations.\ndata instance D1 @Bool :: Bool -> Type\n\ntype family F2 (x :: j) :: forall k. Either j k where\n  F2 5 @Symbol = Left 4\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n\n-- This just tests what the kind error message looks like\n-- Trac #1633\n\nmodule T1633 where\n\ninstance Functor Bool\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule Foo where\n\nclass Wob a b where\n   to :: a -> b\n   from :: b -> a\n\nfoo x = [x, to (from x)]\n-- Ambiguous type:  Wob a b => b -> [b]\n-- Should be rejected\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for Trac #1899\n\nmodule T1899 where\n\n data Constraint a = Formula [[Proposition a]]\n data Proposition a = Prop a\n                    | Auxiliary [Proposition a]\n\n transRHS :: [a] -> Int -> Constraint a\n transRHS varSet b =\n     if b < 0\n       then Formula [[Prop (Auxiliary undefined)]]\n       else Formula $\n                 [[Prop (Auxiliary varSet),\n                   Prop (Auxiliary varSet)]\n                 ]\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #2126\n\nmodule Foo where\n\nnewtype X\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses, UndecidableInstances, FlexibleInstances #-}\n\nmodule T2247 where\n\nclass FD a b | a -> b\ninstance CFD a b => FD a b\n\nclass {- FD a b => -} CFD a b\ninstance CFD Bool Char\ninstance CFD Bool Bool\n\nf' :: FD Bool Bool => Bool\nf' = True\n\ng' :: FD Bool Char => Bool\ng' = False\n\nx = f'\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n              UndecidableInstances,\n              IncoherentInstances,\n              FlexibleInstances #-}\n\n-- Trac #2307\n\nmodule ShouldFail where\n\n class C a b c | a -> b, a -> c\n instance C Int (Maybe String) Float\n instance C Int (Maybe Bool)   Double\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2354(test) where \n \nclass AsInt a where \n  {-# NOINLINE toInt #-} \n  toInt   :: a -> Int \n  {-# NOINLINE fromInt #-} \n  fromInt :: Int -> a \n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test for Trac #2414\n-- Should provoke an occurs-check error\n\nmodule ShouldFail where\n\nunfoldr :: (b -> Maybe (Bool, b)) -> Bool\nunfoldr = unfoldr\n\nf = unfoldr Just\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2534 where\n\nfoo = foldr (>>=) [] []\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Trac #2538\nmodule ShouldFail where\nimport Data.Ix\n\nf :: (Eq a => a -> a) -> Int\nf = error \"urk\"\n\ng :: [Eq a => a -> a] -> Int\ng = error \"urk\"\n\nh :: Ix (Eq a => a -> a) => Int\nh = error \"urk\"\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -XFunctionalDependencies -XMultiParamTypeClasses #-}\n\nmodule T2688 where\n\nclass VectorSpace v s | v -> s where\n    (*^)    :: s -> v -> v\n    (^/)    :: v -> s -> v\n    v ^/ s = v *^ (1/s)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}\n\n-- Trac #2714\n\nmodule T2714 where\n\nf :: ((a -> b) -> b) -> (forall c. c -> a)\nf = ffmap\n\nffmap :: Functor f => (p->q) -> f p -> f q\nffmap = error \"urk\"\n\n{-\n   a ~ f q\n   c ~ f p\n   (p->q) ~ (a->b) -> b\n\n =>\n   a ~ f q\n   c ~ f p\n   p ~ a->b\n   q ~ b\n =>\n   a ~ f b\n   c ~ f (a->b)\n-}\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MagicHash #-}\n{-# OPTIONS_GHC -Wunbanged-strict-patterns #-}\n\n-- Trac #2806\n\nmodule Foo where\n\nimport GHC.Base\n\nfoo :: Int\nfoo = 3\n    where (I# _x) = 4\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes, FlexibleContexts #-}\nmodule T2846 where\n\nf :: String\nf = show ([1,2,3] :: [Num a => a])\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\n-- Trac #2994\n\nmodule T2994 where\n\nclass MonadReader a b \n\nnewtype Reader' r a = Reader' (r -> a)\n\ninstance MonadReader Int\n\ninstance MonadReader (Reader' r)\n\ninstance MonadReader r r (Reader' r)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XImplicitParams -XRankNTypes #-}\nmodule Bug where\n\nt :: forall a. ((?p :: Int) => a) -> String\nt _ = \"Hello\"\n\nf :: (forall a. a -> String) -> Int\nf _ = 3\n\nresult :: Int\nresult = f t\n\n\n-- This should work.\n-- Elaborated result = f (/\\a. \\x:a. t @a (\\p::Int. x))\n-- But it did not work in 8.0.1; fixed in HEAD\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeOperators #-}\nmodule T3155 where\n\n-- Test Trac #3155\n-- Gave bad error message in GHC 6.10\n\ndata Any s where\n  Any :: s ix -> ix -> Any s\n\ndata AnyR s r where\n  AnyR :: s ix -> r ix -> AnyR s r\n\nunR :: (forall ix. r ix -> ix) -> AnyR s r -> Any s\nunR f (AnyR ix rix) = Any ix (f rix)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- Trac #3176\n\nmodule Foo where\n\ndata ES = forall a. Show a => ES {unES:: a}\n\nsmallPrintES f t = show $ unES $ f t \n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #3323\nmodule T3323 where\n\nimport GHC.IO.Handle.Types\nimport GHC.IO.Handle.Internals\n\n-- The point here is that Handle__ is an existential type, \n-- so the haDevice field can't be updated.\n--\n-- The bug was that, haDevice is a \"naughty\" selector, we \n-- couldn't find its type constructor.  \n-- \n-- This only happened when you go via an interface file, which is why\n-- this test imports an existential.  To make the test more\n-- standalone, you'd need to make it a two-module test\n\nf :: Handle__ -> Handle__\nf h = h {haDevice=undefined}\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\n-- Trac #3406\n-- A pattern signature that discards the bound variables\n\nmodule T3406 where\n\ntype ItemColID a b = Int  -- Discards a,b\n\nget :: ItemColID a b -> a -> ItemColID a b\nget (x :: ItemColID a b) = x :: ItemColID a b\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\nmodule T3468 where\n\nimport T3468a\n\ndata Tool d = forall a r . F a\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T3468a where\n\nimport {-# SOURCE #-} T3468\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, TypeFamilies #-}\nmodule T3540 where\n\nthing ::  (a~Int)\nthing = undefined\n\nthing1 ::  Int -> (a~Int)\nthing1 = undefined\n\nthing2 ::  (a~Int) -> Int\nthing2 = undefined\n\nthing3 :: (?dude :: Int) -> Int\nthing3 = undefined\n\nthing4:: (Eq a) -> Int\nthing4 = undefined", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule T3592 where\n\ntype T a = Show a => a\n\nf :: T a -> String\nf = show\n\ng :: T a -> String\ng x = show x\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- c.f Trac #3613\n\nmodule T3613 where\n\nimport Control.Monad\n\nfoo :: Maybe ()\nfoo = return ()\n\nbar :: IO ()\nbar = return ()\n\nfun1 = let fooThen m = foo>> m\n       in fooThen (bar>> undefined)\n\nfun2 = let fooThen m = foo>> m\n       in fooThen (do {bar; undefined})\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T3950 where\n\n-- Id :: (* -> * -> *) -> * -> * -> *\ndata Id p x y = Id (p x y)\n\n-- Sealed :: (* -> *) -> *\ndata Sealed p where\n    Sealed :: p x -> Sealed p\n\n-- w :: (* -> * -> *) -> *\n-- Id p :: * -> * -> *\nrp :: Bool -> Maybe (w (Id p))\nrp _ = Just rp'\n     where rp' :: Sealed (Id p x)\n           rp' = undefined\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Werror #-}\n\nmodule T3966 where\n\ndata Foo a b = Foo {-# UNPACK #-} !(a -> b)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": " {-# OPTIONS  -XMultiParamTypeClasses  -XFunctionalDependencies  -XFlexibleInstances #-}\nmodule HaskellBug where\n\ndata Relation c -- The basic Relation\n      = Rel { relnm :: String -- The name of the relation\n            , relsrc :: c -- Source concept\n            , reltrg :: c -- ^Target concept\n            }\n        deriving Eq\n\n-- This declaration is ok; should not get an error here\nclass (Eq concept)=> Association rel concept | rel -> concept where\n     source, target :: rel -> concept\n      -- e.g. Declaration Concept -> Concept\n     sign  :: rel -> (concept,concept)\n     sign x = (source x,target x)\n     homogeneous :: rel -> Bool\n     homogeneous s = source s == target s\n\ninstance (Eq c)=>Association (Relation c) c where\n     source = relsrc\n     target = reltrg\n\n-- This declaration has a kind error\n-- The error should be reported here\nclass (Eq c, Association r c) => Morphic r c where\n     multiplicities :: r c -> [c]\n     multiplicities _ = []\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\nmodule T4921 where\n\nclass C a b where\n    f :: (a,b)\n\ninstance C Int Char where\n    f = undefined\n\nx = fst f\n\ny = fst f :: Int\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n\n-- A very delicate interaction of overlapping instances\n\nmodule T5051 where\n\ndata T = T deriving( Eq, Ord )\ninstance {-# OVERLAPPING #-} Eq [T] \n\nfoo :: Ord a => [a] -> Bool\nfoo x = x >= x\n\n-- Bizarrely, the defn of 'foo' failed in GHC 7.0.3 with\n-- T5051.hs:14:10:\n--    Overlapping instances for Eq [a]\n--      arising from a use of `>'\n--    Matching instances:\n--      instance Eq a => Eq [a] -- Defined in GHC.Classes\n--      instance [overlap ok] Eq [T] -- Defined at T5051.hs:9:10-15\n--    (The choice depends on the instantiation of `a'\n--     To pick the first instance above, use -XIncoherentInstances\n--     when compiling the other instance declarations)\n--    In the expression: x > x\n--\n-- Reason: the dfun for Ord [a] (in the Prelude) had a \"silent\"\n-- superclass parameter, thus\n--     $dfOrdList :: forall a. (Eq [a], Ord a) => Ord [a]\n-- Using the dfun means we need Eq [a], and that gives rise to the\n-- overlap error.\n--\n-- This is terribly confusing: the use of (>=) means we need Ord [a],\n-- and if we have Ord a (which we do) we should be done.\n-- A very good reason for not having silent parameters!\n-- But, alas, we need them!\n--\n-- Dec 14: now we don't have them any more, the test passes!\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5084 where\n\n-- Superclass method pragma test (fail)\nclass Foo a where\n    bar :: a -> a\n    {-# INLINE bar #-}\n\n-- Instance test (ok)\ninstance Foo Int where\n    bar = (+1)\n    {-# INLINE bar #-}\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}\n\nmodule Test where\n\ninstance {-# OVERLAPPABLE #-} Show a => Eq a where\n   x == y =  length (show x) == length (show y)\n\nf :: Show a => a -> a -> Bool\nf x y = x == y\n\np = f (3 :: Int) 4\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts  #-}\n\nmodule T5236 where\n\ndata A\ndata B\n\nclass Id a b | a -> b, b -> a\n\ninstance Id A A\ninstance Id B B\n\n-- The fundeps mean that this type signature\n-- has a (derived) insoluble Given, A~B, but\n-- we now ignore that (Trac #12466)\nloop :: Id A B => Bool\nloop = True\n\n-- f :: Bool\n-- f = loop\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- Produced a duplicated error message in 7.0\n\nmodule T5246 where\n\nfoo :: (?x :: Int) => a\nfoo = undefined\n\nbar = let ?x = \"hello\"\n      in foo\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}\nmodule T5300 where\n\nimport Control.Monad.Trans.State (StateT)\n\nclass C1 a b c | a -> b\nclass C2 a b c\n\ndata T b = T\n\nf1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a\nf1 f = undefined\n\nf2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) => a1 -> StateT (T b2) m a2\nf2 fm = f1 fm >>= return . undefined\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T5570 where\n\nimport GHC.Exts\n\nmain :: IO ()\nmain = print $ D# $ 3.0##\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XFunctionalDependencies -XUndecidableInstances -XFlexibleInstances #-}\n\nmodule T5684 where\n\nclass B a b | a -> b where\n  op :: a -> b -> ()\n\nclass A a | -> a\n\ninstance A b => B Bool b\n\n{- This used to be a bug in various versions of GHC <= 7.2.2\n   The source of the problem is the kicking out of inert Solved goals back to\n   the worklist, which violated our invariant that when two constraints of the\n   same class meet (workitem-inert) then the combination (Given-Wanted) is impossible.\n   Actually it turns our that it is possible. The order in which the constraints appear\n   below is important so we add two combinations to make sure that the testcase is\n   order-insensitive. -}\n\nflop1 =  [ op False False    -- (3) Creates a functional dependency which kicks the solved out\n                             --     back in the worklist. Next time round the solved workitem\n                             --     meets the wanted from stage (2) and boom, the assertion fails!\n\n         , op 'c' undefined  -- (2) Creates a ([W] B Char beta) permanently in inerts\n         , op True undefined -- (1) Creates ([W] B Bool alpha)\n                             -- which immediately becomes [S] B Bool alpha\n         ]\n\nflop2 =  [ op False False\n         , op True undefined\n         , op 'c' undefined\n         ]\n\n\nflop3 =  [ op 'c' undefined\n         , op True undefined\n         , op False False\n         ]\n\nflop4 =  [ op 'c' undefined\n         , op False False\n         , op True undefined\n         ]\n\n\nflop5 =  [ op True undefined\n         , op 'c' undefined\n         , op False False\n         ]\n\n\nflop6 =  [ op True undefined\n         , op False False\n         , op 'c' undefined\n         ]\n\n\n{- Now, in HEAD we no longer have cached GivenSolved goals in the inerts and hence\n   this situation can no longer appear. If a Given gets kicked out it is only because\n   it got rewritten by a given equality: Notice that since Givens now never contain\n   plain old unification variables (since they are not GivenSolveds!) they can never be\n   rewritten by a spontaneously solved either! So our invariant now holds. -}\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Main where\nimport Data.IORef\n\nmain :: IO ()\nmain = do { (r :: IORef (t -> t)) <- newIORef id\n             -- r <- newIORef i -- => Type-check error\n\n          ; writeIORef r (\\v -> if v then False else True)\n\n          ; c <- readIORef r\n\n          ; print $ c True\n          ; print $ c 1234 }\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule GHCBug where\n\nimport Control.Applicative as Ap\nimport Control.Monad (MonadPlus, mplus, mzero)\nimport Data.Functor.Identity (Identity, runIdentity)\n\nnewtype PrintRuleInterp v = MkPRI { printRule_ :: Int -> String }\nclass Test p where\n  test :: p a -> p a\n\ninstance Test PrintRuleInterp where\n  test (f :: p a) =\n    MkPRI $ printRule_ f\n\n\nnewtype RecDecParser a = MkRD {\n  parseRD :: String -> [(String, a)]\n  }\n\npure_ v = MkRD $ \\s -> pure (s , v)\n\ninstance MonadPlus RecDecParser where\n  mzero = MkRD $ const Ap.empty\n  mplus a b = MkRD $ const Ap.empty\n\n\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoImplicitPrelude, TypeFamilies #-}\n\nmodule T5853 where\nimport Prelude (undefined,Bool(..),Show(..),(.))\n\ntype family Elem f :: *\ntype family Subst f b :: *\n\nclass (Subst fa (Elem fa) ~ fa) => F fa where\n        (<$>) :: (Elem fa ~ a, Elem fb ~ b,\n                  Subst fa b ~ fb, Subst fb a ~ fa) =>\n                         (a -> b) -> (fa -> fb)\n\n{-# RULES\n \"map/map\" forall f g xs. f <$> (g <$> xs) = (f.g) <$> xs\n        #-}\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, GADTs #-}\nmodule T5858 where\n\nclass InferOverloaded a where\n  infer :: a -> String\n\n-- instance (t1 ~ String, t2 ~ String) => InferOverloaded (t1,t2) where\ninstance (t1 ~ String) => InferOverloaded (t1,t1) where\n  infer = show . fst\n  \nfoo = infer ([],[])\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T5957 where\n\nflex :: Int -> Show a => a -> String\nflex i a = show a ++ show i\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FunctionalDependencies #-}\nmodule T5978 where\n\nclass C from to | from -> to where\n\ninstance C Float Char where\ninstance C Double Bool where\n\n\npolyFoo :: (C from to) => from\npolyFoo = undefined\n\npolyBar ::\n   (C fromA toA, C fromB toB) =>\n   (toA -> toB) ->\n   fromA -> fromB\npolyBar = undefined\n\n\nmonoBar :: Double\nmonoBar = polyBar id monoFoo\n-- fromA = Float, fromB = Double, toA = toB\n-- [W] C Float to, C Double to\n-- => [D] to ~ Char, [D] to ~ Bool\n\nmonoFoo :: Float\nmonoFoo = polyFoo\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE InstanceSigs #-}\n\nmodule T6001 where\n\ndata DayKind = Work | Rest\n\ninstance Num DayKind where\n  fromInteger :: Int -> DayKind\n  fromInteger = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\n\nmodule T6018Afail where\n\nimport Data.Kind (Type)\n\ntype family G a b c = (result :: Type) | result -> a b c\ntype instance G Int  Char Bool = Bool\ntype instance G Char Bool Int  = Int\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies #-}\n\nmodule T6018Bfail where\n\nimport Data.Kind (Type)\n\ntype family H a b c = (result :: Type) | result -> a b c\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T6018Cfail where\n\nimport T6018Bfail\n\ntype instance H Int  Char Bool = Bool\ntype instance H Char Bool Int  = Int\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T6018Dfail where\n\nimport T6018Bfail\n\ntype instance H Bool Int  Char = Int\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies, DataKinds, UndecidableInstances, PolyKinds,\n             MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule T6018fail where\n\nimport Data.Kind (Type)\n\nimport T6018Afail -- defines G, identical to F\nimport T6018Cfail -- imports H from T6018Bfail, defines some equations for H\nimport T6018Dfail -- imports H from T6018Bfail, defines conflicting eqns\n\ntype family F a b c = (result :: Type) | result -> a b c\ntype instance F Int  Char Bool = Bool\ntype instance F Char Bool Int  = Int\ntype instance F Bool Int  Char = Int\n\ntype instance G Bool Int  Char = Int\n\ntype family I a b c = r | r -> a b\ntype instance I Int  Char Bool = Bool\ntype instance I Int  Int  Int  = Bool\ntype instance I Bool Int  Int  = Int\n\n-- Id is injective...\ntype family Id a = result | result -> a\ntype instance Id a = a\n\n-- ...but despite that we disallow a call to Id\ntype family IdProxy a = r | r -> a\ntype instance IdProxy a = Id a\n\ndata N = Z | S N\n\n-- P is not injective, although the user declares otherwise. This\n-- should be rejected on the grounds of calling a type family in the\n-- RHS.\ntype family P (a :: N) (b :: N) = (r :: N) | r -> a b\ntype instance P  Z    m = m\ntype instance P (S n) m = S (P n m)\n\n-- this is not injective - not all injective type variables mentioned\n-- on LHS are mentioned on RHS\ntype family J a b c = r | r -> a b\ntype instance J Int b c = Char\n\n-- same as above, but tyvar is now nested inside a tycon\ntype family K (a :: N) (b :: N) = (r :: N) | r -> a b\ntype instance K (S n) m = S m\n\n-- Make sure we look through type synonyms to catch errors\ntype MaybeSyn a = Id a\ntype family L a = r | r -> a\ntype instance L a = MaybeSyn a\n\n-- These should fail because given the RHS kind\n-- there is no way to determine LHS kind\nclass PolyKindVarsC a where\n    type PolyKindVarsF a = (r :: k) | r -> a\n\ninstance PolyKindVarsC '[] where\n    type PolyKindVarsF '[] = '[]\n\ntype family PolyKindVars (a :: k0) = (r :: k1) | r -> a\ntype instance PolyKindVars '[] = '[]\n\n-- This should fail because there is no way to determine k from the RHS\ntype family Fc (a :: k) (b :: k) = r | r -> k\ntype instance Fc a b = Int\n\n-- This should fail because there is no way to determine a, b and k from the RHS\ntype family Gc (a :: k) (b :: k) = r | r -> a b\ntype instance Gc a b = Int\n\n-- fails because injectivity is not compositional in this case\ntype family F1 a = r | r -> a\ntype instance F1 [a]       = Maybe (GF1 a)\ntype instance F1 (Maybe a) = Maybe (GF2 a)\n\ntype family GF1 a = r | r -> a\ntype instance GF1 Int = Bool\n\ntype family GF2 a = r | r -> a\ntype instance GF2 Int = Bool\n\ntype family HF1 a\ntype instance HF1 Bool = Bool\n\ntype family W1 a = r | r -> a\ntype instance W1 [a] = a\n\ntype family W2 a = r | r -> a\ntype instance W2 [a] = W2 a\n\n-- not injective because of infinite types\ntype family Z1 a = r | r -> a\ntype instance Z1 [a]       = (a, a)\ntype instance Z1 (Maybe b) = (b, [b])\n\ntype family G1 a = r | r -> a\ntype instance G1 [a]       = [a]\ntype instance G1 (Maybe b) = [(b, b)]\n\ntype family G3 a b = r | r -> b\ntype instance G3 a Int  = (a, Int)\ntype instance G3 a Bool = (Bool, a)\n\ntype family G4 a b = r | r -> a b\ntype instance G4 a b = [a]\n\ntype family G5 a = r | r -> a\ntype instance G5 [a] = [GF1 a] -- GF1 injective\ntype instance G5 Int = [Bool]\n\ntype family G6 a = r | r -> a\ntype instance G6 [a]  = [HF1 a] -- HF1 not injective\ntype instance G6 Bool = Int\n\ntype family G7a a b (c :: k) = r | r -> a b\ntype family G7 a b (c :: k) = r | r -> a b c\ntype instance G7 a b c = [G7a a b c]\n\nclass C a b where\n    type FC a (b :: Type) = r | r -> b\n    type instance FC a b = b\n\ninstance C Int Char where\n    type FC Int Char = Bool\n\n-- this should fail because the default instance conflicts with one of the\n-- earlier instances\ninstance C Int Bool {- where\n    type FC Int Bool = Bool-}\n\n-- and this should fail because it violates \"bare variable in the RHS\"\n-- restriction\ninstance C Char a\n", "num_lines": 137}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies, DataKinds, PolyKinds,\n             UndecidableInstances #-}\nmodule T6018failclosed where\n\n-- Id is injective...\ntype family IdClosed a = result | result -> a where\n    IdClosed a = a\n\n-- ...but despite that we disallow a call to Id\ntype family IdProxyClosed (a :: *) = r | r -> a where\n    IdProxyClosed a = IdClosed a\n\ndata N = Z | S N\n\n-- PClosed is not injective, although the user declares otherwise. This\n-- should be rejected on the grounds of calling a type family in the\n-- RHS.\ntype family PClosed (a :: N) (b :: N) = (r :: N) | r -> a b where\n    PClosed  Z    m = m\n    PClosed (S n) m = S (PClosed n m)\n\n-- this is not injective - not all injective type variables mentioned\n-- on LHS are mentioned on RHS\ntype family JClosed a b c = r | r -> a b where\n    JClosed Int b c = Char\n\n-- this is not injective - not all injective type variables mentioned\n-- on LHS are mentioned on RHS (tyvar is now nested inside a tycon)\ntype family KClosed (a :: N) (b :: N) = (r :: N) | r -> a b where\n    KClosed (S n) m = S m\n\n-- hiding a type family application behind a type synonym should be rejected\ntype MaybeSynClosed a = IdClosed a\ntype family LClosed a = r | r -> a where\n    LClosed a = MaybeSynClosed a\n\ntype family FClosed a b c = (result :: *) | result -> a b c where\n    FClosed Int  Char Bool = Bool\n    FClosed Char Bool Int  = Int\n    FClosed Bool Int  Char = Int\n\ntype family IClosed a b c = r | r -> a b where\n    IClosed Int  Char Bool = Bool\n    IClosed Int  Int  Int  = Bool\n    IClosed Bool Int  Int  = Int\n\ntype family E2 (a :: Bool) = r | r -> a where\n  E2 False = True\n  E2 True  = False\n  E2 a     = False\n\n-- This exposed a subtle bug in the implementation during development. After\n-- unifying the RHS of (1) and (2) the LHS substitution was done only in (2)\n-- which made it look like an overlapped equation. This is not the case and this\n-- definition should be rejected. The first two equations are here to make sure\n-- that the internal implementation does list indexing corrcectly (this is a bit\n-- tricky because the list is kept in reverse order).\ntype family F a b  = r | r -> a b where\n  F Float  IO      = Float\n  F Bool   IO      = Bool\n  F a      IO      = IO a   -- (1)\n  F Char   b       = b Int  -- (2)\n\n-- This should fail because there is no way to determine a, b and k from the RHS\ntype family Gc (a :: k) (b :: k) = r | r -> k where\n    Gc a b = Int\n", "num_lines": 67}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilyDependencies  #-}\n\nmodule T6018failclosed2 where\n\n-- this one is a strange beast. Last equation is unreachable and thus it is\n-- removed. It is then impossible to typecheck barapp and thus we generate an\n-- error\ntype family Bar a = r | r -> a where\n    Bar Int  = Bool\n    Bar Bool = Int\n    Bar Bool = Char\n\nbar :: Bar a -> Bar a\nbar x = x\n\nbarapp :: Char\nbarapp = bar 'c'\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T6022 where\n\nf x = x == head\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n\nmodule T6069 where\n\nimport Control.Monad.ST\nimport Data.STRef\n\nfourty_two :: forall s. ST s Int\nfourty_two = do\n   x <- newSTRef (42::Int)\n   readSTRef x\n\nf1 = (print . runST) fourty_two -- (1)\nf2 = (print . runST) $ fourty_two -- (2)\nf3 = ((print . runST) $) fourty_two -- (3)\n\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\nmodule T6078 where\n\nimport GHC.Ptr\nimport Foreign\n\nbyteStringSlice len = \\fpbuf ip0 ipe s0 ->\n     let ip1p@(Ptr ip1) = Ptr ip0 `plusPtr` len\n     -- Note that the panic goes away if we use a bang-pattern as follows\n     -- let !ip1p@(Ptr ip1) = Ptr ip0 `plusPtr` len\n     in  ip1p\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}\n\nmodule T6161 where\n\ndata family Fam  a\n\ndata instance Fam Float = FamFloat Float\n\nclass Super a where\n  testSup :: a -> Float\n\nclass Super a => Duper a where\n  testDup :: a -> Float\n\n--class ( Super (Fam a) ) => Foo a where\nclass Duper (Fam a) => Foo a where\n  testFoo :: Fam a -> Float\n\ninstance Foo a => Duper (Fam a) where\n  testDup x = testFoo x + testSup x\n\n--instance Super (Fam Float) where\n--  testSup (FamFloat x) = x\n\ninstance Foo Float where\n  testFoo (FamFloat _) = 5.0\n\ntestProg :: Float\ntestProg = testDup (FamFloat 3.0)\n\n{- Reasoning:\n\ndfDuperFam :: Foo a -> Duper (Fam a)\ndfDuperFam d = Duper (sc (sc d)) (...testDup...)\n\ndfFooFloat :: Foo Float\ndfFooFloat = Foo (dfDuperFloat dx) ...\n\ndx :: Foo Float\ndx = dfFooFloat\n\n\n[W] d1 :: Duper (Fam Float)\n\n    -- Use Duper instnance\n    d1 = dfDuperFam d2\n[W] d2 :: Foo Float\n-}", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances    #-}\n{-# LANGUAGE TypeFamilies         #-}\n{-# LANGUAGE RankNTypes           #-}\n{-# LANGUAGE ConstraintKinds      #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule T7019a where\n\nnewtype Free c a = Free { runFree :: forall r. c r => (a -> r) -> r }\n\ntype C c = forall a. c (Free c a)\n\n-- Notice that C is a synonym, illegal!\ninstance C c => Monad (Free c) where\n  return a = Free ($ a)\n  Free f >>= g = f g\n\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances    #-}\n{-# LANGUAGE TypeFamilies         #-}\n{-# LANGUAGE RankNTypes           #-}\n\nmodule T7019a where\n\nclass Context c where\n  func1 :: c -> String\n\n-- Illegal forall in context\nclass (forall b. Context (Associated a b)) => Class a where\n  data Associated a :: * -> *\n\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, GADTs #-}\n\nmodule T7175 where\n\ntype family F a\n\ndata G1 a where\n   G1C :: F Int\n\ndata G2 a where\n   G2C :: F Int\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7210 where\n\nimport Data.IntMap\n\ndata T = C { f :: !IntMap Int }\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T7264 where\n\ndata Foo = Foo (forall r . r -> String)\n\nmmap :: (a->b) -> Maybe a -> Maybe b\nmmap f (Just x) = Just (f x)\nmmap f Nothing  = Nothing\n\n-- mkFoo2 :: (forall r. r -> String) -> Maybe Foo\n-- Should be rejected because it requires instantiating\n-- mmap at a polymorphic type\nmkFoo2 val = mmap Foo (Just val)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\nmodule T7279 where\n\ndata T a = MkT\n\ninstance (Eq a, Show b) => Eq (T a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7368 where\n\nf  = b  (l  Nothing)\n\nl :: b a -> c b\nl = undefined\n\nb :: (a -> b) -> c\nb = undefined", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types, KindSignatures #-}\nmodule T7368 where\n\nnewtype Bad w = Bad (forall a. (w a -> a))\n-- Bad :: forall w. (forall a. w a -> a) -> Bad w\n\nfun :: forall (f :: * -> *). f (Bad f) -> Bool\nfun (Bad x) = True \n\n{-  f (Bad f) ~ Bad w\n-->\n    f ~ Bad\n    Bad f ~ w\n-}\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7410 where\n\nfoo :: (Either Int, Int)\nfoo = foo\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures, FlexibleContexts, DeriveGeneric #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule T7437 where\n\nimport GHC.Generics\n\nclass GPut f where\n    gput :: f a -> [()]\n\nclass Put a where\n    put :: a -> [()]\n\n    default put :: (Generic t, GPut (Rep t)) => t -> [()]\n    put = gput . from\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T7453 where\n\nnewtype Id a = Id { runId :: a }\n\n-- cast1 :: a -> b\ncast1 v = runId z\n    where z :: Id t\n          z = aux\n              where aux = Id v\n\n-- cast2 :: a -> b\ncast2 v = z ()\n    where z :: () -> t\n          z = aux\n              where aux = const v\n\n-- cast3 :: a -> b\ncast3 v = z\n    where z :: t\n          z = v\n              where aux = const v\n\ncast1' :: a -> b\ncast1' = cast1\n\ncast2' :: a -> b\ncast2' = cast2\n\ncast3' :: a -> b\ncast3' = cast3\n\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\nmodule T7525 where\n\nhmm :: Bool\nhmm = let ?a = True in ?a && ?b\n\n{- The error message should say\n\n    Could not deduce (?b::Bool)\n      arising from a use of implicit parameter `?b'\n    from the context (?a::Bool)\n\nThat is, the context should be (?a :: Bool) not (?a :: t0).\n-}\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, InstanceSigs #-}\nmodule T7545 where\n\nclass C a where\n   f :: a -> b\n\n-- This is now accepted because the instance signature is more general\ninstance C (a -> b) where\n   f :: x\n   f = undefined\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\n\nmodule T7609 where\n\ndata X a b\n\nf :: (a `X` a, Maybe)\nf = undefined\n\ng :: (a `X` a) => Maybe\ng = undefined", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, KindSignatures #-}\nmodule T7645 where\n\nimport Data.Kind\n\ndata (+) a b = P\n\nf :: ((+) a (a :: Type), Maybe)\nf = undefined\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7696 where\n\nf1 :: (m a, t m)\nf1 = undefined\n\nf2 :: ((), w ())\nf2 = f1\n\n{-\nm :: * -> *\nt :: (* -> *) -> *\na :: *\nw :: * -> *\n\nm a ~ ()\nt m ~ w ()\n-}", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7697 where\n\nf :: Int => Int\nf x = x\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T7734 where\n\nx `f` y = x x\n(&) x y = x x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Correct type, which is inferred by GHC 7.6.1 and\n-- works fine with GHC 7.6.2:\n-- test :: Maybe (Maybe (r -> ())) -> r -> ()\n\n-- Incorrect type, resulting in a runtime <<loop>>,\n-- inferred by GHC 7.6.2 and also accepted by GHC 7.6.1:\n-- test :: a -> r -> ()\n\nmodule T7748a where\n\ntest :: a -> r -> ()\ntest zd\n = let f = let g = case zd of\n                       Nothing       -> const ()\n                       Just Nothing  -> const ()\n                       Just (Just p) -> p\n           in  g\n   in f\n\n\n\n{-\nThere is a bug in the type checker of 7.6.1 and 7.6.2, which accepts\nan incorrect type resulting in <<loop>> at runtime. Furthermore, 7.6.2\neven automatically infers this incorrect type. Hence, the attached\ncode has the following behavior:\n\n- No explicit type: Code works in 7.6.1, loops in 7.6.2 \n- Correct explicit type: Code works fine in 7.6.1 and 7.6.2 \n- Incorrect explicit type: Code loops in 7.6.1 and 7.6.2\n\nThe incorrect type has a parameter that is too polymorphic, i.e. an\n\"a\" type is accepted while the function does a pattern match on the\nparameter from which it is clear that it should be a Maybe type. In\n7.4.* versions this incorrect type is not accepted.\n-}", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7778 where\n\nv :: ((Num Int => Num) ()) => ()\nv = v\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, TypeFamilies, LiberalTypeSynonyms #-}\nmodule T7809 where\n\ntype PolyId = (forall a. a -> a)\n\ntype family F a\n\nfoo :: F PolyId\nfoo = undefined", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7851 where\n\nimport Control.Monad.Trans.State\n\nbar = do print\n         print \"Hello\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7856 where\n\ntmp :: String -> IO ()\ntmp = sequence_ lst\n  where lst = [putStrLn \"hi\"]\n\n-- sequence_ :: Monad m => [m a] -> m ()\n\n{-    m () ~ (->) String (IO ())    -- From result of sequence_\n      m a  ~ IO ()                  -- From argument of sequence_\n\nDepends which one gets treated first.\n  m := IO \nis better than\n  m := (->) String\nIt's a bit random which is chosen.\n\nI'll put it in regression suite so we see if it wobbles around.\n-}", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7857 where\n\nimport Text.Printf\n\nf :: a -> b\nf = undefined\n\ng i = f $ printf \"\" i\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7869 where\n\nf = (\\x -> f x) :: [a] -> b\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T7892 where\n\nclass C (f :: * -> *) where\n   type F (f :: *) :: *\n\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T7989 where\n\ndata A = A {a0, a1 :: Int}\ndata B = B {b0, b1 :: Int}\n\nf x = x { a0 = 3, a1 = 2, b0 = 4, b1 = 5 }\n\ndata T = T1 { x,y,v :: Int} | T2 { y,z,v :: Int } | T3 { z,x,v :: Int}\ng a = a { x=0, y=0, z=0, v=0 }\n\nh a = a { x=0, a0=0 }", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, FlexibleContexts, TypeFamilies #-}\nmodule T8030 where\n\n-- The types of op1 and op2 are both ambiguous\n-- and should be reported as such\n\nclass C (a :: k) where\n  type Pr a :: *\n  op1 :: Pr a\n  op2 :: Pr a -> Pr a -> Pr a\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule T8034 where\n\nclass C a where\n  type F a\n  foo :: F a -> F a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies #-}\n\nmodule T8044 where\n\ndata X a where\n  XInt :: X Int\n  XBool :: X Bool\n  XChar :: X Char\n\ntype family Frob a where\n  Frob Int = Int\n  Frob x   = Char\n\nfrob :: X a -> X (Frob a)\nfrob XInt = XInt\nfrob _    = XChar\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T8142 where\n\ntracer :: (Functor f, Coinductive f) => (c -> f c) -> (c -> f c)\ntracer = h where h = (\\(_, b) -> ((outI . fmap h) b)) . out\n\nclass Functor g => Coinductive g where\n  type Nu g :: *\n  out     :: Nu g -> g (Nu g)\n  outI    :: g (Nu g) -> Nu g\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule T8262 where\n\nfoo x = Just (1#)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE NegativeLiterals #-}\n\ntype T = -1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, AllowAmbiguousTypes #-}\nmodule T8392a where\n\n-- Should complain even with AllowAmbiguousTypes\n--\n-- But (Trac #12466) we now don't complain about\n-- contradictory signatures\n-- Instead we get a redundant pattern-match warning,\n-- in the post-typechecking pattern-match checks\nfoo :: (Int ~ Bool) => a -> a\nfoo x = x\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n\nmodule T8428 where\n\nimport Control.Monad.ST\n\ndata IdentityT m a = IdentityT { runIdentityT :: m a }\n\nrunIdST :: IdentityT (forall s. ST s) a -> a\nrunIdST = runST . runIdentityT\n-- Test formatting in the error message.\n-- In fact this should be rejected as a kind error (#8388)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule T8450 where\n\nrunEffect :: Either Bool r -> r\nrunEffect = undefined\n\nrun :: forall a. a\nrun = runEffect $ (undefined :: Either a ())\n\n{-  Either a () ~ Either Bool alpha\n    a ~ alpha -}", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8514 where\n\ntype T a = (a, Maybe)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8570 where\n\nimport T8570a (Image(filepath), logo)\nimport T8570b (Field(Image))\n\nfoo = let Image {filepath = x} = logo in x\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8570a where\ndata Image = Image { filepath :: () }\nlogo = Image ()", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8570b where\n\ndata Field = Image\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T8603 where\n\nimport Control.Monad\nimport Data.Functor\nimport Control.Monad.Trans.Class( lift )\nimport Control.Monad.Trans.State( StateT )\n\nnewtype RV a = RV { getPDF :: [(Rational,a)] } deriving (Show, Eq)\n\ninstance Functor RV where\n  fmap f = RV . map (\\(x,y) -> (x, f y)) . getPDF\n\ninstance Applicative RV where\n  pure = return\n  (<*>) = ap\n\ninstance Monad RV where\n  return x = RV [(1,x)]\n  rv >>= f = RV $\n    do (p,a) <- getPDF rv\n       guard (p > 0)\n       (q,b) <- getPDF $ f a\n       guard (q > 0)\n       return (p*q, b)\n\ntype RVState s a = StateT s RV a\n\nuniform :: [a] -> RV a\nuniform x = RV [(1/fromIntegral (length x), y) | y <- x]\n\ntestRVState1 :: RVState s Bool\ntestRVState1\n  = do prize <- lift uniform [1,2,3]\n       return False\n\n-- lift :: (MonadTrans t, Monad m) => m a -> t m a\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #8806\n\nmodule T8806 where\n\nf :: Int => Int\nf x = x + 1\n\ng :: (Int => Show a) => Int\ng = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n-- Trac #8883\n\nmodule T8883 where\n\ntype family PF a :: * -> *\n\nclass Regular a where\n  from :: a -> PF a a\n\n-- For fold we infer following type signature:\n--\n-- fold :: (Functor (PF a), Regular a) => (PF a b -> b) -> a -> b\n--\n-- However, this signature requires FlexibleContexts since the first\n-- type-class constraint is not of the form (class type-variable) nor\n-- (class (type-variable type1 type2 ... typen)). Since this extension\n-- is not enabled compilation should fail.\nfold f = f . fmap (fold f) . from\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\nmodule T8912 where\n\nclass C a where\n  toInt :: a -> Int\n\ninstance (?imp :: Int) => C [a] where\n  toInt _ = ?imp\n\ntest :: Int\ntest = let ?imp = 5 in toInt \"Hello, world\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9030 where\n\nbad :: Bool\nbad = ()\n\nsquare :: Integral i => i -> i\nsquare x = x^2\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\nmodule T9109 where\n\ndata G a where\n  GBool :: G Bool\n\nfoo GBool = True\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\nmodule T9196 where\n\nf :: (forall a. Eq a) => a -> a\nf x = x\n\ng :: (Eq a => Ord a) => a -> a\ng x = x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, FunctionalDependencies, MultiParamTypeClasses #-}\n\nmodule T9201 where\n\nclass MonoidalCCC (f :: x -> y) (d :: y -> y -> *) | f -> d where\n  ret :: d a (f a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, GADTs #-}\n\nmodule T9260 where\n\nimport GHC.TypeLits\n\ndata Fin n where\n  Fzero :: Fin (n + 1)\n  Fsucc :: Fin n -> Fin (n + 1)\n\ntest :: Fin 1\ntest = Fsucc Fzero\n\n{- Only the second error is legitimate.\n\n% ghc --version\nThe Glorious Glasgow Haskell Compilation System, version 7.8.2\n% ghc -ignore-dot-ghci /tmp/Error.hs\n[1 of 1] Compiling Error            ( /tmp/Error.hs, /tmp/Error.o )\n\n/tmp/Error.hs:12:8:\n    Couldn't match type \u00e2\u20ac\u02dc0\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dc1\u00e2\u20ac\u2122\n    Expected type: Fin 1\n      Actual type: Fin (0 + 1)\n    In the expression: Fsucc Fzero\n    In an equation for \u00e2\u20ac\u02dctest\u00e2\u20ac\u2122: test = Fsucc Fzero\n\n/tmp/Error.hs:12:14:\n    Couldn't match type \u00e2\u20ac\u02dc1\u00e2\u20ac\u2122 with \u00e2\u20ac\u02dc0\u00e2\u20ac\u2122\n    Expected type: Fin 0\n      Actual type: Fin (0 + 1)\n    In the first argument of \u00e2\u20ac\u02dcFsucc\u00e2\u20ac\u2122, namely \u00e2\u20ac\u02dcFzero\u00e2\u20ac\u2122\n    In the expression: Fsucc Fzero\n-}\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor#-}\nmodule Main where\n\ndata Event a b = Event a deriving (Functor)\n\nnewtype F f = F (f (F f))\n\ndata EventF a = EventF (F (Event a)) deriving (Functor)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\nmodule T9318 where\n\ntype family F x\ntype instance F Int = Bool\n\nfoo :: F Int -> ()\nfoo True = ()\n\nbar :: F Int -> ()\nbar 'x' = ()\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9323 where\n\nbroken :: [Int]\nbroken = ()\n\nambiguous :: a -> String\nambiguous _ = show 0\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9415 where\n\nclass D a => C a where\n  meth :: D a => ()\nclass C a => D a\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = _main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9605 where\n\nf1 :: Monad m => m Bool\nf1 = undefined\n\nf2 :: Monad m => m Bool\nf2 = f1 undefined\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses #-}\nmodule T9612 where\nimport Data.Monoid\nimport Control.Monad.Trans.Writer.Lazy( Writer, WriterT )\nimport Data.Functor.Identity( Identity )\n\nclass (Monoid w, Monad m) => MonadWriter w m | m -> w where\n    writer :: (a,w) -> m a\n    tell   :: w -> m ()\n    listen :: m a -> m (a, w)\n    pass   :: m (a, w -> w) -> m a\n\nf ::(Eq a) => a -> (Int, a) -> Writer [(Int, a)] (Int, a)\nf y (n,x) {- | y == x    = return (n+1, x)\n             | otherwise = -}\n   = do tell (n,x)\n        return (1,y)\n\n\ninstance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9634 where\n\ndata X = 1\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\nmodule T9739 where\n\nclass Class3 a => Class1 a where\n\nclass Class2 t a where\n  class2 :: (Class3 t) => a -> m\n\nclass (Class1 t, Class2 t t) => Class3 t where\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9774 where\n\nimport Control.Exception\n\nfoo = putStrLn (assert True 'a')\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From comment:76 in Trac #9858\n-- This exploit still works in GHC 7.10.1.\n-- By Shachaf Ben-Kiki, \u00c3\u02dcrjan Johansen and Nathan van Doorn\n\n{-# LANGUAGE Safe #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n\nmodule T9858a where\n\nimport Data.Typeable\n\ntype E = (:~:)\ntype PX = Proxy (((),()) => ())\ntype PY = Proxy (() -> () -> ())\n\ndata family F p a b\n\nnewtype instance F a b PX = ID (a -> a)\nnewtype instance F a b PY = UC (a -> b)\n\n{-# NOINLINE ecast #-}\necast :: E p q -> f p -> f q\necast Refl = id\n\nsupercast :: F a b PX -> F a b PY\nsupercast = case cast e of\n    Just e' -> ecast e'\n  where\n    e = Refl\n    e :: E PX PX\n\nuc :: a -> b\nuc = case supercast (ID id) of UC f -> f\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule T9858b where\nimport Data.Typeable\n\ntest = typeRep (Proxy :: Proxy (Eq Int => Int))\n\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImpredicativeTypes, FlexibleContexts #-}\n\nmodule T9858e where\nimport Data.Typeable\n\ni :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep\ni p = typeRep p\n\nj = i (Proxy :: Proxy (Eq Int => Int))\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies, StandaloneDeriving #-}\n\nmodule T9999 where\n\nimport Data.Typeable\n\ndata family F a\n\nclass C a where\n  data F1 a\n  type F2 a\n\nmain = typeRep (Proxy :: Proxy F) == typeRep (Proxy :: Proxy F1)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations, RankNTypes, ScopedTypeVariables #-}\n\nimport Data.Coerce (coerce, Coercible)\nimport Data.Ord (Down)\n\nnewtype Age = Age Int deriving Show\n\ntype role Map nominal _\ndata Map a b = Map a b deriving Show\n\nfoo1 = coerce $ one :: ()\n\nfoo2 :: forall m. Monad m => m Age\nfoo2 = coerce $ (return one :: m Int)\n\nfoo3 = coerce $ Map one () :: Map Age ()\n\nfoo4 = coerce $ one :: Down Int\n\nnewtype Void = Void Void\nfoo5 = coerce :: Void -> ()\n\n\n------------------------------------\n-- This next one generates an exponentally big type as it\n-- tries to unwrap.  See comment:15 in Trac #11518\n-- Adding asserions that force the types can make us\n-- run out of space.\nnewtype VoidBad a = VoidBad (VoidBad (a,a))\nfoo5' = coerce :: (VoidBad ()) -> ()\n\n------------------------------------\n-- This shoul fail with a context stack overflow\nnewtype Fix f = Fix (f (Fix f))\nfoo6 = coerce :: Fix (Either Int) -> Fix (Either Age)\nfoo7 = coerce :: Fix (Either Int) -> ()\n\n\none :: Int\none = 1\nmain = return ()\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nimport Data.Coerce (Coercible)\n\ninstance Coercible () ()\n\nmain = return ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations, RankNTypes, ScopedTypeVariables #-}\n\nimport Data.Coerce (coerce, Coercible)\n\nnewtype List a = List [a]\ndata T f = T (f Int)\n\nnewtype NT1 a = NT1 (a -> Int)\nnewtype NT2 a = NT2 (a -> Int)\n\nfoo :: T NT1 -> T NT2\nfoo = coerce\n\nmain = return ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! This should fail with a type error: the instance method\n-- !!! has a function type when it should have the type [a].\nmodule ShouldFail where\n\nclass A a where\n op :: a\n\ninstance (A a, A a) => A [a] where\n op [] = []\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nc (x:y) = x\nc z = z\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n(d:e) = [1,'a']\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n(f,g) = (1,2,3)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n(h:i) = (1,'a')\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n(j,k) = case (if True then True else False) of\n         True -> (True,1)\n         False -> (1,True)\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nn x | True = x+1\n    | False = True\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\no = 1:2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\np = [(1::Int)..(2::Integer)]\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nq = \\ (y:z) -> z+2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nz = \\y -> x x where x = y\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nTrue = []\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf [] = 1\nf True = 2\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf x = g+1\n      where g y = h+2\n                  where h z = z z\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\ndata AList a = ANull | ANode a (AList a)\n\ntype IntList = AList Int\n\ng (ANull) = 2\ng (ANode b (ANode c d)) | b = c+1\n                        | otherwise = 4\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\ntype AnnExpr a = (a,Expr a)\n\ndata Expr a = Var [Char]\n              | App (AnnExpr a) (AnnExpr a)\n\ng (Var name) = [name]\ng (App e1 e2) = (g e1)++(g e2)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldFail where\n\nclass C a where\n op1 :: a -> a\n\nclass (C a) => B a where\n op2 :: a -> a -> a\n\ninstance (B a) => B [a] where\n op2 xs ys = xs\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\nmodule ShouldFail where\n\n(a:[]) = 1\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nclass A a where\n p1 :: a -> a\n p2 :: a -> a -> a\n\nclass (A b) => B b where\n p3 :: b\n p4 :: b -> b\n\nclass (A c) => C c where\n p5 :: c -> c\n p6 :: c -> Int\n\nclass (B d,C d) => D d where\n p7 :: d -> d\n\ninstance D [a] where\n p7 l = []\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nclass A a where\n p1 :: a -> a\n p2 :: a -> a -> a\n\nclass (A b) => B b where\n p3 :: b\n\ninstance (A a) => B [a] where\n p3 = []\n\ndata X = XC --, causes stack dump\n\n--instance B Bool where\n-- p3 = True\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Illegally giving methods in a pattern binding (for no v good reason...)\n\nmodule ShouldFail where\n\ndata Foo = MkFoo Int\n\ninstance Eq Foo where\n    ((==), (/=)) = (\\x -> \\y -> True, \\x -> \\y -> False)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! Duplicate instances\n\ndata B = C\n\nclass A a where\n op :: a -> Bool\n\ninstance A B where\n op C = True\n\ninstance A B where\n op C = True\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests for CycleErr in classes\nmodule TcFail where\n\nclass (B a) => A a where\n op1 :: a -> a\n\nclass (A a) => B a where\n op2 :: a -> a -> a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests for ArityErr\nmodule TcFail where\n\ndata A a b = B (A a)\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tests for InstOpErr\nmodule ShouldFail where\n\ndata Foo = Bar | Baz\n\nf x = x > Bar\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! empty file\n\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf x = if 'a' then 1 else 2\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- This test gives the following not-very-wonderful error message.\n\n  \"tc_sig.hs\", line 3: Type signature does not match the inferred type:\n    Signature: t76 -> Int\n    Inferred type: t75\n\nIt *is* an error, because x does not have the polytype\n        forall a. Eq a => a -> Int\nbecause it is monomorphic, but the error message isn't very illuminating.\n-}\n\nmodule ShouldFail where\n\nf x = (x :: (Eq a) => a -> Int)\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- from Jon Hill\nmodule ShouldFail where\n\nbuglet = [ x | (x,y) <- buglet ]\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom: Jon Hill <hilly@dcs.qmw.ac.uk@jess.gla.ac.uk@pp.dcs.glasgow.ac.uk>\nTo: glasgow-haskell-bugs\nSubject: Unfriendly error message\nDate: Thu, 25 Jun 1992 09:22:55 +0100\n\nHello again,\n\nI came across a rather nasty error message when I gave a function an\nincorrect type signature (the context is wrong). I can remember reading \nin the source about this problem - I just thought I'd let you know anyway :-)\n-}\nmodule ShouldFail where\n\n\ntest::(Num a, Eq a) => a -> Bool\ntest x = (x `mod` 3) == 0\n\n{-\ngranite> ndph bug002.ldh\nData Parallel Haskell Compiler, version 0.01 (Glasgow 0.07)\n\n \n\"<unknown>\", line <unknown>: Cannot express dicts in terms of dictionaries available:\ndicts_encl:\n   \"<built-in>\", line : dict.87 :: <Num a>\n   \"<built-in>\", line : dict.88 :: <Eq a>\ndicts_encl':\n   \"<built-in>\", line : dict.87 :: <Num a>\n   \"<built-in>\", line : dict.88 :: <Eq a>\ndicts:\n   \"<built-in>\", line : dict.87 :: <Num a>\n   \"<built-in>\", line : dict.88 :: <Eq a>\nsuper_class_dict: \"<built-in>\", line : dict.80 :: <Integral a>\nFail: Compilation errors found\n\ndph: execution of the Haskell compiler had trouble\n\n-}\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! instances with empty where parts: duplicate\n--\nmodule ShouldFail where\n\ndata NUM = ONE | TWO\ninstance Num NUM\ninstance Num NUM\ninstance Eq NUM\ninstance Show NUM\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances #-}\n\n-- !!! prelude class name in an instance-tycon position\n--\nmodule ShouldFail where\n\ndata NUM = ONE | TWO\ninstance Num NUM\n  where ONE + ONE = TWO\ninstance Num NUM\ninstance Eq Num\n--instance Text Num\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! PreludeCore entities cannot be redefined at the top-level\n--\nmodule ShouldFail where\n\ndata NUM = ONE | TWO\n\nf a b = a + b\nf :: NUM -> NUM -> NUM\n\nONE + ONE = TWO\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! duplicate class-method declarations\n\nmodule ShouldFail where\n\ndata NUM = ONE | TWO\ninstance Eq NUM where\n        a == b = True\n        a /= b = False\n        a == b = False\n        a /= b = True\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! instances of functions\n--\nmodule ShouldFail where\n\ndata NUM = ONE | TWO\n\nclass EQ a where\n        (===) :: a -> a -> Bool\n\nclass ORD a where\n        (<<) :: a -> a -> Bool\n        a << b = True\n\ninstance EQ (a -> b) where\n        f === g = True\n\ninstance ORD (a -> b)\n\nf = (<<) === (<<)\n--f :: (EQ a,Num a) => a -> a -> Bool\n\n\n{-\ninstance EQ NUM where\n--      a /= b = False\n        a === b = True\n--      a /= b = False\n\n-}\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\nmodule ShouldFail where\n\nclass (?imp :: Int) => D t where\n    methodD :: t -> t\n\n-- Don't repeat implicit parameter constraint on the instance\ninstance D Int where\n    methodD x = x + ?imp\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! weird class/instance examples off the haskell list\n--\n\nclass Foo a          where foo :: a -> a\nclass Foo a => Bar a where bar :: a -> a\n\n\ninstance Num a => Foo [a] where\n    foo []     = []\n    foo (x:xs) = map (x+) xs\n\n\ninstance (Eq a, Show a) => Bar [a] where\n    bar []     = []\n    bar (x:xs) = foo xs where u = x==x\n                              v = show x\n\n------------------------------------------\n\n{-\nclass Foo a => Bar2 a where bar2 :: a -> a\n\ninstance (Eq a, Show a) => Foo [a]\n\ninstance Num a => Bar2 [a]\n\ndata X a = X a\n-}\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The translation of this program should assign only one dictionary to\n-- the function search (an Ord dictionary). Instead, it assigns two.\n-- The output produced currently displays this.\n\n-- 10/12/92:  This program is actually erroneous.  The pattern-binding for\n-- search falls under the monomorphism restriction, and there is no\n-- call to search which might fix its type.  So there should be a complaint.\n-- But the actual error message is horrible:\n--\n-- \"bug001.hs\", line 26: Ambiguous overloading:\n--     class \"Ord_\", type \"a\" (at a use of an overloaded identifier: gt)\n--     class \"Eq_\", type \"a\" (at a use of an overloaded identifier: eq)\n\n\nmodule TcFail where\n\nclass Eq_ a where\n eq :: a -> a -> Bool\n\ninstance Eq_ Int where\n eq = eqIntEq\n\ninstance (Eq_ a) => Eq_ [a] where\n eq = \\ xs ys ->\n     if (null xs)\n        then (null ys)\n        else if (null ys)\n                then False\n                else (&&) (eq (hd xs) (hd ys)) (eq (tl xs) (tl ys))\n\nclass (Eq_ a) => Ord_ a where\n gt :: a -> a -> Bool\n\ninstance Ord_ Int where\n gt = ordIntGt\n\nsearch\n = \\ a bs -> if gt (hd bs) a\n                then False\n                else if eq a (hd bs) then True else search a (tl bs)\n\n\nhd :: [a] -> a\nhd (a:as) = a\n\ntl :: [a] -> [a]\ntl (a:as) = as\n\nordIntGt :: Int -> Int -> Bool\nordIntGt 2 3 = True\n\neqIntEq :: Int -> Int -> Bool\neqIntEq  2 3 = True\n\n\n\n\n{-\n\n===============================================\nMain.Eq__INST_PreludeBuiltin.Int =\n    let\n      AbsBinds [] [] [(eq, eq)]\n          {- nonrec -}\n          {-# LINE 2 \"test3.hs\" -}\n\n          eq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool\n          eq = Main.eqIntEq\n    in ({-dict-} [] [eq])\n\nMain.Eq__INST_PreludeBuiltin.List =\n    /\\ t135 ->\n        \\{-dict-} _dict138 ->\n            let\n              {- nonrec -}\n              _dict136 = {-singleDict-} _dict138\n              {- nonrec -}\n              _dict129 = {-singleDict-} _dict136\n              AbsBinds [] [] [(eq, eq)]\n                  {- nonrec -}\n\n                  _dict133 =\n                      Main.Eq__INST_PreludeBuiltin.List\n                          [t135] [{-singleDict-} _dict136]\n                  {- nonrec -}\n                  {-# LINE 5 \"test3.hs\" -}\n\n                  eq :: [t135] -> [t135] -> PreludeCore.Bool\n                  eq = \\ xs ys ->\n\nif (Main.null t135) xs then\n                                      (Main.null t135) ys\n                                  else\n\n                                      if (Main.null t135) ys then\n                                          PreludeCore.False\n                                      else\n\n                                          Main.and\n\n\n                                              ((Main.Eq_.eq t135 _dict129)\n\n\n                                                   ((Main.hd t135) xs)\n                                                   ((Main.hd t135) ys))\n\n\n\n\n\n\n(Main.Eq_.eq [t135] _dict133)\n\n\n\n                                                   ((Main.tl t135) xs)\n                                                   ((Main.tl t135) ys))\n            in ({-dict-} [] [eq])\nMain.Ord__INST_PreludeBuiltin.Int =\n    let\n      {- nonrec -}\n      _dict142 = Main.Eq__INST_PreludeBuiltin.Int [] []\n      AbsBinds [] [] [(gt, gt)]\n          {- nonrec -}\n          {-# LINE 16 \"test3.hs\" -}\n\n          gt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool\n          gt = Main.ordIntGt\n    in ({-dict-} [_dict142] [gt])\n\nMain.Eq_.eq = /\\ a -> \\{-classdict-} [] [eq] -> eq\n\nMain.Ord_.gt = /\\ a -> \\{-classdict-} [_dict56] [gt] -> gt\n\nMain.Ord__TO_Main.Eq_ = /\\ a -> \\{-classdict-} [_dict58] [gt] -> ???_dict58???\n\nAbsBinds [t60] [] [(hd, Main.hd)]\n    {- nonrec -}\n\n\n\n    hd :: [t60] -> t60\n    hd (a PreludeBuiltin.: as)\n               = a\n\nAbsBinds [t68] [] [(tl, Main.tl)]\n    {- nonrec -}\n\n\n\n\n    tl :: [t68] -> [t68]\n    tl (a PreludeBuiltin.: as)\n               = as\n\n\nAbsBinds [t91] [_dict85, _dict88] [(search, Main.search)]\n    {- rec -}\n    {-# LINE 19 \"test3.hs\" -}\n\n\n    search :: t91 -> [t91] -> PreludeCore.Bool\n    search\n        = \\ a bs ->\n\n\nif (Main.Ord_.gt t91 _dict85) ((Main.hd t91) bs) a then\n                        PreludeCore.False\n                    else\n\n                        if (Main.Eq_.eq t91 _dict88) a ((Main.hd t91) bs) then\n                            PreludeCore.True\n                        else\n\n                            search a ((Main.tl t91) bs)\nAbsBinds [] [] [(and, Main.and)]\n    {- nonrec -}\n    and :: PreludeCore.Bool -> PreludeCore.Bool -> PreludeCore.Bool\n    and PreludeCore.True PreludeCore.True\n                = PreludeCore.True\nAbsBinds [] [] [(ordIntGt, Main.ordIntGt)]\n    {- nonrec -}\n    _dict97 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n    _dict98 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n    _dict100 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n    _dict101 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n\n\n\n    ordIntGt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool\n    ordIntGt\n        2 3 = PreludeCore.True\nAbsBinds [] [] [(eqIntEq, Main.eqIntEq)]\n    {- nonrec -}\n    _dict105 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n    _dict106 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n    _dict108 = PreludeCore.Num_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n    _dict109 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] []\n    {- nonrec -}\n\n    eqIntEq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool\n    eqIntEq\n        2 3 = PreludeCore.True\n\n\nAbsBinds [t112] [] [(null, Main.null)]\n    {- nonrec -}\n\n    null :: [t112] -> PreludeCore.Bool\n    null [] = PreludeCore.True\n-}\n", "num_lines": 220}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! tcfail044: duplicated type variable in instance decls\n--\nmodule ShouldFail where\n\ninstance (Eq a) => Eq (a->a)\ninstance Show (a->b)\n\ninstance (Num a) => Num (a->a) where\n    f + g    = \\x -> f x + g x\n    negate f = \\x -> - (f x)\n    f * g    = \\x -> f x * g x\n    fromInteger n = \\x -> fromInteger n\n\nss :: Float -> Float\ncc :: Float -> Float\ntt :: Float -> Float\n\nss = sin * sin\ncc = cos * cos\ntt = ss + cc\n\n--main = putStr ((show (tt 0.4))++ \"  \"++(show (tt 1.652)))\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! function types in deriving Eq things\n-- From a bug report by Dave Harrison <D.A.Harrison@newcastle.ac.uk>\n\nmodule ShouldFail where\n\n\ntype    Process a = Pid -> Time -> Message a -> ( MessList a,\n                                                  Continuation a)\n\ndata    Continuation a = Do (Process a) deriving Eq\n\n\ntype    ProcList a = [ (Pid, Status, Process a) ]\ndata    Status     = Active | Passive | Busy Integer | Terminated\n                     deriving Eq\n\n\ndata Message a = Create (Process a) | Created Pid   | Activate Pid  |\n                 Passivate Pid      | Terminate Pid | Wait Pid Time |\n                 Query Pid a        | Data Pid a    | Event         |\n                 Output Pid String\n               deriving Eq\n\ntype    MessList a = [ Message a ]\n\ntype    Pid  = Integer\ntype    Time = Integer\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nclass A a where\n op1 :: a -> a\n\ninstance A (a,(b,c)) where\n op1 a = a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nclass (B a) => C a where\n op1 :: a -> a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf x = g x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf x = B x\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\ninstance B Bool where\n op1 a = a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\ndata C a = B a c\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TcFail where\n\ndata B = C A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf (B a) = True\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nf x = (x + 1 :: Int) :: Float\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\ndata Foo = MkFoo Bool\n\ninstance Eq Foo where\n    (MkFoo x) == (MkFoo y) = x == y\n\ninstance Eq Foo where\n    -- forgot to type \"Ord\" above\n    (MkFoo x) <= (MkFoo y) = x <= y\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! inadvertently using -> instead of =>\n\nf :: (RealFrac a) -> a -> a\nf x = x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\nimport Data.Array\n\n-- !!! inadvertently using => instead of ->\n\nf :: (Array a) => a -> b\nf x = x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! signature bugs exposed by Sigbjorn Finne\n--\nmodule ShouldFail where\n\ntype Flarp a = (b,b)\n\n--More fun can be had if we change the signature slightly\n\ntype Bob a = a\n\ntype Flarp2 a = Bob (b,b)\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! bug report from Satnam\n--\nmodule ShouldFail\nwhere\n\ntype Module = (String,[Declaration])\n\ndata Declaration\n  = Architecture String StructuralExpression |\n    Behaviour String Parameter Parameter BehaviouralExpression\n    deriving (Eq, Show)\n\ndata Parameter = ParameterVariable String | ParameterList [Parameter]\n                 deriving (Eq, Show)\n\nnameOfModule :: Module -> String\nnameOfModule (name, _) = name\n\ndata StructuralExpression \n  = Variable String |\n    Serial StructuralExpression StructuralExpression | \n    Par [StructuralExpression] \n    deriving (Eq, Show)\n\ndata BehaviouralExpression\n  = BehaviouralVariable String \n    | AndExpr BehaviouralExpression BehaviouralExpression\n    | OrExpr BehaviouralExpression BehaviouralExpression\n    | NotExpr BehaviouralExpression\n    deriving (Eq, Show)\n\n\ntype BehaviouralRelation\n  = (behaviouralExpression, behaviouralExpression)\n---- ^ typo ----------------^ typo (but so what?)\n\ntype BehaviouralRelationList = [BehaviouralRelation]\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! no type variable on a context\n-- !!! reported by Sigbjorn Finne\n\nmodule ShouldFail where\n\nmoby :: Num => Int -> a -> Int\nmoby x y = x+y\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\n\n------- Forwarded Message\n\nDate:    Wed, 30 Nov 1994 16:34:18 +0100\nFrom:    John Hughes <rjmh@cs.chalmers.se>\nTo:      augustss@cs.chalmers.se, simonpj@dcs.gla.ac.uk\nSubject: Nice little program\n\n\nLennart, Simon,\n\nYou might like to look at the fun little program below.\n\nTHUMBS DOWN to hbc for compiling it (it prints [72, 101, 108, 108, 111])\nTHUMBS UP to ghc for rejecting it --- but what an error message!\nnhc and gofer both reject it with the right error message.\nI haven't tried Yale Haskell.\n\nEnjoy!\n- ----------------------------\n-}\n\nclass HasX a where\n  setX :: x->a->a\n\ndata X x = X x\ninstance HasX (X x) where\n  setX x (X _) = X x\n\nchangetype x = case setX x (X (error \"change type!\")) of X y->y\n\nmain = print (changetype \"Hello\" :: [Int])\n\n{-\n------- End of Forwarded Message\n-}\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\nmodule ShouldFail where\n\ninfixr 1 `rangeOf`\n\ndata Ord a => SubRange a = SubRange (a, a) a\n\ntype IntSubRange = SubRange Int \n\n\nsubRangeValue :: SubRange a -> a\nsubRangeValue (SubRange (lower, upper) value) = value\n\nsubRange :: SubRange a -> (a, a)\nsubRange (SubRange r value) = r\n\nnewRange :: (Ord a, Show a) => (a, a) -> a -> SubRange a\nnewRange r value = checkRange (SubRange r value)\n\n\ncheckRange :: (Ord a, Show a) => SubRange a -> SubRange a\ncheckRange (SubRange (lower, upper) value)\n  = if (value < lower) || (value > upper) then\n      error (\"### sub range error. range = \" ++ show lower ++ \n              \"..\" ++ show upper ++ \" value = \" ++ show value ++ \"\\n\")\n    else\n      SubRange (lower, upper) value\n\n\ninstance Eq a => Eq (SubRange a) where\n  (==) a b = subRangeValue a == subRangeValue  b\n\ninstance (Ord a) => Ord (SubRange a) where\n  (<)  = relOp (<)\n  (<=) = relOp (<=)\n  (>=) = relOp (>=)\n  (>)  = relOp (>)\n\nrelOp :: Ord a => (a->a->Bool) -> SubRange a -> SubRange a -> Bool\nrelOp op a b = (subRangeValue a) `op` (subRangeValue b)\n\nrangeOf :: (Ord a, Show a) => SubRange a -> SubRange a -> SubRange a\nrangeOf a b = checkRange (SubRange (subRange b) (subRangeValue a))\n\nshowRange :: Show a => SubRange a -> String\nshowRange (SubRange (lower, upper) value)\n  = show value ++ \" :\" ++ show lower ++ \"..\" ++ show upper\n\nshowRangePair :: (Show a, Show b) => (SubRange a, SubRange b) -> String\nshowRangePair (a, b)\n  = \"(\" ++ showRange a ++ \", \" ++ showRange b ++ \")\"\n\nshowRangeTriple :: (Show a, Show b, Show c) =>\n                   (SubRange a, SubRange b, SubRange c) -> String\nshowRangeTriple (a, b, c) \n  = \"(\" ++ showRange a ++ \", \" ++ showRange b ++ \", \" ++ showRange c ++ \")\"\n\n\n\ninstance Num a => Num (SubRange a) where\n  negate = numSubRangeNegate\n  (+) = numSubRangeAdd\n  (-) = numSubRangeSubtract\n  (*) = numSubRangeMultiply\n  fromInteger a = SubRange (fromInteger a, fromInteger a) (fromInteger a)\n\nnumSubRangeNegate :: (Ord a, Show a, Num a) => SubRange a -> SubRange a\nnumSubRangeNegate (SubRange (lower, upper) value)\n  = checkRange (SubRange (lower, upper) (-value))\n\nnumSubRangeBinOp :: Num a => (a -> a -> a) -> \n                    SubRange a -> SubRange a -> SubRange a\nnumSubRangeBinOp op a b\n  = SubRange (result, result) result\n    where\n    result = (subRangeValue a) `op` (subRangeValue b)\n\n-- partain:\nnumSubRangeAdd, numSubRangeSubtract, numSubRangeMultiply :: Num a => SubRange a -> SubRange a -> SubRange a\n\nnumSubRangeAdd = numSubRangeBinOp (+)\nnumSubRangeSubtract = numSubRangeBinOp (-)\nnumSubRangeMultiply = numSubRangeBinOp (*)\n\nunsignedBits :: Int -> (Int, Int)\nunsignedBits n = (0, 2^n-1)\n\nsignedBits :: Int -> (Int, Int)\nsignedBits n = (-2^(n-1), 2^(n-1)-1)   \n\n\nsi_n :: Int -> Int -> IntSubRange\nsi_n bits value = SubRange (signedBits bits) value\n\nsi8, si10, si16 :: Int -> IntSubRange\nsi8  = si_n 8\nsi10 = si_n 10\nsi16 = si_n 16\n", "num_lines": 99}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Make sure that state threads don't escape\n-- !! (example from Neil Ashton at York)\n--\nmodule ShouldFail where\n\nimport GHC.Arr\nimport Control.Monad.ST ( runST )\n\ntype IndTree s t = STArray s (Int,Int) t\n\nitgen :: Constructed a => (Int,Int) -> a -> IndTree s a\nitgen n x =\n        runST (\n        newSTArray ((1,1),n) x)\n\nitiap :: Constructed a => (Int,Int) -> (a->a) -> IndTree s a -> IndTree s a\nitiap i f arr =\n        runST (\n        readSTArray arr i >>= \\val ->\n        writeSTArray arr i (f val) >>\n        return arr)\n\nitrap :: Constructed a => ((Int,Int),(Int,Int)) -> (a->a) -> IndTree s a -> IndTree s a\nitrap ((i,k),(j,l)) f arr = runST (itrap' i k)\n        where\n        itrap' i k = if k > l then return arr\n                     else (itrapsnd i k >>\n                        itrap' i (k+1))\n        itrapsnd i k = if i > j then return arr\n                     else (readSTArray arr (i,k) >>= \\val ->\n                        writeSTArray arr (i,k) (f val) >>\n                        itrapsnd (i+1) k)\n\nitrapstate :: Constructed b => ((Int,Int),(Int,Int)) -> (a->b->(a,b)) -> ((Int,Int)->c->a) ->\n                (a->c) -> c -> IndTree s b -> (c, IndTree s b)\nitrapstate ((i,k),(j,l)) f c d s arr = runST(itrapstate' i k s)\n        where\n        itrapstate' i k s = if k > l then return (s,arr)\n                            else (itrapstatesnd i k s >>= \\(s,arr) ->\n                                itrapstate' i (k+1) s)\n        itrapstatesnd i k s = if i > j then return (s,arr)\n                            else (readSTArray arr (i,k) >>= \\val ->\n                               let (newstate, newval) = f (c (i,k) s) val\n                               in writeSTArray arr (i,k) newval >>\n                               itrapstatesnd (i+1) k (d newstate))\n\n-- stuff from Auxiliary: copied here (partain)\n\nsap :: (a->b) -> (c,a) -> (c,b)\nsap f (x,y) = (x, f y)\n\nfap :: (a->b) -> (a,c) -> (b,c)\nfap f (x,y) = (f x, y)\n\nnonempty :: [a] -> Bool\nnonempty []    = False\nnonempty (_:_) = True\n\n-- const :: a -> b -> a\n-- const k x = k\n\n-- id :: a -> a\n-- id x = x\n\ncompose :: [a->a] -> a -> a\ncompose = foldr (.) id\n\nclass Constructed a where\n   normal :: a -> Bool\n\ninstance Constructed Bool where\n   normal True = True\n   normal False = True\n\ninstance Constructed Int where\n   normal 0 = True\n   normal n = True\n\ninstance (Constructed a, Constructed b) => Constructed (a,b) where\n   normal (x,y) = normal x && normal y\n\n-- pair :: (Constructed a, Constructed b) => a -> b -> (a,b)\n-- pair x y | normal x && normal y = (x,y)\n\ninstance Constructed (Maybe a) where\n   normal Nothing = True\n   normal (Just _) = True\n\njust :: Constructed a => a -> Maybe a\njust x | normal x = Just x\n", "num_lines": 91}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom: Marc van Dongen <dongen@cs.ucc.ie>\nDate: Wed, 9 Apr 1997 14:06:39 +0100 (BST)\n\nI just wanted to report that the erroneous and tiny\nprogram added below can not be compiled within 6MB of\nheap (Admitted it can be compiled with a bigger heap).\nIt was part of a bigger program that could not be\ncompiled within 20MB of heap.\n\n[GHC 2.03 and earlier.]  Turned out to be a bug in the\nerror recovery mechanism.\n\n-}\n\nmodule ShouldFail where\n\ntoo_much :: [Int] -> [(Int,Int)] -> [(Int,[Int])] -> Bool\ntoo_much ds ((k,m):q1) s0\n  = case (list1,list2) of\n      []  -> error \"foo\" -- too_much ds q2m  s2m\n  where list1 = ds\n        list2 = ds\n        {-\n        list1 = [k' | k' <- ds, k == k']\n        list2 = [k' | k' <- ds, m == k']\n        s1   = aas s0 k\n        raM  = []\n        raKM = listUnion (\\a b -> a) [] []\n        s1k  = s1\n        q1k  = raM\n        s2k  = s1\n        q2k  = raM\n        s2m  = s1\n        q2m  = raM\n        s2km = foldr (flip aas) s1 raKM\n        q2km = raKM\n        -}\n\nlistUnion :: (v -> v -> Bool) -> [v] -> [v] -> [v]\nlistUnion _  _ _\n  = []\n\naas :: (a,b) -> a -> (a,b)\naas s _\n  = s\n\n\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-\nFrom: Wolfgang Drotschmann <drotschm@athene.informatik.uni-bonn.de>\nResent-Date:  Thu, 15 May 1997 17:23:09 +0100\n\nI'm still using the old ghc-2.01. In one program I ran into a problem\nI couldn't fix. But I played around with it, I found a small little\nscript which reproduces it very well:\n\npanic! (the `impossible' happened):\n        tlist\n-}\n\nmodule TcFail where\n\ntype State = ([Int] Bool)\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n\n-- !!! Mis-matched contexts in a mutually recursive group\n\n{-  # LANGUAGE NoRelaxedPolyRec #-}\n-- With the new type checker you can't turn off RelaxedPolyRec\n-- so this test always succeeds\n\nmodule ShouldFail where\n\nf :: (Ord d) => d -> d\nf c = g c\n\ng :: e -> e\ng c = c\n  where p = f (1 :: Int)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- This program crashed GHC 2.03\n\n   From: Marc van Dongen <dongen@cs.ucc.ie>\n   Date: Sat, 31 May 1997 14:35:40 +0100 (BST)\n\n  zonkIdOcc: g_aoQ\n\n  panic! (the `impossible' happened):\n          lookupBindC:no info!\n  for: g_aoQ\n  (probably: data dependencies broken by an optimisation pass)\n  static binds for:\n  Tmp.$d1{-rmM,x-}\n  local binds for:\n-}\n\nmodule ShouldFail where\n\ndata AB p q = A\n            | B p q\n\ng :: (Ord p,Ord q) => (AB p q) -> Bool\ng (B _ _) = g A\n\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- what error do you get if you redefined Prelude instances?\n\nmodule ShouldFail where\n\nf :: (Eq a) => (a,a) -> (a,a) -> Bool\nf x y = x == y\n\ninstance Eq a => Eq (a,b) where\n    (m,n) == (o,p) = m == o\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- !!! Test top-level unboxed types\n\nmodule ShouldFail where\n\nimport GHC.Base\nimport GHC.Prim\n\nx = 1#\n\ny :: Int#\ny = x +# 1#\n\nmain =  let\n          z = x -# y\n        in\n        if isTrue# (z ># 3#) then putStrLn \"Yes\"\n                             else putStrLn \"No\"\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n{-\n        From: Ralf Hinze <ralf@uran.informatik.uni-bonn.de>\n        Date: Fri, 15 Aug 1997 15:20:51 +0200 (MET DST)\n\nI *suppose* that there is a bug in GHC's type checker. The following\nprogram, which I think is ill-typed, passes silently the type checker.\nNeedless to say that it uses some of GHC's arcane type extensions.\n-}\n\nmodule ShouldFail where\n\ndata ContT m a          =  KContT (forall res. (a -> m res) -> m res)\nunKContT (KContT x)     =  x\n\ncallcc                  :: ((a -> ContT m b) -> ContT m a) -> ContT m a\ncallcc f                =  KContT (\\cont -> unKContT (f (\\a -> KContT (\\cont' -> cont a))) cont)\n\n{-\n`ContT' is a continuation monad transformer. Note that we locally\nqualify over the result type `res' (sometimes called answer or\noutput).  IMHO this make it impossible to define control constructs\nlike `callcc'. Let's have a closer look: the code of `callcc' contains\nthe subexpression `KContT (\\cont' -> cont a)'. To be well-typed the\nargument of `KContT' must have the type `(All res) => (a -> m res) -> m\nres'. Quantification is not possible, however, since the type variable\nin `cont's type cannot be forall'd, since it also appears at an outer\nlevel.  Right? Or wrong?\n-}\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! declaring a default method in a class that doesn't have that method.\n\nclass Foo a where\n  op :: a -> a\n\n  op2 x = x     -- Bogus declaration\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! Using a type constructor as a class name\n\nf :: Integer i => i \nf =               0    \n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule ShouldFail where\n\n-- !!! unboxed field in newtype declaration\n\nimport GHC.Exts ( Int# )\n\nnewtype Unboxed = Unboxed Int#\n\nf = [ Unboxed 1#, Unboxed 2# ] -- shouldn't be allowed!\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\n-- !!! Multi-param type classes test: ambiguity bug\n\n-- GHC actually accepts this program because\n--      q :: Collection c a => a -> Bool\n-- and there is no a priori reason to suppose that\n-- q would be ambiguous in every context. For example,\n-- it could be fine if we had\n--      instance c Int where ...\n-- Of course, it'd be hard to fill in the \"...\" in this particular\n-- case, but that relies on observations about the form of the types\n-- of the class methods, surely beyond what a compiler should do.\n--\n-- Still, the type is ambiguous because there's nothing to fix 'c'\n\n\nmodule ShouldFail where\n\nclass Collection c a where\n    empty :: c a\n    add :: a -> c a -> c a\n    isempty :: c a -> Bool\n\nsingleton x = add x empty\n\nq x = isempty (singleton x)\n\n\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\nimport Data82\nimport Inst82_1\nimport Inst82_2\n\ndata Baz = Baz deriving Read\n\nmain     = print ((read \"FooData\")::FooData)\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\ndata Bar = Bar { flag :: Bool } deriving( Show )\n\ndata State = State { bar :: Bar, baz :: Float }\n\ndisplay :: State -> IO ()\ndisplay (State{ bar = Bar { flag = f, baz = b }}) = print (f,b)\n\n-- Typo! The line above should better be:\n-- display (State{ bar = Bar { flag = f }, baz = b }) = print (f,b)\n\n-- GHC 4.04 (as released) crashed with\n--      panic! (the `impossible' happened): tcLookupValue: b{-r4n-}\n-- Bug reported by Sven Panne\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check that using a label belonging to another constructor\n-- !!! is flagged as being incorrect.\nmodule ShouldFail where\n\ndata F\n = F { x :: Int }\n | G { y :: Int }\n\nz :: F\nz = F { y = 2 }\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Check that not supplying bindings for strict fields\n-- !!! is flagged as being incorrect.\nmodule ShouldFail where\n\ndata F\n = F { x :: Int, y :: !Int }\n\nz :: F\nz = F { x = 2 }\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- !!! Check that we can't derive instances of existential types\nmodule ShouldFail where\n\ndata Ex = forall a. Ex [a] deriving( Eq )\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, FlexibleInstances #-}\n\n-- !!! Check that forall types can't be arguments\nmodule ShouldFail where\n\n\ndata T s a = MkT s a\n \ninstance Ord a => Ord (forall s. T s a) \n-- A for-all should not appear as an argument to Ord\n\n\n\ng :: T s (forall b.b)\ng = error \"urk\"\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n-- !!! Check non-constructors in patterns fail tidily\n-- !!! The -O made ghc 4.08 go into a loop!\n-- Unfortunately the -O has to go in the Makefile\n\nmodule ShouldFail where\n\ncompute :: String -> String\ncompute (\"hd\" ++ _) = \"_\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule ShouldFail where\n\nimport GHC.Base\n\nmy_undefined :: a  -- This one has kind *, not OpenKind\nmy_undefined = undefined\n\ndie :: Int -> ByteArray#\ndie _ = my_undefined\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ParallelListComp #-}\n\n-- !!! Illegal conflicting parallel bindings\n\nmodule ShouldFail where\n\nxys = [ () | let a = 13 | let a = 17 ]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, UndecidableInstances, FlexibleContexts #-}\n-- UndecidableInstances now needed because the Coverage Condition fails\n\nmodule ShouldFail where\n\n-- A stripped down functional-dependency\n-- example that causes GHC 4.08.1 to crash with:\n-- \"basicTypes/Var.lhs:194: Non-exhaustive patterns in function readMutTyVar\"\n-- Reported by Thomas Hallgren Nov 00\n\n-- July 07: I'm changing this from \"should fail\" to \"should succeed\"\n-- See Note [Important subtlety in oclose] in FunDeps\n\n\nprimDup :: Int -> IO Int\nprimDup = undefined\n\ndup () = call primDup\n\n--      call :: Call c h => c -> h\n--\n--      call primDup :: {Call (Int -> IO Int) h} => h  with\n--  Using the instance decl gives\n--      call primDup :: {Call (IO Int) h'} => Int -> h'\n--  The functional dependency means that h must be constant\n--  Hence program is rejected because it can't find an instance\n--  for {Call (IO Int) h'}\n\nclass Call    c h | c -> h where\n    call  :: c -> h\n\ninstance Call c h => Call (Int->c) (Int->h) where\n    call f = call . f\n\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\nmodule ShouldFail where\n\n-- This nonsense tickled a missing-kind-check error in ghc5.00.2\n\ntype A = Int 1\n\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- !!! Test top-level unboxed types\n\nmodule ShouldFail where\n\nimport GHC.Base\n\nx = 1#\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances #-}\nmodule ShouldFail where\n\nclass Foo f a r | f a -> r where\n      foo::f->a->r\n\n-- These instances are incompatible because we can unify\n-- the first two parameters, though it's rather obscure:\n--      p -> (a,b)\n--      t -> (,) (a,a)\n--      c -> (,) a\n--      r -> s\n--\n-- So a constraint which would sow this up is\n--      Foo ((Int,Int)->Int)\n--          ((Int,Int), (Int,Int))\n--          t\n-- This matches both.  Not easy to spot, and the error\n-- message would be improved by giving the unifier, or\n-- a witness.\n\ninstance Foo (p->s)     (t p)    (t s)\ninstance Foo ((a,b)->r) (c a,c b)(c r)\n\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! Ambiguous constraint in type signature\n\nf :: Eq a => Int -> Int\nf x = x\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule ShouldFail where\n\n-- The constraint in the context of an instance declaration\n-- is ambiguous, but we have UndecidableInstances on, so\n-- it could conceivably be ok (we'd need OverlappingInstances\n-- too in this case).  So we allow it.\n-- See Note [The ambiguity check for type signatures] in TcMType\n\nclass Bar a\ninstance Bar a => Bar Bool\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- This bogus program slipped past GHC 5.02!\n\nmodule ShouldFail where\n\ndata DS = forall a. C (a -> Int)\n\ncall (C f) arg = f arg\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one broke GHC 5.02, because of the unsaturated\n-- uses of type synonyms, which are nevertheless kind-correct.\n\nmodule ShouldCompile where\n\ntype A i = i\ntype B = A\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one broke GHC 5.02, because of the unsaturated\n-- uses of type synonyms, which are nevertheless kind-correct.\n\nmodule ShouldCompile where\n\ntype A i = i\ndata T k = MkT (k Int)\n\nf :: T A        -- BAD!\nf = error \"foo\"\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\nmodule ShouldFail where\n\nimport Data.Ratio\n\ndata Integral a => P a = P { p :: a }\n\nf :: Integral a => P (Ratio a) -> P (Ratio a)\nf x = x { p = p x }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\nmodule ShouldCompile where\nimport GHC.ST\nimport GHC.STRef\nimport GHC.Arr\n\n-- Another 'escape' example\n\nf:: ST t Int\nf = do\n    v <- newSTRef 5\n    let g :: ST s Int\n        -- Implicitly forall s. ST s Int\n        g = readSTRef v\n    g\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- Test the handling of conditionals in rank-n stuff\n-- Should fail, regardless of branch ordering\n\nmodule ShouldFail where\n\n-- These two are ok\nf1 = (\\ (x :: forall a. a->a) -> x)\nf2 = (\\ (x :: forall a. a->a) -> x) id 'c'\n\n-- These fail\nf3 v = (if v then\n          (\\ (x :: forall a. a->a) -> x)\n        else\n          (\\ x -> x)\n      ) id 'c'\n\nf4 v = (if v then\n          (\\ x -> x)\n        else\n          (\\ (x :: forall a. a->a) -> x)\n       ) id 'c'\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- Existential context should quantify over some new type variables\n--\n-- Jan07: this is now fine, because we've lifted the restrction\n--        that the context on a constructor should mention\n--        existential type variables\n\nmodule ShouldFail where\n\ndata S m t a = Ok a | Cont (M m t a)\ndata M m t a = Monad m => M { unM::(m (S m t a))}\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one risked building a recursive dictionary rather than\n-- failing, in GHC before 5.03.   Actually, 5.02 managed it ok,\n-- but I think more by luck than good judgement.\n\nmodule ShouldFail where\n\nclass S a\nclass S a => C a where { opc :: a -> a }\nclass S b => D b where { opd :: b -> b }\n\ninstance C Int where\n   opc = opd\n\ninstance D Int where\n   opd = opc\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The type sig for 'test' is illegal in H98 because of the\n-- partial application of the type sig.\n-- But with the LiberalTypeSynonyms extension enabled it\n-- should be OK because when you expand the type synonyms\n-- it's just Int->Int\n-- c.f should_compile/tc155.hs\nmodule ShouldFail where\n\ntype Thing m = m ()\n\ntype Const a b = a\n\ntest :: Thing (Const Int) -> Thing (Const Int)\ntest = test\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- The instance decl is illegal without UndecidableInstances\n\nmodule ShouldFail where\n\ndata Rec f = In (f (Rec f))\n\ninstance Eq (f (Rec f)) => Eq (Rec f) where\n         (In x) == (In y) = x == y\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- Strangely, this program does not elicit an error message\n-- in GHC 5.03.  I don't know why. It fails correctly in\n-- 5.04\n\n\nmodule ShouldFail where\n\nclass Eq ce => Collects e ce | ce -> e where\n    empty :: ce\n    empty = error(\"empty\")\n\ndata Stupid = Stupid -- without equality\n\ninstance Collects Bool Stupid where\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldCompile where\n\ndata Foo a b = Foo { foo :: a -> b }\n\n-- kind error in here\nbar :: String -> (forall a . Foo a) -> IO ()\nbar s _ = putStrLn s\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Record construction should fail statically\n-- if there are any strict fields,\n-- including in the non-record case.\n\nmodule ShouldFail where\n\ndata S = S { x::Int, y:: ! Int }\ndata T = T Int !Int\ndata U = U Int  Int\n\ns1 = S {}       -- Bad\ns2 = S { x=3 }  -- Bad\ns3 = S { y=3 }  -- Ok\nt  = T {}       -- Bad\nu  = U {}       -- Ok\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests kind error messages\n\n-- GHC 6.6 stops on the first kind error it encounters,\n-- so we only get one error report here.  I'll leave \n-- the other tests in here, though, in case matters improve\n-- again\n\nmodule ShouldFail where\n\ndata T k = T (k Int)\n\nf :: [Maybe]\nf x = x\n\ng :: T Int\ng x = x\n\nh :: Int Int\nh x = x\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Killed GHC 5.04.2\n\nmodule ShouldFail where\n\nclass Foo a where\n  foo :: a -> ()\n\ndata Bar = Bar { bar :: () }\n\ntest :: Bar\ntest = undefined { foo = () }\n        -- The point is that foo is a class method,\n        -- but not a record selector\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- in Haskell 98, methods must mention the class variable\n-- (SourceForge bug #756454).\nclass Foo a where\n    bug :: ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- Without any extensions enabled both of these should fail\n\nnewtype N1 = N1 Int deriving ( Enum )\ndata    N2 = N2 Int deriving ( Enum )\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Gave a bad error message in a version of 6.3, as a\n-- result of 6.3's new duplicate-instance reporting structure\n--\n--      Foo.hs:4:5:\n--          No instance for `Eq Foo'\n--          When deriving the `Eq' instance for type `Bar'\n\nmodule ShouldFail where\n\ndata Bar = Bar Foo deriving Eq\ndata Foo = Foo deriving Eq\n\ninstance Eq Foo where\n    Foo == Foo = True\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Gave a nasty\n--      tcLookupGlobal: `FunnyError.$dmb' is not in scope\n-- failure in GHC 6.2, because the type-checking of\n-- the default method didn't recover.\n\nmodule ShouldFail where\n\nclass A x where\n   a :: x -> ()\n   b :: x -> Bool -> ()\n   b x \"Foo\" = () -- deliberate type error\n\ninstance A Int where\n   a _ = ()\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule ShouldFail where\n\nclass Foo a where\n  op :: a -> a\n\ninstance {-# OVERLAPPABLE #-} Foo a => Foo [a] \ninstance {-# OVERLAPPING #-} Foo [Int]\n\nfoo :: Foo a => [a] -> [a]\nfoo x = op x\n-- Correct instance depends on instantiation of 'a' \n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, KindSignatures #-}\n\nmodule ShouldFail where\n\n-- There should be a kind error, when unifying (a b) against (c d)\n\nfoo = [ undefined :: forall a b. a b,\n        undefined :: forall (c:: (* -> *) -> *) (d :: * -> *). c d ]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule ShouldFail where\n\n-- The danger here is getting a type like\n--      f :: forall (a::??). a -> Bool\n-- and hence allowing the bogus calls that follow\n\nf x = True\n\nh v = f 3#\n-- h v = (f 3#, f 4.3#, f True)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldFail where\n\n-- With the new typechecker (GHC 7.1), these now all pass\n\nf1 :: (forall a. Eq a => [a]) -> Bool\nf1 xs@(x:_)  = x\n\nf2 :: (forall a. Eq a => [a]) -> Bool\nf2 [x] = x\n\nf3 :: (forall a. Eq a => [a]) -> Bool\nf3 (x:[]) = x\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts, ExistentialQuantification #-}\n\n-- Tests the \"stupid theta\" in pattern-matching\n-- when there's an existential as well\n\nmodule ShouldCompile  where\n\ndata (Show a) => Obs a = forall b. LiftObs a b\n\nf :: Obs a -> String    -- Needs a (Show a) context\nf (LiftObs _ _) = \"yes\"\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE RankNTypes, ExistentialQuantification #-}\n\n-- An interesting interaction of universals and existentials, prompted by\n-- http://www.haskell.org/pipermail/haskell-cafe/2004-October/007160.html\n--\n-- Note the nested pattern-match in runProg; tc183 checks the\n-- non-nested version\n\n-- 3 Sept 2010: with the new typechecker, this one succeeds\n\nmodule Foo  where\n\nimport Control.Monad.Trans\n\ndata Bar m\n  = forall t. (MonadTrans t, Monad (t m))\n           => Bar (t m () -> m ()) (t m Int)\n\ndata Foo = Foo (forall m. Monad m => Bar m)\n\nrunProg :: Foo -> IO ()\nrunProg (Foo (Bar run op)) = run (prog op)\n-- This nested match \"ought\" to work; because\n--    runProg (Foo b) = case b of\n--                          Bar run op -> run (prog op)\n-- does work. But the interactions with GADTs and\n-- desugaring defeated me, and I removed (in GHC 6.4) the ability\n-- to instantiate functions on the left\n\nprog :: (MonadTrans t, Monad (t IO)) => a -> t IO ()\nprog x = error \"urk\"\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\nfoo :: IO (Num a => a -> a)\nfoo = error \"urk\"\n\n-- baz :: (Num a => a -> a) -> Int\n-- baz = error \"urk\"\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n-- Ambiguity error reporting\n\nmodule Main where\n\nimport Data.Array.MArray (thaw,freeze)\nimport Data.Array.Unboxed as UA (UArray,listArray)\nimport Data.Array.IArray as IA (Array,listArray)\n\nmain :: IO ()\nmain = do let sL = [1,4,6,3,2,5]\n              dim = length sL\n              help :: [FlatVector]\n              help = [listFlatVector (1,s) [0|i<-[1..s]]|s<-sL]\n              tmp :: Vector FlatVector\n              tmp = listVector (1,dim) help\n          v <- thaw tmp\n          return ()\n\ntype FlatVector  = UArray Int Double\n\nlistFlatVector :: (Int,Int) -> [Double] -> FlatVector\nlistFlatVector = UA.listArray\n\ntype Vector a = Array Int a\n\nlistVector :: (Int,Int) -> [a] -> Vector a\nlistVector = IA.listArray\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Both blocks are illegal Haskell 98, because of the un-saturated\n-- type synonym, but (rather obscurely) at one point (GHC 6.3), we\n-- acceped 'blah', but rejected 'blah1'\n\nmodule ShouldFail where\n\ndata T = T\n\n-- This was erroneously accepted\ntype Foo a = String -> Maybe a\ntype Bar m = m Int\nblah = undefined :: Bar Foo\n\n\ntype Foo1 a = Maybe a\ntype Bar1 m = m Int\nblah1 = undefined :: Bar1 Foo1\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- The defn of foo should be rejected; it's monomorphic, but\n-- the implicit parameter escapes\n\nmodule Foo where\n\nbaz = let ?x = 5 in print foo\n\nfoo = woggle 3\n\nwoggle :: (?x :: Int) => Int -> Int\nwoggle y = ?x + y\n\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Error message in monomorphic case\n\nmodule ShouldFail where\n\n  f = (*)       -- Monomorphic\n  g :: Num b => b -> b\n  g x = f x x\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Fails with a kind error.\n-- The current error message was rather horrible (trac bug #312):\n--\n--    Kind error: Expecting kind `k_a1JA -> k_a1JE -> k_a1JI -> *',\n--                but `DUnit t' has kind `k_a1JA -> k_a1JE -> *'\n--\n-- as we couldn't tidy kinds, because they didn't have OccNames.\n-- This test recalls the bad error message.\n\nmodule ShouldFail where\n\nnewtype Object f' f t o1 o2  = Object (f' t o1 -> f t o2)\ntype DUnit t o1 o2       = ()\n\ntype T f g t o1 o2  = Either (f t o1 o2) (g t o1 o2)\n\ntype LiftObject t f' f         = T (Object f' f t) (DUnit t)\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, FlexibleInstances, TypeOperators,\n             MultiParamTypeClasses, FunctionalDependencies, DatatypeContexts #-}\n\n-- This one crashed GHC 6.3 due to an error in TcSimplify.add_ors\n\nmodule Foo where\n\ndata Zero   = Zero deriving Show\ndata One    = One deriving Show\ninfixl 9 :@\ndata (Number a, Digit b) => a :@ b = a :@ b deriving Show\n\nclass Digit a\ninstance Digit Zero\ninstance Digit One\n\nclass Number a\ninstance Number Zero\ninstance Number One\ninstance (Number a, Digit b) => Number (a :@ b)\n\n--- Pretty printing of numbers ---\nclass PrettyNum a where\n    prettyNum   :: a -> String\n\ninstance PrettyNum Zero where\n    prettyNum _ = \"0\"\n\ninstance PrettyNum One where\n    prettyNum _ = \"1\"\n\ninstance (Number a, Digit b, PrettyNum a, PrettyNum b)\n      => PrettyNum (a :@ b) where\n    prettyNum ~(a:@b)\n                = prettyNum a ++ prettyNum b\n\n--- Digit addition ---\nclass (Number a, Digit b, Number c)\n   => AddDigit a b c | a b -> c where\n    addDigit    :: a -> b -> c\n    addDigit    = undefined\n\ninstance Number a => AddDigit a Zero a\ninstance AddDigit Zero One One\ninstance AddDigit One One (One:@Zero)\ninstance Number a => AddDigit (a:@Zero) One (a:@One)\ninstance AddDigit a One a'\n      => AddDigit (a:@One) One (a':@Zero)\n\n--- Addition ---\nclass (Number a, Number b, Number c)\n   => Add a b c | a b -> c where\n    add     :: a -> b -> c\n    add     = undefined\n\ninstance Number n => Add n Zero n\ninstance Add Zero One One\ninstance Add One One (One:@One)\ninstance Number n\n      => Add (n:@Zero) One (n:@One)\ninstance AddDigit n One r'\n      => Add (n:@One) One (r':@Zero)\ninstance (Number n1, Digit d1, Number n2, Digit n2\n         ,Add n1 n2 nr', AddDigit (d1:@nr') d2 r)\n      => Add (n1:@d1) (n2:@d2) r\n\n\nfoo = show $ add (One:@Zero) (One:@One)\n\n\n-- Add (One:@Zero) (One:@One) c, Show c\n-- ==> Number One, Digit Zero, Number One, Digit One\n--     Add One One nr', AddDigit (Zero:@nr') One c, Show c\n--\n-- ==> Add One One nr', AddDigit (Zero:@nr') One c, Show c\n-- \n-- ==> Add One One (One:@One), AddDigit (Zero:@(One:@One)) One c, Show c\n--\n-- ==> AddDigit (Zero:@(One:@One)) One c, Show c\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Class used as a type, recursively\n\nmodule ShouldFail where\n\nclass XML a where toXML :: a -> XML", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- A missing kind check made GHC 6.4 crash on this one\n\nmodule ShouldFail where\n\nclass Foo f where\n        baa :: f a -> f\n\ninstance Foo Maybe where\n        baa z = z\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Kind error message test\n\nmodule ShouldFail where\n\ntype IntMap a = [a]\n\ndata SymDict a = SymDict {idcounter:: Int, itot::IntMap a}\n\ndata SymTable = SymTable {  dict::SymDict   }\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\n-- Test the stupid context on newtypes\n-- (GHC 6.4 dropped it on the floor by mistake)\nmodule ShouldFail where\n\nnewtype Floating a => Test a = Test [a] \n\nx = Test [False, True]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, UndecidableInstances #-}\n-- UndecidableInstances because (L a b) is no smaller than (C a b)\n\n-- This one shows up another rather subtle functional-dependecy\n-- case.  The error is:\n--\n--    Could not deduce (C a b') from the context (C a b)\n--      arising from the superclasses of an instance declaration at Foo.hs:8:0\n--    Probable fix: add (C a b') to the instance declaration superclass context\n--    In the instance declaration for `C (Maybe a) a'\n--\n-- Since L is a superclass of the (sought) constraint (C a b'), you might\n-- think that we'd generate the superclasses (L a b') and (L a b), and now\n-- the fundep will force b=b'.  But GHC is very cautious about generating\n-- superclasses when doing context reduction for instance declarations,\n-- because of the danger of superclass loops.\n--\n-- So, today, this program fails.  It's trivial to fix by adding a fundep for C\n--      class (G a, L a b) => C a b | a -> b\n\n-- Note: Sept 08: when fixing Trac #1470, tc138 started working!\n-- This test is a very strange one (fundeps, undecidable instances),\n-- so I'm just marking it as \"should-succeed\".  It's not very clear to\n-- me what the \"right\" answer should be; when we have the type equality\n-- story more worked out we might want to think about that.\n\nmodule ShouldFail where\n\nclass G a\nclass L a b | a -> b\nclass (G a, L a b) => C a b\n\ninstance C a b' => G (Maybe a)\ninstance C a b  => C (Maybe a) a\ninstance L (Maybe a) a\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Should be rejected by Haskell 98\n\nmodule Foo  where \n\ntype Foo = Double\ninstance Bounded Foo\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- GHC 6.4 gave pretty horrible error messages\n-- for some of these examples\n-- c.f. SourceForge [ ghc-Bugs-1231273 ] confusing error\n\nmodule ShouldFail where\n\nf :: Int -> Int\nf x = x\n\nbar = f 3 9\n\nrot xs = 3 `f` 4\n\nbot xs = map (3 `f`) xs\n\nt = ((\\Just x -> x) :: Maybe a -> a) (Just 1)\n\ng :: Int -> Int\ng x y = True\n\n\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\n-- Tests top-level ambiguity resolution\n-- This made a post-6.4 GHC fall over in TcSimplify\n\nmodule ShouldFail where \n\nclass Foo a\ninstance Foo (a -> b)\n\nfoo :: Foo a => a -> ()\nfoo = undefined\n\nclass Bar a r\n-- The same happens if we use fundeps:\n-- class Bar a r | r -> a\n\nbar :: Bar a r => r -> ()\nbar = undefined\n\ntest = foo bar\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, FlexibleInstances,\n             MultiParamTypeClasses, FunctionalDependencies #-}\n\nmodule Foo  where\n\ndata Z          = Z\ndata S a        = S a\n\nclass MinMax a b c d | a b -> c d, a c d -> b, b c d -> a\ninstance MinMax Z Z Z Z -- (a)\ninstance MinMax a Z Z a -- (b)   -- L1: wrongly flagged as error src.\ninstance MinMax Z b Z b -- (c)\ninstance MinMax a b c d => MinMax (S a) (S b) (S c) (S d)\n                        -- (d)\n\nclass Extend a b  where extend :: a -> b ->  b\ninstance Extend Z b where  Z `extend` b = b\ninstance MinMax a b _c b  => Extend a b where\n        _a `extend` b = b\n\nt       :: MinMax a b _c d => a -> b -> d\nt _ _   = (undefined :: d)\n\nn0      = Z\nn1      = S n0\n\nt1 = n1 `t` n0      -- L2\n\nt2 = n1 `extend` n0 -- L3: uncommenting just this line produces\n                    --     an error message pointing at L1 and L2\n                    --     with no mention of the real culprit, L3.\n\n-- t1   :: S Z      -- L4: uncommenting this and L3 produces an\n                    --  error message rightly pointing at L2 and L3.\n\n\n{-  n0 :: Z;  n1 :: S Z\n\nCall of extend gives wanted: Extend (S Z) Z\nUse instance =>  MinMax (S Z) Z gamma Z\nFD on (b) => gamma ~ Z, Z ~ S Z\n             =>  MinMax (S Z) Z Z Z\nFD on (a), 3rd fundep => Z ~ S Z\n      (b) again (sadly)   Z ~ S Z\n\n-}\n{-\n\nHere's what is happening.\n\nLacking the type signature t1 :: S Z, we get\n\n  n0 :: Z\n  n1 :: S v1\n  t1 :: d1      with constraint ([L2] MinMax (S v1) Z c1 d1)\n  t2 :: Z       with constraint ([L3] Extend (S v1) Z)\n\n     [L2] MinMax (S v1) Z c1 d1, [L3] Extend (S v1) Z\n--->    <by instance for Extend a b>\n     [L2] MinMax (S v1) Z c1 d1, [L3] MinMax (S v1) Z c2 Z}\n--->    <combining these two constraints using (a b -> c d)\n     [L2] MinMax (S v1) Z c1 Z, [L3] MinMax (S v1) Z c1 Z}\n\nNow there are the two constraints are indistinguishable,\nand both give rise to the same error:\n\n--->    <combining first with [L1] instance MinMax a Z Z a>\n     c1=Z, Z=S v1       ERROR\n\nIn either case, the error points to L1.\n\n\nA different sequence leads to a different error:\n\n     [L2] MinMax (S v1) Z c1 d1, [L3] Extend (S v1) Z\n--->    <by instance for Extend a b>\n     [L2] MinMax (S v1) Z c1 d1, [L3] MinMax (S v1) Z c2 Z}\n--->    <combining first with [L1] instance MinMax a Z Z a>\n     [L2] MinMax (S v1) Z Z (S2 v1), [L3] MinMax (S v1) Z c2 Z}\n\nNow combining the two constraints gives rise to the error, but\nthis time pointing to L2,L3.\n\nI can't explain exactly why adding the type signature for t1\nchanges the order.\n\n\nHmm.  Perhaps a good improvement strategy would be:\n  - first do improvement against the instance declarations\n  - and only then do pairwise improvement between constraints\n\nI've implemented that, and indeed it improves the result.\nInstead of:\n\n  Foo.hs:1:0:\n    Couldn't match `S Z' against `Z'\n      Expected type: S Z\n      Inferred type: Z\n    When using functional dependencies to combine\n      MinMax a Z Z a, arising from the instance declaration at Foo.hs:10:0\n      MinMax (S Z) Z _c d, arising from use of `t' at Foo.hs:25:8-10\n\nwe get\n\n  Foo.hs:1:0:\n    Couldn't match `S Z' against `Z'\n      Expected type: S Z\n      Inferred type: Z\n    When using functional dependencies to combine\n      MinMax a Z Z a, arising from the instance declaration at Foo.hs:10:0\n      MinMax (S Z) Z _c Z, arising from use of `extend' at Foo.hs:27:8-15\n\n\nAnd this error in t2 is perfectly correct.  You get it even if you comment\nout the entire definition of t1.\n-}\n", "num_lines": 117}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Both sets should fail in Haskell98\n\n{-# LANGUAGE Haskell98 #-}\n\nmodule ShouldCompile where\n\n  f1 :: Eq a => a -> Bool\n  f1 x = (x == x) || g1 True || g1 \"Yes\"\n  \n  g1 :: Ord a => a -> Bool\n  g1 y = (y <= y) || f1 True\n\n---------\n\n  f2 :: Eq a => a -> Bool\n  f2 x = (x == x) || g2 True || g2 \"Yes\"\n  \n  g2 y = (y <= y) || f2 True\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}\n\n-- This fails, because the type in the pattern doesn't exactly match\n-- the context type.  We don't do subsumption in patterns any more.\n\n-- GHC 7.0: now we do again\n\nmodule Foo where\n\nfoo :: (forall c. c -> c) -> [Char]\nfoo (f :: forall a. [a] -> [a]) = f undefined\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo1 where\n\n-- Variant: class used as data\nclass SClass a where\n sFun :: a -> SData a\n\ndata SData a = SCon (SClass a)\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo1 where\n\n-- Variant: ill-kinded.\nclass XClass a where\n xFun :: a -> XData\n\ndata XData = XCon XClass\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This one caused a panic in GHC 6.4\n\nmodule Foo1 where\n\ndata List elem = Cons elem List | Nil\n\nt1 :: List\nt1 = Cons 1 Nil\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstrainedClassMethods #-}\n\nmodule Main where\n\nclass C a where\n  op :: (Show a, Show b) => a -> b -> String\n        -- This class op adds a constraint on 'a'\n\n        -- In GHC 7.0 this is fine, and it's a royal\n        -- pain to reject it when in H98 mode, so\n        -- I'm just allowing it\n\ninstance C Int where\n  op x y = show x ++ \" \" ++ show y\n\nmain = print (op (1::Int) 2)\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- !!! constraining the type variable in a class head is illegal\n-- Simpler version of tcfail149\nclass Foo a where\n  op :: Eq a => a -> a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts, MultiParamTypeClasses #-}\nmodule ShouldFail where\n\nclass (Show a, Eq a, Monad m) => Name m a where \n    hashName :: a -> m Int \n    newName :: m a \n \ndata Name a => Exp a = MkExp a\n-- The kind error should be reported here\n-- GHC 6.4 reported an error with the class decl\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- This test made Hugs fail (Oct 05) because the constraint\n-- from the 'toInteger' call escaped from the pattern match\n\nmodule ShouldFail where\n\ndata T = forall a. C a\n\ntest (C x) = toInteger x\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Killed a test compiler, so I thought it was worth including\n\nmodule ShouldFail where\n\nf :: a -> [a]\nf x = g x\n    where\n      g y = if y  then [] else [y]\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule ShouldFail where\n\ndata T a = MkT\n\nclass C a b where\n  op :: T a -> T b -> Bool\n\n-- Repeated type variable in an instance constraint\n-- should require UndecidableInstances\ninstance C a a => Eq (T a) where\n  (==) = op\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Data type returns the wrong type\n\nmodule ShouldFail where\n\ndata T a where\n     P :: L1 -> L2\n\ndata L1 = L1\ndata L2 = L2\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- Illegal existential context on a newtype\n\nmodule ShouldFail where\n\nnewtype Foo = forall a . Foo a\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances #-}\n-- NB: *no* UndecidableInstances\n\n-- This one (due to Oleg) made 6.4.1 go into a loop in the typechecker,\n-- despite the lack of UndecidableInstances\n--\n-- The example corresponds to a type function (realized as a class E\n-- with functional dependencies) in the context of an instance.\n-- The function in question is\n--\n--      class E m a b | m a -> b\n--      instance E m (() -> ()) (m ())\n--\n-- We see that the result of the function, \"m ()\" is smaller (in the\n-- number of constructors) that the functions' arguments, \"m\" and\n-- \"() -> ()\" together. Plus any type variable free in the result is also\n-- free in at least one of the arguments. And yet it loops.\nmodule ShouldFail where\n\nclass Foo m a where\n    foo :: m b -> a -> Bool\n\ninstance Foo m () where\n    foo _ _ = True\n\ninstance (E m a b, Foo m b) => Foo m (a->()) where\n    foo m f = undefined\n\nclass E m a b | m a -> b where\n    tr :: m c -> a -> b\n\n-- There is only one instance of the class with functional dependencies\ninstance E m (() -> ()) (m ()) where\n    tr x = undefined\n\n-- GHC(i) loops\n\ntest = foo (\\f -> (f ()) :: ()) (\\f -> (f ()) :: ())\n", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll #-}\n\n-- This one actually crashed in 6.4.1\n-- There's a kind error in the signature for bar, \n-- and we were recovering, and then crashing when we found\n-- a scoped type variable not in scope\n\n data Val v sm = Val\n foo :: forall v sm. Val v sm\n foo = undefined\n   where foo1 :: Val v sm\n         foo1 = bar\n -- Correct type signature: bar :: forall v sm. Val v sm\n bar :: forall v. Val v\n bar = undefined foo\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule ShouldFail where\n\nh :: Int -> (# Int, Int #)\nh x = (# x,x #)\n\nfoo x = case h x of\n          ~(# p, q #) -> p\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Kind error message\n\nmodule ShouldFail where\n\ndata T k = T (k Int)\n\ng :: T Int\ng x = x\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Kind error message\n\nmodule ShouldFail where\n\nf :: [Maybe]\nf x = x\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\n\n-- Kind error message should not contain bangs\n\nmodule ShouldFail where\n\nimport Foreign.ForeignPtr\n\ndata Foo = Foo {-# UNPACK #-} !(ForeignPtr)\n\n \n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\n-- Tests tagToEnum# hacks\n\nmodule ShouldFail where\n\nimport GHC.Base\n\n-- Test 1: Polymorphic\nf :: a\nf = tagToEnum# 0#\n\n-- Test 2: Int value (not an Enumeration TyCon)\nclass Unboxable value where\n    readUnboxable  :: Int -> value\ninstance Unboxable Int where\n    readUnboxable (I# value#) =  tagToEnum# value# \n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XImpredicativeTypes -fno-warn-deprecated-flags #-}\n\nmodule ShouldFail where\n\nimport Control.Concurrent\n\n-- Attempt to put a polymorphic value in an MVar\n-- Fails, but the error message is worth keeping an eye on\n--\n-- Actually (Dec 06) it succeeds now\n--\n-- In GHC 7.0 it fails again! (and rightly so)\n--\n-- With the Visible Type Application patch, this succeeds again.\n--\n-- Sept 16: fails again as it should\n\nfoo = do var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String))\n         putMVar var (show :: forall b. Show b => b -> String)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Without -XScopedTypeVariables, this should fail\n\nmodule ShouldFail where\n\ndestroy :: (forall a. (a -> Maybe (b,a)) -> a -> c) -> [b] -> c\ndestroy = error \"urk\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}\n-- Test inspired by trac #366\n-- The C2 case is impossible due to the types\n\nmodule ShouldCompile where\n\ndata T a where\n    C1 :: T Char\n    C2 :: T Float\n\ninaccessible :: T Char -> Char\ninaccessible C1 = ' '\ninaccessible C2 = ' '\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Test trac #719 (shouldn't give the entire do block in the error message)\n\nmodule ShouldFail where\n\nfoo = do\n          putChar\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n          putChar 'a'\n", "num_lines": 66}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Trac #958\n\nmodule ShoulFail where\n\ndata Succ a = S a       -- NB: deriving Show omitted\ndata Seq a = Cons a (Seq (Succ a)) | Nil deriving Show\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\nmodule ShouldFail where\n\nclass C a b | a -> b\n\ninstance C [p] [q]\n        -- Coverage condition fails\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- This one made GHC fall over on implication constraints\n-- Silly, but one more test does no harm\n\nimport Text.Printf\n\nphex :: a -> b\nphex x = printf \"0x%x\" x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- This one made GHC 6.6 give the very unhelpful error\n-- Foo8.hs:11:10:\n--    Couldn't match kind `?' against `* -> * -> *'\n--    When matching the kinds of `t :: ?' and `t1 :: * -> * -> *'\n--      Expected type: t1\n--      Inferred type: t\n--    In the pattern: Nil\n\nmodule ShouldFail where\n\ndata PatchSeq p a b where\n    Nil   :: PatchSeq p a a\n    U  :: p a b -> PatchSeq p a b\n    (:-)  :: PatchSeq p a b -> PatchSeq p b c -> PatchSeq p a c\n\n-- is_normal :: PatchSeq p a b -> Bool \nis_normal Nil = True \nis_normal (U _) = True \nis_normal (U _ :- _) = True \nis_normal _ = False \n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\nmodule ShouldFail where\n\nnewtype (f <.> g) a = Compose (f (g a))\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -XImpredicativeTypes #-}\n\nmodule Foo where\n\ndata Capture a = Base a\n               | Capture (Capture (forall x . x -> a))\n\ng :: Capture (forall a . a ->  a)\ng = Base id  -- Fails; need a rigid signature on 'id'\n    -- Actually, succeeds now, with visible type application\n    -- Disagree: should not succeed because it instantiates\n    --           Base with a forall type\n\n-- This function should definitely be rejected, with or without type signature\n\nh1 = Capture g\n\nh2 :: Capture b\nh2 = Capture g\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Crashed GHC 6.6!\n-- Trac #1153\n \nmodule ShouldFail where\n\neval :: Int -> String -> String ->  String\neval 0 root actual = evalRHS 0 root actual\n\nevalRHS :: Int -> a\nevalRHS 0 root actual =  eval 0 root actual\n\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\n\n-- Newtype in GADT syntax\n\nmodule ShouldFail where\n\nnewtype Bug a where Bug :: a -> Maybe a\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ShouldFail where\n\n-- See Trac #1176\n-- This is really a pretty-printer test, not a typechecker test\n--\n-- Before ghc-7.2 the error messages looked like this (notice the wrong\n-- indentation):\n\n{-\ntcfail177.hs:9:12:\n    Couldn't match expected type `Bool' with actual type `Int'\n    In the return type of a call of `foo'\n    In the expression:\n      foo\n        [\"One........\" ~?= \"1\", \"Two\" ~?= \"2\", \"Thre.........\" ~?= \"3\",\n     \"Four\" ~?= \"4\", ....]\n    In an equation for `allTest1':\n        allTest1\n          = foo\n              [\"One........\" ~?= \"1\", \"Two\" ~?= \"2\", \"Thre.........\" ~?= \"3\",\n         ....]\n\ntcfail177.hs:18:12:\n    Couldn't match expected type `Bool' with actual type `Int'\n    In the return type of a call of `foo'\n    In the expression:\n      foo\n        [\"One........\" ~?= \"1\", \"Two..................\" ~?= \"2\",\n       \"Thre.........\" ~?= \"3\", \"Four\" ~?= \"4\", ....]\n    In an equation for `allTest2':\n        allTest2\n          = foo\n              [\"One........\" ~?= \"1\", \"Two..................\" ~?= \"2\",\n             \"Thre.........\" ~?= \"3\", ....]\n-}\n\nallTest1 :: Bool\nallTest1 = foo\n           [\"One........\" ~?= \"1\"\n           ,\"Two\" ~?= \"2\"\n           ,\"Thre.........\" ~?= \"3\"\n           ,\"Four\" ~?= \"4\"\n           ,\"Five\" ~?= \"5\"\n           ]\n\nallTest2 :: Bool\nallTest2 = foo\n           [\"One........\" ~?= \"1\"\n           ,\"Two..................\" ~?= \"2\"\n           ,\"Thre.........\" ~?= \"3\"\n           ,\"Four\" ~?= \"4\"\n           ,\"Five\" ~?= \"5\"\n           ]\n\n(~?=) :: a -> a -> Bool\n(~?=) = error \"urk\"\n\nfoo :: a -> Int\nfoo x = 0\n", "num_lines": 60}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- See Trac #1221\n\nmodule ShouldFail where\n\na :: Num a => (Bool -> [a]) -> [a]\na x = x True ++ [1]\n\ny :: b -> ()\ny = const ()\n\n-- Typechecks ok\nb = a (const [2])\n\n-- This one had an uninformative error message\nc = a y\n\n-- More informative\nd = a ()\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n\n-- Examples from Doaitse Swierstra and Brandon Moore\n-- GHC users mailing list, April 07, title \"Release plans\"\n\n-- This one should fail, but Hugs passes it\n\nmodule ShouldFail where\n\ndata T s = forall x. T (s -> (x -> s) -> (x, s, Int))\n\nrun :: T s -> Int\nrun ts  = case ts of\n             T g -> let (x,_, b) =  g x id\n                    in b\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Showed up a bug in bodySplitTyConApp\n\nmodule ShouldFail where\n\np :: f b\np = error \"urk\"\n\ng x = case p of\n        True -> ()\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- GHC 6.7 at one point said wog's type was:\n--\n--    wog :: forall t e (m :: * -> *).\n--           (Monad GHC.Prim.Any1, Monad m) =>\n--           t -> Something (m Bool) e\n--\n-- The stupid 'GHC.Prim.Any1' arose because of type ambiguity\n-- which should be reported, and wasn't.\n\nmodule ShouldFail where\n\ndata Something d e = Something{ bar::  d, initializer::e   }\n\nfoo :: (Monad m) => Something (m Bool) n\nfoo = undefined\n\nwog x = foo{bar = return True}\n\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nimport qualified Prelude\nimport Prelude hiding( Maybe )\n\ndata Maybe a = Foo\n\nf :: Prelude.Maybe a -> Int\nf Foo = 3\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule ShouldCompile where\n\nnewtype Swizzle = MkSwizzle (forall a. Ord a => [a] -> [a])\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -XScopedTypeVariables #-}\n-- We don't actually want scoped type variables, but this flag makes the\n-- forall be recognised by the parser\n\nmodule ShouldCompile where\n\nnewtype Swizzle = MkSwizzle (forall a. Ord a => [a] -> [a])\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- See Trac #1606\n\nmodule ShouldFail where\n\nf :: Int -> Int -> Bool -> Bool -> Int -> Int\nf a b = \\ x y -> let { y1 = y; y2 = y1; y3 = y2; y4 = y3; y5 = y4;\n                       y6 = y5; y7 = y6 } in x\n\n\n\n\n\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #1814\n\nmodule ShouldFail where\n\nimport Tcfail186_Help\n\nfoo = f \"hoo\"", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Tcfail186_Help where\n\ntype PhantomSyn a  = Int\n\nf = (\\_ -> 2) :: PhantomSyn a -> Int\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Trac #1806\n\nmodule ShouldFail where\n\ndata Foo = (:::)\n\nfoo (x ::: y) = ()\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, KindSignatures #-}\n{-# OPTIONS_GHC -Werror #-}\n\n-- Trac #959\n\nmodule ShouldFail where\n\nimport Data.Kind (Type)\n\ndata D (f :: (Type -> Type) -> Type -> Type)\n       (af :: Type -> Type)\n       (ax :: Type) =\n  D (af (f af ax))\n\ndata CList (f :: (Type -> Type) -> Type -> Type) (a :: Type) =\n  RCons a (CList (D f) a)\n\ntype CycleList a = forall f. CList f a\n\nchead :: CycleList a -> a\nchead ys = case ys of (RCons x xs) -> x\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the correct type is used checking the using clause of\n-- the group when a by clause is present\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule ShouldFail where\n\nfoo = [ length x\n      | x <- [1..10]\n      , then group by x using take 2\n      ]\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Checks that the ordering constraint on the groupWith function is respected\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule ShouldFail where\n\nimport GHC.Exts (groupWith)\n\ndata Unorderable = Gnorf | Pinky | Brain\n\nfoo = [ ()\n      | x <- [Gnorf, Brain]\n      , then group by x using groupWith\n      ]\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the correct type is used checking the using clause of the group\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule ShouldFail where\n\ndata Unorderable = Gnorf | Pinky | Brain\n\nfoo = [ ()\n      | x <- [Gnorf, Brain]\n      , then group using take 5\n      ]\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Checks that the correct type is used checking the using clause of the transform\n\n{-# OPTIONS_GHC -XTransformListComp #-}\n\nmodule ShouldFail where\n\nimport Data.List(inits)\n\nz :: [Int]\nz = [x | x <- [3, 2, 1], then inits]\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, GADTs #-}\n\nmodule ShouldFail where\n\ndata Foo a where\n  Foo :: Int -> Foo (forall a. a)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldFail where\n\nbar :: Num (forall a. a) => Int -> Int\nbar = error \"urk\"\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nmodule ShouldFail where\n\nfoo :: [forall a. a] -> Int\nfoo = error \"urk\"\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule ShouldFail where\n\nf3 :: forall a. [a] -> [a]\nJust f3 = Just (\\(x:xs) -> xs ++ [ x :: a ])   -- Not OK!\n        -- The type variable does not scope in a pattern binding\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- trac #2179\n\nmodule Main where\n\nmain = \"hi\"\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule ShouldFail where\n\nf = let x = ( 1#, 'c' ) in x\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\n\n-- Claus reported by email that\n-- GHCi, version 6.9.20080217 loops on this program\n-- http://www.haskell.org/pipermail/cvs-ghc/2008-June/043173.html\n-- So I'm adding it to the test suite so that we'll see it if it happens again\n\nmodule Foo where\n\ndata HsDoc id\n  = DocEmpty\n  | DocParagraph (HsDoc id)\n\ngfoldl' :: (forall a b . c (a -> b) -> a -> c b) -> (forall g . g -> c g) -> a -> c a\ngfoldl' k z hsDoc = case hsDoc of\n                          DocEmpty                  -> z DocEmpty\n--                        (DocParagraph hsDoc)      -> z DocParagraph `k` hsDoc\n\n\n\n\n\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- trac #2307\n-- This was accepted due to a bug in GHC\n\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             UndecidableInstances, IncoherentInstances,\n             FlexibleInstances #-}\n\nmodule Foo where\n\nclass C a b c | b -> c\ninstance C Bool Int Float\ninstance C Char Int Double\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- trac #2806\n\n{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}\n{-# OPTIONS_GHC -Wunbanged-strict-patterns #-}\n\nmodule Foo where\n\nimport GHC.Base\n\npass1 = 'a'\n    where !x = 5#\n\npass2 = 'a'\n    where !(I# x) = 5\n\npass3 = 'a'\n    where !(b, I# x) = (True, 5)\n\npass4 = 'a'\n    where !(# b, I# x #) = (# True, 5 #)\n\npass5 = 'a'\n    where !(# b, x #) = (# True, 5# #)\n\nfail1 = 'a'\n    where x = 5#\n\nfail2 = 'a'\n    where (I# x) = 5\n\nfail3 = 'a'\n    where (b, I# x) = (True, 5)\n\nfail4 = 'a'\n    where (# b, I# x #) = (# True, 5 #)\n\nfail5 = 'a'\n    where (# b, x #) = (# True, 5# #)\n\nfail6 = 'a'\n    where (I# !x) = 5\n\nfail7 = 'a'\n    where (b, !(I# x)) = (True, 5)\n\nfail8 = 'a'\n    where (# b, !(I# x) #) = (# True, 5 #)\n\nfail9 = 'a'\n    where (# b, !x #) = (# True, 5# #)\n{-\n-- Now in tcfail203a.hs, because it's an error\nfail10 = 'a'\n    where !(b, ~(c, (I# x))) = (True, (False, 5))\n-}\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- trac #2806\n\n{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}\n\nmodule Foo where\n\nimport GHC.Base\n\nfail10 = 'a'\n    where !(b, ~(c, (I# x))) = (True, (False, 5))\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# OPTIONS_GHC -Wall #-}\n{-# OPTIONS_GHC -Werror #-}\n\n-- Trac #3261\n\nmodule Foo where\n\nfoo :: Int\nfoo = ceiling 6.3\n\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Fail where\n\nf x = foldl (+) [1 .. x] 'a'\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections, UnboxedTuples #-}\nmodule ShouldCompile where\n\na :: Bool -> (Int, Bool)\na = ( , True)\n\nb :: Int -> Bool -> (Int, Bool)\nb = (1, )\n\nc :: a -> (a, Bool)\nc = (True || False, )\n\nd :: Bool -> (#Int, Bool#)\nd = (# , True#)\n\ne :: Int -> Bool -> (#Int, Bool#)\ne = (#1, #)\n\nf :: a -> (#a, Bool#)\nf = (#True || False, #)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nf :: Int -> [Int] -> [Int]\n-- Want an error message that says 'take' is applied to too many args\nf x = take x []\n\ng :: [Int]\n-- Want an error message that says 'take' is applied to too few args\ng = take 3\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ctx where\n\nf :: (Monad m, Eq a) => a -> m a -> Bool\nf x y = (return x == y)\n\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module FancyContextsWithoutExtension1 where\n\ntype Showish = Show\n\nf :: (Showish a) => a -> a\nf = undefined\n\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TcFail209a where\n\ng :: ((Show a, Num a), Eq a) => a -> a\ng = undefined\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule FancyContextsWithoutExtension2 where\n\ntype family Indexed a :: * -> Constraint\ntype instance Indexed Int = Show\ntype instance Indexed Bool = Num\n\nf :: (Indexed Int a) => a -> a\nf = undefined", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, FlexibleContexts #-}\n\nmodule ShouldFail where\n\nclass (?imp :: Int) => D t where\n    methodD :: t -> t\n\ninstance (?imp :: Int) => D Int where\n    methodD x = x + ?imp\n\ntest :: D Int => Int -- Requires FlexibleContexts\ntest = methodD ?imp\n\n-- Should get reasonable error about unbound ?imp\nuse :: IO ()\nuse = print test\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, MagicHash #-}\nmodule ShouldFail where\n\nimport GHC.Exts\n\n-- If we turn on ConstraintKinds the typing rule for\n-- tuple types is generalised. This test checks that\n-- we get a reasonable error for unreasonable tuples.\n\nf :: (Maybe, Either Int)\nf = (Just 1, Left 1)\n\ng :: (Int#, Int#)\ng = (1#, 2#)", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds #-}\nmodule ShouldFail where\n\nimport GHC.Exts( Constraint )\n\ntype family F a :: Constraint\n\nclass (F a) => C a where\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds #-}\nmodule ShouldFail where\n\nimport GHC.Exts( Constraint )\n\ntype family F a :: Constraint\n\nclass C a where\ninstance (F a) => C [a] where\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, MagicHash #-}\n\nmodule ShouldFail where\n\nimport GHC.Exts\n\n-- As of GHC 7.4, we don't allow unlifted types in ImplicitParms\nfoo :: (?x :: Int#) => Int\nfoo = I# ?x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, UndecidableInstances #-}\nmodule TcFail where\n\nclass cls (A cls) => A cls c where\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test we can't hide cycles with type synonyms\n{-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, UndecidableInstances #-}\nmodule TcFail where\n\ntype Aish = A\n\nclass Aish a => A a where\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n\nmodule Tcfail218 where\n\nclass C a b where foo :: (a,b)\n\ninstance                    C [Int] Bool where foo = undefined\ninstance                    C [a]   b   where foo = undefined\ninstance {-# INCOHERENT #-} C a     Int where foo = undefined\n\n\nx :: ([a],Bool)\n-- Needs C [a] b.\n-- Should fail, as a more specific, unifying but not matching\n-- non-incoherent instance exists, namely C [Int] Bool\nx = foo\n\n-- Needs C [a] Int.\n-- Should succeed, because two instances match, but one is incoherent\ny :: ([a],Int)\ny = foo\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}\nmodule ShouldFail where\n\nclass Class1 a\nclass Class1 a => Class2 a\nclass Class2 a => Class3 a\n\n-- This was wrongfully accepted by ghc-7.0 to ghc-7.10.\n-- It is missing a `Class1 a` constraint.\ninstance Class3 a => Class2 a\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\nimport Prelude hiding( Int )\n\ndata Int = Int\n\nf :: Int\nf = 3\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiWayIf #-}\n\nmodule TcMultiWayIfFail where\n\nx1 = if | True      -> 1 :: Int\n        | False     -> \"2\"\n        | otherwise -> [3 :: Int]\n\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NoNullaryTC where\n\nclass A where\n  f :: a -> a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\nmodule TcNullaryTCFail where\n\nclass A\ninstance A\ninstance A\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers   #-}\n\nmodule StaticPointersFail01 where\n\nimport GHC.StaticPtr\n\nf0 :: StaticPtr Int\nf0 = static g\n\ng :: Int -> Int\ng = id\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers     #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n\nmodule StaticPointersFail02 where\n\nimport GHC.StaticPtr\n\nf1 :: StaticPtr ((forall a . a -> a) -> b)\nf1 = static (undefined :: (forall a . a -> a) -> b)\n\nf2 :: StaticPtr (Monad m => a -> m a)\nf2 = static return\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE StaticPointers     #-}\n\nmodule StaticPointersFail03 where\n\nimport GHC.StaticPtr\nimport Data.Typeable\n\nf1 :: (Typeable a, Typeable m, Monad m) => a -> m a\nf1 = deRefStaticPtr (static return)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications, RankNTypes, PolyKinds #-}\n\nmodule VtaFail1 where\n\npairup_nosig x y = (x, y)\n\nanswer_nosig = pairup_nosig @Int @Bool 5 True\n\naddOne :: Num a => a -> a\naddOne x = x + 1\n\nanswer_constraint_fail = addOne @Bool 5\n\nanswer_lambda = (\\x -> x) @Int 12\n\npair :: forall a. a -> forall b. b -> (a, b)\npair = (,)\n\na = pair 3 @Int @Bool True\n\ndata First (a :: * -> *) = F\n\nfirst :: First a -> Int\nfirst _ = 0\n\nfInt = first @Int F -- should fail\n\ndata Proxy (a :: k) = P -- This expands to P (kind variable) (type variable)\n\nfoo :: Proxy a -> Int\nfoo _ = 0\n\nbaz = foo @Bool (P :: Proxy Int) -- should fail\n\ndata Three (a :: * -> k -> *) = T\n\ntoo :: Three a -> Int\ntoo _ = 3\n\nthreeBad = too @Maybe T\nthreeWorse = too @( -> ) (T :: Three Either)\n\nplus :: Int -> Int -> Int\nplus = (+)\n\nb = plus @Int 5 7\nc = plus @Rational 5 10\nd = (+) @Int @Int @Int 12 14\n\n\ne = show @Int @Float (read \"5\")\nf = show (read @Int @Bool @Float \"3\")\n\nsilly :: a -> Bool\nsilly _ = False\n\ng = silly @Maybe      -- should fail\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n\nmodule Main where\nimport Prelude hiding( succ, pred )\n\nnewtype Ch = Ch (forall a. (a -> a) -> a -> a)\n\napply :: Ch -> (a->a) -> a -> a\napply (Ch f) = f\n\ninstance Eq Ch where\n  a == b = isZero (a - b)\n\ninstance Show Ch where\n  show a = show (fromCh a)\n\ninstance Num Ch where\n  fromInteger n = toCh n\n  m + n = apply n succ m\n  m - n = apply n pred m\n  m * n = apply m (n +) zero\n\nzero :: Ch\nzero = Ch (\\f z -> z)\n\nsucc :: Ch -> Ch\nsucc n = Ch (\\f z -> f (apply n f z))\n\nisZero :: Ch -> Bool\nisZero n = apply n (const False) True\n\ntoCh :: Integer -> Ch\ntoCh 0 = zero\ntoCh n = succ (toCh (n-1))\n\nfromCh :: Ch -> Int\nfromCh n = apply n (+1) 0\n\npred :: Ch -> Ch\npred n = snd (apply n g (zero, zero))\n where g (m,_) = (succ m, m)\n\n\nmain = print ((3+4)*12 - 10::Ch)\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test -fdefer-type-errors\n-- Should compile and run\n\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE GADTs #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\n\nmodule Main where\n\nt5624 :: IO ()\nt5624 = putStr \"Hello World\" >> putStr ','\n\na :: Int\na = 'p'\n\ndata B = B\nb :: B -> Bool\nb x = x == x\n\ndata C a where\n  C1 :: C Int\n  C2 :: Bool -> C Bool\n\nc :: C Int -> Bool\nc (C2 x) = True\n\nd :: a -> a\nd = 1\n\ne = 'p'\nf = e 'q'\n\nh :: a -> (Char,Char)\nh x = (x,'c')\n\ndata T a where\n  K  :: a -> T a\n\ni a = seq (not (K a)) ()\n\nclass MyClass a where myOp :: a -> String\n\nj = myOp 23 -- Two errors, should not combine them\n\n-- No longer reported as an error: Trac #12466\nk :: (Int ~ Bool) => Int -> Bool\nk x = x\n\nl :: IO ()\nl = putChar >> putChar 'p'\n\nmain :: IO ()\nmain = print \"No errors!\"\n", "num_lines": 54}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples, MagicHash, GADTs,\n             DataKinds, PolyKinds, ExplicitForAll #-}\n\nmodule Main where\n\nimport GHC.Exts\n\ndata G a where\n  MkG :: G (TupleRep [LiftedRep, IntRep])\n\n-- tests that we don't eta-expand functions that are levity-polymorphic\n-- see CoreArity.mkEtaWW\nfoo :: forall a (b :: TYPE a). G a -> b -> b\nfoo MkG = (\\x -> x) :: forall (c :: TYPE (TupleRep [LiftedRep, IntRep])). c -> c\n\ndata H a where\n  MkH :: H IntRep\n\n-- tests that we don't push coercions that make args levity-polymorphic\n-- see Simplify.simplCast\nbar :: forall (r :: RuntimeRep) (a :: TYPE r). H r -> (a -> a -> (# a, a #)) -> a -> (# a, a #)\nbar MkH = (\\f x -> f x x) :: forall (b :: TYPE IntRep). (b -> b -> (# b, b #)) -> b -> (# b, b #)\n\nmain :: IO ()\nmain = do\n  let (# b, x #) = foo MkG (# True, 3# #)\n  print b\n  print (I# x)\n\n  let (# y, z #) = bar MkH (#,#) 8#\n  print (I# y)\n  print (I# z)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\n{-# OPTIONS_GHC -dcore-lint #-}\nmodule Main where\n\nimport GHC.Stack\n\nf0 = putStrLn $ prettyCallStack ?loc\n     -- should be empty\n\nf1 :: (?loc :: CallStack) => IO ()\nf1 = putStrLn $ prettyCallStack ?loc\n     -- should show the location of f1's call-site\n\nf3 :: ((?loc :: CallStack) => () -> IO ()) -> IO ()\nf3 x = x ()\n       -- the call-site for the functional argument should be added to the\n       -- stack..\n\nf4 :: (?loc :: CallStack) => ((?loc :: CallStack) => () -> IO ()) -> IO ()\nf4 x = x ()\n       -- as should the call-site for f4 itself\n\nf5 :: (?loc1 :: CallStack) => ((?loc2 :: CallStack) => () -> IO ()) -> IO ()\nf5 x = x ()\n       -- we only push new call-sites onto CallStacks with the name IP name\n\nf6 :: (?loc :: CallStack) => Int -> IO ()\nf6 0 = putStrLn $ prettyCallStack ?loc\nf6 n = f6 (n-1)\n       -- recursive functions add a SrcLoc for each recursive call\n\nf7 :: IO ()\nf7 = putStrLn (prettyCallStack $ id (\\_ -> callStack) ())\n       -- shouldn't crash. See #14043.\n\nmain :: IO ()\nmain = do f0\n          f1\n          f3 (\\ () -> putStrLn $ prettyCallStack ?loc)\n          f4 (\\ () -> putStrLn $ prettyCallStack ?loc)\n          f5 (\\ () -> putStrLn $ prettyCallStack ?loc3)\n          f6 5\n          f7\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\n\nmodule Main where\n\nf0 :: (?x :: Int) => () -> Int\nf0 () = let ?x = 5 in ?x\n   -- Should always return 5\n\nf1 :: (?x :: Int) => () -> Int\nf1 = let ?x = 5 in \\() -> ?x\n   -- Should always return 5\n\nf2 () = let ?x = 5 in \\() -> ?x\n   -- Inferred type: Num a => () -> () -> a\n   -- should always return 5\n\nf3 :: () -> ((?x :: Int) => Int)\n-- Deep skolemisation means that the local x=5 still wins\nf3 = let ?x = 5 in \\() -> ?x\n\nmain = let ?x = 0 in\n       do { print (f0 ())\n          ; print (f1 ())\n          ; print (f2 () ())\n          ; print (f3 ()) }\n\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MonadComprehensions, ParallelListComp #-}\n\n-- !!! Parallel list comprehensions\n\nmodule Main where\n\nf xs = [ (x,y) | x <- xs, x>3 | y <- xs ]\n\nmain = print (f [0..10])\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, TypeApplications, UnboxedTuples, MagicHash,\n             UnboxedSums, NoMonomorphismRestriction #-}\n{-# OPTIONS_GHC -Wno-unused-binds -Wno-unbanged-strict-patterns #-}\n\nmodule Main where\n\nimport Control.Exception\nimport GHC.Exts\n\n-- This stress-tests the semantics of strict patterns.\n\nok :: a -> IO ()\nok x = do\n  evaluate x\n  putStrLn \"Evaluation successful.\"\n\nbad :: a -> IO ()\nbad x = do\n  r <- try @SomeException $ evaluate x\n  case r of\n    Left _  -> putStrLn \"Exception thrown as expected.\"\n    Right _ -> putStrLn \"Exception not thrown when expected.\"\n\n-- OK\na = True\n  where x :: Num a => a\n        !x = undefined   -- x is a function. Should be OK.\n\n-- should fail\nb = True\n  where x :: a\n        !x = undefined\n\n-- OK\nc = True\n  where I# _ = undefined\n\n-- bad\nd = True\n  where I# _x = undefined\n\n-- OK\ne = True\n  where _ = undefined :: Int#\n\n-- bad\nf = True\n  where _x = undefined :: Int#\n\n-- OK\ng = True\n  where (# _ #) = undefined\n\n-- OK\nh = True\n  where (# _x #) = undefined\n\n-- bad\ni = True\n  where (# _x #) = undefined :: (# Int# #)\n\n-- bad\nj = True\n  where !True = False\n\n-- OK\nk = True\n  where True = False\n\n-- OK\nl = True\n  where 3# = 4#\n\n-- bad\nm = True\n  where !3# = 4#\n\n-- bad\nn = True\n  where _x = undefined :: (# () #)\n\n-- OK\no = True\n  where (# _x #) = undefined :: (# () #)\n\n-- OK\np = True\n  where (# _ | #) = (# | True #)\n\n-- bad\nq = True\n  where (# _x | #) = (# | True #) :: (# Int# | Bool #)\n\n-- OK\nr = True\n  where (# _x | #) = (# | True #)\n\n-- bad\ns = True\n  where !(# x #) = undefined\n\nmain :: IO ()\nmain = do\n  ok a\n  bad b\n  ok c\n  bad d\n  ok e\n  bad f\n  ok g\n  ok h\n  bad i\n  bad j\n  ok k\n  ok l\n  bad m\n  bad n\n  ok o\n  ok p\n  bad q\n  ok r\n  bad s\n", "num_lines": 123}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors -fno-warn-deferred-type-errors #-}\n\nimport Control.Exception\nimport Data.Functor\n\na :: Int\na = 'a'\n\nmain :: IO ()\nmain = do\n  catch (void $ evaluate a)\n        (\\e -> do let err = show (e :: TypeError)\n                  putStrLn (\"As expected, TypeError: \" ++ err))\n  catch (void $ evaluate a)\n        (\\e -> do let err = show (e :: ErrorCall)\n                  putStrLn (\"Something went horribly wrong: \" ++ err))\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n{-# OPTIONS_GHC -dcore-lint #-}\n\nimport GHC.Stack\n\nf1 :: (?loc :: CallStack) => CallStack\n-- we can solve CallStacks in local functions from CallStacks\n-- in the outer context\nf1 = let y x = (?loc :: CallStack)\n     in y 0\n\nmain :: IO ()\nmain = do putStrLn $ prettyCallStack f1\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, PartialTypeSignatures #-}\n\nmodule Main where\n\nimport GHC.Stack\n\nf1 :: (?loc :: CallStack) => String\nf1 = show $ map (srcLocStartLine . snd) $ getCallStack ?loc\n\nf2 :: (?loc :: CallStack) => _\nf2 = show $ map (srcLocStartLine . snd) $ getCallStack ?loc\n\nf3 :: (?loc :: CallStack, _) => String\nf3 = show $ map (srcLocStartLine . snd) $ getCallStack ?loc\n\nmain :: IO ()\nmain = do\n  putStrLn f1\n  putStrLn f2\n  putStrLn f3\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\nimport GHC.Stack\n\nfoo :: (?callStack :: CallStack) => [Int]\nfoo = map (srcLocStartLine . snd) (getCallStack ?callStack)\n\nbar1 :: [Int]\nbar1 = foo\n\nbar2 :: [Int]\nbar2 = let ?callStack = freezeCallStack ?callStack in foo\n\nmain :: IO ()\nmain = do\n  print bar1\n  print bar2\n  withFrozenCallStack (error \"look ma, no stack!\")\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, DataKinds #-}\n-- See also TypeOf.hs\n\nimport GHC.Prim\nimport Data.Typeable\n\ndata CharHash = CharHash Char#\n\nmain :: IO ()\nmain = print $ typeRep (Proxy :: Proxy 'CharHash)\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\n\nmodule Main where\n\nimport Control.Exception\n\nnewtype Representational a = Representational ()\ntype role Representational representational\n\nnewtype Phantom a = Phantom ()\ntype role Phantom phantom\n\ntestRepresentational :: Representational Char -> Representational Bool\ntestRepresentational = id\n{-# NOINLINE testRepresentational #-}\n\ntestPhantom :: Phantom Char -> Phantom Bool\ntestPhantom = id\n{-# NOINLINE testPhantom #-}\n\nthrowsException :: String -> a -> IO ()\nthrowsException c v = do\n  result <- try (evaluate v)\n  case result of\n    Right _ -> error (c ++ \" (Failure): No exception!\")\n    Left (TypeError _) -> putStrLn (c ++ \"(Success): exception found\")\n\nmain = do\n  throwsException \"representational\" testRepresentational\n  throwsException \"phantom\" testPhantom\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import T11647Sub (main)\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11647Sub (main) where\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE AllowAmbiguousTypes, TypeFamilies, TypeOperators #-}\n\nimport Data.Kind\nimport Data.Typeable\n\ntype family F x a b\ntype instance F Type       a b = a\ntype instance F Constraint a b = b\n\nfoo :: x :~: y -> F x a b -> F y a b\nfoo Refl = id\n\nunsafeCoerce :: a -> b\nunsafeCoerce x = case eqT :: Maybe (Type :~: Constraint) of\n                   Nothing -> error \"No more bug!\"\n                   Just r  -> foo r x\n\nmain :: IO ()\nmain = let x :: Int\n           x = 42\n       in print (unsafeCoerce x :: Double)\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds, ExplicitForAll, MagicHash, UnboxedTuples,\n             TypeFamilies, GADTs #-}\n\nmodule Main where\n\nimport GHC.Exts\n\nidint :: forall (a :: TYPE IntRep). a -> a\nidint x = x\n\nfive _ = idint 3# +# idint 2#\n\ntype family F a where\n  F Int = (# Bool, Int# #)\n  F Char = (# Double, Int# #)\n\ndata G a where\n  GInt :: G Int\n  GChar :: G Char\n\nf :: G a -> F a\nf GInt = (# True, 3# #)\nf GChar = (# 3.14, 5# #)\n\nf' :: G a -> F a\nf' GInt = (# False, 7# #)\nf' GChar = (# 2.71829, 11# #)\n\ng :: (# Bool, Int# #) -> String\ng (# b, x #) = show b ++ \" \" ++ show (I# x)\n\nh :: (# Double, Int# #) -> String\nh (# d, x #) = show d ++ \" \" ++ show (I# x)\n\ncond :: forall (a :: TYPE (TupleRep [LiftedRep, IntRep])). Bool -> a -> a -> a\ncond True x _ = x\ncond False _ x = x\n\nmain :: IO ()\nmain = do\n  print (I# (five ()))\n  putStrLn (g (f GInt))\n  putStrLn (g (cond False (f GInt) (f' GInt)))\n  putStrLn (h (cond True (f GChar) (f' GChar)))\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# Language FlexibleInstances, TypeFamilies,\n             DataKinds, PolyKinds, MagicHash #-}\n\nmodule Main where\n\nimport Data.Kind\nimport GHC.Exts\n\nclass Shw (a :: TYPE rep) where\n  shw :: a -> String\n\ninstance Int# ~ a => Shw (a :: TYPE IntRep) where\n  shw a = \"I#\" ++ show (I# a)\n\nmain = putStrLn (shw 3#)\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n\nmodule Main where\n\nmain :: () -> ()\nmain = undefined\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstraintKinds #-}       -- For 'C'\n{-# LANGUAGE MultiParamTypeClasses #-} -- For nullary 'Trivial' class\n{-# LANGUAGE ImplicitParams #-}\n{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}\nmodule Main where\n\nimport qualified GHC.Stack as Ghc\n\nclass Trivial where\ninstance Trivial where\n\ntype C = (Ghc.HasCallStack, Trivial)\n\n-- | Print the functions on the call stack.\ncallStack :: C => IO ()\ncallStack = print $ map fst (Ghc.getCallStack Ghc.callStack)\n\nf :: C => a -> IO ()\nf x = callStack\n\ntype C2 =  (?x::Int, ?y::Int)\n\nh1 :: C2 => Int -> IO ()\nh1 v = print (?x+v)\n\nh2 :: C2 => Int -> IO ()\nh2 v = let ?x = 0 in h1 v\n\nmain = do { let { ?x = 3; ?y = 4 }  in h2 4\n            -- Should print 4+0 = 4\n\n          ; f \"ugh\"\n            -- Should print @[\"callStack\", \"f\"]@.\n          }\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE MagicHash #-}\nimport GHC.Exts\nimport Type.Reflection\n\nmain = do\n    case typeRep @(Int -> Char) of\n      App a b -> print (a, b)\n\n    case typeRep @(Int# -> Char) of\n      App a b -> print (a, b)\n\n    case typeRep @(Int# -> Char) of\n      App a b -> print $ App a (typeRep @String)\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeApplications #-}\n\nimport Type.Reflection\n\nmain :: IO ()\nmain = do\n    print $ typeRep @((,,))\n    print $ typeRep @((,,) Int)\n    print $ typeRep @((,,) Int Int Int)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Data.Typeable\n\ndata \u00ce\u00a9 = \u00ce\u00a9\n\nmain :: IO ()\nmain = print $ typeOf \u00ce\u00a9\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}\n\nmodule Main where\n\nclass Foo a b | a -> b where\n    foo :: a -> Maybe b\n    foo x = Nothing\n\n    bar :: a -> b\n\ninstance Foo (Maybe a) a where\n    bar (Just x) = x\n\n\nmain = do { print (foo (Just 'x'))\n          ; print (bar (Just 'y')) }\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,\n             ScopedTypeVariables, GADTs, RankNTypes, FlexibleContexts,\n             MultiParamTypeClasses, GeneralizedNewtypeDeriving,\n             DeriveDataTypeable,\n             OverlappingInstances, UndecidableInstances, CPP #-}\n\nmodule Main (main) where\n\nimport T1735_Help.Basics\nimport T1735_Help.Xml\n\ndata YesNo = Yes | No\n    deriving (Eq, Show, Typeable)\ninstance Sat (ctx YesNo) => Data ctx YesNo where\n    toConstr _ Yes = yesConstr\n    toConstr _ No  = noConstr\n    gunfold _ _ z c  = case constrIndex c of\n                           1 -> z Yes\n                           2 -> z No\n                           _ -> error \"Foo\"\n    dataTypeOf _ _ = yesNoDataType\nyesConstr :: Constr\nyesConstr = mkConstr yesNoDataType \"Yes\" [] Prefix\nnoConstr :: Constr\nnoConstr = mkConstr yesNoDataType \"No\" [] Prefix\nyesNoDataType :: DataType\nyesNoDataType = mkDataType \"YesNo\" [yesConstr, noConstr]\n\nnewtype MyList a = MkMyList { unMyList :: [a] }\n    deriving (Show, Eq, Typeable)\ninstance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)\n      => Data ctx (MyList a) where\n    gfoldl _ f z x  = z MkMyList `f` unMyList x\n    toConstr _ (MkMyList _) = mkMyListConstr\n    gunfold _ k z c  = case constrIndex c of\n                           1 -> k (z MkMyList)\n                           _ -> error \"Foo\"\n    dataTypeOf _ _ = myListDataType\nmkMyListConstr :: Constr\nmkMyListConstr = mkConstr myListDataType \"MkMyList\" [] Prefix\nmyListDataType :: DataType\nmyListDataType = mkDataType \"MyList\" [mkMyListConstr]\n\n#ifdef FOO\nrigidTests :: Maybe (Maybe [YesNo])\nrigidTests =\n mkTest [Elem \"No\"  []] (Just [No])\n#endif\n\nrigidManualTests :: Maybe (Maybe (MyList YesNo))\nrigidManualTests =\n mkTest [Elem \"MkMyList\" [Elem \"Yes\" []]] (Just (MkMyList [Yes]))\n\nmkTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)\nmkTest es v = case fromXml es of\n                  v' | v == v'   -> Nothing\n                     | otherwise -> Just v'\n\nmain :: IO ()\nmain = print rigidManualTests\n\n", "num_lines": 62}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main, arid1, arid2) where\n\nimport Prelude hiding (id, (.))\nimport qualified Prelude\nimport Control.Category\nimport Control.Arrow\nimport System.IO\nimport Debug.Trace\n\n\nmain = do { xs <- runXIOState arid1        -- Works with arid2\n          ; print xs }\n\nrunXIOState :: IOSLA () c -> IO [c]\nrunXIOState f = runIOSLA f ()\n\nnewtype IOSLA a b = IOSLA { runIOSLA :: a -> IO [b] }\n\ninstance Arrow IOSLA where\n    arr f = IOSLA $ \\ x -> return [f x]\n\ninstance Category IOSLA where\n    id = arr id\n\n-- arr :: Arrow m => (b->c) -> m b c\n-- id  :: Category m => m b b\n-- (arr id) :: Arrow m => m a a\n\narid1 :: Arrow m => m a a\narid1 = arr id\n\narid2 :: Arrow m => m a a\narid2 = arr Prelude.id\n\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE TypeFamilies     #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Main where\n\nimport Data.Kind (Type)\n\ntype family F a :: Type\ntype instance F Int = (Int, ())\n\nclass C a\ninstance C ()\ninstance (C (F a), C b) => C (a, b)\n\nf :: C (F a) => a -> Int\nf _ = 2\n\nmain :: IO ()\nmain = print (f (3 :: Int))\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances #-}\n\nmodule Main where\n\nnewtype Mu f = Mu (f (Mu f)) \n     \ntype family Id m\ntype instance Id m = m\n\ninstance Show (Id (f (Mu f))) => Show (Mu f) where\n    show (Mu f) = show f\n\n\nshowMu :: Mu (Either ()) -> String\nshowMu = show\n\nitem :: Mu (Either ())\nitem = Mu (Right (Mu (Left ())))\n\nmain = print (showMu item)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  DeriveDataTypeable,\n              FlexibleContexts, FlexibleInstances,\n              MultiParamTypeClasses,\n              OverlappingInstances, UndecidableInstances,\n              Rank2Types, KindSignatures, EmptyDataDecls #-}\n\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Main (main) where\n\nclass Sat a where\n    dict :: a -- Holds a default value\n\nclass Sat a => Data a where\n    gunfold :: (forall b r. Data b => (b -> r) -> r) -> a\n\ninstance (Sat [a], Data a) => Data [a] where\n   gunfold _  = []\n\nclass Data a => Default a where\n    defaultValue :: a\n    defaultValue = gunfold (\\c -> c dict)\n\ninstance Default t => Sat t where\n    dict = defaultValue\n\ninstance Default a => Default [a] where\n    defaultValue = []\n\ndata Proposition = Prop Expression   \ndata Expression  = Conj [Expression]\n\ninstance Data Expression => Data Proposition where \n  gunfold k = k Prop\n\ninstance (Data [Expression],Sat Expression) => Data Expression where \n-- DV: Notice what happens when we remove the Sat Expression above!\n--     Everything starts working!\n  gunfold k = k Conj\n\ninstance Default Expression\ninstance Default Proposition\n\nmain :: IO () \n\nmain = case (defaultValue :: Proposition) of \n         Prop exp -> case exp of \n                         Conj _ -> putStrLn \"Hurray2!\"\n\n{-  Need Default Proposition\n    for which we have an instance\n\nInstance\n   Default Proposition\nneeds superclass\n   Data Proposition\nvia instance dfun, needs\n   Data Expression\nvia instance dfun, needs\n   Sat Expression\nvia instance dfun, needs\n   Default Expression\nfor which we have an instance\n\nInstance\n   d1: Default Expression\nneeds superclass  [d1 = MkD d2 ..]\n   d2: Data Expression {superclass Sat Expression}\nvia instance dfun, [d2 = dfun d3 d4]  needs\n   d3 : Sat Expression (and d4 : Data [Expression])\nvia instance dfun, [d3 = dfun d5] needs\n   d5 Default Expression\nfor which we have an instance [d5 = d1]\n\n    d1 = MkD d2 ..\n    d2 = dfun d3 d4\n    d3 = dfun d1\n\nInstance\n   d1: Default Expression\nneeds superclass  [d1 = MkD d2 ..]\n   d2: Data Expression {superclass Sat Expression  d2' = sc d2 }\nvia instance dfun, [d2 = dfun d3 d4]  needs\n   d3 : Sat Expression (and d4 : Data [Expression])\nand we can solve: d3 = d2'... no: recursion checker will reject\n\n-}\n\n", "num_lines": 89}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE  DeriveDataTypeable,\n              FlexibleContexts, FlexibleInstances,\n              MultiParamTypeClasses,\n              OverlappingInstances, UndecidableInstances,\n              Rank2Types, KindSignatures, EmptyDataDecls #-}\n\n{-# OPTIONS_GHC -Wall #-}\n\nmodule Main (main) where\n\nimport Data.Typeable\n\nclass Sat a where\n    dict :: a\n\n\nclass ( Sat (ctx a)) => Data ctx a where\n    gunfold :: Proxy ctx\n            -> (forall b r. Data ctx b => c (b -> r) -> c r)\n            -> (forall r. r -> c r)\n            -> Constr\n            -> c a\n    dataTypeOf :: Proxy ctx -> a -> DataType\n\nnewtype ID x = ID { unID :: x }\n\nfromConstrB :: Data ctx a\n            => Proxy ctx\n            -> (forall b. Data ctx b => b)\n            -> Constr\n            -> a\nfromConstrB ctx f = unID . gunfold ctx k z\n where\n  k c = ID (unID c f)\n  z = ID\n\ndata DataType = DataType\n                        { tycon   :: String\n                        , datarep :: DataRep\n                        }\n\ndata Constr = Constr { conrep    :: ConstrRep\n                     , constring :: String\n                     , confields :: [String]\n                     , confixity :: Fixity\n                     , datatype  :: DataType\n                     }\n\ndata DataRep = AlgRep [Constr]\ndata ConstrRep = AlgConstr ConIndex\n\ntype ConIndex = Int\n\ndata Fixity = Prefix\n            | Infix\n\nconstrRep :: Constr -> ConstrRep\nconstrRep = conrep\n\n-- | Constructs an algebraic datatype\nmkDataType :: String -> [Constr] -> DataType\nmkDataType str cs = DataType\n                        { tycon   = str\n                        , datarep = AlgRep cs\n                        }\n\n\n-- | Constructs a constructor\nmkConstr :: DataType -> String -> [String] -> Fixity -> Constr\nmkConstr dt str fields fix =\n        Constr\n                { conrep    = AlgConstr idx\n                , constring = str\n                , confields = fields\n                , confixity = fix\n                , datatype  = dt\n                }\n  where\n    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],\n                     showConstr c == str ]\n\n\n-- | Gets the constructors\ndataTypeConstrs :: DataType -> [Constr]\ndataTypeConstrs dt = case datarep dt of\n                     AlgRep cons -> cons\n\n-- | Gets the string for a constructor\nshowConstr :: Constr -> String\nshowConstr = constring\n\n-- | Gets the index of a constructor\nconstrIndex :: Constr -> ConIndex\nconstrIndex con = case constrRep con of\n                  AlgConstr idx -> idx\n\nnilConstr :: Constr\nnilConstr    = mkConstr listDataType \"[]\" [] Prefix\nconsConstr :: Constr\nconsConstr   = mkConstr listDataType \"(:)\" [] Infix\nlistDataType :: DataType\nlistDataType = mkDataType \"Prelude.[]\" [nilConstr,consConstr]\n\ninstance (Sat (ctx [a]), Data ctx a) =>\n         Data ctx [a] where\n  gunfold _ k z c = case constrIndex c of\n                      1 -> z []\n                      2 -> k (k (z (:)))\n                      _ -> error \"gunfold List\"\n  dataTypeOf _ _ = listDataType\n\nclass (Data DefaultD a) => Default a where\n    defaultValue :: a\n    defaultValue = defaultDefaultValue\n\ndefaultDefaultValue :: Data DefaultD a => a\n{-# NOINLINE defaultDefaultValue #-}\ndefaultDefaultValue = res\n    where res = case datarep $ dataTypeOf defaultProxy res of\n                    AlgRep (c:_) ->\n                        fromConstrB defaultProxy (defaultValueD dict) c\n                    AlgRep [] ->\n                        error \"defaultDefaultValue: Bad DataRep\"\n\ndata DefaultD a = DefaultD { defaultValueD :: a }\n\ndefaultProxy :: Proxy DefaultD\ndefaultProxy = error \"defaultProxy\"\n\n-- dfun3\ninstance Default t => Sat (DefaultD t) where\n    dict = DefaultD { defaultValueD = defaultValue }\n\n-- dfun5\ninstance Default a => Default [a] where\n    defaultValue = []\ndata Proposition = Proposition Expression deriving (Show, Typeable)\ndata Expression = Conjunction [Expression] deriving (Show, Typeable)\n\nconstr_Proposition :: Constr\nconstr_Proposition = mkConstr dataType_Proposition \"Proposition\" [] Prefix\ndataType_Proposition :: DataType\ndataType_Proposition = mkDataType \"Proposition\" [constr_Proposition]\n\n-- dfun1\ninstance Data DefaultD Proposition\n    where gunfold _ k z c = case constrIndex c of\n                            1 -> k (z Proposition)\n                            _ -> error \"gunfold: fallthrough\"\n          dataTypeOf _ _ = dataType_Proposition\n\nconstr_Conjunction :: Constr\nconstr_Conjunction = mkConstr dataType_Expression \"Conjunction\" [] Prefix\ndataType_Expression :: DataType\ndataType_Expression = mkDataType \"Expression\" [constr_Conjunction]\n\n-- dfun2\ninstance (Sat (ctx [Expression]), Sat (ctx Expression))\n      => Data ctx Expression\n    where gunfold _ k z c = case constrIndex c of\n                            1 -> k (z Conjunction)\n                            _ -> error \"gunfold: fallthrough\"\n          dataTypeOf _ _ = dataType_Expression\n\n-- dfun0\ninstance Default Proposition where\n    defaultValue = defaultDefaultValue\n\n-- dfun4\ninstance Default Expression where\n    defaultValue = defaultDefaultValue\n\nmain :: IO ()\nmain = putStrLn (show (defaultValue :: Proposition))\n\n{- The trouble comes from \"instance Default Expression\"\n\nDefine:  dfun4 : Default Expression = MkDefault d_aCl (..)\n\nSimplify the superclass:\n  Wanted:  d_aCl : Data DefaultD Expression\n  Derived: d_aCn : Sat DefaultD Expression       d_aCn = $p1 d_aCl  {irrelevant}\n\n  by dfun2                                       d_aCl = dfun2 d_aCo d_aCp\n  Wanted: d_aCo : Sat (DefaultD [Expression])\n          d_aCp : Sat (DefaultD Expression)\n\n  by dfun3                                       d_aCo = dfun3 d_aCq\n  Wanted:  d_aCq : Default [Expression]\n  Derived: d_aCr : Data DefaultD [Expression]    d_aCr = $p1 d_aCq  {irrelevant}\n\n  by dfun5                                       d_aCq = dfun5 aCu\n  Wanted:  d_aCu : Default Expression\n  Derived: d_aCw : Data DefaultD Expression      d_aCw = $p1 d_aCu\n  Derived: d_aCx : Sat (DefaultD Expression)     d_aCx = $p1 d_aCw\n     -- These two deriveds are unnecessary,\n     -- and dangerous, because we later satisfy\n     -- d_aCu from dfun4 which does not visibly\n     -- depend on d_aCl\n\nNow we satisfy                                   d_aCu = dfun4\n                                                 d_aCp = d_aCx\nResult = disaster:\n                d_aCp = d_aCx\n                      = $p1 d_aCw\n                      = $p1 ($p1 d_aCu)\n                      = $p1 ($p1 dfun4)\n                      = $p1 ($p1 (MkDefault d_aCl ...))\n                      = $p1 d_aCl\n                      = $p1 (dfun2 d_aCo d_aCp)\n                      = d_aCp\n-}\n", "num_lines": 213}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- # LANGUAGE MonoLocalBinds # -}\nmodule Main where\n\nimport T4809_IdentityT (IdentityT(..), XML, runIdentityT)\nimport T4809_XMLGenerator (XMLGenT(..), XMLGen(genElement), Child, EmbedAsChild(..), unXMLGenT)\nimport System.IO (BufferMode(..), hSetBuffering, stdout)\n\npage :: XMLGenT (IdentityT IO) XML\npage = genElement (Nothing, \"ul\") [] [ asChild (asChild \"foo\")]\n--    where\n--       item :: XMLGenT (IdentityT IO) [Child (IdentityT IO)]\n--       item = (asChild $ asChild (return \"bar\" :: XMLGenT (IdentityT IO) String))\n\nmain :: IO ()\nmain =\n    do hSetBuffering stdout LineBuffering \n       r <- runIdentityT (unXMLGenT page)\n       print r\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}\n{-# OPTIONS_GHC -fno-warn-orphans  #-}\nmodule T4809_IdentityT\n    ( evalIdentityT\n    , IdentityT(..)\n    , XML(..)\n    ) where\n\nimport Control.Applicative\nimport Control.Monad        (MonadPlus)\nimport Control.Monad.Trans  (MonadTrans(lift), MonadIO(liftIO))\nimport T4809_XMLGenerator (XMLGenT(..), EmbedAsChild(..), Name)\nimport qualified T4809_XMLGenerator as HSX\n\ndata XML\n  = Element Name [Int] [XML] | CDATA Bool String\n    deriving Show\n\n-- * IdentityT Monad Transformer\n\nnewtype IdentityT m a = IdentityT { runIdentityT :: m a }\n    deriving (Functor, Monad, MonadIO, MonadPlus)\n\ninstance Monad m => Applicative (IdentityT m) where\ninstance Monad m => Alternative (IdentityT m) where\n\ninstance MonadTrans IdentityT where\n    lift = IdentityT\n\nevalIdentityT :: (Functor m, Monad m) => XMLGenT (IdentityT m) XML -> m XML\nevalIdentityT = runIdentityT . HSX.unXMLGenT\n\n-- * HSX.XMLGenerator for IdentityT\n\ninstance (Functor m, Monad m) => HSX.XMLGen (IdentityT m) where\n    type XML (IdentityT m) = XML\n    newtype Child (IdentityT m) = IChild { unIChild :: XML }\n    genElement n _attrs children = HSX.XMLGenT $ \n                                  do children' <- HSX.unXMLGenT (fmap (map unIChild . concat) (sequence children))\n                                     return (Element n [] children')\n\ninstance (Monad m, MonadIO m, Functor m) => EmbedAsChild (IdentityT m) String where\n    asChild s = \n        do liftIO $ putStrLn \"EmbedAsChild (IdentityT m) String\"\n           XMLGenT . return . (:[]) . IChild . CDATA True $ s\n", "num_lines": 46}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies,\n      FlexibleContexts, FlexibleInstances, UndecidableInstances, OverlappingInstances,\n      TypeSynonymInstances, GeneralizedNewtypeDeriving #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  HSX.XMLGenerator\n-- Copyright   :  (c) Niklas Broberg 2008\n-- License     :  BSD-style (see the file LICENSE.txt)\n--\n-- Maintainer  :  Niklas Broberg, niklas.broberg@chalmers.se\n-- Stability   :  experimental\n-- Portability :  requires newtype deriving and MPTCs with fundeps\n--\n-- The class and monad transformer that forms the basis of the literal XML\n-- syntax translation. Literal tags will be translated into functions of\n-- the GenerateXML class, and any instantiating monads with associated XML\n-- types can benefit from that syntax.\n-----------------------------------------------------------------------------\nmodule T4809_XMLGenerator where\n\nimport Control.Applicative\nimport Control.Monad\nimport Control.Monad.Trans\nimport Control.Monad.Cont  (MonadCont)\nimport Control.Monad.Error (MonadError)\nimport Control.Monad.Reader(MonadReader)\nimport Control.Monad.Writer(MonadWriter)\nimport Control.Monad.State (MonadState)\nimport Control.Monad.RWS   (MonadRWS)\nimport Control.Monad (MonadPlus(..),liftM)\n\n----------------------------------------------\n-- General XML Generation\n\n-- | The monad transformer that allows a monad to generate XML values.\nnewtype XMLGenT m a = XMLGenT (m a)\n  deriving (Monad, Functor, MonadIO, MonadPlus, MonadWriter w, MonadReader r,\n            MonadState s, MonadRWS r w s, MonadCont, MonadError e)\n\ninstance Monad m => Applicative (XMLGenT m) where\n  pure  = return\n  (<*>) = ap\n\ninstance Monad m => Alternative (XMLGenT m) where\n\n-- | un-lift.\nunXMLGenT :: XMLGenT m a -> m a\nunXMLGenT   (XMLGenT ma) =  ma\n\ninstance MonadTrans XMLGenT where\n lift = XMLGenT\n\ntype Name = (Maybe String, String)\n\n-- | Generate XML values in some XMLGenerator monad.\nclass Monad m => XMLGen m where\n type XML m\n data Child m\n genElement  :: Name -> [XMLGenT m [Int]] -> [XMLGenT m [Child m]] -> XMLGenT m (XML m)\n genEElement :: Name -> [XMLGenT m [Int]]                          -> XMLGenT m (XML m)\n genEElement n ats = genElement n ats []\n\n-- | Embed values as child nodes of an XML element. The parent type will be clear\n-- from the context so it is not mentioned.\nclass XMLGen m => EmbedAsChild m c where\n asChild :: c -> XMLGenT m [Child m]\n\ninstance (MonadIO m, EmbedAsChild m c, m ~ n) => EmbedAsChild m (XMLGenT n c) where\n asChild m = do\n      liftIO $ putStrLn \"EmbedAsChild m (XMLGenT n c)\"\n      a <- m\n      asChild a\n\ninstance (MonadIO m, EmbedAsChild m c) => EmbedAsChild m [c] where\n  asChild cs =\n      do liftIO $ putStrLn \"EmbedAsChild m [c]\"\n         liftM concat . mapM asChild $ cs\n\ninstance (MonadIO m, XMLGen m) => EmbedAsChild m (Child m) where\n asChild c =\n     do liftIO $ putStrLn \"EmbedAsChild m (Child m)\"\n        return . return $ c\n", "num_lines": 83}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}\nmodule Main where\n\nimport GHC.Exts\n\n{-# NOINLINE foo1 #-} -- Make it harder to get right\nfoo1 x = (# x,x #)\n\n{-# NOINLINE foo2 #-} -- Make it harder to get right\nfoo2 x = (# x, (# True, False #) #)\n\n{-# NOINLINE foo3 #-} -- Make it harder to get right\nfoo3 (# x,y #) = x\n\nmain = print $ foo3 (# if b then x + y else x - y, 30 #)\n  where (# x,  _ #) = foo1 10\n        (# y, (# b, _ #) #) = foo2 20\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}\nmodule Main where\n\nimport GHC.Exts\n\n{-# NOINLINE foo #-} -- Make it harder to get right\nfoo :: Double# -> (# (# Double#, Double# #), Double# #)\nfoo x = (# (# x, x #), x #)\n\nmain :: IO ()\nmain = case foo 1.0## of\n        (# (# x, y #), z #) -> print (D# x + D# y + D# z)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, OverlappingInstances, UndecidableInstances #-}\nmodule Main where\n\nclass (Monad m) => MonadIO m where\n    -- | Lift a computation from the 'IO' monad.\n    liftIO :: IO a -> m a\n\ninstance MonadIO IO where\n    liftIO = id\n\nclass XMLGenerator m where\n    genElement :: (Maybe String, String) -> m ()\n\nnewtype IdentityT m a = IdentityT { runIdentityT :: m a }\n    deriving (Functor, Applicative, Monad, MonadIO)\n\ninstance (MonadIO m) => (XMLGenerator (IdentityT m)) where\n    genElement _ = liftIO $ putStrLn \"in genElement\"\n\nmain :: IO ()\nmain =\n    do runIdentityT web\n       putStrLn \"done.\"\n\nclass (Widgets x) => MonadRender x\nclass (XMLGenerator m)  => Widgets m\n-- instance Widgets (IdentityT IO) -- if you uncomment this, it will work\ninstance (XMLGenerator m, MonadRender m) => Widgets m\ninstance MonadRender (IdentityT IO)\n\nweb :: ( MonadIO m\n       , Widgets m\n       , XMLGenerator m\n       ) => m ()\nweb =\n    do liftIO $ putStrLn \"before\"\n       genElement (Nothing, \"p\")\n       return ()\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverlappingInstances,\n    UndecidableInstances, FunctionalDependencies #-}\n\nmodule Main where\n\nclass Container a b | a -> b where\n    make :: b -> a\n\ndata Cont a = Cont a deriving (Show, Eq)\n\ninstance Container (Cont a) a where\n    make x = Cont x\n\ninstance (Container a b, Show a, Eq a, Num b) => Num a where\n    fromInteger x = make (fromInteger x)\n\nd = fromInteger 3 :: Cont Integer\n\nmain = print d", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\nmodule Main where\n\nclass         L0 a where l0 :: a -> a\nclass L0 a => L1 a where l1 :: a -> a\nclass L1 a => L2 a where l2 :: a -> a\n\n\ndata Worksfine = Worksfine deriving Show\ninstance                                   L0 Worksfine where l0 = id\ninstance                                   L1 Worksfine where l1 = l2\ninstance {- undecidable -} L1 Worksfine => L2 Worksfine where l2 = l0\n\n\ndata WorksfineToo = WorksfineToo deriving Show\ninstance                                      L0 WorksfineToo where l0 = id\ninstance {- undecidable -} L2 WorksfineToo => L1 WorksfineToo where l1 = l2\ninstance {- undecidable -} L1 WorksfineToo => L2 WorksfineToo where l2 = id\n\n\n-- l1 LoopsAtRuntime = <loop>\n-- l2 LoopsAtRuntime = <loop>\ndata LoopsAtRuntime = LoopsAtRuntime deriving Show\ninstance                                        L0 LoopsAtRuntime where l0 = id\ninstance {- undecidable -} L2 LoopsAtRuntime => L1 LoopsAtRuntime where l1 = l2\ninstance {- undecidable -} L1 LoopsAtRuntime => L2 LoopsAtRuntime where l2 = l0\n\nmain = do\n  print (l1 WorksfineToo)\n  print (l2 WorksfineToo)\n  print (l1 LoopsAtRuntime)\n  print (l2 LoopsAtRuntime)\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n\nimport Prelude hiding (Semigroup(..))\n\n{-\n[Summary of the program] Ring is defined as a subclass of Semigroup,\ninheriting multiplication.  Additive is a wrapper that extracts the additive\nstructure of Ring and reifies it as Semigroup.  For simplicity, the code omits\nring operations (+ and *) and defines only the additive and multiplicative\nidentities.\n\n[The bug] If there is a cyclic class hierarchy like\n\n    class B a => Semigroup a                  where ...\n    class Semigroup (Additive a) => Ring a    where ...\n    instance Ring a => Semigroup (Additive a) where ...\n\nthen uses of B's methods on (Additive a) in the method implementations of the\nthird declaration \"instance Ring a => Semigroup (Additive a)\" will:\n\n    1. be accepted by the compiler even in cases where B (Additive a) is not\n       derivable.\n    2. result in <<loop>>.\n -}\n\nclass B a where\n    b :: a\nclass B a => Semigroup a where\n    unit :: a\nclass (Semigroup a, Semigroup (Additive a)) => Ring a where\n    zero :: a\nnewtype Additive a = Additive a\n\n-- The source compiles whether with or without this instance declaration in GHC\n-- 7.2.1 - 7.4.1 and produces <<loop>>.\n--\n-- GHC 7.0.4 rejects this source without this declaration and produces\n-- terminating code with the declaration.\ninstance B a => B (Additive a) where\n   b = Additive b\n\ninstance Ring a => Semigroup (Additive a) where\n    unit = b -- Use a method of type (B a => ...) with a instantiated as\n             -- (Additive a).  This causes <<loop>>.\n\n\n-- Now try to instantiate Ring and evaluate `unit'.\ninstance B Int where\n    b = 1234567890\ninstance Semigroup Int where\n    unit = 1\ninstance Ring Int where\n    zero = 0\nmain = case (unit :: Additive Int) of -- Force the additive identity of Int.\n         Additive x -> print x\n", "num_lines": 56}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fdefer-type-errors #-}\n\nmodule Main where\n\na = [\"x\", 1 :: Int]\n\nmain :: IO ()\nmain = putStrLn \"Hello World\"\n\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}\n\nmodule Main where\n\nmain :: IO ()\nmain =  do\n  let k1 = func1 1 :: Int\n  print $ show k1\n  let k2 = outer :: Int\n  print $ show k2\n\nouter :: Class3 a => a\nouter = func1 1\n\nclass Class1 a where\n  func1 :: Int -> a\n\nclass Class1 a => Class2 a where\n  func2 :: Int -> a\n\nclass Class2 a => Class3 a where\n  func3 :: Int -> a\n\ninstance Class1 Int where\n  func1 = id\n\ninstance (Class1 a, Class3 a) => Class2 a where\n  func2 = func3\n\ninstance Class3 Int where\n  func3 = id\n\n--\n-- \"1\"\n-- tests: <<loop>>\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Correct type, which is inferred by GHC 7.6.1 and\n-- works fine with GHC 7.6.2:\n-- test :: Maybe (Maybe (r -> ())) -> r -> ()\n\n-- Incorrect type, resulting in a runtime <<loop>>,\n-- inferred by GHC 7.6.2 and also accepted by GHC 7.6.1:\n-- test :: a -> r -> ()\n\nmodule Main where\n\ntest zd\n = let f = let g = case zd of\n                       Nothing       -> const ()\n                       Just Nothing  -> const ()\n                       Just (Just p) -> p\n           in  g\n   in f\n\nmain :: IO ()\nmain = do\n  let x = test (Just Nothing) ()\n  print x\n\n\n\n{-\nThere is a bug in the type checker of 7.6.1 and 7.6.2, which accepts\nan incorrect type resulting in <<loop>> at runtime. Furthermore, 7.6.2\neven automatically infers this incorrect type. Hence, the attached\ncode has the following behavior:\n\n- No explicit type: Code works in 7.6.1, loops in 7.6.2 \n- Correct explicit type: Code works fine in 7.6.1 and 7.6.2 \n- Incorrect explicit type: Code loops in 7.6.1 and 7.6.2\n\nThe incorrect type has a parameter that is too polymorphic, i.e. an\n\"a\" type is accepted while the function does a pattern match on the\nparameter from which it is clear that it should be a Maybe type. In\n7.4.* versions this incorrect type is not accepted.\n-}", "num_lines": 40}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# OPTIONS_GHC -fdefer-type-errors #-}\nmodule Main where\n\ndoA :: (forall b. a) -> [a]\ndoA = undefined\n\nf :: (forall b. a) -> a\nf = doA\n\nmain = do { print \"Hello 1\"\n\n          ; f `seq` print \"Hello 2\"\n              -- The casts are pushed inside the lambda\n              -- for f, so this seq succeeds fine\n              -- It does require ImpredicativeTypes, because we instantiate\n              -- seq's type (c->d->d) with f's type (c:= (forall b. a) -> a),\n              -- which is polymorphic (it has foralls).\n\n          ; f (error \"urk\") `seq` print \"Bad\"\n              -- But when we *call* f we get a type error\n        }\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nclass Test a where test :: a\ninstance (a ~ Int, b ~ Int) => Test (a -> b) where test = id\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nx :: ((->) Int) Bool\nx = (==0)\n\nmain = print $ x 0\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Main where\nimport GHC.Exts\n\ngo :: () -> Int#\ngo () = 0#\n\nmain = print (lazy (I# (go $ ())))\n\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = _main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = _main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "main :: IO ()\nmain = _main\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\nmodule Main(main) where\n\nimport Data.Typeable\nimport Data.Kind\n\ntest1 :: Bool\ntest1 = typeRep (Proxy :: Proxy (() :: Type)) ==\n        typeRep (Proxy :: Proxy (() :: Constraint))\n\ntest2 :: Bool\ntest2 = typeRepTyCon (typeRep (Proxy :: Proxy (Int,Int))) ==\n        typeRepTyCon (typeRep (Proxy :: Proxy (Eq Int, Eq Int)))\n\nmain :: IO ()\nmain = print (test1,test2)\n\n\n\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\nmodule Main where\n\nimport Data.Typeable\n\ndata A = A\n\nmain = print $ typeRep (Proxy :: Proxy A) == typeRep (Proxy :: Proxy 'A)\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RoleAnnotations, StandaloneDeriving, FlexibleContexts, UndecidableInstances, GADTs, TypeFamilies #-}\n\nimport Data.Coerce (Coercible, coerce)\nimport Data.Monoid (mempty, First(First), Last())\n\nnewtype Age = Age Int deriving Show\nnewtype Foo = Foo Age deriving Show\nnewtype Bar = Bar Age deriving Show\nnewtype Baz = Baz Bar deriving Show\n\ntype role Map nominal representational\ndata Map a b = Map a b deriving Show\n\n-- Higher kinded coercions (#8541)\nnewtype List a = List [a] deriving Show\ndata T f = T (f Int)\n\n-- It should be possible to coerce _under_ undersaturated newtypes\nnewtype NonEtad a b = NonEtad (Either b a) deriving Show\n\n-- It should be possible to coerce recursive newtypes, in some situations\n-- (#8503)\nnewtype Fix f = Fix (f (Fix f))\nderiving instance Show (f (Fix f)) => Show (Fix f)\n\n-- Later, however, this stopped working (#9117)\n-- newtype FixEither a = FixEither (Either a (FixEither a)) deriving Show\n\n-- This ensures that explicitly given constraints are consulted, even \n-- at higher depths\n-- This stopped working with the fix to #9117\n--data Oracle where Oracle :: Coercible (Fix (Either Age))\n--                                      (Fix (Either Int)) => Oracle\n--foo :: Oracle -> Either Age (Fix (Either Age)) -> Fix (Either Int)\n--foo Oracle = coerce\n\n-- This ensures that Coercible looks into newtype instances (#8548)\ndata family Fam k\nnewtype instance Fam Int = FamInt Bool deriving Show\n\nmain = do\n    print (coerce $ one                       :: Age)\n    print (coerce $ age                       :: Int)\n    print (coerce $ Baz (Bar age)             :: Foo)\n\n    print (coerce (id::Bar->Bar) age          :: Foo)\n    print (coerce Baz age                     :: Foo)\n    print (coerce $ (Age 1, Foo age)          :: (Baz, Baz))\n\n    print (coerce $ Map one one               :: Map Int Age)\n\n    print (coerce $ Just one                  :: First Int)\n    print (coerce $ (mempty :: Last Age)      :: Last Int)\n\n    printT (coerce $ (T (Left age)     :: T (Either Age))  :: T (Either Int))\n    printT (coerce $ (T (Left one)     :: T (Either Int))  :: T (Either Age))\n    printT (coerce $ (T [one]          :: T [])            :: T List)\n    printT (coerce $ (T (List [one])   :: T List)          :: T [])\n\n    printT (coerce $ (T (NonEtad (Right age)) :: T (NonEtad Age)) :: T (NonEtad Int))\n\n    print (coerce $ (Fix (Left ()) :: Fix (Either ())) :: Either () (Fix (Either ())))\n    print (coerce $ (Left () :: Either () (Fix (Either ()))) :: Fix (Either ()))\n\n--    print (coerce $ (FixEither (Left age) :: FixEither Age)\n--               :: Either Int (FixEither Int))\n--    print (coerce $ (Left one :: Either Int (FixEither Age)) :: FixEither Age)\n\n    print (coerce $ True :: Fam Int)\n    print (coerce $ FamInt True :: Bool)\n\n--    foo `seq` return ()\n\n\n  where one = 1 :: Int\n        age = Age one\n        printT (T x) = print x\n", "num_lines": 78}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule Main where\n\nclass R where\n  f :: Int -> Int\n  g :: a -> a\n\ninstance R where\n  f = (+1)\n  g = id\n\nmain = print (g (f 0))\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !! Test for (->) instances\n\nmodule Main where\n\nclass Flob k where\n  twice :: k a a  -> k a a\n\ninstance Flob (->) where\n  twice f = f . f\n\ninc :: Int -> Int\ninc x = x+1\n\nmain = print (twice inc 2)\n\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! space leak from overloading !!!\nmodule Main where\n\n-- This program develops a space leak if sfoldl isn't compiled with some\n-- care.  See comment about polymorphic recursion in TcMonoBinds.lhs\n\nimport System.Environment (getArgs)\nimport GHC.IO\n\nsfoldl :: (a -> Int -> a) -> a -> [Int] -> a\nsfoldl f z [] = z\nsfoldl f z (x:xs) = {-# SCC \"sfoldl1\" #-} (sfoldl f fzx (fzx `seq` xs))\n                  where fzx = {-# SCC \"fzx\" #-} (f z x)\n\n\nmain = IO (\\s -> case print (sfoldl (+) (0::Int) [1..200000]) of { IO a -> a s })\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n-- !!! One method class from Sergey Mechveliani \n--     showed up problematic newtype dict rep.\nmodule Main where\nimport Data.Ratio\n\nclass MBConvertible a b  where  cm :: a -> b -> Maybe b\n\nc :: MBConvertible a b => a -> b -> b\nc                         a    b =  case  cm a b  \n                                    of \n                                      Just b' -> b'\n                                      _       -> error \"c a b  failed\"\n\n\ninstance MBConvertible Int Int  where  cm a _ = Just a\n\ninstance (MBConvertible a b,Integral b) => MBConvertible a (Ratio b)\n  where\n  cm a f =  case  cm a (numerator f)  of  Just a' -> Just (a'%1)\n                                          _       -> Nothing \n  \nmain =  let  f  = 1%1 :: Ratio Int\n             n2 = 2::Int\n             g  = (c n2 f) + f\n        in\n             putStr (shows g \"\\n\")\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification #-}\n-- !!! Tests existential data types\n--     Originally from Kevin Glynn\nmodule Main(main) where\n\ndata Coordinate3D = Coord3D {cx, cy, cz::Double}\n                    deriving (Eq, Show)\n\n-- We Represent a line by two coordinates which it passes through.\ndata Line = MkLine Coordinate3D Coordinate3D\n\n\nclass PictureObject pot where\n\n      -- Returns ordered (rel to 0 0 0) of points where the object\n      -- intersects the given line.\n      intersectLineObject :: pot -> Line -> [Coordinate3D]\n\n      getPictureName :: pot -> String\n\ndata Sphere =\n   Sphere Coordinate3D                  -- Centre\n          Double                        -- Radius\n          Double                        -- ambient coeff\n          Double                        -- diffuse coeff\n          Double                        -- specular coeff\n          Double                        -- phong specular exponent\n\nintersectLineSphere :: Sphere -> Line -> [Coordinate3D]\nintersectLineSphere sp line = []\n\ninstance PictureObject Sphere where\n         intersectLineObject = intersectLineSphere\n         getPictureName _ = \"Sphere\"\n\ndata Cube =\n   Cube Coordinate3D            -- Origin corner\n        Coordinate3D            -- Opposite corner\n        Double                  -- ambient coeff\n        Double                  -- diffuse coeff\n        Double                  -- specular coeff\n        Double                  -- phong specular exponent\n   deriving (Eq, Show)\n\nintersectLineCube :: Cube -> Line -> [Coordinate3D]\nintersectLineCube cube line = []\n\ninstance PictureObject Cube where\n         intersectLineObject = intersectLineCube\n         getPictureName _ = \"Cube\"\n\n\ndata GenPic = forall pot. (PictureObject pot) => MkGenPic pot\n\nsphere :: Sphere\nsphere = Sphere (Coord3D 1 1 1) 1 1 1 1 1\n\ncube :: Cube\ncube = Cube (Coord3D 1 1 1) (Coord3D 2 2 2) 1 1 1 1\n\nobj_list:: [GenPic]\nobj_list = [MkGenPic sphere, MkGenPic cube]\n\nputName :: PictureObject pot => pot -> IO ()\nputName x = putStr $ getPictureName x\n\n\nmain :: IO ()\nmain = do { sequence_ $ map put_it obj_list }\n     where\n       put_it (MkGenPic s) = putStrLn (getPictureName s)\n\n", "num_lines": 73}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Dfun naming bug\n\nmodule Main where\n\n\n  data TT  = TT\n  data TTT = TTT\n\n  class CC  a where\n        op_cc :: a -> a\n\n  class CCT a where\n        op_cct :: a -> a\n\n  -- These two instances should get different dfun names!\n  -- In GHC 4.04 they both got $fCCTTT\n\n  instance CC TTT where\n        op_cc = id\n\n  instance CCT TT where\n        op_cct = id\n\n  main = case op_cc TTT of\n           TTT -> print \"ok\"\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\n-- !!! Selectors for data and newtypes with contexts\n\n-- This program, reported in Aug'00 by Jose Emilio Labra Gayo\n-- gave rise to a Lint error because the selector 'newout' below\n-- was given the type\n--      Eq f => NewT f -> f\n-- but lacked a dictionary argument in its body.\n\nmodule Main where\n\nnewtype (Eq f) => NewT  f = NewIn  { newout  :: f }\ndata    (Eq f) => DataT f = DataIn { dataout :: f }\n\nmain = print (newout (NewIn \"ok new\") ++ dataout (DataIn \" ok data\"))\n\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n\n-- !!! Check that record selectors for polymorphic fields work right\n\nmodule Main where\n\nclass Foo a where\n  bar :: a -> [a]\n\ninstance Foo Int where\n  bar x = replicate x x\n\ninstance Foo Bool where\n  bar x = [x, not x]\n\ndata Record = R {\n     blub :: forall a. Foo a => a -> [a]\n    }\n\nmain = do { let r = R {blub = bar}\n          ; print (blub r (3::Int))\n          ; print (blub r True)\n          }\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- !!! Functional dependencies\n\nmodule Main where\n\nclass Foo a b | a -> b where\n    foo :: a -> b\n\ninstance Foo [a] (Maybe a) where\n    foo []    = Nothing\n    foo (x:_) = Just x\n\ninstance Foo (Maybe a) [a] where\n    foo Nothing  = []\n    foo (Just x) = [x]\n\ntest3:: [a] -> [a]\ntest3 = foo . foo\n-- First foo must use the first instance,\n-- second must use the second.  So we should\n-- get in effect:       test3 (x:xs) = [x]\n\nmain:: IO ()\nmain = print (test3 \"foo\")\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}\n\n-- !!! Functional dependencies\n-- This one gave \"zonkIdOcc:  FunDep_a11w\" in earlier days\n\nmodule Main (main) where\n\ndata ERR a b = EOK a | ERR b deriving (Show)\ndata Error   = No | Notatall deriving (Show, Eq)\n\n\nclass MonadErr m e | m -> e where\n   aerturn ::           e   -> m a\n   areturn ::           a   -> m a\n   acatch  ::           a   -> (a -> m b) -> (e -> m b) -> m b\n   (>>>=)  ::           m a -> (a -> m b) -> m b\n   (>>>)   ::           m a -> m b        -> m b\n\ndata BP a = BP (Int -> (ERR a Error, Int))\n\ninstance MonadErr BP Error where\n   aerturn k             = BP $ \\s  -> (ERR k, s)\n   areturn k             = BP $ \\s  -> (EOK k, s)\n   acatch  k try handler = BP $ \\s  -> let BP try'     = try  k\n                                           (r,s1)      = try' s\n                                           (BP c2, s2) = case r of\n                                                           EOK r -> (areturn r, s1)\n                                                           ERR r -> (handler r, s)\n                                       in  c2 s2\n   a >>> b =  a >>>= \\_ -> b\n\n   (BP c1) >>>= fc2      = BP $ \\s0 -> let (r,s1) = c1 s0\n                                           BP c2 = case r of\n                                                     EOK r -> fc2 r\n                                                     ERR r -> BP (\\s -> (ERR r, s))\n                                       in c2 s1\n\nrun_BP :: Int -> BP a -> (ERR a Error, Int)\nrun_BP st (BP bp) = bp st\n\nfoo :: (ERR Int Error, Int)\nfoo = run_BP 111 (aerturn No)\n\nmain = print (show foo)\n", "num_lines": 45}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, FlexibleContexts,\n             MultiParamTypeClasses #-}\n\n-- !!! Existential data tyes\n-- Hugs didn't like this one\n\nmodule Main (main) where\n\n\nclass MyClass a b where\n        foo :: a -> b -> Int\n\ndata Special = forall b. (MyClass Int b)=> MkSpecial b\ndata General a = forall b. (MyClass a b)=> MkGeneral b\n\ninstance MyClass Int Bool where\n   foo x False = -x\n   foo x True  = x\n\nxs :: [General Int]\nxs = [MkGeneral True, MkGeneral False]\n\nmain = print [foo (3::Int) x | MkGeneral x <- xs]\n        -- Without the (::Int) part we get an\n        -- incomprehensible error message :-(\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- !!! Implicit parameter test\n\nmodule Main where\n\nmain = do { let ?x = 13 in putStrLn $ show $ foo\n          ; let ?x = 14 in putStrLn $ show $ baz () }\n\nfoo :: (?x :: Int) => Int\nfoo = ?x\n\n-- Check that defaulting works too\nbaz () = ?x\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ParallelListComp #-}\n\n-- !!! Parallel list comprehensions\n\nmodule Main where\n\nf xs = [ (x,y) | x <- xs, x>3 | y <- xs ]\n\nmain = print (f [0..10])\n\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Newtypes\n\n-- This one made ghc 5.01 (after newtype squashing) fall over\n-- by generating Core code that contained a pattern match on \n-- the InPE data constructor (which doesn't exist)\n\nmodule Main where\n\n\ndata Expr e = One e | Many [e]\nnewtype PExpr a = InPE (Expr (PExpr a), Int)\n\none :: Int -> PExpr e -> PExpr e\none l x = InPE (One (plus1 x), l)\n\nplus1 :: PExpr a -> PExpr a\nplus1 x@(InPE (_, loc)) = InPE (Many [plus1 x], loc)\n\nget :: PExpr e -> Int\nget (InPE (_,l)) = l\n\nmain = print (get (plus1 (InPE (Many [], 0))))\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- !!! Newtypes\n\n-- A variation of tc014 that Sigbjorn said failed\n\nmodule Main where\n\ndata Expr a b = One a | Many [b]\nnewtype Pat a   = InP (Expr a (Pat a), Int)\nnewtype PExpr a = InPE (Expr a (PExpr a), Int)\n\nplus1 x@(InPE (_, loc)) = InPE (Many [x], loc)\none x l = InPE (One (plus1 x), l)\n\noutP (InP x) = x\n\ngetPatNames p\n  = case outP p of\n      (One n, _)     -> [n]\n      (Many ps, _) -> concatMap getPatNames ps\n\nmain = print (take 10 (map getPatNames (repeat (InP (One \"n\", 1)))))\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances #-}\n\n-- !!! Functional dependencies\n-- This one made the 5.00.1 typechecker go into an infinite loop.\n-- The context simplifier keep thinking it was doing an 'improve'\n-- step, and hence kept going round and round.\n\nmodule Main where\n\nmain = print (get ((AttributeLeaf (MyLabel \"x\") 4)::Env1) (MyLabel \"x\"))\n\nclass Eq l => Domain d l | d -> l where\n        (<<) :: d -> d -> d\n        empty :: d\nclass Domain e l => Environment e l t | e -> l t where\n        get :: e -> l -> Maybe t\n        attribute :: l -> t -> e\n\nclass Eq' a where\n        (=?=) :: a -> a -> Bool\n\nnewtype MyLabel = MyLabel String deriving Eq\n\ninstance Eq' MyLabel where\n        l =?= l' = l == l'\n\ndata BinTreeEnv l t =\n        EmptyEnv |\n        AttributeLeaf l t |\n        Union (BinTreeEnv l t) (BinTreeEnv l t)\n\ninstance (Eq l, Eq' l) => Domain (BinTreeEnv l t) l where\n        EmptyEnv << d = d\n        d << EmptyEnv = d\n        d << d' = Union d d'\n        empty = EmptyEnv\n\ninstance (Eq l, Eq' l) => Environment (BinTreeEnv l t) l t where\n        get EmptyEnv l = Nothing\n        get (AttributeLeaf l t) l' = if l =?= l' then Just t\n                                     else Nothing\n        get (Union d d') l = error \"!??\"\n\n        attribute l t = AttributeLeaf l t\n\ntype Env1 = BinTreeEnv MyLabel Integer\n\n", "num_lines": 49}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, Rank2Types #-}\n\n-- !!! Implicit parameters, and Rank-2 types\n-- This one made the 5.00.1 not print anything\n\nmodule Main where\n\nfoo :: ((?x :: Int) => IO a) -> Int -> IO a\n        -- Note the rank2 type\nfoo s z = do  let ?x = z   in s         -- Should pick up ?x = z\n              let ?x = z+3 in s         -- Ditto z+3\n\nmain = foo (print ?x) 42\n\n", "num_lines": 15}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n\nclass Monad m => C1 m x\n\nclass (Monad m, C1 m x) => C2 m x\n  where\n    c2 :: x -> m x\n\nclass C1 m x => C3 m x\n  where\n    c3 :: x -> m x\n\ninstance Monad m => C1 m Bool\n\ninstance C2 Maybe Bool\n  where\n    c2 = return\n\ninstance C3 Maybe Bool\n  where\n    c3 = return\n\n\nmain = do { print (c2 True :: Maybe Bool) ;\n            print (c3 True :: Maybe Bool) }\n\n------------------------------------------------------------------------\n{-      Here's the email from Ralf Laemmel\n        reporting a bug in Hugs\n\n1. If you evaluate \"test\",\n   then you get as expected \"Just True\".\n\n2. Now remove the \"Monad M\" constraint\n   in the class C2. [giving the class C3]\n   This is of course legal and semantics-preserving\n   since the monad constraints is implied by C1\n   anyway.\n\n3. Now evaluate \"test\" again. Oops, it diverges.\n\nI did this Hugs Version February 2001 under Solaris\nand Linux. Command line option -98 is needed of course.\nFunny enough, if CTRL-C the evaluation of \"test\"\nand you try it the second time (without reloading\nanything etc.), then you see \"Program error: {_Gc Black\nHole}\". Of course, there is no such black hole.\n\nI extracted the above fragment from a huge problem.\nThe scheme is the following. It seems have to do\nwith multi-parameter classes. It definitely has to\ndo with multi-layered class hierarchies where one\nclass has a class-wide superclass, as C2 has C1 in\nthe example. It seems that the superclass is\nproperly propagated during type-inference/checking\nbut it is not properly propagated, as for as code\ndetermination in overloading resolution.\n\nPlease, let me know if I can be of further assistance.\nI am actually amazed how general this scheme is\n(3 classes, 2 parameters). How does it come that it\nwas not detected much earlier.\n\nAnyway, good luck,\nRalf\n\n\nP.S.: I have more problems in a larger application.\nCertain overloaded expressions diverge. I can recover\nfrom that usually by using explicit function types\nfor top-level functions, where again -- as in C1 above\n-- I repeat some constraints which are derivable. I was\nnot able to extract a simple program for that problem.\nBut I would be glad to help you by checking if the\nproblem is gone after you did the bug fix.\n\n\n--\nDr.-Ing. Ralf Laemmel\nCWI & VU, Amsterdam, The Netherlands\nhttp://www.cwi.nl/~ralf/\nhttp://www.cs.vu.nl/~ralf/\n\n-}\n", "num_lines": 85}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\n\n-- GHC 5.02 got this one wrong.\n\nmodule Main where\n\n-- Implicit parameters bug\n-- mbs@cse.ogi.edu 24-Oct-2001 22:21:27\n\nf :: (?x :: Int) => ((?x :: Int) => Int) -> Int -> Int\nf g y = if y == 0\n        then g\n        else let ?x = ?x + 1\n             in f g (y - 1)\n\nh :: (?x :: Int) => Int\nh = ?x\n\nmain = print (let ?x = 0 in f h 10)\n-- The result should be 10!\n\n", "num_lines": 22}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}\n\n-- Hugs (2001) diverges when evaluating main, unless (Monad m) is\n-- added as an extra superclass to C2, which should not be necessary.\n\nmodule Main where\n\nclass Monad m => C1 m x\n\nclass (C1 m x) => C2 m x where\n    c2 :: x -> m x\n\ninstance Monad m => C1 m Bool\n\ninstance C2 Maybe Bool where\n    c2 = return\n\ntest :: Maybe Bool\ntest = c2 True\n\nmain = print test\n\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             TypeSynonymInstances, FlexibleInstances #-}\n\n-- This bizarre program failed because TcSimplify built a loop of\n-- dictionaries, due to an obscure bug in the way in which superclasses\n-- were added\n\nmodule Main where\n\nimport Data.List\nimport Data.Map\n\nclass (Ord oid) => Object o oid | o -> oid where\n\ndata Access oid\n\nclass (Object o oid) => SecurityModel model o oid | model -> o\n\nclass (SecurityModel model o oid) => SecurityPolicy policy model o oid where\n    checkAccess :: policy -> model -> Access oid -> Bool\n    checkAccess _ _ _ = True\n    checkModel :: policy -> model -> Bool\n    checkModel _ _ = True\n\n------------------------------------------------------------\n-- The Linux instance\n------------------------------------------------------------\n\ntype LinuxObjectId = Either [String] String\n\ndata LinuxObject = File [String] deriving (Eq, Show)\n\ninstance Object LinuxObject LinuxObjectId\n\ndata LinuxSecurityModel =\n    LinuxSecurityModel { lsmObjectSet   :: Map LinuxObjectId LinuxObject }\n\n\n-- Now defined in Data.Map, don't think this affects the bug:\n-- instance (Show a, Show b) => Show (Map a b) where\n--     show fm = show (fmToList fm)\n\ninstance Show LinuxSecurityModel where\n    show lsm = \"LSM:\" ++ \"\\tObjects:  \" ++ show (lsmObjectSet lsm)\n\ninstance SecurityModel LinuxSecurityModel LinuxObject LinuxObjectId\n\ndata LinuxSecurityPolicy = LinuxSecurityPolicy\ninstance SecurityPolicy LinuxSecurityPolicy LinuxSecurityModel LinuxObject LinuxObjectId\n\nmodel :: Map LinuxObjectId LinuxObject\nmodel =  fromList [ (Left [], File []), (Left [\"home\"], File [\"home\"]) ]\n\n\n--      works\n-- model :: (LinuxObjectId, LinuxObject)\n-- model =  (Left [], File [])\n\nmain :: IO ()\nmain = do { putStrLn (show model) }\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This test checks in which way the type checker handles phantom types in\n-- RULES.  We would like these type variables to be generalised, but some\n-- versions of GHC instantiated them to `()', which seriously limited the\n-- applicability of such RULES.\n\nmodule Main (main)\nwhere\n\ndata T a = C\n\nfoo :: T a -> String\n{-# NOINLINE foo #-}\nfoo C = \"rewrite rule did NOT fire\"\n\n{-# RULES \n\n-- this rule will not fire if the type argument of `T' is constrained to `()'\n--\n\"foo/C\" foo C = \"rewrite rule did fire\"\n\n #-}\n\nmain = putStrLn $ foo (C :: T Int)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- Implicit parameters should not give rise to ambiguity.\n\nmodule Main (main) where\n\nfoo :: (?x :: [a]) => Int -> String\nfoo n = show (n + length ?x)\n\n\nmain = do { putStrLn (let ?x = [True,False] in foo 3) ;\n            putStrLn (let ?x = \"fred\"       in foo 4) }\n\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, TypeSynonymInstances, FlexibleInstances, ConstrainedClassMethods #-}\n\n-- Class ops that bind no new type variables\n\nmodule Main where\n\n        import Data.List( sort )\n\n        just = [Just \"fred\",Just \"bill\"]\n\n        main = do { putStrLn (let ?p = \"ok1\" in fc1);\n                    putStrLn (let ?p = \"ok2\" in fc2);\n                    putStrLn (show (fd1 just)) ;\n                    putStrLn (show (fd2 just)) }\n\n        -- This class has no tyvars in its class op context\n        -- One uses a newtype, the other a data type\n        class C1 a where\n            fc1 :: (?p :: String) => a;\n        class C2 a where\n            fc2 :: (?p :: String) => a;\n            opc :: a\n\n        instance C1 String where\n            fc1 = ?p;\n        instance C2 String where\n            fc2 = ?p;\n            opc = \"x\"\n\n        -- This class constrains no new type variables in\n        -- its class op context\n        class D1 a where\n            fd1 :: (Ord a) => [a] -> [a]\n        class D2 a where\n            fd2 :: (Ord a) => [a] -> [a]\n            opd :: a\n\n        instance D1 (Maybe a) where\n            fd1 xs = sort xs\n        instance D2 (Maybe a) where\n            fd2 xs = sort xs\n            opd = Nothing\n\n", "num_lines": 44}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- Like tcrun024, but cross module\n\nmodule Main where\n        import TcRun025_B\n\n        just = [Just \"fred\",Just \"bill\"]\n\n        main = do { putStrLn (let ?p = \"ok1\" in fc1);\n                    putStrLn (let ?p = \"ok2\" in fc2);\n                    putStrLn (show (fd1 just)) ;\n                    putStrLn (show (fd2 just)) }\n\n\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, TypeSynonymInstances, FlexibleInstances, ConstrainedClassMethods #-}\n\n-- Similar to tc024, but cross module\n\nmodule TcRun025_B where\n\n        import Data.List( sort )\n\n        -- This class has no tyvars in its class op context\n        -- One uses a newtype, the other a data type\n        class C1 a where\n            fc1 :: (?p :: String) => a;\n        class C2 a where\n            fc2 :: (?p :: String) => a;\n            opc :: a\n\n        instance C1 String where\n            fc1 = ?p;\n        instance C2 String where\n            fc2 = ?p;\n            opc = \"x\"\n\n        -- This class constrains no new type variables in\n        -- its class op context\n        class D1 a where\n            fd1 :: (Ord a) => [a] -> [a]\n        class D2 a where\n            fd2 :: (Ord a) => [a] -> [a]\n            opd :: a\n\n        instance D1 (Maybe a) where\n            fd1 xs = sort xs\n        instance D2 (Maybe a) where\n            fd2 xs = sort xs\n            opd = Nothing\n\n\n\n", "num_lines": 39}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n\n-- Crashed GHC 5.04 with tcTyC\n--      panic: tcSplitTyConApp forall x{-r6S-} :: *.\n--                              Main.L{-rr-} x{-r6S-}\n\n-- GHC 6.3: this is now an error (can do subsumption in patterns)\n\nmodule Main where\n\nnewtype FA c = FA (forall x . c x)\nnewtype L x = L [x]\n\nmy_nil = FA (L []) :: FA L\n\nsample :: String\nsample = case my_nil of FA (L x) -> \"foo\"++x\n\n-- -- but this works fine\n-- sample = case my_nil of FA x -> case x of L y -> \"foo\"++y\n\nmain = print sample\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams #-}\n\n-- Killed GHC 5.04.1\n\nmodule Main where\n\ntype CTPar = ([Double],Int)\n\nus :: (?ctPar :: CTPar) => [Double]\nus = let (d,_) = ?ctPar in d\n\nmain = let ?ctPar = ([3.4],2) in print us \n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -dcore-lint #-}\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, UndecidableInstances #-}\n\n-- This is a rather exotic functional-dependency test.\n-- It crashed GHC 5.04.3 with a core-lint error, because\n-- of a bug in tcSimplifyRestricted (fixed Apr 03)\n\nmodule Main where\n\n\nclass ComposePS a b c | a b -> c where\n    (.>) :: PSOp a -> PSOp b -> PSOp c\n    (V a) .> (V b) = V (a ++ b)\n\ninstance (ConcatPS a b c, CheckPS c Id Id d) => ComposePS a b d\n\n------------------------------------------------------------------------------\n\ndata PSOp a = V [String] deriving Show\n\ndata Id\ndata Push t rest\ndata Pop t rest\n\n\nclass Reverse a b c | a b -> c\ninstance                           Reverse Id b b\ninstance Reverse a (Pop t b)  c => Reverse (Pop t a) b c\ninstance Reverse a (Push t b) c => Reverse (Push t a) b c\n\n------------------------------------------------------------------------------\n\nclass ConcatPS a b c | a b -> c where\n    ccat :: a -> b -> c\ninstance ConcatPS Id a a\ninstance ConcatPS a b c => ConcatPS (Pop t a) b (Pop t c)\ninstance ConcatPS a b c => ConcatPS (Push t a) b (Push t c)\n\n------------------------------------------------------------------------------\n\nclass CheckPS a b c d | a b c -> d where\n    check :: a -> b -> c -> d\n    check _ _ _ = error \"oki\"\n\ninstance Reverse a b c => CheckPS Id a b c\n\ninstance CheckPS a b (Push t c) d => CheckPS (Push t a) b c d\n\ninstance CheckPS a (Pop t b) Id d => CheckPS (Pop t a) b Id d\n\ninstance CheckPS a b c d => CheckPS (Pop t a) b (Push t c) d\n\n\nv1 :: PSOp (Pop a Id)\nv1 = V []\n\nv2 :: PSOp Id\nv2 = V []\n\nt = v1 .> v2\n\nmain = print t\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DatatypeContexts #-}\n-- Killed GHC 5.02.3\n\n-- Confusion about whether the wrapper for a data constructor\n-- with a \"stupid context\" includes the stupid context or not\n-- Core lint catches it, but it seg-faults if it runs\n\nmodule Main where\n\ndata Color = Red\n           | Black\n             deriving Show\n\ndata Ord k => Tree k d = None\n                       | Node{color::Color,\n                              key::k,\n                              item::d,\n                              left::(Tree k d),\n                              right::(Tree k d)}\n                         deriving Show\n\ninsert k i t = (insert2 t) {color=Black}\n    where insert2 None = Node{color=Red,\n                              key=k,\n                              item=i,\n                              left=None,\n                              right=None}\n\nmain = print (insert 1 2 None)\n", "num_lines": 30}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances #-}\n\n-- Test recursive dictionaries\n\nmodule Main where\n\ndata D r = ZeroD | SuccD (r (D r));\n\ninstance (Eq (r (D r))) => Eq (D r) where\n    ZeroD     == ZeroD     = True\n    (SuccD a) == (SuccD b) = a == b\n    _         == _         = False;\n\nequalDC :: D [] -> D [] -> Bool;\nequalDC = (==);\n\nfoo :: D []\nfoo = SuccD [SuccD [ZeroD], ZeroD]\n\nmain = print (foo == foo)\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}\n\n-- A newtype-deriving test\n\nmodule Main where\n\nclass C a b where\n  op :: a -> b -> b\ninstance C [a] Char where\n  op [] x = x\n  op _  x = 'z'\n\nnewtype T = T Char deriving( Show, C [a] )\n\nmain = do { print (op [] 'x')\n          ; print (op [] (T 'y')) }\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UndecidableInstances #-}\n\n-- This tests the recursive-dictionary stuff.\n\nmodule Main where\n\ndata Fix f = In (f (Fix f))\n\ninstance Show (f (Fix f)) => Show (Fix f) where\n  show (In x) = \"In \" ++ show x -- No parens, but never mind\n\ninstance Eq (f (Fix f)) => Eq (Fix f) where\n  (In x) == (In y) = x==y\n\ndata L x = Nil | Cons Int x  deriving( Show, Eq )\n\nmain = do { print (In Nil);\n            print (In Nil == In Nil) }\n\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,\n             UndecidableInstances, TypeSynonymInstances #-}\n\n-- This test made GHC 6.3 build a superclass loop, in\n-- the instance ClassA a String declaration\n\nmodule Main where\n\nclass (Sat (a -> b -> String), ClassB b) => ClassA a b\n\nclass ClassB a where\n  fun :: a -> String\n\nclass Sat x where\n   sat :: x\n\ninstance ClassA a b => Sat (a -> b -> String) where\n  sat = const fun\n\ninstance ClassA a String\n-- Badness was that the ClassB superclass dict was loopy\n--\n-- Needs Sat (a -> String -> String), ClassB String\n-- --> ClassA a String, ClassB String\n-- and adding ClassA gives superclass ClassB.\n\ninstance ClassB String where\n  fun = id\n\nmain = print ((sat :: Int -> String -> String) 3 \"hello\")\n", "num_lines": 32}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitForAll, TypeOperators #-}\n\nmodule Main where\n\n-- Infix type operator\nf1 :: forall m a b. (a `m` b) -> ((a `m` b) -> a) -> a\nf1 x g = g x\n\n-- Infix type operator..  Commented out because we no longer \n-- infix operators to be variables; they are type constructors\n-- f2 :: forall a b (-->). (a --> b) -> ((a --> b) -> b) -> b\n-- f2 x g = g x\n\nmain = do { print (f1 (3,5) fst) \n--        ; print (f2 (3,5) snd)\n          }\n\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n\n-- Tests subsumption for infix operators (in this case (.))\n-- Broke GHC 6.4!\n\n-- Now it breaks the impredicativity story\n--   (id {a}) . (id {a}) :: a -> a\n-- And (forall m. Monad m => m a) /~ IO a\n\nmodule Main(main) where\n\nfoo :: (forall m. Monad m => m a) -> IO a\nfoo = id . id\n\nmain :: IO ()\nmain = foo (return ())\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n\n-- Another test for the new feature that contexts in a mutually\n-- recursive group do not need to be of the same length\n-- I'm putting it here mainly to document the need\n\n-- GHC used to say:\n-- \n-- Bug.lhs:23:10:\n--     Inferred type is less polymorphic than expected\n--      Quantified type variable `c' is mentioned in the environment:\n--        printCatalog :: c -> IO () (bound at Bug.lhs:28:0)\n--    In the `viewCatalog' field of a record\n\n-- Bug.lhs:27:0:\n--    Contexts differ in length\n--    When matching the contexts of the signatures for\n--      printer :: Viewer\n--      printCatalog :: forall c. (Catalog c) => View c\n--    The signature contexts in a mutually recursive group should all be identical\n\nmodule Main where\n\nimport Prelude hiding (traverse)\n\nclass Catalog c where\n  mtraverse :: c -> Viewer -> IO ()\n\ninstance Catalog Int where\n  mtraverse i v = viewShowable v i\n\ntype View a = a -> IO ()\n\ndata Viewer = Viewer {\n    viewShowable :: forall s. Show s => View s,\n    viewCatalog :: forall c. Catalog c => View c\n  }\n\nprinter :: Viewer\n--printer = Viewer {\n--  viewCatalog = \\x -> mtraverse x printer,\n--  viewShowable = putStrLn . show }\nprinter = Viewer {\n  viewCatalog = printCatalog,\n  viewShowable = putStrLn . show }\n\nprintCatalog :: forall c. Catalog c => View c\nprintCatalog x = mtraverse x printer\n\ndata X = X {\n    cat :: Int\n  }\n\ninstance Catalog X where\n  mtraverse x v = do\n    viewCatalog v (cat x)\n\nmain = do\n  let x = X { cat = 20 }\n  mtraverse x printer\n", "num_lines": 61}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ConstrainedClassMethods #-}\n\nmodule Main where\n\nclass C a where\n  op :: (Show a, Show b) => a -> b -> String\n        -- This class op has local quantification, but\n        -- also adds a constraint on 'a'\n\ninstance C Bool where\n  op x y = show x ++ \" \" ++ show y\n\nmain = do { putStrLn (op True 'x'); putStrLn (op False (3::Int)) }\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport TcRun038_B( Foo(..), bar )\n\ninstance Foo Int where\n  op x = x+1\n\nmain = print (bar (3::Int))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n\nmodule TcRun038_B where\n\nclass Foo a where\n  op :: a -> Int\n\n-- Note the (Foo Int) constraint here; and the fact\n-- that there is no (Foo Int) instance in this module\n-- It's in the importing module!\n\nbar :: Foo Int => Int -> Int\nbar x = op x + 7\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, ExplicitForAll #-}\n\n-- Test for GADTs and implication constraints\n\nmodule Main where\n\ndata T a where\n  MkT :: Num a => a -> T a\n\nf :: Read a => T a -> String -> a\nf (MkT n) s = n + read s\n\n----------------\ndata GADT a where\n  MkG :: Num a => a -> GADT [a]\n\ng :: forall b. Read b => GADT b -> String -> b\ng (MkG n) s = -- Here we know Read [b]\n              n : (read s)\n\nmain = do print (f (MkT (3::Int)) \"4\")\n          print (g (MkG (3::Int)) \"[4,5]\")\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Sven Panne found this example; a mistake in typechecking \n-- lazy patterns made functions too strict in a version of\n-- GHC 6.7\n\nmodule Main where\n\nimport Foreign\n\n-- Strangely enough, this works if newtype is used...\ndata Elem a = Elem a\n\ninstance Storable a => Storable (Elem a) where\n   sizeOf ~(Elem r) = 3 * sizeOf r\n   alignment ~(Elem r) = alignment r\n   peek ptr = do r <- peekElemOff (castPtr ptr) 0; return (Elem r)\n   poke ptr (Elem r) = poke (castPtr ptr) r\n\nmain :: IO ()\nmain = do\n   putStrLn \"*** main 1\"\n   allocaBytes 100 $ \\buf -> do\n      poke buf (Elem 12345)\n      putStrLn \"*** main 2\"\n      Elem x <- peekElemOff buf 0\n      print (x :: Int)\n      putStrLn \"*** main 3\"\n\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections, UnboxedTuples #-}\nmodule Main where\n\na :: Int -> (Int, Bool)\na = ( , True)\n\nb :: Bool -> (Int, Bool)\nb = (1, )\n\nc :: a -> (a, Bool)\nc = (, True || False)\n\nd = (,1,)\n\n\ne = (# , True #)\n\nf = (# 1, #)\n\ng = (# , True || False #)\n\nh = (# ,1, #)\n\n\nunchanged :: a -> (# Int #)\nunchanged _binding = (# 1 #)\n\nmain = do\n    print (a 1, b False, c \"Hello\", c 1337, d \"Yeah\" \"Baby\")\n    case e 1 of { (# x1, x2 #) ->\n    case f False of { (# x3, x4 #) ->\n    case g \"Hello\" of { (# x5, x6 #) ->\n    case g 1337 of { (# x7, x8 #) ->\n    case h \"Yeah\" \"Baby\" of { (# x9, x10, x11 #) ->\n    print (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) }}}}}\n\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections, RankNTypes, ImpredicativeTypes #-}\n\n-- Sept 16: This test involves wholesale use of impredicative polymorphism\n--          and I'm amazed it has worked for so long. Anyway it is now\n--          failing, which is OK.  We don't really support impredicative\n--          polymorphism!\n--\n-- The test was added by Max in 5e8ff849, apparently to test tuple sections\n\nmodule Main where\n\ne :: a -> (forall b. b -> b -> b) -> (a, String, forall c. c -> c -> c)\ne = (,\"Hello\" ++ \"World\",)\n\ndropFunction :: (a, String, forall c. c -> c -> c) -> (a, String, Int)\ndropFunction (x, y, z) = (x, y, z 10 20)\n\nmain = print (dropFunction $ e \"Meh\" (flip const), dropFunction $ e 10 const)\n", "num_lines": 19}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, TypeFamilies, ConstraintKinds #-}\n\nimport GHC.Exts ( Constraint )\n\ntype Showish = Show\n\nf :: (Showish a) => a -> String\nf x = show x ++ show x\n\n\ndata T = T\ndata F = F\n\ndata GADT a where\n    Tish :: GADT T\n    Fish :: GADT F\n\ntype family Indexed a b :: Constraint\ntype instance Indexed T b = Show b\ntype instance Indexed F b = Num b\n\ng :: (Indexed a b) => GADT a -> b -> Either String b\ng Tish x = Left (show x)\ng Fish x = Right (x + 1)\n\n\ntype TwoConstraints a = (Show a, Num a)\n\n-- We'll NOINLINE h so that we test the code generation for\n-- constraint tuples\n{-# NOINLINE h #-}\nh :: TwoConstraints a => a -> String\nh x = show (x + 1)\n\n\nmain :: IO ()\nmain = do\n    print $ f 9\n    print $ f True\n\n    print $ g Tish 10\n    print $ g Tish False\n    print $ g Fish 11\n    print $ g Fish 12.0\n\n    print $ h 13\n    print $ h 14.0\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds #-}\n\nimport qualified Data.Set as S\nimport GHC.Exts ( Constraint )\n\nclass RMonad m where\n    type RMonadCtxt m a :: Constraint\n    returnR :: (RMonadCtxt m a) => a -> m a\n    bindR :: (RMonadCtxt m a, RMonadCtxt m b) => m a -> (a -> m b) -> m b\n\n\ninstance RMonad [] where\n    type RMonadCtxt [] a = ()\n    returnR x = [x]\n    bindR = flip concatMap\n\n\ninstance RMonad S.Set where\n    type RMonadCtxt S.Set a = Ord a\n    returnR x = S.singleton x\n    bindR mx fxmy = S.fromList [y | x <- S.toList mx, y <- S.toList (fxmy x)]\n\n\nmain = do\n    print $ (returnR 1 ++        returnR 2) `bindR`\n            (\\x -> returnR (x + 1) ++        returnR (x + 2))\n    print $ (returnR 1 `S.union` returnR 2) `bindR`\n            (\\x -> returnR (x + 1) `S.union` returnR (x + 2))\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, FlexibleContexts #-}\n\n-- !!! Implicit parameter superclass constraint\n-- These examples actually crashed GHC 4.08.2\n\nmodule Main where\n\nclass C t where\n    methodC :: t -> t\n\ninstance (?imp :: Int) => C Int where\n    methodC x = ?imp + x\n\n-- Check implicit parameter constraints in instance heads\ntest1 :: Int\ntest1 = methodC 10\n  where ?imp = 2\n\ntest2 :: (?imp :: Int) => Int\ntest2 = methodC 20\n  where ?imp = 2\n\n\nclass (?imp :: Int) => D t where\n    methodD :: t -> t\n\ninstance (?imp :: Int) => D Int where\n    methodD x = x + ?imp\n\n-- Check implicit parameter constraints in *superclass*, not just in instances\ntest3 :: Int\ntest3 = methodD 10\n  where ?imp = 2\n\ntest4 :: (?imp :: Int) => Int\ntest4 = methodD 20\n  where ?imp = 2\n\ntest5 :: D Int => Int -- Requires FlexibleContexts\ntest5 = methodD ?imp\n\nmain = do\n    print test1\n    print $ let ?imp = 3 in test2\n    print test3\n    print $ let ?imp = 3 in test4\n    print $ let ?imp = 3 in test5\n", "num_lines": 48}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, ConstraintKinds, GADTs #-}\n\nmodule Main where\n\n-- Here we abstract over a *constraint*!\n-- T :: Constraint -> *\n\ndata T a where\n  MkT :: a => T a\n\nf :: T (Ord x) -> x -> Bool\nf MkT x = x > x\n\ng :: T (Ord Int)\ng = MkT\n\nmain = print (f g 4)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\n-- !!! Check that unboxed tuples can be function arguments\nmodule Main where\n\ndata Ex = Ex (# Int,Int #)\n\n{-# NOINLINE f #-} -- Make it harder to get right\nf :: (# Int,Int #) -> Int\nf x = error \"urk\"\n\n{-# NOINLINE g #-} -- Make it harder to get right\ng (Ex (# x,y #)) = x\n\n\nmain = print $ g (Ex (# 10, f (# 20, 30 #) #))", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash, UnboxedTuples #-}\n\nmodule Main where\n\nimport GHC.Prim (Int#, Double#)\n\nmain :: IO ()\nmain = let f = int2Integer# 0# in putStrLn \"\"\n\n\n{-# NOINLINE int2Integer# #-}\nint2Integer# :: Int# -> (# Int#, Double# #)\nint2Integer# x = (# x, 1.0## #)\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\ntype T a = Int -> (# Int, Int #)\n\n{-# NOINLINE f2 #-}\nf2 :: T a -> T a\nf2 t = \\x -> case t x of _ -> (# 3,4 #) -- NB: wildcard has unboxed tuple type\n\nmain = print $ case f2 (\\x -> (# x, x + 1 #)) 10 of (# y, z #) -> y + z", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\ntype T a = Int -> (# Int, Int #)\n\n{-# NOINLINE g #-}\n--g :: (# Int, Int #) -> (# Int, Int #)\ng t =  case t of r -> (r :: (# Int, Int #)) \n\n{-# NOINLINE f #-}\nf :: T a -> T a\nf t = \\x -> case t x of r -> r\n\n\nmain = print $ case f (\\x -> g (# x, x + 1 #)) 10 of (# y, z #) -> y + z", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\n-- Tests unboxed tuple slow calls\n\n{-# NOINLINE g #-}\ng :: Int -> (# Int, Int #) -> Int -> (# Int, (# Int #) #) -> (# #) -> Int\ng a (# b, c #) d (# e, (# f #) #) (# #) = a + b + c + d + e + f\n\n{-# NOINLINE h #-}\nh :: (Int -> (# Int, Int #) -> Int -> (# Int, (# Int #) #) -> (# #) -> Int) -> (Int, Int)\nh g = (g5, g5')\n  where\n    -- Apply all the arguments at once\n    g5' = g 1 (# 2, 3 #) 4 (# 5, (# 6 #) #) (# #)\n\n    -- Try to force argument-at-a-time application as a stress-test\n    g1 = g 1\n    g2 = g1 `seq` g1 (# 2, 3 #)\n    g3 = g2 `seq` g2 4\n    g4 = g3 `seq` g3 (# 5, (# 6 #) #)\n    g5 = g4 `seq` g4 (# #)\n\n\nmain = print $ h g", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}\nmodule Main(main) where\nimport GHC.TypeLits as L\nimport Data.Proxy\n\n--------------------------------------------------------------------------------\n-- Test top-reactions\n\ntsub :: Proxy (x + y) -> Proxy y -> Proxy x\ntsub _ _ = Proxy\n\ntsub2 :: Proxy (x + y) -> (Proxy x, Proxy y)\ntsub2 _ = (Proxy, Proxy)\n\ntdiv :: Proxy (x L.* y) -> Proxy y -> Proxy x\ntdiv _ _ = Proxy\n\ntdiv2 :: Proxy (x L.* y) -> (Proxy x, Proxy y)\ntdiv2 _ = (Proxy, Proxy)\n\ntroot :: Proxy (x ^ y) -> Proxy y -> Proxy x\ntroot _ _ = Proxy\n\ntlog :: Proxy (x ^ y) -> Proxy x -> Proxy y\ntlog _ _ = Proxy\n\ntleq :: ((x <=? y) ~ True) => Proxy y -> Proxy x\ntleq _ = Proxy\n\nmain :: IO ()\nmain = print [ sh (tsub  (Proxy :: Proxy 5) (Proxy :: Proxy 3)) == \"2\"\n             , let (p, q) = tsub2 (Proxy :: Proxy 0)\n               in (sh p, sh q) == (\"0\", \"0\")\n             , sh (tdiv  (Proxy :: Proxy 8) (Proxy :: Proxy 2)) == \"4\"\n             , let (p, q) = tdiv2 (Proxy :: Proxy 1)\n               in (sh p, sh q) == (\"1\", \"1\")\n             , sh (troot (Proxy :: Proxy 9) (Proxy :: Proxy 2)) == \"3\"\n             , sh (tlog  (Proxy :: Proxy 8) (Proxy :: Proxy 2)) == \"3\"\n             , sh (tleq  (Proxy :: Proxy 0))                    == \"0\"\n             ]\n  where\n  sh x = show (natVal x)\n", "num_lines": 43}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-}\nmodule Main(main) where\nimport GHC.TypeLits\nimport Data.Proxy\n\n--------------------------------------------------------------------------------\n-- Test top-reactions\n\ntappend :: Proxy (AppendSymbol x y) -> Proxy x -> Proxy y\ntappend _ _ = Proxy\n\ntappend2 :: Proxy (AppendSymbol x y) -> (Proxy x, Proxy y)\ntappend2 _ = (Proxy, Proxy)\n\nmain :: IO ()\nmain = print [ symbolVal (tappend (Proxy :: Proxy \"abc\") (Proxy :: Proxy \"ab\"))\n               == \"c\"\n             , let (p, q) = tappend2 (Proxy :: Proxy \"\")\n               in (symbolVal p, symbolVal q) == (\"\", \"\")\n             ]\n  where\n  sh x = show (natVal x)\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             FlexibleInstances, FlexibleContexts,\n             OverlappingInstances, UndecidableInstances #-}\n\n--\n-- Test case adopted from the HList library\n-- http://www.cwi.nl/~ralf/HList/\n--\n-- Tests functional dependencies, overlapping instances....\n\nmodule Main where\n\n\n--\n-- Type-level Booleans; nothing weird\n--\ndata HTrue; hTrue :: HTrue; hTrue = undefined\ndata HFalse; hFalse :: HFalse; hFalse = undefined\nclass HBool x; instance HBool HTrue; instance HBool HFalse\ninstance Show HTrue where show _ = \"HTrue\"\ninstance Show HFalse where show _ = \"HFalse\"\n\n\n--\n-- Value-level incarnation; nothing too weird.\n-- Rely on lazy show for type-level Booleans\n--\ntypeEq :: TypeEq t t' b => t -> t' -> b\ntypeEq = undefined\n\n\n--\n-- Type-level cast\n--\nclass TypeCast   a b   | a -> b, b->a   where typeCast   :: a -> b\nclass TypeCast'  t a b | t a -> b, t b -> a where typeCast'  :: t->a->b\nclass TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b\ninstance TypeCast'  () a b => TypeCast a b where typeCast x = typeCast' () x\ninstance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''\ninstance TypeCast'' () a a where typeCast'' _ x  = x\n \n\n--\n-- Type-level type equality\n--\n\nclass TypeEq' () x y b => TypeEq x y b | x y -> b\nclass TypeEq' q x y b | q x y -> b\nclass TypeEq'' q x y b | q x y -> b\ninstance TypeEq' () x y b => TypeEq x y b\n-- This instance used to work <= GHC 6.2\n-- instance TypeEq' () x x HTrue\n-- There were some problems however with GHC CVS 6.3.\n-- So we favour the following, more stable (?) instance instead.\ninstance TypeCast b HTrue => TypeEq' () x x b\ninstance TypeEq'' q x y b => TypeEq' q x y b\ninstance TypeEq'' () x y HFalse\n\n\n--\n-- Let's test.\n-- The following should print \"(HTrue,HFalse)\".\n--\n\nmain = print $ ( typeEq \"42\" \"88\"\n               , typeEq \"42\" (42::Int)\n               )\n", "num_lines": 69}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE PolyKinds #-}\n\nimport qualified Data.ByteString as BS\nimport Type.Reflection\nimport Data.Binary\nimport GHCi.TH.Binary ()\n\nimport GHC.Exts\nimport Data.Kind\nimport Data.Proxy\n\ntestRoundtrip :: Typeable a => TypeRep a -> IO ()\ntestRoundtrip rep\n  | rep /= rep' = putStrLn $ \"bad: \" ++ show rep ++ \" /= \" ++ show rep'\n  | otherwise   = putStrLn $ \"good: \" ++ show rep\n  where\n    rep' = decode (encode rep)\n\nmain :: IO ()\nmain = do\n    testRoundtrip (typeRep :: TypeRep Int)\n    testRoundtrip (typeRep :: TypeRep Int#)\n    testRoundtrip (typeRep :: TypeRep IO)\n    testRoundtrip (typeRep :: TypeRep Maybe)\n    testRoundtrip (typeRep :: TypeRep TYPE)\n    testRoundtrip (typeRep :: TypeRep RuntimeRep)\n    testRoundtrip (typeRep :: TypeRep 'IntRep)\n    testRoundtrip (typeRep :: TypeRep (->))\n    testRoundtrip (typeRep :: TypeRep (Proxy Int))\n    testRoundtrip (typeRep :: TypeRep (Proxy Int#))\n    testRoundtrip (typeRep :: TypeRep Type)\n    testRoundtrip (typeRep :: TypeRep (Int -> Int))\n    testRoundtrip (typeRep :: TypeRep 5)\n    testRoundtrip (typeRep :: TypeRep \"hello world\")\n    testRoundtrip (typeRep :: TypeRep ('Just 5))\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds #-}\n\nimport Type.Reflection\nimport Data.Kind\n\ndata ComposeK (f :: k' -> Type) (g :: k -> k') a = ComposeK (f (g a))\n\nmain :: IO ()\nmain = do\n    let x :: ComposeK Maybe Maybe Int\n        x = undefined\n\n    App x y <- pure $ typeOf x\n    print (x, y)\n\n    App x y <- pure x\n    print (x, y)\n\n    App x y <- pure x\n    print (x, y)\n\n    App x y <- pure x   -- This makes GHC panic\n    print (x, y)\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PolyKinds, TypeFamilies #-}\n\n-- | Test equality predicates of Type.Reflection.\nmodule Main where\n\nimport Type.Reflection\nimport Data.Kind\nimport Data.Maybe\nimport Data.Proxy\nimport Data.Functor.Const\nimport Data.Functor.Product\n\n--data Product (f :: k -> Type) (g :: k -> Type) (a :: k)\n--    = Product (f x) (g x)\n\ntest1 :: IO ()\ntest1 = do\n    let x = typeRep :: TypeRep (Maybe String)\n        y = typeRep :: TypeRep (Maybe Int)\n\n    checkEq False x y\n    App maybe1 _ <- pure x\n    App maybe2 _ <- pure y\n    checkEq True maybe1 maybe2\n\n\ntest2 :: IO ()\ntest2 = do\n    let x = typeRep :: TypeRep (Proxy String)\n        y = typeRep :: TypeRep (Proxy Int)\n\n    checkEq False x y\n    App proxy1 _ <- pure x\n    App proxy2 _ <- pure y\n    checkEq True proxy1 proxy2\n\n\ntest3 :: IO ()\ntest3 = do\n    let x = typeRep :: TypeRep (Product (Const String) (Const Int) Int)\n        y = typeRep :: TypeRep (Product (Const String) (Const Char) Int)\n    checkEq False x y\n    App dx _ <- pure x   -- \"d\" stands for decomposed\n    App dy _ <- pure y\n    checkEq False dx dy\n    App ddx _ <- pure dx\n    App ddy _ <- pure dy\n    checkEq True ddx ddy\n\n\ntest4 :: IO ()\ntest4 = do\n    let x = typeRep :: TypeRep (Product (Const String) (Const Int) Int)\n        y = typeRep :: TypeRep (Product (Const String) (Const Int) Char)\n\n    checkEq False x y\n    App dx _ <- pure x\n    App dy _ <- pure y\n    checkEq True dx dy\n    App ddx _ <- pure dx\n    App ddy _ <- pure dy\n    checkEq True ddx ddy\n\n\nmain :: IO ()\nmain = sequence_ [test1, test2, test3, test4]\n\ntype IsEqual = Bool\n\ncheck :: Bool -> String -> IO ()\ncheck success msg = putStrLn $ goodBad ++ \" \" ++ msg\n  where goodBad\n          | success    = \"good\"\n          | otherwise  = \"bad \"\n\ncheckEq :: IsEqual -> TypeRep a -> TypeRep b -> IO ()\ncheckEq expected a b =\n    check success (show a ++ \" == \" ++ show b ++ \"?\")\n  where success = isJust (a `eqTypeRep` b) == expected\n", "num_lines": 80}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, UnicodeSyntax #-}\n{-# OPTIONS -Wno-star-is-type #-}\n\nimport Data.Typeable\nimport GHC.Types\n\n-- Test that Typeable works for various wired-in types.\n-- See, for instance, #11120.\n\nmain :: IO ()\nmain = do\n  print $ typeOf \"hello world\"\n  print $ typeOf '4'\n  print $ typeOf (42 :: Int)\n  print $ typeOf (42 :: Word)\n  print $ typeOf (3.1415 :: Double)\n  print $ typeOf (return () :: IO ())\n  print $ typeOf ('a', 1::Int, \"hello\")\n  print $ typeOf (typeOf \"hi\")\n  print $ typeOf True\n  print $ typeOf EQ\n  print $ typeOf (id :: Int -> Int)\n\n  print $ typeOf (Proxy :: Proxy (Eq Int))\n  print $ typeOf (Proxy :: Proxy (Int, Int))\n  print $ typeOf (Proxy :: Proxy \"hello world\")\n  print $ typeOf (Proxy :: Proxy 1)\n  print $ typeOf (Proxy :: Proxy [1,2,3])\n  print $ typeOf (Proxy :: Proxy 'EQ)\n  print $ typeOf (Proxy :: Proxy TYPE)\n  print $ typeOf (Proxy :: Proxy (TYPE 'LiftedRep))\n  print $ typeOf (Proxy :: Proxy *)\n  print $ typeOf (Proxy :: Proxy \u00e2\u02dc\u2026)\n  print $ typeOf (Proxy :: Proxy 'LiftedRep)\n  print $ typeOf (Proxy :: Proxy '(1, \"hello\"))\n  print $ typeOf (Proxy :: Proxy (~~))\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE PolyKinds #-}\n{-# LANGUAGE UnboxedTuples #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE TypeOperators #-}\n{-# LANGUAGE StarIsType #-}\n{-# LANGUAGE UnicodeSyntax #-}\n\n{-# OPTIONS -Wno-star-is-type #-}\n\nimport Data.Typeable\nimport Data.Kind\nimport GHC.Exts\n\n-- Test that Typeable works for various wired-in types.\n-- See, for instance, #11120.\n\nrep :: forall a. Typeable a => TypeRep\nrep = typeRep (Proxy :: Proxy a)\n\nmain :: IO ()\nmain = do\n  -- the basics\n  print $ rep @String\n  print $ rep @Char\n  print $ rep @Int\n  print $ rep @Word\n  print $ rep @Double\n  print $ rep @(IO ())\n  print $ rep @IO\n  print $ rep @\"hi\"\n  print $ rep @(Char, Int, String)\n  print $ rep @Bool\n  print $ rep @Ordering\n  print $ rep @(Int -> Int)\n  print $ rep @((Eq Int, Eq String) :: Constraint)\n\n  -- Unboxed things (#12049)\n  print $ rep @Int#\n  print $ rep @(##)\n  print $ rep @(# Int#, Int #)\n\n  -- Various instantiations of a kind-polymorphic type\n  print $ rep @(Proxy (Eq Int))\n  print $ rep @(Proxy (Int, Int))\n  print $ rep @(Proxy \"hello world\")\n  print $ rep @(Proxy 1)\n  print $ rep @(Proxy [1,2,3])\n  print $ rep @(Proxy 'EQ)\n  print $ rep @(Proxy TYPE)\n  print $ rep @(Proxy (TYPE 'LiftedRep))\n  print $ rep @(Proxy *)\n  print $ rep @(Proxy \u00e2\u02dc\u2026)\n  print $ rep @(Proxy 'LiftedRep)\n\n  -- Something lifted and primitive\n  print $ rep @RealWorld  -- #12132\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, OverlappingInstances, Rank2Types,\n    KindSignatures, EmptyDataDecls, MultiParamTypeClasses, CPP #-}\n\n{-\n\n(C) 2004--2005 Ralf Laemmel, Simon D. Foster\n\nThis module approximates Data.Generics.Basics.\n\n-}\n\n\nmodule T1735_Help.Basics (\n\n module Data.Typeable,\n module T1735_Help.Context,\n module T1735_Help.Basics\n\n) where\n\nimport Data.Typeable\nimport T1735_Help.Context\n\n\n------------------------------------------------------------------------------\n-- The ingenious Data class\n\nclass (Typeable a, Sat (ctx a)) => Data ctx a\n\n   where\n\n     gfoldl :: Proxy ctx\n            -> (forall b c. Data ctx b => w (b -> c) -> b -> w c)\n            -> (forall g. g -> w g)\n            -> a -> w a\n\n     -- Default definition for gfoldl\n     -- which copes immediately with basic datatypes\n     --\n     gfoldl _ _ z = z\n\n     gunfold :: Proxy ctx\n             -> (forall b r. Data ctx b => c (b -> r) -> c r)\n             -> (forall r. r -> c r)\n             -> Constr\n             -> c a\n\n     toConstr :: Proxy ctx -> a -> Constr\n\n     dataTypeOf :: Proxy ctx -> a -> DataType\n\n     -- incomplete implementation\n\n     gunfold _ _ _ _ = undefined\n\n     dataTypeOf _ _ = undefined\n\n     -- | Mediate types and unary type constructors\n     dataCast1 :: Typeable t\n               => Proxy ctx\n               -> (forall b. Data ctx b => w (t b))\n               -> Maybe (w a)\n     dataCast1 _ _ = Nothing\n\n     -- | Mediate types and binary type constructors\n     dataCast2 :: Typeable t\n               => Proxy ctx\n               -> (forall b c. (Data ctx b, Data ctx c) => w (t b c))\n               -> Maybe (w a)\n     dataCast2 _ _ = Nothing\n\n\n\n------------------------------------------------------------------------------\n\n-- Generic transformations\n\ntype GenericT ctx = forall a. Data ctx a => a -> a\n\n\n-- Generic map for transformations\n\ngmapT :: Proxy ctx -> GenericT ctx -> GenericT ctx\n\ngmapT ctx f x = unID (gfoldl ctx k ID x)\n  where\n    k (ID g) y = ID (g (f y))\n\n\n-- The identity type constructor\n\nnewtype ID x = ID { unID :: x }\n\n\n------------------------------------------------------------------------------\n\n-- Generic monadic transformations\n\ntype GenericM m ctx = forall a. Data ctx a => a -> m a\n\n-- Generic map for monadic transformations\n\ngmapM :: Monad m => Proxy ctx -> GenericM m ctx -> GenericM m ctx\ngmapM ctx f = gfoldl ctx k return\n    where k c x = do c' <- c\n                     x' <- f x\n                     return (c' x')\n\n\n------------------------------------------------------------------------------\n\n-- Generic queries\n\ntype GenericQ ctx r = forall a. Data ctx a => a -> r\n\n\n-- Map for queries\n\ngmapQ :: Proxy ctx -> GenericQ ctx r -> GenericQ ctx [r]\ngmapQ ctx f = gmapQr ctx (:) [] f\n\ngmapQr :: Data ctx a\n       => Proxy ctx\n       -> (r' -> r -> r)\n       -> r\n       -> GenericQ ctx r'\n       -> a\n       -> r\ngmapQr ctx o r f x = unQr (gfoldl ctx k (const (Qr id)) x) r\n  where\n    k (Qr g) y = Qr (\\s -> g (f y `o` s))\n\n-- The type constructor used in definition of gmapQr\nnewtype Qr r a = Qr { unQr  :: r -> r }\n\n\n\n------------------------------------------------------------------------------\n--\n-- Generic unfolding\n--\n------------------------------------------------------------------------------\n\n\n\n-- | Build a term skeleton\nfromConstr :: Data ctx a => Proxy ctx -> Constr -> a\nfromConstr ctx = fromConstrB ctx undefined\n\n-- | Build a term and use a generic function for subterms\nfromConstrB :: Data ctx a\n            => Proxy ctx\n            -> (forall b. Data ctx b => b)\n            -> Constr\n            -> a\nfromConstrB ctx f = unID . gunfold ctx k z\n where\n  k c = ID (unID c f)\n  z = ID\n\n\n\n-- | Monadic variation on \\\"fromConstrB\\\"\nfromConstrM :: (Monad m, Data ctx a)\n            => Proxy ctx\n            -> (forall b. Data ctx b => m b)\n            -> Constr\n            -> m a\nfromConstrM ctx f = gunfold ctx k z\n where\n  k c = do { c' <- c; b <- f; return (c' b) }\n  z = return\n\n\n\n------------------------------------------------------------------------------\n--\n-- Datatype and constructor representations\n--\n------------------------------------------------------------------------------\n\n\n--\n-- | Representation of datatypes.\n-- | A package of constructor representations with names of type and module.\n-- | The list of constructors could be an array, a balanced tree, or others.\n--\ndata DataType = DataType\n                        { tycon   :: String\n                        , datarep :: DataRep\n                        }\n\n              deriving Show\n\n\n-- | Representation of constructors\ndata Constr = Constr\n                        { conrep    :: ConstrRep\n                        , constring :: String\n                        , confields :: [String] -- for AlgRep only\n                        , confixity :: Fixity   -- for AlgRep only\n                        , datatype  :: DataType\n                        }\n\ninstance Show Constr where\n show = constring\n\n\n-- | Equality of constructors\ninstance Eq Constr where\n  c == c' = constrRep c == constrRep c'\n\n\n-- | Public representation of datatypes\ndata DataRep = AlgRep [Constr]\n             | IntRep\n             | FloatRep\n             | StringRep\n             | NoRep\n\n            deriving (Eq,Show)\n\n\n-- | Public representation of constructors\ndata ConstrRep = AlgConstr    ConIndex\n               | IntConstr    Integer\n               | FloatConstr  Double\n               | StringConstr String\n\n               deriving (Eq,Show)\n\n\n--\n-- | Unique index for datatype constructors.\n-- | Textual order is respected. Starts at 1.\n--\ntype ConIndex = Int\n\n\n-- | Fixity of constructors\ndata Fixity = Prefix\n            | Infix  -- Later: add associativity and precedence\n\n            deriving (Eq,Show)\n\n\n------------------------------------------------------------------------------\n--\n-- Observers for datatype representations\n--\n------------------------------------------------------------------------------\n\n\n-- | Gets the type constructor including the module\ndataTypeName :: DataType -> String\ndataTypeName = tycon\n\n\n\n-- | Gets the public presentation of datatypes\ndataTypeRep :: DataType -> DataRep\ndataTypeRep = datarep\n\n\n-- | Gets the datatype of a constructor\nconstrType :: Constr -> DataType\nconstrType = datatype\n\n\n-- | Gets the public presentation of constructors\nconstrRep :: Constr -> ConstrRep\nconstrRep = conrep\n\n\n-- | Look up a constructor by its representation\nrepConstr :: DataType -> ConstrRep -> Constr\nrepConstr dt cr =\n      case (dataTypeRep dt, cr) of\n        (AlgRep cs, AlgConstr i)      -> cs !! (i-1)\n        (IntRep,    IntConstr i)      -> mkIntConstr dt i\n        (FloatRep,  FloatConstr f)    -> mkFloatConstr dt f\n        (StringRep, StringConstr str) -> mkStringConstr dt str\n        _ -> error \"repConstr\"\n\n\n\n------------------------------------------------------------------------------\n--\n-- Representations of algebraic data types\n--\n------------------------------------------------------------------------------\n\n\n-- | Constructs an algebraic datatype\nmkDataType :: String -> [Constr] -> DataType\nmkDataType str cs = DataType\n                        { tycon   = str\n                        , datarep = AlgRep cs\n                        }\n\n\n-- | Constructs a constructor\nmkConstr :: DataType -> String -> [String] -> Fixity -> Constr\nmkConstr dt str fields fix =\n        Constr\n                { conrep    = AlgConstr idx\n                , constring = str\n                , confields = fields\n                , confixity = fix\n                , datatype  = dt\n                }\n  where\n    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],\n                     showConstr c == str ]\n\n\n-- | Gets the constructors\ndataTypeConstrs :: DataType -> [Constr]\ndataTypeConstrs dt = case datarep dt of\n                        (AlgRep cons) -> cons\n                        _ -> error \"dataTypeConstrs\"\n\n\n-- | Gets the field labels of a constructor\nconstrFields :: Constr -> [String]\nconstrFields = confields\n\n\n-- | Gets the fixity of a constructor\nconstrFixity :: Constr -> Fixity\nconstrFixity = confixity\n\n\n\n------------------------------------------------------------------------------\n--\n-- From strings to constr's and vice versa: all data types\n--\n------------------------------------------------------------------------------\n\n\n-- | Gets the string for a constructor\nshowConstr :: Constr -> String\nshowConstr = constring\n\n\n-- | Lookup a constructor via a string\nreadConstr :: DataType -> String -> Maybe Constr\nreadConstr dt str =\n      case dataTypeRep dt of\n        AlgRep cons -> idx cons\n        IntRep      -> mkReadCon (\\i -> (mkPrimCon dt str (IntConstr i)))\n        FloatRep    -> mkReadCon (\\f -> (mkPrimCon dt str (FloatConstr f)))\n        StringRep   -> Just (mkStringConstr dt str)\n        NoRep       -> Nothing\n  where\n\n    -- Read a value and build a constructor\n    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr\n    mkReadCon f = case (reads str) of\n                    [(t,\"\")] -> Just (f t)\n                    _ -> Nothing\n\n    -- Traverse list of algebraic datatype constructors\n    idx :: [Constr] -> Maybe Constr\n    idx cons = let fit = filter ((==) str . showConstr) cons\n                in if fit == []\n                     then Nothing\n                     else Just (head fit)\n\n\n------------------------------------------------------------------------------\n--\n-- Convenience functions: algebraic data types\n--\n------------------------------------------------------------------------------\n\n\n-- | Test for an algebraic type\nisAlgType :: DataType -> Bool\nisAlgType dt = case datarep dt of\n                 (AlgRep _) -> True\n                 _ -> False\n\n\n-- | Gets the constructor for an index\nindexConstr :: DataType -> ConIndex -> Constr\nindexConstr dt idx = case datarep dt of\n                        (AlgRep cs) -> cs !! (idx-1)\n                        _           -> error \"indexConstr\"\n\n\n-- | Gets the index of a constructor\nconstrIndex :: Constr -> ConIndex\nconstrIndex con = case constrRep con of\n                    (AlgConstr idx) -> idx\n                    _ -> error \"constrIndex\"\n\n\n-- | Gets the maximum constructor index\nmaxConstrIndex :: DataType -> ConIndex\nmaxConstrIndex dt = case dataTypeRep dt of\n                        AlgRep cs -> length cs\n                        _         -> error \"maxConstrIndex\"\n\n\n\n------------------------------------------------------------------------------\n--\n-- Representation of primitive types\n--\n------------------------------------------------------------------------------\n\n\n-- | Constructs the Int type\nmkIntType :: String -> DataType\nmkIntType = mkPrimType IntRep\n\n\n-- | Constructs the Float type\nmkFloatType :: String -> DataType\nmkFloatType = mkPrimType FloatRep\n\n\n-- | Constructs the String type\nmkStringType :: String -> DataType\nmkStringType = mkPrimType StringRep\n\n\n-- | Helper for mkIntType, mkFloatType, mkStringType\nmkPrimType :: DataRep -> String -> DataType\nmkPrimType dr str = DataType\n                        { tycon   = str\n                        , datarep = dr\n                        }\n\n\n-- Makes a constructor for primitive types\nmkPrimCon :: DataType -> String -> ConstrRep -> Constr\nmkPrimCon dt str cr = Constr\n                        { datatype  = dt\n                        , conrep    = cr\n                        , constring = str\n                        , confields = error $ concat [\"constrFields : \", (tycon dt), \" is primative\"]\n                        , confixity = error \"constrFixity\"\n                        }\n\n\nmkIntConstr :: DataType -> Integer -> Constr\nmkIntConstr dt i = case datarep dt of\n                  IntRep -> mkPrimCon dt (show i) (IntConstr i)\n                  _ -> error \"mkIntConstr\"\n\n\nmkFloatConstr :: DataType -> Double -> Constr\nmkFloatConstr dt f = case datarep dt of\n                    FloatRep -> mkPrimCon dt (show f) (FloatConstr f)\n                    _ -> error \"mkFloatConstr\"\n\n\nmkStringConstr :: DataType -> String -> Constr\nmkStringConstr dt str = case datarep dt of\n                       StringRep -> mkPrimCon dt str (StringConstr str)\n                       _ -> error \"mkStringConstr\"\n\n\n------------------------------------------------------------------------------\n--\n-- Non-representations for non-presentable types\n--\n------------------------------------------------------------------------------\n\n\n-- | Constructs a non-representation\nmkNorepType :: String -> DataType\nmkNorepType str = DataType\n                        { tycon   = str\n                        , datarep = NoRep\n                        }\n\n\n-- | Test for a non-representable type\nisNorepType :: DataType -> Bool\nisNorepType dt = case datarep dt of\n                   NoRep -> True\n                   _ -> False\n\n", "num_lines": 488}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UndecidableInstances, OverlappingInstances, EmptyDataDecls #-}\n\n{-\n\n(C) 2004 Ralf Laemmel\n\nContext parameterisation and context passing.\n\n-}\n\n\nmodule T1735_Help.Context\n\nwhere\n\n------------------------------------------------------------------------------\n\n--\n-- The Sat class from John Hughes' \"Restricted Data Types in Haskell\"\n--\n\nclass Sat a\n  where\n    dict :: a\n\n\n------------------------------------------------------------------------------\n\n-- No context\n\ndata NoCtx a\n\nnoCtx :: NoCtx ()\nnoCtx = undefined\n\ninstance Sat (NoCtx a) where dict = undefined\n\n\n------------------------------------------------------------------------------\n\n-- Pair context\n\ndata PairCtx l r a\n   = PairCtx { leftCtx  :: l a\n             , rightCtx :: r a }\n\npairCtx :: l () -> r () -> PairCtx l r ()\npairCtx _ _ = undefined\n\ninstance (Sat (l a), Sat (r a))\n      => Sat (PairCtx l r a)\n  where\n    dict = PairCtx { leftCtx  = dict\n                   , rightCtx = dict }\n\n\n------------------------------------------------------------------------------\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, FlexibleInstances, MultiParamTypeClasses,\n             UndecidableInstances, OverlappingInstances, CPP #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n-- This is a module full of orphans, so don't warn about them\n\nmodule T1735_Help.Instances () where\n\nimport T1735_Help.Basics\nimport Data.Typeable\n\ncharType :: DataType\ncharType = mkStringType \"Prelude.Char\"\n\ninstance Sat (ctx Char) =>\n         Data ctx Char where\n  toConstr _ x = mkStringConstr charType [x]\n  gunfold _ _ z c = case constrRep c of\n                      (StringConstr [x]) -> z x\n                      _ -> error \"gunfold Char\"\n  dataTypeOf _ _ = charType\n\nnilConstr :: Constr\nnilConstr    = mkConstr listDataType \"[]\" [] Prefix\nconsConstr :: Constr\nconsConstr   = mkConstr listDataType \"(:)\" [] Infix\nlistDataType :: DataType\nlistDataType = mkDataType \"Prelude.[]\" [nilConstr,consConstr]\n\ninstance (Sat (ctx [a]), Data ctx a) =>\n         Data ctx [a] where\n  gfoldl _ _ z []     = z []\n  gfoldl _ f z (x:xs) = z (:) `f` x `f` xs\n  toConstr _ []    = nilConstr\n  toConstr _ (_:_) = consConstr\n  gunfold _ k z c = case constrIndex c of\n                      1 -> z []\n                      2 -> k (k (z (:)))\n                      _ -> error \"gunfold List\"\n  dataTypeOf _ _ = listDataType\n  dataCast1 _ f = gcast1 f\n\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,\n             PatternSignatures, GADTs, RankNTypes, FlexibleContexts,\n             MultiParamTypeClasses, GeneralizedNewtypeDeriving,\n             DeriveDataTypeable,\n             OverlappingInstances, UndecidableInstances, CPP #-}\n\nmodule Main (main) where\n\nimport SYBWC.Basics\nimport Xml\n\ndata YesNo = Yes | No\n    deriving (Eq, Show, Typeable)\ninstance Sat (ctx YesNo) => Data ctx YesNo where\n    toConstr _ Yes = yesConstr\n    toConstr _ No  = noConstr\n    gunfold _ _ z c  = case constrIndex c of\n                           1 -> z Yes\n                           2 -> z No\n                           _ -> error \"Foo\"\n    dataTypeOf _ _ = yesNoDataType\nyesConstr :: Constr\nyesConstr = mkConstr yesNoDataType \"Yes\" [] Prefix\nnoConstr :: Constr\nnoConstr = mkConstr yesNoDataType \"No\" [] Prefix\nyesNoDataType :: DataType\nyesNoDataType = mkDataType \"YesNo\" [yesConstr, noConstr]\n\nnewtype MyList a = MkMyList { unMyList :: [a] }\n    deriving (Show, Eq, Typeable)\ninstance (Sat (ctx (MyList a)), Sat (ctx [a]), Data ctx a)\n      => Data ctx (MyList a) where\n    gfoldl _ f z x  = z MkMyList `f` unMyList x\n    toConstr _ (MkMyList _) = mkMyListConstr\n    gunfold _ k z c  = case constrIndex c of\n                           1 -> k (z MkMyList)\n                           _ -> error \"Foo\"\n    dataTypeOf _ _ = myListDataType\nmkMyListConstr :: Constr\nmkMyListConstr = mkConstr myListDataType \"MkMyList\" [] Prefix\nmyListDataType :: DataType\nmyListDataType = mkDataType \"MyList\" [mkMyListConstr]\n\n#ifdef FOO\nrigidTests :: Maybe (Maybe [YesNo])\nrigidTests =\n mkTest [Elem \"No\"  []] (Just [No])\n#endif\n\nrigidManualTests :: Maybe (Maybe (MyList YesNo))\nrigidManualTests =\n mkTest [Elem \"MkMyList\" [Elem \"Yes\" []]] (Just (MkMyList [Yes]))\n\nmkTest :: (Eq a, Xml a) => [Element] -> Maybe a -> Maybe (Maybe a)\nmkTest es v = case fromXml es of\n                  v' | v == v'   -> Nothing\n                     | otherwise -> Just v'\n\nmain :: IO ()\nmain = print rigidManualTests\n\n", "num_lines": 63}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule T1735_Help.State where\n\nimport Control.Monad (ap, liftM)\n\n\nnewtype StateT s m a = StateT { runStateT :: s -> m (a,s) }\n\ninstance Monad m => Monad (StateT s m) where\n    return a = StateT $ \\s -> return (a, s)\n    m >>= k  = StateT $ \\s -> do\n        ~(a, s') <- runStateT m s\n        runStateT (k a) s'\n    fail str = StateT $ \\_ -> fail str\n\ninstance Monad m => Functor (StateT s m) where\n    fmap = liftM\n\ninstance Monad m => Applicative (StateT s m) where\n    pure  = return\n    (<*>) = ap\n\nget :: Monad m => StateT s m s\nget = StateT $ \\s -> return (s, s)\n\nput :: Monad m => s -> StateT s m ()\nput s = StateT $ \\_ -> return ((), s)\n\n", "num_lines": 29}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,\n             GADTs, RankNTypes, FlexibleContexts, TypeSynonymInstances,\n             MultiParamTypeClasses, DeriveDataTypeable, PatternGuards,\n             OverlappingInstances, UndecidableInstances, CPP #-}\n\nmodule T1735_Help.Xml (Element(..), Xml, fromXml) where\n\nimport T1735_Help.Basics\nimport T1735_Help.Instances ()\nimport T1735_Help.State\n\ndata Element = Elem String [Element]\n             | CData String\n             | Attr String String\n\nfromXml :: Xml a => [Element] -> Maybe a\nfromXml xs = case readXml xs of\n             Just (_, v) -> return v\n             Nothing -> error \"XXX\"\n\nclass (Data XmlD a) => Xml a where\n    toXml :: a -> [Element]\n    toXml = defaultToXml\n\n    readXml :: [Element] -> Maybe ([Element], a)\n    readXml = defaultReadXml\n\n    readXml' :: [Element] -> Maybe ([Element], a)\n    readXml' = defaultReadXml'\n\ninstance (Data XmlD t, Show t) => Xml t\n\ndata XmlD a = XmlD { toXmlD :: a -> [Element], readMXmlD :: ReadM Maybe a }\n\nxmlProxy :: Proxy XmlD\nxmlProxy = error \"xmlProxy\"\n\ninstance Xml t => Sat (XmlD t) where\n    dict = XmlD { toXmlD = toXml, readMXmlD = readMXml }\n\ndefaultToXml :: Xml t => t -> [Element]\ndefaultToXml x = [Elem (constring $ toConstr xmlProxy x) (transparentToXml x)]\n\ntransparentToXml :: Xml t => t -> [Element]\ntransparentToXml x = concat $ gmapQ xmlProxy (toXmlD dict) x\n\n-- Don't do any defaulting here, as these functions can be implemented\n-- differently by the user. We do the defaulting elsewhere instead.\n-- The t' type is thus not used.\n\ndefaultReadXml :: Xml t => [Element] -> Maybe ([Element], t)\ndefaultReadXml es = readXml' es\n\ndefaultReadXml' :: Xml t => [Element] -> Maybe ([Element], t)\ndefaultReadXml' = readXmlWith readVersionedElement\n\nreadXmlWith :: Xml t\n            => (Element -> Maybe t)\n            -> [Element]\n            -> Maybe ([Element], t)\nreadXmlWith f es = case es of\n                       e : es' ->\n                           case f e of\n                               Just v -> Just (es', v)\n                               Nothing -> Nothing\n                       [] ->\n                           Nothing\n\nreadVersionedElement :: forall t . Xml t => Element -> Maybe t\nreadVersionedElement e = readElement e\n\nreadElement :: forall t . Xml t => Element -> Maybe t\nreadElement (Elem n es) = res\n    where resType :: t\n          resType = typeNotValue resType\n          resDataType = dataTypeOf xmlProxy resType\n          con = readConstr resDataType n\n          res = case con of\n                Just c -> f c\n                Nothing -> Nothing\n          f c =     let m :: Maybe ([Element], t)\n                        m = constrFromElements c es\n                    in case m of\n                           Just ([], x) -> Just x\n                           _ -> Nothing\nreadElement _ = Nothing\n\nconstrFromElements :: forall t . Xml t\n                   => Constr -> [Element] -> Maybe ([Element], t)\nconstrFromElements c es\n = do let st = ReadState { xmls = es }\n          m :: ReadM Maybe t\n          m = fromConstrM xmlProxy (readMXmlD dict) c\n      -- XXX Should we flip the result order?\n      (x, st') <- runStateT m st\n      return (xmls st', x)\n\ntype ReadM m = StateT ReadState m\n\ndata ReadState = ReadState {\n                     xmls :: [Element]\n                 }\n\ngetXmls :: Monad m => ReadM m [Element]\ngetXmls = do st <- get\n             return $ xmls st\n\nputXmls :: Monad m => [Element] -> ReadM m ()\nputXmls xs = do st <- get\n                put $ st { xmls = xs }\n\nreadMXml :: Xml a => ReadM Maybe a\nreadMXml\n = do xs <- getXmls\n      case readXml xs of\n          Nothing -> fail \"Cannot read value\"\n          Just (xs', v) ->\n              do putXmls xs'\n                 return v\n\ntypeNotValue :: Xml a => a -> a\ntypeNotValue t = error (\"Type used as value: \" ++ typeName)\n    where typeName = dataTypeName (dataTypeOf xmlProxy t)\n\n-- The Xml [a] context is a bit scary, but if we don't have it then\n-- GHC complains about overlapping instances\n\ninstance (Xml a {-, Xml [a] -}) => Xml [a] where\n    toXml = concatMap toXml\n    readXml = f [] []\n        where f acc_xs acc_vs [] = Just (reverse acc_xs, reverse acc_vs)\n              f acc_xs acc_vs (x:xs) = case readXml [x] of\n                                           Just ([], v) ->\n                                               f acc_xs (v:acc_vs) xs\n                                           _ ->\n                                               f (x:acc_xs) acc_vs xs\n\ninstance Xml String where\n    toXml x = [CData x]\n    readXml = readXmlWith f\n        where f (CData x) = Just x\n              f _ = Nothing\n\n", "num_lines": 144}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Type\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module TyCon where\n\nimport Unbound.Generics.LocallyNameless (Alpha (..))\nimport {-# SOURCE #-} Type   (TyName)\n\ndata AlgTyConRhs\n  = NewTyCon TyName\n\ninstance Alpha AlgTyConRhs where\n  isTerm (NewTyCon nm) = isTerm nm\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Type where\n\nimport Unbound.Generics.LocallyNameless (Alpha (..),Name)\nimport TyCon\n\ndata TType = VarTy\n\ntype TyName = Name TType\n\ninstance Alpha TType where\n  isTerm VarTy = False\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Unbound.Generics.LocallyNameless where\n\nimport Data.Typeable (Typeable)\n\ndata Name a = Name\n\nclass Alpha a where\n  isTerm :: a -> Bool\n\ninstance Typeable a => Alpha (Name a) where\n  isTerm _ = False\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule T12441 where\nimport T12441A\nf :: forall b a. (a, b)\nf = undefined\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12441A where\nimport {-# SOURCE #-} T12441\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DuplicateModuleName (Window(..)) where\n\ndata Window = Window deriving (Show)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DuplicateModuleName (Window(..)) where\n\ndata Window = Window\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,\n             OverlappingInstances, UndecidableInstances #-}\n\n--\n-- Test case adopted from the HList library\n-- http://www.cwi.nl/~ralf/HList/\n--\n\nmodule FakePrelude where\n\n\n--\n-- Type-level Booleans; nothing weird\n--\ndata HTrue; hTrue :: HTrue; hTrue = undefined\ndata HFalse; hFalse :: HFalse; hFalse = undefined\nclass HBool x; instance HBool HTrue; instance HBool HFalse\ninstance Show HTrue where show _ = \"HTrue\"\ninstance Show HFalse where show _ = \"HFalse\"\n\n\n--\n-- Type-level type equality\n--\nclass HBool b => TypeEq x y b | x y -> b\n\n\n--\n-- Value-level incarnation; nothing too weird.\n-- Rely on lazy show for type-level Booleans\n--\ntypeEq :: TypeEq t t' b => t -> t' -> b\ntypeEq = undefined\n\n\n--\n-- Type-level cast\n--\nclass TypeCast x y | x -> y, y -> x\n where\n  typeCast :: x -> y\n", "num_lines": 42}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}\n\n--\n-- Test case adopted from the HList library\n-- http://www.cwi.nl/~ralf/HList/\n--\n-- Tests functional dependencies and overlapping instances\n\nmodule Main where\n\nimport FakePrelude\nimport TypeEq\nimport TypeCast\n\n\n--\n-- Let's test.\n-- The following should print \"(HTrue,HFalse)\".\n--\n\nmain = print $ ( typeEq \"42\" \"88\"\n               , typeEq \"42\" (42::Int)\n               )\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}\n\n--\n-- Test case adopted from the HList library\n-- http://www.cwi.nl/~ralf/HList/\n--\n\nmodule TypeCast where\n\nimport FakePrelude\n\n--\n-- We are ready to reveal the definition of type cast.\n--\ninstance TypeCast x x where typeCast = id\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n{-# LANGUAGE MultiParamTypeClasses,\n             FlexibleInstances, OverlappingInstances, UndecidableInstances #-}\n\n--\n-- Test case adopted from the HList library\n-- http://www.cwi.nl/~ralf/HList/\n--\n\nmodule TypeEq where\n\nimport FakePrelude\n\n--\n-- Type-level type equality;\n-- defined in terms of type-level cast\n--\ninstance TypeEq x x HTrue\ninstance (HBool b, TypeCast HFalse b) => TypeEq x y b\n--\n-- NOTE! instance TypeEq x y HFalse -- would violate functional dependency\n--\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples, UnboxedSums, MagicHash #-}\n\nmodule Main where\n\ntype Null = (# #)\n\n{-# NOINLINE showNull #-}\nshowNull :: Null -> String\nshowNull (# #) = \"(# #)\"\n\n{-# NOINLINE showNullAlt #-}\nshowNullAlt :: (# Null | Null #) -> String\nshowNullAlt (# n1 | #) = \"(# \" ++ showNull n1 ++ \" | #)\"\nshowNullAlt (# | n2 #) = \"(# | \" ++ showNull n2 ++ \" #)\"\n\nmain :: IO ()\nmain = do\n    putStrLn (showNull (# #))\n    putStrLn (showNullAlt (# (# #) | #))\n    putStrLn (showNullAlt (# | (# #) #))\n", "num_lines": 21}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-}\n\nmodule Lib where\n\nimport GHC.Prim\n\n-- Can't unboxed tuples and sums to FFI, we should fail appropriately.\n\nforeign import ccall \"f1\" f1 :: (# Int | Int #) -> IO Int\nforeign import ccall \"f2\" f2 :: (# (# Int, Int #) | (# Float#, Float# #) #) -> IO Int\nforeign import ccall \"f3\" f3 :: (# (# #) | Void# | (# Int# | String #) #) -> IO Int\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, PolyKinds #-}\n\nmodule Example where\n\nimport Data.Typeable\nimport GHC.Exts\n\ndata Wat (a :: TYPE (SumRep '[LiftedRep, IntRep])) = Wat a\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\ntype Null = (# #)\n\n{-# NOINLINE showNull #-}\nshowNull :: Null -> String\nshowNull (# #) = \"(# #)\"\n\n{-# NOINLINE showNullPair #-}\nshowNullPair :: (# Null, Null #) -> String\nshowNullPair (# n1, n2 #) = \"(# \" ++ showNull n1 ++ \", \" ++ showNull n2 ++ \" #)\"\n\nmain :: IO ()\nmain = do\n    putStrLn (showNullPair (# (# #), (# #) #))\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums #-}\n\nmodule Main where\n\nimport T14051a\n\nmain :: IO ()\nmain = print $ case func () of\n  (# True | #) -> 123\n  _ -> 321\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums #-}\n\nmodule T14051a where\n\nfunc :: s -> (# Bool | Bool #)\nfunc _ = (# True | #)\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\n{-# NOINLINE f #-}\nf :: (# #) -> [Int]\nf (# #) = [ 1 .. ]\n\nmain :: IO ()\nmain = print (sum (take 10 (f (# #))))\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums #-}\n\nmodule UbxSumLevPoly where\n\n-- this failed thinking that (# Any | True #) :: TYPE (SumRep [LiftedRep, b])\n-- But of course that b should be Lifted!\n\n-- It was due to silliness in TysWiredIn using the same uniques for different\n-- things in mk_sum.\n\np = True\n  where (# _x | #) = (# | True #)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedTuples #-}\n\nmodule Main where\n\n{-# NOINLINE f1 #-}\nf1 :: (# #) -> (# #) -> String\nf1 (# #) (# #) = \"o\"\n\n{-# NOINLINE f2 #-}\nf2 :: (# (# #), (# #) #) -> String\nf2 (# (# #), (# #) #) = \"k\"\n\nmain :: IO ()\nmain = do\n    let t = (# (# #), (# #) #)\n    case t of\n      (# t1, t2 #) -> putStrLn (f1 t1 t2 ++ f2 t)\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash #-}\n\nmodule Main where\n\nimport GHC.Prim\nimport GHC.Types\n\nimport System.Mem (performMajorGC)\n\ntype Either1 a b = (# a | b #)\n\nshowEither1 :: (Show a, Show b) => Either1 a b -> String\nshowEither1 (# left | #)  = \"Left \" ++ show left\nshowEither1 (# | right #) = \"Right \" ++ show right\n\nshowEither2 :: (# Int# | Float# #) -> String\nshowEither2 (# i | #) = \"Left \" ++ show (I# i)\nshowEither2 (# | f #) = \"Right \" ++ show (F# f)\n\nshowEither3 :: Show a => (# a | Int# #) -> String\nshowEither3 (# a | #) = \"Left \" ++ show a\nshowEither3 (# | i #) = \"Right \" ++ show (I# i)\n\ntype T = (# Int | Bool | String | Char | Either Int Bool | Int# | Float# #)\n\nshowEither4 :: T -> String\nshowEither4 (# i | | | | | | #) = \"Alt0: \" ++ show i\nshowEither4 (# | b | | | | | #) = \"Alt1: \" ++ show b\nshowEither4 (# | | s | | | | #) = \"Alt2: \" ++ show s\nshowEither4 (# | | | c | | | #) = \"Alt3: \" ++ show c\nshowEither4 (# | | | | e | | #) = \"Alt4: \" ++ show e\nshowEither4 (# | | | | | i | #) = \"Alt5: \" ++ show (I# i)\nshowEither4 (# | | | | | | f #) = \"Alt6: \" ++ show (F# f)\n\nmain :: IO ()\nmain = do\n    putStrLn (showEither1 e1_1)\n    putStrLn (showEither1 e1_2)\n    putStrLn (showEither2 e2_1)\n    putStrLn (showEither2 e2_2)\n    putStrLn (showEither3 e3_1)\n    putStrLn (showEither3 e3_2)\n\n    putStrLn (showEither4 e4_1)\n    putStrLn (showEither4 e4_2)\n    putStrLn (showEither4 e4_3)\n    putStrLn (showEither4 e4_4)\n    putStrLn (showEither4 e4_5)\n    putStrLn (showEither4 e4_6)\n    putStrLn (showEither4 e4_7)\n\n    -- make sure we don't put pointers to non-pointer slots\n    performMajorGC\n\n    -- make sure pointers in unboxed sums are really roots\n    putStrLn (showEither1 e1_1)\n  where\n    -- boxed types only\n    e1_1, e1_2 :: Either1 String Int\n    e1_1 = (# \"error\" | #)\n    e1_2 = (# | 10 #)\n\n    -- prim types only\n    e2_1, e2_2 :: (# Int# | Float# #)\n    e2_1 = (# 10# | #)\n    e2_2 = (# | 1.2# #)\n\n    -- a mix of prim and boxed types\n    e3_1, e3_2 :: (# String | Int# #)\n    e3_1 = (# \"OK\" | #)\n    e3_2 = (# | 123# #)\n\n    -- big arity\n    e4_1, e4_2, e4_3, e4_4, e4_5, e4_6, e4_7 :: T\n    e4_1 = (# 10 | | | | | | #)\n    e4_2 = (# | False | | | | | #)\n    e4_3 = (# | | \"ok\" | | | | #)\n    e4_4 = (# | | | 'a' | | | #)\n    e4_5 = (# | | | | Right True | | #)\n    e4_6 = (# | | | | | 123# | #)\n    e4_7 = (# | | | | | | 54.3# #)\n", "num_lines": 82}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash #-}\n\nmodule Main where\n\ntype Ty = (# (Int -> Int) | (Int -> Int) #)\n\n{-# NOINLINE apply #-}\napply :: Ty -> Int\napply (# f | #) = f 0\napply (# | f #) = f 1\n\nmain :: IO ()\nmain = do\n  print (apply (# (\\x -> x * 2) | #))\n  print (apply (# | (\\x -> x * 3) #))\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash #-}\n\nmodule Main where\n\ntype Ty = (# () | () #)\n\n{-# NOINLINE showTy #-}\nshowTy :: Ty -> String\nshowTy (# _ | #)  = \"(# _ | #)\"\nshowTy (# | () #) = \"(# | () #)\"\n\nmain :: IO ()\nmain = do\n  print (showTy (# undefined | #))\n  print (showTy (# | () #))\n", "num_lines": 16}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash, UnboxedTuples #-}\n\nmodule Lib where\n\nimport GHC.Prim\n\ndata B = B1 Int# Int# Int# Int# Int# | B2 Float#\n\ntype UbxB = (# (# Int#, Int#, Int#, Int#, Int# #) | Float# #)\n\n{-# INLINE bToSum #-}\nbToSum :: B -> UbxB\nbToSum (B1 i1 i2 i3 i4 i5) = (# (# i1, i2, i3, i4, i5 #) | #)\nbToSum (B2 f) = (# | f #)\n\ndata C = C UbxB UbxB UbxB\n\nmkC :: B -> C\nmkC b = C (bToSum b) (bToSum b) (bToSum b)\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash, BangPatterns #-}\n\nmodule Main where\n\nimport GHC.Prim\nimport GHC.Types\n\n-- Code generator used to fail with illegal instruction errors when Float# is\n-- involved.\n\ntoInt :: (# Int# | Float# #) -> Int#\ntoInt (# i | #) = i\ntoInt (# | f #) = let !(I# i) = ceiling (F# f) in i\n\ntoFloat :: (# Int# | Float# #) -> Float#\ntoFloat (# i | #) = let !(F# f) = fromIntegral (I# i) in f\ntoFloat (# | f #) = f\n\ndata D = D { f1 :: (# Int# | Float# #) }\n\ninstance Show D where\n  show (D (# i | #)) = \"D \" ++ show (I# i)\n  show (D (# | f #)) = \"D \" ++ show (F# f)\n\nmain :: IO ()\nmain = do\n    !(F# f) <- readLn\n    print (I# (toInt (# | f #)))\n\n    !(I# i) <- readLn\n    print (F# (toFloat (# i | #)))\n\n    print (D (# | f #))\n    print (D (# i | #))\n", "num_lines": 35}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash, BangPatterns, UnboxedTuples #-}\n\nmodule Main where\n\nimport GHC.Prim\nimport GHC.Types\n\nimport Data.Void (Void)\nimport System.Mem (performMajorGC)\n\nshowAlt0 :: (# Void# | (# #) | () #) -> String\nshowAlt0 (# | (# #) | #) = \"(# | (# #) | #)\"\nshowAlt0 (# | | () #) = \"(# | | () #)\"\n\nshowAlt1 :: (# Void | Float# #) -> String\nshowAlt1 (# _ | #) = \"(# Void | #)\"\nshowAlt1 (# | f #) = \"(# | \" ++ show (F# f) ++ \"# #)\"\n\ndata D = D { f1 :: (# Void# | (# #) | () #)\n           , f2 :: (# Void | Float# #)\n           }\n\nshowD :: D -> String\nshowD (D f1 f2) = showAlt0 f1 ++ \"\\n\" ++ showAlt1 f2\n\nmain :: IO ()\nmain = do\n    putStrLn (showAlt0 (# | (# #) | #))\n    putStrLn (showAlt0 (# | | () #))\n    putStrLn (showAlt1 (# undefined | #))\n    putStrLn (showAlt1 (# | 8.1# #))\n    putStrLn (showD (D (# | (# #) | #) (# | 1.2# #)))\n    performMajorGC\n", "num_lines": 34}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Lib where\n\nsum = (10 |)\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums #-}\n\nmodule Lib where\n\n-- No spaces needed in the type syntax\ntype T = (#Int|Bool|String#)\n\n-- Term syntax needs spaces, otherwise we parser bars as sections\n-- for ||, ||| etc.\n--\n-- t1 :: T\n-- t1 = (# 10 | | #)\n", "num_lines": 13}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash, UnboxedTuples #-}\n\n-- Nesting sums and tuples is OK\n\nmodule Main where\n\nimport GHC.Prim\nimport GHC.Types\n\nimport System.Mem (performMajorGC)\n\ntype S_T_T a b c d = (# (# a , b #) | (# c , d #) #)\ntype S_S_S a b c d = (# (# a | b #) | (# c | d #) #)\n\nshow_stt :: (Show a, Show b, Show c, Show d) => S_T_T a b c d -> String\nshow_stt (# (# a, b #) | #) = show a ++ show b\nshow_stt (# | (# c, d #) #) = show c ++ show d\n\nshow_sss :: (Show a, Show b, Show c, Show d) => S_S_S a b c d -> String\nshow_sss (# (# a | #) | #) = show a\nshow_sss (# (# | b #) | #) = show b\nshow_sss (# | (# c | #) #) = show c\nshow_sss (# | (# | d #) #) = show d\n\nmain :: IO ()\nmain = do\n    putStrLn (show_stt stt)\n    putStrLn (show_sss sss)\n    performMajorGC\n  where\n    stt :: S_T_T Int Bool Float String\n    stt = (# (# 123, True #) | #)\n\n    sss :: S_S_S Int Bool Float String\n    sss = (# | (# 1.2 | #) #)\n", "num_lines": 36}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-}\n\nmodule Main where\n\nimport GHC.Prim\nimport GHC.Types\n\ntype Either1 a b c = (# a | (# b, c #) #)\n\n-- The bug disappears when this is inlined\n{-# NOINLINE showEither1 #-}\n\nshowEither1 :: Either1 String Int Bool -> String\nshowEither1 (# left | #) = \"Left \" ++ show left\nshowEither1 (# | (# right1, right2 #) #) = \"Right \" ++ show right1 ++ \" \" ++ show right2\n\nmain :: IO ()\nmain = do\n    -- This line used to print \"Right -4611686018427359531 False\"\n    putStrLn (showEither1 e1_2)\n  where\n    -- boxed types only\n    e1_2 :: Either1 String Int Bool\n    e1_2 = (# | (# 10, True #) #)\n", "num_lines": 25}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-}\n\nmodule Main where\n\nimport GHC.Prim\nimport GHC.Types\n\ntype Sum1 = (# (# Int#, Int #) | (# Int#, Int# #) | (# Int, Int# #) #)\n\n{-# NOINLINE showSum1 #-}\nshowSum1 :: Sum1 -> String\nshowSum1 (# p1 | | #) = showP1 p1\nshowSum1 (# | p2 | #) = showP2 p2\nshowSum1 (# | | p3 #) = showP3 p3\n\n{-# NOINLINE showP1 #-}\nshowP1 :: (# Int#, Int #) -> String\nshowP1 (# i1, i2 #) = show (I# i1) ++ show i2\n\n{-# NOINLINE showP2 #-}\nshowP2 :: (# Int#, Int# #) -> String\nshowP2 (# i1, i2 #) = show (I# i1) ++ show (I# i2)\n\n{-# NOINLINE showP3 #-}\nshowP3 :: (# Int, Int# #) -> String\nshowP3 (# i1, i2 #) = show i1 ++ show (I# i2)\n\nmain :: IO ()\nmain = do\n    putStrLn (showSum1 s1)\n    putStrLn (showSum1 s2)\n    putStrLn (showSum1 s3)\n  where\n    s1, s2, s3 :: Sum1\n    s1 = (# (# 123#, 456 #) | | #)\n    s2 = (# | (# 876#, 543# #) | #)\n    s3 = (# | | (# 123, 456# #) #)\n", "num_lines": 38}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-}\n\nmodule Main where\n\ntype UbxBool = (# (# #) | (# #) #)\n\n{-# NOINLINE packBool #-}\npackBool :: UbxBool -> Bool\npackBool (# _ | #) = True\npackBool (# | _ #) = False\n\n{-# NOINLINE unpackBool #-}\nunpackBool :: Bool -> UbxBool\nunpackBool True  = (# (# #) | #)\nunpackBool False = (# | (# #) #)\n\n{-# NOINLINE showUbxBool #-}\nshowUbxBool :: UbxBool -> String\nshowUbxBool b = show (packBool b)\n\nmain :: IO ()\nmain = do\n  putStrLn (showUbxBool (unpackBool True))\n  putStrLn (showUbxBool (unpackBool False))\n  putStrLn (show (packBool (# (# #) | #)))\n  putStrLn (show (packBool (# | (# #) #)))\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport BasicTypes\nimport GHC\nimport GhcMonad\nimport Outputable\nimport RepType\nimport TysPrim\nimport TysWiredIn\nimport UniqSet\nimport Unique\n\nimport qualified Control.Exception as E\nimport Control.Monad\nimport System.Environment (getArgs)\nimport System.IO\n\nassert :: Bool -> String -> SDoc -> IO ()\nassert False tn msg = pprPanic tn msg\nassert True  _  _   = return ()\n\nmain :: IO ()\nmain = do\n    [libdir] <- getArgs\n    runGhc (Just libdir) $ liftIO $ do\n      -- need to initialize the monad to initialize static flags etc.\n      sequence_ [ uniq_tests, layout_tests ]\n\n-- Make sure sum datacon/tycon uniques are really uniq\nuniq_tests :: IO ()\nuniq_tests = do\n    let tycons   = map sumTyCon [2 .. 20]\n        datacons = [ sumDataCon alt arity | arity <- [ 2 .. 20 ]\n                                          , alt   <- [ 1 .. arity ] ]\n\n        us = mkUniqSet (map getUnique tycons)\n               `unionUniqSets` mkUniqSet (map getUnique datacons)\n\n    assert (sizeUniqSet us == length tycons + length datacons)\n           \"uniq_tests\"\n           (text \"Sum cons/tycons have same uniques.\")\n\nlayout_tests :: IO ()\nlayout_tests = sequence_\n    [ layout1, layout2, layout3, layout4, layout5, enum_layout ]\n  where\n    assert_layout tn tys layout =\n      let\n        layout_ret = ubxSumRepType (map typePrimRep tys)\n      in\n        assert (layout_ret == layout)\n               tn\n               (text \"Unexpected sum layout.\" $$\n                text \"Alts:           \" <+> ppr tys $$\n                text \"Expected layout:\" <+> ppr layout $$\n                text \"Actual layout:  \" <+> ppr layout_ret)\n\n    ubxtup = mkTupleTy Unboxed\n\n    layout1 =\n      assert_layout \"layout1\"\n        [ ubxtup [ intTy, intPrimTy ]\n        , ubxtup [ intPrimTy, intTy ] ]\n        [ WordSlot, PtrSlot, WordSlot ]\n\n    layout2 =\n      assert_layout \"layout2\"\n        [ ubxtup [ intTy ]\n        , intTy ]\n        [ WordSlot, PtrSlot ]\n\n    layout3 =\n      assert_layout \"layout3\"\n        [ ubxtup [ intTy, intPrimTy, intTy, intPrimTy ]\n        , ubxtup [ intPrimTy, intTy, intPrimTy, intTy ] ]\n        [ WordSlot, PtrSlot, PtrSlot, WordSlot, WordSlot ]\n\n    layout4 =\n      assert_layout \"layout4\"\n        [ ubxtup [ floatPrimTy, floatPrimTy ]\n        , ubxtup [ intPrimTy, intPrimTy ] ]\n        [ WordSlot, WordSlot, WordSlot, FloatSlot, FloatSlot ]\n\n    layout5 =\n      assert_layout \"layout5\"\n        [ ubxtup [ intPrimTy, intPrimTy ]\n        , ubxtup [ floatPrimTy, floatPrimTy ] ]\n        [ WordSlot, WordSlot, WordSlot, FloatSlot, FloatSlot ]\n\n    enum_layout =\n      assert_layout \"enum\"\n        (replicate 10 (ubxtup []))\n        [ WordSlot ]\n", "num_lines": 94}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums, MagicHash #-}\n\nmodule Lib (flip, getInt) where\n\nimport GHC.Exts\nimport Prelude (Int)\n\n{-# NOINLINE flip #-}\nflip :: (# Int | Int# #) -> (# Int# | Int #)\nflip (# i | #) = (# | i #)\nflip (# | i #) = (# i | #)\n\n{-# NOINLINE getInt #-}\ngetInt :: (# Int# | Int #) -> Int\ngetInt (# i | #) = I# i\ngetInt (# | i #) = i\n", "num_lines": 17}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE UnboxedSums #-}\n\nmodule Main where\n\nimport Lib\n\nimport Prelude (print, IO)\n\nmain :: IO ()\nmain = do\n    print (getInt (flip (# 123 | #)))\n", "num_lines": 12}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\nmodule Main (main) where\n\nimport FastString\n\nimport Control.Concurrent\nimport Control.DeepSeq\nimport Control.Exception\nimport Control.Monad\nimport Data.ByteString (ByteString)\nimport Data.ByteString.Builder\nimport qualified Data.ByteString.Char8 as Char\nimport Data.ByteString.Lazy (toStrict)\nimport Data.List\nimport Data.Monoid\nimport qualified Data.Sequence as Seq\nimport Data.Time\nimport GHC.Conc\nimport System.IO\nimport System.Random\nimport Text.Printf\n\ndata Options = Options\n  { optThreads :: Int   -- ^ the number of threads to run concurrently\n  , optRepeat :: Int    -- ^ how many times do we create the same 'FastString'\n  , optCount :: Int     -- ^ the total number of different 'FastString's\n  , optPrefix :: Int    -- ^ the length of prefix in each 'FastString'\n  }\n\ndefOptions :: Options\ndefOptions = Options\n  { optThreads = 8\n  , optRepeat = 16\n  , optCount = 10000\n  , optPrefix = 0\n  }\n\nrun :: [[ByteString]] -> (ByteString -> Int) -> IO Int\nrun jobs op = do\n  mvars <- forM ([0 ..] `zip` jobs) $ \\(i, job) -> do\n    mvar <- newEmptyMVar\n    forkOn i $ do\n      uniq <- evaluate $ force $ maximum $ map op job\n      putMVar mvar uniq\n    return mvar\n  uniqs <- mapM takeMVar mvars\n  evaluate $ force $ maximum uniqs - 603979775\n\nsummary :: IO [[[a]]] -> IO Int\nsummary getTable = do\n  table <- getTable\n  evaluate $ force $ length $ concat $ concat table\n\ntimeIt :: String -> IO a -> IO a\ntimeIt name io = do\n  before <- getCurrentTime\n  ret <- io\n  after <- getCurrentTime\n  hPrintf stderr \"%s: %.2fms\\n\" name\n    (realToFrac $ diffUTCTime after before * 1000 :: Double)\n  return ret\n\nmain :: IO ()\nmain = do\n  seed <- randomIO\n  let Options{..} = defOptions\n      shuffle (i:is) s\n        | Seq.null s = []\n        | otherwise = m: shuffle is (l <> r)\n        where\n          (l, m Seq.:< r) = Seq.viewl <$> Seq.splitAt (i `rem` Seq.length s) s\n      inputs =\n        shuffle (randoms $ mkStdGen seed) $\n        mconcat $ replicate optRepeat $\n        Seq.fromFunction optCount $ \\i -> toStrict $ toLazyByteString $\n          byteString (Char.replicate optPrefix '_') <> intDec i\n  jobs <- evaluate $ force $ transpose $\n    map (take optThreads) $\n    takeWhile (not . null) $\n    iterate (drop optThreads) inputs\n  setNumCapabilities (length jobs)\n  -- The maximum unique may be greater than 'optCount'\n  u <- timeIt \"run\" $ run jobs $ uniqueOfFS . mkFastStringByteString\n  print $ optCount <= u && u <= min optThreads optRepeat * optCount\n  -- But we should never have duplicate 'FastString's in the table\n  n <- timeIt \"summary\" $ summary getFastStringTable\n  print $ n == optCount\n", "num_lines": 88}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -ddump-to-file #-}\n{-# OPTIONS_GHC -fhpc -ddump-ticked -ddump-simpl-trace -ddump-tc #-}\n{-# OPTIONS_GHC -ddump-types -ddump-core-stats #-}\n\nmodule T15953 where\n\nfoo :: Int -> Int\nfoo 0 = 0\nfoo n = foo (n - 1)\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module WarnMinimal where\n\nclass Fine a where\ninstance Fine Int\n\n-------------------\n\nclass Foo a where\n  foo1 :: a\n  foo2 :: a\n  foo1 = foo2\n  foo2 = foo1\n  {-# MINIMAL foo1 | foo2 #-}\n\n-- this should generate a warning\ninstance Foo Int where  -- WARNING LINE\n\n-- this should generate no warning\ninstance Foo Char where\n  foo1 = 'x'\n\n-- nor should this\ninstance Foo Bool where\n  foo2 = True\n\ninstance Foo Double where\n  foo1 = 1\n  foo2 = 2\n\n-------------------\n\nclass Monad' f where\n  return' :: a -> f a\n  fmap' :: (a -> b) -> f a -> f b\n  join' :: f (f a) -> f a\n  bind' :: f a -> (a -> f b) -> f b\n  {-# MINIMAL return', (fmap',join' | bind') #-}\n  fmap' f x = bind' x (return' . f)\n  join' x = bind' x id\n  bind' x f = join' (fmap' f x)\n\ninstance Monad' [] where\n  return' = return\n  fmap' = map\n  join' = concat\n  -- no warning\n\ninstance Monad' Maybe where\n  return' = Just\n  bind' = (>>=)\n  -- no warning\n\ninstance Monad' IO where\n  return' = return\n  bind' = (>>=)\n  fmap' = fmap\n  join' = (>>= id)\n  -- no warning\n\ninstance Monad' ((->) e) where  -- WARNING LINE\n  return' = const\n  fmap' = (.)\n  -- warning!\n\nnewtype Id a = Id a\ninstance Monad' Id where  -- WARNING LINE\n  fmap' f (Id x) = Id (f x)\n  join' (Id x) = x\n  -- warning!\n\nnewtype Id2 a = Id2 a\ninstance Monad' Id2 where  -- WARNING LINE\n  fmap' f (Id2 x) = Id2 (f x)\n  join' (Id2 x) = x\n  bind' (Id2 x) f = f x\n  -- warning!\n\nnewtype Id3 a = Id3 a\ninstance Monad' Id3 where  -- WARNING LINE\n\n---------\n\n-- incorrect minimal spec\nclass Cheater a where  -- WARNING LINE\n  cheater :: a\n  {-# MINIMAL #-} -- warning!\n\nclass Cheater2 a where\n  _cheater2 :: a\n  {-# MINIMAL #-} -- warning!\n\nclass Cheater3 a where  -- WARNING LINE\n  cheater3, cheater3b :: a\n  {-# MINIMAL cheater3 #-} -- warning!\n\n---------\n\n-- new style warning for classes without explicit spec\ninstance Num Bool where  -- WARNING LINE\n\nclass NoExplicit a where\n  needed :: a\n  _alsoNeeded :: a\n\ninstance NoExplicit Int where  -- WARNING LINE\n\n\n---------\ndata Blarg = Blarg\nclass Eq' a where\n  (===) :: a -> a -> Bool\n  (/==) :: a -> a -> Bool\n  x === y = not (x /== y)\n  x /== y = not (x === y)\n  {-# MINIMAL (===) | (/==) #-}\ninstance Eq' Blarg where  -- WARNING LINE\n", "num_lines": 117}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module WarnMinimalFail1 where\n\nglobal :: Int\nglobal = 0\n{-# MINIMAL global #-} -- invalid, should only be used inside a class declaration\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module WarnMinimalFail2 where\n\nglobal :: Int\nglobal = 0\n\nclass Foo a where\n  local :: a\n  {-# MINIMAL global #-}\n", "num_lines": 9}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DefaultSignatures #-}\nmodule WarnMinimalFail3 where\n\nclass Parent a where\n  parent :: a\n  default parent :: Child a => a\n  parent = child\n\nclass Parent a => Child a where\n  child :: a\n  child = parent\n  {-# MINIMAL parent | child #-}\n  -- we would like this to work, but it doesn't yet.\n", "num_lines": 14}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprM {-# DEPRECATED \"Here can be your menacing deprecation warning!\" #-} where\n\nf :: Int\nf = 42\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nimport DeprM -- here should be emitted deprecation warning\n\ng :: Int\ng = f\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MissingMod\nwhere\n\nimport MissingMod1\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module MissingMod1\nwhere\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule Overflow where\n\nimport GHC.Exts\n\n-- Overflow an 'Int#' expression\nf x = let y :: Int#\n          y = 10000000000000000000000000000000#\n      in 9\n\n-- Overflow an 'Int#' pattern\ng :: Int# -> Bool\ng 100000000000000000000000000# = True\ng _ = False\n\n-- Overflow an 'Int' expression\nh :: Int\nh = 1000000000000000000000000000000\n\n-- Overflow an 'Int' pattern\ni :: Int -> Int\ni 100000000000000000000000000000000 = 0\ni _ = 1\n\n-- Underflow a 'Word' expression\nj :: Word\nj = -1\n\n-- Underflow a 'Word' pattern\nk :: Word -> Bool\nk (-1) = True\nk _ = False\n", "num_lines": 33}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n--\n-- Ensure the plural \"s\" in warnings is only shown if there are more than\n-- one entries\n\n{-# OPTIONS_GHC -Wredundant-constraints #-}\n{-# OPTIONS_GHC -Wtype-defaults #-}\n\nmodule PluralS () where\n\n\n\n-- Defaulting type classes\n\ndefaultingNum = 123 `seq` ()\n\ndefaultingNumAndShow = show 123\n\n\n\n-- Redundant constraints\n\nredundantNum :: (Num a, Num a) => a\nredundantNum = 123\n\nredundantMultiple :: (Num a, Show a, Num a, Eq a, Eq a) => a\nredundantMultiple = 123\n", "num_lines": 28}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wwarn-missing-signatues -Werror=incomplete-patterns #-}\n\nfoo () = ()\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, TypeFamilies #-}\n{-# OPTIONS -Wno-star-is-type #-}\n\nmodule X (type (X.*)) where\n\ntype family (*) a b where { (*) a b = Either b a }\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fwarn-missing-exported-signatures #-}\n\nmodule Bug (Data.List.intercalate, x) where\n\nimport qualified Data.List\n\nintercalate = True\n\nx :: Bool\nx = intercalate\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NegativeLiterals #-}\nmodule T10930 where\n\nimport Numeric.Natural\n\nx = -123 :: Word\ny = -123 :: Natural\n\nw = [10..3] :: [Word]\nz = [10..3] :: [Natural]\n", "num_lines": 11}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NegativeLiterals #-}\nmodule T10930a where\n\nimport Numeric.Natural\n\nx = [-10 .. -3] :: [Natural]\ny = [-3 .. -10] :: [Natural]\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T11077 (module X, foo) where\nimport Data.List as X\nfoo = undefined\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n{-# OPTIONS_GHC -fwarn-noncanonical-monad-instances  #-}\n\n-- | Test noncanonical-monad-instances warnings\nmodule T11128 where\n\nimport Control.Applicative as A\nimport Control.Monad as M\n\n----------------------------------------------------------------------------\n-- minimal definition\n\ndata T0 a  = T0 a deriving Functor\n\ninstance A.Applicative T0 where\n    pure   = T0\n    (<*>)  = M.ap\n\ninstance M.Monad T0 where\n    (>>=)  = undefined\n\n----------------------------------------------------------------------------\n-- trigger all 4 warnings\n\ndata T1 a  = T1 a deriving Functor\n\ninstance A.Applicative T1 where\n    pure   = return\n    (<*>)  = M.ap\n    (*>)   = (M.>>)\n\ninstance M.Monad T1 where\n    (>>=)  = undefined\n    return = T1\n    (>>)   = undefined\n\n----------------------------------------------------------------------------\n-- backward compat canonical definition\n\ndata T2 a  = T2 a deriving Functor\n\ninstance Applicative T2 where\n    pure   = T2\n    (<*>)  = ap\n    (*>)   = undefined\n\ninstance M.Monad T2 where\n    (>>=)  = undefined\n    return = pure\n    (>>)   = (*>)\n", "num_lines": 51}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveFunctor #-}\n{-# OPTIONS_GHC -Wnoncanonical-monadfail-instances  #-}\n\n-- | Test noncanonical-monadfail-instances warnings\nmodule T11128b where\n\nimport Control.Applicative as A\nimport Control.Monad as M\nimport Control.Monad.Fail as MF\n\n----------------------------------------------------------------------------\n-- minimal definition\n\ndata T0 a  = T0 a deriving Functor\n\ninstance A.Applicative T0 where\n    pure   = T0\n    (<*>)  = M.ap\n\ninstance M.Monad T0 where\n    (>>=)  = undefined\n\ninstance MF.MonadFail T0 where\n    fail   = error \"fail\"\n\n----------------------------------------------------------------------------\n-- trigger all 2 warnings\n\ndata T1 a  = T1 a deriving Functor\n\ninstance A.Applicative T1 where\n    pure   = return\n    (<*>)  = M.ap\n    (*>)   = (M.>>)\n\ninstance M.Monad T1 where\n    (>>=)  = undefined\n    return = T1\n    (>>)   = undefined\n    fail   = error \"fail\"\n\ninstance MF.MonadFail T1 where\n    fail   = M.fail\n\n----------------------------------------------------------------------------\n-- backward compat canonical definition\n\ndata T2 a  = T2 a deriving Functor\n\ninstance Applicative T2 where\n    pure   = T2\n    (<*>)  = ap\n    (*>)   = undefined\n\ninstance M.Monad T2 where\n    (>>=)  = undefined\n    return = pure\n    (>>)   = (*>)\n    fail   = MF.fail\n\ninstance MF.MonadFail T2 where\n    fail   = error \"fail\"\n\n----------------------------------------------------------------------------\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T12574 where\n\nid a = a\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T13256 where\n\nv :: Int\nv = (\\x -> case (x :: Int) of 100000000000000000000000000000000 -> 0) 8 :: Int\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\nmodule T15460 where\n\nimport GHC.Int\n\nmain :: IO ()\nmain = do\n   let x = I# (0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff#)\n   print x\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T2526 (foo) where\n\n-- This should generate a warning\nfoo = 1\n\n-- This should not\nbar = 2\n", "num_lines": 8}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\nmodule T9178 where\n\nimport T9178DataType\n\n\ninstance Show T9178_Type where\n         show _ = undefined\n", "num_lines": 10}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n\nmodule T9178DataType where\n\ndata T9178_Type\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T9230 where\n\ntest :: Monad m => m ()\ntest = do\n\treturn ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wmissing-signatures -Werror=incomplete-patterns #-}\nmodule Werror01 where\n\n-- this should generate missing-signatures, but not incomplete-patterns\nfoo () = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wmissing-signatures -Werror -Wwarn=missing-signatures #-}\nmodule Werror02 where\n\n-- this should generate missing-signatures warning\nfoo () = ()\n", "num_lines": 6}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\ndata A = A\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10637 where\n\nimport {-# SOURCE #-} A ()\ndata B = B\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\nclass A a where\n  has :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B where\n\nclass B a where\n  has :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Base (AClass(..), BClass()) where\n\nimport Extends (BClass ())\n\nclass AClass a where\n  has :: a\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Extends where\n\nclass BClass b where\n  has :: b\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\n-- Previously GHC was printing this warning:\n--\n--   Main.hs:5:1: Warning:\n--       The import of \u00e2\u20ac\u02dcA.has\u00e2\u20ac\u2122 from module \u00e2\u20ac\u02dcA\u00e2\u20ac\u2122 is redundant\n--\n--   Main.hs:6:1: Warning:\n--       The import of \u00e2\u20ac\u02dcB.has\u00e2\u20ac\u2122 from module \u00e2\u20ac\u02dcB\u00e2\u20ac\u2122 is redundant\n\nimport A (A (has))\nimport B (B (has))\n\ndata Blah = Blah\n\ninstance A Blah where\n  has = Blah\n\ninstance B Blah where\n  has = Blah\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Base\nimport Extends\n\n-- Previously GHC was giving this false positive:\n--\n--   T10890_1.hs:4:1: Warning:\n--       The import of \u00e2\u20ac\u02dcExtends\u00e2\u20ac\u2122 is redundant\n--         except perhaps to import instances from \u00e2\u20ac\u02dcExtends\u00e2\u20ac\u2122\n--       To import instances alone, use: import Extends()\n\ndata Bar = Bar\n\ninstance AClass Bar where\n  has = Bar\n\ninstance BClass Bar where\n  has = Bar\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 23}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10890_2 where\n\n-- Previously GHC was printing this warning:\n--\n--   Main.hs:5:1: Warning:\n--       The import of \u00e2\u20ac\u02dcA.has\u00e2\u20ac\u2122 from module \u00e2\u20ac\u02dcA\u00e2\u20ac\u2122 is redundant\n--\n--   Main.hs:6:1: Warning:\n--       The import of \u00e2\u20ac\u02dcB.has\u00e2\u20ac\u2122 from module \u00e2\u20ac\u02dcB\u00e2\u20ac\u2122 is redundant\n\nimport T10890_2A (A (has))\nimport T10890_2B (B (has))\n\ndata Blah = Blah\n\ninstance A Blah where\n  has = Blah\n", "num_lines": 18}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10890_2A where\n\nclass A a where\n  has :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module T10890_2B where\n\nclass B a where\n  has :: a\n", "num_lines": 5}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module AltMain(alt_main) where\n\nimport Main\n\nalt_main :: IO ()\nalt_main = Main.main\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main(main) where\n\nimport M1 ()\n\nmain :: IO ()\nmain = return ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module M1 where\n", "num_lines": 2}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CaretDiagnostics1 where\n\nmain :: IO ()\nmain = do\n  10000000000000000000000000000000000000 +\n    2 +\n      (3 :: Int)\n  pure (\"this is not an IO\" + (            ))\n\n  where\n\n    _ = case id of\n      \"\u00ce\u00b3\u00ce\u00b7\u00ce\u00be\" -> (\n        ) '0'\n\nf\u00c3\u00b3o :: Int\nf\u00c3\u00b3o = ()\n\ntabby :: Int\ntabby =  \t()\n\ntabby2 :: Int\ntabby2 =\t\t()\n", "num_lines": 24}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module CaretDiagnostics2 where\n\n\u00d3&l\u00cb\u00e55k\u00cd\n", "num_lines": 4}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wmissing-signatures -Werror=incomplete-patterns #-}\nmodule WerrorFail where\n\n-- this should generate incomplete-patterns warning\nfoo :: Maybe a -> ()\nfoo Nothing = ()\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wall\n                -Werror=incomplete-patterns\n                -Werror=missing-fields #-}\n\nmodule Werror03 where\n\ndata Rec = Rec\n  { f1 :: Int\n  , f2 :: Int\n  } deriving (Show)\n\ndata S = C1 Int | C2 Int\n\n-- incomplete pattern\nsInt s = case s of\n           C1 i -> i\n\n-- missing field\nprintRec = print Rec{ f1 = 1 }\n", "num_lines": 20}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NoMonadFailDesugaring, KindSignatures #-}\n\nmodule WCompatWarningsOnOff where\n\nimport qualified Data.Semigroup as Semi\n\nmonadFail :: Monad m => m a\nmonadFail = do\n    Just _ <- undefined\n    undefined\n\n(<>) = undefined -- Semigroup warnings\n\n-- -fwarn-noncanonical-monoid-instances\nnewtype S = S Int\n\ninstance Semi.Semigroup S where\n  (<>) = mappend\n\ninstance Monoid S where\n  S a `mappend` S b = S (a+b)\n  mempty = S 0\n\n-- -fwarn-star-is-type\nb :: (Bool :: *)\nb = True\n", "num_lines": 27}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n-- Ensure that using -Wno-compat does not switch on warnings\n\n{-# OPTIONS_GHC -Wno-compat #-}\n{-# LANGUAGE CPP #-}\n#include \"Template.hs\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n-- Ensure that -Wcompat switches on the right warnings\n\n{-# OPTIONS_GHC -Wcompat -Wno-error=compat #-}\n{-# LANGUAGE CPP #-}\n#include \"Template.hs\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Test purpose:\n-- Ensure that -Wno-compat disables a previously set -Wcompat\n\n{-# OPTIONS_GHC -Wcompat -Wno-compat #-}\n{-# LANGUAGE CPP #-}\n#include \"Template.hs\"\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport Distribution.Simple\n\nmain :: IO ()\nmain = defaultMain\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main (main) where\n\nimport System.IO\n\nmain = hPutStr stderr \"\"\n\n", "num_lines": 7}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS -cpp #-}\n{-# LANGUAGE LambdaCase #-}\nmodule Main where\n\nimport Control.Concurrent (forkIO, threadDelay)\nimport Control.Concurrent.MVar (putMVar, takeMVar, newEmptyMVar)\nimport Control.Monad\nimport Control.Exception\nimport Data.Maybe (isNothing)\nimport System.Environment (getArgs)\nimport System.Exit\nimport System.IO (hPutStrLn, stderr)\n\n#if !defined(mingw32_HOST_OS)\nimport System.Posix hiding (killProcess)\nimport System.IO.Error hiding (try,catch)\n#endif\n\n#if defined(mingw32_HOST_OS)\nimport System.Process\nimport WinCBindings\nimport Foreign\nimport System.Win32.DebugApi\nimport System.Win32.Types\nimport System.Win32.Console.CtrlHandler\n#endif\n\nmain :: IO ()\nmain = do\n  args <- getArgs\n  case args of\n      [secs,cmd] ->\n          case reads secs of\n          [(secs', \"\")] -> run secs' cmd\n          _ -> die (\"Can't parse \" ++ show secs ++ \" as a number of seconds\")\n      _ -> die (\"Bad arguments \" ++ show args)\n\nrun :: Int -> String -> IO ()\n#if !defined(mingw32_HOST_OS)\nrun secs cmd = do\n        m <- newEmptyMVar\n        mp <- newEmptyMVar\n        installHandler sigINT (Catch (putMVar m Nothing)) Nothing\n        forkIO $ do threadDelay (secs * 1000000)\n                    putMVar m Nothing\n        forkIO $ do ei <- try $ do pid <- systemSession cmd\n                                   return pid\n                    putMVar mp ei\n                    case ei of\n                       Left _ -> return ()\n                       Right pid -> do\n                           r <- getProcessStatus True False pid\n                           putMVar m r\n        ei_pid_ph <- takeMVar mp\n        case ei_pid_ph of\n            Left e -> do hPutStrLn stderr\n                                   (\"Timeout:\\n\" ++ show (e :: IOException))\n                         exitWith (ExitFailure 98)\n            Right pid -> do\n                r <- takeMVar m\n                case r of\n                  Nothing -> do\n                        killProcess pid\n                        exitWith (ExitFailure 99)\n                  Just (Exited r) -> exitWith r\n                  Just (Terminated s) -> raiseSignal s\n                  Just _ -> exitWith (ExitFailure 1)\n\nsystemSession cmd =\n forkProcess $ do\n   createSession\n   executeFile \"/bin/sh\" False [\"-c\", cmd] Nothing\n   -- need to use exec() directly here, rather than something like\n   -- System.Process.system, because we are in a forked child and some\n   -- pthread libraries get all upset if you start doing certain\n   -- things in a forked child of a pthread process, such as forking\n   -- more threads.\n\nkillProcess pid = do\n  ignoreIOExceptions (signalProcessGroup sigTERM pid)\n  checkReallyDead 10\n  where\n    checkReallyDead 0 = hPutStrLn stderr \"checkReallyDead: Giving up\"\n    checkReallyDead (n+1) =\n      do threadDelay (3*100000) -- 3/10 sec\n         m <- tryJust (guard . isDoesNotExistError) $\n                 getProcessStatus False False pid\n         case m of\n            Right Nothing -> return ()\n            Left _ -> return ()\n            _ -> do\n              ignoreIOExceptions (signalProcessGroup sigKILL pid)\n              checkReallyDead n\n\nignoreIOExceptions :: IO () -> IO ()\nignoreIOExceptions io = io `catch` ((\\_ -> return ()) :: IOException -> IO ())\n\n#else\nrun secs cmd =\n    let escape '\\\\' = \"\\\\\\\\\"\n        escape '\"'  = \"\\\\\\\"\"\n        escape c    = [c]\n        cmd' = \"sh -c \\\"\" ++ concatMap escape cmd ++ \"\\\"\" in\n    alloca $ \\p_startupinfo ->\n    alloca $ \\p_pi ->\n    withTString cmd' $ \\cmd'' ->\n    do job <- createJobObjectW nullPtr nullPtr\n       b_info <- setJobParameters job\n       unless b_info $ errorWin \"setJobParameters\"\n\n       ioPort <- createCompletionPort job\n       when (ioPort == nullPtr) $ errorWin \"createCompletionPort, cannot continue.\"\n\n       -- We're explicitly turning off handle inheritance to prevent misc handles\n       -- from being inherited by the child. Notable we don't want the I/O Completion\n       -- Ports and Job handles to be inherited. So we mark them as non-inheritable.\n       setHandleInformation job    cHANDLE_FLAG_INHERIT 0\n       setHandleInformation ioPort cHANDLE_FLAG_INHERIT 0\n\n       -- Now create the process suspended so we can add it to the job and then resume.\n       -- This is so we don't miss any events on the receiving end of the I/O port.\n       let creationflags = cCREATE_SUSPENDED\n       b <- createProcessW nullPtr cmd'' nullPtr nullPtr True\n                           creationflags\n                           nullPtr nullPtr p_startupinfo p_pi\n       unless b $ errorWin \"createProcessW\"\n\n       pi <- peek p_pi\n       b_assign <- assignProcessToJobObject job (piProcess pi)\n       unless b_assign $ errorWin \"assignProcessToJobObject, cannot continue.\"\n\n       let handleInterrupt action =\n               action `onException` terminateJobObject job 99\n           handleCtrl _ = do\n               terminateJobObject job 99\n               closeHandle ioPort\n               closeHandle job\n               exitWith (ExitFailure 99)\n               return True\n\n       withConsoleCtrlHandler handleCtrl $\n           handleInterrupt $ do\n              resumeThread (piThread pi)\n              -- The program is now running\n              let handle = piProcess pi\n              let millisecs = secs * 1000\n              rc <- waitForJobCompletion job ioPort (fromIntegral millisecs)\n              closeHandle ioPort\n\n              if not rc\n                then do terminateJobObject job 99\n                        closeHandle job\n                        exitWith (ExitFailure 99)\n                else alloca $ \\p_exitCode ->\n                      do terminateJobObject job 0\n                         -- Ensured it's all really dead.\n                         closeHandle job\n                         r <- getExitCodeProcess handle p_exitCode\n                         if r\n                           then peek p_exitCode >>= \\case\n                                   0 -> exitWith ExitSuccess\n                                   e -> exitWith $ ExitFailure (fromIntegral e)\n                           else errorWin \"getExitCodeProcess\"\n#endif\n\n", "num_lines": 166}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n\nimport Data.Data\nimport Data.List\nimport GHC\nimport DynFlags\nimport Outputable\nimport ApiAnnotation\nimport System.Environment( getArgs )\nimport System.Exit\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\n\nmain::IO()\nmain = do\n  args <- getArgs\n  case args of\n   [libdir,fileName] -> testOneFile libdir fileName\n   _ -> putStrLn \"invoke with the libdir and a file to parse.\"\n\ntestOneFile :: FilePath -> String -> IO ()\ntestOneFile libdir fileName = do\n       let modByFile m =\n             case ml_hs_file $ ms_location m of\n               Nothing -> False\n               Just fn -> fn == fileName\n       ((anns,_cs),p) <- runGhc (Just libdir) $ do\n                        dflags <- getSessionDynFlags\n                        _ <- setSessionDynFlags dflags\n                        addTarget Target { targetId = TargetFile fileName Nothing\n                                         , targetAllowObjCode = True\n                                         , targetContents = Nothing }\n                        _ <- load LoadAllTargets\n                        graph <- getModuleGraph\n                        let modSum =\n                              case filter modByFile (mgModSummaries graph) of\n                                [x] -> x\n                                xs -> error $ \"Can't find module, got:\"\n                                  ++ show (map (ml_hs_file . ms_location) xs)\n                        p <- parseModule modSum\n                        return (pm_annotations p,p)\n\n       let sspans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)\n\n           exploded = [((kw,ss),[anchor])\n                      | ((anchor,kw),sss) <- Map.toList anns,ss <- sss]\n\n           exploded' = Map.toList $ Map.fromListWith (++) exploded\n\n           problems' = filter (\\(_,anchors)\n                               -> not (any (\\a -> Set.member a sspans) anchors))\n                              exploded'\n\n           problems'' = filter (\\((a,_),_) -> a /= AnnEofPos) problems'\n\n           -- Check that every annotation location in 'vs' appears after\n           -- the start of the enclosing span 's'\n           comesBefore ((s,k),vs) = not $ all ok vs\n             where\n               ok v = (k == AnnEofPos) || (srcSpanStart s <= srcSpanStart v)\n\n           precedingProblems = filter comesBefore $ Map.toList anns\n\n       putStrLn \"---Unattached Annotation Problems (should be empty list)---\"\n       putStrLn (intercalate \"\\n\" [pp $ Map.fromList $ map fst problems''])\n       putStrLn \"---Ann before enclosing span problem (should be empty list)---\"\n       putStrLn (showAnnsList precedingProblems)\n       putStrLn \"---Annotations-----------------------\"\n       putStrLn \"-- SrcSpan the annotation is attached to, AnnKeywordId,\"\n       putStrLn \"--    list of locations the keyword item appears in\"\n       -- putStrLn (intercalate \"\\n\" [showAnns anns])\n       putStrLn (showAnns anns)\n       if null problems'' && null precedingProblems\n          then exitSuccess\n          else exitFailure\n\n    where\n      getAllSrcSpans :: (Data t) => t -> [SrcSpan]\n      getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast\n        where\n          getSrcSpan :: SrcSpan -> [SrcSpan]\n          getSrcSpan ss = [ss]\n\n\nshowAnns :: Map.Map ApiAnnKey [SrcSpan] -> String\nshowAnns anns = showAnnsList $ Map.toList anns\n\nshowAnnsList :: [(ApiAnnKey, [SrcSpan])] -> String\nshowAnnsList annsList = \"[\\n\" ++ (intercalate \",\\n\"\n   $ map (\\((s,k),v)\n              -> (\"((\" ++ pp s ++ \",\" ++ show k ++\"), \" ++ pp v ++ \")\"))\n   annsList)\n    ++ \"\\n]\\n\"\n\npp :: (Outputable a) => a -> String\npp a = showPpr unsafeGlobalDynFlags a\n\n\n-- ---------------------------------------------------------------------\n\n-- Copied from syb for the test\n\n\n-- | Generic queries of type \\\"r\\\",\n--   i.e., take any \\\"a\\\" and return an \\\"r\\\"\n--\ntype GenericQ r = forall a. Data a => a -> r\n\n\n-- | Make a generic query;\n--   start from a type-specific case;\n--   return a constant otherwise\n--\nmkQ :: ( Typeable a\n       , Typeable b\n       )\n    => r\n    -> (b -> r)\n    -> a\n    -> r\n(r `mkQ` br) a = case cast a of\n                        Just b  -> br b\n                        Nothing -> r\n\n\n\n-- | Summarise all nodes in top-down, left-to-right order\neverything :: (r -> r -> r) -> GenericQ r -> GenericQ r\n\n-- Apply f to x to summarise top-level node;\n-- use gmapQ to recurse into immediate subterms;\n-- use ordinary foldl to reduce list of intermediate results\n\neverything k f x = foldl k (f x) (gmapQ (everything k f) x)\n", "num_lines": 135}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\n\nimport Data.List\nimport SrcLoc\nimport GHC hiding (moduleName)\nimport HsDumpAst\nimport DynFlags\nimport Outputable hiding (space)\nimport System.Environment( getArgs )\nimport System.Exit\nimport System.FilePath\n\nimport qualified Data.Map        as Map\n\nusage :: String\nusage = unlines\n    [ \"usage: check-ppr (libdir) (file)\"\n    , \"\"\n    , \"where libdir is the GHC library directory (e.g. the output of\"\n    , \"ghc --print-libdir) and file is the file to parse.\"\n    ]\n\nmain :: IO()\nmain = do\n  args <- getArgs\n  case args of\n   [libdir,fileName] -> testOneFile libdir fileName\n   _ -> putStrLn usage\n\ntestOneFile :: FilePath -> String -> IO ()\ntestOneFile libdir fileName = do\n       p <- parseOneFile libdir fileName\n       let\n         origAst = showSDoc unsafeGlobalDynFlags\n                     $ showAstData BlankSrcSpan (pm_parsed_source p)\n         pped    = pragmas ++ \"\\n\" ++ pp (pm_parsed_source p)\n         anns    = pm_annotations p\n         pragmas = getPragmas anns\n\n         newFile = dropExtension fileName <.> \"ppr\" <.> takeExtension fileName\n         astFile = fileName <.> \"ast\"\n         newAstFile = fileName <.> \"ast.new\"\n\n       writeFile astFile origAst\n       writeFile newFile pped\n\n       p' <- parseOneFile libdir newFile\n\n       let newAstStr :: String\n           newAstStr = showSDoc unsafeGlobalDynFlags\n                         $ showAstData BlankSrcSpan (pm_parsed_source p')\n       writeFile newAstFile newAstStr\n\n       if origAst == newAstStr\n         then do\n           -- putStrLn \"ASTs matched\"\n           exitSuccess\n         else do\n           putStrLn \"AST Match Failed\"\n           putStrLn \"\\n===================================\\nOrig\\n\\n\"\n           putStrLn origAst\n           putStrLn \"\\n===================================\\nNew\\n\\n\"\n           putStrLn newAstStr\n           exitFailure\n\n\nparseOneFile :: FilePath -> FilePath -> IO ParsedModule\nparseOneFile libdir fileName = do\n       let modByFile m =\n             case ml_hs_file $ ms_location m of\n               Nothing -> False\n               Just fn -> fn == fileName\n       runGhc (Just libdir) $ do\n         dflags <- getSessionDynFlags\n         let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream\n         _ <- setSessionDynFlags dflags2\n         addTarget Target { targetId = TargetFile fileName Nothing\n                          , targetAllowObjCode = True\n                          , targetContents = Nothing }\n         _ <- load LoadAllTargets\n         graph <- getModuleGraph\n         let\n           modSum = case filter modByFile (mgModSummaries graph) of\n                     [x] -> x\n                     xs -> error $ \"Can't find module, got:\"\n                              ++ show (map (ml_hs_file . ms_location) xs)\n         parseModule modSum\n\ngetPragmas :: ApiAnns -> String\ngetPragmas anns = pragmaStr\n  where\n    tokComment (L _ (AnnBlockComment s)) = s\n    tokComment (L _ (AnnLineComment  s)) = s\n    tokComment _ = \"\"\n\n    comments = case Map.lookup noSrcSpan (snd anns) of\n      Nothing -> []\n      Just cl -> map tokComment $ sortLocated cl\n    pragmas = filter (\\c -> isPrefixOf \"{-#\" c ) comments\n    pragmaStr = intercalate \"\\n\" pragmas\n\npp :: (Outputable a) => a -> String\npp a = showPpr unsafeGlobalDynFlags a\n\n\n", "num_lines": 106}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- This program compares the sizes of corresponding files in two trees\n\n--   $ ./compareSizes --hi ~/ghc/darcs/ghc ~/ghc/6.12-branch/ghc\n--        Size | Change | Filename\n--      25644 | -0.99% | compiler/stage1/build/Demand.hi\n--      21103 | -0.98% | compiler/stage2/build/Demand.hi\n--     180044 | -0.98% | libraries/base/dist-install/build/GHC/Classes.hi\n--       6415 | -0.58% | .../Data/Array/Parallel/Prelude/Base/Tuple.hi\n--       6507 | -0.57% | .../Data/Array/Parallel/Prelude/Base/Tuple.hi\n--   [...]\n--       3264 |  3.16% | .../Parallel/Unlifted/Sequential/Flat/Enum.hi\n--      51389 |  3.30% | .../build/Language/Haskell/Extension.hi\n--       1415 | 72.18% | libraries/base/dist-install/build/Data/Tuple.hi\n--   28752162 | -0.00% | TOTAL\n\n-- Flags:\n--    --o to compare object files.\n--    --hi to compare interface files [DEFAULT]\n\n-- There's a hack to avoid descending into '*_split' directories\n\n\nmodule Main (main) where\n\nimport Control.Exception\nimport Control.Monad\nimport Data.List\nimport Data.Maybe\nimport Numeric\nimport System.Directory\nimport System.Environment\nimport System.FilePath\nimport System.IO\n\nmain :: IO ()\nmain = do hSetBuffering stdout LineBuffering\n          args <- getArgs\n          case args of\n              [\"--hi\", dir1, dir2] -> doit isHiFile dir1 dir2\n              [\"--o\", dir1, dir2]  -> doit isOFile  dir1 dir2\n              [dir1, dir2]         -> doit isHiFile dir1 dir2\n              _ -> error \"Bad arguments\"\n\nisHiFile :: FilePath -> Bool\nisHiFile = (\".hi\" `isSuffixOf`)\n\nisOFile :: FilePath -> Bool\nisOFile = (\".o\" `isSuffixOf`)\n\ndoit :: (FilePath -> Bool) -> FilePath -> FilePath -> IO ()\ndoit isFileInteresting dir1 dir2\n    = do when verbose $ putStrLn \"Reading tree 1\"\n         tree1 <- getTree isFileInteresting dir1 \".\" \".\"\n         when verbose $ putStrLn \"Reading tree 2\"\n         tree2 <- getTree isFileInteresting dir2 \".\" \".\"\n         when verbose $ putStrLn \"Comparing trees\"\n         let ds = compareTree tree1 tree2\n             ds' = sortBy comparingPercentage ds\n             total = mkTotalDifference ds'\n         mapM_ putStrLn $ showDifferences (ds' ++ [total])\n\nverbose :: Bool\nverbose = False\n\n----------------------------------------------------------------------\n-- Reading the trees\n\ndata Tree = Directory { nodeName :: FilePath, _subTrees :: [Tree] }\n          | File      { nodeName :: FilePath, _filePath :: FilePath,\n                                              _size :: Size }\n    deriving Show\n\ntype Size = Integer\ntype Percentage = Double\n\ngetTree :: (FilePath -> Bool) -> FilePath -> FilePath -> FilePath -> IO Tree\ngetTree isFileInteresting root dir subdir\n    = do entries <- getDirectoryContents (root </> dir </> subdir)\n         mSubtrees <- mapM doEntry $ sort $ filter interesting entries\n         return $ Directory subdir $ catMaybes mSubtrees\n    where interesting \".\"  = False\n          interesting \"..\" = False\n          -- We don't want to descend into object-splitting directories,\n          -- and compare the hundreds of split object files. Instead we\n          -- just compare the combined object file outside of the _split\n          -- directory.\n          interesting d    = not (\"_split\" `isSuffixOf` d)\n          dir' = dir <//> subdir\n          doEntry :: FilePath -> IO (Maybe Tree)\n          doEntry e = liftM Just (getTree isFileInteresting root dir' e)\n            `catchIO` \\_ -> -- XXX We ought to check this is a\n                            -- \"not a directory\" exception really\n                      if isFileInteresting e\n                      then do let fn = dir' <//> e\n                              h <- openFile (root </> fn) ReadMode\n                              size <- hFileSize h\n                              hClose h\n                              return $ Just $ File e fn size\n                      else return Nothing\n\ncatchIO :: IO a -> (IOError -> IO a) -> IO a\ncatchIO = catch\n\n----------------------------------------------------------------------\n-- Comparing the trees\n\ndata Difference = Difference FilePath Size Size Percentage\n    deriving Show\n\ncompareTree :: Tree -> Tree -> [Difference]\ncompareTree (Directory _ ts1) (Directory _ ts2) = compareTrees ts1 ts2\ncompareTree (File _ fn s1) (File _ _ s2)\n    = [Difference fn s1 s2 (mkPercentage s1 s2)]\ncompareTree _ _ = []\n\nmkPercentage :: Size -> Size -> Percentage\nmkPercentage s1 s2 = fromIntegral (s2 - s1) / fromIntegral s1\n\ncompareTrees :: [Tree] -> [Tree] -> [Difference]\ncompareTrees t1s@(t1 : t1s') t2s@(t2 : t2s')\n    = case nodeName t1 `compare` nodeName t2 of\n      LT ->                      compareTrees t1s' t2s\n      EQ -> compareTree t1 t2 ++ compareTrees t1s' t2s'\n      GT ->                      compareTrees t1s  t2s'\ncompareTrees _ _ = []\n\nshowDifferences :: [Difference] -> [String]\nshowDifferences ds = showTable [lpad, lpad, rpad]\n                     ([\"Size\", \"Change\", \"Filename\"] :\n                      map showDifference ds)\n\nshowDifference :: Difference -> [String]\nshowDifference (Difference fp s1 _ percentage)\n    = [show s1, showFFloat (Just 2) percentage \"%\", shorten fp]\n\nshorten :: FilePath -> FilePath\nshorten fp = let xs = map joinPath $ tails $ splitDirectories fp\n             in case xs of\n                x : _\n                 | length x <= allowed ->\n                    x\n                _ -> case dropWhile ((> allowed - 4) . length) xs of\n                     x : _ ->\n                         \"...\" </> x\n                     [] ->\n                         take (allowed - 3) (takeFileName fp) ++ \"...\"\n    where allowed = 50\n\ncomparingPercentage :: Difference -> Difference -> Ordering\ncomparingPercentage (Difference _ _ _ p1) (Difference _ _ _ p2)\n    = compare p1 p2\n\nmkTotalDifference :: [Difference] -> Difference\nmkTotalDifference ds = let s1 = sum [ x | Difference _ x _ _ <- ds ]\n                           s2 = sum [ x | Difference _ _ x _ <- ds ]\n                           percentage = mkPercentage s1 s2\n                       in Difference \"TOTAL\" s1 s2 percentage\n\n----------------------------------------------------------------------\n-- Utils\n\n(<//>) :: FilePath -> FilePath -> FilePath\n\".\" <//> fp = fp\ndir <//> fn = dir </> fn\n\nshowTable :: [Int -> String -> String] -> [[String]] -> [String]\nshowTable padders xss\n    = let lengths = map (maximum . map length) $ transpose xss\n      in map (concat . intersperse \" | \" . zipWith3 id padders lengths) xss\n\nlpad :: Int -> String -> String\nlpad n s = replicate (n - length s) ' ' ++ s\n\nrpad :: Int -> String -> String\nrpad n s = s ++ replicate (n - length s) ' '\n", "num_lines": 176}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- ------------------------------------------------------------------------\n\n(c) The GHC Team, 1992-2012\n\nDeriveConstants is a program that extracts information from the C\ndeclarations in the header files (primarily struct field offsets)\nand generates various files, such as a header file that can be #included\ninto non-C source containing this information.\n\nWe want to get information about code generated by the C compiler,\nsuch as the sizes of types, and offsets of struct fields.  We need\nthis because the layout of certain runtime objects is defined in C\nheaders (e.g. includes/rts/storage/Closures.h), but we need access to\nthe layout of these structures from a Haskell program (GHC).\n\nOne way to do this is to compile and run a C program that includes the\nheader files and prints out the sizes and offsets. However, when we\nare cross-compiling, we can't run a C program compiled for the target\nplatform.\n\nSo, this program works as follows: we generate a C program that when\ncompiled to an object file, has the information we need encoded as\nsymbol sizes.  This means that we can extract the information without\nneeding to run the program, by inspecting the object file using 'nm'.\n\n------------------------------------------------------------------------ -}\n\nimport Control.Monad (when, unless)\nimport Data.Bits (shiftL)\nimport Data.Char (toLower)\nimport Data.List (stripPrefix)\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport Data.Maybe (catMaybes)\nimport Numeric (readHex)\nimport System.Environment (getArgs)\nimport System.Exit (ExitCode(ExitSuccess), exitFailure)\nimport System.FilePath ((</>))\nimport System.IO (stderr, hPutStrLn)\nimport System.Process (showCommandForUser, readProcess, rawSystem)\n\nmain :: IO ()\nmain = do opts <- parseArgs\n          let getOption descr opt = case opt opts of\n                                    Just x -> return x\n                                    Nothing -> die (\"No \" ++ descr ++ \" given\")\n          mode <- getOption \"mode\" o_mode\n          fn <- getOption \"output filename\" o_outputFilename\n          os <- getOption \"target os\"   o_targetOS\n\n          let haskellWanteds = [ what | (wh, what) <- wanteds os\n                                      , wh `elem` [Haskell, Both] ]\n\n          case mode of\n              Gen_Haskell_Type     -> writeHaskellType     fn haskellWanteds\n              Gen_Haskell_Wrappers -> writeHaskellWrappers fn haskellWanteds\n              Gen_Haskell_Exports  -> writeHaskellExports  fn haskellWanteds\n              Gen_Computed cm ->\n                  do tmpdir  <- getOption \"tmpdir\"      o_tmpdir\n                     gccProg <- getOption \"gcc program\" o_gccProg\n                     nmProg  <- getOption \"nm program\"  o_nmProg\n                     let verbose = o_verbose opts\n                         gccFlags = o_gccFlags opts\n                     rs <- getWanted verbose os tmpdir gccProg gccFlags nmProg\n                                     (o_objdumpProg opts)\n                     let haskellRs = [ what\n                                     | (wh, what) <- rs\n                                     , wh `elem` [Haskell, Both] ]\n                         cRs = [ what\n                               | (wh, what) <- rs\n                               , wh `elem` [C, Both] ]\n                     case cm of\n                         ComputeHaskell -> writeHaskellValue fn haskellRs\n                         ComputeHeader  -> writeHeader       fn cRs\n\ndata Options = Options {\n                   o_verbose :: Bool,\n                   o_mode :: Maybe Mode,\n                   o_tmpdir :: Maybe FilePath,\n                   o_outputFilename :: Maybe FilePath,\n                   o_gccProg :: Maybe FilePath,\n                   o_gccFlags :: [String],\n                   o_nmProg :: Maybe FilePath,\n                   o_objdumpProg :: Maybe FilePath,\n                   o_targetOS :: Maybe String\n               }\n\nparseArgs :: IO Options\nparseArgs = do args <- getArgs\n               opts <- f emptyOptions args\n               return (opts {o_gccFlags = reverse (o_gccFlags opts)})\n    where emptyOptions = Options {\n                             o_verbose = False,\n                             o_mode = Nothing,\n                             o_tmpdir = Nothing,\n                             o_outputFilename = Nothing,\n                             o_gccProg = Nothing,\n                             o_gccFlags = [],\n                             o_nmProg = Nothing,\n                             o_objdumpProg = Nothing,\n                             o_targetOS = Nothing\n                         }\n          f opts [] = return opts\n          f opts (\"-v\" : args')\n              = f (opts {o_verbose = True}) args'\n          f opts (\"--gen-haskell-type\" : args')\n              = f (opts {o_mode = Just Gen_Haskell_Type}) args'\n          f opts (\"--gen-haskell-value\" : args')\n              = f (opts {o_mode = Just (Gen_Computed ComputeHaskell)}) args'\n          f opts (\"--gen-haskell-wrappers\" : args')\n              = f (opts {o_mode = Just Gen_Haskell_Wrappers}) args'\n          f opts (\"--gen-haskell-exports\" : args')\n              = f (opts {o_mode = Just Gen_Haskell_Exports}) args'\n          f opts (\"--gen-header\" : args')\n              = f (opts {o_mode = Just (Gen_Computed ComputeHeader)}) args'\n          f opts (\"--tmpdir\" : dir : args')\n              = f (opts {o_tmpdir = Just dir}) args'\n          f opts (\"-o\" : fn : args')\n              = f (opts {o_outputFilename = Just fn}) args'\n          f opts (\"--gcc-program\" : prog : args')\n              = f (opts {o_gccProg = Just prog}) args'\n          f opts (\"--gcc-flag\" : flag : args')\n              = f (opts {o_gccFlags = flag : o_gccFlags opts}) args'\n          f opts (\"--nm-program\" : prog : args')\n              = f (opts {o_nmProg = Just prog}) args'\n          f opts (\"--objdump-program\" : prog : args')\n              = f (opts {o_objdumpProg = Just prog}) args'\n          f opts (\"--target-os\" : os : args')\n              = f (opts {o_targetOS = Just os}) args'\n          f _ (flag : _) = die (\"Unrecognised flag: \" ++ show flag)\n\ndata Mode = Gen_Haskell_Type\n          | Gen_Haskell_Wrappers\n          | Gen_Haskell_Exports\n          | Gen_Computed ComputeMode\n\ndata ComputeMode = ComputeHaskell | ComputeHeader\n\ntype Wanteds = [(Where, What Fst)]\ntype Results = [(Where, What Snd)]\n\ntype Name = String\nnewtype CExpr = CExpr String\nnewtype CPPExpr = CPPExpr String\ndata What f = GetFieldType   Name (f CExpr   Integer)\n            | GetClosureSize Name (f CExpr   Integer)\n            | GetWord        Name (f CExpr   Integer)\n            | GetInt         Name (f CExpr   Integer)\n            | GetNatural     Name (f CExpr   Integer)\n            | GetBool        Name (f CPPExpr Bool)\n            | StructFieldMacro    Name\n            | ClosureFieldMacro   Name\n            | ClosurePayloadMacro Name\n            | FieldTypeGcptrMacro Name\n\ndata Fst a b = Fst a\ndata Snd a b = Snd b\n\ndata Where = C | Haskell | Both\n    deriving Eq\n\nconstantInt :: Where -> Name -> String -> Wanteds\nconstantInt w name expr = [(w, GetInt name (Fst (CExpr expr)))]\n\nconstantWord :: Where -> Name -> String -> Wanteds\nconstantWord w name expr = [(w, GetWord name (Fst (CExpr expr)))]\n\nconstantNatural :: Where -> Name -> String -> Wanteds\nconstantNatural w name expr = [(w, GetNatural name (Fst (CExpr expr)))]\n\nconstantBool :: Where -> Name -> String -> Wanteds\nconstantBool w name expr = [(w, GetBool name (Fst (CPPExpr expr)))]\n\nfieldOffset :: Where -> String -> String -> Wanteds\nfieldOffset w theType theField = fieldOffset_ w nameBase theType theField\n    where nameBase = theType ++ \"_\" ++ theField\n\nfieldOffset_ :: Where -> Name -> String -> String -> Wanteds\nfieldOffset_ w nameBase theType theField = [(w, GetWord name (Fst (CExpr expr)))]\n    where name = \"OFFSET_\" ++ nameBase\n          expr = \"offsetof(\" ++ theType ++ \", \" ++ theField ++ \")\"\n\n-- FieldType is for defining REP_x to be b32 etc\n-- These are both the C-- types used in a load\n--    e.g.  b32[addr]\n-- and the names of the CmmTypes in the compiler\n--    b32 :: CmmType\nfieldType' :: Where -> String -> String -> Wanteds\nfieldType' w theType theField\n    = fieldType_' w nameBase theType theField\n    where nameBase = theType ++ \"_\" ++ theField\n\nfieldType_' :: Where -> Name -> String -> String -> Wanteds\nfieldType_' w nameBase theType theField\n    = [(w, GetFieldType name (Fst (CExpr expr)))]\n    where name = \"REP_\" ++ nameBase\n          expr = \"FIELD_SIZE(\" ++ theType ++ \", \" ++ theField ++ \")\"\n\nstructField :: Where -> String -> String -> Wanteds\nstructField = structFieldHelper C\n\nstructFieldH :: Where -> String -> String -> Wanteds\nstructFieldH w = structFieldHelper w w\n\nstructField_ :: Where -> Name -> String -> String -> Wanteds\nstructField_ w nameBase theType theField\n    = fieldOffset_ w nameBase theType theField\n   ++ fieldType_' C nameBase theType theField\n   ++ structFieldMacro nameBase\n\nstructFieldMacro :: Name -> Wanteds\nstructFieldMacro nameBase = [(C, StructFieldMacro nameBase)]\n\n-- Outputs the byte offset and MachRep for a field\nstructFieldHelper :: Where -> Where -> String -> String -> Wanteds\nstructFieldHelper wFT w theType theField = fieldOffset w theType theField\n                                        ++ fieldType' wFT theType theField\n                                        ++ structFieldMacro nameBase\n    where nameBase = theType ++ \"_\" ++ theField\n\nclosureFieldMacro :: Name -> Wanteds\nclosureFieldMacro nameBase = [(C, ClosureFieldMacro nameBase)]\n\nclosurePayload :: Where -> String -> String -> Wanteds\nclosurePayload w theType theField\n    = closureFieldOffset_ w nameBase theType theField\n   ++ closurePayloadMacro nameBase\n    where nameBase = theType ++ \"_\" ++ theField\n\nclosurePayloadMacro :: Name -> Wanteds\nclosurePayloadMacro nameBase = [(C, ClosurePayloadMacro nameBase)]\n\n-- Byte offset and MachRep for a closure field, minus the header\nclosureField_ :: Where -> Name -> String -> String -> Wanteds\nclosureField_ w nameBase theType theField\n    = closureFieldOffset_ w nameBase theType theField\n   ++ fieldType_' C nameBase theType theField\n   ++ closureFieldMacro nameBase\n\nclosureField :: Where -> String -> String -> Wanteds\nclosureField w theType theField = closureField_ w nameBase theType theField\n    where nameBase = theType ++ \"_\" ++ theField\n\nclosureFieldOffset_ :: Where -> Name -> String -> String -> Wanteds\nclosureFieldOffset_ w nameBase theType theField\n    = defOffset w nameBase (CExpr (\"offsetof(\" ++ theType ++ \", \" ++ theField ++ \") - TYPE_SIZE(StgHeader)\"))\n\n-- Size of a closure type, minus the header, named SIZEOF_<type>_NoHdr\n-- Also, we #define SIZEOF_<type> to be the size of the whole closure for .cmm.\nclosureSize :: Where -> String -> Wanteds\nclosureSize w theType = defSize        w (theType ++ \"_NoHdr\") (CExpr expr)\n                     ++ defClosureSize C theType               (CExpr expr)\n    where expr = \"TYPE_SIZE(\" ++ theType ++ \") - TYPE_SIZE(StgHeader)\"\n\n-- Byte offset and MachRep for a closure field, minus the header\nclosureFieldGcptr :: Where -> String -> String -> Wanteds\nclosureFieldGcptr w theType theField\n    = closureFieldOffset_ w nameBase theType theField\n   ++ fieldTypeGcptr nameBase\n   ++ closureFieldMacro nameBase\n    where nameBase = theType ++ \"_\" ++ theField\n\nfieldTypeGcptr :: Name -> Wanteds\nfieldTypeGcptr nameBase = [(C, FieldTypeGcptrMacro nameBase)]\n\nclosureFieldOffset :: Where -> String -> String -> Wanteds\nclosureFieldOffset w theType theField\n    = defOffset w nameBase (CExpr expr)\n    where nameBase = theType ++ \"_\" ++ theField\n          expr = \"offsetof(\" ++ theType ++ \", \" ++ theField ++ \") - TYPE_SIZE(StgHeader)\"\n\nthunkSize :: Where -> String -> Wanteds\nthunkSize w theType\n    = defSize w (theType ++ \"_NoThunkHdr\") (CExpr expr)\n  ++ closureSize w theType\n    where expr = \"TYPE_SIZE(\" ++ theType ++ \") - TYPE_SIZE(StgThunkHeader)\"\n\ndefIntOffset :: Where -> Name -> String -> Wanteds\ndefIntOffset w nameBase cExpr = [(w, GetInt (\"OFFSET_\" ++ nameBase) (Fst (CExpr cExpr)))]\n\ndefOffset :: Where -> Name -> CExpr -> Wanteds\ndefOffset w nameBase cExpr = [(w, GetWord (\"OFFSET_\" ++ nameBase) (Fst cExpr))]\n\nstructSize :: Where -> String -> Wanteds\nstructSize w theType = defSize w theType (CExpr (\"TYPE_SIZE(\" ++ theType ++ \")\"))\n\ndefSize :: Where -> Name -> CExpr -> Wanteds\ndefSize w nameBase cExpr = [(w, GetWord (\"SIZEOF_\" ++ nameBase) (Fst cExpr))]\n\ndefClosureSize :: Where -> Name -> CExpr -> Wanteds\ndefClosureSize w nameBase cExpr = [(w, GetClosureSize (\"SIZEOF_\" ++ nameBase) (Fst cExpr))]\n\nhaskellise :: Name -> Name\nhaskellise (c : cs) = toLower c : cs\nhaskellise \"\" = \"\"\n\nwanteds :: String -> Wanteds\nwanteds os = concat\n          [-- Control group constant for integrity check; this\n           -- round-tripped constant is used for testing that\n           -- derivedConstant works as expected\n           constantWord Both \"CONTROL_GROUP_CONST_291\" \"0x123\"\n           -- Closure header sizes.\n          ,constantWord Both \"STD_HDR_SIZE\"\n                             -- grrr.. PROFILING is on so we need to\n                             -- subtract sizeofW(StgProfHeader)\n                             \"sizeofW(StgHeader) - sizeofW(StgProfHeader)\"\n          ,constantWord Both \"PROF_HDR_SIZE\" \"sizeofW(StgProfHeader)\"\n\n           -- Size of a storage manager block (in bytes).\n          ,constantWord Both \"BLOCK_SIZE\"  \"BLOCK_SIZE\"\n          ,constantWord C    \"MBLOCK_SIZE\" \"MBLOCK_SIZE\"\n           -- blocks that fit in an MBlock, leaving space for the block\n           -- descriptors\n          ,constantWord Both \"BLOCKS_PER_MBLOCK\" \"BLOCKS_PER_MBLOCK\"\n           -- could be derived, but better to save doing the calculation twice\n\n          ,constantWord Both \"TICKY_BIN_COUNT\" \"TICKY_BIN_COUNT\"\n           -- number of bins for histograms used in ticky code\n\n          ,fieldOffset Both \"StgRegTable\" \"rR1\"\n          ,fieldOffset Both \"StgRegTable\" \"rR2\"\n          ,fieldOffset Both \"StgRegTable\" \"rR3\"\n          ,fieldOffset Both \"StgRegTable\" \"rR4\"\n          ,fieldOffset Both \"StgRegTable\" \"rR5\"\n          ,fieldOffset Both \"StgRegTable\" \"rR6\"\n          ,fieldOffset Both \"StgRegTable\" \"rR7\"\n          ,fieldOffset Both \"StgRegTable\" \"rR8\"\n          ,fieldOffset Both \"StgRegTable\" \"rR9\"\n          ,fieldOffset Both \"StgRegTable\" \"rR10\"\n          ,fieldOffset Both \"StgRegTable\" \"rF1\"\n          ,fieldOffset Both \"StgRegTable\" \"rF2\"\n          ,fieldOffset Both \"StgRegTable\" \"rF3\"\n          ,fieldOffset Both \"StgRegTable\" \"rF4\"\n          ,fieldOffset Both \"StgRegTable\" \"rF5\"\n          ,fieldOffset Both \"StgRegTable\" \"rF6\"\n          ,fieldOffset Both \"StgRegTable\" \"rD1\"\n          ,fieldOffset Both \"StgRegTable\" \"rD2\"\n          ,fieldOffset Both \"StgRegTable\" \"rD3\"\n          ,fieldOffset Both \"StgRegTable\" \"rD4\"\n          ,fieldOffset Both \"StgRegTable\" \"rD5\"\n          ,fieldOffset Both \"StgRegTable\" \"rD6\"\n          ,fieldOffset Both \"StgRegTable\" \"rXMM1\"\n          ,fieldOffset Both \"StgRegTable\" \"rXMM2\"\n          ,fieldOffset Both \"StgRegTable\" \"rXMM3\"\n          ,fieldOffset Both \"StgRegTable\" \"rXMM4\"\n          ,fieldOffset Both \"StgRegTable\" \"rXMM5\"\n          ,fieldOffset Both \"StgRegTable\" \"rXMM6\"\n          ,fieldOffset Both \"StgRegTable\" \"rYMM1\"\n          ,fieldOffset Both \"StgRegTable\" \"rYMM2\"\n          ,fieldOffset Both \"StgRegTable\" \"rYMM3\"\n          ,fieldOffset Both \"StgRegTable\" \"rYMM4\"\n          ,fieldOffset Both \"StgRegTable\" \"rYMM5\"\n          ,fieldOffset Both \"StgRegTable\" \"rYMM6\"\n          ,fieldOffset Both \"StgRegTable\" \"rZMM1\"\n          ,fieldOffset Both \"StgRegTable\" \"rZMM2\"\n          ,fieldOffset Both \"StgRegTable\" \"rZMM3\"\n          ,fieldOffset Both \"StgRegTable\" \"rZMM4\"\n          ,fieldOffset Both \"StgRegTable\" \"rZMM5\"\n          ,fieldOffset Both \"StgRegTable\" \"rZMM6\"\n          ,fieldOffset Both \"StgRegTable\" \"rL1\"\n          ,fieldOffset Both \"StgRegTable\" \"rSp\"\n          ,fieldOffset Both \"StgRegTable\" \"rSpLim\"\n          ,fieldOffset Both \"StgRegTable\" \"rHp\"\n          ,fieldOffset Both \"StgRegTable\" \"rHpLim\"\n          ,fieldOffset Both \"StgRegTable\" \"rCCCS\"\n          ,fieldOffset Both \"StgRegTable\" \"rCurrentTSO\"\n          ,fieldOffset Both \"StgRegTable\" \"rCurrentNursery\"\n          ,fieldOffset Both \"StgRegTable\" \"rHpAlloc\"\n          ,structField C    \"StgRegTable\" \"rRet\"\n          ,structField C    \"StgRegTable\" \"rNursery\"\n\n          ,defIntOffset Both \"stgEagerBlackholeInfo\"\n                             \"FUN_OFFSET(stgEagerBlackholeInfo)\"\n          ,defIntOffset Both \"stgGCEnter1\" \"FUN_OFFSET(stgGCEnter1)\"\n          ,defIntOffset Both \"stgGCFun\"    \"FUN_OFFSET(stgGCFun)\"\n\n          ,fieldOffset Both \"Capability\" \"r\"\n          ,fieldOffset C    \"Capability\" \"lock\"\n          ,structField C    \"Capability\" \"no\"\n          ,structField C    \"Capability\" \"mut_lists\"\n          ,structField C    \"Capability\" \"context_switch\"\n          ,structField C    \"Capability\" \"interrupt\"\n          ,structField C    \"Capability\" \"sparks\"\n          ,structField C    \"Capability\" \"total_allocated\"\n          ,structField C    \"Capability\" \"weak_ptr_list_hd\"\n          ,structField C    \"Capability\" \"weak_ptr_list_tl\"\n\n          ,structField Both \"bdescr\" \"start\"\n          ,structField Both \"bdescr\" \"free\"\n          ,structField Both \"bdescr\" \"blocks\"\n          ,structField C    \"bdescr\" \"gen_no\"\n          ,structField C    \"bdescr\" \"link\"\n          ,structField Both \"bdescr\" \"flags\"\n\n          ,structSize C  \"generation\"\n          ,structField C \"generation\" \"n_new_large_words\"\n          ,structField C \"generation\" \"weak_ptr_list\"\n\n          ,structSize Both   \"CostCentreStack\"\n          ,structField C     \"CostCentreStack\" \"ccsID\"\n          ,structFieldH Both \"CostCentreStack\" \"mem_alloc\"\n          ,structFieldH Both \"CostCentreStack\" \"scc_count\"\n          ,structField C     \"CostCentreStack\" \"prevStack\"\n\n          ,structField C \"CostCentre\" \"ccID\"\n          ,structField C \"CostCentre\" \"link\"\n\n          ,structField C     \"StgHeader\" \"info\"\n          ,structField_ Both \"StgHeader_ccs\" \"StgHeader\" \"prof.ccs\"\n          ,structField_ Both \"StgHeader_ldvw\" \"StgHeader\" \"prof.hp.ldvw\"\n\n          ,structSize Both \"StgSMPThunkHeader\"\n\n          ,closurePayload C \"StgClosure\" \"payload\"\n\n          ,structFieldH Both \"StgEntCounter\" \"allocs\"\n          ,structFieldH Both \"StgEntCounter\" \"allocd\"\n          ,structField  Both \"StgEntCounter\" \"registeredp\"\n          ,structField  Both \"StgEntCounter\" \"link\"\n          ,structField  Both \"StgEntCounter\" \"entry_count\"\n\n          ,closureSize Both \"StgUpdateFrame\"\n          ,closureSize C    \"StgCatchFrame\"\n          ,closureSize C    \"StgStopFrame\"\n\n          ,closureSize  Both \"StgMutArrPtrs\"\n          ,closureField Both \"StgMutArrPtrs\" \"ptrs\"\n          ,closureField Both \"StgMutArrPtrs\" \"size\"\n\n          ,closureSize  Both \"StgSmallMutArrPtrs\"\n          ,closureField Both \"StgSmallMutArrPtrs\" \"ptrs\"\n\n          ,closureSize    Both \"StgArrBytes\"\n          ,closureField   Both \"StgArrBytes\" \"bytes\"\n          ,closurePayload C    \"StgArrBytes\" \"payload\"\n\n          ,closureField  C    \"StgTSO\"      \"_link\"\n          ,closureField  C    \"StgTSO\"      \"global_link\"\n          ,closureField  C    \"StgTSO\"      \"what_next\"\n          ,closureField  C    \"StgTSO\"      \"why_blocked\"\n          ,closureField  C    \"StgTSO\"      \"block_info\"\n          ,closureField  C    \"StgTSO\"      \"blocked_exceptions\"\n          ,closureField  C    \"StgTSO\"      \"id\"\n          ,closureField  C    \"StgTSO\"      \"cap\"\n          ,closureField  C    \"StgTSO\"      \"saved_errno\"\n          ,closureField  C    \"StgTSO\"      \"trec\"\n          ,closureField  C    \"StgTSO\"      \"flags\"\n          ,closureField  C    \"StgTSO\"      \"dirty\"\n          ,closureField  C    \"StgTSO\"      \"bq\"\n          ,closureField  Both \"StgTSO\"      \"alloc_limit\"\n          ,closureField_ Both \"StgTSO_cccs\" \"StgTSO\" \"prof.cccs\"\n          ,closureField  Both \"StgTSO\"      \"stackobj\"\n\n          ,closureField       Both \"StgStack\" \"sp\"\n          ,closureFieldOffset Both \"StgStack\" \"stack\"\n          ,closureField       C    \"StgStack\" \"stack_size\"\n          ,closureField       C    \"StgStack\" \"dirty\"\n\n          ,structSize C \"StgTSOProfInfo\"\n\n          ,closureField Both \"StgUpdateFrame\" \"updatee\"\n\n          ,closureField C \"StgCatchFrame\" \"handler\"\n          ,closureField C \"StgCatchFrame\" \"exceptions_blocked\"\n\n          ,closureSize       C \"StgPAP\"\n          ,closureField      C \"StgPAP\" \"n_args\"\n          ,closureFieldGcptr C \"StgPAP\" \"fun\"\n          ,closureField      C \"StgPAP\" \"arity\"\n          ,closurePayload    C \"StgPAP\" \"payload\"\n\n          ,thunkSize         C \"StgAP\"\n          ,closureField      C \"StgAP\" \"n_args\"\n          ,closureFieldGcptr C \"StgAP\" \"fun\"\n          ,closurePayload    C \"StgAP\" \"payload\"\n\n          ,thunkSize         C \"StgAP_STACK\"\n          ,closureField      C \"StgAP_STACK\" \"size\"\n          ,closureFieldGcptr C \"StgAP_STACK\" \"fun\"\n          ,closurePayload    C \"StgAP_STACK\" \"payload\"\n\n          ,thunkSize C \"StgSelector\"\n\n          ,closureFieldGcptr C \"StgInd\" \"indirectee\"\n\n          ,closureSize  C \"StgMutVar\"\n          ,closureField C \"StgMutVar\" \"var\"\n\n          ,closureSize  C \"StgAtomicallyFrame\"\n          ,closureField C \"StgAtomicallyFrame\" \"code\"\n          ,closureField C \"StgAtomicallyFrame\" \"result\"\n\n          ,closureField C \"StgTRecHeader\" \"enclosing_trec\"\n\n          ,closureSize  C \"StgCatchSTMFrame\"\n          ,closureField C \"StgCatchSTMFrame\" \"handler\"\n          ,closureField C \"StgCatchSTMFrame\" \"code\"\n\n          ,closureSize  C \"StgCatchRetryFrame\"\n          ,closureField C \"StgCatchRetryFrame\" \"running_alt_code\"\n          ,closureField C \"StgCatchRetryFrame\" \"first_code\"\n          ,closureField C \"StgCatchRetryFrame\" \"alt_code\"\n\n          ,closureField C \"StgTVarWatchQueue\" \"closure\"\n          ,closureField C \"StgTVarWatchQueue\" \"next_queue_entry\"\n          ,closureField C \"StgTVarWatchQueue\" \"prev_queue_entry\"\n\n          ,closureSize  C \"StgTVar\"\n          ,closureField C \"StgTVar\" \"current_value\"\n          ,closureField C \"StgTVar\" \"first_watch_queue_entry\"\n          ,closureField C \"StgTVar\" \"num_updates\"\n\n          ,closureSize  C \"StgWeak\"\n          ,closureField C \"StgWeak\" \"link\"\n          ,closureField C \"StgWeak\" \"key\"\n          ,closureField C \"StgWeak\" \"value\"\n          ,closureField C \"StgWeak\" \"finalizer\"\n          ,closureField C \"StgWeak\" \"cfinalizers\"\n\n          ,closureSize  C \"StgCFinalizerList\"\n          ,closureField C \"StgCFinalizerList\" \"link\"\n          ,closureField C \"StgCFinalizerList\" \"fptr\"\n          ,closureField C \"StgCFinalizerList\" \"ptr\"\n          ,closureField C \"StgCFinalizerList\" \"eptr\"\n          ,closureField C \"StgCFinalizerList\" \"flag\"\n\n          ,closureSize  C \"StgMVar\"\n          ,closureField C \"StgMVar\" \"head\"\n          ,closureField C \"StgMVar\" \"tail\"\n          ,closureField C \"StgMVar\" \"value\"\n\n          ,closureSize  C \"StgMVarTSOQueue\"\n          ,closureField C \"StgMVarTSOQueue\" \"link\"\n          ,closureField C \"StgMVarTSOQueue\" \"tso\"\n\n          ,closureSize    C \"StgBCO\"\n          ,closureField   C \"StgBCO\" \"instrs\"\n          ,closureField   C \"StgBCO\" \"literals\"\n          ,closureField   C \"StgBCO\" \"ptrs\"\n          ,closureField   C \"StgBCO\" \"arity\"\n          ,closureField   C \"StgBCO\" \"size\"\n          ,closurePayload C \"StgBCO\" \"bitmap\"\n\n          ,closureSize  C \"StgStableName\"\n          ,closureField C \"StgStableName\" \"sn\"\n\n          ,closureSize  C \"StgBlockingQueue\"\n          ,closureField C \"StgBlockingQueue\" \"bh\"\n          ,closureField C \"StgBlockingQueue\" \"owner\"\n          ,closureField C \"StgBlockingQueue\" \"queue\"\n          ,closureField C \"StgBlockingQueue\" \"link\"\n\n          ,closureSize  C \"MessageBlackHole\"\n          ,closureField C \"MessageBlackHole\" \"link\"\n          ,closureField C \"MessageBlackHole\" \"tso\"\n          ,closureField C \"MessageBlackHole\" \"bh\"\n\n          ,closureSize  C \"StgCompactNFData\"\n          ,closureField C \"StgCompactNFData\" \"totalW\"\n          ,closureField C \"StgCompactNFData\" \"autoBlockW\"\n          ,closureField C \"StgCompactNFData\" \"nursery\"\n          ,closureField C \"StgCompactNFData\" \"last\"\n          ,closureField C \"StgCompactNFData\" \"hp\"\n          ,closureField C \"StgCompactNFData\" \"hpLim\"\n          ,closureField C \"StgCompactNFData\" \"hash\"\n          ,closureField C \"StgCompactNFData\" \"result\"\n\n          ,structSize   C \"StgCompactNFDataBlock\"\n          ,structField  C \"StgCompactNFDataBlock\" \"self\"\n          ,structField  C \"StgCompactNFDataBlock\" \"owner\"\n          ,structField  C \"StgCompactNFDataBlock\" \"next\"\n\n          ,structField_ C \"RtsFlags_ProfFlags_showCCSOnException\"\n                          \"RTS_FLAGS\" \"ProfFlags.showCCSOnException\"\n          ,structField_ C \"RtsFlags_DebugFlags_apply\"\n                          \"RTS_FLAGS\" \"DebugFlags.apply\"\n          ,structField_ C \"RtsFlags_DebugFlags_sanity\"\n                          \"RTS_FLAGS\" \"DebugFlags.sanity\"\n          ,structField_ C \"RtsFlags_DebugFlags_weak\"\n                          \"RTS_FLAGS\" \"DebugFlags.weak\"\n          ,structField_ C \"RtsFlags_GcFlags_initialStkSize\"\n                          \"RTS_FLAGS\" \"GcFlags.initialStkSize\"\n          ,structField_ C \"RtsFlags_MiscFlags_tickInterval\"\n                          \"RTS_FLAGS\" \"MiscFlags.tickInterval\"\n\n          ,structSize   C \"StgFunInfoExtraFwd\"\n          ,structField  C \"StgFunInfoExtraFwd\" \"slow_apply\"\n          ,structField  C \"StgFunInfoExtraFwd\" \"fun_type\"\n          ,structFieldH Both \"StgFunInfoExtraFwd\" \"arity\"\n          ,structField_ C \"StgFunInfoExtraFwd_bitmap\" \"StgFunInfoExtraFwd\" \"b.bitmap\"\n\n          ,structSize   Both \"StgFunInfoExtraRev\"\n          ,structField  C    \"StgFunInfoExtraRev\" \"slow_apply_offset\"\n          ,structField  C    \"StgFunInfoExtraRev\" \"fun_type\"\n          ,structFieldH Both \"StgFunInfoExtraRev\" \"arity\"\n          ,structField_ C    \"StgFunInfoExtraRev_bitmap\" \"StgFunInfoExtraRev\" \"b.bitmap\"\n          ,structField_ C    \"StgFunInfoExtraRev_bitmap_offset\" \"StgFunInfoExtraRev\" \"b.bitmap_offset\"\n\n          ,structField C \"StgLargeBitmap\" \"size\"\n          ,fieldOffset C \"StgLargeBitmap\" \"bitmap\"\n\n          ,structSize  C \"snEntry\"\n          ,structField C \"snEntry\" \"sn_obj\"\n          ,structField C \"snEntry\" \"addr\"\n\n          ,structSize  C \"spEntry\"\n          ,structField C \"spEntry\" \"addr\"\n\n           -- Note that this conditional part only affects the C headers.\n           -- That's important, as it means we get the same PlatformConstants\n           -- type on all platforms.\n          ,if os == \"mingw32\"\n           then concat [structSize  C \"StgAsyncIOResult\"\n                       ,structField C \"StgAsyncIOResult\" \"reqID\"\n                       ,structField C \"StgAsyncIOResult\" \"len\"\n                       ,structField C \"StgAsyncIOResult\" \"errCode\"]\n           else []\n\n          -- pre-compiled thunk types\n          ,constantWord Haskell \"MAX_SPEC_SELECTEE_SIZE\" \"MAX_SPEC_SELECTEE_SIZE\"\n          ,constantWord Haskell \"MAX_SPEC_AP_SIZE\"       \"MAX_SPEC_AP_SIZE\"\n\n          -- closure sizes: these do NOT include the header (see below for\n          -- header sizes)\n          ,constantWord Haskell \"MIN_PAYLOAD_SIZE\" \"MIN_PAYLOAD_SIZE\"\n\n          ,constantInt  Haskell \"MIN_INTLIKE\" \"MIN_INTLIKE\"\n          ,constantWord Haskell \"MAX_INTLIKE\" \"MAX_INTLIKE\"\n\n          ,constantWord Haskell \"MIN_CHARLIKE\" \"MIN_CHARLIKE\"\n          ,constantWord Haskell \"MAX_CHARLIKE\" \"MAX_CHARLIKE\"\n\n          ,constantWord Haskell \"MUT_ARR_PTRS_CARD_BITS\" \"MUT_ARR_PTRS_CARD_BITS\"\n\n          -- A section of code-generator-related MAGIC CONSTANTS.\n          ,constantWord Haskell \"MAX_Vanilla_REG\"      \"MAX_VANILLA_REG\"\n          ,constantWord Haskell \"MAX_Float_REG\"        \"MAX_FLOAT_REG\"\n          ,constantWord Haskell \"MAX_Double_REG\"       \"MAX_DOUBLE_REG\"\n          ,constantWord Haskell \"MAX_Long_REG\"         \"MAX_LONG_REG\"\n          ,constantWord Haskell \"MAX_XMM_REG\"          \"MAX_XMM_REG\"\n          ,constantWord Haskell \"MAX_Real_Vanilla_REG\" \"MAX_REAL_VANILLA_REG\"\n          ,constantWord Haskell \"MAX_Real_Float_REG\"   \"MAX_REAL_FLOAT_REG\"\n          ,constantWord Haskell \"MAX_Real_Double_REG\"  \"MAX_REAL_DOUBLE_REG\"\n          ,constantWord Haskell \"MAX_Real_XMM_REG\"     \"MAX_REAL_XMM_REG\"\n          ,constantWord Haskell \"MAX_Real_Long_REG\"    \"MAX_REAL_LONG_REG\"\n\n          -- This tells the native code generator the size of the spill\n          -- area it has available.\n          ,constantWord Haskell \"RESERVED_C_STACK_BYTES\" \"RESERVED_C_STACK_BYTES\"\n          -- The amount of (Haskell) stack to leave free for saving\n          -- registers when returning to the scheduler.\n          ,constantWord Haskell \"RESERVED_STACK_WORDS\" \"RESERVED_STACK_WORDS\"\n          -- Continuations that need more than this amount of stack\n          -- should do their own stack check (see bug #1466).\n          ,constantWord Haskell \"AP_STACK_SPLIM\" \"AP_STACK_SPLIM\"\n\n          -- Size of a word, in bytes\n          ,constantWord Haskell \"WORD_SIZE\" \"SIZEOF_HSWORD\"\n\n          -- Size of a double in StgWords.\n          ,constantWord Haskell \"DOUBLE_SIZE\" \"SIZEOF_DOUBLE\"\n\n          -- Size of a C int, in bytes. May be smaller than wORD_SIZE.\n          ,constantWord Haskell \"CINT_SIZE\"       \"SIZEOF_INT\"\n          ,constantWord Haskell \"CLONG_SIZE\"      \"SIZEOF_LONG\"\n          ,constantWord Haskell \"CLONG_LONG_SIZE\" \"SIZEOF_LONG_LONG\"\n\n          -- Number of bits to shift a bitfield left by in an info table.\n          ,constantWord Haskell \"BITMAP_BITS_SHIFT\" \"BITMAP_BITS_SHIFT\"\n\n          -- Amount of pointer bits used for semi-tagging constructor closures\n          ,constantWord Haskell \"TAG_BITS\" \"TAG_BITS\"\n\n          ,constantBool Haskell \"WORDS_BIGENDIAN\"    \"defined(WORDS_BIGENDIAN)\"\n          ,constantBool Haskell \"DYNAMIC_BY_DEFAULT\" \"defined(DYNAMIC_BY_DEFAULT)\"\n\n          ,constantWord    Haskell \"LDV_SHIFT\"         \"LDV_SHIFT\"\n          ,constantNatural Haskell \"ILDV_CREATE_MASK\"  \"LDV_CREATE_MASK\"\n          ,constantNatural Haskell \"ILDV_STATE_CREATE\" \"LDV_STATE_CREATE\"\n          ,constantNatural Haskell \"ILDV_STATE_USE\"    \"LDV_STATE_USE\"\n          ]\n\ngetWanted :: Bool -> String -> FilePath -> FilePath -> [String] -> FilePath -> Maybe FilePath\n             -> IO Results\ngetWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram\n    = do let cStuff = unlines (headers ++ concatMap (doWanted . snd) (wanteds os))\n             cFile = tmpdir </> \"tmp.c\"\n             oFile = tmpdir </> \"tmp.o\"\n         writeFile cFile cStuff\n         execute verbose gccProgram (gccFlags ++ [\"-c\", cFile, \"-o\", oFile])\n         xs <- case os of\n                 \"openbsd\" -> readProcess objdumpProgam [\"--syms\", oFile] \"\"\n                 \"aix\"     -> readProcess objdumpProgam [\"--syms\", oFile] \"\"\n                 _         -> readProcess nmProgram [\"-P\", oFile] \"\"\n\n         let ls = lines xs\n             m = Map.fromList $ case os of\n                 \"aix\" -> parseAixObjdump ls\n                 _     -> catMaybes $ map parseNmLine ls\n\n         case Map.lookup \"CONTROL_GROUP_CONST_291\" m of\n             Just 292   -> return () -- OK\n             Nothing    -> die \"CONTROL_GROUP_CONST_291 missing!\"\n             Just 0x292 -> die $ \"broken 'nm' detected, see https://ghc.haskell.org/ticket/11744.\\n\"\n                              ++ \"\\n\"\n                              ++ \"Workaround: You may want to pass\\n\"\n                              ++ \"    --with-nm=$(xcrun --find nm-classic)\\n\"\n                              ++ \"to 'configure'.\\n\"\n             Just x     -> die (\"unexpected value round-tripped for CONTROL_GROUP_CONST_291: \" ++ show x)\n\n         rs <- mapM (lookupResult m) (wanteds os)\n         return rs\n    where headers = [\"#define IN_STG_CODE 0\",\n                     \"\",\n                     \"/*\",\n                     \" * We need offsets of profiled things...\",\n                     \" * better be careful that this doesn't\",\n                     \" * affect the offsets of anything else.\",\n                     \" */\",\n                     \"\",\n                     \"#define PROFILING\",\n                     \"#define THREADED_RTS\",\n                     \"\",\n                     \"#include \\\"PosixSource.h\\\"\",\n                     \"#include \\\"Rts.h\\\"\",\n                     \"#include \\\"StableName.h\\\"\",\n                     \"#include \\\"Capability.h\\\"\",\n                     \"\",\n                     \"#include <inttypes.h>\",\n                     \"#include <stddef.h>\",\n                     \"#include <stdio.h>\",\n                     \"#include <string.h>\",\n                     \"\",\n                     \"#define FIELD_SIZE(s_type, field) ((size_t)sizeof(((s_type*)0)->field))\",\n                     \"#define TYPE_SIZE(type) (sizeof(type))\",\n                     \"#define FUN_OFFSET(sym) (offsetof(Capability,f.sym) - offsetof(Capability,r))\",\n                     \"\",\n                     \"#pragma GCC poison sizeof\"\n                     ]\n\n          objdumpProgam = maybe (error \"no objdump program given\") id mobjdumpProgram\n\n          prefix = \"derivedConstant\"\n          mkFullName name = prefix ++ name\n\n          -- We add 1 to the value, as some platforms will make a symbol\n          -- of size 1 when for\n          --     char foo[0];\n          -- We then subtract 1 again when parsing.\n          doWanted (GetFieldType name (Fst (CExpr cExpr)))\n              = [\"char \" ++ mkFullName name ++ \"[1 + \" ++ cExpr ++ \"];\"]\n          doWanted (GetClosureSize name (Fst (CExpr cExpr)))\n              = [\"char \" ++ mkFullName name ++ \"[1 + \" ++ cExpr ++ \"];\"]\n          doWanted (GetWord name (Fst (CExpr cExpr)))\n              = [\"char \" ++ mkFullName name ++ \"[1 + \" ++ cExpr ++ \"];\"]\n          doWanted (GetInt name (Fst (CExpr cExpr)))\n              = [\"char \" ++ mkFullName name ++ \"Mag[1 + ((intptr_t)(\" ++ cExpr ++ \") >= 0 ? (\" ++ cExpr ++ \") : -(\" ++ cExpr ++ \"))];\",\n                 \"char \" ++ mkFullName name ++ \"Sig[(intptr_t)(\" ++ cExpr ++ \") >= 0 ? 3 : 1];\"]\n          doWanted (GetNatural name (Fst (CExpr cExpr)))\n              = -- These casts fix \"right shift count >= width of type\"\n                -- warnings\n                let cExpr' = \"(uint64_t)(size_t)(\" ++ cExpr ++ \")\"\n                in [\"char \" ++ mkFullName name ++ \"0[1 + ((\" ++ cExpr' ++ \") & 0xFFFF)];\",\n                    \"char \" ++ mkFullName name ++ \"1[1 + (((\" ++ cExpr' ++ \") >> 16) & 0xFFFF)];\",\n                    \"char \" ++ mkFullName name ++ \"2[1 + (((\" ++ cExpr' ++ \") >> 32) & 0xFFFF)];\",\n                    \"char \" ++ mkFullName name ++ \"3[1 + (((\" ++ cExpr' ++ \") >> 48) & 0xFFFF)];\"]\n          doWanted (GetBool name (Fst (CPPExpr cppExpr)))\n              = [\"#if \" ++ cppExpr,\n                 \"char \" ++ mkFullName name ++ \"[1];\",\n                 \"#else\",\n                 \"char \" ++ mkFullName name ++ \"[2];\",\n                 \"#endif\"]\n          doWanted (StructFieldMacro {}) = []\n          doWanted (ClosureFieldMacro {}) = []\n          doWanted (ClosurePayloadMacro {}) = []\n          doWanted (FieldTypeGcptrMacro {}) = []\n\n          -- parseNmLine parses \"nm -P\" output that looks like\n          -- \"derivedConstantMAX_Vanilla_REG C 0000000b 0000000b\" (GNU nm)\n          -- \"_derivedConstantMAX_Vanilla_REG C b 0\" (Mac OS X)\n          -- \"_derivedConstantMAX_Vanilla_REG C 000000b\" (MinGW)\n          -- \"derivedConstantMAX_Vanilla_REG D        1        b\" (Solaris)\n          -- and returns (\"MAX_Vanilla_REG\", 11)\n          parseNmLine line\n              = case words line of\n                ('_' : n) : \"C\" : s : _ -> mkP n s\n                n : \"C\" : s : _ -> mkP n s\n                [n, \"D\", _, s] -> mkP n s\n                [s, \"O\", \"*COM*\", _, n] -> mkP n s\n                _ -> Nothing\n              where mkP r s = case (stripPrefix prefix r, readHex s) of\n                        (Just name, [(size, \"\")]) -> Just (name, size)\n                        _ -> Nothing\n\n          -- On AIX, `nm` isn't able to tell us the symbol size, so we\n          -- need to use `objdump --syms`. However, unlike on OpenBSD,\n          -- `objdump --syms` outputs entries spanning two lines, e.g.\n          --\n          -- [ 50](sec  3)(fl 0x00)(ty   0)(scl   2) (nx 1) 0x00000318 derivedConstantBLOCK_SIZE\n          -- AUX val  4097 prmhsh 0 snhsh 0 typ 3 algn 3 clss 5 stb 0 snstb 0\n          --\n          parseAixObjdump :: [String] -> [(String,Integer)]\n          parseAixObjdump = catMaybes . goAix\n            where\n              goAix (l1@('[':_):l2@('A':'U':'X':_):ls')\n                  = parseObjDumpEntry l1 l2 : goAix ls'\n              goAix (_:ls') = goAix ls'\n              goAix [] = []\n\n              parseObjDumpEntry l1 l2\n                  | [\"val\",n] <- take 2 (tail $ words l2)\n                  , Just sym <- stripPrefix prefix sym0 = Just (sym, read n)\n                  | otherwise = Nothing\n                where\n                  [sym0, _] = take 2 (reverse $ words l1)\n\n          -- If an Int value is larger than 2^28 or smaller\n          -- than -2^28, then fail.\n          -- This test is a bit conservative, but if any\n          -- constants are roughly maxBound or minBound then\n          -- we probably need them to be Integer rather than\n          -- Int so that -- cross-compiling between 32bit and\n          -- 64bit platforms works.\n          lookupSmall :: Map String Integer -> Name -> IO Integer\n          lookupSmall m name\n              = case Map.lookup name m of\n                Just v\n                 | v >   2^(28 :: Int) ||\n                   v < -(2^(28 :: Int)) ->\n                    die (\"Value too large for GetWord: \" ++ show v)\n                 | otherwise -> return v\n                Nothing -> die (\"Can't find \" ++ show name)\n\n          lookupResult :: Map String Integer -> (Where, What Fst)\n                       -> IO (Where, What Snd)\n          lookupResult m (w, GetWord name _)\n              = do v <- lookupSmall m name\n                   return (w, GetWord name (Snd (v - 1)))\n          lookupResult m (w, GetInt name _)\n              = do mag <- lookupSmall m (name ++ \"Mag\")\n                   sig <- lookupSmall m (name ++ \"Sig\")\n                   return (w, GetWord name (Snd ((mag - 1) * (sig - 2))))\n          lookupResult m (w, GetNatural name _)\n              = do v0 <- lookupSmall m (name ++ \"0\")\n                   v1 <- lookupSmall m (name ++ \"1\")\n                   v2 <- lookupSmall m (name ++ \"2\")\n                   v3 <- lookupSmall m (name ++ \"3\")\n                   let v = (v0 - 1)\n                         + shiftL (v1 - 1) 16\n                         + shiftL (v2 - 1) 32\n                         + shiftL (v3 - 1) 48\n                   return (w, GetWord name (Snd v))\n          lookupResult m (w, GetBool name _)\n              = do v <- lookupSmall m name\n                   case v of\n                       1 -> return (w, GetBool name (Snd True))\n                       2 -> return (w, GetBool name (Snd False))\n                       _ -> die (\"Bad boolean: \" ++ show v)\n          lookupResult m (w, GetFieldType name _)\n              = do v <- lookupSmall m name\n                   return (w, GetFieldType name (Snd (v - 1)))\n          lookupResult m (w, GetClosureSize name _)\n              = do v <- lookupSmall m name\n                   return (w, GetClosureSize name (Snd (v - 1)))\n          lookupResult _ (w, StructFieldMacro name)\n              = return (w, StructFieldMacro name)\n          lookupResult _ (w, ClosureFieldMacro name)\n              = return (w, ClosureFieldMacro name)\n          lookupResult _ (w, ClosurePayloadMacro name)\n              = return (w, ClosurePayloadMacro name)\n          lookupResult _ (w, FieldTypeGcptrMacro name)\n              = return (w, FieldTypeGcptrMacro name)\n\nwriteHaskellType :: FilePath -> [What Fst] -> IO ()\nwriteHaskellType fn ws = writeFile fn xs\n    where xs = unlines (headers ++ body ++ footers)\n          headers = [\"data PlatformConstants = PlatformConstants {\"\n                     -- Now a kludge that allows the real entries to\n                     -- all start with a comma, which makes life a\n                     -- little easier\n                    ,\"    pc_platformConstants :: ()\"]\n          footers = [\"  } deriving Read\"]\n          body = concatMap doWhat ws\n          doWhat (GetClosureSize name _) = [\"    , pc_\" ++ name ++ \" :: Int\"]\n          doWhat (GetFieldType   name _) = [\"    , pc_\" ++ name ++ \" :: Int\"]\n          doWhat (GetWord        name _) = [\"    , pc_\" ++ name ++ \" :: Int\"]\n          doWhat (GetInt         name _) = [\"    , pc_\" ++ name ++ \" :: Int\"]\n          doWhat (GetNatural     name _) = [\"    , pc_\" ++ name ++ \" :: Integer\"]\n          doWhat (GetBool        name _) = [\"    , pc_\" ++ name ++ \" :: Bool\"]\n          doWhat (StructFieldMacro {}) = []\n          doWhat (ClosureFieldMacro {}) = []\n          doWhat (ClosurePayloadMacro {}) = []\n          doWhat (FieldTypeGcptrMacro {}) = []\n\nwriteHaskellValue :: FilePath -> [What Snd] -> IO ()\nwriteHaskellValue fn rs = writeFile fn xs\n    where xs = unlines (headers ++ body ++ footers)\n          headers = [\"PlatformConstants {\"\n                    ,\"    pc_platformConstants = ()\"]\n          footers = [\"  }\"]\n          body = concatMap doWhat rs\n          doWhat (GetClosureSize name (Snd v)) = [\"    , pc_\" ++ name ++ \" = \" ++ show v]\n          doWhat (GetFieldType   name (Snd v)) = [\"    , pc_\" ++ name ++ \" = \" ++ show v]\n          doWhat (GetWord        name (Snd v)) = [\"    , pc_\" ++ name ++ \" = \" ++ show v]\n          doWhat (GetInt         name (Snd v)) = [\"    , pc_\" ++ name ++ \" = \" ++ show v]\n          doWhat (GetNatural     name (Snd v)) = [\"    , pc_\" ++ name ++ \" = \" ++ show v]\n          doWhat (GetBool        name (Snd v)) = [\"    , pc_\" ++ name ++ \" = \" ++ show v]\n          doWhat (StructFieldMacro {}) = []\n          doWhat (ClosureFieldMacro {}) = []\n          doWhat (ClosurePayloadMacro {}) = []\n          doWhat (FieldTypeGcptrMacro {}) = []\n\nwriteHaskellWrappers :: FilePath -> [What Fst] -> IO ()\nwriteHaskellWrappers fn ws = writeFile fn xs\n    where xs = unlines body\n          body = concatMap doWhat ws\n          doWhat (GetFieldType {}) = []\n          doWhat (GetClosureSize {}) = []\n          doWhat (GetWord name _) = [haskellise name ++ \" :: DynFlags -> Int\",\n                                    haskellise name ++ \" dflags = pc_\" ++ name ++ \" (sPlatformConstants (settings dflags))\"]\n          doWhat (GetInt name _) = [haskellise name ++ \" :: DynFlags -> Int\",\n                                   haskellise name ++ \" dflags = pc_\" ++ name ++ \" (sPlatformConstants (settings dflags))\"]\n          doWhat (GetNatural name _) = [haskellise name ++ \" :: DynFlags -> Integer\",\n                                        haskellise name ++ \" dflags = pc_\" ++ name ++ \" (sPlatformConstants (settings dflags))\"]\n          doWhat (GetBool name _) = [haskellise name ++ \" :: DynFlags -> Bool\",\n                                     haskellise name ++ \" dflags = pc_\" ++ name ++ \" (sPlatformConstants (settings dflags))\"]\n          doWhat (StructFieldMacro {}) = []\n          doWhat (ClosureFieldMacro {}) = []\n          doWhat (ClosurePayloadMacro {}) = []\n          doWhat (FieldTypeGcptrMacro {}) = []\n\nwriteHaskellExports :: FilePath -> [What Fst] -> IO ()\nwriteHaskellExports fn ws = writeFile fn xs\n    where xs = unlines body\n          body = concatMap doWhat ws\n          doWhat (GetFieldType {}) = []\n          doWhat (GetClosureSize {}) = []\n          doWhat (GetWord    name _) = [\"    \" ++ haskellise name ++ \",\"]\n          doWhat (GetInt     name _) = [\"    \" ++ haskellise name ++ \",\"]\n          doWhat (GetNatural name _) = [\"    \" ++ haskellise name ++ \",\"]\n          doWhat (GetBool    name _) = [\"    \" ++ haskellise name ++ \",\"]\n          doWhat (StructFieldMacro {}) = []\n          doWhat (ClosureFieldMacro {}) = []\n          doWhat (ClosurePayloadMacro {}) = []\n          doWhat (FieldTypeGcptrMacro {}) = []\n\nwriteHeader :: FilePath -> [What Snd] -> IO ()\nwriteHeader fn rs = writeFile fn xs\n    where xs = unlines (headers ++ body)\n          headers = [\"/* This file is created automatically.  Do not edit by hand.*/\", \"\"]\n          body = concatMap doWhat rs\n          doWhat (GetFieldType   name (Snd v)) = [\"#define \" ++ name ++ \" b\" ++ show (v * 8)]\n          doWhat (GetClosureSize name (Snd v)) = [\"#define \" ++ name ++ \" (SIZEOF_StgHeader+\" ++ show v ++ \")\"]\n          doWhat (GetWord        name (Snd v)) = [\"#define \" ++ name ++ \" \" ++ show v]\n          doWhat (GetInt         name (Snd v)) = [\"#define \" ++ name ++ \" \" ++ show v]\n          doWhat (GetNatural     name (Snd v)) = [\"#define \" ++ name ++ \" \" ++ show v]\n          doWhat (GetBool        name (Snd v)) = [\"#define \" ++ name ++ \" \" ++ show (fromEnum v)]\n          doWhat (StructFieldMacro nameBase) =\n                     [\"#define \" ++ nameBase ++ \"(__ptr__) REP_\" ++ nameBase ++ \"[__ptr__+OFFSET_\" ++ nameBase ++ \"]\"]\n          doWhat (ClosureFieldMacro nameBase) =\n                     [\"#define \" ++ nameBase ++ \"(__ptr__) REP_\" ++ nameBase ++ \"[__ptr__+SIZEOF_StgHeader+OFFSET_\" ++ nameBase ++ \"]\"]\n          doWhat (ClosurePayloadMacro nameBase) =\n                     [\"#define \" ++ nameBase ++ \"(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_\" ++ nameBase ++ \" + WDS(__ix__)]\"]\n          doWhat (FieldTypeGcptrMacro nameBase) =\n                     [\"#define REP_\" ++ nameBase ++ \" gcptr\"]\n\ndie :: String -> IO a\ndie err = do hPutStrLn stderr err\n             exitFailure\n\nexecute :: Bool -> FilePath -> [String] -> IO ()\nexecute verbose prog args\n = do when verbose $ putStrLn $ showCommandForUser prog args\n      ec <- rawSystem prog args\n      unless (ec == ExitSuccess) $\n          die (\"Executing \" ++ show prog ++ \" failed\")\n\n", "num_lines": 979}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Data.List\n\nmain :: IO ()\nmain = do xs <- readFile \"testlog\"\n          let ls = lines xs\n              tests = breakTests ls\n              unexpectedTests = filter (any (\"unexpected\" `isInfixOf`)) tests\n          putStr $ unlines $ concat unexpectedTests\n\nbreakTests :: [String] -> [[String]]\nbreakTests xs = splitStarting (\"=====> \" `isPrefixOf`)\n                -- Ignore lines telling us that we're running a .T file:\n              $ filter (not . (\"====> Running \" `isPrefixOf`)) xs\n\nsplitStarting :: (a -> Bool) -> [a] -> [[a]]\nsplitStarting f xs0 = case break f xs0 of\n                      (_, intro : xs) -> ss intro xs\n                      _ -> error \"No data\"\n    where ss intro xs = case break f xs of\n                        (this, intro' : rest) ->\n                            (intro : this) : ss intro' rest\n                        (this, []) -> [intro : this]\n", "num_lines": 26}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Safe #-}\n{-# LANGUAGE CPP #-}\n\n{-\n  gen-dll is a replacement for dll-split which aims to solve a simple problem\n  during the building of stage2. The issue is that the PE image format only has\n  a 16-bit field for the symbol count. This means we can't have more than 2^16-1\n  symbols in a single PE file. See Trac #5987.\n\n  gen-dll solves this issue by partitioning the object files in such a way that\n  a single dll never has more than the allowed amount of symbols. The general\n  workflow of gen-dll is:\n\n  1) use nm -g to dump the symbols defined in each object file, from this dump\n     we collect three key pieces information:\n     a) the object file the symbol belongs to\n     b) the symbol's kind (e.g data or function)\n     c) the symbol name.\n\n  2) If the amount of symbols is lower than the maximum, we're done and we'll\n     just link the entire list of symbols and move on.\n\n     If however we have too many symbols we'll partition the symbols using a\n     per object file granularity. This is because we can't split the content of\n     an object file. An oc belongs to one and only one image file.\n\n  3) Once we have the partitioning, we sub partition these into two groups for\n     each partition:\n     a) data\n     b) function\n\n     The reason for this is that data exports are directly accessed, whereas\n     functions generally go through a trampoline. The trampolines are there to\n     allow for extra functionality such as delay loading (if requested) and to\n     cover for memory model changes due to linking all the object code in on\n     PE image.\n\n     Data is usually accessed direct, so we don't want the trampoline otherwise\n        extern int foo;\n     would point to executable code instead of data.\n\n  4) Once we have everything correctly tagged, the partitions are dumped into a\n     module definition file (def). Each file is named <dll-name>-pt<num>.<ext>\n     which is also the partitioning scheme used for all other files including\n     the resulting dlls.\n\n     From the .def file we use libtool or genlib (when available) to generate\n     an import library. In this case we generate a GNU style import library\n     See Note [BFD import library].\n\n     These import libraries are used to break the cyclic dependencies that may\n     exist between the symbols due to the random partitioning. e.g. A may\n     require B, but A and B can be in different dlls. With the import libraries\n     we promise A that at runtime it'll have B, and vice versa. The Windows\n     runtime linker and loader will take care of breaking this cycle at runtime.\n\n  5) Once we have an import library for each partition, we start linking the\n     final dlls. if e.g. we have 3 dlls, linking dll 1 means passing import\n     libraries 2 and 3 as an argument to the linking of dll 1. This allows it\n     to find all symbols since PE image files can't have dangling symbols.\n\n  6) After creating the dlls the final step is to create one top level import\n     library that is named after the original dll that we were supposed to link.\n\n     To continue the 3 split example. say we were supposed to make libfoo.dll,\n     instead we created libfoo-pt1.dll, libfoo-pt2.dll and libfoo-pt3.dll.\n     Obviously using -lfoo would no longer locate the dlls.\n\n     This is solved by using import libraries again. GNU style import libraries\n     are just plain AR archives where each object file essentially contains\n     only 1 symbol and the dll in which to find this symbol.\n\n     A proper linker processes all the object files in this AR file (lld, ld and\n     ghci do this.) and so while genlib and libtool don't allow you to create\n     import libraries with multiple dll pointers, it is trivial to do.\n\n     We use ar to merge together the import libraries into a large complete one.\n     e.g. libfoo-pt1.dll.a, libfoo-pt2.dll.a and libfoo-pt3.dll.a are merged\n     into libfoo.dll.a. The name isn't coincidental. On Windows you don't link\n     directly against a dll, instead you link against an import library that\n     then tells you how to get to the dll functions.\n\n     In this case by creating a correctly named merged import library we solve\n     the -lfoo problem.\n\n     In the end we end up with libfoo-pt1.dll, libfoo-pt2.dll and libfoo-pt3.dll\n     along with libfoo.dll.a. To the rest of the pipeline the split is\n     completely transparent as -lfoo will just continue to work, and the linker\n     is responsible for populating the IAT (Import Address Table) with the\n     actual dlls we need.\n\n  This scheme is fully scalable and will not need manual maintenance or\n  intervention like dll-split needed. If we ever do switch to compiling using\n  Microsoft compilers, we need to use a custom tool to modify the PE import\n  libraries lib.exe creates. This is slightly more work but for now we can just\n  rely on the GNU import libraries.\n\n  If supported by the stage1 compiler, we'll create dll's which can be used as\n  SxS assemblies, but in order for us to do so, we have to give GHC some extra\n  information such as the stable abi name for the dll and the version of the\n  dll being created. This is purely a deployment thing and does not really\n  affect the workings of this tool.\n-}\nmodule Main(main) where\n\nimport Control.Arrow ((***))\nimport Control.Monad (when, forM_)\nimport Control.Exception (bracket)\n\nimport Data.Char (toLower, isSpace)\nimport Data.List (isPrefixOf, nub, sort, (\\\\))\nimport qualified Data.Map as M (Map(), alter, empty, toList)\n\nimport System.Environment (getArgs)\nimport System.Exit (ExitCode(..), exitWith)\nimport System.Directory (findFilesWith, getCurrentDirectory)\nimport System.FilePath (takeBaseName, takeDirectory, dropExtension, (<.>)\n                       ,takeFileName)\nimport System.IO (hClose, hGetContents, withFile, IOMode(..), hPutStrLn, openFile)\nimport System.Process (proc, createProcess_, StdStream (..), CreateProcess(..)\n                      ,waitForProcess)\n\nimport Foreign.C.Types (CInt(..), )\nimport Foreign.C.String (withCWString, peekCWString, CWString)\nimport Foreign.Ptr (Ptr)\nimport Foreign.Storable (peek)\nimport Foreign.Marshal.Array (peekArray)\nimport Foreign.Marshal.Alloc (alloca)\n\n#if defined(i386_HOST_ARCH)\n# define WINDOWS_CCONV stdcall\n#elif defined(x86_64_HOST_ARCH)\n# define WINDOWS_CCONV ccall\n#else\n# error Unknown mingw32 arch\n#endif\n\n-- Setup some standard program names.\nnm :: FilePath\nnm = NM_TOOL_BIN\n\nlibexe :: FilePath\nlibexe = LIB_TOOL_BIN\n\ngenlib :: FilePath\ngenlib = GENLIB_TOOL_BIN\n\nar :: FilePath\nar = AR_TOOL_BIN\n\n-- Technically speaking the limit for the amount of symbols you can have in a\n-- dll is 2^16-1, however Microsoft's lib.exe for some reason refuses to link\n-- up to this amount. The reason is likely that it adds some extra symbols in\n-- the generated dll, such as dllmain etc. So we reserve some space in the\n-- symbol table to accomodate this. This number is just purely randomly chosen.\n#define SYMBOL_PADDING 10\n\nusage :: IO ()\nusage = putStrLn $ unlines [ \" -= Split a dll if required and perform the linking =- \"\n                           , \"\"\n                           , \" Usage: gen-dll <action>\"\n                           , \"\"\n                           , \" Where <action> is one of:\"\n                           , \"     link     perform a real link of dll, \"\n                           , \"              arguments: dir distdir way flags libs objs out link_cmd delay name version\"\n                           ]\n\nmain :: IO ()\nmain = do\n  args <- getArgs\n  if null args\n     then usage\n     else case (head args) of\n             \"link\" -> let (dir:distdir:way:extra_flags:extra_libs:objs:output:\n                            command:delayed:abi_name:abi_version:_) = tail args\n                       in process_dll_link dir distdir way extra_flags extra_libs\n                                           objs output command delayed abi_name\n                                           abi_version\n             _      -> usage\n\ntype Symbol = String\ntype Symbols = [Symbol]\ntype SymbolType = Char\ndata Obj\n  = Obj { objName  :: String\n        , objCount :: Int\n        , objItems :: [(SymbolType, Symbol)]\n        }\n    deriving Show\ntype Objs = [Obj]\n\n-- | Create the final DLL by using the provided arguments\n--   This also creates the resulting special import library.\nprocess_dll_link :: String -- ^ dir\n                 -> String -- ^ distdir\n                 -> String -- ^ way\n                 -> String -- ^ extra flags\n                 -> String -- ^ extra libraries to link\n                 -> String -- ^ object files to link\n                 -> String -- ^ output filename\n                 -> String -- ^ link command\n                 -> String -- ^ create delay load import libs\n                 -> String -- ^ SxS Name\n                 -> String -- ^ SxS version\n                 -> IO ()\nprocess_dll_link _dir _distdir _way extra_flags extra_libs objs_files output\n                 link_cmd delay_imp sxs_name sxs_version\n  = do let base = dropExtension output\n       -- We need to know how many symbols came from other static archives\n       -- So take the total number of symbols and remove those we know came\n       -- from the object files. Use this to lower the max amount of symbols.\n       --\n       -- This granularity is the best we can do without --print-map like info.\n       raw_exports <- execProg nm Nothing [\"-g\", \"--defined-only\", objs_files]\n       putStrLn $ \"Processing symbols..\"\n\n       let objs    = collectObjs raw_exports\n           num_sym = foldr (\\a b -> b + objCount a) 0 objs\n           exports = base <.> \"lst\"\n\n       putStrLn $ \"Number of symbols in object files for \" ++ output ++ \": \" ++ show num_sym\n\n       _ <- withFile exports WriteMode $ \\hExports ->\n             mapM_ (hPutStrLn hExports . unlines . map snd . objItems) objs\n\n#if defined(GEN_SXS)\n       -- Side-by-Side assembly generation flags for GHC. Pass these along so the DLLs\n       -- get the proper manifests generated.\n       let sxs_opts = [ \"-fgen-sxs-assembly\"\n                      , \"-dylib-abi-name\"\n                      , show sxs_name\n                      , \"-dylib-abi-version\"\n                      , show sxs_version\n                      ]\n#else\n       let sxs_opts = []\n#endif\n\n       -- Now check that the DLL doesn't have too many symbols. See trac #5987.\n       case num_sym > dll_max_symbols of\n         False -> do putStrLn $ \"DLL \" ++ output ++ \" OK, no need to split.\"\n                     let defFile    = base <.> \"def\"\n                         dll_import = base <.> \"dll.a\"\n\n                     build_import_lib base (takeFileName output) defFile objs\n\n                     _ <- execProg link_cmd Nothing\n                              $ concat [[objs_files\n                                        ,extra_libs\n                                        ,extra_flags\n                                        ]\n                                       ,sxs_opts\n                                       ,[\"-fno-shared-implib\"\n                                        ,\"-optl-Wl,--retain-symbols-file=\" ++ exports\n                                        ,\"-o\"\n                                        ,output\n                                        ]\n                                       ]\n\n                     build_delay_import_lib defFile dll_import delay_imp\n\n         True -> do putStrLn $ \"Too many symbols for a single DLL \" ++ output\n                    putStrLn \"We'll have to split the dll...\"\n                    putStrLn $  \"OK, we only have space for \"\n                             ++ show dll_max_symbols\n                             ++ \" symbols from object files when building \"\n                             ++ output\n\n                    -- First split the dlls up by whole object files\n                    -- To do this, we iterate over all object file and\n                    -- generate a the partitions based on allowing a\n                    -- maximum of $DLL_MAX_SYMBOLS in one DLL.\n                    let spl_objs   = groupObjs objs\n                        n_spl_objs = length spl_objs\n                        base'      = base ++ \"-pt\"\n\n                    mapM_ (\\(n, _) -> putStrLn $ \">> DLL split at \" ++ show n ++ \" symbols.\") spl_objs\n                    putStrLn $ \"OK, based on the amount of symbols we'll split the DLL into \" ++ show n_spl_objs ++ \" pieces.\"\n\n                    -- Start off by creating the import libraries to break the\n                    -- mutual dependency chain.\n                    forM_ (zip [(1::Int)..] spl_objs) $ \\(i, (n, o)) ->\n                      do putStrLn $ \"Processing file \" ++ show i   ++ \" of \"\n                                 ++ show n_spl_objs    ++ \" with \" ++ show n\n                                 ++ \" symbols.\"\n                         let base_pt = base' ++ show i\n                             file    = base_pt <.> \"def\"\n                             dll     = base_pt <.> \"dll\"\n                             lst     = base_pt <.> \"lst\"\n\n                         _ <- withFile lst WriteMode $ \\hExports ->\n                               mapM_ (hPutStrLn hExports . unlines . map snd . objItems) o\n\n                         build_import_lib base_pt (takeFileName dll) file o\n\n                    -- Now create the actual DLLs by using the import libraries\n                    -- to break the mutual recursion.\n                    forM_ (zip [1..] spl_objs) $ \\(i, (n, _)) ->\n                      do putStrLn $ \"Creating DLL \" ++ show i   ++ \" of \"\n                                 ++ show n_spl_objs    ++ \" with \" ++ show n\n                                 ++ \" symbols.\"\n                         let base_pt = base' ++ show i\n                             file    = base_pt <.> \"def\"\n                             dll     = base_pt <.> \"dll\"\n                             lst     = base_pt <.> \"lst\"\n                             imp_lib = base_pt <.> \"dll.a\"\n                             indexes = [1..(length spl_objs)]\\\\[i]\n                             libs    = map (\\ix -> (base' ++ show ix) <.> \"dll.a\") indexes\n\n                         _ <- execProg link_cmd Nothing\n                                  $ concat [[objs_files\n                                            ,extra_libs\n                                            ,extra_flags\n                                            ,file\n                                            ]\n                                           ,libs\n                                           ,sxs_opts\n                                           ,[\"-fno-shared-implib\"\n                                            ,\"-optl-Wl,--retain-symbols-file=\" ++ lst\n                                            ,\"-o\"\n                                            ,dll\n                                            ]\n                                           ]\n\n                         -- build_delay_import_lib file imp_lib delay_imp\n                         putStrLn $ \"Created \" ++ dll ++ \".\"\n\n                    -- And finally, merge the individual import libraries into\n                    -- one with the name of the original library we were\n                    -- supposed to make. This means that nothing has to really\n                    -- know how we split up the DLLs, for everything else it'so\n                    -- as if it's still one large assembly.\n                    create_merged_archive base base' (length spl_objs)\n\n\ncollectObjs :: [String] -> Objs\ncollectObjs = map snd . M.toList . foldr collectObjs' M.empty\n\ncollectObjs' :: String -> M.Map String Obj -> M.Map String Obj\ncollectObjs' []  m   = m\ncollectObjs' str_in m\n  = let clean        = dropWhile isSpace\n        str          = clean str_in\n        (file, rest) = ((takeWhile (/=':') . clean) *** clean) $\n                         break isSpace str\n        (typ , sym ) = (id *** clean) $ break isSpace rest\n        obj          = Obj { objName  = file\n                           , objCount = 1\n                           , objItems = [(head typ, sym)]\n                           }\n        upd value\n          = if length typ /= 1\n               then value\n               else Just $ maybe obj\n                                 (\\o -> o { objCount = objCount o + 1\n                                          , objItems = (head typ, sym) : objItems o\n                                          })\n                                 value\n    in M.alter upd file m\n\n-- Split a list of objects into globals and functions\nsplitObjs :: Objs -> (Symbols, Symbols)\nsplitObjs []     = ([], [])\nsplitObjs (y:ys) = group_ (objItems y) (splitObjs ys)\n  where globals = \"DdGgrRSsbBC\"\n        group_ :: [(Char, Symbol)] -> (Symbols, Symbols) -> (Symbols, Symbols)\n        group_ []     x                             = x\n        group_ (x:xs) (g, f) | fst x `elem` globals = group_ xs (snd x:g, f)\n                             |     otherwise        = group_ xs (g, snd x:f)\n\n-- Determine how to split the objects up.\ngroupObjs :: Objs -> [(Int, Objs)]\ngroupObjs = binObjs 0 []\n where binObjs :: Int -> Objs -> Objs -> [(Int, Objs)]\n       binObjs n l []     = [(n, l)]\n       binObjs n l (o:os)\n         = let nx = objCount o\n               n' = n + nx\n           in if n' > dll_max_symbols\n                 then (n, l) : binObjs 0 [] os\n                 else binObjs n' (o:l) os\n\n-- Maximum number of symbols to allow into\n-- one DLL. This is the split factor used.\ndll_max_symbols :: Int\ndll_max_symbols = 65535 - SYMBOL_PADDING -- Some padding for required symbols.\n\nisTrue :: String -> Bool\nisTrue s = let s' = map toLower s\n           in case () of\n               () | s' == \"yes\" -> True\n                  | s' == \"no\"  -> False\n                  | otherwise   -> error $ \"Expected yes/no but got '\" ++ s ++ \"'\"\n\nforeign import WINDOWS_CCONV unsafe \"Shellapi.h CommandLineToArgvW\"\n     c_CommandLineToArgvW :: CWString -> Ptr CInt -> IO (Ptr CWString)\n\nforeign import WINDOWS_CCONV unsafe \"windows.h LocalFree\"\n    localFree :: Ptr a -> IO (Ptr a)\n\nmkArgs :: String -> IO [String]\nmkArgs []  = return []\nmkArgs arg =\n  do withCWString arg $ \\c_arg -> do\n       alloca $ \\c_size -> do\n         res <- c_CommandLineToArgvW c_arg c_size\n         size <- peek c_size\n         args <- peekArray (fromIntegral size) res\n         values <- mapM peekCWString args\n         _ <- localFree res\n         return values\n\nexecProg :: String -> Maybe FilePath -> [String] -> IO [String]\nexecProg prog m_stdin args =\n  do args' <- fmap concat $ mapM mkArgs args\n     prog' <- mkArgs prog\n     let full@(c_prog:c_args) = prog' ++ args'\n     -- print the commands we're executing for debugging and transparency\n     putStrLn $ unwords $ full ++ [maybe \"\" (\"< \" ++) m_stdin]\n     cwdir <- getCurrentDirectory\n     let cp = (proc c_prog c_args)\n              { std_out = CreatePipe, cwd = Just cwdir }\n     cp' <- case m_stdin of\n              Nothing   -> return cp\n              Just path -> do h <- openFile path ReadMode\n                              return cp{ std_in = UseHandle h}\n     bracket\n       (createProcess_ (\"execProg: \" ++ prog)  cp')\n       (\\(_, Just hout, _, ph) -> do\n         hClose hout\n         code <- waitForProcess ph\n         case std_in cp' of\n           UseHandle h -> hClose h\n           _           -> return ()\n         case code of\n           ExitFailure _ -> exitWith code\n           ExitSuccess   -> return ())\n       (\\(_, Just hout, _, _) -> do\n         results <- hGetContents hout\n         length results `seq` return $ lines results)\n\n-- | Mingw-w64's genlib.exe is generally a few order of magnitudes faster than\n-- libtool which is BFD based. So we prefer it, but it's not standard so\n-- support both. We're talking a difference of 45 minutes in build time here.\nexecLibTool :: String -> String -> IO [String]\nexecLibTool input_def output_lib =\n  do if HAS_GENLIB\n        then execProg genlib Nothing [input_def, \"-o\", output_lib]\n        else execProg libexe Nothing [\"-d\", input_def, \"-l\", output_lib]\n\n-- Builds a delay import lib at the very end which is used to\n-- be able to delay the picking of a DLL on Windows.\n-- This function is called always and decided internally\n-- what to do.\nbuild_delay_import_lib :: String -- ^ input def file\n                       -> String -- ^ ouput import delayed import lib\n                       -> String -- ^ flag to indicate if delay import\n                                 --   lib should be created\n                       -> IO ()\nbuild_delay_import_lib input_def output_lib create_delayed\n  = when (isTrue create_delayed) $\n       execLibTool input_def output_lib >> return ()\n\n-- Build a normal import library from the object file definitions\nbuild_import_lib :: FilePath -> FilePath -> FilePath -> Objs -> IO ()\nbuild_import_lib base dll_name defFile objs\n  = do -- Create a def file hiding symbols not in original object files\n       -- because --export-all is re-exporting things from static libs\n       -- we need to separate out data from functions. So first create two temporaries\n       let (globals, functions) = splitObjs objs\n\n       -- This split is important because for DATA entries the compiler should not generate\n       -- a trampoline since CONTS DATA is directly referenced and not executed. This is not very\n       -- important for mingw-w64 which would generate both the trampoline and direct referecne\n       -- by default, but for libtool is it and even for mingw-w64 we can trim the output.\n       _ <- withFile defFile WriteMode $ \\hDef -> do\n              hPutStrLn hDef $ unlines $ [\"LIBRARY \" ++ show dll_name\n                                         ,\"EXPORTS\"\n                                         ]\n              mapM_ (\\v -> hPutStrLn hDef $ \"    \" ++ show v ++ \" DATA\") globals\n              mapM_ (\\v -> hPutStrLn hDef $ \"    \" ++ show v           ) functions\n\n       let dll_import = base <.> \"dll.a\"\n       _ <- execLibTool defFile dll_import\n       return ()\n\n-- Do some cleanup and create merged lib.\n-- Because we have no split the DLL we need\n-- to provide a way for the linker to know about the split\n-- DLL. Also the compile was supposed to produce a DLL\n-- foo.dll and import library foo.lib. However we've actually\n-- produced foo-pt1.dll, foo-pt2.dll etc. What we don't want is to have\n-- To somehow convey back to the compiler that we split the DLL in x pieces\n-- as this would require a lot of changes.\n--\n-- Instead we produce a merged import library which contains the union of\n-- all the import libraries produced. This works because import libraries contain\n-- only .idata section which point to the right dlls. So LD will do the right thing.\n-- And this means we don't have to do any special handling for the rest of the pipeline.\ncreate_merged_archive :: FilePath -> String -> Int -> IO ()\ncreate_merged_archive base prefix count\n  = do let ar_script = base <.> \"mri\"\n           imp_lib   = base <.> \"dll.a\"\n           imp_libs  = map (\\i -> prefix ++ show i <.> \"dll.a\") [1..count]\n       let script = [ \"create \" ++ imp_lib    ] ++\n                    map (\"addlib \" ++) imp_libs ++\n                    [ \"save\", \"end\" ]\n       writeFile ar_script (unlines script)\n       _ <- execProg ar (Just ar_script) [\"-M\"]\n       return ()\n", "num_lines": 511}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# OPTIONS_GHC -fno-warn-unused-matches #-}\n{-# OPTIONS_GHC -fno-warn-unused-binds #-}\n{-# OPTIONS_GHC -fno-warn-missing-signatures #-}\n{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}\n{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n-- The above warning suppression flags are a temporary kludge.\n-- While working on this module you are encouraged to remove it and fix\n-- any warnings in the module. See\n--     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings\n-- for details\nmodule Main(main) where\n\n#include \"../../includes/ghcconfig.h\"\n#include \"../../includes/stg/HaskellMachRegs.h\"\n#include \"../../includes/rts/Constants.h\"\n\n-- Needed for TAG_BITS\n#include \"../../includes/MachDeps.h\"\n\nimport Prelude hiding ((<>))\n\nimport Text.PrettyPrint\nimport Data.Word\nimport Data.Bits\nimport Data.List        ( intersperse, nub, sort )\nimport System.Exit\nimport System.Environment\nimport System.IO\nimport Control.Arrow ((***))\n\n-- -----------------------------------------------------------------------------\n-- Argument kinds (rougly equivalent to PrimRep)\n\ndata ArgRep\n  = N   -- non-ptr\n  | P   -- ptr\n  | V   -- void\n  | F   -- float\n  | D   -- double\n  | L   -- long (64-bit)\n  | V16 -- 16-byte (128-bit) vectors\n  | V32 -- 32-byte (256-bit) vectors\n  | V64 -- 64-byte (512-bit) vectors\n\n-- size of a value in *words*\nargSize :: ArgRep -> Int\nargSize N   = 1\nargSize P   = 1\nargSize V   = 0\nargSize F   = 1\nargSize D   = (SIZEOF_DOUBLE `quot` SIZEOF_VOID_P :: Int)\nargSize L   = (8 `quot` SIZEOF_VOID_P :: Int)\nargSize V16 = (16 `quot` SIZEOF_VOID_P :: Int)\nargSize V32 = (32 `quot` SIZEOF_VOID_P :: Int)\nargSize V64 = (64 `quot` SIZEOF_VOID_P :: Int)\n\nshowArg :: ArgRep -> String\nshowArg N   = \"n\"\nshowArg P   = \"p\"\nshowArg V   = \"v\"\nshowArg F   = \"f\"\nshowArg D   = \"d\"\nshowArg L   = \"l\"\nshowArg V16 = \"v16\"\nshowArg V32 = \"v32\"\nshowArg V64 = \"v64\"\n\n-- is a value a pointer?\nisPtr :: ArgRep -> Bool\nisPtr P = True\nisPtr _ = False\n\n-- -----------------------------------------------------------------------------\n-- Registers\n\ndata RegStatus = Registerised | Unregisterised\n\ntype Reg = String\n\navailableRegs :: RegStatus -> ([Reg],[Reg],[Reg],[Reg])\navailableRegs Unregisterised = ([],[],[],[])\navailableRegs Registerised =\n  ( vanillaRegs MAX_REAL_VANILLA_REG,\n    floatRegs   MAX_REAL_FLOAT_REG,\n    doubleRegs  MAX_REAL_DOUBLE_REG,\n    longRegs    MAX_REAL_LONG_REG\n  )\n\nvanillaRegs, floatRegs, doubleRegs, longRegs :: Int -> [Reg]\nvanillaRegs n = [ \"R\" ++ show m | m <- [2..n] ]  -- never use R1\nfloatRegs   n = [ \"F\" ++ show m | m <- [1..n] ]\ndoubleRegs  n = [ \"D\" ++ show m | m <- [1..n] ]\nlongRegs    n = [ \"L\" ++ show m | m <- [1..n] ]\n\n-- -----------------------------------------------------------------------------\n-- Loading/saving register arguments to the stack\n\nloadRegArgs :: RegStatus -> Int -> [ArgRep] -> (Doc,Int)\nloadRegArgs regstatus sp args\n = (loadRegOffs reg_locs, sp')\n where (reg_locs, _, sp') = assignRegs regstatus sp args\n\nloadRegOffs :: [(Reg,Int)] -> Doc\nloadRegOffs = vcat . map (uncurry assign_stk_to_reg)\n\nsaveRegOffs :: [(Reg,Int)] -> Doc\nsaveRegOffs = vcat . map (uncurry assign_reg_to_stk)\n\nassignRegs\n        :: RegStatus            -- are we registerised?\n        -> Int                  -- Sp of first arg\n        -> [ArgRep]             -- args\n        -> ([(Reg,Int)],        -- regs and offsets to load\n            [ArgRep],           -- left-over args\n            Int)                -- Sp of left-over args\nassignRegs regstatus sp args = assign sp args (availableRegs regstatus) []\n\nassign sp [] regs doc = (doc, [], sp)\nassign sp (V : args) regs doc = assign sp args regs doc\nassign sp (arg : args) regs doc\n = case findAvailableReg arg regs of\n    Just (reg, regs') -> assign (sp + argSize arg)  args regs'\n                            ((reg, sp) : doc)\n    Nothing -> (doc, (arg:args), sp)\n\nfindAvailableReg N (vreg:vregs, fregs, dregs, lregs) =\n  Just (vreg, (vregs,fregs,dregs,lregs))\nfindAvailableReg P (vreg:vregs, fregs, dregs, lregs) =\n  Just (vreg, (vregs,fregs,dregs,lregs))\nfindAvailableReg F (vregs, freg:fregs, dregs, lregs) =\n  Just (freg, (vregs,fregs,dregs,lregs))\nfindAvailableReg D (vregs, fregs, dreg:dregs, lregs) =\n  Just (dreg, (vregs,fregs,dregs,lregs))\nfindAvailableReg L (vregs, fregs, dregs, lreg:lregs) =\n  Just (lreg, (vregs,fregs,dregs,lregs))\nfindAvailableReg _ _ = Nothing\n\nassign_reg_to_stk reg sp\n   = loadSpWordOff (regRep reg) sp <> text \" = \" <> text reg <> semi\n\nassign_stk_to_reg reg sp\n   = text reg <> text \" = \" <> loadSpWordOff (regRep reg) sp <> semi\n\nregRep ('F':_) = \"F_\"\nregRep ('D':_) = \"D_\"\nregRep ('L':_) = \"L_\"\nregRep _       = \"W_\"\n\nloadSpWordOff :: String -> Int -> Doc\nloadSpWordOff rep off = text rep <> text \"[Sp+WDS(\" <> int off <> text \")]\"\n\n-- Make a jump\nmkJump :: RegStatus -- Registerised status\n       -> Doc       -- Jump target\n       -> [Reg]     -- Registers that are definitely live\n       -> [ArgRep]  -- Jump arguments\n       -> Doc\nmkJump regstatus jump live args =\n    text \"jump\" <+> jump <+> brackets (hcat (punctuate comma liveRegs))\n  where\n    liveRegs = mkJumpLiveRegs regstatus live args\n\n-- Make a jump, saving CCCS and restoring it on return\nmkJumpSaveCCCS :: RegStatus -- Registerised status\n               -> Doc       -- Jump target\n               -> [Reg]     -- Registers that are definitely live\n               -> [ArgRep]  -- Jump arguments\n               -> Doc\nmkJumpSaveCCCS regstatus jump live args =\n    text \"jump_SAVE_CCCS\" <> parens (hcat (punctuate comma (jump : liveRegs)))\n  where\n    liveRegs = mkJumpLiveRegs regstatus live args\n\n-- Calculate live registers for a jump\nmkJumpLiveRegs :: RegStatus -- Registerised status\n               -> [Reg]     -- Registers that are definitely live\n               -> [ArgRep]  -- Jump arguments\n               -> [Doc]\nmkJumpLiveRegs regstatus live args =\n    map text regs\n  where\n    (reg_locs, _, _) = assignRegs regstatus 0 args\n    regs             = (nub . sort) (live ++ map fst reg_locs)\n\n-- make a ptr/non-ptr bitmap from a list of argument types\nmkBitmap :: [ArgRep] -> Word32\nmkBitmap args = foldr f 0 args\n where f arg bm | isPtr arg = bm `shiftL` 1\n                | otherwise = (bm `shiftL` size) .|. ((1 `shiftL` size) - 1)\n                where size = argSize arg\n\n-- -----------------------------------------------------------------------------\n-- Generating the application functions\n\n-- A SUBTLE POINT about stg_ap functions (can't think of a better\n-- place to put this comment --SDM):\n--\n-- The entry convention to an stg_ap_ function is as follows: all the\n-- arguments are on the stack (we might revisit this at some point,\n-- but it doesn't make any difference on x86), and THERE IS AN EXTRA\n-- EMPTY STACK SLOT at the top of the stack.\n--\n-- Why?  Because in several cases, stg_ap_* will need an extra stack\n-- slot, eg. to push a return address in the THUNK case, and this is a\n-- way of pushing the stack check up into the caller which is probably\n-- doing one anyway.  Allocating the extra stack slot in the caller is\n-- also probably free, because it will be adjusting Sp after pushing\n-- the args anyway (this might not be true of register-rich machines\n-- when we start passing args to stg_ap_* in regs).\n\nmkApplyName args\n  = text \"stg_ap_\" <> text (concatMap showArg args)\n\nmkApplyRetName args\n  = mkApplyName args <> text \"_ret\"\n\nmkApplyFastName args\n  = mkApplyName args <> text \"_fast\"\n\nmkApplyInfoName args\n  = mkApplyName args <> text \"_info\"\n\nmb_tag_node arity | Just tag <- tagForArity arity = mkTagStmt tag <> semi\n                  | otherwise = empty\n\nmkTagStmt tag = text (\"R1 = R1 + \"++ show tag)\n\ntype StackUsage = (Int, Int)  -- PROFILING, normal\n\nmaxStack :: [StackUsage] -> StackUsage\nmaxStack = (maximum *** maximum) . unzip\n\nstackCheck\n   :: RegStatus  -- Registerised status\n   -> [ArgRep]\n   -> Bool       -- args in regs?\n   -> Doc        -- fun_info_label\n   -> StackUsage\n   -> Doc\nstackCheck regstatus args args_in_regs fun_info_label (prof_sp, norm_sp) =\n  let\n     (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args\n\n     cmp_sp n\n       | n > 0 =\n          text \"if (Sp - WDS(\" <> int n <> text \") < SpLim) {\" $$\n          nest 4 (vcat [\n            if args_in_regs\n               then\n                 text \"Sp_adj\" <> parens (int (-sp_offset)) <> semi $$\n                 saveRegOffs reg_locs\n               else\n                 empty,\n            text \"Sp(0) = \" <> fun_info_label <> char ';',\n            mkJump regstatus (text \"__stg_gc_enter_1\") [\"R1\"] [] <> semi\n            ]) $$\n          char '}'\n       | otherwise = empty\n  in\n  vcat [ text \"#if defined(PROFILING)\",\n         cmp_sp prof_sp,\n         text \"#else\",\n         cmp_sp norm_sp,\n         text \"#endif\"\n       ]\n\ngenMkPAP :: RegStatus -- Register status\n         -> String    -- Macro\n         -> String    -- Jump target\n         -> [Reg]     -- Registers that are definitely live\n         -> String    -- Ticker\n         -> String    -- Disamb\n         -> Bool      -- Don't load argument registers before jump if True\n         -> Bool      -- Arguments already in registers if True\n         -> Bool      -- Is a PAP if True\n         -> [ArgRep]  -- Arguments\n         -> Int       -- Size of all arguments\n         -> Doc       -- info label\n         -> Bool      -- Is a function\n         -> (Doc, StackUsage)\ngenMkPAP regstatus macro jump live ticker disamb\n        no_load_regs    -- don't load argument regs before jumping\n        args_in_regs    -- arguments are already in regs\n        is_pap args all_args_size fun_info_label\n        is_fun_case\n  = (doc, stack_usage)\n\n  where\n    doc = vcat smaller_arity_doc $$ exact_arity_case $$ larger_arity_doc\n\n    stack_usage = maxStack (larger_arity_stack : smaller_arity_stack)\n\n    n_args = length args\n\n        -- offset of arguments on the stack at slow apply calls.\n    stk_args_slow_offset = 1\n\n    stk_args_offset\n        | args_in_regs = 0\n        | otherwise    = stk_args_slow_offset\n\n-- The SMALLER ARITY cases:\n--      if (arity == 1) {\n--          Sp[0] = Sp[1];\n--          Sp[1] = (W_)&stg_ap_1_info;\n--          JMP_(GET_ENTRY(R1.cl));\n    (smaller_arity_doc, smaller_arity_stack)\n       = unzip [ smaller_arity i | i <- [1..n_args-1] ]\n\n    smaller_arity arity = (doc, stack_usage)\n      where\n        (save_regs, stack_usage)\n          | overflow_regs = save_extra_regs\n          | otherwise     = shuffle_extra_args\n\n        doc =\n           text \"if (arity == \" <> int arity <> text \") {\" $$\n           nest 4 (vcat [\n           --  text \"TICK_SLOW_CALL_\" <> text ticker <> text \"_TOO_MANY();\",\n\n                -- load up regs for the call, if necessary\n             load_regs,\n\n                -- If we have more args in registers than are required\n                -- for the call, then we must save some on the stack,\n                -- and set up the stack for the follow-up call.\n                -- If the extra arguments are on the stack, then we must\n                -- instead shuffle them down to make room for the info\n                -- table for the follow-on call.\n             save_regs,\n\n                -- for a PAP, we have to arrange that the stack contains a\n                -- return address in the event that stg_PAP_entry fails its\n                -- heap check.  See stg_PAP_entry in Apply.cmm for details.\n             if is_pap\n                then text \"R2 = \" <> mkApplyInfoName this_call_args <> semi\n\n                else empty,\n            if is_fun_case then mb_tag_node arity else empty,\n            if overflow_regs\n                then mkJumpSaveCCCS\n                       regstatus (text jump) live (take arity args) <> semi\n                else mkJump regstatus (text jump) live (if no_load_regs then [] else args) <> semi\n            ]) $$\n           text \"}\"\n\n           -- offsets in case we need to save regs:\n        (reg_locs, _, _)\n           = assignRegs regstatus stk_args_offset args\n\n           -- register assignment for *this function call*\n        (reg_locs', reg_call_leftovers, reg_call_sp_stk_args)\n           = assignRegs regstatus stk_args_offset (take arity args)\n\n        load_regs\n           | no_load_regs || args_in_regs = empty\n           | otherwise                    = loadRegOffs reg_locs'\n\n        (this_call_args, rest_args) = splitAt arity args\n\n           -- the offset of the stack args from initial Sp\n        sp_stk_args\n           | args_in_regs = stk_args_offset\n           | no_load_regs = stk_args_offset\n           | otherwise    = reg_call_sp_stk_args\n\n           -- the stack args themselves\n        this_call_stack_args\n           | args_in_regs = reg_call_leftovers -- sp offsets are wrong\n           | no_load_regs = this_call_args\n           | otherwise    = reg_call_leftovers\n\n        stack_args_size = sum (map argSize this_call_stack_args)\n\n        overflow_regs = args_in_regs && length reg_locs > length reg_locs'\n\n        save_extra_regs = (doc, (size,size))\n          where\n             -- we have extra arguments in registers to save\n              extra_reg_locs = drop (length reg_locs') (reverse reg_locs)\n              adj_reg_locs = [ (reg, off - adj + 1) |\n                               (reg,off) <- extra_reg_locs ]\n              adj = case extra_reg_locs of\n                      (reg, fst_off):_ -> fst_off\n              size = snd (last adj_reg_locs) + 1\n\n              doc =\n                text \"Sp_adj(\" <> int (-size) <> text \");\" $$\n                saveRegOffs adj_reg_locs $$\n                loadSpWordOff \"W_\" 0 <> text \" = \" <>\n                             mkApplyInfoName rest_args <> semi\n\n        shuffle_extra_args = (doc, (shuffle_prof_stack, shuffle_norm_stack))\n          where\n           doc = vcat [ text \"#if defined(PROFILING)\",\n                        shuffle_prof_doc,\n                        text \"#else\",\n                        shuffle_norm_doc,\n                        text \"#endif\"]\n\n           (shuffle_prof_doc, shuffle_prof_stack) = shuffle True\n           (shuffle_norm_doc, shuffle_norm_stack) = shuffle False\n\n           -- Sadly here we have to insert an stg_restore_cccs frame\n           -- just underneath the stg_ap_*_info frame if we're\n           -- profiling; see Note [jump_SAVE_CCCS]\n           shuffle prof = (doc, -sp_adj)\n             where\n             sp_adj = sp_stk_args - 1 - offset\n             offset = if prof then 2 else 0\n             doc =\n               vcat (map (shuffle_down (offset+1))\n                      [sp_stk_args .. sp_stk_args+stack_args_size-1]) $$\n               (if prof\n                 then\n                   loadSpWordOff \"W_\" (sp_stk_args+stack_args_size-3)\n                     <> text \" = stg_restore_cccs_info;\" $$\n                   loadSpWordOff \"W_\" (sp_stk_args+stack_args_size-2)\n                     <> text \" = CCCS;\"\n                 else empty) $$\n               loadSpWordOff \"W_\" (sp_stk_args+stack_args_size-1)\n                     <> text \" = \"\n                     <> mkApplyInfoName rest_args <> semi $$\n               text \"Sp_adj(\" <> int sp_adj <> text \");\"\n\n        shuffle_down j i =\n             loadSpWordOff \"W_\" (i-j) <> text \" = \" <>\n             loadSpWordOff \"W_\" i <> semi\n\n\n-- The EXACT ARITY case\n--\n--      if (arity == 1) {\n--          Sp++;\n--          JMP_(GET_ENTRY(R1.cl));\n\n    exact_arity_case\n        = text \"if (arity == \" <> int n_args <> text \") {\" $$\n          let\n             (reg_doc, sp')\n                | no_load_regs || args_in_regs = (empty, stk_args_offset)\n                | otherwise    = loadRegArgs regstatus stk_args_offset args\n          in\n          nest 4 (vcat [\n--          text \"TICK_SLOW_CALL_\" <> text ticker <> text \"_CORRECT();\",\n            reg_doc,\n            text \"Sp_adj(\" <> int sp' <> text \");\",\n            if is_pap\n                then text \"R2 = \" <> fun_info_label <> semi\n                else empty,\n            if is_fun_case then mb_tag_node n_args else empty,\n            mkJump regstatus (text jump) live (if no_load_regs then [] else args) <> semi\n          ])\n\n-- The LARGER ARITY cases:\n--\n--      } else /* arity > 1 */ {\n--          BUILD_PAP(1,0,(W_)&stg_ap_v_info);\n--      }\n\n    (larger_arity_doc, larger_arity_stack) = (doc, stack)\n     where\n       -- offsets in case we need to save regs:\n       (reg_locs, leftovers, sp_offset)\n           = assignRegs regstatus stk_args_slow_offset args\n           -- BUILD_PAP assumes args start at offset 1\n\n       stack | args_in_regs = (sp_offset, sp_offset)\n             | otherwise    = (0,0)\n\n       doc =\n           text \"} else {\" $$\n           let\n             save_regs\n                | args_in_regs =\n                        text \"Sp_adj(\" <> int (-sp_offset) <> text \");\" $$\n                        saveRegOffs  reg_locs\n                | otherwise =\n                        empty\n           in\n           nest 4 (vcat [\n--              text \"TICK_SLOW_CALL_\" <> text ticker <> text \"_TOO_FEW();\",\n                save_regs,\n                -- Before building the PAP, tag the function closure pointer\n                if is_fun_case then\n                  vcat [\n                     text \"if (arity < \" <> int tAG_BITS_MAX <> text \") {\",\n                     text \"  R1 = R1 + arity\" <> semi,\n                     text \"}\"\n                   ]\n                  else empty\n                ,\n                text macro <> char '(' <> int n_args <> comma <>\n                                        int all_args_size <>\n                                        text \",\" <> fun_info_label <>\n                                        text \",\" <> text disamb <>\n                                        text \");\"\n           ]) $$\n           char '}'\n\n\n-- Note [jump_SAVE_CCCS]\n\n-- when profiling, if we have some extra arguments to apply that we\n-- save to the stack, we must also save the current cost centre stack\n-- and restore it when applying the extra arguments.  This is all\n-- handled by the macro jump_SAVE_CCCS(target), defined in\n-- rts/AutoApply.h.\n--\n-- At the jump, the stack will look like this:\n--\n--      ... extra args ...\n--      stg_ap_pp_info\n--      CCCS\n--      stg_restore_cccs_info\n\n-- --------------------------------------\n-- Examine tag bits of function pointer and enter it\n-- directly if needed.\n-- TODO: remove the redundant case in the original code.\nenterFastPath regstatus no_load_regs args_in_regs args\n    | Just tag <- tagForArity (length args)\n    = enterFastPathHelper tag regstatus no_load_regs args_in_regs args\nenterFastPath _ _ _ _ = empty\n\n-- Copied from Constants.hs & CgUtils.hs, i'd rather have this imported:\n-- (arity,tag)\ntAG_BITS = (TAG_BITS :: Int)\ntAG_BITS_MAX = ((1 `shiftL` tAG_BITS) :: Int)\n\ntagForArity :: Int -> Maybe Int\ntagForArity i | i < tAG_BITS_MAX = Just i\n              | otherwise        = Nothing\n\nenterFastPathHelper :: Int\n                    -> RegStatus\n                    -> Bool\n                    -> Bool\n                    -> [ArgRep]\n                    -> Doc\nenterFastPathHelper tag regstatus no_load_regs args_in_regs args =\n  text \"if (GETTAG(R1)==\" <> int tag <> text \") {\" $$\n  nest 4 (vcat [\n    reg_doc,\n    text \"Sp_adj(\" <> int sp' <> text \");\",\n    -- enter, but adjust offset with tag\n    mkJump regstatus (text \"%GET_ENTRY(R1-\" <> int tag <> text \")\") [\"R1\"] args <> semi\n  ]) $$\n  text \"}\"\n  -- I don't totally understand this code, I copied it from\n  -- exact_arity_case\n  -- TODO: refactor\n    where\n        -- offset of arguments on the stack at slow apply calls.\n    stk_args_slow_offset = 1\n\n    stk_args_offset\n        | args_in_regs = 0\n        | otherwise    = stk_args_slow_offset\n\n    (reg_doc, sp')\n        | no_load_regs || args_in_regs = (empty, stk_args_offset)\n        | otherwise    = loadRegArgs regstatus stk_args_offset args\n\ntickForArity arity\n    | True\n    = empty\n    | Just tag <- tagForArity arity\n    = vcat [\n            text \"W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;\",\n            text \"W_[SLOW_CALLS_\" <> int arity <> text \"] = W_[SLOW_CALLS_\" <> int arity <> text \"] + 1;\",\n            text \"if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == \" <> int arity <> text \" ) {\",\n            text \"  W_[RIGHT_ARITY_\" <> int arity <> text \"] = W_[RIGHT_ARITY_\" <> int arity <> text \"] + 1;\",\n            text \"  if (GETTAG(R1)==\" <> int tag <> text \") {\",\n            text \"    W_[TAGGED_PTR_\" <> int arity <> text \"] = W_[TAGGED_PTR_\" <> int arity <> text \"] + 1;\",\n            text \"  } else {\",\n            -- force a halt when not tagged!\n--          text \"    W_[0]=0;\",\n            text \"  }\",\n            text \"}\"\n          ]\ntickForArity _ = text \"W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;\"\n\n-- -----------------------------------------------------------------------------\n-- generate an apply function\n\n-- args is a list of 'p', 'n', 'f', 'd' or 'l'\nformalParam :: ArgRep -> Int -> Doc\nformalParam V _ = empty\nformalParam arg n =\n    formalParamType arg <> space <>\n    text \"arg\" <> int n <> text \", \"\nformalParamType arg = argRep arg\n\nargRep F   = text \"F_\"\nargRep D   = text \"D_\"\nargRep L   = text \"L_\"\nargRep P   = text \"gcptr\"\nargRep V16 = text \"V16_\"\nargRep V32 = text \"V32_\"\nargRep V64 = text \"V64_\"\nargRep _   = text \"W_\"\n\ngenApply :: RegStatus -> [ArgRep] -> Doc\ngenApply regstatus args =\n   let\n    fun_ret_label  = mkApplyRetName args\n    fun_info_label = mkApplyInfoName args\n    all_args_size  = sum (map argSize args)\n\n    (bco_doc, bco_stack) =\n       genMkPAP regstatus \"BUILD_PAP\" \"ENTRY_LBL(stg_BCO)\" [\"R1\"] \"FUN\" \"BCO\"\n             True{-stack apply-} False{-args on stack-} False{-not a PAP-}\n             args all_args_size fun_info_label {- tag stmt -}False\n\n    (fun_doc, fun_stack) =\n       genMkPAP regstatus \"BUILD_PAP\" \"%GET_ENTRY(UNTAG(R1))\" [\"R1\"] \"FUN\" \"FUN\"\n             False{-reg apply-} False{-args on stack-} False{-not a PAP-}\n             args all_args_size fun_info_label {- tag stmt -}True\n\n    (pap_doc, pap_stack) =\n       genMkPAP regstatus \"NEW_PAP\" \"stg_PAP_apply\" [\"R1\", \"R2\"] \"PAP\" \"PAP\"\n             True{-stack apply-} False{-args on stack-} True{-is a PAP-}\n             args all_args_size fun_info_label {- tag stmt -}False\n\n    stack_usage = maxStack [bco_stack, fun_stack, pap_stack]\n   in\n    vcat [\n      text \"INFO_TABLE_RET(\" <> mkApplyName args <> text \", \" <>\n        text \"RET_SMALL, W_ info_ptr, \" <> (cat $ zipWith formalParam args [1..]) <>\n        text \")\\n{\",\n      nest 4 (vcat [\n       text \"W_ info;\",\n       text \"W_ arity;\",\n       text \"unwind Sp = Sp + WDS(\" <> int (1+all_args_size) <> text \");\",\n\n--    if fast == 1:\n--        print \"static void *lbls[] =\"\n--        print \"  { [FUN]             &&fun_lbl,\"\n--        print \"    [FUN_1_0]         &&fun_lbl,\"\n--        print \"    [FUN_0_1]        &&fun_lbl,\"\n--        print \"    [FUN_2_0]        &&fun_lbl,\"\n--        print \"    [FUN_1_1]        &&fun_lbl,\"\n--        print \"    [FUN_0_2]        &&fun_lbl,\"\n--        print \"    [FUN_STATIC]      &&fun_lbl,\"\n--        print \"    [PAP]             &&pap_lbl,\"\n--        print \"    [THUNK]           &&thunk_lbl,\"\n--        print \"    [THUNK_1_0]              &&thunk_lbl,\"\n--        print \"    [THUNK_0_1]              &&thunk_lbl,\"\n--        print \"    [THUNK_2_0]              &&thunk_lbl,\"\n--        print \"    [THUNK_1_1]              &&thunk_lbl,\"\n--        print \"    [THUNK_0_2]              &&thunk_lbl,\"\n--        print \"    [THUNK_STATIC]    &&thunk_lbl,\"\n--        print \"    [THUNK_SELECTOR]  &&thunk_lbl,\"\n--        print \"    [IND]            &&ind_lbl,\"\n--        print \"    [IND_STATIC]      &&ind_lbl,\"\n--        print \"  };\"\n\n       tickForArity (length args),\n       text \"\",\n       text \"IF_DEBUG(apply,foreign \\\"C\\\" debugBelch(\\\"\" <> fun_ret_label <>\n          text \"... \\\"); foreign \\\"C\\\" printClosure(R1 \\\"ptr\\\"));\",\n\n       text \"IF_DEBUG(sanity,foreign \\\"C\\\" checkStackFrame(Sp+WDS(\" <> int (1 + all_args_size)\n        <> text \")\\\"ptr\\\"));\",\n\n--       text \"IF_DEBUG(sanity,checkStackChunk(Sp+\" <> int (1 + all_args_size) <>\n--        text \", CurrentTSO->stack + CurrentTSO->stack_size));\",\n\n--       text \"TICK_SLOW_CALL(\" <> int (length args) <> text \");\",\n\n       let do_assert [] _ = []\n           do_assert (arg:args) offset\n                | isPtr arg = this : rest\n                | otherwise = rest\n                where this = text \"ASSERT(LOOKS_LIKE_CLOSURE_PTR(Sp(\"\n                                 <> int offset <> text \")));\"\n                      rest = do_assert args (offset + argSize arg)\n       in\n       vcat (do_assert args 1),\n\n       text  \"again:\",\n\n       -- if pointer is tagged enter it fast!\n       enterFastPath regstatus False False args,\n\n       stackCheck regstatus args False{-args on stack-}\n                  fun_info_label stack_usage,\n\n       -- Functions can be tagged, so we untag them!\n       text  \"R1 = UNTAG(R1);\",\n       text  \"info = %INFO_PTR(R1);\",\n\n--    if fast == 1:\n--        print \"    goto *lbls[info->type];\";\n--    else:\n        text \"switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(%STD_INFO(info)))) {\",\n        nest 4 (vcat [\n\n--    if fast == 1:\n--        print \"    bco_lbl:\"\n--    else:\n        text \"case BCO: {\",\n        nest 4 (vcat [\n          text \"arity = TO_W_(StgBCO_arity(R1));\",\n          text \"ASSERT(arity > 0);\",\n          bco_doc\n         ]),\n        text \"}\",\n\n--    if fast == 1:\n--        print \"    fun_lbl:\"\n--    else:\n        text \"case FUN,\",\n        text \"     FUN_1_0,\",\n        text \"     FUN_0_1,\",\n        text \"     FUN_2_0,\",\n        text \"     FUN_1_1,\",\n        text \"     FUN_0_2,\",\n        text \"     FUN_STATIC: {\",\n        nest 4 (vcat [\n          text \"arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));\",\n          text \"ASSERT(arity > 0);\",\n          fun_doc\n         ]),\n        text \"}\",\n\n--    if fast == 1:\n--        print \"    pap_lbl:\"\n--    else:\n\n        text \"case PAP: {\",\n        nest 4 (vcat [\n          text \"arity = TO_W_(StgPAP_arity(R1));\",\n          text \"ASSERT(arity > 0);\",\n          pap_doc\n         ]),\n        text \"}\",\n\n        text \"\",\n\n--    if fast == 1:\n--        print \"    thunk_lbl:\"\n--    else:\n        text \"case AP,\",\n        text \"     AP_STACK,\",\n        text \"     BLACKHOLE,\",\n        text \"     WHITEHOLE,\",\n        text \"     THUNK,\",\n        text \"     THUNK_1_0,\",\n        text \"     THUNK_0_1,\",\n        text \"     THUNK_2_0,\",\n        text \"     THUNK_1_1,\",\n        text \"     THUNK_0_2,\",\n        text \"     THUNK_STATIC,\",\n        text \"     THUNK_SELECTOR: {\",\n        nest 4 (vcat [\n--          text \"TICK_SLOW_CALL_UNEVALD(\" <> int (length args) <> text \");\",\n          text \"Sp(0) = \" <> fun_info_label <> text \";\",\n          -- CAREFUL! in SMP mode, the info table may already have been\n          -- overwritten by an indirection, so we must enter the original\n          -- info pointer we read, don't read it again, because it might\n          -- not be enterable any more.\n          mkJumpSaveCCCS\n            regstatus (text \"%ENTRY_CODE(info)\") [\"R1\"] args <> semi,\n            -- see Note [jump_SAVE_CCCS]\n          text \"\"\n         ]),\n        text \"}\",\n\n--    if fast == 1:\n--        print \"    ind_lbl:\"\n--    else:\n        text \"case IND,\",\n        text \"     IND_STATIC: {\",\n        nest 4 (vcat [\n          text \"R1 = StgInd_indirectee(R1);\",\n            -- An indirection node might contain a tagged pointer\n          text \"goto again;\"\n         ]),\n        text \"}\",\n        text \"\",\n\n--    if fast == 0:\n\n       text \"default: {\",\n       nest 4 (\n         text \"foreign \\\"C\\\" barf(\\\"\" <> fun_ret_label <> text \"\\\") never returns;\"\n       ),\n       text \"}\"\n\n        ]),\n       text \"}\"\n      ]),\n\n      text \"}\"\n    ]\n\n-- -----------------------------------------------------------------------------\n-- Making a fast unknown application, args are in regs\n\ngenApplyFast :: RegStatus -> [ArgRep] -> Doc\ngenApplyFast regstatus args =\n   let\n    fun_fast_label = mkApplyFastName args\n    fun_ret_label  = text \"RET_LBL\" <> parens (mkApplyName args)\n    fun_info_label = mkApplyInfoName args\n    all_args_size  = sum (map argSize args)\n\n    (fun_doc, fun_stack) =\n       genMkPAP regstatus \"BUILD_PAP\" \"%GET_ENTRY(UNTAG(R1))\" [\"R1\"] \"FUN\" \"FUN\"\n            False{-reg apply-} True{-args in regs-} False{-not a PAP-}\n            args all_args_size fun_info_label {- tag stmt -}True\n\n    (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args\n\n    stack_usage = maxStack [fun_stack, (sp_offset,sp_offset)]\n   in\n    vcat [\n     fun_fast_label,\n     char '{',\n     nest 4 (vcat [\n        text \"W_ info;\",\n        text \"W_ arity;\",\n\n        tickForArity (length args),\n\n        -- if pointer is tagged enter it fast!\n        enterFastPath regstatus False True args,\n\n        stackCheck regstatus args True{-args in regs-}\n                   fun_info_label stack_usage,\n\n        -- Functions can be tagged, so we untag them!\n        text  \"R1 = UNTAG(R1);\",\n        text  \"info = %GET_STD_INFO(R1);\",\n        text \"switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(info))) {\",\n        nest 4 (vcat [\n          text \"case FUN,\",\n          text \"     FUN_1_0,\",\n          text \"     FUN_0_1,\",\n          text \"     FUN_2_0,\",\n          text \"     FUN_1_1,\",\n          text \"     FUN_0_2,\",\n          text \"     FUN_STATIC: {\",\n          nest 4 (vcat [\n            text \"arity = TO_W_(StgFunInfoExtra_arity(%GET_FUN_INFO(R1)));\",\n            text \"ASSERT(arity > 0);\",\n            fun_doc\n           ]),\n          char '}',\n\n          text \"default: {\",\n          nest 4 (vcat [\n             text \"Sp_adj\" <> parens (int (-sp_offset)) <> semi,\n             saveRegOffs reg_locs,\n             mkJump regstatus fun_ret_label [] args <> semi\n          ]),\n          char '}'\n        ]),\n\n       char '}'\n     ]),\n     char '}'\n   ]\n\n-- -----------------------------------------------------------------------------\n-- Making a stack apply\n\n-- These little functions are like slow entry points.  They provide\n-- the layer between the PAP entry code and the function's fast entry\n-- point: namely they load arguments off the stack into registers (if\n-- available) and jump to the function's entry code.\n--\n-- On entry: R1 points to the function closure\n--           arguments are on the stack starting at Sp\n--\n-- Invariant: the list of arguments never contains void.  Since we're only\n-- interested in loading arguments off the stack here, we can ignore\n-- void arguments.\n\nmkStackApplyEntryLabel:: [ArgRep] -> Doc\nmkStackApplyEntryLabel args = text \"stg_ap_stk_\" <> text (concatMap showArg args)\n\ngenStackApply :: RegStatus -> [ArgRep] -> Doc\ngenStackApply regstatus args =\n  let fn_entry_label = mkStackApplyEntryLabel args in\n  vcat [\n    fn_entry_label,\n    text \"{\", nest 4 body, text \"}\"\n   ]\n where\n   (assign_regs, sp') = loadRegArgs regstatus 0 args\n   body = vcat [assign_regs,\n                text \"Sp_adj\" <> parens (int sp') <> semi,\n                mkJump regstatus (text \"%GET_ENTRY(UNTAG(R1))\") [\"R1\"] args <> semi\n                ]\n\n-- -----------------------------------------------------------------------------\n-- Stack save entry points.\n--\n-- These code fragments are used to save registers on the stack at a heap\n-- check failure in the entry code for a function.  We also have to save R1\n-- and the return address (stg_gc_fun_info) on the stack.  See __stg_gc_fun\n-- in HeapStackCheck.cmm for more details.\n\nmkStackSaveEntryLabel :: [ArgRep] -> Doc\nmkStackSaveEntryLabel args = text \"stg_stk_save_\" <> text (concatMap showArg args)\n\ngenStackSave :: RegStatus -> [ArgRep] -> Doc\ngenStackSave regstatus args =\n  let fn_entry_label= mkStackSaveEntryLabel args in\n  vcat [\n    fn_entry_label,\n    text \"{\", nest 4 body, text \"}\"\n   ]\n where\n   body = vcat [text \"Sp_adj\" <> parens (int (-sp_offset)) <> semi,\n                saveRegOffs reg_locs,\n                text \"Sp(2) = R1;\",\n                text \"Sp(1) =\" <+> int stk_args <> semi,\n                text \"Sp(0) = stg_gc_fun_info;\",\n                text \"jump stg_gc_noregs [];\"\n                ]\n\n   std_frame_size = 3 -- the std bits of the frame. See StgRetFun in Closures.h,\n                      -- and the comment on stg_fun_gc_gen\n                      -- in HeapStackCheck.cmm.\n   (reg_locs, leftovers, sp_offset) = assignRegs regstatus std_frame_size args\n\n   -- number of words of arguments on the stack.\n   stk_args = sum (map argSize leftovers) + sp_offset - std_frame_size\n\n-- -----------------------------------------------------------------------------\n-- The prologue...\n\nmain = do\n  args <- getArgs\n  regstatus <- case args of\n                 [] -> return Registerised\n                 [\"-u\"] -> return Unregisterised\n                 _other -> do hPutStrLn stderr \"syntax: genapply [-u]\"\n                              exitWith (ExitFailure 1)\n  let the_code = vcat [\n                text \"// DO NOT EDIT!\",\n                text \"// Automatically generated by utils/genapply/Main.hs\",\n                text \"\",\n                text \"#include \\\"Cmm.h\\\"\",\n                text \"#include \\\"AutoApply.h\\\"\",\n                text \"\",\n\n                vcat (intersperse (text \"\") $\n                   map (genApply regstatus) applyTypes),\n                vcat (intersperse (text \"\") $\n                   map (genStackFns regstatus) stackApplyTypes),\n\n                vcat (intersperse (text \"\") $\n                   map (genApplyFast regstatus) applyTypes),\n\n                genStackApplyArray stackApplyTypes,\n                genStackSaveArray stackApplyTypes,\n                genBitmapArray stackApplyTypes,\n\n                text \"\"  -- add a newline at the end of the file\n            ]\n  -- in\n  putStr (render the_code)\n\n-- These have been shown to cover about 99% of cases in practice...\napplyTypes = [\n        [V],\n        [F],\n        [D],\n        [L],\n        [V16],\n        [V32],\n        [V64],\n        [N],\n        [P],\n        [P,V],\n        [P,P],\n        [P,P,V],\n        [P,P,P],\n        [P,P,P,V],\n        [P,P,P,P],\n        [P,P,P,P,P],\n        [P,P,P,P,P,P]\n   ]\n\n-- No need for V args in the stack apply cases.\n-- ToDo: the stack apply and stack save code doesn't make a distinction\n-- between N and P (they both live in the same register), only the bitmap\n-- changes, so we could share the apply/save code between lots of cases.\n--\n--  NOTE: other places to change if you change stackApplyTypes:\n--       - includes/rts/storage/FunTypes.h\n--       - compiler/codeGen/StgCmmLayout.hs: stdPattern\nstackApplyTypes = [\n        [],\n        [N],\n        [P],\n        [F],\n        [D],\n        [L],\n        [V16],\n        [V32],\n        [V64],\n        [N,N],\n        [N,P],\n        [P,N],\n        [P,P],\n        [N,N,N],\n        [N,N,P],\n        [N,P,N],\n        [N,P,P],\n        [P,N,N],\n        [P,N,P],\n        [P,P,N],\n        [P,P,P],\n        [P,P,P,P],\n        [P,P,P,P,P],\n        [P,P,P,P,P,P],\n        [P,P,P,P,P,P,P],\n        [P,P,P,P,P,P,P,P]\n   ]\n\ngenStackFns regstatus args\n  =  genStackApply regstatus args\n  $$ genStackSave regstatus args\n\n\ngenStackApplyArray types =\n  vcat [\n    text \"section \\\"relrodata\\\" {\",\n    text \"stg_ap_stack_entries:\",\n    text \"W_ 0; W_ 0; W_ 0;\", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO\n    vcat (map arr_ent types),\n    text \"}\"\n  ]\n where\n  arr_ent ty = text \"W_\" <+> mkStackApplyEntryLabel ty <> semi\n\ngenStackSaveArray types =\n  vcat [\n    text \"section \\\"relrodata\\\" {\",\n    text \"stg_stack_save_entries:\",\n    text \"W_ 0; W_ 0; W_ 0;\", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO\n    vcat (map arr_ent types),\n    text \"}\"\n  ]\n where\n  arr_ent ty = text \"W_\" <+> mkStackSaveEntryLabel ty <> semi\n\ngenBitmapArray :: [[ArgRep]] -> Doc\ngenBitmapArray types =\n  vcat [\n    text \"section \\\"rodata\\\" {\",\n    text \"stg_arg_bitmaps:\",\n    text \"W_ 0; W_ 0; W_ 0;\", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO\n    vcat (map gen_bitmap types),\n    text \"}\"\n  ]\n  where\n   gen_bitmap ty = text \"W_\" <+> int bitmap_val <> semi\n        where bitmap_val =\n                (fromIntegral (mkBitmap ty) `shiftL` BITMAP_BITS_SHIFT)\n                 .|. sum (map argSize ty)\n", "num_lines": 1070}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "------------------------------------------------------------------\n-- A primop-table mangling program                              --\n------------------------------------------------------------------\n\nmodule Main where\n\nimport Parser\nimport Syntax\n\nimport Data.Char\nimport Data.List\nimport Data.Maybe ( catMaybes )\nimport System.Environment ( getArgs )\n\nvecOptions :: Entry -> [(String,String,Int)]\nvecOptions i =\n    concat [vecs | OptionVector vecs <- opts i]\n\ndesugarVectorSpec :: Entry -> [Entry]\ndesugarVectorSpec i@(Section {}) = [i]\ndesugarVectorSpec i              = case vecOptions i of\n                                     []  -> [i]\n                                     vos -> map genVecEntry vos\n  where\n    genVecEntry :: (String,String,Int) -> Entry\n    genVecEntry (con,repCon,n) =\n        case i of\n          PrimOpSpec {} ->\n              PrimVecOpSpec { cons    = \"(\" ++ concat (intersperse \" \" [cons i, vecCat, show n, vecWidth]) ++ \")\"\n                            , name    = name'\n                            , prefix  = pfx\n                            , veclen  = n\n                            , elemrep = con ++ \"ElemRep\"\n                            , ty      = desugarTy (ty i)\n                            , cat     = cat i\n                            , desc    = desc i\n                            , opts    = opts i\n                            }\n          PrimTypeSpec {} ->\n              PrimVecTypeSpec { ty      = desugarTy (ty i)\n                              , prefix  = pfx\n                              , veclen  = n\n                              , elemrep = con ++ \"ElemRep\"\n                              , desc    = desc i\n                              , opts    = opts i\n                              }\n          _ ->\n              error \"vector options can only be given for primops and primtypes\"\n      where\n        vecCons       = con++\"X\"++show n++\"#\"\n        vecCat        = conCat con\n        vecWidth      = conWidth con\n        pfx           = lowerHead con++\"X\"++show n\n        vecTyName     = pfx++\"PrimTy\"\n\n        name' | Just pre <- splitSuffix (name i) \"Array#\"     = pre++vec++\"Array#\"\n              | Just pre <- splitSuffix (name i) \"OffAddr#\"   = pre++vec++\"OffAddr#\"\n              | Just pre <- splitSuffix (name i) \"ArrayAs#\"   = pre++con++\"ArrayAs\"++vec++\"#\"\n              | Just pre <- splitSuffix (name i) \"OffAddrAs#\" = pre++con++\"OffAddrAs\"++vec++\"#\"\n              | otherwise                                     = init (name i)++vec ++\"#\"\n          where\n            vec = con++\"X\"++show n\n\n        splitSuffix :: Eq a => [a] -> [a] -> Maybe [a]\n        splitSuffix s suf\n            | drop len s == suf = Just (take len s)\n            | otherwise         = Nothing\n          where\n            len = length s - length suf\n\n        lowerHead s = toLower (head s) : tail s\n\n        desugarTy :: Ty -> Ty\n        desugarTy (TyF s d)           = TyF (desugarTy s) (desugarTy d)\n        desugarTy (TyC s d)           = TyC (desugarTy s) (desugarTy d)\n        desugarTy (TyApp SCALAR [])   = TyApp (TyCon repCon) []\n        desugarTy (TyApp VECTOR [])   = TyApp (VecTyCon vecCons vecTyName) []\n        desugarTy (TyApp VECTUPLE []) = TyUTup (replicate n (TyApp (TyCon repCon) []))\n        desugarTy (TyApp tycon ts)    = TyApp tycon (map desugarTy ts)\n        desugarTy t@(TyVar {})        = t\n        desugarTy (TyUTup ts)         = TyUTup (map desugarTy ts)\n\n    conCat :: String -> String\n    conCat \"Int8\"   = \"IntVec\"\n    conCat \"Int16\"  = \"IntVec\"\n    conCat \"Int32\"  = \"IntVec\"\n    conCat \"Int64\"  = \"IntVec\"\n    conCat \"Word8\"  = \"WordVec\"\n    conCat \"Word16\" = \"WordVec\"\n    conCat \"Word32\" = \"WordVec\"\n    conCat \"Word64\" = \"WordVec\"\n    conCat \"Float\"  = \"FloatVec\"\n    conCat \"Double\" = \"FloatVec\"\n    conCat con      = error $ \"conCat: unknown type constructor \" ++ con ++ \"\\n\"\n\n    conWidth :: String -> String\n    conWidth \"Int8\"   = \"W8\"\n    conWidth \"Int16\"  = \"W16\"\n    conWidth \"Int32\"  = \"W32\"\n    conWidth \"Int64\"  = \"W64\"\n    conWidth \"Word8\"  = \"W8\"\n    conWidth \"Word16\" = \"W16\"\n    conWidth \"Word32\" = \"W32\"\n    conWidth \"Word64\" = \"W64\"\n    conWidth \"Float\"  = \"W32\"\n    conWidth \"Double\" = \"W64\"\n    conWidth con      = error $ \"conWidth: unknown type constructor \" ++ con ++ \"\\n\"\n\nmain :: IO ()\nmain = getArgs >>= \\args ->\n       if length args /= 1 || head args `notElem` known_args\n       then error (\"usage: genprimopcode command < primops.txt > ...\\n\"\n                   ++ \"   where command is one of\\n\"\n                   ++ unlines (map (\"            \"++) known_args)\n                  )\n       else\n       do s <- getContents\n          case parse s of\n             Left err -> error (\"parse error at \" ++ (show err))\n             Right p_o_specs@(Info _ _)\n                -> seq (sanityTop p_o_specs) (\n                   case head args of\n\n                      \"--data-decl\"\n                         -> putStr (gen_data_decl p_o_specs)\n\n                      \"--has-side-effects\"\n                         -> putStr (gen_switch_from_attribs\n                                       \"has_side_effects\"\n                                       \"primOpHasSideEffects\" p_o_specs)\n\n                      \"--out-of-line\"\n                         -> putStr (gen_switch_from_attribs\n                                       \"out_of_line\"\n                                       \"primOpOutOfLine\" p_o_specs)\n\n                      \"--commutable\"\n                         -> putStr (gen_switch_from_attribs\n                                       \"commutable\"\n                                       \"commutableOp\" p_o_specs)\n\n                      \"--code-size\"\n                         -> putStr (gen_switch_from_attribs\n                                       \"code_size\"\n                                       \"primOpCodeSize\" p_o_specs)\n\n                      \"--can-fail\"\n                         -> putStr (gen_switch_from_attribs\n                                       \"can_fail\"\n                                       \"primOpCanFail\" p_o_specs)\n\n                      \"--strictness\"\n                         -> putStr (gen_switch_from_attribs\n                                       \"strictness\"\n                                       \"primOpStrictness\" p_o_specs)\n\n                      \"--fixity\"\n                         -> putStr (gen_switch_from_attribs\n                                       \"fixity\"\n                                       \"primOpFixity\" p_o_specs)\n\n                      \"--primop-primop-info\"\n                         -> putStr (gen_primop_info p_o_specs)\n\n                      \"--primop-tag\"\n                         -> putStr (gen_primop_tag p_o_specs)\n\n                      \"--primop-list\"\n                         -> putStr (gen_primop_list p_o_specs)\n\n                      \"--primop-vector-uniques\"\n                         -> putStr (gen_primop_vector_uniques p_o_specs)\n\n                      \"--primop-vector-tys\"\n                         -> putStr (gen_primop_vector_tys p_o_specs)\n\n                      \"--primop-vector-tys-exports\"\n                         -> putStr (gen_primop_vector_tys_exports p_o_specs)\n\n                      \"--primop-vector-tycons\"\n                         -> putStr (gen_primop_vector_tycons p_o_specs)\n\n                      \"--make-haskell-wrappers\"\n                         -> putStr (gen_wrappers p_o_specs)\n\n                      \"--make-haskell-source\"\n                         -> putStr (gen_hs_source p_o_specs)\n\n                      \"--make-latex-doc\"\n                         -> putStr (gen_latex_doc p_o_specs)\n\n                      _ -> error \"Should not happen, known_args out of sync?\"\n                   )\n\nknown_args :: [String]\nknown_args\n   = [ \"--data-decl\",\n       \"--has-side-effects\",\n       \"--out-of-line\",\n       \"--commutable\",\n       \"--code-size\",\n       \"--can-fail\",\n       \"--strictness\",\n       \"--fixity\",\n       \"--primop-primop-info\",\n       \"--primop-tag\",\n       \"--primop-list\",\n       \"--primop-vector-uniques\",\n       \"--primop-vector-tys\",\n       \"--primop-vector-tys-exports\",\n       \"--primop-vector-tycons\",\n       \"--make-haskell-wrappers\",\n       \"--make-haskell-source\",\n       \"--make-latex-doc\"\n     ]\n\n------------------------------------------------------------------\n-- Code generators -----------------------------------------------\n------------------------------------------------------------------\n\ngen_hs_source :: Info -> String\ngen_hs_source (Info defaults entries) =\n       \"{-\\n\"\n    ++ \"This is a generated file (generated by genprimopcode).\\n\"\n    ++ \"It is not code to actually be used. Its only purpose is to be\\n\"\n    ++ \"consumed by haddock.\\n\"\n    ++ \"-}\\n\"\n    ++ \"\\n\"\n        ++ (replicate 77 '-' ++ \"\\n\") -- For 80-col cleanliness\n        ++ \"-- |\\n\"\n        ++ \"-- Module      :  GHC.Prim\\n\"\n        ++ \"-- \\n\"\n        ++ \"-- Maintainer  :  ghc-devs@haskell.org\\n\"\n        ++ \"-- Stability   :  internal\\n\"\n        ++ \"-- Portability :  non-portable (GHC extensions)\\n\"\n        ++ \"--\\n\"\n        ++ \"-- GHC\\'s primitive types and operations.\\n\"\n        ++ \"-- Use GHC.Exts from the base package instead of importing this\\n\"\n        ++ \"-- module directly.\\n\"\n        ++ \"--\\n\"\n        ++ (replicate 77 '-' ++ \"\\n\") -- For 80-col cleanliness\n        ++ \"{-# LANGUAGE Unsafe #-}\\n\"\n        ++ \"{-# LANGUAGE MagicHash #-}\\n\"\n        ++ \"{-# LANGUAGE MultiParamTypeClasses #-}\\n\"\n        ++ \"{-# LANGUAGE NoImplicitPrelude #-}\\n\"\n        ++ \"{-# LANGUAGE UnboxedTuples #-}\\n\"\n        ++ \"{-# LANGUAGE NegativeLiterals #-}\\n\"\n\n        ++ \"{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\\n\"\n                -- We generate a binding for coerce, like\n                --   coerce :: Coercible a b => a -> b\n                --   coerce = let x = x in x\n                -- and we don't want a complaint that the constraint is redundant\n                -- Remember, this silly file is only for Haddock's consumption\n\n        ++ \"module GHC.Prim (\\n\"\n        ++ unlines (map ((\"        \" ++) . hdr) entries')\n        ++ \") where\\n\"\n    ++ \"\\n\"\n    ++ \"{-\\n\"\n        ++ unlines (map opt defaults)\n    ++ \"-}\\n\"\n    ++ \"import GHC.Types (Coercible)\\n\"\n\n    ++ \"default ()\"  -- If we don't say this then the default type include Integer\n                     -- so that runs off and loads modules that are not part of\n                     -- package ghc-prim at all.  And that in turn somehow ends up\n                     -- with Declaration for $fEqMaybe:\n                     --       attempting to use module \u00e2\u20ac\u02dcGHC.Classes\u00e2\u20ac\u2122\n                     --       (libraries/ghc-prim/./GHC/Classes.hs) which is not loaded\n                     -- coming from LoadIface.homeModError\n                     -- I'm not sure precisely why; but I *am* sure that we don't need\n                     -- any type-class defaulting; and it's clearly wrong to need\n                     -- the base package when haddocking ghc-prim\n\n       -- Now the main payload\n    ++ \"\\n\" ++ unlines (concatMap ent entries') ++ \"\\n\\n\\n\"\n\n     where entries' = concatMap desugarVectorSpec entries\n\n           opt (OptionFalse n)    = n ++ \" = False\"\n           opt (OptionTrue n)     = n ++ \" = True\"\n           opt (OptionString n v) = n ++ \" = { \" ++ v ++ \"}\"\n           opt (OptionInteger n v) = n ++ \" = \" ++ show v\n           opt (OptionVector _)    = \"\"\n           opt (OptionFixity mf) = \"fixity\" ++ \" = \" ++ show mf\n\n           hdr s@(Section {})                                    = sec s\n           hdr (PrimOpSpec { name = n })                         = wrapOp n ++ \",\"\n           hdr (PrimVecOpSpec { name = n })                      = wrapOp n ++ \",\"\n           hdr (PseudoOpSpec { name = n })                       = wrapOp n ++ \",\"\n           hdr (PrimTypeSpec { ty = TyApp (TyCon \"->\") _ })      = \"\"\n                  -- GHC lacks the syntax to explicitly export \"->\"\n           hdr (PrimTypeSpec { ty = TyApp (TyCon n) _ })         = wrapOp n ++ \",\"\n           hdr (PrimTypeSpec {})                                 = error $ \"Illegal type spec\"\n           hdr (PrimVecTypeSpec { ty = TyApp (VecTyCon n _) _ }) = wrapOp n ++ \",\"\n           hdr (PrimVecTypeSpec {})                              = error $ \"Illegal type spec\"\n\n           sec s = \"\\n-- * \" ++ escape (title s) ++ \"\\n\"\n                    ++ (unlines $ map (\"-- \" ++ ) $ lines $ unlatex $ escape $ \"|\" ++ desc s)\n\n\n           ent   (Section {})         = []\n           ent o@(PrimOpSpec {})      = spec o\n           ent o@(PrimVecOpSpec {})   = spec o\n           ent o@(PrimTypeSpec {})    = spec o\n           ent o@(PrimVecTypeSpec {}) = spec o\n           ent o@(PseudoOpSpec {})    = spec o\n\n           spec o = ([ \"\" ] ++) . concat $\n             -- Doc comments\n             [ case unlatex (escape (desc o)) ++ extra (opts o) of\n                 \"\" -> []\n                 cmmt -> map (\"-- \" ++) $ lines $ \"|\" ++ cmmt\n\n             -- Deprecations\n             , [ d | Just n <- [getName o], d <- prim_deprecated (opts o) n ]\n\n             -- Fixity\n             , [ f | Just n <- [getName o], f <- prim_fixity (opts o) n ]\n\n             -- Declarations (see Note [Placeholder declarations])\n             , case o of\n                 PrimOpSpec { name = n, ty = t }    -> prim_func n t\n                 PrimVecOpSpec { name = n, ty = t } -> prim_func n t\n                 PseudoOpSpec { name = n, ty = t }  -> prim_func n t\n                 PrimTypeSpec { ty = t }    -> prim_data t\n                 PrimVecTypeSpec { ty = t } -> prim_data t\n                 Section { } -> error \"Section is not an entity\"\n             ]\n\n           extra options = case on_llvm_only options ++ can_fail options of\n             [m1,m2] -> \"\\n\\n__/Warning:/__ this \" ++ m1 ++ \" and \" ++ m2 ++ \".\"\n             [m] -> \"\\n\\n__/Warning:/__ this \" ++ m ++ \".\"\n             _ -> \"\"\n\n           on_llvm_only options\n             = [ \"is only available on LLVM\"\n               | Just (OptionTrue _) <- [lookup_attrib \"llvm_only\" options] ]\n\n           can_fail options\n             = [ \"can fail with an unchecked exception\"\n               | Just (OptionTrue _) <- [lookup_attrib \"can_fail\" options] ]\n\n           prim_deprecated options n\n              = [ \"{-# DEPRECATED \" ++ wrapOp n ++ \" \\\"\" ++ msg ++ \"\\\" #-}\"\n                | Just (OptionString _ msg)\n                    <- [lookup_attrib \"deprecated_msg\" options] ]\n\n           prim_fixity options n\n              = [ pprFixityDir d ++ \" \" ++ show i ++ \" \" ++ asInfix n\n                | OptionFixity (Just (Fixity _ i d)) <- options ]\n\n           prim_func n t = [ wrapOp n ++ \" :: \" ++ pprTy t,\n                             wrapOp n ++ \" = \" ++ funcRhs n ]\n\n           funcRhs \"tagToEnum#\" = \"let x = x in x\"\n           funcRhs nm           = wrapOp nm\n              -- Special case for tagToEnum#: see Note [Placeholder declarations]\n\n           prim_data t = [ \"data \" ++ pprTy t ]\n\n           unlatex s = case s of\n                '\\\\':'t':'e':'x':'t':'t':'t':'{':cs -> markup \"@\" \"@\" cs\n                '{':'\\\\':'t':'e':'x':'t':'t':'t':' ':cs -> markup \"@\" \"@\" cs\n                '{':'\\\\':'t':'t':cs -> markup \"@\" \"@\" cs\n                '{':'\\\\':'i':'t':cs -> markup \"/\" \"/\" cs\n                '{':'\\\\':'e':'m':cs -> markup \"/\" \"/\" cs\n                c : cs -> c : unlatex cs\n                \"\" -> \"\"\n           markup s t xs = s ++ mk (dropWhile isSpace xs)\n                where mk \"\"        = t\n                      mk ('\\n':cs) = ' ' : mk cs\n                      mk ('}':cs)  = t ++ unlatex cs\n                      mk (c:cs)    = c : mk cs\n           escape = concatMap (\\c -> if c `elem` special then '\\\\':c:[] else c:[])\n                where special = \"/'`\\\"@<\"\n\n-- | Extract a string representation of the name\ngetName :: Entry -> Maybe String\ngetName PrimOpSpec{ name = n } = Just n\ngetName PrimVecOpSpec{ name = n } = Just n\ngetName PseudoOpSpec{ name = n } = Just n\ngetName PrimTypeSpec{ ty = TyApp tc _ } = Just (show tc)\ngetName _ = Nothing\n\n{- Note [Placeholder declarations]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\nWe are generating fake declarations for things in GHC.Prim, just to\nkeep GHC's renamer and typechecker happy enough for what Haddock\nneeds.  Our main plan is to say\n        foo :: <type>\n        foo = foo\nWe have to silence GHC's complaints about unboxed-top-level declarations\nwith an ad-hoc fix in TcBinds: see Note [Compiling GHC.Prim] in TcBinds.\n\nThat works for all the primitive functions except tagToEnum#.\nIf we generate the binding\n        tagToEnum# = tagToEnum#\nGHC will complain about \"tagToEnum# must appear applied to one argument\".\nWe could hack GHC to silence this complaint when compiling GHC.Prim,\nbut it seems easier to generate\n        tagToEnum# = let x = x in x\nWe don't do this for *all* bindings because for ones with an unboxed\nRHS we would get other complaints (e.g.can't unify \"*\" with \"#\").\n-}\n\n-- | \"Pretty\"-print a type\npprTy :: Ty -> String\npprTy = pty\n    where\n          pty (TyF t1 t2) = pbty t1 ++ \" -> \" ++ pty t2\n          pty (TyC t1 t2) = pbty t1 ++ \" => \" ++ pty t2\n          pty t      = pbty t\n\n          pbty (TyApp tc ts) = unwords (wrapOp (show tc) : map paty ts)\n          pbty (TyUTup ts)   = \"(# \"\n                            ++ concat (intersperse \",\" (map pty ts))\n                            ++ \" #)\"\n          pbty t             = paty t\n\n          paty (TyVar tv)    = tv\n          paty t             = \"(\" ++ pty t ++ \")\"\n\n-- | Turn an identifier or operator into its prefix form\nwrapOp :: String -> String\nwrapOp nm | isAlpha (head nm) = nm\n          | otherwise         = \"(\" ++ nm ++ \")\"\n\n-- | Turn an identifer or operator into its infix form\nasInfix :: String -> String\nasInfix nm | isAlpha (head nm) = \"`\" ++ nm ++ \"`\"\n           | otherwise         = nm\n\ngen_latex_doc :: Info -> String\ngen_latex_doc (Info defaults entries)\n   = \"\\\\primopdefaults{\"\n         ++ mk_options defaults\n         ++ \"}\\n\"\n     ++ (concat (map mk_entry entries))\n     where mk_entry (PrimOpSpec {cons=constr,name=n,ty=t,cat=c,desc=d,opts=o}) =\n                 \"\\\\primopdesc{\"\n                 ++ latex_encode constr ++ \"}{\"\n                 ++ latex_encode n ++ \"}{\"\n                 ++ latex_encode (zencode n) ++ \"}{\"\n                 ++ latex_encode (show c) ++ \"}{\"\n                 ++ latex_encode (mk_source_ty t) ++ \"}{\"\n                 ++ latex_encode (mk_core_ty t) ++ \"}{\"\n                 ++ d ++ \"}{\"\n                 ++ mk_options o\n                 ++ \"}\\n\"\n           mk_entry (PrimVecOpSpec {}) =\n                 \"\"\n           mk_entry (Section {title=ti,desc=d}) =\n                 \"\\\\primopsection{\"\n                 ++ latex_encode ti ++ \"}{\"\n                 ++ d ++ \"}\\n\"\n           mk_entry (PrimTypeSpec {ty=t,desc=d,opts=o}) =\n                 \"\\\\primtypespec{\"\n                 ++ latex_encode (mk_source_ty t) ++ \"}{\"\n                 ++ latex_encode (mk_core_ty t) ++ \"}{\"\n                 ++ d ++ \"}{\"\n                 ++ mk_options o\n                 ++ \"}\\n\"\n           mk_entry (PrimVecTypeSpec {}) =\n                 \"\"\n           mk_entry (PseudoOpSpec {name=n,ty=t,desc=d,opts=o}) =\n                 \"\\\\pseudoopspec{\"\n                 ++ latex_encode (zencode n) ++ \"}{\"\n                 ++ latex_encode (mk_source_ty t) ++ \"}{\"\n                 ++ latex_encode (mk_core_ty t) ++ \"}{\"\n                 ++ d ++ \"}{\"\n                 ++ mk_options o\n                 ++ \"}\\n\"\n           mk_source_ty typ = pty typ\n             where pty (TyF t1 t2) = pbty t1 ++ \" -> \" ++ pty t2\n                   pty (TyC t1 t2) = pbty t1 ++ \" => \" ++ pty t2\n                   pty t = pbty t\n                   pbty (TyApp tc ts) = show tc ++ (concat (map (' ':) (map paty ts)))\n                   pbty (TyUTup ts) = \"(# \" ++ (concat (intersperse \",\" (map pty ts))) ++ \" #)\"\n                   pbty t = paty t\n                   paty (TyVar tv) = tv\n                   paty t = \"(\" ++ pty t ++ \")\"\n\n           mk_core_ty typ = foralls ++ (pty typ)\n             where pty (TyF t1 t2) = pbty t1 ++ \" -> \" ++ pty t2\n                   pty (TyC t1 t2) = pbty t1 ++ \" => \" ++ pty t2\n                   pty t = pbty t\n                   pbty (TyApp tc ts) = (zencode (show tc)) ++ (concat (map (' ':) (map paty ts)))\n                   pbty (TyUTup ts) = (zencode (utuplenm (length ts))) ++ (concat ((map (' ':) (map paty ts))))\n                   pbty t = paty t\n                   paty (TyVar tv) = zencode tv\n                   paty (TyApp tc []) = zencode (show tc)\n                   paty t = \"(\" ++ pty t ++ \")\"\n                   utuplenm 1 = \"(# #)\"\n                   utuplenm n = \"(#\" ++ (replicate (n-1) ',') ++ \"#)\"\n                   foralls = if tvars == [] then \"\" else \"%forall \" ++ (tbinds tvars)\n                   tvars = tvars_of typ\n                   tbinds [] = \". \"\n                   tbinds (\"o\":tbs) = \"(o::?) \" ++ (tbinds tbs)\n                   tbinds (tv:tbs) = tv ++ \" \" ++ (tbinds tbs)\n           tvars_of (TyF t1 t2) = tvars_of t1 `union` tvars_of t2\n           tvars_of (TyC t1 t2) = tvars_of t1 `union` tvars_of t2\n           tvars_of (TyApp _ ts) = foldl union [] (map tvars_of ts)\n           tvars_of (TyUTup ts) = foldr union [] (map tvars_of ts)\n           tvars_of (TyVar tv) = [tv]\n\n           mk_options o =\n             \"\\\\primoptions{\"\n              ++ mk_has_side_effects o ++ \"}{\"\n              ++ mk_out_of_line o ++ \"}{\"\n              ++ mk_commutable o ++ \"}{\"\n              ++ mk_needs_wrapper o ++ \"}{\"\n              ++ mk_can_fail o ++ \"}{\"\n              ++ mk_fixity o ++ \"}{\"\n              ++ latex_encode (mk_strictness o) ++ \"}{\"\n              ++ \"}\"\n\n           mk_has_side_effects o = mk_bool_opt o \"has_side_effects\" \"Has side effects.\" \"Has no side effects.\"\n           mk_out_of_line o = mk_bool_opt o \"out_of_line\" \"Implemented out of line.\" \"Implemented in line.\"\n           mk_commutable o = mk_bool_opt o \"commutable\" \"Commutable.\" \"Not commutable.\"\n           mk_needs_wrapper o = mk_bool_opt o \"needs_wrapper\" \"Needs wrapper.\" \"Needs no wrapper.\"\n           mk_can_fail o = mk_bool_opt o \"can_fail\" \"Can fail.\" \"Cannot fail.\"\n\n           mk_bool_opt o opt_name if_true if_false =\n             case lookup_attrib opt_name o of\n               Just (OptionTrue _) -> if_true\n               Just (OptionFalse _) -> if_false\n               Just (OptionString _ _) -> error \"String value for boolean option\"\n               Just (OptionInteger _ _) -> error \"Integer value for boolean option\"\n               Just (OptionFixity _) -> error \"Fixity value for boolean option\"\n               Just (OptionVector _) -> error \"vector template for boolean option\"\n               Nothing -> \"\"\n\n           mk_strictness o =\n             case lookup_attrib \"strictness\" o of\n               Just (OptionString _ s) -> s  -- for now\n               Just _ -> error \"Wrong value for strictness\"\n               Nothing -> \"\"\n\n           mk_fixity o = case lookup_attrib \"fixity\" o of\n             Just (OptionFixity (Just (Fixity _ i d)))\n               -> pprFixityDir d ++ \" \" ++ show i\n             _ -> \"\"\n\n           zencode xs =\n             case maybe_tuple xs of\n                Just n  -> n            -- Tuples go to Z2T etc\n                Nothing -> concat (map encode_ch xs)\n             where\n               maybe_tuple \"(# #)\" = Just(\"Z1H\")\n               maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of\n                                                (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) \"H\")\n                                                _                  -> Nothing\n               maybe_tuple \"()\" = Just(\"Z0T\")\n               maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of\n                                                (n, ')' : _) -> Just ('Z' : shows (n+1) \"T\")\n                                                _            -> Nothing\n               maybe_tuple _                 = Nothing\n\n               count_commas :: Int -> String -> (Int, String)\n               count_commas n (',' : cs) = count_commas (n+1) cs\n               count_commas n cs          = (n,cs)\n\n               unencodedChar :: Char -> Bool    -- True for chars that don't need encoding\n               unencodedChar 'Z' = False\n               unencodedChar 'z' = False\n               unencodedChar c   = isAlphaNum c\n\n               encode_ch :: Char -> String\n               encode_ch c | unencodedChar c = [c]      -- Common case first\n\n               -- Constructors\n               encode_ch '('  = \"ZL\"    -- Needed for things like (,), and (->)\n               encode_ch ')'  = \"ZR\"    -- For symmetry with (\n               encode_ch '['  = \"ZM\"\n               encode_ch ']'  = \"ZN\"\n               encode_ch ':'  = \"ZC\"\n               encode_ch 'Z'  = \"ZZ\"\n\n               -- Variables\n               encode_ch 'z'  = \"zz\"\n               encode_ch '&'  = \"za\"\n               encode_ch '|'  = \"zb\"\n               encode_ch '^'  = \"zc\"\n               encode_ch '$'  = \"zd\"\n               encode_ch '='  = \"ze\"\n               encode_ch '>'  = \"zg\"\n               encode_ch '#'  = \"zh\"\n               encode_ch '.'  = \"zi\"\n               encode_ch '<'  = \"zl\"\n               encode_ch '-'  = \"zm\"\n               encode_ch '!'  = \"zn\"\n               encode_ch '+'  = \"zp\"\n               encode_ch '\\'' = \"zq\"\n               encode_ch '\\\\' = \"zr\"\n               encode_ch '/'  = \"zs\"\n               encode_ch '*'  = \"zt\"\n               encode_ch '_'  = \"zu\"\n               encode_ch '%'  = \"zv\"\n               encode_ch c    = 'z' : shows (ord c) \"U\"\n\n           latex_encode [] = []\n           latex_encode (c:cs) | c `elem` \"#$%&_^{}\" = \"\\\\\" ++ c:(latex_encode cs)\n           latex_encode ('~':cs) = \"\\\\verb!~!\" ++ (latex_encode cs)\n           latex_encode ('\\\\':cs) = \"$\\\\backslash$\" ++ (latex_encode cs)\n           latex_encode (c:cs) = c:(latex_encode cs)\n\ngen_wrappers :: Info -> String\ngen_wrappers (Info _ entries)\n   =    \"{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples #-}\\n\"\n        -- Dependencies on Prelude must be explicit in libraries/base, but we\n        -- don't need the Prelude here so we add NoImplicitPrelude.\n     ++ \"{-# OPTIONS_GHC -Wno-deprecations #-}\\n\"\n     ++ \"module GHC.PrimopWrappers where\\n\"\n     ++ \"import qualified GHC.Prim\\n\"\n     ++ \"import GHC.Tuple ()\\n\"\n     ++ \"import GHC.Prim (\" ++ types ++ \")\\n\"\n     ++ unlines (concatMap f specs)\n     where\n        specs = filter (not.dodgy) $\n                filter (not.is_llvm_only) $\n                filter is_primop entries\n        tycons = foldr union [] $ map (tyconsIn . ty) specs\n        tycons' = filter (`notElem` [TyCon \"()\", TyCon \"Bool\"]) tycons\n        types = concat $ intersperse \", \" $ map show tycons'\n        f spec = let args = map (\\n -> \"a\" ++ show n) [1 .. arity (ty spec)]\n                     src_name = wrap (name spec)\n                     lhs = src_name ++ \" \" ++ unwords args\n                     rhs = \"(GHC.Prim.\" ++ name spec ++ \") \" ++ unwords args\n                 in [\"{-# NOINLINE \" ++ src_name ++ \" #-}\",\n                     src_name ++ \" :: \" ++ pprTy (ty spec),\n                     lhs ++ \" = \" ++ rhs]\n        wrap nm | isLower (head nm) = nm\n                | otherwise = \"(\" ++ nm ++ \")\"\n\n        dodgy spec\n           = name spec `elem`\n             [-- tagToEnum# is really magical, and can't have\n              -- a wrapper since its implementation depends on\n              -- the type of its result\n              \"tagToEnum#\"\n             ]\n\n        is_llvm_only :: Entry -> Bool\n        is_llvm_only entry =\n            case lookup_attrib \"llvm_only\" (opts entry) of\n              Just (OptionTrue _) -> True\n              _                   -> False\n\ngen_primop_list :: Info -> String\ngen_primop_list (Info _ entries)\n   = unlines (\n        [      \"   [\" ++ cons first       ]\n        ++\n        map (\\p -> \"   , \" ++ cons p) rest\n        ++\n        [     \"   ]\"     ]\n     ) where (first:rest) = concatMap desugarVectorSpec (filter is_primop entries)\n\nmIN_VECTOR_UNIQUE :: Int\nmIN_VECTOR_UNIQUE = 300\n\ngen_primop_vector_uniques :: Info -> String\ngen_primop_vector_uniques (Info _ entries)\n   = unlines $\n     concatMap mkVecUnique (specs `zip` [mIN_VECTOR_UNIQUE..])\n  where\n    specs = concatMap desugarVectorSpec (filter is_vector (filter is_primtype entries))\n\n    mkVecUnique :: (Entry, Int) -> [String]\n    mkVecUnique (i, unique) =\n        [ key_id ++ \" :: Unique\"\n        , key_id ++ \" = mkPreludeTyConUnique \" ++ show unique\n        ]\n      where\n        key_id = prefix i ++ \"PrimTyConKey\"\n\ngen_primop_vector_tys :: Info -> String\ngen_primop_vector_tys (Info _ entries)\n   = unlines $\n     concatMap mkVecTypes specs\n  where\n    specs = concatMap desugarVectorSpec (filter is_vector (filter is_primtype entries))\n\n    mkVecTypes :: Entry -> [String]\n    mkVecTypes i =\n        [ name_id ++ \" :: Name\"\n        , name_id ++ \" = mkPrimTc (fsLit \\\"\" ++ pprTy (ty i) ++ \"\\\") \" ++ key_id ++ \" \" ++ tycon_id\n        , ty_id ++ \" :: Type\"\n        , ty_id ++ \" = mkTyConTy \" ++ tycon_id\n        , tycon_id ++ \" :: TyCon\"\n        , tycon_id ++ \" = pcPrimTyCon0 \" ++ name_id ++\n                      \" (VecRep \" ++ show (veclen i) ++ \" \" ++ elemrep i ++ \")\"\n        ]\n      where\n        key_id   = prefix i ++ \"PrimTyConKey\"\n        name_id  = prefix i ++ \"PrimTyConName\"\n        ty_id    = prefix i ++ \"PrimTy\"\n        tycon_id = prefix i ++ \"PrimTyCon\"\n\ngen_primop_vector_tys_exports :: Info -> String\ngen_primop_vector_tys_exports (Info _ entries)\n   = unlines $\n    map mkVecTypes specs\n  where\n    specs = concatMap desugarVectorSpec (filter is_vector (filter is_primtype entries))\n\n    mkVecTypes :: Entry -> String\n    mkVecTypes i =\n        \"        \" ++ ty_id ++ \", \" ++ tycon_id ++ \",\"\n      where\n        ty_id    = prefix i ++ \"PrimTy\"\n        tycon_id = prefix i ++ \"PrimTyCon\"\n\ngen_primop_vector_tycons :: Info -> String\ngen_primop_vector_tycons (Info _ entries)\n   = unlines $\n     map mkVecTypes specs\n  where\n    specs = concatMap desugarVectorSpec (filter is_vector (filter is_primtype entries))\n\n    mkVecTypes :: Entry -> String\n    mkVecTypes i =\n        \"    , \" ++ tycon_id\n      where\n        tycon_id = prefix i ++ \"PrimTyCon\"\n\ngen_primop_tag :: Info -> String\ngen_primop_tag (Info _ entries)\n   = unlines (max_def_type : max_def :\n              tagOf_type : zipWith f primop_entries [1 :: Int ..])\n     where\n        primop_entries = concatMap desugarVectorSpec $ filter is_primop entries\n        tagOf_type = \"primOpTag :: PrimOp -> Int\"\n        f i n = \"primOpTag \" ++ cons i ++ \" = \" ++ show n\n        max_def_type = \"maxPrimOpTag :: Int\"\n        max_def      = \"maxPrimOpTag = \" ++ show (length primop_entries)\n\ngen_data_decl :: Info -> String\ngen_data_decl (Info _ entries) =\n    \"data PrimOp\\n   = \" ++ head conss ++ \"\\n\"\n     ++ unlines (map (\"   | \"++) (tail conss))\n  where\n    conss = map genCons (filter is_primop entries)\n\n    genCons :: Entry -> String\n    genCons entry =\n        case vecOptions entry of\n          [] -> cons entry\n          _  -> cons entry ++ \" PrimOpVecCat Length Width\"\n\ngen_switch_from_attribs :: String -> String -> Info -> String\ngen_switch_from_attribs attrib_name fn_name (Info defaults entries)\n   = let defv = lookup_attrib attrib_name defaults\n         alternatives = catMaybes (map mkAlt (filter is_primop entries))\n\n         getAltRhs (OptionFalse _)    = \"False\"\n         getAltRhs (OptionTrue _)     = \"True\"\n         getAltRhs (OptionInteger _ i) = show i\n         getAltRhs (OptionString _ s) = s\n         getAltRhs (OptionVector _) = \"True\"\n         getAltRhs (OptionFixity mf) = show mf\n\n         mkAlt po\n            = case lookup_attrib attrib_name (opts po) of\n                 Nothing -> Nothing\n                 Just xx -> case vecOptions po of\n                              [] -> Just (fn_name ++ \" \" ++ cons po ++ \" = \" ++ getAltRhs xx)\n                              _  -> Just (fn_name ++ \" (\" ++ cons po ++ \" _ _ _) = \" ++ getAltRhs xx)\n\n     in\n         case defv of\n            Nothing -> error (\"gen_switch_from: \" ++ attrib_name)\n            Just xx\n               -> unlines alternatives\n                  ++ fn_name ++ \" _ = \" ++ getAltRhs xx ++ \"\\n\"\n\n------------------------------------------------------------------\n-- Create PrimOpInfo text from PrimOpSpecs -----------------------\n------------------------------------------------------------------\n\ngen_primop_info :: Info -> String\ngen_primop_info (Info _ entries)\n   = unlines (map mkPOItext (concatMap desugarVectorSpec (filter is_primop entries)))\n\nmkPOItext :: Entry -> String\nmkPOItext i = mkPOI_LHS_text i ++ mkPOI_RHS_text i\n\nmkPOI_LHS_text :: Entry -> String\nmkPOI_LHS_text i\n   = \"primOpInfo \" ++ cons i ++ \" = \"\n\nmkPOI_RHS_text :: Entry -> String\nmkPOI_RHS_text i\n   = case cat i of\n        Compare\n           -> case ty i of\n                 TyF t1 (TyF _ _)\n                    -> \"mkCompare \" ++ sl_name i ++ ppType t1\n                 _ -> error \"Type error in comparison op\"\n        Monadic\n           -> case ty i of\n                 TyF t1 _\n                    -> \"mkMonadic \" ++ sl_name i ++ ppType t1\n                 _ -> error \"Type error in monadic op\"\n        Dyadic\n           -> case ty i of\n                 TyF t1 (TyF _ _)\n                    -> \"mkDyadic \" ++ sl_name i ++ ppType t1\n                 _ -> error \"Type error in dyadic op\"\n        GenPrimOp\n           -> let (argTys, resTy) = flatTys (ty i)\n                  tvs = nub (tvsIn (ty i))\n              in\n                  \"mkGenPrimOp \" ++ sl_name i ++ \" \"\n                      ++ listify (map ppTyVar tvs) ++ \" \"\n                      ++ listify (map ppType argTys) ++ \" \"\n                      ++ \"(\" ++ ppType resTy ++ \")\"\n\nsl_name :: Entry -> String\nsl_name i = \"(fsLit \\\"\" ++ name i ++ \"\\\") \"\n\nppTyVar :: String -> String\nppTyVar \"a\" = \"alphaTyVar\"\nppTyVar \"b\" = \"betaTyVar\"\nppTyVar \"c\" = \"gammaTyVar\"\nppTyVar \"s\" = \"deltaTyVar\"\nppTyVar \"o\" = \"runtimeRep1TyVar, openAlphaTyVar\"\nppTyVar _   = error \"Unknown type var\"\n\nppType :: Ty -> String\nppType (TyApp (TyCon \"Any\")         []) = \"anyTy\"\nppType (TyApp (TyCon \"Bool\")        []) = \"boolTy\"\n\nppType (TyApp (TyCon \"Int#\")        []) = \"intPrimTy\"\nppType (TyApp (TyCon \"Int8#\")       []) = \"int8PrimTy\"\nppType (TyApp (TyCon \"Int16#\")      []) = \"int16PrimTy\"\nppType (TyApp (TyCon \"Int32#\")      []) = \"int32PrimTy\"\nppType (TyApp (TyCon \"Int64#\")      []) = \"int64PrimTy\"\nppType (TyApp (TyCon \"Char#\")       []) = \"charPrimTy\"\nppType (TyApp (TyCon \"Word#\")       []) = \"wordPrimTy\"\nppType (TyApp (TyCon \"Word8#\")      []) = \"word8PrimTy\"\nppType (TyApp (TyCon \"Word16#\")     []) = \"word16PrimTy\"\nppType (TyApp (TyCon \"Word32#\")     []) = \"word32PrimTy\"\nppType (TyApp (TyCon \"Word64#\")     []) = \"word64PrimTy\"\nppType (TyApp (TyCon \"Addr#\")       []) = \"addrPrimTy\"\nppType (TyApp (TyCon \"Float#\")      []) = \"floatPrimTy\"\nppType (TyApp (TyCon \"Double#\")     []) = \"doublePrimTy\"\nppType (TyApp (TyCon \"ByteArray#\")  []) = \"byteArrayPrimTy\"\nppType (TyApp (TyCon \"RealWorld\")   []) = \"realWorldTy\"\nppType (TyApp (TyCon \"ThreadId#\")   []) = \"threadIdPrimTy\"\nppType (TyApp (TyCon \"ForeignObj#\") []) = \"foreignObjPrimTy\"\nppType (TyApp (TyCon \"BCO#\")        []) = \"bcoPrimTy\"\nppType (TyApp (TyCon \"Compact#\")    []) = \"compactPrimTy\"\nppType (TyApp (TyCon \"()\")          []) = \"unitTy\"      -- unitTy is TysWiredIn's name for ()\n\nppType (TyVar \"a\")                      = \"alphaTy\"\nppType (TyVar \"b\")                      = \"betaTy\"\nppType (TyVar \"c\")                      = \"gammaTy\"\nppType (TyVar \"s\")                      = \"deltaTy\"\nppType (TyVar \"o\")                      = \"openAlphaTy\"\n\nppType (TyApp (TyCon \"State#\") [x])             = \"mkStatePrimTy \" ++ ppType x\nppType (TyApp (TyCon \"MutVar#\") [x,y])          = \"mkMutVarPrimTy \" ++ ppType x\n                                                   ++ \" \" ++ ppType y\nppType (TyApp (TyCon \"MutableArray#\") [x,y])    = \"mkMutableArrayPrimTy \" ++ ppType x\n                                                   ++ \" \" ++ ppType y\nppType (TyApp (TyCon \"MutableArrayArray#\") [x]) = \"mkMutableArrayArrayPrimTy \" ++ ppType x\nppType (TyApp (TyCon \"SmallMutableArray#\") [x,y]) = \"mkSmallMutableArrayPrimTy \" ++ ppType x\n                                                    ++ \" \" ++ ppType y\nppType (TyApp (TyCon \"MutableByteArray#\") [x])  = \"mkMutableByteArrayPrimTy \"\n                                                   ++ ppType x\nppType (TyApp (TyCon \"Array#\") [x])             = \"mkArrayPrimTy \" ++ ppType x\nppType (TyApp (TyCon \"ArrayArray#\") [])         = \"mkArrayArrayPrimTy\"\nppType (TyApp (TyCon \"SmallArray#\") [x])        = \"mkSmallArrayPrimTy \" ++ ppType x\n\n\nppType (TyApp (TyCon \"Weak#\")       [x]) = \"mkWeakPrimTy \" ++ ppType x\nppType (TyApp (TyCon \"StablePtr#\")  [x]) = \"mkStablePtrPrimTy \" ++ ppType x\nppType (TyApp (TyCon \"StableName#\") [x]) = \"mkStableNamePrimTy \" ++ ppType x\n\nppType (TyApp (TyCon \"MVar#\") [x,y])     = \"mkMVarPrimTy \" ++ ppType x\n                                           ++ \" \" ++ ppType y\nppType (TyApp (TyCon \"TVar#\") [x,y])     = \"mkTVarPrimTy \" ++ ppType x\n                                           ++ \" \" ++ ppType y\n\nppType (TyApp (VecTyCon _ pptc) [])      = pptc\n\nppType (TyUTup ts) = \"(mkTupleTy Unboxed \"\n                     ++ listify (map ppType ts) ++ \")\"\n\nppType (TyF s d) = \"(mkVisFunTy (\" ++ ppType s ++ \") (\" ++ ppType d ++ \"))\"\nppType (TyC s d) = \"(mkInvisFunTy (\" ++ ppType s ++ \") (\" ++ ppType d ++ \"))\"\n\nppType other\n   = error (\"ppType: can't handle: \" ++ show other ++ \"\\n\")\n\npprFixityDir :: FixityDirection -> String\npprFixityDir InfixN = \"infix\"\npprFixityDir InfixL = \"infixl\"\npprFixityDir InfixR = \"infixr\"\n\nlistify :: [String] -> String\nlistify ss = \"[\" ++ concat (intersperse \", \" ss) ++ \"]\"\n\nflatTys :: Ty -> ([Ty],Ty)\nflatTys (TyF t1 t2) = case flatTys t2 of (ts,t) -> (t1:ts,t)\nflatTys (TyC t1 t2) = case flatTys t2 of (ts,t) -> (t1:ts,t)\nflatTys other       = ([],other)\n\ntvsIn :: Ty -> [TyVar]\ntvsIn (TyF t1 t2)    = tvsIn t1 ++ tvsIn t2\ntvsIn (TyC t1 t2)    = tvsIn t1 ++ tvsIn t2\ntvsIn (TyApp _ tys)  = concatMap tvsIn tys\ntvsIn (TyVar tv)     = [tv]\ntvsIn (TyUTup tys)   = concatMap tvsIn tys\n\ntyconsIn :: Ty -> [TyCon]\ntyconsIn (TyF t1 t2)    = tyconsIn t1 `union` tyconsIn t2\ntyconsIn (TyC t1 t2)    = tyconsIn t1 `union` tyconsIn t2\ntyconsIn (TyApp tc tys) = foldr union [tc] $ map tyconsIn tys\ntyconsIn (TyVar _)      = []\ntyconsIn (TyUTup tys)   = foldr union [] $ map tyconsIn tys\n\narity :: Ty -> Int\narity = length . fst . flatTys\n", "num_lines": 928}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ParserM (\n    -- Parser Monad\n    ParserM(..), AlexInput, run_parser,\n    -- Parser state\n    St,\n    StartCode, start_code, set_start_code,\n    inc_brace_depth, dec_brace_depth,\n    -- Tokens\n    Token(..),\n    -- Actions\n    Action, andBegin, mkT, mkTv,\n    -- Positions\n    get_pos, show_pos,\n    -- Input\n    alexGetChar, alexGetByte, alexInputPrevChar, input, position,\n    -- Other\n    happyError\n ) where\n\nimport Control.Applicative\nimport Prelude\n\nimport Control.Monad (ap, liftM)\nimport Data.Word (Word8)\nimport Data.Char (ord)\n\n-- Parser Monad\nnewtype ParserM a = ParserM (AlexInput -> St -> Either String (AlexInput, St, a))\n\ninstance Functor ParserM where\n  fmap = liftM\n\ninstance Applicative ParserM where\n  pure  = return\n  (<*>) = ap\n\ninstance Monad ParserM where\n    ParserM m >>= k = ParserM $ \\i s -> case m i s of\n                                            Right (i', s', x) ->\n                                                case k x of\n                                                    ParserM y -> y i' s'\n                                            Left err ->\n                                                Left err\n    return a = ParserM $ \\i s -> Right (i, s, a)\n    fail err = ParserM $ \\_ _ -> Left err\n\nrun_parser :: ParserM a -> (String -> Either String a)\nrun_parser (ParserM f)\n = \\s -> case f (AlexInput init_pos s) init_state of\n             Left es -> Left es\n             Right (_, _, x) -> Right x\n\n-- Parser state\n\ndata St = St {\n              start_code :: !StartCode,\n              brace_depth :: !Int\n          }\n    deriving Show\ntype StartCode = Int\n\ninit_state :: St\ninit_state = St {\n                 start_code = 0,\n                 brace_depth = 0\n             }\n\n-- Tokens\n\ndata Token = TEOF\n           | TArrow\n           | TDArrow\n           | TEquals\n           | TComma\n           | TOpenParen\n           | TCloseParen\n           | TOpenParenHash\n           | THashCloseParen\n           | TOpenBrace\n           | TCloseBrace\n           | TOpenBracket\n           | TCloseBracket\n           | TOpenAngle\n           | TCloseAngle\n           | TSection\n           | TPrimop\n           | TPseudoop\n           | TPrimtype\n           | TWith\n           | TDefaults\n           | TTrue\n           | TFalse\n           | TDyadic\n           | TMonadic\n           | TCompare\n           | TGenPrimOp\n           | TThatsAllFolks\n           | TLowerName String\n           | TUpperName String\n           | TString String\n           | TNoBraces String\n           | TInteger Int\n           | TFixity\n           | TInfixN\n           | TInfixL\n           | TInfixR\n           | TNothing\n           | TVector\n           | TSCALAR\n           | TVECTOR\n           | TVECTUPLE\n    deriving Show\n\n-- Actions\n\ntype Action = String -> ParserM Token\n\nset_start_code :: StartCode -> ParserM ()\nset_start_code sc = ParserM $ \\i st -> Right (i, st { start_code = sc }, ())\n\ninc_brace_depth :: ParserM ()\ninc_brace_depth = ParserM $ \\i st ->\n                  Right (i, st { brace_depth = brace_depth st + 1 }, ())\n\ndec_brace_depth :: ParserM ()\ndec_brace_depth = ParserM $ \\i st ->\n                  let bd = brace_depth st - 1\n                      sc = if bd == 0 then 0 else 1\n                  in Right (i, st { brace_depth = bd, start_code = sc }, ())\n\nandBegin :: Action -> StartCode -> Action\n(act `andBegin` sc) x = do set_start_code sc\n                           act x\n\nmkT :: Token -> Action\nmkT t = mkTv (const t)\n\nmkTv :: (String -> Token) -> Action\nmkTv f str = ParserM (\\i st -> Right (i, st, f str))\n\n-- Positions\n\ndata Pos = Pos !Int{- Line -} !Int{- Column -}\n\nget_pos :: ParserM Pos\nget_pos = ParserM $ \\i@(AlexInput p _) st -> Right (i, st, p)\n\nalexMove :: Pos -> Char -> Pos\nalexMove (Pos l _) '\\n' = Pos (l+1) 1\nalexMove (Pos l c) '\\t' = Pos l ((c+8) `div` 8 * 8)\nalexMove (Pos l c) _    = Pos l (c+1)\n\ninit_pos :: Pos\ninit_pos = Pos 1 1\n\nshow_pos :: Pos -> String\nshow_pos (Pos l c) = \"line \" ++ show l ++ \", column \" ++ show c\n\n-- Input\n\ndata AlexInput = AlexInput {position :: !Pos, input :: String}\n\n-- alexGetByte is for Alex >= 3.0, alexGetChar for earlier\n-- XXX no UTF-8; we should do this properly sometime\nalexGetByte :: AlexInput -> Maybe (Word8,AlexInput)\nalexGetByte (AlexInput p (x:xs)) = Just (fromIntegral (ord x),\n                                         AlexInput (alexMove p x) xs)\nalexGetByte (AlexInput _ []) = Nothing\n\nalexGetChar :: AlexInput -> Maybe (Char,AlexInput)\nalexGetChar (AlexInput p (x:xs)) = Just (x, AlexInput (alexMove p x) xs)\nalexGetChar (AlexInput _ []) = Nothing\n\nalexInputPrevChar :: AlexInput -> Char\nalexInputPrevChar _ = error \"Lexer doesn't implement alexInputPrevChar\"\n\nhappyError :: ParserM a\nhappyError = do p <- get_pos\n                fail $ \"Parse error at \" ++ show_pos p\n\n", "num_lines": 181}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Syntax where\n\nimport Data.List\n\n------------------------------------------------------------------\n-- Abstract syntax -----------------------------------------------\n------------------------------------------------------------------\n\n-- info for all primops; the totality of the info in primops.txt(.pp)\ndata Info\n   = Info [Option] [Entry]   -- defaults, primops\n     deriving Show\n\n-- info for one primop\ndata Entry\n    = PrimOpSpec { cons  :: String,      -- PrimOp name\n                   name  :: String,      -- name in prog text\n                   ty    :: Ty,          -- type\n                   cat   :: Category,    -- category\n                   desc  :: String,      -- description\n                   opts  :: [Option] }   -- default overrides\n    | PrimVecOpSpec { cons    :: String,    -- PrimOp name\n                      name    :: String,    -- name in prog text\n                      prefix  :: String,    -- prefix for generated names\n                      veclen  :: Int,       -- vector length\n                      elemrep :: String,    -- vector ElemRep\n                      ty      :: Ty,        -- type\n                      cat     :: Category,  -- category\n                      desc    :: String,    -- description\n                      opts    :: [Option] } -- default overrides\n    | PseudoOpSpec { name  :: String,      -- name in prog text\n                     ty    :: Ty,          -- type\n                     desc  :: String,      -- description\n                     opts  :: [Option] }   -- default overrides\n    | PrimTypeSpec { ty    :: Ty,      -- name in prog text\n                     desc  :: String,      -- description\n                     opts  :: [Option] }   -- default overrides\n    | PrimVecTypeSpec { ty    :: Ty,      -- name in prog text\n                        prefix  :: String,    -- prefix for generated names\n                        veclen  :: Int,       -- vector length\n                        elemrep :: String,    -- vector ElemRep\n                        desc  :: String,      -- description\n                        opts  :: [Option] }   -- default overrides\n    | Section { title :: String,         -- section title\n                desc  :: String }        -- description\n    deriving Show\n\nis_primop :: Entry -> Bool\nis_primop (PrimOpSpec _ _ _ _ _ _) = True\nis_primop _ = False\n\nis_primtype :: Entry -> Bool\nis_primtype (PrimTypeSpec {}) = True\nis_primtype _ = False\n\n-- a binding of property to value\ndata Option\n   = OptionFalse  String          -- name = False\n   | OptionTrue   String          -- name = True\n   | OptionString String String   -- name = { ... unparsed stuff ... }\n   | OptionInteger String Int     -- name = <int>\n   | OptionVector [(String,String,Int)]  -- name = [(,...),...]\n   | OptionFixity (Maybe Fixity)  -- fixity = infix{,l,r} <int> | Nothing\n     deriving Show\n\n-- categorises primops\ndata Category\n   = Dyadic | Monadic | Compare | GenPrimOp\n     deriving Show\n\n-- types\ndata Ty\n   = TyF    Ty Ty\n   | TyC    Ty Ty -- We only allow one constraint, keeps the grammar simpler\n   | TyApp  TyCon [Ty]\n   | TyVar  TyVar\n   | TyUTup [Ty]   -- unboxed tuples; just a TyCon really, \n                   -- but convenient like this\n   deriving (Eq,Show)\n\ntype TyVar = String\n\ndata TyCon = TyCon String\n           | SCALAR\n           | VECTOR\n           | VECTUPLE\n           | VecTyCon String String\n  deriving (Eq, Ord)\n\ninstance Show TyCon where\n    show (TyCon tc)      = tc\n    show SCALAR          = \"SCALAR\"\n    show VECTOR          = \"VECTOR\"\n    show VECTUPLE        = \"VECTUPLE\"\n    show (VecTyCon tc _) = tc\n\n-- Follow definitions of Fixity and FixityDirection in GHC\n\n-- The SourceText exists so that it matches the SourceText field in\n-- BasicTypes.Fixity\ndata Fixity = Fixity SourceText Int FixityDirection\n  deriving (Eq, Show)\n\ndata FixityDirection = InfixN | InfixL | InfixR\n  deriving (Eq, Show)\n\ndata SourceText = SourceText String\n                | NoSourceText\n                deriving (Eq,Show)\n\n------------------------------------------------------------------\n-- Sanity checking -----------------------------------------------\n------------------------------------------------------------------\n\n{- Do some simple sanity checks:\n    * all the default field names are unique\n    * for each PrimOpSpec, all override field names are unique\n    * for each PrimOpSpec, all overriden field names   \n          have a corresponding default value\n    * that primop types correspond in certain ways to the \n      Category: eg if Comparison, the type must be of the form\n         T -> T -> Bool.\n   Dies with \"error\" if there's a problem, else returns ().\n-}\nmyseqAll :: [()] -> a -> a\nmyseqAll (():ys) x = myseqAll ys x\nmyseqAll []      x = x\n\nsanityTop :: Info -> ()\nsanityTop (Info defs entries)\n   = let opt_names = map get_attrib_name defs\n         primops = filter is_primop entries\n     in  \n     if   length opt_names /= length (nub opt_names)\n     then error (\"non-unique default attribute names: \" ++ show opt_names ++ \"\\n\")\n     else myseqAll (map (sanityPrimOp opt_names) primops) ()\n\nsanityPrimOp :: [String] -> Entry -> ()\nsanityPrimOp def_names p\n   = let p_names = map get_attrib_name (opts p)\n         p_names_ok\n            = length p_names == length (nub p_names)\n              && all (`elem` def_names) p_names\n         ty_ok = sane_ty (cat p) (ty p)\n     in\n         if   not p_names_ok\n         then error (\"attribute names are non-unique or have no default in\\n\" ++\n                     \"info for primop \" ++ cons p ++ \"\\n\")\n         else\n         if   not ty_ok\n         then error (\"type of primop \" ++ cons p ++ \" doesn't make sense w.r.t\" ++\n                     \" category \" ++ show (cat p) ++ \"\\n\")\n         else ()\n\nsane_ty :: Category -> Ty -> Bool\nsane_ty Compare (TyF t1 (TyF t2 td)) \n   | t1 == t2 && td == TyApp (TyCon \"Int#\") []  = True\nsane_ty Monadic (TyF t1 td) \n   | t1 == td  = True\nsane_ty Dyadic (TyF t1 (TyF t2 td))\n   | t1 == td && t2 == td  = True\nsane_ty GenPrimOp _\n   = True\nsane_ty _ _\n   = False\n\nget_attrib_name :: Option -> String\nget_attrib_name (OptionFalse nm) = nm\nget_attrib_name (OptionTrue nm)  = nm\nget_attrib_name (OptionString nm _) = nm\nget_attrib_name (OptionInteger nm _) = nm\nget_attrib_name (OptionVector _) = \"vector\"\nget_attrib_name (OptionFixity _) = \"fixity\"\n\nlookup_attrib :: String -> [Option] -> Maybe Option\nlookup_attrib _ [] = Nothing\nlookup_attrib nm (a:as) \n    = if get_attrib_name a == nm then Just a else lookup_attrib nm as\n\nis_vector :: Entry -> Bool\nis_vector i = case lookup_attrib \"vector\" (opts i) of\n                Nothing -> False\n                _       -> True\n", "num_lines": 184}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}\n\nmodule Main (main) where\n\nimport qualified Distribution.ModuleName as ModuleName\nimport Distribution.PackageDescription\nimport Distribution.PackageDescription.Check hiding (doesFileExist)\nimport Distribution.PackageDescription.Configuration\nimport Distribution.PackageDescription.Parsec\nimport Distribution.Package\nimport Distribution.Simple\nimport Distribution.Simple.Configure\nimport Distribution.Simple.LocalBuildInfo\nimport Distribution.Simple.GHC\nimport Distribution.Simple.Program\nimport Distribution.Simple.Program.HcPkg\nimport Distribution.Simple.Setup (ConfigFlags(configStripLibs), fromFlag, toFlag)\nimport Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, writeFileAtomic,\n                                  toUTF8LBS)\nimport Distribution.Simple.Build (writeAutogenFiles)\nimport Distribution.Simple.Register\nimport Distribution.Text\nimport Distribution.Types.MungedPackageId\nimport Distribution.Verbosity\nimport qualified Distribution.InstalledPackageInfo as Installed\nimport qualified Distribution.Simple.PackageIndex as PackageIndex\n\nimport Control.Exception (bracket)\nimport Control.Monad\nimport Control.Applicative ((<|>))\nimport Data.List\nimport Data.Maybe\nimport System.IO\nimport System.Directory (setCurrentDirectory, getCurrentDirectory, doesFileExist)\nimport System.Environment\nimport System.Exit      (exitWith, ExitCode(..))\nimport System.FilePath\n\nmain :: IO ()\nmain = do hSetBuffering stdout LineBuffering\n          args <- getArgs\n          case args of\n              \"hscolour\" : dir : distDir : args' ->\n                  runHsColour dir distDir args'\n              \"check\" : dir : [] ->\n                  doCheck dir\n              \"copy\" : dir : distDir\n                     : strip : myDestDir : myPrefix : myLibdir : myDocdir\n                     : ghcLibWays : args' ->\n                  doCopy dir distDir\n                         strip myDestDir myPrefix myLibdir myDocdir\n                         (\"dyn\" `elem` words ghcLibWays)\n                         args'\n              \"register\" : dir : distDir : ghc : ghcpkg : topdir\n                         : myDestDir : myPrefix : myLibdir : myDocdir\n                         : relocatableBuild : args' ->\n                  doRegister dir distDir ghc ghcpkg topdir\n                             myDestDir myPrefix myLibdir myDocdir\n                             relocatableBuild args'\n              \"configure\" : dir : distDir : config_args ->\n                  generate dir distDir config_args\n              \"sdist\" : dir : distDir : [] ->\n                  doSdist dir distDir\n              [\"--version\"] ->\n                  defaultMainArgs [\"--version\"]\n              _ -> die syntax_error\n\nsyntax_error :: [String]\nsyntax_error =\n    [\"syntax: ghc-cabal configure <directory> <distdir> <args>...\",\n     \"        ghc-cabal copy <directory> <distdir> <strip> <destdir> <prefix> <libdir> <docdir> <libways> <args>...\",\n     \"        ghc-cabal register <directory> <distdir> <ghc> <ghcpkg> <topdir> <destdir> <prefix> <libdir> <docdir> <relocatable> <args>...\",\n     \"        ghc-cabal hscolour <directory> <distdir> <args>...\",\n     \"        ghc-cabal check <directory>\",\n     \"        ghc-cabal sdist <directory> <distdir>\",\n     \"        ghc-cabal --version\"]\n\ndie :: [String] -> IO a\ndie errs = do mapM_ (hPutStrLn stderr) errs\n              exitWith (ExitFailure 1)\n\nwithCurrentDirectory :: FilePath -> IO a -> IO a\nwithCurrentDirectory directory io\n = bracket (getCurrentDirectory) (setCurrentDirectory)\n           (const (setCurrentDirectory directory >> io))\n\n-- We need to use the autoconfUserHooks, as the packages that use\n-- configure can create a .buildinfo file, and we need any info that\n-- ends up in it.\nuserHooks :: UserHooks\nuserHooks = autoconfUserHooks\n\nrunDefaultMain :: IO ()\nrunDefaultMain\n = do let verbosity = normal\n      gpdFile <- defaultPackageDesc verbosity\n      gpd <- readGenericPackageDescription verbosity gpdFile\n      case buildType (flattenPackageDescription gpd) of\n          Configure -> defaultMainWithHooks autoconfUserHooks\n          -- time has a \"Custom\" Setup.hs, but it's actually Configure\n          -- plus a \"./Setup test\" hook. However, Cabal is also\n          -- \"Custom\", but doesn't have a configure script.\n          Custom ->\n              do configureExists <- doesFileExist \"configure\"\n                 if configureExists\n                     then defaultMainWithHooks autoconfUserHooks\n                     else defaultMain\n          -- not quite right, but good enough for us:\n          _ -> defaultMain\n\ndoSdist :: FilePath -> FilePath -> IO ()\ndoSdist directory distDir\n = withCurrentDirectory directory\n $ withArgs ([\"sdist\", \"--builddir\", distDir])\n            runDefaultMain\n\ndoCheck :: FilePath -> IO ()\ndoCheck directory\n = withCurrentDirectory directory\n $ do let verbosity = normal\n      gpdFile <- defaultPackageDesc verbosity\n      gpd <- readGenericPackageDescription verbosity gpdFile\n      case filter isFailure $ checkPackage gpd Nothing of\n          []   -> return ()\n          errs -> mapM_ print errs >> exitWith (ExitFailure 1)\n    where isFailure (PackageDistSuspicious {}) = False\n          isFailure (PackageDistSuspiciousWarn {}) = False\n          isFailure _ = True\n\nrunHsColour :: FilePath -> FilePath -> [String] -> IO ()\nrunHsColour directory distdir args\n = withCurrentDirectory directory\n $ defaultMainArgs (\"hscolour\" : \"--builddir\" : distdir : args)\n\ndoCopy :: FilePath -> FilePath\n       -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> Bool\n       -> [String]\n       -> IO ()\ndoCopy directory distDir\n       strip myDestDir myPrefix myLibdir myDocdir withSharedLibs\n       args\n = withCurrentDirectory directory $ do\n     let copyArgs = [\"copy\", \"--builddir\", distDir]\n                 ++ (if null myDestDir\n                     then []\n                     else [\"--destdir\", myDestDir])\n                 ++ args\n         copyHooks = userHooks {\n                         copyHook = modHook False\n                                  $ copyHook userHooks\n                     }\n\n     defaultMainWithHooksArgs copyHooks copyArgs\n    where\n      modHook relocatableBuild f pd lbi us flags\n       = do let verbosity = normal\n                idts = updateInstallDirTemplates relocatableBuild\n                                                 myPrefix myLibdir myDocdir\n                                                 (installDirTemplates lbi)\n                progs = withPrograms lbi\n                stripProgram' = stripProgram {\n                    programFindLocation = \\_ _ -> return (Just (strip,[])) }\n\n            progs' <- configureProgram verbosity stripProgram' progs\n            let lbi' = lbi {\n                               withPrograms = progs',\n                               installDirTemplates = idts,\n                               configFlags = cfg,\n                               stripLibs = fromFlag (configStripLibs cfg),\n                               withSharedLib = withSharedLibs\n                           }\n\n                -- This hack allows to interpret the \"strip\"\n                -- command-line argument being set to ':' to signify\n                -- disabled library stripping\n                cfg | strip == \":\" = (configFlags lbi) { configStripLibs = toFlag False }\n                    | otherwise    = configFlags lbi\n\n            f pd lbi' us flags\n\ndoRegister :: FilePath -> FilePath -> FilePath -> FilePath\n           -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath\n           -> String -> [String]\n           -> IO ()\ndoRegister directory distDir ghc ghcpkg topdir\n           myDestDir myPrefix myLibdir myDocdir\n           relocatableBuildStr args\n = withCurrentDirectory directory $ do\n     relocatableBuild <- case relocatableBuildStr of\n                         \"YES\" -> return True\n                         \"NO\"  -> return False\n                         _ -> die [\"Bad relocatableBuildStr: \" ++\n                                   show relocatableBuildStr]\n     let regArgs = \"register\" : \"--builddir\" : distDir : args\n         regHooks = userHooks {\n                        regHook = modHook relocatableBuild\n                                $ regHook userHooks\n                    }\n\n     defaultMainWithHooksArgs regHooks  regArgs\n    where\n      modHook relocatableBuild f pd lbi us flags\n       = do let verbosity = normal\n                idts = updateInstallDirTemplates relocatableBuild\n                                                 myPrefix myLibdir myDocdir\n                                                 (installDirTemplates lbi)\n                progs = withPrograms lbi\n                ghcpkgconf = topdir </> \"package.conf.d\"\n                ghcProgram' = ghcProgram {\n                    programPostConf = \\_ cp -> return cp { programDefaultArgs = [\"-B\" ++ topdir] },\n                    programFindLocation = \\_ _ -> return (Just (ghc,[])) }\n                ghcPkgProgram' = ghcPkgProgram {\n                    programPostConf = \\_ cp -> return cp { programDefaultArgs =\n                                                                [\"--global-package-db\", ghcpkgconf]\n                                                                ++ [\"--force\" | not (null myDestDir) ] },\n                    programFindLocation = \\_ _ -> return (Just (ghcpkg,[])) }\n                configurePrograms ps conf = foldM (flip (configureProgram verbosity)) conf ps\n\n            progs' <- configurePrograms [ghcProgram', ghcPkgProgram'] progs\n            instInfos <- dump (hcPkgInfo progs') verbosity GlobalPackageDB\n            let installedPkgs' = PackageIndex.fromList instInfos\n            let lbi' = lbi {\n                               installedPkgs = installedPkgs',\n                               installDirTemplates = idts,\n                               withPrograms = progs'\n                           }\n            f pd lbi' us flags\n\nupdateInstallDirTemplates :: Bool -> FilePath -> FilePath -> FilePath\n                          -> InstallDirTemplates\n                          -> InstallDirTemplates\nupdateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts\n    = idts {\n          prefix    = toPathTemplate $\n                          if relocatableBuild\n                          then \"$topdir\"\n                          else myPrefix,\n          libdir    = toPathTemplate $\n                          if relocatableBuild\n                          then \"$topdir\"\n                          else myLibdir,\n          dynlibdir = toPathTemplate $\n                          (if relocatableBuild\n                          then \"$topdir\"\n                          else myLibdir) </> \"$libname\",\n          libsubdir = toPathTemplate \"$libname\",\n          docdir    = toPathTemplate $\n                          if relocatableBuild\n                          then \"$topdir/../doc/html/libraries/$pkgid\"\n                          else (myDocdir </> \"$pkgid\"),\n          htmldir   = toPathTemplate \"$docdir\"\n      }\n\ngenerate :: FilePath -> FilePath -> [String] -> IO ()\ngenerate directory distdir config_args\n = withCurrentDirectory directory\n $ do let verbosity = normal\n      -- XXX We shouldn't just configure with the default flags\n      -- XXX And this, and thus the \"getPersistBuildConfig distdir\" below,\n      -- aren't going to work when the deps aren't built yet\n      withArgs ([\"configure\", \"--distdir\", distdir, \"--ipid\", \"$pkg-$version\"] ++ config_args)\n               runDefaultMain\n\n      lbi <- getPersistBuildConfig distdir\n      let pd0 = localPkgDescr lbi\n\n      writePersistBuildConfig distdir lbi\n\n      hooked_bi <-\n           if (buildType pd0 == Configure) || (buildType pd0 == Custom)\n           then do\n              cwd <- getCurrentDirectory\n              -- Try to find the .buildinfo in the $dist/build folder where\n              -- cabal 2.2+ will expect it, but fallback to the old default\n              -- location if we don't find any.  This is the case of the\n              -- bindist, which doesn't ship the $dist/build folder.\n              maybe_infoFile <- findHookedPackageDesc (cwd </> distdir </> \"build\")\n                                <|> defaultHookedPackageDesc\n              case maybe_infoFile of\n                  Nothing       -> return emptyHookedBuildInfo\n                  Just infoFile -> readHookedBuildInfo verbosity infoFile\n           else\n              return emptyHookedBuildInfo\n\n      let pd = updatePackageDescription hooked_bi pd0\n\n      -- generate Paths_<pkg>.hs and cabal-macros.h\n      withAllComponentsInBuildOrder pd lbi $ \\_ clbi ->\n        writeAutogenFiles verbosity pd lbi clbi\n\n      -- generate inplace-pkg-config\n      withLibLBI pd lbi $ \\lib clbi ->\n          do cwd <- getCurrentDirectory\n             let fixupIncludeDir dir | cwd `isPrefixOf` dir = [dir, cwd </> distdir </> \"build\" ++ drop (length cwd) dir]\n                                     | otherwise            = [dir]\n             let ipid = mkUnitId (display (packageId pd))\n             let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir\n                                        pd (mkAbiHash \"inplace\") lib lbi clbi\n                 final_ipi = installedPkgInfo {\n                                 Installed.installedUnitId = ipid,\n                                 Installed.compatPackageKey = display (packageId pd),\n                                 Installed.includeDirs = concatMap fixupIncludeDir (Installed.includeDirs installedPkgInfo)\n                             }\n                 content = Installed.showInstalledPackageInfo final_ipi ++ \"\\n\"\n             writeFileAtomic (distdir </> \"inplace-pkg-config\")\n                             (toUTF8LBS content)\n\n      let\n          comp = compiler lbi\n          libBiModules lib = (libBuildInfo lib, libModules lib)\n          exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)\n          biModuless = (map libBiModules . maybeToList $ library pd)\n                    ++ (map exeBiModules $ executables pd)\n          buildableBiModuless = filter isBuildable biModuless\n              where isBuildable (bi', _) = buildable bi'\n          (bi, modules) = case buildableBiModuless of\n                          [] -> error \"No buildable component found\"\n                          [biModules] -> biModules\n                          _ -> error (\"XXX ghc-cabal can't handle \" ++\n                                      \"more than one buildinfo yet\")\n          -- XXX Another Just...\n          Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)\n\n          dep_pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))\n          forDeps f = concatMap f dep_pkgs\n\n          -- copied from Distribution.Simple.PreProcess.ppHsc2Hs\n          packageHacks = case compilerFlavor (compiler lbi) of\n            GHC -> hackRtsPackage\n            _   -> id\n          -- We don't link in the actual Haskell libraries of our\n          -- dependencies, so the -u flags in the ldOptions of the rts\n          -- package mean linking fails on OS X (it's ld is a tad\n          -- stricter than gnu ld). Thus we remove the ldOptions for\n          -- GHC's rts package:\n          hackRtsPackage index =\n            case PackageIndex.lookupPackageName index (mkPackageName \"rts\") of\n              [(_,[rts])] ->\n                 PackageIndex.insert rts{\n                     Installed.ldOptions = [],\n                     Installed.libraryDirs = filter (not . (\"gcc-lib\" `isSuffixOf`)) (Installed.libraryDirs rts)} index\n                        -- GHC <= 6.12 had $topdir/gcc-lib in their\n                        -- library-dirs for the rts package, which causes\n                        -- problems when we try to use the in-tree mingw,\n                        -- due to accidentally picking up the incompatible\n                        -- libraries there.  So we filter out gcc-lib from\n                        -- the RTS's library-dirs here.\n              _ -> error \"No (or multiple) ghc rts package is registered!!\"\n\n          dep_ids  = map snd (externalPackageDeps lbi)\n          deps     = map display dep_ids\n          dep_direct = map (fromMaybe (error \"ghc-cabal: dep_keys failed\")\n                           . PackageIndex.lookupUnitId\n                                            (installedPkgs lbi)\n                           . fst)\n                       . externalPackageDeps\n                       $ lbi\n          dep_ipids = map (display . Installed.installedUnitId) dep_direct\n          depLibNames\n            | packageKeySupported comp = dep_ipids\n            | otherwise = deps\n          depNames = map (display . mungedName) dep_ids\n\n          transitive_dep_ids = map Installed.sourcePackageId dep_pkgs\n          transitiveDeps = map display transitive_dep_ids\n          transitiveDepLibNames\n            | packageKeySupported comp = map fixupRtsLibName transitiveDeps\n            | otherwise = transitiveDeps\n          fixupRtsLibName \"rts-1.0\" = \"rts\"\n          fixupRtsLibName x = x\n          transitiveDepNames = map (display . packageName) transitive_dep_ids\n\n          libraryDirs = forDeps Installed.libraryDirs\n          -- The mkLibraryRelDir function is a bit of a hack.\n          -- Ideally it should be handled in the makefiles instead.\n          mkLibraryRelDir \"rts\"   = \"rts/dist/build\"\n          mkLibraryRelDir \"ghc\"   = \"compiler/stage2/build\"\n          mkLibraryRelDir \"Cabal\" = \"libraries/Cabal/Cabal/dist-install/build\"\n          mkLibraryRelDir l       = \"libraries/\" ++ l ++ \"/dist-install/build\"\n          libraryRelDirs = map mkLibraryRelDir transitiveDepNames\n\n          -- this is a hack to accommodate Cabal 2.2+ more hygenic\n          -- generated data.   We'll inject `dist-install/build` after\n          -- before the `include` directory, if any.\n          injectDistInstall :: FilePath -> [FilePath]\n          injectDistInstall x | takeBaseName x == \"include\" = [x, takeDirectory x ++ \"/dist-install/build/\" ++ takeBaseName x]\n          injectDistInstall x = [x]\n\n      wrappedIncludeDirs <- wrap $ concatMap injectDistInstall $ forDeps Installed.includeDirs\n\n      let variablePrefix = directory ++ '_':distdir\n          mods      = map display modules\n          otherMods = map display (otherModules bi)\n          buildDir' = map (\\c -> if c=='\\\\' then '/' else c) $ buildDir lbi\n      let xs = [variablePrefix ++ \"_VERSION = \" ++ display (pkgVersion (package pd)),\n                -- TODO: move inside withLibLBI\n                variablePrefix ++ \"_COMPONENT_ID = \" ++ localCompatPackageKey lbi,\n                variablePrefix ++ \"_MODULES = \" ++ unwords mods,\n                variablePrefix ++ \"_HIDDEN_MODULES = \" ++ unwords otherMods,\n                variablePrefix ++ \"_SYNOPSIS =\" ++ (unwords $ lines $ synopsis pd),\n                variablePrefix ++ \"_HS_SRC_DIRS = \" ++ unwords (hsSourceDirs bi),\n                variablePrefix ++ \"_DEPS = \" ++ unwords deps,\n                variablePrefix ++ \"_DEP_IPIDS = \" ++ unwords dep_ipids,\n                variablePrefix ++ \"_DEP_NAMES = \" ++ unwords depNames,\n                variablePrefix ++ \"_DEP_COMPONENT_IDS = \" ++ unwords depLibNames,\n                variablePrefix ++ \"_TRANSITIVE_DEP_NAMES = \" ++ unwords transitiveDepNames,\n                variablePrefix ++ \"_TRANSITIVE_DEP_COMPONENT_IDS = \" ++ unwords transitiveDepLibNames,\n                variablePrefix ++ \"_INCLUDE_DIRS = \" ++ unwords (  [ dir | dir <- includeDirs bi ]\n                                                                ++ [ buildDir' ++ \"/\" ++ dir | dir <- includeDirs bi\n                                                                                             , not (isAbsolute dir)]),\n                variablePrefix ++ \"_INCLUDES = \" ++ unwords (includes bi),\n                variablePrefix ++ \"_INSTALL_INCLUDES = \" ++ unwords (installIncludes bi),\n                variablePrefix ++ \"_EXTRA_LIBRARIES = \" ++ unwords (extraLibs bi),\n                variablePrefix ++ \"_EXTRA_LIBDIRS = \" ++ unwords (extraLibDirs bi),\n                variablePrefix ++ \"_S_SRCS = \" ++ unwords (asmSources bi),\n                variablePrefix ++ \"_C_SRCS  = \" ++ unwords (cSources bi),\n                variablePrefix ++ \"_CMM_SRCS = \" ++ unwords (cmmSources bi),\n                variablePrefix ++ \"_DATA_FILES = \"    ++ unwords (dataFiles pd),\n                -- XXX This includes things it shouldn't, like:\n                -- -odir dist-bootstrapping/build\n                variablePrefix ++ \"_HC_OPTS = \" ++ escape (unwords\n                       (   programDefaultArgs ghcProg\n                        ++ hcOptions GHC bi\n                        ++ languageToFlags (compiler lbi) (defaultLanguage bi)\n                        ++ extensionsToFlags (compiler lbi) (usedExtensions bi)\n                        ++ programOverrideArgs ghcProg)),\n                variablePrefix ++ \"_CC_OPTS = \"                        ++ unwords (ccOptions bi),\n                variablePrefix ++ \"_CPP_OPTS = \"                       ++ unwords (cppOptions bi),\n                variablePrefix ++ \"_LD_OPTS = \"                        ++ unwords (ldOptions bi),\n                variablePrefix ++ \"_DEP_INCLUDE_DIRS_SINGLE_QUOTED = \" ++ unwords wrappedIncludeDirs,\n                variablePrefix ++ \"_DEP_CC_OPTS = \"                    ++ unwords (forDeps Installed.ccOptions),\n                variablePrefix ++ \"_DEP_LIB_DIRS_SEARCHPATH = \"        ++ mkSearchPath libraryDirs,\n                variablePrefix ++ \"_DEP_LIB_REL_DIRS = \"               ++ unwords libraryRelDirs,\n                variablePrefix ++ \"_DEP_LIB_REL_DIRS_SEARCHPATH = \"    ++ mkSearchPath libraryRelDirs,\n                variablePrefix ++ \"_DEP_LD_OPTS = \"                    ++ unwords (forDeps Installed.ldOptions),\n                variablePrefix ++ \"_BUILD_GHCI_LIB = \"                 ++ boolToYesNo (withGHCiLib lbi),\n                \"\",\n                -- Sometimes we need to modify the automatically-generated package-data.mk\n                -- bindings in a special way for the GHC build system, so allow that here:\n                \"$(eval $(\" ++ directory ++ \"_PACKAGE_MAGIC))\"\n                ]\n      writeFile (distdir ++ \"/package-data.mk\") $ unlines xs\n\n      writeFileUtf8 (distdir ++ \"/haddock-prologue.txt\") $\n          if null (description pd) then synopsis pd\n                                   else description pd\n  where\n     escape = foldr (\\c xs -> if c == '#' then '\\\\':'#':xs else c:xs) []\n     wrap = mapM wrap1\n     wrap1 s\n      | null s        = die [\"Wrapping empty value\"]\n      | '\\'' `elem` s = die [\"Single quote in value to be wrapped:\", s]\n      -- We want to be able to assume things like <space><quote> is the\n      -- start of a value, so check there are no spaces in confusing\n      -- positions\n      | head s == ' ' = die [\"Leading space in value to be wrapped:\", s]\n      | last s == ' ' = die [\"Trailing space in value to be wrapped:\", s]\n      | otherwise     = return (\"\\'\" ++ s ++ \"\\'\")\n     mkSearchPath = intercalate [searchPathSeparator]\n     boolToYesNo True = \"YES\"\n     boolToYesNo False = \"NO\"\n\n     -- | Version of 'writeFile' that always uses UTF8 encoding\n     writeFileUtf8 f txt = withFile f WriteMode $ \\hdl -> do\n         hSetEncoding hdl utf8\n         hPutStr hdl txt\n", "num_lines": 467}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n-- We never want to link against terminfo while bootstrapping.\n#if defined(BOOTSTRAPPING)\n#if defined(WITH_TERMINFO)\n#undef WITH_TERMINFO\n#endif\n#endif\n\n-----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow 2004-2009.\n--\n-- Package management tool\n--\n-----------------------------------------------------------------------------\n\nmodule Main (main) where\n\nimport Version ( version, targetOS, targetARCH )\nimport qualified GHC.PackageDb as GhcPkg\nimport GHC.PackageDb (BinaryStringRep(..))\nimport GHC.HandleEncoding\nimport qualified Distribution.Simple.PackageIndex as PackageIndex\nimport qualified Data.Graph as Graph\nimport qualified Distribution.ModuleName as ModuleName\nimport Distribution.ModuleName (ModuleName)\nimport Distribution.InstalledPackageInfo as Cabal\nimport qualified Distribution.Parsec as Cabal\nimport Distribution.Package hiding (installedUnitId)\nimport Distribution.Text\nimport Distribution.Version\nimport Distribution.Backpack\nimport Distribution.Types.UnqualComponentName\nimport Distribution.Types.LibraryName\nimport Distribution.Types.MungedPackageName\nimport Distribution.Types.MungedPackageId\nimport Distribution.Simple.Utils (fromUTF8BS, toUTF8BS, writeUTF8File, readUTF8File)\nimport qualified Data.Version as Version\nimport System.FilePath as FilePath\nimport qualified System.FilePath.Posix as FilePath.Posix\nimport System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing,\n                          getModificationTime )\nimport Text.Printf\n\nimport Prelude\n\nimport System.Console.GetOpt\nimport qualified Control.Exception as Exception\nimport Data.Maybe\n\nimport Data.Char ( toLower )\nimport Control.Monad\nimport System.Directory ( doesDirectoryExist, getDirectoryContents,\n                          doesFileExist, removeFile,\n                          getCurrentDirectory )\nimport System.Exit ( exitWith, ExitCode(..) )\nimport System.Environment ( getArgs, getProgName, getEnv )\n#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(mingw32_HOST_OS)\nimport System.Environment ( getExecutablePath )\n#endif\nimport System.IO\nimport System.IO.Error\nimport GHC.IO.Exception (IOErrorType(InappropriateType))\nimport Data.List\nimport Control.Concurrent\nimport qualified Data.Foldable as F\nimport qualified Data.Traversable as F\nimport qualified Data.Set as Set\nimport qualified Data.Map as Map\n\n#if defined(mingw32_HOST_OS)\nimport GHC.ConsoleHandler\n#else\nimport System.Posix hiding (fdToHandle)\n#endif\n\n#if defined(GLOB)\nimport qualified System.Info(os)\n#endif\n\n#if defined(WITH_TERMINFO)\nimport System.Console.Terminfo as Terminfo\n#endif\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\n-- | Short-circuit 'any' with a \\\"monadic predicate\\\".\nanyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool\nanyM _ [] = return False\nanyM p (x:xs) = do\n  b <- p x\n  if b\n    then return True\n    else anyM p xs\n\n-- -----------------------------------------------------------------------------\n-- Entry point\n\nmain :: IO ()\nmain = do\n  configureHandleEncoding\n  args <- getArgs\n\n  case getOpt Permute (flags ++ deprecFlags) args of\n        (cli,_,[]) | FlagHelp `elem` cli -> do\n           prog <- getProgramName\n           bye (usageInfo (usageHeader prog) flags)\n        (cli,_,[]) | FlagVersion `elem` cli ->\n           bye ourCopyright\n        (cli,nonopts,[]) ->\n           case getVerbosity Normal cli of\n           Right v -> runit v cli nonopts\n           Left err -> die err\n        (_,_,errors) -> do\n           prog <- getProgramName\n           die (concat errors ++ shortUsage prog)\n\n-- -----------------------------------------------------------------------------\n-- Command-line syntax\n\ndata Flag\n  = FlagUser\n  | FlagGlobal\n  | FlagHelp\n  | FlagVersion\n  | FlagConfig FilePath\n  | FlagGlobalConfig FilePath\n  | FlagUserConfig FilePath\n  | FlagForce\n  | FlagForceFiles\n  | FlagMultiInstance\n  | FlagExpandEnvVars\n  | FlagExpandPkgroot\n  | FlagNoExpandPkgroot\n  | FlagSimpleOutput\n  | FlagNamesOnly\n  | FlagIgnoreCase\n  | FlagNoUserDb\n  | FlagVerbosity (Maybe String)\n  | FlagUnitId\n  deriving Eq\n\nflags :: [OptDescr Flag]\nflags = [\n  Option [] [\"user\"] (NoArg FlagUser)\n        \"use the current user's package database\",\n  Option [] [\"global\"] (NoArg FlagGlobal)\n        \"use the global package database\",\n  Option ['f'] [\"package-db\"] (ReqArg FlagConfig \"FILE/DIR\")\n        \"use the specified package database\",\n  Option [] [\"package-conf\"] (ReqArg FlagConfig \"FILE/DIR\")\n        \"use the specified package database (DEPRECATED)\",\n  Option [] [\"global-package-db\"] (ReqArg FlagGlobalConfig \"DIR\")\n        \"location of the global package database\",\n  Option [] [\"no-user-package-db\"] (NoArg FlagNoUserDb)\n        \"never read the user package database\",\n  Option [] [\"user-package-db\"] (ReqArg FlagUserConfig \"DIR\")\n        \"location of the user package database (use instead of default)\",\n  Option [] [\"no-user-package-conf\"] (NoArg FlagNoUserDb)\n        \"never read the user package database (DEPRECATED)\",\n  Option [] [\"force\"] (NoArg FlagForce)\n         \"ignore missing dependencies, directories, and libraries\",\n  Option [] [\"force-files\"] (NoArg FlagForceFiles)\n         \"ignore missing directories and libraries only\",\n  Option [] [\"enable-multi-instance\"] (NoArg FlagMultiInstance)\n        \"allow registering multiple instances of the same package version\",\n  Option [] [\"expand-env-vars\"] (NoArg FlagExpandEnvVars)\n        \"expand environment variables (${name}-style) in input package descriptions\",\n  Option [] [\"expand-pkgroot\"] (NoArg FlagExpandPkgroot)\n        \"expand ${pkgroot}-relative paths to absolute in output package descriptions\",\n  Option [] [\"no-expand-pkgroot\"] (NoArg FlagNoExpandPkgroot)\n        \"preserve ${pkgroot}-relative paths in output package descriptions\",\n  Option ['?'] [\"help\"] (NoArg FlagHelp)\n        \"display this help and exit\",\n  Option ['V'] [\"version\"] (NoArg FlagVersion)\n        \"output version information and exit\",\n  Option [] [\"simple-output\"] (NoArg FlagSimpleOutput)\n        \"print output in easy-to-parse format for some commands\",\n  Option [] [\"names-only\"] (NoArg FlagNamesOnly)\n        \"only print package names, not versions; can only be used with list --simple-output\",\n  Option [] [\"ignore-case\"] (NoArg FlagIgnoreCase)\n        \"ignore case for substring matching\",\n  Option [] [\"ipid\", \"unit-id\"] (NoArg FlagUnitId)\n        \"interpret package arguments as unit IDs (e.g. installed package IDs)\",\n  Option ['v'] [\"verbose\"] (OptArg FlagVerbosity \"Verbosity\")\n        \"verbosity level (0-2, default 1)\"\n  ]\n\ndata Verbosity = Silent | Normal | Verbose\n    deriving (Show, Eq, Ord)\n\ngetVerbosity :: Verbosity -> [Flag] -> Either String Verbosity\ngetVerbosity v [] = Right v\ngetVerbosity _ (FlagVerbosity Nothing    : fs) = getVerbosity Verbose fs\ngetVerbosity _ (FlagVerbosity (Just \"0\") : fs) = getVerbosity Silent  fs\ngetVerbosity _ (FlagVerbosity (Just \"1\") : fs) = getVerbosity Normal  fs\ngetVerbosity _ (FlagVerbosity (Just \"2\") : fs) = getVerbosity Verbose fs\ngetVerbosity _ (FlagVerbosity v : _) = Left (\"Bad verbosity: \" ++ show v)\ngetVerbosity v (_ : fs) = getVerbosity v fs\n\ndeprecFlags :: [OptDescr Flag]\ndeprecFlags = [\n        -- put deprecated flags here\n  ]\n\nourCopyright :: String\nourCopyright = \"GHC package manager version \" ++ Version.version ++ \"\\n\"\n\nshortUsage :: String -> String\nshortUsage prog = \"For usage information see '\" ++ prog ++ \" --help'.\"\n\nusageHeader :: String -> String\nusageHeader prog = substProg prog $\n  \"Usage:\\n\" ++\n  \"  $p init {path}\\n\" ++\n  \"    Create and initialise a package database at the location {path}.\\n\" ++\n  \"    Packages can be registered in the new database using the register\\n\" ++\n  \"    command with --package-db={path}.  To use the new database with GHC,\\n\" ++\n  \"    use GHC's -package-db flag.\\n\" ++\n  \"\\n\" ++\n  \"  $p register {filename | -}\\n\" ++\n  \"    Register the package using the specified installed package\\n\" ++\n  \"    description. The syntax for the latter is given in the $p\\n\" ++\n  \"    documentation.  The input file should be encoded in UTF-8.\\n\" ++\n  \"\\n\" ++\n  \"  $p update {filename | -}\\n\" ++\n  \"    Register the package, overwriting any other package with the\\n\" ++\n  \"    same name. The input file should be encoded in UTF-8.\\n\" ++\n  \"\\n\" ++\n  \"  $p unregister [pkg-id] \\n\" ++\n  \"    Unregister the specified packages in the order given.\\n\" ++\n  \"\\n\" ++\n  \"  $p expose {pkg-id}\\n\" ++\n  \"    Expose the specified package.\\n\" ++\n  \"\\n\" ++\n  \"  $p hide {pkg-id}\\n\" ++\n  \"    Hide the specified package.\\n\" ++\n  \"\\n\" ++\n  \"  $p trust {pkg-id}\\n\" ++\n  \"    Trust the specified package.\\n\" ++\n  \"\\n\" ++\n  \"  $p distrust {pkg-id}\\n\" ++\n  \"    Distrust the specified package.\\n\" ++\n  \"\\n\" ++\n  \"  $p list [pkg]\\n\" ++\n  \"    List registered packages in the global database, and also the\\n\" ++\n  \"    user database if --user is given. If a package name is given\\n\" ++\n  \"    all the registered versions will be listed in ascending order.\\n\" ++\n  \"    Accepts the --simple-output flag.\\n\" ++\n  \"\\n\" ++\n  \"  $p dot\\n\" ++\n  \"    Generate a graph of the package dependencies in a form suitable\\n\" ++\n  \"    for input for the graphviz tools.  For example, to generate a PDF\\n\" ++\n  \"    of the dependency graph: ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf\\n\" ++\n  \"\\n\" ++\n  \"  $p find-module {module}\\n\" ++\n  \"    List registered packages exposing module {module} in the global\\n\" ++\n  \"    database, and also the user database if --user is given.\\n\" ++\n  \"    All the registered versions will be listed in ascending order.\\n\" ++\n  \"    Accepts the --simple-output flag.\\n\" ++\n  \"\\n\" ++\n  \"  $p latest {pkg-id}\\n\" ++\n  \"    Prints the highest registered version of a package.\\n\" ++\n  \"\\n\" ++\n  \"  $p check\\n\" ++\n  \"    Check the consistency of package dependencies and list broken packages.\\n\" ++\n  \"    Accepts the --simple-output flag.\\n\" ++\n  \"\\n\" ++\n  \"  $p describe {pkg}\\n\" ++\n  \"    Give the registered description for the specified package. The\\n\" ++\n  \"    description is returned in precisely the syntax required by $p\\n\" ++\n  \"    register.\\n\" ++\n  \"\\n\" ++\n  \"  $p field {pkg} {field}\\n\" ++\n  \"    Extract the specified field of the package description for the\\n\" ++\n  \"    specified package. Accepts comma-separated multiple fields.\\n\" ++\n  \"\\n\" ++\n  \"  $p dump\\n\" ++\n  \"    Dump the registered description for every package.  This is like\\n\" ++\n  \"    \\\"ghc-pkg describe '*'\\\", except that it is intended to be used\\n\" ++\n  \"    by tools that parse the results, rather than humans.  The output is\\n\" ++\n  \"    always encoded in UTF-8, regardless of the current locale.\\n\" ++\n  \"\\n\" ++\n  \"  $p recache\\n\" ++\n  \"    Regenerate the package database cache.  This command should only be\\n\" ++\n  \"    necessary if you added a package to the database by dropping a file\\n\" ++\n  \"    into the database directory manually.  By default, the global DB\\n\" ++\n  \"    is recached; to recache a different DB use --user or --package-db\\n\" ++\n  \"    as appropriate.\\n\" ++\n  \"\\n\" ++\n  \" Substring matching is supported for {module} in find-module and\\n\" ++\n  \" for {pkg} in list, describe, and field, where a '*' indicates\\n\" ++\n  \" open substring ends (prefix*, *suffix, *infix*).  Use --ipid to\\n\" ++\n  \" match against the installed package ID instead.\\n\" ++\n  \"\\n\" ++\n  \"  When asked to modify a database (register, unregister, update,\\n\"++\n  \"  hide, expose, and also check), ghc-pkg modifies the global database by\\n\"++\n  \"  default.  Specifying --user causes it to act on the user database,\\n\"++\n  \"  or --package-db can be used to act on another database\\n\"++\n  \"  entirely. When multiple of these options are given, the rightmost\\n\"++\n  \"  one is used as the database to act upon.\\n\"++\n  \"\\n\"++\n  \"  Commands that query the package database (list, tree, latest, describe,\\n\"++\n  \"  field) operate on the list of databases specified by the flags\\n\"++\n  \"  --user, --global, and --package-db.  If none of these flags are\\n\"++\n  \"  given, the default is --global --user.\\n\"++\n  \"\\n\" ++\n  \" The following optional flags are also accepted:\\n\"\n\nsubstProg :: String -> String -> String\nsubstProg _ [] = []\nsubstProg prog ('$':'p':xs) = prog ++ substProg prog xs\nsubstProg prog (c:xs) = c : substProg prog xs\n\n-- -----------------------------------------------------------------------------\n-- Do the business\n\ndata Force = NoForce | ForceFiles | ForceAll | CannotForce\n  deriving (Eq,Ord)\n\n-- | Enum flag representing argument type\ndata AsPackageArg\n    = AsUnitId\n    | AsDefault\n\n-- | Represents how a package may be specified by a user on the command line.\ndata PackageArg\n    -- | A package identifier foo-0.1, or a glob foo-*\n    = Id GlobPackageIdentifier\n    -- | An installed package ID foo-0.1-HASH.  This is guaranteed to uniquely\n    -- match a single entry in the package database.\n    | IUId UnitId\n    -- | A glob against the package name.  The first string is the literal\n    -- glob, the second is a function which returns @True@ if the argument\n    -- matches.\n    | Substring String (String->Bool)\n\nrunit :: Verbosity -> [Flag] -> [String] -> IO ()\nrunit verbosity cli nonopts = do\n  installSignalHandlers -- catch ^C and clean up\n  when (verbosity >= Verbose)\n    (putStr ourCopyright)\n  prog <- getProgramName\n  let\n        force\n          | FlagForce `elem` cli        = ForceAll\n          | FlagForceFiles `elem` cli   = ForceFiles\n          | otherwise                   = NoForce\n        as_arg | FlagUnitId `elem` cli = AsUnitId\n               | otherwise             = AsDefault\n        multi_instance = FlagMultiInstance `elem` cli\n        expand_env_vars= FlagExpandEnvVars `elem` cli\n        mexpand_pkgroot= foldl' accumExpandPkgroot Nothing cli\n          where accumExpandPkgroot _ FlagExpandPkgroot   = Just True\n                accumExpandPkgroot _ FlagNoExpandPkgroot = Just False\n                accumExpandPkgroot x _                   = x\n\n        splitFields fields = unfoldr splitComma (',':fields)\n          where splitComma \"\" = Nothing\n                splitComma fs = Just $ break (==',') (tail fs)\n\n        -- | Parses a glob into a predicate which tests if a string matches\n        -- the glob.  Returns Nothing if the string in question is not a glob.\n        -- At the moment, we only support globs at the beginning and/or end of\n        -- strings.  This function respects case sensitivity.\n        --\n        -- >>> fromJust (substringCheck \"*\") \"anything\"\n        -- True\n        --\n        -- >>> fromJust (substringCheck \"string\") \"string\"\n        -- True\n        --\n        -- >>> fromJust (substringCheck \"*bar\") \"foobar\"\n        -- True\n        --\n        -- >>> fromJust (substringCheck \"foo*\") \"foobar\"\n        -- True\n        --\n        -- >>> fromJust (substringCheck \"*ooba*\") \"foobar\"\n        -- True\n        --\n        -- >>> fromJust (substringCheck \"f*bar\") \"foobar\"\n        -- False\n        substringCheck :: String -> Maybe (String -> Bool)\n        substringCheck \"\"    = Nothing\n        substringCheck \"*\"   = Just (const True)\n        substringCheck [_]   = Nothing\n        substringCheck (h:t) =\n          case (h, init t, last t) of\n            ('*',s,'*') -> Just (isInfixOf (f s) . f)\n            ('*',_, _ ) -> Just (isSuffixOf (f t) . f)\n            ( _ ,s,'*') -> Just (isPrefixOf (f (h:s)) . f)\n            _           -> Nothing\n          where f | FlagIgnoreCase `elem` cli = map toLower\n                  | otherwise                 = id\n#if defined(GLOB)\n        glob x | System.Info.os==\"mingw32\" = do\n          -- glob echoes its argument, after win32 filename globbing\n          (_,o,_,_) <- runInteractiveCommand (\"glob \"++x)\n          txt <- hGetContents o\n          return (read txt)\n        glob x | otherwise = return [x]\n#endif\n  --\n  -- first, parse the command\n  case nonopts of\n#if defined(GLOB)\n    -- dummy command to demonstrate usage and permit testing\n    -- without messing things up; use glob to selectively enable\n    -- windows filename globbing for file parameters\n    -- register, update, FlagGlobalConfig, FlagConfig; others?\n    [\"glob\", filename] -> do\n        print filename\n        glob filename >>= print\n#endif\n    [\"init\", filename] ->\n        initPackageDB filename verbosity cli\n    [\"register\", filename] ->\n        registerPackage filename verbosity cli\n                        multi_instance\n                        expand_env_vars False force\n    [\"update\", filename] ->\n        registerPackage filename verbosity cli\n                        multi_instance\n                        expand_env_vars True force\n    \"unregister\" : pkgarg_strs@(_:_) -> do\n        forM_ pkgarg_strs $ \\pkgarg_str -> do\n          pkgarg <- readPackageArg as_arg pkgarg_str\n          unregisterPackage pkgarg verbosity cli force\n    [\"expose\", pkgarg_str] -> do\n        pkgarg <- readPackageArg as_arg pkgarg_str\n        exposePackage pkgarg verbosity cli force\n    [\"hide\",   pkgarg_str] -> do\n        pkgarg <- readPackageArg as_arg pkgarg_str\n        hidePackage pkgarg verbosity cli force\n    [\"trust\",    pkgarg_str] -> do\n        pkgarg <- readPackageArg as_arg pkgarg_str\n        trustPackage pkgarg verbosity cli force\n    [\"distrust\", pkgarg_str] -> do\n        pkgarg <- readPackageArg as_arg pkgarg_str\n        distrustPackage pkgarg verbosity cli force\n    [\"list\"] -> do\n        listPackages verbosity cli Nothing Nothing\n    [\"list\", pkgarg_str] ->\n        case substringCheck pkgarg_str of\n          Nothing -> do pkgarg <- readPackageArg as_arg pkgarg_str\n                        listPackages verbosity cli (Just pkgarg) Nothing\n          Just m -> listPackages verbosity cli\n                                 (Just (Substring pkgarg_str m)) Nothing\n    [\"dot\"] -> do\n        showPackageDot verbosity cli\n    [\"find-module\", mod_name] -> do\n        let match = maybe (==mod_name) id (substringCheck mod_name)\n        listPackages verbosity cli Nothing (Just match)\n    [\"latest\", pkgid_str] -> do\n        pkgid <- readGlobPkgId pkgid_str\n        latestPackage verbosity cli pkgid\n    [\"describe\", pkgid_str] -> do\n        pkgarg <- case substringCheck pkgid_str of\n          Nothing -> readPackageArg as_arg pkgid_str\n          Just m  -> return (Substring pkgid_str m)\n        describePackage verbosity cli pkgarg (fromMaybe False mexpand_pkgroot)\n\n    [\"field\", pkgid_str, fields] -> do\n        pkgarg <- case substringCheck pkgid_str of\n          Nothing -> readPackageArg as_arg pkgid_str\n          Just m  -> return (Substring pkgid_str m)\n        describeField verbosity cli pkgarg\n                      (splitFields fields) (fromMaybe True mexpand_pkgroot)\n\n    [\"check\"] -> do\n        checkConsistency verbosity cli\n\n    [\"dump\"] -> do\n        dumpPackages verbosity cli (fromMaybe False mexpand_pkgroot)\n\n    [\"recache\"] -> do\n        recache verbosity cli\n\n    [] -> do\n        die (\"missing command\\n\" ++ shortUsage prog)\n    (_cmd:_) -> do\n        die (\"command-line syntax error\\n\" ++ shortUsage prog)\n\nparseCheck :: Cabal.Parsec a => String -> String -> IO a\nparseCheck str what =\n  case Cabal.eitherParsec str of\n    Left e  -> die (\"cannot parse \\'\" ++ str ++ \"\\' as a \" ++ what ++ \": \" ++ e)\n    Right x -> pure x\n\n-- | Either an exact 'PackageIdentifier', or a glob for all packages\n-- matching 'PackageName'.\ndata GlobPackageIdentifier\n    = ExactPackageIdentifier MungedPackageId\n    | GlobPackageIdentifier  MungedPackageName\n\ndisplayGlobPkgId :: GlobPackageIdentifier -> String\ndisplayGlobPkgId (ExactPackageIdentifier pid) = display pid\ndisplayGlobPkgId (GlobPackageIdentifier pn) = display pn ++ \"-*\"\n\nreadGlobPkgId :: String -> IO GlobPackageIdentifier\nreadGlobPkgId str\n  | \"-*\" `isSuffixOf` str =\n    GlobPackageIdentifier <$> parseCheck (init (init str)) \"package identifier (glob)\"\n  | otherwise = ExactPackageIdentifier <$> parseCheck str \"package identifier (exact)\"\n\nreadPackageArg :: AsPackageArg -> String -> IO PackageArg\nreadPackageArg AsUnitId str = IUId <$> parseCheck str \"installed package id\"\nreadPackageArg AsDefault str = Id <$> readGlobPkgId str\n\n-- -----------------------------------------------------------------------------\n-- Package databases\n\n-- Some commands operate on a single database:\n--      register, unregister, expose, hide, trust, distrust\n-- however these commands also check the union of the available databases\n-- in order to check consistency.  For example, register will check that\n-- dependencies exist before registering a package.\n--\n-- Some commands operate  on multiple databases, with overlapping semantics:\n--      list, describe, field\n\ndata PackageDB (mode :: GhcPkg.DbMode)\n  = PackageDB {\n      location, locationAbsolute :: !FilePath,\n      -- We need both possibly-relative and definitely-absolute package\n      -- db locations. This is because the relative location is used as\n      -- an identifier for the db, so it is important we do not modify it.\n      -- On the other hand we need the absolute path in a few places\n      -- particularly in relation to the ${pkgroot} stuff.\n\n      packageDbLock :: !(GhcPkg.DbOpenMode mode GhcPkg.PackageDbLock),\n      -- If package db is open in read write mode, we keep its lock around for\n      -- transactional updates.\n\n      packages :: [InstalledPackageInfo]\n    }\n\ntype PackageDBStack = [PackageDB 'GhcPkg.DbReadOnly]\n        -- A stack of package databases.  Convention: head is the topmost\n        -- in the stack.\n\n-- | Selector for picking the right package DB to modify as 'register' and\n-- 'recache' operate on the database on top of the stack, whereas 'modify'\n-- changes the first database that contains a specific package.\ndata DbModifySelector = TopOne | ContainsPkg PackageArg\n\nallPackagesInStack :: PackageDBStack -> [InstalledPackageInfo]\nallPackagesInStack = concatMap packages\n\n-- | Retain only the part of the stack up to and including the given package\n-- DB (where the global package DB is the bottom of the stack). The resulting\n-- package DB stack contains exactly the packages that packages from the\n-- specified package DB can depend on, since dependencies can only extend\n-- down the stack, not up (e.g. global packages cannot depend on user\n-- packages).\nstackUpTo :: FilePath -> PackageDBStack -> PackageDBStack\nstackUpTo to_modify = dropWhile ((/= to_modify) . location)\n\ngetPkgDatabases :: Verbosity\n                -> GhcPkg.DbOpenMode mode DbModifySelector\n                -> Bool    -- use the user db\n                -> Bool    -- read caches, if available\n                -> Bool    -- expand vars, like ${pkgroot} and $topdir\n                -> [Flag]\n                -> IO (PackageDBStack,\n                          -- the real package DB stack: [global,user] ++\n                          -- DBs specified on the command line with -f.\n                       GhcPkg.DbOpenMode mode (PackageDB mode),\n                          -- which one to modify, if any\n                       PackageDBStack)\n                          -- the package DBs specified on the command\n                          -- line, or [global,user] otherwise.  This\n                          -- is used as the list of package DBs for\n                          -- commands that just read the DB, such as 'list'.\n\ngetPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do\n  -- first we determine the location of the global package config.  On Windows,\n  -- this is found relative to the ghc-pkg.exe binary, whereas on Unix the\n  -- location is passed to the binary using the --global-package-db flag by the\n  -- wrapper script.\n  let err_msg = \"missing --global-package-db option, location of global package database unknown\\n\"\n  global_conf <-\n     case [ f | FlagGlobalConfig f <- my_flags ] of\n        [] -> do mb_dir <- getLibDir\n                 case mb_dir of\n                   Nothing  -> die err_msg\n                   Just dir -> do\n                     r <- lookForPackageDBIn dir\n                     case r of\n                       Nothing -> die (\"Can't find package database in \" ++ dir)\n                       Just path -> return path\n        fs -> return (last fs)\n\n  -- The value of the $topdir variable used in some package descriptions\n  -- Note that the way we calculate this is slightly different to how it\n  -- is done in ghc itself. We rely on the convention that the global\n  -- package db lives in ghc's libdir.\n  top_dir <- absolutePath (takeDirectory global_conf)\n\n  let no_user_db = FlagNoUserDb `elem` my_flags\n\n  -- get the location of the user package database, and create it if necessary\n  -- getAppUserDataDirectory can fail (e.g. if $HOME isn't set)\n  e_appdir <- tryIO $ getAppUserDataDirectory \"ghc\"\n\n  mb_user_conf <-\n    case [ f | FlagUserConfig f <- my_flags ] of\n      _ | no_user_db -> return Nothing\n      [] -> case e_appdir of\n        Left _    -> return Nothing\n        Right appdir -> do\n          let subdir = targetARCH ++ '-':targetOS ++ '-':Version.version\n              dir = appdir </> subdir\n          r <- lookForPackageDBIn dir\n          case r of\n            Nothing -> return (Just (dir </> \"package.conf.d\", False))\n            Just f  -> return (Just (f, True))\n      fs -> return (Just (last fs, True))\n\n  -- If the user database exists, and for \"use_user\" commands (which includes\n  -- \"ghc-pkg check\" and all commands that modify the db) we will attempt to\n  -- use the user db.\n  let sys_databases\n        | Just (user_conf,user_exists) <- mb_user_conf,\n          use_user || user_exists = [user_conf, global_conf]\n        | otherwise               = [global_conf]\n\n  e_pkg_path <- tryIO (System.Environment.getEnv \"GHC_PACKAGE_PATH\")\n  let env_stack =\n        case e_pkg_path of\n                Left  _ -> sys_databases\n                Right path\n                  | not (null path) && isSearchPathSeparator (last path)\n                  -> splitSearchPath (init path) ++ sys_databases\n                  | otherwise\n                  -> splitSearchPath path\n\n        -- The \"global\" database is always the one at the bottom of the stack.\n        -- This is the database we modify by default.\n      virt_global_conf = last env_stack\n\n  let db_flags = [ f | Just f <- map is_db_flag my_flags ]\n         where is_db_flag FlagUser\n                      | Just (user_conf, _user_exists) <- mb_user_conf\n                      = Just user_conf\n               is_db_flag FlagGlobal     = Just virt_global_conf\n               is_db_flag (FlagConfig f) = Just f\n               is_db_flag _              = Nothing\n\n  let flag_db_names | null db_flags = env_stack\n                    | otherwise     = reverse (nub db_flags)\n\n  -- For a \"modify\" command, treat all the databases as\n  -- a stack, where we are modifying the top one, but it\n  -- can refer to packages in databases further down the\n  -- stack.\n\n  -- -f flags on the command line add to the database\n  -- stack, unless any of them are present in the stack\n  -- already.\n  let final_stack = filter (`notElem` env_stack)\n                     [ f | FlagConfig f <- reverse my_flags ]\n                     ++ env_stack\n\n      top_db = if null db_flags\n               then virt_global_conf\n               else last db_flags\n\n  (db_stack, db_to_operate_on) <- getDatabases top_dir mb_user_conf\n                                               flag_db_names final_stack top_db\n\n  let flag_db_stack = [ db | db_name <- flag_db_names,\n                        db <- db_stack, location db == db_name ]\n\n  when (verbosity > Normal) $ do\n    infoLn (\"db stack: \" ++ show (map location db_stack))\n    F.forM_ db_to_operate_on $ \\db ->\n      infoLn (\"modifying: \" ++ (location db))\n    infoLn (\"flag db stack: \" ++ show (map location flag_db_stack))\n\n  return (db_stack, db_to_operate_on, flag_db_stack)\n  where\n    getDatabases top_dir mb_user_conf flag_db_names\n                 final_stack top_db = case mode of\n      -- When we open in read only mode, we simply read all of the databases/\n      GhcPkg.DbOpenReadOnly -> do\n        db_stack <- mapM readDatabase final_stack\n        return (db_stack, GhcPkg.DbOpenReadOnly)\n\n      -- The only package db we open in read write mode is the one on the top of\n      -- the stack.\n      GhcPkg.DbOpenReadWrite TopOne -> do\n        (db_stack, mto_modify) <- stateSequence Nothing\n          [ \\case\n              to_modify@(Just _) -> (, to_modify) <$> readDatabase db_path\n              Nothing -> if db_path /= top_db\n                then (, Nothing) <$> readDatabase db_path\n                else do\n                  db <- readParseDatabase verbosity mb_user_conf\n                                          mode use_cache db_path\n                    `Exception.catch` couldntOpenDbForModification db_path\n                  let ro_db = db { packageDbLock = GhcPkg.DbOpenReadOnly }\n                  return (ro_db, Just db)\n          | db_path <- final_stack ]\n\n        to_modify <- case mto_modify of\n          Just db -> return db\n          Nothing -> die \"no database selected for modification\"\n\n        return (db_stack, GhcPkg.DbOpenReadWrite to_modify)\n\n      -- The package db we open in read write mode is the first one included in\n      -- flag_db_names that contains specified package. Therefore we need to\n      -- open each one in read/write mode first and decide whether it's for\n      -- modification based on its contents.\n      GhcPkg.DbOpenReadWrite (ContainsPkg pkgarg) -> do\n        (db_stack, mto_modify) <- stateSequence Nothing\n          [ \\case\n              to_modify@(Just _) -> (, to_modify) <$> readDatabase db_path\n              Nothing -> if db_path `notElem` flag_db_names\n                then (, Nothing) <$> readDatabase db_path\n                else do\n                  let hasPkg :: PackageDB mode -> Bool\n                      hasPkg = not . null . findPackage pkgarg . packages\n\n                      openRo (e::IOError) = do\n                        db <- readDatabase db_path\n                        if hasPkg db\n                          then couldntOpenDbForModification db_path e\n                          else return (db, Nothing)\n\n                  -- If we fail to open the database in read/write mode, we need\n                  -- to check if it's for modification first before throwing an\n                  -- error, so we attempt to open it in read only mode.\n                  Exception.handle openRo $ do\n                    db <- readParseDatabase verbosity mb_user_conf\n                                            mode use_cache db_path\n                    let ro_db = db { packageDbLock = GhcPkg.DbOpenReadOnly }\n                    if hasPkg db\n                      then return (ro_db, Just db)\n                      else do\n                        -- If the database is not for modification after all,\n                        -- drop the write lock as we are already finished with\n                        -- the database.\n                        case packageDbLock db of\n                          GhcPkg.DbOpenReadWrite lock ->\n                            GhcPkg.unlockPackageDb lock\n                        return (ro_db, Nothing)\n          | db_path <- final_stack ]\n\n        to_modify <- case mto_modify of\n          Just db -> return db\n          Nothing -> cannotFindPackage pkgarg Nothing\n\n        return (db_stack, GhcPkg.DbOpenReadWrite to_modify)\n      where\n        couldntOpenDbForModification :: FilePath -> IOError -> IO a\n        couldntOpenDbForModification db_path e = die $ \"Couldn't open database \"\n          ++ db_path ++ \" for modification: \" ++ show e\n\n        -- Parse package db in read-only mode.\n        readDatabase :: FilePath -> IO (PackageDB 'GhcPkg.DbReadOnly)\n        readDatabase db_path = do\n          db <- readParseDatabase verbosity mb_user_conf\n                                  GhcPkg.DbOpenReadOnly use_cache db_path\n          if expand_vars\n            then return $ mungePackageDBPaths top_dir db\n            else return db\n\n    stateSequence :: Monad m => s -> [s -> m (a, s)] -> m ([a], s)\n    stateSequence s []     = return ([], s)\n    stateSequence s (m:ms) = do\n      (a, s')   <- m s\n      (as, s'') <- stateSequence s' ms\n      return (a : as, s'')\n\nlookForPackageDBIn :: FilePath -> IO (Maybe FilePath)\nlookForPackageDBIn dir = do\n  let path_dir = dir </> \"package.conf.d\"\n  exists_dir <- doesDirectoryExist path_dir\n  if exists_dir then return (Just path_dir) else do\n    let path_file = dir </> \"package.conf\"\n    exists_file <- doesFileExist path_file\n    if exists_file then return (Just path_file) else return Nothing\n\nreadParseDatabase :: forall mode t. Verbosity\n                  -> Maybe (FilePath,Bool)\n                  -> GhcPkg.DbOpenMode mode t\n                  -> Bool -- use cache\n                  -> FilePath\n                  -> IO (PackageDB mode)\nreadParseDatabase verbosity mb_user_conf mode use_cache path\n  -- the user database (only) is allowed to be non-existent\n  | Just (user_conf,False) <- mb_user_conf, path == user_conf\n  = do lock <- F.forM mode $ \\_ -> do\n         createDirectoryIfMissing True path\n         GhcPkg.lockPackageDb cache\n       mkPackageDB [] lock\n  | otherwise\n  = do e <- tryIO $ getDirectoryContents path\n       case e of\n         Left err\n           | ioeGetErrorType err == InappropriateType -> do\n              -- We provide a limited degree of backwards compatibility for\n              -- old single-file style db:\n              mdb <- tryReadParseOldFileStyleDatabase verbosity\n                       mb_user_conf mode use_cache path\n              case mdb of\n                Just db -> return db\n                Nothing ->\n                  die $ \"ghc no longer supports single-file style package \"\n                     ++ \"databases (\" ++ path ++ \") use 'ghc-pkg init'\"\n                     ++ \"to create the database with the correct format.\"\n\n           | otherwise -> ioError err\n         Right fs\n           | not use_cache -> ignore_cache (const $ return ())\n           | otherwise -> do\n              e_tcache <- tryIO $ getModificationTime cache\n              case e_tcache of\n                Left ex -> do\n                  whenReportCacheErrors $\n                    if isDoesNotExistError ex\n                      then\n                        -- It's fine if the cache is not there as long as the\n                        -- database is empty.\n                        when (not $ null confs) $ do\n                            warn (\"WARNING: cache does not exist: \" ++ cache)\n                            warn (\"ghc will fail to read this package db. \" ++\n                                  recacheAdvice)\n                      else do\n                        warn (\"WARNING: cache cannot be read: \" ++ show ex)\n                        warn \"ghc will fail to read this package db.\"\n                  ignore_cache (const $ return ())\n                Right tcache -> do\n                  when (verbosity >= Verbose) $ do\n                      warn (\"Timestamp \" ++ show tcache ++ \" for \" ++ cache)\n                  -- If any of the .conf files is newer than package.cache, we\n                  -- assume that cache is out of date.\n                  cache_outdated <- (`anyM` confs) $ \\conf ->\n                    (tcache <) <$> getModificationTime conf\n                  if not cache_outdated\n                      then do\n                          when (verbosity > Normal) $\n                             infoLn (\"using cache: \" ++ cache)\n                          GhcPkg.readPackageDbForGhcPkg cache mode\n                            >>= uncurry mkPackageDB\n                      else do\n                          whenReportCacheErrors $ do\n                              warn (\"WARNING: cache is out of date: \" ++ cache)\n                              warn (\"ghc will see an old view of this \" ++\n                                    \"package db. \" ++ recacheAdvice)\n                          ignore_cache $ \\file -> do\n                            when (verbosity >= Verbose) $ do\n                              tFile <- getModificationTime file\n                              let rel = case tcache `compare` tFile of\n                                    LT -> \" (NEWER than cache)\"\n                                    GT -> \" (older than cache)\"\n                                    EQ -> \" (same as cache)\"\n                              warn (\"Timestamp \" ++ show tFile\n                                ++ \" for \" ++ file ++ rel)\n            where\n                 confs = map (path </>) $ filter (\".conf\" `isSuffixOf`) fs\n\n                 ignore_cache :: (FilePath -> IO ()) -> IO (PackageDB mode)\n                 ignore_cache checkTime = do\n                     -- If we're opening for modification, we need to acquire a\n                     -- lock even if we don't open the cache now, because we are\n                     -- going to modify it later.\n                     lock <- F.mapM (const $ GhcPkg.lockPackageDb cache) mode\n                     let doFile f = do checkTime f\n                                       parseSingletonPackageConf verbosity f\n                     pkgs <- mapM doFile confs\n                     mkPackageDB pkgs lock\n\n                 -- We normally report cache errors for read-only commands,\n                 -- since modify commands will usually fix the cache.\n                 whenReportCacheErrors = when $ verbosity > Normal\n                   || verbosity >= Normal && GhcPkg.isDbOpenReadMode mode\n  where\n    cache = path </> cachefilename\n\n    recacheAdvice\n      | Just (user_conf, True) <- mb_user_conf, path == user_conf\n      = \"Use 'ghc-pkg recache --user' to fix.\"\n      | otherwise\n      = \"Use 'ghc-pkg recache' to fix.\"\n\n    mkPackageDB :: [InstalledPackageInfo]\n                -> GhcPkg.DbOpenMode mode GhcPkg.PackageDbLock\n                -> IO (PackageDB mode)\n    mkPackageDB pkgs lock = do\n      path_abs <- absolutePath path\n      return $ PackageDB {\n          location = path,\n          locationAbsolute = path_abs,\n          packageDbLock = lock,\n          packages = pkgs\n        }\n\nparseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo\nparseSingletonPackageConf verbosity file = do\n  when (verbosity > Normal) $ infoLn (\"reading package config: \" ++ file)\n  readUTF8File file >>= fmap fst . parsePackageInfo\n\ncachefilename :: FilePath\ncachefilename = \"package.cache\"\n\nmungePackageDBPaths :: FilePath -> PackageDB mode -> PackageDB mode\nmungePackageDBPaths top_dir db@PackageDB { packages = pkgs } =\n    db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }\n  where\n    pkgroot = takeDirectory $ dropTrailingPathSeparator (locationAbsolute db)\n    -- It so happens that for both styles of package db (\"package.conf\"\n    -- files and \"package.conf.d\" dirs) the pkgroot is the parent directory\n    -- ${pkgroot}/package.conf  or  ${pkgroot}/package.conf.d/\n\n-- TODO: This code is duplicated in compiler/main/Packages.hs\nmungePackagePaths :: FilePath -> FilePath\n                  -> InstalledPackageInfo -> InstalledPackageInfo\n-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec\n-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)\n-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.\n-- The \"pkgroot\" is the directory containing the package database.\n--\n-- Also perform a similar substitution for the older GHC-specific\n-- \"$topdir\" variable. The \"topdir\" is the location of the ghc\n-- installation (obtained from the -B option).\nmungePackagePaths top_dir pkgroot pkg =\n    pkg {\n      importDirs  = munge_paths (importDirs pkg),\n      includeDirs = munge_paths (includeDirs pkg),\n      libraryDirs = munge_paths (libraryDirs pkg),\n      libraryDynDirs = munge_paths (libraryDynDirs pkg),\n      frameworkDirs = munge_paths (frameworkDirs pkg),\n      haddockInterfaces = munge_paths (haddockInterfaces pkg),\n                     -- haddock-html is allowed to be either a URL or a file\n      haddockHTMLs = munge_paths (munge_urls (haddockHTMLs pkg))\n    }\n  where\n    munge_paths = map munge_path\n    munge_urls  = map munge_url\n\n    munge_path p\n      | Just p' <- stripVarPrefix \"${pkgroot}\" p = pkgroot ++ p'\n      | Just p' <- stripVarPrefix \"$topdir\"    p = top_dir ++ p'\n      | otherwise                                = p\n\n    munge_url p\n      | Just p' <- stripVarPrefix \"${pkgrooturl}\" p = toUrlPath pkgroot p'\n      | Just p' <- stripVarPrefix \"$httptopdir\"   p = toUrlPath top_dir p'\n      | otherwise                                   = p\n\n    toUrlPath r p = \"file:///\"\n                 -- URLs always use posix style '/' separators:\n                 ++ FilePath.Posix.joinPath\n                        (r : -- We need to drop a leading \"/\" or \"\\\\\"\n                             -- if there is one:\n                             dropWhile (all isPathSeparator)\n                                       (FilePath.splitDirectories p))\n\n    -- We could drop the separator here, and then use </> above. However,\n    -- by leaving it in and using ++ we keep the same path separator\n    -- rather than letting FilePath change it to use \\ as the separator\n    stripVarPrefix var path = case stripPrefix var path of\n                              Just [] -> Just []\n                              Just cs@(c : _) | isPathSeparator c -> Just cs\n                              _ -> Nothing\n\n\n-- -----------------------------------------------------------------------------\n-- Workaround for old single-file style package dbs\n\n-- Single-file style package dbs have been deprecated for some time, but\n-- it turns out that Cabal was using them in one place. So this code is for a\n-- workaround to allow older Cabal versions to use this newer ghc.\n\n-- We check if the file db contains just \"[]\" and if so, we look for a new\n-- dir-style db in path.d/, ie in a dir next to the given file.\n-- We cannot just replace the file with a new dir style since Cabal still\n-- assumes it's a file and tries to overwrite with 'writeFile'.\n\n-- ghc itself also cooperates in this workaround\n\ntryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (FilePath, Bool)\n                                 -> GhcPkg.DbOpenMode mode t -> Bool -> FilePath\n                                 -> IO (Maybe (PackageDB mode))\ntryReadParseOldFileStyleDatabase verbosity mb_user_conf\n                                 mode use_cache path = do\n  -- assumes we've already established that path exists and is not a dir\n  content <- readFile path `catchIO` \\_ -> return \"\"\n  if take 2 content == \"[]\"\n    then do\n      path_abs <- absolutePath path\n      let path_dir = adjustOldDatabasePath path\n      warn $ \"Warning: ignoring old file-style db and trying \" ++ path_dir\n      direxists <- doesDirectoryExist path_dir\n      if direxists\n        then do\n          db <- readParseDatabase verbosity mb_user_conf mode use_cache path_dir\n          -- but pretend it was at the original location\n          return $ Just db {\n              location         = path,\n              locationAbsolute = path_abs\n            }\n         else do\n           lock <- F.forM mode $ \\_ -> do\n             createDirectoryIfMissing True path_dir\n             GhcPkg.lockPackageDb $ path_dir </> cachefilename\n           return $ Just PackageDB {\n               location         = path,\n               locationAbsolute = path_abs,\n               packageDbLock    = lock,\n               packages         = []\n             }\n\n    -- if the path is not a file, or is not an empty db then we fail\n    else return Nothing\n\nadjustOldFileStylePackageDB :: PackageDB mode -> IO (PackageDB mode)\nadjustOldFileStylePackageDB db = do\n  -- assumes we have not yet established if it's an old style or not\n  mcontent <- liftM Just (readFile (location db)) `catchIO` \\_ -> return Nothing\n  case fmap (take 2) mcontent of\n    -- it is an old style and empty db, so look for a dir kind in location.d/\n    Just \"[]\" -> return db {\n        location         = adjustOldDatabasePath $ location db,\n        locationAbsolute = adjustOldDatabasePath $ locationAbsolute db\n      }\n    -- it is old style but not empty, we have to bail\n    Just  _   -> die $ \"ghc no longer supports single-file style package \"\n                    ++ \"databases (\" ++ location db ++ \") use 'ghc-pkg init'\"\n                    ++ \"to create the database with the correct format.\"\n    -- probably not old style, carry on as normal\n    Nothing   -> return db\n\nadjustOldDatabasePath :: FilePath -> FilePath\nadjustOldDatabasePath = (<.> \"d\")\n\n-- -----------------------------------------------------------------------------\n-- Creating a new package DB\n\ninitPackageDB :: FilePath -> Verbosity -> [Flag] -> IO ()\ninitPackageDB filename verbosity _flags = do\n  let eexist = die (\"cannot create: \" ++ filename ++ \" already exists\")\n  b1 <- doesFileExist filename\n  when b1 eexist\n  b2 <- doesDirectoryExist filename\n  when b2 eexist\n  createDirectoryIfMissing True filename\n  lock <- GhcPkg.lockPackageDb $ filename </> cachefilename\n  filename_abs <- absolutePath filename\n  changeDB verbosity [] PackageDB {\n      location = filename,\n      locationAbsolute = filename_abs,\n      packageDbLock = GhcPkg.DbOpenReadWrite lock,\n      packages = []\n    }\n    -- We can get away with passing an empty stack here, because the new DB is\n    -- going to be initially empty, so no dependencies are going to be actually\n    -- looked up.\n    []\n\n-- -----------------------------------------------------------------------------\n-- Registering\n\nregisterPackage :: FilePath\n                -> Verbosity\n                -> [Flag]\n                -> Bool              -- multi_instance\n                -> Bool              -- expand_env_vars\n                -> Bool              -- update\n                -> Force\n                -> IO ()\nregisterPackage input verbosity my_flags multi_instance\n                expand_env_vars update force = do\n  (db_stack, GhcPkg.DbOpenReadWrite db_to_operate_on, _flag_dbs) <-\n    getPkgDatabases verbosity (GhcPkg.DbOpenReadWrite TopOne)\n      True{-use user-} True{-use cache-} False{-expand vars-} my_flags\n\n  let to_modify = location db_to_operate_on\n\n  s <-\n    case input of\n      \"-\" -> do\n        when (verbosity >= Normal) $\n            info \"Reading package info from stdin ... \"\n        -- fix the encoding to UTF-8, since this is an interchange format\n        hSetEncoding stdin utf8\n        getContents\n      f   -> do\n        when (verbosity >= Normal) $\n            info (\"Reading package info from \" ++ show f ++ \" ... \")\n        readUTF8File f\n\n  expanded <- if expand_env_vars then expandEnvVars s force\n                                 else return s\n\n  (pkg, ws) <- parsePackageInfo expanded\n  when (verbosity >= Normal) $\n      infoLn \"done.\"\n\n  -- report any warnings from the parse phase\n  _ <- reportValidateErrors verbosity [] ws\n         (display (mungedId pkg) ++ \": Warning: \") Nothing\n\n  -- validate the expanded pkg, but register the unexpanded\n  pkgroot <- absolutePath (takeDirectory to_modify)\n  let top_dir = takeDirectory (location (last db_stack))\n      pkg_expanded = mungePackagePaths top_dir pkgroot pkg\n\n  let truncated_stack = stackUpTo to_modify db_stack\n  -- truncate the stack for validation, because we don't allow\n  -- packages lower in the stack to refer to those higher up.\n  validatePackageConfig pkg_expanded verbosity truncated_stack\n                        multi_instance update force\n\n  let\n     -- In the normal mode, we only allow one version of each package, so we\n     -- remove all instances with the same source package id as the one we're\n     -- adding. In the multi instance mode we don't do that, thus allowing\n     -- multiple instances with the same source package id.\n     removes = [ RemovePackage p\n               | not multi_instance,\n                 p <- packages db_to_operate_on,\n                 mungedId p == mungedId pkg,\n                 -- Only remove things that were instantiated the same way!\n                 instantiatedWith p == instantiatedWith pkg ]\n  --\n  changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on db_stack\n\nparsePackageInfo\n        :: String\n        -> IO (InstalledPackageInfo, [ValidateWarning])\nparsePackageInfo str =\n  case parseInstalledPackageInfo str of\n    Right (warnings, ok) -> pure (mungePackageInfo ok, ws)\n      where\n        ws = [ msg | msg <- warnings\n                   , not (\"Unrecognized field pkgroot\" `isPrefixOf` msg) ]\n    Left err -> die (unlines err)\n\nmungePackageInfo :: InstalledPackageInfo -> InstalledPackageInfo\nmungePackageInfo ipi = ipi\n\n-- -----------------------------------------------------------------------------\n-- Making changes to a package database\n\ndata DBOp = RemovePackage InstalledPackageInfo\n          | AddPackage    InstalledPackageInfo\n          | ModifyPackage InstalledPackageInfo\n\nchangeDB :: Verbosity\n         -> [DBOp]\n         -> PackageDB 'GhcPkg.DbReadWrite\n         -> PackageDBStack\n         -> IO ()\nchangeDB verbosity cmds db db_stack = do\n  let db' = updateInternalDB db cmds\n  db'' <- adjustOldFileStylePackageDB db'\n  createDirectoryIfMissing True (location db'')\n  changeDBDir verbosity cmds db'' db_stack\n\nupdateInternalDB :: PackageDB 'GhcPkg.DbReadWrite\n                 -> [DBOp] -> PackageDB 'GhcPkg.DbReadWrite\nupdateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds }\n where\n  do_cmd pkgs (RemovePackage p) =\n    filter ((/= installedUnitId p) . installedUnitId) pkgs\n  do_cmd pkgs (AddPackage p) = p : pkgs\n  do_cmd pkgs (ModifyPackage p) =\n    do_cmd (do_cmd pkgs (RemovePackage p)) (AddPackage p)\n\n\nchangeDBDir :: Verbosity\n            -> [DBOp]\n            -> PackageDB 'GhcPkg.DbReadWrite\n            -> PackageDBStack\n            -> IO ()\nchangeDBDir verbosity cmds db db_stack = do\n  mapM_ do_cmd cmds\n  updateDBCache verbosity db db_stack\n where\n  do_cmd (RemovePackage p) = do\n    let file = location db </> display (installedUnitId p) <.> \"conf\"\n    when (verbosity > Normal) $ infoLn (\"removing \" ++ file)\n    removeFileSafe file\n  do_cmd (AddPackage p) = do\n    let file = location db </> display (installedUnitId p) <.> \"conf\"\n    when (verbosity > Normal) $ infoLn (\"writing \" ++ file)\n    writeUTF8File file (showInstalledPackageInfo p)\n  do_cmd (ModifyPackage p) =\n    do_cmd (AddPackage p)\n\nupdateDBCache :: Verbosity\n              -> PackageDB 'GhcPkg.DbReadWrite\n              -> PackageDBStack\n              -> IO ()\nupdateDBCache verbosity db db_stack = do\n  let filename = location db </> cachefilename\n      db_stack_below = stackUpTo (location db) db_stack\n\n      pkgsCabalFormat :: [InstalledPackageInfo]\n      pkgsCabalFormat = packages db\n\n      -- | All the packages we can legally depend on in this step.\n      dependablePkgsCabalFormat :: [InstalledPackageInfo]\n      dependablePkgsCabalFormat = allPackagesInStack db_stack_below\n\n      pkgsGhcCacheFormat :: [(PackageCacheFormat, Bool)]\n      pkgsGhcCacheFormat\n        -- See Note [Recompute abi-depends]\n        = map (recomputeValidAbiDeps dependablePkgsCabalFormat)\n        $ map convertPackageInfoToCacheFormat\n          pkgsCabalFormat\n\n      hasAnyAbiDepends :: InstalledPackageInfo -> Bool\n      hasAnyAbiDepends x = length (abiDepends x) > 0\n\n  -- warn when we find any (possibly-)bogus abi-depends fields;\n  -- Note [Recompute abi-depends]\n  when (verbosity >= Normal) $ do\n    let definitelyBrokenPackages =\n          nub\n            . sort\n            . map (unPackageName . GhcPkg.packageName . fst)\n            . filter snd\n            $ pkgsGhcCacheFormat\n    when (definitelyBrokenPackages /= []) $ do\n      warn \"the following packages have broken abi-depends fields:\"\n      forM_ definitelyBrokenPackages $ \\pkg ->\n        warn $ \"    \" ++ pkg\n    when (verbosity > Normal) $ do\n      let possiblyBrokenPackages =\n            nub\n              . sort\n              . filter (not . (`elem` definitelyBrokenPackages))\n              . map (unPackageName . pkgName . packageId)\n              . filter hasAnyAbiDepends\n              $ pkgsCabalFormat\n      when (possiblyBrokenPackages /= []) $ do\n          warn $\n            \"the following packages have correct abi-depends, \" ++\n            \"but may break in the future:\"\n          forM_ possiblyBrokenPackages $ \\pkg ->\n            warn $ \"    \" ++ pkg\n\n  when (verbosity > Normal) $\n      infoLn (\"writing cache \" ++ filename)\n\n  GhcPkg.writePackageDb filename (map fst pkgsGhcCacheFormat) pkgsCabalFormat\n    `catchIO` \\e ->\n      if isPermissionError e\n      then die $ filename ++ \": you don't have permission to modify this file\"\n      else ioError e\n\n  case packageDbLock db of\n    GhcPkg.DbOpenReadWrite lock -> GhcPkg.unlockPackageDb lock\n\ntype PackageCacheFormat = GhcPkg.InstalledPackageInfo\n                            ComponentId\n                            PackageIdentifier\n                            PackageName\n                            UnitId\n                            OpenUnitId\n                            ModuleName\n                            OpenModule\n\n{- Note [Recompute abi-depends]\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\nLike most fields, `ghc-pkg` relies on who-ever is performing package\nregistration to fill in fields; this includes the `abi-depends` field present\nfor the package.\n\nHowever, this was likely a mistake, and is not very robust; in certain cases,\nversions of Cabal may use bogus abi-depends fields for a package when doing\nbuilds. Why? Because package database information is aggressively cached; it is\npossible to work Cabal into a situation where it uses a cached version of\n`abi-depends`, rather than the one in the actual database after it has been\nrecomputed.\n\nHowever, there is an easy fix: ghc-pkg /already/ knows the `abi-depends` of a\npackage, because they are the ABIs of the packages pointed at by the `depends`\nfield. So it can simply look up the abi from the dependencies in the original\ndatabase, and ignore whatever the system registering gave it.\n\nSo, instead, we do two things here:\n\n  - We throw away the information for a registered package's `abi-depends` field.\n\n  - We recompute it: we simply look up the unit ID of the package in the original\n    database, and use *its* abi-depends.\n\nSee Trac #14381, and Cabal issue #4728.\n\nAdditionally, because we are throwing away the original (declared) ABI deps, we\nreturn a boolean that indicates whether any abi-depends were actually\noverridden.\n\n-}\n\nrecomputeValidAbiDeps :: [InstalledPackageInfo]\n                      -> PackageCacheFormat\n                      -> (PackageCacheFormat, Bool)\nrecomputeValidAbiDeps db pkg =\n  (pkg { GhcPkg.abiDepends = newAbiDeps }, abiDepsUpdated)\n  where\n    newAbiDeps =\n      catMaybes . flip map (GhcPkg.abiDepends pkg) $ \\(k, _) ->\n        case filter (\\d -> installedUnitId d == k) db of\n          [x] -> Just (k, unAbiHash (abiHash x))\n          _   -> Nothing\n    abiDepsUpdated =\n      GhcPkg.abiDepends pkg /= newAbiDeps\n\nconvertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat\nconvertPackageInfoToCacheFormat pkg =\n    GhcPkg.InstalledPackageInfo {\n       GhcPkg.unitId             = installedUnitId pkg,\n       GhcPkg.componentId        = installedComponentId pkg,\n       GhcPkg.instantiatedWith   = instantiatedWith pkg,\n       GhcPkg.sourcePackageId    = sourcePackageId pkg,\n       GhcPkg.packageName        = packageName pkg,\n       GhcPkg.packageVersion     = Version.Version (versionNumbers (packageVersion pkg)) [],\n       GhcPkg.sourceLibName      =\n         fmap (mkPackageName . unUnqualComponentName) (libraryNameString $ sourceLibName pkg),\n       GhcPkg.depends            = depends pkg,\n       GhcPkg.abiDepends         = map (\\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg),\n       GhcPkg.abiHash            = unAbiHash (abiHash pkg),\n       GhcPkg.importDirs         = importDirs pkg,\n       GhcPkg.hsLibraries        = hsLibraries pkg,\n       GhcPkg.extraLibraries     = extraLibraries pkg,\n       GhcPkg.extraGHCiLibraries = extraGHCiLibraries pkg,\n       GhcPkg.libraryDirs        = libraryDirs pkg,\n       GhcPkg.libraryDynDirs     = libraryDynDirs pkg,\n       GhcPkg.frameworks         = frameworks pkg,\n       GhcPkg.frameworkDirs      = frameworkDirs pkg,\n       GhcPkg.ldOptions          = ldOptions pkg,\n       GhcPkg.ccOptions          = ccOptions pkg,\n       GhcPkg.includes           = includes pkg,\n       GhcPkg.includeDirs        = includeDirs pkg,\n       GhcPkg.haddockInterfaces  = haddockInterfaces pkg,\n       GhcPkg.haddockHTMLs       = haddockHTMLs pkg,\n       GhcPkg.exposedModules     = map convertExposed (exposedModules pkg),\n       GhcPkg.hiddenModules      = hiddenModules pkg,\n       GhcPkg.indefinite         = indefinite pkg,\n       GhcPkg.exposed            = exposed pkg,\n       GhcPkg.trusted            = trusted pkg\n    }\n  where\n    convertExposed (ExposedModule n reexport) = (n, reexport)\n\ninstance GhcPkg.BinaryStringRep ComponentId where\n  fromStringRep = mkComponentId . fromStringRep\n  toStringRep   = toStringRep . display\n\ninstance GhcPkg.BinaryStringRep PackageName where\n  fromStringRep = mkPackageName . fromStringRep\n  toStringRep   = toStringRep . display\n\ninstance GhcPkg.BinaryStringRep PackageIdentifier where\n  fromStringRep = fromMaybe (error \"BinaryStringRep PackageIdentifier\")\n                . simpleParse . fromStringRep\n  toStringRep = toStringRep . display\n\ninstance GhcPkg.BinaryStringRep ModuleName where\n  fromStringRep = ModuleName.fromString . fromStringRep\n  toStringRep   = toStringRep . display\n\ninstance GhcPkg.BinaryStringRep String where\n  fromStringRep = fromUTF8BS\n  toStringRep   = toUTF8BS\n\ninstance GhcPkg.BinaryStringRep UnitId where\n  fromStringRep = mkUnitId . fromStringRep\n  toStringRep   = toStringRep . display\n\ninstance GhcPkg.DbUnitIdModuleRep UnitId ComponentId OpenUnitId ModuleName OpenModule where\n  fromDbModule (GhcPkg.DbModule uid mod_name) = OpenModule uid mod_name\n  fromDbModule (GhcPkg.DbModuleVar mod_name) = OpenModuleVar mod_name\n  toDbModule (OpenModule uid mod_name) = GhcPkg.DbModule uid mod_name\n  toDbModule (OpenModuleVar mod_name) = GhcPkg.DbModuleVar mod_name\n  fromDbUnitId (GhcPkg.DbUnitId cid insts) = IndefFullUnitId cid (Map.fromList insts)\n  fromDbUnitId (GhcPkg.DbInstalledUnitId uid)\n    = DefiniteUnitId (unsafeMkDefUnitId uid)\n  toDbUnitId (IndefFullUnitId cid insts) = GhcPkg.DbUnitId cid (Map.toList insts)\n  toDbUnitId (DefiniteUnitId def_uid)\n    = GhcPkg.DbInstalledUnitId (unDefUnitId def_uid)\n\n-- -----------------------------------------------------------------------------\n-- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar\n\nexposePackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()\nexposePackage = modifyPackage (\\p -> ModifyPackage p{exposed=True})\n\nhidePackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()\nhidePackage = modifyPackage (\\p -> ModifyPackage p{exposed=False})\n\ntrustPackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()\ntrustPackage = modifyPackage (\\p -> ModifyPackage p{trusted=True})\n\ndistrustPackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()\ndistrustPackage = modifyPackage (\\p -> ModifyPackage p{trusted=False})\n\nunregisterPackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()\nunregisterPackage = modifyPackage RemovePackage\n\nmodifyPackage\n  :: (InstalledPackageInfo -> DBOp)\n  -> PackageArg\n  -> Verbosity\n  -> [Flag]\n  -> Force\n  -> IO ()\nmodifyPackage fn pkgarg verbosity my_flags force = do\n  (db_stack, GhcPkg.DbOpenReadWrite db, _flag_dbs) <-\n    getPkgDatabases verbosity (GhcPkg.DbOpenReadWrite $ ContainsPkg pkgarg)\n      True{-use user-} True{-use cache-} False{-expand vars-} my_flags\n\n  let db_name = location db\n      pkgs    = packages db\n\n      -- Get package respecting flags...\n      ps = findPackage pkgarg pkgs\n\n  -- This shouldn't happen if getPkgDatabases picks the DB correctly.\n  when (null ps) $ cannotFindPackage pkgarg $ Just db\n\n  let pks = map installedUnitId ps\n\n      cmds = [ fn pkg | pkg <- pkgs, installedUnitId pkg `elem` pks ]\n      new_db = updateInternalDB db cmds\n      new_db_ro = new_db { packageDbLock = GhcPkg.DbOpenReadOnly }\n\n      -- ...but do consistency checks with regards to the full stack\n      old_broken = brokenPackages (allPackagesInStack db_stack)\n      rest_of_stack = filter ((/= db_name) . location) db_stack\n      new_stack = new_db_ro : rest_of_stack\n      new_broken = brokenPackages (allPackagesInStack new_stack)\n      newly_broken = filter ((`notElem` map installedUnitId old_broken)\n                            . installedUnitId) new_broken\n  --\n  let displayQualPkgId pkg\n        | [_] <- filter ((== pkgid) . mungedId)\n                        (allPackagesInStack db_stack)\n            = display pkgid\n        | otherwise = display pkgid ++ \"@\" ++ display (installedUnitId pkg)\n        where pkgid = mungedId pkg\n  when (not (null newly_broken)) $\n      dieOrForceAll force (\"unregistering would break the following packages: \"\n              ++ unwords (map displayQualPkgId newly_broken))\n\n  changeDB verbosity cmds db db_stack\n\nrecache :: Verbosity -> [Flag] -> IO ()\nrecache verbosity my_flags = do\n  (_db_stack, GhcPkg.DbOpenReadWrite db_to_operate_on, _flag_dbs) <-\n    getPkgDatabases verbosity (GhcPkg.DbOpenReadWrite TopOne)\n      True{-use user-} False{-no cache-} False{-expand vars-} my_flags\n  changeDB verbosity [] db_to_operate_on _db_stack\n\n-- -----------------------------------------------------------------------------\n-- Listing packages\n\nlistPackages ::  Verbosity -> [Flag] -> Maybe PackageArg\n             -> Maybe (String->Bool)\n             -> IO ()\nlistPackages verbosity my_flags mPackageName mModuleName = do\n  let simple_output = FlagSimpleOutput `elem` my_flags\n  (db_stack, GhcPkg.DbOpenReadOnly, flag_db_stack) <-\n    getPkgDatabases verbosity GhcPkg.DbOpenReadOnly\n      False{-use user-} True{-use cache-} False{-expand vars-} my_flags\n\n  let db_stack_filtered -- if a package is given, filter out all other packages\n        | Just this <- mPackageName =\n            [ db{ packages = filter (this `matchesPkg`) (packages db) }\n            | db <- flag_db_stack ]\n        | Just match <- mModuleName = -- packages which expose mModuleName\n            [ db{ packages = filter (match `exposedInPkg`) (packages db) }\n            | db <- flag_db_stack ]\n        | otherwise = flag_db_stack\n\n      db_stack_sorted\n          = [ db{ packages = sort_pkgs (packages db) }\n            | db <- db_stack_filtered ]\n          where sort_pkgs = sortBy cmpPkgIds\n                cmpPkgIds pkg1 pkg2 =\n                   case mungedName p1 `compare` mungedName p2 of\n                        LT -> LT\n                        GT -> GT\n                        EQ -> case mungedVersion p1 `compare` mungedVersion p2 of\n                                LT -> LT\n                                GT -> GT\n                                EQ -> installedUnitId pkg1 `compare` installedUnitId pkg2\n                   where (p1,p2) = (mungedId pkg1, mungedId pkg2)\n\n      stack = reverse db_stack_sorted\n\n      match `exposedInPkg` pkg = any match (map display $ exposedModules pkg)\n\n      pkg_map = allPackagesInStack db_stack\n      broken = map installedUnitId (brokenPackages pkg_map)\n\n      show_normal PackageDB{ location = db_name, packages = pkg_confs } =\n          do hPutStrLn stdout db_name\n             if null pkg_confs\n                 then hPutStrLn stdout \"    (no packages)\"\n                 else hPutStrLn stdout $ unlines (map (\"    \" ++) (map pp_pkg pkg_confs))\n           where\n                 pp_pkg p\n                   | installedUnitId p `elem` broken = printf \"{%s}\" doc\n                   | exposed p = doc\n                   | otherwise = printf \"(%s)\" doc\n                   where doc | verbosity >= Verbose = printf \"%s (%s)\" pkg (display (installedUnitId p))\n                             | otherwise            = pkg\n                          where\n                          pkg = display (mungedId p)\n\n      show_simple = simplePackageList my_flags . allPackagesInStack\n\n  when (not (null broken) && not simple_output && verbosity /= Silent) $ do\n     prog <- getProgramName\n     warn (\"WARNING: there are broken packages.  Run '\" ++ prog ++ \" check' for more details.\")\n\n  if simple_output then show_simple stack else do\n\n#if !defined(WITH_TERMINFO)\n    mapM_ show_normal stack\n#else\n    let\n       show_colour withF db@PackageDB{ packages = pkg_confs } =\n           if null pkg_confs\n           then termText (location db) <#> termText \"\\n    (no packages)\\n\"\n           else\n               mconcat $ map (<#> termText \"\\n\") $\n                           (termText (location db)\n                            : map (termText \"    \" <#>) (map pp_pkg pkg_confs))\n          where\n                   pp_pkg p\n                     | installedUnitId p `elem` broken = withF Red  doc\n                     | exposed p                       = doc\n                     | otherwise                       = withF Blue doc\n                     where doc | verbosity >= Verbose\n                               = termText (printf \"%s (%s)\" pkg (display (installedUnitId p)))\n                               | otherwise\n                               = termText pkg\n                            where\n                            pkg = display (mungedId p)\n\n    is_tty <- hIsTerminalDevice stdout\n    if not is_tty\n       then mapM_ show_normal stack\n       else do tty <- Terminfo.setupTermFromEnv\n               case Terminfo.getCapability tty withForegroundColor of\n                   Nothing -> mapM_ show_normal stack\n                   Just w  -> runTermOutput tty $ mconcat $\n                                                  map (show_colour w) stack\n#endif\n\nsimplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO ()\nsimplePackageList my_flags pkgs = do\n   let showPkg = if FlagNamesOnly `elem` my_flags then display . mungedName\n                                                  else display\n       strs = map showPkg $ map mungedId pkgs\n   when (not (null pkgs)) $\n      hPutStrLn stdout $ concat $ intersperse \" \" strs\n\nshowPackageDot :: Verbosity -> [Flag] -> IO ()\nshowPackageDot verbosity myflags = do\n  (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <-\n    getPkgDatabases verbosity GhcPkg.DbOpenReadOnly\n      False{-use user-} True{-use cache-} False{-expand vars-} myflags\n\n  let all_pkgs = allPackagesInStack flag_db_stack\n      ipix  = PackageIndex.fromList all_pkgs\n\n  putStrLn \"digraph {\"\n  let quote s = '\"':s ++ \"\\\"\"\n  mapM_ putStrLn [ quote from ++ \" -> \" ++ quote to\n                 | p <- all_pkgs,\n                   let from = display (mungedId p),\n                   key <- depends p,\n                   Just dep <- [PackageIndex.lookupUnitId ipix key],\n                   let to = display (mungedId dep)\n                 ]\n  putStrLn \"}\"\n\n-- -----------------------------------------------------------------------------\n-- Prints the highest (hidden or exposed) version of a package\n\n-- ToDo: This is no longer well-defined with unit ids, because the\n-- dependencies may be varying versions\nlatestPackage ::  Verbosity -> [Flag] -> GlobPackageIdentifier -> IO ()\nlatestPackage verbosity my_flags pkgid = do\n  (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <-\n    getPkgDatabases verbosity GhcPkg.DbOpenReadOnly\n      False{-use user-} True{-use cache-} False{-expand vars-} my_flags\n\n  ps <- findPackages flag_db_stack (Id pkgid)\n  case ps of\n    [] -> die \"no matches\"\n    _  -> show_pkg . maximum . map mungedId $ ps\n  where\n    show_pkg pid = hPutStrLn stdout (display pid)\n\n-- -----------------------------------------------------------------------------\n-- Describe\n\ndescribePackage :: Verbosity -> [Flag] -> PackageArg -> Bool -> IO ()\ndescribePackage verbosity my_flags pkgarg expand_pkgroot = do\n  (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <-\n    getPkgDatabases verbosity GhcPkg.DbOpenReadOnly\n      False{-use user-} True{-use cache-} expand_pkgroot my_flags\n  dbs <- findPackagesByDB flag_db_stack pkgarg\n  doDump expand_pkgroot [ (pkg, locationAbsolute db)\n                        | (db, pkgs) <- dbs, pkg <- pkgs ]\n\ndumpPackages :: Verbosity -> [Flag] -> Bool -> IO ()\ndumpPackages verbosity my_flags expand_pkgroot = do\n  (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <-\n    getPkgDatabases verbosity GhcPkg.DbOpenReadOnly\n      False{-use user-} True{-use cache-} expand_pkgroot my_flags\n  doDump expand_pkgroot [ (pkg, locationAbsolute db)\n                        | db <- flag_db_stack, pkg <- packages db ]\n\ndoDump :: Bool -> [(InstalledPackageInfo, FilePath)] -> IO ()\ndoDump expand_pkgroot pkgs = do\n  -- fix the encoding to UTF-8, since this is an interchange format\n  hSetEncoding stdout utf8\n  putStrLn $\n    intercalate \"---\\n\"\n    [ if expand_pkgroot\n        then showInstalledPackageInfo pkg\n        else showInstalledPackageInfo pkg ++ pkgrootField\n    | (pkg, pkgloc) <- pkgs\n    , let pkgroot      = takeDirectory pkgloc\n          pkgrootField = \"pkgroot: \" ++ show pkgroot ++ \"\\n\" ]\n\n-- PackageId is can have globVersion for the version\nfindPackages :: PackageDBStack -> PackageArg -> IO [InstalledPackageInfo]\nfindPackages db_stack pkgarg\n  = fmap (concatMap snd) $ findPackagesByDB db_stack pkgarg\n\nfindPackage :: PackageArg -> [InstalledPackageInfo] -> [InstalledPackageInfo]\nfindPackage pkgarg pkgs = filter (pkgarg `matchesPkg`) pkgs\n\nfindPackagesByDB :: PackageDBStack -> PackageArg\n                 -> IO [(PackageDB 'GhcPkg.DbReadOnly, [InstalledPackageInfo])]\nfindPackagesByDB db_stack pkgarg\n  = case [ (db, matched)\n         | db <- db_stack,\n           let matched = findPackage pkgarg $ packages db,\n           not (null matched) ] of\n        [] -> cannotFindPackage pkgarg Nothing\n        ps -> return ps\n\ncannotFindPackage :: PackageArg -> Maybe (PackageDB mode) -> IO a\ncannotFindPackage pkgarg mdb = die $ \"cannot find package \" ++ pkg_msg pkgarg\n  ++ maybe \"\" (\\db -> \" in \" ++ location db) mdb\n  where\n    pkg_msg (Id pkgid)           = displayGlobPkgId pkgid\n    pkg_msg (IUId ipid)          = display ipid\n    pkg_msg (Substring pkgpat _) = \"matching \" ++ pkgpat\n\nmatches :: GlobPackageIdentifier -> MungedPackageId -> Bool\nGlobPackageIdentifier pn `matches` pid'\n  = (pn == mungedName pid')\nExactPackageIdentifier pid `matches` pid'\n  = mungedName pid == mungedName pid' &&\n    (mungedVersion pid == mungedVersion pid' || mungedVersion pid == nullVersion)\n\nmatchesPkg :: PackageArg -> InstalledPackageInfo -> Bool\n(Id pid)        `matchesPkg` pkg = pid `matches` mungedId pkg\n(IUId ipid)     `matchesPkg` pkg = ipid == installedUnitId pkg\n(Substring _ m) `matchesPkg` pkg = m (display (mungedId pkg))\n\n-- -----------------------------------------------------------------------------\n-- Field\n\ndescribeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> Bool -> IO ()\ndescribeField verbosity my_flags pkgarg fields expand_pkgroot = do\n  (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <-\n    getPkgDatabases verbosity GhcPkg.DbOpenReadOnly\n      False{-use user-} True{-use cache-} expand_pkgroot my_flags\n  fns <- mapM toField fields\n  ps <- findPackages flag_db_stack pkgarg\n  mapM_ (selectFields fns) ps\n  where showFun = if FlagSimpleOutput `elem` my_flags\n                  then showSimpleInstalledPackageInfoField\n                  else showInstalledPackageInfoField\n        toField f = case showFun f of\n                    Nothing -> die (\"unknown field: \" ++ f)\n                    Just fn -> return fn\n        selectFields fns pinfo = mapM_ (\\fn->putStrLn (fn pinfo)) fns\n\n\n-- -----------------------------------------------------------------------------\n-- Check: Check consistency of installed packages\n\ncheckConsistency :: Verbosity -> [Flag] -> IO ()\ncheckConsistency verbosity my_flags = do\n  (db_stack, GhcPkg.DbOpenReadOnly, _) <-\n    getPkgDatabases verbosity GhcPkg.DbOpenReadOnly\n      True{-use user-} True{-use cache-} True{-expand vars-} my_flags\n      -- although check is not a modify command, we do need to use the user\n      -- db, because we may need it to verify package deps.\n\n  let simple_output = FlagSimpleOutput `elem` my_flags\n\n  let pkgs = allPackagesInStack db_stack\n\n      checkPackage p = do\n         (_,es,ws) <- runValidate $ checkPackageConfig p verbosity db_stack\n                                                       True True\n         if null es\n            then do when (not simple_output) $ do\n                      _ <- reportValidateErrors verbosity [] ws \"\" Nothing\n                      return ()\n                    return []\n            else do\n              when (not simple_output) $ do\n                  reportError (\"There are problems in package \" ++ display (mungedId p) ++ \":\")\n                  _ <- reportValidateErrors verbosity es ws \"  \" Nothing\n                  return ()\n              return [p]\n\n  broken_pkgs <- concat `fmap` mapM checkPackage pkgs\n\n  let filterOut pkgs1 pkgs2 = filter not_in pkgs2\n        where not_in p = mungedId p `notElem` all_ps\n              all_ps = map mungedId pkgs1\n\n  let not_broken_pkgs = filterOut broken_pkgs pkgs\n      (_, trans_broken_pkgs) = closure [] not_broken_pkgs\n      all_broken_pkgs = broken_pkgs ++ trans_broken_pkgs\n\n  when (not (null all_broken_pkgs)) $ do\n    if simple_output\n      then simplePackageList my_flags all_broken_pkgs\n      else do\n       reportError (\"\\nThe following packages are broken, either because they have a problem\\n\"++\n                \"listed above, or because they depend on a broken package.\")\n       mapM_ (hPutStrLn stderr . display . mungedId) all_broken_pkgs\n\n  when (not (null all_broken_pkgs)) $ exitWith (ExitFailure 1)\n\n\nclosure :: [InstalledPackageInfo] -> [InstalledPackageInfo]\n        -> ([InstalledPackageInfo], [InstalledPackageInfo])\nclosure pkgs db_stack = go pkgs db_stack\n where\n   go avail not_avail =\n     case partition (depsAvailable avail) not_avail of\n        ([],        not_avail') -> (avail, not_avail')\n        (new_avail, not_avail') -> go (new_avail ++ avail) not_avail'\n\n   depsAvailable :: [InstalledPackageInfo] -> InstalledPackageInfo\n                 -> Bool\n   depsAvailable pkgs_ok pkg = null dangling\n        where dangling = filter (`notElem` pids) (depends pkg)\n              pids = map installedUnitId pkgs_ok\n\n        -- we want mutually recursive groups of package to show up\n        -- as broken. (#1750)\n\nbrokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo]\nbrokenPackages pkgs = snd (closure [] pkgs)\n\n-----------------------------------------------------------------------------\n-- Sanity-check a new package config, and automatically build GHCi libs\n-- if requested.\n\ntype ValidateError   = (Force,String)\ntype ValidateWarning = String\n\nnewtype Validate a = V { runValidate :: IO (a, [ValidateError],[ValidateWarning]) }\n\ninstance Functor Validate where\n    fmap = liftM\n\ninstance Applicative Validate where\n    pure a = V $ pure (a, [], [])\n    (<*>) = ap\n\ninstance Monad Validate where\n   m >>= k = V $ do\n      (a, es, ws) <- runValidate m\n      (b, es', ws') <- runValidate (k a)\n      return (b,es++es',ws++ws')\n\nverror :: Force -> String -> Validate ()\nverror f s = V (return ((),[(f,s)],[]))\n\nvwarn :: String -> Validate ()\nvwarn s = V (return ((),[],[\"Warning: \" ++ s]))\n\nliftIO :: IO a -> Validate a\nliftIO k = V (k >>= \\a -> return (a,[],[]))\n\n-- returns False if we should die\nreportValidateErrors :: Verbosity -> [ValidateError] -> [ValidateWarning]\n                     -> String -> Maybe Force -> IO Bool\nreportValidateErrors verbosity es ws prefix mb_force = do\n  when (verbosity >= Normal) $ mapM_ (warn . (prefix++)) ws\n  oks <- mapM report es\n  return (and oks)\n  where\n    report (f,s)\n      | Just force <- mb_force\n      = if (force >= f)\n           then do when (verbosity >= Normal) $\n                        reportError (prefix ++ s ++ \" (ignoring)\")\n                   return True\n           else if f < CannotForce\n                   then do reportError (prefix ++ s ++ \" (use --force to override)\")\n                           return False\n                   else do reportError err\n                           return False\n      | otherwise = do reportError err\n                       return False\n      where\n             err = prefix ++ s\n\nvalidatePackageConfig :: InstalledPackageInfo\n                      -> Verbosity\n                      -> PackageDBStack\n                      -> Bool   -- multi_instance\n                      -> Bool   -- update, or check\n                      -> Force\n                      -> IO ()\nvalidatePackageConfig pkg verbosity db_stack\n                      multi_instance update force = do\n  (_,es,ws) <- runValidate $\n                 checkPackageConfig pkg verbosity db_stack\n                                    multi_instance update\n  ok <- reportValidateErrors verbosity es ws\n          (display (mungedId pkg) ++ \": \") (Just force)\n  when (not ok) $ exitWith (ExitFailure 1)\n\ncheckPackageConfig :: InstalledPackageInfo\n                      -> Verbosity\n                      -> PackageDBStack\n                      -> Bool   -- multi_instance\n                      -> Bool   -- update, or check\n                      -> Validate ()\ncheckPackageConfig pkg verbosity db_stack\n                   multi_instance update = do\n  checkPackageId pkg\n  checkUnitId pkg db_stack update\n  checkDuplicates db_stack pkg multi_instance update\n  mapM_ (checkDep db_stack) (depends pkg)\n  checkDuplicateDepends (depends pkg)\n  mapM_ (checkDir False \"import-dirs\")  (importDirs pkg)\n  mapM_ (checkDir True  \"library-dirs\") (libraryDirs pkg)\n  mapM_ (checkDir True  \"dynamic-library-dirs\") (libraryDynDirs pkg)\n  mapM_ (checkDir True  \"include-dirs\") (includeDirs pkg)\n  mapM_ (checkDir True  \"framework-dirs\") (frameworkDirs pkg)\n  mapM_ (checkFile   True \"haddock-interfaces\") (haddockInterfaces pkg)\n  mapM_ (checkDirURL True \"haddock-html\")       (haddockHTMLs pkg)\n  checkDuplicateModules pkg\n  checkExposedModules db_stack pkg\n  checkOtherModules pkg\n  let has_code = Set.null (openModuleSubstFreeHoles (Map.fromList (instantiatedWith pkg)))\n  when has_code $ mapM_ (checkHSLib verbosity (libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg)\n  -- ToDo: check these somehow?\n  --    extra_libraries :: [String],\n  --    c_includes      :: [String],\n\n-- When the package name and version are put together, sometimes we can\n-- end up with a package id that cannot be parsed.  This will lead to\n-- difficulties when the user wants to refer to the package later, so\n-- we check that the package id can be parsed properly here.\ncheckPackageId :: InstalledPackageInfo -> Validate ()\ncheckPackageId ipi =\n  let str = display (mungedId ipi) in\n  case Cabal.eitherParsec str :: Either String MungedPackageId of\n    Left e -> verror CannotForce (\"invalid package identifier: '\" ++ str ++ \"': \" ++ e)\n    Right _ -> pure ()\n\ncheckUnitId :: InstalledPackageInfo -> PackageDBStack -> Bool\n                -> Validate ()\ncheckUnitId ipi db_stack update = do\n  let uid = installedUnitId ipi\n  when (null (display uid)) $ verror CannotForce \"missing id field\"\n  when (display uid /= compatPackageKey ipi) $\n    verror CannotForce $ \"installed package info from too old version of Cabal \"\n                      ++ \"(key field does not match id field)\"\n  let dups = [ p | p <- allPackagesInStack db_stack,\n                   installedUnitId p == uid ]\n  when (not update && not (null dups)) $\n    verror CannotForce $\n        \"package(s) with this id already exist: \" ++\n         unwords (map (display.installedUnitId) dups)\n\ncheckDuplicates :: PackageDBStack -> InstalledPackageInfo\n                -> Bool -> Bool-> Validate ()\ncheckDuplicates db_stack pkg multi_instance update = do\n  let\n        pkgid = mungedId pkg\n        pkgs  = packages (head db_stack)\n  --\n  -- Check whether this package id already exists in this DB\n  --\n  when (not update && not multi_instance\n                   && (pkgid `elem` map mungedId pkgs)) $\n       verror CannotForce $\n          \"package \" ++ display pkgid ++ \" is already installed\"\n\n  let\n        uncasep = map toLower . display\n        dups = filter ((== uncasep pkgid) . uncasep) (map mungedId pkgs)\n\n  when (not update && not multi_instance\n                   && not (null dups)) $ verror ForceAll $\n        \"Package names may be treated case-insensitively in the future.\\n\"++\n        \"Package \" ++ display pkgid ++\n        \" overlaps with: \" ++ unwords (map display dups)\n\ncheckDir, checkFile, checkDirURL :: Bool -> String -> FilePath -> Validate ()\ncheckDir  = checkPath False True\ncheckFile = checkPath False False\ncheckDirURL = checkPath True True\n\ncheckPath :: Bool -> Bool -> Bool -> String -> FilePath -> Validate ()\ncheckPath url_ok is_dir warn_only thisfield d\n | url_ok && (\"http://\"  `isPrefixOf` d\n           || \"https://\" `isPrefixOf` d) = return ()\n\n | url_ok\n , Just d' <- stripPrefix \"file://\" d\n = checkPath False is_dir warn_only thisfield d'\n\n   -- Note: we don't check for $topdir/${pkgroot} here. We rely on these\n   -- variables having been expanded already, see mungePackagePaths.\n\n | isRelative d = verror ForceFiles $\n                     thisfield ++ \": \" ++ d ++ \" is a relative path which \"\n                  ++ \"makes no sense (as there is nothing for it to be \"\n                  ++ \"relative to). You can make paths relative to the \"\n                  ++ \"package database itself by using ${pkgroot}.\"\n        -- relative paths don't make any sense; #4134\n | otherwise = do\n   there <- liftIO $ if is_dir then doesDirectoryExist d else doesFileExist d\n   when (not there) $\n       let msg = thisfield ++ \": \" ++ d ++ \" doesn't exist or isn't a \"\n                                        ++ if is_dir then \"directory\" else \"file\"\n       in\n       if warn_only\n          then vwarn msg\n          else verror ForceFiles msg\n\ncheckDep :: PackageDBStack -> UnitId -> Validate ()\ncheckDep db_stack pkgid\n  | pkgid `elem` pkgids = return ()\n  | otherwise = verror ForceAll (\"dependency \\\"\" ++ display pkgid\n                                 ++ \"\\\" doesn't exist\")\n  where\n        all_pkgs = allPackagesInStack db_stack\n        pkgids = map installedUnitId all_pkgs\n\ncheckDuplicateDepends :: [UnitId] -> Validate ()\ncheckDuplicateDepends deps\n  | null dups = return ()\n  | otherwise = verror ForceAll (\"package has duplicate dependencies: \" ++\n                                     unwords (map display dups))\n  where\n       dups = [ p | (p:_:_) <- group (sort deps) ]\n\ncheckHSLib :: Verbosity -> [String] -> String -> Validate ()\ncheckHSLib _verbosity dirs lib = do\n  let filenames = [\"lib\" ++ lib ++ \".a\",\n                   \"lib\" ++ lib ++ \"_p.a\",\n                   \"lib\" ++ lib ++ \"-ghc\" ++ Version.version ++ \".so\",\n                   \"lib\" ++ lib ++ \"-ghc\" ++ Version.version ++ \".dylib\",\n                            lib ++ \"-ghc\" ++ Version.version ++ \".dll\"]\n  b <- liftIO $ doesFileExistOnPath filenames dirs\n  when (not b) $\n    verror ForceFiles (\"cannot find any of \" ++ show filenames ++\n                       \" on library path\")\n\ndoesFileExistOnPath :: [FilePath] -> [FilePath] -> IO Bool\ndoesFileExistOnPath filenames paths = anyM doesFileExist fullFilenames\n  where fullFilenames = [ path </> filename\n                        | filename <- filenames\n                        , path <- paths ]\n\n-- | Perform validation checks (module file existence checks) on the\n-- @hidden-modules@ field.\ncheckOtherModules :: InstalledPackageInfo -> Validate ()\ncheckOtherModules pkg = mapM_ (checkModuleFile pkg) (hiddenModules pkg)\n\n-- | Perform validation checks (module file existence checks and module\n-- reexport checks) on the @exposed-modules@ field.\ncheckExposedModules :: PackageDBStack -> InstalledPackageInfo -> Validate ()\ncheckExposedModules db_stack pkg =\n  mapM_ checkExposedModule (exposedModules pkg)\n  where\n    checkExposedModule (ExposedModule modl reexport) = do\n      let checkOriginal = checkModuleFile pkg modl\n          checkReexport = checkModule \"module reexport\" db_stack pkg\n      maybe checkOriginal checkReexport reexport\n\n-- | Validates the existence of an appropriate @hi@ file associated with\n-- a module.  Used for both @hidden-modules@ and @exposed-modules@ which\n-- are not reexports.\ncheckModuleFile :: InstalledPackageInfo -> ModuleName -> Validate ()\ncheckModuleFile pkg modl =\n      -- there's no interface file for GHC.Prim\n      unless (modl == ModuleName.fromString \"GHC.Prim\") $ do\n      let files = [ ModuleName.toFilePath modl <.> extension\n                  | extension <- [\"hi\", \"p_hi\", \"dyn_hi\" ] ]\n      b <- liftIO $ doesFileExistOnPath files (importDirs pkg)\n      when (not b) $\n         verror ForceFiles (\"cannot find any of \" ++ show files)\n\n-- | Validates that @exposed-modules@ and @hidden-modules@ do not have duplicate\n-- entries.\n-- ToDo: this needs updating for signatures: signatures can validly show up\n-- multiple times in the @exposed-modules@ list as long as their backing\n-- implementations agree.\ncheckDuplicateModules :: InstalledPackageInfo -> Validate ()\ncheckDuplicateModules pkg\n  | null dups = return ()\n  | otherwise = verror ForceAll (\"package has duplicate modules: \" ++\n                                     unwords (map display dups))\n  where\n    dups = [ m | (m:_:_) <- group (sort mods) ]\n    mods = map exposedName (exposedModules pkg) ++ hiddenModules pkg\n\n-- | Validates an original module entry, either the origin of a module reexport\n-- or the backing implementation of a signature, by checking that it exists,\n-- really is an original definition, and is accessible from the dependencies of\n-- the package.\n-- ToDo: If the original module in question is a backing signature\n-- implementation, then we should also check that the original module in\n-- question is NOT a signature (however, if it is a reexport, then it's fine\n-- for the original module to be a signature.)\ncheckModule :: String\n            -> PackageDBStack\n            -> InstalledPackageInfo\n            -> OpenModule\n            -> Validate ()\ncheckModule _ _ _ (OpenModuleVar _) = error \"Impermissible reexport\"\ncheckModule field_name db_stack pkg\n    (OpenModule (DefiniteUnitId def_uid) definingModule) =\n  let definingPkgId = unDefUnitId def_uid\n      mpkg = if definingPkgId == installedUnitId pkg\n              then Just pkg\n              else PackageIndex.lookupUnitId ipix definingPkgId\n  in case mpkg of\n      Nothing\n           -> verror ForceAll (field_name ++ \" refers to a non-existent \" ++\n                               \"defining package: \" ++\n                                       display definingPkgId)\n\n      Just definingPkg\n        | not (isIndirectDependency definingPkgId)\n           -> verror ForceAll (field_name ++ \" refers to a defining \" ++\n                               \"package that is not a direct (or indirect) \" ++\n                               \"dependency of this package: \" ++\n                                       display definingPkgId)\n\n        | otherwise\n        -> case find ((==definingModule).exposedName)\n                     (exposedModules definingPkg) of\n            Nothing ->\n              verror ForceAll (field_name ++ \" refers to a module \" ++\n                               display definingModule ++ \" \" ++\n                               \"that is not exposed in the \" ++\n                               \"defining package \" ++ display definingPkgId)\n            Just (ExposedModule {exposedReexport = Just _} ) ->\n              verror ForceAll (field_name ++ \" refers to a module \" ++\n                               display definingModule ++ \" \" ++\n                               \"that is reexported but not defined in the \" ++\n                               \"defining package \" ++ display definingPkgId)\n            _ -> return ()\n  where\n    all_pkgs = allPackagesInStack db_stack\n    ipix     = PackageIndex.fromList all_pkgs\n\n    isIndirectDependency pkgid = fromMaybe False $ do\n      thispkg  <- graphVertex (installedUnitId pkg)\n      otherpkg <- graphVertex pkgid\n      return (Graph.path depgraph thispkg otherpkg)\n    (depgraph, _, graphVertex) =\n      PackageIndex.dependencyGraph (PackageIndex.insert pkg ipix)\n\ncheckModule _ _ _ (OpenModule (IndefFullUnitId _ _) _) =\n    -- TODO: add some checks here\n    return ()\n\n\n-- ---------------------------------------------------------------------------\n-- expanding environment variables in the package configuration\n\nexpandEnvVars :: String -> Force -> IO String\nexpandEnvVars str0 force = go str0 \"\"\n where\n   go \"\" acc = return $! reverse acc\n   go ('$':'{':str) acc | (var, '}':rest) <- break close str\n        = do value <- lookupEnvVar var\n             go rest (reverse value ++ acc)\n        where close c = c == '}' || c == '\\n' -- don't span newlines\n   go (c:str) acc\n        = go str (c:acc)\n\n   lookupEnvVar :: String -> IO String\n   lookupEnvVar \"pkgroot\"    = return \"${pkgroot}\"    -- these two are special,\n   lookupEnvVar \"pkgrooturl\" = return \"${pkgrooturl}\" -- we don't expand them\n   lookupEnvVar nm =\n        catchIO (System.Environment.getEnv nm)\n           (\\ _ -> do dieOrForceAll force (\"Unable to expand variable \" ++\n                                        show nm)\n                      return \"\")\n\n-----------------------------------------------------------------------------\n\ngetProgramName :: IO String\ngetProgramName = liftM (`withoutSuffix` \".bin\") getProgName\n   where str `withoutSuffix` suff\n            | suff `isSuffixOf` str = take (length str - length suff) str\n            | otherwise             = str\n\nbye :: String -> IO a\nbye s = putStr s >> exitWith ExitSuccess\n\ndie :: String -> IO a\ndie = dieWith 1\n\ndieWith :: Int -> String -> IO a\ndieWith ec s = do\n  prog <- getProgramName\n  reportError (prog ++ \": \" ++ s)\n  exitWith (ExitFailure ec)\n\ndieOrForceAll :: Force -> String -> IO ()\ndieOrForceAll ForceAll s = ignoreError s\ndieOrForceAll _other s   = dieForcible s\n\nwarn :: String -> IO ()\nwarn = reportError\n\n-- send info messages to stdout\ninfoLn :: String -> IO ()\ninfoLn = putStrLn\n\ninfo :: String -> IO ()\ninfo = putStr\n\nignoreError :: String -> IO ()\nignoreError s = reportError (s ++ \" (ignoring)\")\n\nreportError :: String -> IO ()\nreportError s = do hFlush stdout; hPutStrLn stderr s\n\ndieForcible :: String -> IO ()\ndieForcible s = die (s ++ \" (use --force to override)\")\n\n-----------------------------------------\n-- Cut and pasted from ghc/compiler/main/SysTools\n\ngetLibDir :: IO (Maybe String)\n\n#if defined(mingw32_HOST_OS) || defined(darwin_HOST_OS) || defined(linux_HOST_OS)\ngetLibDir = Just . (\\p -> p </> \"lib\") . takeDirectory . takeDirectory <$> getExecutablePath\n#else\ngetLibDir = return Nothing\n#endif\n\n-----------------------------------------\n-- Adapted from ghc/compiler/utils/Panic\n\ninstallSignalHandlers :: IO ()\ninstallSignalHandlers = do\n  threadid <- myThreadId\n  let\n      interrupt = Exception.throwTo threadid\n                                    (Exception.ErrorCall \"interrupted\")\n  --\n#if !defined(mingw32_HOST_OS)\n  _ <- installHandler sigQUIT (Catch interrupt) Nothing\n  _ <- installHandler sigINT  (Catch interrupt) Nothing\n  return ()\n#else\n  -- GHC 6.3+ has support for console events on Windows\n  -- NOTE: running GHCi under a bash shell for some reason requires\n  -- you to press Ctrl-Break rather than Ctrl-C to provoke\n  -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know\n  -- why --SDM 17/12/2004\n  let sig_handler ControlC = interrupt\n      sig_handler Break    = interrupt\n      sig_handler _        = return ()\n\n  _ <- installHandler (Catch sig_handler)\n  return ()\n#endif\n\ncatchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\ncatchIO = Exception.catch\n\ntryIO :: IO a -> IO (Either Exception.IOException a)\ntryIO = Exception.try\n\n-- removeFileSave doesn't throw an exceptions, if the file is already deleted\nremoveFileSafe :: FilePath -> IO ()\nremoveFileSafe fn =\n  removeFile fn `catchIO` \\ e ->\n    when (not $ isDoesNotExistError e) $ ioError e\n\n-- | Turn a path relative to the current directory into a (normalised)\n-- absolute path.\nabsolutePath :: FilePath -> IO FilePath\nabsolutePath path = return . normalise . (</> path) =<< getCurrentDirectory\n", "num_lines": 2235}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "---------------------------------------------------------\n-- The main program for the hpc-add tool, part of HPC.\n-- Andy Gill, Oct 2006\n---------------------------------------------------------\n\nmodule HpcCombine (sum_plugin,combine_plugin,map_plugin) where\n\nimport Trace.Hpc.Tix\nimport Trace.Hpc.Util\n\nimport HpcFlags\n\nimport Control.Monad\nimport qualified Data.Set as Set\nimport qualified Data.Map as Map\n\n------------------------------------------------------------------------------\nsum_options :: FlagOptSeq\nsum_options\n        = excludeOpt\n        . includeOpt\n        . outputOpt\n        . unionModuleOpt\n        . verbosityOpt\n\nsum_plugin :: Plugin\nsum_plugin = Plugin { name = \"sum\"\n                    , usage = \"[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]\"\n                    , options = sum_options\n                    , summary = \"Sum multiple .tix files in a single .tix file\"\n                    , implementation = sum_main\n                    , init_flags = default_flags\n                    , final_flags = default_final_flags\n                    }\n\ncombine_options :: FlagOptSeq\ncombine_options\n        = excludeOpt\n        . includeOpt\n        . outputOpt\n        . combineFunOpt\n        . combineFunOptInfo\n        . unionModuleOpt\n        . verbosityOpt\n\ncombine_plugin :: Plugin\ncombine_plugin = Plugin { name = \"combine\"\n                        , usage = \"[OPTION] .. <TIX_FILE> <TIX_FILE>\"\n                        , options = combine_options\n                        , summary = \"Combine two .tix files in a single .tix file\"\n                        , implementation = combine_main\n                        , init_flags = default_flags\n                        , final_flags = default_final_flags\n                        }\n\nmap_options :: FlagOptSeq\nmap_options\n        = excludeOpt\n        . includeOpt\n        . outputOpt\n        . mapFunOpt\n        . mapFunOptInfo\n        . unionModuleOpt\n        . verbosityOpt\n\nmap_plugin :: Plugin\nmap_plugin = Plugin { name = \"map\"\n                    , usage = \"[OPTION] .. <TIX_FILE> \"\n                    , options = map_options\n                    , summary = \"Map a function over a single .tix file\"\n                    , implementation = map_main\n                    , init_flags = default_flags\n                    , final_flags = default_final_flags\n                    }\n\n------------------------------------------------------------------------------\n\nsum_main :: Flags -> [String] -> IO ()\nsum_main _     [] = hpcError sum_plugin $ \"no .tix file specified\"\nsum_main flags (first_file:more_files) = do\n  Just tix <- readTix first_file\n\n  tix' <- foldM (mergeTixFile flags (+))\n                (filterTix flags tix)\n                more_files\n\n  case outputFile flags of\n    \"-\" -> putStrLn (show tix')\n    out -> writeTix out tix'\n\ncombine_main :: Flags -> [String] -> IO ()\ncombine_main flags [first_file,second_file] = do\n  let f = theCombineFun (combineFun flags)\n\n  Just tix1 <- readTix first_file\n  Just tix2 <- readTix second_file\n\n  let tix = mergeTix (mergeModule flags)\n                     f\n                     (filterTix flags tix1)\n                     (filterTix flags tix2)\n\n  case outputFile flags of\n    \"-\" -> putStrLn (show tix)\n    out -> writeTix out tix\ncombine_main _     _ = hpcError combine_plugin $ \"need exactly two .tix files to combine\"\n\nmap_main :: Flags -> [String] -> IO ()\nmap_main flags [first_file] = do\n  let f = thePostFun (postFun flags)\n\n  Just tix <- readTix first_file\n\n  let (Tix inside_tix) = filterTix flags tix\n  let tix' = Tix [ TixModule m p i (map f t)\n                 | TixModule m p i t <- inside_tix\n                 ]\n\n  case outputFile flags of\n    \"-\" -> putStrLn (show tix')\n    out -> writeTix out tix'\nmap_main _     [] = hpcError map_plugin $ \"no .tix file specified\"\nmap_main _     _  = hpcError map_plugin $ \"to many .tix files specified\"\n\nmergeTixFile :: Flags -> (Integer -> Integer -> Integer) -> Tix -> String -> IO Tix\nmergeTixFile flags fn tix file_name = do\n  Just new_tix <- readTix file_name\n  return $! strict $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix)\n\n-- could allow different numbering on the module info,\n-- as long as the total is the same; will require normalization.\n\nmergeTix :: MergeFun\n         -> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix\nmergeTix modComb f\n         (Tix t1)\n         (Tix t2)  = Tix\n         [ case (Map.lookup m fm1,Map.lookup m fm2) of\n           -- todo, revisit the semantics of this combination\n            (Just (TixModule _ hash1 len1 tix1),Just (TixModule _ hash2 len2 tix2))\n               | hash1 /= hash2\n               || length tix1 /= length tix2\n               || len1 /= length tix1\n               || len2 /= length tix2\n                     -> error $ \"mismatched in module \" ++ m\n               | otherwise      ->\n                     TixModule m hash1 len1 (zipWith f tix1 tix2)\n            (Just m1,Nothing) ->\n                  m1\n            (Nothing,Just m2) ->\n                  m2\n            _ -> error \"impossible\"\n         | m <- Set.toList (theMergeFun modComb m1s m2s)\n         ]\n  where\n   m1s = Set.fromList $ map tixModuleName t1\n   m2s = Set.fromList $ map tixModuleName t2\n\n   fm1 = Map.fromList [ (tixModuleName tix,tix)\n                      | tix <- t1\n                      ]\n   fm2 = Map.fromList [ (tixModuleName tix,tix)\n                      | tix <- t2\n                      ]\n\n\n-- What I would give for a hyperstrict :-)\n-- This makes things about 100 times faster.\nclass Strict a where\n   strict :: a -> a\n\ninstance Strict Integer where\n   strict i = i\n\ninstance Strict Int where\n   strict i = i\n\ninstance Strict Hash where      -- should be fine, because Hash is a newtype round an Int\n   strict i = i\n\ninstance Strict Char where\n   strict i = i\n\ninstance Strict a => Strict [a] where\n   strict (a:as) = (((:) $! strict a) $! strict as)\n   strict []     = []\n\ninstance (Strict a, Strict b) => Strict (a,b) where\n   strict (a,b) = (((,) $! strict a) $! strict b)\n\ninstance Strict Tix where\n  strict (Tix t1) =\n            Tix $! strict t1\n\ninstance Strict TixModule where\n  strict (TixModule m1 p1 i1 t1) =\n            ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1)\n\n", "num_lines": 199}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HpcDraft (draft_plugin) where\n\nimport Trace.Hpc.Tix\nimport Trace.Hpc.Mix\nimport Trace.Hpc.Util\n\nimport HpcFlags\n\nimport qualified Data.Set as Set\nimport qualified Data.Map as Map\nimport HpcUtils\nimport Data.Tree\n\n------------------------------------------------------------------------------\ndraft_options :: FlagOptSeq\ndraft_options\n        = excludeOpt\n        . includeOpt\n        . srcDirOpt\n        . hpcDirOpt\n        . resetHpcDirsOpt\n        . outputOpt\n        . verbosityOpt\n\ndraft_plugin :: Plugin\ndraft_plugin = Plugin { name = \"draft\"\n                       , usage = \"[OPTION] .. <TIX_FILE>\"\n                       , options = draft_options\n                       , summary = \"Generate draft overlay that provides 100% coverage\"\n                       , implementation = draft_main\n                       , init_flags = default_flags\n                       , final_flags = default_final_flags\n                       }\n\n------------------------------------------------------------------------------\n\ndraft_main :: Flags -> [String] -> IO ()\ndraft_main _        []              = error \"draft_main: unhandled case: []\"\ndraft_main hpcflags (progName:mods) = do\n  let hpcflags1 = hpcflags\n                { includeMods = Set.fromList mods\n                                   `Set.union`\n                                includeMods hpcflags }\n  let prog = getTixFileName $ progName\n  tix <- readTix prog\n  case tix of\n    Just (Tix tickCounts) -> do\n        outs <- sequence\n                      [ makeDraft hpcflags1 tixModule\n                      | tixModule@(TixModule m _ _ _) <- tickCounts\n                      , allowModule hpcflags1 m\n                      ]\n        case outputFile hpcflags1 of\n         \"-\" -> putStrLn (unlines outs)\n         out -> writeFile out (unlines outs)\n    Nothing -> hpcError draft_plugin $ \"unable to find tix file for:\" ++ progName\n\n\nmakeDraft :: Flags -> TixModule -> IO String\nmakeDraft hpcflags tix = do\n  let modu = tixModuleName tix\n      tixs = tixModuleTixs tix\n\n  (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix)\n\n  let forest = createMixEntryDom\n              [ (srcspan,(box,v > 0))\n              | ((srcspan,box),v) <- zip entries tixs\n              ]\n\n--  let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span)\n--  putStrLn $ drawForest $ map (fmap show) $ forest\n\n  let non_ticked = findNotTickedFromList forest\n\n  hs  <- readFileFromPath (hpcError draft_plugin) filepath (srcDirs hpcflags)\n\n  let hsMap :: Map.Map Int String\n      hsMap = Map.fromList (zip [1..] $ lines hs)\n\n  let quoteString = show\n\n  let firstLine pos = case fromHpcPos pos of\n                        (ln,_,_,_) -> ln\n\n\n  let showPleaseTick :: Int -> PleaseTick -> String\n      showPleaseTick d (TickFun str pos) =\n                     spaces d ++ \"tick function \\\"\" ++ last str ++ \"\\\" \"\n                              ++ \"on line \" ++ show (firstLine pos) ++ \";\"\n      showPleaseTick d (TickExp pos) =\n                     spaces d ++ \"tick \"\n                              ++ if '\\n' `elem` txt\n                                 then \"at position \" ++ show pos ++ \";\"\n                                 else quoteString txt ++ \" \"  ++ \"on line \" ++ show (firstLine pos) ++ \";\"\n\n          where\n                  txt = grabHpcPos hsMap pos\n\n      showPleaseTick d (TickInside [str] _ pleases) =\n                     spaces d ++ \"inside \\\"\" ++ str ++ \"\\\" {\\n\" ++\n                     showPleaseTicks (d + 2) pleases ++\n                     spaces d ++ \"}\"\n\n      showPleaseTick _ (TickInside _ _ _)\n          = error \"showPleaseTick: Unhandled case TickInside\"\n\n      showPleaseTicks d pleases = unlines (map (showPleaseTick d) pleases)\n\n      spaces d = take d (repeat ' ')\n\n  return $ \"module \" ++ show (fixPackageSuffix modu) ++ \" {\\n\" ++\n         showPleaseTicks 2 non_ticked ++ \"}\"\n\nfixPackageSuffix :: String -> String\nfixPackageSuffix modu = case span (/= '/') modu of\n                        (before,'/':after) -> before ++ \":\" ++ after\n                        _                  -> modu\n\ndata PleaseTick\n   = TickFun [String] HpcPos\n   | TickExp HpcPos\n   | TickInside [String] HpcPos [PleaseTick]\n    deriving Show\n\nmkTickInside :: [String] -> HpcPos -> [PleaseTick]\n             -> [PleaseTick] -> [PleaseTick]\nmkTickInside _ _ []        = id\nmkTickInside nm pos inside = (TickInside nm pos inside :)\n\nfindNotTickedFromTree :: MixEntryDom [(BoxLabel,Bool)] -> [PleaseTick]\nfindNotTickedFromTree (Node (pos,(ExpBox {},False):_) _) = [TickExp pos]\nfindNotTickedFromTree (Node (pos,(TopLevelBox nm,False):_) _)\n  = [ TickFun nm pos ]\nfindNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _)\n  = [ TickFun nm pos ]\nfindNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children)\n  = mkTickInside nm pos (findNotTickedFromList children) []\nfindNotTickedFromTree (Node (pos,_:others) children) =\n                      findNotTickedFromTree (Node (pos,others) children)\nfindNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children\n\nfindNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick]\nfindNotTickedFromList = concatMap findNotTickedFromTree\n\n", "num_lines": 146}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) 2007 Andy Gill\n\nmodule HpcFlags where\n\nimport System.Console.GetOpt\nimport qualified Data.Set as Set\nimport Data.Char\nimport Trace.Hpc.Tix\nimport Trace.Hpc.Mix\nimport System.Exit\nimport System.FilePath\n\ndata Flags = Flags\n  { outputFile          :: String\n  , includeMods         :: Set.Set String\n  , excludeMods         :: Set.Set String\n  , hpcDirs             :: [String]\n  , srcDirs             :: [String]\n  , destDir             :: String\n\n  , perModule           :: Bool\n  , decList             :: Bool\n  , xmlOutput           :: Bool\n\n  , funTotals           :: Bool\n  , altHighlight        :: Bool\n\n  , combineFun          :: CombineFun   -- tick-wise combine\n  , postFun             :: PostFun      --\n  , mergeModule         :: MergeFun     -- module-wise merge\n\n  , verbosity           :: Verbosity\n  }\n\ndefault_flags :: Flags\ndefault_flags = Flags\n  { outputFile          = \"-\"\n  , includeMods         = Set.empty\n  , excludeMods         = Set.empty\n  , hpcDirs             = [\".hpc\"]\n  , srcDirs             = []\n  , destDir             = \".\"\n\n  , perModule           = False\n  , decList             = False\n  , xmlOutput           = False\n\n  , funTotals           = False\n  , altHighlight        = False\n\n  , combineFun          = ADD\n  , postFun             = ID\n  , mergeModule         = INTERSECTION\n\n  , verbosity           = Normal\n  }\n\n\ndata Verbosity = Silent | Normal | Verbose\n  deriving (Eq, Ord)\n\nverbosityFromString :: String -> Verbosity\nverbosityFromString \"0\" = Silent\nverbosityFromString \"1\" = Normal\nverbosityFromString \"2\" = Verbose\nverbosityFromString v   = error $ \"unknown verbosity: \" ++ v\n\n\n-- We do this after reading flags, because the defaults\n-- depends on if specific flags we used.\n\ndefault_final_flags :: Flags -> Flags\ndefault_final_flags flags = flags\n  { srcDirs = if null (srcDirs flags)\n              then [\".\"]\n              else srcDirs flags\n  }\n\ntype FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)]\n\nnoArg :: String -> String -> (Flags -> Flags) -> FlagOptSeq\nnoArg flag detail fn = (:) $ Option [] [flag] (NoArg $ fn) detail\n\nanArg :: String -> String -> String -> (String -> Flags -> Flags) -> FlagOptSeq\nanArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail\n\ninfoArg :: String -> FlagOptSeq\ninfoArg info = (:) $ Option [] [] (NoArg $ id) info\n\nexcludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt,\n    destDirOpt, outputOpt, verbosityOpt,\n    perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt,\n    altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt,\n    mapFunOptInfo, unionModuleOpt :: FlagOptSeq\nexcludeOpt      = anArg \"exclude\"    \"exclude MODULE and/or PACKAGE\" \"[PACKAGE:][MODULE]\"\n                $ \\ a f -> f { excludeMods = a `Set.insert` excludeMods f }\n\nincludeOpt      = anArg \"include\"    \"include MODULE and/or PACKAGE\" \"[PACKAGE:][MODULE]\"\n                $ \\ a f -> f { includeMods = a `Set.insert` includeMods f }\n\nhpcDirOpt       = anArg \"hpcdir\"     \"append sub-directory that contains .mix files\" \"DIR\"\n                   (\\ a f -> f { hpcDirs = hpcDirs f ++ [a] })\n                .  infoArg \"default .hpc [rarely used]\"\n\nresetHpcDirsOpt = noArg \"reset-hpcdirs\" \"empty the list of hpcdir's\"\n                   (\\ f -> f { hpcDirs = [] })\n                .  infoArg \"[rarely used]\"\n\nsrcDirOpt       = anArg \"srcdir\"     \"path to source directory of .hs files\" \"DIR\"\n                  (\\ a f -> f { srcDirs = srcDirs f ++ [a] })\n                . infoArg \"multi-use of srcdir possible\"\n\ndestDirOpt      = anArg \"destdir\"   \"path to write output to\" \"DIR\"\n                $ \\ a f -> f { destDir = a }\n\n\noutputOpt     = anArg \"output\"    \"output FILE\" \"FILE\"        $ \\ a f -> f { outputFile = a }\n\nverbosityOpt  = anArg \"verbosity\" \"verbosity level, 0-2\" \"[0-2]\"\n                (\\ a f -> f { verbosity  = verbosityFromString a })\n              . infoArg \"default 1\"\n\n-- markup\n\nperModuleOpt  = noArg \"per-module\" \"show module level detail\" $ \\ f -> f { perModule = True }\ndecListOpt    = noArg \"decl-list\"  \"show unused decls\"        $ \\ f -> f { decList = True }\nxmlOutputOpt  = noArg \"xml-output\" \"show output in XML\"       $ \\ f -> f { xmlOutput = True }\nfunTotalsOpt  = noArg \"fun-entry-count\" \"show top-level function entry counts\"\n                                                              $ \\ f -> f { funTotals = True }\naltHighlightOpt\n              = noArg \"highlight-covered\" \"highlight covered code, rather that code gaps\"\n                                                              $ \\ f -> f { altHighlight = True }\n\ncombineFunOpt = anArg \"function\"\n                      \"combine .tix files with join function, default = ADD\" \"FUNCTION\"\n              $ \\ a f -> case reads (map toUpper a) of\n                          [(c,\"\")] -> f { combineFun = c }\n                          _ -> error $ \"no such combine function : \" ++ a\ncombineFunOptInfo = infoArg\n                  $ \"FUNCTION = \" ++ foldr1 (\\ a b -> a ++ \" | \" ++ b) (map fst foldFuns)\n\nmapFunOpt = anArg \"function\"\n                      \"apply function to .tix files, default = ID\" \"FUNCTION\"\n              $ \\ a f -> case reads (map toUpper a) of\n                          [(c,\"\")] -> f { postFun = c }\n                          _ -> error $ \"no such combine function : \" ++ a\nmapFunOptInfo = infoArg\n                  $ \"FUNCTION = \" ++ foldr1 (\\ a b -> a ++ \" | \" ++ b) (map fst postFuns)\n\nunionModuleOpt = noArg \"union\"\n                      \"use the union of the module namespace (default is intersection)\"\n              $ \\ f -> f { mergeModule = UNION }\n\n\n-------------------------------------------------------------------------------\n\nreadMixWithFlags :: Flags -> Either String TixModule -> IO Mix\nreadMixWithFlags flags modu = readMix [ dir </> hpcDir\n                                      | dir <- srcDirs flags\n                                      , hpcDir <- hpcDirs flags\n                                      ] modu\n\n-------------------------------------------------------------------------------\n\ncommand_usage :: Plugin -> IO ()\ncommand_usage plugin =\n  putStrLn $\n                                       \"Usage: hpc \" ++ (name plugin) ++ \" \" ++\n                                        (usage plugin) ++\n                                        \"\\n\" ++ summary plugin ++ \"\\n\" ++\n                                        if null (options plugin [])\n                                        then \"\"\n                                        else usageInfo \"\\n\\nOptions:\\n\" (options plugin [])\n\nhpcError :: Plugin -> String -> IO a\nhpcError plugin msg = do\n   putStrLn $ \"Error: \" ++ msg\n   command_usage plugin\n   exitFailure\n\n-------------------------------------------------------------------------------\n\ndata Plugin = Plugin { name           :: String\n                     , usage          :: String\n                     , options        :: FlagOptSeq\n                     , summary        :: String\n                     , implementation :: Flags -> [String] -> IO ()\n                     , init_flags     :: Flags\n                     , final_flags    :: Flags -> Flags\n                     }\n\n------------------------------------------------------------------------------\n\n-- filterModules takes a list of candidate modules,\n-- and\n--  * excludes the excluded modules\n--  * includes the rest if there are no explicitly included modules\n--  * otherwise, accepts just the included modules.\n\nallowModule :: Flags -> String -> Bool\nallowModule flags full_mod\n      | full_mod' `Set.member` excludeMods flags = False\n      | pkg_name  `Set.member` excludeMods flags = False\n      | mod_name  `Set.member` excludeMods flags = False\n      | Set.null (includeMods flags)             = True\n      | full_mod' `Set.member` includeMods flags = True\n      | pkg_name  `Set.member` includeMods flags = True\n      | mod_name  `Set.member` includeMods flags = True\n      | otherwise                                = False\n  where\n          full_mod' = pkg_name ++ mod_name\n      -- pkg name always ends with '/', main\n          (pkg_name,mod_name) =\n                        case span (/= '/') full_mod of\n                     (p,'/':m) -> (p ++ \":\",m)\n                     (m,[])    -> (\":\",m)\n                     _         -> error \"impossible case in allowModule\"\n\nfilterTix :: Flags -> Tix -> Tix\nfilterTix flags (Tix tixs) =\n     Tix $ filter (allowModule flags . tixModuleName) tixs\n\n\n\n------------------------------------------------------------------------------\n-- HpcCombine specifics\n\ndata CombineFun = ADD | DIFF | SUB\n     deriving (Eq,Show, Read, Enum)\n\ntheCombineFun :: CombineFun -> Integer -> Integer -> Integer\ntheCombineFun fn = case fn of\n            ADD  -> \\ l r -> l + r\n            SUB  -> \\ l r -> max 0 (l - r)\n            DIFF -> \\ g b -> if g > 0 then 0 else min 1 b\n\nfoldFuns :: [ (String,CombineFun) ]\nfoldFuns = [ (show comb,comb)\n           | comb <- [ADD .. SUB]\n           ]\n\ndata PostFun = ID | INV | ZERO\n     deriving (Eq,Show, Read, Enum)\n\nthePostFun :: PostFun -> Integer -> Integer\nthePostFun ID   x = x\nthePostFun INV  0 = 1\nthePostFun INV  _ = 0\nthePostFun ZERO _ = 0\n\npostFuns :: [(String, PostFun)]\npostFuns = [ (show pos,pos)\n             | pos <- [ID .. ZERO]\n           ]\n\n\ndata MergeFun = INTERSECTION | UNION\n     deriving (Eq,Show, Read, Enum)\n\ntheMergeFun :: (Ord a) => MergeFun -> Set.Set a -> Set.Set a -> Set.Set a\ntheMergeFun INTERSECTION = Set.intersection\ntheMergeFun UNION        = Set.union\n\nmergeFuns :: [(String, MergeFun)]\nmergeFuns = [ (show pos,pos)\n             | pos <- [INTERSECTION,UNION]\n           ]\n\n", "num_lines": 269}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HpcLexer where\n\nimport Data.Char\n\ndata Token\n        = ID String\n        | SYM Char\n        | INT Int\n        | STR String\n        | CAT String\n        deriving (Eq,Show)\n\ninitLexer :: String -> [Token]\ninitLexer str = [ t | (_,_,t) <- lexer str 1 1 ]\n\nlexer :: String -> Int -> Int ->  [(Int,Int,Token)]\nlexer (c:cs) line column\n  | c == '\\n' = lexer cs (succ line) 1\n  | c == '\\\"' = lexerSTR cs line (succ column)\n  | c == '[' = lexerCAT cs \"\" line (succ column)\n  | c `elem` \"{};-:\"\n              = (line,column,SYM c) : lexer cs line (succ column)\n  | isSpace c = lexer cs        line (succ column)\n  | isAlpha c = lexerKW  cs [c] line (succ column)\n  | isDigit c = lexerINT cs [c] line (succ column)\n  | otherwise = error \"lexer failure\"\nlexer [] _ _ = []\n\nlexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)]\nlexerKW  (c:cs) s line column\n  | isAlpha c = lexerKW cs (s ++ [c]) line (succ column)\nlexerKW  other s line column = (line,column,ID s) : lexer other line column\n\nlexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)]\nlexerINT  (c:cs) s line column\n  | isDigit c = lexerINT cs (s ++ [c]) line (succ column)\nlexerINT  other s line column = (line,column,INT (read s)) : lexer other line column\n\n-- not technically correct for the new column count, but a good approximation.\nlexerSTR :: String -> Int -> Int -> [(Int,Int,Token)]\nlexerSTR cs line column\n  = case lex ('\"' : cs) of\n      [(str,rest)] -> (line,succ column,STR (read str))\n                   : lexer rest line (length (show str) + column + 1)\n      _ -> error \"bad string\"\n\nlexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)]\nlexerCAT (c:cs) s line column\n  | c == ']'  =  (line,column,CAT s) : lexer cs line (succ column)\n  | otherwise = lexerCAT cs (s ++ [c]) line (succ column)\nlexerCAT  [] _ _ _ = error \"lexer failure in CAT\"\n\ntest :: IO ()\ntest = do\n          t <- readFile \"EXAMPLE.tc\"\n          print (initLexer t)\n\n", "num_lines": 58}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "---------------------------------------------------------\n-- The main program for the hpc-markup tool, part of HPC.\n-- Andy Gill and Colin Runciman, June 2006\n---------------------------------------------------------\n\nmodule HpcMarkup (markup_plugin) where\n\nimport Trace.Hpc.Mix\nimport Trace.Hpc.Tix\nimport Trace.Hpc.Util\n\nimport HpcFlags\nimport HpcUtils\n\nimport System.Directory\nimport System.FilePath\nimport System.IO (localeEncoding)\nimport Data.List\nimport Data.Maybe(fromJust)\nimport Data.Semigroup as Semi\nimport Data.Array\nimport Control.Monad\nimport qualified Data.Set as Set\n\n------------------------------------------------------------------------------\n\nmarkup_options :: FlagOptSeq\nmarkup_options\n        = excludeOpt\n        . includeOpt\n        . srcDirOpt\n        . hpcDirOpt\n        . resetHpcDirsOpt\n        . funTotalsOpt\n        . altHighlightOpt\n        . destDirOpt\n        . verbosityOpt\n\nmarkup_plugin :: Plugin\nmarkup_plugin = Plugin { name = \"markup\"\n                       , usage = \"[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]\"\n                       , options = markup_options\n                       , summary = \"Markup Haskell source with program coverage\"\n                       , implementation = markup_main\n                       , init_flags = default_flags\n                       , final_flags = default_final_flags\n                       }\n\n------------------------------------------------------------------------------\n\nmarkup_main :: Flags -> [String] -> IO ()\nmarkup_main flags (prog:modNames) = do\n  let hpcflags1 = flags\n                { includeMods = Set.fromList modNames\n                                   `Set.union`\n                                includeMods flags }\n  let Flags\n       { funTotals = theFunTotals\n       , altHighlight = invertOutput\n       , destDir = dest_dir\n       }  = hpcflags1\n\n  mtix <- readTix (getTixFileName prog)\n  Tix tixs <- case mtix of\n    Nothing -> hpcError markup_plugin $ \"unable to find tix file for: \" ++ prog\n    Just a -> return a\n\n  mods <-\n     sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput\n              | tix <- tixs\n              , allowModule hpcflags1 (tixModuleName tix)\n              ]\n\n  let index_name = \"hpc_index\"\n      index_fun  = \"hpc_index_fun\"\n      index_alt  = \"hpc_index_alt\"\n      index_exp  = \"hpc_index_exp\"\n\n  let writeSummary filename cmp = do\n        let mods' = sortBy cmp mods\n\n        unless (verbosity flags < Normal) $\n            putStrLn $ \"Writing: \" ++ (filename <.> \"html\")\n\n        writeFileUsing (dest_dir </> filename <.> \"html\") $\n            \"<html>\" ++\n            \"<head>\" ++\n            charEncodingTag ++\n            \"<style type=\\\"text/css\\\">\" ++\n            \"table.bar { background-color: #f25913; }\\n\" ++\n            \"td.bar { background-color: #60de51;  }\\n\" ++\n            \"td.invbar { background-color: #f25913;  }\\n\" ++\n            \"table.dashboard { border-collapse: collapse  ; border: solid 1px black }\\n\" ++\n            \".dashboard td { border: solid 1px black }\\n\" ++\n            \".dashboard th { border: solid 1px black }\\n\" ++\n            \"</style>\\n\" ++\n            \"</head>\" ++\n            \"<body>\" ++\n            \"<table class=\\\"dashboard\\\" width=\\\"100%\\\" border=1>\\n\" ++\n            \"<tr>\" ++\n            \"<th rowspan=2><a href=\\\"\" ++ index_name ++ \".html\\\">module</a></th>\" ++\n            \"<th colspan=3><a href=\\\"\" ++ index_fun ++ \".html\\\">Top Level Definitions</a></th>\" ++\n            \"<th colspan=3><a href=\\\"\" ++ index_alt ++ \".html\\\">Alternatives</a></th>\" ++\n            \"<th colspan=3><a href=\\\"\" ++ index_exp ++ \".html\\\">Expressions</a></th>\" ++\n            \"</tr>\" ++\n            \"<tr>\" ++\n            \"<th>%</th>\" ++\n            \"<th colspan=2>covered / total</th>\" ++\n            \"<th>%</th>\" ++\n            \"<th colspan=2>covered / total</th>\" ++\n            \"<th>%</th>\" ++\n            \"<th colspan=2>covered / total</th>\" ++\n            \"</tr>\" ++\n            concat [ showModuleSummary (modName,fileName,modSummary)\n                   | (modName,fileName,modSummary) <- mods'\n                   ] ++\n            \"<tr></tr>\" ++\n            showTotalSummary (mconcat\n                                 [ modSummary\n                                 | (_,_,modSummary) <- mods'\n                                 ])\n                   ++ \"</table></body></html>\\n\"\n\n  writeSummary index_name  $ \\ (n1,_,_) (n2,_,_) -> compare n1 n2\n\n  writeSummary index_fun $ \\ (_,_,s1) (_,_,s2) ->\n        compare (percent (topFunTicked s2) (topFunTotal s2))\n                (percent (topFunTicked s1) (topFunTotal s1))\n\n  writeSummary index_alt $ \\ (_,_,s1) (_,_,s2) ->\n        compare (percent (altTicked s2) (altTotal s2))\n                (percent (altTicked s1) (altTotal s1))\n\n  writeSummary index_exp $ \\ (_,_,s1) (_,_,s2) ->\n        compare (percent (expTicked s2) (expTotal s2))\n                (percent (expTicked s1) (expTotal s1))\n\n\nmarkup_main _ []\n    = hpcError markup_plugin $ \"no .tix file or executable name specified\"\n\ncharEncodingTag :: String\ncharEncodingTag =\n    \"<meta http-equiv=\\\"Content-Type\\\" \" ++\n          \"content=\\\"text/html; \" ++ \"charset=\" ++ show localeEncoding ++ \"\\\">\"\n\n-- Add characters to the left of a string until it is at least as\n-- large as requested.\npadLeft :: Int -> Char -> String -> String\npadLeft n c str = go n str\n  where\n    -- If the string is already long enough, stop traversing it.\n    go 0 _       = str\n    go k []      = replicate k c ++ str\n    go k (_:xs)  = go (k-1) xs\n\ngenHtmlFromMod\n  :: String\n  -> Flags\n  -> TixModule\n  -> Bool\n  -> Bool\n  -> IO (String, [Char], ModuleSummary)\ngenHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do\n  let theHsPath = srcDirs flags\n  let modName0 = tixModuleName tix\n\n  (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix)\n\n  let arr_tix :: Array Int Integer\n      arr_tix = listArray (0,length (tixModuleTixs tix) - 1)\n              $ tixModuleTixs tix\n\n  let tickedWith :: Int -> Integer\n      tickedWith n = arr_tix ! n\n\n      isTicked n = tickedWith n /= 0\n\n  let info = [ (pos,theMarkup)\n             | (gid,(pos,boxLabel)) <- zip [0 ..] mix'\n             , let binBox = case (isTicked gid,isTicked (gid+1)) of\n                               (False,False) -> []\n                               (True,False)  -> [TickedOnlyTrue]\n                               (False,True)  -> [TickedOnlyFalse]\n                               (True,True)   -> []\n             , let tickBox = if isTicked gid\n                             then [IsTicked]\n                             else [NotTicked]\n             , theMarkup <- case boxLabel of\n                                  ExpBox {} -> tickBox\n                                  TopLevelBox {}\n                                            -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox\n                                  LocalBox {}   -> tickBox\n                                  BinBox _ True -> binBox\n                                  _             -> []\n             ]\n\n\n  let modSummary = foldr (.) id\n             [ \\ st ->\n               case boxLabel of\n                 ExpBox False\n                        -> st { expTicked = ticked (expTicked st)\n                              , expTotal = succ (expTotal st)\n                              }\n                 ExpBox True\n                        -> st { expTicked = ticked (expTicked st)\n                              , expTotal = succ (expTotal st)\n                              , altTicked = ticked (altTicked st)\n                              , altTotal = succ (altTotal st)\n                              }\n                 TopLevelBox _ ->\n                           st { topFunTicked = ticked (topFunTicked st)\n                              , topFunTotal = succ (topFunTotal st)\n                              }\n                 _ -> st\n             | (gid,(_pos,boxLabel)) <- zip [0 ..] mix'\n             , let ticked = if isTicked gid\n                            then succ\n                            else id\n             ] $ mempty\n\n  -- add prefix to modName argument\n  content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath\n\n  let content' = markup tabStop info content\n  let addLine n xs = \"<span class=\\\"lineno\\\">\" ++ padLeft 5 ' ' (show n) ++ \" </span>\" ++ xs\n  let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines\n  let fileName = modName0 <.> \"hs\" <.> \"html\"\n  unless (verbosity flags < Normal) $\n            putStrLn $ \"Writing: \" ++ fileName\n  writeFileUsing (dest_dir </> fileName) $\n            unlines [\"<html>\",\n                     \"<head>\",\n                     charEncodingTag,\n                     \"<style type=\\\"text/css\\\">\",\n                     \"span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }\",\n                     if invertOutput\n                     then \"span.nottickedoff { color: #404040; background: white; font-style: oblique }\"\n                     else \"span.nottickedoff { background: \" ++ yellow ++ \"}\",\n                     if invertOutput\n                     then \"span.istickedoff { color: black; background: #d0c0ff; font-style: normal; }\"\n                     else \"span.istickedoff { background: white }\",\n                     \"span.tickonlyfalse { margin: -1px; border: 1px solid \" ++ red ++ \"; background: \" ++ red ++ \" }\",\n                     \"span.tickonlytrue  { margin: -1px; border: 1px solid \" ++ green ++ \"; background: \" ++ green ++ \" }\",\n                     \"span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }\",\n                     if invertOutput\n                     then \"span.decl { font-weight: bold; background: #d0c0ff }\"\n                     else \"span.decl { font-weight: bold }\",\n                     \"span.spaces    { background: white }\",\n                     \"</style>\",\n                     \"</head>\",\n                     \"<body>\",\n                     \"<pre>\",\n                     concat [\n                         \"<span class=\\\"decl\\\">\",\n                         \"<span class=\\\"nottickedoff\\\">never executed</span> \",\n                         \"<span class=\\\"tickonlytrue\\\">always true</span> \",\n                         \"<span class=\\\"tickonlyfalse\\\">always false</span></span>\"],\n                     \"</pre>\",\n                     \"<pre>\"] ++ addLines content' ++ \"\\n</pre>\\n</body>\\n</html>\\n\";\n\n\n  modSummary `seq` return (modName0,fileName,modSummary)\n\ndata Loc = Loc !Int !Int\n         deriving (Eq,Ord,Show)\n\ndata Markup\n     = NotTicked\n     | TickedOnlyTrue\n     | TickedOnlyFalse\n     | IsTicked\n     | TopLevelDecl\n           Bool     -- display entry totals\n           Integer\n     deriving (Eq,Show)\n\nmarkup    :: Int                -- ^tabStop\n          -> [(HpcPos,Markup)]  -- random list of tick location pairs\n          -> String             -- text to mark up\n          -> String\nmarkup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs\n  where\n    tickLocs = [ (Loc ln1 c1,Loc ln2 c2,mark)\n               | (pos,mark) <- mix\n               , let (ln1,c1,ln2,c2) = fromHpcPos pos\n               ]\n    sortedTickLocs = sortBy (\\(locA1,locZ1,_) (locA2,locZ2,_) ->\n                              (locA1,locZ2) `compare` (locA2,locZ1)) tickLocs\n\naddMarkup :: Int                -- tabStop\n          -> String             -- text to mark up\n          -> Loc                -- current location\n          -> [(Loc,Markup)]     -- stack of open ticks, with closing location\n          -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs\n          -> String\n\n-- check the pre-condition.\n--addMarkup tabStop cs loc os ticks\n--   | not (isSorted (map fst os)) = error $ \"addMarkup: bad closing ordering: \" ++ show os\n\n--addMarkup tabStop cs loc os@(_:_) ticks\n--   | trace (show (loc,os,take 10 ticks)) False = undefined\n\n-- close all open ticks, if we have reached the end\naddMarkup _ [] _loc os [] =\n  concatMap (const closeTick) os\naddMarkup tabStop cs loc ((o,_):os) ticks | loc > o =\n  closeTick ++ addMarkup tabStop cs loc os ticks\n\n--addMarkup tabStop cs loc os ((t1,t2,tik@(TopLevelDecl {})):ticks) | loc == t1 =\n--   openTick tik ++ closeTick ++ addMarkup tabStop cs loc os ticks\n\naddMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 =\n  case os of\n  ((_,tik'):_)\n    | not (allowNesting tik0 tik')\n    -> addMarkup tabStop cs loc os ticks -- already marked or bool within marked bool\n  _ -> openTick tik0 ++ addMarkup tabStop cs loc (addTo (t2,tik0) os) ticks\n where\n\n  addTo (t,tik) []             = [(t,tik)]\n  addTo (t,tik) ((t',tik'):xs) | t <= t'   = (t,tik):(t',tik'):xs\n                               | otherwise = (t',tik):(t',tik'):xs\n\naddMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 =\n          -- throw away this tick, because it is from a previous place ??\n          addMarkup tabStop0 cs loc os ticks\n\naddMarkup tabStop0 ('\\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks\n          | ln == ln2 && col < col2\n          = addMarkup tabStop0 (' ':'\\n':cs) loc os ticks\naddMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks =\n  if c0=='\\n' && os/=[] then\n    concatMap (const closeTick) (downToTopLevel os) ++\n    c0 : \"<span class=\\\"spaces\\\">\" ++ expand 1 w ++ \"</span>\" ++\n    concatMap (openTick.snd) (reverse (downToTopLevel os)) ++\n    addMarkup tabStop0 cs' loc' os ticks\n  else if c0=='\\t' then\n    expand p \"\\t\" ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks\n  else\n    escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks\n  where\n  (w,cs') = span (`elem` \" \\t\") cs\n  loc' = foldl (flip incBy) loc (c0:w)\n  escape '>' = \"&gt;\"\n  escape '<' = \"&lt;\"\n  escape '\"' = \"&quot;\"\n  escape '&' = \"&amp;\"\n  escape c  = [c]\n\n  expand :: Int -> String -> String\n  expand _ \"\"       = \"\"\n  expand c ('\\t':s) = replicate (c' - c) ' ' ++ expand c' s\n    where\n    c' = tabStopAfter 8 c\n  expand c (' ':s)  = ' ' : expand (c+1) s\n  expand _ _        = error \"bad character in string for expansion\"\n\n  incBy :: Char -> Loc -> Loc\n  incBy '\\n' (Loc ln _c) = Loc (succ ln) 1\n  incBy '\\t' (Loc ln c) = Loc ln (tabStopAfter tabStop0 c)\n  incBy _    (Loc ln c) = Loc ln (succ c)\n\n  tabStopAfter :: Int -> Int -> Int\n  tabStopAfter tabStop c = fromJust (find (>c) [1,(tabStop + 1)..])\n\n\naddMarkup tabStop cs loc os ticks = \"ERROR: \" ++ show (take 10 cs,tabStop,loc,take 10 os,take 10 ticks)\n\nopenTick :: Markup -> String\nopenTick NotTicked       = \"<span class=\\\"nottickedoff\\\">\"\nopenTick IsTicked        = \"<span class=\\\"istickedoff\\\">\"\nopenTick TickedOnlyTrue  = \"<span class=\\\"tickonlytrue\\\">\"\nopenTick TickedOnlyFalse = \"<span class=\\\"tickonlyfalse\\\">\"\nopenTick (TopLevelDecl False _) = openTopDecl\nopenTick (TopLevelDecl True 0)\n         = \"<span class=\\\"funcount\\\">-- never entered</span>\" ++\n           openTopDecl\nopenTick (TopLevelDecl True 1)\n         = \"<span class=\\\"funcount\\\">-- entered once</span>\" ++\n           openTopDecl\nopenTick (TopLevelDecl True n0)\n         = \"<span class=\\\"funcount\\\">-- entered \" ++ showBigNum n0 ++ \" times</span>\" ++ openTopDecl\n  where showBigNum n | n <= 9999 = show n\n                     | otherwise = case n `quotRem` 1000 of\n                                     (q, r) -> showBigNum' q ++ \",\" ++ showWith r\n        showBigNum' n | n <= 999 = show n\n                      | otherwise = case n `quotRem` 1000 of\n                                      (q, r) -> showBigNum' q ++ \",\" ++ showWith r\n        showWith n = padLeft 3 '0' $ show n\n\n\n\ncloseTick :: String\ncloseTick = \"</span>\"\n\nopenTopDecl :: String\nopenTopDecl = \"<span class=\\\"decl\\\">\"\n\ndownToTopLevel :: [(Loc,Markup)] -> [(Loc,Markup)]\ndownToTopLevel ((_,TopLevelDecl {}):_) = []\ndownToTopLevel (o : os)               = o : downToTopLevel os\ndownToTopLevel []                     = []\n\n\n-- build in logic for nesting bin boxes\n\nallowNesting :: Markup  -- innermost\n            -> Markup   -- outermost\n            -> Bool\nallowNesting n m               | n == m = False -- no need to double nest\nallowNesting IsTicked TickedOnlyFalse   = False\nallowNesting IsTicked TickedOnlyTrue    = False\nallowNesting _ _                        = True\n\n------------------------------------------------------------------------------\n\ndata ModuleSummary = ModuleSummary\n     { expTicked :: !Int\n     , expTotal  :: !Int\n     , topFunTicked :: !Int\n     , topFunTotal  :: !Int\n     , altTicked :: !Int\n     , altTotal  :: !Int\n     }\n     deriving (Show)\n\n\nshowModuleSummary :: (String, String, ModuleSummary) -> String\nshowModuleSummary (modName,fileName,modSummary) =\n  \"<tr>\\n\" ++\n  \"<td>&nbsp;&nbsp;<tt>module <a href=\\\"\" ++ fileName ++ \"\\\">\"\n                              ++ modName ++ \"</a></tt></td>\\n\" ++\n   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++\n   showSummary (altTicked modSummary) (altTotal modSummary) ++\n   showSummary (expTicked modSummary) (expTotal modSummary) ++\n  \"</tr>\\n\"\n\nshowTotalSummary :: ModuleSummary -> String\nshowTotalSummary modSummary =\n  \"<tr style=\\\"background: #e0e0e0\\\">\\n\" ++\n  \"<th align=left>&nbsp;&nbsp;Program Coverage Total</tt></th>\\n\" ++\n   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++\n   showSummary (altTicked modSummary) (altTotal modSummary) ++\n   showSummary (expTicked modSummary) (expTotal modSummary) ++\n  \"</tr>\\n\"\n\nshowSummary :: (Integral t, Show t) => t -> t -> String\nshowSummary ticked total =\n                \"<td align=\\\"right\\\">\" ++ showP (percent ticked total) ++ \"</td>\" ++\n                \"<td>\" ++ show ticked ++ \"/\" ++ show total ++ \"</td>\" ++\n                \"<td width=100>\" ++\n                    (case percent ticked total of\n                       Nothing -> \"&nbsp;\"\n                       Just w -> bar w \"bar\"\n                     )  ++ \"</td>\"\n     where\n        showP Nothing = \"-&nbsp;\"\n        showP (Just x) = show x ++ \"%\"\n        bar 0 _     = bar 100 \"invbar\"\n        bar w inner = \"<table cellpadding=0 cellspacing=0 width=\\\"100\\\" class=\\\"bar\\\">\" ++\n                         \"<tr><td><table cellpadding=0 cellspacing=0 width=\\\"\" ++ show w ++ \"%\\\">\" ++\n                              \"<tr><td height=12 class=\" ++ show inner ++ \"></td></tr>\" ++\n                              \"</table></td></tr></table>\"\n\npercent :: (Integral a) => a -> a -> Maybe a\npercent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total)\n\ninstance Semi.Semigroup ModuleSummary where\n  (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) <> (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2)\n     = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2)\n\ninstance Monoid ModuleSummary where\n  mempty = ModuleSummary\n                  { expTicked = 0\n                  , expTotal  = 0\n                  , topFunTicked = 0\n                  , topFunTotal  = 0\n                  , altTicked = 0\n                  , altTotal  = 0\n                  }\n  mappend = (<>)\n\n------------------------------------------------------------------------------\n\nwriteFileUsing :: String -> String -> IO ()\nwriteFileUsing filename text = do\n-- We need to check for the dest_dir each time, because we use sub-dirs for\n-- packages, and a single .tix file might contain information about\n-- many package.\n\n  -- create the dest_dir if needed\n  createDirectoryIfMissing True (takeDirectory filename)\n\n  writeFile filename text\n\n------------------------------------------------------------------------------\n-- global color pallete\n\nred,green,yellow :: String\nred    = \"#f20913\"\ngreen  = \"#60de51\"\nyellow = \"yellow\"\n\n", "num_lines": 507}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HpcOverlay where\n\nimport HpcFlags\nimport HpcParser\nimport HpcUtils\nimport Trace.Hpc.Tix\nimport Trace.Hpc.Mix\nimport Trace.Hpc.Util\nimport qualified Data.Map as Map\nimport Data.Tree\n\noverlay_options :: FlagOptSeq\noverlay_options\n        = srcDirOpt\n        . hpcDirOpt\n        . resetHpcDirsOpt\n        . outputOpt\n        . verbosityOpt\n\noverlay_plugin :: Plugin\noverlay_plugin = Plugin { name = \"overlay\"\n                       , usage = \"[OPTION] .. <OVERLAY_FILE> [<OVERLAY_FILE> [...]]\"\n                       , options = overlay_options\n                       , summary = \"Generate a .tix file from an overlay file\"\n                       , implementation = overlay_main\n                       , init_flags = default_flags\n                       , final_flags = default_final_flags\n                       }\n\noverlay_main :: Flags -> [String] -> IO ()\noverlay_main _     [] = hpcError overlay_plugin $ \"no overlay file specified\"\noverlay_main flags files = do\n  specs <- mapM hpcParser files\n  let (Spec globals modules) = concatSpec specs\n\n  let modules1 = Map.fromListWith (++) [ (m,info) | (m,info) <- modules ]\n\n  mod_info <-\n     sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left modu)\n                   content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags)\n                   processModule modu content mix mod_spec globals\n              | (modu, mod_spec) <- Map.toList modules1\n              ]\n\n\n  let tix = Tix $ mod_info\n\n  case outputFile flags of\n    \"-\" -> putStrLn (show tix)\n    out -> writeFile out (show tix)\n\n\nprocessModule :: String         -- ^ module name\n              -> String         -- ^ module contents\n              -> Mix            -- ^ mix entry for this module\n              -> [Tick]         -- ^ local ticks\n              -> [ExprTick]     -- ^ global ticks\n              -> IO TixModule\nprocessModule modName modContents (Mix _ _ hash _ entries) locals globals = do\n\n   let hsMap :: Map.Map Int String\n       hsMap = Map.fromList (zip [1..] $ lines modContents)\n\n   let topLevelFunctions =\n        Map.fromListWith (++)\n                     [ (nm,[pos])\n                     | (pos,TopLevelBox [nm]) <- entries\n                     ]\n\n   let inside :: HpcPos -> String -> Bool\n       inside pos nm =\n                       case Map.lookup nm topLevelFunctions of\n                         Nothing -> False\n                         Just poss -> any (pos `insideHpcPos`) poss\n\n   -- TODO: rename plzTick => plzExprTick, plzTopPick => plzTick\n   let plzTick :: HpcPos -> BoxLabel -> ExprTick -> Bool\n       plzTick pos (ExpBox _) (TickExpression _ match q _)  =\n                     qualifier pos q\n                  && case match of\n                        Nothing -> True\n                        Just str -> str == grabHpcPos hsMap pos\n       plzTick _   _       _ = False\n\n\n       plzTopTick :: HpcPos -> BoxLabel -> Tick -> Bool\n       plzTopTick pos label  (ExprTick ignore)           = plzTick pos label ignore\n       plzTopTick pos _      (TickFunction fn q _)   =\n                    qualifier pos q && pos `inside` fn\n       plzTopTick pos label  (InsideFunction fn igs)   =\n         pos `inside` fn && any (plzTopTick pos label) igs\n\n\n   let tixs = Map.fromList\n              [ (ix,\n                   any (plzTick pos label) globals\n                || any (plzTopTick pos label) locals)\n              | (ix,(pos,label)) <- zip [0..] entries\n              ]\n\n\n   -- let show' (srcspan,stuff) = show (srcspan,stuff,grabHpcPos hsMap span)\n\n   let forest = createMixEntryDom\n              [ (srcspan,ix)\n              | ((srcspan,_),ix) <- zip entries [0..]\n              ]\n\n\n   --\n   let forest2 = addParentToList [] $ forest\n--   putStrLn $ drawForest $ map (fmap show') $ forest2\n\n   let isDomList = Map.fromList\n              [ (ix,filter (/= ix) rng ++ dom)\n              | (_,(rng,dom)) <- concatMap flatten forest2\n              , ix <- rng\n              ]\n\n   -- We do not use laziness here, because the dominator lists\n   -- point to their equivent peers, creating loops.\n\n\n   let isTicked n =\n           case Map.lookup n tixs of\n             Just v -> v\n             Nothing -> error $ \"can not find ix # \" ++ show n\n\n   let tixs' = [ case Map.lookup n isDomList of\n                   Just vs -> if any isTicked (n : vs) then 1 else 0\n                   Nothing -> error $ \"can not find ix in dom list # \" ++ show n\n               | n <- [0..(length entries - 1)]\n               ]\n\n   return $ TixModule modName hash (length tixs') tixs'\n\nqualifier :: HpcPos -> Maybe Qualifier -> Bool\nqualifier _   Nothing = True\nqualifier pos (Just (OnLine n)) = n == l1 && n == l2\n  where (l1,_,l2,_) = fromHpcPos pos\nqualifier pos (Just (AtPosition l1' c1' l2' c2'))\n          = (l1', c1', l2', c2') == fromHpcPos pos\n\nconcatSpec :: [Spec] -> Spec\nconcatSpec = foldr\n               (\\ (Spec pre1 body1) (Spec pre2 body2)\n                     -> Spec (pre1 ++ pre2) (body1 ++ body2))\n                (Spec [] [])\n\n\n\naddParentToTree :: [a] -> MixEntryDom [a] -> MixEntryDom ([a],[a])\naddParentToTree path (Node (pos,a) children) =\n                Node (pos,(a,path)) (addParentToList (a ++ path) children)\n\naddParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])]\naddParentToList path nodes = map (addParentToTree path) nodes\n\n\n", "num_lines": 160}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "---------------------------------------------------------\n-- The main program for the hpc-report tool, part of HPC.\n-- Colin Runciman and Andy Gill, June 2006\n---------------------------------------------------------\n\nmodule HpcReport (report_plugin) where\n\nimport Prelude hiding (exp)\nimport Data.List(sort,intersperse,sortBy)\nimport HpcFlags\nimport Trace.Hpc.Mix\nimport Trace.Hpc.Tix\nimport Control.Monad hiding (guard)\nimport qualified Data.Set as Set\n\nnotExpecting :: String -> a\nnotExpecting s = error (\"not expecting \"++s)\n\ndata BoxTixCounts = BT {boxCount, tixCount :: !Int}\n\nbtZero :: BoxTixCounts\nbtZero = BT {boxCount=0, tixCount=0}\n\nbtPlus :: BoxTixCounts -> BoxTixCounts -> BoxTixCounts\nbtPlus (BT b1 t1) (BT b2 t2) = BT (b1+b2) (t1+t2)\n\nbtPercentage :: String -> BoxTixCounts -> String\nbtPercentage s (BT b t) = showPercentage s t b\n\nshowPercentage :: String -> Int -> Int -> String\nshowPercentage s 0 0 = \"100% \"++s++\" (0/0)\"\nshowPercentage s n d = showWidth 3 p++\"% \"++\n                       s++\n                       \" (\"++show n++\"/\"++show d++\")\"\n  where\n  p = (n*100) `div` d\n  showWidth w x0 = replicate (shortOf w (length sx)) ' ' ++ sx\n                  where\n                  sx = show x0\n                  shortOf x y = if y < x then x-y else 0\n\ndata BinBoxTixCounts = BBT { binBoxCount\n                           , onlyTrueTixCount\n                           , onlyFalseTixCount\n                           , bothTixCount :: !Int}\n\nbbtzero :: BinBoxTixCounts\nbbtzero = BBT { binBoxCount=0\n              , onlyTrueTixCount=0\n              , onlyFalseTixCount=0\n              , bothTixCount=0}\n\nbbtPlus :: BinBoxTixCounts -> BinBoxTixCounts -> BinBoxTixCounts\nbbtPlus (BBT b1 tt1 ft1 bt1) (BBT b2 tt2 ft2 bt2) =\n  BBT (b1+b2) (tt1+tt2) (ft1+ft2) (bt1+bt2)\n\nbbtPercentage :: String -> Bool -> BinBoxTixCounts -> String\nbbtPercentage s withdetail (BBT b tt ft bt) =\n  showPercentage s bt b ++\n  if withdetail && bt/=b then\n    detailFor tt \"always True\"++\n    detailFor ft \"always False\"++\n    detailFor (b-(tt+ft+bt)) \"unevaluated\"\n  else \"\"\n  where\n  detailFor n txt = if n>0 then \", \"++show n++\" \"++txt\n                    else \"\"\n\ndata ModInfo = MI { exp,alt,top,loc :: !BoxTixCounts\n                  , guard,cond,qual :: !BinBoxTixCounts\n                  , decPaths :: [[String]]}\n\nmiZero :: ModInfo\nmiZero = MI { exp=btZero\n            , alt=btZero\n            , top=btZero\n            , loc=btZero\n            , guard=bbtzero\n            , cond=bbtzero\n            , qual=bbtzero\n            , decPaths = []}\n\nmiPlus :: ModInfo -> ModInfo -> ModInfo\nmiPlus mi1 mi2 =\n  MI { exp = exp mi1 `btPlus` exp mi2\n     , alt = alt mi1 `btPlus` alt mi2\n     , top = top mi1 `btPlus` top mi2\n     , loc = loc mi1 `btPlus` loc mi2\n     , guard = guard mi1 `bbtPlus` guard mi2\n     , cond  = cond  mi1 `bbtPlus` cond  mi2\n     , qual  = qual  mi1 `bbtPlus` qual  mi2\n     , decPaths = decPaths mi1 ++ decPaths mi2 }\n\nallBinCounts :: ModInfo -> BinBoxTixCounts\nallBinCounts mi =\n  BBT { binBoxCount = sumAll binBoxCount\n      , onlyTrueTixCount = sumAll onlyTrueTixCount\n      , onlyFalseTixCount = sumAll onlyFalseTixCount\n      , bothTixCount = sumAll bothTixCount }\n  where\n  sumAll f = f (guard mi) + f (cond mi) + f (qual mi)\n\naccumCounts :: [(BoxLabel,Integer)] -> ModInfo -> ModInfo\naccumCounts [] mi = mi\naccumCounts ((bl,btc):etc) mi\n | single bl = accumCounts etc mi'\n  where\n  mi' = case bl of\n        ExpBox False ->   mi{exp = inc (exp mi)}\n        ExpBox True  ->   mi{exp = inc (exp mi), alt = inc (alt mi)}\n        TopLevelBox dp -> mi{top = inc (top mi)\n                            ,decPaths = upd dp (decPaths mi)}\n        LocalBox dp ->    mi{loc = inc (loc mi)\n                            ,decPaths = upd dp (decPaths mi)}\n        _other ->          notExpecting \"BoxLabel in accumcounts\"\n  inc (BT {boxCount=bc,tixCount=tc}) =\n    BT { boxCount = bc+1\n       , tixCount = tc + bit (btc>0) }\n  upd dp dps =\n    if btc>0 then dps else dp:dps\naccumCounts [_] _ = error \"accumCounts: Unhandled case: [_] _\"\naccumCounts ((bl0,btc0):(bl1,btc1):etc) mi =\n  accumCounts etc mi'\n  where\n  mi' = case (bl0,bl1) of\n        (BinBox GuardBinBox True, BinBox GuardBinBox False) ->\n          mi{guard = inc (guard mi)}\n        (BinBox CondBinBox True, BinBox CondBinBox False) ->\n          mi{cond = inc (cond mi)}\n        (BinBox QualBinBox True, BinBox QualBinBox False) ->\n          mi{qual = inc (qual mi)}\n        _other -> notExpecting \"BoxLabel pair in accumcounts\"\n  inc (BBT { binBoxCount=bbc\n           , onlyTrueTixCount=ttc\n           , onlyFalseTixCount=ftc\n           , bothTixCount=btc}) =\n    BBT { binBoxCount       = bbc+1\n        , onlyTrueTixCount  = ttc + bit (btc0 >0 && btc1==0)\n        , onlyFalseTixCount = ftc + bit (btc0==0 && btc1 >0)\n        , bothTixCount      = btc + bit (btc0 >0 && btc1 >0) }\n\nbit :: Bool -> Int\nbit True = 1\nbit False = 0\n\nsingle :: BoxLabel -> Bool\nsingle (ExpBox {}) = True\nsingle (TopLevelBox _) = True\nsingle (LocalBox _) = True\nsingle (BinBox {}) = False\n\nmodInfo :: Flags -> Bool -> TixModule -> IO ModInfo\nmodInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do\n  Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix)\n  return (q (accumCounts (zip (map snd mes) tickCounts) miZero))\n  where\n  q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)}\n         else mi\n\nmodReport :: Flags -> TixModule -> IO ()\nmodReport hpcflags tix@(TixModule moduleName _ _ _) = do\n  mi <- modInfo hpcflags False tix\n  if xmlOutput hpcflags\n    then putStrLn $ \"  <module name = \" ++ show moduleName  ++ \">\"\n    else putStrLn (\"-----<module \"++moduleName++\">-----\")\n  printModInfo hpcflags mi\n  if xmlOutput hpcflags\n    then putStrLn $ \"  </module>\"\n    else return ()\n\nprintModInfo :: Flags -> ModInfo -> IO ()\nprintModInfo hpcflags mi | xmlOutput hpcflags = do\n  element \"exprs\" (xmlBT $ exp mi)\n  element \"booleans\" (xmlBBT $ allBinCounts mi)\n  element \"guards\" (xmlBBT $ guard mi)\n  element \"conditionals\" (xmlBBT $ cond mi)\n  element \"qualifiers\" (xmlBBT $ qual mi)\n  element \"alts\" (xmlBT $ alt mi)\n  element \"local\" (xmlBT $ loc mi)\n  element \"toplevel\" (xmlBT $ top mi)\nprintModInfo hpcflags mi = do\n  putStrLn (btPercentage \"expressions used\" (exp mi))\n  putStrLn (bbtPercentage \"boolean coverage\" False (allBinCounts mi))\n  putStrLn (\"     \"++bbtPercentage \"guards\" True (guard mi))\n  putStrLn (\"     \"++bbtPercentage \"'if' conditions\" True (cond mi))\n  putStrLn (\"     \"++bbtPercentage \"qualifiers\" True (qual mi))\n  putStrLn (btPercentage \"alternatives used\" (alt mi))\n  putStrLn (btPercentage \"local declarations used\" (loc mi))\n  putStrLn (btPercentage \"top-level declarations used\" (top mi))\n  modDecList hpcflags mi\n\nmodDecList :: Flags -> ModInfo -> IO ()\nmodDecList hpcflags mi0 =\n  when (decList hpcflags && someDecsUnused mi0) $ do\n    putStrLn \"unused declarations:\"\n    mapM_ showDecPath (sort (decPaths mi0))\n  where\n  someDecsUnused mi = tixCount (top mi) < boxCount (top mi) ||\n                      tixCount (loc mi) < boxCount (loc mi)\n  showDecPath dp = putStrLn (\"     \"++\n                             concat (intersperse \".\" dp))\n\nreport_plugin :: Plugin\nreport_plugin = Plugin { name = \"report\"\n                       , usage = \"[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]\"\n                       , options = report_options\n                       , summary = \"Output textual report about program coverage\"\n                       , implementation = report_main\n                       , init_flags = default_flags\n                       , final_flags = default_final_flags\n                       }\n\nreport_main :: Flags -> [String] -> IO ()\nreport_main hpcflags (progName:mods) = do\n  let hpcflags1 = hpcflags\n                { includeMods = Set.fromList mods\n                                   `Set.union`\n                                includeMods hpcflags }\n  let prog = getTixFileName $ progName\n  tix <- readTix prog\n  case tix of\n    Just (Tix tickCounts) ->\n           makeReport hpcflags1 progName\n                    $ sortBy (\\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2)\n                    $ [ tix'\n                      | tix'@(TixModule m _ _ _) <- tickCounts\n                      , allowModule hpcflags1 m\n                      ]\n    Nothing -> hpcError report_plugin  $ \"unable to find tix file for:\" ++ progName\nreport_main _ [] =\n        hpcError report_plugin $ \"no .tix file or executable name specified\"\n\nmakeReport :: Flags -> String -> [TixModule] -> IO ()\nmakeReport hpcflags progName modTcs | xmlOutput hpcflags = do\n  putStrLn $ \"<?xml version=\\\"1.0\\\" encoding=\\\"UTF-8\\\"?>\"\n  putStrLn $ \"<coverage name=\" ++ show progName ++ \">\"\n  if perModule hpcflags\n    then mapM_ (modReport hpcflags) modTcs\n    else return ()\n  mis <- mapM (modInfo hpcflags True) modTcs\n  putStrLn $ \"  <summary>\"\n  printModInfo hpcflags (foldr miPlus miZero mis)\n  putStrLn $ \"  </summary>\"\n  putStrLn $ \"</coverage>\"\nmakeReport hpcflags _ modTcs =\n  if perModule hpcflags then\n    mapM_ (modReport hpcflags) modTcs\n  else do\n    mis <- mapM (modInfo hpcflags True) modTcs\n    printModInfo hpcflags (foldr miPlus miZero mis)\n\nelement :: String -> [(String,String)] -> IO ()\nelement tag attrs = putStrLn $\n                    \"    <\" ++ tag ++ \" \"\n                        ++ unwords [ x ++ \"=\" ++ show y\n                                   | (x,y) <- attrs\n                                   ] ++ \"/>\"\n\nxmlBT :: BoxTixCounts -> [(String, String)]\nxmlBT (BT b t) = [(\"boxes\",show b),(\"count\",show t)]\n\nxmlBBT :: BinBoxTixCounts -> [(String, String)]\nxmlBBT (BBT b tt tf bt) = [(\"boxes\",show b),(\"true\",show tt),(\"false\",show tf),(\"count\",show (tt + tf + bt))]\n\n------------------------------------------------------------------------------\n\nreport_options :: FlagOptSeq\nreport_options\n        = perModuleOpt\n        . decListOpt\n        . excludeOpt\n        . includeOpt\n        . srcDirOpt\n        . hpcDirOpt\n        . resetHpcDirsOpt\n        . xmlOutputOpt\n        . verbosityOpt\n\n\n", "num_lines": 280}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HpcShowTix (showtix_plugin) where\n\nimport Trace.Hpc.Mix\nimport Trace.Hpc.Tix\n\nimport HpcFlags\n\nimport qualified Data.Set as Set\n\nshowtix_options :: FlagOptSeq\nshowtix_options\n        = excludeOpt\n        . includeOpt\n        . srcDirOpt\n        . hpcDirOpt\n        . resetHpcDirsOpt\n        . outputOpt\n        . verbosityOpt\n\nshowtix_plugin :: Plugin\nshowtix_plugin = Plugin { name = \"show\"\n                       , usage = \"[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]\"\n                       , options = showtix_options\n                       , summary = \"Show .tix file in readable, verbose format\"\n                       , implementation = showtix_main\n                       , init_flags = default_flags\n                       , final_flags = default_final_flags\n                       }\n\n\nshowtix_main :: Flags -> [String] -> IO ()\nshowtix_main _     [] = hpcError showtix_plugin $ \"no .tix file or executable name specified\"\nshowtix_main flags (prog:modNames) = do\n  let hpcflags1 = flags\n                { includeMods = Set.fromList modNames\n                                   `Set.union`\n                                includeMods flags }\n\n  optTixs <- readTix (getTixFileName prog)\n  case optTixs of\n    Nothing -> hpcError showtix_plugin $ \"could not read .tix file : \"  ++ prog\n    Just (Tix tixs) -> do\n       tixs_mixs <- sequence\n               [ do mix <- readMixWithFlags hpcflags1 (Right tix)\n                    return $ (tix,mix)\n               | tix <- tixs\n               , allowModule hpcflags1 (tixModuleName tix)\n               ]\n\n       let rjust n str = take (n - length str) (repeat ' ') ++ str\n       let ljust n str = str ++ take (n - length str) (repeat ' ')\n\n       sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ \" \" ++\n                                         rjust 10 (show count) ++ \" \" ++\n                                         ljust 20  modName ++ \" \" ++ rjust 20 (show pos) ++ \" \" ++ show lab)\n                             | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries\n                             ]\n                 | ( TixModule modName _hash1 _ tixs'\n                   , Mix _file _timestamp _hash2 _tab entries\n                   ) <- tixs_mixs\n                 ]\n\n       return ()\n\n", "num_lines": 65}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HpcUtils where\n\nimport Trace.Hpc.Util\nimport qualified Data.Map as Map\nimport System.FilePath\n\ndropWhileEndLE :: (a -> Bool) -> [a] -> [a]\n-- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse\ndropWhileEndLE p = foldr (\\x r -> if null r && p x then [] else x:r) []\n\n-- turns \\n into ' '\n-- | grab's the text behind a HpcPos; \ngrabHpcPos :: Map.Map Int String -> HpcPos -> String\ngrabHpcPos hsMap srcspan = \n         case lns of\n           [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln)\n           _ -> let lns1 = drop (c1 -1) (head lns) : tail lns\n                    lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ]\n                 in foldl1 (\\ xs ys -> xs ++ \"\\n\" ++ ys) lns2\n  where (l1,c1,l2,c2) = fromHpcPos srcspan\n        lns = map (\\ n -> case Map.lookup n hsMap of\n                           Just ln -> ln\n                           Nothing -> error $ \"bad line number : \" ++ show n\n                  ) [l1..l2]\n\n\nreadFileFromPath :: (String -> IO String) -> String -> [String] -> IO String\nreadFileFromPath _ filename@('/':_) _ = readFile filename\nreadFileFromPath err filename path0 = readTheFile path0\n  where\n        readTheFile [] = err $ \"could not find \" ++ show filename\n                                 ++ \" in path \" ++ show path0\n        readTheFile (dir:dirs) =\n                catchIO (do str <- readFile (dir </> filename)\n                            return str)\n                        (\\ _ -> readTheFile dirs)\n", "num_lines": 37}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- (c) 2007 Andy Gill\n\n-- Main driver for Hpc\nimport Data.Version\nimport System.Environment\nimport System.Exit\nimport System.Console.GetOpt\n\nimport HpcFlags\nimport HpcReport\nimport HpcMarkup\nimport HpcCombine\nimport HpcShowTix\nimport HpcDraft\nimport HpcOverlay\nimport Paths_hpc_bin\n\nhelpList :: IO ()\nhelpList =\n     putStrLn $\n           \"Usage: hpc COMMAND ...\\n\\n\" ++\n           section \"Commands\" help ++\n           section \"Reporting Coverage\" reporting ++\n           section \"Processing Coverage files\" processing ++\n           section \"Coverage Overlays\" overlays ++\n           section \"Others\" other ++\n           \"\"\n  where\n    help       = [\"help\"]\n    reporting  = [\"report\",\"markup\"]\n    overlays   = [\"overlay\",\"draft\"]\n    processing = [\"sum\",\"combine\",\"map\"]\n    other     = [ name hook\n                | hook <- hooks\n                , name hook `notElem`\n                     (concat [help,reporting,processing,overlays])\n                ]\n\nsection :: String -> [String] -> String\nsection _   []   = \"\"\nsection msg cmds = msg ++ \":\\n\"\n        ++ unlines [ take 14 (\"  \" ++ cmd ++ repeat ' ') ++ summary hook\n                   | cmd <- cmds\n                   , hook <- hooks\n                   , name hook == cmd\n                   ]\n\ndispatch :: [String] -> IO ()\ndispatch [] = do\n             helpList\n             exitWith ExitSuccess\ndispatch (txt:args0) = do\n     case lookup txt hooks' of\n       Just plugin -> parse plugin args0\n       _ -> parse help_plugin (txt:args0)\n  where\n     parse plugin args =\n              case getOpt Permute (options plugin []) args of\n                (_,_,errs) | not (null errs)\n                     -> do putStrLn \"hpc failed:\"\n                           sequence_ [ putStr (\"  \" ++ err)\n                                    | err <- errs\n                                    ]\n                           putStrLn $ \"\\n\"\n                           command_usage plugin\n                           exitFailure\n                (o,ns,_) -> do\n                         let flags = final_flags plugin\n                                   $ foldr (.) id o\n                                   $ init_flags plugin\n                         implementation plugin flags ns\n\nmain :: IO ()\nmain = do\n args <- getArgs\n dispatch args\n\n------------------------------------------------------------------------------\n\nhooks :: [Plugin]\nhooks = [ help_plugin\n        , report_plugin\n        , markup_plugin\n        , sum_plugin\n        , combine_plugin\n        , map_plugin\n        , showtix_plugin\n        , overlay_plugin\n        , draft_plugin\n        , version_plugin\n        ]\n\nhooks' :: [(String, Plugin)]\nhooks' = [ (name hook,hook) | hook <- hooks ]\n\n------------------------------------------------------------------------------\n\nhelp_plugin :: Plugin\nhelp_plugin = Plugin { name = \"help\"\n                     , usage = \"[<HPC_COMMAND>]\"\n                     , summary = \"Display help for hpc or a single command\"\n                     , options = help_options\n                     , implementation = help_main\n                     , init_flags = default_flags\n                     , final_flags = default_final_flags\n                     }\n\nhelp_main :: Flags -> [String] -> IO ()\nhelp_main _ [] = do\n            helpList\n            exitWith ExitSuccess\nhelp_main _ (sub_txt:_) = do\n    case lookup sub_txt hooks' of\n      Nothing -> do\n          putStrLn $ \"no such hpc command : \" ++ sub_txt\n          exitFailure\n      Just plugin' -> do\n          command_usage plugin'\n          exitWith ExitSuccess\n\nhelp_options :: FlagOptSeq\nhelp_options   = id\n\n------------------------------------------------------------------------------\n\nversion_plugin :: Plugin\nversion_plugin = Plugin { name = \"version\"\n                        , usage = \"\"\n                        , summary = \"Display version for hpc\"\n                        , options = id\n                        , implementation = version_main\n                        , init_flags = default_flags\n                        , final_flags = default_final_flags\n                        }\n\nversion_main :: Flags -> [String] -> IO ()\nversion_main _ _ = putStrLn (\"hpc tools, version \" ++ showVersion version)\n\n\n------------------------------------------------------------------------------\n", "num_lines": 141}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GADTs #-}\n\n-- |\n-- The Remote GHCi server.\n--\n-- For details on Remote GHCi, see Note [Remote GHCi] in\n-- compiler/ghci/GHCi.hs.\n--\nmodule Main (main) where\n\nimport Lib (serv)\n\nimport GHCi.Message\nimport GHCi.Signals\nimport GHCi.Utils\n\nimport Control.Exception\nimport Control.Monad\nimport Data.IORef\nimport System.Environment\nimport System.Exit\nimport Text.Printf\n\ndieWithUsage :: IO a\ndieWithUsage = do\n    prog <- getProgName\n    die $ prog ++ \": \" ++ msg\n  where\n#ifdef WINDOWS\n    msg = \"usage: iserv <write-handle> <read-handle> [-v]\"\n#else\n    msg = \"usage: iserv <write-fd> <read-fd> [-v]\"\n#endif\n\nmain :: IO ()\nmain = do\n  args <- getArgs\n  (wfd1, rfd2, rest) <-\n      case args of\n        arg0:arg1:rest -> do\n            let wfd1 = read arg0\n                rfd2 = read arg1\n            return (wfd1, rfd2, rest)\n        _ -> dieWithUsage\n\n  verbose <- case rest of\n    [\"-v\"] -> return True\n    []     -> return False\n    _      -> dieWithUsage\n  when verbose $\n    printf \"GHC iserv starting (in: %d; out: %d)\\n\"\n      (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)\n  inh  <- getGhcHandle rfd2\n  outh <- getGhcHandle wfd1\n  installSignalHandlers\n  lo_ref <- newIORef Nothing\n  let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}\n  uninterruptibleMask $ serv verbose hook pipe\n\n  where hook = return -- empty hook\n    -- we cannot allow any async exceptions while communicating, because\n    -- we will lose sync in the protocol, hence uninterruptibleMask.\n\n", "num_lines": 64}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, GADTs, OverloadedStrings, LambdaCase #-}\n\n{-\nThis is the proxy portion of iserv.\n\nIt acts as local bridge for GHC to call\na remote slave. This all might sound\nconfusing, so let's try to get some\nnaming down.\n\nGHC is the actual Haskell compiler, that\nacts as frontend to the code to be compiled.\n\niserv is the slave, that GHC delegates compilation\nof TH to. As such it needs to be compiled for\nand run on the Target. In the special case\nwhere the Host and the Target are the same,\nno proxy is needed. GHC and iserv communicate\nvia pipes.\n\niserv-proxy is the proxy instance to iserv.\nThe following illustration should make this\nsomewhat clear:\n\n .----- Host -----.     .- Target -.\n | GHC <--> proxy<+-----+>  iserv  |\n '----------------'  ^  '----------'\n        ^            |\n        |            '-- communication via sockets\n        '--- communication via pipes\n\nFor now, we won't support multiple concurrent\ninvocations of the proxy instance, and that\nbehavior will be undefined, as this largely\ndepends on the capability of the iserv on the\ntarget to spawn multiple process.  Spawning\nmultiple threads won't be sufficient, as the\nGHC runtime has global state.\n\nAlso the GHC runtime needs to be able to\nuse the linker on the Target to link archives\nand object files.\n\n-}\n\nmodule Main (main) where\n\nimport System.IO\nimport GHCi.Message\nimport GHCi.Utils\nimport GHCi.Signals\n\nimport Remote.Message\n\nimport Network.Socket\nimport Data.IORef\nimport Control.Monad\nimport System.Environment\nimport System.Exit\nimport Text.Printf\nimport GHC.Fingerprint (getFileHash)\nimport System.Directory\nimport System.FilePath (isAbsolute)\n\nimport Data.Binary\nimport qualified Data.ByteString as BS\n\nimport Control.Concurrent (threadDelay)\nimport qualified Control.Exception as E\n\ntrace :: String -> IO ()\ntrace s = getProgName >>= \\name -> printf \"[%20s] %s\\n\" name s\n\ndieWithUsage :: IO a\ndieWithUsage = do\n    prog <- getProgName\n    die $ prog ++ \": \" ++ msg\n  where\n#if defined(WINDOWS)\n    msg = \"usage: iserv <write-handle> <read-handle> <slave ip> [-v]\"\n#else\n    msg = \"usage: iserv <write-fd> <read-fd> <slave ip> [-v]\"\n#endif\n\nmain :: IO ()\nmain = do\n  hSetBuffering stdin LineBuffering\n  hSetBuffering stdout LineBuffering\n\n  args <- getArgs\n  (wfd1, rfd2, host_ip, port, rest) <-\n      case args of\n        arg0:arg1:arg2:arg3:rest -> do\n            let wfd1 = read arg0\n                rfd2 = read arg1\n                ip   = arg2\n                port = read arg3\n            return (wfd1, rfd2, ip, port, rest)\n        _ -> dieWithUsage\n\n  verbose <- case rest of\n    [\"-v\"] -> return True\n    []     -> return False\n    _      -> dieWithUsage\n\n  when verbose $\n    printf \"GHC iserv starting (in: %d; out: %d)\\n\"\n      (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)\n  inh  <- getGhcHandle rfd2\n  outh <- getGhcHandle wfd1\n  installSignalHandlers\n  lo_ref <- newIORef Nothing\n  let in_pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}\n\n  when verbose $\n    trace (\"Trying to connect to \" ++ host_ip ++ \":\" ++ (show port))\n\n  out_pipe <- do\n    let go n = E.try (connectTo verbose host_ip port >>= socketToPipe) >>= \\case\n          Left e | n == 0 -> E.throw (e :: E.SomeException)\n                 | n >  0 -> threadDelay 500000 >> go (n - 1)\n          Right a -> return a\n      in go 120 -- wait for up to 60seconds (polling every 0.5s).\n\n  when verbose $\n    trace \"Starting proxy\"\n  proxy verbose in_pipe out_pipe\n\n-- | A hook, to transform outgoing (proxy -> slave)\n-- messages prior to sending them to the slave.\nhook :: Msg -> IO Msg\nhook = return\n\n-- | Forward a single @THMessage@ from the slave\n-- to ghc, and read back the result from GHC.\n--\n--  @Message@s go from ghc to the slave.\n--    ghc --- proxy --> slave               (@Message@)\n--  @THMessage@s go from the slave to ghc\n--    ghc <-- proxy --- slave               (@THMessage@)\n--\nfwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a\nfwdTHMsg local msg = do\n  writePipe local (putTHMessage msg)\n  readPipe local get\n\n-- | Fowarard a @Message@ call and handle @THMessages@.\nfwdTHCall :: (Binary a) => Bool -> Pipe -> Pipe -> Message a -> IO a\nfwdTHCall verbose local remote msg = do\n  when verbose $ trace (\"fwdTHCall: \" ++ show msg)\n  writePipe remote (putMessage msg)\n  -- wait for control instructions\n  when verbose $ trace \"waiting for control instructions...\"\n  loopTH\n  when verbose $ trace \"reading remote pipe result\"\n  readPipe remote get\n    where\n      loopTH :: IO ()\n      loopTH = do\n        when verbose $\n          trace \"fwdTHCall/loopTH: reading remote pipe...\"\n        THMsg msg' <- readPipe remote getTHMessage\n        when verbose $\n          trace (\"| TH Msg: ghc <- proxy -- slave: \" ++ show msg')\n        res <- fwdTHMsg local msg'\n        when verbose $\n          trace (\"| Resp.:  ghc -- proxy -> slave: \" ++ show res)\n        writePipe remote (put res)\n        case msg' of\n          RunTHDone -> return ()\n          _         -> loopTH\n\n-- | Forwards a @Message@ call, and handle @SlaveMessage@.\n-- Similar to @THMessages@, but @SlaveMessage@ are between\n-- the slave and the proxy, and are not forwarded to ghc.\n-- These message allow the Slave to query the proxy for\n-- files.\n--\n--  ghc --- proxy --> slave  (@Message@)\n--\n--          proxy <-- slave  (@SlaveMessage@)\n--\nfwdLoadCall :: (Binary a, Show a) => Bool -> Pipe -> Pipe -> Message a -> IO a\nfwdLoadCall verbose _ remote msg = do\n  when verbose $ trace \"fwdLoadCall: writing remote pipe\"\n  writePipe remote (putMessage msg)\n  loopLoad\n  when verbose $ trace \"fwdLoadCall: reading local pipe\"\n  readPipe remote get\n  where\n    truncateMsg :: Int -> String -> String\n    truncateMsg n s | length s > n = take n s ++ \"...\"\n                    | otherwise    = s\n    reply :: (Binary a, Show a) => a -> IO ()\n    reply m = do\n      when verbose $\n        trace (\"| Resp.:         proxy -> slave: \"\n                  ++ truncateMsg 80 (show m))\n      writePipe remote (put m)\n    loopLoad :: IO ()\n    loopLoad = do\n      when verbose $ trace \"fwdLoadCall: reading remote pipe\"\n      SlaveMsg msg' <- readPipe remote getSlaveMessage\n      when verbose $\n        trace (\"| Sl Msg:        proxy <- slave: \" ++ show msg')\n      case msg' of\n        Done -> return ()\n        Missing path -> do\n          when verbose $\n            trace $ \"fwdLoadCall: missing path: \" ++ path\n          reply =<< BS.readFile path\n          loopLoad\n        Have path remoteHash -> do\n          localHash <- getFileHash path\n          reply =<< if localHash == remoteHash\n                    then return Nothing\n                    else Just <$> BS.readFile path\n          loopLoad\n\n-- | The actual proxy. Conntect local and remote pipe,\n-- and does some message handling.\nproxy :: Bool -> Pipe -> Pipe -> IO ()\nproxy verbose local remote = loop\n  where\n    fwdCall :: (Binary a, Show a) => Message a -> IO a\n    fwdCall msg = do\n      when verbose $ trace \"proxy/fwdCall: writing remote pipe\"\n      writePipe remote (putMessage msg)\n      when verbose $ trace \"proxy/fwdCall: reading remote pipe\"\n      readPipe remote get\n\n    -- reply to ghc.\n    reply :: (Show a, Binary a) => a -> IO ()\n    reply msg = do\n      when verbose $\n        trace (\"Resp.:    ghc <- proxy -- slave: \" ++ show msg)\n      writePipe local (put msg)\n\n    loop = do\n      (Msg msg) <- readPipe local getMessage\n      when verbose $\n        trace (\"Msg:      ghc -- proxy -> slave: \" ++ show msg)\n      (Msg msg') <- hook (Msg msg)\n      -- Note [proxy-communication]\n      --\n      -- The fwdTHCall/fwdLoadCall/fwdCall's have to match up\n      -- with their endpoints in libiserv:Remote.Slave otherwise\n      -- you will end up with hung connections.\n      --\n      -- We are intercepting some calls between ghc and iserv\n      -- and augment the protocol here.  Thus these two sides\n      -- need to line up and know what request/reply to expect.\n      --\n      case msg' of\n        -- TH might send some message back to ghc.\n        RunTH{} -> do\n          resp <- fwdTHCall verbose local remote msg'\n          reply resp\n          loop\n        RunModFinalizers{} -> do\n          resp <- fwdTHCall verbose local remote msg'\n          reply resp\n          loop\n        -- Load messages might send some messages back to the proxy, to\n        -- requrest files that are not present on the device.\n        LoadArchive{} -> do\n          resp <- fwdLoadCall verbose local remote msg'\n          reply resp\n          loop\n        LoadObj{} -> do\n          resp <- fwdLoadCall verbose local remote msg'\n          reply resp\n          loop\n        -- On windows we assume that we don't want to copy libraries\n        -- that are referenced in C:\\ these are usually system libraries.\n        LoadDLL path@('C':':':_) -> do\n          fwdCall msg' >>= reply >> loop\n        LoadDLL path | isAbsolute path -> do\n          resp <- fwdLoadCall verbose local remote msg'\n          reply resp\n          loop\n        Shutdown{}    -> fwdCall msg' >> return ()\n        _other        -> fwdCall msg' >>= reply >> loop\n\n\nconnectTo :: Bool -> String -> PortNumber -> IO Socket\nconnectTo verbose host port = do\n  addr <- resolve host (show port)\n  open addr\n  where\n    resolve host port = do\n        let hints = defaultHints { addrSocketType = Stream }\n        addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)\n        return addr\n    open addr = do\n        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)\n        when verbose $\n          trace $ \"Created socket for \" ++ host ++ \":\" ++ show port\n        connect sock $ addrAddress addr\n        when verbose $\n          trace \"connected\"\n        return sock\n\n-- | Turn a socket into an unbuffered pipe.\nsocketToPipe :: Socket -> IO Pipe\nsocketToPipe sock = do\n  hdl <- socketToHandle sock ReadWriteMode\n  hSetBuffering hdl NoBuffering\n\n  lo_ref <- newIORef Nothing\n  pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref }\n", "num_lines": 312}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import           Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport           Remote.Slave (startSlave')\nimport           System.Environment (getArgs, getProgName)\nimport           System.Exit (die)\n\nmain :: IO ()\nmain = getArgs >>= startSlave\n\ndieWithUsage :: IO a\ndieWithUsage = do\n  prog <- getProgName\n  die $ msg prog\n where\n  msg name = \"usage: \" ++ name ++ \" /path/to/storage PORT [-v]\"\n\nstartSlave :: [String] -> IO ()\nstartSlave args0\n  | \"--help\" `elem` args0 = dieWithUsage\n  | otherwise = do\n      (path, port, rest) <- case args0 of\n        arg0:arg1:rest -> return (arg0, read arg1, rest)\n        _              -> dieWithUsage\n\n      verbose <- case rest of\n        [\"-v\"] -> return True\n        []     -> return False\n        _      -> dieWithUsage\n\n      startSlave' verbose path port\n", "num_lines": 31}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n#include \"ghcconfig.h\"\n-----------------------------------------------------------------------------\n--\n-- (c) The University of Glasgow, 2004\n--\n-- runghc program, for invoking from a #! line in a script.  For example:\n--\n--   script.lhs:\n--      #!/usr/bin/env runghc\n--      > main = putStrLn \"hello!\"\n--\n-- runghc accepts one flag:\n--\n--      -f <path>    specify the path\n--\n-- -----------------------------------------------------------------------------\n\nmodule Main (main) where\n\nimport Control.Exception\nimport Data.Semigroup as Semi\nimport System.Directory\nimport System.Environment\nimport System.Exit\nimport System.FilePath\nimport System.IO\n\n#if defined(mingw32_HOST_OS)\nimport System.Process (rawSystem)\nimport Foreign\nimport Foreign.C.String\n#else\nimport System.Posix.Process (executeFile)\n#endif\n\n#if defined(mingw32_HOST_OS)\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n#endif\n\nmain :: IO ()\nmain = do\n    args <- getArgs\n    case parseRunGhcFlags args of\n        (Help, _) -> printUsage\n        (ShowVersion, _) -> printVersion\n        (RunGhcFlags (Just ghc), args') -> uncurry (doIt ghc) $ getGhcArgs args'\n        (RunGhcFlags Nothing, args') -> do\n            mbPath <- getExecPath\n            case mbPath of\n                Nothing  -> dieProg (\"cannot find ghc\")\n                Just path -> do\n                    ghc <- findGhc path\n                    uncurry (doIt ghc) $ getGhcArgs args'\n\n-- In some cases, runghc isn't given a path to ghc explicitly. This can occur\n-- if $1_$2_SHELL_WRAPPER = NO (which is always the case on Windows). In such\n-- a scenario, we must guess where ghc lives. Given a path where ghc might\n-- live, we check for the existence of ghc. If we can't find it, we assume that\n-- we're building ghc from source, in which case we fall back on ghc-stage2.\n-- (See Trac #1185.)\nfindGhc :: FilePath -> IO FilePath\nfindGhc path = do\n    let ghcDir = takeDirectory (normalise path)\n        ghc    = ghcDir </> \"ghc\" <.> exeExtension\n    ghcExists <- doesFileExist ghc\n    return $ if ghcExists\n             then ghc\n             else ghcDir </> \"ghc-stage2\" <.> exeExtension\n\ndata RunGhcFlags = RunGhcFlags (Maybe FilePath) -- GHC location\n                 | Help -- Print help text\n                 | ShowVersion -- Print version info\n\ninstance Semi.Semigroup RunGhcFlags where\n    Help <> _ = Help\n    _ <> Help = Help\n    ShowVersion <> _ = ShowVersion\n    _ <> ShowVersion = ShowVersion\n    RunGhcFlags _ <> right@(RunGhcFlags (Just _)) = right\n    left@(RunGhcFlags _) <> RunGhcFlags Nothing = left\n\ninstance Monoid RunGhcFlags where\n    mempty = RunGhcFlags Nothing\n    mappend = (<>)\n\nparseRunGhcFlags :: [String] -> (RunGhcFlags, [String])\nparseRunGhcFlags = f mempty\n    where f flags (\"-f\" : ghc : args)\n              = f (flags `mappend` RunGhcFlags (Just ghc)) args\n          f flags (('-' : 'f' : ghc) : args)\n              = f (flags `mappend` RunGhcFlags (Just ghc)) args\n          f flags (\"--help\" : args) = f (flags `mappend` Help) args\n          f flags (\"--version\" : args) = f (flags `mappend` ShowVersion) args\n          -- If you need the first GHC flag to be a -f flag then\n          -- you can pass -- first\n          f flags (\"--\" : args) = (flags, args)\n          f flags         args  = (flags, args)\n\nprintVersion :: IO ()\nprintVersion = do\n    putStrLn (\"runghc \" ++ VERSION)\n\nprintUsage :: IO ()\nprintUsage = do\n    putStrLn \"Usage: runghc [runghc flags] [GHC flags] module [program args]\"\n    putStrLn \"\"\n    putStrLn \"The runghc flags are\"\n    putStrLn \"    -f /path/to/ghc       Tell runghc where GHC is\"\n    putStrLn \"    --ghc-arg=<arg>       Pass an option or argument to GHC\"\n    putStrLn \"    --help                Print this usage information\"\n    putStrLn \"    --version             Print version number\"\n\ndoIt :: String -- ^ path to GHC\n     -> [String] -- ^ GHC args\n     -> [String] -- ^ rest of the args\n     -> IO ()\ndoIt ghc ghc_args rest = do\n    case rest of\n        [] -> do\n           -- behave like typical perl, python, ruby interpreters:\n           -- read from stdin\n           tmpdir <- getTemporaryDirectory\n           bracket\n             (openTempFile tmpdir \"runghcXXXX.hs\")\n             (\\(filename,h) -> do hClose h; removeFile filename)\n             $ \\(filename,h) -> do\n                 getContents >>= hPutStr h\n                 hClose h\n                 doIt ghc ghc_args [filename]\n        filename : prog_args -> do\n            -- If the file exists, and is not a .lhs file, then we\n            -- want to treat it as a .hs file.\n            --\n            -- If the file doesn't exist then GHC is going to look for\n            -- filename.hs and filename.lhs, and use the appropriate\n            -- type.\n            exists <- doesFileExist filename\n            let xflag = if exists && (takeExtension filename /= \".lhs\")\n                        then [\"-x\", \"hs\"]\n                        else []\n                c1 = \":set prog \" ++ show filename\n                c2 = \":main \" ++ show prog_args\n\n            let cmd = ghc\n                args = [\"-ignore-dot-ghci\"] ++\n                       xflag ++\n                       ghc_args ++\n                       [ \"-e\", c1, \"-e\", c2, filename]\n\n\n#if defined(mingw32_HOST_OS)\n            rawSystem cmd args >>= exitWith\n#else\n            -- Passing False to avoid searching the PATH, since the cmd should\n            -- always be an absolute path to the ghc executable.\n            executeFile cmd False args Nothing\n#endif\n\ngetGhcArgs :: [String] -> ([String], [String])\ngetGhcArgs args\n = let (ghcArgs, otherArgs) = case break pastArgs args of\n                              (xs, \"--\":ys) -> (xs, ys)\n                              (xs, ys)      -> (xs, ys)\n   in (map unescape ghcArgs, otherArgs)\n    where unescape ('-':'-':'g':'h':'c':'-':'a':'r':'g':'=':arg) =\n                case arg of\n                    -- Bug #8601: allow --ghc-arg=--ghc-arg= as a prefix as well for backwards compatibility\n                    ('-':'-':'g':'h':'c':'-':'a':'r':'g':'=':arg') -> arg'\n                    _ -> arg\n          unescape arg = arg\n\npastArgs :: String -> Bool\n-- You can use -- to mark the end of the flags, in case you need to use\n-- a file called -foo.hs for some reason. You almost certainly shouldn't,\n-- though.\npastArgs \"--\" = True\npastArgs ('-':_) = False\npastArgs _       = True\n\ndieProg :: String -> IO a\ndieProg msg = do\n    p <- getProgName\n    hPutStrLn stderr (p ++ \": \" ++ msg)\n    exitWith (ExitFailure 1)\n\n-- usage :: String\n-- usage = \"syntax: runghc [-f GHC-PATH | --] [GHC-ARGS] [--] FILE ARG...\"\n\ngetExecPath :: IO (Maybe String)\n#if defined(mingw32_HOST_OS)\ngetExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.\n  where\n    try_size size = allocaArray (fromIntegral size) $ \\buf -> do\n        ret <- c_GetModuleFileName nullPtr buf size\n        case ret of\n          0 -> return Nothing\n          _ | ret < size -> fmap Just $ peekCWString buf\n            | otherwise  -> try_size (size * 2)\n\nforeign import WINDOWS_CCONV unsafe \"windows.h GetModuleFileNameW\"\n  c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32\n#else\ngetExecPath = return Nothing\n#endif\n", "num_lines": 212}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport Control.Monad\nimport qualified Data.ByteString.Char8 as BSC\nimport Data.Function\nimport Data.List\nimport qualified Data.Map as Map\nimport Data.Map (Map)\nimport System.Environment\nimport System.FilePath\n\ndata CleanWhat = CleanFile FilePath\n               | CleanRec  FilePath\n    deriving (Read, Show)\n\nnewtype FilePathFragment = FilePathFragment BSC.ByteString\n    deriving (Show, Eq, Ord)\n\ntoFilePathFragments :: FilePath -> [FilePathFragment]\ntoFilePathFragments\n    = map (FilePathFragment . BSC.pack) . splitDirectories . normalise\n\nfromFilePathFragments :: [FilePathFragment] -> FilePath\nfromFilePathFragments xs = joinPath $ map f $ reverse xs\n    where f (FilePathFragment frag) = BSC.unpack frag\n\ndata Tree = Node !FileInfo !(Map FilePathFragment Tree)\ndata FileInfo = FileInfo {\n                    fiBefore :: !Bool,\n                    fiAfter :: !Bool,\n                    fiDeleted :: !Bool\n                }\n\nbeforeFileInfo :: FileInfo\nbeforeFileInfo = noFileInfo { fiBefore  = True }\n\nafterFileInfo :: FileInfo\nafterFileInfo = noFileInfo { fiAfter   = True }\n\nnoFileInfo :: FileInfo\nnoFileInfo = FileInfo {\n                 fiBefore  = False,\n                 fiAfter   = False,\n                 fiDeleted = False\n             }\n\nreadTree :: FileInfo -> FilePath -> IO (Tree)\nreadTree fi fp = do xs <- readFile fp\n                    return $ mkTree fi $ lines xs\n\nmkTree :: FileInfo -> [FilePath] -> Tree\nmkTree fi fps = f (sort fragss)\n    where fragss = map toFilePathFragments fps\n          f xs = let xs' = g $ groupBy ((==) `on` head)\n                             $ filter (not . null) xs\n                 in Node fi xs'\n          g xss = mapFromList' [ (head (head xs), f (map tail xs))\n                               | xs <- xss ]\n\nmapFromList' :: Ord a => [(a, b)] -> Map a b\nmapFromList' xs = seqAll xs `seq` Map.fromList xs\n    where seqAll [] = ()\n          seqAll ((x, y) : xys) = x `seq` y `seq` seqAll xys\n\n{-\n... = OK: will happen if a file in a non-existent directory is rm'd [1]\n..D = OK: will happen if a non-existent file is rm'd [1]\n.A. = suspicious: Why wasn't this file cleaned?\n.AD = OK: This is what object files look like\nB.. = suspicious: Where did the file go?\nB.D = suspicious: Why are we removing a file that existed before?\nBA. = OK: This is what source files look like\nBAD = suspicious: Why are we removing a file that existed before?\n\n[1] some files may only be created on certain platforms, or in certain\n    build-system configurations, but the cleaning code is deliberately\n    simple so it will always clean them regardless\n-}\npprSuspicious :: Tree -> [String]\npprSuspicious t = f [] t\n    where f ps (Node fi m) = suspicious (fromFilePathFragments ps) fi\n                          ++ concat [ f (p : ps) m' | (p, m') <- Map.toList m ]\n          suspicious fp (FileInfo False True  False) = [\"File not deleted:    \" ++ show fp]\n          suspicious fp (FileInfo True  False False) = [\"File disappeared:    \" ++ show fp]\n          suspicious fp (FileInfo True  False True)  = [\"Deleted before file: \" ++ show fp]\n          suspicious fp (FileInfo True  True  True)  = [\"Deleted before file: \" ++ show fp]\n          suspicious _  _                            = []\n\npprTree :: Tree -> [String]\npprTree t = f [] t\n    where f ps (Node fi m) = (pprInfo fi ++ \" \" ++ fromFilePathFragments ps)\n                           : concat [ f (p : ps) m' | (p, m') <- Map.toList m ]\n\npprInfo :: FileInfo -> String\npprInfo (FileInfo before after deleted) = [if before  then 'B' else '.',\n                                           if after   then 'A' else '.',\n                                           if deleted then 'D' else '.']\n\nmergeTree :: Tree -> Tree -> Tree\nmergeTree (Node fi1 m1) (Node fi2 m2)\n    = Node (mergeFileInfo fi1 fi2)\n           (Map.unionWith mergeTree m1 m2)\n\nmergeFileInfo :: FileInfo -> FileInfo -> FileInfo\nmergeFileInfo (FileInfo before1 after1 deleted1)\n              (FileInfo before2 after2 deleted2)\n    = FileInfo (before1 || before2) (after1 || after2) (deleted1 || deleted2)\n\nmain :: IO ()\nmain = do args <- getArgs\n          case args of\n              [contentsBeforeFile, contentsAfterFile, wouldBeCleanedFile] ->\n                  doit contentsBeforeFile contentsAfterFile wouldBeCleanedFile\n              _ ->\n                  error \"Bad args\"\n\ndoit :: FilePath -> FilePath -> FilePath -> IO ()\ndoit contentsBeforeFile contentsAfterFile wouldBeCleanedFile\n = do contentsBefore <- readTree beforeFileInfo contentsBeforeFile\n      contentsAfter  <- readTree afterFileInfo  contentsAfterFile\n      let contentsMerged = mergeTree contentsBefore contentsAfter\n      wouldBeCleaned <- liftM (map read . lines) $ readFile wouldBeCleanedFile\n      let contentsCleaned = simulateCleans contentsMerged wouldBeCleaned\n      mapM_ putStrLn $ pprSuspicious contentsCleaned\n\nsimulateCleans :: Tree -> [CleanWhat] -> Tree\nsimulateCleans = foldl' simulateClean\n\nsimulateClean :: Tree -> CleanWhat -> Tree\nsimulateClean t (CleanFile fp) = at t fp markDeleted\nsimulateClean t (CleanRec  fp) = at t fp markSubtreeDeleted\n\nmarkDeleted :: Tree -> Tree\nmarkDeleted (Node fi m) = Node (fi { fiDeleted = True }) m\n\nmarkSubtreeDeleted :: Tree -> Tree\nmarkSubtreeDeleted (Node fi m) = Node fi' (Map.map markSubtreeDeleted m)\n    where fi' = -- \"rm -r\" will only delete things that are there afterwards\n                if fiAfter fi then fi { fiDeleted = True } else fi\n\nat :: Tree -> FilePath -> (Tree -> Tree) -> Tree\nat t fp f = at' t (toFilePathFragments fp) f\n\nat' :: Tree -> [FilePathFragment] -> (Tree -> Tree) -> Tree\nat' t           []       f = f t\nat' (Node fi m) (p : ps) f = Node fi m'\n    where m' = Map.insert p (at' t ps f) m\n          t = Map.findWithDefault (Node noFileInfo Map.empty) p m\n\n", "num_lines": 151}
{"repo_name": "fbghc", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule Main (main) where\n\nimport System.Environment\n\ndata CleanWhat = CleanFile FilePath\n               | CleanRec  FilePath\n    deriving (Read, Show)\n\nmain :: IO ()\nmain = do args <- getArgs\n          ls <- case args of\n                \"CLEAN_FILES\" : files -> return $ map CleanFile files\n                \"CLEAN_REC\"   : dirs  -> return $ map CleanRec dirs\n                _ -> error \"Bad args\"\n          appendFile \"would-be-cleaned\" $ unlines $ map show ls\n", "num_lines": 17}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env runhaskell\n> import Distribution.Simple\n> main = defaultMain\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Documentation.Haddock (haddock)\nimport ResponseFile (expandResponse)\nimport System.Environment (getArgs)\n\nmain :: IO ()\nmain = getArgs >>= expandResponse >>= haddock\n", "num_lines": 9}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule ResponseFile (\n    unescapeArgs,\n    escapeArgs,\n    expandResponse\n  ) where\n\nimport Control.Exception\nimport Data.Char (isSpace)\nimport Data.Foldable (foldl')\nimport System.Exit (exitFailure)\nimport System.IO\n\n\n-- | Given a string of concatenated strings, separate each by removing\n-- a layer of /quoting/ and\\/or /escaping/ of certain characters.\n--\n-- These characters are: any whitespace, single quote, double quote,\n-- and the backslash character.  The backslash character always\n-- escapes (i.e., passes through without further consideration) the\n-- character which follows.  Characters can also be escaped in blocks\n-- by quoting (i.e., surrounding the blocks with matching pairs of\n-- either single- or double-quotes which are not themselves escaped).\n--\n-- Any whitespace which appears outside of either of the quoting and\n-- escaping mechanisms, is interpreted as having been added by this\n-- special concatenation process to designate where the boundaries\n-- are between the original, un-concatenated list of strings.  These\n-- added whitespace characters are removed from the output.\n--\n-- > unescapeArgs \"hello\\\\ \\\\\\\"world\\\\\\\"\\n\" == escapeArgs \"hello \\\"world\\\"\"\nunescapeArgs :: String -> [String]\nunescapeArgs = filter (not . null) . unescape\n\n-- | Given a list of strings, concatenate them into a single string\n-- with escaping of certain characters, and the addition of a newline\n-- between each string.  The escaping is done by adding a single\n-- backslash character before any whitespace, single quote, double\n-- quote, or backslash character, so this escaping character must be\n-- removed.  Unescaped whitespace (in this case, newline) is part\n-- of this \"transport\" format to indicate the end of the previous\n-- string and the start of a new string.\n--\n-- While 'unescapeArgs' allows using quoting (i.e., convenient\n-- escaping of many characters) by having matching sets of single- or\n-- double-quotes,'escapeArgs' does not use the quoting mechasnism,\n-- and thus will always escape any whitespace, quotes, and\n-- backslashes.\n--\n-- > unescapeArgs \"hello\\\\ \\\\\\\"world\\\\\\\"\\\\n\" == escapeArgs \"hello \\\"world\\\"\"\nescapeArgs :: [String] -> String\nescapeArgs = unlines . map escapeArg\n\n-- | Arguments which look like '@foo' will be replaced with the\n-- contents of file @foo@. A gcc-like syntax for response files arguments\n-- is expected.  This must re-constitute the argument list by doing an\n-- inverse of the escaping mechanism done by the calling-program side.\n--\n-- We quit if the file is not found or reading somehow fails.\n-- (A convenience routine for haddock or possibly other clients)\nexpandResponse :: [String] -> IO [String]\nexpandResponse = fmap concat . mapM expand\n  where\n    expand :: String -> IO [String]\n    expand ('@':f) = readFileExc f >>= return . unescapeArgs\n    expand x = return [x]\n\n    readFileExc f =\n      readFile f `catch` \\(e :: IOException) -> do\n        hPutStrLn stderr $ \"Error while expanding response file: \" ++ show e\n        exitFailure\n\ndata Quoting = NoneQ | SngQ | DblQ\n\nunescape :: String -> [String]\nunescape args = reverse . map reverse $ go args NoneQ False [] []\n    where\n      -- n.b., the order of these cases matters; these are cribbed from gcc\n      -- case 1: end of input\n      go []     _q    _bs   a as = a:as\n      -- case 2: back-slash escape in progress\n      go (c:cs) q     True  a as = go cs q     False (c:a) as\n      -- case 3: no back-slash escape in progress, but got a back-slash\n      go (c:cs) q     False a as\n        | '\\\\' == c              = go cs q     True  a     as\n      -- case 4: single-quote escaping in progress\n      go (c:cs) SngQ  False a as\n        | '\\'' == c              = go cs NoneQ False a     as\n        | otherwise              = go cs SngQ  False (c:a) as\n      -- case 5: double-quote escaping in progress\n      go (c:cs) DblQ  False a as\n        | '\"' == c               = go cs NoneQ False a     as\n        | otherwise              = go cs DblQ  False (c:a) as\n      -- case 6: no escaping is in progress\n      go (c:cs) NoneQ False a as\n        | isSpace c              = go cs NoneQ False []    (a:as)\n        | '\\'' == c              = go cs SngQ  False a     as\n        | '\"'  == c              = go cs DblQ  False a     as\n        | otherwise              = go cs NoneQ False (c:a) as\n\nescapeArg :: String -> String\nescapeArg = reverse . foldl' escape []\n\nescape :: String -> Char -> String\nescape cs c\n  |    isSpace c\n    || '\\\\' == c\n    || '\\'' == c\n    || '\"'  == c = c:'\\\\':cs -- n.b., our caller must reverse the result\n  | otherwise    = c:cs\n", "num_lines": 111}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Main where\n\nimport Test.Hspec (describe, hspec, Spec)\nimport qualified ResponseFileSpec (spec)\n\n\nmain :: IO ()\nmain = hspec spec\n\nspec :: Spec\nspec = do\n    describe \"ResponseFile\" ResponseFileSpec.spec\n", "num_lines": 13}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ResponseFileSpec where\n\nimport Test.Hspec (context, describe, it, shouldBe, Spec)\nimport ResponseFile (escapeArgs, unescapeArgs)\n\n-- The first two elements are\n--   1) a list of 'args' to encode and\n--   2) a single string of the encoded args\n-- The 3rd element is just a description for the tests.\ntestStrs :: [(([String], String), String)]\ntestStrs =\n  [ (([\"a simple command line\"],\n      \"a\\\\ simple\\\\ command\\\\ line\\n\"),\n     \"the white-space, end with newline\")\n\n  , (([\"arg 'foo' is single quoted\"],\n      \"arg\\\\ \\\\'foo\\\\'\\\\ is\\\\ single\\\\ quoted\\n\"),\n     \"the single quotes as well\")\n\n  , (([\"arg \\\"bar\\\" is double quoted\"],\n      \"arg\\\\ \\\\\\\"bar\\\\\\\"\\\\ is\\\\ double\\\\ quoted\\n\"),\n     \"the double quotes as well\" )\n\n  , (([\"arg \\\"foo bar\\\" has embedded whitespace\"],\n      \"arg\\\\ \\\\\\\"foo\\\\ bar\\\\\\\"\\\\ has\\\\ embedded\\\\ whitespace\\n\"),\n     \"the quote-embedded whitespace\")\n\n  , (([\"arg 'Jack said \\\\'hi\\\\'' has single quotes\"],\n      \"arg\\\\ \\\\'Jack\\\\ said\\\\ \\\\\\\\\\\\'hi\\\\\\\\\\\\'\\\\'\\\\ has\\\\ single\\\\ quotes\\n\"),\n     \"the escaped single quotes\")\n\n  , (([\"arg 'Jack said \\\\\\\"hi\\\\\\\"' has double quotes\"],\n      \"arg\\\\ \\\\'Jack\\\\ said\\\\ \\\\\\\\\\\\\\\"hi\\\\\\\\\\\\\\\"\\\\'\\\\ has\\\\ double\\\\ quotes\\n\"),\n     \"the escaped double quotes\")\n\n  , (([\"arg 'Jack said\\\\r\\\\n\\\\t \\\\\\\"hi\\\\\\\"' has other whitespace\"],\n      \"arg\\\\ \\\\'Jack\\\\ said\\\\\\\\r\\\\\\\\n\\\\\\\\t\\\\ \\\\\\\\\\\\\\\"hi\\\\\\\\\\\\\\\"\\\\'\\\\ has\\\\ \\\n           \\other\\\\ whitespace\\n\"),\n     \"the other whitespace\")\n\n  , (([ \"--prologue=.\\\\dist\\\\.\\\\haddock-prologue3239114604.txt\"\n      , \"--title=HaddockNewline-0.1.0.0: This has a\\n\\\n        \\newline yo.\"\n      , \"-BC:\\\\Program Files\\\\Haskell Platform\\\\lib\"],\n      \"--prologue=.\\\\\\\\dist\\\\\\\\.\\\\\\\\haddock-prologue3239114604.txt\\n\\\n      \\--title=HaddockNewline-0.1.0.0:\\\\ This\\\\ has\\\\ a\\\\\\n\\\n      \\newline\\\\ yo.\\n\\\n      \\-BC:\\\\\\\\Program\\\\ Files\\\\\\\\Haskell\\\\ Platform\\\\\\\\lib\\n\"),\n     \"an actual haddock response file snippet with embedded newlines\")\n  ]\n\nspec :: Spec\nspec = do\n  describe \"escapeArgs\" $ do\n      mapM_ (\\((ss1,s2),des) -> do\n                  context (\"given \" ++ (show ss1)) $ do\n                      it (\"should escape \" ++ des) $ do\n                          escapeArgs ss1 `shouldBe` s2\n            ) testStrs\n  describe \"unescapeArgs\" $ do\n      mapM_ (\\((ss1,s2),des) -> do\n                  context (\"given \" ++ (show s2)) $ do\n                      it (\"should unescape \" ++ des) $ do\n                          unescapeArgs s2 `shouldBe` ss1\n            ) testStrs\n  describe \"unescapeArgs\" $ do\n      context \"given unescaped single quotes\" $ do\n          it \"should pass-through, without escaping, everything inside\" $ do\n              -- backslash *always* is escaped anywhere it appears\n              (filter (not . null) $\n                unescapeArgs \"this\\\\ is\\\\ 'not escape\\\\d \\\"inside\\\"'\\\\ yo\\n\")\n              `shouldBe`\n              [\"this is not escaped \\\"inside\\\" yo\"]\n      context \"given unescaped double quotes\" $ do\n          it \"should pass-through, without escaping, everything inside\" $ do\n              -- backslash *always* is escaped anywhere it appears\n              (filter (not . null) $\n                unescapeArgs \"this\\\\ is\\\\ \\\"not escape\\\\d 'inside'\\\"\\\\ yo\\n\")\n              `shouldBe`\n              [\"this is not escaped 'inside' yo\"]\n", "num_lines": 81}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env runhaskell\n> import Distribution.Simple\n> main = defaultMain\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wwarn #-}\n{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, Rank2Types #-}\n{-# LANGUAGE LambdaCase #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock\n-- Copyright   :  (c) Simon Marlow 2003-2006,\n--                    David Waern  2006-2010,\n--                    Mateusz Kowalczyk 2014\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Haddock - A Haskell Documentation Tool\n--\n-- Program entry point and top-level code.\n-----------------------------------------------------------------------------\nmodule Haddock (\n  haddock,\n  haddockWithGhc,\n  getGhcDirs,\n  readPackagesAndProcessModules,\n  withGhc\n) where\n\nimport Haddock.Backends.Xhtml\nimport Haddock.Backends.Xhtml.Meta\nimport Haddock.Backends.Xhtml.Themes (getThemes)\nimport Haddock.Backends.LaTeX\nimport Haddock.Backends.Hoogle\nimport Haddock.Backends.Hyperlinker\nimport Haddock.Interface\nimport Haddock.Interface.Json\nimport Haddock.Parser\nimport Haddock.Types\nimport Haddock.Version\nimport Haddock.InterfaceFile\nimport Haddock.Options\nimport Haddock.Utils\n\nimport Control.Monad hiding (forM_)\nimport Data.Foldable (forM_, foldl')\nimport Data.Traversable (for)\nimport Data.List (isPrefixOf)\nimport Control.Exception\nimport Data.Maybe\nimport Data.IORef\nimport Data.Map (Map)\nimport Data.Version (makeVersion)\nimport qualified Data.Map as Map\nimport System.IO\nimport System.Exit\n\n#if defined(mingw32_HOST_OS)\nimport Foreign\nimport Foreign.C\nimport Data.Int\n#endif\n\n#ifdef IN_GHC_TREE\nimport System.FilePath\n#else\nimport qualified GHC.Paths as GhcPaths\nimport Paths_haddock_api (getDataDir)\nimport System.Directory (doesDirectoryExist)\n#endif\n\nimport Text.ParserCombinators.ReadP (readP_to_S)\nimport GHC hiding (verbosity)\nimport Config\nimport DynFlags hiding (projectVersion, verbosity)\nimport ErrUtils\nimport Packages\nimport Panic (handleGhcException)\nimport Module\nimport FastString\n\n--------------------------------------------------------------------------------\n-- * Exception handling\n--------------------------------------------------------------------------------\n\n\nhandleTopExceptions :: IO a -> IO a\nhandleTopExceptions =\n  handleNormalExceptions . handleHaddockExceptions . handleGhcExceptions\n\n\n-- | Either returns normally or throws an ExitCode exception;\n-- all other exceptions are turned into exit exceptions.\nhandleNormalExceptions :: IO a -> IO a\nhandleNormalExceptions inner =\n  (inner `onException` hFlush stdout)\n  `catches`\n  [  Handler (\\(code :: ExitCode) -> exitWith code)\n\n  ,  Handler (\\(ex :: AsyncException) ->\n       case ex of\n         StackOverflow -> do\n           putStrLn \"stack overflow: use -g +RTS -K<size> to increase it\"\n           exitFailure\n         _ -> do\n           putStrLn (\"haddock: \" ++ show ex)\n           exitFailure)\n\n  ,  Handler (\\(ex :: SomeException) -> do\n        putStrLn (\"haddock: internal error: \" ++ show ex)\n        exitFailure)\n  ]\n\n\nhandleHaddockExceptions :: IO a -> IO a\nhandleHaddockExceptions inner =\n  catches inner [Handler handler]\n  where\n    handler (e::HaddockException) = do\n      putStrLn $ \"haddock: \" ++ show e\n      exitFailure\n\n\nhandleGhcExceptions :: IO a -> IO a\nhandleGhcExceptions =\n  -- error messages propagated as exceptions\n  handleGhcException $ \\e -> do\n    hFlush stdout\n    print (e :: GhcException)\n    exitFailure\n\n\n-------------------------------------------------------------------------------\n-- * Top level\n-------------------------------------------------------------------------------\n\n\n-- | Run Haddock with given list of arguments.\n--\n-- Haddock's own main function is defined in terms of this:\n--\n-- > main = getArgs >>= haddock\nhaddock :: [String] -> IO ()\nhaddock args = haddockWithGhc withGhc args\n\nhaddockWithGhc :: (forall a. [Flag] -> Ghc a -> IO a) -> [String] -> IO ()\nhaddockWithGhc ghc args = handleTopExceptions $ do\n\n  -- Parse command-line flags and handle some of them initially.\n  -- TODO: unify all of this (and some of what's in the 'render' function),\n  -- into one function that returns a record with a field for each option,\n  -- or which exits with an error or help message.\n  (flags, files) <- parseHaddockOpts args\n  shortcutFlags flags\n  qual <- rightOrThrowE (qualification flags)\n  sinceQual <- rightOrThrowE (sinceQualification flags)\n\n  -- inject dynamic-too into flags before we proceed\n  flags' <- ghc flags $ do\n        df <- getDynFlags\n        case lookup \"GHC Dynamic\" (compilerInfo df) of\n          Just \"YES\" -> return $ Flag_OptGhc \"-dynamic-too\" : flags\n          _ -> return flags\n\n  unless (Flag_NoWarnings `elem` flags) $ do\n    hypSrcWarnings flags\n    forM_ (warnings args) $ \\warning -> do\n      hPutStrLn stderr warning\n\n  ghc flags' $ do\n    dflags <- getDynFlags\n\n    forM_ (optShowInterfaceFile flags) $ \\path -> liftIO $ do\n      mIfaceFile <- readInterfaceFiles freshNameCache [((\"\", Nothing), path)]\n      forM_ mIfaceFile $ \\(_, ifaceFile) -> do\n        putMsg dflags (renderJson (jsonInterfaceFile ifaceFile))\n\n    if not (null files) then do\n      (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files\n\n      -- Dump an \"interface file\" (.haddock file), if requested.\n      forM_ (optDumpInterfaceFile flags) $ \\path -> liftIO $ do\n        writeInterfaceFile path InterfaceFile {\n            ifInstalledIfaces = map toInstalledIface ifaces\n          , ifLinkEnv         = homeLinks\n          }\n\n      -- Render the interfaces.\n      liftIO $ renderStep dflags flags sinceQual qual packages ifaces\n\n    else do\n      when (any (`elem` [Flag_Html, Flag_Hoogle, Flag_LaTeX]) flags) $\n        throwE \"No input file(s).\"\n\n      -- Get packages supplied with --read-interface.\n      packages <- liftIO $ readInterfaceFiles freshNameCache (readIfaceArgs flags)\n\n      -- Render even though there are no input files (usually contents/index).\n      liftIO $ renderStep dflags flags sinceQual qual packages []\n\n-- | Create warnings about potential misuse of -optghc\nwarnings :: [String] -> [String]\nwarnings = map format . filter (isPrefixOf \"-optghc\")\n  where\n    format arg = concat [\"Warning: `\", arg, \"' means `-o \", drop 2 arg, \"', did you mean `-\", arg, \"'?\"]\n\n\nwithGhc :: [Flag] -> Ghc a -> IO a\nwithGhc flags action = do\n  libDir <- fmap snd (getGhcDirs flags)\n\n  -- Catches all GHC source errors, then prints and re-throws them.\n  let handleSrcErrors action' = flip handleSourceError action' $ \\err -> do\n        printException err\n        liftIO exitFailure\n\n  withGhc' libDir (ghcFlags flags) (\\_ -> handleSrcErrors action)\n\n\nreadPackagesAndProcessModules :: [Flag] -> [String]\n                              -> Ghc ([(DocPaths, InterfaceFile)], [Interface], LinkEnv)\nreadPackagesAndProcessModules flags files = do\n    -- Get packages supplied with --read-interface.\n    packages <- readInterfaceFiles nameCacheFromGhc (readIfaceArgs flags)\n\n    -- Create the interfaces -- this is the core part of Haddock.\n    let ifaceFiles = map snd packages\n    (ifaces, homeLinks) <- processModules (verbosity flags) files flags ifaceFiles\n\n    return (packages, ifaces, homeLinks)\n\n\nrenderStep :: DynFlags -> [Flag] -> SinceQual -> QualOption\n           -> [(DocPaths, InterfaceFile)] -> [Interface] -> IO ()\nrenderStep dflags flags sinceQual nameQual pkgs interfaces = do\n  updateHTMLXRefs pkgs\n  let\n    ifaceFiles = map snd pkgs\n    installedIfaces = concatMap ifInstalledIfaces ifaceFiles\n    extSrcMap = Map.fromList $ do\n      ((_, Just path), ifile) <- pkgs\n      iface <- ifInstalledIfaces ifile\n      return (instMod iface, path)\n  render dflags flags sinceQual nameQual interfaces installedIfaces extSrcMap\n\n-- | Render the interfaces with whatever backend is specified in the flags.\nrender :: DynFlags -> [Flag] -> SinceQual -> QualOption -> [Interface]\n       -> [InstalledInterface] -> Map Module FilePath -> IO ()\nrender dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do\n\n  let\n    title                = fromMaybe \"\" (optTitle flags)\n    unicode              = Flag_UseUnicode `elem` flags\n    pretty               = Flag_PrettyHtml `elem` flags\n    opt_wiki_urls        = wikiUrls          flags\n    opt_contents_url     = optContentsUrl    flags\n    opt_index_url        = optIndexUrl       flags\n    odir                 = outputDir         flags\n    opt_latex_style      = optLaTeXStyle     flags\n    opt_source_css       = optSourceCssFile  flags\n    opt_mathjax          = optMathjax        flags\n    dflags'\n      | unicode          = gopt_set dflags Opt_PrintUnicodeSyntax\n      | otherwise        = dflags\n\n    visibleIfaces    = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]\n\n    -- /All/ visible interfaces including external package modules.\n    allIfaces        = map toInstalledIface ifaces ++ installedIfaces\n    allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ]\n\n    pkgMod           = ifaceMod (head ifaces)\n    pkgKey           = moduleUnitId pkgMod\n    pkgStr           = Just (unitIdString pkgKey)\n    pkgNameVer       = modulePackageInfo dflags flags pkgMod\n    pkgName          = fmap (unpackFS . (\\(PackageName n) -> n)) (fst pkgNameVer)\n    sincePkg         = case sinceQual of\n                         External -> pkgName\n                         Always -> Nothing\n\n    (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags\n\n    srcModule'\n      | Flag_HyperlinkedSource `elem` flags = Just hypSrcModuleUrlFormat\n      | otherwise = srcModule\n\n    srcMap = Map.union\n      (Map.map SrcExternal extSrcMap)\n      (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ])\n\n    pkgSrcMap = Map.mapKeys moduleUnitId extSrcMap\n    pkgSrcMap'\n      | Flag_HyperlinkedSource `elem` flags =\n          Map.insert pkgKey hypSrcModuleNameUrlFormat pkgSrcMap\n      | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl pkgSrcMap\n      | otherwise = pkgSrcMap\n\n    -- TODO: Get these from the interface files as with srcMap\n    pkgSrcLMap'\n      | Flag_HyperlinkedSource `elem` flags =\n          Map.singleton pkgKey hypSrcModuleLineUrlFormat\n      | Just path <- srcLEntity = Map.singleton pkgKey path\n      | otherwise = Map.empty\n\n    sourceUrls' = (srcBase, srcModule', pkgSrcMap', pkgSrcLMap')\n\n    installedMap :: Map Module InstalledInterface\n    installedMap = Map.fromList [ (unwire (instMod iface), iface) | iface <- installedIfaces ]\n\n    -- The user gives use base-4.9.0.0, but the InstalledInterface\n    -- records the *wired in* identity base.  So untranslate it\n    -- so that we can service the request.\n    unwire :: Module -> Module\n    unwire m = m { moduleUnitId = unwireUnitId dflags (moduleUnitId m) }\n\n  reexportedIfaces <- concat `fmap` (for (reexportFlags flags) $ \\mod_str -> do\n    let warn = hPutStrLn stderr . (\"Warning: \" ++)\n    case readP_to_S parseModuleId mod_str of\n      [(m, \"\")]\n        | Just iface <- Map.lookup m installedMap\n        -> return [iface]\n        | otherwise\n        -> warn (\"Cannot find reexported module '\" ++ mod_str ++ \"'\") >> return []\n      _ -> warn (\"Cannot parse reexported module flag '\" ++ mod_str ++ \"'\") >> return [])\n\n  libDir   <- getHaddockLibDir flags\n  prologue <- getPrologue dflags' flags\n  themes   <- getThemes libDir flags >>= either bye return\n\n  let withQuickjump = Flag_QuickJumpIndex `elem` flags\n\n  when (Flag_GenIndex `elem` flags) $ do\n    withTiming (pure dflags') \"ppHtmlIndex\" (const ()) $ do\n      _ <- {-# SCC ppHtmlIndex #-}\n           ppHtmlIndex odir title pkgStr\n                  themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls\n                  allVisibleIfaces pretty\n      return ()\n\n    copyHtmlBits odir libDir themes withQuickjump\n\n  when (Flag_GenContents `elem` flags) $ do\n    withTiming (pure dflags') \"ppHtmlContents\" (const ()) $ do\n      _ <- {-# SCC ppHtmlContents #-}\n           ppHtmlContents dflags' odir title pkgStr\n                     themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls\n                     allVisibleIfaces True prologue pretty\n                     sincePkg (makeContentsQual qual)\n      return ()\n    copyHtmlBits odir libDir themes withQuickjump\n\n  when (Flag_Html `elem` flags) $ do\n    withTiming (pure dflags') \"ppHtml\" (const ()) $ do\n      _ <- {-# SCC ppHtml #-}\n           ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir\n                  prologue\n                  themes opt_mathjax sourceUrls' opt_wiki_urls\n                  opt_contents_url opt_index_url unicode sincePkg qual\n                  pretty withQuickjump\n      return ()\n    copyHtmlBits odir libDir themes withQuickjump\n    writeHaddockMeta odir withQuickjump\n\n  -- TODO: we throw away Meta for both Hoogle and LaTeX right now,\n  -- might want to fix that if/when these two get some work on them\n  when (Flag_Hoogle `elem` flags) $ do\n    case pkgNameVer of\n      (Just (PackageName pkgNameFS), mpkgVer) ->\n          let\n            pkgNameStr | unpackFS pkgNameFS == \"main\" && title /= [] = title\n                       | otherwise = unpackFS pkgNameFS\n\n            pkgVer =\n              fromMaybe (makeVersion []) mpkgVer\n          in ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)\n               visibleIfaces odir\n      _ -> putStrLn . unlines $\n          [ \"haddock: Unable to find a package providing module \"\n            ++ moduleNameString (moduleName pkgMod) ++ \", skipping Hoogle.\"\n          , \"\"\n          , \"         Perhaps try specifying the desired package explicitly\"\n            ++ \" using the --package-name\"\n          , \"         and --package-version arguments.\"\n          ]\n\n  when (Flag_LaTeX `elem` flags) $ do\n    withTiming (pure dflags') \"ppLatex\" (const ()) $ do\n      _ <- {-# SCC ppLatex #-}\n           ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style\n                   libDir\n      return ()\n\n  when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do\n    withTiming (pure dflags') \"ppHyperlinkedSource\" (const ()) $ do\n      _ <- {-# SCC ppHyperlinkedSource #-}\n           ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces\n      return ()\n\n\n-------------------------------------------------------------------------------\n-- * Reading and dumping interface files\n-------------------------------------------------------------------------------\n\n\nreadInterfaceFiles :: MonadIO m\n                   => NameCacheAccessor m\n                   -> [(DocPaths, FilePath)]\n                   -> m [(DocPaths, InterfaceFile)]\nreadInterfaceFiles name_cache_accessor pairs = do\n  catMaybes `liftM` mapM ({-# SCC readInterfaceFile #-} tryReadIface) pairs\n  where\n    -- try to read an interface, warn if we can't\n    tryReadIface (paths, file) =\n      readInterfaceFile name_cache_accessor file >>= \\case\n        Left err -> liftIO $ do\n          putStrLn (\"Warning: Cannot read \" ++ file ++ \":\")\n          putStrLn (\"   \" ++ err)\n          putStrLn \"Skipping this interface.\"\n          return Nothing\n        Right f -> return $ Just (paths, f)\n\n\n-------------------------------------------------------------------------------\n-- * Creating a GHC session\n-------------------------------------------------------------------------------\n\n\n-- | Start a GHC session with the -haddock flag set. Also turn off\n-- compilation and linking. Then run the given 'Ghc' action.\nwithGhc' :: String -> [String] -> (DynFlags -> Ghc a) -> IO a\nwithGhc' libDir flags ghcActs = runGhc (Just libDir) $ do\n  dynflags  <- getSessionDynFlags\n  dynflags' <- parseGhcFlags (gopt_set dynflags Opt_Haddock) {\n    hscTarget = HscNothing,\n    ghcMode   = CompManager,\n    ghcLink   = NoLink\n    }\n  -- We disable pattern match warnings because than can be very\n  -- expensive to check\n  let dynflags'' = unsetPatternMatchWarnings $\n        updOptLevel 0 $\n        gopt_unset dynflags' Opt_SplitObjs\n  -- ignore the following return-value, which is a list of packages\n  -- that may need to be re-linked: Haddock doesn't do any\n  -- dynamic or static linking at all!\n  _ <- setSessionDynFlags dynflags''\n  ghcActs dynflags''\n  where\n\n    -- ignore sublists of flags that start with \"+RTS\" and end in \"-RTS\"\n    --\n    -- See https://github.com/haskell/haddock/issues/666\n    filterRtsFlags :: [String] -> [String]\n    filterRtsFlags flgs = foldr go (const []) flgs True\n      where go \"-RTS\" func _ = func True\n            go \"+RTS\" func _ = func False\n            go _      func False = func False\n            go arg    func True = arg : func True\n\n\n    parseGhcFlags :: MonadIO m => DynFlags -> m DynFlags\n    parseGhcFlags dynflags = do\n      -- TODO: handle warnings?\n\n      let flags' = filterRtsFlags flags\n      (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags')\n      if not (null rest)\n        then throwE (\"Couldn't parse GHC options: \" ++ unwords flags')\n        else return dynflags'\n\nunsetPatternMatchWarnings :: DynFlags -> DynFlags\nunsetPatternMatchWarnings dflags =\n  foldl' wopt_unset dflags pattern_match_warnings\n  where\n    pattern_match_warnings =\n      [ Opt_WarnIncompletePatterns\n      , Opt_WarnIncompleteUniPatterns\n      , Opt_WarnIncompletePatternsRecUpd\n      , Opt_WarnOverlappingPatterns\n      ]\n\n-------------------------------------------------------------------------------\n-- * Misc\n-------------------------------------------------------------------------------\n\n\ngetHaddockLibDir :: [Flag] -> IO String\ngetHaddockLibDir flags =\n  case [str | Flag_Lib str <- flags] of\n    [] -> do\n#ifdef IN_GHC_TREE\n      getInTreeDir\n#else\n      -- if data directory does not exist we are probably\n      -- invoking from either ./haddock-api or ./\n      let res_dirs = [ getDataDir -- provided by Cabal\n                     , pure \"resources\"\n                     , pure \"haddock-api/resources\"\n                     ]\n\n          check get_path = do\n            p <- get_path\n            exists <- doesDirectoryExist p\n            pure $ if exists then Just p else Nothing\n\n      dirs <- mapM check res_dirs\n      case [p | Just p <- dirs] of\n        (p : _) -> return p\n        _       -> die \"Haddock's resource directory does not exist!\\n\"\n#endif\n    fs -> return (last fs)\n\n\ngetGhcDirs :: [Flag] -> IO (String, String)\ngetGhcDirs flags = do\n  case [ dir | Flag_GhcLibDir dir <- flags ] of\n    [] -> do\n#ifdef IN_GHC_TREE\n      libDir <- getInTreeDir\n      return (ghcPath, libDir)\n#else\n      return (ghcPath, GhcPaths.libdir)\n#endif\n    xs -> return (ghcPath, last xs)\n  where\n#ifdef IN_GHC_TREE\n    ghcPath = \"not available\"\n#else\n    ghcPath = GhcPaths.ghc\n#endif\n\n\nshortcutFlags :: [Flag] -> IO ()\nshortcutFlags flags = do\n  usage <- getUsage\n\n  when (Flag_Help             `elem` flags) (bye usage)\n  when (Flag_Version          `elem` flags) byeVersion\n  when (Flag_InterfaceVersion `elem` flags) (bye (show binaryInterfaceVersion ++ \"\\n\"))\n  when (Flag_CompatibleInterfaceVersions `elem` flags)\n    (bye (unwords (map show binaryInterfaceVersionCompatibility) ++ \"\\n\"))\n  when (Flag_GhcVersion       `elem` flags) (bye (cProjectVersion ++ \"\\n\"))\n\n  when (Flag_PrintGhcPath `elem` flags) $ do\n    dir <- fmap fst (getGhcDirs flags)\n    bye $ dir ++ \"\\n\"\n\n  when (Flag_PrintGhcLibDir `elem` flags) $ do\n    dir <- fmap snd (getGhcDirs flags)\n    bye $ dir ++ \"\\n\"\n\n  when (Flag_UseUnicode `elem` flags && Flag_Html `notElem` flags) $\n    throwE \"Unicode can only be enabled for HTML output.\"\n\n  when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)\n        && Flag_Html `elem` flags) $\n    throwE \"-h/--html cannot be used with --gen-index or --gen-contents\"\n\n  when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)\n        && Flag_Hoogle `elem` flags) $\n    throwE \"--hoogle cannot be used with --gen-index or --gen-contents\"\n\n  when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)\n        && Flag_LaTeX `elem` flags) $\n    throwE \"--latex cannot be used with --gen-index or --gen-contents\"\n  where\n    byeVersion = bye $\n      \"Haddock version \" ++ projectVersion ++ \", (c) Simon Marlow 2006\\n\"\n      ++ \"Ported to use the GHC API by David Waern 2006-2008\\n\"\n\n\n-- | Generate some warnings about potential misuse of @--hyperlinked-source@.\nhypSrcWarnings :: [Flag] -> IO ()\nhypSrcWarnings flags = do\n\n    when (hypSrc && any isSourceUrlFlag flags) $\n        hPutStrLn stderr $ concat\n            [ \"Warning: \"\n            , \"--source-* options are ignored when \"\n            , \"--hyperlinked-source is enabled.\"\n            ]\n\n    when (not hypSrc && any isSourceCssFlag flags) $\n        hPutStrLn stderr $ concat\n            [ \"Warning: \"\n            , \"source CSS file is specified but \"\n            , \"--hyperlinked-source is disabled.\"\n            ]\n\n  where\n    hypSrc = Flag_HyperlinkedSource `elem` flags\n    isSourceUrlFlag (Flag_SourceBaseURL _) = True\n    isSourceUrlFlag (Flag_SourceModuleURL _) = True\n    isSourceUrlFlag (Flag_SourceEntityURL _) = True\n    isSourceUrlFlag (Flag_SourceLEntityURL _) = True\n    isSourceUrlFlag _ = False\n    isSourceCssFlag (Flag_SourceCss _) = True\n    isSourceCssFlag _ = False\n\n\nupdateHTMLXRefs :: [(DocPaths, InterfaceFile)] -> IO ()\nupdateHTMLXRefs packages = do\n  writeIORef html_xrefs_ref (Map.fromList mapping)\n  writeIORef html_xrefs_ref' (Map.fromList mapping')\n  where\n    mapping = [ (instMod iface, html) | ((html, _), ifaces) <- packages\n              , iface <- ifInstalledIfaces ifaces ]\n    mapping' = [ (moduleName m, html) | (m, html) <- mapping ]\n\n\ngetPrologue :: DynFlags -> [Flag] -> IO (Maybe (MDoc RdrName))\ngetPrologue dflags flags =\n  case [filename | Flag_Prologue filename <- flags ] of\n    [] -> return Nothing\n    [filename] -> do\n      h <- openFile filename ReadMode\n      hSetEncoding h utf8\n      str <- hGetContents h -- semi-closes the handle\n      return . Just $! parseParas dflags Nothing str\n    _ -> throwE \"multiple -p/--prologue options\"\n\n\nrightOrThrowE :: Either String b -> IO b\nrightOrThrowE (Left msg) = throwE msg\nrightOrThrowE (Right x) = pure x\n\n\n#ifdef IN_GHC_TREE\n\ngetInTreeDir :: IO String\ngetInTreeDir = getExecDir >>= \\case\n  Nothing -> error \"No GhcDir found\"\n  Just d -> return (d </> \"..\" </> \"lib\")\n\n\ngetExecDir :: IO (Maybe String)\n#if defined(mingw32_HOST_OS)\ngetExecDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.\n  where\n    try_size size = allocaArray (fromIntegral size) $ \\buf -> do\n        ret <- c_GetModuleFileName nullPtr buf size\n        case ret of\n          0 -> return Nothing\n          _ | ret < size -> fmap (Just . dropFileName) $ peekCWString buf\n            | otherwise  -> try_size (size * 2)\n\n# if defined(i386_HOST_ARCH)\n#  define WINDOWS_CCONV stdcall\n# elif defined(x86_64_HOST_ARCH)\n#  define WINDOWS_CCONV ccall\n# else\n#  error Unknown mingw32 arch\n# endif\n\nforeign import WINDOWS_CCONV unsafe \"windows.h GetModuleFileNameW\"\n  c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32\n#else\ngetExecDir = return Nothing\n#endif\n\n#endif\n", "num_lines": 660}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Documentation.Haddock\n-- Copyright   :  (c) David Waern 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskellorg\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- The Haddock API: A rudimentory, highly experimental API exposing some of\n-- the internals of Haddock. Don't expect it to be stable.\n-----------------------------------------------------------------------------\nmodule Documentation.Haddock (\n\n  -- * Interface\n  Interface(..),\n  InstalledInterface(..),\n  toInstalledIface,\n  createInterfaces,\n  processModules,\n\n  -- * Export items & declarations\n  ExportItem(..),\n  DocForDecl,\n  FnArgsDoc,\n\n  -- * Cross-referencing\n  LinkEnv,\n  DocName(..),\n\n  -- * Instances\n  DocInstance,\n  InstHead,\n\n  -- * Documentation comments\n  Doc,\n  MDoc,\n  DocH(..),\n  Example(..),\n  Hyperlink(..),\n  DocMarkup,\n  DocMarkupH(..),\n  Documentation(..),\n  ArgMap,\n  AliasMap,\n  WarningMap,\n  DocMap,\n  HaddockModInfo(..),\n  markup,\n\n  -- * Interface files\n  InterfaceFile(..),\n  readInterfaceFile,\n  nameCacheFromGhc,\n  freshNameCache,\n  NameCacheAccessor,\n\n  -- * Flags and options\n  Flag(..),\n  DocOption(..),\n\n  -- * Error handling\n  HaddockException(..),\n\n  -- * Program entry point\n  haddock,\n  haddockWithGhc,\n  getGhcDirs,\n  withGhc\n) where\n\nimport Documentation.Haddock.Markup (markup)\nimport Haddock.InterfaceFile\nimport Haddock.Interface\nimport Haddock.Types\nimport Haddock.Options\nimport Haddock\n\n\n-- | Create 'Interface' structures from a given list of Haddock command-line\n-- flags and file or module names (as accepted by 'haddock' executable).  Flags\n-- that control documentation generation or show help or version information\n-- are ignored.\ncreateInterfaces\n  :: [Flag]         -- ^ A list of command-line flags\n  -> [String]       -- ^ File or module names\n  -> IO [Interface] -- ^ Resulting list of interfaces\ncreateInterfaces flags modules = do\n  (_, ifaces, _) <- withGhc flags (readPackagesAndProcessModules flags modules)\n  return ifaces\n", "num_lines": 92}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, PatternGuards #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Convert\n-- Copyright   :  (c) Isaac Dupree 2009,\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Conversion between TyThing and HsDecl. This functionality may be moved into\n-- GHC at some point.\n-----------------------------------------------------------------------------\nmodule Haddock.Convert where\n-- Some other functions turned out to be useful for converting\n-- instance heads, which aren't TyThings, so just export everything.\n\nimport Bag ( emptyBag )\nimport BasicTypes ( TupleSort(..), SourceText(..), LexicalFixity(..) )\nimport Class\nimport CoAxiom\nimport ConLike\nimport Data.Either (lefts, rights)\nimport DataCon\nimport FamInstEnv\nimport FV\nimport HsSyn\nimport Name\nimport NameSet ( emptyNameSet )\nimport RdrName ( mkVarUnqual )\nimport PatSyn\nimport SrcLoc ( Located, noLoc, unLoc, GenLocated(..), srcLocSpan )\nimport TcType\nimport TyCon\nimport Type\nimport TyCoRep\nimport TysPrim ( alphaTyVars )\nimport TysWiredIn ( listTyConName, starKindTyConName, unitTy )\nimport PrelNames ( hasKey, eqTyConKey, ipClassKey\n                 , tYPETyConKey, liftedRepDataConKey )\nimport Unique ( getUnique )\nimport Util ( chkAppend, compareLength, dropList, filterByList, filterOut\n            , splitAtList )\nimport Var\nimport VarSet\n\nimport Haddock.Types\nimport Haddock.Interface.Specialize\n\n\n\n-- the main function here! yay!\ntyThingToLHsDecl :: TyThing -> Either ErrMsg ([ErrMsg], (HsDecl GhcRn))\ntyThingToLHsDecl t = case t of\n  -- ids (functions and zero-argument a.k.a. CAFs) get a type signature.\n  -- Including built-in functions like seq.\n  -- foreign-imported functions could be represented with ForD\n  -- instead of SigD if we wanted...\n  --\n  -- in a future code version we could turn idVarDetails = foreign-call\n  -- into a ForD instead of a SigD if we wanted.  Haddock doesn't\n  -- need to care.\n  AnId i -> allOK $ SigD (synifyIdSig ImplicitizeForAll i)\n\n  -- type-constructors (e.g. Maybe) are complicated, put the definition\n  -- later in the file (also it's used for class associated-types too.)\n  ATyCon tc\n    | Just cl <- tyConClass_maybe tc -- classes are just a little tedious\n    -> let extractFamilyDecl :: TyClDecl a -> Either ErrMsg (LFamilyDecl a)\n           extractFamilyDecl (FamDecl d) = return $ noLoc d\n           extractFamilyDecl _           =\n             Left \"tyThingToLHsDecl: impossible associated tycon\"\n\n           atTyClDecls = [synifyTyCon Nothing at_tc | ATI at_tc _ <- classATItems cl]\n           atFamDecls  = map extractFamilyDecl (rights atTyClDecls)\n           tyClErrors = lefts atTyClDecls\n           famDeclErrors = lefts atFamDecls\n       in withErrs (tyClErrors ++ famDeclErrors) . TyClD $ ClassDecl\n         { tcdCtxt = synifyCtx (classSCTheta cl)\n         , tcdLName = synifyName cl\n         , tcdTyVars = synifyTyVars (tyConVisibleTyVars (classTyCon cl))\n         , tcdFixity = Prefix\n         , tcdFDs = map (\\ (l,r) -> noLoc\n                        (map (noLoc . getName) l, map (noLoc . getName) r) ) $\n                         snd $ classTvsFds cl\n         , tcdSigs = noLoc (MinimalSig NoSourceText . noLoc . fmap noLoc $ classMinimalDef cl) :\n                      map (noLoc . synifyTcIdSig DeleteTopLevelQuantification)\n                        (classMethods cl)\n         , tcdMeths = emptyBag --ignore default method definitions, they don't affect signature\n         -- class associated-types are a subset of TyCon:\n         , tcdATs = rights atFamDecls\n         , tcdATDefs = [] --ignore associated type defaults\n         , tcdDocs = [] --we don't have any docs at this point\n         , tcdFVs = placeHolderNamesTc }\n    | otherwise\n    -> synifyTyCon Nothing tc >>= allOK . TyClD\n\n  -- type-constructors (e.g. Maybe) are complicated, put the definition\n  -- later in the file (also it's used for class associated-types too.)\n  ACoAxiom ax -> synifyAxiom ax >>= allOK\n\n  -- a data-constructor alone just gets rendered as a function:\n  AConLike (RealDataCon dc) -> allOK $ SigD (TypeSig [synifyName dc]\n    (synifySigWcType ImplicitizeForAll (dataConUserType dc)))\n\n  AConLike (PatSynCon ps) ->\n    allOK . SigD $ PatSynSig [synifyName ps] (synifyPatSynSigType ps)\n  where\n    withErrs e x = return (e, x)\n    allOK x = return (mempty, x)\n\nsynifyAxBranch :: TyCon -> CoAxBranch -> TyFamInstEqn GhcRn\nsynifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })\n  = let name            = synifyName tc\n        args_types_only = filterOutInvisibleTypes tc args\n        typats          = map (synifyType WithinType) args_types_only\n        annot_typats    = zipWith3 annotHsType (mkIsPolyTvs fam_tvs)\n                                   args_types_only typats\n        hs_rhs          = synifyType WithinType rhs\n    in HsIB { hsib_vars   = map tyVarName tkvs\n            , hsib_closed = True\n            , hsib_body   = FamEqn { feqn_tycon  = name\n                                   , feqn_pats   = annot_typats\n                                   , feqn_fixity = Prefix\n                                   , feqn_rhs    = hs_rhs } }\n  where\n    fam_tvs = tyConVisibleTyVars tc\n\nsynifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl GhcRn)\nsynifyAxiom ax@(CoAxiom { co_ax_tc = tc })\n  | isOpenTypeFamilyTyCon tc\n  , Just branch <- coAxiomSingleBranch_maybe ax\n  = return $ InstD\n           $ TyFamInstD\n           $ TyFamInstDecl { tfid_eqn = synifyAxBranch tc branch }\n\n  | Just ax' <- isClosedSynFamilyTyConWithAxiom_maybe tc\n  , getUnique ax' == getUnique ax   -- without the getUniques, type error\n  = synifyTyCon (Just ax) tc >>= return . TyClD\n\n  | otherwise\n  = Left \"synifyAxiom: closed/open family confusion\"\n\n-- | Turn type constructors into type class declarations\nsynifyTyCon :: Maybe (CoAxiom br) -> TyCon -> Either ErrMsg (TyClDecl GhcRn)\nsynifyTyCon _coax tc\n  | isFunTyCon tc || isPrimTyCon tc\n  = return $\n    DataDecl { tcdLName = synifyName tc\n             , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:\n                         let mk_hs_tv realKind fakeTyVar\n                                = noLoc $ KindedTyVar (noLoc (getName fakeTyVar))\n                                                      (synifyKindSig realKind)\n                         in HsQTvs { hsq_implicit = []   -- No kind polymorphism\n                                   , hsq_explicit = zipWith mk_hs_tv (fst (splitFunTys (tyConKind tc)))\n                                                                alphaTyVars --a, b, c... which are unfortunately all kind *\n                                   , hsq_dependent = emptyNameSet }\n\n           , tcdFixity = Prefix\n\n           , tcdDataDefn = HsDataDefn { dd_ND = DataType  -- arbitrary lie, they are neither\n                                                    -- algebraic data nor newtype:\n                                      , dd_ctxt = noLoc []\n                                      , dd_cType = Nothing\n                                      , dd_kindSig = synifyDataTyConReturnKind tc\n                                               -- we have their kind accurately:\n                                      , dd_cons = []  -- No constructors\n                                      , dd_derivs = noLoc [] }\n           , tcdDataCusk = False\n           , tcdFVs = placeHolderNamesTc }\n\nsynifyTyCon _coax tc\n  | Just flav <- famTyConFlav_maybe tc\n  = case flav of\n      -- Type families\n      OpenSynFamilyTyCon -> mkFamDecl OpenTypeFamily\n      ClosedSynFamilyTyCon mb\n        | Just (CoAxiom { co_ax_branches = branches }) <- mb\n          -> mkFamDecl $ ClosedTypeFamily $ Just\n            $ map (noLoc . synifyAxBranch tc) (fromBranches branches)\n        | otherwise\n          -> mkFamDecl $ ClosedTypeFamily $ Just []\n      BuiltInSynFamTyCon {}\n        -> mkFamDecl $ ClosedTypeFamily $ Just []\n      AbstractClosedSynFamilyTyCon {}\n        -> mkFamDecl $ ClosedTypeFamily Nothing\n      DataFamilyTyCon {}\n        -> mkFamDecl DataFamily\n  where\n    resultVar = famTcResVar tc\n    mkFamDecl i = return $ FamDecl $\n      FamilyDecl { fdInfo = i\n                 , fdLName = synifyName tc\n                 , fdTyVars = synifyTyVars (tyConVisibleTyVars tc)\n                 , fdFixity = Prefix\n                 , fdResultSig =\n                       synifyFamilyResultSig resultVar (tyConResKind tc)\n                 , fdInjectivityAnn =\n                       synifyInjectivityAnn  resultVar (tyConTyVars tc)\n                                       (tyConInjectivityInfo tc)\n                 }\n\nsynifyTyCon coax tc\n  | Just ty <- synTyConRhs_maybe tc\n  = return $ SynDecl { tcdLName = synifyName tc\n                     , tcdTyVars = synifyTyVars (tyConVisibleTyVars tc)\n                     , tcdFixity = Prefix\n                     , tcdRhs = synifyType WithinType ty\n                     , tcdFVs = placeHolderNamesTc }\n  | otherwise =\n  -- (closed) newtype and data\n  let\n  alg_nd = if isNewTyCon tc then NewType else DataType\n  alg_ctx = synifyCtx (tyConStupidTheta tc)\n  name = case coax of\n    Just a -> synifyName a -- Data families are named according to their\n                           -- CoAxioms, not their TyCons\n    _ -> synifyName tc\n  tyvars = synifyTyVars (tyConVisibleTyVars tc)\n  kindSig = synifyDataTyConReturnKind tc\n  -- The data constructors.\n  --\n  -- Any data-constructors not exported from the module that *defines* the\n  -- type will not (cannot) be included.\n  --\n  -- Very simple constructors, Haskell98 with no existentials or anything,\n  -- probably look nicer in non-GADT syntax.  In source code, all constructors\n  -- must be declared with the same (GADT vs. not) syntax, and it probably\n  -- is less confusing to follow that principle for the documentation as well.\n  --\n  -- There is no sensible infix-representation for GADT-syntax constructor\n  -- declarations.  They cannot be made in source code, but we could end up\n  -- with some here in the case where some constructors use existentials.\n  -- That seems like an acceptable compromise (they'll just be documented\n  -- in prefix position), since, otherwise, the logic (at best) gets much more\n  -- complicated. (would use dataConIsInfix.)\n  use_gadt_syntax = any (not . isVanillaDataCon) (tyConDataCons tc)\n  consRaw = map (synifyDataCon use_gadt_syntax) (tyConDataCons tc)\n  cons = rights consRaw\n  -- \"deriving\" doesn't affect the signature, no need to specify any.\n  alg_deriv = noLoc []\n  defn = HsDataDefn { dd_ND      = alg_nd\n                    , dd_ctxt    = alg_ctx\n                    , dd_cType   = Nothing\n                    , dd_kindSig = kindSig\n                    , dd_cons    = cons\n                    , dd_derivs  = alg_deriv }\n in case lefts consRaw of\n  [] -> return $\n        DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdFixity = Prefix\n                 , tcdDataDefn = defn\n                 , tcdDataCusk = False, tcdFVs = placeHolderNamesTc }\n  dataConErrs -> Left $ unlines dataConErrs\n\n-- In this module, every TyCon being considered has come from an interface\n-- file. This means that when considering a data type constructor such as:\n--\n--   data Foo (w :: *) (m :: * -> *) (a :: *)\n--\n-- Then its tyConKind will be (* -> (* -> *) -> * -> *). But beware! We are\n-- also rendering the type variables of Foo, so if we synify the tyConKind of\n-- Foo in full, we will end up displaying this in Haddock:\n--\n--   data Foo (w :: *) (m :: * -> *) (a :: *)\n--     :: * -> (* -> *) -> * -> *\n--\n-- Which is entirely wrong (#548). We only want to display the *return* kind,\n-- which this function obtains.\nsynifyDataTyConReturnKind :: TyCon -> Maybe (LHsKind GhcRn)\nsynifyDataTyConReturnKind tc\n  = case splitFunTys (tyConKind tc) of\n      (_, ret_kind)\n        | isLiftedTypeKind ret_kind -> Nothing -- Don't bother displaying :: *\n        | otherwise                 -> Just (synifyKindSig ret_kind)\n\nsynifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity\n                     -> Maybe (LInjectivityAnn GhcRn)\nsynifyInjectivityAnn Nothing _ _            = Nothing\nsynifyInjectivityAnn _       _ NotInjective = Nothing\nsynifyInjectivityAnn (Just lhs) tvs (Injective inj) =\n    let rhs = map (noLoc . tyVarName) (filterByList inj tvs)\n    in Just $ noLoc $ InjectivityAnn (noLoc lhs) rhs\n\nsynifyFamilyResultSig :: Maybe Name -> Kind -> LFamilyResultSig GhcRn\nsynifyFamilyResultSig  Nothing    kind =\n   noLoc $ KindSig  (synifyKindSig kind)\nsynifyFamilyResultSig (Just name) kind =\n   noLoc $ TyVarSig (noLoc $ KindedTyVar (noLoc name) (synifyKindSig kind))\n\n-- User beware: it is your responsibility to pass True (use_gadt_syntax)\n-- for any constructor that would be misrepresented by omitting its\n-- result-type.\n-- But you might want pass False in simple enough cases,\n-- if you think it looks better.\nsynifyDataCon :: Bool -> DataCon -> Either ErrMsg (LConDecl GhcRn)\nsynifyDataCon use_gadt_syntax dc =\n let\n  -- dataConIsInfix allegedly tells us whether it was declared with\n  -- infix *syntax*.\n  use_infix_syntax = dataConIsInfix dc\n  use_named_field_syntax = not (null field_tys)\n  name = synifyName dc\n  -- con_qvars means a different thing depending on gadt-syntax\n  (univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc\n\n  qvars = if use_gadt_syntax\n          then synifyTyVars (univ_tvs ++ ex_tvs)\n          else synifyTyVars ex_tvs\n\n  -- skip any EqTheta, use 'orig'inal syntax\n  ctx = synifyCtx theta\n\n  linear_tys =\n    zipWith (\\ty bang ->\n               let tySyn = synifyType WithinType ty\n               in case bang of\n                    (HsSrcBang _ NoSrcUnpack NoSrcStrict) -> tySyn\n                    bang' -> noLoc $ HsBangTy bang' tySyn)\n            arg_tys (dataConSrcBangs dc)\n\n  field_tys = zipWith con_decl_field (dataConFieldLabels dc) linear_tys\n  con_decl_field fl synTy = noLoc $\n    ConDeclField [noLoc $ FieldOcc (noLoc $ mkVarUnqual $ flLabel fl) (flSelector fl)] synTy\n                 Nothing\n  hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of\n          (True,True) -> Left \"synifyDataCon: contradiction!\"\n          (True,False) -> return $ RecCon (noLoc field_tys)\n          (False,False) -> return $ PrefixCon linear_tys\n          (False,True) -> case linear_tys of\n                           [a,b] -> return $ InfixCon a b\n                           _ -> Left \"synifyDataCon: infix with non-2 args?\"\n  gadt_ty = HsIB [] (synifyType WithinType res_ty) False\n -- finally we get synifyDataCon's result!\n in hs_arg_tys >>=\n      \\hat ->\n        if use_gadt_syntax\n           then return $ noLoc $\n              ConDeclGADT { con_names = [name]\n                          , con_type = gadt_ty\n                          , con_doc =  Nothing }\n           else return $ noLoc $\n              ConDeclH98 { con_name = name\n                         , con_qvars = Just qvars\n                         , con_cxt   = Just ctx\n                         , con_details =  hat\n                         , con_doc =  Nothing }\n\nsynifyName :: NamedThing n => n -> Located Name\nsynifyName n = L (srcLocSpan (getSrcLoc n)) (getName n)\n\n\nsynifyIdSig :: SynifyTypeState -> Id -> Sig GhcRn\nsynifyIdSig s i = TypeSig [synifyName i] (synifySigWcType s (varType i))\n\nsynifyTcIdSig :: SynifyTypeState -> Id -> Sig GhcRn\nsynifyTcIdSig s i = ClassOpSig False [synifyName i] (synifySigType s (varType i))\n\nsynifyCtx :: [PredType] -> LHsContext GhcRn\nsynifyCtx = noLoc . map (synifyType WithinType)\n\n\nsynifyTyVars :: [TyVar] -> LHsQTyVars GhcRn\nsynifyTyVars ktvs = HsQTvs { hsq_implicit = []\n                           , hsq_explicit = map synifyTyVar ktvs\n                           , hsq_dependent = emptyNameSet }\n\nsynifyTyVar :: TyVar -> LHsTyVarBndr GhcRn\nsynifyTyVar tv\n  | isLiftedTypeKind kind = noLoc (UserTyVar (noLoc name))\n  | otherwise             = noLoc (KindedTyVar (noLoc name) (synifyKindSig kind))\n  where\n    kind = tyVarKind tv\n    name = getName tv\n\n-- | Annotate (with HsKingSig) a type if the first parameter is True\n-- and if the type contains a free variable.\n-- This is used to synify type patterns for poly-kinded tyvars in\n-- synifying class and type instances.\nannotHsType :: Bool   -- True <=> annotate\n            -> Type -> LHsType GhcRn -> LHsType GhcRn\n  -- tiny optimization: if the type is annotated, don't annotate again.\nannotHsType _    _  hs_ty@(L _ (HsKindSig {})) = hs_ty\nannotHsType True ty hs_ty\n  | not $ isEmptyVarSet $ filterVarSet isTyVar $ tyCoVarsOfType ty\n  = let ki    = typeKind ty\n        hs_ki = synifyType WithinType ki\n    in noLoc (HsKindSig hs_ty hs_ki)\nannotHsType _    _ hs_ty = hs_ty\n\n-- | For every type variable in the input,\n-- report whether or not the tv is poly-kinded. This is used to eventually\n-- feed into 'annotHsType'.\nmkIsPolyTvs :: [TyVar] -> [Bool]\nmkIsPolyTvs = map is_poly_tv\n  where\n    is_poly_tv tv = not $\n                    isEmptyVarSet $\n                    filterVarSet isTyVar $\n                    tyCoVarsOfType $\n                    tyVarKind tv\n\n--states of what to do with foralls:\ndata SynifyTypeState\n  = WithinType\n  -- ^ normal situation.  This is the safe one to use if you don't\n  -- quite understand what's going on.\n  | ImplicitizeForAll\n  -- ^ beginning of a function definition, in which, to make it look\n  --   less ugly, those rank-1 foralls are made implicit.\n  | DeleteTopLevelQuantification\n  -- ^ because in class methods the context is added to the type\n  --   (e.g. adding @forall a. Num a =>@ to @(+) :: a -> a -> a@)\n  --   which is rather sensible,\n  --   but we want to restore things to the source-syntax situation where\n  --   the defining class gets to quantify all its functions for free!\n\n\nsynifySigType :: SynifyTypeState -> Type -> LHsSigType GhcRn\n-- The empty binders is a bit suspicious;\n-- what if the type has free variables?\nsynifySigType s ty = mkEmptyImplicitBndrs (synifyType s ty)\n\nsynifySigWcType :: SynifyTypeState -> Type -> LHsSigWcType GhcRn\n-- Ditto (see synifySigType)\nsynifySigWcType s ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs (synifyType s ty))\n\nsynifyPatSynSigType :: PatSyn -> LHsSigType GhcRn\n-- Ditto (see synifySigType)\nsynifyPatSynSigType ps = mkEmptyImplicitBndrs (synifyPatSynType ps)\n\nsynifyType :: SynifyTypeState -> Type -> LHsType GhcRn\nsynifyType _ (TyVarTy tv) = noLoc $ HsTyVar NotPromoted $ noLoc (getName tv)\nsynifyType _ (TyConApp tc tys)\n  = maybe_sig res_ty\n  where\n    res_ty :: LHsType GhcRn\n    res_ty\n      -- Use */# instead of TYPE 'Lifted/TYPE 'Unlifted (#473)\n      | tc `hasKey` tYPETyConKey\n      , [TyConApp lev []] <- tys\n      , lev `hasKey` liftedRepDataConKey\n      = noLoc (HsTyVar NotPromoted (noLoc starKindTyConName))\n      -- Use non-prefix tuple syntax where possible, because it looks nicer.\n      | Just sort <- tyConTuple_maybe tc\n      , tyConArity tc == length tys\n      = noLoc $ HsTupleTy (case sort of\n                              BoxedTuple      -> HsBoxedTuple\n                              ConstraintTuple -> HsConstraintTuple\n                              UnboxedTuple    -> HsUnboxedTuple)\n                           (map (synifyType WithinType) vis_tys)\n      -- ditto for lists\n      | getName tc == listTyConName, [ty] <- tys =\n         noLoc $ HsListTy (synifyType WithinType ty)\n      -- ditto for implicit parameter tycons\n      | tc `hasKey` ipClassKey\n      , [name, ty] <- tys\n      , Just x <- isStrLitTy name\n      = noLoc $ HsIParamTy (noLoc $ HsIPName x) (synifyType WithinType ty)\n      -- and equalities\n      | tc `hasKey` eqTyConKey\n      , [ty1, ty2] <- tys\n      = noLoc $ HsEqTy (synifyType WithinType ty1) (synifyType WithinType ty2)\n      -- and infix type operators\n      | isSymOcc (nameOccName (getName tc))\n      , ty1:ty2:tys_rest <- vis_tys\n      = mk_app_tys (HsOpTy (synifyType WithinType ty1)\n                           (noLoc $ getName tc)\n                           (synifyType WithinType ty2))\n                   tys_rest\n      -- Most TyCons:\n      | otherwise\n      = mk_app_tys (HsTyVar NotPromoted $ noLoc (getName tc))\n                   vis_tys\n      where\n        mk_app_tys ty_app ty_args =\n          foldl (\\t1 t2 -> noLoc $ HsAppTy t1 t2)\n                (noLoc ty_app)\n                (map (synifyType WithinType) $\n                 filterOut isCoercionTy ty_args)\n\n    vis_tys  = filterOutInvisibleTypes tc tys\n    binders  = tyConBinders tc\n    res_kind = tyConResKind tc\n\n    maybe_sig :: LHsType GhcRn -> LHsType GhcRn\n    maybe_sig ty'\n      | needs_kind_sig\n      = let full_kind  = typeKind (mkTyConApp tc tys)\n            full_kind' = synifyType WithinType full_kind\n        in noLoc $ HsKindSig ty' full_kind'\n      | otherwise = ty'\n\n    needs_kind_sig :: Bool\n    needs_kind_sig\n      | GT <- compareLength tys binders\n      = False\n      | otherwise\n      = let (dropped_binders, remaining_binders)\n                  = splitAtList  tys binders\n            result_kind  = mkTyConKind remaining_binders res_kind\n            result_vars  = tyCoVarsOfType result_kind\n            dropped_vars = fvVarSet $\n                           mapUnionFV injectiveVarsOfBinder dropped_binders\n\n        in not (subVarSet result_vars dropped_vars)\n\nsynifyType s (AppTy t1 (CoercionTy {})) = synifyType s t1\nsynifyType _ (AppTy t1 t2) = let\n  s1 = synifyType WithinType t1\n  s2 = synifyType WithinType t2\n  in noLoc $ HsAppTy s1 s2\nsynifyType _ (FunTy t1 t2) = let\n  s1 = synifyType WithinType t1\n  s2 = synifyType WithinType t2\n  in noLoc $ HsFunTy s1 s2\nsynifyType s forallty@(ForAllTy _tv _ty) =\n  let (tvs, ctx, tau) = tcSplitSigmaTyPreserveSynonyms forallty\n      sPhi = HsQualTy { hst_ctxt = synifyCtx ctx\n                      , hst_body = synifyType WithinType tau }\n  in case s of\n    DeleteTopLevelQuantification -> synifyType ImplicitizeForAll tau\n    WithinType        -> noLoc $ HsForAllTy { hst_bndrs = map synifyTyVar tvs\n                                            , hst_body  = noLoc sPhi }\n    ImplicitizeForAll -> noLoc sPhi\n\nsynifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t\nsynifyType s (CastTy t _) = synifyType s t\nsynifyType _ (CoercionTy {}) = error \"synifyType:Coercion\"\n\nsynifyPatSynType :: PatSyn -> LHsType GhcRn\nsynifyPatSynType ps = let\n  (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, res_ty) = patSynSig ps\n  req_theta' | null req_theta && not (null prov_theta && null ex_tvs) = [unitTy]\n               -- HACK: a HsQualTy with theta = [unitTy] will be printed as \"() =>\",\n               -- i.e., an explicit empty context, which is what we need. This is not\n               -- possible by taking theta = [], as that will print no context at all\n             | otherwise = req_theta\n  sForAll []  s = s\n  sForAll tvs s = HsForAllTy { hst_bndrs = map synifyTyVar tvs\n                             , hst_body  = noLoc s }\n  sQual theta s = HsQualTy   { hst_ctxt  = synifyCtx theta\n                             , hst_body  = noLoc s }\n  sTau = unLoc $ synifyType WithinType $ mkFunTys arg_tys res_ty\n  in noLoc $ sForAll univ_tvs $ sQual req_theta' $ sForAll ex_tvs $ sQual prov_theta sTau\n\nsynifyTyLit :: TyLit -> HsTyLit\nsynifyTyLit (NumTyLit n) = HsNumTy NoSourceText n\nsynifyTyLit (StrTyLit s) = HsStrTy NoSourceText s\n\nsynifyKindSig :: Kind -> LHsKind GhcRn\nsynifyKindSig k = synifyType WithinType k\n\nsynifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead GhcRn\nsynifyInstHead (_, preds, cls, types) = specializeInstHead $ InstHead\n    { ihdClsName = getName cls\n    , ihdTypes = map unLoc annot_ts\n    , ihdInstType = ClassInst\n        { clsiCtx = map (unLoc . synifyType WithinType) preds\n        , clsiTyVars = synifyTyVars (tyConVisibleTyVars cls_tycon)\n        , clsiSigs = map synifyClsIdSig $ classMethods cls\n        , clsiAssocTys = do\n            (Right (FamDecl fam)) <- map (synifyTyCon Nothing) $ classATs cls\n            pure $ mkPseudoFamilyDecl fam\n        }\n    }\n  where\n    cls_tycon = classTyCon cls\n    ts  = filterOutInvisibleTypes cls_tycon types\n    ts' = map (synifyType WithinType) ts\n    annot_ts = zipWith3 annotHsType is_poly_tvs ts ts'\n    is_poly_tvs = mkIsPolyTvs (tyConVisibleTyVars cls_tycon)\n    synifyClsIdSig = synifyIdSig DeleteTopLevelQuantification\n\n-- Convert a family instance, this could be a type family or data family\nsynifyFamInst :: FamInst -> Bool -> Either ErrMsg (InstHead GhcRn)\nsynifyFamInst fi opaque = do\n    ityp' <- ityp fam_flavor\n    return InstHead\n        { ihdClsName = fi_fam fi\n        , ihdTypes = map unLoc annot_ts\n        , ihdInstType = ityp'\n        }\n  where\n    ityp SynFamilyInst | opaque = return $ TypeInst Nothing\n    ityp SynFamilyInst =\n        return . TypeInst . Just . unLoc $ synifyType WithinType fam_rhs\n    ityp (DataFamilyInst c) =\n        DataInst <$> synifyTyCon (Just $ famInstAxiom fi) c\n    fam_tc     = famInstTyCon fi\n    fam_flavor = fi_flavor fi\n    fam_lhs    = fi_tys fi\n    fam_rhs    = fi_rhs fi\n\n    eta_expanded_lhs\n      -- eta-expand lhs types, because sometimes data/newtype\n      -- instances are eta-reduced; See Trac #9692\n      -- See Note [Eta reduction for data family axioms] in TcInstDcls in GHC\n      | DataFamilyInst rep_tc <- fam_flavor\n      = let (_, rep_tc_args) = splitTyConApp fam_rhs\n            etad_tyvars      = dropList rep_tc_args $ tyConTyVars rep_tc\n            etad_tys         = mkTyVarTys etad_tyvars\n            eta_exp_lhs      = fam_lhs `chkAppend` etad_tys\n        in eta_exp_lhs\n      | otherwise\n      = fam_lhs\n\n    ts = filterOutInvisibleTypes fam_tc eta_expanded_lhs\n    synifyTypes = map (synifyType WithinType)\n    ts' = synifyTypes ts\n    annot_ts = zipWith3 annotHsType is_poly_tvs ts ts'\n    is_poly_tvs = mkIsPolyTvs (tyConVisibleTyVars fam_tc)\n\n{-\nNote [Invariant: Never expand type synonyms]\n\nIn haddock, we never want to expand a type synonym that may be presented to the\nuser, as we want to keep the link to the abstraction captured in the synonym.\n\nAll code in Haddock.Convert must make sure that this invariant holds.\n\nSee https://github.com/haskell/haddock/issues/879 for a bug where this\ninvariant didn't hold.\n-}\n\n-- | A version of 'TcType.tcSplitSigmaTy' that preserves type synonyms.\n--\n-- See Note [Invariant: Never expand type synonyms]\ntcSplitSigmaTyPreserveSynonyms :: Type -> ([TyVar], ThetaType, Type)\ntcSplitSigmaTyPreserveSynonyms ty =\n    case tcSplitForAllTysPreserveSynonyms ty of\n      (tvs, rho) -> case tcSplitPhiTyPreserveSynonyms rho of\n        (theta, tau) -> (tvs, theta, tau)\n\n-- | See Note [Invariant: Never expand type synonyms]\ntcSplitForAllTysPreserveSynonyms :: Type -> ([TyVar], Type)\ntcSplitForAllTysPreserveSynonyms ty = split ty ty []\n  where\n    split _       (ForAllTy (TvBndr tv _) ty') tvs = split ty' ty' (tv:tvs)\n    split orig_ty _                            tvs = (reverse tvs, orig_ty)\n\n-- | See Note [Invariant: Never expand type synonyms]\ntcSplitPhiTyPreserveSynonyms :: Type -> (ThetaType, Type)\ntcSplitPhiTyPreserveSynonyms ty0 = split ty0 []\n  where\n    split ty ts\n      = case tcSplitPredFunTyPreserveSynonyms_maybe ty of\n          Just (pred_, ty') -> split ty' (pred_:ts)\n          Nothing           -> (reverse ts, ty)\n\n-- | See Note [Invariant: Never expand type synonyms]\ntcSplitPredFunTyPreserveSynonyms_maybe :: Type -> Maybe (PredType, Type)\ntcSplitPredFunTyPreserveSynonyms_maybe (FunTy arg res)\n  | isPredTy arg = Just (arg, res)\ntcSplitPredFunTyPreserveSynonyms_maybe _\n  = Nothing\n", "num_lines": 657}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule Haddock.Doc ( module Documentation.Haddock.Doc\n                   , docCodeBlock\n                   , combineDocumentation\n                   ) where\n\nimport Data.Maybe\nimport Documentation.Haddock.Doc\nimport Haddock.Types\nimport Haddock.Utils (mkMeta)\n\ncombineDocumentation :: Documentation name -> Maybe (MDoc name)\ncombineDocumentation (Documentation Nothing Nothing) = Nothing\ncombineDocumentation (Documentation mDoc mWarning)   =\n  Just (maybe emptyMetaDoc mkMeta mWarning\n        `metaDocAppend`\n        fromMaybe emptyMetaDoc mDoc)\n\n-- Drop trailing whitespace from @..@ code blocks.  Otherwise this:\n--\n--    -- @\n--    -- foo\n--    -- @\n--\n-- turns into (DocCodeBlock \"\\nfoo\\n \") which when rendered in HTML\n-- gives an extra vertical space after the code block.  The single space\n-- on the final line seems to trigger the extra vertical space.\n--\ndocCodeBlock :: DocH mod id -> DocH mod id\ndocCodeBlock (DocString s)\n  = DocString (reverse $ dropWhile (`elem` \" \\t\") $ reverse s)\ndocCodeBlock (DocAppend l r)\n  = DocAppend l (docCodeBlock r)\ndocCodeBlock d = d\n", "num_lines": 35}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns, FlexibleInstances, ViewPatterns #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n{-# OPTIONS_HADDOCK hide #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.GhcUtils\n-- Copyright   :  (c) David Waern 2006-2009\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Utils for dealing with types from the GHC API\n-----------------------------------------------------------------------------\nmodule Haddock.GhcUtils where\n\n\nimport Control.Arrow\n\nimport Exception\nimport Outputable\nimport Name\nimport NameSet\nimport Lexeme\nimport Module\nimport HscTypes\nimport GHC\nimport Class\n\n\nmoduleString :: Module -> String\nmoduleString = moduleNameString . moduleName\n\nisNameSym :: Name -> Bool\nisNameSym = isSymOcc . nameOccName\n\n\nisVarSym :: OccName -> Bool\nisVarSym = isLexVarSym . occNameFS\n\nisConSym :: OccName -> Bool\nisConSym = isLexConSym . occNameFS\n\n\ngetMainDeclBinder :: HsDecl name -> [IdP name]\ngetMainDeclBinder (TyClD d) = [tcdName d]\ngetMainDeclBinder (ValD d) =\n  case collectHsBindBinders d of\n    []       -> []\n    (name:_) -> [name]\ngetMainDeclBinder (SigD d) = sigNameNoLoc d\ngetMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]\ngetMainDeclBinder (ForD (ForeignExport _ _ _ _)) = []\ngetMainDeclBinder _ = []\n\n-- Extract the source location where an instance is defined. This is used\n-- to correlate InstDecls with their Instance/CoAxiom Names, via the\n-- instanceMap.\ngetInstLoc :: InstDecl name -> SrcSpan\ngetInstLoc (ClsInstD (ClsInstDecl { cid_poly_ty = ty })) = getLoc (hsSigType ty)\ngetInstLoc (DataFamInstD (DataFamInstDecl\n  { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = L l _ }}})) = l\ngetInstLoc (TyFamInstD (TyFamInstDecl\n  -- Since CoAxioms' Names refer to the whole line for type family instances\n  -- in particular, we need to dig a bit deeper to pull out the entire\n  -- equation. This does not happen for data family instances, for some reason.\n  { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = L l _ }}})) = l\n\n-- Useful when there is a signature with multiple names, e.g.\n--   foo, bar :: Types..\n-- but only one of the names is exported and we have to change the\n-- type signature to only include the exported names.\nfilterLSigNames :: (IdP name -> Bool) -> LSig name -> Maybe (LSig name)\nfilterLSigNames p (L loc sig) = L loc <$> (filterSigNames p sig)\n\nfilterSigNames :: (IdP name -> Bool) -> Sig name -> Maybe (Sig name)\nfilterSigNames p orig@(SpecSig n _ _)          = ifTrueJust (p $ unLoc n) orig\nfilterSigNames p orig@(InlineSig n _)          = ifTrueJust (p $ unLoc n) orig\nfilterSigNames p (FixSig (FixitySig ns ty)) =\n  case filter (p . unLoc) ns of\n    []       -> Nothing\n    filtered -> Just (FixSig (FixitySig filtered ty))\nfilterSigNames _ orig@(MinimalSig _ _)      = Just orig\nfilterSigNames p (TypeSig ns ty) =\n  case filter (p . unLoc) ns of\n    []       -> Nothing\n    filtered -> Just (TypeSig filtered ty)\nfilterSigNames p (ClassOpSig is_default ns ty) =\n  case filter (p . unLoc) ns of\n    []       -> Nothing\n    filtered -> Just (ClassOpSig is_default filtered ty)\nfilterSigNames p (PatSynSig ns ty) =\n  case filter (p . unLoc) ns of\n    []       -> Nothing\n    filtered -> Just (PatSynSig filtered ty)\nfilterSigNames _ _                           = Nothing\n\nifTrueJust :: Bool -> name -> Maybe name\nifTrueJust True  = Just\nifTrueJust False = const Nothing\n\nsigName :: LSig name -> [IdP name]\nsigName (L _ sig) = sigNameNoLoc sig\n\nsigNameNoLoc :: Sig name -> [IdP name]\nsigNameNoLoc (TypeSig      ns _)       = map unLoc ns\nsigNameNoLoc (ClassOpSig _ ns _)       = map unLoc ns\nsigNameNoLoc (PatSynSig    ns _)       = map unLoc ns\nsigNameNoLoc (SpecSig      n _ _)      = [unLoc n]\nsigNameNoLoc (InlineSig    n _)        = [unLoc n]\nsigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns\nsigNameNoLoc _                         = []\n\n-- | Was this signature given by the user?\nisUserLSig :: LSig name -> Bool\nisUserLSig (L _(TypeSig {}))    = True\nisUserLSig (L _(ClassOpSig {})) = True\nisUserLSig (L _(PatSynSig {}))  = True\nisUserLSig _                    = False\n\n\nisClassD :: HsDecl a -> Bool\nisClassD (TyClD d) = isClassDecl d\nisClassD _ = False\n\nisValD :: HsDecl a -> Bool\nisValD (ValD _) = True\nisValD _ = False\n\n\ndeclATs :: HsDecl a -> [IdP a]\ndeclATs (TyClD d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d\ndeclATs _ = []\n\n\npretty :: Outputable a => DynFlags -> a -> String\npretty = showPpr\n\nnubByName :: (a -> Name) -> [a] -> [a]\nnubByName f ns = go emptyNameSet ns\n  where\n    go !_ [] = []\n    go !s (x:xs)\n      | y `elemNameSet` s = go s xs\n      | otherwise         = let !s' = extendNameSet s y\n                            in x : go s' xs\n      where\n        y = f x\n\n-------------------------------------------------------------------------------\n-- * Located\n-------------------------------------------------------------------------------\n\n\nunL :: Located a -> a\nunL (L _ x) = x\n\n\nreL :: a -> Located a\nreL = L undefined\n\n-------------------------------------------------------------------------------\n-- * NamedThing instances\n-------------------------------------------------------------------------------\n\n\ninstance NamedThing (TyClDecl GhcRn) where\n  getName = tcdName\n\n-------------------------------------------------------------------------------\n-- * Subordinates\n-------------------------------------------------------------------------------\n\n\nclass Parent a where\n  children :: a -> [Name]\n\n\ninstance Parent (ConDecl GhcRn) where\n  children con =\n    case getConDetails con of\n      RecCon fields -> map (selectorFieldOcc . unL) $\n                         concatMap (cd_fld_names . unL) (unL fields)\n      _             -> []\n\ninstance Parent (TyClDecl GhcRn) where\n  children d\n    | isDataDecl  d = map unL $ concatMap (getConNames . unL)\n                              $ (dd_cons . tcdDataDefn) $ d\n    | isClassDecl d =\n        map (unL . fdLName . unL) (tcdATs d) ++\n        [ unL n | L _ (TypeSig ns _) <- tcdSigs d, n <- ns ]\n    | otherwise = []\n\n\n-- | A parent and its children\nfamily :: (NamedThing a, Parent a) => a -> (Name, [Name])\nfamily = getName &&& children\n\n\nfamilyConDecl :: ConDecl GHC.GhcRn -> [(Name, [Name])]\nfamilyConDecl d = zip (map unL (getConNames d)) (repeat $ children d)\n\n-- | A mapping from the parent (main-binder) to its children and from each\n-- child to its grand-children, recursively.\nfamilies :: TyClDecl GhcRn -> [(Name, [Name])]\nfamilies d\n  | isDataDecl  d = family d : concatMap (familyConDecl . unL) (dd_cons (tcdDataDefn d))\n  | isClassDecl d = [family d]\n  | otherwise     = []\n\n\n-- | A mapping from child to parent\nparentMap :: TyClDecl GhcRn -> [(Name, Name)]\nparentMap d = [ (c, p) | (p, cs) <- families d, c <- cs ]\n\n\n-- | The parents of a subordinate in a declaration\nparents :: Name -> HsDecl GhcRn -> [Name]\nparents n (TyClD d) = [ p | (c, p) <- parentMap d, c == n ]\nparents _ _ = []\n\n\n-------------------------------------------------------------------------------\n-- * Utils that work in monads defined by GHC\n-------------------------------------------------------------------------------\n\n\nmodifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc ()\nmodifySessionDynFlags f = do\n  dflags <- getSessionDynFlags\n  _ <- setSessionDynFlags (f dflags)\n  return ()\n\n\n-- | A variant of 'gbracket' where the return value from the first computation\n-- is not required.\ngbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c\ngbracket_ before_ after thing = gbracket before_ (const after) (const thing)\n\n-- Extract the minimal complete definition of a Name, if one exists\nminimalDef :: GhcMonad m => Name -> m (Maybe ClassMinimalDef)\nminimalDef n = do\n  mty <- lookupGlobalName n\n  case mty of\n    Just (ATyCon (tyConClass_maybe -> Just c)) -> return . Just $ classMinimalDef c\n    _ -> return Nothing\n\n-------------------------------------------------------------------------------\n-- * DynFlags\n-------------------------------------------------------------------------------\n\n\nsetObjectDir, setHiDir, setStubDir, setOutputDir :: String -> DynFlags -> DynFlags\nsetObjectDir  f d = d{ objectDir  = Just f}\nsetHiDir      f d = d{ hiDir      = Just f}\nsetStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }\n  -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file\n  -- \\#included from the .hc file when compiling with -fvia-C.\nsetOutputDir  f = setObjectDir f . setHiDir f . setStubDir f\n", "num_lines": 262}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, OverloadedStrings #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Interface\n-- Copyright   :  (c) Simon Marlow      2003-2006,\n--                    David Waern       2006-2010,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- This module typechecks Haskell modules using the GHC API and processes\n-- the result to create 'Interface's. The typechecking and the 'Interface'\n-- creation is interleaved, so that when a module is processed, the\n-- 'Interface's of all previously processed modules are available. The\n-- creation of an 'Interface' from a typechecked module is delegated to\n-- \"Haddock.Interface.Create\".\n--\n-- When all modules have been typechecked and processed, information about\n-- instances are attached to each 'Interface'. This task is delegated to\n-- \"Haddock.Interface.AttachInstances\". Note that this is done as a separate\n-- step because GHC can't know about all instances until all modules have been\n-- typechecked.\n--\n-- As a last step a link environment is built which maps names to the \\\"best\\\"\n-- places to link to in the documentation, and all 'Interface's are \\\"renamed\\\"\n-- using this environment.\n-----------------------------------------------------------------------------\nmodule Haddock.Interface (\n  processModules\n) where\n\n\nimport Haddock.GhcUtils\nimport Haddock.InterfaceFile\nimport Haddock.Interface.Create\nimport Haddock.Interface.AttachInstances\nimport Haddock.Interface.Rename\nimport Haddock.Options hiding (verbosity)\nimport Haddock.Types\nimport Haddock.Utils\n\nimport Control.Monad\nimport Data.List\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\nimport Distribution.Verbosity\nimport System.Directory\nimport System.FilePath\nimport Text.Printf\n\nimport Digraph\nimport DynFlags hiding (verbosity)\nimport Exception\nimport GHC hiding (verbosity)\nimport HscTypes\nimport FastString (unpackFS)\nimport MonadUtils (liftIO)\nimport TcRnTypes (tcg_rdr_env)\nimport RdrName (plusGlobalRdrEnv)\nimport ErrUtils (withTiming)\n\n#if defined(mingw32_HOST_OS)\nimport System.IO\nimport GHC.IO.Encoding.CodePage (mkLocaleEncoding)\nimport GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))\n#endif\n\n-- | Create 'Interface's and a link environment by typechecking the list of\n-- modules using the GHC API and processing the resulting syntax trees.\nprocessModules\n  :: Verbosity                  -- ^ Verbosity of logging to 'stdout'\n  -> [String]                   -- ^ A list of file or module names sorted by\n                                -- module topology\n  -> [Flag]                     -- ^ Command-line flags\n  -> [InterfaceFile]            -- ^ Interface files of package dependencies\n  -> Ghc ([Interface], LinkEnv) -- ^ Resulting list of interfaces and renaming\n                                -- environment\nprocessModules verbosity modules flags extIfaces = do\n#if defined(mingw32_HOST_OS)\n  -- Avoid internal error: <stderr>: hPutChar: invalid argument (invalid character)' non UTF-8 Windows\n  liftIO $ hSetEncoding stdout $ mkLocaleEncoding TransliterateCodingFailure\n  liftIO $ hSetEncoding stderr $ mkLocaleEncoding TransliterateCodingFailure\n#endif\n\n  out verbosity verbose \"Creating interfaces...\"\n  let instIfaceMap =  Map.fromList [ (instMod iface, iface) | ext <- extIfaces\n                                   , iface <- ifInstalledIfaces ext ]\n  interfaces <- createIfaces0 verbosity modules flags instIfaceMap\n\n  let exportedNames =\n        Set.unions $ map (Set.fromList . ifaceExports) $\n        filter (\\i -> not $ OptHide `elem` ifaceOptions i) interfaces\n      mods = Set.fromList $ map ifaceMod interfaces\n  out verbosity verbose \"Attaching instances...\"\n  interfaces' <- {-# SCC attachInstances #-}\n                 withTiming getDynFlags \"attachInstances\" (const ()) $ do\n                   attachInstances (exportedNames, mods) interfaces instIfaceMap\n\n  out verbosity verbose \"Building cross-linking environment...\"\n  -- Combine the link envs of the external packages into one\n  let extLinks  = Map.unions (map ifLinkEnv extIfaces)\n      homeLinks = buildHomeLinks interfaces' -- Build the environment for the home\n                                             -- package\n      links     = homeLinks `Map.union` extLinks\n\n  out verbosity verbose \"Renaming interfaces...\"\n  let warnings = Flag_NoWarnings `notElem` flags\n  dflags <- getDynFlags\n  let (interfaces'', msgs) =\n         runWriter $ mapM (renameInterface dflags links warnings) interfaces'\n  liftIO $ mapM_ putStrLn msgs\n\n  return (interfaces'', homeLinks)\n\n\n--------------------------------------------------------------------------------\n-- * Module typechecking and Interface creation\n--------------------------------------------------------------------------------\n\n\ncreateIfaces0 :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc [Interface]\ncreateIfaces0 verbosity modules flags instIfaceMap =\n  -- Output dir needs to be set before calling depanal since depanal uses it to\n  -- compute output file names that are stored in the DynFlags of the\n  -- resulting ModSummaries.\n  (if useTempDir then withTempOutputDir else id) $ do\n    modGraph <- depAnalysis\n    createIfaces verbosity flags instIfaceMap modGraph\n\n  where\n    useTempDir :: Bool\n    useTempDir = Flag_NoTmpCompDir `notElem` flags\n\n\n    withTempOutputDir :: Ghc a -> Ghc a\n    withTempOutputDir action = do\n      tmp <- liftIO getTemporaryDirectory\n      x   <- liftIO getProcessID\n      let dir = tmp </> \".haddock-\" ++ show x\n      modifySessionDynFlags (setOutputDir dir)\n      withTempDir dir action\n\n\n    depAnalysis :: Ghc ModuleGraph\n    depAnalysis = do\n      targets <- mapM (\\f -> guessTarget f Nothing) modules\n      setTargets targets\n      depanal [] False\n\n\ncreateIfaces :: Verbosity -> [Flag] -> InstIfaceMap -> ModuleGraph -> Ghc [Interface]\ncreateIfaces verbosity flags instIfaceMap mods = do\n  let sortedMods = flattenSCCs $ topSortModuleGraph False mods Nothing\n  out verbosity normal \"Haddock coverage:\"\n  (ifaces, _) <- foldM f ([], Map.empty) sortedMods\n  return (reverse ifaces)\n  where\n    f (ifaces, ifaceMap) modSummary = do\n      x <- {-# SCC processModule #-}\n           withTiming getDynFlags \"processModule\" (const ()) $ do\n             processModule verbosity modSummary flags ifaceMap instIfaceMap\n      return $ case x of\n        Just iface -> (iface:ifaces, Map.insert (ifaceMod iface) iface ifaceMap)\n        Nothing    -> (ifaces, ifaceMap) -- Boot modules don't generate ifaces.\n\n\nprocessModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe Interface)\nprocessModule verbosity modsum flags modMap instIfaceMap = do\n  out verbosity verbose $ \"Checking module \" ++ moduleString (ms_mod modsum) ++ \"...\"\n  tm <- {-# SCC \"parse/typecheck/load\" #-} loadModule =<< typecheckModule =<< parseModule modsum\n\n  -- We need to modify the interactive context's environment so that when\n  -- Haddock later looks for instances, it also looks in the modules it\n  -- encountered while typechecking.\n  --\n  -- See https://github.com/haskell/haddock/issues/469.\n  hsc_env@HscEnv{ hsc_IC = old_IC } <- getSession\n  let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm\n  setSession hsc_env{ hsc_IC = old_IC {\n    ic_rn_gbl_env = ic_rn_gbl_env old_IC `plusGlobalRdrEnv` new_rdr_env\n  } }\n\n  if not $ isBootSummary modsum then do\n    out verbosity verbose \"Creating interface...\"\n    (interface, msgs) <- {-# SCC createIterface #-}\n                        withTiming getDynFlags \"createInterface\" (const ()) $ do\n                          runWriterGhc $ createInterface tm flags modMap instIfaceMap\n    liftIO $ mapM_ putStrLn (nub msgs)\n    dflags <- getDynFlags\n    let (haddockable, haddocked) = ifaceHaddockCoverage interface\n        percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int\n        modString = moduleString (ifaceMod interface)\n        coverageMsg = printf \" %3d%% (%3d /%3d) in '%s'\" percentage haddocked haddockable modString\n        header = case ifaceDoc interface of\n          Documentation Nothing _ -> False\n          _ -> True\n        undocumentedExports = [ formatName s n | ExportDecl { expItemDecl = L s n\n                                                            , expItemMbDoc = (Documentation Nothing _, _)\n                                                            } <- ifaceExportItems interface ]\n          where\n            formatName :: SrcSpan -> HsDecl GhcRn -> String\n            formatName loc n = p (getMainDeclBinder n) ++ case loc of\n              RealSrcSpan rss -> \" (\" ++ unpackFS (srcSpanFile rss) ++ \":\" ++ show (srcSpanStartLine rss) ++ \")\"\n              _ -> \"\"\n\n            p [] = \"\"\n            p (x:_) = let n = pretty dflags x\n                          ms = modString ++ \".\"\n                      in if ms `isPrefixOf` n\n                         then drop (length ms) n\n                         else n\n\n    when (OptHide `notElem` ifaceOptions interface) $ do\n      out verbosity normal coverageMsg\n      when (Flag_NoPrintMissingDocs `notElem` flags\n            && not (null undocumentedExports && header)) $ do\n        out verbosity normal \"  Missing documentation for:\"\n        unless header $ out verbosity normal \"    Module header\"\n        mapM_ (out verbosity normal . (\"    \" ++)) undocumentedExports\n    interface' <- liftIO $ evaluate interface\n    return (Just interface')\n  else\n    return Nothing\n\n\n--------------------------------------------------------------------------------\n-- * Building of cross-linking environment\n--------------------------------------------------------------------------------\n\n\n-- | Build a mapping which for each original name, points to the \"best\"\n-- place to link to in the documentation.  For the definition of\n-- \"best\", we use \"the module nearest the bottom of the dependency\n-- graph which exports this name\", not including hidden modules.  When\n-- there are multiple choices, we pick a random one.\n--\n-- The interfaces are passed in in topologically sorted order, but we start\n-- by reversing the list so we can do a foldl.\nbuildHomeLinks :: [Interface] -> LinkEnv\nbuildHomeLinks ifaces = foldl upd Map.empty (reverse ifaces)\n  where\n    upd old_env iface\n      | OptHide    `elem` ifaceOptions iface = old_env\n      | OptNotHome `elem` ifaceOptions iface =\n        foldl' keep_old old_env exported_names\n      | otherwise = foldl' keep_new old_env exported_names\n      where\n        exported_names = ifaceVisibleExports iface ++ map getName (ifaceInstances iface)\n        mdl            = ifaceMod iface\n        keep_old env n = Map.insertWith (\\_ old -> old) n mdl env\n        keep_new env n = Map.insert n mdl env\n\n\n--------------------------------------------------------------------------------\n-- * Utils\n--------------------------------------------------------------------------------\n\n\nwithTempDir :: (ExceptionMonad m) => FilePath -> m a -> m a\nwithTempDir dir = gbracket_ (liftIO $ createDirectory dir)\n                            (liftIO $ removeDirectoryRecursive dir)\n", "num_lines": 265}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.InterfaceFile\n-- Copyright   :  (c) David Waern       2006-2009,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Reading and writing the .haddock interface file\n-----------------------------------------------------------------------------\nmodule Haddock.InterfaceFile (\n  InterfaceFile(..), ifUnitId, ifModule,\n  readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor,\n  writeInterfaceFile, binaryInterfaceVersion, binaryInterfaceVersionCompatibility\n) where\n\n\nimport Haddock.Types\nimport Haddock.Utils hiding (out)\n\nimport Control.Monad\nimport Data.Array\nimport Data.IORef\nimport Data.List\nimport qualified Data.Map as Map\nimport Data.Map (Map)\nimport Data.Word\n\nimport BinIface (getSymtabName, getDictFastString)\nimport Binary\nimport FastMutInt\nimport FastString\nimport GHC hiding (NoLink)\nimport GhcMonad (withSession)\nimport HscTypes\nimport NameCache\nimport IfaceEnv\nimport Name\nimport UniqFM\nimport UniqSupply\nimport Unique\n\n\ndata InterfaceFile = InterfaceFile {\n  ifLinkEnv         :: LinkEnv,\n  ifInstalledIfaces :: [InstalledInterface]\n}\n\n\nifModule :: InterfaceFile -> Module\nifModule if_ =\n  case ifInstalledIfaces if_ of\n    [] -> error \"empty InterfaceFile\"\n    iface:_ -> instMod iface\n\nifUnitId :: InterfaceFile -> UnitId\nifUnitId if_ =\n  case ifInstalledIfaces if_ of\n    [] -> error \"empty InterfaceFile\"\n    iface:_ -> moduleUnitId $ instMod iface\n\n\nbinaryInterfaceMagic :: Word32\nbinaryInterfaceMagic = 0xD0Cface\n\n\n-- IMPORTANT: Since datatypes in the GHC API might change between major\n-- versions, and because we store GHC datatypes in our interface files, we need\n-- to make sure we version our interface files accordingly.\n--\n-- If you change the interface file format or adapt Haddock to work with a new\n-- major version of GHC (so that the format changes indirectly) *you* need to\n-- follow these steps:\n--\n-- (1) increase `binaryInterfaceVersion`\n--\n-- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion]\n--\nbinaryInterfaceVersion :: Word16\n#if (__GLASGOW_HASKELL__ >= 803) && (__GLASGOW_HASKELL__ < 805)\nbinaryInterfaceVersion = 33\n\nbinaryInterfaceVersionCompatibility :: [Word16]\nbinaryInterfaceVersionCompatibility = [binaryInterfaceVersion]\n#else\n#error Unsupported GHC version\n#endif\n\n\ninitBinMemSize :: Int\ninitBinMemSize = 1024*1024\n\n\nwriteInterfaceFile :: FilePath -> InterfaceFile -> IO ()\nwriteInterfaceFile filename iface = do\n  bh0 <- openBinMem initBinMemSize\n  put_ bh0 binaryInterfaceMagic\n  put_ bh0 binaryInterfaceVersion\n\n  -- remember where the dictionary pointer will go\n  dict_p_p <- tellBin bh0\n  put_ bh0 dict_p_p\n\n  -- remember where the symbol table pointer will go\n  symtab_p_p <- tellBin bh0\n  put_ bh0 symtab_p_p\n\n  -- Make some intial state\n  symtab_next <- newFastMutInt\n  writeFastMutInt symtab_next 0\n  symtab_map <- newIORef emptyUFM\n  let bin_symtab = BinSymbolTable {\n                      bin_symtab_next = symtab_next,\n                      bin_symtab_map  = symtab_map }\n  dict_next_ref <- newFastMutInt\n  writeFastMutInt dict_next_ref 0\n  dict_map_ref <- newIORef emptyUFM\n  let bin_dict = BinDictionary {\n                      bin_dict_next = dict_next_ref,\n                      bin_dict_map  = dict_map_ref }\n\n  -- put the main thing\n  let bh = setUserData bh0 $ newWriteState (putName bin_symtab)\n                                           (putName bin_symtab)\n                                           (putFastString bin_dict)\n  put_ bh iface\n\n  -- write the symtab pointer at the front of the file\n  symtab_p <- tellBin bh\n  putAt bh symtab_p_p symtab_p\n  seekBin bh symtab_p\n\n  -- write the symbol table itself\n  symtab_next' <- readFastMutInt symtab_next\n  symtab_map'  <- readIORef symtab_map\n  putSymbolTable bh symtab_next' symtab_map'\n\n  -- write the dictionary pointer at the fornt of the file\n  dict_p <- tellBin bh\n  putAt bh dict_p_p dict_p\n  seekBin bh dict_p\n\n  -- write the dictionary itself\n  dict_next <- readFastMutInt dict_next_ref\n  dict_map  <- readIORef dict_map_ref\n  putDictionary bh dict_next dict_map\n\n  -- and send the result to the file\n  writeBinMem bh filename\n  return ()\n\n\ntype NameCacheAccessor m = (m NameCache, NameCache -> m ())\n\n\nnameCacheFromGhc :: forall m. (GhcMonad m, MonadIO m) => NameCacheAccessor m\nnameCacheFromGhc = ( read_from_session , write_to_session )\n  where\n    read_from_session = do\n       ref <- withSession (return . hsc_NC)\n       liftIO $ readIORef ref\n    write_to_session nc' = do\n       ref <- withSession (return . hsc_NC)\n       liftIO $ writeIORef ref nc'\n\n\nfreshNameCache :: NameCacheAccessor IO\nfreshNameCache = ( create_fresh_nc , \\_ -> return () )\n  where\n    create_fresh_nc = do\n       u  <- mkSplitUniqSupply 'a' -- ??\n       return (initNameCache u [])\n\n\n-- | Read a Haddock (@.haddock@) interface file. Return either an\n-- 'InterfaceFile' or an error message.\n--\n-- This function can be called in two ways.  Within a GHC session it will\n-- update the use and update the session's name cache.  Outside a GHC session\n-- a new empty name cache is used.  The function is therefore generic in the\n-- monad being used.  The exact monad is whichever monad the first\n-- argument, the getter and setter of the name cache, requires.\n--\nreadInterfaceFile :: forall m.\n                     MonadIO m\n                  => NameCacheAccessor m\n                  -> FilePath\n                  -> m (Either String InterfaceFile)\nreadInterfaceFile (get_name_cache, set_name_cache) filename = do\n  bh0 <- liftIO $ readBinMem filename\n\n  magic   <- liftIO $ get bh0\n  version <- liftIO $ get bh0\n\n  case () of\n    _ | magic /= binaryInterfaceMagic -> return . Left $\n      \"Magic number mismatch: couldn't load interface file: \" ++ filename\n      | version `notElem` binaryInterfaceVersionCompatibility -> return . Left $\n      \"Interface file is of wrong version: \" ++ filename\n      | otherwise -> with_name_cache $ \\update_nc -> do\n\n      dict  <- get_dictionary bh0\n\n      -- read the symbol table so we are capable of reading the actual data\n      bh1 <- do\n          let bh1 = setUserData bh0 $ newReadState (error \"getSymtabName\")\n                                                   (getDictFastString dict)\n          symtab <- update_nc (get_symbol_table bh1)\n          return $ setUserData bh1 $ newReadState (getSymtabName (NCU (\\f -> update_nc (return . f))) dict symtab)\n                                                  (getDictFastString dict)\n\n      -- load the actual data\n      iface <- liftIO $ get bh1\n      return (Right iface)\n where\n   with_name_cache :: forall a.\n                      ((forall n b. MonadIO n\n                                => (NameCache -> n (NameCache, b))\n                                -> n b)\n                       -> m a)\n                   -> m a\n   with_name_cache act = do\n      nc_var <-  get_name_cache >>= (liftIO . newIORef)\n      x <- act $ \\f -> do\n              nc <- liftIO $ readIORef nc_var\n              (nc', x) <- f nc\n              liftIO $ writeIORef nc_var nc'\n              return x\n      liftIO (readIORef nc_var) >>= set_name_cache\n      return x\n\n   get_dictionary bin_handle = liftIO $ do\n      dict_p <- get bin_handle\n      data_p <- tellBin bin_handle\n      seekBin bin_handle dict_p\n      dict <- getDictionary bin_handle\n      seekBin bin_handle data_p\n      return dict\n\n   get_symbol_table bh1 theNC = liftIO $ do\n      symtab_p <- get bh1\n      data_p'  <- tellBin bh1\n      seekBin bh1 symtab_p\n      (nc', symtab) <- getSymbolTable bh1 theNC\n      seekBin bh1 data_p'\n      return (nc', symtab)\n\n\n-------------------------------------------------------------------------------\n-- * Symbol table\n-------------------------------------------------------------------------------\n\n\nputName :: BinSymbolTable -> BinHandle -> Name -> IO ()\nputName BinSymbolTable{\n            bin_symtab_map = symtab_map_ref,\n            bin_symtab_next = symtab_next }    bh name\n  = do\n    symtab_map <- readIORef symtab_map_ref\n    case lookupUFM symtab_map name of\n      Just (off,_) -> put_ bh (fromIntegral off :: Word32)\n      Nothing -> do\n         off <- readFastMutInt symtab_next\n         writeFastMutInt symtab_next (off+1)\n         writeIORef symtab_map_ref\n             $! addToUFM symtab_map name (off,name)\n         put_ bh (fromIntegral off :: Word32)\n\n\ndata BinSymbolTable = BinSymbolTable {\n        bin_symtab_next :: !FastMutInt, -- The next index to use\n        bin_symtab_map  :: !(IORef (UniqFM (Int,Name)))\n                                -- indexed by Name\n  }\n\n\nputFastString :: BinDictionary -> BinHandle -> FastString -> IO ()\nputFastString BinDictionary { bin_dict_next = j_r,\n                              bin_dict_map  = out_r}  bh f\n  = do\n    out <- readIORef out_r\n    let unique = getUnique f\n    case lookupUFM out unique of\n        Just (j, _)  -> put_ bh (fromIntegral j :: Word32)\n        Nothing -> do\n           j <- readFastMutInt j_r\n           put_ bh (fromIntegral j :: Word32)\n           writeFastMutInt j_r (j + 1)\n           writeIORef out_r $! addToUFM out unique (j, f)\n\n\ndata BinDictionary = BinDictionary {\n        bin_dict_next :: !FastMutInt, -- The next index to use\n        bin_dict_map  :: !(IORef (UniqFM (Int,FastString)))\n                                -- indexed by FastString\n  }\n\n\nputSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()\nputSymbolTable bh next_off symtab = do\n  put_ bh next_off\n  let names = elems (array (0,next_off-1) (eltsUFM symtab))\n  mapM_ (\\n -> serialiseName bh n symtab) names\n\n\ngetSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)\ngetSymbolTable bh namecache = do\n  sz <- get bh\n  od_names <- replicateM sz (get bh)\n  let arr = listArray (0,sz-1) names\n      (namecache', names) = mapAccumR (fromOnDiskName arr) namecache od_names\n  return (namecache', arr)\n\n\ntype OnDiskName = (UnitId, ModuleName, OccName)\n\n\nfromOnDiskName\n   :: Array Int Name\n   -> NameCache\n   -> OnDiskName\n   -> (NameCache, Name)\nfromOnDiskName _ nc (pid, mod_name, occ) =\n  let\n        modu  = mkModule pid mod_name\n        cache = nsNames nc\n  in\n  case lookupOrigNameCache cache modu occ of\n     Just name -> (nc, name)\n     Nothing   ->\n        let\n                us        = nsUniqs nc\n                u         = uniqFromSupply us\n                name      = mkExternalName u modu occ noSrcSpan\n                new_cache = extendNameCache cache modu occ name\n        in\n        case splitUniqSupply us of { (us',_) ->\n        ( nc{ nsUniqs = us', nsNames = new_cache }, name )\n        }\n\n\nserialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()\nserialiseName bh name _ = do\n  let modu = nameModule name\n  put_ bh (moduleUnitId modu, moduleName modu, nameOccName name)\n\n\n-------------------------------------------------------------------------------\n-- * GhcBinary instances\n-------------------------------------------------------------------------------\n\n\ninstance (Ord k, Binary k, Binary v) => Binary (Map k v) where\n  put_ bh m = put_ bh (Map.toList m)\n  get bh = fmap (Map.fromList) (get bh)\n\n\ninstance Binary InterfaceFile where\n  put_ bh (InterfaceFile env ifaces) = do\n    put_ bh env\n    put_ bh ifaces\n\n  get bh = do\n    env    <- get bh\n    ifaces <- get bh\n    return (InterfaceFile env ifaces)\n\n\ninstance Binary InstalledInterface where\n  put_ bh (InstalledInterface modu is_sig info docMap argMap\n           exps visExps opts fixMap) = do\n    put_ bh modu\n    put_ bh is_sig\n    put_ bh info\n    lazyPut bh (docMap, argMap)\n    put_ bh exps\n    put_ bh visExps\n    put_ bh opts\n    put_ bh fixMap\n\n  get bh = do\n    modu    <- get bh\n    is_sig  <- get bh\n    info    <- get bh\n    ~(docMap, argMap) <- lazyGet bh\n    exps    <- get bh\n    visExps <- get bh\n    opts    <- get bh\n    fixMap  <- get bh\n    return (InstalledInterface modu is_sig info docMap argMap\n            exps visExps opts fixMap)\n\n\ninstance Binary DocOption where\n    put_ bh OptHide = do\n            putByte bh 0\n    put_ bh OptPrune = do\n            putByte bh 1\n    put_ bh OptIgnoreExports = do\n            putByte bh 2\n    put_ bh OptNotHome = do\n            putByte bh 3\n    put_ bh OptShowExtensions = do\n            putByte bh 4\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do\n                    return OptHide\n              1 -> do\n                    return OptPrune\n              2 -> do\n                    return OptIgnoreExports\n              3 -> do\n                    return OptNotHome\n              4 -> do\n                    return OptShowExtensions\n              _ -> fail \"invalid binary data found\"\n\n\ninstance Binary Example where\n    put_ bh (Example expression result) = do\n        put_ bh expression\n        put_ bh result\n    get bh = do\n        expression <- get bh\n        result <- get bh\n        return (Example expression result)\n\ninstance Binary Hyperlink where\n    put_ bh (Hyperlink url label) = do\n        put_ bh url\n        put_ bh label\n    get bh = do\n        url <- get bh\n        label <- get bh\n        return (Hyperlink url label)\n\ninstance Binary Picture where\n    put_ bh (Picture uri title) = do\n        put_ bh uri\n        put_ bh title\n    get bh = do\n        uri <- get bh\n        title <- get bh\n        return (Picture uri title)\n\ninstance Binary a => Binary (Header a) where\n    put_ bh (Header l t) = do\n        put_ bh l\n        put_ bh t\n    get bh = do\n        l <- get bh\n        t <- get bh\n        return (Header l t)\n\ninstance Binary a => Binary (Table a) where\n    put_ bh (Table h b) = do\n        put_ bh h\n        put_ bh b\n    get bh = do\n        h <- get bh\n        b <- get bh\n        return (Table h b)\n\ninstance Binary a => Binary (TableRow a) where\n    put_ bh (TableRow cs) = put_ bh cs\n    get bh = do\n        cs <- get bh\n        return (TableRow cs)\n\ninstance Binary a => Binary (TableCell a) where\n    put_ bh (TableCell i j c) = do\n        put_ bh i\n        put_ bh j\n        put_ bh c\n    get bh = do\n        i <- get bh\n        j <- get bh\n        c <- get bh\n        return (TableCell i j c)\n\ninstance Binary Meta where\n    put_ bh (Meta v p) = do\n        put_ bh v\n        put_ bh p\n    get bh = do\n        v <- get bh\n        p <- get bh\n        return (Meta v p)\n\ninstance (Binary mod, Binary id) => Binary (MetaDoc mod id) where\n  put_ bh MetaDoc { _meta = m, _doc = d } = do\n    put_ bh m\n    put_ bh d\n  get bh = do\n    m <- get bh\n    d <- get bh\n    return $ MetaDoc { _meta = m, _doc = d }\n\ninstance (Binary mod, Binary id) => Binary (DocH mod id) where\n    put_ bh DocEmpty = do\n            putByte bh 0\n    put_ bh (DocAppend aa ab) = do\n            putByte bh 1\n            put_ bh aa\n            put_ bh ab\n    put_ bh (DocString ac) = do\n            putByte bh 2\n            put_ bh ac\n    put_ bh (DocParagraph ad) = do\n            putByte bh 3\n            put_ bh ad\n    put_ bh (DocIdentifier ae) = do\n            putByte bh 4\n            put_ bh ae\n    put_ bh (DocModule af) = do\n            putByte bh 5\n            put_ bh af\n    put_ bh (DocEmphasis ag) = do\n            putByte bh 6\n            put_ bh ag\n    put_ bh (DocMonospaced ah) = do\n            putByte bh 7\n            put_ bh ah\n    put_ bh (DocUnorderedList ai) = do\n            putByte bh 8\n            put_ bh ai\n    put_ bh (DocOrderedList aj) = do\n            putByte bh 9\n            put_ bh aj\n    put_ bh (DocDefList ak) = do\n            putByte bh 10\n            put_ bh ak\n    put_ bh (DocCodeBlock al) = do\n            putByte bh 11\n            put_ bh al\n    put_ bh (DocHyperlink am) = do\n            putByte bh 12\n            put_ bh am\n    put_ bh (DocPic x) = do\n            putByte bh 13\n            put_ bh x\n    put_ bh (DocAName an) = do\n            putByte bh 14\n            put_ bh an\n    put_ bh (DocExamples ao) = do\n            putByte bh 15\n            put_ bh ao\n    put_ bh (DocIdentifierUnchecked x) = do\n            putByte bh 16\n            put_ bh x\n    put_ bh (DocWarning ag) = do\n            putByte bh 17\n            put_ bh ag\n    put_ bh (DocProperty x) = do\n            putByte bh 18\n            put_ bh x\n    put_ bh (DocBold x) = do\n            putByte bh 19\n            put_ bh x\n    put_ bh (DocHeader aa) = do\n            putByte bh 20\n            put_ bh aa\n    put_ bh (DocMathInline x) = do\n            putByte bh 21\n            put_ bh x\n    put_ bh (DocMathDisplay x) = do\n            putByte bh 22\n            put_ bh x\n    put_ bh (DocTable x) = do\n            putByte bh 23\n            put_ bh x\n\n    get bh = do\n            h <- getByte bh\n            case h of\n              0 -> do\n                    return DocEmpty\n              1 -> do\n                    aa <- get bh\n                    ab <- get bh\n                    return (DocAppend aa ab)\n              2 -> do\n                    ac <- get bh\n                    return (DocString ac)\n              3 -> do\n                    ad <- get bh\n                    return (DocParagraph ad)\n              4 -> do\n                    ae <- get bh\n                    return (DocIdentifier ae)\n              5 -> do\n                    af <- get bh\n                    return (DocModule af)\n              6 -> do\n                    ag <- get bh\n                    return (DocEmphasis ag)\n              7 -> do\n                    ah <- get bh\n                    return (DocMonospaced ah)\n              8 -> do\n                    ai <- get bh\n                    return (DocUnorderedList ai)\n              9 -> do\n                    aj <- get bh\n                    return (DocOrderedList aj)\n              10 -> do\n                    ak <- get bh\n                    return (DocDefList ak)\n              11 -> do\n                    al <- get bh\n                    return (DocCodeBlock al)\n              12 -> do\n                    am <- get bh\n                    return (DocHyperlink am)\n              13 -> do\n                    x <- get bh\n                    return (DocPic x)\n              14 -> do\n                    an <- get bh\n                    return (DocAName an)\n              15 -> do\n                    ao <- get bh\n                    return (DocExamples ao)\n              16 -> do\n                    x <- get bh\n                    return (DocIdentifierUnchecked x)\n              17 -> do\n                    ag <- get bh\n                    return (DocWarning ag)\n              18 -> do\n                    x <- get bh\n                    return (DocProperty x)\n              19 -> do\n                    x <- get bh\n                    return (DocBold x)\n              20 -> do\n                    aa <- get bh\n                    return (DocHeader aa)\n              21 -> do\n                    x <- get bh\n                    return (DocMathInline x)\n              22 -> do\n                    x <- get bh\n                    return (DocMathDisplay x)\n              23 -> do\n                    x <- get bh\n                    return (DocTable x)\n              _ -> error \"invalid binary data found in the interface file\"\n\n\ninstance Binary name => Binary (HaddockModInfo name) where\n  put_ bh hmi = do\n    put_ bh (hmi_description hmi)\n    put_ bh (hmi_copyright   hmi)\n    put_ bh (hmi_license     hmi)\n    put_ bh (hmi_maintainer  hmi)\n    put_ bh (hmi_stability   hmi)\n    put_ bh (hmi_portability hmi)\n    put_ bh (hmi_safety      hmi)\n    put_ bh (fromEnum <$> hmi_language hmi)\n    put_ bh (map fromEnum $ hmi_extensions hmi)\n\n  get bh = do\n    descr <- get bh\n    copyr <- get bh\n    licen <- get bh\n    maint <- get bh\n    stabi <- get bh\n    porta <- get bh\n    safet <- get bh\n    langu <- fmap toEnum <$> get bh\n    exten <- map toEnum <$> get bh\n    return (HaddockModInfo descr copyr licen maint stabi porta safet langu exten)\n\ninstance Binary DocName where\n  put_ bh (Documented name modu) = do\n    putByte bh 0\n    put_ bh name\n    put_ bh modu\n  put_ bh (Undocumented name) = do\n    putByte bh 1\n    put_ bh name\n\n  get bh = do\n    h <- getByte bh\n    case h of\n      0 -> do\n        name <- get bh\n        modu <- get bh\n        return (Documented name modu)\n      1 -> do\n        name <- get bh\n        return (Undocumented name)\n      _ -> error \"get DocName: Bad h\"\n", "num_lines": 702}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.ModuleTree\n-- Copyright   :  (c) Simon Marlow 2003-2006,\n--                    David Waern  2006\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where\n\n\nimport Haddock.Types ( MDoc )\n\nimport GHC           ( Name )\nimport Module        ( Module, moduleNameString, moduleName, moduleUnitId, unitIdString )\nimport DynFlags      ( DynFlags )\nimport Packages      ( lookupPackage )\nimport PackageConfig ( sourcePackageIdString )\n\nimport qualified Control.Applicative as A\n\n\ndata ModuleTree = Node String (Maybe Module) (Maybe String) (Maybe String) (Maybe (MDoc Name)) [ModuleTree]\n\n\nmkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]\nmkModuleTree dflags showPkgs mods =\n  foldr fn [] [ (mdl, splitModule mdl, modPkg mdl, modSrcPkg mdl, short) | (mdl, short) <- mods ]\n  where\n    modPkg mod_ | showPkgs = Just (unitIdString (moduleUnitId mod_))\n                | otherwise = Nothing\n    modSrcPkg mod_ | showPkgs = fmap sourcePackageIdString\n                                     (lookupPackage dflags (moduleUnitId mod_))\n                   | otherwise = Nothing\n    fn (m,mod_,pkg,srcPkg,short) = addToTrees mod_ m pkg srcPkg short\n\n\naddToTrees :: [String] -> Module -> Maybe String -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree] -> [ModuleTree]\naddToTrees [] _ _ _ _ ts = ts\naddToTrees ss m pkg srcPkg short [] = mkSubTree ss m pkg srcPkg short\naddToTrees (s1:ss) m pkg srcPkg short (t@(Node s2 leaf node_pkg node_srcPkg node_short subs) : ts)\n  | s1 >  s2  = t : addToTrees (s1:ss) m pkg srcPkg short ts\n  | s1 == s2  = Node s2 (leaf A.<|> (if null ss then Just m else Nothing)) this_pkg this_srcPkg this_short (addToTrees ss m pkg srcPkg short subs) : ts\n  | otherwise = mkSubTree (s1:ss) m pkg srcPkg short ++ t : ts\n where\n  this_pkg = if null ss then pkg else node_pkg\n  this_srcPkg = if null ss then srcPkg else node_srcPkg\n  this_short = if null ss then short else node_short\n\n\nmkSubTree :: [String] -> Module -> Maybe String -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree]\nmkSubTree []     _ _   _      _     = []\nmkSubTree [s]    m pkg srcPkg short = [Node s (Just m) pkg srcPkg short []]\nmkSubTree (s:s':ss) m pkg srcPkg short = [Node s Nothing Nothing Nothing Nothing (mkSubTree (s':ss) m pkg srcPkg short)]\n\n\nsplitModule :: Module -> [String]\nsplitModule mdl = split (moduleNameString (moduleName mdl))\n  where split mod0 = case break (== '.') mod0 of\n          (s1, '.':s2) -> s1 : split s2\n          (s1, _)      -> [s1]\n", "num_lines": 65}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Options\n-- Copyright   :  (c) Simon Marlow      2003-2006,\n--                    David Waern       2006-2009,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Definition of the command line interface of Haddock.\n-----------------------------------------------------------------------------\nmodule Haddock.Options (\n  parseHaddockOpts,\n  Flag(..),\n  getUsage,\n  optTitle,\n  outputDir,\n  optContentsUrl,\n  optIndexUrl,\n  optCssFile,\n  optSourceCssFile,\n  sourceUrls,\n  wikiUrls,\n  optDumpInterfaceFile,\n  optShowInterfaceFile,\n  optLaTeXStyle,\n  optMathjax,\n  qualification,\n  sinceQualification,\n  verbosity,\n  ghcFlags,\n  reexportFlags,\n  readIfaceArgs,\n  optPackageName,\n  optPackageVersion,\n  modulePackageInfo\n) where\n\n\nimport qualified Data.Char as Char\nimport           Data.Version\nimport           Control.Applicative\nimport           Distribution.Verbosity\nimport           FastString\nimport           GHC ( DynFlags, Module, moduleUnitId )\nimport           Haddock.Types\nimport           Haddock.Utils\nimport           Packages\nimport           System.Console.GetOpt\nimport qualified Text.ParserCombinators.ReadP as RP\n\n\ndata Flag\n  = Flag_BuiltInThemes\n  | Flag_CSS String\n--  | Flag_DocBook\n  | Flag_ReadInterface String\n  | Flag_DumpInterface String\n  | Flag_ShowInterface String\n  | Flag_Heading String\n  | Flag_Html\n  | Flag_Hoogle\n  | Flag_Lib String\n  | Flag_OutputDir FilePath\n  | Flag_Prologue FilePath\n  | Flag_SourceBaseURL    String\n  | Flag_SourceModuleURL  String\n  | Flag_SourceEntityURL  String\n  | Flag_SourceLEntityURL String\n  | Flag_WikiBaseURL   String\n  | Flag_WikiModuleURL String\n  | Flag_WikiEntityURL String\n  | Flag_LaTeX\n  | Flag_LaTeXStyle String\n  | Flag_QuickJumpIndex\n  | Flag_HyperlinkedSource\n  | Flag_SourceCss String\n  | Flag_Mathjax String\n  | Flag_Help\n  | Flag_Verbosity String\n  | Flag_Version\n  | Flag_CompatibleInterfaceVersions\n  | Flag_InterfaceVersion\n  | Flag_UseContents String\n  | Flag_GenContents\n  | Flag_UseIndex String\n  | Flag_GenIndex\n  | Flag_IgnoreAllExports\n  | Flag_HideModule String\n  | Flag_ShowModule String\n  | Flag_ShowAllModules\n  | Flag_ShowExtensions String\n  | Flag_OptGhc String\n  | Flag_GhcLibDir String\n  | Flag_GhcVersion\n  | Flag_PrintGhcPath\n  | Flag_PrintGhcLibDir\n  | Flag_NoWarnings\n  | Flag_UseUnicode\n  | Flag_NoTmpCompDir\n  | Flag_Qualification String\n  | Flag_PrettyHtml\n  | Flag_NoPrintMissingDocs\n  | Flag_PackageName String\n  | Flag_PackageVersion String\n  | Flag_Reexport String\n  | Flag_SinceQualification String\n  deriving (Eq, Show)\n\n\noptions :: Bool -> [OptDescr Flag]\noptions backwardsCompat =\n  [\n    Option ['B']  []     (ReqArg Flag_GhcLibDir \"DIR\")\n      \"path to a GHC lib dir, to override the default path\",\n    Option ['o']  [\"odir\"]     (ReqArg Flag_OutputDir \"DIR\")\n      \"directory in which to put the output files\",\n    Option ['l']  [\"lib\"]         (ReqArg Flag_Lib \"DIR\")\n      \"location of Haddock's auxiliary files\",\n    Option ['i'] [\"read-interface\"] (ReqArg Flag_ReadInterface \"FILE\")\n      \"read an interface from FILE\",\n    Option ['D']  [\"dump-interface\"] (ReqArg Flag_DumpInterface \"FILE\")\n      \"write the resulting interface to FILE\",\n    Option []     [\"show-interface\"] (ReqArg Flag_ShowInterface \"FILE\")\n      \"print the interface in a human readable form\",\n--    Option ['S']  [\"docbook\"]  (NoArg Flag_DocBook)\n--  \"output in DocBook XML\",\n    Option ['h']  [\"html\"]     (NoArg Flag_Html)\n      \"output in HTML (XHTML 1.0)\",\n    Option []  [\"latex\"]  (NoArg Flag_LaTeX) \"use experimental LaTeX rendering\",\n    Option []  [\"latex-style\"]  (ReqArg Flag_LaTeXStyle \"FILE\") \"provide your own LaTeX style in FILE\",\n    Option []  [\"mathjax\"]  (ReqArg Flag_Mathjax \"URL\") \"URL FOR mathjax\",\n    Option ['U'] [\"use-unicode\"] (NoArg Flag_UseUnicode) \"use Unicode in HTML output\",\n    Option []  [\"hoogle\"]     (NoArg Flag_Hoogle)\n      \"output for Hoogle; you may want --package-name and --package-version too\",\n    Option [] [\"quickjump\"] (NoArg Flag_QuickJumpIndex)\n      \"generate an index for interactive documentation navigation\",\n    Option [] [\"hyperlinked-source\"] (NoArg Flag_HyperlinkedSource)\n      \"generate highlighted and hyperlinked source code (for use with --html)\",\n    Option [] [\"source-css\"] (ReqArg Flag_SourceCss \"FILE\")\n      \"use custom CSS file instead of default one in hyperlinked source\",\n    Option []  [\"source-base\"]   (ReqArg Flag_SourceBaseURL \"URL\")\n      \"URL for a source code link on the contents\\nand index pages\",\n    Option ['s'] (if backwardsCompat then [\"source\", \"source-module\"] else [\"source-module\"])\n      (ReqArg Flag_SourceModuleURL \"URL\")\n      \"URL for a source code link for each module\\n(using the %{FILE} or %{MODULE} vars)\",\n    Option []  [\"source-entity\"]  (ReqArg Flag_SourceEntityURL \"URL\")\n      \"URL for a source code link for each entity\\n(using the %{FILE}, %{MODULE}, %{NAME},\\n%{KIND} or %{LINE} vars)\",\n    Option []  [\"source-entity-line\"] (ReqArg Flag_SourceLEntityURL \"URL\")\n      \"URL for a source code link for each entity.\\nUsed if name links are unavailable, eg. for TH splices.\",\n    Option []  [\"comments-base\"]   (ReqArg Flag_WikiBaseURL \"URL\")\n      \"URL for a comments link on the contents\\nand index pages\",\n    Option []  [\"comments-module\"]  (ReqArg Flag_WikiModuleURL \"URL\")\n      \"URL for a comments link for each module\\n(using the %{MODULE} var)\",\n    Option []  [\"comments-entity\"]  (ReqArg Flag_WikiEntityURL \"URL\")\n      \"URL for a comments link for each entity\\n(using the %{FILE}, %{MODULE}, %{NAME},\\n%{KIND} or %{LINE} vars)\",\n    Option ['c']  [\"css\", \"theme\"] (ReqArg Flag_CSS \"PATH\")\n      \"the CSS file or theme directory to use for HTML output\",\n    Option []  [\"built-in-themes\"] (NoArg Flag_BuiltInThemes)\n      \"include all the built-in haddock themes\",\n    Option ['p']  [\"prologue\"] (ReqArg Flag_Prologue \"FILE\")\n      \"file containing prologue text\",\n    Option ['t']  [\"title\"]    (ReqArg Flag_Heading \"TITLE\")\n      \"page heading\",\n    Option ['q']  [\"qual\"] (ReqArg Flag_Qualification \"QUAL\")\n      \"qualification of names, one of \\n'none' (default), 'full', 'local'\\n'relative' or 'aliased'\",\n    Option ['?']  [\"help\"]  (NoArg Flag_Help)\n      \"display this help and exit\",\n    Option ['V']  [\"version\"]  (NoArg Flag_Version)\n      \"output version information and exit\",\n    Option []  [\"compatible-interface-versions\"]  (NoArg Flag_CompatibleInterfaceVersions)\n      \"output compatible interface file versions and exit\",\n    Option []  [\"interface-version\"]  (NoArg Flag_InterfaceVersion)\n      \"output interface file version and exit\",\n    Option ['v']  [\"verbosity\"]  (ReqArg Flag_Verbosity \"VERBOSITY\")\n      \"set verbosity level\",\n    Option [] [\"use-contents\"] (ReqArg Flag_UseContents \"URL\")\n      \"use a separately-generated HTML contents page\",\n    Option [] [\"gen-contents\"] (NoArg Flag_GenContents)\n      \"generate an HTML contents from specified\\ninterfaces\",\n    Option [] [\"use-index\"] (ReqArg Flag_UseIndex \"URL\")\n      \"use a separately-generated HTML index\",\n    Option [] [\"gen-index\"] (NoArg Flag_GenIndex)\n      \"generate an HTML index from specified\\ninterfaces\",\n    Option [] [\"ignore-all-exports\"] (NoArg Flag_IgnoreAllExports)\n      \"behave as if all modules have the\\nignore-exports atribute\",\n    Option [] [\"hide\"] (ReqArg Flag_HideModule \"MODULE\")\n      \"behave as if MODULE has the hide attribute\",\n    Option [] [\"show\"] (ReqArg Flag_ShowModule \"MODULE\")\n      \"behave as if MODULE does not have the hide attribute\",\n    Option [] [\"show-all\"] (NoArg Flag_ShowAllModules)\n      \"behave as if not modules have the hide attribute\",\n    Option [] [\"show-extensions\"] (ReqArg Flag_ShowExtensions \"MODULE\")\n      \"behave as if MODULE has the show-extensions attribute\",\n    Option [] [\"optghc\"] (ReqArg Flag_OptGhc \"OPTION\")\n      \"option to be forwarded to GHC\",\n    Option []  [\"ghc-version\"]  (NoArg Flag_GhcVersion)\n      \"output GHC version in numeric format\",\n    Option []  [\"print-ghc-path\"]  (NoArg Flag_PrintGhcPath)\n      \"output path to GHC binary\",\n    Option []  [\"print-ghc-libdir\"]  (NoArg Flag_PrintGhcLibDir)\n      \"output GHC lib dir\",\n    Option ['w'] [\"no-warnings\"] (NoArg Flag_NoWarnings) \"turn off all warnings\",\n    Option [] [\"no-tmp-comp-dir\"] (NoArg Flag_NoTmpCompDir)\n      \"do not re-direct compilation output to a temporary directory\",\n    Option [] [\"pretty-html\"] (NoArg Flag_PrettyHtml)\n      \"generate html with newlines and indenting (for use with --html)\",\n    Option [] [\"no-print-missing-docs\"] (NoArg Flag_NoPrintMissingDocs)\n      \"don't print information about any undocumented entities\",\n    Option []  [\"reexport\"] (ReqArg Flag_Reexport \"MOD\")\n      \"reexport the module MOD, adding it to the index\",\n    Option [] [\"package-name\"] (ReqArg Flag_PackageName \"NAME\")\n      \"name of the package being documented\",\n    Option [] [\"package-version\"] (ReqArg Flag_PackageVersion \"VERSION\")\n      \"version of the package being documented in usual x.y.z.w format\",\n    Option []  [\"since-qual\"] (ReqArg Flag_SinceQualification \"QUAL\")\n      \"package qualification of @since, one of\\n'always' (default) or 'only-external'\"\n  ]\n\n\ngetUsage :: IO String\ngetUsage = do\n  prog <- getProgramName\n  return $ usageInfo (usageHeader prog) (options False)\n  where\n    usageHeader :: String -> String\n    usageHeader prog = \"Usage: \" ++ prog ++ \" [OPTION...] file...\\n\"\n\n\nparseHaddockOpts :: [String] -> IO ([Flag], [String])\nparseHaddockOpts params =\n  case getOpt Permute (options True) params  of\n    (flags, args, []) -> return (flags, args)\n    (_, _, errors)    -> do\n      usage <- getUsage\n      throwE (concat errors ++ usage)\n\noptPackageVersion :: [Flag] -> Maybe Data.Version.Version\noptPackageVersion flags =\n  let ver = optLast [ v | Flag_PackageVersion v <- flags ]\n  in ver >>= fmap fst . optLast . RP.readP_to_S parseVersion\n\noptPackageName :: [Flag] -> Maybe PackageName\noptPackageName flags =\n  optLast [ PackageName $ mkFastString n | Flag_PackageName n <- flags ]\n\n\noptTitle :: [Flag] -> Maybe String\noptTitle flags =\n  case [str | Flag_Heading str <- flags] of\n    [] -> Nothing\n    (t:_) -> Just t\n\n\noutputDir :: [Flag] -> FilePath\noutputDir flags =\n  case [ path | Flag_OutputDir path <- flags ] of\n    []    -> \".\"\n    paths -> last paths\n\n\noptContentsUrl :: [Flag] -> Maybe String\noptContentsUrl flags = optLast [ url | Flag_UseContents url <- flags ]\n\n\noptIndexUrl :: [Flag] -> Maybe String\noptIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ]\n\n\noptCssFile :: [Flag] -> Maybe FilePath\noptCssFile flags = optLast [ str | Flag_CSS str <- flags ]\n\noptSourceCssFile :: [Flag] -> Maybe FilePath\noptSourceCssFile flags = optLast [ str | Flag_SourceCss str <- flags ]\n\nsourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String)\nsourceUrls flags =\n  (optLast [str | Flag_SourceBaseURL    str <- flags]\n  ,optLast [str | Flag_SourceModuleURL  str <- flags]\n  ,optLast [str | Flag_SourceEntityURL  str <- flags]\n  ,optLast [str | Flag_SourceLEntityURL str <- flags])\n\n\nwikiUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String)\nwikiUrls flags =\n  (optLast [str | Flag_WikiBaseURL   str <- flags]\n  ,optLast [str | Flag_WikiModuleURL str <- flags]\n  ,optLast [str | Flag_WikiEntityURL str <- flags])\n\n\noptDumpInterfaceFile :: [Flag] -> Maybe FilePath\noptDumpInterfaceFile flags = optLast [ str | Flag_DumpInterface str <- flags ]\n\noptShowInterfaceFile :: [Flag] -> Maybe FilePath\noptShowInterfaceFile flags = optLast [ str | Flag_ShowInterface str <- flags ]\n\noptLaTeXStyle :: [Flag] -> Maybe String\noptLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ]\n\n\noptMathjax :: [Flag] -> Maybe String\noptMathjax flags = optLast [ str | Flag_Mathjax str <- flags ]\n\n\nqualification :: [Flag] -> Either String QualOption\nqualification flags =\n  case map (map Char.toLower) [ str | Flag_Qualification str <- flags ] of\n      []             -> Right OptNoQual\n      [\"none\"]       -> Right OptNoQual\n      [\"full\"]       -> Right OptFullQual\n      [\"local\"]      -> Right OptLocalQual\n      [\"relative\"]   -> Right OptRelativeQual\n      [\"aliased\"]    -> Right OptAliasedQual\n      [arg]          -> Left $ \"unknown qualification type \" ++ show arg\n      _:_            -> Left \"qualification option given multiple times\"\n\nsinceQualification :: [Flag] -> Either String SinceQual\nsinceQualification flags =\n  case map (map Char.toLower) [ str | Flag_SinceQualification str <- flags ] of\n      []             -> Right Always\n      [\"always\"]     -> Right Always\n      [\"external\"]   -> Right External\n      [arg]          -> Left $ \"unknown since-qualification type \" ++ show arg\n      _:_            -> Left \"since-qualification option given multiple times\"\n\nverbosity :: [Flag] -> Verbosity\nverbosity flags =\n  case [ str | Flag_Verbosity str <- flags ] of\n    []  -> normal\n    x:_ -> case parseVerbosity x of\n      Left e -> throwE e\n      Right v -> v\n\n\nghcFlags :: [Flag] -> [String]\nghcFlags flags = [ option | Flag_OptGhc option <- flags ]\n\nreexportFlags :: [Flag] -> [String]\nreexportFlags flags = [ option | Flag_Reexport option <- flags ]\n\n\nreadIfaceArgs :: [Flag] -> [(DocPaths, FilePath)]\nreadIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ]\n  where\n    parseIfaceOption :: String -> (DocPaths, FilePath)\n    parseIfaceOption str =\n      case break (==',') str of\n        (fpath, ',':rest) ->\n          case break (==',') rest of\n            (src, ',':file) -> ((fpath, Just src), file)\n            (file, _) -> ((fpath, Nothing), file)\n        (file, _) -> ((\"\", Nothing), file)\n\n\n-- | Like 'listToMaybe' but returns the last element instead of the first.\noptLast :: [a] -> Maybe a\noptLast [] = Nothing\noptLast xs = Just (last xs)\n\n\n-- | This function has a potential to return 'Nothing' because package name and\n-- versions can no longer reliably be extracted in all cases: if the package is\n-- not installed yet then this info is no longer available.\n--\n-- The @--package-name@ and @--package-version@ Haddock flags allow the user to\n-- specify this information manually and it is returned here if present.\nmodulePackageInfo :: DynFlags\n                  -> [Flag] -- ^ Haddock flags are checked as they may contain\n                            -- the package name or version provided by the user\n                            -- which we prioritise\n                  -> Module\n                  -> (Maybe PackageName, Maybe Data.Version.Version)\nmodulePackageInfo dflags flags modu =\n  ( optPackageName flags    <|> fmap packageName pkgDb\n  , optPackageVersion flags <|> fmap packageVersion pkgDb\n  )\n  where\n    pkgDb = lookupPackage dflags (moduleUnitId modu)\n", "num_lines": 382}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving\n             , FlexibleInstances, UndecidableInstances\n             , IncoherentInstances #-}\n{-# LANGUAGE LambdaCase #-}\n-- |\n-- Module      :  Haddock.Parser\n-- Copyright   :  (c) Mateusz Kowalczyk 2013,\n--                    Simon Hengel      2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n\nmodule Haddock.Parser ( parseParas\n                      , parseString\n                      , parseIdent\n                      ) where\n\nimport qualified Documentation.Haddock.Parser as P\nimport DynFlags (DynFlags)\nimport FastString (mkFastString)\nimport Documentation.Haddock.Types\nimport Lexer (mkPState, unP, ParseResult(POk))\nimport Parser (parseIdentifier)\nimport RdrName (RdrName)\nimport SrcLoc (mkRealSrcLoc, unLoc)\nimport StringBuffer (stringToStringBuffer)\n\nparseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod RdrName\nparseParas d p = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas p\n\nparseString :: DynFlags -> String -> DocH mod RdrName\nparseString d = P.overIdentifier (parseIdent d) . P.parseString\n\nparseIdent :: DynFlags -> String -> Maybe RdrName\nparseIdent dflags str0 =\n  let buffer = stringToStringBuffer str0\n      realSrcLc = mkRealSrcLoc (mkFastString \"<unknown file>\") 0 0\n      pstate = mkPState dflags buffer realSrcLc\n  in case unP parseIdentifier pstate of\n    POk _ name -> Just (unLoc name)\n    _ -> Nothing\n", "num_lines": 45}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Rank2Types #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Haddock.Syb\n    ( everything, everythingButType, everythingWithState\n    , everywhere, everywhereButType\n    , mkT\n    , combine\n    ) where\n\n\nimport Data.Data\nimport Control.Applicative\nimport Data.Maybe\nimport Data.Foldable\n\n-- | Returns true if a == t.\n-- requires AllowAmbiguousTypes\nisType :: forall a b. (Typeable a, Typeable b) => b -> Bool\nisType _ = isJust $ eqT @a @b\n\n-- | Perform a query on each level of a tree.\n--\n-- This is stolen directly from SYB package and copied here to not introduce\n-- additional dependencies.\neverything :: (r -> r -> r)\n           -> (forall a. Data a => a -> r)\n           -> (forall a. Data a => a -> r)\neverything k f x = foldl' k (f x) (gmapQ (everything k f) x)\n\n-- | Variation of \"everything\" with an added stop condition\n-- Just like 'everything', this is stolen from SYB package.\neverythingBut :: (r -> r -> r)\n              -> (forall a. Data a => a -> (r, Bool))\n              -> (forall a. Data a => a -> r)\neverythingBut k f x = let (v, stop) = f x\n                      in if stop\n                           then v\n                           else foldl' k v (gmapQ (everythingBut k f) x)\n\n-- | Variation of \"everything\" that does not recurse into children of type t\n-- requires AllowAmbiguousTypes\neverythingButType ::\n  forall t r. (Typeable t)\n  => (r -> r -> r)\n  -> (forall a. Data a => a -> r)\n  -> (forall a. Data a => a -> r)\neverythingButType k f = everythingBut k $ (,) <$> f <*> isType @t\n\n-- | Perform a query with state on each level of a tree.\n--\n-- This is the same as 'everything' but allows for stateful computations. In\n-- SYB it is called @everythingWithContext@ but I find this name somewhat\n-- nicer.\neverythingWithState :: s -> (r -> r -> r)\n                    -> (forall a. Data a => a -> s -> (r, s))\n                    -> (forall a. Data a => a -> r)\neverythingWithState s k f x =\n    let (r, s') = f x s\n    in foldl' k r (gmapQ (everythingWithState s' k f) x)\n\n-- | Apply transformation on each level of a tree.\n--\n-- Just like 'everything', this is stolen from SYB package.\neverywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a)\neverywhere f = f . gmapT (everywhere f)\n\n-- | Variation on everywhere with an extra stop condition\n-- Just like 'everything', this is stolen from SYB package.\neverywhereBut :: (forall a. Data a => a -> Bool)\n  -> (forall a. Data a => a -> a)\n  -> (forall a. Data a => a -> a)\neverywhereBut q f x\n    | q x       = x\n    | otherwise = f (gmapT (everywhereBut q f) x)\n\n-- | Variation of \"everywhere\" that does not recurse into children of type t\n-- requires AllowAmbiguousTypes\neverywhereButType :: forall t . (Typeable t)\n  => (forall a. Data a => a -> a)\n  -> (forall a. Data a => a -> a)\neverywhereButType = everywhereBut (isType @t)\n\n-- | Create generic transformation.\n--\n-- Another function stolen from SYB package.\nmkT :: (Typeable a, Typeable b) => (b -> b) -> (a -> a)\nmkT f = case cast f of\n    Just f' -> f'\n    Nothing -> id\n\n-- | Combine two queries into one using alternative combinator.\ncombine :: Alternative f => (forall a. Data a => a -> f r)\n                         -> (forall a. Data a => a -> f r)\n                         -> (forall a. Data a => a -> f r)\ncombine f g x = f x <|> g x\n", "num_lines": 99}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Types\n-- Copyright   :  (c) Simon Marlow      2003-2006,\n--                    David Waern       2006-2009,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskellorg\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Types that are commonly used through-out Haddock. Some of the most\n-- important types are defined here, like 'Interface' and 'DocName'.\n-----------------------------------------------------------------------------\nmodule Haddock.Types (\n  module Haddock.Types\n  , HsDocString, LHsDocString\n  , Fixity(..)\n  , module Documentation.Haddock.Types\n ) where\n\nimport Control.Exception\nimport Control.Arrow hiding ((<+>))\nimport Control.DeepSeq\nimport Control.Monad.IO.Class (MonadIO(..))\nimport Data.Typeable\nimport Data.Map (Map)\nimport Data.Data (Data)\nimport qualified Data.Map as Map\nimport Documentation.Haddock.Types\nimport BasicTypes (Fixity(..))\n\nimport GHC hiding (NoLink)\nimport DynFlags (Language)\nimport qualified GHC.LanguageExtensions as LangExt\nimport Coercion\nimport NameSet\nimport OccName\nimport Outputable\nimport Control.Applicative (Applicative(..))\nimport Control.Monad (ap)\n\nimport Haddock.Backends.Hyperlinker.Types\n\n-----------------------------------------------------------------------------\n-- * Convenient synonyms\n-----------------------------------------------------------------------------\n\n\ntype IfaceMap      = Map Module Interface\ntype InstIfaceMap  = Map Module InstalledInterface  -- TODO: rename\ntype DocMap a      = Map Name (MDoc a)\ntype ArgMap a      = Map Name (Map Int (MDoc a))\ntype SubMap        = Map Name [Name]\ntype DeclMap       = Map Name [LHsDecl GhcRn]\ntype InstMap       = Map SrcSpan Name\ntype FixMap        = Map Name Fixity\ntype DocPaths      = (FilePath, Maybe FilePath) -- paths to HTML and sources\n\n\n-----------------------------------------------------------------------------\n-- * Interface\n-----------------------------------------------------------------------------\n\n\n-- | 'Interface' holds all information used to render a single Haddock page.\n-- It represents the /interface/ of a module. The core business of Haddock\n-- lies in creating this structure. Note that the record contains some fields\n-- that are only used to create the final record, and that are not used by the\n-- backends.\ndata Interface = Interface\n  {\n    -- | The module behind this interface.\n    ifaceMod             :: !Module\n\n    -- | Is this a signature?\n  , ifaceIsSig           :: !Bool\n\n    -- | Original file name of the module.\n  , ifaceOrigFilename    :: !FilePath\n\n    -- | Textual information about the module.\n  , ifaceInfo            :: !(HaddockModInfo Name)\n\n    -- | Documentation header.\n  , ifaceDoc             :: !(Documentation Name)\n\n    -- | Documentation header with cross-reference information.\n  , ifaceRnDoc           :: !(Documentation DocName)\n\n    -- | Haddock options for this module (prune, ignore-exports, etc).\n  , ifaceOptions         :: ![DocOption]\n\n    -- | Declarations originating from the module. Excludes declarations without\n    -- names (instances and stand-alone documentation comments). Includes\n    -- names of subordinate declarations mapped to their parent declarations.\n  , ifaceDeclMap         :: !(Map Name [LHsDecl GhcRn])\n\n    -- | Documentation of declarations originating from the module (including\n    -- subordinates).\n  , ifaceDocMap          :: !(DocMap Name)\n  , ifaceArgMap          :: !(ArgMap Name)\n\n    -- | Documentation of declarations originating from the module (including\n    -- subordinates).\n  , ifaceRnDocMap        :: !(DocMap DocName)\n  , ifaceRnArgMap        :: !(ArgMap DocName)\n\n  , ifaceFixMap          :: !(Map Name Fixity)\n\n  , ifaceExportItems     :: ![ExportItem GhcRn]\n  , ifaceRnExportItems   :: ![ExportItem DocNameI]\n\n    -- | All names exported by the module.\n  , ifaceExports         :: ![Name]\n\n    -- | All \\\"visible\\\" names exported by the module.\n    -- A visible name is a name that will show up in the documentation of the\n    -- module.\n  , ifaceVisibleExports  :: ![Name]\n\n    -- | Aliases of module imports as in @import A.B.C as C@.\n  , ifaceModuleAliases   :: !AliasMap\n\n    -- | Instances exported by the module.\n  , ifaceInstances       :: ![ClsInst]\n  , ifaceFamInstances    :: ![FamInst]\n\n    -- | Orphan instances\n  , ifaceOrphanInstances :: ![DocInstance GhcRn]\n  , ifaceRnOrphanInstances :: ![DocInstance DocNameI]\n\n    -- | The number of haddockable and haddocked items in the module, as a\n    -- tuple. Haddockable items are the exports and the module itself.\n  , ifaceHaddockCoverage :: !(Int, Int)\n\n    -- | Warnings for things defined in this module.\n  , ifaceWarningMap :: !WarningMap\n\n    -- | Tokenized source code of module (avaliable if Haddock is invoked with\n    -- source generation flag).\n  , ifaceTokenizedSrc :: !(Maybe [RichToken])\n  }\n\ntype WarningMap = Map Name (Doc Name)\n\n\n-- | A subset of the fields of 'Interface' that we store in the interface\n-- files.\ndata InstalledInterface = InstalledInterface\n  {\n    -- | The module represented by this interface.\n    instMod              :: Module\n\n    -- | Is this a signature?\n  , instIsSig            :: Bool\n\n    -- | Textual information about the module.\n  , instInfo             :: HaddockModInfo Name\n\n    -- | Documentation of declarations originating from the module (including\n    -- subordinates).\n  , instDocMap           :: DocMap Name\n\n  , instArgMap           :: ArgMap Name\n\n    -- | All names exported by this module.\n  , instExports          :: [Name]\n\n    -- | All \\\"visible\\\" names exported by the module.\n    -- A visible name is a name that will show up in the documentation of the\n    -- module.\n  , instVisibleExports   :: [Name]\n\n    -- | Haddock options for this module (prune, ignore-exports, etc).\n  , instOptions          :: [DocOption]\n\n  , instFixMap           :: Map Name Fixity\n  }\n\n\n-- | Convert an 'Interface' to an 'InstalledInterface'\ntoInstalledIface :: Interface -> InstalledInterface\ntoInstalledIface interface = InstalledInterface\n  { instMod              = ifaceMod              interface\n  , instIsSig            = ifaceIsSig            interface\n  , instInfo             = ifaceInfo             interface\n  , instDocMap           = ifaceDocMap           interface\n  , instArgMap           = ifaceArgMap           interface\n  , instExports          = ifaceExports          interface\n  , instVisibleExports   = ifaceVisibleExports   interface\n  , instOptions          = ifaceOptions          interface\n  , instFixMap           = ifaceFixMap           interface\n  }\n\n\n-----------------------------------------------------------------------------\n-- * Export items & declarations\n-----------------------------------------------------------------------------\n\n\ndata ExportItem name\n\n  -- | An exported declaration.\n  = ExportDecl\n      {\n        -- | A declaration.\n        expItemDecl :: !(LHsDecl name)\n\n        -- | Bundled patterns for a data type declaration\n      , expItemPats :: ![(HsDecl name, DocForDecl (IdP name))]\n\n        -- | Maybe a doc comment, and possibly docs for arguments (if this\n        -- decl is a function or type-synonym).\n      , expItemMbDoc :: !(DocForDecl (IdP name))\n\n        -- | Subordinate names, possibly with documentation.\n      , expItemSubDocs :: ![(IdP name, DocForDecl (IdP name))]\n\n        -- | Instances relevant to this declaration, possibly with\n        -- documentation.\n      , expItemInstances :: ![DocInstance name]\n\n        -- | Fixity decls relevant to this declaration (including subordinates).\n      , expItemFixities :: ![(IdP name, Fixity)]\n\n        -- | Whether the ExportItem is from a TH splice or not, for generating\n        -- the appropriate type of Source link.\n      , expItemSpliced :: !Bool\n      }\n\n  -- | An exported entity for which we have no documentation (perhaps because it\n  -- resides in another package).\n  | ExportNoDecl\n      { expItemName :: !(IdP name)\n\n        -- | Subordinate names.\n      , expItemSubs :: ![IdP name]\n      }\n\n  -- | A section heading.\n  | ExportGroup\n      {\n        -- | Section level (1, 2, 3, ...).\n        expItemSectionLevel :: !Int\n\n        -- | Section id (for hyperlinks).\n      , expItemSectionId :: !String\n\n        -- | Section heading text.\n      , expItemSectionText :: !(Doc (IdP name))\n      }\n\n  -- | Some documentation.\n  | ExportDoc !(MDoc (IdP name))\n\n  -- | A cross-reference to another module.\n  | ExportModule !Module\n\ndata Documentation name = Documentation\n  { documentationDoc :: Maybe (MDoc name)\n  , documentationWarning :: !(Maybe (Doc name))\n  } deriving Functor\n\n\n-- | Arguments and result are indexed by Int, zero-based from the left,\n-- because that's the easiest to use when recursing over types.\ntype FnArgsDoc name = Map Int (MDoc name)\ntype DocForDecl name = (Documentation name, FnArgsDoc name)\n\n\nnoDocForDecl :: DocForDecl name\nnoDocForDecl = (Documentation Nothing Nothing, Map.empty)\n\n\n-----------------------------------------------------------------------------\n-- * Cross-referencing\n-----------------------------------------------------------------------------\n\n\n-- | Type of environment used to cross-reference identifiers in the syntax.\ntype LinkEnv = Map Name Module\n\n-- | Extends 'Name' with cross-reference information.\ndata DocName\n  = Documented Name Module\n     -- ^ This thing is part of the (existing or resulting)\n     -- documentation. The 'Module' is the preferred place\n     -- in the documentation to refer to.\n  | Undocumented Name\n     -- ^ This thing is not part of the (existing or resulting)\n     -- documentation, as far as Haddock knows.\n  deriving (Eq, Data)\n\ndata DocNameI\n\ntype instance IdP DocNameI = DocName\n\n\ninstance NamedThing DocName where\n  getName (Documented name _) = name\n  getName (Undocumented name) = name\n\n-- | Useful for debugging\ninstance Outputable DocName where\n  ppr = ppr . getName\n\ninstance OutputableBndr DocName where\n  pprBndr _ = ppr . getName\n  pprPrefixOcc = pprPrefixOcc . getName\n  pprInfixOcc = pprInfixOcc . getName\n\nclass NamedThing name => SetName name where\n\n    setName :: Name -> name -> name\n\n\ninstance SetName Name where\n\n    setName name' _ = name'\n\n\ninstance SetName DocName where\n\n    setName name' (Documented _ mdl) = Documented name' mdl\n    setName name' (Undocumented _) = Undocumented name'\n\n\n\n-----------------------------------------------------------------------------\n-- * Instances\n-----------------------------------------------------------------------------\n\n-- | The three types of instances\ndata InstType name\n  = ClassInst\n      { clsiCtx :: [HsType name]\n      , clsiTyVars :: LHsQTyVars name\n      , clsiSigs :: [Sig name]\n      , clsiAssocTys :: [PseudoFamilyDecl name]\n      }\n  | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)\n  | DataInst (TyClDecl name)        -- ^ Data constructors\n\ninstance (SourceTextX a, OutputableBndrId a)\n         => Outputable (InstType a) where\n  ppr (ClassInst { .. }) = text \"ClassInst\"\n      <+> ppr clsiCtx\n      <+> ppr clsiTyVars\n      <+> ppr clsiSigs\n  ppr (TypeInst  a) = text \"TypeInst\"  <+> ppr a\n  ppr (DataInst  a) = text \"DataInst\"  <+> ppr a\n\n\n-- | Almost the same as 'FamilyDecl' except for type binders.\n--\n-- In order to perform type specialization for class instances, we need to\n-- substitute class variables to appropriate type. However, type variables in\n-- associated type are specified using 'LHsTyVarBndrs' instead of 'HsType'.\n-- This makes type substitution impossible and to overcome this issue,\n-- 'PseudoFamilyDecl' type is introduced.\ndata PseudoFamilyDecl name = PseudoFamilyDecl\n    { pfdInfo :: FamilyInfo name\n    , pfdLName :: Located (IdP name)\n    , pfdTyVars :: [LHsType name]\n    , pfdKindSig :: LFamilyResultSig name\n    }\n\n\nmkPseudoFamilyDecl :: FamilyDecl name -> PseudoFamilyDecl name\nmkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl\n    { pfdInfo = fdInfo\n    , pfdLName = fdLName\n    , pfdTyVars = [ L loc (mkType bndr) | L loc bndr <- hsq_explicit fdTyVars ]\n    , pfdKindSig = fdResultSig\n    }\n  where\n    mkType (KindedTyVar (L loc name) lkind) =\n        HsKindSig tvar lkind\n      where\n        tvar = L loc (HsTyVar NotPromoted (L loc name))\n    mkType (UserTyVar name) = HsTyVar NotPromoted name\n\n\n-- | An instance head that may have documentation and a source location.\ntype DocInstance name = (InstHead name, Maybe (MDoc (IdP name)), Located (IdP name), Maybe Module)\n\n-- | The head of an instance. Consists of a class name, a list of type\n-- parameters (which may be annotated with kinds), and an instance type\ndata InstHead name = InstHead\n    { ihdClsName :: IdP name\n    , ihdTypes :: [HsType name]\n    , ihdInstType :: InstType name\n    }\n\n\n-- | An instance origin information.\n--\n-- This is used primarily in HTML backend to generate unique instance\n-- identifiers (for expandable sections).\ndata InstOrigin name\n    = OriginClass name\n    | OriginData name\n    | OriginFamily name\n\n\ninstance NamedThing name => NamedThing (InstOrigin name) where\n\n    getName (OriginClass name) = getName name\n    getName (OriginData name) = getName name\n    getName (OriginFamily name) = getName name\n\n\n-----------------------------------------------------------------------------\n-- * Documentation comments\n-----------------------------------------------------------------------------\n\n\ntype LDoc id = Located (Doc id)\n\ntype Doc id = DocH (ModuleName, OccName) id\ntype MDoc id = MetaDoc (ModuleName, OccName) id\n\ntype DocMarkup id a = DocMarkupH (ModuleName, OccName) id a\n\ninstance (NFData a, NFData mod)\n         => NFData (DocH mod a) where\n  rnf doc = case doc of\n    DocEmpty                  -> ()\n    DocAppend a b             -> a `deepseq` b `deepseq` ()\n    DocString a               -> a `deepseq` ()\n    DocParagraph a            -> a `deepseq` ()\n    DocIdentifier a           -> a `deepseq` ()\n    DocIdentifierUnchecked a  -> a `deepseq` ()\n    DocModule a               -> a `deepseq` ()\n    DocWarning a              -> a `deepseq` ()\n    DocEmphasis a             -> a `deepseq` ()\n    DocBold a                 -> a `deepseq` ()\n    DocMonospaced a           -> a `deepseq` ()\n    DocUnorderedList a        -> a `deepseq` ()\n    DocOrderedList a          -> a `deepseq` ()\n    DocDefList a              -> a `deepseq` ()\n    DocCodeBlock a            -> a `deepseq` ()\n    DocHyperlink a            -> a `deepseq` ()\n    DocPic a                  -> a `deepseq` ()\n    DocMathInline a           -> a `deepseq` ()\n    DocMathDisplay a          -> a `deepseq` ()\n    DocAName a                -> a `deepseq` ()\n    DocProperty a             -> a `deepseq` ()\n    DocExamples a             -> a `deepseq` ()\n    DocHeader a               -> a `deepseq` ()\n    DocTable a                -> a `deepseq` ()\n\n#if !MIN_VERSION_ghc(8,0,2)\n-- These were added to GHC itself in 8.0.2\ninstance NFData Name where rnf x = seq x ()\ninstance NFData OccName where rnf x = seq x ()\ninstance NFData ModuleName where rnf x = seq x ()\n#endif\n\ninstance NFData id => NFData (Header id) where\n  rnf (Header a b) = a `deepseq` b `deepseq` ()\n\ninstance NFData Hyperlink where\n  rnf (Hyperlink a b) = a `deepseq` b `deepseq` ()\n\ninstance NFData Picture where\n  rnf (Picture a b) = a `deepseq` b `deepseq` ()\n\ninstance NFData Example where\n  rnf (Example a b) = a `deepseq` b `deepseq` ()\n\ninstance NFData id => NFData (Table id) where\n    rnf (Table h b) = h `deepseq` b `deepseq` ()\n\ninstance NFData id => NFData (TableRow id) where\n    rnf (TableRow cs) = cs `deepseq` ()\n\ninstance NFData id => NFData (TableCell id) where\n    rnf (TableCell i j c) = i `deepseq` j `deepseq` c `deepseq` ()\n\nexampleToString :: Example -> String\nexampleToString (Example expression result) =\n    \">>> \" ++ expression ++ \"\\n\" ++  unlines result\n\ndata HaddockModInfo name = HaddockModInfo\n  { hmi_description :: Maybe (Doc name)\n  , hmi_copyright   :: Maybe String\n  , hmi_license     :: Maybe String\n  , hmi_maintainer  :: Maybe String\n  , hmi_stability   :: Maybe String\n  , hmi_portability :: Maybe String\n  , hmi_safety      :: Maybe String\n  , hmi_language    :: Maybe Language\n  , hmi_extensions  :: [LangExt.Extension]\n  }\n\n\nemptyHaddockModInfo :: HaddockModInfo a\nemptyHaddockModInfo = HaddockModInfo\n  { hmi_description = Nothing\n  , hmi_copyright   = Nothing\n  , hmi_license     = Nothing\n  , hmi_maintainer  = Nothing\n  , hmi_stability   = Nothing\n  , hmi_portability = Nothing\n  , hmi_safety      = Nothing\n  , hmi_language    = Nothing\n  , hmi_extensions  = []\n  }\n\n\n-----------------------------------------------------------------------------\n-- * Options\n-----------------------------------------------------------------------------\n\n\n-- | Source-level options for controlling the documentation.\ndata DocOption\n  = OptHide            -- ^ This module should not appear in the docs.\n  | OptPrune\n  | OptIgnoreExports   -- ^ Pretend everything is exported.\n  | OptNotHome         -- ^ Not the best place to get docs for things\n                       -- exported by this module.\n  | OptShowExtensions  -- ^ Render enabled extensions for this module.\n  deriving (Eq, Show)\n\n\n-- | Option controlling how to qualify names\ndata QualOption\n  = OptNoQual         -- ^ Never qualify any names.\n  | OptFullQual       -- ^ Qualify all names fully.\n  | OptLocalQual      -- ^ Qualify all imported names fully.\n  | OptRelativeQual   -- ^ Like local, but strip module prefix\n                      --   from modules in the same hierarchy.\n  | OptAliasedQual    -- ^ Uses aliases of module names\n                      --   as suggested by module import renamings.\n                      --   However, we are unfortunately not able\n                      --   to maintain the original qualifications.\n                      --   Image a re-export of a whole module,\n                      --   how could the re-exported identifiers be qualified?\n\ntype AliasMap = Map Module ModuleName\n\ndata Qualification\n  = NoQual\n  | FullQual\n  | LocalQual Module\n  | RelativeQual Module\n  | AliasedQual AliasMap Module\n       -- ^ @Module@ contains the current module.\n       --   This way we can distinguish imported and local identifiers.\n\nmakeContentsQual :: QualOption -> Qualification\nmakeContentsQual qual =\n  case qual of\n    OptNoQual -> NoQual\n    _         -> FullQual\n\nmakeModuleQual :: QualOption -> AliasMap -> Module -> Qualification\nmakeModuleQual qual aliases mdl =\n  case qual of\n    OptLocalQual      -> LocalQual mdl\n    OptRelativeQual   -> RelativeQual mdl\n    OptAliasedQual    -> AliasedQual aliases mdl\n    OptFullQual       -> FullQual\n    OptNoQual         -> NoQual\n\n-- | Whether to hide empty contexts\n-- Since pattern synonyms have two contexts with different semantics, it is\n-- important to all of them, even if one of them is empty.\ndata HideEmptyContexts\n  = HideEmptyContexts\n  | ShowEmptyToplevelContexts\n\n-- | When to qualify @since@ annotations with their package\ndata SinceQual\n  = Always\n  | External -- ^ only qualify when the thing being annotated is from\n             -- an external package\n\n-----------------------------------------------------------------------------\n-- * Error handling\n-----------------------------------------------------------------------------\n\n\n-- A monad which collects error messages, locally defined to avoid a dep on mtl\n\n\ntype ErrMsg = String\nnewtype ErrMsgM a = Writer { runWriter :: (a, [ErrMsg]) }\n\n\ninstance Functor ErrMsgM where\n        fmap f (Writer (a, msgs)) = Writer (f a, msgs)\n\ninstance Applicative ErrMsgM where\n    pure a = Writer (a, [])\n    (<*>)  = ap\n\ninstance Monad ErrMsgM where\n        return   = pure\n        m >>= k  = Writer $ let\n                (a, w)  = runWriter m\n                (b, w') = runWriter (k a)\n                in (b, w ++ w')\n\n\ntell :: [ErrMsg] -> ErrMsgM ()\ntell w = Writer ((), w)\n\n\n-- Exceptions\n\n\n-- | Haddock's own exception type.\ndata HaddockException = HaddockException String deriving Typeable\n\n\ninstance Show HaddockException where\n  show (HaddockException str) = str\n\n\nthrowE :: String -> a\ninstance Exception HaddockException\nthrowE str = throw (HaddockException str)\n\n\n-- In \"Haddock.Interface.Create\", we need to gather\n-- @Haddock.Types.ErrMsg@s a lot, like @ErrMsgM@ does,\n-- but we can't just use @GhcT ErrMsgM@ because GhcT requires the\n-- transformed monad to be MonadIO.\nnewtype ErrMsgGhc a = WriterGhc { runWriterGhc :: Ghc (a, [ErrMsg]) }\n--instance MonadIO ErrMsgGhc where\n--  liftIO = WriterGhc . fmap (\\a->(a,[])) liftIO\n--er, implementing GhcMonad involves annoying ExceptionMonad and\n--WarnLogMonad classes, so don't bother.\nliftGhcToErrMsgGhc :: Ghc a -> ErrMsgGhc a\nliftGhcToErrMsgGhc = WriterGhc . fmap (\\a->(a,[]))\nliftErrMsg :: ErrMsgM a -> ErrMsgGhc a\nliftErrMsg = WriterGhc . return . runWriter\n--  for now, use (liftErrMsg . tell) for this\n--tell :: [ErrMsg] -> ErrMsgGhc ()\n--tell msgs = WriterGhc $ return ( (), msgs )\n\n\ninstance Functor ErrMsgGhc where\n  fmap f (WriterGhc x) = WriterGhc (fmap (first f) x)\n\ninstance Applicative ErrMsgGhc where\n    pure a = WriterGhc (return (a, []))\n    (<*>) = ap\n\ninstance Monad ErrMsgGhc where\n  return = pure\n  m >>= k = WriterGhc $ runWriterGhc m >>= \\ (a, msgs1) ->\n               fmap (second (msgs1 ++)) (runWriterGhc (k a))\n\ninstance MonadIO ErrMsgGhc where\n  liftIO m = WriterGhc (fmap (\\x -> (x, [])) (liftIO m))\n\n-----------------------------------------------------------------------------\n-- * Pass sensitive types\n-----------------------------------------------------------------------------\n\ntype instance PostRn DocNameI NameSet        = PlaceHolder\ntype instance PostRn DocNameI Fixity         = PlaceHolder\ntype instance PostRn DocNameI Bool           = PlaceHolder\ntype instance PostRn DocNameI Name           = DocName\ntype instance PostRn DocNameI (Located Name) = Located DocName\ntype instance PostRn DocNameI [Name]         = PlaceHolder\ntype instance PostRn DocNameI DocName        = DocName\n\ntype instance PostTc DocNameI Kind     = PlaceHolder\ntype instance PostTc DocNameI Type     = PlaceHolder\ntype instance PostTc DocNameI Coercion = PlaceHolder\n", "num_lines": 683}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Utils\n-- Copyright   :  (c) The University of Glasgow 2001-2002,\n--                    Simon Marlow 2003-2006,\n--                    David Waern  2006-2009\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Utils (\n\n  -- * Misc utilities\n  restrictTo, emptyHsQTvs,\n  toDescription, toInstalledDescription,\n  mkEmptySigWcType, addClassContext, lHsQTyVarsToTypes,\n\n  -- * Filename utilities\n  moduleHtmlFile, moduleHtmlFile',\n  contentsHtmlFile, indexHtmlFile, indexJsonFile,\n  moduleIndexFrameName, mainFrameName, synopsisFrameName,\n  subIndexHtmlFile,\n  haddockJsFile, jsQuickJumpFile,\n  quickJumpCssFile,\n\n  -- * Anchor and URL utilities\n  moduleNameUrl, moduleNameUrl', moduleUrl,\n  nameAnchorId,\n  makeAnchorId,\n\n  -- * Miscellaneous utilities\n  getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,\n\n  -- * HTML cross reference mapping\n  html_xrefs_ref, html_xrefs_ref',\n\n  -- * Doc markup\n  mkMeta,\n\n  -- * List utilities\n  replace,\n  spanWith,\n\n  -- * MTL stuff\n  MonadIO(..),\n\n  -- * Logging\n  parseVerbosity,\n  out,\n\n  -- * System tools\n  getProcessID\n ) where\n\n\nimport Documentation.Haddock.Doc (emptyMetaDoc)\nimport Haddock.Types\nimport Haddock.GhcUtils\n\nimport GHC\nimport Name\nimport NameSet ( emptyNameSet )\nimport HsTypes (selectorFieldOcc)\n\nimport Control.Monad ( liftM )\nimport Data.Char ( isAlpha, isAlphaNum, isAscii, ord, chr )\nimport Numeric ( showIntAtBase )\nimport Data.Map ( Map )\nimport qualified Data.Map as Map hiding ( Map )\nimport Data.IORef ( IORef, newIORef, readIORef )\nimport Data.List ( isSuffixOf )\nimport Data.Maybe ( mapMaybe )\nimport System.Environment ( getProgName )\nimport System.Exit\nimport System.IO ( hPutStr, stderr )\nimport System.IO.Unsafe ( unsafePerformIO )\nimport qualified System.FilePath.Posix as HtmlPath\nimport Distribution.Verbosity\nimport Distribution.ReadE\n\n#ifndef mingw32_HOST_OS\nimport qualified System.Posix.Internals\n#endif\n\nimport MonadUtils ( MonadIO(..) )\n\n\n--------------------------------------------------------------------------------\n-- * Logging\n--------------------------------------------------------------------------------\n\n\nparseVerbosity :: String -> Either String Verbosity\nparseVerbosity = runReadE flagToVerbosity\n\n\n-- | Print a message to stdout, if it is not too verbose\nout :: MonadIO m\n    => Verbosity -- ^ program verbosity\n    -> Verbosity -- ^ message verbosity\n    -> String -> m ()\nout progVerbosity msgVerbosity msg\n  | msgVerbosity <= progVerbosity = liftIO $ putStrLn msg\n  | otherwise = return ()\n\n\n--------------------------------------------------------------------------------\n-- * Some Utilities\n--------------------------------------------------------------------------------\n\n\n-- | Extract a module's short description.\ntoDescription :: Interface -> Maybe (MDoc Name)\ntoDescription = fmap mkMeta . hmi_description . ifaceInfo\n\n\n-- | Extract a module's short description.\ntoInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)\ntoInstalledDescription = fmap mkMeta . hmi_description . instInfo\n\nmkMeta :: Doc a -> MDoc a\nmkMeta x = emptyMetaDoc { _doc = x }\n\nmkEmptySigWcType :: LHsType GhcRn -> LHsSigWcType GhcRn\n-- Dubious, because the implicit binders are empty even\n-- though the type might have free varaiables\nmkEmptySigWcType ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs ty)\n\naddClassContext :: Name -> LHsQTyVars GhcRn -> LSig GhcRn -> LSig GhcRn\n-- Add the class context to a class-op signature\naddClassContext cls tvs0 (L pos (ClassOpSig _ lname ltype))\n  = L pos (TypeSig lname (mkEmptySigWcType (go (hsSigType ltype))))\n          -- The mkEmptySigWcType is suspicious\n  where\n    go (L loc (HsForAllTy { hst_bndrs = tvs, hst_body = ty }))\n       = L loc (HsForAllTy { hst_bndrs = tvs, hst_body = go ty })\n    go (L loc (HsQualTy { hst_ctxt = ctxt, hst_body = ty }))\n       = L loc (HsQualTy { hst_ctxt = add_ctxt ctxt, hst_body = ty })\n    go (L loc ty)\n       = L loc (HsQualTy { hst_ctxt = add_ctxt (L loc []), hst_body = L loc ty })\n\n    extra_pred = nlHsTyConApp cls (lHsQTyVarsToTypes tvs0)\n    add_ctxt (L loc preds) = L loc (extra_pred : preds)\n\naddClassContext _ _ sig = sig   -- E.g. a MinimalSig is fine\n\nlHsQTyVarsToTypes :: LHsQTyVars GhcRn -> [LHsType GhcRn]\nlHsQTyVarsToTypes tvs\n  = [ noLoc (HsTyVar NotPromoted (noLoc (hsLTyVarName tv)))\n    | tv <- hsQTvExplicit tvs ]\n\n--------------------------------------------------------------------------------\n-- * Making abstract declarations\n--------------------------------------------------------------------------------\n\n\nrestrictTo :: [Name] -> LHsDecl GhcRn -> LHsDecl GhcRn\nrestrictTo names (L loc decl) = L loc $ case decl of\n  TyClD d | isDataDecl d  ->\n    TyClD (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) })\n  TyClD d | isClassDecl d ->\n    TyClD (d { tcdSigs = restrictDecls names (tcdSigs d),\n               tcdATs = restrictATs names (tcdATs d) })\n  _ -> decl\n\nrestrictDataDefn :: [Name] -> HsDataDefn GhcRn -> HsDataDefn GhcRn\nrestrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons })\n  | DataType <- new_or_data\n  = defn { dd_cons = restrictCons names cons }\n  | otherwise    -- Newtype\n  = case restrictCons names cons of\n      []    -> defn { dd_ND = DataType, dd_cons = [] }\n      [con] -> defn { dd_cons = [con] }\n      _ -> error \"Should not happen\"\n\nrestrictCons :: [Name] -> [LConDecl GhcRn] -> [LConDecl GhcRn]\nrestrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]\n  where\n    keep d | any (\\n -> n `elem` names) (map unLoc $ getConNames d) =\n      case getConDetails h98d of\n        PrefixCon _ -> Just d\n        RecCon fields\n          | all field_avail (unL fields) -> Just d\n          | otherwise -> Just (h98d { con_details = PrefixCon (field_types (map unL (unL fields))) })\n          -- if we have *all* the field names available, then\n          -- keep the record declaration.  Otherwise degrade to\n          -- a constructor declaration.  This isn't quite right, but\n          -- it's the best we can do.\n        InfixCon _ _ -> Just d\n      where\n        h98d = h98ConDecl d\n        h98ConDecl c@ConDeclH98{} = c\n        h98ConDecl c@ConDeclGADT{} = c'\n          where\n            (details,_res_ty,cxt,tvs) = gadtDeclDetails (con_type c)\n            c' :: ConDecl GhcRn\n            c' = ConDeclH98\n                   { con_name = head (con_names c)\n                   , con_qvars = Just $ HsQTvs { hsq_implicit = mempty\n                                               , hsq_explicit = tvs\n                                               , hsq_dependent = emptyNameSet }\n                   , con_cxt = Just cxt\n                   , con_details = details\n                   , con_doc = con_doc c\n                   }\n\n        field_avail :: LConDeclField GhcRn -> Bool\n        field_avail (L _ (ConDeclField fs _ _))\n            = all (\\f -> selectorFieldOcc (unLoc f) `elem` names) fs\n        field_types flds = [ t | ConDeclField _ t _ <- flds ]\n\n    keep _ = Nothing\n\nrestrictDecls :: [Name] -> [LSig GhcRn] -> [LSig GhcRn]\nrestrictDecls names = mapMaybe (filterLSigNames (`elem` names))\n\n\nrestrictATs :: [Name] -> [LFamilyDecl GhcRn] -> [LFamilyDecl GhcRn]\nrestrictATs names ats = [ at | at <- ats , unL (fdLName (unL at)) `elem` names ]\n\nemptyHsQTvs :: LHsQTyVars Name\n-- This function is here, rather than in HsTypes, because it *renamed*, but\n-- does not necessarily have all the rigt kind variables.  It is used\n-- in Haddock just for printing, so it doesn't matter\nemptyHsQTvs = HsQTvs { hsq_implicit = error \"haddock:emptyHsQTvs\"\n                     , hsq_explicit = []\n                     , hsq_dependent = error \"haddock:emptyHsQTvs\" }\n\n\n--------------------------------------------------------------------------------\n-- * Filename mangling functions stolen from s main/DriverUtil.lhs.\n--------------------------------------------------------------------------------\n\n\nbaseName :: ModuleName -> FilePath\nbaseName = map (\\c -> if c == '.' then '-' else c) . moduleNameString\n\n\nmoduleHtmlFile :: Module -> FilePath\nmoduleHtmlFile mdl =\n  case Map.lookup mdl html_xrefs of\n    Nothing  -> baseName mdl' ++ \".html\"\n    Just fp0 -> HtmlPath.joinPath [fp0, baseName mdl' ++ \".html\"]\n  where\n   mdl' = moduleName mdl\n\n\nmoduleHtmlFile' :: ModuleName -> FilePath\nmoduleHtmlFile' mdl =\n  case Map.lookup mdl html_xrefs' of\n    Nothing  -> baseName mdl ++ \".html\"\n    Just fp0 -> HtmlPath.joinPath [fp0, baseName mdl ++ \".html\"]\n\n\ncontentsHtmlFile, indexHtmlFile, indexJsonFile :: String\ncontentsHtmlFile = \"index.html\"\nindexHtmlFile = \"doc-index.html\"\nindexJsonFile = \"doc-index.json\"\n\n\n\nmoduleIndexFrameName, mainFrameName, synopsisFrameName :: String\nmoduleIndexFrameName = \"modules\"\nmainFrameName = \"main\"\nsynopsisFrameName = \"synopsis\"\n\n\nsubIndexHtmlFile :: String -> String\nsubIndexHtmlFile ls = \"doc-index-\" ++ b ++ \".html\"\n   where b | all isAlpha ls = ls\n           | otherwise = concatMap (show . ord) ls\n\n\n-------------------------------------------------------------------------------\n-- * Anchor and URL utilities\n--\n-- NB: Anchor IDs, used as the destination of a link within a document must\n-- conform to XML's NAME production. That, taken with XHTML and HTML 4.01's\n-- various needs and compatibility constraints, means these IDs have to match:\n--      [A-Za-z][A-Za-z0-9:_.-]*\n-- Such IDs do not need to be escaped in any way when used as the fragment part\n-- of a URL. Indeed, %-escaping them can lead to compatibility issues as it\n-- isn't clear if such fragment identifiers should, or should not be unescaped\n-- before being matched with IDs in the target document.\n-------------------------------------------------------------------------------\n\n\nmoduleUrl :: Module -> String\nmoduleUrl = moduleHtmlFile\n\n\nmoduleNameUrl :: Module -> OccName -> String\nmoduleNameUrl mdl n = moduleUrl mdl ++ '#' : nameAnchorId n\n\n\nmoduleNameUrl' :: ModuleName -> OccName -> String\nmoduleNameUrl' mdl n = moduleHtmlFile' mdl ++ '#' : nameAnchorId n\n\n\nnameAnchorId :: OccName -> String\nnameAnchorId name = makeAnchorId (prefix : ':' : occNameString name)\n where prefix | isValOcc name = 'v'\n              | otherwise     = 't'\n\n\n-- | Takes an arbitrary string and makes it a valid anchor ID. The mapping is\n-- identity preserving.\nmakeAnchorId :: String -> String\nmakeAnchorId [] = []\nmakeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r\n  where\n    escape p c | p c = [c]\n               | otherwise = '-' : show (ord c) ++ \"-\"\n    isLegal ':' = True\n    isLegal '_' = True\n    isLegal '.' = True\n    isLegal c = isAscii c && isAlphaNum c\n       -- NB: '-' is legal in IDs, but we use it as the escape char\n\n\n-------------------------------------------------------------------------------\n-- * Files we need to copy from our $libdir\n-------------------------------------------------------------------------------\n\n\nhaddockJsFile :: String\nhaddockJsFile = \"haddock-bundle.min.js\"\n\njsQuickJumpFile :: String\njsQuickJumpFile = \"quick-jump.min.js\"\n\nquickJumpCssFile :: String\nquickJumpCssFile = \"quick-jump.css\"\n\n-------------------------------------------------------------------------------\n-- * Misc.\n-------------------------------------------------------------------------------\n\n\ngetProgramName :: IO String\ngetProgramName = liftM (`withoutSuffix` \".bin\") getProgName\n   where str `withoutSuffix` suff\n            | suff `isSuffixOf` str = take (length str - length suff) str\n            | otherwise             = str\n\n\nbye :: String -> IO a\nbye s = putStr s >> exitSuccess\n\n\ndieMsg :: String -> IO ()\ndieMsg s = getProgramName >>= \\prog -> die (prog ++ \": \" ++ s)\n\n\nnoDieMsg :: String -> IO ()\nnoDieMsg s = getProgramName >>= \\prog -> hPutStr stderr (prog ++ \": \" ++ s)\n\n\nmapSnd :: (b -> c) -> [(a,b)] -> [(a,c)]\nmapSnd _ [] = []\nmapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs\n\n\nmapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)\nmapMaybeM _ Nothing = return Nothing\nmapMaybeM f (Just a) = liftM Just (f a)\n\n\nescapeStr :: String -> String\nescapeStr = escapeURIString isUnreserved\n\n\n-- Following few functions are copy'n'pasted from Network.URI module\n-- to avoid depending on the network lib, since doing so gives a\n-- circular build dependency between haddock and network\n-- (at least if you want to build network with haddock docs)\nescapeURIChar :: (Char -> Bool) -> Char -> String\nescapeURIChar p c\n    | p c       = [c]\n    | otherwise = '%' : myShowHex (ord c) \"\"\n    where\n        myShowHex :: Int -> ShowS\n        myShowHex n r =  case showIntAtBase 16 toChrHex n r of\n            []  -> \"00\"\n            [a] -> ['0',a]\n            cs  -> cs\n        toChrHex d\n            | d < 10    = chr (ord '0' + fromIntegral d)\n            | otherwise = chr (ord 'A' + fromIntegral (d - 10))\n\n\nescapeURIString :: (Char -> Bool) -> String -> String\nescapeURIString = concatMap . escapeURIChar\n\n\nisUnreserved :: Char -> Bool\nisUnreserved c = isAlphaNumChar c || (c `elem` \"-_.~\")\n\n\nisAlphaChar, isDigitChar, isAlphaNumChar :: Char -> Bool\nisAlphaChar c    = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')\nisDigitChar c    = c >= '0' && c <= '9'\nisAlphaNumChar c = isAlphaChar c || isDigitChar c\n\n\n-----------------------------------------------------------------------------\n-- * HTML cross references\n--\n-- For each module, we need to know where its HTML documentation lives\n-- so that we can point hyperlinks to it.  It is extremely\n-- inconvenient to plumb this information to all the places that need\n-- it (basically every function in HaddockHtml), and furthermore the\n-- mapping is constant for any single run of Haddock.  So for the time\n-- being I'm going to use a write-once global variable.\n-----------------------------------------------------------------------------\n\n\n{-# NOINLINE html_xrefs_ref #-}\nhtml_xrefs_ref :: IORef (Map Module FilePath)\nhtml_xrefs_ref = unsafePerformIO (newIORef (error \"module_map\"))\n\n\n{-# NOINLINE html_xrefs_ref' #-}\nhtml_xrefs_ref' :: IORef (Map ModuleName FilePath)\nhtml_xrefs_ref' = unsafePerformIO (newIORef (error \"module_map\"))\n\n\n{-# NOINLINE html_xrefs #-}\nhtml_xrefs :: Map Module FilePath\nhtml_xrefs = unsafePerformIO (readIORef html_xrefs_ref)\n\n\n{-# NOINLINE html_xrefs' #-}\nhtml_xrefs' :: Map ModuleName FilePath\nhtml_xrefs' = unsafePerformIO (readIORef html_xrefs_ref')\n\n\n-----------------------------------------------------------------------------\n-- * List utils\n-----------------------------------------------------------------------------\n\n\nreplace :: Eq a => a -> a -> [a] -> [a]\nreplace a b = map (\\x -> if x == a then b else x)\n\n\nspanWith :: (a -> Maybe b) -> [a] -> ([b],[a])\nspanWith _ [] = ([],[])\nspanWith p xs@(a:as)\n  | Just b <- p a = let (bs,cs) = spanWith p as in (b:bs,cs)\n  | otherwise     = ([],xs)\n\n-----------------------------------------------------------------------------\n-- * System tools\n-----------------------------------------------------------------------------\n\n\n#ifdef mingw32_HOST_OS\nforeign import ccall unsafe \"_getpid\" getProcessID :: IO Int -- relies on Int == Int32 on Windows\n#else\ngetProcessID :: IO Int\ngetProcessID = fmap fromIntegral System.Posix.Internals.c_getpid\n#endif\n", "num_lines": 467}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Version\n-- Copyright   :  (c) Simon Marlow 2003\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Version (\n  projectName, projectVersion, projectUrl\n) where\n\n#ifdef IN_GHC_TREE\nimport Paths_haddock ( version )\n#else\nimport Paths_haddock_api ( version )\n#endif\nimport Data.Version  ( showVersion )\n\nprojectName :: String\nprojectName = \"Haddock\"\n\nprojectUrl :: String\nprojectUrl  = \"http://www.haskell.org/haddock/\"\n\nprojectVersion :: String\nprojectVersion = showVersion version\n", "num_lines": 31}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.HaddockDB\n-- Copyright   :  (c) Simon Marlow 2003\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.HaddockDB (ppDocBook) where\n\n{-\nimport HaddockTypes\nimport HaddockUtil\nimport HsSyn2\n\nimport Text.PrettyPrint\n-}\n\n-----------------------------------------------------------------------------\n-- Printing the results in DocBook format\n\nppDocBook :: a\nppDocBook = error \"not working\"\n{-\nppDocBook :: FilePath -> [(Module, Interface)] -> String\nppDocBook odir mods = render (ppIfaces mods)\n\nppIfaces mods\n  =  text \"<!DOCTYPE BOOK PUBLIC \\\"-//OASIS//DTD DocBook V3.1//EN\\\" [\"\n  $$ text \"]>\"\n  $$ text \"<book>\"\n  $$ text \"<bookinfo>\"\n  $$ text \"<author><othername>HaskellDoc version 0.0</othername></author>\"\n  $$ text \"</bookinfo>\"\n  $$ text \"<article>\"\n  $$ vcat (map do_mod mods)\n  $$ text \"</article></book>\"\n  where\n     do_mod (Module mod, iface)\n        =  text \"<sect1 id=\\\"sec-\" <> text mod <> text \"\\\">\"\n        $$ text \"<title><literal>\"\n\t   <> text mod\n\t   <> text \"</literal></title>\"\n\t$$ text \"<indexterm><primary><literal>\"\n\t   <> text mod\n\t   <> text \"</literal></primary></indexterm>\"\n\t$$ text \"<variablelist>\"\n\t$$ vcat (map (do_export mod) (eltsFM (iface_decls iface)))\n\t$$ text \"</variablelist>\"\n\t$$ text \"</sect1>\"\n\n     do_export mod decl | (nm:_) <- declBinders decl\n\t=  text \"<varlistentry id=\" <> ppLinkId mod nm <> char '>'\n\t$$ text \"<term><literal>\"\n\t\t<> do_decl decl\n\t\t<> text \"</literal></term>\"\n\t$$ text \"<listitem>\"\n\t$$ text \"<para>\"\n\t$$ text \"</para>\"\n\t$$ text \"</listitem>\"\n\t$$ text \"</varlistentry>\"\n     do_export _ _ = empty\n\n     do_decl (HsTypeSig _ [nm] ty _)\n\t=  ppHsName nm <> text \" :: \" <> ppHsType ty\n     do_decl (HsTypeDecl _ nm args ty _)\n\t=  hsep ([text \"type\", ppHsName nm ]\n\t\t ++ map ppHsName args\n\t\t ++ [equals, ppHsType ty])\n     do_decl (HsNewTypeDecl loc ctx nm args con drv _)\n\t= hsep ([text \"data\", ppHsName nm] -- data, not newtype\n\t\t++ map ppHsName args\n\t\t) <+> equals <+> ppHsConstr con -- ToDo: derivings\n     do_decl (HsDataDecl loc ctx nm args cons drv _)\n\t= hsep ([text \"data\", {-ToDo: context-}ppHsName nm]\n\t        ++ map ppHsName args)\n            <+> vcat (zipWith (<+>) (equals : repeat (char '|'))\n                                    (map ppHsConstr cons))\n     do_decl (HsClassDecl loc ty fds decl _)\n\t= hsep [text \"class\", ppHsType ty]\n     do_decl decl\n\t= empty\n\nppHsConstr :: HsConDecl -> Doc\nppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) =\n\t ppHsName name\n\t <> (braces . hsep . punctuate comma . map ppField $ fieldList)\nppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) =\n\t hsep (ppHsName name : map ppHsBangType typeList)\n\nppField (HsFieldDecl ns ty doc)\n   = hsep (punctuate comma (map ppHsName ns) ++\n\t \t[text \"::\", ppHsBangType ty])\n\nppHsBangType :: HsBangType -> Doc\nppHsBangType (HsBangedTy ty) = char '!' <> ppHsType ty\nppHsBangType (HsUnBangedTy ty) = ppHsType ty\n\nppHsContext :: HsContext -> Doc\nppHsContext []      = empty\nppHsContext context = parenList (map (\\ (a,b) -> ppHsQName a <+>\n\t\t\t\t\t hsep (map ppHsAType b)) context)\n\nppHsType :: HsType -> Doc\nppHsType (HsForAllType Nothing context htype) =\n     hsep [ ppHsContext context, text \"=>\", ppHsType htype]\nppHsType (HsForAllType (Just tvs) [] htype) =\n     hsep (text \"forall\" : map ppHsName tvs ++ text \".\" : [ppHsType htype])\nppHsType (HsForAllType (Just tvs) context htype) =\n     hsep (text \"forall\" : map ppHsName tvs ++ text \".\" :\n\t   ppHsContext context : text \"=>\" : [ppHsType htype])\nppHsType (HsTyFun a b) = fsep [ppHsBType a, text \"-&gt;\", ppHsType b]\nppHsType (HsTyIP n t)  = fsep [(char '?' <> ppHsName n), text \"::\", ppHsType t]\nppHsType t = ppHsBType t\n\nppHsBType (HsTyApp (HsTyCon (Qual (Module \"Prelude\") (HsTyClsName (HsSpecial \"[]\")))) b )\n  = brackets $ ppHsType b\nppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b]\nppHsBType t = ppHsAType t\n\nppHsAType :: HsType -> Doc\nppHsAType (HsTyTuple True l)  = parenList . map ppHsType $ l\nppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l\n-- special case\nppHsAType (HsTyApp (HsTyCon (Qual (Module \"Prelude\") (HsTyClsName (HsSpecial \"[]\")))) b )\n  = brackets $ ppHsType b\nppHsAType (HsTyVar name) = ppHsName name\nppHsAType (HsTyCon name) = ppHsQName name\nppHsAType t = parens $ ppHsType t\n\nppHsQName :: HsQName -> Doc\nppHsQName (UnQual str)\t\t\t= ppHsName str\nppHsQName n@(Qual (Module mod) str)\n\t | n == unit_con_name\t\t= ppHsName str\n\t | isSpecial str \t\t= ppHsName str\n\t | otherwise\n\t\t=  text \"<link linkend=\" <> ppLinkId mod str <> char '>'\n\t\t<> ppHsName str\n\t\t<> text \"</link>\"\n\nisSpecial (HsTyClsName id) | HsSpecial _ <- id = True\nisSpecial (HsVarName id) | HsSpecial _ <- id = True\nisSpecial _ = False\n\nppHsName :: HsName -> Doc\nppHsName (HsTyClsName id) = ppHsIdentifier id\nppHsName (HsVarName id) = ppHsIdentifier id\n\nppHsIdentifier :: HsIdentifier -> Doc\nppHsIdentifier (HsIdent str)\t= text str\nppHsIdentifier (HsSymbol str) = text str\nppHsIdentifier (HsSpecial str) = text str\n\nppLinkId :: String -> HsName -> Doc\nppLinkId mod str\n  = hcat [char '\\\"', text mod, char '.', ppHsName str, char '\\\"']\n\n-- -----------------------------------------------------------------------------\n-- * Misc\n\nparenList :: [Doc] -> Doc\nparenList = parens . fsep . punctuate comma\n\nubxParenList :: [Doc] -> Doc\nubxParenList = ubxparens . fsep . punctuate comma\n\nubxparens p = text \"(#\" <> p <> text \"#)\"\n-}\n", "num_lines": 171}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Hoogle\n-- Copyright   :  (c) Neil Mitchell 2006-2008\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Write out Hoogle compatible documentation\n-- http://www.haskell.org/hoogle/\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Hoogle (\n    ppHoogle\n  ) where\n\nimport BasicTypes (OverlapFlag(..), OverlapMode(..), SourceText(..))\nimport InstEnv (ClsInst(..))\nimport Documentation.Haddock.Markup\nimport Haddock.GhcUtils\nimport Haddock.Types hiding (Version)\nimport Haddock.Utils hiding (out)\n\nimport HsBinds (emptyLHsBinds)\nimport GHC\nimport Outputable\nimport NameSet\n\nimport Data.Char\nimport Data.List\nimport Data.Maybe\nimport Data.Version\n\nimport System.Directory\nimport System.FilePath\nimport System.IO\n\nprefix :: [String]\nprefix = [\"-- Hoogle documentation, generated by Haddock\"\n         ,\"-- See Hoogle, http://www.haskell.org/hoogle/\"\n         ,\"\"]\n\n\nppHoogle :: DynFlags -> String -> Version -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO ()\nppHoogle dflags package version synopsis prologue ifaces odir = do\n    let -- Since Hoogle is line based, we want to avoid breaking long lines.\n        dflags' = dflags{ pprCols = maxBound }\n        filename = package ++ \".txt\"\n        contents = prefix ++\n                   docWith dflags' (drop 2 $ dropWhile (/= ':') synopsis) prologue ++\n                   [\"@package \" ++ package] ++\n                   [\"@version \" ++ showVersion version\n                   | not (null (versionBranch version)) ] ++\n                   concat [ppModule dflags' i | i <- ifaces, OptHide `notElem` ifaceOptions i]\n    createDirectoryIfMissing True odir\n    h <- openFile (odir </> filename) WriteMode\n    hSetEncoding h utf8\n    hPutStr h (unlines contents)\n    hClose h\n\nppModule :: DynFlags -> Interface -> [String]\nppModule dflags iface =\n  \"\" : ppDocumentation dflags (ifaceDoc iface) ++\n  [\"module \" ++ moduleString (ifaceMod iface)] ++\n  concatMap (ppExport dflags) (ifaceExportItems iface) ++\n  concatMap (ppInstance dflags) (ifaceInstances iface)\n\n\n---------------------------------------------------------------------\n-- Utility functions\n\ndropHsDocTy :: HsType a -> HsType a\ndropHsDocTy = f\n    where\n        g (L src x) = L src (f x)\n        f (HsForAllTy a e) = HsForAllTy a (g e)\n        f (HsQualTy a e) = HsQualTy a (g e)\n        f (HsBangTy a b) = HsBangTy a (g b)\n        f (HsAppTy a b) = HsAppTy (g a) (g b)\n        f (HsFunTy a b) = HsFunTy (g a) (g b)\n        f (HsListTy a) = HsListTy (g a)\n        f (HsPArrTy a) = HsPArrTy (g a)\n        f (HsTupleTy a b) = HsTupleTy a (map g b)\n        f (HsOpTy a b c) = HsOpTy (g a) b (g c)\n        f (HsParTy a) = HsParTy (g a)\n        f (HsKindSig a b) = HsKindSig (g a) b\n        f (HsDocTy a _) = f $ unL a\n        f x = x\n\noutHsType :: (SourceTextX a, OutputableBndrId a)\n          => DynFlags -> HsType a -> String\noutHsType dflags = out dflags . dropHsDocTy\n\n\ndropComment :: String -> String\ndropComment (' ':'-':'-':' ':_) = []\ndropComment (x:xs) = x : dropComment xs\ndropComment [] = []\n\n\noutWith :: Outputable a => (SDoc -> String) -> a -> [Char]\noutWith p = f . unwords . map (dropWhile isSpace) . lines . p . ppr\n    where\n        f xs | \" <document comment>\" `isPrefixOf` xs = f $ drop 19 xs\n        f (x:xs) = x : f xs\n        f [] = []\n\nout :: Outputable a => DynFlags -> a -> String\nout dflags = outWith $ showSDocUnqual dflags\n\noperator :: String -> String\noperator (x:xs) | not (isAlphaNum x) && x `notElem` \"_' ([{\" = '(' : x:xs ++ \")\"\noperator x = x\n\ncommaSeparate :: Outputable a => DynFlags -> [a] -> String\ncommaSeparate dflags = showSDocUnqual dflags . interpp'SP\n\n---------------------------------------------------------------------\n-- How to print each export\n\nppExport :: DynFlags -> ExportItem GhcRn -> [String]\nppExport dflags ExportDecl { expItemDecl    = L _ decl\n                           , expItemMbDoc   = (dc, _)\n                           , expItemSubDocs = subdocs\n                           , expItemFixities = fixities\n                           } = ppDocumentation dflags dc ++ f decl ++ ppFixities\n    where\n        f (TyClD d@DataDecl{})  = ppData dflags d subdocs\n        f (TyClD d@SynDecl{})   = ppSynonym dflags d\n        f (TyClD d@ClassDecl{}) = ppClass dflags d subdocs\n        f (TyClD (FamDecl d))   = ppFam dflags d\n        f (ForD (ForeignImport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]\n        f (ForD (ForeignExport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]\n        f (SigD sig) = ppSig dflags sig\n        f _ = []\n\n        ppFixities = concatMap (ppFixity dflags) fixities\nppExport _ _ = []\n\nppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]\nppSigWithDoc dflags (TypeSig names sig) subdocs\n    = concatMap mkDocSig names\n    where\n        mkDocSig n = mkSubdoc dflags n subdocs [pp_sig dflags [n] (hsSigWcType sig)]\n\nppSigWithDoc _ _ _ = []\n\nppSig :: DynFlags -> Sig GhcRn -> [String]\nppSig dflags x  = ppSigWithDoc dflags x []\n\npp_sig :: DynFlags -> [Located Name] -> LHsType GhcRn -> String\npp_sig dflags names (L _ typ)  =\n    operator prettyNames ++ \" :: \" ++ outHsType dflags typ\n    where\n      prettyNames = intercalate \", \" $ map (out dflags) names\n\n-- note: does not yet output documentation for class methods\nppClass :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]\nppClass dflags decl subdocs =\n  (out dflags decl{tcdSigs=[], tcdATs=[], tcdATDefs=[], tcdMeths=emptyLHsBinds}\n    ++ ppTyFams) :  ppMethods\n    where\n\n        ppMethods = concat . map (ppSig' . unLoc . add_ctxt) $ tcdSigs decl\n        ppSig' = flip (ppSigWithDoc dflags) subdocs\n\n        add_ctxt = addClassContext (tcdName decl) (tyClDeclTyVars decl)\n\n        ppTyFams\n            | null $ tcdATs decl = \"\"\n            | otherwise = (\" \" ++) . showSDocUnqual dflags . whereWrapper $ concat\n                [ map pprTyFam (tcdATs decl)\n                , map (ppr . tyFamEqnToSyn . unLoc) (tcdATDefs decl)\n                ]\n\n        pprTyFam :: LFamilyDecl GhcRn -> SDoc\n        pprTyFam (L _ at) = vcat' $ map text $\n            mkSubdoc dflags (fdLName at) subdocs (ppFam dflags at)\n\n        whereWrapper elems = vcat'\n            [ text \"where\" <+> lbrace\n            , nest 4 . vcat . map (Outputable.<> semi) $ elems\n            , rbrace\n            ]\n\n        tyFamEqnToSyn :: TyFamDefltEqn GhcRn -> TyClDecl GhcRn\n        tyFamEqnToSyn tfe = SynDecl\n            { tcdLName  = feqn_tycon tfe\n            , tcdTyVars = feqn_pats tfe\n            , tcdFixity = feqn_fixity tfe\n            , tcdRhs    = feqn_rhs tfe\n            , tcdFVs    = emptyNameSet\n            }\n\nppFam :: DynFlags -> FamilyDecl GhcRn -> [String]\nppFam dflags decl@(FamilyDecl { fdInfo = info })\n  = [out dflags decl']\n  where\n    decl' = case info of\n              -- We don't need to print out a closed type family's equations\n              -- for Hoogle, so pretend it doesn't have any.\n              ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily }\n              _                  -> decl\n\nppInstance :: DynFlags -> ClsInst -> [String]\nppInstance dflags x =\n  [dropComment $ outWith (showSDocForUser dflags alwaysQualify) cls]\n  where\n    -- As per #168, we don't want safety information about the class\n    -- in Hoogle output. The easiest way to achieve this is to set the\n    -- safety information to a state where the Outputable instance\n    -- produces no output which means no overlap and unsafe (or [safe]\n    -- is generated).\n    cls = x { is_flag = OverlapFlag { overlapMode = NoOverlap NoSourceText\n                                    , isSafeOverlap = False } }\n\nppSynonym :: DynFlags -> TyClDecl GhcRn -> [String]\nppSynonym dflags x = [out dflags x]\n\nppData :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]\nppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs\n    = showData decl{ tcdDataDefn = defn { dd_cons=[],dd_derivs=noLoc [] }} :\n      concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn)\n    where\n\n        -- GHC gives out \"data Bar =\", we want to delete the equals.\n        -- There's no need to worry about parenthesizing infix data type names,\n        -- since this Outputable instance for TyClDecl gets this right already.\n        showData d = unwords $ if last xs == \"=\" then init xs else xs\n            where\n                xs = words $ out dflags d\nppData _ _ _ = panic \"ppData\"\n\n-- | for constructors, and named-fields...\nlookupCon :: DynFlags -> [(Name, DocForDecl Name)] -> Located Name -> [String]\nlookupCon dflags subdocs (L _ name) = case lookup name subdocs of\n  Just (d, _) -> ppDocumentation dflags d\n  _ -> []\n\nppCtor :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String]\nppCtor dflags dat subdocs con@ConDeclH98 {}\n  -- AZ:TODO get rid of the concatMap\n   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConDetails con)\n    where\n        f (PrefixCon args) = [typeSig name $ args ++ [resType]]\n        f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]\n        f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat\n                          [(concatMap (lookupCon dflags subdocs . noLoc . selectorFieldOcc . unLoc) (cd_fld_names r)) ++\n                           [out dflags (map (selectorFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]\n                          | r <- map unLoc recs]\n\n        funs = foldr1 (\\x y -> reL $ HsFunTy x y)\n        apps = foldl1 (\\x y -> reL $ HsAppTy x y)\n\n        typeSig nm flds = operator nm ++ \" :: \" ++ outHsType dflags (unL $ funs flds)\n\n        -- We print the constructors as comma-separated list. See GHC\n        -- docs for con_names on why it is a list to begin with.\n        name = commaSeparate dflags . map unL $ getConNames con\n\n        resType = apps $ map (reL . HsTyVar NotPromoted . reL) $\n                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]\n\nppCtor dflags _dat subdocs con@ConDeclGADT {}\n   = concatMap (lookupCon dflags subdocs) (getConNames con) ++ f\n    where\n        f = [typeSig name (hsib_body $ con_type con)]\n\n        typeSig nm ty = operator nm ++ \" :: \" ++ outHsType dflags (unL ty)\n        name = out dflags $ map unL $ getConNames con\n\n\nppFixity :: DynFlags -> (Name, Fixity) -> [String]\nppFixity dflags (name, fixity) = [out dflags ((FixitySig [noLoc name] fixity) :: FixitySig GhcRn)]\n\n\n---------------------------------------------------------------------\n-- DOCUMENTATION\n\nppDocumentation :: Outputable o => DynFlags -> Documentation o -> [String]\nppDocumentation dflags (Documentation d w) = mdoc dflags d ++ doc dflags w\n\n\ndoc :: Outputable o => DynFlags -> Maybe (Doc o) -> [String]\ndoc dflags = docWith dflags \"\"\n\nmdoc :: Outputable o => DynFlags -> Maybe (MDoc o) -> [String]\nmdoc dflags = docWith dflags \"\" . fmap _doc\n\ndocWith :: Outputable o => DynFlags -> String -> Maybe (Doc o) -> [String]\ndocWith _ [] Nothing = []\ndocWith dflags header d\n  = (\"\":) $ zipWith (++) (\"-- | \" : repeat \"--   \") $\n    lines header ++ [\"\" | header /= \"\" && isJust d] ++\n    maybe [] (showTags . markup (markupTag dflags)) d\n\nmkSubdoc :: DynFlags -> Located Name -> [(Name, DocForDecl Name)] -> [String] -> [String]\nmkSubdoc dflags n subdocs s = concatMap (ppDocumentation dflags) getDoc ++ s\n where\n   getDoc = maybe [] (return . fst) (lookup (unL n) subdocs)\n\ndata Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags | Str String\n           deriving Show\n\ntype Tags = [Tag]\n\nbox :: (a -> b) -> a -> [b]\nbox f x = [f x]\n\nstr :: String -> [Tag]\nstr a = [Str a]\n\n-- want things like paragraph, pre etc to be handled by blank lines in the source document\n-- and things like \\n and \\t converted away\n-- much like blogger in HTML mode\n-- everything else wants to be included as tags, neatly nested for some (ul,li,ol)\n-- or inlne for others (a,i,tt)\n-- entities (&,>,<) should always be appropriately escaped\n\nmarkupTag :: Outputable o => DynFlags -> DocMarkup o [Tag]\nmarkupTag dflags = Markup {\n  markupParagraph            = box TagP,\n  markupEmpty                = str \"\",\n  markupString               = str,\n  markupAppend               = (++),\n  markupIdentifier           = box (TagInline \"a\") . str . out dflags,\n  markupIdentifierUnchecked  = box (TagInline \"a\") . str . out dflags . snd,\n  markupModule               = box (TagInline \"a\") . str,\n  markupWarning              = box (TagInline \"i\"),\n  markupEmphasis             = box (TagInline \"i\"),\n  markupBold                 = box (TagInline \"b\"),\n  markupMonospaced           = box (TagInline \"tt\"),\n  markupPic                  = const $ str \" \",\n  markupMathInline           = const $ str \"<math>\",\n  markupMathDisplay          = const $ str \"<math>\",\n  markupUnorderedList        = box (TagL 'u'),\n  markupOrderedList          = box (TagL 'o'),\n  markupDefList              = box (TagL 'u') . map (\\(a,b) -> TagInline \"i\" a : Str \" \" : b),\n  markupCodeBlock            = box TagPre,\n  markupHyperlink            = \\(Hyperlink url mLabel) -> (box (TagInline \"a\") . str) (fromMaybe url mLabel),\n  markupAName                = const $ str \"\",\n  markupProperty             = box TagPre . str,\n  markupExample              = box TagPre . str . unlines . map exampleToString,\n  markupHeader               = \\(Header l h) -> box (TagInline $ \"h\" ++ show l) h,\n  markupTable                = \\(Table _ _) -> str \"TODO: table\"\n  }\n\n\nshowTags :: [Tag] -> [String]\nshowTags = intercalate [\"\"] . map showBlock\n\n\nshowBlock :: Tag -> [String]\nshowBlock (TagP xs) = showInline xs\nshowBlock (TagL t xs) = ['<':t:\"l>\"] ++ mid ++ ['<':'/':t:\"l>\"]\n    where mid = concatMap (showInline . box (TagInline \"li\")) xs\nshowBlock (TagPre xs) = [\"<pre>\"] ++ showPre xs ++ [\"</pre>\"]\nshowBlock x = showInline [x]\n\n\nasInline :: Tag -> Tags\nasInline (TagP xs) = xs\nasInline (TagPre xs) = [TagInline \"pre\" xs]\nasInline (TagL t xs) = [TagInline (t:\"l\") $ map (TagInline \"li\") xs]\nasInline x = [x]\n\n\nshowInline :: [Tag] -> [String]\nshowInline = unwordsWrap 70 . words . concatMap f\n    where\n        fs = concatMap f\n        f (Str x) = escape x\n        f (TagInline s xs) = \"<\"++s++\">\" ++ (if s == \"li\" then trim else id) (fs xs) ++ \"</\"++s++\">\"\n        f x = fs $ asInline x\n\n        trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse\n\n\nshowPre :: [Tag] -> [String]\nshowPre = trimFront . trimLines . lines . concatMap f\n    where\n        trimLines = dropWhile null . reverse . dropWhile null . reverse\n        trimFront xs = map (drop i) xs\n            where\n                ns = [length a | x <- xs, let (a,b) = span isSpace x, b /= \"\"]\n                i = if null ns then 0 else minimum ns\n\n        fs = concatMap f\n        f (Str x) = escape x\n        f (TagInline s xs) = \"<\"++s++\">\" ++ fs xs ++ \"</\"++s++\">\"\n        f x = fs $ asInline x\n\n\nunwordsWrap :: Int -> [String] -> [String]\nunwordsWrap n = f n []\n    where\n        f _ s [] = [g s | s /= []]\n        f i s (x:xs) | nx > i = g s : f (n - nx - 1) [x] xs\n                     | otherwise = f (i - nx - 1) (x:s) xs\n            where nx = length x\n\n        g = unwords . reverse\n\n\nescape :: String -> String\nescape = concatMap f\n    where\n        f '<' = \"&lt;\"\n        f '>' = \"&gt;\"\n        f '&' = \"&amp;\"\n        f x = [x]\n\n\n-- | Just like 'vcat' but uses '($+$)' instead of '($$)'.\nvcat' :: [SDoc] -> SDoc\nvcat' = foldr ($+$) empty\n", "num_lines": 419}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Haddock.Backends.Hyperlinker\n    ( ppHyperlinkedSource\n    , module Haddock.Backends.Hyperlinker.Types\n    , module Haddock.Backends.Hyperlinker.Utils\n    ) where\n\n\nimport Haddock.Types\nimport Haddock.Backends.Hyperlinker.Renderer\nimport Haddock.Backends.Hyperlinker.Types\nimport Haddock.Backends.Hyperlinker.Utils\n\nimport Text.XHtml hiding ((</>))\n\nimport Data.Maybe\nimport System.Directory\nimport System.FilePath\n\n\n-- | Generate hyperlinked source for given interfaces.\n--\n-- Note that list of interfaces should also contain interfaces normally hidden\n-- when generating documentation. Otherwise this could lead to dead links in\n-- produced source.\nppHyperlinkedSource :: FilePath -- ^ Output directory\n                    -> FilePath -- ^ Resource directory\n                    -> Maybe FilePath -- ^ Custom CSS file path\n                    -> Bool -- ^ Flag indicating whether to pretty-print HTML\n                    -> SrcMap -- ^ Paths to sources\n                    -> [Interface] -- ^ Interfaces for which we create source\n                    -> IO ()\nppHyperlinkedSource outdir libdir mstyle pretty srcs ifaces = do\n    createDirectoryIfMissing True srcdir\n    let cssFile = fromMaybe (defaultCssFile libdir) mstyle\n    copyFile cssFile $ srcdir </> srcCssFile\n    copyFile (libdir </> \"html\" </> highlightScript) $\n        srcdir </> highlightScript\n    mapM_ (ppHyperlinkedModuleSource srcdir pretty srcs) ifaces\n  where\n    srcdir = outdir </> hypSrcDir\n\n-- | Generate hyperlinked source for particular interface.\nppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMap -> Interface\n                          -> IO ()\nppHyperlinkedModuleSource srcdir pretty srcs iface =\n    case ifaceTokenizedSrc iface of\n        Just tokens -> writeFile path . html . render' $ tokens\n        Nothing -> return ()\n  where\n    render' = render (Just srcCssFile) (Just highlightScript) srcs\n    html = if pretty then renderHtml else showHtml\n    path = srcdir </> hypSrcModuleFile (ifaceMod iface)\n\n-- | Name of CSS file in output directory.\nsrcCssFile :: FilePath\nsrcCssFile = \"style.css\"\n\n-- | Name of highlight script in output and resource directory.\nhighlightScript :: FilePath\nhighlightScript = \"highlight.js\"\n\n-- | Path to default CSS file.\ndefaultCssFile :: FilePath -> FilePath\ndefaultCssFile libdir = libdir </> \"html\" </> \"solarized.css\"\n", "num_lines": 65}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n{-# LANGUAGE RecordWildCards #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.LaTeX\n-- Copyright   :  (c) Simon Marlow      2010,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.LaTeX (\n  ppLaTeX\n) where\n\n\nimport Documentation.Haddock.Markup\nimport Haddock.Types\nimport Haddock.Utils\nimport Haddock.GhcUtils\nimport Pretty hiding (Doc, quote)\nimport qualified Pretty\n\nimport GHC\nimport OccName\nimport Name                 ( nameOccName )\nimport RdrName              ( rdrNameOcc )\nimport FastString           ( unpackFS, unpackLitString, zString )\nimport Outputable           ( panic)\n\nimport qualified Data.Map as Map\nimport System.Directory\nimport System.FilePath\nimport Data.Char\nimport Control.Monad\nimport Data.Maybe\nimport Data.List\nimport Prelude hiding ((<>))\n\nimport Haddock.Doc (combineDocumentation)\n\n-- import Debug.Trace\n\n{- SAMPLE OUTPUT\n\n\\haddockmoduleheading{\\texttt{Data.List}}\n\\hrulefill\n{\\haddockverb\\begin{verbatim}\nmodule Data.List (\n    (++),  head,  last,  tail,  init,  null,  length,  map,  reverse,\n  ) where\\end{verbatim}}\n\\hrulefill\n\n\\section{Basic functions}\n\\begin{haddockdesc}\n\\item[\\begin{tabular}{@{}l}\nhead\\ ::\\ {\\char 91}a{\\char 93}\\ ->\\ a\n\\end{tabular}]\\haddockbegindoc\nExtract the first element of a list, which must be non-empty.\n\\par\n\n\\end{haddockdesc}\n\\begin{haddockdesc}\n\\item[\\begin{tabular}{@{}l}\nlast\\ ::\\ {\\char 91}a{\\char 93}\\ ->\\ a\n\\end{tabular}]\\haddockbegindoc\nExtract the last element of a list, which must be finite and non-empty.\n\\par\n\n\\end{haddockdesc}\n-}\n\n\n{- TODO\n * don't forget fixity!!\n-}\n\nppLaTeX :: String                       -- Title\n        -> Maybe String                 -- Package name\n        -> [Interface]\n        -> FilePath                     -- destination directory\n        -> Maybe (Doc GHC.RdrName)      -- prologue text, maybe\n        -> Maybe String                 -- style file\n        -> FilePath\n        -> IO ()\n\nppLaTeX title packageStr visible_ifaces odir prologue maybe_style libdir\n = do\n   createDirectoryIfMissing True odir\n   when (isNothing maybe_style) $\n     copyFile (libdir </> \"latex\" </> haddockSty) (odir </> haddockSty)\n   ppLaTeXTop title packageStr odir prologue maybe_style visible_ifaces\n   mapM_ (ppLaTeXModule title odir) visible_ifaces\n\n\nhaddockSty :: FilePath\nhaddockSty = \"haddock.sty\"\n\n\ntype LaTeX = Pretty.Doc\n\n\nppLaTeXTop\n   :: String\n   -> Maybe String\n   -> FilePath\n   -> Maybe (Doc GHC.RdrName)\n   -> Maybe String\n   -> [Interface]\n   -> IO ()\n\nppLaTeXTop doctitle packageStr odir prologue maybe_style ifaces = do\n\n  let tex = vcat [\n        text \"\\\\documentclass{book}\",\n        text \"\\\\usepackage\" <> braces (maybe (text \"haddock\") text maybe_style),\n        text \"\\\\begin{document}\",\n        text \"\\\\begin{titlepage}\",\n        text \"\\\\begin{haddocktitle}\",\n        text doctitle,\n        text \"\\\\end{haddocktitle}\",\n        case prologue of\n           Nothing -> empty\n           Just d  -> vcat [text \"\\\\begin{haddockprologue}\",\n                            rdrDocToLaTeX d,\n                            text \"\\\\end{haddockprologue}\"],\n        text \"\\\\end{titlepage}\",\n        text \"\\\\tableofcontents\",\n        vcat [ text \"\\\\input\" <> braces (text mdl) | mdl <- mods ],\n        text \"\\\\end{document}\"\n        ]\n\n      mods = sort (map (moduleBasename.ifaceMod) ifaces)\n\n      filename = odir </> (fromMaybe \"haddock\" packageStr <.> \"tex\")\n\n  writeFile filename (show tex)\n\n\nppLaTeXModule :: String -> FilePath -> Interface -> IO ()\nppLaTeXModule _title odir iface = do\n  createDirectoryIfMissing True odir\n  let\n      mdl = ifaceMod iface\n      mdl_str = moduleString mdl\n\n      exports = ifaceRnExportItems iface\n\n      tex = vcat [\n        text \"\\\\haddockmoduleheading\" <> braces (text mdl_str),\n        text \"\\\\label{module:\" <> text mdl_str <> char '}',\n        text \"\\\\haddockbeginheader\",\n        verb $ vcat [\n           text \"module\" <+> text mdl_str <+> lparen,\n           text \"    \" <> fsep (punctuate (text \", \") $\n                               map exportListItem $\n                               filter forSummary exports),\n           text \"  ) where\"\n         ],\n        text \"\\\\haddockendheader\" $$ text \"\",\n        description,\n        body\n       ]\n\n      description\n          = (fromMaybe empty . documentationToLaTeX . ifaceRnDoc) iface\n\n      body = processExports exports\n  --\n  writeFile (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 string_txt \"\" tex)\n\n\nstring_txt :: TextDetails -> String -> String\nstring_txt (Chr c)   s  = c:s\nstring_txt (Str s1)  s2 = s1 ++ s2\nstring_txt (PStr s1) s2 = unpackFS s1 ++ s2\nstring_txt (ZStr s1) s2 = zString s1 ++ s2\nstring_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2\n\n\nexportListItem :: ExportItem DocNameI -> LaTeX\nexportListItem ExportDecl { expItemDecl = decl, expItemSubDocs = subdocs }\n  = sep (punctuate comma . map ppDocBinder $ declNames decl) <>\n     case subdocs of\n       [] -> empty\n       _  -> parens (sep (punctuate comma (map (ppDocBinder . fst) subdocs)))\nexportListItem (ExportNoDecl y [])\n  = ppDocBinder y\nexportListItem (ExportNoDecl y subs)\n  = ppDocBinder y <> parens (sep (punctuate comma (map ppDocBinder subs)))\nexportListItem (ExportModule mdl)\n  = text \"module\" <+> text (moduleString mdl)\nexportListItem _\n  = error \"exportListItem\"\n\n\n-- Deal with a group of undocumented exports together, to avoid lots\n-- of blank vertical space between them.\nprocessExports :: [ExportItem DocNameI] -> LaTeX\nprocessExports [] = empty\nprocessExports (decl : es)\n  | Just sig <- isSimpleSig decl\n  = multiDecl [ ppTypeSig (map getName names) typ False\n              | (names,typ) <- sig:sigs ] $$\n    processExports es'\n  where (sigs, es') = spanWith isSimpleSig es\nprocessExports (ExportModule mdl : es)\n  = declWithDoc (vcat [ text \"module\" <+> text (moduleString m) | m <- mdl:mdls ]) Nothing $$\n    processExports es'\n  where (mdls, es') = spanWith isExportModule es\nprocessExports (e : es) =\n  processExport e $$ processExports es\n\n\nisSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)\nisSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames t))\n                       , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }\n  | Map.null argDocs = Just (map unLoc lnames, unLoc (hsSigWcType t))\nisSimpleSig _ = Nothing\n\n\nisExportModule :: ExportItem DocNameI -> Maybe Module\nisExportModule (ExportModule m) = Just m\nisExportModule _ = Nothing\n\n\nprocessExport :: ExportItem DocNameI -> LaTeX\nprocessExport (ExportGroup lev _id0 doc)\n  = ppDocGroup lev (docToLaTeX doc)\nprocessExport (ExportDecl decl pats doc subdocs insts fixities _splice)\n  = ppDecl decl pats doc insts subdocs fixities\nprocessExport (ExportNoDecl y [])\n  = ppDocName y\nprocessExport (ExportNoDecl y subs)\n  = ppDocName y <> parens (sep (punctuate comma (map ppDocName subs)))\nprocessExport (ExportModule mdl)\n  = declWithDoc (text \"module\" <+> text (moduleString mdl)) Nothing\nprocessExport (ExportDoc doc)\n  = docToLaTeX $ _doc doc\n\n\nppDocGroup :: Int -> LaTeX -> LaTeX\nppDocGroup lev doc = sec lev <> braces doc\n  where sec 1 = text \"\\\\section\"\n        sec 2 = text \"\\\\subsection\"\n        sec 3 = text \"\\\\subsubsection\"\n        sec _ = text \"\\\\paragraph\"\n\n\ndeclNames :: LHsDecl DocNameI -> [DocName]\ndeclNames (L _ decl) = case decl of\n  TyClD d  -> [tcdName d]\n  SigD (TypeSig lnames _ ) -> map unLoc lnames\n  SigD (PatSynSig lnames _) -> map unLoc lnames\n  ForD (ForeignImport (L _ n) _ _ _) -> [n]\n  ForD (ForeignExport (L _ n) _ _ _) -> [n]\n  _ -> error \"declaration not supported by declNames\"\n\n\nforSummary :: (ExportItem DocNameI) -> Bool\nforSummary (ExportGroup _ _ _) = False\nforSummary (ExportDoc _)       = False\nforSummary _                    = True\n\n\nmoduleLaTeXFile :: Module -> FilePath\nmoduleLaTeXFile mdl = moduleBasename mdl ++ \".tex\"\n\n\nmoduleBasename :: Module -> FilePath\nmoduleBasename mdl = map (\\c -> if c == '.' then '-' else c)\n                         (moduleNameString (moduleName mdl))\n\n\n-------------------------------------------------------------------------------\n-- * Decls\n-------------------------------------------------------------------------------\n\n\nppDecl :: LHsDecl DocNameI\n       -> [(HsDecl DocNameI, DocForDecl DocName)]\n       -> DocForDecl DocName\n       -> [DocInstance DocNameI]\n       -> [(DocName, DocForDecl DocName)]\n       -> [(DocName, Fixity)]\n       -> LaTeX\n\nppDecl (L loc decl) pats (doc, fnArgsDoc) instances subdocs _fixities = case decl of\n  TyClD d@(FamDecl {})          -> ppTyFam False loc doc d unicode\n  TyClD d@(DataDecl {})\n                                -> ppDataDecl pats instances subdocs loc (Just doc) d unicode\n  TyClD d@(SynDecl {})          -> ppTySyn loc (doc, fnArgsDoc) d unicode\n-- Family instances happen via FamInst now\n--  TyClD d@(TySynonym {})\n--    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode\n-- Family instances happen via FamInst now\n  TyClD d@(ClassDecl {})    -> ppClassDecl instances loc doc subdocs d unicode\n  SigD (TypeSig lnames t)   -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames)\n                                        (hsSigWcType t) unicode\n  SigD (PatSynSig lnames ty) ->\n      ppLPatSig loc (doc, fnArgsDoc) (map unLoc lnames) ty unicode\n  ForD d                         -> ppFor loc (doc, fnArgsDoc) d unicode\n  InstD _                        -> empty\n  DerivD _                       -> empty\n  _                              -> error \"declaration not supported by ppDecl\"\n  where\n    unicode = False\n\n\nppTyFam :: Bool -> SrcSpan -> Documentation DocName ->\n              TyClDecl DocNameI -> Bool -> LaTeX\nppTyFam _ _ _ _ _ =\n  error \"type family declarations are currently not supported by --latex\"\n\n\nppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX\nppFor loc doc (ForeignImport (L _ name) typ _ _) unicode =\n  ppFunSig loc doc [name] (hsSigType typ) unicode\nppFor _ _ _ _ = error \"ppFor error in Haddock.Backends.LaTeX\"\n--  error \"foreign declarations are currently not supported by --latex\"\n\n\n-------------------------------------------------------------------------------\n-- * Type Synonyms\n-------------------------------------------------------------------------------\n\n\n-- we skip type patterns for now\nppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX\n\nppTySyn loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars\n                         , tcdRhs = ltype }) unicode\n  = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode\n  where\n    hdr  = hsep (keyword \"type\"\n                 : ppDocBinder name\n                 : map ppSymName (tyvarNames ltyvars))\n    full = hdr <+> char '=' <+> ppLType unicode ltype\n\nppTySyn _ _ _ _ = error \"declaration not supported by ppTySyn\"\n\n\n-------------------------------------------------------------------------------\n-- * Function signatures\n-------------------------------------------------------------------------------\n\n\nppFunSig :: SrcSpan -> DocForDecl DocName -> [DocName] -> LHsType DocNameI\n         -> Bool -> LaTeX\nppFunSig loc doc docnames (L _ typ) unicode =\n  ppTypeOrFunSig loc docnames typ doc\n    ( ppTypeSig names typ False\n    , hsep . punctuate comma $ map ppSymName names\n    , dcolon unicode)\n    unicode\n where\n   names = map getName docnames\n\nppLPatSig :: SrcSpan -> DocForDecl DocName -> [DocName]\n          -> LHsSigType DocNameI\n          -> Bool -> LaTeX\nppLPatSig _loc (doc, _argDocs) docnames ty unicode\n  = declWithDoc pref1 (documentationToLaTeX doc)\n  where\n    pref1 = hsep [ keyword \"pattern\"\n                 , hsep $ punctuate comma $ map ppDocBinder docnames\n                 , dcolon unicode\n                 , ppLType unicode (hsSigType ty)\n                 ]\n\nppTypeOrFunSig :: SrcSpan -> [DocName] -> HsType DocNameI\n               -> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX)\n               -> Bool -> LaTeX\nppTypeOrFunSig _ _ typ (doc, argDocs) (pref1, pref2, sep0)\n               unicode\n  | Map.null argDocs =\n      declWithDoc pref1 (documentationToLaTeX doc)\n  | otherwise        =\n      declWithDoc pref2 $ Just $\n        text \"\\\\haddockbeginargs\" $$\n        do_args 0 sep0 typ $$\n        text \"\\\\end{tabulary}\\\\par\" $$\n        fromMaybe empty (documentationToLaTeX doc)\n  where\n     do_largs n leader (L _ t) = do_args n leader t\n\n     arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs\n\n     do_args :: Int -> LaTeX -> HsType DocNameI -> LaTeX\n     do_args _n leader (HsForAllTy tvs ltype)\n       = decltt leader\n         <-> decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]))\n         <+> ppLType unicode ltype\n     do_args n leader (HsQualTy lctxt ltype)\n       = decltt leader\n         <-> ppLContextNoArrow lctxt unicode <+> nl $$\n             do_largs n (darrow unicode) ltype\n     do_args n leader (HsFunTy lt r)\n       = decltt leader <-> decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl $$\n         do_largs (n+1) (arrow unicode) r\n     do_args n leader t\n       = decltt leader <-> decltt (ppType unicode t) <-> arg_doc n <+> nl\n\n\nppTypeSig :: [Name] -> HsType DocNameI  -> Bool -> LaTeX\nppTypeSig nms ty unicode =\n  hsep (punctuate comma $ map ppSymName nms)\n    <+> dcolon unicode\n    <+> ppType unicode ty\n\n\nppTyVars :: [LHsTyVarBndr DocNameI] -> [LaTeX]\nppTyVars = map (ppSymName . getName . hsLTyVarName)\n\n\ntyvarNames :: LHsQTyVars DocNameI -> [Name]\ntyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit\n\n\ndeclWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX\ndeclWithDoc decl doc =\n   text \"\\\\begin{haddockdesc}\" $$\n   text \"\\\\item[\\\\begin{tabular}{@{}l}\" $$\n   text (latexMonoFilter (show decl)) $$\n   text \"\\\\end{tabular}]\" <>\n       (if isNothing doc then empty else text \"\\\\haddockbegindoc\") $$\n   maybe empty id doc $$\n   text \"\\\\end{haddockdesc}\"\n\n\n-- in a group of decls, we don't put them all in the same tabular,\n-- because that would prevent the group being broken over a page\n-- boundary (breaks Foreign.C.Error for example).\nmultiDecl :: [LaTeX] -> LaTeX\nmultiDecl decls =\n   text \"\\\\begin{haddockdesc}\" $$\n   vcat [\n      text \"\\\\item[\" $$\n      text (latexMonoFilter (show decl)) $$\n      text \"]\"\n      | decl <- decls ] $$\n   text \"\\\\end{haddockdesc}\"\n\n\n-------------------------------------------------------------------------------\n-- * Rendering Doc\n-------------------------------------------------------------------------------\n\n\nmaybeDoc :: Maybe (Doc DocName) -> LaTeX\nmaybeDoc = maybe empty docToLaTeX\n\n\n-- for table cells, we strip paragraphs out to avoid extra vertical space\n-- and don't add a quote environment.\nrDoc  :: Maybe (Doc DocName) -> LaTeX\nrDoc = maybeDoc . fmap latexStripTrailingWhitespace\n\n\n-------------------------------------------------------------------------------\n-- * Class declarations\n-------------------------------------------------------------------------------\n\n\nppClassHdr :: Bool -> Located [LHsType DocNameI] -> DocName\n           -> LHsQTyVars DocNameI -> [Located ([Located DocName], [Located DocName])]\n           -> Bool -> LaTeX\nppClassHdr summ lctxt n tvs fds unicode =\n  keyword \"class\"\n  <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode else empty)\n  <+> ppAppDocNameNames summ n (tyvarNames tvs)\n  <+> ppFds fds unicode\n\n\nppFds :: [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX\nppFds fds unicode =\n  if null fds then empty else\n    char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))\n  where\n    fundep (vars1,vars2) = hsep (map (ppDocName . unLoc) vars1) <+> arrow unicode <+>\n                           hsep (map (ppDocName . unLoc) vars2)\n\n\nppClassDecl :: [DocInstance DocNameI] -> SrcSpan\n            -> Documentation DocName -> [(DocName, DocForDecl DocName)]\n            -> TyClDecl DocNameI -> Bool -> LaTeX\nppClassDecl instances loc doc subdocs\n  (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars, tcdFDs = lfds\n             , tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs }) unicode\n  = declWithDoc classheader (if null body then Nothing else Just (vcat body)) $$\n    instancesBit\n  where\n    classheader\n      | null lsigs = hdr unicode\n      | otherwise  = hdr unicode <+> keyword \"where\"\n\n    hdr = ppClassHdr False lctxt (unLoc lname) ltyvars lfds\n\n    body = catMaybes [documentationToLaTeX doc, body_]\n\n    body_\n      | null lsigs, null ats, null at_defs = Nothing\n      | null ats, null at_defs = Just methodTable\n---     | otherwise = atTable $$ methodTable\n      | otherwise = error \"LaTeX.ppClassDecl\"\n\n    methodTable =\n      text \"\\\\haddockpremethods{}\\\\textbf{Methods}\" $$\n      vcat  [ ppFunSig loc doc [name] (hsSigWcType typ) unicode\n            | L _ (TypeSig lnames typ) <- lsigs\n            , name <- map unLoc lnames\n            , let doc = lookupAnySubdoc name subdocs\n            ]\n\n    instancesBit = ppDocInstances unicode instances\n\nppClassDecl _ _ _ _ _ _ = error \"declaration type not supported by ppShortClassDecl\"\n\nppDocInstances :: Bool -> [DocInstance DocNameI] -> LaTeX\nppDocInstances _unicode [] = empty\nppDocInstances unicode (i : rest)\n  | Just ihead <- isUndocdInstance i\n  = declWithDoc (vcat (map (ppInstDecl unicode) (ihead:is))) Nothing $$\n    ppDocInstances unicode rest'\n  | otherwise\n  = ppDocInstance unicode i $$ ppDocInstances unicode rest\n  where\n    (is, rest') = spanWith isUndocdInstance rest\n\nisUndocdInstance :: DocInstance a -> Maybe (InstHead a)\nisUndocdInstance (i,Nothing,_,_) = Just i\nisUndocdInstance _ = Nothing\n\n-- | Print a possibly commented instance. The instance header is printed inside\n-- an 'argBox'. The comment is printed to the right of the box in normal comment\n-- style.\nppDocInstance :: Bool -> DocInstance DocNameI -> LaTeX\nppDocInstance unicode (instHead, doc, _, _) =\n  declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc)\n\n\nppInstDecl :: Bool -> InstHead DocNameI -> LaTeX\nppInstDecl unicode instHead = keyword \"instance\" <+> ppInstHead unicode instHead\n\n\nppInstHead :: Bool -> InstHead DocNameI -> LaTeX\nppInstHead unicode (InstHead {..}) = case ihdInstType of\n    ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ\n    TypeInst rhs -> keyword \"type\" <+> typ <+> tibody rhs\n    DataInst _ -> error \"data instances not supported by --latex yet\"\n  where\n    typ = ppAppNameTypes ihdClsName ihdTypes unicode\n    tibody = maybe empty (\\t -> equals <+> ppType unicode t)\n\nlookupAnySubdoc :: (Eq name1) =>\n                   name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2\nlookupAnySubdoc n subdocs = case lookup n subdocs of\n  Nothing -> noDocForDecl\n  Just docs -> docs\n\n\n-------------------------------------------------------------------------------\n-- * Data & newtype declarations\n-------------------------------------------------------------------------------\n\n\nppDataDecl :: [(HsDecl DocNameI, DocForDecl DocName)] -> [DocInstance DocNameI] ->\n              [(DocName, DocForDecl DocName)] -> SrcSpan ->\n              Maybe (Documentation DocName) -> TyClDecl DocNameI -> Bool ->\n              LaTeX\nppDataDecl pats instances subdocs _loc doc dataDecl unicode\n\n   =  declWithDoc (ppDataHeader dataDecl unicode <+> whereBit)\n                  (if null body then Nothing else Just (vcat body))\n   $$ instancesBit\n\n  where\n    cons      = dd_cons (tcdDataDefn dataDecl)\n    resTy     = (unLoc . head) cons\n\n    body = catMaybes [constrBit,patternBit, doc >>= documentationToLaTeX]\n\n    (whereBit, leaders)\n      | null cons\n      , null pats = (empty,[])\n      | null cons = (decltt (keyword \"where\"), repeat empty)\n      | otherwise = case resTy of\n        ConDeclGADT{} -> (decltt (keyword \"where\"), repeat empty)\n        _             -> (empty, (decltt (text \"=\") : repeat (decltt (text \"|\"))))\n\n    constrBit\n      | null cons = Nothing\n      | otherwise = Just $\n          text \"\\\\haddockbeginconstrs\" $$\n          vcat (zipWith (ppSideBySideConstr subdocs unicode) leaders cons) $$\n          text \"\\\\end{tabulary}\\\\par\"\n\n    patternBit\n      | null cons = Nothing\n      | otherwise = Just $\n          text \"\\\\haddockbeginconstrs\" $$\n          vcat [ hsep [ keyword \"pattern\"\n                      , hsep $ punctuate comma $ map (ppDocBinder . unLoc) lnames\n                      , dcolon unicode\n                      , ppLType unicode (hsSigType ty)\n                      ] <-> rDoc (fmap _doc . combineDocumentation . fst $ d)\n               | (SigD (PatSynSig lnames ty),d) <- pats\n               ] $$\n          text \"\\\\end{tabulary}\\\\par\"\n\n    instancesBit = ppDocInstances unicode instances\n\n\n-- ppConstrHdr is for (non-GADT) existentials constructors' syntax\nppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Bool -> LaTeX\nppConstrHdr forall tvs ctxt unicode\n = (if null tvs then empty else ppForall)\n   <+>\n   (if null ctxt then empty else ppContextNoArrow ctxt unicode <+> darrow unicode <+> text \" \")\n  where\n    ppForall = case forall of\n      True  -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text \". \"\n      False -> empty\n\n\nppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX\n                   -> LConDecl DocNameI -> LaTeX\nppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =\n  leader <->\n  case con_details con of\n\n    PrefixCon args ->\n      decltt (hsep ((header_ unicode <+> ppOcc) :\n                 map (ppLParendType unicode) args))\n      <-> rDoc mbDoc <+> nl\n\n    RecCon (L _ fields) ->\n      (decltt (header_ unicode <+> ppOcc)\n        <-> rDoc mbDoc <+> nl)\n      $$\n      doRecordFields fields\n\n    InfixCon arg1 arg2 ->\n      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,\n                 ppOcc,\n                 ppLParendType unicode arg2 ])\n      <-> rDoc mbDoc <+> nl\n\n where\n    doRecordFields fields =\n        vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))\n\n\n    header_ = ppConstrHdr False tyVars context\n    occ     = map (nameOccName . getName . unLoc) $ getConNames con\n    ppOcc   = case occ of\n      [one] -> ppBinder one\n      _     -> cat (punctuate comma (map ppBinder occ))\n    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))\n    context = unLoc (fromMaybe (noLoc []) (con_cxt con))\n\n    -- don't use \"con_doc con\", in case it's reconstructed from a .hi file,\n    -- or also because we want Haddock to do the doc-parsing, not GHC.\n    mbDoc = case getConNames con of\n              [] -> panic \"empty con_names\"\n              (cn:_) -> lookup (unLoc cn) subdocs >>=\n                        fmap _doc . combineDocumentation . fst\n\nppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclGADT {})) =\n  leader <->\n  doGADTCon (hsib_body $ con_type con)\n\n where\n    doGADTCon resTy = decltt (ppOcc <+> dcolon unicode <+>\n                               ppLType unicode resTy\n                            ) <-> rDoc mbDoc\n\n    occ     = map (nameOccName . getName . unLoc) $ getConNames con\n    ppOcc   = case occ of\n      [one] -> ppBinder one\n      _     -> cat (punctuate comma (map ppBinder occ))\n\n    -- don't use \"con_doc con\", in case it's reconstructed from a .hi file,\n    -- or also because we want Haddock to do the doc-parsing, not GHC.\n    mbDoc = case getConNames con of\n              [] -> panic \"empty con_names\"\n              (cn:_) -> lookup (unLoc cn) subdocs >>=\n                        fmap _doc . combineDocumentation . fst\n{- old\n\nppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX\n                   -> LConDecl DocName -> LaTeX\nppSideBySideConstr subdocs unicode leader (L loc con) =\n  leader <->\n  case con_res con of\n  ResTyH98 -> case con_details con of\n\n    PrefixCon args ->\n      decltt (hsep ((header_ unicode <+> ppOcc) :\n                 map (ppLParendType unicode) args))\n      <-> rDoc mbDoc <+> nl\n\n    RecCon (L _ fields) ->\n      (decltt (header_ unicode <+> ppOcc)\n        <-> rDoc mbDoc <+> nl)\n      $$\n      doRecordFields fields\n\n    InfixCon arg1 arg2 ->\n      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,\n                 ppOcc,\n                 ppLParendType unicode arg2 ])\n      <-> rDoc mbDoc <+> nl\n\n  ResTyGADT _ resTy -> case con_details con of\n    -- prefix & infix could also use hsConDeclArgTys if it seemed to\n    -- simplify the code.\n    PrefixCon args -> doGADTCon args resTy\n    cd@(RecCon (L _ fields)) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$\n                                     doRecordFields fields\n    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy\n\n where\n    doRecordFields fields =\n        vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))\n\n    doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+>\n                               ppLType unicode (mk_forall $ mk_phi $\n                                                foldr mkFunTy resTy args)\n                            ) <-> rDoc mbDoc\n\n\n    header_ = ppConstrHdr (con_explicit con) tyVars context\n    occ     = map (nameOccName . getName . unLoc) $ con_names con\n    ppOcc   = case occ of\n      [one] -> ppBinder one\n      _     -> cat (punctuate comma (map ppBinder occ))\n    ltvs    = con_qvars con\n    tyVars  = tyvarNames (con_qvars con)\n    context = unLoc (con_cxt con)\n\n    mk_forall ty | con_explicit con = L loc (HsForAllTy (hsQTvExplicit ltvs) ty)\n                 | otherwise        = ty\n    mk_phi ty | null context = ty\n              | otherwise    = L loc (HsQualTy (con_cxt con) ty)\n\n    -- don't use \"con_doc con\", in case it's reconstructed from a .hi file,\n    -- or also because we want Haddock to do the doc-parsing, not GHC.\n    mbDoc = case con_names con of\n              [] -> panic \"empty con_names\"\n              (cn:_) -> lookup (unLoc cn) subdocs >>=\n                        fmap _doc . combineDocumentation . fst\n    mkFunTy a b = noLoc (HsFunTy a b)\n-}\n\nppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocNameI ->  LaTeX\nppSideBySideField subdocs unicode (ConDeclField names ltype _) =\n  decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))\n    <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc\n  where\n    -- don't use cd_fld_doc for same reason we don't use con_doc above\n    -- Where there is more than one name, they all have the same documentation\n    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst\n\n-- {-\n-- ppHsFullConstr :: HsConDecl -> LaTeX\n-- ppHsFullConstr (HsConDecl _ nm tvs ctxt typeList doc) =\n--      declWithDoc False doc (\n-- \thsep ((ppHsConstrHdr tvs ctxt +++\n-- \t\tppHsBinder False nm) : map ppHsBangType typeList)\n--       )\n-- ppHsFullConstr (HsRecDecl _ nm tvs ctxt fields doc) =\n--    td << vanillaTable << (\n--      case doc of\n--        Nothing -> aboves [hdr, fields_html]\n--        Just _  -> aboves [hdr, constr_doc, fields_html]\n--    )\n--\n--   where hdr = declBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm)\n--\n-- \tconstr_doc\n-- \t  | isJust doc = docBox (docToLaTeX (fromJust doc))\n-- \t  | otherwise  = LaTeX.emptyTable\n--\n-- \tfields_html =\n-- \t   td <<\n-- \t      table ! [width \"100%\", cellpadding 0, cellspacing 8] << (\n-- \t\t   aboves (map ppFullField (concat (map expandField fields)))\n-- \t\t)\n-- -}\n--\n-- ppShortField :: Bool -> Bool -> ConDeclField DocName -> LaTeX\n-- ppShortField summary unicode (ConDeclField (L _ name) ltype _)\n--   = tda [theclass \"recfield\"] << (\n--       ppBinder summary (docNameOcc name)\n--       <+> dcolon unicode <+> ppLType unicode ltype\n--     )\n--\n-- {-\n-- ppFullField :: HsFieldDecl -> LaTeX\n-- ppFullField (HsFieldDecl [n] ty doc)\n--   = declWithDoc False doc (\n-- \tppHsBinder False n <+> dcolon <+> ppHsBangType ty\n--     )\n-- ppFullField _ = error \"ppFullField\"\n--\n-- expandField :: HsFieldDecl -> [HsFieldDecl]\n-- expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ]\n-- -}\n\n\n-- | Print the LHS of a data\\/newtype declaration.\n-- Currently doesn't handle 'data instance' decls or kind signatures\nppDataHeader :: TyClDecl DocNameI -> Bool -> LaTeX\nppDataHeader (DataDecl { tcdLName = L _ name, tcdTyVars = tyvars\n                       , tcdDataDefn = HsDataDefn { dd_ND = nd, dd_ctxt = ctxt } }) unicode\n  = -- newtype or data\n    (case nd of { NewType -> keyword \"newtype\"; DataType -> keyword \"data\" }) <+>\n    -- context\n    ppLContext ctxt unicode <+>\n    -- T a b c ..., or a :+: b\n    ppAppDocNameNames False name (tyvarNames tyvars)\nppDataHeader _ _ = error \"ppDataHeader: illegal argument\"\n\n--------------------------------------------------------------------------------\n-- * Type applications\n--------------------------------------------------------------------------------\n\n\n-- | Print an application of a DocName to its list of HsTypes\nppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> LaTeX\nppAppNameTypes n ts unicode = ppTypeApp n ts ppDocName (ppParendType unicode)\n\n\n-- | Print an application of a DocName and a list of Names\nppAppDocNameNames :: Bool -> DocName -> [Name] -> LaTeX\nppAppDocNameNames _summ n ns =\n  ppTypeApp n ns (ppBinder . nameOccName . getName) ppSymName\n\n\n-- | General printing of type applications\nppTypeApp :: DocName -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX\nppTypeApp n (t1:t2:rest) ppDN ppT\n  | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)\n  | operator                    = opApp\n  where\n    operator = isNameSym . getName $ n\n    opApp = ppT t1 <+> ppDN n <+> ppT t2\n\nppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts)\n\n\n-------------------------------------------------------------------------------\n-- * Contexts\n-------------------------------------------------------------------------------\n\n\nppLContext, ppLContextNoArrow :: Located (HsContext DocNameI) -> Bool -> LaTeX\nppLContext        = ppContext        . unLoc\nppLContextNoArrow = ppContextNoArrow . unLoc\n\nppContextNoLocsMaybe :: [HsType DocNameI] -> Bool -> Maybe LaTeX\nppContextNoLocsMaybe [] _ = Nothing\nppContextNoLocsMaybe cxt unicode = Just $ pp_hs_context cxt unicode\n\nppContextNoArrow :: HsContext DocNameI -> Bool -> LaTeX\nppContextNoArrow cxt unicode = fromMaybe empty $\n                               ppContextNoLocsMaybe (map unLoc cxt) unicode\n\n\nppContextNoLocs :: [HsType DocNameI] -> Bool -> LaTeX\nppContextNoLocs cxt unicode = maybe empty (<+> darrow unicode) $\n                              ppContextNoLocsMaybe cxt unicode\n\n\nppContext :: HsContext DocNameI -> Bool -> LaTeX\nppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode\n\n\npp_hs_context :: [HsType DocNameI] -> Bool -> LaTeX\npp_hs_context []  _       = empty\npp_hs_context [p] unicode = ppType unicode p\npp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)\n\n\n-------------------------------------------------------------------------------\n-- * Types and contexts\n-------------------------------------------------------------------------------\n\n\nppBang :: HsSrcBang -> LaTeX\nppBang (HsSrcBang _ _ SrcStrict) = char '!'\nppBang (HsSrcBang _ _ SrcLazy)   = char '~'\nppBang _                         = empty\n\n\ntupleParens :: HsTupleSort -> [LaTeX] -> LaTeX\ntupleParens HsUnboxedTuple = ubxParenList\ntupleParens _              = parenList\n\n\nsumParens :: [LaTeX] -> LaTeX\nsumParens = ubxparens . hsep . punctuate (text \" | \")\n\n\n-------------------------------------------------------------------------------\n-- * Rendering of HsType\n--\n-- Stolen from Html and tweaked for LaTeX generation\n-------------------------------------------------------------------------------\n\n\npREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int\n\npREC_TOP = (0 :: Int)   -- type in ParseIface.y in GHC\npREC_FUN = (1 :: Int)   -- btype in ParseIface.y in GHC\n                        -- Used for LH arg of (->)\npREC_OP  = (2 :: Int)   -- Used for arg of any infix operator\n                        -- (we don't keep their fixities around)\npREC_CON = (3 :: Int)   -- Used for arg of type applicn:\n                        -- always parenthesise unless atomic\n\nmaybeParen :: Int           -- Precedence of context\n           -> Int           -- Precedence of top-level operator\n           -> LaTeX -> LaTeX  -- Wrap in parens if (ctxt >= op)\nmaybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p\n                               | otherwise            = p\n\n\nppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocNameI) -> LaTeX\nppLType       unicode y = ppType unicode (unLoc y)\nppLParendType unicode y = ppParendType unicode (unLoc y)\nppLFunLhType  unicode y = ppFunLhType unicode (unLoc y)\n\n\nppType, ppParendType, ppFunLhType :: Bool -> HsType DocNameI -> LaTeX\nppType       unicode ty = ppr_mono_ty pREC_TOP ty unicode\nppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode\nppFunLhType  unicode ty = ppr_mono_ty pREC_FUN ty unicode\n\nppLKind :: Bool -> LHsKind DocNameI -> LaTeX\nppLKind unicode y = ppKind unicode (unLoc y)\n\nppKind :: Bool -> HsKind DocNameI -> LaTeX\nppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode\n\n\n-- Drop top-level for-all type variables in user style\n-- since they are implicit in Haskell\n\nppr_mono_lty :: Int -> LHsType DocNameI -> Bool -> LaTeX\nppr_mono_lty ctxt_prec ty unicode = ppr_mono_ty ctxt_prec (unLoc ty) unicode\n\n\nppr_mono_ty :: Int -> HsType DocNameI -> Bool -> LaTeX\nppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode\n  = maybeParen ctxt_prec pREC_FUN $\n    sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot\n        , ppr_mono_lty pREC_TOP ty unicode ]\nppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode\n  = maybeParen ctxt_prec pREC_FUN $\n    sep [ ppLContext ctxt unicode\n        , ppr_mono_lty pREC_TOP ty unicode ]\n\nppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty\nppr_mono_ty _         (HsTyVar NotPromoted (L _ name)) _ = ppDocName name\nppr_mono_ty _         (HsTyVar Promoted    (L _ name)) _ = char '\\'' <> ppDocName name\nppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u\nppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)\nppr_mono_ty _         (HsSumTy tys) u       = sumParens (map (ppLType u) tys)\nppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)\nppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)\nppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)\nppr_mono_ty _         (HsIParamTy (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)\nppr_mono_ty _         (HsSpliceTy {})     _ = error \"ppr_mono_ty HsSpliceTy\"\nppr_mono_ty _         (HsRecTy {})        _ = error \"ppr_mono_ty HsRecTy\"\nppr_mono_ty _         (HsCoreTy {})       _ = error \"ppr_mono_ty HsCoreTy\"\nppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys\nppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys\nppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys\n\nppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode\n  = maybeParen ctxt_prec pREC_OP $\n    ppr_mono_lty pREC_OP ty1 unicode <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode\n\nppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode\n  = maybeParen ctxt_prec pREC_CON $\n    hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]\n\nppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode\n  = maybeParen ctxt_prec pREC_FUN $\n    ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode\n  where\n    ppr_op = if not (isSymOcc occName) then char '`' <> ppLDocName op <> char '`' else ppLDocName op\n    occName = nameOccName . getName . unLoc $ op\n\nppr_mono_ty ctxt_prec (HsParTy ty) unicode\n--  = parens (ppr_mono_lty pREC_TOP ty)\n  = ppr_mono_lty ctxt_prec ty unicode\n\nppr_mono_ty ctxt_prec (HsDocTy ty _) unicode\n  = ppr_mono_lty ctxt_prec ty unicode\n\nppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'\n\nppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u\n\nppr_mono_ty _ (HsAppsTy {}) _ = panic \"ppr_mono_ty:HsAppsTy\"\n\n\nppr_tylit :: HsTyLit -> Bool -> LaTeX\nppr_tylit (HsNumTy _ n) _ = integer n\nppr_tylit (HsStrTy _ s) _ = text (show s)\n  -- XXX: Ok in verbatim, but not otherwise\n  -- XXX: Do something with Unicode parameter?\n\n\nppr_fun_ty :: Int -> LHsType DocNameI -> LHsType DocNameI -> Bool -> LaTeX\nppr_fun_ty ctxt_prec ty1 ty2 unicode\n  = let p1 = ppr_mono_lty pREC_FUN ty1 unicode\n        p2 = ppr_mono_lty pREC_TOP ty2 unicode\n    in\n    maybeParen ctxt_prec pREC_FUN $\n    sep [p1, arrow unicode <+> p2]\n\n\n-------------------------------------------------------------------------------\n-- * Names\n-------------------------------------------------------------------------------\n\n\nppBinder :: OccName -> LaTeX\nppBinder n\n  | isInfixName n = parens $ ppOccName n\n  | otherwise     = ppOccName n\n\nisInfixName :: OccName -> Bool\nisInfixName n = isVarSym n || isConSym n\n\nppSymName :: Name -> LaTeX\nppSymName name\n  | isNameSym name = parens $ ppName name\n  | otherwise = ppName name\n\n\nppVerbOccName :: OccName -> LaTeX\nppVerbOccName = text . latexFilter . occNameString\n\nppIPName :: HsIPName -> LaTeX\nppIPName ip = text $ unpackFS $ hsIPNameFS ip\n\nppOccName :: OccName -> LaTeX\nppOccName = text . occNameString\n\n\nppVerbDocName :: DocName -> LaTeX\nppVerbDocName = ppVerbOccName . nameOccName . getName\n\n\nppVerbRdrName :: RdrName -> LaTeX\nppVerbRdrName = ppVerbOccName . rdrNameOcc\n\n\nppDocName :: DocName -> LaTeX\nppDocName = ppOccName . nameOccName . getName\n\n\nppLDocName :: Located DocName -> LaTeX\nppLDocName (L _ d) = ppDocName d\n\n\nppDocBinder :: DocName -> LaTeX\nppDocBinder = ppBinder . nameOccName . getName\n\n\nppName :: Name -> LaTeX\nppName = ppOccName . nameOccName\n\n\nlatexFilter :: String -> String\nlatexFilter = foldr latexMunge \"\"\n\n\nlatexMonoFilter :: String -> String\nlatexMonoFilter = foldr latexMonoMunge \"\"\n\n\nlatexMunge :: Char -> String -> String\nlatexMunge '#'  s = \"{\\\\char '43}\" ++ s\nlatexMunge '$'  s = \"{\\\\char '44}\" ++ s\nlatexMunge '%'  s = \"{\\\\char '45}\" ++ s\nlatexMunge '&'  s = \"{\\\\char '46}\" ++ s\nlatexMunge '~'  s = \"{\\\\char '176}\" ++ s\nlatexMunge '_'  s = \"{\\\\char '137}\" ++ s\nlatexMunge '^'  s = \"{\\\\char '136}\" ++ s\nlatexMunge '\\\\' s = \"{\\\\char '134}\" ++ s\nlatexMunge '{'  s = \"{\\\\char '173}\" ++ s\nlatexMunge '}'  s = \"{\\\\char '175}\" ++ s\nlatexMunge '['  s = \"{\\\\char 91}\" ++ s\nlatexMunge ']'  s = \"{\\\\char 93}\" ++ s\nlatexMunge c    s = c : s\n\n\nlatexMonoMunge :: Char -> String -> String\nlatexMonoMunge ' ' s = '\\\\' : ' ' : s\nlatexMonoMunge '\\n' s = '\\\\' : '\\\\' : s\nlatexMonoMunge c   s = latexMunge c s\n\n\n-------------------------------------------------------------------------------\n-- * Doc Markup\n-------------------------------------------------------------------------------\n\n\nparLatexMarkup :: (a -> LaTeX) -> DocMarkup a (StringContext -> LaTeX)\nparLatexMarkup ppId = Markup {\n  markupParagraph            = \\p v -> p v <> text \"\\\\par\" $$ text \"\",\n  markupEmpty                = \\_ -> empty,\n  markupString               = \\s v -> text (fixString v s),\n  markupAppend               = \\l r v -> l v <> r v,\n  markupIdentifier           = markupId ppId,\n  markupIdentifierUnchecked  = markupId (ppVerbOccName . snd),\n  markupModule               = \\m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl),\n  markupWarning              = \\p v -> emph (p v),\n  markupEmphasis             = \\p v -> emph (p v),\n  markupBold                 = \\p v -> bold (p v),\n  markupMonospaced           = \\p _ -> tt (p Mono),\n  markupUnorderedList        = \\p v -> itemizedList (map ($v) p) $$ text \"\",\n  markupPic                  = \\p _ -> markupPic p,\n  markupMathInline           = \\p _ -> markupMathInline p,\n  markupMathDisplay          = \\p _ -> markupMathDisplay p,\n  markupOrderedList          = \\p v -> enumeratedList (map ($v) p) $$ text \"\",\n  markupDefList              = \\l v -> descriptionList (map (\\(a,b) -> (a v, b v)) l),\n  markupCodeBlock            = \\p _ -> quote (verb (p Verb)) $$ text \"\",\n  markupHyperlink            = \\l _ -> markupLink l,\n  markupAName                = \\_ _ -> empty,\n  markupProperty             = \\p _ -> quote $ verb $ text p,\n  markupExample              = \\e _ -> quote $ verb $ text $ unlines $ map exampleToString e,\n  markupHeader               = \\(Header l h) p -> header l (h p),\n  markupTable                = \\(Table h b) p -> table h b p\n  }\n  where\n    header 1 d = text \"\\\\section*\" <> braces d\n    header 2 d = text \"\\\\subsection*\" <> braces d\n    header l d\n      | l > 0 && l <= 6 = text \"\\\\subsubsection*\" <> braces d\n    header l _ = error $ \"impossible header level in LaTeX generation: \" ++ show l\n\n    table _ _ _ = text \"{TODO: Table}\"\n\n    fixString Plain s = latexFilter s\n    fixString Verb  s = s\n    fixString Mono  s = latexMonoFilter s\n\n    markupLink (Hyperlink url mLabel) = case mLabel of\n      Just label -> text \"\\\\href\" <> braces (text url) <> braces (text label)\n      Nothing    -> text \"\\\\url\"  <> braces (text url)\n\n    -- Is there a better way of doing this? Just a space is an aribtrary choice.\n    markupPic (Picture uri title) = parens (imageText title)\n      where\n        imageText Nothing = beg\n        imageText (Just t) = beg <> text \" \" <> text t\n\n        beg = text \"image: \" <> text uri\n\n    markupMathInline mathjax = text \"\\\\(\" <> text mathjax <> text \"\\\\)\"\n\n    markupMathDisplay mathjax = text \"\\\\[\" <> text mathjax <> text \"\\\\]\"\n\n    markupId ppId_ id v =\n      case v of\n        Verb  -> theid\n        Mono  -> theid\n        Plain -> text \"\\\\haddockid\" <> braces theid\n      where theid = ppId_ id\n\n\nlatexMarkup :: DocMarkup DocName (StringContext -> LaTeX)\nlatexMarkup = parLatexMarkup ppVerbDocName\n\n\nrdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX)\nrdrLatexMarkup = parLatexMarkup ppVerbRdrName\n\n\ndocToLaTeX :: Doc DocName -> LaTeX\ndocToLaTeX doc = markup latexMarkup doc Plain\n\n\ndocumentationToLaTeX :: Documentation DocName -> Maybe LaTeX\ndocumentationToLaTeX = fmap docToLaTeX . fmap _doc . combineDocumentation\n\n\nrdrDocToLaTeX :: Doc RdrName -> LaTeX\nrdrDocToLaTeX doc = markup rdrLatexMarkup doc Plain\n\n\ndata StringContext = Plain | Verb | Mono\n\n\nlatexStripTrailingWhitespace :: Doc a -> Doc a\nlatexStripTrailingWhitespace (DocString s)\n  | null s'   = DocEmpty\n  | otherwise = DocString s\n  where s' = reverse (dropWhile isSpace (reverse s))\nlatexStripTrailingWhitespace (DocAppend l r)\n  | DocEmpty <- r' = latexStripTrailingWhitespace l\n  | otherwise      = DocAppend l r'\n  where\n    r' = latexStripTrailingWhitespace r\nlatexStripTrailingWhitespace (DocParagraph p) =\n  latexStripTrailingWhitespace p\nlatexStripTrailingWhitespace other = other\n\n\n-------------------------------------------------------------------------------\n-- * LaTeX utils\n-------------------------------------------------------------------------------\n\n\nitemizedList :: [LaTeX] -> LaTeX\nitemizedList items =\n  text \"\\\\begin{itemize}\" $$\n  vcat (map (text \"\\\\item\" $$) items) $$\n  text \"\\\\end{itemize}\"\n\n\nenumeratedList :: [LaTeX] -> LaTeX\nenumeratedList items =\n  text \"\\\\begin{enumerate}\" $$\n  vcat (map (text \"\\\\item \" $$) items) $$\n  text \"\\\\end{enumerate}\"\n\n\ndescriptionList :: [(LaTeX,LaTeX)] -> LaTeX\ndescriptionList items =\n  text \"\\\\begin{description}\" $$\n  vcat (map (\\(a,b) -> text \"\\\\item\" <> brackets a <+> b) items) $$\n  text \"\\\\end{description}\"\n\n\ntt :: LaTeX -> LaTeX\ntt ltx = text \"\\\\haddocktt\" <> braces ltx\n\n\ndecltt :: LaTeX -> LaTeX\ndecltt ltx = text \"\\\\haddockdecltt\" <> braces ltx\n\n\nemph :: LaTeX -> LaTeX\nemph ltx = text \"\\\\emph\" <> braces ltx\n\nbold :: LaTeX -> LaTeX\nbold ltx = text \"\\\\textbf\" <> braces ltx\n\nverb :: LaTeX -> LaTeX\nverb doc = text \"{\\\\haddockverb\\\\begin{verbatim}\" $$ doc <> text \"\\\\end{verbatim}}\"\n   -- NB. swallow a trailing \\n in the verbatim text by appending the\n   -- \\end{verbatim} directly, otherwise we get spurious blank lines at the\n   -- end of code blocks.\n\n\nquote :: LaTeX -> LaTeX\nquote doc = text \"\\\\begin{quote}\" $$ doc $$ text \"\\\\end{quote}\"\n\n\ndcolon, arrow, darrow, forallSymbol :: Bool -> LaTeX\ndcolon unicode = text (if unicode then \"\u00e2\u02c6\u00b7\" else \"::\")\narrow  unicode = text (if unicode then \"\u00e2\u2020\u2019\" else \"->\")\ndarrow unicode = text (if unicode then \"\u00e2\u2021\u2019\" else \"=>\")\nforallSymbol unicode = text (if unicode then \"\u00e2\u02c6\u20ac\" else \"forall\")\n\n\ndot :: LaTeX\ndot = char '.'\n\n\nparenList :: [LaTeX] -> LaTeX\nparenList = parens . hsep . punctuate comma\n\n\nubxParenList :: [LaTeX] -> LaTeX\nubxParenList = ubxparens . hsep . punctuate comma\n\n\nubxparens :: LaTeX -> LaTeX\nubxparens h = text \"(#\" <> h <> text \"#)\"\n\n\npabrackets :: LaTeX -> LaTeX\npabrackets h = text \"[:\" <> h <> text \":]\"\n\n\nnl :: LaTeX\nnl = text \"\\\\\\\\\"\n\n\nkeyword :: String -> LaTeX\nkeyword = text\n\n\ninfixr 4 <->  -- combining table cells\n(<->) :: LaTeX -> LaTeX -> LaTeX\na <-> b = a <+> char '&' <+> b\n", "num_lines": 1308}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html\n-- Copyright   :  (c) Simon Marlow      2003-2006,\n--                    David Waern       2006-2009,\n--                    Mark Lentczner    2010,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\n{-# LANGUAGE CPP, NamedFieldPuns #-}\nmodule Haddock.Backends.Xhtml (\n  ppHtml, copyHtmlBits,\n  ppHtmlIndex, ppHtmlContents,\n) where\n\n\nimport Prelude hiding (div)\n\nimport Haddock.Backends.Xhtml.Decl\nimport Haddock.Backends.Xhtml.DocMarkup\nimport Haddock.Backends.Xhtml.Layout\nimport Haddock.Backends.Xhtml.Names\nimport Haddock.Backends.Xhtml.Themes\nimport Haddock.Backends.Xhtml.Types\nimport Haddock.Backends.Xhtml.Utils\nimport Haddock.ModuleTree\nimport Haddock.Types\nimport Haddock.Version\nimport Haddock.Utils\nimport Haddock.Utils.Json\nimport Text.XHtml hiding ( name, title, p, quote )\nimport Haddock.GhcUtils\n\nimport Control.Monad         ( when, unless )\nimport qualified Data.ByteString.Builder as Builder\nimport Data.Char             ( toUpper, isSpace )\nimport Data.List             ( sortBy, isPrefixOf, intercalate, intersperse )\nimport Data.Maybe\nimport System.Directory\nimport System.FilePath hiding ( (</>) )\nimport qualified System.IO as IO\nimport Data.Map              ( Map )\nimport qualified Data.Map as Map hiding ( Map )\nimport qualified Data.Set as Set hiding ( Set )\nimport Data.Ord              ( comparing )\n\nimport DynFlags (Language(..))\nimport GHC hiding ( NoLink, moduleInfo,LexicalFixity(..) )\nimport Name\n\n--------------------------------------------------------------------------------\n-- * Generating HTML documentation\n--------------------------------------------------------------------------------\n\nppHtml :: DynFlags\n       -> String                       -- ^ Title\n       -> Maybe String                 -- ^ Package\n       -> [Interface]\n       -> [InstalledInterface]         -- ^ Reexported interfaces\n       -> FilePath                     -- ^ Destination directory\n       -> Maybe (MDoc GHC.RdrName)     -- ^ Prologue text, maybe\n       -> Themes                       -- ^ Themes\n       -> Maybe String                 -- ^ The mathjax URL (--mathjax)\n       -> SourceURLs                   -- ^ The source URL (--source)\n       -> WikiURLs                     -- ^ The wiki URL (--wiki)\n       -> Maybe String                 -- ^ The contents URL (--use-contents)\n       -> Maybe String                 -- ^ The index URL (--use-index)\n       -> Bool                         -- ^ Whether to use unicode in output (--use-unicode)\n       -> Maybe String                 -- ^ Package name\n       -> QualOption                   -- ^ How to qualify names\n       -> Bool                         -- ^ Output pretty html (newlines and indenting)\n       -> Bool                         -- ^ Also write Quickjump index\n       -> IO ()\n\nppHtml dflags doctitle maybe_package ifaces reexported_ifaces odir prologue\n        themes maybe_mathjax_url maybe_source_url maybe_wiki_url\n        maybe_contents_url maybe_index_url unicode\n        pkg qual debug withQuickjump = do\n  let\n    visible_ifaces = filter visible ifaces\n    visible i = OptHide `notElem` ifaceOptions i\n\n  when (isNothing maybe_contents_url) $\n    ppHtmlContents dflags odir doctitle maybe_package\n        themes maybe_mathjax_url maybe_index_url maybe_source_url maybe_wiki_url\n        (map toInstalledIface visible_ifaces ++ reexported_ifaces)\n        False -- we don't want to display the packages in a single-package contents\n        prologue debug pkg (makeContentsQual qual)\n\n  when (isNothing maybe_index_url) $ do\n    ppHtmlIndex odir doctitle maybe_package\n      themes maybe_mathjax_url maybe_contents_url maybe_source_url maybe_wiki_url\n      (map toInstalledIface visible_ifaces ++ reexported_ifaces) debug\n\n    when withQuickjump $\n      ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual\n        visible_ifaces\n\n  mapM_ (ppHtmlModule odir doctitle themes\n           maybe_mathjax_url maybe_source_url maybe_wiki_url\n           maybe_contents_url maybe_index_url unicode pkg qual debug) visible_ifaces\n\n\ncopyHtmlBits :: FilePath -> FilePath -> Themes -> Bool -> IO ()\ncopyHtmlBits odir libdir themes withQuickjump = do\n  let\n    libhtmldir = joinPath [libdir, \"html\"]\n    copyCssFile f = copyFile f (combine odir (takeFileName f))\n    copyLibFile f = copyFile (joinPath [libhtmldir, f]) (joinPath [odir, f])\n  mapM_ copyCssFile (cssFiles themes)\n  copyLibFile haddockJsFile\n  copyCssFile (joinPath [libhtmldir, quickJumpCssFile])\n  when withQuickjump (copyLibFile jsQuickJumpFile)\n  return ()\n\n\nheadHtml :: String -> Themes -> Maybe String -> Html\nheadHtml docTitle themes mathjax_url =\n  header << [\n    meta ! [httpequiv \"Content-Type\", content \"text/html; charset=UTF-8\"],\n    thetitle << docTitle,\n    styleSheet themes,\n    thelink ! [ rel \"stylesheet\", thetype \"text/css\", href quickJumpCssFile] << noHtml,\n    script ! [src haddockJsFile, emptyAttr \"async\", thetype \"text/javascript\"] << noHtml,\n    script ! [src mjUrl, thetype \"text/javascript\"] << noHtml\n    ]\n  where\n    mjUrl = maybe \"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML\" id mathjax_url\n\n\nsrcButton :: SourceURLs -> Maybe Interface -> Maybe Html\nsrcButton (Just src_base_url, _, _, _) Nothing =\n  Just (anchor ! [href src_base_url] << \"Source\")\nsrcButton (_, Just src_module_url, _, _) (Just iface) =\n  let url = spliceURL (Just $ ifaceOrigFilename iface)\n                      (Just $ ifaceMod iface) Nothing Nothing src_module_url\n   in Just (anchor ! [href url] << \"Source\")\nsrcButton _ _ =\n  Nothing\n\n\nwikiButton :: WikiURLs -> Maybe Module -> Maybe Html\nwikiButton (Just wiki_base_url, _, _) Nothing =\n  Just (anchor ! [href wiki_base_url] << \"User Comments\")\n\nwikiButton (_, Just wiki_module_url, _) (Just mdl) =\n  let url = spliceURL Nothing (Just mdl) Nothing Nothing wiki_module_url\n   in Just (anchor ! [href url] << \"User Comments\")\n\nwikiButton _ _ =\n  Nothing\n\n\ncontentsButton :: Maybe String -> Maybe Html\ncontentsButton maybe_contents_url\n  = Just (anchor ! [href url] << \"Contents\")\n  where url = fromMaybe contentsHtmlFile maybe_contents_url\n\n\nindexButton :: Maybe String -> Maybe Html\nindexButton maybe_index_url\n  = Just (anchor ! [href url] << \"Index\")\n  where url = fromMaybe indexHtmlFile maybe_index_url\n\n\nbodyHtml :: String -> Maybe Interface\n    -> SourceURLs -> WikiURLs\n    -> Maybe String -> Maybe String\n    -> Html -> Html\nbodyHtml doctitle iface\n           maybe_source_url maybe_wiki_url\n           maybe_contents_url maybe_index_url\n           pageContent =\n  body << [\n    divPackageHeader << [\n      unordList (catMaybes [\n        srcButton maybe_source_url iface,\n        wikiButton maybe_wiki_url (ifaceMod <$> iface),\n        contentsButton maybe_contents_url,\n        indexButton maybe_index_url])\n            ! [theclass \"links\", identifier \"page-menu\"],\n      nonEmptySectionName << doctitle\n      ],\n    divContent << pageContent,\n    divFooter << paragraph << (\n      \"Produced by \" +++\n      (anchor ! [href projectUrl] << toHtml projectName) +++\n      (\" version \" ++ projectVersion)\n      )\n    ]\n\nmoduleInfo :: Interface -> Html\nmoduleInfo iface =\n   let\n      info = ifaceInfo iface\n\n      doOneEntry :: (String, HaddockModInfo GHC.Name -> Maybe String) -> Maybe HtmlTable\n      doOneEntry (fieldName, field) =\n        field info >>= \\a -> return (th << fieldName <-> td << a)\n\n      entries :: [HtmlTable]\n      entries = maybeToList copyrightsTable ++ mapMaybe doOneEntry [\n          (\"License\",hmi_license),\n          (\"Maintainer\",hmi_maintainer),\n          (\"Stability\",hmi_stability),\n          (\"Portability\",hmi_portability),\n          (\"Safe Haskell\",hmi_safety),\n          (\"Language\", lg)\n          ] ++ extsForm\n        where\n          lg inf = case hmi_language inf of\n            Nothing -> Nothing\n            Just Haskell98 -> Just \"Haskell98\"\n            Just Haskell2010 -> Just \"Haskell2010\"\n\n          multilineRow :: String -> [String] -> HtmlTable\n          multilineRow title xs = (th ! [valign \"top\"]) << title <-> td << (toLines xs)\n            where toLines = mconcat . intersperse br . map toHtml\n\n          copyrightsTable :: Maybe HtmlTable\n          copyrightsTable = fmap (multilineRow \"Copyright\" . split) (hmi_copyright info)\n            where split = map (trim . filter (/= ',')) . lines\n\n          extsForm\n            | OptShowExtensions `elem` ifaceOptions iface =\n              let fs = map (dropOpt . show) (hmi_extensions info)\n              in case map stringToHtml fs of\n                [] -> []\n                [x] -> extField x -- don't use a list for a single extension\n                xs -> extField $ unordList xs ! [theclass \"extension-list\"]\n            | otherwise = []\n            where\n              extField x = return $ th << \"Extensions\" <-> td << x\n              dropOpt x = if \"Opt_\" `isPrefixOf` x then drop 4 x else x\n   in\n      case entries of\n         [] -> noHtml\n         _ -> table ! [theclass \"info\"] << aboves entries\n\n\n--------------------------------------------------------------------------------\n-- * Generate the module contents\n--------------------------------------------------------------------------------\n\n\nppHtmlContents\n   :: DynFlags\n   -> FilePath\n   -> String\n   -> Maybe String\n   -> Themes\n   -> Maybe String\n   -> Maybe String\n   -> SourceURLs\n   -> WikiURLs\n   -> [InstalledInterface] -> Bool -> Maybe (MDoc GHC.RdrName)\n   -> Bool\n   -> Maybe Package  -- ^ Current package\n   -> Qualification  -- ^ How to qualify names\n   -> IO ()\nppHtmlContents dflags odir doctitle _maybe_package\n  themes mathjax_url maybe_index_url\n  maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug pkg qual = do\n  let tree = mkModuleTree dflags showPkgs\n         [(instMod iface, toInstalledDescription iface)\n         | iface <- ifaces\n         , not (instIsSig iface)]\n      sig_tree = mkModuleTree dflags showPkgs\n         [(instMod iface, toInstalledDescription iface)\n         | iface <- ifaces\n         , instIsSig iface]\n      html =\n        headHtml doctitle themes mathjax_url +++\n        bodyHtml doctitle Nothing\n          maybe_source_url maybe_wiki_url\n          Nothing maybe_index_url << [\n            ppPrologue pkg qual doctitle prologue,\n            ppSignatureTree pkg qual sig_tree,\n            ppModuleTree pkg qual tree\n          ]\n  createDirectoryIfMissing True odir\n  writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)\n\n\nppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html\nppPrologue _ _ _ Nothing = noHtml\nppPrologue pkg qual title (Just doc) =\n  divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml pkg qual doc))\n\n\nppSignatureTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html\nppSignatureTree pkg qual ts =\n  divModuleList << (sectionName << \"Signatures\" +++ mkNodeList pkg qual [] \"n\" ts)\n\n\nppModuleTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html\nppModuleTree _ _ [] = mempty\nppModuleTree pkg qual ts =\n  divModuleList << (sectionName << \"Modules\" +++ mkNodeList pkg qual [] \"n\" ts)\n\n\nmkNodeList :: Maybe Package -> Qualification -> [String] -> String -> [ModuleTree] -> Html\nmkNodeList pkg qual ss p ts = case ts of\n  [] -> noHtml\n  _ -> unordList (zipWith (mkNode pkg qual ss) ps ts)\n  where\n    ps = [ p ++ '.' : show i | i <- [(1::Int)..]]\n\n\nmkNode :: Maybe Package -> Qualification -> [String] -> String -> ModuleTree -> Html\nmkNode pkg qual ss p (Node s leaf _pkg srcPkg short ts) =\n  htmlModule <+> shortDescr +++ htmlPkg +++ subtree\n  where\n    modAttrs = case (ts, leaf) of\n      (_:_, Nothing) -> collapseControl p \"module\"\n      (_,   _    ) -> [theclass \"module\"]\n\n    cBtn = case (ts, leaf) of\n      (_:_, Just _) -> thespan ! collapseControl p \"\" << spaceHtml\n      (_,   _   ) -> noHtml\n      -- We only need an explicit collapser button when the module name\n      -- is also a leaf, and so is a link to a module page. Indeed, the\n      -- spaceHtml is a minor hack and does upset the layout a fraction.\n\n    htmlModule = thespan ! modAttrs << (cBtn +++\n      case leaf of\n        Just m -> ppModule m\n        Nothing -> toHtml s\n      )\n\n    shortDescr = maybe noHtml (origDocToHtml pkg qual) short\n    htmlPkg = maybe noHtml (thespan ! [theclass \"package\"] <<) srcPkg\n\n    subtree =\n      if null ts then noHtml else\n      collapseDetails p DetailsOpen (\n        thesummary ! [ theclass \"hide-when-js-enabled\" ] << \"Submodules\" +++\n        mkNodeList pkg qual (s:ss) p ts\n      )\n\n\n\n--------------------------------------------------------------------------------\n-- * Generate the index\n--------------------------------------------------------------------------------\n\nppJsonIndex :: FilePath\n           -> SourceURLs                   -- ^ The source URL (--source)\n           -> WikiURLs                     -- ^ The wiki URL (--wiki)\n           -> Bool\n           -> Maybe Package\n           -> QualOption\n           -> [Interface]\n           -> IO ()\nppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual_opt ifaces = do\n  createDirectoryIfMissing True odir\n  IO.withBinaryFile (joinPath [odir, indexJsonFile]) IO.WriteMode $ \\h -> do\n    Builder.hPutBuilder h (encodeToBuilder modules)\n  where\n    modules :: Value\n    modules = Array (concatMap goInterface ifaces)\n\n    goInterface :: Interface -> [Value]\n    goInterface iface =\n        concatMap (goExport mdl qual) (ifaceRnExportItems iface)\n      where\n        aliases = ifaceModuleAliases iface\n        qual    = makeModuleQual qual_opt aliases mdl\n        mdl     = ifaceMod iface\n\n    goExport :: Module -> Qualification -> ExportItem DocNameI -> [Value]\n    goExport mdl qual item\n      | Just item_html <- processExport True links_info unicode pkg qual item\n      = [ Object\n            [ \"display_html\" .= String (showHtmlFragment item_html)\n            , \"name\"         .= String (intercalate \" \" (map nameString names))\n            , \"module\"       .= String (moduleString mdl)\n            , \"link\"         .= String (fromMaybe \"\" (listToMaybe (map (nameLink mdl) names)))\n            ]\n        ]\n      | otherwise = []\n      where\n        names = exportName item ++ exportSubs item\n\n    exportSubs :: ExportItem name -> [IdP name]\n    exportSubs ExportDecl { expItemSubDocs } = map fst expItemSubDocs\n    exportSubs _ = []\n\n    exportName :: ExportItem name -> [IdP name]\n    exportName ExportDecl { expItemDecl } = getMainDeclBinder (unLoc expItemDecl)\n    exportName ExportNoDecl { expItemName } = [expItemName]\n    exportName _ = []\n\n    nameString :: NamedThing name => name -> String\n    nameString = occNameString . nameOccName . getName\n\n    nameLink :: NamedThing name => Module -> name -> String\n    nameLink mdl = moduleNameUrl' (moduleName mdl) . nameOccName . getName\n\n    links_info = (maybe_source_url, maybe_wiki_url)\n\nppHtmlIndex :: FilePath\n            -> String\n            -> Maybe String\n            -> Themes\n            -> Maybe String\n            -> Maybe String\n            -> SourceURLs\n            -> WikiURLs\n            -> [InstalledInterface]\n            -> Bool\n            -> IO ()\nppHtmlIndex odir doctitle _maybe_package themes\n  maybe_mathjax_url maybe_contents_url maybe_source_url maybe_wiki_url ifaces debug = do\n  let html = indexPage split_indices Nothing\n              (if split_indices then [] else index)\n\n  createDirectoryIfMissing True odir\n\n  when split_indices $ do\n    mapM_ (do_sub_index index) initialChars\n    -- Let's add a single large index as well for those who don't know exactly what they're looking for:\n    let mergedhtml = indexPage False Nothing index\n    writeFile (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString debug mergedhtml)\n\n  writeFile (joinPath [odir, indexHtmlFile]) (renderToString debug html)\n\n  where\n    indexPage showLetters ch items =\n      headHtml (doctitle ++ \" (\" ++ indexName ch ++ \")\") themes maybe_mathjax_url +++\n      bodyHtml doctitle Nothing\n        maybe_source_url maybe_wiki_url\n        maybe_contents_url Nothing << [\n          if showLetters then indexInitialLetterLinks else noHtml,\n          if null items then noHtml else\n            divIndex << [sectionName << indexName ch, buildIndex items]\n          ]\n\n    indexName ch = \"Index\" ++ maybe \"\" (\\c -> \" - \" ++ [c]) ch\n    merged_name = \"All\"\n\n    buildIndex items = table << aboves (map indexElt items)\n\n    -- an arbitrary heuristic:\n    -- too large, and a single-page will be slow to load\n    -- too small, and we'll have lots of letter-indexes with only one\n    --   or two members in them, which seems inefficient or\n    --   unnecessarily hard to use.\n    split_indices = length index > 150\n\n    indexInitialLetterLinks =\n      divAlphabet <<\n         unordList (map (\\str -> anchor ! [href (subIndexHtmlFile str)] << str) $\n                        [ [c] | c <- initialChars\n                              , any ((==c) . toUpper . head . fst) index ] ++\n                        [merged_name])\n\n    -- todo: what about names/operators that start with Unicode\n    -- characters?\n    -- Exports beginning with '_' can be listed near the end,\n    -- presumably they're not as important... but would be listed\n    -- with non-split index!\n    initialChars = [ 'A'..'Z' ] ++ \":!#$%&*+./<=>?@\\\\^|-~\" ++ \"_\"\n\n    do_sub_index this_ix c\n      = unless (null index_part) $\n          writeFile (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html)\n      where\n        html = indexPage True (Just c) index_part\n        index_part = [(n,stuff) | (n,stuff) <- this_ix, toUpper (head n) == c]\n\n\n    index :: [(String, Map GHC.Name [(Module,Bool)])]\n    index = sortBy cmp (Map.toAscList full_index)\n      where cmp (n1,_) (n2,_) = comparing (map toUpper) n1 n2\n\n    -- for each name (a plain string), we have a number of original HsNames that\n    -- it can refer to, and for each of those we have a list of modules\n    -- that export that entity.  Each of the modules exports the entity\n    -- in a visible or invisible way (hence the Bool).\n    full_index :: Map String (Map GHC.Name [(Module,Bool)])\n    full_index = Map.fromListWith (flip (Map.unionWith (++)))\n                 (concatMap getIfaceIndex ifaces)\n\n    getIfaceIndex iface =\n      [ (getOccString name\n         , Map.fromList [(name, [(mdl, name `Set.member` visible)])])\n         | name <- instExports iface ]\n      where\n        mdl = instMod iface\n        visible = Set.fromList (instVisibleExports iface)\n\n    indexElt :: (String, Map GHC.Name [(Module,Bool)]) -> HtmlTable\n    indexElt (str, entities) =\n       case Map.toAscList entities of\n          [(nm,entries)] ->\n              td ! [ theclass \"src\" ] << toHtml str <->\n                          indexLinks nm entries\n          many_entities ->\n              td ! [ theclass \"src\" ] << toHtml str <-> td << spaceHtml </>\n                  aboves (zipWith (curry doAnnotatedEntity) [1..] many_entities)\n\n    doAnnotatedEntity :: (Integer, (Name, [(Module, Bool)])) -> HtmlTable\n    doAnnotatedEntity (j,(nm,entries))\n          = td ! [ theclass \"alt\" ] <<\n                  toHtml (show j) <+> parens (ppAnnot (nameOccName nm)) <->\n                   indexLinks nm entries\n\n    ppAnnot n | not (isValOcc n) = toHtml \"Type/Class\"\n              | isDataOcc n      = toHtml \"Data Constructor\"\n              | otherwise        = toHtml \"Function\"\n\n    indexLinks nm entries =\n       td ! [ theclass \"module\" ] <<\n          hsep (punctuate comma\n          [ if visible then\n               linkId mdl (Just nm) << toHtml (moduleString mdl)\n            else\n               toHtml (moduleString mdl)\n          | (mdl, visible) <- entries ])\n\n\n--------------------------------------------------------------------------------\n-- * Generate the HTML page for a module\n--------------------------------------------------------------------------------\n\n\nppHtmlModule\n        :: FilePath -> String -> Themes\n        -> Maybe String -> SourceURLs -> WikiURLs\n        -> Maybe String -> Maybe String -> Bool -> Maybe Package -> QualOption\n        -> Bool -> Interface -> IO ()\nppHtmlModule odir doctitle themes\n  maybe_mathjax_url maybe_source_url maybe_wiki_url\n  maybe_contents_url maybe_index_url unicode pkg qual debug iface = do\n  let\n      mdl = ifaceMod iface\n      aliases = ifaceModuleAliases iface\n      mdl_str = moduleString mdl\n      mdl_str_annot = mdl_str ++ if ifaceIsSig iface\n                                    then \" (signature)\"\n                                    else \"\"\n      mdl_str_linked\n        | ifaceIsSig iface\n        = mdl_str +++ \" (signature\" +++\n                       sup << (\"[\" +++ anchor ! [href signatureDocURL] << \"?\" +++ \"]\" ) +++\n                       \")\"\n        | otherwise\n        = toHtml mdl_str\n      real_qual = makeModuleQual qual aliases mdl\n      html =\n        headHtml mdl_str_annot themes maybe_mathjax_url +++\n        bodyHtml doctitle (Just iface)\n          maybe_source_url maybe_wiki_url\n          maybe_contents_url maybe_index_url << [\n            divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_linked)),\n            ifaceToHtml maybe_source_url maybe_wiki_url iface unicode pkg real_qual\n          ]\n\n  createDirectoryIfMissing True odir\n  writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)\n\nsignatureDocURL :: String\nsignatureDocURL = \"https://wiki.haskell.org/Module_signature\"\n\n\nifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Maybe Package -> Qualification -> Html\nifaceToHtml maybe_source_url maybe_wiki_url iface unicode pkg qual\n  = ppModuleContents pkg qual exports (not . null $ ifaceRnOrphanInstances iface) +++\n    description +++\n    synopsis +++\n    divInterface (maybe_doc_hdr +++ bdy +++ orphans)\n  where\n    exports = numberSectionHeadings (ifaceRnExportItems iface)\n\n    -- todo: if something has only sub-docs, or fn-args-docs, should\n    -- it be measured here and thus prevent omitting the synopsis?\n    has_doc ExportDecl { expItemMbDoc = (Documentation mDoc mWarning, _) } = isJust mDoc || isJust mWarning\n    has_doc (ExportNoDecl _ _) = False\n    has_doc (ExportModule _) = False\n    has_doc _ = True\n\n    no_doc_at_all = not (any has_doc exports)\n\n    description | isNoHtml doc = doc\n                | otherwise    = divDescription $ sectionName << \"Description\" +++ doc\n                where doc = docSection Nothing pkg qual (ifaceRnDoc iface)\n\n        -- omit the synopsis if there are no documentation annotations at all\n    synopsis\n      | no_doc_at_all = noHtml\n      | otherwise\n      = divSynopsis $\n            collapseDetails \"syn\" DetailsClosed (\n              thesummary << \"Synopsis\" +++\n              shortDeclList (\n                  mapMaybe (processExport True linksInfo unicode pkg qual) exports\n              ) ! collapseToggle \"syn\" \"\"\n            )\n\n        -- if the documentation doesn't begin with a section header, then\n        -- add one (\"Documentation\").\n    maybe_doc_hdr\n      = case exports of\n          [] -> noHtml\n          ExportGroup {} : _ -> noHtml\n          _ -> h1 << \"Documentation\"\n\n    bdy =\n      foldr (+++) noHtml $\n        mapMaybe (processExport False linksInfo unicode pkg qual) exports\n\n    orphans =\n      ppOrphanInstances linksInfo (ifaceRnOrphanInstances iface) False unicode pkg qual\n\n    linksInfo = (maybe_source_url, maybe_wiki_url)\n\n\nppModuleContents :: Maybe Package -- ^ This package\n                 -> Qualification\n                 -> [ExportItem DocNameI]\n                 -> Bool          -- ^ Orphans sections\n                 -> Html\nppModuleContents pkg qual exports orphan\n  | null sections && not orphan  = noHtml\n  | otherwise                    = contentsDiv\n where\n  contentsDiv = divTableOfContents << (\n    sectionName << \"Contents\" +++\n    unordList (sections ++ orphanSection))\n\n  (sections, _leftovers{-should be []-}) = process 0 exports\n  orphanSection\n    | orphan =  [ linkedAnchor \"section.orphans\" << \"Orphan instances\" ]\n    | otherwise = []\n\n  process :: Int -> [ExportItem DocNameI] -> ([Html],[ExportItem DocNameI])\n  process _ [] = ([], [])\n  process n items@(ExportGroup lev id0 doc : rest)\n    | lev <= n  = ( [], items )\n    | otherwise = ( html:secs, rest2 )\n    where\n      html = linkedAnchor (groupId id0)\n             << docToHtmlNoAnchors (Just id0) pkg qual (mkMeta doc) +++ mk_subsections ssecs\n      (ssecs, rest1) = process lev rest\n      (secs,  rest2) = process n   rest1\n  process n (_ : rest) = process n rest\n\n  mk_subsections [] = noHtml\n  mk_subsections ss = unordList ss\n\n-- we need to assign a unique id to each section heading so we can hyperlink\n-- them from the contents:\nnumberSectionHeadings :: [ExportItem DocNameI] -> [ExportItem DocNameI]\nnumberSectionHeadings = go 1\n  where go :: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]\n        go _ [] = []\n        go n (ExportGroup lev _ doc : es)\n          = ExportGroup lev (show n) doc : go (n+1) es\n        go n (other:es)\n          = other : go n es\n\n\nprocessExport :: Bool -> LinksInfo -> Bool -> Maybe Package -> Qualification\n              -> ExportItem DocNameI -> Maybe Html\nprocessExport _ _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances\nprocessExport summary _ _ pkg qual (ExportGroup lev id0 doc)\n  = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) pkg qual (mkMeta doc)\nprocessExport summary links unicode pkg qual (ExportDecl decl pats doc subdocs insts fixities splice)\n  = processDecl summary $ ppDecl summary links decl pats doc insts fixities subdocs splice unicode pkg qual\nprocessExport summary _ _ _ qual (ExportNoDecl y [])\n  = processDeclOneLiner summary $ ppDocName qual Prefix True y\nprocessExport summary _ _ _ qual (ExportNoDecl y subs)\n  = processDeclOneLiner summary $\n      ppDocName qual Prefix True y\n      +++ parenList (map (ppDocName qual Prefix True) subs)\nprocessExport summary _ _ pkg qual (ExportDoc doc)\n  = nothingIf summary $ docSection_ Nothing pkg qual doc\nprocessExport summary _ _ _ _ (ExportModule mdl)\n  = processDeclOneLiner summary $ toHtml \"module\" <+> ppModule mdl\n\n\nnothingIf :: Bool -> a -> Maybe a\nnothingIf True _ = Nothing\nnothingIf False a = Just a\n\n\nprocessDecl :: Bool -> Html -> Maybe Html\nprocessDecl True = Just\nprocessDecl False = Just . divTopDecl\n\ntrim :: String -> String\ntrim = f . f\n  where f = reverse . dropWhile isSpace\n\nprocessDeclOneLiner :: Bool -> Html -> Maybe Html\nprocessDeclOneLiner True = Just\nprocessDeclOneLiner False = Just . divTopDecl . declElem\n\ngroupHeading :: Int -> String -> Html -> Html\ngroupHeading lev id0 = linkedAnchor grpId . groupTag lev ! [identifier grpId]\n  where grpId = groupId id0\n\ngroupTag :: Int -> Html -> Html\ngroupTag lev\n  | lev == 1  = h1\n  | lev == 2  = h2\n  | lev == 3  = h3\n  | otherwise = h4\n", "num_lines": 714}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeApplications #-}\n\nmodule Haddock.Backends.Hyperlinker.Ast (enrich) where\n\n\nimport qualified Haddock.Syb as Syb\nimport Haddock.Backends.Hyperlinker.Types\n\nimport qualified GHC\nimport qualified SrcLoc\n\nimport Control.Applicative\nimport Control.Monad (guard)\nimport Data.Data\nimport qualified Data.Map.Strict as Map\nimport Data.Maybe\n\nimport Prelude hiding (span)\n\neverythingInRenamedSource :: (Alternative f, Data x)\n  => (forall a. Data a => a -> f r) -> x -> f r\neverythingInRenamedSource f = Syb.everythingButType @GHC.Name (<|>) f\n\n-- | Add more detailed information to token stream using GHC API.\nenrich :: GHC.RenamedSource -> [Token] -> [RichToken]\nenrich src =\n    map $ \\token -> RichToken\n        { rtkToken = token\n        , rtkDetails = enrichToken token detailsMap\n        }\n  where\n    detailsMap =\n      mkDetailsMap (concatMap ($ src)\n                     [ variables\n                     , types\n                     , decls\n                     , binds\n                     , imports\n                     ])\n\ntype LTokenDetails = [(GHC.SrcSpan, TokenDetails)]\n\n-- | A map containing association between source locations and \"details\" of\n-- this location.\n--\ntype DetailsMap = Map.Map Position (Span, TokenDetails)\n\nmkDetailsMap :: [(GHC.SrcSpan, TokenDetails)] -> DetailsMap\nmkDetailsMap xs =\n  Map.fromListWith select_details [ (start, (span, token_details))\n                                  | (ghc_span, token_details) <- xs\n                                  , GHC.RealSrcSpan span <- [ghc_span]\n                                  , let start = SrcLoc.realSrcSpanStart span\n                                  ]\n  where\n    -- favour token details which appear earlier in the list\n    select_details _new old = old\n\nlookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails\nlookupBySpan span details = do\n  let pos = SrcLoc.realSrcSpanStart span\n  (_, (tok_span, tok_details)) <- Map.lookupLE pos details\n  guard (tok_span `SrcLoc.containsSpan` span)\n  return tok_details\n\nenrichToken :: Token -> DetailsMap -> Maybe TokenDetails\nenrichToken (Token typ _ spn) dm\n    | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm\nenrichToken _ _ = Nothing\n\n-- | Obtain details map for variables (\"normally\" used identifiers).\nvariables :: GHC.RenamedSource -> LTokenDetails\nvariables =\n    everythingInRenamedSource (var `Syb.combine` rec)\n  where\n    var term = case cast term of\n        (Just ((GHC.L sspan (GHC.HsVar name)) :: GHC.LHsExpr GHC.GhcRn)) ->\n            pure (sspan, RtkVar (GHC.unLoc name))\n        (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _ _))) ->\n            pure (sspan, RtkVar name)\n        _ -> empty\n    rec term = case cast term of\n        Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.GhcRn) _) ->\n            pure (sspan, RtkVar name)\n        _ -> empty\n\n-- | Obtain details map for types.\ntypes :: GHC.RenamedSource -> LTokenDetails\ntypes = everythingInRenamedSource ty\n  where\n    ty :: forall a. Data a => a -> [(GHC.SrcSpan, TokenDetails)]\n    ty term = case cast term of\n        (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) ->\n            pure (sspan, RtkType (GHC.unLoc name))\n        (Just ((GHC.L sspan (GHC.HsOpTy l name r)) :: GHC.LHsType GHC.GhcRn)) ->\n            (sspan, RtkType (GHC.unLoc name)):(ty l ++ ty r)\n        _ -> empty\n\n-- | Obtain details map for identifier bindings.\n--\n-- That includes both identifiers bound by pattern matching or declared using\n-- ordinary assignment (in top-level declarations, let-expressions and where\n-- clauses).\n\nbinds :: GHC.RenamedSource -> LTokenDetails\nbinds = everythingInRenamedSource\n      (fun `Syb.combine` pat `Syb.combine` tvar)\n  where\n    fun term = case cast term of\n        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) ->\n            pure (sspan, RtkBind name)\n        (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ args _ _))) ->\n            pure (sspan, RtkBind name) ++ everythingInRenamedSource patsyn_binds args\n        _ -> empty\n    patsyn_binds term = case cast term of\n        (Just (GHC.L sspan (name :: GHC.Name))) -> pure (sspan, RtkVar name)\n        _ -> empty\n    pat term = case cast term of\n        (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) ->\n            pure (sspan, RtkBind (GHC.unLoc name))\n        (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->\n            [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs\n        (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) ->\n            pure (sspan, RtkBind name)\n        _ -> empty\n    rec term = case cast term of\n        (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.GhcRn) _)) ->\n            pure (sspan, RtkVar name)\n        _ -> empty\n    tvar term = case cast term of\n        (Just ((GHC.L sspan (GHC.UserTyVar name)) :: GHC.LHsTyVarBndr GHC.GhcRn)) ->\n            pure (sspan, RtkBind (GHC.unLoc name))\n        (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->\n            pure (sspan, RtkBind name)\n        _ -> empty\n\n-- | Obtain details map for top-level declarations.\ndecls :: GHC.RenamedSource -> LTokenDetails\ndecls (group, _, _, _) = concatMap ($ group)\n    [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds\n    , everythingInRenamedSource fun . GHC.hs_valds\n    , everythingInRenamedSource fix . GHC.hs_fixds\n    , everythingInRenamedSource (con `Syb.combine` ins)\n    ]\n  where\n    typ (GHC.L _ t) = case t of\n        GHC.DataDecl { tcdLName = name } -> pure . decl $ name\n        GHC.SynDecl name _ _ _ _ -> pure . decl $ name\n        GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam\n        GHC.ClassDecl{..} ->\n          [decl tcdLName]\n            ++ concatMap sig tcdSigs\n            ++ concatMap tyfam tcdATs\n    fun term = case cast term of\n        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn))\n            | GHC.isExternalName name -> pure (sspan, RtkDecl name)\n        (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ _ _ _)))\n            | GHC.isExternalName name -> pure (sspan, RtkDecl name)\n        _ -> empty\n    con term = case cast term of\n        (Just (cdcl :: GHC.ConDecl GHC.GhcRn)) ->\n            map decl (GHC.getConNames cdcl)\n              ++ everythingInRenamedSource fld cdcl\n        Nothing -> empty\n    ins term = case cast term of\n        (Just ((GHC.DataFamInstD (GHC.DataFamInstDecl eqn))\n                :: GHC.InstDecl GHC.GhcRn))\n          -> pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn\n        (Just (GHC.TyFamInstD (GHC.TyFamInstDecl eqn))) ->\n            pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn\n        _ -> empty\n    fld term = case cast term of\n        Just (field :: GHC.ConDeclField GHC.GhcRn)\n          -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field\n        Nothing -> empty\n    fix term = case cast term of\n        Just ((GHC.FixitySig names _) :: GHC.FixitySig GHC.GhcRn)\n          -> map (\\(GHC.L sspan x) -> (sspan, RtkVar x)) names\n        Nothing -> empty\n    tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName]\n    sig (GHC.L _ (GHC.TypeSig names _)) = map decl names\n    sig (GHC.L _ (GHC.PatSynSig names _)) = map decl names\n    sig (GHC.L _ (GHC.ClassOpSig _ names _)) = map decl names\n    sig _ = []\n    decl (GHC.L sspan name) = (sspan, RtkDecl name)\n    tyref (GHC.L sspan name) = (sspan, RtkType name)\n\n-- | Obtain details map for import declarations.\n--\n-- This map also includes type and variable details for items in export and\n-- import lists.\nimports :: GHC.RenamedSource -> LTokenDetails\nimports src@(_, imps, _, _) =\n    everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps\n  where\n    ie term = case cast term of\n        (Just ((GHC.IEVar v) :: GHC.IE GHC.GhcRn)) -> pure $ var $ GHC.ieLWrappedName v\n        (Just (GHC.IEThingAbs t)) -> pure $ typ $ GHC.ieLWrappedName t\n        (Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t\n        (Just (GHC.IEThingWith t _ vs _fls)) ->\n          [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs\n        (Just (GHC.IEModuleContents m)) -> pure $ modu m\n        _ -> empty\n    typ (GHC.L sspan name) = (sspan, RtkType name)\n    var (GHC.L sspan name) = (sspan, RtkVar name)\n    modu (GHC.L sspan name) = (sspan, RtkModule name)\n    imp idecl\n      | not . GHC.ideclImplicit $ idecl = Just (modu (GHC.ideclName idecl))\n      | otherwise = Nothing\n", "num_lines": 215}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Haddock.Backends.Hyperlinker.Parser (parse) where\n\nimport Data.Either         ( isRight, isLeft )\nimport Data.List           ( foldl', isPrefixOf, isSuffixOf )\nimport Data.Maybe          ( maybeToList )\nimport Data.Char           ( isSpace )\nimport qualified Text.Read as R\n\nimport GHC                 ( DynFlags, addSourceToTokens )\nimport SrcLoc\nimport FastString          ( mkFastString )\nimport StringBuffer        ( stringToStringBuffer )\nimport Lexer               ( Token(..) )\nimport qualified Lexer as L\n\nimport Haddock.Backends.Hyperlinker.Types as T\n\n\n-- | Turn source code string into a stream of more descriptive tokens.\n--\n-- Result should retain original file layout (including comments, whitespace,\n-- etc.), i.e. the following \"law\" should hold:\n--\n-- prop> concat . map tkValue . parse = id\n--\n-- (In reality, this only holds for input not containing '\\r', '\\t', '\\f', '\\v',\n-- characters, since GHC transforms those into ' ' and '\\n')\nparse :: DynFlags -> FilePath -> String -> [T.Token]\nparse dflags fp = ghcToks . processCPP dflags fp . filterCRLF\n  where\n    -- Remove CRLFs from source\n    filterCRLF :: String -> String\n    filterCRLF ('\\r':'\\n':cs) = '\\n' : filterCRLF cs\n    filterCRLF (c:cs) = c : filterCRLF cs\n    filterCRLF [] = []\n\n-- | Parse the source into tokens using the GHC lexer.\n--\n--   * CPP lines are removed and reinserted as line-comments\n--   * top-level file pragmas are parsed as block comments (see the\n--     'ITblockComment' case of 'classify' for more details)\n--\nprocessCPP :: DynFlags    -- ^ GHC's flags\n           -> FilePath    -- ^ source file name (for position information)\n           -> String      -- ^ source file contents\n           -> [(Located L.Token, String)]\nprocessCPP dflags fpath s = addSrc . go start . splitCPP $ s\n  where\n    start = mkRealSrcLoc (mkFastString fpath) 1 1\n    addSrc = addSourceToTokens start (stringToStringBuffer s)\n\n    -- Transform a list of Haskell/CPP lines into a list of tokens\n    go :: RealSrcLoc -> [Either String String] -> [Located L.Token]\n    go _   [] = []\n    go pos ls =\n      let (hLinesRight,  ls')  = span isRight ls\n          (cppLinesLeft, rest) = span isLeft ls'\n\n          hSrc   = concat [ hLine   | Right hLine  <- hLinesRight  ]\n          cppSrc = concat [ cppLine | Left cppLine <- cppLinesLeft ]\n\n      in case L.lexTokenStream (stringToStringBuffer hSrc) pos dflags of\n\n           -- Stuff that fails to lex gets turned into comments\n           L.PFailed _ _ss _msg ->\n             let (src_pos, failed) = mkToken ITunknown pos hSrc\n                 (new_pos, cpp)    = mkToken ITlineComment src_pos cppSrc\n             in failed : cpp : go new_pos rest\n\n           -- Successfully lexed\n           L.POk ss toks ->\n             let (new_pos, cpp) = mkToken ITlineComment (L.loc ss) cppSrc\n             in toks ++ [cpp] ++ go new_pos rest\n\n    -- Manually make a token from a 'String', advancing the cursor position\n    mkToken tok start' str =\n      let end = foldl' advanceSrcLoc start' str\n      in (end, L (RealSrcSpan $ mkRealSrcSpan start' end) (tok str))\n\n\n-- | Split apart the initial file into Haskell source lines ('Left' entries) and\n-- CPP lines ('Right' entries).\n--\n-- All characters in the input are present in the output:\n--\n-- prop> concat . map (either id id) . splitCPP = id\nsplitCPP :: String -> [Either String String]\nsplitCPP \"\" = []\nsplitCPP s | isCPPline s = Left l : splitCPP rest\n           | otherwise =  Right l : splitCPP rest\n  where\n    ~(l, rest) = spanToNewline 0 s\n\n\n-- | Heuristic to decide if a line is going to be a CPP line. This should be a\n-- cheap operation since it is going to be run on every line being processed.\n--\n-- Right now it just checks if the first non-whitespace character in the first\n-- five characters of the line is a '#':\n--\n-- >>> isCPPline \"#define FOO 1\"\n-- True\n--\n-- >>> isCPPline \"\\t\\t  #ifdef GHC\"\n-- True\n--\n-- >>> isCPPline \"       #endif\"\n-- False\n--\nisCPPline :: String -> Bool\nisCPPline = isPrefixOf \"#\" . dropWhile (`elem` \" \\t\") . take 5\n\n\n-- | Split a \"line\" off the front of a string, hopefully without cutting tokens\n-- in half. I say \"hopefully\" because knowing what a token is requires lexing,\n-- yet lexing depends on this function.\n--\n-- All characters in the input are present in the output:\n--\n-- prop> curry (++) . spanToNewLine 0 = id\nspanToNewline :: Int                 -- ^ open '{-'\n              -> String              -- ^ input\n              -> (String, String)\n\n-- Base case and space characters\nspanToNewline _ \"\" = (\"\", \"\")\nspanToNewline n ('\\n':str) | n <= 0 = (\"\\n\", str)\nspanToNewline n ('\\n':str) | n <= 0 = (\"\\n\", str)\nspanToNewline n ('\\\\':'\\n':str) =\n    let (str', rest) = spanToNewline n str\n    in ('\\\\':'\\n':str', rest)\n\n-- Block comments\nspanToNewline n ('{':'-':str) =\n    let (str', rest) = spanToNewline (n+1) str\n    in ('{':'-':str', rest)\nspanToNewline n ('-':'}':str) =\n    let (str', rest) = spanToNewline (n-1) str\n    in ('-':'}':str', rest)\n\n-- When not in a block comment, try to lex a Haskell token\nspanToNewline 0 str@(c:_) | ((lexed, str') : _) <- R.lex str, not (isSpace c) =\n    if all (== '-') lexed && length lexed >= 2\n      -- A Haskell line comment\n      then case span (/= '\\n') str' of\n             (str'', '\\n':rest) -> (lexed ++ str'' ++ \"\\n\", rest)\n             (_, _) -> (str, \"\") \n\n      -- An actual Haskell token\n      else let (str'', rest) = spanToNewline 0 str'\n           in (lexed ++ str'', rest)\n\n-- In all other cases, advance one character at a time\nspanToNewline n (c:str) =\n    let (str', rest) = spanToNewline n str\n    in (c:str', rest)\n\n\n-- | Turn a list of GHC's 'L.Token' (and their source 'String') into a list of\n-- Haddock's 'T.Token'.\nghcToks :: [(Located L.Token, String)] -> [T.Token]\nghcToks = reverse . (\\(_,ts,_) -> ts) . foldl' go (start, [], False)\n  where\n    start = mkRealSrcLoc (mkFastString \"lexing\") 1 1\n\n    go :: (RealSrcLoc, [T.Token], Bool)\n       -- ^ current position, tokens accumulated, currently in pragma (or not)\n       \n       -> (Located L.Token, String)\n       -- ^ next token, its content\n       \n       -> (RealSrcLoc, [T.Token], Bool)\n       -- ^ new position, new tokens accumulated, currently in pragma (or not)\n\n    go (pos, toks, in_prag) (L l tok, raw) =\n        ( next_pos\n        , classifiedTok ++ maybeToList white ++ toks\n        , inPragma in_prag tok\n        )\n       where\n         (next_pos, white) = mkWhitespace pos l\n         \n         classifiedTok = [ Token (classify' tok) raw rss\n                         | RealSrcSpan rss <- [l]\n                         , not (null raw)\n                         ]\n         \n         classify' | in_prag = const TkPragma\n                   | otherwise = classify\n\n\n-- | Find the correct amount of whitespace between tokens.\nmkWhitespace :: RealSrcLoc -> SrcSpan -> (RealSrcLoc, Maybe T.Token)\nmkWhitespace prev spn =\n  case spn of\n    UnhelpfulSpan _ -> (prev,Nothing)\n    RealSrcSpan s | null wsstring -> (end, Nothing)\n                  | otherwise -> (end, Just (Token TkSpace wsstring wsspan))\n      where\n        start = realSrcSpanStart s\n        end = realSrcSpanEnd s\n        wsspan = mkRealSrcSpan prev start\n        nls = srcLocLine start - srcLocLine prev\n        spaces = if nls == 0 then srcLocCol start - srcLocCol prev\n                             else srcLocCol start - 1\n        wsstring = replicate nls '\\n' ++ replicate spaces ' '\n\n\n-- | Classify given tokens as appropriate Haskell token type.\nclassify :: L.Token -> TokenType\nclassify tok =\n  case tok of\n    ITas                   -> TkKeyword\n    ITcase                 -> TkKeyword\n    ITclass                -> TkKeyword\n    ITdata                 -> TkKeyword\n    ITdefault              -> TkKeyword\n    ITderiving             -> TkKeyword\n    ITdo                   -> TkKeyword\n    ITelse                 -> TkKeyword\n    IThiding               -> TkKeyword\n    ITforeign              -> TkKeyword\n    ITif                   -> TkKeyword\n    ITimport               -> TkKeyword\n    ITin                   -> TkKeyword\n    ITinfix                -> TkKeyword\n    ITinfixl               -> TkKeyword\n    ITinfixr               -> TkKeyword\n    ITinstance             -> TkKeyword\n    ITlet                  -> TkKeyword\n    ITmodule               -> TkKeyword\n    ITnewtype              -> TkKeyword\n    ITof                   -> TkKeyword\n    ITqualified            -> TkKeyword\n    ITthen                 -> TkKeyword\n    ITtype                 -> TkKeyword\n    ITwhere                -> TkKeyword\n\n    ITforall            {} -> TkKeyword\n    ITexport               -> TkKeyword\n    ITlabel                -> TkKeyword\n    ITdynamic              -> TkKeyword\n    ITsafe                 -> TkKeyword\n    ITinterruptible        -> TkKeyword\n    ITunsafe               -> TkKeyword\n    ITstdcallconv          -> TkKeyword\n    ITccallconv            -> TkKeyword\n    ITcapiconv             -> TkKeyword\n    ITprimcallconv         -> TkKeyword\n    ITjavascriptcallconv   -> TkKeyword\n    ITmdo                  -> TkKeyword\n    ITfamily               -> TkKeyword\n    ITrole                 -> TkKeyword\n    ITgroup                -> TkKeyword\n    ITby                   -> TkKeyword\n    ITusing                -> TkKeyword\n    ITpattern              -> TkKeyword\n    ITstatic               -> TkKeyword\n    ITstock                -> TkKeyword\n    ITanyclass             -> TkKeyword\n\n    ITunit                 -> TkKeyword\n    ITsignature            -> TkKeyword\n    ITdependency           -> TkKeyword\n    ITrequires             -> TkKeyword\n\n    ITinline_prag       {} -> TkPragma\n    ITspec_prag         {} -> TkPragma\n    ITspec_inline_prag  {} -> TkPragma\n    ITsource_prag       {} -> TkPragma\n    ITrules_prag        {} -> TkPragma\n    ITwarning_prag      {} -> TkPragma\n    ITdeprecated_prag   {} -> TkPragma\n    ITline_prag         {} -> TkPragma\n    ITcolumn_prag       {} -> TkPragma\n    ITscc_prag          {} -> TkPragma\n    ITgenerated_prag    {} -> TkPragma\n    ITcore_prag         {} -> TkPragma\n    ITunpack_prag       {} -> TkPragma\n    ITnounpack_prag     {} -> TkPragma\n    ITann_prag          {} -> TkPragma\n    ITcomplete_prag     {} -> TkPragma\n    ITclose_prag           -> TkPragma\n    IToptions_prag      {} -> TkPragma\n    ITinclude_prag      {} -> TkPragma\n    ITlanguage_prag        -> TkPragma\n    ITvect_prag         {} -> TkPragma\n    ITvect_scalar_prag  {} -> TkPragma\n    ITnovect_prag       {} -> TkPragma\n    ITminimal_prag      {} -> TkPragma\n    IToverlappable_prag {} -> TkPragma\n    IToverlapping_prag  {} -> TkPragma\n    IToverlaps_prag     {} -> TkPragma\n    ITincoherent_prag   {} -> TkPragma\n    ITctype             {} -> TkPragma\n\n    ITdotdot               -> TkGlyph\n    ITcolon                -> TkGlyph\n    ITdcolon            {} -> TkGlyph\n    ITequal                -> TkGlyph\n    ITlam                  -> TkGlyph\n    ITlcase                -> TkGlyph\n    ITvbar                 -> TkGlyph\n    ITlarrow            {} -> TkGlyph\n    ITrarrow            {} -> TkGlyph\n    ITat                   -> TkGlyph\n    ITtilde                -> TkGlyph\n    ITtildehsh             -> TkGlyph\n    ITdarrow            {} -> TkGlyph\n    ITminus                -> TkGlyph\n    ITbang                 -> TkGlyph\n    ITdot                  -> TkOperator\n    ITtypeApp              -> TkGlyph\n\n    ITbiglam               -> TkGlyph\n\n    ITocurly               -> TkSpecial\n    ITccurly               -> TkSpecial\n    ITvocurly              -> TkSpecial\n    ITvccurly              -> TkSpecial\n    ITobrack               -> TkSpecial\n    ITopabrack             -> TkSpecial\n    ITcpabrack             -> TkSpecial\n    ITcbrack               -> TkSpecial\n    IToparen               -> TkSpecial\n    ITcparen               -> TkSpecial\n    IToubxparen            -> TkSpecial\n    ITcubxparen            -> TkSpecial\n    ITsemi                 -> TkSpecial\n    ITcomma                -> TkSpecial\n    ITunderscore           -> TkIdentifier\n    ITbackquote            -> TkSpecial\n    ITsimpleQuote          -> TkSpecial\n\n    ITvarid             {} -> TkIdentifier\n    ITconid             {} -> TkIdentifier\n    ITvarsym            {} -> TkOperator\n    ITconsym            {} -> TkOperator\n    ITqvarid            {} -> TkIdentifier\n    ITqconid            {} -> TkIdentifier\n    ITqvarsym           {} -> TkOperator\n    ITqconsym           {} -> TkOperator\n\n    ITdupipvarid        {} -> TkUnknown\n    ITlabelvarid        {} -> TkUnknown\n\n    ITchar              {} -> TkChar\n    ITstring            {} -> TkString\n    ITinteger           {} -> TkNumber\n    ITrational          {} -> TkNumber\n\n    ITprimchar          {} -> TkChar\n    ITprimstring        {} -> TkString\n    ITprimint           {} -> TkNumber\n    ITprimword          {} -> TkNumber\n    ITprimfloat         {} -> TkNumber\n    ITprimdouble        {} -> TkNumber\n\n    ITopenExpQuote      {} -> TkSpecial\n    ITopenPatQuote         -> TkSpecial\n    ITopenDecQuote         -> TkSpecial\n    ITopenTypQuote         -> TkSpecial\n    ITcloseQuote        {} -> TkSpecial\n    ITopenTExpQuote     {} -> TkSpecial\n    ITcloseTExpQuote       -> TkSpecial\n    ITidEscape          {} -> TkUnknown\n    ITparenEscape          -> TkSpecial\n    ITidTyEscape        {} -> TkUnknown\n    ITparenTyEscape        -> TkSpecial\n    ITtyQuote              -> TkSpecial\n    ITquasiQuote        {} -> TkUnknown\n    ITqQuasiQuote       {} -> TkUnknown\n\n    ITproc                 -> TkKeyword\n    ITrec                  -> TkKeyword\n    IToparenbar         {} -> TkGlyph\n    ITcparenbar         {} -> TkGlyph\n    ITlarrowtail        {} -> TkGlyph\n    ITrarrowtail        {} -> TkGlyph\n    ITLarrowtail        {} -> TkGlyph\n    ITRarrowtail        {} -> TkGlyph\n\n    ITunknown           {} -> TkUnknown\n    ITeof                  -> TkUnknown\n\n    -- Line comments are only supposed to start with '--'. Starting with '#'\n    -- means that this was probably a CPP.\n    ITlineComment s\n      | isCPPline s        -> TkCpp\n      | otherwise          -> TkComment\n\n    ITdocCommentNext    {} -> TkComment\n    ITdocCommentPrev    {} -> TkComment\n    ITdocCommentNamed   {} -> TkComment\n    ITdocSection        {} -> TkComment\n    ITdocOptions        {} -> TkComment\n\n    -- The lexer considers top-level pragmas as comments (see `pragState` in\n    -- the GHC lexer for more), so we have to manually reverse this. The\n    -- following is a hammer: it smashes _all_ pragma-like block comments into\n    -- pragmas.\n    ITblockComment c\n      | isPrefixOf \"{-#\" c\n      , isSuffixOf \"#-}\" c -> TkPragma\n      | otherwise          -> TkComment\n\n-- | Classify given tokens as beginning pragmas (or not).\ninPragma :: Bool     -- ^ currently in pragma\n         -> L.Token  -- ^ current token\n         -> Bool     -- ^ new information about whether we are in a pragma\ninPragma _ ITclose_prag = False\ninPragma True _ = True\ninPragma False tok =\n  case tok of\n    ITinline_prag       {} -> True\n    ITspec_prag         {} -> True\n    ITspec_inline_prag  {} -> True\n    ITsource_prag       {} -> True\n    ITrules_prag        {} -> True\n    ITwarning_prag      {} -> True\n    ITdeprecated_prag   {} -> True\n    ITline_prag         {} -> True\n    ITcolumn_prag       {} -> True\n    ITscc_prag          {} -> True\n    ITgenerated_prag    {} -> True\n    ITcore_prag         {} -> True\n    ITunpack_prag       {} -> True\n    ITnounpack_prag     {} -> True\n    ITann_prag          {} -> True\n    ITcomplete_prag     {} -> True\n    IToptions_prag      {} -> True\n    ITinclude_prag      {} -> True\n    ITlanguage_prag        -> True\n    ITvect_prag         {} -> True\n    ITvect_scalar_prag  {} -> True\n    ITnovect_prag       {} -> True\n    ITminimal_prag      {} -> True\n    IToverlappable_prag {} -> True\n    IToverlapping_prag  {} -> True\n    IToverlaps_prag     {} -> True\n    ITincoherent_prag   {} -> True\n    ITctype             {} -> True\n\n    _                      -> False\n\n", "num_lines": 446}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\nmodule Haddock.Backends.Hyperlinker.Renderer (render) where\n\n\nimport Haddock.Backends.Hyperlinker.Types\nimport Haddock.Backends.Hyperlinker.Utils\n\nimport qualified GHC\nimport qualified Name as GHC\nimport qualified Unique as GHC\n\nimport System.FilePath.Posix ((</>))\n\nimport Data.List\nimport Data.Maybe\nimport qualified Data.Map as Map\n\nimport Text.XHtml (Html, HtmlAttr, (!))\nimport qualified Text.XHtml as Html\n\n\ntype StyleClass = String\n\n\nrender :: Maybe FilePath -> Maybe FilePath -> SrcMap -> [RichToken]\n       -> Html\nrender mcss mjs srcs tokens = header mcss mjs <> body srcs tokens\n\nbody :: SrcMap -> [RichToken] -> Html\nbody srcs tokens = Html.body . Html.pre $ hypsrc\n  where\n    hypsrc = mconcat . map (richToken srcs) $ tokens\n\n\nheader :: Maybe FilePath -> Maybe FilePath -> Html\nheader mcss mjs\n    | isNothing mcss && isNothing mjs = Html.noHtml\nheader mcss mjs =\n    Html.header $ css mcss <> js mjs\n  where\n    css Nothing = Html.noHtml\n    css (Just cssFile) = Html.thelink Html.noHtml !\n        [ Html.rel \"stylesheet\"\n        , Html.thetype \"text/css\"\n        , Html.href cssFile\n        ]\n    js Nothing = Html.noHtml\n    js (Just scriptFile) = Html.script Html.noHtml !\n        [ Html.thetype \"text/javascript\"\n        , Html.src scriptFile\n        ]\n\n-- | Given information about the source position of definitions, render a token\nrichToken :: SrcMap -> RichToken -> Html\nrichToken srcs (RichToken Token{..} details)\n    | tkType == TkSpace = renderSpace (GHC.srcSpanStartLine tkSpan) tkValue\n    | otherwise = linked content\n  where\n    content = tokenSpan ! [ multiclass style ]\n    tokenSpan = Html.thespan (Html.toHtml tkValue)\n    style = tokenStyle tkType ++ maybe [] richTokenStyle details\n\n    -- If we have name information, we can make links\n    linked = case details of\n      Just d -> externalAnchor d . internalAnchor d . hyperlink srcs d\n      Nothing -> id\n\nrichTokenStyle :: TokenDetails -> [StyleClass]\nrichTokenStyle (RtkVar _) = [\"hs-var\"]\nrichTokenStyle (RtkType _) = [\"hs-type\"]\nrichTokenStyle _ = []\n\ntokenStyle :: TokenType -> [StyleClass]\ntokenStyle TkIdentifier = [\"hs-identifier\"]\ntokenStyle TkKeyword = [\"hs-keyword\"]\ntokenStyle TkString = [\"hs-string\"]\ntokenStyle TkChar = [\"hs-char\"]\ntokenStyle TkNumber = [\"hs-number\"]\ntokenStyle TkOperator = [\"hs-operator\"]\ntokenStyle TkGlyph = [\"hs-glyph\"]\ntokenStyle TkSpecial = [\"hs-special\"]\ntokenStyle TkSpace = []\ntokenStyle TkComment = [\"hs-comment\"]\ntokenStyle TkCpp = [\"hs-cpp\"]\ntokenStyle TkPragma = [\"hs-pragma\"]\ntokenStyle TkUnknown = []\n\nmulticlass :: [StyleClass] -> HtmlAttr\nmulticlass = Html.theclass . intercalate \" \"\n\nexternalAnchor :: TokenDetails -> Html -> Html\nexternalAnchor (RtkDecl name) content =\n    Html.anchor content ! [ Html.name $ externalAnchorIdent name ]\nexternalAnchor _ content = content\n\ninternalAnchor :: TokenDetails -> Html -> Html\ninternalAnchor (RtkBind name) content =\n    Html.anchor content ! [ Html.name $ internalAnchorIdent name ]\ninternalAnchor _ content = content\n\nexternalAnchorIdent :: GHC.Name -> String\nexternalAnchorIdent = hypSrcNameUrl\n\ninternalAnchorIdent :: GHC.Name -> String\ninternalAnchorIdent = (\"local-\" ++) . show . GHC.getKey . GHC.nameUnique\n\nhyperlink :: SrcMap -> TokenDetails -> Html -> Html\nhyperlink srcs details = case rtkName details of\n    Left name ->\n        if GHC.isInternalName name\n        then internalHyperlink name\n        else externalNameHyperlink srcs name\n    Right name -> externalModHyperlink srcs name\n\ninternalHyperlink :: GHC.Name -> Html -> Html\ninternalHyperlink name content =\n    Html.anchor content ! [ Html.href $ \"#\" ++ internalAnchorIdent name ]\n\nexternalNameHyperlink :: SrcMap -> GHC.Name -> Html -> Html\nexternalNameHyperlink srcs name content = case Map.lookup mdl srcs of\n    Just SrcLocal -> Html.anchor content !\n        [ Html.href $ hypSrcModuleNameUrl mdl name ]\n    Just (SrcExternal path) -> Html.anchor content !\n        [ Html.href $ path </> hypSrcModuleNameUrl mdl name ]\n    Nothing -> content\n  where\n    mdl = GHC.nameModule name\n\nexternalModHyperlink :: SrcMap -> GHC.ModuleName -> Html -> Html\nexternalModHyperlink srcs name content =\n    let srcs' = Map.mapKeys GHC.moduleName srcs in\n    case Map.lookup name srcs' of\n      Just SrcLocal -> Html.anchor content !\n        [ Html.href $ hypSrcModuleUrl' name ]\n      Just (SrcExternal path) -> Html.anchor content !\n        [ Html.href $ path </> hypSrcModuleUrl' name ]\n      Nothing -> content\n\n\nrenderSpace :: Int -> String -> Html\nrenderSpace _ [] = Html.noHtml\nrenderSpace line ('\\n':rest) = mconcat\n    [ Html.thespan . Html.toHtml $ \"\\n\"\n    , lineAnchor (line + 1)\n    , renderSpace (line + 1) rest\n    ]\nrenderSpace line space =\n    let (hspace, rest) = span (/= '\\n') space\n    in (Html.thespan . Html.toHtml) hspace <> renderSpace line rest\n\n\nlineAnchor :: Int -> Html\nlineAnchor line = Html.anchor Html.noHtml ! [ Html.name $ hypSrcLineUrl line ]\n", "num_lines": 155}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Haddock.Backends.Hyperlinker.Types where\n\n\nimport qualified GHC\n\nimport Data.Map (Map)\n\ndata Token = Token\n    { tkType :: TokenType\n    , tkValue :: String\n    , tkSpan :: {-# UNPACK #-} !Span\n    }\n    deriving (Show)\n\ntype Position = GHC.RealSrcLoc\ntype Span = GHC.RealSrcSpan\n\ndata TokenType\n    = TkIdentifier\n    | TkKeyword\n    | TkString\n    | TkChar\n    | TkNumber\n    | TkOperator\n    | TkGlyph\n    | TkSpecial\n    | TkSpace\n    | TkComment\n    | TkCpp\n    | TkPragma\n    | TkUnknown\n    deriving (Show, Eq)\n\n\ndata RichToken = RichToken\n    { rtkToken :: Token\n    , rtkDetails :: Maybe TokenDetails\n    }\n\ndata TokenDetails\n    = RtkVar GHC.Name\n    | RtkType GHC.Name\n    | RtkBind GHC.Name\n    | RtkDecl GHC.Name\n    | RtkModule GHC.ModuleName\n    deriving (Eq)\n\n\nrtkName :: TokenDetails -> Either GHC.Name GHC.ModuleName\nrtkName (RtkVar name) = Left name\nrtkName (RtkType name) = Left name\nrtkName (RtkBind name) = Left name\nrtkName (RtkDecl name) = Left name\nrtkName (RtkModule name) = Right name\n\n\n-- | Path for making cross-package hyperlinks in generated sources.\n--\n-- Used in 'SrcMap' to determine whether module originates in current package\n-- or in an external package.\ndata SrcPath\n    = SrcExternal FilePath\n    | SrcLocal\n\n-- | Mapping from modules to cross-package source paths.\ntype SrcMap = Map GHC.Module SrcPath\n\n", "num_lines": 68}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Haddock.Backends.Hyperlinker.Utils\n    ( hypSrcDir, hypSrcModuleFile, hypSrcModuleFile'\n    , hypSrcModuleUrl, hypSrcModuleUrl'\n    , hypSrcNameUrl\n    , hypSrcLineUrl\n    , hypSrcModuleNameUrl, hypSrcModuleLineUrl\n    , hypSrcModuleUrlFormat\n    , hypSrcModuleNameUrlFormat, hypSrcModuleLineUrlFormat\n    ) where\n\n\nimport Haddock.Backends.Xhtml.Utils\n\nimport GHC\nimport FastString\nimport System.FilePath.Posix ((</>))\n\n\nhypSrcDir :: FilePath\nhypSrcDir = \"src\"\n\nhypSrcModuleFile :: Module -> FilePath\nhypSrcModuleFile = hypSrcModuleFile' . moduleName\n\nhypSrcModuleFile' :: ModuleName -> FilePath\nhypSrcModuleFile' mdl = spliceURL'\n    Nothing (Just mdl) Nothing Nothing moduleFormat\n\nhypSrcModuleUrl :: Module -> String\nhypSrcModuleUrl = hypSrcModuleFile\n\nhypSrcModuleUrl' :: ModuleName -> String\nhypSrcModuleUrl' = hypSrcModuleFile'\n\nhypSrcNameUrl :: Name -> String\nhypSrcNameUrl name = spliceURL\n    Nothing Nothing (Just name) Nothing nameFormat\n\nhypSrcLineUrl :: Int -> String\nhypSrcLineUrl line = spliceURL\n    Nothing Nothing Nothing (Just spn) lineFormat\n  where\n    loc = mkSrcLoc nilFS line 1\n    spn = mkSrcSpan loc loc\n\nhypSrcModuleNameUrl :: Module -> Name -> String\nhypSrcModuleNameUrl mdl name = hypSrcModuleUrl mdl ++ \"#\" ++ hypSrcNameUrl name\n\nhypSrcModuleLineUrl :: Module -> Int -> String\nhypSrcModuleLineUrl mdl line = hypSrcModuleUrl mdl ++ \"#\" ++ hypSrcLineUrl line\n\nhypSrcModuleUrlFormat :: String\nhypSrcModuleUrlFormat = hypSrcDir </> moduleFormat\n\nhypSrcModuleNameUrlFormat :: String\nhypSrcModuleNameUrlFormat = hypSrcModuleUrlFormat ++ \"#\" ++ nameFormat\n\nhypSrcModuleLineUrlFormat :: String\nhypSrcModuleLineUrlFormat = hypSrcModuleUrlFormat ++ \"#\" ++ lineFormat\n\nmoduleFormat :: String\nmoduleFormat = \"%{MODULE}.html\"\n\nnameFormat :: String\nnameFormat = \"%{NAME}\"\n\nlineFormat :: String\nlineFormat = \"line-%{LINE}\"\n", "num_lines": 69}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TransformListComp #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE Rank2Types #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html.Decl\n-- Copyright   :  (c) Simon Marlow   2003-2006,\n--                    David Waern    2006-2009,\n--                    Mark Lentczner 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Xhtml.Decl (\n  ppDecl,\n\n  ppTyName, ppTyFamHeader, ppTypeApp, ppOrphanInstances,\n  tyvarNames\n) where\n\nimport Haddock.Backends.Xhtml.DocMarkup\nimport Haddock.Backends.Xhtml.Layout\nimport Haddock.Backends.Xhtml.Names\nimport Haddock.Backends.Xhtml.Types\nimport Haddock.Backends.Xhtml.Utils\nimport Haddock.GhcUtils\nimport Haddock.Types\nimport Haddock.Doc (combineDocumentation)\n\nimport           Data.List             ( intersperse, sort )\nimport qualified Data.Map as Map\nimport           Data.Maybe\nimport           Text.XHtml hiding     ( name, title, p, quote )\n\nimport GHC hiding (LexicalFixity(..))\nimport GHC.Exts\nimport Name\nimport BooleanFormula\nimport RdrName ( rdrNameOcc )\n\nppDecl :: Bool -> LinksInfo -> LHsDecl DocNameI\n       -> [(HsDecl DocNameI, DocForDecl DocName)]\n       -> DocForDecl DocName ->  [DocInstance DocNameI] -> [(DocName, Fixity)]\n       -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode\n       -> Maybe Package -> Qualification -> Html\nppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode pkg qual = case decl of\n  TyClD (FamDecl d)            -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode pkg qual\n  TyClD d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode pkg qual\n  TyClD d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode pkg qual\n  TyClD d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode pkg qual\n  SigD (TypeSig lnames lty)    -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames\n                                         (hsSigWcType lty) fixities splice unicode pkg qual\n  SigD (PatSynSig lnames ty)   -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames\n                                         ty fixities splice unicode pkg qual\n  ForD d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual\n  InstD _                      -> noHtml\n  DerivD _                     -> noHtml\n  _                            -> error \"declaration not supported by ppDecl\"\n\n\nppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->\n             [Located DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->\n             Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppLFunSig summary links loc doc lnames lty fixities splice unicode pkg qual =\n  ppFunSig summary links loc doc (map unLoc lnames) lty fixities\n           splice unicode pkg qual\n\nppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->\n            [DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->\n            Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppFunSig summary links loc doc docnames typ fixities splice unicode pkg qual =\n  ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ)\n            splice unicode pkg qual HideEmptyContexts\n  where\n    pp_typ = ppLType unicode qual HideEmptyContexts typ\n\nppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->\n             [Located DocName] -> LHsSigType DocNameI ->\n             [(DocName, Fixity)] ->\n             Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice\n          unicode pkg qual\n  | summary = pref1\n  | otherwise = topDeclElem links loc splice (map unLoc docnames) (pref1 <+> ppFixities fixities qual)\n                +++ docSection Nothing pkg qual doc\n  where\n    pref1 = hsep [ keyword \"pattern\"\n                 , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames\n                 , dcolon unicode\n                 , ppPatSigType unicode qual (hsSigType typ)\n                 ]\n\nppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->\n             [DocName] -> [(DocName, Fixity)] -> (HsType DocNameI, Html) ->\n             Splice -> Unicode -> Maybe Package -> Qualification -> HideEmptyContexts -> Html\nppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)\n          splice unicode pkg qual emptyCtxts =\n  ppTypeOrFunSig summary links loc docnames typ doc\n    ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode\n    , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames\n    , dcolon unicode\n    )\n    splice unicode pkg qual emptyCtxts\n  where\n    occnames = map (nameOccName . getName) docnames\n    addFixities html\n      | summary   = html\n      | otherwise = html <+> ppFixities fixities qual\n\n\nppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocNameI\n               -> DocForDecl DocName -> (Html, Html, Html)\n               -> Splice -> Unicode -> Maybe Package -> Qualification\n               -> HideEmptyContexts -> Html\nppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)\n               splice unicode pkg qual emptyCtxts\n  | summary = pref1\n  | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName pkg qual doc\n  | otherwise = topDeclElem links loc splice docnames pref2 +++\n      subArguments pkg qual (do_args 0 sep typ) +++ docSection curName pkg qual doc\n  where\n    curName = getName <$> listToMaybe docnames\n    argDoc n = Map.lookup n argDocs\n\n    do_largs n leader (L _ t) = do_args n leader t\n\n    do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]\n    do_args n leader (HsForAllTy tvs ltype)\n      = do_largs n leader' ltype\n      where\n        leader' = leader <+> ppForAll tvs unicode qual\n\n    do_args n leader (HsQualTy lctxt ltype)\n      | null (unLoc lctxt)\n      = do_largs n leader ltype\n      | otherwise\n      = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, [])\n        : do_largs n (darrow unicode) ltype\n\n    do_args n leader (HsFunTy lt r)\n      = (leader <+> ppLFunLhType unicode qual emptyCtxts lt, argDoc n, [])\n        : do_largs (n+1) (arrow unicode) r\n    do_args n leader t\n      = [(leader <+> ppType unicode qual emptyCtxts t, argDoc n, [])]\n\nppForAll :: [LHsTyVarBndr DocNameI] -> Unicode -> Qualification -> Html\nppForAll tvs unicode qual =\n  case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- tvs] of\n    [] -> noHtml\n    ts -> forallSymbol unicode <+> hsep ts +++ dot\n  where ppKTv n k = parens $\n          ppTyName (getName n) <+> dcolon unicode <+> ppLKind unicode qual k\n\nppFixities :: [(DocName, Fixity)] -> Qualification -> Html\nppFixities [] _ = noHtml\nppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge\n  where\n    ppFix (ns, p, d) = thespan ! [theclass \"fixity\"] <<\n                         (toHtml d <+> toHtml (show p) <+> ppNames ns)\n\n    ppDir InfixR = \"infixr\"\n    ppDir InfixL = \"infixl\"\n    ppDir InfixN = \"infix\"\n\n    ppNames = case fs of\n      _:[] -> const noHtml -- Don't display names for fixities on single names\n      _    -> concatHtml . intersperse (stringToHtml \", \") . map (ppDocName qual Infix False)\n\n    uniq_fs = [ (n, the p, the d') | (n, Fixity _ p d) <- fs\n                                   , let d' = ppDir d\n                                   , then group by Down (p,d') using groupWith ]\n\n    rightEdge = thespan ! [theclass \"rightedge\"] << noHtml\n\n\n-- | Pretty-print type variables.\nppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]\nppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs\n\ntyvarNames :: LHsQTyVars DocNameI -> [Name]\ntyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit\n\n\nppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName\n      -> ForeignDecl DocNameI -> [(DocName, Fixity)]\n      -> Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppFor summary links loc doc (ForeignImport (L _ name) typ _ _) fixities\n      splice unicode pkg qual\n  = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode pkg qual\nppFor _ _ _ _ _ _ _ _ _ _ = error \"ppFor\"\n\n\n-- we skip type patterns for now\nppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan\n        -> DocForDecl DocName -> TyClDecl DocNameI\n        -> Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars\n                                                , tcdRhs = ltype })\n        splice unicode pkg qual\n  = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc\n                   (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)\n                   splice unicode pkg qual ShowEmptyToplevelContexts\n  where\n    hdr  = hsep ([keyword \"type\", ppBinder summary occ]\n                 ++ ppTyVars unicode qual (hsQTvExplicit ltyvars))\n    full = hdr <+> equals <+> ppPatSigType unicode qual ltype\n    occ  = nameOccName . getName $ name\n    fixs\n      | summary   = noHtml\n      | otherwise = ppFixities fixities qual\nppTySyn _ _ _ _ _ _ _ _ _ _ = error \"declaration not supported by ppTySyn\"\n\n\nppTypeSig :: Bool -> [OccName] -> Html -> Unicode -> Html\nppTypeSig summary nms pp_ty unicode =\n  concatHtml htmlNames <+> dcolon unicode <+> pp_ty\n  where\n    htmlNames = intersperse (stringToHtml \", \") $ map (ppBinder summary) nms\n\n\nppTyName :: Name -> Html\nppTyName = ppName Prefix\n\n\nppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan\n            -> [DocName] -> HsType DocNameI\n            -> Html\nppSimpleSig links splice unicode qual emptyCtxts loc names typ =\n    topDeclElem' names $ ppTypeSig True occNames ppTyp unicode\n  where\n    topDeclElem' = topDeclElem links loc splice\n    ppTyp = ppType unicode qual emptyCtxts typ\n    occNames = map getOccName names\n\n\n--------------------------------------------------------------------------------\n-- * Type families\n--------------------------------------------------------------------------------\n\n\nppFamilyInfo :: Bool -> FamilyInfo DocNameI -> Html\nppFamilyInfo assoc OpenTypeFamily\n    | assoc = keyword \"type\"\n    | otherwise = keyword \"type family\"\nppFamilyInfo assoc DataFamily\n    | assoc = keyword \"data\"\n    | otherwise = keyword \"data family\"\nppFamilyInfo _ (ClosedTypeFamily _) = keyword \"type family\"\n\n\nppTyFamHeader :: Bool -> Bool -> FamilyDecl DocNameI\n              -> Unicode -> Qualification -> Html\nppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info\n                                               , fdResultSig = L _ result\n                                               , fdInjectivityAnn = injectivity })\n              unicode qual =\n  (case info of\n     OpenTypeFamily\n       | associated -> keyword \"type\"\n       | otherwise  -> keyword \"type family\"\n     DataFamily\n       | associated -> keyword \"data\"\n       | otherwise  -> keyword \"data family\"\n     ClosedTypeFamily _\n                    -> keyword \"type family\"\n  ) <+>\n\n  ppFamDeclBinderWithVars summary unicode qual d <+>\n  ppResultSig result unicode qual <+>\n\n  (case injectivity of\n     Nothing                   -> noHtml\n     Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn\n  ) <+>\n\n  (case info of\n     ClosedTypeFamily _ -> keyword \"where ...\"\n     _                  -> mempty\n  )\n\nppResultSig :: FamilyResultSig DocNameI -> Unicode -> Qualification -> Html\nppResultSig result unicode qual = case result of\n    NoSig               -> noHtml\n    KindSig kind        -> dcolon unicode  <+> ppLKind unicode qual kind\n    TyVarSig (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr\n\nppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocNameI\n                     -> Html\nppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =\n    ppFamilyInfo True pfdInfo <+>\n    ppAppNameTypes (unLoc pfdLName) (map unLoc pfdTyVars) unicode qual <+>\n    ppResultSig (unLoc pfdKindSig) unicode qual\n\nppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocNameI -> Html\nppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =\n    char '|' <+> ppLDocName qual Raw lhs <+> arrow unicode <+>\n    hsep (map (ppLDocName qual Raw) rhs)\n\n\nppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocNameI] ->\n           [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->\n           FamilyDecl DocNameI -> Splice -> Unicode -> Maybe Package ->\n           Qualification -> Html\nppTyFam summary associated links instances fixities loc doc decl splice unicode\n        pkg qual\n\n  | summary   = ppTyFamHeader True associated decl unicode qual\n  | otherwise = header_ +++ docSection Nothing pkg qual doc +++ instancesBit\n\n  where\n    docname = unLoc $ fdLName decl\n\n    header_ = topDeclElem links loc splice [docname] $\n       ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual\n\n    instancesBit\n      | FamilyDecl { fdInfo = ClosedTypeFamily mb_eqns } <- decl\n      , not summary\n      = subEquations pkg qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns\n\n      | otherwise\n      = ppInstances links (OriginFamily docname) instances splice unicode pkg qual\n\n    -- Individual equation of a closed type family\n    ppTyFamEqn :: TyFamInstEqn DocNameI -> SubDecl\n    ppTyFamEqn (HsIB { hsib_body = FamEqn { feqn_tycon = n, feqn_rhs = rhs\n                                          , feqn_pats = ts } })\n      = ( ppAppNameTypes (unLoc n) (map unLoc ts) unicode qual\n          <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)\n        , Nothing, [] )\n\n\n\nppPseudoFamilyDecl :: LinksInfo -> Splice -> Unicode -> Qualification\n                   -> PseudoFamilyDecl DocNameI\n                   -> Html\nppPseudoFamilyDecl links splice unicode qual\n                   decl@(PseudoFamilyDecl { pfdLName = L loc name, .. }) =\n    wrapper $ ppPseudoFamilyHeader unicode qual decl\n  where\n    wrapper = topDeclElem links loc splice [name]\n\n\n--------------------------------------------------------------------------------\n-- * Associated Types\n--------------------------------------------------------------------------------\n\n\nppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocNameI\n            -> [(DocName, Fixity)] -> Splice -> Unicode -> Maybe Package\n            -> Qualification -> Html\nppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual =\n   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode pkg qual\n\n\n--------------------------------------------------------------------------------\n-- * TyClDecl helpers\n--------------------------------------------------------------------------------\n\n-- | Print a type family and its variables\nppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocNameI -> Html\nppFamDeclBinderWithVars summ unicode qual (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =\n  ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (hsq_explicit tvs)\n\n-- | Print a newtype / data binder and its variables\nppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocNameI -> Html\nppDataBinderWithVars summ unicode qual decl =\n  ppAppDocNameTyVarBndrs summ unicode qual (tcdName decl) (hsQTvExplicit $ tcdTyVars decl)\n\n--------------------------------------------------------------------------------\n-- * Type applications\n--------------------------------------------------------------------------------\n\nppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocNameI] -> Html\nppAppDocNameTyVarBndrs summ unicode qual n vs =\n    ppTypeApp n vs ppDN (ppHsTyVarBndr unicode qual . unLoc)\n  where\n    ppDN notation = ppBinderFixity notation summ . nameOccName . getName\n    ppBinderFixity Infix = ppBinderInfix\n    ppBinderFixity _ = ppBinder\n\n-- | Print an application of a 'DocName' to its list of 'HsType's\nppAppNameTypes :: DocName -> [HsType DocNameI] -> Unicode -> Qualification -> Html\nppAppNameTypes n ts unicode qual =\n    ppTypeApp n ts (\\p -> ppDocName qual p True) (ppParendType unicode qual HideEmptyContexts)\n\n\n-- | General printing of type applications\nppTypeApp :: DocName -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html\nppTypeApp n (t1:t2:rest) ppDN ppT\n  | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)\n  | operator                    = opApp\n  where\n    operator = isNameSym . getName $ n\n    opApp = ppT t1 <+> ppDN Infix n <+> ppT t2\n\nppTypeApp n ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT ts)\n\n\n-------------------------------------------------------------------------------\n-- * Contexts\n-------------------------------------------------------------------------------\n\n\nppLContext, ppLContextNoArrow :: Located (HsContext DocNameI) -> Unicode\n                              -> Qualification -> HideEmptyContexts -> Html\nppLContext        = ppContext        . unLoc\nppLContextNoArrow = ppContextNoArrow . unLoc\n\nppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html\nppContextNoArrow cxt unicode qual emptyCtxts = fromMaybe noHtml $\n                                               ppContextNoLocsMaybe (map unLoc cxt) unicode qual emptyCtxts\n\n\nppContextNoLocs :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Html\nppContextNoLocs cxt unicode qual emptyCtxts = maybe noHtml (<+> darrow unicode) $\n                                              ppContextNoLocsMaybe cxt unicode qual emptyCtxts\n\n\nppContextNoLocsMaybe :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Maybe Html\nppContextNoLocsMaybe [] _ _ emptyCtxts =\n  case emptyCtxts of\n    HideEmptyContexts -> Nothing\n    ShowEmptyToplevelContexts -> Just (toHtml \"()\")\nppContextNoLocsMaybe cxt unicode qual _ = Just $ ppHsContext cxt unicode qual\n\nppContext :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html\nppContext cxt unicode qual emptyCtxts = ppContextNoLocs (map unLoc cxt) unicode qual emptyCtxts\n\n\nppHsContext :: [HsType DocNameI] -> Unicode -> Qualification -> Html\nppHsContext []  _       _    = noHtml\nppHsContext [p] unicode qual = ppCtxType unicode qual p\nppHsContext cxt unicode qual = parenList (map (ppType unicode qual HideEmptyContexts) cxt)\n\n\n-------------------------------------------------------------------------------\n-- * Class declarations\n-------------------------------------------------------------------------------\n\n\nppClassHdr :: Bool -> Located [LHsType DocNameI] -> DocName\n           -> LHsQTyVars DocNameI -> [Located ([Located DocName], [Located DocName])]\n           -> Unicode -> Qualification -> Html\nppClassHdr summ lctxt n tvs fds unicode qual =\n  keyword \"class\"\n  <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual HideEmptyContexts else noHtml)\n  <+> ppAppDocNameTyVarBndrs summ unicode qual n (hsQTvExplicit tvs)\n  <+> ppFds fds unicode qual\n\n\nppFds :: [Located ([Located DocName], [Located DocName])] -> Unicode -> Qualification -> Html\nppFds fds unicode qual =\n  if null fds then noHtml else\n        char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))\n  where\n        fundep (vars1,vars2) = ppVars vars1 <+> arrow unicode <+> ppVars vars2\n        ppVars = hsep . map ((ppDocName qual Prefix True) . unLoc)\n\nppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocNameI -> SrcSpan\n                 -> [(DocName, DocForDecl DocName)]\n                 -> Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs\n                                          , tcdFDs = fds, tcdSigs = sigs, tcdATs = ats }) loc\n    subdocs splice unicode pkg qual =\n  if not (any isUserLSig sigs) && null ats\n    then (if summary then id else topDeclElem links loc splice [nm]) hdr\n    else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword \"where\")\n      +++ shortSubDecls False\n          (\n            [ ppAssocType summary links doc at [] splice unicode pkg qual | at <- ats\n              , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]  ++\n\n                -- ToDo: add associated type defaults\n\n            [ ppFunSig summary links loc doc names (hsSigType typ)\n                       [] splice unicode pkg qual\n              | L _ (ClassOpSig False lnames typ) <- sigs\n              , let doc = lookupAnySubdoc (head names) subdocs\n                    names = map unLoc lnames ]\n              -- FIXME: is taking just the first name ok? Is it possible that\n              -- there are different subdocs for different names in a single\n              -- type signature?\n          )\n  where\n    hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode qual\n    nm  = unLoc lname\nppShortClassDecl _ _ _ _ _ _ _ _ _ = error \"declaration type not supported by ppShortClassDecl\"\n\n\n\nppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)]\n            -> SrcSpan -> Documentation DocName\n            -> [(DocName, DocForDecl DocName)] -> TyClDecl DocNameI\n            -> Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppClassDecl summary links instances fixities loc d subdocs\n        decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars\n                        , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats })\n            splice unicode pkg qual\n  | summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual\n  | otherwise = classheader +++ docSection Nothing pkg qual d\n                  +++ minimalBit +++ atBit +++ methodBit +++ instancesBit\n  where\n    sigs = map unLoc lsigs\n\n    classheader\n      | any isUserLSig lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword \"where\" <+> fixs)\n      | otherwise = topDeclElem links loc splice [nm] (hdr unicode qual <+> fixs)\n\n    -- Only the fixity relevant to the class header\n    fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual\n\n    nm   = tcdName decl\n\n    hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds\n\n    -- ToDo: add assocatied typ defaults\n    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode pkg qual\n                      | at <- ats\n                      , let n = unL . fdLName $ unL at\n                            doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs\n                            subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]\n\n    methodBit = subMethods [ ppFunSig summary links loc doc [name] (hsSigType typ)\n                                      subfixs splice unicode pkg qual\n                           | L _ (ClassOpSig _ lnames typ) <- lsigs\n                           , name <- map unLoc lnames\n                           , let doc = lookupAnySubdoc name subdocs\n                                 subfixs = [ f | f@(n',_) <- fixities\n                                               , name == n' ]\n                           ]\n                           -- N.B. taking just the first name is ok. Signatures with multiple names\n                           -- are expanded so that each name gets its own signature.\n\n    minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of\n      -- Miminal complete definition = every shown method\n      And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==\n                   sort [getName n | ClassOpSig _ ns _ <- sigs, L _ n <- ns]\n        -> noHtml\n\n      -- Minimal complete definition = the only shown method\n      Var (L _ n) : _ | [getName n] ==\n                        [getName n' | L _ (ClassOpSig _ ns _) <- lsigs, L _ n' <- ns]\n        -> noHtml\n\n      -- Minimal complete definition = nothing\n      And [] : _ -> subMinimal $ toHtml \"Nothing\"\n\n      m : _  -> subMinimal $ ppMinimal False m\n      _ -> noHtml\n\n    ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n\n    ppMinimal _ (And fs) = foldr1 (\\a b -> a+++\", \"+++b) $ map (ppMinimal True . unLoc) fs\n    ppMinimal p (Or fs) = wrap $ foldr1 (\\a b -> a+++\" | \"+++b) $ map (ppMinimal False . unLoc) fs\n      where wrap | p = parens | otherwise = id\n    ppMinimal p (Parens x) = ppMinimal p (unLoc x)\n\n    instancesBit = ppInstances links (OriginClass nm) instances\n        splice unicode pkg qual\n\nppClassDecl _ _ _ _ _ _ _ _ _ _ _ _ = error \"declaration type not supported by ppShortClassDecl\"\n\n\nppInstances :: LinksInfo\n            -> InstOrigin DocName -> [DocInstance DocNameI]\n            -> Splice -> Unicode -> Maybe Package -> Qualification\n            -> Html\nppInstances links origin instances splice unicode pkg qual\n  = subInstances pkg qual instName links True (zipWith instDecl [1..] instances)\n  -- force Splice = True to use line URLs\n  where\n    instName = getOccString origin\n    instDecl :: Int -> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)\n    instDecl no (inst, mdoc, loc, mdl) =\n        ((ppInstHead links splice unicode qual mdoc origin False no inst mdl), mdl, loc)\n\n\nppOrphanInstances :: LinksInfo\n                  -> [DocInstance DocNameI]\n                  -> Splice -> Unicode -> Maybe Package -> Qualification\n                  -> Html\nppOrphanInstances links instances splice unicode pkg qual\n  = subOrphanInstances pkg qual links True (zipWith instDecl [1..] instances)\n  where\n    instOrigin :: InstHead name -> InstOrigin (IdP name)\n    instOrigin inst = OriginClass (ihdClsName inst)\n\n    instDecl :: Int -> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)\n    instDecl no (inst, mdoc, loc, mdl) =\n        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst Nothing), mdl, loc)\n\n\nppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification\n           -> Maybe (MDoc DocName)\n           -> InstOrigin DocName\n           -> Bool -- ^ Is instance orphan\n           -> Int  -- ^ Normal\n           -> InstHead DocNameI\n           -> Maybe Module\n           -> SubDecl\nppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) mdl =\n    case ihdInstType of\n        ClassInst { .. } ->\n            ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual HideEmptyContexts <+> typ\n            , mdoc\n            , [subInstDetails iid ats sigs mname]\n            )\n          where\n            sigs = ppInstanceSigs links splice unicode qual clsiSigs\n            ats = ppInstanceAssocTys links splice unicode qual clsiAssocTys\n        TypeInst rhs ->\n            ( subInstHead iid ptype\n            , mdoc\n            , [subFamInstDetails iid prhs mname]\n            )\n          where\n            ptype = keyword \"type\" <+> typ\n            prhs = ptype <+> maybe noHtml\n                                   (\\t -> equals <+> ppType unicode qual HideEmptyContexts t) rhs\n        DataInst dd ->\n            ( subInstHead iid pdata\n            , mdoc\n            , [subFamInstDetails iid pdecl mname])\n          where\n            pdata = keyword \"data\" <+> typ\n            pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual\n  where\n    mname = maybe noHtml (\\m -> toHtml \"Defined in\" <+> ppModule m) mdl\n    iid = instanceId origin no orphan ihd\n    typ = ppAppNameTypes ihdClsName ihdTypes unicode qual\n\n\nppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification\n                   -> [PseudoFamilyDecl DocNameI]\n                   -> [Html]\nppInstanceAssocTys links splice unicode qual =\n    map ppFamilyDecl'\n  where\n    ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual\n\n\nppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification\n              -> [Sig DocNameI]\n              -> [Html]\nppInstanceSigs links splice unicode qual sigs = do\n    TypeSig lnames typ <- sigs\n    let names = map unLoc lnames\n        L _ rtyp = hsSigWcType typ\n    -- Instance methods signatures are synified and thus don't have a useful\n    -- SrcSpan value. Use the methods name location instead.\n    return $ ppSimpleSig links splice unicode qual HideEmptyContexts (getLoc $ head $ lnames) names rtyp\n\n\nlookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2\nlookupAnySubdoc n = fromMaybe noDocForDecl . lookup n\n\n\ninstanceId :: InstOrigin DocName -> Int -> Bool -> InstHead DocNameI -> String\ninstanceId origin no orphan ihd = concat $\n    [ \"o:\" | orphan ] ++\n    [ qual origin\n    , \":\" ++ getOccString origin\n    , \":\" ++ (occNameString . getOccName . ihdClsName) ihd\n    , \":\" ++ show no\n    ]\n  where\n    qual (OriginClass _) = \"ic\"\n    qual (OriginData _) = \"id\"\n    qual (OriginFamily _) = \"if\"\n\n\n-------------------------------------------------------------------------------\n-- * Data & newtype declarations\n-------------------------------------------------------------------------------\n\n\n-- TODO: print contexts\nppShortDataDecl :: Bool -> Bool -> TyClDecl DocNameI\n                -> [(HsDecl DocNameI, DocForDecl DocName)]\n                -> Unicode -> Qualification -> Html\nppShortDataDecl summary dataInst dataDecl pats unicode qual\n\n  | [] <- cons\n  , [] <- pats = dataHeader\n\n  | [lcon] <- cons, [] <- pats, isH98,\n    (cHead,cBody,cFoot) <- ppShortConstrParts summary dataInst (unLoc lcon) unicode qual\n       = (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot\n\n  | [] <- pats, isH98 = dataHeader\n      +++ shortSubDecls dataInst (zipWith doConstr ('=':repeat '|') cons ++ pats1)\n\n  | otherwise = (dataHeader <+> keyword \"where\")\n      +++ shortSubDecls dataInst (map doGADTConstr cons ++ pats1)\n\n  where\n    dataHeader\n      | dataInst  = noHtml\n      | otherwise = ppDataHeader summary dataDecl unicode qual\n    doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual\n    doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual\n\n    cons      = dd_cons (tcdDataDefn dataDecl)\n    isH98     = case unLoc (head cons) of\n                  ConDeclH98 {} -> True\n                  ConDeclGADT{} -> False\n\n    pats1 = [ hsep [ keyword \"pattern\"\n                   , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames\n                   , dcolon unicode\n                   , ppPatSigType unicode qual (hsSigType typ)\n                   ]\n            | (SigD (PatSynSig lnames typ),_) <- pats\n            ]\n\n\nppDataDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)] ->\n              [(DocName, DocForDecl DocName)] ->\n              SrcSpan -> Documentation DocName -> TyClDecl DocNameI ->\n              [(HsDecl DocNameI, DocForDecl DocName)] ->\n              Splice -> Unicode -> Maybe Package -> Qualification -> Html\nppDataDecl summary links instances fixities subdocs loc doc dataDecl pats\n           splice unicode pkg qual\n\n  | summary   = ppShortDataDecl summary False dataDecl pats unicode qual\n  | otherwise = header_ +++ docSection Nothing pkg qual doc +++ constrBit +++ patternBit +++ instancesBit\n\n  where\n    docname   = tcdName dataDecl\n    cons      = dd_cons (tcdDataDefn dataDecl)\n    isH98     = case unLoc (head cons) of\n                  ConDeclH98 {} -> True\n                  ConDeclGADT{} -> False\n\n    header_ = topDeclElem links loc splice [docname] $\n             ppDataHeader summary dataDecl unicode qual <+> whereBit <+> fix\n\n    fix = ppFixities (filter (\\(n,_) -> n == docname) fixities) qual\n\n    whereBit\n      | null cons\n      , null pats = noHtml\n      | null cons = keyword \"where\"\n      | otherwise = if isH98 then noHtml else keyword \"where\"\n\n    constrBit = subConstructors pkg qual\n      [ ppSideBySideConstr subdocs subfixs unicode pkg qual c\n      | c <- cons\n      , let subfixs = filter (\\(n,_) -> any (\\cn -> cn == n)\n                                     (map unLoc (getConNames (unLoc c)))) fixities\n      ]\n\n    patternBit = subPatterns pkg qual\n      [ (hsep [ keyword \"pattern\"\n              , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames\n              , dcolon unicode\n              , ppPatSigType unicode qual (hsSigType typ)\n              ] <+> ppFixities subfixs qual\n        ,combineDocumentation (fst d), [])\n      | (SigD (PatSynSig lnames typ),d) <- pats\n      , let subfixs = filter (\\(n,_) -> any (\\cn -> cn == n) (map unLoc lnames)) fixities\n      ]\n\n    instancesBit = ppInstances links (OriginData docname) instances\n        splice unicode pkg qual\n\n\n\nppShortConstr :: Bool -> ConDecl DocNameI -> Unicode -> Qualification -> Html\nppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot\n  where\n    (cHead,cBody,cFoot) = ppShortConstrParts summary False con unicode qual\n\n\n-- returns three pieces: header, body, footer so that header & footer can be\n-- incorporated into the declaration\nppShortConstrParts :: Bool -> Bool -> ConDecl DocNameI -> Unicode -> Qualification -> (Html, Html, Html)\nppShortConstrParts summary dataInst con unicode qual = case con of\n  ConDeclH98{} -> case con_details con of\n    PrefixCon args ->\n      (header_ unicode qual +++ hsep (ppOcc\n            : map (ppLParendType unicode qual HideEmptyContexts) args), noHtml, noHtml)\n    RecCon (L _ fields) ->\n      (header_ unicode qual +++ ppOcc <+> char '{',\n       doRecordFields fields,\n       char '}')\n    InfixCon arg1 arg2 ->\n      (header_ unicode qual +++ hsep [ppLParendType unicode qual HideEmptyContexts arg1,\n            ppOccInfix, ppLParendType unicode qual HideEmptyContexts arg2],\n       noHtml, noHtml)\n\n  ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts resTy,noHtml,noHtml)\n\n  where\n    resTy = hsib_body (con_type con)\n\n    doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) (map unLoc fields))\n\n    header_  = ppConstrHdr forall_ tyVars context\n    occ        = map (nameOccName . getName . unLoc) $ getConNames con\n\n    ppOcc      = case occ of\n      [one] -> ppBinder summary one\n      _     -> hsep (punctuate comma (map (ppBinder summary) occ))\n\n    ppOccInfix = case occ of\n      [one] -> ppBinderInfix summary one\n      _     -> hsep (punctuate comma (map (ppBinderInfix summary) occ))\n\n    ltvs     = fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)\n    tyVars   = tyvarNames ltvs\n    lcontext = fromMaybe (noLoc []) (con_cxt con)\n    context  = unLoc lcontext\n    forall_  = False\n\n\n-- ppConstrHdr is for (non-GADT) existentials constructors' syntax\nppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Unicode\n            -> Qualification -> Html\nppConstrHdr forall_ tvs ctxt unicode qual\n = (if null tvs then noHtml else ppForall)\n   +++\n   (if null ctxt then noHtml\n    else ppContextNoArrow ctxt unicode qual HideEmptyContexts\n         <+> darrow unicode +++ toHtml \" \")\n  where\n    ppForall | forall_   = forallSymbol unicode <+> hsep (map (ppName Prefix) tvs)\n                           <+> toHtml \". \"\n             | otherwise = noHtml\n\nppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]\n                   -> Unicode -> Maybe Package -> Qualification -> LConDecl DocNameI -> SubDecl\nppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)\n = (decl, mbDoc, fieldPart)\n where\n    decl = case con of\n      ConDeclH98{} -> case con_details con of\n        PrefixCon args ->\n          hsep ((header_ +++ ppOcc)\n            : map (ppLParendType unicode qual HideEmptyContexts) args)\n          <+> fixity\n\n        RecCon _ -> header_ +++ ppOcc <+> fixity\n\n        InfixCon arg1 arg2 ->\n          hsep [header_ +++ ppLParendType unicode qual HideEmptyContexts arg1,\n            ppOccInfix,\n            ppLParendType unicode qual HideEmptyContexts arg2]\n          <+> fixity\n\n      ConDeclGADT{} -> doGADTCon resTy\n\n    resTy = hsib_body (con_type con)\n\n    fieldPart = case getConDetails con of\n        RecCon (L _ fields) -> [doRecordFields fields]\n        _ -> []\n\n    doRecordFields fields = subFields pkg qual\n      (map (ppSideBySideField subdocs unicode qual) (map unLoc fields))\n\n    doGADTCon :: Located (HsType DocNameI) -> Html\n    doGADTCon ty = ppOcc <+> dcolon unicode\n        -- ++AZ++ make this prepend \"{..}\" when it is a record style GADT\n        <+> ppLType unicode qual HideEmptyContexts ty\n        <+> fixity\n\n    fixity  = ppFixities fixities qual\n    header_ = ppConstrHdr forall_ tyVars context unicode qual\n    occ       = map (nameOccName . getName . unLoc) $ getConNames con\n\n    ppOcc     = case occ of\n      [one] -> ppBinder False one\n      _     -> hsep (punctuate comma (map (ppBinder False) occ))\n\n    ppOccInfix = case occ of\n      [one] -> ppBinderInfix False one\n      _     -> hsep (punctuate comma (map (ppBinderInfix False) occ))\n\n    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))\n    context = unLoc (fromMaybe (noLoc []) (con_cxt con))\n    forall_ = False\n    -- don't use \"con_doc con\", in case it's reconstructed from a .hi file,\n    -- or also because we want Haddock to do the doc-parsing, not GHC.\n    mbDoc = lookup (unLoc $ head $ getConNames con) subdocs >>=\n            combineDocumentation . fst\n\n\nppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification\n                  -> ConDeclField DocNameI -> SubDecl\nppSideBySideField subdocs unicode qual (ConDeclField names ltype _) =\n  ( hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))\n      <+> dcolon unicode\n      <+> ppLType unicode qual HideEmptyContexts ltype\n  , mbDoc\n  , []\n  )\n  where\n    -- don't use cd_fld_doc for same reason we don't use con_doc above\n    -- Where there is more than one name, they all have the same documentation\n    mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst\n\n\nppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html\nppShortField summary unicode qual (ConDeclField names ltype _)\n  = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names))\n    <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype\n\n\n-- | Print the LHS of a data\\/newtype declaration.\n-- Currently doesn't handle 'data instance' decls or kind signatures\nppDataHeader :: Bool -> TyClDecl DocNameI -> Unicode -> Qualification -> Html\nppDataHeader summary decl@(DataDecl { tcdDataDefn =\n                                         HsDataDefn { dd_ND = nd\n                                                    , dd_ctxt = ctxt\n                                                    , dd_kindSig = ks } })\n             unicode qual\n  = -- newtype or data\n    (case nd of { NewType -> keyword \"newtype\"; DataType -> keyword \"data\" })\n    <+>\n    -- context\n    ppLContext ctxt unicode qual HideEmptyContexts <+>\n    -- T a b c ..., or a :+: b\n    ppDataBinderWithVars summary unicode qual decl\n    <+> case ks of\n      Nothing -> mempty\n      Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x\n\nppDataHeader _ _ _ _ = error \"ppDataHeader: illegal argument\"\n\n--------------------------------------------------------------------------------\n-- * Types and contexts\n--------------------------------------------------------------------------------\n\n\nppBang :: HsSrcBang -> Html\nppBang (HsSrcBang _ _ SrcStrict) = toHtml \"!\"\nppBang (HsSrcBang _ _ SrcLazy)   = toHtml \"~\"\nppBang _                         = noHtml\n\n\ntupleParens :: HsTupleSort -> [Html] -> Html\ntupleParens HsUnboxedTuple = ubxParenList\ntupleParens _              = parenList\n\n\nsumParens :: [Html] -> Html\nsumParens = ubxSumList\n\n--------------------------------------------------------------------------------\n-- * Rendering of HsType\n--------------------------------------------------------------------------------\n\n\npREC_TOP, pREC_CTX, pREC_FUN, pREC_OP, pREC_CON :: Int\n\npREC_TOP = 0 :: Int   -- type in ParseIface.y in GHC\npREC_CTX = 1 :: Int   -- Used for single contexts, eg. ctx => type\n                      -- (as opposed to (ctx1, ctx2) => type)\npREC_FUN = 2 :: Int   -- btype in ParseIface.y in GHC\n                      -- Used for LH arg of (->)\npREC_OP  = 3 :: Int   -- Used for arg of any infix operator\n                      -- (we don't keep their fixities around)\npREC_CON = 4 :: Int   -- Used for arg of type applicn:\n                      -- always parenthesise unless atomic\n\nmaybeParen :: Int           -- Precedence of context\n           -> Int           -- Precedence of top-level operator\n           -> Html -> Html  -- Wrap in parens if (ctxt >= op)\nmaybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p\n                               | otherwise            = p\n\n\nppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> Located (HsType DocNameI) -> Html\nppLType       unicode qual emptyCtxts y = ppType unicode qual emptyCtxts (unLoc y)\nppLParendType unicode qual emptyCtxts y = ppParendType unicode qual emptyCtxts (unLoc y)\nppLFunLhType  unicode qual emptyCtxts y = ppFunLhType unicode qual emptyCtxts (unLoc y)\n\nppCtxType :: Unicode -> Qualification -> HsType DocNameI -> Html\nppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual HideEmptyContexts\n\nppType, ppParendType, ppFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html\nppType       unicode qual emptyCtxts ty = ppr_mono_ty pREC_TOP ty unicode qual emptyCtxts\nppParendType unicode qual emptyCtxts ty = ppr_mono_ty pREC_CON ty unicode qual emptyCtxts\nppFunLhType  unicode qual emptyCtxts ty = ppr_mono_ty pREC_FUN ty unicode qual emptyCtxts\n\nppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html\nppHsTyVarBndr _       qual (UserTyVar (L _ name)) =\n    ppDocName qual Raw False name\nppHsTyVarBndr unicode qual (KindedTyVar name kind) =\n    parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>\n            ppLKind unicode qual kind)\n\nppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html\nppLKind unicode qual y = ppKind unicode qual (unLoc y)\n\nppKind :: Unicode -> Qualification -> HsKind DocNameI -> Html\nppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual HideEmptyContexts\n\nppPatSigType :: Unicode -> Qualification -> LHsType DocNameI -> Html\nppPatSigType unicode qual typ =\n  let emptyCtxts =\n        if hasNonEmptyContext typ && isFirstContextEmpty typ\n          then ShowEmptyToplevelContexts\n          else HideEmptyContexts\n  in ppLType unicode qual emptyCtxts typ\n  where\n    hasNonEmptyContext :: LHsType name -> Bool\n    hasNonEmptyContext t =\n      case unLoc t of\n        HsForAllTy _ s -> hasNonEmptyContext s\n        HsQualTy cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True\n        HsFunTy _ s -> hasNonEmptyContext s\n        _ -> False\n    isFirstContextEmpty :: LHsType name -> Bool\n    isFirstContextEmpty t =\n      case unLoc t of\n        HsForAllTy _ s -> isFirstContextEmpty s\n        HsQualTy cxt _ -> null (unLoc cxt)\n        HsFunTy _ s -> isFirstContextEmpty s\n        _ -> False\n\nppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> Html\nppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot\n\nppr_mono_lty :: Int -> LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html\nppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)\n\n\nppr_mono_ty :: Int -> HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html\nppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual emptyCtxts\n  = maybeParen ctxt_prec pREC_FUN $\n    ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts\n\nppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual emptyCtxts\n  = maybeParen ctxt_prec pREC_FUN $\n    ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts\n\n-- UnicodeSyntax alternatives\nppr_mono_ty _ (HsTyVar _ (L _ name)) True _ _\n  | getOccString (getName name) == \"*\"    = toHtml \"\u00e2\u02dc\u2026\"\n  | getOccString (getName name) == \"(->)\" = toHtml \"(\u00e2\u2020\u2019)\"\n\nppr_mono_ty _         (HsBangTy b ty)     u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty\nppr_mono_ty _         (HsTyVar _ (L _ name)) _ q _ = ppDocName q Prefix True name\nppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e\nppr_mono_ty _         (HsTupleTy con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys)\nppr_mono_ty _         (HsSumTy tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys)\nppr_mono_ty _         (HsKindSig ty kind) u q e =\n    parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind)\nppr_mono_ty _         (HsListTy ty)       u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)\nppr_mono_ty _         (HsPArrTy ty)       u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)\nppr_mono_ty ctxt_prec (HsIParamTy (L _ n) ty) u q _ =\n    maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts\nppr_mono_ty _         (HsSpliceTy {})     _ _ _ = error \"ppr_mono_ty HsSpliceTy\"\nppr_mono_ty _         (HsRecTy {})        _ _ _ = toHtml \"{..}\"\n       -- Can now legally occur in ConDeclGADT, the output here is to provide a\n       -- placeholder in the signature, which is followed by the field\n       -- declarations.\nppr_mono_ty _         (HsCoreTy {})       _ _ _ = error \"ppr_mono_ty HsCoreTy\"\nppr_mono_ty _         (HsExplicitListTy Promoted _ tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys\nppr_mono_ty _         (HsExplicitListTy NotPromoted _ tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys\nppr_mono_ty _         (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys\nppr_mono_ty _         (HsAppsTy {})       _ _ _ = error \"ppr_mono_ty HsAppsTy\"\n\nppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual _\n  = maybeParen ctxt_prec pREC_CTX $\n    ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts\n\nppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual _\n  = maybeParen ctxt_prec pREC_CON $\n    hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual HideEmptyContexts, ppr_mono_lty pREC_CON arg_ty unicode qual HideEmptyContexts]\n\nppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual _\n  = maybeParen ctxt_prec pREC_FUN $\n    ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts\n  where\n    -- `(:)` is valid in type signature only as constructor to promoted list\n    -- and needs to be quoted in code so we explicitly quote it here too.\n    ppr_op\n        | (getOccString . getName . unLoc) op == \":\" = promoQuote ppr_op'\n        | otherwise = ppr_op'\n    ppr_op' = ppLDocName qual Infix op\n\nppr_mono_ty ctxt_prec (HsParTy ty) unicode qual emptyCtxts\n--  = parens (ppr_mono_lty pREC_TOP ty)\n  = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts\n\nppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual emptyCtxts\n  = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts\n\nppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_'\nppr_mono_ty _ (HsTyLit n) _ _ _ = ppr_tylit n\n\nppr_tylit :: HsTyLit -> Html\nppr_tylit (HsNumTy _ n) = toHtml (show n)\nppr_tylit (HsStrTy _ s) = toHtml (show s)\n\nppr_fun_ty :: Int -> LHsType DocNameI -> LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html\nppr_fun_ty ctxt_prec ty1 ty2 unicode qual emptyCtxts\n  = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual HideEmptyContexts\n        p2 = ppr_mono_lty pREC_TOP ty2 unicode qual emptyCtxts\n    in\n    maybeParen ctxt_prec pREC_FUN $\n    hsep [p1, arrow unicode <+> p2]\n", "num_lines": 1108}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html.DocMarkup\n-- Copyright   :  (c) Simon Marlow   2003-2006,\n--                    David Waern    2006-2009,\n--                    Mark Lentczner 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Xhtml.DocMarkup (\n  docToHtml,\n  rdrDocToHtml,\n  origDocToHtml,\n  docToHtmlNoAnchors,\n\n  docElement, docSection, docSection_,\n) where\n\nimport Data.List\nimport Documentation.Haddock.Markup\nimport Haddock.Backends.Xhtml.Names\nimport Haddock.Backends.Xhtml.Utils\nimport Haddock.Types\nimport Haddock.Utils\nimport Haddock.Doc (combineDocumentation, emptyMetaDoc,\n                    metaDocAppend, metaConcat)\n\nimport Text.XHtml hiding ( name, p, quote )\nimport Data.Maybe (fromMaybe)\n\nimport GHC\nimport Name\n\n\nparHtmlMarkup :: Qualification -> Bool\n              -> (Bool -> a -> Html) -> DocMarkup a Html\nparHtmlMarkup qual insertAnchors ppId = Markup {\n  markupEmpty                = noHtml,\n  markupString               = toHtml,\n  markupParagraph            = paragraph,\n  markupAppend               = (+++),\n  markupIdentifier           = thecode . ppId insertAnchors,\n  markupIdentifierUnchecked  = thecode . ppUncheckedLink qual,\n  markupModule               = \\m -> let (mdl,ref) = break (=='#') m\n                                         -- Accomodate for old style\n                                         -- foo\\#bar anchors\n                                         mdl' = case reverse mdl of\n                                           '\\\\':_ -> init mdl\n                                           _ -> mdl\n                                     in ppModuleRef (mkModuleName mdl') ref,\n  markupWarning              = thediv ! [theclass \"warning\"],\n  markupEmphasis             = emphasize,\n  markupBold                 = strong,\n  markupMonospaced           = thecode,\n  markupUnorderedList        = unordList,\n  markupOrderedList          = ordList,\n  markupDefList              = defList,\n  markupCodeBlock            = pre,\n  markupHyperlink            = \\(Hyperlink url mLabel)\n                               -> if insertAnchors\n                                  then anchor ! [href url]\n                                       << fromMaybe url mLabel\n                                  else toHtml $ fromMaybe url mLabel,\n  markupAName                = \\aname\n                               -> if insertAnchors\n                                  then namedAnchor aname << \"\"\n                                  else noHtml,\n  markupPic                  = \\(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)),\n  markupMathInline           = \\mathjax -> toHtml (\"\\\\(\" ++ mathjax ++ \"\\\\)\"),\n  markupMathDisplay          = \\mathjax -> toHtml (\"\\\\[\" ++ mathjax ++ \"\\\\]\"),\n  markupProperty             = pre . toHtml,\n  markupExample              = examplesToHtml,\n  markupHeader               = \\(Header l t) -> makeHeader l t,\n  markupTable                = \\(Table h r) -> makeTable h r\n  }\n  where\n    makeHeader :: Int -> Html -> Html\n    makeHeader 1 mkup = h1 mkup\n    makeHeader 2 mkup = h2 mkup\n    makeHeader 3 mkup = h3 mkup\n    makeHeader 4 mkup = h4 mkup\n    makeHeader 5 mkup = h5 mkup\n    makeHeader 6 mkup = h6 mkup\n    makeHeader l _ = error $ \"Somehow got a header level `\" ++ show l ++ \"' in DocMarkup!\"\n\n    makeTable :: [TableRow Html] -> [TableRow Html] -> Html\n    makeTable hs bs = table (concatHtml (hs' ++ bs'))\n      where\n        hs' | null hs   = []\n            | otherwise = [thead (concatHtml (map (makeTableRow th) hs))]\n\n        bs' = [tbody (concatHtml (map (makeTableRow td) bs))]\n\n    makeTableRow :: (Html -> Html) -> TableRow Html -> Html\n    makeTableRow thr (TableRow cs) = tr (concatHtml (map (makeTableCell thr) cs))\n\n    makeTableCell :: (Html -> Html) -> TableCell Html -> Html\n    makeTableCell thr (TableCell i j c) = thr c ! (i' ++ j')\n      where\n        i' = if i == 1 then [] else [ colspan i ]\n        j' = if j == 1 then [] else [ rowspan j ]\n\n    examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass \"screen\"]\n\n    exampleToHtml (Example expression result) = htmlExample\n      where\n        htmlExample = htmlPrompt +++ htmlExpression +++ toHtml (unlines result)\n        htmlPrompt = (thecode . toHtml $ \">>> \") ! [theclass \"prompt\"]\n        htmlExpression = (strong . thecode . toHtml $ expression ++ \"\\n\") ! [theclass \"userinput\"]\n\n-- | We use this intermediate type to transform the input 'Doc' tree\n-- in an arbitrary way before rendering, such as grouping some\n-- elements. This is effectivelly a hack to prevent the 'Doc' type\n-- from changing if it is possible to recover the layout information\n-- we won't need after the fact.\ndata Hack a id =\n  UntouchedDoc (MetaDoc a id)\n  | CollapsingHeader (Header (DocH a id)) (MetaDoc a id) Int (Maybe String)\n  | HackAppend (Hack a id) (Hack a id)\n  deriving Eq\n\n-- | Group things under bold 'DocHeader's together.\ntoHack :: Int -- ^ Counter for header IDs which serves to assign\n              -- unique identifiers within the comment scope\n       -> Maybe String\n       -- ^ It is not enough to have unique identifier within the\n       -- scope of the comment: if two different comments have the\n       -- same ID for headers, the collapse/expand behaviour will act\n       -- on them both. This serves to make each header a little bit\n       -- more unique. As we can't export things with the same names,\n       -- this should work more or less fine: it is in fact the\n       -- implicit assumption the collapse/expand mechanism makes for\n       -- things like \u00e2\u20ac\u02dcInstances\u00e2\u20ac\u2122 boxes.\n       -> [MetaDoc a id] -> Hack a id\ntoHack _ _ [] = UntouchedDoc emptyMetaDoc\ntoHack _ _ [x] = UntouchedDoc x\ntoHack n nm (MetaDoc { _doc = DocHeader (Header l (DocBold x)) }:xs) =\n  let -- Header with dropped bold\n      h = Header l x\n      -- Predicate for takeWhile, grab everything including \u00e2\u20ac\u02dcsmaller\u00e2\u20ac\u2122\n      -- headers\n      p (MetaDoc { _doc = DocHeader (Header l' _) }) = l' > l\n      p _ = True\n      -- Stuff \u00e2\u20ac\u02dcunder\u00e2\u20ac\u2122 this header\n      r = takeWhile p xs\n      -- Everything else that didn't make it under\n      r' = drop (length r) xs\n      app y [] = y\n      app y ys = HackAppend y (toHack (n + 1) nm ys)\n  in case r of\n      -- No content under this header\n      [] -> CollapsingHeader h emptyMetaDoc n nm `app` r'\n      -- We got something out, stitch it back together into one chunk\n      y:ys -> CollapsingHeader h (foldl metaDocAppend y ys) n nm `app` r'\ntoHack n nm (x:xs) = HackAppend (UntouchedDoc x) (toHack n nm xs)\n\n-- | Remove \u00e2\u20ac\u02dctop-level\u00e2\u20ac\u2122 'DocAppend's turning them into a flat list.\n-- This lends itself much better to processing things in order user\n-- might look at them, such as in 'toHack'.\nflatten :: MetaDoc a id -> [MetaDoc a id]\nflatten MetaDoc { _meta = m, _doc = DocAppend x y } =\n  let f z = MetaDoc { _meta = m, _doc = z }\n  in flatten (f x) ++ flatten (f y)\nflatten x = [x]\n\n-- | Generate the markup needed for collapse to happen. For\n-- 'UntouchedDoc' and 'HackAppend' we do nothing more but\n-- extract/append the underlying 'Doc' and convert it to 'Html'. For\n-- 'CollapsingHeader', we attach extra info to the generated 'Html'\n-- that allows us to expand/collapse the content.\nhackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (ModuleName, OccName) id -> Html\nhackMarkup fmt' currPkg h' =\n  let (html, ms) = hackMarkup' fmt' h'\n  in html +++ renderMeta fmt' currPkg (metaConcat ms)\n  where\n    hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id\n                -> (Html, [Meta])\n    hackMarkup' fmt h = case h of\n      UntouchedDoc d -> (markup fmt $ _doc d, [_meta d])\n      CollapsingHeader (Header lvl titl) par n nm ->\n        let id_ = makeAnchorId $ \"ch:\" ++ fromMaybe \"noid:\" nm ++ show n\n            col' = collapseControl id_ \"caption\"\n            summary = thesummary ! [ theclass \"hide-when-js-enabled\" ] << \"Expand\"\n            instTable contents = collapseDetails id_ DetailsClosed (summary +++ contents)\n            lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6]\n            getHeader = fromMaybe caption (lookup lvl lvs)\n            subCaption = getHeader ! col' << markup fmt titl\n        in ((subCaption +++) . instTable $ markup fmt (_doc par), [_meta par])\n      HackAppend d d' -> let (x, m) = hackMarkup' fmt d\n                             (y, m') = hackMarkup' fmt d'\n                         in (markupAppend fmt x y, m ++ m')\n\nrenderMeta :: DocMarkup id Html -> Maybe Package -> Meta -> Html\nrenderMeta fmt currPkg (Meta { _version = Just x, _package = pkg }) =\n  markupParagraph fmt . markupEmphasis fmt . toHtml $\n    \"Since: \" ++ formatPkgMaybe pkg ++ formatVersion x\n  where\n    formatVersion v = concat . intersperse \".\" $ map show v\n    formatPkgMaybe (Just p) | Just p /= currPkg = p ++ \"-\"\n    formatPkgMaybe _ = \"\"\nrenderMeta _ _ _ = noHtml\n\n-- | Goes through 'hackMarkup' to generate the 'Html' rather than\n-- skipping straight to 'markup': this allows us to employ XHtml\n-- specific hacks to the tree first.\nmarkupHacked :: DocMarkup id Html\n             -> Maybe Package      -- this package\n             -> Maybe String\n             -> MDoc id\n             -> Html\nmarkupHacked fmt currPkg n = hackMarkup fmt currPkg . toHack 0 n . flatten\n\n-- If the doc is a single paragraph, don't surround it with <P> (this causes\n-- ugly extra whitespace with some browsers).  FIXME: Does this still apply?\ndocToHtml :: Maybe String  -- ^ Name of the thing this doc is for. See\n                           -- comments on 'toHack' for details.\n          -> Maybe Package -- ^ Current package\n          -> Qualification -> MDoc DocName -> Html\ndocToHtml n pkg qual = markupHacked fmt pkg n . cleanup\n  where fmt = parHtmlMarkup qual True (ppDocName qual Raw)\n\n-- | Same as 'docToHtml' but it doesn't insert the 'anchor' element\n-- in links. This is used to generate the Contents box elements.\ndocToHtmlNoAnchors :: Maybe String  -- ^ See 'toHack'\n                   -> Maybe Package -- ^ Current package\n                   -> Qualification -> MDoc DocName -> Html\ndocToHtmlNoAnchors n pkg qual = markupHacked fmt pkg n . cleanup\n  where fmt = parHtmlMarkup qual False (ppDocName qual Raw)\n\norigDocToHtml :: Maybe Package -> Qualification -> MDoc Name -> Html\norigDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup\n  where fmt = parHtmlMarkup qual True (const $ ppName Raw)\n\n\nrdrDocToHtml :: Maybe Package -> Qualification -> MDoc RdrName -> Html\nrdrDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup\n  where fmt = parHtmlMarkup qual True (const ppRdrName)\n\n\ndocElement :: (Html -> Html) -> Html -> Html\ndocElement el content_ =\n  if isNoHtml content_\n    then el ! [theclass \"doc empty\"] << spaceHtml\n    else el ! [theclass \"doc\"] << content_\n\n\ndocSection :: Maybe Name -- ^ Name of the thing this doc is for\n           -> Maybe Package -- ^ Current package\n           -> Qualification -> Documentation DocName -> Html\ndocSection n pkg qual =\n  maybe noHtml (docSection_ n pkg qual) . combineDocumentation\n\n\ndocSection_ :: Maybe Name    -- ^ Name of the thing this doc is for\n            -> Maybe Package -- ^ Current package\n            -> Qualification -> MDoc DocName -> Html\ndocSection_ n pkg qual =\n  (docElement thediv <<) . docToHtml (getOccString <$> n) pkg qual\n\n\ncleanup :: MDoc a -> MDoc a\ncleanup = overDoc (markup fmtUnParagraphLists)\n  where\n    -- If there is a single paragraph, then surrounding it with <P>..</P>\n    -- can add too much whitespace in some browsers (eg. IE).  However if\n    -- we have multiple paragraphs, then we want the extra whitespace to\n    -- separate them.  So we catch the single paragraph case and transform it\n    -- here. We don't do this in code blocks as it eliminates line breaks.\n    unParagraph :: Doc a -> Doc a\n    unParagraph (DocParagraph d) = d\n    unParagraph doc              = doc\n\n    fmtUnParagraphLists :: DocMarkup a (Doc a)\n    fmtUnParagraphLists = idMarkup {\n      markupUnorderedList = DocUnorderedList . map unParagraph,\n      markupOrderedList   = DocOrderedList   . map unParagraph\n      }\n", "num_lines": 281}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html.Layout\n-- Copyright   :  (c) Simon Marlow   2003-2006,\n--                    David Waern    2006-2009,\n--                    Mark Lentczner 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Xhtml.Layout (\n  miniBody,\n\n  divPackageHeader, divContent, divModuleHeader, divFooter,\n  divTableOfContents, divDescription, divSynopsis, divInterface,\n  divIndex, divAlphabet, divModuleList,\n\n  sectionName,\n  nonEmptySectionName,\n\n  shortDeclList,\n  shortSubDecls,\n\n  divTopDecl,\n\n  SubDecl,\n  subArguments,\n  subAssociatedTypes,\n  subConstructors,\n  subPatterns,\n  subEquations,\n  subFields,\n  subInstances, subOrphanInstances,\n  subInstHead, subInstDetails, subFamInstDetails,\n  subMethods,\n  subMinimal,\n\n  topDeclElem, declElem,\n) where\n\nimport Haddock.Backends.Xhtml.DocMarkup\nimport Haddock.Backends.Xhtml.Types\nimport Haddock.Backends.Xhtml.Utils\nimport Haddock.Types\nimport Haddock.Utils (makeAnchorId, nameAnchorId)\nimport qualified Data.Map as Map\nimport Text.XHtml hiding ( name, title, quote )\nimport Data.Maybe (fromMaybe)\n\nimport FastString            ( unpackFS )\nimport GHC\nimport Name (nameOccName)\n\n--------------------------------------------------------------------------------\n-- * Sections of the document\n--------------------------------------------------------------------------------\n\n\nminiBody :: Html -> Html\nminiBody = body ! [identifier \"mini\"]\n\n\nsectionDiv :: String -> Html -> Html\nsectionDiv i = thediv ! [identifier i]\n\n\nsectionName :: Html -> Html\nsectionName = paragraph ! [theclass \"caption\"]\n\n\n-- | Make an element that always has at least something (a non-breaking space).\n-- If it would have otherwise been empty, then give it the class \".empty\".\nnonEmptySectionName :: Html -> Html\nnonEmptySectionName c\n  | isNoHtml c = paragraph ! [theclass \"caption empty\"] $ spaceHtml\n  | otherwise  = paragraph ! [theclass \"caption\"]       $ c\n\n\ndivPackageHeader, divContent, divModuleHeader, divFooter,\n  divTableOfContents, divDescription, divSynopsis, divInterface,\n  divIndex, divAlphabet, divModuleList\n    :: Html -> Html\n\ndivPackageHeader    = sectionDiv \"package-header\"\ndivContent          = sectionDiv \"content\"\ndivModuleHeader     = sectionDiv \"module-header\"\ndivFooter           = sectionDiv \"footer\"\ndivTableOfContents  = sectionDiv \"table-of-contents\"\ndivDescription      = sectionDiv \"description\"\ndivSynopsis         = sectionDiv \"synopsis\"\ndivInterface        = sectionDiv \"interface\"\ndivIndex            = sectionDiv \"index\"\ndivAlphabet         = sectionDiv \"alphabet\"\ndivModuleList       = sectionDiv \"module-list\"\n\n\n--------------------------------------------------------------------------------\n-- * Declaration containers\n--------------------------------------------------------------------------------\n\n\nshortDeclList :: [Html] -> Html\nshortDeclList items = ulist << map (li ! [theclass \"src short\"] <<) items\n\n\nshortSubDecls :: Bool -> [Html] -> Html\nshortSubDecls inst items = ulist ! [theclass c] << map (i <<) items\n  where i | inst      = li ! [theclass \"inst\"]\n          | otherwise = li\n        c | inst      = \"inst\"\n          | otherwise = \"subs\"\n\n\ndivTopDecl :: Html -> Html\ndivTopDecl = thediv ! [theclass \"top\"]\n\n\ntype SubDecl = (Html, Maybe (MDoc DocName), [Html])\n\n\ndivSubDecls :: (HTML a) => String -> a -> Maybe Html -> Html\ndivSubDecls cssClass captionName = maybe noHtml wrap\n  where\n    wrap = (subSection <<) . (subCaption +++)\n    subSection = thediv ! [theclass $ unwords [\"subs\", cssClass]]\n    subCaption = paragraph ! [theclass \"caption\"] << captionName\n\n\nsubDlist :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html\nsubDlist _ _ [] = Nothing\nsubDlist pkg qual decls = Just $ ulist << map subEntry decls\n  where\n    subEntry (decl, mdoc, subs) =\n      li <<\n        (define ! [theclass \"src\"] << decl +++\n         docElement thediv << (fmap (docToHtml Nothing pkg qual) mdoc +++ subs))\n\n\nsubTable :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html\nsubTable _ _ [] = Nothing\nsubTable pkg qual decls = Just $ table << aboves (concatMap subRow decls)\n  where\n    subRow (decl, mdoc, subs) =\n      (td ! [theclass \"src\"] << decl\n       <->\n       docElement td << fmap (docToHtml Nothing pkg qual) mdoc)\n      : map (cell . (td <<)) subs\n\n\n-- | Sub table with source information (optional).\nsubTableSrc :: Maybe Package -> Qualification -> LinksInfo -> Bool\n            -> [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html\nsubTableSrc _ _ _ _ [] = Nothing\nsubTableSrc pkg qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)\n  where\n    subRow ((decl, mdoc, subs), mdl, L loc dn) =\n      (td ! [theclass \"src clearfix\"] <<\n        (thespan ! [theclass \"inst-left\"] << decl)\n        <+> linkHtml loc mdl dn\n      <->\n      docElement td << fmap (docToHtml Nothing pkg qual) mdoc\n      )\n      : map (cell . (td <<)) subs\n\n    linkHtml :: SrcSpan -> Maybe Module -> DocName -> Html\n    linkHtml loc@(RealSrcSpan _) mdl dn = links lnks loc splice mdl dn\n    linkHtml _ _ _ = noHtml\n\nsubBlock :: [Html] -> Maybe Html\nsubBlock [] = Nothing\nsubBlock hs = Just $ toHtml hs\n\n\nsubArguments :: Maybe Package -> Qualification -> [SubDecl] -> Html\nsubArguments pkg qual = divSubDecls \"arguments\" \"Arguments\" . subTable pkg qual\n\n\nsubAssociatedTypes :: [Html] -> Html\nsubAssociatedTypes = divSubDecls \"associated-types\" \"Associated Types\" . subBlock\n\n\nsubConstructors :: Maybe Package -> Qualification -> [SubDecl] -> Html\nsubConstructors pkg qual = divSubDecls \"constructors\" \"Constructors\" . subTable pkg qual\n\nsubPatterns :: Maybe Package -> Qualification -> [SubDecl] -> Html\nsubPatterns pkg qual = divSubDecls \"bundled-patterns\" \"Bundled Patterns\" . subTable pkg qual\n\nsubFields :: Maybe Package -> Qualification -> [SubDecl] -> Html\nsubFields pkg qual = divSubDecls \"fields\" \"Fields\" . subDlist pkg qual\n\n\nsubEquations :: Maybe Package -> Qualification -> [SubDecl] -> Html\nsubEquations pkg qual = divSubDecls \"equations\" \"Equations\" . subTable pkg qual\n\n\n-- | Generate sub table for instance declarations, with source\nsubInstances :: Maybe Package -> Qualification\n             -> String -- ^ Class name, used for anchor generation\n             -> LinksInfo -> Bool\n             -> [(SubDecl, Maybe Module, Located DocName)] -> Html\nsubInstances pkg qual nm lnks splice = maybe noHtml wrap . instTable\n  where\n    wrap contents = subSection (collapseDetails id_ DetailsOpen (summary +++ contents))\n    instTable = subTableSrc pkg qual lnks splice\n    subSection = thediv ! [theclass \"subs instances\"]\n    summary = thesummary << \"Instances\"\n    id_ = makeAnchorId $ \"i:\" ++ nm\n\n\nsubOrphanInstances :: Maybe Package -> Qualification\n                   -> LinksInfo -> Bool\n                   -> [(SubDecl, Maybe Module, Located DocName)] -> Html\nsubOrphanInstances pkg qual lnks splice  = maybe noHtml wrap . instTable\n  where\n    wrap = ((h1 << \"Orphan instances\") +++)\n    instTable = fmap (thediv ! [ identifier (\"section.\" ++ id_) ] <<) . subTableSrc pkg qual lnks splice\n    id_ = makeAnchorId $ \"orphans\"\n\n\nsubInstHead :: String -- ^ Instance unique id (for anchor generation)\n            -> Html -- ^ Header content (instance name and type)\n            -> Html\nsubInstHead iid hdr =\n    expander noHtml <+> hdr\n  where\n    expander = thespan ! collapseControl (instAnchorId iid) \"instance\"\n\n\nsubInstDetails :: String -- ^ Instance unique id (for anchor generation)\n               -> [Html] -- ^ Associated type contents\n               -> [Html] -- ^ Method contents (pretty-printed signatures)\n               -> Html   -- ^ Source module\n               -> Html\nsubInstDetails iid ats mets mdl =\n    subInstSection iid << (p mdl <+> subAssociatedTypes ats <+> subMethods mets)\n\nsubFamInstDetails :: String -- ^ Instance unique id (for anchor generation)\n                  -> Html   -- ^ Type or data family instance\n                  -> Html   -- ^ Source module TODO: use this\n                  -> Html\nsubFamInstDetails iid fi mdl =\n    subInstSection iid << (p mdl <+> (thediv ! [theclass \"src\"] << fi))\n\nsubInstSection :: String -- ^ Instance unique id (for anchor generation)\n               -> Html\n               -> Html\nsubInstSection iid contents = collapseDetails (instAnchorId iid) DetailsClosed (summary +++ contents)\n  where\n    summary = thesummary ! [ theclass \"hide-when-js-enabled\" ] << \"Instance details\"\n\ninstAnchorId :: String -> String\ninstAnchorId iid = makeAnchorId $ \"i:\" ++ iid\n\n\nsubMethods :: [Html] -> Html\nsubMethods = divSubDecls \"methods\" \"Methods\" . subBlock\n\nsubMinimal :: Html -> Html\nsubMinimal = divSubDecls \"minimal\" \"Minimal complete definition\" . Just . declElem\n\n\n-- a box for displaying code\ndeclElem :: Html -> Html\ndeclElem = paragraph ! [theclass \"src\"]\n\n\n-- a box for top level documented names\n-- it adds a source and wiki link at the right hand side of the box\ntopDeclElem :: LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html\ntopDeclElem lnks loc splice names html =\n    declElem << (html <+> (links lnks loc splice Nothing $ head names))\n        -- FIXME: is it ok to simply take the first name?\n\n-- | Adds a source and wiki link at the right hand side of the box.\n-- Name must be documented, otherwise we wouldn't get here.\nlinks :: LinksInfo -> SrcSpan -> Bool -> Maybe Module -> DocName -> Html\nlinks ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice mdl' docName@(Documented n mdl) =\n  srcLink <+> wikiLink <+> (selfLink ! [theclass \"selflink\"] << \"#\")\n  where selfLink = linkedAnchor (nameAnchorId (nameOccName (getName docName)))\n\n        srcLink = let nameUrl = Map.lookup origPkg sourceMap\n                      lineUrl = Map.lookup origPkg lineMap\n                      mUrl | splice    = lineUrl\n                                        -- Use the lineUrl as a backup\n                           | otherwise = maybe lineUrl Just nameUrl in\n          case mUrl of\n            Nothing  -> noHtml\n            Just url -> let url' = spliceURL (Just fname) (Just origMod)\n                                               (Just n) (Just loc) url\n                          in anchor ! [href url', theclass \"link\"] << \"Source\"\n\n        wikiLink =\n          case maybe_wiki_url of\n            Nothing  -> noHtml\n            Just url -> let url' = spliceURL (Just fname) (Just mdl)\n                                               (Just n) (Just loc) url\n                          in anchor ! [href url', theclass \"link\"] << \"Comments\"\n\n        -- For source links, we want to point to the original module,\n        -- because only that will have the source.\n        --\n        -- 'mdl'' is a way of \"overriding\" the module. Without it, instances\n        -- will point to the module defining the class/family, which is wrong.\n        origMod = fromMaybe (nameModule n) mdl'\n        origPkg = moduleUnitId origMod\n\n        fname = case loc of\n          RealSrcSpan l -> unpackFS (srcSpanFile l)\n          UnhelpfulSpan _ -> error \"links: UnhelpfulSpan\"\nlinks _ _ _ _ _ = noHtml\n", "num_lines": 313}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Haddock.Backends.Xhtml.Meta where\n\nimport Haddock.Utils.Json\nimport Haddock.Version\n\nimport Data.ByteString.Builder (hPutBuilder)\nimport System.FilePath ((</>))\nimport System.IO (withFile, IOMode (WriteMode))\n\n-- | Everytime breaking changes to the Quckjump api\n-- happen this needs to be modified.\nquickjumpVersion :: Int\nquickjumpVersion = 1\n\n-- | Writes a json encoded file containing additional\n-- information about the generated documentation. This\n-- is useful for external tools (e.g. hackage).\nwriteHaddockMeta :: FilePath -> Bool -> IO ()\nwriteHaddockMeta odir withQuickjump = do\n  let\n    meta_json :: Value\n    meta_json = object (concat [\n        [ \"haddock_version\"   .= String projectVersion ]\n      , [ \"quickjump_version\" .= quickjumpVersion | withQuickjump ]\n      ])\n\n  withFile (odir </> \"meta.json\") WriteMode $ \\h ->\n    hPutBuilder h (encodeToBuilder meta_json)\n", "num_lines": 29}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html.Names\n-- Copyright   :  (c) Simon Marlow   2003-2006,\n--                    David Waern    2006-2009,\n--                    Mark Lentczner 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Xhtml.Names (\n  ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink,\n  ppBinder, ppBinderInfix, ppBinder',\n  ppModule, ppModuleRef, ppIPName, linkId, Notation(..)\n) where\n\n\nimport Haddock.Backends.Xhtml.Utils\nimport Haddock.GhcUtils\nimport Haddock.Types\nimport Haddock.Utils\n\nimport Text.XHtml hiding ( name, p, quote )\nimport qualified Data.Map as M\nimport qualified Data.List as List\n\nimport GHC hiding (LexicalFixity(..))\nimport Name\nimport RdrName\nimport FastString (unpackFS)\n\n\n-- | Indicator of how to render a 'DocName' into 'Html'\ndata Notation = Raw -- ^ Render as-is.\n              | Infix -- ^ Render using infix notation.\n              | Prefix -- ^ Render using prefix notation.\n                deriving (Eq, Show)\n\nppOccName :: OccName -> Html\nppOccName = toHtml . occNameString\n\n\nppRdrName :: RdrName -> Html\nppRdrName = ppOccName . rdrNameOcc\n\nppIPName :: HsIPName -> Html\nppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS\n\n\nppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html\nppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName\n\n\n-- The Bool indicates if it is to be rendered in infix notation\nppLDocName :: Qualification -> Notation -> Located DocName -> Html\nppLDocName qual notation (L _ d) = ppDocName qual notation True d\n\nppDocName :: Qualification -> Notation -> Bool -> DocName -> Html\nppDocName qual notation insertAnchors docName =\n  case docName of\n    Documented name mdl ->\n      linkIdOcc mdl (Just (nameOccName name)) insertAnchors\n      << ppQualifyName qual notation name mdl\n    Undocumented name\n      | isExternalName name || isWiredInName name ->\n          ppQualifyName qual notation name (nameModule name)\n      | otherwise -> ppName notation name\n\n-- | Render a name depending on the selected qualification mode\nppQualifyName :: Qualification -> Notation -> Name -> Module -> Html\nppQualifyName qual notation name mdl =\n  case qual of\n    NoQual   -> ppName notation name\n    FullQual -> ppFullQualName notation mdl name\n    LocalQual localmdl ->\n      if moduleString mdl == moduleString localmdl\n        then ppName notation name\n        else ppFullQualName notation mdl name\n    RelativeQual localmdl ->\n      case List.stripPrefix (moduleString localmdl) (moduleString mdl) of\n        -- local, A.x -> x\n        Just []      -> ppName notation name\n        -- sub-module, A.B.x -> B.x\n        Just ('.':m) -> toHtml $ m ++ '.' : getOccString name\n        -- some module with same prefix, ABC.x -> ABC.x\n        Just _       -> ppFullQualName notation mdl name\n        -- some other module, D.x -> D.x\n        Nothing      -> ppFullQualName notation mdl name\n    AliasedQual aliases localmdl ->\n      case (moduleString mdl == moduleString localmdl,\n            M.lookup mdl aliases) of\n        (False, Just alias) -> ppQualName notation alias name\n        _ -> ppName notation name\n\n\nppFullQualName :: Notation -> Module -> Name -> Html\nppFullQualName notation mdl name = wrapInfix notation (getOccName name) qname\n  where\n    qname = toHtml $ moduleString mdl ++ '.' : getOccString name\n\nppQualName :: Notation -> ModuleName -> Name -> Html\nppQualName notation mdlName name = wrapInfix notation (getOccName name) qname\n  where\n    qname = toHtml $ moduleNameString mdlName ++ '.' : getOccString name\n\nppName :: Notation -> Name -> Html\nppName notation name = wrapInfix notation (getOccName name) $ toHtml (getOccString name)\n\n\nppBinder :: Bool -> OccName -> Html\nppBinder = ppBinderWith Prefix\n\nppBinderInfix :: Bool -> OccName -> Html\nppBinderInfix = ppBinderWith Infix\n\nppBinderWith :: Notation -> Bool -> OccName -> Html\n-- 'isRef' indicates whether this is merely a reference from another part of\n-- the documentation or is the actual definition; in the latter case, we also\n-- set the 'id' and 'class' attributes.\nppBinderWith notation isRef n =\n  makeAnchor << ppBinder' notation n\n  where\n    name = nameAnchorId n\n    makeAnchor | isRef     = linkedAnchor name\n               | otherwise = namedAnchor name ! [theclass \"def\"]\n\nppBinder' :: Notation -> OccName -> Html\nppBinder' notation n = wrapInfix notation n $ ppOccName n\n\nwrapInfix :: Notation -> OccName -> Html -> Html\nwrapInfix notation n = case notation of\n  Infix | is_star_kind -> id\n        | not is_sym -> quote\n  Prefix | is_star_kind -> id\n         | is_sym -> parens\n  _ -> id\n  where\n    is_sym = isSymOcc n\n    is_star_kind = isTcOcc n && occNameString n == \"*\"\n\nlinkId :: Module -> Maybe Name -> Html -> Html\nlinkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName) True\n\n\nlinkIdOcc :: Module -> Maybe OccName -> Bool -> Html -> Html\nlinkIdOcc mdl mbName insertAnchors =\n  if insertAnchors\n  then anchor ! [href url, title ttl]\n  else id\n  where\n    ttl = moduleNameString (moduleName mdl)\n    url = case mbName of\n      Nothing   -> moduleUrl mdl\n      Just name -> moduleNameUrl mdl name\n\n\nlinkIdOcc' :: ModuleName -> Maybe OccName -> Html -> Html\nlinkIdOcc' mdl mbName = anchor ! [href url, title ttl]\n  where\n    ttl = moduleNameString mdl\n    url = case mbName of\n      Nothing   -> moduleHtmlFile' mdl\n      Just name -> moduleNameUrl' mdl name\n\n\nppModule :: Module -> Html\nppModule mdl = anchor ! [href (moduleUrl mdl)]\n               << toHtml (moduleString mdl)\n\n\nppModuleRef :: ModuleName -> String -> Html\nppModuleRef mdl ref = anchor ! [href (moduleHtmlFile' mdl ++ ref)]\n                      << toHtml (moduleNameString mdl)\n    -- NB: The ref parameter already includes the '#'.\n    -- This function is only called from markupModule expanding a\n    -- DocModule, which doesn't seem to be ever be used.\n", "num_lines": 179}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html.Themes\n-- Copyright   :  (c) Mark Lentczner 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Xhtml.Themes (\n    Themes,\n    getThemes,\n\n    cssFiles, styleSheet\n    )\n    where\n\nimport Haddock.Options\n\nimport Control.Monad (liftM)\nimport Data.Char (toLower)\nimport Data.Either (lefts, rights)\nimport Data.List (nub)\nimport Data.Maybe (isJust, listToMaybe)\n\nimport System.Directory\nimport System.FilePath\nimport Text.XHtml hiding ( name, title, p, quote, (</>) )\nimport qualified Text.XHtml as XHtml\n\n\n--------------------------------------------------------------------------------\n-- * CSS Themes\n--------------------------------------------------------------------------------\n\ndata Theme = Theme {\n  themeName :: String,\n  themeHref :: String,\n  themeFiles :: [FilePath]\n  }\n\ntype Themes = [Theme]\n\ntype PossibleTheme = Either String Theme\ntype PossibleThemes = Either String Themes\n\n\n-- | Find a theme by name (case insensitive match)\nfindTheme :: String -> Themes -> Maybe Theme\nfindTheme s = listToMaybe . filter ((== ls).lower.themeName)\n  where lower = map toLower\n        ls = lower s\n\n\n-- | Standard theme used by default\nstandardTheme :: FilePath -> IO PossibleThemes\nstandardTheme libDir = liftM (liftEither (take 1)) (defaultThemes libDir)\n\n\n-- | Default themes that are part of Haddock; added with --default-themes\n-- The first theme in this list is considered the standard theme.\n-- Themes are \"discovered\" by scanning the html sub-dir of the libDir,\n-- and looking for directories with the extension .theme or .std-theme.\n-- The later is, obviously, the standard theme.\ndefaultThemes :: FilePath -> IO PossibleThemes\ndefaultThemes libDir = do\n  themeDirs <- getDirectoryItems (libDir </> \"html\")\n  themes <- mapM directoryTheme $ discoverThemes themeDirs\n  return $ sequenceEither themes\n  where\n    discoverThemes paths =\n      filterExt \".std-theme\" paths ++ filterExt \".theme\" paths\n    filterExt ext = filter ((== ext).takeExtension)\n\n\n-- | Build a theme from a single .css file\nsingleFileTheme :: FilePath -> IO PossibleTheme\nsingleFileTheme path =\n  if isCssFilePath path\n      then retRight $ Theme name file [path]\n      else errMessage \"File extension isn't .css\" path\n  where\n    name = takeBaseName path\n    file = takeFileName path\n\n\n-- | Build a theme from a directory\ndirectoryTheme :: FilePath -> IO PossibleTheme\ndirectoryTheme path = do\n  items <- getDirectoryItems path\n  case filter isCssFilePath items of\n    [cf] -> retRight $ Theme (takeBaseName path) (takeFileName cf) items\n    [] -> errMessage \"No .css file in theme directory\" path\n    _ -> errMessage \"More than one .css file in theme directory\" path\n\n\n-- | Check if we have a built in theme\ndoesBuiltInExist :: IO PossibleThemes -> String -> IO Bool\ndoesBuiltInExist pts s = fmap (either (const False) test) pts\n  where test = isJust . findTheme s\n\n\n-- | Find a built in theme\nbuiltInTheme :: IO PossibleThemes -> String -> IO PossibleTheme\nbuiltInTheme pts s = either Left fetch <$> pts\n  where fetch = maybe (Left (\"Unknown theme: \" ++ s)) Right . findTheme s\n\n\n--------------------------------------------------------------------------------\n-- * CSS Theme Arguments\n--------------------------------------------------------------------------------\n\n-- | Process input flags for CSS Theme arguments\ngetThemes :: FilePath -> [Flag] -> IO PossibleThemes\ngetThemes libDir flags =\n  liftM concatEither (mapM themeFlag flags) >>= someTheme\n  where\n    themeFlag :: Flag -> IO (Either String Themes)\n    themeFlag (Flag_CSS path) = (liftM . liftEither) (:[]) (theme path)\n    themeFlag (Flag_BuiltInThemes) = builtIns\n    themeFlag _ = retRight []\n\n    theme :: FilePath -> IO PossibleTheme\n    theme path = pick path\n      [(doesFileExist,              singleFileTheme),\n       (doesDirectoryExist,         directoryTheme),\n       (doesBuiltInExist builtIns,  builtInTheme builtIns)]\n      \"Theme not found\"\n\n    pick :: FilePath\n      -> [(FilePath -> IO Bool, FilePath -> IO PossibleTheme)] -> String\n      -> IO PossibleTheme\n    pick path [] msg = errMessage msg path\n    pick path ((test,build):opts) msg = do\n      pass <- test path\n      if pass then build path else pick path opts msg\n\n\n    someTheme :: Either String Themes -> IO (Either String Themes)\n    someTheme (Right []) = standardTheme libDir\n    someTheme est = return est\n\n    builtIns = defaultThemes libDir\n\n\nerrMessage :: String -> FilePath -> IO (Either String a)\nerrMessage msg path = return (Left msg')\n  where msg' = \"Error: \" ++ msg ++ \": \\\"\" ++ path ++ \"\\\"\\n\"\n\n\nretRight :: a -> IO (Either String a)\nretRight = return . Right\n\n\n--------------------------------------------------------------------------------\n-- * File Utilities\n--------------------------------------------------------------------------------\n\n\ngetDirectoryItems :: FilePath -> IO [FilePath]\ngetDirectoryItems path =\n  map (combine path) . filter notDot <$> getDirectoryContents path\n  where notDot s = s /= \".\" && s /= \"..\"\n\n\nisCssFilePath :: FilePath -> Bool\nisCssFilePath path = takeExtension path == \".css\"\n\n\n--------------------------------------------------------------------------------\n-- * Style Sheet Utilities\n--------------------------------------------------------------------------------\n\ncssFiles :: Themes -> [String]\ncssFiles ts = nub $ concatMap themeFiles ts\n\n\nstyleSheet :: Themes -> Html\nstyleSheet ts = toHtml $ zipWith mkLink rels ts\n  where\n    rels = \"stylesheet\" : repeat \"alternate stylesheet\"\n    mkLink aRel t =\n      thelink\n        ! [ href (themeHref t),  rel aRel, thetype \"text/css\",\n            XHtml.title (themeName t)\n          ]\n        << noHtml\n\n--------------------------------------------------------------------------------\n-- * Either Utilities\n--------------------------------------------------------------------------------\n\n-- These three routines are here because Haddock does not have access to the\n-- Control.Monad.Error module which supplies the Functor and Monad instances\n-- for Either String.\n\nsequenceEither :: [Either a b] -> Either a [b]\nsequenceEither es = maybe (Right $ rights es) Left (listToMaybe (lefts es))\n\n\nliftEither :: (b -> c) -> Either a b -> Either a c\nliftEither f = either Left (Right . f)\n\n\nconcatEither :: [Either a [b]] -> Either a [b]\nconcatEither = liftEither concat . sequenceEither\n", "num_lines": 208}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html.Types\n-- Copyright   :  (c) Simon Marlow   2003-2006,\n--                    David Waern    2006-2009,\n--                    Mark Lentczner 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Xhtml.Types (\n  SourceURLs, WikiURLs,\n  LinksInfo,\n  Splice,\n  Unicode,\n) where\n\n\nimport Data.Map\nimport GHC\n\n\n-- the base, module and entity URLs for the source code and wiki links.\ntype SourceURLs = (Maybe FilePath, Maybe FilePath, Map UnitId FilePath, Map UnitId FilePath)\ntype WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath)\n\n\n-- The URL for source and wiki links\ntype LinksInfo = (SourceURLs, WikiURLs)\n\n-- Whether something is a splice or not\ntype Splice = Bool\n\n-- Whether unicode syntax is to be used\ntype Unicode = Bool\n", "num_lines": 38}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Backends.Html.Util\n-- Copyright   :  (c) Simon Marlow   2003-2006,\n--                    David Waern    2006-2009,\n--                    Mark Lentczner 2010\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Backends.Xhtml.Utils (\n  renderToString,\n\n  namedAnchor, linkedAnchor,\n  spliceURL, spliceURL',\n  groupId,\n\n  (<+>), (<=>), char,\n  keyword, punctuate,\n\n  braces, brackets, pabrackets, parens, parenList, ubxParenList, ubxSumList,\n  arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote, promoQuote,\n\n  hsep, vcat,\n\n  DetailsState(..), collapseDetails, thesummary,\n  collapseToggle, collapseControl,\n) where\n\n\nimport Haddock.Utils\n\nimport Data.Maybe\n\nimport Text.XHtml hiding ( name, title, p, quote )\nimport qualified Text.XHtml as XHtml\n\nimport GHC      ( SrcSpan(..), srcSpanStartLine, Name )\nimport Module   ( Module, ModuleName, moduleName, moduleNameString )\nimport Name     ( getOccString, nameOccName, isValOcc )\n\n\n-- | Replace placeholder string elements with provided values.\n--\n-- Used to generate URL for customized external paths, usually provided with\n-- @--source-module@, @--source-entity@ and related command-line arguments.\n--\n-- >>> spliceURL Nothing mmod mname Nothing \"output/%{MODULE}.hs#%{NAME}\"\n-- \"output/Foo.hs#foo\"\nspliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->\n             Maybe SrcSpan -> String -> String\nspliceURL mfile mmod = spliceURL' mfile (moduleName <$> mmod)\n\n\n-- | Same as 'spliceURL' but takes 'ModuleName' instead of 'Module'.\nspliceURL' :: Maybe FilePath -> Maybe ModuleName -> Maybe GHC.Name ->\n              Maybe SrcSpan -> String -> String\nspliceURL' maybe_file maybe_mod maybe_name maybe_loc = run\n where\n  file = fromMaybe \"\" maybe_file\n  mdl = case maybe_mod of\n          Nothing           -> \"\"\n          Just m -> moduleNameString m\n\n  (name, kind) =\n    case maybe_name of\n      Nothing             -> (\"\",\"\")\n      Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), \"v\")\n             | otherwise -> (escapeStr (getOccString n), \"t\")\n\n  line = case maybe_loc of\n    Nothing -> \"\"\n    Just span_ ->\n      case span_ of\n      RealSrcSpan span__ ->\n        show $ srcSpanStartLine span__\n      UnhelpfulSpan _ -> \"\"\n\n  run \"\" = \"\"\n  run ('%':'M':rest) = mdl  ++ run rest\n  run ('%':'F':rest) = file ++ run rest\n  run ('%':'N':rest) = name ++ run rest\n  run ('%':'K':rest) = kind ++ run rest\n  run ('%':'L':rest) = line ++ run rest\n  run ('%':'%':rest) = '%'   : run rest\n\n  run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mdl  ++ run rest\n  run ('%':'{':'F':'I':'L':'E':'}':rest)         = file ++ run rest\n  run ('%':'{':'N':'A':'M':'E':'}':rest)         = name ++ run rest\n  run ('%':'{':'K':'I':'N':'D':'}':rest)         = kind ++ run rest\n\n  run ('%':'{':'M':'O':'D':'U':'L':'E':'/':'.':'/':c:'}':rest) =\n    map (\\x -> if x == '.' then c else x) mdl ++ run rest\n\n  run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) =\n    map (\\x -> if x == '/' then c else x) file ++ run rest\n\n  run ('%':'{':'L':'I':'N':'E':'}':rest)         = line ++ run rest\n\n  run (c:rest) = c : run rest\n\n\nrenderToString :: Bool -> Html -> String\nrenderToString debug html\n  | debug = renderHtml html\n  | otherwise = showHtml html\n\n\nhsep :: [Html] -> Html\nhsep [] = noHtml\nhsep htmls = foldr1 (\\a b -> a+++\" \"+++b) htmls\n\n-- | Concatenate a series of 'Html' values vertically, with linebreaks in between.\nvcat :: [Html] -> Html\nvcat [] = noHtml\nvcat htmls = foldr1 (\\a b -> a+++br+++b) htmls\n\n\ninfixr 8 <+>\n(<+>) :: Html -> Html -> Html\na <+> b = a +++ sep +++ b\n  where\n    sep = if isNoHtml a || isNoHtml b then noHtml else toHtml \" \"\n\n-- | Join two 'Html' values together with a linebreak in between.\n--   Has 'noHtml' as left identity.\ninfixr 8 <=>\n(<=>) :: Html -> Html -> Html\na <=> b = a +++ sep +++ b\n  where\n    sep = if isNoHtml a then noHtml else br\n\n\nkeyword :: String -> Html\nkeyword s = thespan ! [theclass \"keyword\"] << toHtml s\n\n\nequals, comma :: Html\nequals = char '='\ncomma  = char ','\n\n\nchar :: Char -> Html\nchar c = toHtml [c]\n\n\nquote :: Html -> Html\nquote h = char '`' +++ h +++ '`'\n\n\n-- | Promoted type quote (e.g. @'[a, b]@, @'(a, b, c)@).\npromoQuote :: Html -> Html\npromoQuote h = char '\\'' +++ h\n\n\nparens, brackets, pabrackets, braces :: Html -> Html\nparens h        = char '(' +++ h +++ char ')'\nbrackets h      = char '[' +++ h +++ char ']'\npabrackets h    = toHtml \"[:\" +++ h +++ toHtml \":]\"\nbraces h        = char '{' +++ h +++ char '}'\n\n\npunctuate :: Html -> [Html] -> [Html]\npunctuate _ []     = []\npunctuate h (d0:ds) = go d0 ds\n                   where\n                     go d [] = [d]\n                     go d (e:es) = (d +++ h) : go e es\n\n\nparenList :: [Html] -> Html\nparenList = parens . hsep . punctuate comma\n\n\nubxParenList :: [Html] -> Html\nubxParenList = ubxparens . hsep . punctuate comma\n\n\nubxSumList :: [Html]  -> Html\nubxSumList = ubxparens . hsep . punctuate (toHtml \" | \")\n\n\nubxparens :: Html -> Html\nubxparens h = toHtml \"(#\" +++ h +++ toHtml \"#)\"\n\n\ndcolon, arrow, darrow, forallSymbol :: Bool -> Html\ndcolon unicode = toHtml (if unicode then \"\u00e2\u02c6\u00b7\" else \"::\")\narrow  unicode = toHtml (if unicode then \"\u00e2\u2020\u2019\" else \"->\")\ndarrow unicode = toHtml (if unicode then \"\u00e2\u2021\u2019\" else \"=>\")\nforallSymbol unicode = if unicode then toHtml \"\u00e2\u02c6\u20ac\" else keyword \"forall\"\n\n\ndot :: Html\ndot = toHtml \".\"\n\n\n-- | Generate a named anchor\nnamedAnchor :: String -> Html -> Html\nnamedAnchor n = anchor ! [XHtml.identifier n]\n\n\nlinkedAnchor :: String -> Html -> Html\nlinkedAnchor n = anchor ! [href ('#':n)]\n\n\n-- | generate an anchor identifier for a group\ngroupId :: String -> String\ngroupId g = makeAnchorId (\"g:\" ++ g)\n\n--\n-- A section of HTML which is collapsible.\n--\n\ndata DetailsState = DetailsOpen | DetailsClosed\n\ncollapseDetails :: String -> DetailsState -> Html -> Html\ncollapseDetails id_ state = tag \"details\" ! (identifier id_ : openAttrs)\n  where openAttrs = case state of { DetailsOpen -> [emptyAttr \"open\"]; DetailsClosed -> [] }\n\nthesummary :: Html -> Html\nthesummary = tag \"summary\"\n\n-- | Attributes for an area that toggles a collapsed area\ncollapseToggle :: String -> String -> [HtmlAttr]\ncollapseToggle id_ classes = [ theclass cs, strAttr \"data-details-id\" id_ ]\n  where cs = unwords (words classes ++ [\"details-toggle\"])\n\n-- | Attributes for an area that toggles a collapsed area,\n-- and displays a control.\ncollapseControl :: String -> String -> [HtmlAttr]\ncollapseControl id_ classes = collapseToggle id_ cs\n  where cs = unwords (words classes ++ [\"details-toggle-control\"])", "num_lines": 235}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, MagicHash #-}\n{-# LANGUAGE TypeFamilies #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Interface.AttachInstances\n-- Copyright   :  (c) Simon Marlow 2006,\n--                    David Waern  2006-2009,\n--                    Isaac Dupree 2009\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Interface.AttachInstances (attachInstances) where\n\n\nimport Haddock.Types\nimport Haddock.Convert\nimport Haddock.GhcUtils\n\nimport Control.Arrow hiding ((<+>))\nimport Data.List\nimport Data.Ord (comparing)\nimport Data.Maybe ( maybeToList, mapMaybe, fromMaybe )\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\n\nimport Class\nimport DynFlags\nimport CoreSyn (isOrphan)\nimport ErrUtils\nimport FamInstEnv\nimport FastString\nimport GHC\nimport InstEnv\nimport MonadUtils (liftIO)\nimport Name\nimport NameEnv\nimport Outputable (text, sep, (<+>))\nimport PrelNames\nimport SrcLoc\nimport TyCon\nimport TyCoRep\nimport TysPrim( funTyCon )\nimport Var hiding (varName)\n#define FSLIT(x) (mkFastString# (x#))\n\ntype ExportedNames = Set.Set Name\ntype Modules = Set.Set Module\ntype ExportInfo = (ExportedNames, Modules)\n\n-- Also attaches fixities\nattachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]\nattachInstances expInfo ifaces instIfaceMap = do\n  (_msgs, mb_index) <- getNameToInstancesIndex (map ifaceMod ifaces)\n  mapM (attach $ fromMaybe emptyNameEnv mb_index) ifaces\n  where\n    -- TODO: take an IfaceMap as input\n    ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]\n\n    attach index iface = do\n      newItems <- mapM (attachToExportItem index expInfo iface ifaceMap instIfaceMap)\n                       (ifaceExportItems iface)\n      let orphanInstances = attachOrphanInstances expInfo iface ifaceMap instIfaceMap (ifaceInstances iface)\n      return $ iface { ifaceExportItems = newItems\n                     , ifaceOrphanInstances = orphanInstances\n                     }\n\nattachOrphanInstances :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> [ClsInst] -> [DocInstance GhcRn]\nattachOrphanInstances expInfo iface ifaceMap instIfaceMap cls_instances =\n  [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, (L (getSrcSpan n) n), Nothing)\n  | let is = [ (instanceSig i, getName i) | i <- cls_instances, isOrphan (is_orphan i) ]\n  , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is\n  , not $ isInstanceHidden expInfo cls tys\n  ]\n\n\nattachToExportItem\n  :: NameEnv ([ClsInst], [FamInst])\n  -> ExportInfo\n  -> Interface\n  -> IfaceMap\n  -> InstIfaceMap\n  -> ExportItem GhcRn\n  -> Ghc (ExportItem GhcRn)\nattachToExportItem index expInfo iface ifaceMap instIfaceMap export =\n  case attachFixities export of\n    e@ExportDecl { expItemDecl = L eSpan (TyClD d) } -> do\n      insts <-\n        let mb_instances  = lookupNameEnv index (tcdName d)\n            cls_instances = maybeToList mb_instances >>= fst\n            fam_instances = maybeToList mb_instances >>= snd\n            fam_insts = [ ( synifyFamInst i opaque\n                          , doc\n                          , spanNameE n (synifyFamInst i opaque) (L eSpan (tcdName d))\n                          , nameModule_maybe n\n                          )\n                        | i <- sortBy (comparing instFam) fam_instances\n                        , let n = getName i\n                        , let doc = instLookup instDocMap n iface ifaceMap instIfaceMap\n                        , not $ isNameHidden expInfo (fi_fam i)\n                        , not $ any (isTypeHidden expInfo) (fi_tys i)\n                        , let opaque = isTypeHidden expInfo (fi_rhs i)\n                        ]\n            cls_insts = [ ( synifyInstHead i\n                          , instLookup instDocMap n iface ifaceMap instIfaceMap\n                          , spanName n (synifyInstHead i) (L eSpan (tcdName d))\n                          , nameModule_maybe n\n                          )\n                        | let is = [ (instanceSig i, getName i) | i <- cls_instances ]\n                        , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is\n                        , not $ isInstanceHidden expInfo cls tys\n                        ]\n              -- fam_insts but with failing type fams filtered out\n            cleanFamInsts = [ (fi, n, L l r, m) | (Right fi, n, L l (Right r), m) <- fam_insts ]\n            famInstErrs = [ errm | (Left errm, _, _, _) <- fam_insts ]\n        in do\n          dfs <- getDynFlags\n          let mkBug = (text \"haddock-bug:\" <+>) . text\n          liftIO $ putMsg dfs (sep $ map mkBug famInstErrs)\n          return $ cls_insts ++ cleanFamInsts\n      return $ e { expItemInstances = insts }\n    e -> return e\n  where\n    attachFixities e@ExportDecl{ expItemDecl = L _ d\n                               , expItemPats = patsyns\n                               , expItemSubDocs = subDocs\n                               } = e { expItemFixities =\n      nubByName fst $ expItemFixities e ++\n      [ (n',f) | n <- getMainDeclBinder d\n               , n' <- n : (map fst subDocs ++ patsyn_names)\n               , Just f <- [instLookup instFixMap n' iface ifaceMap instIfaceMap]\n      ] }\n      where\n        patsyn_names = concatMap (getMainDeclBinder . fst) patsyns\n\n    attachFixities e = e\n    -- spanName: attach the location to the name that is the same file as the instance location\n    spanName s (InstHead { ihdClsName = clsn }) (L instL instn) =\n        let s1 = getSrcSpan s\n            sn = if srcSpanFileName_maybe s1 == srcSpanFileName_maybe instL\n                    then instn\n                    else clsn\n        in L (getSrcSpan s) sn\n    -- spanName on Either\n    spanNameE s (Left e) _ =  L (getSrcSpan s) (Left e)\n    spanNameE s (Right ok) linst =\n      let L l r = spanName s ok linst\n      in L l (Right r)\n\n\ninstLookup :: (InstalledInterface -> Map.Map Name a) -> Name\n            -> Interface -> IfaceMap -> InstIfaceMap -> Maybe a\ninstLookup f name iface ifaceMap instIfaceMap =\n  case Map.lookup name (f $ toInstalledIface iface) of\n    res@(Just _) -> res\n    Nothing -> do\n      let ifaceMaps = Map.union (fmap toInstalledIface ifaceMap) instIfaceMap\n      iface' <- Map.lookup (nameModule name) ifaceMaps\n      Map.lookup name (f iface')\n\n--------------------------------------------------------------------------------\n-- Collecting and sorting instances\n--------------------------------------------------------------------------------\n\n\n-- | Simplified type for sorting types, ignoring qualification (not visible\n-- in Haddock output) and unifying special tycons with normal ones.\n-- For the benefit of the user (looks nice and predictable) and the\n-- tests (which prefer output to be deterministic).\ndata SimpleType = SimpleType Name [SimpleType]\n                | SimpleTyLit TyLit\n                  deriving (Eq,Ord)\n\n\ninstHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType])\ninstHead (_, _, cls, args)\n  = (map argCount args, className cls, map simplify args)\n\nargCount :: Type -> Int\nargCount (AppTy t _)     = argCount t + 1\nargCount (TyConApp _ ts) = length ts\nargCount (FunTy _ _ )    = 2\nargCount (ForAllTy _ t)  = argCount t\nargCount (CastTy t _)    = argCount t\nargCount _ = 0\n\nsimplify :: Type -> SimpleType\nsimplify (FunTy t1 t2)  = SimpleType funTyConName [simplify t1, simplify t2]\nsimplify (ForAllTy _ t) = simplify t\nsimplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2))\n  where (SimpleType s ts) = simplify t1\nsimplify (TyVarTy v) = SimpleType (tyVarName v) []\nsimplify (TyConApp tc ts) = SimpleType (tyConName tc)\n                                       (mapMaybe simplify_maybe ts)\nsimplify (LitTy l) = SimpleTyLit l\nsimplify (CastTy ty _) = simplify ty\nsimplify (CoercionTy _) = error \"simplify:Coercion\"\n\nsimplify_maybe :: Type -> Maybe SimpleType\nsimplify_maybe (CoercionTy {}) = Nothing\nsimplify_maybe ty              = Just (simplify ty)\n\n-- Used for sorting\ninstFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType)\ninstFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t }\n  = (map argCount ts, n, map simplify ts, argCount t, simplify t)\n\n\nfunTyConName :: Name\nfunTyConName = mkWiredInName gHC_PRIM\n                        (mkOccNameFS tcName FSLIT(\"(->)\"))\n                        funTyConKey\n                        (ATyCon funTyCon)       -- Relevant TyCon\n                        BuiltInSyntax\n\n--------------------------------------------------------------------------------\n-- Filtering hidden instances\n--------------------------------------------------------------------------------\n\n-- | A class or data type is hidden iff\n--\n-- * it is defined in one of the modules that are being processed\n--\n-- * and it is not exported by any non-hidden module\nisNameHidden :: ExportInfo -> Name -> Bool\nisNameHidden (names, modules) name =\n  nameModule name `Set.member` modules &&\n  not (name `Set.member` names)\n\n-- | We say that an instance is \u00c2\u00abhidden\u00c2\u00bb iff its class or any (part)\n-- of its type(s) is hidden.\nisInstanceHidden :: ExportInfo -> Class -> [Type] -> Bool\nisInstanceHidden expInfo cls tys =\n    instClassHidden || instTypeHidden\n  where\n    instClassHidden :: Bool\n    instClassHidden = isNameHidden expInfo $ getName cls\n\n    instTypeHidden :: Bool\n    instTypeHidden = any (isTypeHidden expInfo) tys\n\nisTypeHidden :: ExportInfo -> Type -> Bool\nisTypeHidden expInfo = typeHidden\n  where\n    typeHidden :: Type -> Bool\n    typeHidden t =\n      case t of\n        TyVarTy {} -> False\n        AppTy t1 t2 -> typeHidden t1 || typeHidden t2\n        FunTy t1 t2 -> typeHidden t1 || typeHidden t2\n        TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args\n        ForAllTy bndr ty -> typeHidden (tyVarKind (binderVar bndr)) || typeHidden ty\n        LitTy _ -> False\n        CastTy ty _ -> typeHidden ty\n        CoercionTy {} -> False\n\n    nameHidden :: Name -> Bool\n    nameHidden = isNameHidden expInfo\n", "num_lines": 261}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, TupleSections, BangPatterns, LambdaCase #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -Wwarn #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Interface.Create\n-- Copyright   :  (c) Simon Marlow      2003-2006,\n--                    David Waern       2006-2009,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- This module provides a single function 'createInterface',\n-- which creates a Haddock 'Interface' from the typechecking\n-- results 'TypecheckedModule' from GHC.\n-----------------------------------------------------------------------------\nmodule Haddock.Interface.Create (createInterface) where\n\nimport Documentation.Haddock.Doc (metaDocAppend)\nimport Documentation.Haddock.Utf8 as Utf8\nimport Haddock.Types\nimport Haddock.Options\nimport Haddock.GhcUtils\nimport Haddock.Utils\nimport Haddock.Convert\nimport Haddock.Interface.LexParseRn\nimport Haddock.Backends.Hyperlinker.Types\nimport Haddock.Backends.Hyperlinker.Ast as Hyperlinker\nimport Haddock.Backends.Hyperlinker.Parser as Hyperlinker\n\nimport Data.Bifunctor\nimport Data.Bitraversable\nimport qualified Data.ByteString as BS\nimport qualified Data.Map as M\nimport Data.Map (Map)\nimport Data.List\nimport Data.Maybe\nimport Data.Ord\nimport Control.Applicative\nimport Control.Exception (evaluate)\nimport Control.Monad\nimport Data.Traversable\n\nimport Avail hiding (avail)\nimport qualified Avail\nimport qualified Module\nimport qualified SrcLoc\nimport ConLike (ConLike(..))\nimport GHC\nimport HscTypes\nimport Name\nimport NameSet\nimport NameEnv\nimport Packages   ( lookupModuleInAllPackages, PackageName(..) )\nimport Bag\nimport RdrName\nimport TcRnTypes\nimport FastString ( concatFS, unpackFS )\nimport BasicTypes ( StringLiteral(..), SourceText(..) )\nimport qualified Outputable as O\nimport HsDecls    ( getConDetails )\n\n\n-- | Use a 'TypecheckedModule' to produce an 'Interface'.\n-- To do this, we need access to already processed modules in the topological\n-- sort. That's what's in the 'IfaceMap'.\ncreateInterface :: TypecheckedModule\n                -> [Flag]       -- Boolean flags\n                -> IfaceMap     -- Locally processed modules\n                -> InstIfaceMap -- External, already installed interfaces\n                -> ErrMsgGhc Interface\ncreateInterface tm flags modMap instIfaceMap = do\n\n  let ms             = pm_mod_summary . tm_parsed_module $ tm\n      mi             = moduleInfo tm\n      L _ hsm        = parsedSource tm\n      !safety        = modInfoSafe mi\n      mdl            = ms_mod ms\n      sem_mdl        = tcg_semantic_mod (fst (tm_internals_ tm))\n      is_sig         = ms_hsc_src ms == HsigFile\n      dflags         = ms_hspp_opts ms\n      !instances     = modInfoInstances mi\n      !fam_instances = md_fam_insts md\n      !exportedNames = modInfoExportsWithSelectors mi\n      (pkgNameFS, _) = modulePackageInfo dflags flags mdl\n      pkgName        = fmap (unpackFS . (\\(PackageName n) -> n)) pkgNameFS\n\n      (TcGblEnv { tcg_rdr_env = gre\n                , tcg_warns   = warnings\n                , tcg_exports = all_exports\n                }, md) = tm_internals_ tm\n\n  -- The 'pkgName' is necessary to decide what package to mention in \"@since\"\n  -- annotations. Not having it is not fatal though.\n  --\n  -- Cabal can be trusted to pass the right flags, so this warning should be\n  -- mostly encountered when running Haddock outside of Cabal.\n  when (isNothing pkgName) $\n    liftErrMsg $ tell [ \"Warning: Package name is not available.\" ]\n\n  -- The renamed source should always be available to us, but it's best\n  -- to be on the safe side.\n  (group_, imports, mayExports, mayDocHeader) <-\n    case renamedSource tm of\n      Nothing -> do\n        liftErrMsg $ tell [ \"Warning: Renamed source is not available.\" ]\n        return (emptyRnGroup, [], Nothing, Nothing)\n      Just x -> return x\n\n  opts <- liftErrMsg $ mkDocOpts (haddockOptions dflags) flags mdl\n\n  -- Process the top-level module header documentation.\n  (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags pkgName gre safety mayDocHeader\n\n  let declsWithDocs = topDecls group_\n\n      exports0 = fmap (reverse . map (first unLoc)) mayExports\n      exports\n        | OptIgnoreExports `elem` opts = Nothing\n        | otherwise = exports0\n\n      unrestrictedImportedMods\n        -- module re-exports are only possible with\n        -- explicit export list\n        | Just{} <- exports\n        = unrestrictedModuleImports (map unLoc imports)\n        | otherwise = M.empty\n\n      fixMap = mkFixMap group_\n      (decls, _) = unzip declsWithDocs\n      localInsts = filter (nameIsLocalOrFrom sem_mdl)\n                        $  map getName instances\n                        ++ map getName fam_instances\n      -- Locations of all TH splices\n      splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ]\n\n  warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames)\n\n  maps@(!docMap, !argMap, !declMap, _) <-\n    liftErrMsg (mkMaps dflags pkgName gre localInsts declsWithDocs)\n\n  let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))\n\n  -- The MAIN functionality: compute the export items which will\n  -- each be the actual documentation of this module.\n  exportItems <- mkExportItems is_sig modMap pkgName mdl sem_mdl allWarnings gre\n                   exportedNames decls maps fixMap unrestrictedImportedMods\n                   splices exports all_exports instIfaceMap dflags\n\n  let !visibleNames = mkVisibleNames maps exportItems opts\n\n  -- Measure haddock documentation coverage.\n  let prunedExportItems0 = pruneExportItems exportItems\n      !haddockable = 1 + length exportItems -- module + exports\n      !haddocked = (if isJust mbDoc then 1 else 0) + length prunedExportItems0\n      !coverage = (haddockable, haddocked)\n\n  -- Prune the export list to just those declarations that have\n  -- documentation, if the 'prune' option is on.\n  let prunedExportItems'\n        | OptPrune `elem` opts = prunedExportItems0\n        | otherwise = exportItems\n      !prunedExportItems = seqList prunedExportItems' `seq` prunedExportItems'\n\n  let !aliases =\n        mkAliasMap dflags $ tm_renamed_source tm\n\n  modWarn <- liftErrMsg (moduleWarning dflags gre warnings)\n\n  tokenizedSrc <- mkMaybeTokenizedSrc dflags flags tm\n\n  return $! Interface {\n    ifaceMod               = mdl\n  , ifaceIsSig             = is_sig\n  , ifaceOrigFilename      = msHsFilePath ms\n  , ifaceInfo              = info\n  , ifaceDoc               = Documentation mbDoc modWarn\n  , ifaceRnDoc             = Documentation Nothing Nothing\n  , ifaceOptions           = opts\n  , ifaceDocMap            = docMap\n  , ifaceArgMap            = argMap\n  , ifaceRnDocMap          = M.empty\n  , ifaceRnArgMap          = M.empty\n  , ifaceExportItems       = prunedExportItems\n  , ifaceRnExportItems     = []\n  , ifaceExports           = exportedNames\n  , ifaceVisibleExports    = visibleNames\n  , ifaceDeclMap           = declMap\n  , ifaceFixMap            = fixMap\n  , ifaceModuleAliases     = aliases\n  , ifaceInstances         = instances\n  , ifaceFamInstances      = fam_instances\n  , ifaceOrphanInstances   = [] -- Filled in `attachInstances`\n  , ifaceRnOrphanInstances = [] -- Filled in `renameInterface`\n  , ifaceHaddockCoverage   = coverage\n  , ifaceWarningMap        = warningMap\n  , ifaceTokenizedSrc      = tokenizedSrc\n  }\n\n\n-- | Given all of the @import M as N@ declarations in a package,\n-- create a mapping from the module identity of M, to an alias N\n-- (if there are multiple aliases, we pick the last one.)  This\n-- will go in 'ifaceModuleAliases'.\nmkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName\nmkAliasMap dflags mRenamedSource =\n  case mRenamedSource of\n    Nothing -> M.empty\n    Just (_,impDecls,_,_) ->\n      M.fromList $\n      mapMaybe (\\(SrcLoc.L _ impDecl) -> do\n        SrcLoc.L _ alias <- ideclAs impDecl\n        return $\n          (lookupModuleDyn dflags\n             -- TODO: This is supremely dodgy, because in general the\n             -- UnitId isn't going to look anything like the package\n             -- qualifier (even with old versions of GHC, the\n             -- IPID would be p-0.1, but a package qualifier never\n             -- has a version number it.  (Is it possible that in\n             -- Haddock-land, the UnitIds never have version numbers?\n             -- I, ezyang, have not quite understand Haddock's package\n             -- identifier model.)\n             --\n             -- Additionally, this is simulating some logic GHC already\n             -- has for deciding how to qualify names when it outputs\n             -- them to the user.  We should reuse that information;\n             -- or at least reuse the renamed imports, which know what\n             -- they import!\n             (fmap Module.fsToUnitId $\n              fmap sl_fs $ ideclPkgQual impDecl)\n             (case ideclName impDecl of SrcLoc.L _ name -> name),\n           alias))\n        impDecls\n\n-- We want to know which modules are imported without any qualification. This\n-- way we can display module reexports more compactly. This mapping also looks\n-- through aliases:\n--\n-- module M (module X) where\n--   import M1 as X\n--   import M2 as X\n--\n-- With our mapping we know that we can display exported modules M1 and M2.\n--\nunrestrictedModuleImports :: [ImportDecl name] -> M.Map ModuleName [ModuleName]\nunrestrictedModuleImports idecls =\n  M.map (map (unLoc . ideclName))\n  $ M.filter (all isInteresting) impModMap\n  where\n    impModMap =\n      M.fromListWith (++) (concatMap moduleMapping idecls)\n\n    moduleMapping idecl =\n      concat [ [ (unLoc (ideclName idecl), [idecl]) ]\n             , [ (unLoc mod_name, [idecl])\n               | Just mod_name <- [ideclAs idecl]\n               ]\n             ]\n\n    isInteresting idecl =\n      case ideclHiding idecl of\n        -- i) no subset selected\n        Nothing             -> True\n        -- ii) an import with a hiding clause\n        -- without any names\n        Just (True, L _ []) -> True\n        -- iii) any other case of qualification\n        _                   -> False\n\n-- Similar to GHC.lookupModule\n-- ezyang: Not really...\nlookupModuleDyn ::\n  DynFlags -> Maybe UnitId -> ModuleName -> Module\nlookupModuleDyn _ (Just pkgId) mdlName =\n  Module.mkModule pkgId mdlName\nlookupModuleDyn dflags Nothing mdlName =\n  case lookupModuleInAllPackages dflags mdlName of\n    (m,_):_ -> m\n    [] -> Module.mkModule Module.mainUnitId mdlName\n\n\n-------------------------------------------------------------------------------\n-- Warnings\n-------------------------------------------------------------------------------\n\nmkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap\nmkWarningMap dflags warnings gre exps = case warnings of\n  NoWarnings  -> pure M.empty\n  WarnAll _   -> pure M.empty\n  WarnSome ws ->\n    let ws' = [ (n, w)\n              | (occ, w) <- ws\n              , elt <- lookupGlobalRdrEnv gre occ\n              , let n = gre_name elt, n `elem` exps ]\n    in M.fromList <$> traverse (bitraverse pure (parseWarning dflags gre)) ws'\n\nmoduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))\nmoduleWarning _ _ NoWarnings = pure Nothing\nmoduleWarning _ _ (WarnSome _) = pure Nothing\nmoduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w\n\nparseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)\nparseWarning dflags gre w = case w of\n  DeprecatedTxt _ msg -> format \"Deprecated: \" (concatFS $ map (sl_fs . unLoc) msg)\n  WarningTxt    _ msg -> format \"Warning: \"    (concatFS $ map (sl_fs . unLoc) msg)\n  where\n    format x xs = DocWarning . DocParagraph . DocAppend (DocString x)\n                  <$> processDocString dflags gre (HsDocString xs)\n\n\n-------------------------------------------------------------------------------\n-- Doc options\n--\n-- Haddock options that are embedded in the source file\n-------------------------------------------------------------------------------\n\n\nmkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption]\nmkDocOpts mbOpts flags mdl = do\n  opts <- case mbOpts of\n    Just opts -> case words $ replace ',' ' ' opts of\n      [] -> tell [\"No option supplied to DOC_OPTION/doc_option\"] >> return []\n      xs -> liftM catMaybes (mapM parseOption xs)\n    Nothing -> return []\n  pure (foldl go opts flags)\n  where\n    mdlStr = moduleString mdl\n\n    -- Later flags override earlier ones\n    go os m | m == Flag_HideModule mdlStr     = OptHide : os\n            | m == Flag_ShowModule mdlStr     = filter (/= OptHide) os\n            | m == Flag_ShowAllModules        = filter (/= OptHide) os\n            | m == Flag_IgnoreAllExports      = OptIgnoreExports : os\n            | m == Flag_ShowExtensions mdlStr = OptIgnoreExports : os\n            | otherwise                       = os\n\nparseOption :: String -> ErrMsgM (Maybe DocOption)\nparseOption \"hide\"            = return (Just OptHide)\nparseOption \"prune\"           = return (Just OptPrune)\nparseOption \"ignore-exports\"  = return (Just OptIgnoreExports)\nparseOption \"not-home\"        = return (Just OptNotHome)\nparseOption \"show-extensions\" = return (Just OptShowExtensions)\nparseOption other = tell [\"Unrecognised option: \" ++ other] >> return Nothing\n\n\n--------------------------------------------------------------------------------\n-- Maps\n--------------------------------------------------------------------------------\n\n\ntype Maps = (DocMap Name, ArgMap Name, DeclMap, InstMap)\n\n-- | Create 'Maps' by looping through the declarations. For each declaration,\n-- find its names, its subordinates, and its doc strings. Process doc strings\n-- into 'Doc's.\nmkMaps :: DynFlags\n       -> Maybe Package  -- this package\n       -> GlobalRdrEnv\n       -> [Name]\n       -> [(LHsDecl GhcRn, [HsDocString])]\n       -> ErrMsgM Maps\nmkMaps dflags pkgName gre instances decls = do\n  (a, b, c) <- unzip3 <$> traverse mappings decls\n  pure ( f' (map (nubByName fst) a)\n       , f  (filterMapping (not . M.null) b)\n       , f  (filterMapping (not . null) c)\n       , instanceMap\n       )\n  where\n    f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b\n    f = M.fromListWith (<>) . concat\n\n    f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name)\n    f' = M.fromListWith metaDocAppend . concat\n\n    filterMapping :: (b -> Bool) ->  [[(a, b)]] -> [[(a, b)]]\n    filterMapping p = map (filter (p . snd))\n\n    mappings :: (LHsDecl GhcRn, [HsDocString])\n             -> ErrMsgM ( [(Name, MDoc Name)]\n                        , [(Name, Map Int (MDoc Name))]\n                        , [(Name,  [LHsDecl GhcRn])]\n                        )\n    mappings (ldecl, docStrs) = do\n      let L l decl = ldecl\n          declDoc :: [HsDocString] -> Map Int HsDocString\n                  -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))\n          declDoc strs m = do\n            doc' <- processDocStrings dflags pkgName gre strs\n            m'   <- traverse (processDocStringParas dflags pkgName gre) m\n            pure (doc', m')\n\n      (doc, args) <- declDoc docStrs (typeDocs decl)\n\n      let\n          subs :: [(Name, [HsDocString], Map Int HsDocString)]\n          subs = subordinates instanceMap decl\n\n      (subDocs, subArgs) <- unzip <$> traverse (\\(_, strs, m) -> declDoc strs m) subs\n\n      let\n          ns = names l decl\n          subNs = [ n | (n, _, _) <- subs ]\n          dm = [ (n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs ]\n          am = [ (n, args) | n <- ns ] ++ zip subNs subArgs\n          cm = [ (n, [ldecl]) | n <- ns ++ subNs ]\n\n      seqList ns `seq`\n        seqList subNs `seq`\n        doc `seq`\n        seqList subDocs `seq`\n        seqList subArgs `seq`\n        pure (dm, am, cm)\n\n    instanceMap :: Map SrcSpan Name\n    instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]\n\n    names :: SrcSpan -> HsDecl GhcRn -> [Name]\n    names _ (InstD d) = maybeToList (M.lookup loc instanceMap) -- See note [2].\n      where loc = case d of\n              -- The CoAx's loc is the whole line, but only for TFs. The\n              -- workaround is to dig into the family instance declaration and\n              -- get the identifier with the right location.\n              TyFamInstD (TyFamInstDecl d') -> getLoc (feqn_tycon (hsib_body d'))\n              _ -> getInstLoc d\n    names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].\n    names _ decl = getMainDeclBinder decl\n\n-- Note [2]:\n------------\n-- We relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried\n-- inside them. That should work for normal user-written instances (from\n-- looking at GHC sources). We can assume that commented instances are\n-- user-written. This lets us relate Names (from ClsInsts) to comments\n-- (associated with InstDecls and DerivDecls).\n\n--------------------------------------------------------------------------------\n-- Declarations\n--------------------------------------------------------------------------------\n\n\n-- | Get all subordinate declarations inside a declaration, and their docs.\n-- A subordinate declaration is something like the associate type or data\n-- family of a type class.\nsubordinates :: InstMap\n             -> HsDecl GhcRn\n             -> [(Name, [HsDocString], Map Int HsDocString)]\nsubordinates instMap decl = case decl of\n  InstD (ClsInstD d) -> do\n    DataFamInstDecl { dfid_eqn = HsIB { hsib_body =\n      FamEqn { feqn_tycon = L l _\n             , feqn_rhs   = defn }}} <- unLoc <$> cid_datafam_insts d\n    [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs defn\n\n  InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body = d })))\n    -> dataSubs (feqn_rhs d)\n  TyClD d | isClassDecl d -> classSubs d\n          | isDataDecl  d -> dataSubs (tcdDataDefn d)\n  _ -> []\n  where\n    classSubs dd = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls dd\n                   , name <- getMainDeclBinder d, not (isValD d)\n                   ]\n    dataSubs :: HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]\n    dataSubs dd = constrs ++ fields ++ derivs\n      where\n        cons = map unL $ (dd_cons dd)\n        constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)\n                  | c <- cons, cname <- getConNames c ]\n        fields  = [ (selectorFieldOcc n, maybeToList $ fmap unL doc, M.empty)\n                  | RecCon flds <- map getConDetails cons\n                  , L _ (ConDeclField ns _ doc) <- (unLoc flds)\n                  , L _ n <- ns ]\n        derivs  = [ (instName, [unL doc], M.empty)\n                  | HsIB { hsib_body = L l (HsDocTy _ doc) }\n                      <- concatMap (unLoc . deriv_clause_tys . unLoc) $\n                           unLoc $ dd_derivs dd\n                  , Just instName <- [M.lookup l instMap] ]\n\n-- | Extract function argument docs from inside types.\ntypeDocs :: HsDecl GhcRn -> Map Int HsDocString\ntypeDocs d =\n  let docs = go 0 in\n  case d of\n    SigD (TypeSig _ ty)      -> docs (unLoc (hsSigWcType ty))\n    SigD (ClassOpSig _ _ ty) -> docs (unLoc (hsSigType ty))\n    SigD (PatSynSig _ ty)    -> docs (unLoc (hsSigType ty))\n    ForD (ForeignImport _ ty _ _)   -> docs (unLoc (hsSigType ty))\n    TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)\n    _ -> M.empty\n  where\n    go n (HsForAllTy { hst_body = ty }) = go n (unLoc ty)\n    go n (HsQualTy   { hst_body = ty }) = go n (unLoc ty)\n    go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty\n    go n (HsFunTy _ ty) = go (n+1) (unLoc ty)\n    go n (HsDocTy _ (L _ doc)) = M.singleton n doc\n    go _ _ = M.empty\n\n\n-- | All the sub declarations of a class (that we handle), ordered by\n-- source location, with documentation attached if it exists.\nclassDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]\nclassDecls class_ = filterDecls . collectDocs . sortByLoc $ decls\n  where\n    decls = docs ++ defs ++ sigs ++ ats\n    docs  = mkDecls tcdDocs DocD class_\n    defs  = mkDecls (bagToList . tcdMeths) ValD class_\n    sigs  = mkDecls tcdSigs SigD class_\n    ats   = mkDecls tcdATs (TyClD . FamDecl) class_\n\n\n-- | The top-level declarations of a module that we care about,\n-- ordered by source location, with documentation attached if it exists.\ntopDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])]\ntopDecls =\n  filterClasses . filterDecls . collectDocs . sortByLoc . ungroup\n\n-- | Extract a map of fixity declarations only\nmkFixMap :: HsGroup GhcRn -> FixMap\nmkFixMap group_ = M.fromList [ (n,f)\n                             | L _ (FixitySig ns f) <- hs_fixds group_,\n                               L _ n <- ns ]\n\n\n-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.\nungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]\nungroup group_ =\n  mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD  group_ ++\n  mkDecls hs_derivds             DerivD group_ ++\n  mkDecls hs_defds               DefD   group_ ++\n  mkDecls hs_fords               ForD   group_ ++\n  mkDecls hs_docs                DocD   group_ ++\n  mkDecls (tyClGroupInstDecls . hs_tyclds) InstD  group_ ++\n  mkDecls (typesigs . hs_valds)  SigD   group_ ++\n  mkDecls (valbinds . hs_valds)  ValD   group_\n  where\n    typesigs (ValBindsOut _ sigs) = filter isUserLSig sigs\n    typesigs _ = error \"expected ValBindsOut\"\n\n    valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds\n    valbinds _ = error \"expected ValBindsOut\"\n\n\n-- | Take a field of declarations from a data structure and create HsDecls\n-- using the given constructor\nmkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]\nmkDecls field con struct = [ L loc (con decl) | L loc decl <- field struct ]\n\n\n-- | Sort by source location\nsortByLoc :: [Located a] -> [Located a]\nsortByLoc = sortBy (comparing getLoc)\n\n\n--------------------------------------------------------------------------------\n-- Filtering of declarations\n--\n-- We filter out declarations that we don't intend to handle later.\n--------------------------------------------------------------------------------\n\n\n-- | Filter out declarations that we don't handle in Haddock\nfilterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]\nfilterDecls = filter (isHandled . unL . fst)\n  where\n    isHandled (ForD (ForeignImport {})) = True\n    isHandled (TyClD {})  = True\n    isHandled (InstD {})  = True\n    isHandled (DerivD {}) = True\n    isHandled (SigD d) = isUserLSig (reL d)\n    isHandled (ValD _) = True\n    -- we keep doc declarations to be able to get at named docs\n    isHandled (DocD _) = True\n    isHandled _ = False\n\n-- | Go through all class declarations and filter their sub-declarations\nfilterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]\nfilterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x\n                      | x@(L loc d, doc) <- decls ]\n  where\n    filterClass (TyClD c) =\n      TyClD $ c { tcdSigs = filter (liftA2 (||) isUserLSig isMinimalLSig) $ tcdSigs c }\n    filterClass _ = error \"expected TyClD\"\n\n\n--------------------------------------------------------------------------------\n-- Collect docs\n--\n-- To be able to attach the right Haddock comment to the right declaration,\n-- we sort the declarations by their SrcLoc and \"collect\" the docs for each\n-- declaration.\n--------------------------------------------------------------------------------\n\n\n-- | Collect docs and attach them to the right declarations.\ncollectDocs :: [LHsDecl a] -> [(LHsDecl a, [HsDocString])]\ncollectDocs = go Nothing []\n  where\n    go Nothing _ [] = []\n    go (Just prev) docs [] = finished prev docs []\n    go prev docs (L _ (DocD (DocCommentNext str)) : ds)\n      | Nothing <- prev = go Nothing (str:docs) ds\n      | Just decl <- prev = finished decl docs (go Nothing [str] ds)\n    go prev docs (L _ (DocD (DocCommentPrev str)) : ds) = go prev (str:docs) ds\n    go Nothing docs (d:ds) = go (Just d) docs ds\n    go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)\n\n    finished decl docs rest = (decl, reverse docs) : rest\n\n\n-- | Build the list of items that will become the documentation, from the\n-- export list.  At this point, the list of ExportItems is in terms of\n-- original names.\n--\n-- We create the export items even if the module is hidden, since they\n-- might be useful when creating the export items for other modules.\nmkExportItems\n  :: Bool               -- is it a signature\n  -> IfaceMap\n  -> Maybe Package      -- this package\n  -> Module             -- this module\n  -> Module             -- semantic module\n  -> WarningMap\n  -> GlobalRdrEnv\n  -> [Name]             -- exported names (orig)\n  -> [LHsDecl GhcRn]    -- renamed source declarations\n  -> Maps\n  -> FixMap\n  -> M.Map ModuleName [ModuleName]\n  -> [SrcSpan]          -- splice locations\n  -> Maybe [(IE GhcRn, Avails)]\n  -> Avails             -- exported stuff from this module\n  -> InstIfaceMap\n  -> DynFlags\n  -> ErrMsgGhc [ExportItem GhcRn]\nmkExportItems\n  is_sig modMap pkgName thisMod semMod warnings gre exportedNames decls\n  maps fixMap unrestricted_imp_mods splices exportList allExports\n  instIfaceMap dflags =\n  case exportList of\n    Nothing      ->\n      fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre\n        exportedNames decls maps fixMap splices instIfaceMap dflags\n        allExports\n    Just exports -> liftM concat $ mapM lookupExport exports\n  where\n    lookupExport (IEGroup lev docStr, _)  = liftErrMsg $ do\n      doc <- processDocString dflags gre docStr\n      return [ExportGroup lev \"\" doc]\n\n    lookupExport (IEDoc docStr, _)        = liftErrMsg $ do\n      doc <- processDocStringParas dflags pkgName gre docStr\n      return [ExportDoc doc]\n\n    lookupExport (IEDocNamed str, _)      = liftErrMsg $\n      findNamedDoc str [ unL d | d <- decls ] >>= \\case\n        Nothing -> return  []\n        Just docStr -> do\n          doc <- processDocStringParas dflags pkgName gre docStr\n          return [ExportDoc doc]\n\n    lookupExport (IEModuleContents (L _ mod_name), _)\n      -- only consider exporting a module if we are sure we\n      -- are really exporting the whole module and not some\n      -- subset. We also look through module aliases here.\n      | Just mods <- M.lookup mod_name unrestricted_imp_mods\n      , not (null mods)\n      = concat <$> traverse (moduleExport thisMod dflags modMap instIfaceMap) mods\n\n    lookupExport (_, avails) =\n      concat <$> traverse availExport (nubAvails avails)\n\n    availExport avail =\n      availExportItem is_sig modMap thisMod semMod warnings exportedNames\n        maps fixMap splices instIfaceMap dflags avail\n\navailExportItem :: Bool               -- is it a signature\n                -> IfaceMap\n                -> Module             -- this module\n                -> Module             -- semantic module\n                -> WarningMap\n                -> [Name]             -- exported names (orig)\n                -> Maps\n                -> FixMap\n                -> [SrcSpan]          -- splice locations\n                -> InstIfaceMap\n                -> DynFlags\n                -> AvailInfo\n                -> ErrMsgGhc [ExportItem GhcRn]\navailExportItem is_sig modMap thisMod semMod warnings exportedNames\n  (docMap, argMap, declMap, _) fixMap splices instIfaceMap\n  dflags availInfo = declWith availInfo\n  where\n    declWith :: AvailInfo -> ErrMsgGhc [ ExportItem GhcRn ]\n    declWith avail = do\n      let t = availName avail\n      r    <- findDecl avail\n      case r of\n        ([L l (ValD _)], (doc, _)) -> do\n          -- Top-level binding without type signature\n          export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap\n          return [export]\n        (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds ->\n          let declNames = getMainDeclBinder (unL decl)\n          in case () of\n            _\n              -- We should not show a subordinate by itself if any of its\n              -- parents is also exported. See note [1].\n              | t `notElem` declNames,\n                Just p <- find isExported (parents t $ unL decl) ->\n                do liftErrMsg $ tell [\n                     \"Warning: \" ++ moduleString thisMod ++ \": \" ++\n                     pretty dflags (nameOccName t) ++ \" is exported separately but \" ++\n                     \"will be documented under \" ++ pretty dflags (nameOccName p) ++\n                     \". Consider exporting it together with its parent(s)\" ++\n                     \" for code clarity.\" ]\n                   return []\n\n              -- normal case\n              | otherwise -> case decl of\n                  -- A single signature might refer to many names, but we\n                  -- create an export item for a single name only.  So we\n                  -- modify the signature to contain only that single name.\n                  L loc (SigD sig) ->\n                    -- fromJust is safe since we already checked in guards\n                    -- that 't' is a name declared in this declaration.\n                    let newDecl = L loc . SigD . fromJust $ filterSigNames (== t) sig\n                    in availExportDecl avail newDecl docs_\n\n                  L loc (TyClD cl@ClassDecl{}) -> do\n                    mdef <- liftGhcToErrMsgGhc $ minimalDef t\n                    let sig = maybeToList $ fmap (noLoc . MinimalSig NoSourceText . noLoc . fmap noLoc) mdef\n                    availExportDecl avail\n                      (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_\n\n                  _ -> availExportDecl avail decl docs_\n\n        -- Declaration from another package\n        ([], _) -> do\n          mayDecl <- hiDecl dflags t\n          case mayDecl of\n            Nothing -> return [ ExportNoDecl t [] ]\n            Just decl ->\n              -- We try to get the subs and docs\n              -- from the installed .haddock file for that package.\n              -- TODO: This needs to be more sophisticated to deal\n              -- with signature inheritance\n              case M.lookup (nameModule t) instIfaceMap of\n                Nothing -> do\n                   liftErrMsg $ tell\n                      [\"Warning: Couldn't find .haddock for export \" ++ pretty dflags t]\n                   let subs_ = availNoDocs avail\n                   availExportDecl avail decl (noDocForDecl, subs_)\n                Just iface ->\n                  availExportDecl avail decl (lookupDocs avail warnings (instDocMap iface) (instArgMap iface))\n\n        _ -> return []\n\n    availExportDecl :: AvailInfo -> LHsDecl GhcRn\n                    -> (DocForDecl Name, [(Name, DocForDecl Name)])\n                    -> ErrMsgGhc [ ExportItem GhcRn ]\n    availExportDecl avail decl (doc, subs)\n      | availExportsDecl avail = do\n          -- bundled pattern synonyms only make sense if the declaration is\n          -- exported (otherwise there would be nothing to bundle to)\n          bundledPatSyns <- findBundledPatterns avail\n\n          let\n            patSynNames =\n              concatMap (getMainDeclBinder . fst) bundledPatSyns\n\n            fixities =\n                [ (n, f)\n                | n <- availName avail : fmap fst subs ++ patSynNames\n                , Just f <- [M.lookup n fixMap]\n                ]\n\n          return [ ExportDecl {\n                       expItemDecl      = restrictTo (fmap fst subs)\n                                            (extractDecl declMap (availName avail) decl)\n                     , expItemPats      = bundledPatSyns\n                     , expItemMbDoc     = doc\n                     , expItemSubDocs   = subs\n                     , expItemInstances = []\n                     , expItemFixities  = fixities\n                     , expItemSpliced   = False\n                     }\n                 ]\n\n      | otherwise =\n          return [ ExportDecl {\n                       expItemDecl      = extractDecl declMap sub decl\n                     , expItemPats      = []\n                     , expItemMbDoc     = sub_doc\n                     , expItemSubDocs   = []\n                     , expItemInstances = []\n                     , expItemFixities  = [ (sub, f) | Just f <- [M.lookup sub fixMap] ]\n                     , expItemSpliced   = False\n                     }\n                 | (sub, sub_doc) <- subs\n                 ]\n\n    exportedNameSet = mkNameSet exportedNames\n    isExported n = elemNameSet n exportedNameSet\n\n    findDecl :: AvailInfo -> ErrMsgGhc ([LHsDecl GhcRn], (DocForDecl Name, [(Name, DocForDecl Name)]))\n    findDecl avail\n      | m == semMod =\n          case M.lookup n declMap of\n            Just ds -> return (ds, lookupDocs avail warnings docMap argMap)\n            Nothing\n              | is_sig -> do\n                -- OK, so it wasn't in the local declaration map.  It could\n                -- have been inherited from a signature.  Reconstitute it\n                -- from the type.\n                mb_r <- hiDecl dflags n\n                case mb_r of\n                    Nothing -> return ([], (noDocForDecl, availNoDocs avail))\n                    -- TODO: If we try harder, we might be able to find\n                    -- a Haddock!  Look in the Haddocks for each thing in\n                    -- requirementContext (pkgState)\n                    Just decl -> return ([decl], (noDocForDecl, availNoDocs avail))\n              | otherwise ->\n                return ([], (noDocForDecl, availNoDocs avail))\n      | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap\n      , Just ds <- M.lookup n (ifaceDeclMap iface) =\n          return (ds, lookupDocs avail warnings\n                            (ifaceDocMap iface)\n                            (ifaceArgMap iface))\n      | otherwise = return ([], (noDocForDecl, availNoDocs avail))\n      where\n        n = availName avail\n        m = nameModule n\n\n    findBundledPatterns :: AvailInfo -> ErrMsgGhc [(HsDecl GhcRn, DocForDecl Name)]\n    findBundledPatterns avail = do\n      patsyns <- for constructor_names $ \\name -> do\n        mtyThing <- liftGhcToErrMsgGhc (lookupName name)\n        case mtyThing of\n          Just (AConLike PatSynCon{}) -> do\n            export_items <- declWith (Avail.avail name)\n            pure [ (unLoc patsyn_decl, patsyn_doc)\n                 | ExportDecl {\n                       expItemDecl  = patsyn_decl\n                     , expItemMbDoc = patsyn_doc\n                     } <- export_items\n                 ]\n          _ -> pure []\n      pure (concat patsyns)\n      where\n        constructor_names =\n          filter isDataConName (availSubordinates avail)\n\n-- this heavily depends on the invariants stated in Avail\navailExportsDecl :: AvailInfo -> Bool\navailExportsDecl (AvailTC ty_name names _)\n  | n : _ <- names = ty_name == n\n  | otherwise      = False\navailExportsDecl _ = True\n\navailSubordinates :: AvailInfo -> [Name]\navailSubordinates avail =\n  filter (/= availName avail) (availNamesWithSelectors avail)\n\navailNoDocs :: AvailInfo -> [(Name, DocForDecl Name)]\navailNoDocs avail =\n  zip (availSubordinates avail) (repeat noDocForDecl)\n\n-- | Given a 'Module' from a 'Name', convert it into a 'Module' that\n-- we can actually find in the 'IfaceMap'.\nsemToIdMod :: UnitId -> Module -> Module\nsemToIdMod this_uid m\n    | Module.isHoleModule m = mkModule this_uid (moduleName m)\n    | otherwise      = m\n\nhiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl GhcRn))\nhiDecl dflags t = do\n  mayTyThing <- liftGhcToErrMsgGhc $ lookupName t\n  case mayTyThing of\n    Nothing -> do\n      liftErrMsg $ tell [\"Warning: Not found in environment: \" ++ pretty dflags t]\n      return Nothing\n    Just x -> case tyThingToLHsDecl x of\n      Left m -> liftErrMsg (tell [bugWarn m]) >> return Nothing\n      Right (m, t') -> liftErrMsg (tell $ map bugWarn m)\n                      >> return (Just $ noLoc t')\n    where\n      warnLine x = O.text \"haddock-bug:\" O.<+> O.text x O.<>\n                   O.comma O.<+> O.quotes (O.ppr t) O.<+>\n                   O.text \"-- Please report this on Haddock issue tracker!\"\n      bugWarn = O.showSDoc dflags . warnLine\n\n-- | This function is called for top-level bindings without type signatures.\n-- It gets the type signature from GHC and that means it's not going to\n-- have a meaningful 'SrcSpan'. So we pass down 'SrcSpan' for the\n-- declaration and use it instead - 'nLoc' here.\nhiValExportItem :: DynFlags -> Name -> SrcSpan -> DocForDecl Name -> Bool\n                -> Maybe Fixity -> ErrMsgGhc (ExportItem GhcRn)\nhiValExportItem dflags name nLoc doc splice fixity = do\n  mayDecl <- hiDecl dflags name\n  case mayDecl of\n    Nothing -> return (ExportNoDecl name [])\n    Just decl -> return (ExportDecl (fixSpan decl) [] doc [] [] fixities splice)\n  where\n    fixSpan (L l t) = L (SrcLoc.combineSrcSpans l nLoc) t\n    fixities = case fixity of\n      Just f  -> [(name, f)]\n      Nothing -> []\n\n\n-- | Lookup docs for a declaration from maps.\nlookupDocs :: AvailInfo -> WarningMap -> DocMap Name -> ArgMap Name\n           -> (DocForDecl Name, [(Name, DocForDecl Name)])\nlookupDocs avail warnings docMap argMap =\n  let n = availName avail in\n  let lookupArgDoc x = M.findWithDefault M.empty x argMap in\n  let doc = (lookupDoc n, lookupArgDoc n) in\n  let subDocs = [ (s, (lookupDoc s, lookupArgDoc s))\n                | s <- availSubordinates avail\n                ] in\n  (doc, subDocs)\n  where\n    lookupDoc name = Documentation (M.lookup name docMap) (M.lookup name warnings)\n\n\n-- | Export the given module as `ExportModule`. We are not concerned with the\n-- single export items of the given module.\nmoduleExport :: Module           -- ^ Module A (identity, NOT semantic)\n             -> DynFlags         -- ^ The flags used when typechecking A\n             -> IfaceMap         -- ^ Already created interfaces\n             -> InstIfaceMap     -- ^ Interfaces in other packages\n             -> ModuleName       -- ^ The exported module\n             -> ErrMsgGhc [ExportItem GhcRn] -- ^ Resulting export items\nmoduleExport thisMod dflags ifaceMap instIfaceMap expMod =\n    -- NB: we constructed the identity module when looking up in\n    -- the IfaceMap.\n    case M.lookup m ifaceMap of\n      Just iface\n        | OptHide `elem` ifaceOptions iface -> return (ifaceExportItems iface)\n        | otherwise -> return [ ExportModule m ]\n\n      Nothing -> -- We have to try to find it in the installed interfaces\n                 -- (external packages).\n        case M.lookup expMod (M.mapKeys moduleName instIfaceMap) of\n          Just iface -> return [ ExportModule (instMod iface) ]\n          Nothing -> do\n            liftErrMsg $\n              tell [\"Warning: \" ++ pretty dflags thisMod ++ \": Could not find \" ++\n                    \"documentation for exported module: \" ++ pretty dflags expMod]\n            return []\n  where\n    m = mkModule unitId expMod -- Identity module!\n    unitId = moduleUnitId thisMod\n\n-- Note [1]:\n------------\n-- It is unnecessary to document a subordinate by itself at the top level if\n-- any of its parents is also documented. Furthermore, if the subordinate is a\n-- record field or a class method, documenting it under its parent\n-- indicates its special status.\n--\n-- A user might expect that it should show up separately, so we issue a\n-- warning. It's a fine opportunity to also tell the user she might want to\n-- export the subordinate through the parent export item for clarity.\n--\n-- The code removes top-level subordinates also when the parent is exported\n-- through a 'module' export. I think that is fine.\n--\n-- (For more information, see Trac #69)\n\n\n-- | Simplified variant of 'mkExportItems', where we can assume that\n-- every locally defined declaration is exported; thus, we just\n-- zip through the renamed declarations.\n\nfullModuleContents :: Bool               -- is it a signature\n                   -> IfaceMap\n                   -> Maybe Package      -- this package\n                   -> Module             -- this module\n                   -> Module             -- semantic module\n                   -> WarningMap\n                   -> GlobalRdrEnv      -- ^ The renaming environment\n                   -> [Name]             -- exported names (orig)\n                   -> [LHsDecl GhcRn]    -- renamed source declarations\n                   -> Maps\n                   -> FixMap\n                   -> [SrcSpan]          -- splice locations\n                   -> InstIfaceMap\n                   -> DynFlags\n                   -> Avails\n                   -> ErrMsgGhc [ExportItem GhcRn]\nfullModuleContents is_sig modMap pkgName thisMod semMod warnings gre exportedNames\n  decls maps@(_, _, declMap, _) fixMap splices instIfaceMap dflags avails = do\n  let availEnv = availsToNameEnv (nubAvails avails)\n  (concat . concat) `fmap` (for decls $ \\decl -> do\n    case decl of\n      (L _ (DocD (DocGroup lev docStr))) -> do\n        doc <- liftErrMsg (processDocString dflags gre docStr)\n        return [[ExportGroup lev \"\" doc]]\n      (L _ (DocD (DocCommentNamed _ docStr))) -> do\n        doc <- liftErrMsg (processDocStringParas dflags pkgName gre docStr)\n        return [[ExportDoc doc]]\n      (L _ (ValD valDecl))\n        | name:_ <- collectHsBindBinders valDecl\n        , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap\n        -> return []\n      _ ->\n        for (getMainDeclBinder (unLoc decl)) $ \\nm -> do\n          case lookupNameEnv availEnv nm of\n            Just avail ->\n              availExportItem is_sig modMap thisMod\n                semMod warnings exportedNames maps fixMap\n                splices instIfaceMap dflags avail\n            Nothing -> pure [])\n  where\n    isSigD (L _ SigD{}) = True\n    isSigD _            = False\n\n-- | Sometimes the declaration we want to export is not the \"main\" declaration:\n-- it might be an individual record selector or a class method.  In these\n-- cases we have to extract the required declaration (and somehow cobble\n-- together a type signature for it...).\nextractDecl :: DeclMap -> Name -> LHsDecl GhcRn -> LHsDecl GhcRn\nextractDecl declMap name decl\n  | name `elem` getMainDeclBinder (unLoc decl) = decl\n  | otherwise  =\n    case unLoc decl of\n      TyClD d@ClassDecl {} ->\n        let\n          matchesMethod =\n            [ lsig\n            | lsig <- tcdSigs d\n            , ClassOpSig False _ _ <- pure $ unLoc lsig\n              -- Note: exclude `default` declarations (see #505)\n            , name `elem` sigName lsig\n            ]\n\n          matchesAssociatedType =\n            [ lfam_decl\n            | lfam_decl <- tcdATs d\n            , name == unLoc (fdLName (unLoc lfam_decl))\n            ]\n\n            -- TODO: document fixity\n        in case (matchesMethod, matchesAssociatedType)  of\n          ([s0], _) -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d)\n                           L pos sig = addClassContext n tyvar_names s0\n                       in L pos (SigD sig)\n          (_, [L pos fam_decl]) -> L pos (TyClD (FamDecl fam_decl))\n\n          ([], [])\n            | Just (famInstDecl:_) <- M.lookup name declMap\n            -> extractDecl declMap name famInstDecl\n          _ -> O.pprPanic \"extractDecl\" (O.text \"Ambiguous decl for\" O.<+> O.ppr name O.<+> O.text \"in class:\"\n                                         O.$$ O.nest 4 (O.ppr d)\n                                         O.$$ O.text \"Matches:\"\n                                         O.$$ O.nest 4 (O.ppr matchesMethod O.<+> O.ppr matchesAssociatedType))\n      TyClD d@DataDecl {} ->\n        let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))\n        in if isDataConName name\n           then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))\n           else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))\n      TyClD FamDecl {}\n        | isValName name\n        , Just (famInst:_) <- M.lookup name declMap\n        -> extractDecl declMap name famInst\n      InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body =\n                             FamEqn { feqn_tycon = L _ n\n                                    , feqn_pats  = tys\n                                    , feqn_rhs   = defn }}))) ->\n        if isDataConName name\n        then SigD <$> extractPatternSyn name n tys (dd_cons defn)\n        else SigD <$> extractRecSel name n tys (dd_cons defn)\n      InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts })\n        | isDataConName name ->\n            let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body =\n                                          FamEqn { feqn_rhs   = dd\n                                                 }\n                                         })) <- insts\n                               , name `elem` map unLoc (concatMap (getConNames . unLoc) (dd_cons dd))\n                               ]\n            in case matches of\n                [d0] -> extractDecl declMap name (noLoc (InstD (DataFamInstD d0)))\n                _    -> error \"internal: extractDecl (ClsInstD)\"\n        | otherwise ->\n            let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))\n                                   <- insts\n                                 -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)\n                               , RecCon rec <- map (getConDetails . unLoc) (dd_cons (feqn_rhs d))\n                               , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)\n                               , L _ n <- ns\n                               , selectorFieldOcc n == name\n                          ]\n            in case matches of\n              [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0)\n              _ -> error \"internal: extractDecl (ClsInstD)\"\n      _ -> error \"internal: extractDecl\"\n\n\nextractPatternSyn :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn\nextractPatternSyn nm t tvs cons =\n  case filter matches cons of\n    [] -> error \"extractPatternSyn: constructor pattern not found\"\n    con:_ -> extract <$> con\n where\n  matches :: LConDecl GhcRn -> Bool\n  matches (L _ con) = nm `elem` (unLoc <$> getConNames con)\n  extract :: ConDecl GhcRn -> Sig GhcRn\n  extract con =\n    let args =\n          case getConDetails con of\n            PrefixCon args' -> args'\n            RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields\n            InfixCon arg1 arg2 -> [arg1, arg2]\n        typ = longArrow args (data_ty con)\n        typ' =\n          case con of\n            ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)\n            _ -> typ\n        typ'' = noLoc (HsQualTy (noLoc []) typ')\n    in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'')\n\n  longArrow :: [LHsType name] -> LHsType name -> LHsType name\n  longArrow inputs output = foldr (\\x y -> noLoc (HsFunTy x y)) output inputs\n\n  data_ty con\n    | ConDeclGADT{} <- con = hsib_body $ con_type con\n    | otherwise = foldl' (\\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs\n\nextractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]\n              -> LSig GhcRn\nextractRecSel _ _ _ [] = error \"extractRecSel: selector not found\"\n\nextractRecSel nm t tvs (L _ con : rest) =\n  case getConDetails con of\n    RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->\n      L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy data_ty (getBangType ty)))))\n    _ -> extractRecSel nm t tvs rest\n where\n  matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]\n  matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds\n                                 , L l n <- ns, selectorFieldOcc n == nm ]\n  data_ty\n    -- ResTyGADT _ ty <- con_res con = ty\n    | ConDeclGADT{} <- con = hsib_body $ con_type con\n    | otherwise = foldl' (\\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs\n\n-- | Keep export items with docs.\npruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn]\npruneExportItems = filter hasDoc\n  where\n    hasDoc (ExportDecl{expItemMbDoc = (Documentation d _, _)}) = isJust d\n    hasDoc _ = True\n\n\nmkVisibleNames :: Maps -> [ExportItem GhcRn] -> [DocOption] -> [Name]\nmkVisibleNames (_, _, _, instMap) exports opts\n  | OptHide `elem` opts = []\n  | otherwise = let ns = concatMap exportName exports\n                in seqList ns `seq` ns\n  where\n    exportName e@ExportDecl {} = name ++ subs ++ patsyns\n      where subs    = map fst (expItemSubDocs e)\n            patsyns = concatMap (getMainDeclBinder . fst) (expItemPats e)\n            name = case unLoc $ expItemDecl e of\n              InstD d -> maybeToList $ M.lookup (getInstLoc d) instMap\n              decl    -> getMainDeclBinder decl\n    exportName ExportNoDecl {} = [] -- we don't count these as visible, since\n                                    -- we don't want links to go to them.\n    exportName _ = []\n\nseqList :: [a] -> ()\nseqList [] = ()\nseqList (x : xs) = x `seq` seqList xs\n\nmkMaybeTokenizedSrc :: DynFlags -> [Flag] -> TypecheckedModule\n                    -> ErrMsgGhc (Maybe [RichToken])\nmkMaybeTokenizedSrc dflags flags tm\n    | Flag_HyperlinkedSource `elem` flags = case renamedSource tm of\n        Just src -> do\n            tokens <- liftGhcToErrMsgGhc (liftIO (mkTokenizedSrc dflags summary src))\n            return $ Just tokens\n        Nothing -> do\n            liftErrMsg . tell . pure $ concat\n                [ \"Warning: Cannot hyperlink module \\\"\"\n                , moduleNameString . ms_mod_name $ summary\n                , \"\\\" because renamed source is not available\"\n                ]\n            return Nothing\n    | otherwise = return Nothing\n  where\n    summary = pm_mod_summary . tm_parsed_module $ tm\n\nmkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken]\nmkTokenizedSrc dflags ms src = do\n  -- make sure to read the whole file at once otherwise\n  -- we run out of file descriptors (see #495)\n  rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate\n  let tokens = Hyperlinker.parse dflags filepath (Utf8.decodeUtf8 rawSrc)\n  return $ Hyperlinker.enrich src tokens\n  where\n    filepath = msHsFilePath ms\n\n-- | Find a stand-alone documentation comment by its name.\nfindNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString)\nfindNamedDoc name = search\n  where\n    search [] = do\n      tell [\"Cannot find documentation for: $\" ++ name]\n      return Nothing\n    search (DocD (DocCommentNamed name' doc) : rest)\n      | name == name' = return (Just doc)\n      | otherwise = search rest\n    search (_other_decl : rest) = search rest\n", "num_lines": 1218}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\nmodule Haddock.Interface.Json (\n    jsonInstalledInterface\n  , jsonInterfaceFile\n  , renderJson\n  ) where\n\nimport BasicTypes\nimport Json\nimport Module\nimport Name\nimport Outputable\n\nimport Control.Arrow\nimport Data.Map (Map)\nimport Data.Bifunctor\nimport qualified Data.Map as Map\n\nimport Haddock.Types\nimport Haddock.InterfaceFile\n\njsonInterfaceFile :: InterfaceFile -> JsonDoc\njsonInterfaceFile InterfaceFile{..} =\n  jsonObject [ (\"link_env\" , jsonMap nameStableString (jsonString . moduleNameString . moduleName) ifLinkEnv)\n             , (\"inst_ifaces\", jsonArray (map jsonInstalledInterface ifInstalledIfaces))\n             ]\n\njsonInstalledInterface :: InstalledInterface -> JsonDoc\njsonInstalledInterface InstalledInterface{..} = jsonObject properties\n  where\n    properties =\n      [ (\"module\"          , jsonModule instMod)\n      , (\"is_sig\"          , jsonBool instIsSig)\n      , (\"info\"            , jsonHaddockModInfo instInfo)\n      , (\"doc_map\"         , jsonMap nameStableString jsonMDoc instDocMap)\n      , (\"arg_map\"         , jsonMap nameStableString (jsonMap show jsonMDoc) instArgMap)\n      , (\"exports\"         , jsonArray (map jsonName instExports))\n      , (\"visible_exports\" , jsonArray (map jsonName instVisibleExports))\n      , (\"options\"         , jsonArray (map (jsonString . show) instOptions))\n      , (\"fix_map\"         , jsonMap nameStableString jsonFixity instFixMap)\n      ]\n\njsonHaddockModInfo :: HaddockModInfo Name -> JsonDoc\njsonHaddockModInfo HaddockModInfo{..} =\n  jsonObject [ (\"description\" , jsonMaybe jsonDoc hmi_description)\n             , (\"copyright\"   , jsonMaybe jsonString hmi_copyright)\n             , (\"maintainer\"  , jsonMaybe jsonString hmi_maintainer)\n             , (\"stability\"   , jsonMaybe jsonString hmi_stability)\n             , (\"protability\" , jsonMaybe jsonString hmi_portability)\n             , (\"safety\"      , jsonMaybe jsonString hmi_safety)\n             , (\"language\"    , jsonMaybe (jsonString . show) hmi_language)\n             , (\"extensions\"  , jsonArray (map (jsonString . show) hmi_extensions))\n             ]\n\njsonMap :: (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc\njsonMap f g = jsonObject . map (f *** g) . Map.toList\n\njsonMDoc :: MDoc Name -> JsonDoc\njsonMDoc MetaDoc{..} =\n  jsonObject [ (\"meta\", jsonObject [(\"version\", jsonMaybe (jsonString . show) (_version _meta))])\n             , (\"doc\",  jsonDoc _doc)\n             ]\n\njsonDoc :: Doc Name -> JsonDoc\njsonDoc doc = jsonString (show (bimap (moduleNameString . fst) nameStableString doc))\n\njsonModule :: Module -> JsonDoc\njsonModule = JSString . moduleStableString\n\njsonName :: Name -> JsonDoc\njsonName = JSString . nameStableString\n\njsonFixity :: Fixity -> JsonDoc\njsonFixity (Fixity _ prec dir) =\n  jsonObject [ (\"prec\"      , jsonInt prec)\n             , (\"direction\" , jsonFixityDirection dir)\n             ]\n\njsonFixityDirection :: FixityDirection -> JsonDoc\njsonFixityDirection InfixL = jsonString \"infixl\"\njsonFixityDirection InfixR = jsonString \"infixr\"\njsonFixityDirection InfixN = jsonString \"infix\"\n\nrenderJson :: JsonDoc -> SDoc\nrenderJson = renderJSON\n\njsonMaybe :: (a -> JsonDoc) -> Maybe a -> JsonDoc\njsonMaybe = maybe jsonNull\n\njsonString :: String -> JsonDoc\njsonString = JSString\n\njsonObject :: [(String, JsonDoc)] -> JsonDoc\njsonObject = JSObject\n\njsonArray :: [JsonDoc] -> JsonDoc\njsonArray = JSArray\n\njsonNull :: JsonDoc\njsonNull = JSNull\n\njsonInt :: Int -> JsonDoc\njsonInt = JSInt\n\njsonBool :: Bool -> JsonDoc\njsonBool = JSBool\n", "num_lines": 107}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wwarn #-}\n{-# LANGUAGE BangPatterns #-}\n  -----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Interface.LexParseRn\n-- Copyright   :  (c) Isaac Dupree 2009,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Interface.LexParseRn\n  ( processDocString\n  , processDocStringParas\n  , processDocStrings\n  , processModuleHeader\n  ) where\n\nimport Data.List\nimport Documentation.Haddock.Doc (metaDocConcat)\nimport DynFlags (languageExtensions)\nimport qualified GHC.LanguageExtensions as LangExt\nimport FastString\nimport GHC\nimport Haddock.Interface.ParseModuleHeader\nimport Haddock.Parser\nimport Haddock.Types\nimport Name\nimport Outputable ( showPpr, showSDoc )\nimport RdrName\nimport EnumSet\nimport RnEnv (dataTcOccs)\n\nprocessDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString]\n                  -> ErrMsgM (Maybe (MDoc Name))\nprocessDocStrings dflags pkg gre strs = do\n  mdoc <- metaDocConcat <$> traverse (processDocStringParas dflags pkg gre) strs\n  case mdoc of\n    -- We check that we don't have any version info to render instead\n    -- of just checking if there is no comment: there may not be a\n    -- comment but we still want to pass through any meta data.\n    MetaDoc { _meta = Meta Nothing Nothing, _doc = DocEmpty } -> pure Nothing\n    x -> pure (Just x)\n\nprocessDocStringParas :: DynFlags -> Maybe Package -> GlobalRdrEnv -> HsDocString\n                      -> ErrMsgM (MDoc Name)\nprocessDocStringParas dflags pkg gre (HsDocString fs) =\n  overDocF (rename dflags gre) $ parseParas dflags pkg (unpackFS fs)\n\nprocessDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)\nprocessDocString dflags gre (HsDocString fs) =\n  rename dflags gre $ parseString dflags (unpackFS fs)\n\nprocessModuleHeader :: DynFlags -> Maybe Package -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString\n                    -> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))\nprocessModuleHeader dflags pkgName gre safety mayStr = do\n  (hmi, doc) <-\n    case mayStr of\n      Nothing -> return failure\n      Just (L _ (HsDocString fs)) -> do\n        let str = unpackFS fs\n            (hmi, doc) = parseModuleHeader dflags pkgName str\n        !descr <- case hmi_description hmi of\n                    Just hmi_descr -> Just <$> rename dflags gre hmi_descr\n                    Nothing        -> pure Nothing\n        let hmi' = hmi { hmi_description = descr }\n        doc'  <- overDocF (rename dflags gre) doc\n        return (hmi', Just doc')\n\n  let flags :: [LangExt.Extension]\n      -- We remove the flags implied by the language setting and we display the language instead\n      flags = EnumSet.toList (extensionFlags dflags) \\\\ languageExtensions (language dflags)\n  return (hmi { hmi_safety = Just $ showPpr dflags safety\n              , hmi_language = language dflags\n              , hmi_extensions = flags\n              } , doc)\n  where\n    failure = (emptyHaddockModInfo, Nothing)\n\n-- | Takes a 'GlobalRdrEnv' which (hopefully) contains all the\n-- definitions and a parsed comment and we attempt to make sense of\n-- where the identifiers in the comment point to. We're in effect\n-- trying to convert 'RdrName's to 'Name's, with some guesswork and\n-- fallbacks in case we can't locate the identifiers.\n--\n-- See the comments in the source for implementation commentary.\nrename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name)\nrename dflags gre = rn\n  where\n    rn d = case d of\n      DocAppend a b -> DocAppend <$> rn a <*> rn b\n      DocParagraph doc -> DocParagraph <$> rn doc\n      DocIdentifier x -> do\n        -- Generate the choices for the possible kind of thing this\n        -- is.\n        let choices = dataTcOccs x\n        -- Try to look up all the names in the GlobalRdrEnv that match\n        -- the names.\n        let names = concatMap (\\c -> map gre_name (lookupGRE_RdrName c gre)) choices\n\n        case names of\n          -- We found no names in the env so we start guessing.\n          [] ->\n            case choices of\n              -- This shouldn't happen as 'dataTcOccs' always returns at least its input.\n              [] -> pure (DocMonospaced (DocString (showPpr dflags x)))\n\n              -- There was nothing in the environment so we need to\n              -- pick some default from what's available to us. We\n              -- diverge here from the old way where we would default\n              -- to type constructors as we're much more likely to\n              -- actually want anchors to regular definitions than\n              -- type constructor names (such as in #253). So now we\n              -- only get type constructor links if they are actually\n              -- in scope.\n              a:_ -> outOfScope dflags a\n\n          -- There is only one name in the environment that matches so\n          -- use it.\n          [a] -> pure (DocIdentifier a)\n\n          -- But when there are multiple names available, default to\n          -- type constructors: somewhat awfully GHC returns the\n          -- values in the list positionally.\n          a:b:_ -> ambiguous dflags x (if isTyConName a then a else b) names\n\n      DocWarning doc -> DocWarning <$> rn doc\n      DocEmphasis doc -> DocEmphasis <$> rn doc\n      DocBold doc -> DocBold <$> rn doc\n      DocMonospaced doc -> DocMonospaced <$> rn doc\n      DocUnorderedList docs -> DocUnorderedList <$> traverse rn docs\n      DocOrderedList docs -> DocOrderedList <$> traverse rn docs\n      DocDefList list -> DocDefList <$> traverse (\\(a, b) -> (,) <$> rn a <*> rn b) list\n      DocCodeBlock doc -> DocCodeBlock <$> rn doc\n      DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x)\n      DocModule str -> pure (DocModule str)\n      DocHyperlink l -> pure (DocHyperlink l)\n      DocPic str -> pure (DocPic str)\n      DocMathInline str -> pure (DocMathInline str)\n      DocMathDisplay str -> pure (DocMathDisplay str)\n      DocAName str -> pure (DocAName str)\n      DocProperty p -> pure (DocProperty p)\n      DocExamples e -> pure (DocExamples e)\n      DocEmpty -> pure (DocEmpty)\n      DocString str -> pure (DocString str)\n      DocHeader (Header l t) -> DocHeader . Header l <$> rn t\n      DocTable t -> DocTable <$> traverse rn t\n\n-- | Wrap an identifier that's out of scope (i.e. wasn't found in\n-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently\n-- we simply monospace the identifier in most cases except when the\n-- identifier is qualified: if the identifier is qualified then we can\n-- still try to guess and generate anchors accross modules but the\n-- users shouldn't rely on this doing the right thing. See tickets\n-- #253 and #375 on the confusion this causes depending on which\n-- default we pick in 'rename'.\noutOfScope :: DynFlags -> RdrName -> ErrMsgM (Doc a)\noutOfScope dflags x =\n  case x of\n    Unqual occ -> warnAndMonospace occ\n    Qual mdl occ -> pure (DocIdentifierUnchecked (mdl, occ))\n    Orig _ occ -> warnAndMonospace occ\n    Exact name -> warnAndMonospace name  -- Shouldn't happen since x is out of scope\n  where\n    warnAndMonospace a = do\n      tell [\"Warning: '\" ++ showPpr dflags a ++ \"' is out of scope.\"]\n      pure (monospaced a)\n    monospaced a = DocMonospaced (DocString (showPpr dflags a))\n\n-- | Warn about an ambiguous identifier.\nambiguous :: DynFlags -> RdrName -> Name -> [Name] -> ErrMsgM (Doc Name)\nambiguous dflags x dflt names = do\n  tell [msg]\n  pure (DocIdentifier dflt)\n  where\n    msg = \"Warning: \" ++ x_str ++ \" is ambiguous. It is defined\\n\" ++\n          concatMap (\\n -> \"    * \" ++ defnLoc n ++ \"\\n\") names ++\n          \"    You may be able to disambiguate the identifier by qualifying it or\\n\" ++\n          \"    by hiding some imports.\\n\" ++\n          \"    Defaulting to \" ++ x_str ++ \" defined \" ++ defnLoc dflt\n    x_str = '\\'' : showPpr dflags x ++ \"'\"\n    defnLoc = showSDoc dflags . pprNameDefnLoc\n", "num_lines": 185}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -Wwarn #-}\n-----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Interface.ParseModuleHeader\n-- Copyright   :  (c) Simon Marlow 2006, Isaac Dupree 2009\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Interface.ParseModuleHeader (parseModuleHeader) where\n\nimport Control.Monad (mplus)\nimport Data.Char\nimport DynFlags\nimport Haddock.Parser\nimport Haddock.Types\nimport RdrName\n\n-- -----------------------------------------------------------------------------\n-- Parsing module headers\n\n-- NB.  The headers must be given in the order Module, Description,\n-- Copyright, License, Maintainer, Stability, Portability, except that\n-- any or all may be omitted.\nparseModuleHeader :: DynFlags -> Maybe Package -> String -> (HaddockModInfo RdrName, MDoc RdrName)\nparseModuleHeader dflags pkgName str0 =\n   let\n      getKey :: String -> String -> (Maybe String,String)\n      getKey key str = case parseKey key str of\n         Nothing -> (Nothing,str)\n         Just (value,rest) -> (Just value,rest)\n\n      (_moduleOpt,str1) = getKey \"Module\" str0\n      (descriptionOpt,str2) = getKey \"Description\" str1\n      (copyrightOpt,str3) = getKey \"Copyright\" str2\n      (licenseOpt,str4) = getKey \"License\" str3\n      (licenceOpt,str5) = getKey \"Licence\" str4\n      (spdxLicenceOpt,str6) = getKey \"SPDX-License-Identifier\" str5\n      (maintainerOpt,str7) = getKey \"Maintainer\" str6\n      (stabilityOpt,str8) = getKey \"Stability\" str7\n      (portabilityOpt,str9) = getKey \"Portability\" str8\n\n   in (HaddockModInfo {\n          hmi_description = parseString dflags <$> descriptionOpt,\n          hmi_copyright = copyrightOpt,\n          hmi_license = spdxLicenceOpt `mplus` licenseOpt `mplus` licenceOpt,\n          hmi_maintainer = maintainerOpt,\n          hmi_stability = stabilityOpt,\n          hmi_portability = portabilityOpt,\n          hmi_safety = Nothing,\n          hmi_language = Nothing, -- set in LexParseRn\n          hmi_extensions = [] -- also set in LexParseRn\n          }, parseParas dflags pkgName str9)\n\n-- | This function is how we read keys.\n--\n-- all fields in the header are optional and have the form\n--\n-- [spaces1][field name][spaces] \":\"\n--    [text]\"\\n\" ([spaces2][space][text]\"\\n\" | [spaces]\"\\n\")*\n-- where each [spaces2] should have [spaces1] as a prefix.\n--\n-- Thus for the key \"Description\",\n--\n-- > Description : this is a\n-- >    rather long\n-- >\n-- >    description\n-- >\n-- > The module comment starts here\n--\n-- the value will be \"this is a .. description\" and the rest will begin\n-- at \"The module comment\".\nparseKey :: String -> String -> Maybe (String,String)\nparseKey key toParse0 =\n   do\n      let\n         (spaces0,toParse1) = extractLeadingSpaces (dropWhile (`elem` ['\\r', '\\n']) toParse0)\n\n         indentation = spaces0\n      afterKey0 <- extractPrefix key toParse1\n      let\n         afterKey1 = extractLeadingSpaces afterKey0\n      afterColon0 <- case snd afterKey1 of\n         ':':afterColon -> return afterColon\n         _ -> Nothing\n      let\n         (_,afterColon1) = extractLeadingSpaces afterColon0\n\n      return (scanKey True indentation afterColon1)\n   where\n      scanKey :: Bool -> String -> String -> (String,String)\n      scanKey _       _           [] = ([],[])\n      scanKey isFirst indentation str =\n         let\n            (nextLine,rest1) = extractNextLine str\n\n            accept = isFirst || sufficientIndentation || allSpaces\n\n            sufficientIndentation = case extractPrefix indentation nextLine of\n               Just (c:_) | isSpace c -> True\n               _ -> False\n\n            allSpaces = case extractLeadingSpaces nextLine of\n               (_,[]) -> True\n               _ -> False\n         in\n            if accept\n               then\n                  let\n                     (scanned1,rest2) = scanKey False indentation rest1\n\n                     scanned2 = case scanned1 of\n                        \"\" -> if allSpaces then \"\" else nextLine\n                        _ -> nextLine ++ \"\\n\" ++ scanned1\n                  in\n                     (scanned2,rest2)\n               else\n                  ([],str)\n\n      extractLeadingSpaces :: String -> (String,String)\n      extractLeadingSpaces [] = ([],[])\n      extractLeadingSpaces (s@(c:cs))\n         | isSpace c =\n            let\n               (spaces1,cs1) = extractLeadingSpaces cs\n            in\n               (c:spaces1,cs1)\n         | otherwise = ([],s)\n\n      extractNextLine :: String -> (String,String)\n      extractNextLine [] = ([],[])\n      extractNextLine (c:cs)\n         | c == '\\n' =\n            ([],cs)\n         | otherwise =\n            let\n               (line,rest) = extractNextLine cs\n            in\n               (c:line,rest)\n\n      -- comparison is case-insensitive.\n      extractPrefix :: String -> String -> Maybe String\n      extractPrefix [] s = Just s\n      extractPrefix _ [] = Nothing\n      extractPrefix (c1:cs1) (c2:cs2)\n         | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2\n         | otherwise = Nothing\n", "num_lines": 151}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n----------------------------------------------------------------------------\n-- |\n-- Module      :  Haddock.Interface.Rename\n-- Copyright   :  (c) Simon Marlow 2003-2006,\n--                    David Waern  2006-2009\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n-----------------------------------------------------------------------------\nmodule Haddock.Interface.Rename (renameInterface) where\n\n\nimport Data.Traversable (mapM)\n\nimport Haddock.GhcUtils\nimport Haddock.Types\n\nimport Bag (emptyBag)\nimport GHC hiding (NoLink)\nimport Name\nimport RdrName (RdrName(Exact))\nimport PrelNames (eqTyCon_RDR)\n\nimport Control.Applicative\nimport Control.Monad hiding (mapM)\nimport Data.List\nimport qualified Data.Map as Map hiding ( Map )\nimport Prelude hiding (mapM)\n\n\nrenameInterface :: DynFlags -> LinkEnv -> Bool -> Interface -> ErrMsgM Interface\nrenameInterface dflags renamingEnv warnings iface =\n\n  -- first create the local env, where every name exported by this module\n  -- is mapped to itself, and everything else comes from the global renaming\n  -- env\n  let localEnv = foldl fn renamingEnv (ifaceVisibleExports iface)\n        where fn env name = Map.insert name (ifaceMod iface) env\n\n      -- rename names in the exported declarations to point to things that\n      -- are closer to, or maybe even exported by, the current module.\n      (renamedExportItems, missingNames1)\n        = runRnFM localEnv (renameExportItems (ifaceExportItems iface))\n\n      (rnDocMap, missingNames2) = runRnFM localEnv (mapM renameDoc (ifaceDocMap iface))\n\n      (rnArgMap, missingNames3) = runRnFM localEnv (mapM (mapM renameDoc) (ifaceArgMap iface))\n\n      (renamedOrphanInstances, missingNames4)\n        = runRnFM localEnv (mapM renameDocInstance (ifaceOrphanInstances iface))\n\n      (finalModuleDoc, missingNames5)\n        = runRnFM localEnv (renameDocumentation (ifaceDoc iface))\n\n      -- combine the missing names and filter out the built-ins, which would\n      -- otherwise always be missing.\n      missingNames = nubByName id $ filter isExternalName  -- XXX: isExternalName filters out too much\n                    (missingNames1 ++ missingNames2 ++ missingNames3\n                     ++ missingNames4 ++ missingNames5)\n\n      -- Filter out certain built in type constructors using their string\n      -- representation.\n      --\n      -- Note that since the renamed AST represents equality constraints as\n      -- @HasOpTy t1 eqTyCon_RDR t2@ (and _not_ as @HsEqTy t1 t2@), we need to\n      -- manually filter out 'eqTyCon_RDR' (aka @~@).\n      strings = [ pretty dflags n\n                | n <- missingNames\n                , not (isSystemName n)\n                , not (isBuiltInSyntax n)\n                , Exact n /= eqTyCon_RDR\n                ]\n\n  in do\n    -- report things that we couldn't link to. Only do this for non-hidden\n    -- modules.\n    unless (OptHide `elem` ifaceOptions iface || null strings || not warnings) $\n      tell [\"Warning: \" ++ moduleString (ifaceMod iface) ++\n            \": could not find link destinations for:\\n\"++\n            unwords (\"   \" : strings) ]\n\n    return $ iface { ifaceRnDoc         = finalModuleDoc,\n                     ifaceRnDocMap      = rnDocMap,\n                     ifaceRnArgMap      = rnArgMap,\n                     ifaceRnExportItems = renamedExportItems,\n                     ifaceRnOrphanInstances = renamedOrphanInstances}\n\n\n--------------------------------------------------------------------------------\n-- Monad for renaming\n--\n-- The monad does two things for us: it passes around the environment for\n-- renaming, and it returns a list of names which couldn't be found in\n-- the environment.\n--------------------------------------------------------------------------------\n\n\nnewtype RnM a =\n  RnM { unRn :: (Name -> (Bool, DocName))  -- name lookup function\n             -> (a,[Name])\n      }\n\ninstance Monad RnM where\n  (>>=) = thenRn\n  return = pure\n\ninstance Functor RnM where\n  fmap f x = do a <- x; return (f a)\n\ninstance Applicative RnM where\n  pure = returnRn\n  (<*>) = ap\n\nreturnRn :: a -> RnM a\nreturnRn a   = RnM (const (a,[]))\nthenRn :: RnM a -> (a -> RnM b) -> RnM b\nm `thenRn` k = RnM (\\lkp -> case unRn m lkp of\n  (a,out1) -> case unRn (k a) lkp of\n    (b,out2) -> (b,out1++out2))\n\ngetLookupRn :: RnM (Name -> (Bool, DocName))\ngetLookupRn = RnM (\\lkp -> (lkp,[]))\n\noutRn :: Name -> RnM ()\noutRn name = RnM (const ((),[name]))\n\nlookupRn :: Name -> RnM DocName\nlookupRn name = do\n  lkp <- getLookupRn\n  case lkp name of\n    (False,maps_to) -> do outRn name; return maps_to\n    (True, maps_to) -> return maps_to\n\n\nrunRnFM :: LinkEnv -> RnM a -> (a,[Name])\nrunRnFM env rn = unRn rn lkp\n  where\n    lkp n = case Map.lookup n env of\n      Nothing  -> (False, Undocumented n)\n      Just mdl -> (True,  Documented n mdl)\n\n\n--------------------------------------------------------------------------------\n-- Renaming\n--------------------------------------------------------------------------------\n\n\nrename :: Name -> RnM DocName\nrename = lookupRn\n\n\nrenameL :: Located Name -> RnM (Located DocName)\nrenameL = mapM rename\n\n\nrenameExportItems :: [ExportItem GhcRn] -> RnM [ExportItem DocNameI]\nrenameExportItems = mapM renameExportItem\n\n\nrenameDocForDecl :: DocForDecl Name -> RnM (DocForDecl DocName)\nrenameDocForDecl (doc, fnArgsDoc) =\n  (,) <$> renameDocumentation doc <*> renameFnArgsDoc fnArgsDoc\n\n\nrenameDocumentation :: Documentation Name -> RnM (Documentation DocName)\nrenameDocumentation (Documentation mDoc mWarning) =\n  Documentation <$> mapM renameDoc mDoc <*> mapM renameDoc mWarning\n\n\nrenameLDocHsSyn :: LHsDocString -> RnM LHsDocString\nrenameLDocHsSyn = return\n\n\nrenameDoc :: Traversable t => t Name -> RnM (t DocName)\nrenameDoc = traverse rename\n\nrenameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName)\nrenameFnArgsDoc = mapM renameDoc\n\n\nrenameLType :: LHsType GhcRn -> RnM (LHsType DocNameI)\nrenameLType = mapM renameType\n\nrenameLSigType :: LHsSigType GhcRn -> RnM (LHsSigType DocNameI)\nrenameLSigType = renameImplicit renameLType\n\nrenameLSigWcType :: LHsSigWcType GhcRn -> RnM (LHsSigWcType DocNameI)\nrenameLSigWcType = renameWc (renameImplicit renameLType)\n\nrenameLKind :: LHsKind GhcRn -> RnM (LHsKind DocNameI)\nrenameLKind = renameLType\n\nrenameMaybeLKind :: Maybe (LHsKind GhcRn) -> RnM (Maybe (LHsKind DocNameI))\nrenameMaybeLKind = traverse renameLKind\n\nrenameFamilyResultSig :: LFamilyResultSig GhcRn -> RnM (LFamilyResultSig DocNameI)\nrenameFamilyResultSig (L loc NoSig)\n    = return (L loc NoSig)\nrenameFamilyResultSig (L loc (KindSig ki))\n    = do { ki' <- renameLKind ki\n         ; return (L loc (KindSig ki')) }\nrenameFamilyResultSig (L loc (TyVarSig bndr))\n    = do { bndr' <- renameLTyVarBndr bndr\n         ; return (L loc (TyVarSig bndr')) }\n\nrenameInjectivityAnn :: LInjectivityAnn GhcRn -> RnM (LInjectivityAnn DocNameI)\nrenameInjectivityAnn (L loc (InjectivityAnn lhs rhs))\n    = do { lhs' <- renameL lhs\n         ; rhs' <- mapM renameL rhs\n         ; return (L loc (InjectivityAnn lhs' rhs')) }\n\nrenameMaybeInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)\n                          -> RnM (Maybe (LInjectivityAnn DocNameI))\nrenameMaybeInjectivityAnn = traverse renameInjectivityAnn\n\nrenameType :: HsType GhcRn -> RnM (HsType DocNameI)\nrenameType t = case t of\n  HsForAllTy { hst_bndrs = tyvars, hst_body = ltype } -> do\n    tyvars'   <- mapM renameLTyVarBndr tyvars\n    ltype'    <- renameLType ltype\n    return (HsForAllTy { hst_bndrs = tyvars', hst_body = ltype' })\n\n  HsQualTy { hst_ctxt = lcontext , hst_body = ltype } -> do\n    lcontext' <- renameLContext lcontext\n    ltype'    <- renameLType ltype\n    return (HsQualTy { hst_ctxt = lcontext', hst_body = ltype' })\n\n  HsTyVar ip (L l n) -> return . HsTyVar ip . L l =<< rename n\n  HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype\n\n  HsAppTy a b -> do\n    a' <- renameLType a\n    b' <- renameLType b\n    return (HsAppTy a' b')\n\n  HsFunTy a b -> do\n    a' <- renameLType a\n    b' <- renameLType b\n    return (HsFunTy a' b')\n\n  HsListTy ty -> return . HsListTy =<< renameLType ty\n  HsPArrTy ty -> return . HsPArrTy =<< renameLType ty\n  HsIParamTy n ty -> liftM (HsIParamTy n) (renameLType ty)\n  HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)\n\n  HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts\n  HsSumTy ts -> HsSumTy <$> mapM renameLType ts\n\n  HsOpTy a (L loc op) b -> do\n    op' <- rename op\n    a'  <- renameLType a\n    b'  <- renameLType b\n    return (HsOpTy a' (L loc op') b')\n\n  HsParTy ty -> return . HsParTy =<< renameLType ty\n\n  HsKindSig ty k -> do\n    ty' <- renameLType ty\n    k' <- renameLKind k\n    return (HsKindSig ty' k')\n\n  HsDocTy ty doc -> do\n    ty' <- renameLType ty\n    doc' <- renameLDocHsSyn doc\n    return (HsDocTy ty' doc')\n\n  HsTyLit x -> return (HsTyLit x)\n\n  HsRecTy a               -> HsRecTy <$> mapM renameConDeclFieldField a\n  HsCoreTy a              -> pure (HsCoreTy a)\n  HsExplicitListTy i a b  -> HsExplicitListTy i a <$> mapM renameLType b\n  HsExplicitTupleTy a b   -> HsExplicitTupleTy a <$> mapM renameLType b\n  HsSpliceTy s _          -> renameHsSpliceTy s\n  HsWildCardTy a          -> HsWildCardTy <$> renameWildCardInfo a\n  HsAppsTy _              -> error \"renameType: HsAppsTy\"\n\n-- | Rename splices, but _only_ those that turn out to be for types.\n-- I think this is actually safe for our possible inputs:\n--\n--  * the input is from after GHC's renamer, so should have an 'HsSpliced'\n--  * the input is typechecked, and only 'HsSplicedTy' should get through that\n--\nrenameHsSpliceTy :: HsSplice GhcRn -> RnM (HsType DocNameI)\nrenameHsSpliceTy (HsSpliced _ (HsSplicedTy t)) = renameType t\nrenameHsSpliceTy (HsSpliced _ _) = error \"renameHsSpliceTy: not an HsSplicedTy\"\nrenameHsSpliceTy _ = error \"renameHsSpliceTy: not an HsSpliced\"\n\nrenameLHsQTyVars :: LHsQTyVars GhcRn -> RnM (LHsQTyVars DocNameI)\nrenameLHsQTyVars (HsQTvs { hsq_implicit = _, hsq_explicit = tvs })\n  = do { tvs' <- mapM renameLTyVarBndr tvs\n       ; return (HsQTvs { hsq_implicit = error \"haddock:renameLHsQTyVars\", hsq_explicit = tvs', hsq_dependent = error \"haddock:renameLHsQTyVars\" }) }\n                -- This is rather bogus, but I'm not sure what else to do\n\nrenameLTyVarBndr :: LHsTyVarBndr GhcRn -> RnM (LHsTyVarBndr DocNameI)\nrenameLTyVarBndr (L loc (UserTyVar (L l n)))\n  = do { n' <- rename n\n       ; return (L loc (UserTyVar (L l n'))) }\nrenameLTyVarBndr (L loc (KindedTyVar (L lv n) kind))\n  = do { n' <- rename n\n       ; kind' <- renameLKind kind\n       ; return (L loc (KindedTyVar (L lv n') kind')) }\n\nrenameLContext :: Located [LHsType GhcRn] -> RnM (Located [LHsType DocNameI])\nrenameLContext (L loc context) = do\n  context' <- mapM renameLType context\n  return (L loc context')\n\nrenameWildCardInfo :: HsWildCardInfo GhcRn -> RnM (HsWildCardInfo DocNameI)\nrenameWildCardInfo (AnonWildCard  (L l name)) = AnonWildCard . L l <$> rename name\n\nrenameInstHead :: InstHead GhcRn -> RnM (InstHead DocNameI)\nrenameInstHead InstHead {..} = do\n  cname <- rename ihdClsName\n  types <- mapM renameType ihdTypes\n  itype <- case ihdInstType of\n    ClassInst { .. } -> ClassInst\n        <$> mapM renameType clsiCtx\n        <*> renameLHsQTyVars clsiTyVars\n        <*> mapM renameSig clsiSigs\n        <*> mapM renamePseudoFamilyDecl clsiAssocTys\n    TypeInst  ts -> TypeInst  <$> traverse renameType ts\n    DataInst  dd -> DataInst  <$> renameTyClD dd\n  return InstHead\n    { ihdClsName = cname\n    , ihdTypes = types\n    , ihdInstType = itype\n    }\n\nrenameLDecl :: LHsDecl GhcRn -> RnM (LHsDecl DocNameI)\nrenameLDecl (L loc d) = return . L loc =<< renameDecl d\n\nrenamePats :: [(HsDecl GhcRn, DocForDecl Name)] -> RnM [(HsDecl DocNameI, DocForDecl DocName)]\nrenamePats = mapM\n  (\\(d,doc) -> do { d'   <- renameDecl d\n                  ; doc' <- renameDocForDecl doc\n                  ; return (d',doc')})\n\nrenameDecl :: HsDecl GhcRn -> RnM (HsDecl DocNameI)\nrenameDecl decl = case decl of\n  TyClD d -> do\n    d' <- renameTyClD d\n    return (TyClD d')\n  SigD s -> do\n    s' <- renameSig s\n    return (SigD s')\n  ForD d -> do\n    d' <- renameForD d\n    return (ForD d')\n  InstD d -> do\n    d' <- renameInstD d\n    return (InstD d')\n  DerivD d -> do\n    d' <- renameDerivD d\n    return (DerivD d')\n  _ -> error \"renameDecl\"\n\nrenameLThing :: (a GhcRn -> RnM (a DocNameI)) -> Located (a GhcRn) -> RnM (Located (a DocNameI))\nrenameLThing fn (L loc x) = return . L loc =<< fn x\n\nrenameTyClD :: TyClDecl GhcRn -> RnM (TyClDecl DocNameI)\nrenameTyClD d = case d of\n--  TyFamily flav lname ltyvars kind tckind -> do\n  FamDecl { tcdFam = decl } -> do\n    decl' <- renameFamilyDecl decl\n    return (FamDecl { tcdFam = decl' })\n\n  SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs, tcdFVs = _fvs } -> do\n    lname'    <- renameL lname\n    tyvars'   <- renameLHsQTyVars tyvars\n    rhs'     <- renameLType rhs\n    return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdRhs = rhs', tcdFVs = placeHolderNames })\n\n  DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn, tcdFVs = _fvs } -> do\n    lname'    <- renameL lname\n    tyvars'   <- renameLHsQTyVars tyvars\n    defn'     <- renameDataDefn defn\n    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })\n\n  ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars, tcdFixity = fixity\n            , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do\n    lcontext' <- renameLContext lcontext\n    lname'    <- renameL lname\n    ltyvars'  <- renameLHsQTyVars ltyvars\n    lfundeps' <- mapM renameLFunDep lfundeps\n    lsigs'    <- mapM renameLSig lsigs\n    ats'      <- mapM (renameLThing renameFamilyDecl) ats\n    at_defs'  <- mapM renameLTyFamDefltEqn at_defs\n    -- we don't need the default methods or the already collected doc entities\n    return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars'\n                      , tcdFixity = fixity\n                      , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag\n                      , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdFVs = placeHolderNames })\n\n  where\n    renameLFunDep (L loc (xs, ys)) = do\n      xs' <- mapM rename (map unLoc xs)\n      ys' <- mapM rename (map unLoc ys)\n      return (L loc (map noLoc xs', map noLoc ys'))\n\n    renameLSig (L loc sig) = return . L loc =<< renameSig sig\n\nrenameFamilyDecl :: FamilyDecl GhcRn -> RnM (FamilyDecl DocNameI)\nrenameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname\n                             , fdTyVars = ltyvars\n                             , fdFixity = fixity\n                             , fdResultSig = result\n                             , fdInjectivityAnn = injectivity }) = do\n    info'        <- renameFamilyInfo info\n    lname'       <- renameL lname\n    ltyvars'     <- renameLHsQTyVars ltyvars\n    result'      <- renameFamilyResultSig result\n    injectivity' <- renameMaybeInjectivityAnn injectivity\n    return (FamilyDecl { fdInfo = info', fdLName = lname'\n                       , fdTyVars = ltyvars'\n                       , fdFixity = fixity\n                       , fdResultSig = result'\n                       , fdInjectivityAnn = injectivity' })\n\n\nrenamePseudoFamilyDecl :: PseudoFamilyDecl GhcRn\n                       -> RnM (PseudoFamilyDecl DocNameI)\nrenamePseudoFamilyDecl (PseudoFamilyDecl { .. }) =  PseudoFamilyDecl\n    <$> renameFamilyInfo pfdInfo\n    <*> renameL pfdLName\n    <*> mapM renameLType pfdTyVars\n    <*> renameFamilyResultSig pfdKindSig\n\n\nrenameFamilyInfo :: FamilyInfo GhcRn -> RnM (FamilyInfo DocNameI)\nrenameFamilyInfo DataFamily     = return DataFamily\nrenameFamilyInfo OpenTypeFamily = return OpenTypeFamily\nrenameFamilyInfo (ClosedTypeFamily eqns)\n  = do { eqns' <- mapM (mapM (mapM renameTyFamInstEqn)) eqns\n       ; return $ ClosedTypeFamily eqns' }\n\nrenameDataDefn :: HsDataDefn GhcRn -> RnM (HsDataDefn DocNameI)\nrenameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType\n                           , dd_kindSig = k, dd_cons = cons }) = do\n    lcontext' <- renameLContext lcontext\n    k'        <- renameMaybeLKind k\n    cons'     <- mapM (mapM renameCon) cons\n    -- I don't think we need the derivings, so we return Nothing\n    return (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType\n                       , dd_kindSig = k', dd_cons = cons'\n                       , dd_derivs = noLoc [] })\n\nrenameCon :: ConDecl GhcRn -> RnM (ConDecl DocNameI)\nrenameCon decl@(ConDeclH98 { con_name = lname, con_qvars = ltyvars\n                           , con_cxt = lcontext, con_details = details\n                           , con_doc = mbldoc }) = do\n      lname'    <- renameL lname\n      ltyvars'  <- traverse renameLHsQTyVars ltyvars\n      lcontext' <- traverse renameLContext lcontext\n      details'  <- renameDetails details\n      mbldoc'   <- mapM renameLDocHsSyn mbldoc\n      return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'\n                   , con_details = details', con_doc = mbldoc' })\n\n  where\n    renameDetails (RecCon (L l fields)) = do\n      fields' <- mapM renameConDeclFieldField fields\n      return (RecCon (L l fields'))\n    renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps\n    renameDetails (InfixCon a b) = do\n      a' <- renameLType a\n      b' <- renameLType b\n      return (InfixCon a' b')\n\nrenameCon decl@(ConDeclGADT { con_names = lnames\n                            , con_type = lty\n                            , con_doc = mbldoc }) = do\n      lnames'   <- mapM renameL lnames\n      lty'      <- renameLSigType lty\n      mbldoc'   <- mapM renameLDocHsSyn mbldoc\n      return (decl { con_names = lnames'\n                   , con_type = lty', con_doc = mbldoc' })\n\nrenameConDeclFieldField :: LConDeclField GhcRn -> RnM (LConDeclField DocNameI)\nrenameConDeclFieldField (L l (ConDeclField names t doc)) = do\n  names' <- mapM renameLFieldOcc names\n  t'   <- renameLType t\n  doc' <- mapM renameLDocHsSyn doc\n  return $ L l (ConDeclField names' t' doc')\n\nrenameLFieldOcc :: LFieldOcc GhcRn -> RnM (LFieldOcc DocNameI)\nrenameLFieldOcc (L l (FieldOcc lbl sel)) = do\n  sel' <- rename sel\n  return $ L l (FieldOcc lbl sel')\n\nrenameSig :: Sig GhcRn -> RnM (Sig DocNameI)\nrenameSig sig = case sig of\n  TypeSig lnames ltype -> do\n    lnames' <- mapM renameL lnames\n    ltype' <- renameLSigWcType ltype\n    return (TypeSig lnames' ltype')\n  ClassOpSig is_default lnames sig_ty -> do\n    lnames' <- mapM renameL lnames\n    ltype' <- renameLSigType sig_ty\n    return (ClassOpSig is_default lnames' ltype')\n  PatSynSig lnames sig_ty -> do\n    lnames' <- mapM renameL lnames\n    sig_ty' <- renameLSigType sig_ty\n    return $ PatSynSig lnames' sig_ty'\n  FixSig (FixitySig lnames fixity) -> do\n    lnames' <- mapM renameL lnames\n    return $ FixSig (FixitySig lnames' fixity)\n  MinimalSig src (L l s) -> do\n    s' <- traverse renameL s\n    return $ MinimalSig src (L l s')\n  -- we have filtered out all other kinds of signatures in Interface.Create\n  _ -> error \"expected TypeSig\"\n\n\nrenameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI)\nrenameForD (ForeignImport lname ltype co x) = do\n  lname' <- renameL lname\n  ltype' <- renameLSigType ltype\n  return (ForeignImport lname' ltype' co x)\nrenameForD (ForeignExport lname ltype co x) = do\n  lname' <- renameL lname\n  ltype' <- renameLSigType ltype\n  return (ForeignExport lname' ltype' co x)\n\n\nrenameInstD :: InstDecl GhcRn -> RnM (InstDecl DocNameI)\nrenameInstD (ClsInstD { cid_inst = d }) = do\n  d' <- renameClsInstD d\n  return (ClsInstD { cid_inst = d' })\nrenameInstD (TyFamInstD { tfid_inst = d }) = do\n  d' <- renameTyFamInstD d\n  return (TyFamInstD { tfid_inst = d' })\nrenameInstD (DataFamInstD { dfid_inst = d }) = do\n  d' <- renameDataFamInstD d\n  return (DataFamInstD { dfid_inst = d' })\n\nrenameDerivD :: DerivDecl GhcRn -> RnM (DerivDecl DocNameI)\nrenameDerivD (DerivDecl { deriv_type = ty\n                        , deriv_strategy = strat\n                        , deriv_overlap_mode = omode }) = do\n  ty' <- renameLSigType ty\n  return (DerivDecl { deriv_type = ty'\n                    , deriv_strategy = strat\n                    , deriv_overlap_mode = omode })\n\nrenameClsInstD :: ClsInstDecl GhcRn -> RnM (ClsInstDecl DocNameI)\nrenameClsInstD (ClsInstDecl { cid_overlap_mode = omode\n                            , cid_poly_ty =ltype, cid_tyfam_insts = lATs\n                            , cid_datafam_insts = lADTs }) = do\n  ltype' <- renameLSigType ltype\n  lATs'  <- mapM (mapM renameTyFamInstD) lATs\n  lADTs' <- mapM (mapM renameDataFamInstD) lADTs\n  return (ClsInstDecl { cid_overlap_mode = omode\n                      , cid_poly_ty = ltype', cid_binds = emptyBag\n                      , cid_sigs = []\n                      , cid_tyfam_insts = lATs', cid_datafam_insts = lADTs' })\n\n\nrenameTyFamInstD :: TyFamInstDecl GhcRn -> RnM (TyFamInstDecl DocNameI)\nrenameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })\n  = do { eqn' <- renameTyFamInstEqn eqn\n       ; return (TyFamInstDecl { tfid_eqn = eqn' }) }\n\nrenameTyFamInstEqn :: TyFamInstEqn GhcRn -> RnM (TyFamInstEqn DocNameI)\nrenameTyFamInstEqn eqn\n  = renameImplicit rename_ty_fam_eqn eqn\n  where\n    rename_ty_fam_eqn\n      :: FamEqn GhcRn (HsTyPats GhcRn) (LHsType GhcRn)\n      -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (LHsType DocNameI))\n    rename_ty_fam_eqn (FamEqn { feqn_tycon = tc, feqn_pats = pats\n                              , feqn_fixity = fixity, feqn_rhs = rhs })\n      = do { tc' <- renameL tc\n           ; pats' <- mapM renameLType pats\n           ; rhs' <- renameLType rhs\n           ; return (FamEqn { feqn_tycon  = tc'\n                            , feqn_pats   = pats'\n                            , feqn_fixity = fixity\n                            , feqn_rhs    = rhs' }) }\n\nrenameLTyFamDefltEqn :: LTyFamDefltEqn GhcRn -> RnM (LTyFamDefltEqn DocNameI)\nrenameLTyFamDefltEqn (L loc (FamEqn { feqn_tycon = tc, feqn_pats = tvs\n                                    , feqn_fixity = fixity, feqn_rhs = rhs }))\n  = do { tc'  <- renameL tc\n       ; tvs' <- renameLHsQTyVars tvs\n       ; rhs' <- renameLType rhs\n       ; return (L loc (FamEqn { feqn_tycon  = tc'\n                               , feqn_pats   = tvs'\n                               , feqn_fixity = fixity\n                               , feqn_rhs    = rhs' })) }\n\nrenameDataFamInstD :: DataFamInstDecl GhcRn -> RnM (DataFamInstDecl DocNameI)\nrenameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn })\n  = do { eqn' <- renameImplicit rename_data_fam_eqn eqn\n       ; return (DataFamInstDecl { dfid_eqn = eqn' }) }\n  where\n    rename_data_fam_eqn\n      :: FamEqn GhcRn (HsTyPats GhcRn) (HsDataDefn GhcRn)\n      -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (HsDataDefn DocNameI))\n    rename_data_fam_eqn (FamEqn { feqn_tycon = tc, feqn_pats = pats\n                                , feqn_fixity = fixity, feqn_rhs = defn })\n      = do { tc' <- renameL tc\n           ; pats' <- mapM renameLType pats\n           ; defn' <- renameDataDefn defn\n           ; return (FamEqn { feqn_tycon  = tc'\n                            , feqn_pats   = pats'\n                            , feqn_fixity = fixity\n                            , feqn_rhs    = defn' }) }\n\nrenameImplicit :: (in_thing -> RnM out_thing)\n               -> HsImplicitBndrs GhcRn in_thing\n               -> RnM (HsImplicitBndrs DocNameI out_thing)\nrenameImplicit rn_thing (HsIB { hsib_body = thing })\n  = do { thing' <- rn_thing thing\n       ; return (HsIB { hsib_body = thing'\n                      , hsib_vars = PlaceHolder\n                      , hsib_closed = PlaceHolder }) }\n\nrenameWc :: (in_thing -> RnM out_thing)\n         -> HsWildCardBndrs GhcRn in_thing\n         -> RnM (HsWildCardBndrs DocNameI out_thing)\nrenameWc rn_thing (HsWC { hswc_body = thing })\n  = do { thing' <- rn_thing thing\n       ; return (HsWC { hswc_body = thing'\n                      , hswc_wcs = PlaceHolder }) }\n\nrenameDocInstance :: DocInstance GhcRn -> RnM (DocInstance DocNameI)\nrenameDocInstance (inst, idoc, L l n, m) = do\n  inst' <- renameInstHead inst\n  n' <- rename n\n  idoc' <- mapM renameDoc idoc\n  return (inst', idoc', L l n', m)\n\nrenameExportItem :: ExportItem GhcRn -> RnM (ExportItem DocNameI)\nrenameExportItem item = case item of\n  ExportModule mdl -> return (ExportModule mdl)\n  ExportGroup lev id_ doc -> do\n    doc' <- renameDoc doc\n    return (ExportGroup lev id_ doc')\n  ExportDecl decl pats doc subs instances fixities splice -> do\n    decl' <- renameLDecl decl\n    pats' <- renamePats pats\n    doc'  <- renameDocForDecl doc\n    subs' <- mapM renameSub subs\n    instances' <- forM instances renameDocInstance\n    fixities' <- forM fixities $ \\(name, fixity) -> do\n      name' <- lookupRn name\n      return (name', fixity)\n    return (ExportDecl decl' pats' doc' subs' instances' fixities' splice)\n  ExportNoDecl x subs -> do\n    x'    <- lookupRn x\n    subs' <- mapM lookupRn subs\n    return (ExportNoDecl x' subs')\n  ExportDoc doc -> do\n    doc' <- renameDoc doc\n    return (ExportDoc doc')\n\n\nrenameSub :: (Name, DocForDecl Name) -> RnM (DocName, DocForDecl DocName)\nrenameSub (n,doc) = do\n  n' <- rename n\n  doc' <- renameDocForDecl doc\n  return (n', doc')\n", "num_lines": 666}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE Rank2Types #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeApplications #-}\n{-# LANGUAGE RecordWildCards #-}\n\nmodule Haddock.Interface.Specialize\n    ( specializeInstHead\n    ) where\n\n\nimport Haddock.Syb\nimport Haddock.Types\n\nimport GHC\nimport Name\nimport FastString\n\nimport Control.Monad\nimport Control.Monad.Trans.State\n\nimport Data.Data\nimport qualified Data.List as List\nimport Data.Maybe\nimport Data.Map (Map)\nimport qualified Data.Map as Map\nimport Data.Set (Set)\nimport qualified Data.Set as Set\n\n-- | Instantiate all occurrences of given names with corresponding types.\nspecialize :: forall name a. (Ord (IdP name), DataId name, NamedThing (IdP name))\n            => Data a\n            => [(IdP name, HsType name)] -> a -> a\nspecialize specs = go spec_map0\n  where\n    go :: forall x. Data x => Map (IdP name) (HsType name) -> x -> x\n    go spec_map = everywhereButType @name $ mkT $ sugar . strip_kind_sig . specialize_ty_var spec_map\n\n    strip_kind_sig :: HsType name -> HsType name\n    strip_kind_sig (HsKindSig (L _ t) _) = t\n    strip_kind_sig typ = typ\n\n    specialize_ty_var :: Map (IdP name) (HsType name) -> HsType name -> HsType name\n    specialize_ty_var spec_map (HsTyVar _ (L _ name'))\n      | Just t <- Map.lookup name' spec_map = t\n    specialize_ty_var _ typ = typ\n\n    -- This is a tricky recursive definition. By adding in the specializations\n    -- one by one, we should avoid infinite loops.\n    spec_map0 = foldr (\\(n,t) acc -> Map.insert n (go acc t) acc) mempty specs\n\n\n-- | Instantiate given binders with corresponding types.\n--\n-- Again, it is just a convenience function around 'specialize'. Note that\n-- length of type list should be the same as the number of binders.\nspecializeTyVarBndrs :: (Ord (IdP name), DataId name, NamedThing (IdP name))\n                     => Data a\n                     => LHsQTyVars name -> [HsType name]\n                     -> a -> a\nspecializeTyVarBndrs bndrs typs =\n    specialize $ zip bndrs' typs\n  where\n    bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs\n    bname (UserTyVar (L _ name)) = name\n    bname (KindedTyVar (L _ name) _) = name\n\n\nspecializePseudoFamilyDecl :: (Ord (IdP name), DataId name, NamedThing (IdP name))\n                           => LHsQTyVars name -> [HsType name]\n                           -> PseudoFamilyDecl name\n                           -> PseudoFamilyDecl name\nspecializePseudoFamilyDecl bndrs typs decl =\n  decl {pfdTyVars = map (specializeTyVarBndrs bndrs typs) (pfdTyVars decl)}\n\nspecializeSig :: forall name . (Ord (IdP name), DataId name, SetName (IdP name), NamedThing (IdP name))\n              => LHsQTyVars name -> [HsType name]\n              -> Sig name\n              -> Sig name\nspecializeSig bndrs typs (TypeSig lnames typ) =\n  TypeSig lnames (typ {hswc_body = (hswc_body typ) {hsib_body = noLoc typ'}})\n  where\n    true_type :: HsType name\n    true_type = unLoc (hsSigWcType typ)\n    typ' :: HsType name\n    typ' = rename fv $ specializeTyVarBndrs bndrs typs true_type\n    fv = foldr Set.union Set.empty . map freeVariables $ typs\nspecializeSig _ _ sig = sig\n\n\n-- | Make all details of instance head (signatures, associated types)\n-- specialized to that particular instance type.\nspecializeInstHead :: (Ord (IdP name), DataId name, SetName (IdP name), NamedThing (IdP name))\n                   => InstHead name -> InstHead name\nspecializeInstHead ihd@InstHead { ihdInstType = clsi@ClassInst { .. }, .. } =\n    ihd { ihdInstType = instType' }\n  where\n    instType' = clsi\n        { clsiSigs = map specializeSig' clsiSigs\n        , clsiAssocTys = map specializeFamilyDecl' clsiAssocTys\n        }\n    specializeSig' = specializeSig clsiTyVars ihdTypes\n    specializeFamilyDecl' = specializePseudoFamilyDecl clsiTyVars ihdTypes\nspecializeInstHead ihd = ihd\n\n\n-- | Make given type use tuple and list literals where appropriate.\n--\n-- After applying 'specialize' function some terms may not use idiomatic list\n-- and tuple literals resulting in types like @[] a@ or @(,,) a b c@. This\n-- can be fixed using 'sugar' function, that will turn such types into @[a]@\n-- and @(a, b, c)@.\nsugar :: forall name. (NamedThing (IdP name), DataId name)\n      => HsType name -> HsType name\nsugar = sugarOperators . sugarTuples . sugarLists\n\nsugarLists :: NamedThing (IdP name) => HsType name -> HsType name\nsugarLists (HsAppTy (L _ (HsTyVar _ (L _ name))) ltyp)\n    | isBuiltInSyntax name' && strName == \"[]\" = HsListTy ltyp\n  where\n    name' = getName name\n    strName = occNameString . nameOccName $ name'\nsugarLists typ = typ\n\n\nsugarTuples :: NamedThing (IdP name) => HsType name -> HsType name\nsugarTuples typ =\n    aux [] typ\n  where\n    aux apps (HsAppTy (L _ ftyp) atyp) = aux (atyp:apps) ftyp\n    aux apps (HsParTy (L _ typ')) = aux apps typ'\n    aux apps (HsTyVar _ (L _ name))\n        | isBuiltInSyntax name' && suitable = HsTupleTy HsBoxedTuple apps\n      where\n        name' = getName name\n        strName = occNameString . nameOccName $ name'\n        suitable = case parseTupleArity strName of\n            Just arity -> arity == length apps\n            Nothing -> False\n    aux _ _ = typ\n\n\nsugarOperators :: NamedThing (IdP name) => HsType name -> HsType name\nsugarOperators (HsAppTy (L _ (HsAppTy (L _ (HsTyVar _ (L l name))) la)) lb)\n    | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb\n    | isBuiltInSyntax name' && getOccString name == \"(->)\" = HsFunTy la lb\n  where\n    name' = getName name\nsugarOperators typ = typ\n\n\n-- | Compute arity of given tuple operator.\n--\n-- >>> parseTupleArity \"(,,)\"\n-- Just 3\n--\n-- >>> parseTupleArity \"(,,,,)\"\n-- Just 5\n--\n-- >>> parseTupleArity \"abc\"\n-- Nothing\n--\n-- >>> parseTupleArity \"()\"\n-- Nothing\nparseTupleArity :: String -> Maybe Int\nparseTupleArity ('(':commas) = do\n    n <- parseCommas commas\n    guard $ n /= 0\n    return $ n + 1\n  where\n    parseCommas (',':rest) = (+ 1) <$> parseCommas rest\n    parseCommas \")\" = Just 0\n    parseCommas _ = Nothing\nparseTupleArity _ = Nothing\n\n\n-- | Haskell AST type representation.\n--\n-- This type is used for renaming (more below), essentially the ambiguous (!)\n-- version of 'Name'. So, why is this 'FastString' instead of 'OccName'? Well,\n-- it was 'OccName' before, but turned out that 'OccName' sometimes also\n-- contains namespace information, differentiating visually same types.\n--\n-- And 'FastString' is used because it is /visual/ part of 'OccName' - it is\n-- not converted to 'String' or alike to avoid new allocations. Additionally,\n-- since it is stored mostly in 'Set', fast comparison of 'FastString' is also\n-- quite nice.\ntype NameRep = FastString\n\ngetNameRep :: NamedThing name => name -> NameRep\ngetNameRep = occNameFS . getOccName\n\nnameRepString :: NameRep -> String\nnameRepString = unpackFS\n\nstringNameRep :: String -> NameRep\nstringNameRep = mkFastString\n\nsetInternalNameRep :: SetName name => NameRep -> name -> name\nsetInternalNameRep = setInternalOccName . mkVarOccFS\n\nsetInternalOccName :: SetName name => OccName -> name -> name\nsetInternalOccName occ name =\n    setName nname' name\n  where\n    nname = getName name\n    nname' = mkInternalName (nameUnique nname) occ (nameSrcSpan nname)\n\n\n-- | Compute set of free variables of given type.\nfreeVariables :: forall name. (NamedThing (IdP name), DataId name)\n              => HsType name -> Set Name\nfreeVariables =\n    everythingWithState Set.empty Set.union query\n  where\n    query term ctx = case cast term :: Maybe (HsType name) of\n        Just (HsForAllTy bndrs _) ->\n            (Set.empty, Set.union ctx (bndrsNames bndrs))\n        Just (HsTyVar _ (L _ name))\n            | getName name `Set.member` ctx -> (Set.empty, ctx)\n            | otherwise -> (Set.singleton $ getName name, ctx)\n        _ -> (Set.empty, ctx)\n    bndrsNames = Set.fromList . map (getName . tyVarName . unLoc)\n\n\n-- | Make given type visually unambiguous.\n--\n-- After applying 'specialize' method, some free type variables may become\n-- visually ambiguous - for example, having @a -> b@ and specializing @a@ to\n-- @(a -> b)@ we get @(a -> b) -> b@ where first occurrence of @b@ refers to\n-- different type variable than latter one. Applying 'rename' function\n-- will fix that type to be visually unambiguous again (making it something\n-- like @(a -> b0) -> b@).\nrename :: (Eq (IdP name), DataId name, SetName (IdP name))\n       => Set Name-> HsType name -> HsType name\nrename fv typ = evalState (renameType typ) env\n  where\n    env = RenameEnv\n      { rneHeadFVs = Map.fromList . map mkPair . Set.toList $ fv\n      , rneSigFVs = Set.map getNameRep $ freeVariables typ\n      , rneCtx = Map.empty\n      }\n    mkPair name = (getNameRep name, name)\n\n-- | Renaming monad.\ntype Rename name = State (RenameEnv name)\n\ndata RenameEnv name = RenameEnv\n  { rneHeadFVs :: Map NameRep Name\n  , rneSigFVs :: Set NameRep\n  , rneCtx :: Map Name name\n  }\n\n\nrenameType :: (Eq (IdP name), SetName (IdP name))\n           => HsType name -> Rename (IdP name) (HsType name)\nrenameType (HsForAllTy bndrs lt) =\n    HsForAllTy\n        <$> mapM (located renameBinder) bndrs\n        <*> renameLType lt\nrenameType (HsQualTy lctxt lt) =\n    HsQualTy\n        <$> located renameContext lctxt\n        <*> renameLType lt\nrenameType (HsTyVar ip name) = HsTyVar ip <$> located renameName name\nrenameType (HsAppTy lf la) = HsAppTy <$> renameLType lf <*> renameLType la\nrenameType (HsFunTy la lr) = HsFunTy <$> renameLType la <*> renameLType lr\nrenameType (HsListTy lt) = HsListTy <$> renameLType lt\nrenameType (HsPArrTy lt) = HsPArrTy <$> renameLType lt\nrenameType (HsTupleTy srt lt) = HsTupleTy srt <$> mapM renameLType lt\nrenameType (HsSumTy lt) = HsSumTy <$> mapM renameLType lt\nrenameType (HsOpTy la lop lb) =\n    HsOpTy <$> renameLType la <*> located renameName lop <*> renameLType lb\nrenameType (HsParTy lt) = HsParTy <$> renameLType lt\nrenameType (HsIParamTy ip lt) = HsIParamTy ip <$> renameLType lt\nrenameType (HsEqTy la lb) = HsEqTy <$> renameLType la <*> renameLType lb\nrenameType (HsKindSig lt lk) = HsKindSig <$> renameLType lt <*> pure lk\nrenameType t@(HsSpliceTy _ _) = pure t\nrenameType (HsDocTy lt doc) = HsDocTy <$> renameLType lt <*> pure doc\nrenameType (HsBangTy bang lt) = HsBangTy bang <$> renameLType lt\nrenameType t@(HsRecTy _) = pure t\nrenameType t@(HsCoreTy _) = pure t\nrenameType (HsExplicitListTy ip ph ltys) =\n    HsExplicitListTy ip ph <$> renameLTypes ltys\nrenameType (HsExplicitTupleTy phs ltys) =\n    HsExplicitTupleTy phs <$> renameLTypes ltys\nrenameType t@(HsTyLit _) = pure t\nrenameType (HsWildCardTy wc) = pure (HsWildCardTy wc)\nrenameType (HsAppsTy _) = error \"HsAppsTy: Only used before renaming\"\n\n\nrenameLType :: (Eq (IdP name), SetName (IdP name))\n            => LHsType name -> Rename (IdP name) (LHsType name)\nrenameLType = located renameType\n\n\nrenameLTypes :: (Eq (IdP name), SetName (IdP name))\n             => [LHsType name] -> Rename (IdP name) [LHsType name]\nrenameLTypes = mapM renameLType\n\n\nrenameContext :: (Eq (IdP name), SetName (IdP name))\n              => HsContext name -> Rename (IdP name) (HsContext name)\nrenameContext = renameLTypes\n\nrenameBinder :: (Eq (IdP name), SetName (IdP name))\n             => HsTyVarBndr name -> Rename (IdP name) (HsTyVarBndr name)\nrenameBinder (UserTyVar lname) = UserTyVar <$> located renameName lname\nrenameBinder (KindedTyVar lname lkind) =\n  KindedTyVar <$> located renameName lname <*> located renameType lkind\n\n\n-- | Core renaming logic.\nrenameName :: (Eq name, SetName name) => name -> Rename name name\nrenameName name = do\n    RenameEnv { .. } <- get\n    case Map.lookup (getName name) rneCtx of\n      Nothing\n        | Just headTv <- Map.lookup (getNameRep name) rneHeadFVs\n        , headTv /= getName name -> freshName name\n      Just name' -> return name'\n      _ -> return name\n\n\n-- | Generate fresh occurrence name, put it into context and return.\nfreshName :: SetName name => name -> Rename name name\nfreshName name = do\n    taken <- takenNames\n    let name' = setInternalNameRep (findFreshName taken rep) name\n    modify $ \\rne -> rne\n      { rneCtx = Map.insert (getName name) name' (rneCtx rne) }\n    return name'\n  where\n    nname = getName name\n    rep = getNameRep nname\n\n\ntakenNames :: NamedThing name => Rename name (Set NameRep)\ntakenNames = do\n    RenameEnv { .. } <- get\n    return $ Set.unions [headReps rneHeadFVs, rneSigFVs, ctxElems rneCtx]\n  where\n    headReps = Set.fromList . Map.keys\n    ctxElems = Set.fromList . map getNameRep . Map.elems\n\n\nfindFreshName :: Set NameRep -> NameRep -> NameRep\nfindFreshName taken =\n    fromJust . List.find isFresh . alternativeNames\n  where\n    isFresh = not . flip Set.member taken\n\n\nalternativeNames :: NameRep -> [NameRep]\nalternativeNames name =\n    [ stringNameRep $ str ++ show i | i :: Int <- [0..] ]\n  where\n    str = nameRepString name\n\n\nlocated :: Functor f => (a -> f b) -> Located a -> f (Located b)\nlocated f (L loc e) = L loc <$> f e\n\n\ntyVarName :: HsTyVarBndr name -> IdP name\ntyVarName (UserTyVar name) = unLoc name\ntyVarName (KindedTyVar (L _ name) _) = name\n", "num_lines": 368}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n\n-- | Minimal JSON / RFC 7159 support\n--\n-- The API is heavily inspired by @aeson@'s API but puts emphasis on\n-- simplicity rather than performance. The 'ToJSON' instances are\n-- intended to have an encoding compatible with @aeson@'s encoding.\n--\nmodule Haddock.Utils.Json\n    ( Value(..)\n    , Object, object, Pair, (.=)\n    , encodeToString\n    , encodeToBuilder\n    , ToJSON(toJSON)\n    )\n    where\n\nimport Data.Char\nimport Data.Int\nimport Data.String\nimport Data.Word\nimport Data.List\nimport Data.Monoid\n\nimport Data.ByteString.Builder (Builder)\nimport qualified Data.ByteString.Builder as BB\n\n-- TODO: We may want to replace 'String' with 'Text' or 'ByteString'\n\n-- | A JSON value represented as a Haskell value.\ndata Value = Object !Object\n           | Array  [Value]\n           | String  String\n           | Number !Double\n           | Bool   !Bool\n           | Null\n           deriving (Eq, Read, Show)\n\n-- | A key\\/value pair for an 'Object'\ntype Pair = (String, Value)\n\n-- | A JSON \\\"object\\\" (key/value map).\ntype Object = [Pair]\n\ninfixr 8 .=\n\n-- | A key-value pair for encoding a JSON object.\n(.=) :: ToJSON v => String -> v -> Pair\nk .= v  = (k, toJSON v)\n\n-- | Create a 'Value' from a list of name\\/value 'Pair's.\nobject :: [Pair] -> Value\nobject = Object\n\ninstance IsString Value where\n  fromString = String\n\n\n-- | A type that can be converted to JSON.\nclass ToJSON a where\n  -- | Convert a Haskell value to a JSON-friendly intermediate type.\n  toJSON :: a -> Value\n\ninstance ToJSON () where\n  toJSON () = Array []\n\ninstance ToJSON Value where\n  toJSON = id\n\ninstance ToJSON Bool where\n  toJSON = Bool\n\ninstance ToJSON a => ToJSON [a] where\n  toJSON = Array . map toJSON\n\ninstance ToJSON a => ToJSON (Maybe a) where\n  toJSON Nothing  = Null\n  toJSON (Just a) = toJSON a\n\ninstance (ToJSON a,ToJSON b) => ToJSON (a,b) where\n  toJSON (a,b) = Array [toJSON a, toJSON b]\n\ninstance (ToJSON a,ToJSON b,ToJSON c) => ToJSON (a,b,c) where\n  toJSON (a,b,c) = Array [toJSON a, toJSON b, toJSON c]\n\ninstance (ToJSON a,ToJSON b,ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where\n  toJSON (a,b,c,d) = Array [toJSON a, toJSON b, toJSON c, toJSON d]\n\ninstance ToJSON Float where\n  toJSON = Number . realToFrac\n\ninstance ToJSON Double where\n  toJSON = Number\n\ninstance ToJSON Int    where  toJSON = Number . realToFrac\ninstance ToJSON Int8   where  toJSON = Number . realToFrac\ninstance ToJSON Int16  where  toJSON = Number . realToFrac\ninstance ToJSON Int32  where  toJSON = Number . realToFrac\n\ninstance ToJSON Word   where  toJSON = Number . realToFrac\ninstance ToJSON Word8  where  toJSON = Number . realToFrac\ninstance ToJSON Word16 where  toJSON = Number . realToFrac\ninstance ToJSON Word32 where  toJSON = Number . realToFrac\n\n-- | Possibly lossy due to conversion to 'Double'\ninstance ToJSON Int64  where  toJSON = Number . realToFrac\n\n-- | Possibly lossy due to conversion to 'Double'\ninstance ToJSON Word64 where  toJSON = Number . realToFrac\n\n-- | Possibly lossy due to conversion to 'Double'\ninstance ToJSON Integer where toJSON = Number . fromInteger\n\n------------------------------------------------------------------------------\n-- 'BB.Builder'-based encoding\n\n-- | Serialise value as JSON/UTF8-encoded 'Builder'\nencodeToBuilder :: ToJSON a => a -> Builder\nencodeToBuilder = encodeValueBB . toJSON\n\nencodeValueBB :: Value -> Builder\nencodeValueBB jv = case jv of\n  Bool True  -> \"true\"\n  Bool False -> \"false\"\n  Null       -> \"null\"\n  Number n\n    | isNaN n || isInfinite n   -> encodeValueBB Null\n    | Just i <- doubleToInt64 n -> BB.int64Dec i\n    | otherwise                 -> BB.doubleDec n\n  Array a  -> encodeArrayBB a\n  String s -> encodeStringBB s\n  Object o -> encodeObjectBB o\n\nencodeArrayBB :: [Value] -> Builder\nencodeArrayBB [] = \"[]\"\nencodeArrayBB jvs = BB.char8 '[' <> go jvs <> BB.char8 ']'\n  where\n    go = Data.Monoid.mconcat . intersperse (BB.char8 ',') . map encodeValueBB\n\nencodeObjectBB :: Object -> Builder\nencodeObjectBB [] = \"{}\"\nencodeObjectBB jvs = BB.char8 '{' <> go jvs <> BB.char8 '}'\n  where\n    go = Data.Monoid.mconcat . intersperse (BB.char8 ',') . map encPair\n    encPair (l,x) = encodeStringBB l <> BB.char8 ':' <> encodeValueBB x\n\nencodeStringBB :: String -> Builder\nencodeStringBB str = BB.char8 '\"' <> go str <> BB.char8 '\"'\n  where\n    go = BB.stringUtf8 . escapeString\n\n------------------------------------------------------------------------------\n-- 'String'-based encoding\n\n-- | Serialise value as JSON-encoded Unicode 'String'\nencodeToString :: ToJSON a => a -> String\nencodeToString jv = encodeValue (toJSON jv) []\n\nencodeValue :: Value -> ShowS\nencodeValue jv = case jv of\n  Bool b   -> showString (if b then \"true\" else \"false\")\n  Null     -> showString \"null\"\n  Number n\n    | isNaN n || isInfinite n    -> encodeValue Null\n    | Just i <- doubleToInt64 n -> shows i\n    | otherwise                 -> shows n\n  Array a -> encodeArray a\n  String s -> encodeString s\n  Object o -> encodeObject o\n\nencodeArray :: [Value] -> ShowS\nencodeArray [] = showString \"[]\"\nencodeArray jvs = ('[':) . go jvs . (']':)\n  where\n    go []     = id\n    go [x]    = encodeValue x\n    go (x:xs) = encodeValue x . (',':) . go xs\n\nencodeObject :: Object -> ShowS\nencodeObject [] = showString \"{}\"\nencodeObject jvs = ('{':) . go jvs . ('}':)\n  where\n    go []          = id\n    go [(l,x)]     = encodeString l . (':':) . encodeValue x\n    go ((l,x):lxs) = encodeString l . (':':) . encodeValue x . (',':) . go lxs\n\nencodeString :: String -> ShowS\nencodeString str = ('\"':) . showString (escapeString str) . ('\"':)\n\n------------------------------------------------------------------------------\n-- helpers\n\n-- | Try to convert 'Double' into 'Int64', return 'Nothing' if not\n-- representable loss-free as integral 'Int64' value.\ndoubleToInt64 :: Double -> Maybe Int64\ndoubleToInt64 x\n  | fromInteger x' == x\n  , x' <= toInteger (maxBound :: Int64)\n  , x' >= toInteger (minBound :: Int64)\n    = Just (fromIntegral x')\n  | otherwise = Nothing\n  where\n    x' = round x\n\n-- | Minimally escape a 'String' in accordance with RFC 7159, \"7. Strings\"\nescapeString :: String -> String\nescapeString s\n  | not (any needsEscape s) = s\n  | otherwise               = escape s\n  where\n    escape [] = []\n    escape (x:xs) = case x of\n      '\\\\' -> '\\\\':'\\\\':escape xs\n      '\"'  -> '\\\\':'\"':escape xs\n      '\\b' -> '\\\\':'b':escape xs\n      '\\f' -> '\\\\':'f':escape xs\n      '\\n' -> '\\\\':'n':escape xs\n      '\\r' -> '\\\\':'r':escape xs\n      '\\t' -> '\\\\':'t':escape xs\n      c | ord c < 0x10 -> '\\\\':'u':'0':'0':'0':intToDigit (ord c):escape xs\n        | ord c < 0x20 -> '\\\\':'u':'0':'0':'1':intToDigit (ord c - 0x10):escape xs\n        | otherwise    -> c : escape xs\n\n    -- unescaped = %x20-21 / %x23-5B / %x5D-10FFFF\n    needsEscape c = ord c < 0x20 || c `elem` ['\\\\','\"']\n", "num_lines": 226}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -F -pgmF hspec-discover #-}\n", "num_lines": 2}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where\n\n\nimport Test.Hspec\nimport Test.QuickCheck\n\nimport qualified GHC\nimport Control.Monad.IO.Class\n\nimport Haddock (getGhcDirs)\nimport Haddock.Backends.Hyperlinker.Parser\nimport Haddock.Backends.Hyperlinker.Types\n\nwithDynFlags :: (GHC.DynFlags -> IO ()) -> IO ()\nwithDynFlags cont = do\n  libDir <- fmap snd (getGhcDirs [])\n  GHC.runGhc (Just libDir) $ do\n    dflags <- GHC.getSessionDynFlags\n    liftIO $ cont dflags\n\n\nmain :: IO ()\nmain = hspec spec\n\n\nspec :: Spec\nspec = describe \"parse\" parseSpec\n\n\n-- | Defined for its instance of 'Arbitrary'. Represents strings that, when\n-- considered as GHC source, won't be rewritten.\nnewtype NoGhcRewrite = NoGhcRewrite String deriving (Show, Eq)\n\n-- | Filter out strings where GHC would replace/remove some characters during\n-- lexing.\nnoGhcRewrite :: String -> Bool\nnoGhcRewrite ('\\t':_) = False        -- GHC replaces tabs with 8 spaces\nnoGhcRewrite ('\\r':_) = False\nnoGhcRewrite ('\\f':_) = False\nnoGhcRewrite ('\\v':_) = False\nnoGhcRewrite (' ':'\\n':_) = False    -- GHC strips whitespace on empty lines\nnoGhcRewrite (_:s) = noGhcRewrite s\nnoGhcRewrite \"\" = True\n\ninstance Arbitrary NoGhcRewrite where\n  arbitrary = fmap NoGhcRewrite (arbitrary `suchThat` noGhcRewrite)\n  shrink (NoGhcRewrite src) = [ NoGhcRewrite shrunk\n                              | shrunk <- shrink src\n                              , noGhcRewrite shrunk\n                              ]\n\n\nparseSpec :: Spec\nparseSpec = around withDynFlags $ do\n\n    it \"is total\" $ \\dflags ->\n        property $ \\src -> length (parse dflags \"\" src) `shouldSatisfy` (>= 0)\n\n    it \"retains file layout\" $ \\dflags ->\n        property $ \\(NoGhcRewrite src) -> concatMap tkValue (parse dflags \"\" src) == src\n\n    context \"when parsing single-line comments\" $ do\n\n        it \"should ignore content until the end of line\" $ \\dflags ->\n            shouldParseTo\n                \"-- some very simple comment\\nidentifier\"\n                [TkComment, TkSpace, TkIdentifier]\n                dflags\n\n        it \"should allow endline escaping\" $ \\dflags ->\n            shouldParseTo\n                \"#define first line\\\\\\nsecond line\\\\\\nand another one\"\n                [TkCpp]\n                dflags\n\n    context \"when parsing multi-line comments\" $ do\n\n        it \"should support nested comments\" $ \\dflags ->\n            shouldParseTo\n                \"{- comment {- nested -} still comment -} {- next comment -}\"\n                [TkComment, TkSpace, TkComment]\n                dflags\n\n        it \"should distinguish compiler pragma\" $ \\dflags ->\n            shouldParseTo\n                \"{- comment -}{-# LANGUAGE GADTs #-}{- comment -}\"\n                [TkComment, TkPragma, TkComment]\n                dflags\n\n    it \"should recognize preprocessor directives\" $ \\dflags -> do\n            shouldParseTo\n                \"\\n#define foo bar\"\n                [TkSpace, TkCpp]\n                dflags\n            shouldParseTo\n                \"x # y\"\n                [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier]\n                dflags\n\n    it \"should distinguish basic language constructs\" $ \\dflags -> do\n        \n        shouldParseTo\n            \"(* 2) <$> (\\\"abc\\\", foo)\"\n            [ TkSpecial, TkOperator, TkSpace, TkNumber, TkSpecial\n            , TkSpace, TkOperator, TkSpace\n            , TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial\n            ]\n            dflags\n            \n        shouldParseTo\n            \"let foo' = foo in foo' + foo'\"\n            [ TkKeyword, TkSpace, TkIdentifier\n            , TkSpace, TkGlyph, TkSpace\n            , TkIdentifier, TkSpace, TkKeyword, TkSpace\n            , TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier\n            ]\n            dflags\n        \n        shouldParseTo\n            \"square x = y^2 where y = x\"\n            [ TkIdentifier, TkSpace, TkIdentifier\n            , TkSpace, TkGlyph, TkSpace\n            , TkIdentifier, TkOperator, TkNumber\n            , TkSpace, TkKeyword, TkSpace\n            , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier\n            ]\n            dflags\n\n    it \"should parse do-notation syntax\" $ \\dflags -> do\n        shouldParseTo\n            \"do { foo <- getLine; putStrLn foo }\"\n            [ TkKeyword, TkSpace, TkSpecial, TkSpace\n            , TkIdentifier, TkSpace, TkGlyph, TkSpace\n            , TkIdentifier, TkSpecial, TkSpace\n            , TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial\n            ]\n            dflags\n\n        shouldParseTo\n            (unlines\n                [ \"do\"\n                , \"    foo <- getLine\"\n                , \"    putStrLn foo\"\n                ])\n            [ TkKeyword, TkSpace, TkIdentifier\n            , TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace\n            , TkIdentifier, TkSpace, TkIdentifier, TkSpace\n            ]\n            dflags\n  where\n    shouldParseTo :: String -> [TokenType] -> GHC.DynFlags -> Expectation\n    shouldParseTo str tokens dflags = map tkType (parse dflags \"\" str) `shouldBe` tokens\n", "num_lines": 153}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DeriveGeneric, StandaloneDeriving #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule Main (main) where\n\nimport Control.Applicative ((<|>))\nimport Control.Exception (IOException, catch)\nimport Control.Monad (when)\nimport Data.Foldable (traverse_)\nimport Data.List (foldl')\nimport Data.Traversable (for)\nimport GHC.Generics (Generic)\nimport Prelude ()\nimport Prelude.Compat\nimport System.Directory (getDirectoryContents)\nimport System.Exit (exitFailure)\nimport System.FilePath\nimport System.IO\n\nimport Data.TreeDiff\nimport Data.TreeDiff.Golden\n\nimport qualified Options.Applicative as O\n\nimport           Documentation.Haddock.Types\nimport qualified Documentation.Haddock.Parser as Parse\n\ntype Doc id = DocH () id\n\ndata Fixture = Fixture\n    { fixtureName   :: FilePath\n    , fixtureOutput :: FilePath\n    }\n  deriving Show\n\ndata  Result = Result\n    { _resultSuccess :: !Int\n    , _resultTotal   :: !Int\n    }\n  deriving Show\n\ncombineResults :: Result -> Result -> Result\ncombineResults (Result s t) (Result s' t') = Result (s + s') (t + t')\n\nreadFixtures :: IO [Fixture]\nreadFixtures = do\n    let dir = \"fixtures/examples\"\n    files <- getDirectoryContents dir\n    let inputs = filter (\\fp -> takeExtension fp == \".input\") files\n    return $ flip map inputs $ \\fp -> Fixture\n        { fixtureName = dir </> fp\n        , fixtureOutput = dir </> fp -<.> \"parsed\"\n        }\n\ngoldenFixture\n    :: String\n    -> IO Expr\n    -> IO Expr\n    -> (Expr -> Expr -> IO (Maybe String))\n    -> (Expr -> IO ())\n    -> IO Result\ngoldenFixture name expect actual cmp wrt = do\n    putStrLn $ \"running \" ++ name\n    a <- actual\n    e <- expect `catch` handler a\n    mres <- cmp e a\n    case mres of\n        Nothing  -> return (Result 1 1)\n        Just str -> do\n            putStrLn str\n            return (Result 0 1)\n  where\n    handler :: Expr -> IOException -> IO Expr\n    handler a exc = do\n        putStrLn $ \"Caught \" ++ show exc\n        putStrLn \"Accepting the test\"\n        wrt a\n        return a\n\nrunFixtures :: [Fixture] -> IO ()\nrunFixtures fixtures = do\n    results <- for fixtures $ \\(Fixture i o) -> do\n        let name = takeBaseName i\n        let readDoc = do\n                input <- readFile i\n                return (parseString input)\n        ediffGolden goldenFixture name o readDoc\n    case foldl' combineResults (Result 0 0) results of\n        Result s t -> do\n            putStrLn $ \"Fixtures: success \" ++ show s ++ \"; total \" ++ show t\n            when (s /= t) exitFailure\n\nlistFixtures :: [Fixture] -> IO ()\nlistFixtures = traverse_ $ \\(Fixture i _) -> do\n    let name = takeBaseName i\n    putStrLn name\n\nacceptFixtures :: [Fixture] -> IO ()\nacceptFixtures = traverse_ $ \\(Fixture i o) -> do\n    input <- readFile i\n    let doc = parseString input\n    let actual = show (prettyExpr $ toExpr doc) ++ \"\\n\"\n    writeFile o actual\n\nparseString :: String -> Doc String\nparseString = Parse.toRegular . _doc . Parse.parseParas Nothing\n\ndata Cmd = CmdRun | CmdAccept | CmdList\n\nmain :: IO ()\nmain = do\n    hSetBuffering stdout NoBuffering -- For interleaved output when debugging\n    runCmd =<< O.execParser opts\n  where\n    opts = O.info (O.helper <*> cmdParser) O.fullDesc\n\n    cmdParser :: O.Parser Cmd\n    cmdParser = cmdRun <|> cmdAccept <|> cmdList <|> pure CmdRun\n\n    cmdRun = O.flag' CmdRun $ mconcat\n        [ O.long \"run\"\n        , O.help \"Run parser fixtures\"\n        ]\n\n    cmdAccept = O.flag' CmdAccept $ mconcat\n        [ O.long \"accept\"\n        , O.help \"Run & accept parser fixtures\"\n        ]\n\n    cmdList = O.flag' CmdList $ mconcat\n        [ O.long \"list\"\n        , O.help \"List fixtures\"\n        ]\n\nrunCmd :: Cmd -> IO ()\nrunCmd CmdRun    = readFixtures >>= runFixtures\nrunCmd CmdList   = readFixtures >>= listFixtures\nrunCmd CmdAccept = readFixtures >>= acceptFixtures\n\n-------------------------------------------------------------------------------\n-- Orphans\n-------------------------------------------------------------------------------\n\nderiving instance Generic (DocH mod id)\ninstance (ToExpr mod, ToExpr id)  => ToExpr (DocH mod id)\n\nderiving instance Generic (Header id)\ninstance ToExpr id => ToExpr (Header id)\n\nderiving instance Generic Hyperlink\ninstance ToExpr Hyperlink\n\nderiving instance Generic Picture\ninstance ToExpr Picture\n\nderiving instance Generic Example\ninstance ToExpr Example\n\nderiving instance Generic (Table id)\ninstance ToExpr id => ToExpr (Table id)\n\nderiving instance Generic (TableRow id)\ninstance ToExpr id => ToExpr (TableRow id)\n\nderiving instance Generic (TableCell id)\ninstance ToExpr id => ToExpr (TableCell id)\n", "num_lines": 166}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -fno-warn-orphans #-}\nmodule Documentation.Haddock.Doc (docParagraph, docAppend,\n                                  docConcat, metaDocConcat,\n                                  metaDocAppend, emptyMetaDoc,\n                                  metaAppend, metaConcat) where\n\nimport Control.Applicative ((<|>), empty)\nimport Documentation.Haddock.Types\nimport Data.Char (isSpace)\n\ndocConcat :: [DocH mod id] -> DocH mod id\ndocConcat = foldr docAppend DocEmpty\n\n-- | Concat using 'metaAppend'.\nmetaConcat :: [Meta] -> Meta\nmetaConcat = foldr metaAppend emptyMeta\n\n-- | Like 'docConcat' but also joins the 'Meta' info.\nmetaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id\nmetaDocConcat = foldr metaDocAppend emptyMetaDoc\n\n-- | We do something perhaps unexpected here and join the meta info\n-- in \u00e2\u20ac\u02dcreverse\u00e2\u20ac\u2122: this results in the metadata from the \u00e2\u20ac\u02dclatest\u00e2\u20ac\u2122\n-- paragraphs taking precedence.\nmetaDocAppend :: MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id\nmetaDocAppend (MetaDoc { _meta = m, _doc = d })\n              (MetaDoc { _meta = m', _doc = d' }) =\n  MetaDoc { _meta = m' `metaAppend` m, _doc = d `docAppend` d' }\n\n-- | This is not a monoidal append, it uses '<|>' for the '_version' and\n-- '_package'.\nmetaAppend :: Meta -> Meta -> Meta\nmetaAppend (Meta v1 p1) (Meta v2 p2) = Meta (v1 <|> v2) (p1 <|> p2)\n\nemptyMetaDoc :: MetaDoc mod id\nemptyMetaDoc = MetaDoc { _meta = emptyMeta, _doc = DocEmpty }\n\nemptyMeta :: Meta\nemptyMeta = Meta empty empty\n\ndocAppend :: DocH mod id -> DocH mod id -> DocH mod id\ndocAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2)\ndocAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d\ndocAppend (DocOrderedList ds1) (DocOrderedList ds2) = DocOrderedList (ds1 ++ ds2)\ndocAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) = DocAppend (DocOrderedList (ds1++ds2)) d\ndocAppend (DocUnorderedList ds1) (DocUnorderedList ds2) = DocUnorderedList (ds1 ++ ds2)\ndocAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) = DocAppend (DocUnorderedList (ds1++ds2)) d\ndocAppend DocEmpty d = d\ndocAppend d DocEmpty = d\ndocAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2)\ndocAppend (DocAppend d (DocString s1)) (DocString s2) = DocAppend d (DocString (s1 ++ s2))\ndocAppend (DocString s1) (DocAppend (DocString s2) d) = DocAppend (DocString (s1 ++ s2)) d\ndocAppend d1 d2 = DocAppend d1 d2\n\n-- again to make parsing easier - we spot a paragraph whose only item\n-- is a DocMonospaced and make it into a DocCodeBlock\ndocParagraph :: DocH mod id -> DocH mod id\ndocParagraph (DocMonospaced p)\n  = DocCodeBlock (docCodeBlock p)\ndocParagraph (DocAppend (DocString s1) (DocMonospaced p))\n  | all isSpace s1\n  = DocCodeBlock (docCodeBlock p)\ndocParagraph (DocAppend (DocString s1)\n    (DocAppend (DocMonospaced p) (DocString s2)))\n  | all isSpace s1 && all isSpace s2\n  = DocCodeBlock (docCodeBlock p)\ndocParagraph (DocAppend (DocMonospaced p) (DocString s2))\n  | all isSpace s2\n  = DocCodeBlock (docCodeBlock p)\ndocParagraph p\n  = DocParagraph p\n\n\n-- Drop trailing whitespace from @..@ code blocks.  Otherwise this:\n--\n--    -- @\n--    -- foo\n--    -- @\n--\n-- turns into (DocCodeBlock \"\\nfoo\\n \") which when rendered in HTML\n-- gives an extra vertical space after the code block.  The single space\n-- on the final line seems to trigger the extra vertical space.\n--\ndocCodeBlock :: DocH mod id -> DocH mod id\ndocCodeBlock (DocString s)\n  = DocString (reverse $ dropWhile (`elem` \" \\t\") $ reverse s)\ndocCodeBlock (DocAppend l r)\n  = DocAppend l (docCodeBlock r)\ndocCodeBlock d = d\n", "num_lines": 90}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | @since 1.4.5\nmodule Documentation.Haddock.Markup (\n    markup\n  , idMarkup\n  ) where\n\nimport Documentation.Haddock.Types\n\nmarkup :: DocMarkupH mod id a -> DocH mod id -> a\nmarkup m DocEmpty                    = markupEmpty m\nmarkup m (DocAppend d1 d2)           = markupAppend m (markup m d1) (markup m d2)\nmarkup m (DocString s)               = markupString m s\nmarkup m (DocParagraph d)            = markupParagraph m (markup m d)\nmarkup m (DocIdentifier x)           = markupIdentifier m x\nmarkup m (DocIdentifierUnchecked x)  = markupIdentifierUnchecked m x\nmarkup m (DocModule mod0)            = markupModule m mod0\nmarkup m (DocWarning d)              = markupWarning m (markup m d)\nmarkup m (DocEmphasis d)             = markupEmphasis m (markup m d)\nmarkup m (DocBold d)                 = markupBold m (markup m d)\nmarkup m (DocMonospaced d)           = markupMonospaced m (markup m d)\nmarkup m (DocUnorderedList ds)       = markupUnorderedList m (map (markup m) ds)\nmarkup m (DocOrderedList ds)         = markupOrderedList m (map (markup m) ds)\nmarkup m (DocDefList ds)             = markupDefList m (map (markupPair m) ds)\nmarkup m (DocCodeBlock d)            = markupCodeBlock m (markup m d)\nmarkup m (DocHyperlink l)            = markupHyperlink m l\nmarkup m (DocAName ref)              = markupAName m ref\nmarkup m (DocPic img)                = markupPic m img\nmarkup m (DocMathInline mathjax)     = markupMathInline m mathjax\nmarkup m (DocMathDisplay mathjax)    = markupMathDisplay m mathjax\nmarkup m (DocProperty p)             = markupProperty m p\nmarkup m (DocExamples e)             = markupExample m e\nmarkup m (DocHeader (Header l t))    = markupHeader m (Header l (markup m t))\nmarkup m (DocTable (Table h b))      = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b))\n\nmarkupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a)\nmarkupPair m (a,b) = (markup m a, markup m b)\n\n-- | The identity markup\nidMarkup :: DocMarkupH mod id (DocH mod id)\nidMarkup = Markup {\n  markupEmpty                = DocEmpty,\n  markupString               = DocString,\n  markupParagraph            = DocParagraph,\n  markupAppend               = DocAppend,\n  markupIdentifier           = DocIdentifier,\n  markupIdentifierUnchecked  = DocIdentifierUnchecked,\n  markupModule               = DocModule,\n  markupWarning              = DocWarning,\n  markupEmphasis             = DocEmphasis,\n  markupBold                 = DocBold,\n  markupMonospaced           = DocMonospaced,\n  markupUnorderedList        = DocUnorderedList,\n  markupOrderedList          = DocOrderedList,\n  markupDefList              = DocDefList,\n  markupCodeBlock            = DocCodeBlock,\n  markupHyperlink            = DocHyperlink,\n  markupAName                = DocAName,\n  markupPic                  = DocPic,\n  markupMathInline           = DocMathInline,\n  markupMathDisplay          = DocMathDisplay,\n  markupProperty             = DocProperty,\n  markupExample              = DocExamples,\n  markupHeader               = DocHeader,\n  markupTable                = DocTable\n  }\n", "num_lines": 66}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP               #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ViewPatterns      #-}\n-- |\n-- Module      :  Documentation.Haddock.Parser\n-- Copyright   :  (c) Mateusz Kowalczyk 2013-2014,\n--                    Simon Hengel      2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Parser used for Haddock comments. For external users of this\n-- library, the most commonly used combination of functions is going\n-- to be\n--\n-- @'toRegular' . '_doc' . 'parseParas'@\nmodule Documentation.Haddock.Parser (\n  parseString,\n  parseParas,\n  overIdentifier,\n  toRegular,\n  Identifier\n) where\n\nimport           Control.Applicative\nimport           Control.Arrow (first)\nimport           Control.Monad\nimport           Data.Char (chr, isUpper, isAlpha, isAlphaNum, isSpace)\nimport           Data.List (intercalate, unfoldr, elemIndex, notElem)\nimport           Data.Maybe (fromMaybe, mapMaybe)\nimport           Data.Monoid\nimport qualified Data.Set as Set\nimport           Documentation.Haddock.Doc\nimport           Documentation.Haddock.Parser.Monad\nimport           Documentation.Haddock.Parser.Util\nimport           Documentation.Haddock.Types\nimport           Prelude hiding (takeWhile)\nimport qualified Prelude as P\n\nimport qualified Text.Parsec as Parsec\nimport           Text.Parsec (try)\n\nimport qualified Data.Text as T\nimport           Data.Text (Text)\n\n#if MIN_VERSION_base(4,9,0)\nimport           Text.Read.Lex                      (isSymbolChar)\n#else\nimport           Data.Char                          (GeneralCategory (..),\n                                                     generalCategory)\n#endif\n\n-- $setup\n-- >>> :set -XOverloadedStrings\n\n#if !MIN_VERSION_base(4,9,0)\n-- inlined from base-4.10.0.0\nisSymbolChar :: Char -> Bool\nisSymbolChar c = not (isPuncChar c) && case generalCategory c of\n    MathSymbol           -> True\n    CurrencySymbol       -> True\n    ModifierSymbol       -> True\n    OtherSymbol          -> True\n    DashPunctuation      -> True\n    OtherPunctuation     -> c `notElem` (\"'\\\"\" :: String)\n    ConnectorPunctuation -> c /= '_'\n    _                    -> False\n  where\n    -- | The @special@ character class as defined in the Haskell Report.\n    isPuncChar :: Char -> Bool\n    isPuncChar = (`elem` (\",;()[]{}`\" :: String))\n#endif\n\n-- | Identifier string surrounded with opening and closing quotes/backticks.\ntype Identifier = (Char, String, Char)\n\n-- | Drops the quotes/backticks around all identifiers, as if they\n-- were valid but still 'String's.\ntoRegular :: DocH mod Identifier -> DocH mod String\ntoRegular = fmap (\\(_, x, _) -> x)\n\n-- | Maps over 'DocIdentifier's over 'String' with potentially failing\n-- conversion using user-supplied function. If the conversion fails,\n-- the identifier is deemed to not be valid and is treated as a\n-- regular string.\noverIdentifier :: (String -> Maybe a)\n               -> DocH mod Identifier\n               -> DocH mod a\noverIdentifier f d = g d\n  where\n    g (DocIdentifier (o, x, e)) = case f x of\n      Nothing -> DocString $ o : x ++ [e]\n      Just x' -> DocIdentifier x'\n    g DocEmpty = DocEmpty\n    g (DocAppend x x') = DocAppend (g x) (g x')\n    g (DocString x) = DocString x\n    g (DocParagraph x) = DocParagraph $ g x\n    g (DocIdentifierUnchecked x) = DocIdentifierUnchecked x\n    g (DocModule x) = DocModule x\n    g (DocWarning x) = DocWarning $ g x\n    g (DocEmphasis x) = DocEmphasis $ g x\n    g (DocMonospaced x) = DocMonospaced $ g x\n    g (DocBold x) = DocBold $ g x\n    g (DocUnorderedList x) = DocUnorderedList $ fmap g x\n    g (DocOrderedList x) = DocOrderedList $ fmap g x\n    g (DocDefList x) = DocDefList $ fmap (\\(y, z) -> (g y, g z)) x\n    g (DocCodeBlock x) = DocCodeBlock $ g x\n    g (DocHyperlink x) = DocHyperlink x\n    g (DocPic x) = DocPic x\n    g (DocMathInline x) = DocMathInline x\n    g (DocMathDisplay x) = DocMathDisplay x\n    g (DocAName x) = DocAName x\n    g (DocProperty x) = DocProperty x\n    g (DocExamples x) = DocExamples x\n    g (DocHeader (Header l x)) = DocHeader . Header l $ g x\n    g (DocTable (Table h b)) = DocTable (Table (map (fmap g) h) (map (fmap g) b))\n\n\nchoice' :: [Parser a] -> Parser a\nchoice' [] = empty\nchoice' [p] = p\nchoice' (p : ps) = try p <|> choice' ps\n\nparse :: Parser a -> Text -> (ParserState, a)\nparse p = either err id . parseOnly (p <* Parsec.eof)\n  where\n    err = error . (\"Haddock.Parser.parse: \" ++)\n\n-- | Main entry point to the parser. Appends the newline character\n-- to the input string.\nparseParas :: Maybe Package\n           -> String -- ^ String to parse\n           -> MetaDoc mod Identifier\nparseParas pkg input = case parseParasState input of\n  (state, a) -> MetaDoc { _meta = Meta { _version = parserStateSince state\n                                       , _package = pkg\n                                       }\n                        , _doc = a\n                        }\n\nparseParasState :: String -> (ParserState, DocH mod Identifier)\nparseParasState = parse (emptyLines *> p) . T.pack . (++ \"\\n\") . filter (/= '\\r')\n  where\n    p :: Parser (DocH mod Identifier)\n    p = docConcat <$> many (paragraph <* emptyLines)\n\n    emptyLines :: Parser ()\n    emptyLines = void $ many (try (skipHorizontalSpace *> \"\\n\"))\n\nparseParagraphs :: String -> Parser (DocH mod Identifier)\nparseParagraphs input = case parseParasState input of\n  (state, a) -> Parsec.putState state *> pure a\n\n-- | Variant of 'parseText' for 'String' instead of 'Text'\nparseString :: String -> DocH mod Identifier\nparseString = parseText . T.pack\n\n-- | Parse a text paragraph. Actually just a wrapper over 'parseParagraph' which\n-- drops leading whitespace.\nparseText :: Text -> DocH mod Identifier\nparseText = parseParagraph . T.dropWhile isSpace . T.filter (/= '\\r')\n\nparseParagraph :: Text -> DocH mod Identifier\nparseParagraph = snd . parse p\n  where\n    p :: Parser (DocH mod Identifier)\n    p = docConcat <$> many (choice' [ monospace\n                                    , anchor\n                                    , identifier\n                                    , moduleName\n                                    , picture\n                                    , mathDisplay\n                                    , mathInline\n                                    , markdownImage\n                                    , hyperlink\n                                    , bold\n                                    , emphasis\n                                    , encodedChar\n                                    , string'\n                                    , skipSpecialChar\n                                    ])\n\n-- | Parses and processes\n-- <https://en.wikipedia.org/wiki/Numeric_character_reference Numeric character references>\n--\n-- >>> parseString \"&#65;\"\n-- DocString \"A\"\nencodedChar :: Parser (DocH mod a)\nencodedChar = \"&#\" *> c <* \";\"\n  where\n    c = DocString . return . chr <$> num\n    num = hex <|> decimal\n    hex = (\"x\" <|> \"X\") *> hexadecimal\n\n-- | List of characters that we use to delimit any special markup.\n-- Once we have checked for any of these and tried to parse the\n-- relevant markup, we can assume they are used as regular text.\nspecialChar :: [Char]\nspecialChar = \"_/<@\\\"&'`# \"\n\n-- | Plain, regular parser for text. Called as one of the last parsers\n-- to ensure that we have already given a chance to more meaningful parsers\n-- before capturing their characers.\nstring' :: Parser (DocH mod a)\nstring' = DocString . unescape . T.unpack <$> takeWhile1_ (`notElem` specialChar)\n  where\n    unescape \"\" = \"\"\n    unescape ('\\\\':x:xs) = x : unescape xs\n    unescape (x:xs) = x : unescape xs\n\n-- | Skips a single special character and treats it as a plain string.\n-- This is done to skip over any special characters belonging to other\n-- elements but which were not deemed meaningful at their positions.\nskipSpecialChar :: Parser (DocH mod a)\nskipSpecialChar = DocString . return <$> Parsec.oneOf specialChar\n\n-- | Emphasis parser.\n--\n-- >>> parseString \"/Hello world/\"\n-- DocEmphasis (DocString \"Hello world\")\nemphasis :: Parser (DocH mod Identifier)\nemphasis = DocEmphasis . parseParagraph <$>\n  disallowNewline (\"/\" *> takeWhile1_ (/= '/') <* \"/\")\n\n-- | Bold parser.\n--\n-- >>> parseString \"__Hello world__\"\n-- DocBold (DocString \"Hello world\")\nbold :: Parser (DocH mod Identifier)\nbold = DocBold . parseParagraph <$> disallowNewline (\"__\" *> takeUntil \"__\")\n\ndisallowNewline :: Parser Text -> Parser Text\ndisallowNewline = mfilter (T.all (/= '\\n'))\n\n-- | Like `takeWhile`, but unconditionally take escaped characters.\ntakeWhile_ :: (Char -> Bool) -> Parser Text\ntakeWhile_ p = scan p_ False\n  where\n    p_ escaped c\n      | escaped = Just False\n      | not $ p c = Nothing\n      | otherwise = Just (c == '\\\\')\n\n-- | Like 'takeWhile1', but unconditionally take escaped characters.\ntakeWhile1_ :: (Char -> Bool) -> Parser Text\ntakeWhile1_ = mfilter (not . T.null) . takeWhile_\n\n-- | Text anchors to allow for jumping around the generated documentation.\n--\n-- >>> parseString \"#Hello world#\"\n-- DocAName \"Hello world\"\nanchor :: Parser (DocH mod a)\nanchor = DocAName . T.unpack <$>\n         disallowNewline (\"#\" *> takeWhile1_ (/= '#') <* \"#\")\n\n-- | Monospaced strings.\n--\n-- >>> parseString \"@cruel@\"\n-- DocMonospaced (DocString \"cruel\")\nmonospace :: Parser (DocH mod Identifier)\nmonospace = DocMonospaced . parseParagraph\n            <$> (\"@\" *> takeWhile1_ (/= '@') <* \"@\")\n\n-- | Module names.\n--\n-- Note that we allow '#' and '\\' to support anchors (old style anchors are of\n-- the form \"SomeModule\\#anchor\").\nmoduleName :: Parser (DocH mod a)\nmoduleName = DocModule <$> (\"\\\"\" *> modid <* \"\\\"\")\n  where\n    modid = intercalate \".\" <$> conid `Parsec.sepBy1` \".\"\n    conid = (:)\n      <$> Parsec.satisfy (\\c -> isAlpha c && isUpper c)\n      <*> many (conChar <|> Parsec.oneOf \"\\\\#\")\n\n    conChar = Parsec.alphaNum <|> Parsec.char '_'\n\n-- | Picture parser, surrounded by \\<\\< and \\>\\>. It's possible to specify\n-- a title for the picture.\n--\n-- >>> parseString \"<<hello.png>>\"\n-- DocPic (Picture {pictureUri = \"hello.png\", pictureTitle = Nothing})\n-- >>> parseString \"<<hello.png world>>\"\n-- DocPic (Picture {pictureUri = \"hello.png\", pictureTitle = Just \"world\"})\npicture :: Parser (DocH mod a)\npicture = DocPic . makeLabeled Picture\n          <$> disallowNewline (\"<<\" *> takeUntil \">>\")\n\n-- | Inline math parser, surrounded by \\\\( and \\\\).\n--\n-- >>> parseString \"\\\\(\\\\int_{-\\\\infty}^{\\\\infty} e^{-x^2/2} = \\\\sqrt{2\\\\pi}\\\\)\"\n-- DocMathInline \"\\\\int_{-\\\\infty}^{\\\\infty} e^{-x^2/2} = \\\\sqrt{2\\\\pi}\"\nmathInline :: Parser (DocH mod a)\nmathInline = DocMathInline . T.unpack \n             <$> disallowNewline  (\"\\\\(\" *> takeUntil \"\\\\)\")\n\n-- | Display math parser, surrounded by \\\\[ and \\\\].\n--\n-- >>> parseString \"\\\\[\\\\int_{-\\\\infty}^{\\\\infty} e^{-x^2/2} = \\\\sqrt{2\\\\pi}\\\\]\"\n-- DocMathDisplay \"\\\\int_{-\\\\infty}^{\\\\infty} e^{-x^2/2} = \\\\sqrt{2\\\\pi}\"\nmathDisplay :: Parser (DocH mod a)\nmathDisplay = DocMathDisplay . T.unpack \n              <$> (\"\\\\[\" *> takeUntil \"\\\\]\")\n\nmarkdownImage :: Parser (DocH mod a)\nmarkdownImage = fromHyperlink <$> (\"!\" *> linkParser)\n  where\n    fromHyperlink (Hyperlink url label) = DocPic (Picture url label)\n\n-- | Paragraph parser, called by 'parseParas'.\nparagraph :: Parser (DocH mod Identifier)\nparagraph = choice' [ examples\n                    , table\n                    , do indent <- takeIndent\n                         choice' [ since\n                                 , unorderedList indent\n                                 , orderedList indent\n                                 , birdtracks\n                                 , codeblock\n                                 , property\n                                 , header\n                                 , textParagraphThatStartsWithMarkdownLink\n                                 , definitionList indent\n                                 , docParagraph <$> textParagraph\n                                 ]\n                    ]\n\n-- | Provides support for grid tables.\n--\n-- Tables are composed by an optional header and body. The header is composed by\n-- a single row. The body is composed by a non-empty list of rows.\n--\n-- Example table with header:\n--\n-- > +----------+----------+\n-- > | /32bit/  |   64bit  |\n-- > +==========+==========+\n-- > |  0x0000  | @0x0000@ |\n-- > +----------+----------+\n--\n-- Algorithms loosely follows ideas in\n-- http://docutils.sourceforge.net/docutils/parsers/rst/tableparser.py\n--\ntable :: Parser (DocH mod Identifier)\ntable = do\n    -- first we parse the first row, which determines the width of the table\n    firstRow <- parseFirstRow\n    let len = T.length firstRow\n\n    -- then we parse all consequtive rows starting and ending with + or |,\n    -- of the width `len`.\n    restRows <- many (try (parseRestRows len))\n\n    -- Now we gathered the table block, the next step is to split the block\n    -- into cells.\n    DocTable <$> tableStepTwo len (firstRow : restRows)\n  where\n    parseFirstRow :: Parser Text\n    parseFirstRow = do\n        skipHorizontalSpace\n        -- upper-left corner is +\n        c <- Parsec.char '+'\n        cs <- some (Parsec.char '-' <|> Parsec.char '+')\n\n        -- upper right corner is + too\n        guard (last cs == '+')\n\n        -- trailing space\n        skipHorizontalSpace\n        _ <- Parsec.newline\n\n        return (T.cons c $ T.pack cs)\n\n    parseRestRows :: Int -> Parser Text\n    parseRestRows l = do\n        skipHorizontalSpace\n\n        c <- Parsec.char '|' <|> Parsec.char '+'\n        bs <- scan predicate (l - 2)\n        c2 <- Parsec.char '|' <|> Parsec.char '+'\n\n        -- trailing space\n        skipHorizontalSpace\n        _ <- Parsec.newline\n\n        return (T.cons c (T.snoc bs c2))\n      where\n        predicate n c\n            | n <= 0    = Nothing\n            | c == '\\n' = Nothing\n            | otherwise = Just (n - 1)\n\n-- Second step searchs for row of '+' and '=' characters, records it's index\n-- and changes to '=' to '-'.\ntableStepTwo\n    :: Int              -- ^ width\n    -> [Text]           -- ^ rows\n    -> Parser (Table (DocH mod Identifier))\ntableStepTwo width = go 0 [] where\n    go _ left [] = tableStepThree width (reverse left) Nothing\n    go n left (r : rs)\n        | T.all (`elem` ['+', '=']) r =\n            tableStepThree width (reverse left ++ r' : rs) (Just n)\n        | otherwise =\n            go (n + 1) (r :  left) rs\n      where\n        r' = T.map (\\c -> if c == '=' then '-' else c) r\n\n-- Third step recognises cells in the table area, returning a list of TC, cells.\ntableStepThree\n    :: Int              -- ^ width\n    -> [Text]           -- ^ rows\n    -> Maybe Int        -- ^ index of header separator\n    -> Parser (Table (DocH mod Identifier))\ntableStepThree width rs hdrIndex = do\n    cells <- loop (Set.singleton (0, 0))\n    tableStepFour rs hdrIndex cells\n  where\n    height = length rs\n\n    loop :: Set.Set (Int, Int) -> Parser [TC]\n    loop queue = case Set.minView queue of\n        Nothing -> return []\n        Just ((y, x), queue')\n            | y + 1 >= height || x + 1 >= width -> loop queue'\n            | otherwise -> case scanRight x y of\n                Nothing -> loop queue'\n                Just (x2, y2) -> do\n                    let tc = TC y x y2 x2\n                    fmap (tc :) $ loop $ queue' `Set.union` Set.fromList\n                        [(y, x2), (y2, x), (y2, x2)]\n\n    -- scan right looking for +, then try scan down\n    --\n    -- do we need to record + saw on the way left and down?\n    scanRight :: Int -> Int -> Maybe (Int, Int)\n    scanRight x y = go (x + 1) where\n        bs = rs !! y\n        go x' | x' >= width          = fail \"overflow right \"\n              | T.index bs x' == '+' = scanDown x y x' <|> go (x' + 1)\n              | T.index bs x' == '-' = go (x' + 1)\n              | otherwise            = fail $ \"not a border (right) \" ++ show (x,y,x')\n\n    -- scan down looking for +\n    scanDown :: Int -> Int -> Int -> Maybe (Int, Int)\n    scanDown x y x2 = go (y + 1) where\n        go y' | y' >= height                 = fail \"overflow down\"\n              | T.index (rs !! y') x2 == '+' = scanLeft x y x2 y' <|> go (y' + 1)\n              | T.index (rs !! y') x2 == '|' = go (y' + 1)\n              | otherwise                    = fail $ \"not a border (down) \" ++ show (x,y,x2,y')\n\n    -- check that at y2 x..x2 characters are '+' or '-'\n    scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int)\n    scanLeft x y x2 y2\n        | all (\\x' -> T.index bs x' `elem` ['+', '-']) [x..x2] = scanUp x y x2 y2\n        | otherwise                                            = fail $ \"not a border (left) \" ++ show (x,y,x2,y2)\n      where\n        bs = rs !! y2\n\n    -- check that at y2 x..x2 characters are '+' or '-'\n    scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)\n    scanUp x y x2 y2\n        | all (\\y' -> T.index (rs !! y') x `elem` ['+', '|']) [y..y2] = return (x2, y2)\n        | otherwise                                                   = fail $ \"not a border (up) \" ++ show (x,y,x2,y2)\n\n-- | table cell: top left bottom right\ndata TC = TC !Int !Int !Int !Int\n  deriving Show\n\ntcXS :: TC -> [Int]\ntcXS (TC _ x _ x2) = [x, x2]\n\ntcYS :: TC -> [Int]\ntcYS (TC y _ y2 _) = [y, y2]\n\n-- | Fourth step. Given the locations of cells, forms 'Table' structure.\ntableStepFour :: [Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))\ntableStepFour rs hdrIndex cells =  case hdrIndex of\n    Nothing -> return $ Table [] rowsDoc\n    Just i  -> case elemIndex i yTabStops of\n        Nothing -> return $ Table [] rowsDoc\n        Just i' -> return $ uncurry Table $ splitAt i' rowsDoc\n  where\n    xTabStops = sortNub $ concatMap tcXS cells\n    yTabStops = sortNub $ concatMap tcYS cells\n\n    sortNub :: Ord a => [a] -> [a]\n    sortNub = Set.toList . Set.fromList\n\n    init' :: [a] -> [a]\n    init' []       = []\n    init' [_]      = []\n    init' (x : xs) = x : init' xs\n\n    rowsDoc = (fmap . fmap) parseParagraph rows\n\n    rows = map makeRow (init' yTabStops)\n      where\n        makeRow y = TableRow $ mapMaybe (makeCell y) cells\n        makeCell y (TC y' x y2 x2)\n            | y /= y' = Nothing\n            | otherwise = Just $ TableCell xts yts (extract (x + 1) (y + 1) (x2 - 1) (y2 - 1))\n          where\n            xts = length $ P.takeWhile (< x2) $ dropWhile (< x) xTabStops\n            yts = length $ P.takeWhile (< y2) $ dropWhile (< y) yTabStops\n\n    -- extract cell contents given boundaries\n    extract :: Int -> Int -> Int -> Int -> Text\n    extract x y x2 y2 = T.intercalate \"\\n\"\n        [ T.take (x2 - x + 1) $ T.drop x $ rs !! y'\n        | y' <- [y .. y2]\n        ]\n\n-- | Parse \\@since annotations.\nsince :: Parser (DocH mod a)\nsince = (\"@since \" *> version <* skipHorizontalSpace <* endOfLine) >>= setSince >> return DocEmpty\n  where\n    version = decimal `Parsec.sepBy1` \".\"\n\n-- | Headers inside the comment denoted with @=@ signs, up to 6 levels\n-- deep.\n--\n-- >>> snd <$> parseOnly header \"= Hello\"\n-- Right (DocHeader (Header {headerLevel = 1, headerTitle = DocString \"Hello\"}))\n-- >>> snd <$> parseOnly header \"== World\"\n-- Right (DocHeader (Header {headerLevel = 2, headerTitle = DocString \"World\"}))\nheader :: Parser (DocH mod Identifier)\nheader = do\n  let psers = map (string . flip T.replicate \"=\") [6, 5 .. 1]\n      pser = choice' psers\n  delim <- T.unpack <$> pser\n  line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseText\n  rest <- try paragraph <|> return DocEmpty\n  return $ DocHeader (Header (length delim) line) `docAppend` rest\n\ntextParagraph :: Parser (DocH mod Identifier)\ntextParagraph = parseText . T.intercalate \"\\n\" <$> some nonEmptyLine\n\ntextParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier)\ntextParagraphThatStartsWithMarkdownLink = docParagraph <$> (docAppend <$> markdownLink <*> optionalTextParagraph)\n  where\n    optionalTextParagraph :: Parser (DocH mod Identifier)\n    optionalTextParagraph = choice' [ docAppend <$> whitespace <*> textParagraph\n                                    , pure DocEmpty ]\n\n    whitespace :: Parser (DocH mod a)\n    whitespace = DocString <$> (f <$> takeHorizontalSpace <*> optional \"\\n\")\n      where\n        f :: Text -> Maybe Text -> String\n        f xs (fromMaybe \"\" -> x)\n          | T.null (xs <> x) = \"\"\n          | otherwise = \" \"\n\n-- | Parses unordered (bullet) lists.\nunorderedList :: Text -> Parser (DocH mod Identifier)\nunorderedList indent = DocUnorderedList <$> p\n  where\n    p = (\"*\" <|> \"-\") *> innerList indent p\n\n-- | Parses ordered lists (numbered or dashed).\norderedList :: Text -> Parser (DocH mod Identifier)\norderedList indent = DocOrderedList <$> p\n  where\n    p = (paren <|> dot) *> innerList indent p\n    dot = (decimal :: Parser Int) <* \".\"\n    paren = \"(\" *> decimal <* \")\"\n\n-- | Generic function collecting any further lines belonging to the\n-- list entry and recursively collecting any further lists in the\n-- same paragraph. Usually used as\n--\n-- > someListFunction = listBeginning *> innerList someListFunction\ninnerList :: Text -> Parser [DocH mod Identifier]\n          -> Parser [DocH mod Identifier]\ninnerList indent item = do\n  c <- takeLine\n  (cs, items) <- more indent item\n  let contents = docParagraph . parseText . dropNLs . T.unlines $ c : cs\n  return $ case items of\n    Left p -> [contents `docAppend` p]\n    Right i -> contents : i\n\n-- | Parses definition lists.\ndefinitionList :: Text -> Parser (DocH mod Identifier)\ndefinitionList indent = DocDefList <$> p\n  where\n    p = do\n      label <- \"[\" *> (parseParagraph <$> takeWhile1_ (`notElem` (\"]\\n\" :: String))) <* (\"]\" <* optional \":\")\n      c <- takeLine\n      (cs, items) <- more indent p\n      let contents = parseText . dropNLs . T.unlines $ c : cs\n      return $ case items of\n        Left x -> [(label, contents `docAppend` x)]\n        Right i -> (label, contents) : i\n\n-- | Drops all trailing newlines.\ndropNLs :: Text -> Text \ndropNLs = T.dropWhileEnd (== '\\n')\n\n-- | Main worker for 'innerList' and 'definitionList'.\n-- We need the 'Either' here to be able to tell in the respective functions\n-- whether we're dealing with the next list or a nested paragraph.\nmore :: Monoid a => Text -> Parser a\n     -> Parser ([Text], Either (DocH mod Identifier) a)\nmore indent item = choice' [ innerParagraphs indent\n                           , moreListItems indent item\n                           , moreContent indent item\n                           , pure ([], Right mempty)\n                           ]\n\n-- | Used by 'innerList' and 'definitionList' to parse any nested paragraphs.\ninnerParagraphs :: Text\n                -> Parser ([Text], Either (DocH mod Identifier) a)\ninnerParagraphs indent = (,) [] . Left <$> (\"\\n\" *> indentedParagraphs indent)\n\n-- | Attempts to fetch the next list if possibly. Used by 'innerList' and\n-- 'definitionList' to recursively grab lists that aren't separated by a whole\n-- paragraph.\nmoreListItems :: Text -> Parser a\n              -> Parser ([Text], Either (DocH mod Identifier) a)\nmoreListItems indent item = (,) [] . Right <$> indentedItem\n  where\n    indentedItem = string indent *> Parsec.spaces *> item\n\n-- | Helper for 'innerList' and 'definitionList' which simply takes\n-- a line of text and attempts to parse more list content with 'more'.\nmoreContent :: Monoid a => Text -> Parser a\n            -> Parser ([Text], Either (DocH mod Identifier) a)\nmoreContent indent item = first . (:) <$> nonEmptyLine <*> more indent item\n\n-- | Parses an indented paragraph.\n-- The indentation is 4 spaces.\nindentedParagraphs :: Text -> Parser (DocH mod Identifier)\nindentedParagraphs indent =\n    (T.unpack . T.concat <$> dropFrontOfPara indent') >>= parseParagraphs\n  where\n    indent' = string $ indent <> \"    \"\n\n-- | Grab as many fully indented paragraphs as we can.\ndropFrontOfPara :: Parser Text -> Parser [Text]\ndropFrontOfPara sp = do\n  currentParagraph <- some (try (sp *> takeNonEmptyLine))\n  followingParagraphs <-\n    choice' [ skipHorizontalSpace *> nextPar -- we have more paragraphs to take\n            , skipHorizontalSpace *> nlList -- end of the ride, remember the newline\n            , Parsec.eof *> return []       -- nothing more to take at all\n            ]\n  return (currentParagraph ++ followingParagraphs)\n  where\n    nextPar = (++) <$> nlList <*> dropFrontOfPara sp\n    nlList = \"\\n\" *> return [\"\\n\"]\n\nnonSpace :: Text -> Parser Text\nnonSpace xs\n  | T.all isSpace xs = fail \"empty line\"\n  | otherwise = return xs\n\n-- | Takes a non-empty, not fully whitespace line.\n--\n--  Doesn't discard the trailing newline.\ntakeNonEmptyLine :: Parser Text\ntakeNonEmptyLine = do\n    l <- takeWhile1 (Parsec.noneOf \"\\n\") >>= nonSpace\n    _ <- \"\\n\"\n    pure (l <> \"\\n\")\n\n-- | Takes indentation of first non-empty line.\n--\n-- More precisely: skips all whitespace-only lines and returns indentation\n-- (horizontal space, might be empty) of that non-empty line.\ntakeIndent :: Parser Text \ntakeIndent = do\n  indent <- takeHorizontalSpace\n  choice' [ \"\\n\" *> takeIndent\n          , return indent\n          ]\n\n-- | Blocks of text of the form:\n--\n-- >> foo\n-- >> bar\n-- >> baz\n--\nbirdtracks :: Parser (DocH mod a)\nbirdtracks = DocCodeBlock . DocString . T.unpack . T.intercalate \"\\n\" . stripSpace <$> some line\n  where\n    line = try (skipHorizontalSpace *> \">\" *> takeLine)\n\nstripSpace :: [Text] -> [Text]\nstripSpace = fromMaybe <*> mapM strip'\n  where\n    strip' t = case T.uncons t of\n                 Nothing -> Just \"\"\n                 Just (' ',t') -> Just t'\n                 _ -> Nothing\n\n-- | Parses examples. Examples are a paragraph level entitity (separated by an empty line).\n-- Consecutive examples are accepted.\nexamples :: Parser (DocH mod a)\nexamples = DocExamples <$> (many (try (skipHorizontalSpace *> \"\\n\")) *> go)\n  where\n    go :: Parser [Example]\n    go = do\n      prefix <- takeHorizontalSpace <* \">>>\"\n      expr <- takeLine\n      (rs, es) <- resultAndMoreExamples\n      return (makeExample prefix expr rs : es)\n      where\n        resultAndMoreExamples :: Parser ([Text], [Example])\n        resultAndMoreExamples = choice' [ moreExamples, result, pure ([], []) ]\n          where\n            moreExamples :: Parser ([Text], [Example])\n            moreExamples = (,) [] <$> go\n\n            result :: Parser ([Text], [Example])\n            result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples\n\n    makeExample :: Text -> Text -> [Text] -> Example\n    makeExample prefix expression res =\n      Example (T.unpack (T.strip expression)) result\n      where\n        result = map (T.unpack . substituteBlankLine . tryStripPrefix) res\n\n        tryStripPrefix xs = fromMaybe xs (T.stripPrefix prefix xs)\n\n        substituteBlankLine \"<BLANKLINE>\" = \"\"\n        substituteBlankLine xs = xs\n\nnonEmptyLine :: Parser Text \nnonEmptyLine = try (mfilter (T.any (not . isSpace)) takeLine)\n\ntakeLine :: Parser Text\ntakeLine = try (takeWhile (Parsec.noneOf \"\\n\") <* endOfLine)\n\nendOfLine :: Parser ()\nendOfLine = void \"\\n\" <|> Parsec.eof \n\n-- | Property parser.\n--\n-- >>> snd <$> parseOnly property \"prop> hello world\"\n-- Right (DocProperty \"hello world\")\nproperty :: Parser (DocH mod a)\nproperty = DocProperty . T.unpack . T.strip <$> (\"prop>\" *> takeWhile1 (Parsec.noneOf \"\\n\"))\n\n-- |\n-- Paragraph level codeblock. Anything between the two delimiting \\@ is parsed\n-- for markup.\ncodeblock :: Parser (DocH mod Identifier)\ncodeblock =\n  DocCodeBlock . parseParagraph . dropSpaces\n  <$> (\"@\" *> skipHorizontalSpace *> \"\\n\" *> block' <* \"@\")\n  where\n    dropSpaces xs =\n      case splitByNl xs of\n        [] -> xs\n        ys -> case T.uncons (last ys) of\n          Just (' ',_) -> case mapM dropSpace ys of\n                            Nothing -> xs\n                            Just zs -> T.intercalate \"\\n\" zs\n          _ -> xs\n\n    -- This is necessary because \u00e2\u20ac\u02dclines\u00e2\u20ac\u2122 swallows up a trailing newline\n    -- and we lose information about whether the last line belongs to @ or to\n    -- text which we need to decide whether we actually want to be dropping\n    -- anything at all.\n    splitByNl = unfoldr (\\x -> case T.uncons x of\n                                 Just ('\\n',x') -> Just (T.span (/= '\\n') x')\n                                 _ -> Nothing)\n                . (\"\\n\" <>)\n\n    dropSpace t = case T.uncons t of\n                    Nothing -> Just \"\"\n                    Just (' ',t') -> Just t'\n                    _ -> Nothing\n\n    block' = scan p False\n      where\n        p isNewline c\n          | isNewline && c == '@' = Nothing\n          | isNewline && isSpace c = Just isNewline\n          | otherwise = Just $ c == '\\n'\n\nhyperlink :: Parser (DocH mod a)\nhyperlink = choice' [ angleBracketLink, markdownLink, autoUrl ]\n\nangleBracketLink :: Parser (DocH mod a)\nangleBracketLink =\n    DocHyperlink . makeLabeled Hyperlink \n    <$> disallowNewline (\"<\" *> takeUntil \">\")\n\nmarkdownLink :: Parser (DocH mod a)\nmarkdownLink = DocHyperlink <$> linkParser\n\nlinkParser :: Parser Hyperlink\nlinkParser = flip Hyperlink <$> label <*> (whitespace *> url)\n  where\n    label :: Parser (Maybe String)\n    label = Just . decode . T.strip <$> (\"[\" *> takeUntil \"]\")\n\n    whitespace :: Parser ()\n    whitespace = skipHorizontalSpace <* optional (\"\\n\" *> skipHorizontalSpace)\n\n    url :: Parser String\n    url = rejectWhitespace (decode <$> (\"(\" *> takeUntil \")\"))\n\n    rejectWhitespace :: MonadPlus m => m String -> m String\n    rejectWhitespace = mfilter (all (not . isSpace))\n\n    decode :: Text -> String\n    decode = T.unpack . removeEscapes\n\n-- | Looks for URL-like things to automatically hyperlink even if they\n-- weren't marked as links.\nautoUrl :: Parser (DocH mod a)\nautoUrl = mkLink <$> url\n  where\n    url = mappend <$> choice' [ \"http://\", \"https://\", \"ftp://\"] <*> takeWhile1 (Parsec.satisfy (not . isSpace))\n    \n    mkLink :: Text -> DocH mod a\n    mkLink s = case T.unsnoc s of\n      Just (xs,x) | x `elem` (\",.!?\" :: String) -> DocHyperlink (mkHyperlink xs) `docAppend` DocString [x]\n      _ -> DocHyperlink (mkHyperlink s)\n\n    mkHyperlink :: Text -> Hyperlink\n    mkHyperlink lnk = Hyperlink (T.unpack lnk) Nothing\n\n\n\n-- | Parses strings between identifier delimiters. Consumes all input that it\n-- deems to be valid in an identifier. Note that it simply blindly consumes\n-- characters and does no actual validation itself.\nparseValid :: Parser String\nparseValid = p some\n  where\n    idChar = Parsec.satisfy (\\c -> isAlphaNum c || isSymbolChar c || c == '_')\n\n    p p' = do\n      vs <- p' idChar\n      c <- peekChar'\n      case c of\n        '`' -> return vs\n        '\\'' -> choice' [ (\\x -> vs ++ \"'\" ++ x) <$> (\"'\" *> p many), return vs ]\n        _ -> fail \"outofvalid\"\n\n-- | Parses identifiers with help of 'parseValid'. Asks GHC for\n-- 'String' from the string it deems valid.\nidentifier :: Parser (DocH mod Identifier)\nidentifier = do\n  o <- idDelim\n  vid <- parseValid\n  e <- idDelim\n  return $ DocIdentifier (o, vid, e)\n  where\n    idDelim = Parsec.satisfy (\\c -> c == '\\'' || c == '`')\n", "num_lines": 857}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}\n\n-- |\n-- Module      :  Documentation.Haddock.Types\n-- Copyright   :  (c) Simon Marlow      2003-2006,\n--                    David Waern       2006-2009,\n--                    Mateusz Kowalczyk 2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskellorg\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Exposes documentation data types used for (some) of Haddock.\nmodule Documentation.Haddock.Types where\n\n#if !MIN_VERSION_base(4,8,0)\nimport Control.Applicative\nimport Data.Foldable\nimport Data.Traversable\n#endif\n\n#if MIN_VERSION_base(4,8,0)\nimport Control.Arrow ((***))\nimport Data.Bifunctor\n#endif\n\n#if MIN_VERSION_base(4,10,0)\nimport Data.Bifoldable\nimport Data.Bitraversable\n#endif\n\n-- | With the advent of 'Version', we may want to start attaching more\n-- meta-data to comments. We make a structure for this ahead of time\n-- so we don't have to gut half the core each time we want to add such\n-- info.\ndata Meta = Meta { _version :: Maybe Version\n                 , _package :: Maybe Package\n                 } deriving (Eq, Show)\n\ndata MetaDoc mod id =\n  MetaDoc { _meta :: Meta\n          , _doc :: DocH mod id\n          } deriving (Eq, Show, Functor, Foldable, Traversable)\n\n#if MIN_VERSION_base(4,8,0)\ninstance Bifunctor MetaDoc where\n  bimap f g (MetaDoc m d) = MetaDoc m (bimap f g d)\n#endif\n\n#if MIN_VERSION_base(4,10,0)\ninstance Bifoldable MetaDoc where\n  bifoldr f g z d = bifoldr f g z (_doc d)\n\ninstance Bitraversable MetaDoc where\n  bitraverse f g (MetaDoc m d) = MetaDoc m <$> bitraverse f g d\n#endif\n\noverDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d\noverDoc f d = d { _doc = f $ _doc d }\n\noverDocF :: Functor f => (DocH a b -> f (DocH c d)) -> MetaDoc a b -> f (MetaDoc c d)\noverDocF f d = (\\x -> d { _doc = x }) <$> f (_doc d)\n\ntype Version = [Int]\ntype Package = String\n\ndata Hyperlink = Hyperlink\n  { hyperlinkUrl   :: String\n  , hyperlinkLabel :: Maybe String\n  } deriving (Eq, Show)\n\ndata Picture = Picture\n  { pictureUri   :: String\n  , pictureTitle :: Maybe String\n  } deriving (Eq, Show)\n\ndata Header id = Header\n  { headerLevel :: Int\n  , headerTitle :: id\n  } deriving (Eq, Show, Functor, Foldable, Traversable)\n\ndata Example = Example\n  { exampleExpression :: String\n  , exampleResult     :: [String]\n  } deriving (Eq, Show)\n\ndata TableCell id = TableCell\n  { tableCellColspan  :: Int\n  , tableCellRowspan  :: Int\n  , tableCellContents :: id\n  } deriving (Eq, Show, Functor, Foldable, Traversable)\n\nnewtype TableRow id = TableRow\n  { tableRowCells :: [TableCell id]\n  } deriving (Eq, Show, Functor, Foldable, Traversable)\n\ndata Table id = Table\n  { tableHeaderRows :: [TableRow id]\n  , tableBodyRows   :: [TableRow id]\n  } deriving (Eq, Show, Functor, Foldable, Traversable)\n\ndata DocH mod id\n  = DocEmpty\n  | DocAppend (DocH mod id) (DocH mod id)\n  | DocString String\n  | DocParagraph (DocH mod id)\n  | DocIdentifier id\n  | DocIdentifierUnchecked mod\n  -- ^ A qualified identifier that couldn't be resolved.\n  | DocModule String\n  | DocWarning (DocH mod id)\n  -- ^ This constructor has no counterpart in Haddock markup.\n  | DocEmphasis (DocH mod id)\n  | DocMonospaced (DocH mod id)\n  | DocBold (DocH mod id)\n  | DocUnorderedList [DocH mod id]\n  | DocOrderedList [DocH mod id]\n  | DocDefList [(DocH mod id, DocH mod id)]\n  | DocCodeBlock (DocH mod id)\n  | DocHyperlink Hyperlink\n  | DocPic Picture\n  | DocMathInline String\n  | DocMathDisplay String\n  | DocAName String\n  -- ^ A (HTML) anchor.\n  | DocProperty String\n  | DocExamples [Example]\n  | DocHeader (Header (DocH mod id))\n  | DocTable (Table (DocH mod id))\n  deriving (Eq, Show, Functor, Foldable, Traversable)\n\n#if MIN_VERSION_base(4,8,0)\ninstance Bifunctor DocH where\n  bimap _ _ DocEmpty = DocEmpty\n  bimap f g (DocAppend docA docB) = DocAppend (bimap f g docA) (bimap f g docB)\n  bimap _ _ (DocString s) = DocString s\n  bimap f g (DocParagraph doc) = DocParagraph (bimap f g doc)\n  bimap _ g (DocIdentifier i) = DocIdentifier (g i)\n  bimap f _ (DocIdentifierUnchecked m) = DocIdentifierUnchecked (f m)\n  bimap _ _ (DocModule s) = DocModule s\n  bimap f g (DocWarning doc) = DocWarning (bimap f g doc)\n  bimap f g (DocEmphasis doc) = DocEmphasis (bimap f g doc)\n  bimap f g (DocMonospaced doc) = DocMonospaced (bimap f g doc)\n  bimap f g (DocBold doc) = DocBold (bimap f g doc)\n  bimap f g (DocUnorderedList docs) = DocUnorderedList (map (bimap f g) docs)\n  bimap f g (DocOrderedList docs) = DocOrderedList (map (bimap f g) docs)\n  bimap f g (DocDefList docs) = DocDefList (map (bimap f g *** bimap f g) docs)\n  bimap f g (DocCodeBlock doc) = DocCodeBlock (bimap f g doc)\n  bimap _ _ (DocHyperlink hyperlink) = DocHyperlink hyperlink\n  bimap _ _ (DocPic picture) = DocPic picture\n  bimap _ _ (DocMathInline s) = DocMathInline s\n  bimap _ _ (DocMathDisplay s) = DocMathDisplay s\n  bimap _ _ (DocAName s) = DocAName s\n  bimap _ _ (DocProperty s) = DocProperty s\n  bimap _ _ (DocExamples examples) = DocExamples examples\n  bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title))\n  bimap f g (DocTable (Table header body)) = DocTable (Table (map (fmap (bimap f g)) header) (map (fmap (bimap f g)) body))\n#endif\n\n#if MIN_VERSION_base(4,10,0)\ninstance Bifoldable DocH where\n  bifoldr f g z (DocAppend docA docB) = bifoldr f g (bifoldr f g z docA) docB\n  bifoldr f g z (DocParagraph doc) = bifoldr f g z doc\n  bifoldr _ g z (DocIdentifier i) = g i z\n  bifoldr f _ z (DocIdentifierUnchecked m) = f m z\n  bifoldr f g z (DocWarning doc) = bifoldr f g z doc\n  bifoldr f g z (DocEmphasis doc) = bifoldr f g z doc\n  bifoldr f g z (DocMonospaced doc) = bifoldr f g z doc\n  bifoldr f g z (DocBold doc) = bifoldr f g z doc\n  bifoldr f g z (DocUnorderedList docs) = foldr (flip (bifoldr f g)) z docs\n  bifoldr f g z (DocOrderedList docs) = foldr (flip (bifoldr f g)) z docs\n  bifoldr f g z (DocDefList docs) = foldr (\\(l, r) acc -> bifoldr f g (bifoldr f g acc l) r) z docs\n  bifoldr f g z (DocCodeBlock doc) = bifoldr f g z doc\n  bifoldr f g z (DocHeader (Header _ title)) = bifoldr f g z title\n  bifoldr f g z (DocTable (Table header body)) = foldr (\\r acc -> foldr (flip (bifoldr f g)) acc r) (foldr (\\r acc -> foldr (flip (bifoldr f g)) acc r) z body) header\n  bifoldr _ _ z _ = z\n\ninstance Bitraversable DocH where\n  bitraverse _ _ DocEmpty = pure DocEmpty\n  bitraverse f g (DocAppend docA docB) = DocAppend <$> bitraverse f g docA <*> bitraverse f g docB\n  bitraverse _ _ (DocString s) = pure (DocString s)\n  bitraverse f g (DocParagraph doc) = DocParagraph <$> bitraverse f g doc\n  bitraverse _ g (DocIdentifier i) = DocIdentifier <$> g i\n  bitraverse f _ (DocIdentifierUnchecked m) = DocIdentifierUnchecked <$> f m\n  bitraverse _ _ (DocModule s) = pure (DocModule s)\n  bitraverse f g (DocWarning doc) = DocWarning <$> bitraverse f g doc\n  bitraverse f g (DocEmphasis doc) = DocEmphasis <$> bitraverse f g doc\n  bitraverse f g (DocMonospaced doc) = DocMonospaced <$> bitraverse f g doc\n  bitraverse f g (DocBold doc) = DocBold <$> bitraverse f g doc\n  bitraverse f g (DocUnorderedList docs) = DocUnorderedList <$> traverse (bitraverse f g) docs\n  bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverse (bitraverse f g) docs\n  bitraverse f g (DocDefList docs) = DocDefList <$> traverse (bitraverse (bitraverse f g) (bitraverse f g)) docs\n  bitraverse f g (DocCodeBlock doc) = DocCodeBlock <$> bitraverse f g doc\n  bitraverse _ _ (DocHyperlink hyperlink) = pure (DocHyperlink hyperlink)\n  bitraverse _ _ (DocPic picture) = pure (DocPic picture)\n  bitraverse _ _ (DocMathInline s) = pure (DocMathInline s)\n  bitraverse _ _ (DocMathDisplay s) = pure (DocMathDisplay s)\n  bitraverse _ _ (DocAName s) = pure (DocAName s)\n  bitraverse _ _ (DocProperty s) = pure (DocProperty s)\n  bitraverse _ _ (DocExamples examples) = pure (DocExamples examples)\n  bitraverse f g (DocHeader (Header level title)) = (DocHeader . Header level) <$> bitraverse f g title\n  bitraverse f g (DocTable (Table header body)) = (\\h b -> DocTable (Table h b)) <$> traverse (traverse (bitraverse f g)) header <*> traverse (traverse (bitraverse f g)) body\n#endif\n\n-- | 'DocMarkupH' is a set of instructions for marking up documentation.\n-- In fact, it's really just a mapping from 'Doc' to some other\n-- type [a], where [a] is usually the type of the output (HTML, say).\n-- Use 'Documentation.Haddock.Markup.markup' to apply a 'DocMarkupH' to\n-- a 'DocH'.\n--\n-- @since 1.4.5\n--\ndata DocMarkupH mod id a = Markup\n  { markupEmpty                :: a\n  , markupString               :: String -> a\n  , markupParagraph            :: a -> a\n  , markupAppend               :: a -> a -> a\n  , markupIdentifier           :: id -> a\n  , markupIdentifierUnchecked  :: mod -> a\n  , markupModule               :: String -> a\n  , markupWarning              :: a -> a\n  , markupEmphasis             :: a -> a\n  , markupBold                 :: a -> a\n  , markupMonospaced           :: a -> a\n  , markupUnorderedList        :: [a] -> a\n  , markupOrderedList          :: [a] -> a\n  , markupDefList              :: [(a,a)] -> a\n  , markupCodeBlock            :: a -> a\n  , markupHyperlink            :: Hyperlink -> a\n  , markupAName                :: String -> a\n  , markupPic                  :: Picture -> a\n  , markupMathInline           :: String -> a\n  , markupMathDisplay          :: String -> a\n  , markupProperty             :: String -> a\n  , markupExample              :: [Example] -> a\n  , markupHeader               :: Header a -> a\n  , markupTable                :: Table a -> a\n  }\n", "num_lines": 240}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Documentation.Haddock.Utf8 (encodeUtf8, decodeUtf8) where\nimport           Data.Bits ((.|.), (.&.), shiftL, shiftR)\nimport qualified Data.ByteString as BS\nimport           Data.Char (chr, ord)\nimport           Data.Word (Word8)\n\n-- | Helper that encodes and packs a 'String' into a 'BS.ByteString'\nencodeUtf8 :: String -> BS.ByteString\nencodeUtf8 = BS.pack . encode\n\n-- | Helper that unpacks and decodes a 'BS.ByteString' into a 'String'\ndecodeUtf8 :: BS.ByteString -> String\ndecodeUtf8 = decode . BS.unpack\n\n-- Copy/pasted functions from Codec.Binary.UTF8.String for encoding/decoding\n-- | Character to use when 'encode' or 'decode' fail for a byte.\nreplacementCharacter :: Char\nreplacementCharacter = '\\xfffd'\n\n-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.\nencode :: String -> [Word8]\nencode = concatMap (map fromIntegral . go . ord)\n where\n  go oc\n   | oc <= 0x7f       = [oc]\n\n   | oc <= 0x7ff      = [ 0xc0 + (oc `shiftR` 6)\n                        , 0x80 + oc .&. 0x3f\n                        ]\n\n   | oc <= 0xffff     = [ 0xe0 + (oc `shiftR` 12)\n                        , 0x80 + ((oc `shiftR` 6) .&. 0x3f)\n                        , 0x80 + oc .&. 0x3f\n                        ]\n   | otherwise        = [ 0xf0 + (oc `shiftR` 18)\n                        , 0x80 + ((oc `shiftR` 12) .&. 0x3f)\n                        , 0x80 + ((oc `shiftR` 6) .&. 0x3f)\n                        , 0x80 + oc .&. 0x3f\n                        ]\n\n-- | Decode a UTF8 string packed into a list of Word8 values, directly to String\ndecode :: [Word8] -> String\ndecode [    ] = \"\"\ndecode (c:cs)\n  | c < 0x80  = chr (fromEnum c) : decode cs\n  | c < 0xc0  = replacementCharacter : decode cs\n  | c < 0xe0  = multi1\n  | c < 0xf0  = multi_byte 2 0xf  0x800\n  | c < 0xf8  = multi_byte 3 0x7  0x10000\n  | c < 0xfc  = multi_byte 4 0x3  0x200000\n  | c < 0xfe  = multi_byte 5 0x1  0x4000000\n  | otherwise = replacementCharacter : decode cs\n  where\n    multi1 = case cs of\n      c1 : ds | c1 .&. 0xc0 == 0x80 ->\n        let d = ((fromEnum c .&. 0x1f) `shiftL` 6) .|.  fromEnum (c1 .&. 0x3f)\n        in if d >= 0x000080 then toEnum d : decode ds\n                            else replacementCharacter : decode ds\n      _ -> replacementCharacter : decode cs\n\n    multi_byte :: Int -> Word8 -> Int -> String\n    multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))\n      where\n        aux 0 rs acc\n          | overlong <= acc && acc <= 0x10ffff &&\n            (acc < 0xd800 || 0xdfff < acc)     &&\n            (acc < 0xfffe || 0xffff < acc)      = chr acc : decode rs\n          | otherwise = replacementCharacter : decode rs\n\n        aux n (r:rs) acc\n          | r .&. 0xc0 == 0x80 = aux (n-1) rs\n                               $ shiftL acc 6 .|. fromEnum (r .&. 0x3f)\n\n        aux _ rs     _ = replacementCharacter : decode rs\n", "num_lines": 75}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n\nmodule Documentation.Haddock.Parser.Monad where\n\nimport qualified Text.Parsec.Char as Parsec\nimport qualified Text.Parsec as Parsec\n\nimport qualified Data.Text as T\nimport           Data.Text                   ( Text )\n\nimport           Data.String                 ( IsString(..) )\nimport           Data.Bits                   ( Bits(..) )\nimport           Data.Char                   ( ord )\nimport           Data.List                   ( foldl' )\n\nimport           Documentation.Haddock.Types ( Version )\n\nnewtype ParserState = ParserState {\n  parserStateSince :: Maybe Version\n} deriving (Eq, Show)\n\ninitialParserState :: ParserState\ninitialParserState = ParserState Nothing\n\nsetSince :: Version -> Parser ()\nsetSince since = Parsec.modifyState (\\st -> st {parserStateSince = Just since})\n\ntype Parser = Parsec.Parsec Text ParserState\n\ninstance (a ~ Text) => IsString (Parser a) where\n  fromString = fmap T.pack . Parsec.string\n\nparseOnly :: Parser a -> Text -> Either String (ParserState, a)\nparseOnly p t = case Parsec.runParser p' initialParserState \"<haddock>\" t of\n                  Left e -> Left (show e)\n                  Right (x,s) -> Right (s,x)\n  where p' = (,) <$> p <*> Parsec.getState\n\n-- | Always succeeds, but returns 'Nothing' if at the end of input. Does not\n-- consume input.\npeekChar :: Parser (Maybe Char)\npeekChar = Parsec.optionMaybe . Parsec.try . Parsec.lookAhead $ Parsec.anyChar\n\n-- | Fails if at the end of input. Does not consume input.\npeekChar' :: Parser Char\npeekChar' = Parsec.lookAhead Parsec.anyChar \n\n-- | Parses the given string. Returns the parsed string.\nstring :: Text -> Parser Text\nstring t = Parsec.string (T.unpack t) *> pure t\n\n-- | Scan the input text, accumulating characters as long as the scanning\n-- function returns true.\nscan :: (s -> Char -> Maybe s) -- ^ scan function\n     -> s                      -- ^ initial state\n     -> Parser Text \nscan f = fmap T.pack . go\n  where go s1 = do { cOpt <- peekChar\n                   ; case cOpt >>= f s1 of\n                       Nothing -> pure \"\"\n                       Just s2 -> (:) <$> Parsec.anyChar <*> go s2\n                   }\n\n-- | Apply a parser for a character zero or more times and collect the result in\n-- a string.\ntakeWhile :: Parser Char -> Parser Text\ntakeWhile = fmap T.pack . Parsec.many\n\n-- | Apply a parser for a character one or more times and collect the result in\n-- a string.\ntakeWhile1 :: Parser Char -> Parser Text\ntakeWhile1 =  fmap T.pack . Parsec.many1\n\n-- | Parse a decimal number.\ndecimal :: Integral a => Parser a\ndecimal = foldl' step 0 `fmap` Parsec.many1 Parsec.digit\n  where step a c = a * 10 + fromIntegral (ord c - 48)\n\n-- | Parse a hexadecimal number.\nhexadecimal :: (Integral a, Bits a) => Parser a\nhexadecimal = foldl' step 0 `fmap` Parsec.many1 Parsec.hexDigit \n  where\n  step a c | w >= 48 && w <= 57  = (a `shiftL` 4) .|. fromIntegral (w - 48)\n           | w >= 97             = (a `shiftL` 4) .|. fromIntegral (w - 87)\n           | otherwise           = (a `shiftL` 4) .|. fromIntegral (w - 55)\n    where w = ord c\n", "num_lines": 92}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\n-- |\n-- Module      :  Documentation.Haddock.Parser.Util\n-- Copyright   :  (c) Mateusz Kowalczyk 2013-2014,\n--                    Simon Hengel      2013\n-- License     :  BSD-like\n--\n-- Maintainer  :  haddock@projects.haskell.org\n-- Stability   :  experimental\n-- Portability :  portable\n--\n-- Various utility functions used by the parser.\nmodule Documentation.Haddock.Parser.Util (\n  takeUntil,\n  removeEscapes,\n  makeLabeled,\n  takeHorizontalSpace,\n  skipHorizontalSpace,\n) where\n\nimport qualified Text.Parsec as Parsec\n\nimport qualified Data.Text as T\nimport           Data.Text (Text)\n\nimport           Control.Applicative\nimport           Control.Monad (mfilter)\nimport           Documentation.Haddock.Parser.Monad\nimport           Prelude hiding (takeWhile)\n\nimport           Data.Char (isSpace)\n\n-- | Characters that count as horizontal space\nhorizontalSpace :: [Char]\nhorizontalSpace = \" \\t\\f\\v\\r\"\n\n-- | Skip and ignore leading horizontal space\nskipHorizontalSpace :: Parser ()\nskipHorizontalSpace = Parsec.skipMany (Parsec.oneOf horizontalSpace)\n\n-- | Take leading horizontal space\ntakeHorizontalSpace :: Parser Text \ntakeHorizontalSpace = takeWhile (Parsec.oneOf horizontalSpace)\n\nmakeLabeled :: (String -> Maybe String -> a) -> Text -> a\nmakeLabeled f input = case T.break isSpace $ removeEscapes $ T.strip input of\n  (uri, \"\")    -> f (T.unpack uri) Nothing\n  (uri, label) -> f (T.unpack uri) (Just . T.unpack $ T.stripStart label)\n\n-- | Remove escapes from given string.\n--\n-- Only do this if you do not process (read: parse) the input any further.\nremoveEscapes :: Text -> Text\nremoveEscapes = T.unfoldr go\n  where\n  go :: Text -> Maybe (Char, Text)\n  go xs = case T.uncons xs of\n            Just ('\\\\',ys) -> T.uncons ys\n            unconsed -> unconsed\n\n-- | Consume characters from the input up to and including the given pattern.\n-- Return everything consumed except for the end pattern itself.\ntakeUntil :: Text -> Parser Text \ntakeUntil end_ = T.dropEnd (T.length end_) <$> requireEnd (scan p (False, end)) >>= gotSome\n  where\n    end = T.unpack end_ \n\n    p :: (Bool, String) -> Char -> Maybe (Bool, String)\n    p acc c = case acc of\n      (True, _) -> Just (False, end)\n      (_, []) -> Nothing\n      (_, x:xs) | x == c -> Just (False, xs)\n      _ -> Just (c == '\\\\', end)\n\n    requireEnd = mfilter (T.isSuffixOf end_)\n\n    gotSome xs\n      | T.null xs = fail \"didn't get any content\"\n      | otherwise = return xs\n", "num_lines": 80}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -F -pgmF hspec-discover #-}\n", "num_lines": 2}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Documentation.Haddock.Utf8Spec (main, spec) where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Documentation.Haddock.Utf8\n\nmain :: IO ()\nmain = hspec spec\n\nspec :: Spec\nspec = do\n  describe \"decodeUtf8\" $ do\n    it \"is inverse to encodeUtf8\" $ do\n      property $ \\xs -> (decodeUtf8 . encodeUtf8) xs `shouldBe` xs\n", "num_lines": 15}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings #-}\nmodule Documentation.Haddock.Parser.UtilSpec (main, spec) where\n\nimport Documentation.Haddock.Parser.Monad\nimport Documentation.Haddock.Parser.Util\nimport Data.Either.Compat (isLeft)\nimport Test.Hspec\nimport Control.Applicative\n\nmain :: IO ()\nmain = hspec spec\n\nspec :: Spec\nspec = do\n  describe \"takeUntil\" $ do\n    it \"takes everything until a specified byte sequence\" $ do\n      snd <$> parseOnly (takeUntil \"end\") \"someend\" `shouldBe` Right \"some\"\n\n    it \"requires the end sequence\" $ do\n      snd <$> parseOnly (takeUntil \"end\") \"someen\" `shouldSatisfy` isLeft\n\n    it \"takes escaped bytes unconditionally\" $ do\n      snd <$> parseOnly (takeUntil \"end\") \"some\\\\endend\" `shouldBe` Right \"some\\\\end\"\n", "num_lines": 24}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env runhaskell\n> import Distribution.Simple\n> main = defaultMain\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\n\nmodule Test.Haddock\n    ( module Test.Haddock.Config\n    , runAndCheck, runHaddock, checkFiles\n    ) where\n\n\nimport Control.Monad\n\nimport Data.Maybe\n\nimport System.Directory\nimport System.Exit\nimport System.FilePath\nimport System.IO\nimport System.Process\nimport qualified Data.ByteString.Char8 as BS\n\nimport Test.Haddock.Config\nimport Test.Haddock.Process\nimport Test.Haddock.Utils\n\n\ndata CheckResult\n    = Fail\n    | Pass\n    | NoRef\n    | Error String\n    | Accepted\n    deriving Eq\n\n\nrunAndCheck :: Config c -> IO ()\nrunAndCheck cfg = do\n    runHaddock cfg\n    checkFiles cfg\n\n\ncheckFiles :: Config c -> IO ()\ncheckFiles cfg@(Config { .. }) = do\n    putStrLn \"Testing output files...\"\n\n    files <- ignore <$> getDirectoryTree (cfgOutDir cfg)\n    failed <- liftM catMaybes . forM files $ \\file -> do\n        putStr $ \"Checking \\\"\" ++ file ++ \"\\\"... \"\n\n        status <- maybeAcceptFile cfg file =<< checkFile cfg file\n        case status of\n            Fail -> putStrLn \"FAIL\" >> (return $ Just file)\n            Pass -> putStrLn \"PASS\" >> (return Nothing)\n            NoRef -> putStrLn \"PASS [no .ref]\" >> (return Nothing)\n            Error msg -> putStrLn (\"ERROR (\" ++ msg ++ \")\") >> return Nothing\n            Accepted -> putStrLn \"ACCEPTED\" >> return Nothing\n\n    if null failed\n        then do\n            putStrLn \"All tests passed!\"\n            exitSuccess\n        else do\n            maybeDiff cfg failed\n            exitFailure\n  where\n    ignore = filter (not . dcfgCheckIgnore cfgDirConfig)\n\n\nmaybeDiff :: Config c -> [FilePath] -> IO ()\nmaybeDiff (Config { cfgDiffTool = Nothing }) _ = pure ()\nmaybeDiff cfg@(Config { cfgDiffTool = (Just diff) }) files = do\n    putStrLn \"Diffing failed cases...\"\n    forM_ files $ diffFile cfg diff\n\n\nrunHaddock :: Config c -> IO ()\nrunHaddock cfg@(Config { .. }) = do\n    createEmptyDirectory $ cfgOutDir cfg\n\n    putStrLn \"Generating documentation...\"\n    forM_ cfgPackages $ \\tpkg -> do\n        haddockStdOut <- openFile cfgHaddockStdOut WriteMode\n        let pc = processConfig\n                    { pcArgs = concat\n                        [ cfgHaddockArgs\n                        , pure $ \"--odir=\" ++ outDir cfgDirConfig tpkg\n                        , tpkgFiles tpkg\n                        ]\n                    , pcEnv = Just $ cfgEnv\n                    , pcStdOut = Just $ haddockStdOut\n                    }\n        handle <- runProcess' cfgHaddockPath pc\n        waitForSuccess \"Failed to run Haddock on specified test files\" handle\n\n\ncheckFile :: Config c -> FilePath -> IO CheckResult\ncheckFile cfg file = do\n    hasRef <- doesFileExist $ refFile dcfg file\n    if hasRef\n        then do\n            mout <- readOut cfg file\n            mref <- readRef cfg file\n            return $ case (mout, mref) of\n                (Just out, Just ref)\n                    | ccfgEqual ccfg out ref -> Pass\n                    | otherwise -> Fail\n                _ -> Error \"Failed to parse input files\"\n        else return NoRef\n  where\n    ccfg = cfgCheckConfig cfg\n    dcfg = cfgDirConfig cfg\n\n-- We use ByteString here to ensure that no lazy I/O is performed.\n-- This way to ensure that the reference file isn't held open in\n-- case after `diffFile` (which is problematic if we need to rewrite\n-- the reference file in `maybeAcceptFile`)\n\n-- | Read the reference artifact for a test\nreadRef :: Config c -> FilePath -> IO (Maybe c)\nreadRef cfg file =\n    ccfgRead ccfg . BS.unpack\n    <$> BS.readFile (refFile dcfg file)\n  where\n    ccfg = cfgCheckConfig cfg\n    dcfg = cfgDirConfig cfg\n\n-- | Read (and clean) the test output artifact for a test\nreadOut :: Config c -> FilePath -> IO (Maybe c)\nreadOut cfg file =\n    fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack\n    <$> BS.readFile (outFile dcfg file)\n  where\n    ccfg = cfgCheckConfig cfg\n    dcfg = cfgDirConfig cfg\n\n\ndiffFile :: Config c -> FilePath -> FilePath -> IO ()\ndiffFile cfg diff file = do\n    Just out <- readOut cfg file\n    Just ref <- readRef cfg file\n    writeFile outFile' $ ccfgDump ccfg out\n    writeFile refFile' $ ccfgDump ccfg ref\n\n    putStrLn $ \"Diff for file \\\"\" ++ file ++ \"\\\":\"\n    hFlush stdout\n    handle <- runProcess' diff $ processConfig\n        { pcArgs = [outFile', refFile']\n        , pcStdOut = Just $ stdout\n        }\n    waitForProcess handle >> return ()\n  where\n    dcfg = cfgDirConfig cfg\n    ccfg = cfgCheckConfig cfg\n    outFile' = outFile dcfg file <.> \"dump\"\n    refFile' = outFile dcfg file <.> \"ref\" <.> \"dump\"\n\n\nmaybeAcceptFile :: Config c -> FilePath -> CheckResult -> IO CheckResult\nmaybeAcceptFile cfg file result\n    | cfgAccept cfg && result `elem` [NoRef, Fail] = do\n        Just out <- readOut cfg file\n        writeFile (refFile dcfg file) $ ccfgDump ccfg out\n        pure Accepted\n  where\n    dcfg = cfgDirConfig cfg\n    ccfg = cfgCheckConfig cfg\nmaybeAcceptFile _ _ result = pure result\n\n\noutDir :: DirConfig -> TestPackage -> FilePath\noutDir dcfg tpkg = dcfgOutDir dcfg </> tpkgName tpkg\n\n\noutFile :: DirConfig -> FilePath -> FilePath\noutFile dcfg file = dcfgOutDir dcfg </> file\n\n\nrefFile :: DirConfig -> FilePath -> FilePath\nrefFile dcfg file = dcfgRefDir dcfg </> file\n", "num_lines": 179}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE CPP #-}\n\nmodule Test.Haddock.Config\n    ( TestPackage(..), CheckConfig(..), DirConfig(..), Config(..)\n    , defaultDirConfig\n    , cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir\n    , parseArgs, checkOpt, loadConfig\n    ) where\n\n\nimport Control.Applicative\nimport Control.Monad\n\nimport qualified Data.List as List\nimport Data.Maybe\n\nimport Distribution.InstalledPackageInfo\nimport Distribution.Package\nimport Distribution.Simple.Compiler hiding (Flag)\nimport Distribution.Simple.GHC\nimport Distribution.Simple.PackageIndex\nimport Distribution.Simple.Program\nimport Distribution.Simple.Utils\nimport Distribution.Verbosity\n\nimport System.Console.GetOpt\nimport System.Directory\nimport System.Exit\nimport System.Environment\nimport System.FilePath\nimport System.IO\n\nimport Test.Haddock.Process\nimport Test.Haddock.Utils\n\n\ndata TestPackage = TestPackage\n    { tpkgName :: String\n    , tpkgFiles :: [FilePath]\n    }\n\n\ndata CheckConfig c = CheckConfig\n    { ccfgRead :: String -> Maybe c\n      -- ^ @f contents@ parses file contents @contents@ to\n      -- produce a thing to be compared.\n    , ccfgClean :: String -> c -> c\n      -- ^ @f fname x@ cleans @x@ to such that it can be compared\n    , ccfgDump :: c -> String\n    , ccfgEqual :: c -> c -> Bool\n    }\n\n\ndata DirConfig = DirConfig\n    { dcfgSrcDir :: FilePath\n    , dcfgRefDir :: FilePath\n    , dcfgOutDir :: FilePath\n    , dcfgResDir :: FilePath\n    , dcfgCheckIgnore :: FilePath -> Bool\n    }\n\n\ndefaultDirConfig :: FilePath -> DirConfig\ndefaultDirConfig baseDir = DirConfig\n    { dcfgSrcDir = baseDir </> \"src\"\n    , dcfgRefDir = baseDir </> \"ref\"\n    , dcfgOutDir = baseDir </> \"out\"\n    , dcfgResDir = rootDir </> \"resources\"\n    , dcfgCheckIgnore = const False\n    }\n  where\n    rootDir = baseDir </> \"..\"\n\n\ndata Config c = Config\n    { cfgHaddockPath :: FilePath\n    , cfgPackages :: [TestPackage]\n    , cfgHaddockArgs :: [String]\n    , cfgHaddockStdOut :: FilePath\n    , cfgDiffTool :: Maybe FilePath\n    , cfgEnv :: Environment\n    , cfgAccept :: Bool\n    , cfgCheckConfig :: CheckConfig c\n    , cfgDirConfig :: DirConfig\n    }\n\n\ncfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir :: Config c -> FilePath\ncfgSrcDir = dcfgSrcDir . cfgDirConfig\ncfgRefDir = dcfgRefDir . cfgDirConfig\ncfgOutDir = dcfgOutDir . cfgDirConfig\ncfgResDir = dcfgResDir . cfgDirConfig\n\n\n\ndata Flag\n    = FlagHaddockPath FilePath\n    | FlagHaddockOptions String\n    | FlagHaddockStdOut FilePath\n    | FlagGhcPath FilePath\n    | FlagDiffTool FilePath\n    | FlagNoDiff\n    | FlagAccept\n    | FlagHelp\n    deriving Eq\n\n\nflagsHaddockPath :: [Flag] -> Maybe FilePath\nflagsHaddockPath flags = mlast [ path | FlagHaddockPath path <- flags ]\n\nflagsGhcPath :: [Flag] -> Maybe FilePath\nflagsGhcPath flags = mlast [ path | FlagGhcPath path <- flags ]\n\nflagsHaddockOptions :: [Flag] -> [String]\nflagsHaddockOptions flags = concat\n    [ words opts | FlagHaddockOptions opts <- flags ]\n\n\nflagsHaddockStdOut :: [Flag] -> Maybe FilePath\nflagsHaddockStdOut flags = mlast [ path | FlagHaddockStdOut path <- flags ]\n\n\nflagsDiffTool :: [Flag] -> Maybe FilePath\nflagsDiffTool flags = mlast [ path | FlagDiffTool path <- flags ]\n\n\noptions :: [OptDescr Flag]\noptions =\n    [ Option [] [\"haddock-path\"] (ReqArg FlagHaddockPath \"FILE\")\n        \"path to Haddock executable to exectue tests with\"\n    , Option [] [\"haddock-options\"] (ReqArg FlagHaddockOptions \"OPTS\")\n        \"additional options to run Haddock with\"\n    , Option [] [\"haddock-stdout\"] (ReqArg FlagHaddockStdOut \"FILE\")\n        \"where to redirect Haddock output\"\n    , Option [] [\"ghc-path\"] (ReqArg FlagGhcPath \"FILE\")\n        \"path ghc executable\"\n    , Option [] [\"diff-tool\"] (ReqArg FlagDiffTool \"PATH\")\n        \"diff tool to use when printing failed cases\"\n    , Option ['a'] [\"accept\"] (NoArg FlagAccept)\n        \"accept generated output\"\n    , Option [] [\"no-diff\"] (NoArg FlagNoDiff)\n        \"do not print diff for failed cases\"\n    , Option ['h'] [\"help\"] (NoArg FlagHelp)\n        \"display this help end exit\"\n    ]\n\n\nparseArgs :: CheckConfig c -> DirConfig -> [String] -> IO (Config c)\nparseArgs ccfg dcfg args = uncurry (loadConfig ccfg dcfg) =<< checkOpt args\n\n\ncheckOpt :: [String] -> IO ([Flag], [String])\ncheckOpt args = do\n    let (flags, files, errors) = getOpt Permute options args\n\n    unless (null errors) $ do\n        hPutStr stderr $ concat errors\n        exitFailure\n\n    when (FlagHelp `elem` flags) $ do\n        hPutStrLn stderr $ usageInfo \"\" options\n        exitSuccess\n\n    return (flags, files)\n\n\nloadConfig :: CheckConfig c -> DirConfig -> [Flag] -> [String] -> IO (Config c)\nloadConfig ccfg dcfg flags files = do\n    cfgEnv <- (:) (\"haddock_datadir\", dcfgResDir dcfg) <$> getEnvironment\n\n    systemHaddockPath <- List.lookup \"HADDOCK_PATH\" <$> getEnvironment\n    haddockOnPath <- findExecutable \"haddock\"\n\n    let haddock_path = msum [ flagsHaddockPath flags\n                            , systemHaddockPath\n                            , haddockOnPath\n                            ]\n\n    cfgHaddockPath <- case haddock_path of\n        Just path -> pure path\n        Nothing   -> do\n          hPutStrLn stderr \"Haddock executable not found\"\n          exitFailure\n\n    ghcPath <- case flagsGhcPath flags of\n                 Just fp -> return fp\n                 Nothing -> init <$> rawSystemStdout normal\n                                                     cfgHaddockPath\n                                                     [\"--print-ghc-path\"]\n\n    printVersions cfgEnv cfgHaddockPath\n\n    cfgPackages <- processFileArgs dcfg files\n\n    cfgHaddockArgs <- liftM concat . sequence $\n        [ pure [\"--no-warnings\"]\n        , pure [\"--odir=\" ++ dcfgOutDir dcfg]\n        , pure [\"--optghc=-w\"]\n        , pure [\"--optghc=-hide-all-packages\"]\n        , pure $ flagsHaddockOptions flags\n        , baseDependencies ghcPath\n        ]\n\n    let cfgHaddockStdOut = fromMaybe defaultStdOut (flagsHaddockStdOut flags)\n\n    cfgDiffTool <- if FlagNoDiff `elem` flags\n        then pure Nothing\n        else (<|>) <$> pure (flagsDiffTool flags) <*> defaultDiffTool\n\n    let cfgAccept = FlagAccept `elem` flags\n\n    let cfgCheckConfig = ccfg\n    let cfgDirConfig   = dcfg\n\n    return $ Config { .. }\n\n\nprintVersions :: Environment -> FilePath -> IO ()\nprintVersions env haddockPath = do\n    handleHaddock <- runProcess' haddockPath $ processConfig\n        { pcEnv = Just env\n        , pcArgs = [\"--version\"]\n        }\n    waitForSuccess \"Failed to run `haddock --version`\" handleHaddock\n\n    handleGhc <- runProcess' haddockPath $ processConfig\n        { pcEnv = Just env\n        , pcArgs = [\"--ghc-version\"]\n        }\n    waitForSuccess \"Failed to run `haddock --ghc-version`\" handleGhc\n\n\nbaseDependencies :: FilePath -> IO [String]\nbaseDependencies ghcPath = do\n    -- The 'getInstalledPackages' crashes if used when \"GHC_PACKAGE_PATH\" is\n    -- set to some value. I am not sure why is that happening and what are the\n    -- consequences of unsetting it - but looks like it works (for now).\n    unsetEnv \"GHC_PACKAGE_PATH\"\n\n    (comp, _, cfg) <- configure normal (Just ghcPath) Nothing\n        defaultProgramConfiguration\n#if MIN_VERSION_Cabal(1,23,0)\n    pkgIndex <- getInstalledPackages normal comp [GlobalPackageDB] cfg\n#else\n    pkgIndex <- getInstalledPackages normal [GlobalPackageDB] cfg\n#endif\n    let\n      pkgs =\n        [ \"array\"\n        , \"base\"\n        , \"ghc-prim\"\n        , \"process\"\n        , \"template-haskell\"\n        ]\n    concat `fmap` mapM (getDependency pkgIndex) pkgs\n  where\n    getDependency pkgIndex name = case ifaces pkgIndex name of\n        [] -> do\n            hPutStrLn stderr $ \"Couldn't find base test dependency: \" ++ name\n            exitFailure\n        (ifArg:_) -> pure [\"--optghc=-package\" ++ name, ifArg]\n    ifaces pkgIndex name = do\n        pkg <- join $ snd <$> lookupPackageName pkgIndex (mkPackageName name)\n        iface <$> haddockInterfaces pkg <*> haddockHTMLs pkg\n    iface file html = \"--read-interface=\" ++ html ++ \",\" ++ file\n\n\ndefaultDiffTool :: IO (Maybe FilePath)\ndefaultDiffTool =\n    liftM listToMaybe . filterM isAvailable $ [\"colordiff\", \"diff\"]\n  where\n    isAvailable = liftM isJust . findProgramLocation silent\n\n\ndefaultStdOut :: FilePath\n#ifdef mingw32_HOST_OS\ndefaultStdOut = \"nul\"\n#else\ndefaultStdOut = \"/dev/null\"\n#endif\n\n\nprocessFileArgs :: DirConfig -> [String] -> IO [TestPackage]\nprocessFileArgs dcfg [] =\n    processFileArgs' dcfg . filter isValidEntry =<< getDirectoryContents srcDir\n  where\n    isValidEntry entry\n        | hasExtension entry = isSourceFile entry\n        | otherwise = isRealDir entry\n    srcDir = dcfgSrcDir dcfg\nprocessFileArgs dcfg args = processFileArgs' dcfg args\n\n\nprocessFileArgs' :: DirConfig -> [String] -> IO [TestPackage]\nprocessFileArgs' dcfg args = do\n    (dirs, mdls) <- partitionM doesDirectoryExist' . map takeBaseName $ args\n    rootPkg <- pure $ TestPackage\n        { tpkgName = \"\"\n        , tpkgFiles = map (srcDir </>) mdls\n        }\n    otherPkgs <- forM dirs $ \\dir -> do\n        let srcDir' = srcDir </> dir\n        files <- filterM (isModule dir) =<< getDirectoryContents srcDir'\n        pure $ TestPackage\n            { tpkgName = dir\n            , tpkgFiles = map (srcDir' </>) files\n            }\n    pure . filter (not . null . tpkgFiles) $ rootPkg:otherPkgs\n  where\n    doesDirectoryExist' path = doesDirectoryExist (srcDir </> path)\n    isModule dir file = (isSourceFile file &&) <$>\n        doesFileExist (srcDir </> dir </> file)\n    srcDir = dcfgSrcDir dcfg\n\n\nisSourceFile :: FilePath -> Bool\nisSourceFile file = takeExtension file `elem` [\".hs\", \".lhs\"]\n\n\nisRealDir :: FilePath -> Bool\nisRealDir dir = not $ dir `elem` [\".\", \"..\"]\n", "num_lines": 323}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n\n\nmodule Test.Haddock.Process where\n\n\nimport Control.Monad\n\nimport System.Exit\nimport System.IO\nimport System.Process\n\n\ntype Environment = [(String, String)]\n\n\ndata ProcessConfig = ProcessConfig\n    { pcArgs :: [String]\n    , pcWorkDir :: Maybe FilePath\n    , pcEnv :: Maybe Environment\n    , pcStdIn :: Maybe Handle\n    , pcStdOut :: Maybe Handle\n    , pcStdErr :: Maybe Handle\n    }\n    deriving (Show)\n\n\nprocessConfig :: ProcessConfig\nprocessConfig = ProcessConfig\n    { pcArgs = []\n    , pcWorkDir = Nothing\n    , pcEnv = Nothing\n    , pcStdIn = Nothing\n    , pcStdOut = Nothing\n    , pcStdErr = Nothing\n    }\n\n\nrunProcess' :: FilePath -> ProcessConfig -> IO ProcessHandle\nrunProcess' path (ProcessConfig { .. }) = runProcess\n    path pcArgs pcWorkDir pcEnv pcStdIn pcStdOut pcStdErr\n\n\nwaitForSuccess :: String -> ProcessHandle -> IO ()\nwaitForSuccess msg handle = do\n    result <- waitForProcess handle\n    unless (result == ExitSuccess) $ do\n        hPutStrLn stderr $ msg\n        exitFailure\n", "num_lines": 50}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Test.Haddock.Utils where\n\n\nimport Control.Monad\n\nimport Data.Maybe\n\nimport System.Directory\nimport System.FilePath\n\n\nmlast :: [a] -> Maybe a\nmlast = listToMaybe . reverse\n\n\npartitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])\npartitionM _ [] = pure ([], [])\npartitionM p (x:xs) = do\n    (ss, fs) <- partitionM p xs\n    b <- p x\n    pure $ if b then (x:ss, fs) else (ss, x:fs)\n\n\nwhenM :: Monad m => m Bool -> m () -> m ()\nwhenM mb action = mb >>= \\b -> when b action\n\n\ngetDirectoryTree :: FilePath -> IO [FilePath]\ngetDirectoryTree path = do\n    (dirs, files) <- partitionM isDirectory =<< contents\n    subfiles <- fmap concat . forM dirs $ \\dir ->\n        map (dir </>) <$> getDirectoryTree (path </> dir)\n    pure $ files ++ subfiles\n  where\n    contents = filter realEntry <$> getDirectoryContents path\n    isDirectory entry = doesDirectoryExist $ path </> entry\n    realEntry entry = not $ entry == \".\" || entry == \"..\"\n\n\ncreateEmptyDirectory :: FilePath -> IO ()\ncreateEmptyDirectory path = do\n    whenM (doesDirectoryExist path) $ removeDirectoryRecursive path\n    createDirectory path\n\n\n-- | Just like 'copyFile' but output directory path is not required to exist.\ncopyFile' :: FilePath -> FilePath -> IO ()\ncopyFile' old new = do\n    createDirectoryIfMissing True $ takeDirectory new\n    copyFile old new\n\n\ncrlfToLf :: String -> String\ncrlfToLf \"\" = \"\"\ncrlfToLf ('\\r' : '\\n' : rest) = '\\n' : crlfToLf rest\ncrlfToLf ('\\r' : rest)  = '\\n' : crlfToLf rest\ncrlfToLf (other : rest) = other : crlfToLf rest\n", "num_lines": 58}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE StandaloneDeriving #-}\n\n\nmodule Test.Haddock.Xhtml\n    ( Xml(..)\n    , parseXml, dumpXml\n    , stripLinks, stripLinksWhen, stripAnchorsWhen, stripFooter\n    ) where\n\n\nimport Data.Generics.Aliases\nimport Data.Generics.Schemes\n\nimport Text.XML.Light\nimport Text.XHtml (Html, HtmlAttr, (!))\nimport qualified Text.XHtml as Xhtml\n\n\nnewtype Xml = Xml\n    { xmlElement :: Element\n    } deriving Eq\n\n\n-- TODO: Find a way to avoid warning about orphan instances.\nderiving instance Eq Element\nderiving instance Eq Content\nderiving instance Eq CData\n\n\nparseXml :: String -> Maybe Xml\nparseXml = fmap Xml . parseXMLDoc\n\n\ndumpXml :: Xml -> String\ndumpXml = Xhtml.renderHtmlFragment. xmlElementToXhtml . xmlElement\n\n\nstripLinks :: Xml -> Xml\nstripLinks = stripLinksWhen (const True)\n\n\nstripLinksWhen :: (String -> Bool) -> Xml -> Xml\nstripLinksWhen p =\n    processAnchors unlink\n  where\n    unlink attr@(Attr { attrKey = key, attrVal = val })\n        | qName key == \"href\" && p val = attr { attrVal = \"#\" }\n        | otherwise = attr\n\n\nstripAnchorsWhen :: (String -> Bool) -> Xml -> Xml\nstripAnchorsWhen p =\n    processAnchors unname\n  where\n    unname attr@(Attr { attrKey = key, attrVal = val })\n        | qName key == \"name\" && p val = attr { attrVal = \"\" }\n        | otherwise = attr\n\n\nprocessAnchors :: (Attr -> Attr) -> Xml -> Xml\nprocessAnchors f = Xml . everywhere (mkT f) . xmlElement\n\n\nstripFooter :: Xml -> Xml\nstripFooter =\n    Xml . everywhere (mkT defoot) . xmlElement\n  where\n    defoot el\n        | isFooter el = el { elContent = [] }\n        | otherwise = el\n    isFooter el = any isFooterAttr $ elAttribs el\n    isFooterAttr (Attr { .. }) = and\n        [ qName attrKey == \"id\"\n        , attrVal == \"footer\"\n        ]\n\n\nxmlElementToXhtml :: Element -> Html\nxmlElementToXhtml (Element { .. }) =\n    Xhtml.tag (qName elName) contents ! attrs\n  where\n    contents = mconcat $ map xmlContentToXhtml elContent\n    attrs = map xmlAttrToXhtml elAttribs\n\n\nxmlContentToXhtml :: Content -> Html\nxmlContentToXhtml (Elem el) = xmlElementToXhtml el\nxmlContentToXhtml (Text text) = Xhtml.toHtml $ cdData text\nxmlContentToXhtml (CRef _) = Xhtml.noHtml\n\n\nxmlAttrToXhtml :: Attr -> HtmlAttr\nxmlAttrToXhtml (Attr { .. }) = Xhtml.strAttr (qName attrKey) attrVal\n", "num_lines": 95}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n\nimport Data.Function\nimport System.Environment\nimport System.FilePath\n\nimport Test.Haddock\nimport Test.Haddock.Utils\n\n\ncheckConfig :: CheckConfig String\ncheckConfig = CheckConfig\n    { ccfgRead = Just\n    , ccfgClean = \\_ -> id\n    , ccfgDump = id\n    , ccfgEqual = (==) `on` crlfToLf\n    }\n\n\ndirConfig :: DirConfig\ndirConfig = defaultDirConfig $ takeDirectory __FILE__\n\n\nmain :: IO ()\nmain = do\n    cfg <- parseArgs checkConfig dirConfig =<< getArgs\n    runAndCheck $ cfg\n        { cfgHaddockArgs = cfgHaddockArgs cfg ++\n            [ \"--package-name=test\"\n            , \"--package-version=0.0.0\"\n            , \"--hoogle\"\n            ]\n        }\n", "num_lines": 35}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE AllowAmbiguousTypes #-}\n\n\nmodule AssocTypes where\n\n\nclass Foo a where\n\n    type Bar a b\n    type Baz a\n\n    type Baz a = [(a, a)]\n\n    bar :: Bar a a\n    bar = undefined\n\n\ninstance Foo [a] where\n\n    type Bar [a] Int = [(a, Bool)]\n    type Bar [a] Bool = [(Int, a)]\n\n    type Baz [a] = (a, a, a)\n", "num_lines": 25}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, TypeFamilies #-}\nmodule Bug722 where\n\nclass Foo a where\n  (!@#) :: a -> a -> a\ninfixl 4 !@#\n\ntype family (&*) :: * -> * -> *\ninfixr 3 &*\n\ndata a :-& b = a :^& b\ninfixl 6 :-&, :^&\n\n", "num_lines": 14}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE UndecidableInstances #-}\nmodule Bug806 where\n\nimport Data.Proxy\n\n-- | 'F1' docs\ntype family F1 a b :: * -> *\n-- | 'F2' docs\ntype family F2 a b :: * -> * where\n  F2 Int b = Maybe\n  F2 a   b = []\n-- | 'D' docs\ndata family D a :: * -> *\n\nv :: Int\nv = 42\n\n-- | 'C' docs\nclass C a where\n  -- | 'AT' docs\n  type AT a\n  type AT a = Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy)))))))))\n", "num_lines": 25}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeOperators #-}\nmodule Bug825 where\n\ndata a :~: b\ndata (:~~:) a b\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Classes where\n\n\nclass Foo f where\n\n    bar :: f a -> f b -> f (a, b)\n    baz :: f ()\n\n    baz = undefined\n\n\nclass Quux q where\n\n    (+++), (///) :: q -> q -> q\n    (***), logBase :: q -> q -> q\n    foo, quux :: q -> q -> q\n", "num_lines": 17}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Fixity where\n\n\n(+++), (***), (///) :: a -> a -> a\n(+++) = undefined\n(***) = undefined\n(///) = undefined\n\n\ninfix 6 +++\ninfixl 7 ***\ninfixr 8 ///\n", "num_lines": 13}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bar where\n\n\nimport Foo\n\n\nbar :: Int -> Int\nbar x = foo' x x\n\n\nbar' :: Int -> Int -> Int\nbar' x y = foo' (bar (foo x)) (bar (foo y))\n", "num_lines": 13}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Foo where\n\n\nfoo :: Int -> Int\nfoo = (* 2)\n\n\nfoo' :: Int -> Int -> Int\nfoo' x y = foo x + foo y\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ReaderT where\n\nnewtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ReaderTReexport (ReaderT(..), runReaderT) where\n\nimport ReaderT\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n\nimport Data.Char\nimport Data.Function (on)\n\nimport System.Environment\nimport System.FilePath\n\nimport Test.Haddock\nimport Test.Haddock.Xhtml\n\n\ncheckConfig :: CheckConfig Xml\ncheckConfig = CheckConfig\n    { ccfgRead = parseXml\n    , ccfgClean = stripIfRequired\n    , ccfgDump = dumpXml\n    , ccfgEqual = (==) `on` dumpXml\n    }\n\n\ndirConfig :: DirConfig\ndirConfig = (defaultDirConfig $ takeDirectory __FILE__)\n    { dcfgCheckIgnore = checkIgnore\n    }\n\n\nmain :: IO ()\nmain = do\n    cfg <- parseArgs checkConfig dirConfig =<< getArgs\n    runAndCheck $ cfg\n        { cfgHaddockArgs = cfgHaddockArgs cfg ++ [\"--pretty-html\", \"--html\"]\n        }\n\n\nstripIfRequired :: String -> Xml -> Xml\nstripIfRequired mdl =\n    stripLinks' . stripFooter\n  where\n    stripLinks'\n        | mdl `elem` preserveLinksModules = id\n        | otherwise = stripLinks\n\n\n-- | List of modules in which we don't 'stripLinks'\npreserveLinksModules :: [String]\npreserveLinksModules = [\"Bug253\"]\n\ningoredTests :: [FilePath]\ningoredTests =\n  [\n    -- Currently some declarations are exported twice\n    -- we need a reliable way to deduplicate here.\n    -- Happens since PR #688.\n    \"B\"\n\n    -- ignore-exports flag broke with PR #688. We use\n    -- the Avails calculated by GHC now. Probably\n    -- requires a change to GHC to \"ignore\" a modules\n    -- export list reliably.\n  , \"IgnoreExports\"\n  ]\n\ncheckIgnore :: FilePath -> Bool\ncheckIgnore file | takeBaseName file `elem` ingoredTests = True\ncheckIgnore file@(c:_) | takeExtension file == \".html\" && isUpper c = False\ncheckIgnore _ = True\n", "num_lines": 69}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module A where\n\ndata A = A\n\nother :: Int\nother = 2\n\n-- | Doc for test2\ntest2 :: Bool\ntest2 = False\n\n-- | Should show up on the page for both modules A and B\ndata X = X -- ^ Doc for consructor\n\n-- | Should show up on the page for both modules A and B\nreExport :: Int\nreExport = 1\n", "num_lines": 18}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module B ( module A, test, reExport, X(..) ) where\nimport A ( A(..), test2, reExport, X(..) )\n\n-- | This link shouldn't work: 'other'.\n--   These links should work: 'A.other', 'Data.List.sortBy', 'test2', 'A.test2', 'Data.Maybe.fromMaybe'.\n--   Module link: \"Prelude\".\ntest :: Int\ntest = 1\n", "num_lines": 9}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bold where\n-- | Some __bold text__.\n--\n-- * __Bold__ in a list\n--\n-- [__bold in a definition__] list\n--\n-- @ bold __in__ a __code__ block @\nfoo = undefined\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug1 where\n\n-- | We should have different anchors for constructors and types\\/classes.  This\n-- hyperlink should point to the type constructor by default: 'T'.\ndata T = T\n\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug195 where\n\ndata T = A { someField :: () -- ^ Doc for someField of A\n           , someOtherField :: () -- ^ Doc for someOtherField of A\n           }\n       | B { someField :: () -- ^ Doc for someField of B\n           , someOtherField :: () -- ^ Doc for someOtherField of B\n           }\n       | C { someField :: () -- ^ Doc for someField of C\n           , someOtherField :: () -- ^ Doc for someOtherField of C\n           }\n", "num_lines": 12}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug2 ( x ) where\nimport B\nx :: A\nx = A\n", "num_lines": 5}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- We test that leading whitespace gets properly dropped (or not!)\n-- from codeblocks\nmodule Bug201 where\n\n-- |\n-- @\n-- This leading whitespace\n-- should be dropped\n-- @\nf :: ()\nf = ()\n\n{-|\n@\n But this one\n should not\n@\n\n> this should\n> be dropped\n\n@\n and so should this\n because there's a space before closing @\n @\n-}\ng :: ()\ng = ()\n", "num_lines": 29}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | This module tests that if we're trying to link to a /qualified/\n-- identifier that's not in scope, we get an anchor as if it was a\n-- variable. Previous behaviour was to treat it as a type constructor\n-- so issue like #253 arose. Also see @rename@ function comments in\n-- source.\nmodule Bug253 where\n\n-- | This link should generate @#v@ anchor: 'DoesNotExist.fakeFakeFake'\nfoo :: ()\nfoo = ()\n", "num_lines": 11}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | This module tests the \u00e2\u20ac\u02dc@since \u00e2\u20ac\u00a6\u00e2\u20ac\u2122 annotation.\n--\n-- @since 1.2.3\nmodule Bug26 where\n\n-- | Foo\n--\n-- @since 2.10.7\n--\n-- @since 2.10.8\nf :: ()\nf = ()\n\n-- | Bar\ng :: ()\ng = ()\n\n-- | Class\n--\n-- @since 1.0\nclass C a where\n  -- | @since 1.2.3\n  c_f :: a\n\n-- | instance for ()\n--\n-- @since 0.7.8\ninstance C () where\n  c_f = ()\n", "num_lines": 30}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-|\nCopyright: Foo,\n           Bar,\n           Baz\n\nThe module description\n-}\n-- The module header can start with newlines. They are not taken into account for the indentation level\nmodule Bug280 where\n\nx = \"\"\n", "num_lines": 12}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, FlexibleInstances, GADTs #-}\n-- This tests that we are able to extract record selectors for\n-- associated types when the type itself is not exported. Making this\n-- bug exhibit is very simple: simply mention a record field defined\n-- inside of the associated type anywhere in the export list.\n--\n-- Note: ProblemCtor only shows up when T or A are exported but PolyCtor\n-- only shows up when the class is exported as well, since it's polymorphic.\nmodule Bug294 ( A, problemField, problemField', gadtField\n              , TP(ProblemCtor), DP(ProblemCtor'), TO'(PolyCtor)) where\n\ndata A\n\nclass T t where\n  data TO t :: *\n  data TP t :: *\n\n  t :: t\n\ninstance T A where\n  data TO A = TA { problemField :: A }\n  data TP A = ProblemCtor A\n\ndata family DO t :: *\ndata family DP t :: *\n\ndata instance DO A = DA { problemField' :: A }\ndata instance DP A = ProblemCtor' A\n\ndata GADT :: * -> * where\n  Ctor :: { gadtField :: A } -> GADT A\n\nclass T' t where\n  data TO' t :: *\n\ninstance T' a where\n  data TO' a = PolyCtor\n", "num_lines": 38}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- We introduced a regression in 2.14.x where we don't consider\n-- identifiers with ^ as valid. We test that the regression goes away\n-- here. It's a silly typo in the parser, really. Same with \u00e2\u02dc\u2026 which is a valid\n-- symbol according to the 2010 report.\nmodule Bug298 where\n\n\n(<^>) :: (a -> a) -> a -> a\nx <^> y = x y\n\n(<^) :: a -> a -> a\nx <^ y = x\n\n(^>) :: a -> a -> a\nx ^> y = y\n\n(\u00e2\u2039\u2020^) :: a -> a -> a\nx \u00e2\u2039\u2020^ y = y\n\n-- | Links to '<^>' and '^>', '<^' and '\u00e2\u2039\u2020^'.\nf :: ()\nf = ()\n", "num_lines": 23}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug3 where\n\n-- | /multi-line\n-- emphasis/\nfoo :: Int\nfoo = undefined\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- From 2.14.x onwards we were forgetting to swallow \u00e2\u20ac\u02dc#\u00e2\u20ac\u2122 as a special\n-- character resulting in broken anchors if they accured\n-- mid-paragraph. Here we check that anchors get generated as\n-- expected.\nmodule Bug308 where\n\n-- | start#startAnchor# followed by middle#middleAnchor# and end#endAnchor#\nf :: ()\nf = ()\n\n{-|\nstart \"Bug308#startAnchor\"\n\nstartOldStyle \"Bug308\\#startAnchor\"\n\nmiddle \"Bug308#middleAnchor\"\n\nend \"Bug308#middleAnchor\"\n-}\ng :: ()\ng = ()\n", "num_lines": 22}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Just like Bug308 module but here we test that referring to anchors\n-- from other modules works.\nmodule Bug308CrossModule where\n\nimport Bug308\n\n{-|\nstart \"Bug308#startAnchor\"\n\nstartOldStyle \"Bug308\\#startAnchor\"\n\nmiddle \"Bug308#middleAnchor\"\n\nend \"Bug308#middleAnchor\"\n-}\nh :: ()\nh = ()\n", "num_lines": 18}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExplicitNamespaces #-}\nmodule Bug310 ( type (+) ) where\n\nimport GHC.TypeLits\n", "num_lines": 5}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | The first list is incorrectly numbered as 1. 2. 1.; the second example\n-- renders fine (1. 2. 3.).\n--\n-- See https://github.com/haskell/haddock/issues/313\nmodule Bug313 where\n\n{- |\nSome text.\n\n1. Item 1\n\n2. Item 2\n\n    > Some code\n\n3. Item 3\n\nSome more text.\n-}\na :: a\na = undefined\n\n{- |\nSome text.\n\n1. Item 1\n\n2. Item 2\n\n    > Some code\n\n3. Item 3\n\n-}\n-- | Some more text.\nb :: a\nb = undefined\n", "num_lines": 38}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Tests for collapsable headers\nmodule Bug335 where\n\n{-|\n=== __ExF:__\nabc\n-}\nf :: ()\nf = ()\n\n{-|\n=== __ExG:__\n>>> a\nb\n\n>>> c\nd\n\n==== Under ex\nfoo\n\n== Out of Ex\nfoo\n-}\ng :: ()\ng = ()\n", "num_lines": 27}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug387\n  ( -- * Section1#a:section1#\n    test1\n    -- * Section2#a:section2#\n  , test2\n  ) where\n\ntest1 :: Int\ntest1 = 223\n\ntest2 :: Int\ntest2 = 42\n", "num_lines": 13}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug4 where\n-- | don't use apostrophe's in the wrong place's\nfoo :: Int\nfoo = undefined\n\n", "num_lines": 6}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug458 where\n\n-- | See the defn of @'\u00e2\u0160\u2020'@.\n(\u00e2\u0160\u2020) :: () -> () -> ()\n_ \u00e2\u0160\u2020 _ = ()\n\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug546 where\n\n-- |Test:\n--\n-- [@[code with square \\\\ brackets\\]@] lorem ipsum\nx = 1\n\n-- |\n--\n-- [@[..\\]@]  Matches any of the enclosed characters. Ranges of characters can\n--            be specified by separating the endpoints with a @\\'-'@. @\\'-'@ or\n--            @']'@ can be matched by including them as the first character(s)\n--            in the list. Never matches path separators: @[\\/]@ matches\n--            nothing at all. Named character classes can also be matched:\n--            @[:x:]@ within @[]@ specifies the class named @x@, which matches\n--            certain predefined characters. See below for a full list.\n--\n-- [@[^..\\]@ or @[!..\\]@] Like @[..]@, but matches any character /not/ listed.\n--                        Note that @[^-x]@ is not the inverse of @[-x]@, but\n--                        the range @[^-x]@.\n--\n-- [@\\<m-n>@] Matches any integer in the range m to n, inclusive. The range may\n--            be open-ended by leaving out either number: @\\\"\\<->\\\"@, for\n--            instance, matches any integer.\n--\n-- [@**/@]    Matches any number of characters, including path separators,\n--            excluding the empty string.\n--\n-- Supported character classes:\n--\n-- [@[:alnum:\\]@]  Equivalent to @\\\"0-9A-Za-z\\\"@.\n--\n-- [@[:alpha:\\]@]  Equivalent to @\\\"A-Za-z\\\"@.\n--\n-- [@[:blank:\\]@]  Equivalent to @\\\"\\\\t \\\"@.\n--\n-- [@[:cntrl:\\]@]  Equivalent to @\\\"\\\\0-\\\\x1f\\\\x7f\\\"@.\n--\n-- [@[:digit:\\]@]  Equivalent to @\\\"0-9\\\"@.\n--\n-- [@[:graph:\\]@]  Equivalent to @\\\"!-~\\\"@.\n--\n-- [@[:lower:\\]@]  Equivalent to @\\\"a-z\\\"@.\n--\n-- [@[:print:\\]@]  Equivalent to @\\\" -~\\\"@.\n--\n-- [@[:punct:\\]@]  Equivalent to @\\\"!-\\/:-\\@[-`{-~\\\"@.\n--\n-- [@[:space:\\]@]  Equivalent to @\\\"\\\\t-\\\\r \\\"@.\n--\n-- [@[:upper:\\]@]  Equivalent to @\\\"A-Z\\\"@.\n--\n-- [@[:xdigit:\\]@] Equivalent to @\\\"0-9A-Fa-f\\\"@.\ncompile :: String -> String\ncompile = id", "num_lines": 55}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug548 (WrappedArrow(..)) where\n\nimport Control.Applicative\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Exporting records.\nmodule Bug6( A(A), B(B), b, C(C,c1,c2), D(D,d1), E(E) ) where\n\n-- |\n-- This record is exported without its field\ndata A = A { a :: Int }\n\n-- |\n-- .. with its field, but the field is named separately in the export list\n-- (the field isn't documented separately since it is already documented here)\ndata B = B { b :: Int }\n\n-- |\n-- .. with fields names as subordinate names in the export\ndata C = C { c1 :: Int, c2 :: Int }\n\n-- |\n-- .. with only some of the fields exported (we can't handle this one -\n-- how do we render the declaration?)\ndata D = D { d1 :: Int, d2 :: Int }\n\n-- | a newtype with a field\nnewtype E = E { e :: Int }\n", "num_lines": 24}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug613  where\n\nimport Prelude (Either(Left, Right))\n\nclass Functor f where\n  fmap :: (a -> b) -> f a -> f b\n\ninstance Functor (Either a) where\n  fmap _ (Left x) = Left x\n  fmap f (Right y) = Right (f y)\n\n-- | Phantom type a0 is added to block the first renaming from a to a0. This ensures that the renamer doesn't create a new conflict\ndata ThreeVars a0 a b = ThreeVars a b\n\ninstance Functor (ThreeVars a0 a) where\n  fmap f (ThreeVars a b) = ThreeVars a (f b)\n", "num_lines": 17}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug647 where\n\nclass Bug647 a where\n\tf :: a -- ^ doc for arg1\n\t  -> a -- ^ doc for arg2\n\t  -> a -- ^ doc for arg3", "num_lines": 6}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Bug679 where\n\nimport Language.Haskell.TH\n\ndata Bar a = Bar\n\n$(do\n   a <- newName \"a\"\n   \n   let classN = mkName \"Foo\"\n   let methodN = mkName \"foo\"\n\n   methodTy <- [t| $(varT a) -> $(varT a) |]\n   let cla = ClassD [] classN [PlainTV a] [] [SigD methodN methodTy]\n \n   -- Note that we are /reusing/ the same type variable 'a' as in the class\n   instanceHead <- [t| $(conT classN) (Bar $(varT a)) |]\n   idCall <- [e| id |]\n   let ins = InstanceD Nothing [] instanceHead [FunD methodN [Clause [] (NormalB idCall) []]]\n    \n   pure [cla,ins])\n\n", "num_lines": 25}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n-- | This module caused a duplicate instance in the documentation for the Foo\n-- type.\nmodule Bug7  where\n\n-- | The Foo datatype\ndata Foo = Foo\n\n-- | The Bar class\nclass Bar x y\n\n-- | Just one instance\ninstance Bar Foo Foo\n", "num_lines": 14}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bug8 where\n\ninfix -->\ninfix --->\n\ndata Typ = Type (Typ,[Typ])\n         | TFree (Typ, [Typ])\n\nx --> y = Type(s,[s,t])\n(--->) :: (Foldable t0) => t0 t -> Typ -> Typ\n(--->) = flip $ foldr (-->)\n\ns = undefined\nt = undefined\nmain = undefined\n", "num_lines": 16}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs, KindSignatures #-}\nmodule Bug85 where\n\n-- explicitly stated non-trivial kind\ndata Foo :: (* -> *) -> * -> * where\n  Bar :: f x -> Foo f (f x)\n\n-- Just kind * but explicitly written\ndata Baz :: * where\n  Baz' :: Baz\n\n-- No kind signature written down at all\ndata Qux where\n  Quux :: Qux\n", "num_lines": 15}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module BugDeprecated where\n\nfoo :: Int\nfoo = 23\n\nbar :: Int\nbar = 23\n\nbaz :: Int\nbaz = 23\n{-# DEPRECATED foo \"for foo\" #-}\n{-# DEPRECATED bar \"for bar\" #-}\n{-# DEPRECATED baz \"for baz\" #-}\n\n-- | some documentation for one\none :: Int\none = 23\n\ntwo :: Int\ntwo = 23\n\nthree :: Int\nthree = 23\n{-# DEPRECATED one \"for one\" #-}\n{-# DEPRECATED two \"for two\" #-}\n{-# DEPRECATED three \"for three\" #-}\n", "num_lines": 27}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- test for #192\nmodule BugExportHeadings (\n-- * Foo\n  foo\n-- * Bar\n, bar\n-- * Baz\n, baz\n\n-- * One\n, one\n-- * Two\n, two\n-- * Three\n, three\n) where\n\nfoo, bar, baz :: Int\nfoo = 23\nbar = 23\nbaz = 23\n\none, two, three :: Int\none = 23\ntwo = 23\nthree = 23\n{-# DEPRECATED one \"for one\" #-}\n{-# DEPRECATED two \"for two\" #-}\n{-# DEPRECATED three \"for three\" #-}\n", "num_lines": 30}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Bugs where\n\ndata A a = A a (a -> Int)\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, GADTs, KindSignatures, PatternSynonyms, TypeOperators,\n             ViewPatterns #-}\nmodule BundledPatterns (Vec(Nil,(:>)), RTree (LR,BR)) where\n\nimport GHC.TypeLits\nimport Prelude hiding (head, tail)\nimport Unsafe.Coerce\n\n-- | Fixed size vectors.\n--\n-- * Lists with their length encoded in their type\n-- * 'Vec'tor elements have an __ASCENDING__ subscript starting from 0 and\n--   ending at @'length' - 1@.\ndata Vec :: Nat -> * -> * where\n  Nil  :: Vec 0 a\n  Cons :: a -> Vec n a -> Vec (n + 1) a\n\ninfixr 5 `Cons`\n\n-- | Add an element to the head of a vector.\n--\n-- >>> 3:>4:>5:>Nil\n-- <3,4,5>\n-- >>> let x = 3:>4:>5:>Nil\n-- >>> :t x\n-- x :: Num a => Vec 3 a\n--\n-- Can be used as a pattern:\n--\n-- >>> let f (x :> y :> _) = x + y\n-- >>> :t f\n-- f :: Num a => Vec ((n + 1) + 1) a -> a\n-- >>> f (3:>4:>5:>6:>7:>Nil)\n-- 7\n--\n-- Also in conjunctions with (':<'):\n--\n-- >>> let g (a :> b :> (_ :< y :< x)) = a + b +  x + y\n-- >>> :t g\n-- g :: Num a => Vec ((((n + 1) + 1) + 1) + 1) a -> a\n-- >>> g (1:>2:>3:>4:>5:>Nil)\n-- 12\npattern (:>) :: a -> Vec n a -> Vec (n + 1) a\npattern (:>) x xs <- ((\\ys -> (head ys,tail ys)) -> (x,xs))\n  where\n    (:>) x xs = Cons x xs\n\ninfixr 5 :>\n\nhead :: Vec (n + 1) a -> a\nhead (x `Cons` _) = x\n\ntail :: Vec (n + 1) a -> Vec n a\ntail (_ `Cons` xs) = unsafeCoerce xs\n\n-- | Perfect depth binary tree.\n--\n-- * Only has elements at the leaf of the tree\n-- * A tree of depth /d/ has /2^d/ elements.\ndata RTree :: Nat -> * -> * where\n  LR_ :: a -> RTree 0 a\n  BR_ :: RTree d a -> RTree d a -> RTree (d+1) a\n\ntextract :: RTree 0 a -> a\ntextract (LR_ x) = x\n{-# NOINLINE textract #-}\n\ntsplit :: RTree (d+1) a -> (RTree d a,RTree d a)\ntsplit (BR_ l r) = (unsafeCoerce l, unsafeCoerce r)\n{-# NOINLINE tsplit #-}\n\n-- | Leaf of a perfect depth tree\n--\n-- >>> LR 1\n-- 1\n-- >>> let x = LR 1\n-- >>> :t x\n-- x :: Num a => RTree 0 a\n--\n-- Can be used as a pattern:\n--\n-- >>> let f (LR a) (LR b) = a + b\n-- >>> :t f\n-- f :: Num a => RTree 0 a -> RTree 0 a -> a\n-- >>> f (LR 1) (LR 2)\n-- 3\npattern LR :: a -> RTree 0 a\npattern LR x <- (textract -> x)\n  where\n    LR x = LR_ x\n\n-- | Branch of a perfect depth tree\n--\n-- >>> BR (LR 1) (LR 2)\n-- <1,2>\n-- >>> let x = BR (LR 1) (LR 2)\n-- >>> :t x\n-- x :: Num a => RTree 1 a\n--\n-- Case be used a pattern:\n--\n-- >>> let f (BR (LR a) (LR b)) = LR (a + b)\n-- >>> :t f\n-- f :: Num a => RTree 1 a -> RTree 0 a\n-- >>> f (BR (LR 1) (LR 2))\n-- 3\npattern BR :: RTree d a -> RTree d a -> RTree (d+1) a\npattern BR l r <- ((\\t -> (tsplit t)) -> (l,r))\n  where\n    BR l r = BR_ l r\n", "num_lines": 111}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds, GADTs, KindSignatures, PatternSynonyms, TypeOperators,\n             ViewPatterns #-}\nmodule BundledPatterns2 (Vec((:>), Empty), RTree(..)) where\n\nimport GHC.TypeLits\n\nimport BundledPatterns\n\npattern Empty :: Vec 0 a\npattern Empty <- Nil\n", "num_lines": 11}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n\nmodule ConstructorPatternExport (\n    pattern FooCons\n  , pattern MyRecCons\n  , pattern (:+)\n  , pattern BlubCons\n  , pattern MyGADTCons\n  ) where\n\ndata Foo a = FooCons String a\n\ndata MyRec = MyRecCons { one :: Bool, two :: Int }\n\ndata MyInfix a = String :+ a\n\ndata Blub = forall b. Show b => BlubCons b\n\ndata MyGADT :: * -> * where\n  MyGADTCons :: forall a. Eq a => a -> Int -> MyGADT (Maybe String)\n\npattern MyGADTCons' :: () => forall a. Eq a => a -> Int -> MyGADT (Maybe String)\npattern MyGADTCons' x y = MyGADTCons x y", "num_lines": 26}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprecatedClass where\n\n-- | some class\nclass SomeClass a where\n  -- | documentation for foo\n  foo :: a -> a\n\n{-# DEPRECATED SomeClass \"SomeClass\" #-}\n{-# DEPRECATED foo \"foo\" #-}\n\nclass SomeOtherClass a where\n  bar :: a -> a\n\n{-# DEPRECATED SomeOtherClass \"SomeOtherClass\" #-}\n{-# DEPRECATED bar \"bar\" #-}\n", "num_lines": 16}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule DeprecatedData where\n\n-- | type Foo\ndata Foo = Foo -- ^ constructor Foo\n         | Bar -- ^ constructor Bar\n\n{-# DEPRECATED Foo \"Foo\" #-}\n{-# DEPRECATED Bar \"Bar\" #-}\n\ndata One = One\n         | Two\n\n{-# DEPRECATED One \"One\" #-}\n{-# DEPRECATED Two \"Two\" #-}\n", "num_lines": 16}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprecatedFunction where\n\n-- | some documentation for foo\nfoo :: Int\nfoo = 23\n{-# DEPRECATED foo \"use `bar` instead\" #-}\n\n-- | some documentation for bar\nbar :: Int\nbar = 42\n", "num_lines": 11}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprecatedFunction2 where\n\n\nfoo :: Int\nfoo = 23\n{-# DEPRECATED foo \"use bar instead\" #-}\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprecatedFunction3 where\n\n\n\nfoo = 23\n{-# DEPRECATED foo \"use bar instead\" #-}\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Documentation for \"DeprecatedModule\".\nmodule DeprecatedModule {-# DEPRECATED \"Use \\\"Foo\\\" instead\" #-} where\n\nfoo :: Int\nfoo = 23\n", "num_lines": 6}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprecatedModule2 {-# DEPRECATED \"Use Foo instead\" #-} where\n\nfoo :: Int\nfoo = 23\n", "num_lines": 5}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprecatedNewtype where\n\n-- | some documentation\nnewtype SomeNewType = SomeNewTypeConst String {- ^ constructor docu -}\n{-# DEPRECATED SomeNewType \"SomeNewType\" #-}\n{-# DEPRECATED SomeNewTypeConst \"SomeNewTypeConst\" #-}\n\nnewtype SomeOtherNewType = SomeOtherNewTypeConst String\n{-# DEPRECATED SomeOtherNewType \"SomeOtherNewType\" #-}\n{-# DEPRECATED SomeOtherNewTypeConst \"SomeOtherNewTypeConst\" #-}\n", "num_lines": 11}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module DeprecatedRecord where\n\n-- | type Foo\ndata Foo = Foo {\n  fooName  :: String -- ^ some name\n, fooValue :: Int    -- ^ some value\n}\n\n{-# DEPRECATED fooValue \"do not use this\" #-}\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- |\n-- What is tested here:\n--\n-- * Deprecation messages are shown for re-exported items.\n--\nmodule DeprecatedReExport (\n-- * Re-exported from an other module\n  foo\n-- * Re-exported from an other package\n-- | Not yet working, see <http://trac.haskell.org/haddock/ticket/223>\n-- , isEmptyChan\n,\n) where\n\nimport DeprecatedFunction\nimport Control.Concurrent.Chan\n", "num_lines": 17}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\nmodule DeprecatedTypeFamily where\n\n-- | some documentation\ndata family SomeTypeFamily k :: * -> *\n{-# DEPRECATED SomeTypeFamily \"SomeTypeFamily\" #-}\n\ndata family SomeOtherTypeFamily k :: * -> *\n{-# DEPRECATED SomeOtherTypeFamily \"SomeOtherTypeFamily\" #-}\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\nmodule DeprecatedTypeSynonym where\n\n-- | some documentation\ntype TypeSyn = String\n{-# DEPRECATED TypeSyn \"TypeSyn\" #-}\n\ntype OtherTypeSyn = String\n{-# DEPRECATED OtherTypeSyn \"OtherTypeSyn\" #-}\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DuplicateRecordFields #-}\nmodule DuplicateRecordFields (RawReplay(..)) where\n\nimport Prelude hiding (Int)\n\ndata Int = Int\n\ndata RawReplay = RawReplay\n    { headerSize :: Int\n    -- ^ The byte size of the first section.\n    , headerCRC :: Int\n    -- ^ The CRC of the first section.\n    , header :: Int\n    -- ^ The first section.\n    , contentSize :: Int\n    -- ^ The byte size of the second section.\n    , contentCRC :: Int\n    -- ^ The CRC of the second section.\n    , content :: Int\n    -- ^ The second section.\n    , footer :: Int\n    -- ^ Arbitrary data after the second section. In replays generated by\n    -- Rocket League, this is always empty. However it is not technically\n    -- invalid to put something here.\n    }", "num_lines": 25}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Examples where\n\n-- | Fibonacci number of given 'Integer'.\n--\n-- Examples:\n--\n-- >>> fib 5\n-- 5\n-- >>> fib 10\n-- 55\n--\n-- >>> fib 10\n-- 55\n--\n-- One more Example:\n--\n-- >>> fib 5\n-- 5\n--\n-- One more Example:\n--\n-- >>> fib 5\n-- 5\n--\n-- Example with an import:\n--\n-- >>> import Data.Char\n-- >>> isSpace 'a'\n-- False\n--\n-- >>> putStrLn \"foo\\n\\nbar\"\n-- foo\n-- <BLANKLINE>\n-- bar\n--\nfib :: Integer -> Integer\nfib 0 = 0\nfib 1 = 1\nfib n = fib (n - 1) + fib (n - 2)\n", "num_lines": 40}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE Haskell2010, ExplicitForAll, MonomorphismRestriction #-}\n{-# OPTIONS_HADDOCK show-extensions #-}\nmodule Extensions where\n\n-- | Bar\nfoobar :: t\nfoobar = undefined\n", "num_lines": 8}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes, DataKinds, TypeFamilies #-}\nmodule FunArgs where\n\nf :: forall a. Ord a\n  => Int          -- ^ First argument\n  -> a            -- ^ Second argument\n  -> Bool         -- ^ Third argument\n  -> (a -> a)     -- ^ Fourth argument\n  -> ()           -- ^ Result\nf = undefined\n\n\ng :: a -- ^ First argument\n  -> b -- ^ Second argument\n  -> c -- ^ Third argument\n  -> d -- ^ Result\ng = undefined\n\n\nh :: forall a b c\n  .  a -- ^ First argument\n  -> b -- ^ Second argument\n  -> c -- ^ Third argument\n  -> forall d. d -- ^ Result\nh = undefined\n\n\ni :: forall a (b :: ()) d. (d ~ '())\n  => forall c\n  .  a b c d -- ^ abcd\n  -> ()      -- ^ Result\ni = undefined\n\n\nj :: forall proxy (a :: ()) b\n  .  proxy a -- ^ First argument\n  -> b       -- ^ Result\nj = undefined\n", "num_lines": 39}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE GADTs #-}\nmodule GADTRecords (H1(..)) where\n\n-- | h1\ndata H1 a b where\n  C1 :: H1 a b\n  C2 :: Ord a => [a] -> H1 a a\n  C3 :: { field :: Int -- ^ hello docs\n        } -> H1 Int Int\n  C4 :: { field2 :: a -- ^ hello2 docs\n        } -> H1 Int a\n", "num_lines": 12}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{- |\n  Implementation of fixed-size hash tables, with a type\n  class for constructing hash values for structured types.\n-}\nmodule Hash (\n  -- * The @HashTable@ type\n  HashTable,\n\n  -- ** Operations on @HashTable@s\n  new, insert, lookup,\n\n  -- * The @Hash@ class\n  Hash(..),\n ) where\n\nimport Data.Array\nimport Prelude hiding (lookup)\n\n-- | A hash table with keys of type @key@ and values of type @val@.\n-- The type @key@ should be an instance of 'Eq'.\ndata HashTable key val = HashTable Int (Array Int [(key,val)])\n\n-- | Builds a new hash table with a given size\nnew :: (Eq key, Hash key) => Int -> IO (HashTable key val)\nnew = undefined\n\n-- | Inserts a new element into the hash table\ninsert :: (Eq key, Hash key) => key -> val -> IO ()\ninsert = undefined\n\n-- | Looks up a key in the hash table, returns @'Just' val@ if the key\n-- was found, or 'Nothing' otherwise.\nlookup :: Hash key => key -> IO (Maybe val)\nlookup = undefined\n\n-- | A class of types which can be hashed.\nclass Hash a where\n   -- | hashes the value of type @a@ into an 'Int'\n   hash :: a -> Int\n\ninstance Hash Int where\n   hash = id\n\ninstance Hash Float where\n   hash = trunc\n\ninstance (Hash a, Hash b) => Hash (a,b) where\n   hash (a,b) = hash a `xor` hash b\n\ntrunc = undefined\nxor = undefined\n", "num_lines": 52}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_HADDOCK hide #-}\n\nmodule Hidden where\n\nhidden :: Int -> Int\nhidden a = a\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- http://trac.haskell.org/haddock/ticket/37\nmodule HiddenInstances (VisibleClass, VisibleData) where\n\n-- | Should be visible\nclass VisibleClass a\n\n-- | Should *not* be visible\nclass HiddenClass a\n\n-- | Should *not* be visible\ndata HiddenData = HiddenData\n\n-- | Should be visible\ndata VisibleData = VisibleData\n\n-- | Should be visible\ninstance VisibleClass Int\n\n-- | Should be visible\ninstance VisibleClass VisibleData\n\n-- | Should be visible\ninstance Num VisibleData\n\n-- | Should *not* be visible\ninstance VisibleClass HiddenData\n\n-- | Should *not* be visible\ninstance HiddenClass Int\n\n-- | Should *not* be visible\ninstance HiddenClass VisibleData\n\n-- | Should *not* be visible\ninstance HiddenClass HiddenData\n", "num_lines": 36}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_HADDOCK hide #-}\nmodule HiddenInstancesA where\n\n-- | Should be visible\nclass Foo a\n\n-- | Should be visible\ndata Bar\n\n-- | Should be visible\ninstance Foo Bar\n\n-- | Should *not* be visible\ndata Baz\n\n-- | Should *not* be visible\ninstance Foo Baz\n", "num_lines": 18}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module HiddenInstancesB (Foo, Bar) where\nimport HiddenInstancesA\n", "num_lines": 3}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Hyperlinks where\n\n-- |\n-- A plain URL: <http://example.com/>\n--\n-- A URL with a label: <http://example.com/ some link>\nfoo :: Int\nfoo = 23\n", "num_lines": 9}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_HADDOCK ignore-exports #-}\nmodule IgnoreExports (foo) where\n\n-- | documentation for foo\nfoo :: Int\nfoo = 23\n\n-- | documentation for bar\nbar :: Int\nbar = 23\n", "num_lines": 11}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ImplicitParams, RankNTypes #-}\nmodule ImplicitParams where\n\ndata X = X\n\nc :: (?x :: X) => X\nc = ?x\n\nd :: (?x :: X, ?y :: X) => (X, X)\nd = (?x, ?y)\n\nf :: ((?x :: X) => a) -> a\nf a = let ?x = X in a\n", "num_lines": 14}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE ImpredicativeTypes #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeOperators #-}\n\n\nmodule Instances where\n\n\nnewtype (<~~) a b = Xyzzy (b -> (a, a))\n\n\nclass Foo f where\n\n    foo :: f Int -> a -> f a\n    foo' :: f (f a) -> Int -> f (f Int)\n\n    foo = undefined\n    foo' = undefined\n\ninstance Foo Maybe\ninstance Foo []\ninstance (Eq a, Foo f) => Foo ((,) (f a))\ninstance Foo (Either a)\ninstance Foo ((,,) a a)\ninstance Foo ((->) a)\ninstance Foo ((<~~) a)\n\n\nclass Foo f => Bar f a where\n\n    bar :: f a -> f Bool -> a\n    bar' :: f (f a) -> f (f (f b))\n    bar0, bar1 :: (f a, f a) -> (f b, f c)\n\n    bar = undefined\n    bar' = undefined\n    bar0 = undefined\n    bar1 = undefined\n\n\ninstance Bar Maybe Bool\ninstance Bar Maybe [a]\ninstance Bar [] (a, a)\ninstance Foo f => Bar (Either a) (f a)\ninstance Foo ((,,) a b) => Bar ((,,) a b) (a, b, a)\n\n\nclass Baz a where\n\n    baz :: a -> (forall a. a -> a) -> (b, forall c. c -> a) -> (b, c)\n    baz' :: b -> (forall b. b -> a) -> (forall b. b -> a) -> [(b, a)]\n    baz'' :: b -> (forall b. (forall b. b -> a) -> c) -> (forall c. c -> b)\n\n    baz = undefined\n    baz' = undefined\n    baz'' = undefined\n\n\ninstance Baz (a -> b)\ninstance Baz [c]\ninstance Baz (a, b, c)\ninstance Baz (a, [b], b, a)\n\n\ndata Quux a b c = Qx a | Qux a b | Quux a b c\n\ninstance Foo (Quux a b)\ninstance Bar (Quux a c) (Quux a b c)\ninstance Baz (Quux a b c)\n\n\nclass Norf a b where\n\n    type Plugh a c b\n    data Thud a c\n\n    norf :: Plugh a c b -> a -> (a -> c) -> b\n\n    norf = undefined\n\n\ninstance Norf Int Bool where\n\n    type Plugh Int [a] Bool = a\n    type Plugh Int (a, b) Bool = (a, [b])\n\n    data Thud Int (Quux a [a] c) = Thuud a | Thuuud Int Int\n    data Thud Int [a] = Thuuuud Bool\n\n\ninstance Norf [a] [b] where\n\n    type Plugh [a] (Maybe a) [b] = a\n    type Plugh [a] [b] [b] = Quux a b (a, b)\n\n    data Thud [a] (a, a, a) = Thd a\n", "num_lines": 100}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Math (display) for 'normalDensity'\n--\n-- \\[\n-- \\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\n-- \\]\n--\n-- \\(\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\)\n\nmodule Math where\n\n-- | Math (inline) for 'normalDensity'\n-- \\(\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\)\n-- \\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]\nf = 5\n", "num_lines": 15}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | This tests the new MINIMAL pragma present in GHC 7.8\nmodule Minimal\n  ( Foo(..)\n  , Weird(..)\n  , NoMins(..)\n  , FullMin(..)\n  , PartialMin(ccc)\n  , EmptyMin(..)\n  ) where\n\nclass Foo a where\n  -- | Any two of these are required...\n  foo :: a\n  bar :: a\n  bat :: a\n\n  -- | .. or just this\n  fooBarBat :: (a,a,a)\n\n  {-# MINIMAL (foo, bar) | (bar, bat) | (foo, bat) | fooBarBat #-}\n\nclass Weird a where\n  a :: a\n  b :: a\n  c :: a\n  d :: a\n  e :: a\n  f :: a\n  g :: a\n\n  {-# MINIMAL ((a, b), c | (d | (e, (f | g)))) #-}\n\nclass NoMins a where\n  x :: a\n  y :: a\n  z :: a\n\n  -- | Has a default implementation!\n  z = x\n\nclass FullMin a where\n  aaa :: a\n  bbb :: a\n\nclass PartialMin a where\n  ccc :: a\n  ddd :: a\n\nclass EmptyMin a where\n  eee :: a\n  fff :: a\n  eee = fff\n  fff = undefined\n", "num_lines": 54}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Documentation for \"ModuleWithWarning\".\nmodule ModuleWithWarning {-# WARNING \"This is an unstable interface.  Prefer functions from \\\"Prelude\\\" instead!\" #-} where\n\nfoo :: Int\nfoo = 23\n", "num_lines": 6}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NamedDoc where\n\n-- $foo bar\n\n", "num_lines": 5}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Nesting where\n\n{-|\n* We can\n\n    * easily go back\n\n        1. some indentation\n\n    * levels\n\n1. @back at the top@\n\n-}\nd :: t\nd = undefined\n\n\n{-|\n* Beginning of list\n\n    * second list\n\n        * Some indented list but\nthe presence of this text pushes it out of nesting back to the top.\n-}\ne :: t\ne = undefined\n\n\n{-|\n* Beginning of list\n\n    @\n    nested code\n        we preserve the space correctly\n    @\n-}\nf :: t\nf = undefined\n\n\n{-|\n* Beginning of list\n\n    * Nested list\n-}\ng :: t\ng = undefined\n\n{-|\n* Beginning of list\n\n    > nested\n    > bird\n    > tracks\n-}\nh :: t\nh = undefined\n\n{-|\n* Beginning of list\nThis belongs to the list above!\n\n    > nested\n    > bird\n    > tracks\n    >\n    > another line\n    >   with indentation\n\n    >nested bird tracks\n    >  without leading space\n\n    * Next list\n    More of the indented list.\n\n        * Deeper\n\n            * Deeper\n\n                    * Even deeper!\n                    * No newline separation even in indented lists.\n-}\ni :: t\ni = undefined\n\n\n\n{-|\n[All this] Works for\ndefinition lists too.\n\n    > nested\n    > bird\n    > tracks\n\n    * Next list\n    with more of the indented list content.\n\n        Even more content on a new line.\n\n        1. Different type of list\n\n            (2) Deeper\n\n            >>> Here's an example in a list\n            example result\n\n                    [b] Even deeper!\n                    [c] No newline separation even in indented lists.\n                    We can have any paragraph level element that we normally\n                    can, like headers\n\n                    === Level 3 header\n                    with some content\u00e2\u20ac\u00a6\n\n                    * and even more lists inside\n-}\nj :: t\nj = undefined\n\n{-|\n      - list may start at arbitrary depth\n\n      - and consecutive items at that depth\n      belong to the same list\n\n      - of course we can still\n\n          * nest items like we are used to\n\n      - and then get back to initial list\n-}\nk :: t\nk = undefined\n", "num_lines": 137}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "\n-- Haddock comments are parsed as separate declarations so we\n-- need to insert a ';' when using them with explicit layout.\n-- This should probably be changed.\n\nmodule NoLayout where {\n  -- | the function 'g'\n  ;\n  g :: Int;\n  g = undefined\n }\n\n", "num_lines": 13}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module NonGreedy where\n\n-- | <url1> <url2>\nf :: a\nf = undefined\n", "num_lines": 6}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE PatternSynonyms, TypeOperators, TypeFamilies, MultiParamTypeClasses, GADTs #-}\n{-# LANGUAGE FunctionalDependencies #-}\n\n-- | Test operators with or without fixity declarations\nmodule Operators where\n\n-- | Operator with no fixity\n(+-) :: a -> a -> a\na +- _ = a\n\n-- | Operator with infixr 7\n(*/) :: a -> a -> a\n_ */ b = b\ninfixr 7 */\n\n-- | Named function with infixl 3\nfoo :: a -> a -> a\nfoo a _ = a\ninfixl 3 `foo`\n\n-- | Data type with operator constructors\ndata Foo\n  = Foo `Bar` Foo -- ^ Has infixl 3\n  | Foo :- Foo  -- ^ Has infixr 5\ninfixr 5 :-\ninfixl 3 `Bar`\n\n-- | Pattern synonym, infixr 3\npattern (:+) a b <- [a,b]\ninfixr 3 :+\n\n-- | Type name, infixl 6 and GADT constructor\ndata (a <-> b) where\n  (:<->) :: a -> b -> a <-> b\ninfixl 6 <->\ninfixr 6 :<->\n\n-- | Type family with fixity\ntype family a ++ b\ninfix 3 ++\n\n-- | Data family with fixity\ndata family a ** b\ninfix 9 **\n\n-- | Class with fixity, including associated types\nclass a ><> b | a -> b where\n  -- Dec 2015: Added @a -> b@ functional dependency to clean up ambiguity\n  -- See GHC #11264\n  type a <>< b :: *\n  data a ><< b\n  (>><), (<<>) :: a -> b -> ()\n\n  -- | Multiple fixities\n  (**>), (**<), (>**), (<**) :: a -> a -> ()\n\ninfixr 1 ><>\ninfixl 2 <><\ninfixl 3 ><<\ninfixr 4 >><\ninfixl 5 <<>\n\ninfixr 8 **>, >**\ninfixl 8 **<, <**\n\n-- | Type synonym with fixity\ntype (a >-< b) = a <-> b\ninfixl 6 >-<\n", "num_lines": 69}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module OrphanInstances where\n\nimport OrphanInstancesType\nimport OrphanInstancesClass\n\n-- | This is an orphan instance.\ninstance AClass AType where\n  aClass (AType n) = n\n", "num_lines": 9}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module OrphanInstancesClass (AClass(..)) where\n\nclass AClass a where\n  aClass :: a -> Int\n", "num_lines": 5}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module OrphanInstancesType (AType(..)) where\n\ndata AType = AType Int\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE ExistentialQuantification, PatternSynonyms, PolyKinds, TypeOperators #-}\n\n-- | Testing some pattern synonyms\nmodule PatternSyns where\n\n-- | FooType doc\ndata FooType x = FooCtor x\n\n-- | Pattern synonym for 'Foo' x\npattern Foo x = FooCtor x\n\n-- | Pattern synonym for 'Bar' x\npattern Bar x = FooCtor (Foo x)\n\n-- | Pattern synonym for (':<->')\npattern x :<-> y = (Foo x, Bar y)\n\n-- | BlubType is existentially quantified\ndata BlubType = forall x. Show x => BlubCtor x\n\n-- | Pattern synonym for 'Blub' x\npattern Blub x = BlubCtor x\n\n-- | Doc for ('><')\ndata (a :: *) >< b = Empty\n\n-- | Pattern for 'Empty'\npattern E = Empty\n\n-- | Earlier ghc versions didn't allow explicit signatures\n-- on pattern synonyms.\npattern PatWithExplicitSig :: Eq somex => somex -> FooType somex\npattern PatWithExplicitSig x = FooCtor x\n", "num_lines": 34}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module PR643 (test) where\n\nimport PR643_1\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module PR643_1 where\n\ninfixr 5 `test`\n\n-- | Some big documentation\ntest :: ()\ntest = ()\n", "num_lines": 8}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE TypeOperators #-}\n\n\nmodule PromotedTypes where\n\n\ndata RevList a = RNil | RevList a :> a\n\n\ndata Pattern :: [*] -> * where\n  Nil :: Pattern '[]\n  Cons :: Maybe h -> Pattern t -> Pattern (h ': t)\n\n\n-- Unlike (:), (:>) does not have to be quoted on type level.\ndata RevPattern :: RevList * -> * where\n    RevNil :: RevPattern RNil\n    RevCons :: Maybe h -> RevPattern t -> RevPattern (t :> h)\n\n\ndata Tuple :: (*, *) -> * where\n    Tuple :: a -> b -> Tuple '(a, b)\n", "num_lines": 26}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Properties where\n\n-- | Fibonacci number of given 'Integer'.\n--\n-- prop> fib n <= fib (n + 1)\nfib :: Integer -> Integer\nfib 0 = 0\nfib 1 = 1\nfib n = fib (n - 1) + fib (n - 2)\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_HADDOCK prune #-}\n-- |\n-- What is tested here:\n--\n-- * If a binding has a deprecation message but no documentation, it is pruned\n--   when @OPTIONS_HADDOCK prune@ is used.\n--\nmodule PruneWithWarning (foo, bar) where\n\nfoo :: Int\nfoo = 23\n{-# DEPRECATED foo \"use bar instead\" #-}\n\nbar :: Int\nbar = 42\n", "num_lines": 16}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- Used by QuasiQuote. Example taken from the GHC documentation.\nmodule QuasiExpr where\n\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Quote\n\ndata Expr  =  IntExpr Integer\n           |  AntiIntExpr String\n           |  BinopExpr BinOp Expr Expr\n           |  AntiExpr String\n    deriving Show\n\ndata BinOp  =  AddOp\n            |  SubOp\n            |  MulOp\n            |  DivOp\n    deriving Show\n\neval :: Expr -> Integer\neval (IntExpr n)        = n\neval (BinopExpr op x y) = (opToFun op) (eval x) (eval y)\n  where\n    opToFun AddOp = (+)\n    opToFun SubOp = (-)\n    opToFun MulOp = (*)\n    opToFun DivOp = div\n\nexpr = QuasiQuoter parseExprExp undefined undefined undefined\n\n-- cheating...\nparseExprExp :: String -> Q Exp\nparseExprExp _ = [| BinopExpr AddOp (IntExpr 1) (IntExpr 2) |]\n", "num_lines": 35}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}\n\n-- example taken from the GHC documentation\nmodule QuasiQuote where\n\nimport QuasiExpr\n\nval :: Integer\nval = eval [expr|1 + 2|]\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE EmptyDataDecls, KindSignatures #-}\n-- |\n-- What is tested here:\n--\n-- Due to a change in GHC 7.6.1 we had a bug that superclass contraints were\n-- included in the instances list.  Edward K. repported it here:\n--\n--   <http://www.haskell.org/pipermail/haskell-cafe/2012-September/103600.html>\n--\n-- And here is the corresponding thread on glasgow-haskell-users:\n--\n--   <http://www.haskell.org/pipermail/glasgow-haskell-users/2012-September/022914.html>\n--\n-- It has been fixed in:\n--\n-- > 6ccf78e15a525282fef61bc4f58a279aa9c21771\n-- > Fix spurious superclass constraints bug.\n--\nmodule SpuriousSuperclassConstraints where\n\nimport Control.Applicative\n\ndata SomeType (f :: * -> *) a\n\ninstance Functor (SomeType f) where\n  fmap = undefined\n\ninstance Applicative f => Applicative (SomeType f) where\n  pure   = undefined\n  (<*>)  = undefined\n", "num_lines": 31}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | This tests the table markup\nmodule Table\n  ( tableWithHeader\n  , tableWithoutHeader\n  , fancyTable\n  ) where\n\n-- | Table with header.\n--\n-- +------+--------------+------------------------------------------+\n-- | code | message      | description                              |\n-- +======+==============+==========================================+\n-- | 200  |   @OK@       | operation successful                     |\n-- +------+--------------+------------------------------------------+\n-- | 204  | @No Content@ | operation successful, no body returned   |\n-- +------+--------------+------------------------------------------+\ntableWithHeader :: a -> a\ntableWithHeader a = a\n\n-- | Table without header.\n--\n-- +------+--------------+------------------------------------------+\n-- | 200  |   @OK@       | operation successful                     |\n-- +------+--------------+------------------------------------------+\n-- | 204  | @No Content@ | operation successful, no body returned   |\n-- +------+--------------+------------------------------------------+\n-- | 404  | @Not Found@  | resource not found                       |\n-- +------+--------------+------------------------------------------+\ntableWithoutHeader :: a -> a\ntableWithoutHeader a = a\n\n-- | Fancy table.\n--\n-- +------------------------+------------+----------+----------+\n-- | Header row, column 1   | Header 2   | Header 3 | Header 4 |\n-- | (header rows optional) |            |          |          |\n-- +========================+============+==========+==========+\n-- | body row 1, column 1   | column 2   | column 3 | column 4 |\n-- +------------------------+------------+----------+----------+\n-- | 'tableWithHeader'      | Cells may span columns.          |\n-- +------------------------+------------+---------------------+\n-- | body row 3             | Cells may  | \\[                  |\n-- +------------------------+ span rows. | f(n) = \\sum_{i=1}   |\n-- | body row 4             |            | \\]                  |\n-- +------------------------+------------+---------------------+\nfancyTable :: a -> a\nfancyTable x = x\n", "num_lines": 48}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-----------------------------------------------------------------------------\n-- |\n-- Module      :  Test\n-- Copyright   :  (c) Simon Marlow 2002\n-- License     :  BSD-style\n--\n-- Maintainer  :  libraries@haskell.org\n-- Stability   :  provisional\n-- Portability :  portable\n--\n-- This module illustrates & tests most of the features of Haddock.\n-- Testing references from the description: 'T', 'f', 'g', 'Visible.visible'.\n--\n-----------------------------------------------------------------------------\n\n-- This is plain comment, ignored by Haddock.\n{-# LANGUAGE Rank2Types, GADTs #-}\nmodule Test (\n\n\t-- Section headings are introduced with '-- *':\n\t-- * Type declarations\n\n\t-- Subsection headings are introduced with '-- **' and so on.\n\t-- ** Data types\n\tT(..), T2, T3(..), T4(..), T5(..), T6(..),\n\tN1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..),\n\n\t-- ** Records\n\tR(..), R1(..),\n\n\t-- | test that we can export record selectors on their own:\n\tp, q, u,\n\n\t-- * Class declarations\n\tC(a,b), D(..), E, F(..),\n\n\t-- | Test that we can export a class method on its own:\n\ta,\n\n\t-- * Function types\n\tf, g,\n\n\t-- * Auxiliary stuff\n\n\t-- $aux1\n\n\t-- $aux2\n\n\t-- $aux3\n\n\t-- $aux4\n\n\t-- $aux5\n\n\t-- $aux6\n\n\t-- $aux7\n\n\t-- $aux8\n\n\t-- $aux9\n\n\t-- $aux10\n\n\t-- $aux11\n\n\t-- $aux12\n\n\t-- | This is some inline documentation in the export list\n\t--\n\t-- > a code block using bird-tracks\n\t-- > each line must begin with > (which isn't significant unless it\n\t-- > is at the beginning of the line).\n\n\t-- * A hidden module\n\tmodule Hidden,\n\n\t-- * A visible module\n\tmodule Visible,\n\n\t{-| nested-style doc comments -}\n\n\t-- * Existential \\/ Universal types\n\tEx(..),\n\n\t-- * Type signatures with argument docs\n\tk, l, m, o,\n\n\t-- * A section\n\t-- and without an intervening comma:\n\t-- ** A subsection\n\n{-|\n > a literal line\n\n $ a non /literal/ line $\n-}\n\n\tf',\n\n  withType, withoutType\n   ) where\n\nimport Hidden\nimport Visible\nimport Data.Maybe\n\nbla = Nothing\n\n-- | This comment applies to the /following/ declaration\n-- and it continues until the next non-comment line\ndata T a b\n = A Int (Maybe Float) -- ^ This comment describes the 'A' constructor\n | -- | This comment describes the 'B' constructor\n   B (T a b, T Int Float) -- ^\n\n-- | An abstract data declaration\ndata T2 a b = T2 a b\n\n-- | A data declaration with no documentation annotations on the constructors\ndata T3 a b = A1 a | B1 b\n\n-- A data declaration with no documentation annotations at all\ndata T4 a b = A2 a | B2 b\n\n-- A data declaration documentation on the constructors only\ndata T5 a b\n  = A3 a -- ^ documents 'A3'\n  | B3 b -- ^ documents 'B3'\n\n-- | Testing alternative comment styles\ndata T6\n  -- | This is the doc for 'A4'\n  = A4\n  | B4\n  | -- ^ This is the doc for 'B4'\n\n    -- | This is the doc for 'C4'\n    C4\n\n-- | A newtype\nnewtype N1 a = N1 a\n\n-- | A newtype with a fieldname\nnewtype N2 a b = N2 {n :: a b}\n\n-- | A newtype with a fieldname, documentation on the field\nnewtype N3 a b = N3 {n3 :: a b -- ^ this is the 'n3' field\n\t\t    }\n\n-- | An abstract newtype - we show this one as data rather than newtype because\n-- the difference isn\\'t visible to the programmer for an abstract type.\nnewtype N4 a b = N4 a\n\nnewtype N5 a b = N5 {n5 :: a b -- ^ no docs on the datatype or the constructor\n\t\t    }\n\nnewtype N6 a b = N6 {n6 :: a b\n\t\t    }\n\t\t -- ^ docs on the constructor only\n\n-- | docs on the newtype and the constructor\nnewtype N7 a b = N7 {n7 :: a b\n\t\t    }\n\t\t-- ^ The 'N7' constructor\n\n\nclass (D a) => C a  where\n   -- |this is a description of the 'a' method\n   a :: IO a\n   b :: [a]\n   -- ^ this is a description of the 'b' method\n   c :: a -- c is hidden in the export list\n   c = undefined\n\n-- ^ This comment applies to the /previous/ declaration (the 'C' class)\n\nclass D a where\n   d :: T a b\n   e :: (a,a)\n-- ^ This is a class declaration with no separate docs for the methods\n\ninstance D Int where\n  d = undefined\n  e = undefined\n\n-- instance with a qualified class name\ninstance Test.D Float where\n  d = undefined\n  e = undefined\n\nclass E a where\n  ee :: a\n-- ^ This is a class declaration with no methods (or no methods exported)\n\n-- This is a class declaration with no documentation at all\nclass F a where\n  ff :: a\n\n-- | This is the documentation for the 'R' record, which has four fields,\n-- 'p', 'q', 'r', and 's'.\ndata R =\n  -- | This is the 'C1' record constructor, with the following fields:\n  C1 { p :: Int -- ^ This comment applies to the 'p' field\n     , q :: forall a . a->a  -- ^ This comment applies to the 'q' field\n     , -- | This comment applies to both 'r' and 's'\n       r,s :: Int\n     }\n  | C2 { t :: T1 -> (T2 Int Int)-> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (),\n       u,v :: Int\n     }\n  -- ^ This is the 'C2' record constructor, also with some fields:\n\n-- | Testing different record commenting styles\ndata R1\n  -- | This is the 'C3' record constructor\n  = C3 {\n\t-- | The 's1' record selector\n\t  s1 :: Int\n\t-- | The 's2' record selector\n\t, s2 :: Int\n\t, s3 :: Int  -- NOTE: In the original examples/Test.hs in Haddock, there is an extra \",\" here.\n                     -- Since GHC doesn't allow that, I have removed it in this file.\n\t-- ^ The 's3' record selector\n     }\n\n-- These section headers are only used when there is no export list to\n-- give the structure of the documentation:\n\n-- * This is a section header (level 1)\n-- ** This is a section header (level 2)\n-- *** This is a section header (level 3)\n\n{-|\nIn a comment string we can refer to identifiers in scope with\nsingle quotes like this: 'T', and we can refer to modules by\nusing double quotes: \"Foo\".  We can add emphasis /like this/.\n\n   * This is a bulleted list\n\n   - This is the next item (different kind of bullet)\n\n   (1) This is an ordered list\n\n   2. This is the next item (different kind of bullet)\n\n   [cat] a small, furry, domesticated mammal\n\n   [pineapple] a fruit grown in the tropics\n\n@\n     This is a block of code, which can include other markup: 'R'\n     formatting\n               is\n                 significant\n@\n\n> this is another block of code\n\nWe can also include URLs in documentation: <http://www.haskell.org/>.\n-}\n\nf :: C a => a -> Int\n\n-- | we can export foreign declarations too\nforeign import ccall g :: Int -> IO CInt\n\n-- | this doc string has a parse error in it: \\'\nh :: Int\nh = 42\n\n\n-- $aux1 This is some documentation that is attached to a name ($aux1)\n-- rather than a source declaration.  The documentation may be\n-- referred to in the export list using its name.\n--\n-- @ code block in named doc @\n\n-- $aux2 This is some documentation that is attached to a name ($aux2)\n\n-- $aux3\n-- @ code block on its own in named doc @\n\n-- $aux4\n--\n-- @ code block on its own in named doc (after newline) @\n\n{- $aux5 a nested, named doc comment\n\n   with a paragraph,\n\n   @ and a code block @\n-}\n\n-- some tests for various arrangements of code blocks:\n\n{- $aux6\n>test\n>test1\n\n@ test2\n  test3\n@\n-}\n\n{- $aux7\n@\ntest1\ntest2\n@\n-}\n\n{- $aux8\n>test3\n>test4\n-}\n\n{- $aux9\n@\ntest1\ntest2\n@\n\n>test3\n>test4\n-}\n\n{- $aux10\n>test3\n>test4\n\n@\ntest1\ntest2\n@\n-}\n\n-- This one is currently wrong (Haddock 0.4).  The @...@ part is\n-- interpreted as part of the bird-tracked code block.\n{- $aux11\naux11:\n\n>test3\n>test4\n\n@\ntest1\ntest2\n@\n-}\n\n-- $aux12\n-- > foo\n--\n-- > bar\n--\n\n-- | A data-type using existential\\/universal types\ndata Ex a\n  = forall b . C b => Ex1 b\n  | forall b . Ex2 b\n  | forall b . C a => Ex3 b -- NOTE: I have added \"forall b\" here make GHC accept this file\n  | Ex4 (forall a . a -> a)\n\n-- | This is a function with documentation for each argument\nk :: T () () \t  -- ^ This argument has type 'T'\n  -> (T2 Int Int) -- ^ This argument has type 'T2 Int Int'\n  -> (T3 Bool Bool -> T4 Float Float) -- ^ This argument has type @T3 Bool Bool -> T4 Float Float@\n  -> T5 () ()\t  -- ^ This argument has a very long description that should\n\t\t  -- hopefully cause some wrapping to happen when it is finally\n\t\t  -- rendered by Haddock in the generated HTML page.\n  -> IO ()\t  -- ^ This is the result type\n\n-- This function has arg docs but no docs for the function itself\nl :: (Int, Int, Float) -- ^ takes a triple\n  -> Int -- ^ returns an 'Int'\n\n-- | This function has some arg docs\nm :: R\n  -> N1 ()\t-- ^ one of the arguments\n  -> IO Int\t-- ^ and the return value\n\n-- | This function has some arg docs but not a return value doc\n\n-- can't use the original name ('n') with GHC\nnewn :: R\t\t-- ^ one of the arguments, an 'R'\n     -> N1 ()\t\t-- ^ one of the arguments\n     -> IO Int\nnewn = undefined\n\n\n-- | A foreign import with argument docs\nforeign import ccall unsafe\n o :: Float  -- ^ The input float\n   -> IO Float  -- ^ The output float\n\n-- | We should be able to escape this: \\#\\#\\#\n\n-- p :: Int\n-- can't use the above original definition with GHC\nnewp :: Int\nnewp = undefined\n\n-- | a function with a prime can be referred to as 'f''\n-- but f' doesn't get link'd 'f\\''\nf' :: Int\n\n-- | Comment on a definition without type signature\nwithoutType = undefined\n\n-- | Comment on a definition with type signature\nwithType :: Int\nwithType = 1\n\n-- Add some definitions here so that this file can be compiled with GHC\n\ndata T1\nf = undefined\nf' = undefined\ntype CInt = Int\nk = undefined\nl = undefined\nm = undefined\n", "num_lines": 424}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH where\n\nimport Language.Haskell.TH\n\ndecl :: Q [Dec]\ndecl = [d| f x = x|]\n", "num_lines": 9}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule TH2 where\n\nimport TH\n\n$( decl )\n", "num_lines": 8}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TemplateHaskell #-}\n\n-- | Ensures haddock built with @-threaded@.\nmodule Threaded where\n\nimport Threaded_TH\n\n-- | @$(forkTH)@ fails at compile time if haddock isn't using the\n-- threaded RTS.\nf = $(forkTH)\n", "num_lines": 11}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- | Imported by 'Threaded', since a TH splice can't be used in the\n-- module where it is defined.\nmodule Threaded_TH where\n\nimport Control.Concurrent (forkOS)\nimport Language.Haskell.TH.Syntax (Exp (LitE), Lit (IntegerL), Q, runIO)\n\n-- | forkOS requires the threaded RTS, so this TH fails if haddock was\n-- built without @-threaded@.\nforkTH :: Q Exp\nforkTH = do\n  _ <- runIO (forkOS (return ()))\n  return (LitE (IntegerL 0))\n", "num_lines": 14}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE MagicHash #-}\n\nmodule Ticket112 where\n\nimport GHC.Prim\n\n-- | ...given a raw 'Addr#' to the string, and the length of the string.\nf :: a\nf = undefined\n", "num_lines": 10}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Ticket61 (module Ticket61_Hidden) where\n\nimport Ticket61_Hidden\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# OPTIONS_HADDOCK hide #-}\n\nmodule Ticket61_Hidden where\n\nclass C a where\n  -- | A comment about f\n  f :: a\n", "num_lines": 8}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators #-}\nmodule Ticket75 where\n\ndata a :- b = Q\n\n-- | A reference to ':-'\nf :: Int\nf = undefined\n", "num_lines": 9}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies, UndecidableInstances, PolyKinds, TypeOperators, DataKinds, MultiParamTypeClasses, GADTs #-}\n\n-- | Doc for: module TypeFamilies\nmodule TypeFamilies where\n\nimport qualified TypeFamilies2 as TF\n\n-- | Doc for: data X\ndata X\n  = X   -- ^ Doc for: X\n  | XX  -- ^ Doc for: XX\n  | XXX -- ^ Doc for: XXX\n\n-- | Doc for: data Y\ndata Y\n\n-- | Doc for: data Z\ndata Z = ZA | ZB\n\n-- | Doc for: class Test a\nclass Test a\n\n-- | Doc for: instance Test X\ninstance Test X\n-- | Doc for: instance Test Y\ninstance Test Y\n\n-- | Doc for: type family Foo a\ntype family Foo a :: k\n\n-- | Doc for: type instance Foo X = Y\ntype instance Foo X = Y\n-- | Doc for: type instance Foo Y = X\ntype instance Foo Y = X\n\n-- | Doc for: data family Bat a\ndata family Bat (a :: k) :: *\n\n-- | Doc for: data instance Bat X\ndata instance Bat X\n  = BatX X -- ^ Doc for: BatX X\n  | BatXX { aaa :: X , bbb :: Y } -- ^ Doc for: BatXX { ... }\n\n-- | Doc for: data instance Bat Y\ndata instance Bat Y = BatY Y -- ^ Doc for: BatY Y\n\n-- | Doc for: data instance Bat Z\ndata instance Bat (z :: Z) where\n  BatZ1 :: Z -> Bat ZA\n  BatZ2 :: { batx :: X, baty :: Y } -> Bat ZB\n\n-- | Doc for: class Assoc a\nclass Assoc a where\n  -- | Doc for: data AssocD a\n  data AssocD a :: *\n  -- | Doc for: type AssocT a\n  type AssocT a :: *\n\n-- | Doc for: instance Assoc X\ninstance Assoc X where\n  -- | Doc for: data AssocD X = AssocX\n  data AssocD X = AssocX -- ^ Doc for: AssocX\n  -- | Doc for: type AssocT X = Foo X\n  type AssocT X = Foo X\n\n-- | Doc for: instance Assoc Y\ninstance Assoc Y where\n  -- | Doc for: data AssocD Y = AssocY\n  data AssocD Y = AssocY -- ^ Doc for: AssocY\n  -- | Doc for: type AssocT Y = Bat Y\n  type AssocT Y = Bat Y\n\n-- | Doc for: type family Bar b\ntype family Bar b where\n  Bar X = X\n  Bar y = Y\n\ntype family (<>) (a :: k) (b :: k) :: k\n\ntype instance X <> a = X\ntype instance Y <> a = a\n\ntype instance XXX <> XX = 'X\n\nclass (><) (a :: k) (b :: k)\ninstance XX >< XXX\n\n-- | External instance\n\ntype instance TF.Foo X = Y\n\ndata instance TF.Bar Y\n", "num_lines": 93}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n-- This tests what happens if we have unexported types\n-- in type instances. The expected behaviour is\n-- that we get the instance, Y is not linked and\n-- Haddock shows a linking warning.\n--\n-- The other families and instances that are not exported should not\n-- show up at all\nmodule TypeFamilies2 (W, Foo, Bar) where\n\n-- | Exported type\ndata W\n\n-- | Hidden type\ndata Z\n\n-- | Exported type family\ntype family Foo a\n\n-- | Should be visible, but with a hidden right hand side\ntype instance Foo W = Z\n\n-- | Should be hidden\ntype instance Foo Z = W\n\n-- | Exported data family\ndata family Bar a\n\n-- | Shown because BarX is still exported despite Z being hidden\ndata instance Bar W = BarX Z\n\n-- | Should be completely invisible, including instances\ntype family Invisible a\ntype instance Invisible W = Z\ntype instance Invisible Z = W\n\ndata family Invisible2 a\ndata instance Invisible2 W = Invis  Z\ndata instance Invisible2 Z = Invis' W\n", "num_lines": 40}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeOperators, GADTs, MultiParamTypeClasses, FlexibleContexts #-}\nmodule TypeOperators where\n\ndata a :-: b\n\ndata (a :+: b) c\n\ndata a `Op` b\n\nnewtype (g `O` f) a = O { unO :: g (f a) }\n\nclass a <=> b\n\nbiO :: (g `O` f) a\nbiO = undefined\n\nf :: (a ~ b) => a -> b\nf = id\n\ng :: (a ~ b, b ~ c) => a -> c\ng = id\n\nx :: ((a :-: a) <=> (a `Op` a)) => a\nx = undefined\n\ny :: (a <=> a, (a `Op` a) <=> a) => a\ny = undefined\n", "num_lines": 28}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Unicode where\n\n-- | \u00ce\u00b3\u00ce\u00bb\u00cf\u017d\u00cf\u0192\u00cf\u0192\u00ce\u00b1\nx :: Int\nx = 1\n\n", "num_lines": 7}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Unicode2 where\n\n-- | All of the following work with a unicode character \u00c3\u00bc:\n--\n--   * an italicized /\u00c3\u00bc/\n--   \n--   * inline code @\u00c3\u00bc@\n--\n--   * a code block:\n--\n--   > \u00c3\u00bc\n--\n--   * a url <https://www.google.com/search?q=\u00c3\u00bc>\n-- \n--   * a link to '\u00c3\u00bc'\n--\n\u00c3\u00bc :: ()\n\u00c3\u00bc = ()\n", "num_lines": 19}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Visible where\nvisible :: Int -> Int\nvisible a = a\n", "num_lines": 4}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n\nimport Data.Char\nimport Data.List\nimport Data.Function (on)\n\nimport System.Environment\nimport System.FilePath\n\nimport Test.Haddock\nimport Test.Haddock.Xhtml\n\n\ncheckConfig :: CheckConfig Xml\ncheckConfig = CheckConfig\n    { ccfgRead = parseXml\n    , ccfgClean = \\_ -> strip\n    , ccfgDump = dumpXml\n    , ccfgEqual = (==) `on` dumpXml\n    }\n  where\n    strip = stripAnchors' . stripLinks' . stripFooter\n    stripLinks' = stripLinksWhen $ \\href -> \"#local-\" `isPrefixOf` href\n    stripAnchors' = stripAnchorsWhen $ \\name -> \"local-\" `isPrefixOf` name\n\n\ndirConfig :: DirConfig\ndirConfig = (defaultDirConfig $ takeDirectory __FILE__)\n    { dcfgCheckIgnore = checkIgnore\n    }\n\n\nmain :: IO ()\nmain = do\n    cfg <- parseArgs checkConfig dirConfig =<< getArgs\n    runAndCheck $ cfg\n        { cfgHaddockArgs = cfgHaddockArgs cfg ++\n            [ \"--pretty-html\"\n            , \"--hyperlinked-source\"\n            ]\n        }\n\n\ncheckIgnore :: FilePath -> Bool\ncheckIgnore file\n    | and . map ($ file) $ [isHtmlFile, isSourceFile, isModuleFile] = False\n  where\n    isHtmlFile = (== \".html\") . takeExtension\n    isSourceFile = (== \"src\") . takeDirectory\n    isModuleFile = isUpper . head . takeBaseName\ncheckIgnore _ = True\n", "num_lines": 53}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Classes where\n\n\nclass Foo a where\n    bar :: a -> Int\n    baz :: Int -> (a, a)\n\ninstance Foo Int where\n    bar = id\n    baz x = (x, x)\n\ninstance Foo [a] where\n    bar = length\n    baz _ = ([], [])\n\n\nclass Foo a => Foo' a where\n    quux :: (a, a) -> a\n    quux (x, y) = norf [x, y]\n\n    norf :: [a] -> a\n    norf = quux . baz . sum . map bar\n\ninstance Foo' Int where\n    norf = sum\n\ninstance Foo' [a] where\n    quux = uncurry (++)\n\n\nclass Plugh p where\n    plugh :: p a a -> p b b -> p (a -> b) (b -> a)\n\ninstance Plugh Either where\n    plugh (Left a) _ = Right $ const a\n    plugh (Right a) _ = Right $ const a\n    plugh _ (Left b) = Left $ const b\n    plugh _ (Right b) = Left $ const b\n", "num_lines": 39}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Constructors where\n\n\ndata Foo\n    = Bar\n    | Baz\n    | Quux Foo Int\n\nnewtype Norf = Norf (Foo, [Foo], Foo)\n\n\nbar, baz, quux :: Foo\nbar = Bar\nbaz = Baz\nquux = Quux quux 0\n\n\nunfoo :: Foo -> Int\nunfoo Bar = 0\nunfoo Baz = 0\nunfoo (Quux foo n) = 42 * n + unfoo foo\n\n\nunnorf :: Norf -> [Foo]\nunnorf (Norf (Bar, xs, Bar)) = xs\nunnorf (Norf (Baz, xs, Baz)) = reverse xs\nunnorf _ = undefined\n\n\nunnorf' :: Norf -> Int\nunnorf' x@(Norf (f1@(Quux _ n), _, f2@(Quux f3 _))) =\n    x' + n * unfoo f1 + aux f3\n  where\n    aux fx = unfoo f2 * unfoo fx * unfoo f3\n    x' = sum . map unfoo . unnorf $ x\n", "num_lines": 36}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\nmodule CPP where\n\n#define SOMETHING1\n\nfoo :: String\nfoo = {-  \" single quotes are fine in block comments\n          {- nested block comments are fine -}\n       -} \"foo\"\n\n#define SOMETHING2\n\nbar :: String\nbar = \"block comment in a string is not a comment {- \"\n\n#define SOMETHING3\n\n-- \" single quotes are fine in line comments\n-- {- unclosed block comments are fine in line comments\n\n-- Multiline CPP is also fine\n#define FOO\\\n  1\n\nbaz :: String\nbaz = \"line comment in a string is not a comment --\"\n", "num_lines": 27}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Identifiers where\n\n\nfoo, bar, baz :: Int -> Int -> Int\nfoo x y = x + x * bar y x * y + y\nbar x y = y + x - baz x y - x + y\nbaz x y = x * y * y * y * x\n\nquux :: Int -> Int\nquux x = foo (bar x x) (bar x x)\n\nnorf :: Int -> Int -> Int -> Int\nnorf x y z\n    | x < 0 = quux x\n    | y < 0 = quux y\n    | z < 0 = quux z\n    | otherwise = norf (-x) (-y) (-z)\n\n\nmain :: IO ()\nmain = do\n    putStrLn . show $ foo x y\n    putStrLn . show $ quux z\n    putStrLn . show $ Identifiers.norf x y z\n  where\n    x = 10\n    y = 20\n    z = 30\n", "num_lines": 29}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Literals where\n\n\nstr :: String\nstr = \"str literal\"\n\nnum :: Num a => a\nnum = 0 + 1 + 1010011 * 41231 + 12131\n\nfrac :: Fractional a => a\nfrac = 42.0000001\n\nlist :: [[[[a]]]]\nlist = [[], [[]], [[[]]]]\n\npair :: ((), ((), (), ()), ())\npair = ((), ((), (), ()), ())\n", "num_lines": 18}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Operators where\n\n\n(+++) :: [a] -> [a] -> [a]\na +++ b = a ++ b ++ a\n\n($$$) :: [a] -> [a] -> [a]\na $$$ b = b +++ a\n\n(***) :: [a] -> [a] -> [a]\n(***) a [] = a\n(***) a (_:b) = a +++ (a *** b)\n\n(*/\\*) :: [[a]] -> [a] -> [a]\na */\\* b = concatMap (*** b) a\n\n(**/\\**) :: [[a]] -> [[a]] -> [[a]]\na **/\\** b = zipWith (*/\\*) [a +++ b] (a $$$ b)\n\n\n(#.#) :: a -> b -> (c -> (a, b))\na #.# b = const $ (a, b)\n", "num_lines": 23}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\n\nmodule Polymorphism where\n\n\nfoo :: a -> a -> a\nfoo = undefined\n\nfoo' :: forall a. a -> a -> a\nfoo' = undefined\n\nbar :: a -> b -> (a, b)\nbar = undefined\n\nbar' :: forall a b. a -> b -> (a, b)\nbar' = undefined\n\nbaz :: a -> (a -> [a -> a] -> b) -> b\nbaz = undefined\n\nbaz' :: forall a b. a -> (a -> [a -> a] -> b) -> b\nbaz' = undefined\n\nquux :: a -> (forall a. a -> a) -> a\nquux x f = f x\n\nquux' :: forall a. a -> (forall a. a -> a) -> a\nquux' x f = f x\n\n\nnum :: Num a => a -> a -> a\nnum = undefined\n\nnum' :: forall a. Num a => a -> a -> a\nnum' = undefined\n\neq :: (Eq a, Eq b) => [a] -> [b] -> (a, b)\neq = undefined\n\neq' :: forall a b. (Eq a, Eq b) => [a] -> [b] -> (a, b)\neq' = undefined\n\nmon :: Monad m => (a -> m a) -> m a\nmon = undefined\n\nmon' :: forall m a. Monad m => (a -> m a) -> m a\nmon' = undefined\n\n\nnorf :: a -> (forall a. Ord a => a -> a) -> a\nnorf x f = x\n\nnorf' :: forall a. a -> (forall a. Ord a => a -> a) -> a\nnorf' x f = x\n\n\nplugh :: forall a. a -> a\nplugh x = x :: a\n\nthud :: forall a b. (a -> b) -> a -> (a, b)\nthud f x =\n    (x :: a, y) :: (a, b)\n  where\n    y = (f :: a -> b) x :: b\n", "num_lines": 67}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE NamedFieldPuns #-}\n{-# LANGUAGE RecordWildCards #-}\n\n\nmodule Records where\n\n\ndata Point = Point\n    { x :: !Int\n    , y :: !Int\n    }\n\n\npoint :: Int -> Int -> Point\npoint x y = Point { x = x, y = y }\n\n\nlengthSqr :: Point -> Int\nlengthSqr (Point { x = x, y = y }) = x * x + y * y\n\nlengthSqr' :: Point -> Int\nlengthSqr' (Point { x, y }) = y * y + x * x\n\n\ntranslateX, translateY :: Point -> Int -> Point\ntranslateX p d = p { x = x p + d }\ntranslateY p d = p { y = y p + d }\n\ntranslate :: Int -> Int -> Point -> Point\ntranslate x y p =\n    aux p\n  where\n    (dx, dy) = (x, y)\n    aux Point{..} = p { x = x + dx, y = y + dy }\n", "num_lines": 35}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE TypeFamilies #-}\n\n\nmodule Types where\n\n\ndata Quux = Bar | Baz\n\nnewtype Foo = Foo ()\n\ntype FooQuux = (Foo, Quux)\ntype QuuxFoo = (Quux, Foo)\n\n\ndata family Norf a b\n\ndata instance Norf Foo Quux = NFQ Foo Quux\ndata instance Norf Quux Foo = NQF Quux Foo\n\n\ntype family Norf' a b\n\ntype instance Norf' Foo Quux = (Foo, Quux)\ntype instance Norf' Quux Foo = (Quux, Foo)\n\n\nnorf1 :: Norf Foo Quux -> Int\nnorf1 (NFQ (Foo ()) Bar) = 0\nnorf1 (NFQ (Foo ()) Baz) = 1\n\nnorf2 :: Norf Quux Foo -> Int\nnorf2 (NQF Bar (Foo ())) = 0\nnorf2 (NQF Baz (Foo ())) = 1\n\n\nnorf1' :: Norf' Foo Quux -> Int\nnorf1' (Foo (), Bar) = 0\nnorf1' (Foo (), Baz) = 1\n\nnorf2' :: Norf' Quux Foo -> Int\nnorf2' (Bar, Foo ()) = 0\nnorf2' (Baz, Foo ()) = 1\n", "num_lines": 43}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE CPP #-}\n\n\nimport Data.Function\nimport System.Environment\nimport System.FilePath\n\nimport Test.Haddock\nimport Test.Haddock.Utils\n\n\ncheckConfig :: CheckConfig String\ncheckConfig = CheckConfig\n    { ccfgRead = Just\n    , ccfgClean = \\_ -> id\n    , ccfgDump = id\n    , ccfgEqual = (==) `on` crlfToLf\n    }\n\n\ndirConfig :: DirConfig\ndirConfig = defaultDirConfig $ takeDirectory __FILE__\n\n\nmain :: IO ()\nmain = do\n    cfg <- parseArgs checkConfig dirConfig =<< getArgs\n    runAndCheck $ cfg\n        { cfgHaddockArgs = cfgHaddockArgs cfg ++ [\"--latex\"]\n        }\n", "num_lines": 31}
{"repo_name": "fbhaddock", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module Simple (foo) where\n\n-- | This is foo.\nfoo :: t\nfoo = undefined\n", "num_lines": 6}
{"repo_name": "flipper", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env stack\n{-\n  Copyright (c) Meta Platforms, Inc. and affiliates.\n\n  This source code is licensed under the MIT license found in the\n  LICENSE file in the root directory of this source tree.\n-}\n\n-- stack --resolver lts-9.0 --install-ghc runghc --package turtle --package system-filepath --package pseudomacros --package megaparsec --package bifunctors\n\n{-\n\nThis script verifies that for a given version number, all Flipper artifacts were\nsuccessfully uploaded to Bintray. Due to service flakiness, sometimes one or\nmore artifacts don't actually end up getting published and we want to have\nan automated way to check whether or not an upload succeded.\n\nThis script works by simply passing it the version number you want to check.\nOn Mac OS you may also need to disable IPv6 because reasons.\n\n  scripts/verify-bintray-upload.hs 0.5.0\n\nOr with disabling the IPv6 stack in the JVM:\n\n  env JAVA_TOOL_OPTIONS=\"-Djava.net.preferIPv6Addresses=false\" scripts/verify-bintray-upload.hs 0.5.0\n\n-}\n\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ViewPatterns #-}\n\nimport Prelude hiding (FilePath)\nimport Turtle\n\nimport Control.Arrow ((>>>))\nimport Data.Bifunctor (first)\nimport Data.Maybe (fromMaybe, catMaybes)\nimport Data.List.NonEmpty (fromList)\nimport PseudoMacros (__FILE__)\n\nimport qualified Filesystem.Path.CurrentOS as Path\nimport qualified Control.Monad.Managed as Managed\nimport qualified Text.Megaparsec.Text as MT\nimport qualified Text.Megaparsec as M\nimport qualified Data.Text as T\nimport qualified Control.Foldl as Fold\n\n-- * Global settings\n\ndata RemoteRepository = RemoteRepository\n  { repoId :: Text\n  , repoLayout :: Maybe Text\n  , repoUrl :: Text }\n\nremoteRepositoryToString :: RemoteRepository -> Text\nremoteRepositoryToString RemoteRepository{..} =\n  T.intercalate \"::\"\n    [ repoId\n    , fromMaybe \"\" repoLayout\n    , repoUrl\n    ]\n\nremoteRepositories :: [RemoteRepository]\nremoteRepositories =\n  [ RemoteRepository \"jcenter\" Nothing \"https://jcenter.bintray.com/\"\n  , RemoteRepository \"google\" Nothing \"https://maven.google.com/\"\n  ]\n\n-- * Application logic\n\nnewtype Version = Version Text\n\n-- | Strip a leading 'v' if present and wrap in a newtype.\nparseVersion :: Text -> Version\nparseVersion (T.stripPrefix \"v\" -> Just v) = Version v\nparseVersion v                             = Version v\n\nparser :: Turtle.Parser Version\nparser = parseVersion <$> argText \"VERSION\" \"Version number to verify\"\n\ndata MvnArtifact = MvnArtifact\n  { mvnArtifactId :: Text\n  , mvnPackaging :: Text\n  } deriving Show\n\n-- | Provide a path to the directory this very file resides in through some\n-- arcane magic.\nthisDirectory :: IO FilePath\nthisDirectory = do\n  let filePath :: FilePath = $__FILE__\n  currentDir <- pwd\n  return . Path.parent $ currentDir </> filePath\n\nmkFakeMavenSettings\n  :: Managed.MonadManaged m\n  => m FilePath\nmkFakeMavenSettings = do\n  mavenTmp <- using (mktempdir \"/tmp\" \"fbm2\")\n  output (mavenTmp </> \"settings.xml\") $\n    \"<settings>\" <|> (\"<localRepository>\" <> pure (unsafeTextToLine (format fp mavenTmp)) <>  \"</localRepository>\") <|> \"</settings>\"\n  return mavenTmp\n\nparseMvnArtifact :: Text -> Either Text MvnArtifact\nparseMvnArtifact = M.parse (mvnParser <* M.eof) \"<input>\" >>> first (T.pack . M.parseErrorPretty)\n  where\n    pomParser :: MT.Parser (Text, Text)\n    pomParser = do\n      identifier <- T.strip . T.pack <$> M.someTill M.printChar (M.char '=')\n      M.space\n      value <- T.strip . T.pack <$> M.some M.printChar\n\n      return (identifier, value)\n\n    emptyLineParser :: forall a. MT.Parser (Maybe a)\n    emptyLineParser = M.some M.spaceChar >> M.optional M.newline *> pure Nothing\n\n    commentParser :: forall a. MT.Parser (Maybe a)\n    commentParser = M.char '#' >> M.manyTill M.anyChar M.newline *> pure Nothing\n\n    mvnParser :: MT.Parser MvnArtifact\n    mvnParser = do\n      pomItems <- M.many $ (commentParser <|> (Just <$> pomParser) <* M.eol) <|> emptyLineParser\n      case reducePomTokens (catMaybes pomItems) of\n        Just a -> return a\n        Nothing -> M.unexpected (M.Label $ fromList \"Missing POM identifiers.\")\n\n    reducePomTokens :: [(Text, Text)] -> Maybe MvnArtifact\n    reducePomTokens ts = do\n      mvnArtifactId <- lookup \"POM_ARTIFACT_ID\" ts\n      mvnPackaging <- lookup \"POM_PACKAGING\" ts\n      return MvnArtifact{..}\n\nmvnArtifactToVersionedIdentifier :: MvnArtifact -> Text -> Text\nmvnArtifactToVersionedIdentifier MvnArtifact{..} version =\n  format (\"com.facebook.flipper:\"%s%\":\"%s%\":\"%s) mvnArtifactId version mvnPackaging\n\nbuildMvnGetCommand :: MvnArtifact -> Version -> FilePath -> (T.Text, [T.Text])\nbuildMvnGetCommand artifact (Version version) configDir =\n  ( \"mvn\"\n  , [ \"dependency:get\"\n    , \"-gs\"\n    , format fp (configDir </> \"settings.xml\")\n    , \"-Dartifact=\" <> (mvnArtifactToVersionedIdentifier artifact version)\n    , \"-DremoteRepositories=\" <> T.intercalate \",\" (remoteRepositoryToString <$> remoteRepositories)\n    -- Would be nice to also check transitive deps, but mvn get doesn't support resolving transitive AARs.\n    , \"-Dtransitive=false\"]\n  )\n\n-- | Ensure that the given directory sits at least one\n--   level deep inside the given prefix.\nisSubDir :: FilePath -> FilePath -> Bool\nisSubDir prefix' path =\n  stripPrefix prefix' path & \\case\n    Just dir -> length (splitDirectories dir) > 1\n    Nothing -> False\n\nfoldResult :: FoldM IO (Maybe (MvnArtifact, Bool)) Bool\nfoldResult = FoldM step (pure True) pure\n    where\n        step _ (Just (mvnArtifact, False)) =\n          printf (\"Failed to download artifact \"%w%\".\\n\") mvnArtifact >> return False\n        step prev _ =\n          return prev\n\nmain :: IO ()\nmain = do\n  version <- options \"Bintray Upload Verifier\" parser\n  this <- thisDirectory\n  rootDir <- realpath $ this </> \"..\"\n\n  whichMvn <- which \"mvn\"\n  case whichMvn of\n    Just _ -> return ()\n    Nothing -> die \"This tool requires `mvn` (Apache Maven) to be on your $PATH.\"\n\n  let parseProg = do\n      gradleProperties :: FilePath <- realpath =<< find (suffix \"/gradle.properties\") rootDir\n      guard $ isSubDir rootDir gradleProperties\n      contents <- liftIO $ readTextFile gradleProperties\n      case parseMvnArtifact contents of\n        Left err' -> do\n          printf (\"Skipping unsupported file '\"%fp%\"' because of error \"%s%\".\\n\") gradleProperties err'\n          return Nothing\n        Right mvnArtifact -> do\n          printf (\"Downloading Maven artifact for \"%w%\" ...\\n\") mvnArtifact\n          return $ Just mvnArtifact\n\n  let runProg mvnArtifact = do\n      mavenTmp <- mkFakeMavenSettings\n      let (cmd, args) = buildMvnGetCommand mvnArtifact version mavenTmp\n      ret <- proc cmd args empty\n      case ret of\n        ExitSuccess ->\n          return (mvnArtifact, True)\n        ExitFailure code -> do\n          return (mvnArtifact, False)\n\n  artifacts :: [MvnArtifact] <- catMaybes <$> fold parseProg Fold.list\n  foldIO (parallel (flip fold Fold.head . runProg <$> artifacts)) foldResult >>= \\case\n     True -> do\n       echo \"All artifacts seem to have been uploaded. Sweet!\"\n       exit ExitSuccess\n     False -> do\n       err \"ERROR: Some artifacts are missing from Bintray!\"\n       exit $ ExitFailure 1\n\n", "num_lines": 212}
{"repo_name": "flipper", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env stack\n{-\n  Copyright (c) Meta Platforms, Inc. and affiliates.\n\n  This source code is licensed under the MIT license found in the\n  LICENSE file in the root directory of this source tree.\n-}\n\n-- stack --resolver lts-14.7 --install-ghc runghc --package turtle --package system-filepath --package foldl\n\n{-# OPTIONS_GHC -fno-warn-name-shadowing #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nimport Prelude hiding (FilePath)\nimport Turtle\n\nimport Data.Maybe (catMaybes)\nimport Control.Monad (forM_)\n\nimport qualified Filesystem.Path.CurrentOS as Path\nimport qualified Data.Text as T\nimport qualified Control.Foldl as F\n\n-- * Global settings\n\nreleaseReplacements :: [(FilePath, Pattern Version)]\nreleaseReplacements =\n  [(\"gradle.properties\", \"VERSION_NAME=\" *> anyVersion)\n  ,(\"docs/getting-started/android-native.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper:\" *> releaseVersion <* \"'\")\n  ,(\"docs/getting-started/android-native.mdx\", spaces >> \"releaseImplementation 'com.facebook.flipper:flipper-noop:\" *> releaseVersion <* \"'\")\n  ,(\"docs/getting-started/react-native-android.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper:\" *> releaseVersion <* \"'\")\n  ,(\"docs/getting-started/react-native-android.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper-network-plugin:\" *> releaseVersion <* \"'\")\n  ,(\"desktop/plugins/public/leak_canary/docs/setup.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper-leakcanary2-plugin:\" *> releaseVersion <* \"'\")\n  ,(\"desktop/plugins/public/layout/docs/setup.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper-litho-plugin:\" *> releaseVersion <* \"'\")\n  ,(\"desktop/plugins/public/network/docs/setup.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper-network-plugin:\" *> releaseVersion <* \"'\")\n  ,(\"desktop/plugins/public/fresco/docs/setup.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper-images-plugin:\" *> releaseVersion <* \"'\")\n  ,(\"docs/getting-started/react-native-ios.mdx\", spaces >> \"use_flipper!('Flipper' => '\" *> releaseVersion <* \"')\" <* many anyChar)\n  ,(\"docs/getting-started/react-native-ios.mdx\", spaces >> \"flipperkit_version = '\" *> releaseVersion <* \"'\" <* many anyChar)\n  ,(\"docs/getting-started/react-native.mdx\", many anyChar >> \"`FLIPPER_VERSION=\" *> releaseVersion <* \"`.\")\n  ,(\"docs/getting-started/react-native.mdx\", many anyChar >> \"`use_flipper!({ 'Flipper' => '\" *> releaseVersion <* \"' })`.\")\n  ]\n\nsnapshotReplacements :: [(FilePath, Pattern Version)]\nsnapshotReplacements =\n  [(\"gradle.properties\", \"VERSION_NAME=\" *> anyVersion)\n  ,(\"docs/getting-started/android-native.mdx\", spaces >> \"debugImplementation 'com.facebook.flipper:flipper:\" *> snapshotVersion <* \"'\")\n  ,(\"docs/getting-started/android-native.mdx\", spaces >> \"releaseImplementation 'com.facebook.flipper:flipper-noop:\" *> snapshotVersion <* \"'\")\n  ]\n\nflipperPath :: FilePath -> FilePath\nflipperPath basePath =\n  basePath </> \"xplat\" </> \"sonar\"\n\n-- * Patterns\n\nreleaseVersion :: Pattern Version\nreleaseVersion =\n  Version <$> plus digit <> \".\" <> plus digit <> \".\" <> plus digit\n\nsnapshotVersion :: Pattern Version\nsnapshotVersion =\n  Version <$> plus digit <> \".\" <> plus digit <> \".\" <> plus digit <> \"-SNAPSHOT\"\n\nanyVersion :: Pattern Version\nanyVersion =\n  Version <$> plus digit <> \".\" <> plus digit <> \".\" <> plus (char '-' <|> alphaNum)\n\n-- * Application logic\n\nnewtype Version = Version Text\n  deriving (Show, Eq)\n\nunversion (Version v) = v\n\ndata BumpMode = ModeRelease | ModeSnapshot\n  deriving (Show, Eq)\n\ndata BumpArguments = BumpArguments\n  { argVersion :: Version\n  , argMode :: BumpMode\n  } deriving (Show, Eq)\n\nparser :: Turtle.Parser BumpArguments\nparser = BumpArguments\n  <$> (Version <$> argText \"version\" \"Version to bump to, e.g. 1.0.2\")\n  <*> ((\\b -> if b then ModeSnapshot else ModeRelease) <$> switch \"snapshot\" 's' \"Change SNAPSHOT references instead of release ones\")\n\n-- | Find the root of the project, indicated by the presence of a \".hg\" folder.\nfindProjectRoot :: FilePath -> IO (Maybe FilePath)\nfindProjectRoot dir = go $ Path.splitDirectories dir\n  where\n        go :: forall (m :: * -> *).\n              MonadIO m =>\n              [FilePath] -> m (Maybe FilePath)\n        go []     = return Nothing\n        go ds     = do\n          let ds'  = init ds\n              dir' = Path.concat ds'\n              hg   = dir' </> \".hg\"\n          hgExists <- testdir hg\n          if hgExists then\n            return $ Just dir'\n          else\n            go ds'\n\nreplaceLine :: Version -> Pattern Version -> Pattern Version -> Line -> Shell Line\nreplaceLine newVersion matcher pttrn l =\n  if match pttrn (lineToText l) == empty then pure l\n  else sed (unversion newVersion <$ anyVersion) $ pure l\n\nmain :: IO ()\nmain = do\n  args <- options \"Flipper Version Bumper\" parser\n  let newVersion = argVersion args\n  let (versionMatcher, replacements) = case argMode args of\n        ModeRelease -> (releaseVersion, releaseReplacements)\n        ModeSnapshot -> (snapshotVersion, snapshotReplacements)\n\n  let isVersionValid = match versionMatcher (unversion newVersion)\n  when (null isVersionValid) $ do\n    printf (\"Invalid version specified: \"%w%\".\\n\") newVersion\n    exit $ ExitFailure 2\n\n  projectRoot <- findProjectRoot =<< pwd\n  let flipperDir = flipperPath <$> projectRoot\n  flipperDir_ <- case flipperDir of\n        Just f -> pure f\n        Nothing -> die \"Couldn't determine flipper location.\"\n\n  printf (\"Starting bump to \"%w%\".\\n\") newVersion\n  forM_ replacements $ \\(path, pttrn) -> do\n      let absPath = flipperDir_ </> path\n      printf (\"Updating version in \"%w%\"\\n\") absPath\n      lines <- T.lines <$> readTextFile absPath\n      newLines :: [Line] <- flip fold F.mconcat . sequence $ replaceLine newVersion versionMatcher pttrn <$> catMaybes (textToLine <$> lines)\n      writeTextFile absPath . T.unlines $ lineToText <$> newLines\n  echo \"Done!\"\n", "num_lines": 141}
{"repo_name": "flipper", "repo_creator": "facebook", "programming_language": "Haskell", "code": "#!/usr/bin/env stack\n{-\n  Copyright (c) Meta Platforms, Inc. and affiliates.\n\n  This source code is licensed under the MIT license found in the\n  LICENSE file in the root directory of this source tree.\n-}\n\n-- stack --resolver lts-14.3 --install-ghc runghc --package turtle --package system-filepath --package foldl --package typed-process --package bytestring\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nimport Prelude hiding (FilePath)\nimport Turtle\n\nimport Data.Maybe (catMaybes)\nimport Control.Monad (forM_)\nimport Data.List ((\\\\))\n\nimport qualified Filesystem.Path.CurrentOS as Path\nimport qualified System.Process.Typed as Proc\nimport qualified Data.Text as T\nimport qualified Control.Foldl as F\nimport qualified Data.ByteString.Char8 as C\nimport qualified Data.ByteString as BS\nimport qualified Data.ByteString.Lazy as BSL\n\n-- * Global settings\n\nflipperPath :: FilePath -> FilePath\nflipperPath basePath =\n  basePath </> \"xplat\" </> \"sonar\"\n\n-- * Application logic\n\n-- | Find the root of the project, indicated by the presence of a \".hg\" folder.\nfindProjectRoot :: FilePath -> IO (Maybe FilePath)\nfindProjectRoot dir = go $ Path.splitDirectories dir\n  where\n        go :: forall (m :: * -> *).\n              MonadIO m =>\n              [FilePath] -> m (Maybe FilePath)\n        go []     = return Nothing\n        go ds     = do\n          let ds'  = init ds\n              dir' = Path.concat ds'\n              hg   = dir' </> \".hg\"\n          hgExists <- testdir hg\n          if hgExists then\n            return $ Just dir'\n          else\n            go ds'\n\ndata TSCResult = TSCResult\n  { numErrors :: Int\n  , errors    :: [BS.ByteString]\n  } deriving (Show, Eq)\n\nrunTSC :: FilePath -> Shell TSCResult\nrunTSC root = do\n  cd root\n  (exitCode, stdout, stderr) <- liftIO $ Proc.readProcess (Proc.proc \"yarn\" [\"run\", \"tsc\", \"--strict\"])\n  let errors = C.split '\\n' (BSL.toStrict stdout) & filter (BS.isInfixOf \": error TS\")\n  pure $ TSCResult { numErrors = length errors\n                   , errors = errors\n                   }\n\nhgPrev :: Shell ()\nhgPrev = procs \"hg\" [\"prev\"] mempty\n\nhgNext :: Shell ()\nhgNext = procs \"hg\" [\"next\"] mempty\n\nhandleErr :: IO ExitCode\nhandleErr = err \"Failed to run hg/tsc. Check above output.\" >> (pure $ ExitFailure 2)\n\nhandleRes :: TSCResult -> TSCResult -> IO ExitCode\nhandleRes cur prev = do\n  let delta = numErrors cur - numErrors prev\n  if delta > 0 then do\n    eprintf (\"TSC Strict Mode regression. \"%d%\" new violations introduced:\\n\") delta\n    forM_ (errors cur \\\\ errors prev) $ eprintf (\"- \"%w%\"\\n\")\n    eprintf \"Please visit https://fburl.com/strictflipper for more information.\\n\"\n    return $ ExitFailure 1\n  else do\n    printf (\"TSC Strict Mode test passed. Delta: \"%d%\"\\n\") delta\n    return ExitSuccess\n\nmain :: IO ()\nmain = do\n  projectRoot <- findProjectRoot =<< pwd\n  let flipperDir = flipperPath <$> projectRoot\n  flipperDir_ <- case flipperDir of\n        Just f -> realpath f\n        Nothing -> die \"Couldn't determine Flipper project location.\"\n\n  printf \"Running tsc --strict against current revision.\\n\"\n  currentRes <- fold (runTSC flipperDir_) F.head\n  printf \"Checking out hg prev.\\n\"\n  _ <- sh hgPrev\n  printf \"Running tsc --strict against previous revision.\\n\"\n  prevRes <- fold (runTSC flipperDir_) F.head\n  printf \"Checking out hg next.\\n\"\n  _ <- sh hgNext\n\n  exit =<< case (currentRes, prevRes) of\n    (Just cur, Just prev) -> handleRes cur prev\n    _ -> handleErr\n", "num_lines": 112}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module FB\n  ( getObject\n  , getUser\n  , getUserFriends\n  , Id(..), Friend(..), User(..)\n  ) where\n\nimport FB.DataSource\nimport Data.Aeson\nimport Facebook (Id(..), Friend(..), User(..))\n\nimport Haxl.Core\n\n-- | Fetch an arbitrary object in the Facebook graph.\ngetObject :: Id -> GenHaxl u w Object\ngetObject id = dataFetch (GetObject id)\n\n-- | Fetch a Facebook user.\ngetUser :: Id -> GenHaxl u w User\ngetUser id = dataFetch (GetUser id)\n\n-- | Fetch the friends of a Facebook user that are registered with the\n-- current app.\ngetUserFriends :: Id -> GenHaxl u w [Friend]\ngetUserFriends id = dataFetch (GetUserFriends id)\n", "num_lines": 26}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE RebindableSyntax, OverloadedStrings #-}\nmodule Main (main) where\n\nimport Control.Exception as E\nimport Data.Aeson\nimport Data.HashMap.Strict ((!))\nimport Data.Time.Calendar\nimport Data.Time.Clock\nimport FB\nimport FB.DataSource\nimport Haxl.Core\nimport Haxl.Prelude\nimport System.Environment\nimport System.Exit\nimport System.IO.Error\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as T\nimport qualified Data.Vector as Vector\n\nmain = do\n  (creds, access_token) <- getCredentials\n  facebookState <- initGlobalState 10 creds access_token\n  env <- initEnv (stateSet facebookState stateEmpty) ()\n  r <- runHaxl env $ do\n    likes <- getObject \"me/likes\"\n    mapM getObject (likeIds likes)      -- these happen concurrently\n  print r\n\nlikeIds :: Object -> [Id]\nlikeIds likes = do\n  Array arr <- [likes ! \"data\"]\n  Object obj <- Vector.toList arr\n  String id <- [obj ! \"id\"]\n  return (Id id)\n\n-- Modifed from the test in the fb package:\n-- https://github.com/meteficha/fb/blob/master/tests/Main.hs\n-- Copyright (c)2012, Felipe Lessa\n\n-- | Grab the Facebook credentials from the environment.\ngetCredentials :: IO (Credentials, UserAccessToken)\ngetCredentials = tryToGet `E.catch` showHelp\n    where\n      tryToGet = do\n        [appName, appId, appSecret, accessToken] <-\n           mapM getEnv [\"APP_NAME\", \"APP_ID\", \"APP_SECRET\", \"ACCESS_TOKEN\"]\n        now <- getCurrentTime\n        let creds = Credentials (T.pack appName)\n                                (T.pack appId)\n                                (T.pack appSecret)\n            access_token = UserAccessToken\n                             (Id \"me\")\n                             (T.pack accessToken)\n                             now\n        return (creds, access_token)\n\n      showHelp exc | not (isDoesNotExistError exc) = E.throw exc\n      showHelp _ = do\n        putStrLn $ unlines\n          [ \"In order to run the tests from the 'haxl-facebook' package, you\"\n          , \"need developer access to a Facebook app.  Create an app by\"\n          , \"going to http://developers.facebook.com, select \\\"Create a New\"\n          , \" App\\\" from the \\\"Apps\\\" menu at the top.  Then create an\"\n          , \"access token using the Graph API explorer:\"\n          , \"   https://developers.facebook.com/tools/explorer\"\n          , \"Select your app from the \\\"Application\\\" menu at the top, then hit\"\n          , \"\\\"Get Access Token\\\".  The access token will last about 2 hours.\"\n          , \"\"\n          , \"Please supply your app's name, id and secret in the environment\"\n          , \"variables APP_NAME, APP_ID and APP_SECRET, respectively, and\"\n          , \"the access token in ACCESS_TOKEN.\"\n          , \"\"\n          , \"For example, before running the test you could run in the shell:\"\n          , \"\"\n          , \" $ export APP_NAME=\\\"test\\\"\"\n          , \" $ export APP_ID=\\\"000000000000000\\\"\"\n          , \" $ export APP_SECRET=\\\"xxxxxxxxxxxxxxxxxxxxxxxxxxxx\\\"\"\n          , \" $ export ACCESS_TOKEN=\\\"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\\\"\"\n          , \"\"\n          , \"Of course, these values above aren't valid and you need to\"\n          , \"replace them with your own.\"\n          , \"\"\n          , \"(Exiting now with a failure code.)\"]\n        exitFailure\n", "num_lines": 85}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "{-# LANGUAGE OverloadedStrings, StandaloneDeriving, RecordWildCards,\n    GADTs, TypeFamilies, MultiParamTypeClasses, DeriveDataTypeable,\n    FlexibleInstances #-}\n-- QSem was deprecated in 7.6, but no more\n{-# OPTIONS_GHC -fno-warn-deprecations #-}\nmodule FB.DataSource\n  ( FacebookReq(..)\n  , initGlobalState\n  , Credentials(..)\n  , UserAccessToken\n  , AccessToken(..)\n  ) where\n\nimport Network.HTTP.Conduit\nimport Facebook as FB\nimport Control.Monad\nimport Control.Monad.Trans.Resource\nimport Data.Hashable\nimport Data.Typeable\nimport Network.HTTP.Client.TLS (tlsManagerSettings)\nimport Data.Conduit\nimport Data.Conduit.List hiding (mapM, mapM_)\nimport Data.Monoid\nimport Data.Aeson\nimport Control.Concurrent.Async\nimport Control.Concurrent.QSem\nimport Control.Exception\n\nimport Haxl.Core\n\ndata FacebookReq a where\n   GetObject      :: Id -> FacebookReq Object\n   GetUser        :: UserId -> FacebookReq User\n   GetUserFriends :: UserId -> FacebookReq [Friend]\n  deriving Typeable\n\nderiving instance Eq (FacebookReq a)\nderiving instance Show (FacebookReq a)\n\ninstance ShowP FacebookReq where showp = show\n\ninstance Hashable (FacebookReq a) where\n  hashWithSalt s (GetObject (Id id))      = hashWithSalt s (0::Int,id)\n  hashWithSalt s (GetUser (Id id))        = hashWithSalt s (1::Int,id)\n  hashWithSalt s (GetUserFriends (Id id)) = hashWithSalt s (2::Int,id)\n\ninstance StateKey FacebookReq where\n  data State FacebookReq =\n    FacebookState\n       { credentials :: Credentials\n       , userAccessToken :: UserAccessToken\n       , manager :: Manager\n       , semaphore :: QSem\n       }\n\ninstance DataSourceName FacebookReq where\n  dataSourceName _ = \"Facebook\"\n\ninstance DataSource u FacebookReq where\n  fetch = facebookFetch\n\ninitGlobalState\n  :: Int\n  -> Credentials\n  -> UserAccessToken\n  -> IO (State FacebookReq)\n\ninitGlobalState threads creds token = do\n  manager <- newManager tlsManagerSettings\n  sem <- newQSem threads\n  return FacebookState\n    { credentials = creds\n    , manager = manager\n    , userAccessToken = token\n    , semaphore = sem\n    }\n\nfacebookFetch\n  :: State FacebookReq\n  -> Flags\n  -> u\n  -> PerformFetch FacebookReq\n\nfacebookFetch FacebookState{..} _flags _user =\n  BackgroundFetch $\n    mapM_ (fetchAsync credentials manager userAccessToken semaphore)\n\nfetchAsync\n  :: Credentials -> Manager -> UserAccessToken -> QSem\n  -> BlockedFetch FacebookReq\n  -> IO ()\nfetchAsync creds manager tok sem (BlockedFetch req rvar) =\n  void $ async $ bracket_ (waitQSem sem) (signalQSem sem) $ do\n    e <- Control.Exception.try $\n           runResourceT $ runFacebookT creds manager $ fetchFBReq tok req\n    case e of\n      Left ex -> putFailure rvar (ex :: SomeException)\n      Right a -> putSuccess rvar a\n\nfetchFBReq\n  :: UserAccessToken\n  -> FacebookReq a\n  -> FacebookT Auth (ResourceT IO) a\n\nfetchFBReq tok (GetObject (Id id)) =\n  getObject (\"/\" <> id) [] (Just tok)\n\nfetchFBReq _tok (GetUser id) =\n  getUser id [] Nothing\n\nfetchFBReq tok (GetUserFriends id) = do\n  f <- getUserFriends id [] tok\n  source <- fetchAllNextPages f\n  source $$ consume\n", "num_lines": 115}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Necessary:\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- Incidental:\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n\nmodule Main where\n\nimport Control.Monad\nimport Data.Hashable\nimport Data.List\nimport Data.Text (Text)\nimport Data.Traversable (for)\nimport Data.Typeable\nimport Haxl.Core\nimport System.Random\n\nimport qualified Data.Text as Text\n\nmain :: IO ()\nmain = do\n  let stateStore = stateSet UserState{} stateEmpty\n  env0 <- initEnv stateStore ()\n  names <- runHaxl env0 getAllUsernames\n  print names\n\n-- Data source API.\n\ngetAllUsernames :: Haxl [Name]\ngetAllUsernames = do\n  userIds <- getAllUserIds\n  for userIds $ \\userId -> do\n    getUsernameById userId\n\ngetAllUserIds :: Haxl [Id]\ngetAllUserIds = dataFetch GetAllIds\n\ngetUsernameById :: Id -> Haxl Name\ngetUsernameById userId = dataFetch (GetNameById userId)\n\n-- Aliases.\n\ntype Haxl = GenHaxl () ()\ntype Id = Int\ntype Name = Text\n\n-- Data source implementation.\n\ndata UserReq a where\n  GetAllIds   :: UserReq [Id]\n  GetNameById :: Id -> UserReq Name\n  deriving (Typeable)\n\nderiving instance Eq (UserReq a)\ninstance Hashable (UserReq a) where\n   hashWithSalt s GetAllIds       = hashWithSalt s (0::Int)\n   hashWithSalt s (GetNameById a) = hashWithSalt s (1::Int, a)\n\nderiving instance Show (UserReq a)\ninstance ShowP UserReq where showp = show\n\ninstance StateKey UserReq where\n  data State UserReq = UserState {}\n\ninstance DataSourceName UserReq where\n  dataSourceName _ = \"UserDataSource\"\n\ninstance DataSource u UserReq where\n  fetch _state _flags _userEnv = SyncFetch $ \\blockedFetches -> do\n    let\n      allIdVars :: [ResultVar [Id]]\n      allIdVars = [r | BlockedFetch GetAllIds r <- blockedFetches]\n\n      idStrings :: [String]\n      idStrings = map show ids\n\n      ids :: [Id]\n      vars :: [ResultVar Name]\n      (ids, vars) = unzip\n        [(userId, r) | BlockedFetch (GetNameById userId) r <- blockedFetches]\n\n    unless (null allIdVars) $ do\n      allIds <- sql \"select id from ids\"\n      mapM_ (\\r -> putSuccess r allIds) allIdVars\n\n    unless (null ids) $ do\n      names <- sql $ unwords\n        [ \"select name from names where\"\n        , intercalate \" or \" $ map (\"id = \" ++) idStrings\n        , \"order by find_in_set(id, '\" ++ intercalate \",\" idStrings ++ \"')\"\n        ]\n      mapM_ (uncurry putSuccess) (zip vars names)\n\n-- Mock SQL API.\n\nclass SQLResult a where\n  mockResult :: IO a\n\ninstance SQLResult a => SQLResult [a] where\n  mockResult = replicateM 10 mockResult\n\ninstance SQLResult Name where\n  -- An infinite number of employees, all named Jim.\n  mockResult = (\"Jim\" `Text.append`) . Text.pack . show <$> randomRIO (1::Int, 100)\n\ninstance SQLResult Id where\n  mockResult = randomRIO (1, 100)\n\nsql :: SQLResult a => String -> IO a\nsql query = print query >> mockResult\n", "num_lines": 117}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n-- | Everything needed to define data sources and to invoke the\n-- engine.\n--\n{-# LANGUAGE CPP #-}\nmodule Haxl.Core (\n    -- * The monad and operations\n    GenHaxl (..), runHaxl, runHaxlWithWrites\n\n    -- ** Env\n  , Env(..), Caches, caches\n    -- *** Operations in the monad\n  , env, withEnv, withLabel\n    -- *** Building the Env\n  , initEnvWithData, initEnv, emptyEnv, sanitizeEnv\n    -- *** Building the StateStore\n  , StateStore, stateGet, stateSet, stateEmpty\n\n    -- ** Writes inside the monad\n  , tellWrite, tellWriteNoMemo\n\n    -- ** Exceptions\n  , throw, catch, catchIf, try, tryToHaxlException\n\n    -- ** Data fetching and caching\n  , dataFetch, uncachedRequest\n  , cacheRequest, dupableCacheRequest, cacheResult, cacheResultWithShow\n  , cachedComputation, preCacheComputation\n  , dumpCacheAsHaskell\n\n    -- ** Memoization\n  , newMemo, newMemoWith, prepareMemo, runMemo\n  , memo, memoUnique, memoize, memoize1, memoize2\n  , memoFingerprint, MemoFingerprintKey(..)\n\n    -- ** Conditionals\n  , pAnd, pOr, unsafeChooseFirst\n\n    -- ** Statistics\n  , Stats(..)\n  , FetchStats(..)\n  , CallId\n  , Microseconds\n  , Timestamp\n  , emptyStats\n  , numFetches\n  , ppStats\n  , ppFetchStats\n  , aggregateFetchBatches\n  , Profile(..)\n  , ProfileMemo(..)\n  , ProfileFetch(..)\n  , emptyProfile\n  , ProfileLabel\n  , ProfileKey\n  , ProfileData(..)\n  , emptyProfileData\n  , AllocCount\n  , LabelHitCount\n\n    -- * Report flags\n  , ReportFlag(..)\n  , ReportFlags\n  , defaultReportFlags\n  , profilingReportFlags\n  , setReportFlag\n  , clearReportFlag\n  , testReportFlag\n\n    -- ** Flags\n  , Flags(..)\n  , defaultFlags\n  , ifTrace\n  , ifReport\n  , ifProfiling\n\n    -- * Building data sources\n  , DataSource(..)\n  , ShowP(..)\n  , DataSourceName(..)\n  , Request\n  , BlockedFetch(..)\n  , PerformFetch(..)\n  , StateKey(..)\n  , SchedulerHint(..)\n  , FailureClassification(..)\n\n    -- ** Result variables\n  , ResultVar(..)\n  , mkResultVar\n  , putFailure\n  , putResult\n  , putSuccess\n  , putResultFromChildThread\n  , putResultWithStats\n  , putResultWithStatsFromChildThread\n  , DataSourceStats(..)\n\n    -- ** Default fetch implementations\n  , asyncFetch, asyncFetchWithDispatch, asyncFetchAcquireRelease\n  , backgroundFetchSeq, backgroundFetchPar\n  , backgroundFetchAcquireRelease, backgroundFetchAcquireReleaseMVar\n  , stubFetch\n  , syncFetch\n\n    -- ** Utilities\n  , except\n  , setError\n  , getMapFromRCMap\n\n    -- * Exceptions\n  , module Haxl.Core.Exception\n\n    -- * Recording the function callgraph\n  , module Haxl.Core.CallGraph\n  ) where\n\nimport Haxl.Core.CallGraph\nimport Haxl.Core.DataSource\nimport Haxl.Core.Flags\nimport Haxl.Core.Memo\nimport Haxl.Core.Monad hiding (unsafeLiftIO {- Ask nicely to get this! -})\nimport Haxl.Core.Fetch\nimport Haxl.Core.Parallel\nimport Haxl.Core.Profile\nimport Haxl.Core.Run\nimport Haxl.Core.Stats\nimport Haxl.Core.Exception\nimport Haxl.Core.RequestStore (getMapFromRCMap)\nimport Haxl.Core.ShowP (ShowP(..))\nimport Haxl.Core.StateStore\n", "num_lines": 137}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# OPTIONS_GHC -fno-warn-orphans #-}\n\n-- | Support for using Haxl as a DSL.  This module provides most of\n-- the standard Prelude, plus a selection of stuff that makes\n-- Haxl client code cleaner and more concise.\n--\n-- We intend Haxl client code to:\n--\n--  * Import @Haxl.Prelude@\n--\n--  * Use @RebindableSyntax@.  This implies @NoImplicitPrelude@, and\n--    allows @if@-@then@-@else@ to be used with a monadic condition.\n--\n--  * Use @OverloadedStrings@  (we use @Text@ a lot)\n--\nmodule Haxl.Prelude (\n    -- * The Standard Haskell Prelude\n    -- | Everything from \"Prelude\" except 'mapM', 'mapM_',\n    -- 'sequence', and 'sequence'\n    module Prelude,\n\n    -- * Haxl and Fetching data\n    GenHaxl, dataFetch, DataSource, memo,\n    memoize, memoize1, memoize2,\n\n    -- * Extra Monad and Applicative things\n    Applicative(..),\n    mapM, mapM_, sequence, sequence_, filterM, foldM,\n    forM, forM_,\n    foldl', sort,\n    Monoid(..),\n    join,\n    andThen,\n\n    -- * Lifted operations\n    IfThenElse(..),\n    (.>), (.<), (.>=), (.<=),\n    (.==), (./=), (.&&), (.||),\n    (.++),\n    pair,\n    pAnd, pOr,\n\n    -- * Text things\n    Text,\n    IsString(..),\n\n    -- * Exceptions\n    throw, catch, try, withDefault, catchAny,\n    HaxlException(..), TransientError(..), LogicError(..),\n    NotFound(..), UnexpectedType(..), FetchError(..),\n    EmptyList(..), InvalidParameter(..)\n\n  ) where\n\nimport Haxl.Core.DataSource\nimport Haxl.Core.Exception\nimport Haxl.Core.Memo\nimport Haxl.Core.Monad\nimport Haxl.Core.Fetch\nimport Haxl.Core.Parallel\n\nimport Control.Applicative\nimport Control.Monad (foldM, join, void)\nimport Data.List (foldl', sort)\nimport Data.Text (Text)\nimport Data.Traversable hiding (forM, mapM, sequence)\nimport GHC.Exts (IsString(..))\nimport Prelude hiding (mapM, mapM_, sequence, sequence_)\nimport Data.Maybe\nimport Control.Exception (fromException)\n\ninfixr 3 .&&\ninfixr 2 .||\ninfix  4 .>, .<, .>=, .<=, .==, ./=\n\n-- -----------------------------------------------------------------------------\n-- Haxl versions of Haskell Prelude stuff\n\n-- Using overloading and RebindableSyntax to hide the monad as far as\n-- possible.\n\nclass IfThenElse a b where\n  ifThenElse :: a -> b -> b -> b\n\ninstance IfThenElse Bool a where\n  ifThenElse b t e = if b then t else e\n\n-- The equality constraint is necessary to convince the typechecker that\n-- this is valid:\n--\n-- > if ipGetCountry ip .== \"us\" then ... else ...\n--\ninstance (u1 ~ u2) => IfThenElse (GenHaxl u1 w Bool) (GenHaxl u2 w a) where\n  ifThenElse fb t e = do\n    b <- fb\n    if b then t else e\n\ninstance Num a => Num (GenHaxl u w a) where\n  (+)         = liftA2 (+)\n  (-)         = liftA2 (-)\n  (*)         = liftA2 (*)\n  fromInteger = pure . fromInteger\n  abs         = liftA abs\n  signum      = liftA signum\n  negate      = liftA negate\n\ninstance Fractional a => Fractional (GenHaxl u w a) where\n  (/) = liftA2 (/)\n  recip = liftA recip\n  fromRational = return . fromRational\n\n-- -----------------------------------------------------------------------------\n-- Convenience functions for avoiding do-notation boilerplate\n\n-- convention is to prefix the name with a '.'.  We could change this,\n-- or even just not provide these at all.\n\n(.>) :: Ord a => GenHaxl u w a -> GenHaxl u w a -> GenHaxl u w Bool\n(.>) = liftA2 (Prelude.>)\n\n(.<) :: Ord a => GenHaxl u w a -> GenHaxl u w a -> GenHaxl u w Bool\n(.<) = liftA2 (Prelude.<)\n\n(.>=) :: Ord a => GenHaxl u w a -> GenHaxl u w a -> GenHaxl u w Bool\n(.>=) = liftA2 (Prelude.>=)\n\n(.<=) :: Ord a => GenHaxl u w a -> GenHaxl u w a -> GenHaxl u w Bool\n(.<=) = liftA2 (Prelude.<=)\n\n(.==) :: Eq a => GenHaxl u w a -> GenHaxl u w a -> GenHaxl u w Bool\n(.==) = liftA2 (Prelude.==)\n\n(./=) :: Eq a => GenHaxl u w a -> GenHaxl u w a -> GenHaxl u w Bool\n(./=) = liftA2 (Prelude./=)\n\n(.++) :: GenHaxl u w [a] -> GenHaxl u w [a] -> GenHaxl u w [a]\n(.++) = liftA2 (Prelude.++)\n\n-- short-circuiting Bool operations\n(.&&):: GenHaxl u w Bool -> GenHaxl u w Bool -> GenHaxl u w Bool\nfa .&& fb = do a <- fa; if a then fb else return False\n\n(.||):: GenHaxl u w Bool -> GenHaxl u w Bool -> GenHaxl u w Bool\nfa .|| fb = do a <- fa; if a then return True else fb\n\npair :: GenHaxl u w a -> GenHaxl u w b -> GenHaxl u w (a, b)\npair = liftA2 (,)\n\n-- -----------------------------------------------------------------------------\n-- Applicative traversals\n\n-- | We don't want the monadic 'mapM', because that doesn't do batching.\n-- There doesn't seem to be a way to make 'Data.Traversable.mapM' have\n-- the right behaviour when used with Haxl, so instead we define 'mapM'\n-- to be 'traverse' in Haxl code.\nmapM :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)\nmapM = traverse\n\nforM :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)\nforM = flip mapM\n\n-- | See 'mapM'.\nmapM_ :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f ()\nmapM_ f t = void $ traverse f t\n\nforM_ :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f ()\nforM_ = flip mapM_\n\n-- | See 'mapM'.\nsequence :: (Traversable t, Applicative f) => t (f a) -> f (t a)\nsequence = sequenceA\n\n-- | See 'mapM'.\nsequence_ :: (Traversable t, Applicative f) => t (f a) -> f ()\nsequence_ t = void $ sequenceA t\n\n-- | See 'mapM'.\nfilterM :: (Applicative f) => (a -> f Bool) -> [a] -> f [a]\nfilterM predicate xs =\n    filt <$> mapM predicate xs\n  where\n    filt bools = [ x | (x,True) <- zip xs bools ]\n\n-- | In somes cases, we do want the monadic version of @('>>')@ to disable\n-- concurrency and start one computation only after the other finishes, e.g.:\n--\n-- @\n-- deferedFetch x = do\n--   sleep 5\n--   fetch x  -- fetch will actually run concurrently with sleep\n-- @\n--\n-- But we have defined @('>>') = ('*>')@ with the applicative behavior as this\n-- is desired in most cases, so instead we define 'andThen' as the monadic\n-- version of @('>>')@:\n--\n-- @\n-- deferedFetch x = sleep 5 `andThen` fetch x\n-- @\nandThen :: Monad m => m a -> m b -> m b\nandThen a b = a >>= \\_ -> b\n\n--------------------------------------------------------------------------------\n\n-- | Runs the given 'GenHaxl' computation, and if it throws a\n-- 'TransientError' or 'LogicError' exception (see\n-- \"Haxl.Core.Exception\"), the exception is ignored and the supplied\n-- default value is returned instead.\nwithDefault :: a -> GenHaxl u w a -> GenHaxl u w a\nwithDefault d a = catchAny a (return d)\n\n-- | Catch 'LogicError's and 'TransientError's and perform an alternative action\ncatchAny\n  :: GenHaxl u w a   -- ^ run this first\n  -> GenHaxl u w a   -- ^ if it throws 'LogicError' or 'TransientError', run this\n  -> GenHaxl u w a\ncatchAny haxl handler =\n  haxl `catch` \\e ->\n    if isJust (fromException e :: Maybe LogicError) ||\n       isJust (fromException e :: Maybe TransientError)\n      then\n        handler\n      else\n        throw e\n", "num_lines": 235}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright 2004-present Facebook. All Rights Reserved.\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE CPP #-}\n\nmodule Haxl.Core.CallGraph where\n\nimport Data.Map.Strict (Map)\nimport qualified Data.Map.Strict as Map\n#if __GLASGOW_HASKELL__ < 804\nimport Data.Monoid\n#endif\nimport Data.Text (Text)\nimport qualified Data.Text as Text\n\ntype ModuleName = Text\n\n-- | An unqualified function\ntype Function = Text\n\n-- | A qualified function\ndata QualFunction = QualFunction ModuleName Function deriving (Eq, Ord)\n\ninstance Show QualFunction where\n  show (QualFunction mn nm) = Text.unpack $ mn <> Text.pack \".\" <> nm\n\n-- | Represents an edge between a parent function which calls a child function\n-- in the call graph\ntype FunctionCall = (QualFunction, QualFunction)\n\n-- | An edge list which represents the dependencies between function calls\ntype CallGraph = ([FunctionCall], Map QualFunction Text)\n\n-- | Used as the root of all function calls\nmainFunction :: QualFunction\nmainFunction = QualFunction \"MAIN\" \"main\"\n\nemptyCallGraph :: CallGraph\nemptyCallGraph = ([], Map.empty)\n", "num_lines": 39}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- |\n-- A cache mapping data requests to their results.  This module is\n-- provided for access to Haxl internals only; most users should not\n-- need to import it.\n--\nmodule Haxl.Core.DataCache\n  ( DataCache(..)\n  , SubCache(..)\n  , emptyDataCache\n  , filter\n  , insert\n  , insertNotShowable\n  , insertWithShow\n  , lookup\n  , showCache\n  , readCache\n  ) where\n\nimport Prelude hiding (lookup, filter)\nimport Control.Exception\nimport Unsafe.Coerce\nimport Data.Typeable\nimport Data.Hashable\nimport qualified Data.HashTable.IO as H\n\n-- ---------------------------------------------------------------------------\n-- DataCache\n\n-- | A @'DataCache' res@ maps things of type @req a@ to @res a@, for\n-- any @req@ and @a@ provided @req a@ is an instance of 'Typeable'. In\n-- practice @req a@ will be a request type parameterised by its result.\n--\nnewtype DataCache res = DataCache (HashTable TypeRep (SubCache res))\n\n-- | The implementation is a two-level map: the outer level maps the\n-- types of requests to 'SubCache', which maps actual requests to their\n-- results.  So each 'SubCache' contains requests of the same type.\n-- This works well because we only have to store the dictionaries for\n-- 'Hashable' and 'Eq' once per request type.\n--\ndata SubCache res =\n  forall req a . (Hashable (req a), Eq (req a)) =>\n       SubCache (req a -> String) (a -> String) !(HashTable (req a) (res a))\n       -- NB. the inner HashMap is strict, to avoid building up\n       -- a chain of thunks during repeated insertions.\n\ntype HashTable k v = H.BasicHashTable k v\n\n-- | A new, empty 'DataCache'.\nemptyDataCache :: IO (DataCache res)\nemptyDataCache = DataCache <$> H.new\n\n-- | Inserts a request-result pair into the 'DataCache'.\ninsert\n  :: (Hashable (req a), Typeable (req a), Eq (req a), Show (req a), Show a)\n  => req a\n  -- ^ Request\n  -> res a\n  -- ^ Result\n  -> DataCache res\n  -> IO ()\n\ninsert = insertWithShow show show\n\n-- | Inserts a request-result pair into the 'DataCache', without\n-- requiring Show instances of the request or the result.  The cache\n-- cannot be subsequently used with `showCache`.\ninsertNotShowable\n  :: (Hashable (req a), Typeable (req a), Eq (req a))\n  => req a\n  -- ^ Request\n  -> res a\n  -- ^ Result\n  -> DataCache res\n  -> IO ()\n\ninsertNotShowable = insertWithShow notShowable notShowable\n\n-- | Inserts a request-result pair into the 'DataCache', with the given\n-- functions used to show the request and result.\ninsertWithShow\n  :: (Hashable (req a), Typeable (req a), Eq (req a))\n  => (req a -> String)\n  -- ^ Show function for request\n  -> (a -> String)\n  -- ^ Show function for result\n  -> req a\n  -- ^ Request\n  -> res a\n  -- ^ Result\n  -> DataCache res\n  -> IO ()\n\ninsertWithShow showRequest showResult request result (DataCache m) =\n  H.mutateIO m (typeOf request) (mutate showRequest showResult request result)\n\nnotShowable :: a\nnotShowable = error \"insertNotShowable\"\n\n-- | A mutation function for mutateIO. If the key doesn't exist in the top-level\n-- cache, creates a new hashtable and inserts the request and result.\n-- If the key exists, insert the request and result into the existing subcache,\n-- replacing any existing mapping.\nmutate :: (Hashable (req a), Typeable (req a), Eq (req a))\n  => (req a -> String)\n  -> (a -> String)\n  -> req a\n  -> res a\n  -> Maybe (SubCache res)\n  -> IO (Maybe (SubCache res), ())\nmutate showRequest showResult request result Nothing = do\n  newTable <- H.new\n  H.insert newTable request result\n  return (Just (SubCache showRequest showResult newTable), ())\nmutate _ _ request result (Just sc@(SubCache _ _ oldTable)) = do\n    H.insert oldTable (unsafeCoerce request) (unsafeCoerce result)\n    return (Just sc, ())\n\n-- | Looks up the cached result of a request.\nlookup\n  :: Typeable (req a)\n  => req a\n  -- ^ Request\n  -> DataCache res\n  -> IO (Maybe (res a))\n\nlookup req (DataCache m) = do\n  mbRes <- H.lookup m (typeOf req)\n  case mbRes of\n    Nothing -> return Nothing\n    Just (SubCache _ _ sc) ->\n      unsafeCoerce (H.lookup sc (unsafeCoerce req))\n\nfilter\n  :: forall res\n  . (forall a. res a -> IO Bool)\n  -> DataCache res\n  -> IO (DataCache res)\nfilter pred (DataCache cache) = do\n  cacheList <- H.toList cache\n  filteredCache <- filterSubCache `mapM` cacheList\n  DataCache <$> H.fromList filteredCache\n  where\n    filterSubCache\n      :: (TypeRep, SubCache res)\n      -> IO (TypeRep, SubCache res)\n    filterSubCache (ty, SubCache showReq showRes hm) = do\n      filteredList <- H.foldM go [] hm\n      filteredSC <- H.fromList filteredList\n      return (ty, SubCache showReq showRes filteredSC)\n      where\n        go res (request, rvar) = do\n          predRes <- pred rvar\n          return $ if predRes then (request, rvar):res else res\n\n-- | Dumps the contents of the cache, with requests and responses\n-- converted to 'String's using the supplied show functions.  The\n-- entries are grouped by 'TypeRep'.  Note that this will fail if\n-- 'insertNotShowable' has been used to insert any entries.\nshowCache\n  :: forall res\n  .  DataCache res\n  -> (forall a . res a -> IO (Maybe (Either SomeException a)))\n  -> IO [(TypeRep, [(String, Either SomeException String)])]\nshowCache (DataCache cache) readRes = H.foldM goSubCache [] cache\n  where\n    goSubCache\n      :: [(TypeRep, [(String, Either SomeException String)])]\n      -> (TypeRep, SubCache res)\n      -> IO [(TypeRep, [(String, Either SomeException String)])]\n    goSubCache res (ty, SubCache showReq showRes hm) = do\n      subCacheResult <- H.foldM go [] hm\n      return $ (ty, subCacheResult):res\n      where\n        go res (request, rvar) = do\n          maybe_r <- readRes rvar\n          return $ case maybe_r of\n            Nothing -> res\n            Just (Left e) -> (showReq request, Left e) : res\n            Just (Right result) ->\n              (showReq request, Right (showRes result)) : res\n\n-- | Dumps the contents of the cache responses to list\nreadCache\n  :: forall res ret\n  .  DataCache res\n  -> (forall a . res a -> IO ret)\n  -> IO [(TypeRep, [Either SomeException ret])]\nreadCache (DataCache cache) readRes = H.foldM goSubCache [] cache\n  where\n    goSubCache\n      :: [(TypeRep, [Either SomeException ret])]\n      -> (TypeRep, SubCache res)\n      -> IO [(TypeRep, [Either SomeException ret])]\n    goSubCache res (ty, SubCache _showReq _showRes hm) = do\n      subCacheResult <- H.foldM go [] hm\n      return $ (ty, subCacheResult):res\n      where\n        go res (_request, rvar) = do\n          r <- try $ readRes rvar\n          return $ r : res\n", "num_lines": 213}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE Rank2Types #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- |\n-- The 'DataSource' class and related types and functions.  This\n-- module is provided for access to Haxl internals only; most users\n-- should import \"Haxl.Core\" instead.\n--\nmodule Haxl.Core.DataSource\n  (\n  -- * Data fetching\n    DataSource(..)\n  , DataSourceName(..)\n  , Request\n  , BlockedFetch(..)\n  , PerformFetch(..)\n  , SchedulerHint(..)\n  , FailureClassification(..)\n\n  -- * Result variables\n  , ResultVar(..)\n  , mkResultVar\n  , putFailure\n  , putResult\n  , putResultFromChildThread\n  , putSuccess\n  , putResultWithStats\n  , putResultWithStatsFromChildThread\n\n  -- * Default fetch implementations\n  , asyncFetch, asyncFetchWithDispatch\n  , asyncFetchAcquireRelease\n  , backgroundFetchSeq, backgroundFetchPar\n  , backgroundFetchAcquireRelease\n  , backgroundFetchAcquireReleaseMVar\n  , stubFetch\n  , syncFetch\n\n  -- * Utilities\n  , except\n  , setError\n  ) where\n\nimport Control.Exception\nimport Control.Monad\nimport Data.Hashable\nimport Data.Text (Text)\nimport Data.Kind (Type)\nimport Data.Typeable\n\nimport Haxl.Core.Exception\nimport Haxl.Core.Flags\nimport Haxl.Core.ShowP\nimport Haxl.Core.StateStore\nimport Haxl.Core.Stats\n\n\nimport GHC.Conc ( newStablePtrPrimMVar\n                , PrimMVar)\nimport Control.Concurrent ( threadCapability\n                          , forkOn\n                          , myThreadId )\nimport Control.Concurrent.MVar\nimport Foreign.StablePtr\n\n-- ---------------------------------------------------------------------------\n-- DataSource class\n\n-- | The class of data sources, parameterised over the request type for\n-- that data source. Every data source must implement this class.\n--\n-- A data source keeps track of its state by creating an instance of\n-- 'StateKey' to map the request type to its state. In this case, the\n-- type of the state should probably be a reference type of some kind,\n-- such as 'IORef'.\n--\n-- For a complete example data source, see\n-- <https://github.com/facebook/Haxl/tree/master/example Examples>.\n--\nclass (DataSourceName req, StateKey req, ShowP req) => DataSource u req where\n\n  -- | Issues a list of fetches to this 'DataSource'. The 'BlockedFetch'\n  -- objects contain both the request and the 'ResultVar's into which to put\n  -- the results.\n  fetch\n    :: State req\n      -- ^ Current state.\n    -> Flags\n      -- ^ Tracing flags.\n    -> u\n      -- ^ User environment.\n    -> PerformFetch req\n      -- ^ Fetch the data; see 'PerformFetch'.\n\n  schedulerHint :: u -> SchedulerHint req\n  schedulerHint _ = TryToBatch\n\n  classifyFailure :: u -> req a -> SomeException -> FailureClassification\n  classifyFailure _ _ _ = StandardFailure\n\nclass DataSourceName (req :: Type -> Type) where\n  -- | The name of this 'DataSource', used in tracing and stats. Must\n  -- take a dummy request.\n  dataSourceName :: Proxy req -> Text\n\n-- The 'ShowP' class is a workaround for the fact that we can't write\n-- @'Show' (req a)@ as a superclass of 'DataSource', without also\n-- parameterizing 'DataSource' over @a@, which is a pain (I tried\n-- it). 'ShowP' seems fairly benign, though.\n\n-- | A convenience only: package up 'Eq', 'Hashable', 'Typeable', and 'Show'\n-- for requests into a single constraint.\ntype Request req a =\n  ( Eq (req a)\n  , Hashable (req a)\n  , Typeable (req a)\n  , Show (req a)\n  , Show a\n  )\n\n-- | Hints to the scheduler about this data source\ndata SchedulerHint (req :: Type -> Type)\n  = TryToBatch\n    -- ^ Hold data-source requests while we execute as much as we can, so\n    -- that we can hopefully collect more requests to batch.\n  | SubmitImmediately\n    -- ^ Submit a request via fetch as soon as we have one, don't try to\n    -- batch multiple requests.  This is really only useful if the data source\n    -- returns BackgroundFetch, otherwise requests to this data source will\n    -- be performed synchronously, one at a time.\n\n-- | Hints to the stats module about how to deal with these failures\ndata FailureClassification\n  = StandardFailure\n  | IgnoredForStatsFailure\n\n-- | A data source can fetch data in one of four ways.\n--\ndata PerformFetch req\n  = SyncFetch  ([BlockedFetch req] -> IO ())\n    -- ^ Fully synchronous, returns only when all the data is fetched.\n    -- See 'syncFetch' for an example.\n  | AsyncFetch ([BlockedFetch req] -> IO () -> IO ())\n    -- ^ Asynchronous; performs an arbitrary IO action while the data\n    -- is being fetched, but only returns when all the data is\n    -- fetched.  See 'asyncFetch' for an example.\n  | BackgroundFetch ([BlockedFetch req] -> IO ())\n    -- ^ Fetches the data in the background, calling 'putResult' at\n    -- any time in the future.  This is the best kind of fetch,\n    -- because it provides the most concurrency.\n\n\n-- | A 'BlockedFetch' is a pair of\n--\n--   * The request to fetch (with result type @a@)\n--\n--   * A 'ResultVar' to store either the result or an error\n--\n-- We often want to collect together multiple requests, but they return\n-- different types, and the type system wouldn't let us put them\n-- together in a list because all the elements of the list must have the\n-- same type. So we wrap up these types inside the 'BlockedFetch' type,\n-- so that they all look the same and we can put them in a list.\n--\n-- When we unpack the 'BlockedFetch' and get the request and the 'ResultVar'\n-- out, the type system knows that the result type of the request\n-- matches the type parameter of the 'ResultVar', so it will let us take the\n-- result of the request and store it in the 'ResultVar'.\n--\ndata BlockedFetch r = forall a. BlockedFetch (r a) (ResultVar a)\n\n\n-- -----------------------------------------------------------------------------\n-- ResultVar\n\n-- | A sink for the result of a data fetch in 'BlockedFetch'\nnewtype ResultVar a =\n  ResultVar (Either SomeException a -> Bool -> Maybe DataSourceStats -> IO ())\n  -- The Bool here is True if result was returned by a child thread,\n  -- rather than the main runHaxl thread.  see Note [tracking allocation in\n  -- child threads]\n\nmkResultVar\n  :: (Either SomeException a -> Bool -> Maybe DataSourceStats -> IO ())\n  -> ResultVar a\nmkResultVar = ResultVar\n\nputFailure :: (Exception e) => ResultVar a -> e -> IO ()\nputFailure r = putResult r . except\n\nputSuccess :: ResultVar a -> a -> IO ()\nputSuccess r = putResult r . Right\n\nputResult :: ResultVar a -> Either SomeException a -> IO ()\nputResult (ResultVar io) res = io res False Nothing\n\nputResultWithStats\n  :: ResultVar a -> Either SomeException a -> DataSourceStats -> IO ()\nputResultWithStats (ResultVar io) res st = io res False (Just st)\n\nputResultWithStatsFromChildThread\n  :: ResultVar a -> Either SomeException a -> DataSourceStats -> IO ()\nputResultWithStatsFromChildThread (ResultVar io) res st = io res True (Just st)\n\n-- | Like `putResult`, but used to get correct accounting when work is\n-- being done in child threads.  This is particularly important for\n-- data sources that are using 'BackgroundFetch', The allocation performed\n-- in the child thread up to this point will be propagated back to the\n-- thread that called 'runHaxl'.\n--\n-- Note: if you're doing multiple 'putResult' calls in the same thread\n-- ensure that only the /last/ one is 'putResultFromChildThread'.  If you\n-- make multiple 'putResultFromChildThread' calls, the allocation will be\n-- counted multiple times.\n--\n-- If you are reusing a thread for multiple fetches, you should call\n-- @System.Mem.setAllocationCounter 0@ after\n-- 'putResultFromChildThread', so that allocation is not counted\n-- multiple times.\nputResultFromChildThread :: ResultVar a -> Either SomeException a -> IO ()\nputResultFromChildThread (ResultVar io) res =  io res True Nothing\n  -- see Note [tracking allocation in child threads]\n\n-- | Function for easily setting a fetch to a particular exception\nsetError :: (Exception e) => (forall a. r a -> e) -> BlockedFetch r -> IO ()\nsetError e (BlockedFetch req m) = putFailure m (e req)\n\nexcept :: (Exception e) => e -> Either SomeException a\nexcept = Left . toException\n\n\n-- -----------------------------------------------------------------------------\n-- Fetch templates\n\nstubFetch\n  :: (Exception e) => (forall a. r a -> e)\n  -> State r -> Flags -> u -> PerformFetch r\nstubFetch e _state _flags _si = SyncFetch $ mapM_ (setError e)\n\n-- | Common implementation templates for 'fetch' of 'DataSource'.\n--\n-- Example usage:\n--\n-- > fetch = syncFetch MyDS.withService MyDS.retrieve\n-- >   $ \\service request -> case request of\n-- >     This x -> MyDS.fetchThis service x\n-- >     That y -> MyDS.fetchThat service y\n--\nasyncFetchWithDispatch\n  :: ((service -> IO ()) -> IO ())\n  -- ^ Wrapper to perform an action in the context of a service.\n\n  -> (service -> IO ())\n  -- ^ Dispatch all the pending requests\n\n  -> (service -> IO ())\n  -- ^ Wait for the results\n\n  -> (forall a. service -> request a -> IO (IO (Either SomeException a)))\n  -- ^ Enqueue an individual request to the service.\n\n  -> State request\n  -- ^ Currently unused.\n\n  -> Flags\n  -- ^ Currently unused.\n\n  -> u\n  -- ^ Currently unused.\n\n  -> PerformFetch request\n\nasyncFetch, syncFetch\n  :: ((service -> IO ()) -> IO ())\n  -- ^ Wrapper to perform an action in the context of a service.\n\n  -> (service -> IO ())\n  -- ^ Dispatch all the pending requests and wait for the results\n\n  -> (forall a. service -> request a -> IO (IO (Either SomeException a)))\n  -- ^ Submits an individual request to the service.\n\n  -> State request\n  -- ^ Currently unused.\n\n  -> Flags\n  -- ^ Currently unused.\n\n  -> u\n  -- ^ Currently unused.\n\n  -> PerformFetch request\n\nasyncFetchWithDispatch\n  withService dispatch wait enqueue _state _flags _si =\n  AsyncFetch $ \\requests inner -> withService $ \\service -> do\n    getResults <- mapM (submitFetch service enqueue) requests\n    dispatch service\n    inner\n    wait service\n    sequence_ getResults\n\nasyncFetch withService wait enqueue _state _flags _si =\n  AsyncFetch $ \\requests inner -> withService $ \\service -> do\n    getResults <- mapM (submitFetch service enqueue) requests\n    inner\n    wait service\n    sequence_ getResults\n\nsyncFetch withService dispatch enqueue _state _flags _si =\n  SyncFetch $ \\requests -> withService $ \\service -> do\n  getResults <- mapM (submitFetch service enqueue) requests\n  dispatch service\n  sequence_ getResults\n\nbackgroundFetchSeq, backgroundFetchPar\n  :: (forall a. request a -> IO (Either SomeException a))\n  -- ^ Run one request, will be run in a background thread\n\n  -> State request\n  -- ^ Currently unused.\n\n  -> Flags\n  -- ^ Currently unused.\n\n  -> u\n  -- ^ Currently unused.\n\n  -> PerformFetch request\n\nbackgroundFetchSeq run _state _flags _si =\n  BackgroundFetch $ \\requests -> do\n    (cap, _) <- threadCapability =<< myThreadId\n    mask $ \\restore -> void $ forkOn cap $ do\n      let rethrow = rethrowFromBg requests\n      restore (mapM_ runOne requests) `catch` rethrow\n      where\n        runOne (BlockedFetch request result) = do\n          res <- run request\n          putResultFromBg result res\n\nbackgroundFetchPar run _state _flags _si =\n  BackgroundFetch $ \\requests -> do\n    (cap, _) <- threadCapability =<< myThreadId\n    mapM_ (runOneInThread cap) requests\n  where\n    runOneInThread cap request = do\n      mask $ \\restore -> void $ forkOn cap $ do\n        let rethrow = rethrowFromBg [request]\n        restore (runOne request) `catch` rethrow\n    runOne (BlockedFetch request result) = do\n      res <- run request\n      putResultFromBg result res\n\n\n{- |\nA version of 'asyncFetch' (actually 'asyncFetchWithDispatch') that\nhandles exceptions correctly.  You should use this instead of\n'asyncFetch' or 'asyncFetchWithDispatch'.  The danger with\n'asyncFetch' is that if an exception is thrown by @withService@, the\n@inner@ action won't be executed, and we'll drop some data-fetches in\nthe same round.\n\n'asyncFetchAcquireRelease' behaves like the following:\n\n> asyncFetchAcquireRelease acquire release dispatch wait enqueue =\n>   AsyncFetch $ \\requests inner ->\n>     bracket acquire release $ \\service -> do\n>       getResults <- mapM (submitFetch service enqueue) requests\n>       dispatch service\n>       inner\n>       wait service\n>       sequence_ getResults\n\nexcept that @inner@ is run even if @acquire@, @enqueue@, or @dispatch@ throws,\n/unless/ an async exception is received.\n-}\n\nasyncFetchAcquireRelease\n  :: IO service\n  -- ^ Resource acquisition for this datasource\n\n  -> (service -> IO ())\n  -- ^ Resource release\n\n  -> (service -> IO ())\n  -- ^ Dispatch all the pending requests and wait for the results\n\n  -> (service -> IO ())\n  -- ^ Wait for the results\n\n  -> (forall a. service -> request a -> IO (IO (Either SomeException a)))\n  -- ^ Submits an individual request to the service.\n\n  -> State request\n  -- ^ Currently unused.\n\n  -> Flags\n  -- ^ Currently unused.\n\n  -> u\n  -- ^ Currently unused.\n\n  -> PerformFetch request\n\nasyncFetchAcquireRelease\n  acquire release dispatch wait enqueue _state _flags _si =\n  AsyncFetch $ \\requests inner -> mask $ \\restore -> do\n    r1 <- tryWithRethrow acquire\n    case r1 of\n      Left err -> do restore inner; throwIO (err :: SomeException)\n      Right service -> do\n        flip finally (release service) $ restore $ do\n          r2 <- tryWithRethrow $ do\n            getResults <- mapM (submitFetch service enqueue) requests\n            dispatch service\n            return getResults\n          inner  --  we assume this cannot throw, ensured by performFetches\n          case r2 of\n            Left err -> throwIO (err :: SomeException)\n            Right getResults -> do wait service; sequence_ getResults\n\n-- | Used by 'asyncFetch' and 'syncFetch' to retrieve the results of\n-- requests to a service.\nsubmitFetch\n  :: service\n  -> (forall a. service -> request a -> IO (IO (Either SomeException a)))\n  -> BlockedFetch request\n  -> IO (IO ())\nsubmitFetch service fetchFn (BlockedFetch request result)\n  = (putResult result =<<) <$> fetchFn service request\n\nputResultFromBg :: ResultVar a -> Either SomeException a -> IO ()\nputResultFromBg result r = do\n  -- See comment on putResultFromChildThread\n  -- We must set the allocation counter to 0 here in case there are more\n  -- results in the batch.\n  -- This is safe as we own this thread, and know that there\n  -- is no allocation limits set.\n  putResultFromChildThread result r\n  setAllocationCounter 0\n\nrethrowFromBg :: [BlockedFetch req] -> SomeException -> IO ()\nrethrowFromBg requests e = do\n  mapM_ (rethrow1bg e) requests\n  rethrowAsyncExceptions e\n  where\n    rethrow1bg e (BlockedFetch _ result) =\n      putResultFromBg result (Left e)\n\n\nbackgroundFetchAcquireReleaseMVar\n  :: IO service\n  -- ^ Resource acquisition for this datasource\n\n  -> (service -> IO ())\n  -- ^ Resource release\n\n  -> (service -> Int -> MVar () -> IO ())\n  -- ^ Dispatch all the pending requests and when ready trigger the given mvar\n\n  -> (service -> IO ())\n  -- ^ Process all requests\n\n  -> (forall a. service -> request a -> IO (IO (Either SomeException a)))\n  -- ^ Submits an individual request to the service.\n\n  -> State request\n  -- ^ Currently unused.\n\n  -> Flags\n  -- ^ Currently unused.\n\n  -> u\n  -- ^ Currently unused.\n\n  -> PerformFetch request\n\nbackgroundFetchAcquireReleaseMVar\n  acquire release dispatch process enqueue _state _flags _si =\n  BackgroundFetch $ \\requests -> do\n    mvar <- newEmptyMVar\n    mask $ \\restore -> do\n      (cap, _) <- threadCapability =<< myThreadId\n      service <- acquire\n      getResults <- (do\n        results <- restore $ mapM (submit service) requests\n        -- dispatch takes ownership of mvar, so we call it under `mask` to\n        -- ensure that it can safely manage that resource.\n        dispatch service cap mvar\n        return (sequence_ results)) `onException` release service\n      -- now spawn off a background thread to wait on the dispatch to finish\n      _tid <- forkOn cap $ do\n        takeMVar mvar\n          -- todo: it is possible that we would want to do\n          -- this processResults on the main scheduler thread for performance\n          -- which might reduce thread switching, especially for large batches\n          -- but for now this seems to work just fine\n        let rethrow = rethrowFromBg requests\n        _ <- finally\n          (restore (process service >> getResults) `catch` rethrow)\n          (release service `catch` rethrow)\n        return ()\n      return ()\n  where\n    submit service (BlockedFetch request result) =\n      (putResultFromBg result =<<) <$> enqueue service request\n\n\n{- |\nA version of 'backgroundFetchAcquireReleaseMVar' where the dispatch function\nis given a 'StablePtr PrimMVar' which is more useful for C based APIs.\n-}\n\nbackgroundFetchAcquireRelease\n  :: IO service\n  -- ^ Resource acquisition for this datasource\n\n  -> (service -> IO ())\n  -- ^ Resource release\n\n  -> (service -> Int -> StablePtr PrimMVar -> IO ())\n  -- ^ Dispatch all the pending requests and when ready trigger the given mvar\n\n  -> (service -> IO ())\n  -- ^ Process all requests\n\n  -> (forall a. service -> request a -> IO (IO (Either SomeException a)))\n  -- ^ Submits an individual request to the service.\n\n  -> State request\n  -- ^ Currently unused.\n\n  -> Flags\n  -- ^ Currently unused.\n\n  -> u\n  -- ^ Currently unused.\n\n  -> PerformFetch request\n\nbackgroundFetchAcquireRelease\n  a r dispatch = backgroundFetchAcquireReleaseMVar\n                 a\n                 r\n                 (\\s c mvar -> do\n                     sp <- newStablePtrPrimMVar mvar\n                     dispatch s c sp)\n", "num_lines": 561}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE OverloadedStrings #-}\n\n-- | An exception hierarchy that can be used with the 'Haxl' monad.\n--\n-- The Haxl framework may throw exceptions from this hierarchy: for\n-- example, a misbehaving data source causes 'dataFetch' to throw a\n-- 'DataSourceError'.  The combinator 'withDefault' from\n-- \"Haxl.Core.Prelude\" uses this hierarchy to provide default values\n-- for expressions that raise 'TransientError' or 'LogicError'\n-- exceptions.\n--\n-- You are under no obligations to use this hierarchy for your own\n-- exceptions, but you might find it useful nonetheless; for\n-- 'withDefault' to be useful, for example, you'll want your\n-- exceptions to be children of 'LogicError' or 'TransientError' as\n-- appropriate.\n--\n-- Most users should import \"Haxl.Core\" instead of importing this\n-- module directly.\n--\nmodule Haxl.Core.Exception (\n\n  HaxlException(..),\n\n  -- * Exception categories\n  InternalError(..),\n  internalErrorToException,\n  internalErrorFromException,\n\n  LogicError(..),\n  logicErrorToException,\n  logicErrorFromException,\n\n  LogicBug(..),\n  logicBugToException,\n  logicBugFromException,\n\n  TransientError(..),\n  transientErrorToException,\n  transientErrorFromException,\n\n  -- ** Internal exceptions\n  CriticalError(..),\n  DataSourceError(..),\n  NonHaxlException(..),\n\n  -- ** Logic exceptions\n  NotFound(..),\n  UnexpectedType(..),\n  EmptyList(..),\n  JSONError(..),\n  InvalidParameter(..),\n  MonadFail(..),\n\n  -- ** Transient exceptions\n  FetchError(..),\n\n  -- * Exception utilities\n  asHaxlException,\n  MiddleException(..),\n  rethrowAsyncExceptions,\n  tryWithRethrow,\n  ) where\n\n#if __GLASGOW_HASKELL__ >= 808\nimport Prelude hiding (MonadFail)\n#endif\nimport Control.Exception as Exception\nimport Data.Aeson\nimport Data.Binary (Binary)\nimport Data.Typeable\nimport Data.Text (Text)\nimport qualified Data.Text as Text\n\nimport Haxl.Core.Util\nimport GHC.Stack\n\n-- | We have a 3-tiered hierarchy of exceptions, with 'HaxlException' at\n-- the top, and all Haxl exceptions as children of this. Users should\n-- never deal directly with 'HaxlException's.\n--\n-- The main types of exceptions are:\n--\n--   ['InternalError']  Something is wrong with Haxl core.\n--\n--   ['LogicBug']       Something is wrong with Haxl client code.\n--\n--   ['LogicError']     Things that really should be return values, e.g.\n--                      NotFound.\n--\n--   ['TransientError'] Something is temporarily failing (usually in a fetch).\n--\n-- These are not meant to be thrown (but likely be caught). Thrown\n-- exceptions should be a subclass of one of these. There are some\n-- generic leaf exceptions defined below this, such as 'FetchError'\n-- (generic transient failure) or 'CriticalError' (internal failure).\n--\ndata HaxlException\n  = forall e. (MiddleException e)\n    => HaxlException\n         (Maybe Stack)  -- filled in with the call stack when thrown,\n                        -- if PROFILING is on\n         e\n  deriving (Typeable)\n\ntype Stack = [Text]\n  -- hopefully this will get more informative in the future\n\ninstance Show HaxlException where\n  show (HaxlException (Just stk@(_:_)) e) =\n    show e ++ '\\n' : renderStack (reverse $ map Text.unpack stk)\n  show (HaxlException _ e) = show e\n\ninstance Exception HaxlException\n\n-- | These need to be serializable to JSON to cross FFI boundaries.\ninstance ToJSON HaxlException where\n  toJSON (HaxlException stk e) = object fields\n    where\n      fields | Just s@(_:_) <- stk = (\"stack\" .= s) : rest\n             | otherwise = rest\n      rest =\n        [ \"type\" .= show (typeOf e)\n        , \"name\" .= eName e\n        , \"txt\"  .= show e\n        ]\n\nhaxlExceptionToException\n  :: (MiddleException e) => e -> SomeException\nhaxlExceptionToException = toException . HaxlException Nothing\n\nhaxlExceptionFromException\n  :: (MiddleException e) => SomeException -> Maybe e\nhaxlExceptionFromException x = do\n  HaxlException _ a <- fromException x\n  cast a\n\nclass (Exception a) => MiddleException a where\n  eName :: a -> String\n\n-- | For transient failures.\ndata TransientError = forall e . (Exception e) => TransientError e\n  deriving (Typeable)\n\nderiving instance Show TransientError\n\ninstance Exception TransientError where\n toException   = haxlExceptionToException\n fromException = haxlExceptionFromException\n\ninstance MiddleException TransientError where\n  eName (TransientError e) = show $ typeOf e\n\ntransientErrorToException :: (Exception e) => e -> SomeException\ntransientErrorToException = toException . TransientError\n\ntransientErrorFromException\n  :: (Exception e) => SomeException -> Maybe e\ntransientErrorFromException x = do\n  TransientError a <- fromException x\n  cast a\n\n-- | For errors in Haxl core code.\ndata InternalError = forall e . (Exception e) => InternalError e\n  deriving (Typeable)\n\nderiving instance Show InternalError\n\ninstance Exception InternalError where\n  toException   = haxlExceptionToException\n  fromException = haxlExceptionFromException\n\ninstance MiddleException InternalError where\n  eName (InternalError e) = show $ typeOf e\n\ninternalErrorToException :: (Exception e) => e -> SomeException\ninternalErrorToException = toException . InternalError\n\ninternalErrorFromException\n  :: (Exception e) => SomeException -> Maybe e\ninternalErrorFromException x = do\n  InternalError a <- fromException x\n  cast a\n\n-- | For errors in Haxl client code.\ndata LogicError = forall e . (Exception e) => LogicError e\n  deriving (Typeable)\n\nderiving instance Show LogicError\n\ninstance Exception LogicError where\n toException   = haxlExceptionToException\n fromException = haxlExceptionFromException\n\ninstance MiddleException LogicError where\n  eName (LogicError e) = show $ typeOf e\n\nlogicErrorToException :: (Exception e) => e -> SomeException\nlogicErrorToException = toException . LogicError\n\nlogicErrorFromException\n  :: (Exception e) => SomeException -> Maybe e\nlogicErrorFromException x = do\n  LogicError a <- fromException x\n  cast a\n\ndata LogicBug = forall e . (Exception e) => LogicBug e\n  deriving (Typeable)\n\nderiving instance Show LogicBug\n\ninstance Exception LogicBug where\n toException   = haxlExceptionToException\n fromException = haxlExceptionFromException\n\ninstance MiddleException LogicBug where\n  eName (LogicBug e) = show $ typeOf e\n\nlogicBugToException :: (Exception e) => e -> SomeException\nlogicBugToException = toException . LogicBug\n\nlogicBugFromException\n  :: (Exception e) => SomeException -> Maybe e\nlogicBugFromException x = do\n  LogicBug a <- fromException x\n  cast a\n\n------------------------------------------------------------------------\n-- Leaf exceptions. You should throw these. Or make your own.\n------------------------------------------------------------------------\n\n-- | Generic \\\"critical\\\" exception. Something internal is\n-- borked. Panic.\nnewtype CriticalError = CriticalError Text\n  deriving (Typeable, Binary, Eq, Show)\n\ninstance Exception CriticalError where\n  toException   = internalErrorToException\n  fromException = internalErrorFromException\n\n-- | Exceptions that are converted to HaxlException by\n-- asHaxlException.  Typically these will be pure exceptions,\n-- e.g., the 'error' function in pure code, or a pattern-match\n-- failure.\nnewtype NonHaxlException = NonHaxlException Text\n  deriving (Typeable, Binary, Eq, Show)\n\ninstance Exception NonHaxlException where\n  toException   = internalErrorToException\n  fromException = internalErrorFromException\n\n-- | Generic \\\"something was not found\\\" exception.\nnewtype NotFound = NotFound Text\n  deriving (Typeable, Binary, Eq, Show)\n\ninstance Exception NotFound where\n  toException = logicErrorToException\n  fromException = logicErrorFromException\n\n-- | Generic \\\"something had the wrong type\\\" exception.\nnewtype UnexpectedType = UnexpectedType Text\n  deriving (Typeable, Eq, Show)\n\ninstance Exception UnexpectedType where\n  toException = logicErrorToException\n  fromException = logicErrorFromException\n\n-- | Generic \\\"input list was empty\\\" exception.\nnewtype EmptyList = EmptyList Text\n  deriving (Typeable, Eq, Show)\n\ninstance Exception EmptyList where\n  toException = logicErrorToException\n  fromException = logicErrorFromException\n  -- TODO: should be a child of LogicBug\n\n-- | Generic \\\"Incorrect assumptions about JSON data\\\" exception.\nnewtype JSONError = JSONError Text\n  deriving (Typeable, Eq, Show)\n\ninstance Exception JSONError where\n  toException = logicErrorToException\n  fromException = logicErrorFromException\n\n-- | Generic \\\"passing some invalid parameter\\\" exception.\nnewtype InvalidParameter = InvalidParameter Text\n  deriving (Typeable, Eq, Show)\n\ninstance Exception InvalidParameter where\n  toException = logicErrorToException\n  fromException = logicErrorFromException\n  -- TODO: should be a child of LogicBug\n\n-- | Generic \\\"fail was called\\\" exception.\nnewtype MonadFail = MonadFail Text\n  deriving (Typeable, Eq, Show)\n\ninstance Exception MonadFail where\n  toException = logicErrorToException\n  fromException = logicErrorFromException\n\n-- | Generic transient fetching exceptions.\nnewtype FetchError = FetchError Text\n  deriving (Typeable, Eq, Show)\n\ninstance Exception FetchError where\n  toException   = transientErrorToException\n  fromException = transientErrorFromException\n\n-- | A data source did something wrong\nnewtype DataSourceError = DataSourceError Text\n  deriving (Typeable, Eq, Show)\n\ninstance Exception DataSourceError where\n  toException   = internalErrorToException\n  fromException = internalErrorFromException\n\n-- | Converts all exceptions that are not derived from 'HaxlException'\n-- into 'NonHaxlException', using 'show'.\nasHaxlException :: SomeException -> HaxlException\nasHaxlException e\n  | Just haxl_exception <- fromException e = -- it's a HaxlException\n     haxl_exception\n  | otherwise =\n     HaxlException Nothing (InternalError (NonHaxlException (textShow e)))\n\n-- We must be careful about turning IO monad exceptions into Haxl\n-- exceptions.  An IO monad exception will normally propagate right\n-- out of runHaxl and terminate the whole computation, whereas a Haxl\n-- exception can get dropped on the floor, if it is on the right of\n-- <*> and the left side also throws, for example.  So turning an IO\n-- monad exception into a Haxl exception is a dangerous thing to do.\n-- In particular, we never want to do it for an asynchronous exception\n-- (AllocationLimitExceeded, ThreadKilled, etc.), because these are\n-- supposed to unconditionally terminate the computation.\n--\n-- There are three places where we take an arbitrary IO monad exception and\n-- turn it into a Haxl exception:\n--\n--  * wrapFetchInCatch.  Here we want to propagate a failure of the\n--    data source to the callers of the data source, but if the\n--    failure came from elsewhere (an asynchronous exception), then we\n--    should just propagate it\n--\n--  * cacheResult (cache the results of IO operations): again,\n--    failures of the IO operation should be visible to the caller as\n--    a Haxl exception, but we exclude asynchronous exceptions from\n--    this.\n\n--  * unsafeToHaxlException: assume the caller knows what they're\n--    doing, and just wrap all exceptions.\n--\nrethrowAsyncExceptions :: SomeException -> IO ()\nrethrowAsyncExceptions e\n  | Just SomeAsyncException{} <- fromException e = Exception.throw e\n  | otherwise = return ()\n\ntryWithRethrow :: IO a -> IO (Either SomeException a)\ntryWithRethrow io =\n  (Right <$> io) `catch` \\e -> do rethrowAsyncExceptions e ; return (Left e)\n", "num_lines": 372}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n\n-- | Implementation of data-fetching operations.  Most users should\n-- import \"Haxl.Core\" instead.\n--\nmodule Haxl.Core.Fetch\n  ( dataFetch\n  , dataFetchWithShow\n  , dataFetchWithInsert\n  , uncachedRequest\n  , cacheResult\n  , dupableCacheRequest\n  , cacheResultWithShow\n  , cacheRequest\n  , performFetches\n  , performRequestStore\n  , ShowReq\n  ) where\n\nimport Control.Concurrent.STM\nimport Control.Exception as Exception\nimport Control.Monad\nimport Data.Either\nimport Data.Hashable\nimport Data.IORef\nimport Data.Int\nimport Data.List\n#if __GLASGOW_HASKELL__ < 804\nimport Data.Monoid\n#endif\nimport Data.Proxy\nimport Data.Typeable\nimport Data.Text (Text)\nimport Data.Kind (Type)\nimport qualified Data.Text as Text\nimport Text.Printf\n#ifdef PROFILING\nimport GHC.Stack\n#endif\n\nimport Haxl.Core.DataSource\nimport Haxl.Core.DataCache as DataCache\nimport Haxl.Core.Exception\nimport Haxl.Core.Flags\nimport Haxl.Core.Monad\nimport Haxl.Core.Profile\nimport Haxl.Core.RequestStore\nimport Haxl.Core.ShowP\nimport Haxl.Core.Stats\nimport Haxl.Core.StateStore\nimport Haxl.Core.Util\n\n-- -----------------------------------------------------------------------------\n-- Data fetching and caching\n\n-- | Possible responses when checking the cache.\ndata CacheResult u w a\n  -- | The request hadn't been seen until now.\n  = Uncached\n       (ResultVar a)\n       {-# UNPACK #-} !(IVar u w a)\n       {-# UNPACK #-} !CallId\n\n  -- | The request has been seen before, but its result has not yet been\n  -- fetched.\n  | CachedNotFetched\n      {-# UNPACK #-} !(IVar u w a)\n       {-# UNPACK #-} !CallId\n\n  -- | The request has been seen before, and its result has already been\n  -- fetched.\n  | Cached (ResultVal a w)\n           {-# UNPACK #-} !CallId\n\n\n-- | Show functions for request and its result.\ntype ShowReq r a = (r a -> String, a -> String)\n\n-- Note [showFn]\n--\n-- Occasionally, for tracing purposes or generating exceptions, we need to\n-- call 'show' on the request in a place where we *cannot* have a Show\n-- dictionary. (Because the function is a worker which is called by one of\n-- the *WithShow variants that take explicit show functions via a ShowReq\n-- argument.) None of the functions that does this is exported, so this is\n-- hidden from the Haxl user.\n\ncachedWithInsert\n  :: forall r a u w.\n     (DataSource u r, Typeable (r a))\n  => (r a -> String)    -- See Note [showFn]\n  -> (r a -> DataCacheItem u w a -> DataCache (DataCacheItem u w) -> IO ())\n  -> Env u w -> r a -> IO (CacheResult u w a)\ncachedWithInsert showFn insertFn env@Env{..} req = do\n  let\n    doFetch = do\n      ivar <- newIVar\n      k <- nextCallId env\n      let !rvar = stdResultVar env ivar (Proxy :: Proxy r)\n      insertFn req (DataCacheItem ivar k) dataCache\n      return (Uncached rvar ivar k)\n  mbRes <- DataCache.lookup req dataCache\n  case mbRes of\n    Nothing -> doFetch\n    Just (DataCacheItem i@IVar{ivarRef = cr} k) -> do\n      e <- readIORef cr\n      case e of\n        IVarEmpty _ -> do\n          ivar <- withCurrentCCS i\n          return (CachedNotFetched ivar k)\n        IVarFull r -> do\n          ifTrace flags 3 $ putStrLn $ case r of\n            ThrowIO{} -> \"Cached error: \" ++ showFn req\n            ThrowHaxl{} -> \"Cached error: \" ++ showFn req\n            Ok{} -> \"Cached request: \" ++ showFn req\n          return (Cached r k)\n\n\n-- | Make a ResultVar with the standard function for sending a CompletionReq\n-- to the scheduler. This is the function will be executed when the fetch\n-- completes.\nstdResultVar\n  :: forall r a u w. (DataSourceName r, Typeable r)\n  => Env u w\n  -> IVar u w a\n  -> Proxy r\n  -> ResultVar a\nstdResultVar Env{..} ivar p =\n  mkResultVar $ \\r isChildThread _ -> do\n    allocs <- if isChildThread\n      then\n        -- In a child thread, return the current allocation counter too,\n        -- for correct tracking of allocation.\n        getAllocationCounter\n      else\n        return 0\n    atomicallyOnBlocking\n      (LogicBug (ReadingCompletionsFailedFetch (dataSourceName p))) $ do\n      cs <- readTVar completions\n      writeTVar completions (CompleteReq (eitherToResult r) ivar allocs : cs)\n    -- Decrement the counter as request has finished. Do this after updating the\n    -- completions TVar so that if the scheduler is tracking what was being\n    -- waited on it gets a consistent view.\n    ifReport flags ReportOutgoneFetches $\n      atomicModifyIORef' submittedReqsRef (\\m -> (subFromCountMap p 1 m, ()))\n{-# INLINE stdResultVar #-}\n\n\n-- | Record the call stack for a data fetch in the Stats.  Only useful\n-- when profiling.\nlogFetch :: Env u w -> (r a -> String) -> r a -> CallId -> IO ()\n#ifdef PROFILING\nlogFetch env showFn req fid = do\n  ifReport (flags env) ReportFetchStack $ do\n    stack <- currentCallStack\n    modifyIORef' (statsRef env) $ \\(Stats s) ->\n      Stats (FetchCall (showFn req) stack fid : s)\n#else\nlogFetch _ _ _ _ = return ()\n#endif\n\ncalcFailure\n  :: forall u req a . DataSource u req\n  => u\n  -> req a\n  -> Either SomeException a\n  -> FailureCount\ncalcFailure _u _r Right{} = mempty\ncalcFailure u r (Left e) = case classifyFailure u r e of\n  StandardFailure -> mempty { failureCountStandard = 1 }\n  IgnoredForStatsFailure -> mempty { failureCountIgnored = 1 }\n\naddFallbackFetchStats\n  :: forall u w req a . DataSource u req\n  => Env u w\n  -> CallId\n  -> req a\n  -> ResultVal a w\n  -> IO ()\naddFallbackFetchStats Env{..} fid req res = do\n  bid <- atomicModifyIORef' statsBatchIdRef $ \\x -> (x+1,x+1)\n  start <- getTimestamp\n  let\n    dsName = dataSourceName (Proxy :: Proxy req)\n    FailureCount{..} = case res of\n      Ok{} -> mempty\n      (ThrowHaxl e _) -> calcFailure userEnv req (Left e)\n      (ThrowIO e) -> calcFailure userEnv req (Left e)\n    this = FetchStats { fetchDataSource = dsName\n                      , fetchBatchSize = 1\n                      , fetchStart = start\n                      , fetchDuration = 0\n                      , fetchSpace = 0\n                      , fetchFailures = failureCountStandard\n                      , fetchIgnoredFailures = failureCountIgnored\n                      , fetchBatchId = bid\n                      , fetchIds = [fid] }\n  atomicModifyIORef' statsRef $ \\(Stats fs) -> (Stats (this : fs), ())\n\naddFallbackResult\n  :: Env u w\n  -> ResultVal a w\n  -> IVar u w a\n  -> IO ()\naddFallbackResult Env{..} res ivar = do\n  atomicallyOnBlocking\n    (LogicBug (ReadingCompletionsFailedFetch \"addFallbackResult\")) $ do\n    cs <- readTVar completions\n    writeTVar completions (CompleteReq res ivar 0 : cs)\n\n-- | Performs actual fetching of data for a 'Request' from a 'DataSource'.\ndataFetch :: (DataSource u r, Request r a) => r a -> GenHaxl u w a\ndataFetch = dataFetchWithInsert show DataCache.insert\n\n-- | Performs actual fetching of data for a 'Request' from a 'DataSource', using\n-- the given show functions for requests and their results.\ndataFetchWithShow\n  :: (DataSource u r, Eq (r a), Hashable (r a), Typeable (r a))\n  => ShowReq r a\n  -> r a -> GenHaxl u w a\ndataFetchWithShow (showReq, showRes) = dataFetchWithInsert showReq\n  (DataCache.insertWithShow showReq showRes)\n\n-- | Performs actual fetching of data for a 'Request' from a 'DataSource', using\n-- the given function to insert requests in the cache.\ndataFetchWithInsert\n  :: forall u w r a\n   . (DataSource u r, Eq (r a), Hashable (r a), Typeable (r a))\n  => (r a -> String)    -- See Note [showFn]\n  -> (r a -> DataCacheItem u w a -> DataCache (DataCacheItem u w) -> IO ())\n  -> r a\n  -> GenHaxl u w a\ndataFetchWithInsert showFn insertFn req =\n  GenHaxl $ \\env@Env{..} -> do\n  -- First, check the cache\n  res <- cachedWithInsert showFn insertFn env req\n  case res of\n    -- This request has not been seen before\n    Uncached rvar ivar fid -> do\n      logFetch env showFn req fid\n      ifProfiling flags $ addProfileFetch env req fid False\n      --\n      -- Check whether the data source wants to submit requests\n      -- eagerly, or batch them up.\n      --\n      let\n        blockedFetch = BlockedFetch req rvar\n        blockedFetchI = BlockedFetchInternal fid\n        submitFetch = do\n          case schedulerHint userEnv :: SchedulerHint r of\n            SubmitImmediately ->\n              performFetches env [BlockedFetches [blockedFetch] [blockedFetchI]]\n            TryToBatch ->\n              -- add the request to the RequestStore and continue\n              modifyIORef' reqStoreRef $ \\bs ->\n                addRequest blockedFetch blockedFetchI bs\n          return $ Blocked ivar (Return ivar)\n\n      -- if there is a fallback configured try that,\n      -- else dispatch the fetch\n      case dataCacheFetchFallback of\n        Nothing -> submitFetch\n        Just (DataCacheLookup dcl) -> do\n          mbFallbackRes <- dcl req\n          case mbFallbackRes of\n            Nothing -> submitFetch\n            Just fallbackRes -> do\n              addFallbackResult env fallbackRes ivar\n              ifReport flags ReportFetchStats $ addFallbackFetchStats\n                env\n                fid\n                req\n                fallbackRes\n              return $ Blocked ivar (Return ivar)\n\n    -- Seen before but not fetched yet.  We're blocked, but we don't have\n    -- to add the request to the RequestStore.\n    CachedNotFetched ivar fid -> do\n      ifProfiling flags $ addProfileFetch env req fid True\n      return $ Blocked ivar (Return ivar)\n\n    -- Cached: either a result, or an exception\n    Cached r fid -> do\n      ifProfiling flags $ addProfileFetch env req fid True\n      done env r\n\n-- | A data request that is not cached.  This is not what you want for\n-- normal read requests, because then multiple identical requests may\n-- return different results, and this invalidates some of the\n-- properties that we expect Haxl computations to respect: that data\n-- fetches can be arbitrarily reordered, and identical requests can be\n-- commoned up, for example.\n--\n-- 'uncachedRequest' is useful for performing writes, provided those\n-- are done in a safe way - that is, not mixed with reads that might\n-- conflict in the same Haxl computation.\n--\n-- if we are recording or running a test, we fallback to using dataFetch\n-- This allows us to store the request in the cache when recording, which\n-- allows a transparent run afterwards. Without this, the test would try to\n-- call the datasource during testing and that would be an exception.\nuncachedRequest\n :: forall a u w (r :: Type -> Type). (DataSource u r, Request r a)\n => r a -> GenHaxl u w a\nuncachedRequest req = do\n  flg <- env flags\n  if recording flg /= 0\n    then dataFetch req\n    else GenHaxl $ \\e@Env{..} -> do\n      ivar <- newIVar\n      k <- nextCallId e\n      let !rvar = stdResultVar e ivar (Proxy :: Proxy r)\n      modifyIORef' reqStoreRef $ \\bs ->\n        addRequest (BlockedFetch req rvar) (BlockedFetchInternal k) bs\n      return $ Blocked ivar (Return ivar)\n\n\n-- | Transparently provides caching. Useful for datasources that can\n-- return immediately, but also caches values.  Exceptions thrown by\n-- the IO operation (except for asynchronous exceptions) are\n-- propagated into the Haxl monad and can be caught by 'catch' and\n-- 'try'.\ncacheResult :: Request r a => r a -> IO a -> GenHaxl u w a\ncacheResult = cacheResultWithInsert show DataCache.insert\n\n-- | Transparently provides caching in the same way as 'cacheResult', but uses\n-- the given functions to show requests and their results.\ncacheResultWithShow\n  :: (Eq (r a), Hashable (r a), Typeable (r a))\n  => ShowReq r a -> r a -> IO a -> GenHaxl u w a\ncacheResultWithShow (showReq, showRes) = cacheResultWithInsert showReq\n  (DataCache.insertWithShow showReq showRes)\n\n-- Transparently provides caching, using the given function to insert requests\n-- into the cache.\ncacheResultWithInsert\n  :: Typeable (r a)\n  => (r a -> String)    -- See Note [showFn]\n  -> (r a -> DataCacheItem u w a -> DataCache (DataCacheItem u w) -> IO ())\n  -> r a\n  -> IO a\n  -> GenHaxl u w a\ncacheResultWithInsert showFn insertFn req val = GenHaxl $ \\env@Env{..} -> do\n  mbRes <- DataCache.lookup req dataCache\n  case mbRes of\n    Nothing -> do\n      let\n        getResult = do\n          eitherResult <- Exception.try val\n          case eitherResult of\n            Left e -> rethrowAsyncExceptions e\n            _ -> return ()\n          return $ eitherToResultThrowIO eitherResult\n      -- if there is a fallback configured try that\n      result <- case dataCacheFetchFallback of\n        Nothing -> getResult\n        Just (DataCacheLookup dcl) -> do\n          mbFallbackRes <- dcl req\n          maybe getResult return mbFallbackRes\n      ivar <- newFullIVar result\n      k <- nextCallId env\n      insertFn req (DataCacheItem ivar k) dataCache\n      done env result\n    Just (DataCacheItem IVar{ivarRef = cr} _) -> do\n      e <- readIORef cr\n      case e of\n        IVarEmpty _ -> raise env corruptCache\n        IVarFull r -> done env r\n  where\n    corruptCache = DataSourceError $ Text.concat\n      [ Text.pack (showFn req)\n      , \" has a corrupted cache value: these requests are meant to\"\n      , \" return immediately without an intermediate value. Either\"\n      , \" the cache was updated incorrectly, or you're calling\"\n      , \" cacheResult on a query that involves a blocking fetch.\"\n      ]\n\n-- | Inserts a request/result pair into the cache. Throws an exception\n-- if the request has already been issued, either via 'dataFetch' or\n-- 'cacheRequest'.\n--\n-- This can be used to pre-populate the cache when running tests, to\n-- avoid going to the actual data source and ensure that results are\n-- deterministic.\n--\ncacheRequest\n  :: Request req a => req a -> Either SomeException a -> GenHaxl u w ()\ncacheRequest request result = GenHaxl $ \\e@Env{..} -> do\n  mbRes <- DataCache.lookup request dataCache\n  case mbRes of\n    Nothing -> do\n      cr <- newFullIVar (eitherToResult result)\n      k <- nextCallId e\n      DataCache.insert request (DataCacheItem cr k) dataCache\n      return (Done ())\n\n    -- It is an error if the request is already in the cache.\n    -- We can't test whether the cached result is the same without adding an\n    -- Eq constraint, and we don't necessarily have Eq for all results.\n    _other -> raise e $\n      DataSourceError \"cacheRequest: request is already in the cache\"\n\n-- | Similar to @cacheRequest@ but doesn't throw an exception if the key\n-- already exists in the cache.\n-- If this function is called twice to cache the same Haxl request, the first\n-- value will be discarded and overwritten with the second value.\n-- Useful e.g. for unit tests\ndupableCacheRequest\n  :: Request req a => req a -> Either SomeException a -> GenHaxl u w ()\ndupableCacheRequest request result = GenHaxl $ \\e@Env{..} -> do\n  cr <- newFullIVar (eitherToResult result)\n  k <- nextCallId e\n  DataCache.insert request (DataCacheItem cr k) dataCache\n  return (Done ())\n\nperformRequestStore\n   :: forall u w. Env u w -> RequestStore u -> IO ()\nperformRequestStore env reqStore =\n  performFetches env (contents reqStore)\n\n-- | Issues a batch of fetches in a 'RequestStore'. After\n-- 'performFetches', all the requests in the 'RequestStore' are\n-- complete, and all of the 'ResultVar's are full.\nperformFetches\n  :: forall u w. Env u w -> [BlockedFetches u] -> IO ()\nperformFetches env@Env{flags=f, statsRef=sref, statsBatchIdRef=sbref} jobs = do\n  t0 <- getTimestamp\n\n  ifTrace f 3 $\n    forM_ jobs $ \\(BlockedFetches reqs _) ->\n      forM_ reqs $ \\(BlockedFetch r _) -> putStrLn (showp r)\n\n  let\n    applyFetch i bfs@(BlockedFetches (reqs :: [BlockedFetch r]) _) =\n      case stateGet (states env) of\n        Nothing ->\n          return (FetchToDo reqs (SyncFetch (mapM_ (setError e))))\n         where\n           e :: ShowP req => req a -> DataSourceError\n           e req = DataSourceError $ \"data source not initialized: \" <> dsName\n                  <> \": \"\n                  <> Text.pack (showp req)\n        Just state ->\n          return $ FetchToDo reqs\n            $ (if testReportFlag ReportFetchStats $ report f\n                then wrapFetchInStats\n                        (userEnv env)\n                        sref\n                        sbref\n                        dsName\n                        (length reqs)\n                        bfs\n                else id)\n            $ wrapFetchInTrace i (length reqs) dsName\n            $ wrapFetchInCatch reqs\n            $ fetch state f (userEnv env)\n      where\n        dsName = dataSourceName (Proxy :: Proxy r)\n\n  fetches <- zipWithM applyFetch [0..] jobs\n\n  scheduleFetches fetches (submittedReqsRef env) (flags env)\n\n  t1 <- getTimestamp\n  let roundtime = fromIntegral (t1 - t0) / 1000000 :: Double\n\n  ifTrace f 1 $\n    printf \"Batch data fetch done (%.4fs)\\n\" (realToFrac roundtime :: Double)\n\ndata FetchToDo where\n  FetchToDo\n    :: forall (req :: Type -> Type). (DataSourceName req, Typeable req)\n    => [BlockedFetch req] -> PerformFetch req -> FetchToDo\n\n-- Catch exceptions arising from the data source and stuff them into\n-- the appropriate requests.  We don't want any exceptions propagating\n-- directly from the data sources, because we want the exception to be\n-- thrown by dataFetch instead.\n--\nwrapFetchInCatch :: [BlockedFetch req] -> PerformFetch req -> PerformFetch req\nwrapFetchInCatch reqs fetch =\n  case fetch of\n    SyncFetch f ->\n      SyncFetch $ \\reqs -> f reqs `Exception.catch` handler\n    AsyncFetch f ->\n      AsyncFetch $ \\reqs io -> f reqs io `Exception.catch` handler\n      -- this might be wrong: if the outer 'fio' throws an exception,\n      -- then we don't know whether we have executed the inner 'io' or\n      -- not.  If not, then we'll likely get some errors about \"did\n      -- not set result var\" later, because we haven't executed some\n      -- data fetches.  But we can't execute 'io' in the handler,\n      -- because we might have already done it.  It isn't possible to\n      -- do it completely right here, so we have to rely on data\n      -- sources themselves to catch (synchronous) exceptions.  Async\n      -- exceptions aren't a problem because we're going to rethrow\n      -- them all the way to runHaxl anyway.\n    BackgroundFetch f ->\n      BackgroundFetch $ \\reqs -> f reqs `Exception.catch` handler\n  where\n    handler :: SomeException -> IO ()\n    handler e = do\n      rethrowAsyncExceptions e\n      mapM_ (forceError e) reqs\n\n    -- Set the exception even if the request already had a result.\n    -- Otherwise we could be discarding an exception.\n    forceError e (BlockedFetch _ rvar) =\n      putResult rvar (except e)\n\n\ndata FailureCount = FailureCount\n  { failureCountStandard :: {-# UNPACK #-} !Int\n  , failureCountIgnored :: {-# UNPACK #-} !Int\n  }\n\n#if __GLASGOW_HASKELL__ >= 804\ninstance Semigroup FailureCount where\n  FailureCount s1 i1 <> FailureCount s2 i2 = FailureCount (s1+s2) (i1+i2)\n#endif\n\ninstance Monoid FailureCount where\n  mempty = FailureCount 0 0\n#if __GLASGOW_HASKELL__ < 804\n  mappend (FailureCount s1 i1) (FailureCount s2 i2)\n    = FailureCount (s1+s2) (i1+i2)\n#endif\n\nwrapFetchInStats\n  :: DataSource u req\n  => u\n  -> IORef Stats\n  -> IORef Int\n  -> Text\n  -> Int\n  -> BlockedFetches u\n  -> PerformFetch req\n  -> PerformFetch req\nwrapFetchInStats\n  u\n  !statsRef\n  !batchIdRef\n  dataSource\n  batchSize\n  (BlockedFetches _reqs reqsI)\n  perform = do\n  case perform of\n    SyncFetch f ->\n      SyncFetch $ \\reqs -> do\n        bid <- newBatchId\n        fail_ref <- newIORef mempty\n        (t0,t,alloc,_) <- statsForIO (f (map (addFailureCount u fail_ref)\n          (reqsWithFetchDsStats bid reqs)))\n        failures <- readIORef fail_ref\n        updateFetchStats bid allFids t0 t alloc batchSize failures\n    AsyncFetch f -> do\n      AsyncFetch $ \\reqs inner -> do\n        bid <- newBatchId\n        inner_r <- newIORef (0, 0)\n        fail_ref <- newIORef mempty\n        let inner' = do\n              (_,t,alloc,_) <- statsForIO inner\n              writeIORef inner_r (t,alloc)\n            reqs' = map (addFailureCount u fail_ref) reqs\n            reqs'' = reqsWithFetchDsStats bid reqs'\n        (t0, totalTime, totalAlloc, _) <- statsForIO (f reqs'' inner')\n        (innerTime, innerAlloc) <- readIORef inner_r\n        failures <- readIORef fail_ref\n        updateFetchStats bid allFids t0 (totalTime - innerTime)\n          (totalAlloc - innerAlloc) batchSize failures\n    BackgroundFetch io -> do\n      BackgroundFetch $ \\reqs -> do\n        bid <- newBatchId\n        startTime <- getTimestamp\n        io (reqsWithFetchDsStats bid\n          (zipWith (addTimer u bid startTime) reqs reqsI))\n  where\n    allFids = map (\\(BlockedFetchInternal k) -> k) reqsI\n    newBatchId = atomicModifyIORef' batchIdRef $ \\x -> (x+1,x+1)\n    statsForIO io = do\n      prevAlloc <- getAllocationCounter\n      (t0,t,a) <- time io\n      postAlloc <- getAllocationCounter\n      return (t0,t, fromIntegral $ prevAlloc - postAlloc, a)\n    reqsWithFetchDsStats = \\bid reqs\n      -> zipWith (addFetchDatasourceStats bid) reqs reqsI\n    addTimer\n      u\n      bid\n      t0\n      (BlockedFetch req (ResultVar fn))\n      (BlockedFetchInternal fid) =\n        BlockedFetch req $ ResultVar $ \\result isChildThread stats -> do\n          t1 <- getTimestamp\n          -- We cannot measure allocation easily for BackgroundFetch. Here we\n          -- just attribute all allocation to the last\n          -- `putResultFromChildThread` and use 0 for the others.\n          -- While the individual allocations may not be correct,\n          -- the total sum and amortized allocation are still meaningful.\n          -- see Note [tracking allocation in child threads]\n          allocs <- if isChildThread then getAllocationCounter else return 0\n          updateFetchStats bid [fid] t0 (t1 - t0)\n            (negate allocs)\n            1 -- batch size: we don't know if this is a batch or not\n            (calcFailure u req result) -- failures\n          fn result isChildThread stats\n\n    addFetchDatasourceStats\n      :: Int\n      -> BlockedFetch r\n      -> BlockedFetchInternal\n      -> BlockedFetch r\n    addFetchDatasourceStats bid\n      (BlockedFetch req (ResultVar fn))\n      (BlockedFetchInternal fid) = BlockedFetch req $ ResultVar\n        $ \\result isChildThread stats -> do\n          let mkStats dss = FetchDataSourceStats\n                { fetchDsStatsCallId = fid\n                , fetchDsStatsDataSource = dataSource\n                , fetchDsStatsStats = dss\n                , fetchBatchId = bid\n                }\n          case stats of\n            Just dss -> atomicModifyIORef' statsRef\n              $ \\(Stats fs) -> (Stats (mkStats dss : fs), ())\n            Nothing -> return ()\n          fn result isChildThread stats\n\n\n    updateFetchStats\n      :: Int\n      -> [CallId]\n      -> Timestamp\n      -> Microseconds\n      -> Int64\n      -> Int\n      -> FailureCount\n      -> IO ()\n    updateFetchStats bid fids start time space batch FailureCount{..} = do\n      let this = FetchStats { fetchDataSource = dataSource\n                            , fetchBatchSize = batch\n                            , fetchStart = start\n                            , fetchDuration = time\n                            , fetchSpace = space\n                            , fetchFailures = failureCountStandard\n                            , fetchIgnoredFailures = failureCountIgnored\n                            , fetchBatchId = bid\n                            , fetchIds = fids }\n      atomicModifyIORef' statsRef $ \\(Stats fs) -> (Stats (this : fs), ())\n\n    addFailureCount :: DataSource u r\n      => u -> IORef FailureCount -> BlockedFetch r -> BlockedFetch r\n    addFailureCount u ref (BlockedFetch req (ResultVar fn)) =\n      BlockedFetch req $ ResultVar $ \\result isChildThread stats -> do\n        let addFailures r = (r <> calcFailure u req result, ())\n        when (isLeft result) $ atomicModifyIORef' ref addFailures\n        fn result isChildThread stats\n\nwrapFetchInTrace\n  :: Int\n  -> Int\n  -> Text\n  -> PerformFetch req\n  -> PerformFetch req\n#ifdef EVENTLOG\nwrapFetchInTrace i n dsName f =\n  case f of\n    SyncFetch io -> SyncFetch (wrapF \"Sync\" io)\n    AsyncFetch fio -> AsyncFetch (wrapF \"Async\" . fio . unwrapF \"Async\")\n  where\n    d = Text.unpack dsName\n    wrapF :: String -> IO a -> IO a\n    wrapF ty = bracket_ (traceEventIO $ printf \"START %d %s (%d %s)\" i d n ty)\n                        (traceEventIO $ printf \"STOP %d %s (%d %s)\" i d n ty)\n    unwrapF :: String -> IO a -> IO a\n    unwrapF ty = bracket_ (traceEventIO $ printf \"STOP %d %s (%d %s)\" i d n ty)\n                          (traceEventIO $ printf \"START %d %s (%d %s)\" i d n ty)\n#else\nwrapFetchInTrace _ _ _ f = f\n#endif\n\ntime :: IO a -> IO (Timestamp,Microseconds,a)\ntime io = do\n  t0 <- getTimestamp\n  a <- io\n  t1 <- getTimestamp\n  return (t0, t1 - t0, a)\n\n-- | Start all the async fetches first, then perform the sync fetches before\n-- getting the results of the async fetches.\nscheduleFetches :: [FetchToDo] -> IORef ReqCountMap -> Flags -> IO ()\nscheduleFetches fetches ref flags = do\n  -- update ReqCountmap for these fetches\n  ifReport flags ReportOutgoneFetches $ sequence_\n    [ atomicModifyIORef' ref $\n        \\m -> (addToCountMap (Proxy :: Proxy r) (length reqs) m, ())\n    | FetchToDo (reqs :: [BlockedFetch r]) _f <- fetches\n    ]\n\n  ifTrace flags 1 $ printf \"Batch data fetch round: %s\\n\" $\n     intercalate (\", \"::String) $\n        map (\\(c, n, ds) -> printf \"%s %s %d\" n ds c) stats\n\n  fully_async_fetches\n  async_fetches sync_fetches\n where\n\n  fetchName :: forall req . PerformFetch req -> String\n  fetchName (BackgroundFetch _) = \"background\"\n  fetchName (AsyncFetch _) = \"async\"\n  fetchName (SyncFetch _) = \"sync\"\n\n  srcName :: forall req . (DataSourceName req) => [BlockedFetch req] -> String\n  srcName _ = Text.unpack $ dataSourceName (Proxy :: Proxy req)\n\n  stats = [(length reqs, fetchName f, srcName reqs)\n          | FetchToDo reqs f <- fetches]\n\n  fully_async_fetches :: IO ()\n  fully_async_fetches = sequence_\n    [f reqs | FetchToDo reqs (BackgroundFetch f) <- fetches]\n\n  async_fetches :: IO () -> IO ()\n  async_fetches = compose\n    [f reqs | FetchToDo reqs (AsyncFetch f) <- fetches]\n\n  sync_fetches :: IO ()\n  sync_fetches = sequence_\n    [f reqs | FetchToDo reqs (SyncFetch f) <- fetches]\n\n\n-- | An exception thrown when reading from datasources fails\ndata ReadingCompletionsFailedFetch = ReadingCompletionsFailedFetch Text\n  deriving Show\n\ninstance Exception ReadingCompletionsFailedFetch\n", "num_lines": 753}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE BangPatterns #-}\n\n-- |\n-- The 'Flags' type and related functions.  This module is provided\n-- for access to Haxl internals only; most users should import\n-- \"Haxl.Core\" instead.\n--\nmodule Haxl.Core.Flags\n  (\n    -- * Report flags\n    ReportFlag(..)\n  , ReportFlags\n  , defaultReportFlags\n  , profilingReportFlags\n  , setReportFlag\n  , clearReportFlag\n  , testReportFlag\n    -- * Flags\n  , Flags(..)\n  , defaultFlags\n  , ifTrace\n  , ifReport\n  , ifProfiling\n  ) where\n\nimport Control.Monad\nimport Data.Bits\nimport Data.List (foldl')\nimport Text.Printf (printf)\n\n-- ---------------------------------------------------------------------------\n-- ReportFlags\ndata ReportFlag\n  = ReportOutgoneFetches  -- ^ outgone fetches, for debugging eg: timeouts\n  | ReportFetchStats  -- ^ data fetch stats & errors\n  | ReportProfiling   -- ^ enabling label stack and profiling\n  | ReportExceptionLabelStack  -- ^ include label stack in HaxlException\n  | ReportFetchStack  -- ^ log cost-center stack traces of dataFetch calls\n  deriving (Bounded, Enum, Eq, Show)\n\nprofilingDependents :: [ReportFlag]\nprofilingDependents =\n  [ ReportExceptionLabelStack\n  , ReportFetchStack\n  ]\n\nnewtype ReportFlags = ReportFlags Int\n\ninstance Show ReportFlags where\n  show (ReportFlags fs) = printf \"%0*b\" (fromEnum maxReportFlag + 1) fs\n    where\n      maxReportFlag = maxBound :: ReportFlag\n\ndefaultReportFlags :: ReportFlags\ndefaultReportFlags = ReportFlags 0\n\nprofilingReportFlags :: ReportFlags\nprofilingReportFlags = foldl' (flip setReportFlag) defaultReportFlags\n  [ ReportOutgoneFetches\n  , ReportFetchStats\n  , ReportProfiling\n  ]\n\nsetReportFlag :: ReportFlag -> ReportFlags -> ReportFlags\nsetReportFlag f (ReportFlags fs) =\n  ReportFlags $ setDependencies $ setBit fs $ fromEnum f\n  where\n    setDependencies\n      | f `elem` profilingDependents = flip setBit $ fromEnum ReportProfiling\n      | otherwise = id\n\nclearReportFlag :: ReportFlag -> ReportFlags -> ReportFlags\nclearReportFlag f (ReportFlags fs) =\n  ReportFlags $ clearDependents $ clearBit fs $ fromEnum f\n  where\n    clearDependents z = case f of\n      ReportProfiling -> foldl' clearBit z $ map fromEnum profilingDependents\n      _ -> z\n\n{-# INLINE testReportFlag #-}\ntestReportFlag :: ReportFlag -> ReportFlags -> Bool\ntestReportFlag !f (ReportFlags !fs) = testBit fs $ fromEnum f\n\n-- ---------------------------------------------------------------------------\n-- Flags\n\n-- | Flags that control the operation of the engine.\ndata Flags = Flags\n  { trace :: {-# UNPACK #-} !Int\n    -- ^ Tracing level (0 = quiet, 3 = very verbose).\n  , report :: {-# UNPACK #-} !ReportFlags\n    -- ^ Report flags\n  , caching :: {-# UNPACK #-} !Int\n    -- ^ Non-zero if caching is enabled.  If caching is disabled, then\n    -- we still do batching and de-duplication, but do not cache\n    -- results.\n  , recording :: {-# UNPACK #-} !Int\n    -- ^ Non-zero if recording is enabled. This allows tests to record cache\n    -- calls for datasources by making uncachedRequest behave like dataFetch\n  }\n\ndefaultFlags :: Flags\ndefaultFlags = Flags\n  { trace = 0\n  , report = defaultReportFlags\n  , caching = 1\n  , recording = 0\n  }\n\n-- | Runs an action if the tracing level is above the given threshold.\nifTrace :: Monad m => Flags -> Int -> m a -> m ()\nifTrace flags i = when (trace flags >= i) . void\n\n-- | Runs an action if the ReportFlag is set.\nifReport :: Monad m => Flags -> ReportFlag -> m a -> m ()\nifReport flags i = when (testReportFlag i $ report flags) . void\n\nifProfiling :: Monad m => Flags -> m a -> m ()\nifProfiling flags = ifReport flags ReportProfiling\n", "num_lines": 126}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE RecordWildCards #-}\n\n-- |\n-- Memoization support. This module is provided for access to Haxl\n-- internals only; most users should import \"Haxl.Core\" instead.\n--\nmodule Haxl.Core.Memo\n  (\n    -- * Basic memoization\n    cachedComputation\n  , preCacheComputation\n\n    -- * High-level memoization\n  , memo\n  , memoFingerprint\n  , MemoFingerprintKey(..)\n  , memoize, memoize1, memoize2\n  , memoUnique\n\n    -- * Local memoization\n  , MemoVar\n  , newMemo\n  , newMemoWith\n  , prepareMemo\n  , runMemo\n  ) where\n\nimport Control.Exception as Exception hiding (throw)\nimport Data.IORef\nimport qualified Data.HashMap.Strict as HashMap\nimport Data.Text (Text)\nimport Data.Typeable\nimport Data.Hashable\nimport Data.Int\nimport Data.Word\n\nimport GHC.Prim (Addr#)\n\nimport Haxl.Core.Exception\nimport Haxl.Core.DataCache as DataCache\nimport Haxl.Core.Flags\nimport Haxl.Core.Monad\nimport Haxl.Core.Stats\nimport Haxl.Core.Profile\nimport Haxl.Core.Util (trace_)\n\n-- -----------------------------------------------------------------------------\n-- Memoization\n\n-- | 'cachedComputation' memoizes a Haxl computation.  The key is a\n-- request.\n--\n-- /Note:/ These cached computations will /not/ be included in the output\n-- of 'dumpCacheAsHaskell'.\n--\ncachedComputation\n   :: forall req u w a.\n      ( Eq (req a)\n      , Hashable (req a)\n      , Typeable (req a)\n      , Monoid w)\n   => req a -> GenHaxl u w a -> GenHaxl u w a\n\ncachedComputation req haxl = GenHaxl $ \\env@Env{..} -> do\n  mbRes <- DataCache.lookup req memoCache\n  case mbRes of\n    Just (DataCacheItem ivar k) -> do\n      ifProfiling flags $ do\n        incrementMemoHitCounterFor env k True\n      unHaxl (getIVarWithWrites ivar) env\n    Nothing -> do\n      ivar <- newIVar\n      k <- nextCallId env\n      -- no need to incremenetMemoHitCounter as execMemo will do it\n      DataCache.insertNotShowable req (DataCacheItem ivar k) memoCache\n      execMemoNowProfiled env haxl ivar k\n\n\n-- | Like 'cachedComputation', but fails if the cache is already\n-- populated.\n--\n-- Memoization can be (ab)used to \"mock\" a cached computation, by\n-- pre-populating the cache with an alternative implementation. In\n-- that case we don't want the operation to populate the cache to\n-- silently succeed if the cache is already populated.\n--\npreCacheComputation\n  :: forall req u w a.\n     ( Eq (req a)\n     , Hashable (req a)\n     , Typeable (req a)\n     , Monoid w)\n  => req a -> GenHaxl u w a -> GenHaxl u w a\npreCacheComputation req haxl = GenHaxl $ \\env@Env{..} -> do\n  mbRes <- DataCache.lookup req memoCache\n  case mbRes of\n    Just _ -> return $ Throw $ toException $ InvalidParameter\n      \"preCacheComputation: key is already cached\"\n    Nothing -> do\n      ivar <- newIVar\n      k <- nextCallId env\n      DataCache.insertNotShowable req (DataCacheItem ivar k) memoCache\n      execMemoNowProfiled env haxl ivar k\n\n-- -----------------------------------------------------------------------------\n-- Memoization\n\nnewtype MemoVar u w a = MemoVar (IORef (MemoStatus u w a))\n\ndata MemoStatus u w a\n  = MemoEmpty\n  | MemoReady (GenHaxl u w a) CallId\n  | MemoRun {-# UNPACK #-} !(IVar u w a) {-# UNPACK #-} !CallId\n\n-- | Create a new @MemoVar@ for storing a memoized computation. The created\n-- @MemoVar@ is initially empty, not tied to any specific computation. Running\n-- this memo (with @runMemo@) without preparing it first (with @prepareMemo@)\n-- will result in an exception.\nnewMemo :: GenHaxl u w (MemoVar u w a)\nnewMemo = unsafeLiftIO $ MemoVar <$> newIORef MemoEmpty\n\n-- | Store a computation within a supplied @MemoVar@. Any memo stored within the\n-- @MemoVar@ already (regardless of completion) will be discarded, in favor of\n-- the supplied computation. A @MemoVar@ must be prepared before it is run.\nprepareMemo :: MemoVar u w a -> GenHaxl u w a -> GenHaxl u w ()\nprepareMemo (MemoVar memoRef) memoCmp\n  = GenHaxl $ \\env -> do\n      k <- nextCallId env\n      writeIORef memoRef (MemoReady memoCmp k)\n      return (Done ())\n\n-- | Convenience function, combines @newMemo@ and @prepareMemo@.\nnewMemoWith :: GenHaxl u w a -> GenHaxl u w (MemoVar u w a)\nnewMemoWith memoCmp = do\n  memoVar <- newMemo\n  prepareMemo memoVar memoCmp\n  return memoVar\n\n-- | Continue the memoized computation within a given @MemoVar@.\n-- Notes:\n--\n--   1. If the memo contains a complete result, return that result.\n--   2. If the memo contains an in-progress computation, continue it as far as\n--      possible for this round.\n--   3. If the memo is empty (it was not prepared), throw an error.\n--\n-- For example, to memoize the computation @one@ given by:\n--\n-- > one :: Haxl Int\n-- > one = return 1\n--\n-- use:\n--\n-- > do\n-- >   oneMemo <- newMemoWith one\n-- >   let memoizedOne = runMemo aMemo one\n-- >   oneResult <- memoizedOne\n--\n-- To memoize mutually dependent computations such as in:\n--\n-- > h :: Haxl Int\n-- > h = do\n-- >   a <- f\n-- >   b <- g\n-- >   return (a + b)\n-- >  where\n-- >   f = return 42\n-- >   g = succ <$> f\n--\n-- without needing to reorder them, use:\n--\n-- > h :: Haxl Int\n-- > h = do\n-- >   fMemoRef <- newMemo\n-- >   gMemoRef <- newMemo\n-- >\n-- >   let f = runMemo fMemoRef\n-- >       g = runMemo gMemoRef\n-- >\n-- >   prepareMemo fMemoRef $ return 42\n-- >   prepareMemo gMemoRef $ succ <$> f\n-- >\n-- >   a <- f\n-- >   b <- g\n-- >   return (a + b)\n--\nrunMemo :: Monoid w => MemoVar u w a -> GenHaxl u w a\nrunMemo (MemoVar memoRef) = GenHaxl $ \\env -> do\n  stored <- readIORef memoRef\n  case stored of\n    -- Memo was not prepared first; throw an exception.\n    MemoEmpty -> trace_ \"MemoEmpty \" $\n      raise env $ CriticalError \"Attempting to run empty memo.\"\n    -- Memo has been prepared but not run yet\n    MemoReady cont k -> trace_ \"MemoReady\" $ do\n      ivar <- newIVar\n      writeIORef memoRef (MemoRun ivar k)\n      execMemoNowProfiled env cont ivar k\n    -- The memo has already been run, get (or wait for) for the result\n    MemoRun ivar k -> trace_ \"MemoRun\" $ do\n      ifProfiling (flags env) $ do\n        incrementMemoHitCounterFor env k True\n      unHaxl (getIVarWithWrites ivar) env\n\nexecMemoNowProfiled\n  :: Monoid w\n  => Env u w\n  -> GenHaxl u w a\n  -> IVar u w a\n  -> CallId\n  -> IO (Result u w a)\nexecMemoNowProfiled envOuter cont ivar cid =\n  if not $ testReportFlag ReportProfiling $ report $ flags envOuter\n  then execMemoNow envOuter cont ivar\n  else do\n    incrementMemoHitCounterFor envOuter cid False\n    unHaxl\n      (collectMemoData 0 $ GenHaxl $ \\e -> execMemoNow e cont ivar)\n      envOuter\n  where\n    addStats :: Env u w -> Int64 -> IO ()\n    addStats env acc = modifyIORef' (statsRef env) $ \\(Stats s) ->\n      Stats (MemoCall cid acc : s)\n    collectMemoData :: Int64 -> GenHaxl u w a -> GenHaxl u w a\n    collectMemoData acc f = GenHaxl $ \\env -> do\n      a0 <- getAllocationCounter\n      r <- unHaxl f env{memoKey=cid}\n      a1 <- getAllocationCounter\n      let newTotal = acc + (a0 - a1)\n      ret <- case r of\n        Done a -> do addStats env newTotal; return (Done a)\n        Throw e -> do addStats env newTotal; return (Throw e)\n        Blocked ivar k ->\n          return (Blocked ivar (Cont (collectMemoData newTotal (toHaxl k))))\n      setAllocationCounter a1\n      return ret\n\nexecMemoNow :: Monoid w => Env u w -> GenHaxl u w a -> IVar u w a -> IO (Result u w a)\nexecMemoNow env cont ivar = do\n  wlogs <- newIORef mempty\n  let\n    !menv = env { writeLogsRef = wlogs }\n    -- use an env with empty writes, so we can memoize the extra\n    -- writes done as part of 'cont'\n  r <- Exception.try $ unHaxl cont menv\n\n  case r of\n    Left e -> trace_ (\"execMemoNow: Left \" ++ show e) $ do\n      rethrowAsyncExceptions e\n      putIVar ivar (ThrowIO e) env\n      throwIO e\n    Right (Done a) -> trace_ \"execMemoNow: Done\" $ do\n      wt <- readIORef wlogs\n      putIVar ivar (Ok a (Just wt)) env\n      modifyIORef' (writeLogsRef env) (<> wt)\n      return (Done a)\n    Right (Throw ex) -> trace_ (\"execMemoNow: Throw\" ++ show ex) $ do\n      wt <- readIORef wlogs\n      putIVar ivar (ThrowHaxl ex (Just wt)) env\n      modifyIORef' (writeLogsRef env) (<> wt)\n      return (Throw ex)\n    Right (Blocked ivar' cont) -> trace_ \"execMemoNow: Blocked\" $ do\n      -- We \"block\" this memoized computation in the new environment 'menv', so\n      -- that when it finishes, we can store all the write logs from the env\n      -- in the IVar.\n      addJob menv (toHaxl cont) ivar ivar'\n      -- Now we call @getIVarWithWrites@ to populate the writes in the original\n      -- environment 'env'.\n      return (Blocked ivar (Cont (getIVarWithWrites ivar)))\n\n-- -----------------------------------------------------------------------------\n-- 1-ary and 2-ary memo functions\n\nnewtype MemoVar1 u w a b = MemoVar1 (IORef (MemoStatus1 u w a b))\nnewtype MemoVar2 u w a b c = MemoVar2 (IORef (MemoStatus2 u w a b c))\n\ndata MemoStatus1 u w a b\n  = MemoEmpty1\n  | MemoTbl1 (a -> GenHaxl u w b) (HashMap.HashMap a (MemoVar u w b))\n\ndata MemoStatus2 u w a b c\n  = MemoEmpty2\n  | MemoTbl2\n      (a -> b -> GenHaxl u w c)\n      (HashMap.HashMap a (HashMap.HashMap b (MemoVar u w c)))\n\nnewMemo1 :: GenHaxl u w (MemoVar1 u w a b)\nnewMemo1 = unsafeLiftIO $ MemoVar1 <$> newIORef MemoEmpty1\n\nnewMemoWith1 :: (a -> GenHaxl u w b) -> GenHaxl u w (MemoVar1 u w a b)\nnewMemoWith1 f = newMemo1 >>= \\r -> prepareMemo1 r f >> return r\n\nprepareMemo1 :: MemoVar1 u w a b -> (a -> GenHaxl u w b) -> GenHaxl u w ()\nprepareMemo1 (MemoVar1 r) f\n  = unsafeLiftIO $ writeIORef r (MemoTbl1 f HashMap.empty)\n\nrunMemo1 :: (Eq a, Hashable a, Monoid w) => MemoVar1 u w a b -> a -> GenHaxl u w b\nrunMemo1 (MemoVar1 r) k = unsafeLiftIO (readIORef r) >>= \\case\n  MemoEmpty1 -> throw $ CriticalError \"Attempting to run empty memo.\"\n  MemoTbl1 f h -> case HashMap.lookup k h of\n    Nothing -> do\n      x <- newMemoWith (f k)\n      unsafeLiftIO $ writeIORef r (MemoTbl1 f (HashMap.insert k x h))\n      runMemo x\n    Just v -> runMemo v\n\nnewMemo2 :: GenHaxl u w (MemoVar2 u w a b c)\nnewMemo2 = unsafeLiftIO $ MemoVar2 <$> newIORef MemoEmpty2\n\nnewMemoWith2 :: (a -> b -> GenHaxl u w c) -> GenHaxl u w (MemoVar2 u w a b c)\nnewMemoWith2 f = newMemo2 >>= \\r -> prepareMemo2 r f >> return r\n\nprepareMemo2 :: MemoVar2 u w a b c -> (a -> b -> GenHaxl u w c) -> GenHaxl u w ()\nprepareMemo2 (MemoVar2 r) f\n  = unsafeLiftIO $ writeIORef r (MemoTbl2 f HashMap.empty)\n\nrunMemo2 :: (Eq a, Hashable a, Eq b, Hashable b, Monoid w)\n         => MemoVar2 u w a b c\n         -> a -> b -> GenHaxl u w c\nrunMemo2 (MemoVar2 r) k1 k2 = unsafeLiftIO (readIORef r) >>= \\case\n  MemoEmpty2 -> throw $ CriticalError \"Attempting to run empty memo.\"\n  MemoTbl2 f h1 -> case HashMap.lookup k1 h1 of\n    Nothing -> do\n      v <- newMemoWith (f k1 k2)\n      unsafeLiftIO $ writeIORef r\n        (MemoTbl2 f (HashMap.insert k1 (HashMap.singleton k2 v) h1))\n      runMemo v\n    Just h2 -> case HashMap.lookup k2 h2 of\n      Nothing -> do\n        v <- newMemoWith (f k1 k2)\n        unsafeLiftIO $ writeIORef r\n          (MemoTbl2 f (HashMap.insert k1 (HashMap.insert k2 v h2) h1))\n        runMemo v\n      Just v -> runMemo v\n\n-- -----------------------------------------------------------------------------\n-- A key type that can be used for memoizing computations by a Text key\n\n-- | Memoize a computation using an arbitrary key.  The result will be\n-- calculated once; the second and subsequent time it will be returned\n-- immediately.  It is the caller's responsibility to ensure that for\n-- every two calls @memo key haxl@, if they have the same @key@ then\n-- they compute the same result.\nmemo\n  :: (Typeable a, Typeable k, Hashable k, Eq k, Monoid w)\n  => k -> GenHaxl u w a -> GenHaxl u w a\nmemo key = cachedComputation (MemoKey key)\n\n{-# RULES\n\"memo/Text\" memo = memoText :: (Typeable a, Monoid w) =>\n            Text -> GenHaxl u w a -> GenHaxl u w a\n #-}\n\n{-# NOINLINE memo #-}\n\n-- | Memoize a computation using its location and a Fingerprint. This ensures\n-- uniqueness across computations.\nmemoUnique\n  :: (Typeable a, Typeable k, Hashable k, Eq k, Monoid w)\n  => MemoFingerprintKey a -> Text -> k -> GenHaxl u w a -> GenHaxl u w a\nmemoUnique fp label key = withLabel label . memo (fp, key)\n\n{-# NOINLINE memoUnique #-}\n\ndata MemoKey k a where\n  MemoKey :: (Typeable k, Hashable k, Eq k) => k -> MemoKey k a\n  deriving Typeable\n\nderiving instance Eq (MemoKey k a)\n\ninstance Hashable (MemoKey k a) where\n  hashWithSalt s (MemoKey t) = hashWithSalt s t\n\n-- An optimised memo key for Text keys.  This is used automatically\n-- when the key is Text, due to the RULES pragma above.\n\ndata MemoTextKey a where\n  MemoText :: Text -> MemoTextKey a\n  deriving Typeable\n\nderiving instance Eq (MemoTextKey a)\n\ninstance Hashable (MemoTextKey a) where\n  hashWithSalt s (MemoText t) = hashWithSalt s t\n\nmemoText :: (Typeable a, Monoid w) => Text -> GenHaxl u w a -> GenHaxl u w a\nmemoText key = withLabel key . cachedComputation (MemoText key)\n\n-- | A memo key derived from a 128-bit MD5 hash.  Do not use this directly,\n-- it is for use by automatically-generated memoization.\ndata MemoFingerprintKey a where\n  MemoFingerprintKey\n    :: {-# UNPACK #-} !Word64\n    -> {-# UNPACK #-} !Word64\n    -> Addr# -> Addr#\n    -> MemoFingerprintKey a\n  deriving Typeable\n\nderiving instance Eq (MemoFingerprintKey a)\n\ninstance Hashable (MemoFingerprintKey a) where\n  hashWithSalt s (MemoFingerprintKey x _ _ _) =\n    hashWithSalt s (fromIntegral x :: Int)\n\n-- This is optimised for cheap call sites: when we have a call\n--\n--   memoFingerprint (MemoFingerprintKey 1234 5678 \"module\"# \"name\"#) e\n--\n-- then the MemoFingerprintKey constructor will be statically\n-- allocated (with two 64-bit fields and pointers to cstrings for the names),\n-- and shared by all calls to memo. So the memo call will not allocate,\n-- unlike memoText.\n--\n{-# NOINLINE memoFingerprint #-}\nmemoFingerprint\n  :: (Typeable a, Monoid w) => MemoFingerprintKey a -> GenHaxl u w a -> GenHaxl u w a\nmemoFingerprint key@(MemoFingerprintKey _ _ mnPtr nPtr) =\n  withFingerprintLabel mnPtr nPtr . cachedComputation key\n\n-- * Generic memoization machinery.\n\n-- | Transform a Haxl computation into a memoized version of itself.\n--\n-- Given a Haxl computation, @memoize@ creates a version which stores its result\n-- in a @MemoVar@ (which @memoize@ creates), and returns the stored result on\n-- subsequent invocations. This permits the creation of local memos, whose\n-- lifetimes are scoped to the current function, rather than the entire request.\nmemoize :: Monoid w => GenHaxl u w a -> GenHaxl u w (GenHaxl u w a)\nmemoize a = runMemo <$> newMemoWith a\n\n-- | Transform a 1-argument function returning a Haxl computation into a\n-- memoized version of itself.\n--\n-- Given a function @f@ of type @a -> GenHaxl u w b@, @memoize1@ creates a version\n-- which memoizes the results of @f@ in a table keyed by its argument, and\n-- returns stored results on subsequent invocations with the same argument.\n--\n-- e.g.:\n--\n-- > allFriends :: [Int] -> GenHaxl u w [Int]\n-- > allFriends ids = do\n-- >   memoizedFriendsOf <- memoize1 friendsOf\n-- >   concat <$> mapM memoizeFriendsOf ids\n--\n-- The above implementation will not invoke the underlying @friendsOf@\n-- repeatedly for duplicate values in @ids@.\nmemoize1 :: (Eq a, Hashable a, Monoid w)\n         => (a -> GenHaxl u w b)\n         -> GenHaxl u w (a -> GenHaxl u w b)\nmemoize1 f = runMemo1 <$> newMemoWith1 f\n\n-- | Transform a 2-argument function returning a Haxl computation, into a\n-- memoized version of itself.\n--\n-- The 2-ary version of @memoize1@, see its documentation for details.\nmemoize2 :: (Eq a, Hashable a, Eq b, Hashable b, Monoid w)\n         => (a -> b -> GenHaxl u w c)\n         -> GenHaxl u w (a -> b -> GenHaxl u w c)\nmemoize2 f = runMemo2 <$> newMemoWith2 f\n", "num_lines": 474}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{- TODO\n\n- do EVENTLOG stuff, track the data fetch numbers for performFetch\n\n- timing: we should be using clock_gettime(CLOCK_MONOTONIC) instead of\n  getCurrentTime, which will be affected by NTP and leap seconds.\n\n- write different scheduling policies\n\n-}\n\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE ConstraintKinds #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiWayIf #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE PatternGuards #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- |\n-- The implementation of the 'Haxl' monad.  Most users should\n-- import \"Haxl.Core\" instead of importing this module directly.\n--\nmodule Haxl.Core.Monad\n  (\n    -- * The monad\n    GenHaxl(..)\n  , Result(..)\n\n    -- * Writes (for debugging only)\n  , WriteTree(..)\n  , tellWrite\n  , tellWriteNoMemo\n  , write\n  , writeNoMemo\n  , flattenWT\n  , appendWTs\n  , mbModifyWLRef\n  , mapWrites\n  , mapWriteTree\n\n    -- * Cont\n  , Cont(..)\n  , toHaxl\n\n    -- * IVar\n  , IVar(..)\n  , IVarContents(..)\n  , newIVar\n  , newFullIVar\n  , withCurrentCCS\n  , getIVar\n  , getIVarWithWrites\n  , putIVar\n\n    -- * ResultVal\n  , ResultVal(..)\n  , done\n  , eitherToResult\n  , eitherToResultThrowIO\n\n    -- * CompleteReq\n  , CompleteReq(..)\n\n    -- * Env\n  , Env(..)\n  , DataCacheItem(..)\n  , DataCacheLookup(..)\n  , HaxlDataCache\n  , Caches\n  , caches\n  , initEnvWithData\n  , initEnv\n  , emptyEnv\n  , env, withEnv\n  , nextCallId\n  , sanitizeEnv\n\n    -- * Profiling\n  , ProfileCurrent(..)\n\n    -- * JobList\n  , JobList(..)\n  , appendJobList\n  , lengthJobList\n  , addJob\n\n    -- * Exceptions\n  , throw\n  , raise\n  , catch\n  , catchIf\n  , try\n  , tryToHaxlException\n\n    -- * Dumping the cache\n  , dumpCacheAsHaskell\n  , dumpCacheAsHaskellFn\n\n    -- * CallGraph\n#ifdef PROFILING\n  , withCallGraph\n#endif\n\n    -- * Unsafe operations\n  ,  unsafeLiftIO, unsafeToHaxlException\n  ) where\n\nimport Haxl.Core.Flags\nimport Haxl.Core.Stats\nimport Haxl.Core.StateStore\nimport Haxl.Core.Exception\nimport Haxl.Core.RequestStore as RequestStore\nimport Haxl.Core.DataCache as DataCache\nimport Haxl.Core.Util (trace_)\n\nimport Control.Applicative (liftA2)\nimport Control.Arrow (left)\nimport Control.Concurrent.STM\nimport qualified Control.Monad.Catch as Catch\nimport Control.Exception (Exception(..), SomeException, throwIO)\n#if __GLASGOW_HASKELL__ >= 808\nimport Control.Monad hiding (MonadFail)\nimport qualified Control.Monad as CTL\n#else\nimport Control.Monad\n#endif\nimport qualified Control.Exception as Exception\nimport Data.Either (rights)\nimport Data.IORef\nimport Data.Int\nimport Data.Maybe\nimport Data.List.NonEmpty (NonEmpty(..))\nimport qualified Data.List.NonEmpty as NonEmpty\n#if __GLASGOW_HASKELL__ < 804\nimport Data.Semigroup\n#endif\nimport qualified Data.Text as Text\nimport Data.Typeable\nimport GHC.Exts (IsString(..))\nimport Text.PrettyPrint hiding ((<>))\nimport Text.Printf\n#ifdef EVENTLOG\nimport Control.Exception (bracket_)\nimport Debug.Trace (traceEventIO)\n#endif\n\n#ifdef PROFILING\nimport qualified Data.Map as Map\nimport Data.Text (Text)\nimport Foreign.Ptr (Ptr)\nimport GHC.Stack\nimport Haxl.Core.CallGraph\n#endif\n\n-- -----------------------------------------------------------------------------\n-- The environment\n\n-- | The data we carry around in the Haxl monad.\n\ndata DataCacheItem u w a = DataCacheItem (IVar u w a) {-# UNPACK #-} !CallId\ntype HaxlDataCache u w = DataCache (DataCacheItem u w)\nnewtype DataCacheLookup w =\n  DataCacheLookup\n    (forall req a . Typeable (req a)\n    => req a\n    -> IO (Maybe (ResultVal a w)))\n\ndata Env u w = Env\n  { dataCache     :: {-# UNPACK #-} !(HaxlDataCache u w)\n      -- ^ cached data fetches\n\n  , memoCache      :: {-# UNPACK #-} !(HaxlDataCache u w)\n      -- ^ memoized computations\n\n  , memoKey    :: {-# UNPACK #-} !CallId\n      -- ^ current running memo key\n\n  , flags        :: !Flags\n      -- conservatively not unpacking, because this is passed\n      -- to 'fetch' and would need to be rebuilt.\n\n  , userEnv      :: u\n      -- ^ user-supplied data, retrievable with 'env'\n\n  , statsRef     :: {-# UNPACK #-} !(IORef Stats)\n      -- ^ statistics, collected according to the 'report' level in 'flags'.\n\n  , statsBatchIdRef :: {-# UNPACK #-} !(IORef Int)\n     -- ^ keeps track of a Unique ID for each batch dispatched with stats\n     -- enabled, for aggregating after.\n\n  , callIdRef :: {-# UNPACK #-} !(IORef CallId)\n     -- ^ keeps track of a Unique ID for each fetch/memo.\n\n  , profCurrent    :: ProfileCurrent\n     -- ^ current profiling label, see 'withLabel'\n\n  , profRef      :: {-# UNPACK #-} !(IORef Profile)\n      -- ^ profiling data, collected according to the 'report' level in 'flags'.\n\n  , states       :: StateStore\n      -- ^ Data sources and other components can store their state in\n      -- here. Items in this store must be instances of 'StateKey'.\n\n  , reqStoreRef :: {-# UNPACK #-} !(IORef (RequestStore u))\n       -- ^ The set of requests that we have not submitted to data sources yet.\n       -- Owned by the scheduler.\n\n  , runQueueRef :: {-# UNPACK #-} !(IORef (JobList u w))\n       -- ^ runnable computations. Things get added to here when we wake up\n       -- a computation that was waiting for something.  When the list is\n       -- empty, either we're finished, or we're waiting for some data fetch\n       -- to return.\n\n  , submittedReqsRef :: {-# UNPACK #-} !(IORef ReqCountMap)\n       -- ^ all outgone fetches which haven't yet returned. Entries are\n       -- removed from this map as the fetches finish. This field is\n       -- useful for tracking outgone fetches to detect downstream\n       -- failures.\n\n  , completions :: {-# UNPACK #-} !(TVar [CompleteReq u w])\n       -- ^ Requests that have completed.  Modified by data sources\n       -- (via putResult) and the scheduler.  Waiting for this list to\n       -- become non-empty is how the scheduler blocks waiting for\n       -- data fetches to return.\n\n  , writeLogsRef :: {-# UNPACK #-} !(IORef w)\n       -- ^ A log of all writes done as part of this haxl computation. Any\n       -- haxl computation that needs to be memoized runs in its own\n       -- environment so that we can get a hold of those writes and put them\n       -- in the IVar associated with the compuatation.\n  , writeLogsRefNoMemo :: {-# UNPACK #-} !(IORef w)\n       -- ^ This is just a specialized version of @writeLogsRef@, where we put\n       -- logs that user doesn't want memoized. This is a better alternative to\n       -- doing arbitrary IO from a (memoized) Haxl computation.\n\n  , dataCacheFetchFallback :: !(Maybe (DataCacheLookup w))\n       -- ^ Allows you to inject a DataCache lookup just before a dataFetch is\n       -- dispatched. This is useful for injecting fetch results in testing.\n\n#ifdef PROFILING\n  , callGraphRef ::  Maybe (IORef CallGraph)\n       -- ^ An edge list representing the current function call graph. The type\n       -- is wrapped in a Maybe to avoid changing the existing callsites.\n\n  , currFunction :: QualFunction\n       -- ^ The most recent function call.\n#endif\n  }\n\ndata ProfileCurrent = ProfileCurrent\n  { profCurrentKey ::  {-# UNPACK #-} !ProfileKey\n  , profLabelStack :: {-# UNPACK #-} !(NonEmpty ProfileLabel)\n  }\n\ntype Caches u w = (HaxlDataCache u w, HaxlDataCache u w)\n\ncaches :: Env u w -> Caches u w\ncaches env = (dataCache env, memoCache env)\n\ngetMaxCallId :: HaxlDataCache u w -> IO (Maybe Int)\ngetMaxCallId c = do\n  callIds  <- rights . concatMap snd <$>\n              DataCache.readCache c (\\(DataCacheItem _ i) -> return i)\n  case callIds of\n    [] -> return Nothing\n    vals -> return $ Just (maximum vals)\n\n\n-- | Initialize an environment with a 'StateStore', an input map, a\n-- preexisting 'DataCache', and a seed for the random number generator.\ninitEnvWithData :: Monoid w => StateStore -> u -> Caches u w -> IO (Env u w)\ninitEnvWithData states e (dcache, mcache) = do\n  newCid <- max <$>\n    (maybe 0 ((+) 1) <$> getMaxCallId dcache) <*>\n    (maybe 0 ((+) 1) <$> getMaxCallId mcache)\n  ciref<- newIORef newCid\n  sref <- newIORef emptyStats\n  sbref <- newIORef 0\n  pref <- newIORef emptyProfile\n  rs <- newIORef noRequests          -- RequestStore\n  rq <- newIORef JobNil              -- RunQueue\n  sr <- newIORef emptyReqCounts      -- SubmittedReqs\n  comps <- newTVarIO []              -- completion queue\n  wl <- newIORef mempty\n  wlnm <- newIORef mempty\n  return Env\n    { dataCache = dcache\n    , memoCache = mcache\n    , memoKey = (-1)\n    , flags = defaultFlags\n    , userEnv = e\n    , states = states\n    , statsRef = sref\n    , statsBatchIdRef = sbref\n    , profCurrent = ProfileCurrent 0 $ \"MAIN\" :| []\n    , callIdRef = ciref\n    , profRef = pref\n    , reqStoreRef = rs\n    , runQueueRef = rq\n    , submittedReqsRef = sr\n    , completions = comps\n    , writeLogsRef = wl\n    , writeLogsRefNoMemo = wlnm\n    , dataCacheFetchFallback = Nothing\n#ifdef PROFILING\n    , callGraphRef = Nothing\n    , currFunction = mainFunction\n#endif\n    }\n\n-- | Initializes an environment with 'StateStore' and an input map.\ninitEnv :: Monoid w => StateStore -> u -> IO (Env u w)\ninitEnv states e = do\n  dcache <- emptyDataCache\n  mcache <- emptyDataCache\n  initEnvWithData states e (dcache, mcache)\n\n-- | A new, empty environment.\nemptyEnv :: Monoid w => u -> IO (Env u w)\nemptyEnv = initEnv stateEmpty\n\n-- | If you're using the env from a failed Haxl computation in a second Haxl\n-- computation, it is recommended to sanitize the Env to remove all empty\n-- IVars - especially if it's possible the first Haxl computation could've\n-- been interrupted via an async exception. This is because if the Haxl\n-- computation was interrupted by an exception, it's possible that there are\n-- entries in the cache which are still blocked, while the results from\n-- outgone fetches have been discarded.\nsanitizeEnv :: Env u w -> IO (Env u w)\nsanitizeEnv env@Env{..} = do\n  sanitizedDC <- DataCache.filter isIVarFull dataCache\n  sanitizedMC <- DataCache.filter isIVarFull memoCache\n  rs <- newIORef noRequests          -- RequestStore\n  rq <- newIORef JobNil              -- RunQueue\n  comps <- newTVarIO []              -- completion queue\n  sr <- newIORef emptyReqCounts      -- SubmittedReqs\n  return env\n    { dataCache = sanitizedDC\n    , memoCache = sanitizedMC\n    , reqStoreRef = rs\n    , runQueueRef = rq\n    , completions = comps\n    , submittedReqsRef = sr\n    }\n  where\n  isIVarFull (DataCacheItem IVar{..} _) = do\n    ivarContents <- readIORef ivarRef\n    case ivarContents of\n      IVarFull _ -> return True\n      _ -> return False\n\n-- -----------------------------------------------------------------------------\n-- WriteTree\n\n-- | A tree of writes done during a Haxl computation. We could use a simple\n-- list, but this allows us to avoid multiple mappends when concatenating\n-- writes from two haxl computations.\n--\n-- Users should try to treat this data type as opaque, and prefer\n-- to use @flattenWT@ to get a simple list of writes from a @WriteTree@.\ndata WriteTree w\n  = NilWrites\n  | SomeWrite w\n  | MergeWrites (WriteTree w) (WriteTree w)\n  deriving (Show)\n\ninstance Semigroup (WriteTree w) where\n  (<>) = appendWTs\n\ninstance Monoid (WriteTree w) where\n  mempty = NilWrites\n\nappendWTs :: WriteTree w -> WriteTree w -> WriteTree w\nappendWTs NilWrites w = w\nappendWTs w NilWrites = w\nappendWTs w1 w2 = MergeWrites w1 w2\n\n-- This function must be called at the end of the Haxl computation to get\n-- a list of writes.\n-- Haxl provides no guarantees on the order of the returned logs.\nflattenWT :: WriteTree w -> [w]\nflattenWT = go []\n  where\n    go !ws NilWrites = ws\n    go !ws (SomeWrite w) = w : ws\n    go !ws (MergeWrites w1 w2) = go (go ws w2) w1\n\n-- This is a convenience wrapper over modifyIORef, which only modifies\n-- writeLogsRef IORef, for non NilWrites.\nmbModifyWLRef :: WriteTree w -> IORef (WriteTree w) -> IO ()\nmbModifyWLRef NilWrites _ = return ()\nmbModifyWLRef !wt ref = modifyIORef' ref (`appendWTs` wt)\n\nmapWriteTree :: (w -> w) -> WriteTree w -> WriteTree w\nmapWriteTree _ NilWrites = NilWrites\nmapWriteTree f (SomeWrite w) = SomeWrite (f w)\nmapWriteTree f (MergeWrites wt1 wt2) =\n  MergeWrites (mapWriteTree f wt1) (mapWriteTree f wt2)\n\n-- -----------------------------------------------------------------------------\n-- | The Haxl monad, which does several things:\n--\n--  * It is a reader monad for 'Env', which contains the current state\n--    of the scheduler, including unfetched requests and the run queue\n--    of computations.\n--\n--  * It is a writer monad for 'WriteTree'. These can be used to do\n--    arbitrary \"logs\" from any Haxl computation. These are better than\n--    doing arbitrary IO from a Haxl computation as these writes also get\n--    memoized if the Haxl computation associated with them is memoized.\n--    Now if this memoized computation is run again, you'll get the writes\n--    twice.\n\n--  * It is a concurrency, or resumption, monad. A computation may run\n--    partially and return 'Blocked', in which case the framework should\n--    perform the outstanding requests in the 'RequestStore', and then\n--    resume the computation.\n--\n--  * The Applicative combinator '<*>' explores /both/ branches in the\n--    event that the left branch is 'Blocked', so that we can collect\n--    multiple requests and submit them as a batch.\n--\n--  * It contains IO, so that we can perform real data fetching.\n--\nnewtype GenHaxl u w a = GenHaxl\n  { unHaxl :: Env u w -> IO (Result u w a) }\n\ntellWrite :: w -> GenHaxl u (WriteTree w) ()\ntellWrite = write . SomeWrite\n\nwrite :: Monoid w => w -> GenHaxl u w ()\nwrite wt = GenHaxl $ \\Env{..} -> do\n  modifyIORef' writeLogsRef (<> wt)\n  return $ Done ()\n\ntellWriteNoMemo :: w -> GenHaxl u (WriteTree w) ()\ntellWriteNoMemo = writeNoMemo . SomeWrite\n\nwriteNoMemo :: Monoid w => w -> GenHaxl u w ()\nwriteNoMemo wt = GenHaxl $ \\Env{..} -> do\n  modifyIORef' writeLogsRefNoMemo (<> wt)\n  return $ Done ()\n\n\ninstance IsString a => IsString (GenHaxl u w a) where\n  fromString s = return (fromString s)\n\n-- -----------------------------------------------------------------------------\n-- JobList\n\n-- | A list of computations together with the IVar into which they\n-- should put their result.\n--\n-- This could be an ordinary list, but the optimised representation\n-- saves space and time.\n--\ndata JobList u w\n = JobNil\n | forall a . JobCons\n     (Env u w)          -- See Note [make withEnv work] below.\n     (GenHaxl u w a)\n     {-# UNPACK #-} !(IVar u w a)\n     (JobList u w)\n\n-- Note [make withEnv work]\n--\n-- The withEnv operation supplies a new Env for the scope of a GenHaxl\n-- computation.  The problem is that the computation might be split\n-- into pieces and put onto various JobLists, so we have to be sure to\n-- use the correct Env when we execute the pieces. Furthermore, if one\n-- of these pieces blocks and gets run again later, we must ensure to\n-- restart it with the correct Env.  So we stash the Env along with\n-- the continuation in the JobList.\n\nappendJobList :: JobList u w -> JobList u w -> JobList u w\nappendJobList JobNil c = c\nappendJobList c JobNil = c\nappendJobList (JobCons a b c d) e = JobCons a b c $! appendJobList d e\n\nlengthJobList :: JobList u w -> Int\nlengthJobList JobNil = 0\nlengthJobList (JobCons _ _ _ j) = 1 + lengthJobList j\n\n\n-- -----------------------------------------------------------------------------\n-- IVar\n\n-- | A synchronisation point.  It either contains a value, or a list\n-- of computations waiting for the value.\n#ifdef PROFILING\ndata IVar u w a = IVar\n  { ivarRef :: {-# UNPACK #-} !(IORef (IVarContents u w a))\n  , ivarCCS :: {-# UNPACK #-} !(Ptr CostCentreStack)\n#else\nnewtype IVar u w a = IVar\n  { ivarRef :: IORef (IVarContents u w a)\n#endif\n  }\n\ndata IVarContents u w a\n  = IVarFull (ResultVal a w)\n  | IVarEmpty (JobList u w)\n    -- morally this is a list of @a -> GenHaxl u w ()@, but instead of\n    -- using a function, each computation begins with `getIVar` to grab\n    -- the value it is waiting for.  This is less type safe but a little\n    -- faster (benchmarked with tests/MonadBench.hs).\n\nnewIVar :: IO (IVar u w a)\nnewIVar = do\n  ivarRef <- newIORef (IVarEmpty JobNil)\n#ifdef PROFILING\n  ivarCCS <- getCurrentCCS ivarRef\n#endif\n  return IVar{..}\n\nnewFullIVar :: ResultVal a w -> IO (IVar u w a)\nnewFullIVar r = do\n  ivarRef <- newIORef (IVarFull r)\n#ifdef PROFILING\n  ivarCCS <- getCurrentCCS ivarRef\n#endif\n  return IVar{..}\n\nwithCurrentCCS :: IVar u w a -> IO (IVar u w a)\n#ifdef PROFILING\nwithCurrentCCS ivar = do\n  ccs <- getCurrentCCS ivar\n  return ivar{ivarCCS = ccs}\n#else\nwithCurrentCCS = return\n#endif\n\ngetIVar :: IVar u w a -> GenHaxl u w a\ngetIVar i@IVar{ivarRef = !ref} = GenHaxl $ \\env -> do\n  e <- readIORef ref\n  case e of\n    IVarFull (Ok a _wt) -> return (Done a)\n    IVarFull (ThrowHaxl e _wt) -> raiseFromIVar env i e\n    IVarFull (ThrowIO e) -> throwIO e\n    IVarEmpty _ -> return (Blocked i (Return i))\n\n-- Just a specialised version of getIVar, for efficiency in <*>\ngetIVarApply :: IVar u w (a -> b) -> a -> GenHaxl u w b\ngetIVarApply i@IVar{ivarRef = !ref} a = GenHaxl $ \\env -> do\n  e <- readIORef ref\n  case e of\n    IVarFull (Ok f _wt) -> return (Done (f a))\n    IVarFull (ThrowHaxl e _wt) -> raiseFromIVar env i e\n    IVarFull (ThrowIO e) -> throwIO e\n    IVarEmpty _ ->\n      return (Blocked i (Cont (getIVarApply i a)))\n\n-- Another specialised version of getIVar, for efficiency in cachedComputation\ngetIVarWithWrites :: Monoid w => IVar u w a -> GenHaxl u w a\ngetIVarWithWrites i@IVar{ivarRef = !ref} = GenHaxl $ \\env@Env{..} -> do\n  e <- readIORef ref\n  case e of\n    IVarFull (Ok a wt) -> do\n      modifyIORef' writeLogsRef (<> fromMaybe mempty wt)\n      return (Done a)\n    IVarFull (ThrowHaxl e wt) -> do\n      modifyIORef' writeLogsRef (<> fromMaybe mempty wt)\n      raiseFromIVar env i e\n    IVarFull (ThrowIO e) -> throwIO e\n    IVarEmpty _ ->\n      return (Blocked i (Cont (getIVarWithWrites i)))\n\nputIVar :: IVar u w a -> ResultVal a w -> Env u w -> IO ()\nputIVar IVar{ivarRef = !ref} a Env{..} = do\n  e <- readIORef ref\n  case e of\n    IVarEmpty jobs -> do\n      writeIORef ref (IVarFull a)\n      modifyIORef' runQueueRef (appendJobList jobs)\n      -- An IVar is typically only meant to be written to once\n      -- so it would make sense to throw an error here. But there\n      -- are legitimate use-cases for writing several times.\n      -- (See Haxl.Core.Parallel)\n    IVarFull{} -> return ()\n\n{-# INLINE addJob #-}\naddJob :: Env u w -> GenHaxl u w b -> IVar u w b -> IVar u w a -> IO ()\naddJob env !haxl !resultIVar IVar{ivarRef = !ref} =\n  modifyIORef' ref $ \\contents ->\n    case contents of\n      IVarEmpty list -> IVarEmpty (JobCons env haxl resultIVar list)\n      _ -> addJobPanic\n\naddJobPanic :: forall a . a\naddJobPanic = error \"addJob: not empty\"\n\n\n-- -----------------------------------------------------------------------------\n-- ResultVal\n\n-- | The contents of a full IVar.  We have to distinguish exceptions\n-- thrown in the IO monad from exceptions thrown in the Haxl monad, so\n-- that when the result is fetched using getIVar, we can throw the\n-- exception in the right way.\ndata ResultVal a w\n  = Ok a (Maybe w)\n  | ThrowHaxl SomeException (Maybe w)\n  | ThrowIO SomeException\n    -- we get no write logs when an IO exception occurs\n\ndone :: Env u w -> ResultVal a w -> IO (Result u w a)\ndone _ (Ok a _) = return (Done a)\ndone env (ThrowHaxl e _) = raise env e\ndone _ (ThrowIO e) = throwIO e\n\neitherToResultThrowIO :: Either SomeException a -> ResultVal a w\neitherToResultThrowIO (Right a) = Ok a Nothing\neitherToResultThrowIO (Left e)\n  | Just HaxlException{} <- fromException e = ThrowHaxl e Nothing\n  | otherwise = ThrowIO e\n\neitherToResult :: Either SomeException a -> ResultVal a w\neitherToResult (Right a) = Ok a Nothing\neitherToResult (Left e) = ThrowHaxl e Nothing\n\n\n-- -----------------------------------------------------------------------------\n-- CompleteReq\n\n-- | A completed request from a data source, containing the result,\n-- and the 'IVar' representing the blocked computations.  The job of a\n-- data source is just to add these to a queue ('completions') using\n-- 'putResult'; the scheduler collects them from the queue and unblocks\n-- the relevant computations.\ndata CompleteReq u w\n  = forall a . CompleteReq\n      (ResultVal a w)\n      !(IVar u w a)  -- IVar because the result is cached\n      {-# UNPACK #-} !Int64 -- see Note [tracking allocation in child threads]\n\n\n{- Note [tracking allocation in child threads]\n\nFor a BackgroundFetch, we might be doing some of the work in a\nseparate thread, but we want to make sure that the parent thread gets\ncharged for the allocation, so that allocation limits still work.\n\nThe design is a bit tricky here.  We want to track the allocation\naccurately but without adding much overhead.\n\nThe best way to propagate the allocation back from the child thread is\nthrough putResult.  If we had some other method, we would also need a\nway to synchronise it with the main runHaxl loop; the advantage of\nputResult is that this is already a synchronisation method, because\nrunHaxl is waiting for the result of the dataFetch.\n\nWe need a special version of putResult for child threads\n(putResultFromChildThread), because we don't want to propagate any\nallocation from the runHaxl thread back to itself and count it twice.\n\nWe also want to capture the allocation as late as possible, so that we\ncount everything.  For that reason, we pass a Bool down from putResult\ninto the function in the ResultVar, and it reads the allocation\ncounter as the last thing before adding the result to the completions\nTVar.\n\nThe other problem to consider is how to capture the allocation when\nthe child thread is doing multiple putResults.  Our solution here is\nto ensure that the *last* one is a putResultFromChildThread, so it\ncaptures all the allocation from everything leading up to it.\n\nWhy not reset the counter each time, so we could do multiple\nputResultFromChildThreads?  Because the child thread might be using an\nallocation limit itself, and changing the counter would mess it up.\n-}\n\n-- -----------------------------------------------------------------------------\n-- Result\n\n-- | The result of a computation is either 'Done' with a value, 'Throw'\n-- with an exception, or 'Blocked' on the result of a data fetch with\n-- a continuation.\ndata Result u w a\n  = Done a\n  | Throw SomeException\n  | forall b . Blocked\n      {-# UNPACK #-} !(IVar u w b)\n      (Cont u w a)\n         -- ^ The 'IVar' is what we are blocked on; 'Cont' is the\n         -- continuation.  This might be wrapped further if we're\n         -- nested inside multiple '>>=', before finally being added\n         -- to the 'IVar'.  Morally @b -> GenHaxl u w a@, but see\n         -- 'IVar',\n\ninstance (Show a) => Show (Result u w a) where\n  show (Done a) = printf \"Done(%s)\" $ show a\n  show (Throw e) = printf \"Throw(%s)\" $ show e\n  show Blocked{} = \"Blocked\"\n\ninstance Functor (Result u w) where\n  fmap f (Done a) = Done (f a)\n  fmap _ (Throw exc) = Throw exc\n  fmap f (Blocked ivar cont) = Blocked ivar (f :<$> cont)\n\n{- Note [Exception]\n\nHow do we want to represent Haxl exceptions (those that are thrown by\n\"throw\" in the Haxl monad)?\n\n1) Explicitly via a Throw constructor in the Result type\n2) Using throwIO in the IO monad\n\nIf we did (2), we would have to use an exception handler in <*>,\nbecause an exception in the right-hand argument of <*> should not\nnecessarily be thrown by the whole computation - an exception on the\nleft should get priority, and the left might currently be Blocked.\n\nWe must be careful about turning IO monad exceptions into Haxl\nexceptions.  An IO monad exception will normally propagate right\nout of runHaxl and terminate the whole computation, whereas a Haxl\nexception can get dropped on the floor, if it is on the right of\n<*> and the left side also throws, for example.  So turning an IO\nmonad exception into a Haxl exception is a dangerous thing to do.\nIn particular, we never want to do it for an asynchronous exception\n(AllocationLimitExceeded, ThreadKilled, etc.), because these are\nsupposed to unconditionally terminate the computation.\n\nThere are three places where we take an arbitrary IO monad exception and\nturn it into a Haxl exception:\n\n * wrapFetchInCatch.  Here we want to propagate a failure of the\n   data source to the callers of the data source, but if the\n   failure came from elsewhere (an asynchronous exception), then we\n   should just propagate it\n\n * cacheResult (cache the results of IO operations): again,\n   failures of the IO operation should be visible to the caller as\n   a Haxl exception, but we exclude asynchronous exceptions from\n   this.\n\n * unsafeToHaxlException: assume the caller knows what they're\n   doing, and just wrap all exceptions.\n-}\n\n\n-- -----------------------------------------------------------------------------\n-- Cont\n\n-- | A data representation of a Haxl continuation.  This is to avoid\n-- repeatedly traversing a left-biased tree in a continuation, leading\n-- O(n^2) complexity for some pathalogical cases - see the \"seql\" benchmark\n-- in tests/MonadBench.hs.\n-- See \"A Smart View on Datatypes\", Jaskelioff/Rivas, ICFP'15\ndata Cont u w a\n  = Cont (GenHaxl u w a)\n  | forall b. Cont u w b :>>= (b -> GenHaxl u w a)\n  | forall b. (b -> a) :<$> (Cont u w b)\n  | Return (IVar u w a)\n\ntoHaxl :: Cont u w a -> GenHaxl u w a\ntoHaxl (Cont haxl) = haxl\ntoHaxl (m :>>= k) = toHaxlBind m k\ntoHaxl (f :<$> x) = toHaxlFmap f x\ntoHaxl (Return i) = getIVar i\n\ntoHaxlBind :: Cont u w b -> (b -> GenHaxl u w a) -> GenHaxl u w a\ntoHaxlBind (m :>>= k) k2 = toHaxlBind m (k >=> k2)\ntoHaxlBind (Cont haxl) k = haxl >>= k\ntoHaxlBind (f :<$> x) k = toHaxlBind x (k . f)\ntoHaxlBind (Return i) k = getIVar i >>= k\n\ntoHaxlFmap :: (a -> b) -> Cont u w a -> GenHaxl u w b\ntoHaxlFmap f (m :>>= k) = toHaxlBind m (k >=> return . f)\ntoHaxlFmap f (Cont haxl) = f <$> haxl\ntoHaxlFmap f (g :<$> x) = toHaxlFmap (f . g) x\ntoHaxlFmap f (Return i) = f <$> getIVar i\n\n-- -----------------------------------------------------------------------------\n-- Monad/Applicative instances\n\ninstance Monad (GenHaxl u w) where\n  return = pure\n  GenHaxl m >>= k = GenHaxl $ \\env -> do\n    e <- m env\n    case e of\n      Done a -> unHaxl (k a) env\n      Throw e -> return (Throw e)\n      Blocked ivar cont -> trace_ \">>= Blocked\" $\n        return (Blocked ivar (cont :>>= k))\n\n  -- We really want the Applicative version of >>\n  (>>) = (*>)\n\n#if __GLASGOW_HASKELL__ >= 808\ninstance CTL.MonadFail (GenHaxl u w) where\n#endif\n  fail msg = GenHaxl $ \\_env ->\n    return $ Throw $ toException $ MonadFail $ Text.pack msg\n\ninstance Functor (GenHaxl u w) where\n  fmap f (GenHaxl m) = GenHaxl $ \\env -> do\n    r <- m env\n    case r of\n      Done a -> return (Done (f a))\n      Throw e -> return (Throw e)\n      Blocked ivar cont -> trace_ \"fmap Blocked\" $\n        return (Blocked ivar (f :<$> cont))\n\ninstance Applicative (GenHaxl u w) where\n  pure a = GenHaxl $ \\_env -> pure (Done a)\n  GenHaxl ff <*> GenHaxl aa = GenHaxl $ \\env -> do\n    rf <- ff env\n    case rf of\n      Done f -> do\n        ra <- aa env\n        case ra of\n          Done a -> trace_ \"Done/Done\" $ return (Done (f a))\n          Throw e -> trace_ \"Done/Throw\" $ return (Throw e)\n          Blocked ivar fcont -> trace_ \"Done/Blocked\" $\n            return (Blocked ivar (f :<$> fcont))\n      Throw e -> trace_ \"Throw\" $ return (Throw e)\n      Blocked ivar1 fcont -> do\n        ra <- aa env\n        case ra of\n          Done a -> trace_ \"Blocked/Done\" $\n            return (Blocked ivar1 (($ a) :<$> fcont))\n          Throw e -> trace_ \"Blocked/Throw\" $\n            return (Blocked ivar1 (fcont :>>= (\\_ -> throw e)))\n          Blocked ivar2 acont -> trace_ \"Blocked/Blocked\" $\n            blockedBlocked env ivar1 fcont ivar2 acont\n             -- Note [Blocked/Blocked]\n\ninstance Semigroup a => Semigroup (GenHaxl u w a) where\n  (<>) = liftA2 (<>)\n\ninstance Monoid a => Monoid (GenHaxl u w a) where\n  mempty = pure mempty\n#if __GLASGOW_HASKELL__ < 804\n  mappend = liftA2 mappend\n#endif\n\nblockedBlocked\n  :: Env u w\n  -> IVar u w c\n  -> Cont u w (a -> b)\n  -> IVar u w d\n  -> Cont u w a\n  -> IO (Result u w b)\nblockedBlocked _ _ (Return i) ivar2 acont =\n  return (Blocked ivar2 (acont :>>= getIVarApply i))\nblockedBlocked _ _ (g :<$> Return i) ivar2 acont =\n  return (Blocked ivar2 (acont :>>= \\ a -> (\\f -> g f a) <$> getIVar i))\nblockedBlocked env ivar1 fcont ivar2 acont = do\n  i <- newIVar\n  addJob env (toHaxl fcont) i ivar1\n  let cont = acont :>>= \\a -> getIVarApply i a\n  return (Blocked ivar2 cont)\n\n-- Note [Blocked/Blocked]\n--\n-- This is the tricky case: we're blocked on both sides of the <*>.\n-- We need to divide the computation into two pieces that may continue\n-- independently when the resources they are blocked on become\n-- available.  Moreover, the computation as a whole depends on the two\n-- pieces.  It works like this:\n--\n--   ff <*> aa\n--\n-- becomes\n--\n--   (ff >>= putIVar i) <*> (a <- aa; f <- getIVar i; return (f a)\n--\n-- where the IVar i is a new synchronisation point.  If the right side\n-- gets to the `getIVar` first, it will block until the left side has\n-- called 'putIVar'.\n--\n-- We can also do it the other way around:\n--\n--   (do ff <- f; getIVar i; return (ff a)) <*> (a >>= putIVar i)\n--\n-- The first was slightly faster according to tests/MonadBench.hs.\n\n\n\n-- -----------------------------------------------------------------------------\n-- Env utils\n\n-- | Extracts data from the 'Env'.\nenv :: (Env u w -> a) -> GenHaxl u w a\nenv f = GenHaxl $ \\env -> return (Done (f env))\n\n-- | Returns a version of the Haxl computation which always uses the\n-- provided 'Env', ignoring the one specified by 'runHaxl'.\nwithEnv :: Env u w -> GenHaxl u w a -> GenHaxl u w a\nwithEnv newEnv (GenHaxl m) = GenHaxl $ \\_env -> do\n  r <- m newEnv\n  case r of\n    Done a -> return (Done a)\n    Throw e -> return (Throw e)\n    Blocked ivar k ->\n      return (Blocked ivar (Cont (withEnv newEnv (toHaxl k))))\n\nnextCallId :: Env u w -> IO CallId\nnextCallId env = atomicModifyIORef' (callIdRef env) $ \\x -> (x+1,x+1)\n\n-- | Runs the Haxl computation, transforming the writes within using the\n-- provided function.\n--\n-- Memoization behavior is unchanged, meaning if a memoized computation is run\n-- once inside @mapWrites@ and then once without, the writes from the second run\n-- will NOT be transformed.\nmapWrites :: Monoid w => (w -> w) -> GenHaxl u w a -> GenHaxl u w a\nmapWrites f action = GenHaxl $ \\curEnv -> do\n  wlogs <- newIORef mempty\n  wlogsNoMemo <- newIORef mempty\n  let\n    !newEnv = curEnv { writeLogsRef = wlogs, writeLogsRefNoMemo = wlogsNoMemo }\n  unHaxl (mapWritesImpl curEnv newEnv action) newEnv\n  where\n    mapWritesImpl oldEnv curEnv (GenHaxl m) = GenHaxl $ \\_ -> do\n      let\n        pushTransformedWrites = do\n          wt <- readIORef $ writeLogsRef curEnv\n          modifyIORef' (writeLogsRef oldEnv) (<> f wt)\n          wtNoMemo <- readIORef $ writeLogsRefNoMemo curEnv\n          modifyIORef' (writeLogsRefNoMemo oldEnv) (<> f wtNoMemo)\n\n      r <- m curEnv\n\n      case r of\n        Done a -> pushTransformedWrites >> return (Done a)\n        Throw e -> pushTransformedWrites >> return (Throw e)\n        Blocked ivar k -> return\n          (Blocked ivar (Cont (mapWritesImpl oldEnv curEnv (toHaxl k))))\n\n#ifdef PROFILING\n-- -----------------------------------------------------------------------------\n-- CallGraph recording\n\n-- | Returns a version of the Haxl computation which records function calls in\n-- an edge list which is the function call graph. Each function that is to be\n-- recorded must be wrapped with a call to @withCallGraph@.\nwithCallGraph\n  :: Typeable a\n  => (a -> Maybe Text)\n  -> QualFunction\n  -> GenHaxl u w a\n  -> GenHaxl u w a\nwithCallGraph toText f a = do\n  coreEnv <- env id\n  -- TODO: Handle exceptions\n  value <- withEnv coreEnv{currFunction = f} a\n  case callGraphRef coreEnv of\n    Just graph -> unsafeLiftIO $ modifyIORef' graph\n      (updateCallGraph (f, currFunction coreEnv) (toText value))\n    _ -> throw $ CriticalError\n      \"withCallGraph called without an IORef CallGraph\"\n  return value\n  where\n    updateCallGraph :: FunctionCall -> Maybe Text -> CallGraph -> CallGraph\n    updateCallGraph fnCall@(childQFunc, _) (Just value) (edgeList, valueMap) =\n      (fnCall : edgeList, Map.insert childQFunc value valueMap)\n    updateCallGraph fnCall Nothing (edgeList, valueMap) =\n      (fnCall : edgeList, valueMap)\n#endif\n\n-- -----------------------------------------------------------------------------\n-- Exceptions\n\n-- | Throw an exception in the Haxl monad\nthrow :: Exception e => e -> GenHaxl u w a\nthrow e = GenHaxl $ \\env -> raise env e\n\nraise :: Exception e => Env u w -> e -> IO (Result u w a)\nraise env e = raiseImpl env (toException e)\n#ifdef PROFILING\n  currentCallStack\n#endif\n\n\nraiseFromIVar :: Exception e => Env u w -> IVar u w a -> e -> IO (Result u w b)\n#ifdef PROFILING\nraiseFromIVar env IVar{..} e =\n  raiseImpl env (toException e) (ccsToStrings ivarCCS)\n#else\nraiseFromIVar env _ivar e = raiseImpl env (toException e)\n#endif\n\n{-# INLINE raiseImpl #-}\n#ifdef PROFILING\nraiseImpl :: Env u w -> SomeException -> IO [String] -> IO (Result u w b)\nraiseImpl Env{..} e getCostCentreStack\n#else\nraiseImpl :: Env u w -> SomeException -> IO (Result u w b)\nraiseImpl Env{..} e\n#endif\n  | testReportFlag ReportExceptionLabelStack $ report flags\n  , Just (HaxlException Nothing h) <- fromException e = do\n    let stk = NonEmpty.toList $ profLabelStack profCurrent\n    return $ Throw $ toException $ HaxlException (Just stk) h\n#ifdef PROFILING\n  | Just (HaxlException Nothing h) <- fromException e = do\n    stk <- reverse . map Text.pack <$> getCostCentreStack\n    return $ Throw $ toException $ HaxlException (Just stk) h\n#endif\n  | otherwise = return $ Throw e\n\n-- | Catch an exception in the Haxl monad\ncatch :: Exception e => GenHaxl u w a -> (e -> GenHaxl u w a) -> GenHaxl u w a\ncatch (GenHaxl m) h = GenHaxl $ \\env -> do\n   r <- m env\n   case r of\n     Done a    -> return (Done a)\n     Throw e | Just e' <- fromException e -> unHaxl (h e') env\n             | otherwise -> return (Throw e)\n     Blocked ivar k -> return (Blocked ivar (Cont (catch (toHaxl k) h)))\n\n-- | Catch exceptions that satisfy a predicate\ncatchIf\n  :: Exception e => (e -> Bool) -> GenHaxl u w a -> (e -> GenHaxl u w a)\n  -> GenHaxl u w a\ncatchIf cond haxl handler =\n  catch haxl $ \\e -> if cond e then handler e else throw e\n\n-- | Returns @'Left' e@ if the computation throws an exception @e@, or\n-- @'Right' a@ if it returns a result @a@.\ntry :: Exception e => GenHaxl u w a -> GenHaxl u w (Either e a)\ntry haxl = (Right <$> haxl) `catch` (return . Left)\n\n-- | @since 0.3.1.0\ninstance Catch.MonadThrow (GenHaxl u w) where throwM = Haxl.Core.Monad.throw\n-- | @since 0.3.1.0\ninstance Catch.MonadCatch (GenHaxl u w) where catch = Haxl.Core.Monad.catch\n\n\n-- -----------------------------------------------------------------------------\n-- Unsafe operations\n\n-- | Under ordinary circumstances this is unnecessary; users of the Haxl\n-- monad should generally /not/ perform arbitrary IO.\nunsafeLiftIO :: IO a -> GenHaxl u w a\nunsafeLiftIO m = GenHaxl $ \\_env -> Done <$> m\n\n-- | Convert exceptions in the underlying IO monad to exceptions in\n-- the Haxl monad.  This is morally unsafe, because you could then\n-- catch those exceptions in Haxl and observe the underlying execution\n-- order.  Not to be exposed to user code.\n--\n-- Note: this function does not catch async exceptions. This is a flaw in Haxl\n-- where it can sometimes leave the environment in a bad state when async\n-- exceptions are thrown (for example the cache may think a fetch is happening\n-- but the exception has stopped it). TODO would be to make Haxl async exception\n-- safe and then remove the rethrowAsyncExceptions below, but for now this is\n-- safer to avoid bugs. Additionally this would not protect you from async\n-- exceptions thrown while executing code in the scheduler, and so relying on\n-- this function to catch all async exceptions would be ambitious at best.\nunsafeToHaxlException :: GenHaxl u w a -> GenHaxl u w a\nunsafeToHaxlException (GenHaxl m) = GenHaxl $ \\env -> do\n  r <- m env `Exception.catch` \\e -> do\n    rethrowAsyncExceptions e\n    return (Throw e)\n  case r of\n    Blocked cvar c ->\n      return (Blocked cvar (Cont (unsafeToHaxlException (toHaxl c))))\n    other -> return other\n\n-- | Like 'try', but lifts all exceptions into the 'HaxlException'\n-- hierarchy.  Uses 'unsafeToHaxlException' internally.  Typically\n-- this is used at the top level of a Haxl computation, to ensure that\n-- all exceptions are caught.\ntryToHaxlException :: GenHaxl u w a -> GenHaxl u w (Either HaxlException a)\ntryToHaxlException h = left asHaxlException <$> try (unsafeToHaxlException h)\n\n\n-- -----------------------------------------------------------------------------\n\n-- | Dump the contents of the cache as Haskell code that, when\n-- compiled and run, will recreate the same cache contents.  For\n-- example, the generated code looks something like this:\n--\n-- > loadCache :: GenHaxl u w ()\n-- > loadCache = do\n-- >   cacheRequest (ListWombats 3) (Right ([1,2,3]))\n-- >   cacheRequest (CountAardvarks \"abcabc\") (Right (2))\n--\ndumpCacheAsHaskell :: GenHaxl u w String\ndumpCacheAsHaskell =\n    dumpCacheAsHaskellFn \"loadCache\" \"GenHaxl u w ()\" \"cacheRequest\"\n\n-- | Dump the contents of the cache as Haskell code that, when\n-- compiled and run, will recreate the same cache contents.\n-- Does not take into account the writes done as part of the computation.\n--\n-- Takes the name and type for the resulting function as arguments.\n-- Also takes the cacheFn to use, we can use either @cacheRequest@ or\n-- @dupableCacheRequest@.\ndumpCacheAsHaskellFn :: String -> String -> String -> GenHaxl u w String\ndumpCacheAsHaskellFn fnName fnType cacheFn = do\n  cache <- env dataCache  -- NB. dataCache, not memoCache.  We ignore memoized\n                       -- results when dumping the cache.\n  let\n    readIVar (DataCacheItem IVar{ivarRef = !ref} _) = do\n      r <- readIORef ref\n      case r of\n        IVarFull (Ok a _) -> return (Just (Right a))\n        IVarFull (ThrowHaxl e _) -> return (Just (Left e))\n        IVarFull (ThrowIO e) -> return (Just (Left e))\n        IVarEmpty _ -> return Nothing\n\n    mk_cr (req, res) =\n      text cacheFn <+> parens (text req) <+> parens (result res)\n    result (Left e) = text \"except\" <+> parens (text (show e))\n    result (Right s) = text \"Right\" <+> parens (text s)\n\n  entries <- unsafeLiftIO $ do\n    showCache cache readIVar\n\n  let\n    body = if null entries\n      then text \"return ()\"\n      else vcat (map mk_cr (concatMap snd entries))\n\n  return $ show $\n    text (fnName ++ \" :: \" ++ fnType) $$\n    text (fnName ++ \" = do\") $$\n      nest 2 body $$\n    text \"\" -- final newline\n", "num_lines": 1137}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RecordWildCards #-}\n\n-- | Psuedo-parallel operations.  Most users should import \"Haxl.Core\"\n-- instead.\n--\nmodule Haxl.Core.Parallel\n  ( -- * Parallel operations\n    biselect\n  , pAnd\n  , pOr\n  , unsafeChooseFirst\n  ) where\n\nimport Haxl.Core.Monad hiding (catch, throw)\nimport Haxl.Core.Exception\n\nimport Control.Exception (throw)\n\n-- -----------------------------------------------------------------------------\n-- Parallel operations\n\n-- Bind more tightly than .&&, .||\ninfixr 5 `pAnd`\ninfixr 4 `pOr`\n\n\nbiselect :: GenHaxl u w (Either a b)\n         -> GenHaxl u w (Either a c)\n         -> GenHaxl u w (Either a (b,c))\nbiselect haxla haxlb = biselect_opt id id Left Right haxla haxlb\n\n{-# INLINE biselect_opt #-}\nbiselect_opt :: (l -> Either a b)\n             -> (r -> Either a c)\n             -> (a -> t)\n             -> ((b,c) -> t)\n             -> GenHaxl u w l\n             -> GenHaxl u w r\n             -> GenHaxl u w t\nbiselect_opt discrimA discrimB left right haxla haxlb =\n  let go (GenHaxl haxla) (GenHaxl haxlb) = GenHaxl $ \\env -> do\n        ra <- haxla env\n        case ra of\n          Done ea ->\n            case discrimA ea of\n              Left a -> return (Done (left a))\n              Right b -> do\n                  rb <- haxlb env\n                  case rb of\n                    Done eb ->\n                      case discrimB eb of\n                        Left a -> return (Done (left a))\n                        Right c -> return (Done (right (b,c)))\n                    Throw e -> return (Throw e)\n                    Blocked ib haxlb' ->\n                      return (Blocked ib\n                              (haxlb' :>>= \\b' -> go_right b b'))\n          Throw e -> return (Throw e)\n          Blocked ia haxla' -> do\n            rb <- haxlb env\n            case rb of\n              Done eb ->\n                case discrimB eb of\n                  Left a -> return (Done (left a))\n                  Right c ->\n                     return (Blocked ia\n                             (haxla' :>>= \\a' -> go_left a' c))\n              Throw e -> return (Throw e)\n              Blocked ib haxlb' -> do\n                i <- newIVar\n                addJob env (return ()) i ia\n                addJob env (return ()) i ib\n                return (Blocked i (Cont (go (toHaxl haxla') (toHaxl haxlb'))))\n                -- The code above makes sure that the computation\n                -- wakes up whenever either 'ia' or 'ib' is filled.\n                -- The ivar 'i' is used as a synchronisation point\n                -- for the whole computation, and we make sure that\n                -- whenever 'ia' or 'ib' are filled in then 'i' will\n                -- also be filled.\n\n      go_right b eb =\n        case discrimB eb of\n          Left a -> return (left a)\n          Right c -> return (right (b,c))\n      go_left ea c =\n        case discrimA ea of\n          Left a -> return (left a)\n          Right b -> return (right (b,c))\n  in go haxla haxlb\n\n-- | Parallel version of '(.||)'.  Both arguments are evaluated in\n-- parallel, and if either returns 'True' then the other is\n-- not evaluated any further.\n--\n-- WARNING: exceptions may be unpredictable when using 'pOr'.  If one\n-- argument returns 'True' before the other completes, then 'pOr'\n-- returns 'True' immediately, ignoring a possible exception that\n-- the other argument may have produced if it had been allowed to\n-- complete.\npOr :: GenHaxl u w Bool -> GenHaxl u w Bool -> GenHaxl u w Bool\npOr x y = biselect_opt discrim discrim left right x y\n  where\n    discrim True = Left ()\n    discrim False = Right ()\n    left _ = True\n    right _ = False\n\n-- | Parallel version of '(.&&)'.  Both arguments are evaluated in\n-- parallel, and if either returns 'False' then the other is\n-- not evaluated any further.\n--\n-- WARNING: exceptions may be unpredictable when using 'pAnd'.  If one\n-- argument returns 'False' before the other completes, then 'pAnd'\n-- returns 'False' immediately, ignoring a possible exception that\n-- the other argument may have produced if it had been allowed to\n-- complete.\npAnd :: GenHaxl u w Bool -> GenHaxl u w Bool -> GenHaxl u w Bool\npAnd x y = biselect_opt discrim discrim left right x y\n  where\n    discrim False = Left ()\n    discrim True = Right ()\n    left _ = False\n    right _ = True\n\n-- | This function takes two haxl computations as input, and returns the\n-- output of whichever computation finished first. This is clearly\n-- non-deterministic in its output and exception behavior, be careful when\n-- using it.\nunsafeChooseFirst\n  :: GenHaxl u w a\n  -> GenHaxl u w b\n  -> GenHaxl u w (Either a b)\nunsafeChooseFirst x y = biselect_opt discrimx discrimy id right x y\n  where\n    discrimx :: a -> Either (Either a b) ()\n    discrimx a = Left (Left a)\n\n    discrimy :: b -> Either (Either a b) ()\n    discrimy b = Left (Right b)\n\n    right _ = throw $ CriticalError\n      \"unsafeChooseFirst: We should never have a 'Right ()'\"\n", "num_lines": 152}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE MagicHash #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- | Implementation of lightweight profiling.  Most users should\n-- import \"Haxl.Core\" instead.\n--\nmodule Haxl.Core.Profile\n  ( withLabel\n  , withFingerprintLabel\n  , addProfileFetch\n  , incrementMemoHitCounterFor\n  , collectProfileData\n  , profileCont\n  ) where\n\nimport Data.IORef\nimport Data.Hashable\nimport Data.List.NonEmpty (NonEmpty(..), (<|))\n#if __GLASGOW_HASKELL__ < 804\nimport Data.Monoid\n#endif\nimport Data.Typeable\nimport qualified Data.HashMap.Strict as HashMap\nimport GHC.Exts\nimport qualified Data.Text as Text\nimport Haxl.Core.DataSource\nimport Haxl.Core.Flags\nimport Haxl.Core.Stats\nimport Haxl.Core.Monad\n\n-- -----------------------------------------------------------------------------\n-- Profiling\n\n-- | Label a computation so profiling data is attributed to the label.\nwithLabel :: ProfileLabel -> GenHaxl u w a -> GenHaxl u w a\nwithLabel l (GenHaxl m) = GenHaxl $ \\env ->\n  if not $ testReportFlag ReportProfiling $ report $ flags env\n     then m env\n     else collectProfileData l m env\n\n-- | Label a computation so profiling data is attributed to the label.\n-- Intended only for internal use by 'memoFingerprint'.\nwithFingerprintLabel :: Addr# -> Addr# -> GenHaxl u w a -> GenHaxl u w a\nwithFingerprintLabel mnPtr nPtr (GenHaxl m) = GenHaxl $ \\env ->\n  if not $ testReportFlag ReportProfiling $ report $ flags env\n     then m env\n     else collectProfileData\n            (Text.unpackCString# mnPtr <> \".\" <> Text.unpackCString# nPtr)\n            m env\n\n-- | Collect profiling data and attribute it to given label.\ncollectProfileData\n  :: ProfileLabel\n  -> (Env u w -> IO (Result u w a))\n  -> Env u w\n  -> IO (Result u w a)\ncollectProfileData l m env = do\n  let ProfileCurrent prevProfKey (prevProfLabel :| _) = profCurrent env\n  if prevProfLabel == l\n  then\n    -- do not add a new label if we are recursing\n    m env\n  else do\n    key <- atomicModifyIORef' (profRef env) $ \\p ->\n      case HashMap.lookup (l, prevProfKey) (profileTree p) of\n        Just k -> (p, k)\n        Nothing -> (p\n          { profileTree = HashMap.insert\n            (l, prevProfKey)\n            (profileNextKey p)\n            (profileTree p)\n          , profileNextKey = profileNextKey p + 1 }, profileNextKey p)\n    runProfileData l key m False env\n{-# INLINE collectProfileData #-}\n\nrunProfileData\n  :: ProfileLabel\n  -> ProfileKey\n  -> (Env u w -> IO (Result u w a))\n  -> Bool\n  -> Env u w\n  -> IO (Result u w a)\nrunProfileData l key m isCont env = do\n  t0 <- getTimestamp\n  a0 <- getAllocationCounter\n  let\n    ProfileCurrent caller stack = profCurrent env\n    nextCurrent = ProfileCurrent\n      { profCurrentKey = key\n      , profLabelStack = l <| stack\n      }\n    runCont (GenHaxl h) = GenHaxl $ runProfileData l key h True\n\n  r <- m env{profCurrent=nextCurrent} -- what if it throws?\n\n  -- Make the result strict in Done/Throw so that if the user code\n  -- returns (force a), the force is evaluated *inside* the profile.\n  result <- case r of\n    Done !a -> return (Done a)\n    Throw !e -> return (Throw e)\n    Blocked ivar k -> return (Blocked ivar (Cont $ runCont (toHaxl k)))\n\n  a1 <- getAllocationCounter\n  t1 <- getTimestamp\n\n  -- caller might not be the actual caller of this function\n  -- for example MAIN may be continuing a function from the middle of the stack.\n  -- But this is what we want as we need to account for allocations.\n  -- So do not be tempted to pass through prevProfKey (from collectProfileData)\n  -- which is the original caller\n  modifyProfileData env key caller (a0 - a1) (t1-t0) (if isCont then 0 else 1)\n\n  -- So we do not count the allocation overhead of modifyProfileData\n  setAllocationCounter a1\n  return result\n{-# INLINE runProfileData #-}\n\nmodifyProfileData\n  :: Env u w\n  -> ProfileKey\n  -> ProfileKey\n  -> AllocCount\n  -> Microseconds\n  -> LabelHitCount\n  -> IO ()\nmodifyProfileData env key caller allocs t labelIncrement = do\n  modifyIORef' (profRef env) $ \\ p ->\n    p { profile =\n          HashMap.insertWith updEntry key newEntry .\n          HashMap.insertWith updCaller caller newCaller $\n          profile p }\n  where newEntry =\n          emptyProfileData\n            { profileAllocs = allocs\n            , profileLabelHits = labelIncrement\n            , profileTime = t\n            }\n        updEntry _ old =\n          old\n            { profileAllocs = profileAllocs old + allocs\n            , profileLabelHits = profileLabelHits old + labelIncrement\n            , profileTime = profileTime old + t\n            }\n        -- subtract allocs/time from caller, so they are not double counted\n        -- we don't know the caller's caller, but it will get set on\n        -- the way back out, so an empty hashset is fine for now\n        newCaller =\n          emptyProfileData { profileAllocs = -allocs\n                           , profileTime = -t\n                           }\n        updCaller _ old =\n          old { profileAllocs = profileAllocs old - allocs\n              , profileTime = profileTime old - t\n              }\n\n\n-- Like collectProfileData, but intended to be run from the scheduler.\n--\n-- * doesn't add a dependency (the original withLabel did this)\n--\n-- * doesn't subtract allocs from the caller (we're evaluating this\n--   cont from the top level, so we don't need this)\n--\n-- * doesn't wrap a Blocked continuation in withLabel (the scheduler\n--   will call profileCont the next time this cont runs)\n--\nprofileCont\n  :: (Env u w -> IO (Result u w a))\n  -> Env u w\n  -> IO (Result u w a)\nprofileCont m env = do\n  t0 <- getTimestamp\n  a0 <- getAllocationCounter\n  r <- m env\n  a1 <- getAllocationCounter\n  t1 <- getTimestamp\n  let\n    allocs = a0 - a1\n    t = t1 - t0\n    newEntry = emptyProfileData\n      { profileAllocs = allocs\n      , profileTime = t\n      }\n    updEntry _ old = old\n      { profileAllocs = profileAllocs old + allocs\n      , profileTime = profileTime old + t\n      }\n    profKey = profCurrentKey (profCurrent env)\n  modifyIORef' (profRef env) $ \\ p ->\n    p { profile =\n         HashMap.insertWith updEntry profKey newEntry $\n         profile p }\n  -- So we do not count the allocation overhead of modifyProfileData\n  setAllocationCounter a1\n  return r\n{-# INLINE profileCont #-}\n\nincrementMemoHitCounterFor :: Env u w -> CallId -> Bool -> IO ()\nincrementMemoHitCounterFor env callId wasCached = do\n  modifyIORef' (profRef env) $ \\p ->  p {\n    profile = HashMap.insertWith\n                upd\n                (profCurrentKey $ profCurrent env)\n                (emptyProfileData { profileMemos = [val] })\n                (profile p)\n    }\n  where\n    val = ProfileMemo callId wasCached\n    upd _ old = old { profileMemos = val : profileMemos old }\n\n{-# NOINLINE addProfileFetch #-}\naddProfileFetch\n  :: forall r u w a . (DataSourceName r, Eq (r a), Hashable (r a), Typeable (r a))\n  => Env u w -> r a -> CallId -> Bool -> IO ()\naddProfileFetch env _req cid wasCached = do\n  c <- getAllocationCounter\n  let (ProfileCurrent profKey _) = profCurrent env\n  modifyIORef' (profRef env) $ \\ p ->\n    let\n      val = ProfileFetch cid (memoKey env) wasCached\n      upd _ old = old { profileFetches = val : profileFetches old }\n\n    in p { profile =\n           HashMap.insertWith\n             upd\n             profKey\n             (emptyProfileData { profileFetches = [val] })\n             (profile p)\n         }\n  -- So we do not count the allocation overhead of addProfileFetch\n  setAllocationCounter c\n", "num_lines": 243}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE KindSignatures #-}\n{-# LANGUAGE BangPatterns #-}\n-- | Bucketing requests by 'DataSource'.\n--\n-- When a request is issued by the client via 'dataFetch', it is placed\n-- in the 'RequestStore'. When we are ready to fetch the current batch\n-- of requests, the 'contents' operation extracts the fetches, bucketed\n-- by 'DataSource'.\n--\n-- This module is provided for access to Haxl internals only; most\n-- users should not need to import it.\n--\nmodule Haxl.Core.RequestStore\n  ( BlockedFetches(..)\n  , BlockedFetchInternal(..)\n  , RequestStore\n  , isEmpty\n  , noRequests\n  , addRequest\n  , contents\n  , getSize\n  , ReqCountMap(..)\n  , emptyReqCounts\n  , filterRCMap\n  , getMapFromRCMap\n  , getSummaryMapFromRCMap\n  , addToCountMap\n  , subFromCountMap\n  ) where\n\nimport Haxl.Core.DataSource\nimport Haxl.Core.Stats\nimport Data.Map (Map)\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Map.Strict as Map\nimport Data.Proxy\nimport Data.Text (Text)\nimport Data.Kind (Type)\nimport Data.Typeable\nimport Unsafe.Coerce\n\n-- | A container for multiple 'BlockedFetch' objects.\nnewtype RequestStore u = RequestStore (Map TypeRep (BlockedFetches u))\n  -- Since we don't know which data sources we will be using, the store\n  -- is dynamically-typed.  It maps the TypeRep of the request to the\n  -- 'BlockedFetches' for that 'DataSource'.\n\nnewtype BlockedFetchInternal = BlockedFetchInternal CallId\n\n-- | A batch of 'BlockedFetch' objects for a single 'DataSource'\ndata BlockedFetches u =\n  forall r. (DataSource u r) =>\n        BlockedFetches [BlockedFetch r] [BlockedFetchInternal]\n\nisEmpty :: RequestStore u -> Bool\nisEmpty (RequestStore m) = Map.null m\n\n-- | A new empty 'RequestStore'.\nnoRequests :: RequestStore u\nnoRequests = RequestStore Map.empty\n\n-- | Adds a 'BlockedFetch' to a 'RequestStore'.\naddRequest\n  :: forall u r. (DataSource u r)\n  => BlockedFetch r -> BlockedFetchInternal -> RequestStore u -> RequestStore u\naddRequest bf bfi (RequestStore m) =\n  RequestStore $ Map.insertWith combine ty (BlockedFetches [bf] [bfi]) m\n where\n  combine :: BlockedFetches u -> BlockedFetches u -> BlockedFetches u\n  combine _ (BlockedFetches bfs bfis)\n    | typeOf1 (getR bfs) == ty = BlockedFetches (unsafeCoerce bf:bfs) (bfi:bfis)\n    | otherwise                = error \"RequestStore.insert\"\n         -- the dynamic type check here should be unnecessary, but if\n         -- there are bugs in `Typeable` or `Map` then we'll get an\n         -- error instead of a crash.  The overhead is negligible.\n\n  -- a type conversion only, so we can get the type of the reqeusts from\n  -- the list of BlockedFetch.\n  getR :: [BlockedFetch r1] -> r1 a\n  getR _ = undefined\n\n  -- The TypeRep of requests for this data source\n  ty :: TypeRep\n  !ty = typeOf1 (undefined :: r a)\n\n-- | Retrieves the whole contents of the 'RequestStore'.\ncontents :: RequestStore u -> [BlockedFetches u]\ncontents (RequestStore m) = Map.elems m\n\ngetSize :: RequestStore u -> Int\ngetSize (RequestStore m) = Map.size m\n\n-- A counter to keep track of outgone requests. Entries are added to this\n-- map as we send requests to datasources, and removed as these fetches\n-- are completed.\n-- This is a 2 level map: the 1st level stores requests for a particular\n-- datasource, the 2nd level stores count of requests per type.\nnewtype ReqCountMap = ReqCountMap (Map Text (Map TypeRep Int))\n  deriving (Show)\n\nemptyReqCounts :: ReqCountMap\nemptyReqCounts = ReqCountMap Map.empty\n\naddToCountMap\n  :: forall (r :: Type -> Type). (DataSourceName r, Typeable r)\n  => Proxy r\n  -> Int -- type and number of requests\n  -> ReqCountMap\n  -> ReqCountMap\naddToCountMap = updateCountMap (+)\n\nsubFromCountMap\n  :: forall (r :: Type -> Type). (DataSourceName r, Typeable r)\n  => Proxy r\n  -> Int -- type and number of requests\n  -> ReqCountMap\n  -> ReqCountMap\nsubFromCountMap = updateCountMap (-)\n\nupdateCountMap\n  :: forall (r :: Type -> Type). (DataSourceName r, Typeable r)\n  => (Int -> Int -> Int)\n  -> Proxy r\n  -> Int -- type and number of requests\n  -> ReqCountMap\n  -> ReqCountMap\nupdateCountMap op p n (ReqCountMap m) = ReqCountMap $ Map.insertWith\n  (flip (Map.unionWith op)) -- flip is important as \"op\" is not commutative\n  (dataSourceName p) (Map.singleton ty n)\n  m\n  where\n    -- The TypeRep of requests for this data source\n    -- The way this is implemented, all elements in the 2nd level map will be\n    -- mapped to the same key, as all requests to a datasource have the same\n    -- \"type\". It will be more beneficial to be able to instead map requests\n    -- to their names (ie, data constructor) - but there's no cheap way of doing\n    -- that.\n    ty :: TypeRep\n    !ty = typeOf1 (undefined :: r a)\n\n-- Filter all keys with 0 fetches. Since ReqCountMap is a 2-level map, we need\n-- nested filter operations.\nfilterRCMap :: ReqCountMap -> ReqCountMap\nfilterRCMap (ReqCountMap m) = ReqCountMap $\n  Map.filter ((> 0) . Map.size) (Map.filter (> 0) <$> m)\n\n-- Filters the ReqCountMap by default\ngetMapFromRCMap :: ReqCountMap -> Map Text (Map TypeRep Int)\ngetMapFromRCMap r\n  | ReqCountMap m <- filterRCMap r = m\n\ngetSummaryMapFromRCMap :: ReqCountMap -> HashMap.HashMap Text Int\ngetSummaryMapFromRCMap (ReqCountMap m) = HashMap.fromList\n  [ (k, s)\n  | (k, v) <- Map.toList m\n  , not $ Map.null v\n  , let s = sum $ Map.elems v\n  , s > 0\n  ]\n", "num_lines": 169}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE BangPatterns #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n\n-- | Defines 'runHaxl'.  Most users should import \"Haxl.Core\" instead.\n--\nmodule Haxl.Core.Run\n  ( runHaxl\n  , runHaxlWithWrites\n  ) where\n\nimport Control.Concurrent.STM\nimport Control.Exception as Exception\nimport Control.Monad\nimport Data.IORef\nimport Data.Maybe\nimport Text.Printf\nimport Unsafe.Coerce\n\nimport Haxl.Core.DataCache\nimport Haxl.Core.Exception\nimport Haxl.Core.Flags\nimport Haxl.Core.Monad\nimport Haxl.Core.Fetch\nimport Haxl.Core.Profile\nimport Haxl.Core.RequestStore as RequestStore\nimport Haxl.Core.Stats\nimport Haxl.Core.Util\n\nimport qualified Data.HashTable.IO as H\n\n-- -----------------------------------------------------------------------------\n-- runHaxl\n\n-- | Runs a 'Haxl' computation in the given 'Env'.\n--\n-- Note: to make multiple concurrent calls to 'runHaxl', each one must\n-- have a separate 'Env'. A single 'Env' must /not/ be shared between\n-- multiple concurrent calls to 'runHaxl', otherwise deadlocks or worse\n-- will likely ensue.\n--\n-- However, multiple 'Env's may share a single 'StateStore', and thereby\n-- use the same set of datasources.\nrunHaxl:: forall u w a. Monoid w => Env u w -> GenHaxl u w a -> IO a\nrunHaxl env haxl = fst <$> runHaxlWithWrites env haxl\n\nrunHaxlWithWrites :: forall u w a. Monoid w => Env u w -> GenHaxl u w a -> IO (a, w)\nrunHaxlWithWrites env@Env{..} haxl = do\n  result@IVar{ivarRef = resultRef} <- newIVar -- where to put the final result\n  ifTraceLog <- do\n    if trace flags < 3\n    then return $ \\_ -> return ()\n    else do\n      start <- getTimestamp\n      return $ \\s -> do\n        now <- getTimestamp\n        let t = fromIntegral (now - start) / 1000.0 :: Double\n        printf \"%.1fms: %s\" t (s :: String)\n  let\n    -- Run a job, and put its result in the given IVar\n    schedule :: Env u w -> JobList u w -> GenHaxl u w b -> IVar u w b -> IO ()\n    schedule env@Env{..} rq (GenHaxl run) ivar@IVar{ivarRef = !ref} = do\n      ifTraceLog $ printf \"schedule: %d\\n\" (1 + lengthJobList rq)\n      let {-# INLINE result #-}\n          result r = do\n            e <- readIORef ref\n            case e of\n              IVarFull _ ->\n                -- An IVar is typically only meant to be written to once\n                -- so it would make sense to throw an error here. But there\n                -- are legitimate use-cases for writing several times.\n                -- (See Haxl.Core.Parallel)\n                reschedule env rq\n              IVarEmpty haxls -> do\n                writeIORef ref (IVarFull r)\n                -- Have we got the final result now?\n                if ref == unsafeCoerce resultRef\n                        -- comparing IORefs of different types is safe, it's\n                        -- pointer-equality on the MutVar#.\n                   then\n                     -- We have a result, but don't discard unfinished\n                     -- computations in the run queue. See\n                     -- Note [runHaxl and unfinished requests].\n                     -- Nothing can depend on the final IVar, so haxls must\n                     -- be empty.\n                     case rq of\n                       JobNil -> return ()\n                       _ -> modifyIORef' runQueueRef (appendJobList rq)\n                   else reschedule env (appendJobList haxls rq)\n      r <-\n        if testReportFlag ReportProfiling $ report flags  -- withLabel unfolded\n          then Exception.try $ profileCont run env\n          else Exception.try $ run env\n      case r of\n        Left e -> do\n          rethrowAsyncExceptions e\n          result (ThrowIO e)\n        Right (Done a) -> do\n          wt <- readIORef writeLogsRef\n          result $ Ok a (Just wt)\n        Right (Throw ex) -> do\n          wt <- readIORef writeLogsRef\n          result $ ThrowHaxl ex (Just wt)\n        Right (Blocked i fn) -> do\n          addJob env (toHaxl fn) ivar i\n          reschedule env rq\n\n    -- Here we have a choice:\n    --   - If the requestStore is non-empty, we could submit those\n    --     requests right away without waiting for more.  This might\n    --     be good for latency, especially if the data source doesn't\n    --     support batching, or if batching is pessimal.\n    --   - To optimise the batch sizes, we want to execute as much as\n    --     we can and only submit requests when we have no more\n    --     computation to do.\n    --   - compromise: wait at least Nms for an outstanding result\n    --     before giving up and submitting new requests.\n    --\n    -- For now we use the batching strategy in the scheduler, but\n    -- individual data sources can request that their requests are\n    -- sent eagerly by using schedulerHint.\n    --\n    reschedule :: Env u w -> JobList u w -> IO ()\n    reschedule env@Env{..} haxls = do\n      case haxls of\n        JobNil -> do\n          rq <- readIORef runQueueRef\n          case rq of\n            JobNil -> emptyRunQueue env\n            JobCons env' a b c -> do\n              writeIORef runQueueRef JobNil\n              schedule env' c a b\n        JobCons env' a b c ->\n          schedule env' c a b\n\n    emptyRunQueue :: Env u w -> IO ()\n    emptyRunQueue env = do\n      ifTraceLog $ printf \"emptyRunQueue\\n\"\n      haxls <- checkCompletions env\n      case haxls of\n        JobNil -> checkRequestStore env\n        _ -> reschedule env haxls\n\n    checkRequestStore :: Env u w -> IO ()\n    checkRequestStore env@Env{..} = do\n      ifTraceLog $ printf \"checkRequestStore\\n\"\n      reqStore <- readIORef reqStoreRef\n      if RequestStore.isEmpty reqStore\n        then waitCompletions env\n        else do\n          ifTraceLog $ printf \"performFetches %d\\n\" (RequestStore.getSize reqStore)\n          writeIORef reqStoreRef noRequests\n          performRequestStore env reqStore\n          -- empty the cache if we're not caching.  Is this the best\n          -- place to do it?  We do get to de-duplicate requests that\n          -- happen simultaneously.\n          when (caching flags == 0) $ do\n            let DataCache dc = dataCache\n            H.foldM (\\_ (k, _) -> H.delete dc k) () dc\n          emptyRunQueue env\n\n    checkCompletions :: Env u w -> IO (JobList u w)\n    checkCompletions Env{..} = do\n      ifTraceLog $ printf \"checkCompletions\\n\"\n      comps <- atomicallyOnBlocking (LogicBug ReadingCompletionsFailedRun) $ do\n        c <- readTVar completions\n        writeTVar completions []\n        return c\n      case comps of\n        [] -> return JobNil\n        _ -> do\n          ifTraceLog $ printf \"%d complete\\n\" (length comps)\n          let\n              getComplete (CompleteReq a IVar{ivarRef = !cr} allocs) = do\n                when (allocs < 0) $ do\n                  cur <- getAllocationCounter\n                  setAllocationCounter (cur + allocs)\n                r <- readIORef cr\n                case r of\n                  IVarFull _ -> do\n                    ifTraceLog $ printf \"existing result\\n\"\n                    return JobNil\n                    -- this happens if a data source reports a result,\n                    -- and then throws an exception.  We call putResult\n                    -- a second time for the exception, which comes\n                    -- ahead of the original request (because it is\n                    -- pushed on the front of the completions list) and\n                    -- therefore overrides it.\n                  IVarEmpty cv -> do\n                    writeIORef cr (IVarFull a)\n                    return cv\n          jobs <- mapM getComplete comps\n          return (foldr appendJobList JobNil jobs)\n\n    waitCompletions :: Env u w -> IO ()\n    waitCompletions env@Env{..} = do\n      ifTraceLog $ printf \"waitCompletions\\n\"\n      let\n        wrapped = atomicallyOnBlocking (LogicBug ReadingCompletionsFailedRun)\n        doWait = wrapped $ do\n          c <- readTVar completions\n          when (null c) retry\n        doWaitProfiled = do\n          queueEmpty <- null <$> wrapped (readTVar completions)\n          when queueEmpty $ do\n            -- Double check the queue as we want to make sure that\n            -- submittedReqsRef is copied before waiting on the queue but as a\n            -- fast path do not want to copy it if the queue is empty.\n            -- There is still a race oppoortunity as submittedReqsRef is\n            -- decremented in whatever thread the completion happens, and so it\n            -- is possible for waitingOn to be empty while queueEmpty2 is True.\n            waitingOn <- readIORef submittedReqsRef\n            queueEmpty2 <- null <$> wrapped (readTVar completions)\n            when queueEmpty2 $ do\n              start <- getTimestamp\n              doWait\n              end <- getTimestamp\n              let fw = FetchWait\n                        { fetchWaitReqs = getSummaryMapFromRCMap waitingOn\n                        , fetchWaitStart = start\n                        , fetchWaitDuration = (end-start)\n                        }\n              modifyIORef' statsRef $ \\(Stats s) -> Stats (fw:s)\n      if testReportFlag ReportFetchStats $ report flags\n        then doWaitProfiled\n        else doWait\n      emptyRunQueue env\n\n  --\n  schedule env JobNil haxl result\n  r <- readIORef resultRef\n  writeIORef writeLogsRef mempty\n  wtNoMemo <- atomicModifyIORef' writeLogsRefNoMemo\n    (\\old_wrts -> (mempty, old_wrts))\n  case r of\n    IVarEmpty _ -> throwIO (CriticalError \"runHaxl: missing result\")\n    IVarFull (Ok a wt) -> do\n      return (a, fromMaybe mempty wt <> wtNoMemo)\n    IVarFull (ThrowHaxl e _wt)  -> throwIO e\n      -- The written logs are discarded when there's a Haxl exception. We\n      -- can change this behavior if we need to get access to partial logs.\n    IVarFull (ThrowIO e)  -> throwIO e\n\n\n{- Note [runHaxl and unfinished requests]\n\nrunHaxl returns immediately when the supplied computation has returned\na result.  This doesn't necessarily mean that the whole computation\ngraph has completed, however.  In particular, when using pAnd and pOr,\nwe might have created some data fetches that have not completed, but\nweren't required, because the other branch of the pAnd/pOr subsumed\nthe result.\n\nWhen runHaxl returns, it might be that:\n- reqStoreRef contains some unsubmitted requests\n- runQueueRef contains some jobs\n- there are in-flight BackgroundFetch requests, that will return their\n  results to the completions queue in due course.\n- there are various unfilled IVars in the cache and/or memo tables\n\nThis should be all safe, we can even restart runHaxl with the same Env\nafter it has stopped and the in-progress computations will\ncontinue. But don't discard the contents of\nreqStoreRef/runQueueRef/completions, because then we'll deadlock if we\ndiscover one of the unfilled IVars in the cache or memo table.\n-}\n\n{- TODO: later\ndata SchedPolicy\n  = SubmitImmediately\n  | WaitAtLeast Int{-ms-}\n  | WaitForAllPendingRequests\n-}\n\n-- | An exception thrown when reading from datasources fails\ndata ReadingCompletionsFailedRun = ReadingCompletionsFailedRun\n  deriving Show\n\ninstance Exception ReadingCompletionsFailedRun\n", "num_lines": 289}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n-- |\n-- Most users should import \"Haxl.Core\" instead of importing this\n-- module directly.\n--\nmodule Haxl.Core.ShowP\n  ( ShowP(..)\n  ) where\n\n-- | A class of type constructors for which we can show all\n-- parameterizations.\nclass ShowP f where\n  showp :: f a -> String\n", "num_lines": 19}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE CPP #-}\n\n-- |\n-- Most users should import \"Haxl.Core\" instead of importing this\n-- module directly.\n--\nmodule Haxl.Core.StateStore\n  ( StateKey(..)\n  , StateStore\n  , stateGet\n  , stateSet\n  , stateEmpty\n  ) where\n\nimport Data.Map (Map)\nimport Data.Kind (Type)\nimport qualified Data.Map.Strict as Map\n#if __GLASGOW_HASKELL__ < 804\nimport Data.Monoid\n#endif\nimport Data.Typeable\nimport Unsafe.Coerce\n\n-- | 'StateKey' maps one type to another type. A type that is an\n-- instance of 'StateKey' can store and retrieve information from a\n-- 'StateStore'.\n--\nclass Typeable f => StateKey (f :: Type -> Type) where\n  data State f\n\n  -- | We default this to typeOf1, but if f is itself a complex type that is\n  -- already applied to some paramaters, we want to be able to use the same\n  -- state by using typeOf2, etc\n  getStateType :: Proxy f -> TypeRep\n  getStateType = typeRep\n\n-- | The 'StateStore' maps a 'StateKey' to the 'State' for that type.\nnewtype StateStore = StateStore (Map TypeRep StateStoreData)\n\n#if __GLASGOW_HASKELL__ >= 804\ninstance Semigroup StateStore where\n  -- Left-biased union\n  StateStore m1 <> StateStore m2 = StateStore $ m1 <> m2\n#endif\n\ninstance Monoid StateStore where\n  mempty = stateEmpty\n#if __GLASGOW_HASKELL__ < 804\n  mappend (StateStore m1) (StateStore m2) = StateStore $ m1 <> m2\n#endif\n\n-- | Encapsulates the type of 'StateStore' data so we can have a\n-- heterogeneous collection.\ndata StateStoreData = forall f. StateKey f => StateStoreData (State f)\n\n-- | A `StateStore` with no entries.\nstateEmpty :: StateStore\nstateEmpty = StateStore Map.empty\n\n-- | Inserts a `State` in the `StateStore` container.\nstateSet :: forall f . StateKey f => State f -> StateStore -> StateStore\nstateSet st (StateStore m) =\n  StateStore (Map.insert (getStateType (Proxy :: Proxy f)) (StateStoreData st) m)\n\n-- | Retrieves a `State` from the `StateStore` container.\nstateGet :: forall r . StateKey r => StateStore -> Maybe (State r)\nstateGet (StateStore m) =\n  case Map.lookup ty m of\n     Nothing -> Nothing\n     Just (StateStoreData (st :: State f))\n       | getStateType (Proxy :: Proxy f) == ty -> Just (unsafeCoerce st)\n       | otherwise             -> Nothing\n          -- the dynamic type check here should be unnecessary, but if\n          -- there are bugs in `Typeable` or `Map` then we'll get an\n          -- error instead of a crash.  The overhead is a few percent.\n where\n  ty = getStateType (Proxy :: Proxy r)\n", "num_lines": 88}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE RankNTypes #-}\n{-# LANGUAGE CPP #-}\n\n-- |\n-- Types and operations for statistics and profiling.  Most users\n-- should import \"Haxl.Core\" instead of importing this module\n-- directly.\n--\nmodule Haxl.Core.Stats\n  (\n  -- * Data-source stats\n    Stats(..)\n  , CallId\n  , FetchStats(..)\n  , Microseconds\n  , Timestamp\n  , DataSourceStats(..)\n  , getTimestamp\n  , emptyStats\n  , numFetches\n  , ppStats\n  , ppFetchStats\n  , aggregateFetchBatches\n\n  -- * Profiling\n  , Profile(..)\n  , ProfileMemo(..)\n  , ProfileFetch(..)\n  , emptyProfile\n  , ProfileKey\n  , ProfileLabel\n  , ProfileData(..)\n  , emptyProfileData\n  , AllocCount\n  , LabelHitCount\n\n  -- * Allocation\n  , getAllocationCounter\n  , setAllocationCounter\n  ) where\n\nimport Data.Aeson\nimport Data.Function (on)\nimport Data.Maybe (mapMaybe)\nimport Data.HashMap.Strict (HashMap)\nimport Data.Int\nimport Data.List (intercalate, sortOn, groupBy)\n#if __GLASGOW_HASKELL__ < 804\nimport Data.Semigroup (Semigroup)\n#endif\nimport Data.Ord (Down(..))\nimport Data.Text (Text)\nimport Data.Time.Clock.POSIX\nimport Data.Typeable\nimport Text.Printf\nimport qualified Data.HashMap.Strict as HashMap\nimport qualified Data.Text as Text\n\nimport GHC.Conc (getAllocationCounter, setAllocationCounter)\n\n-- ---------------------------------------------------------------------------\n-- Measuring time\n\ntype Microseconds = Int64\ntype Timestamp = Microseconds -- since an epoch\n\ngetTimestamp :: IO Timestamp\ngetTimestamp = do\n  t <- getPOSIXTime -- for now, TODO better\n  return (round (t * 1000000))\n\n-- ---------------------------------------------------------------------------\n-- Stats\n\ndata DataSourceStats =\n  forall a. (Typeable a, Show a, Eq a, ToJSON a) => DataSourceStats a\n\ninstance Show DataSourceStats where\n  show (DataSourceStats x) = printf \"DataSourceStats %s\" (show x)\n\ninstance Eq DataSourceStats where\n  (==) (DataSourceStats a) (DataSourceStats b) =\n    cast a == Just b\n\n-- | Stats that we collect along the way.\nnewtype Stats = Stats [FetchStats]\n  deriving (Show, ToJSON, Semigroup, Monoid)\n\n-- | Pretty-print Stats.\nppStats :: Stats -> String\nppStats (Stats rss) =\n  intercalate \"\\n\"\n    [ \"[\"\n    ++ [\n      if fetchWasRunning rs\n          (minStartTime + (t - 1) * usPerDash)\n          (minStartTime + t * usPerDash)\n        then fetchSymbol rs\n        else '-'\n      | t <- [1..numDashes]\n      ]\n    ++ \"] \" ++ show i ++ \" - \" ++ ppFetchStats rs\n    | (i, rs) <- zip [(1::Int)..] validFetchStats ]\n  where\n    isFetchStats FetchStats{} = True\n    isFetchStats FetchWait{} = True\n    isFetchStats FetchDataSourceStats{} = True\n    isFetchStats _ = False\n    validFetchStats = filter isFetchStats (reverse rss)\n    numDashes = 50\n    getStart FetchStats{..} = Just fetchStart\n    getStart FetchWait{..} = Just fetchWaitStart\n    getStart _ = Nothing\n    getEnd FetchStats{..} = Just $ fetchStart + fetchDuration\n    getEnd FetchWait{..} = Just $ fetchWaitStart + fetchWaitDuration\n    getEnd _ = Nothing\n    minStartTime = minimum $ mapMaybe getStart validFetchStats\n    endTime = maximum $ mapMaybe getEnd validFetchStats\n    usPerDash = (endTime - minStartTime) `div` numDashes\n    fetchSymbol FetchStats{} = '*'\n    fetchSymbol FetchWait{} = '.'\n    fetchSymbol _ = '?'\n    fetchWasRunning :: FetchStats -> Timestamp -> Timestamp -> Bool\n    fetchWasRunning fs@FetchStats{} t1 t2 =\n      (fetchStart fs + fetchDuration fs) >= t1 && fetchStart fs < t2\n    fetchWasRunning fw@FetchWait{} t1 t2 =\n      (fetchWaitStart fw + fetchWaitDuration fw) >= t1 && fetchWaitStart fw < t2\n    fetchWasRunning _ _ _ = False\n\ntype CallId = Int\n\n-- | Maps data source name to the number of requests made in that round.\n-- The map only contains entries for sources that made requests in that\n-- round.\ndata FetchStats\n    -- | Timing stats for a (batched) data fetch\n  = FetchStats\n    { fetchDataSource :: Text\n    , fetchBatchSize :: {-# UNPACK #-} !Int\n    , fetchStart :: {-# UNPACK #-} !Timestamp\n    , fetchDuration :: {-# UNPACK #-} !Microseconds\n    , fetchSpace :: {-# UNPACK #-} !Int64\n    , fetchFailures :: {-# UNPACK #-} !Int\n    , fetchIgnoredFailures :: {-# UNPACK #-} !Int\n    , fetchBatchId :: {-# UNPACK #-} !Int\n    , fetchIds :: [CallId]\n    }\n\n    -- | The stack trace of a call to 'dataFetch'.  These are collected\n    -- only when profiling and reportLevel is 5 or greater.\n  | FetchCall\n    { fetchReq :: String\n    , fetchStack :: [String]\n    , fetchStatId :: {-# UNPACK #-} !CallId\n    }\n  | MemoCall\n    { memoStatId :: {-# UNPACK #-} !CallId\n    , memoSpace :: {-# UNPACK #-} !Int64\n    }\n  | FetchWait\n    { fetchWaitReqs :: HashMap Text Int\n       -- ^ What DataSources had requests that were being waited for\n    , fetchWaitStart :: {-# UNPACK #-} !Timestamp\n    , fetchWaitDuration :: {-# UNPACK #-} !Microseconds\n    }\n  | FetchDataSourceStats\n    { fetchDsStatsCallId :: CallId\n    , fetchDsStatsDataSource :: Text\n    , fetchDsStatsStats :: DataSourceStats\n    , fetchBatchId :: {-# UNPACK #-} !Int\n    }\n  deriving (Eq, Show)\n\n-- | Pretty-print RoundStats.\nppFetchStats :: FetchStats -> String\nppFetchStats FetchStats{..} =\n  printf \"%s: %d fetches (%.2fms, %d bytes, %d failures)\"\n    (Text.unpack fetchDataSource) fetchBatchSize\n    (fromIntegral fetchDuration / 1000 :: Double)  fetchSpace fetchFailures\nppFetchStats (FetchCall r ss _) = show r ++ '\\n':show ss\nppFetchStats MemoCall{} = \"\"\nppFetchStats FetchWait{..}\n  | HashMap.size fetchWaitReqs == 0 = msg \"unexpected: Blocked on nothing\"\n  | HashMap.size fetchWaitReqs <= 2 =\n    msg $ printf \"Blocked on %s\"\n      (intercalate \",\" [printf \"%s (%d reqs)\" ds c\n                       | (ds,c) <- HashMap.toList fetchWaitReqs])\n  | otherwise = msg $ printf \"Blocked on %d sources (%d reqs)\"\n                        (HashMap.size fetchWaitReqs)\n                        (sum $ HashMap.elems fetchWaitReqs)\n  where\n    msg :: String -> String\n    msg x = printf \"%s (%.2fms)\"\n                x\n                (fromIntegral fetchWaitDuration / 1000 :: Double)\nppFetchStats FetchDataSourceStats{..} =\n  printf \"%s (stats): %s\" (Text.unpack fetchDsStatsDataSource)\n    (show fetchDsStatsStats)\n\n-- | Aggregate stats merging FetchStats from the same dispatched batch into one.\naggregateFetchBatches :: ([FetchStats] -> a) -> Stats -> [a]\naggregateFetchBatches agg (Stats fetches) =\n      map agg $\n      groupBy ((==) `on` fetchBatchId) $\n      sortOn (Down . fetchBatchId)\n      [f | f@FetchStats{} <- fetches]\n\ninstance ToJSON FetchStats where\n  toJSON FetchStats{..} = object\n    [ \"type\" .= (\"FetchStats\" :: Text)\n    , \"datasource\" .= fetchDataSource\n    , \"fetches\" .= fetchBatchSize\n    , \"start\" .= fetchStart\n    , \"duration\" .= fetchDuration\n    , \"allocation\" .= fetchSpace\n    , \"failures\" .= fetchFailures\n    , \"ignoredFailures\" .= fetchIgnoredFailures\n    , \"batchid\" .= fetchBatchId\n    , \"fetchids\" .= fetchIds\n    ]\n  toJSON (FetchCall req strs fid) = object\n    [ \"type\" .= (\"FetchCall\" :: Text)\n    , \"request\" .= req\n    , \"stack\" .= strs\n    , \"fetchid\" .= fid\n    ]\n  toJSON (MemoCall cid allocs) = object\n    [ \"type\" .= (\"MemoCall\" :: Text)\n    , \"callid\" .= cid\n    , \"allocation\" .= allocs\n    ]\n  toJSON FetchWait{..} = object\n    [ \"type\" .= (\"FetchWait\" :: Text)\n    , \"duration\" .= fetchWaitDuration\n    ]\n  toJSON FetchDataSourceStats{..} = object\n    [ \"type\" .= (\"FetchDataSourceStats\" :: Text)\n    , \"datasource\" .= fetchDsStatsDataSource\n    , \"stats\" .= sjson fetchDsStatsStats\n    , \"batchid\" .= fetchBatchId\n    ]\n    where\n      sjson (DataSourceStats s) = toJSON s\n\nemptyStats :: Stats\nemptyStats = Stats []\n\nnumFetches :: Stats -> Int\nnumFetches (Stats rs) = sum [ fetchBatchSize | FetchStats{..} <- rs ]\n\n\n-- ---------------------------------------------------------------------------\n-- Profiling\n\ntype ProfileLabel = Text\ntype AllocCount = Int64\ntype LabelHitCount = Int64\ntype ProfileKey = Int64\n\ndata ProfileFetch = ProfileFetch\n  { profileFetchFetchId :: {-# UNPACK #-} !CallId\n  , profileFetchMemoId ::  {-# UNPACK #-} !CallId\n  , profileFetchWasCached :: !Bool\n  }\n  deriving (Show, Eq)\n\ndata ProfileMemo = ProfileMemo\n  { profileMemoId :: {-# UNPACK #-} !CallId\n  , profileMemoWasCached :: !Bool\n  }\n  deriving (Show, Eq)\n\ndata Profile = Profile\n  { profile      :: HashMap ProfileKey ProfileData\n     -- ^ Data per key (essentially per call stack)\n  , profileTree :: HashMap (ProfileLabel, ProfileKey) ProfileKey\n     -- ^ (label, parent) -> current. The exception is the root which will have\n     -- (\"MAIN\", 0) -> 0\n  , profileNextKey :: ProfileKey\n     -- ^ Provides a unique key per callstack\n  }\n\nemptyProfile :: Profile\nemptyProfile = Profile HashMap.empty (HashMap.singleton (\"MAIN\", 0) 0) 1\n\ndata ProfileData = ProfileData\n  { profileAllocs :: {-# UNPACK #-} !AllocCount\n     -- ^ allocations made by this label\n  , profileFetches :: [ProfileFetch]\n     -- ^ fetches made in this label\n  , profileLabelHits :: {-# UNPACK #-} !LabelHitCount\n     -- ^ number of hits at this label\n  , profileMemos :: [ProfileMemo]\n     -- ^ memo and a boolean representing if it was cached at the time\n  , profileTime :: {-# UNPACK #-} !Microseconds\n     -- ^ amount of time spent in computation at this label\n  }\n  deriving Show\n\nemptyProfileData :: ProfileData\nemptyProfileData = ProfileData 0 [] 0 [] 0\n", "num_lines": 312}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n-- | Internal utilities only.\n--\n{-# OPTIONS_GHC -fno-warn-unused-imports #-}\nmodule Haxl.Core.Util\n  ( atomicallyOnBlocking\n  , compose\n  , textShow\n  , trace_\n  ) where\n\nimport Data.Text (Text)\nimport Debug.Trace (trace)\nimport qualified Data.Text as Text\n\nimport Control.Concurrent.STM\nimport Control.Exception\n\natomicallyOnBlocking :: Exception e => e -> STM a -> IO a\natomicallyOnBlocking e stm =\n  catch (atomically stm)\n        (\\BlockedIndefinitelyOnSTM -> throw e)\n\n-- | Composes a list of endofunctions.\ncompose :: [a -> a] -> a -> a\ncompose = foldr (.) id\n\ntextShow :: (Show a) => a -> Text\ntextShow = Text.pack . show\n\n-- | This function can be used to trace a bunch of lines to stdout when\n-- debugging haxl core.\ntrace_ :: String -> a -> a\ntrace_ _ = id\n--trace_ = Debug.Trace.trace\n", "num_lines": 41}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n\n-- |\n-- A generic Haxl datasource for performing arbitrary IO concurrently.\n-- Every IO operation will be performed in a separate thread.\n-- You can use this with any kind of IO, but each different operation\n-- requires an instance of the 'ConcurrentIO' class.\n--\n-- For example, to make a concurrent sleep operation:\n--\n-- > sleep :: Int -> GenHaxl u w Int\n-- > sleep n = dataFetch (Sleep n)\n-- >\n-- > data Sleep\n-- > instance ConcurrentIO Sleep where\n-- >   data ConcurrentIOReq Sleep a where\n-- >     Sleep :: Int -> ConcurrentIOReq Sleep Int\n-- >\n-- >   performIO (Sleep n) = threadDelay (n*1000) >> return n\n-- >\n-- > deriving instance Eq (ConcurrentIOReq Sleep a)\n-- > deriving instance Show (ConcurrentIOReq Sleep a)\n-- >\n-- > instance ShowP (ConcurrentIOReq Sleep) where showp = show\n-- >\n-- > instance Hashable (ConcurrentIOReq Sleep a) where\n-- >   hashWithSalt s (Sleep n) = hashWithSalt s n\n--\n-- Note that you can have any number of constructors in your\n-- ConcurrentIOReq GADT, so most of the boilerplate only needs to be\n-- written once.\n\nmodule Haxl.DataSource.ConcurrentIO\n  ( mkConcurrentIOState\n  , ConcurrentIO(..)\n  ) where\n\nimport Control.Concurrent\nimport Control.Monad\nimport qualified Data.Text as Text\nimport Data.Typeable\n\nimport Haxl.Core\n\nclass ConcurrentIO tag where\n  data ConcurrentIOReq tag a\n  performIO :: ConcurrentIOReq tag a -> IO a\n\nderiving instance Typeable ConcurrentIOReq -- not needed by GHC 7.10 and later\n\ninstance (Typeable tag) => StateKey (ConcurrentIOReq tag) where\n  data State (ConcurrentIOReq tag) = ConcurrentIOState\n  getStateType _ = typeRep (Proxy :: Proxy ConcurrentIOReq)\n\nmkConcurrentIOState :: IO (State (ConcurrentIOReq ()))\nmkConcurrentIOState = return ConcurrentIOState\n\ninstance Typeable tag => DataSourceName (ConcurrentIOReq tag) where\n  dataSourceName _ =\n    Text.pack (show (typeRepTyCon (typeRep (Proxy :: Proxy tag))))\n\ninstance\n  (Typeable tag, ShowP (ConcurrentIOReq tag), ConcurrentIO tag)\n  => DataSource u (ConcurrentIOReq tag)\n where\n  fetch _state _flags _u = BackgroundFetch $ \\bfs -> do\n    forM_ bfs $ \\(BlockedFetch req rv) ->\n      forkFinally (performIO req) (putResultFromChildThread rv)\n", "num_lines": 82}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE RebindableSyntax, OverloadedStrings, ApplicativeDo #-}\nmodule AdoTests (tests) where\n\nimport TestUtils\nimport MockTAO\n\nimport Control.Applicative\nimport Test.HUnit\n\nimport Prelude()\nimport Haxl.Prelude\n\n-- -----------------------------------------------------------------------------\n\n--\n-- Test ApplicativeDo batching\n--\nado1 = expectResult 12 ado1_\n\nado1_ = do\n  a <- friendsOf =<< id1\n  b <- friendsOf =<< id2\n  return (length (a ++ b))\n\nado2 = expectResult 12 ado2_\n\nado2_ = do\n  x <- id1\n  a <- friendsOf x\n  y <- id2\n  b <- friendsOf y\n  return (length (a ++ b))\n\nado3 = expectResult 11 ado3_\n\nado3_ = do\n  x <- id1\n  a <- friendsOf x\n  a' <- friendsOf =<< if null a then id3 else id4\n  y <- id2\n  b <- friendsOf y\n  b' <- friendsOf  =<< if null b then id4 else id3\n  return (length (a' ++ b'))\n\ntests future = TestList\n  [ TestLabel \"ado1\" $ TestCase (ado1 future)\n  , TestLabel \"ado2\" $ TestCase (ado2 future)\n  , TestLabel \"ado3\" $ TestCase (ado3 future)\n  ]\n", "num_lines": 56}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule AllTests (allTests) where\n\nimport TestExampleDataSource\nimport BatchTests\nimport CoreTests\nimport DataCacheTest\nimport ExceptionStackTests\nimport AdoTests\nimport OutgoneFetchesTests\nimport ProfileTests\nimport MemoizationTests\nimport MonadAsyncTest\nimport TestBadDataSource\nimport FullyAsyncTest\nimport WriteTests\nimport ParallelTests\nimport StatsTests\nimport DataSourceDispatchTests\n\nimport Test.HUnit\n\nallTests :: Test\nallTests = TestList\n  [ TestLabel \"ExampleDataSource\" TestExampleDataSource.tests\n  , TestLabel \"BatchTests-future\" $ BatchTests.tests True\n  , TestLabel \"BatchTests-sync\" $ BatchTests.tests False\n  , TestLabel \"CoreTests\" CoreTests.tests\n  , TestLabel \"DataCacheTests\" DataCacheTest.tests\n  , TestLabel \"ExceptionStackTests\" ExceptionStackTests.tests\n  , TestLabel \"AdoTests\" $ AdoTests.tests False\n  , TestLabel \"OutgoneFetchesTest\" OutgoneFetchesTests.tests\n  , TestLabel \"ProfileTests\" ProfileTests.tests\n  , TestLabel \"MemoizationTests\" MemoizationTests.tests\n  , TestLabel \"MonadAsyncTests\" MonadAsyncTest.tests\n  , TestLabel \"BadDataSourceTests\" TestBadDataSource.tests\n  , TestLabel \"FullyAsyncTest\" FullyAsyncTest.tests\n  , TestLabel \"WriteTest\" WriteTests.tests\n  , TestLabel \"ParallelTest\" ParallelTests.tests\n  , TestLabel \"StatsTests\" StatsTests.tests\n  , TestLabel \"DataSourceDispatchTests\" DataSourceDispatchTests.tests\n  ]\n", "num_lines": 49}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE RecordWildCards #-}\n\n-- | A data source that can be made to fail in various ways, for testing\n\nmodule BadDataSource (\n    -- * initialise the state\n    State(..), initGlobalState, FetchImpl(..),\n\n    -- * requests for this data source\n    FailAfter(..)\n  ) where\n\nimport Haxl.Prelude\nimport Prelude ()\n\nimport Haxl.Core\n\nimport Control.Exception\nimport Data.Typeable\nimport Data.Hashable\nimport Control.Concurrent\nimport Control.Monad (void)\n\nimport GHC.Conc ( PrimMVar )\nimport Foreign.StablePtr\nimport Foreign.C.Types ( CInt(..) )\n\nforeign import ccall safe\n  hs_try_putmvar :: CInt -> StablePtr PrimMVar -> IO ()\n\ndata FetchImpl =\n  Async\n  | Background\n  | BackgroundMVar\n  | BackgroundSeq\n  | BackgroundPar\n\ndata FailAfter a where\n  FailAfter :: Int -> FailAfter Int\n  deriving Typeable\n\nderiving instance Eq (FailAfter a)\nderiving instance Show (FailAfter a)\ninstance ShowP FailAfter where showp = show\n\ninstance Hashable (FailAfter a) where\n   hashWithSalt s (FailAfter a) = hashWithSalt s (0::Int,a)\n\ninstance StateKey FailAfter where\n  data State FailAfter = FailAfterState\n         { failAcquireDelay :: Int\n         , failAcquire :: IO ()\n         , failReleaseDelay :: Int\n         , failRelease :: IO ()\n         , failDispatchDelay :: Int\n         , failDispatch :: IO ()\n         , failWaitDelay :: Int\n         , failWait :: IO ()\n         , failImpl :: FetchImpl\n        }\n\ninstance DataSourceName FailAfter where\n  dataSourceName _ = \"BadDataSource\"\n\n\ninstance DataSource u FailAfter where\n  fetch state@FailAfterState{..}\n    | BackgroundSeq <- failImpl = backgroundFetchSeq runOne state\n    | BackgroundPar <- failImpl = backgroundFetchPar runOne state\n    | Background <- failImpl = backgroundFetchAcquireRelease\n        acquire release dispatchbg wait\n        submit state\n    | BackgroundMVar <- failImpl = backgroundFetchAcquireReleaseMVar\n        acquire release dispatchbgMVar wait\n        submit state\n    | Async <- failImpl = asyncFetchAcquireRelease\n       acquire release dispatch wait\n       submit state\n   where\n     acquire = do threadDelay failAcquireDelay; failAcquire\n     release _ = do threadDelay failReleaseDelay; failRelease\n     dispatch _ = do threadDelay failDispatchDelay; failDispatch\n     dispatchBase put = (do\n                          failDispatch\n                          _ <- mask_ $ forkIO $ finally\n                            (threadDelay failDispatchDelay)\n                            put\n                          return ()) `onException` put\n     dispatchbg _ c m = dispatchBase (hs_try_putmvar (fromIntegral c) m)\n     dispatchbgMVar _ _ m = dispatchBase (void $ tryPutMVar m ())\n     wait _ = do threadDelay failWaitDelay; failWait\n     submit :: () -> FailAfter a -> IO (IO (Either SomeException a))\n     submit _ (FailAfter t) = do\n       threadDelay t\n       return (return (Left (toException (FetchError \"failed request\"))))\n     runOne :: FailAfter a -> IO (Either SomeException a)\n     runOne r = do\n       bracket acquire release $ \\s -> do\n         dispatch s\n         getRes <- submit s r\n         wait s\n         getRes\n\ninitGlobalState :: FetchImpl -> IO (State FailAfter)\ninitGlobalState impl = do\n  return FailAfterState\n    { failAcquireDelay = 0\n    , failAcquire = return ()\n    , failReleaseDelay = 0\n    , failRelease = return ()\n    , failDispatchDelay = 0\n    , failDispatch = return ()\n    , failWaitDelay = 0\n    , failWait = return ()\n    , failImpl = impl\n    }\n", "num_lines": 131}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE RebindableSyntax, OverloadedStrings #-}\nmodule BatchTests (tests) where\n\nimport TestTypes\nimport TestUtils\nimport MockTAO\n\nimport Control.Applicative\nimport Test.HUnit\n\nimport Haxl.Core\n\nimport Prelude()\nimport Haxl.Prelude\nimport Data.IORef\n\n-- -----------------------------------------------------------------------------\n\n--\n-- Test batching over multiple arguments in liftA2\n--\nbatching1 = expectResult 12 batching1_\n\nbatching1_ = do\n  a <- id1\n  b <- id2\n  length <$> liftA2 (++) (friendsOf a) (friendsOf b)\n\n--\n-- Test batching in mapM (which is really traverse)\n--\nbatching2 = expectResult 12 batching2_\n\nbatching2_ = do\n  a <- id1\n  b <- id2\n  fs <- mapM friendsOf [a,b]\n  return (sum (map length fs))\n\n--\n-- Test batching when we have a monadic bind in each branch\n--\nbatching3 = expectResult 12 batching3_\n\nbatching3_ = do\n  let a = id1 >>= friendsOf\n      b = id2 >>= friendsOf\n  length <$> a .++ b\n\n--\n-- Test batching over both arguments of (+)\n--\nbatching4 = expectResult 12 batching4_\n\nbatching4_ = do\n  let a = length <$> (id1 >>= friendsOf)\n      b = length <$> (id2 >>= friendsOf)\n  a + b\n\n--\n-- Test batching over both arguments of (+)\n--\nbatching5 = expectResult 2 batching5_\n\nbatching5_ :: Haxl Int\nbatching5_ = if a .> b then 1 else 2\n where\n  a = length <$> (id1 >>= friendsOf)\n  b = length <$> (id2 >>= friendsOf)\n\n--\n-- Test batching when we perform all batching tests together with sequence\n--\nbatching6 = expectResult [12,12,12,12,2] batching6_\n\nbatching6_ = sequence [batching1_,batching2_,batching3_,batching4_,batching5_]\n\n--\n-- Ensure if/then/else and bool operators break batching\n--\nbatching7 = expectResult 12 batching7_\n\nbatching7_ :: Haxl Int\nbatching7_ = if a .> 0 then a+b else 0\n where\n  a = length <$> (id1 >>= friendsOf)\n  b = length <$> (id2 >>= friendsOf)\n\n-- We expect 3 rounds here due to boolean operators\nbatching8 = expectResult 12 batching8_\n\nbatching8_ :: Haxl Int\nbatching8_ = if (c .== 0) .|| (a .> 0 .&& b .> 0) then a+b else 0\n where\n  a = length <$> (id1 >>= friendsOf)\n  b = length <$> (id2 >>= friendsOf)\n  c = length <$> (id3 >>= friendsOf)\n\n-- (>>) should batch, so we expect one round\nbatching9 = expectResult 6 batching9_\n\nbatching9_ :: Haxl Int\nbatching9_ = (id1 >>= friendsOf) >> (length <$> (id2 >>= friendsOf))\n\n--\n-- Test data caching, numFetches\n--\n\n-- simple (one cache hit)\ncaching1 = expectFetches 3 caching1_\ncaching1_ = nf id1 + nf id2 + nf id3 + nf id3\n where\n  nf id = length <$> (id >>= friendsOf)\n\n-- simple, in rounds (no cache hits)\ncaching2 = expectFetches 3 caching2_\ncaching2_ = if nf id1 .> 0 then nf id2 + nf id3 else 0\n where\n  nf id = length <$> (id >>= friendsOf)\n\n-- rounds (one cache hit)\ncaching3 = expectFetches 3 caching3_\ncaching3_ = if nf id1 .> 0 then nf id1 + nf id2 + nf id3 else 0\n where\n  nf id = length <$> (id >>= friendsOf)\n\n--\n-- Basic sanity check on data-cache re-use\n--\ncacheReuse future = do\n  env <- makeTestEnv future\n  expectResultWithEnv 12 batching7_ env\n\n  -- make a new env\n  tao <- MockTAO.initGlobalState future\n  let st = stateSet tao stateEmpty\n  env2 <- initEnvWithData st testinput (caches env)\n  cid <- readIORef (callIdRef env2)\n  assertBool \"callId is unique\" (cid > 0)\n\n  -- ensure no more data fetching rounds needed\n  expectResultWithEnv 12 batching7_ env2\n\nnoCaching future = do\n  env <- makeTestEnv future\n  let env' = env{ flags = (flags env){caching = 0} }\n  result <- runHaxl env' caching3_\n  assertEqual \"result\" result 18\n  stats <- readIORef (statsRef env)\n  assertEqual \"fetches\" 4 (numFetches stats)\n\nexceptionTest1 = expectResult []\n  $ withDefault [] $ friendsOf 101\n\nexceptionTest2 = expectResult [7..12] $ liftA2 (++)\n  (withDefault [] (friendsOf 101))\n  (withDefault [] (friendsOf 2))\n\ndeterministicExceptions future = do\n  env <- makeTestEnv future\n  let haxl =\n        sequence [ do _ <- friendsOf =<< id1; throw (NotFound \"xxx\")\n                 , throw (NotFound \"yyy\")\n                 ]\n  -- the first time, friendsOf should block, but we should still get the\n  -- \"xxx\" exception.\n  r <- runHaxl env $ try haxl\n  assertBool \"exceptionTest3\" $\n    case r of\n     Left (NotFound \"xxx\") -> True\n     _ -> False\n  -- the second time, friendsOf will be cached, and we should get the \"xxx\"\n  -- exception as before.\n  r <- runHaxl env $ try haxl\n  assertBool \"exceptionTest3\" $\n    case r of\n     Left (NotFound \"xxx\") -> True\n     _ -> False\n\npOrTests future = do\n  env <- makeTestEnv future\n\n  -- Test semantics\n  r <- runHaxl env $ do\n        a <- return False `pOr` return False\n        b <- return False `pOr` return True\n        c <- return True `pOr` return False\n        d <- return True `pOr` return True\n        return (not a && b && c && d)\n  assertBool \"pOr0\" r\n\n  -- pOr is left-biased with respect to exceptions:\n  r <- runHaxl env $ try $ return True `pOr` throw (NotFound \"foo\")\n  assertBool \"pOr1\" $\n    case (r :: Either NotFound Bool) of\n      Right True -> True\n      _ -> False\n  r <- runHaxl env $ try $ throw (NotFound \"foo\") `pOr` return True\n  assertBool \"pOr2\" $\n    case (r :: Either NotFound Bool) of\n      Left (NotFound \"foo\") -> True\n      _ -> False\n\n  -- pOr is non-deterministic (see also Note [tricky pOr/pAnd])\n  let nondet = (do _ <- friendsOf 1; throw (NotFound \"foo\")) `pOr` return True\n  r <- runHaxl env $ try nondet\n  assertBool \"pOr3\" $\n    case (r :: Either NotFound Bool) of\n      Right True -> True\n      _ -> False\n  -- next we populate the cache\n  _ <- runHaxl env $ friendsOf 1\n  -- and now exactly the same pOr again will throw this time:\n  r <- runHaxl env $ try nondet\n  assertBool \"pOr4\" $\n    case (r :: Either NotFound Bool) of\n      Left (NotFound \"foo\") -> True\n      _ -> False\n\n  -- One more test: Blocked/False => Blocked\n  r <- runHaxl env $ try $\n    (do _ <- friendsOf 2; throw (NotFound \"foo\")) `pOr` return False\n  assertBool \"pOr5\" $\n    case (r :: Either NotFound Bool) of\n      Left (NotFound _) -> True\n      _ -> False\n\npAndTests future = do\n  env <- makeTestEnv future\n\n  -- Test semantics\n  r <- runHaxl env $ do\n        a <- return False `pAnd` return False\n        b <- return False `pAnd` return True\n        c <- return True `pAnd` return False\n        d <- return True `pAnd` return True\n        return (not a && not b && not c && d)\n  assertBool \"pAnd0\" r\n\n  -- pAnd is left-biased with respect to exceptions:\n  r <- runHaxl env $ try $ return False `pAnd` throw (NotFound \"foo\")\n  assertBool \"pAnd1\" $\n    case (r :: Either NotFound Bool) of\n      Right False -> True\n      _ -> False\n  r <- runHaxl env $ try $ throw (NotFound \"foo\") `pAnd` return False\n  assertBool \"pAnd2\" $\n    case (r :: Either NotFound Bool) of\n      Left (NotFound \"foo\") -> True\n      _ -> False\n\n  -- pAnd is non-deterministic (see also Note [tricky pOr/pAnd])\n  let nondet =\n        (do _ <- friendsOf 1; throw (NotFound \"foo\")) `pAnd` return False\n  r <- runHaxl env $ try nondet\n  assertBool \"pAnd3\" $\n    case (r :: Either NotFound Bool) of\n      Right False -> True\n      _ -> False\n  -- next we populate the cache\n  _ <- runHaxl env $ friendsOf 1\n  -- and now exactly the same pAnd again will throw this time:\n  r <- runHaxl env $ try nondet\n  assertBool \"pAnd4\" $\n    case (r :: Either NotFound Bool) of\n      Left (NotFound \"foo\") -> True\n      _ -> False\n\n  -- One more test: Blocked/True => Blocked\n  r <- runHaxl env $ try $\n    (do _ <- friendsOf 2; throw (NotFound \"foo\")) `pAnd` return True\n  assertBool \"pAnd5\" $\n    case (r :: Either NotFound Bool) of\n      Left (NotFound _) -> True\n      _ -> False\n\ntests :: Bool -> Test\ntests future = TestList\n  [ TestLabel \"batching1\" $ TestCase (batching1 future)\n  , TestLabel \"batching2\" $ TestCase (batching2 future)\n  , TestLabel \"batching3\" $ TestCase (batching3 future)\n  , TestLabel \"batching4\" $ TestCase (batching4 future)\n  , TestLabel \"batching5\" $ TestCase (batching5 future)\n  , TestLabel \"batching6\" $ TestCase (batching6 future)\n  , TestLabel \"batching7\" $ TestCase (batching7 future)\n  , TestLabel \"batching8\" $ TestCase (batching8 future)\n  , TestLabel \"batching9\" $ TestCase (batching9 future)\n  , TestLabel \"caching1\" $ TestCase (caching1 future)\n  , TestLabel \"caching2\" $ TestCase (caching2 future)\n  , TestLabel \"caching3\" $ TestCase (caching3 future)\n  , TestLabel \"CacheReuse\" $ TestCase (cacheReuse future)\n  , TestLabel \"NoCaching\" $ TestCase (noCaching future)\n  , TestLabel \"exceptionTest1\" $ TestCase (exceptionTest1 future)\n  , TestLabel \"exceptionTest2\" $ TestCase (exceptionTest2 future)\n  , TestLabel \"deterministicExceptions\" $\n      TestCase (deterministicExceptions future)\n  , TestLabel \"pOrTest\" $ TestCase (pOrTests future)\n  , TestLabel \"pAndTest\" $ TestCase (pAndTests future)\n  ]\n", "num_lines": 306}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE RankNTypes, GADTs, BangPatterns, DeriveDataTypeable,\n    StandaloneDeriving #-}\n{-# OPTIONS_GHC -fno-warn-unused-do-bind -fno-warn-type-defaults #-}\n\nmodule Bench where\n\nimport Haxl.Core.DataCache as DataCache\n\nimport Prelude hiding (mapM)\n\nimport Data.Hashable\nimport Data.IORef\nimport Data.Time.Clock\nimport Data.Traversable\nimport Data.Typeable\nimport System.Environment\nimport Text.Printf\n\ndata TestReq a where\n  ReqInt    :: {-# UNPACK #-} !Int -> TestReq Int\n  ReqDouble :: {-# UNPACK #-} !Int -> TestReq Double\n  ReqBool   :: {-# UNPACK #-} !Int -> TestReq Bool\n  deriving Typeable\n\nderiving instance Eq (TestReq a)\nderiving instance Show (TestReq a)\n\ninstance Hashable (TestReq a) where\n  hashWithSalt salt (ReqInt i) = hashWithSalt salt (0::Int, i)\n  hashWithSalt salt (ReqDouble i) = hashWithSalt salt (1::Int, i)\n  hashWithSalt salt (ReqBool i) = hashWithSalt salt (2::Int, i)\n\nmain = do\n  [n] <- fmap (fmap read) getArgs\n  t0 <- getCurrentTime\n  cache <- emptyDataCache\n  let\n     f 0 = return ()\n     f !n = do\n       m <- newIORef 0\n       DataCache.insert (ReqInt n) m cache\n       f (n-1)\n  --\n  f n\n  m <- DataCache.lookup (ReqInt (n `div` 2)) cache\n  print =<< mapM readIORef m\n  t1 <- getCurrentTime\n  printf \"insert: %.2fs\\n\" (realToFrac (t1 `diffUTCTime` t0) :: Double)\n\n  t0 <- getCurrentTime\n  let\n     f 0  !m = return m\n     f !n !m = do\n      mbRes <- DataCache.lookup (ReqInt n) cache\n      case mbRes of\n        Nothing -> f (n-1) m\n        Just _  -> f (n-1) (m+1)\n  f n 0 >>= print\n  t1 <- getCurrentTime\n  printf \"lookup: %.2fs\\n\" (realToFrac (t1 `diffUTCTime` t0) :: Double)\n", "num_lines": 67}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE PatternGuards #-}\n{-# LANGUAGE RebindableSyntax #-}\n\nmodule CoreTests where\n\nimport Haxl.Prelude\nimport Prelude ()\n\nimport Haxl.Core\n\nimport Test.HUnit\n\nimport Data.Aeson\nimport qualified Data.ByteString.Lazy.Char8 as BS\nimport Data.List\n\nimport Control.Exception (Exception(..))\n\nimport ExampleDataSource\n\ntestEnv = do\n  -- To use a data source, we need to initialize its state:\n  exstate <- ExampleDataSource.initGlobalState\n\n  -- And create a StateStore object containing the states we need:\n  let st = stateSet exstate stateEmpty\n\n  -- Create the Env:\n  initEnv st () :: IO (Env () ())\n\nuseless :: String -> GenHaxl u w Bool\nuseless _ = throw (NotFound \"ha ha\")\n\nexceptions :: Assertion\nexceptions =\n  do\n    en <- emptyEnv () :: IO (Env () ())\n    a <- runHaxl en $ try (useless \"input\")\n    assertBool \"NotFound -> HaxlException\" $\n      isLeft (a :: Either HaxlException Bool)\n\n    b <- runHaxl en $ try (useless \"input\")\n    assertBool \"NotFound -> Logic Error\" $\n      isLeft (b :: Either LogicError Bool)\n\n    c <- runHaxl en $ try (useless \"input\")\n    assertBool \"NotFound -> NotFound\" $\n      isLeft (c :: Either NotFound Bool)\n\n    -- Make sure TransientError -doesn't- catch our NotFound\n    d <- runHaxl en $\n             (useless \"input\"\n              `catch` \\TransientError{} -> return False)\n             `catch` \\LogicError{} -> return True\n    assertBool \"Transient != NotFound\" d\n\n    -- test catch\n    e <- runHaxl en $\n         throw (NotFound \"haha\") `catch` \\NotFound{} -> return True\n    assertBool \"catch1\" e\n\n    f <- runHaxl en $\n         throw (NotFound \"haha\") `catch` \\LogicError{} -> return True\n    assertBool \"catch2\" f\n\n    -- test catchIf\n    let transientOrNotFound e\n          | Just TransientError{} <- fromException e  = True\n          | Just NotFound{} <- fromException e  = True\n          | otherwise = False\n\n    e <- runHaxl en $\n         catchIf transientOrNotFound (throw (NotFound \"haha\")) $ \\_ ->\n           return True\n    assertBool \"catchIf1\" e\n\n    e <- runHaxl en $\n         catchIf transientOrNotFound (throw (FetchError \"haha\")) $ \\_ ->\n           return True\n    assertBool \"catchIf2\" e\n\n    e <- runHaxl en $\n           (catchIf transientOrNotFound (throw (CriticalError \"haha\")) $ \\_ ->\n              return True)\n            `catch` \\InternalError{} -> return False\n    assertBool \"catchIf2\" (not e)\n\n    -- test tryToHaxlException\n    e <- runHaxl en $ tryToHaxlException $ head []\n    assertBool \"tryToHaxlException1\" $\n      case e of\n        Left ex | Just NonHaxlException{} <- fromException (toException ex)\n          -> True\n        _ -> False\n\n    env <- testEnv\n    e <- runHaxl env $ tryToHaxlException $ do\n      xs <- listWombats 3\n      return $! length xs `quot` 0\n    print e\n    assertBool \"tryToHaxlException1\" $\n      case e of\n        Left ex | Just NonHaxlException{} <- fromException (toException ex)\n          -> True\n        _ -> False\n\n    env <- testEnv\n    e <- runHaxl env $ mapM tryToHaxlException\n      [ do xs <- listWombats 3; return $! length xs `quot` 0\n      , head []\n      ]\n    print e\n    assertBool \"tryToHaxlException2\" $\n      case e of\n        [Left ex1, Left ex2]\n           | \"divide\" `isInfixOf` show ex1\n           , \"head\" `isInfixOf` show ex2 -> True\n        _ -> False\n  where\n  isLeft Left{} = True\n  isLeft _ = False\n\n\n-- This is mostly a compile test, to make sure all the plumbing\n-- makes the compiler happy.\nbase :: (Exception a) => a -> IO HaxlException\nbase e = do\n  en <- emptyEnv () :: IO (Env () ())\n  runHaxl en $ throw e `catch` \\x -> return x\n\nprinting :: Assertion\nprinting = do\n  a <- base $ NotFound \"notfound!\"\n  print a\n\n  b <- base $ CriticalError \"ohthehumanity!\"\n  print b\n\n  c <- base $ FetchError \"timeout!\"\n  print c\n\n  BS.putStrLn $ encode a\n  BS.putStrLn $ encode b\n  BS.putStrLn $ encode c\n\n\nwithEnvTest :: Test\nwithEnvTest = TestLabel \"withEnvTest\" $ TestCase $ do\n  exstate <- ExampleDataSource.initGlobalState\n  e <- initEnv (stateSet exstate stateEmpty) False :: IO (Env Bool ())\n  b <- runHaxl e $ withEnv e { userEnv = True } $ env userEnv\n  assertBool \"withEnv1\" b\n  e <- initEnv (stateSet exstate stateEmpty) False :: IO (Env Bool ())\n  b <- runHaxl e $ withEnv e { userEnv = True } $ do\n    _ <- countAardvarks \"aaa\"\n    env userEnv\n  assertBool \"withEnv2\" b\n  e <- initEnv (stateSet exstate stateEmpty) False :: IO (Env Bool ())\n  b <- runHaxl e $ withEnv e { userEnv = True } $ do\n    memo (\"xxx\" :: Text) $ do\n      _ <- countAardvarks \"aaa\"\n      env userEnv\n  assertBool \"withEnv3\" b\n  e <- initEnv (stateSet exstate stateEmpty) False :: IO (Env Bool ())\n  b <- runHaxl e $\n    withEnv e { userEnv = True } $ do\n      memo (\"yyy\" :: Text) $ do\n        _ <- countAardvarks \"aaa\"\n        _ <- countAardvarks \"bbb\"\n        env userEnv\n  assertBool \"withEnv4\" b\n\n\ntests = TestList\n  [ TestLabel \"exceptions\" $ TestCase exceptions,\n    TestLabel \"print_stuff\" $ TestCase printing,\n    TestLabel \"withEnv\" $ withEnvTest\n  ]\n", "num_lines": 186}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE StandaloneDeriving, GADTs, DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE ExistentialQuantification #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule DataCacheTest (tests, newResult, takeResult) where\n\nimport Haxl.Core.DataCache as DataCache\nimport Haxl.Core.Monad\nimport Haxl.Core\n\nimport Control.Exception\nimport Data.Either\nimport Data.Hashable\nimport Data.Traversable\nimport Data.Typeable\nimport Prelude hiding (mapM)\nimport Test.HUnit\nimport Data.IORef\nimport Data.Text\nimport Unsafe.Coerce\n\ndata TestReq a where\n   Req :: Int -> TestReq a -- polymorphic result\n  deriving Typeable\n\nderiving instance Eq (TestReq a)\nderiving instance Show (TestReq a)\n\ninstance Hashable (TestReq a) where\n  hashWithSalt salt (Req i) = hashWithSalt salt i\n\ninstance DataSource u TestReq where\n  fetch = error \"no fetch defined\"\n\ninstance DataSourceName TestReq where\n  dataSourceName _ = pack \"TestReq\"\n\ninstance StateKey TestReq where\n  data State TestReq = TestReqState\n\ninstance ShowP TestReq where showp = show\n\ndata CacheableReq x where CacheableInt :: Int -> CacheableReq Int\n  deriving Typeable\nderiving instance Eq (CacheableReq x)\nderiving instance Show (CacheableReq x)\ninstance Hashable (CacheableReq x) where\n  hashWithSalt s (CacheableInt val) = hashWithSalt s (0::Int, val)\n\n\nnewResult :: Monoid w => a -> IO (IVar u w a)\nnewResult a = newFullIVar (Ok a mempty)\n\ntakeResult :: IVar u w a -> IO (ResultVal a w)\ntakeResult IVar{ivarRef = ref} = do\n  e <- readIORef ref\n  case e of\n    IVarFull a -> return a\n    _ -> error \"takeResult\"\n\n\ndcSoundnessTest :: Test\ndcSoundnessTest = TestLabel \"DataCache soundness\" $ TestCase $ do\n  m1 <- newResult 1\n  m2 <- newResult \"hello\"\n  cache <- emptyDataCache\n  DataCache.insert (Req 2 :: TestReq String) m2 cache\n  DataCache.insert (Req 1 :: TestReq Int) m1 cache\n\n  -- \"Req 1\" has a result of type Int, so if we try to look it up\n  -- with a result of type String, we should get Nothing, not a crash.\n  r <- mapM takeResult =<< DataCache.lookup (Req 1) cache\n  assertBool \"dcSoundness1\" $\n    case r :: Maybe (ResultVal String ()) of\n     Nothing -> True\n     _something_else -> False\n\n  r <- mapM takeResult =<< DataCache.lookup (Req 1) cache\n  assertBool \"dcSoundness2\" $\n    case r :: Maybe (ResultVal Int ()) of\n     Just (Ok 1 Nothing) -> True\n     _something_else -> False\n\n  r <- mapM takeResult =<< DataCache.lookup (Req 2) cache\n  assertBool \"dcSoundness3\" $\n    case r :: Maybe (ResultVal String ()) of\n      Just (Ok \"hello\" Nothing) -> True\n      _something_else -> False\n\n  r <- mapM takeResult =<< DataCache.lookup (Req 2) cache\n  assertBool \"dcSoundness4\" $\n    case r :: Maybe (ResultVal Int ()) of\n      Nothing -> True\n      _something_else -> False\n\n\ndcStrictnessTest :: Test\ndcStrictnessTest = TestLabel \"DataCache strictness\" $ TestCase $ do\n  env <- initEnv stateEmpty () :: IO (Env () ())\n  r <- Control.Exception.try $ runHaxl env $\n    cachedComputation (Req (error \"BOOM\")) $ return \"OK\"\n  assertBool \"dcStrictnessTest\" $\n    case r of\n      Left (ErrorCall \"BOOM\") -> True\n      _other -> False\n\ndcFallbackTest :: Test\ndcFallbackTest = TestLabel \"DataCache fallback\" $ TestList\n  [ TestLabel \"Base\" $ TestCase $ do\n      env <- mkEnv\n      (r,cached) <- runHaxl env (do\n                           a <- dataFetch req\n                           b <- cacheResult (CacheableInt 1234) (return 99999)\n                           return (a,b))\n      (Stats stats) <- readIORef (statsRef env)\n      assertEqual \"fallback still has stats\" 1\n        (Prelude.length [x | x@FetchStats{} <- stats])\n      assertEqual \"dcFallbackTest found\" 1 r\n      assertEqual \"dcFallbackTest cached\" 1234 cached\n  , TestLabel \"Exception\" $ TestCase $ do\n      env <- mkEnv\n      rbad <- Control.Exception.try $ runHaxl env (dataFetch reqBad)\n      assertBool \"dcFallbackTest not found\" $\n        case rbad of\n          Left (ErrorCall \"no fetch defined\") -> True\n          _ -> False\n  , TestLabel \"Completions\" $ TestCase $ do\n      -- check applicative still runs as it would have without a fallback\n      env <- mkEnv\n      let\n        fetchA = dataFetch reqEx\n        fetchB = tellWrite 7 >> dataFetch req\n      (rbad, writes) <- runHaxlWithWrites env $\n        Haxl.Core.try $ (,) <$> fetchA <*> fetchB\n      fetches <- countFetches env\n      assertEqual \"dispatched 2 fetches\" 2 fetches\n      assertBool \"exception propogates\" $\n        case rbad of\n          Left (NotFound _) -> True\n          _ -> False\n      assertEqual \"write side effects happen\" [7] (flattenWT writes)\n  ]\n  where\n\n    mkEnv = addLookup <$> initEnv (stateSet TestReqState stateEmpty) ()\n\n    countFetches env = do\n      (Stats stats) <- readIORef (statsRef env)\n      let\n        c = sum [ fetchBatchSize x\n                | x@FetchStats{} <- stats\n                ]\n      return c\n\n    addLookup :: Env () (WriteTree Int) -> Env () (WriteTree Int)\n    addLookup e = e { dataCacheFetchFallback = Just (DataCacheLookup lookup)\n                    , flags = (flags e) { report = profilingReportFlags }\n                    }\n    lookup\n      :: forall req a . Typeable (req a)\n      => req a\n      -> IO (Maybe (ResultVal a (WriteTree Int)))\n    lookup r\n      | typeOf r == typeRep (Proxy :: Proxy (TestReq Int)) =\n        -- have to coerce on the way out as results are not Typeable\n        -- so you better be sure you do it right!\n        return $ unsafeCoerce . doReq <$> cast r\n      | typeOf r == typeRep (Proxy :: Proxy (CacheableReq Int)) =\n          return $ unsafeCoerce . doCache <$> cast r\n      | otherwise = return Nothing\n\n    doReq :: TestReq Int -> ResultVal Int (WriteTree Int)\n    doReq (Req 999) = ThrowHaxl (toException $ NotFound empty) Nothing\n    doReq (Req r) = Ok r Nothing\n\n    doCache :: CacheableReq Int -> ResultVal Int (WriteTree Int)\n    doCache (CacheableInt i) = Ok i Nothing\n\n    req :: TestReq Int\n    req = Req 1\n\n    reqEx :: TestReq Int\n    reqEx = Req 999\n\n    reqBad :: TestReq String\n    reqBad = Req 2\n\n\n-- tests :: Assertion\ntests = TestList [ dcSoundnessTest\n                 , dcStrictnessTest\n                 , dcFallbackTest\n                 ]\n", "num_lines": 201}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ApplicativeDo #-}\n\nmodule DataSourceDispatchTests (tests) where\nimport Test.HUnit hiding (State)\nimport Control.Monad\nimport Haxl.Core\nimport Data.Hashable\n\ndata DataSourceDispatch ty where\n    GetBatchSize :: Int -> DataSourceDispatch Int\n\nderiving instance Eq (DataSourceDispatch ty)\nderiving instance Show (DataSourceDispatch ty)\n\ninstance DataSourceName DataSourceDispatch where\n    dataSourceName _ = \"DataSourceDispatch\"\n\ninstance StateKey DataSourceDispatch where\n    data State DataSourceDispatch = DataSourceDispatchState\n\ninstance ShowP DataSourceDispatch where showp = show\n\ninstance Hashable (DataSourceDispatch a) where\n  hashWithSalt s (GetBatchSize n) = hashWithSalt s n\n\ninitDataSource :: IO (State DataSourceDispatch)\ninitDataSource = return DataSourceDispatchState\n\ninstance DataSource UserEnv DataSourceDispatch where\n    fetch _state _flags _u = SyncFetch $ \\bfs -> forM_ bfs (fill $ length bfs)\n      where\n      fill :: Int -> BlockedFetch DataSourceDispatch -> IO ()\n      fill l (BlockedFetch (GetBatchSize _ ) rv) = putResult rv (Right l)\n\n    schedulerHint Batching = TryToBatch\n    schedulerHint NoBatching = SubmitImmediately\n\ndata UserEnv = Batching | NoBatching deriving (Eq)\n\nmakeTestEnv :: UserEnv -> IO (Env UserEnv ())\nmakeTestEnv testUsrEnv = do\n  st <- initDataSource\n  e <- initEnv (stateSet st stateEmpty) testUsrEnv\n  return e { flags = (flags e) {\n    report = setReportFlag ReportFetchStats defaultReportFlags } }\n\nschedulerTest:: Test\nschedulerTest = TestCase $ do\n    let\n        fet = do\n          x <- dataFetch (GetBatchSize 0)\n          y <- dataFetch (GetBatchSize 1)\n          return [x,y]\n\n    e <- makeTestEnv Batching\n    r1 :: [Int] <- runHaxl e fet\n    assertEqual \"Failed to create batches for data fetch\" [2,2] r1\n\n    eNoBatching <- makeTestEnv NoBatching\n    r2 :: [Int] <- runHaxl eNoBatching fet\n    assertEqual \"Unexpexted batches in SubmitImmediately\" [1,1] r2\n\n    return ()\n\ntests :: Test\ntests = TestList\n  [ TestLabel \"schedulerTest\" schedulerTest\n  ]\n", "num_lines": 82}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule ExampleDataSource (\n    -- * initialise the state\n    initGlobalState,\n\n    -- * requests for this data source\n    Id(..), ExampleReq(..),\n    countAardvarks,\n    listWombats,\n  ) where\n\nimport Haxl.Prelude\nimport Prelude ()\n\nimport Haxl.Core\n\nimport Data.Typeable\nimport Data.Hashable\nimport Control.Concurrent\nimport qualified Control.Exception as E\nimport System.IO\n\n-- Here is an example minimal data source.  Our data source will have\n-- two requests:\n--\n--   countAardvarks :: String -> Haxl Int\n--   listWombats    :: Id     -> Haxl [Id]\n--\n-- First, the data source defines a request type, with one constructor\n-- for each request:\n\nnewtype Id = Id Int\n  deriving (Eq, Ord, Enum, Num, Integral, Real, Hashable, Typeable)\n\ninstance Show Id where\n  show (Id i) = show i\n\ndata ExampleReq a where\n  CountAardvarks :: String -> ExampleReq Int\n  ListWombats    :: Id     -> ExampleReq [Id]\n  deriving Typeable -- requests must be Typeable\n\n-- The request type (ExampleReq) is parameterized by the result type of\n-- each request.  Each request might have a different result, so we use a\n-- GADT - a data type in which each constructor may have different type\n-- parameters. Here CountAardvarks is a request that takes a String\n-- argument and its result is Int, whereas ListWombats takes an Id\n-- argument and returns a [Id].\n\n-- The request type needs instances for 'Eq1' and 'Hashable1'.  These\n-- are like 'Eq' and 'Hashable', but for types with one parameter\n-- where the parameter is irrelevant for hashing and equality.\n-- These two instances are used to support caching of requests.\n\n-- We need Eq, but we have to derive it with a standalone declaration\n-- like this, because plain deriving doesn't work with GADTs.\nderiving instance Eq (ExampleReq a)\n\nderiving instance Show (ExampleReq a)\n\ninstance ShowP ExampleReq where showp = show\n\ninstance Hashable (ExampleReq a) where\n   hashWithSalt s (CountAardvarks a) = hashWithSalt s (0::Int,a)\n   hashWithSalt s (ListWombats a)    = hashWithSalt s (1::Int,a)\n\ninstance StateKey ExampleReq where\n  data State ExampleReq = ExampleState {\n        -- in here you can put any state that the\n        -- data source needs to maintain throughout the\n        -- run.\n        }\n\n-- Next we need to define an instance of DataSourceName:\n\ninstance DataSourceName ExampleReq where\n  dataSourceName _ = \"ExampleDataSource\"\n\n-- Next we need to define an instance of DataSource:\n\ninstance DataSource u ExampleReq where\n  -- I'll define exampleFetch below\n  fetch = exampleFetch\n\n  -- we don't want to treat NotFound as an exception for stats purposes\n  classifyFailure _ _ e\n    | Just NotFound{} <- E.fromException e = IgnoredForStatsFailure\n    | otherwise = StandardFailure\n\n\n-- Every data source should define a function 'initGlobalState' that\n-- initialises the state for that data source.  The arguments to this\n-- function might vary depending on the data source - we might need to\n-- pass in resources from the environment, or parameters to set up the\n-- data source.\ninitGlobalState :: IO (State ExampleReq)\ninitGlobalState = do\n  -- initialize the state here.\n  return ExampleState { }\n\n\n-- The most important bit: fetching the data.  The fetching function\n-- takes a list of BlockedFetch, which is defined as\n--\n-- data BlockedFetch r\n--   = forall a . BlockedFetch (r a) (ResultVar a)\n--\n-- That is, each BlockedFetch is a pair of\n--\n--   - the request to fetch (with result type a)\n--   - a ResultVar to store either the result or an error\n--\n-- The job of fetch is to fetch the data and fill in all the ResultVars.\n--\nexampleFetch :: State ExampleReq             -- current state\n             -> Flags                        -- tracing verbosity, etc.\n             -> u                            -- user environment\n             -> PerformFetch ExampleReq      -- tells the framework how to fetch\n\nexampleFetch _state _flags _user = SyncFetch $ mapM_ fetch1\n\n  -- There are two ways a data source can fetch data: synchronously or\n  -- asynchronously.  See the type 'PerformFetch' in \"Haxl.Core.Types\" for\n  -- details.\n\nfetch1 :: BlockedFetch ExampleReq -> IO ()\nfetch1 (BlockedFetch (CountAardvarks \"BANG\") _) =\n  error \"BANG\"  -- data sources should not throw exceptions, but in\n                -- the event that one does, the framework will\n                -- propagate the exception to the call site of\n                -- dataFetch.\nfetch1 (BlockedFetch (CountAardvarks \"BANG2\") m) = do\n  putSuccess m 1\n  error \"BANG2\" -- the exception is propagated even if we have already\n                -- put the result with putSuccess\nfetch1 (BlockedFetch (CountAardvarks \"BANG3\") _) = do\n  hPutStr stderr \"BANG3\"\n  killThread =<< myThreadId -- an asynchronous exception\nfetch1 (BlockedFetch (CountAardvarks \"BANG4\") r) = do\n  putFailure r $ NotFound \"BANG4\"\nfetch1 (BlockedFetch (CountAardvarks str) m) =\n  putSuccess m (length (filter (== 'a') str))\nfetch1 (BlockedFetch (ListWombats a) r) =\n  if a > 999999\n    then putFailure r $ FetchError \"too large\"\n    else putSuccess r $ take (fromIntegral a) [1..]\n\n\n-- Normally a data source will provide some convenient wrappers for\n-- its requests:\n\ncountAardvarks :: String -> GenHaxl u w Int\ncountAardvarks str = dataFetch (CountAardvarks str)\n\nlistWombats :: Id -> GenHaxl u w [Id]\nlistWombats i = dataFetch (ListWombats i)\n", "num_lines": 171}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE CPP #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule ExceptionStackTests (tests) where\n\nimport Prelude ()\nimport Haxl.Core\nimport Haxl.Prelude\n\nimport Test.HUnit\n\nimport qualified ExampleDataSource\n\ntestEnv :: ReportFlags -> IO (Env () ())\ntestEnv report = do\n  exstate <- ExampleDataSource.initGlobalState\n  let st = stateSet exstate stateEmpty\n  env <- initEnv st ()\n  return env{ flags = (flags env){ report = report } }\n\nreportFlags :: ReportFlags\nreportFlags = setReportFlag ReportExceptionLabelStack defaultReportFlags\n\nrunHaxlTest\n  :: ReportFlags\n  -> String\n  -> (Int -> Int -> GenHaxl () () Int)\n  -> IO (Maybe [Text])\nrunHaxlTest report str func = do\n  env <- testEnv report\n  result <- runHaxl env $\n    withLabel \"try\" $ tryToHaxlException $ withLabel \"test\" $ do\n      x <- withLabel \"dummy\" $ pure 1\n      y <- withLabel \"fetch\" $ ExampleDataSource.countAardvarks str\n      withLabel \"func\" $ func x y\n  case result of\n    Left (HaxlException stk _) -> return stk\n    Right{} -> assertFailure \"expected: HaxlException\"\n\nfetchException :: Test\nfetchException = TestCase $ do\n  result <- runHaxlTest reportFlags \"BANG4\" $ \\i j -> return $ i + j\n  assertEqual \"stack\" (Just [\"fetch\", \"test\", \"try\", \"MAIN\"]) result\n\nuserException :: Test\nuserException = TestCase $ do\n  result <- runHaxlTest reportFlags \"aaa\" $ \\_ _ -> withLabel \"throw\" $\n    throw $ InvalidParameter \"throw\"\n  assertEqual \"stack\" (Just [\"throw\", \"func\", \"test\", \"try\", \"MAIN\"]) result\n\n#ifndef PROFILING\ndisabledExceptionStack :: Test\ndisabledExceptionStack = TestCase $ do\n  result <- runHaxlTest defaultReportFlags \"BANG4\" $ \\i j -> return $ i + j\n  assertEqual \"stack\" Nothing result\n#endif\n\ntests :: Test\ntests = TestList\n  [ TestLabel \"FetchException\" fetchException\n  , TestLabel \"UserException\" userException\n#ifndef PROFILING\n  , TestLabel \"DisabledExceptionStack\"  disabledExceptionStack\n#endif\n  ]\n", "num_lines": 72}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module FBMain (main) where\n\nimport Facebook.Init\nimport TestRunner\nimport AllTests\n\nmain :: IO ()\nmain = withFacebookUnitTest $ testRunner $ allTests\n", "num_lines": 9}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\nmodule FullyAsyncTest where\n\nimport Haxl.Prelude as Haxl\nimport Prelude()\n\nimport SleepDataSource\nimport Haxl.DataSource.ConcurrentIO\n\nimport Haxl.Core\nimport Test.HUnit\nimport Data.IORef\nimport Haxl.Core.Monad (unsafeLiftIO)\n\ntests :: Test\ntests = sleepTest\n\ntestEnv :: IO (Env () ())\ntestEnv = do\n  st <- mkConcurrentIOState\n  env <- initEnv (stateSet st stateEmpty) ()\n  return env { flags = (flags env) {\n    report = setReportFlag ReportFetchStats defaultReportFlags } }\n\nsleepTest :: Test\nsleepTest = TestCase $ do\n  env <- testEnv\n\n  ref <- newIORef ([] :: [Int])\n  let tick n = unsafeLiftIO (modifyIORef ref (n:))\n\n  -- simulate running a selection of data fetches that complete at\n  -- different times, overlapping them as much as possible.\n  runHaxl env $\n    sequence_\n       [ sequence_ [sleep 100, sleep 400] `andThen` tick 5     -- A\n       , sleep 100 `andThen` tick 2 `andThen` sleep 200 `andThen` tick 4    -- B\n       , sleep 50 `andThen` tick 1 `andThen` sleep 150 `andThen` tick 3     -- C\n       ]\n\n  ys <- readIORef ref\n  assertEqual \"FullyAsyncTest: ordering\" [1,2,3,4,5] (reverse ys)\n\n  stats <- readIORef (statsRef env)\n  print stats\n  assertEqual \"FullyAsyncTest: stats\" 5 (numFetches stats)\n\n{-\n           A         B         C\n50          |        |       tick 1\n100         |     tick 2       |\n150         |        |         |\n200         |        |       tick 3\n250         |        |\n300         |     tick 4\n350         |\n400         |\n450         |\n500      tick 5\n-}\n", "num_lines": 66}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE CPP, OverloadedStrings #-}\nmodule LoadCache where\n\nimport Haxl.Core\nimport ExampleDataSource\n\n#include \"LoadCache.txt\"\n", "num_lines": 14}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\nmodule MemoizationTests (tests) where\n\nimport Data.IORef\n\nimport Test.HUnit\n\nimport Haxl.Core\nimport Haxl.Core.Monad (unsafeLiftIO)\n\nimport ExampleDataSource\n\nmemoSoundness :: Test\nmemoSoundness = TestCase $ do\n  iEnv <- do\n    exState <- ExampleDataSource.initGlobalState\n    initEnv (stateSet exState stateEmpty) () :: IO (Env () ())\n\n  unMemoizedWombats <- runHaxl iEnv $ listWombats 100\n\n  (initialGet, subsequentGet) <- runHaxl iEnv $ do\n    wombatsMemo <- newMemoWith (listWombats 100)\n    let memoizedWombats = runMemo wombatsMemo\n\n    initialGet <- memoizedWombats\n    subsequentGet <- memoizedWombats\n\n    return (initialGet, subsequentGet)\n\n  assertBool \"Memo Soundness 1\" $ initialGet == unMemoizedWombats\n  assertBool \"Memo Soundness 2\" $ subsequentGet == unMemoizedWombats\n\n  let impure runCounterRef = unsafeLiftIO $ do\n        modifyIORef runCounterRef succ\n        readIORef runCounterRef\n\n      initialRunCounter = 0 :: Int\n\n  runCounterRef <- newIORef initialRunCounter\n\n  (initialImpureGet, subsequentImpureGet) <- runHaxl iEnv $ do\n    impureMemo <- newMemoWith (impure runCounterRef)\n    let memoizedImpure = runMemo impureMemo\n\n    initialImpureGet <- memoizedImpure\n    subsequentImpureGet <- memoizedImpure\n\n    return (initialImpureGet, subsequentImpureGet)\n\n  assertBool \"Memo Soundness 3\" $ initialImpureGet == succ initialRunCounter\n  assertBool \"Memo Soundness 4\" $ subsequentImpureGet == initialImpureGet\n\n  let fMemoVal = 42 :: Int\n\n  dependentResult <- runHaxl iEnv $ do\n    fMemoRef <- newMemo\n    gMemoRef <- newMemo\n\n    let f = runMemo fMemoRef\n        g = runMemo gMemoRef\n\n    prepareMemo fMemoRef $ return fMemoVal\n    prepareMemo gMemoRef $ succ <$> f\n\n    a <- f\n    b <- g\n    return (a + b)\n\n  assertBool \"Memo Soundness 5\" $ dependentResult == fMemoVal + succ fMemoVal\n\ntests = TestList [TestLabel \"Memo Soundness\" memoSoundness]\n", "num_lines": 77}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE TypeSynonymInstances #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE RecordWildCards #-}\n\nmodule MockTAO (\n    Id(..),\n    initGlobalState,\n    assocRangeId2s,\n    friendsAssoc,\n    friendsOf,\n  ) where\n\nimport Data.Hashable\nimport Data.Map (Map)\nimport Data.Typeable\nimport Prelude ()\nimport qualified Data.Map as Map\nimport qualified Data.Text as Text\nimport Control.Concurrent\nimport Control.Exception\nimport Control.Monad (void)\n\n\nimport Haxl.Prelude\nimport Haxl.Core\n\nimport TestTypes\n\n-- -----------------------------------------------------------------------------\n-- Minimal mock TAO\n\ndata TAOReq a where\n  AssocRangeId2s :: Id -> Id -> TAOReq [Id]\n  deriving Typeable\n\nderiving instance Show (TAOReq a)\nderiving instance Eq (TAOReq a)\n\ninstance ShowP TAOReq where showp = show\n\ninstance Hashable (TAOReq a) where\n  hashWithSalt s (AssocRangeId2s a b) = hashWithSalt s (a,b)\n\ninstance StateKey TAOReq where\n  data State TAOReq = TAOState { future :: Bool }\n\ninstance DataSourceName TAOReq where\n  dataSourceName _ = \"MockTAO\"\n\ninstance DataSource UserEnv TAOReq where\n  fetch TAOState{..} _flags _user\n    | future = BackgroundFetch $ \\f -> do\n        mask_ $ void . forkIO $  mapM_ (doFetch True) f\n    | otherwise = SyncFetch $ mapM_ (doFetch False)\n\ninitGlobalState :: Bool -> IO (State TAOReq)\ninitGlobalState future = return TAOState { future=future }\n\ndoFetch ::  Bool -> BlockedFetch TAOReq -> IO ()\ndoFetch bg (BlockedFetch req@(AssocRangeId2s a b) r) = put result\n  where put = if bg then putResultFromChildThread r else putResult r\n        result = case Map.lookup (a, b) assocs of\n          Nothing -> except . NotFound . Text.pack $ show req\n          Just result -> Right result\n\n\nassocs :: Map (Id,Id) [Id]\nassocs = Map.fromList [\n  ((friendsAssoc, 1), [5..10]),\n  ((friendsAssoc, 2), [7..12]),\n  ((friendsAssoc, 3), [10..15]),\n  ((friendsAssoc, 4), [15..19])\n ]\n\nfriendsAssoc :: Id\nfriendsAssoc = 167367433327742\n\nassocRangeId2s :: Id -> Id -> Haxl [Id]\nassocRangeId2s a b = dataFetch (AssocRangeId2s a b)\n\nfriendsOf :: Id -> Haxl [Id]\nfriendsOf = assocRangeId2s friendsAssoc\n", "num_lines": 95}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE ApplicativeDo #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n\nmodule MonadAsyncTest (tests) where\nimport Haxl.Core\nimport Test.HUnit hiding (State)\nimport Control.Concurrent\nimport Control.Exception as Exception\nimport Control.Monad\nimport Haxl.Core.Monad (unsafeLiftIO, WriteTree)\nimport System.IO.Unsafe\nimport Data.Hashable\nimport Data.IORef\nimport Data.Text (Text)\n\nnewtype SimpleWrite = SimpleWrite Text deriving (Eq, Show)\n\n{-# NOINLINE shouldThrowRef #-}\nshouldThrowRef :: IORef Bool\nshouldThrowRef = unsafePerformIO (newIORef False)\n\n-- | This datasource contains \"bad\" code which can throw at the wrong\n-- moment.\ndata ThrowableSleep a where\n  Sleep :: Int -> ThrowableSleep Int\n\nderiving instance Eq (ThrowableSleep a)\nderiving instance Show (ThrowableSleep a)\n\ninstance ShowP ThrowableSleep where showp = show\n\ninstance Hashable (ThrowableSleep a) where\n  hashWithSalt s (Sleep n) = hashWithSalt s n\n\ninstance StateKey ThrowableSleep where\n  data State ThrowableSleep = ThrowableSleepState\n\ninitDataSource :: IO (State ThrowableSleep)\ninitDataSource = return ThrowableSleepState\n\ninstance DataSourceName ThrowableSleep where\n  dataSourceName _ = \"ThrowableSleep\"\n\ninstance DataSource u ThrowableSleep where\n  fetch _state _flags _u = BackgroundFetch $ \\bfs -> forM_ bfs fill\n    where\n    fill :: BlockedFetch ThrowableSleep -> IO ()\n    fill (BlockedFetch (Sleep n) rv) = do\n      _ <- forkFinally\n        (do\n          threadDelay (n*1000)\n          return n\n        )\n        (\\res -> do\n          shouldThrow <- atomicModifyIORef' shouldThrowRef (\\s -> (False, s))\n          -- Simulate case when datasource throws before putting Result into\n          -- completions queue.\n          when shouldThrow $ do\n            throwIO $ ErrorCall \"datasource threw an exception\"\n          -- In case the datasource throws before this point, there'll be\n          -- nothing to put the result to the queue of 'completions', and\n          -- therefore Haxl would block indefinitely.\n          --\n          -- Note that Haxl tries to catch datasource exceptions and put the\n          -- \"exception result\" into `completions` using `wrapFetchInCatch`\n          -- function. However that doesn't work in this case because the\n          -- datasource throws in a separate thread.\n          putResultFromChildThread rv res\n        )\n      return ()\n\ntests :: Test\ntests = TestList\n  [ TestLabel \"exceptionTest\" exceptionTest\n  ]\n\nmkTestEnv :: IO (Env () (WriteTree SimpleWrite))\nmkTestEnv = do\n  st <- initDataSource\n  initEnv (stateSet st stateEmpty) ()\n\nexceptionTest :: Test\nexceptionTest = TestCase $ do\n  e <- mkTestEnv\n\n  let\n      fet (n :: Int) (st :: Bool )= do\n        x <- dataFetch (Sleep (fromIntegral n))\n        unsafeLiftIO $ writeIORef shouldThrowRef st\n        y <- dataFetch (Sleep (fromIntegral x*2))\n        return (x+y)\n\n  r1 :: (Either Exception.SomeException Int)\n    <- Exception.try $ runHaxl e $ fet 10 True\n\n  -- Datasources are responsible for putting the fetched result into the\n  -- completions queue. If for some reason they fail to do so, Haxl throws a\n  -- LogicBug since the scheduler is still expecting some request(s) to\n  -- be completed.\n  case r1 of\n    Left ex | Just (LogicBug _) <- Exception.fromException ex -> return ()\n    _ -> assertFailure \"r1 computation did not fail with Logic Bug!\"\n\n  -- Sanitize the env to get rid of all empty IVars\n  -- While this test examines the case when there's an exception in the Haxl\n  -- datasource itself, a similar behavior will occur in case an async\n  -- exception is thrown to the Haxl scheduler thread.\n  e' <- sanitizeEnv e\n\n  r2 :: (Either Exception.SomeException Int)\n    <- Exception.try $ runHaxl e' $ fet 10 False\n  case r2 of\n    Right _ -> return ()\n    Left ex | Just (LogicBug _) <- Exception.fromException ex -> do\n                assertFailure $ \"bad exception in r2: \" ++ show ex\n    Left _ -> return ()\n", "num_lines": 129}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n-- | Benchmarking tool for core performance characteristics of the Haxl monad.\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ApplicativeDo, RecordWildCards #-}\nmodule MonadBench (main) where\n\nimport Control.Monad\nimport Data.List as List\nimport Data.Maybe\nimport Data.Time.Clock\nimport Options.Applicative\nimport System.Exit\nimport System.IO\nimport Text.Printf\n\nimport Haxl.Prelude as Haxl\nimport Prelude()\n\nimport Haxl.Core\nimport Haxl.Core.Monad (WriteTree)\nimport Haxl.Core.Util\n\nimport ExampleDataSource\n\nnewtype SimpleWrite = SimpleWrite Text deriving (Eq, Show)\n\ntestEnv :: ReportFlags -> IO (Env () (WriteTree SimpleWrite))\ntestEnv report = do\n  exstate <- ExampleDataSource.initGlobalState\n  let st = stateSet exstate stateEmpty\n  env <- initEnv st ()\n  return env { flags = (flags env) { report = report } }\n\ntype Test = (String, Int, Int -> GenHaxl () (WriteTree SimpleWrite) ())\n\ntestName :: Test -> String\ntestName (t,_,_) = t\n\nallTests :: [Test]\nallTests =\n    -- parallel, identical queries\n  [ (\"par1\", large, \\n -> Haxl.sequence_ (replicate n (listWombats 3)))\n    -- parallel, distinct queries\n  , (\"par2\", medium, \\n ->\n        Haxl.sequence_ (map listWombats [1..fromIntegral n]))\n    -- sequential, identical queries\n  , (\"seqr\", huge, \\n ->\n        foldr andThen (return ()) (replicate n (listWombats 3)))\n    -- sequential, left-associated, distinct queries\n  , (\"seql\", medium, \\n -> do\n       _ <- foldl andThen (return []) (map listWombats [1.. fromIntegral n])\n       return ())\n    -- No memoization\n  , (\"memo0\", small, \\n -> Haxl.sequence_ [unionWombats | _ <- [1..n]])\n    -- One put, N gets.\n  , (\"memo1\", medium_large, \\n ->\n        Haxl.sequence_ [memo (42 :: Int) unionWombats | _ <- [1..n]])\n    -- N puts, N gets.\n  , (\"memo2\", small, \\n ->\n        Haxl.sequence_ [memo (i :: Int) unionWombats | i <- [1..n]])\n  , (\"memo3\", medium_large, \\n -> do\n        ref <- newMemoWith unionWombats\n        let c = runMemo ref\n        Haxl.sequence_ [c | _ <- [1..n]])\n  , (\"memo4\", small, \\n -> do\n        let f = unionWombatsTo\n        Haxl.sequence_ [f x | x <- take n $ cycle [100, 200 .. 1000]])\n  , (\"memo5\", medium_large, \\n -> do\n        f <- memoize1 unionWombatsTo\n        Haxl.sequence_ [f x | x <- take n $ cycle [100, 200 .. 1000]])\n  , (\"memo6\", small, \\n -> do\n        let f = unionWombatsFromTo\n        Haxl.sequence_ [ f x y\n                       | x <- take n $ cycle [100, 200 .. 1000]\n                       , let y = x + 1000\n                       ])\n  , (\"memo7\", medium_large, \\n -> do\n        f <- memoize2 unionWombatsFromTo\n        Haxl.sequence_ [ f x y\n                       | x <- take n $ cycle [100, 200 .. 1000]\n                       , let y = x + 1000\n                       ])\n  , (\"cc1\", medium_large, \\n ->\n        Haxl.sequence_ [ cachedComputation (ListWombats 1000) unionWombats\n                       | _ <- [1..n]\n                       ])\n  , (\"tree\", 20, \\n -> void $ tree n (\\_ act -> act))\n  , (\"tree_labels\", 20, \\n -> void $\n      tree n (\\n act -> withLabel (textShow n) act))\n    -- parallel writes\n  , (\"write1\", large, \\n ->\n        Haxl.sequence_ (replicate n (tellWrite (SimpleWrite \"haha\"))))\n    -- sequential writes\n  , (\"write2\", huge, \\n -> foldr\n        andThen\n        (return ())\n        (replicate n (tellWrite (SimpleWrite \"haha\"))))\n  ]\n  where\n    huge = large * 10\n    large =  medium * 10\n    medium_large =  medium * 4\n    medium = 200000\n    small = 1000\n\ndata Options = Options\n  { test :: String\n  , nOverride :: Maybe Int\n  , reportFlag :: ReportFlags\n  }\n\nrunTest :: Options -> Test -> IO ()\nrunTest Options{..} (t, nDef, act) = do\n  let n = fromMaybe nDef nOverride\n  env <- testEnv reportFlag\n  t0 <- getCurrentTime\n  runHaxl env $ act n\n  t1 <- getCurrentTime\n  printf \"%12s: %10d reqs: %.2fs\\n\"\n    t n (realToFrac (t1 `diffUTCTime` t0) :: Double)\n\noptionsParser :: Parser Options\noptionsParser = do\n  test <- argument str (metavar \"TEST\")\n  reportFlag <- reportFlagParser\n  nOverride <- optional $ argument auto (metavar \"NUM\")\n  return Options{..}\n  where\n    reportFlagParser = foldl' (flip ($)) defaultReportFlags <$> sequenceA\n      [ flag id (setReportFlag i) $ long $ show i\n      | i <- enumFrom minBound\n      ]\n\nmain :: IO ()\nmain = do\n  opts@Options{..} <- execParser $ info optionsParser mempty\n  let tests = if test == \"all\"\n        then allTests\n        else filter ((==) test . testName) allTests\n  when\n    (null tests)\n    (do\n        hPutStrLn stderr $ \"syntax: monadbench [all|\" ++\n          intercalate \"|\" (map testName allTests) ++ \"]\"\n        exitWith (ExitFailure 1))\n  Control.Monad.mapM_ (runTest opts) tests\n\ntree\n  :: Int\n  -> (Int -> GenHaxl () (WriteTree SimpleWrite) [Id]\n  -> GenHaxl () (WriteTree SimpleWrite) [Id])\n  -> GenHaxl () (WriteTree SimpleWrite) [Id]\ntree 0 wrap = wrap 0 $ listWombats 0\ntree n wrap = wrap n $ concat <$> Haxl.sequence\n  [ tree (n-1) wrap\n  , listWombats (fromIntegral n), tree (n-1) wrap\n  ]\n\nunionWombats :: GenHaxl () (WriteTree SimpleWrite) [Id]\nunionWombats = foldl List.union [] <$> Haxl.mapM listWombats [1..1000]\n\nunionWombatsTo :: Id -> GenHaxl () (WriteTree SimpleWrite) [Id]\nunionWombatsTo x = foldl List.union [] <$> Haxl.mapM listWombats [1..x]\n\nunionWombatsFromTo :: Id -> Id -> GenHaxl () (WriteTree SimpleWrite) [Id]\nunionWombatsFromTo x y = foldl List.union [] <$> Haxl.mapM listWombats [x..y]\n", "num_lines": 172}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ApplicativeDo #-}\nmodule OutgoneFetchesTests (tests) where\n\nimport Haxl.Prelude as Haxl\nimport Prelude()\n\nimport Haxl.Core\nimport Haxl.DataSource.ConcurrentIO\n\nimport Data.IORef\nimport qualified Data.Map as Map\nimport Data.Typeable\nimport Test.HUnit\nimport System.Timeout\n\nimport ExampleDataSource\nimport SleepDataSource\n\ntestEnv :: IO (Env () ())\ntestEnv = do\n  exstate <- ExampleDataSource.initGlobalState\n  sleepState <- mkConcurrentIOState\n  let st = stateSet exstate $ stateSet sleepState stateEmpty\n  e <- initEnv st ()\n  return e { flags = (flags e) {\n    report = setReportFlag ReportOutgoneFetches defaultReportFlags } }\n    -- report=1 to enable fetches tracking\n\n-- A cheap haxl computation we interleave b/w the @sleep@ fetches.\nwombats :: GenHaxl () () Int\nwombats = length <$> listWombats 3\n\noutgoneFetchesTest :: String -> Int -> GenHaxl () () a -> Test\noutgoneFetchesTest label unfinished haxl = TestLabel label $ TestCase $ do\n  env <- testEnv\n  _ <- timeout (100*1000) $ runHaxl env haxl -- 100ms\n  actual <- getMapFromRCMap <$> readIORef (submittedReqsRef env)\n  assertEqual \"fetchesMap\" expected actual\n  where\n  expected = if unfinished == 0 then Map.empty else\n    Map.singleton (dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep))) $\n      Map.singleton (typeOf1 (undefined :: ConcurrentIOReq Sleep a)) unfinished\n\ntests :: Test\ntests = TestList\n  [ outgoneFetchesTest \"finished\" 0 $ do\n      -- test that a completed datasource fetch doesn't show up in Env\n      _ <- sleep 1  -- finished\n      _ <- sleep 1  -- cached/finished\n      _ <- sleep 1  -- cached/finished\n      wombats\n  , outgoneFetchesTest \"unfinished\" 2 $ do\n      -- test that unfinished datasource fetches shows up in Env\n      _ <- sleep 200 -- unfinished\n      _ <- wombats\n      _ <- sleep 300 -- unfinished\n      _  <- wombats\n      return ()\n  , outgoneFetchesTest \"mixed\" 2 $ do\n      -- test for finished/unfinished fetches from the same datasource\n      _ <- sleep 1   -- finished\n      _ <- sleep 200  -- unfinished\n      _ <- sleep 300  -- unfinished\n      return ()\n  , outgoneFetchesTest \"cached\" 1 $ do\n      -- test for cached requests not showing up twice in ReqCountMap\n      _ <- sleep 200  -- unfinished\n      _ <- sleep 200  -- cached/unfinished\n      return ()\n  , outgoneFetchesTest \"unsent\" 1 $\n      -- test for unsent requests not showing up in ReqCountMap\n      sleep 200 `andThen` sleep 300 -- second req should never be sent\n  ]\n", "num_lines": 81}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "module ParallelTests where\n\nimport Haxl.Prelude\nimport Haxl.Core\n\nimport Haxl.DataSource.ConcurrentIO\nimport SleepDataSource\n\nimport Data.Time.Clock\n\nimport Test.HUnit\n\ntestEnv :: IO (Env () ())\ntestEnv = do\n  sleepState <- mkConcurrentIOState\n  let st = stateSet sleepState stateEmpty\n  initEnv st ()\n\nsync_test :: IO ()\nsync_test = do\n  env <- testEnv\n  -- This computation tests that the two arguments of the pOr can fire\n  -- without causing an error. The reason we test for this is that the\n  -- synchronization involved in this case is a little fragile.\n  False <- runHaxl env $ do\n    (fmap (const False) (sleep 50)\n      `pOr` fmap (const False) (sleep 100))\n      `pOr` fmap (const False) (sleep 200)\n  return ()\n\nsemantics_when_computation_is_blocked_test :: IO ()\nsemantics_when_computation_is_blocked_test = do\n  env <- testEnv\n    -- Test semantics of blocking\n  let sleepReturn bool t = do\n        _ <- sleep t\n        return bool\n  r <- runHaxl env $ do\n        -- All sleep times are different so that they're not cached\n        a <- sleepReturn False 10 `pOr` sleepReturn False 11\n        b <- sleepReturn False 12 `pOr` sleepReturn True 13\n        c <- sleepReturn True 14 `pOr` sleepReturn False 15\n        d <- sleepReturn True 16 `pOr` sleepReturn True 17\n        return (not a && b && c && d)\n  assertBool \"pOr blocked semantics\" r\n\n\ntiming_test = do\n  env <- testEnv\n  t0 <- getCurrentTime\n  True <- runHaxl env $\n    fmap (const True) (sleep 200) `pOr` fmap (const True) (sleep 100)\n  t1 <- getCurrentTime\n  True <- runHaxl env $\n    fmap (const True) (sleep 100) `pOr` fmap (const True) (sleep 200)\n  t2 <- getCurrentTime\n  False <- runHaxl env $\n    fmap (const False) (sleep 200) `pOr` fmap (const False) (sleep 100)\n  t3 <- getCurrentTime\n  False <- runHaxl env $\n    fmap (const False) (sleep 100) `pOr` fmap (const False) (sleep 200)\n  t4 <- getCurrentTime\n  -- diffUTCTime returns the difference in seconds,\n  -- while sleep expects milliseconds\n  assert (t4 `diffUTCTime` t3 < 0.2)\n  assert (t3 `diffUTCTime` t2 < 0.2)\n  assert (t2 `diffUTCTime` t1 < 0.2)\n  assert (t1 `diffUTCTime` t0 < 0.2)\n\ntests = TestList [TestLabel \"sync_test\" (TestCase sync_test)\n                 ,TestLabel \"timing_test\" (TestCase timing_test)\n                 ,TestLabel \"semantics_when_computation_is_blocked_test\" (TestCase semantics_when_computation_is_blocked_test)\n                 ]\n", "num_lines": 74}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE NoImplicitPrelude #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE CPP #-}\n\nmodule ProfileTests where\n\nimport Haxl.Prelude\n\nimport Haxl.Core\nimport Haxl.Core.Monad\nimport Haxl.Core.Stats\n\nimport Test.HUnit\n\nimport Control.DeepSeq (force)\nimport Control.Exception (evaluate)\nimport Data.Aeson\nimport Data.IORef\nimport qualified Data.HashMap.Strict as HashMap\n#if MIN_VERSION_aeson(2,0,0)\nimport qualified Data.Aeson.KeyMap as KeyMap\n#else\nimport qualified Data.HashMap.Strict as KeyMap\n#endif\nimport Data.Int\n\nimport TestTypes\nimport TestUtils\nimport WorkDataSource\nimport SleepDataSource\n\nmkProfilingEnv :: IO HaxlEnv\nmkProfilingEnv = do\n  env <- makeTestEnv False\n  return env { flags = (flags env) { report = profilingReportFlags } }\n\n-- expects only one label to be shown\nlabelToDataMap :: Profile -> HashMap.HashMap ProfileLabel ProfileData\nlabelToDataMap Profile{..} = HashMap.fromList hashKeys\n  where\n    labelKeys = HashMap.fromList [\n      (k, l) | ((l, _), k) <- HashMap.toList profileTree]\n    hashKeys = [ (l, v)\n      | (k, v) <- HashMap.toList profile\n      , Just l <- [HashMap.lookup k labelKeys]]\n\ncollectsdata :: Assertion\ncollectsdata = do\n  e <- mkProfilingEnv\n  _x <- runHaxl e $\n          withLabel \"bar\" $\n            withLabel \"foo\" $ do\n              u <- env userEnv\n              slp <- sum <$> mapM (\\x -> withLabel \"baz\" $ return x) [1..5]\n              -- do some non-trivial work that can't be lifted out\n              -- first sleep though in order to force a Blocked result\n              sleep slp `andThen` case fromJSON <$> KeyMap.lookup \"A\" u of\n                Just (Success n) | sum [n .. 1000::Integer] > 0 -> return 5\n                _otherwise -> return (4::Int)\n  profCopy <- readIORef (profRef e)\n  let\n    profData = profile profCopy\n    labelKeys = HashMap.fromList [\n      (l, k) | ((l, _), k) <- HashMap.toList (profileTree profCopy)]\n    getData k = do\n      k2 <- HashMap.lookup k labelKeys\n      HashMap.lookup k2 profData\n  assertEqual \"has data\" 4 $ HashMap.size profData\n  assertBool \"foo allocates\" $\n    case profileAllocs <$> getData \"foo\" of\n      Just x -> x > 10000\n      Nothing -> False\n  assertEqual \"foo is only called once\" (Just 1) $\n    profileLabelHits <$> getData \"foo\"\n  assertEqual \"baz is called 5 times\" (Just 5) $\n    profileLabelHits <$> getData \"baz\"\n  assertBool \"bar does not allocate (much)\" $\n    case profileAllocs <$> getData \"bar\" of\n      Just n -> n < 5000  -- getAllocationCounter can be off by +/- 4K\n      _otherwise -> False\n  let fooParents = case HashMap.lookup \"foo\" labelKeys of\n        Nothing -> []\n        Just kfoo ->\n          [ kparent\n          | ((_, kparent), k) <- HashMap.toList (profileTree profCopy)\n          , k == kfoo]\n  assertEqual \"foo's parent\" 1 (length fooParents)\n  assertEqual \"foo's parent is bar\" (Just (head fooParents)) $\n    HashMap.lookup (\"bar\", 0) (profileTree profCopy)\n\n\ncollectsLazyData :: Assertion\ncollectsLazyData = do\n  e <- mkProfilingEnv\n  _x <- runHaxl e $ withLabel \"bar\" $ do\n          u <- env userEnv\n          withLabel \"foo\" $ do\n             let start = if KeyMap.member \"A\" u\n                         then 10\n                         else 1\n             return $ sum [start..10000::Integer]\n  profCopy <- readIORef (profRef e)\n  -- check the allocations are attributed to foo\n  assertBool \"foo has allocations\" $\n    case profileAllocs <$> HashMap.lookup \"foo\" (labelToDataMap profCopy) of\n      Just x -> x > 10000\n      Nothing -> False\n\nexceptions :: Assertion\nexceptions = do\n  env <- mkProfilingEnv\n  _x <- runHaxl env $\n          withLabel \"outer\" $\n            tryToHaxlException $ withLabel \"inner\" $\n              unsafeLiftIO $ evaluate $ force (error \"pure exception\" :: Int)\n  profData <- labelToDataMap <$> readIORef (profRef env)\n  assertBool \"inner label not added\" $\n    not $ HashMap.member \"inner\" profData\n\n  env2 <- mkProfilingEnv\n  _x <- runHaxl env2 $\n          withLabel \"outer\" $\n            tryToHaxlException $ withLabel \"inner\" $\n              throw $ NotFound \"haxl exception\"\n  profData <- labelToDataMap <$> readIORef (profRef env2)\n  assertBool \"inner label added\" $\n    HashMap.member \"inner\" profData\n\n\n-- Test that we correctly attribute work done in child threads when\n-- using BackgroundFetch to the caller of runHaxl. This is important\n-- for correct accounting when relying on allocation limits.\nthreadAlloc :: Integer -> Assertion\nthreadAlloc batches = do\n  env' <- initEnv (stateSet mkWorkState stateEmpty) () :: IO (Env () ())\n  let env = env'  { flags = (flags env') {\n    report = setReportFlag ReportFetchStats defaultReportFlags } }\n  a0 <- getAllocationCounter\n  let\n    wsize = 100000\n    w = forM [wsize..(wsize+batches-1)] work\n  _x <- runHaxl env $ sum <$> w\n  a1 <- getAllocationCounter\n  let\n    lower = fromIntegral $ 1000000 * batches\n    upper = fromIntegral $ 25000000 * batches\n  assertBool \"threadAlloc lower bound\" $ (a0 - a1) > lower\n  assertBool \"threadAlloc upper bound\" $ (a0 - a1) < upper\n    -- the result was 16MB on 64-bit, or around 25KB if we miss the allocs\n    -- in the child thread. For batched it should be similarly scaled.\n    -- When we do not reset the counter for each batch was\n    -- scaled again by number of batches.\n\n  stats <- readIORef (statsRef env)\n  assertEqual\n    \"threadAlloc: batches\"\n    [fromIntegral batches]\n    (aggregateFetchBatches length stats)\n  -- if we actually do more than 1 batch then the above test is not useful\n\ndata MemoType = Global | Local\n\n-- Test that we correctly attribute memo work\nmemos:: MemoType -> Assertion\nmemos memoType = do\n  env <- mkProfilingEnv\n  let\n    memoAllocs = 10000000 :: Int64\n    doWork = unsafeLiftIO $ do\n      a0 <- getAllocationCounter\n      setAllocationCounter $ a0 - memoAllocs\n      return (5 :: Int)\n    mkWork\n      | Global <- memoType = return (memo (1 :: Int) doWork)\n      | Local <- memoType = memoize doWork\n  _ <- runHaxl env $ do\n    work <- mkWork\n    andThen\n      (withLabel \"do\" work)\n      (withLabel \"cached\" work)\n  profData <- labelToDataMap <$> readIORef (profRef env)\n  case HashMap.lookup \"do\" profData of\n    Nothing -> assertFailure \"do not in data\"\n    Just ProfileData{..} -> do\n      assertEqual \"has correct memo id\" profileMemos [ProfileMemo 1 False]\n      assertBool \"allocs are included in 'do'\" (profileAllocs >= memoAllocs)\n  case HashMap.lookup \"cached\" profData of\n    Nothing -> assertFailure \"cached not in data\"\n    Just ProfileData{..} -> do\n      assertEqual \"has correct memo id\" profileMemos [ProfileMemo 1 True]\n      assertBool \"allocs are *not* included in 'cached'\" (profileAllocs < 50000)\n  (Stats memoStats) <- readIORef (statsRef env)\n  assertEqual \"exactly 1 memo/fetch\" 1 (length memoStats)\n  let memoStat = head memoStats\n  putStrLn $ \"memoStat=\" ++ show memoStat\n  assertEqual \"correct call id\" 1 (memoStatId memoStat)\n  assertBool \"allocs are big enough\" $ memoSpace memoStat >= memoAllocs\n  assertBool \"allocs are not too big\" $ memoSpace memoStat < memoAllocs + 100000\n\n\ntests = TestList\n  [ TestLabel \"collectsdata\" $ TestCase collectsdata\n  , TestLabel \"collectsdata - lazy\" $ TestCase collectsLazyData\n  , TestLabel \"exceptions\" $ TestCase exceptions\n  , TestLabel \"threads\" $ TestCase (threadAlloc 1)\n  , TestLabel \"threads with batch\" $ TestCase (threadAlloc 50)\n  , TestLabel \"memos - Global\" $ TestCase (memos Global)\n  , TestLabel \"memos - Local\" $ TestCase (memos Local)\n  ]\n", "num_lines": 217}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE FlexibleInstances #-}\n\nmodule SleepDataSource (\n    Sleep, sleep,\n  ) where\n\nimport Haxl.Prelude\nimport Prelude ()\n\nimport Haxl.Core\nimport Haxl.DataSource.ConcurrentIO\n\nimport Control.Concurrent\nimport Data.Hashable\nimport Data.Typeable\n\nsleep :: Int -> GenHaxl u w Int\nsleep n = dataFetch (Sleep n)\n\ndata Sleep deriving Typeable\ninstance ConcurrentIO Sleep where\n  data ConcurrentIOReq Sleep a where\n    Sleep :: Int -> ConcurrentIOReq Sleep Int\n\n  performIO (Sleep n) = threadDelay (n*1000) >> return n\n\nderiving instance Eq (ConcurrentIOReq Sleep a)\nderiving instance Show (ConcurrentIOReq Sleep a)\n\ninstance ShowP (ConcurrentIOReq Sleep) where showp = show\n\ninstance Hashable (ConcurrentIOReq Sleep a) where\n  hashWithSalt s (Sleep n) = hashWithSalt s n\n", "num_lines": 47}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule StatsTests (tests) where\n\nimport Test.HUnit\nimport Data.List\nimport Data.Maybe\n\nimport Haxl.Prelude\nimport Haxl.Core\nimport Prelude()\n\nimport ExampleDataSource\nimport SleepDataSource\nimport Haxl.DataSource.ConcurrentIO\n\nimport Control.Monad (void)\nimport Data.IORef\nimport qualified Data.HashMap.Strict as HashMap\n\naggregateBatches :: Test\naggregateBatches = TestCase $ do\n  let\n    statsNoBatches = [ FetchStats { fetchDataSource = \"foo\"\n                                  , fetchBatchSize = 7\n                                  , fetchStart = 0\n                                  , fetchDuration = 10\n                                  , fetchSpace = 1\n                                  , fetchFailures = 2\n                                  , fetchIgnoredFailures = 0\n                                  , fetchBatchId = n\n                                  , fetchIds = [1,2] }\n                                  | n <- reverse [1..10] ++ [11..20] ]\n                     ++ [ FetchCall \"A\" [\"B\"] 1, FetchCall \"C\" [\"D\"] 2 ]\n    fetchBatch = [ FetchStats { fetchDataSource = \"batch\"\n                              , fetchBatchSize = 1\n                              , fetchStart = 100\n                              , fetchDuration = 1000 * n\n                              , fetchSpace = 3\n                              , fetchFailures = if n <= 3 then 1 else 0\n                              , fetchIgnoredFailures = 0\n                              , fetchBatchId = 123\n                              , fetchIds = [fromIntegral n] } | n <- [1..50] ]\n    agg (sz,bids) FetchStats{..} = (sz + fetchBatchSize, fetchBatchId:bids)\n    agg _ _ = error \"unexpected\"\n    agg' = foldl' agg (0,[])\n    aggNoBatch = aggregateFetchBatches agg' (Stats statsNoBatches)\n    expectedNoBatch = [(7, [n]) | n <- reverse [1..20] :: [Int]]\n    aggBatch = aggregateFetchBatches agg' (Stats fetchBatch)\n    expectedResultBatch = (50, [123 | _ <- [1..50] :: [Int]])\n    aggInterspersedBatch =\n      aggregateFetchBatches agg'\n      (Stats $ intersperse (head fetchBatch) statsNoBatches)\n    expectedResultInterspersed =\n      (21, [123 | _ <- [1..21] :: [Int]]) : expectedNoBatch\n  assertEqual \"No batch has no change\" expectedNoBatch aggNoBatch\n  assertEqual \"Batch is combined\" [expectedResultBatch] aggBatch\n  assertEqual\n    \"Grouping works as expected\" expectedResultInterspersed aggInterspersedBatch\n\ntestEnv :: IO (Env () ())\ntestEnv = do\n  -- To use a data source, we need to initialize its state:\n  exstate <- ExampleDataSource.initGlobalState\n  sleepState <- mkConcurrentIOState\n\n  -- And create a StateStore object containing the states we need:\n  let st = stateSet exstate (stateSet sleepState stateEmpty)\n\n  -- Create the Env:\n  env <- initEnv st ()\n  return env{ flags = (flags env){\n    report = setReportFlag ReportFetchStack profilingReportFlags } }\n\n\nfetchIdsSync :: Test\nfetchIdsSync = TestCase $ do\n  env <- testEnv\n  _ <- runHaxl  env $\n       sequence_\n       [ void $ countAardvarks \"abcabc\" + (length <$> listWombats 3)\n       , void $ listWombats 100\n       , void $ listWombats 99\n       , void $ countAardvarks \"BANG4\" `catch` \\NotFound{} -> return 123\n       ]\n  -- expect a single DS stat\n  (Stats stats) <- readIORef (statsRef env)\n  let\n    fetchStats = [x | x@FetchStats{} <- stats]\n  assertEqual \"Only 1 batch\" 1 (length fetchStats)\n  let\n    [stat] = fetchStats\n  assertEqual \"No real failures\" 0 (fetchFailures stat)\n  assertEqual \"1 ignored failure\" 1 (fetchIgnoredFailures stat)\n\nfetchIdsBackground :: Test\nfetchIdsBackground = TestCase $ do\n  env <- testEnv\n  _ <- runHaxl  env $\n       sequence_\n       [ withLabel \"short\" $ sleep 1\n       , withLabel \"long\" $ sleep 500 ]\n\n  -- make sure that with memo'ing we still preserve the stack\n  _ <- runHaxl  env $ withLabel \"base\"\n    (memo (1 :: Int) $ withLabel \"child\" $ sleep 102)\n\n  _ <- runHaxl env $ withLabel \"short_cached\" $ sleep 1\n\n  -- expect a single DS stat\n  (Stats stats) <- readIORef (statsRef env)\n  (Profile p pt _) <- readIORef (profRef env)\n  let\n    keyMap =\n      HashMap.fromList [ (label, k) | ((label,_), k) <- HashMap.toList pt]\n    revMap = HashMap.fromList [(v,k) | (k,v) <- HashMap.toList pt]\n    parentMap =\n      HashMap.fromList $\n      catMaybes\n      [ case HashMap.lookup kp revMap of\n          Just (lp,_) -> Just (label, lp)\n          Nothing -> Nothing\n      | ((label,kp), _) <- HashMap.toList pt]\n    fetchMap =  HashMap.fromList [ (fid, x) | x@FetchStats{} <- stats\n                                   , fid <- fetchIds x]\n    get l = [ (prof, wasCached, fetchStat)\n            | Just key <- [HashMap.lookup l keyMap]\n            , Just prof <- [HashMap.lookup key p]\n            , ProfileFetch fid _ wasCached <- profileFetches prof\n            , Just fetchStat <- [HashMap.lookup fid fetchMap]]\n    [(short, shortWC, shortFetch)] = get \"short\"\n    [(long, longWC, longFetch)] = get \"long\"\n    [(shortCached, shortCachedWC, shortCachedFetch)] = get \"short_cached\"\n\n  assertEqual \"3 batches\" 3 (HashMap.size fetchMap)\n  assertEqual \"6 labels (inc MAIN)\" 6 (HashMap.size keyMap)\n\n  assertEqual \"child parent is base\"\n    (Just \"base\")\n    (HashMap.lookup \"child\" parentMap)\n\n  assertEqual \"base parent is MAIN\"\n    (Just \"MAIN\")\n    (HashMap.lookup \"base\" parentMap)\n\n  assertEqual \"long parent is MAIN\"\n    (Just \"MAIN\")\n    (HashMap.lookup \"long\" parentMap)\n\n  assertBool \"original fetches not cached (short)\" (not shortWC)\n  assertBool \"original fetches not cached (long)\" (not longWC)\n  assertBool \"was cached short\" shortCachedWC\n\n  assertEqual \"one fetch short\" 1 (length $ profileFetches short)\n  assertEqual \"one fetch long\" 1 (length $ profileFetches long)\n  assertEqual \"one fetch short_cached\" 1 (length $ profileFetches shortCached)\n\n  assertBool \"short fetch mapped properly\" (fetchDuration shortFetch < 100000)\n  assertEqual\n    \"short cached fetch mapped properly\"\n    (fetchDuration shortFetch)\n    (fetchDuration shortCachedFetch)\n  assertBool \"long fetch was mapped properly\" (fetchDuration longFetch > 100000)\n\n\nppStatsTest :: Test\nppStatsTest = TestCase $ do\n  let\n    r = ppStats (Stats [])\n    mc = ppStats (Stats [MemoCall 0 0])\n    fc = ppStats (Stats [FetchCall \"\" [] 0])\n    fw = ppStats (Stats [FetchWait HashMap.empty 0 1])\n    fs = ppStats (Stats [FetchStats \"\" 0 0 0 0 0 0 0 []])\n  assertEqual \"empty stats -> empty string\" r \"\"\n  assertEqual \"memo call stats -> empty string\" mc \"\"\n  assertEqual \"fetch call stats -> empty string\" fc \"\"\n  assertBool \"fetch wait stats -> some data\" (not $ null fw)\n  assertBool \"fetch stats -> some data\" (not $ null fs)\n\n\ntests = TestList [ TestLabel \"Aggregate Batches\" aggregateBatches\n                 , TestLabel \"Fetch IDs Sync\" fetchIdsSync\n                 , TestLabel \"Fetch IDs Background\" fetchIdsBackground\n                 , TestLabel \"ppStats\" ppStatsTest ]\n", "num_lines": 193}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\nmodule TestBadDataSource (tests) where\n\nimport Haxl.Prelude as Haxl\nimport Prelude()\n\nimport Haxl.Core\n\nimport Data.IORef\nimport Test.HUnit\nimport Control.Exception\nimport System.Mem\n\nimport ExampleDataSource\nimport BadDataSource\n\ntestEnv impl fn = do\n  -- Use allocation limits, just to make sure haxl properly behaves and\n  -- doesn't reset this internally somewhere.\n  -- `go` will disable this\n  setAllocationCounter 5000000 -- 5 meg should be enough, uses ~100k atm\n  enableAllocationLimit\n  exstate <- ExampleDataSource.initGlobalState\n  badstate <- BadDataSource.initGlobalState impl\n  let st = stateSet exstate $ stateSet (fn badstate) stateEmpty\n  initEnv st ()\n\nwombats :: GenHaxl () () Int\nwombats = length <$> listWombats 3\n\nwombatsMany :: GenHaxl () () Int\nwombatsMany = length <$> listWombats 7\n\ngo :: FetchImpl -> Test\ngo impl = TestCase $ flip finally disableAllocationLimit $ do\n  -- test that a failed acquire doesn't fail the other requests\n  ref <- newIORef False\n  env <- testEnv impl $ \\st ->\n    st { failAcquire = throwIO (DataSourceError \"acquire\")\n       , failRelease = writeIORef ref True }\n\n  x <- runHaxl env $\n        (dataFetch (FailAfter 0) + wombatsMany)\n          `Haxl.catch` \\DataSourceError{} -> wombats\n\n  assertEqual \"badDataSourceTest1\" 3 x\n\n  -- We should *not* have called release\n  assertEqual \"badDataSourceTest2\" False =<< readIORef ref\n\n  -- test that a failed dispatch doesn't fail the other requests\n  ref <- newIORef False\n  env <- testEnv impl $ \\st ->\n    st { failDispatch = throwIO (DataSourceError \"dispatch\")\n       , failRelease = writeIORef ref True }\n\n  x <- runHaxl env $\n        (dataFetch (FailAfter 0) + wombatsMany)\n          `Haxl.catch` \\DataSourceError{} -> wombats\n\n  assertEqual \"badDataSourceTest3\" x 3\n\n  -- We *should* have called release\n  assertEqual \"badDataSourceTest4\" True =<< readIORef ref\n\n  -- test that a failed wait is a DataSourceError\n  env <- testEnv impl $ \\st ->\n    st { failWait = throwIO (DataSourceError \"wait\") }\n\n  x <- runHaxl env $\n        (dataFetch (FailAfter 0) + wombatsMany)\n          `Haxl.catch` \\DataSourceError{} -> wombats\n\n  assertEqual \"badDataSourceTest5\" x 3\n\n  -- We *should* have called release\n  assertEqual \"badDataSourceTest6\" True =<< readIORef ref\n\n  -- test that a failed release is still a DataSourceError, even\n  -- though the request will have completed successfully\n  env <- testEnv impl $ \\st ->\n    st { failRelease = throwIO (DataSourceError \"release\") }\n\n  let\n    -- In background fetches the scheduler might happen to process the data\n    -- source result (FetchError in this case) before it processes the exception\n    -- from release. So we have to allow both cases.\n    isBg = case impl of\n      Background -> True\n      BackgroundMVar -> True\n      _ -> False\n    releaseCatcher e\n      | Just DataSourceError{} <- fromException e = wombats\n      | Just FetchError{} <- fromException e =\n          if isBg then wombats else Haxl.throw e\n      | otherwise = Haxl.throw e\n\n  x <- runHaxl env $\n        (dataFetch (FailAfter 0) + wombatsMany)\n          `Haxl.catch` releaseCatcher\n\n  assertEqual \"badDataSourceTest7\" x 3\n\n  -- test that if we don't throw anything we get the result\n  -- (which is a fetch error for this source)\n  env <- testEnv impl id\n  x <- runHaxl env $\n        (dataFetch (FailAfter 0) + wombatsMany)\n          `Haxl.catch` \\FetchError{} -> wombats\n\n  assertEqual \"badDataSourceTest8\" x 3\n\n\n\n\ntests = TestList\n  [ TestLabel \"badDataSourceTest async\" (go Async)\n  , TestLabel \"badDataSourceTest background\" (go Background)\n  , TestLabel \"badDataSourceTest backgroundMVar\" (go BackgroundMVar)\n  , TestLabel \"badDataSourceTest backgroundFetchSeq\" (go BackgroundSeq)\n  , TestLabel \"badDataSourceTest backgroundFetchPar\" (go BackgroundPar)\n  ]\n", "num_lines": 129}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE CPP, OverloadedStrings, RebindableSyntax, MultiWayIf #-}\n{-# LANGUAGE RecordWildCards #-}\nmodule TestExampleDataSource (tests) where\n\nimport Haxl.Prelude as Haxl\nimport Prelude()\n\nimport Haxl.Core.Monad (unsafeLiftIO)\nimport Haxl.Core\n\nimport Test.HUnit\nimport Data.IORef\nimport Data.Maybe\nimport Control.Exception\nimport System.Environment\nimport System.FilePath\n\nimport ExampleDataSource\nimport LoadCache\n\ntestEnv :: IO (Env () ())\ntestEnv = do\n  -- To use a data source, we need to initialize its state:\n  exstate <- ExampleDataSource.initGlobalState\n\n  -- And create a StateStore object containing the states we need:\n  let st = stateSet exstate stateEmpty\n\n  -- Create the Env:\n  env <- initEnv st ()\n  return env{ flags = (flags env){\n    report = setReportFlag ReportFetchStats defaultReportFlags } }\n\n\ntests = TestList [\n  TestLabel \"exampleTest\" exampleTest,\n  TestLabel \"orderTest\" orderTest,\n  TestLabel \"preCacheTest\" preCacheTest,\n  TestLabel \"cachedComputationTest\" cachedComputationTest,\n  TestLabel \"cacheResultTest\" cacheResultTest,\n  TestLabel \"memoTest\" memoTest,\n  TestLabel \"dataSourceExceptionTest\" dataSourceExceptionTest,\n  TestLabel \"dumpCacheAsHaskell\" dumpCacheTest,\n  TestLabel \"fetchError\" fetchError\n  ]\n\n-- Let's test ExampleDataSource.\n\nexampleTest :: Test\nexampleTest = TestCase $ do\n  env <- testEnv\n\n  -- Run an example expression with two fetches:\n  x <- runHaxl env $\n     countAardvarks \"abcabc\" + (length <$> listWombats 3)\n\n  assertEqual \"runTests\" x (2 + 3)\n\n  -- Should be just one fetching round:\n  Stats stats <- readIORef (statsRef env)\n  putStrLn (ppStats (Stats stats))\n  assertEqual \"rounds\" 1 (length stats)\n\n  -- With two fetches:\n  assertBool \"reqs\" $\n    case stats of\n       [FetchStats{..}] ->\n         fetchDataSource == \"ExampleDataSource\" && fetchBatchSize == 2\n       _otherwise -> False\n\n-- Test side-effect ordering\n\norderTest = TestCase $ do\n  env <- testEnv\n\n  ref <- newIORef ([] :: [Int])\n\n  let tick n = unsafeLiftIO (modifyIORef ref (n:))\n\n  let left = do tick 1\n                r <- countAardvarks \"abcabc\"\n                tick 2\n                return r\n\n  let right = do tick 3\n                 r <- length <$> listWombats 3\n                 tick 4\n                 return r\n\n  x <- runHaxl env $ left + right\n  assertEqual \"TestExampleDataSource2\" x (2 + 3)\n\n  -- The order of the side effects is 1,3,2,4.  First we see 1, then\n  -- left gets blocked, then we explore right, we see 3, then right\n  -- gets blocked.  The data fetches are performed, then we see 2 and\n  -- then 4.\n\n  ys <- readIORef ref\n  assertEqual \"TestExampleDataSource: ordering\" (reverse ys) [1,3,2,4]\n\n\npreCacheTest = TestCase $ do\n  env <- testEnv\n\n  x <- runHaxl env $ do\n    cacheRequest (CountAardvarks \"xxx\") (Right 3)\n    cacheRequest (ListWombats 1000000) (Right [1,2,3])\n    countAardvarks \"xxx\" + (length <$> listWombats 1000000)\n  assertEqual \"preCacheTest1\" x (3 + 3)\n\n  y <- Control.Exception.try $ runHaxl env $ do\n    cacheRequest (CountAardvarks \"yyy\") $ except (NotFound \"yyy\")\n    countAardvarks \"yyy\"\n  assertBool \"preCacheTest2\" $\n     case y of\n       Left (NotFound \"yyy\") -> True\n       _other -> False\n\n-- Pretend CountAardvarks is a request computed by some Haxl code\ncachedComputationTest = TestCase $ do\n  env <- testEnv\n  let env' = env { flags = (flags env){trace = 3} }\n\n  let x = cachedComputation (CountAardvarks \"ababa\") $ do\n        a <- length <$> listWombats 10\n        b <- length <$> listWombats 20\n        return (a + b)\n\n  r <- runHaxl env' $ x + x + countAardvarks \"baba\"\n\n  assertEqual \"cachedComputationTest1\" 62 r\n\n  stats <- readIORef (statsRef env)\n  assertEqual \"fetches\" 3 (numFetches stats)\n\ncacheResultTest = TestCase $ do\n  env <- testEnv\n  ref <- newIORef 0\n  let request = cacheResult (CountAardvarks \"ababa\") $ do\n         modifyIORef ref (+1)\n         readIORef ref\n  r <- runHaxl env $ (+) <$> request <*> request\n  assertEqual \"cacheResult\" 2 r\n\n\n-- Pretend CountAardvarks is a request computed by some Haxl code\nmemoTest = TestCase $ do\n  env <- testEnv\n  let env' = env { flags = (flags env){trace = 3} }\n\n  let x = memo (CountAardvarks \"ababa\") $ do\n        a <- length <$> listWombats 10\n        b <- length <$> listWombats 20\n        return (a + b)\n\n  r <- runHaxl env' $ x + x + countAardvarks \"baba\"\n\n  assertEqual \"memoTest1\" 62 r\n\n  stats <- readIORef (statsRef env)\n  assertEqual \"fetches\" 3 (numFetches stats)\n\n-- Test that the FetchError gets returned properly, and that we have\n-- a failure logged in the stats.\nfetchError = TestCase $ do\n  env <- testEnv\n  r <- runHaxl env $ Haxl.try $\n    (++) <$> listWombats 1000000 <*> listWombats 1000001\n  assertBool \"fetchError1\" $ case r of\n    Left FetchError{} -> True\n    Right _ -> False\n  Stats stats <- readIORef (statsRef env)\n  assertEqual \"fetchError2\" 2 (sum [ fetchFailures | FetchStats{..} <- stats ])\n\ndataSourceExceptionTest = TestCase $ do\n  env <- testEnv\n\n  r <- runHaxl env $ Haxl.try $ countAardvarks \"BANG\"\n  assertBool \"exception1\" $\n    case r of\n      Left (ErrorCall \"BANG\") -> True\n      _ -> False\n  r <- runHaxl env $ Haxl.try $ countAardvarks \"BANG2\"\n  assertBool \"exception2\" $\n    case r of\n      Left (ErrorCall \"BANG2\") -> True\n      _ -> False\n\n  -- In this test, BANG3 is an asynchronous exception (ThreadKilled),\n  -- so we should see that instead of the exception on the left.\n  -- Furthermore, it doesn't get caught by Haxl.try, and we have to\n  -- catch it outside of runHaxl.\n  env <- testEnv\n  r <- Control.Exception.try $ runHaxl env $ Haxl.try $\n          (length <$> listWombats 100) + countAardvarks \"BANG3\"\n  print r\n  assertBool \"exception3\" $\n    case (r :: Either AsyncException (Either SomeException Int)) of\n       Left ThreadKilled -> True\n       _ -> False\n\n-- Test that we can load the cache from a dumped copy of it, and then dump it\n-- again to get the same result.\ndumpCacheTest = TestCase $ do\n  env <- testEnv\n  runHaxl env loadCache\n  str <- runHaxl env dumpCacheAsHaskell\n  lcPath <-loadCachePath\n  loadcache <- readFile lcPath\n  -- The order of 'cacheRequest ...' calls is nondeterministic and\n  -- differs among GHC versions, so we sort the lines for comparison.\n  assertEqual \"dumpCacheAsHaskell\" (sort $ lines loadcache) (sort $ lines str)\n  where\n    loadCachePath = do\n      lcEnv <- lookupEnv \"LOADCACHE\"\n      return $ fromMaybe (dropFileName __FILE__ </> \"LoadCache.txt\") lcEnv\n", "num_lines": 223}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE CPP, OverloadedStrings #-}\nmodule Main where\n\nimport Test.Framework (defaultMain)\nimport Test.Framework.Providers.HUnit (hUnitTestToTests)\nimport AllTests\n\nmain :: IO ()\nmain = defaultMain $ hUnitTestToTests allTests\n", "num_lines": 16}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE CPP #-}\n\nmodule TestTypes\n   ( UserEnv\n   , Haxl\n   , HaxlEnv\n   , lookupInput\n   , Id(..)\n   ) where\n\nimport Data.Aeson\nimport Data.Binary (Binary)\nimport qualified Data.Text as Text\n#if MIN_VERSION_aeson(2,0,0)\nimport qualified Data.Aeson.KeyMap as KeyMap\nimport Data.Aeson.Key (toText)\n#else\nimport qualified Data.HashMap.Strict as KeyMap\n#endif\nimport Data.Hashable\nimport Data.Typeable\n\nimport Haxl.Core\n\n#if !MIN_VERSION_aeson(2,0,0)\ntype Key = Text.Text\n\ntoText :: Key -> Text.Text\ntoText = id\n#endif\n\ntype UserEnv = Object\ntype Haxl a = GenHaxl UserEnv () a\ntype HaxlEnv = Env UserEnv ()\n\nlookupInput :: FromJSON a => Key -> Haxl a\nlookupInput field = do\n  mb_val <- env (KeyMap.lookup field . userEnv)\n  case mb_val of\n    Nothing ->\n      throw (NotFound (Text.concat [\"field \", toText field, \" was not found.\"]))\n    Just val ->\n      case fromJSON val of\n        Error str ->\n          throw (UnexpectedType (Text.concat\n            [\"field \", toText field, \": \", Text.pack str]))\n        Success a -> return a\n\n\nnewtype Id = Id Int\n  deriving (Eq, Ord, Binary, Enum, Num, Integral, Real, Hashable, Typeable,\n            ToJSON, FromJSON)\n\ninstance Show Id where\n  show (Id i) = show i\n", "num_lines": 65}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE CPP #-}\nmodule TestUtils\n  ( makeTestEnv\n  , expectResultWithEnv\n  , expectResult\n  , expectFetches\n  , testinput\n  , id1, id2, id3, id4\n  ) where\n\nimport TestTypes\nimport MockTAO\nimport Haxl.DataSource.ConcurrentIO\n\nimport Data.IORef\nimport Data.Aeson\nimport Test.HUnit\n#if MIN_VERSION_aeson(2,0,0)\nimport qualified Data.Aeson.KeyMap as KeyMap\n#else\nimport qualified Data.HashMap.Strict as KeyMap\n#endif\n\nimport Haxl.Core\n\nimport Prelude()\nimport Haxl.Prelude\n\ntestinput :: Object\ntestinput = KeyMap.fromList [\n  \"A\" .= (1 :: Int),\n  \"B\" .= (2 :: Int),\n  \"C\" .= (3 :: Int),\n  \"D\" .= (4 :: Int) ]\n\nid1 :: Haxl Id\nid1 = lookupInput \"A\"\n\nid2 :: Haxl Id\nid2 = lookupInput \"B\"\n\nid3 :: Haxl Id\nid3 = lookupInput \"C\"\n\nid4 :: Haxl Id\nid4 = lookupInput \"D\"\n\nmakeTestEnv :: Bool -> IO HaxlEnv\nmakeTestEnv future = do\n  tao <- MockTAO.initGlobalState future\n  stio <- mkConcurrentIOState\n  let st = stateSet stio $ stateSet tao stateEmpty\n  env <- initEnv st testinput\n  return env { flags = (flags env) {\n    report = setReportFlag ReportFetchStats defaultReportFlags } }\n\nexpectResultWithEnv\n  :: (Eq a, Show a) => a -> Haxl a -> HaxlEnv -> Assertion\nexpectResultWithEnv result haxl env = do\n  a <- runHaxl env haxl\n  assertEqual \"result\" result a\n\nexpectResult :: (Eq a, Show a) => a -> Haxl a -> Bool -> Assertion\nexpectResult result haxl future = do\n  env <- makeTestEnv future\n  expectResultWithEnv result haxl env\n\nexpectFetches :: (Eq a, Show a) => Int -> Haxl a -> Bool -> Assertion\nexpectFetches n haxl future = do\n  env <- makeTestEnv future\n  _ <- runHaxl env haxl\n  stats <- readIORef (statsRef env)\n  assertEqual \"fetches\" n (numFetches stats)\n", "num_lines": 81}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE OverloadedStrings #-}\n\nmodule WorkDataSource (\n    mkWorkState,\n    work,\n  ) where\n\nimport Haxl.Prelude\nimport Prelude ()\n\nimport Haxl.Core\n\nimport Control.Exception\nimport Data.Hashable\nimport Data.Typeable\nimport Control.Monad (void)\nimport Control.Concurrent.MVar\n\n\ndata Work a where\n  Work :: Integer -> Work Integer\n  deriving Typeable\n\nderiving instance Eq (Work a)\nderiving instance Show (Work a)\ninstance ShowP Work where showp = show\n\ninstance Hashable (Work a) where\n   hashWithSalt s (Work a) = hashWithSalt s (0::Int,a)\n\ninstance DataSourceName Work where\n  dataSourceName _ = \"Work\"\n\ninstance StateKey Work where\n  data State Work = WorkState\n\nnewtype Service = Service (MVar [IO ()])\n\nrun :: Work a -> IO a\nrun (Work n) = evaluate (sum [1..n]) >> return n\n\nmkService :: IO Service\nmkService = Service <$> newMVar []\n\nprocess :: Service -> IO ()\nprocess (Service q) = do\n  r <- swapMVar q []\n  sequence_ r\n\nenqueue :: Service -> Work a -> IO (IO (Either SomeException a))\nenqueue (Service q) w = do\n  res <- newEmptyMVar\n  let r = do\n        v <- Control.Exception.try $ run w\n        putMVar res v\n  modifyMVar_ q (return . (:) r)\n  return (takeMVar res)\n\ninstance DataSource u Work where\n  fetch = backgroundFetchAcquireReleaseMVar\n    mkService\n    (\\_ -> return ())\n    -- pretend we are ready so that process does the work\n    (\\_ _ m -> void $ tryPutMVar m ())\n    process\n    enqueue\n\n\nmkWorkState :: State Work\nmkWorkState = WorkState\n\nwork :: Integer -> GenHaxl u w Integer\nwork n = dataFetch (Work n)\n", "num_lines": 86}
{"repo_name": "Haxl", "repo_creator": "facebook", "programming_language": "Haskell", "code": "-- Copyright (c) 2014-present, Facebook, Inc.\n-- All rights reserved.\n--\n-- This source code is distributed under the terms of a BSD license,\n-- found in the LICENSE file.\n\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE StandaloneDeriving #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule WriteTests (tests) where\n\nimport Test.HUnit\n\nimport Control.Arrow\nimport Control.Concurrent\nimport Data.Either\nimport Data.Foldable\nimport Data.Hashable\nimport Data.IORef\nimport qualified Data.Text as Text\n\nimport Haxl.Core.Monad (mapWrites, mapWriteTree, flattenWT, WriteTree)\nimport Haxl.Core\nimport Haxl.Prelude as Haxl\n\n-- A fake data source\ndata SimpleDataSource a where\n  GetNumber :: SimpleDataSource Int\n\nderiving instance Eq (SimpleDataSource a)\nderiving instance Show (SimpleDataSource a)\ninstance ShowP SimpleDataSource where showp = show\n\ninstance Hashable (SimpleDataSource a) where\n  hashWithSalt s GetNumber = hashWithSalt s (0 :: Int)\n\ninstance StateKey SimpleDataSource where\n  data State SimpleDataSource = DSState\n\ninstance DataSourceName SimpleDataSource where\n  dataSourceName _ = \"SimpleDataSource\"\n\ninstance DataSource u SimpleDataSource where\n  fetch _st _flags _usr  = SyncFetch $ Haxl.mapM_ fetch1\n    where\n    fetch1 :: BlockedFetch SimpleDataSource -> IO ()\n    fetch1 (BlockedFetch GetNumber m) =\n      threadDelay 1000 >> putSuccess m 37\n\nnewtype SimpleWrite = SimpleWrite Text\n  deriving (Eq, Show, Ord)\n\nassertEqualIgnoreOrder ::\n  (Eq a, Show a, Ord a) => String -> [a] -> [a] -> Assertion\nassertEqualIgnoreOrder msg lhs rhs =\n  assertEqual msg (sort lhs) (sort rhs)\n\ndoInnerWrite :: GenHaxl u (WriteTree SimpleWrite) Int\ndoInnerWrite = do\n  tellWrite $ SimpleWrite \"inner\"\n  return 0\n\ndoOuterWrite :: GenHaxl u (WriteTree SimpleWrite) Int\ndoOuterWrite = do\n  tellWrite $ SimpleWrite \"outer1\"\n\n  doWriteMemo <- newMemoWith doInnerWrite\n  let doMemoizedWrite = runMemo doWriteMemo\n  _ <- doMemoizedWrite\n  _ <- doMemoizedWrite\n\n  tellWrite $ SimpleWrite \"outer2\"\n\n  return 1\n\ndoNonMemoWrites :: GenHaxl u (WriteTree SimpleWrite) Int\ndoNonMemoWrites = do\n  tellWrite $ SimpleWrite \"inner\"\n  tellWriteNoMemo $ SimpleWrite \"inner not memo\"\n  return 0\n\nrunHaxlWithWriteList :: Env u (WriteTree w) -> GenHaxl u (WriteTree w) a -> IO (a, [w])\nrunHaxlWithWriteList env haxl = second flattenWT <$> runHaxlWithWrites env haxl\n\nwriteSoundness :: Test\nwriteSoundness = TestCase $ do\n  let numReps = 4\n\n  -- do writes without memoization\n  env1 <- emptyEnv ()\n  (allRes, allWrites) <- runHaxlWithWriteList env1 $\n    Haxl.sequence (replicate numReps doInnerWrite)\n\n  assertBool \"Write Soundness 1\" $\n    allWrites == replicate numReps (SimpleWrite \"inner\")\n  assertBool \"Write Soundness 2\" $ allRes == replicate numReps 0\n\n  -- do writes with memoization\n  env2 <- emptyEnv ()\n\n  (memoRes, memoWrites) <- runHaxlWithWriteList env2 $ do\n    doWriteMemo <- newMemoWith doInnerWrite\n    let memoizedWrite = runMemo doWriteMemo\n\n    Haxl.sequence (replicate numReps memoizedWrite)\n\n  assertBool \"Write Soundness 3\" $\n    memoWrites == replicate numReps (SimpleWrite \"inner\")\n  assertBool \"Write Soundness 4\" $ memoRes == replicate numReps 0\n\n  -- do writes with interleaved memo\n  env3 <- emptyEnv ()\n\n  (ilRes, ilWrites) <- runHaxlWithWriteList env3 $ do\n    doWriteMemo <- newMemoWith doInnerWrite\n    let memoizedWrite = runMemo doWriteMemo\n\n    Haxl.sequence $ replicate numReps (doInnerWrite *> memoizedWrite)\n\n  assertBool \"Write Soundness 5\" $\n    ilWrites == replicate (2*numReps) (SimpleWrite \"inner\")\n  assertBool \"Write Soundness 6\" $ ilRes == replicate numReps 0\n\n  -- do writes with nested memo\n  env4 <- emptyEnv ()\n\n  (nestRes, nestWrites) <- runHaxlWithWriteList env4 $ do\n    doWriteMemo' <- newMemoWith doOuterWrite\n    let memoizedWrite' = runMemo doWriteMemo'\n\n    Haxl.sequence (replicate numReps memoizedWrite')\n\n  let expWrites =\n        [ SimpleWrite \"outer1\"\n        , SimpleWrite \"inner\"\n        , SimpleWrite \"inner\"\n        , SimpleWrite \"outer2\"\n        ]\n  assertBool \"Write Soundness 7\" $\n    nestWrites == fold (replicate numReps expWrites)\n  assertBool \"Write Soundness 8\" $ nestRes == replicate numReps 1\n\n  -- do both kinds of writes without memoization\n  env5 <- emptyEnv ()\n  (allRes, allWrites) <- runHaxlWithWriteList env5 $\n    Haxl.sequence (replicate numReps doNonMemoWrites)\n\n  assertBool \"Write Soundness 9\" $\n    allWrites == replicate numReps (SimpleWrite \"inner\") ++\n      replicate numReps (SimpleWrite \"inner not memo\")\n  assertBool \"Write Soundness 10\" $ allRes == replicate numReps 0\n\n  -- do both kinds of writes with memoization\n  env6 <- emptyEnv ()\n\n  (memoRes, memoWrites) <- runHaxlWithWriteList env6 $ do\n    doWriteMemo <- newMemoWith doNonMemoWrites\n    let memoizedWrite = runMemo doWriteMemo\n\n    Haxl.sequence (replicate numReps memoizedWrite)\n\n  -- \"inner not memo\" only appears once in this test\n  assertBool \"Write Soundness 11\" $\n    memoWrites == replicate numReps (SimpleWrite \"inner\") ++\n      [SimpleWrite \"inner not memo\"]\n  assertBool \"Write Soundness 12\" $ memoRes == replicate numReps 0\n\nwriteLogsCorrectnessTest :: Test\nwriteLogsCorrectnessTest = TestLabel \"writeLogs_correctness\" $ TestCase $ do\n  e <- emptyEnv ()\n  (_ , wrts) <- runHaxlWithWriteList e doNonMemoWrites\n  assertEqualIgnoreOrder \"Expected writes\" [SimpleWrite \"inner\",\n    SimpleWrite \"inner not memo\"] wrts\n  wrtsNoMemo <- readIORef $ writeLogsRefNoMemo e\n  wrtsMemo <- readIORef $ writeLogsRef e\n  assertEqualIgnoreOrder \"WriteTree not empty\" [] $ flattenWT wrtsNoMemo\n  assertEqualIgnoreOrder \"WriteTree not empty\" [] $ flattenWT wrtsMemo\n\nmapWritesTest :: Test\nmapWritesTest = TestLabel \"mapWrites\" $ TestCase $ do\n  let funcSingle (SimpleWrite s) = SimpleWrite $ Text.toUpper s\n      func = mapWriteTree funcSingle\n  env0 <- emptyEnv ()\n  (res0, wrts0) <- runHaxlWithWriteList env0 $ mapWrites func doNonMemoWrites\n  assertEqual \"Expected computation result\" 0 res0\n  assertEqualIgnoreOrder \"Writes correctly transformed\" [SimpleWrite \"INNER\",\n    SimpleWrite \"INNER NOT MEMO\"] wrts0\n\n  -- Writes should behave the same inside and outside mapWrites\n  env1 <- emptyEnv ()\n  (res1, wrts1) <- runHaxlWithWriteList env1 $ do\n    outer <- doOuterWrite\n    outerMapped <- mapWrites func doOuterWrite\n    return $ outer == outerMapped\n  assertBool \"Results are identical\" res1\n  assertEqualIgnoreOrder\n    \"Writes correctly transformed, non-transformed writes preserved\"\n    [ SimpleWrite \"outer1\", SimpleWrite \"inner\"\n    , SimpleWrite \"inner\", SimpleWrite \"outer2\"\n    , SimpleWrite \"OUTER1\", SimpleWrite \"INNER\"\n    , SimpleWrite \"INNER\", SimpleWrite \"OUTER2\"\n    ]\n    wrts1\n\n  -- Memoization behaviour should be unaffected\n  env2 <- emptyEnv ()\n  (_res2, wrts2) <- runHaxlWithWriteList env2 $ do\n    writeMemo <- newMemoWith doNonMemoWrites\n    let doWriteMemo = runMemo writeMemo\n    _ <- mapWrites func doWriteMemo\n    _ <- doWriteMemo\n    return ()\n  -- \"inner not memo\" should appear only once\n  assertEqualIgnoreOrder\n    \"Write correctly transformed under memoization\"\n    [ SimpleWrite \"INNER\"\n    , SimpleWrite \"inner\"\n    , SimpleWrite \"INNER NOT MEMO\"\n    ]\n    wrts2\n\n  -- Same as previous, but the non-mapped computation is run first\n  env3 <- emptyEnv ()\n  (_res3, wrts3) <- runHaxlWithWriteList env3 $ do\n    writeMemo <- newMemoWith doNonMemoWrites\n    let doWriteMemo = runMemo writeMemo\n    _ <- doWriteMemo\n    _ <- mapWrites func doWriteMemo\n    return ()\n  -- \"inner not memo\" should appear only once\n  assertEqualIgnoreOrder\n    \"Flipped: Write correctly transformed under memoization\"\n    [ SimpleWrite \"inner\"\n    , SimpleWrite \"INNER\"\n    , SimpleWrite \"inner not memo\"\n    ]\n    wrts3\n\n  -- inner computation performs no writes\n  env4 <- emptyEnv ()\n  (res4, wrts4) <- runHaxlWithWriteList env4 $\n    mapWrites func (return (0 :: Int))\n  assertEqual \"No Writes: Expected computation result\" 0 res4\n  assertEqualIgnoreOrder \"No writes\" [] wrts4\n\n  -- inner computation throws an exception\n  env5 <- emptyEnv ()\n  (res5, wrts5) <- runHaxlWithWriteList env5 $ mapWrites func $ try $ do\n    _ <- doNonMemoWrites\n    _ <- throw (NotFound \"exception\")\n    return 0\n  assertBool \"Throw: Expected Computation Result\" $ isLeft\n    (res5 :: Either HaxlException Int)\n  assertEqualIgnoreOrder\n    \"Datasource writes correctly transformed\"\n    [ SimpleWrite \"INNER\"\n    , SimpleWrite \"INNER NOT MEMO\"\n    ]\n    wrts5\n\n  -- inner computation calls a datasource\n  env6 <- initEnv (stateSet DSState stateEmpty) ()\n  (res6, wrts6) <- runHaxlWithWriteList env6 $ mapWrites func $ do\n    _ <- doNonMemoWrites\n    dataFetch GetNumber\n\n  assertEqual \"Datasource: Expected Computation Result\" 37 res6\n  assertEqualIgnoreOrder\n    \"Datasource writes correctly transformed\"\n    [ SimpleWrite \"INNER\"\n    , SimpleWrite \"INNER NOT MEMO\"\n    ]\n    wrts6\n\n  -- inner computation calls a datasource, flipped calls\n  env7 <- initEnv (stateSet DSState stateEmpty) ()\n  (res7, wrts7) <- runHaxlWithWriteList env7 $ mapWrites func $ do\n    df <- dataFetch GetNumber\n    _ <- doNonMemoWrites\n    return df\n\n  assertEqual \"Flipped Datasource: Expected Computation Result\" 37 res7\n  assertEqualIgnoreOrder\n    \"Flipped: Datasource writes correctly transformed\"\n    [ SimpleWrite \"INNER\"\n    , SimpleWrite \"INNER NOT MEMO\"\n    ]\n    wrts7\n\ntests = TestList\n  [ TestLabel \"Write Soundness\" writeSoundness,\n    TestLabel \"writeLogs_correctness\" writeLogsCorrectnessTest,\n    TestLabel \"mapWrites\" mapWritesTest\n  ]\n", "num_lines": 299}
{"repo_name": "gym-http-api", "repo_creator": "openai", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "gym-http-api", "repo_creator": "openai", "programming_language": "Haskell", "code": "-------------------------------------------------------------------------------\n-- |\n-- Module    :  Main\n-- License   :  MIT\n-- Stability :  experimental\n-- Portability: non-portable\n--\n-- Example of how to build an agent using OpenAI.Gym.Client\n-------------------------------------------------------------------------------\n{-# LANGUAGE NamedFieldPuns #-}\nmodule Main where\n\nimport Prelude\nimport Control.Monad (replicateM_, when)\nimport Control.Monad.Catch\nimport Control.Exception.Base\n\nimport OpenAI.Gym\nimport Servant.Client\nimport Network.HTTP.Client\n\n\nmain :: IO ()\nmain = do\n  manager <- newManager defaultManagerSettings\n  out <- runClientM example (ClientEnv manager url)\n  case out of\n    Left err -> print err\n    Right ok -> print ok\n\n  where\n    url :: BaseUrl\n    url = BaseUrl Http \"localhost\" 5000 \"\"\n\n\nexample :: ClientM ()\nexample = do\n  inst <- envCreate CartPoleV0\n  Monitor{directory} <- withMonitor inst $\n    replicateM_ episodeCount (agent inst)\n\n  -- Upload to the scoreboard.\n  -- TODO: Implement environment variable support.\n  upload (Config directory \"algo\" \"\")\n\n  where\n    episodeCount :: Int\n    episodeCount = 100\n\n\nagent :: InstID -> ClientM ()\nagent inst = do\n  envReset inst\n  go 0 False\n  where\n    maxSteps :: Int\n    maxSteps = 200\n\n    reward :: Int\n    reward = 0\n\n    go :: Int -> Bool -> ClientM ()\n    go x done = do\n      Action a <- envActionSpaceSample inst\n      Outcome ob reward done _ <- envStep inst (Step a True)\n      when (not done && x < 200) $ go (x + 1) done\n\n\nwithMonitor :: InstID -> ClientM () -> ClientM Monitor\nwithMonitor inst agent = do\n  envMonitorStart inst configs\n  agent\n  envMonitorClose inst\n  return configs\n  where\n    configs :: Monitor\n    configs = Monitor \"/tmp/random-agent-results\" True False False\n\n\n\n", "num_lines": 81}
{"repo_name": "gym-http-api", "repo_creator": "openai", "programming_language": "Haskell", "code": "-- * reexports\nmodule OpenAI.Gym\n  ( module X\n  ) where\n\nimport OpenAI.Gym.API as X\nimport OpenAI.Gym.Data as X\n\n", "num_lines": 9}
{"repo_name": "gym-http-api", "repo_creator": "openai", "programming_language": "Haskell", "code": "-------------------------------------------------------------------------------\n-- |\n-- Module    :  OpenAI.Gym.API\n-- License   :  MIT\n-- Stability :  experimental\n-- Portability: non-portable\n-------------------------------------------------------------------------------\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE TypeOperators #-}\nmodule OpenAI.Gym.API where\n\nimport OpenAI.Gym.Prelude\nimport OpenAI.Gym.Data\n\ntype GymAPI\n  = \"v1\" :> ( \"envs\" :> ( ReqBody '[JSON] GymEnv :> Post '[JSON] InstID\n                     :<|> Get '[JSON] Environment\n                     :<|> Capture \"instance_id\" InstID :> \"reset\" :> Post '[JSON] Observation\n                     :<|> Capture \"instance_id\" InstID :> \"step\"  :> ReqBody '[JSON] Step :> Post '[JSON] Outcome\n                     :<|> Capture \"instance_id\" InstID :> \"action_space\" :> Get '[JSON] Info\n                     :<|> Capture \"instance_id\" InstID :> \"action_space\" :> \"sample\"   :> Get '[JSON] Action\n                     :<|> Capture \"instance_id\" InstID :> \"action_space\" :> \"contains\" :> Capture \"x\" Int :> Get '[JSON] Object\n                     :<|> Capture \"instance_id\" InstID :> \"observation_space\"  :> Get '[JSON] Info\n                     :<|> Capture \"instance_id\" InstID :> \"monitor\" :> \"start\" :> ReqBody '[JSON] Monitor :> Post '[HTML] ()\n                     :<|> Capture \"instance_id\" InstID :> \"monitor\" :> \"close\" :> Post '[HTML] ()\n                     :<|> Capture \"instance_id\" InstID :> \"close\"   :> Post '[HTML] ())\n         :<|> \"upload\" :> ReqBody '[JSON] Config :> Post '[HTML] ()\n         :<|> \"shutdown\" :> Post '[HTML] ())\n\n\ngymAPI :: Proxy GymAPI\ngymAPI = Proxy\n\n\nenvCreate               :: GymEnv  -> ClientM InstID\nenvListAll              :: ClientM Environment\nenvReset                :: InstID  -> ClientM Observation\nenvStep                 :: InstID  -> Step    -> ClientM Outcome\nenvActionSpaceInfo      :: InstID  -> ClientM Info\nenvActionSpaceSample    :: InstID  -> ClientM Action\nenvActionSpaceContains  :: InstID  -> Int     -> ClientM Object\nenvObservationSpaceInfo :: InstID  -> ClientM Info\nenvMonitorStart         :: InstID  -> Monitor -> ClientM ()\nenvMonitorClose         :: InstID  -> ClientM ()\nenvClose                :: InstID  -> ClientM ()\nupload                  :: Config  -> ClientM ()\nshutdownServer          :: ClientM ()\n\n\n(envCreate\n  :<|> envListAll\n  :<|> envReset\n  :<|> envStep\n  :<|> envActionSpaceInfo\n  :<|> envActionSpaceSample\n  :<|> envActionSpaceContains\n  :<|> envObservationSpaceInfo\n  :<|> envMonitorStart\n  :<|> envMonitorClose\n  :<|> envClose)\n  :<|> upload\n  :<|> shutdownServer\n  = client gymAPI\n\n\n", "num_lines": 66}
{"repo_name": "gym-http-api", "repo_creator": "openai", "programming_language": "Haskell", "code": "-------------------------------------------------------------------------------\n-- |\n-- Module    :  OpenAI.Gym.Data\n-- License   :  MIT\n-- Stability :  experimental\n-- Portability: non-portable\n-------------------------------------------------------------------------------\n{-# LANGUAGE DeriveGeneric #-}\nmodule OpenAI.Gym.Data\n  ( GymEnv (..)\n  , InstID (..)\n  , Environment (..)\n  , Observation (..)\n  , Step (..)\n  , Outcome (..)\n  , Info (..)\n  , Action (..)\n  , Monitor (..)\n  , Config (..)\n  ) where\n\nimport OpenAI.Gym.Prelude\nimport qualified Data.Text  as T\nimport qualified Data.Aeson as A\n\ndata GymEnv\n  -- | Classic Control Environments\n  = CartPoleV0               -- ^ Balance a pole on a cart (for a short time).\n  | CartPoleV1               -- ^ Balance a pole on a cart.\n  | AcrobotV1                -- ^ Swing up a two-link robot.\n  | MountainCarV0            -- ^ Drive up a big hill.\n  | MountainCarContinuousV0  -- ^ Drive up a big hill with continuous control.\n  | PendulumV0               -- ^ Swing up a pendulum.\n\n  -- Toy text games\n  | FrozenLakeV0             -- ^ Swing up a pendulum.\n\n  -- | Atari Games\n  | PongRamV0                -- ^ Maximize score in the game Pong, with RAM as input\n  | PongV0                   -- ^ Maximize score in the game Pong\n  deriving (Eq, Enum, Ord)\n\n\ninstance Show GymEnv where\n  show CartPoleV0              = \"CartPole-v0\"\n  show CartPoleV1              = \"CartPole-v1\"\n  show AcrobotV1               = \"Acrobot-v1\"\n  show MountainCarV0           = \"MountainCar-v0\"\n  show MountainCarContinuousV0 = \"MountainCarContinuous-v0\"\n  show PendulumV0              = \"Pendulum-v0\"\n  show FrozenLakeV0            = \"FrozenLake-v0\"\n  show PongRamV0               = \"Pong-ram-v0\"\n  show PongV0                  = \"Pong-v0\"\n\ninstance ToJSON GymEnv where\n  toJSON env = object [ \"env_id\" .= show env ]\n\n\ndata InstID = InstID !Text\n  deriving (Eq, Show, Generic)\n\ninstance ToHttpApiData InstID where\n  toUrlPiece (InstID i) = i\n\ninstance ToJSON InstID where\n  toJSON (InstID i) = toSingleton \"instance_id\" i\n\ninstance FromJSON InstID where\n  parseJSON = parseSingleton InstID \"instance_id\"\n\n\nnewtype Environment = Environment { all_envs :: HashMap Text Text }\n  deriving (Eq, Show, Generic)\n\ninstance ToJSON Environment\ninstance FromJSON Environment\n\n\ndata Observation = Observation !Value\n  deriving (Eq, Show, Generic)\n\ninstance ToJSON Observation where\n  toJSON (Observation v) = toSingleton \"observation\" v\n\ninstance FromJSON Observation where\n  parseJSON = parseSingleton Observation \"observation\"\n\n\ndata Step = Step\n  { action :: !Value\n  , render :: !Bool\n  } deriving (Eq, Generic, Show)\n\ninstance ToJSON Step\n\n\ndata Outcome = Outcome\n  { observation :: !Value\n  , reward      :: !Double\n  , done        :: !Bool\n  , info        :: !Object\n  } deriving (Eq, Show, Generic)\n\ninstance ToJSON Outcome\ninstance FromJSON Outcome\n\n\ndata Info = Info !Object\n  deriving (Eq, Show, Generic)\n\ninstance ToJSON Info where\n  toJSON (Info v) = toSingleton \"info\" v\n\ninstance FromJSON Info where\n  parseJSON = parseSingleton Info \"info\"\n\n\ndata Action = Action !Value\n  deriving (Eq, Show, Generic)\n\ninstance ToJSON Action where\n  toJSON (Action v) = toSingleton \"action\" v\n\ninstance FromJSON Action where\n  parseJSON = parseSingleton Action \"action\"\n\n\ndata Monitor = Monitor\n  { directory      :: !Text\n  , force          :: !Bool\n  , resume         :: !Bool\n  , video_callable :: !Bool\n  } deriving (Generic, Eq, Show)\n\ninstance ToJSON Monitor\n\n\ndata Config = Config\n  { training_dir :: !Text\n  , algorithm_id :: !Text\n  , api_key      :: !Text\n  } deriving (Generic, Eq, Show)\n\ninstance ToJSON Config\n\n\n", "num_lines": 147}
{"repo_name": "gym-http-api", "repo_creator": "openai", "programming_language": "Haskell", "code": "-------------------------------------------------------------------------------\n-- |\n-- Module    :  OpenAI.Gym.Client\n-- License   :  MIT\n-- Stability :  experimental\n-- Portability: non-portable\n-------------------------------------------------------------------------------\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# OPTIONS_GHC -Wno-orphans #-}\nmodule OpenAI.Gym.Prelude\n  ( module P\n  , parseSingleton\n  , toSingleton\n  ) where\n\nimport Control.Monad              as P\nimport Control.Monad.Loops        as P\nimport Control.Monad.Trans.Except as P (runExceptT)\nimport Control.Monad.Trans.Reader as P\nimport Control.Monad.Trans.Class  as P\nimport Data.Aeson                 as P\nimport Data.HashMap.Strict        as P (HashMap)\nimport Data.Proxy                 as P\nimport Data.Text                  as P (Text)\nimport GHC.Generics               as P\nimport Network.HTTP.Client        as P hiding (Proxy, responseBody, responseStatus)\nimport Servant.API                as P\nimport Servant.Client             as P\nimport Servant.HTML.Lucid         as P (HTML)\nimport Control.Monad.IO.Class     as P\nimport Prelude                    as P\nimport Data.Aeson.Types (Parser)\n\ninstance MimeUnrender HTML () where\n    mimeUnrender _ _ = return ()\n\nparseSingleton :: FromJSON a => (a -> b) -> Text -> Value -> Parser b\nparseSingleton fn f (Object v) = fn <$> v .: f\nparseSingleton fn f _          = mempty\n\ntoSingleton :: ToJSON a => Text -> a -> Value\ntoSingleton f a = object [ f .= toJSON a ]\n\n", "num_lines": 44}
{"repo_name": "gym-http-api", "repo_creator": "openai", "programming_language": "Haskell", "code": "main :: IO ()\nmain = putStrLn \"Test suite not yet implemented\"\n", "num_lines": 3}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "import Distribution.Simple\nmain = defaultMain\n", "num_lines": 3}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# OPTIONS_GHC -F -pgmF hspec-discover #-}\n\nmodule Spec where\n", "num_lines": 4}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule SortSpecs.BubbleSortSpec where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Sorts.BubbleSort\n\nspec :: Spec\nspec = do\n    describe \"bubbleSort\" $ do\n        it \"returns empty list when sorting empty list\" $ property $\n            bubbleSort [] == ([] :: [Int])\n\n        it \"returns same list if input was already sorted\" $ property $\n            \\(x :: [Int]) -> bubbleSort x == (bubbleSort . bubbleSort $ x)\n\n        it \"returns list with smallest element at 0\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = bubbleSort x\n                        in head sortedList == minimum sortedList\n\n        it \"returns list with largest element at the end\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = bubbleSort x\n                        in last sortedList == maximum sortedList\n\n        it \"handle simple sorting of static value\" $\n            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]\n                (sortedList :: [Int]) = [1, 2, 3, 4, 7]\n            in bubbleSort unsortedList == sortedList\n", "num_lines": 31}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule SortSpecs.HeapSortSpec where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Sorts.HeapSort\n\nspec :: Spec\nspec = do\n    describe \"heapSort\" $ do\n        it \"returns empty list when sorting empty list\" $ property $\n            heapSort [] == ([] :: [Int])\n\n        it \"returns same list if input was already sorted\" $ property $\n            \\(x :: [Int]) -> heapSort x == (heapSort . heapSort $ x)\n\n        it \"returns list with smallest element at 0\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = heapSort x\n                        in head sortedList == minimum sortedList\n\n        it \"returns list with largest element at the end\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = heapSort x\n                        in last sortedList == maximum sortedList\n\n        it \"handle simple sorting of static value\" $\n            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]\n                (sortedList :: [Int]) = [1, 2, 3, 4, 7]\n            in heapSort unsortedList == sortedList\n", "num_lines": 31}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule SortSpecs.InsertionSortSpec where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Sorts.InsertionSort\n\nspec :: Spec\nspec = do\n    describe \"insertionSort\" $ do\n        it \"returns empty list when sorting empty list\" $ property $\n            insertionSort [] == ([] :: [Int])\n\n        it \"returns same list if input was already sorted\" $ property $\n            \\(x :: [Int]) -> insertionSort x == (insertionSort . insertionSort $ x)\n\n        it \"returns list with smallest element at 0\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = insertionSort x\n                        in head sortedList == minimum sortedList\n\n        it \"returns list with largest element at the end\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = insertionSort x\n                        in last sortedList == maximum sortedList\n\n        it \"handle simple sorting of static value\" $\n            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]\n                (sortedList :: [Int]) = [1, 2, 3, 4, 7]\n            in insertionSort unsortedList == sortedList\n", "num_lines": 31}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule SortSpecs.MergeSortSpec where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Sorts.MergeSort\n\nspec :: Spec\nspec = do\n    describe \"megeSort\" $ do\n        it \"returns empty list when sorting empty list\" $ property $\n            mergeSort [] == ([] :: [Int])\n\n        it \"returns same list if input was already sorted\" $ property $\n            \\(x :: [Int]) -> mergeSort x == (mergeSort . mergeSort $ x)\n\n        it \"returns list with smallest element at 0\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = mergeSort x\n                        in head sortedList == minimum sortedList\n\n        it \"returns list with largest element at the end\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = mergeSort x\n                        in last sortedList == maximum sortedList\n\n        it \"handle simple sorting of static value\" $\n            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]\n                (sortedList :: [Int]) = [1, 2, 3, 4, 7]\n            in mergeSort unsortedList == sortedList\n", "num_lines": 31}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule SortSpecs.QuickSortSpec where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Sorts.QuickSort\n\nspec :: Spec\nspec = do\n    describe \"quicksort\" $ do\n        it \"returns empty list when sorting empty list\" $ property $\n            quicksort [] == ([] :: [Int])\n\n        it \"returns same list if input was already sorted\" $ property $\n            \\(x :: [Int]) -> quicksort x == (quicksort . quicksort $ x)\n\n        it \"returns list with smallest element at 0\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = quicksort x\n                        in head sortedList == minimum sortedList\n\n        it \"returns list with largest element at the end\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = quicksort x\n                        in last sortedList == maximum sortedList\n\n        it \"handle simple sorting of static value\" $\n            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]\n                (sortedList :: [Int]) = [1, 2, 3, 4, 7]\n            in quicksort unsortedList == sortedList\n", "num_lines": 31}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule SortSpecs.SelectionSortSpec where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Sorts.SelectionSort\n\nspec :: Spec\nspec = do\n    describe \"selectionSort\" $ do\n        it \"returns empty list when sorting empty list\" $ property $\n            selectionSort [] == ([] :: [Int])\n\n        it \"returns same list if input was already sorted\" $ property $\n            \\(x :: [Int]) -> selectionSort x == (selectionSort . selectionSort $ x)\n\n        it \"returns list with smallest element at 0\" $ property $\n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = selectionSort x\n                        in head sortedList == minimum sortedList\n\n        it \"returns list with largest element at the end\" $ property $\n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = selectionSort x\n                        in last sortedList == maximum sortedList\n\n        it \"handle simple sorting of static value\" $\n            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]\n                (sortedList :: [Int]) = [1, 2, 3, 4, 7]\n            in selectionSort unsortedList == sortedList\n", "num_lines": 31}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE ScopedTypeVariables #-}\nmodule SortSpecs.ShellSortSpec where\n\nimport Test.Hspec\nimport Test.QuickCheck\nimport Sorts.ShellSort\n\nspec :: Spec\nspec = do\n    describe \"shellSort\" $ do\n        it \"returns empty list when sorting empty list\" $ property $\n            shellSort [] == ([] :: [Int])\n\n        it \"returns same list if input was already sorted\" $ property $\n            \\(x :: [Int]) -> shellSort x == (shellSort . shellSort $ x)\n\n        it \"returns list with smallest element at 0\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = shellSort x\n                        in head sortedList == minimum sortedList\n\n        it \"returns list with largest element at the end\" $ property $ \n            forAll (listOf1 arbitrary) $\n                \\(x :: [Int]) -> let sortedList = shellSort x\n                        in last sortedList == maximum sortedList\n\n        it \"handle simple sorting of static value\" $\n            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]\n                (sortedList :: [Int]) = [1, 2, 3, 4, 7]\n            in shellSort unsortedList == sortedList\n", "num_lines": 31}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module HaskellAlgorithms \n(\n    module Sorts.BubbleSort\n) where\n\nimport Sorts.BubbleSort\n", "num_lines": 7}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module BinaryTree.BinarySearchTree where\n\ndata BTree a = Empty | Node a (BTree a) (BTree a) deriving (Show)\ndata Side = LeftSide | RightSide deriving (Eq, Show)\n\n-- Function to get the data associated with the node.\nnodeKey :: BTree a -> Maybe a\nnodeKey Empty = Nothing\nnodeKey (Node x _ _) = Just x\n\n-- Perform inorder walk of the binary search tree.\n-- Cormen, Thomas H., et al. Introduction to algorithms.  pg. 288, MIT press, 2009.\ninorderWalk :: (Eq a, Ord a) => BTree a -> [a]\ninorderWalk Empty = []\ninorderWalk (Node x l r) = (inorderWalk l) ++ [x] ++ (inorderWalk r)\n\n-- Function to insert a value into the tree. Returns the new tree.\n-- Cormen, Thomas H., et al. Introduction to algorithms.  pg. 294, MIT press, 2009.\nbstInsert :: (Eq a, Ord a) => BTree a -> a -> BTree a\nbstInsert Empty z = Node z Empty Empty\nbstInsert (Node x l r) z\n    | z < x = Node x (bstInsert l z) r\n    | otherwise = Node x l (bstInsert r z)\n\n-- Function to find the maximum value in the BST.\nbstMax :: (Eq a, Ord a) => BTree a -> Maybe a\nbstMax Empty = Nothing\nbstMax (Node x Empty Empty) = Just x\nbstMax (Node x l Empty) = Just x\nbstMax (Node x l r) = bstMax r\n\n-- Function to find the minimum value in the BST.\nbstMin :: (Eq a, Ord a) => BTree a -> Maybe a\nbstMin Empty = Nothing\nbstMin (Node x Empty Empty) = Just x\nbstMin (Node x Empty r) = Just x\nbstMin (Node x l r) = bstMin l\n\n-- Function to build BST from a list of values using a fold.\nbstFromList :: (Eq a, Ord a) => [a] -> BTree a\nbstFromList [] = Empty\nbstFromList lst = foldl (\\tree elem -> bstInsert tree elem) Empty lst\n\nsampleTree = bstFromList [10, 7, 3, 11, 12, 1, 3, 2]\n\n-- Function to check if a given tree is a Binary Search Tree.\n-- Property: \n--     x is a node in the BST. If y is a node in the left subtree of x then \n--     y.key <= x.key. If y is a node in the right subtree of x then\n--     y.key >= x.key.\n--     Cormen, Thomas H., et al. Introduction to algorithms. MIT press, 2009.\nisBST :: (Ord a, Eq a) => BTree a -> Bool\nisBST Empty = True\nisBST (Node x Empty Empty) = True\nisBST (Node x Empty r) = (x < (nkey r)) && (isBST r) where nkey = (\\(Node n ll rr) -> n)\nisBST (Node x l Empty) = (x >= (nkey l)) && (isBST l) where nkey = (\\(Node n ll rr) -> n)\nisBST (Node x l r) = (x >= (nkey l)) && (x < (nkey r)) && (isBST l) && (isBST r) where nkey = (\\(Node n ll rr) -> n)", "num_lines": 57}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module BinaryTree.BinaryTree where\n\nimport qualified Data.List as L\n\ndata BTree a = Empty | Node a (BTree a) (BTree a) deriving (Show)\ndata Side = LeftSide | RightSide deriving (Eq, Show)\n\n-- Get subtree on specified side\ngetSubTree :: Side -> BTree a -> BTree a\ngetSubTree _ Empty = Empty\ngetSubTree s (Node _ l r) = if s == LeftSide then l else r\n\n-- Get Left Subtree\ngetLeftTree :: BTree a -> BTree a\ngetLeftTree Empty = Empty\ngetLeftTree (Node _ l _) = l\n\n-- Get Right Subtree\ngetRightTree :: BTree a -> BTree a\ngetRightTree Empty = Empty\ngetRightTree (Node _ _ r) = r\n\n-- Get string representation of node Data\nnodeShow :: (Show a) => BTree a -> String\nnodeShow Empty = \"\"\nnodeShow (Node val _ _) = show val\n\n-- Depth first traversal\ndfsList :: BTree a -> [a]\ndfsList Empty = []\ndfsList (Node n l r) = [n] ++ (dfsList l) ++ (dfsList r)\n\n-- Breadth first traversal.\nbfsList :: BTree a -> [a]\nbfsList Empty = []\nbfsList t = concat $ takeWhile (\\l -> (length l) > 0) [getLevel i 0 t | i <- [0..]]\n\n-- Get all nodes from a single level in the tree.\ngetLevel :: (Num b, Enum b, Eq b) => b -> b -> BTree a -> [a]\ngetLevel _ _ Empty = []\ngetLevel 0 _ (Node n l r) = [n]\ngetLevel level i (Node n l r)\n    | i == level = [n]\n    | otherwise = (getLevel level (i+1) l) ++ (getLevel level (i+1) r)\n\n-- Get a list of lists of nodes in each level\ngetLevels :: BTree a -> [[a]]\ngetLevels t = takeWhile (\\l -> (length l) > 0) [getLevel i 0 t | i <- [0..]]\n\n-- Get the depth of the tree\ngetDepth :: BTree a -> Int\ngetDepth t = length $ getLevels t\n\n-- Generate a Binary Tree from a list of values.\n-- Assume list is in breadth first order.\nfromList :: [a] -> BTree a\nfromList lst = fromListInt 0 lst\n-- Internal function to convert list to tree.\nfromListInt :: Int -> [a] -> BTree a\nfromListInt _ [] = Empty\nfromListInt i lst@(x:xs) = Node x (fromListInt (2*i + 1) (drop (i+1) lst)) \n                                  (fromListInt (2*i + 2) (drop (i+2) lst))\n\n-- Count number of nodes in the tree.\nnumNodes :: BTree a -> Int\nnumNodes t = length $ bfsList t\n\n-- Pretty Print a Binary Tree\nsimplePrint :: (Show a) => BTree a -> String\nsimplePrint Empty = \"\"\nsimplePrint t = (nodeShow t) ++ \" \" ++ (simplePrint $ getLeftTree t) ++ (simplePrint $ getRightTree t)", "num_lines": 71}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module DataStructures.MaxHeap where\n\n-- Construct a max heap (represented as a list) from a given input list\nmaxHeap :: Ord a => [a] -> [a]\nmaxHeap [] = []\nmaxHeap [x] = [x]\nmaxHeap xs = maxHeap' xs (div (length xs) 2)\n\n-- Insert an element into a heap and then fix the heap\ninsert :: Ord a => [a] -> a -> [a]\ninsert [] e = [e]\ninsert xs e = upHeapify (xs ++ [e]) (length xs)\n\n\n-- Recursive helper function for maxHeap\nmaxHeap' :: Ord a => [a] -> Int -> [a]\nmaxHeap' xs 0 = maxHeapify xs 0\nmaxHeap' xs i = maxHeap' (maxHeapify xs i) (i-1)\n\n-- Given a heap and an index (i), move the element at i up the heap until it is in the right position \nupHeapify :: Ord a => [a] -> Int -> [a]\nupHeapify xs 0 = xs\nupHeapify xs i | xs !! i <= xs !! ip = xs\n               | otherwise = upHeapify (swap xs i ip) ip\n                where\n                    ip = parent i\n\n-- Given a heap and an index (i), move the element at i down the heap until it is in the right position\nmaxHeapify :: (Ord a) => [a] -> Int -> [a]\nmaxHeapify xs i | not (hasAnyChild xs i) = xs\n                | hasLeftChild xs i && hasRightChild xs i = \n                    let largestChild = if xs !! (leftChild i) > xs !! (rightChild i) then leftChild i else rightChild i\n                    in if xs !! largestChild > xs !! i then maxHeapify (swap xs largestChild i) largestChild else xs\n                | hasLeftChild xs i =\n                    if xs !! (leftChild i) > xs !! i then maxHeapify (swap xs (leftChild i) i) (leftChild i) else xs\n                | otherwise =\n                    if xs !! (rightChild i) > xs !! i then maxHeapify (swap xs (rightChild i) i) (rightChild i) else xs\n\n\n-- Remove the largest element from the heap, and then fix the heap\nextract :: Ord a => [a] -> [a]\nextract [] = []\nextract [_] = []\nextract xs = maxHeapify ((last xs):take (length xs - 2) (tail xs)) 0\n\n-- Delete an element from a heap and then fix the heap\n-- If the element is not present, return the heap as is\ndelete :: Ord a => [a] -> a -> [a]\ndelete [] _ = []\ndelete xs e = let i' = (search xs e)\n                  f = if xs !! (length xs - 1) > e then upHeapify else maxHeapify\n                  in case i' of \n                      Nothing -> xs\n                      Just i  -> f (take ((length xs) - 1) (swap xs i ((length xs) - 1))) i\n\n-- Find the index of an element in a heap\n-- Returns Nothing if the element is not present\nsearch :: Eq a => [a] -> a -> Maybe Int\nsearch xs e = search' xs e 0 \n\n-- Recursive helper function for search\nsearch' :: Eq a => [a] -> a -> Int -> Maybe Int\nsearch' [] _ _ = Nothing\nsearch' (x:xs) e i | e == x = Just i\n                   | otherwise = search' xs e (i+1)\n\n\n-- Swap the values stored in two positions in a list\nswap :: [a] -> Int -> Int -> [a]\nswap xs i1 i2 = map snd . foldr (\\x a -> \n        if fst x == i1 then ys !! i2 : a\n        else if fst x == i2 then ys !! i1 : a\n        else x : a) [] $ ys\n    where ys = zip [0..] xs\n\n-- Index where the left child of the node at the given index should be located\nleftChild :: Int -> Int\nleftChild i = 2 * i + 1\n\n-- Index where the right child of the node at the given index should be located\nrightChild :: Int -> Int\nrightChild i = 2 * i + 2\n\n-- Index where the parent of the node at the given index should be located\nparent ::  Int -> Int\nparent i = floor (fromIntegral (div (i-1) 2))\n\n-- Helper functions to determine which, if any, child nodes are present in the heap for the node at a given index\nhasLeftChild, hasRightChild, hasAnyChild :: [a] -> Int -> Bool\nhasLeftChild xs i = leftChild i < length xs\n\nhasRightChild xs i = rightChild i < length xs\n\nhasAnyChild xs i = hasLeftChild xs i || hasRightChild xs i", "num_lines": 94}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Graph.Dfs where\n\nimport Data.List\n\ntype Node = Int\ntype Edge = (Node,Node)\ntype Graph = ([Node],[Edge])\n\ndepthfirst :: Graph -> Node -> [Node]\ndepthfirst (v,e) n\n    | [x|x<-v,x==n] == [] = []\n    | otherwise = dfrecursive (v,e) [n]\n    \ndfrecursive :: Graph -> [Node] -> [Node]\ndfrecursive ([],_) _ = []\ndfrecursive (_,_) [] = []\ndfrecursive (v,e) (top:stack)\n    | [x|x<-v,x==top] == [] = dfrecursive (newv, e) stack\n    | otherwise = top : dfrecursive (newv, e) (adjacent ++ stack)\n    where\n        adjacent = [x | (x,y)<-e,y==top] ++ [x | (y,x)<-e,y==top]\n        newv = [x|x<-v,x/=top]\n        \nconnectedcomponents :: Graph -> [[Node]]\nconnectedcomponents ([],_) = []\nconnectedcomponents (top:v,e) \n    | remaining == [] = [connected]\n    | otherwise = connected : connectedcomponents (remaining, e)\n    where\n        connected = depthfirst (top:v,e) top\n        remaining = (top:v) \\\\ connected\n        \n        \ndfsbipartite :: Graph -> [(Node, Int)] -> [Node] -> [Node] -> Bool\ndfsbipartite ([],_) _ _ _ = True\ndfsbipartite (_,_) [] _ _ = True\ndfsbipartite (v,e) ((nv, 0):stack) odd even\n    | [x|x<-v,x==nv] == [] = dfsbipartite (v, e) stack odd even\n    | [] == intersect adjacent even = dfsbipartite (newv, e) ([(x,1)|x<-adjacent] ++ stack) odd (nv : even)\n    | otherwise = False\n    where\n        adjacent = [x | (x,y)<-e,y==nv] ++ [x | (y,x)<-e,y==nv]\n        newv = [x|x<-v,x/=nv]\ndfsbipartite (v,e) ((nv, 1):stack) odd even\n    | [x|x<-v,x==nv] == [] = dfsbipartite (v, e) stack odd even    \n    | [] == intersect adjacent odd = dfsbipartite (newv, e) ([(x,0)|x<-adjacent] ++ stack) (nv : odd) even\n    | otherwise = False\n    where\n        adjacent = [x | (x,y)<-e,y==nv] ++ [x | (y,x)<-e,y==nv]\n        newv = [x|x<-v,x/=nv]\n\nbipartite :: Graph -> Bool\nbipartite ([],_) = True\nbipartite (top:v,e) = dfsbipartite (top:v, e) [(top,0)] [] []\n", "num_lines": 55}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "{-# LANGUAGE TupleSections #-}\nmodule Graph.DirectedGraph where\n\nimport qualified Data.Set as Set\nimport qualified Data.Map as Map\n\ntype Graph a = Map.Map a (Set.Set a)\n\nempty :: Ord a => Graph a\nempty = Map.empty\n\ninsertNode :: Ord a => a -> Graph a -> Graph a\ninsertNode u g\n    | Map.member u g = g\n    | otherwise      = Map.insert u Set.empty g\n\ninsertEdge :: Ord a => (a, a) -> Graph a -> Graph a\ninsertEdge (u, v) = Map.insertWith Set.union u (Set.singleton v) . insertNode u . insertNode v\n\ndeleteNode :: Ord a => a -> Graph a -> Graph a\ndeleteNode u = Map.delete u . Map.map (Set.delete u)\n\nadjacentNodes :: Ord a => a -> Graph a -> Maybe (Set.Set a)\nadjacentNodes = Map.lookup\n\nnodes :: Ord a => Graph a -> Set.Set a\nnodes = Map.keysSet\n\nedges :: Ord a => Graph a -> [(a, a)]\nedges = concat . Map.elems . Map.mapWithKey (\\u -> map (u,) . Set.toList)\n\n-- Creates graph from list of edges\nfromList :: Ord a => [(a, a)] -> Graph a\nfromList = foldr insertEdge Map.empty\n\n-- Creates new graph by flipping every edge\ntranspose :: Ord a => Graph a -> Graph a\ntranspose = fromList . map (\\(a, b)->(b, a)) . edges\n", "num_lines": 39}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Maths.Factorial where\n\nfac :: Integer -> Integer \nfac 0 = 1\nfac n = n * fac (n - 1)\n\nmain :: IO ()\nmain = do\n    print (fac 4)", "num_lines": 9}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Maths.Fibonacci where\n\nfib :: Integer -> Integer\nfib 0 = 0\nfib 1 = 1\nfib n = fib (n-1) + fib (n-2)\n\nmain :: IO ()\nmain = do\n    print (fib 10)", "num_lines": 10}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Maths.GraphDist where\n\n-- calculates the distance from the origin\ncalcDistOrigin :: Floating a => a -> a -> a -> a\ncalcDistOrigin x y z = sqrt ((x ** 2) + (y ** 2) + (z ** 2))\n\n-- calculates the distance between two points\ncalcDist :: Floating a => a -> a -> a -> a -> a -> a -> a\ncalcDist x1 x2 y1 y2 z1 z2 = sqrt ((x2 - x1) ** 2 + (y2 - y1) ** 2 + (z2 - z1) ** 2)\n\nmain :: IO ()\nmain = do\n  print (calcDistOrigin 4 5 6)\n  print (calcDist 4 6 5 9 6 10)", "num_lines": 14}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Maths.KadaneAlgorithm where\n\n-- Sample Input List \ninputList :: [Integer]\ninputList = [1, -2, 3, 4, -5, 6, -7, 8, 9, 10]\n\n\n-- Helper function that updates values of maxSoFar and maxEndingHere\n-- and call itself recursively over the values of the list \n-- and when the list is empty, return the maxSoFar value\n-- with the start and end indices.\nmaxSubArrayHelper :: Integer -> Integer -> Integer -> Integer -> Integer -> [Integer] -> (Integer, Integer, Integer)\nmaxSubArrayHelper maxSoFar _ _ start end [] = (maxSoFar, start, end)\nmaxSubArrayHelper maxSoFar maxEndingHere i start end (x:xs) = \n    let i' = i + 1\n        maxEndingHere' = maxEndingHere + x\n    in \n        if maxSoFar < maxEndingHere' then \n            maxSubArrayHelper maxEndingHere' maxEndingHere' i' start i xs\n        else if maxEndingHere' < 0 then\n            maxSubArrayHelper maxSoFar 0 i' i' i' xs\n        else \n            maxSubArrayHelper maxSoFar maxEndingHere' i' start end xs\n\n-- Initially maxSoFar (maximum sum till the previous iteration), \n-- maxEndingHere (maximum sum till end index of the current iteration),\n-- start (start index) and end (end index) are sent as 0\nmaxSubArray :: [Integer] -> (Integer, Integer, Integer)\nmaxSubArray = maxSubArrayHelper 0 0 0 0 0\n\n-- Outputs (sum, start, end)\n-- sum - sum from start to end indices of the input array\n-- start:end - the subarray with max sum\nmain :: IO ()\nmain = do\n    print (maxSubArray inputList)", "num_lines": 36}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Maths.Palindrome where\n\npalinedrome :: Eq a => [a] -> Bool\npalinedrome xs = (xs == reverse xs)\n\nmain :: IO ()\nmain = do\n  print (palinedrome [1, 3, 1])", "num_lines": 8}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Misc.BinarySearch where\n\nbsWithIndex :: (Ord a) => [a] -> a -> Int -> Maybe Int\nbsWithIndex list n i\n    | n == head list        = Just i\n    | len == 1              = Nothing   -- only candidate in list is not the right elem\n    | n < head ys           = bsWithIndex xs n i\n    | otherwise             = bsWithIndex ys n (i + half)\n    where \n        len         = length list\n        half        = len `div` 2 \n        (xs, ys)    = splitAt half list\n\nbs :: (Ord a) => [a] -> a -> Int\nbs list n = case bsWithIndex list n 0 of\n    Just x  -> x\n    Nothing -> -1\n\nmain :: IO ()\nmain = do\n    let intList = [1,4,7,10,25,30]\n    print $ bs intList 29  -- 29 -> -1 as not in list\n    print $ bs intList 7   --  7 ->  2 as in list\n", "num_lines": 24}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Misc.NQueens where\n{-\nThe n-Queens search is a backtracking algorithm. The n-Queens problem fits n \nnumber of Queens onto a Chess board. As only one Queen can fit per row, a \none-dimensional integer array is used to represent the Queen's offset on each \nrow.\n-}\n\nimport Data.List (permutations)\n\nmain = nqueens 8\nnqueens size = mapM_ (printBoard size) $ take 1 $ filter (evaluateBoard size) $ board_permutations size\n\n--N sized Chess boards are represented as a one-dimension array.\nboard_permutations size = permutations [0..size - 1]\n\n--Count the number of valid boards for a specified Chess board size.\ncount_boards size = length $ filter (evaluateBoard size) $ board_permutations size\n\n--Show every valid board \nnqueens_list size = mapM_ (printBoard size) $ filter (evaluateBoard size) $ board_permutations size\n\n--Board printing function\nprintBoard size board = do \n    printBoard2 size board \n    putStrLn \"\" where\n        printBoard2 _ [] = return ()\n        printBoard2 size board = do\n            let row = head board\n            printRow size row\n            printBoard2 size $ tail board\n\nprintRow size row = do\n    let lstring = (replicate row \". \")\n    let rstring = replicate (size - row - 1) \". \"\n    putStrLn $ concat (lstring ++ [\"Q \"] ++ rstring)\n    return ()\n\n--Recursively check that prior rows are valid.\nevaluateBoard _ [] = True\nevaluateBoard size rows = (evaluateBoard size $ cut_last rows) && validate size (cut_last rows) (last_row - 1) (last_row + 1) last_row where\n    last_row = last rows\n\n--Validate that a Queen on a row doesn't have conflicts with earlier rows.\nvalidate _ [] _ _ _ = True\nvalidate size rows left right position = if check_row == left || check_row == right || check_row == position then False else validate size (cut_last rows) (left - 1) (right + 1) position where\n    check_row = last rows\n\ncut_last x = reverse $ drop 1 $ reverse x\n", "num_lines": 50}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Misc.Powerset where\n\npowerset :: [a] -> [[a]]\npowerset [] = [[]]\npowerset (x:xs) = (powerset xs) ++ (map (\\ys -> x:ys) (powerset xs)) \n\nxs = [1,2,3,4]\n\nmain :: IO ()\nmain = do\n    putStrLn (show (powerset xs))\n", "num_lines": 12}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Misc.TowersOfHanoi where\n\nhanoi :: (Eq a, Num a) => a -> [Char] -> [Char] -> [Char] -> IO ()\nhanoi 0 _ _ _ = return ()\nhanoi n startPole intermediatePole endPole = do\n    hanoi (n - 1) startPole endPole intermediatePole\n    putStrLn (\"Move from \" ++ startPole ++ \" to \" ++ endPole)\n    hanoi (n - 1) intermediatePole startPole endPole\n\nmain :: IO ()\nmain = do\n    hanoi 3 \"startPole\" \"intermediatePole\" \"endPole\"\n", "num_lines": 13}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module ProjectEuler.Problem1.Problem1 where\n\nsolList = filter (\\n -> (rem n 5 == 0) || (rem n 3 == 0)) [1..999]\n\nmain = do\n    print $ sum solList", "num_lines": 6}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module ProjectEuler.Problem2.Problem2 where\n\nfib :: Integer -> [Integer]\nfib n\n    | n < 0 = []\n    | n == 1 = [0]\n    | n == 2 = [0, 1]\n    | otherwise = reverse $ foldl (\\acc n -> (sum (take 2 acc)):acc) [1, 0] [3..n]\n\nmain = do\n    print $ sum $ filter even $ takeWhile (<=4000000) (fib 100)", "num_lines": 11}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module ProjectEuler.Problem3.Problem3 where\n\nlargestPrimeFactor :: Integer -> Integer -> Integer \nlargestPrimeFactor divi val \n  | val `mod` divi == 0 = if divi == val then val else largestPrimeFactor 2 $ val `div` divi\n  | val `mod` divi /= 0 = largestPrimeFactor (divi + 1) val\n\nmain = do\n  print $ largestPrimeFactor 2 600851475143\n", "num_lines": 10}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module ProjectEuler.Problem4.Problem4 where\n\nisPalindrome :: Integer -> Bool\nisPalindrome i = \n  let strInt = show i\n      front = take (length strInt `div` 2) strInt \n      back = take (length strInt `div` 2)  $ reverse strInt\n  in front == back\n\nmain = do\n  print $ maximum [i * j | i <- [100..999], j <- [100..999], isPalindrome (i * j)]\n", "num_lines": 12}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module ProjectEuler.Problem5.Problem5 where\n\nimport Data.List\n\nprimeFactors' :: Integer -> Integer -> [Integer]\nprimeFactors' _ 1 = [1]\nprimeFactors' d n\n  | d * d > n       = [n]\n  | n `rem` d == 0  = d : primeFactors' d (n `div` d)\n  | otherwise       = primeFactors' (d + 1) n\n\nprimeFactors :: Integer -> [Integer]\nprimeFactors x = primeFactors' 2 x\n\ncombinedPrimeFactorisationTo :: Integer -> [Integer]\ncombinedPrimeFactorisationTo n\n  | n == 1    = [1]\n  | otherwise = furtherPrimes ++ (nPrimes \\\\ furtherPrimes)\n      where\n        furtherPrimes = combinedPrimeFactorisationTo (n - 1)\n        nPrimes       = primeFactors n\n\nmain :: IO ()\nmain = do\n  print $ product $ combinedPrimeFactorisationTo 20\n", "num_lines": 26}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module ProjectEuler.Problem6.Problem6 where\n\nsumSquare :: [Integer] -> Integer\nsumSquare = sum . map (^2)\n\nsquareSum :: [Integer] -> Integer\nsquareSum = (^2) . sum\n\nmain :: IO ()\nmain = do\n    let l = [1..100]\n    putStrLn $ show $ (squareSum l) - (sumSquare l)", "num_lines": 12}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module ProjectEuler.Problem7.Problem7 where\n\nprimes :: [Integer]\nprimes = sieve [2..]\n    where sieve (p:xs) = p : sieve [x | x <- xs, rem x p > 0]\n\nmain :: IO ()\nmain = do\n    putStrLn $ show $ primes !! 10000 -- zero indexing", "num_lines": 9}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Robotics.ComplementaryFilter.CompFilt where\n\nimport Robotics.ComplementaryFilter.TestData\n\n-- Utility functions to extract X, Y, Z components from 3D vector.\ngetX :: (a, a, a) -> a\ngetX (x,_,_) = x\n\ngetY :: (a, a, a) -> a\ngetY (_,y,_) = y\n\ngetZ :: (a, a, a) -> a\ngetZ (_,_,z) = z\n\n-- Extract accel data from list of floats\ngetAccel :: (RealFloat a) => [a] -> (a, a, a)\ngetAccel [] = (0, 0, 0)\ngetAccel s = if length s >= 6\n                then (s!!0, s!!1, s!!2)\n                else (0, 0, 0)\n\n-- Extract gyro data from a lsit of floats\ngetGyro :: (RealFloat a) => [a] -> (a, a, a)\ngetGyro s = if length s >= 6 \n               then (s!!3, s!!4, s!!5)\n               else (0, 0, 0)\n\n-- Function to calculate tilt angle from accelerometer reading.\n-- By default the tilt measurement is made around the Z axis.\naccelTiltAngle :: (RealFloat a) => (a, a, a) -> a\naccelTiltAngle (_, y, z) = (atan2 z y)*180.0/pi\n\n\n-- Complementary filter, uses the scanl pattern.\ncompFilt :: (RealFloat a) => [a] -> [a] -> a -> a -> [a]\ncompFilt \u00cf\u2030s \u00ce\u00b8_accs \u00ce\u00b1 \u00ce\u00b4t = scanl (\\\u00ce\u00b8 (\u00cf\u2030, \u00ce\u00b8_acc) -> \u00ce\u00b1*(\u00ce\u00b8 + \u00cf\u2030*\u00ce\u00b4t) + (1-\u00ce\u00b1)*\u00ce\u00b8_acc) \n                                (head \u00ce\u00b8_accs)\n                                (zip \u00cf\u2030s \u00ce\u00b8_accs)\n\n-- Calculate tilts\ncalcTilt :: (RealFloat a) => [(a, a, a)] -> [(a, a, a)] -> a -> a -> [a]\ncalcTilt accel gyro \u00ce\u00b1 \u00ce\u00b4t = compFilt (map getX gyro) (map accelTiltAngle accel) \u00ce\u00b1 \u00ce\u00b4t\n\nmain = do\n    let accels = map getAccel testData\n    let gyros  = map getGyro testData\n    let tilts = calcTilt accels gyros 0.95 0.01\n    print tilts", "num_lines": 48}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Robotics.ComplementaryFilter.TestData where\n\ntestData = [[-1.176, 6.4028, 6.5988, -131.45, 43.8, -9.2], [-1.372, 7.4481, 6.3701, -127.4, 40.1, -11.85], [-1.666, 8.3628, 6.0435, -121.65, 35.7, -13.75], [-1.9927, 9.0815, 5.6514, -114.75, 31.0, -15.1], [-2.352, 9.4082, 5.2921, -107.6, 26.2, -16.0], [-2.7441, 9.4082, 4.9328, -101.1, 21.5, -16.35], [-3.0381, 9.1795, 4.6388, -95.6, 17.3, -16.15], [-3.2341, 8.8202, 4.5081, -90.3, 13.0, -15.85], [-3.3321, 8.3955, 4.5081, -85.75, 9.6, -15.8], [-3.4627, 7.9708, 4.6061, -81.05, 6.95, -16.15], [-3.5281, 7.6115, 4.7041, -76.45, 5.5, -16.5], [-3.5607, 7.3501, 4.8021, -72.35, 5.75, -16.5], [-3.5934, 7.2195, 4.8348, -69.25, 7.95, -15.85], [-3.6587, 7.1215, 4.8674, -67.55, 11.65, -14.55], [-3.6587, 7.0888, 4.8348, -67.35, 16.2, -12.8], [-3.6914, 7.0888, 4.8348, -68.65, 20.9, -10.8], [-3.6914, 7.0888, 4.8021, -71.2, 25.8, -8.5], [-3.6914, 7.0888, 4.8348, -74.75, 29.35, -6.7], [-3.6587, 7.0888, 4.9001, -78.0, 31.8, -5.25], [-3.5934, 7.0888, 4.9654, -80.95, 32.95, -4.45], [-3.5281, 7.0561, 5.0961, -83.25, 32.8, -4.55], [-3.4627, 7.0888, 5.2594, -84.75, 31.7, -5.5], [-3.4627, 7.1541, 5.3574, -85.2, 30.2, -7.05], [-3.4627, 7.2848, 5.4228, -84.55, 28.6, -8.9], [-3.4627, 7.4481, 5.3574, -82.95, 27.3, -10.7], [-3.4954, 7.7095, 5.1614, -80.75, 26.5, -12.05], [-3.4954, 8.0362, 4.8348, -78.4, 26.6, -12.85], [-3.4627, 8.3955, 4.4101, -76.15, 27.65, -12.65], [-3.4301, 8.7875, 3.8874, -74.9, 29.5, -11.5], [-3.3647, 9.2122, 3.3974, -74.45, 31.95, -9.35], [-3.2667, 9.6042, 2.9727, -74.75, 34.7, -6.2], [-3.1361, 10.0289, 2.7114, -75.55, 37.65, -2.1], [-2.9727, 10.4535, 2.6134, -76.4, 40.7, 2.75], [-2.8094, 10.8782, 2.7441, -76.55, 43.7, 7.95], [-2.6461, 11.2376, 3.0707, -74.9, 46.3, 13.25], [-2.4827, 11.5969, 3.5934, -70.75, 48.25, 18.95], [-2.2867, 11.8909, 4.0507, -62.6, 49.6, 23.5], [-2.058, 12.1522, 4.4428, -52.5, 50.1, 27.3], [-1.862, 12.3809, 4.6714, -40.25, 50.1, 30.2], [-1.6334, 12.5442, 4.7368, -26.3, 49.8, 32.15], [-1.4374, 12.6422, 4.5734, -11.0, 49.4, 33.35], [-1.3067, 12.7076, 4.2141, 5.0, 49.15, 34.25], [-1.2414, 12.6422, 3.6914, 20.55, 49.2, 35.25], [-1.274, 12.5116, 3.1687, 34.3, 49.7, 36.75], [-1.3394, 12.3482, 2.6787, 45.2, 50.35, 39.05], [-1.47, 12.1849, 2.5154, 52.95, 50.5, 42.9], [-1.6987, 11.9889, 2.6461, 58.7, 49.0, 47.45], [-2.0254, 11.7929, 3.1687, 62.2, 45.6, 52.65], [-2.3847, 11.5642, 4.0507, 65.1, 40.0, 58.05], [-2.7767, 11.4009, 5.2594, 68.1, 32.2, 63.05], [-3.1034, 11.2702, 6.6641, 72.6, 22.3, 67.3], [-3.4301, 11.1722, 8.1342, 80.2, 10.6, 70.5], [-3.7567, 11.0742, 9.4409, 92.0, -1.95, 72.0], [-4.1161, 11.0089, 10.4862, 107.95, -14.25, 71.55], [-4.4101, 10.9435, 11.1069, 126.75, -24.85, 69.25], [-4.6388, 10.8455, 11.1396, 146.05, -33.7, 65.5], [-4.8348, 10.7149, 10.7475, 165.35, -38.85, 61.95], [-4.9981, 10.5189, 9.9962, 178.55, -41.65, 58.6], [-5.0961, 10.3229, 9.0488, 186.75, -42.45, 55.6], [-5.2268, 10.0289, 8.0362, 189.45, -41.5, 52.9], [-5.2594, 9.7022, 7.0888, 186.95, -39.4, 51.1], [-5.2921, 9.2775, 6.3701, 180.15, -36.95, 50.35], [-5.2594, 8.8528, 5.8148, 170.45, -35.2, 50.5], [-5.1941, 8.3628, 5.4881, 159.55, -35.1, 50.95], [-5.1288, 7.8402, 5.3574, 149.0, -36.9, 51.0], [-4.9981, 7.3501, 5.4228, 138.8, -41.2, 50.5], [-4.9001, 6.7948, 5.5208, 131.75, -46.95, 49.55], [-4.7368, 6.3048, 5.6841, 126.6, -54.3, 48.15], [-4.5734, 5.7821, 5.8148, 123.0, -62.95, 46.0], [-4.3448, 5.2921, 5.8801, 120.55, -72.4, 42.85], [-4.1487, 4.7694, 5.9128, 118.95, -81.85, 38.75], [-3.9201, 4.2141, 5.8474, 117.8, -90.45, 33.75], [-3.7241, 3.7241, 5.6841, 116.55, -97.65, 28.1], [-3.5281, 3.1687, 5.3574, 114.7, -103.15, 21.75], [-3.3647, 2.6787, 5.0634, 111.7, -107.05, 13.95], [-3.2341, 2.2214, 4.6388, 106.6, -108.35, 6.6], [-3.1361, 1.8294, 4.2141, 100.35, -107.55, -0.6], [-3.1034, 1.5354, 3.7241, 92.5, -104.7, -7.25], [-3.1687, 1.3394, 3.2667, 83.25, -99.9, -12.95], [-3.2667, 1.274, 2.8421, 72.85, -93.3, -17.45], [-3.3974, 1.372, 2.352, 61.55, -85.1, -20.55], [-3.5281, 1.7314, 1.862, 49.7, -75.6, -22.25], [-3.5934, 2.254, 1.372, 37.6, -65.35, -22.7], [-3.6261, 3.0381, 0.6533, 25.6, -54.55, -22.2], [-3.6261, 4.0507, -0.1307, 13.8, -42.2, -20.6], [-3.5934, 5.3901, -0.9474, 0.3, -31.75, -18.35], [-3.4954, 6.9255, -1.7314, -11.8, -22.65, -15.55], [-3.3321, 8.6242, -2.4174, -23.0, -15.2, -12.75], [-3.1687, 10.3882, -3.0381, -32.1, -9.55, -10.25], [-3.0707, 12.1522, -3.5607, -38.45, -5.7, -8.05], [-3.0381, 13.9163, -3.9201, -42.0, -3.55, -5.95], [-2.9727, 15.125, -4.0181, -43.45, -3.55, -4.0], [-2.9074, 15.8436, -3.8547, -43.1, -6.1, -2.85], [-2.8747, 16.0723, -3.3974, -40.25, -10.7, -3.35], [-2.9074, 15.8436, -2.8747, -34.7, -17.6, -5.5], [-2.9727, 15.2556, -2.2867, -26.65, -24.75, -8.65], [-3.1687, 14.3083, -1.666, -19.7, -31.95, -12.3], [-3.4301, 13.1649, -0.98, -14.45, -38.1, -15.95], [-3.8874, 11.9236, -0.2613, -11.65, -41.95, -19.0], [-4.3774, 10.8782, 0.4573, -11.25, -42.25, -20.85], [-4.9328, 9.8982, 1.078, -13.2, -38.75, -21.05], [-5.3901, 9.3428, 1.6334, -17.25, -32.2, -19.6], [-5.7821, 9.0488, 2.156, -22.7, -23.3, -16.65], [-6.0761, 8.9835, 2.5807, -29.0, -12.3, -11.7], [-6.1741, 8.9835, 2.9401, -36.9, 1.75, -6.05], [-5.9781, 9.0162, 3.2667, -44.35, 14.0, -0.1], [-5.5534, 8.9508, 3.5281, -52.25, 24.05, 4.7], [-4.8674, 8.7222, 3.8221, -60.0, 30.75, 7.55], [-4.2141, 8.2322, 4.1814, -66.95, 34.85, 8.7], [-3.5607, 7.5461, 4.5408, -73.8, 37.7, 8.75], [-2.9074, 6.5661, 4.8674, -81.75, 40.0, 8.15], [-2.254, 5.7494, 5.2594, -91.05, 41.35, 6.5], [-1.666, 5.0634, 5.7821, -100.85, 41.0, 3.5], [-1.2414, 4.7041, 6.2068, -109.15, 39.0, -1.05], [-0.98, 4.7041, 6.4681, -114.75, 36.6, -5.45], [-0.8493, 5.0634, 6.5988, -116.0, 34.25, -9.6], [-0.9147, 5.6841, 6.5335, -114.8, 31.85, -13.15], [-1.1434, 6.4355, 6.2721, -112.05, 29.15, -15.9], [-1.47, 7.1868, 5.8801, -108.15, 26.1, -18.0], [-1.862, 7.9382, 5.4554, -103.45, 22.75, -19.45], [-2.352, 8.3955, 4.9981, -98.3, 19.6, -20.25], [-2.8094, 8.6568, 4.6061, -93.4, 16.9, -20.4], [-3.2667, 8.6568, 4.2794, -89.3, 15.1, -19.75], [-3.6261, 8.4608, 4.0834, -85.95, 14.1, -18.6], [-3.8547, 8.1668, 4.0181, -83.75, 13.8, -17.4], [-3.9201, 7.8402, 4.0507, -81.85, 13.75, -16.5], [-3.9201, 7.5788, 4.1487, -79.9, 14.05, -16.1], [-3.8547, 7.3828, 4.2141, -78.1, 15.0, -15.9], [-3.7894, 7.2521, 4.3121, -76.65, 16.85, -15.55], [-3.6587, 7.2195, 4.3448, -76.1, 19.6, -14.9], [-3.5607, 7.2195, 4.3774, -76.95, 22.8, -14.1], [-3.4627, 7.2848, 4.3774, -79.25, 26.0, -13.2], [-3.3647, 7.3828, 4.3448, -82.45, 28.7, -12.3], [-3.2994, 7.5135, 4.3774, -86.45, 30.95, -11.7], [-3.2341, 7.6115, 4.3774, -89.6, 32.05, -11.3], [-3.1687, 7.7095, 4.4101, -92.05, 32.35, -11.2], [-3.1034, 7.7422, 4.4101, -93.7, 32.0, -11.5], [-3.0381, 7.7748, 4.4101, -94.45, 31.05, -12.15], [-3.0054, 7.8402, 4.4101, -94.2, 29.75, -13.05], [-2.9727, 7.9382, 4.4101, -93.0, 28.6, -13.85], [-3.0054, 8.0688, 4.3448, -91.15, 28.05, -14.35], [-3.0381, 8.2322, 4.2467, -89.0, 28.5, -14.3], [-3.0054, 8.4935, 4.0834, -86.8, 30.25, -13.3], [-3.0381, 8.8202, 3.9201, -84.3, 32.6, -11.55], [-3.0054, 9.1795, 3.7241, -82.15, 35.2, -9.0], [-2.9727, 9.6042, 3.5281, -80.0, 37.8, -5.9], [-2.9074, 10.0289, 3.3647, -77.85, 40.2, -2.4], [-2.8094, 10.4535, 3.2667, -75.65, 42.2, 1.45], [-2.7114, 10.8129, 3.3321, -73.2, 43.55, 5.5], [-2.5807, 11.2049, 3.4954, -70.15, 44.0, 9.45], [-2.4174, 11.4989, 3.7567, -66.0, 43.5, 13.05], [-2.254, 11.7602, 4.1487, -60.35, 42.2, 16.05], [-2.0907, 11.9889, 4.4754, -52.75, 40.25, 18.8], [-1.8947, 12.1522, 4.7694, -41.65, 38.4, 20.6], [-1.6987, 12.2829, 4.9001, -29.75, 36.5, 21.7], [-1.5354, 12.4136, 4.8674, -16.0, 34.6, 22.05], [-1.4047, 12.4789, 4.6061, -0.65, 33.0, 21.8], [-1.4374, 12.4462, 4.1487, 15.9, 32.05, 21.5], [-1.5354, 12.3156, 3.4954, 32.4, 32.2, 21.65], [-1.7314, 12.0542, 2.7767, 47.35, 33.65, 22.5], [-1.96, 11.7929, 2.0907, 58.95, 36.25, 24.4], [-2.3194, 11.4989, 1.568, 66.3, 39.3, 28.4], [-2.7441, 11.1722, 1.47, 69.3, 42.25, 34.05], [-3.1687, 10.8782, 1.862, 68.2, 43.9, 41.55], [-3.5607, 10.6495, 2.7114, 64.95, 44.15, 50.1], [-3.8547, 10.5189, 4.0181, 61.25, 42.6, 58.85], [-4.0507, 10.5515, 5.6514, 59.3, 38.55, 67.2], [-4.2141, 10.7475, 7.4481, 61.4, 31.7, 74.7], [-4.3121, 10.9435, 9.2122, 69.3, 22.35, 80.65], [-4.3448, 11.0415, 10.6822, 83.7, 11.5, 84.1], [-4.3121, 11.1396, 11.7276, 103.7, 0.65, 84.2], [-4.2794, 11.1396, 12.0216, 126.6, -10.45, 80.85], [-4.3121, 11.0742, 11.7276, 151.8, -19.1, 76.05], [-4.3448, 10.8782, 10.9435, 170.65, -26.05, 70.55], [-4.4428, 10.5842, 9.8655, 183.75, -30.9, 64.95], [-4.5408, 10.1922, 8.5915, 190.0, -33.6, 59.4], [-4.6388, 9.7349, 7.3501, 189.4, -34.45, 54.2], [-4.7368, 9.2775, 6.3048, 182.8, -34.0, 50.2], [-4.8348, 8.6895, 5.4881, 171.8, -33.2, 48.0], [-4.8674, 8.1668, 4.9654, 158.55, -32.95, 47.1], [-4.8348, 7.6441, 4.6388, 145.1, -34.05, 46.7], [-4.7368, 7.1215, 4.6388, 131.5, -37.6, 46.15], [-4.6061, 6.6315, 4.7041, 121.85, -43.0, 45.0], [-4.4428, 6.2068, 4.8348, 114.65, -50.4, 43.3], [-4.2467, 5.7168, 4.9981, 109.7, -59.55, 41.0], [-4.0181, 5.3248, 5.1614, 106.65, -70.05, 37.6], [-3.8221, 4.9328, 5.2268, 104.95, -81.2, 33.05], [-3.6587, 4.4754, 5.2594, 104.25, -91.9, 27.3], [-3.5607, 4.0834, 5.1941, 103.9, -101.0, 20.7], [-3.4627, 3.6587, 4.9981, 103.45, -107.9, 13.6], [-3.4301, 3.2341, 4.6714, 102.15, -112.2, 5.35], [-3.3974, 2.8421, 4.2794, 99.25, -113.75, -1.9], [-3.4301, 2.4827, 3.8221, 94.75, -112.0, -8.6], [-3.4627, 2.2214, 3.2994, 88.25, -107.4, -14.2], [-3.5281, 2.058, 2.7767, 79.65, -100.15, -18.4], [-3.5934, 2.058, 2.3194, 69.2, -90.75, -20.85], [-3.6914, 2.156, 1.8947, 57.2, -79.8, -21.7], [-3.7241, 2.4827, 1.5027, 44.2, -67.8, -21.1], [-3.6914, 2.9401, 1.1434, 30.6, -55.25, -19.3], [-3.6587, 3.5607, 0.686, 16.8, -42.8, -16.6], [-3.5607, 4.3774, 0.2287, 3.4, -29.35, -13.25], [-3.4627, 5.3901, -0.294, -10.75, -18.6, -10.25], [-3.2667, 6.6968, -0.8493, -22.35, -9.65, -7.3], [-3.0054, 8.1668, -1.4374, -32.65, -3.05, -4.4], [-2.6787, 9.7675, -1.96, -40.7, 1.1, -2.05], [-2.4174, 11.3682, -2.4827, -45.55, 2.75, -0.4], [-2.156, 13.1323, -2.9401, -47.05, 2.0, 0.4], [-1.9927, 14.4716, -3.2994, -45.5, -1.05, 0.65], [-1.8294, 15.4516, -3.4301, -41.75, -6.7, 0.55], [-1.7314, 15.9416, -3.3321, -36.2, -14.5, -0.6], [-1.7314, 15.9416, -3.0054, -27.65, -25.0, -3.25], [-1.8947, 15.5496, -2.5807, -18.3, -35.05, -7.45], [-2.156, 14.7983, -2.058, -8.55, -45.25, -12.35], [-2.548, 13.7856, -1.4374, 0.2, -54.6, -17.15], [-3.1361, 12.5769, -0.7513, 6.65, -61.9, -21.25], [-3.7241, 11.3029, -0.0327, 10.45, -65.75, -24.2], [-4.3448, 10.0615, 0.6207, 11.35, -65.25, -25.7], [-4.9981, 9.1795, 1.2087, 9.1, -60.45, -25.45], [-5.5861, 8.6568, 1.7314, 3.7, -52.2, -23.35], [-6.0435, 8.4282, 2.2214, -4.0, -41.3, -19.15], [-6.3701, 8.4282, 2.5154, -14.2, -26.55, -14.1], [-6.5335, 8.5588, 2.7767, -24.05, -11.9, -8.35], [-6.4681, 8.7548, 3.0054, -34.15, 2.65, -2.6], [-6.1088, 8.8528, 3.1687, -44.65, 15.2, 2.25], [-5.6188, 8.8202, 3.4301, -54.9, 24.7, 5.65], [-4.9981, 8.5262, 3.7894, -63.95, 31.5, 7.5], [-4.3448, 7.8402, 4.1487, -72.05, 36.7, 8.1], [-3.5934, 6.9581, 4.5408, -80.55, 40.95, 7.85], [-2.8421, 6.1088, 5.0634, -90.3, 44.05, 6.45], [-2.1234, 5.3248, 5.5861, -100.8, 45.45, 3.45], [-1.5027, 4.8348, 6.1415, -111.45, 44.9, -0.3], [-1.0454, 4.6714, 6.5661, -117.75, 43.3, -4.55], [-0.7513, 4.9328, 6.8275, -120.4, 41.0, -8.8], [-0.6533, 5.4554, 6.8601, -120.25, 38.05, -12.65], [-0.784, 6.1415, 6.6968, -118.25, 34.5, -15.75], [-1.078, 6.9908, 6.4028, -114.65, 30.45, -18.0], [-1.47, 7.7095, 5.9781, -109.7, 26.0, -19.55], [-1.9927, 8.2648, 5.4881, -103.8, 21.55, -20.35], [-2.4827, 8.6242, 4.9328, -97.7, 17.35, -20.7], [-3.0381, 8.7548, 4.5081, -91.6, 13.6, -20.5], [-3.4954, 8.6895, 4.1814, -87.15, 11.45, -19.8], [-3.8221, 8.4608, 3.9527, -83.6, 10.25, -18.95], [-4.0181, 8.1668, 3.8874, -80.6, 9.7, -18.25], [-4.0507, 7.9055, 3.8874, -77.95, 9.75, -17.95], [-4.0181, 7.7095, 3.9201, -75.6, 10.6, -17.9], [-3.9201, 7.5461, 3.9854, -73.9, 12.45, -17.7], [-3.7894, 7.4481, 4.0834, -73.2, 15.4, -17.15], [-3.6261, 7.4155, 4.1487, -74.0, 19.0, -16.25], [-3.4627, 7.4481, 4.2141, -76.2, 22.7, -15.05], [-3.3321, 7.5135, 4.2794, -79.9, 26.3, -14.15], [-3.2341, 7.6115, 4.3448, -83.5, 28.65, -13.35], [-3.1687, 7.6441, 4.4428, -86.65, 30.0, -12.85], [-3.1034, 7.6768, 4.5081, -88.9, 30.5, -12.7], [-3.0707, 7.6441, 4.5734, -90.05, 30.05, -13.1], [-3.0381, 7.5788, 4.6388, -90.2, 28.85, -14.0], [-3.0381, 7.5135, 4.6714, -89.4, 27.05, -15.35], [-3.0381, 7.4808, 4.6714, -87.85, 25.15, -16.95], [-3.0707, 7.5135, 4.6061, -85.85, 23.7, -18.3], [-3.1034, 7.6441, 4.4754, -83.7, 23.2, -19.3], [-3.1034, 7.8402, 4.2794, -81.6, 23.9, -19.35], [-3.1034, 8.1668, 4.0834, -80.35, 25.4, -18.55], [-3.0381, 8.5588, 3.8221, -79.65, 27.4, -16.8], [-3.0054, 9.0488, 3.5607, -79.3, 29.75, -14.25], [-2.9401, 9.5715, 3.2667, -79.1, 32.4, -10.95], [-2.8747, 10.1269, 3.1361, -78.75, 35.1, -7.05], [-2.8094, 10.5515, 3.1034, -78.1, 37.5, -2.75], [-2.7114, 10.9435, 3.2341, -76.85, 39.2, 1.65], [-2.5807, 11.3029, 3.5934, -74.45, 40.1, 6.35], [-2.4827, 11.5969, 3.9527, -69.5, 40.3, 10.05], [-2.3194, 11.8256, 4.3774, -62.95, 39.9, 13.25], [-2.156, 11.9889, 4.7368, -54.4, 38.95, 15.9], [-1.96, 12.1522, 5.0308, -44.3, 37.5, 17.8], [-1.6987, 12.3156, 5.1614, -32.9, 35.75, 18.95], [-1.5354, 12.4462, 5.1614, -20.25, 33.95, 19.55], [-1.4047, 12.6096, 4.9328, -6.3, 32.35, 19.95], [-1.4047, 12.6749, 4.5734, 8.7, 31.3, 20.55], [-1.47, 12.6749, 4.0181, 23.85, 30.95, 21.75], [-1.6007, 12.5442, 3.4954, 38.0, 31.6, 24.1], [-1.8294, 12.3809, 3.0054, 51.5, 32.95, 27.3], [-2.156, 12.1196, 2.7441, 60.95, 34.5, 31.7], [-2.5807, 11.8256, 2.6787, 68.0, 35.6, 37.35], [-3.1034, 11.4662, 2.9727, 72.8, 35.8, 43.95], [-3.5607, 11.1396, 3.5934, 75.75, 34.7, 50.9], [-3.9527, 10.8129, 4.5081, 77.35, 32.25, 57.7], [-4.3121, 10.6169, 5.6514, 79.15, 28.3, 63.9], [-4.6388, 10.4862, 6.8928, 83.0, 22.75, 69.15], [-4.9001, 10.4209, 8.2322, 90.2, 16.0, 73.45], [-5.1288, 10.4209, 9.2122, 101.1, 7.95, 75.45], [-5.2594, 10.3555, 9.8002, 116.8, 1.35, 75.6], [-5.3248, 10.2902, 9.9635, 131.75, -4.0, 74.35], [-5.3248, 10.1922, 9.7349, 145.7, -8.0, 72.25], [-5.2268, 10.1269, 9.1468, 156.95, -10.9, 69.6], [-5.1288, 9.9635, 8.3955, 164.3, -12.8, 66.55], [-4.9981, 9.7349, 7.4808, 166.95, -13.75, 63.2], [-4.8674, 9.4735, 6.6968, 165.1, -14.15, 59.9], [-4.7368, 9.2122, 6.0435, 159.55, -14.45, 57.1], [-4.6061, 8.8855, 5.5208, 151.4, -15.55, 54.65], [-4.5081, 8.5262, 5.3248, 141.3, -18.45, 52.65], [-4.4428, 8.1015, 5.2594, 132.8, -22.8, 50.45], [-4.4101, 7.6441, 5.2921, 125.65, -28.7, 48.0], [-4.3448, 7.1541, 5.3901, 120.1, -36.1, 45.45], [-4.2794, 6.6315, 5.4881, 116.0, -44.75, 42.8], [-4.2141, 6.1415, 5.5861, 113.0, -54.4, 39.95], [-4.0834, 5.5534, 5.5861, 110.95, -64.35, 36.55], [-3.9527, 5.0634, 5.5534, 109.45, -73.9, 32.55], [-3.8221, 4.6061, 5.4228, 108.15, -82.3, 28.1], [-3.5934, 4.1487, 5.2268, 106.6, -89.8, 22.65], [-3.3974, 3.6914, 4.9654, 104.1, -94.55, 17.5], [-3.2341, 3.2341, 4.6388, 100.75, -97.4, 12.1], [-3.0707, 2.8094, 4.2794, 96.1, -98.2, 6.6], [-2.9727, 2.4174, 3.8874, 89.95, -97.15, 1.2], [-2.9074, 2.0907, 3.5281, 82.35, -94.45, -3.7], [-2.9074, 1.8947, 3.1687, 73.55, -90.45, -7.85], [-2.9401, 1.862, 2.8421, 64.0, -85.2, -11.05], [-3.0054, 1.96, 2.4827, 54.1, -79.0, -13.4], [-3.0707, 2.2214, 2.1234, 44.2, -72.05, -14.8], [-3.1034, 2.6787, 1.6987, 34.6, -63.85, -15.45], [-3.1034, 3.3974, 1.176, 24.55, -56.25, -15.4], [-3.1361, 4.3448, 0.4573, 16.4, -48.3, -14.75], [-3.1361, 5.5534, -0.3593, 8.3, -40.25, -13.2], [-3.0381, 6.9581, -1.2087, -0.45, -32.7, -10.8], [-2.8747, 8.4935, -1.9927, -9.2, -26.15, -8.1], [-2.7441, 10.2902, -2.7114, -17.05, -20.85, -5.6], [-2.6134, 11.8582, -3.2994, -23.05, -17.0, -3.5], [-2.548, 13.3283, -3.7567, -26.9, -14.55, -1.8], [-2.45, 14.4389, -3.9854, -29.1, -13.95, -0.25], [-2.352, 15.0923, -3.8547, -30.4, -16.65, 0.35], [-2.254, 15.2883, -3.4301, -29.45, -22.15, -1.2], [-2.254, 15.0923, -2.8747, -25.6, -30.0, -5.05], [-2.4174, 14.635, -2.254, -19.75, -39.45, -10.35], [-2.7114, 13.9489, -1.6007, -13.55, -49.25, -16.25], [-3.1361, 13.0669, -0.9147, -8.7, -57.9, -22.05], [-3.6914, 12.0869, -0.196, -6.55, -64.2, -27.1], [-4.3448, 11.4336, 0.5553, -7.15, -67.25, -30.55], [-5.0634, 11.0089, 1.3067, -9.45, -66.45, -32.05], [-5.7168, 10.8129, 1.96, -12.6, -61.2, -31.05], [-6.2721, 10.7475, 2.4827, -16.4, -52.65, -27.85], [-6.6968, 10.6495, 2.9727, -19.9, -40.6, -22.75], [-6.9255, 10.4862, 3.3321, -24.05, -26.4, -16.0], [-6.8601, 10.0942, 3.6261, -29.0, -12.25, -8.4], [-6.5008, 9.4082, 3.8221, -34.35, 0.05, -1.5], [-5.9128, 8.3302, 4.0181, -39.65, 9.85, 3.05], [-5.2594, 6.8275, 4.1487, -45.7, 17.85, 5.15], [-4.6061, 5.3574, 4.2141, -54.3, 25.35, 5.55], [-3.9201, 3.9854, 4.3448, -67.2, 32.25, 4.85], [-3.2341, 3.0054, 4.5734, -84.05, 38.25, 2.75], [-2.5154, 2.45, 4.9654, -104.75, 41.75, -0.2], [-1.862, 2.5154, 5.4554, -121.55, 44.35, -4.05], [-1.372, 3.2014, 5.9781, -134.65, 46.6, -8.15], [-1.0454, 4.3774, 6.3701, -143.25, 48.3, -11.55], [-0.8493, 5.8148, 6.6315, -147.3, 49.0, -13.8], [-0.784, 7.4155, 6.7621, -146.9, 47.7, -14.9], [-0.8167, 8.5915, 6.7295, -142.2, 44.1, -15.4], [-0.98, 9.5062, 6.5008, -133.9, 38.55, -15.85], [-1.3394, 10.0289, 6.0761, -123.3, 31.7, -16.7], [-1.7967, 10.0615, 5.6188, -110.6, 23.35, -17.5], [-2.3194, 9.7349, 5.1288, -100.25, 16.25, -17.9], [-2.7441, 9.2122, 4.7041, -91.75, 10.05, -18.15], [-3.1034, 8.5915, 4.3774, -85.1, 4.9, -18.5], [-3.4627, 7.9708, 4.2141, -79.95, 1.4, -19.25], [-3.7241, 7.4808, 4.1487, -75.9, -0.0, -20.15], [-3.8874, 7.1541, 4.1487, -72.6, 1.05, -20.65], [-3.9854, 6.9908, 4.2141, -70.3, 4.3, -20.3], [-3.9854, 7.0235, 4.2794, -69.0, 9.1, -19.15], [-3.9201, 7.0888, 4.3774, -68.9, 15.1, -17.3], [-3.8221, 7.2195, 4.4428, -70.15, 20.35, -15.4], [-3.6914, 7.3501, 4.5408, -72.0, 25.05, -13.45], [-3.5607, 7.4481, 4.6388, -74.2, 28.5, -11.75], [-3.4301, 7.4808, 4.7694, -76.4, 30.5, -10.4], [-3.2994, 7.4808, 4.9001, -78.35, 30.85, -9.9], [-3.1687, 7.4155, 4.9654, -80.0, 29.9, -10.25], [-3.1361, 7.3828, 5.0308, -81.25, 28.15, -11.35], [-3.1034, 7.3501, 5.0961, -82.0, 26.1, -13.05], [-3.1361, 7.4155, 5.0308, -82.15, 24.3, -14.9], [-3.2014, 7.5461, 4.9001, -81.8, 23.05, -16.85], [-3.2667, 7.7422, 4.6714, -80.95, 23.05, -18.1], [-3.2994, 8.0688, 4.2794, -80.1, 24.15, -18.7], [-3.2994, 8.4282, 3.8221, -79.5, 26.3, -18.35], [-3.2994, 8.8202, 3.3321, -79.4, 29.25, -17.0], [-3.2994, 9.2122, 2.8421, -79.8, 32.5, -14.65], [-3.2341, 9.6695, 2.4827, -80.5, 35.7, -11.4], [-3.1687, 10.0289, 2.3194, -81.3, 38.55, -7.4], [-3.0381, 10.3882, 2.3847, -81.6, 40.9, -2.75], [-2.9074, 10.7475, 2.7114, -80.95, 42.6, 2.95], [-2.7114, 11.1069, 3.2014, -78.1, 43.75, 8.15], [-2.5154, 11.4336, 3.8874, -72.9, 43.95, 13.2], [-2.254, 11.7276, 4.5081, -64.5, 43.45, 17.65], [-1.9274, 12.0216, 5.0634, -53.15, 42.3, 21.25], [-1.6334, 12.3156, 5.4228, -39.35, 40.85, 23.8], [-1.4047, 12.5769, 5.5534, -23.7, 39.4, 25.4], [-1.2087, 12.8056, 5.3901, -6.5, 38.25, 26.35], [-1.176, 12.9036, 4.9981, 11.65, 37.65, 27.1], [-1.2087, 12.9036, 4.3448, 29.4, 37.9, 28.1], [-1.3394, 12.8056, 3.6587, 45.0, 39.4, 30.15], [-1.568, 12.6096, 3.0707, 58.15, 41.5, 33.2], [-1.8294, 12.3809, 2.7441, 65.75, 43.75, 37.8], [-2.1887, 12.1196, 2.7441, 70.3, 45.15, 43.75], [-2.6134, 11.8256, 3.1361, 72.85, 44.95, 50.5], [-2.9727, 11.4989, 3.9201, 74.1, 42.65, 57.45], [-3.2994, 11.2049, 5.0961, 75.15, 37.9, 63.85], [-3.5607, 11.0415, 6.4681, 77.65, 30.55, 69.25], [-3.8547, 10.9435, 7.9382, 83.8, 20.75, 73.2], [-4.1487, 10.8782, 9.4409, 94.85, 9.25, 75.25], [-4.4101, 10.8782, 10.3882, 112.95, -4.0, 74.6], [-4.6714, 10.7802, 10.8782, 132.1, -14.6, 72.0], [-4.9001, 10.6822, 10.8782, 151.35, -23.3, 68.25], [-5.0634, 10.5515, 10.3882, 168.3, -29.85, 64.25], [-5.2594, 10.3882, 9.6042, 181.25, -34.2, 60.3], [-5.3901, 10.1269, 8.5915, 189.05, -36.25, 56.55], [-5.5208, 9.8002, 7.5135, 191.0, -36.25, 53.25], [-5.6188, 9.4735, 6.5661, 187.3, -34.9, 50.75], [-5.6514, 9.0488, 5.8474, 179.05, -33.1, 49.35], [-5.6841, 8.6242, 5.3248, 168.1, -31.6, 48.85], [-5.6841, 8.1342, 5.1288, 154.95, -30.7, 48.8], [-5.6188, 7.6441, 5.0634, 144.25, -31.1, 48.55], [-5.5534, 7.0888, 5.1614, 135.2, -32.85, 48.05], [-5.3901, 6.5335, 5.2594, 127.9, -36.25, 47.15], [-5.1941, 5.9781, 5.3248, 122.25, -41.25, 45.65], [-4.9328, 5.4228, 5.3574, 117.85, -47.45, 43.5], [-4.6388, 4.8674, 5.3248, 114.35, -54.35, 40.45], [-4.3121, 4.3121, 5.1941, 111.15, -61.7, 36.35], [-4.0181, 3.8547, 4.9981, 107.95, -69.05, 31.25], [-3.6914, 3.3647, 4.7694, 104.2, -76.75, 24.5], [-3.4301, 2.9074, 4.5081, 99.05, -82.45, 17.65], [-3.2014, 2.45, 4.2141, 93.45, -86.6, 10.4], [-3.0707, 2.058, 3.9527, 86.75, -88.9, 2.95], [-2.9727, 1.6334, 3.6914, 78.95, -89.25, -4.2], [-2.9727, 1.372, 3.4301, 70.1, -87.8, -10.65], [-3.0381, 1.176, 3.1687, 60.45, -84.5, -15.95], [-3.1034, 1.176, 2.9074, 50.4, -79.3, -19.75], [-3.2014, 1.3394, 2.6461, 40.3, -72.5, -21.95], [-3.2667, 1.666, 2.2214, 30.4, -64.5, -22.5], [-3.2994, 2.254, 1.6987, 19.6, -54.6, -21.55], [-3.2667, 3.1034, 1.0127, 10.45, -45.1, -19.55], [-3.2014, 4.3121, 0.1633, 1.45, -35.45, -16.5], [-3.1034, 5.7821, -0.784, -8.15, -26.35, -12.45], [-2.9074, 7.5135, -1.6987, -18.25, -18.5, -7.85], [-2.6787, 9.3755, -2.5154, -27.55, -12.25, -3.6], [-2.548, 11.5642, -3.2014, -34.8, -7.9, -0.15], [-2.4174, 13.4263, -3.7894, -39.1, -5.6, 2.4], [-2.352, 15.0596, -4.1487, -40.45, -5.45, 4.3], [-2.2867, 16.203, -4.1161, -39.65, -9.05, 5.4], [-2.2214, 16.7583, -3.7567, -36.3, -15.65, 4.55], [-2.2214, 16.7583, -3.2014, -29.75, -24.35, 0.85], [-2.4174, 16.3337, -2.6134, -20.4, -34.7, -5.15], [-2.7114, 15.5823, -1.96, -10.3, -45.55, -12.3], [-3.1361, 14.5369, -1.274, -1.65, -55.55, -19.8], [-3.6914, 13.3936, -0.5227, 4.05, -63.55, -26.75], [-4.3774, 12.2176, 0.2287, 6.6, -68.2, -32.3], [-5.0961, 11.3356, 0.9147, 6.8, -68.45, -35.75], [-5.7821, 10.7149, 1.6007, 5.55, -64.65, -36.65], [-6.3375, 10.2902, 2.1234, 3.2, -56.3, -34.3], [-6.8275, 9.9309, 2.6134, -0.45, -45.3, -29.35], [-7.1215, 9.5715, 2.9727, -4.55, -31.85, -21.95], [-7.1541, 9.0815, 3.2667, -9.45, -17.65, -12.9], [-6.8601, 8.3955, 3.4627, -15.35, -4.3, -3.9], [-6.4028, 7.4808, 3.6261, -22.55, 6.85, 3.2], [-5.8474, 6.3048, 3.8547, -31.05, 15.75, 7.8], [-5.3248, 5.1941, 4.0181, -41.25, 24.15, 10.55], [-4.7694, 4.1814, 4.1814, -54.4, 32.5, 12.35], [-4.1161, 3.3647, 4.4428, -71.15, 40.0, 13.1], [-3.3974, 2.9727, 4.8021, -92.8, 46.85, 12.2], [-2.6787, 3.0381, 5.2594, -112.0, 51.55, 9.8], [-2.0254, 3.6261, 5.7494, -128.4, 55.25, 6.55], [-1.4374, 4.6061, 6.1741, -140.2, 57.9, 3.3], [-1.0454, 5.8148, 6.4681, -147.3, 58.95, 0.35], [-0.7513, 7.0561, 6.5988, -150.25, 57.4, -2.6], [-0.6207, 8.2975, 6.5988, -149.3, 52.9, -5.75], [-0.686, 9.1142, 6.4681, -144.45, 46.15, -9.3], [-0.98, 9.6369, 6.1741, -136.2, 38.0, -13.15], [-1.4374, 9.8002, 5.7494, -125.75, 28.1, -17.3], [-1.9927, 9.5715, 5.2921, -113.7, 19.65, -20.55], [-2.4827, 9.1468, 4.8021, -104.45, 12.3, -23.1], [-2.9401, 8.6242, 4.4101, -97.0, 6.4, -25.1], [-3.3321, 8.0688, 4.1487, -91.05, 2.25, -26.65], [-3.5607, 7.6115, 4.0181, -86.3, 0.1, -27.9], [-3.7241, 7.2521, 4.0181, -82.5, -0.1, -28.55], [-3.7894, 7.0561, 4.0834, -79.6, 1.7, -28.4], [-3.7894, 7.0561, 4.1814, -77.75, 5.05, -27.45], [-3.7567, 7.1215, 4.3121, -76.75, 9.35, -25.5], [-3.6914, 7.2195, 4.4101, -76.45, 14.65, -23.3], [-3.5934, 7.3501, 4.5081, -76.8, 19.25, -20.95], [-3.5281, 7.4808, 4.5734, -77.65, 23.35, -18.7], [-3.4627, 7.5135, 4.5734, -78.85, 26.55, -16.65], [-3.3647, 7.5135, 4.5734, -80.4, 28.65, -15.15], [-3.2667, 7.4481, 4.5734, -82.25, 29.5, -14.4], [-3.2014, 7.4155, 4.6061, -84.4, 29.3, -14.3], [-3.1687, 7.3501, 4.6061, -86.7, 28.3, -14.8], [-3.1361, 7.3828, 4.6388, -88.7, 26.95, -15.65], [-3.1361, 7.4808, 4.6061, -90.05, 25.55, -16.7], [-3.1361, 7.7095, 4.5081, -90.65, 24.4, -17.4], [-3.1034, 8.0362, 4.3121, -90.45, 23.9, -17.55], [-3.0707, 8.4608, 4.0181, -89.85, 24.05, -17.0], [-3.0707, 8.9835, 3.6914, -88.85, 24.9, -15.55], [-3.0707, 9.5062, 3.3321, -87.5, 26.4, -13.2], [-3.0707, 10.0289, 3.0054, -85.7, 28.4, -9.9], [-3.0707, 10.5189, 2.8094, -83.45, 30.6, -5.8], [-3.0707, 10.9435, 2.7441, -80.8, 32.9, -1.05], [-3.0381, 11.3356, 2.9074, -77.55, 35.1, 4.2], [-3.0054, 11.6296, 3.2341, -73.05, 37.55, 10.4], [-2.9074, 11.8909, 3.6587, -65.65, 39.55, 15.95], [-2.7441, 12.0869, 4.0834, -56.75, 41.4, 21.15], [-2.5154, 12.2502, 4.4428, -45.65, 42.9, 25.6], [-2.1887, 12.3809, 4.6714, -33.0, 44.05, 29.1], [-1.9274, 12.5442, 4.7041, -19.25, 44.85, 31.6], [-1.6987, 12.6749, 4.5734, -4.5, 45.5, 33.25], [-1.568, 12.7402, 4.2467, 11.05, 46.05, 34.35], [-1.5354, 12.7076, 3.7894, 26.65, 46.6, 35.2], [-1.568, 12.6096, 3.2014, 41.0, 47.3, 36.45], [-1.7314, 12.4462, 2.7441, 54.1, 48.05, 38.25], [-1.9927, 12.2176, 2.5154, 62.3, 48.15, 41.1], [-2.3847, 11.9562, 2.5807, 67.7, 46.85, 45.05], [-2.8421, 11.6296, 3.0381, 70.95, 43.95, 49.85], [-3.3974, 11.3356, 3.8547, 72.85, 39.45, 55.05], [-3.8221, 11.0742, 4.9981, 74.3, 33.55, 60.3], [-4.2141, 10.8782, 6.3701, 76.8, 26.15, 65.3], [-4.5408, 10.8455, 7.8402, 82.15, 17.3, 69.6], [-4.8348, 10.8129, 9.3755, 91.75, 7.5, 72.65], [-5.0634, 10.8129, 10.4862, 106.0, -3.25, 73.9], [-5.1941, 10.7802, 11.1069, 126.15, -11.25, 73.2], [-5.2268, 10.7149, 11.2702, 145.35, -17.3, 71.3], [-5.1941, 10.6169, 10.9109, 163.0, -21.7, 68.95], [-5.1288, 10.4209, 10.1922, 176.95, -24.85, 66.3], [-5.0634, 10.1922, 9.2448, 185.6, -26.75, 63.4], [-4.9981, 9.8655, 8.1668, 188.2, -27.5, 60.3], [-4.9328, 9.4409, 7.1868, 185.15, -27.45, 57.45], [-4.8674, 9.0162, 6.4028, 177.45, -27.3, 55.45], [-4.8348, 8.5915, 5.7821, 166.6, -27.75, 54.35], [-4.7694, 8.1342, 5.5208, 154.6, -29.7, 53.65], [-4.7041, 7.6768, 5.4228, 141.75, -33.15, 52.75], [-4.6061, 7.1541, 5.4881, 132.15, -38.3, 51.5], [-4.4754, 6.6315, 5.6188, 124.7, -45.1, 49.85], [-4.3448, 6.1415, 5.7494, 119.3, -53.6, 47.8], [-4.1814, 5.5861, 5.8474, 115.45, -63.45, 45.2], [-3.9854, 5.0308, 5.8801, 112.7, -74.15, 41.55], [-3.7567, 4.4754, 5.8148, 110.6, -84.9, 36.85], [-3.5934, 3.9854, 5.7168, 109.05, -94.9, 31.05], [-3.4301, 3.4954, 5.4881, 107.55, -103.4, 23.65], [-3.2667, 3.0054, 5.1941, 105.5, -110.55, 16.55], [-3.1687, 2.548, 4.8021, 102.85, -114.5, 9.15], [-3.1034, 2.1234, 4.3774, 99.1, -115.95, 1.7], [-3.0707, 1.764, 3.8874, 93.95, -114.85, -5.4], [-3.1034, 1.5354, 3.3647, 87.25, -111.45, -11.6], [-3.2014, 1.372, 2.8094, 79.0, -105.95, -16.5], [-3.2994, 1.4374, 2.3194, 69.3, -98.5, -19.9], [-3.4301, 1.6334, 1.7967, 58.25, -89.3, -21.7], [-3.5607, 2.0254, 1.2087, 46.15, -78.7, -21.95], [-3.6587, 2.6134, 0.588, 33.25, -65.5, -20.45], [-3.6914, 3.4301, -0.0653, 18.25, -52.9, -17.95], [-3.6914, 4.4754, -0.784, 4.85, -40.2, -14.65], [-3.5934, 5.8148, -1.5027, -8.6, -28.25, -10.8], [-3.3647, 7.3175, -2.156, -21.5, -17.8, -6.65], [-3.1361, 8.9508, -2.7114, -32.8, -9.25, -2.8], [-2.9074, 10.6495, -3.2014, -41.5, -2.95, 0.35], [-2.6787, 12.4789, -3.5607, -47.0, 0.75, 2.55], [-2.4827, 13.9163, -3.7567, -49.15, 1.45, 3.65], [-2.2867, 15.027, -3.6914, -48.55, -1.15, 3.75], [-2.156, 15.6476, -3.4301, -45.0, -7.6, 2.35], [-2.1234, 15.811, -3.0381, -39.25, -15.4, -0.75], [-2.2214, 15.5823, -2.548, -31.55, -24.75, -5.5], [-2.4174, 15.027, -2.0254, -23.35, -35.05, -11.35], [-2.7767, 14.2429, -1.4047, -15.95, -45.15, -17.6], [-3.2667, 13.2956, -0.7187, -10.25, -53.55, -23.25], [-3.8547, 12.1849, 0.0, -6.75, -58.75, -27.6], [-4.5081, 11.3029, 0.686, -5.55, -59.75, -30.25], [-5.1614, 10.6822, 1.3067, -6.4, -56.65, -30.95], [-5.7821, 10.3229, 1.96, -9.0, -50.25, -29.15], [-6.2721, 10.1269, 2.4174, -13.15, -39.3, -25.25], [-6.5988, 9.9635, 2.8421, -17.25, -26.35, -19.3], [-6.6968, 9.7675, 3.1361, -21.85, -11.4, -11.75], [-6.5335, 9.4409, 3.3321, -27.4, 4.0, -3.75], [-6.1088, 9.0162, 3.4627, -34.45, 17.8, 3.35], [-5.6188, 8.2975, 3.6261, -42.55, 29.0, 9.05], [-4.9328, 7.2195, 3.8221, -51.65, 38.2, 13.05], [-4.2141, 6.0108, 4.0507, -62.35, 46.05, 15.35], [-3.4954, 4.8674, 4.3448, -75.65, 52.4, 15.95], [-2.7441, 3.9854, 4.7368, -91.55, 56.9, 14.4], [-2.0254, 3.4301, 5.2594, -110.65, 57.75, 10.95], [-1.4374, 3.3647, 5.8801, -125.6, 55.9, 6.0], [-0.9474, 3.7567, 6.5008, -136.0, 52.2, 0.0], [-0.588, 4.6061, 6.9255, -141.0, 47.25, -6.35], [-0.5227, 5.7168, 7.2195, -141.0, 41.0, -12.25], [-0.588, 6.8928, 7.3175, -136.65, 33.7, -17.1], [-0.8493, 8.1342, 7.1541, -128.7, 25.8, -20.95], [-1.2087, 8.9835, 6.7948, -117.95, 17.5, -23.85], [-1.7314, 9.4735, 6.2068, -105.6, 9.65, -26.25], [-2.352, 9.6369, 5.5534, -92.0, 2.1, -27.45], [-2.9401, 9.4082, 4.9654, -81.95, -2.95, -27.6], [-3.4301, 8.9508, 4.3774, -74.7, -6.4, -26.95], [-3.8221, 8.3955, 3.9854, -70.15, -8.3, -26.15], [-4.1161, 7.8728, 3.7241, -67.65, -8.95, -25.55], [-4.2467, 7.4155, 3.6587, -66.45, -8.25, -25.1], [-4.3121, 7.0888, 3.7241, -66.15, -5.65, -24.45], [-4.2467, 6.9255, 3.8547, -66.55, -1.25, -23.15], [-4.1487, 6.9255, 4.0181, -67.75, 4.6, -21.2], [-4.0181, 6.9908, 4.2141, -69.7, 11.2, -18.45], [-3.8547, 7.1541, 4.3448, -72.65, 18.8, -15.65], [-3.7241, 7.3501, 4.4428, -75.65, 25.25, -12.65], [-3.5934, 7.4808, 4.5081, -78.8, 30.95, -9.75], [-3.4301, 7.6115, 4.5081, -82.05, 35.5, -7.1], [-3.2994, 7.6768, 4.5408, -85.1, 38.65, -5.1], [-3.2014, 7.6441, 4.5734, -87.75, 40.15, -4.0], [-3.1034, 7.5788, 4.6061, -89.85, 40.3, -3.85], [-3.0707, 7.5135, 4.6388, -91.35, 39.55, -4.45], [-3.0707, 7.4808, 4.6714, -92.25, 38.35, -5.6], [-3.0707, 7.5461, 4.7041, -92.4, 37.0, -7.1], [-3.0707, 7.6768, 4.6714, -91.65, 36.05, -8.45], [-3.0381, 7.9055, 4.5734, -90.15, 35.55, -9.5], [-3.0054, 8.2322, 4.3774, -88.1, 35.55, -10.05], [-2.9074, 8.6568, 4.1161, -86.0, 36.1, -10.05], [-2.8421, 9.1142, 3.7894, -84.05, 37.05, -9.45], [-2.7767, 9.5715, 3.4954, -82.25, 38.15, -8.1], [-2.6787, 10.0942, 3.2667, -80.45, 39.05, -6.15], [-2.6134, 10.5189, 3.1361, -78.6, 39.5, -3.55], [-2.5154, 10.9109, 3.2014, -76.4, 39.45, -0.05], [-2.4827, 11.2702, 3.3974, -73.1, 38.95, 3.45], [-2.45, 11.5969, 3.7567, -68.7, 38.3, 7.25], [-2.4174, 11.8256, 4.1814, -62.15, 37.55, 11.25], [-2.352, 12.0542, 4.6061, -53.0, 36.7, 15.1], [-2.254, 12.1849, 4.9001, -41.6, 35.75, 18.5], [-2.156, 12.3156, 5.0308, -28.55, 35.15, 21.25], [-2.0907, 12.4462, 4.9328, -14.2, 35.25, 23.5], [-2.0907, 12.4789, 4.6714, 1.05, 36.35, 25.45], [-2.1234, 12.4462, 4.2141, 16.65, 38.3, 27.45], [-2.2214, 12.2829, 3.5607, 31.35, 41.2, 30.0], [-2.3194, 12.0869, 2.9727, 44.85, 45.45, 32.95], [-2.45, 11.8582, 2.548, 53.0, 49.7, 36.95], [-2.6461, 11.5642, 2.3847, 57.7, 53.65, 42.3], [-2.8747, 11.3029, 2.5807, 59.9, 56.4, 48.8], [-3.0381, 11.0415, 3.1361, 60.6, 57.0, 55.85], [-3.1687, 10.8129, 4.0834, 60.75, 54.9, 62.85], [-3.2667, 10.6822, 5.3248, 61.45, 49.95, 69.1], [-3.3647, 10.6169, 6.7621, 64.4, 42.0, 74.25], [-3.4627, 10.6169, 8.3628, 71.5, 31.2, 77.8], [-3.6261, 10.6495, 9.6042, 83.7, 16.7, 79.15], [-3.7894, 10.6822, 10.4862, 102.85, 3.2, 77.55], [-3.9854, 10.6169, 10.8782, 122.5, -9.35, 73.85], [-4.2141, 10.5842, 10.8455, 142.0, -20.0, 69.05], [-4.4754, 10.4535, 10.3229, 159.1, -28.3, 63.95], [-4.7041, 10.3229, 9.5062, 172.2, -34.1, 59.1], [-4.9328, 10.0289, 8.5262, 180.2, -37.3, 54.65], [-5.1288, 9.7675, 7.4808, 182.55, -37.95, 50.9], [-5.2594, 9.4409, 6.5335, 179.35, -36.75, 48.4], [-5.3574, 9.0815, 5.6841, 171.7, -34.7, 47.25], [-5.3574, 8.6568, 5.2268, 159.75, -32.65, 47.5], [-5.3574, 8.2322, 4.9654, 148.2, -31.95, 48.15], [-5.2594, 7.8075, 4.9001, 137.4, -32.7, 48.75], [-5.1288, 7.2848, 4.9654, 128.15, -35.25, 49.05], [-4.9328, 6.7948, 5.0634, 120.65, -39.65, 48.8], [-4.7041, 6.3048, 5.1941, 114.9, -46.1, 47.95], [-4.4754, 5.7494, 5.2921, 110.7, -54.2, 46.25], [-4.1814, 5.2594, 5.3248, 108.0, -63.25, 43.4], [-3.8874, 4.8348, 5.3248, 106.4, -72.6, 39.4], [-3.6261, 4.4101, 5.1941, 105.4, -82.65, 33.4], [-3.2994, 3.9854, 4.9981, 104.15, -90.7, 26.95], [-3.0707, 3.5607, 4.7368, 102.15, -97.3, 19.6], [-2.9074, 3.1034, 4.4428, 98.85, -102.1, 11.6], [-2.7767, 2.7114, 4.1161, 94.05, -104.65, 3.3], [-2.7441, 2.352, 3.7567, 87.55, -104.85, -4.8], [-2.7767, 2.0254, 3.4627, 79.35, -102.75, -12.2], [-2.9074, 1.7967, 3.2014, 69.75, -98.5, -18.35], [-3.0707, 1.7314, 2.9074, 59.1, -92.2, -23.0], [-3.2341, 1.8294, 2.6787, 48.1, -84.2, -25.95], [-3.3647, 2.0907, 2.3847, 37.25, -74.9, -27.45], [-3.4627, 2.5154, 1.96, 25.5, -63.5, -27.25], [-3.5281, 3.2014, 1.372, 15.4, -52.7, -25.9], [-3.5607, 4.2141, 0.5553, 5.45, -41.65, -23.4], [-3.5281, 5.4881, -0.392, -4.85, -31.15, -19.7], [-3.3647, 7.0561, -1.3394, -15.85, -21.95, -14.95], [-3.1361, 8.7875, -2.254, -26.5, -14.3, -9.85], [-2.9074, 10.8782, -3.1034, -35.4, -8.4, -5.2], [-2.7114, 12.7076, -3.8221, -41.8, -4.45, -1.35], [-2.5154, 14.4063, -4.3774, -45.35, -2.8, 1.75], [-2.3194, 15.7456, -4.5081, -46.15, -4.6, 4.1], [-2.1234, 16.497, -4.2467, -43.9, -9.85, 4.6], [-1.96, 16.6277, -3.7241, -38.45, -17.55, 2.45], [-1.96, 16.301, -3.0707, -29.3, -26.95, -2.65], [-2.156, 15.5496, -2.3847, -18.3, -37.6, -9.45], [-2.4827, 14.5043, -1.6334, -8.2, -48.2, -16.55], [-2.9727, 13.0343, -0.8167, -0.8, -57.0, -22.8], [-3.5281, 11.7276, 0.098, 3.15, -62.6, -27.5], [-4.1487, 10.5842, 0.98, 3.7, -64.1, -30.55], [-4.7694, 9.8329, 1.862, 1.9, -61.55, -31.85], [-5.3901, 9.4409, 2.5807, -1.7, -54.55, -30.65], [-5.9128, 9.3102, 3.2014, -5.65, -44.9, -27.05], [-6.2721, 9.3102, 3.6914, -9.55, -32.3, -21.45], [-6.4028, 9.3102, 4.0507, -13.4, -18.25, -14.6], [-6.2721, 9.2448, 4.2141, -17.5, -5.05, -7.75], [-5.9454, 8.9508, 4.3121, -22.2, 5.8, -2.2], [-5.5534, 8.2975, 4.2794, -27.5, 14.15, 1.85], [-5.0961, 7.3828, 4.2467, -34.1, 20.95, 4.6], [-4.5081, 6.2395, 4.1814, -43.55, 27.05, 6.45], [-3.8547, 5.0308, 4.2467, -57.3, 32.35, 7.05], [-3.2014, 4.0507, 4.4754, -77.55, 36.45, 5.9], [-2.548, 3.4627, 4.8348, -97.1, 38.6, 3.2], [-2.0254, 3.3647, 5.3574, -114.7, 40.3, -0.6], [-1.5354, 3.7894, 5.8474, -128.05, 41.75, -4.7], [-1.2414, 4.5734, 6.2395, -136.5, 42.65, -8.7], [-1.078, 5.6841, 6.4355, -140.6, 42.4, -12.3], [-1.078, 6.9908, 6.5335, -140.7, 40.35, -15.25], [-1.2087, 8.0688, 6.5008, -136.75, 36.4, -17.55], [-1.4047, 8.8855, 6.2395, -129.15, 30.9, -19.35], [-1.764, 9.3428, 5.8801, -118.95, 23.2, -21.05], [-2.1887, 9.4082, 5.4881, -106.75, 15.45, -22.25], [-2.6134, 9.2122, 5.0634, -96.85, 7.8, -23.1], [-3.0054, 8.7875, 4.7041, -88.55, 0.95, -23.7], [-3.3647, 8.2648, 4.4754, -81.7, -4.7, -24.45], [-3.5607, 7.7422, 4.3121, -76.05, -8.75, -25.5], [-3.7567, 7.2848, 4.2141, -71.6, -10.7, -26.55], [-3.9201, 7.0561, 4.1487, -68.5, -10.2, -27.1], [-4.0181, 6.9581, 4.1487, -66.75, -7.1, -26.8], [-4.0507, 6.9908, 4.1487, -66.25, -1.95, -25.4], [-4.0834, 7.0888, 4.1814, -67.1, 5.05, -23.45], [-4.0507, 7.2195, 4.1814, -69.0, 11.55, -21.1], [-4.0181, 7.3501, 4.1814, -71.7, 17.65, -18.6], [-3.9854, 7.4481, 4.2141, -74.85, 22.95, -16.0], [-3.8874, 7.5135, 4.2141, -78.05, 27.25, -13.65], [-3.7894, 7.4808, 4.2141, -81.15, 30.4, -11.7], [-3.6587, 7.4155, 4.2467, -84.05, 32.4, -10.4], [-3.5607, 7.3175, 4.2794, -86.9, 33.4, -9.75], [-3.4627, 7.2195, 4.3121, -89.65, 33.85, -9.45], [-3.3974, 7.2195, 4.3448, -92.0, 34.1, -9.4], [-3.3321, 7.2848, 4.3448, -94.0, 34.35, -9.3], [-3.2341, 7.4808, 4.2467, -95.05, 34.8, -9.05], [-3.1687, 7.7748, 4.1161, -95.65, 35.3, -8.45], [-3.0707, 8.1995, 3.9201, -96.0, 35.75, -7.45], [-2.9401, 8.6895, 3.7241, -95.95, 36.1, -5.95], [-2.8747, 9.2122, 3.5607, -95.3, 36.35, -4.05], [-2.7767, 9.8329, 3.4627, -94.0, 36.35, -1.85], [-2.6787, 10.3555, 3.4627, -91.9, 36.05, 0.6], [-2.5807, 10.8782, 3.6587, -88.9, 35.45, 3.2], [-2.5154, 11.3356, 3.9527, -84.5, 34.5, 6.1], [-2.3847, 11.7276, 4.3774, -77.25, 33.55, 8.5], [-2.2214, 12.1196, 4.7694, -68.45, 32.55, 10.8], [-2.0254, 12.4462, 5.0634, -57.8, 31.45, 12.75], [-1.764, 12.7729, 5.2594, -45.9, 30.3, 14.5], [-1.5354, 13.0669, 5.2921, -33.25, 29.35, 16.05], [-1.372, 13.3936, 5.1941, -19.6, 28.65, 17.45], [-1.274, 13.5896, 4.9328, -4.7, 28.4, 19.05], [-1.3067, 13.6876, 4.5081, 11.25, 28.6, 21.15], [-1.4374, 13.6549, 3.9527, 27.3, 29.4, 24.35], [-1.6987, 13.4589, 3.4627, 44.0, 31.1, 28.0], [-2.058, 13.1323, 3.1034, 56.9, 33.05, 32.45], [-2.5154, 12.6749, 2.9401, 67.6, 34.7, 37.75], [-3.0381, 12.1849, 3.0381, 76.1, 35.55, 43.65], [-3.6914, 11.5969, 3.3647, 82.15, 35.35, 50.05], [-4.2141, 11.0089, 4.0834, 85.85, 34.0, 56.55], [-4.6388, 10.4862, 5.0634, 88.15, 31.45, 62.65], [-4.9654, 10.1922, 6.2721, 90.65, 27.25, 68.1], [-5.2594, 10.0289, 7.5461, 95.35, 21.4, 72.65], [-5.4554, 9.9962, 8.8528, 103.35, 14.5, 76.05], [-5.5861, 9.9962, 9.7675, 116.75, 6.75, 77.25], [-5.5861, 10.0615, 10.2902, 131.6, 0.55, 76.95], [-5.5208, 10.0942, 10.3555, 147.45, -4.7, 75.45], [-5.3901, 10.0942, 10.0615, 162.05, -9.2, 73.2], [-5.2268, 10.0289, 9.4082, 173.55, -12.8, 70.25], [-5.1288, 9.9309, 8.5915, 180.4, -15.25, 66.9], [-5.0308, 9.7022, 7.7095, 182.15, -16.45, 63.45], [-4.9328, 9.3755, 6.9255, 179.1, -16.75, 60.5], [-4.8674, 9.0488, 6.3048, 172.05, -16.8, 58.5], [-4.8021, 8.6568, 5.8474, 162.35, -17.3, 57.05], [-4.8021, 8.1668, 5.6514, 150.1, -18.95, 56.0], [-4.7694, 7.7095, 5.6188, 139.5, -21.75, 55.0], [-4.7041, 7.1541, 5.6841, 130.25, -26.05, 53.9], [-4.6061, 6.5988, 5.7494, 122.65, -31.9, 52.65], [-4.4754, 6.0435, 5.8474, 116.5, -39.45, 51.0], [-4.2794, 5.4554, 5.8801, 111.55, -48.45, 48.6], [-4.0834, 4.8348, 5.8474, 107.55, -58.15, 45.1], [-3.8221, 4.3121, 5.7494, 104.35, -67.95, 40.6], [-3.5607, 3.8221, 5.5861, 101.8, -77.1, 35.0], [-3.2994, 3.3321, 5.3574, 99.5, -85.95, 27.6], [-3.0381, 2.8747, 5.0634, 96.6, -92.05, 20.25], [-2.8421, 2.4174, 4.7041, 93.3, -96.2, 12.3], [-2.6787, 2.0254, 4.3121, 88.95, -98.2, 4.1], [-2.5807, 1.6987, 3.8547, 83.45, -98.2, -4.05], [-2.5807, 1.4374, 3.4627, 76.65, -96.3, -11.55], [-2.6461, 1.3394, 2.9727, 68.7, -92.65, -18.0], [-2.8094, 1.4047, 2.5154, 59.85, -87.3, -23.05], [-2.9727, 1.6334, 2.0254, 50.2, -80.4, -26.6], [-3.1361, 2.058, 1.4047, 40.0, -72.35, -28.9], [-3.2994, 2.7767, 0.7187, 28.2, -61.8, -29.45], [-3.4627, 3.7567, -0.1307, 17.5, -51.1, -28.55], [-3.5934, 5.0634, -1.0454, 6.05, -39.8, -25.75], [-3.5934, 6.6315, -1.9274, -6.35, -28.8, -21.55], [-3.4301, 8.3628, -2.7114, -18.7, -18.8, -16.7], [-3.2667, 10.1922, -3.3647, -29.45, -10.15, -11.9], [-3.1034, 12.2502, -3.9201, -37.6, -3.2, -7.45], [-2.9401, 13.9163, -4.3121, -42.65, 1.75, -3.3], [-2.7114, 15.2556, -4.4101, -45.1, 3.7, 0.5], [-2.45, 16.0396, -4.1161, -45.3, 1.35, 3.55], [-2.254, 16.301, -3.5934, -41.7, -4.1, 3.8], [-2.156, 16.0723, -3.0054, -34.7, -11.7, 1.6], [-2.1887, 15.4516, -2.352, -25.8, -21.05, -2.15], [-2.3847, 14.5696, -1.6987, -17.15, -31.1, -6.65], [-2.7441, 13.4263, -0.98, -10.55, -40.35, -11.4], [-3.2014, 12.2829, -0.1633, -6.85, -47.4, -15.95], [-3.7894, 11.2049, 0.6207, -5.75, -50.95, -19.7], [-4.4101, 10.6822, 1.372, -6.75, -50.7, -22.05], [-4.9654, 10.4535, 2.156, -9.2, -47.45, -22.55], [-5.4228, 10.4862, 2.7767, -12.25, -40.5, -21.0], [-5.7821, 10.5515, 3.2994, -15.5, -31.05, -17.95], [-5.9781, 10.5842, 3.7567, -18.2, -19.25, -13.35], [-5.9454, 10.4535, 4.0507, -20.9, -7.4, -7.8], [-5.6188, 10.0289, 4.2467, -23.95, 2.4, -2.55], [-5.1288, 9.1468, 4.3448, -27.15, 9.15, 1.05], [-4.6714, 7.9055, 4.3774, -30.65, 13.95, 2.6], [-4.2141, 6.1415, 4.3448, -36.35, 18.65, 2.85], [-3.7894, 4.5734, 4.2794, -46.25, 23.7, 2.45], [-3.2994, 3.2667, 4.3448, -61.15, 27.85, 1.2], [-2.7767, 2.45, 4.5408, -79.5, 30.55, -1.75], [-2.2867, 2.254, 4.8674, -100.6, 31.95, -5.55], [-1.862, 2.7441, 5.2921, -116.45, 33.8, -9.5], [-1.568, 3.8221, 5.6841, -128.2, 36.4, -12.85], [-1.3394, 5.2268, 6.0108, -135.55, 38.65, -15.3], [-1.176, 6.7621, 6.2721, -138.45, 38.8, -16.95], [-1.1107, 8.3302, 6.3701, -136.65, 36.05, -18.4], [-1.2087, 9.4082, 6.3048, -130.4, 30.9, -19.9], [-1.47, 10.0615, 6.0761, -120.4, 24.3, -21.5], [-1.862, 10.1595, 5.7168, -108.6, 16.8, -23.3], [-2.2867, 9.8329, 5.2268, -95.85, 7.95, -24.9], [-2.6787, 9.2122, 4.7694, -86.75, 0.2, -26.5], [-3.0381, 8.4935, 4.4101, -80.25, -6.85, -28.25], [-3.3974, 7.7748, 4.1487, -75.85, -12.45, -30.3], [-3.6587, 7.2195, 4.0181, -72.75, -15.6, -32.35], [-3.8874, 6.7948, 3.9854, -70.7, -15.9, -33.75], [-4.0507, 6.5988, 4.0181, -69.65, -13.45, -34.05], [-4.1487, 6.5988, 4.0834, -69.8, -8.75, -33.25], [-4.2141, 6.7295, 4.1814, -71.0, -2.75, -31.35], [-4.2467, 6.9255, 4.2467, -72.9, 4.75, -28.25], [-4.2467, 7.1215, 4.3121, -75.4, 11.55, -24.85], [-4.1814, 7.2848, 4.3448, -78.1, 17.9, -21.1], [-4.1161, 7.3828, 4.3448, -81.2, 23.3, -17.5], [-3.9854, 7.4481, 4.3121, -84.7, 27.4, -14.5], [-3.8547, 7.4155, 4.3448, -88.3, 30.15, -12.45], [-3.7567, 7.3175, 4.3448, -91.75, 31.8, -11.35], [-3.6587, 7.2195, 4.3774, -94.95, 32.7, -11.05], [-3.5934, 7.1868, 4.4101, -97.85, 33.2, -11.35], [-3.5281, 7.2521, 4.4428, -100.15, 33.5, -11.95], [-3.4627, 7.4155, 4.4101, -101.75, 33.95, -12.4], [-3.3974, 7.7095, 4.2794, -102.25, 34.65, -12.4], [-3.3321, 8.1015, 4.1161, -101.95, 35.65, -11.7], [-3.2341, 8.5915, 3.8874, -101.1, 36.8, -10.15], [-3.1361, 9.1795, 3.6261, -99.7, 38.1, -7.8], [-3.0707, 9.8002, 3.3647, -97.6, 39.45, -4.55], [-3.0054, 10.4535, 3.2014, -94.85, 40.8, -0.55], [-2.9401, 10.9762, 3.1361, -91.35, 42.15, 4.2], [-2.9074, 11.4662, 3.2341, -87.0, 43.45, 9.4], [-2.8747, 11.8582, 3.4954, -81.35, 44.75, 15.35], [-2.8094, 12.1849, 3.8221, -72.75, 46.15, 20.45], [-2.6787, 12.4462, 4.2141, -62.9, 47.35, 25.2], [-2.5154, 12.6422, 4.5408, -51.35, 48.35, 29.35], [-2.2214, 12.8056, 4.7368, -38.65, 49.05, 32.6], [-1.96, 12.9689, 4.7694, -25.25, 49.5, 34.75], [-1.7314, 13.0996, 4.7041, -11.05, 49.8, 35.95], [-1.5354, 13.1976, 4.4428, 4.0, 49.8, 36.5], [-1.4374, 13.1976, 4.0507, 19.35, 49.7, 37.05], [-1.4374, 13.1323, 3.5607, 33.85, 49.55, 37.95], [-1.47, 12.9689, 3.1687, 46.35, 49.35, 39.8], [-1.6334, 12.7076, 2.9727, 57.35, 48.7, 42.55], [-1.8947, 12.4136, 3.0381, 64.65, 46.75, 46.4], [-2.2867, 12.0542, 3.4301, 70.3, 43.15, 51.0], [-2.7441, 11.6949, 4.1487, 74.65, 37.85, 55.95], [-3.1361, 11.3356, 5.1614, 78.4, 30.95, 60.9], [-3.5281, 11.0089, 6.4028, 82.65, 22.7, 65.35], [-3.8874, 10.8455, 7.7748, 89.05, 12.95, 69.0], [-4.2467, 10.7802, 9.1142, 99.0, 2.1, 71.4], [-4.6061, 10.8129, 10.3555, 113.05, -8.65, 71.9], [-4.9328, 10.7802, 11.0089, 133.0, -18.9, 70.55], [-5.1288, 10.7802, 11.2049, 152.1, -25.7, 68.25], [-5.2921, 10.7475, 10.9109, 170.0, -30.55, 65.7], [-5.3574, 10.6822, 10.2902, 184.45, -33.75, 63.0], [-5.4554, 10.4862, 9.3428, 193.95, -35.3, 60.15], [-5.5208, 10.2249, 8.2975, 197.55, -35.3, 57.35], [-5.5861, 9.8002, 7.3175, 195.25, -34.1, 55.05], [-5.6188, 9.3755, 6.5008, 187.8, -32.4, 53.75], [-5.6514, 8.8202, 5.8474, 176.65, -30.9, 53.6], [-5.7168, 8.2648, 5.5534, 163.8, -29.95, 54.2], [-5.7168, 7.6115, 5.3901, 149.65, -30.0, 54.9], [-5.6514, 6.9581, 5.3901, 138.6, -31.2, 55.55], [-5.5208, 6.2721, 5.4228, 129.3, -34.05, 56.15], [-5.2594, 5.6188, 5.4554, 121.85, -38.55, 56.3], [-4.9328, 5.0308, 5.4554, 116.05, -44.5, 55.5], [-4.5081, 4.4754, 5.3901, 111.6, -51.55, 53.45], [-4.0834, 3.8874, 5.2594, 107.95, -59.6, 49.75], [-3.5934, 3.4301, 5.0308, 104.55, -68.25, 44.35], [-3.1687, 2.9727, 4.7694, 100.95, -76.9, 37.25], [-2.7767, 2.548, 4.5081, 96.7, -85.95, 27.45], [-2.4174, 2.1234, 4.2467, 91.1, -92.65, 17.4], [-2.1887, 1.764, 3.9854, 85.4, -97.6, 6.75], [-2.0907, 1.4047, 3.7567, 78.85, -100.8, -3.9], [-2.1234, 1.1434, 3.4954, 71.5, -102.0, -13.9], [-2.254, 0.98, 3.2014, 63.4, -100.85, -22.6], [-2.4827, 1.0127, 2.9074, 54.8, -97.3, -29.45], [-2.7441, 1.2087, 2.548, 45.95, -91.4, -34.2], [-3.0054, 1.6334, 2.1234, 37.0, -83.4, -36.6], [-3.2667, 2.2867, 1.4047, 27.75, -73.55, -36.45], [-3.4954, 3.2667, 0.5553, 16.7, -60.15, -34.05], [-3.6587, 4.5408, -0.392, 5.8, -47.05, -29.5], [-3.7241, 6.1088, -1.372, -6.55, -34.1, -23.2], [-3.6587, 7.9382, -2.2214, -19.5, -21.85, -16.0], [-3.4954, 9.8655, -2.9727, -31.35, -10.8, -8.6], [-3.3647, 11.8256, -3.6261, -40.8, -1.65, -1.65], [-3.1687, 13.8836, -4.0834, -46.95, 5.3, 4.45], [-2.9401, 15.419, -4.2141, -49.85, 9.1, 9.4], [-2.6787, 16.399, -4.0181, -49.8, 8.55, 12.6], [-2.4174, 16.7583, -3.5281, -46.3, 3.35, 13.05], [-2.254, 16.595, -2.9727, -37.5, -4.2, 10.05], [-2.1887, 16.007, -2.4174, -26.9, -14.35, 4.55], [-2.254, 15.0923, -1.862, -16.4, -26.25, -2.75], [-2.548, 13.9489, -1.2087, -8.2, -38.2, -11.15], [-3.0381, 12.8056, -0.49, -3.5, -48.65, -19.4], [-3.6914, 11.7276, 0.2613, -2.15, -55.95, -26.25], [-4.3774, 11.1069, 1.0454, -2.8, -59.05, -30.95], [-5.0308, 10.8129, 1.764, -4.55, -58.5, -33.35], [-5.6188, 10.7475, 2.5807, -6.5, -54.65, -33.05], [-6.1088, 10.7149, 3.1687, -8.25, -45.8, -30.2], [-6.4681, 10.6169, 3.6914, -9.15, -34.65, -24.75], [-6.5661, 10.2902, 4.0834, -9.85, -22.3, -17.5], [-6.3701, 9.6369, 4.2794, -10.9, -10.85, -10.3], [-5.9128, 8.5915, 4.4428, -12.95, -1.7, -5.0], [-5.5208, 7.2521, 4.4428, -16.9, 5.7, -1.95], [-5.1288, 5.5208, 4.3448, -24.2, 13.15, -0.15], [-4.7041, 4.0507, 4.2794, -36.75, 21.15, 1.3], [-4.1487, 2.8421, 4.3121, -54.9, 28.5, 1.95], [-3.5281, 2.156, 4.5408, -77.1, 35.1, 1.1], [-2.8747, 2.1234, 4.8674, -103.25, 39.9, -0.9], [-2.2867, 2.8094, 5.3574, -123.55, 44.6, -3.2], [-1.7967, 3.9527, 5.8474, -138.7, 49.35, -5.15], [-1.3067, 5.4554, 6.2068, -148.2, 52.9, -6.55], [-0.98, 6.9581, 6.4681, -152.4, 53.5, -7.9], [-0.784, 8.3302, 6.5661, -151.4, 50.5, -9.65], [-0.8167, 9.5389, 6.4681, -145.45, 44.65, -11.9], [-1.0454, 10.0942, 6.2395, -135.35, 36.95, -14.55], [-1.47, 10.2249, 5.7494, -122.6, 27.95, -17.45], [-1.96, 9.8655, 5.1941, -109.8, 17.2, -20.75], [-2.45, 9.2775, 4.6388, -97.8, 8.1, -23.35], [-2.8747, 8.5915, 4.1487, -90.1, 0.25, -25.7], [-3.2994, 7.9382, 3.8221, -84.55, -5.55, -27.85], [-3.6587, 7.3828, 3.6587, -80.55, -8.45, -29.6], [-3.8874, 6.9908, 3.6261, -77.6, -8.4, -30.5], [-4.0507, 6.7948, 3.6587, -75.85, -5.45, -30.2], [-4.1161, 6.8275, 3.7567, -75.3, -0.2, -28.7], [-4.1487, 6.9908, 3.9201, -75.7, 6.35, -26.15], [-4.1161, 7.1868, 4.1161, -76.45, 13.35, -22.5], [-4.0507, 7.4155, 4.2467, -77.4, 21.05, -18.9], [-3.9854, 7.6115, 4.3448, -78.45, 27.1, -15.15], [-3.8874, 7.7422, 4.3448, -79.75, 32.0, -11.7], [-3.7567, 7.7748, 4.3774, -81.3, 35.45, -8.95], [-3.6261, 7.7095, 4.4101, -83.05, 37.45, -7.25], [-3.4954, 7.6441, 4.4428, -85.05, 38.15, -6.65], [-3.4301, 7.5135, 4.4754, -87.25, 38.0, -6.9], [-3.3647, 7.4155, 4.5081, -89.7, 37.4, -7.85], [-3.3321, 7.4155, 4.5734, -92.0, 36.6, -9.25], [-3.2667, 7.4808, 4.5734, -93.8, 35.45, -11.0], [-3.2341, 7.6768, 4.5081, -94.95, 34.45, -12.4], [-3.1361, 8.0035, 4.3448, -95.15, 33.55, -13.25], [-3.0707, 8.3955, 4.0834, -94.9, 32.75, -13.5], [-2.9727, 8.8855, 3.7567, -94.1, 32.15, -13.0], [-2.9074, 9.4082, 3.3974, -92.85, 31.75, -11.7], [-2.8747, 9.9309, 3.0707, -91.05, 31.7, -9.45], [-2.8421, 10.4535, 2.8421, -88.85, 32.05, -6.2], [-2.8094, 10.9109, 2.7767, -86.2, 32.8, -2.15], [-2.7767, 11.3029, 2.9401, -82.8, 33.9, 2.45], [-2.7441, 11.6622, 3.2994, -78.05, 35.35, 7.95], [-2.6461, 11.9889, 3.7241, -70.4, 36.65, 12.85], [-2.4827, 12.2829, 4.2467, -61.35, 37.65, 17.4], [-2.254, 12.5442, 4.7041, -50.35, 38.0, 21.3], [-1.96, 12.8056, 5.0961, -37.65, 37.7, 24.2], [-1.6987, 13.0343, 5.3248, -23.15, 36.95, 26.1], [-1.5027, 13.2629, 5.3574, -6.85, 35.75, 27.2], [-1.4374, 13.3609, 5.1941, 11.0, 34.45, 27.95], [-1.47, 13.3283, 4.8674, 29.55, 33.25, 28.85], [-1.6007, 13.1649, 4.3121, 47.35, 32.45, 30.5], [-1.8294, 12.8709, 3.8221, 64.95, 32.2, 32.7], [-2.156, 12.4462, 3.4301, 77.4, 32.1, 36.0], [-2.5807, 11.9889, 3.2014, 86.5, 31.45, 40.35], [-3.1034, 11.4336, 3.2994, 92.2, 29.85, 45.5], [-3.6914, 10.8782, 3.7567, 94.7, 27.35, 50.85], [-4.1814, 10.3882, 4.5408, 94.95, 24.05, 56.2], [-4.6061, 10.0615, 5.5861, 94.75, 19.8, 61.2], [-4.9981, 9.8982, 6.7948, 96.05, 14.5, 65.65], [-5.3248, 9.8655, 8.1995, 100.4, 8.35, 69.2], [-5.5861, 9.9309, 9.2448, 108.65, 1.6, 71.45], [-5.7494, 9.9962, 9.9309, 122.5, -3.35, 71.85], [-5.7821, 10.1269, 10.2249, 137.2, -7.25, 71.4], [-5.7168, 10.1922, 10.0615, 151.85, -10.55, 70.5], [-5.5208, 10.2575, 9.5389, 164.1, -13.35, 69.0], [-5.3248, 10.1595, 8.7548, 172.25, -15.8, 66.65], [-5.1614, 9.9635, 7.9055, 175.55, -17.65, 63.5], [-4.9981, 9.6695, 7.0888, 174.15, -19.05, 60.15], [-4.9001, 9.3102, 6.4355, 168.75, -20.5, 57.25], [-4.8021, 8.8855, 5.9454, 160.65, -22.4, 54.85], [-4.8021, 8.3628, 5.7168, 151.25, -25.15, 52.4], [-4.7694, 7.8075, 5.6841, 141.15, -28.25, 50.15], [-4.7694, 7.2195, 5.7168, 133.5, -32.25, 47.95], [-4.7041, 6.5988, 5.7821, 127.45, -37.4, 46.0], [-4.5734, 6.0108, 5.8474, 122.75, -43.85, 44.3], [-4.4101, 5.4554, 5.8474, 119.0, -51.4, 42.4], [-4.1814, 4.8021, 5.7494, 115.8, -59.55, 39.9], [-3.8874, 4.2794, 5.6188, 112.8, -67.85, 36.5], [-3.5934, 3.7894, 5.4228, 109.85, -76.05, 32.2], [-3.2994, 3.3321, 5.1288, 106.65, -83.6, 26.4], [-3.0054, 2.8747, 4.8348, 102.55, -90.6, 20.4], [-2.8094, 2.45, 4.5081, 98.35, -95.0, 13.7], [-2.6787, 2.058, 4.1487, 93.4, -97.6, 6.5], [-2.5807, 1.7314, 3.7567, 87.7, -98.35, -0.8], [-2.6134, 1.47, 3.3974, 81.05, -97.4, -7.8], [-2.7441, 1.3394, 2.9727, 73.4, -94.65, -13.9], [-2.8747, 1.372, 2.4827, 64.75, -90.05, -18.85], [-3.1034, 1.568, 1.9927, 55.1, -83.8, -22.45], [-3.2667, 1.9927, 1.3394, 44.75, -76.3, -24.75], [-3.4301, 2.6787, 0.6207, 34.1, -66.1, -25.8], [-3.5934, 3.6587, -0.2613, 22.05, -55.5, -25.35], [-3.6914, 4.9328, -1.2087, 10.45, -44.35, -23.3], [-3.6914, 6.4681, -2.0907, -2.15, -33.55, -20.05], [-3.6587, 8.1668, -2.8747, -14.8, -23.75, -16.4], [-3.5281, 9.9635, -3.4954, -25.95, -15.4, -12.6], [-3.4627, 11.7929, -3.9527, -34.45, -8.65, -8.9], [-3.3647, 13.6876, -4.2467, -39.95, -3.85, -5.25], [-3.2341, 14.929, -4.2467, -43.2, -1.8, -1.65], [-3.0707, 15.713, -3.8221, -44.65, -3.45, 1.25], [-2.9074, 15.9416, -3.2667, -43.05, -8.75, 2.25], [-2.8094, 15.713, -2.6134, -37.05, -15.5, 1.15], [-2.7767, 15.0923, -1.9927, -29.5, -23.75, -1.4], [-2.8421, 14.1449, -1.4047, -22.2, -32.4, -5.1], [-3.1034, 13.0016, -0.8167, -17.3, -40.1, -9.7], [-3.5281, 11.8909, -0.1633, -15.75, -45.8, -14.55], [-4.1161, 10.9762, 0.4573, -17.05, -48.55, -18.8], [-4.7368, 10.5515, 1.078, -20.0, -48.2, -21.85], [-5.3574, 10.4209, 1.666, -23.8, -45.2, -23.3], [-5.9128, 10.4535, 2.3194, -27.7, -39.4, -23.0], [-6.3701, 10.5515, 2.8421, -31.7, -29.15, -20.7], [-6.6315, 10.5842, 3.3321, -35.0, -17.95, -16.4], [-6.5988, 10.3555, 3.7241, -37.95, -7.1, -10.7], [-6.3048, 9.7675, 4.0834, -40.3, 1.85, -4.9], [-5.6514, 8.7222, 4.3774, -42.25, 8.95, -0.55], [-5.0308, 7.3175, 4.5081, -45.05, 15.25, 2.05], [-4.4101, 5.4881, 4.5734, -50.75, 22.15, 3.7], [-3.7567, 3.9201, 4.6061, -61.15, 29.05, 4.7], [-3.0381, 2.6787, 4.7368, -76.1, 34.55, 4.6], [-2.352, 2.0254, 4.9981, -93.65, 38.25, 2.9], [-1.764, 1.9927, 5.3574, -113.0, 41.45, 0.1], [-1.372, 2.6787, 5.7494, -127.5, 44.1, -3.35], [-1.1434, 3.9201, 6.1088, -138.0, 46.3, -6.6], [-1.0454, 5.4228, 6.3701, -144.1, 47.05, -9.15], [-1.0454, 7.0235, 6.5661, -145.5, 45.15, -11.3], [-1.176, 8.3955, 6.6315, -142.1, 40.45, -13.6], [-1.4047, 9.6042, 6.5335, -134.5, 33.6, -16.05], [-1.8294, 10.1922, 6.2721, -123.7, 25.5, -18.8], [-2.2867, 10.2575, 5.8801, -111.3, 16.9, -21.55], [-2.7114, 9.9309, 5.4228, -99.0, 8.45, -23.95], [-3.0381, 9.3102, 4.9654, -88.3, -0.4, -26.35], [-3.2667, 8.6242, 4.6388, -79.15, -7.25, -28.6], [-3.4954, 7.9055, 4.4101, -73.35, -12.45, -30.9], [-3.6261, 7.3501, 4.3121, -69.3, -15.3, -32.75], [-3.7567, 6.9581, 4.3121, -66.5, -15.5, -33.75], [-3.8221, 6.7948, 4.3774, -64.85, -13.1, -33.55], [-3.8547, 6.7948, 4.4754, -64.4, -8.95, -32.15], [-3.8874, 6.8928, 4.5408, -65.1, -4.05, -29.95], [-3.9201, 7.0561, 4.6061, -66.6, 1.15, -27.1], [-3.9854, 7.2195, 4.6061, -68.6, 6.35, -23.45], [-3.9854, 7.3175, 4.5734, -70.9, 11.65, -20.05], [-3.9854, 7.3828, 4.5408, -72.95, 15.5, -16.95], [-3.9527, 7.3501, 4.4754, -75.15, 18.5, -14.35], [-3.9201, 7.2848, 4.4428, -77.55, 20.7, -12.4], [-3.8874, 7.2195, 4.4428, -80.15, 22.45, -11.0], [-3.8874, 7.1868, 4.3774, -82.65, 24.3, -9.95], [-3.8874, 7.2521, 4.3774, -84.8, 26.6, -8.95], [-3.8547, 7.3501, 4.3121, -86.45, 29.45, -7.85], [-3.7894, 7.5788, 4.2141, -87.55, 32.75, -6.45], [-3.7241, 7.8728, 3.9527, -88.3, 36.35, -4.45], [-3.6587, 8.2648, 3.6587, -88.95, 40.4, -2.25], [-3.5281, 8.7222, 3.3647, -89.4, 43.85, 0.4], [-3.4301, 9.1795, 3.1361, -89.45, 46.9, 3.4], [-3.2994, 9.6369, 2.9727, -89.1, 49.2, 6.65], [-3.1361, 10.0615, 2.9727, -88.1, 50.5, 10.15], [-2.9727, 10.4535, 3.1361, -86.15, 50.75, 13.65], [-2.8421, 10.9109, 3.4627, -82.7, 50.25, 17.05], [-2.7114, 11.2049, 3.9201, -77.25, 49.2, 20.3], [-2.548, 11.4662, 4.5081, -69.4, 47.95, 23.15], [-2.3194, 11.6949, 4.9001, -59.4, 46.2, 25.65], [-2.0907, 11.8909, 5.1614, -46.4, 44.35, 27.05], [-1.862, 12.0869, 5.2594, -33.9, 42.65, 27.65], [-1.666, 12.3156, 5.1288, -20.8, 41.55, 27.55], [-1.47, 12.5116, 4.8021, -7.15, 41.2, 27.3], [-1.4047, 12.6422, 4.3121, 6.75, 41.6, 27.35], [-1.4047, 12.7076, 3.7241, 20.3, 42.6, 28.05], [-1.47, 12.7076, 3.1687, 32.65, 44.25, 29.7], [-1.6334, 12.6096, 2.7114, 43.25, 46.2, 32.45], [-1.862, 12.4462, 2.4827, 52.0, 48.0, 36.5], [-2.2214, 12.1849, 2.548, 59.1, 48.55, 42.55], [-2.6134, 11.8582, 3.0054, 65.35, 47.25, 48.75], [-3.0381, 11.5316, 3.7567, 69.7, 44.0, 54.95], [-3.4627, 11.2049, 4.8674, 73.65, 38.9, 60.8], [-3.9201, 10.9762, 6.1741, 78.45, 32.05, 65.95], [-4.3448, 10.8129, 7.5135, 85.7, 23.8, 70.15], [-4.7694, 10.7475, 8.8202, 96.4, 14.7, 73.15], [-5.1614, 10.7149, 9.8655, 110.7, 5.9, 74.65], [-5.4881, 10.6495, 10.5189, 127.6, -1.35, 74.5], [-5.7168, 10.5842, 10.7149, 145.3, -6.8, 73.05], [-5.8474, 10.5189, 10.4209, 163.25, -10.75, 71.5], [-5.8801, 10.4209, 9.7349, 175.55, -12.55, 69.7], [-5.8801, 10.2575, 8.8855, 182.95, -12.95, 67.65], [-5.8474, 10.0289, 7.9055, 184.7, -12.25, 65.4], [-5.7168, 9.7675, 6.9908, 181.0, -11.0, 63.25], [-5.5861, 9.4082, 6.2395, 172.9, -9.9, 61.7], [-5.4228, 8.9835, 5.7494, 161.9, -9.7, 60.8], [-5.2594, 8.5262, 5.4554, 149.85, -10.7, 60.15], [-5.1288, 8.0362, 5.3574, 138.45, -13.25, 59.25], [-4.9654, 7.4481, 5.3574, 128.45, -18.3, 57.8], [-4.7694, 6.8601, 5.4228, 119.35, -24.9, 56.05], [-4.5408, 6.2721, 5.5534, 113.1, -33.55, 53.75], [-4.2794, 5.6188, 5.5861, 108.5, -43.8, 50.7], [-3.9527, 5.0634, 5.5861, 105.2, -55.0, 46.55], [-3.6587, 4.5408, 5.4881, 102.85, -66.65, 41.2], [-3.3321, 4.0507, 5.3248, 101.0, -78.15, 34.7], [-3.0381, 3.4954, 5.1288, 99.25, -88.85, 27.25], [-2.7767, 3.0381, 4.9001, 97.1, -98.2, 19.05], [-2.5807, 2.5807, 4.5734, 94.25, -105.6, 9.3], [-2.45, 2.156, 4.2467, 89.9, -111.05, 0.5], [-2.3847, 1.7967, 3.9201, 84.8, -113.35, -7.95], [-2.3847, 1.5027, 3.5934, 78.45, -113.45, -15.55], [-2.4827, 1.3394, 3.2341, 71.05, -111.3, -21.85], [-2.6787, 1.3067, 2.9074, 62.8, -107.05, -26.5], [-2.8747, 1.5027, 2.548, 54.0, -100.75, -29.25], [-3.0381, 1.9274, 2.1234, 44.95, -92.95, -30.15], [-3.2667, 2.548, 1.6334, 35.85, -83.9, -29.2], [-3.4301, 3.4627, 0.98, 26.95, -73.6, -26.65], [-3.6261, 4.6388, 0.0653, 18.0, -62.15, -21.7], [-3.7241, 6.0108, -0.784, 7.05, -48.5, -15.55], [-3.7567, 7.5461, -1.6334, -3.6, -36.45, -8.4], [-3.6587, 9.1795, -2.352, -14.2, -25.2, -1.25], [-3.4954, 10.8782, -3.0054, -23.55, -15.3, 5.2], [-3.3647, 12.4789, -3.4954, -30.65, -7.15, 10.4], [-3.1687, 13.8836, -3.8221, -35.15, -1.4, 14.3], [-2.9401, 14.9616, -3.8874, -37.75, 0.9, 16.55], [-2.6461, 15.419, -3.6587, -38.5, -1.3, 16.15], [-2.3847, 15.4516, -3.1361, -36.45, -7.65, 12.4], [-2.254, 15.1576, -2.5807, -31.45, -19.25, 4.7], [-2.254, 14.5369, -1.9927, -23.7, -32.2, -3.9], [-2.45, 13.6876, -1.3394, -16.8, -45.8, -12.9], [-2.8094, 12.6749, -0.6533, -11.55, -58.25, -21.45], [-3.3974, 11.6622, 0.0653, -8.75, -67.7, -28.5], [-3.9527, 10.8129, 0.7513, -8.05, -72.5, -33.35], [-4.5734, 10.1922, 1.372, -9.3, -72.35, -35.65], [-5.1288, 9.8655, 1.9274, -12.25, -67.95, -35.3], [-5.6514, 9.7022, 2.4174, -16.1, -59.8, -32.9], [-6.0761, 9.6369, 2.8421, -20.2, -48.45, -28.05], [-6.3375, 9.5715, 3.1361, -25.0, -33.35, -22.15], [-6.3701, 9.3755, 3.2994, -29.5, -19.95, -15.85], [-6.2395, 9.0162, 3.4301, -34.5, -8.5, -10.75], [-6.0108, 8.3628, 3.5934, -40.2, 0.1, -7.5], [-5.7494, 7.4808, 3.7567, -46.5, 7.15, -5.65], [-5.4228, 6.4355, 3.8874, -54.2, 14.25, -4.3], [-4.9328, 5.1941, 4.0834, -64.7, 21.65, -3.0], [-4.3121, 4.2141, 4.3448, -78.25, 28.55, -2.3], [-3.6261, 3.6261, 4.7694, -93.95, 34.35, -2.85], [-2.9727, 3.4301, 5.2594, -109.7, 39.65, -4.35], [-2.3847, 3.7894, 5.7494, -124.35, 43.5, -5.85], [-1.862, 4.5408, 6.1741, -132.95, 46.45, -7.2], [-1.47, 5.5534, 6.4355, -137.55, 47.75, -8.4], [-1.2087, 6.6641, 6.5661, -138.65, 46.7, -9.6], [-1.1434, 7.6768, 6.5661, -136.45, 43.5, -10.95], [-1.274, 8.5262, 6.4355, -131.45, 38.25, -12.35], [-1.568, 9.1468, 6.1741, -123.95, 31.45, -13.7], [-1.9927, 9.3102, 5.8801, -114.9, 23.75, -15.2], [-2.45, 9.1795, 5.4554, -105.6, 16.25, -16.5], [-2.8747, 8.7875, 5.1288, -97.3, 8.85, -17.55], [-3.2667, 8.3302, 4.8348, -89.35, 3.3, -18.4], [-3.5281, 7.8402, 4.6714, -83.45, -0.9, -19.25], [-3.7567, 7.4155, 4.5734, -78.3, -3.4, -20.1], [-3.9854, 7.1541, 4.5408, -73.9, -3.65, -20.55], [-4.0834, 7.0235, 4.5081, -70.5, -1.4, -20.35], [-4.1161, 7.0235, 4.5081, -68.3, 2.9, -19.15], [-4.0834, 7.1215, 4.5081, -67.5, 8.3, -17.3], [-4.0507, 7.2521, 4.5081, -68.05, 14.2, -15.05], [-3.9527, 7.3828, 4.4754, -69.75, 20.0, -12.35], [-3.8874, 7.5135, 4.4754, -72.45, 25.75, -10.15], [-3.7894, 7.6115, 4.4428, -74.9, 29.65, -8.25], [-3.6587, 7.6441, 4.4428, -77.1, 32.3, -6.8], [-3.5607, 7.6115, 4.4101, -79.05, 33.95, -5.95], [-3.4954, 7.5461, 4.4101, -80.9, 34.8, -5.55], [-3.4627, 7.5135, 4.4428, -82.5, 35.25, -5.55], [-3.4627, 7.5135, 4.4101, -83.8, 35.75, -5.5], [-3.4627, 7.5788, 4.3774, -84.75, 36.8, -5.2], [-3.4301, 7.7095, 4.2467, -85.5, 38.55, -4.45], [-3.3974, 7.9055, 4.0834, -86.2, 41.35, -3.0], [-3.3321, 8.1995, 3.8547, -87.05, 44.3, -1.15], [-3.2014, 8.5915, 3.6261, -87.65, 47.1, 1.15], [-3.1034, 9.0162, 3.3974, -87.9, 49.75, 3.8], [-2.9727, 9.4735, 3.2667, -87.65, 51.95, 6.65], [-2.8747, 9.8982, 3.2341, -86.8, 53.4, 9.6], [-2.7441, 10.2902, 3.3647, -85.05, 53.7, 12.45], [-2.6787, 10.6822, 3.6261, -81.9, 52.9, 15.15], [-2.6134, 11.0089, 3.9854, -76.95, 51.1, 17.45], [-2.548, 11.3029, 4.5081, -70.05, 48.85, 19.6], [-2.4827, 11.4989, 4.9001, -60.0, 46.1, 21.0], [-2.3847, 11.6622, 5.2268, -49.6, 43.45, 21.8], [-2.254, 11.8256, 5.3901, -38.3, 40.8, 22.0], [-2.1234, 11.9889, 5.3574, -26.6, 38.45, 21.6], [-1.9927, 12.1522, 5.1941, -14.5, 36.7, 20.9], [-1.9274, 12.2829, 4.8348, -2.0, 35.85, 20.4], [-1.862, 12.3809, 4.3774, 10.75, 35.9, 20.45], [-1.862, 12.4136, 3.8221, 23.3, 36.7, 21.35], [-1.8947, 12.3809, 3.2994, 35.0, 38.2, 23.3], [-1.9927, 12.2502, 2.8094, 45.25, 40.25, 26.35], [-2.1234, 12.0869, 2.5807, 53.75, 42.5, 31.35], [-2.352, 11.8256, 2.6134, 61.2, 43.7, 37.05], [-2.6134, 11.4989, 2.9074, 65.95, 43.55, 43.6], [-2.9074, 11.1722, 3.5607, 69.2, 41.8, 50.3], [-3.2341, 10.8782, 4.5408, 71.65, 38.2, 56.65], [-3.5607, 10.6169, 5.7168, 74.6, 32.75, 62.2], [-3.8874, 10.4862, 6.9908, 79.7, 25.45, 66.8], [-4.2467, 10.4209, 8.1995, 88.1, 16.75, 70.1], [-4.5408, 10.3882, 9.2448, 100.1, 7.65, 71.8], [-4.8021, 10.3555, 9.9962, 115.05, -0.9, 71.7], [-4.9981, 10.3229, 10.1922, 131.45, -9.05, 69.95], [-5.1288, 10.2249, 9.9635, 148.95, -14.85, 67.65], [-5.1941, 10.1595, 9.4082, 161.45, -19.2, 65.05], [-5.1941, 10.0289, 8.5915, 169.75, -21.95, 62.3], [-5.1614, 9.8002, 7.6768, 173.0, -23.15, 59.55], [-5.0961, 9.5715, 6.8275, 171.4, -23.15, 57.1], [-5.0308, 9.2448, 6.1088, 165.6, -22.75, 55.35], [-4.9328, 8.8855, 5.6188, 156.95, -22.8, 54.3], [-4.8348, 8.5262, 5.2921, 146.95, -23.9, 53.6], [-4.7694, 8.1015, 5.2268, 137.1, -26.4, 52.65], [-4.6714, 7.6441, 5.2594, 127.6, -31.2, 51.35], [-4.5408, 7.1868, 5.3574, 121.0, -37.4, 49.6], [-4.4101, 6.6968, 5.4881, 116.1, -45.65, 47.4], [-4.2467, 6.1741, 5.5861, 112.7, -55.55, 44.45], [-4.0507, 5.6514, 5.6514, 110.6, -66.3, 40.6], [-3.8874, 5.2268, 5.6514, 109.55, -77.05, 35.9], [-3.6587, 4.7041, 5.5861, 109.25, -87.15, 30.4], [-3.4627, 4.2467, 5.4228, 109.05, -96.05, 24.3], [-3.2667, 3.7567, 5.1288, 108.35, -103.45, 17.7], [-3.1361, 3.2994, 4.8348, 106.55, -109.45, 9.95], [-3.0381, 2.8094, 4.4754, 102.95, -112.35, 2.9], [-2.9727, 2.4174, 4.1161, 98.05, -113.0, -4.05], [-2.9727, 2.058, 3.7567, 91.55, -111.7, -10.4], [-3.0054, 1.8294, 3.3974, 83.65, -108.75, -15.9], [-3.1034, 1.6987, 3.1034, 74.7, -104.2, -20.25], [-3.2341, 1.764, 2.8094, 65.25, -98.2, -23.3], [-3.3647, 2.0254, 2.4827, 55.9, -90.95, -24.9], [-3.5281, 2.4827, 2.058, 46.65, -82.55, -24.95], [-3.6587, 3.1361, 1.4374, 37.55, -73.1, -23.3], [-3.7894, 4.1161, 0.6533, 27.5, -60.85, -20.35], [-3.8874, 5.2921, -0.294, 18.1, -49.1, -15.95], [-3.9527, 6.7295, -1.2414, 7.5, -37.2, -10.3], [-3.9201, 8.2975, -2.156, -3.75, -25.85, -4.1], [-3.8221, 9.9309, -2.9727, -14.55, -15.65, 1.85], [-3.7241, 11.5969, -3.6587, -23.85, -6.95, 6.95], [-3.5607, 13.3609, -4.1814, -30.6, -0.25, 10.85], [-3.3974, 14.5696, -4.4428, -34.75, 3.65, 13.35], [-3.1687, 15.2883, -4.3121, -37.2, 3.65, 14.25], [-2.9074, 15.517, -3.8547, -37.35, -0.15, 12.15], [-2.7114, 15.2883, -3.2667, -33.65, -8.1, 7.3], [-2.6461, 14.733, -2.6787, -27.8, -17.8, 0.4], [-2.7441, 13.8836, -2.058, -21.25, -28.7, -7.4], [-3.0054, 12.8056, -1.372, -15.8, -39.3, -15.05], [-3.3647, 11.6622, -0.686, -12.75, -47.9, -21.7], [-3.8221, 10.6169, 0.0327, -12.35, -53.15, -26.7], [-4.3448, 9.7675, 0.7187, -14.0, -54.25, -29.75], [-4.8674, 9.3102, 1.3394, -17.4, -51.65, -30.7], [-5.3574, 9.1142, 1.9927, -21.95, -46.0, -29.65], [-5.7821, 9.0815, 2.548, -26.9, -36.0, -26.35], [-6.0761, 9.1142, 3.0054, -32.7, -24.35, -21.65], [-6.1741, 9.1142, 3.4627, -38.0, -11.85, -15.9], [-6.0435, 8.9508, 3.8547, -43.55, -0.35, -10.45], [-5.7168, 8.6242, 4.1814, -49.2, 8.7, -6.45], [-5.3901, 8.0362, 4.4754, -54.65, 15.55, -4.0], [-4.9654, 7.1541, 4.7041, -60.2, 21.65, -2.45], [-4.5081, 6.2068, 4.8674, -67.15, 27.75, -1.2], [-3.9527, 5.2268, 4.9981, -76.45, 33.5, -0.5], [-3.3321, 4.5081, 5.1941, -87.9, 37.9, -1.1], [-2.7767, 4.0834, 5.4554, -101.4, 41.1, -2.9], [-2.2867, 4.1161, 5.6841, -111.85, 42.95, -5.35], [-1.9274, 4.5734, 5.8474, -119.35, 44.2, -7.8], [-1.6987, 5.2921, 5.9454, -124.0, 44.75, -9.9], [-1.6007, 6.1741, 5.9781, -126.3, 44.1, -11.6], [-1.6007, 7.0561, 5.9128, -126.45, 41.9, -13.0], [-1.764, 7.9708, 5.8148, -124.4, 38.25, -14.2], [-1.9927, 8.6242, 5.6514, -120.25, 33.5, -15.0], [-2.352, 8.9508, 5.4554, -114.25, 28.15, -15.55], [-2.7114, 9.0488, 5.1941, -107.25, 22.2, -15.85], [-3.0707, 8.8855, 4.9328, -99.3, 17.6, -15.7], [-3.3321, 8.5588, 4.7041, -92.75, 13.7, -15.45], [-3.5607, 8.1995, 4.5081, -86.8, 10.45, -15.5], [-3.6914, 7.8402, 4.4428, -81.4, 8.15, -15.8], [-3.7894, 7.5788, 4.3448, -76.6, 7.4, -16.15], [-3.8221, 7.3828, 4.2794, -72.65, 8.55, -16.25], [-3.8221, 7.2848, 4.2467, -70.0, 11.4, -15.8], [-3.7567, 7.2848, 4.2141, -69.05, 15.35, -14.8], [-3.6914, 7.3501, 4.1814, -69.8, 19.8, -13.6], [-3.5934, 7.4481, 4.1814, -72.05, 24.75, -12.1], [-3.4954, 7.5461, 4.1814, -75.5, 28.45, -10.85], [-3.3974, 7.6115, 4.2141, -78.6, 31.05, -9.9], [-3.3321, 7.6441, 4.2141, -81.25, 32.3, -9.4], [-3.2667, 7.6441, 4.2794, -83.25, 32.25, -9.5], [-3.2341, 7.6115, 4.3121, -84.55, 31.3, -10.15], [-3.2667, 7.5135, 4.3448, -85.2, 29.8, -11.2], [-3.2994, 7.4808, 4.3448, -85.3, 28.3, -12.3], [-3.3647, 7.4808, 4.3121, -85.0, 27.3, -13.15], [-3.3974, 7.5461, 4.2141, -84.4, 27.25, -13.55], [-3.4301, 7.7422, 4.0507, -83.95, 28.65, -13.15], [-3.4301, 8.0362, 3.8547, -83.85, 30.85, -11.95], [-3.3974, 8.4608, 3.6261, -84.05, 33.55, -10.0], [-3.3321, 8.9182, 3.4301, -84.2, 36.5, -7.4], [-3.2667, 9.4409, 3.2341, -84.0, 39.5, -4.25], [-3.1687, 9.9309, 3.1361, -83.2, 42.1, -0.8], [-3.1034, 10.4862, 3.1361, -81.7, 44.0, 2.85], [-3.0054, 10.9762, 3.2667, -79.1, 45.1, 6.5], [-2.9401, 11.4009, 3.4954, -75.0, 45.35, 10.05], [-2.8421, 11.7602, 3.8547, -69.15, 45.2, 13.7], [-2.7114, 12.0542, 4.1487, -60.4, 45.0, 16.6], [-2.5154, 12.3156, 4.3774, -51.2, 44.7, 19.1], [-2.2867, 12.5442, 4.5408, -41.15, 44.45, 21.15], [-1.96, 12.7729, 4.6061, -30.45, 44.4, 22.65], [-1.6987, 13.0016, 4.5734, -18.65, 44.45, 23.7], [-1.4374, 13.1649, 4.4101, -5.5, 44.7, 24.65], [-1.2414, 13.2956, 4.1487, 8.85, 44.95, 25.85], [-1.1434, 13.2956, 3.7894, 23.65, 45.05, 27.5], [-1.1107, 13.1649, 3.4301, 37.85, 44.85, 29.8], [-1.176, 12.9036, 3.2014, 50.8, 43.9, 33.2], [-1.4047, 12.5769, 3.1361, 63.3, 41.85, 37.0], [-1.764, 12.1849, 3.2994, 72.35, 38.3, 41.55], [-2.254, 11.7602, 3.7241, 79.25, 33.4, 46.4], [-2.8421, 11.3029, 4.4754, 84.25, 27.3, 51.25], [-3.4301, 10.9109, 5.4554, 88.25, 20.3, 55.8], [-3.9854, 10.6169, 6.5988, 92.75, 12.45, 60.0], [-4.5734, 10.5189, 7.8075, 99.1, 4.15, 63.55], [-5.0961, 10.4862, 8.8855, 108.15, -4.05, 66.3], [-5.5208, 10.4209, 9.7675, 120.15, -10.95, 68.05], [-5.8148, 10.4209, 10.1922, 134.25, -16.4, 69.05], [-6.0108, 10.3882, 10.1269, 150.4, -19.3, 69.65], [-6.0435, 10.3555, 9.7349, 162.6, -20.8, 70.2], [-5.9781, 10.2575, 8.9835, 170.95, -21.25, 70.3], [-5.8474, 10.0615, 8.1342, 174.55, -20.85, 69.7], [-5.6841, 9.8002, 7.2848, 173.45, -19.75, 68.45], [-5.4881, 9.4409, 6.5335, 168.3, -18.6, 66.85], [-5.3248, 9.0815, 5.9781, 160.05, -18.3, 65.25], [-5.1288, 8.6242, 5.5534, 150.0, -19.45, 63.35], [-4.9981, 8.1668, 5.3901, 139.7, -22.5, 60.45], [-4.8674, 7.6441, 5.3901, 129.4, -28.25, 57.0], [-4.7694, 7.1215, 5.4554, 122.2, -35.3, 53.0], [-4.6714, 6.6315, 5.5861, 117.1, -44.0, 48.85], [-4.5734, 6.1088, 5.6841, 113.75, -54.3, 44.65], [-4.4101, 5.5534, 5.7821, 111.8, -65.6, 40.25], [-4.2467, 4.9981, 5.7821, 110.8, -77.2, 35.3], [-4.0507, 4.4101, 5.7494, 110.5, -88.05, 29.85], [-3.8874, 3.8874, 5.6188, 110.5, -97.6, 24.0], [-3.7241, 3.3647, 5.3901, 110.35, -105.35, 17.9], [-3.5281, 2.8421, 5.0634, 109.45, -111.5, 11.0], [-3.3974, 2.3194, 4.6714, 107.0, -114.7, 4.8], [-3.2994, 1.8947, 4.2467, 103.05, -115.45, -1.35], [-3.2341, 1.5354, 3.7894, 97.25, -113.95, -7.1], [-3.2014, 1.274, 3.2994, 89.7, -110.45, -12.15], [-3.2667, 1.1434, 2.8094, 80.5, -105.15, -16.1], [-3.3321, 1.2087, 2.352, 70.0, -98.1, -18.75], [-3.4627, 1.5027, 1.862, 58.45, -89.45, -20.05], [-3.5934, 1.96, 1.3394, 46.1, -79.6, -20.15], [-3.6914, 2.6787, 0.686, 33.45, -68.7, -19.25], [-3.7567, 3.6914, -0.0653, 20.85, -56.8, -17.3], [-3.8547, 4.9328, -0.882, 6.25, -42.9, -14.5], [-3.8547, 6.4355, -1.6987, -7.45, -30.85, -10.8], [-3.7567, 8.1342, -2.4174, -21.0, -19.9, -6.9], [-3.5281, 9.8982, -3.0381, -32.95, -10.7, -3.45], [-3.3321, 11.6622, -3.4954, -42.0, -3.9, -0.95], [-3.1361, 13.3609, -3.8547, -47.45, 0.3, 0.7], [-2.8747, 14.8636, -3.9527, -49.7, 1.3, 1.6], [-2.6134, 15.6476, -3.7567, -49.75, -1.85, 1.6], [-2.3194, 15.9416, -3.2014, -46.85, -8.9, -0.35], [-2.156, 15.7456, -2.6134, -40.2, -20.55, -5.55], [-2.1234, 15.1903, -1.9927, -29.5, -33.25, -12.05], [-2.3194, 14.3083, -1.4047, -19.6, -46.5, -19.35], [-2.6787, 13.1976, -0.7513, -11.65, -58.45, -26.35], [-3.2994, 11.9889, -0.098, -7.1, -67.75, -32.35], [-3.9527, 10.9435, 0.5553, -5.75, -72.8, -36.7], [-4.7041, 10.1922, 1.1434, -6.65, -72.9, -39.35], [-5.4554, 9.7675, 1.666, -9.05, -68.55, -39.9], [-6.1415, 9.6695, 2.058, -12.45, -60.25, -37.95], [-6.6968, 9.6695, 2.45, -16.55, -48.35, -33.45], [-7.0561, 9.7022, 2.7114, -21.75, -31.9, -25.6], [-7.0888, 9.6369, 2.8747, -26.8, -16.4, -17.35], [-6.8928, 9.4082, 3.0054, -32.35, -2.0, -9.55], [-6.5008, 8.8528, 3.1687, -38.5, 10.0, -3.25], [-5.9128, 7.9382, 3.4301, -45.65, 19.85, 1.65], [-5.2594, 6.7621, 3.6587, -55.0, 28.7, 5.5], [-4.5408, 5.3248, 3.9854, -67.6, 37.05, 8.3], [-3.7241, 4.2141, 4.4101, -83.25, 43.95, 9.4], [-2.9074, 3.3974, 4.9654, -100.35, 48.8, 8.4], [-2.1887, 3.0381, 5.6841, -116.6, 51.55, 5.4], [-1.5354, 3.2341, 6.3048, -130.65, 52.5, 1.8], [-1.0454, 3.9527, 6.7948, -137.8, 51.85, -2.2], [-0.7513, 4.9981, 6.9908, -140.25, 49.6, -6.05], [-0.686, 6.2068, 7.0888, -138.6, 45.5, -9.55], [-0.784, 7.3828, 6.9581, -133.65, 39.8, -12.5], [-1.078, 8.3628, 6.6641, -126.2, 32.85, -14.8], [-1.5354, 9.1142, 6.2395, -117.0, 25.15, -16.75], [-2.0907, 9.4082, 5.7821, -106.95, 17.25, -18.4], [-2.7114, 9.3755, 5.2268, -97.3, 10.0, -19.65], [-3.2341, 9.0815, 4.8021, -89.1, 3.4, -20.4], [-3.6587, 8.5915, 4.5081, -81.65, -1.0, -20.95], [-3.9854, 8.0688, 4.2794, -76.25, -4.05, -21.7], [-4.1814, 7.6115, 4.1814, -71.8, -5.75, -22.7], [-4.3121, 7.2848, 4.1487, -68.0, -5.6, -23.7], [-4.3121, 7.0888, 4.1814, -65.15, -3.25, -24.05], [-4.2467, 6.9908, 4.2141, -63.55, 1.0, -23.6], [-4.1161, 7.0235, 4.2467, -63.6, 6.5, -22.4], [-3.9854, 7.1215, 4.2794, -65.3, 12.45, -20.65], [-3.8547, 7.2521, 4.3121, -68.3, 18.3, -18.5], [-3.7567, 7.3828, 4.3448, -72.1, 24.15, -15.9], [-3.6587, 7.4808, 4.3774, -76.45, 28.35, -13.6], [-3.5607, 7.5135, 4.3774, -80.1, 31.4, -11.65], [-3.4954, 7.4808, 4.3774, -83.3, 33.15, -10.25], [-3.4627, 7.4481, 4.4101, -86.0, 33.65, -9.65], [-3.4954, 7.3175, 4.4754, -88.2, 33.35, -9.65], [-3.5607, 7.2195, 4.5081, -89.85, 32.6, -10.1], [-3.6261, 7.1868, 4.5408, -90.8, 31.95, -10.8], [-3.6587, 7.2195, 4.5408, -91.15, 31.7, -11.4], [-3.6914, 7.3828, 4.4428, -91.1, 31.9, -11.85], [-3.6587, 7.6441, 4.2794, -90.8, 32.7, -11.8], [-3.5934, 8.0362, 4.0181, -90.6, 33.75, -11.2], [-3.4954, 8.5588, 3.7567, -90.5, 35.05, -9.95], [-3.3647, 9.1468, 3.4954, -90.2, 36.65, -8.05], [-3.2341, 9.7349, 3.2667, -89.5, 38.25, -5.55], [-3.1361, 10.3229, 3.1687, -88.3, 39.5, -2.45], [-3.0054, 10.9435, 3.1687, -86.35, 40.3, 1.0], [-2.9401, 11.4336, 3.3321, -83.05, 40.65, 4.75], [-2.9074, 11.8582, 3.6587, -77.9, 40.8, 8.65], [-2.8747, 12.2176, 4.0507, -70.45, 41.0, 13.15], [-2.8094, 12.4789, 4.3774, -59.5, 41.2, 17.0], [-2.7441, 12.6749, 4.6061, -47.95, 41.2, 20.5], [-2.6461, 12.8382, 4.7368, -35.35, 41.25, 23.45], [-2.5807, 12.9363, 4.7368, -21.85, 41.7, 25.95], [-2.5154, 13.0016, 4.6061, -7.5, 42.75, 28.2], [-2.5154, 13.0016, 4.3448, 7.5, 44.35, 30.6], [-2.5154, 12.9036, 3.9854, 22.25, 46.35, 33.4], [-2.548, 12.7076, 3.6261, 35.7, 48.55, 36.65], [-2.6461, 12.4462, 3.2994, 47.15, 50.6, 40.45], [-2.7767, 12.1522, 3.2014, 56.6, 52.3, 45.5], [-2.9727, 11.7929, 3.2994, 65.3, 52.6, 50.7], [-3.2341, 11.4336, 3.5934, 71.5, 51.1, 56.1], [-3.4954, 11.0415, 4.2141, 76.3, 47.6, 61.25], [-3.8547, 10.6495, 5.0634, 80.05, 42.1, 65.7], [-4.1487, 10.3555, 6.0761, 84.05, 34.75, 69.1], [-4.4754, 10.1595, 7.1541, 89.8, 26.05, 71.35], [-4.7694, 10.0289, 8.1342, 98.25, 16.8, 72.4], [-5.0961, 9.9962, 8.9182, 109.35, 7.8, 72.15], [-5.3248, 9.8982, 9.4082, 122.1, -0.0, 70.45], [-5.4881, 9.8655, 9.5062, 136.65, -6.65, 68.25], [-5.5534, 9.8002, 9.2122, 148.2, -10.7, 65.9], [-5.5208, 9.7675, 8.6568, 157.25, -13.2, 63.65], [-5.4554, 9.7022, 7.9382, 162.75, -14.4, 61.5], [-5.2921, 9.5715, 7.1868, 164.1, -14.75, 59.4], [-5.1614, 9.3755, 6.5008, 161.5, -14.9, 57.55], [-4.9654, 9.0488, 5.9781, 155.85, -15.45, 56.15], [-4.8021, 8.7548, 5.6188, 148.4, -17.05, 55.15], [-4.6388, 8.3955, 5.4881, 140.4, -19.95, 54.2], [-4.5081, 7.9382, 5.4881, 132.9, -24.4, 52.8], [-4.4101, 7.4481, 5.5861, 125.85, -31.05, 51.3], [-4.3121, 6.9255, 5.7168, 121.0, -38.45, 49.55], [-4.1814, 6.4028, 5.8148, 117.45, -47.05, 47.5], [-4.0507, 5.8801, 5.9128, 114.95, -56.5, 45.05], [-3.9201, 5.3901, 5.9128, 113.2, -66.2, 41.95], [-3.7894, 4.9001, 5.8148, 111.8, -75.6, 38.2], [-3.6261, 4.3774, 5.6841, 110.55, -84.25, 33.8], [-3.4301, 3.9527, 5.4881, 109.25, -91.75, 28.85], [-3.2667, 3.4954, 5.1614, 107.4, -97.85, 23.4], [-3.1361, 3.0707, 4.8348, 104.9, -102.7, 16.75], [-3.0381, 2.7114, 4.4428, 101.0, -105.1, 10.55], [-3.0054, 2.3847, 4.0507, 96.4, -105.75, 4.3], [-2.9727, 2.1234, 3.6587, 90.9, -104.9, -1.6], [-3.0381, 1.96, 3.2341, 84.45, -102.7, -6.9], [-3.1034, 1.8947, 2.8421, 77.3, -99.2, -11.2], [-3.2014, 1.9927, 2.3847, 69.5, -94.45, -14.55], [-3.3321, 2.3194, 1.8947, 61.2, -88.75, -16.65], [-3.4627, 2.8094, 1.274, 52.55, -82.0, -17.6], [-3.5607, 3.5607, 0.4247, 43.75, -73.95, -17.35], [-3.6587, 4.5081, -0.49, 34.5, -63.65, -15.45], [-3.6914, 5.7168, -1.4047, 22.75, -54.0, -12.55], [-3.6914, 7.0888, -2.2867, 11.45, -44.55, -8.95], [-3.6261, 8.5588, -3.1034, 0.1, -35.65, -5.25], [-3.5934, 10.1269, -3.7894, -10.2, -27.45, -1.9], [-3.5607, 11.6949, -4.3448, -18.6, -20.4, 1.05], [-3.5281, 13.1976, -4.6388, -25.1, -15.1, 3.45], [-3.3974, 14.1776, -4.6061, -30.2, -12.7, 5.05], [-3.2667, 14.7656, -4.2794, -33.4, -13.5, 5.15], [-3.1361, 14.9616, -3.7241, -33.9, -17.05, 3.0], [-3.0381, 14.831, -3.1034, -31.2, -23.85, -0.8], [-3.0054, 14.4389, -2.3847, -26.95, -31.9, -5.8], [-3.0707, 13.7529, -1.6334, -22.25, -40.95, -11.65], [-3.2667, 12.9036, -0.8493, -18.25, -49.75, -17.7], [-3.6914, 12.0869, -0.0653, -15.55, -56.85, -23.35], [-4.1814, 11.4009, 0.6207, -13.85, -60.8, -27.7], [-4.7041, 10.8782, 1.2087, -13.05, -61.65, -30.45], [-5.1614, 10.5189, 1.764, -13.15, -59.7, -31.6], [-5.6188, 10.2902, 2.254, -13.7, -54.95, -31.25], [-6.0435, 10.0289, 2.6787, -14.95, -47.35, -28.65], [-6.3048, 9.7349, 2.9727, -17.3, -36.3, -24.2], [-6.3375, 9.2775, 3.2667, -20.3, -25.9, -18.7], [-6.1741, 8.5915, 3.5281, -24.4, -16.35, -13.7], [-5.9128, 7.6441, 3.8221, -29.8, -8.3, -10.1], [-5.5534, 6.5661, 4.0834, -36.75, -0.45, -7.5], [-5.2268, 5.4554, 4.3121, -46.05, 8.25, -4.9], [-4.7694, 4.3121, 4.5408, -58.45, 17.55, -2.05], [-4.1487, 3.4954, 4.8348, -73.65, 26.25, 0.2], [-3.4954, 3.1687, 5.1288, -90.4, 33.7, 1.2], [-2.8421, 3.2667, 5.5534, -106.85, 40.6, 1.0], [-2.2867, 3.8874, 5.9128, -122.25, 45.55, 0.3], [-1.7967, 4.8674, 6.2068, -131.75, 49.0, -0.45], [-1.4047, 5.9781, 6.4028, -137.15, 49.85, -1.4], [-1.1434, 7.1215, 6.5008, -138.75, 47.5, -3.0], [-1.1434, 8.1015, 6.4355, -136.95, 42.65, -5.35], [-1.372, 8.8855, 6.2721, -132.2, 36.2, -7.95], [-1.764, 9.3755, 5.9781, -125.0, 29.1, -10.6], [-2.2867, 9.4409, 5.6188, -116.4, 22.1, -12.9], [-2.8094, 9.2122, 5.1614, -107.9, 15.7, -14.8], [-3.2667, 8.8202, 4.7694, -100.7, 9.95, -16.35], [-3.6261, 8.3302, 4.4428, -94.4, 6.5, -17.55], [-3.9201, 7.8728, 4.2141, -90.1, 4.65, -18.55], [-4.0507, 7.5135, 4.1161, -86.6, 4.3, -19.35], [-4.1161, 7.2521, 4.1487, -83.7, 5.45, -19.85], [-4.0507, 7.1215, 4.2467, -81.65, 7.9, -19.85], [-3.9527, 7.0561, 4.3448, -80.55, 11.35, -19.35], [-3.8547, 7.1541, 4.4754, -80.35, 15.3, -18.3], [-3.7241, 7.2848, 4.5734, -80.95, 19.45, -16.8], [-3.5934, 7.4481, 4.6388, -82.05, 23.55, -14.7], [-3.4627, 7.6441, 4.6714, -83.7, 27.6, -12.75], [-3.3321, 7.7422, 4.6388, -85.35, 30.35, -11.0], [-3.2667, 7.7422, 4.6061, -86.9, 32.05, -9.75], [-3.2014, 7.7095, 4.5408, -88.2, 32.6, -9.2], [-3.2014, 7.6115, 4.4754, -89.3, 32.2, -9.3], [-3.2341, 7.4808, 4.4101, -90.2, 31.35, -9.95], [-3.3321, 7.3828, 4.3448, -90.85, 30.2, -11.05], [-3.3974, 7.3828, 4.2467, -91.15, 29.05, -12.2], [-3.4627, 7.4481, 4.1487, -91.0, 28.1, -13.25], [-3.4954, 7.6441, 3.9854, -90.55, 27.65, -13.85], [-3.4954, 8.0035, 3.7894, -90.0, 27.9, -13.6], [-3.4627, 8.4608, 3.5607, -89.55, 28.7, -12.55], [-3.3974, 9.0162, 3.3647, -88.9, 29.95, -10.65], [-3.3647, 9.5715, 3.2014, -87.75, 31.55, -7.95], [-3.2994, 10.1269, 3.1034, -85.9, 33.2, -4.55], [-3.2341, 10.6495, 3.1361, -83.25, 34.75, -0.65], [-3.2014, 11.1069, 3.2667, -79.7, 36.05, 3.6], [-3.2014, 11.4336, 3.5281, -75.05, 37.2, 8.05], [-3.2014, 11.6949, 3.8547, -69.0, 38.35, 12.5], [-3.1361, 11.8909, 4.1814, -61.25, 39.9, 17.35], [-3.0381, 12.0216, 4.4101, -50.95, 41.35, 21.3], [-2.8421, 12.1196, 4.5734, -40.95, 42.85, 24.7], [-2.6134, 12.2502, 4.6061, -30.5, 44.4, 27.55], [-2.352, 12.4136, 4.5081, -19.55, 46.1, 29.8], [-2.1234, 12.6096, 4.3121, -7.7, 47.9, 31.7], [-1.96, 12.7402, 4.0181, 5.2, 49.65, 33.5], [-1.8294, 12.8056, 3.6587, 18.6, 51.3, 35.55], [-1.7967, 12.7729, 3.2994, 31.45, 52.65, 38.05], [-1.8294, 12.6422, 3.0054, 42.95, 53.3, 41.55], [-1.9927, 12.4462, 2.9401, 54.05, 52.6, 45.35], [-2.2867, 12.1522, 3.1034, 62.15, 50.05, 49.7], [-2.6787, 11.7602, 3.5607, 68.6, 45.7, 54.3], [-3.1361, 11.4009, 4.3448, 73.55, 39.95, 58.85], [-3.6587, 11.0415, 5.3574, 77.65, 33.0, 63.05], [-4.1487, 10.7802, 6.5335, 82.4, 25.0, 66.75], [-4.6388, 10.6169, 7.8075, 89.4, 16.2, 69.75], [-5.1288, 10.5515, 8.9508, 99.6, 7.4, 71.7], [-5.5534, 10.4862, 9.8655, 113.0, -0.3, 72.3], [-5.8474, 10.4209, 10.4209, 128.75, -5.85, 71.7], [-6.0435, 10.3882, 10.4535, 146.8, -9.65, 70.8], [-6.1088, 10.3229, 10.0289, 160.95, -11.2, 69.9], [-6.0435, 10.1922, 9.3428, 171.35, -11.55, 68.85], [-5.9128, 9.9962, 8.4608, 176.7, -10.95, 67.35], [-5.7494, 9.7022, 7.5135, 176.6, -9.6, 65.6], [-5.5861, 9.4082, 6.6641, 171.55, -7.9, 64.0], [-5.3574, 9.0162, 6.0435, 162.65, -6.7, 63.05], [-5.1614, 8.5915, 5.5861, 151.4, -6.7, 62.55], [-4.9981, 8.1668, 5.3901, 139.55, -8.35, 61.9], [-4.8021, 7.6441, 5.3574, 128.45, -12.5, 60.6], [-4.6714, 7.1215, 5.4554, 118.05, -18.25, 59.0], [-4.5081, 6.5988, 5.6188, 111.0, -25.9, 57.0], [-4.3448, 6.0435, 5.7821, 105.95, -35.4, 54.45], [-4.1161, 5.4554, 5.8801, 102.65, -46.3, 51.1], [-3.8874, 4.9328, 5.9454, 100.8, -58.15, 46.65], [-3.6587, 4.4428, 5.9128, 100.05, -70.0, 41.05], [-3.4627, 3.8874, 5.7821, 100.05, -81.15, 34.45], [-3.2014, 3.3974, 5.6188, 100.4, -90.85, 27.1], [-3.0054, 2.9401, 5.2921, 100.55, -98.7, 18.25], [-2.8421, 2.45, 4.9001, 99.75, -104.75, 10.2], [-2.7114, 2.058, 4.4754, 97.55, -107.7, 2.3], [-2.6461, 1.7314, 3.9854, 93.8, -108.35, -5.1], [-2.6461, 1.5027, 3.4301, 88.35, -106.9, -11.55], [-2.7114, 1.3394, 2.9074, 81.1, -103.45, -16.85], [-2.8421, 1.4047, 2.3847, 72.4, -98.2, -20.7], [-2.9727, 1.6987, 1.8294, 62.45, -91.55, -23.1], [-3.1361, 2.1887, 1.274, 51.7, -83.75, -24.25], [-3.2994, 2.9074, 0.6533, 40.8, -74.85, -24.2], [-3.4627, 3.9201, -0.2287, 29.9, -64.6, -22.55], [-3.5934, 5.1941, -1.0454, 17.0, -51.95, -19.5], [-3.6587, 6.6968, -1.862, 4.9, -40.65, -15.35], [-3.6587, 8.3302, -2.548, -7.0, -30.0, -10.75], [-3.5607, 10.0289, -3.1687, -17.55, -20.35, -6.25], [-3.4301, 11.7602, -3.6587, -25.85, -12.2, -2.0], [-3.2994, 13.3283, -4.0507, -31.5, -5.95, 1.85], [-3.1361, 14.7003, -4.1487, -35.1, -2.65, 5.15], [-2.8747, 15.4516, -3.9527, -36.7, -3.35, 7.1], [-2.6134, 15.713, -3.4301, -35.5, -8.15, 6.7], [-2.45, 15.5823, -2.8747, -30.95, -16.25, 3.3], [-2.3847, 15.0923, -2.254, -23.0, -28.35, -1.55], [-2.45, 14.2756, -1.6007, -15.15, -40.65, -7.45], [-2.7114, 13.2303, -0.9147, -8.45, -52.6, -13.8], [-3.1687, 12.1196, -0.196, -3.8, -62.4, -19.9], [-3.6914, 11.1069, 0.49, -1.25, -68.3, -25.0], [-4.2794, 10.2575, 1.078, -0.85, -69.55, -28.45], [-4.8674, 9.6369, 1.6334, -2.6, -66.6, -30.1], [-5.3901, 9.3102, 2.1234, -6.1, -60.25, -30.1], [-5.8801, 9.1468, 2.6134, -10.75, -50.8, -28.6], [-6.2721, 9.0488, 2.9727, -16.1, -37.25, -24.9], [-6.4355, 8.9182, 3.2994, -22.3, -24.45, -20.35], [-6.3375, 8.6568, 3.5934, -28.0, -13.15, -15.75], [-6.1741, 8.1995, 3.8874, -33.95, -4.35, -12.35], [-5.8474, 7.5461, 4.1814, -40.3, 2.65, -10.2], [-5.5208, 6.6968, 4.4428, -47.5, 9.5, -8.35], [-5.0634, 5.6514, 4.6388, -56.65, 17.0, -6.15], [-4.4428, 4.7694, 4.8674, -68.4, 24.55, -4.05], [-3.7567, 4.0834, 5.0961, -82.45, 31.1, -3.0], [-3.0707, 3.8547, 5.4228, -97.65, 36.5, -3.25], [-2.5154, 3.9854, 5.7494, -113.55, 41.65, -4.25], [-2.0254, 4.5734, 5.9781, -124.45, 45.1, -5.45], [-1.6987, 5.4228, 6.1415, -131.5, 46.7, -6.75], [-1.5027, 6.4028, 6.1741, -135.1, 45.75, -8.3], [-1.47, 7.3501, 6.1088, -135.55, 42.35, -10.35], [-1.666, 8.1668, 5.9781, -133.2, 37.1, -12.6], [-1.9927, 8.8528, 5.7494, -128.3, 30.9, -14.7], [-2.4174, 9.1468, 5.4554, -121.35, 24.4, -16.45], [-2.8747, 9.1142, 5.1614, -113.35, 18.3, -17.85], [-3.2667, 8.8855, 4.7694, -105.7, 13.15, -18.85], [-3.5607, 8.5262, 4.5081, -98.35, 9.05, -19.4], [-3.7894, 8.1342, 4.3121, -92.9, 6.65, -19.85], [-3.8874, 7.7748, 4.2141, -88.15, 5.5, -20.25], [-3.9201, 7.5461, 4.1487, -84.0, 5.7, -20.55], [-3.8874, 7.3828, 4.1814, -80.5, 7.4, -20.55], [-3.8221, 7.3501, 4.2141, -77.95, 10.3, -19.95], [-3.6914, 7.4155, 4.2467, -76.6, 14.05, -18.75], [-3.5934, 7.5135, 4.2794, -76.4, 18.1, -17.15], [-3.4627, 7.6441, 4.3121, -77.3, 22.1, -15.3], [-3.3647, 7.7748, 4.3448, -78.85, 25.95, -13.15], [-3.2994, 7.8402, 4.3448, -80.7, 28.3, -11.45], [-3.2341, 7.8728, 4.3774, -82.0, 29.55, -10.2], [-3.2341, 7.8075, 4.4101, -82.7, 29.65, -9.45], [-3.2667, 7.7095, 4.4428, -82.9, 28.9, -9.25], [-3.3321, 7.6115, 4.4428, -82.7, 27.65, -9.55], [-3.4627, 7.5135, 4.4101, -82.1, 26.2, -10.05], [-3.5607, 7.4808, 4.3448, -81.2, 25.2, -10.55], [-3.6587, 7.5135, 4.2467, -80.05, 24.95, -10.8], [-3.7241, 7.6441, 3.9854, -79.1, 25.7, -10.5], [-3.7567, 7.9055, 3.7241, -78.6, 27.5, -9.55], [-3.7241, 8.2322, 3.3974, -79.0, 29.75, -7.95], [-3.6587, 8.6568, 3.1034, -79.9, 32.3, -5.8], [-3.6261, 9.1142, 2.9074, -80.9, 35.1, -3.1], [-3.5281, 9.6042, 2.8421, -81.4, 37.7, -0.05], [-3.4301, 10.0615, 2.9727, -81.1, 39.65, 3.25], [-3.3321, 10.5842, 3.2341, -79.65, 40.8, 6.7], [-3.2667, 10.9762, 3.6261, -76.6, 41.3, 10.1], [-3.1687, 11.3356, 4.1161, -71.5, 41.4, 13.45], [-3.0381, 11.6296, 4.6061, -63.95, 41.45, 16.95], [-2.8747, 11.8582, 4.9328, -53.05, 41.45, 19.75], [-2.6461, 12.0542, 5.0961, -42.1, 41.5, 22.15], [-2.4174, 12.2502, 5.0634, -30.65, 41.75, 24.0], [-2.2214, 12.4136, 4.8674, -18.8, 42.45, 25.5], [-2.058, 12.5442, 4.5408, -6.25, 43.65, 26.75], [-1.96, 12.6422, 4.0507, 6.9, 45.35, 28.1], [-1.8947, 12.6422, 3.4954, 20.05, 47.5, 29.9], [-1.8947, 12.5442, 2.9401, 32.3, 49.85, 32.2], [-1.96, 12.3482, 2.45, 43.0, 52.1, 35.25], [-2.1234, 12.1196, 2.2214, 52.0, 53.7, 39.7], [-2.352, 11.8256, 2.254, 59.95, 53.5, 44.55], [-2.6134, 11.4662, 2.6134, 64.95, 51.35, 50.0], [-2.9074, 11.1069, 3.3321, 68.25, 47.2, 55.55], [-3.2667, 10.8129, 4.3774, 70.8, 41.2, 60.7], [-3.5934, 10.6169, 5.6514, 74.0, 33.3, 65.25], [-3.9527, 10.4862, 7.0235, 79.5, 23.75, 69.05], [-4.3121, 10.4862, 8.2975, 88.4, 13.15, 71.8], [-4.6714, 10.5189, 9.4082, 100.65, 2.5, 73.0], [-4.9328, 10.5189, 10.2575, 115.85, -7.0, 72.4], [-5.1614, 10.5189, 10.4862, 134.65, -15.35, 70.75], [-5.2921, 10.5189, 10.2575, 150.5, -20.75, 68.9], [-5.3574, 10.4862, 9.7022, 163.4, -24.35, 67.0], [-5.3248, 10.3229, 8.8528, 171.65, -26.5, 64.95], [-5.2594, 10.0942, 7.9382, 174.55, -27.35, 62.55], [-5.1941, 9.7675, 7.0235, 172.35, -27.25, 60.05], [-5.0961, 9.3755, 6.2395, 166.1, -26.65, 58.2], [-4.9981, 8.9508, 5.6841, 157.05, -26.4, 57.1], [-4.9001, 8.4608, 5.2921, 146.55, -27.15, 56.4], [-4.8021, 7.9055, 5.1614, 136.05, -29.7, 55.3], [-4.6714, 7.3501, 5.1288, 125.65, -33.8, 53.75], [-4.5408, 6.7948, 5.1941, 118.3, -39.65, 51.75], [-4.3774, 6.2721, 5.2921, 112.85, -47.15, 49.6], [-4.1487, 5.7168, 5.3901, 109.0, -56.1, 47.1], [-3.8874, 5.2268, 5.4228, 106.4, -66.1, 43.8], [-3.6261, 4.7368, 5.4228, 104.7, -76.45, 39.45], [-3.3321, 4.2467, 5.3574, 103.65, -86.5, 34.05], [-3.1034, 3.7894, 5.2268, 102.95, -95.65, 27.75], [-2.9074, 3.3321, 4.9654, 102.15, -103.25, 20.85], [-2.7767, 2.8747, 4.6714, 100.75, -109.5, 12.5], [-2.6787, 2.45, 4.3448, 98.05, -112.75, 4.75], [-2.6787, 2.0907, 3.9527, 94.4, -113.8, -2.95], [-2.7114, 1.862, 3.5281, 89.45, -112.8, -10.1], [-2.8421, 1.7314, 3.1034, 83.1, -109.8, -16.25], [-3.0054, 1.6987, 2.6787, 75.45, -104.85, -20.95], [-3.1687, 1.96, 2.254, 66.55, -97.9, -23.95], [-3.3647, 2.352, 1.764, 56.5, -89.25, -25.15], [-3.5281, 2.9727, 1.1434, 45.5, -78.95, -24.7], [-3.6587, 3.8547, 0.392, 33.8, -67.1, -22.35], [-3.7567, 4.9654, -0.4573, 19.7, -52.35, -18.7], [-3.7894, 6.3375, -1.274, 6.1, -39.1, -13.85], [-3.7241, 7.9055, -2.058, -7.65, -26.45, -8.45], [-3.5934, 9.5715, -2.7441, -20.25, -15.1, -3.3], [-3.4627, 11.2702, -3.3321, -30.55, -5.9, 1.05], [-3.3321, 12.9036, -3.7894, -37.55, 0.75, 4.2], [-3.1687, 14.4716, -4.0507, -41.25, 4.15, 6.0], [-2.9727, 15.419, -4.0181, -42.35, 3.35, 6.4], [-2.7767, 15.8763, -3.6914, -40.75, -1.65, 4.8], [-2.6787, 15.8763, -3.2341, -35.95, -11.05, 0.2], [-2.6787, 15.4843, -2.7114, -27.5, -22.0, -6.05], [-2.7767, 14.733, -2.1234, -18.95, -34.4, -13.4], [-3.0054, 13.7529, -1.47, -11.3, -46.55, -21.0], [-3.4627, 12.6096, -0.784, -5.8, -56.75, -27.7], [-3.9854, 11.4989, -0.0327, -2.95, -63.25, -32.6], [-4.5734, 10.5842, 0.6533, -2.25, -64.75, -35.35], [-5.0961, 9.7022, 1.3067, -3.6, -61.45, -35.75], [-5.5861, 9.2122, 1.8947, -6.65, -54.2, -33.9], [-6.0108, 8.8528, 2.4827, -10.7, -43.45, -29.3], [-6.3048, 8.6242, 2.8747, -16.4, -27.8, -23.1], [-6.4028, 8.3955, 3.2341, -22.65, -12.3, -15.7], [-6.2395, 8.0688, 3.5281, -29.95, 2.35, -8.55], [-5.8474, 7.6441, 3.8547, -38.0, 14.3, -3.15], [-5.3248, 7.1541, 4.1487, -46.4, 23.1, 0.05], [-4.8348, 6.5661, 4.3774, -55.05, 29.9, 1.8], [-4.2794, 5.8148, 4.6061, -65.0, 35.75, 2.85], [-3.6914, 5.1941, 4.8348, -77.15, 40.55, 3.25], [-3.0381, 4.7694, 5.1288, -90.85, 43.6, 2.5], [-2.45, 4.5734, 5.5534, -104.4, 44.95, 0.3], [-1.9927, 4.7041, 5.8801, -117.15, 45.2, -2.2], [-1.666, 5.1614, 6.1741, -125.0, 44.75, -4.55], [-1.5027, 5.7821, 6.3375, -129.5, 43.45, -6.7], [-1.47, 6.5008, 6.3701, -131.15, 41.0, -8.6], [-1.568, 7.2195, 6.3048, -130.4, 37.4, -10.45], [-1.7967, 7.8075, 6.1415, -127.3, 33.0, -12.35], [-2.1234, 8.3302, 5.9128, -122.4, 28.15, -14.2], [-2.4827, 8.5588, 5.6514, -116.2, 23.15, -15.9], [-2.9074, 8.5915, 5.3574, -109.45, 18.35, -17.5], [-3.2667, 8.4282, 5.0961, -102.95, 13.9, -18.85], [-3.5607, 8.1668, 4.8674, -96.45, 11.0, -19.75], [-3.7241, 7.8402, 4.7041, -91.35, 8.75, -20.65], [-3.8221, 7.5788, 4.6061, -86.65, 7.1, -21.65], [-3.8874, 7.3828, 4.6061, -82.35, 6.1, -22.65], [-3.8874, 7.2195, 4.5408, -78.6, 6.2, -23.3], [-3.8547, 7.1868, 4.5081, -75.95, 7.55, -23.35], [-3.7894, 7.2195, 4.4754, -74.75, 9.95, -22.75], [-3.6914, 7.2521, 4.4101, -75.2, 13.1, -21.75], [-3.5934, 7.3501, 4.3774, -77.0, 16.55, -20.3], [-3.5281, 7.4481, 4.3448, -80.05, 20.35, -19.0], [-3.4627, 7.5461, 4.3121, -83.05, 23.1, -17.75], [-3.3974, 7.5788, 4.3121, -85.85, 25.05, -16.85], [-3.3321, 7.5461, 4.3448, -88.1, 26.0, -16.35], [-3.3321, 7.5135, 4.3448, -89.7, 26.05, -16.35], [-3.3647, 7.4481, 4.3774, -90.6, 25.4, -16.7], [-3.3974, 7.4481, 4.3774, -90.75, 24.35, -17.15], [-3.4627, 7.5135, 4.3121, -90.35, 23.45, -17.45], [-3.4954, 7.6441, 4.1814, -89.7, 23.35, -17.2], [-3.5281, 7.9055, 3.9854, -89.05, 24.25, -16.1], [-3.5607, 8.2975, 3.7567, -88.55, 26.5, -14.2], [-3.5281, 8.7548, 3.5281, -88.2, 29.4, -11.4], [-3.4954, 9.3102, 3.2994, -87.7, 32.95, -7.85], [-3.4627, 9.8655, 3.1687, -86.85, 36.85, -3.65], [-3.3974, 10.3882, 3.1361, -85.5, 40.65, 0.9], [-3.3647, 10.8455, 3.2014, -83.45, 43.9, 5.7], [-3.3321, 11.2376, 3.4301, -80.35, 46.3, 10.45], [-3.2994, 11.5642, 3.7894, -75.75, 47.75, 14.85], [-3.2341, 11.7602, 4.2794, -69.4, 48.45, 18.8], [-3.1687, 11.9236, 4.6714, -61.2, 48.8, 22.4], [-3.0381, 12.0216, 4.9654, -50.25, 48.55, 24.85], [-2.8747, 12.0869, 5.1288, -39.65, 48.05, 26.55], [-2.6461, 12.1522, 5.1288, -28.5, 47.55, 27.5], [-2.4174, 12.2502, 4.9654, -16.85, 47.15, 27.9], [-2.2214, 12.3482, 4.6388, -4.55, 46.95, 28.1], [-2.058, 12.4136, 4.1487, 8.4, 47.15, 28.45], [-1.96, 12.3809, 3.5607, 21.45, 47.75, 29.3], [-1.96, 12.2829, 2.9727, 33.65, 48.9, 30.9], [-1.9927, 12.0869, 2.4174, 44.2, 50.4, 33.45], [-2.1234, 11.8256, 2.0907, 53.55, 51.95, 37.7], [-2.3847, 11.4989, 2.058, 59.7, 52.35, 42.65], [-2.6787, 11.1396, 2.352, 63.9, 51.35, 48.6], [-3.0054, 10.7802, 2.9727, 66.4, 48.65, 54.95], [-3.3974, 10.4862, 3.9854, 67.95, 44.25, 61.25], [-3.7241, 10.2902, 5.2268, 69.9, 37.85, 66.9], [-4.0507, 10.1922, 6.6315, 73.95, 29.25, 71.75], [-4.3774, 10.2249, 8.0362, 81.65, 18.8, 75.35], [-4.6714, 10.2902, 9.2122, 93.4, 7.4, 77.25], [-4.9328, 10.3555, 10.1922, 108.6, -3.6, 77.1], [-5.0961, 10.3555, 10.5515, 128.0, -14.0, 75.2], [-5.2268, 10.3882, 10.5189, 144.75, -21.0, 72.3], [-5.2921, 10.3882, 10.0289, 158.9, -26.1, 69.0], [-5.3248, 10.2575, 9.2775, 168.95, -29.2, 65.5], [-5.3248, 10.0615, 8.3955, 173.85, -30.25, 61.85], [-5.2921, 9.8002, 7.4808, 173.8, -29.5, 58.3], [-5.2268, 9.4735, 6.6968, 169.4, -27.75, 55.3], [-5.1614, 9.1142, 6.0435, 161.75, -26.1, 53.2], [-5.0308, 8.6568, 5.5208, 152.2, -25.8, 51.75], [-4.9654, 8.1668, 5.2921, 142.35, -27.9, 50.2], [-4.8348, 7.6441, 5.1614, 132.35, -32.2, 48.55], [-4.7041, 7.1215, 5.1614, 125.1, -38.75, 46.6], [-4.5734, 6.6315, 5.1941, 119.65, -47.45, 44.5], [-4.4101, 6.1415, 5.2594, 115.8, -57.9, 42.2], [-4.2141, 5.6188, 5.3248, 113.3, -69.65, 39.4], [-4.0181, 5.1614, 5.3574, 111.9, -81.7, 35.7], [-3.8221, 4.7041, 5.3901, 111.55, -93.1, 31.15], [-3.6261, 4.2794, 5.3248, 111.85, -103.1, 25.9], [-3.4627, 3.8874, 5.1288, 112.45, -111.15, 20.15], [-3.3321, 3.4627, 4.9001, 112.7, -117.5, 13.15], [-3.2341, 3.0707, 4.5734, 111.85, -120.65, 6.75], [-3.1687, 2.7114, 4.1814, 109.55, -121.3, 0.4], [-3.1361, 2.4174, 3.7241, 105.5, -119.45, -5.55], [-3.1687, 2.1887, 3.2667, 99.55, -115.5, -10.55], [-3.2667, 2.1234, 2.7114, 91.8, -109.5, -14.2], [-3.3647, 2.156, 2.156, 82.35, -101.75, -16.45], [-3.4954, 2.3847, 1.6334, 71.4, -92.35, -17.3], [-3.6587, 2.7767, 1.078, 59.3, -81.7, -16.95], [-3.7241, 3.3647, 0.392, 46.6, -70.25, -15.6], [-3.7894, 4.1814, -0.294, 33.8, -56.8, -13.3], [-3.8221, 5.2268, -1.0127, 19.55, -44.85, -10.7], [-3.7894, 6.4681, -1.6987, 7.1, -33.6, -7.8], [-3.7241, 7.8075, -2.352, -4.55, -23.6, -5.1], [-3.5934, 9.2448, -2.8747, -14.6, -15.35, -2.85], [-3.4627, 10.6822, -3.3321, -22.35, -9.2, -1.35], [-3.3647, 12.2176, -3.6587, -27.5, -5.25, -0.55], [-3.2341, 13.3283, -3.8221, -30.4, -3.6, -0.2], [-3.1034, 14.1123, -3.7894, -31.7, -4.6, -0.4], [-2.9727, 14.5043, -3.4954, -31.45, -8.25, -1.9], [-2.9074, 14.5696, -3.0707, -29.0, -15.2, -4.6], [-2.8747, 14.3409, -2.5807, -25.4, -23.3, -8.5], [-2.9401, 13.8509, -2.0254, -21.3, -32.7, -13.05], [-3.1034, 13.1649, -1.372, -17.4, -42.15, -17.95], [-3.4301, 12.3482, -0.7187, -14.45, -50.4, -22.7], [-3.8874, 11.5316, -0.0327, -12.7, -56.3, -26.6], [-4.3774, 10.7475, 0.588, -12.25, -58.8, -29.05], [-4.8674, 10.1595, 1.1434, -13.5, -57.75, -29.9], [-5.3248, 9.6695, 1.7314, -16.5, -53.45, -29.3], [-5.7821, 9.3102, 2.156, -20.8, -45.05, -27.0], [-6.1415, 9.0162, 2.5154, -26.9, -34.6, -23.5], [-6.3375, 8.7222, 2.8747, -33.55, -22.4, -18.85], [-6.3048, 8.3302, 3.2014, -41.4, -10.15, -13.85], [-6.0761, 7.8728, 3.5607, -50.3, 0.9, -9.85], [-5.7494, 7.3175, 3.9854, -59.8, 10.05, -7.3], [-5.3901, 6.6968, 4.3774, -69.2, 18.05, -5.9], [-4.9654, 5.9781, 4.7694, -78.85, 25.65, -4.85], [-4.4428, 5.4228, 5.0961, -89.4, 32.8, -3.9], [-3.8221, 4.8674, 5.5208, -100.9, 38.95, -3.5], [-3.2014, 4.6061, 5.8801, -112.5, 44.0, -4.1], [-2.6461, 4.6714, 6.2068, -123.85, 46.95, -5.45], [-2.2214, 5.0308, 6.4681, -131.05, 48.55, -7.05], [-1.8947, 5.6188, 6.5335, -134.95, 48.6, -8.8], [-1.6987, 6.3048, 6.5008, -135.95, 46.95, -10.65], [-1.6334, 7.0235, 6.3375, -134.55, 43.5, -12.65], [-1.7314, 7.7422, 6.0761, -131.3, 38.65, -14.9], [-1.9274, 8.2322, 5.7494, -126.45, 33.0, -17.1], [-2.1887, 8.5915, 5.3901, -120.4, 27.15, -18.95], [-2.5154, 8.7222, 4.9981, -113.8, 21.8, -20.4], [-2.8094, 8.6568, 4.6388, -106.7, 16.9, -21.0], [-3.0381, 8.4935, 4.3448, -101.3, 13.85, -20.9], [-3.2341, 8.2975, 4.1487, -96.95, 11.9, -20.35], [-3.2994, 8.1015, 4.0507, -93.1, 10.8, -19.6], [-3.3321, 7.9708, 4.0181, -89.35, 10.5, -18.85], [-3.3647, 7.9382, 4.0181, -85.5, 11.15, -17.95], [-3.3647, 7.9055, 4.0181, -81.85, 12.8, -16.85], [-3.3647, 7.9382, 3.9854, -78.9, 15.4, -15.4], [-3.3647, 7.9708, 3.9201, -77.0, 18.7, -13.75], [-3.3321, 8.0035, 3.8547, -76.25, 22.85, -11.75], [-3.3321, 8.0035, 3.8547, -76.6, 26.35, -9.95], [-3.3321, 7.9382, 3.8547, -77.55, 29.25, -8.35], [-3.2994, 7.8402, 3.9201, -78.65, 31.15, -7.1], [-3.2667, 7.7095, 4.0181, -79.8, 31.85, -6.45], [-3.2667, 7.5461, 4.1487, -80.7, 31.15, -6.4], [-3.2667, 7.4481, 4.2794, -81.15, 29.25, -6.95], [-3.2994, 7.3828, 4.3774, -80.75, 26.45, -8.1], [-3.3647, 7.4481, 4.4101, -79.4, 23.4, -9.65], [-3.3974, 7.6115, 4.2794, -77.55, 20.7, -11.3], [-3.4627, 7.9055, 4.0181, -75.7, 18.8, -12.75], [-3.5281, 8.2975, 3.6587, -74.45, 18.45, -13.3], [-3.5281, 8.7548, 3.3321, -74.25, 19.55, -12.9], [-3.5607, 9.2448, 3.0054, -74.7, 21.8, -11.5], [-3.5607, 9.7349, 2.8094, -75.35, 24.75, -9.25], [-3.5281, 10.1595, 2.7441, -76.0, 27.8, -6.3], [-3.5281, 10.5842, 2.8421, -76.3, 30.6, -3.0], [-3.4954, 10.9109, 3.1361, -75.65, 32.85, 0.5], [-3.4301, 11.1722, 3.5281, -73.4, 34.35, 3.95], [-3.3321, 11.3682, 4.0507, -68.95, 35.2, 7.5], [-3.1687, 11.5316, 4.4754, -61.3, 35.4, 10.1], [-2.9401, 11.6949, 4.8021, -52.8, 35.2, 12.05], [-2.6787, 11.8582, 4.9981, -43.35, 34.9, 13.55], [-2.3194, 12.0542, 5.0308, -33.3, 34.7, 14.8], [-1.96, 12.2829, 4.9328, -22.4, 34.65, 16.0], [-1.666, 12.5116, 4.7041, -10.35, 34.65, 17.45], [-1.4374, 12.7076, 4.3774, 2.8, 34.65, 19.35], [-1.372, 12.7729, 3.9854, 16.4, 34.65, 21.95], [-1.4047, 12.7729, 3.5934, 29.65, 34.45, 25.4], [-1.6334, 12.6422, 3.3647, 42.05, 33.8, 30.25], [-2.0254, 12.3809, 3.2667, 54.75, 32.4, 35.45], [-2.5807, 12.0869, 3.3974, 64.75, 30.25, 41.25], [-3.2667, 11.6622, 3.8221, 73.35, 27.5, 47.6], [-4.1161, 11.2049, 4.4754, 80.25, 24.45, 54.15], [-4.8021, 10.8129, 5.3248, 85.95, 21.3, 60.65], [-5.4554, 10.4209, 6.3375, 91.5, 17.75, 66.7], [-6.0108, 10.1595, 7.3828, 98.25, 14.05, 71.95], [-6.4355, 9.9962, 8.2975, 106.95, 10.7, 76.3], [-6.7295, 9.8655, 9.0815, 117.6, 8.3, 79.6], [-6.7948, 9.7675, 9.3755, 129.3, 6.95, 81.9], [-6.6968, 9.7022, 9.3755, 141.8, 6.75, 82.85], [-6.4681, 9.6695, 8.9835, 151.0, 6.75, 82.75], [-6.1415, 9.6369, 8.3955, 157.25, 6.65, 81.55], [-5.7494, 9.5389, 7.7095, 159.9, 6.6, 79.3], [-5.3574, 9.4082, 6.9908, 158.9, 6.3, 76.3], [-4.9981, 9.2122, 6.3701, 154.75, 5.2, 73.0], [-4.7041, 8.9182, 5.8801, 148.3, 2.7, 69.75], [-4.4428, 8.5915, 5.6514, 140.75, -1.55, 66.55], [-4.3121, 8.1342, 5.5208, 133.25, -7.7, 62.75], [-4.1814, 7.7095, 5.5208, 125.85, -16.7, 59.3], [-4.1161, 7.2195, 5.6514, 120.75, -26.3, 56.0], [-4.0507, 6.7295, 5.7821, 117.05, -37.5, 52.85], [-3.9527, 6.2395, 5.9128, 114.6, -50.05, 49.6], [-3.8221, 5.7168, 6.0108, 113.1, -63.25, 46.0], [-3.6914, 5.2594, 6.0435, 112.4, -76.3, 41.55], [-3.4954, 4.7041, 6.0108, 112.25, -88.55, 36.25], [-3.2994, 4.2467, 5.9128, 112.4, -99.5, 30.25], [-3.1034, 3.8221, 5.6514, 112.5, -108.65, 23.7], [-2.9401, 3.3647, 5.3574, 112.0, -116.3, 15.85], [-2.8094, 2.9401, 4.9981, 110.15, -120.35, 8.65], [-2.7441, 2.548, 4.5408, 107.05, -121.65, 1.5], [-2.7114, 2.2214, 4.0834, 102.2, -120.35, -5.1], [-2.8094, 1.9927, 3.5934, 95.5, -116.8, -10.6], [-2.9727, 1.862, 3.1034, 87.1, -111.15, -14.75], [-3.1687, 1.8294, 2.5807, 77.3, -103.55, -17.35], [-3.3647, 2.0254, 2.058, 66.5, -94.4, -18.55], [-3.5934, 2.3847, 1.5027, 55.1, -84.2, -18.5], [-3.7894, 3.0054, 0.8493, 43.5, -73.25, -17.35], [-3.9527, 3.8874, -0.098, 31.9, -61.55, -14.95], [-4.0507, 4.9981, -0.98, 18.5, -48.0, -11.8], [-4.0507, 6.3375, -1.862, 6.2, -36.55, -8.15], [-3.9854, 7.8402, -2.6461, -5.8, -26.1, -4.55], [-3.8221, 9.4409, -3.3321, -16.45, -16.95, -1.3], [-3.6914, 11.1069, -3.9527, -25.05, -9.25, 1.35], [-3.5281, 12.6422, -4.4101, -31.4, -3.25, 3.4], [-3.3321, 14.0143, -4.5408, -35.9, 0.3, 4.75], [-3.0707, 14.7983, -4.3774, -38.95, 0.35, 4.95], [-2.8421, 15.125, -3.8547, -39.6, -3.15, 3.2], [-2.6787, 15.0596, -3.2667, -37.35, -10.55, -1.3], [-2.5807, 14.6676, -2.5807, -32.3, -19.7, -7.1], [-2.6134, 14.0143, -1.8294, -26.85, -30.5, -14.1], [-2.8094, 13.0996, -1.0127, -22.0, -41.65, -21.6], [-3.2667, 12.1522, -0.1633, -18.8, -51.65, -28.65], [-3.8547, 11.3029, 0.6533, -17.3, -58.7, -34.3], [-4.4754, 10.7149, 1.3394, -17.35, -61.7, -37.9], [-5.1288, 10.3229, 2.0254, -18.55, -60.8, -39.15], [-5.6841, 10.1595, 2.6134, -20.15, -56.25, -38.15], [-6.1741, 10.0615, 3.1361, -21.85, -47.95, -34.65], [-6.5008, 9.9635, 3.5281, -23.95, -34.7, -27.8], [-6.5988, 9.7675, 3.7894, -27.45, -21.15, -19.95], [-6.3701, 9.3102, 4.0181, -31.7, -8.05, -12.25], [-5.9454, 8.5588, 4.2467, -36.6, 3.15, -6.3], [-5.3574, 7.5461, 4.4428, -42.15, 12.5, -2.3], [-4.8348, 6.3375, 4.5734, -49.45, 21.15, 0.35], [-4.3121, 5.0961, 4.6714, -60.25, 29.5, 2.2], [-3.6914, 3.8547, 4.8348, -75.1, 36.75, 2.85], [-3.1034, 3.2014, 5.0961, -92.45, 42.15, 1.9], [-2.5807, 2.9727, 5.4881, -109.7, 46.0, -0.45], [-2.1887, 3.3321, 5.8474, -124.3, 49.15, -3.65], [-1.9274, 4.1487, 6.1088, -135.9, 51.2, -6.25], [-1.7967, 5.2594, 6.2068, -141.95, 52.3, -8.2], [-1.7314, 6.4681, 6.2395, -144.4, 51.8, -9.6], [-1.7967, 7.5788, 6.1415, -143.4, 49.55, -10.65], [-1.9274, 8.5262, 5.9454, -139.15, 45.8, -11.35], [-2.156, 9.2448, 5.6841, -132.25, 41.0, -11.9], [-2.45, 9.4735, 5.3248, -123.75, 35.45, -12.35], [-2.7767, 9.3428, 4.9328, -115.15, 29.8, -12.65], [-3.0381, 9.0162, 4.5734, -107.45, 24.7, -12.75], [-3.2014, 8.5588, 4.3448, -100.2, 19.65, -12.85], [-3.3321, 8.1015, 4.2141, -94.6, 15.95, -13.35], [-3.4301, 7.7095, 4.1814, -89.45, 13.25, -14.15], [-3.4954, 7.4481, 4.1814, -84.65, 12.15, -14.9], [-3.5281, 7.3175, 4.2467, -80.45, 12.9, -15.0], [-3.5281, 7.3175, 4.2794, -77.2, 15.35, -14.3], [-3.4954, 7.4155, 4.3121, -75.1, 18.9, -12.95], [-3.4627, 7.5461, 4.3121, -74.2, 22.85, -11.15], [-3.4301, 7.6441, 4.3448, -74.25, 26.85, -9.1], [-3.3974, 7.7422, 4.3448, -74.9, 30.75, -6.85], [-3.3647, 7.7422, 4.3774, -75.9, 33.15, -5.2], [-3.2994, 7.6768, 4.4101, -76.7, 34.35, -4.2], [-3.2667, 7.5788, 4.4428, -77.25, 34.3, -4.15], [-3.2667, 7.4481, 4.5081, -77.65, 33.3, -5.0], [-3.2994, 7.3175, 4.5408, -77.9, 31.75, -6.5], [-3.3647, 7.2521, 4.5081, -77.95, 30.1, -8.45], [-3.3974, 7.2521, 4.4428, -77.9, 28.8, -10.35], [-3.4301, 7.3828, 4.3121, -77.95, 28.2, -12.0], [-3.4627, 7.6115, 4.0181, -78.45, 28.6, -13.0], [-3.4301, 7.9708, 3.7241, -79.6, 30.1, -13.15], [-3.3974, 8.3955, 3.3974, -81.45, 32.25, -12.2], [-3.2994, 8.8528, 3.1361, -83.15, 34.85, -10.35], [-3.2341, 9.4082, 2.9727, -84.6, 37.55, -7.65], [-3.1361, 9.8982, 2.9401, -85.4, 39.9, -4.25], [-3.0381, 10.3882, 3.0054, -85.3, 41.8, -0.35], [-2.9401, 10.9109, 3.2667, -83.65, 43.2, 3.85], [-2.8421, 11.3356, 3.5934, -79.8, 44.2, 8.2], [-2.7114, 11.7276, 3.9854, -73.5, 44.8, 12.5], [-2.5154, 12.0869, 4.4101, -64.95, 45.05, 17.0], [-2.2867, 12.4136, 4.6388, -53.55, 44.8, 20.4], [-2.058, 12.7402, 4.7694, -42.45, 44.5, 23.25], [-1.7967, 13.0343, 4.8021, -30.6, 44.4, 25.45], [-1.6007, 13.3283, 4.7368, -17.6, 44.4, 27.25], [-1.4047, 13.5243, 4.5734, -3.3, 44.4, 28.85], [-1.372, 13.6223, 4.3121, 11.95, 44.35, 30.55], [-1.4047, 13.5569, 3.9854, 27.3, 44.25, 32.6], [-1.5354, 13.3609, 3.7241, 41.9, 44.0, 35.15], [-1.7967, 13.0343, 3.5607, 55.25, 43.4, 38.3], [-2.156, 12.6096, 3.5607, 67.05, 41.8, 42.6], [-2.6134, 12.1196, 3.7241, 78.1, 38.55, 46.95], [-3.1361, 11.5642, 4.1814, 85.5, 34.6, 51.55], [-3.6914, 11.0415, 4.8674, 90.75, 29.85, 56.15], [-4.2467, 10.5842, 5.7821, 94.65, 24.35, 60.55], [-4.7041, 10.3229, 6.7948, 98.8, 18.2, 64.4], [-5.1288, 10.1922, 7.8402, 104.7, 11.6, 67.65], [-5.4881, 10.1269, 8.7222, 113.05, 5.2, 69.9], [-5.7168, 10.0615, 9.3428, 123.9, -0.05, 71.05], [-5.8148, 10.0615, 9.6369, 136.15, -4.05, 71.4], [-5.7821, 10.0289, 9.4735, 148.2, -7.6, 71.25], [-5.6514, 9.9962, 9.0488, 159.35, -10.15, 70.6], [-5.4228, 9.8982, 8.3628, 165.7, -12.5, 69.25], [-5.1941, 9.7349, 7.5788, 167.85, -14.5, 67.2], [-4.9654, 9.5062, 6.8601, 165.95, -16.2, 64.65], [-4.6714, 9.2448, 6.2721, 160.65, -18.25, 62.1], [-4.4754, 8.9182, 5.8474, 153.05, -21.25, 59.65], [-4.2794, 8.5262, 5.6188, 144.5, -25.5, 57.1], [-4.2141, 8.1015, 5.6188, 136.4, -31.0, 54.1], [-4.1487, 7.6441, 5.6841, 129.6, -37.75, 50.65], [-4.1161, 7.1541, 5.8148, 124.55, -46.65, 46.6], [-4.0834, 6.6315, 5.9454, 120.7, -55.75, 43.05], [-4.0507, 6.0761, 6.0435, 118.5, -65.85, 39.5], [-3.9854, 5.5534, 6.0761, 117.05, -76.3, 35.6], [-3.8547, 4.9981, 6.0108, 116.0, -86.5, 31.25], [-3.7241, 4.4101, 5.9128, 115.05, -95.8, 26.35], [-3.5934, 3.8874, 5.7168, 113.95, -103.75, 21.05], [-3.4627, 3.3321, 5.4228, 112.4, -110.1, 15.4], [-3.2994, 2.8421, 5.0961, 110.15, -114.75, 9.35], [-3.2014, 2.3847, 4.6714, 106.95, -117.45, 3.0], [-3.1361, 1.9927, 4.2794, 102.65, -118.25, -4.25], [-3.1034, 1.6987, 3.8221, 96.3, -117.15, -10.45], [-3.1361, 1.5027, 3.3647, 89.4, -114.55, -16.0], [-3.2667, 1.4374, 2.8747, 81.45, -110.45, -20.5], [-3.4627, 1.47, 2.45, 72.75, -104.95, -23.8], [-3.6587, 1.6987, 1.9274, 63.55, -98.0, -25.65], [-3.8547, 2.2214, 1.3067, 53.9, -89.75, -26.1], [-4.0507, 2.9401, 0.5553, 43.95, -80.05, -25.2], [-4.2467, 3.8874, -0.3267, 33.45, -69.0, -22.9], [-4.3448, 5.1614, -1.4047, 22.0, -57.15, -18.8], [-4.3774, 6.5661, -2.3194, 8.2, -43.85, -14.3], [-4.3774, 8.1015, -3.1687, -4.0, -32.55, -9.5], [-4.3121, 9.7349, -3.9201, -15.3, -22.15, -4.8], [-4.2141, 11.3682, -4.5408, -24.95, -13.05, -0.4], [-4.0507, 12.8709, -4.9328, -32.55, -5.75, 3.55], [-3.8547, 14.0143, -4.9981, -38.4, -1.3, 6.9], [-3.5934, 14.8636, -4.7368, -42.1, -0.2, 9.0], [-3.3647, 15.1576, -4.2467, -42.95, -2.15, 9.2], [-3.1687, 15.0596, -3.5607, -41.15, -6.55, 7.55], [-3.0054, 14.7003, -2.8747, -37.65, -14.15, 3.8], [-2.9727, 14.0143, -2.058, -32.95, -22.45, -1.2], [-3.1361, 13.1976, -1.2087, -29.35, -31.1, -7.25], [-3.4627, 12.3482, -0.3267, -26.95, -39.0, -13.45], [-4.0507, 11.6949, 0.4573, -25.55, -44.55, -18.95], [-4.6388, 11.2702, 1.176, -24.8, -47.35, -23.1], [-5.1941, 11.0415, 1.7967, -24.45, -47.9, -25.8], [-5.7168, 10.9109, 2.4174, -23.85, -46.05, -27.05], [-6.1415, 10.8129, 2.8747, -22.75, -41.15, -26.45], [-6.4355, 10.6169, 3.2994, -21.5, -33.7, -23.4], [-6.4681, 10.2249, 3.5934, -20.6, -23.65, -17.85], [-6.2068, 9.5062, 3.8547, -20.75, -14.8, -13.0], [-5.7821, 8.4608, 4.1161, -22.65, -7.15, -9.4], [-5.3248, 7.1215, 4.3774, -26.7, 0.05, -7.2], [-4.8021, 5.7168, 4.5734, -33.8, 8.3, -5.4], [-4.2794, 4.3774, 4.7368, -45.05, 17.3, -3.45], [-3.6914, 3.1361, 4.9654, -60.6, 25.6, -2.0], [-3.0054, 2.5807, 5.2268, -79.2, 32.5, -1.6], [-2.3847, 2.6134, 5.5534, -98.4, 38.0, -2.25], [-1.862, 3.2341, 5.8801, -115.0, 42.4, -3.25], [-1.47, 4.3774, 6.1415, -128.25, 46.35, -3.95], [-1.2087, 5.7494, 6.2395, -135.1, 48.05, -4.4], [-1.078, 7.1215, 6.1741, -137.9, 47.05, -4.95], [-1.1107, 8.2975, 6.0108, -137.0, 43.45, -5.9], [-1.3394, 9.2448, 5.7168, -132.7, 38.15, -7.45], [-1.764, 9.8002, 5.3248, -125.6, 31.9, -9.35], [-2.2867, 9.8982, 4.8674, -117.05, 25.55, -11.25], [-2.8421, 9.6042, 4.4101, -108.95, 19.95, -12.85], [-3.2994, 9.1142, 3.9527, -102.6, 15.55, -13.85], [-3.6261, 8.5262, 3.6587, -98.2, 12.25, -14.6], [-3.8547, 8.0035, 3.4954, -94.65, 11.05, -15.2], [-3.9527, 7.5788, 3.4954, -92.2, 11.4, -15.7], [-3.9201, 7.3175, 3.6261, -90.0, 13.2, -15.85], [-3.8221, 7.1868, 3.7894, -88.0, 16.2, -15.4], [-3.6587, 7.2195, 3.9854, -86.3, 19.7, -14.45], [-3.4954, 7.3501, 4.1814, -84.9, 23.05, -13.2], [-3.3321, 7.5788, 4.3448, -83.65, 25.85, -11.95], [-3.2014, 7.7095, 4.4428, -82.5, 27.85, -10.7], [-3.1034, 7.8728, 4.5081, -81.5, 28.9, -9.55], [-3.0054, 7.9382, 4.4754, -80.4, 29.0, -8.9], [-2.9727, 7.9382, 4.4754, -79.55, 28.3, -8.75], [-2.9727, 7.8402, 4.3774, -79.1, 27.05, -9.25], [-3.0381, 7.7095, 4.3121, -79.2, 25.6, -10.3], [-3.1361, 7.5788, 4.2467, -79.8, 24.15, -11.8], [-3.2667, 7.4808, 4.1814, -80.6, 23.05, -13.5], [-3.3974, 7.4808, 4.1161, -81.5, 22.4, -15.15], [-3.4954, 7.5788, 3.9854, -82.3, 22.45, -16.5], [-3.5934, 7.8075, 3.8547, -83.0, 23.15, -17.35], [-3.6261, 8.1342, 3.6261, -83.8, 24.3, -17.4], [-3.6261, 8.5588, 3.4301, -84.55, 26.0, -16.5], [-3.6261, 9.0815, 3.2014, -84.9, 27.75, -14.7], [-3.5934, 9.5715, 3.0381, -84.7, 29.7, -12.0], [-3.5281, 10.0615, 2.9401, -83.85, 31.6, -8.5], [-3.4627, 10.4862, 2.9401, -82.3, 33.4, -4.3], [-3.3647, 10.9109, 3.1034, -79.95, 35.1, 0.45], [-3.2341, 11.3682, 3.3974, -76.2, 36.8, 5.55], [-3.0707, 11.7276, 3.7567, -70.5, 38.65, 10.85], [-2.8421, 12.0542, 4.1487, -62.55, 40.4, 16.05], [-2.548, 12.3156, 4.4428, -52.7, 42.2, 21.3], [-2.254, 12.5769, 4.6061, -39.55, 43.65, 25.2], [-1.9927, 12.8709, 4.6388, -26.15, 45.15, 28.35], [-1.8294, 13.0669, 4.5081, -10.85, 46.75, 30.8], [-1.764, 13.1976, 4.2141, 5.85, 48.4, 32.95], [-1.8294, 13.1649, 3.7567, 22.8, 50.15, 35.0], [-1.96, 12.9689, 3.2994, 38.3, 52.3, 37.45], [-2.2214, 12.7076, 2.9074, 51.25, 54.8, 40.6], [-2.5807, 12.3482, 2.6787, 61.25, 57.15, 44.9], [-3.0054, 11.9236, 2.7441, 68.25, 58.6, 51.2], [-3.3974, 11.4989, 3.1687, 72.85, 58.55, 57.8], [-3.7894, 11.0742, 3.9527, 74.65, 56.9, 64.75], [-4.0834, 10.7475, 5.0634, 75.55, 53.6, 71.6], [-4.2794, 10.5842, 6.3701, 77.65, 48.4, 77.9], [-4.4754, 10.5515, 7.7422, 82.85, 41.0, 83.15], [-4.6061, 10.5842, 9.0162, 92.05, 31.85, 86.65], [-4.6714, 10.6495, 9.9635, 105.25, 22.0, 87.9], [-4.7041, 10.6822, 10.4862, 121.2, 12.55, 86.9], [-4.7041, 10.7475, 10.5842, 138.05, 4.1, 84.3], [-4.7041, 10.7149, 10.1595, 153.5, -3.3, 80.4], [-4.6714, 10.6169, 9.4082, 166.75, -10.45, 76.35], [-4.6714, 10.3882, 8.4282, 173.3, -15.6, 71.9], [-4.6388, 10.0615, 7.4481, 174.25, -19.55, 67.25], [-4.6388, 9.7349, 6.5335, 170.1, -22.5, 63.0], [-4.6388, 9.3102, 5.8474, 162.15, -25.05, 59.6], [-4.6061, 8.8528, 5.3248, 151.85, -27.85, 57.05], [-4.6388, 8.2648, 5.0634, 140.8, -31.4, 54.95], [-4.5734, 7.6768, 4.9328, 130.3, -36.1, 52.85], [-4.5408, 7.0888, 4.9328, 121.25, -42.1, 50.55], [-4.4428, 6.5335, 5.0308, 114.05, -50.3, 47.7], [-4.3448, 5.9128, 5.1288, 108.2, -58.75, 44.95], [-4.2141, 5.3248, 5.2268, 104.65, -68.25, 41.75], [-4.0181, 4.7694, 5.2594, 102.1, -78.45, 37.75], [-3.7567, 4.2794, 5.2268, 100.4, -88.75, 32.85], [-3.5281, 3.7894, 5.1614, 99.2, -98.35, 26.95], [-3.3321, 3.2994, 5.0308, 98.2, -106.7, 20.15], [-3.1034, 2.8421, 4.8348, 96.8, -113.5, 12.6], [-2.9401, 2.45, 4.5734, 94.6, -118.6, 4.45], [-2.8094, 2.0907, 4.2141, 91.35, -121.8, -5.05], [-2.7767, 1.7967, 3.8874, 86.3, -123.0, -13.4], [-2.8094, 1.6007, 3.5281, 80.7, -121.9, -21.05], [-2.9401, 1.568, 3.1687, 74.05, -118.9, -27.5], [-3.1034, 1.666, 2.7767, 66.6, -114.1, -32.25], [-3.3647, 1.9274, 2.3847, 58.65, -107.4, -34.9], [-3.5934, 2.3847, 1.8947, 50.2, -98.8, -35.2], [-3.8221, 3.0381, 1.2414, 41.1, -88.3, -33.15], [-4.0507, 4.0834, 0.49, 31.25, -76.05, -28.85], [-4.1487, 5.2594, -0.392, 20.45, -62.65, -22.6], [-4.1814, 6.6315, -1.4047, 8.55, -48.8, -13.85], [-4.1161, 8.1668, -2.254, -5.35, -33.45, -5.55], [-3.9527, 9.7675, -3.0054, -16.85, -20.95, 2.4], [-3.7567, 11.3356, -3.6914, -26.6, -10.2, 9.1], [-3.5607, 12.8382, -4.1814, -33.6, -2.1, 14.05], [-3.2994, 14.0796, -4.4428, -37.45, 2.45, 16.8], [-3.0381, 14.929, -4.4101, -38.3, 2.85, 17.05], [-2.8421, 15.3536, -4.1487, -36.4, -0.85, 14.65], [-2.7441, 15.321, -3.6914, -31.95, -8.1, 9.55], [-2.7114, 14.9616, -3.1687, -25.9, -18.3, 2.3], [-2.8747, 14.4063, -2.4174, -19.6, -30.35, -7.5], [-3.2014, 13.6876, -1.6334, -13.65, -43.9, -16.6], [-3.7241, 12.9689, -0.7513, -10.35, -54.15, -24.65], [-4.3774, 12.4136, 0.1633, -9.0, -60.95, -30.4], [-5.1614, 11.9236, 1.0454, -8.85, -63.5, -33.3], [-5.7494, 11.6296, 1.862, -9.15, -62.25, -33.45], [-6.2721, 11.4009, 2.5807, -9.0, -57.05, -31.1], [-6.6315, 11.0415, 3.2014, -8.25, -47.65, -26.55], [-6.8275, 10.5515, 3.6587, -7.65, -35.45, -19.8], [-6.7295, 9.7675, 3.9854, -8.25, -22.3, -11.6], [-6.3375, 8.7222, 4.1814, -10.6, -8.9, -3.3], [-5.7494, 7.4155, 4.3448, -16.0, 0.1, 1.1], [-5.1614, 6.0108, 4.4428, -23.35, 6.85, 2.55], [-4.6061, 4.6061, 4.5408, -33.75, 13.25, 1.85], [-4.0507, 3.4301, 4.6714, -48.35, 18.85, 0.1], [-3.5281, 2.6461, 4.8674, -67.1, 22.85, -2.2], [-3.0054, 2.3847, 5.1288, -88.1, 25.5, -5.2], [-2.5154, 2.7441, 5.5208, -108.4, 27.65, -8.55], [-2.1234, 3.6587, 5.9128, -125.25, 30.2, -11.3], [-1.862, 4.9328, 6.2395, -137.25, 33.2, -13.0], [-1.6987, 6.3048, 6.3375, -145.1, 35.85, -13.25], [-1.6007, 7.6115, 6.3375, -147.75, 35.95, -12.8], [-1.568, 8.6568, 6.1415, -146.35, 34.25, -12.2], [-1.7314, 9.3428, 5.8474, -141.0, 31.3, -12.1], [-2.0907, 9.6695, 5.3901, -132.85, 27.4, -12.6], [-2.4827, 9.6369, 4.8674, -123.7, 22.8, -13.55], [-2.9074, 9.2448, 4.3448, -115.55, 18.1, -14.6], [-3.2994, 8.7548, 3.8547, -109.3, 14.15, -15.25], [-3.5934, 8.2322, 3.5607, -104.65, 11.55, -15.55], [-3.7567, 7.8075, 3.3974, -100.8, 10.5, -15.6], [-3.7894, 7.5135, 3.3974, -96.9, 11.35, -15.3], [-3.7894, 7.3828, 3.4954, -93.7, 13.65, -14.45], [-3.6914, 7.4155, 3.6587, -90.75, 17.35, -12.85], [-3.5607, 7.5461, 3.8874, -87.75, 21.85, -10.5], [-3.4301, 7.7422, 4.0834, -84.6, 26.55, -7.8], [-3.2667, 7.8728, 4.2467, -81.35, 30.8, -5.05], [-3.1687, 8.0362, 4.3448, -78.4, 34.2, -2.5], [-3.0707, 8.1342, 4.4428, -76.1, 36.6, -0.25], [-3.0381, 8.1015, 4.5081, -74.4, 37.75, 1.4], [-3.0054, 8.0035, 4.5734, -73.15, 37.8, 2.3], [-3.0381, 7.8402, 4.6388, -72.1, 36.9, 2.15], [-3.1034, 7.6115, 4.7041, -71.6, 35.35, 1.0], [-3.2014, 7.3828, 4.7368, -71.5, 33.5, -0.9], [-3.3647, 7.1868, 4.7694, -71.85, 31.75, -3.3], [-3.4954, 7.0888, 4.7694, -72.35, 30.3, -5.9], [-3.5934, 7.0888, 4.6714, -72.95, 29.4, -8.5], [-3.6587, 7.1868, 4.5408, -73.65, 28.95, -10.75], [-3.6587, 7.4481, 4.3121, -74.85, 28.85, -12.45], [-3.6261, 7.8402, 3.9854, -76.65, 28.95, -13.45], [-3.5281, 8.3302, 3.6914, -79.25, 29.25, -13.35], [-3.3974, 8.8855, 3.4301, -81.6, 29.6, -12.2], [-3.2341, 9.5389, 3.2667, -83.4, 30.05, -10.2], [-3.0707, 10.1595, 3.2341, -84.25, 30.45, -7.35], [-2.9074, 10.7475, 3.3321, -83.7, 30.85, -3.75], [-2.8094, 11.2376, 3.5281, -81.35, 31.45, 0.5], [-2.7441, 11.7276, 3.8547, -76.65, 32.4, 5.15], [-2.6787, 12.0869, 4.1487, -69.3, 33.75, 10.1], [-2.6461, 12.3156, 4.3774, -59.35, 35.55, 14.9], [-2.5807, 12.4462, 4.5081, -47.35, 37.65, 19.95], [-2.5807, 12.5116, 4.4754, -32.2, 40.55, 24.0], [-2.6134, 12.5116, 4.2794, -18.05, 43.7, 27.6], [-2.6787, 12.4789, 3.9201, -3.7, 47.5, 30.9], [-2.7767, 12.3482, 3.4954, 10.1, 51.9, 34.1], [-2.8421, 12.1849, 3.0054, 22.5, 56.85, 37.35], [-2.9074, 11.9889, 2.6134, 32.8, 62.15, 40.95], [-2.9401, 11.7602, 2.3847, 40.55, 67.25, 45.2], [-3.0054, 11.5642, 2.3847, 45.85, 71.2, 50.25], [-3.0054, 11.3356, 2.7767, 49.05, 72.9, 56.0], [-3.0381, 11.1396, 3.4954, 50.85, 71.25, 62.7], [-3.0707, 10.9762, 4.5081, 52.55, 66.4, 68.3], [-3.1034, 10.9109, 5.7821, 55.3, 58.3, 72.95], [-3.2014, 10.8782, 7.2195, 60.85, 47.15, 76.4], [-3.3321, 10.8782, 8.5915, 70.45, 33.5, 78.35], [-3.5281, 10.9109, 9.7675, 84.4, 18.45, 78.35], [-3.7567, 10.9109, 10.6495, 101.95, 3.55, 76.2], [-4.0181, 10.8455, 11.0742, 121.75, -9.55, 72.1], [-4.3121, 10.8129, 11.1069, 141.8, -20.0, 67.0], [-4.6061, 10.6822, 10.5515, 159.85, -27.45, 61.5], [-4.9001, 10.5189, 9.7022, 175.25, -32.4, 57.35], [-5.1288, 10.2575, 8.6895, 183.0, -33.95, 54.0], [-5.3248, 9.9309, 7.6441, 184.5, -33.5, 51.45], [-5.4881, 9.5062, 6.6641, 180.4, -31.7, 50.0], [-5.6188, 9.0815, 5.8801, 172.05, -29.2, 50.0], [-5.6514, 8.6242, 5.3574, 161.1, -26.95, 51.25], [-5.6188, 8.0362, 5.0308, 149.1, -25.7, 53.05], [-5.4881, 7.4808, 4.9328, 137.4, -26.1, 54.55], [-5.2921, 6.8601, 4.9328, 127.0, -28.25, 55.25], [-5.0634, 6.2721, 4.9981, 118.5, -32.15, 54.95], [-4.8021, 5.7168, 5.1288, 111.3, -38.45, 53.85], [-4.4754, 5.1614, 5.2268, 106.55, -45.6, 51.75], [-4.1161, 4.6061, 5.2921, 102.95, -54.0, 48.45], [-3.7567, 4.1161, 5.2594, 100.15, -63.05, 43.65], [-3.3647, 3.6261, 5.1941, 98.0, -72.05, 37.55], [-3.0707, 3.1687, 5.0634, 96.1, -80.4, 30.45], [-2.7767, 2.6461, 4.8348, 93.9, -87.7, 22.55], [-2.548, 2.2214, 4.5408, 91.0, -93.55, 14.2], [-2.4174, 1.8294, 4.2467, 87.15, -97.85, 5.5], [-2.352, 1.5027, 3.8547, 82.45, -100.3, -3.1], [-2.352, 1.3067, 3.4954, 76.9, -100.8, -12.1], [-2.4174, 1.274, 3.1034, 69.6, -99.25, -19.05], [-2.548, 1.4047, 2.6461, 62.15, -95.95, -24.55], [-2.6787, 1.6987, 2.156, 53.8, -91.0, -28.45], [-2.8747, 2.254, 1.5354, 44.5, -84.5, -30.6], [-3.0381, 3.1034, 0.8493, 34.55, -76.25, -30.95], [-3.1687, 4.2467, -0.0327, 23.8, -66.55, -29.3], [-3.2341, 5.8148, -0.9474, 11.75, -56.2, -25.65], [-3.2014, 7.4481, -1.7967, -1.4, -45.85, -20.55], [-3.1034, 9.1795, -2.6461, -14.3, -36.0, -14.85], [-3.0054, 10.9762, -3.2994, -25.45, -26.3, -8.65], [-2.8747, 12.7076, -3.7567, -34.45, -19.55, -3.8], [-2.7767, 14.2429, -4.0181, -38.7, -15.35, 0.1], [-2.6461, 15.321, -3.9527, -39.75, -14.7, 2.65], [-2.4827, 15.909, -3.6587, -37.55, -17.8, 3.1], [-2.45, 16.007, -3.1361, -31.55, -23.95, 0.8], [-2.5154, 15.6476, -2.6134, -22.45, -32.55, -3.9], [-2.7114, 14.9616, -2.058, -12.2, -43.0, -10.05], [-3.1034, 14.0796, -1.5027, -3.05, -53.75, -16.9], [-3.6261, 13.0669, -0.7513, 3.15, -63.3, -24.35], [-4.3121, 12.1849, -0.0327, 5.6, -70.9, -29.7], [-5.0308, 11.5642, 0.686, 4.75, -73.5, -33.05], [-5.7168, 11.1722, 1.4374, 2.35, -72.3, -33.95], [-6.3701, 11.0089, 2.0907, -0.55, -67.95, -32.65], [-6.8275, 10.9109, 2.7767, -2.95, -60.05, -29.4], [-7.0888, 10.7475, 3.3647, -4.45, -48.6, -24.2], [-7.1215, 10.3229, 3.8221, -5.2, -35.3, -17.35], [-6.8928, 9.6042, 4.1487, -5.8, -22.2, -10.0], [-6.4028, 8.5262, 4.3448, -7.05, -11.0, -4.2], [-5.8801, 7.0888, 4.4428, -10.05, -1.25, -0.7], [-5.3248, 5.4881, 4.4428, -17.2, 6.5, 0.25], [-4.8348, 3.9201, 4.4101, -28.65, 14.75, 0.3], [-4.2794, 2.6134, 4.4428, -46.05, 22.35, -0.05], [-3.5607, 1.7967, 4.6388, -68.55, 28.0, -1.15], [-2.9401, 1.6334, 4.9328, -93.6, 31.95, -3.3], [-2.3847, 2.156, 5.3574, -117.3, 35.4, -5.8], [-1.9274, 3.5281, 5.8474, -136.15, 38.95, -7.85], [-1.568, 5.1288, 6.2068, -148.75, 42.2, -8.95], [-1.274, 6.7948, 6.4355, -155.4, 43.65, -9.35], [-1.1107, 8.3302, 6.4681, -156.6, 41.55, -9.85], [-1.078, 9.5389, 6.3048, -151.75, 36.95, -10.75], [-1.3067, 10.2902, 6.0108, -142.45, 30.8, -12.4], [-1.666, 10.5515, 5.5534, -129.9, 23.7, -14.65], [-2.1887, 10.3229, 4.9981, -116.75, 16.2, -17.15], [-2.6787, 9.7349, 4.4101, -105.4, 9.05, -19.5], [-3.1034, 8.9182, 3.8874, -97.05, 3.0, -21.6], [-3.4627, 8.1668, 3.5281, -91.1, -1.45, -23.4], [-3.7241, 7.5788, 3.3321, -86.65, -3.85, -24.9], [-3.8547, 7.1541, 3.3321, -83.1, -3.95, -25.95], [-3.9201, 6.9255, 3.3974, -80.15, -1.65, -25.9], [-3.8874, 6.9581, 3.5281, -78.35, 2.2, -24.7], [-3.8221, 7.1215, 3.7567, -77.05, 6.9, -22.55], [-3.7241, 7.3828, 3.9854, -75.8, 11.65, -19.8], [-3.6261, 7.6441, 4.1814, -74.3, 16.0, -16.85], [-3.5281, 7.8402, 4.3121, -72.7, 19.65, -13.85], [-3.4301, 8.0035, 4.4428, -71.2, 22.45, -10.95], [-3.3647, 8.0362, 4.5081, -70.0, 24.4, -8.4], [-3.3647, 7.9382, 4.5408, -69.25, 25.65, -6.55], [-3.3647, 7.7422, 4.5734, -69.05, 26.3, -5.4], [-3.4301, 7.5135, 4.5734, -69.7, 26.45, -5.35], [-3.5281, 7.2521, 4.5734, -71.1, 26.55, -6.0], [-3.6587, 7.0561, 4.5734, -72.95, 26.8, -7.1], [-3.7894, 6.9255, 4.5408, -75.1, 27.5, -8.4], [-3.8547, 6.9255, 4.4428, -77.4, 28.4, -9.8], [-3.8221, 7.0235, 4.2467, -79.85, 29.4, -11.0], [-3.7567, 7.2848, 3.9854, -82.55, 30.3, -12.0], [-3.6261, 7.6768, 3.7241, -85.5, 31.0, -12.45], [-3.4627, 8.1342, 3.4301, -88.5, 31.6, -12.15], [-3.2341, 8.6895, 3.2341, -91.5, 31.95, -11.0], [-3.0054, 9.2448, 3.1687, -93.55, 31.8, -9.15], [-2.7767, 9.8329, 3.2341, -94.4, 31.15, -6.75], [-2.5807, 10.4209, 3.4954, -93.55, 30.15, -3.85], [-2.4174, 10.9762, 3.8547, -90.4, 29.15, -0.55], [-2.3194, 11.4662, 4.3121, -84.65, 28.15, 3.1], [-2.2214, 11.9236, 4.7694, -76.1, 27.2, 6.8], [-2.156, 12.3156, 5.1614, -65.05, 26.2, 10.35], [-2.1234, 12.6422, 5.3901, -52.15, 25.45, 13.4], [-2.0907, 12.9363, 5.4554, -37.9, 25.3, 16.5], [-2.156, 13.1649, 5.3248, -20.8, 26.1, 19.15], [-2.2214, 13.3609, 5.0308, -4.9, 27.8, 22.05], [-2.3847, 13.4589, 4.6061, 11.25, 30.15, 25.45], [-2.5807, 13.4263, 4.1487, 27.0, 33.3, 29.25], [-2.7767, 13.2629, 3.7241, 41.6, 37.1, 33.65], [-3.0381, 12.9689, 3.3647, 54.35, 41.15, 38.8], [-3.3647, 12.5442, 3.2014, 65.0, 44.6, 44.6], [-3.7241, 12.0542, 3.2667, 73.25, 46.65, 50.9], [-4.0834, 11.4989, 3.6261, 79.05, 46.85, 57.3], [-4.4101, 10.9762, 4.3121, 82.8, 44.85, 63.9], [-4.7368, 10.5189, 5.2268, 85.7, 41.35, 69.05], [-4.9981, 10.2249, 6.3048, 88.8, 36.35, 73.3], [-5.2268, 10.0289, 7.4155, 93.75, 29.95, 76.65], [-5.4228, 9.9635, 8.4282, 101.2, 22.95, 78.65], [-5.5208, 9.9309, 9.2122, 111.4, 16.25, 79.1], [-5.5208, 9.9309, 9.6695, 123.75, 10.35, 78.2], [-5.4228, 9.9635, 9.7675, 136.9, 5.45, 76.4], [-5.2594, 9.9635, 9.4735, 149.0, 1.25, 74.05], [-5.0634, 9.9635, 8.8528, 158.35, -2.3, 70.9], [-4.8348, 9.8329, 8.1342, 164.25, -5.9, 67.7], [-4.6388, 9.6369, 7.3828, 165.0, -8.75, 64.35], [-4.4428, 9.3755, 6.7621, 162.15, -11.65, 61.15], [-4.3121, 9.0488, 6.2721, 156.6, -14.9, 58.5], [-4.2141, 8.6568, 5.9454, 149.4, -18.75, 56.35], [-4.1814, 8.2322, 5.8148, 141.8, -23.2, 54.45], [-4.1487, 7.6441, 5.7821, 134.7, -28.55, 52.5], [-4.1487, 7.0888, 5.8148, 128.7, -34.75, 50.55], [-4.1161, 6.5335, 5.8474, 123.85, -41.85, 48.55], [-4.0834, 5.9454, 5.8801, 119.8, -49.75, 46.2], [-3.9854, 5.3901, 5.8474, 115.95, -59.25, 43.8], [-3.8547, 4.8674, 5.7494, 112.85, -67.85, 40.8], [-3.6914, 4.3448, 5.5861, 110.1, -76.1, 37.0], [-3.4954, 3.8874, 5.3901, 107.55, -83.6, 32.25], [-3.2341, 3.4301, 5.1288, 104.95, -90.0, 26.8], [-3.0381, 2.9727, 4.8348, 102.0, -94.9, 20.6], [-2.8421, 2.5154, 4.5081, 98.4, -98.25, 13.75], [-2.7114, 2.1234, 4.1814, 94.0, -100.0, 6.35], [-2.6134, 1.8294, 3.7894, 88.6, -100.15, -1.3], [-2.6134, 1.5354, 3.4301, 82.25, -98.7, -9.5], [-2.6787, 1.372, 3.1034, 73.9, -95.95, -16.0], [-2.8094, 1.372, 2.7441, 65.65, -91.65, -21.35], [-3.0054, 1.5027, 2.352, 56.85, -86.05, -25.3], [-3.2014, 1.8294, 1.8294, 47.6, -79.05, -27.65], [-3.3974, 2.4174, 1.176, 37.85, -70.25, -28.25], [-3.5607, 3.2994, 0.294, 27.6, -59.35, -27.1], [-3.7241, 4.6388, -0.7513, 16.25, -47.0, -24.0], [-3.7894, 6.1741, -1.7967, 3.25, -34.15, -19.15], [-3.7567, 7.9055, -2.8747, -10.6, -21.2, -12.45], [-3.6261, 9.8002, -3.7241, -25.35, -7.25, -6.25], [-3.4954, 11.7276, -4.4428, -36.45, 3.75, -0.35], [-3.3321, 13.5569, -4.9328, -44.7, 12.6, 4.8], [-3.1034, 15.0596, -5.0308, -50.15, 17.7, 8.9], [-2.8094, 16.0723, -4.7368, -53.0, 17.75, 11.4], [-2.5807, 16.497, -4.1487, -52.25, 13.35, 11.3], [-2.4174, 16.4317, -3.3974, -47.15, 5.55, 8.0], [-2.4174, 15.9416, -2.6787, -39.25, -5.35, 2.1], [-2.6134, 15.1903, -1.8947, -31.05, -18.0, -5.45], [-3.0381, 14.2756, -0.9147, -24.85, -30.5, -14.4], [-3.6261, 13.3936, 0.0653, -21.4, -42.5, -21.25], [-4.2467, 12.7076, 1.1107, -20.15, -49.85, -26.25], [-4.8674, 12.2829, 2.0907, -18.8, -53.55, -29.25], [-5.4881, 12.0216, 2.9727, -16.25, -52.95, -29.9], [-5.9781, 11.7276, 3.7894, -12.55, -47.45, -27.85], [-6.2721, 11.3029, 4.4754, -8.35, -37.7, -23.15], [-6.3375, 10.4535, 5.0308, -4.05, -26.0, -16.45], [-6.1088, 9.3102, 5.3574, 0.1, -15.0, -9.4], [-5.6514, 7.7748, 5.4881, 3.05, -6.1, -4.25], [-5.1614, 5.9781, 5.3248, 3.05, 2.35, -1.75], [-4.7694, 4.1487, 4.9981, -2.85, 10.25, -1.65], [-4.3774, 2.5154, 4.6714, -15.95, 17.65, -2.35], [-3.9201, 1.274, 4.4428, -36.85, 23.05, -3.7], [-3.3321, 0.7513, 4.3774, -63.25, 26.3, -5.5], [-2.8094, 1.0127, 4.5408, -91.7, 29.0, -7.9], [-2.3847, 2.254, 4.9001, -118.15, 32.85, -10.35], [-2.058, 3.8874, 5.4228, -139.05, 37.85, -11.95], [-1.7314, 5.7168, 5.8801, -153.05, 42.05, -12.45], [-1.47, 7.5135, 6.3048, -160.35, 43.2, -12.5], [-1.2414, 9.0162, 6.5008, -161.0, 40.3, -13.1], [-1.2414, 10.0942, 6.5008, -154.25, 35.05, -14.65], [-1.4047, 10.6495, 6.2721, -142.9, 28.2, -17.25], [-1.6987, 10.5842, 5.8474, -128.7, 20.0, -20.5], [-2.0907, 10.0289, 5.2921, -114.65, 10.65, -23.95], [-2.4827, 9.2775, 4.6714, -103.45, 1.05, -27.35], [-2.8421, 8.4608, 4.1161, -95.7, -7.55, -30.7], [-3.2014, 7.6441, 3.7567, -90.35, -13.8, -33.75], [-3.4954, 7.0888, 3.5934, -86.45, -17.0, -36.0], [-3.7567, 6.7295, 3.5607, -83.55, -16.9, -37.05], [-3.9527, 6.6315, 3.6587, -81.45, -13.35, -36.45], [-4.0834, 6.7295, 3.7894, -80.05, -8.0, -34.45], [-4.1814, 6.9581, 3.9527, -79.25, -1.4, -31.25], [-4.1814, 7.1868, 4.0834, -78.3, 5.8, -27.25], [-4.1814, 7.4155, 4.2141, -77.3, 12.95, -22.75], [-4.1161, 7.5461, 4.2467, -76.65, 19.5, -18.0], [-4.0181, 7.6115, 4.2794, -76.65, 24.95, -13.65], [-3.9201, 7.5788, 4.3121, -77.35, 28.9, -10.2], [-3.7894, 7.4808, 4.3774, -78.6, 31.3, -8.05], [-3.7241, 7.3501, 4.3774, -80.25, 32.45, -7.1], [-3.6587, 7.2521, 4.4428, -82.6, 32.85, -7.4], [-3.6261, 7.2195, 4.4754, -84.85, 32.9, -8.4], [-3.6261, 7.2521, 4.4754, -87.0, 32.95, -9.7], [-3.5607, 7.3828, 4.4101, -88.9, 33.15, -11.15], [-3.4954, 7.6441, 4.2467, -90.45, 33.55, -12.3], [-3.3974, 7.9708, 4.0181, -91.8, 34.3, -12.75], [-3.2667, 8.4608, 3.7241, -93.2, 35.25, -12.25], [-3.1361, 8.9508, 3.4627, -94.55, 36.25, -10.85], [-3.0054, 9.4735, 3.2667, -95.55, 37.0, -8.5], [-2.8747, 9.9635, 3.2341, -95.75, 37.25, -4.9], [-2.7441, 10.4535, 3.3321, -94.5, 37.1, -1.0], [-2.6787, 10.9435, 3.5934, -91.75, 36.7, 3.35], [-2.5807, 11.4009, 4.0181, -86.95, 36.05, 7.95], [-2.5154, 11.8256, 4.5081, -79.65, 35.25, 12.5], [-2.4174, 12.2176, 5.0308, -69.6, 34.2, 16.75], [-2.3194, 12.6096, 5.4228, -57.1, 33.2, 20.5], [-2.1887, 13.0016, 5.6841, -42.65, 32.5, 23.55], [-2.0907, 13.3283, 5.7494, -26.65, 32.45, 25.85], [-2.0907, 13.5896, 5.5534, -9.35, 33.05, 27.75], [-2.1234, 13.7529, 5.1941, 8.65, 34.45, 29.9], [-2.254, 13.7529, 4.6714, 28.55, 37.05, 32.15], [-2.45, 13.5896, 4.1161, 44.35, 40.5, 35.1], [-2.6787, 13.3283, 3.5934, 57.45, 44.7, 38.9], [-2.9727, 12.9036, 3.2667, 67.5, 48.95, 43.75], [-3.3321, 12.4462, 3.1687, 74.65, 52.3, 49.5], [-3.6587, 11.8909, 3.4301, 79.3, 53.9, 55.8], [-3.9527, 11.2702, 4.0181, 81.85, 53.4, 62.1], [-4.1814, 10.7802, 4.9654, 83.45, 50.65, 67.95], [-4.3121, 10.4535, 6.2721, 85.75, 45.4, 72.8], [-4.4428, 10.2249, 7.4808, 90.8, 36.45, 76.75], [-4.5408, 10.1269, 8.6242, 101.1, 26.45, 78.4], [-4.6388, 10.0615, 9.4735, 114.2, 15.7, 78.05], [-4.7041, 10.0289, 9.9635, 129.75, 5.4, 76.0], [-4.7368, 10.0289, 10.0289, 145.9, -3.6, 73.05], [-4.7041, 9.9962, 9.7022, 160.65, -11.1, 69.75], [-4.7041, 9.8982, 9.0162, 172.25, -17.2, 66.35], [-4.7368, 9.8002, 8.1995, 179.4, -21.75, 62.95], [-4.7368, 9.6042, 7.3501, 181.35, -24.8, 59.9], [-4.7694, 9.3102, 6.5008, 178.5, -26.45, 57.2], [-4.7368, 8.9835, 5.9454, 170.9, -27.45, 55.8], [-4.7041, 8.6568, 5.6188, 161.8, -28.45, 55.0], [-4.7041, 8.1995, 5.4554, 152.1, -30.2, 54.4], [-4.6388, 7.7748, 5.4228, 143.1, -33.0, 53.65], [-4.5734, 7.2521, 5.5208, 135.45, -37.0, 52.7], [-4.4754, 6.7295, 5.6188, 129.4, -42.2, 51.4], [-4.3774, 6.1088, 5.7168, 124.6, -48.75, 49.75], [-4.2467, 5.5534, 5.7494, 120.65, -56.55, 47.7], [-4.0834, 5.0308, 5.7168, 117.3, -65.25, 44.95], [-3.8874, 4.5408, 5.6514, 114.3, -75.35, 41.0], [-3.6914, 4.0181, 5.4881, 111.25, -83.85, 36.55], [-3.4301, 3.5607, 5.3248, 108.45, -91.45, 31.15], [-3.2341, 3.0707, 5.0961, 105.2, -97.7, 24.8], [-3.0707, 2.6134, 4.8021, 101.4, -102.35, 17.7], [-2.9401, 2.156, 4.5081, 96.8, -105.25, 10.0], [-2.8421, 1.764, 4.1814, 91.4, -106.4, 1.95], [-2.8421, 1.4374, 3.8221, 85.15, -105.8, -6.05], [-2.9401, 1.2087, 3.4627, 78.1, -103.5, -13.45], [-3.0707, 1.1434, 3.0381, 70.35, -99.55, -19.7], [-3.2014, 1.2414, 2.5807, 62.0, -93.3, -24.9], [-3.3974, 1.5027, 2.0254, 51.95, -86.45, -27.6], [-3.5934, 2.0254, 1.3394, 42.2, -78.15, -28.45], [-3.7567, 2.8747, 0.392, 31.8, -68.05, -27.4], [-3.9201, 4.0181, -0.6533, 20.3, -56.6, -24.5], [-4.0181, 5.4881, -1.7314, 7.2, -44.75, -19.8], [-4.0507, 7.4155, -2.7441, -6.95, -33.0, -14.05], [-3.9854, 9.3102, -3.6587, -20.7, -21.8, -7.95], [-3.9527, 11.2702, -4.4101, -32.7, -11.65, -2.15], [-3.9201, 13.1323, -5.0308, -41.85, -2.9, 3.55], [-3.7894, 14.7656, -5.1941, -48.1, 3.7, 7.55], [-3.6261, 15.8763, -4.9654, -50.65, 5.2, 10.05], [-3.4301, 16.4317, -4.4428, -50.15, 2.7, 10.25], [-3.2667, 16.4317, -3.7567, -45.95, -2.75, 7.6], [-3.2341, 15.9743, -3.0381, -39.1, -10.5, 2.4], [-3.3321, 15.1903, -2.2867, -31.85, -19.5, -4.6], [-3.6587, 14.0143, -1.4374, -26.45, -28.4, -12.3], [-4.2141, 12.8709, -0.5227, -24.25, -35.9, -19.45], [-4.8674, 11.9562, 0.5553, -25.05, -40.6, -25.25], [-5.6514, 11.3029, 1.47, -27.0, -41.4, -29.55], [-6.3701, 10.9435, 2.3194, -28.25, -38.3, -30.85], [-7.0235, 10.7149, 3.1361, -27.8, -31.3, -29.1], [-7.5135, 10.5189, 3.8221, -25.9, -20.55, -24.05], [-7.7422, 10.2249, 4.3448, -23.3, -7.45, -15.8], [-7.5461, 9.6695, 4.6714, -20.95, 6.3, -5.9], [-7.0235, 8.8202, 4.8348, -19.6, 19.25, 3.3], [-6.3048, 7.4808, 4.8674, -20.4, 30.65, 10.6], [-5.4554, 5.9781, 4.8674, -24.95, 40.95, 15.9], [-4.5734, 4.4428, 4.8021, -34.95, 51.05, 19.15], [-3.6914, 3.0381, 4.8348, -51.75, 60.45, 20.4], [-2.7767, 2.1234, 4.9981, -77.75, 65.6, 19.0], [-1.8947, 1.862, 5.4228, -103.4, 67.75, 14.9], [-1.176, 2.2867, 5.9781, -126.75, 67.6, 8.95], [-0.5553, 3.2994, 6.5988, -144.1, 65.55, 2.5], [-0.196, 4.8021, 7.0561, -153.8, 61.85, -3.5], [-0.0, 6.6641, 7.3175, -156.5, 55.95, -8.8], [-0.0, 8.2975, 7.3501, -153.2, 47.25, -13.2], [-0.1307, 9.6042, 7.0561, -144.75, 36.65, -16.85], [-0.49, 10.4862, 6.5008, -131.85, 25.6, -20.45], [-1.0454, 10.8129, 5.8148, -114.25, 13.75, -23.05], [-1.666, 10.6495, 4.9981, -99.1, 4.3, -24.95], [-2.3194, 10.0942, 4.1814, -87.0, -3.45, -26.25], [-2.8747, 9.3428, 3.4954, -78.95, -9.15, -27.15], [-3.3974, 8.5588, 3.0381, -74.15, -12.4, -27.95], [-3.7567, 7.8728, 2.8094, -71.35, -12.8, -28.7], [-3.9527, 7.3175, 2.7767, -69.75, -10.5, -28.95], [-4.0181, 7.0235, 2.8747, -69.15, -5.9, -28.35], [-3.9854, 6.9581, 3.1361, -69.45, 0.4, -26.75], [-3.8547, 7.0561, 3.3974, -70.35, 8.3, -23.85], [-3.6914, 7.2521, 3.7241, -71.4, 15.2, -20.7], [-3.5281, 7.4481, 3.9854, -72.0, 21.3, -17.3], [-3.3321, 7.6115, 4.1814, -72.3, 26.15, -13.95], [-3.1687, 7.7095, 4.3121, -72.3, 29.4, -11.0], [-3.0707, 7.7422, 4.3774, -72.15, 31.1, -8.8], [-3.0381, 7.6768, 4.3774, -72.05, 31.7, -7.5], [-3.0707, 7.5788, 4.2794, -72.15, 31.7, -7.1], [-3.1361, 7.4481, 4.1161, -72.8, 31.75, -7.55], [-3.2341, 7.3175, 3.8874, -74.25, 32.25, -8.55], [-3.3321, 7.2848, 3.6261, -76.5, 33.7, -9.9], [-3.3974, 7.3175, 3.2994, -80.2, 35.75, -11.0], [-3.3974, 7.4808, 3.0381, -84.55, 38.25, -11.8], [-3.3647, 7.7422, 2.8421, -89.6, 40.8, -12.0], [-3.2014, 8.1015, 2.7441, -94.8, 43.1, -11.6], [-2.9727, 8.5588, 2.8094, -99.5, 44.75, -10.55], [-2.7114, 9.1468, 3.0707, -102.65, 45.2, -9.0], [-2.4174, 9.7022, 3.4301, -103.45, 44.25, -7.1], [-2.156, 10.2902, 3.9201, -101.45, 41.85, -5.0], [-1.96, 10.8455, 4.5408, -96.35, 38.65, -2.45], [-1.7967, 11.3682, 5.0634, -86.5, 34.8, 0.0], [-1.666, 11.7929, 5.4881, -74.4, 31.55, 2.5], [-1.5354, 12.1849, 5.6841, -60.0, 28.65, 4.7], [-1.47, 12.5769, 5.6514, -44.45, 26.5, 6.75], [-1.5027, 12.9363, 5.4228, -28.85, 25.65, 8.75], [-1.568, 13.2956, 5.0308, -13.85, 26.45, 11.0], [-1.666, 13.5896, 4.5081, 0.5, 28.9, 13.65], [-1.7967, 13.7856, 4.0181, 14.2, 32.5, 16.8], [-1.8947, 13.8509, 3.4954, 27.0, 36.65, 20.45], [-2.058, 13.7856, 3.2014, 38.85, 41.0, 25.25], [-2.254, 13.6223, 3.0381, 51.05, 45.15, 30.1], [-2.4827, 13.2956, 3.1034, 60.8, 47.25, 35.4], [-2.7441, 12.8382, 3.3974, 69.4, 47.05, 40.8], [-3.0707, 12.3156, 3.9201, 76.8, 44.5, 45.95], [-3.3974, 11.7929, 4.6714, 83.15, 39.8, 50.65], [-3.7567, 11.3029, 5.5861, 89.0, 33.35, 54.6], [-4.1161, 10.9109, 6.5661, 95.2, 25.5, 57.95], [-4.5081, 10.7475, 7.5461, 102.45, 16.6, 60.65], [-4.8674, 10.6495, 8.5262, 111.15, 7.55, 62.5], [-5.1614, 10.5842, 9.1468, 121.65, -1.4, 63.35], [-5.3574, 10.5515, 9.4735, 135.05, -7.8, 63.2], [-5.4554, 10.5515, 9.4409, 147.1, -13.05, 62.75], [-5.4228, 10.4862, 9.0815, 157.65, -17.45, 62.1], [-5.3248, 10.4209, 8.4935, 165.25, -21.4, 60.95], [-5.1941, 10.1922, 7.7748, 169.05, -25.1, 59.1], [-5.0308, 9.8655, 7.0561, 169.0, -28.5, 56.45], [-4.8674, 9.5389, 6.4028, 165.65, -31.9, 53.5], [-4.7368, 9.1142, 5.9454, 159.75, -35.6, 50.5], [-4.6388, 8.6568, 5.5861, 152.6, -39.95, 47.05], [-4.5734, 8.1342, 5.4554, 144.55, -45.4, 43.65], [-4.5408, 7.5461, 5.4228, 138.15, -50.65, 40.05], [-4.5408, 6.9908, 5.4554, 132.85, -56.05, 36.55], [-4.5081, 6.3701, 5.5208, 128.55, -61.65, 33.5], [-4.4428, 5.7821, 5.5534, 124.9, -67.6, 30.85], [-4.3774, 5.2268, 5.5208, 121.65, -73.7, 28.55], [-4.2794, 4.5734, 5.4554, 118.4, -79.65, 26.25], [-4.1487, 4.0507, 5.2921, 114.85, -85.05, 23.9], [-3.9527, 3.5607, 5.0961, 110.9, -89.7, 21.35], [-3.7567, 3.1034, 4.9001, 106.5, -94.0, 18.0], [-3.5281, 2.6461, 4.6714, 101.0, -96.85, 14.4], [-3.3647, 2.2214, 4.4101, 95.5, -98.75, 10.05], [-3.2014, 1.8294, 4.1487, 89.45, -99.6, 5.05], [-3.0707, 1.47, 3.8874, 82.7, -99.4, -0.45], [-3.0054, 1.176, 3.6914, 75.35, -98.4, -6.15], [-3.0054, 1.0127, 3.4627, 67.45, -96.6, -11.75], [-3.0707, 0.98, 3.2341, 59.45, -93.75, -16.8], [-3.1687, 1.1434, 2.9727, 51.5, -89.85, -20.95], [-3.3321, 1.47, 2.5154, 43.75, -84.75, -23.95], [-3.5281, 2.0254, 1.8947, 35.8, -77.2, -25.7], [-3.7241, 2.9401, 0.98, 26.1, -68.2, -25.45], [-3.9527, 4.1814, -0.1307, 16.35, -57.45, -23.25], [-4.1161, 5.7168, -1.274, 4.95, -45.95, -19.0], [-4.1814, 7.5135, -2.3847, -7.45, -34.3, -13.35], [-4.2141, 9.5062, -3.4301, -19.35, -22.75, -7.0], [-4.2141, 11.7602, -4.4101, -29.6, -11.9, -0.5], [-4.1487, 13.7203, -5.2268, -37.7, -2.3, 5.9], [-4.0181, 15.321, -5.6188, -43.2, 4.95, 11.65], [-3.7241, 16.4317, -5.4881, -46.2, 7.85, 16.5], [-3.3647, 16.8563, -5.0308, -46.1, 6.15, 18.2], [-3.1034, 16.7257, -4.4101, -41.85, 1.8, 16.5], [-3.0381, 16.203, -3.7567, -35.1, -5.0, 11.65], [-3.0381, 15.3536, -3.1034, -28.7, -13.3, 4.55], [-3.2994, 14.3736, -2.2867, -24.85, -22.1, -3.55], [-3.7567, 13.4263, -1.3067, -24.2, -30.45, -11.2], [-4.2467, 12.6422, -0.294, -25.85, -37.6, -17.15], [-4.8021, 12.2829, 0.7513, -27.7, -43.15, -21.1], [-5.2594, 12.0869, 1.8947, -27.7, -46.2, -22.7], [-5.5861, 11.9236, 2.8747, -25.4, -45.65, -21.25], [-5.7821, 11.6296, 3.8221, -20.5, -41.9, -17.0], [-5.7494, 10.9762, 4.6714, -14.55, -36.9, -10.35], [-5.3901, 9.8655, 5.3248, -8.1, -32.3, -3.2], [-4.7041, 8.2975, 5.7494, -2.05, -29.25, 1.7], [-4.0507, 6.4028, 5.8801, 2.15, -26.45, 3.1], [-3.5281, 4.4754, 5.7168, 2.55, -21.55, 1.25], [-3.2014, 2.548, 5.4228, -4.2, -15.55, -2.3], [-2.8747, 1.3394, 5.0961, -20.0, -10.7, -6.4], [-2.548, 0.8167, 4.8348, -43.75, -7.25, -11.35], [-2.254, 1.078, 4.8674, -75.15, -3.55, -16.15], [-2.0907, 2.1887, 5.0308, -101.65, 1.2, -20.35], [-2.0907, 3.8221, 5.2921, -123.0, 7.75, -23.0], [-2.1234, 5.6514, 5.6188, -138.35, 14.4, -23.55], [-2.156, 7.4155, 5.8474, -148.15, 18.75, -22.2], [-2.1887, 8.8855, 6.0108, -152.15, 20.55, -20.05], [-2.352, 9.9635, 6.0435, -149.9, 20.8, -18.25], [-2.6134, 10.2902, 5.9128, -142.1, 20.1, -17.3], [-2.9401, 10.1269, 5.5208, -131.0, 18.6, -16.9], [-3.2667, 9.5389, 4.9001, -120.05, 16.05, -17.0], [-3.5607, 8.7222, 4.4101, -111.4, 12.3, -17.15], [-3.7894, 7.9055, 4.0181, -107.3, 9.0, -17.25], [-3.8874, 7.2521, 3.8547, -105.1, 6.55, -17.55], [-3.9527, 6.7621, 3.8874, -103.2, 5.5, -17.95], [-3.9527, 6.5008, 4.0834, -100.95, 6.05, -17.9], [-3.9201, 6.4681, 4.4101, -98.4, 8.1, -17.0], [-3.8874, 6.6315, 4.7368, -95.4, 11.35, -15.3], [-3.8221, 6.8601, 5.0634, -91.75, 15.15, -13.0], [-3.7894, 7.1215, 5.2921, -87.4, 18.95, -10.5], [-3.7241, 7.3175, 5.3574, -82.7, 22.9, -7.8], [-3.6914, 7.4481, 5.2921, -78.1, 26.0, -5.65], [-3.6587, 7.4808, 5.1288, -75.55, 28.6, -3.85], [-3.6261, 7.4481, 4.9328, -74.6, 30.5, -2.7], [-3.6261, 7.3501, 4.7041, -75.4, 31.65, -2.35], [-3.6261, 7.2195, 4.5734, -77.55, 32.25, -2.75], [-3.6587, 7.0888, 4.4428, -80.85, 32.75, -3.6], [-3.6914, 7.0561, 4.4101, -84.7, 33.65, -4.55], [-3.7241, 7.0561, 4.3774, -88.6, 35.0, -5.4], [-3.6914, 7.1868, 4.3448, -91.95, 36.75, -6.05], [-3.6261, 7.4155, 4.2467, -95.05, 38.8, -6.3], [-3.4954, 7.7748, 4.1161, -97.25, 40.4, -6.15], [-3.3321, 8.1995, 3.9201, -98.85, 41.6, -5.65], [-3.1361, 8.7222, 3.7241, -99.65, 42.35, -4.8], [-2.9074, 9.2775, 3.5607, -99.3, 42.55, -3.65], [-2.7441, 9.8002, 3.4301, -97.8, 42.2, -2.05], [-2.5807, 10.3882, 3.3974, -95.35, 41.45, 0.1], [-2.45, 10.9109, 3.4954, -91.85, 40.55, 2.8], [-2.3847, 11.3682, 3.7567, -86.9, 39.8, 6.1], [-2.2867, 11.7602, 4.0507, -79.85, 39.55, 10.4], [-2.1887, 12.1522, 4.3774, -69.3, 39.9, 14.75], [-2.058, 12.4789, 4.6061, -58.25, 40.65, 19.4], [-1.8947, 12.8382, 4.7368, -46.05, 41.75, 24.0], [-1.7314, 13.1649, 4.8021, -32.65, 43.1, 28.2], [-1.666, 13.4589, 4.7368, -17.65, 44.7, 32.0], [-1.6987, 13.6876, 4.5734, -0.75, 46.4, 35.55], [-1.7967, 13.7529, 4.2794, 17.3, 48.25, 39.0], [-1.9927, 13.6549, 3.9527, 35.15, 50.25, 42.45], [-2.2867, 13.3936, 3.6261, 51.5, 52.3, 45.85], [-2.6787, 13.0016, 3.4301, 65.65, 54.25, 49.85], [-3.1361, 12.5442, 3.3974, 78.1, 55.1, 54.05], [-3.6587, 11.9889, 3.6261, 85.6, 54.8, 58.95], [-4.1161, 11.4009, 4.1487, 89.7, 53.35, 64.25], [-4.5408, 10.9435, 4.9981, 91.1, 50.75, 69.45], [-4.8348, 10.6169, 6.0435, 91.65, 46.95, 74.3], [-5.0961, 10.4535, 7.2521, 93.4, 41.65, 78.65], [-5.2594, 10.4535, 8.4282, 98.05, 35.0, 82.15], [-5.3248, 10.4862, 9.4409, 106.4, 27.8, 84.25], [-5.2921, 10.5189, 10.1922, 118.35, 20.7, 84.5], [-5.1941, 10.6169, 10.4535, 134.65, 13.2, 82.8], [-5.0308, 10.6169, 10.2575, 149.5, 7.0, 79.95], [-4.8348, 10.5842, 9.7022, 162.3, 0.85, 76.2], [-4.6714, 10.4535, 8.8855, 171.25, -5.15, 71.75], [-4.4754, 10.1922, 7.9708, 175.35, -10.75, 66.7], [-4.3448, 9.8655, 7.0888, 174.55, -16.05, 61.35], [-4.2467, 9.4409, 6.3375, 169.75, -21.2, 56.4], [-4.2141, 9.0162, 5.8474, 162.3, -26.55, 52.1], [-4.2141, 8.4935, 5.5208, 153.65, -32.25, 48.35], [-4.2794, 7.9382, 5.3574, 145.15, -38.45, 44.35], [-4.3121, 7.3501, 5.3901, 136.95, -45.95, 40.95], [-4.3448, 6.7621, 5.4228, 131.2, -52.95, 37.9], [-4.3774, 6.1415, 5.4554, 126.85, -60.2, 35.1], [-4.3448, 5.5534, 5.4554, 123.5, -67.7, 32.6], [-4.2467, 4.9328, 5.4228, 120.55, -75.1, 30.0], [-4.1161, 4.3774, 5.2921, 117.55, -82.15, 27.05], [-3.9201, 3.7894, 5.1288, 114.4, -88.4, 23.65], [-3.7241, 3.2994, 4.9328, 110.95, -93.65, 19.8], [-3.5281, 2.8421, 4.6714, 107.05, -97.55, 15.35], [-3.3321, 2.3847, 4.3774, 102.5, -100.35, 9.65], [-3.2014, 1.96, 4.0834, 96.35, -101.25, 4.05], [-3.1034, 1.568, 3.7894, 89.75, -100.65, -1.85], [-3.0707, 1.2087, 3.5281, 82.1, -98.65, -7.7], [-3.1361, 1.0127, 3.2994, 73.55, -95.25, -13.05], [-3.2341, 0.882, 3.0054, 64.3, -90.4, -17.5], [-3.3974, 0.9474, 2.7441, 54.6, -84.15, -20.8], [-3.5281, 1.176, 2.45, 44.6, -76.6, -22.75], [-3.6587, 1.666, 1.9927, 34.35, -67.85, -23.35], [-3.7567, 2.45, 1.176, 23.8, -57.4, -22.05], [-3.8221, 3.5934, 0.196, 11.3, -43.7, -19.0], [-3.7894, 5.0961, -0.882, -1.2, -31.15, -14.0], [-3.6587, 6.8601, -1.8947, -14.75, -19.2, -7.65], [-3.4301, 8.8202, -2.8421, -27.65, -8.2, -0.85], [-3.2014, 10.8455, -3.7241, -38.4, 1.15, 5.8], [-3.0381, 12.8056, -4.5081, -46.15, 8.75, 11.95], [-2.9074, 14.7656, -4.9981, -50.7, 13.9, 17.4], [-2.6787, 15.9743, -5.0308, -52.25, 14.8, 21.45], [-2.4827, 16.5297, -4.6388, -50.85, 11.0, 22.9], [-2.4174, 16.4643, -3.9201, -45.35, 3.0, 20.05], [-2.5154, 15.9743, -3.3321, -34.9, -6.3, 13.65], [-2.8094, 15.2556, -2.7441, -25.4, -16.8, 4.6], [-3.2667, 14.4063, -2.0907, -18.8, -27.0, -5.7], [-4.0181, 13.6223, -1.2414, -16.55, -36.05, -15.5], [-4.7368, 13.0996, -0.2613, -17.95, -43.7, -23.35], [-5.4228, 12.9036, 0.784, -20.45, -49.5, -28.6], [-6.0435, 12.9036, 1.7967, -21.2, -52.05, -30.85], [-6.5008, 12.9363, 2.7441, -19.3, -50.15, -29.85], [-6.8275, 12.7076, 3.7894, -15.3, -44.2, -25.8], [-6.9255, 12.0542, 4.6061, -9.7, -35.3, -17.95], [-6.6968, 10.7802, 5.2594, -2.45, -28.0, -9.4], [-6.1415, 8.8855, 5.6188, 3.7, -22.0, -2.45], [-5.5208, 6.5988, 5.6514, 7.8, -15.45, 0.8], [-4.8674, 4.1814, 5.3574, 7.0, -5.9, 0.3], [-4.3774, 1.9927, 4.9001, -2.6, 4.75, -2.45], [-3.9201, 0.1307, 4.5408, -23.1, 13.4, -5.85], [-3.4301, -0.6207, 4.3774, -52.6, 19.85, -8.85], [-2.8421, -0.3267, 4.4101, -86.7, 25.85, -11.6], [-2.254, 0.98, 4.7694, -119.7, 33.2, -14.45], [-1.8294, 2.9727, 5.3248, -149.55, 42.5, -16.05], [-1.47, 5.2268, 5.9128, -167.45, 48.7, -15.9], [-1.1434, 7.4808, 6.5008, -177.2, 50.2, -14.2], [-0.8167, 9.3755, 6.8928, -178.5, 47.6, -12.3], [-0.686, 10.7802, 7.0235, -171.4, 42.3, -11.4], [-0.784, 11.4989, 6.8928, -157.45, 35.0, -12.35], [-1.0127, 11.4662, 6.4681, -139.4, 25.9, -14.9], [-1.4047, 10.8129, 5.7494, -121.2, 15.4, -18.25], [-1.862, 9.8002, 4.9001, -106.7, 4.55, -21.7], [-2.2867, 8.7875, 4.2141, -97.0, -6.4, -25.6], [-2.7441, 7.9055, 3.7241, -90.2, -13.65, -28.95], [-3.1034, 7.1868, 3.4954, -86.0, -17.8, -31.7], [-3.4301, 6.7295, 3.4627, -82.65, -18.6, -33.35], [-3.6914, 6.5335, 3.5934, -80.0, -16.4, -33.6], [-3.8874, 6.5335, 3.7894, -77.9, -11.95, -32.4], [-4.0507, 6.7621, 4.0507, -75.8, -6.35, -29.95], [-4.1161, 7.0888, 4.2794, -73.1, -0.3, -26.7], [-4.1487, 7.3501, 4.4754, -69.8, 5.7, -22.95], [-4.1161, 7.5135, 4.5734, -66.8, 11.25, -19.05], [-4.0834, 7.6115, 4.5734, -64.8, 16.4, -14.9], [-3.9854, 7.5461, 4.5408, -64.25, 19.65, -11.95], [-3.9201, 7.4481, 4.5408, -65.15, 21.6, -10.1], [-3.8221, 7.2521, 4.5408, -67.2, 22.55, -9.45], [-3.7894, 7.0561, 4.5408, -70.25, 23.0, -9.85], [-3.7894, 6.8928, 4.5734, -74.05, 23.5, -10.95], [-3.8221, 6.8275, 4.5734, -78.2, 24.3, -12.45], [-3.7894, 6.8601, 4.4754, -82.2, 25.45, -14.0], [-3.7567, 7.0561, 4.3448, -85.9, 26.95, -15.35], [-3.6587, 7.3501, 4.0834, -89.35, 28.6, -16.45], [-3.5607, 7.7095, 3.7567, -93.1, 30.55, -16.8], [-3.4301, 8.1995, 3.3974, -96.35, 32.3, -16.35], [-3.2667, 8.7222, 3.0707, -99.2, 33.85, -15.05], [-3.1361, 9.2775, 2.8747, -101.4, 34.85, -12.75], [-2.9727, 9.8002, 2.8094, -102.6, 35.35, -9.55], [-2.8747, 10.3229, 2.9401, -102.5, 35.5, -5.55], [-2.8094, 10.8782, 3.2667, -100.4, 35.65, -0.9], [-2.7441, 11.3682, 3.7567, -95.85, 35.85, 4.25], [-2.6787, 11.7929, 4.4101, -88.3, 36.05, 9.7], [-2.548, 12.1522, 4.9981, -77.75, 36.05, 15.8], [-2.3847, 12.5116, 5.4881, -63.1, 35.9, 20.7], [-2.2214, 12.8709, 5.8148, -48.3, 35.9, 24.85], [-2.058, 13.2303, 5.9454, -32.0, 36.3, 28.05], [-1.96, 13.5569, 5.9128, -14.35, 36.95, 30.6], [-1.9274, 13.8183, 5.6841, 4.6, 37.7, 32.85], [-1.9927, 13.9163, 5.3248, 24.0, 38.65, 35.05], [-2.1234, 13.8836, 4.8674, 42.6, 39.9, 37.3], [-2.352, 13.6549, 4.4101, 59.3, 41.6, 39.75], [-2.6787, 13.2956, 4.0181, 73.6, 43.25, 42.65], [-3.1034, 12.8056, 3.7567, 85.05, 44.15, 46.6], [-3.5607, 12.1849, 3.8221, 94.0, 43.6, 50.6], [-4.0507, 11.4989, 4.2141, 98.4, 41.8, 54.75], [-4.4754, 10.9109, 4.8348, 100.15, 39.0, 58.7], [-4.9001, 10.4209, 5.7494, 100.85, 35.25, 62.2], [-5.2268, 10.1269, 6.7948, 102.65, 30.45, 65.3], [-5.4881, 9.9962, 7.8402, 107.05, 24.85, 67.8], [-5.6514, 9.8982, 8.7222, 114.85, 19.25, 69.3], [-5.6841, 9.8655, 9.3428, 125.9, 14.2, 69.7], [-5.6188, 9.8982, 9.6369, 139.0, 9.55, 69.25], [-5.4554, 9.8982, 9.4409, 152.15, 4.7, 68.3], [-5.2268, 9.8982, 8.9835, 164.6, 0.45, 67.0], [-4.9654, 9.8002, 8.2648, 171.9, -3.8, 65.1], [-4.7368, 9.6042, 7.5135, 174.85, -8.0, 62.7], [-4.5408, 9.3428, 6.8275, 173.6, -12.1, 59.95], [-4.4101, 9.0488, 6.3048, 168.8, -16.35, 57.3], [-4.3448, 8.6568, 5.9781, 161.7, -20.7, 55.0], [-4.3448, 8.1995, 5.7821, 153.7, -25.05, 52.8], [-4.3448, 7.7422, 5.7821, 146.1, -29.65, 50.5], [-4.3774, 7.2195, 5.8474, 139.7, -34.6, 48.0], [-4.4101, 6.6315, 5.9454, 134.05, -40.7, 45.95], [-4.4101, 6.0761, 5.9781, 130.0, -46.7, 44.15], [-4.3448, 5.5208, 5.9454, 126.3, -53.2, 42.55], [-4.2467, 4.9654, 5.8474, 122.65, -59.9, 40.9], [-4.0834, 4.4428, 5.6841, 118.7, -66.65, 38.85], [-3.9201, 3.9527, 5.4881, 114.6, -73.1, 36.25], [-3.6914, 3.3974, 5.2594, 110.1, -78.75, 32.9], [-3.4954, 2.9727, 4.9654, 105.2, -83.4, 28.7], [-3.2994, 2.5154, 4.6388, 99.8, -86.9, 23.65], [-3.1034, 2.1234, 4.3121, 93.9, -89.35, 16.9], [-2.9727, 1.764, 4.0181, 86.55, -90.3, 10.05], [-2.9074, 1.4374, 3.7241, 79.5, -90.2, 2.85], [-2.9074, 1.274, 3.3647, 72.0, -89.1, -4.3], [-2.9727, 1.2087, 3.0381, 64.15, -86.85, -10.95], [-3.0381, 1.3067, 2.6787, 56.05, -83.45, -16.55], [-3.1361, 1.568, 2.2214, 47.85, -78.95, -20.85], [-3.2341, 2.156, 1.6334, 39.3, -73.0, -23.55], [-3.3321, 2.9727, 0.8493, 30.3, -65.25, -24.5], [-3.4301, 4.0507, -0.2287, 20.5, -56.05, -23.5], [-3.4301, 5.4554, -1.2414, 7.75, -44.9, -20.7], [-3.3974, 7.1215, -2.2214, -4.95, -35.15, -16.6], [-3.2994, 8.9182, -3.1034, -17.6, -25.9, -11.85], [-3.2341, 10.8129, -3.8874, -28.9, -17.7, -7.25], [-3.2014, 12.6749, -4.4754, -37.65, -11.05, -3.15], [-3.1361, 14.3409, -4.8021, -43.2, -7.0, 0.1], [-3.0707, 15.713, -4.7694, -45.5, -6.5, 2.1], [-3.0054, 16.3337, -4.4101, -44.55, -9.45, 2.5], [-3.0381, 16.4317, -3.8221, -39.8, -14.75, 0.7], [-3.1361, 16.0396, -3.1034, -31.5, -21.85, -3.9], [-3.3974, 15.321, -2.4827, -20.6, -31.2, -9.6], [-3.7894, 14.3409, -1.7967, -12.15, -39.25, -15.75], [-4.3121, 13.2629, -1.078, -6.75, -45.5, -21.3], [-5.0634, 12.2829, -0.3267, -5.0, -48.7, -25.0], [-5.7168, 11.5316, 0.4573, -6.15, -48.25, -26.5], [-6.3048, 11.0415, 1.1434, -8.85, -44.85, -25.8], [-6.7621, 10.7475, 1.862, -12.0, -38.35, -22.95], [-7.0888, 10.5189, 2.548, -15.0, -28.45, -18.05], [-7.2195, 10.2249, 3.2667, -17.95, -16.15, -11.05], [-7.0888, 9.7349, 3.8221, -20.9, -1.7, -1.65], [-6.5988, 8.9508, 4.2794, -24.3, 9.55, 5.9], [-5.8801, 7.8402, 4.6714, -27.4, 18.05, 10.7], [-5.1288, 6.5335, 4.9001, -31.15, 24.55, 12.45], [-4.4101, 5.1614, 4.9654, -37.05, 30.95, 11.9], [-3.7894, 3.8547, 4.9654, -47.35, 36.35, 10.2], [-3.1361, 2.8421, 4.9981, -62.65, 39.65, 7.55], [-2.4827, 2.4827, 5.0961, -81.25, 40.95, 3.85], [-1.8947, 2.8094, 5.3248, -100.15, 41.15, -0.65], [-1.47, 3.6587, 5.6188, -116.55, 41.1, -5.6], [-1.2414, 4.9328, 5.8801, -129.7, 41.0, -9.0], [-1.078, 6.3375, 6.0761, -136.45, 39.9, -11.4], [-1.0127, 7.7095, 6.1741, -139.0, 36.55, -13.0], [-1.0127, 8.8855, 6.1415, -137.3, 31.3, -14.3], [-1.2414, 9.7022, 6.0108, -131.3, 25.2, -15.75], [-1.6334, 10.0942, 5.7168, -121.9, 18.7, -17.45], [-2.0907, 9.9309, 5.2921, -110.9, 12.2, -19.3], [-2.6134, 9.4735, 4.7694, -100.65, 6.15, -21.0], [-3.0707, 8.8528, 4.2141, -92.85, 1.15, -22.3], [-3.4954, 8.1995, 3.7894, -87.75, -2.7, -23.35], [-3.8221, 7.6441, 3.5607, -84.05, -3.95, -24.05], [-4.0507, 7.2195, 3.4954, -81.5, -3.0, -24.45], [-4.2141, 6.9255, 3.4954, -79.5, 0.05, -24.3], [-4.2794, 6.8275, 3.5607, -78.35, 4.9, -23.3], [-4.2794, 6.9255, 3.6914, -78.1, 11.0, -21.45], [-4.2141, 7.0888, 3.8547, -78.45, 17.65, -19.05], [-4.0834, 7.3175, 4.0181, -79.0, 24.25, -16.3], [-3.9201, 7.5461, 4.1487, -79.6, 30.25, -13.45], [-3.7241, 7.7095, 4.1814, -80.5, 35.2, -10.7], [-3.5281, 7.8402, 4.2141, -82.0, 39.15, -8.1], [-3.3321, 7.9055, 4.1814, -84.25, 41.0, -6.65], [-3.1687, 7.9055, 4.1814, -86.45, 41.35, -6.15], [-3.0381, 7.8402, 4.1814, -88.5, 40.5, -6.55], [-2.9727, 7.7422, 4.1814, -90.25, 38.9, -7.65], [-2.9727, 7.6768, 4.2141, -91.75, 37.15, -9.2], [-3.0381, 7.6115, 4.2141, -92.8, 35.4, -10.95], [-3.0707, 7.6441, 4.2141, -93.1, 33.9, -12.65], [-3.1361, 7.7422, 4.1814, -92.55, 32.65, -14.1], [-3.1687, 7.9708, 4.0507, -91.35, 31.65, -15.1], [-3.1687, 8.2322, 3.8547, -89.45, 30.8, -15.25], [-3.1361, 8.5915, 3.6587, -87.5, 30.2, -14.75], [-3.1361, 9.0162, 3.4301, -85.2, 29.65, -13.55], [-3.1034, 9.4082, 3.2667, -82.55, 29.15, -11.5], [-3.0707, 9.8329, 3.2014, -79.55, 28.7, -8.75], [-3.0381, 10.2575, 3.2341, -76.25, 28.45, -5.25], [-3.0381, 10.6822, 3.3974, -72.55, 28.5, -1.15], [-3.0381, 11.0742, 3.6914, -67.9, 28.9, 3.35], [-3.0054, 11.4009, 4.0834, -61.75, 29.8, 8.05], [-2.9074, 11.7276, 4.4428, -53.85, 31.25, 13.25], [-2.7441, 12.0216, 4.6714, -43.05, 32.8, 17.45], [-2.5807, 12.3156, 4.8021, -31.95, 34.65, 20.95], [-2.45, 12.6096, 4.7041, -19.6, 36.85, 23.8], [-2.352, 12.8382, 4.4428, -6.05, 39.3, 26.2], [-2.352, 13.0016, 3.9854, 8.4, 42.1, 28.35], [-2.3847, 13.0343, 3.3974, 22.7, 45.4, 30.6], [-2.548, 12.9363, 2.8094, 35.7, 49.2, 33.2], [-2.7767, 12.7402, 2.2867, 46.4, 53.2, 36.6], [-3.0707, 12.4789, 1.96, 54.35, 56.8, 41.65], [-3.4301, 12.0869, 1.9927, 59.95, 59.3, 47.4], [-3.7567, 11.6622, 2.4174, 62.2, 59.5, 54.0], [-4.0834, 11.2376, 3.2014, 62.85, 57.95, 60.75], [-4.3448, 11.0089, 4.3774, 63.35, 54.4, 67.3], [-4.5734, 10.8129, 5.7494, 65.5, 48.8, 73.3], [-4.7368, 10.6822, 7.2195, 70.95, 41.0, 78.4], [-4.8348, 10.6169, 8.5588, 80.45, 31.45, 82.1], [-4.8674, 10.6169, 9.6695, 93.95, 21.3, 83.6], [-4.8348, 10.6169, 10.4535, 110.55, 11.6, 82.85], [-4.7368, 10.6169, 10.6169, 128.4, 1.85, 79.95], [-4.6388, 10.5515, 10.3229, 147.15, -5.7, 76.5], [-4.5408, 10.4209, 9.7022, 160.3, -12.35, 72.65], [-4.4428, 10.1595, 8.8528, 168.55, -17.95, 68.35], [-4.3448, 9.8655, 7.9055, 171.2, -22.5, 63.7], [-4.3121, 9.5389, 7.0561, 168.9, -26.25, 59.1], [-4.3121, 9.1795, 6.4028, 162.85, -29.45, 55.25], [-4.3121, 8.7222, 5.9128, 154.65, -32.7, 52.45], [-4.3448, 8.2975, 5.5861, 145.75, -36.55, 50.3], [-4.3448, 7.8075, 5.4554, 137.25, -41.45, 48.2], [-4.3448, 7.3175, 5.4228, 130.0, -48.45, 45.65], [-4.3448, 6.8601, 5.4228, 123.65, -55.85, 43.25], [-4.3121, 6.3701, 5.4554, 119.65, -64.2, 41.0], [-4.2467, 5.9128, 5.4554, 116.6, -73.2, 38.8], [-4.1487, 5.4554, 5.4228, 114.1, -82.45, 36.25], [-4.0181, 4.9981, 5.3574, 111.8, -91.4, 33.1], [-3.9527, 4.5408, 5.2594, 109.65, -99.2, 29.4], [-3.8221, 4.1487, 5.0634, 107.65, -105.3, 25.2], [-3.7241, 3.7567, 4.8348, 105.65, -109.35, 20.6], [-3.5934, 3.3647, 4.4754, 103.45, -111.3, 14.95], [-3.5281, 3.0054, 4.0507, 100.3, -111.0, 9.5], [-3.4301, 2.7114, 3.5934, 96.65, -108.8, 3.95], [-3.3974, 2.4827, 3.0707, 91.75, -105.05, -1.35], [-3.3974, 2.352, 2.548, 85.6, -100.1, -6.0], [-3.4301, 2.2867, 2.058, 78.0, -94.1, -9.7], [-3.5281, 2.3847, 1.5354, 69.2, -87.05, -12.3], [-3.6261, 2.6787, 1.0127, 59.4, -78.95, -13.65], [-3.6914, 3.1361, 0.5227, 48.6, -69.9, -13.7], [-3.7241, 3.6914, -0.098, 37.0, -59.95, -12.55], [-3.7567, 4.4754, -0.686, 24.85, -48.05, -10.25], [-3.6914, 5.4881, -1.2414, 11.15, -37.5, -7.65], [-3.5934, 6.6315, -1.764, -0.4, -27.8, -4.95], [-3.3974, 7.9382, -2.2214, -10.55, -19.5, -2.55], [-3.1361, 9.2448, -2.6461, -18.7, -13.05, -0.6], [-2.9074, 10.5842, -3.0054, -24.65, -8.8, 0.55], [-2.7114, 11.8582, -3.2667, -28.25, -6.9, 0.85], [-2.548, 13.0669, -3.3647, -29.6, -7.65, 0.3], [-2.45, 13.8183, -3.3647, -28.7, -10.65, -0.95], [-2.3847, 14.2429, -3.2014, -25.8, -15.1, -2.9], [-2.45, 14.3736, -2.9727, -21.4, -20.3, -5.85], [-2.5807, 14.2103, -2.6787, -15.95, -26.7, -9.0], [-2.8094, 13.8509, -2.254, -11.25, -32.65, -12.4], [-3.1034, 13.3283, -1.764, -6.95, -38.35, -15.85], [-3.4954, 12.7076, -1.176, -3.1, -42.9, -19.4], [-4.0834, 12.0869, -0.6533, -0.05, -45.55, -22.75], [-4.7368, 11.6296, -0.1633, 1.55, -45.7, -24.95], [-5.3574, 11.2702, 0.2613, 1.05, -43.45, -25.4], [-5.9128, 11.0089, 0.686, -1.65, -39.2, -24.15], [-6.3048, 10.7802, 1.0127, -6.25, -33.1, -21.55], [-6.6315, 10.5189, 1.4374, -12.2, -24.7, -17.35], [-6.7948, 10.1922, 1.8294, -20.45, -13.05, -12.55], [-6.7295, 9.6369, 2.2214, -29.1, -2.15, -6.65], [-6.4028, 8.8528, 2.7114, -38.55, 7.9, -0.65], [-5.7494, 7.8402, 3.2667, -48.55, 16.55, 3.85], [-5.0308, 6.7295, 3.8221, -58.55, 23.65, 6.15], [-4.3448, 5.6188, 4.3774, -68.2, 30.55, 6.65], [-3.6914, 4.4754, 4.8021, -77.8, 37.25, 6.1], [-3.0381, 3.8547, 5.1288, -88.05, 42.75, 5.0], [-2.3847, 3.5934, 5.4881, -98.75, 46.55, 3.35], [-1.7314, 3.7894, 5.7168, -109.1, 49.2, 0.75], [-1.2414, 4.4428, 5.9128, -118.75, 50.15, -1.85], [-0.9147, 5.4881, 6.0435, -124.2, 49.55, -4.25], [-0.7513, 6.5988, 6.1415, -126.4, 47.15, -6.35], [-0.7187, 7.6768, 6.1415, -125.6, 42.15, -8.4], [-0.784, 8.6242, 6.0435, -122.2, 34.9, -10.65], [-1.078, 9.2775, 5.9128, -116.25, 26.4, -13.4], [-1.5027, 9.6369, 5.6841, -108.4, 17.85, -16.6], [-2.058, 9.6369, 5.3574, -99.6, 9.95, -19.9], [-2.6134, 9.3102, 4.9328, -91.15, 3.5, -23.0], [-3.1361, 8.8528, 4.5081, -84.35, -1.55, -25.85], [-3.5607, 8.2975, 4.1814, -79.35, -4.0, -27.7], [-3.9201, 7.8075, 3.9527, -76.95, -4.45, -29.0], [-4.1487, 7.4155, 3.8547, -75.85, -3.0, -29.65], [-4.2467, 7.1541, 3.8547, -75.35, 0.1, -29.75], [-4.2794, 6.9908, 3.9527, -75.2, 4.25, -29.2], [-4.2467, 6.9581, 4.0507, -75.5, 9.1, -28.1], [-4.1814, 7.0235, 4.1814, -76.2, 14.15, -26.55], [-4.0834, 7.1215, 4.3121, -77.4, 19.25, -24.65], [-3.9854, 7.2521, 4.3774, -79.0, 24.1, -22.5], [-3.8547, 7.3828, 4.3448, -81.0, 29.0, -19.85], [-3.6914, 7.5135, 4.2794, -83.9, 32.7, -17.45], [-3.5607, 7.5788, 4.1814, -87.0, 35.8, -15.15], [-3.4301, 7.6115, 4.1161, -90.5, 38.05, -13.35], [-3.2994, 7.6115, 4.0507, -94.0, 39.45, -12.1], [-3.2341, 7.5788, 4.0181, -97.1, 40.1, -11.5], [-3.2341, 7.5461, 4.0181, -99.45, 40.3, -11.3], [-3.2341, 7.5135, 4.1161, -100.7, 40.3, -11.5], [-3.2994, 7.5461, 4.2141, -100.7, 40.1, -11.95], [-3.3647, 7.6115, 4.3121, -99.35, 39.55, -12.6], [-3.3974, 7.7748, 4.3121, -96.4, 38.65, -13.1], [-3.4627, 8.0362, 4.2794, -92.75, 37.65, -13.25], [-3.4627, 8.3628, 4.1487, -88.7, 36.55, -12.9], [-3.4301, 8.7548, 3.9854, -84.7, 35.5, -12.0], [-3.3974, 9.1468, 3.7567, -80.85, 34.55, -10.55], [-3.3974, 9.5715, 3.5934, -77.15, 33.8, -8.5], [-3.3647, 10.0289, 3.3974, -73.7, 33.45, -5.85], [-3.3321, 10.4209, 3.2994, -70.65, 33.6, -2.65], [-3.3321, 10.7475, 3.3647, -67.95, 34.2, 1.05], [-3.3321, 11.0742, 3.5607, -64.9, 35.5, 5.45], [-3.2994, 11.3356, 3.8547, -60.05, 37.2, 9.25], [-3.2014, 11.5969, 4.1487, -53.9, 39.05, 12.75], [-3.0381, 11.8256, 4.4101, -46.2, 40.85, 15.85], [-2.8094, 12.0542, 4.5734, -37.2, 42.35, 18.5], [-2.5807, 12.3156, 4.6388, -26.9, 43.5, 20.6], [-2.352, 12.5442, 4.5734, -15.2, 44.35, 22.25], [-2.156, 12.7402, 4.3448, -2.05, 44.9, 23.7], [-2.0254, 12.8056, 4.0507, 11.8, 45.2, 25.4], [-1.9927, 12.8056, 3.6587, 25.25, 45.25, 27.65], [-2.0254, 12.6749, 3.3647, 37.7, 44.9, 31.1], [-2.1887, 12.4789, 3.1687, 50.05, 43.9, 35.0], [-2.45, 12.1849, 3.2014, 59.45, 41.8, 39.55], [-2.7767, 11.7929, 3.4301, 67.05, 38.4, 44.45], [-3.2014, 11.4336, 3.9527, 72.95, 34.05, 49.55], [-3.6587, 11.0415, 4.6714, 77.65, 29.0, 54.65], [-4.0834, 10.6822, 5.5208, 82.35, 23.5, 59.4], [-4.4754, 10.4535, 6.5008, 88.1, 17.35, 63.5], [-4.8674, 10.2575, 7.4155, 95.3, 10.95, 66.55], [-5.2268, 10.1595, 8.2648, 103.95, 4.9, 68.65], [-5.4554, 10.0289, 8.7548, 115.05, -0.3, 69.45], [-5.5861, 9.9309, 8.9182, 125.35, -3.3, 69.75], [-5.5861, 9.8982, 8.8202, 135.05, -5.4, 69.6], [-5.4554, 9.8329, 8.4935, 142.8, -7.25, 69.0], [-5.2594, 9.7349, 7.9382, 147.65, -9.1, 67.65], [-5.0308, 9.5715, 7.3501, 149.3, -11.0, 65.7], [-4.7694, 9.4082, 6.7948, 148.25, -13.15, 63.45], [-4.5408, 9.1795, 6.3375, 145.35, -15.95, 61.3], [-4.3448, 8.9508, 5.9781, 141.35, -20.05, 59.15], [-4.2141, 8.5915, 5.7494, 136.85, -26.65, 56.4], [-4.1487, 8.1995, 5.6188, 131.9, -34.15, 53.5], [-4.1161, 7.7748, 5.5861, 128.05, -42.9, 50.35], [-4.1487, 7.3501, 5.5861, 124.95, -52.55, 47.2], [-4.1487, 6.9581, 5.6188, 122.7, -62.65, 44.3], [-4.1814, 6.5335, 5.6514, 121.1, -72.85, 41.4], [-4.1814, 6.0761, 5.6514, 119.95, -82.7, 38.4], [-4.1161, 5.5861, 5.6188, 119.0, -91.5, 35.0], [-4.0834, 5.1614, 5.5208, 118.45, -98.7, 31.35], [-4.0507, 4.7694, 5.3248, 118.25, -103.95, 27.55], [-3.9527, 4.3448, 5.0634, 118.1, -107.45, 23.1], [-3.8874, 3.9201, 4.7041, 117.45, -108.55, 18.9], [-3.8221, 3.4627, 4.2467, 115.9, -107.9, 14.6], [-3.7567, 3.0707, 3.7241, 112.8, -105.8, 10.3], [-3.7241, 2.8094, 3.2014, 107.85, -102.35, 6.25], [-3.6914, 2.6134, 2.6461, 100.95, -97.75, 2.7], [-3.6914, 2.5154, 2.0907, 92.25, -92.05, -0.1], [-3.7567, 2.548, 1.568, 82.0, -85.25, -2.05], [-3.7567, 2.7441, 1.078, 70.5, -77.3, -3.2], [-3.7567, 3.1034, 0.588, 58.1, -68.3, -3.45], [-3.6914, 3.5934, 0.098, 43.6, -57.25, -2.9], [-3.5607, 4.2794, -0.4247, 30.95, -46.9, -1.95], [-3.3974, 5.1614, -0.9474, 18.95, -36.8, -0.7], [-3.1687, 6.2068, -1.4374, 7.9, -27.8, 0.55], [-2.8421, 7.3501, -1.9274, -1.8, -20.35, 1.65], [-2.548, 8.5915, -2.3847, -10.0, -14.9, 2.3], [-2.2867, 9.9962, -2.7767, -16.4, -11.65, 2.3], [-2.156, 11.2049, -3.1034, -20.75, -10.6, 1.5], [-2.0907, 12.2829, -3.3321, -23.1, -11.75, 0.0], [-2.0907, 13.0996, -3.3647, -23.65, -15.55, -2.35], [-2.1887, 13.6549, -3.2667, -22.4, -20.3, -5.05], [-2.3847, 13.8836, -3.0381, -19.8, -25.8, -8.45], [-2.6787, 13.8836, -2.7114, -16.25, -31.65, -12.4], [-3.0381, 13.6549, -2.2867, -12.1, -37.75, -16.7], [-3.4301, 13.1976, -1.7967, -7.65, -43.55, -21.1], [-3.8547, 12.6422, -1.2414, -3.6, -48.4, -25.3], [-4.3774, 12.0542, -0.7513, -0.55, -51.15, -28.85], [-4.9654, 11.5642, -0.294, 0.8, -51.15, -30.75], [-5.5534, 11.2049, 0.1633, -0.15, -48.4, -30.65], [-6.0108, 10.9109, 0.5553, -3.15, -42.35, -28.5], [-6.4028, 10.6169, 0.9147, -8.45, -34.45, -25.15], [-6.6968, 10.3555, 1.3067, -14.5, -24.15, -20.45], [-6.8928, 9.9635, 1.6987, -21.75, -12.1, -14.55], [-6.8275, 9.4409, 2.1234, -30.1, 0.45, -7.6], [-6.5008, 8.6895, 2.6134, -39.35, 12.15, -0.95], [-5.9454, 7.6115, 3.2341, -48.75, 22.3, 3.8], [-5.2921, 6.6315, 3.7894, -57.95, 31.2, 6.65], [-4.6714, 5.6514, 4.3448, -67.05, 39.7, 8.15], [-4.0181, 4.8021, 4.8021, -76.85, 47.55, 9.15], [-3.2994, 4.3121, 5.2268, -88.8, 54.45, 9.3], [-2.548, 4.1487, 5.5534, -99.45, 58.6, 8.45], [-1.8294, 4.4101, 5.8474, -108.85, 61.05, 6.7], [-1.3067, 5.0961, 6.0435, -115.9, 61.7, 4.5], [-0.9147, 6.0761, 6.2068, -119.85, 60.25, 2.2], [-0.7187, 7.0888, 6.2395, -120.75, 56.2, -0.25], [-0.6533, 8.1668, 6.1741, -118.85, 49.15, -3.15], [-0.7187, 8.8855, 6.0435, -114.35, 40.05, -6.65], [-1.0454, 9.3755, 5.8474, -107.95, 30.3, -10.5], [-1.47, 9.5389, 5.4881, -100.3, 20.75, -14.95], [-1.9927, 9.4409, 5.0961, -91.6, 11.05, -18.9], [-2.5154, 9.1142, 4.6714, -84.85, 4.05, -22.55], [-3.0054, 8.6242, 4.3121, -79.9, -0.85, -25.5], [-3.5281, 8.1668, 3.9854, -76.75, -3.45, -27.6], [-3.8221, 7.7422, 3.7567, -75.05, -3.8, -29.1], [-3.9854, 7.4481, 3.6587, -74.3, -2.4, -30.0], [-4.0834, 7.2521, 3.6261, -74.0, 0.25, -30.5], [-4.1161, 7.2195, 3.6587, -73.95, 3.9, -30.45], [-4.0834, 7.2521, 3.7241, -74.2, 8.25, -29.75], [-4.0181, 7.3501, 3.7894, -74.85, 13.75, -28.25], [-3.9201, 7.4808, 3.8221, -76.15, 18.7, -26.55], [-3.7894, 7.6441, 3.8547, -77.85, 23.45, -24.6], [-3.6587, 7.8075, 3.8221, -80.0, 27.7, -22.45], [-3.4954, 7.9708, 3.7241, -82.55, 31.4, -20.15], [-3.3321, 8.0362, 3.6587, -85.3, 34.6, -17.95], [-3.2014, 8.1015, 3.5934, -88.2, 37.15, -15.85], [-3.1034, 8.1015, 3.4954, -91.1, 39.1, -14.25], [-3.0381, 8.1015, 3.4301, -93.7, 40.5, -13.0], [-3.0381, 8.0688, 3.4301, -95.7, 41.5, -11.95], [-3.0707, 8.0688, 3.4301, -96.9, 42.5, -11.25], [-3.1687, 8.1015, 3.4627, -97.1, 43.35, -10.65], [-3.2667, 8.1668, 3.5281, -96.4, 44.0, -10.1], [-3.3647, 8.2975, 3.5934, -94.8, 44.3, -9.6], [-3.4301, 8.4935, 3.6261, -92.3, 44.0, -9.0], [-3.4954, 8.7548, 3.6587, -88.95, 43.1, -8.35], [-3.5281, 9.1142, 3.6261, -85.05, 41.7, -7.5], [-3.5281, 9.4082, 3.5934, -80.85, 39.95, -6.4], [-3.5281, 9.7022, 3.5281, -76.65, 38.05, -5.1], [-3.4954, 10.0289, 3.5281, -72.55, 36.1, -3.25], [-3.4954, 10.2902, 3.5281, -68.0, 34.15, -1.35], [-3.4627, 10.5189, 3.5607, -64.1, 32.95, 0.8], [-3.4627, 10.7475, 3.6587, -60.2, 32.55, 3.1], [-3.4301, 10.9435, 3.7894, -55.9, 33.05, 5.45], [-3.3321, 11.1069, 3.9527, -50.8, 34.25, 7.7], [-3.2014, 11.3029, 4.0834, -44.6, 36.0, 9.75], [-3.0054, 11.4989, 4.1487, -37.15, 38.05, 11.5], [-2.7441, 11.6949, 4.0834, -28.55, 40.15, 12.9], [-2.4827, 11.8909, 3.8874, -19.05, 42.1, 14.0], [-2.2214, 12.0542, 3.6261, -8.85, 44.0, 15.4], [-1.9927, 12.2176, 3.3321, 3.05, 45.35, 17.0], [-1.8294, 12.3156, 3.0381, 13.45, 46.15, 19.4], [-1.764, 12.3482, 2.8421, 23.2, 46.3, 22.8], [-1.7967, 12.3482, 2.8094, 32.05, 45.3, 27.15], [-1.9274, 12.2829, 3.0054, 39.95, 42.65, 32.3], [-2.156, 12.1196, 3.4301, 47.2, 38.15, 38.1], [-2.4827, 11.9562, 4.0834, 54.25, 32.15, 44.05], [-2.8094, 11.7602, 4.9654, 61.65, 24.9, 49.85], [-3.2014, 11.5969, 6.0761, 70.1, 16.4, 55.55], [-3.5934, 11.3682, 7.0561, 81.35, 5.65, 59.45], [-3.9854, 11.1396, 7.9055, 92.9, -4.4, 61.85], [-4.4101, 10.9762, 8.5915, 105.5, -13.8, 62.8], [-4.7694, 10.7802, 8.9835, 118.6, -21.4, 62.45], [-5.1288, 10.5842, 9.0815, 131.35, -26.8, 61.35], [-5.3248, 10.4209, 8.9182, 142.7, -30.25, 59.9], [-5.4228, 10.2249, 8.4608, 151.8, -32.05, 58.35], [-5.4881, 9.9962, 7.8402, 157.7, -32.65, 56.7], [-5.4554, 9.8002, 7.0888, 160.2, -32.35, 55.05], [-5.3901, 9.5062, 6.4681, 159.75, -31.6, 53.5], [-5.2594, 9.2122, 5.9128, 156.55, -31.2, 52.65], [-5.1288, 8.8528, 5.4881, 152.05, -32.0, 52.15], [-4.9981, 8.4608, 5.1941, 146.65, -34.4, 51.75], [-4.9001, 8.0688, 5.0308, 140.9, -38.35, 51.2], [-4.7694, 7.6115, 5.0634, 135.25, -43.55, 50.6], [-4.6714, 7.2195, 5.1288, 130.25, -49.75, 49.95], [-4.5734, 6.7948, 5.2921, 126.1, -56.55, 49.45], [-4.4428, 6.4028, 5.4228, 122.85, -63.7, 48.75], [-4.2794, 6.0108, 5.5534, 120.25, -70.75, 47.6], [-4.0834, 5.6514, 5.6188, 118.25, -78.1, 45.55], [-3.8547, 5.2921, 5.6188, 116.45, -83.8, 43.05], [-3.6587, 4.9001, 5.4881, 114.95, -88.45, 39.85], [-3.4301, 4.4754, 5.2921, 113.2, -92.0, 35.9], [-3.2341, 4.0507, 4.9654, 110.75, -94.5, 31.15], [-3.0707, 3.6261, 4.5734, 107.25, -95.95, 25.8], [-2.9401, 3.2341, 4.1487, 102.6, -96.4, 20.0], [-2.8747, 2.9401, 3.6914, 96.7, -95.95, 14.15], [-2.8747, 2.7441, 3.2014, 89.7, -94.7, 8.5], [-2.9074, 2.6134, 2.7441, 81.75, -92.55, 2.6]]", "num_lines": 3}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Sorts.BubbleSort where\n\nlistToSort :: [Int]\nlistToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]\n\n\n-- The bubble sort function\nbubbleSort :: (Ord a) => [a] -> [a]\nbubbleSort lst = if bpassed == lst then lst\n                 else bubbleSort bpassed\n                 where bpassed = bubblePass lst\n\n-- A single pass of bubble sort\nbubblePass :: (Ord a) => [a] -> [a]\nbubblePass [] = [] -- Empty list is empty.\nbubblePass [x] = [x] -- Singleton list is always trivially sorted.\nbubblePass (x1:x2:xs) = if x1 > x2\n                        then [x2] ++ (bubblePass ([x1] ++ xs))\n                        else [x1] ++ (bubblePass ([x2] ++ xs))\n\nmain = do\n    putStrLn $ \"Unsorted: \" ++ show listToSort\n    putStrLn $ \"Sorted: \" ++ show (bubbleSort listToSort)", "num_lines": 23}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Sorts.HeapSort where\n\nlistToSort :: [Integer]\nlistToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]\n\n-- Sort the input list with the heap sort algorithm\nheapSort :: (Ord a) => [a] -> [a]\nheapSort [] = []\nheapSort [x] = [x]\nheapSort xs = heapSort' (maxHeap xs) []\n\n-- Recursive helper function for heapSort\nheapSort' :: Ord a => [a] -> [a] -> [a]\nheapSort' [] out = out\nheapSort' h out = heapSort' (extract h) out ++ [head h] \n\n-- Construct a max heap (represented as a list) from a given input list\nmaxHeap :: Ord a => [a] -> [a]\nmaxHeap [] = []\nmaxHeap [x] = [x]\nmaxHeap xs = maxHeap' xs (div (length xs) 2)\n\n-- Recursive helper function for maxHeap\nmaxHeap' :: Ord a => [a] -> Int -> [a]\nmaxHeap' xs 0 = maxHeapify xs 0\nmaxHeap' xs i = maxHeap' (maxHeapify xs i) (i-1)\n\n-- Given a heap and an index (i), move the element at i down the heap until it is in the right position\nmaxHeapify :: (Ord a) => [a] -> Int -> [a]\nmaxHeapify xs i | not (hasAnyChild xs i) = xs\n                | hasLeftChild xs i && hasRightChild xs i = \n                    let largestChild = if xs !! (leftChild i) > xs !! (rightChild i) then leftChild i else rightChild i\n                    in if xs !! largestChild > xs !! i then maxHeapify (swap xs largestChild i) largestChild else xs\n                | hasLeftChild xs i =\n                    if xs !! (leftChild i) > xs !! i then maxHeapify (swap xs (leftChild i) i) (leftChild i) else xs\n                | otherwise =\n                    if xs !! (rightChild i) > xs !! i then maxHeapify (swap xs (rightChild i) i) (rightChild i) else xs\n\n\n-- Remove the largest element from the heap, and then fix the heap\nextract :: Ord a => [a] -> [a]\nextract [] = []\nextract [_] = []\nextract xs = maxHeapify ((last xs):take (length xs - 2) (tail xs)) 0\n\n\n-- Swap the values stored in two positions in a list\nswap :: [a] -> Int -> Int -> [a]\nswap xs i1 i2 = map snd . foldr (\\x a -> \n        if fst x == i1 then ys !! i2 : a\n        else if fst x == i2 then ys !! i1 : a\n        else x : a) [] $ ys\n    where ys = zip [0..] xs\n\n-- Index where the left child of the node at the given index should be located\nleftChild :: Int -> Int\nleftChild i = 2 * i + 1\n\n-- Index where the right child of the node at the given index should be located\nrightChild :: Int -> Int\nrightChild i = 2 * i + 2\n\n-- Helper functions to determine which, if any, child nodes are present in the heap for the node at a given index\nhasLeftChild, hasRightChild, hasAnyChild :: [a] -> Int -> Bool\nhasLeftChild xs i = leftChild i < length xs\n\nhasRightChild xs i = rightChild i < length xs\n\nhasAnyChild xs i = hasLeftChild xs i || hasRightChild xs i\n\n\nmain :: IO ()\nmain = do\n    putStrLn $ \"Unsorted: \" ++ show listToSort\n    putStrLn $ \"Sorted: \" ++ show (heapSort listToSort)", "num_lines": 75}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Sorts.InsertionSort where\n\nlistToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]\n\ninsertionSort:: (Ord a) => [a] -> [a]\ninsertionSort [] = [] -- Empty list is empty\ninsertionSort [x] = [x] -- Singleton lists are trivially sorted.\ninsertionSort (x:xs) = insert x (insertionSort xs)\n\n-- Assumes that the second argument is an alread-sorted list,\n-- and inserts the first argument in the appropriate position\ninsert :: (Ord a) => a -> [a] -> [a]\ninsert x [] = [x]\ninsert x lst@(y:ys) = if x <= y then x:lst else y:(insert x ys)\n\n\nmain = do\n    putStrLn $ \"Unsorted: \" ++ show listToSort\n    putStrLn $ \"Sorted: \" ++ show (insertionSort listToSort)\n", "num_lines": 20}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Sorts.MergeSort where\n\nlistToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]\n\nmergeSort :: (Ord a) => [a] -> [a]\nmergeSort [] = [] -- Empty list is empty\nmergeSort [x] = [x] -- Singleton lists are trivially sorted.\nmergeSort [x, y] = [(min x y), (max x y)]\nmergeSort lst = merge (mergeSort leftL) (mergeSort rightL)\n                where leftL = take splitPoint lst\n                      rightL = drop splitPoint lst\n                      splitPoint = (length lst) `div` 2\n\n-- Function to execute a merge of two sorted lists\nmerge :: (Ord a) => [a] -> [a] -> [a]\nmerge l1 [] = l1\nmerge [] l2 = l2\nmerge lst1@(x:xs) lst2@(y:ys) = if x < y \n                                then x:(merge xs lst2)\n                                else y:(merge lst1 ys)\n\nmain = do\n    putStrLn $ \"Unsorted: \" ++ show listToSort\n    putStrLn $ \"Sorted: \" ++ show (mergeSort listToSort)", "num_lines": 24}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Sorts.QuickSort where\n\nlistToSort :: [Int]\nlistToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]\n\nquicksort :: (Ord a) => [a] -> [a]\nquicksort [] = [] -- Empty list is empty.\nquicksort [x] = [x] -- Singleton list is always trivially sorted.\nquicksort [x, y] = [(min x y), (max x y)]\nquicksort (x:xs) =\n  quicksort [a | a <- xs, a <= x] ++ [x] ++ quicksort [a | a <- xs, a > x]\n  -- x is the pivot, left quicksort returns smaller sorted and right quicksort bigger sorted\n\nmain = do\n    putStrLn $ \"Unsorted: \" ++ show listToSort\n    putStrLn $ \"Sorted: \" ++ show (quicksort listToSort)\n\n", "num_lines": 18}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Sorts.SelectionSort where\n\nlistToSort :: [Int]\nlistToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]\n\n\n-- The selection sort function\nselectionSort :: (Ord a) => [a] -> [a]\nselectionSort [] = []\nselectionSort (x:xs) =\n    let (y, ys) = leastUnsorted (x:xs)\n    in y : selectionSort ys\n\n-- select least element from unsorted list, return it and the rest of unsorted list\nleastUnsorted :: (Ord a) => [a] -> (a, [a])\nleastUnsorted [x] = (x, [])\nleastUnsorted (x:xs) =\n    let (y, ys) = leastUnsorted xs\n    in if x <= y then (x, xs) else (y, x:ys)\n\nmain = do\n    putStrLn $ \"Unsorted: \" ++ show listToSort\n    putStrLn $ \"Sorted: \" ++ show (selectionSort listToSort)", "num_lines": 23}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Sorts.ShellSort where\n-- Shell sort uses insertion sort for sorting individual sublists\nimport Sorts.InsertionSort\n\n-- Produces the sequence of gaps to use for sorting a list of size n\ngaps :: Int -> [Int]\ngaps n = reverse (takeWhile (< n) tokuda)\n\n-- Produces Tokuda's sequence\ntokuda :: [Int]\ntokuda = [gap n | n <- [1..]]\n\n-- Computes term k in Tokuda's sequence\ngap :: (Integral a) => a -> a\ngap k = ceiling (gap' k)\n\n-- Recursize helper function for gap\ngap' :: (Integral a) => a -> Double\ngap' 1 = 1\ngap' k = 2.25 * gap' (k - 1) + 1\n\n-- Sort an input sequence using the shell sort algorithm\nshellSort :: (Ord a) => [a] -> [a]\nshellSort xs = shellSort' xs (gaps (length xs))\n\n-- Recursive helper function for shellSort\nshellSort' :: (Ord a) => [a] -> [Int] -> [a]\nshellSort' [] _ = []\nshellSort' [x] _ = [x]\nshellSort' l [] = l\nshellSort' l (g:gs) = shellSort' (combine [insertionSort (getSub l g i) | i <- [0..g-1]]) gs\n\n-- Get the sublist of l formed by taking elements with gap g between them, starting at index i\ngetSub :: (Ord a) => [a] -> Int -> Int -> [a]\ngetSub [] _ _ = []\ngetSub l g i = [l !! e | e <- [i, i+g..length l - 1]] \n\n\n-- Combine a list of sublists into a single list in the correct order\n-- Required after individual sublists have been sorted, to rebuild the main list\ncombine :: [[a]] -> [a]\ncombine [] = []\ncombine l@(xs:_)\n        | length xs == 0 = []\n        | otherwise = [x | (x:_) <- l] ++ combine (map (drop 1) l)\n\nmain :: IO ()\nmain = do\n    putStrLn $ \"Unsorted: \" ++ show listToSort\n    putStrLn $ \"Sorted: \" ++ show (shellSort listToSort)", "num_lines": 50}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module SpecializedStructure.MergeFindSet where\n\nimport qualified Data.Map as Map\nimport qualified Data.Set as Set\n\ntype Mfset a = (Map.Map a a, Map.Map a Int)\n\nfromSet :: Ord a => Set.Set a -> Mfset a\nfromSet ns = (fathers, ranks)\n    where\n        fathers = Map.fromList [(i, i) | i <- Set.toList ns]\n        ranks   = Map.fromList [(i, 0) | i <- Set.toList ns]\n\nfind :: Ord a => a -> Mfset a -> a\nfind x mfset = let father = fst mfset Map.! x\n               in if father == x then x else find father mfset\n\nmerge :: Ord a => a -> a -> Mfset a -> Mfset a\nmerge x y mfset\n    | x' == y'  = mfset\n    | rx == ry  = (x' `connectTo` y', Map.adjust (+1) y' ranks)\n    | rx < ry   = (x' `connectTo` y', ranks)\n    | otherwise = (y' `connectTo` x', ranks)\n    where\n        (fathers, ranks) = mfset\n        connectTo a b = Map.adjust (const b) a fathers\n        findWithRank a = (\\f -> (f, ranks Map.! f)) $ find a mfset\n        (x', rx) = findWithRank x\n        (y', ry) = findWithRank y\n", "num_lines": 30}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Statistics.Center where\n\nimport qualified Data.Sort as S\nimport qualified Data.Vector.Generic as VG\nimport qualified Data.Vector.Algorithms.Intro as VGAI\n\n-- Measures of central tendency.\n\narithmeticMean :: (Foldable t, Fractional a) => t a -> a\narithmeticMean vals = (sum vals) / (fromIntegral $ length vals)\n\ngeometricMean :: (Foldable t, Floating a) => t a -> a\ngeometricMean vals = (product vals) ** (1/(fromIntegral $ length vals))\n\nharmonicMean :: (Foldable t, Functor t, Fractional a) => t a -> a\nharmonicMean vals = (sum $ fmap (1/) vals) / (fromIntegral $ length vals)\n\n-- For median, since the containers are sorted differently, we need to use\n-- different methods\n\nmedianList :: (Fractional a, Ord a) => [a] -> a\nmedianList = medianListSorted . S.sort\n\nmedianVector\n  :: (VG.Vector vector a, Foldable vector, Fractional a, Ord a)\n  => vector a -> a\nmedianVector = medianVectorSorted . VG.modify VGAI.sort\n\n-- When sorted, the two median algorithms are quite similar. We can reduce\n-- duplication by adding an export list to the module and using more\n-- higher-order functions but let's leave this for a different PR.\n\nmedianListSorted :: Fractional a => [a] -> a\nmedianListSorted vals\n  | odd n = vals !! mid\n  | otherwise = arithmeticMean $ take 2 $ drop (mid - 1) vals\n  where\n    n = length vals\n    mid = n `div` 2\n\nmedianVectorSorted\n  :: (VG.Vector vector a, Foldable vector, Fractional a)\n  => vector a -> a\nmedianVectorSorted vals\n  | odd n = vals VG.! mid\n  | otherwise = arithmeticMean $ VG.take 2 $ VG.drop (mid - 1) vals\n  where\n    n = length vals\n    mid = n `div` 2\n", "num_lines": 50}
{"repo_name": "Haskell", "repo_creator": "TheAlgorithms", "programming_language": "Haskell", "code": "module Statistics.Dispersion where\n\nimport Statistics.Center\n\nvariance :: (Foldable t, Functor t, Fractional a) => t a -> a\nvariance vals = (sum $ fmap (\\x -> x * x) deviations) / n\n    where n = (fromIntegral $ length vals)\n          mu = arithmeticMean vals\n          deviations = fmap (\\x -> x-mu) vals\n\nstdev :: (Foldable t, Functor t, Floating a) => t a -> a\nstdev vals = sqrt $ variance vals\n", "num_lines": 13}